[MLton-commit] r4361

[Matthew Fluet]

Merge trunk revisions 3807:4360 into cmm branch
----------------------------------------------------------------------

_U  mlton/branches/on-20050420-cmm-branch/
D   mlton/branches/on-20050420-cmm-branch/.cvsignore
A   mlton/branches/on-20050420-cmm-branch/.ignore
U   mlton/branches/on-20050420-cmm-branch/Makefile
_U  mlton/branches/on-20050420-cmm-branch/basis-library/
D   mlton/branches/on-20050420-cmm-branch/basis-library/.cvsignore
A   mlton/branches/on-20050420-cmm-branch/basis-library/.ignore
U   mlton/branches/on-20050420-cmm-branch/basis-library/Makefile
U   mlton/branches/on-20050420-cmm-branch/basis-library/README
U   mlton/branches/on-20050420-cmm-branch/basis-library/arrays-and-vectors/array-slice.sig
U   mlton/branches/on-20050420-cmm-branch/basis-library/arrays-and-vectors/array.sml
U   mlton/branches/on-20050420-cmm-branch/basis-library/arrays-and-vectors/array2.sig
U   mlton/branches/on-20050420-cmm-branch/basis-library/arrays-and-vectors/array2.sml
U   mlton/branches/on-20050420-cmm-branch/basis-library/arrays-and-vectors/mono-array-slice.sig
U   mlton/branches/on-20050420-cmm-branch/basis-library/arrays-and-vectors/mono-array.fun
U   mlton/branches/on-20050420-cmm-branch/basis-library/arrays-and-vectors/mono-array.sig
U   mlton/branches/on-20050420-cmm-branch/basis-library/arrays-and-vectors/mono-array2.fun
U   mlton/branches/on-20050420-cmm-branch/basis-library/arrays-and-vectors/mono-array2.sig
U   mlton/branches/on-20050420-cmm-branch/basis-library/arrays-and-vectors/mono-vector-slice.sig
U   mlton/branches/on-20050420-cmm-branch/basis-library/arrays-and-vectors/mono-vector.fun
U   mlton/branches/on-20050420-cmm-branch/basis-library/arrays-and-vectors/mono-vector.sig
U   mlton/branches/on-20050420-cmm-branch/basis-library/arrays-and-vectors/mono.sml
U   mlton/branches/on-20050420-cmm-branch/basis-library/arrays-and-vectors/sequence.fun
U   mlton/branches/on-20050420-cmm-branch/basis-library/arrays-and-vectors/sequence.sig
U   mlton/branches/on-20050420-cmm-branch/basis-library/arrays-and-vectors/slice.sig
U   mlton/branches/on-20050420-cmm-branch/basis-library/arrays-and-vectors/vector.sml
U   mlton/branches/on-20050420-cmm-branch/basis-library/basis-1997.mlb
U   mlton/branches/on-20050420-cmm-branch/basis-library/basis-2002.mlb
U   mlton/branches/on-20050420-cmm-branch/basis-library/basis-none.mlb
U   mlton/branches/on-20050420-cmm-branch/basis-library/basis.mlb
A   mlton/branches/on-20050420-cmm-branch/basis-library/default.mlb
U   mlton/branches/on-20050420-cmm-branch/basis-library/equal.mlb
U   mlton/branches/on-20050420-cmm-branch/basis-library/general/bool.sml
U   mlton/branches/on-20050420-cmm-branch/basis-library/general/general.sml
U   mlton/branches/on-20050420-cmm-branch/basis-library/general/option.sig
U   mlton/branches/on-20050420-cmm-branch/basis-library/general/option.sml
U   mlton/branches/on-20050420-cmm-branch/basis-library/general/sml90.sml
U   mlton/branches/on-20050420-cmm-branch/basis-library/infixes.mlb
U   mlton/branches/on-20050420-cmm-branch/basis-library/integer/embed-int.sml
U   mlton/branches/on-20050420-cmm-branch/basis-library/integer/embed-word.sml
U   mlton/branches/on-20050420-cmm-branch/basis-library/integer/int-inf.sig
U   mlton/branches/on-20050420-cmm-branch/basis-library/integer/int-inf.sml
U   mlton/branches/on-20050420-cmm-branch/basis-library/integer/int.sml
U   mlton/branches/on-20050420-cmm-branch/basis-library/integer/integer.sig
U   mlton/branches/on-20050420-cmm-branch/basis-library/integer/pack-word32.sml
U   mlton/branches/on-20050420-cmm-branch/basis-library/integer/patch.sml
U   mlton/branches/on-20050420-cmm-branch/basis-library/integer/word.sig
U   mlton/branches/on-20050420-cmm-branch/basis-library/integer/word.sml
U   mlton/branches/on-20050420-cmm-branch/basis-library/io/bin-io.sig
U   mlton/branches/on-20050420-cmm-branch/basis-library/io/bin-io.sml
U   mlton/branches/on-20050420-cmm-branch/basis-library/io/bin-prim-io.sml
U   mlton/branches/on-20050420-cmm-branch/basis-library/io/imperative-io.fun
U   mlton/branches/on-20050420-cmm-branch/basis-library/io/imperative-io.sig
U   mlton/branches/on-20050420-cmm-branch/basis-library/io/io.sig
U   mlton/branches/on-20050420-cmm-branch/basis-library/io/io.sml
U   mlton/branches/on-20050420-cmm-branch/basis-library/io/prim-io.fun
U   mlton/branches/on-20050420-cmm-branch/basis-library/io/prim-io.sig
U   mlton/branches/on-20050420-cmm-branch/basis-library/io/stream-io.fun
U   mlton/branches/on-20050420-cmm-branch/basis-library/io/stream-io.sig
U   mlton/branches/on-20050420-cmm-branch/basis-library/io/text-io.sig
U   mlton/branches/on-20050420-cmm-branch/basis-library/io/text-io.sml
U   mlton/branches/on-20050420-cmm-branch/basis-library/io/text-prim-io.sml
U   mlton/branches/on-20050420-cmm-branch/basis-library/io/text-stream-io.sig
U   mlton/branches/on-20050420-cmm-branch/basis-library/libs/all.mlb
U   mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/arrays-and-vectors/array.sig
U   mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/arrays-and-vectors/mono-array.sig
U   mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/arrays-and-vectors/mono-array2.sig
U   mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/arrays-and-vectors/mono-vector-array-array2-convert.fun
U   mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/arrays-and-vectors/vector-array-convert.fun
U   mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/basis-1997.mlb
U   mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/integer/word.sig
U   mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/io/bin-io-convert.fun
U   mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/io/bin-io.sig
U   mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/io/bin-stream-io.sig
U   mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/io/io-convert.fun
U   mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/io/io.sig
U   mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/io/text-io-convert.fun
U   mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/io/text-io.sig
U   mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/io/text-stream-io.sig
U   mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/posix/file-sys-convert.fun
U   mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/posix/file-sys.sig
U   mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/posix/flags-convert.fun
U   mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/posix/io-convert.fun
U   mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/posix/io.sig
U   mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/posix/posix-convert.fun
U   mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/posix/process-convert.fun
U   mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/posix/process.sig
U   mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/posix/tty-convert.fun
U   mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/posix/tty.sig
U   mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/real/IEEE-real-convert.fun
U   mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/real/IEEE-real.sig
U   mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/real/real-convert.fun
U   mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/real/real.sig
U   mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/system/file-sys-convert.fun
U   mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/system/file-sys.sig
U   mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/system/os-convert.fun
U   mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/system/os.sig
U   mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/system/path-convert.fun
U   mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/system/process-convert.fun
U   mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/system/timer-convert.fun
U   mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/system/unix-convert.fun
U   mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/system/unix.sig
U   mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/text/string.sig
U   mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/text/substring.sig
U   mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/text/text-convert.fun
U   mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/top-level/basis-funs.sml
U   mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/top-level/basis-sigs.sml
U   mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/top-level/basis.sml
U   mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/top-level/infixes.sml
U   mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/top-level/overloads.sml
U   mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/top-level/top-level.sml
U   mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-2002/basis-2002.mlb
_U  mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-2002/top-level/
D   mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-2002/top-level/.cvsignore
A   mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-2002/top-level/.ignore
U   mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-2002/top-level/Makefile
U   mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-2002/top-level/basis-funs.sml
U   mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-2002/top-level/basis-sigs.sml
U   mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-2002/top-level/basis.sig
U   mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-2002/top-level/basis.sml
U   mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-2002/top-level/generate-overloads.sml
U   mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-2002/top-level/infixes.sml
U   mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-2002/top-level/overloads.sml
U   mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-2002/top-level/pervasive-equal.sml
U   mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-2002/top-level/pervasive-exns.sml
U   mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-2002/top-level/pervasive-types.sml
U   mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-2002/top-level/pervasive-vals.sml
U   mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-2002/top-level/top-level.sml
U   mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-2002-strict/top-level/top-level.sml
U   mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-extra/basis-extra.mlb
U   mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-extra/top-level/basis-funs.sml
U   mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-extra/top-level/basis-sigs.sml
U   mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-extra/top-level/basis.sig
U   mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-extra/top-level/basis.sml
U   mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-extra/top-level/top-level.sml
U   mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-none/top-level/basis.sml
U   mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-none/top-level/infixes.sml
U   mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-none/top-level/top-level.sml
U   mlton/branches/on-20050420-cmm-branch/basis-library/libs/primitive.mlb
U   mlton/branches/on-20050420-cmm-branch/basis-library/list/list-pair.sml
U   mlton/branches/on-20050420-cmm-branch/basis-library/list/list.sml
U   mlton/branches/on-20050420-cmm-branch/basis-library/misc/C.sig
U   mlton/branches/on-20050420-cmm-branch/basis-library/misc/C.sml
U   mlton/branches/on-20050420-cmm-branch/basis-library/misc/basic.sml
U   mlton/branches/on-20050420-cmm-branch/basis-library/misc/cleaner.sig
U   mlton/branches/on-20050420-cmm-branch/basis-library/misc/cleaner.sml
U   mlton/branches/on-20050420-cmm-branch/basis-library/misc/dynamic-wind.sml
U   mlton/branches/on-20050420-cmm-branch/basis-library/misc/primitive.sml
U   mlton/branches/on-20050420-cmm-branch/basis-library/misc/reader.sig
U   mlton/branches/on-20050420-cmm-branch/basis-library/misc/reader.sml
U   mlton/branches/on-20050420-cmm-branch/basis-library/misc/unique-id.fun
U   mlton/branches/on-20050420-cmm-branch/basis-library/misc/unique-id.sig
U   mlton/branches/on-20050420-cmm-branch/basis-library/misc/util.sml
U   mlton/branches/on-20050420-cmm-branch/basis-library/mlton/array.sig
U   mlton/branches/on-20050420-cmm-branch/basis-library/mlton/bin-io.sig
U   mlton/branches/on-20050420-cmm-branch/basis-library/mlton/call-stack.sig
U   mlton/branches/on-20050420-cmm-branch/basis-library/mlton/call-stack.sml
U   mlton/branches/on-20050420-cmm-branch/basis-library/mlton/cont.sig
U   mlton/branches/on-20050420-cmm-branch/basis-library/mlton/cont.sml
U   mlton/branches/on-20050420-cmm-branch/basis-library/mlton/exit.sml
U   mlton/branches/on-20050420-cmm-branch/basis-library/mlton/exn.sig
U   mlton/branches/on-20050420-cmm-branch/basis-library/mlton/exn.sml
U   mlton/branches/on-20050420-cmm-branch/basis-library/mlton/ffi.sig
U   mlton/branches/on-20050420-cmm-branch/basis-library/mlton/ffi.sml
U   mlton/branches/on-20050420-cmm-branch/basis-library/mlton/finalizable.sig
U   mlton/branches/on-20050420-cmm-branch/basis-library/mlton/finalizable.sml
U   mlton/branches/on-20050420-cmm-branch/basis-library/mlton/gc.sig
U   mlton/branches/on-20050420-cmm-branch/basis-library/mlton/gc.sml
U   mlton/branches/on-20050420-cmm-branch/basis-library/mlton/int-inf.sig
U   mlton/branches/on-20050420-cmm-branch/basis-library/mlton/io.fun
U   mlton/branches/on-20050420-cmm-branch/basis-library/mlton/io.sig
U   mlton/branches/on-20050420-cmm-branch/basis-library/mlton/itimer.sig
U   mlton/branches/on-20050420-cmm-branch/basis-library/mlton/itimer.sml
U   mlton/branches/on-20050420-cmm-branch/basis-library/mlton/mlton.sig
U   mlton/branches/on-20050420-cmm-branch/basis-library/mlton/mlton.sml
U   mlton/branches/on-20050420-cmm-branch/basis-library/mlton/platform.sig
U   mlton/branches/on-20050420-cmm-branch/basis-library/mlton/platform.sml
U   mlton/branches/on-20050420-cmm-branch/basis-library/mlton/pointer.sig
U   mlton/branches/on-20050420-cmm-branch/basis-library/mlton/pointer.sml
U   mlton/branches/on-20050420-cmm-branch/basis-library/mlton/proc-env.sig
U   mlton/branches/on-20050420-cmm-branch/basis-library/mlton/proc-env.sml
U   mlton/branches/on-20050420-cmm-branch/basis-library/mlton/process.sig
U   mlton/branches/on-20050420-cmm-branch/basis-library/mlton/process.sml
U   mlton/branches/on-20050420-cmm-branch/basis-library/mlton/profile.sig
U   mlton/branches/on-20050420-cmm-branch/basis-library/mlton/profile.sml
U   mlton/branches/on-20050420-cmm-branch/basis-library/mlton/ptrace.sig
U   mlton/branches/on-20050420-cmm-branch/basis-library/mlton/ptrace.sml
U   mlton/branches/on-20050420-cmm-branch/basis-library/mlton/random.sig
U   mlton/branches/on-20050420-cmm-branch/basis-library/mlton/random.sml
U   mlton/branches/on-20050420-cmm-branch/basis-library/mlton/rlimit.sig
U   mlton/branches/on-20050420-cmm-branch/basis-library/mlton/rlimit.sml
U   mlton/branches/on-20050420-cmm-branch/basis-library/mlton/rusage.sig
U   mlton/branches/on-20050420-cmm-branch/basis-library/mlton/rusage.sml
U   mlton/branches/on-20050420-cmm-branch/basis-library/mlton/signal.sig
U   mlton/branches/on-20050420-cmm-branch/basis-library/mlton/signal.sml
U   mlton/branches/on-20050420-cmm-branch/basis-library/mlton/socket.sig
U   mlton/branches/on-20050420-cmm-branch/basis-library/mlton/socket.sml
U   mlton/branches/on-20050420-cmm-branch/basis-library/mlton/syslog.sig
U   mlton/branches/on-20050420-cmm-branch/basis-library/mlton/syslog.sml
U   mlton/branches/on-20050420-cmm-branch/basis-library/mlton/text-io.sig
U   mlton/branches/on-20050420-cmm-branch/basis-library/mlton/thread.sig
U   mlton/branches/on-20050420-cmm-branch/basis-library/mlton/thread.sml
U   mlton/branches/on-20050420-cmm-branch/basis-library/mlton/vector.sig
U   mlton/branches/on-20050420-cmm-branch/basis-library/mlton/weak.sig
U   mlton/branches/on-20050420-cmm-branch/basis-library/mlton/weak.sml
U   mlton/branches/on-20050420-cmm-branch/basis-library/mlton/word.sig
U   mlton/branches/on-20050420-cmm-branch/basis-library/mlton/world.sig
U   mlton/branches/on-20050420-cmm-branch/basis-library/mlton/world.sml
U   mlton/branches/on-20050420-cmm-branch/basis-library/mlton.mlb
U   mlton/branches/on-20050420-cmm-branch/basis-library/net/generic-sock.sig
U   mlton/branches/on-20050420-cmm-branch/basis-library/net/generic-sock.sml
U   mlton/branches/on-20050420-cmm-branch/basis-library/net/inet-sock.sig
U   mlton/branches/on-20050420-cmm-branch/basis-library/net/inet-sock.sml
U   mlton/branches/on-20050420-cmm-branch/basis-library/net/net-host-db.sig
U   mlton/branches/on-20050420-cmm-branch/basis-library/net/net-host-db.sml
U   mlton/branches/on-20050420-cmm-branch/basis-library/net/net-prot-db.sml
U   mlton/branches/on-20050420-cmm-branch/basis-library/net/net-serv-db.sml
U   mlton/branches/on-20050420-cmm-branch/basis-library/net/net.sml
U   mlton/branches/on-20050420-cmm-branch/basis-library/net/socket.sig
U   mlton/branches/on-20050420-cmm-branch/basis-library/net/socket.sml
U   mlton/branches/on-20050420-cmm-branch/basis-library/net/unix-sock.sig
U   mlton/branches/on-20050420-cmm-branch/basis-library/net/unix-sock.sml
U   mlton/branches/on-20050420-cmm-branch/basis-library/notes.txt
U   mlton/branches/on-20050420-cmm-branch/basis-library/overloads.mlb
U   mlton/branches/on-20050420-cmm-branch/basis-library/pervasive-exns.mlb
U   mlton/branches/on-20050420-cmm-branch/basis-library/pervasive-types.mlb
U   mlton/branches/on-20050420-cmm-branch/basis-library/pervasive-vals.mlb
U   mlton/branches/on-20050420-cmm-branch/basis-library/pervasive.mlb
U   mlton/branches/on-20050420-cmm-branch/basis-library/platform/cygwin.sml
U   mlton/branches/on-20050420-cmm-branch/basis-library/posix/error.sig
U   mlton/branches/on-20050420-cmm-branch/basis-library/posix/error.sml
U   mlton/branches/on-20050420-cmm-branch/basis-library/posix/file-sys.sig
U   mlton/branches/on-20050420-cmm-branch/basis-library/posix/file-sys.sml
U   mlton/branches/on-20050420-cmm-branch/basis-library/posix/flags.sml
U   mlton/branches/on-20050420-cmm-branch/basis-library/posix/io.sig
U   mlton/branches/on-20050420-cmm-branch/basis-library/posix/io.sml
U   mlton/branches/on-20050420-cmm-branch/basis-library/posix/posix.sig
U   mlton/branches/on-20050420-cmm-branch/basis-library/posix/posix.sml
U   mlton/branches/on-20050420-cmm-branch/basis-library/posix/primitive.sml
U   mlton/branches/on-20050420-cmm-branch/basis-library/posix/proc-env.sig
U   mlton/branches/on-20050420-cmm-branch/basis-library/posix/proc-env.sml
U   mlton/branches/on-20050420-cmm-branch/basis-library/posix/process.sig
U   mlton/branches/on-20050420-cmm-branch/basis-library/posix/process.sml
U   mlton/branches/on-20050420-cmm-branch/basis-library/posix/signal.sml
U   mlton/branches/on-20050420-cmm-branch/basis-library/posix/stub-mingw.sml
U   mlton/branches/on-20050420-cmm-branch/basis-library/posix/sys-db.sig
U   mlton/branches/on-20050420-cmm-branch/basis-library/posix/sys-db.sml
U   mlton/branches/on-20050420-cmm-branch/basis-library/posix/tty.sig
U   mlton/branches/on-20050420-cmm-branch/basis-library/posix/tty.sml
U   mlton/branches/on-20050420-cmm-branch/basis-library/real/IEEE-real.sig
U   mlton/branches/on-20050420-cmm-branch/basis-library/real/IEEE-real.sml
U   mlton/branches/on-20050420-cmm-branch/basis-library/real/math.sig
U   mlton/branches/on-20050420-cmm-branch/basis-library/real/pack-real.sml
U   mlton/branches/on-20050420-cmm-branch/basis-library/real/real.fun
U   mlton/branches/on-20050420-cmm-branch/basis-library/real/real.sig
U   mlton/branches/on-20050420-cmm-branch/basis-library/real/real32.sml
U   mlton/branches/on-20050420-cmm-branch/basis-library/real/real64.sml
U   mlton/branches/on-20050420-cmm-branch/basis-library/sml-nj/sml-nj.sig
U   mlton/branches/on-20050420-cmm-branch/basis-library/sml-nj/sml-nj.sml
U   mlton/branches/on-20050420-cmm-branch/basis-library/sml-nj/unsafe.sig
U   mlton/branches/on-20050420-cmm-branch/basis-library/sml-nj/unsafe.sml
U   mlton/branches/on-20050420-cmm-branch/basis-library/sml-nj.mlb
U   mlton/branches/on-20050420-cmm-branch/basis-library/system/command-line.sml
U   mlton/branches/on-20050420-cmm-branch/basis-library/system/date.sig
U   mlton/branches/on-20050420-cmm-branch/basis-library/system/date.sml
U   mlton/branches/on-20050420-cmm-branch/basis-library/system/file-sys.sml
U   mlton/branches/on-20050420-cmm-branch/basis-library/system/io.sig
U   mlton/branches/on-20050420-cmm-branch/basis-library/system/io.sml
U   mlton/branches/on-20050420-cmm-branch/basis-library/system/os.sml
U   mlton/branches/on-20050420-cmm-branch/basis-library/system/path.sml
U   mlton/branches/on-20050420-cmm-branch/basis-library/system/pre-os.sml
U   mlton/branches/on-20050420-cmm-branch/basis-library/system/process.sig
U   mlton/branches/on-20050420-cmm-branch/basis-library/system/process.sml
U   mlton/branches/on-20050420-cmm-branch/basis-library/system/time.sml
U   mlton/branches/on-20050420-cmm-branch/basis-library/system/timer.sig
U   mlton/branches/on-20050420-cmm-branch/basis-library/system/timer.sml
U   mlton/branches/on-20050420-cmm-branch/basis-library/system/unix.sig
U   mlton/branches/on-20050420-cmm-branch/basis-library/system/unix.sml
U   mlton/branches/on-20050420-cmm-branch/basis-library/text/byte.sml
U   mlton/branches/on-20050420-cmm-branch/basis-library/text/char.sml
U   mlton/branches/on-20050420-cmm-branch/basis-library/text/char0.sml
U   mlton/branches/on-20050420-cmm-branch/basis-library/text/string-cvt.sig
U   mlton/branches/on-20050420-cmm-branch/basis-library/text/string-cvt.sml
U   mlton/branches/on-20050420-cmm-branch/basis-library/text/string.sig
U   mlton/branches/on-20050420-cmm-branch/basis-library/text/string.sml
U   mlton/branches/on-20050420-cmm-branch/basis-library/text/string0.sml
U   mlton/branches/on-20050420-cmm-branch/basis-library/text/substring.sml
U   mlton/branches/on-20050420-cmm-branch/basis-library/text/text.sig
U   mlton/branches/on-20050420-cmm-branch/basis-library/text/text.sml
U   mlton/branches/on-20050420-cmm-branch/basis-library/top-level/arithmetic.sml
U   mlton/branches/on-20050420-cmm-branch/basis-library/top-level/infixes.sml
U   mlton/branches/on-20050420-cmm-branch/basis-library/unsafe.mlb
_U  mlton/branches/on-20050420-cmm-branch/benchmark/
D   mlton/branches/on-20050420-cmm-branch/benchmark/.cvsignore
A   mlton/branches/on-20050420-cmm-branch/benchmark/.ignore
U   mlton/branches/on-20050420-cmm-branch/benchmark/Makefile
U   mlton/branches/on-20050420-cmm-branch/benchmark/benchmark.cm
A   mlton/branches/on-20050420-cmm-branch/benchmark/benchmark.mlb
U   mlton/branches/on-20050420-cmm-branch/benchmark/call-main.sml
U   mlton/branches/on-20050420-cmm-branch/benchmark/main.sml
U   mlton/branches/on-20050420-cmm-branch/benchmark/sources.cm
A   mlton/branches/on-20050420-cmm-branch/benchmark/sources.mlb
_U  mlton/branches/on-20050420-cmm-branch/benchmark/tests/
D   mlton/branches/on-20050420-cmm-branch/benchmark/tests/.cvsignore
A   mlton/branches/on-20050420-cmm-branch/benchmark/tests/.ignore
_U  mlton/branches/on-20050420-cmm-branch/benchmark/tests/DATA/
D   mlton/branches/on-20050420-cmm-branch/benchmark/tests/DATA/.cvsignore
A   mlton/branches/on-20050420-cmm-branch/benchmark/tests/DATA/.ignore
U   mlton/branches/on-20050420-cmm-branch/benchmark/tests/DATA/ml.grm
U   mlton/branches/on-20050420-cmm-branch/benchmark/tests/DATA/ml.lex
U   mlton/branches/on-20050420-cmm-branch/benchmark/tests/DLXSimulator.sml
U   mlton/branches/on-20050420-cmm-branch/benchmark/tests/Makefile
U   mlton/branches/on-20050420-cmm-branch/benchmark/tests/barnes-hut.sml
U   mlton/branches/on-20050420-cmm-branch/benchmark/tests/boyer.sml
U   mlton/branches/on-20050420-cmm-branch/benchmark/tests/checksum.sml
U   mlton/branches/on-20050420-cmm-branch/benchmark/tests/count-graphs.sml
U   mlton/branches/on-20050420-cmm-branch/benchmark/tests/fft.sml
U   mlton/branches/on-20050420-cmm-branch/benchmark/tests/fib.sml
U   mlton/branches/on-20050420-cmm-branch/benchmark/tests/flat-array.sml
U   mlton/branches/on-20050420-cmm-branch/benchmark/tests/fxp.sml
U   mlton/branches/on-20050420-cmm-branch/benchmark/tests/hamlet.sml
U   mlton/branches/on-20050420-cmm-branch/benchmark/tests/imp-for.sml
U   mlton/branches/on-20050420-cmm-branch/benchmark/tests/knuth-bendix.sml
U   mlton/branches/on-20050420-cmm-branch/benchmark/tests/lexgen.sml
U   mlton/branches/on-20050420-cmm-branch/benchmark/tests/life.sml
U   mlton/branches/on-20050420-cmm-branch/benchmark/tests/logic.sml
U   mlton/branches/on-20050420-cmm-branch/benchmark/tests/mandelbrot.sml
U   mlton/branches/on-20050420-cmm-branch/benchmark/tests/matrix-multiply.sml
U   mlton/branches/on-20050420-cmm-branch/benchmark/tests/md5.sml
U   mlton/branches/on-20050420-cmm-branch/benchmark/tests/merge.sml
U   mlton/branches/on-20050420-cmm-branch/benchmark/tests/mlyacc.sml
U   mlton/branches/on-20050420-cmm-branch/benchmark/tests/model-elimination.sml
U   mlton/branches/on-20050420-cmm-branch/benchmark/tests/mpuz.sml
U   mlton/branches/on-20050420-cmm-branch/benchmark/tests/nucleic.sml
U   mlton/branches/on-20050420-cmm-branch/benchmark/tests/output1.sml
U   mlton/branches/on-20050420-cmm-branch/benchmark/tests/peek.sml
U   mlton/branches/on-20050420-cmm-branch/benchmark/tests/psdes-random.sml
U   mlton/branches/on-20050420-cmm-branch/benchmark/tests/ratio-regions.sml
U   mlton/branches/on-20050420-cmm-branch/benchmark/tests/ray.sml
U   mlton/branches/on-20050420-cmm-branch/benchmark/tests/raytrace.sml
U   mlton/branches/on-20050420-cmm-branch/benchmark/tests/simple.sml
U   mlton/branches/on-20050420-cmm-branch/benchmark/tests/smith-normal-form.sml
U   mlton/branches/on-20050420-cmm-branch/benchmark/tests/tailfib.sml
U   mlton/branches/on-20050420-cmm-branch/benchmark/tests/tak.sml
U   mlton/branches/on-20050420-cmm-branch/benchmark/tests/tensor.sml
U   mlton/branches/on-20050420-cmm-branch/benchmark/tests/tsp.sml
U   mlton/branches/on-20050420-cmm-branch/benchmark/tests/tyan.sml
U   mlton/branches/on-20050420-cmm-branch/benchmark/tests/vector-concat.sml
U   mlton/branches/on-20050420-cmm-branch/benchmark/tests/vector-rev.sml
U   mlton/branches/on-20050420-cmm-branch/benchmark/tests/vliw.sml
U   mlton/branches/on-20050420-cmm-branch/benchmark/tests/wc-input1.sml
U   mlton/branches/on-20050420-cmm-branch/benchmark/tests/wc-scanStream.sml
U   mlton/branches/on-20050420-cmm-branch/benchmark/tests/zebra.sml
U   mlton/branches/on-20050420-cmm-branch/benchmark/tests/zern.sml
U   mlton/branches/on-20050420-cmm-branch/bin/Makefile
U   mlton/branches/on-20050420-cmm-branch/bin/add-cross
U   mlton/branches/on-20050420-cmm-branch/bin/build-cross-gcc
D   mlton/branches/on-20050420-cmm-branch/bin/check-basis
U   mlton/branches/on-20050420-cmm-branch/bin/clean
A   mlton/branches/on-20050420-cmm-branch/bin/grab-wiki
U   mlton/branches/on-20050420-cmm-branch/bin/host-arch
U   mlton/branches/on-20050420-cmm-branch/bin/host-os
A   mlton/branches/on-20050420-cmm-branch/bin/make-pdf-guide
U   mlton/branches/on-20050420-cmm-branch/bin/mlton-script
U   mlton/branches/on-20050420-cmm-branch/bin/mmake
A   mlton/branches/on-20050420-cmm-branch/bin/msed
A   mlton/branches/on-20050420-cmm-branch/bin/patch-mingw
U   mlton/branches/on-20050420-cmm-branch/bin/platform
U   mlton/branches/on-20050420-cmm-branch/bin/regression
A   mlton/branches/on-20050420-cmm-branch/bin/sync-ignore
U   mlton/branches/on-20050420-cmm-branch/bin/upgrade-basis
_U  mlton/branches/on-20050420-cmm-branch/bytecode/
D   mlton/branches/on-20050420-cmm-branch/bytecode/.cvsignore
A   mlton/branches/on-20050420-cmm-branch/bytecode/.ignore
U   mlton/branches/on-20050420-cmm-branch/bytecode/Makefile
U   mlton/branches/on-20050420-cmm-branch/bytecode/interpret.c
U   mlton/branches/on-20050420-cmm-branch/bytecode/interpret.h
U   mlton/branches/on-20050420-cmm-branch/bytecode/opcode.h
U   mlton/branches/on-20050420-cmm-branch/bytecode/print-opcodes.c
D   mlton/branches/on-20050420-cmm-branch/debian/
U   mlton/branches/on-20050420-cmm-branch/doc/README
U   mlton/branches/on-20050420-cmm-branch/doc/changelog
D   mlton/branches/on-20050420-cmm-branch/doc/cm2mlb/
D   mlton/branches/on-20050420-cmm-branch/doc/cmcat/
U   mlton/branches/on-20050420-cmm-branch/doc/examples/Makefile
_U  mlton/branches/on-20050420-cmm-branch/doc/examples/ffi/
D   mlton/branches/on-20050420-cmm-branch/doc/examples/ffi/.cvsignore
A   mlton/branches/on-20050420-cmm-branch/doc/examples/ffi/.ignore
U   mlton/branches/on-20050420-cmm-branch/doc/examples/ffi/Makefile
U   mlton/branches/on-20050420-cmm-branch/doc/examples/ffi/export.sml
U   mlton/branches/on-20050420-cmm-branch/doc/examples/ffi/ffi-export.c
U   mlton/branches/on-20050420-cmm-branch/doc/examples/ffi/ffi-import.c
U   mlton/branches/on-20050420-cmm-branch/doc/examples/ffi/iimport.sml
U   mlton/branches/on-20050420-cmm-branch/doc/examples/ffi/import.sml
U   mlton/branches/on-20050420-cmm-branch/doc/examples/ffi/import2.sml
U   mlton/branches/on-20050420-cmm-branch/doc/examples/ffi/test_quot.sml
_U  mlton/branches/on-20050420-cmm-branch/doc/examples/finalizable/
D   mlton/branches/on-20050420-cmm-branch/doc/examples/finalizable/.cvsignore
A   mlton/branches/on-20050420-cmm-branch/doc/examples/finalizable/.ignore
U   mlton/branches/on-20050420-cmm-branch/doc/examples/finalizable/Makefile
U   mlton/branches/on-20050420-cmm-branch/doc/examples/finalizable/cons.c
U   mlton/branches/on-20050420-cmm-branch/doc/examples/finalizable/finalizable.sml
_U  mlton/branches/on-20050420-cmm-branch/doc/examples/profiling/
D   mlton/branches/on-20050420-cmm-branch/doc/examples/profiling/.cvsignore
A   mlton/branches/on-20050420-cmm-branch/doc/examples/profiling/.ignore
U   mlton/branches/on-20050420-cmm-branch/doc/examples/profiling/Makefile
U   mlton/branches/on-20050420-cmm-branch/doc/examples/profiling/list-rev.sml
U   mlton/branches/on-20050420-cmm-branch/doc/examples/profiling/tak.sml
_U  mlton/branches/on-20050420-cmm-branch/doc/examples/save-world/
D   mlton/branches/on-20050420-cmm-branch/doc/examples/save-world/.cvsignore
A   mlton/branches/on-20050420-cmm-branch/doc/examples/save-world/.ignore
U   mlton/branches/on-20050420-cmm-branch/doc/examples/save-world/Makefile
A   mlton/branches/on-20050420-cmm-branch/doc/guide/
_U  mlton/branches/on-20050420-cmm-branch/doc/hacker-guide/
D   mlton/branches/on-20050420-cmm-branch/doc/hacker-guide/.cvsignore
A   mlton/branches/on-20050420-cmm-branch/doc/hacker-guide/.ignore
U   mlton/branches/on-20050420-cmm-branch/doc/hacker-guide/Makefile
U   mlton/branches/on-20050420-cmm-branch/doc/hacker-guide/abstract.tex
_U  mlton/branches/on-20050420-cmm-branch/doc/library-guide/
D   mlton/branches/on-20050420-cmm-branch/doc/library-guide/.cvsignore
A   mlton/branches/on-20050420-cmm-branch/doc/library-guide/.ignore
U   mlton/branches/on-20050420-cmm-branch/doc/library-guide/Makefile
_U  mlton/branches/on-20050420-cmm-branch/doc/license/
U   mlton/branches/on-20050420-cmm-branch/doc/license/MLKit-LICENSE
U   mlton/branches/on-20050420-cmm-branch/doc/license/MLton-LICENSE
U   mlton/branches/on-20050420-cmm-branch/doc/license/README
_U  mlton/branches/on-20050420-cmm-branch/doc/mlb-formal/
D   mlton/branches/on-20050420-cmm-branch/doc/mlb-formal/.cvsignore
A   mlton/branches/on-20050420-cmm-branch/doc/mlb-formal/.ignore
U   mlton/branches/on-20050420-cmm-branch/doc/mlb-formal/Makefile
D   mlton/branches/on-20050420-cmm-branch/doc/mlton.el
D   mlton/branches/on-20050420-cmm-branch/doc/mlton.spec
_U  mlton/branches/on-20050420-cmm-branch/doc/style-guide/
D   mlton/branches/on-20050420-cmm-branch/doc/style-guide/.cvsignore
A   mlton/branches/on-20050420-cmm-branch/doc/style-guide/.ignore
U   mlton/branches/on-20050420-cmm-branch/doc/style-guide/Makefile
U   mlton/branches/on-20050420-cmm-branch/doc/style-guide/main.tex
D   mlton/branches/on-20050420-cmm-branch/freebsd/
A   mlton/branches/on-20050420-cmm-branch/ide/
U   mlton/branches/on-20050420-cmm-branch/include/Makefile
U   mlton/branches/on-20050420-cmm-branch/include/bytecode-main.h
U   mlton/branches/on-20050420-cmm-branch/include/bytecode.h
U   mlton/branches/on-20050420-cmm-branch/include/c-chunk.h
U   mlton/branches/on-20050420-cmm-branch/include/c-common.h
U   mlton/branches/on-20050420-cmm-branch/include/c-main.h
U   mlton/branches/on-20050420-cmm-branch/include/cmm-main.h
U   mlton/branches/on-20050420-cmm-branch/include/main.h
U   mlton/branches/on-20050420-cmm-branch/include/x86-main.h
U   mlton/branches/on-20050420-cmm-branch/lib/Makefile
U   mlton/branches/on-20050420-cmm-branch/lib/basis-stubs/Makefile
U   mlton/branches/on-20050420-cmm-branch/lib/basis-stubs/basis-2002.sml
U   mlton/branches/on-20050420-cmm-branch/lib/basis-stubs/sources.cm
A   mlton/branches/on-20050420-cmm-branch/lib/ckit-lib/
U   mlton/branches/on-20050420-cmm-branch/lib/cml/cml-lib/cml-lib.mlb
U   mlton/branches/on-20050420-cmm-branch/lib/cml/cml-lib/multicast.sig
U   mlton/branches/on-20050420-cmm-branch/lib/cml/cml-lib/multicast.sml
U   mlton/branches/on-20050420-cmm-branch/lib/cml/cml-lib/result.sig
U   mlton/branches/on-20050420-cmm-branch/lib/cml/cml-lib/result.sml
U   mlton/branches/on-20050420-cmm-branch/lib/cml/cml-lib/simple-rpc.sig
U   mlton/branches/on-20050420-cmm-branch/lib/cml/cml-lib/simple-rpc.sml
U   mlton/branches/on-20050420-cmm-branch/lib/cml/cml-lib/trace-cml.sig
U   mlton/branches/on-20050420-cmm-branch/lib/cml/cml-lib/trace-cml.sml
U   mlton/branches/on-20050420-cmm-branch/lib/cml/cml.mlb
U   mlton/branches/on-20050420-cmm-branch/lib/cml/core-cml/channel.sig
U   mlton/branches/on-20050420-cmm-branch/lib/cml/core-cml/channel.sml
U   mlton/branches/on-20050420-cmm-branch/lib/cml/core-cml/core-cml.mlb
U   mlton/branches/on-20050420-cmm-branch/lib/cml/core-cml/event.sig
U   mlton/branches/on-20050420-cmm-branch/lib/cml/core-cml/event.sml
U   mlton/branches/on-20050420-cmm-branch/lib/cml/core-cml/mailbox.sig
U   mlton/branches/on-20050420-cmm-branch/lib/cml/core-cml/mailbox.sml
U   mlton/branches/on-20050420-cmm-branch/lib/cml/core-cml/rep-types.sml
U   mlton/branches/on-20050420-cmm-branch/lib/cml/core-cml/run-cml.sml
U   mlton/branches/on-20050420-cmm-branch/lib/cml/core-cml/scheduler-hooks.sml
U   mlton/branches/on-20050420-cmm-branch/lib/cml/core-cml/scheduler.sml
U   mlton/branches/on-20050420-cmm-branch/lib/cml/core-cml/sync-var.sig
U   mlton/branches/on-20050420-cmm-branch/lib/cml/core-cml/sync-var.sml
U   mlton/branches/on-20050420-cmm-branch/lib/cml/core-cml/thread-id.sml
U   mlton/branches/on-20050420-cmm-branch/lib/cml/core-cml/thread.sig
U   mlton/branches/on-20050420-cmm-branch/lib/cml/core-cml/thread.sml
U   mlton/branches/on-20050420-cmm-branch/lib/cml/core-cml/timeout.sml
U   mlton/branches/on-20050420-cmm-branch/lib/cml/core-cml/trans-id.sml
U   mlton/branches/on-20050420-cmm-branch/lib/cml/core-cml/version.sml
U   mlton/branches/on-20050420-cmm-branch/lib/cml/tests/exit.mlb
U   mlton/branches/on-20050420-cmm-branch/lib/cml/tests/ping-pong.mlb
U   mlton/branches/on-20050420-cmm-branch/lib/cml/tests/ping-pong.sml
U   mlton/branches/on-20050420-cmm-branch/lib/cml/tests/primes-multicast.mlb
U   mlton/branches/on-20050420-cmm-branch/lib/cml/tests/primes-multicast.sml
U   mlton/branches/on-20050420-cmm-branch/lib/cml/tests/primes.mlb
U   mlton/branches/on-20050420-cmm-branch/lib/cml/tests/primes.sml
U   mlton/branches/on-20050420-cmm-branch/lib/cml/tests/print.mlb
U   mlton/branches/on-20050420-cmm-branch/lib/cml/tests/print.sml
U   mlton/branches/on-20050420-cmm-branch/lib/cml/tests/run-main.sml
U   mlton/branches/on-20050420-cmm-branch/lib/cml/tests/timeout.mlb
U   mlton/branches/on-20050420-cmm-branch/lib/cml/tests/timeout.sml
U   mlton/branches/on-20050420-cmm-branch/lib/cml/util/assert.sml
U   mlton/branches/on-20050420-cmm-branch/lib/cml/util/critical.sml
U   mlton/branches/on-20050420-cmm-branch/lib/cml/util/debug.sml
U   mlton/branches/on-20050420-cmm-branch/lib/cml/util/fun-priority-queue.fun
U   mlton/branches/on-20050420-cmm-branch/lib/cml/util/fun-priority-queue.sig
U   mlton/branches/on-20050420-cmm-branch/lib/cml/util/fun-queue.sml
U   mlton/branches/on-20050420-cmm-branch/lib/cml/util/imp-queue.sml
U   mlton/branches/on-20050420-cmm-branch/lib/cml/util/local-assert.fun
U   mlton/branches/on-20050420-cmm-branch/lib/cml/util/local-debug.fun
U   mlton/branches/on-20050420-cmm-branch/lib/cml/util/timeit.sml
U   mlton/branches/on-20050420-cmm-branch/lib/cml/util/util.mlb
U   mlton/branches/on-20050420-cmm-branch/lib/mlnlffi/c.mlb
U   mlton/branches/on-20050420-cmm-branch/lib/mlnlffi/c.sig
D   mlton/branches/on-20050420-cmm-branch/lib/mlnlffi/c.x86-linux.mlb
D   mlton/branches/on-20050420-cmm-branch/lib/mlnlffi/c.x86-unix.mlb
U   mlton/branches/on-20050420-cmm-branch/lib/mlnlffi/internals/c-debug.sml
A   mlton/branches/on-20050420-cmm-branch/lib/mlnlffi/internals/c-int.mlb
U   mlton/branches/on-20050420-cmm-branch/lib/mlnlffi/internals/c-int.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlnlffi/internals/c-int.sml
D   mlton/branches/on-20050420-cmm-branch/lib/mlnlffi/internals/c-int.x86-unix.mlb
U   mlton/branches/on-20050420-cmm-branch/lib/mlnlffi/internals/zstring.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlnlffi/memory/bitop-fn.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlnlffi/memory/linkage-libdl.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlnlffi/memory/linkage.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlnlffi/memory/memaccess-a4c1s2i4l4ll8f4d8.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlnlffi/memory/memalloc-a4-unix.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlnlffi/memory/memalloc.sig
A   mlton/branches/on-20050420-cmm-branch/lib/mlnlffi/memory/memory.32bit-unix.mlb
A   mlton/branches/on-20050420-cmm-branch/lib/mlnlffi/memory/memory.mlb
D   mlton/branches/on-20050420-cmm-branch/lib/mlnlffi/memory/memory.x86-linux.mlb
D   mlton/branches/on-20050420-cmm-branch/lib/mlnlffi/memory/memory.x86-unix.mlb
U   mlton/branches/on-20050420-cmm-branch/lib/mlnlffi/memory/mlrep-i8i16i32i32i64f32f64.sml
A   mlton/branches/on-20050420-cmm-branch/lib/mlnlffi/memory/platform/
_U  mlton/branches/on-20050420-cmm-branch/lib/mlton/
D   mlton/branches/on-20050420-cmm-branch/lib/mlton/.cvsignore
A   mlton/branches/on-20050420-cmm-branch/lib/mlton/.ignore
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/Makefile
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/Makefile
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/alpha-beta.fun
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/alpha-beta.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/append-list.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/append-list.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/array.fun
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/array.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/array.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/array2.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/array2.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/assert.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/assert.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/base64.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/base64.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/binary-search.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/binary-search.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/bool.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/bool.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/bounded-order.fun
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/bounded-order.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/buffer.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/buffer.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/char-buffer.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/char-buffer.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/char-pred.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/char-pred.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/char.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/char.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/char0.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/char0.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/choice-pattern.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/choice-pattern.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/circular-list.fun
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/circular-list.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/clearable-promise.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/clearable-promise.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/computation.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/console.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/console.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/control.fun
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/control.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/counter.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/counter.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/date.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/date.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/dir.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/dir.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/directed-graph.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/directed-graph.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/directed-sub-graph.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/directed-sub-graph.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/dot-color.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/dot.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/dot.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/doubly-linked.fun
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/doubly-linked.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/dynamic-wind.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/dynamic-wind.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/engine.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/engine.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/env.fun
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/env.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/error.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/error.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/escape.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/escape.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/euclidean-ring.fun
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/euclidean-ring.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/exn.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/exn.sml
A   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/exn0.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/export.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/export.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/field.fun
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/field.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/file-desc.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/file-desc.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/file.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/file.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/fixed-point.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/fixed-point.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/fold.fun
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/fold.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/format.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/format.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/function.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/function.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/hash-set.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/hash-set.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/hash-table.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/hash-table.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/het-container.fun
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/het-container.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/html.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/html.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/http.mlb
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/http.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/http.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/init-script.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/init-script.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/insertion-sort.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/insertion-sort.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/instream.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/instream.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/instream0.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/int-inf.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/int-inf.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/int.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/integer.fun
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/integer.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/intermediate-computation.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/intermediate-computation.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/iterate.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/iterate.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/itimer.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/justify.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/justify.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/large-word.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/layout.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/layout.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/lines.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/lines.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/linked-list.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/linked-list.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/list.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/list.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/mark.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/mark.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/max-pow-2-that-divides.fun
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/merge-sort.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/merge-sort.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/mono-container.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/mono-list.fun
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/mono-option.fun
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/mono-vector.fun
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/my-dirs.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/my-dirs.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/net.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/net.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/number.fun
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/number.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/option.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/option.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/order.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/order0.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/ordered-field.fun
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/ordered-field.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/ordered-ring.fun
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/ordered-ring.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/outstream.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/outstream.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/outstream0.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/pair.fun
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/pair.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/parse.fun
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/parse.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/pid.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/pid.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/pointer.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/pointer.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/popt.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/popt.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/port.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/port.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/postscript.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/postscript.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/power.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/process.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/process.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/promise.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/promise.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/property-list.fun
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/property-list.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/property.fun
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/property.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/ps.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/ps.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/queue.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/quick-sort.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/quick-sort.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/random.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/random.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/rational.fun
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/rational.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/rdb.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/rdb.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/reader.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/reader.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/real.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/real.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/ref.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/ref.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/regexp.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/regexp.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/relation.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/relation.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/relation0.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/resizable-array.fun
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/resizable-array.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/result.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/result.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/ring-with-identity.fun
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/ring-with-identity.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/ring.fun
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/ring.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/sexp.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/sexp.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/signal.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/signal.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/sources.cm
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/sources.mlb
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/stream.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/stream.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/string-map.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/string-map.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/string.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/string.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/string0.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/string1.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/substring.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/substring.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/sum.fun
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/sum.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/t.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/tab.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/tab.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/test.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/thread.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/thread.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/time.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/time.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/trace.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/trace.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/tree.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/tree.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/two-list-queue-mutable.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/two-list-queue.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/unicode.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/unimplemented.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/unique-id.fun
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/unique-id.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/unique-set.fun
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/unique-set.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/unit.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/unit.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/url.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/url.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/vector.fun
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/vector.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/vector.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/word.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/word.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/word32.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/word8.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/directed-graph/classify-edges.fun
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/directed-graph/classify-edges.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/directed-graph/dijkstra.fun
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/directed-graph/shortest-path-check.fun
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/directed-graph/shortest-path-check.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/directed-graph/shortest-path.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/directed-graph/sources.cm
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/directed-graph/test.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/directed-graph/weight.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/env/array-finite-function.fun
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/env/array-finite-function.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/env/basic-env-to-env.fun
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/env/cache.fun
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/env/cache.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/env/finite-function.fun
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/env/finite-function.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/env/mono-env.fun
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/env/mono-env.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/env/move-to-front.fun
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/env/poly-cache-ref.fun
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/env/poly-cache.fun
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/env/poly-cache.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/env/sources.cm
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/env/sources.mlb
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/env/splay-env.fun
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/heap/binary.fun
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/heap/binomial.fun
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/heap/fibonacci.fun
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/heap/forest.fun
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/heap/forest.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/heap/heap.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/heap/sources.cm
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/heap/test.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/pervasive/pervasive.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/pervasive/sources.cm
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/pervasive/sources.mlb
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/queue/append-reverse.fun
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/queue/append-reverse.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/queue/basic-persistent.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/queue/bounded-ephemeral.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/queue/circular.fun
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/queue/early.fun
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/queue/ephemeral.fun
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/queue/ephemeral.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/queue/explicit-append-reverse.fun
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/queue/incremental-append-reverse.fun
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/queue/incremental.fun
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/queue/lazy-append-reverse.fun
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/queue/linked-list.fun
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/queue/list.fun
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/queue/persistent.fun
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/queue/persistent.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/queue/queue.fun
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/queue/singly-linked.fun
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/queue/sources.cm
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/queue/test.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/queue/two-list.fun
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/queue/unbounded-ephemeral.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/set/bit-vector-set.fun
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/set/disjoint-collection.fun
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/set/disjoint-collection.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/set/disjoint-max.fun
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/set/disjoint-max.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/set/disjoint.fun
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/set/disjoint.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/set/hashed-unique-set.fun
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/set/object-oriented.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/set/ordered-unique-set.fun
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/set/poly-set.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/set/poly-unordered.fun
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/set/poly-unordered2.fun
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/set/set.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/set/sources.cm
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/set/sources.mlb
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/set/test.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/set/type.fun
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/set/type.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/set/universe-equal.fun
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/set/universe-type-check.fun
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/set/universe.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/set/unordered-universe.fun
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/set/unordered.fun
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/sources.cm
U   mlton/branches/on-20050420-cmm-branch/lib/mlton/sources.mlb
U   mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/Makefile
U   mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/array.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/bin-io.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/bin-io.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/call-stack.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/cont.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/exn.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/finalizable.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/gc.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/int-inf.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/io.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/itimer.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/mlton.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/mlton.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/platform.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/pointer.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/proc-env.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/process.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/profile.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/ptrace.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/random.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/random.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/real.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/rlimit.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/rusage.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/signal.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/socket.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/sources.cm
U   mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/syslog.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/text-io.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/thread.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/thread.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/vector.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/weak.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/word.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/world.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs-in-smlnj/Makefile
U   mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs-in-smlnj/array.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs-in-smlnj/array2.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs-in-smlnj/bin-io.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs-in-smlnj/char.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs-in-smlnj/date.sml
A   mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs-in-smlnj/ieee-real.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs-in-smlnj/import.cm
U   mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs-in-smlnj/int-inf.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs-in-smlnj/int.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs-in-smlnj/list.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs-in-smlnj/mlton.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs-in-smlnj/open-int32.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs-in-smlnj/os.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs-in-smlnj/other.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs-in-smlnj/pervasive.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs-in-smlnj/posix.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs-in-smlnj/real.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs-in-smlnj/sources.cm
U   mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs-in-smlnj/string-cvt.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs-in-smlnj/string.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs-in-smlnj/substring.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs-in-smlnj/text-io.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs-in-smlnj/time.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs-in-smlnj/unsafe.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs-in-smlnj/vector.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs-in-smlnj/word.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlyacc/base.sig
U   mlton/branches/on-20050420-cmm-branch/lib/mlyacc/join.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlyacc/lrtable.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlyacc/mlyacc-lib.mlb
U   mlton/branches/on-20050420-cmm-branch/lib/mlyacc/parser1.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlyacc/parser2.sml
U   mlton/branches/on-20050420-cmm-branch/lib/mlyacc/sources.cm
U   mlton/branches/on-20050420-cmm-branch/lib/mlyacc/stream.sml
_U  mlton/branches/on-20050420-cmm-branch/lib/opengl/
D   mlton/branches/on-20050420-cmm-branch/lib/opengl/.cvsignore
A   mlton/branches/on-20050420-cmm-branch/lib/opengl/.ignore
U   mlton/branches/on-20050420-cmm-branch/lib/opengl/GLUT.sig
U   mlton/branches/on-20050420-cmm-branch/lib/opengl/GLUT.sml
U   mlton/branches/on-20050420-cmm-branch/lib/opengl/GLUT_c.c
U   mlton/branches/on-20050420-cmm-branch/lib/opengl/GLU_c.c
U   mlton/branches/on-20050420-cmm-branch/lib/opengl/GL_c.c
U   mlton/branches/on-20050420-cmm-branch/lib/opengl/Makefile
U   mlton/branches/on-20050420-cmm-branch/lib/opengl/atom.sml
U   mlton/branches/on-20050420-cmm-branch/lib/opengl/bits.sml
U   mlton/branches/on-20050420-cmm-branch/lib/opengl/blender.sml
U   mlton/branches/on-20050420-cmm-branch/lib/opengl/hello.sml
U   mlton/branches/on-20050420-cmm-branch/lib/opengl/menus.sml
U   mlton/branches/on-20050420-cmm-branch/lib/opengl/molehill.sml
A   mlton/branches/on-20050420-cmm-branch/lib/opengl/platform.h
U   mlton/branches/on-20050420-cmm-branch/lib/opengl/points.sml
U   mlton/branches/on-20050420-cmm-branch/lib/opengl/shortest.sml
U   mlton/branches/on-20050420-cmm-branch/lib/opengl/solar.sml
U   mlton/branches/on-20050420-cmm-branch/lib/opengl/spin_cube.sml
U   mlton/branches/on-20050420-cmm-branch/lib/opengl/triangle.sml
D   mlton/branches/on-20050420-cmm-branch/lib/smlnj/
A   mlton/branches/on-20050420-cmm-branch/lib/smlnj-lib/
_U  mlton/branches/on-20050420-cmm-branch/man/
D   mlton/branches/on-20050420-cmm-branch/man/.cvsignore
A   mlton/branches/on-20050420-cmm-branch/man/.ignore
U   mlton/branches/on-20050420-cmm-branch/man/Makefile
A   mlton/branches/on-20050420-cmm-branch/man/mlnlffigen.1
U   mlton/branches/on-20050420-cmm-branch/man/mlprof.1
U   mlton/branches/on-20050420-cmm-branch/man/mlton.1
_U  mlton/branches/on-20050420-cmm-branch/mllex/
D   mlton/branches/on-20050420-cmm-branch/mllex/.cvsignore
A   mlton/branches/on-20050420-cmm-branch/mllex/.ignore
A   mlton/branches/on-20050420-cmm-branch/mllex/INSTALL
U   mlton/branches/on-20050420-cmm-branch/mllex/Makefile
U   mlton/branches/on-20050420-cmm-branch/mllex/README
U   mlton/branches/on-20050420-cmm-branch/mllex/README.MLton
U   mlton/branches/on-20050420-cmm-branch/mllex/call-main.sml
A   mlton/branches/on-20050420-cmm-branch/mllex/export-lex.sml
U   mlton/branches/on-20050420-cmm-branch/mllex/lexgen.doc
U   mlton/branches/on-20050420-cmm-branch/mllex/lexgen.sml
U   mlton/branches/on-20050420-cmm-branch/mllex/lexgen.tex
U   mlton/branches/on-20050420-cmm-branch/mllex/main.sml
U   mlton/branches/on-20050420-cmm-branch/mllex/mlex_int.doc
U   mlton/branches/on-20050420-cmm-branch/mllex/mllex.cm
U   mlton/branches/on-20050420-cmm-branch/mllex/mllex.mlb
U   mlton/branches/on-20050420-cmm-branch/mllex/sources.cm
U   mlton/branches/on-20050420-cmm-branch/mllex/sources.mlb
_U  mlton/branches/on-20050420-cmm-branch/mlnlffigen/
D   mlton/branches/on-20050420-cmm-branch/mlnlffigen/.cvsignore
A   mlton/branches/on-20050420-cmm-branch/mlnlffigen/.ignore
U   mlton/branches/on-20050420-cmm-branch/mlnlffigen/Makefile
U   mlton/branches/on-20050420-cmm-branch/mlnlffigen/README
U   mlton/branches/on-20050420-cmm-branch/mlnlffigen/ast-to-spec.sml
U   mlton/branches/on-20050420-cmm-branch/mlnlffigen/call-main.sml
U   mlton/branches/on-20050420-cmm-branch/mlnlffigen/control.sig
U   mlton/branches/on-20050420-cmm-branch/mlnlffigen/control.sml
U   mlton/branches/on-20050420-cmm-branch/mlnlffigen/cpif-dev.sml
U   mlton/branches/on-20050420-cmm-branch/mlnlffigen/gen.sml
U   mlton/branches/on-20050420-cmm-branch/mlnlffigen/hash.sml
U   mlton/branches/on-20050420-cmm-branch/mlnlffigen/main.sml
U   mlton/branches/on-20050420-cmm-branch/mlnlffigen/mlnlffigen.mlb
U   mlton/branches/on-20050420-cmm-branch/mlnlffigen/pp.sml
U   mlton/branches/on-20050420-cmm-branch/mlnlffigen/sizes.sml
U   mlton/branches/on-20050420-cmm-branch/mlnlffigen/sources.mlb
U   mlton/branches/on-20050420-cmm-branch/mlnlffigen/spec.sml
_U  mlton/branches/on-20050420-cmm-branch/mlprof/
D   mlton/branches/on-20050420-cmm-branch/mlprof/.cvsignore
A   mlton/branches/on-20050420-cmm-branch/mlprof/.ignore
U   mlton/branches/on-20050420-cmm-branch/mlprof/Makefile
U   mlton/branches/on-20050420-cmm-branch/mlprof/call-main.sml
U   mlton/branches/on-20050420-cmm-branch/mlprof/main.sml
U   mlton/branches/on-20050420-cmm-branch/mlprof/mlprof.cm
U   mlton/branches/on-20050420-cmm-branch/mlprof/mlprof.mlb
U   mlton/branches/on-20050420-cmm-branch/mlprof/sources.cm
U   mlton/branches/on-20050420-cmm-branch/mlprof/sources.mlb
_U  mlton/branches/on-20050420-cmm-branch/mlton/
D   mlton/branches/on-20050420-cmm-branch/mlton/.cvsignore
A   mlton/branches/on-20050420-cmm-branch/mlton/.ignore
U   mlton/branches/on-20050420-cmm-branch/mlton/Makefile
U   mlton/branches/on-20050420-cmm-branch/mlton/ast/admits-equality.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/ast/admits-equality.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/ast/ast-atoms.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/ast/ast-atoms.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/ast/ast-const.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/ast/ast-const.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/ast/ast-core.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/ast/ast-core.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/ast/ast-id.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/ast/ast-id.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/ast/ast-mlbs.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/ast/ast-mlbs.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/ast/ast-modules.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/ast/ast-modules.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/ast/ast-programs.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/ast/ast-programs.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/ast/ast.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/ast/ast.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/ast/char-size.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/ast/char-size.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/ast/field.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/ast/field.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/ast/int-size.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/ast/int-size.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/ast/longid.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/ast/longid.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/ast/prim-cons.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/ast/prim-cons.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/ast/prim-tycons.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/ast/prim-tycons.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/ast/real-size.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/ast/real-size.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/ast/record.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/ast/record.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/ast/sources.cm
U   mlton/branches/on-20050420-cmm-branch/mlton/ast/sources.mlb
U   mlton/branches/on-20050420-cmm-branch/mlton/ast/symbol.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/ast/symbol.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/ast/tycon-kind.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/ast/tycon-kind.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/ast/tyvar.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/ast/tyvar.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/ast/word-size.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/ast/word-size.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/ast/wrapped.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/atoms/atoms.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/atoms/atoms.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/atoms/c-function.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/atoms/c-function.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/atoms/c-type.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/atoms/c-type.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/atoms/cases.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/atoms/cases.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/atoms/con-.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/atoms/con-.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/atoms/const-type.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/atoms/const-type.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/atoms/const.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/atoms/const.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/atoms/ffi.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/atoms/ffi.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/atoms/func.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/atoms/generic-scheme.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/atoms/generic-scheme.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/atoms/hash-type.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/atoms/hash-type.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/atoms/id.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/atoms/id.sig
D   mlton/branches/on-20050420-cmm-branch/mlton/atoms/int-x.fun
D   mlton/branches/on-20050420-cmm-branch/mlton/atoms/int-x.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/atoms/label.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/atoms/prim.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/atoms/prim.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/atoms/profile-exp.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/atoms/profile-exp.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/atoms/profile-label.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/atoms/profile-label.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/atoms/real-x.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/atoms/real-x.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/atoms/source-info.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/atoms/source-info.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/atoms/sources.cm
U   mlton/branches/on-20050420-cmm-branch/mlton/atoms/sources.mlb
U   mlton/branches/on-20050420-cmm-branch/mlton/atoms/tycon.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/atoms/tycon.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/atoms/type-ops.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/atoms/type-ops.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/atoms/unary-tycon.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/atoms/unary-tycon.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/atoms/use-name.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/atoms/var.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/atoms/var.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/atoms/word-x-vector.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/atoms/word-x-vector.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/atoms/word-x.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/atoms/word-x.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/backend/allocate-registers.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/backend/allocate-registers.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/backend/backend.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/backend/backend.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/backend/chunkify.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/backend/chunkify.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/backend/equivalence-graph.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/backend/equivalence-graph.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/backend/err.sml
U   mlton/branches/on-20050420-cmm-branch/mlton/backend/implement-handlers.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/backend/implement-handlers.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/backend/limit-check.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/backend/limit-check.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/backend/live.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/backend/live.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/backend/machine.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/backend/machine.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/backend/object-type.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/backend/packed-representation.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/backend/parallel-move.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/backend/parallel-move.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/backend/pointer-tycon.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/backend/pointer-tycon.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/backend/profile.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/backend/profile.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/backend/rep-type.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/backend/rep-type.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/backend/representation.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/backend/rssa.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/backend/rssa.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/backend/runtime.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/backend/runtime.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/backend/scale.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/backend/scale.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/backend/signal-check.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/backend/signal-check.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/backend/small-int-inf.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/backend/small-int-inf.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/backend/sources.cm
U   mlton/branches/on-20050420-cmm-branch/mlton/backend/sources.mlb
U   mlton/branches/on-20050420-cmm-branch/mlton/backend/ssa-to-rssa.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/backend/ssa-to-rssa.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/backend/switch.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/backend/switch.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/call-main.sml
U   mlton/branches/on-20050420-cmm-branch/mlton/closure-convert/abstract-value.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/closure-convert/abstract-value.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/closure-convert/closure-convert.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/closure-convert/closure-convert.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/closure-convert/globalize.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/closure-convert/globalize.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/closure-convert/lambda-free.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/closure-convert/lambda-free.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/closure-convert/sources.cm
U   mlton/branches/on-20050420-cmm-branch/mlton/closure-convert/sources.mlb
U   mlton/branches/on-20050420-cmm-branch/mlton/cm/cm.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/cm/cm.sml
U   mlton/branches/on-20050420-cmm-branch/mlton/cm/lexer.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/cm/lexer.sml
U   mlton/branches/on-20050420-cmm-branch/mlton/cm/parse.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/cm/parse.sml
U   mlton/branches/on-20050420-cmm-branch/mlton/cm/sources.cm
U   mlton/branches/on-20050420-cmm-branch/mlton/cm/sources.mlb
U   mlton/branches/on-20050420-cmm-branch/mlton/codegen/bytecode/bytecode.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/codegen/bytecode/bytecode.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/codegen/bytecode/sources.cm
U   mlton/branches/on-20050420-cmm-branch/mlton/codegen/bytecode/sources.mlb
U   mlton/branches/on-20050420-cmm-branch/mlton/codegen/c-codegen/c-codegen.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/codegen/c-codegen/c-codegen.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/codegen/c-codegen/sources.cm
U   mlton/branches/on-20050420-cmm-branch/mlton/codegen/c-codegen/sources.mlb
U   mlton/branches/on-20050420-cmm-branch/mlton/codegen/sources.cm
U   mlton/branches/on-20050420-cmm-branch/mlton/codegen/sources.mlb
U   mlton/branches/on-20050420-cmm-branch/mlton/codegen/x86-codegen/peephole.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/codegen/x86-codegen/peephole.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/codegen/x86-codegen/sources.cm
U   mlton/branches/on-20050420-cmm-branch/mlton/codegen/x86-codegen/sources.mlb
U   mlton/branches/on-20050420-cmm-branch/mlton/codegen/x86-codegen/x86-allocate-registers.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/codegen/x86-codegen/x86-allocate-registers.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/codegen/x86-codegen/x86-codegen.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/codegen/x86-codegen/x86-codegen.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/codegen/x86-codegen/x86-entry-transfer.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/codegen/x86-codegen/x86-entry-transfer.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/codegen/x86-codegen/x86-generate-transfers.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/codegen/x86-codegen/x86-generate-transfers.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/codegen/x86-codegen/x86-jump-info.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/codegen/x86-codegen/x86-jump-info.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/codegen/x86-codegen/x86-live-transfers.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/codegen/x86-codegen/x86-live-transfers.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/codegen/x86-codegen/x86-liveness.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/codegen/x86-codegen/x86-liveness.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/codegen/x86-codegen/x86-loop-info.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/codegen/x86-codegen/x86-loop-info.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/codegen/x86-codegen/x86-mlton-basic.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/codegen/x86-codegen/x86-mlton-basic.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/codegen/x86-codegen/x86-mlton.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/codegen/x86-codegen/x86-mlton.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/codegen/x86-codegen/x86-pseudo.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/codegen/x86-codegen/x86-simplify.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/codegen/x86-codegen/x86-simplify.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/codegen/x86-codegen/x86-translate.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/codegen/x86-codegen/x86-translate.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/codegen/x86-codegen/x86-validate.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/codegen/x86-codegen/x86-validate.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/codegen/x86-codegen/x86.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/codegen/x86-codegen/x86.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/control/bits.sml
A   mlton/branches/on-20050420-cmm-branch/mlton/control/control-flags.sig
A   mlton/branches/on-20050420-cmm-branch/mlton/control/control-flags.sml
U   mlton/branches/on-20050420-cmm-branch/mlton/control/control.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/control/control.sml
D   mlton/branches/on-20050420-cmm-branch/mlton/control/layout.sml
U   mlton/branches/on-20050420-cmm-branch/mlton/control/pretty.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/control/pretty.sml
U   mlton/branches/on-20050420-cmm-branch/mlton/control/region.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/control/region.sml
U   mlton/branches/on-20050420-cmm-branch/mlton/control/source-pos.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/control/source-pos.sml
U   mlton/branches/on-20050420-cmm-branch/mlton/control/source.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/control/source.sml
U   mlton/branches/on-20050420-cmm-branch/mlton/control/sources.cm
U   mlton/branches/on-20050420-cmm-branch/mlton/control/sources.mlb
U   mlton/branches/on-20050420-cmm-branch/mlton/control/system.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/control/system.sml
U   mlton/branches/on-20050420-cmm-branch/mlton/core-ml/core-ml.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/core-ml/core-ml.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/core-ml/dead-code.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/core-ml/dead-code.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/core-ml/sources.cm
U   mlton/branches/on-20050420-cmm-branch/mlton/core-ml/sources.mlb
U   mlton/branches/on-20050420-cmm-branch/mlton/defunctorize/defunctorize.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/defunctorize/defunctorize.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/defunctorize/sources.cm
U   mlton/branches/on-20050420-cmm-branch/mlton/defunctorize/sources.mlb
U   mlton/branches/on-20050420-cmm-branch/mlton/elaborate/decs.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/elaborate/decs.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/elaborate/elaborate-core.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/elaborate/elaborate-core.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/elaborate/elaborate-env.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/elaborate/elaborate-env.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/elaborate/elaborate-mlbs.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/elaborate/elaborate-mlbs.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/elaborate/elaborate-modules.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/elaborate/elaborate-modules.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/elaborate/elaborate-programs.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/elaborate/elaborate-programs.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/elaborate/elaborate-sigexp.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/elaborate/elaborate-sigexp.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/elaborate/elaborate.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/elaborate/elaborate.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/elaborate/interface.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/elaborate/interface.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/elaborate/precedence-parse.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/elaborate/precedence-parse.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/elaborate/scope.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/elaborate/scope.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/elaborate/sources.cm
U   mlton/branches/on-20050420-cmm-branch/mlton/elaborate/sources.mlb
U   mlton/branches/on-20050420-cmm-branch/mlton/elaborate/type-env.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/elaborate/type-env.sig
_U  mlton/branches/on-20050420-cmm-branch/mlton/front-end/
D   mlton/branches/on-20050420-cmm-branch/mlton/front-end/.cvsignore
A   mlton/branches/on-20050420-cmm-branch/mlton/front-end/.ignore
U   mlton/branches/on-20050420-cmm-branch/mlton/front-end/Makefile
U   mlton/branches/on-20050420-cmm-branch/mlton/front-end/front-end.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/front-end/front-end.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/front-end/import.cm
U   mlton/branches/on-20050420-cmm-branch/mlton/front-end/ml.grm
U   mlton/branches/on-20050420-cmm-branch/mlton/front-end/ml.lex
U   mlton/branches/on-20050420-cmm-branch/mlton/front-end/mlb-front-end.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/front-end/mlb-front-end.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/front-end/mlb.grm
U   mlton/branches/on-20050420-cmm-branch/mlton/front-end/mlb.lex
U   mlton/branches/on-20050420-cmm-branch/mlton/front-end/sources.cm
U   mlton/branches/on-20050420-cmm-branch/mlton/front-end/sources.mlb
U   mlton/branches/on-20050420-cmm-branch/mlton/main/compile.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/main/compile.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/main/lookup-constant.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/main/lookup-constant.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/main/main.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/main/main.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/main/main.sml
U   mlton/branches/on-20050420-cmm-branch/mlton/main/sources.cm
U   mlton/branches/on-20050420-cmm-branch/mlton/main/sources.mlb
U   mlton/branches/on-20050420-cmm-branch/mlton/match-compile/match-compile.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/match-compile/match-compile.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/match-compile/nested-pat.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/match-compile/nested-pat.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/match-compile/sources.cm
U   mlton/branches/on-20050420-cmm-branch/mlton/match-compile/sources.mlb
U   mlton/branches/on-20050420-cmm-branch/mlton/mlton-stubs.cm
U   mlton/branches/on-20050420-cmm-branch/mlton/mlton.cm
U   mlton/branches/on-20050420-cmm-branch/mlton/mlton.mlb
U   mlton/branches/on-20050420-cmm-branch/mlton/sources.cm
U   mlton/branches/on-20050420-cmm-branch/mlton/sources.mlb
U   mlton/branches/on-20050420-cmm-branch/mlton/ssa/analyze.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/ssa/analyze.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/ssa/analyze2.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/ssa/analyze2.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/ssa/common-arg.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/ssa/common-arg.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/ssa/common-block.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/ssa/common-block.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/ssa/common-subexp.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/ssa/common-subexp.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/ssa/constant-propagation.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/ssa/constant-propagation.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/ssa/contify.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/ssa/contify.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/ssa/deep-flatten.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/ssa/deep-flatten.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/ssa/direct-exp.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/ssa/direct-exp.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/ssa/direct-exp2.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/ssa/direct-exp2.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/ssa/equatable.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/ssa/equatable.sml
U   mlton/branches/on-20050420-cmm-branch/mlton/ssa/flat-lattice.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/ssa/flat-lattice.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/ssa/flatten.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/ssa/flatten.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/ssa/global.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/ssa/global.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/ssa/inline.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/ssa/inline.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/ssa/introduce-loops.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/ssa/introduce-loops.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/ssa/known-case.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/ssa/known-case.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/ssa/local-flatten.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/ssa/local-flatten.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/ssa/local-ref.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/ssa/local-ref.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/ssa/loop-invariant.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/ssa/loop-invariant.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/ssa/multi.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/ssa/multi.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/ssa/n-point-lattice.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/ssa/n-point-lattice.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/ssa/poly-equal.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/ssa/poly-equal.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/ssa/prepasses.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/ssa/prepasses.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/ssa/prepasses2.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/ssa/prepasses2.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/ssa/redundant-tests.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/ssa/redundant-tests.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/ssa/redundant.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/ssa/redundant.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/ssa/ref-flatten.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/ssa/ref-flatten.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/ssa/remove-unused.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/ssa/remove-unused.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/ssa/remove-unused2.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/ssa/remove-unused2.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/ssa/restore.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/ssa/restore.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/ssa/restore2.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/ssa/restore2.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/ssa/shrink.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/ssa/shrink.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/ssa/shrink2.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/ssa/shrink2.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/ssa/simplify-types.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/ssa/simplify-types.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/ssa/simplify.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/ssa/simplify.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/ssa/simplify2.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/ssa/simplify2.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/ssa/sources.cm
U   mlton/branches/on-20050420-cmm-branch/mlton/ssa/sources.mlb
U   mlton/branches/on-20050420-cmm-branch/mlton/ssa/ssa-to-ssa2.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/ssa/ssa-to-ssa2.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/ssa/ssa-tree.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/ssa/ssa-tree.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/ssa/ssa-tree2.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/ssa/ssa-tree2.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/ssa/ssa.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/ssa/ssa.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/ssa/ssa2.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/ssa/ssa2.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/ssa/three-point-lattice.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/ssa/three-point-lattice.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/ssa/two-point-lattice.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/ssa/two-point-lattice.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/ssa/type-check.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/ssa/type-check.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/ssa/type-check2.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/ssa/type-check2.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/ssa/useless.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/ssa/useless.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/ssa/zone.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/ssa/zone.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/xml/call-count.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/xml/call-count.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/xml/implement-exceptions.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/xml/implement-exceptions.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/xml/implement-suffix.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/xml/implement-suffix.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/xml/monomorphise.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/xml/monomorphise.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/xml/polyvariance.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/xml/polyvariance.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/xml/scc-funs.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/xml/scc-funs.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/xml/shrink.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/xml/shrink.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/xml/simplify-types.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/xml/simplify-types.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/xml/sources.cm
U   mlton/branches/on-20050420-cmm-branch/mlton/xml/sources.mlb
U   mlton/branches/on-20050420-cmm-branch/mlton/xml/sxml-exns.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/xml/sxml-simplify.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/xml/sxml-simplify.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/xml/sxml-tree.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/xml/sxml.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/xml/sxml.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/xml/type-check.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/xml/type-check.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/xml/uncurry.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/xml/uncurry.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/xml/xml-simplify.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/xml/xml-simplify.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/xml/xml-tree.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/xml/xml-tree.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/xml/xml-type.sig
U   mlton/branches/on-20050420-cmm-branch/mlton/xml/xml.fun
U   mlton/branches/on-20050420-cmm-branch/mlton/xml/xml.sig
_U  mlton/branches/on-20050420-cmm-branch/mlyacc/
D   mlton/branches/on-20050420-cmm-branch/mlyacc/.cvsignore
A   mlton/branches/on-20050420-cmm-branch/mlyacc/.ignore
U   mlton/branches/on-20050420-cmm-branch/mlyacc/INSTALL
U   mlton/branches/on-20050420-cmm-branch/mlyacc/Makefile
U   mlton/branches/on-20050420-cmm-branch/mlyacc/README
U   mlton/branches/on-20050420-cmm-branch/mlyacc/README.MLton
U   mlton/branches/on-20050420-cmm-branch/mlyacc/call-main.sml
_U  mlton/branches/on-20050420-cmm-branch/mlyacc/doc/
D   mlton/branches/on-20050420-cmm-branch/mlyacc/doc/.cvsignore
A   mlton/branches/on-20050420-cmm-branch/mlyacc/doc/.ignore
U   mlton/branches/on-20050420-cmm-branch/mlyacc/doc/Makefile
U   mlton/branches/on-20050420-cmm-branch/mlyacc/doc/mlyacc.tex
U   mlton/branches/on-20050420-cmm-branch/mlyacc/doc/tech.doc
U   mlton/branches/on-20050420-cmm-branch/mlyacc/examples/calc/README
U   mlton/branches/on-20050420-cmm-branch/mlyacc/examples/calc/calc.lex
A   mlton/branches/on-20050420-cmm-branch/mlyacc/examples/calc/calc.sml
U   mlton/branches/on-20050420-cmm-branch/mlyacc/examples/calc/sources.cm
U   mlton/branches/on-20050420-cmm-branch/mlyacc/examples/fol/README
U   mlton/branches/on-20050420-cmm-branch/mlyacc/examples/fol/absyn.sml
U   mlton/branches/on-20050420-cmm-branch/mlyacc/examples/fol/fol.grm
U   mlton/branches/on-20050420-cmm-branch/mlyacc/examples/fol/fol.lex
U   mlton/branches/on-20050420-cmm-branch/mlyacc/examples/fol/interface.sml
U   mlton/branches/on-20050420-cmm-branch/mlyacc/examples/fol/link.sml
D   mlton/branches/on-20050420-cmm-branch/mlyacc/examples/fol/load.sml
U   mlton/branches/on-20050420-cmm-branch/mlyacc/examples/fol/parse.sml
A   mlton/branches/on-20050420-cmm-branch/mlyacc/examples/fol/sources.cm
U   mlton/branches/on-20050420-cmm-branch/mlyacc/examples/pascal/README
D   mlton/branches/on-20050420-cmm-branch/mlyacc/examples/pascal/join.sml
D   mlton/branches/on-20050420-cmm-branch/mlyacc/examples/pascal/load.sml
A   mlton/branches/on-20050420-cmm-branch/mlyacc/examples/pascal/parser.sml
U   mlton/branches/on-20050420-cmm-branch/mlyacc/examples/pascal/pascal.grm
U   mlton/branches/on-20050420-cmm-branch/mlyacc/examples/pascal/pascal.lex
A   mlton/branches/on-20050420-cmm-branch/mlyacc/examples/pascal/sources.cm
U   mlton/branches/on-20050420-cmm-branch/mlyacc/main.sml
U   mlton/branches/on-20050420-cmm-branch/mlyacc/mlyacc.cm
U   mlton/branches/on-20050420-cmm-branch/mlyacc/mlyacc.mlb
U   mlton/branches/on-20050420-cmm-branch/mlyacc/sources.cm
U   mlton/branches/on-20050420-cmm-branch/mlyacc/sources.mlb
_U  mlton/branches/on-20050420-cmm-branch/mlyacc/src/
D   mlton/branches/on-20050420-cmm-branch/mlyacc/src/.cvsignore
A   mlton/branches/on-20050420-cmm-branch/mlyacc/src/.ignore
U   mlton/branches/on-20050420-cmm-branch/mlyacc/src/absyn.sig
U   mlton/branches/on-20050420-cmm-branch/mlyacc/src/absyn.sml
U   mlton/branches/on-20050420-cmm-branch/mlyacc/src/core.sml
U   mlton/branches/on-20050420-cmm-branch/mlyacc/src/coreutils.sml
U   mlton/branches/on-20050420-cmm-branch/mlyacc/src/export-yacc.sml
U   mlton/branches/on-20050420-cmm-branch/mlyacc/src/grammar.sml
U   mlton/branches/on-20050420-cmm-branch/mlyacc/src/graph.sml
U   mlton/branches/on-20050420-cmm-branch/mlyacc/src/hdr.sml
U   mlton/branches/on-20050420-cmm-branch/mlyacc/src/lalr.sml
U   mlton/branches/on-20050420-cmm-branch/mlyacc/src/link.sml
D   mlton/branches/on-20050420-cmm-branch/mlyacc/src/load
U   mlton/branches/on-20050420-cmm-branch/mlyacc/src/look.sml
U   mlton/branches/on-20050420-cmm-branch/mlyacc/src/mklrtable.sml
U   mlton/branches/on-20050420-cmm-branch/mlyacc/src/mkprstruct.sml
U   mlton/branches/on-20050420-cmm-branch/mlyacc/src/parse.sml
U   mlton/branches/on-20050420-cmm-branch/mlyacc/src/shrink.sml
U   mlton/branches/on-20050420-cmm-branch/mlyacc/src/sigs.sml
U   mlton/branches/on-20050420-cmm-branch/mlyacc/src/sources.mlb
U   mlton/branches/on-20050420-cmm-branch/mlyacc/src/utils.sig
U   mlton/branches/on-20050420-cmm-branch/mlyacc/src/utils.sml
U   mlton/branches/on-20050420-cmm-branch/mlyacc/src/verbose.sml
U   mlton/branches/on-20050420-cmm-branch/mlyacc/src/yacc.grm
U   mlton/branches/on-20050420-cmm-branch/mlyacc/src/yacc.lex
U   mlton/branches/on-20050420-cmm-branch/mlyacc/src/yacc.sml
A   mlton/branches/on-20050420-cmm-branch/package/
_U  mlton/branches/on-20050420-cmm-branch/package/debian/
_U  mlton/branches/on-20050420-cmm-branch/regression/
D   mlton/branches/on-20050420-cmm-branch/regression/.cvsignore
A   mlton/branches/on-20050420-cmm-branch/regression/.ignore
U   mlton/branches/on-20050420-cmm-branch/regression/7.sml
U   mlton/branches/on-20050420-cmm-branch/regression/FuhMishra.sml
U   mlton/branches/on-20050420-cmm-branch/regression/Makefile
U   mlton/branches/on-20050420-cmm-branch/regression/README
U   mlton/branches/on-20050420-cmm-branch/regression/README.kit
U   mlton/branches/on-20050420-cmm-branch/regression/array.sml
U   mlton/branches/on-20050420-cmm-branch/regression/array2.sml
U   mlton/branches/on-20050420-cmm-branch/regression/array5.sml
U   mlton/branches/on-20050420-cmm-branch/regression/array6.sml
U   mlton/branches/on-20050420-cmm-branch/regression/array7.sml
U   mlton/branches/on-20050420-cmm-branch/regression/bytechar.sml
U   mlton/branches/on-20050420-cmm-branch/regression/callcc2.sml
U   mlton/branches/on-20050420-cmm-branch/regression/callcc3.sml
U   mlton/branches/on-20050420-cmm-branch/regression/char.scan.sml
U   mlton/branches/on-20050420-cmm-branch/regression/check_arrays.sml
U   mlton/branches/on-20050420-cmm-branch/regression/cmdline.sml
U   mlton/branches/on-20050420-cmm-branch/regression/cobol.sml
U   mlton/branches/on-20050420-cmm-branch/regression/constraint.sml
U   mlton/branches/on-20050420-cmm-branch/regression/conv.sml
U   mlton/branches/on-20050420-cmm-branch/regression/conv2.sml
U   mlton/branches/on-20050420-cmm-branch/regression/datatype-with-free-tyvars.sml
U   mlton/branches/on-20050420-cmm-branch/regression/date.sml
U   mlton/branches/on-20050420-cmm-branch/regression/deep-flatten.sml
U   mlton/branches/on-20050420-cmm-branch/regression/echo.sml
U   mlton/branches/on-20050420-cmm-branch/regression/eqtype.sml
U   mlton/branches/on-20050420-cmm-branch/regression/ex.sml
U   mlton/branches/on-20050420-cmm-branch/regression/exnHistory.ok
U   mlton/branches/on-20050420-cmm-branch/regression/exnHistory.sml
U   mlton/branches/on-20050420-cmm-branch/regression/exnHistory3.ok
U   mlton/branches/on-20050420-cmm-branch/regression/exnHistory3.sml
_U  mlton/branches/on-20050420-cmm-branch/regression/fail/
D   mlton/branches/on-20050420-cmm-branch/regression/fail/.cvsignore
A   mlton/branches/on-20050420-cmm-branch/regression/fail/.ignore
U   mlton/branches/on-20050420-cmm-branch/regression/fail/eqtype.1.sml
U   mlton/branches/on-20050420-cmm-branch/regression/fail/functor.1.sml
U   mlton/branches/on-20050420-cmm-branch/regression/fail/modules.15.sml
U   mlton/branches/on-20050420-cmm-branch/regression/fail/modules.16.sml
U   mlton/branches/on-20050420-cmm-branch/regression/fail/modules.17.sml
U   mlton/branches/on-20050420-cmm-branch/regression/fail/modules.18.sml
U   mlton/branches/on-20050420-cmm-branch/regression/fail/modules.19.sml
U   mlton/branches/on-20050420-cmm-branch/regression/fail/modules.23.sml
U   mlton/branches/on-20050420-cmm-branch/regression/fail/modules.25.sml
U   mlton/branches/on-20050420-cmm-branch/regression/fail/modules.3.sml
U   mlton/branches/on-20050420-cmm-branch/regression/fail/modules.40.sml
U   mlton/branches/on-20050420-cmm-branch/regression/fail/modules.49.sml
U   mlton/branches/on-20050420-cmm-branch/regression/fail/modules.50.sml
U   mlton/branches/on-20050420-cmm-branch/regression/fail/modules.51.sml
U   mlton/branches/on-20050420-cmm-branch/regression/fail/rank.sml
U   mlton/branches/on-20050420-cmm-branch/regression/fail/sharing.2.sml
U   mlton/branches/on-20050420-cmm-branch/regression/fast.sml
U   mlton/branches/on-20050420-cmm-branch/regression/fast2.sml
U   mlton/branches/on-20050420-cmm-branch/regression/ffi-opaque.sml
U   mlton/branches/on-20050420-cmm-branch/regression/fft.sml
U   mlton/branches/on-20050420-cmm-branch/regression/filesys.sml
A   mlton/branches/on-20050420-cmm-branch/regression/filesys.x86-cygwin.ok
U   mlton/branches/on-20050420-cmm-branch/regression/finalize.2.sml
A   mlton/branches/on-20050420-cmm-branch/regression/finalize.3.ok
A   mlton/branches/on-20050420-cmm-branch/regression/finalize.3.sml
A   mlton/branches/on-20050420-cmm-branch/regression/finalize.4.ok
A   mlton/branches/on-20050420-cmm-branch/regression/finalize.4.sml
A   mlton/branches/on-20050420-cmm-branch/regression/finalize.5.ok
A   mlton/branches/on-20050420-cmm-branch/regression/finalize.5.sml
U   mlton/branches/on-20050420-cmm-branch/regression/finalize.sml
U   mlton/branches/on-20050420-cmm-branch/regression/fixed-integer.sml
U   mlton/branches/on-20050420-cmm-branch/regression/flat-array.2.sml
U   mlton/branches/on-20050420-cmm-branch/regression/flat-array.sml
U   mlton/branches/on-20050420-cmm-branch/regression/flexrecord.sml
U   mlton/branches/on-20050420-cmm-branch/regression/format.sml
U   mlton/branches/on-20050420-cmm-branch/regression/functor.sml
U   mlton/branches/on-20050420-cmm-branch/regression/general.sml
U   mlton/branches/on-20050420-cmm-branch/regression/generate/all-overloads.sml
U   mlton/branches/on-20050420-cmm-branch/regression/harmonic.sml
U   mlton/branches/on-20050420-cmm-branch/regression/int-inf.1.sml
U   mlton/branches/on-20050420-cmm-branch/regression/int-inf.2.sml
U   mlton/branches/on-20050420-cmm-branch/regression/int-inf.4.sml
U   mlton/branches/on-20050420-cmm-branch/regression/int-inf.5.sml
U   mlton/branches/on-20050420-cmm-branch/regression/int-inf.bitops.sml
U   mlton/branches/on-20050420-cmm-branch/regression/int-inf.compare.sml
U   mlton/branches/on-20050420-cmm-branch/regression/int.sml
U   mlton/branches/on-20050420-cmm-branch/regression/kitkbjul9.sml
U   mlton/branches/on-20050420-cmm-branch/regression/kitlife35u.sml
U   mlton/branches/on-20050420-cmm-branch/regression/kitmandelbrot.sml
U   mlton/branches/on-20050420-cmm-branch/regression/kitqsort.sml
U   mlton/branches/on-20050420-cmm-branch/regression/kitreynolds2.sml
U   mlton/branches/on-20050420-cmm-branch/regression/kitsimple.sml
U   mlton/branches/on-20050420-cmm-branch/regression/kkb36c.sml
U   mlton/branches/on-20050420-cmm-branch/regression/kkb_eq.sml
U   mlton/branches/on-20050420-cmm-branch/regression/klife_eq.sml
U   mlton/branches/on-20050420-cmm-branch/regression/lambda-list-ref.sml
U   mlton/branches/on-20050420-cmm-branch/regression/lib.sml
U   mlton/branches/on-20050420-cmm-branch/regression/life.sml
U   mlton/branches/on-20050420-cmm-branch/regression/list.sml
U   mlton/branches/on-20050420-cmm-branch/regression/listpair.sml
U   mlton/branches/on-20050420-cmm-branch/regression/llv.sml
U   mlton/branches/on-20050420-cmm-branch/regression/local-ref.sml
U   mlton/branches/on-20050420-cmm-branch/regression/math.sml
U   mlton/branches/on-20050420-cmm-branch/regression/mlton.share.sml
U   mlton/branches/on-20050420-cmm-branch/regression/mlton.word.sml
U   mlton/branches/on-20050420-cmm-branch/regression/modules.sml
U   mlton/branches/on-20050420-cmm-branch/regression/mutex.sml
U   mlton/branches/on-20050420-cmm-branch/regression/nested-loop.sml
U   mlton/branches/on-20050420-cmm-branch/regression/nonexhaustive.sml
U   mlton/branches/on-20050420-cmm-branch/regression/once.sml
U   mlton/branches/on-20050420-cmm-branch/regression/opaque.sml
U   mlton/branches/on-20050420-cmm-branch/regression/opaque2.sml
U   mlton/branches/on-20050420-cmm-branch/regression/os-exit.sml
U   mlton/branches/on-20050420-cmm-branch/regression/pack-real.sml
U   mlton/branches/on-20050420-cmm-branch/regression/pack-word.sml
U   mlton/branches/on-20050420-cmm-branch/regression/poly-equal.2.sml
U   mlton/branches/on-20050420-cmm-branch/regression/poly-equal.sml
U   mlton/branches/on-20050420-cmm-branch/regression/polymorphic-recursion.sml
U   mlton/branches/on-20050420-cmm-branch/regression/posix-exit.sml
U   mlton/branches/on-20050420-cmm-branch/regression/prodcons.sml
U   mlton/branches/on-20050420-cmm-branch/regression/pseudokit.sml
U   mlton/branches/on-20050420-cmm-branch/regression/real.sml
U   mlton/branches/on-20050420-cmm-branch/regression/ref-flatten.2.sml
U   mlton/branches/on-20050420-cmm-branch/regression/ref-flatten.3.sml
U   mlton/branches/on-20050420-cmm-branch/regression/ref-flatten.4.sml
U   mlton/branches/on-20050420-cmm-branch/regression/ref-flatten.5.sml
A   mlton/branches/on-20050420-cmm-branch/regression/ref-flatten.6.ok
A   mlton/branches/on-20050420-cmm-branch/regression/ref-flatten.6.sml
U   mlton/branches/on-20050420-cmm-branch/regression/ref-flatten.sml
U   mlton/branches/on-20050420-cmm-branch/regression/ring.sml
U   mlton/branches/on-20050420-cmm-branch/regression/same-fringe.sml
U   mlton/branches/on-20050420-cmm-branch/regression/serialize.sml
U   mlton/branches/on-20050420-cmm-branch/regression/sharing.sml
U   mlton/branches/on-20050420-cmm-branch/regression/signals.sml
U   mlton/branches/on-20050420-cmm-branch/regression/signals2.sml
U   mlton/branches/on-20050420-cmm-branch/regression/sigs.sml
U   mlton/branches/on-20050420-cmm-branch/regression/size.sml
U   mlton/branches/on-20050420-cmm-branch/regression/slow.sml
U   mlton/branches/on-20050420-cmm-branch/regression/slow2.sml
U   mlton/branches/on-20050420-cmm-branch/regression/slower.sml
U   mlton/branches/on-20050420-cmm-branch/regression/smith-normal-form.sml
U   mlton/branches/on-20050420-cmm-branch/regression/socket.sml
U   mlton/branches/on-20050420-cmm-branch/regression/string.fromString.sml
U   mlton/branches/on-20050420-cmm-branch/regression/string.sml
U   mlton/branches/on-20050420-cmm-branch/regression/string2.sml
U   mlton/branches/on-20050420-cmm-branch/regression/stringcvt.sml
U   mlton/branches/on-20050420-cmm-branch/regression/substring.sml
U   mlton/branches/on-20050420-cmm-branch/regression/suspend.sml
U   mlton/branches/on-20050420-cmm-branch/regression/tak.sml
U   mlton/branches/on-20050420-cmm-branch/regression/testdyn1.sml
U   mlton/branches/on-20050420-cmm-branch/regression/textio.sml
U   mlton/branches/on-20050420-cmm-branch/regression/thread-switch.sml
U   mlton/branches/on-20050420-cmm-branch/regression/thread0.sml
U   mlton/branches/on-20050420-cmm-branch/regression/thread1.sml
U   mlton/branches/on-20050420-cmm-branch/regression/thread2.sml
U   mlton/branches/on-20050420-cmm-branch/regression/time.sml
U   mlton/branches/on-20050420-cmm-branch/regression/time3.sml
A   mlton/branches/on-20050420-cmm-branch/regression/time4.ok
A   mlton/branches/on-20050420-cmm-branch/regression/time4.sml
U   mlton/branches/on-20050420-cmm-branch/regression/timeout.sml
U   mlton/branches/on-20050420-cmm-branch/regression/tststrcmp.sml
U   mlton/branches/on-20050420-cmm-branch/regression/unary.2.sml
U   mlton/branches/on-20050420-cmm-branch/regression/unixpath.sml
A   mlton/branches/on-20050420-cmm-branch/regression/unixpath.x86-cygwin.ok
U   mlton/branches/on-20050420-cmm-branch/regression/useless-string.sml
U   mlton/branches/on-20050420-cmm-branch/regression/vector.sml
U   mlton/branches/on-20050420-cmm-branch/regression/vector4.sml
U   mlton/branches/on-20050420-cmm-branch/regression/weak.sml
U   mlton/branches/on-20050420-cmm-branch/regression/where.sml
U   mlton/branches/on-20050420-cmm-branch/regression/word-all.sml
U   mlton/branches/on-20050420-cmm-branch/regression/word.sml
U   mlton/branches/on-20050420-cmm-branch/regression/word8array.sml
U   mlton/branches/on-20050420-cmm-branch/regression/word8vector.sml
U   mlton/branches/on-20050420-cmm-branch/regression/world1.sml
U   mlton/branches/on-20050420-cmm-branch/regression/world2.sml
U   mlton/branches/on-20050420-cmm-branch/regression/world3.sml
U   mlton/branches/on-20050420-cmm-branch/regression/world4.sml
U   mlton/branches/on-20050420-cmm-branch/regression/world5.sml
U   mlton/branches/on-20050420-cmm-branch/regression/world6.sml
_U  mlton/branches/on-20050420-cmm-branch/runtime/
D   mlton/branches/on-20050420-cmm-branch/runtime/.cvsignore
A   mlton/branches/on-20050420-cmm-branch/runtime/.ignore
U   mlton/branches/on-20050420-cmm-branch/runtime/Makefile
U   mlton/branches/on-20050420-cmm-branch/runtime/Posix/Error.c
U   mlton/branches/on-20050420-cmm-branch/runtime/Posix/FileSys/Dirstream.c
U   mlton/branches/on-20050420-cmm-branch/runtime/Posix/FileSys/ST.c
U   mlton/branches/on-20050420-cmm-branch/runtime/Posix/FileSys/Stat.c
U   mlton/branches/on-20050420-cmm-branch/runtime/Posix/FileSys/Utimbuf.c
U   mlton/branches/on-20050420-cmm-branch/runtime/Posix/FileSys/access.c
U   mlton/branches/on-20050420-cmm-branch/runtime/Posix/FileSys/chdir.c
U   mlton/branches/on-20050420-cmm-branch/runtime/Posix/FileSys/chmod.c
U   mlton/branches/on-20050420-cmm-branch/runtime/Posix/FileSys/chown.c
U   mlton/branches/on-20050420-cmm-branch/runtime/Posix/FileSys/fchmod.c
U   mlton/branches/on-20050420-cmm-branch/runtime/Posix/FileSys/fchown.c
U   mlton/branches/on-20050420-cmm-branch/runtime/Posix/FileSys/fpathconf.c
U   mlton/branches/on-20050420-cmm-branch/runtime/Posix/FileSys/ftruncate.c
U   mlton/branches/on-20050420-cmm-branch/runtime/Posix/FileSys/getcwd.c
U   mlton/branches/on-20050420-cmm-branch/runtime/Posix/FileSys/link.c
U   mlton/branches/on-20050420-cmm-branch/runtime/Posix/FileSys/mkdir.c
U   mlton/branches/on-20050420-cmm-branch/runtime/Posix/FileSys/mkfifo.c
U   mlton/branches/on-20050420-cmm-branch/runtime/Posix/FileSys/open.c
U   mlton/branches/on-20050420-cmm-branch/runtime/Posix/FileSys/pathconf.c
U   mlton/branches/on-20050420-cmm-branch/runtime/Posix/FileSys/readlink.c
U   mlton/branches/on-20050420-cmm-branch/runtime/Posix/FileSys/rename.c
U   mlton/branches/on-20050420-cmm-branch/runtime/Posix/FileSys/rmdir.c
U   mlton/branches/on-20050420-cmm-branch/runtime/Posix/FileSys/symlink.c
U   mlton/branches/on-20050420-cmm-branch/runtime/Posix/FileSys/umask.c
U   mlton/branches/on-20050420-cmm-branch/runtime/Posix/FileSys/unlink.c
U   mlton/branches/on-20050420-cmm-branch/runtime/Posix/IO/FLock.c
U   mlton/branches/on-20050420-cmm-branch/runtime/Posix/IO/close.c
U   mlton/branches/on-20050420-cmm-branch/runtime/Posix/IO/dup.c
U   mlton/branches/on-20050420-cmm-branch/runtime/Posix/IO/dup2.c
U   mlton/branches/on-20050420-cmm-branch/runtime/Posix/IO/fcntl2.c
U   mlton/branches/on-20050420-cmm-branch/runtime/Posix/IO/fcntl3.c
U   mlton/branches/on-20050420-cmm-branch/runtime/Posix/IO/fsync.c
U   mlton/branches/on-20050420-cmm-branch/runtime/Posix/IO/lseek.c
U   mlton/branches/on-20050420-cmm-branch/runtime/Posix/IO/pipe.c
U   mlton/branches/on-20050420-cmm-branch/runtime/Posix/IO/read.c
U   mlton/branches/on-20050420-cmm-branch/runtime/Posix/IO/write.c
U   mlton/branches/on-20050420-cmm-branch/runtime/Posix/ProcEnv/ProcEnv.c
U   mlton/branches/on-20050420-cmm-branch/runtime/Posix/ProcEnv/Tms.c
U   mlton/branches/on-20050420-cmm-branch/runtime/Posix/ProcEnv/Uname.c
U   mlton/branches/on-20050420-cmm-branch/runtime/Posix/ProcEnv/getenv.c
U   mlton/branches/on-20050420-cmm-branch/runtime/Posix/ProcEnv/getgroups.c
U   mlton/branches/on-20050420-cmm-branch/runtime/Posix/ProcEnv/getlogin.c
U   mlton/branches/on-20050420-cmm-branch/runtime/Posix/ProcEnv/getpgrp.c
U   mlton/branches/on-20050420-cmm-branch/runtime/Posix/ProcEnv/isatty.c
U   mlton/branches/on-20050420-cmm-branch/runtime/Posix/ProcEnv/setenv.c
A   mlton/branches/on-20050420-cmm-branch/runtime/Posix/ProcEnv/setgroups.c
U   mlton/branches/on-20050420-cmm-branch/runtime/Posix/ProcEnv/sysconf.c
U   mlton/branches/on-20050420-cmm-branch/runtime/Posix/ProcEnv/ttyname.c
U   mlton/branches/on-20050420-cmm-branch/runtime/Posix/Process/alarm.c
U   mlton/branches/on-20050420-cmm-branch/runtime/Posix/Process/exece.c
U   mlton/branches/on-20050420-cmm-branch/runtime/Posix/Process/execp.c
U   mlton/branches/on-20050420-cmm-branch/runtime/Posix/Process/exit.c
U   mlton/branches/on-20050420-cmm-branch/runtime/Posix/Process/exitStatus.c
U   mlton/branches/on-20050420-cmm-branch/runtime/Posix/Process/fork.c
U   mlton/branches/on-20050420-cmm-branch/runtime/Posix/Process/ifExited.c
U   mlton/branches/on-20050420-cmm-branch/runtime/Posix/Process/ifSignaled.c
U   mlton/branches/on-20050420-cmm-branch/runtime/Posix/Process/ifStopped.c
U   mlton/branches/on-20050420-cmm-branch/runtime/Posix/Process/kill.c
A   mlton/branches/on-20050420-cmm-branch/runtime/Posix/Process/nanosleep.c
U   mlton/branches/on-20050420-cmm-branch/runtime/Posix/Process/pause.c
U   mlton/branches/on-20050420-cmm-branch/runtime/Posix/Process/sleep.c
U   mlton/branches/on-20050420-cmm-branch/runtime/Posix/Process/stopSig.c
A   mlton/branches/on-20050420-cmm-branch/runtime/Posix/Process/system.c
U   mlton/branches/on-20050420-cmm-branch/runtime/Posix/Process/termSig.c
U   mlton/branches/on-20050420-cmm-branch/runtime/Posix/Process/waitpid.c
U   mlton/branches/on-20050420-cmm-branch/runtime/Posix/Signal.c
U   mlton/branches/on-20050420-cmm-branch/runtime/Posix/SysDB/Group.c
U   mlton/branches/on-20050420-cmm-branch/runtime/Posix/SysDB/Passwd.c
U   mlton/branches/on-20050420-cmm-branch/runtime/Posix/TTY.c
U   mlton/branches/on-20050420-cmm-branch/runtime/assert.h
U   mlton/branches/on-20050420-cmm-branch/runtime/basis/Array/numElements.c
U   mlton/branches/on-20050420-cmm-branch/runtime/basis/Date.c
U   mlton/branches/on-20050420-cmm-branch/runtime/basis/Debug.c
U   mlton/branches/on-20050420-cmm-branch/runtime/basis/GC.c
U   mlton/branches/on-20050420-cmm-branch/runtime/basis/IEEEReal.c
U   mlton/branches/on-20050420-cmm-branch/runtime/basis/Int/Word.c
U   mlton/branches/on-20050420-cmm-branch/runtime/basis/Int/Word8Array.c
U   mlton/branches/on-20050420-cmm-branch/runtime/basis/Int/Word8Vector.c
U   mlton/branches/on-20050420-cmm-branch/runtime/basis/IntInf.c
U   mlton/branches/on-20050420-cmm-branch/runtime/basis/Itimer/set.c
U   mlton/branches/on-20050420-cmm-branch/runtime/basis/MLton/allocTooLarge.c
U   mlton/branches/on-20050420-cmm-branch/runtime/basis/MLton/bug.c
U   mlton/branches/on-20050420-cmm-branch/runtime/basis/MLton/errno.c
U   mlton/branches/on-20050420-cmm-branch/runtime/basis/MLton/exit.c
U   mlton/branches/on-20050420-cmm-branch/runtime/basis/MLton/profile.c
U   mlton/branches/on-20050420-cmm-branch/runtime/basis/MLton/rlimit.c
U   mlton/branches/on-20050420-cmm-branch/runtime/basis/MLton/rusage.c
U   mlton/branches/on-20050420-cmm-branch/runtime/basis/MLton/share.c
U   mlton/branches/on-20050420-cmm-branch/runtime/basis/MLton/size.c
U   mlton/branches/on-20050420-cmm-branch/runtime/basis/MLton/spawne.c
U   mlton/branches/on-20050420-cmm-branch/runtime/basis/MLton/spawnp.c
U   mlton/branches/on-20050420-cmm-branch/runtime/basis/MLton/world.c
U   mlton/branches/on-20050420-cmm-branch/runtime/basis/Net/Net.c
U   mlton/branches/on-20050420-cmm-branch/runtime/basis/Net/NetHostDB.c
U   mlton/branches/on-20050420-cmm-branch/runtime/basis/Net/NetProtDB.c
U   mlton/branches/on-20050420-cmm-branch/runtime/basis/Net/NetServDB.c
U   mlton/branches/on-20050420-cmm-branch/runtime/basis/Net/Socket/INetSock.c
U   mlton/branches/on-20050420-cmm-branch/runtime/basis/Net/Socket/Socket.c
U   mlton/branches/on-20050420-cmm-branch/runtime/basis/Net/Socket/UnixSock.c
U   mlton/branches/on-20050420-cmm-branch/runtime/basis/OS/IO/poll.c
U   mlton/branches/on-20050420-cmm-branch/runtime/basis/PackReal.c
U   mlton/branches/on-20050420-cmm-branch/runtime/basis/Ptrace.c
U   mlton/branches/on-20050420-cmm-branch/runtime/basis/Real/Math.c
U   mlton/branches/on-20050420-cmm-branch/runtime/basis/Real/class.c
U   mlton/branches/on-20050420-cmm-branch/runtime/basis/Real/frexp.c
U   mlton/branches/on-20050420-cmm-branch/runtime/basis/Real/gdtoa.c
U   mlton/branches/on-20050420-cmm-branch/runtime/basis/Real/modf.c
U   mlton/branches/on-20050420-cmm-branch/runtime/basis/Real/nextAfter.c
U   mlton/branches/on-20050420-cmm-branch/runtime/basis/Real/real.c
U   mlton/branches/on-20050420-cmm-branch/runtime/basis/Real/signBit.c
U   mlton/branches/on-20050420-cmm-branch/runtime/basis/Real/strto.c
U   mlton/branches/on-20050420-cmm-branch/runtime/basis/Stdio.c
U   mlton/branches/on-20050420-cmm-branch/runtime/basis/Thread.c
U   mlton/branches/on-20050420-cmm-branch/runtime/basis/Time.c
U   mlton/branches/on-20050420-cmm-branch/runtime/gc.c
U   mlton/branches/on-20050420-cmm-branch/runtime/gc.h
_U  mlton/branches/on-20050420-cmm-branch/runtime/gdtoa.tgz
U   mlton/branches/on-20050420-cmm-branch/runtime/platform/cygwin.c
U   mlton/branches/on-20050420-cmm-branch/runtime/platform/cygwin.h
U   mlton/branches/on-20050420-cmm-branch/runtime/platform/darwin.c
U   mlton/branches/on-20050420-cmm-branch/runtime/platform/darwin.h
A   mlton/branches/on-20050420-cmm-branch/runtime/platform/feround.c
A   mlton/branches/on-20050420-cmm-branch/runtime/platform/feround.h
U   mlton/branches/on-20050420-cmm-branch/runtime/platform/freebsd.c
U   mlton/branches/on-20050420-cmm-branch/runtime/platform/freebsd.h
U   mlton/branches/on-20050420-cmm-branch/runtime/platform/getText.c
U   mlton/branches/on-20050420-cmm-branch/runtime/platform/getrusage.c
U   mlton/branches/on-20050420-cmm-branch/runtime/platform/linux.c
U   mlton/branches/on-20050420-cmm-branch/runtime/platform/linux.h
U   mlton/branches/on-20050420-cmm-branch/runtime/platform/mingw.c
U   mlton/branches/on-20050420-cmm-branch/runtime/platform/mingw.h
U   mlton/branches/on-20050420-cmm-branch/runtime/platform/mkdir2.c
U   mlton/branches/on-20050420-cmm-branch/runtime/platform/mmap.c
U   mlton/branches/on-20050420-cmm-branch/runtime/platform/netbsd.c
U   mlton/branches/on-20050420-cmm-branch/runtime/platform/netbsd.h
U   mlton/branches/on-20050420-cmm-branch/runtime/platform/openbsd.c
U   mlton/branches/on-20050420-cmm-branch/runtime/platform/openbsd.h
U   mlton/branches/on-20050420-cmm-branch/runtime/platform/release.virtual.c
U   mlton/branches/on-20050420-cmm-branch/runtime/platform/showMem.linux.c
A   mlton/branches/on-20050420-cmm-branch/runtime/platform/signbit.c
U   mlton/branches/on-20050420-cmm-branch/runtime/platform/solaris.c
U   mlton/branches/on-20050420-cmm-branch/runtime/platform/solaris.h
U   mlton/branches/on-20050420-cmm-branch/runtime/platform/ssmmap.c
U   mlton/branches/on-20050420-cmm-branch/runtime/platform/totalRam.sysconf.c
U   mlton/branches/on-20050420-cmm-branch/runtime/platform/totalRam.sysctl.c
U   mlton/branches/on-20050420-cmm-branch/runtime/platform/use-mmap.c
U   mlton/branches/on-20050420-cmm-branch/runtime/platform/windows.c
U   mlton/branches/on-20050420-cmm-branch/runtime/platform.c
U   mlton/branches/on-20050420-cmm-branch/runtime/platform.h
U   mlton/branches/on-20050420-cmm-branch/runtime/types.h
A   mlton/branches/on-20050420-cmm-branch/util/

----------------------------------------------------------------------


Property changes on: mlton/branches/on-20050420-cmm-branch
___________________________________________________________________
Name: svn:ignore
   - build
build-stamp
configure-stamp
install
regression-log
rpms
runtime-log
   + build
build-stamp
configure-stamp
install
regression-log
rpms
runtime-log


Deleted: mlton/branches/on-20050420-cmm-branch/.cvsignore
===================================================================
--- mlton/branches/on-20050420-cmm-branch/.cvsignore	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/.cvsignore	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,7 +0,0 @@
-build
-build-stamp
-configure-stamp
-install
-regression-log
-rpms
-runtime-log

Copied: mlton/branches/on-20050420-cmm-branch/.ignore (from rev 4358, mlton/trunk/.ignore)

Modified: mlton/branches/on-20050420-cmm-branch/Makefile
===================================================================
--- mlton/branches/on-20050420-cmm-branch/Makefile	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/Makefile	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,11 @@
+## Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ #    Jagannathan, and Stephen Weeks.
+ # Copyright (C) 1997-2000 NEC Research Institute.
+ #
+ # MLton is released under a BSD-style license.
+ # See the file MLton-LICENSE for details.
+ ##
+
 export TARGET = self
 export TARGET_ARCH = $(shell bin/host-arch)
 export TARGET_OS = $(shell bin/host-os)
@@ -6,39 +14,56 @@
 SRC = $(ROOT)
 BIN = $(BUILD)/bin
 LIB = $(BUILD)/lib
+INC = $(LIB)/include
 COMP = $(SRC)/mlton
 RUN = $(SRC)/runtime
 MLTON = $(BIN)/mlton
 AOUT = mlton-compile
+ifeq (mingw, $(TARGET_OS))
+EXE = .exe
+else
+EXE =
+endif
 MLBPATHMAP = $(LIB)/mlb-path-map
 TARGETMAP = $(LIB)/target-map
-SPEC = $(SRC)/doc/mlton.spec
+SPEC = package/rpm/mlton.spec
 LEX = mllex
 PROF = mlprof
 YACC = mlyacc
+NLFFIGEN = mlnlffigen
 PATH = $(BIN):$(SRC)/bin:$(shell echo $$PATH)
 CP = /bin/cp -fpR
 GZIP = gzip --force --best
 RANLIB = ranlib
 
-VERSION = $(shell date +%Y%m%d)
-RELEASE = 1
+# If we're compiling with another version of MLton, then we want to do
+# another round of compilation so that we get a MLton built without
+# stubs.
+ifeq (other, $(shell if [ ! -x $(BIN)/mlton ]; then echo other; fi))
+	BOOTSTRAP_OTHER=true
+else
+	BOOTSTRAP_OTHER=false
+endif
 
+VERSION ?= $(shell date +%Y%m%d)
+RELEASE ?= 1
+
 .PHONY: all
 all:
 	$(MAKE) docs all-no-docs
 
 .PHONY: all-no-docs
 all-no-docs:
-	$(MAKE) dirs runtime compiler world-no-check
-# If we're compiling with another version of MLton, then we want to do
-# another round of compilation so that we get a MLton built without
-# stubs.  Remove $(AOUT) so that the $(MAKE) compiler below will
-# remake MLton.
-ifeq (other, $(shell if [ ! -x $(BIN)/mlton ]; then echo other; fi))
-	rm -f $(COMP)/$(AOUT)
+	$(MAKE) dirs runtime compiler world-no-check script mlbpathmap targetmap constants libraries tools
+# Remove $(AOUT) so that the $(MAKE) compiler below will remake MLton.
+# We also want to re-run the just-built tools (mllex and mlyacc)
+# because they may be better than those that were used for the first
+# round of compilation.  So, we clean out the front end.
+ifeq (true, $(BOOTSTRAP_OTHER))
+	rm -f $(COMP)/$(AOUT)$(EXE)
+	$(MAKE) -C $(COMP)/front-end clean
 endif
-	$(MAKE) script mlbpathmap targetmap constants compiler world libraries tools
+	$(MAKE) compiler world
 	@echo 'Build of MLton succeeded.'
 
 .PHONY: basis-no-check
@@ -46,7 +71,8 @@
 	mkdir -p $(LIB)/sml
 	rm -rf $(LIB)/sml/basis
 	$(CP) $(SRC)/basis-library/. $(LIB)/sml/basis
-	find $(LIB)/sml -type f -name .cvsignore | xargs rm -rf
+	find $(LIB)/sml/basis -type d -name .svn | xargs rm -rf
+	find $(LIB)/sml/basis -type f -name .ignore | xargs rm -rf
 
 .PHONY: basis
 basis:
@@ -66,22 +92,14 @@
 clean:
 	bin/clean
 
-.PHONY: clean-cvs
-clean-cvs:
-	find . -type d | grep CVS | xargs rm -rf
+.PHONY: clean-svn
+clean-svn:
+	find . -type d | grep .svn | xargs rm -rf
 
-.PHONY: cm
-cm:
-	$(MAKE) -C $(COMP) mlton-stubs_cm
-	$(MAKE) -C $(LEX) mllex_cm
-	$(MAKE) -C $(PROF) mlprof_cm
-	$(MAKE) -C $(YACC) mlyacc_cm
-	$(MAKE) -C benchmark benchmark_cm
-
 .PHONY: compiler
 compiler:
 	$(MAKE) -C $(COMP)
-	$(CP) $(COMP)/$(AOUT) $(LIB)/
+	$(CP) $(COMP)/$(AOUT)$(EXE) $(LIB)/
 
 .PHONY: constants
 constants:
@@ -94,7 +112,8 @@
 DEBSRC = mlton-$(VERSION).orig
 .PHONY: deb
 deb:
-	$(MAKE) clean clean-cvs version
+	$(MAKE) clean clean-svn version
+	mv package/debian .
 	tar -cpf - . | \
 		( cd .. && mkdir $(DEBSRC) && cd $(DEBSRC) && tar -xpf - )
 	cd .. && tar -cpf - $(DEBSRC) | $(GZIP) >mlton_$(VERSION).orig.tar.gz
@@ -114,9 +133,9 @@
 		echo;							\
 		echo ' -- Stephen Weeks <sweeks@sweeks.com>  '`date -R`;\
 		echo;							\
-		cat debian/changelog;					\
+		cat package/debian/changelog;				\
 	) >/tmp/changelog
-	mv /tmp/changelog debian/changelog
+	mv /tmp/changelog package/debian/changelog
 
 .PHONY: deb-lint
 deb-lint:
@@ -124,40 +143,52 @@
 
 .PHONY: deb-spell
 deb-spell:
-	ispell -g debian/control
+	ispell -g package/debian/control
 
 .PHONY: dirs
 dirs:
-	mkdir -p $(BIN) $(LIB)/$(TARGET) $(LIB)/include
+	mkdir -p $(BIN) $(LIB)/$(TARGET) $(INC)
 
 .PHONY: docs
 docs: dirs
 	$(MAKE) -C $(LEX) docs
 	$(MAKE) -C $(YACC) docs
+	if htmldoc --version >/dev/null 2>&1; then \
+		bin/make-pdf-guide; \
+	fi
 
 BSDSRC = /tmp/mlton-$(VERSION)
 .PHONY: freebsd
 freebsd:
-	$(MAKE) clean clean-cvs version
+	$(MAKE) clean clean-svn version
 	rm -rf $(BSDSRC)
 	mkdir -p $(BSDSRC)
 	( cd $(SRC) && tar -cpf - . ) | ( cd $(BSDSRC) && tar -xpf - )
 	cd /tmp && tar -cpf - mlton-$(VERSION) | \
-		 $(GZIP) >/usr/ports/distfiles/mlton-$(VERSION)-1.freebsd.src.tgz
-			     # vvvv do not change make to $(MAKE)
-	cd $(BSDSRC)/freebsd && make build-package  
+		 $(GZIP) >/usr/ports/distfiles/mlton-$(VERSION)-$(RELEASE).freebsd.src.tgz
+        # do not change "make" to "$(MAKE)" in the following line
+	cd $(BSDSRC)/package/freebsd && MAINTAINER_MODE=yes make build-package  
 
+LIBRARIES = ckit-lib cml mlnlffi-lib mlyacc-lib smlnj-lib
+
 .PHONY: libraries-no-check
 libraries-no-check:
-	cd $(LIB)/sml && rm -rf cml mlyacc-lib
-	$(CP) $(SRC)/lib/mlyacc/. $(LIB)/sml/mlyacc-lib
+	mkdir -p $(LIB)/sml
+	cd $(LIB)/sml && rm -rf $(LIBRARIES)
+	$(MAKE) -C $(SRC)/lib/ckit-lib
+	$(MAKE) -C $(SRC)/lib/smlnj-lib
 	$(CP) $(SRC)/lib/cml/. $(LIB)/sml/cml
+	$(CP) $(SRC)/lib/ckit-lib/ckit/. $(LIB)/sml/ckit-lib
 	$(CP) $(SRC)/lib/mlnlffi/. $(LIB)/sml/mlnlffi-lib
+	$(CP) $(SRC)/lib/mlyacc/. $(LIB)/sml/mlyacc-lib
+	$(CP) $(SRC)/lib/smlnj-lib/smlnj-lib/. $(LIB)/sml/smlnj-lib
+	find $(LIB)/sml -type d -name .svn | xargs rm -rf
+	find $(LIB)/sml -type f -name .ignore | xargs rm -rf
 
 .PHONY: libraries
 libraries:
 	$(MAKE) libraries-no-check
-	for f in cml mlyacc-lib mlnlffi-lib; do			\
+	for f in $(LIBRARIES); do				\
 		echo "Type checking $$f library.";		\
 		$(MLTON) -disable-ann deadCode 			\
 			-stop tc 				\
@@ -182,7 +213,7 @@
 .PHONY: nj-mlton-quad
 nj-mlton-quad:
 	$(MAKE) dirs runtime
-	$(MAKE) -C $(COMP) nj-mlton-dual
+	$(MAKE) -C $(COMP) nj-mlton-quad
 	$(MAKE) script basis-no-check mlbpathmap targetmap constants libraries-no-check
 	@echo 'Build of MLton succeeded.'
 
@@ -194,13 +225,29 @@
 		>>$(MLBPATHMAP).tmp
 	mv $(MLBPATHMAP).tmp $(MLBPATHMAP)
 
+.PHONY: traced
+traced:
+	$(MAKE) -C $(COMP) AOUT=$(AOUT).trace COMPILE_ARGS="-const 'Exn.keepHistory true' -const 'MLton.debug true' -drop-pass 'deepFlatten'"
+	$(CP) $(COMP)/$(AOUT).trace $(LIB)/
+	$(LIB)/$(AOUT).trace @MLton -- $(LIB)/world.trace
+	sed 's/mlton-compile/mlton-compile.trace/' < $(MLTON) | sed 's/world.mlton/world.trace.mlton/' > $(MLTON).trace
+	chmod a+x $(MLTON).trace
+
+.PHONY: debugged
+debugged:
+	$(MAKE) -C $(COMP) AOUT=$(AOUT).debug COMPILE_ARGS="-debug true -const 'Exn.keepHistory true' -const 'MLton.debug true' -drop-pass 'deepFlatten'"
+	$(CP) $(COMP)/$(AOUT).debug $(LIB)/
+	$(LIB)/$(AOUT).debug @MLton -- $(LIB)/world.debug
+	sed 's/mlton-compile/mlton-compile.debug/' < $(MLTON) | sed 's/world.mlton/world.debug.mlton/' > $(MLTON).debug
+	chmod a+x $(MLTON).debug
+
 .PHONY: profiled
 profiled:
-	$(MAKE) -C $(COMP) AOUT=$(AOUT).alloc COMPILE_ARGS='-profile alloc'
+	$(MAKE) -C $(COMP) AOUT=$(AOUT).alloc COMPILE_ARGS="-profile alloc"
 	$(CP) $(COMP)/$(AOUT).alloc $(LIB)/
-	$(MAKE) -C $(COMP) AOUT=$(AOUT).count COMPILE_ARGS='-profile count'
+	$(MAKE) -C $(COMP) AOUT=$(AOUT).count COMPILE_ARGS="-profile count"
 	$(CP) $(COMP)/$(AOUT).count $(LIB)/
-	$(MAKE) -C $(COMP) AOUT=$(AOUT).time COMPILE_ARGS='-profile time'
+	$(MAKE) -C $(COMP) AOUT=$(AOUT).time COMPILE_ARGS="-profile time"
 	$(CP) $(COMP)/$(AOUT).time $(LIB)/
 	$(LIB)/$(AOUT).alloc @MLton -- $(LIB)/world.alloc
 	$(LIB)/$(AOUT).count @MLton -- $(LIB)/world.count
@@ -216,13 +263,13 @@
 SOURCEDIR = $(TOPDIR)/SOURCES/mlton-$(VERSION)
 .PHONY: rpms
 rpms:
-	$(MAKE) clean clean-cvs version
+	$(MAKE) clean clean-svn version
 	mkdir -p $(TOPDIR)
 	cd $(TOPDIR) && mkdir -p BUILD RPMS/i386 SOURCES SPECS SRPMS
 	rm -rf $(SOURCEDIR)
 	mkdir -p $(SOURCEDIR)
 	( cd $(SRC) && tar -cpf - . ) | ( cd $(SOURCEDIR) && tar -xpf - )
-	$(CP) $(SOURCEDIR)/doc/mlton.spec $(TOPDIR)/SPECS/mlton.spec
+	$(CP) $(SOURCEDIR)/$(SPEC) $(TOPDIR)/SPECS/mlton.spec
 	( cd $(TOPDIR)/SOURCES && tar -cpf - mlton-$(VERSION) )		\
 		| $(GZIP) >$(SOURCEDIR).tgz
 	rm -rf $(SOURCEDIR)
@@ -233,10 +280,10 @@
 	@echo 'Compiling MLton runtime system for $(TARGET).'
 	$(MAKE) -C runtime
 	$(CP) $(RUN)/*.a $(LIB)/$(TARGET)/
-	$(CP) runtime/*.h include/*.h $(LIB)/include/
-	mkdir -p $(LIB)/include/platform
-	$(CP) bytecode/interpret.h $(LIB)/include
-	$(CP) runtime/platform/*.h $(LIB)/include/platform
+	$(CP) runtime/*.h include/*.h $(INC)/
+	mkdir -p $(INC)/platform
+	$(CP) bytecode/interpret.h $(INC)
+	$(CP) runtime/platform/*.h $(INC)/platform
 	$(MAKE) -C bytecode
 	bytecode/print-opcodes >$(LIB)/opcodes
 	ar r $(LIB)/$(TARGET)/libmlton.a bytecode/interpret.o 
@@ -245,9 +292,7 @@
 
 .PHONY: script
 script:
-	@echo 'Setting lib in mlton script.'
-	sed "/^lib=/s;'.*';\"\`dirname \$$0\`/../lib\";" 	\
-		<bin/mlton-script >$(MLTON)
+	$(CP) bin/mlton-script $(MLTON)
 	chmod a+x $(MLTON)
 	$(CP) $(SRC)/bin/platform $(LIB)
 
@@ -262,18 +307,23 @@
 .PHONY: tools
 tools:
 	$(MAKE) -C $(LEX)
+	$(MAKE) -C $(NLFFIGEN)
 	$(MAKE) -C $(PROF)
 	$(MAKE) -C $(YACC)
-	$(CP) $(LEX)/$(LEX) $(PROF)/$(PROF) $(YACC)/$(YACC) $(BIN)/
+	$(CP) $(LEX)/$(LEX)$(EXE) 		\
+		$(NLFFIGEN)/$(NLFFIGEN)$(EXE)	\
+		$(PROF)/$(PROF)$(EXE)		\
+		$(YACC)/$(YACC)$(EXE)		\
+		$(BIN)/
 
 .PHONY: version
 version:
 	@echo 'Instantiating version numbers.'
 	for f in							\
-		debian/changelog					\
-		doc/mlton.spec						\
-		freebsd/Makefile					\
-		mlton/control/control.sml; 				\
+		package/debian/changelog				\
+		$(SPEC)							\
+		package/freebsd/Makefile				\
+		mlton/control/control-flags.sml;			\
 	do								\
 		sed "s/\(.*\)MLTONVERSION\(.*\)/\1$(VERSION)\2/" <$$f >z && \
 		mv z $$f;						\
@@ -285,7 +335,7 @@
 world-no-check: 
 	@echo 'Making world.'
 	$(MAKE) basis-no-check
-	$(LIB)/$(AOUT) @MLton -- $(LIB)/world
+	$(LIB)/$(AOUT)$(EXE) @MLton -- $(LIB)/world
 
 .PHONY: world
 world: 
@@ -301,6 +351,15 @@
 # puts them.
 DESTDIR = $(CURDIR)/install
 PREFIX = /usr
+ifeq ($(TARGET_OS), cygwin)
+PREFIX = /
+endif
+ifeq ($(TARGET_OS), darwin)
+PREFIX = /usr/local
+endif
+ifeq ($(TARGET_OS), mingw)
+PREFIX = /mingw
+endif
 ifeq ($(TARGET_OS), solaris)
 PREFIX = /usr/local
 endif
@@ -311,6 +370,9 @@
 TLIB = $(DESTDIR)$(prefix)/$(ULIB)
 TMAN = $(DESTDIR)$(prefix)$(MAN_PREFIX_EXTRA)/man/man1
 TDOC = $(DESTDIR)$(prefix)/share/doc/mlton
+ifeq ($(TARGET_OS), cygwin)
+TDOC = $(DESTDIR)$(prefix)/usr/share/doc/mlton
+endif
 ifeq ($(TARGET_OS), solaris)
 TDOC = $(DESTDIR)$(prefix)/doc/mlton
 endif
@@ -324,28 +386,35 @@
 .PHONY: install
 install: install-docs install-no-docs
 
+MAN_PAGES =  \
+	mllex.1 \
+	mlnlffigen.1 \
+	mlprof.1 \
+	mlton.1 \
+	mlyacc.1
+
 .PHONY: install-no-docs
 install-no-docs:
 	mkdir -p $(TLIB) $(TBIN) $(TMAN)
 	$(CP) $(LIB)/. $(TLIB)/
 	rm -f $(TLIB)/self/libmlton-gdb.a
-	sed "/^lib=/s;'.*';'$(prefix)/$(ULIB)';" 			\
+	sed "/^lib=/s;.*;lib='$(prefix)/$(ULIB)';" 			\
 		<$(SRC)/bin/mlton-script >$(TBIN)/mlton
 	chmod a+x $(TBIN)/mlton
-	$(CP) $(BIN)/$(LEX) $(BIN)/$(PROF) $(BIN)/$(YACC) $(TBIN)/
-	( cd $(SRC)/man && tar cf - mllex.1 mlprof.1 mlton.1 mlyacc.1 ) | \
+	cd $(BIN) && $(CP) $(LEX)$(EXE) $(NLFFIGEN)$(EXE)		\
+		 $(PROF)$(EXE) $(YACC)$(EXE) $(TBIN)/
+	( cd $(SRC)/man && tar cf - $(MAN_PAGES)) | \
 		( cd $(TMAN)/ && tar xf - )
 	if $(GZIP_MAN); then						\
-		cd $(TMAN) && $(GZIP) mllex.1 mlprof.1 mlton.1		\
-			mlyacc.1;					\
+		cd $(TMAN) && $(GZIP) $(MAN_PAGES);			\
 	fi
 	case "$(TARGET_OS)" in						\
-	darwin|solaris)							\
+	cygwin|darwin|solaris)						\
 	;;								\
 	*)								\
-		for f in $(TLIB)/$(AOUT) 				\
-			$(TBIN)/$(LEX) $(TBIN)/$(PROF)			\
-			$(TBIN)/$(YACC); do 				\
+		for f in $(TLIB)/$(AOUT)$(EXE) $(TBIN)/$(LEX)$(EXE)	\
+			$(TBIN)/$(NLFFIGEN)$(EXE) $(TBIN)/$(PROF)$(EXE)	\
+			$(TBIN)/$(YACC)$(EXE); do			\
 			strip --remove-section=.comment			\
 				--remove-section=.note $$f; 		\
 		done							\
@@ -354,11 +423,15 @@
 .PHONY: install-docs
 install-docs:
 	mkdir -p $(TDOC)
-	(									\
-		cd $(SRC)/doc &&						\
-		$(CP) changelog cm2mlb cmcat examples license README $(TDOC)/	\
+	(								\
+		cd $(SRC)/doc &&					\
+		$(CP) changelog examples guide license README $(TDOC)/	\
 	)
-	rm -rf $(TDOC)/user-guide
+	mv $(TDOC)/guide/mlton-guide.pdf $(TDOC)/
+	(								\
+		cd $(SRC)/util &&					\
+		$(CP) cmcat cm2mlb $(TDOC)/				\
+	)
 	for f in callcc command-line hello-world same-fringe signals	\
 			size taut thread1 thread2 thread-switch timeout \
 		; do 							\
@@ -366,10 +439,10 @@
 	done
 	$(GZIP) -c $(LEX)/$(LEX).ps >$(TDOC)/$(LEX).ps.gz
 	$(GZIP) -c $(YACC)/$(YACC).ps >$(TDOC)/$(YACC).ps.gz
-	find $(TDOC)/ -name CVS -type d | xargs rm -rf
-	find $(TDOC)/ -name .cvsignore -type f | xargs rm -rf
-	find $(TEXM)/ -name CVS -type d | xargs rm -rf
-	find $(TEXM)/ -name .cvsignore -type f | xargs rm -rf
+	find $(TDOC)/ -name .svn -type d | xargs rm -rf
+	find $(TDOC)/ -name .ignore -type f | xargs rm -rf
+	find $(TEXM)/ -name .svn -type d | xargs rm -rf
+	find $(TEXM)/ -name .ignore -type f | xargs rm -rf
 
 TDOCBASE = $(DESTDIR)$(prefix)/share/doc-base
 
@@ -383,3 +456,4 @@
 		$(CP) $(SRC)/debian/$$f.doc-base $(TDOCBASE)/$$f; \
 	done
 	cd $(TDOC)/ && $(GZIP) changelog changelog.Debian
+	chown -R root.root $(TDOC) $(TLIB)


Property changes on: mlton/branches/on-20050420-cmm-branch/basis-library
___________________________________________________________________
Name: svn:ignore
   - basis.sml
   + basis.sml


Deleted: mlton/branches/on-20050420-cmm-branch/basis-library/.cvsignore
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/.cvsignore	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/.cvsignore	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1 +0,0 @@
-basis.sml

Copied: mlton/branches/on-20050420-cmm-branch/basis-library/.ignore (from rev 4358, mlton/trunk/basis-library/.ignore)

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/Makefile
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/Makefile	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/Makefile	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,11 @@
+## Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ #    Jagannathan, and Stephen Weeks.
+ # Copyright (C) 1997-2000 NEC Research Institute.
+ #
+ # MLton is released under a BSD-style license.
+ # See the file MLton-LICENSE for details.
+ ##
+
 all:
 
 .PHONY: clean

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/README
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/README	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/README	2006-02-16 19:34:54 UTC (rev 4361)
@@ -30,6 +30,6 @@
 declarations from the basis so that there are no free variables in the
 user program (or basis).  It has a special hack to include all
 bindings of the form 
-	
-	val _ = ...
+        
+        val _ = ...
 

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/arrays-and-vectors/array-slice.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/arrays-and-vectors/array-slice.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/arrays-and-vectors/array-slice.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -15,8 +15,8 @@
       val collate: ('a * 'a -> order) -> 'a slice * 'a slice -> order
       val copy: {src: 'a slice, dst: 'a Array.array, di: int} -> unit
       val copyVec: {di: int,
-		    dst: 'a Array.array,
-		    src: 'a VectorSlice.slice} -> unit
+                    dst: 'a Array.array,
+                    src: 'a VectorSlice.slice} -> unit
       val exists: ('a -> bool) -> 'a slice -> bool
       val find: ('a -> bool) -> 'a slice -> 'a option
       val findi: (int * 'a -> bool) -> 'a slice -> (int * 'a) option

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/arrays-and-vectors/array.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/arrays-and-vectors/array.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/arrays-and-vectors/array.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,18 +1,19 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 structure Array: ARRAY_EXTRA =
    struct
       structure A = Sequence (type 'a sequence = 'a array
-			      type 'a elt = 'a
-			      val fromArray = fn a => a
-			      val isMutable = true
-			      val length = Primitive.Array.length
-			      val sub = Primitive.Array.sub)
+                              type 'a elt = 'a
+                              val fromArray = fn a => a
+                              val isMutable = true
+                              val length = Primitive.Array.length
+                              val sub = Primitive.Array.sub)
       open A
       open Primitive.Int
 
@@ -20,52 +21,52 @@
       type 'a vector = 'a Vector.vector
 
       structure ArraySlice =
-	 struct
-	    open Slice
-	    fun update (arr, i, x) = 
-	       update' Primitive.Array.update (arr, i, x)
-	    fun unsafeUpdate (arr, i, x) = 
-	       unsafeUpdate' Primitive.Array.update (arr, i, x)
-	    fun vector sl = create Vector.tabulate (fn x => x) sl
-	    fun modifyi f sl = 
-	       appi (fn (i, x) => unsafeUpdate (sl, i, f (i, x))) sl
-	    fun modify f sl = modifyi (f o #2) sl
-	    local
-	       fun make (length, sub) {src, dst, di} =
-		  modifyi (fn (i, _) => sub (src, i)) 
-		          (slice (dst, di, SOME (length src)))
-	    in
-	       fun copy (arg as {src, dst, di}) =
-		  let val (src', si', len') = base src
-		  in
-		    if src' = dst andalso si' < di andalso si' +? len' >= di
-		       then let val sl = slice (dst, di, SOME (length src))
-			    in 
-			       foldri (fn (i, _, _) => 
-				       unsafeUpdate (sl, i, unsafeSub (src, i)))
-			       () sl
-			    end
-		    else make (length, unsafeSub) arg
-		  end
+         struct
+            open Slice
+            fun update (arr, i, x) = 
+               update' Primitive.Array.update (arr, i, x)
+            fun unsafeUpdate (arr, i, x) = 
+               unsafeUpdate' Primitive.Array.update (arr, i, x)
+            fun vector sl = create Vector.tabulate (fn x => x) sl
+            fun modifyi f sl = 
+               appi (fn (i, x) => unsafeUpdate (sl, i, f (i, x))) sl
+            fun modify f sl = modifyi (f o #2) sl
+            local
+               fun make (length, sub) {src, dst, di} =
+                  modifyi (fn (i, _) => sub (src, i)) 
+                          (slice (dst, di, SOME (length src)))
+            in
+               fun copy (arg as {src, dst, di}) =
+                  let val (src', si', len') = base src
+                  in
+                    if src' = dst andalso si' < di andalso si' +? len' >= di
+                       then let val sl = slice (dst, di, SOME (length src))
+                            in 
+                               foldri (fn (i, _, _) => 
+                                       unsafeUpdate (sl, i, unsafeSub (src, i)))
+                               () sl
+                            end
+                    else make (length, unsafeSub) arg
+                  end
 
-	       fun copyVec arg =
-		  make (Vector.VectorSlice.length, Vector.VectorSlice.unsafeSub) arg
-	    end
-	 end
+               fun copyVec arg =
+                  make (Vector.VectorSlice.length, Vector.VectorSlice.unsafeSub) arg
+            end
+         end
 
       val rawArray = Primitive.Array.array
       val array = new
 
       local
-	fun make f arr = f (ArraySlice.full arr)
+        fun make f arr = f (ArraySlice.full arr)
       in
-	fun vector arr = make (ArraySlice.vector) arr
-	fun modifyi f = make (ArraySlice.modifyi f)
-	fun modify f = make (ArraySlice.modify f)
-	fun copy {src, dst, di} = ArraySlice.copy {src = ArraySlice.full src,
-						   dst = dst, di = di}
-	fun copyVec {src, dst, di} = ArraySlice.copyVec {src = VectorSlice.full src,
-							 dst = dst, di = di}
+        fun vector arr = make (ArraySlice.vector) arr
+        fun modifyi f = make (ArraySlice.modifyi f)
+        fun modify f = make (ArraySlice.modify f)
+        fun copy {src, dst, di} = ArraySlice.copy {src = ArraySlice.full src,
+                                                   dst = dst, di = di}
+        fun copyVec {src, dst, di} = ArraySlice.copyVec {src = VectorSlice.full src,
+                                                         dst = dst, di = di}
       end
 
       val unsafeSub = Primitive.Array.sub

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/arrays-and-vectors/array2.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/arrays-and-vectors/array2.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/arrays-and-vectors/array2.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -3,10 +3,10 @@
       eqtype 'a array
 
       type 'a region = {base: 'a array,
-			row: int,
-			col: int,
-			nrows: int option,
-			ncols: int option}
+                        row: int,
+                        col: int,
+                        nrows: int option,
+                        ncols: int option}
 
       datatype traversal = RowMajor | ColMajor
 
@@ -21,9 +21,9 @@
       val row: 'a array * int -> 'a vector 
       val column: 'a array * int -> 'a vector 
       val copy: {src: 'a region,
-		 dst: 'a array,
-		 dst_row: int,
-		 dst_col: int} -> unit
+                 dst: 'a array,
+                 dst_row: int,
+                 dst_col: int} -> unit
       val appi: traversal -> (int * int * 'a -> unit) -> 'a region -> unit 
       val app: traversal -> ('a -> unit) -> 'a array -> unit 
       val foldi: traversal -> (int * int * 'a * 'b -> 'b) -> 'b -> 'a region -> 'b 

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/arrays-and-vectors/array2.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/arrays-and-vectors/array2.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/arrays-and-vectors/array2.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 structure Array2: ARRAY2 =
    struct
       open Primitive.Int
@@ -14,229 +15,229 @@
        * This is probably just an NJ-ism, but I don't want to think about it.
        *)
       type 'a array = {rows: int,
-		       cols: int,
-		       array: 'a Array.array}
+                       cols: int,
+                       array: 'a Array.array}
 
       fun dimensions ({rows, cols, ...}: 'a array) = (rows, cols)
       fun nRows ({rows, ...}: 'a array) = rows
       fun nCols ({cols, ...}: 'a array) = cols
 
       type 'a region = {base: 'a array,
-			row: int,
-			col: int,
-			nrows: int option,
-			ncols: int option}
+                        row: int,
+                        col: int,
+                        nrows: int option,
+                        ncols: int option}
 
       fun checkRegion {base, row, col, nrows, ncols} =
-	 let val (rows, cols) = dimensions base
-	 in {stopRow = Array.checkSliceMax (row, nrows, rows),
-	     stopCol = Array.checkSliceMax (col, ncols, cols)}
-	 end
+         let val (rows, cols) = dimensions base
+         in {stopRow = Array.checkSliceMax (row, nrows, rows),
+             stopCol = Array.checkSliceMax (col, ncols, cols)}
+         end
       
       fun wholeRegion (a: 'a array): 'a region =
-	 {base = a, row = 0, col = 0, nrows = NONE, ncols = NONE}
+         {base = a, row = 0, col = 0, nrows = NONE, ncols = NONE}
 
       datatype traversal = RowMajor | ColMajor
 
       local
-	 fun make (rows, cols, doit) =
-	    if Primitive.safe andalso (rows < 0 orelse cols < 0)
-	       then raise Size
-	    else {rows = rows,
-		  cols = cols,
-		  array = doit (rows * cols handle Overflow => raise Size)}
+         fun make (rows, cols, doit) =
+            if Primitive.safe andalso (rows < 0 orelse cols < 0)
+               then raise Size
+            else {rows = rows,
+                  cols = cols,
+                  array = doit (rows * cols handle Overflow => raise Size)}
       in
-	 fun arrayUninit (rows, cols) =
-	    make (rows, cols, Primitive.Array.array)
-	 fun array (rows, cols, init) =
-	    make (rows, cols, fn size => Array.array (size, init))
+         fun arrayUninit (rows, cols) =
+            make (rows, cols, Primitive.Array.array)
+         fun array (rows, cols, init) =
+            make (rows, cols, fn size => Array.array (size, init))
       end
 
       fun array0 (): 'a array =
-	 {rows = 0,
-	  cols = 0,
-	  array = Primitive.Array.array 0}
+         {rows = 0,
+          cols = 0,
+          array = Primitive.Array.array 0}
 
       fun spot ({rows, cols, ...}: 'a array, r, c) =
-	 if Primitive.safe andalso (geu (r, rows) orelse geu (c, cols))
-	    then raise Subscript
-	 else r *? cols +? c
-	 
+         if Primitive.safe andalso (geu (r, rows) orelse geu (c, cols))
+            then raise Subscript
+         else r *? cols +? c
+         
       fun sub (a as {array, ...}: 'a array, r, c) =
-	 Primitive.Array.sub (array, spot (a, r, c))
+         Primitive.Array.sub (array, spot (a, r, c))
 
       fun update (a as {array, ...}: 'a array, r, c, x) =
-	 Primitive.Array.update (array, spot (a, r, c), x)
+         Primitive.Array.update (array, spot (a, r, c), x)
 
       fun 'a fromList (rows: 'a list list): 'a array =
-	 case rows of
-	    [] => array0 ()
-	  | row1 :: _ =>
-	       let
-		  val cols = length row1
-		  val a as {array, ...} = arrayUninit (length rows, cols)
-		  val _ =
-		     List.foldl
-		     (fn (row: 'a list, i) =>
-		      let
-			 val max = i +? cols
-			 val i' =
-			    List.foldl (fn (x: 'a, i) =>
-					(if i >= max
-					    then raise Size
-					 else (Primitive.Array.update (array, i, x)
-					       ; i + 1)))
-			    i row
-		      in if i' = max
-			    then i'
-			 else raise Size
-		      end)
-		     0 rows
-	       in
-		  a
-	       end
+         case rows of
+            [] => array0 ()
+          | row1 :: _ =>
+               let
+                  val cols = length row1
+                  val a as {array, ...} = arrayUninit (length rows, cols)
+                  val _ =
+                     List.foldl
+                     (fn (row: 'a list, i) =>
+                      let
+                         val max = i +? cols
+                         val i' =
+                            List.foldl (fn (x: 'a, i) =>
+                                        (if i >= max
+                                            then raise Size
+                                         else (Primitive.Array.update (array, i, x)
+                                               ; i + 1)))
+                            i row
+                      in if i' = max
+                            then i'
+                         else raise Size
+                      end)
+                     0 rows
+               in
+                  a
+               end
 
       fun row ({rows, cols, array}, r) =
-	 if Primitive.safe andalso geu (r, rows)
-	    then raise Subscript
-	 else
-	    ArraySlice.vector (ArraySlice.slice (array, r *? cols, SOME cols))
+         if Primitive.safe andalso geu (r, rows)
+            then raise Subscript
+         else
+            ArraySlice.vector (ArraySlice.slice (array, r *? cols, SOME cols))
 
       fun column (a as {rows, cols, ...}: 'a array, c) =
-	 if Primitive.safe andalso geu (c, cols)
-	    then raise Subscript
-	 else
-	    Vector.tabulate (rows, fn r => sub(a, r, c))
+         if Primitive.safe andalso geu (c, cols)
+            then raise Subscript
+         else
+            Vector.tabulate (rows, fn r => sub(a, r, c))
 
       fun foldi trv f b (region as {base, row, col, ...}) =
-	 let
-	    val {stopRow, stopCol} = checkRegion region
-	 in
-	    case trv of
-	       RowMajor =>
-		  Util.naturalFoldStartStop
-		  (row, stopRow, b, fn (r, b) =>
-		   Util.naturalFoldStartStop
-		   (col, stopCol, b, fn (c, b) =>
-		    f (r, c, sub (base, r, c), b)))
-	     | ColMajor =>
-		  Util.naturalFoldStartStop
-		  (col, stopCol, b, fn (c, b) =>
-		   Util.naturalFoldStartStop
-		   (row, stopRow, b, fn (r, b) =>
-		    f (r, c, sub (base, r, c), b)))
-	 end
+         let
+            val {stopRow, stopCol} = checkRegion region
+         in
+            case trv of
+               RowMajor =>
+                  Util.naturalFoldStartStop
+                  (row, stopRow, b, fn (r, b) =>
+                   Util.naturalFoldStartStop
+                   (col, stopCol, b, fn (c, b) =>
+                    f (r, c, sub (base, r, c), b)))
+             | ColMajor =>
+                  Util.naturalFoldStartStop
+                  (col, stopCol, b, fn (c, b) =>
+                   Util.naturalFoldStartStop
+                   (row, stopRow, b, fn (r, b) =>
+                    f (r, c, sub (base, r, c), b)))
+         end
 
       fun fold trv f b a =
-	  foldi trv (fn (_, _, x, b) => f (x, b)) b (wholeRegion a)
+          foldi trv (fn (_, _, x, b) => f (x, b)) b (wholeRegion a)
 
       fun appi trv f =
-	 foldi trv (fn (r, c, x, ()) => f (r, c, x)) ()
+         foldi trv (fn (r, c, x, ()) => f (r, c, x)) ()
 
       fun app trv f = fold trv (f o #1) ()
 
       fun modifyi trv f (r as {base, ...}) =
-	 appi trv (fn (r, c, x) => update (base, r, c, f (r, c, x))) r
+         appi trv (fn (r, c, x) => update (base, r, c, f (r, c, x))) r
 
       fun modify trv f a = modifyi trv (f o #3) (wholeRegion a)
 
       fun tabulate trv (rows, cols, f) =
-	 if !Primitive.usesCallcc
-	    then
-	       (* All this mess is careful to construct a list representing
-		* the array and then convert the list to the array after all
-		* the calls to f have been made, in case f uses callcc.
-		*)
-	       let
-		  val size =
-		     if Primitive.safe andalso (rows < 0 orelse cols < 0)
-			then raise Size
-		     else rows * cols handle Overflow => raise Size
-		  val (rows', cols', f) =
-		     case trv of
-			RowMajor => (rows, cols, f)
-		      | ColMajor => (cols, rows, fn (c, r) => f (r, c))
-		  fun loopr (r, l) =
-		     if r >= rows'
-			then l
-		     else
-			let
-			   fun loopc (c, l) =
-			      if c >= cols'
-				 then l
-			      else loopc (c + 1, f (r, c) :: l)
-			in loopr (r + 1, loopc (0, l))
-			end
-		  val l = loopr (0, [])
-		  val a = Primitive.Array.array size
-	       in case trv of
-		  RowMajor =>
-		     (* The list holds the elements in row major order,
-		      * but reversed.
-		      *)
-		     let
-			val _ =
-			   List.foldl (fn (x, i) =>
-				       (Primitive.Array.update (a, i, x)
-					; i -? 1))
-			   (size -? 1) l
-		     in
-			()
-		     end
-		| ColMajor =>
-		     (* The list holds the elements in column major order,
-		      * but reversed.
-		      *)
-		     let
-			val _ =
-			   List.foldl (fn (x, (spot, r)) =>
-				       (Primitive.Array.update (a, spot, x)
-					; if r = 0
-					     then (spot -? 1 +? size -? cols,
-						   rows -? 1)
-					  else (spot -? cols, r -? 1)))
-			   (size -? 1, rows -? 1)
-			   l
-		     in
-			()
-		     end
-		  ; {rows = rows, cols = cols, array = a}
-	       end
-	 else
-	    let val a = arrayUninit (rows, cols)
-	    in modifyi trv (fn (r, c, _) => f (r, c)) (wholeRegion a)
-	       ; a
-	    end
+         if !Primitive.usesCallcc
+            then
+               (* All this mess is careful to construct a list representing
+                * the array and then convert the list to the array after all
+                * the calls to f have been made, in case f uses callcc.
+                *)
+               let
+                  val size =
+                     if Primitive.safe andalso (rows < 0 orelse cols < 0)
+                        then raise Size
+                     else rows * cols handle Overflow => raise Size
+                  val (rows', cols', f) =
+                     case trv of
+                        RowMajor => (rows, cols, f)
+                      | ColMajor => (cols, rows, fn (c, r) => f (r, c))
+                  fun loopr (r, l) =
+                     if r >= rows'
+                        then l
+                     else
+                        let
+                           fun loopc (c, l) =
+                              if c >= cols'
+                                 then l
+                              else loopc (c + 1, f (r, c) :: l)
+                        in loopr (r + 1, loopc (0, l))
+                        end
+                  val l = loopr (0, [])
+                  val a = Primitive.Array.array size
+               in case trv of
+                  RowMajor =>
+                     (* The list holds the elements in row major order,
+                      * but reversed.
+                      *)
+                     let
+                        val _ =
+                           List.foldl (fn (x, i) =>
+                                       (Primitive.Array.update (a, i, x)
+                                        ; i -? 1))
+                           (size -? 1) l
+                     in
+                        ()
+                     end
+                | ColMajor =>
+                     (* The list holds the elements in column major order,
+                      * but reversed.
+                      *)
+                     let
+                        val _ =
+                           List.foldl (fn (x, (spot, r)) =>
+                                       (Primitive.Array.update (a, spot, x)
+                                        ; if r = 0
+                                             then (spot -? 1 +? size -? cols,
+                                                   rows -? 1)
+                                          else (spot -? cols, r -? 1)))
+                           (size -? 1, rows -? 1)
+                           l
+                     in
+                        ()
+                     end
+                  ; {rows = rows, cols = cols, array = a}
+               end
+         else
+            let val a = arrayUninit (rows, cols)
+            in modifyi trv (fn (r, c, _) => f (r, c)) (wholeRegion a)
+               ; a
+            end
 
       fun copy {src = src as {base, row, col, ...}: 'a region,
-		dst, dst_row, dst_col} =
-	 let
-	    val {stopRow, stopCol} = checkRegion src
-	    val nrows = stopRow -? row
-	    val ncols = stopCol -? col
-	    val _ = checkRegion {base = dst, row = dst_row, col = dst_col,
-				nrows = SOME nrows, ncols = SOME ncols}
-	    fun for (start, stop, f) =
-	       let
-		  fun loop i =
-		     if i >= stop
-			then ()
-		     else (f i; loop (i + 1))
-	       in loop start
-	       end
-	    fun forDown (start, stop, f) =
-	       let
-		  fun loop i =
-		     if i < start
-			then ()
-		     else (f i; loop (i - 1))
-	       in loop (stop -? 1)
-	       end
-	    val forRows = if row <= dst_row then forDown else for
-	    val forCols = if col <= dst_col then for else forDown
-	 in forRows (0, nrows, fn r =>
-		     forCols (0, ncols, fn c =>
-			      update (dst, dst_row +? r, dst_col +? c,
-				      sub (base, row +? r, col +? c))))
-	 end
+                dst, dst_row, dst_col} =
+         let
+            val {stopRow, stopCol} = checkRegion src
+            val nrows = stopRow -? row
+            val ncols = stopCol -? col
+            val _ = checkRegion {base = dst, row = dst_row, col = dst_col,
+                                nrows = SOME nrows, ncols = SOME ncols}
+            fun for (start, stop, f: int -> unit) =
+               let
+                  fun loop i =
+                     if i >= stop
+                        then ()
+                     else (f i; loop (i + 1))
+               in loop start
+               end
+            fun forDown (start, stop, f: int -> unit) =
+               let
+                  fun loop i =
+                     if i < start
+                        then ()
+                     else (f i; loop (i - 1))
+               in loop (stop -? 1)
+               end
+            val forRows = if row <= dst_row then forDown else for
+            val forCols = if col <= dst_col then for else forDown
+         in forRows (0, nrows, fn r =>
+                     forCols (0, ncols, fn c =>
+                              update (dst, dst_row +? r, dst_col +? c,
+                                      sub (base, row +? r, col +? c))))
+         end
    end

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/arrays-and-vectors/mono-array-slice.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/arrays-and-vectors/mono-array-slice.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/arrays-and-vectors/mono-array-slice.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -5,7 +5,7 @@
       type slice
       type vector
       type vector_slice
-	 
+         
       val length: slice -> int
       val sub: slice * int -> elem
       val update: slice * int * elem -> unit

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/arrays-and-vectors/mono-array.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/arrays-and-vectors/mono-array.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/arrays-and-vectors/mono-array.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,14 +1,15 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 functor MonoArray (type elem
-		   structure V: MONO_VECTOR_EXTRA
-		     where type elem = elem
-		       and type vector = elem Vector.vector
+                   structure V: MONO_VECTOR_EXTRA
+                     where type elem = elem
+                       and type vector = elem Vector.vector
                        and type MonoVectorSlice.slice = elem VectorSlice.slice
                   ): MONO_ARRAY_EXTRA 
                      where type elem = elem
@@ -26,15 +27,15 @@
       val toPoly = fn a => a
 
       structure MonoArraySlice =
-	 struct
-	    open ArraySlice
+         struct
+            open ArraySlice
 
-	    type elem = elem
-	    type array = array
-	    type slice = elem slice
-	    type vector = vector
-	    type vector_slice = vector_slice
+            type elem = elem
+            type array = array
+            type slice = elem slice
+            type vector = vector
+            type vector_slice = vector_slice
 
-	    val toPoly = fn s => s
-	 end
+            val toPoly = fn s => s
+         end
    end

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/arrays-and-vectors/mono-array.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/arrays-and-vectors/mono-array.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/arrays-and-vectors/mono-array.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -34,10 +34,10 @@
       include MONO_ARRAY
       type vector_slice
       structure MonoArraySlice: MONO_ARRAY_SLICE_EXTRA 
-	where type elem = elem
-	  and type array = array
-	  and type vector = vector
-	  and type vector_slice = vector_slice
+        where type elem = elem
+          and type array = array
+          and type vector = vector
+          and type vector_slice = vector_slice
 
       val concat: array list -> array
       val duplicate: array -> array

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/arrays-and-vectors/mono-array2.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/arrays-and-vectors/mono-array2.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/arrays-and-vectors/mono-array2.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,22 +1,23 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 functor MonoArray2 (type elem
-		    structure V: MONO_VECTOR
-		      where type elem = elem
-		        and type vector = elem Vector.vector): MONO_ARRAY2 =
+                    structure V: MONO_VECTOR
+                      where type elem = elem
+                        and type vector = elem Vector.vector): MONO_ARRAY2 =
    struct
       type elem = V.elem
       type vector = V.vector
       open Array2
       type array = elem array
       type region = {base: array,
-		     row: int,
-		     col: int,
-		     nrows: int option,
-		     ncols: int option}
+                     row: int,
+                     col: int,
+                     nrows: int option,
+                     ncols: int option}
    end

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/arrays-and-vectors/mono-array2.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/arrays-and-vectors/mono-array2.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/arrays-and-vectors/mono-array2.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -6,11 +6,11 @@
       type vector
 
       type region = {base: array,
-		     row: int,
-		     col: int,
-		     nrows: int option,
-		     ncols: int option}
-	 
+                     row: int,
+                     col: int,
+                     nrows: int option,
+                     ncols: int option}
+         
       datatype traversal = datatype Array2.traversal
 
       val array: int * int * elem -> array 

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/arrays-and-vectors/mono-vector-slice.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/arrays-and-vectors/mono-vector-slice.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/arrays-and-vectors/mono-vector-slice.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -3,7 +3,7 @@
       type elem
       type slice
       type vector
-	 
+         
       val all: (elem -> bool) -> slice -> bool
       val app: (elem -> unit) -> slice -> unit
       val appi: (int * elem -> unit) -> slice -> unit

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/arrays-and-vectors/mono-vector.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/arrays-and-vectors/mono-vector.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/arrays-and-vectors/mono-vector.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 functor MonoVector (type elem): MONO_VECTOR_EXTRA 
                                 where type elem = elem =
    struct
@@ -13,12 +14,12 @@
       type elem = elem
       type vector = elem vector
       structure MonoVectorSlice = 
-	 struct
-	    open VectorSlice
-	    type elem = elem
-	    type vector = vector
-	    type slice = elem slice
-	 end
+         struct
+            open VectorSlice
+            type elem = elem
+            type vector = vector
+            type slice = elem slice
+         end
    end
 
 functor EqtypeMonoVector (eqtype elem): EQTYPE_MONO_VECTOR_EXTRA 
@@ -31,12 +32,12 @@
       val fromPoly = fn v => v
       val toPoly = fn v => v
       structure MonoVectorSlice = 
-	 struct
-	    open VectorSlice
-	    type elem = elem
-	    type vector = vector
-	    type slice = elem slice
-	    val fromPoly = fn s => s
-	    val toPoly = fn s => s
-	 end
+         struct
+            open VectorSlice
+            type elem = elem
+            type vector = vector
+            type slice = elem slice
+            val fromPoly = fn s => s
+            val toPoly = fn s => s
+         end
    end

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/arrays-and-vectors/mono-vector.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/arrays-and-vectors/mono-vector.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/arrays-and-vectors/mono-vector.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -51,8 +51,8 @@
       include MONO_VECTOR_EXTRA_PRE
 
       structure MonoVectorSlice: MONO_VECTOR_SLICE_EXTRA 
-	 where type elem = elem
-	   and type vector = vector
+         where type elem = elem
+           and type vector = vector
    end
 
 signature EQTYPE_MONO_VECTOR_EXTRA =
@@ -60,8 +60,8 @@
       include MONO_VECTOR_EXTRA_PRE
 
       structure MonoVectorSlice: EQTYPE_MONO_VECTOR_SLICE_EXTRA 
-	 where type elem = elem
-	   and type vector = vector
+         where type elem = elem
+           and type vector = vector
 
       val fromPoly: elem Vector.vector -> vector 
       val toPoly: vector -> elem Vector.vector

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/arrays-and-vectors/mono.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/arrays-and-vectors/mono.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/arrays-and-vectors/mono.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,9 @@
-(* Copyright (C) 1999-2003 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 signature EQ_MONO =
@@ -15,9 +15,9 @@
       structure VectorSlice: EQTYPE_MONO_VECTOR_SLICE_EXTRA
       sharing type Array.array = ArraySlice.array = Vector.array
       sharing type Array.elem = Array2.elem = ArraySlice.elem = Vector.elem
-	 = VectorSlice.elem
+         = VectorSlice.elem
       sharing type Array.vector = Array2.vector = ArraySlice.vector
-	 = Vector.vector = VectorSlice.vector
+         = Vector.vector = VectorSlice.vector
       sharing type ArraySlice.vector_slice = VectorSlice.slice
    end
 
@@ -26,10 +26,10 @@
       structure Vector = EqtypeMonoVector (type elem = elem)
       structure VectorSlice = Vector.MonoVectorSlice
       structure Array = MonoArray (type elem = elem
-				   structure V = Vector)
+                                   structure V = Vector)
       structure ArraySlice = Array.MonoArraySlice
       structure Array2 = MonoArray2 (type elem = elem
-				     structure V = Vector)
+                                     structure V = Vector)
    end
 
 functor Mono (type elem) =
@@ -37,10 +37,10 @@
       structure Vector = MonoVector (type elem = elem)
       structure VectorSlice = Vector.MonoVectorSlice
       structure Array = MonoArray (type elem = elem
-				   structure V = Vector)
+                                   structure V = Vector)
       structure ArraySlice = Array.MonoArraySlice
       structure Array2 = MonoArray2 (type elem = elem
-				     structure V = Vector)
+                                     structure V = Vector)
    end
 
 local

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/arrays-and-vectors/sequence.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/arrays-and-vectors/sequence.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/arrays-and-vectors/sequence.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,20 +1,21 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 functor Sequence (S: sig
-			type 'a sequence 
-			type 'a elt
-			(* fromArray should be constant time. *)
-			val fromArray: 'a elt array -> 'a sequence 
-			val isMutable: bool
-			val length: 'a sequence -> int
-			val sub: 'a sequence * int -> 'a elt
-		     end
-		  ): SEQUENCE =
+                        type 'a sequence 
+                        type 'a elt
+                        (* fromArray should be constant time. *)
+                        val fromArray: 'a elt array -> 'a sequence 
+                        val isMutable: bool
+                        val length: 'a sequence -> int
+                        val sub: 'a sequence * int -> 'a elt
+                     end
+                  ): SEQUENCE =
    struct
       open S
 
@@ -25,472 +26,472 @@
       val maxLen = Array.maxLen
 
       fun array n =
-	 if not isMutable andalso n = 0
-	    then Array.array0Const ()
-	 else Array.array n
+         if not isMutable andalso n = 0
+            then Array.array0Const ()
+         else Array.array n
 
       fun seq0 () = fromArray (array 0)
 
       fun unfoldi (n, b, f) =
-	 let
-	    val a = array n
-	    fun loop (i, b)  =
-	       if i >= n
-		  then ()
-	       else
-		  let
-		     val (x, b') = f (i, b)
-		     val _ = Array.update (a, i, x)
-		  in
-		     loop (i +? 1, b')
-		  end
-	    val _ = loop (0, b)
-	 in
-	    fromArray a
-	 end
+         let
+            val a = array n
+            fun loop (i, b)  =
+               if i >= n
+                  then ()
+               else
+                  let
+                     val (x, b') = f (i, b)
+                     val _ = Array.update (a, i, x)
+                  in
+                     loop (i +? 1, b')
+                  end
+            val _ = loop (0, b)
+         in
+            fromArray a
+         end
 
       (* Tabulate depends on the fact that the runtime system fills in the array
        * with reasonable bogus values.
        *)
       fun tabulate (n, f) =
 (*
-	 if !Primitive.usesCallcc
-	    then
-	       (* This code is careful to use a list to accumulate the 
-		* components of the array in case f uses callcc.
-		*)
-	       let
-		  fun loop (i, l) =
-		     if i >= n
-			then l
-		     else loop (i + 1, f i :: l)
-		  val l = loop (0, [])
-		  val a = array n
-		  fun loop (l, i) =
-		     case l of
-			[] => ()
-		      | x :: l =>
-			   let val i = i -? 1
-			   in Array.update (a, i, x)
-			      ; loop (l, i)
-			   end
-	       in loop (l, n)
-		  ; fromArray a
-	       end
-	 else
+         if !Primitive.usesCallcc
+            then
+               (* This code is careful to use a list to accumulate the 
+                * components of the array in case f uses callcc.
+                *)
+               let
+                  fun loop (i, l) =
+                     if i >= n
+                        then l
+                     else loop (i + 1, f i :: l)
+                  val l = loop (0, [])
+                  val a = array n
+                  fun loop (l, i) =
+                     case l of
+                        [] => ()
+                      | x :: l =>
+                           let val i = i -? 1
+                           in Array.update (a, i, x)
+                              ; loop (l, i)
+                           end
+               in loop (l, n)
+                  ; fromArray a
+               end
+         else
 *)
-	    unfoldi (n, (), fn (i, ()) => (f i, ()))
+            unfoldi (n, (), fn (i, ()) => (f i, ()))
 
       fun new (n, x) = tabulate (n, fn _ => x)
 
       fun fromList l =
-	 let
-	    val a = array (List.length l)
-	    val _ =
-	       List.foldl (fn (c, i) => (Array.update (a, i, c) ; i +? 1)) 0 l
-	 in
-	    fromArray a
-	 end
+         let
+            val a = array (List.length l)
+            val _ =
+               List.foldl (fn (c, i) => (Array.update (a, i, c) ; i +? 1)) 0 l
+         in
+            fromArray a
+         end
 
       structure Slice =
-	 struct
-	    type 'a sequence = 'a sequence
-	    type 'a elt = 'a elt
-	    datatype 'a t = T of {seq: 'a sequence, start: int, len: int}
-	    type 'a slice = 'a t
+         struct
+            type 'a sequence = 'a sequence
+            type 'a elt = 'a elt
+            datatype 'a t = T of {seq: 'a sequence, start: int, len: int}
+            type 'a slice = 'a t
 
-	    fun length (T {len, ...}) = len
-	    fun unsafeSub (T {seq, start, ...}, i) =
-	       S.sub (seq, start +? i)
-	    fun sub (sl as T {len, ...}, i) =
-	       if Primitive.safe andalso Primitive.Int.geu (i, len)
-		  then raise Subscript
-	       else unsafeSub (sl, i)
-	    fun unsafeUpdate' update (T {seq, start, ...}, i, x) =
-	       update (seq, start +? i, x)
-	    fun update' update (sl as T {len, ...}, i, x) =
-	       if Primitive.safe andalso Primitive.Int.geu (i, len)
-		  then raise Subscript
-	       else unsafeUpdate' update (sl, i, x)
-	    fun full (seq: 'a sequence) : 'a slice = 
-	       T {seq = seq, start = 0, len = S.length seq}
-	    fun subslice (T {seq, start, len}, start', len') = 
-	       case len' of
-		  NONE => if Primitive.safe andalso
-		             (start' < 0 orelse start' > len)
-			     then raise Subscript
-			  else T {seq = seq,
-				  start = start +? start',
-				  len = len -? start'}
-		| SOME len' => if Primitive.safe andalso
-			          (start' < 0 orelse start' > len orelse
-				   len' < 0 orelse len' > len -? start')
-				  then raise Subscript
-			       else T {seq = seq,
-				       start = start +? start',
-				       len = len'}
-	    fun unsafeSubslice (T {seq, start, len}, start', len') = 
-	       T {seq = seq, 
-		  start = start +? start',
-		  len = (case len' of
-			    NONE => len -? start'
-			  | SOME len' => len')}
-	    fun slice (seq: 'a sequence, start, len) =
-	       subslice (full seq, start, len)
-	    fun unsafeSlice (seq: 'a sequence, start, len) =
-	       unsafeSubslice (full seq, start, len)
-	    fun base (T {seq, start, len}) = (seq, start, len)
-	    fun isEmpty sl = length sl = 0
-	    fun getItem (sl as T {seq, start, len}) =
-	       if isEmpty sl
-		  then NONE
-	       else SOME (S.sub (seq, start), 
-			  T {seq = seq, 
-			     start = start +? 1, 
-			     len = len -? 1})
-	    fun foldli f b (T {seq, start, len}) =
-	       let
-		  val min = start
-		  val max = start +? len
-		  fun loop (i, b) =
-		     if i >= max then b
-		     else loop (i +? 1, f (i -? min, S.sub (seq, i), b))
-	       in loop (min, b)
-	       end
-	    fun foldri f b (T {seq, start, len}) =
-	       let
-		  val min = start
-		  val max = start +? len
-		  fun loop (i, b) =
-		     if i < min then b
-		     else loop (i -? 1, f (i -? min, S.sub (seq, i), b))
-	       in loop (max -? 1, b)
-	       end
-	    local
-	       fun make foldi f b sl = foldi (fn (_, x, b) => f (x, b)) b sl
-	    in
-	       fun foldl f = make foldli f
-	       fun foldr f = make foldri f
-	    end
-	    fun appi f sl = foldli (fn (i, x, ()) => f (i, x)) () sl
-	    fun app f sl = appi (f o #2) sl
-	    fun createi tabulate f (T {seq, start, len}) =
-	       tabulate (len, fn i => f (i, S.sub (seq, start +? i)))
-	    fun create tabulate f sl = createi tabulate (f o #2) sl
-	    fun mapi f sl = createi tabulate f sl
-	    fun map f sl = mapi (f o #2) sl
-	    fun findi p (T {seq, start, len}) = 
-	       let
-		  val min = start
-		  val max = start +? len
-		  fun loop i =
-		     if i >= max
-		        then NONE
-		     else let val z = (i -? min, S.sub (seq, i))
-			  in if p z
-			        then SOME z
-			     else loop (i +? 1)
-			  end
-	       in loop min
-	       end
-	    fun find p sl = Option.map #2 (findi (p o #2) sl)
-	    fun existsi p sl = Option.isSome (findi p sl)
-	    fun exists p sl = existsi (p o #2) sl
-	    fun alli p sl = not (existsi (not o p) sl)
-	    fun all p sl = alli (p o #2) sl
-	    fun collate cmp (T {seq = seq1, start = start1, len = len1},
-			     T {seq = seq2, start = start2, len = len2}) =
-	       let
-		  val min1 = start1
-		  val min2 = start2
-		  val max1 = start1 +? len1
-		  val max2 = start2 +? len2
-		  fun loop (i, j) =
-		     case (i >= max1, j >= max2) of
-		        (true, true) => EQUAL
-		      | (true, false) => LESS
-		      | (false, true) => GREATER
-		      | (false, false) => 
-			   (case cmp (S.sub (seq1, i), S.sub (seq2, j)) of
-			      EQUAL => loop (i +? 1, j +? 1)
-			    | ans => ans)
-	       in loop (min1, min2)
-	       end
-	    fun sequence (sl as T {seq, start, len}): 'a sequence =
-	       if isMutable orelse (start <> 0 orelse len <> S.length seq)
-		  then map (fn x => x) sl
-	       else seq
-	    fun append (sl1: 'a slice, sl2: 'a slice): 'a sequence =
-	       if length sl1 = 0
-		  then sequence sl2
-	       else if length sl2 = 0
-		  then sequence sl1
-	       else
-		  let
-		     val l1 = length sl1
-		     val l2 = length sl2
-		     val n = l1 + l2 handle Overflow => raise Size
-		  in
-		     unfoldi (n, (0, sl1),
-			      fn (_, (i, sl)) =>
-				  if i < length sl
-				     then (unsafeSub (sl, i), (i +? 1, sl))
-				  else (unsafeSub (sl2, 0), (1, sl2)))
-		  end
-	    fun concat (sls: 'a slice list): 'a sequence =
-	       case sls of
-		  [] => seq0 ()
-		| [sl] => sequence sl
-		| sls' as sl::sls =>
-		     let
-		        val n = List.foldl (fn (sl, s) => s + length sl) 0 sls'
-			        handle Overflow => raise Size
-		     in
-		        unfoldi (n, (0, sl, sls),
-				 fn (_, ac) =>
-				 let
-				    fun loop (i, sl, sls) =
-				       if i < length sl
-					  then (unsafeSub (sl, i), (i +? 1, sl, sls))
-				       else case sls of
-					       [] => raise Fail "concat bug"
-					     | sl :: sls => loop (0, sl, sls)
-				 in loop ac
-				 end)
-		     end
-	    fun concatWith (sep: 'a sequence) (sls: 'a slice list): 'a sequence =
-	       let val sep = full sep
-	       in case sls of
-		     [] => seq0 ()
-		   | [sl] => sequence sl
-		   | sl::sls =>
-		       List.foldl (fn (sl,seq) => 
-				   concat [full seq, sep, full (sequence sl)])
-		                  (sequence sl) sls
-	       end
-	    fun triml k =
-	       if Primitive.safe andalso k < 0
-		  then raise Subscript
-	       else
-		  (fn (T {seq, start, len}) =>
-		   if k > len
-		      then unsafeSlice (seq, start +? len, SOME 0)
-		   else unsafeSlice (seq, start +? k, SOME (len -? k)))
-	    fun trimr k =
-	       if Primitive.safe andalso k < 0
-		  then raise Subscript
-	       else 
-		  (fn (T {seq, start, len}) =>
-		   unsafeSlice (seq, start,
-				SOME (if k > len then 0 else len -? k)))
-	    fun isSubsequence (eq: 'a elt * 'a elt -> bool)
-	                      (seq: 'a sequence)
-			      (sl: 'a slice) =
-	       let
-		  val n = S.length seq
-		  val n' = length sl
-	       in
-		  if n <= n'
-		     then let
-			     val n'' = n' -? n
-			     fun loop (i, j) =
-			        if i > n''
-				   then false
-				else if j >= n
-				   then true
-				else if eq (S.sub (seq, j), unsafeSub (sl, i +? j))
-				   then loop (i, j +? 1)
-				else loop (i +? 1, 0)
-			  in
-			     loop (0, 0)
-			  end
-		  else false
-	       end
-	    fun isPrefix (eq: 'a elt * 'a elt -> bool)
-	                 (seq: 'a sequence)
-			 (sl: 'a slice) =
-	       let
-		  val n = S.length seq
-		  val n' = length sl
-	       in
-		  if n <= n'
-		     then let
-			     fun loop (j) =
-			        if j >= n
-				   then true
-				else if eq (S.sub (seq, j), unsafeSub (sl, j))
-				   then loop (j +? 1)
-				else false
-			  in
-			     loop (0)
-			  end
-		  else false
-	       end
-	    fun isSuffix (eq: 'a elt * 'a elt -> bool)
-	                 (seq: 'a sequence)
-			 (sl: 'a slice) =
-	       let
-		  val n = S.length seq
-		  val n' = length sl
-	       in
-		  if n <= n'
-		     then let
-			     val n'' = n' -? n
-			     fun loop (j) =
-			        if j >= n
-				   then true
-				else if eq (S.sub (seq, j), unsafeSub (sl, n'' +? j))
-				   then loop (j +? 1)
-				else false
-			  in
-			     loop (0)
-			  end
-		  else false
-	       end
-	    fun split (T {seq, start, len}, i) =
-	       (unsafeSlice (seq, start, SOME (i -? start)),
-		unsafeSlice (seq, i, SOME (len -? (i -? start))))
-	    fun splitl f (sl as T {seq, start, len}) =
-	       let
-		  val stop = start +? len
-		  fun loop i =
-		     if i >= stop
-		        then i
-		     else if f (S.sub (seq, i))
-		             then loop (i +? 1)
-			  else i
-	       in split (sl, loop start)
-	       end
-	    fun splitr f (sl as T {seq, start, len}) =
-	       let
-		  fun loop i =
-		     if i < start
-		        then start
-		     else if f (S.sub (seq, i))
-		             then loop (i -? 1)
-			  else i +? 1
-	       in split (sl, loop (start +? len -? 1))
-	       end
-	    fun splitAt (T {seq, start, len}, i) =
-	       if Primitive.safe andalso Primitive.Int.gtu (i, len)
-		  then raise Subscript
-	       else (unsafeSlice (seq, start, SOME i),
-		     unsafeSlice (seq, start +? i, SOME (len -? i)))
-	    fun dropl p s = #2 (splitl p s)
-	    fun dropr p s = #1 (splitr p s)
-	    fun takel p s = #1 (splitl p s)
-	    fun taker p s = #2 (splitr p s)
-	    fun position (eq: 'a elt * 'a elt -> bool)
-	                 (seq': 'a sequence)
-			 (sl as T {seq, start, len}) =
-	       let
-		  val len' = S.length seq'
-		  val max = start +? len -? len' +? 1
-		  (* loop returns the index of the front of the suffix. *)
-		  fun loop i =
-		     if i >= max
-		        then start +? len
-		     else let
-			     fun loop' j =
-			        if j >= len'
-				   then i
-				else if eq (S.sub (seq, i +? j), 
-					    S.sub (seq', j))
-				        then loop' (j +? 1)
-				     else loop (i +? 1)
-			  in loop' 0
-			  end
-	       in split (sl, loop start)
-	       end
-	    fun span (eq: 'a sequence * 'a sequence -> bool)
-	             (T {seq, start, ...},
-		      T {seq = seq', start = start', len = len'}) =
-	       if Primitive.safe andalso 
-		  (not (eq (seq, seq')) orelse start' +? len' < start)
-		  then raise Span
-	       else unsafeSlice (seq, start, SOME ((start' +? len') -? start))
-	    fun translate f (sl: 'a slice) =
-	       concat (List.rev (foldl (fn (c, l) => (full (f c)) :: l) [] sl))
-	    local
-	       fun make finish p (T {seq, start, len}) =
-		  let
-		     val max = start +? len
-		     fun loop (i, start, sls) =
-		        if i >= max
-			   then List.rev (finish (seq, start, i, sls))
-			else
-			   if p (S.sub (seq, i))
-			      then loop (i +? 1, i +? 1, finish (seq, start, i, sls))
-			   else loop (i +? 1, start, sls)
-		  in loop (start, start, []) 
-		  end
-	    in
-	       fun tokens p sl =
-		  make (fn (seq, start, stop, sls) =>
-			if start = stop
-			   then sls
-			else
-			   (unsafeSlice (seq, start, SOME (stop -? start)))
-			   :: sls)
-		       p sl
-	       fun fields p sl = 
-		  make (fn (seq, start, stop, sls) =>
-			(unsafeSlice (seq, start, SOME (stop -? start)))
-			:: sls)
-		       p sl
-	    end
-	    fun toList (sl: 'a slice) = foldr (fn (a,l) => a::l) [] sl
-	 end
+            fun length (T {len, ...}) = len
+            fun unsafeSub (T {seq, start, ...}, i) =
+               S.sub (seq, start +? i)
+            fun sub (sl as T {len, ...}, i) =
+               if Primitive.safe andalso Primitive.Int.geu (i, len)
+                  then raise Subscript
+               else unsafeSub (sl, i)
+            fun unsafeUpdate' update (T {seq, start, ...}, i, x) =
+               update (seq, start +? i, x)
+            fun update' update (sl as T {len, ...}, i, x) =
+               if Primitive.safe andalso Primitive.Int.geu (i, len)
+                  then raise Subscript
+               else unsafeUpdate' update (sl, i, x)
+            fun full (seq: 'a sequence) : 'a slice = 
+               T {seq = seq, start = 0, len = S.length seq}
+            fun subslice (T {seq, start, len}, start', len') = 
+               case len' of
+                  NONE => if Primitive.safe andalso
+                             (start' < 0 orelse start' > len)
+                             then raise Subscript
+                          else T {seq = seq,
+                                  start = start +? start',
+                                  len = len -? start'}
+                | SOME len' => if Primitive.safe andalso
+                                  (start' < 0 orelse start' > len orelse
+                                   len' < 0 orelse len' > len -? start')
+                                  then raise Subscript
+                               else T {seq = seq,
+                                       start = start +? start',
+                                       len = len'}
+            fun unsafeSubslice (T {seq, start, len}, start', len') = 
+               T {seq = seq, 
+                  start = start +? start',
+                  len = (case len' of
+                            NONE => len -? start'
+                          | SOME len' => len')}
+            fun slice (seq: 'a sequence, start, len) =
+               subslice (full seq, start, len)
+            fun unsafeSlice (seq: 'a sequence, start, len) =
+               unsafeSubslice (full seq, start, len)
+            fun base (T {seq, start, len}) = (seq, start, len)
+            fun isEmpty sl = length sl = 0
+            fun getItem (sl as T {seq, start, len}) =
+               if isEmpty sl
+                  then NONE
+               else SOME (S.sub (seq, start), 
+                          T {seq = seq, 
+                             start = start +? 1, 
+                             len = len -? 1})
+            fun foldli f b (T {seq, start, len}) =
+               let
+                  val min = start
+                  val max = start +? len
+                  fun loop (i, b) =
+                     if i >= max then b
+                     else loop (i +? 1, f (i -? min, S.sub (seq, i), b))
+               in loop (min, b)
+               end
+            fun foldri f b (T {seq, start, len}) =
+               let
+                  val min = start
+                  val max = start +? len
+                  fun loop (i, b) =
+                     if i < min then b
+                     else loop (i -? 1, f (i -? min, S.sub (seq, i), b))
+               in loop (max -? 1, b)
+               end
+            local
+               fun make foldi f b sl = foldi (fn (_, x, b) => f (x, b)) b sl
+            in
+               fun foldl f = make foldli f
+               fun foldr f = make foldri f
+            end
+            fun appi f sl = foldli (fn (i, x, ()) => f (i, x)) () sl
+            fun app f sl = appi (f o #2) sl
+            fun createi tabulate f (T {seq, start, len}) =
+               tabulate (len, fn i => f (i, S.sub (seq, start +? i)))
+            fun create tabulate f sl = createi tabulate (f o #2) sl
+            fun mapi f sl = createi tabulate f sl
+            fun map f sl = mapi (f o #2) sl
+            fun findi p (T {seq, start, len}) = 
+               let
+                  val min = start
+                  val max = start +? len
+                  fun loop i =
+                     if i >= max
+                        then NONE
+                     else let val z = (i -? min, S.sub (seq, i))
+                          in if p z
+                                then SOME z
+                             else loop (i +? 1)
+                          end
+               in loop min
+               end
+            fun find p sl = Option.map #2 (findi (p o #2) sl)
+            fun existsi p sl = Option.isSome (findi p sl)
+            fun exists p sl = existsi (p o #2) sl
+            fun alli p sl = not (existsi (not o p) sl)
+            fun all p sl = alli (p o #2) sl
+            fun collate cmp (T {seq = seq1, start = start1, len = len1},
+                             T {seq = seq2, start = start2, len = len2}) =
+               let
+                  val min1 = start1
+                  val min2 = start2
+                  val max1 = start1 +? len1
+                  val max2 = start2 +? len2
+                  fun loop (i, j) =
+                     case (i >= max1, j >= max2) of
+                        (true, true) => EQUAL
+                      | (true, false) => LESS
+                      | (false, true) => GREATER
+                      | (false, false) => 
+                           (case cmp (S.sub (seq1, i), S.sub (seq2, j)) of
+                              EQUAL => loop (i +? 1, j +? 1)
+                            | ans => ans)
+               in loop (min1, min2)
+               end
+            fun sequence (sl as T {seq, start, len}): 'a sequence =
+               if isMutable orelse (start <> 0 orelse len <> S.length seq)
+                  then map (fn x => x) sl
+               else seq
+            fun append (sl1: 'a slice, sl2: 'a slice): 'a sequence =
+               if length sl1 = 0
+                  then sequence sl2
+               else if length sl2 = 0
+                  then sequence sl1
+               else
+                  let
+                     val l1 = length sl1
+                     val l2 = length sl2
+                     val n = l1 + l2 handle Overflow => raise Size
+                  in
+                     unfoldi (n, (0, sl1),
+                              fn (_, (i, sl)) =>
+                                  if i < length sl
+                                     then (unsafeSub (sl, i), (i +? 1, sl))
+                                  else (unsafeSub (sl2, 0), (1, sl2)))
+                  end
+            fun concat (sls: 'a slice list): 'a sequence =
+               case sls of
+                  [] => seq0 ()
+                | [sl] => sequence sl
+                | sls' as sl::sls =>
+                     let
+                        val n = List.foldl (fn (sl, s) => s + length sl) 0 sls'
+                                handle Overflow => raise Size
+                     in
+                        unfoldi (n, (0, sl, sls),
+                                 fn (_, ac) =>
+                                 let
+                                    fun loop (i, sl, sls) =
+                                       if i < length sl
+                                          then (unsafeSub (sl, i), (i +? 1, sl, sls))
+                                       else case sls of
+                                               [] => raise Fail "concat bug"
+                                             | sl :: sls => loop (0, sl, sls)
+                                 in loop ac
+                                 end)
+                     end
+            fun concatWith (sep: 'a sequence) (sls: 'a slice list): 'a sequence =
+               let val sep = full sep
+               in case sls of
+                     [] => seq0 ()
+                   | [sl] => sequence sl
+                   | sl::sls =>
+                       List.foldl (fn (sl,seq) => 
+                                   concat [full seq, sep, full (sequence sl)])
+                                  (sequence sl) sls
+               end
+            fun triml k =
+               if Primitive.safe andalso k < 0
+                  then raise Subscript
+               else
+                  (fn (T {seq, start, len}) =>
+                   if k > len
+                      then unsafeSlice (seq, start +? len, SOME 0)
+                   else unsafeSlice (seq, start +? k, SOME (len -? k)))
+            fun trimr k =
+               if Primitive.safe andalso k < 0
+                  then raise Subscript
+               else 
+                  (fn (T {seq, start, len}) =>
+                   unsafeSlice (seq, start,
+                                SOME (if k > len then 0 else len -? k)))
+            fun isSubsequence (eq: 'a elt * 'a elt -> bool)
+                              (seq: 'a sequence)
+                              (sl: 'a slice) =
+               let
+                  val n = S.length seq
+                  val n' = length sl
+               in
+                  if n <= n'
+                     then let
+                             val n'' = n' -? n
+                             fun loop (i, j) =
+                                if i > n''
+                                   then false
+                                else if j >= n
+                                   then true
+                                else if eq (S.sub (seq, j), unsafeSub (sl, i +? j))
+                                   then loop (i, j +? 1)
+                                else loop (i +? 1, 0)
+                          in
+                             loop (0, 0)
+                          end
+                  else false
+               end
+            fun isPrefix (eq: 'a elt * 'a elt -> bool)
+                         (seq: 'a sequence)
+                         (sl: 'a slice) =
+               let
+                  val n = S.length seq
+                  val n' = length sl
+               in
+                  if n <= n'
+                     then let
+                             fun loop (j) =
+                                if j >= n
+                                   then true
+                                else if eq (S.sub (seq, j), unsafeSub (sl, j))
+                                   then loop (j +? 1)
+                                else false
+                          in
+                             loop (0)
+                          end
+                  else false
+               end
+            fun isSuffix (eq: 'a elt * 'a elt -> bool)
+                         (seq: 'a sequence)
+                         (sl: 'a slice) =
+               let
+                  val n = S.length seq
+                  val n' = length sl
+               in
+                  if n <= n'
+                     then let
+                             val n'' = n' -? n
+                             fun loop (j) =
+                                if j >= n
+                                   then true
+                                else if eq (S.sub (seq, j), unsafeSub (sl, n'' +? j))
+                                   then loop (j +? 1)
+                                else false
+                          in
+                             loop (0)
+                          end
+                  else false
+               end
+            fun split (T {seq, start, len}, i) =
+               (unsafeSlice (seq, start, SOME (i -? start)),
+                unsafeSlice (seq, i, SOME (len -? (i -? start))))
+            fun splitl f (sl as T {seq, start, len}) =
+               let
+                  val stop = start +? len
+                  fun loop i =
+                     if i >= stop
+                        then i
+                     else if f (S.sub (seq, i))
+                             then loop (i +? 1)
+                          else i
+               in split (sl, loop start)
+               end
+            fun splitr f (sl as T {seq, start, len}) =
+               let
+                  fun loop i =
+                     if i < start
+                        then start
+                     else if f (S.sub (seq, i))
+                             then loop (i -? 1)
+                          else i +? 1
+               in split (sl, loop (start +? len -? 1))
+               end
+            fun splitAt (T {seq, start, len}, i) =
+               if Primitive.safe andalso Primitive.Int.gtu (i, len)
+                  then raise Subscript
+               else (unsafeSlice (seq, start, SOME i),
+                     unsafeSlice (seq, start +? i, SOME (len -? i)))
+            fun dropl p s = #2 (splitl p s)
+            fun dropr p s = #1 (splitr p s)
+            fun takel p s = #1 (splitl p s)
+            fun taker p s = #2 (splitr p s)
+            fun position (eq: 'a elt * 'a elt -> bool)
+                         (seq': 'a sequence)
+                         (sl as T {seq, start, len}) =
+               let
+                  val len' = S.length seq'
+                  val max = start +? len -? len' +? 1
+                  (* loop returns the index of the front of the suffix. *)
+                  fun loop i =
+                     if i >= max
+                        then start +? len
+                     else let
+                             fun loop' j =
+                                if j >= len'
+                                   then i
+                                else if eq (S.sub (seq, i +? j), 
+                                            S.sub (seq', j))
+                                        then loop' (j +? 1)
+                                     else loop (i +? 1)
+                          in loop' 0
+                          end
+               in split (sl, loop start)
+               end
+            fun span (eq: 'a sequence * 'a sequence -> bool)
+                     (T {seq, start, ...},
+                      T {seq = seq', start = start', len = len'}) =
+               if Primitive.safe andalso 
+                  (not (eq (seq, seq')) orelse start' +? len' < start)
+                  then raise Span
+               else unsafeSlice (seq, start, SOME ((start' +? len') -? start))
+            fun translate f (sl: 'a slice) =
+               concat (List.rev (foldl (fn (c, l) => (full (f c)) :: l) [] sl))
+            local
+               fun make finish p (T {seq, start, len}) =
+                  let
+                     val max = start +? len
+                     fun loop (i, start, sls) =
+                        if i >= max
+                           then List.rev (finish (seq, start, i, sls))
+                        else
+                           if p (S.sub (seq, i))
+                              then loop (i +? 1, i +? 1, finish (seq, start, i, sls))
+                           else loop (i +? 1, start, sls)
+                  in loop (start, start, []) 
+                  end
+            in
+               fun tokens p sl =
+                  make (fn (seq, start, stop, sls) =>
+                        if start = stop
+                           then sls
+                        else
+                           (unsafeSlice (seq, start, SOME (stop -? start)))
+                           :: sls)
+                       p sl
+               fun fields p sl = 
+                  make (fn (seq, start, stop, sls) =>
+                        (unsafeSlice (seq, start, SOME (stop -? start)))
+                        :: sls)
+                       p sl
+            end
+            fun toList (sl: 'a slice) = foldr (fn (a,l) => a::l) [] sl
+         end
 
       local
-	fun make f seq = f (Slice.full seq)
-	fun make2 f (seq1, seq2) = f (Slice.full seq1, Slice.full seq2)
+        fun make f seq = f (Slice.full seq)
+        fun make2 f (seq1, seq2) = f (Slice.full seq1, Slice.full seq2)
       in
-	fun sub (seq, i) = Slice.sub (Slice.full seq, i)
-	fun unsafeSub (seq, i) = Slice.unsafeSub (Slice.full seq, i)
-	fun update' update (seq, i, x) = 
-	   Slice.update' update (Slice.full seq, i, x)
-	fun append seqs = make2 Slice.append seqs
-	fun concat seqs = Slice.concat (List.map Slice.full seqs)
-	fun appi f = make (Slice.appi f)
-	fun app f = make (Slice.app f)
-	fun mapi f = make (Slice.mapi f)
-	fun map f = make (Slice.map f)
-	fun foldli f b = make (Slice.foldli f b)
-	fun foldri f b = make (Slice.foldri f b)
-	fun foldl f b = make (Slice.foldl f b)
-	fun foldr f b = make (Slice.foldr f b)
-	fun findi p = make (Slice.findi p)
-	fun find p = make (Slice.find p)
-	fun existsi p = make (Slice.existsi p)
-	fun exists p = make (Slice.exists p)
-	fun alli p = make (Slice.alli p)
-	fun all p = make (Slice.all p)
-	fun collate cmp = make2 (Slice.collate cmp)
-	fun concatWith sep seqs = Slice.concatWith sep (List.map Slice.full seqs)
-	fun isPrefix eq seq = make (Slice.isPrefix eq seq)
-	fun isSubsequence eq seq = make (Slice.isSubsequence eq seq)
-	fun isSuffix eq seq = make (Slice.isSuffix eq seq)
-	fun translate f = make (Slice.translate f)
-	fun tokens f seq = List.map Slice.sequence (make (Slice.tokens f) seq)
-	fun fields f seq = List.map Slice.sequence (make (Slice.fields f) seq)
-	fun createi tabulate f seq = make (Slice.createi tabulate f) seq
-	fun create tabulate f seq = make (Slice.create tabulate f) seq
-	fun duplicate seq = make Slice.sequence seq
-	fun toList seq = make Slice.toList seq
+        fun sub (seq, i) = Slice.sub (Slice.full seq, i)
+        fun unsafeSub (seq, i) = Slice.unsafeSub (Slice.full seq, i)
+        fun update' update (seq, i, x) = 
+           Slice.update' update (Slice.full seq, i, x)
+        fun append seqs = make2 Slice.append seqs
+        fun concat seqs = Slice.concat (List.map Slice.full seqs)
+        fun appi f = make (Slice.appi f)
+        fun app f = make (Slice.app f)
+        fun mapi f = make (Slice.mapi f)
+        fun map f = make (Slice.map f)
+        fun foldli f b = make (Slice.foldli f b)
+        fun foldri f b = make (Slice.foldri f b)
+        fun foldl f b = make (Slice.foldl f b)
+        fun foldr f b = make (Slice.foldr f b)
+        fun findi p = make (Slice.findi p)
+        fun find p = make (Slice.find p)
+        fun existsi p = make (Slice.existsi p)
+        fun exists p = make (Slice.exists p)
+        fun alli p = make (Slice.alli p)
+        fun all p = make (Slice.all p)
+        fun collate cmp = make2 (Slice.collate cmp)
+        fun concatWith sep seqs = Slice.concatWith sep (List.map Slice.full seqs)
+        fun isPrefix eq seq = make (Slice.isPrefix eq seq)
+        fun isSubsequence eq seq = make (Slice.isSubsequence eq seq)
+        fun isSuffix eq seq = make (Slice.isSuffix eq seq)
+        fun translate f = make (Slice.translate f)
+        fun tokens f seq = List.map Slice.sequence (make (Slice.tokens f) seq)
+        fun fields f seq = List.map Slice.sequence (make (Slice.fields f) seq)
+        fun createi tabulate f seq = make (Slice.createi tabulate f) seq
+        fun create tabulate f seq = make (Slice.create tabulate f) seq
+        fun duplicate seq = make Slice.sequence seq
+        fun toList seq = make Slice.toList seq
       end
     
       (* Deprecated *)
       fun checkSliceMax (start: int, num: int option, max: int): int =
-	 case num of
-	    NONE => if Primitive.safe andalso (start < 0 orelse start > max)
-		       then raise Subscript
-		    else max
-	  | SOME num =>
-	       if Primitive.safe
-		  andalso (start < 0 orelse num < 0 orelse start > max -? num)
-		  then raise Subscript
-	       else start +? num
+         case num of
+            NONE => if Primitive.safe andalso (start < 0 orelse start > max)
+                       then raise Subscript
+                    else max
+          | SOME num =>
+               if Primitive.safe
+                  andalso (start < 0 orelse num < 0 orelse start > max -? num)
+                  then raise Subscript
+               else start +? num
       (* Deprecated *)
       fun checkSlice (s, i, opt) = checkSliceMax (i, opt, length s)
    end

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/arrays-and-vectors/sequence.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/arrays-and-vectors/sequence.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/arrays-and-vectors/sequence.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,9 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 signature SEQUENCE =
@@ -12,7 +12,7 @@
       type 'a elt
 
       structure Slice : SLICE where type 'a sequence = 'a sequence
-	                        and type 'a elt = 'a elt
+                                and type 'a elt = 'a elt
 
       val maxLen: int
       val fromList: 'a elt list -> 'a sequence

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/arrays-and-vectors/slice.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/arrays-and-vectors/slice.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/arrays-and-vectors/slice.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,9 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 signature SLICE =
@@ -75,9 +75,9 @@
        * (int * (int -> 'b elt) -> 'c  should be a tabulate function.
        *)
       val createi: (int * (int -> 'b elt) -> 'c) ->
-	           (int * 'a elt -> 'b elt) -> 'a slice -> 'c
+                   (int * 'a elt -> 'b elt) -> 'a slice -> 'c
       val create: (int * (int -> 'b elt) -> 'c) ->
-	          ('a elt -> 'b elt) -> 'a slice -> 'c
+                  ('a elt -> 'b elt) -> 'a slice -> 'c
       val toList: 'a slice -> 'a elt list
       val sequence: 'a slice -> 'a sequence
    end

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/arrays-and-vectors/vector.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/arrays-and-vectors/vector.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/arrays-and-vectors/vector.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,38 +1,39 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 structure Vector: VECTOR_EXTRA =
    struct
       structure V = Sequence (type 'a sequence = 'a vector
-			      type 'a elt = 'a
-			      val fromArray = Primitive.Vector.fromArray
-			      val isMutable = false
-			      val length = Primitive.Vector.length
-			      val sub = Primitive.Vector.sub)
+                              type 'a elt = 'a
+                              val fromArray = Primitive.Vector.fromArray
+                              val isMutable = false
+                              val length = Primitive.Vector.length
+                              val sub = Primitive.Vector.sub)
       open V
 
       type 'a vector = 'a vector
 
       structure VectorSlice = 
-	 struct
-	    open Slice
-	    type 'a vector = 'a vector
-	    val vector = sequence
+         struct
+            open Slice
+            type 'a vector = 'a vector
+            val vector = sequence
 
-	    val isSubvector = isSubsequence
-	    val span = fn (sl, sl') => 
-	       span (op = : ''a vector * ''a vector -> bool) (sl, sl')
-	 end
+            val isSubvector = isSubsequence
+            val span = fn (sl, sl') => 
+               span (op = : ''a vector * ''a vector -> bool) (sl, sl')
+         end
 
       fun update (v, i, x) = 
-	tabulate (length v,
-		  fn j => if i = j 
-			     then x
-			  else unsafeSub (v, j))
+        tabulate (length v,
+                  fn j => if i = j 
+                             then x
+                          else unsafeSub (v, j))
 
       val unsafeSub = Primitive.Vector.sub
 

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/basis-1997.mlb
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/basis-1997.mlb	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/basis-1997.mlb	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,17 +1,27 @@
+(* Copyright (C) 2004-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 ann  
    "deadCode true"
-   "sequenceUnit true"
-   "warnMatch true"
-   "warnUnused true" "forceUsed"
+   "sequenceNonUnit warn"
+   "nonexhaustiveMatch warn" "redundantMatch warn"
+   "warnUnused true" "forceUsed" 
 in
    local
       basis-2002.mlb
-      libs/basis-1997/basis-1997.mlb
+      libs/basis-1997/basis-1997.mlb 
    in
       libs/basis-1997/top-level/basis-funs.sml
       libs/basis-1997/top-level/basis-sigs.sml
       libs/basis-1997/top-level/top-level.sml
       libs/basis-1997/top-level/infixes.sml
-      ann "allowOverload true" in libs/basis-1997/top-level/overloads.sml end
-  end
+      ann "allowOverload true" 
+      in
+         libs/basis-1997/top-level/overloads.sml 
+      end
+   end
 end

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/basis-2002.mlb
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/basis-2002.mlb	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/basis-2002.mlb	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,7 +1,14 @@
+(* Copyright (C) 2004-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 ann  
    "deadCode true"
-   "sequenceUnit true"
-   "warnMatch true"
+   "sequenceNonUnit warn"
+   "nonexhaustiveMatch warn" "redundantMatch warn"
    "warnUnused true" "forceUsed"
 in
    local
@@ -12,6 +19,8 @@
       libs/basis-2002/top-level/basis-sigs.sml
       libs/basis-2002/top-level/top-level.sml
       libs/basis-2002/top-level/infixes.sml
-      ann "allowOverload true" in libs/basis-2002/top-level/overloads.sml end
-    end
+      ann "allowOverload true" in 
+         libs/basis-2002/top-level/overloads.sml 
+      end
+   end
 end

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/basis-none.mlb
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/basis-none.mlb	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/basis-none.mlb	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,7 +1,14 @@
+(* Copyright (C) 2004-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 ann  
    "deadCode true"
-   "sequenceUnit true"
-   "warnMatch true"
+   "sequenceNonUnit warn"
+   "nonexhaustiveMatch warn" "redundantMatch warn"
    "warnUnused true" "forceUsed"
 in
    local

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/basis.mlb
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/basis.mlb	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/basis.mlb	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1 +1,8 @@
+(* Copyright (C) 2004-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 basis-2002.mlb

Copied: mlton/branches/on-20050420-cmm-branch/basis-library/default.mlb (from rev 4358, mlton/trunk/basis-library/default.mlb)

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/equal.mlb
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/equal.mlb	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/equal.mlb	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,7 +1,14 @@
+(* Copyright (C) 2004-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 ann  
    "deadCode true"
-   "sequenceUnit true"
-   "warnMatch true"
+   "sequenceNonUnit warn"
+   "nonexhaustiveMatch warn" "redundantMatch warn"
    "warnUnused true" "forceUsed"
 in
    local
@@ -10,5 +17,5 @@
       libs/basis-2002/top-level/basis-equal.sig
    in
       libs/basis-2002/top-level/pervasive-equal.sml
-    end
+   end
 end

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/general/bool.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/general/bool.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/general/bool.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 structure Bool: BOOL =
    struct
       datatype bool = datatype bool
@@ -12,25 +13,25 @@
       val not = not
 
       fun scan reader state =
-	 case reader state of
-	    NONE => NONE
-	  | SOME(c, state) =>
-	       case c of
-		  #"f" => (case Reader.reader4 reader state of
-			      SOME((#"a", #"l", #"s", #"e"), state) =>
-				 SOME(false, state)
-			    | _ => NONE)
-		| #"t" => (case Reader.reader3 reader state of
-			      SOME((#"r", #"u", #"e"), state) =>
-				 SOME(true, state)
-			    | _ => NONE)
-		| _ => NONE
-	       
+         case reader state of
+            NONE => NONE
+          | SOME(c, state) =>
+               case c of
+                  #"f" => (case Reader.reader4 reader state of
+                              SOME((#"a", #"l", #"s", #"e"), state) =>
+                                 SOME(false, state)
+                            | _ => NONE)
+                | #"t" => (case Reader.reader3 reader state of
+                              SOME((#"r", #"u", #"e"), state) =>
+                                 SOME(true, state)
+                            | _ => NONE)
+                | _ => NONE
+               
       val fromString = StringCvt.scanString scan
 
       val toString =
-	 fn true => "true"
-	  | false => "false"
+         fn true => "true"
+          | false => "false"
    end
 
 structure BoolGlobal: BOOL_GLOBAL = Bool

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/general/general.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/general/general.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/general/general.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 structure General: GENERAL_EXTRA =
    struct
       type unit = unit
@@ -31,23 +32,23 @@
       val exnName = Primitive.Exn.name
 
       local
-	 val messagers: (exn -> string option) list ref = ref []
+         val messagers: (exn -> string option) list ref = ref []
       in
-	 val addExnMessager: (exn -> string option) -> unit =
-	    fn f => messagers := f :: !messagers
-	    
-	 val rec exnMessage: exn -> string =
-	    fn e =>
-	    let
-	       val rec find =
-		  fn [] => exnName e
-		   | m :: ms =>
-			case m e of
-			   NONE => find ms
-			 | SOME s => s
-	    in
-	       find (!messagers)
-	    end
+         val addExnMessager: (exn -> string option) -> unit =
+            fn f => messagers := f :: !messagers
+            
+         val rec exnMessage: exn -> string =
+            fn e =>
+            let
+               val rec find =
+                  fn [] => exnName e
+                   | m :: ms =>
+                        case m e of
+                           NONE => find ms
+                         | SOME s => s
+            in
+               find (!messagers)
+            end
       end
    end
 

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/general/option.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/general/option.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/general/option.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -16,7 +16,7 @@
       val app: ('a -> unit) -> 'a option -> unit
       val compose: ('a -> 'b) * ('c -> 'a option) -> 'c -> 'b option 
       val composePartial:
-	 ('a -> 'b option) * ('c -> 'a option) -> 'c -> 'b option 
+         ('a -> 'b option) * ('c -> 'a option) -> 'c -> 'b option 
       val filter: ('a -> bool) -> 'a -> 'a option 
       val join: 'a option option -> 'a option 
       val map: ('a -> 'b) -> 'a option -> 'b option 

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/general/option.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/general/option.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/general/option.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 structure Option: OPTION =
 struct
 

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/general/sml90.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/general/sml90.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/general/sml90.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 structure SML90:> SML90 =
    struct
       type instream = TextIO.instream
@@ -26,44 +27,44 @@
 
       local open Real.Math
       in
-	 val sqrt = fn x => if Real.< (x, 0.0) then raise Sqrt else sqrt x
-	 val exp = fn x => let val y = exp x
-			   in if Real.isFinite y
-				 then y
-			      else raise Exp
-			   end
-	 val ln = fn x => if Real.> (x, 0.0) then ln x else raise Ln
-	 val sin = sin
-	 val cos = cos
-	 val arctan = atan
+         val sqrt = fn x => if Real.< (x, 0.0) then raise Sqrt else sqrt x
+         val exp = fn x => let val y = exp x
+                           in if Real.isFinite y
+                                 then y
+                              else raise Exp
+                           end
+         val ln = fn x => if Real.> (x, 0.0) then ln x else raise Ln
+         val sin = sin
+         val cos = cos
+         val arctan = atan
       end
 
       fun ord s =
-	 if String.size s = 0
-	    then raise Ord
-	 else Char.ord(String.sub(s, 0))
+         if String.size s = 0
+            then raise Ord
+         else Char.ord(String.sub(s, 0))
 
       val chr = String.str o Char.chr
       fun explode s = List.map String.str (String.explode s)
       val implode = String.concat
       fun lookahead ins =
-	 case TextIO.lookahead ins of
-	    NONE => ""
-	  | SOME c => str c
-	       
+         case TextIO.lookahead ins of
+            NONE => ""
+          | SOME c => str c
+               
       val std_in = TextIO.stdIn
       fun open_in f =
-	 TextIO.openIn f handle IO.Io _ => raise Io (concat ["Cannot open ", f])
+         TextIO.openIn f handle IO.Io _ => raise Io (concat ["Cannot open ", f])
       fun input ins =
-	 TextIO.inputN ins handle IO.Io _ => raise Io "Input stream is closed"
+         TextIO.inputN ins handle IO.Io _ => raise Io "Input stream is closed"
       val close_in = TextIO.closeIn
       fun end_of_stream ins = TextIO.endOfStream ins handle _ => true
       val std_out = TextIO.stdOut
       fun open_out f =
-	 TextIO.openOut f
-	 handle IO.Io _ => raise Io (concat ["Cannot open ", f]) 
+         TextIO.openOut f
+         handle IO.Io _ => raise Io (concat ["Cannot open ", f]) 
       fun output (out, s) =
-	 TextIO.output (out, s)
-	 handle IO.Io _ => raise Io "Output stream is closed"
+         TextIO.output (out, s)
+         handle IO.Io _ => raise Io "Output stream is closed"
       val close_out = TextIO.closeOut
    end

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/infixes.mlb
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/infixes.mlb	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/infixes.mlb	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,7 +1,14 @@
+(* Copyright (C) 2004-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 ann  
    "deadCode true"
-   "sequenceUnit true"
-   "warnMatch true"
+   "sequenceNonUnit warn"
+   "nonexhaustiveMatch warn" "redundantMatch warn"
    "warnUnused true" "forceUsed"
 in
    libs/basis-2002/top-level/infixes.sml

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/integer/embed-int.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/integer/embed-int.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/integer/embed-int.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,10 @@
+(* Copyright (C) 2004-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 signature EMBED_INT =
    sig
       eqtype int
@@ -2,3 +9,3 @@
       type big
-	 
+         
       val precision': Int.int
@@ -9,20 +16,20 @@
    end
 
 functor EmbedInt (structure Big: INTEGER_EXTRA
-		  structure Small: EMBED_INT where type big = Big.int): INTEGER =
+                  structure Small: EMBED_INT where type big = Big.int): INTEGER =
    struct
       val () = if Int.< (Small.precision', valOf Big.precision) then ()
-	       else raise Fail "EmbedWord"
+               else raise Fail "EmbedWord"
 
       open Small
 
       val shift = Word.fromInt (Int.- (valOf Big.precision, precision'))
 
       val extend: Big.int -> Big.int =
-	 fn i => Big.~>> (Big.<< (i, shift), shift)
+         fn i => Big.~>> (Big.<< (i, shift), shift)
 
       val toBig: Small.int -> Big.int = extend o Small.toBig
-	 
+         
       val precision = SOME precision'
 
       val maxIntBig = Big.>> (Big.fromInt ~1, Word.+ (shift, 0w1))
@@ -32,40 +39,40 @@
       val mask = Big.>> (Big.fromInt ~1, shift)
 
       fun fromBig (i: Big.int): int =
-	 let
-	    val i' = Big.andb (i, mask)
-	 in
-	    if i = extend i'
-	       then fromBigUnsafe i'
-	    else raise Overflow
-	 end
-	       
+         let
+            val i' = Big.andb (i, mask)
+         in
+            if i = extend i'
+               then fromBigUnsafe i'
+            else raise Overflow
+         end
+               
       val maxInt = SOME (fromBig maxIntBig)
 
       val minInt = SOME (fromBig minIntBig)
-	 
+         
       local
-	 val make: (Big.int * Big.int -> Big.int) -> (int * int -> int) =
-	    fn f => fn (x, y) => fromBig (f (toBig x, toBig y))
+         val make: (Big.int * Big.int -> Big.int) -> (int * int -> int) =
+            fn f => fn (x, y) => fromBig (f (toBig x, toBig y))
       in
-	 val op * = make Big.*
-	 val op + = make Big.+
-	 val op - = make Big.-
-	 val op div = make Big.div
-	 val op mod = make Big.mod
-	 val quot = make Big.quot
-	 val rem = make Big.rem
+         val op * = make Big.*
+         val op + = make Big.+
+         val op - = make Big.-
+         val op div = make Big.div
+         val op mod = make Big.mod
+         val quot = make Big.quot
+         val rem = make Big.rem
       end
 
       local
-	 val make: (Big.int * Big.int -> 'a) -> (int * int -> 'a) =
-	    fn f => fn (x, y) => f (toBig x, toBig y)
+         val make: (Big.int * Big.int -> 'a) -> (int * int -> 'a) =
+            fn f => fn (x, y) => f (toBig x, toBig y)
       in
-	 val op < = make Big.<
-	 val op <= = make Big.<=
-	 val op > = make Big.>
-	 val op >= = make Big.>=
-	 val compare = make Big.compare
+         val op < = make Big.<
+         val op <= = make Big.<=
+         val op > = make Big.>
+         val op >= = make Big.>=
+         val compare = make Big.compare
       end
 
       val fromInt = fromBig o Big.fromInt
@@ -73,11 +80,11 @@
       val toInt = Big.toInt o toBig
 
       local
-	 val make: (Big.int -> Big.int) -> (int -> int) =
-	    fn f => fn x => fromBig (f (toBig x))
+         val make: (Big.int -> Big.int) -> (int -> int) =
+            fn f => fn x => fromBig (f (toBig x))
       in
-	 val ~ = make Big.~
-	 val abs = make Big.abs
+         val ~ = make Big.~
+         val abs = make Big.abs
       end
 
       fun fmt r i = Big.fmt r (toBig i)
@@ -91,10 +98,10 @@
       fun min (i, j) = if i <= j then i else j
 
       fun scan r reader state =
-	 Option.map
-	 (fn (i, state) => (fromBig i, state))
-	 (Big.scan r reader state)
-	 
+         Option.map
+         (fn (i, state) => (fromBig i, state))
+         (Big.scan r reader state)
+         
       val sign = Big.sign o toBig
 
       fun sameSign (x, y) = sign x = sign y
@@ -106,15 +113,15 @@
 
 functor Embed8 (Small: EMBED_INT where type big = Int8.int): INTEGER =
    EmbedInt (structure Big = Int8
-	     structure Small = Small)
+             structure Small = Small)
 
 functor Embed16 (Small: EMBED_INT where type big = Int16.int): INTEGER =
    EmbedInt (structure Big = Int16
-	     structure Small = Small)
+             structure Small = Small)
 
 functor Embed32 (Small: EMBED_INT where type big = Int32.int): INTEGER =
    EmbedInt (structure Big = Int32
-	     structure Small = Small)
+             structure Small = Small)
 
 structure Int1 = Embed8 (Primitive.Int1)
 structure Int2 = Embed8 (Primitive.Int2)

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/integer/embed-word.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/integer/embed-word.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/integer/embed-word.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,10 @@
+(* Copyright (C) 2004-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 signature EMBED_WORD =
    sig
       eqtype word
@@ -2,3 +9,3 @@
       type big
-	 
+         
       val fromBigUnsafe: big -> word
@@ -9,108 +16,108 @@
    end
 
 functor EmbedWord (structure Big: WORD
-		   structure Small: EMBED_WORD where type big = Big.word): WORD =
+                   structure Small: EMBED_WORD where type big = Big.word): WORD =
    struct
       val () = if Int.< (Small.wordSize, Big.wordSize) then ()
-	       else raise Fail "EmbedWord"
-		  
+               else raise Fail "EmbedWord"
+                  
       open Small
 
       fun ones size =
-	 Big.- (Big.<< (Big.fromLarge 0w1, Word.fromInt size),
-		Big.fromLarge 0w1)
-	 
+         Big.- (Big.<< (Big.fromLarge 0w1, Word.fromInt size),
+                Big.fromLarge 0w1)
+         
       val maxWord = ones wordSize
 
       fun fromBig (w: Big.word): word =
-	 fromBigUnsafe (Big.andb (w, maxWord))
+         fromBigUnsafe (Big.andb (w, maxWord))
 
       fun fromBigOverflow (w: Big.word): word =
-	 if Big.<= (w, maxWord)
-	    then fromBigUnsafe w
-	 else raise Overflow
+         if Big.<= (w, maxWord)
+            then fromBigUnsafe w
+         else raise Overflow
 
       fun highBitIsSet (w: Big.word): bool =
-	 Big.> (w, ones (Int.- (wordSize, 1)))
-	 
+         Big.> (w, ones (Int.- (wordSize, 1)))
+         
       fun toBigX (w: word): Big.word =
-	 let
-	    val w = toBig w
-	 in
-	    if highBitIsSet w
-	       then Big.orb (w, Big.notb maxWord)
-	    else w
-	 end
+         let
+            val w = toBig w
+         in
+            if highBitIsSet w
+               then Big.orb (w, Big.notb maxWord)
+            else w
+         end
 
       local
-	 val make: (Big.word * Big.word -> Big.word) -> (word * word -> word) =
-	    fn f => fn (x, y) => fromBig (f (toBig x, toBig y))
+         val make: (Big.word * Big.word -> Big.word) -> (word * word -> word) =
+            fn f => fn (x, y) => fromBig (f (toBig x, toBig y))
       in
-	 val op * = make Big.*
-	 val op + = make Big.+
-	 val op - = make Big.-
-	 val andb = make Big.andb
-	 val op div = make Big.div
-	 val op mod = make Big.mod
-	 val orb  = make Big.orb
-	 val xorb  = make Big.xorb
+         val op * = make Big.*
+         val op + = make Big.+
+         val op - = make Big.-
+         val andb = make Big.andb
+         val op div = make Big.div
+         val op mod = make Big.mod
+         val orb  = make Big.orb
+         val xorb  = make Big.xorb
       end
 
       local
-	 val make: ((Big.word * Word.word -> Big.word)
-		    -> word * Word.word -> word) =
-	    fn f => fn (w, w') => fromBig (f (toBig w, w'))
+         val make: ((Big.word * Word.word -> Big.word)
+                    -> word * Word.word -> word) =
+            fn f => fn (w, w') => fromBig (f (toBig w, w'))
       in
-	 val >> = make Big.>>
-	 val << = make Big.<<
+         val >> = make Big.>>
+         val << = make Big.<<
       end
 
       fun ~>> (w, w') = fromBig (Big.~>> (toBigX w, w'))
 
       local
-	 val make: (Big.word * Big.word -> 'a) -> (word * word -> 'a) =
-	    fn f => fn (x, y) => f (toBig x, toBig y)
+         val make: (Big.word * Big.word -> 'a) -> (word * word -> 'a) =
+            fn f => fn (x, y) => f (toBig x, toBig y)
       in
-	 val op < = make Big.<
-	 val op <= = make Big.<=
-	 val op > = make Big.>
-	 val op >= = make Big.>=
-	 val compare = make Big.compare
+         val op < = make Big.<
+         val op <= = make Big.<=
+         val op > = make Big.>
+         val op >= = make Big.>=
+         val compare = make Big.compare
       end
 
       local
-	 val make: (Big.word -> Big.word) -> word -> word =
-	    fn f => fn w => fromBig (f (toBig w))
+         val make: (Big.word -> Big.word) -> word -> word =
+            fn f => fn w => fromBig (f (toBig w))
       in
-	 val notb = make Big.notb
+         val notb = make Big.notb
       end
 
       local
-	 val make: ('a -> Big.word) -> 'a -> word =
-	    fn f => fn a => fromBig (f a)
+         val make: ('a -> Big.word) -> 'a -> word =
+            fn f => fn a => fromBig (f a)
       in
-	 val fromInt = make Big.fromInt
-	 val fromLarge = make Big.fromLarge
-	 val fromLargeInt = make Big.fromLargeInt
+         val fromInt = make Big.fromInt
+         val fromLarge = make Big.fromLarge
+         val fromLargeInt = make Big.fromLargeInt
       end
 
       local
-	 val make: (Big.word -> 'a) -> word -> 'a =
-	    fn f => fn w => f (toBig w)
+         val make: (Big.word -> 'a) -> word -> 'a =
+            fn f => fn w => f (toBig w)
       in
-	 val toInt = make Big.toInt
-	 val toLarge = make Big.toLarge
-	 val toLargeInt = make Big.toLargeInt
-	 val toString = make Big.toString
+         val toInt = make Big.toInt
+         val toLarge = make Big.toLarge
+         val toLargeInt = make Big.toLargeInt
+         val toString = make Big.toString
       end
 
       local
-	 val make: (Big.word -> 'a) -> word -> 'a =
-	    fn f => fn w => f (toBigX w)
+         val make: (Big.word -> 'a) -> word -> 'a =
+            fn f => fn w => f (toBigX w)
       in
-	 val toIntX = make Big.toIntX
-	 val toLargeIntX = make Big.toLargeIntX
-	 val toLargeX = make Big.toLargeX
+         val toIntX = make Big.toIntX
+         val toLargeIntX = make Big.toLargeIntX
+         val toLargeX = make Big.toLargeX
       end
 
       fun fmt r i = Big.fmt r (toBig i)
@@ -124,28 +131,28 @@
       fun min (w, w') = if w <= w' then w else w'
 
       fun scan r reader state =
-	 Option.map
-	 (fn (w, state) => (fromBigOverflow w, state))
-	 (Big.scan r reader state)
+         Option.map
+         (fn (w, state) => (fromBigOverflow w, state))
+         (Big.scan r reader state)
 
       val toLargeWord = toLarge
 
       val toLargeWordX = toLargeX
-	 
+         
       fun ~ w = fromLarge 0w0 - w
    end
 
 functor EmbedWord8 (Small: EMBED_WORD where type big = Word8.word): WORD =
    EmbedWord (structure Big = Word8
-	      structure Small = Small)
+              structure Small = Small)
 
 functor EmbedWord16 (Small: EMBED_WORD where type big = Word16.word): WORD =
    EmbedWord (structure Big = Word16
-	      structure Small = Small)
+              structure Small = Small)
 
 functor EmbedWord32 (Small: EMBED_WORD where type big = Word32.word): WORD =
    EmbedWord (structure Big = Word32
-	      structure Small = Small)
+              structure Small = Small)
 
 structure Word1 = EmbedWord8 (Primitive.Word1)
 structure Word2 = EmbedWord8 (Primitive.Word2)

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/integer/int-inf.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/integer/int-inf.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/integer/int-inf.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -23,7 +23,7 @@
       val gcd: int * int -> int 
       val isSmall: int -> bool
       datatype rep =
-	 Big of Word.word Vector.vector
+         Big of Word.word Vector.vector
        | Small of Int.int
       val rep: int -> rep
       val toInt64: int -> Int64.int

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/integer/int-inf.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/integer/int-inf.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/integer/int-inf.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 (*
  * IntInf.int's either have a bottom bit of 1, in which case the top 31
  * bits are the signed integer, or else the bottom bit is 0, in which case
@@ -16,25 +17,25 @@
 structure IntInf: INT_INF_EXTRA =
    struct
       structure Word = Word32
-	 
+         
       datatype rep =
-	 Big of Word.word Vector.vector
+         Big of Word.word Vector.vector
        | Small of Int.int
-	 
+         
       structure Prim = Primitive.IntInf
       type bigInt = Prim.int
       local
-	 open Int
+         open Int
       in
-	 val op < = op <
-	 val op <= = op <=
-	 val op > = op >
-	 val op >= = op >=
-	 val op + = op +
-	 val op - = op -
+         val op < = op <
+         val op <= = op <=
+         val op > = op >
+         val op >= = op >=
+         val op + = op +
+         val op - = op -
       end
       type smallInt = int
-	 
+         
       (* bigIntConstant is just to make it easy to spot where the bigInt
        * constants are in this module.
        *)
@@ -42,17 +43,17 @@
       val zero = bigIntConstant 0
       val one = bigIntConstant 1
       val negOne = bigIntConstant ~1
-	 
+         
       (* Check if an IntInf.int is small (i.e., a fixnum). *)
       fun isSmall (i: bigInt): bool =
-	 0w0 <> Word.andb (Prim.toWord i, 0w1)
+         0w0 <> Word.andb (Prim.toWord i, 0w1)
 
       (* Check if two IntInf.int's are both small (i.e., fixnums).
        * This is a gross hack, but uses only one test.
        *)
       fun areSmall (i: bigInt, i': bigInt) =
-	 0w0 <> Word.andb (Prim.toWord i, Word.andb (Prim.toWord i', 0w1))
-	 
+         0w0 <> Word.andb (Prim.toWord i, Word.andb (Prim.toWord i', 0w1))
+         
       (*
        * Return the number of `limbs' in a bigInt.
        * If arg is big, then |arg| is in [ 2^ (32 (x-1)), 2^ (32 x) )
@@ -60,11 +61,11 @@
        * [ - 2^30, 2^30 ).
        *)
       fun bigSize (arg: bigInt): smallInt =
-	 Vector.length (Prim.toVector arg) -? 1
+         Vector.length (Prim.toVector arg) -? 1
       fun size (arg: bigInt): smallInt =
-	 if isSmall arg
-	    then 1
-	 else bigSize arg
+         if isSmall arg
+            then 1
+         else bigSize arg
 
       val bytesPerWord = 0w4
       (*
@@ -74,10 +75,10 @@
        * below.
        *)
       fun reserve (size: smallInt, extra: smallInt): word = 
-	 Word.* (bytesPerWord,
-		 Word.+ (Word.fromInt size,
-			 Word.+ (0w4, (* counter, size, header, sign words *)
-				 Word.fromInt extra)))
+         Word.* (bytesPerWord,
+                 Word.+ (Word.fromInt size,
+                         Word.+ (0w4, (* counter, size, header, sign words *)
+                                 Word.fromInt extra)))
 
       (*
        * Given a fixnum bigInt, return the Word.word which it
@@ -86,14 +87,14 @@
        * which is a bignum bigInt.
        *)
       fun stripTag (arg: bigInt): Word.word =
-	 Word.~>> (Prim.toWord arg, 0w1)
+         Word.~>> (Prim.toWord arg, 0w1)
 
       (*
        * Given a Word.word, add the tag bit in so that it looks like
        * a fixnum bigInt.
        *)
       fun addTag (argw: Word.word): Word.word =
-	 Word.orb (Word.<< (argw, 0w1), 0w1)
+         Word.orb (Word.<< (argw, 0w1), 0w1)
 
       (*
        * Given a fixnum bigInt, change the tag bit to 0.
@@ -101,13 +102,13 @@
        * which is a bignum bigInt.
        *)
       fun zeroTag (arg: bigInt): Word.word =
-	 Word.andb (Prim.toWord arg, 0wxFFFFFFFE)
+         Word.andb (Prim.toWord arg, 0wxFFFFFFFE)
 
       (*
        * Given a Word.word, set the tag bit back to 1.
        *)
       fun incTag (argw: Word.word): Word.word =
-	 Word.orb (argw, 0w1)
+         Word.orb (argw, 0w1)
 
       (*
        * badw is the fixnum bigInt (as a word) whose negation and
@@ -123,7 +124,7 @@
        * Given two Word.word's, check if they have the same `sign' bit.
        *)
       fun sameSign (lhs: Word.word, rhs: Word.word): bool =
-	 Word.toIntX (Word.xorb (lhs, rhs)) >= 0
+         Word.toIntX (Word.xorb (lhs, rhs)) >= 0
 
       (*
        * Given a bignum bigint, test if it is (strictly) negative.
@@ -131,174 +132,174 @@
        * which is a fixnum bigInt.
        *)
       fun bigIsNeg (arg: bigInt): bool =
-	 Primitive.Vector.sub (Prim.toVector arg, 0) <> 0w0
+         Primitive.Vector.sub (Prim.toVector arg, 0) <> 0w0
 
       (*
        * Convert a smallInt to a bigInt.
        *)
       fun bigFromInt (arg: smallInt): bigInt =
-	 let
-	    val argv = Word.fromInt arg
-	    val ans = addTag argv
-	 in
-	    if sameSign (argv, ans)
-	       then Prim.fromWord ans
-	    else let val space = Primitive.Array.array 2
-		     val (isneg, abs) = if arg < 0
-					   then (0w1, Word.- (0w0, argv))
-					else (0w0, argv)
-		     val _ = Primitive.Array.update (space, 0, isneg)
-		     val _ = Primitive.Array.update (space, 1, abs)
-		     val space = Primitive.Vector.fromArray space
-		 in 
-		    Prim.fromVector space
-		 end
-	 end
+         let
+            val argv = Word.fromInt arg
+            val ans = addTag argv
+         in
+            if sameSign (argv, ans)
+               then Prim.fromWord ans
+            else let val space = Primitive.Array.array 2
+                     val (isneg, abs) = if arg < 0
+                                           then (0w1, Word.- (0w0, argv))
+                                        else (0w0, argv)
+                     val _ = Primitive.Array.update (space, 0, isneg)
+                     val _ = Primitive.Array.update (space, 1, abs)
+                     val space = Primitive.Vector.fromArray space
+                 in 
+                    Prim.fromVector space
+                 end
+         end
 
       fun rep x =
-	 if isSmall x
-	    then Small (Word.toIntX (stripTag x))
-	 else Big (Prim.toVector x)
-	    
+         if isSmall x
+            then Small (Word.toIntX (stripTag x))
+         else Big (Prim.toVector x)
+            
       (*
        * Convert a bigInt to a smallInt, raising overflow if it
        * is too big.
        *)
       fun bigToInt (arg: bigInt): smallInt =
-	 if isSmall arg
-	    then Word.toIntX (stripTag arg)
-	 else if bigSize arg <> 1
-		 then raise Overflow
-	      else let val arga = Prim.toVector arg
-		       val argw = Primitive.Vector.sub (arga, 1)
-		   in if Primitive.Vector.sub (arga, 0) <> 0w0
-			 then if Word.<= (argw, 0wx80000000)
-				 then Word.toIntX (Word.- (0w0, argw))
-			      else raise Overflow
-		      else if Word.< (argw, 0wx80000000)
-			      then Word.toIntX argw
-			   else raise Overflow
-		   end
+         if isSmall arg
+            then Word.toIntX (stripTag arg)
+         else if bigSize arg <> 1
+                 then raise Overflow
+              else let val arga = Prim.toVector arg
+                       val argw = Primitive.Vector.sub (arga, 1)
+                   in if Primitive.Vector.sub (arga, 0) <> 0w0
+                         then if Word.<= (argw, 0wx80000000)
+                                 then Word.toIntX (Word.- (0w0, argw))
+                              else raise Overflow
+                      else if Word.< (argw, 0wx80000000)
+                              then Word.toIntX argw
+                           else raise Overflow
+                   end
 
       fun bigFromInt64 (i: Int64.int): bigInt =
-	 if Int64.<= (~0x40000000, i) andalso Int64.<= (i, 0x3FFFFFFF)
-	    then Prim.fromWord (addTag (Word.fromInt (Int64.toInt i)))
-	 else
-	    let
-	       fun doit (i: Int64.int, isNeg): bigInt =
-		  if Int64.<= (i, 0xFFFFFFFF)
-		     then
-			let
-			   val a = Primitive.Array.array 2
-			   val _ = Array.update (a, 0, isNeg)
-			   val _ = Array.update (a, 1, Int64.toWord i)
-			in
-			   Prim.fromVector (Vector.fromArray a)
-			end
-		  else
-		     let
-			val a = Primitive.Array.array 3
-			val _ = Array.update (a, 0, isNeg)
-			val r = Int64.rem (i, 0x100000000)
-			val _ = Array.update (a, 1, Int64.toWord r)
-			val q = Int64.quot (i, 0x100000000)
-			val _ = Array.update (a, 2, Int64.toWord q)
-		     in
-			Prim.fromVector (Vector.fromArray a)
-		     end
-	    in
-	       if Int64.>= (i, 0)
-		  then doit (i, 0w0)
-	       else
-		  if i = valOf Int64.minInt
-		     then ~0x8000000000000000
-		  else doit (Int64.~? i, 0w1)
-	    end
-		
+         if Int64.<= (~0x40000000, i) andalso Int64.<= (i, 0x3FFFFFFF)
+            then Prim.fromWord (addTag (Word.fromInt (Int64.toInt i)))
+         else
+            let
+               fun doit (i: Int64.int, isNeg): bigInt =
+                  if Int64.<= (i, 0xFFFFFFFF)
+                     then
+                        let
+                           val a = Primitive.Array.array 2
+                           val _ = Array.update (a, 0, isNeg)
+                           val _ = Array.update (a, 1, Int64.toWord i)
+                        in
+                           Prim.fromVector (Vector.fromArray a)
+                        end
+                  else
+                     let
+                        val a = Primitive.Array.array 3
+                        val _ = Array.update (a, 0, isNeg)
+                        val r = Int64.rem (i, 0x100000000)
+                        val _ = Array.update (a, 1, Int64.toWord r)
+                        val q = Int64.quot (i, 0x100000000)
+                        val _ = Array.update (a, 2, Int64.toWord q)
+                     in
+                        Prim.fromVector (Vector.fromArray a)
+                     end
+            in
+               if Int64.>= (i, 0)
+                  then doit (i, 0w0)
+               else
+                  if i = valOf Int64.minInt
+                     then ~0x8000000000000000
+                  else doit (Int64.~? i, 0w1)
+            end
+                
       fun bigToInt64 (arg: bigInt): Int64.int =
-	 case rep arg of
-	    Small i => Int64.fromInt i
-	  | Big v => 
-	       if Vector.length v > 3
-		 then raise Overflow
-	      else let
-		      val sign = Primitive.Vector.sub (v, 0)
-		      val w1 = Primitive.Vector.sub (v, 1)
-		      val w2 = Primitive.Vector.sub (v, 2)
-		   in
-		      if Word.> (w2, 0wx80000000)
-			 then raise Overflow
-		      else if w2 = 0wx80000000
-			      then if w1 = 0w0 andalso sign = 0w1
-				      then valOf Int64.minInt
-				   else raise Overflow				      
-			   else
-			      let
-				 val n =
-				    Int64.+?
-				    (Primitive.Int64.fromWord w1,
-				     Int64.*? (Primitive.Int64.fromWord w2,
-					       0x100000000))
-			      in
-				 if sign = 0w1
-				    then Int64.~ n
-				 else n
-			      end
-		   end
-			 
+         case rep arg of
+            Small i => Int64.fromInt i
+          | Big v => 
+               if Vector.length v > 3
+                 then raise Overflow
+              else let
+                      val sign = Primitive.Vector.sub (v, 0)
+                      val w1 = Primitive.Vector.sub (v, 1)
+                      val w2 = Primitive.Vector.sub (v, 2)
+                   in
+                      if Word.> (w2, 0wx80000000)
+                         then raise Overflow
+                      else if w2 = 0wx80000000
+                              then if w1 = 0w0 andalso sign = 0w1
+                                      then valOf Int64.minInt
+                                   else raise Overflow                                
+                           else
+                              let
+                                 val n =
+                                    Int64.+?
+                                    (Primitive.Int64.fromWord w1,
+                                     Int64.*? (Primitive.Int64.fromWord w2,
+                                               0x100000000))
+                              in
+                                 if sign = 0w1
+                                    then Int64.~ n
+                                 else n
+                              end
+                   end
+                         
       (*
        * bigInt negation.
        *)
       fun bigNegate (arg: bigInt): bigInt =
-	 if isSmall arg
-	    then let val argw = Prim.toWord arg
-		 in if argw = badw
-		       then negBad
-		    else Prim.fromWord (Word.- (0w2, argw))
-		 end
-	 else Prim.~ (arg, reserve (bigSize arg, 1))
+         if isSmall arg
+            then let val argw = Prim.toWord arg
+                 in if argw = badw
+                       then negBad
+                    else Prim.fromWord (Word.- (0w2, argw))
+                 end
+         else Prim.~ (arg, reserve (bigSize arg, 1))
 
       val dontInline: (unit -> 'a) -> 'a =
-	 fn f =>
-	 let
-	    val rec recur: int -> 'a =
-	       fn i =>
-	       if i = 0
-		  then f ()
-	       else (ignore (recur (i - 1))
-		     ; recur (i - 2))
-	 in
-	    recur 0
-	 end
-	    
+         fn f =>
+         let
+            val rec recur: int -> 'a =
+               fn i =>
+               if i = 0
+                  then f ()
+               else (ignore (recur (i - 1))
+                     ; recur (i - 2))
+         in
+            recur 0
+         end
+            
       (*
        * bigInt multiplication.
        *)
       local 
-	 val carry: Word.word ref = ref 0w0
+         val carry: Word.word ref = ref 0w0
       in
-	 fun bigMul (lhs: bigInt, rhs: bigInt): bigInt =
-	    let
-	       val res =
-		  if areSmall (lhs, rhs)
-		     then let
-			     val lhsv = stripTag lhs
-			     val rhs0 = zeroTag rhs
-			     val ans0 = Prim.smallMul (lhsv, rhs0, carry)
-			  in
-			     if (! carry) = Word.~>> (ans0, 0w31)
-				then SOME (Prim.fromWord (incTag ans0))
-			     else NONE
-			  end
-		  else NONE
-	    in
-	       case res of
-		  NONE =>
-		     dontInline
-		     (fn () =>
-		      Prim.* (lhs, rhs, reserve (size lhs +? size rhs, 0)))
-		| SOME i => i
-	    end
+         fun bigMul (lhs: bigInt, rhs: bigInt): bigInt =
+            let
+               val res =
+                  if areSmall (lhs, rhs)
+                     then let
+                             val lhsv = stripTag lhs
+                             val rhs0 = zeroTag rhs
+                             val ans0 = Prim.smallMul (lhsv, rhs0, carry)
+                          in
+                             if (! carry) = Word.~>> (ans0, 0w31)
+                                then SOME (Prim.fromWord (incTag ans0))
+                             else NONE
+                          end
+                  else NONE
+            in
+               case res of
+                  NONE =>
+                     dontInline
+                     (fn () =>
+                      Prim.* (lhs, rhs, reserve (size lhs +? size rhs, 0)))
+                | SOME i => i
+            end
       end
 
       (*
@@ -315,30 +316,30 @@
        * word for the isNeg flag).
        *)
       fun bigQuot (num: bigInt, den: bigInt): bigInt =
-	 if areSmall (num, den)
-	    then let val numv = stripTag num
-		     val denv = stripTag den
-		 in if numv = badv andalso denv = Word.fromInt ~1
-		       then negBad
-		    else let val numi = Word.toIntX numv
-			     val deni = Word.toIntX denv
-			     val ansi = Int.quot (numi, deni)
-			     val answ = Word.fromInt ansi
-			 in Prim.fromWord (addTag answ)
-			 end
-		 end
-	 else let val nsize = size num
-		  val dsize = size den
-	      in if nsize < dsize
-		    then zero
-		 else if den = zero
-			 then raise Div
-		      else
-			 Prim.quot
-			 (num, den,
-			  Word.* (Word.* (0w2, bytesPerWord),
-				  Word.+ (Word.fromInt nsize, 0w3)))
-	      end
+         if areSmall (num, den)
+            then let val numv = stripTag num
+                     val denv = stripTag den
+                 in if numv = badv andalso denv = Word.fromInt ~1
+                       then negBad
+                    else let val numi = Word.toIntX numv
+                             val deni = Word.toIntX denv
+                             val ansi = Int.quot (numi, deni)
+                             val answ = Word.fromInt ansi
+                         in Prim.fromWord (addTag answ)
+                         end
+                 end
+         else let val nsize = size num
+                  val dsize = size den
+              in if nsize < dsize
+                    then zero
+                 else if den = zero
+                         then raise Div
+                      else
+                         Prim.quot
+                         (num, den,
+                          Word.* (Word.* (0w2, bytesPerWord),
+                                  Word.+ (Word.fromInt nsize, 0w3)))
+              end
 
       (*
        * bigInt rem.
@@ -354,202 +355,202 @@
        * word for the isNeg flag).
        *)
       fun bigRem (num: bigInt, den: bigInt): bigInt =
-	 if areSmall (num, den)
-	    then let val numv = stripTag num
-		     val numi = Word.toIntX numv
-		     val denv = stripTag den
-		     val deni = Word.toIntX denv
-		     val ansi = Int.rem (numi, deni)
-		     val answ = Word.fromInt ansi
-		 in Prim.fromWord (addTag answ)
-		 end
-	 else let val nsize = size num
-		  val dsize = size den
-	      in if nsize < dsize
-		    then num
-		 else if den = zero
-			 then raise Div
-		      else
-			 Prim.rem
-			 (num, den, Word.* (Word.* (0w2, bytesPerWord),
-					    Word.+ (Word.fromInt nsize, 0w3)))
-	      end
+         if areSmall (num, den)
+            then let val numv = stripTag num
+                     val numi = Word.toIntX numv
+                     val denv = stripTag den
+                     val deni = Word.toIntX denv
+                     val ansi = Int.rem (numi, deni)
+                     val answ = Word.fromInt ansi
+                 in Prim.fromWord (addTag answ)
+                 end
+         else let val nsize = size num
+                  val dsize = size den
+              in if nsize < dsize
+                    then num
+                 else if den = zero
+                         then raise Div
+                      else
+                         Prim.rem
+                         (num, den, Word.* (Word.* (0w2, bytesPerWord),
+                                            Word.+ (Word.fromInt nsize, 0w3)))
+              end
 
       (*
        * bigInt addition.
        *)
       fun bigPlus (lhs: bigInt, rhs: bigInt): bigInt =
-	 let
-	    val res =
-	       if areSmall (lhs, rhs)
-		  then let val ansv = Word.+ (stripTag lhs, stripTag rhs)
-			   val ans = addTag ansv
-		       in if sameSign (ans, ansv)
-			     then SOME (Prim.fromWord ans)
-			  else NONE
-		       end
-	       else NONE
-	 in
-	    case res of
-	       NONE => 
-		  dontInline
-		  (fn () =>
-		   Prim.+ (lhs, rhs, reserve (Int.max (size lhs, size rhs), 1)))
-	     | SOME i => i
-	 end
+         let
+            val res =
+               if areSmall (lhs, rhs)
+                  then let val ansv = Word.+ (stripTag lhs, stripTag rhs)
+                           val ans = addTag ansv
+                       in if sameSign (ans, ansv)
+                             then SOME (Prim.fromWord ans)
+                          else NONE
+                       end
+               else NONE
+         in
+            case res of
+               NONE => 
+                  dontInline
+                  (fn () =>
+                   Prim.+ (lhs, rhs, reserve (Int.max (size lhs, size rhs), 1)))
+             | SOME i => i
+         end
 
       (*
        * bigInt subtraction.
        *)
       fun bigMinus (lhs: bigInt, rhs: bigInt): bigInt =
-	 let
-	    val res =
-	       if areSmall (lhs, rhs)
-		  then
-		     let
-			val ansv = Word.- (stripTag lhs, stripTag rhs)
-			val ans = addTag ansv
-		     in
-			if sameSign (ans, ansv)
-			   then SOME (Prim.fromWord ans)
-			else NONE
-		     end
-	       else NONE
-	 in
-	    case res of
-	       NONE =>
-		  dontInline
-		  (fn () =>
-		   Prim.- (lhs, rhs, reserve (Int.max (size lhs, size rhs), 1)))
-	     | SOME i => i
-	 end
+         let
+            val res =
+               if areSmall (lhs, rhs)
+                  then
+                     let
+                        val ansv = Word.- (stripTag lhs, stripTag rhs)
+                        val ans = addTag ansv
+                     in
+                        if sameSign (ans, ansv)
+                           then SOME (Prim.fromWord ans)
+                        else NONE
+                     end
+               else NONE
+         in
+            case res of
+               NONE =>
+                  dontInline
+                  (fn () =>
+                   Prim.- (lhs, rhs, reserve (Int.max (size lhs, size rhs), 1)))
+             | SOME i => i
+         end
 
       (*
        * bigInt compare.
        *)
       fun bigCompare (lhs: bigInt, rhs: bigInt): order =
-	 if areSmall (lhs, rhs)
-	    then Int.compare (Word.toIntX (Prim.toWord lhs),
-			      Word.toIntX (Prim.toWord rhs))
-	 else Int.compare (Prim.compare (lhs, rhs), 0)
+         if areSmall (lhs, rhs)
+            then Int.compare (Word.toIntX (Prim.toWord lhs),
+                              Word.toIntX (Prim.toWord rhs))
+         else Int.compare (Prim.compare (lhs, rhs), 0)
 
 
       (*
        * bigInt comparisions.
        *)
       local
-	 fun makeTest (smallTest: smallInt * smallInt -> bool)
-	    (lhs: bigInt, rhs: bigInt): bool =
-	    if areSmall (lhs, rhs)
-	       then smallTest (Word.toIntX (Prim.toWord lhs),
-			       Word.toIntX (Prim.toWord rhs))
-	    else smallTest (Prim.compare (lhs, rhs), 0)
+         fun makeTest (smallTest: smallInt * smallInt -> bool)
+            (lhs: bigInt, rhs: bigInt): bool =
+            if areSmall (lhs, rhs)
+               then smallTest (Word.toIntX (Prim.toWord lhs),
+                               Word.toIntX (Prim.toWord rhs))
+            else smallTest (Prim.compare (lhs, rhs), 0)
       in
-	 val bigGT = makeTest (op >)
-	 val bigGE = makeTest (op >=)
-	 val bigLE = makeTest (op <=)
-	 val bigLT = makeTest (op <)
+         val bigGT = makeTest (op >)
+         val bigGE = makeTest (op >=)
+         val bigLE = makeTest (op <=)
+         val bigLT = makeTest (op <)
       end
 
       (*
        * bigInt abs.
        *)
       fun bigAbs (arg: bigInt): bigInt =
-	 if isSmall arg
-	    then let val argw = Prim.toWord arg
-		 in if argw = badw
-		       then negBad
-		    else if Word.toIntX argw < 0
-			    then Prim.fromWord (Word.- (0w2, argw))
-			 else arg
-		 end
-	 else if bigIsNeg arg
-		 then Prim.~ (arg, reserve (bigSize arg, 1))
-	      else arg
+         if isSmall arg
+            then let val argw = Prim.toWord arg
+                 in if argw = badw
+                       then negBad
+                    else if Word.toIntX argw < 0
+                            then Prim.fromWord (Word.- (0w2, argw))
+                         else arg
+                 end
+         else if bigIsNeg arg
+                 then Prim.~ (arg, reserve (bigSize arg, 1))
+              else arg
 
       (*
        * bigInt min.
        *)
       fun bigMin (lhs: bigInt, rhs: bigInt): bigInt =
-	 if bigLE (lhs, rhs)
-	    then lhs
-	 else rhs
+         if bigLE (lhs, rhs)
+            then lhs
+         else rhs
 
       (*
        * bigInt max.
        *)
       fun bigMax (lhs: bigInt, rhs: bigInt): bigInt =
-	 if bigLE (lhs, rhs)
-	    then rhs
-	 else lhs
+         if bigLE (lhs, rhs)
+            then rhs
+         else lhs
 
       (*
        * bigInt sign.
        *)
       fun bigSign (arg: bigInt): smallInt =
-	 if isSmall arg
-	    then Int.sign (Word.toIntX (stripTag arg))
-	 else if bigIsNeg arg
-		 then ~1
-	      else 1
+         if isSmall arg
+            then Int.sign (Word.toIntX (stripTag arg))
+         else if bigIsNeg arg
+                 then ~1
+              else 1
 
       (*
        * bigInt sameSign.
        *)
       fun bigSameSign (lhs: bigInt, rhs: bigInt): bool =
-	 bigSign lhs = bigSign rhs
+         bigSign lhs = bigSign rhs
 
       (*
        * bigInt gcd.
        * based on code from PolySpace.
        *)
       local
-	 open Int
+         open Int
 
-	 fun mod2 x = Word.toIntX (Word.andb (Word.fromInt x, 0w1))
-	 fun div2 x = Word.toIntX (Word.>> (Word.fromInt x, 0w1))
-	    
-	 fun gcdInt (a, b, acc) =
-	    case (a, b) of
-	       (0, _) => b * acc
-	     | (_, 0) => a * acc
-	     | (_, 1) => acc
-	     | (1, _) => acc
-	     | _ => 
-		  if a = b
-		     then a * acc
-		  else
-		     let
-			val a_2 = div2 a
-			val a_r2 = mod2 a
-			val b_2 = div2 b
-			val b_r2 = mod2 b
-		     in
-			if 0 = a_r2
-			   then
-			      if 0 = b_r2
-				 then gcdInt (a_2, b_2, acc + acc)
-			      else gcdInt (a_2, b, acc)
-			else
-			   if 0 = b_r2
-			      then gcdInt (a, b_2, acc)
-			   else
-			      if a >= b
-				 then gcdInt (div2 (a - b), b, acc)
-			      else gcdInt (a, div2 (b - a), acc)
-		     end
-		  
+         fun mod2 x = Word.toIntX (Word.andb (Word.fromInt x, 0w1))
+         fun div2 x = Word.toIntX (Word.>> (Word.fromInt x, 0w1))
+            
+         fun gcdInt (a, b, acc) =
+            case (a, b) of
+               (0, _) => b * acc
+             | (_, 0) => a * acc
+             | (_, 1) => acc
+             | (1, _) => acc
+             | _ => 
+                  if a = b
+                     then a * acc
+                  else
+                     let
+                        val a_2 = div2 a
+                        val a_r2 = mod2 a
+                        val b_2 = div2 b
+                        val b_r2 = mod2 b
+                     in
+                        if 0 = a_r2
+                           then
+                              if 0 = b_r2
+                                 then gcdInt (a_2, b_2, acc + acc)
+                              else gcdInt (a_2, b, acc)
+                        else
+                           if 0 = b_r2
+                              then gcdInt (a, b_2, acc)
+                           else
+                              if a >= b
+                                 then gcdInt (div2 (a - b), b, acc)
+                              else gcdInt (a, div2 (b - a), acc)
+                     end
+                  
       in
-	 fun bigGcd (lhs: bigInt, rhs: bigInt): bigInt =
-	    if areSmall (lhs, rhs)
-	       then
-		  Prim.fromWord
-		  (addTag
-		   (Word.fromInt
-		    (gcdInt (Int.abs (Word.toIntX (stripTag lhs)),
-			     Int.abs (Word.toIntX (stripTag rhs)),
-			     1))))
-	    else Prim.gcd (lhs, rhs, reserve (max (size lhs, size rhs), 0))
+         fun bigGcd (lhs: bigInt, rhs: bigInt): bigInt =
+            if areSmall (lhs, rhs)
+               then
+                  Prim.fromWord
+                  (addTag
+                   (Word.fromInt
+                    (gcdInt (Int.abs (Word.toIntX (stripTag lhs)),
+                             Int.abs (Word.toIntX (stripTag rhs)),
+                             1))))
+            else Prim.gcd (lhs, rhs, reserve (max (size lhs, size rhs), 0))
       end
 
       (*
@@ -557,291 +558,304 @@
        * dpc is the maximum number of digits per `limb'.
        *)
       local
-	 open StringCvt
+         open StringCvt
 
-	 fun cvt {base: smallInt,
-		  dpc: word,
-		  smallCvt: smallInt -> string}
-	    (arg: bigInt)
-	    : string =
-	    if isSmall arg
-	       then smallCvt (Word.toIntX (stripTag arg))
-	    else Prim.toString (arg, base,
-				Word.+
-				(reserve (0, 0),
-				 Word.+ (0w2, (* sign character *)
-					 Word.* (dpc,
-						 Word.fromInt (bigSize arg)))))
-	 val binCvt = cvt {base = 2, dpc = 0w32, smallCvt = Int.fmt BIN}
-	 val octCvt = cvt {base = 8, dpc = 0w11, smallCvt = Int.fmt OCT}
-	 val hexCvt = cvt {base = 16, dpc = 0w8, smallCvt = Int.fmt HEX}
+         fun cvt {base: smallInt,
+                  dpc: word,
+                  smallCvt: smallInt -> string}
+            (arg: bigInt)
+            : string =
+            if isSmall arg
+               then smallCvt (Word.toIntX (stripTag arg))
+            else Prim.toString (arg, base,
+                                Word.+
+                                (reserve (0, 0),
+                                 Word.+ (0w2, (* sign character *)
+                                         Word.* (dpc,
+                                                 Word.fromInt (bigSize arg)))))
+         val binCvt = cvt {base = 2, dpc = 0w32, smallCvt = Int.fmt BIN}
+         val octCvt = cvt {base = 8, dpc = 0w11, smallCvt = Int.fmt OCT}
+         val hexCvt = cvt {base = 16, dpc = 0w8, smallCvt = Int.fmt HEX}
       in
-	 val bigToString = cvt {base = 10,
-				dpc = 0w10,
-				smallCvt = Int.toString}
-	 fun bigFmt radix =
-	    case radix of
-	       BIN => binCvt
-	     | OCT => octCvt
-	     | DEC => bigToString
-	     | HEX => hexCvt
+         val bigToString = cvt {base = 10,
+                                dpc = 0w10,
+                                smallCvt = Int.toString}
+         fun bigFmt radix =
+            case radix of
+               BIN => binCvt
+             | OCT => octCvt
+             | DEC => bigToString
+             | HEX => hexCvt
       end
 
       (*
        * bigInt scan and fromString.
        *)
       local
-	 open StringCvt
+         open StringCvt
 
-	 (*
-	  * We use Word.word to store chunks of digits.
-	  * smallToInf converts such a word to a fixnum bigInt.
-	  * Thus, it can only represent values in [- 2^30, 2^30).
-	  *)
-	 fun smallToBig (arg: Word.word): bigInt =
-	    Prim.fromWord (addTag arg)
-	    
-	    
-	 (*
-	  * Given a char, if it is a digit in the appropriate base,
-	  * convert it to a word.  Otherwise, return NONE.
-	  * Note, both a-f and A-F are accepted as hexadecimal digits.
-	  *)
-	 fun binDig (ch: char): Word.word option =
-	    case ch of
-	       #"0" => SOME 0w0
-	     | #"1" => SOME 0w1
-	     | _ => NONE
+         (*
+          * We use Word.word to store chunks of digits.
+          * smallToInf converts such a word to a fixnum bigInt.
+          * Thus, it can only represent values in [- 2^30, 2^30).
+          *)
+         fun smallToBig (arg: Word.word): bigInt =
+            Prim.fromWord (addTag arg)
+            
+            
+         (*
+          * Given a char, if it is a digit in the appropriate base,
+          * convert it to a word.  Otherwise, return NONE.
+          * Note, both a-f and A-F are accepted as hexadecimal digits.
+          *)
+         fun binDig (ch: char): Word.word option =
+            case ch of
+               #"0" => SOME 0w0
+             | #"1" => SOME 0w1
+             | _ => NONE
 
-	 local
-	    val op <= = Char.<=
-	 in
-	    fun octDig (ch: char): Word.word option =
-	       if #"0" <= ch andalso ch <= #"7"
-		  then SOME (Word.fromInt (ord ch -? ord #"0"))
-	       else NONE
-		  
-	    fun decDig (ch: char): Word.word option =
-	       if #"0" <= ch andalso ch <= #"9"
-		  then SOME (Word.fromInt (ord ch -? ord #"0"))
-	       else NONE
-		  
-	    fun hexDig (ch: char): Word.word option =
-	       if #"0" <= ch andalso ch <= #"9"
-		  then SOME (Word.fromInt (ord ch -? ord #"0"))
-	       else if #"a" <= ch andalso ch <= #"f"
-		       then SOME (Word.fromInt (ord ch -? (ord #"a" - 0xa)))
-		    else if #"A" <= ch andalso ch <= #"F"
-			    then SOME (Word.fromInt
-				       (ord ch -? (ord #"A" - 0xA)))
-			 else
-			    NONE
-	 end
+         local
+            val op <= = Char.<=
+         in
+            fun octDig (ch: char): Word.word option =
+               if #"0" <= ch andalso ch <= #"7"
+                  then SOME (Word.fromInt (ord ch -? ord #"0"))
+               else NONE
+                  
+            fun decDig (ch: char): Word.word option =
+               if #"0" <= ch andalso ch <= #"9"
+                  then SOME (Word.fromInt (ord ch -? ord #"0"))
+               else NONE
+                  
+            fun hexDig (ch: char): Word.word option =
+               if #"0" <= ch andalso ch <= #"9"
+                  then SOME (Word.fromInt (ord ch -? ord #"0"))
+               else if #"a" <= ch andalso ch <= #"f"
+                       then SOME (Word.fromInt (ord ch -? (ord #"a" - 0xa)))
+                    else if #"A" <= ch andalso ch <= #"F"
+                            then SOME (Word.fromInt
+                                       (ord ch -? (ord #"A" - 0xA)))
+                         else
+                            NONE
+         end
       
-	 (*
-	  * Given a digit converter and a char reader, return a digit
-	  * reader.
-	  *)
-	 fun toDigR (charToDig: char -> Word.word option,
-		     cread: (char, 'a) reader)
-	    (state: 'a)
-	    : (Word.word * 'a) option =
-	    case cread state of
-	       NONE => NONE
-	     | SOME (ch, state') =>
-		  case charToDig ch of
-		     NONE => NONE
-		   | SOME dig => SOME (dig, state')
-			
-	 (*
-	  * A chunk represents the result of processing some digits.
-	  * more is a bool indicating if there might be more digits.
-	  * shift is base raised to the number-of-digits-seen power.
-	  * chunk is the value of the digits seen.
-	  *)
-	 type chunk = {
-		       more: bool,
-		       shift: Word.word,
-		       chunk: Word.word
-		       }
-	    
-	 (*
-	  * Given the base, the number of digits per chunk,
-	  * a char reader and a digit reader, return a chunk reader.
-	  *)
-	 fun toChunkR (base: Word.word,
-		       dpc: smallInt,
-		       dread: (Word.word, 'a) reader)
-	    : (chunk, 'a) reader =
-	    let fun loop {left: smallInt,
-			  shift: Word.word,
-			  chunk: Word.word,
-			  state: 'a}
-	       : chunk * 'a =
-	       if left <= 0
-		  then ({more = true,
-			 shift = shift,
-			 chunk = chunk },
-			state)
-	       else
-		  case dread state of
-		     NONE => ({more = false,
-			       shift = shift,
-			       chunk = chunk},
-			      state)
-		   | SOME (dig, state') =>
-			loop {
-			      left = left - 1,
-			      shift = Word.* (base, shift),
-			      chunk = Word.+ (Word.* (base,
-						      chunk),
-					      dig),
-			      state = state'
-			      }
-		fun reader (state: 'a): (chunk * 'a) option =
-		   case dread state of
-		      NONE => NONE
-		    | SOME (dig, next) =>
-			 SOME (loop {left = dpc - 1,
-				     shift = base,
-				     chunk = dig,
-				     state = next})
-	    in reader
-	    end
-	 
-	 (*
-	  * Given a chunk reader, return an unsigned reader.
-	  *)
-	 fun toUnsR (ckread: (chunk, 'a) reader): (bigInt, 'a) reader =
-	    let fun loop (more: bool, ac: bigInt, state: 'a) =
-	       if more
-		  then case ckread state of
-		     NONE => (ac, state)
-		   | SOME ({more, shift, chunk}, state') =>
-			loop (more,
-			      bigPlus (bigMul (smallToBig shift,
-					       ac),
-				       smallToBig chunk),
-			      state')
-	       else (ac, state)
-		fun reader (state: 'a): (bigInt * 'a) option =
-		   case ckread state of
-		      NONE => NONE
-		    | SOME ({more, chunk, ...}, state') =>
-			 SOME (loop (more,
-				     smallToBig chunk,
-				     state'))
-	    in reader
-	    end
-	 
-	 (*
-	  * Given a char reader and an unsigned reader, return a signed
-	  * reader.  This includes skipping any initial white space.
-	  *)
-	 fun toSign (cread: (char, 'a) reader, uread: (bigInt, 'a) reader)
-	    : (bigInt, 'a) reader =
-	    let fun reader (state: 'a): (bigInt * 'a) option =
-	       case cread state of
-		  NONE => NONE
-		| SOME (ch, state') =>
-		     if Char.isSpace ch
-			then reader state'
-		     else let val (isNeg, state'') =
-			case ch of
-			   #"+" =>
-			   (false, state')
-			 | #"-" =>
-			      (true, state')
-			 | #"~" =>
-			      (true, state')
-			 | _ =>
-			      (false, state)
-			  in if isNeg
-				then case uread state'' of
-				   NONE => NONE
-				 | SOME (abs, state''') =>
-				      SOME (bigNegate abs,
-					    state''')
-			     else uread state''
-			  end
-	    in reader
-	    end
-		  
-	 (*
-	  * Base-specific conversions from char readers to
-	  * bigInt readers.
-	  *)
-	 local
-	    fun reader (base, dpc, dig)
-	       (cread: (char, 'a) reader): (bigInt, 'a) reader =
-	       let val dread = toDigR (dig, cread)
-		  val ckread = toChunkR (base, dpc, dread)
-		  val uread = toUnsR ckread
-		  val reader = toSign (cread, uread)
-	       in reader
-	       end
-	 in
-	    fun binReader z = reader (0w2, 29, binDig) z
-	    fun octReader z = reader (0w8, 9, octDig) z
-	    fun decReader z = reader (0w10, 9, decDig) z
-	    fun hexReader z = reader (0wx10, 7, hexDig) z
-	 end	 
+         (*
+          * Given a digit converter and a char reader, return a digit
+          * reader.
+          *)
+         fun toDigR (charToDig: char -> Word.word option,
+                     cread: (char, 'a) reader)
+            (s: 'a)
+            : (Word.word * 'a) option =
+            case cread s of
+               NONE => NONE
+             | SOME (ch, s') =>
+                  case charToDig ch of
+                     NONE => NONE
+                   | SOME dig => SOME (dig, s')
+                        
+         (*
+          * A chunk represents the result of processing some digits.
+          * more is a bool indicating if there might be more digits.
+          * shift is base raised to the number-of-digits-seen power.
+          * chunk is the value of the digits seen.
+          *)
+         type chunk = {
+                       more: bool,
+                       shift: Word.word,
+                       chunk: Word.word
+                       }
+            
+         (*
+          * Given the base, the number of digits per chunk,
+          * a char reader and a digit reader, return a chunk reader.
+          *)
+         fun toChunkR (base: Word.word,
+                       dpc: smallInt,
+                       dread: (Word.word, 'a) reader)
+            : (chunk, 'a) reader =
+            let fun loop {left: smallInt,
+                          shift: Word.word,
+                          chunk: Word.word,
+                          s: 'a}
+               : chunk * 'a =
+               if left <= 0
+                  then ({more = true,
+                         shift = shift,
+                         chunk = chunk },
+                        s)
+               else
+                  case dread s of
+                     NONE => ({more = false,
+                               shift = shift,
+                               chunk = chunk},
+                              s)
+                   | SOME (dig, s') =>
+                        loop {
+                              left = left - 1,
+                              shift = Word.* (base, shift),
+                              chunk = Word.+ (Word.* (base,
+                                                      chunk),
+                                              dig),
+                              s = s'
+                              }
+                fun reader (s: 'a): (chunk * 'a) option =
+                   case dread s of
+                      NONE => NONE
+                    | SOME (dig, next) =>
+                         SOME (loop {left = dpc - 1,
+                                     shift = base,
+                                     chunk = dig,
+                                     s = next})
+            in reader
+            end
+         
+         (*
+          * Given a chunk reader, return an unsigned reader.
+          *)
+         fun toUnsR (ckread: (chunk, 'a) reader): (bigInt, 'a) reader =
+            let fun loop (more: bool, ac: bigInt, s: 'a) =
+               if more
+                  then case ckread s of
+                     NONE => (ac, s)
+                   | SOME ({more, shift, chunk}, s') =>
+                        loop (more,
+                              bigPlus (bigMul (smallToBig shift,
+                                               ac),
+                                       smallToBig chunk),
+                              s')
+               else (ac, s)
+                fun reader (s: 'a): (bigInt * 'a) option =
+                   case ckread s of
+                      NONE => NONE
+                    | SOME ({more, chunk, ...}, s') =>
+                         SOME (loop (more,
+                                     smallToBig chunk,
+                                     s'))
+            in reader
+            end
+         
+         (*
+          * Given a char reader and an unsigned reader, return an unsigned
+          * reader that includes skipping the option hex '0x'.
+          *)
+         fun toHexR (cread: (char, 'a) reader, uread: (bigInt, 'a) reader) 
+            s =
+            case cread s of
+               NONE => NONE
+             | SOME (c1, s1) =>
+                  if c1 = #"0" then
+                     case cread s1 of
+                        NONE => SOME (zero, s1)
+                      | SOME (c2, s2) =>
+                           if c2 = #"x" orelse c2 = #"X" then
+                              case uread s2 of 
+                                 NONE => SOME (zero, s1)
+                               | SOME x => SOME x
+                           else uread s
+                  else uread s
+
+         (*
+          * Given a char reader and an unsigned reader, return a signed
+          * reader.  This includes skipping any initial white space.
+          *)
+         fun toSign (cread: (char, 'a) reader, uread: (bigInt, 'a) reader)
+            : (bigInt, 'a) reader =
+            let
+               fun reader (s: 'a): (bigInt * 'a) option =
+                  case cread s of
+                     NONE => NONE
+                   | SOME (ch, s') =>
+                        if Char.isSpace ch then reader s'
+                        else
+                           let
+                              val (isNeg, s'') =
+                                 case ch of
+                                    #"+" => (false, s')
+                                  | #"-" => (true, s')
+                                  | #"~" => (true, s')
+                                  | _ => (false, s)
+                           in
+                              if isNeg then
+                                 case uread s'' of
+                                    NONE => NONE
+                                  | SOME (abs, s''') =>
+                                       SOME (bigNegate abs, s''')
+                              else uread s''
+                           end
+            in
+               reader
+            end
+                  
+         (*
+          * Base-specific conversions from char readers to
+          * bigInt readers.
+          *)
+         local
+            fun reader (base, dpc, dig)
+               (cread: (char, 'a) reader): (bigInt, 'a) reader =
+               let val dread = toDigR (dig, cread)
+                  val ckread = toChunkR (base, dpc, dread)
+                  val uread = toUnsR ckread
+                  val hread =
+                     if base = 0w16 then toHexR (cread, uread) else uread
+                  val reader = toSign (cread, hread)
+               in reader
+               end
+         in
+            fun binReader z = reader (0w2, 29, binDig) z
+            fun octReader z = reader (0w8, 9, octDig) z
+            fun decReader z = reader (0w10, 9, decDig) z
+            fun hexReader z = reader (0w16, 7, hexDig) z
+         end     
       in
-	 
-	 local fun stringReader (pos, str) =
-	    if pos >= String.size str
-	       then NONE
-	    else SOME (String.sub (str, pos),
-		       (pos + 1, str))
-	       val reader = decReader stringReader
-	 in
-	    fun bigFromString str =
-	       case reader (0, str) of
-		  NONE => NONE
-		| SOME (res, _) => SOME res
-	 end
+         
+         local fun stringReader (pos, str) =
+            if pos >= String.size str
+               then NONE
+            else SOME (String.sub (str, pos), (pos + 1, str))
+               val reader = decReader stringReader
+         in
+            fun bigFromString str =
+               case reader (0, str) of
+                  NONE => NONE
+                | SOME (res, _) => SOME res
+         end
       
-	 fun bigScan radix =
-	    case radix of
-	       BIN => binReader
-	     | OCT => octReader
-	     | DEC => decReader
-	     | HEX => hexReader
+         fun bigScan radix =
+            case radix of
+               BIN => binReader
+             | OCT => octReader
+             | DEC => decReader
+             | HEX => hexReader
       end
 
       local
-	 fun isEven (n: int) = Int.mod (Int.abs n, 2) = 0
+         fun isEven (n: int) = Int.mod (Int.abs n, 2) = 0
       in
-	 fun pow (i: bigInt, j: int): bigInt =
-	    if j < 0
-	       then
-		  if i = zero
-		     then raise Div
-		  else if i = one
-			  then one
-		       else if i = negOne
-			       then if isEven j
-				       then one
-				    else negOne
-			    else zero
-	    else
-	       if j = 0
-		  then one
-	       else
-		  let
-		     fun square (n: bigInt): bigInt = bigMul (n, n)
-		     (* pow (j) returns (i ^ j) *)
-		     fun pow (j: int): bigInt =
-			if j <= 0
-			   then one
-			else if isEven j
-				then evenPow j
-			     else bigMul (i, evenPow (j - 1))
-		     (* evenPow (j) returns (i ^ j), assuming j is even *)
-		     and evenPow (j: int): bigInt =
-			square (pow (Int.quot (j, 2)))
-		  in pow (j)
-		  end
+         fun pow (i: bigInt, j: int): bigInt =
+            if j < 0 then
+               if i = zero then
+                  raise Div
+               else
+                  if i = one then one
+                  else if i = negOne then if isEven j then one else negOne
+                  else zero
+            else
+               if j = 0 then one
+               else
+                  let
+                     fun square (n: bigInt): bigInt = bigMul (n, n)
+                     (* pow (j) returns (i ^ j) *)
+                     fun pow (j: int): bigInt =
+                        if j <= 0 then one
+                        else if isEven j then evenPow j
+                        else bigMul (i, evenPow (j - 1))
+                     (* evenPow (j) returns (i ^ j), assuming j is even *)
+                     and evenPow (j: int): bigInt =
+                        square (pow (Int.quot (j, 2)))
+                  in pow (j)
+                  end
       end
 
       val op + = bigPlus
@@ -853,34 +867,34 @@
       val rem = bigRem
 
       fun x div y =
-	 if x >= zero
-	    then if y > zero
-		    then quot (x, y)
-		 else if y < zero
-			 then if x = zero
-				 then zero
-			      else quot (x - one, y) - one
-		      else raise Div
-	 else if y < zero
-		 then quot (x, y)
-	      else if y > zero
-		      then quot (x + one, y) - one
-		   else raise Div
+         if x >= zero
+            then if y > zero
+                    then quot (x, y)
+                 else if y < zero
+                         then if x = zero
+                                 then zero
+                              else quot (x - one, y) - one
+                      else raise Div
+         else if y < zero
+                 then quot (x, y)
+              else if y > zero
+                      then quot (x + one, y) - one
+                   else raise Div
 
       fun x mod y =
-	 if x >= zero
-	    then if y > zero
-		    then rem (x, y)
-		 else if y < zero
-			 then if x = zero
-				 then zero
-			      else rem (x - one, y) + (one + y)
-		      else raise Div
-	 else if y < zero
-		 then rem (x, y)
-	      else if y > zero
-		      then rem (x + one, y) + (y - one)
-		   else raise Div
+         if x >= zero
+            then if y > zero
+                    then rem (x, y)
+                 else if y < zero
+                         then if x = zero
+                                 then zero
+                              else rem (x - one, y) + (one + y)
+                      else raise Div
+         else if y < zero
+                 then rem (x, y)
+              else if y > zero
+                      then rem (x + one, y) + (y - one)
+                   else raise Div
 
       fun divMod (x, y) = (x div y, x mod y)
       fun quotRem (x, y) = (quot (x, y), rem (x, y))
@@ -889,85 +903,85 @@
        * bigInt log2
        *)
       structure Word =
-	 struct
-	    open Word
-	    fun log2 (w: word): int =
-	       let
-		  fun loop (n, s, ac): word =
-		     if n = 0w1
-			then ac
-		     else
-			let
-			   val (n, ac) =
-			      if n >= << (0w1, s)
-				 then (>> (n, s), ac + s)
-			      else (n, ac)
-			in
-			   loop (n, >> (s, 0w1), ac)
-			end
-	       in
-		  toInt (loop (w, 0w16, 0w0))
-	       end
-	 end
+         struct
+            open Word
+            fun log2 (w: word): int =
+               let
+                  fun loop (n, s, ac): word =
+                     if n = 0w1
+                        then ac
+                     else
+                        let
+                           val (n, ac) =
+                              if n >= << (0w1, s)
+                                 then (>> (n, s), ac + s)
+                              else (n, ac)
+                        in
+                           loop (n, >> (s, 0w1), ac)
+                        end
+               in
+                  toInt (loop (w, 0w16, 0w0))
+               end
+         end
 
       local
-	 val bitsPerLimb: Int.int = 32
+         val bitsPerLimb: Int.int = 32
       in
-	 fun log2 (n: bigInt): Int.int =
-	    if bigLE (n, 0)
-	       then raise Domain
-	    else
-	       case rep n of
-		  Big v =>
-		     Int.+ (Int.* (bitsPerLimb, Int.- (Vector.length v, 2)),
-			    Word.log2 (Vector.sub (v, Int.- (Vector.length v, 1))))
-		| Small i => Word.log2 (Word.fromInt i)
+         fun log2 (n: bigInt): Int.int =
+            if bigLE (n, 0)
+               then raise Domain
+            else
+               case rep n of
+                  Big v =>
+                     Int.+ (Int.* (bitsPerLimb, Int.- (Vector.length v, 2)),
+                            Word.log2 (Vector.sub (v, Int.- (Vector.length v, 1))))
+                | Small i => Word.log2 (Word.fromInt i)
       end
 
       (* 
        * bigInt bit operations.
        *)
       local
-	 fun make (wordOp, bigIntOp): bigInt * bigInt -> bigInt =
-	    fn (lhs: bigInt, rhs: bigInt) =>
-	    if areSmall (lhs, rhs)
-	       then
-		  let
-		     val ansv = wordOp (stripTag lhs, stripTag rhs)
-		     val ans = addTag ansv
-		  in
-		     Prim.fromWord ans
-		  end
-	    else
-	       dontInline
-	       (fn () => 
-		bigIntOp (lhs, rhs, reserve (Int.max (size lhs, size rhs), 0)))
+         fun make (wordOp, bigIntOp): bigInt * bigInt -> bigInt =
+            fn (lhs: bigInt, rhs: bigInt) =>
+            if areSmall (lhs, rhs)
+               then
+                  let
+                     val ansv = wordOp (stripTag lhs, stripTag rhs)
+                     val ans = addTag ansv
+                  in
+                     Prim.fromWord ans
+                  end
+            else
+               dontInline
+               (fn () => 
+                bigIntOp (lhs, rhs, reserve (Int.max (size lhs, size rhs), 0)))
       in
-	 val bigAndb = make (Word.andb, Prim.andb)
-	 val bigOrb = make (Word.orb, Prim.orb)
-	 val bigXorb = make (Word.xorb, Prim.xorb)
+         val bigAndb = make (Word.andb, Prim.andb)
+         val bigOrb = make (Word.orb, Prim.orb)
+         val bigXorb = make (Word.xorb, Prim.xorb)
       end
 
       fun bigNotb (arg: bigInt): bigInt =
-	 if isSmall arg
-	    then Prim.fromWord (addTag (Word.notb (stripTag arg)))
-	 else dontInline (fn () => Prim.notb (arg, reserve (size arg, 0)))
+         if isSmall arg
+            then Prim.fromWord (addTag (Word.notb (stripTag arg)))
+         else dontInline (fn () => Prim.notb (arg, reserve (size arg, 0)))
 
       local
-	 val bitsPerLimb : Word.word = 0w32
-	 fun shiftSize shift = Word.toIntX (Word.div (shift, bitsPerLimb))
+         val bitsPerLimb : Word.word = 0w32
+         fun shiftSize shift = Word.toIntX (Word.div (shift, bitsPerLimb))
       in
-	 fun bigArshift (arg: bigInt, shift: word): bigInt =
-	    if shift = 0wx0
-	       then arg
-	    else Prim.~>> (arg, shift,
-			   reserve (Int.max (1, size arg -? shiftSize shift),
-				    0))
+         fun bigArshift (arg: bigInt, shift: word): bigInt =
+            if shift = 0wx0
+               then arg
+            else Prim.~>> (arg, shift,
+                           reserve (Int.max (1, size arg -? shiftSize shift),
+                                    0))
 
-	 fun bigLshift (arg: bigInt, shift: word): bigInt =
-	    if shift = 0wx0
-	       then arg
-	    else Prim.<< (arg, shift, reserve (size arg +? shiftSize shift, 1))
+         fun bigLshift (arg: bigInt, shift: word): bigInt =
+            if shift = 0wx0
+               then arg
+            else Prim.<< (arg, shift, reserve (size arg +? shiftSize shift, 1))
       end
    
       type int = bigInt

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/integer/int.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/integer/int.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/integer/int.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 functor Integer (I: PRE_INTEGER_EXTRA) =
 struct
 
@@ -17,18 +18,18 @@
    if detectOverflow andalso
       precision' <> PI.precision'
       then if PI.<(precision', PI.precision')
-	     then (I.toInt, 
-		   fn i =>
-		   if (PI.<= (I.toInt minInt', i)
-		       andalso PI.<= (i, I.toInt maxInt'))
-		      then I.fromInt i
-		   else raise Overflow)
-	     else (fn i => 
-		   if (I.<= (I.fromInt PI.minInt', i)
-		       andalso I.<= (i, I.fromInt PI.maxInt'))
-		      then I.toInt i
-		   else raise Overflow,
-		   I.fromInt)
+             then (I.toInt, 
+                   fn i =>
+                   if (PI.<= (I.toInt minInt', i)
+                       andalso PI.<= (i, I.toInt maxInt'))
+                      then I.fromInt i
+                   else raise Overflow)
+             else (fn i => 
+                   if (I.<= (I.fromInt PI.minInt', i)
+                       andalso I.<= (i, I.fromInt PI.maxInt'))
+                      then I.toInt i
+                   else raise Overflow,
+                   I.fromInt)
    else (I.toInt, I.fromInt)
 
 val precision: Int.int option = SOME precision'
@@ -43,57 +44,57 @@
   if y = zero
     then raise Div
     else if detectOverflow andalso x = minInt' andalso y = ~one
-	   then raise Overflow
-	   else I.quot (x, y)
-	     
+           then raise Overflow
+           else I.quot (x, y)
+             
 fun rem (x, y) =
   if y = zero
     then raise Div
     else if x = minInt' andalso y = ~one
-	   then zero
-	   else I.rem (x, y)
+           then zero
+           else I.rem (x, y)
    
 fun x div y =
   if x >= zero
     then if y > zero
-	   then I.quot (x, y)
-	   else if y < zero
-		  then if x = zero
-			 then zero
-			 else I.quot (x - one, y) -? one
-		  else raise Div
+           then I.quot (x, y)
+           else if y < zero
+                  then if x = zero
+                         then zero
+                         else I.quot (x - one, y) -? one
+                  else raise Div
     else if y < zero
-	   then if detectOverflow andalso x = minInt' andalso y = ~one
-		  then raise Overflow
-		  else I.quot (x, y)
-	   else if y > zero
-		  then I.quot (x + one, y) -? one
-		  else raise Div
+           then if detectOverflow andalso x = minInt' andalso y = ~one
+                  then raise Overflow
+                  else I.quot (x, y)
+           else if y > zero
+                  then I.quot (x + one, y) -? one
+                  else raise Div
 
 fun x mod y =
   if x >= zero
     then if y > zero
-	   then I.rem (x, y)
-	   else if y < zero
-		  then if x = zero
-			 then zero
-			 else I.rem (x - one, y) +? (y + one)
-		  else raise Div
+           then I.rem (x, y)
+           else if y < zero
+                  then if x = zero
+                         then zero
+                         else I.rem (x - one, y) +? (y + one)
+                  else raise Div
     else if y < zero
-	   then if x = minInt' andalso y = ~one
-		  then zero
-		  else I.rem (x, y)
-	   else if y > zero
-		  then I.rem (x + one, y) +? (y - one)
-		  else raise Div
+           then if x = minInt' andalso y = ~one
+                  then zero
+                  else I.rem (x, y)
+           else if y > zero
+                  then I.rem (x + one, y) +? (y - one)
+                  else raise Div
 
 val sign: int -> Int.int =
   fn i => if i = zero
-	    then (0: Int.int)
-	  else if i < zero
-	    then (~1: Int.int)
-	  else (1: Int.int)
-	       
+            then (0: Int.int)
+          else if i < zero
+            then (~1: Int.int)
+          else (1: Int.int)
+               
 fun sameSign (x, y) = sign x = sign y
   
 fun abs (x: int) = if x < zero then ~ x else x
@@ -122,96 +123,91 @@
 in
    fun fmt radix (n: int): string =
       let
-	 val radix = fromInt (StringCvt.radixToInt radix)
-	 fun loop (q, i: Int.int) =
-	    let
-	       val _ =
-		  CharArray.update
-		  (buf, i, StringCvt.digitToChar (toInt (~? (rem (q, radix)))))
-	       val q = quot (q, radix)
-	    in
-	       if q = zero
-		  then
-		     let
-			val start =
-			   if n < zero
-			      then
-				 let
-				    val i = PI.- (i, 1)
-				    val () = CharArray.update (buf, i, #"~")
-				 in
-				    i
-				 end
-			   else i
-		     in
-			CharArraySlice.vector
-			(CharArraySlice.slice (buf, start, NONE))
-		     end
-	       else loop (q, PI.- (i, 1))
-	    end
+         val radix = fromInt (StringCvt.radixToInt radix)
+         fun loop (q, i: Int.int) =
+            let
+               val _ =
+                  CharArray.update
+                  (buf, i, StringCvt.digitToChar (toInt (~? (rem (q, radix)))))
+               val q = quot (q, radix)
+            in
+               if q = zero
+                  then
+                     let
+                        val start =
+                           if n < zero
+                              then
+                                 let
+                                    val i = PI.- (i, 1)
+                                    val () = CharArray.update (buf, i, #"~")
+                                 in
+                                    i
+                                 end
+                           else i
+                     in
+                        CharArraySlice.vector
+                        (CharArraySlice.slice (buf, start, NONE))
+                     end
+               else loop (q, PI.- (i, 1))
+            end
       in
-	 loop (if n < zero then n else ~? n, PI.- (maxNumDigits, 1))
+         loop (if n < zero then n else ~? n, PI.- (maxNumDigits, 1))
       end
 end      
 
 val toString = fmt StringCvt.DEC
-	 
-fun scan radix reader state =
-  let
-    (* Works with the negative of the number so that minInt can
-     * be scanned.
-     *)
-    val state = StringCvt.skipWS reader state
-    fun charToDigit c =
-      case StringCvt.charToDigit radix c of
-	NONE => NONE
-      | SOME n => SOME (fromInt n)
-    val radixInt = fromInt (StringCvt.radixToInt radix)
-    fun finishNum (state, n) =
-      case reader state of
-	NONE => SOME (n, state)
-      | SOME (c, state') =>
-	  case charToDigit c of
-	    NONE => SOME (n, state)
-	  | SOME n' => finishNum (state', n * radixInt - n')
-    fun num state =
-      case (reader state, radix) of
-	(NONE, _) => NONE
-      | (SOME (#"0", state), StringCvt.HEX) =>
-	  (case reader state of
-	     NONE => SOME (zero, state)
-	   | SOME (c, state') =>
-	       let
-		 fun rest () =
-		   case reader state' of
-		     NONE => SOME (zero, state)
-		   | SOME (c, state') =>
-		       case charToDigit c of
-			 NONE => SOME (zero, state)
-		       | SOME n => finishNum (state', ~? n)
-	       in case c of
-		 #"x" => rest ()
-	       | #"X" => rest ()
-	       | _ => (case charToDigit c of
-			 NONE => SOME (zero, state)
-		       | SOME n => finishNum (state', ~? n))
-	       end)
-      | (SOME (c, state), _) =>
-	     (case charToDigit c of
-		NONE => NONE
-	      | SOME n => finishNum (state, ~? n))
-    fun negate state =
-      case num state of
-	NONE => NONE
-      | SOME (n, s) => SOME (~ n, s)
-  in case reader state of
-    NONE => NONE
-  | SOME (c, state') =>
-      case c of
-	#"~" => num state'
-      | #"-" => num state'
-      | #"+" => negate state'
-      | _ => negate state
+         
+fun scan radix reader s =
+   let
+      (* Works with the negative of the number so that minInt can be scanned. *)
+      val s = StringCvt.skipWS reader s
+      fun charToDigit c =
+         case StringCvt.charToDigit radix c of
+            NONE => NONE
+          | SOME n => SOME (fromInt n)
+      val radixInt = fromInt (StringCvt.radixToInt radix)
+      fun finishNum (s, n) =
+         case reader s of
+            NONE => SOME (n, s)
+          | SOME (c, s') =>
+               case charToDigit c of
+                  NONE => SOME (n, s)
+                | SOME n' => finishNum (s', n * radixInt - n')
+      fun num s =
+         case (reader s, radix) of
+            (NONE, _) => NONE
+          | (SOME (#"0", s), StringCvt.HEX) =>
+               (case reader s of
+                   NONE => SOME (zero, s)
+                 | SOME (c, s') =>
+                      if c = #"x" orelse c = #"X" then
+                         case reader s' of
+                            NONE => SOME (zero, s)
+                          | SOME (c, s') =>
+                               case charToDigit c of
+                                  NONE => SOME (zero, s)
+                                | SOME n => finishNum (s', ~? n)
+                      else
+                         case charToDigit c of
+                            NONE => SOME (zero, s)
+                          | SOME n => finishNum (s', ~? n))
+          | (SOME (c, s), _) =>
+               case charToDigit c of
+                  NONE => NONE
+                | SOME n => finishNum (s, ~? n)
+    fun negate s =
+       case num s of
+          NONE => NONE
+        | SOME (n, s) => SOME (~ n, s)
+  in
+     case reader s of
+        NONE => NONE
+      | SOME (c, s') =>
+           case c of
+              #"~" => num s'
+            | #"-" => num s'
+            | #"+" => negate s'
+            | _ => negate s
   end
       
 val fromString = StringCvt.scanString (scan StringCvt.DEC)
@@ -220,12 +216,12 @@
   if Primitive.safe andalso exp < zero
     then raise Fail "Int.power"
     else let
-	   fun loop (exp, accum) =
-	     if exp <= zero
-	       then accum
-	       else loop (exp - one, base * accum)
-	 in loop (exp, one)
-	 end
+           fun loop (exp, accum) =
+             if exp <= zero
+               then accum
+               else loop (exp - one, base * accum)
+         in loop (exp, one)
+         end
 end
 
 structure Int8 = Integer (Primitive.Int8)
@@ -240,14 +236,10 @@
 structure Int64 = 
    struct
       local
-	 structure P = Primitive.Int64
-	 structure I = Integer (P)
+         structure P = Primitive.Int64
+         structure I = Integer (P)
       in
-	 open I
-	 val toWord = P.toWord
+         open I
+         val toWord = P.toWord
       end
    end
-      
-
-      
-

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/integer/integer.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/integer/integer.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/integer/integer.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -66,8 +66,8 @@
       val precision: Int.int option 
       val sameSign: int * int -> bool 
       val scan: (StringCvt.radix
-		 -> (char, 'a) StringCvt.reader
-		 -> (int, 'a) StringCvt.reader)
+                 -> (char, 'a) StringCvt.reader
+                 -> (int, 'a) StringCvt.reader)
       val sign: int -> Int.int 
       val toLarge: int -> LargeInt.int 
       val toString: int -> string 

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/integer/pack-word32.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/integer/pack-word32.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/integer/pack-word32.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,9 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 functor PackWord32 (val isBigEndian: bool): PACK_WORD =
@@ -16,20 +16,20 @@
 val (sub, up, subV) =
    if isBigEndian = Primitive.MLton.Platform.Arch.hostIsBigEndian
       then (Primitive.Word8Array.subWord,
-	    Primitive.Word8Array.updateWord,
-	    Primitive.Word8Vector.subWord)
+            Primitive.Word8Array.updateWord,
+            Primitive.Word8Vector.subWord)
    else (Primitive.Word8Array.subWordRev,
-	 Primitive.Word8Array.updateWordRev,
-	 Primitive.Word8Vector.subWordRev)
+         Primitive.Word8Array.updateWordRev,
+         Primitive.Word8Vector.subWordRev)
 
 fun start (i, n) = 
    let
       val i = Int.* (bytesPerElem, i)
       val _ =
-	 if Primitive.safe
-	    andalso Primitive.Int.geu (Int.+ (i, Int.- (bytesPerElem, 1)), n)
-	    then raise Subscript
-	 else ()
+         if Primitive.safe
+            andalso Primitive.Int.geu (Int.+ (i, Int.- (bytesPerElem, 1)), n)
+            then raise Subscript
+         else ()
    in
       i
    end handle Overflow => raise Subscript
@@ -37,9 +37,9 @@
 local
    fun make (sub, length, toPoly) (av, i) =
       let
-	 val _ = start (i, length av)
+         val _ = start (i, length av)
       in
-	 Word.toLarge (sub (toPoly av, i))
+         Word.toLarge (sub (toPoly av, i))
       end
 in
    val subArr = make (sub, Word8Array.length, Word8Array.toPoly)
@@ -60,3 +60,5 @@
 
 structure PackWord32Big = PackWord32 (val isBigEndian = true)
 structure PackWord32Little = PackWord32 (val isBigEndian = false)
+structure PackWord32Host = 
+   PackWord32(val isBigEndian = Primitive.MLton.Platform.Arch.hostIsBigEndian)

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/integer/patch.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/integer/patch.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/integer/patch.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 (* Patch in fromLarge and toLarge now that IntInf is defined. *)
 
 structure Int8: INTEGER_EXTRA =
@@ -39,18 +40,18 @@
       val toLarge = IntInf.fromInt64
 
       val op * =
-	 if Primitive.detectOverflow
-	    then fn (i, j) => fromLarge (IntInf.* (toLarge i, toLarge j))
-	 else op *?
+         if Primitive.detectOverflow
+            then fn (i, j) => fromLarge (IntInf.* (toLarge i, toLarge j))
+         else op *?
 
       (* Must redefine scan because the Integer functor defines it in terms of
        * Int64.*, which wasn't defined yet.
        *)
       fun scan radix reader state =
-	 case IntInf.scan radix reader state of
-	    NONE => NONE
-	  | SOME (i, s) => SOME (fromLarge i, s)
-		      
+         case IntInf.scan radix reader state of
+            NONE => NONE
+          | SOME (i, s) => SOME (fromLarge i, s)
+                      
       val fromString = StringCvt.scanString (scan StringCvt.DEC)
    end
 
@@ -66,7 +67,7 @@
       val toLargeInt = LargeInt.fromInt o toInt
 
       fun fromLargeInt (i: LargeInt.int): word =
-	 fromInt (LargeInt.toInt (LargeInt.mod (i, 0x100)))
+         fromInt (LargeInt.toInt (LargeInt.mod (i, 0x100)))
    end
 
 structure Word16: WORD_EXTRA =
@@ -77,7 +78,7 @@
       val toLargeInt = LargeInt.fromInt o toInt
 
       fun fromLargeInt (i: LargeInt.int): word =
-	 fromInt (LargeInt.toInt (LargeInt.mod (i, 0x10000)))
+         fromInt (LargeInt.toInt (LargeInt.mod (i, 0x10000)))
    end
 
 structure Word32: WORD32_EXTRA =
@@ -89,24 +90,24 @@
       fun highBitSet w = w >= 0wx80000000
 
       fun toLargeInt (w: word): LargeInt.int =
-	 if highBitSet w
-	    then IntInf.+ (0x80000000, toLargeIntX (andb (w, 0wx7FFFFFFF)))
-	 else toLargeIntX w
+         if highBitSet w
+            then IntInf.+ (0x80000000, toLargeIntX (andb (w, 0wx7FFFFFFF)))
+         else toLargeIntX w
 
       local
-	 val t32: LargeInt.int = 0x100000000
-	 val t31: LargeInt.int = 0x80000000
+         val t32: LargeInt.int = 0x100000000
+         val t31: LargeInt.int = 0x80000000
       in
-	 fun fromLargeInt (i: IntInf.int): word =
-	    fromInt
-	    (let
-		open IntInf
-		val low32 = i mod t32
-	     in
-		toInt (if low32 >= t31
-			  then low32 - t32
-		       else low32)
-	     end)
+         fun fromLargeInt (i: IntInf.int): word =
+            fromInt
+            (let
+                open IntInf
+                val low32 = i mod t32
+             in
+                toInt (if low32 >= t31
+                          then low32 - t32
+                       else low32)
+             end)
       end
    end
 
@@ -122,25 +123,25 @@
 
       val t32: LargeInt.int = 0x100000000
       val t64: LargeInt.int = 0x10000000000000000
-	 
+         
       fun toLargeInt w =
-	 IntInf.+
-	 (Word32.toLargeInt (Word32.fromLarge w),
-	  IntInf.<< (Word32.toLargeInt (Word32.fromLarge (>> (w, 0w32))),
-		     0w32))
+         IntInf.+
+         (Word32.toLargeInt (Word32.fromLarge w),
+          IntInf.<< (Word32.toLargeInt (Word32.fromLarge (>> (w, 0w32))),
+                     0w32))
 
       fun toLargeIntX w =
-	 if Word32.toLarge 0w0 = andb (w, << (Word32.toLarge 0w1, 0w63))
-	    then toLargeInt w
-	 else IntInf.- (toLargeInt w, t64)
+         if Word32.toLarge 0w0 = andb (w, << (Word32.toLarge 0w1, 0w63))
+            then toLargeInt w
+         else IntInf.- (toLargeInt w, t64)
 
       fun fromLargeInt (i: IntInf.int): word =
-	 let
-	    val (d, m) = IntInf.divMod (i, t32)
-	 in
-	    W.orb (W.<< (Word32.toLarge (Word32.fromLargeInt d), 0w32),
-		   Word32.toLarge (Word32.fromLargeInt m))
-	 end
+         let
+            val (d, m) = IntInf.divMod (i, t32)
+         in
+            W.orb (W.<< (Word32.toLarge (Word32.fromLargeInt d), 0w32),
+                   Word32.toLarge (Word32.fromLargeInt m))
+         end
    end
 
 structure LargeWord = Word64

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/integer/word.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/integer/word.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/integer/word.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -50,7 +50,7 @@
 signature WORD =
    sig
       include PRE_WORD
-	 
+         
       val compare: word * word -> order 
       val fmt: StringCvt.radix -> word -> string 
       val fromLargeInt: LargeInt.int -> word
@@ -59,8 +59,8 @@
       val max: word * word -> word
       val min: word * word -> word 
       val scan: (StringCvt.radix
-		 -> (char, 'a) StringCvt.reader
-		 -> (word, 'a) StringCvt.reader)
+                 -> (char, 'a) StringCvt.reader
+                 -> (word, 'a) StringCvt.reader)
       val toLargeInt: word -> LargeInt.int 
       val toLargeIntX: word -> LargeInt.int 
       val toLargeWord: word -> LargeWord.word 

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/integer/word.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/integer/word.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/integer/word.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 functor Word (W: PRE_WORD_EXTRA): WORD_EXTRA =
 struct
 
@@ -32,7 +33,7 @@
       andalso w > fromInt Int.maxInt'
       then raise Overflow
    else W.toInt w
-		      
+                      
 fun toIntX w =
   if detectOverflow
      andalso Int.> (wordSize, Int.precision')
@@ -44,7 +45,7 @@
 local
    fun make f (w, w') =
       if Primitive.safe andalso w' = zero
-	 then raise Div
+         then raise Div
       else f (w, w')
 in
    val op div = make (op div)
@@ -71,12 +72,12 @@
 fun fmt radix (w: word): string =
    let val radix = fromInt (StringCvt.radixToInt radix)
       fun loop (q, chars) =
-	 let val chars = StringCvt.digitToChar (toInt (q mod radix)) :: chars
-	    val q = q div radix
-	 in if q = zero
-	       then String0.implode chars
-	    else loop (q, chars)
-	 end
+         let val chars = StringCvt.digitToChar (toInt (q mod radix)) :: chars
+            val q = q div radix
+         in if q = zero
+               then String0.implode chars
+            else loop (q, chars)
+         end
    in loop (w, [])
    end
 
@@ -88,61 +89,61 @@
       val charToDigit = StringCvt.charToDigit radix
       val radixWord = fromInt (StringCvt.radixToInt radix)
       fun finishNum (state, n) =
-	 case reader state of
-	    NONE => SOME (n, state)
-	  | SOME (c, state') =>
-	       case charToDigit c of
-		  NONE => SOME (n, state)
-		| SOME n' =>
-		     let val n'' = n * radixWord
-		     in if n'' div radixWord = n
-			   then let val n' = fromInt n'
-				   val n''' = n'' + n'
-				in if n''' >= n''
-				      then finishNum (state', n''')
-				   else raise Overflow
-				end
-			else raise Overflow
-		     end
+         case reader state of
+            NONE => SOME (n, state)
+          | SOME (c, state') =>
+               case charToDigit c of
+                  NONE => SOME (n, state)
+                | SOME n' =>
+                     let val n'' = n * radixWord
+                     in if n'' div radixWord = n
+                           then let val n' = fromInt n'
+                                   val n''' = n'' + n'
+                                in if n''' >= n''
+                                      then finishNum (state', n''')
+                                   else raise Overflow
+                                end
+                        else raise Overflow
+                     end
       fun num state = finishNum (state, zero)
    in
       case reader state of
-	 NONE => NONE
+         NONE => NONE
        | SOME (c, state) =>
-	    case c of
-	       #"0" =>
-	       (case reader state of
-		   NONE => SOME (zero, state)
-		 | SOME (c, state') =>
-		      case c of
-			 #"w" => (case radix of
-				     StringCvt.HEX =>
-					(case reader state' of
-					    NONE =>
-					       (* the #"w" was not followed by
-						* an #"X" or #"x", therefore we
-						* return 0 *)
-					       SOME (zero, state)
-					  | SOME (c, state) =>
-					       (case c of
-						   #"x" => num state
-						 | #"X" => num state
-						 | _ =>
-						 (* the #"w" was not followed by
-						  * an #"X" or #"x", therefore we
-						  * return 0 *)
-						      SOME (zero, state)))
-				   | _ => num state')
-		       | #"x" => (case radix of
-				     StringCvt.HEX => num state'
-				   | _ => NONE)
-		       | #"X" => (case radix of
-				     StringCvt.HEX => num state'
-				   | _ => NONE)
-		       | _ => num state)
-	     | _ => (case charToDigit c of
-			NONE => NONE
-		      | SOME n => finishNum (state, fromInt n))
+            case c of
+               #"0" =>
+               (case reader state of
+                   NONE => SOME (zero, state)
+                 | SOME (c, state') =>
+                      case c of
+                         #"w" => (case radix of
+                                     StringCvt.HEX =>
+                                        (case reader state' of
+                                            NONE =>
+                                               (* the #"w" was not followed by
+                                                * an #"X" or #"x", therefore we
+                                                * return 0 *)
+                                               SOME (zero, state)
+                                          | SOME (c, state) =>
+                                               (case c of
+                                                   #"x" => num state
+                                                 | #"X" => num state
+                                                 | _ =>
+                                                 (* the #"w" was not followed by
+                                                  * an #"X" or #"x", therefore we
+                                                  * return 0 *)
+                                                      SOME (zero, state)))
+                                   | _ => num state')
+                       | #"x" => (case radix of
+                                     StringCvt.HEX => num state'
+                                   | _ => NONE)
+                       | #"X" => (case radix of
+                                     StringCvt.HEX => num state'
+                                   | _ => NONE)
+                       | _ => num state)
+             | _ => (case charToDigit c of
+                        NONE => NONE
+                      | SOME n => finishNum (state, fromInt n))
    end
 
 val fromString = StringCvt.scanString (scan StringCvt.HEX)

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/io/bin-io.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/io/bin-io.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/io/bin-io.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -6,7 +6,7 @@
       type instream
       type outstream
       type vector = StreamIO.vector
-	 
+         
       val canInput: instream * int -> int option 
       val closeIn: instream -> unit 
       val closeOut: outstream -> unit 

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/io/bin-io.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/io/bin-io.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/io/bin-io.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,10 @@
+(* Copyright (C) 2002-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 structure BinIO: BIN_IO_EXTRA =
    ImperativeIOExtra
    (structure Array = Word8Array
@@ -12,5 +19,5 @@
     val mkWriter = Posix.IO.mkBinWriter
     val someElem = 0wx0: Word8.word
     val xlatePos = SOME {fromInt = fn i => i,
-			 toInt = fn i => i})
+                         toInt = fn i => i})
        

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/io/bin-prim-io.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/io/bin-prim-io.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/io/bin-prim-io.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,12 +1,19 @@
+(* Copyright (C) 2002-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 structure BinPrimIO : PRIM_IO
                       where type array = Word8Array.array
-		      where type vector = Word8Vector.vector
-		      where type elem = Word8.word
-		      where type pos = Position.int =
+                      where type vector = Word8Vector.vector
+                      where type elem = Word8.word
+                      where type pos = Position.int =
   PrimIO (structure Vector = Word8Vector
-	  structure VectorSlice = Word8VectorSlice
-	  structure Array = Word8Array
-	  structure ArraySlice = Word8ArraySlice
-	  type pos = Position.int
-	  val compare = Position.compare
-	  val someElem = 0wx0: Word8.word)
+          structure VectorSlice = Word8VectorSlice
+          structure Array = Word8Array
+          structure ArraySlice = Word8ArraySlice
+          type pos = Position.int
+          val compare = Position.compare
+          val someElem = 0wx0: Word8.word)

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/io/imperative-io.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/io/imperative-io.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/io/imperative-io.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,10 @@
+(* Copyright (C) 2002-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 signature IMPERATIVE_IO_EXTRA_ARG =
    sig
       structure Array: sig
@@ -2,46 +9,46 @@
                           include MONO_ARRAY
-			  val rawArray: int -> array
-			  val unsafeSub: array * int -> elem
-		       end
+                          val rawArray: int -> array
+                          val unsafeSub: array * int -> elem
+                       end
       structure ArraySlice: MONO_ARRAY_SLICE
       structure PrimIO: PRIM_IO
       structure Vector: sig 
-	                   include MONO_VECTOR
+                           include MONO_VECTOR
                            val fromArray: Array.array -> vector
-			end
+                        end
       structure VectorSlice: MONO_VECTOR_SLICE
       sharing type Array.array
-	 = ArraySlice.array
-	 = PrimIO.array
+         = ArraySlice.array
+         = PrimIO.array
       sharing type Array.elem
-	 = ArraySlice.elem
-	 = PrimIO.elem
-	 = Vector.elem
-	 = VectorSlice.elem
+         = ArraySlice.elem
+         = PrimIO.elem
+         = Vector.elem
+         = VectorSlice.elem
       sharing type Array.vector
-	 = ArraySlice.vector
-	 = PrimIO.vector
-	 = Vector.vector
-	 = VectorSlice.vector
+         = ArraySlice.vector
+         = PrimIO.vector
+         = Vector.vector
+         = VectorSlice.vector
       sharing type ArraySlice.slice
-	 = PrimIO.array_slice
+         = PrimIO.array_slice
       sharing type ArraySlice.vector_slice
-	 = PrimIO.vector_slice
-	 = VectorSlice.slice
-	 
+         = PrimIO.vector_slice
+         = VectorSlice.slice
+         
       val chunkSize: int
       val fileTypeFlags: Posix.FileSys.O.flags list
       val line : {isLine: Vector.elem -> bool,
-		  lineElem: Vector.elem} option
+                  lineElem: Vector.elem} option
       val mkReader: {fd: Posix.FileSys.file_desc,
-		     name: string,
-		     initBlkMode: bool} -> PrimIO.reader
+                     name: string,
+                     initBlkMode: bool} -> PrimIO.reader
       val mkWriter: {fd: Posix.FileSys.file_desc,
-		     name: string,
-		     appendMode: bool,
-		     initBlkMode: bool,
-		     chunkSize: int} -> PrimIO.writer
+                     name: string,
+                     appendMode: bool,
+                     initBlkMode: bool,
+                     chunkSize: int} -> PrimIO.writer
       val someElem: PrimIO.elem
       val xlatePos : {toInt : PrimIO.pos -> Position.int, 
-		      fromInt : Position.int -> PrimIO.pos} option
+                      fromInt : Position.int -> PrimIO.pos} option
    end
@@ -70,30 +77,48 @@
 (*                     outstream                     *)
 (* ------------------------------------------------- *)
 
-datatype outstream = Out of SIO.outstream ref
+(* The following :> hides the fact that Outstream.t is an eqtype.  Doing it
+ * here is much easier than putting :> on the functor result.
+ *)
+structure Outstream:>
+   sig
+      type t
 
-fun output (Out os, v) = SIO.output (!os, v)
-fun output1 (Out os, v) = SIO.output1 (!os, v)
-fun outputSlice (Out os, v) = SIO.outputSlice (!os, v)
-fun flushOut (Out os) = SIO.flushOut (!os)
-fun closeOut (Out os) = SIO.closeOut (!os)
-fun mkOutstream os = Out (ref os)
-fun getOutstream (Out os) = !os
-fun setOutstream (Out os, os') = os := os'
-fun getPosOut (Out os) = SIO.getPosOut (!os)
-fun setPosOut (Out os, outPos) = os := SIO.setPosOut outPos
+      val get: t -> SIO.outstream
+      val make: SIO.outstream -> t
+      val set: t *  SIO.outstream -> unit
+   end =
+   struct 
+      datatype t = T of SIO.outstream ref
 
+      fun get (T r) = !r
+      fun set (T r, s) = r := s
+      fun make s = T (ref s)
+   end
+
+type outstream = Outstream.t
+fun output (os, v) = SIO.output (Outstream.get os, v)
+fun output1 (os, v) = SIO.output1 (Outstream.get os, v)
+fun outputSlice (os, v) = SIO.outputSlice (Outstream.get os, v)
+fun flushOut os = SIO.flushOut (Outstream.get os)
+fun closeOut os = SIO.closeOut (Outstream.get os)
+val mkOutstream = Outstream.make
+val getOutstream = Outstream.get
+val setOutstream  = Outstream.set
+val getPosOut = SIO.getPosOut o Outstream.get
+fun setPosOut (os, outPos) = Outstream.set (os, SIO.setPosOut outPos)
+
 fun newOut {appendMode, bufferMode, closeAtExit, fd, name} =
    let
       val writer = mkWriter {appendMode = appendMode, 
-			     chunkSize = chunkSize,
-			     fd = fd,
-			     initBlkMode = true,
-			     name = name}
+                             chunkSize = chunkSize,
+                             fd = fd,
+                             initBlkMode = true,
+                             name = name}
       val outstream = SIO.mkOutstream'' {bufferMode = bufferMode,
-					 closeAtExit = closeAtExit,
-					 closed = false,
-					 writer = writer}
+                                         closeAtExit = closeAtExit,
+                                         closed = false,
+                                         writer = writer}
    in
       mkOutstream outstream
    end
@@ -101,74 +126,74 @@
 structure PFS = Posix.FileSys
 
 val stdErr = newOut {appendMode = true, 
-		     bufferMode = IO.NO_BUF,
-		     closeAtExit = false,
-		     fd = PFS.stderr,
-		     name = "<stderr>"}
-	 
+                     bufferMode = IO.NO_BUF,
+                     closeAtExit = false,
+                     fd = PFS.stderr,
+                     name = "<stderr>"}
+         
 val newOut = fn {appendMode, closeAtExit, fd, name} =>
    newOut {appendMode = appendMode,
-	   bufferMode = if Posix.ProcEnv.isatty fd
-			    then IO.LINE_BUF
-			 else IO.BLOCK_BUF,
-	   closeAtExit = closeAtExit,
-	   fd = fd,
-	   name = name}
-	 
+           bufferMode = if Posix.ProcEnv.isatty fd
+                            then IO.LINE_BUF
+                         else IO.BLOCK_BUF,
+           closeAtExit = closeAtExit,
+           fd = fd,
+           name = name}
+         
 val stdOut = newOut {appendMode = true,
-		     closeAtExit = false,
-		     fd = PFS.stdout, 
-		     name = "<stdout>"}
+                     closeAtExit = false,
+                     fd = PFS.stdout, 
+                     name = "<stdout>"}
    
 val newOut = fn {appendMode, fd, name} =>
    newOut {appendMode = appendMode,
-	   closeAtExit = true,
-	   fd = fd,
-	   name = name}
+           closeAtExit = true,
+           fd = fd,
+           name = name}
 
 fun 'a protect' (function: string, name: string, f: unit -> 'a): 'a =
    f () handle e => raise IO.Io {cause = e,
-				 function = function,
-				 name = name}
+                                 function = function,
+                                 name = name}
       
 local
    val readWrite =
       let
-	 open PFS.S
+         open PFS.S
       in
-	 flags [irusr, iwusr, irgrp, iwgrp, iroth, iwoth]
+         flags [irusr, iwusr, irgrp, iwgrp, iroth, iwoth]
       end
 in
    fun openOut file =
       protect'
       ("openOut", file, fn () =>
        let
-	  val fd = PFS.createf (file, Posix.IO.O_WRONLY, 
-				PFS.O.flags (PFS.O.trunc::fileTypeFlags), 
-				readWrite)
+          val fd = PFS.createf (file, Posix.IO.O_WRONLY, 
+                                PFS.O.flags (PFS.O.trunc::fileTypeFlags), 
+                                readWrite)
        in 
-	  newOut {fd = fd, 
-		  name = file, 
-		  appendMode = false}
+          newOut {fd = fd, 
+                  name = file, 
+                  appendMode = false}
        end)
 
    fun openAppend file =
       protect'
       ("openAppend", file, fn () =>
        let
-	  val fd = PFS.createf (file, Posix.IO.O_WRONLY,
-				PFS.O.flags (PFS.O.append::fileTypeFlags),
-				readWrite)
+          val fd = PFS.createf (file, Posix.IO.O_WRONLY,
+                                PFS.O.flags (PFS.O.append::fileTypeFlags),
+                                readWrite)
        in
-	  newOut {fd = fd, 
-		  name = file, 
-		  appendMode = true}
+          newOut {fd = fd, 
+                  name = file, 
+                  appendMode = true}
        end)
 end
 
 val newOut = fn (fd, name) => newOut {fd = fd, 
-				      name = name,
-				      appendMode = false}
+                                      name = name,
+                                      appendMode = false}
 val outFd = SIO.outFd o getOutstream
 
 (* ------------------------------------------------- *)
@@ -185,11 +210,11 @@
  *)
 
 datatype instream = In of {augmentedReader: PIO.reader,
-			   buf: A.array,
-			   first: int ref, (* index of first character *)
-			   last: int ref, (* one past the index of the last char *)
-			   reader: PIO.reader,
-			   state: state ref}
+                           buf: A.array,
+                           first: int ref, (* index of first character *)
+                           last: int ref, (* one past the index of the last char *)
+                           reader: PIO.reader,
+                           state: state ref}
 
 local
    val augmentedReader = PIO.nullRd ()
@@ -199,11 +224,11 @@
    val reader = PIO.nullRd ()
 in
    fun mkInstream s = In {augmentedReader = augmentedReader,
-			  buf = buf,
-			  first = first,
-			  last = last,
-			  reader = reader,
-			  state = ref (Stream s)}
+                          buf = buf,
+                          first = first,
+                          last = last,
+                          reader = reader,
+                          state = ref (Stream s)}
 end
 
 fun setInstream (In {first, last, state, ...}, s) =
@@ -216,14 +241,14 @@
 fun augmentedReaderSel (In {augmentedReader = PIO.RD v, ...}, sel) = sel v
 
 fun readerSel (In {reader = PIO.RD v, ...}, sel) = sel v
-	 
+         
 fun inbufferName ib = readerSel (ib, #name)
 
 fun inFd ib =
    case readerSel (ib, #ioDesc) of
       NONE => raise IO.Io {cause = Fail "<no ioDesc>",
-			   function = "inFd",
-			   name = inbufferName ib}
+                           function = "inFd",
+                           name = inbufferName ib}
     | SOME ioDesc => valOf (Posix.FileSys.iodToFD ioDesc)
 
 val empty = V.tabulate (0, fn _ => someElem)
@@ -231,7 +256,7 @@
 local
    fun make (sel, e: exn) ib =
       case augmentedReaderSel (ib, sel) of
-	 NONE => raise e
+         NONE => raise e
        | SOME x => x
 in
    val readArr = make (#readArr, IO.BlockingNotSupported)
@@ -241,19 +266,19 @@
 
 fun 'a protect (ib, function: string, f: unit -> 'a): 'a =
    f () handle e => raise IO.Io {cause = e,
-				 function = function,
-				 name = inbufferName ib}
+                                 function = function,
+                                 name = inbufferName ib}
       
 fun update (ib as In {buf, first, last, state, ...}) =
    let
       val i = readArr ib (AS.full buf)
    in
       if i = 0
-	 then (state := Open {eos = true}
-	       ; false)
+         then (state := Open {eos = true}
+               ; false)
       else (first := 0
-	    ; last := i
-	    ; true)
+            ; last := i
+            ; true)
    end
 
 fun input (ib as In {buf, first, last, ...}) =
@@ -262,28 +287,28 @@
       val l = !last
    in
       if f < l
-	 then (first := l
-	       ; AS.vector (AS.slice (buf, f, SOME (l - f))))
+         then (first := l
+               ; AS.vector (AS.slice (buf, f, SOME (l - f))))
       else
-	 let
-	    val In {state, ...} = ib
-	 in
-	    case !state of
-	       Closed => empty
-	     | Open {eos} =>
-		  if eos
-		     then (state := Open {eos = false}
-			   ; empty)
-		  else protect (ib, "input", fn () =>
-				readVec ib (augmentedReaderSel (ib, #chunkSize)))
-	     | Stream s =>
-		  let
-		     val (v, s') = SIO.input s
-		     val _ = state := Stream s'
-		  in
-		     v
-		  end
-	 end
+         let
+            val In {state, ...} = ib
+         in
+            case !state of
+               Closed => empty
+             | Open {eos} =>
+                  if eos
+                     then (state := Open {eos = false}
+                           ; empty)
+                  else protect (ib, "input", fn () =>
+                                readVec ib (augmentedReaderSel (ib, #chunkSize)))
+             | Stream s =>
+                  let
+                     val (v, s') = SIO.input s
+                     val _ = state := Stream s'
+                  in
+                     v
+                  end
+         end
    end
 
 (* input1 will move past a temporary end of stream *)
@@ -292,33 +317,33 @@
       val f = !first
    in
       if f < !last
-	 then (first := f + 1
-	       ; SOME (A.unsafeSub (buf, f)))
+         then (first := f + 1
+               ; SOME (A.unsafeSub (buf, f)))
       else
-	 let
-	    val In {state, ...} = ib
-	 in
-	    case !state of
-	       Closed => NONE
-	     | Open {eos} =>
-		  if eos
-		     then
-			(state := Open {eos = false}
-			 ; NONE)
-		  else
-		     if protect (ib, "input1", fn () => update ib)
-			then
-			   (first := 1
-			    ; SOME (A.sub (buf, 0)))
-		     else NONE
-	     | Stream s =>
-		  let
-		     val (c, s') = SIO.input1' s
-		     val _ = state := Stream s'
-		  in
-		     c
-		  end
-	 end
+         let
+            val In {state, ...} = ib
+         in
+            case !state of
+               Closed => NONE
+             | Open {eos} =>
+                  if eos
+                     then
+                        (state := Open {eos = false}
+                         ; NONE)
+                  else
+                     if protect (ib, "input1", fn () => update ib)
+                        then
+                           (first := 1
+                            ; SOME (A.sub (buf, 0)))
+                     else NONE
+             | Stream s =>
+                  let
+                     val (c, s') = SIO.input1' s
+                     val _ = state := Stream s'
+                  in
+                     c
+                  end
+         end
    end
 
 fun inputN (ib as In {buf, first, last, ...}, n) =
@@ -326,246 +351,246 @@
       then raise Size
    else
       let
-	 val f = !first
-	 val l = !last
-	 val size = l - f
+         val f = !first
+         val l = !last
+         val size = l - f
       in
-	 if size >= n
-	    then (first := f + n
-		  ; AS.vector (AS.slice (buf, f, SOME n)))
-	 else
-	    let
-	       val In {state, ...} = ib
-	    in
-	       case !state of
-		  Closed => empty
-		| Open {eos} =>
-		     if eos
-			then (state := Open {eos = false}
-			      ; empty)
-		     else
-			protect
-			(ib, "inputN", fn () =>
-			 let
-			    val readArr = readArr ib
-			    val inp = A.rawArray n
-			    fun fill k =
-			       if k >= size
-				  then ()
-			       else (A.update (inp, k, A.sub (buf, f + k))
-				     ; fill (k + 1))
-			    val _ = fill 0
-			    val _ = first := l
-			    fun loop i =
-			       if i = n
-				  then i
-			       else let
-				       val j = 
-					  readArr
-					  (AS.slice (inp, i, SOME (n - i)))
-				    in
-				       if j = 0
-					  then (state := Open {eos = true}; i)
-				       else loop (i + j)
-				    end
-			    val i = loop size
-			 in
-			    if i = n
-			       then V.fromArray inp
-			    else AS.vector (AS.slice (inp, 0, SOME i))
-			 end)
-		| Stream s =>
-		     let
-			val (v, s') = SIO.inputN (s, n)
-			val _ = state := Stream s'
-		     in
-			v
-		     end
-	    end
+         if size >= n
+            then (first := f + n
+                  ; AS.vector (AS.slice (buf, f, SOME n)))
+         else
+            let
+               val In {state, ...} = ib
+            in
+               case !state of
+                  Closed => empty
+                | Open {eos} =>
+                     if eos
+                        then (state := Open {eos = false}
+                              ; empty)
+                     else
+                        protect
+                        (ib, "inputN", fn () =>
+                         let
+                            val readArr = readArr ib
+                            val inp = A.rawArray n
+                            fun fill k =
+                               if k >= size
+                                  then ()
+                               else (A.update (inp, k, A.sub (buf, f + k))
+                                     ; fill (k + 1))
+                            val _ = fill 0
+                            val _ = first := l
+                            fun loop i =
+                               if i = n
+                                  then i
+                               else let
+                                       val j = 
+                                          readArr
+                                          (AS.slice (inp, i, SOME (n - i)))
+                                    in
+                                       if j = 0
+                                          then (state := Open {eos = true}; i)
+                                       else loop (i + j)
+                                    end
+                            val i = loop size
+                         in
+                            if i = n
+                               then V.fromArray inp
+                            else AS.vector (AS.slice (inp, 0, SOME i))
+                         end)
+                | Stream s =>
+                     let
+                        val (v, s') = SIO.inputN (s, n)
+                        val _ = state := Stream s'
+                     in
+                        v
+                     end
+            end
       end
 
 fun inputAll (ib as In {state, ...}) =
    case !state of
       Closed => empty
     | Open {eos} =>
-	 if eos
-	    then (state := Open {eos = false}
-		  ; empty)
-	 else
-	    protect
-	    (ib, "inputAll", fn () =>
-	     let
-		val In {buf, first, last, ...} = ib
-		val readVec = readVec ib
-		val f = !first
-		val l = !last
-		val inp = AS.vector (AS.slice (buf, f, SOME (l - f)))
-		val inps = [inp]
-		fun loop inps =
-		   let
-		      val inp =
-			 readVec (augmentedReaderSel (ib, #chunkSize))
-		   in
-		      if V.length inp = 0
-			 then V.concat (List.rev inps)
-		      else loop (inp :: inps)
-		   end
-	     in
-		loop inps
-	     end)
+         if eos
+            then (state := Open {eos = false}
+                  ; empty)
+         else
+            protect
+            (ib, "inputAll", fn () =>
+             let
+                val In {buf, first, last, ...} = ib
+                val readVec = readVec ib
+                val f = !first
+                val l = !last
+                val inp = AS.vector (AS.slice (buf, f, SOME (l - f)))
+                val inps = [inp]
+                fun loop inps =
+                   let
+                      val inp =
+                         readVec (augmentedReaderSel (ib, #chunkSize))
+                   in
+                      if V.length inp = 0
+                         then V.concat (List.rev inps)
+                      else loop (inp :: inps)
+                   end
+             in
+                loop inps
+             end)
     | Stream s =>
-	  let
-	     val (v, s') = SIO.inputAll s
-	     val _ = state := Stream s'
-	  in
-	     v
-	  end
+          let
+             val (v, s') = SIO.inputAll s
+             val _ = state := Stream s'
+          in
+             v
+          end
 
 val inputLine =
    case line of
       NONE => (fn ib => SOME (input ib))
     | SOME {isLine, lineElem, ...} =>
-	 let
-	    val lineVec = V.tabulate (1, fn _ => lineElem)
-	 in
-	    fn (ib as In {state, ...}) =>
-	    case !state of
-	       Closed => NONE
-	     | Open {eos} =>
-		  if eos
-		      then NONE
-		  else
-		     protect
-		     (ib, "inputLine", fn () =>
-		      let
-			 val In {buf, first, last, ...} = ib
-			 fun finish (inps, trail) =
-			    let
-			       val inps = if trail
-					     then lineVec :: inps
-					  else inps
-			       val inp = V.concat (List.rev inps)
-			    in
-			       SOME inp
-			    end
-			 fun loop inps =
-			    if !first < !last orelse update ib
-			       then
-				  let
-				     val f = !first
-				     val l = !last
-				     (* !first < !last *) 
-				     fun loop' i = (* pre: !first <= i <= !last *)
-					let
-					   fun done j = (* pre: !first < j <= !last *)
-					      let
-						 val inp = AS.vector (AS.slice (buf, f, SOME (j - f)))
-					      in
-						 first := j;
-						 inp::inps
-					      end
-					in
-					   if i >= l
-					      then loop (done i)
-					   else if isLine (A.sub (buf, i))
-						   then finish (done (i + 1), false)
-						else loop' (i + 1)
-					end
-				  in
-				     loop' f
-				  end
-			    else (case inps of
-				     [] => NONE
-				   | _ => finish (inps, true))
-		      in
-			 loop []
-		      end)
-	     | Stream s =>
-		  Option.map
-		  (fn (v, s') => (state := Stream s'; v))
-		  (SIO.inputLine s)
-	 end
+         let
+            val lineVec = V.tabulate (1, fn _ => lineElem)
+         in
+            fn (ib as In {state, ...}) =>
+            case !state of
+               Closed => NONE
+             | Open {eos} =>
+                  if eos
+                      then NONE
+                  else
+                     protect
+                     (ib, "inputLine", fn () =>
+                      let
+                         val In {buf, first, last, ...} = ib
+                         fun finish (inps, trail) =
+                            let
+                               val inps = if trail
+                                             then lineVec :: inps
+                                          else inps
+                               val inp = V.concat (List.rev inps)
+                            in
+                               SOME inp
+                            end
+                         fun loop inps =
+                            if !first < !last orelse update ib
+                               then
+                                  let
+                                     val f = !first
+                                     val l = !last
+                                     (* !first < !last *) 
+                                     fun loop' i = (* pre: !first <= i <= !last *)
+                                        let
+                                           fun done j = (* pre: !first < j <= !last *)
+                                              let
+                                                 val inp = AS.vector (AS.slice (buf, f, SOME (j - f)))
+                                              in
+                                                 first := j;
+                                                 inp::inps
+                                              end
+                                        in
+                                           if i >= l
+                                              then loop (done i)
+                                           else if isLine (A.sub (buf, i))
+                                                   then finish (done (i + 1), false)
+                                                else loop' (i + 1)
+                                        end
+                                  in
+                                     loop' f
+                                  end
+                            else (case inps of
+                                     [] => NONE
+                                   | _ => finish (inps, true))
+                      in
+                         loop []
+                      end)
+             | Stream s =>
+                  Option.map
+                  (fn (v, s') => (state := Stream s'; v))
+                  (SIO.inputLine s)
+         end
 
 fun canInput (ib as In {state, ...}, n) =
    if n < 0 orelse n > V.maxLen
       then raise Size
    else
       case !state of
-	 Closed => SOME 0
+         Closed => SOME 0
        | Open {eos} =>
-	    if eos
-	       then SOME 0
-	    else
-	       protect
-	       (ib, "canInput", fn () =>
-		let
-		   val readArrNB = readArrNB ib
-		   val In {buf, first, last, ...} = ib
-		   val f = !first
-		   val l = !last
-		   val read = l - f
-		   val _ =
-		      if f > 0
-			 then
-			    (AS.copy {di = 0,
-				      dst = buf,
-				      src = AS.slice (buf, f, SOME read)}
-			     ; first := 0)
-		      else ()
-		   val size = A.length buf
-		   (* 0 = !first *)
-		   fun loop read =
-		      if read = size
-			 then read
-		      else
-			 let
-			    val slice = AS.slice (buf, read, NONE)
-			    val i = readArrNB slice
-			 in
-			    case i of
-			       NONE => read
-			     | SOME i =>
-				  if 0 = i then read else loop (read + i)
-			 end
-		   val read = loop read
-		   val _ = last := read
-		in
-		   SOME (if read > 0
-			    then Int.min (n, read)
-			 else (state := Open {eos = true}; 0))
-		end)
+            if eos
+               then SOME 0
+            else
+               protect
+               (ib, "canInput", fn () =>
+                let
+                   val readArrNB = readArrNB ib
+                   val In {buf, first, last, ...} = ib
+                   val f = !first
+                   val l = !last
+                   val read = l - f
+                   val _ =
+                      if f > 0
+                         then
+                            (AS.copy {di = 0,
+                                      dst = buf,
+                                      src = AS.slice (buf, f, SOME read)}
+                             ; first := 0)
+                      else ()
+                   val size = A.length buf
+                   (* 0 = !first *)
+                   fun loop read =
+                      if read = size
+                         then read
+                      else
+                         let
+                            val slice = AS.slice (buf, read, NONE)
+                            val i = readArrNB slice
+                         in
+                            case i of
+                               NONE => read
+                             | SOME i =>
+                                  if 0 = i then read else loop (read + i)
+                         end
+                   val read = loop read
+                   val _ = last := read
+                in
+                   SOME (if read > 0
+                            then Int.min (n, read)
+                         else (state := Open {eos = true}; 0))
+                end)
        | Stream s => SIO.canInput (s, n)
-		 
+                 
 fun lookahead (ib as In {buf, first, last, ...}) =
    let
       val f = !first
       val l = !last
    in
       if f < l
-	 then SOME (A.unsafeSub (buf, f))
+         then SOME (A.unsafeSub (buf, f))
       else
-	 let
-	    val In {state, ...} = ib
-	 in
-	    case !state of
-	       Closed => NONE
-	     | Open {eos, ...} =>
-		  if eos
-		     then NONE
-		  else if protect (ib, "lookahead", fn () => update ib)
-			  then SOME (A.sub (buf, 0))
-		       else NONE
-	     | Stream s => Option.map #1 (SIO.input1 s)
-	 end
+         let
+            val In {state, ...} = ib
+         in
+            case !state of
+               Closed => NONE
+             | Open {eos, ...} =>
+                  if eos
+                     then NONE
+                  else if protect (ib, "lookahead", fn () => update ib)
+                          then SOME (A.sub (buf, 0))
+                       else NONE
+             | Stream s => Option.map #1 (SIO.input1 s)
+         end
    end
 
 fun closeIn (ib as In {first, last, state, ...}) =
    case !state of
       Closed => ()
     | Open _ =>
-	 (first := !last
-	  ; state := Closed
-	  ; protect (ib, "closeIn", fn () => readerSel (ib, #close) ()))
+         (first := !last
+          ; state := Closed
+          ; protect (ib, "closeIn", fn () => readerSel (ib, #close) ()))
     | Stream s => SIO.closeIn s
 
 fun endOfStream (ib as In {first, last, state, ...}) =
@@ -574,109 +599,109 @@
    (case !state of
        Closed => true
      | Open {eos, ...} =>
-	  eos orelse not (protect (ib, "endOfStream", fn () => update ib))
+          eos orelse not (protect (ib, "endOfStream", fn () => update ib))
      | Stream s => SIO.endOfStream s)
 
 fun mkInbuffer' {reader, closed, bufferContents} =
    let
       val (state, first, last, buf) =
-	 if closed
-	    then (ref Closed, ref 0, ref 0, Array.array (0, someElem))
-	 else let
-		 val PIO.RD {chunkSize, ...} = reader
-		 val buf = Array.array (chunkSize, someElem)
-		 val first = ref 0
-		 val (state, last) =
-		    case bufferContents of
-		       NONE => (ref (Open {eos = false}), ref 0)
-		     | SOME v =>
-			  if V.length v = 0
-			     then (ref (Open {eos = true}), ref 0)
-			  else (V.appi (fn (i, c) => A.update (buf, i, c)) v
-				; (ref (Open {eos = false}), ref (V.length v)))
-	      in
-		 (state, first, last, buf)
-	      end
+         if closed
+            then (ref Closed, ref 0, ref 0, Array.array (0, someElem))
+         else let
+                 val PIO.RD {chunkSize, ...} = reader
+                 val buf = Array.array (chunkSize, someElem)
+                 val first = ref 0
+                 val (state, last) =
+                    case bufferContents of
+                       NONE => (ref (Open {eos = false}), ref 0)
+                     | SOME v =>
+                          if V.length v = 0
+                             then (ref (Open {eos = true}), ref 0)
+                          else (V.appi (fn (i, c) => A.update (buf, i, c)) v
+                                ; (ref (Open {eos = false}), ref (V.length v)))
+              in
+                 (state, first, last, buf)
+              end
    in
       In {augmentedReader = PIO.augmentReader reader,
-	  buf = buf,
-	  first = first,
-	  last = last,
-	  reader = reader,
-	  state = state}
+          buf = buf,
+          first = first,
+          last = last,
+          reader = reader,
+          state = state}
    end
 
 fun openVector v = 
    mkInbuffer' {bufferContents = NONE,
-		closed = false,
-		reader = PIO.openVector v}
+                closed = false,
+                reader = PIO.openVector v}
 
 val openInbuffers : (instream * {close: bool}) list ref = ref []
 
 fun getInstream (ib as In {state, ...}) =
    let
       fun doit (closed: bool, bufferContents) =
-	 let
-	    val In {reader, ...} = ib
-	    val (ibs, openInbuffers') =
-	       List.partition (fn (ib', _) => equalsIn (ib, ib'))
-	       (!openInbuffers)
-	    val _ = openInbuffers := openInbuffers'
-	    val closeAtExit = 
-	       List.foldr (fn ((_, {close = close'}), close) =>
-			   close orelse close')
-	       false ibs
-	 in
-	    SIO.mkInstream'' {bufferContents = bufferContents,
-			      closeAtExit = closeAtExit,
-			      closed = closed,
-			      reader = reader}
-	 end
+         let
+            val In {reader, ...} = ib
+            val (ibs, openInbuffers') =
+               List.partition (fn (ib', _) => equalsIn (ib, ib'))
+               (!openInbuffers)
+            val _ = openInbuffers := openInbuffers'
+            val closeAtExit = 
+               List.foldr (fn ((_, {close = close'}), close) =>
+                           close orelse close')
+               false ibs
+         in
+            SIO.mkInstream'' {bufferContents = bufferContents,
+                              closeAtExit = closeAtExit,
+                              closed = closed,
+                              reader = reader}
+         end
    in
       case !state of
-	 Closed => doit (true, NONE)
+         Closed => doit (true, NONE)
        | Open {eos} =>
-	    if eos
-	       then doit (false, SOME (true, empty))
-	    else
-	       let
-		  val In {buf, first, last, ...} = ib
-		  val f = !first
-		  val l = !last
-		  val s =
-		     if f < l
-			then 
-			   doit (false,
-				 SOME (true, 
-				       AS.vector (AS.slice (buf, f, 
-							    SOME (l - f)))))
-			else doit (false, NONE)
-		  val () = state := Stream s
-	       in
-		  s
-	       end
+            if eos
+               then doit (false, SOME (true, empty))
+            else
+               let
+                  val In {buf, first, last, ...} = ib
+                  val f = !first
+                  val l = !last
+                  val s =
+                     if f < l
+                        then 
+                           doit (false,
+                                 SOME (true, 
+                                       AS.vector (AS.slice (buf, f, 
+                                                            SOME (l - f)))))
+                        else doit (false, NONE)
+                  val () = state := Stream s
+               in
+                  s
+               end
        | Stream s => s
    end
 
 val mkInbuffer'' =
    let
       val _ =
-	 Cleaner.addNew
-	 (Cleaner.atExit, fn () =>
-	  List.app (fn (ib, {close}) => if close then closeIn ib else ())
-	  (!openInbuffers))
+         Cleaner.addNew
+         (Cleaner.atExit, fn () =>
+          List.app (fn (ib, {close}) => if close then closeIn ib else ())
+          (!openInbuffers))
    in
       fn {bufferContents, closeAtExit, closed, reader} =>
       let
-	 val ib = mkInbuffer' {bufferContents = bufferContents,
-			       closed = closed,
-			       reader = reader}
-	 val _ = if closed
-		    then ()
-		 else openInbuffers := ((ib, {close = closeAtExit})
-					:: (!openInbuffers))
+         val ib = mkInbuffer' {bufferContents = bufferContents,
+                               closed = closed,
+                               reader = reader}
+         val _ = if closed
+                    then ()
+                 else openInbuffers := ((ib, {close = closeAtExit})
+                                        :: (!openInbuffers))
       in
-	 ib
+         ib
       end
    end
 
@@ -688,8 +713,8 @@
 val closeIn = fn ib =>
    let
       val _ = openInbuffers := List.filter (fn (ib',_) => 
-					    not (equalsIn (ib, ib'))) 
-	 (!openInbuffers)
+                                            not (equalsIn (ib, ib'))) 
+         (!openInbuffers)
    in
       closeIn ib
    end
@@ -699,19 +724,19 @@
       val reader = mkReader {fd = fd, initBlkMode = true, name = name}
    in
       mkInbuffer'' {bufferContents = bufferContents,
-		    closeAtExit = closeAtExit,
-		    closed = false,
-		    reader = reader}
+                    closeAtExit = closeAtExit,
+                    closed = false,
+                    reader = reader}
    end
      
 val newIn = fn (fd, name) =>
    newIn {bufferContents = NONE,
-	  closeAtExit = true,
-	  fd = fd,
-	  name = name}
+          closeAtExit = true,
+          fd = fd,
+          name = name}
 
 val stdIn = newIn (PFS.stdin, "<stdin>")
-	 
+         
 fun openIn file =
    protect'
    ("openIn", file, fn () =>
@@ -732,16 +757,16 @@
 (*      structure VectorSlice: MONO_VECTOR_SLICE *)
 (*      sharing type Array.array = ArraySlice.array *)
       sharing type
-	 Array.elem
-(*	 = ArraySlice.elem *)
-	 = StreamIO.elem
-	 = Vector.elem
-(*	 = VectorSlice.elem *)
+         Array.elem
+(*       = ArraySlice.elem *)
+         = StreamIO.elem
+         = Vector.elem
+(*       = VectorSlice.elem *)
       sharing type
-	 Array.vector
-(*	 = ArraySlice.vector *)
-	 = Vector.vector
-(*	 = VectorSlice.vector *)
+         Array.vector
+(*       = ArraySlice.vector *)
+         = Vector.vector
+(*       = VectorSlice.vector *)
 (*      sharing type ArraySlice.vector_slice = VectorSlice.slice *)
    end
 
@@ -773,21 +798,21 @@
       fun endOfStream (In is) = SIO.endOfStream (!is)
       fun getInstream (In is) = !is
       fun input (In is) = let val (v, is') = SIO.input (!is)
-			  in is := is'; v
-			  end 
+                          in is := is'; v
+                          end 
       (* input1 will never move past a temporary end of stream *)
       fun input1 (In is) = 
-	case SIO.input1 (!is) of
-	  SOME (c,is') => (is := is'; SOME c)
-	| NONE => NONE
+        case SIO.input1 (!is) of
+          SOME (c,is') => (is := is'; SOME c)
+        | NONE => NONE
       fun inputAll (In is) = let val (v, is') = SIO.inputAll (!is)
-			     in is := is'; v
-			     end
+                             in is := is'; v
+                             end
       fun inputN (In is, n) = let val (v, is') = SIO.inputN (!is, n)
-			      in is := is'; v
-			      end
+                              in is := is'; v
+                              end
       fun lookahead (In is) =
-	 Option.map #1 (SIO.input1 (!is))
+         Option.map #1 (SIO.input1 (!is))
       fun mkInstream is = In (ref is)
       fun setInstream (In is, is') = is := is'
    end

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/io/imperative-io.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/io/imperative-io.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/io/imperative-io.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -68,9 +68,9 @@
       val output: outstream * vector -> unit
       val outputSlice: outstream * vector_slice -> unit
       val scanStream:
-	 ((elem, StreamIO.instream) StringCvt.reader
-	  -> ('a, StreamIO.instream) StringCvt.reader)
-	 -> instream -> 'a option
+         ((elem, StreamIO.instream) StringCvt.reader
+          -> ('a, StreamIO.instream) StringCvt.reader)
+         -> instream -> 'a option
       val setInstream: instream * StreamIO.instream -> unit
       val setOutstream: outstream * StreamIO.outstream -> unit
       val setPosOut: outstream * StreamIO.out_pos -> unit

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/io/io.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/io/io.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/io/io.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,8 +1,8 @@
 signature IO =
    sig
       exception Io of {name : string,
-		       function : string,
-		       cause : exn}
+                       function : string,
+                       cause : exn}
       exception BlockingNotSupported
       exception NonblockingNotSupported
       exception RandomAccessNotSupported

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/io/io.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/io/io.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/io/io.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 structure IO: IO =
    struct
       exception BlockingNotSupported
@@ -12,17 +13,17 @@
       exception ClosedStream
 
       exception Io of {cause : exn,
-		       function : string,
-		       name : string}
+                       function : string,
+                       name : string}
 
       val _ =
-	 General.addExnMessager
-	 (fn e =>
-	  case e of
-	     Io {cause, function, name, ...} => 
-   	        SOME (concat ["Io: ", function, " \"", name, "\" failed with ",
-			      exnMessage cause])
-	   | _ => NONE)
+         General.addExnMessager
+         (fn e =>
+          case e of
+             Io {cause, function, name, ...} => 
+                SOME (concat ["Io: ", function, " \"", name, "\" failed with ",
+                              exnMessage cause])
+           | _ => NONE)
       
       exception NonblockingNotSupported
 

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/io/prim-io.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/io/prim-io.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/io/prim-io.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,10 @@
+(* Copyright (C) 2002-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 signature PRIM_IO_ARG =
    sig
       structure Vector: MONO_VECTOR
@@ -5,12 +12,12 @@
       structure Array: MONO_ARRAY
       structure ArraySlice: MONO_ARRAY_SLICE
       sharing type Vector.elem = VectorSlice.elem 
-	 = Array.elem = ArraySlice.elem 
+         = Array.elem = ArraySlice.elem 
       sharing type Vector.vector = VectorSlice.vector 
-	 = Array.vector = ArraySlice.vector 
+         = Array.vector = ArraySlice.vector 
       sharing type VectorSlice.slice = ArraySlice.vector_slice
       sharing type Array.array = ArraySlice.array
-	
+        
       val someElem: Vector.elem
 
       eqtype pos
@@ -20,12 +27,12 @@
 functor PrimIO (S: PRIM_IO_ARG): PRIM_IO =
    struct 
       open S
-	 
+         
       structure V = Vector
       structure VS = VectorSlice
       structure A = Array
       structure AS = ArraySlice
-	 
+         
       type elem = A.elem
       type vector = V.vector
       type vector_slice = VS.slice
@@ -33,284 +40,284 @@
       type array_slice = AS.slice
       type pos = pos
       val compare = compare
-	 
+         
       datatype reader =
-	 RD of {avail: unit -> int option,
-		block: (unit -> unit) option,
-		canInput: (unit -> bool) option,
-		chunkSize: int,
-		close: unit -> unit,
-		endPos: (unit -> pos) option,
-		getPos: (unit -> pos) option,
-		ioDesc: OS.IO.iodesc option,
-		name: string,
-		readArr: (array_slice -> int) option,
-		readArrNB: (array_slice -> int option) option,
-		readVec: (int -> vector) option,
-		readVecNB: (int -> vector option) option,
-		setPos: (pos -> unit) option,
-		verifyPos: (unit -> pos) option}
-	 
+         RD of {avail: unit -> int option,
+                block: (unit -> unit) option,
+                canInput: (unit -> bool) option,
+                chunkSize: int,
+                close: unit -> unit,
+                endPos: (unit -> pos) option,
+                getPos: (unit -> pos) option,
+                ioDesc: OS.IO.iodesc option,
+                name: string,
+                readArr: (array_slice -> int) option,
+                readArrNB: (array_slice -> int option) option,
+                readVec: (int -> vector) option,
+                readVecNB: (int -> vector option) option,
+                setPos: (pos -> unit) option,
+                verifyPos: (unit -> pos) option}
+         
       datatype writer =
-	 WR of {block: (unit -> unit) option,
-		canOutput: (unit -> bool) option,
-		chunkSize: int,
-		close: unit -> unit,
-		endPos: (unit -> pos) option,
-		getPos: (unit -> pos) option,
-		ioDesc: OS.IO.iodesc option,
-		name: string,
-		setPos: (pos -> unit) option,
-		verifyPos: (unit -> pos) option,
-		writeArr: (array_slice -> int) option,
-		writeArrNB: (array_slice -> int option) option,
-		writeVec: (vector_slice -> int) option,
-		writeVecNB: (vector_slice -> int option) option}
-	 
-	 
+         WR of {block: (unit -> unit) option,
+                canOutput: (unit -> bool) option,
+                chunkSize: int,
+                close: unit -> unit,
+                endPos: (unit -> pos) option,
+                getPos: (unit -> pos) option,
+                ioDesc: OS.IO.iodesc option,
+                name: string,
+                setPos: (pos -> unit) option,
+                verifyPos: (unit -> pos) option,
+                writeArr: (array_slice -> int) option,
+                writeArrNB: (array_slice -> int option) option,
+                writeVec: (vector_slice -> int) option,
+                writeVecNB: (vector_slice -> int option) option}
+         
+         
       fun liftExn name function cause = raise IO.Io {name = name,
-						     function = function,
-						     cause = cause}
+                                                     function = function,
+                                                     cause = cause}
 
       fun openVector v =
-	 let
-	    val name = "openVector"
-	    val closed = ref false
-	    val pos = ref 0
-	    val eofPos = V.length v
-	    fun check f = if !closed
-			     then liftExn name f IO.ClosedStream
-			     else ()
-	    fun const f c = fn _ => (check f; c)
-	    fun readVec f i =
-	       let
-		  val _ = check f
-		  val n = Int.min (i, eofPos - !pos)
-	       in
-		  VS.vector (VS.slice (v, !pos, SOME n)) before (pos := !pos + n)
-	       end
-	    fun readArr f sl =
-	       let
-		  val _ = check f
-		  val (buf, i, sz) = AS.base sl
-		  val n = Int.min (sz, eofPos - !pos)
-	       in
-		  AS.copyVec {src = VS.slice (v, !pos, SOME n),
-			      dst = buf,
-			      di = i};
-		  pos := !pos + n;
-		  n
-	       end
-	 in
-	    RD {avail = const "avail" NONE,
-		block = SOME (const "block" ()),
-		canInput = SOME (const "canInput" true),
-		chunkSize = 32,
-		close = fn () => (closed := true),
-		endPos = NONE,
-		getPos = NONE,
-		ioDesc = NONE,
-		name = name,
-		readArr = SOME (readArr "readArr"),
-		readArrNB = SOME (SOME o (readArr "readVecNB")),
-		readVec = SOME (readVec "readVec"),
-		readVecNB = SOME (SOME o (readVec "readVecNB")),
-		setPos = NONE,
-		verifyPos = NONE}
-	 end
+         let
+            val name = "openVector"
+            val closed = ref false
+            val pos = ref 0
+            val eofPos = V.length v
+            fun check f = if !closed
+                             then liftExn name f IO.ClosedStream
+                             else ()
+            fun const f c = fn _ => (check f; c)
+            fun readVec f i =
+               let
+                  val _ = check f
+                  val n = Int.min (i, eofPos - !pos)
+               in
+                  VS.vector (VS.slice (v, !pos, SOME n)) before (pos := !pos + n)
+               end
+            fun readArr f sl =
+               let
+                  val _ = check f
+                  val (buf, i, sz) = AS.base sl
+                  val n = Int.min (sz, eofPos - !pos)
+               in
+                  AS.copyVec {src = VS.slice (v, !pos, SOME n),
+                              dst = buf,
+                              di = i};
+                  pos := !pos + n;
+                  n
+               end
+         in
+            RD {avail = const "avail" NONE,
+                block = SOME (const "block" ()),
+                canInput = SOME (const "canInput" true),
+                chunkSize = 32,
+                close = fn () => (closed := true),
+                endPos = NONE,
+                getPos = NONE,
+                ioDesc = NONE,
+                name = name,
+                readArr = SOME (readArr "readArr"),
+                readArrNB = SOME (SOME o (readArr "readVecNB")),
+                readVec = SOME (readVec "readVec"),
+                readVecNB = SOME (SOME o (readVec "readVecNB")),
+                setPos = NONE,
+                verifyPos = NONE}
+         end
       
       fun nullRd () =
-	 let
-	    val name = "nullRd"
-	    val closed = ref false
-	    fun check f = if !closed
-			     then liftExn name f IO.ClosedStream
-			     else ()
-	    fun const f c = fn _ => (check f; c)
-	    val empty = V.fromList []
-	 in
-	    RD {avail = const "avail" NONE,
-		block = SOME (const "block" ()),
-		canInput = SOME (const "canInput" true),
-		chunkSize = 1,
-		close = fn () => (closed := true),
-		endPos = NONE,
-		getPos = NONE,
-		ioDesc = NONE,
-		name = name,
-		readArr = SOME (const "readArr" 0),
-		readArrNB = SOME (const "readArrNB" (SOME 0)),
-		readVec = SOME (const "readVec" empty),
-		readVecNB = SOME (const "readVecNB" (SOME empty)),
-		setPos = NONE,
-		verifyPos = NONE}
-	 end
+         let
+            val name = "nullRd"
+            val closed = ref false
+            fun check f = if !closed
+                             then liftExn name f IO.ClosedStream
+                             else ()
+            fun const f c = fn _ => (check f; c)
+            val empty = V.fromList []
+         in
+            RD {avail = const "avail" NONE,
+                block = SOME (const "block" ()),
+                canInput = SOME (const "canInput" true),
+                chunkSize = 1,
+                close = fn () => (closed := true),
+                endPos = NONE,
+                getPos = NONE,
+                ioDesc = NONE,
+                name = name,
+                readArr = SOME (const "readArr" 0),
+                readArrNB = SOME (const "readArrNB" (SOME 0)),
+                readVec = SOME (const "readVec" empty),
+                readVecNB = SOME (const "readVecNB" (SOME empty)),
+                setPos = NONE,
+                verifyPos = NONE}
+         end
       
       fun nullWr () =
-	 let
-	    val name = "nullWr"
-	    val closed = ref false
-	    fun check f = if !closed
-			     then liftExn name f IO.ClosedStream
-			     else ()
-	    fun const f c = fn _ => (check f; c)
-	    fun function f g = fn x => (check f; g x)
-	 in
-	    WR {block = SOME (const "block" ()),
-		canOutput = SOME (const "canOutput" true),
-		chunkSize = 1,
-		close = fn () => (closed := true),
-		endPos = NONE,
-		getPos = NONE,
-		ioDesc = NONE,
-		name = name,
-		setPos = NONE,
-		verifyPos = NONE,
-		writeArr = SOME (function "writeArr" AS.length),
-		writeArrNB = SOME (function "writeArrNB" (SOME o AS.length)),
-		writeVec = SOME (function "writeVec" VS.length),
-		writeVecNB = SOME (function "writeVecNB" (SOME o VS.length))}
-	 end
+         let
+            val name = "nullWr"
+            val closed = ref false
+            fun check f = if !closed
+                             then liftExn name f IO.ClosedStream
+                             else ()
+            fun const f c = fn _ => (check f; c)
+            fun function f g = fn x => (check f; g x)
+         in
+            WR {block = SOME (const "block" ()),
+                canOutput = SOME (const "canOutput" true),
+                chunkSize = 1,
+                close = fn () => (closed := true),
+                endPos = NONE,
+                getPos = NONE,
+                ioDesc = NONE,
+                name = name,
+                setPos = NONE,
+                verifyPos = NONE,
+                writeArr = SOME (function "writeArr" AS.length),
+                writeArrNB = SOME (function "writeArrNB" (SOME o AS.length)),
+                writeVec = SOME (function "writeVec" VS.length),
+                writeVecNB = SOME (function "writeVecNB" (SOME o VS.length))}
+         end
 
-      fun doBlock (f, block) x = (block (); valOf (f x))
+      fun doBlock (f, block: unit -> unit) x = (block (); valOf (f x))
       fun doCanInput (f, canInput) x = if canInput ()
-					  then SOME (f x)
-					  else NONE
+                                          then SOME (f x)
+                                          else NONE
 
       fun augmentReader (RD {name, chunkSize,
-			     readVec, readArr, readVecNB, readArrNB,
-			     block, canInput, avail,
-			     getPos, setPos, endPos, verifyPos,
-			     close, ioDesc}) =
-	 let
-	    fun augmentRead (readVec, readArr) =
-	       case (readVec, readArr) of
-		  (SOME readVec, SOME readArr) => (SOME readVec, SOME readArr)
-		| (NONE, SOME readArr) =>
-		     (SOME (fn i =>
-			    let
-			       val buf = A.array (i, someElem)
-			       fun first j = AS.slice (buf, 0, SOME j)
-			    in
-			       (AS.vector o first) (readArr (first i))
-			    end),
-		      SOME readArr)
-		| (SOME readVec, NONE) =>
-		     (SOME readVec,
-		      SOME (fn sl =>
-			    let
-			       val (buf, i, sz) = AS.base sl
-			       val v = readVec sz
-			       val _ = A.copyVec {src = v, dst = buf, di = i}
-			    in
-			       V.length v
-			    end))
-		| (NONE, NONE) => (NONE, NONE)
-	    fun augmentReadNB (readVecNB, readArrNB) =
-	       case (readVecNB, readArrNB) of
-		  (SOME readVecNB, SOME readArrNB) => (SOME readVecNB, SOME readArrNB)
-		| (NONE, SOME readArrNB) => 
-		     (SOME (fn i =>
-			    let
-			       val buf = A.array (i, someElem)
-			       fun first j = AS.slice (buf, 0, SOME j)
-			    in
-			       Option.map (AS.vector o first) (readArrNB (first i))
-			    end),
-		      SOME readArrNB)
-		| (SOME readVecNB, NONE) =>
-		     (SOME readVecNB,
-		      SOME (fn sl =>
-			    let
-			       val (buf, i, sz) = AS.base sl
-			    in
-			       case readVecNB sz of
-				  NONE => NONE
-				| SOME v => (A.copyVec {src = v, dst = buf, di = i}
-					     ; SOME (V.length v))
-			    end))
-		| (NONE, NONE) => (NONE, NONE)
-	    fun augmentSeq (readSeq, readSeqNB) =
-	       case (readSeq, readSeqNB) of
-		  (SOME readSeq, SOME readSeqNB) => (SOME readSeq, SOME readSeqNB)
-		| (NONE, SOME readSeqNB) =>
-		     (case block of
-			 NONE => NONE
-		       | SOME block => SOME (doBlock (readSeqNB, block)),
-			    SOME readSeqNB)
-		| (SOME readSeq, NONE) =>
-			 (SOME readSeq,
-			  case canInput of
-			     NONE => NONE
-			   | SOME canInput => SOME (doCanInput (readSeq, canInput)))
-		| (NONE, NONE) => (NONE, NONE)
-			 
-	    val ((readVec,readArr),(readVecNB,readArrNB)) =
-	       (augmentRead (readVec, readArr),
-		augmentReadNB (readVecNB, readArrNB))
-	    val ((readVec,readVecNB),(readArr,readArrNB)) =
-	       (augmentSeq (readVec, readVecNB),
-		augmentSeq (readArr, readArrNB))
-	 in
-	    RD {name = name, chunkSize = chunkSize,
-		readVec = readVec, readArr = readArr, 
-		readVecNB = readVecNB, readArrNB = readArrNB,
-		block = block, canInput = canInput, avail = avail,
-		getPos = getPos, setPos = setPos, 
-		endPos = endPos, verifyPos = verifyPos,
-		close = close, ioDesc = ioDesc}
-	 end
+                             readVec, readArr, readVecNB, readArrNB,
+                             block, canInput, avail,
+                             getPos, setPos, endPos, verifyPos,
+                             close, ioDesc}) =
+         let
+            fun augmentRead (readVec, readArr) =
+               case (readVec, readArr) of
+                  (SOME readVec, SOME readArr) => (SOME readVec, SOME readArr)
+                | (NONE, SOME readArr) =>
+                     (SOME (fn i =>
+                            let
+                               val buf = A.array (i, someElem)
+                               fun first j = AS.slice (buf, 0, SOME j)
+                            in
+                               (AS.vector o first) (readArr (first i))
+                            end),
+                      SOME readArr)
+                | (SOME readVec, NONE) =>
+                     (SOME readVec,
+                      SOME (fn sl =>
+                            let
+                               val (buf, i, sz) = AS.base sl
+                               val v = readVec sz
+                               val _ = A.copyVec {src = v, dst = buf, di = i}
+                            in
+                               V.length v
+                            end))
+                | (NONE, NONE) => (NONE, NONE)
+            fun augmentReadNB (readVecNB, readArrNB) =
+               case (readVecNB, readArrNB) of
+                  (SOME readVecNB, SOME readArrNB) => (SOME readVecNB, SOME readArrNB)
+                | (NONE, SOME readArrNB) => 
+                     (SOME (fn i =>
+                            let
+                               val buf = A.array (i, someElem)
+                               fun first j = AS.slice (buf, 0, SOME j)
+                            in
+                               Option.map (AS.vector o first) (readArrNB (first i))
+                            end),
+                      SOME readArrNB)
+                | (SOME readVecNB, NONE) =>
+                     (SOME readVecNB,
+                      SOME (fn sl =>
+                            let
+                               val (buf, i, sz) = AS.base sl
+                            in
+                               case readVecNB sz of
+                                  NONE => NONE
+                                | SOME v => (A.copyVec {src = v, dst = buf, di = i}
+                                             ; SOME (V.length v))
+                            end))
+                | (NONE, NONE) => (NONE, NONE)
+            fun augmentSeq (readSeq, readSeqNB) =
+               case (readSeq, readSeqNB) of
+                  (SOME readSeq, SOME readSeqNB) => (SOME readSeq, SOME readSeqNB)
+                | (NONE, SOME readSeqNB) =>
+                     (case block of
+                         NONE => NONE
+                       | SOME block => SOME (doBlock (readSeqNB, block)),
+                            SOME readSeqNB)
+                | (SOME readSeq, NONE) =>
+                         (SOME readSeq,
+                          case canInput of
+                             NONE => NONE
+                           | SOME canInput => SOME (doCanInput (readSeq, canInput)))
+                | (NONE, NONE) => (NONE, NONE)
+                         
+            val ((readVec,readArr),(readVecNB,readArrNB)) =
+               (augmentRead (readVec, readArr),
+                augmentReadNB (readVecNB, readArrNB))
+            val ((readVec,readVecNB),(readArr,readArrNB)) =
+               (augmentSeq (readVec, readVecNB),
+                augmentSeq (readArr, readArrNB))
+         in
+            RD {name = name, chunkSize = chunkSize,
+                readVec = readVec, readArr = readArr, 
+                readVecNB = readVecNB, readArrNB = readArrNB,
+                block = block, canInput = canInput, avail = avail,
+                getPos = getPos, setPos = setPos, 
+                endPos = endPos, verifyPos = verifyPos,
+                close = close, ioDesc = ioDesc}
+         end
 
       fun augmentWriter (WR {name, chunkSize,
-			     writeVec, writeArr, writeVecNB, writeArrNB,
-			     block, canOutput,
-			     getPos, setPos, endPos, verifyPos,
-			     close, ioDesc}) =
-	 let
-	    fun augmentWrite (writeVec, writeArr) =
-	       case (writeVec, writeArr) of
-		  (SOME writeVec, SOME writeArr) => (SOME writeVec, SOME writeArr)
-		| (NONE, SOME writeArr) =>
-		     (SOME (fn sl => 
-			    writeArr
-			    (AS.full
-			     (A.tabulate (VS.length sl, fn i => VS.sub (sl, i))))),
-		      SOME writeArr)
-		| (SOME writeVec, NONE) =>
-		     (SOME writeVec,
-		      SOME (fn sl => writeVec (VS.full (AS.vector sl))))
-		| (NONE, NONE) => (NONE, NONE)
-	    fun augmentSeq (writeSeq, writeSeqNB) =
-	       case (writeSeq, writeSeqNB) of
-		  (SOME writeSeq, SOME writeSeqNB) => (SOME writeSeq, SOME writeSeqNB)
-		| (NONE, SOME writeSeqNB) =>
-		     (case block of
-			 NONE => NONE
-		       | SOME block => SOME (fn x => (block ();
-						      valOf (writeSeqNB x))),
-			    SOME writeSeqNB)
-		| (SOME writeSeq, NONE) =>
-			 (SOME writeSeq,
-			  case canOutput of
-			     NONE => NONE
-			   | SOME canOutput => SOME (fn x => (if canOutput ()
-								 then SOME (writeSeq x)
-								 else NONE)))
-		| (NONE, NONE) => (NONE, NONE)
-			 
-	    val ((writeVec,writeArr),(writeVecNB,writeArrNB)) =
-	       (augmentWrite (writeVec, writeArr),
-		augmentWrite (writeVecNB, writeArrNB))
-	    val ((writeVec,writeVecNB),(writeArr,writeArrNB)) =
-	       (augmentSeq (writeVec, writeVecNB),
-		augmentSeq (writeArr, writeArrNB))
-	 in
-	    WR {name = name, chunkSize = chunkSize,
-		writeVec = writeVec, writeArr = writeArr, 
-		writeVecNB = writeVecNB, writeArrNB = writeArrNB,
-		block = block, canOutput = canOutput,
-		getPos = getPos, setPos = setPos, 
-		endPos = endPos, verifyPos = verifyPos,
-		close = close, ioDesc = ioDesc}
-	 end
+                             writeVec, writeArr, writeVecNB, writeArrNB,
+                             block, canOutput,
+                             getPos, setPos, endPos, verifyPos,
+                             close, ioDesc}) =
+         let
+            fun augmentWrite (writeVec, writeArr) =
+               case (writeVec, writeArr) of
+                  (SOME writeVec, SOME writeArr) => (SOME writeVec, SOME writeArr)
+                | (NONE, SOME writeArr) =>
+                     (SOME (fn sl => 
+                            writeArr
+                            (AS.full
+                             (A.tabulate (VS.length sl, fn i => VS.sub (sl, i))))),
+                      SOME writeArr)
+                | (SOME writeVec, NONE) =>
+                     (SOME writeVec,
+                      SOME (fn sl => writeVec (VS.full (AS.vector sl))))
+                | (NONE, NONE) => (NONE, NONE)
+            fun augmentSeq (writeSeq, writeSeqNB) =
+               case (writeSeq, writeSeqNB) of
+                  (SOME writeSeq, SOME writeSeqNB) => (SOME writeSeq, SOME writeSeqNB)
+                | (NONE, SOME writeSeqNB) =>
+                     (case block of
+                         NONE => NONE
+                       | SOME block => SOME (fn x => (block ();
+                                                      valOf (writeSeqNB x))),
+                            SOME writeSeqNB)
+                | (SOME writeSeq, NONE) =>
+                         (SOME writeSeq,
+                          case canOutput of
+                             NONE => NONE
+                           | SOME canOutput => SOME (fn x => (if canOutput ()
+                                                                 then SOME (writeSeq x)
+                                                                 else NONE)))
+                | (NONE, NONE) => (NONE, NONE)
+                         
+            val ((writeVec,writeArr),(writeVecNB,writeArrNB)) =
+               (augmentWrite (writeVec, writeArr),
+                augmentWrite (writeVecNB, writeArrNB))
+            val ((writeVec,writeVecNB),(writeArr,writeArrNB)) =
+               (augmentSeq (writeVec, writeVecNB),
+                augmentSeq (writeArr, writeArrNB))
+         in
+            WR {name = name, chunkSize = chunkSize,
+                writeVec = writeVec, writeArr = writeArr, 
+                writeVecNB = writeVecNB, writeArrNB = writeArrNB,
+                block = block, canOutput = canOutput,
+                getPos = getPos, setPos = setPos, 
+                endPos = endPos, verifyPos = verifyPos,
+                close = close, ioDesc = ioDesc}
+         end
    end

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/io/prim-io.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/io/prim-io.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/io/prim-io.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -10,37 +10,37 @@
       val compare: pos * pos -> order
 
       datatype reader =
-	 RD of {avail: unit -> int option,
-		block: (unit -> unit) option,
-		canInput: (unit -> bool) option,
-		chunkSize: int,
-		close: unit -> unit,
-		endPos: (unit -> pos) option,
-		getPos: (unit -> pos) option,
-		ioDesc: OS.IO.iodesc option,
-		name: string,
-		readArr: (array_slice -> int) option,
-		readArrNB: (array_slice -> int option) option,
-		readVec: (int -> vector) option,
-		readVecNB: (int -> vector option) option,
-		setPos: (pos -> unit) option,
-		verifyPos: (unit -> pos) option}
+         RD of {avail: unit -> int option,
+                block: (unit -> unit) option,
+                canInput: (unit -> bool) option,
+                chunkSize: int,
+                close: unit -> unit,
+                endPos: (unit -> pos) option,
+                getPos: (unit -> pos) option,
+                ioDesc: OS.IO.iodesc option,
+                name: string,
+                readArr: (array_slice -> int) option,
+                readArrNB: (array_slice -> int option) option,
+                readVec: (int -> vector) option,
+                readVecNB: (int -> vector option) option,
+                setPos: (pos -> unit) option,
+                verifyPos: (unit -> pos) option}
 
       datatype writer =
-	 WR of {block: (unit -> unit) option,
-		canOutput: (unit -> bool) option,
-		chunkSize: int,
-		close: unit -> unit,
-		endPos: (unit -> pos) option,
-		getPos: (unit -> pos) option,
-		ioDesc: OS.IO.iodesc option,
-		name: string,
-		setPos: (pos -> unit) option,
-		verifyPos: (unit -> pos) option,
-		writeArr: (array_slice -> int) option,
-		writeArrNB: (array_slice -> int option) option,
-		writeVec: (vector_slice -> int) option,
-		writeVecNB: (vector_slice -> int option) option}
+         WR of {block: (unit -> unit) option,
+                canOutput: (unit -> bool) option,
+                chunkSize: int,
+                close: unit -> unit,
+                endPos: (unit -> pos) option,
+                getPos: (unit -> pos) option,
+                ioDesc: OS.IO.iodesc option,
+                name: string,
+                setPos: (pos -> unit) option,
+                verifyPos: (unit -> pos) option,
+                writeArr: (array_slice -> int) option,
+                writeArrNB: (array_slice -> int option) option,
+                writeVec: (vector_slice -> int) option,
+                writeVecNB: (vector_slice -> int option) option}
 
       val openVector: vector -> reader
       val nullRd: unit -> reader

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/io/stream-io.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/io/stream-io.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/io/stream-io.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,10 @@
+(* Copyright (C) 2002-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 signature STREAM_IO_EXTRA_ARG = 
    sig
       structure Array: MONO_ARRAY
@@ -6,24 +13,24 @@
       structure Vector: MONO_VECTOR
       structure VectorSlice: MONO_VECTOR_SLICE
       sharing type PrimIO.elem 
-	 = Vector.elem = VectorSlice.elem
-	 = Array.elem = ArraySlice.elem 
+         = Vector.elem = VectorSlice.elem
+         = Array.elem = ArraySlice.elem 
       sharing type PrimIO.vector 
-	 = Vector.vector = VectorSlice.vector
-	 = Array.vector = ArraySlice.vector 
+         = Vector.vector = VectorSlice.vector
+         = Array.vector = ArraySlice.vector 
       sharing type PrimIO.vector_slice 
-	 = VectorSlice.slice
-	 = ArraySlice.vector_slice
+         = VectorSlice.slice
+         = ArraySlice.vector_slice
       sharing type PrimIO.array 
-	 = Array.array = ArraySlice.array 
+         = Array.array = ArraySlice.array 
       sharing type PrimIO.array_slice 
-	 = ArraySlice.slice
+         = ArraySlice.slice
 
       val line: {isLine: PrimIO.elem -> bool,
-		 lineElem: PrimIO.elem} option
+                 lineElem: PrimIO.elem} option
       val someElem: PrimIO.elem
       val xlatePos : {toInt : PrimIO.pos -> Position.int,
-		      fromInt : Position.int -> PrimIO.pos} option
+                      fromInt : Position.int -> PrimIO.pos} option
    end
 
 functor StreamIOExtra (S: STREAM_IO_EXTRA_ARG): STREAM_IO_EXTRA =
@@ -34,10 +41,10 @@
       structure A = Array
       structure AS = ArraySlice
       structure V = struct
-		      open Vector
-		      val extract : vector * int * int option -> vector
-			 = VectorSlice.vector o VectorSlice.slice
-		    end
+                      open Vector
+                      val extract : vector * int * int option -> vector
+                         = VectorSlice.vector o VectorSlice.slice
+                    end
       structure VS = VectorSlice
 
       type elem = PIO.elem
@@ -48,24 +55,24 @@
       type pos = PIO.pos
 
       fun liftExn name function cause = raise IO.Io {name = name,
-						     function = function,
-						     cause = cause}
+                                                     function = function,
+                                                     cause = cause}
 
       (*---------------*)
       (*   outstream   *)
       (*---------------*)
 
       datatype buf = Buf of {array: A.array,
-			     size: int ref}
+                             size: int ref}
       datatype bufferMode = NO_BUF
                            | LINE_BUF of buf
                            | BLOCK_BUF of buf
       fun newLineBuf bufSize =
-	LINE_BUF (Buf {size = ref 0, 
-		       array = A.array (bufSize, someElem)})
+        LINE_BUF (Buf {size = ref 0, 
+                       array = A.array (bufSize, someElem)})
       fun newBlockBuf bufSize =
-	BLOCK_BUF (Buf {size = ref 0, 
-			array = A.array (bufSize, someElem)})
+        BLOCK_BUF (Buf {size = ref 0, 
+                        array = A.array (bufSize, someElem)})
 
       datatype state = Active | Terminated | Closed
       fun active state = case state of Active => true | _ => false
@@ -73,295 +80,295 @@
       fun closed state = case state of Closed => true | _ => false
 
       datatype outstream = Out of {writer: writer,
-				   augmented_writer: writer,
-				   state: state ref,
-				   bufferMode: bufferMode ref}
+                                   augmented_writer: writer,
+                                   state: state ref,
+                                   bufferMode: bufferMode ref}
 
       fun equalsOut (Out {state = state1, ...}, Out {state = state2, ...}) =
-	 state1 = state2
-	
+         state1 = state2
+        
       fun outstreamSel (Out v, sel) = sel v
       fun outstreamWriter os = outstreamSel (os, #writer)
       fun writerSel (PIO.WR v, sel) = sel v
       fun outstreamName os = writerSel (outstreamWriter os, #name)
 
       local
-	 fun flushGen (write: 'a -> int,
-		       base: 'a -> ('b * int * int),
-		       slice: ('b * int * int option) -> 'a,
-		       a: 'a) =
-	    let
-	       val (b, i, sz) = base a
-	       val max = i + sz
-	       fun loop i =
-		  if i = max
-		     then ()
-		     else let
-			     val j = write (slice (b, i, SOME (max - i)))
-			  in 
-			     if j = 0
-				then raise (Fail "partial write")
-				else loop (i + j)
-			  end
-	    in
-	       loop i
-	    end
+         fun flushGen (write: 'a -> int,
+                       base: 'a -> ('b * int * int),
+                       slice: ('b * int * int option) -> 'a,
+                       a: 'a) =
+            let
+               val (b, i, sz) = base a
+               val max = i + sz
+               fun loop i =
+                  if i = max
+                     then ()
+                     else let
+                             val j = write (slice (b, i, SOME (max - i)))
+                          in 
+                             if j = 0
+                                then raise (Fail "partial write")
+                                else loop (i + j)
+                          end
+            in
+               loop i
+            end
       in
-	 fun flushVec (writer, x) =
-	    case writerSel (writer, #writeVec) of
-	       NONE => raise IO.BlockingNotSupported
-	     | SOME writeVec => flushGen (writeVec, VS.base, VS.slice, x)
-		  
-	 fun flushArr (writer, x) =
-	    case writerSel (writer, #writeArr) of
-	       NONE => raise IO.BlockingNotSupported
-	     | SOME writeArr => flushGen (writeArr, AS.base, AS.slice, x)
+         fun flushVec (writer, x) =
+            case writerSel (writer, #writeVec) of
+               NONE => raise IO.BlockingNotSupported
+             | SOME writeVec => flushGen (writeVec, VS.base, VS.slice, x)
+                  
+         fun flushArr (writer, x) =
+            case writerSel (writer, #writeArr) of
+               NONE => raise IO.BlockingNotSupported
+             | SOME writeArr => flushGen (writeArr, AS.base, AS.slice, x)
       end
 
       fun flushBuf' (writer, size, array) =
-	 let
-	    val size' = !size 
-	 in 
-	    size := 0
-	    ; flushArr (writer, AS.slice (array, 0, SOME size'))
-	 end
+         let
+            val size' = !size 
+         in 
+            size := 0
+            ; flushArr (writer, AS.slice (array, 0, SOME size'))
+         end
 
       fun flushBuf (writer, Buf {size, array}) = flushBuf' (writer, size, array)
 
       fun output (os as Out {augmented_writer,
-			     state, 
-			     bufferMode, ...}, v) =
-	 if terminated (!state)
-	    then liftExn (outstreamName os) "output" IO.ClosedStream
-	    else let
-		    fun put () = flushVec (augmented_writer, VS.full v)
-		    fun doit (buf as Buf {size, array}, maybe) =
-		       let
-			  val curSize = !size
-			  val newSize = curSize + V.length v
-		       in
-			  if newSize >= A.length array orelse maybe ()
-			     then (flushBuf (augmented_writer, buf); put ())
-			     else (A.copyVec {src = v, dst = array, di = curSize};
-				   size := newSize)
-		       end
-		 in
-		    case !bufferMode of
-		       NO_BUF => put ()
-		     | LINE_BUF buf => doit (buf, fn () => (case line of
-							       NONE => false 
-							     | SOME {isLine, ...} => V.exists isLine v))
-		     | BLOCK_BUF buf => doit (buf, fn () => false)
-		 end
-	         handle exn => liftExn (outstreamName os) "output" exn
+                             state, 
+                             bufferMode, ...}, v) =
+         if terminated (!state)
+            then liftExn (outstreamName os) "output" IO.ClosedStream
+            else let
+                    fun put () = flushVec (augmented_writer, VS.full v)
+                    fun doit (buf as Buf {size, array}, maybe) =
+                       let
+                          val curSize = !size
+                          val newSize = curSize + V.length v
+                       in
+                          if newSize >= A.length array orelse maybe ()
+                             then (flushBuf (augmented_writer, buf); put ())
+                             else (A.copyVec {src = v, dst = array, di = curSize};
+                                   size := newSize)
+                       end
+                 in
+                    case !bufferMode of
+                       NO_BUF => put ()
+                     | LINE_BUF buf => doit (buf, fn () => (case line of
+                                                               NONE => false 
+                                                             | SOME {isLine, ...} => V.exists isLine v))
+                     | BLOCK_BUF buf => doit (buf, fn () => false)
+                 end
+                 handle exn => liftExn (outstreamName os) "output" exn
 
       fun ensureActive (os as Out {state, ...}) =
-	 if active (!state)
-	    then ()
-	 else liftExn (outstreamName os) "output" IO.ClosedStream
+         if active (!state)
+            then ()
+         else liftExn (outstreamName os) "output" IO.ClosedStream
 
       local
-	 val buf1 = A.array (1, someElem)
-	 fun flush (os, size, array) =
-	    let
-	       val Out {augmented_writer, ...} = os
-	    in
-	       flushBuf' (augmented_writer, size, array)
-	       handle exn => liftExn (outstreamName os) "output1" exn
-	    end
+         val buf1 = A.array (1, someElem)
+         fun flush (os, size, array) =
+            let
+               val Out {augmented_writer, ...} = os
+            in
+               flushBuf' (augmented_writer, size, array)
+               handle exn => liftExn (outstreamName os) "output1" exn
+            end
       in
-	 (* output1 is implemented very carefully to make it fast.  Think hard
-	  * before modifying it, and test after you do, to make sure that it
-	  * hasn't been slowed down.
-	  *)
-	 fun output1 (os as Out {bufferMode, ...}, c): unit =
-	    case !bufferMode of
-	       BLOCK_BUF (Buf {array, size}) =>
-		  let
-		     val n = !size
-		  in
-		     (* Use the bounds check for the update to make sure there
-		      * is space to put the character in the array.
-		      *)
-		     (A.update (array, n, c)
-		      ; size := 1 + n)
-		     handle Subscript =>
-			let
-			   val _ = ensureActive os
-			   val _ = flush (os, size, array)
-			   val _ = A.update (array, 0, c)
-			   val _ = size := 1
-			in
-			   ()
-			end
-		  end
-	     | LINE_BUF (Buf {array, size}) =>
-		  let
-		     val n = !size
-		     val _ = 
-			(* Use the bounds check for the update to make sure there
-			 * is space to put the character in the array.
-			 *)
-			(A.update (array, n, c)
-			 ; size := 1 + n)
-			handle Subscript =>
-			   let
-			      val _ = ensureActive os
-			      val _ = flush (os, size, array)
-			      val _ = A.update (array, 0, c)
-			      val _ = size := 1
-			   in
-			      ()
-			   end
-		  in
-		     case line of
-			NONE => ()
-		      | SOME {isLine, ...} =>
-			   if isLine c then flush (os, size, array) else ()
-		  end
-	     | NO_BUF =>
-		  let
-		     val _ = ensureActive os
-		     val _ = A.update (buf1, 0, c)
-		     val Out {augmented_writer, ...} = os
-		  in
-		     flushArr (augmented_writer, AS.slice (buf1, 0, SOME 1))
-		  end
+         (* output1 is implemented very carefully to make it fast.  Think hard
+          * before modifying it, and test after you do, to make sure that it
+          * hasn't been slowed down.
+          *)
+         fun output1 (os as Out {bufferMode, ...}, c): unit =
+            case !bufferMode of
+               BLOCK_BUF (Buf {array, size}) =>
+                  let
+                     val n = !size
+                  in
+                     (* Use the bounds check for the update to make sure there
+                      * is space to put the character in the array.
+                      *)
+                     (A.update (array, n, c)
+                      ; size := 1 + n)
+                     handle Subscript =>
+                        let
+                           val _ = ensureActive os
+                           val _ = flush (os, size, array)
+                           val _ = A.update (array, 0, c)
+                           val _ = size := 1
+                        in
+                           ()
+                        end
+                  end
+             | LINE_BUF (Buf {array, size}) =>
+                  let
+                     val n = !size
+                     val _ = 
+                        (* Use the bounds check for the update to make sure there
+                         * is space to put the character in the array.
+                         *)
+                        (A.update (array, n, c)
+                         ; size := 1 + n)
+                        handle Subscript =>
+                           let
+                              val _ = ensureActive os
+                              val _ = flush (os, size, array)
+                              val _ = A.update (array, 0, c)
+                              val _ = size := 1
+                           in
+                              ()
+                           end
+                  in
+                     case line of
+                        NONE => ()
+                      | SOME {isLine, ...} =>
+                           if isLine c then flush (os, size, array) else ()
+                  end
+             | NO_BUF =>
+                  let
+                     val _ = ensureActive os
+                     val _ = A.update (buf1, 0, c)
+                     val Out {augmented_writer, ...} = os
+                  in
+                     flushArr (augmented_writer, AS.slice (buf1, 0, SOME 1))
+                  end
       end
 
       fun outputSlice (os as Out {augmented_writer,
-				  state, 
-				  bufferMode, ...}, v) =
-	 if terminated (!state)
-	    then liftExn (outstreamName os) "output" IO.ClosedStream
-	    else let
-		    fun put () = flushVec (augmented_writer, v)
-		    fun doit (buf as Buf {size, array}, maybe) =
-		       let
-			  val curSize = !size
-			  val newSize = curSize + VS.length v
-		       in
-			  if newSize >= A.length array orelse maybe ()
-			     then (flushBuf (augmented_writer, buf); put ())
-			     else (AS.copyVec {src = v, dst = array, di = curSize};
-				   size := newSize)
-		       end
-		 in
-		    case !bufferMode of
-		       NO_BUF => put ()
-		     | LINE_BUF buf => doit (buf, fn () => (case line of
-							       NONE => false 
-							     | SOME {isLine, ...} => VS.exists isLine v))
-		     | BLOCK_BUF buf => doit (buf, fn () => false)
-		 end
-	         handle exn => liftExn (outstreamName os) "output" exn
+                                  state, 
+                                  bufferMode, ...}, v) =
+         if terminated (!state)
+            then liftExn (outstreamName os) "output" IO.ClosedStream
+            else let
+                    fun put () = flushVec (augmented_writer, v)
+                    fun doit (buf as Buf {size, array}, maybe) =
+                       let
+                          val curSize = !size
+                          val newSize = curSize + VS.length v
+                       in
+                          if newSize >= A.length array orelse maybe ()
+                             then (flushBuf (augmented_writer, buf); put ())
+                             else (AS.copyVec {src = v, dst = array, di = curSize};
+                                   size := newSize)
+                       end
+                 in
+                    case !bufferMode of
+                       NO_BUF => put ()
+                     | LINE_BUF buf => doit (buf, fn () => (case line of
+                                                               NONE => false 
+                                                             | SOME {isLine, ...} => VS.exists isLine v))
+                     | BLOCK_BUF buf => doit (buf, fn () => false)
+                 end
+                 handle exn => liftExn (outstreamName os) "output" exn
 
       fun flushOut (os as Out {augmented_writer, 
-			       state, 
-			       bufferMode, ...}) =
-	if terminated (!state)
-	  then ()
-	  else case !bufferMode of
-	         NO_BUF => ()
-	       | LINE_BUF buf => flushBuf (augmented_writer, buf)
-	       | BLOCK_BUF buf => flushBuf (augmented_writer, buf)
-	handle exn => liftExn (outstreamName os) "flushOut" exn
+                               state, 
+                               bufferMode, ...}) =
+        if terminated (!state)
+          then ()
+          else case !bufferMode of
+                 NO_BUF => ()
+               | LINE_BUF buf => flushBuf (augmented_writer, buf)
+               | BLOCK_BUF buf => flushBuf (augmented_writer, buf)
+        handle exn => liftExn (outstreamName os) "flushOut" exn
 
       fun makeTerminated (Out {bufferMode, ...}) =
-	 let
-	    fun doit (Buf {array, size}) = size := A.length array
-	 in
-	    case !bufferMode of
-	       BLOCK_BUF b => doit b
-	     | LINE_BUF b => doit b
-	     | NO_BUF => ()
-	 end
+         let
+            fun doit (Buf {array, size}) = size := A.length array
+         in
+            case !bufferMode of
+               BLOCK_BUF b => doit b
+             | LINE_BUF b => doit b
+             | NO_BUF => ()
+         end
       
       fun closeOut (os as Out {state, ...}) =
-	if closed (!state)
-	  then ()
-	  else (flushOut os;
-		if terminated (!state)
-		  then ()
-		  else (writerSel (outstreamWriter os, #close)) ();
-		state := Closed
-		; makeTerminated os)
-	handle exn => liftExn (outstreamName os) "closeOut" exn
+        if closed (!state)
+          then ()
+          else (flushOut os;
+                if terminated (!state)
+                  then ()
+                  else (writerSel (outstreamWriter os, #close)) ();
+                state := Closed
+                ; makeTerminated os)
+        handle exn => liftExn (outstreamName os) "closeOut" exn
 
       fun getBufferMode (Out {bufferMode, ...}) =
-	 case !bufferMode of
-	    NO_BUF => IO.NO_BUF
-	  | LINE_BUF _ => IO.LINE_BUF
-	  | BLOCK_BUF _ => IO.BLOCK_BUF
+         case !bufferMode of
+            NO_BUF => IO.NO_BUF
+          | LINE_BUF _ => IO.LINE_BUF
+          | BLOCK_BUF _ => IO.BLOCK_BUF
 
       fun setBufferMode (os as Out {bufferMode, ...}, mode) =
-	case mode of
-	  IO.NO_BUF => (flushOut os;
-			bufferMode := NO_BUF)
-	| IO.LINE_BUF => let
-			   fun doit () = 
-			     bufferMode := 
-			     newLineBuf (writerSel (outstreamWriter os, #chunkSize))
-			 in
-			   case !bufferMode of
-			     NO_BUF => doit ()
-			   | LINE_BUF _ => ()
-			   | BLOCK_BUF _ => doit ()
-			 end
-	| IO.BLOCK_BUF => let
-			    fun doit () = 
-			      bufferMode := 
-			      newBlockBuf (writerSel (outstreamWriter os, #chunkSize))
-			  in
-			    case !bufferMode of
-			      NO_BUF => doit ()
-			    | LINE_BUF _ => doit ()
-			    | BLOCK_BUF _ => ()
-			  end
+        case mode of
+          IO.NO_BUF => (flushOut os;
+                        bufferMode := NO_BUF)
+        | IO.LINE_BUF => let
+                           fun doit () = 
+                             bufferMode := 
+                             newLineBuf (writerSel (outstreamWriter os, #chunkSize))
+                         in
+                           case !bufferMode of
+                             NO_BUF => doit ()
+                           | LINE_BUF _ => ()
+                           | BLOCK_BUF _ => doit ()
+                         end
+        | IO.BLOCK_BUF => let
+                            fun doit () = 
+                              bufferMode := 
+                              newBlockBuf (writerSel (outstreamWriter os, #chunkSize))
+                          in
+                            case !bufferMode of
+                              NO_BUF => doit ()
+                            | LINE_BUF _ => doit ()
+                            | BLOCK_BUF _ => ()
+                          end
 
       fun mkOutstream' {writer, closed, bufferMode} =
-	let
-	  val bufSize = writerSel (writer, #chunkSize)
-	in
-	  Out {writer = writer,
-	       augmented_writer = PIO.augmentWriter writer,
-	       state = ref (if closed then Closed else Active),
-	       bufferMode = ref (case bufferMode of
-				    IO.NO_BUF => NO_BUF
-				  | IO.LINE_BUF => newLineBuf bufSize
-				  | IO.BLOCK_BUF => newBlockBuf bufSize)}
-	end
+        let
+          val bufSize = writerSel (writer, #chunkSize)
+        in
+          Out {writer = writer,
+               augmented_writer = PIO.augmentWriter writer,
+               state = ref (if closed then Closed else Active),
+               bufferMode = ref (case bufferMode of
+                                    IO.NO_BUF => NO_BUF
+                                  | IO.LINE_BUF => newLineBuf bufSize
+                                  | IO.BLOCK_BUF => newBlockBuf bufSize)}
+        end
       fun mkOutstream (writer, bufferMode) =
-	mkOutstream' {writer = writer, closed = false, bufferMode = bufferMode}
+        mkOutstream' {writer = writer, closed = false, bufferMode = bufferMode}
 
       fun getWriter (os as Out {writer, state, bufferMode, ...}) =
-	if closed (!state)
-	  then liftExn (outstreamName os) "getWriter" IO.ClosedStream
-	  else (flushOut os
-		; state := Terminated
-		; makeTerminated os
-		; (writer,
-		   case !bufferMode of
-		      NO_BUF => IO.NO_BUF
-		    | LINE_BUF _ => IO.LINE_BUF
-		    | BLOCK_BUF _ => IO.BLOCK_BUF))
+        if closed (!state)
+          then liftExn (outstreamName os) "getWriter" IO.ClosedStream
+          else (flushOut os
+                ; state := Terminated
+                ; makeTerminated os
+                ; (writer,
+                   case !bufferMode of
+                      NO_BUF => IO.NO_BUF
+                    | LINE_BUF _ => IO.LINE_BUF
+                    | BLOCK_BUF _ => IO.BLOCK_BUF))
 
       datatype out_pos = OutPos of {pos: pos,
-				    outstream: outstream}
+                                    outstream: outstream}
 
       fun getPosOut (os as Out {...}) =
-	(flushOut os;
-	 case writerSel (outstreamSel (os, #writer), #getPos) of
-	   NONE => liftExn (outstreamName os) "getPosOut" IO.RandomAccessNotSupported
-	 | SOME getPos => OutPos {pos = getPos (),
-				  outstream = os})
+        (flushOut os;
+         case writerSel (outstreamSel (os, #writer), #getPos) of
+           NONE => liftExn (outstreamName os) "getPosOut" IO.RandomAccessNotSupported
+         | SOME getPos => OutPos {pos = getPos (),
+                                  outstream = os})
 
       fun setPosOut (OutPos {pos, outstream = os}) =
-	(flushOut os;
-	 case writerSel (outstreamSel (os, #writer), #setPos) of
-	   NONE => liftExn (outstreamName os) "setPosOut" IO.RandomAccessNotSupported
-	 | SOME setPos => setPos pos;
-	 os)
+        (flushOut os;
+         case writerSel (outstreamSel (os, #writer), #setPos) of
+           NONE => liftExn (outstreamName os) "setPosOut" IO.RandomAccessNotSupported
+         | SOME setPos => setPos pos;
+         os)
 
       fun filePosOut (OutPos {pos, ...}) = pos
 
@@ -370,31 +377,31 @@
       (*---------------*)
 
       datatype state = Link of {buf: buf}
-	             | Eos of {buf: buf} (* V.length inp = 0 *)
-	             | End
-	             | Truncated
-	             | Closed
+                     | Eos of {buf: buf} (* V.length inp = 0 *)
+                     | End
+                     | Truncated
+                     | Closed
       and buf = Buf of {inp: V.vector,
-			base: pos option,
-			next: state ref}
+                        base: pos option,
+                        next: state ref}
 
       datatype instream = In of {common: {reader: reader,
-					  augmented_reader: reader,
-					  tail: state ref ref},
-				 pos: int,
-				 buf: buf}
+                                          augmented_reader: reader,
+                                          tail: state ref ref},
+                                 pos: int,
+                                 buf: buf}
       (* @ s = Eos, End, Truncated, Closed ==>
        *   pos = V.length inp, !next = s
        *)
 
       fun equalsIn (In {common = {tail = tail1, ...}, ...}, 
-		    In {common = {tail = tail2, ...}, ...}) = 
-	tail1 = tail2
+                    In {common = {tail = tail2, ...}, ...}) = 
+        tail1 = tail2
 
       fun update (In {common, ...}, pos, buf) =
-	In {common = common,
-	    pos = pos,
-	    buf = buf}
+        In {common = common,
+            pos = pos,
+            buf = buf}
       fun updatePos (is as In {buf, ...}, pos) = update (is, pos, buf)
       fun updateBufBeg (is, buf) = update (is, 0, buf)
       fun updateBufEnd (is, buf as Buf {inp, ...}) = update (is, V.length inp, buf)
@@ -410,390 +417,390 @@
       val empty = V.tabulate (0, fn _ => someElem)
 
       fun extend function
-	         (is as In {common = {augmented_reader, tail, ...}, ...})
-		 blocking =
-	case !(!tail) of
-	  End =>
-	    let
-	      fun link (base, inp) = let
-				       val next = ref End
-				       val buf = Buf {inp = inp,
-						      base = base,
-						      next = next}
-				       val this = if V.length inp = 0
-						    then Eos {buf = buf}
-						    else Link {buf = buf}
-				       val _ = !tail := this
-				       val _ = tail := next
-				     in
-				       SOME this
-				     end
-	      fun doit readVec =
-		let
-		  val base =
-		    case readerSel (augmented_reader, #getPos) of
-		      NONE => NONE
-		    | SOME getPos => SOME (getPos ())
-		  val inp = readVec (readerSel (augmented_reader, #chunkSize))
-		            handle exn =>
-			    liftExn (instreamName is) function exn
-		in
-		  case inp of
-		    NONE => NONE
-		  | SOME inp => link (base, inp)
-		end
-	    in
-	      if blocking 
-		then case readerSel (augmented_reader, #readVec) of
-		       NONE => liftExn (instreamName is) 
-			               function 
-				       IO.BlockingNotSupported
-		     | SOME readVec => doit (SOME o readVec)
-		else case readerSel (augmented_reader, #readVecNB) of
-		       NONE => liftExn (instreamName is) 
-			               function 
-				       IO.NonblockingNotSupported
-		     | SOME readVecNB => doit readVecNB
-	    end
-	| _ => liftExn (instreamName is) function Match
+                 (is as In {common = {augmented_reader, tail, ...}, ...})
+                 blocking =
+        case !(!tail) of
+          End =>
+            let
+              fun link (base, inp) = let
+                                       val next = ref End
+                                       val buf = Buf {inp = inp,
+                                                      base = base,
+                                                      next = next}
+                                       val this = if V.length inp = 0
+                                                    then Eos {buf = buf}
+                                                    else Link {buf = buf}
+                                       val _ = !tail := this
+                                       val _ = tail := next
+                                     in
+                                       SOME this
+                                     end
+              fun doit readVec =
+                let
+                  val base =
+                    case readerSel (augmented_reader, #getPos) of
+                      NONE => NONE
+                    | SOME getPos => SOME (getPos ())
+                  val inp = readVec (readerSel (augmented_reader, #chunkSize))
+                            handle exn =>
+                            liftExn (instreamName is) function exn
+                in
+                  case inp of
+                    NONE => NONE
+                  | SOME inp => link (base, inp)
+                end
+            in
+              if blocking 
+                then case readerSel (augmented_reader, #readVec) of
+                       NONE => liftExn (instreamName is) 
+                                       function 
+                                       IO.BlockingNotSupported
+                     | SOME readVec => doit (SOME o readVec)
+                else case readerSel (augmented_reader, #readVecNB) of
+                       NONE => liftExn (instreamName is) 
+                                       function 
+                                       IO.NonblockingNotSupported
+                     | SOME readVecNB => doit readVecNB
+            end
+        | _ => liftExn (instreamName is) function Match
 
       fun extendB function is = valOf (extend function is true)
       fun extendNB function is = extend function is false
 
       fun input (is as In {pos, buf as Buf {inp, next, ...}, ...}) =
-	if pos < V.length inp
-	  then (V.extract(inp, pos, NONE), 
-		updateBufEnd (is, buf))
-	  else let
-		 fun doit next =
-		   case next of
-		     Link {buf as Buf {inp, ...}} => (inp, updateBufEnd (is, buf))
-		   | Eos {buf} => (empty, updateBufBeg (is, buf))
-		   | End => doit (extendB "input" is)
-		   | _ => (empty, is)
-	       in
-		 doit (!next)
-	       end
+        if pos < V.length inp
+          then (V.extract(inp, pos, NONE), 
+                updateBufEnd (is, buf))
+          else let
+                 fun doit next =
+                   case next of
+                     Link {buf as Buf {inp, ...}} => (inp, updateBufEnd (is, buf))
+                   | Eos {buf} => (empty, updateBufBeg (is, buf))
+                   | End => doit (extendB "input" is)
+                   | _ => (empty, is)
+               in
+                 doit (!next)
+               end
 
       fun inputN (is, n) =
-	if n < 0 orelse n > V.maxLen
-	  then raise Size
-	  else let
-		 fun first (is as In {pos, buf as Buf {inp, ...}, ...}, n) =
-		   if pos + n <= V.length inp
-		     then let
-			    val inp' = V.extract(inp, pos, SOME n)
-			  in
-			    (inp', updatePos (is, pos + n))
-			  end
-		     else let
-			    val inp' = VS.slice(inp, pos, NONE)
-			  in
-			    loop (buf, [inp'], n - (V.length inp - pos))
-			  end
-		 and loop (buf' as Buf {next, ...}, inps, n) =
-		   let
-		     fun doit next =
-		       case next of
-			 Link {buf as Buf {inp, ...}} =>
-			   if n <= V.length inp
-			     then let
-				    val inp' = VS.slice(inp, 0, SOME n)
-				    val inps = inp'::inps
-				  in
-				    finish (inps, update (is, n, buf))
-				  end
-			     else loop (buf, (VS.full inp)::inps, n - V.length inp)
-		       | Eos {buf} => 
-			   finish (inps, if n > 0
-					   then updateBufBeg (is, buf)
-					   else updateBufEnd (is, buf'))
-		       | End => doit (extendB "inputN" is)
-		       | _ => finish (inps, updateBufEnd (is, buf'))
-		   in
-		     doit (!next)
-		   end
-		 and finish (inps, is) =
-		   let val inp = VS.concat (List.rev inps)
-		   in (inp, is)
-		   end
-	       in
-		 first (is, n)
-	       end
+        if n < 0 orelse n > V.maxLen
+          then raise Size
+          else let
+                 fun first (is as In {pos, buf as Buf {inp, ...}, ...}, n) =
+                   if pos + n <= V.length inp
+                     then let
+                            val inp' = V.extract(inp, pos, SOME n)
+                          in
+                            (inp', updatePos (is, pos + n))
+                          end
+                     else let
+                            val inp' = VS.slice(inp, pos, NONE)
+                          in
+                            loop (buf, [inp'], n - (V.length inp - pos))
+                          end
+                 and loop (buf' as Buf {next, ...}, inps, n) =
+                   let
+                     fun doit next =
+                       case next of
+                         Link {buf as Buf {inp, ...}} =>
+                           if n <= V.length inp
+                             then let
+                                    val inp' = VS.slice(inp, 0, SOME n)
+                                    val inps = inp'::inps
+                                  in
+                                    finish (inps, update (is, n, buf))
+                                  end
+                             else loop (buf, (VS.full inp)::inps, n - V.length inp)
+                       | Eos {buf} => 
+                           finish (inps, if n > 0
+                                           then updateBufBeg (is, buf)
+                                           else updateBufEnd (is, buf'))
+                       | End => doit (extendB "inputN" is)
+                       | _ => finish (inps, updateBufEnd (is, buf'))
+                   in
+                     doit (!next)
+                   end
+                 and finish (inps, is) =
+                   let val inp = VS.concat (List.rev inps)
+                   in (inp, is)
+                   end
+               in
+                 first (is, n)
+               end
 
       (* input1' will move past a temporary end of stream *)
       fun input1' (is as In {pos, buf = Buf {inp, next, ...}, ...}) =
-	 case SOME (V.sub (inp, pos)) handle Subscript => NONE of
-	    NONE =>
-	       let
-		  fun doit next =
-		     case next of
-			Link {buf} => input1' (updateBufBeg (is, buf))
-		      | Eos {buf} => (NONE, updateBufBeg (is, buf))
-		      | End => doit (extendB "input1" is)
-		      | _ => (NONE, is)
-	       in
-		  doit (!next)
-	       end
-	  | SOME e =>
-	       let
-		  val is' = updatePos (is, pos + 1)
-	       in
-		  (SOME e, is')
-	       end
-		   
+         case SOME (V.sub (inp, pos)) handle Subscript => NONE of
+            NONE =>
+               let
+                  fun doit next =
+                     case next of
+                        Link {buf} => input1' (updateBufBeg (is, buf))
+                      | Eos {buf} => (NONE, updateBufBeg (is, buf))
+                      | End => doit (extendB "input1" is)
+                      | _ => (NONE, is)
+               in
+                  doit (!next)
+               end
+          | SOME e =>
+               let
+                  val is' = updatePos (is, pos + 1)
+               in
+                  (SOME e, is')
+               end
+                   
       (* input1 will never move past a temporary end of stream *)
       fun input1 is =
-	case input1' is of
-	  (SOME c, is') => SOME (c, is')
-	| _ => NONE
+        case input1' is of
+          (SOME c, is') => SOME (c, is')
+        | _ => NONE
 
       fun inputAll is =
-	let
-	  fun loop (is, ac) =
-	    let val (inp, is') = input is
-	    in
-	      if V.length inp = 0
-		then (V.concat (List.rev ac), is')
-		else loop (is', inp::ac)
-	    end
-	in
-	  loop (is, [])
-	end
+        let
+          fun loop (is, ac) =
+            let val (inp, is') = input is
+            in
+              if V.length inp = 0
+                then (V.concat (List.rev ac), is')
+                else loop (is', inp::ac)
+            end
+        in
+          loop (is, [])
+        end
 
       val inputLine =
-	 case line of
-	    NONE => (fn is => SOME (input is))
-	  | SOME {isLine, lineElem, ...} =>
-	    let
-	       val lineVecSl = VS.full (V.tabulate(1, fn _ => lineElem))
-	    in
-	       fn is =>
-	       let
-		  fun findLine (v, i) =
-		     let
-			fun loop i =
-			   case SOME (V.sub (v, i)) handle Subscript => NONE of
-			      NONE => NONE
-			    | SOME c => 
-				 if isLine c
-				    then SOME (i + 1)
-				 else loop (i + 1)
-		     in
-			loop i
-		     end
-		  fun first (is as In {pos, buf as Buf {inp, next, ...}, ...}) =
-		     (case findLine (inp, pos) of
-			 SOME i => let
-				      val inp' = V.extract(inp, pos, SOME (i - pos))
-				   in
-				      SOME (inp', updatePos (is, i))
-				   end
-		       | NONE => if pos < V.length inp
-				    then let
-					    val inp' = VS.slice(inp, pos, NONE)
-					 in
-					    loop (buf, [inp'])
-					 end
-				    else let
-					    fun doit next = 
-					       case next of
-						  Link {buf} => first (updateBufBeg (is, buf))
-						| Eos _ => NONE
-						| End => doit (extendB "inputLine" is)
-						| _ => NONE
-					 in
-					    doit (!next)
-					 end)
-		  and loop (buf' as Buf {next, ...}, inps) = 
-		     (* List.length inps > 0 *)
-		     let
-			fun doit next =
-			   case next of
-			      Link {buf as Buf {inp, ...}} =>
-				 (case findLine (inp, 0) of
-				     SOME i => let
-						  val inp' = VS.slice(inp, 0, SOME i)
-						  val inps = inp'::inps
-					       in
-						  finish (inps, update (is, i, buf), false)
-					       end
-				   | NONE => loop (buf, (VS.full inp)::inps))
-			    | End => doit (extendB "inputLine" is)
-			    | _ => finish (inps, updateBufEnd (is, buf'), true)
-		     in
-			doit (!next)
-		     end
-		  and finish (inps, is, trail) =
-		     let
-			val inps = if trail
-				      then lineVecSl::inps
-				      else inps
-			val inp = VS.concat (List.rev inps)
-		     in
-			SOME (inp, is)
-		     end
-	       in
-		  first is
-	       end
-	    end
-	       
+         case line of
+            NONE => (fn is => SOME (input is))
+          | SOME {isLine, lineElem, ...} =>
+            let
+               val lineVecSl = VS.full (V.tabulate(1, fn _ => lineElem))
+            in
+               fn is =>
+               let
+                  fun findLine (v, i) =
+                     let
+                        fun loop i =
+                           case SOME (V.sub (v, i)) handle Subscript => NONE of
+                              NONE => NONE
+                            | SOME c => 
+                                 if isLine c
+                                    then SOME (i + 1)
+                                 else loop (i + 1)
+                     in
+                        loop i
+                     end
+                  fun first (is as In {pos, buf as Buf {inp, next, ...}, ...}) =
+                     (case findLine (inp, pos) of
+                         SOME i => let
+                                      val inp' = V.extract(inp, pos, SOME (i - pos))
+                                   in
+                                      SOME (inp', updatePos (is, i))
+                                   end
+                       | NONE => if pos < V.length inp
+                                    then let
+                                            val inp' = VS.slice(inp, pos, NONE)
+                                         in
+                                            loop (buf, [inp'])
+                                         end
+                                    else let
+                                            fun doit next = 
+                                               case next of
+                                                  Link {buf} => first (updateBufBeg (is, buf))
+                                                | Eos _ => NONE
+                                                | End => doit (extendB "inputLine" is)
+                                                | _ => NONE
+                                         in
+                                            doit (!next)
+                                         end)
+                  and loop (buf' as Buf {next, ...}, inps) = 
+                     (* List.length inps > 0 *)
+                     let
+                        fun doit next =
+                           case next of
+                              Link {buf as Buf {inp, ...}} =>
+                                 (case findLine (inp, 0) of
+                                     SOME i => let
+                                                  val inp' = VS.slice(inp, 0, SOME i)
+                                                  val inps = inp'::inps
+                                               in
+                                                  finish (inps, update (is, i, buf), false)
+                                               end
+                                   | NONE => loop (buf, (VS.full inp)::inps))
+                            | End => doit (extendB "inputLine" is)
+                            | _ => finish (inps, updateBufEnd (is, buf'), true)
+                     in
+                        doit (!next)
+                     end
+                  and finish (inps, is, trail) =
+                     let
+                        val inps = if trail
+                                      then lineVecSl::inps
+                                      else inps
+                        val inp = VS.concat (List.rev inps)
+                     in
+                        SOME (inp, is)
+                     end
+               in
+                  first is
+               end
+            end
+               
       fun canInput (is as In {pos, buf = Buf {inp, next, ...}, ...}, n) =
-	if n < 0 orelse n > V.maxLen
-	  then raise Size
-	else if n = 0
-	  then SOME 0
-	else let
-	       fun start inp = 
-		 add ([], inp, 0)
-	       and add (inps, inp, k) =
-		 let
-		   val l = V.length inp
-		   val inps = inp::inps
-		 in
-		   if k + l > n
-		     then finish (inps, n)
-		     else loop (inps, k + l)
-		 end
-	       and loop (inps, k) =
-		 case extendNB "canInput" is of
-		   NONE => finish (inps, k)
-		 | SOME (Link {buf = Buf {inp, ...}}) =>
-		     add (inps, inp, k)
-		 | SOME (Eos _) => finish (inps, k)
-		 | _ => raise Fail "extendNB bug"
-	       and finish (inps, k) =
-		 let
-		   val inp = V.concat (List.rev inps)
-		 in
-		   (inp, k)
-		 end
-	     in
-	       if pos < V.length inp
-		 then SOME (Int.min (V.length inp - pos, n))
-		 else case !next of
-		        End => 
-			  (case extendNB "canInput" is of
-			     NONE => NONE
-			   | SOME (Link {buf = Buf {inp, base, ...}}) =>
-			       let
-				 val (inp, k) = start inp
-				 val buf = Buf {inp = inp,
-						base = base,
-						next = ref End}
-			       in
-				 next := Link {buf = buf};
-				 SOME k
-			       end
-			   | SOME (Eos _) => SOME 0
-			   | _ => raise Fail "extendNB bug")
-		      | _ => SOME 0
-	     end
+        if n < 0 orelse n > V.maxLen
+          then raise Size
+        else if n = 0
+          then SOME 0
+        else let
+               fun start inp = 
+                 add ([], inp, 0)
+               and add (inps, inp, k) =
+                 let
+                   val l = V.length inp
+                   val inps = inp::inps
+                 in
+                   if k + l > n
+                     then finish (inps, n)
+                     else loop (inps, k + l)
+                 end
+               and loop (inps, k) =
+                 case extendNB "canInput" is of
+                   NONE => finish (inps, k)
+                 | SOME (Link {buf = Buf {inp, ...}}) =>
+                     add (inps, inp, k)
+                 | SOME (Eos _) => finish (inps, k)
+                 | _ => raise Fail "extendNB bug"
+               and finish (inps, k) =
+                 let
+                   val inp = V.concat (List.rev inps)
+                 in
+                   (inp, k)
+                 end
+             in
+               if pos < V.length inp
+                 then SOME (Int.min (V.length inp - pos, n))
+                 else case !next of
+                        End => 
+                          (case extendNB "canInput" is of
+                             NONE => NONE
+                           | SOME (Link {buf = Buf {inp, base, ...}}) =>
+                               let
+                                 val (inp, k) = start inp
+                                 val buf = Buf {inp = inp,
+                                                base = base,
+                                                next = ref End}
+                               in
+                                 next := Link {buf = buf};
+                                 SOME k
+                               end
+                           | SOME (Eos _) => SOME 0
+                           | _ => raise Fail "extendNB bug")
+                      | _ => SOME 0
+             end
 
       structure Close =
-	 struct
-	    datatype t = T of {close: unit -> unit,
-			       name: string,
-			       tail: state ref ref}
+         struct
+            datatype t = T of {close: unit -> unit,
+                               name: string,
+                               tail: state ref ref}
 
-	    fun close (T {close, name, tail}) =
-	       case !(!tail) of
-		  End =>
-		     (!tail := Closed
-		      ; close () handle exn => liftExn name "closeIn" exn)
-		| _ => ()
-		     
-	    fun equalsInstream (T {tail, ...}, is) = tail = instreamTail is
+            fun close (T {close, name, tail}) =
+               case !(!tail) of
+                  End =>
+                     (!tail := Closed
+                      ; close () handle exn => liftExn name "closeIn" exn)
+                | _ => ()
+                     
+            fun equalsInstream (T {tail, ...}, is) = tail = instreamTail is
 
-	    fun make (In {common = {reader = PIO.RD {close, name, ...},
-				    tail, ...},
-			  ...}): t =
-	       T {close = close, name = name, tail = tail}
-	 end
+            fun make (In {common = {reader = PIO.RD {close, name, ...},
+                                    tail, ...},
+                          ...}): t =
+               T {close = close, name = name, tail = tail}
+         end
 
       val closeIn = Close.close o Close.make
 
       fun endOfStream is =
-	let val (inp, _) = input is
-	in V.length inp = 0
-	end
+        let val (inp, _) = input is
+        in V.length inp = 0
+        end
 
       fun mkInstream' {bufferContents, closed, reader} =
-	let
-	  val next = ref (if closed then Closed else End)
-	  val base =
-	    case readerSel (reader, #getPos) of
-	      NONE => NONE
-	    | SOME getPos => SOME (getPos ())
-	  val buf = 
-	    case bufferContents of
-	      NONE => Buf {inp = empty,
-			   base = base,
-			   next = next}
-	    | SOME (lastRead, v) => 
-		if V.length v = 0
-		  then Buf {inp = empty,
-			    base = base,
-			    next = ref (Eos {buf = Buf {inp = empty,
-							base = base,
-							next = next}})}
-		  else case (lastRead, base, xlatePos) of
-		         (true, SOME b, SOME {fromInt, toInt, ...}) =>
-			   let
-			     val b =
-			       fromInt (Position.- (toInt b, Position.fromInt (V.length v)))
-			   in
-			     Buf {inp = v,
-				  base = SOME b,
-				  next = next}
-			   end
-		       | _ => Buf {inp = v,
-				   base = NONE,
-				   next = next}
-	in
-	  In {common = {reader = reader,
-			augmented_reader = PIO.augmentReader reader,
-			tail = ref next},
-	      pos = 0,
-	      buf = buf}
-	end
+        let
+          val next = ref (if closed then Closed else End)
+          val base =
+            case readerSel (reader, #getPos) of
+              NONE => NONE
+            | SOME getPos => SOME (getPos ())
+          val buf = 
+            case bufferContents of
+              NONE => Buf {inp = empty,
+                           base = base,
+                           next = next}
+            | SOME (lastRead, v) => 
+                if V.length v = 0
+                  then Buf {inp = empty,
+                            base = base,
+                            next = ref (Eos {buf = Buf {inp = empty,
+                                                        base = base,
+                                                        next = next}})}
+                  else case (lastRead, base, xlatePos) of
+                         (true, SOME b, SOME {fromInt, toInt, ...}) =>
+                           let
+                             val b =
+                               fromInt (Position.- (toInt b, Position.fromInt (V.length v)))
+                           in
+                             Buf {inp = v,
+                                  base = SOME b,
+                                  next = next}
+                           end
+                       | _ => Buf {inp = v,
+                                   base = NONE,
+                                   next = next}
+        in
+          In {common = {reader = reader,
+                        augmented_reader = PIO.augmentReader reader,
+                        tail = ref next},
+              pos = 0,
+              buf = buf}
+        end
      
       fun mkInstream (reader, bufferContents) =
-	mkInstream' {bufferContents = if 0 = V.length bufferContents
-					 then NONE
-					 else SOME (false, bufferContents),
-		     closed = false, 
-		     reader = reader}
-	
+        mkInstream' {bufferContents = if 0 = V.length bufferContents
+                                         then NONE
+                                         else SOME (false, bufferContents),
+                     closed = false, 
+                     reader = reader}
+        
       fun getReader (is as In {common = {reader, tail, ...}, ...}) =
-	case !(!tail) of
-	  End => (!tail := Truncated;
-		  let val (inp, _) = inputAll is
-		  in (reader, inp)
-		  end)
-	| _ => liftExn (instreamName is) "getReader" IO.ClosedStream
+        case !(!tail) of
+          End => (!tail := Truncated;
+                  let val (inp, _) = inputAll is
+                  in (reader, inp)
+                  end)
+        | _ => liftExn (instreamName is) "getReader" IO.ClosedStream
 
       fun filePosIn (is as In {common = {augmented_reader, ...},
-			       pos,
-			       buf = Buf {base, ...}, ...}) =
-	case base of
-	   SOME b => (case xlatePos of
-			 SOME {fromInt, toInt, ...} => 
-			    (fromInt (Position.+ (Position.fromInt pos, toInt b)))
-		       | NONE => (case (readerSel (augmented_reader, #readVec),
-					readerSel (augmented_reader, #getPos),
-					readerSel (augmented_reader, #setPos)) of
-				     (SOME readVec, SOME getPos, SOME setPos) => 
-					let
-					   val curPos = getPos ()
-					in
-					   setPos b
-					   ; ignore (readVec pos)
-					   ; getPos () before setPos curPos
-					end
-				   | _ => 
-					liftExn (instreamName is) "filePosIn" IO.RandomAccessNotSupported))
-	 | NONE => liftExn (instreamName is) "filePosIn" IO.RandomAccessNotSupported
+                               pos,
+                               buf = Buf {base, ...}, ...}) =
+        case base of
+           SOME b => (case xlatePos of
+                         SOME {fromInt, toInt, ...} => 
+                            (fromInt (Position.+ (Position.fromInt pos, toInt b)))
+                       | NONE => (case (readerSel (augmented_reader, #readVec),
+                                        readerSel (augmented_reader, #getPos),
+                                        readerSel (augmented_reader, #setPos)) of
+                                     (SOME readVec, SOME getPos, SOME setPos) => 
+                                        let
+                                           val curPos = getPos ()
+                                        in
+                                           setPos b
+                                           ; ignore (readVec pos)
+                                           ; getPos () before setPos curPos
+                                        end
+                                   | _ => 
+                                        liftExn (instreamName is) "filePosIn" IO.RandomAccessNotSupported))
+         | NONE => liftExn (instreamName is) "filePosIn" IO.RandomAccessNotSupported
    end
 
 signature STREAM_IO_ARG = 
@@ -804,11 +811,11 @@
       structure Vector: MONO_VECTOR
       structure VectorSlice: MONO_VECTOR_SLICE
       sharing type PrimIO.elem = Vector.elem = VectorSlice.elem = Array.elem
-	 = ArraySlice.elem 
+         = ArraySlice.elem 
       sharing type PrimIO.vector = Vector.vector = VectorSlice.vector
-	 = Array.vector = ArraySlice.vector 
+         = Array.vector = ArraySlice.vector 
       sharing type PrimIO.vector_slice = VectorSlice.slice
-	 = ArraySlice.vector_slice
+         = ArraySlice.vector_slice
       sharing type PrimIO.array = Array.array = ArraySlice.array 
       sharing type PrimIO.array_slice = ArraySlice.slice
 
@@ -817,8 +824,8 @@
 
 functor StreamIO (S: STREAM_IO_ARG): STREAM_IO =
    StreamIOExtra (open S
-		  val line = NONE
-		  val xlatePos = NONE)
+                  val line = NONE
+                  val xlatePos = NONE)
 
 signature STREAM_IO_EXTRA_FILE_ARG = STREAM_IO_EXTRA_ARG
 
@@ -833,8 +840,8 @@
       open StreamIO
 
       fun liftExn name function cause = raise IO.Io {name = name,
-						     function = function,
-						     cause = cause}
+                                                     function = function,
+                                                     cause = cause}
 
       (*---------------*)
       (*   outstream   *)
@@ -844,110 +851,110 @@
       fun outstreamName os = writerSel (outstreamWriter os, #name)
 
       fun outFd os =
-	case writerSel (outstreamWriter os, #ioDesc) of
-	  SOME ioDesc => valOf (Posix.FileSys.iodToFD ioDesc)
-	| NONE => liftExn (outstreamName os) "outFd" (Fail "<no ioDesc>")
+        case writerSel (outstreamWriter os, #ioDesc) of
+          SOME ioDesc => valOf (Posix.FileSys.iodToFD ioDesc)
+        | NONE => liftExn (outstreamName os) "outFd" (Fail "<no ioDesc>")
 
       val openOutstreams : (outstream * {close: bool}) list ref = ref []
 
       val mkOutstream'' =
-	 let	
-	    val _ = Cleaner.addNew
-	       (Cleaner.atExit, fn () =>
-		List.app (fn (os, {close}) =>
-			  if close
-			     then closeOut os
-			  else flushOut os) (!openOutstreams))
-	 in
-	    fn {bufferMode, closeAtExit, closed, writer} =>
-	    let
-	       val os = mkOutstream' {bufferMode = bufferMode,
-				      closed = closed,
-				      writer = writer}
-	       val _ =
-		  if closed
-		     then ()
-		  else openOutstreams := ((os, {close = closeAtExit})
-					  :: (!openOutstreams))
-	    in
-	       os
-	    end
-	 end
+         let    
+            val _ = Cleaner.addNew
+               (Cleaner.atExit, fn () =>
+                List.app (fn (os, {close}) =>
+                          if close
+                             then closeOut os
+                          else flushOut os) (!openOutstreams))
+         in
+            fn {bufferMode, closeAtExit, closed, writer} =>
+            let
+               val os = mkOutstream' {bufferMode = bufferMode,
+                                      closed = closed,
+                                      writer = writer}
+               val _ =
+                  if closed
+                     then ()
+                  else openOutstreams := ((os, {close = closeAtExit})
+                                          :: (!openOutstreams))
+            in
+               os
+            end
+         end
      
       fun mkOutstream' {bufferMode, closed, writer} =
-	 mkOutstream'' {bufferMode = bufferMode,
-			closeAtExit = true,
-			closed = closed, 
-			writer = writer}
-	
+         mkOutstream'' {bufferMode = bufferMode,
+                        closeAtExit = true,
+                        closed = closed, 
+                        writer = writer}
+        
       fun mkOutstream (writer, bufferMode) =
-	mkOutstream' {bufferMode = bufferMode,
-		      closed = false,
-		      writer = writer}
-	
+        mkOutstream' {bufferMode = bufferMode,
+                      closed = false,
+                      writer = writer}
+        
       val closeOut = fn os =>
-	let
-	  val _ = openOutstreams := List.filter (fn (os', _) => 
-						 not (equalsOut (os, os'))) 
+        let
+          val _ = openOutstreams := List.filter (fn (os', _) => 
+                                                 not (equalsOut (os, os'))) 
                                                 (!openOutstreams)
-	in
-	  closeOut os
-	end
+        in
+          closeOut os
+        end
 
       (*---------------*)
       (*   instream    *)
       (*---------------*)
 
       fun readerSel (PIO.RD v, sel) = sel v
-	 
+         
       fun instreamName is = readerSel (instreamReader is, #name)
 
       fun inFd is =
-	case readerSel (instreamReader is, #ioDesc) of
-	  SOME ioDesc => valOf (Posix.FileSys.iodToFD ioDesc)
-	| NONE => liftExn (instreamName is) "inFd" (Fail "<no ioDesc>")
+        case readerSel (instreamReader is, #ioDesc) of
+          SOME ioDesc => valOf (Posix.FileSys.iodToFD ioDesc)
+        | NONE => liftExn (instreamName is) "inFd" (Fail "<no ioDesc>")
 
       val closeAtExits: Close.t list ref = ref []
-	 
+         
       val mkInstream'' =
-	let
-	   val _ = Cleaner.addNew (Cleaner.atExit, fn () =>
-				   List.app Close.close (!closeAtExits))
-	in
-	  fn {bufferContents, closeAtExit, closed, reader} =>
-	  let
-	    val is =
-	       mkInstream' {bufferContents = bufferContents,
-			    closed = closed,
-			    reader = reader}
-	    val _ =
-	       if closed orelse not closeAtExit
-		  then ()
-	       else closeAtExits := Close.make is :: (!closeAtExits)
-	  in
-	    is
-	  end
-	end
+        let
+           val _ = Cleaner.addNew (Cleaner.atExit, fn () =>
+                                   List.app Close.close (!closeAtExits))
+        in
+          fn {bufferContents, closeAtExit, closed, reader} =>
+          let
+            val is =
+               mkInstream' {bufferContents = bufferContents,
+                            closed = closed,
+                            reader = reader}
+            val _ =
+               if closed orelse not closeAtExit
+                  then ()
+               else closeAtExits := Close.make is :: (!closeAtExits)
+          in
+            is
+          end
+        end
      
       fun mkInstream' {bufferContents, closed, reader} =
-	mkInstream'' {bufferContents = bufferContents,
-		      closeAtExit = true,
-		      closed = closed, 
-		      reader = reader}
-		      
-	
+        mkInstream'' {bufferContents = bufferContents,
+                      closeAtExit = true,
+                      closed = closed, 
+                      reader = reader}
+                      
+        
       fun mkInstream (reader, bufferContents) =
-	mkInstream' {bufferContents = (if V.length bufferContents = 0 then NONE
-				       else SOME (false, bufferContents)),
-		     closed = false,
-		     reader = reader}
-	
+        mkInstream' {bufferContents = (if V.length bufferContents = 0 then NONE
+                                       else SOME (false, bufferContents)),
+                     closed = false,
+                     reader = reader}
+        
       val closeIn = fn is =>
-	 let
-	    val _ =
-	       closeAtExits :=
-	       List.filter (fn c => Close.equalsInstream (c, is)) (!closeAtExits)
-	 in
-	    closeIn is
-	 end
+         let
+            val _ =
+               closeAtExits :=
+               List.filter (fn c => Close.equalsInstream (c, is)) (!closeAtExits)
+         in
+            closeIn is
+         end
    end

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/io/stream-io.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/io/stream-io.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/io/stream-io.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -38,13 +38,13 @@
       type vector_slice
 
       structure Close:
-	 sig
-	    type t
+         sig
+            type t
 
-	    val close: t -> unit
-	    val equalsInstream: t * instream -> bool
-	    val make: instream -> t
-	 end
+            val close: t -> unit
+            val equalsInstream: t * instream -> bool
+            val make: instream -> t
+         end
 
       val equalsIn: instream * instream -> bool
       val equalsOut: outstream * outstream -> bool
@@ -52,11 +52,11 @@
       val inputLine: instream -> (vector * instream) option
       val instreamReader: instream -> reader
       val mkInstream': {bufferContents: (bool * vector) option,
-			closed: bool,
-			reader: reader} -> instream
+                        closed: bool,
+                        reader: reader} -> instream
       val mkOutstream': {bufferMode: IO.buffer_mode,
-			 closed: bool,
-			 writer: writer} -> outstream
+                         closed: bool,
+                         writer: writer} -> outstream
       val outputSlice: outstream * vector_slice -> unit
       val outstreamWriter: outstream -> writer
    end
@@ -67,12 +67,12 @@
 
       val inFd: instream -> Posix.IO.file_desc
       val mkInstream'': {bufferContents: (bool * vector) option,
-			 closeAtExit: bool,
-			 closed: bool,
-			 reader: reader} -> instream
+                         closeAtExit: bool,
+                         closed: bool,
+                         reader: reader} -> instream
       val outFd: outstream -> Posix.IO.file_desc
       val mkOutstream'': {bufferMode: IO.buffer_mode,
-			  closeAtExit: bool,
-			  closed: bool,
-			  writer: writer} -> outstream
+                          closeAtExit: bool,
+                          closed: bool,
+                          writer: writer} -> outstream
   end

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/io/text-io.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/io/text-io.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/io/text-io.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -6,13 +6,13 @@
 signature TEXT_IO =
    sig
       include TEXT_IO_GLOBAL
-	 
+         
       structure StreamIO: TEXT_STREAM_IO
-(*	 where type elem = Char.char *)  (* redundant *)
-	 where type pos = TextPrimIO.pos
-	 where type reader = TextPrimIO.reader
-(*	 where type vector = CharVector.vector *) (* redundant *)
-	 where type writer = TextPrimIO.writer
+(*       where type elem = Char.char *)  (* redundant *)
+         where type pos = TextPrimIO.pos
+         where type reader = TextPrimIO.reader
+(*       where type vector = CharVector.vector *) (* redundant *)
+         where type writer = TextPrimIO.writer
 
       type elem = StreamIO.elem
       type instream
@@ -43,9 +43,9 @@
       val output: outstream * vector -> unit 
       val outputSubstr: outstream * substring -> unit
       val scanStream:
- 	 ((Char.char, StreamIO.instream) StringCvt.reader
-	  -> ('a, StreamIO.instream) StringCvt.reader)
-	 -> instream -> 'a option
+         ((Char.char, StreamIO.instream) StringCvt.reader
+          -> ('a, StreamIO.instream) StringCvt.reader)
+         -> instream -> 'a option
       val setInstream: (instream * StreamIO.instream) -> unit
       val setOutstream: outstream * StreamIO.outstream -> unit
       val setPosOut: outstream * StreamIO.out_pos -> unit

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/io/text-io.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/io/text-io.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/io/text-io.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,29 +1,37 @@
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 structure TextIO: TEXT_IO_EXTRA =
    struct
       structure IO =
-	 ImperativeIOExtra
-	 (structure Array = CharArray
-	  structure ArraySlice = CharArraySlice
-	  structure PrimIO = TextPrimIO
-	  structure Vector = CharVector
-	  structure VectorSlice = CharVectorSlice
-	  val chunkSize = Primitive.TextIO.bufSize
-	  val fileTypeFlags = [PosixPrimitive.FileSys.O.text]
-	  val line = SOME {isLine = fn c => c = #"\n",
-			   lineElem = #"\n"}
-	  val mkReader = Posix.IO.mkTextReader
-	  val mkWriter = Posix.IO.mkTextWriter
-	  val someElem = (#"\000": Char.char)
-	  val xlatePos = SOME {fromInt = fn i => i,
-			       toInt = fn i => i})
+         ImperativeIOExtra
+         (structure Array = CharArray
+          structure ArraySlice = CharArraySlice
+          structure PrimIO = TextPrimIO
+          structure Vector = CharVector
+          structure VectorSlice = CharVectorSlice
+          val chunkSize = Primitive.TextIO.bufSize
+          val fileTypeFlags = [PosixPrimitive.FileSys.O.text]
+          val line = SOME {isLine = fn c => c = #"\n",
+                           lineElem = #"\n"}
+          val mkReader = Posix.IO.mkTextReader
+          val mkWriter = Posix.IO.mkTextWriter
+          val someElem = (#"\000": Char.char)
+          val xlatePos = SOME {fromInt = fn i => i,
+                               toInt = fn i => i})
       open IO
 
       structure StreamIO =
-	 struct
-	    open StreamIO
+         struct
+            open StreamIO
 
-	    fun outputSubstr (s, ss) = outputSlice (s, ss)
-	 end
+            fun outputSubstr (s, ss) = outputSlice (s, ss)
+         end
 
       val outputSubstr = outputSlice
 

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/io/text-prim-io.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/io/text-prim-io.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/io/text-prim-io.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,12 +1,19 @@
+(* Copyright (C) 2002-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 structure TextPrimIO : PRIM_IO
                        where type array = CharArray.array
-		       where type vector = CharVector.vector
-		       where type elem = Char.char =
+                       where type vector = CharVector.vector
+                       where type elem = Char.char =
   PrimIO (structure Vector = CharVector
-	  structure VectorSlice = CharVectorSlice
-	  structure Array = CharArray
-	  structure ArraySlice = CharArraySlice
-	  type pos = Position.int
-	  val compare = Position.compare
-	  val someElem = #"\000": Char.char)
+          structure VectorSlice = CharVectorSlice
+          structure Array = CharArray
+          structure ArraySlice = CharArraySlice
+          type pos = Position.int
+          val compare = Position.compare
+          val someElem = #"\000": Char.char)
 

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/io/text-stream-io.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/io/text-stream-io.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/io/text-stream-io.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,8 +1,8 @@
 signature TEXT_STREAM_IO =
    sig
       include STREAM_IO
-	 where type elem = Char.char
-	 where type vector = CharVector.vector 
+         where type elem = Char.char
+         where type vector = CharVector.vector 
 
       val inputLine: instream -> (string * instream) option
       val outputSubstr: outstream * substring -> unit

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/libs/all.mlb
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/libs/all.mlb	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/libs/all.mlb	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,12 +1,18 @@
+(* Copyright (C) 2004-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 local
-  ../basis.mlb
-  ../pervasive.mlb
-  ../basis-2002.mlb
-  ../basis-1997.mlb
-  ../basis-none.mlb
-  ../mlton.mlb
-  ../sml-nj.mlb
-  ../unsafe.mlb
+   ../basis.mlb
+   ../pervasive.mlb
+   ../basis-2002.mlb
+   ../basis-1997.mlb
+   ../basis-none.mlb
+   ../mlton.mlb
+   ../sml-nj.mlb
+   ../unsafe.mlb
 in
-
-end
\ No newline at end of file
+end

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/arrays-and-vectors/array.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/arrays-and-vectors/array.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/arrays-and-vectors/array.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -7,9 +7,9 @@
       val appi: (int * 'a -> unit) -> 'a array * int * int option -> unit 
       val array: int * 'a -> 'a array 
       val copy: {src: 'a array, si: int, len: int option, 
-		 dst: 'a array, di: int} -> unit 
+                 dst: 'a array, di: int} -> unit 
       val copyVec: {src: 'a vector, si: int, len: int option, 
-		    dst: 'a array, di: int} -> unit 
+                    dst: 'a array, di: int} -> unit 
       val extract: 'a array * int * int option -> 'a vector 
       val foldl: ('a * 'b -> 'b) -> 'b -> 'a array -> 'b 
       val foldli: (int * 'a * 'b -> 'b) -> 'b -> 'a array * int * int option -> 'b

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/arrays-and-vectors/mono-array.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/arrays-and-vectors/mono-array.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/arrays-and-vectors/mono-array.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -12,9 +12,9 @@
       val update: (array * int * elem) -> unit
       val extract: (array * int * int option) -> Vector.vector
       val copy: {src: array, si: int, len: int option,
-		 dst: array, di: int} -> unit
+                 dst: array, di: int} -> unit
       val copyVec: {src: Vector.vector, si: int, len: int option, 
-		    dst: array, di: int} -> unit
+                    dst: array, di: int} -> unit
       val appi: ((int * elem) -> unit) -> (array * int * int option) -> unit
       val app: (elem -> unit) -> array -> unit
       val foldli: ((int * elem * 'b) -> 'b) -> 'b -> (array * int * int option) -> 'b

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/arrays-and-vectors/mono-array2.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/arrays-and-vectors/mono-array2.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/arrays-and-vectors/mono-array2.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -3,8 +3,8 @@
       eqtype array
       type elem
       type region = {base: array, 
-		     row: int, col: int, 
-		     nrows: int option, ncols: int option}
+                     row: int, col: int, 
+                     nrows: int option, ncols: int option}
       datatype traversal = datatype Array2.traversal
       structure Vector: MONO_VECTOR_1997
       val array: (int * int * elem) -> array

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/arrays-and-vectors/mono-vector-array-array2-convert.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/arrays-and-vectors/mono-vector-array-array2-convert.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/arrays-and-vectors/mono-vector-array-array2-convert.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,58 +1,65 @@
+(* Copyright (C) 2002-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
 
+
 functor MonoVectorArrayArray2Convert
         (structure Vector: MONO_VECTOR
-	 structure VectorSlice: MONO_VECTOR_SLICE
-	 structure Array: MONO_ARRAY
-	 structure ArraySlice: MONO_ARRAY_SLICE
-	 structure Array2: MONO_ARRAY2
-	 sharing type Vector.elem = VectorSlice.elem =
-	              Array.elem = ArraySlice.elem =
+         structure VectorSlice: MONO_VECTOR_SLICE
+         structure Array: MONO_ARRAY
+         structure ArraySlice: MONO_ARRAY_SLICE
+         structure Array2: MONO_ARRAY2
+         sharing type Vector.elem = VectorSlice.elem =
+                      Array.elem = ArraySlice.elem =
                       Array2.elem
-	 sharing type Vector.vector = VectorSlice.vector =
+         sharing type Vector.vector = VectorSlice.vector =
                       Array.vector = ArraySlice.vector = 
                       Array2.vector
-	 sharing type VectorSlice.slice = ArraySlice.vector_slice
-	 sharing type Array.array = ArraySlice.array) :
+         sharing type VectorSlice.slice = ArraySlice.vector_slice
+         sharing type Array.array = ArraySlice.array) :
         sig
-	   structure Vector: MONO_VECTOR_1997
-	   structure Array: MONO_ARRAY_1997
-	   structure Array2: MONO_ARRAY2_1997
-	   sharing type Vector.elem = Array.elem = Array2.elem
-	   sharing type Vector.vector = Array.Vector.vector = Array2.Vector.vector
-	end =
+           structure Vector: MONO_VECTOR_1997
+           structure Array: MONO_ARRAY_1997
+           structure Array2: MONO_ARRAY2_1997
+           sharing type Vector.elem = Array.elem = Array2.elem
+           sharing type Vector.vector = Array.Vector.vector = Array2.Vector.vector
+        end =
   struct
      fun shift1 f (_, s, _) = fn (i:int, x) => f (i + s, x)
      fun shift2 f (_, s, _) = fn (i:int, x, y) => f (i + s, x, y)
       
      structure V =
        struct
-	  open Vector
-	  fun extract sl = VectorSlice.vector (VectorSlice.slice sl)
-	  fun mapi f sl = VectorSlice.mapi (shift1 f sl) (VectorSlice.slice sl)
-	  fun appi f sl = VectorSlice.appi (shift1 f sl) (VectorSlice.slice sl)
-	  fun foldli f b sl = VectorSlice.foldli (shift2 f sl) b (VectorSlice.slice sl)
-	  fun foldri f b sl = VectorSlice.foldri (shift2 f sl) b (VectorSlice.slice sl)
+          open Vector
+          fun extract sl = VectorSlice.vector (VectorSlice.slice sl)
+          fun mapi f sl = VectorSlice.mapi (shift1 f sl) (VectorSlice.slice sl)
+          fun appi f sl = VectorSlice.appi (shift1 f sl) (VectorSlice.slice sl)
+          fun foldli f b sl = VectorSlice.foldli (shift2 f sl) b (VectorSlice.slice sl)
+          fun foldri f b sl = VectorSlice.foldri (shift2 f sl) b (VectorSlice.slice sl)
        end
      structure A = 
        struct
-	  open Array
-	  structure Vector = V
-	  fun appi f sl = ArraySlice.appi (shift1 f sl) (ArraySlice.slice sl)
-	  fun copy {src, si, len, dst, di} =
-	    ArraySlice.copy {src = ArraySlice.slice (src, si, len),
-			     dst = dst, di = di}
-	  fun copyVec {src, si, len, dst, di} =
-	    ArraySlice.copyVec {src = VectorSlice.slice (src, si, len),
-				dst = dst, di = di}
-	  fun extract sl = ArraySlice.vector (ArraySlice.slice sl)
-	  fun foldli f b sl = ArraySlice.foldli (shift2 f sl) b (ArraySlice.slice sl)
-	  fun foldri f b sl = ArraySlice.foldri (shift2 f sl) b (ArraySlice.slice sl)
-	  fun modifyi f sl = ArraySlice.modifyi (shift1 f sl) (ArraySlice.slice sl)
+          open Array
+          structure Vector = V
+          fun appi f sl = ArraySlice.appi (shift1 f sl) (ArraySlice.slice sl)
+          fun copy {src, si, len, dst, di} =
+            ArraySlice.copy {src = ArraySlice.slice (src, si, len),
+                             dst = dst, di = di}
+          fun copyVec {src, si, len, dst, di} =
+            ArraySlice.copyVec {src = VectorSlice.slice (src, si, len),
+                                dst = dst, di = di}
+          fun extract sl = ArraySlice.vector (ArraySlice.slice sl)
+          fun foldli f b sl = ArraySlice.foldli (shift2 f sl) b (ArraySlice.slice sl)
+          fun foldri f b sl = ArraySlice.foldri (shift2 f sl) b (ArraySlice.slice sl)
+          fun modifyi f sl = ArraySlice.modifyi (shift1 f sl) (ArraySlice.slice sl)
        end
      structure A2 =
        struct
-	  open Array2
-	  structure Vector = V
+          open Array2
+          structure Vector = V
        end
      structure Array = A
      structure Vector = V

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/arrays-and-vectors/vector-array-convert.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/arrays-and-vectors/vector-array-convert.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/arrays-and-vectors/vector-array-convert.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,42 +1,49 @@
+(* Copyright (C) 2002-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
 
+
 functor VectorArrayConvert
         (structure Vector: VECTOR 
-	 structure VectorSlice: VECTOR_SLICE 
+         structure VectorSlice: VECTOR_SLICE 
                                 where type 'a slice = 'a VectorSlice.slice
-	 structure Array: ARRAY 
-	 structure ArraySlice: ARRAY_SLICE
+         structure Array: ARRAY 
+         structure ArraySlice: ARRAY_SLICE
                                where type 'a slice = 'a ArraySlice.slice) :
-	sig
-	   structure Vector: VECTOR_1997
-	   structure Array: ARRAY_1997
-	end =
+        sig
+           structure Vector: VECTOR_1997
+           structure Array: ARRAY_1997
+        end =
   struct
      fun shift1 f (_, s, _) = fn (i:int, x) => f (i + s, x)
      fun shift2 f (_, s, _) = fn (i:int, x, y) => f (i + s, x, y)
       
      structure V =
        struct
-	  open Vector
-	  fun extract sl = VectorSlice.vector (VectorSlice.slice sl)
-	  fun mapi f sl = VectorSlice.mapi (shift1 f sl) (VectorSlice.slice sl)
-	  fun appi f sl = VectorSlice.appi (shift1 f sl) (VectorSlice.slice sl)
-	  fun foldli f b sl = VectorSlice.foldli (shift2 f sl) b (VectorSlice.slice sl)
-	  fun foldri f b sl = VectorSlice.foldri (shift2 f sl) b (VectorSlice.slice sl)
+          open Vector
+          fun extract sl = VectorSlice.vector (VectorSlice.slice sl)
+          fun mapi f sl = VectorSlice.mapi (shift1 f sl) (VectorSlice.slice sl)
+          fun appi f sl = VectorSlice.appi (shift1 f sl) (VectorSlice.slice sl)
+          fun foldli f b sl = VectorSlice.foldli (shift2 f sl) b (VectorSlice.slice sl)
+          fun foldri f b sl = VectorSlice.foldri (shift2 f sl) b (VectorSlice.slice sl)
        end
      structure A = 
        struct
-	  open Array
-	  fun appi f sl = ArraySlice.appi (shift1 f sl) (ArraySlice.slice sl)
-	  fun copy {src, si, len, dst, di} =
-	    ArraySlice.copy {src = ArraySlice.slice (src, si, len),
-			     dst = dst, di = di}
-	  fun copyVec {src, si, len, dst, di} =
-	    ArraySlice.copyVec {src = VectorSlice.slice (src, si, len),
-				dst = dst, di = di}
-	  fun extract sl = ArraySlice.vector (ArraySlice.slice sl)
-	  fun foldli f b sl = ArraySlice.foldli (shift2 f sl) b (ArraySlice.slice sl)
-	  fun foldri f b sl = ArraySlice.foldri (shift2 f sl) b (ArraySlice.slice sl)
-	  fun modifyi f sl = ArraySlice.modifyi (shift1 f sl) (ArraySlice.slice sl)
+          open Array
+          fun appi f sl = ArraySlice.appi (shift1 f sl) (ArraySlice.slice sl)
+          fun copy {src, si, len, dst, di} =
+            ArraySlice.copy {src = ArraySlice.slice (src, si, len),
+                             dst = dst, di = di}
+          fun copyVec {src, si, len, dst, di} =
+            ArraySlice.copyVec {src = VectorSlice.slice (src, si, len),
+                                dst = dst, di = di}
+          fun extract sl = ArraySlice.vector (ArraySlice.slice sl)
+          fun foldli f b sl = ArraySlice.foldli (shift2 f sl) b (ArraySlice.slice sl)
+          fun foldri f b sl = ArraySlice.foldri (shift2 f sl) b (ArraySlice.slice sl)
+          fun modifyi f sl = ArraySlice.modifyi (shift1 f sl) (ArraySlice.slice sl)
        end
      structure Vector = V
      structure Array = A

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/basis-1997.mlb
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/basis-1997.mlb	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/basis-1997.mlb	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,19 +1,25 @@
+(* Copyright (C) 2004-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 ann  
    "deadCode true"
-   "sequenceUnit true"
-   "warnMatch true"
+   "sequenceNonUnit warn"
+   "nonexhaustiveMatch warn" "redundantMatch warn"
    "warnUnused true" "forceUsed"
 in
    local
       ../basis-2002/basis-2002.mlb
       ../../basis-2002.mlb
       local
-        ../basis-extra/basis-extra.mlb
+         ../basis-extra/basis-extra.mlb
       in
-        signature SML90
-        structure SML90
+         signature SML90
+         structure SML90
       end
-
       arrays-and-vectors/vector.sig
       arrays-and-vectors/array.sig
       arrays-and-vectors/vector-array-convert.fun
@@ -62,7 +68,6 @@
       io/bin-stream-io.sig
       io/bin-io.sig
       io/bin-io-convert.fun
-
       top-level/basis.sig
       top-level/basis.sml
    in
@@ -92,5 +97,5 @@
       signature UNIX_1997
 
       structure Basis1997
-  end
+   end
 end

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/integer/word.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/integer/word.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/integer/word.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -35,5 +35,5 @@
       val fromString: string -> word option
       val scan: StringCvt.radix -> 
                 (char, 'a) StringCvt.reader -> 
-		(word, 'a) StringCvt.reader
+                (word, 'a) StringCvt.reader
    end

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/io/bin-io-convert.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/io/bin-io-convert.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/io/bin-io-convert.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,10 @@
+(* Copyright (C) 2002-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 functor BinIOConvert
         (structure BinIO: BIN_IO) :
         BIN_IO_1997 =
@@ -6,7 +13,7 @@
 
      structure StreamIO =
         struct
-	   open StreamIO
-	   val inputAll = #1 o inputAll
-	end
+           open StreamIO
+           val inputAll = #1 o inputAll
+        end
   end

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/io/bin-io.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/io/bin-io.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/io/bin-io.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -19,9 +19,9 @@
       val openIn: string -> instream 
 (*
       val scanStream:
- 	 ((Char.char, StreamIO.instream) StringCvt.reader
-	  -> ('a, StreamIO.instream) StringCvt.reader)
-	 -> instream -> 'a option 
+         ((Char.char, StreamIO.instream) StringCvt.reader
+          -> ('a, StreamIO.instream) StringCvt.reader)
+         -> instream -> 'a option 
 *)
       val setInstream: (instream * StreamIO.instream) -> unit
 (*

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/io/bin-stream-io.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/io/bin-stream-io.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/io/bin-stream-io.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,6 +1,6 @@
 signature BIN_STREAM_IO_1997 =
    sig
       include STREAM_IO_1997
-	 where type vector = Word8Vector.vector 
-	 where type elem = Word8Vector.elem
+         where type vector = Word8Vector.vector 
+         where type elem = Word8Vector.elem
    end

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/io/io-convert.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/io/io-convert.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/io/io-convert.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,10 @@
+(* Copyright (C) 2002-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 functor IOConvert
         (structure IO: IO) :
         IO_1997 =

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/io/io.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/io/io.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/io/io.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,8 +1,8 @@
 signature IO_1997 =
    sig
       exception Io of {cause: exn,
-		       function: string,
-		       name: string}
+                       function: string,
+                       name: string}
       exception BlockingNotSupported
       exception NonblockingNotSupported
       exception RandomAccessNotSupported

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/io/text-io-convert.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/io/text-io-convert.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/io/text-io-convert.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,10 @@
+(* Copyright (C) 2002-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 functor TextIOConvert
         (structure TextIO: TEXT_IO) :
         TEXT_IO_1997 =
@@ -5,19 +12,19 @@
      open TextIO
 
      fun inputLine ins =
-	case TextIO.inputLine ins of
-	   NONE => ""
-	 | SOME s => s
-	      
+        case TextIO.inputLine ins of
+           NONE => ""
+         | SOME s => s
+              
      structure StreamIO =
         struct
-	   open StreamIO
+           open StreamIO
 
-	   val inputAll = #1 o inputAll
+           val inputAll = #1 o inputAll
 
-	   fun inputLine ins =
-	      case StreamIO.inputLine ins of
-		 NONE => ("", ins)
-	       | SOME (s, ins) => (s, ins)
-	end
+           fun inputLine ins =
+              case StreamIO.inputLine ins of
+                 NONE => ("", ins)
+               | SOME (s, ins) => (s, ins)
+        end
   end

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/io/text-io.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/io/text-io.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/io/text-io.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -20,9 +20,9 @@
       val openIn: string -> instream 
       val print: string -> unit
       val scanStream:
- 	 ((Char.char, StreamIO.instream) StringCvt.reader
-	  -> ('a, StreamIO.instream) StringCvt.reader)
-	 -> instream -> 'a option
+         ((Char.char, StreamIO.instream) StringCvt.reader
+          -> ('a, StreamIO.instream) StringCvt.reader)
+         -> instream -> 'a option
       val setInstream: (instream * StreamIO.instream) -> unit
       val stdIn: instream
 (*

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/io/text-stream-io.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/io/text-stream-io.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/io/text-stream-io.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,8 +1,8 @@
 signature TEXT_STREAM_IO_1997 =
    sig
       include STREAM_IO_1997
-	 where type vector = CharVector.vector 
-	 where type elem = Char.char
+         where type vector = CharVector.vector 
+         where type elem = Char.char
 
       val inputLine: instream -> string * instream
 (*

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/posix/file-sys-convert.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/posix/file-sys-convert.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/posix/file-sys-convert.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,10 @@
+(* Copyright (C) 2002-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 functor PosixFileSysConvert
         (structure FileSys: POSIX_FILE_SYS) :
         POSIX_FILE_SYS_1997 =
@@ -5,18 +12,18 @@
      open FileSys
      val readdir = fn d =>
        case readdir d of
-	 NONE => ""
+         NONE => ""
        | SOME s => s
      structure S =
         struct
-	   open S
-	   structure Flags = FlagsConvert(structure Flags = S)
-	   open Flags
-	end
+           open S
+           structure Flags = FlagsConvert(structure Flags = S)
+           open Flags
+        end
      structure O =
         struct
-	   open O
-	   structure Flags = FlagsConvert(structure Flags = O)
-	   open Flags
-	end
+           open O
+           structure Flags = FlagsConvert(structure Flags = O)
+           open Flags
+        end
   end

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/posix/file-sys.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/posix/file-sys.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/posix/file-sys.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -10,7 +10,7 @@
       (* identity functions *)
       val fdToIOD: file_desc -> OS.IO.iodesc
       val iodToFD: OS.IO.iodesc -> file_desc option
-	 
+         
       type dirstream
       val opendir: string -> dirstream
       val readdir: dirstream -> string
@@ -19,44 +19,44 @@
 
       val chdir: string -> unit
       val getcwd: unit -> string
-	 
+         
       val stdin: file_desc 
       val stdout: file_desc 
       val stderr: file_desc
-	 
+         
       structure S:
-	 sig
-	    eqtype mode
-	    include POSIX_FLAGS_1997 where type flags = mode 
+         sig
+            eqtype mode
+            include POSIX_FLAGS_1997 where type flags = mode 
 
-	    val irwxu: mode 
-	    val irusr: mode 
-	    val iwusr: mode 
-	    val ixusr: mode 
-	    val irwxg: mode 
-	    val irgrp: mode 
-	    val iwgrp: mode 
-	    val ixgrp: mode 
-	    val irwxo: mode 
-	    val iroth: mode 
-	    val iwoth: mode 
-	    val ixoth: mode 
-	    val isuid: mode 
-	    val isgid: mode 
-	 end
+            val irwxu: mode 
+            val irusr: mode 
+            val iwusr: mode 
+            val ixusr: mode 
+            val irwxg: mode 
+            val irgrp: mode 
+            val iwgrp: mode 
+            val ixgrp: mode 
+            val irwxo: mode 
+            val iroth: mode 
+            val iwoth: mode 
+            val ixoth: mode 
+            val isuid: mode 
+            val isgid: mode 
+         end
 
       structure O:
-	 sig
-	    include POSIX_FLAGS_1997
+         sig
+            include POSIX_FLAGS_1997
 
             val append: flags 
-	    val excl: flags 
-	    val noctty: flags 
-	    val nonblock: flags 
-	    val sync: flags 
-	    val trunc: flags 
-	 end
-	 
+            val excl: flags 
+            val noctty: flags 
+            val nonblock: flags 
+            val sync: flags 
+            val trunc: flags 
+         end
+         
        datatype open_mode  = O_RDONLY  | O_WRONLY  | O_RDWR
 
        val openf: string * open_mode * O.flags -> file_desc 
@@ -81,37 +81,37 @@
        val inoToWord: ino -> SysWord.word 
 
        structure ST:
-	  sig
-	     type stat
+          sig
+             type stat
 
-	     val isDir: stat -> bool 
-	     val isChr: stat -> bool 
-	     val isBlk: stat -> bool 
-	     val isReg: stat -> bool 
-	     val isFIFO: stat -> bool 
-	     val isLink: stat -> bool 
-	     val isSock: stat -> bool 
-	     val mode: stat -> S.mode 
-	     val ino: stat -> ino 
-	     val dev: stat -> dev 
-	     val nlink: stat -> int 
-	     val uid: stat -> uid 
-	     val gid: stat -> gid 
-	     val size: stat -> Position.int 
-	     val atime: stat -> Time.time 
-	     val mtime: stat -> Time.time 
-	     val ctime: stat -> Time.time 
-	  end
+             val isDir: stat -> bool 
+             val isChr: stat -> bool 
+             val isBlk: stat -> bool 
+             val isReg: stat -> bool 
+             val isFIFO: stat -> bool 
+             val isLink: stat -> bool 
+             val isSock: stat -> bool 
+             val mode: stat -> S.mode 
+             val ino: stat -> ino 
+             val dev: stat -> dev 
+             val nlink: stat -> int 
+             val uid: stat -> uid 
+             val gid: stat -> gid 
+             val size: stat -> Position.int 
+             val atime: stat -> Time.time 
+             val mtime: stat -> Time.time 
+             val ctime: stat -> Time.time 
+          end
 
        val stat: string -> ST.stat
        val lstat: string -> ST.stat
        val fstat: file_desc -> ST.stat
 
        datatype access_mode =
-	  A_READ
-	| A_WRITE
-	| A_EXEC
-	  
+          A_READ
+        | A_WRITE
+        | A_EXEC
+          
        val access: string * access_mode list -> bool
        val chmod: string * S.mode -> unit
        val fchmod: file_desc * S.mode -> unit

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/posix/flags-convert.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/posix/flags-convert.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/posix/flags-convert.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,10 @@
+(* Copyright (C) 2002-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 functor FlagsConvert
         (structure Flags: BIT_FLAGS) :
         POSIX_FLAGS_1997 where type flags = Flags.flags =

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/posix/io-convert.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/posix/io-convert.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/posix/io-convert.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,10 @@
+(* Copyright (C) 2002-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 functor PosixIOConvert (structure IO: POSIX_IO): POSIX_IO_1997 =
   struct
      open IO
@@ -4,24 +11,24 @@
 
      structure FD =
         struct
-	   open FD
-	   structure Flags = FlagsConvert (structure Flags = FD)
-	   open Flags
-	end
+           open FD
+           structure Flags = FlagsConvert (structure Flags = FD)
+           open Flags
+        end
      
      structure O =
         struct
-	   open O
-	   structure Flags = FlagsConvert (structure Flags = O)
-	   open Flags
-	end
+           open O
+           structure Flags = FlagsConvert (structure Flags = O)
+           open Flags
+        end
 
      fun readArr (fd, {buf, i, sz}) =
-	IO.readArr (fd, Word8ArraySlice.slice (buf, i, sz))
+        IO.readArr (fd, Word8ArraySlice.slice (buf, i, sz))
 
      fun writeArr (fd, {buf, i, sz}) =
-	IO.writeArr (fd, Word8ArraySlice.slice (buf, i, sz))
+        IO.writeArr (fd, Word8ArraySlice.slice (buf, i, sz))
 
      fun writeVec (fd, {buf, i, sz}) =
-	IO.writeVec (fd, Word8VectorSlice.slice (buf, i, sz))
+        IO.writeVec (fd, Word8VectorSlice.slice (buf, i, sz))
   end

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/posix/io.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/posix/io.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/posix/io.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -10,35 +10,35 @@
       val close: file_desc -> unit 
       val readVec: file_desc * int -> Word8Vector.vector 
       val readArr: file_desc * {buf: Word8Array.array,
-				i: int,
-				sz: int option} -> int 
+                                i: int,
+                                sz: int option} -> int 
       val writeVec: file_desc * {buf: Word8Vector.vector,
-				 i: int,
-				 sz: int option} -> int 
+                                 i: int,
+                                 sz: int option} -> int 
       val writeArr: file_desc * {buf: Word8Array.array,
-				 i: int,
-				 sz: int option} -> int 
+                                 i: int,
+                                 sz: int option} -> int 
 
       datatype whence = SEEK_SET | SEEK_CUR | SEEK_END
 
       structure FD:
-	 sig
-	    include POSIX_FLAGS_1997
+         sig
+            include POSIX_FLAGS_1997
 
             val cloexec: flags 
-	 end
+         end
       
       structure O:
-	 sig
-	    include POSIX_FLAGS_1997
+         sig
+            include POSIX_FLAGS_1997
 
             val append: flags 
-	    val nonblock: flags 
-	    val sync: flags 
-	 end
+            val nonblock: flags 
+            val sync: flags 
+         end
       
       datatype open_mode = O_RDONLY | O_WRONLY | O_RDWR
-	 
+         
       val dupfd: {old: file_desc, base: file_desc} -> file_desc 
       val getfd: file_desc -> FD.flags 
       val setfd: file_desc * FD.flags -> unit 
@@ -46,28 +46,28 @@
       val setfl: file_desc * O.flags -> unit 
       val lseek: file_desc * Position.int * whence -> Position.int 
       val fsync: file_desc -> unit
-	 
+         
       datatype lock_type =
-	 F_RDLCK
+         F_RDLCK
        | F_WRLCK
        | F_UNLCK
-	 
+         
       structure FLock:
-	 sig
-	    type flock
-	    val flock: {
-			ltype: lock_type,
-			whence: whence,
-			start: Position.int,
-			len: Position.int,
-			pid: pid option
-			} -> flock 
-	    val ltype: flock -> lock_type 
-	    val whence: flock -> whence 
-	    val start: flock -> Position.int 
-	    val len: flock -> Position.int 
-	    val pid: flock -> pid option 
-	 end
+         sig
+            type flock
+            val flock: {
+                        ltype: lock_type,
+                        whence: whence,
+                        start: Position.int,
+                        len: Position.int,
+                        pid: pid option
+                        } -> flock 
+            val ltype: flock -> lock_type 
+            val whence: flock -> whence 
+            val start: flock -> Position.int 
+            val len: flock -> Position.int 
+            val pid: flock -> pid option 
+         end
       
       val getlk: file_desc * FLock.flock -> FLock.flock 
       val setlk: file_desc * FLock.flock -> FLock.flock 

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/posix/posix-convert.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/posix/posix-convert.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/posix/posix-convert.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,10 @@
+(* Copyright (C) 2002-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 functor PosixConvert
         (structure Posix : POSIX) :
         POSIX_1997 = 

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/posix/process-convert.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/posix/process-convert.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/posix/process-convert.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,10 @@
+(* Copyright (C) 2002-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 functor PosixProcessConvert
         (structure Process: POSIX_PROCESS) :
         POSIX_PROCESS_1997 =
@@ -5,8 +12,8 @@
      open Process
      structure W =
         struct
-	   open W
-	   structure Flags = FlagsConvert(structure Flags = W)
-	   open Flags
-	end
+           open W
+           structure Flags = FlagsConvert(structure Flags = W)
+           open Flags
+        end
   end
\ No newline at end of file

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/posix/process.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/posix/process.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/posix/process.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -11,22 +11,22 @@
       val execp: string * string list -> 'a 
 
       datatype waitpid_arg =
-	 W_ANY_CHILD
+         W_ANY_CHILD
        | W_CHILD of pid
        | W_SAME_GROUP
        | W_GROUP of pid 
 
       datatype exit_status =
-	 W_EXITED
+         W_EXITED
        | W_EXITSTATUS of Word8.word
        | W_SIGNALED of signal
        | W_STOPPED of signal 
 
       structure W :
-	 sig
-	    include POSIX_FLAGS_1997
+         sig
+            include POSIX_FLAGS_1997
             val untraced: flags 
-	 end
+         end
 
       val wait: unit -> pid * exit_status
       val waitpid: waitpid_arg * W.flags list -> pid * exit_status
@@ -34,7 +34,7 @@
       val exit: Word8.word -> 'a 
 
       datatype killpid_arg  =
-	 K_PROC of pid
+         K_PROC of pid
        | K_SAME_GROUP
        | K_GROUP of pid 
 

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/posix/tty-convert.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/posix/tty-convert.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/posix/tty-convert.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,10 @@
+(* Copyright (C) 2002-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 functor PosixTTYConvert
         (structure TTY: POSIX_TTY) :
         POSIX_TTY_1997 =
@@ -5,27 +12,27 @@
      open TTY
      structure I =
         struct
-	   open I
-	   structure Flags = FlagsConvert(structure Flags = I)
-	   open Flags
-	end
+           open I
+           structure Flags = FlagsConvert(structure Flags = I)
+           open Flags
+        end
      structure O =
         struct
-	   open O
-	   structure Flags = FlagsConvert(structure Flags = O)
-	   open Flags
-	end
+           open O
+           structure Flags = FlagsConvert(structure Flags = O)
+           open Flags
+        end
      structure C =
         struct
-	   open C
-	   structure Flags = FlagsConvert(structure Flags = C)
-	   open Flags
-	end
+           open C
+           structure Flags = FlagsConvert(structure Flags = C)
+           open Flags
+        end
      structure L =
         struct
-	   open L
-	   structure Flags = FlagsConvert(structure Flags = L)
-	   open Flags
-	end
+           open L
+           structure Flags = FlagsConvert(structure Flags = L)
+           open Flags
+        end
      open TC
   end
\ No newline at end of file

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/posix/tty.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/posix/tty.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/posix/tty.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -4,84 +4,84 @@
       eqtype file_desc
 
       structure V:
-	 sig
-	    val eof: int 
-	    val eol: int 
-	    val erase: int 
-	    val intr: int 
-	    val kill: int 
-	    val min: int 
-	    val quit: int 
-	    val susp: int 
-	    val time: int 
-	    val start: int 
-	    val stop: int 
-	    val nccs: int
-	       
-	    type cc
-	    val cc: (int * char) list -> cc 
-	    val update: cc * (int * char) list -> cc 
-	    val sub: cc * int -> char 
-	 end
+         sig
+            val eof: int 
+            val eol: int 
+            val erase: int 
+            val intr: int 
+            val kill: int 
+            val min: int 
+            val quit: int 
+            val susp: int 
+            val time: int 
+            val start: int 
+            val stop: int 
+            val nccs: int
+               
+            type cc
+            val cc: (int * char) list -> cc 
+            val update: cc * (int * char) list -> cc 
+            val sub: cc * int -> char 
+         end
 
       structure I:
-	 sig
-	    include POSIX_FLAGS_1997
-	    val brkint: flags 
-	    val icrnl: flags 
-	    val ignbrk: flags 
-	    val igncr: flags 
-	    val ignpar: flags 
-	    val inlcr: flags 
-	    val inpck: flags 
-	    val istrip: flags 
-	    val ixoff: flags 
-	    val ixon: flags 
-	    val parmrk: flags 
-	 end
+         sig
+            include POSIX_FLAGS_1997
+            val brkint: flags 
+            val icrnl: flags 
+            val ignbrk: flags 
+            val igncr: flags 
+            val ignpar: flags 
+            val inlcr: flags 
+            val inpck: flags 
+            val istrip: flags 
+            val ixoff: flags 
+            val ixon: flags 
+            val parmrk: flags 
+         end
 
       structure O:
-	 sig
-	    include POSIX_FLAGS_1997
-	    val opost: flags 
-	 end
+         sig
+            include POSIX_FLAGS_1997
+            val opost: flags 
+         end
 
       structure C:
-	 sig
-	    include POSIX_FLAGS_1997
-	    val clocal: flags 
-	    val cread: flags 
-	    val cs5: flags 
-	    val cs6: flags 
-	    val cs7: flags 
-	    val cs8: flags 
-	    val csize: flags 
-	    val cstopb: flags 
-	    val hupcl: flags 
-	    val parenb: flags 
-	    val parodd: flags 
-	 end
+         sig
+            include POSIX_FLAGS_1997
+            val clocal: flags 
+            val cread: flags 
+            val cs5: flags 
+            val cs6: flags 
+            val cs7: flags 
+            val cs8: flags 
+            val csize: flags 
+            val cstopb: flags 
+            val hupcl: flags 
+            val parenb: flags 
+            val parodd: flags 
+         end
 
       structure L:
-	 sig
-	    include POSIX_FLAGS_1997
-	    val echo: flags 
-	    val echoe: flags 
-	    val echok: flags 
-	    val echonl: flags 
-	    val icanon: flags 
-	    val iexten: flags 
-	    val isig: flags 
-	    val noflsh: flags 
-	    val tostop: flags 
-	 end
+         sig
+            include POSIX_FLAGS_1997
+            val echo: flags 
+            val echoe: flags 
+            val echok: flags 
+            val echonl: flags 
+            val icanon: flags 
+            val iexten: flags 
+            val isig: flags 
+            val noflsh: flags 
+            val tostop: flags 
+         end
 
       eqtype speed
 
       val compareSpeed: speed * speed -> order 
       val speedToWord: speed -> SysWord.word 
       val wordToSpeed: SysWord.word -> speed
-	 
+         
       val b0: speed 
       val b50: speed 
       val b75: speed 
@@ -102,20 +102,20 @@
       type termios
 
       val termios: {iflag: I.flags,
-		    oflag: O.flags,
-		    cflag: C.flags,
-		    lflag: L.flags,
-		    cc: V.cc,
-		    ispeed: speed,
-		    ospeed: speed} -> termios
+                    oflag: O.flags,
+                    cflag: C.flags,
+                    lflag: L.flags,
+                    cc: V.cc,
+                    ispeed: speed,
+                    ospeed: speed} -> termios
 
       val fieldsOf: termios -> {iflag: I.flags,
-				oflag: O.flags,
-				cflag: C.flags,
-				lflag: L.flags,
-				cc: V.cc,
-				ispeed: speed,
-				ospeed: speed} 
+                                oflag: O.flags,
+                                cflag: C.flags,
+                                lflag: L.flags,
+                                cc: V.cc,
+                                ispeed: speed,
+                                ospeed: speed} 
       val getiflag: termios -> I.flags 
       val getoflag: termios -> O.flags 
       val getcflag: termios -> C.flags 
@@ -123,38 +123,38 @@
       val getcc: termios -> V.cc 
 
       structure CF:
-	 sig
-	    val getospeed: termios -> speed 
-	    val setospeed: termios * speed -> termios 
-	    val getispeed: termios -> speed 
-	    val setispeed: termios * speed -> termios 
-	 end
+         sig
+            val getospeed: termios -> speed 
+            val setospeed: termios * speed -> termios 
+            val getispeed: termios -> speed 
+            val setispeed: termios * speed -> termios 
+         end
 
       structure TC:
-	 sig
-	    eqtype set_action
+         sig
+            eqtype set_action
 
-	    val sanow: set_action 
-	    val sadrain: set_action 
-	    val saflush: set_action 
+            val sanow: set_action 
+            val sadrain: set_action 
+            val saflush: set_action 
 
-	    eqtype flow_action
+            eqtype flow_action
 
-	    val ooff: flow_action 
-	    val oon: flow_action 
-	    val ioff: flow_action 
-	    val ion: flow_action 
+            val ooff: flow_action 
+            val oon: flow_action 
+            val ioff: flow_action 
+            val ion: flow_action 
 
-	    eqtype queue_sel
-	       
-	    val iflush: queue_sel 
-	    val oflush: queue_sel 
-	    val ioflush: queue_sel 
-	 end
+            eqtype queue_sel
+               
+            val iflush: queue_sel 
+            val oflush: queue_sel 
+            val ioflush: queue_sel 
+         end
 
       val getattr: file_desc -> termios
       val setattr: file_desc * TC.set_action * termios -> unit
-	 
+         
       val sendbreak: file_desc * int -> unit
       val drain: file_desc -> unit
       val flush: file_desc * TC.queue_sel -> unit

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/real/IEEE-real-convert.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/real/IEEE-real-convert.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/real/IEEE-real-convert.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,12 +1,19 @@
+(* Copyright (C) 2002-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 functor IEEERealConvert
         (structure IEEEReal: IEEE_REAL):
         sig
-	  include IEEE_REAL_1997 
-	  val >> : IEEEReal.float_class -> float_class
-	  val << : float_class -> IEEEReal.float_class
-	  val >>> : IEEEReal.decimal_approx -> decimal_approx
-	  val <<< : decimal_approx -> IEEEReal.decimal_approx
-	end =
+          include IEEE_REAL_1997 
+          val >> : IEEEReal.float_class -> float_class
+          val << : float_class -> IEEEReal.float_class
+          val >>> : IEEEReal.decimal_approx -> decimal_approx
+          val <<< : decimal_approx -> IEEEReal.decimal_approx
+        end =
   struct
      open IEEEReal
 
@@ -19,26 +26,26 @@
       | SUBNORMAL
      val >> =
        fn IEEEReal.NAN => NAN QUIET
-	| IEEEReal.INF => INF
-	| IEEEReal.ZERO => ZERO
-	| IEEEReal.NORMAL => NORMAL
-	| IEEEReal.SUBNORMAL => SUBNORMAL
+        | IEEEReal.INF => INF
+        | IEEEReal.ZERO => ZERO
+        | IEEEReal.NORMAL => NORMAL
+        | IEEEReal.SUBNORMAL => SUBNORMAL
      val << =
        fn NAN _ => IEEEReal.NAN
-	| INF => IEEEReal.INF
-	| ZERO => IEEEReal.ZERO
-	| NORMAL => IEEEReal.NORMAL
-	| SUBNORMAL => IEEEReal.SUBNORMAL
+        | INF => IEEEReal.INF
+        | ZERO => IEEEReal.ZERO
+        | NORMAL => IEEEReal.NORMAL
+        | SUBNORMAL => IEEEReal.SUBNORMAL
 
      type decimal_approx = {kind: float_class, sign: bool,
-			    digits: int list, exp: int}
+                            digits: int list, exp: int}
  
      val <<< = fn {kind, sign, digits, exp} =>
        {class = << kind, sign = sign, 
-	digits = digits, exp = exp}
+        digits = digits, exp = exp}
      val >>> = fn {class, sign, digits, exp} =>
        {kind = >> class, sign = sign, 
-	digits = digits, exp = exp}
+        digits = digits, exp = exp}
 
      val toString = toString o <<<
      val fromString = fn s => 

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/real/IEEE-real.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/real/IEEE-real.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/real/IEEE-real.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -4,20 +4,20 @@
       datatype real_order = LESS | EQUAL | GREATER | UNORDERED
       datatype nan_mode = QUIET | SIGNALLING
       datatype float_class = 
-	 NAN of nan_mode
+         NAN of nan_mode
        | INF
        | ZERO
        | NORMAL
        | SUBNORMAL
       datatype rounding_mode = 
-	 TO_NEAREST
+         TO_NEAREST
        | TO_NEGINF
        | TO_POSINF
        | TO_ZERO
       val setRoundingMode: rounding_mode -> unit
       val getRoundingMode: unit -> rounding_mode
       type decimal_approx = {kind: float_class, sign: bool, 
-			     digits: int list, exp: int}
+                             digits: int list, exp: int}
       val toString: decimal_approx -> string
       val fromString: string -> decimal_approx option 
    end

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/real/real-convert.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/real/real-convert.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/real/real-convert.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,10 @@
+(* Copyright (C) 2002-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 functor RealConvert
         (structure Real: REAL) :
         REAL_1997 =

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/real/real.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/real/real.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/real/real.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -2,7 +2,7 @@
    sig
       type real
       structure Math: MATH where type real = real
-	
+        
       val ceil: real -> Int.int
       val floor: real -> Int.int 
       val round: real -> Int.int

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/system/file-sys-convert.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/system/file-sys-convert.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/system/file-sys-convert.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,10 @@
+(* Copyright (C) 2002-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 functor OSFileSysConvert
         (structure FileSys : OS_FILE_SYS) :
         OS_FILE_SYS_1997 =
@@ -5,6 +12,6 @@
      open FileSys
      val readDir = fn d =>
        case readDir d of
-	 NONE => ""
+         NONE => ""
        | SOME s => s
   end

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/system/file-sys.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/system/file-sys.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/system/file-sys.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -21,12 +21,12 @@
       val setTime: string * Time.time option -> unit 
       val remove: string -> unit 
       val rename: {old: string, new: string} -> unit
-	 
+         
       datatype access_mode =
-	 A_READ
+         A_READ
        | A_WRITE
        | A_EXEC
-	 
+         
       val access: string * access_mode list -> bool 
       val tmpName: unit -> string 
 

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/system/os-convert.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/system/os-convert.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/system/os-convert.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,10 @@
+(* Copyright (C) 2002-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 functor OSConvert
         (structure OS: OS) :
         OS_1997 = 

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/system/os.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/system/os.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/system/os.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -7,7 +7,7 @@
       val errorMsg: syserror -> string 
       val errorName: syserror -> string
       val syserror: string -> syserror option
-	 
+         
       structure FileSys: OS_FILE_SYS_1997
       structure Path: OS_PATH_1997
       structure Process: OS_PROCESS_1997

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/system/path-convert.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/system/path-convert.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/system/path-convert.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,10 @@
+(* Copyright (C) 2003-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 functor OSPathConvert
         (structure Path : OS_PATH) :
         OS_PATH_1997 =

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/system/process-convert.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/system/process-convert.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/system/process-convert.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,10 @@
+(* Copyright (C) 2002-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 functor OSProcessConvert
         (structure Process : OS_PROCESS) :
         OS_PROCESS_1997 =

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/system/timer-convert.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/system/timer-convert.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/system/timer-convert.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,10 @@
+(* Copyright (C) 2002-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 functor TimerConvert
         (structure Timer: TIMER) :
         TIMER_1997 =
@@ -6,9 +13,9 @@
 
      val checkCPUTimer = fn cput =>
        let
-	 val {usr, sys} = checkCPUTimer cput
-	 val gc = checkGCTime cput
+         val {usr, sys} = checkCPUTimer cput
+         val gc = checkGCTime cput
        in
-	 {usr = usr, sys = sys, gc = gc}
+         {usr = usr, sys = sys, gc = gc}
        end
   end

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/system/unix-convert.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/system/unix-convert.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/system/unix-convert.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,10 @@
+(* Copyright (C) 2002-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 functor UnixConvert
         (structure Unix: UNIX) :
         UNIX_1997 =

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/system/unix.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/system/unix.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/system/unix.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -2,7 +2,7 @@
    sig
       type proc
       type signal
-	 
+         
       val executeInEnv: string * string list * string list -> proc 
       val execute: string * string list -> proc 
       val streamsOf: proc -> TextIO.instream * TextIO.outstream 

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/text/string.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/text/string.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/text/string.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -19,7 +19,7 @@
       val isPrefix: string -> string -> bool
       val compare: (string * string) -> order
       val collate: (((Char.char * Char.char) -> order)
-		    -> (string * string) -> order)
+                    -> (string * string) -> order)
       val < : (string * string) -> bool
       val <= : (string * string) -> bool
       val > : (string * string) -> bool

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/text/substring.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/text/substring.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/text/substring.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -20,11 +20,11 @@
       val isPrefix: String.string -> substring -> bool
       val compare: (substring * substring) -> order
       val collate: ((String.Char.char * String.Char.char) -> order)
-	           -> (substring * substring) -> order
+                   -> (substring * substring) -> order
       val splitl: ((String.Char.char -> bool)
-		   -> substring -> (substring * substring))
+                   -> substring -> (substring * substring))
       val splitr: ((String.Char.char -> bool)
-		   -> substring -> (substring * substring))
+                   -> substring -> (substring * substring))
       val splitAt: (substring * int) -> (substring * substring)
       val dropl: (String.Char.char -> bool) -> substring -> substring
       val dropr: (String.Char.char -> bool) -> substring -> substring
@@ -33,7 +33,7 @@
       val position: String.string -> substring -> (substring * substring)
       val span: (substring * substring) -> substring
       val translate: ((String.Char.char -> String.string)
-		      -> substring -> String.string)
+                      -> substring -> String.string)
       val tokens: (String.Char.char -> bool) -> substring -> substring list
       val fields: (String.Char.char -> bool) -> substring -> substring list
       val foldl: ((String.Char.char * 'a) -> 'a) -> 'a -> substring -> 'a

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/text/text-convert.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/text/text-convert.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/text/text-convert.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,10 @@
+(* Copyright (C) 2002-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 functor TextConvert (structure Text: TEXT):
    sig
       structure Char: CHAR
@@ -9,14 +16,14 @@
    struct
       structure Char = Text.Char
       structure String =
-	 struct
-	    structure Char = Char
-	    open Text.String
-	 end
+         struct
+            structure Char = Char
+            open Text.String
+         end
       structure Substring =
-	 struct
-	    structure String = String
-	    open Text.Substring
-	    val all = full
-	 end
+         struct
+            structure String = String
+            open Text.Substring
+            val all = full
+         end
    end

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/top-level/basis-funs.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/top-level/basis-funs.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/top-level/basis-funs.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,10 @@
+(* Copyright (C) 2002-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 (* Required functors *)
 
 (* Optional functors *)

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/top-level/basis-sigs.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/top-level/basis-sigs.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/top-level/basis-sigs.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,10 @@
+(* Copyright (C) 2002-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 (* Required signatures *)
 signature CHAR = CHAR
 signature INTEGER = INTEGER

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/top-level/basis.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/top-level/basis.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/top-level/basis.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,10 @@
+(* Copyright (C) 2002-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 structure Basis1997: BASIS_1997 =
    struct
       open Basis2002
@@ -4,72 +11,72 @@
       structure SML90 = SML90
 
       structure VectorArray = VectorArrayConvert
-	                      (structure Vector = Vector
-			       structure VectorSlice = VectorSlice
-			       structure Array = Array
-			       structure ArraySlice = ArraySlice)
+                              (structure Vector = Vector
+                               structure VectorSlice = VectorSlice
+                               structure Array = Array
+                               structure ArraySlice = ArraySlice)
       structure Vector = VectorArray.Vector
       structure Array = VectorArray.Array
       structure BoolVectorArray = MonoVectorArrayArray2Convert
-	                          (structure Vector = BoolVector
-				   structure VectorSlice = BoolVectorSlice
-				   structure Array = BoolArray
-				   structure ArraySlice = BoolArraySlice
-				   structure Array2 = BoolArray2)
+                                  (structure Vector = BoolVector
+                                   structure VectorSlice = BoolVectorSlice
+                                   structure Array = BoolArray
+                                   structure ArraySlice = BoolArraySlice
+                                   structure Array2 = BoolArray2)
       structure BoolVector = BoolVectorArray.Vector
       structure BoolArray = BoolVectorArray.Array
       structure BoolArray2 = BoolVectorArray.Array2
       structure CharVectorArray = MonoVectorArrayArray2Convert
-	                          (structure Vector = CharVector
-				   structure VectorSlice = CharVectorSlice
-				   structure Array = CharArray
-				   structure ArraySlice = CharArraySlice
-				   structure Array2 = CharArray2)
+                                  (structure Vector = CharVector
+                                   structure VectorSlice = CharVectorSlice
+                                   structure Array = CharArray
+                                   structure ArraySlice = CharArraySlice
+                                   structure Array2 = CharArray2)
       structure CharVector = CharVectorArray.Vector
       structure CharArray = CharVectorArray.Array
       structure CharArray2 = CharVectorArray.Array2
       structure IntVectorArray = MonoVectorArrayArray2Convert
-	                         (structure Vector = IntVector
-				  structure VectorSlice = IntVectorSlice
-				  structure Array = IntArray
-				  structure ArraySlice = IntArraySlice
-				  structure Array2 = IntArray2)
+                                 (structure Vector = IntVector
+                                  structure VectorSlice = IntVectorSlice
+                                  structure Array = IntArray
+                                  structure ArraySlice = IntArraySlice
+                                  structure Array2 = IntArray2)
       structure IntVector = IntVectorArray.Vector
       structure IntArray = IntVectorArray.Array
       structure IntArray2 = IntVectorArray.Array2
       structure Int32VectorArray = MonoVectorArrayArray2Convert
-	                           (structure Vector = Int32Vector
-			 	    structure VectorSlice = Int32VectorSlice
-				    structure Array = Int32Array
-				    structure ArraySlice = Int32ArraySlice
-				    structure Array2 = Int32Array2)
+                                   (structure Vector = Int32Vector
+                                    structure VectorSlice = Int32VectorSlice
+                                    structure Array = Int32Array
+                                    structure ArraySlice = Int32ArraySlice
+                                    structure Array2 = Int32Array2)
       structure Int32Vector = Int32VectorArray.Vector
       structure Int32Array = Int32VectorArray.Array
       structure Int32Array2 = Int32VectorArray.Array2
       structure RealVectorArray = MonoVectorArrayArray2Convert
-	                          (structure Vector = RealVector
-				   structure VectorSlice = RealVectorSlice
-				   structure Array = RealArray
-				   structure ArraySlice = RealArraySlice
-				   structure Array2 = RealArray2)
+                                  (structure Vector = RealVector
+                                   structure VectorSlice = RealVectorSlice
+                                   structure Array = RealArray
+                                   structure ArraySlice = RealArraySlice
+                                   structure Array2 = RealArray2)
       structure RealVector = RealVectorArray.Vector
       structure RealArray = RealVectorArray.Array
       structure RealArray2 = RealVectorArray.Array2
       structure Real64VectorArray = MonoVectorArrayArray2Convert
-	                            (structure Vector = Real64Vector
-				     structure VectorSlice = Real64VectorSlice
-				     structure Array = Real64Array
-				     structure ArraySlice = Real64ArraySlice
-				     structure Array2 = Real64Array2)
+                                    (structure Vector = Real64Vector
+                                     structure VectorSlice = Real64VectorSlice
+                                     structure Array = Real64Array
+                                     structure ArraySlice = Real64ArraySlice
+                                     structure Array2 = Real64Array2)
       structure Real64Vector = Real64VectorArray.Vector
       structure Real64Array = Real64VectorArray.Array
       structure Real64Array2 = Real64VectorArray.Array2
       structure Word8VectorArray = MonoVectorArrayArray2Convert
-	                           (structure Vector = Word8Vector
-			 	    structure VectorSlice = Word8VectorSlice
-				    structure Array = Word8Array
-				    structure ArraySlice = Word8ArraySlice
-				    structure Array2 = Word8Array2)
+                                   (structure Vector = Word8Vector
+                                    structure VectorSlice = Word8VectorSlice
+                                    structure Array = Word8Array
+                                    structure ArraySlice = Word8ArraySlice
+                                    structure Array2 = Word8Array2)
       structure Word8Vector = Word8VectorArray.Vector
       structure Word8Array = Word8VectorArray.Array
       structure Word8Array2 = Word8VectorArray.Array2

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/top-level/infixes.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/top-level/infixes.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/top-level/infixes.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 infix  7 * / mod div
 infix  6 + - ^
 infixr 5 :: @

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/top-level/overloads.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/top-level/overloads.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/top-level/overloads.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,9 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 _overload ~ :   ('a -> 'a)

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/top-level/top-level.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/top-level/top-level.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-1997/top-level/top-level.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,2 +1,9 @@
+(* Copyright (C) 2002-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
 
+
 open Basis1997

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-2002/basis-2002.mlb
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-2002/basis-2002.mlb	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-2002/basis-2002.mlb	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,7 +1,14 @@
+(* Copyright (C) 2004-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 ann  
    "deadCode true"
-   "sequenceUnit true"
-   "warnMatch true"
+   "sequenceNonUnit warn"
+   "nonexhaustiveMatch warn" "redundantMatch warn"
    "warnUnused true" "forceUsed"
 in
    local
@@ -10,5 +17,5 @@
       top-level/basis.sml
    in
       structure Basis2002
-    end
+   end
 end


Property changes on: mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-2002/top-level
___________________________________________________________________
Name: svn:ignore
   - generate-overloads
   + generate-overloads


Deleted: mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-2002/top-level/.cvsignore
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-2002/top-level/.cvsignore	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-2002/top-level/.cvsignore	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1 +0,0 @@
-generate-overloads

Copied: mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-2002/top-level/.ignore (from rev 4358, mlton/trunk/basis-library/libs/basis-2002/top-level/.ignore)

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-2002/top-level/Makefile
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-2002/top-level/Makefile	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-2002/top-level/Makefile	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,10 @@
+## Copyright (C) 2004-2005 Henry Cejtin, Matthew Fluet, Suresh
+ #    Jagannathan, and Stephen Weeks.
+ #
+ # MLton is released under a BSD-style license.
+ # See the file MLton-LICENSE for details.
+ ##
+
 GEN = generate-overloads
 
 overloads.sml: $(GEN).sml

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-2002/top-level/basis-funs.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-2002/top-level/basis-funs.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-2002/top-level/basis-funs.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,10 @@
+(* Copyright (C) 2002-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 (* Required functors *)
 
 (* Optional functors *)

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-2002/top-level/basis-sigs.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-2002/top-level/basis-sigs.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-2002/top-level/basis-sigs.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,10 @@
+(* Copyright (C) 2002-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 (* Required signatures *)
 signature ARRAY = ARRAY 
 signature ARRAY_SLICE = ARRAY_SLICE 

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-2002/top-level/basis.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-2002/top-level/basis.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-2002/top-level/basis.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -34,7 +34,7 @@
       (* Top-level values *)
       val = : ''a * ''a -> bool
       val <> : ''a * ''a -> bool
-	
+        
       val ! : 'a ref -> 'a
       val := : 'a ref * 'a -> unit
       val @ : ('a list * 'a list) -> 'a list
@@ -80,49 +80,49 @@
       val vector : 'a list -> 'a vector
 
       (* Required structures *)
-      structure Array : ARRAY	
-      structure ArraySlice : ARRAY_SLICE	
-      structure BinIO : BIN_IO	
-      structure BinPrimIO : PRIM_IO	
-      structure Bool : BOOL	
-      structure Byte : BYTE	
-      structure Char : CHAR	
-      structure CharArray : MONO_ARRAY	
-      structure CharArraySlice : MONO_ARRAY_SLICE	
-      structure CharVector : MONO_VECTOR	
-      structure CharVectorSlice : MONO_VECTOR_SLICE	
-      structure CommandLine : COMMAND_LINE	
-      structure Date : DATE	
-      structure General : GENERAL	
-      structure IEEEReal : IEEE_REAL	
-      structure Int : INTEGER	
-      structure IO : IO	
-      structure LargeInt : INTEGER	
-      structure LargeReal : REAL	
-      structure LargeWord : WORD	
-      structure List : LIST	
-      structure ListPair : LIST_PAIR	
-      structure Math : MATH	
-      structure Option : OPTION	
-      structure OS : OS	
-      structure Position : INTEGER	
-      structure Real : REAL	
-      structure StringCvt : STRING_CVT	
-      structure String : STRING	
-      structure Substring : SUBSTRING	
-      structure TextIO : TEXT_IO	
-      structure TextPrimIO : PRIM_IO	
-      structure Text : TEXT	
-      structure Time : TIME	
-      structure Timer : TIMER	
-      structure VectorSlice : VECTOR_SLICE	
-      structure Vector : VECTOR	
-      structure Word : WORD	
-      structure Word8Array : MONO_ARRAY	
-      structure Word8Array2 : MONO_ARRAY2	
-      structure Word8ArraySlice : MONO_ARRAY_SLICE	
-      structure Word8Vector : MONO_VECTOR	
-      structure Word8VectorSlice : MONO_VECTOR_SLICE	
+      structure Array : ARRAY   
+      structure ArraySlice : ARRAY_SLICE        
+      structure BinIO : BIN_IO  
+      structure BinPrimIO : PRIM_IO     
+      structure Bool : BOOL     
+      structure Byte : BYTE     
+      structure Char : CHAR     
+      structure CharArray : MONO_ARRAY  
+      structure CharArraySlice : MONO_ARRAY_SLICE       
+      structure CharVector : MONO_VECTOR        
+      structure CharVectorSlice : MONO_VECTOR_SLICE     
+      structure CommandLine : COMMAND_LINE      
+      structure Date : DATE     
+      structure General : GENERAL       
+      structure IEEEReal : IEEE_REAL    
+      structure Int : INTEGER   
+      structure IO : IO 
+      structure LargeInt : INTEGER      
+      structure LargeReal : REAL        
+      structure LargeWord : WORD        
+      structure List : LIST     
+      structure ListPair : LIST_PAIR    
+      structure Math : MATH     
+      structure Option : OPTION 
+      structure OS : OS 
+      structure Position : INTEGER      
+      structure Real : REAL     
+      structure StringCvt : STRING_CVT  
+      structure String : STRING 
+      structure Substring : SUBSTRING   
+      structure TextIO : TEXT_IO        
+      structure TextPrimIO : PRIM_IO    
+      structure Text : TEXT     
+      structure Time : TIME     
+      structure Timer : TIMER   
+      structure VectorSlice : VECTOR_SLICE      
+      structure Vector : VECTOR 
+      structure Word : WORD     
+      structure Word8Array : MONO_ARRAY 
+      structure Word8Array2 : MONO_ARRAY2       
+      structure Word8ArraySlice : MONO_ARRAY_SLICE      
+      structure Word8Vector : MONO_VECTOR       
+      structure Word8VectorSlice : MONO_VECTOR_SLICE    
 
       (* Optional structures *)
       structure Array2 : ARRAY2
@@ -310,7 +310,7 @@
       structure Word64ArraySlice : MONO_ARRAY_SLICE
       structure Word64Vector : MONO_VECTOR
       structure Word64VectorSlice : MONO_VECTOR_SLICE
-	 
+         
       (* ************************************************** *)
       (* ************************************************** *)
 
@@ -407,7 +407,7 @@
       sharing type Word8VectorSlice.vector = Word8Vector.vector
       sharing type Word8Array2.elem = Word8.word
       sharing type Word8Array2.vector = Word8Vector.vector
-	
+        
       (* Optional structures *)
       sharing type BoolArray.vector = BoolVector.vector
       sharing type BoolArraySlice.array = BoolArray.array

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-2002/top-level/basis.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-2002/top-level/basis.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-2002/top-level/basis.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1 +1,8 @@
+(* Copyright (C) 2002-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 structure Basis2002 : BASIS_2002 = BasisExtra

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-2002/top-level/generate-overloads.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-2002/top-level/generate-overloads.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-2002/top-level/generate-overloads.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,10 @@
+(* Copyright (C) 2004-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 structure List =
    struct
       fun foreach (l, f) = List.app f l
@@ -8,14 +15,14 @@
 val int =
    ["Int", "IntInf", "LargeInt", "FixedInt", "Position"]
    @ List.map (List.tabulate (31, fn i => i + 2) @ [64],
-	       fn i => concat ["Int", Int.toString i])
+               fn i => concat ["Int", Int.toString i])
 
 val real = ["Real", "Real32", "Real64", "LargeReal"]
 
 val word =
    ["Word", "LargeWord", "SysWord"]
    @ List.map (List.tabulate (32, fn i => i + 1) @ [64],
-	       fn i => concat ["Word", Int.toString i])
+               fn i => concat ["Word", Int.toString i])
 
 val text = ["Char", "String"]
 
@@ -50,9 +57,9 @@
     fn (prec, f, ty, class) =>
     (print (concat ["\n_overload ", Int.toString prec, " ", f, " : ", ty, "\n"])
      ; (case class of
-	   [] => ()
-	 | c :: class =>
-	      (print (concat ["as  ", c, ".", f, "\n"])
-	       ; List.foreach (class, fn c =>
-			       print (concat ["and ", c, ".", f, "\n"]))))))
+           [] => ()
+         | c :: class =>
+              (print (concat ["as  ", c, ".", f, "\n"])
+               ; List.foreach (class, fn c =>
+                               print (concat ["and ", c, ".", f, "\n"]))))))
    

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-2002/top-level/infixes.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-2002/top-level/infixes.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-2002/top-level/infixes.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 infix  7 * / mod div
 infix  6 + - ^
 infixr 5 :: @

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-2002/top-level/overloads.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-2002/top-level/overloads.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-2002/top-level/overloads.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,10 @@
+(* Copyright (C) 2002-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 (* This file is automatically generated.  Do not edit. *)
 
 _overload 2 ~ : 'a -> 'a

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-2002/top-level/pervasive-equal.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-2002/top-level/pervasive-equal.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-2002/top-level/pervasive-equal.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,10 @@
+(* Copyright (C) 2004-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 local
    structure B = Basis2002 : BASIS_2002_EQUAL
 in

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-2002/top-level/pervasive-exns.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-2002/top-level/pervasive-exns.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-2002/top-level/pervasive-exns.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,10 @@
+(* Copyright (C) 2004-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 local
    structure B : BASIS_2002_EXNS = Basis2002
 in

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-2002/top-level/pervasive-types.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-2002/top-level/pervasive-types.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-2002/top-level/pervasive-types.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,10 @@
+(* Copyright (C) 2004-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 local
    structure B : BASIS_2002_TYPES = Basis2002
 in

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-2002/top-level/pervasive-vals.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-2002/top-level/pervasive-vals.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-2002/top-level/pervasive-vals.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,10 @@
+(* Copyright (C) 2004-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 local
    structure B : BASIS_2002_VALS = Basis2002
 in

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-2002/top-level/top-level.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-2002/top-level/top-level.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-2002/top-level/top-level.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,9 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 open Basis2002
@@ -13,6 +13,7 @@
  *
  * Order here matters!  Do not alphabetize or otherwise reorder without thinking.
  *)
+structure Posix = Posix
 structure OS = OS
 structure BoolArray = BoolArray
 structure BoolVector = BoolVector

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-2002-strict/top-level/top-level.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-2002-strict/top-level/top-level.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-2002-strict/top-level/top-level.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,9 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 open Basis2002

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-extra/basis-extra.mlb
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-extra/basis-extra.mlb	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-extra/basis-extra.mlb	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,263 +1,268 @@
+(* Copyright (C) 2004-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 ann  
    "deadCode true"
-   "sequenceUnit true"
-   "warnMatch true"
+   "sequenceNonUnit warn"
+   "nonexhaustiveMatch warn" "redundantMatch warn"
    "warnUnused true" "forceUsed"
 in
-  local
-    ../primitive.mlb
-    (*
-    #
-    # Common basis implementation.
-    #
-    *)
-    ../../top-level/infixes.sml
-    ../../misc/basic.sml
-    ../../misc/dynamic-wind.sig
-    ../../misc/dynamic-wind.sml
-    ../../general/general.sig
-    ../../general/general.sml
-    ../../misc/util.sml
-    ../../general/option.sig
-    ../../general/option.sml
-    ../../list/list.sig
-    ../../list/list.sml
-    ../../list/list-pair.sig
-    ../../list/list-pair.sml
-    ../../arrays-and-vectors/slice.sig
-    ../../arrays-and-vectors/sequence.sig
-    ../../arrays-and-vectors/sequence.fun
-    ../../arrays-and-vectors/vector-slice.sig
-    ../../arrays-and-vectors/vector.sig
-    ../../arrays-and-vectors/vector.sml
-    ../../arrays-and-vectors/array-slice.sig
-    ../../arrays-and-vectors/array.sig
-    ../../arrays-and-vectors/array.sml
-    ../../arrays-and-vectors/array2.sig
-    ../../arrays-and-vectors/array2.sml
-    ../../arrays-and-vectors/mono-vector-slice.sig
-    ../../arrays-and-vectors/mono-vector.sig
-    ../../arrays-and-vectors/mono-vector.fun
-    ../../arrays-and-vectors/mono-array-slice.sig
-    ../../arrays-and-vectors/mono-array.sig
-    ../../arrays-and-vectors/mono-array.fun
-    ../../arrays-and-vectors/mono-array2.sig
-    ../../arrays-and-vectors/mono-array2.fun
-    ../../arrays-and-vectors/mono.sml
-    ../../text/string0.sml
-    ../../text/char0.sml
-    ../../misc/reader.sig
-    ../../misc/reader.sml
-    ../../text/string-cvt.sig
-    ../../text/string-cvt.sml
-    ../../general/bool.sig
-    ../../general/bool.sml
-    ../../integer/integer.sig
-    ../../integer/int.sml
-    ../../text/char.sig
-    ../../text/char.sml
-    ../../text/substring.sig
-    ../../text/substring.sml
-    ../../text/string.sig
-    ../../text/string.sml
-    ../../misc/C.sig
-    ../../misc/C.sml
-    ../../integer/word.sig
-    ../../integer/word.sml
-    ../../integer/int-inf.sig
-    ../../integer/int-inf.sml
-    ../../real/IEEE-real.sig
-    ../../real/IEEE-real.sml
-    ../../real/math.sig
-    ../../real/real.sig
-    ../../real/real.fun
-    ../../integer/pack-word.sig
-    ../../integer/pack-word32.sml
-    ../../text/byte.sig
-    ../../text/byte.sml
-    ../../text/text.sig
-    ../../text/text.sml
-    ../../real/pack-real.sig
-    ../../real/pack-real.sml
-    ../../real/real32.sml
-    ../../real/real64.sml
-    ../../integer/patch.sml
-    ../../integer/embed-int.sml
-    ../../integer/embed-word.sml
+   local
+      ../primitive.mlb
+      (* Common basis implementation. *)
+      ../../top-level/infixes.sml
+      ../../misc/basic.sml
+      ../../misc/dynamic-wind.sig
+      ../../misc/dynamic-wind.sml
+      ../../general/general.sig
+      ../../general/general.sml
+      ../../misc/util.sml
+      ../../general/option.sig
+      ../../general/option.sml
+      ../../list/list.sig
+      ../../list/list.sml
+      ../../list/list-pair.sig
+      ../../list/list-pair.sml
+      ../../arrays-and-vectors/slice.sig
+      ../../arrays-and-vectors/sequence.sig
+      ../../arrays-and-vectors/sequence.fun
+      ../../arrays-and-vectors/vector-slice.sig
+      ../../arrays-and-vectors/vector.sig
+      ../../arrays-and-vectors/vector.sml
+      ../../arrays-and-vectors/array-slice.sig
+      ../../arrays-and-vectors/array.sig
+      ../../arrays-and-vectors/array.sml
+      ../../arrays-and-vectors/array2.sig
+      ../../arrays-and-vectors/array2.sml
+      ../../arrays-and-vectors/mono-vector-slice.sig
+      ../../arrays-and-vectors/mono-vector.sig
+      ../../arrays-and-vectors/mono-vector.fun
+      ../../arrays-and-vectors/mono-array-slice.sig
+      ../../arrays-and-vectors/mono-array.sig
+      ../../arrays-and-vectors/mono-array.fun
+      ../../arrays-and-vectors/mono-array2.sig
+      ../../arrays-and-vectors/mono-array2.fun
+      ../../arrays-and-vectors/mono.sml
+      ../../text/string0.sml
+      ../../text/char0.sml
+      ../../misc/reader.sig
+      ../../misc/reader.sml
+      ../../text/string-cvt.sig
+      ../../text/string-cvt.sml
+      ../../general/bool.sig
+      ../../general/bool.sml
+      ../../integer/integer.sig
+      ../../integer/int.sml
+      ../../text/char.sig
+      ../../text/char.sml
+      ../../text/substring.sig
+      ../../text/substring.sml
+      ../../text/string.sig
+      ../../text/string.sml
+      ../../misc/C.sig
+      ../../misc/C.sml
+      ../../integer/word.sig
+      ../../integer/word.sml
+      ../../integer/int-inf.sig
+      ../../integer/int-inf.sml
+      ../../real/IEEE-real.sig
+      ../../real/IEEE-real.sml
+      ../../real/math.sig
+      ../../real/real.sig
+      ../../real/real.fun
+      ../../integer/pack-word.sig
+      ../../integer/pack-word32.sml
+      ../../text/byte.sig
+      ../../text/byte.sml
+      ../../text/text.sig
+      ../../text/text.sml
+      ../../real/pack-real.sig
+      ../../real/pack-real.sml
+      ../../real/real32.sml
+      ../../real/real64.sml
+      ../../integer/patch.sml
+      ../../integer/embed-int.sml
+      ../../integer/embed-word.sml
 
-    ../../top-level/arithmetic.sml
+      ../../top-level/arithmetic.sml
 
-    (*
-    # misc/unique-id.sig
-    # misc/unique-id.fun
-    *)
-    ../../misc/cleaner.sig
-    ../../misc/cleaner.sml
+      (* misc/unique-id.sig *)
+      (* misc/unique-id.fun *)
+      ../../misc/cleaner.sig
+      ../../misc/cleaner.sml
 
-    ../../system/pre-os.sml
-    ../../system/time.sig
-    ../../system/time.sml
-    ../../system/date.sig
-    ../../system/date.sml
+      ../../system/pre-os.sml
+      ../../system/time.sig
+      ../../system/time.sml
+      ../../system/date.sig
+      ../../system/date.sml
 
-    ../../io/io.sig
-    ../../io/io.sml
-    ../../io/prim-io.sig
-    ../../io/prim-io.fun
-    ../../io/bin-prim-io.sml
-    ../../io/text-prim-io.sml
+      ../../io/io.sig
+      ../../io/io.sml
+      ../../io/prim-io.sig
+      ../../io/prim-io.fun
+      ../../io/bin-prim-io.sml
+      ../../io/text-prim-io.sml
 
-    ../../posix/error.sig
-    ../../posix/error.sml
-    ../../posix/stub-mingw.sml
-    ../../posix/flags.sig
-    ../../posix/flags.sml
-    ../../posix/signal.sig
-    ../../posix/signal.sml
-    ../../posix/proc-env.sig
-    ../../posix/proc-env.sml
-    ../../posix/file-sys.sig
-    ../../posix/file-sys.sml
-    ../../posix/io.sig
-    ../../posix/io.sml
-    ../../posix/process.sig
-    ../../posix/process.sml
-    ../../posix/sys-db.sig
-    ../../posix/sys-db.sml
-    ../../posix/tty.sig
-    ../../posix/tty.sml
-    ../../posix/posix.sig
-    ../../posix/posix.sml
+      ../../posix/error.sig
+      ../../posix/error.sml
+      ../../posix/stub-mingw.sml
+      ../../posix/flags.sig
+      ../../posix/flags.sml
+      ../../posix/signal.sig
+      ../../posix/signal.sml
+      ../../posix/proc-env.sig
+      ../../posix/proc-env.sml
+      ../../posix/file-sys.sig
+      ../../posix/file-sys.sml
+      ../../posix/io.sig
+      ../../posix/io.sml
+      ../../posix/process.sig
+      ../../posix/process.sml
+      ../../posix/sys-db.sig
+      ../../posix/sys-db.sml
+      ../../posix/tty.sig
+      ../../posix/tty.sml
+      ../../posix/posix.sig
+      ../../posix/posix.sml
 
-    ../../platform/cygwin.sml
+      ../../platform/cygwin.sml
 
-    ../../io/stream-io.sig
-    ../../io/stream-io.fun
-    ../../io/imperative-io.sig
-    ../../io/imperative-io.fun
-    ../../io/bin-stream-io.sig
-    ../../io/bin-io.sig
-    ../../io/bin-io.sml
-    ../../io/text-stream-io.sig
-    ../../io/text-io.sig
-    ../../io/text-io.sml
+      ../../io/stream-io.sig
+      ../../io/stream-io.fun
+      ../../io/imperative-io.sig
+      ../../io/imperative-io.fun
+      ../../io/bin-stream-io.sig
+      ../../io/bin-io.sig
+      ../../io/bin-io.sml
+      ../../io/text-stream-io.sig
+      ../../io/text-io.sig
+      ../../io/text-io.sml
 
-    ../../system/path.sig
-    ../../system/path.sml
-    ../../system/file-sys.sig
-    ../../system/file-sys.sml
-    ../../system/command-line.sig
-    ../../system/command-line.sml
+      ../../system/path.sig
+      ../../system/path.sml
+      ../../system/file-sys.sig
+      ../../system/file-sys.sml
+      ../../system/command-line.sig
+      ../../system/command-line.sml
 
-    ../../general/sml90.sig
-    ../../general/sml90.sml
+      ../../general/sml90.sig
+      ../../general/sml90.sml
 
-    ../../mlton/pointer.sig
-    ../../mlton/pointer.sml
-    ../../mlton/call-stack.sig
-    ../../mlton/call-stack.sml
-    ../../mlton/exit.sml
-    ../../mlton/exn.sig
-    ../../mlton/exn.sml
-    ../../mlton/thread.sig
-    ../../mlton/thread.sml
-    ../../mlton/signal.sig
-    ../../mlton/signal.sml
-    ../../mlton/process.sig
-    ../../mlton/process.sml
-    ../../mlton/rusage.sig
-    ../../mlton/rusage.sml
+      ../../mlton/pointer.sig
+      ../../mlton/pointer.sml
+      ../../mlton/call-stack.sig
+      ../../mlton/call-stack.sml
+      ../../mlton/exit.sml
+      ../../mlton/exn.sig
+      ../../mlton/exn.sml
+      ../../mlton/thread.sig
+      ../../mlton/thread.sml
+      ../../mlton/signal.sig
+      ../../mlton/signal.sml
+      ../../mlton/process.sig
+      ../../mlton/process.sml
+      ../../mlton/gc.sig
+      ../../mlton/gc.sml
+      ../../mlton/rusage.sig
+      ../../mlton/rusage.sml
 
-    ../../system/process.sig
-    ../../system/process.sml
-    ../../system/io.sig
-    ../../system/io.sml
-    ../../system/os.sig
-    ../../system/os.sml
-    ../../system/unix.sig
-    ../../system/unix.sml
-    ../../system/timer.sig
-    ../../system/timer.sml
+      ../../system/process.sig
+      ../../system/process.sml
+      ../../system/io.sig
+      ../../system/io.sml
+      ../../system/os.sig
+      ../../system/os.sml
+      ../../system/unix.sig
+      ../../system/unix.sml
+      ../../system/timer.sig
+      ../../system/timer.sml
 
-    ../../net/net.sig
-    ../../net/net.sml
-    ../../net/net-host-db.sig
-    ../../net/net-host-db.sml
-    ../../net/net-prot-db.sig
-    ../../net/net-prot-db.sml
-    ../../net/net-serv-db.sig
-    ../../net/net-serv-db.sml
-    ../../net/socket.sig
-    ../../net/socket.sml
-    ../../net/generic-sock.sig
-    ../../net/generic-sock.sml
-    ../../net/inet-sock.sig
-    ../../net/inet-sock.sml
-    ../../net/unix-sock.sig
-    ../../net/unix-sock.sml
+      ../../net/net.sig
+      ../../net/net.sml
+      ../../net/net-host-db.sig
+      ../../net/net-host-db.sml
+      ../../net/net-prot-db.sig
+      ../../net/net-prot-db.sml
+      ../../net/net-serv-db.sig
+      ../../net/net-serv-db.sml
+      ../../net/socket.sig
+      ../../net/socket.sml
+      ../../net/generic-sock.sig
+      ../../net/generic-sock.sml
+      ../../net/inet-sock.sig
+      ../../net/inet-sock.sml
+      ../../net/unix-sock.sig
+      ../../net/unix-sock.sml
 
-    ../../mlton/array.sig
-    ../../mlton/cont.sig
-    ../../mlton/cont.sml
-    ../../mlton/random.sig
-    ../../mlton/random.sml
-    ../../mlton/io.sig
-    ../../mlton/io.fun
-    ../../mlton/text-io.sig
-    ../../mlton/bin-io.sig
-    ../../mlton/itimer.sig
-    ../../mlton/itimer.sml
-    ../../mlton/ffi.sig
-    ann "ffiStr MLtonFFI" in
-      ../../mlton/ffi.sml
-    end
-    ../../mlton/gc.sig
-    ../../mlton/gc.sml
-    ../../mlton/int-inf.sig
-    ../../mlton/platform.sig
-    ../../mlton/platform.sml
-    ../../mlton/proc-env.sig
-    ../../mlton/proc-env.sml
-    ../../mlton/profile.sig
-    ../../mlton/profile.sml
-    (*
-    # mlton/ptrace.sig
-    # mlton/ptrace.sml
-    *)
-    ../../mlton/rlimit.sig
-    ../../mlton/rlimit.sml
-    ../../mlton/socket.sig
-    ../../mlton/socket.sml
-    ../../mlton/syslog.sig
-    ann "allowImport true" in 
-      ../../mlton/syslog.sml 
-    end
-    ../../mlton/vector.sig
-    ../../mlton/weak.sig
-    ../../mlton/weak.sml
-    ../../mlton/finalizable.sig
-    ../../mlton/finalizable.sml
-    ../../mlton/word.sig
-    ../../mlton/world.sig
-    ../../mlton/world.sml
-    ../../mlton/mlton.sig
-    ../../mlton/mlton.sml
+      ../../mlton/array.sig
+      ../../mlton/cont.sig
+      ../../mlton/cont.sml
+      ../../mlton/random.sig
+      ../../mlton/random.sml
+      ../../mlton/io.sig
+      ../../mlton/io.fun
+      ../../mlton/text-io.sig
+      ../../mlton/bin-io.sig
+      ../../mlton/itimer.sig
+      ../../mlton/itimer.sml
+      ../../mlton/ffi.sig
+      ann 
+         "ffiStr MLtonFFI" 
+      in
+         ../../mlton/ffi.sml
+      end
+      ../../mlton/int-inf.sig
+      ../../mlton/platform.sig
+      ../../mlton/platform.sml
+      ../../mlton/proc-env.sig
+      ../../mlton/proc-env.sml
+      ../../mlton/profile.sig
+      ../../mlton/profile.sml
+      (*
+      # mlton/ptrace.sig
+      # mlton/ptrace.sml
+       *)
+      ../../mlton/rlimit.sig
+      ../../mlton/rlimit.sml
+      ../../mlton/socket.sig
+      ../../mlton/socket.sml
+      ../../mlton/syslog.sig
+      ann
+         "allowFFI true" 
+      in 
+         ../../mlton/syslog.sml 
+      end
+      ../../mlton/vector.sig
+      ../../mlton/weak.sig
+      ../../mlton/weak.sml
+      ../../mlton/finalizable.sig
+      ../../mlton/finalizable.sml
+      ../../mlton/word.sig
+      ../../mlton/world.sig
+      ../../mlton/world.sml
+      ../../mlton/mlton.sig
+      ../../mlton/mlton.sml
 
-    ../../sml-nj/sml-nj.sig
-    ../../sml-nj/sml-nj.sml
-    ../../sml-nj/unsafe.sig
-    ../../sml-nj/unsafe.sml
+      ../../sml-nj/sml-nj.sig
+      ../../sml-nj/sml-nj.sml
+      ../../sml-nj/unsafe.sig
+      ../../sml-nj/unsafe.sml
 
-    top-level/basis.sig
-    ann
-      "allowRebindEquals true"
-    in 
-      top-level/basis.sml 
-    end
-  in
-    structure BasisExtra 
-    top-level/basis-sigs.sml
-    top-level/basis-funs.sml
-    top-level/top-level.sml 
-  end
+      top-level/basis.sig
+      ann
+         "allowRebindEquals true"
+      in 
+         top-level/basis.sml 
+      end
+   in
+      structure BasisExtra 
+      top-level/basis-sigs.sml
+      top-level/basis-funs.sml
+      top-level/top-level.sml 
+   end
 end

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-extra/top-level/basis-funs.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-extra/top-level/basis-funs.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-extra/top-level/basis-funs.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,10 @@
+(* Copyright (C) 2004-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 (* Required functors *)
 
 (* Optional functors *)

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-extra/top-level/basis-sigs.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-extra/top-level/basis-sigs.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-extra/top-level/basis-sigs.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,10 @@
+(* Copyright (C) 2004-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 (* Required signatures *)
 signature ARRAY = ARRAY 
 signature ARRAY_SLICE = ARRAY_SLICE 

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-extra/top-level/basis.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-extra/top-level/basis.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-extra/top-level/basis.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -78,51 +78,51 @@
 *)
       val valOf : 'a option -> 'a 
       val vector : 'a list -> 'a vector
-	
+        
       (* Required structures *)
-      structure Array : ARRAY	
-      structure ArraySlice : ARRAY_SLICE	
-      structure BinIO : BIN_IO	
-      structure BinPrimIO : PRIM_IO	
-      structure Bool : BOOL	
-      structure Byte : BYTE	
-      structure Char : CHAR	
-      structure CharArray : MONO_ARRAY	
-      structure CharArraySlice : MONO_ARRAY_SLICE	
-      structure CharVector : MONO_VECTOR	
-      structure CharVectorSlice : MONO_VECTOR_SLICE	
-      structure CommandLine : COMMAND_LINE	
-      structure Date : DATE	
-      structure General : GENERAL	
-      structure IEEEReal : IEEE_REAL	
-      structure Int : INTEGER	
-      structure IO : IO	
-      structure LargeInt : INTEGER	
-      structure LargeReal : REAL	
-      structure LargeWord : WORD	
-      structure List : LIST	
-      structure ListPair : LIST_PAIR	
-      structure Math : MATH	
-      structure Option : OPTION	
-      structure OS : OS	
-      structure Position : INTEGER	
-      structure Real : REAL	
-      structure StringCvt : STRING_CVT	
-      structure String : STRING	
-      structure Substring : SUBSTRING	
-      structure TextIO : TEXT_IO	
-      structure TextPrimIO : PRIM_IO	
-      structure Text : TEXT	
-      structure Time : TIME	
-      structure Timer : TIMER	
-      structure VectorSlice : VECTOR_SLICE	
-      structure Vector : VECTOR	
-      structure Word : WORD	
-      structure Word8Array : MONO_ARRAY	
-      structure Word8Array2 : MONO_ARRAY2	
-      structure Word8ArraySlice : MONO_ARRAY_SLICE	
-      structure Word8Vector : MONO_VECTOR	
-      structure Word8VectorSlice : MONO_VECTOR_SLICE	
+      structure Array : ARRAY   
+      structure ArraySlice : ARRAY_SLICE        
+      structure BinIO : BIN_IO  
+      structure BinPrimIO : PRIM_IO     
+      structure Bool : BOOL     
+      structure Byte : BYTE     
+      structure Char : CHAR     
+      structure CharArray : MONO_ARRAY  
+      structure CharArraySlice : MONO_ARRAY_SLICE       
+      structure CharVector : MONO_VECTOR        
+      structure CharVectorSlice : MONO_VECTOR_SLICE     
+      structure CommandLine : COMMAND_LINE      
+      structure Date : DATE     
+      structure General : GENERAL       
+      structure IEEEReal : IEEE_REAL    
+      structure Int : INTEGER   
+      structure IO : IO 
+      structure LargeInt : INTEGER      
+      structure LargeReal : REAL        
+      structure LargeWord : WORD        
+      structure List : LIST     
+      structure ListPair : LIST_PAIR    
+      structure Math : MATH     
+      structure Option : OPTION 
+      structure OS : OS 
+      structure Position : INTEGER      
+      structure Real : REAL     
+      structure StringCvt : STRING_CVT  
+      structure String : STRING 
+      structure Substring : SUBSTRING   
+      structure TextIO : TEXT_IO        
+      structure TextPrimIO : PRIM_IO    
+      structure Text : TEXT     
+      structure Time : TIME     
+      structure Timer : TIMER   
+      structure VectorSlice : VECTOR_SLICE      
+      structure Vector : VECTOR 
+      structure Word : WORD     
+      structure Word8Array : MONO_ARRAY 
+      structure Word8Array2 : MONO_ARRAY2       
+      structure Word8ArraySlice : MONO_ARRAY_SLICE      
+      structure Word8Vector : MONO_VECTOR       
+      structure Word8VectorSlice : MONO_VECTOR_SLICE    
 
       (* Optional structures *)
       structure Array2 : ARRAY2
@@ -319,6 +319,7 @@
 
       sharing type MLton.IntInf.t = IntInf.int
       sharing type MLton.Process.pid = Posix.Process.pid
+      sharing type MLton.ProcEnv.gid = Posix.ProcEnv.gid
       sharing type MLton.Signal.t = Posix.Signal.signal
       sharing type MLton.Word.t = Word.word
       sharing type MLton.Word8.t = Word8.word
@@ -327,7 +328,7 @@
       sharing Unsafe.Real64Array = Real64Array
       sharing Unsafe.Word8Array = Word8Array
       sharing Unsafe.Word8Vector = Word8Vector
-	 
+         
       (* ************************************************** *)
       (* ************************************************** *)
 
@@ -432,7 +433,7 @@
       sharing type Word8VectorSlice.vector = Word8Vector.vector
       sharing type Word8Array2.elem = Word8.word
       sharing type Word8Array2.vector = Word8Vector.vector
-	
+        
       (* Optional structures *)
       sharing type BoolArray.vector = BoolVector.vector
       sharing type BoolArraySlice.array = BoolArray.array
@@ -622,6 +623,10 @@
       sharing type Word64VectorSlice.vector = Word64Vector.vector
       sharing type Word64Array2.elem = Word64.word
       sharing type Word64Array2.vector = Word64Vector.vector
+      sharing type MLton.BinIO.instream = BinIO.instream
+      sharing type MLton.BinIO.outstream = BinIO.outstream
+      sharing type MLton.TextIO.instream = TextIO.instream
+      sharing type MLton.TextIO.outstream = TextIO.outstream
    end
    (* bool is already defined as bool and so cannot be shared.
     * So, we where these to get the needed sharing.
@@ -696,6 +701,9 @@
    where type Word8ArraySlice.vector_slice = Word8ArraySlice.vector_slice
    where type Word8Vector.vector = Word8Vector.vector
 
+   where type 'a MLton.Thread.t = 'a MLton.Thread.t
+   where type MLton.Thread.Runnable.t = MLton.Thread.Runnable.t
+
    (* Types that must be exposed because constants denote them. *)
    where type Int1.int = Int1.int
    where type Int2.int = Int2.int
@@ -765,6 +773,3 @@
    where type Word31.word = Word31.word
    where type Word32.word = Word32.word
    where type Word64.word = Word64.word
-
-   where type 'a MLton.Thread.t = 'a MLton.Thread.t
-   where type MLton.Thread.Runnable.t = MLton.Thread.Runnable.t

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-extra/top-level/basis.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-extra/top-level/basis.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-extra/top-level/basis.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,10 @@
+(* Copyright (C) 2004-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 structure BasisExtra :> BASIS_EXTRA = 
    struct
       (* Required structures *)
@@ -239,21 +246,21 @@
       structure MLton = MLton
       structure SMLofNJ = SMLofNJ
       structure Unsafe = Unsafe
-	 
+         
       open ArrayGlobal
-	   BoolGlobal
-	   CharGlobal
-	   IntGlobal
-	   GeneralGlobal
-	   ListGlobal
-	   OptionGlobal
-	   RealGlobal
-	   StringGlobal
-	   RealGlobal
-	   SubstringGlobal
-	   TextIOGlobal
-	   VectorGlobal
-	   WordGlobal
+           BoolGlobal
+           CharGlobal
+           IntGlobal
+           GeneralGlobal
+           ListGlobal
+           OptionGlobal
+           RealGlobal
+           StringGlobal
+           RealGlobal
+           SubstringGlobal
+           TextIOGlobal
+           VectorGlobal
+           WordGlobal
       val real = real
       val op = = op =
       val op <> = op <>

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-extra/top-level/top-level.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-extra/top-level/top-level.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-extra/top-level/top-level.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,10 @@
+(* Copyright (C) 2004-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 local
    open BasisExtra
 in

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-none/top-level/basis.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-none/top-level/basis.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-none/top-level/basis.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1 +1,8 @@
+(* Copyright (C) 2002-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 structure BasisNone : BASIS_NONE = BasisExtra
\ No newline at end of file

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-none/top-level/infixes.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-none/top-level/infixes.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-none/top-level/infixes.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,8 +1,9 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 infix  4 = 

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-none/top-level/top-level.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-none/top-level/top-level.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-none/top-level/top-level.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,10 @@
+(* Copyright (C) 2002-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
 
+
 open BasisNone
 

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/libs/primitive.mlb
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/libs/primitive.mlb	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/libs/primitive.mlb	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,11 +1,19 @@
+(* Copyright (C) 2004-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 ann 
    "allowConstant true"
-   "allowImport true"
+   "allowFFI true"
    "allowPrim true"
    "allowRebindEquals true"
    "deadCode true"
-   "sequenceUnit true"
-   "warnMatch true"
+   "nonexhaustiveMatch warn"
+   "redundantMatch warn"
+   "sequenceNonUnit warn"
    "warnUnused true"
 in
    _prim

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/list/list-pair.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/list/list-pair.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/list/list-pair.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 structure ListPair: LIST_PAIR =
    struct
       exception UnequalLengths
@@ -14,51 +15,51 @@
       fun ul _ = raise UnequalLengths
 
       fun unzip l =
-	 List.foldr (fn ((x, y), (xs, ys)) => (x :: xs, y :: ys)) ([], []) l
+         List.foldr (fn ((x, y), (xs, ys)) => (x :: xs, y :: ys)) ([], []) l
 
       fun foldl' w f b (l1, l2) =
-	 let
-	    fun loop (l1, l2, b) =
-	       case (l1, l2) of
-		  ([], []) => b
-		| (x1 :: l1, x2 :: l2) => loop (l1, l2, f (x1, x2, b))
-		| _ => w b
-	 in
-	    loop (l1, l2, b)
-	 end
+         let
+            fun loop (l1, l2, b) =
+               case (l1, l2) of
+                  ([], []) => b
+                | (x1 :: l1, x2 :: l2) => loop (l1, l2, f (x1, x2, b))
+                | _ => w b
+         in
+            loop (l1, l2, b)
+         end
 
       fun foldl f = foldl' id f
 
       fun foldlEq f = foldl' ul f
 
       fun foldr' w f b (l1, l2) =
-	 let
-	    fun loop (l1, l2) =
-	       case (l1, l2) of
-		  ([], []) => b
-		| (x1 :: l1, x2 :: l2) => f (x1, x2, loop (l1, l2))
-		| _ => w b
-	 in
-	    loop (l1, l2)
-	 end
+         let
+            fun loop (l1, l2) =
+               case (l1, l2) of
+                  ([], []) => b
+                | (x1 :: l1, x2 :: l2) => f (x1, x2, loop (l1, l2))
+                | _ => w b
+         in
+            loop (l1, l2)
+         end
 
       fun foldr f = foldr' id f
-	 
+         
       fun foldrEq f = foldr' ul f
 
       fun zip' w (l1, l2) =
-	 rev (foldl' w (fn (x, x', l) => (x, x') :: l) [] (l1, l2))
+         rev (foldl' w (fn (x, x', l) => (x, x') :: l) [] (l1, l2))
 
       fun zip (l1, l2) = zip' id (l1, l2)
 
       fun zipEq (l1, l2) = zip' ul (l1, l2)
-	 
+         
       fun map' w f = rev o (foldl' w (fn (x1, x2, l) => f (x1, x2) :: l) [])
 
       fun map f = map' id f
 
       fun mapEq f = map' ul f
-	 
+         
       fun app' w f = foldl' w (fn (x1, x2, ()) => f (x1, x2)) ()
 
       fun app f = app' id f
@@ -66,25 +67,25 @@
       fun appEq f = app' ul f
 
       fun exists p (l1, l2) =
-	 let
-	    fun loop (l1, l2) =
-	       case (l1, l2) of
-		  (x1 :: l1, x2 :: l2) => p (x1, x2) orelse loop (l1, l2)
-		| _ => false
-	 in
-	    loop (l1, l2)
-	 end
+         let
+            fun loop (l1, l2) =
+               case (l1, l2) of
+                  (x1 :: l1, x2 :: l2) => p (x1, x2) orelse loop (l1, l2)
+                | _ => false
+         in
+            loop (l1, l2)
+         end
        
       fun all p ls = not (exists (not o p) ls)
 
       fun allEq p =
-	 let
-	    fun loop (l1, l2) =
-	       case (l1, l2) of
-		  ([], []) => true
-		| (x1 :: l1, x2 :: l2) => p (x1, x2) andalso loop (l1, l2)
-		| _ => false
-	 in
-	    loop
-	 end
+         let
+            fun loop (l1, l2) =
+               case (l1, l2) of
+                  ([], []) => true
+                | (x1 :: l1, x2 :: l2) => p (x1, x2) andalso loop (l1, l2)
+                | _ => false
+         in
+            loop
+         end
    end

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/list/list.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/list/list.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/list/list.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,47 +1,48 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 structure List: LIST =
   struct
      open Primitive.Int
-	
+        
      datatype list = datatype list
 
      exception Empty
 
      val null =
-	fn [] => true
-	 | _ => false
+        fn [] => true
+         | _ => false
 
      val hd =
-	fn x :: _ => x
-	 | _ => raise Empty
+        fn x :: _ => x
+         | _ => raise Empty
 
      val tl =
-	fn _ :: l => l
-	 | _ => raise Empty
+        fn _ :: l => l
+         | _ => raise Empty
 
      val rec last =
-	fn [] => raise Empty
-	 | [x] => x
-	 | _ :: l => last l
+        fn [] => raise Empty
+         | [x] => x
+         | _ :: l => last l
 
      val getItem =
-	fn [] => NONE
-	 | x :: r => SOME (x, r)
+        fn [] => NONE
+         | x :: r => SOME (x, r)
    
      fun foldl f b l =
-	let
-	   fun loop (l, b) =
-	      case l of
-		 [] => b
-	       | x :: l => loop (l, f (x, b))
-	in loop (l, b)
-	end
+        let
+           fun loop (l, b) =
+              case l of
+                 [] => b
+               | x :: l => loop (l, f (x, b))
+        in loop (l, b)
+        end
 
      fun length l = foldl (fn (_, n) => n +? 1) 0 l
      
@@ -52,9 +53,9 @@
      fun rev l = appendRev (l, [])
 
      fun l1 @ l2 =
-	case l2 of
-	   [] => l1
-	 | _ => appendRev (rev l1, l2)
+        case l2 of
+           [] => l1
+         | _ => appendRev (rev l1, l2)
 
      fun foldr f b l = foldl f b (rev l)
 
@@ -65,105 +66,105 @@
      fun map f l = rev (foldl (fn (x, l) => f x :: l) [] l)
 
      fun mapPartial pred l =
-	rev (foldl (fn (x, l) => (case pred x of
-				   NONE => l
-				 | SOME y => y :: l))
-		   [] l)
+        rev (foldl (fn (x, l) => (case pred x of
+                                   NONE => l
+                                 | SOME y => y :: l))
+                   [] l)
 
      fun filter pred = mapPartial (fn x => if pred x then SOME x else NONE)
 
      fun partition pred l =
-	let
-	   val (pos, neg) =
-	      foldl (fn (x, (trues, falses)) =>
-		     if pred x then (x :: trues, falses)
-		     else (trues, x :: falses))
-	      ([], []) l
-	in (rev pos, rev neg)
-	end
+        let
+           val (pos, neg) =
+              foldl (fn (x, (trues, falses)) =>
+                     if pred x then (x :: trues, falses)
+                     else (trues, x :: falses))
+              ([], []) l
+        in (rev pos, rev neg)
+        end
 
      fun find pred =
-	let
-	   val rec loop =
-	      fn [] => NONE
-	       | x :: l => if pred x
-			    then SOME x
-			 else loop l
-	in loop
-	end
+        let
+           val rec loop =
+              fn [] => NONE
+               | x :: l => if pred x
+                            then SOME x
+                         else loop l
+        in loop
+        end
      
      fun exists pred l =
-	case find pred l of
-	   NONE => false
-	 | SOME _ => true
+        case find pred l of
+           NONE => false
+         | SOME _ => true
      
      fun all pred = not o (exists (not o pred))
 
      fun tabulate (n, f) = 
-	if Primitive.safe andalso n < 0
-	   then raise Size
-	else let
-		fun loop (i, ac) =
-		   if i < n
-		      then loop (i + 1, f i :: ac)
-		   else rev ac
-	     in loop (0, [])
-	     end
+        if Primitive.safe andalso n < 0
+           then raise Size
+        else let
+                fun loop (i, ac) =
+                   if i < n
+                      then loop (i + 1, f i :: ac)
+                   else rev ac
+             in loop (0, [])
+             end
 
      fun nth (l, n) =
-	let
-	   fun loop (l, n) =
-	      case l of
-		 [] => raise Subscript
-	       | x :: l =>
-		    if n > 0
-		       then loop (l, n - 1)
-		    else x
-	in
-	   if Primitive.safe andalso n < 0
-	      then raise Subscript
-	   else loop (l, n)
-	end
+        let
+           fun loop (l, n) =
+              case l of
+                 [] => raise Subscript
+               | x :: l =>
+                    if n > 0
+                       then loop (l, n - 1)
+                    else x
+        in
+           if Primitive.safe andalso n < 0
+              then raise Subscript
+           else loop (l, n)
+        end
 
      fun take (l, n) =
-	let
-	   fun loop (l, n, ac) =
-	      if n > 0
-		 then (case l of
-			  [] => raise Subscript
-			| x :: l => loop (l, n - 1, x :: ac))
-	      else rev ac
-	in
-	   if Primitive.safe andalso n < 0
-	      then raise Subscript
-	   else loop (l, n, [])
-	end
+        let
+           fun loop (l, n, ac) =
+              if n > 0
+                 then (case l of
+                          [] => raise Subscript
+                        | x :: l => loop (l, n - 1, x :: ac))
+              else rev ac
+        in
+           if Primitive.safe andalso n < 0
+              then raise Subscript
+           else loop (l, n, [])
+        end
 
      fun drop (l, n) =
-	let
-	   fun loop (l, n) =
-	      if n > 0
-		 then (case l of
-			  [] => raise Subscript
-			| _ :: l => loop (l, n - 1))
-	      else l
-	in
-	   if Primitive.safe andalso n < 0
-	      then raise Subscript
-	   else loop (l, n)
-	end
+        let
+           fun loop (l, n) =
+              if n > 0
+                 then (case l of
+                          [] => raise Subscript
+                        | _ :: l => loop (l, n - 1))
+              else l
+        in
+           if Primitive.safe andalso n < 0
+              then raise Subscript
+           else loop (l, n)
+        end
 
      fun collate cmp =
         let
-	   val rec loop =
-	     fn ([], []) => EQUAL
-	      | ([], _) => LESS
-	      | (_, []) => GREATER
-	      | (x1::l1,x2::l2) => (case cmp (x1, x2) of
-				      EQUAL => loop (l1, l2)
-				    | ans => ans)
-	in loop
-	end
+           val rec loop =
+             fn ([], []) => EQUAL
+              | ([], _) => LESS
+              | (_, []) => GREATER
+              | (x1::l1,x2::l2) => (case cmp (x1, x2) of
+                                      EQUAL => loop (l1, l2)
+                                    | ans => ans)
+        in loop
+        end
   end
 
 structure ListGlobal: LIST_GLOBAL = List

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/misc/C.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/misc/C.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/misc/C.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,36 +1,37 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature C =
    sig
       (* C char* *)
       structure CS :
-	 sig
-	    type t
+         sig
+            type t
 
-	    (* string must be null terminated *)
-	    val length: t -> int
-	    val sub: t * int -> char
-	    val toCharArrayOfLength: t * int -> char array
-	    (* string must be null terminated *)
-	    val toString: t -> string
-	    (* extract first n characters of string *)
-	    val toStringOfLength: t * int -> string
-	    val update: t * int * char -> unit
-	 end
+            (* string must be null terminated *)
+            val length: t -> int
+            val sub: t * int -> char
+            val toCharArrayOfLength: t * int -> char array
+            (* string must be null terminated *)
+            val toString: t -> string
+            (* extract first n characters of string *)
+            val toStringOfLength: t * int -> string
+            val update: t * int * char -> unit
+         end
 
       (* NULL terminated char** *)
       structure CSS:
-	 sig
-	    type t
+         sig
+            type t
 
-	    val fromList: string list -> NullString.t array
-	    (* extract first n strings from array *)
-	    val toArrayOfLength: t * int -> string array
-	    val toList: t -> string list
-	 end
+            val fromList: string list -> NullString.t array
+            (* extract first n strings from array *)
+            val toArrayOfLength: t * int -> string array
+            val toList: t -> string list
+         end
    end

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/misc/C.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/misc/C.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/misc/C.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,87 +1,88 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 structure C: C =
    struct
       open Int
-	 
+         
       fun makeLength (sub, term) p =
-	 let
-	    fun loop i =
-	       if term (sub (p, i))
-		  then i
-	       else loop (i +? 1)
-	 in loop 0
-	 end
+         let
+            fun loop i =
+               if term (sub (p, i))
+                  then i
+               else loop (i +? 1)
+         in loop 0
+         end
 
       fun toArrayOfLength (s: 'a,
-			   sub: 'a * int -> 'b,
-			   n: int) : 'b array =
-	 let
-	    val a = Primitive.Array.array n
-	    fun loop i =
-	       if i >= n
-		  then ()
-	       else (Array.update (a, i, sub (s, i))
-		     ; loop (i + 1))
-	 in loop 0;
-	    a
-	 end
+                           sub: 'a * int -> 'b,
+                           n: int) : 'b array =
+         let
+            val a = Primitive.Array.array n
+            fun loop i =
+               if i >= n
+                  then ()
+               else (Array.update (a, i, sub (s, i))
+                     ; loop (i + 1))
+         in loop 0;
+            a
+         end
 
       structure CS =
-	 struct
-	    type t = Pointer.t
+         struct
+            type t = Pointer.t
 
-	    fun sub (cs, i) =
-	       Primitive.Char.fromWord8 (Primitive.Pointer.getWord8 (cs, i))
+            fun sub (cs, i) =
+               Primitive.Char.fromWord8 (Primitive.Pointer.getWord8 (cs, i))
 
-	    fun update (cs, i, c) =
-	       Primitive.Pointer.setWord8 (cs, i, Primitive.Char.toWord8 c)
+            fun update (cs, i, c) =
+               Primitive.Pointer.setWord8 (cs, i, Primitive.Char.toWord8 c)
 
-	    fun toCharArrayOfLength (cs, n) = toArrayOfLength (cs, sub, n)
+            fun toCharArrayOfLength (cs, n) = toArrayOfLength (cs, sub, n)
 
-	    fun toStringOfLength cs =
-	       String.fromArray (CharArray.fromPoly (toCharArrayOfLength cs))
+            fun toStringOfLength cs =
+               String.fromArray (CharArray.fromPoly (toCharArrayOfLength cs))
 
-	    val length = makeLength (sub, fn #"\000" => true | _ => false)
+            val length = makeLength (sub, fn #"\000" => true | _ => false)
 
-	    fun toString cs = toStringOfLength (cs, length cs)
-	 end
+            fun toString cs = toStringOfLength (cs, length cs)
+         end
       
       structure CSS =
-	 struct
-	    type t = Pointer.t
+         struct
+            type t = Pointer.t
 
-	    fun sub (css: t, i) = Primitive.Pointer.getPointer (css, i)
+            fun sub (css: t, i) = Primitive.Pointer.getPointer (css, i)
 
-	    val length = makeLength (sub, Primitive.Pointer.isNull)
+            val length = makeLength (sub, Primitive.Pointer.isNull)
 
-	    val toArrayOfLength =
-	       fn (css, n) => toArrayOfLength (css, CS.toString o sub, n)
+            val toArrayOfLength =
+               fn (css, n) => toArrayOfLength (css, CS.toString o sub, n)
 
-	    fun toArray css = toArrayOfLength (css, length css)
+            fun toArray css = toArrayOfLength (css, length css)
 
-	    val toList = Array.toList o toArray
+            val toList = Array.toList o toArray
 
-	    (* The C side converts the last element of the array, "",
-	     * to the null terminator that C primitives expect.
-	     * As far as C can tell, the other elements of the array
-	     * are just char*'s.
-	     *)
-	    fun fromList l =
-	       let
-		  val a = Array.array (1 +? List.length l, NullString.empty)
-		  val _ =
-		     List.foldl (fn (s, i) =>
-				 (Array.update (a, i, NullString.nullTerm s)
-				  ; i +? 1))
-		     0 l
-	       in
-		  a
-	       end
-	 end
+            (* The C side converts the last element of the array, "",
+             * to the null terminator that C primitives expect.
+             * As far as C can tell, the other elements of the array
+             * are just char*'s.
+             *)
+            fun fromList l =
+               let
+                  val a = Array.array (1 +? List.length l, NullString.empty)
+                  val _ =
+                     List.foldl (fn (s, i) =>
+                                 (Array.update (a, i, NullString.nullTerm s)
+                                  ; i +? 1))
+                     0 l
+               in
+                  a
+               end
+         end
    end

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/misc/basic.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/misc/basic.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/misc/basic.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,9 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 (* Integer arithmetic without overflow checking. *)

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/misc/cleaner.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/misc/cleaner.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/misc/cleaner.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature CLEANER =
    sig
       type t

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/misc/cleaner.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/misc/cleaner.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/misc/cleaner.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 structure Cleaner: CLEANER =
 struct
 

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/misc/dynamic-wind.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/misc/dynamic-wind.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/misc/dynamic-wind.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,27 @@
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 structure DynamicWind: DYNAMIC_WIND =
 struct
 
-fun wind(thunk, cleanup) =
-   let val a = thunk()
-   in cleanup(); a
-   end handle exn => (cleanup(); raise exn)
+fun try (f: unit -> 'a, k: 'a -> 'b, h: exn -> 'b) =
+   let
+      datatype t =
+         A of 'a
+       | E of exn
+   in
+      case A (f ()) handle e => E e of
+         A a => k a
+       | E e => h e
+   end
+         
+fun wind (thunk, cleanup: unit -> unit) =
+   try (thunk, fn a => (cleanup (); a), fn e => (cleanup (); raise e))
 
 end
 

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/misc/primitive.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/misc/primitive.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/misc/primitive.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,9 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 (* Primitive names are special -- see atoms/prim.fun. *)
@@ -155,12 +155,17 @@
       type t = pointer
    end
 
+structure GetSet =
+   struct
+      type 'a t = (unit -> 'a) * ('a -> unit)
+   end
+
 structure Pid :> sig
-		    eqtype t
+                    eqtype t
 
-		    val fromInt: int -> t
-		    val toInt: t -> int
-		 end =
+                    val fromInt: int -> t
+                    val toInt: t -> int
+                 end =
    struct
       type t = int
 
@@ -171,15 +176,19 @@
    
 exception Fail of string
 exception Match = Match
-exception Overflow = Overflow
+exception PrimitiveOverflow = Overflow
+exception Overflow
 exception Size
 
+val wrapOverflow: ('a -> 'b) -> ('a -> 'b) =
+   fn f => fn a => f a handle PrimitiveOverflow => raise Overflow
+
 datatype 'a option = NONE | SOME of 'a
 
 fun not b = if b then false else true
    
 functor Comparisons (type t
-		     val < : t * t -> bool) =
+                     val < : t * t -> bool) =
    struct
       fun <= (a, b) = not (< (b, a))
       fun > (a, b) = < (b, a)
@@ -187,8 +196,8 @@
    end
 
 functor RealComparisons (type t
-			 val < : t * t -> bool
-			 val <= : t * t -> bool) =
+                         val < : t * t -> bool
+                         val <= : t * t -> bool) =
    struct
       fun > (a, b) = < (b, a)
       fun >= (a, b) = <= (b, a)
@@ -196,1919 +205,1988 @@
 
 structure Primitive =
    struct
-      val bug = _import "MLton_bug" : NullString.t -> unit;
+      val bug = _import "MLton_bug": NullString.t -> unit;
+      val debug = _command_line_const "MLton.debug": bool = false;
       val detectOverflow =
-	 _command_line_const "MLton.detectOverflow": bool = true;
+         _command_line_const "MLton.detectOverflow": bool = true;
       val eq = _prim "MLton_eq": 'a * 'a -> bool;
       (* val errno = _import "MLton_errno": unit -> int; *)
       val installSignalHandler =
-	 _prim "MLton_installSignalHandler": unit -> unit;
+         _prim "MLton_installSignalHandler": unit -> unit;
       val safe = _command_line_const "MLton.safe": bool = true;
       val touch = _prim "MLton_touch": 'a -> unit;
       val usesCallcc: bool ref = ref false;
 
       structure Stdio =
-	 struct
-	    val print = _import "Stdio_print": string -> unit;
-	    (* val sprintf = _import "Stdio_sprintf": char array * nullString * real -> int; *)
-	 end
+         struct
+            val print = _import "Stdio_print": string -> unit;
+            (* val sprintf = _import "Stdio_sprintf": char array * nullString * real -> int; *)
+         end
 
       structure Array =
-	 struct
-	    val array0Const = _prim "Array_array0Const": unit -> 'a array;
-	    val length = _prim "Array_length": 'a array -> int;
-	    (* There is no maximum length on arrays, so maxLen = maxInt. *)
-	    val maxLen: int = 0x7FFFFFFF
-	    val sub = _prim "Array_sub": 'a array * int -> 'a;
-	    val update = _prim "Array_update": 'a array * int * 'a -> unit;
-	 end
+         struct
+            val array0Const = _prim "Array_array0Const": unit -> 'a array;
+            val length = _prim "Array_length": 'a array -> int;
+            (* There is no maximum length on arrays, so maxLen = maxInt. *)
+            val maxLen: int = 0x7FFFFFFF
+            val sub = _prim "Array_sub": 'a array * int -> 'a;
+            val update = _prim "Array_update": 'a array * int * 'a -> unit;
+         end
 
       structure CString =
-	 struct
-	    type t = Pointer.t
-	 end
+         struct
+            type t = Pointer.t
+         end
       structure CStringArray =
-	 struct
-	    type t = Pointer.t
-	 end
+         struct
+            type t = Pointer.t
+         end
 
       structure GCState =
-	 struct
-	    type t = Pointer.t
+         struct
+            type t = Pointer.t
 
-	    val gcState = _import "gcStateAddress": t;
-	 end
+            val gcState = #1 _symbol "gcStateAddress": t GetSet.t; ()
+         end
       
       structure CallStack =
-	 struct
-	    (* The most recent caller is at index 0 in the array. *)
-	    datatype t = T of int array
+         struct
+            (* The most recent caller is at index 0 in the array. *)
+            datatype t = T of int array
 
-	    val callStack =
-	       _import "GC_callStack": GCState.t * int array -> unit;
-	    val frameIndexSourceSeq =
-	       _import "GC_frameIndexSourceSeq": GCState.t * int -> Pointer.t;
-	    val keep = _command_line_const "CallStack.keep": bool = false;
-	    val numStackFrames =
-	       _import "GC_numStackFrames": GCState.t -> int;
-	    val sourceName = _import "GC_sourceName": GCState.t * int -> CString.t;
-	 end
+            val callStack =
+               _import "GC_callStack": GCState.t * int array -> unit;
+            val frameIndexSourceSeq =
+               _import "GC_frameIndexSourceSeq": GCState.t * int -> Pointer.t;
+            val keep = _command_line_const "CallStack.keep": bool = false;
+            val numStackFrames =
+               _import "GC_numStackFrames": GCState.t -> int;
+            val sourceName = _import "GC_sourceName": GCState.t * int -> CString.t;
+         end
 
       structure Char =
-	 struct
-	    open Char
-	       
-	    val op < = _prim "WordU8_lt": char * char -> bool;
-	    val chr = _prim "WordS32_toWord8": int -> char;
-	    val ord = _prim "WordU8_toWord32": char -> int;
-	    val toInt8 = _prim "WordS8_toWord8": char -> Int8.int;
-	    val fromInt8 = _prim "WordS8_toWord8": Int8.int -> char;
-	    val toWord8 = _prim "WordU8_toWord8": char -> Word8.word;
-	    val fromWord8 = _prim "WordU8_toWord8": Word8.word -> char;
-	 end
+         struct
+            open Char
+               
+            val op < = _prim "WordU8_lt": char * char -> bool;
+            val chr = _prim "WordS32_toWord8": int -> char;
+            val ord = _prim "WordU8_toWord32": char -> int;
+            val toInt8 = _prim "WordS8_toWord8": char -> Int8.int;
+            val fromInt8 = _prim "WordS8_toWord8": Int8.int -> char;
+            val toWord8 = _prim "WordU8_toWord8": char -> Word8.word;
+            val fromWord8 = _prim "WordU8_toWord8": Word8.word -> char;
+         end
 
       structure Char =
-	 struct
-	    open Char
-	    local
-	       structure S = Comparisons (Char)
-	    in
-	       open S
-	    end
-	 end
+         struct
+            open Char
+            local
+               structure S = Comparisons (Char)
+            in
+               open S
+            end
+         end
 
       structure Char2 =
-	 struct
-	    open Char2
+         struct
+            open Char2
 
-	    val op < = _prim "WordU16_lt": char * char -> bool;
-	    val chr = _prim "WordS32_toWord16": int -> char;
-	    val ord = _prim "WordU16_toWord32": char -> int;
-	    val toInt16 = _prim "WordS16_toWord16": char -> Int16.int;
-	    val fromInt16 = _prim "WordS16_toWord16": Int16.int -> char;
-	    (* val toWord16 = _prim "WordU16_toWord16": char -> Word16.word; *)
-	    (* val fromWord16 = _prim "WordU16_toWord16": Word16.word -> char; *)
-	 end
+            val op < = _prim "WordU16_lt": char * char -> bool;
+            val chr = _prim "WordS32_toWord16": int -> char;
+            val ord = _prim "WordU16_toWord32": char -> int;
+            val toInt16 = _prim "WordS16_toWord16": char -> Int16.int;
+            val fromInt16 = _prim "WordS16_toWord16": Int16.int -> char;
+            (* val toWord16 = _prim "WordU16_toWord16": char -> Word16.word; *)
+            (* val fromWord16 = _prim "WordU16_toWord16": Word16.word -> char; *)
+         end
       
       structure Char4 =
-	 struct
-	    open Char4
+         struct
+            open Char4
 
-	    val op < = _prim "WordU32_lt": char * char -> bool;
-	    val chr = _prim "WordS32_toWord32": int -> char;
-	    val ord = _prim "WordU32_toWord32": char -> int;
-	    val toInt32 = _prim "WordS32_toWord32": char -> Int32.int;
-	    val fromInt32 = _prim "WordS32_toWord32": Int32.int -> char;
-	    (* val toWord32 = _prim "WordU32_toWord32": char -> Word32.word; *)
-	    (* val fromWord32 = _prim "WordU32_toWord32": Word32.word -> char; *)
-	 end
+            val op < = _prim "WordU32_lt": char * char -> bool;
+            val chr = _prim "WordS32_toWord32": int -> char;
+            val ord = _prim "WordU32_toWord32": char -> int;
+            val toInt32 = _prim "WordS32_toWord32": char -> Int32.int;
+            val fromInt32 = _prim "WordS32_toWord32": Int32.int -> char;
+            (* val toWord32 = _prim "WordU32_toWord32": char -> Word32.word; *)
+            (* val fromWord32 = _prim "WordU32_toWord32": Word32.word -> char; *)
+         end
 
       structure CommandLine =
-	 struct
-	    val argc = fn () => _import "CommandLine_argc": int;
-	    val argv = fn () => _import "CommandLine_argv": CStringArray.t;
-	    val commandName =
-	       fn () => _import "CommandLine_commandName": CString.t;
-	 end
+         struct
+            val argc = #1 _symbol "CommandLine_argc": int GetSet.t;
+            val argv = #1 _symbol "CommandLine_argv": CStringArray.t GetSet.t;
+            val commandName = #1 _symbol "CommandLine_commandName": CString.t GetSet.t;
+         end
 
       structure Date =
-	 struct
-	    type time = int
-	    type size = int
+         struct
+            type time = int
+            type size = int
 
-	    structure Tm =
-	       struct
-		  val sec = _import "Date_Tm_sec": unit -> int;
-		  val min = _import "Date_Tm_min": unit -> int;
-		  val hour = _import "Date_Tm_hour": unit -> int;
-		  val mday = _import "Date_Tm_mday": unit -> int;
-		  val mon = _import "Date_Tm_mon": unit -> int;
-		  val year = _import "Date_Tm_year": unit -> int;
-		  val wday = _import "Date_Tm_wday": unit -> int;
-		  val yday = _import "Date_Tm_yday": unit -> int;
-		  val isdst = _import "Date_Tm_isdst": unit -> int;
+            structure Tm =
+               struct
+                  val sec = _import "Date_Tm_sec": unit -> int;
+                  val min = _import "Date_Tm_min": unit -> int;
+                  val hour = _import "Date_Tm_hour": unit -> int;
+                  val mday = _import "Date_Tm_mday": unit -> int;
+                  val mon = _import "Date_Tm_mon": unit -> int;
+                  val year = _import "Date_Tm_year": unit -> int;
+                  val wday = _import "Date_Tm_wday": unit -> int;
+                  val yday = _import "Date_Tm_yday": unit -> int;
+                  val isdst = _import "Date_Tm_isdst": unit -> int;
 
-		  val setSec = _import "Date_Tm_setSec": int -> unit;
-		  val setMin = _import "Date_Tm_setMin": int -> unit;
-		  val setHour = _import "Date_Tm_setHour": int -> unit;
-		  val setMday = _import "Date_Tm_setMday": int -> unit;
-		  val setMon = _import "Date_Tm_setMon": int -> unit;
-		  val setYear = _import "Date_Tm_setYear": int -> unit;
-		  val setWday = _import "Date_Tm_setWday": int -> unit;
-		  val setYday = _import "Date_Tm_setYday": int -> unit;
-		  val setIsdst = _import "Date_Tm_setIsdst": int -> unit;
-	       end
-	       
-	    val gmTime = _import "Date_gmTime": time ref -> unit;
-	    val localOffset = _import "Date_localOffset": unit -> int;
-	    val localTime = _import "Date_localTime": time ref -> unit;
-	    val mkTime = _import "Date_mkTime": unit -> time;
-	    val strfTime =
-	       _import "Date_strfTime": char array * size * NullString.t -> size;
-	 end
+                  val setSec = _import "Date_Tm_setSec": int -> unit;
+                  val setMin = _import "Date_Tm_setMin": int -> unit;
+                  val setHour = _import "Date_Tm_setHour": int -> unit;
+                  val setMday = _import "Date_Tm_setMday": int -> unit;
+                  val setMon = _import "Date_Tm_setMon": int -> unit;
+                  val setYear = _import "Date_Tm_setYear": int -> unit;
+                  val setWday = _import "Date_Tm_setWday": int -> unit;
+                  val setYday = _import "Date_Tm_setYday": int -> unit;
+                  val setIsdst = _import "Date_Tm_setIsdst": int -> unit;
+               end
+               
+            val gmTime = _import "Date_gmTime": time ref -> unit;
+            val localOffset = _import "Date_localOffset": unit -> int;
+            val localTime = _import "Date_localTime": time ref -> unit;
+            val mkTime = _import "Date_mkTime": unit -> time;
+            val strfTime =
+               _import "Date_strfTime": char array * size * NullString.t -> size;
+         end
     
       structure Exn =
-	 struct
-	    (* The polymorphism with extra and setInitExtra is because primitives
-	     * are only supposed to deal with basic types.  The polymorphism
-	     * allows the various passes like monomorphisation to translate
-	     * the types appropriately.
-	     *)
-	    type extra = CallStack.t option
+         struct
+            (* The polymorphism with extra and setInitExtra is because primitives
+             * are only supposed to deal with basic types.  The polymorphism
+             * allows the various passes like monomorphisation to translate
+             * the types appropriately.
+             *)
+            type extra = CallStack.t option
 
-	    val extra = _prim "Exn_extra": exn -> 'a;
-	    val extra: exn -> extra = extra
-	    val name = _prim "Exn_name": exn -> string;
-	    val keepHistory =
-	       _command_line_const "Exn.keepHistory": bool = false;
-	    val setExtendExtra = _prim "Exn_setExtendExtra": ('a -> 'a) -> unit;
-	    val setExtendExtra: (extra -> extra) -> unit = setExtendExtra
-	    val setInitExtra = _prim "Exn_setInitExtra": 'a -> unit;
-	    val setInitExtra: extra -> unit = setInitExtra
-	 end
+            val extra = _prim "Exn_extra": exn -> 'a;
+            val extra: exn -> extra = extra
+            val name = _prim "Exn_name": exn -> string;
+            val keepHistory =
+               _command_line_const "Exn.keepHistory": bool = false;
+            val setExtendExtra = _prim "Exn_setExtendExtra": ('a -> 'a) -> unit;
+            val setExtendExtra: (extra -> extra) -> unit = setExtendExtra
+            val setInitExtra = _prim "Exn_setInitExtra": 'a -> unit;
+            val setInitExtra: extra -> unit = setInitExtra
+         end
 
       structure FFI =
-	 struct
-	    val getOp = fn () => _import "MLton_FFI_op": int;
-	    val int8Array = _import "MLton_FFI_Int8": Pointer.t;
-	    val int16Array = _import "MLton_FFI_Int16": Pointer.t;
-	    val int32Array = _import "MLton_FFI_Int32": Pointer.t;
-	    val int64Array = _import "MLton_FFI_Int64": Pointer.t;
-	    val numExports = _build_const "MLton_FFI_numExports": int;
-	    val pointerArray = _import "MLton_FFI_Pointer": Pointer.t;
-	    val real32Array = _import "MLton_FFI_Real32": Pointer.t;
-	    val real64Array = _import "MLton_FFI_Real64": Pointer.t;
-	    val word8Array = _import "MLton_FFI_Word8": Pointer.t;
-	    val word16Array = _import "MLton_FFI_Word16": Pointer.t;
-	    val word32Array = _import "MLton_FFI_Word32": Pointer.t;
-	    val word64Array = _import "MLton_FFI_Word64": Pointer.t;
-	 end
+         struct
+            val getOp = #1 _symbol "MLton_FFI_op": int GetSet.t;
+            val int8Array = #1 _symbol "MLton_FFI_Int8": Pointer.t GetSet.t; ()
+            val int16Array = #1 _symbol "MLton_FFI_Int16": Pointer.t GetSet.t; ()
+            val int32Array = #1 _symbol "MLton_FFI_Int32": Pointer.t GetSet.t; ()
+            val int64Array = #1 _symbol "MLton_FFI_Int64": Pointer.t GetSet.t; ()
+            val numExports = _build_const "MLton_FFI_numExports": int;
+            val pointerArray = #1 _symbol "MLton_FFI_Pointer": Pointer.t GetSet.t; ()
+            val real32Array = #1 _symbol "MLton_FFI_Real32": Pointer.t GetSet.t; ()
+            val real64Array = #1 _symbol "MLton_FFI_Real64": Pointer.t GetSet.t; ()
+            val word8Array = #1 _symbol "MLton_FFI_Word8": Pointer.t GetSet.t; ()
+            val word16Array = #1 _symbol "MLton_FFI_Word16": Pointer.t GetSet.t; ()
+            val word32Array = #1 _symbol "MLton_FFI_Word32": Pointer.t GetSet.t; ()
+            val word64Array = #1 _symbol "MLton_FFI_Word64": Pointer.t GetSet.t; ()
+         end
 
       structure GC =
-	 struct
-	    val collect = _prim "GC_collect": unit -> unit;
-	    val pack = _import "MLton_GC_pack": unit -> unit;
-	    val setHashConsDuringGC =
-	       _import "GC_setHashConsDuringGC": bool -> unit;
-	    val setMessages = _import "GC_setMessages": bool -> unit;
-	    val setSummary = _import "GC_setSummary": bool -> unit;
-	    val unpack = _import "MLton_GC_unpack": unit -> unit;
-	 end
+         struct
+            val collect = _prim "GC_collect": unit -> unit;
+            val pack = _import "MLton_GC_pack": unit -> unit;
+            val setHashConsDuringGC =
+               _import "GC_setHashConsDuringGC": bool -> unit;
+            val setMessages = _import "GC_setMessages": bool -> unit;
+            val setRusageMeasureGC = _import "GC_setRusageMeasureGC": bool -> unit;
+            val setSummary = _import "GC_setSummary": bool -> unit;
+            val unpack = _import "MLton_GC_unpack": unit -> unit;
+         end
       
       structure IEEEReal =
-	 struct
-	    structure RoundingMode =
-	       struct
-		  type t = int
-		     
-		  val toNearest = _const "FE_TONEAREST": t;
-		  val downward = _const "FE_DOWNWARD": t;
-		  val noSupport = _const "FE_NOSUPPORT": t;
-		  val upward = _const "FE_UPWARD": t;
-		  val towardZero = _const "FE_TOWARDZERO": t;
-	       end
-	    
-	    val getRoundingMode =
-	       _import "IEEEReal_getRoundingMode": unit -> int;
-	    val setRoundingMode =
-	       _import "IEEEReal_setRoundingMode": int -> unit;
-	 end
+         struct
+            structure RoundingMode =
+               struct
+                  type t = int
+                     
+                  val toNearest = _const "FE_TONEAREST": t;
+                  val downward = _const "FE_DOWNWARD": t;
+                  val noSupport = _const "FE_NOSUPPORT": t;
+                  val upward = _const "FE_UPWARD": t;
+                  val towardZero = _const "FE_TOWARDZERO": t;
+               end
+            
+            val getRoundingMode =
+               _import "IEEEReal_getRoundingMode": unit -> int;
+            val setRoundingMode =
+               _import "IEEEReal_setRoundingMode": int -> unit;
+         end
 
       structure Int1 =
-	 struct
-	    type big = Int8.int
-	    type int = int1
-	    val fromBigUnsafe = _prim "WordU8_toWord1": big -> int;
-	    val precision' = 1
-	    val toBig = _prim "WordU1_toWord8": int -> big;
-	 end
+         struct
+            type big = Int8.int
+            type int = int1
+            val fromBigUnsafe = _prim "WordU8_toWord1": big -> int;
+            val precision' = 1
+            val toBig = _prim "WordU1_toWord8": int -> big;
+         end
       structure Int2 =
-	 struct
-	    type big = Int8.int
-	    type int = int2
-	    val fromBigUnsafe = _prim "WordU8_toWord2": big -> int;
-	    val precision' = 2
-	    val toBig = _prim "WordU2_toWord8": int -> big;
-	 end
+         struct
+            type big = Int8.int
+            type int = int2
+            val fromBigUnsafe = _prim "WordU8_toWord2": big -> int;
+            val precision' = 2
+            val toBig = _prim "WordU2_toWord8": int -> big;
+         end
       structure Int3 =
-	 struct
-	    type big = Int8.int
-	    type int = int3
-	    val fromBigUnsafe = _prim "WordU8_toWord3": big -> int;
-	    val precision' = 3
-	    val toBig = _prim "WordU3_toWord8": int -> big;
-	 end
+         struct
+            type big = Int8.int
+            type int = int3
+            val fromBigUnsafe = _prim "WordU8_toWord3": big -> int;
+            val precision' = 3
+            val toBig = _prim "WordU3_toWord8": int -> big;
+         end
       structure Int4 =
-	 struct
-	    type big = Int8.int
-	    type int = int4
-	    val fromBigUnsafe = _prim "WordU8_toWord4": big -> int;
-	    val precision' = 4
-	    val toBig = _prim "WordU4_toWord8": int -> big;
-	 end
+         struct
+            type big = Int8.int
+            type int = int4
+            val fromBigUnsafe = _prim "WordU8_toWord4": big -> int;
+            val precision' = 4
+            val toBig = _prim "WordU4_toWord8": int -> big;
+         end
       structure Int5 =
-	 struct
-	    type big = Int8.int
-	    type int = int5
-	    val fromBigUnsafe = _prim "WordU8_toWord5": big -> int;
-	    val precision' = 5
-	    val toBig = _prim "WordU5_toWord8": int -> big;
-	 end
+         struct
+            type big = Int8.int
+            type int = int5
+            val fromBigUnsafe = _prim "WordU8_toWord5": big -> int;
+            val precision' = 5
+            val toBig = _prim "WordU5_toWord8": int -> big;
+         end
       structure Int6 =
-	 struct
-	    type big = Int8.int
-	    type int = int6
-	    val fromBigUnsafe = _prim "WordU8_toWord6": big -> int;
-	    val precision' = 6
-	    val toBig = _prim "WordU6_toWord8": int -> big;
-	 end
+         struct
+            type big = Int8.int
+            type int = int6
+            val fromBigUnsafe = _prim "WordU8_toWord6": big -> int;
+            val precision' = 6
+            val toBig = _prim "WordU6_toWord8": int -> big;
+         end
       structure Int7 =
-	 struct
-	    type big = Int8.int
-	    type int = int7
-	    val fromBigUnsafe = _prim "WordU8_toWord7": big -> int;
-	    val precision' = 7
-	    val toBig = _prim "WordU7_toWord8": int -> big;
-	 end
+         struct
+            type big = Int8.int
+            type int = int7
+            val fromBigUnsafe = _prim "WordU8_toWord7": big -> int;
+            val precision' = 7
+            val toBig = _prim "WordU7_toWord8": int -> big;
+         end
       structure Int8 =
-	 struct
-	    type t = Int8.int
-	    type int = t
-	       
-	    val precision' : Int.int = 8
-	    val maxInt' : int = 0x7f
-	    val minInt' : int = ~0x80
+         struct
+            type t = Int8.int
+            type int = t
+               
+            val precision' : Int.int = 8
+            val maxInt' : int = 0x7f
+            val minInt' : int = ~0x80
 
-	    val *? = _prim "WordS8_mul": int * int -> int;
-	    val * =
-	       if detectOverflow
-		  then _prim "WordS8_mulCheck": int * int -> int;
-	       else *?
-	    val +? = _prim "Word8_add": int * int -> int;
-	    val + =
-	       if detectOverflow
-		  then _prim "WordS8_addCheck": int * int -> int;
-	       else +?
-	    val -? = _prim "Word8_sub": int * int -> int;
-	    val - =
-	       if detectOverflow
-		  then _prim "WordS8_subCheck": int * int -> int;
-	       else -?
-	    val op < = _prim "WordS8_lt": int * int -> bool;
-	    val quot = _prim "WordS8_quot": int * int -> int;
-	    val rem = _prim "WordS8_rem": int * int -> int;
-	    val << = _prim "Word8_lshift": int * Word.word -> int;
-	    val >> = _prim "WordU8_rshift": int * Word.word -> int;
-	    val ~>> = _prim "WordS8_rshift": int * Word.word -> int;
-	    val ~? = _prim "Word8_neg": int -> int; 
-	    val ~ =
-	       if detectOverflow
-		  then _prim "Word8_negCheck": int -> int;
-	       else ~?
-	    val andb = _prim "Word8_andb": int * int -> int;
-	    val fromInt = _prim "WordS32_toWord8": Int.int -> int;
-	    val toInt = _prim "WordS8_toWord32": int -> Int.int;
-	 end
+            val *? = _prim "WordS8_mul": int * int -> int;
+            val * =
+               if detectOverflow
+                  then wrapOverflow (_prim "WordS8_mulCheck": int * int -> int;)
+               else *?
+            val +? = _prim "Word8_add": int * int -> int;
+            val + =
+               if detectOverflow
+                  then wrapOverflow (_prim "WordS8_addCheck": int * int -> int;)
+               else +?
+            val -? = _prim "Word8_sub": int * int -> int;
+            val - =
+               if detectOverflow
+                  then wrapOverflow (_prim "WordS8_subCheck": int * int -> int;)
+               else -?
+            val op < = _prim "WordS8_lt": int * int -> bool;
+            val quot = _prim "WordS8_quot": int * int -> int;
+            val rem = _prim "WordS8_rem": int * int -> int;
+            val << = _prim "Word8_lshift": int * Word.word -> int;
+            val >> = _prim "WordU8_rshift": int * Word.word -> int;
+            val ~>> = _prim "WordS8_rshift": int * Word.word -> int;
+            val ~? = _prim "Word8_neg": int -> int; 
+            val ~ =
+               if detectOverflow
+                  then wrapOverflow (_prim "Word8_negCheck": int -> int;)
+               else ~?
+            val andb = _prim "Word8_andb": int * int -> int;
+            val fromInt = _prim "WordS32_toWord8": Int.int -> int;
+            val toInt = _prim "WordS8_toWord32": int -> Int.int;
+         end
       structure Int8 =
-	 struct
-	    open Int8
-	    local
-	       structure S = Comparisons (Int8)
-	    in
-	       open S
-	    end
-	 end
+         struct
+            open Int8
+            local
+               structure S = Comparisons (Int8)
+            in
+               open S
+            end
+         end
       structure Int9 =
-	 struct
-	    type big = Int16.int
-	    type int = int9
-	    val fromBigUnsafe = _prim "WordU16_toWord9": big -> int;
-	    val precision' = 9
-	    val toBig = _prim "WordU9_toWord16": int -> big;
-	 end
+         struct
+            type big = Int16.int
+            type int = int9
+            val fromBigUnsafe = _prim "WordU16_toWord9": big -> int;
+            val precision' = 9
+            val toBig = _prim "WordU9_toWord16": int -> big;
+         end
       structure Int10 =
-	 struct
-	    type big = Int16.int
-	    type int = int10
-	    val fromBigUnsafe = _prim "WordU16_toWord10": big -> int;
-	    val precision' = 10
-	    val toBig = _prim "WordU10_toWord16": int -> big;
-	 end
+         struct
+            type big = Int16.int
+            type int = int10
+            val fromBigUnsafe = _prim "WordU16_toWord10": big -> int;
+            val precision' = 10
+            val toBig = _prim "WordU10_toWord16": int -> big;
+         end
       structure Int11 =
-	 struct
-	    type big = Int16.int
-	    type int = int11
-	    val fromBigUnsafe = _prim "WordU16_toWord11": big -> int;
-	    val precision' = 11
-	    val toBig = _prim "WordU11_toWord16": int -> big;
-	 end
+         struct
+            type big = Int16.int
+            type int = int11
+            val fromBigUnsafe = _prim "WordU16_toWord11": big -> int;
+            val precision' = 11
+            val toBig = _prim "WordU11_toWord16": int -> big;
+         end
       structure Int12 =
-	 struct
-	    type big = Int16.int
-	    type int = int12
-	    val fromBigUnsafe = _prim "WordU16_toWord12": big -> int;
-	    val precision' = 12
-	    val toBig = _prim "WordU12_toWord16": int -> big;
-	 end
+         struct
+            type big = Int16.int
+            type int = int12
+            val fromBigUnsafe = _prim "WordU16_toWord12": big -> int;
+            val precision' = 12
+            val toBig = _prim "WordU12_toWord16": int -> big;
+         end
       structure Int13 =
-	 struct
-	    type big = Int16.int
-	    type int = int13
-	    val fromBigUnsafe = _prim "WordU16_toWord13": big -> int;
-	    val precision' = 13
-	    val toBig = _prim "WordU13_toWord16": int -> big;
-	 end
+         struct
+            type big = Int16.int
+            type int = int13
+            val fromBigUnsafe = _prim "WordU16_toWord13": big -> int;
+            val precision' = 13
+            val toBig = _prim "WordU13_toWord16": int -> big;
+         end
       structure Int14 =
-	 struct
-	    type big = Int16.int
-	    type int = int14
-	    val fromBigUnsafe = _prim "WordU16_toWord14": big -> int;
-	    val precision' = 14
-	    val toBig = _prim "WordU14_toWord16": int -> big;
-	 end
+         struct
+            type big = Int16.int
+            type int = int14
+            val fromBigUnsafe = _prim "WordU16_toWord14": big -> int;
+            val precision' = 14
+            val toBig = _prim "WordU14_toWord16": int -> big;
+         end
       structure Int15 =
-	 struct
-	    type big = Int16.int
-	    type int = int15
-	    val fromBigUnsafe = _prim "WordU16_toWord15": big -> int;
-	    val precision' = 15
-	    val toBig = _prim "WordU15_toWord16": int -> big;
-	 end    
+         struct
+            type big = Int16.int
+            type int = int15
+            val fromBigUnsafe = _prim "WordU16_toWord15": big -> int;
+            val precision' = 15
+            val toBig = _prim "WordU15_toWord16": int -> big;
+         end    
       structure Int16 =
-	 struct
-	    type t = Int16.int
-	    type int = t
-	       
-	    val precision' : Int.int = 16
-	    val maxInt' : int = 0x7fff
-	    val minInt' : int = ~0x8000
+         struct
+            type t = Int16.int
+            type int = t
+               
+            val precision' : Int.int = 16
+            val maxInt' : int = 0x7fff
+            val minInt' : int = ~0x8000
 
-	    val *? = _prim "WordS16_mul": int * int -> int;
-	    val * =
-	       if detectOverflow
-		  then _prim "WordS16_mulCheck": int * int -> int;
-	       else *?
-	    val +? = _prim "Word16_add": int * int -> int;
-	    val + =
-	       if detectOverflow
-		  then _prim "WordS16_addCheck": int * int -> int;
-	       else +?
-	    val -? = _prim "Word16_sub": int * int -> int;
-	    val - =
-	       if detectOverflow
-		  then _prim "WordS16_subCheck": int * int -> int;
-	       else -?
-	    val op < = _prim "WordS16_lt": int * int -> bool;
-	    val quot = _prim "WordS16_quot": int * int -> int;
-	    val rem = _prim "WordS16_rem": int * int -> int;
-	    val << = _prim "Word16_lshift": int * Word.word -> int;
-	    val >> = _prim "WordU16_rshift": int * Word.word -> int;
-	    val ~>> = _prim "WordS16_rshift": int * Word.word -> int;
-	    val ~? = _prim "Word16_neg": int -> int; 
-	    val ~ =
-	       if detectOverflow
-		  then _prim "Word16_negCheck": int -> int;
-	       else ~?
-	    val andb = _prim "Word16_andb": int * int -> int;
-	    val fromInt = _prim "WordS32_toWord16": Int.int -> int;
-	    val toInt = _prim "WordS16_toWord32": int -> Int.int;
-	 end
+            val *? = _prim "WordS16_mul": int * int -> int;
+            val * =
+               if detectOverflow
+                  then (wrapOverflow
+                        (_prim "WordS16_mulCheck": int * int -> int;))
+               else *?
+            val +? = _prim "Word16_add": int * int -> int;
+            val + =
+               if detectOverflow
+                  then (wrapOverflow
+                        (_prim "WordS16_addCheck": int * int -> int;))
+               else +?
+            val -? = _prim "Word16_sub": int * int -> int;
+            val - =
+               if detectOverflow
+                  then (wrapOverflow
+                        (_prim "WordS16_subCheck": int * int -> int;))
+               else -?
+            val op < = _prim "WordS16_lt": int * int -> bool;
+            val quot = _prim "WordS16_quot": int * int -> int;
+            val rem = _prim "WordS16_rem": int * int -> int;
+            val << = _prim "Word16_lshift": int * Word.word -> int;
+            val >> = _prim "WordU16_rshift": int * Word.word -> int;
+            val ~>> = _prim "WordS16_rshift": int * Word.word -> int;
+            val ~? = _prim "Word16_neg": int -> int; 
+            val ~ =
+               if detectOverflow
+                  then wrapOverflow (_prim "Word16_negCheck": int -> int;)
+               else ~?
+            val andb = _prim "Word16_andb": int * int -> int;
+            val fromInt = _prim "WordS32_toWord16": Int.int -> int;
+            val toInt = _prim "WordS16_toWord32": int -> Int.int;
+         end
       structure Int16 =
-	 struct
-	    open Int16
-	    local
-	       structure S = Comparisons (Int16)
-	    in
-	       open S
-	    end
-	 end
+         struct
+            open Int16
+            local
+               structure S = Comparisons (Int16)
+            in
+               open S
+            end
+         end
       structure Int17 =
-	 struct
-	    type big = Int32.int
-	    type int = int17
-	    val fromBigUnsafe = _prim "WordU32_toWord17": big -> int;
-	    val precision' = 17
-	    val toBig = _prim "WordU17_toWord32": int -> big;
-	 end
+         struct
+            type big = Int32.int
+            type int = int17
+            val fromBigUnsafe = _prim "WordU32_toWord17": big -> int;
+            val precision' = 17
+            val toBig = _prim "WordU17_toWord32": int -> big;
+         end
       structure Int18 =
-	 struct
-	    type big = Int32.int
-	    type int = int18
-	    val fromBigUnsafe = _prim "WordU32_toWord18": big -> int;
-	    val precision' = 18
-	    val toBig = _prim "WordU18_toWord32": int -> big;
-	 end
+         struct
+            type big = Int32.int
+            type int = int18
+            val fromBigUnsafe = _prim "WordU32_toWord18": big -> int;
+            val precision' = 18
+            val toBig = _prim "WordU18_toWord32": int -> big;
+         end
       structure Int19 =
-	 struct
-	    type big = Int32.int
-	    type int = int19
-	    val fromBigUnsafe = _prim "WordU32_toWord19": big -> int;
-	    val precision' = 19
-	    val toBig = _prim "WordU19_toWord32": int -> big;
-	 end
+         struct
+            type big = Int32.int
+            type int = int19
+            val fromBigUnsafe = _prim "WordU32_toWord19": big -> int;
+            val precision' = 19
+            val toBig = _prim "WordU19_toWord32": int -> big;
+         end
       structure Int20 =
-	 struct
-	    type big = Int32.int
-	    type int = int20
-	    val fromBigUnsafe = _prim "WordU32_toWord20": big -> int;
-	    val precision' = 20
-	    val toBig = _prim "WordU20_toWord32": int -> big;
-	 end
+         struct
+            type big = Int32.int
+            type int = int20
+            val fromBigUnsafe = _prim "WordU32_toWord20": big -> int;
+            val precision' = 20
+            val toBig = _prim "WordU20_toWord32": int -> big;
+         end
       structure Int21 =
-	 struct
-	    type big = Int32.int
-	    type int = int21
-	    val fromBigUnsafe = _prim "WordU32_toWord21": big -> int;
-	    val precision' = 21
-	    val toBig = _prim "WordU21_toWord32": int -> big;
-	 end
+         struct
+            type big = Int32.int
+            type int = int21
+            val fromBigUnsafe = _prim "WordU32_toWord21": big -> int;
+            val precision' = 21
+            val toBig = _prim "WordU21_toWord32": int -> big;
+         end
       structure Int22 =
-	 struct
-	    type big = Int32.int
-	    type int = int22
-	    val fromBigUnsafe = _prim "WordU32_toWord22": big -> int;
-	    val precision' = 22
-	    val toBig = _prim "WordU22_toWord32": int -> big;
-	 end
+         struct
+            type big = Int32.int
+            type int = int22
+            val fromBigUnsafe = _prim "WordU32_toWord22": big -> int;
+            val precision' = 22
+            val toBig = _prim "WordU22_toWord32": int -> big;
+         end
       structure Int23 =
-	 struct
-	    type big = Int32.int
-	    type int = int23
-	    val fromBigUnsafe = _prim "WordU32_toWord23": big -> int;
-	    val precision' = 23
-	    val toBig = _prim "WordU23_toWord32": int -> big;
-	 end
+         struct
+            type big = Int32.int
+            type int = int23
+            val fromBigUnsafe = _prim "WordU32_toWord23": big -> int;
+            val precision' = 23
+            val toBig = _prim "WordU23_toWord32": int -> big;
+         end
       structure Int24 =
-	 struct
-	    type big = Int32.int
-	    type int = int24
-	    val fromBigUnsafe = _prim "WordU32_toWord24": big -> int;
-	    val precision' = 24
-	    val toBig = _prim "WordU24_toWord32": int -> big;
-	 end
+         struct
+            type big = Int32.int
+            type int = int24
+            val fromBigUnsafe = _prim "WordU32_toWord24": big -> int;
+            val precision' = 24
+            val toBig = _prim "WordU24_toWord32": int -> big;
+         end
       structure Int25 =
-	 struct
-	    type big = Int32.int
-	    type int = int25
-	    val fromBigUnsafe = _prim "WordU32_toWord25": big -> int;
-	    val precision' = 25
-	    val toBig = _prim "WordU25_toWord32": int -> big;
-	 end
+         struct
+            type big = Int32.int
+            type int = int25
+            val fromBigUnsafe = _prim "WordU32_toWord25": big -> int;
+            val precision' = 25
+            val toBig = _prim "WordU25_toWord32": int -> big;
+         end
       structure Int26 =
-	 struct
-	    type big = Int32.int
-	    type int = int26
-	    val fromBigUnsafe = _prim "WordU32_toWord26": big -> int;
-	    val precision' = 26
-	    val toBig = _prim "WordU26_toWord32": int -> big;
-	 end
+         struct
+            type big = Int32.int
+            type int = int26
+            val fromBigUnsafe = _prim "WordU32_toWord26": big -> int;
+            val precision' = 26
+            val toBig = _prim "WordU26_toWord32": int -> big;
+         end
       structure Int27 =
-	 struct
-	    type big = Int32.int
-	    type int = int27
-	    val fromBigUnsafe = _prim "WordU32_toWord27": big -> int;
-	    val precision' = 27
-	    val toBig = _prim "WordU27_toWord32": int -> big;
-	 end
+         struct
+            type big = Int32.int
+            type int = int27
+            val fromBigUnsafe = _prim "WordU32_toWord27": big -> int;
+            val precision' = 27
+            val toBig = _prim "WordU27_toWord32": int -> big;
+         end
       structure Int28 =
-	 struct
-	    type big = Int32.int
-	    type int = int28
-	    val fromBigUnsafe = _prim "WordU32_toWord28": big -> int;
-	    val precision' = 28
-	    val toBig = _prim "WordU28_toWord32": int -> big;
-	 end
+         struct
+            type big = Int32.int
+            type int = int28
+            val fromBigUnsafe = _prim "WordU32_toWord28": big -> int;
+            val precision' = 28
+            val toBig = _prim "WordU28_toWord32": int -> big;
+         end
       structure Int29 =
-	 struct
-	    type big = Int32.int
-	    type int = int29
-	    val fromBigUnsafe = _prim "WordU32_toWord29": big -> int;
-	    val precision' = 29
-	    val toBig = _prim "WordU29_toWord32": int -> big;
-	 end
+         struct
+            type big = Int32.int
+            type int = int29
+            val fromBigUnsafe = _prim "WordU32_toWord29": big -> int;
+            val precision' = 29
+            val toBig = _prim "WordU29_toWord32": int -> big;
+         end
       structure Int30 =
-	 struct
-	    type big = Int32.int
-	    type int = int30
-	    val fromBigUnsafe = _prim "WordU32_toWord30": big -> int;
-	    val precision' = 30
-	    val toBig = _prim "WordU30_toWord32": int -> big;
-	 end
+         struct
+            type big = Int32.int
+            type int = int30
+            val fromBigUnsafe = _prim "WordU32_toWord30": big -> int;
+            val precision' = 30
+            val toBig = _prim "WordU30_toWord32": int -> big;
+         end
       structure Int31 =
-	 struct
-	    type big = Int32.int
-	    type int = int31
-	    val fromBigUnsafe = _prim "WordU32_toWord31": big -> int;
-	    val precision' = 31
-	    val toBig = _prim "WordU31_toWord32": int -> big;
-	 end
+         struct
+            type big = Int32.int
+            type int = int31
+            val fromBigUnsafe = _prim "WordU32_toWord31": big -> int;
+            val precision' = 31
+            val toBig = _prim "WordU31_toWord32": int -> big;
+         end
       structure Int32 =
-	 struct
-	    type t = Int32.int
-	    type int = t
+         struct
+            type t = Int32.int
+            type int = t
 
-	    val precision' : Int.int = 32
-	    val maxInt' : int = 0x7fffffff
-	    val minInt' : int = ~0x80000000
+            val precision' : Int.int = 32
+            val maxInt' : int = 0x7fffffff
+            val minInt' : int = ~0x80000000
 
-	    val *? = _prim "WordS32_mul": int * int -> int;
-	    val * =
-	       if detectOverflow
-		  then _prim "WordS32_mulCheck": int * int -> int;
-	       else *?
-	    val +? = _prim "Word32_add": int * int -> int;
-	    val + =
-	       if detectOverflow
-		  then _prim "WordS32_addCheck": int * int -> int;
-	       else +?
-	    val -? = _prim "Word32_sub": int * int -> int;
-	    val - =
-	       if detectOverflow
-		  then _prim "WordS32_subCheck": int * int -> int;
-	       else -?
-	    val op < = _prim "WordS32_lt": int * int -> bool;
-	    val quot = _prim "WordS32_quot": int * int -> int;
-	    val rem = _prim "WordS32_rem": int * int -> int;
-	    val << = _prim "Word32_lshift": int * Word.word -> int;
-	    val >> = _prim "WordU32_rshift": int * Word.word -> int;
-	    val ~>> = _prim "WordS32_rshift": int * Word.word -> int;
-	    val ~? = _prim "Word32_neg": int -> int; 
-	    val ~ =
-	       if detectOverflow
-		  then _prim "Word32_negCheck": int -> int;
-	       else ~?
-	    val andb = _prim "Word32_andb": int * int -> int;
-	    val fromInt : int -> int = fn x => x
-	    val toInt : int -> int = fn x => x
-	 end
+            val *? = _prim "WordS32_mul": int * int -> int;
+            val * =
+               if detectOverflow
+                  then (wrapOverflow
+                        (_prim "WordS32_mulCheck": int * int -> int;))
+               else *?
+            val +? = _prim "Word32_add": int * int -> int;
+            val + =
+               if detectOverflow
+                  then (wrapOverflow
+                        (_prim "WordS32_addCheck": int * int -> int;))
+               else +?
+            val -? = _prim "Word32_sub": int * int -> int;
+            val - =
+               if detectOverflow
+                  then (wrapOverflow
+                        (_prim "WordS32_subCheck": int * int -> int;))
+               else -?
+            val op < = _prim "WordS32_lt": int * int -> bool;
+            val quot = _prim "WordS32_quot": int * int -> int;
+            val rem = _prim "WordS32_rem": int * int -> int;
+            val << = _prim "Word32_lshift": int * Word.word -> int;
+            val >> = _prim "WordU32_rshift": int * Word.word -> int;
+            val ~>> = _prim "WordS32_rshift": int * Word.word -> int;
+            val ~? = _prim "Word32_neg": int -> int; 
+            val ~ =
+               if detectOverflow
+                  then wrapOverflow (_prim "Word32_negCheck": int -> int;)
+               else ~?
+            val andb = _prim "Word32_andb": int * int -> int;
+            val fromInt : int -> int = fn x => x
+            val toInt : int -> int = fn x => x
+         end
       structure Int32 =
-	 struct
-	    open Int32
-	    local
-	       structure S = Comparisons (Int32)
-	    in
-	       open S
-	    end
-	 end
+         struct
+            open Int32
+            local
+               structure S = Comparisons (Int32)
+            in
+               open S
+            end
+         end
       structure Int = Int32
       structure Int64 =
-	 struct
-	    type t = Int64.int
-	    type int = t
+         struct
+            type t = Int64.int
+            type int = t
 
-	    val precision' : Int.int = 64
-	    val maxInt' : int = 0x7FFFFFFFFFFFFFFF
-	    val minInt' : int = ~0x8000000000000000
+            val precision' : Int.int = 64
+            val maxInt' : int = 0x7FFFFFFFFFFFFFFF
+            val minInt' : int = ~0x8000000000000000
 
-	    val *? = _prim "WordS64_mul": int * int -> int;
-	    val +? = _prim "Word64_add": int * int -> int;
-	    val + =
-	       if detectOverflow
-		  then _prim "WordS64_addCheck": int * int -> int;
-	       else +?
-	    val -? = _prim "Word64_sub": int * int -> int;
-	    val - =
-	       if detectOverflow
-		  then _prim "WordS64_subCheck": int * int -> int;
-	       else -?
-	    val op < = _prim "WordS64_lt": int * int -> bool;
-	    val << = _prim "Word64_lshift": int * Word.word -> int;
-	    val >> = _prim "WordU64_rshift": int * Word.word -> int;
-	    val ~>> = _prim "WordS64_rshift": int * Word.word -> int;
-	    val quot = _prim "WordS64_quot": int * int -> int;
-	    val rem = _prim "WordS64_rem": int * int -> int;
-	    val ~? = _prim "Word64_neg": int -> int; 
-	    val ~ =
-	       if detectOverflow
-		  then _prim "Word64_negCheck": int -> int;
-	       else ~?
-	    val andb = _prim "Word64_andb": int * int -> int;
-	    val fromInt = _prim "WordS32_toWord64": Int.int -> int;
-	    val fromWord = _prim "WordU32_toWord64": word -> int;
-	    val toInt = _prim "WordU64_toWord32": int -> Int.int;
-	    val toWord = _prim "WordU64_toWord32": int -> word;
-	    val * = fn _ => raise Fail "Int64.* unimplemented"
-	 end
+            val *? = _prim "WordS64_mul": int * int -> int;
+            val * = fn _ => raise Fail "Int64.* unimplemented"
+(*
+            val * =
+               if detectOverflow
+                  then _prim "WordS64_mulCheck": int * int -> int;
+               else *?
+*)
+            val +? = _prim "Word64_add": int * int -> int;
+            val + =
+               if detectOverflow
+                  then (wrapOverflow
+                        (_prim "WordS64_addCheck": int * int -> int;))
+               else +?
+            val -? = _prim "Word64_sub": int * int -> int;
+            val - =
+               if detectOverflow
+                  then (wrapOverflow
+                        (_prim "WordS64_subCheck": int * int -> int;))
+               else -?
+            val op < = _prim "WordS64_lt": int * int -> bool;
+            val << = _prim "Word64_lshift": int * Word.word -> int;
+            val >> = _prim "WordU64_rshift": int * Word.word -> int;
+            val ~>> = _prim "WordS64_rshift": int * Word.word -> int;
+            val quot = _prim "WordS64_quot": int * int -> int;
+            val rem = _prim "WordS64_rem": int * int -> int;
+            val ~? = _prim "Word64_neg": int -> int; 
+            val ~ =
+               if detectOverflow
+                  then wrapOverflow (_prim "Word64_negCheck": int -> int;)
+               else ~?
+            val andb = _prim "Word64_andb": int * int -> int;
+            val fromInt = _prim "WordS32_toWord64": Int.int -> int;
+            val fromWord = _prim "WordU32_toWord64": word -> int;
+            val toInt = _prim "WordU64_toWord32": int -> Int.int;
+            val toWord = _prim "WordU64_toWord32": int -> word;
+         end
       structure Int64 =
-	 struct
-	    open Int64
-	    local
-	       structure S = Comparisons (Int64)
-	    in
-	       open S
-	    end
-	 end
+         struct
+            open Int64
+            local
+               structure S = Comparisons (Int64)
+            in
+               open S
+            end
+         end
 
       structure Array =
-	 struct
-	    open Array
+         struct
+            open Array
 
-	    val array = _prim "Array_array": int -> 'a array;
-      	    val array =
-	       fn n => if safe andalso Int.< (n, 0)
-			  then raise Size
-		       else array n
-	 end
+            val array = _prim "Array_array": int -> 'a array;
+            val array =
+               fn n => if safe andalso Int.< (n, 0)
+                          then raise Size
+                       else array n
+         end
 
       structure IntInf =
-	 struct
-	    open IntInf
+         struct
+            open IntInf
 
-	    val + = _prim "IntInf_add": int * int * word -> int;
-	    val andb = _prim "IntInf_andb": int * int * word -> int;
-	    val ~>> = _prim "IntInf_arshift": int * word * word -> int;
-	    val compare = _prim "IntInf_compare": int * int -> Int.int;
-	    val fromVector = _prim "WordVector_toIntInf": word vector -> int;
-	    val fromWord = _prim "Word_toIntInf": word -> int;
-	    val gcd = _prim "IntInf_gcd": int * int * word -> int;
-	    val << = _prim "IntInf_lshift": int * word * word -> int;
-	    val * = _prim "IntInf_mul": int * int * word -> int;
-	    val ~ = _prim "IntInf_neg": int * word -> int;
-	    val notb = _prim "IntInf_notb": int * word -> int;
-	    val orb = _prim "IntInf_orb": int * int * word -> int;
-	    val quot = _prim "IntInf_quot": int * int * word -> int;
-	    val rem = _prim "IntInf_rem": int * int * word -> int;
-	    val smallMul =
-	       _import "IntInf_smallMul": word * word * word ref -> word;
-	    val - = _prim "IntInf_sub": int * int * word -> int; 
- 	    val toString
-	       = _prim "IntInf_toString": int * Int.int * word -> string;
-	    val toVector = _prim "IntInf_toVector": int -> word vector;
-	    val toWord = _prim "IntInf_toWord": int -> word;
-	    val xorb = _prim "IntInf_xorb": int * int * word -> int;
-	 end
+            val + = _prim "IntInf_add": int * int * word -> int;
+            val andb = _prim "IntInf_andb": int * int * word -> int;
+            val ~>> = _prim "IntInf_arshift": int * word * word -> int;
+            val compare = _prim "IntInf_compare": int * int -> Int.int;
+            val fromVector = _prim "WordVector_toIntInf": word vector -> int;
+            val fromWord = _prim "Word_toIntInf": word -> int;
+            val gcd = _prim "IntInf_gcd": int * int * word -> int;
+            val << = _prim "IntInf_lshift": int * word * word -> int;
+            val * = _prim "IntInf_mul": int * int * word -> int;
+            val ~ = _prim "IntInf_neg": int * word -> int;
+            val notb = _prim "IntInf_notb": int * word -> int;
+            val orb = _prim "IntInf_orb": int * int * word -> int;
+            val quot = _prim "IntInf_quot": int * int * word -> int;
+            val rem = _prim "IntInf_rem": int * int * word -> int;
+            val smallMul =
+               _import "IntInf_smallMul": word * word * word ref -> word;
+            val - = _prim "IntInf_sub": int * int * word -> int; 
+            val toString
+               = _prim "IntInf_toString": int * Int.int * word -> string;
+            val toVector = _prim "IntInf_toVector": int -> word vector;
+            val toWord = _prim "IntInf_toWord": int -> word;
+            val xorb = _prim "IntInf_xorb": int * int * word -> int;
+         end
 
       structure Itimer =
-	 struct
-	    type which = int
-	       
-	    val prof = _const "Itimer_prof": which;
-	    val real = _const "Itimer_real": which;
-	    val set =
-	       _import "Itimer_set": which * int * int * int * int -> unit;
-	    val virtual = _const "Itimer_virtual": which;
-	 end
+         struct
+            type which = int
+               
+            val prof = _const "Itimer_prof": which;
+            val real = _const "Itimer_real": which;
+            val set =
+               _import "Itimer_set": which * int * int * int * int -> unit;
+            val virtual = _const "Itimer_virtual": which;
+         end
 
       structure MLton =
-	 struct
-	    structure Codegen =
-	       struct
-		  datatype t = Bytecode | C | Cmm | Native
+         struct
+            structure Codegen =
+               struct
+                  datatype t = Bytecode | C | Cmm | Native
 
-		  val codegen =
-		     case _build_const "MLton_codegen": int; of
-			0 => Bytecode
-		      | 1 => C
-		      | 2 => Cmm
-		      | 3 => Native
-		      | _ => raise Fail "MLton_codegen"
+                  val codegen =
+                     case _build_const "MLton_Codegen_codegen": int; of
+                        0 => Bytecode
+                      | 1 => C
+                      | 2 => Cmm
+                      | 3 => Native
+                      | _ => raise Fail "MLton_Codegen_codegen"
 
-		  val isBytecode = codegen = Bytecode
-		  (* val isC = codegen = C *)
-		  val isNative = codegen = Native
-	       end
-	    
-	    (* val deserialize = _prim "MLton_deserialize": Word8Vector.vector -> 'a ref; *)
-	    (* val serialize = _prim "MLton_serialize": 'a ref -> Word8Vector.vector; *)
-	    val share = _prim "MLton_share": 'a -> unit;
-	    val size = _prim "MLton_size": 'a ref -> int;
+                  val isBytecode = codegen = Bytecode
+                  (* val isC = codegen = C *)
+                  val isNative = codegen = Native
+               end
+            
+            (* val deserialize = _prim "MLton_deserialize": Word8Vector.vector -> 'a ref; *)
+            (* val serialize = _prim "MLton_serialize": 'a ref -> Word8Vector.vector; *)
+            val share = _prim "MLton_share": 'a -> unit;
+            val size = _prim "MLton_size": 'a ref -> int;
 
-	    structure Platform =
-	       struct
-		  structure Arch =
-		     struct
+            structure Platform =
+               struct
+                  structure Arch =
+                     struct
                         datatype t = Alpha | AMD64 | ARM | HPPA | IA64 | m68k |
                                      MIPS | PowerPC | S390 | Sparc | X86
                         
-			val host: t =
-			   case _const "MLton_Platform_Arch_host": string; of
-			      "alpha" => Alpha
-			    | "amd64" => AMD64
-			    | "arm" => ARM
-			    | "hppa" => HPPA
-			    | "ia64" => IA64
-			    | "m68k" => m68k
+                        val host: t =
+                           case _const "MLton_Platform_Arch_host": string; of
+                              "alpha" => Alpha
+                            | "amd64" => AMD64
+                            | "arm" => ARM
+                            | "hppa" => HPPA
+                            | "ia64" => IA64
+                            | "m68k" => m68k
                             | "mips" => MIPS
                             | "powerpc" => PowerPC
                             | "s390" => S390
-			    | "sparc" => Sparc
-			    | "x86" => X86
-			    | _ => raise Fail "strange MLton_Platform_Arch_host"
+                            | "sparc" => Sparc
+                            | "x86" => X86
+                            | _ => raise Fail "strange MLton_Platform_Arch_host"
 
-			val hostIsBigEndian =
-			   _const "MLton_Platform_Arch_bigendian": bool;
-		     end
+                        val hostIsBigEndian =
+                           _const "MLton_Platform_Arch_bigendian": bool;
+                     end
 
-		  structure OS =
-		     struct
-			datatype t =
-			   Cygwin
-			 | Darwin
-			 | FreeBSD
-			 | Linux
-			 | MinGW
-			 | NetBSD
-			 | OpenBSD
-			 | Solaris
+                  structure OS =
+                     struct
+                        datatype t =
+                           Cygwin
+                         | Darwin
+                         | FreeBSD
+                         | Linux
+                         | MinGW
+                         | NetBSD
+                         | OpenBSD
+                         | Solaris
 
-			val host: t =
-			   case _const "MLton_Platform_OS_host": string; of
-			      "cygwin" => Cygwin
-			    | "darwin" => Darwin
-			    | "freebsd" => FreeBSD
-			    | "linux" => Linux
-			    | "mingw" => MinGW
-			    | "netbsd" => NetBSD
-			    | "openbsd" => OpenBSD
-			    | "solaris" => Solaris
-			    | _ => raise Fail "strange MLton_Platform_OS_host"
+                        val host: t =
+                           case _const "MLton_Platform_OS_host": string; of
+                              "cygwin" => Cygwin
+                            | "darwin" => Darwin
+                            | "freebsd" => FreeBSD
+                            | "linux" => Linux
+                            | "mingw" => MinGW
+                            | "netbsd" => NetBSD
+                            | "openbsd" => OpenBSD
+                            | "solaris" => Solaris
+                            | _ => raise Fail "strange MLton_Platform_OS_host"
 
-			local
-			   val cygwinUseMmap =
-			      _import "MLton_Platform_CygwinUseMmap": bool;
-			in
-			   val forkIsEnabled =
-			      case host of
-				 Cygwin => cygwinUseMmap
-			       | MinGW => false
-			       | _ => true
+                        val forkIsEnabled =
+                           case host of
+                              Cygwin =>
+                                 #1 _symbol "MLton_Platform_CygwinUseMmap": bool GetSet.t; ()
+                            | MinGW => false
+                            | _ => true
 
-			   val useWindowsProcess = not forkIsEnabled
-			end
-		     end
-	       end
+                        val useWindowsProcess = not forkIsEnabled
+                     end
+               end
 
-	    structure Process =
-	       struct
-                  val cwait =
-                     _import "MLton_Process_cwait": Pid.t * int ref -> Pid.t;
-		  val spawne =
-		     _import "MLton_Process_spawne"
-		     : (NullString.t * NullString.t array * NullString.t array
-			-> Pid.t);
-		  val spawnp =
-		     _import "MLton_Process_spawnp"
-		     : NullString.t * NullString.t array -> Pid.t;
-	       end
-	    
-	    structure Profile =
-	       struct
-		  val isOn = _build_const "MLton_profile_isOn": bool;
-		  structure Data =
-		     struct
-		        type t = word
+            structure Process =
+               struct
+                  val spawne =
+                     if let
+                           open Platform.OS
+                        in
+                           case host of
+                              Cygwin => true
+                            | MinGW => true
+                            | _ => false
+                        end
+                        then
+                           _import "MLton_Process_spawne"
+                           : (NullString.t 
+                              * NullString.t array
+                              * NullString.t array
+                              -> Pid.t);
+                        else fn _ => raise Fail "spawne not defined"
+                  val spawnp =
+                     if let
+                           open Platform.OS
+                        in
+                           case host of
+                              Cygwin => true
+                            | MinGW => true
+                            | _ => false
+                        end
+                        then
+                           _import "MLton_Process_spawnp"
+                           : (NullString.t 
+                              * NullString.t array
+                              -> Pid.t);
+                        else fn _ => raise Fail "spawnp not defined"
+               end
+            
+            structure Profile =
+               struct
+                  val isOn = _build_const "MLton_Profile_isOn": bool;
+                  structure Data =
+                     struct
+                        type t = word
 
-			val dummy:t = 0w0
-			val free = _import "MLton_Profile_Data_free": t -> unit;
-			val malloc = _import "MLton_Profile_Data_malloc": unit -> t;
-			val write =
-			   _import "MLton_Profile_Data_write"
-			   : t * word (* fd *) -> unit;
-		     end
-		  val current = _import "MLton_Profile_current": unit -> Data.t;
-		  val done = _import "MLton_Profile_done": unit -> unit;
-		  val setCurrent =
-		     _import "MLton_Profile_setCurrent": Data.t -> unit;
-	       end
-	    
-	    structure Rlimit =
-	       struct
-		  type rlim = word
-		     
-		  val infinity = _const "MLton_Rlimit_infinity": rlim;
+                        val dummy:t = 0w0
+                        val free = _import "MLton_Profile_Data_free": t -> unit;
+                        val malloc = _import "MLton_Profile_Data_malloc": unit -> t;
+                        val write =
+                           _import "MLton_Profile_Data_write"
+                           : t * word (* fd *) -> unit;
+                     end
+                  val current = _import "MLton_Profile_current": unit -> Data.t;
+                  val done = _import "MLton_Profile_done": unit -> unit;
+                  val setCurrent =
+                     _import "MLton_Profile_setCurrent": Data.t -> unit;
+               end
+            
+            structure Rlimit =
+               struct
+                  type rlim = word
+                     
+                  val infinity = _const "MLton_Rlimit_infinity": rlim;
 
-		  type t = int
+                  type t = int
 
-		  val cpuTime = _const "MLton_Rlimit_cpuTime": t;
-		  val coreFileSize = _const "MLton_Rlimit_coreFileSize": t;
-		  val dataSize = _const "MLton_Rlimit_dataSize": t;
-		  val fileSize = _const "MLton_Rlimit_fileSize": t;
-		  val lockedInMemorySize =
-		     _const "MLton_Rlimit_lockedInMemorySize": t;
-		  val numFiles = _const "MLton_Rlimit_numFiles": t;
-		  val numProcesses = _const "MLton_Rlimit_numProcesses": t;
-		  val residentSetSize = _const "MLton_Rlimit_residentSetSize": t;
-		  val stackSize = _const "MLton_Rlimit_stackSize": t;
-		  val virtualMemorySize =
-		     _const "MLton_Rlimit_virtualMemorySize": t;
-		     
-		  val get = _import "MLton_Rlimit_get": t -> int;
-		  val getHard = _import "MLton_Rlimit_getHard": unit -> rlim;
-		  val getSoft = _import "MLton_Rlimit_getSoft": unit -> rlim;
-		  val set = _import "MLton_Rlimit_set": t * rlim * rlim -> int;
-	       end
-	    
-	    structure Rusage =
+                  val cpuTime = _const "MLton_Rlimit_cpuTime": t;
+                  val coreFileSize = _const "MLton_Rlimit_coreFileSize": t;
+                  val dataSize = _const "MLton_Rlimit_dataSize": t;
+                  val fileSize = _const "MLton_Rlimit_fileSize": t;
+                  val lockedInMemorySize =
+                     _const "MLton_Rlimit_lockedInMemorySize": t;
+                  val numFiles = _const "MLton_Rlimit_numFiles": t;
+                  val numProcesses = _const "MLton_Rlimit_numProcesses": t;
+                  val residentSetSize = _const "MLton_Rlimit_residentSetSize": t;
+                  val stackSize = _const "MLton_Rlimit_stackSize": t;
+                  val virtualMemorySize =
+                     _const "MLton_Rlimit_virtualMemorySize": t;
+                     
+                  val get = _import "MLton_Rlimit_get": t -> int;
+                  val getHard = _import "MLton_Rlimit_getHard": unit -> rlim;
+                  val getSoft = _import "MLton_Rlimit_getSoft": unit -> rlim;
+                  val set = _import "MLton_Rlimit_set": t * rlim * rlim -> int;
+               end
+            
+            structure Rusage =
                struct
-		 val ru = _import "MLton_Rusage_ru": unit -> unit;
-		    
-		 val self_utime_sec = _import "MLton_Rusage_self_utime_sec": unit -> int;
-		 val self_utime_usec = _import "MLton_Rusage_self_utime_usec": unit -> int;
-		 val self_stime_sec = _import "MLton_Rusage_self_stime_sec": unit -> int;
-		 val self_stime_usec = _import "MLton_Rusage_self_stime_usec": unit -> int;
-		 val children_utime_sec = _import "MLton_Rusage_children_utime_sec": unit -> int;
-		 val children_utime_usec = _import "MLton_Rusage_children_utime_usec": unit -> int;
-		 val children_stime_sec = _import "MLton_Rusage_children_stime_sec": unit -> int;
-		 val children_stime_usec = _import "MLton_Rusage_children_stime_usec": unit -> int;
-		 val gc_utime_sec = _import "MLton_Rusage_gc_utime_sec": unit -> int;
-		 val gc_utime_usec = _import "MLton_Rusage_gc_utime_usec": unit -> int;
-		 val gc_stime_sec = _import "MLton_Rusage_gc_stime_sec": unit -> int;
-		 val gc_stime_usec = _import "MLton_Rusage_gc_stime_usec": unit -> int;
-	       end
+                 val ru = _import "MLton_Rusage_ru": unit -> unit;
+                    
+                 val self_utime_sec = _import "MLton_Rusage_self_utime_sec": unit -> int;
+                 val self_utime_usec = _import "MLton_Rusage_self_utime_usec": unit -> int;
+                 val self_stime_sec = _import "MLton_Rusage_self_stime_sec": unit -> int;
+                 val self_stime_usec = _import "MLton_Rusage_self_stime_usec": unit -> int;
+                 val children_utime_sec = _import "MLton_Rusage_children_utime_sec": unit -> int;
+                 val children_utime_usec = _import "MLton_Rusage_children_utime_usec": unit -> int;
+                 val children_stime_sec = _import "MLton_Rusage_children_stime_sec": unit -> int;
+                 val children_stime_usec = _import "MLton_Rusage_children_stime_usec": unit -> int;
+                 val gc_utime_sec = _import "MLton_Rusage_gc_utime_sec": unit -> int;
+                 val gc_utime_usec = _import "MLton_Rusage_gc_utime_usec": unit -> int;
+                 val gc_stime_sec = _import "MLton_Rusage_gc_stime_sec": unit -> int;
+                 val gc_stime_usec = _import "MLton_Rusage_gc_stime_usec": unit -> int;
+               end
 
-	    structure Syslog =
-	       struct
-		  type openflag = int
-		     
-		  val CONS = _const "LOG_CONS" : openflag;
-		  val NDELAY = _const "LOG_NDELAY" : openflag;
-		  val PERROR = _const "LOG_PERROR" : openflag;
-		  val PID = _const "LOG_PID" : openflag;
-		     
-		  type facility = int
-		     
-		  val AUTHPRIV = _const "LOG_AUTHPRIV" : facility;
-		  val CRON = _const "LOG_CRON" : facility;
-		  val DAEMON = _const "LOG_DAEMON" : facility;
-		  val KERN = _const "LOG_KERN" : facility;
-		  val LOCAL0 = _const "LOG_LOCAL0" : facility;
-		  val LOCAL1 = _const "LOG_LOCAL1" : facility;
-		  val LOCAL2 = _const "LOG_LOCAL2" : facility;
-		  val LOCAL3 = _const "LOG_LOCAL3" : facility;
-		  val LOCAL4 = _const "LOG_LOCAL4" : facility;
-		  val LOCAL5 = _const "LOG_LOCAL5" : facility;
-		  val LOCAL6 = _const "LOG_LOCAL6" : facility;
-		  val LOCAL7 = _const "LOG_LOCAL7" : facility;
-		  val LPR = _const "LOG_LPR" : facility;
-		  val MAIL = _const "LOG_MAIL" : facility;
-		  val NEWS = _const "LOG_NEWS" : facility;
-		  val SYSLOG = _const "LOG_SYSLOG" : facility;
-		  val USER = _const "LOG_USER" : facility;
-		  val UUCP = _const "LOG_UUCP" : facility;
-		     
-		  type loglevel = int
-		     
-		  val EMERG = _const "LOG_EMERG" : loglevel;
-		  val ALERT = _const "LOG_ALERT" : loglevel;
-		  val CRIT = _const "LOG_CRIT" : loglevel;
-		  val ERR = _const "LOG_ERR" : loglevel;
-		  val WARNING = _const "LOG_WARNING" : loglevel;
-		  val NOTICE = _const "LOG_NOTICE" : loglevel;
-		  val INFO = _const "LOG_INFO" : loglevel;
-		  val DEBUG = _const "LOG_DEBUG" : loglevel;
-	       end
+            structure Syslog =
+               struct
+                  type openflag = int
+                     
+                  val CONS = _const "LOG_CONS": openflag;
+                  val NDELAY = _const "LOG_NDELAY": openflag;
+                  val PERROR = _const "LOG_PERROR": openflag;
+                  val PID = _const "LOG_PID": openflag;
+                     
+                  type facility = int
+                     
+                  val AUTHPRIV = _const "LOG_AUTHPRIV": facility;
+                  val CRON = _const "LOG_CRON": facility;
+                  val DAEMON = _const "LOG_DAEMON": facility;
+                  val KERN = _const "LOG_KERN": facility;
+                  val LOCAL0 = _const "LOG_LOCAL0": facility;
+                  val LOCAL1 = _const "LOG_LOCAL1": facility;
+                  val LOCAL2 = _const "LOG_LOCAL2": facility;
+                  val LOCAL3 = _const "LOG_LOCAL3": facility;
+                  val LOCAL4 = _const "LOG_LOCAL4": facility;
+                  val LOCAL5 = _const "LOG_LOCAL5": facility;
+                  val LOCAL6 = _const "LOG_LOCAL6": facility;
+                  val LOCAL7 = _const "LOG_LOCAL7": facility;
+                  val LPR = _const "LOG_LPR": facility;
+                  val MAIL = _const "LOG_MAIL": facility;
+                  val NEWS = _const "LOG_NEWS": facility;
+                  val SYSLOG = _const "LOG_SYSLOG": facility;
+                  val USER = _const "LOG_USER": facility;
+                  val UUCP = _const "LOG_UUCP": facility;
+                     
+                  type loglevel = int
+                     
+                  val EMERG = _const "LOG_EMERG": loglevel;
+                  val ALERT = _const "LOG_ALERT": loglevel;
+                  val CRIT = _const "LOG_CRIT": loglevel;
+                  val ERR = _const "LOG_ERR": loglevel;
+                  val WARNING = _const "LOG_WARNING": loglevel;
+                  val NOTICE = _const "LOG_NOTICE": loglevel;
+                  val INFO = _const "LOG_INFO": loglevel;
+                  val DEBUG = _const "LOG_DEBUG": loglevel;
+               end
 
-	    structure Weak =
-	       struct
-		  type 'a t = 'a weak
-		     
-		  val canGet = _prim "Weak_canGet": 'a t -> bool;
-		  val get = _prim "Weak_get": 'a t -> 'a;
-		  val new = _prim "Weak_new" : 'a -> 'a t;
-	       end
-	 end
+            structure Weak =
+               struct
+                  type 'a t = 'a weak
+                     
+                  val canGet = _prim "Weak_canGet": 'a t -> bool;
+                  val get = _prim "Weak_get": 'a t -> 'a;
+                  val new = _prim "Weak_new": 'a -> 'a t;
+               end
+         end
 
       structure Net =
-	 struct
-	    (* val htonl = _import "Net_htonl": int -> int; *)
-	    (* val ntohl = _import "Net_ntohl": int -> int; *)
- 	    val htons = _import "Net_htons": int -> int;
-	    val ntohs = _import "Net_ntohs": int -> int;
-	 end
+         struct
+            (* val htonl = _import "Net_htonl": int -> int; *)
+            (* val ntohl = _import "Net_ntohl": int -> int; *)
+            val htons = _import "Net_htons": int -> int;
+            val ntohs = _import "Net_ntohs": int -> int;
+         end
 
       structure NetHostDB =
-	 struct
-	    (* network byte order (MSB) *)
-	    type pre_in_addr = word8 array
-	    type in_addr = word8 vector
-	    val inAddrLen = _const "NetHostDB_inAddrLen": int;
-	    val INADDR_ANY = _const "NetHostDB_INADDR_ANY": int;
-	    type addr_family = int
-	    val entryName = _import "NetHostDB_Entry_name": unit -> CString.t;
-	    val entryNumAliases = _import "NetHostDB_Entry_numAliases": unit -> int;
-	    val entryAliasesN = _import "NetHostDB_Entry_aliasesN": int -> CString.t;
-	    val entryAddrType = _import "NetHostDB_Entry_addrType": unit -> int;
-	    val entryLength = _import "NetHostDB_Entry_length": unit -> int;
-	    val entryNumAddrs = _import "NetHostDB_Entry_numAddrs": unit -> int;
-	    val entryAddrsN =
-	       _import "NetHostDB_Entry_addrsN": int * pre_in_addr -> unit;
-	    val getByAddress =
-	       _import "NetHostDB_getByAddress": in_addr * int -> bool;
-	    val getByName = _import "NetHostDB_getByName": NullString.t -> bool;
-	    val getHostName =
-	       _import "NetHostDB_getHostName": char array * int -> int;
-	 end
+         struct
+            (* network byte order (MSB) *)
+            type pre_in_addr = word8 array
+            type in_addr = word8 vector
+            val inAddrLen = _const "NetHostDB_inAddrLen": int;
+            val INADDR_ANY = _const "NetHostDB_INADDR_ANY": int;
+            type addr_family = int
+            val entryName = _import "NetHostDB_Entry_name": unit -> CString.t;
+            val entryNumAliases = _import "NetHostDB_Entry_numAliases": unit -> int;
+            val entryAliasesN = _import "NetHostDB_Entry_aliasesN": int -> CString.t;
+            val entryAddrType = _import "NetHostDB_Entry_addrType": unit -> int;
+            val entryLength = _import "NetHostDB_Entry_length": unit -> int;
+            val entryNumAddrs = _import "NetHostDB_Entry_numAddrs": unit -> int;
+            val entryAddrsN =
+               _import "NetHostDB_Entry_addrsN": int * pre_in_addr -> unit;
+            val getByAddress =
+               _import "NetHostDB_getByAddress": in_addr * int -> bool;
+            val getByName = _import "NetHostDB_getByName": NullString.t -> bool;
+            val getHostName =
+               _import "NetHostDB_getHostName": char array * int -> int;
+         end
 
       structure NetProtDB =
-	 struct
-	    val entryName = _import "NetProtDB_Entry_name": unit -> CString.t;
-	    val entryNumAliases = _import "NetProtDB_Entry_numAliases": unit -> int;
-	    val entryAliasesN = _import "NetProtDB_Entry_aliasesN": int -> CString.t;
-	    val entryProtocol = _import "NetProtDB_Entry_protocol": unit -> int;
-	    val getByName = _import "NetProtDB_getByName": NullString.t -> bool;
-	    val getByNumber = _import "NetProtDB_getByNumber": int -> bool;
-	 end
+         struct
+            val entryName = _import "NetProtDB_Entry_name": unit -> CString.t;
+            val entryNumAliases = _import "NetProtDB_Entry_numAliases": unit -> int;
+            val entryAliasesN = _import "NetProtDB_Entry_aliasesN": int -> CString.t;
+            val entryProtocol = _import "NetProtDB_Entry_protocol": unit -> int;
+            val getByName = _import "NetProtDB_getByName": NullString.t -> bool;
+            val getByNumber = _import "NetProtDB_getByNumber": int -> bool;
+         end
 
       structure NetServDB =
-	 struct
-	    val entryName = _import "NetServDB_Entry_name": unit -> CString.t;
-	    val entryNumAliases = _import "NetServDB_Entry_numAliases": unit -> int;
-	    val entryAliasesN = _import "NetServDB_Entry_aliasesN": int -> CString.t;
-	    val entryPort = _import "NetServDB_Entry_port": unit -> int;
-	    val entryProtocol = _import "NetServDB_Entry_protocol": unit -> CString.t;
-	    val getByName = _import "NetServDB_getByName": NullString.t * NullString.t -> bool;
-	    val getByNameNull = _import "NetServDB_getByNameNull": NullString.t -> bool;
-	    val getByPort = _import "NetServDB_getByPort": int * NullString.t -> bool;
-	    val getByPortNull = _import "NetServDB_getByPortNull": int -> bool;
-	 end
+         struct
+            val entryName = _import "NetServDB_Entry_name": unit -> CString.t;
+            val entryNumAliases = _import "NetServDB_Entry_numAliases": unit -> int;
+            val entryAliasesN = _import "NetServDB_Entry_aliasesN": int -> CString.t;
+            val entryPort = _import "NetServDB_Entry_port": unit -> int;
+            val entryProtocol = _import "NetServDB_Entry_protocol": unit -> CString.t;
+            val getByName = _import "NetServDB_getByName": NullString.t * NullString.t -> bool;
+            val getByNameNull = _import "NetServDB_getByNameNull": NullString.t -> bool;
+            val getByPort = _import "NetServDB_getByPort": int * NullString.t -> bool;
+            val getByPortNull = _import "NetServDB_getByPortNull": int -> bool;
+         end
 
       structure OS =
-	 struct
-	    structure IO =
-	       struct
-		  val POLLIN = _const "OS_IO_POLLIN": word;
-		  val POLLPRI = _const "OS_IO_POLLPRI": word;
-		  val POLLOUT = _const "OS_IO_POLLOUT": word;
-		  val poll = _import "OS_IO_poll": int vector * word vector * 
+         struct
+            structure IO =
+               struct
+                  val POLLIN = _const "OS_IO_POLLIN": word;
+                  val POLLPRI = _const "OS_IO_POLLPRI": word;
+                  val POLLOUT = _const "OS_IO_POLLOUT": word;
+                  val poll = _import "OS_IO_poll": int vector * word vector * 
                                                 int * int * word array -> int;
-	       end
-	 end
+               end
+         end
 
       structure PackReal32 =
-	 struct
-	    type real = Real32.real
-	       
-	    val subVec = _import "PackReal32_subVec": word8 vector * int -> real;
-	    val subVecRev =
-	       _import "PackReal32_subVecRev": word8 vector * int -> real;
-	    val update =
-	       _import "PackReal32_update": word8 array * int * real -> unit;
-	    val updateRev =
-	       _import "PackReal32_updateRev": word8 array * int * real -> unit;
-	 end
+         struct
+            type real = Real32.real
+               
+            val subVec = _import "PackReal32_subVec": word8 vector * int -> real;
+            val subVecRev =
+               _import "PackReal32_subVecRev": word8 vector * int -> real;
+            val update =
+               _import "PackReal32_update": word8 array * int * real -> unit;
+            val updateRev =
+               _import "PackReal32_updateRev": word8 array * int * real -> unit;
+         end
 
       structure PackReal64 =
-	 struct
-	    type real = Real64.real
-	       
-	    val subVec = _import "PackReal64_subVec": word8 vector * int -> real;
-	    val subVecRev =
-	       _import "PackReal64_subVecRev": word8 vector * int -> real;
-	    val update =
-	       _import "PackReal64_update": word8 array * int * real -> unit;
-	    val updateRev =
-	       _import "PackReal64_updateRev": word8 array * int * real -> unit;
-	 end
+         struct
+            type real = Real64.real
+               
+            val subVec = _import "PackReal64_subVec": word8 vector * int -> real;
+            val subVecRev =
+               _import "PackReal64_subVecRev": word8 vector * int -> real;
+            val update =
+               _import "PackReal64_update": word8 array * int * real -> unit;
+            val updateRev =
+               _import "PackReal64_updateRev": word8 array * int * real -> unit;
+         end
 
       structure Pointer =
-	 struct
-	    open Pointer
+         struct
+            open Pointer
 
-	    val fromWord = _prim "WordU32_toWord32": word -> t;
-	    val toWord = _prim "WordU32_toWord32": t -> word;
-	       
-	    val null: t = fromWord 0w0
+            val fromWord = _prim "WordU32_toWord32": word -> t;
+            val toWord = _prim "WordU32_toWord32": t -> word;
+               
+            val null: t = fromWord 0w0
 
-	    fun isNull p = p = null
+            fun isNull p = p = null
 
-	    (* val + = _prim "Pointer_add": t * t -> t; *)
-	    (* val op < = _prim "Pointer_lt" : t * t -> bool; *)
-	    (* val - = _prim "Pointer_sub": t * t -> t; *)
-	    val free = _import "free": t -> unit;
-	    val getInt8 = _prim "Pointer_getWord8": t * int -> Int8.int;
-	    val getInt16 = _prim "Pointer_getWord16": t * int -> Int16.int;
-	    val getInt32 = _prim "Pointer_getWord32": t * int -> Int32.int;
-	    val getInt64 = _prim "Pointer_getWord64": t * int -> Int64.int;
-	    val getPointer = _prim "Pointer_getPointer": t * int -> 'a;
-	    val getReal32 = _prim "Pointer_getReal32": t * int -> Real32.real;
-	    val getReal64 = _prim "Pointer_getReal64": t * int -> Real64.real;
-	    val getWord8 = _prim "Pointer_getWord8": t * int -> Word8.word;
-	    val getWord16 = _prim "Pointer_getWord16": t * int -> Word16.word;
-	    val getWord32 = _prim "Pointer_getWord32": t * int -> Word32.word;
-	    val getWord64 = _prim "Pointer_getWord64": t * int -> Word64.word;
-	    val setInt8 = _prim "Pointer_setWord8": t * int * Int8.int -> unit;
-	    val setInt16 =
-	       _prim "Pointer_setWord16": t * int * Int16.int -> unit;
-	    val setInt32 =
-	       _prim "Pointer_setWord32": t * int * Int32.int -> unit;
-	    val setInt64 = 
-	       _prim "Pointer_setWord64": t * int * Int64.int -> unit;
-	    val setPointer = _prim "Pointer_setPointer": t * int * 'a -> unit;
-	    val setReal32 =
-	       _prim "Pointer_setReal32": t * int * Real32.real -> unit;
-	    val setReal64 =
-	       _prim "Pointer_setReal64": t * int * Real64.real -> unit;
-  	    val setWord8 =
-	       _prim "Pointer_setWord8": t * int * Word8.word -> unit;
-	    val setWord16 =
-	       _prim "Pointer_setWord16": t * int * Word16.word -> unit;
-	    val setWord32 =
-	       _prim "Pointer_setWord32": t * int * Word32.word -> unit;
-	    val setWord64 =
-	       _prim "Pointer_setWord64": t * int * Word64.word -> unit;
-	 end
+            (* val + = _prim "Pointer_add": t * t -> t; *)
+            (* val op < = _prim "Pointer_lt": t * t -> bool; *)
+            (* val - = _prim "Pointer_sub": t * t -> t; *)
+(*            val free = _import "free": t -> unit; *)
+            val getInt8 = _prim "Pointer_getWord8": t * int -> Int8.int;
+            val getInt16 = _prim "Pointer_getWord16": t * int -> Int16.int;
+            val getInt32 = _prim "Pointer_getWord32": t * int -> Int32.int;
+            val getInt64 = _prim "Pointer_getWord64": t * int -> Int64.int;
+            val getPointer = _prim "Pointer_getPointer": t * int -> 'a;
+            val getReal32 = _prim "Pointer_getReal32": t * int -> Real32.real;
+            val getReal64 = _prim "Pointer_getReal64": t * int -> Real64.real;
+            val getWord8 = _prim "Pointer_getWord8": t * int -> Word8.word;
+            val getWord16 = _prim "Pointer_getWord16": t * int -> Word16.word;
+            val getWord32 = _prim "Pointer_getWord32": t * int -> Word32.word;
+            val getWord64 = _prim "Pointer_getWord64": t * int -> Word64.word;
+            val setInt8 = _prim "Pointer_setWord8": t * int * Int8.int -> unit;
+            val setInt16 =
+               _prim "Pointer_setWord16": t * int * Int16.int -> unit;
+            val setInt32 =
+               _prim "Pointer_setWord32": t * int * Int32.int -> unit;
+            val setInt64 = 
+               _prim "Pointer_setWord64": t * int * Int64.int -> unit;
+            val setPointer = _prim "Pointer_setPointer": t * int * 'a -> unit;
+            val setReal32 =
+               _prim "Pointer_setReal32": t * int * Real32.real -> unit;
+            val setReal64 =
+               _prim "Pointer_setReal64": t * int * Real64.real -> unit;
+            val setWord8 =
+               _prim "Pointer_setWord8": t * int * Word8.word -> unit;
+            val setWord16 =
+               _prim "Pointer_setWord16": t * int * Word16.word -> unit;
+            val setWord32 =
+               _prim "Pointer_setWord32": t * int * Word32.word -> unit;
+            val setWord64 =
+               _prim "Pointer_setWord64": t * int * Word64.word -> unit;
+         end
 
       structure Real64 =
-	 struct
-	    open Real64
+         struct
+            open Real64
 
-	    structure Class =
-	       struct
-		  type t = int
-		     
-		  val inf = _const "FP_INFINITE": t;
-		  val nan = _const "FP_NAN": t;
-		  val normal = _const "FP_NORMAL": t;
-		  val subnormal = _const "FP_SUBNORMAL": t;
-		  val zero = _const "FP_ZERO": t;
-	       end
-	    
-	    structure Math =
-	       struct
-		  type real = real
+            structure Class =
+               struct
+                  type t = int
+                     
+                  val inf = _const "FP_INFINITE": t;
+                  val nan = _const "FP_NAN": t;
+                  val normal = _const "FP_NORMAL": t;
+                  val subnormal = _const "FP_SUBNORMAL": t;
+                  val zero = _const "FP_ZERO": t;
+               end
+            
+            structure Math =
+               struct
+                  type real = real
 
-		  val acos = _prim "Real64_Math_acos": real -> real;
-		  val asin = _prim "Real64_Math_asin": real -> real;
-		  val atan = _prim "Real64_Math_atan": real -> real;
-		  val atan2 = _prim "Real64_Math_atan2": real * real -> real;
-		  val cos = _prim "Real64_Math_cos": real -> real;
-		  val cosh = _import "cosh": real -> real;
-		  val e = _import "Real64_Math_e": real;
-		  val exp = _prim "Real64_Math_exp": real -> real;
-		  val ln = _prim "Real64_Math_ln": real -> real;
-		  val log10 = _prim "Real64_Math_log10": real -> real;
-		  val pi = _import "Real64_Math_pi": real;
-		  val pow = _import "pow": real * real -> real;
-		  val sin = _prim "Real64_Math_sin": real -> real;
-		  val sinh = _import "sinh": real -> real;
-		  val sqrt = _prim "Real64_Math_sqrt": real -> real;
-		  val tan = _prim "Real64_Math_tan": real -> real;
-		  val tanh = _import "tanh": real -> real;
-	       end
+                  val acos = _prim "Real64_Math_acos": real -> real;
+                  val asin = _prim "Real64_Math_asin": real -> real;
+                  val atan = _prim "Real64_Math_atan": real -> real;
+                  val atan2 = _prim "Real64_Math_atan2": real * real -> real;
+                  val cos = _prim "Real64_Math_cos": real -> real;
+                  val cosh = _import "cosh": real -> real;
+                  val e = #1 _symbol "Real64_Math_e": real GetSet.t; ()
+                  val exp = _prim "Real64_Math_exp": real -> real;
+                  val ln = _prim "Real64_Math_ln": real -> real;
+                  val log10 = _prim "Real64_Math_log10": real -> real;
+                  val pi = #1 _symbol "Real64_Math_pi": real GetSet.t; ()
+                  val pow = _import "pow": real * real -> real;
+                  val sin = _prim "Real64_Math_sin": real -> real;
+                  val sinh = _import "sinh": real -> real;
+                  val sqrt = _prim "Real64_Math_sqrt": real -> real;
+                  val tan = _prim "Real64_Math_tan": real -> real;
+                  val tanh = _import "tanh": real -> real;
+               end
 
-	    val * = _prim "Real64_mul": real * real -> real;
-	    val *+ = _prim "Real64_muladd": real * real * real -> real;
-	    val *- = _prim "Real64_mulsub": real * real * real -> real;
-	    val + = _prim "Real64_add": real * real -> real;
-	    val - = _prim "Real64_sub": real * real -> real;
-	    val / = _prim "Real64_div": real * real -> real;
-	    val op < = _prim "Real64_lt": real * real -> bool;
-	    val op <= = _prim "Real64_le": real * real -> bool;
-	    val == = _prim "Real64_equal": real * real -> bool;
-	    val ?= = _prim "Real64_qequal": real * real -> bool;
-	    val abs = _prim "Real64_abs": real -> real;
-	    val class = _import "Real64_class": real -> int;
-	    val frexp = _import "Real64_frexp": real * int ref -> real;
-	    val gdtoa =
-	       _import "Real64_gdtoa": real * int * int * int ref -> CString.t;
-	    val fromInt = _prim "WordS32_toReal64": int -> real;
-	    val ldexp = _prim "Real64_ldexp": real * int -> real;
-	    val maxFinite = _import "Real64_maxFinite": real;
-	    val minNormalPos = _import "Real64_minNormalPos": real;
-	    val minPos = _import "Real64_minPos": real;
-	    val modf = _import "Real64_modf": real * real ref -> real;
-	    val nextAfter = _import "Real64_nextAfter": real * real -> real;
-	    val round = _prim "Real64_round": real -> real;
-	    val signBit = _import "Real64_signBit": real -> bool;
-	    val strto = _import "Real64_strto": NullString.t -> real;
-	    val toInt = _prim "Real64_toWordS32": real -> int;
-	    val ~ = _prim "Real64_neg": real -> real;
+            val * = _prim "Real64_mul": real * real -> real;
+            val *+ = _prim "Real64_muladd": real * real * real -> real;
+            val *- = _prim "Real64_mulsub": real * real * real -> real;
+            val + = _prim "Real64_add": real * real -> real;
+            val - = _prim "Real64_sub": real * real -> real;
+            val / = _prim "Real64_div": real * real -> real;
+            val op < = _prim "Real64_lt": real * real -> bool;
+            val op <= = _prim "Real64_le": real * real -> bool;
+            val == = _prim "Real64_equal": real * real -> bool;
+            val ?= = _prim "Real64_qequal": real * real -> bool;
+            val abs = _prim "Real64_abs": real -> real;
+            val class = _import "Real64_class": real -> int;
+            val frexp = _import "Real64_frexp": real * int ref -> real;
+            val gdtoa =
+               _import "Real64_gdtoa": real * int * int * int ref -> CString.t;
+            val fromInt = _prim "WordS32_toReal64": int -> real;
+            val ldexp = _prim "Real64_ldexp": real * int -> real;
+            val maxFinite = #1 _symbol "Real64_maxFinite": real GetSet.t; ()
+            val minNormalPos = #1 _symbol "Real64_minNormalPos": real GetSet.t; ()
+            val minPos = #1 _symbol "Real64_minPos": real GetSet.t; ()
+            val modf = _import "Real64_modf": real * real ref -> real;
+            val nextAfter = _import "Real64_nextAfter": real * real -> real;
+            val round = _prim "Real64_round": real -> real;
+            val signBit = _import "Real64_signBit": real -> int;
+            val strto = _import "Real64_strto": NullString.t -> real;
+            val toInt = _prim "Real64_toWordS32": real -> int;
+            val ~ = _prim "Real64_neg": real -> real;
 
-	    val fromLarge : real -> real = fn x => x
-	    val toLarge : real -> real = fn x => x
-	    val precision : int = 53
-	    val radix : int = 2
-	 end
+            val fromLarge : real -> real = fn x => x
+            val toLarge : real -> real = fn x => x
+            val precision : int = 53
+            val radix : int = 2
+         end
       
       structure Real32 =
-	 struct
-	    open Real32
+         struct
+            open Real32
 
-	    val precision : int = 24
-	    val radix : int = 2
+            val precision : int = 24
+            val radix : int = 2
 
-	    val fromLarge = _prim "Real64_toReal32": real64 -> real;
-	    val toLarge = _prim "Real32_toReal64": real -> real64;
+            val fromLarge = _prim "Real64_toReal32": real64 -> real;
+            val toLarge = _prim "Real32_toReal64": real -> real64;
 
-	    fun unary (f: Real64.real -> Real64.real) (r: real): real =
-	       fromLarge (f (toLarge r))
+            fun unary (f: Real64.real -> Real64.real) (r: real): real =
+               fromLarge (f (toLarge r))
 
-	    fun binary (f: Real64.real * Real64.real -> Real64.real)
-	       (r: real, r': real): real =
-	       fromLarge (f (toLarge r, toLarge r'))
-	       
-	    structure Math =
-	       struct
-		  type real = real
+            fun binary (f: Real64.real * Real64.real -> Real64.real)
+               (r: real, r': real): real =
+               fromLarge (f (toLarge r, toLarge r'))
+               
+            structure Math =
+               struct
+                  type real = real
 
-		  val acos = _prim "Real32_Math_acos": real -> real;
-		  val asin = _prim "Real32_Math_asin": real -> real;
-		  val atan = _prim "Real32_Math_atan": real -> real;
-		  val atan2 = _prim "Real32_Math_atan2": real * real -> real;
-		  val cos = _prim "Real32_Math_cos": real -> real;
-		  val cosh = unary Real64.Math.cosh
-		  val e = _import "Real32_Math_e": real;
-		  val exp = _prim "Real32_Math_exp": real -> real;
-		  val ln = _prim "Real32_Math_ln": real -> real;
-		  val log10 = _prim "Real32_Math_log10": real -> real;
-		  val pi = _import "Real32_Math_pi": real;
-		  val pow = binary Real64.Math.pow
-		  val sin = _prim "Real32_Math_sin": real -> real;
-		  val sinh = unary Real64.Math.sinh
-		  val sqrt = _prim "Real32_Math_sqrt": real -> real;
-		  val tan = _prim "Real32_Math_tan": real -> real;
-		  val tanh = unary Real64.Math.tanh
-	       end
+                  val acos = _prim "Real32_Math_acos": real -> real;
+                  val asin = _prim "Real32_Math_asin": real -> real;
+                  val atan = _prim "Real32_Math_atan": real -> real;
+                  val atan2 = _prim "Real32_Math_atan2": real * real -> real;
+                  val cos = _prim "Real32_Math_cos": real -> real;
+                  val cosh = unary Real64.Math.cosh
+                  val e = #1 _symbol "Real32_Math_e": real GetSet.t; ()
+                  val exp = _prim "Real32_Math_exp": real -> real;
+                  val ln = _prim "Real32_Math_ln": real -> real;
+                  val log10 = _prim "Real32_Math_log10": real -> real;
+                  val pi = #1 _symbol "Real32_Math_pi": real GetSet.t; ()
+                  val pow = binary Real64.Math.pow
+                  val sin = _prim "Real32_Math_sin": real -> real;
+                  val sinh = unary Real64.Math.sinh
+                  val sqrt = _prim "Real32_Math_sqrt": real -> real;
+                  val tan = _prim "Real32_Math_tan": real -> real;
+                  val tanh = unary Real64.Math.tanh
+               end
 
-	    val * = _prim "Real32_mul": real * real -> real;
-	    val *+ = _prim "Real32_muladd": real * real * real -> real;
-	    val *- = _prim "Real32_mulsub": real * real * real -> real;
-	    val + = _prim "Real32_add": real * real -> real;
-	    val - = _prim "Real32_sub": real * real -> real;
-	    val / = _prim "Real32_div": real * real -> real;
-	    val op < = _prim "Real32_lt": real * real -> bool;
-	    val op <= = _prim "Real32_le": real * real -> bool;
-	    val == = _prim "Real32_equal": real * real -> bool;
-	    val ?= = _prim "Real32_qequal": real * real -> bool;
-	    val abs = _prim "Real32_abs": real -> real;
-	    val class = _import "Real32_class": real -> int;
-	    fun frexp (r: real, ir: int ref): real =
-	       fromLarge (Real64.frexp (toLarge r, ir))
-	    val gdtoa =
-	       _import "Real32_gdtoa": real * int * int * int ref -> CString.t;
-	    val fromInt = _prim "WordS32_toReal32": int -> real;
-	    val ldexp = _prim "Real32_ldexp": real * int -> real;
-	    val maxFinite = _import "Real32_maxFinite": real;
-	    val minNormalPos = _import "Real32_minNormalPos": real;
-	    val minPos = _import "Real32_minPos": real;
-	    val modf = _import "Real32_modf": real * real ref -> real;
-	    val signBit = _import "Real32_signBit": real -> bool;
-	    val strto = _import "Real32_strto": NullString.t -> real;
-	    val toInt = _prim "Real32_toWordS32": real -> int;
-	    val ~ = _prim "Real32_neg": real -> real;
-	 end
+            val * = _prim "Real32_mul": real * real -> real;
+            val *+ = _prim "Real32_muladd": real * real * real -> real;
+            val *- = _prim "Real32_mulsub": real * real * real -> real;
+            val + = _prim "Real32_add": real * real -> real;
+            val - = _prim "Real32_sub": real * real -> real;
+            val / = _prim "Real32_div": real * real -> real;
+            val op < = _prim "Real32_lt": real * real -> bool;
+            val op <= = _prim "Real32_le": real * real -> bool;
+            val == = _prim "Real32_equal": real * real -> bool;
+            val ?= = _prim "Real32_qequal": real * real -> bool;
+            val abs = _prim "Real32_abs": real -> real;
+            val class = _import "Real32_class": real -> int;
+            fun frexp (r: real, ir: int ref): real =
+               fromLarge (Real64.frexp (toLarge r, ir))
+            val gdtoa =
+               _import "Real32_gdtoa": real * int * int * int ref -> CString.t;
+            val fromInt = _prim "WordS32_toReal32": int -> real;
+            val ldexp = _prim "Real32_ldexp": real * int -> real;
+            val maxFinite = #1 _symbol "Real32_maxFinite": real GetSet.t; ()
+            val minNormalPos = #1 _symbol "Real32_minNormalPos": real GetSet.t; ()
+            val minPos = #1 _symbol "Real32_minPos": real GetSet.t; ()
+            val modf = _import "Real32_modf": real * real ref -> real;
+            val signBit = _import "Real32_signBit": real -> int;
+            val strto = _import "Real32_strto": NullString.t -> real;
+            val toInt = _prim "Real32_toWordS32": real -> int;
+            val ~ = _prim "Real32_neg": real -> real;
+         end
     
       structure Real32 =
-	 struct
-	    open Real32
-	    local
-	       structure S = RealComparisons (Real32)
-	    in
-	       open S
-	    end
-	 end
+         struct
+            open Real32
+            local
+               structure S = RealComparisons (Real32)
+            in
+               open S
+            end
+         end
 
       structure Real64 =
-	 struct
-	    open Real64
-	    local
-	       structure S = RealComparisons (Real64)
-	    in
-	       open S
-	    end
-	 end
+         struct
+            open Real64
+            local
+               structure S = RealComparisons (Real64)
+            in
+               open S
+            end
+         end
 
       structure Ref =
-	 struct
-	    val deref = _prim "Ref_deref": 'a ref -> 'a;
-	    val assign = _prim "Ref_assign": 'a ref * 'a -> unit;
-	 end
+         struct
+            val deref = _prim "Ref_deref": 'a ref -> 'a;
+            val assign = _prim "Ref_assign": 'a ref * 'a -> unit;
+         end
 
       structure Signal:>
-	 sig
-	    eqtype t
-	    type how
+         sig
+            eqtype t
+            type how
 
-	    val fromInt: int -> t
-	    val toInt: t -> int
-	 end =
-	 struct
-	    type t = int
-	    type how = int
+            val fromInt: int -> t
+            val toInt: t -> int
+         end =
+         struct
+            type t = int
+            type how = int
 
-	    val fromInt = fn s => s
-	    val toInt = fn s => s
-	 end
+            val fromInt = fn s => s
+            val toInt = fn s => s
+         end
 
+      structure Socket:>
+         sig
+            type sock
+
+            val fromInt: int -> sock
+            val toInt: sock -> int
+         end =
+         struct
+            type sock = int
+
+            fun fromInt i = i
+            fun toInt i = i
+         end
+            
       structure Socket =
-	 struct
-	    type sock = int
-	    type pre_sock_addr = word8 array
-	    type sock_addr = word8 vector
-	    val sockAddrLenMax = _const "Socket_sockAddrLenMax": int;
-	    structure AF =
-	       struct
-		  type addr_family = int
-		  val UNIX = _const "Socket_AF_UNIX": addr_family;
-		  val INET = _const "Socket_AF_INET": addr_family;
-		  val INET6 = _const "Socket_AF_INET6": addr_family;
-		  val UNSPEC = _const "Socket_AF_UNSPEC": addr_family;
-	       end
-	    structure SOCK:>
-	       sig
-		  eqtype sock_type
+         struct
+            open Socket
 
-		  val fromInt: int -> sock_type
-	       end =
-	       struct
-		  type sock_type = int
+            type pre_sock_addr = word8 array
+            type sock_addr = word8 vector
+            val sockAddrLenMax = _const "Socket_sockAddrLenMax": int;
+            structure AF =
+               struct
+                  type addr_family = int
+                  val UNIX = _const "Socket_AF_UNIX": addr_family;
+                  val INET = _const "Socket_AF_INET": addr_family;
+                  val INET6 = _const "Socket_AF_INET6": addr_family;
+                  val UNSPEC = _const "Socket_AF_UNSPEC": addr_family;
+               end
+            structure SOCK:>
+               sig
+                  eqtype sock_type
 
-		  val fromInt = fn i => i
-	       end
-	    structure SOCK =
-	       struct
-		  open SOCK
-		  val STREAM = _const "Socket_SOCK_STREAM": sock_type;
-		  val DGRAM = _const "Socket_SOCK_DGRAM": sock_type;
-	       end
-	    structure CtlExtra =
-	       struct
-		  type level = int
-		  type optname = int
-		  type request = int
-		  (* host byte order (LSB) *)
-		  type read_data = word8 vector
-		  type write_data = word8 array
+                  val fromInt: int -> sock_type
+               end =
+               struct
+                  type sock_type = int
 
-		  val setSockOpt = 
-		     _import "Socket_Ctl_setSockOpt": sock * level * optname * 
-		                                   read_data * int -> 
+                  val fromInt = fn i => i
+               end
+            structure SOCK =
+               struct
+                  open SOCK
+                  val STREAM = _const "Socket_SOCK_STREAM": sock_type;
+                  val DGRAM = _const "Socket_SOCK_DGRAM": sock_type;
+               end
+            structure CtlExtra =
+               struct
+                  type level = int
+                  type optname = int
+                  type request = int
+                  (* host byte order (LSB) *)
+                  type read_data = word8 vector
+                  type write_data = word8 array
+
+                  val setSockOpt = 
+                     _import "Socket_Ctl_setSockOpt": sock * level * optname * 
+                                                   read_data * int -> 
                                                    int;
-		  val getSockOpt = 
-		     _import "Socket_Ctl_getSockOpt": sock * level * optname * 
-		                                   write_data * int ref -> 
+                  val getSockOpt = 
+                     _import "Socket_Ctl_getSockOpt": sock * level * optname * 
+                                                   write_data * int ref -> 
                                                    int;
-		  val setIOCtl =
-		     _import "Socket_Ctl_getsetIOCtl": sock * request *
-		                                    read_data ->
-						    int;
-		  val getIOCtl =
-		     _import "Socket_Ctl_getsetIOCtl": sock * request *
-		                                    write_data ->
-						    int;
-	       end
-	    structure Ctl =
-	       struct
-		  open CtlExtra
-		  val SOCKET = _const "Socket_Ctl_SOL_SOCKET": level;
-		  val DEBUG = _const "Socket_Ctl_SO_DEBUG": optname;
-		  val REUSEADDR = _const "Socket_Ctl_SO_REUSEADDR": optname;
-		  val KEEPALIVE = _const "Socket_Ctl_SO_KEEPALIVE": optname;
-		  val DONTROUTE = _const "Socket_Ctl_SO_DONTROUTE": optname;
-		  val LINGER = _const "Socket_Ctl_SO_LINGER": optname;
-		  val BROADCAST = _const "Socket_Ctl_SO_BROADCAST": optname;
-		  val OOBINLINE = _const "Socket_Ctl_SO_OOBINLINE": optname;
-		  val SNDBUF = _const "Socket_Ctl_SO_SNDBUF": optname;
-		  val RCVBUF = _const "Socket_Ctl_SO_RCVBUF": optname;
-		  val TYPE = _const "Socket_Ctl_SO_TYPE": optname;
-		  val ERROR = _const "Socket_Ctl_SO_ERROR": optname;
+                  val setIOCtl =
+                     _import "Socket_Ctl_getsetIOCtl": sock * request *
+                                                    read_data ->
+                                                    int;
+                  val getIOCtl =
+                     _import "Socket_Ctl_getsetIOCtl": sock * request *
+                                                    write_data ->
+                                                    int;
+               end
+            structure Ctl =
+               struct
+                  open CtlExtra
+                  val SOCKET = _const "Socket_Ctl_SOL_SOCKET": level;
+                  val DEBUG = _const "Socket_Ctl_SO_DEBUG": optname;
+                  val REUSEADDR = _const "Socket_Ctl_SO_REUSEADDR": optname;
+                  val KEEPALIVE = _const "Socket_Ctl_SO_KEEPALIVE": optname;
+                  val DONTROUTE = _const "Socket_Ctl_SO_DONTROUTE": optname;
+                  val LINGER = _const "Socket_Ctl_SO_LINGER": optname;
+                  val BROADCAST = _const "Socket_Ctl_SO_BROADCAST": optname;
+                  val OOBINLINE = _const "Socket_Ctl_SO_OOBINLINE": optname;
+                  val SNDBUF = _const "Socket_Ctl_SO_SNDBUF": optname;
+                  val RCVBUF = _const "Socket_Ctl_SO_RCVBUF": optname;
+                  val TYPE = _const "Socket_Ctl_SO_TYPE": optname;
+                  val ERROR = _const "Socket_Ctl_SO_ERROR": optname;
 
-		  val getPeerName =
-		     _import "Socket_Ctl_getPeerName": sock * pre_sock_addr * int ref -> int;
-		  val getSockName =
-		     _import "Socket_Ctl_getSockName": sock * pre_sock_addr * int ref -> int;
+                  val getPeerName =
+                     _import "Socket_Ctl_getPeerName": sock * pre_sock_addr * int ref -> int;
+                  val getSockName =
+                     _import "Socket_Ctl_getSockName": sock * pre_sock_addr * int ref -> int;
 
-		  (* val NBIO = _const "Socket_Ctl_FIONBIO": request; *)
-		  val NREAD = _const "Socket_Ctl_FIONREAD": request;
-		  val ATMARK = _const "Socket_Ctl_SIOCATMARK": request;
-	       end
+                  (* val NBIO = _const "Socket_Ctl_FIONBIO": request; *)
+                  val NREAD = _const "Socket_Ctl_FIONREAD": request;
+                  val ATMARK = _const "Socket_Ctl_SIOCATMARK": request;
+               end
 
-	    val familyOfAddr = _import "Socket_familyOfAddr": sock_addr -> AF.addr_family;
-	    val bind = _import "Socket_bind": sock * sock_addr * int -> int;
-	    val listen = _import "Socket_listen": sock * int -> int;
-	    val connect = _import "Socket_connect": sock * sock_addr * int -> int;
-	    val accept = _import "Socket_accept": sock * pre_sock_addr * int ref -> int;
-	    val close = _import "Socket_close": sock -> int;
+            val familyOfAddr =
+               _import "Socket_familyOfAddr": sock_addr -> AF.addr_family;
+            val bind = _import "Socket_bind": sock * sock_addr * int -> int;
+            val listen = _import "Socket_listen": sock * int -> int;
+            val connect =
+               _import "Socket_connect": sock * sock_addr * int -> int;
+            val accept =
+               _import "Socket_accept": sock * pre_sock_addr * int ref -> int;
+            val close = _import "Socket_close": sock -> int;
 
-	    type how = int
-	    val SHUT_RD = _const "Socket_SHUT_RD": how;
-	    val SHUT_WR = _const "Socket_SHUT_WR": how;
-	    val SHUT_RDWR = _const "Socket_SHUT_RDWR": how;
-	    val shutdown = _import "Socket_shutdown": sock * how -> int;
+            type how = int
+            val SHUT_RD = _const "Socket_SHUT_RD": how;
+            val SHUT_WR = _const "Socket_SHUT_WR": how;
+            val SHUT_RDWR = _const "Socket_SHUT_RDWR": how;
+            val shutdown = _import "Socket_shutdown": sock * how -> int;
 
-	    type flags = word
-	    val MSG_DONTROUTE = _const "Socket_MSG_DONTROUTE": flags;
-	    val MSG_DONTWAIT = _const "Socket_MSG_DONTWAIT": flags;
-	    val MSG_OOB = _const "Socket_MSG_OOB": flags;
-	    val MSG_PEEK = _const "Socket_MSG_PEEK": flags;
+            type flags = word
+            val MSG_DONTROUTE = _const "Socket_MSG_DONTROUTE": flags;
+            val MSG_DONTWAIT = _const "Socket_MSG_DONTWAIT": flags;
+            val MSG_OOB = _const "Socket_MSG_OOB": flags;
+            val MSG_PEEK = _const "Socket_MSG_PEEK": flags;
 
-	    val sendArr = _import "Socket_send":
-	       sock * word8 array * int * int * word -> int;
-	    val sendVec = _import "Socket_send":
-	       sock * word8 vector * int * int * word -> int;
-	    val sendToArr = _import "Socket_sendTo":
-	       sock * word8 array * int * int * word * sock_addr * int -> int;
-	    val sendToVec = _import "Socket_sendTo":
-	       sock * word8 vector * int * int * word * sock_addr * int -> int;
-	    val recv = _import "Socket_recv":
-	       sock * word8 array * int * int * word -> int;
-	    val recvFrom = _import "Socket_recvFrom":
-	       sock * word8 array * int * int * word * pre_sock_addr * int ref
-	       -> int;
+            val sendArr = _import "Socket_send":
+               sock * word8 array * int * int * word -> int;
+            val sendVec = _import "Socket_send":
+               sock * word8 vector * int * int * word -> int;
+            val sendToArr = _import "Socket_sendTo":
+               sock * word8 array * int * int * word * sock_addr * int -> int;
+            val sendToVec = _import "Socket_sendTo":
+               sock * word8 vector * int * int * word * sock_addr * int -> int;
+            val recv = _import "Socket_recv":
+               sock * word8 array * int * int * word -> int;
+            val recvFrom = _import "Socket_recvFrom":
+               sock * word8 array * int * int * word * pre_sock_addr * int ref
+               -> int;
 
-	    structure GenericSock =
-	       struct
-		  val socket = 
-		     _import "GenericSock_socket": AF.addr_family * 
-		                                SOCK.sock_type * 
-						int -> int;
-		  val socketPair = 
-		     _import "GenericSock_socketPair": AF.addr_family * 
-		                                    SOCK.sock_type * 
-						    int * 
-						    int ref * int ref -> int;
-	       end
+            structure GenericSock =
+               struct
+                  val socket = 
+                     _import "GenericSock_socket": AF.addr_family * 
+                                                SOCK.sock_type * 
+                                                int -> int;
+                  val socketPair = 
+                     _import "GenericSock_socketPair": AF.addr_family * 
+                                                    SOCK.sock_type * 
+                                                    int * 
+                                                    int ref * int ref -> int;
+               end
 
-	    structure INetSock =
-	       struct
-		  val toAddr = _import "INetSock_toAddr": NetHostDB.in_addr * int * 
+            structure INetSock =
+               struct
+                  val toAddr = _import "INetSock_toAddr": NetHostDB.in_addr * int * 
                                                        pre_sock_addr * int ref -> unit;
-		  val fromAddr = _import "INetSock_fromAddr": sock_addr -> unit;
-		  val getInAddr = _import "INetSock_getInAddr": NetHostDB.pre_in_addr -> 
+                  val fromAddr = _import "INetSock_fromAddr": sock_addr -> unit;
+                  val getInAddr = _import "INetSock_getInAddr": NetHostDB.pre_in_addr -> 
                                                              unit;
-		  val getPort = _import "INetSock_getPort": unit -> int;
-		  structure TCP =
-		     struct
-		        open CtlExtra
-		        val TCP = _const "Socket_INetSock_TCP_SOL_TCP": level;
-			val NODELAY = _const "Socket_INetSock_TCP_SO_NODELAY": optname;
-		     end
-	       end
-	    structure UnixSock =
-	       struct
-		  val toAddr =
-		     _import "UnixSock_toAddr"
-		     : NullString.t * int * pre_sock_addr * int ref -> unit;
-		  val pathLen = _import "UnixSock_pathLen": sock_addr -> int;
-		  val fromAddr =
-		     _import "UnixSock_fromAddr"
-		     : sock_addr * char array * int -> unit;
-	       end
-	 end
+                  val getPort = _import "INetSock_getPort": unit -> int;
+                  structure TCP =
+                     struct
+                        open CtlExtra
+                        val TCP = _const "Socket_INetSock_TCP_SOL_TCP": level;
+                        val NODELAY = _const "Socket_INetSock_TCP_SO_NODELAY": optname;
+                     end
+               end
+            structure UnixSock =
+               struct
+                  val toAddr =
+                     _import "UnixSock_toAddr"
+                     : NullString.t * int * pre_sock_addr * int ref -> unit;
+                  val pathLen = _import "UnixSock_pathLen": sock_addr -> int;
+                  val fromAddr =
+                     _import "UnixSock_fromAddr"
+                     : sock_addr * char array * int -> unit;
+               end
+         end
 
       structure Status:>
-	 sig
-	    eqtype t
+         sig
+            eqtype t
 
-	    val failure: t
-	    val fromInt: int -> t
-	    val success: t
-	    val toInt: t -> int
-	 end =
-	 struct
-	    type t = int
+            val failure: t
+            val fromInt: int -> t
+            val success: t
+            val toInt: t -> int
+         end =
+         struct
+            type t = int
 
-	    val failure = 1
-	    val fromInt = fn i => i
-	    val success = 0
-	    val toInt = fn i => i
-	 end
+            val failure = 1
+            val fromInt = fn i => i
+            val success = 0
+            val toInt = fn i => i
+         end
 
       val halt = _prim "MLton_halt": Status.t -> unit;
 
       structure String =
-	 struct
-	    val fromWord8Vector =
-	       _prim "Word8Vector_toString": word8 vector -> string;
-	    val toWord8Vector =
-	       _prim "String_toWord8Vector": string -> word8 vector;
-	 end
+         struct
+            val fromWord8Vector =
+               _prim "Word8Vector_toString": word8 vector -> string;
+            val toWord8Vector =
+               _prim "String_toWord8Vector": string -> word8 vector;
+         end
 
       structure TextIO =
-	 struct
-	    val bufSize = _command_line_const "TextIO.bufSize": int = 4096;
-	 end
+         struct
+            val bufSize = _command_line_const "TextIO.bufSize": int = 4096;
+         end
       
       structure Thread =
-	 struct
-	    type preThread = PreThread.t
-	    type thread = Thread.t
+         struct
+            type preThread = PreThread.t
+            type thread = Thread.t
 
-	    val atomicBegin = _prim "Thread_atomicBegin": unit -> unit;
-	    val canHandle = _prim "Thread_canHandle": unit -> int;
-	    fun atomicEnd () =
-	       if Int.<= (canHandle (), 0)
-		  then raise Fail "Thread.atomicEnd with no atomicBegin"
-	       else _prim "Thread_atomicEnd": unit -> unit; ()
-	    val copy = _prim "Thread_copy": preThread -> thread;
-	    (* copyCurrent's result is accesible via savedPre ().
-	     * It is not possible to have the type of copyCurrent as
-	     * unit -> preThread, because there are two different ways to
-	     * return from the call to copyCurrent.  One way is the direct
-	     * obvious way, in the thread that called copyCurrent.  That one,
-	     * of course, wants to call savedPre ().  However, another way to
-	     * return is by making a copy of the preThread and then switching
-	     * to it.  In that case, there is no preThread to return.  Making
-	     * copyCurrent return a preThread creates nasty bugs where the
-	     * return code from the CCall expects to see a preThread result
-	     * according to the C return convention, but there isn't one when
-	     * switching to a copy.
-	     *)
-	    val copyCurrent = _prim "Thread_copyCurrent": unit -> unit;
-	    val current = _import "Thread_current": unit -> thread;
-	    val finishHandler = _import "Thread_finishHandler": unit -> unit;
-	    val returnToC = _prim "Thread_returnToC": unit -> unit;
-	    val saved = _import "Thread_saved": unit -> thread;
-	    val savedPre = _import "Thread_saved": unit -> preThread;
-	    val setCallFromCHandler =
-	       _import "Thread_setCallFromCHandler": thread -> unit;
-	    val setHandler = _import "Thread_setHandler": thread -> unit;
-	    val setSaved = _import "Thread_setSaved": thread -> unit;
-	    val startHandler = _import "Thread_startHandler": unit -> unit;
-	    val switchTo = _prim "Thread_switchTo": thread -> unit;
-	 end      
+            val atomicBegin = _prim "Thread_atomicBegin": unit -> unit;
+            val canHandle = _prim "Thread_canHandle": unit -> int;
+            fun atomicEnd () =
+               if Int.<= (canHandle (), 0)
+                  then raise Fail "Thread.atomicEnd with no atomicBegin"
+               else _prim "Thread_atomicEnd": unit -> unit; ()
+            val copy = _prim "Thread_copy": preThread -> thread;
+            (* copyCurrent's result is accesible via savedPre ().
+             * It is not possible to have the type of copyCurrent as
+             * unit -> preThread, because there are two different ways to
+             * return from the call to copyCurrent.  One way is the direct
+             * obvious way, in the thread that called copyCurrent.  That one,
+             * of course, wants to call savedPre ().  However, another way to
+             * return is by making a copy of the preThread and then switching
+             * to it.  In that case, there is no preThread to return.  Making
+             * copyCurrent return a preThread creates nasty bugs where the
+             * return code from the CCall expects to see a preThread result
+             * according to the C return convention, but there isn't one when
+             * switching to a copy.
+             *)
+            val copyCurrent = _prim "Thread_copyCurrent": unit -> unit;
+            val current = _import "Thread_current": unit -> thread;
+            val finishHandler = _import "Thread_finishHandler": unit -> unit;
+            val returnToC = _prim "Thread_returnToC": unit -> unit;
+            val saved = _import "Thread_saved": unit -> thread;
+            val savedPre = _import "Thread_saved": unit -> preThread;
+            val setCallFromCHandler =
+               _import "Thread_setCallFromCHandler": thread -> unit;
+            val setHandler = _import "Thread_setHandler": thread -> unit;
+            val setSaved = _import "Thread_setSaved": thread -> unit;
+            val startHandler = _import "Thread_startHandler": unit -> unit;
+            val switchTo = _prim "Thread_switchTo": thread -> unit;
+         end      
 
       structure Time =
-	 struct
-	    val gettimeofday = _import "Time_gettimeofday": unit -> int;
-	    val sec = _import "Time_sec": unit -> int;
-	    val usec = _import "Time_usec": unit -> int;
-	 end
+         struct
+            val gettimeofday = _import "Time_gettimeofday": unit -> int;
+            val sec = _import "Time_sec": unit -> int;
+            val usec = _import "Time_usec": unit -> int;
+         end
 
       structure TopLevel =
-	 struct
-	    val setHandler =
-	       _prim "TopLevel_setHandler": (exn -> unit) -> unit;
-	    val setSuffix =
-	       _prim "TopLevel_setSuffix": (unit -> unit) -> unit;
-	 end
+         struct
+            val setHandler =
+               _prim "TopLevel_setHandler": (exn -> unit) -> unit;
+            val setSuffix =
+               _prim "TopLevel_setSuffix": (unit -> unit) -> unit;
+         end
 
       structure Vector =
-	 struct
-	    val sub = _prim "Vector_sub": 'a vector * int -> 'a;
-	    val length = _prim "Vector_length": 'a vector -> int;
+         struct
+            val sub = _prim "Vector_sub": 'a vector * int -> 'a;
+            val length = _prim "Vector_length": 'a vector -> int;
 
-	    (* Don't mutate the array after you apply fromArray, because vectors
-	     * are supposed to be immutable and the optimizer depends on this.
-	     *)
-	    val fromArray = _prim "Array_toVector": 'a array -> 'a vector;
-	 end
+            (* Don't mutate the array after you apply fromArray, because vectors
+             * are supposed to be immutable and the optimizer depends on this.
+             *)
+            val fromArray = _prim "Array_toVector": 'a array -> 'a vector;
+         end
 
-      structure Cygwin =
-	 struct
-	    val toFullWindowsPath =
-	       _import "Cygwin_toFullWindowsPath": NullString.t -> CString.t;
-	 end
-
-      structure Windows =
-	 struct
-	    structure Process =
-	       struct
-		  val create = 
-		     _import "Windows_Process_create"
-		     : (NullString.t * NullString.t * NullString.t
-			* int * int * int) -> Pid.t;
-		  val terminate =
-		     _import "Windows_terminate": Pid.t * Signal.t -> int;
-	       end
-	 end
-
       structure Word1 =
-	 struct
-	    type big = Word8.word
-	    type word = word1
-	    val fromBigUnsafe = _prim "WordU8_toWord1": big -> word;
-	    val toBig = _prim "WordU1_toWord8": word -> big;
-	    val wordSize = 1
-	 end
+         struct
+            type big = Word8.word
+            type word = word1
+            val fromBigUnsafe = _prim "WordU8_toWord1": big -> word;
+            val toBig = _prim "WordU1_toWord8": word -> big;
+            val wordSize = 1
+         end
       structure Word2 =
-	 struct
-	    type big = Word8.word
-	    type word = word2
-	    val fromBigUnsafe = _prim "WordU8_toWord2": big -> word;
-	    val toBig = _prim "WordU2_toWord8": word -> big;
-	    val wordSize = 2
-	 end
+         struct
+            type big = Word8.word
+            type word = word2
+            val fromBigUnsafe = _prim "WordU8_toWord2": big -> word;
+            val toBig = _prim "WordU2_toWord8": word -> big;
+            val wordSize = 2
+         end
       structure Word3 =
-	 struct
-	    type big = Word8.word
-	    type word = word3
-	    val fromBigUnsafe = _prim "WordU8_toWord3": big -> word;
-	    val toBig = _prim "WordU3_toWord8": word -> big;
-	    val wordSize = 3
-	 end
+         struct
+            type big = Word8.word
+            type word = word3
+            val fromBigUnsafe = _prim "WordU8_toWord3": big -> word;
+            val toBig = _prim "WordU3_toWord8": word -> big;
+            val wordSize = 3
+         end
       structure Word4 =
-	 struct
-	    type big = Word8.word
-	    type word = word4
-	    val fromBigUnsafe = _prim "WordU8_toWord4": big -> word;
-	    val toBig = _prim "WordU4_toWord8": word -> big;
-	    val wordSize = 4
-	 end
+         struct
+            type big = Word8.word
+            type word = word4
+            val fromBigUnsafe = _prim "WordU8_toWord4": big -> word;
+            val toBig = _prim "WordU4_toWord8": word -> big;
+            val wordSize = 4
+         end
       structure Word5 =
-	 struct
-	    type big = Word8.word
-	    type word = word5
-	    val fromBigUnsafe = _prim "WordU8_toWord5": big -> word;
-	    val toBig = _prim "WordU5_toWord8": word -> big;
-	    val wordSize = 5
-	 end
+         struct
+            type big = Word8.word
+            type word = word5
+            val fromBigUnsafe = _prim "WordU8_toWord5": big -> word;
+            val toBig = _prim "WordU5_toWord8": word -> big;
+            val wordSize = 5
+         end
       structure Word6 =
-	 struct
-	    type big = Word8.word
-	    type word = word6
-	    val fromBigUnsafe = _prim "WordU8_toWord6": big -> word;
-	    val toBig = _prim "WordU6_toWord8": word -> big;
-	    val wordSize = 6
-	 end
+         struct
+            type big = Word8.word
+            type word = word6
+            val fromBigUnsafe = _prim "WordU8_toWord6": big -> word;
+            val toBig = _prim "WordU6_toWord8": word -> big;
+            val wordSize = 6
+         end
       structure Word7 =
-	 struct
-	    type big = Word8.word
-	    type word = word7
-	    val fromBigUnsafe = _prim "WordU8_toWord7": big -> word;
-	    val toBig = _prim "WordU7_toWord8": word -> big;
-	    val wordSize = 7
-	 end
+         struct
+            type big = Word8.word
+            type word = word7
+            val fromBigUnsafe = _prim "WordU8_toWord7": big -> word;
+            val toBig = _prim "WordU7_toWord8": word -> big;
+            val wordSize = 7
+         end
       structure Word8 =
-	 struct
-	    open Word8
-	       
-	    val wordSize: int = 8
+         struct
+            open Word8
+               
+            val wordSize: int = 8
 
-	    val + = _prim "Word8_add": word * word -> word;
-	    val andb = _prim "Word8_andb": word * word -> word;
-	    val ~>> = _prim "WordS8_rshift": word * Word.word -> word;
-	    val div = _prim "WordU8_quot": word * word -> word;
-	    val fromInt = _prim "WordU32_toWord8": int -> word;
-	    val fromLarge = _prim "WordU64_toWord8": LargeWord.word -> word;
-	    val << = _prim "Word8_lshift": word * Word.word -> word;
-	    val op < = _prim "WordU8_lt" : word * word -> bool;
-	    val mod = _prim "WordU8_rem": word * word -> word;
-	    val * = _prim "WordU8_mul": word * word -> word;
-	    val ~ = _prim "Word8_neg": word -> word;
-	    val notb = _prim "Word8_notb": word -> word;
-	    val orb = _prim "Word8_orb": word * word -> word;
-	    val rol = _prim "Word8_rol": word * Word.word -> word;
-	    val ror = _prim "Word8_ror": word * Word.word -> word;
-	    val >> = _prim "WordU8_rshift": word * Word.word -> word;
-	    val - = _prim "Word8_sub": word * word -> word;
-	    val toInt = _prim "WordU8_toWord32": word -> int;
-	    val toIntX = _prim "WordS8_toWord32": word -> int;
-	    val toLarge = _prim "WordU8_toWord64": word -> LargeWord.word;
-	    val toLargeX = _prim "WordS8_toWord64": word -> LargeWord.word;
-	    val xorb = _prim "Word8_xorb": word * word -> word;
-	 end
+            val + = _prim "Word8_add": word * word -> word;
+            val andb = _prim "Word8_andb": word * word -> word;
+            val ~>> = _prim "WordS8_rshift": word * Word.word -> word;
+            val div = _prim "WordU8_quot": word * word -> word;
+            val fromInt = _prim "WordU32_toWord8": int -> word;
+            val fromLarge = _prim "WordU64_toWord8": LargeWord.word -> word;
+            val << = _prim "Word8_lshift": word * Word.word -> word;
+            val op < = _prim "WordU8_lt": word * word -> bool;
+            val mod = _prim "WordU8_rem": word * word -> word;
+            val * = _prim "WordU8_mul": word * word -> word;
+            val ~ = _prim "Word8_neg": word -> word;
+            val notb = _prim "Word8_notb": word -> word;
+            val orb = _prim "Word8_orb": word * word -> word;
+            val rol = _prim "Word8_rol": word * Word.word -> word;
+            val ror = _prim "Word8_ror": word * Word.word -> word;
+            val >> = _prim "WordU8_rshift": word * Word.word -> word;
+            val - = _prim "Word8_sub": word * word -> word;
+            val toInt = _prim "WordU8_toWord32": word -> int;
+            val toIntX = _prim "WordS8_toWord32": word -> int;
+            val toLarge = _prim "WordU8_toWord64": word -> LargeWord.word;
+            val toLargeX = _prim "WordS8_toWord64": word -> LargeWord.word;
+            val xorb = _prim "Word8_xorb": word * word -> word;
+         end
       structure Word8 =
-	 struct
-	    open Word8
-	    local
-	       structure S = Comparisons (Word8)
-	    in
-	       open S
-	    end
-	 end
+         struct
+            open Word8
+            local
+               structure S = Comparisons (Word8)
+            in
+               open S
+            end
+         end
       structure Word8Array =
-	 struct
-	    val subWord =
-	       _prim "Word8Array_subWord": word8 array * int -> word;
-	    val subWordRev =
-	       _import "Word8Array_subWord32Rev": word8 array * int -> word;
-	    val updateWord =
-	       _prim "Word8Array_updateWord": word8 array * int * word -> unit;
-	    val updateWordRev =
-	       _import "Word8Array_updateWord32Rev": word8 array * int * word -> unit;
-	 end
+         struct
+            val subWord =
+               _prim "Word8Array_subWord": word8 array * int -> word;
+            val subWordRev =
+               _import "Word8Array_subWord32Rev": word8 array * int -> word;
+            val updateWord =
+               _prim "Word8Array_updateWord": word8 array * int * word -> unit;
+            val updateWordRev =
+               _import "Word8Array_updateWord32Rev": word8 array * int * word -> unit;
+         end
       structure Word8Vector =
-	 struct
-	    val subWord =
-	       _prim "Word8Vector_subWord": word8 vector * int -> word;
-	    val subWordRev =
-	       _import "Word8Vector_subWord32Rev": word8 vector * int -> word;
-	 end
+         struct
+            val subWord =
+               _prim "Word8Vector_subWord": word8 vector * int -> word;
+            val subWordRev =
+               _import "Word8Vector_subWord32Rev": word8 vector * int -> word;
+         end
       structure Word9 =
-	 struct
-	    type big = Word16.word
-	    type word = word9
-	    val fromBigUnsafe = _prim "WordU16_toWord9": big -> word;
-	    val toBig = _prim "WordU9_toWord16": word -> big;
-	    val wordSize = 9
-	 end
+         struct
+            type big = Word16.word
+            type word = word9
+            val fromBigUnsafe = _prim "WordU16_toWord9": big -> word;
+            val toBig = _prim "WordU9_toWord16": word -> big;
+            val wordSize = 9
+         end
       structure Word10 =
-	 struct
-	    type big = Word16.word
-	    type word = word10
-	    val fromBigUnsafe = _prim "WordU16_toWord10": big -> word;
-	    val toBig = _prim "WordU10_toWord16": word -> big;
-	    val wordSize = 10
-	 end
+         struct
+            type big = Word16.word
+            type word = word10
+            val fromBigUnsafe = _prim "WordU16_toWord10": big -> word;
+            val toBig = _prim "WordU10_toWord16": word -> big;
+            val wordSize = 10
+         end
       structure Word11 =
-	 struct
-	    type big = Word16.word
-	    type word = word11
-	    val fromBigUnsafe = _prim "WordU16_toWord11": big -> word;
-	    val toBig = _prim "WordU11_toWord16": word -> big;
-	    val wordSize = 11
-	 end
+         struct
+            type big = Word16.word
+            type word = word11
+            val fromBigUnsafe = _prim "WordU16_toWord11": big -> word;
+            val toBig = _prim "WordU11_toWord16": word -> big;
+            val wordSize = 11
+         end
       structure Word12 =
-	 struct
-	    type big = Word16.word
-	    type word = word12
-	    val fromBigUnsafe = _prim "WordU16_toWord12": big -> word;
-	    val toBig = _prim "WordU12_toWord16": word -> big;
-	    val wordSize = 12
-	 end
+         struct
+            type big = Word16.word
+            type word = word12
+            val fromBigUnsafe = _prim "WordU16_toWord12": big -> word;
+            val toBig = _prim "WordU12_toWord16": word -> big;
+            val wordSize = 12
+         end
       structure Word13 =
-	 struct
-	    type big = Word16.word
-	    type word = word13
-	    val fromBigUnsafe = _prim "WordU16_toWord13": big -> word;
-	    val toBig = _prim "WordU13_toWord16": word -> big;
-	    val wordSize = 13
-	 end
+         struct
+            type big = Word16.word
+            type word = word13
+            val fromBigUnsafe = _prim "WordU16_toWord13": big -> word;
+            val toBig = _prim "WordU13_toWord16": word -> big;
+            val wordSize = 13
+         end
       structure Word14 =
-	 struct
-	    type big = Word16.word
-	    type word = word14
-	    val fromBigUnsafe = _prim "WordU16_toWord14": big -> word;
-	    val toBig = _prim "WordU14_toWord16": word -> big;
-	    val wordSize = 14
-	 end
+         struct
+            type big = Word16.word
+            type word = word14
+            val fromBigUnsafe = _prim "WordU16_toWord14": big -> word;
+            val toBig = _prim "WordU14_toWord16": word -> big;
+            val wordSize = 14
+         end
       structure Word15 =
-	 struct
-	    type big = Word16.word
-	    type word = word15
-	    val fromBigUnsafe = _prim "WordU16_toWord15": big -> word;
-	    val toBig = _prim "WordU15_toWord16": word -> big;
-	    val wordSize = 15
-	 end
+         struct
+            type big = Word16.word
+            type word = word15
+            val fromBigUnsafe = _prim "WordU16_toWord15": big -> word;
+            val toBig = _prim "WordU15_toWord16": word -> big;
+            val wordSize = 15
+         end
       structure Word16 =
-	 struct
-	    open Word16
-	       
-	    val wordSize: int = 16
+         struct
+            open Word16
+               
+            val wordSize: int = 16
 
-	    val + = _prim "Word16_add": word * word -> word;
-	    val andb = _prim "Word16_andb": word * word -> word;
-	    val ~>> = _prim "WordS16_rshift": word * Word.word -> word;
-	    val div = _prim "WordU16_quot": word * word -> word;
-	    val fromInt = _prim "WordU32_toWord16": int -> word;
-	    val fromLarge = _prim "WordU64_toWord16": LargeWord.word -> word;
-	    val << = _prim "Word16_lshift": word * Word.word -> word;
-	    val op < = _prim "WordU16_lt" : word * word -> bool;
-	    val mod = _prim "WordU16_rem": word * word -> word;
-	    val * = _prim "WordU16_mul": word * word -> word;
-	    val ~ = _prim "Word16_neg": word -> word;
-	    val notb = _prim "Word16_notb": word -> word;
-	    val orb = _prim "Word16_orb": word * word -> word;
-	    val >> = _prim "WordU16_rshift": word * Word.word -> word;
-	    val - = _prim "Word16_sub": word * word -> word;
-	    val toInt = _prim "WordU16_toWord32": word -> int;
-	    val toIntX = _prim "WordS16_toWord32": word -> int;
-	    val toLarge = _prim "WordU16_toWord64": word -> LargeWord.word;
-	    val toLargeX = _prim "WordS16_toWord64": word -> LargeWord.word;
-	    val xorb = _prim "Word16_xorb": word * word -> word;
-	 end
+            val + = _prim "Word16_add": word * word -> word;
+            val andb = _prim "Word16_andb": word * word -> word;
+            val ~>> = _prim "WordS16_rshift": word * Word.word -> word;
+            val div = _prim "WordU16_quot": word * word -> word;
+            val fromInt = _prim "WordU32_toWord16": int -> word;
+            val fromLarge = _prim "WordU64_toWord16": LargeWord.word -> word;
+            val << = _prim "Word16_lshift": word * Word.word -> word;
+            val op < = _prim "WordU16_lt": word * word -> bool;
+            val mod = _prim "WordU16_rem": word * word -> word;
+            val * = _prim "WordU16_mul": word * word -> word;
+            val ~ = _prim "Word16_neg": word -> word;
+            val notb = _prim "Word16_notb": word -> word;
+            val orb = _prim "Word16_orb": word * word -> word;
+            val >> = _prim "WordU16_rshift": word * Word.word -> word;
+            val - = _prim "Word16_sub": word * word -> word;
+            val toInt = _prim "WordU16_toWord32": word -> int;
+            val toIntX = _prim "WordS16_toWord32": word -> int;
+            val toLarge = _prim "WordU16_toWord64": word -> LargeWord.word;
+            val toLargeX = _prim "WordS16_toWord64": word -> LargeWord.word;
+            val xorb = _prim "Word16_xorb": word * word -> word;
+         end
       structure Word16 =
-	 struct
-	    open Word16
-	    local
-	       structure S = Comparisons (Word16)
-	    in
-	       open S
-	    end
-	 end
+         struct
+            open Word16
+            local
+               structure S = Comparisons (Word16)
+            in
+               open S
+            end
+         end
       structure Word17 =
-	 struct
-	    type big = Word32.word
-	    type word = word17
-	    val fromBigUnsafe = _prim "WordU32_toWord17": big -> word;
-	    val toBig = _prim "WordU17_toWord32": word -> big;
-	    val wordSize = 17
-	 end
+         struct
+            type big = Word32.word
+            type word = word17
+            val fromBigUnsafe = _prim "WordU32_toWord17": big -> word;
+            val toBig = _prim "WordU17_toWord32": word -> big;
+            val wordSize = 17
+         end
       structure Word18 =
-	 struct
-	    type big = Word32.word
-	    type word = word18
-	    val fromBigUnsafe = _prim "WordU32_toWord18": big -> word;
-	    val toBig = _prim "WordU18_toWord32": word -> big;
-	    val wordSize = 18
-	 end
+         struct
+            type big = Word32.word
+            type word = word18
+            val fromBigUnsafe = _prim "WordU32_toWord18": big -> word;
+            val toBig = _prim "WordU18_toWord32": word -> big;
+            val wordSize = 18
+         end
       structure Word19 =
-	 struct
-	    type big = Word32.word
-	    type word = word19
-	    val fromBigUnsafe = _prim "WordU32_toWord19": big -> word;
-	    val toBig = _prim "WordU19_toWord32": word -> big;
-	    val wordSize = 19
-	 end
+         struct
+            type big = Word32.word
+            type word = word19
+            val fromBigUnsafe = _prim "WordU32_toWord19": big -> word;
+            val toBig = _prim "WordU19_toWord32": word -> big;
+            val wordSize = 19
+         end
       structure Word20 =
-	 struct
-	    type big = Word32.word
-	    type word = word20
-	    val fromBigUnsafe = _prim "WordU32_toWord20": big -> word;
-	    val toBig = _prim "WordU20_toWord32": word -> big;
-	    val wordSize = 20
-	 end
+         struct
+            type big = Word32.word
+            type word = word20
+            val fromBigUnsafe = _prim "WordU32_toWord20": big -> word;
+            val toBig = _prim "WordU20_toWord32": word -> big;
+            val wordSize = 20
+         end
       structure Word21 =
-	 struct
-	    type big = Word32.word
-	    type word = word21
-	    val fromBigUnsafe = _prim "WordU32_toWord21": big -> word;
-	    val toBig = _prim "WordU21_toWord32": word -> big;
-	    val wordSize = 21
-	 end
+         struct
+            type big = Word32.word
+            type word = word21
+            val fromBigUnsafe = _prim "WordU32_toWord21": big -> word;
+            val toBig = _prim "WordU21_toWord32": word -> big;
+            val wordSize = 21
+         end
       structure Word22 =
-	 struct
-	    type big = Word32.word
-	    type word = word22
-	    val fromBigUnsafe = _prim "WordU32_toWord22": big -> word;
-	    val toBig = _prim "WordU22_toWord32": word -> big;
-	    val wordSize = 22
-	 end
+         struct
+            type big = Word32.word
+            type word = word22
+            val fromBigUnsafe = _prim "WordU32_toWord22": big -> word;
+            val toBig = _prim "WordU22_toWord32": word -> big;
+            val wordSize = 22
+         end
       structure Word23 =
-	 struct
-	    type big = Word32.word
-	    type word = word23
-	    val fromBigUnsafe = _prim "WordU32_toWord23": big -> word;
-	    val toBig = _prim "WordU23_toWord32": word -> big;
-	    val wordSize = 23
-	 end
+         struct
+            type big = Word32.word
+            type word = word23
+            val fromBigUnsafe = _prim "WordU32_toWord23": big -> word;
+            val toBig = _prim "WordU23_toWord32": word -> big;
+            val wordSize = 23
+         end
       structure Word24 =
-	 struct
-	    type big = Word32.word
-	    type word = word24
-	    val fromBigUnsafe = _prim "WordU32_toWord24": big -> word;
-	    val toBig = _prim "WordU24_toWord32": word -> big;
-	    val wordSize = 24
-	 end
+         struct
+            type big = Word32.word
+            type word = word24
+            val fromBigUnsafe = _prim "WordU32_toWord24": big -> word;
+            val toBig = _prim "WordU24_toWord32": word -> big;
+            val wordSize = 24
+         end
       structure Word25 =
-	 struct
-	    type big = Word32.word
-	    type word = word25
-	    val fromBigUnsafe = _prim "WordU32_toWord25": big -> word;
-	    val toBig = _prim "WordU25_toWord32": word -> big;
-	    val wordSize = 25
-	 end
+         struct
+            type big = Word32.word
+            type word = word25
+            val fromBigUnsafe = _prim "WordU32_toWord25": big -> word;
+            val toBig = _prim "WordU25_toWord32": word -> big;
+            val wordSize = 25
+         end
       structure Word26 =
-	 struct
-	    type big = Word32.word
-	    type word = word26
-	    val fromBigUnsafe = _prim "WordU32_toWord26": big -> word;
-	    val toBig = _prim "WordU26_toWord32": word -> big;
-	    val wordSize = 26
-	 end
+         struct
+            type big = Word32.word
+            type word = word26
+            val fromBigUnsafe = _prim "WordU32_toWord26": big -> word;
+            val toBig = _prim "WordU26_toWord32": word -> big;
+            val wordSize = 26
+         end
       structure Word27 =
-	 struct
-	    type big = Word32.word
-	    type word = word27
-	    val fromBigUnsafe = _prim "WordU32_toWord27": big -> word;
-	    val toBig = _prim "WordU27_toWord32": word -> big;
-	    val wordSize = 27
-	 end
+         struct
+            type big = Word32.word
+            type word = word27
+            val fromBigUnsafe = _prim "WordU32_toWord27": big -> word;
+            val toBig = _prim "WordU27_toWord32": word -> big;
+            val wordSize = 27
+         end
       structure Word28 =
-	 struct
-	    type big = Word32.word
-	    type word = word28
-	    val fromBigUnsafe = _prim "WordU32_toWord28": big -> word;
-	    val toBig = _prim "WordU28_toWord32": word -> big;
-	    val wordSize = 28
-	 end
+         struct
+            type big = Word32.word
+            type word = word28
+            val fromBigUnsafe = _prim "WordU32_toWord28": big -> word;
+            val toBig = _prim "WordU28_toWord32": word -> big;
+            val wordSize = 28
+         end
       structure Word29 =
-	 struct
-	    type big = Word32.word
-	    type word = word29
-	    val fromBigUnsafe = _prim "WordU32_toWord29": big -> word;
-	    val toBig = _prim "WordU29_toWord32": word -> big;
-	    val wordSize = 29
-	 end
+         struct
+            type big = Word32.word
+            type word = word29
+            val fromBigUnsafe = _prim "WordU32_toWord29": big -> word;
+            val toBig = _prim "WordU29_toWord32": word -> big;
+            val wordSize = 29
+         end
       structure Word30 =
-	 struct
-	    type big = Word32.word
-	    type word = word30
-	    val fromBigUnsafe = _prim "WordU32_toWord30": big -> word;
-	    val toBig = _prim "WordU30_toWord32": word -> big;
-	    val wordSize = 30
-	 end
+         struct
+            type big = Word32.word
+            type word = word30
+            val fromBigUnsafe = _prim "WordU32_toWord30": big -> word;
+            val toBig = _prim "WordU30_toWord32": word -> big;
+            val wordSize = 30
+         end
       structure Word31 =
-	 struct
-	    type big = Word32.word
-	    type word = word31
-	    val fromBigUnsafe = _prim "WordU32_toWord31": big -> word;
-	    val toBig = _prim "WordU31_toWord32": word -> big;
-	    val wordSize = 31
-	 end
+         struct
+            type big = Word32.word
+            type word = word31
+            val fromBigUnsafe = _prim "WordU32_toWord31": big -> word;
+            val toBig = _prim "WordU31_toWord32": word -> big;
+            val wordSize = 31
+         end
       structure Word32 =
-	 struct
-	    open Word32
-	       
-	    val wordSize: int = 32
+         struct
+            open Word32
+               
+            val wordSize: int = 32
 
-	    val + = _prim "Word32_add": word * word -> word;
-	    val andb = _prim "Word32_andb": word * word -> word;
-	    val ~>> = _prim "WordS32_rshift": word * word -> word;
-	    val div = _prim "WordU32_quot": word * word -> word;
-	    val fromInt = _prim "WordU32_toWord32": int -> word;
-	    val fromLarge = _prim "WordU64_toWord32": LargeWord.word -> word;
-	    val << = _prim "Word32_lshift": word * word -> word;
-	    val op < = _prim "WordU32_lt" : word * word -> bool;
-	    val mod = _prim "WordU32_rem": word * word -> word;
-	    val * = _prim "WordU32_mul": word * word -> word;
-	    val ~ = _prim "Word32_neg": word -> word;
-	    val notb = _prim "Word32_notb": word -> word;
-	    val orb = _prim "Word32_orb": word * word -> word;
-	    val rol = _prim "Word32_rol": word * word -> word;
-	    val ror = _prim "Word32_ror": word * word -> word;
-	    val >> = _prim "WordU32_rshift": word * word -> word;
-	    val - = _prim "Word32_sub": word * word -> word;
-	    val toInt = _prim "WordU32_toWord32": word -> int;
-	    val toIntX = _prim "WordS32_toWord32": word -> int;
-	    val toLarge = _prim "WordU32_toWord64": word -> LargeWord.word;
-	    val toLargeX = _prim "WordS32_toWord64": word -> LargeWord.word;
-	    val xorb = _prim "Word32_xorb": word * word -> word;
-	 end
+            val + = _prim "Word32_add": word * word -> word;
+            val andb = _prim "Word32_andb": word * word -> word;
+            val ~>> = _prim "WordS32_rshift": word * word -> word;
+            val div = _prim "WordU32_quot": word * word -> word;
+            val fromInt = _prim "WordU32_toWord32": int -> word;
+            val fromLarge = _prim "WordU64_toWord32": LargeWord.word -> word;
+            val << = _prim "Word32_lshift": word * word -> word;
+            val op < = _prim "WordU32_lt": word * word -> bool;
+            val mod = _prim "WordU32_rem": word * word -> word;
+            val * = _prim "WordU32_mul": word * word -> word;
+            val ~ = _prim "Word32_neg": word -> word;
+            val notb = _prim "Word32_notb": word -> word;
+            val orb = _prim "Word32_orb": word * word -> word;
+            val rol = _prim "Word32_rol": word * word -> word;
+            val ror = _prim "Word32_ror": word * word -> word;
+            val >> = _prim "WordU32_rshift": word * word -> word;
+            val - = _prim "Word32_sub": word * word -> word;
+            val toInt = _prim "WordU32_toWord32": word -> int;
+            val toIntX = _prim "WordS32_toWord32": word -> int;
+            val toLarge = _prim "WordU32_toWord64": word -> LargeWord.word;
+            val toLargeX = _prim "WordS32_toWord64": word -> LargeWord.word;
+            val xorb = _prim "Word32_xorb": word * word -> word;
+         end
       structure Word32 =
-	 struct
-	    open Word32
-	    local
-	       structure S = Comparisons (Word32)
-	    in
-	       open S
-	    end
-	 end
+         struct
+            open Word32
+            local
+               structure S = Comparisons (Word32)
+            in
+               open S
+            end
+         end
       structure Word = Word32
       structure Word64 =
-	 struct
-	    open Word64
-	       
-	    val wordSize: int = 64
+         struct
+            open Word64
+               
+            val wordSize: int = 64
 
-	    val + = _prim "Word64_add": word * word -> word;
-	    val andb = _prim "Word64_andb": word * word -> word;
-	    val ~>> = _prim "WordS64_rshift": word * Word.word -> word;
-	    val div = _prim "WordU64_quot": word * word -> word;
-	    val fromInt = _prim "WordS32_toWord64": int -> word;
-	    val fromLarge: LargeWord.word -> word = fn x => x
-	    val << = _prim "Word64_lshift": word * Word.word -> word;
-	    val op < = _prim "WordU64_lt" : word * word -> bool;
-	    val mod = _prim "WordU64_rem": word * word -> word;
-	    val * = _prim "WordU64_mul": word * word -> word;
-	    val ~ = _prim "Word64_neg": word -> word;
-	    val notb = _prim "Word64_notb": word -> word;
-	    val orb = _prim "Word64_orb": word * word -> word;
-	    val >> = _prim "WordU64_rshift": word * Word.word -> word;
-	    val - = _prim "Word64_sub": word * word -> word;
-	    val toInt = _prim "WordU64_toWord32": word -> int;
-	    val toIntX = _prim "WordU64_toWord32": word -> int;
-	    val toLarge: word -> LargeWord.word = fn x => x
-	    val toLargeX: word -> LargeWord.word = fn x => x
-	    val xorb = _prim "Word64_xorb": word * word -> word;
-	 end
+            val + = _prim "Word64_add": word * word -> word;
+            val andb = _prim "Word64_andb": word * word -> word;
+            val ~>> = _prim "WordS64_rshift": word * Word.word -> word;
+            val div = _prim "WordU64_quot": word * word -> word;
+            val fromInt = _prim "WordS32_toWord64": int -> word;
+            val fromLarge: LargeWord.word -> word = fn x => x
+            val << = _prim "Word64_lshift": word * Word.word -> word;
+            val op < = _prim "WordU64_lt": word * word -> bool;
+            val mod = _prim "WordU64_rem": word * word -> word;
+            val * = _prim "WordU64_mul": word * word -> word;
+            val ~ = _prim "Word64_neg": word -> word;
+            val notb = _prim "Word64_notb": word -> word;
+            val orb = _prim "Word64_orb": word * word -> word;
+            val >> = _prim "WordU64_rshift": word * Word.word -> word;
+            val - = _prim "Word64_sub": word * word -> word;
+            val toInt = _prim "WordU64_toWord32": word -> int;
+            val toIntX = _prim "WordU64_toWord32": word -> int;
+            val toLarge: word -> LargeWord.word = fn x => x
+            val toLargeX: word -> LargeWord.word = fn x => x
+            val xorb = _prim "Word64_xorb": word * word -> word;
+         end
       structure Word64 =
-	 struct
-	    open Word64
-	    local
-	       structure S = Comparisons (Word64)
-	    in
-	       open S
-	    end
-	 end
+         struct
+            open Word64
+            local
+               structure S = Comparisons (Word64)
+            in
+               open S
+            end
+         end
 
+      structure Cygwin =
+         struct
+            val toFullWindowsPath =
+               _import "Cygwin_toFullWindowsPath": NullString.t -> CString.t;
+         end
+
+      structure FileDesc:>
+         sig
+            eqtype t
+
+            val fromWord: word -> t
+            val fromInt: int -> t
+            val toInt: t -> int
+            val toWord: t -> word
+         end =
+         struct
+            type t = int
+
+            val fromWord = Word32.toInt
+            fun fromInt i = i
+            fun toInt i = i
+            val toWord = Word32.fromInt
+         end
+
+      structure Windows =
+         struct
+            structure Process =
+               struct
+                  val create = 
+                     _import "Windows_Process_create"
+                     : (NullString.t * NullString.t * NullString.t
+                        * FileDesc.t * FileDesc.t * FileDesc.t) -> Pid.t;
+                  val terminate =
+                     _import "Windows_terminate": Pid.t * Signal.t -> int;
+               end
+         end
+
       structure World =
-	 struct
-	    val isOriginal = _import "World_isOriginal": unit -> bool;
-	    val makeOriginal = _import "World_makeOriginal": unit -> unit;
-	    val save = _prim "World_save": word (* filedes *) -> unit;
-	 end
+         struct
+            val isOriginal = _import "World_isOriginal": unit -> bool;
+            val makeOriginal = _import "World_makeOriginal": unit -> unit;
+            val save = _prim "World_save": word (* filedes *) -> unit;
+         end
    end
 
 structure Primitive =
@@ -2116,17 +2194,17 @@
       open Primitive
 
       structure Int32 =
-	 struct
-	    open Int32
-	       
-	    local
-	       fun make f (i: int, i': int): bool =
-		  f (Primitive.Word32.fromInt i, Primitive.Word32.fromInt i')
-	    in
-	       val geu = make Primitive.Word32.>=
-	       val gtu = make Primitive.Word32.> 
-	    end
-	 end
+         struct
+            open Int32
+               
+            local
+               fun make f (i: int, i': int): bool =
+                  f (Primitive.Word32.fromInt i, Primitive.Word32.fromInt i')
+            in
+               val geu = make Primitive.Word32.>=
+               val gtu = make Primitive.Word32.> 
+            end
+         end
       structure Int = Int32
    end
 
@@ -2135,13 +2213,13 @@
       open NullString
 
       fun fromString s =
-	 if #"\000" = let
-			 open Primitive
-		      in
-			 Vector.sub (s, Int.- (Vector.length s, 1))
-		      end
-	    then NullString.fromString s
-	 else raise Fail "NullString.fromString"
+         if #"\000" = let
+                         open Primitive
+                      in
+                         Vector.sub (s, Int.- (Vector.length s, 1))
+                      end
+            then NullString.fromString s
+         else raise Fail "NullString.fromString"
 
       val empty = fromString "\000"
    end
@@ -2175,13 +2253,13 @@
    val _ =
       TopLevel.setHandler 
       (fn exn => 
-       (Stdio.print ("unhandled exception: ")
-	; case exn of
-	     Fail msg => (Stdio.print "Fail "
-			  ; Stdio.print msg)
-	   | _ => Stdio.print (Exn.name exn)
-	; Stdio.print ("\n")
-	; bug (NullString.fromString 
-	       "unhandled exception in Basis Library\000")))
+       (Stdio.print "unhandled exception: "
+        ; case exn of
+             Fail msg => (Stdio.print "Fail "
+                          ; Stdio.print msg)
+           | _ => Stdio.print (Exn.name exn)
+        ; Stdio.print "\n"
+        ; bug (NullString.fromString 
+               "unhandled exception in Basis Library\000")))
 in
 end

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/misc/reader.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/misc/reader.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/misc/reader.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature READER =
    sig
       type ('a, 'b) reader = 'b -> ('a * 'b) option
@@ -15,10 +16,10 @@
       (* never return NONE *)
 (*      val tokens: ('a -> bool) -> ('a, 'b) reader -> ('a list list, 'b) reader*)
 (*      val fields: ('a -> bool) -> ('a, 'b) reader -> ('a list list, 'b) reader *)
-	 
+         
       val map: ('a -> 'c) -> ('a, 'b) reader -> ('c, 'b) reader
       val mapOpt: ('a -> 'c option) -> ('a, 'b) reader -> ('c, 'b) reader
-	 
+         
       val ignore: ('a -> bool) -> ('a, 'b) reader -> ('a, 'b) reader
 
       (* read excatly N items *)

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/misc/reader.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/misc/reader.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/misc/reader.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 structure Reader: READER =
 struct
 
@@ -15,23 +16,23 @@
 (* local
  *    fun make finish p reader state =
  *       let
- * 	 fun loop (state, token, tokens) =
- * 	    case reader state of
- * 	       NONE => SOME (rev (finish (token, tokens)), state)
- * 	     | SOME (x, state) =>
- * 		  let
- * 		     val (token, tokens) =
- * 			if p x then ([], finish (token, tokens))
- * 			else (x :: token, tokens)
- * 		  in loop (state, token, tokens)
- * 		  end
+ *       fun loop (state, token, tokens) =
+ *          case reader state of
+ *             NONE => SOME (rev (finish (token, tokens)), state)
+ *           | SOME (x, state) =>
+ *                let
+ *                   val (token, tokens) =
+ *                      if p x then ([], finish (token, tokens))
+ *                      else (x :: token, tokens)
+ *                in loop (state, token, tokens)
+ *                end
  *       in loop (state, [], [])
  *       end
  * in
  *     fun tokens p = make (fn (token, tokens) =>
- *  		       case token of
- *  			  [] => tokens
- *  			| _ => (rev token) :: tokens) p
+ *                     case token of
+ *                        [] => tokens
+ *                      | _ => (rev token) :: tokens) p
  *    fun fields p = make (fn (field, fields) => (rev field) :: fields) p
  * end
  *)
@@ -40,33 +41,33 @@
    fn state =>
    let
       fun loop (state, accum) =
-	 case reader state of
-	    NONE => SOME (rev accum, state)
-	  | SOME (a, state) => loop (state, a :: accum)
+         case reader state of
+            NONE => SOME (rev accum, state)
+          | SOME (a, state) => loop (state, a :: accum)
    in loop (state, [])
    end
-	       
+               
 fun readerN (reader: ('a, 'b) reader, n: int): ('a list, 'b) reader =
    fn (state :'b) =>
    let
       fun loop (n, state, accum) =
-	 if n <= 0
-	    then SOME (rev accum, state)
-	 else case reader state of
-	    NONE => NONE
-	  | SOME (x, state) => loop (n - 1, state, x :: accum)
+         if n <= 0
+            then SOME (rev accum, state)
+         else case reader state of
+            NONE => NONE
+          | SOME (x, state) => loop (n - 1, state, x :: accum)
    in loop (n, state, [])
    end
 
 fun ignore f reader =
    let
       fun loop state =
-	 case reader state of
-	    NONE => NONE
-	  | SOME (x, state) =>
-	       if f x
-		  then loop state
-	       else SOME (x, state)
+         case reader state of
+            NONE => NONE
+          | SOME (x, state) =>
+               if f x
+                  then loop state
+               else SOME (x, state)
    in loop
    end
 val _ = ignore
@@ -82,9 +83,9 @@
    case reader b of
       NONE => NONE
     | SOME (a, b) =>
-	 case f a of
-	    NONE => NONE
-	  | SOME c => SOME (c, b)
+         case f a of
+            NONE => NONE
+          | SOME c => SOME (c, b)
 
 fun reader2 reader =
    map (fn [y, z] => (y, z) | _ => raise Fail "Reader.reader2")

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/misc/unique-id.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/misc/unique-id.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/misc/unique-id.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 functor UniqueId () :> UNIQUE_ID =
    struct
       type t = unit ref

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/misc/unique-id.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/misc/unique-id.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/misc/unique-id.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,13 +1,14 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature UNIQUE_ID =
    sig
       type t
-	 
+         
       val new: unit -> t
    end

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/misc/util.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/misc/util.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/misc/util.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,49 +1,50 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 structure Util =
    struct
       fun makeCompare (op <) =
-	 {compare = (fn (i, j) =>
-		     if i < j then LESS
-		     else if j < i then GREATER
-			  else EQUAL),
-	  min = fn (x, y) => if x < y then x else y,
-	  max = fn (x, y) => if x < y then y else x}
+         {compare = (fn (i, j) =>
+                     if i < j then LESS
+                     else if j < i then GREATER
+                          else EQUAL),
+          min = fn (x, y) => if x < y then x else y,
+          max = fn (x, y) => if x < y then y else x}
 
       fun makeOrder compare =
-	 {< = fn (x, y) => (case compare (x, y) of
-			      LESS => true
-			    | _ => false),
-	  <= = fn (x, y) => (case compare (x, y) of
-			       GREATER => false
-			     | _ => true),
-	  > = fn (x, y) => (case compare (x, y) of
-			      GREATER => true
-			    | _ => false),
-	  >= = fn (x, y) => (case compare (x, y) of
-			       LESS => false
-			     | _ => true)}
+         {< = fn (x, y) => (case compare (x, y) of
+                              LESS => true
+                            | _ => false),
+          <= = fn (x, y) => (case compare (x, y) of
+                               GREATER => false
+                             | _ => true),
+          > = fn (x, y) => (case compare (x, y) of
+                              GREATER => true
+                            | _ => false),
+          >= = fn (x, y) => (case compare (x, y) of
+                               LESS => false
+                             | _ => true)}
 
       open Primitive.Int
-	 
+         
       fun naturalFoldStartStop (start, stop, b, f) =
-	 if start > stop
-	    then raise Subscript
-	 else 
-	    let
-	       fun loop (i, b) =
-		  if i >= stop then b
-		  else loop (i + 1, f (i, b))
-	    in loop (start, b)
-	    end
+         if start > stop
+            then raise Subscript
+         else 
+            let
+               fun loop (i, b) =
+                  if i >= stop then b
+                  else loop (i + 1, f (i, b))
+            in loop (start, b)
+            end
 
       fun naturalForeachStartStop (start, stop, f) =
-	 naturalFoldStartStop (start, stop, (), fn (i, ()) => f i)
+         naturalFoldStartStop (start, stop, (), fn (i, ()) => f i)
 
       fun naturalForeach (n, f) = naturalForeachStartStop (0, n, f)
    end

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/mlton/array.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/mlton/array.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/mlton/array.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,11 @@
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 type int = Int.int
    
 signature MLTON_ARRAY =

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/mlton/bin-io.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/mlton/bin-io.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/mlton/bin-io.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,4 +1,9 @@
-signature MLTON_BIN_IO =
-   MLTON_IO
-   where type instream = BinIO.instream
-   where type outstream = BinIO.outstream
+(* Copyright (C) 2002-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
+signature MLTON_BIN_IO = MLTON_IO
+

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/mlton/call-stack.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/mlton/call-stack.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/mlton/call-stack.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,10 @@
+(* Copyright (C) 2004-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 signature MLTON_CALL_STACK =
    sig
       type t

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/mlton/call-stack.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/mlton/call-stack.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/mlton/call-stack.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,10 @@
+(* Copyright (C) 2004-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 structure MLtonCallStack =
    struct
       open Primitive.CallStack
@@ -4,45 +11,45 @@
 
       val gcState = Primitive.GCState.gcState
       structure Pointer = MLtonPointer
-	 
+         
       val current: unit -> t =
-	 fn () =>
-	 if not keep
-	    then T (Array.array (0, 0))
-	 else
-	    let
-	       val a = Array.array (numStackFrames gcState, ~1)
-	       val () = callStack (gcState, a)
-	    in
-	       T a
-	    end
+         fn () =>
+         if not keep
+            then T (Array.array (0, 0))
+         else
+            let
+               val a = Array.array (numStackFrames gcState, ~1)
+               val () = callStack (gcState, a)
+            in
+               T a
+            end
 
       val toStrings: t -> string list =
-	 fn T a =>
-	 if not keep
-	    then []
-	 else
-	    let
-	       val skip = Array.length a - 2
-	    in
-	       Array.foldri
-	       (fn (i, frameIndex, ac) =>
-		if i >= skip
-		   then ac
-		else
-		   let
-		      val p = frameIndexSourceSeq (gcState, frameIndex)
-		      val max = Pointer.getInt32 (p, 0)
-		      fun loop (j, ac) =
-			 if j > max
-			    then ac
-			 else loop (j + 1,
-				    C.CS.toString (sourceName
-						   (gcState, Pointer.getInt32 (p, j)))
-				    :: ac)
-		   in
-		      loop (1, ac)
-		   end)
-	       [] a
-	    end
+         fn T a =>
+         if not keep
+            then []
+         else
+            let
+               val skip = Array.length a - 2
+            in
+               Array.foldri
+               (fn (i, frameIndex, ac) =>
+                if i >= skip
+                   then ac
+                else
+                   let
+                      val p = frameIndexSourceSeq (gcState, frameIndex)
+                      val max = Pointer.getInt32 (p, 0)
+                      fun loop (j, ac) =
+                         if j > max
+                            then ac
+                         else loop (j + 1,
+                                    C.CS.toString (sourceName
+                                                   (gcState, Pointer.getInt32 (p, j)))
+                                    :: ac)
+                   in
+                      loop (1, ac)
+                   end)
+               [] a
+            end
    end

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/mlton/cont.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/mlton/cont.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/mlton/cont.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,11 @@
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 signature MLTON_CONT =
    sig
       type 'a t

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/mlton/cont.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/mlton/cont.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/mlton/cont.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,11 @@
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 structure MLtonCont:> MLTON_CONT =
 struct
 
@@ -17,40 +25,40 @@
 fun callcc (f: 'a t -> 'a): 'a =
    (dummy ()
     ; if MLtonThread.amInSignalHandler ()
-	 then die "callcc can not be used in a signal handler\n"
+         then die "callcc can not be used in a signal handler\n"
       else 
-	 let
-	    datatype 'a state =
-	       Original of 'a t -> 'a
-	     | Copy of unit -> 'a
-	     | Clear
-	    val r: 'a state ref = ref (Original f)
-	    val _ = Thread.atomicBegin () (* Match 1 *)
-	    val _ = Thread.copyCurrent ()
-	 in
-	    case (!r before r := Clear) of
-	       Clear => raise Fail "callcc saw Clear"
-	     | Copy v => (Thread.atomicEnd () (* Match 2 *)
-			  ; v ())
-	     | Original f =>
-		  let
-		     val t = Thread.savedPre ()
-		  in
-		     Thread.atomicEnd () (* Match 1 *)
-		     ; f (fn v =>
-			  let
-			     val _ = Thread.atomicBegin () (* Match 2 *)
-			     val _ = r := Copy v
-			     val new = Thread.copy t
-			     (* The following Thread.atomicBegin () 
-			      * is matched by Thread.switchTo.
-			      *)
-			     val _ = Thread.atomicBegin ()
-			  in
-			     Thread.switchTo new
-			  end)
-		  end
-	 end)
+         let
+            datatype 'a state =
+               Original of 'a t -> 'a
+             | Copy of unit -> 'a
+             | Clear
+            val r: 'a state ref = ref (Original f)
+            val _ = Thread.atomicBegin () (* Match 1 *)
+            val _ = Thread.copyCurrent ()
+         in
+            case (!r before r := Clear) of
+               Clear => raise Fail "callcc saw Clear"
+             | Copy v => (Thread.atomicEnd () (* Match 2 *)
+                          ; v ())
+             | Original f =>
+                  let
+                     val t = Thread.savedPre ()
+                  in
+                     Thread.atomicEnd () (* Match 1 *)
+                     ; f (fn v =>
+                          let
+                             val _ = Thread.atomicBegin () (* Match 2 *)
+                             val _ = r := Copy v
+                             val new = Thread.copy t
+                             (* The following Thread.atomicBegin () 
+                              * is matched by Thread.switchTo.
+                              *)
+                             val _ = Thread.atomicBegin ()
+                          in
+                             Thread.switchTo new
+                          end)
+                  end
+         end)
 
 fun ('a, 'b) throw' (k: 'a t, v: unit -> 'a): 'b =
    (k v; raise Fail "throw bug")

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/mlton/exit.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/mlton/exit.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/mlton/exit.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,10 @@
+(* Copyright (C) 2004-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 structure Exit =
    struct
       structure Status = PosixPrimitive.Process.Status
@@ -5,23 +12,23 @@
       val exiting = ref false
 
       fun atExit f =
-	 if !exiting
-	    then ()
-	 else Cleaner.addNew (Cleaner.atExit, f)
+         if !exiting
+            then ()
+         else Cleaner.addNew (Cleaner.atExit, f)
 
       fun exit (status: Status.t): 'a =
-	 if !exiting
-	    then raise Fail "exit"
-	 else
-	    let
-	       val _ = exiting := true
-	       val i = Status.toInt status
-	    in
-	       if 0 <= i andalso i < 256
-		  then (let open Cleaner in clean atExit end
-			; Primitive.halt status
-			; raise Fail "exit")
-	       else raise Fail (concat ["exit must have 0 <= status < 256: saw ",
-					Int.toString i])
-	    end
+         if !exiting
+            then raise Fail "exit"
+         else
+            let
+               val _ = exiting := true
+               val i = Status.toInt status
+            in
+               if 0 <= i andalso i < 256
+                  then (let open Cleaner in clean atExit end
+                        ; Primitive.halt status
+                        ; raise Fail "exit")
+               else raise Fail (concat ["exit must have 0 <= status < 256: saw ",
+                                        Int.toString i])
+            end
    end

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/mlton/exn.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/mlton/exn.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/mlton/exn.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,10 @@
+(* Copyright (C) 2001-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 signature MLTON_EXN =
    sig
       val addExnMessager: (exn -> string option) -> unit

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/mlton/exn.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/mlton/exn.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/mlton/exn.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,10 @@
+(* Copyright (C) 2001-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 structure MLtonExn =
    struct
       open Primitive.Exn
@@ -3,41 +10,53 @@
 
       type t = exn
-	 
+         
       val addExnMessager = General.addExnMessager
 
       val history: t -> string list =
-	 if keepHistory
-	    then (setInitExtra (NONE: extra)
-		  ; setExtendExtra (fn e =>
-				    case e of
-				       NONE => SOME (MLtonCallStack.current ())
-				     | SOME _ => e)
-		  ; fn e => (case extra e of
-				NONE => []
-			      | SOME cs =>
-				   (* The tl gets rid of the anonymous function
-				    * passed to setExtendExtra above.
-				    *)
-				   tl (MLtonCallStack.toStrings cs)))
-	 else fn _ => []
+         if keepHistory then
+            (setInitExtra (NONE: extra)
+             ; setExtendExtra (fn e =>
+                               case e of
+                                  NONE => SOME (MLtonCallStack.current ())
+                                | SOME _ => e)
+             ; (fn e =>
+                case extra e of
+                   NONE => []
+                 | SOME cs =>
+                      let
+                         (* Gets rid of the anonymous function passed to
+                          * setExtendExtra above.
+                          *)
+                         fun loop xs =
+                            case xs of
+                               [] => []
+                             | x :: xs =>
+                                  if String.isPrefix "MLtonExn.fn " x then
+                                     xs
+                                  else
+                                     loop xs
+                      in
+                         loop (MLtonCallStack.toStrings cs)
+                      end))
+         else fn _ => []
 
       local
-	 val message = Primitive.Stdio.print
+         val message = Primitive.Stdio.print
       in
-	 fun 'a topLevelHandler (exn: exn): 'a =
-	    (message (concat ["unhandled exception: ", exnMessage exn, "\n"])
-	     ; (case history exn of
-		   [] => ()
-		 | l =>
-		      (message "with history:\n"
-		       ; (List.app (fn s => message (concat ["\t", s, "\n"]))
-			  l)))
-	     ; Exit.exit Exit.Status.failure)
-	    handle _ => (message "Toplevel handler raised exception.\n"
-			 ; Primitive.halt Exit.Status.failure
-			 (* The following raise is unreachable, but must be there
-			  * so that the expression is of type 'a.
-			  *)
-			 ; raise Fail "bug")
+         fun 'a topLevelHandler (exn: exn): 'a =
+            (message (concat ["unhandled exception: ", exnMessage exn, "\n"])
+             ; (case history exn of
+                   [] => ()
+                 | l =>
+                      (message "with history:\n"
+                       ; (List.app (fn s => message (concat ["\t", s, "\n"]))
+                          l)))
+             ; Exit.exit Exit.Status.failure)
+            handle _ => (message "Toplevel handler raised exception.\n"
+                         ; Primitive.halt Exit.Status.failure
+                         (* The following raise is unreachable, but must be there
+                          * so that the expression is of type 'a.
+                          *)
+                         ; raise Fail "bug")
       end
    end

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/mlton/ffi.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/mlton/ffi.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/mlton/ffi.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,10 @@
+(* Copyright (C) 2003-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 signature MLTON_FFI =
    sig
       val atomicBegin: unit -> unit

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/mlton/ffi.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/mlton/ffi.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/mlton/ffi.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,10 @@
+(* Copyright (C) 2003-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 structure MLtonFFI: MLTON_FFI =
 struct
 
@@ -45,7 +52,7 @@
 val getChar8 = Primitive.Char.fromInt8 o getInt8
 val getChar16 = Primitive.Char2.fromInt16 o getInt16
 val getChar32 = Primitive.Char4.fromInt32 o getInt32
-	       
+               
 fun boolToInt (b: bool): int = if b then 1 else 0
 
 val setBool = setInt32 o boolToInt

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/mlton/finalizable.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/mlton/finalizable.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/mlton/finalizable.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,10 @@
+(* Copyright (C) 2003-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 signature MLTON_FINALIZABLE =
    sig
       type 'a t

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/mlton/finalizable.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/mlton/finalizable.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/mlton/finalizable.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,10 @@
+(* Copyright (C) 2003-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 structure MLtonFinalizable: MLTON_FINALIZABLE =
 struct
 
@@ -11,14 +18,14 @@
    end
 
 datatype 'a t = T of {afters: (unit -> unit) list ref,
-		      finalizers: ('a -> unit) list ref,
-		      value: 'a ref}
+                      finalizers: ('a -> unit) list ref,
+                      value: 'a ref}
 
 fun touch (T {value, ...}) = Primitive.touch value
    
 fun withValue (f as T {value, ...}, g) =
    DynamicWind.wind (fn () => g (!value),
-		     fn () => touch f)
+                     fn () => touch f)
 
 fun addFinalizer (T {finalizers, ...}, f) =
    List.push (finalizers, f)
@@ -26,35 +33,36 @@
 val finalize =
    let
       val r: {clean: unit -> unit,
-	      isAlive: unit -> bool} list ref = ref []
+              isAlive: unit -> bool} list ref = ref []
       fun clean l =
-	 List.foldl (fn (z as {clean, isAlive}, (gotOne, zs)) =>
-		     if isAlive ()
-			then (gotOne, z :: zs)
-		     else (clean (); (true, zs)))
-	 (false, []) l
+         List.foldl (fn (z as {clean: unit -> unit, isAlive}, 
+                         (gotOne, zs)) =>
+                     if isAlive ()
+                        then (gotOne, z :: zs)
+                     else (clean (); (true, zs)))
+         (false, []) l
       val _ = MLtonSignal.handleGC (fn () => r := #2 (clean (!r)))
       val _ =
-	 Cleaner.addNew
-	 (Cleaner.atExit, fn () =>
-	  let
-	     val l = !r
-	     (* Must clear r so that the handler doesn't interfere and so that
-	      * all other references to the finalizers are dropped.
-	      *)
-	     val _ = r := []
-	     fun loop l =
-		let
-		   val _ = MLtonGC.collect ()
-		   val (gotOne, l) = clean l
-		in
-		   if gotOne
-		      then loop l
-		   else ()
-		end
-	  in
-	     loop l
-	  end)
+         Cleaner.addNew
+         (Cleaner.atExit, fn () =>
+          let
+             val l = !r
+             (* Must clear r so that the handler doesn't interfere and so that
+              * all other references to the finalizers are dropped.
+              *)
+             val _ = r := []
+             fun loop l =
+                let
+                   val _ = MLtonGC.collect ()
+                   val (gotOne, l) = clean l
+                in
+                   if gotOne
+                      then loop l
+                   else ()
+                end
+          in
+             loop l
+          end)
    in
       fn z => r := z :: !r
    end
@@ -65,12 +73,12 @@
       val finalizers = ref []
       val value = ref v
       val f = T {afters = afters,
-		 finalizers = finalizers,
-		 value = value}
+                 finalizers = finalizers,
+                 value = value}
       val weak = MLtonWeak.new value
       fun clean () =
-	 (List.foreach (!finalizers, fn f => f v)
-	  ; List.foreach (!afters, fn f => f ()))
+         (List.foreach (!finalizers, fn f => f v)
+          ; List.foreach (!afters, fn f => f ()))
       fun isAlive () = isSome (MLtonWeak.get weak)
       val _ = finalize {clean = clean, isAlive = isAlive}
    in

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/mlton/gc.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/mlton/gc.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/mlton/gc.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,11 @@
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 signature MLTON_GC =
    sig
       val collect: unit -> unit

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/mlton/gc.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/mlton/gc.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/mlton/gc.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,11 @@
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 structure MLtonGC =
    struct
       open Primitive.GC

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/mlton/int-inf.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/mlton/int-inf.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/mlton/int-inf.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,10 @@
+(* Copyright (C) 2002-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 type int = Int.int
 type word = Word.word
    
@@ -9,7 +16,7 @@
       val gcd: t * t -> t
       val isSmall: t -> bool
       datatype rep =
-	 Big of word vector
+         Big of word vector
        | Small of int
       val rep: t -> rep
    end

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/mlton/io.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/mlton/io.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/mlton/io.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,10 @@
+(* Copyright (C) 2002-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 functor MLtonIO (S: MLTON_IO_ARG): MLTON_IO =
 struct
 
@@ -6,20 +13,20 @@
 fun mkstemps {prefix, suffix}: string * outstream =
    let
       fun loop () =
-	 let
-	    val name = concat [prefix, MLtonRandom.alphaNumString 6, suffix]
-	    open Posix.FileSys
-	 in
-	    (name,
-	     newOut (createf (name, O_WRONLY, O.flags [O.excl],
-			      let open S
-			      in flags [irusr, iwusr]
-			      end),
-		     name))
-	 end handle e as PosixError.SysErr (_, SOME s) =>
-	    if s = Posix.Error.exist
-	       then loop ()
-	    else raise e
+         let
+            val name = concat [prefix, MLtonRandom.alphaNumString 6, suffix]
+            open Posix.FileSys
+         in
+            (name,
+             newOut (createf (name, O_WRONLY, O.flags [O.excl],
+                              let open S
+                              in flags [irusr, iwusr]
+                              end),
+                     name))
+         end handle e as PosixError.SysErr (_, SOME s) =>
+            if s = Posix.Error.exist
+               then loop ()
+            else raise e
    in
       loop ()
    end

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/mlton/io.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/mlton/io.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/mlton/io.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,10 @@
+(* Copyright (C) 2002-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 signature MLTON_IO_ARG =
    sig
       type instream
@@ -2,3 +9,3 @@
       type outstream
-	 
+         
       val inFd: instream -> Posix.IO.file_desc

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/mlton/itimer.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/mlton/itimer.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/mlton/itimer.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,7 +1,15 @@
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 signature MLTON_ITIMER =
    sig
       datatype t =
-	 Prof
+         Prof
        | Real
        | Virtual
 

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/mlton/itimer.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/mlton/itimer.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/mlton/itimer.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,40 +1,48 @@
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 structure MLtonItimer =
    struct
       structure Prim = Primitive.Itimer
-	 
+         
       datatype t = Prof | Real | Virtual
 
       val signal =
-	 fn Prof => PosixPrimitive.Signal.prof
-	  | Real => PosixPrimitive.Signal.alrm
-	  | Virtual => PosixPrimitive.Signal.vtalrm
+         fn Prof => PosixPrimitive.Signal.prof
+          | Real => PosixPrimitive.Signal.alrm
+          | Virtual => PosixPrimitive.Signal.vtalrm
 
       val toInt =
-	 fn Prof => Prim.prof
-	  | Real => Prim.real
-	  | Virtual => Prim.virtual
+         fn Prof => Prim.prof
+          | Real => Prim.real
+          | Virtual => Prim.virtual
 
       fun set' (t, {interval, value}) =
-	 let
-	    fun split t =
-	       let
-		  val (q, r) = IntInf.quotRem (Time.toMicroseconds t, 1000000)
-	       in
-		  (IntInf.toInt q, IntInf.toInt r)
-	       end
-	    val (s1, u1) = split interval
-	    val (s2, u2) = split value
-	 in
-	    Prim.set (toInt t, s1, u1, s2, u2)
-	 end
+         let
+            fun split t =
+               let
+                  val (q, r) = IntInf.quotRem (Time.toMicroseconds t, 1000000)
+               in
+                  (IntInf.toInt q, IntInf.toInt r)
+               end
+            val (s1, u1) = split interval
+            val (s2, u2) = split value
+         in
+            Prim.set (toInt t, s1, u1, s2, u2)
+         end
 
       fun set (z as (t, _)) =
-	 if Primitive.MLton.Profile.isOn
-	    andalso t = Prof
-	    then let
-		    open PosixError
-		 in
-		    raiseSys inval
-		 end
-	 else set' z
+         if Primitive.MLton.Profile.isOn
+            andalso t = Prof
+            then let
+                    open PosixError
+                 in
+                    raiseSys inval
+                 end
+         else set' z
    end

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/mlton/mlton.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/mlton/mlton.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/mlton/mlton.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,14 +1,15 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 signature MLTON =
    sig
 (*      val cleanAtExit: unit -> unit *)
+      val debug: bool
 (*      val deserialize: Word8Vector.vector -> 'a *)
       (* Pointer equality.  The usual caveats about lack of a well-defined
        * semantics.

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/mlton/mlton.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/mlton/mlton.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/mlton/mlton.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 structure MLton: MLTON =
 struct
 
@@ -32,6 +33,7 @@
 
 (* fun cleanAtExit () = let open Cleaner in clean atExit end *)
 
+val debug = Primitive.debug
 val eq = Primitive.eq
 (* val errno = Primitive.errno *)
 val safe = Primitive.safe
@@ -88,15 +90,15 @@
       open OS
 
       structure FileSys =
-	 struct
-	    open FileSys
+         struct
+            open FileSys
 
-	    fun tmpName () =
-	       let
-		  val (f, out) = MLton.TextIO.mkstemp "/tmp/file"
-		  val _ = TextIO.closeOut out
-	       in
-		  f
-	       end
-	 end
+            fun tmpName () =
+               let
+                  val (f, out) = MLton.TextIO.mkstemp "/tmp/file"
+                  val _ = TextIO.closeOut out
+               in
+                  f
+               end
+         end
    end

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/mlton/platform.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/mlton/platform.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/mlton/platform.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,29 +1,36 @@
+(* Copyright (C) 2003-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 signature MLTON_PLATFORM =
    sig
       structure Arch:
-	 sig
+         sig
             datatype t = Alpha | AMD64 | ARM | HPPA | IA64 | m68k |
                          MIPS | PowerPC | S390 | Sparc | X86
 
-	    val fromString: string -> t option
-	    val host: t
-	    val toString: t -> string
-	 end
-	 
+            val fromString: string -> t option
+            val host: t
+            val toString: t -> string
+         end
+         
       structure OS:
-	 sig
-	    datatype t =
-	       Cygwin
-	     | Darwin
-	     | FreeBSD
-	     | Linux
-	     | MinGW
-	     | NetBSD
-	     | OpenBSD
-	     | Solaris
+         sig
+            datatype t =
+               Cygwin
+             | Darwin
+             | FreeBSD
+             | Linux
+             | MinGW
+             | NetBSD
+             | OpenBSD
+             | Solaris
 
-	    val fromString: string -> t option
-	    val host: t
-	    val toString: t -> string
-	 end
+            val fromString: string -> t option
+            val host: t
+            val toString: t -> string
+         end
    end

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/mlton/platform.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/mlton/platform.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/mlton/platform.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,10 @@
+(* Copyright (C) 2003-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 structure MLtonPlatform: MLTON_PLATFORM =
    struct
       open Primitive.MLton.Platform
@@ -4,54 +11,54 @@
 
       fun peek (l, f) = List.find f l
       fun omap (opt, f) = Option.map f opt
-	 
+         
       structure Arch =
-	 struct
-	    open Arch
+         struct
+            open Arch
 
-	    val all = [
-	        (Alpha, "Alpha"),
-	        (AMD64, "AMD64"),
-	        (ARM, "ARM"),
-	        (HPPA, "HPPA"),
-	        (IA64, "IA64"),
-	        (m68k, "m68k"),
-	        (MIPS, "MIPS"),
-	        (PowerPC, "PowerPC"), 
-	        (S390, "S390"),
-	        (Sparc, "Sparc"), 
-	        (X86, "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 = String.toLower s
-	       in
-		  omap (peek (all, fn (_, s') => s = String.toLower s'), #1)
-	       end
+            fun fromString s =
+               let
+                  val s = String.toLower s
+               in
+                  omap (peek (all, fn (_, s') => s = String.toLower s'), #1)
+               end
 
-	    fun toString a = #2 (valOf (peek (all, fn (a', _) => a = a')))
-	 end
+            fun toString a = #2 (valOf (peek (all, fn (a', _) => a = a')))
+         end
 
       structure OS =
-	 struct
-	    open OS
+         struct
+            open OS
 
-	    val all = [(Cygwin, "Cygwin"),
-		       (Darwin, "Darwin"),
-		       (FreeBSD, "FreeBSD"),
-		       (Linux, "Linux"),
-		       (MinGW, "MinGW"),
-		       (NetBSD, "NetBSD"),
-		       (OpenBSD, "OpenBSD"),
-		       (Solaris, "Solaris")]
-	       
-	    fun fromString s =
-	       let
-		  val s = String.toLower s
-	       in
-		  omap (peek (all, fn (_, s') => s = String.toLower s'), #1)
-	       end
+            val all = [(Cygwin, "Cygwin"),
+                       (Darwin, "Darwin"),
+                       (FreeBSD, "FreeBSD"),
+                       (Linux, "Linux"),
+                       (MinGW, "MinGW"),
+                       (NetBSD, "NetBSD"),
+                       (OpenBSD, "OpenBSD"),
+                       (Solaris, "Solaris")]
+               
+            fun fromString s =
+               let
+                  val s = String.toLower s
+               in
+                  omap (peek (all, fn (_, s') => s = String.toLower s'), #1)
+               end
 
-	    fun toString a = #2 (valOf (peek (all, fn (a', _) => a = a')))
-	 end
+            fun toString a = #2 (valOf (peek (all, fn (a', _) => a = a')))
+         end
    end

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/mlton/pointer.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/mlton/pointer.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/mlton/pointer.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,10 @@
+(* Copyright (C) 2003-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 signature MLTON_POINTER =
    sig
       eqtype t
@@ -5,7 +12,7 @@
       val add: t * word -> t
       val compare: t * t -> order
       val diff: t * t -> word
-      val free: t -> unit
+(*      val free: t -> unit *)
       val getInt8: t * int -> Int8.int
       val getInt16: t * int -> Int16.int
       val getInt32: t * int -> Int32.int

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/mlton/pointer.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/mlton/pointer.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/mlton/pointer.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,10 @@
+(* Copyright (C) 2003-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 structure MLtonPointer: MLTON_POINTER =
 struct
 

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/mlton/proc-env.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/mlton/proc-env.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/mlton/proc-env.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,4 +1,15 @@
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 signature MLTON_PROC_ENV =
    sig
+      type gid
+
       val setenv: {name: string, value: string} -> unit
+      val setgroups: gid list -> unit
    end

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/mlton/proc-env.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/mlton/proc-env.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/mlton/proc-env.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,11 +1,25 @@
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 structure MLtonProcEnv: MLTON_PROC_ENV =
    struct
+      type gid = PosixPrimitive.ProcEnv.gid
+
       fun setenv {name, value} =
-	 let
-	    val name = NullString.nullTerm name
-	    val value = NullString.nullTerm value
-	 in
-	    PosixError.SysCall.simple
-	    (fn () => PosixPrimitive.ProcEnv.setenv (name, value))
-	 end
+         let
+            val name = NullString.nullTerm name
+            val value = NullString.nullTerm value
+         in
+            PosixError.SysCall.simple
+            (fn () => PosixPrimitive.ProcEnv.setenv (name, value))
+         end
+
+      fun setgroups gs =
+         PosixError.SysCall.simple
+         (fn () => PosixPrimitive.ProcEnv.setgroups (Array.fromList gs))
    end

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/mlton/process.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/mlton/process.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/mlton/process.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,10 @@
+(* Copyright (C) 2002-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 signature MLTON_PROCESS =
    sig
       type pid
@@ -50,13 +57,13 @@
         end
       
       val create:
-	 {args: string list, 
-	  env: string list option, 
-	  path: string, 
-	  stderr: ('stderr, output) Param.t,
-	  stdin: ('stdin, input) Param.t,
-	  stdout: ('stdout, output) Param.t}
-	 -> ('stdin, 'stdout, 'stderr) t
+         {args: string list, 
+          env: string list option, 
+          path: string, 
+          stderr: ('stderr, output) Param.t,
+          stdin: ('stdin, input) Param.t,
+          stdout: ('stdout, output) Param.t}
+         -> ('stdin, 'stdout, 'stderr) t
       val getStderr: ('stdin, 'stdout, 'stderr) t -> ('stderr, input) Child.t
       val getStdin:  ('stdin, 'stdout, 'stderr) t -> ('stdin, output) Child.t
       val getStdout: ('stdin, 'stdout, 'stderr) t -> ('stdout, input) Child.t

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/mlton/process.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/mlton/process.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/mlton/process.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,10 @@
+(* Copyright (C) 2002-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 structure MLtonProcess =
    struct
       structure Prim = Primitive.MLton.Process
@@ -3,16 +10,14 @@
       structure MLton = Primitive.MLton
       local
-	 open Posix
+         open Posix
       in
-	 structure FileSys = FileSys
-	 structure IO = IO
-	 structure ProcEnv = ProcEnv
-	 structure Process = Posix.Process
+         structure FileSys = FileSys
+         structure IO = IO
+         structure ProcEnv = ProcEnv
+         structure Process = Posix.Process
       end
       structure Mask = MLtonSignal.Mask
       structure SysCall = PosixError.SysCall
 
-      datatype z = datatype PosixPrimitive.file_desc
-      
       type pid = Pid.t
 
@@ -31,346 +36,328 @@
 
       val readWrite =
         let
-	   open FileSys.S
+           open FileSys.S
         in
-	   flags [irusr, iwusr, irgrp, iwgrp, iroth, iwoth]
-	end
+           flags [irusr, iwusr, irgrp, iwgrp, iroth, iwoth]
+        end
       
       structure Child =
-	 struct
-	    datatype 'use childt =
-	       FileDesc of FileSys.file_desc
-	     | Stream of 'use * ('use -> unit)
-	     | Term
-	    type ('use, 'dir) t = 'use childt ref
+         struct
+            datatype 'use childt =
+               FileDesc of FileSys.file_desc
+             | Stream of 'use * ('use -> unit)
+             | Term
+            type ('use, 'dir) t = 'use childt ref
           
-	    (* This is _not_ the identity; by rebuilding it we get type
-	     * ('a, 'b) t -> ('c, 'd) t
-	     *)
-	    fun remember x =
-	       case !x of 
-		  FileDesc f =>
-		     (x := Stream ((), fn () => ())
-		      ; ref (FileDesc f))
-		| Stream _ => raise MisuseOfForget (* remember twice = bad *)
-		| Term => ref Term
-		     
-	    local
-	       fun convert (new, close) p =
-		  case !p of
-		     FileDesc fd =>
-			let
-			   val str = new (fd, "<process>")
-			   val () = p := Stream (str, close)
-			in
-			   str
-			end
-		   | Stream (str, _) => str
-		   | Term => raise MisuseOfForget
-	    in
-	       val binIn = convert (BinIO.newIn, BinIO.closeIn)
-	       val binOut = convert (BinIO.newOut, BinIO.closeOut)
-	       val textIn = convert (TextIO.newIn, TextIO.closeIn)
-	       val textOut = convert (TextIO.newOut, TextIO.closeOut)
-	    end
+            (* This is _not_ the identity; by rebuilding it we get type
+             * ('a, 'b) t -> ('c, 'd) t
+             *)
+            fun remember x =
+               case !x of 
+                  FileDesc f =>
+                     (x := Stream ((), fn () => ())
+                      ; ref (FileDesc f))
+                | Stream _ => raise MisuseOfForget (* remember twice = bad *)
+                | Term => ref Term
+                     
+            local
+               fun convert (new, close) p =
+                  case !p of
+                     FileDesc fd =>
+                        let
+                           val str = new (fd, "<process>")
+                           val () = p := Stream (str, close)
+                        in
+                           str
+                        end
+                   | Stream (str, _) => str
+                   | Term => raise MisuseOfForget
+            in
+               val binIn = convert (BinIO.newIn, BinIO.closeIn)
+               val binOut = convert (BinIO.newOut, BinIO.closeOut)
+               val textIn = convert (TextIO.newIn, TextIO.closeIn)
+               val textOut = convert (TextIO.newOut, TextIO.closeOut)
+            end
           
-	    fun fd p =
-	       case !p of
-		  FileDesc fd => fd
-		| _ => raise MisuseOfForget
+            fun fd p =
+               case !p of
+                  FileDesc fd => fd
+                | _ => raise MisuseOfForget
           
-	    fun close ch =
-	       case ch of
-		  FileDesc fd => IO.close fd
-		| Stream (str, close) => close str
-		| Term => ()
+            fun close ch =
+               case ch of
+                  FileDesc fd => IO.close fd
+                | Stream (str, close) => close str
+                | Term => ()
           
-	    val close =
-	       fn (stdin, stdout, stderr) => 
-	       (close stdin; close stdout; close stderr)
-	 end
+            val close =
+               fn (stdin, stdout, stderr) => 
+               (close stdin; close stdout; close stderr)
+         end
       
       structure Param =
-	 struct
-	    datatype ('use, 'dir) t =
-	       File of string
-	     | FileDesc of FileSys.file_desc
-	     | Pipe
-	     | Self
+         struct
+            datatype ('use, 'dir) t =
+               File of string
+             | FileDesc of FileSys.file_desc
+             | Pipe
+             | Self
           
-	    (* This is _not_ the identity; by rebuilding it we get type
-	     * ('a, 'b) t -> ('c, 'd) t
-	     *)
-	    val forget = fn 
-	       File x => File x
-	     | FileDesc f => FileDesc f
-	     | Pipe => Pipe
-	     | Self => Self
+            (* This is _not_ the identity; by rebuilding it we get type
+             * ('a, 'b) t -> ('c, 'd) t
+             *)
+            val forget = fn 
+               File x => File x
+             | FileDesc f => FileDesc f
+             | Pipe => Pipe
+             | Self => Self
           
-	    val pipe = Pipe
-	    local
-	       val null = if useWindowsProcess then "nul" else "/dev/null"
-	    in
-	       val null = File null
-	    end
-	    val self = Self
-	    fun file f = File f
-	    fun fd f = FileDesc f
+            val pipe = Pipe
+            local
+               val null = if useWindowsProcess then "nul" else "/dev/null"
+            in
+               val null = File null
+            end
+            val self = Self
+            fun file f = File f
+            fun fd f = FileDesc f
 
-	    fun child c =
-	       FileDesc
-	       (case !c of 
-		   Child.FileDesc f => (c := Child.Stream ((), fn () => ()); f)
-		 | Child.Stream _ => raise DoublyRedirected
-		 | Child.Term  => raise MisuseOfForget)
+            fun child c =
+               FileDesc
+               (case !c of 
+                   Child.FileDesc f => (c := Child.Stream ((), fn () => ()); f)
+                 | Child.Stream _ => raise DoublyRedirected
+                 | Child.Term  => raise MisuseOfForget)
             
-	    fun setCloseExec fd =
-	       if useWindowsProcess
-		  then ()
-	       else IO.setfd (fd, IO.FD.flags [IO.FD.cloexec])
+            fun setCloseExec fd =
+               if useWindowsProcess
+                  then ()
+               else IO.setfd (fd, IO.FD.flags [IO.FD.cloexec])
             
-	    fun openOut std p =
-	       case p of 
-		  File s => (FileSys.creat (s, readWrite), Child.Term)
-		| FileDesc f => (f, Child.Term)
-		| Pipe =>
-		     let
-			val {infd, outfd} = IO.pipe ()
-			val () = setCloseExec infd
-		     in
-			(outfd, Child.FileDesc infd)
-		     end
-		| Self => (std, Child.Term)
+            fun openOut std p =
+               case p of 
+                  File s => (FileSys.creat (s, readWrite), Child.Term)
+                | FileDesc f => (f, Child.Term)
+                | Pipe =>
+                     let
+                        val {infd, outfd} = IO.pipe ()
+                        val () = setCloseExec infd
+                     in
+                        (outfd, Child.FileDesc infd)
+                     end
+                | Self => (std, Child.Term)
             
-	    fun openStdin p =
-	       case p of
-		  File s =>
-		     (FileSys.openf (s, FileSys.O_RDONLY, FileSys.O.flags []),
-		      Child.Term)
-		| FileDesc f => (f, Child.Term)
-		| Pipe =>
-		     let
-			val {infd, outfd} = IO.pipe ()
-			val () = setCloseExec outfd
-		     in
-			(infd, Child.FileDesc outfd)
-		     end
-		| Self => (FileSys.stdin, Child.Term)
+            fun openStdin p =
+               case p of
+                  File s =>
+                     (FileSys.openf (s, FileSys.O_RDONLY, FileSys.O.flags []),
+                      Child.Term)
+                | FileDesc f => (f, Child.Term)
+                | Pipe =>
+                     let
+                        val {infd, outfd} = IO.pipe ()
+                        val () = setCloseExec outfd
+                     in
+                        (infd, Child.FileDesc outfd)
+                     end
+                | Self => (FileSys.stdin, Child.Term)
             
-	    fun close p fd =
-	       case p of
-		  File _ => IO.close fd
-		| FileDesc _ => IO.close fd
-		| Pipe => IO.close fd
-		| _ => ()
+            fun close p fd =
+               case p of
+                  File _ => IO.close fd
+                | FileDesc _ => IO.close fd
+                | Pipe => IO.close fd
+                | _ => ()
         end
         
       datatype ('stdin, 'stdout, 'stderr) t =
-	 T of {pid: Process.pid,
-	       status: Posix.Process.exit_status option ref,
-	       stderr: ('stderr, input) Child.t,
-	       stdin:  ('stdin, output) Child.t,
-	       stdout: ('stdout, input) Child.t}
+         T of {pid: Process.pid,
+               status: Posix.Process.exit_status option ref,
+               stderr: ('stderr, input) Child.t,
+               stdin:  ('stdin, output) Child.t,
+               stdout: ('stdout, input) Child.t}
 
       local
-	 fun make f (T r) = f r
+         fun make f (T r) = f r
       in
-	 val getStderr = fn z => make #stderr z
-	 val getStdin = fn z => make #stdin z
-	 val getStdout = fn z => make #stdout z
+         val getStderr = fn z => make #stderr z
+         val getStdin = fn z => make #stdin z
+         val getStdout = fn z => make #stdout z
       end
       
-      fun ('a, 'b) protect (f: 'a -> 'b) (x: 'a): 'b =
-	 let
-	    val () = Mask.block Mask.all
-	 in
-	    DynamicWind.wind (fn () => f x, fn () => Mask.unblock Mask.all)
-	 end
+      fun ('a, 'b) protect (f: 'a -> 'b, x: 'a): 'b =
+         if useWindowsProcess then f x
+         else
+            let
+               val () = Mask.block Mask.all
+            in
+               DynamicWind.wind (fn () => f x, fn () => Mask.unblock Mask.all)
+            end
 
-      fun cwait pid =
-	 let
-	    val status: int ref = ref 0
-	    val pid =
-	       SysCall.syscall
-	       (fn () =>
-		let 
-		   val p = Prim.cwait (pid, status)
-		   val p' = Pid.toInt p
-		in
-		   (p', fn () => p)
-		end)
-	 in
-	    (pid, Process.fromStatus (Exit.Status.fromInt (!status)))
-	 end
-
       fun reap (T {pid, status, stderr, stdin, stdout}) =
-	 case !status of
-	    NONE => 
-	       let
-		  val _ = Child.close (!stdin, !stdout, !stderr)
-		  (* protect is probably too much; typically, one
-		   * would only mask SIGINT, SIGQUIT and SIGHUP
-		   *)
-		  val (_, st) =
-		     if useWindowsProcess
-			then cwait pid
-		     else protect Process.waitpid (Process.W_CHILD pid, [])
-		  val () = status := SOME st
-	       in
-		  st
-	       end
-	  | SOME status => status
+         case !status of
+            NONE => 
+               let
+                  val _ = Child.close (!stdin, !stdout, !stderr)
+                  (* protect is probably too much; typically, one
+                   * would only mask SIGINT, SIGQUIT and SIGHUP
+                   *)
+                  val (_, st) =
+                     protect (Process.waitpid, (Process.W_CHILD pid, []))
+                  val () = status := SOME st
+               in
+                  st
+               end
+          | SOME status => status
 
       fun kill (p as T {pid, status, ...}, signal) =
         case !status of
-	   NONE =>
-	      let
-		 val () =
-		    if useWindowsProcess
-		       then
-			  SysCall.simple
-			  (fn () =>
-			   Primitive.Windows.Process.terminate (pid, signal))
-		    else Process.kill (Process.K_PROC pid, signal)
-	      in
-		 ignore (reap p)
-	      end
-	 | SOME _ => ()
+           NONE =>
+              let
+                 val () =
+                    if useWindowsProcess
+                       then
+                          SysCall.simple
+                          (fn () =>
+                           Primitive.Windows.Process.terminate (pid, signal))
+                    else Process.kill (Process.K_PROC pid, signal)
+              in
+                 ignore (reap p)
+              end
+         | SOME _ => ()
 
       fun launchWithFork (path, args, env, stdin, stdout, stderr) =
-	 case protect Process.fork () of
-	    NONE => (* child *)
-	       let 
-		  val base =
-		     Substring.string
-		     (Substring.taker (fn c => c <> #"/") (Substring.full path))
-		  fun dup2 (old, new) =
-		     if old = new
-			then ()
-		     else (IO.dup2 {old = old, new = new}; IO.close old)
-	       in
-		  dup2 (stdin, FileSys.stdin)
-		  ; dup2 (stdout, FileSys.stdout)
-		  ; dup2 (stderr, FileSys.stderr)
-		  ; Process.exece (path, base :: args, env)
-		  ; Process.exit 0w1 (* just in case *)
-	       end
-	  | SOME pid => pid (* parent *)
+         case protect (Process.fork, ()) of
+            NONE => (* child *)
+               let 
+                  val base =
+                     Substring.string
+                     (Substring.taker (fn c => c <> #"/") (Substring.full path))
+                  fun dup2 (old, new) =
+                     if old = new
+                        then ()
+                     else (IO.dup2 {old = old, new = new}; IO.close old)
+               in
+                  dup2 (stdin, FileSys.stdin)
+                  ; dup2 (stdout, FileSys.stdout)
+                  ; dup2 (stderr, FileSys.stderr)
+                  ; ignore (Process.exece (path, base :: args, env))
+                  ; Process.exit 0w1 (* just in case *)
+               end
+          | SOME pid => pid (* parent *)
 
       val dquote = "\""
       fun cmdEscape y = 
-	 concat [dquote,
-		 String.translate
-		 (fn #"\"" => "\\\"" | #"\\" => "\\\\" | x => String.str x) y,
-		 dquote]
+         concat [dquote,
+                 String.translate
+                 (fn #"\"" => "\\\"" | #"\\" => "\\\\" | x => String.str x) y,
+                 dquote]
 
-      fun create (cmd, args, env, FD stdin, FD stdout, FD stderr) =
-	 SysCall.syscall
-	 (fn () =>
-	  let
-	     val cmd =
-		let
-		   open MLton.Platform.OS
-		in
-		   case host of
-		      Cygwin => Cygwin.toExe cmd
-		    | MinGW => cmd
-		    | _ => raise Fail "create"
-		end
-	     val p =
-		Primitive.Windows.Process.create
-		(NullString.nullTerm cmd, args, env, stdin, stdout, stderr)
-	     val p' = Pid.toInt p
-	  in
-	     (p', fn () => p)
-	  end)
+      fun create (cmd, args, env, stdin, stdout, stderr) =
+         SysCall.syscall
+         (fn () =>
+          let
+             val cmd =
+                let
+                   open MLton.Platform.OS
+                in
+                   case host of
+                      Cygwin => Cygwin.toExe cmd
+                    | MinGW => cmd
+                    | _ => raise Fail "create"
+                end
+             val p =
+                Primitive.Windows.Process.create
+                (NullString.nullTerm cmd, args, env, stdin, stdout, stderr)
+             val p' = Pid.toInt p
+          in
+             (p', fn () => p)
+          end)
 
       fun launchWithCreate (path, args, env, stdin, stdout, stderr) =
-	 create 
-	 (path,
-	  NullString.nullTerm (String.concatWith " "
-			       (List.map cmdEscape (path :: args))),
-	  NullString.nullTerm (String.concatWith "\000" env ^ "\000"),
-	  stdin, stdout, stderr)
+         create 
+         (path,
+          NullString.nullTerm (String.concatWith " "
+                               (List.map cmdEscape (path :: args))),
+          NullString.nullTerm (String.concatWith "\000" env ^ "\000"),
+          stdin, stdout, stderr)
 
       val launch =
-	 fn z =>
-	 (if useWindowsProcess then launchWithCreate else launchWithFork) z
-	     
+         fn z =>
+         (if useWindowsProcess then launchWithCreate else launchWithFork) z
+             
       fun create {args, env, path, stderr, stdin, stdout} =
-	 if not (FileSys.access (path, [FileSys.A_EXEC]))
-	    then PosixError.raiseSys PosixError.noent
-	 else
-	    let
-	       val () = TextIO.flushOut TextIO.stdOut
-	       val env =
-		  case env of
-		     NONE => ProcEnv.environ ()
-		   | SOME x => x
-	       val (fstdin, cstdin) = Param.openStdin stdin
-	       val (fstdout, cstdout) = Param.openOut FileSys.stdout stdout
-	       val (fstderr, cstderr) = Param.openOut FileSys.stderr stderr
-	       val closeStdio =
-		  fn () => (Param.close stdin  fstdin
-			    ; Param.close stdout fstdout
-			    ; Param.close stderr fstderr)
-	       val pid =
-		  launch (path, args, env, fstdin, fstdout, fstderr)
-		  handle ex => (closeStdio ()
-				; Child.close (cstdin, cstdout, cstderr)
-				; raise ex)
-	       val () = closeStdio ()
-	    in
-	       T {pid = pid,
-		  status = ref NONE,
-		  stderr = ref cstderr,
-		  stdin = ref cstdin,
-		  stdout = ref cstdout}
+         if not (FileSys.access (path, [FileSys.A_EXEC]))
+            then PosixError.raiseSys PosixError.noent
+         else
+            let
+               val () = TextIO.flushOut TextIO.stdOut
+               val env =
+                  case env of
+                     NONE => ProcEnv.environ ()
+                   | SOME x => x
+               val (fstdin, cstdin) = Param.openStdin stdin
+               val (fstdout, cstdout) = Param.openOut FileSys.stdout stdout
+               val (fstderr, cstderr) = Param.openOut FileSys.stderr stderr
+               val closeStdio =
+                  fn () => (Param.close stdin  fstdin
+                            ; Param.close stdout fstdout
+                            ; Param.close stderr fstderr)
+               val pid =
+                  launch (path, args, env, fstdin, fstdout, fstderr)
+                  handle ex => (closeStdio ()
+                                ; Child.close (cstdin, cstdout, cstderr)
+                                ; raise ex)
+               val () = closeStdio ()
+            in
+               T {pid = pid,
+                  status = ref NONE,
+                  stderr = ref cstderr,
+                  stdin = ref cstdin,
+                  stdout = ref cstdout}
             end
 
-      val useSpawn = not Primitive.MLton.Platform.OS.forkIsEnabled
-
       fun spawne {path, args, env} =
-	 if useSpawn
-	    then
-	       let
-		  val path = NullString.nullTerm path
-		  val args = C.CSS.fromList args
-		  val env = C.CSS.fromList env
-	       in
-		  SysCall.syscall
-		  (fn () =>
-		   let val pid = Prim.spawne (path, args, env)
-		   in (Pid.toInt pid, fn () => pid)
-		   end)
-	       end
-	 else
-	    case Posix.Process.fork () of
-	       NONE => Posix.Process.exece (path, args, env)
-	     | SOME pid => pid
+         if useWindowsProcess
+            then
+               let
+                  val path = NullString.nullTerm path
+                  val args = C.CSS.fromList args
+                  val env = C.CSS.fromList env
+               in
+                  SysCall.syscall
+                  (fn () =>
+                   let val pid = Prim.spawne (path, args, env)
+                   in (Pid.toInt pid, fn () => pid)
+                   end)
+               end
+         else
+            case Posix.Process.fork () of
+               NONE => Posix.Process.exece (path, args, env)
+             | SOME pid => pid
 
       fun spawn {args, path}= 
-	 spawne {args = args,
-		 env = ProcEnv.environ (),
-		 path = path}
+         spawne {args = args,
+                 env = ProcEnv.environ (),
+                 path = path}
 
       fun spawnp {args, file} =
-	 if useSpawn
-	    then
-	       let
-		  val file = NullString.nullTerm file
-		  val args = C.CSS.fromList args
-	       in
-		  SysCall.syscall
-		  (fn () =>
-		   let val pid = Prim.spawnp (file, args)
-		   in (Pid.toInt pid, fn () => pid)
-		   end)
-	       end
-	 else	 
-	    case Posix.Process.fork () of
-	       NONE => Posix.Process.execp (file, args)
-	     | SOME pid => pid
+         if useWindowsProcess
+            then
+               let
+                  val file = NullString.nullTerm file
+                  val args = C.CSS.fromList args
+               in
+                  SysCall.syscall
+                  (fn () =>
+                   let val pid = Prim.spawnp (file, args)
+                   in (Pid.toInt pid, fn () => pid)
+                   end)
+               end
+         else    
+            case Posix.Process.fork () of
+               NONE => Posix.Process.execp (file, args)
+             | SOME pid => pid
 
       open Exit
    end

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/mlton/profile.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/mlton/profile.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/mlton/profile.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,14 +1,21 @@
+(* Copyright (C) 2002-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 signature MLTON_PROFILE =
    sig
       structure Data:
-	 sig
-	    type t
+         sig
+            type t
 
-	    val equals: t * t -> bool
-	    val free: t -> unit
-	    val malloc: unit -> t
-	    val write: t * string -> unit
-	 end
+            val equals: t * t -> bool
+            val free: t -> unit
+            val malloc: unit -> t
+            val write: t * string -> unit
+         end
 
       val isOn: bool (* a compile-time constant *)
       val withData: Data.t * (unit -> 'a) -> 'a

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/mlton/profile.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/mlton/profile.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/mlton/profile.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,10 @@
+(* Copyright (C) 2003-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 structure MLtonProfile: MLTON_PROFILE =
 struct
 
@@ -8,75 +15,75 @@
 structure Data =
    struct
       datatype t = T of {isCurrent: bool ref,
-			 isFreed: bool ref,
-			 raw: P.Data.t}
+                         isFreed: bool ref,
+                         raw: P.Data.t}
    
       val all: t list ref = ref []
    
       local
-	 fun make f (T r) = f r
+         fun make f (T r) = f r
       in
-	 val isFreed = make #isFreed
-	 val raw = make #raw
+         val isFreed = make #isFreed
+         val raw = make #raw
       end
 
       fun equals (d, d') =
-	 isFreed d = isFreed d'
+         isFreed d = isFreed d'
 
       fun free (d as T {isCurrent, isFreed, raw, ...}) =
-	 if not isOn
-	    then ()
-	 else
-	    if !isFreed
-	       then raise Fail "free of freed profile data"
-	    else if !isCurrent
-		    then raise Fail "free of current profile data"
-		 else
-		    (all := List.foldl (fn (d', ac) =>
-					if equals (d, d')
-					   then ac
-					else d' :: ac) [] (!all)
-		     ; P.Data.free raw
-		     ; isFreed := true)
+         if not isOn
+            then ()
+         else
+            if !isFreed
+               then raise Fail "free of freed profile data"
+            else if !isCurrent
+                    then raise Fail "free of current profile data"
+                 else
+                    (all := List.foldl (fn (d', ac) =>
+                                        if equals (d, d')
+                                           then ac
+                                        else d' :: ac) [] (!all)
+                     ; P.Data.free raw
+                     ; isFreed := true)
 
       fun make (raw: P.Data.t): t =
-	 T {isCurrent = ref false,
-	    isFreed = ref false,
-	    raw = raw}
-	 
+         T {isCurrent = ref false,
+            isFreed = ref false,
+            raw = raw}
+         
       fun malloc (): t =
-	 let
-	    val array =
-	       if isOn
-		  then P.Data.malloc ()
-	       else P.Data.dummy
-	    val d = make array
-	    val _ = all := d :: !all
-	 in
-	    d
-	 end
+         let
+            val array =
+               if isOn
+                  then P.Data.malloc ()
+               else P.Data.dummy
+            val d = make array
+            val _ = all := d :: !all
+         in
+            d
+         end
 
       fun write (T {isFreed, raw, ...}, file) =
-	 if not isOn
-	    then ()
-	 else
-	    if !isFreed
-	       then raise Fail "write of freed profile data"
-	    else
-	       let
-		  val fd =
-		     let
-			open Posix.FileSys
-			open S
-		     in
-			creat (file,
-			       flags [irusr, iwusr, irgrp, iwgrp, iroth, iwoth])
-		     end
-		  val _ = P.Data.write (raw, Posix.FileSys.fdToWord fd)
-		  val _ = Posix.IO.close fd
-	       in
-		  ()
-	       end
+         if not isOn
+            then ()
+         else
+            if !isFreed
+               then raise Fail "write of freed profile data"
+            else
+               let
+                  val fd =
+                     let
+                        open Posix.FileSys
+                        open S
+                     in
+                        creat (file,
+                               flags [irusr, iwusr, irgrp, iwgrp, iroth, iwoth])
+                     end
+                  val _ = P.Data.write (raw, Posix.FileSys.fdToWord fd)
+                  val _ = Posix.IO.close fd
+               in
+                  ()
+               end
    end
 
 val r: Data.t ref = ref (Data.make P.Data.dummy)
@@ -88,17 +95,17 @@
       then ()
    else
       if !isFreed
-	 then raise Fail "setCurrent of freed profile data"
+         then raise Fail "setCurrent of freed profile data"
       else
-	 let
-	    val Data.T {isCurrent = ic, ...} = current ()
-	    val _ = ic := false
-	    val _ = isCurrent := true
-	    val _ = r := d
-	    val _ = P.setCurrent raw
-	 in
-	    ()
-	 end
+         let
+            val Data.T {isCurrent = ic, ...} = current ()
+            val _ = ic := false
+            val _ = isCurrent := true
+            val _ = r := d
+            val _ = P.setCurrent raw
+         in
+            ()
+         end
 
 fun withData (d: Data.t, f: unit -> 'a): 'a =
    let
@@ -115,20 +122,20 @@
       then ()
    else
       let
-	 val _ =
-	    Cleaner.addNew
-	    (Cleaner.atExit, fn () =>
-	     (P.done ()
-	      ; Data.write (current (), "mlmon.out")
-	      ; List.app (P.Data.free o Data.raw) (!Data.all)))
-	 val _ =
-	    Cleaner.addNew
-	    (Cleaner.atLoadWorld, fn () =>
-	     ((* In a new world, all of the old profiling data is invalid. *)
-	      Data.all := []
-	      ; init ()))
+         val _ =
+            Cleaner.addNew
+            (Cleaner.atExit, fn () =>
+             (P.done ()
+              ; Data.write (current (), "mlmon.out")
+              ; List.app (P.Data.free o Data.raw) (!Data.all)))
+         val _ =
+            Cleaner.addNew
+            (Cleaner.atLoadWorld, fn () =>
+             ((* In a new world, all of the old profiling data is invalid. *)
+              Data.all := []
+              ; init ()))
       in
-	 init ()
+         init ()
       end
 
 end

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/mlton/ptrace.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/mlton/ptrace.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/mlton/ptrace.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,11 @@
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 signature MLTON_PTRACE =
    sig
       type pid

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/mlton/ptrace.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/mlton/ptrace.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/mlton/ptrace.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,26 +1,34 @@
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 structure MLtonPtrace: MLTON_PTRACE =
    struct
       open Primitive.Ptrace
-	 
+         
       type pid = Pid.t
-	 
+         
       local
-	 fun make request pid = PosixError.checkResult(ptrace2(request, pid))
+         fun make request pid = PosixError.checkResult(ptrace2(request, pid))
       in
-	 val attach = make ATTACH
-	 val cont = make CONT
-	 val detach = make DETACH
-	 val kill = make KILL
-	 val singleStep = make SINGLESTEP
-	 val sysCall = make SYSCALL
+         val attach = make ATTACH
+         val cont = make CONT
+         val detach = make DETACH
+         val kill = make KILL
+         val singleStep = make SINGLESTEP
+         val sysCall = make SYSCALL
       end
 
       local
       in
-	 fun peekText(pid, addr) =
-	    let val data: word ref = ref 0w0
-	    in PosixError.checkResult(ptrace4(PEEKTEXT, pid, addr, data))
-	       ; !data
-	    end
+         fun peekText(pid, addr) =
+            let val data: word ref = ref 0w0
+            in PosixError.checkResult(ptrace4(PEEKTEXT, pid, addr, data))
+               ; !data
+            end
       end
    end

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/mlton/random.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/mlton/random.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/mlton/random.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,11 @@
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 type int = Int.int
 type word = Word.word
    
@@ -5,20 +13,20 @@
    sig
       (* Return a random alphanumeric character. *)
       val alphaNumChar: unit -> char
-	 
+         
       (* Return a string of random alphanumeric characters of specified
        * length.
        *)
       val alphaNumString: int -> string
-	 
+         
       (* Get the next pseudrandom. *)
       val rand: unit -> word
-	 
+         
       (* Use /dev/random to get a word.  Useful as an arg to srand.
        * Return NONE if /dev/random can't be read.
        *)
       val seed: unit -> word option
-	 
+         
       (* Set the seed used by rand. *)
       val srand: word -> unit
 

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/mlton/random.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/mlton/random.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/mlton/random.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,11 @@
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 structure MLtonRandom: MLTON_RANDOM =
    struct
       (* Uses /dev/random and /dev/urandom to get a random word.
@@ -4,93 +12,93 @@
        * If they can't be read from, return NONE.
        *)
       local
-	 fun make (file, name) =
-	    let
-	       val buf = Word8Array.array (4, 0w0)
-	    in
-	       fn () =>
-	       (let
-		   val fd =
-		      let
-			 open Posix.FileSys
-		      in
-			 openf (file, O_RDONLY, O.flags [])
-		      end
-		   fun loop rem =
-		      let
-			 val n = Posix.IO.readArr (fd,
-						   Word8ArraySlice.slice
-						   (buf, 4 - rem, SOME rem))
-			 val _ = if n = 0
-				    then (Posix.IO.close fd; raise Fail name)
-				 else ()
-			 val rem = rem - n
-		      in
-			 if rem = 0
-			    then ()
-			 else loop rem
-		      end
-		   val _ = loop 4
-		   val _ = Posix.IO.close fd
-		in
-		   SOME (Word.fromLarge (PackWord32Little.subArr (buf, 0)))
-		end
-		   handle OS.SysErr _ => NONE)
-	    end
+         fun make (file, name) =
+            let
+               val buf = Word8Array.array (4, 0w0)
+            in
+               fn () =>
+               (let
+                   val fd =
+                      let
+                         open Posix.FileSys
+                      in
+                         openf (file, O_RDONLY, O.flags [])
+                      end
+                   fun loop rem =
+                      let
+                         val n = Posix.IO.readArr (fd,
+                                                   Word8ArraySlice.slice
+                                                   (buf, 4 - rem, SOME rem))
+                         val _ = if n = 0
+                                    then (Posix.IO.close fd; raise Fail name)
+                                 else ()
+                         val rem = rem - n
+                      in
+                         if rem = 0
+                            then ()
+                         else loop rem
+                      end
+                   val _ = loop 4
+                   val _ = Posix.IO.close fd
+                in
+                   SOME (Word.fromLarge (PackWord32Little.subArr (buf, 0)))
+                end
+                   handle OS.SysErr _ => NONE)
+            end
       in
-	 val seed = make ("/dev/random", "Random.seed")
-	 val useed = make ("/dev/urandom", "Random.useed")
+         val seed = make ("/dev/random", "Random.seed")
+         val useed = make ("/dev/urandom", "Random.useed")
       end
 
       local
-	 open Word
-	 val seed: word ref = ref 0w13
+         open Word
+         val seed: word ref = ref 0w13
       in
-	 (* From page 284 of Numerical Recipes in C. *)
-	 fun rand (): word =
-	    let
-	       val res = 0w1664525 * !seed + 0w1013904223
-	       val _ = seed := res
-	    in
-	       res
-	    end
+         (* From page 284 of Numerical Recipes in C. *)
+         fun rand (): word =
+            let
+               val res = 0w1664525 * !seed + 0w1013904223
+               val _ = seed := res
+            in
+               res
+            end
 
-	 fun srand (w: word): unit = seed := w
+         fun srand (w: word): unit = seed := w
       end
 
       local
-	 val chars =
-	    "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"
-	 val numChars = String.size chars
-	 val refresh =
-	    let
-	       val numChars = IntInf.fromInt numChars
-	       fun loop (i: IntInf.int, c: int): int =
-		  if IntInf.< (i, numChars)
-		     then c
-		  else loop (IntInf.div (i, numChars), c + 1)
-	    in
-	       loop (IntInf.pow (2, Word.wordSize), 0)
-	    end
-	 val r: word ref = ref 0w0
-	 val count: int ref = ref refresh
-	 val numChars = Word.fromInt numChars
+         val chars =
+            "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"
+         val numChars = String.size chars
+         val refresh =
+            let
+               val numChars = IntInf.fromInt numChars
+               fun loop (i: IntInf.int, c: int): int =
+                  if IntInf.< (i, numChars)
+                     then c
+                  else loop (IntInf.div (i, numChars), c + 1)
+            in
+               loop (IntInf.pow (2, Word.wordSize), 0)
+            end
+         val r: word ref = ref 0w0
+         val count: int ref = ref refresh
+         val numChars = Word.fromInt numChars
       in
-	 fun alphaNumChar (): char =
-	    let
-	       val n = !count
-	       val _ = if n = refresh
-			  then (r := rand ()
-				; count := 1)
-		       else (count := n + 1)
-	       val w = !r
-	       val c = String.sub (chars, Word.toInt (Word.mod (w, numChars)))
-	       val _ = r := Word.div (w, numChars)
-	    in
-	       c
-	    end
+         fun alphaNumChar (): char =
+            let
+               val n = !count
+               val _ = if n = refresh
+                          then (r := rand ()
+                                ; count := 1)
+                       else (count := n + 1)
+               val w = !r
+               val c = String.sub (chars, Word.toInt (Word.mod (w, numChars)))
+               val _ = r := Word.div (w, numChars)
+            in
+               c
+            end
       end
 
       fun alphaNumString (length: int): string =
-	 String.tabulate (length, fn _ => alphaNumChar ())
+         String.tabulate (length, fn _ => alphaNumChar ())
    end

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/mlton/rlimit.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/mlton/rlimit.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/mlton/rlimit.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,11 @@
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 type word = Word.word
    
 signature MLTON_RLIMIT =
@@ -3,9 +11,9 @@
    sig
       type rlim = word
-	       
+               
       val infinity: rlim
 
       type t
-	       
+               
       val coreFileSize: t        (* CORE    max core file size *)
       val cpuTime: t             (* CPU     CPU time in seconds *)

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/mlton/rlimit.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/mlton/rlimit.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/mlton/rlimit.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,11 @@
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 structure MLtonRlimit: MLTON_RLIMIT =
    struct
       open Primitive.MLton.Rlimit
@@ -3,14 +11,14 @@
 
       val get =
-	 fn (r: t) =>
-	 PosixError.SysCall.syscall
-	 (fn () =>
-	  (get r, fn () => 
-	   {hard = getHard (),
-	    soft = getSoft ()}))
+         fn (r: t) =>
+         PosixError.SysCall.syscall
+         (fn () =>
+          (get r, fn () => 
+           {hard = getHard (),
+            soft = getSoft ()}))
 
       val set =
-	 fn (r: t, {hard, soft}) =>
-	 PosixError.SysCall.simple
-	 (fn () => set (r, hard, soft))
+         fn (r: t, {hard, soft}) =>
+         PosixError.SysCall.simple
+         (fn () => set (r, hard, soft))
    end

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/mlton/rusage.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/mlton/rusage.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/mlton/rusage.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,19 @@
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 signature MLTON_RUSAGE =
    sig
       type t = {utime: Time.time, (* user time *)
-		stime: Time.time  (* system time *)
-		}
-	 
+                stime: Time.time  (* system time *)
+                }
+
+      val measureGC: bool -> unit
       val rusage: unit -> {children: t,
-			   gc: t,
-			   self: t}
+                           gc: t,
+                           self: t}
    end

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/mlton/rusage.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/mlton/rusage.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/mlton/rusage.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,11 @@
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 structure MLtonRusage: MLTON_RUSAGE =
    struct
       structure Prim = Primitive.MLton.Rusage
@@ -5,31 +13,38 @@
       type t = {utime: Time.time, stime: Time.time}
 
       fun collect (utimeSec, utimeUsec, stimeSec, stimeUsec) =
-	 let
-	    fun toTime (sec, usec) =
-	       let
-		  val time_sec =
-		     Time.fromSeconds (LargeInt.fromInt (sec ()))
-		  val time_usec =
-		     Time.fromMicroseconds (LargeInt.fromInt (usec ()))
-	       in
-		  Time.+ (time_sec, time_usec)
-	       end
-	 in
-	    {stime = toTime (stimeSec, stimeUsec),
-	     utime = toTime (utimeSec, utimeUsec)}
-	 end
+         let
+            fun toTime (sec, usec) =
+               let
+                  val time_sec =
+                     Time.fromSeconds (LargeInt.fromInt (sec ()))
+                  val time_usec =
+                     Time.fromMicroseconds (LargeInt.fromInt (usec ()))
+               in
+                  Time.+ (time_sec, time_usec)
+               end
+         in
+            {stime = toTime (stimeSec, stimeUsec),
+             utime = toTime (utimeSec, utimeUsec)}
+         end
 
-      fun rusage () =
-	 let
-	    val () = Prim.ru ()
-	    open Prim
-	 in
-	    {children = collect (children_utime_sec, children_utime_usec,
-				 children_stime_sec, children_stime_usec),
-	     gc = collect (gc_utime_sec, gc_utime_usec,
-			   gc_stime_sec, gc_stime_usec),
-	     self = collect (self_utime_sec, self_utime_usec,
-			     self_stime_sec, self_stime_usec)}
-	 end
+      val measureGC = Primitive.GC.setRusageMeasureGC
+
+      val rusage =
+         let 
+            val () = measureGC true
+         in
+            fn () =>
+            let
+               val () = Prim.ru ()
+               open Prim
+            in
+               {children = collect (children_utime_sec, children_utime_usec,
+                                    children_stime_sec, children_stime_usec),
+                gc = collect (gc_utime_sec, gc_utime_usec,
+                              gc_stime_sec, gc_stime_usec),
+                self = collect (self_utime_sec, self_utime_usec,
+                                self_stime_sec, self_stime_usec)}
+            end
+         end
    end

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/mlton/signal.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/mlton/signal.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/mlton/signal.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,11 @@
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 signature MLTON_SIGNAL =
    sig
       type t
@@ -4,31 +12,31 @@
       type signal = t
 
       structure Handler:
-	 sig
-	    type t
+         sig
+            type t
 
-	    val default: t
-	    val handler: (MLtonThread.Runnable.t -> MLtonThread.Runnable.t) -> t
-	    val ignore: t
-	    val isDefault: t -> bool
-	    val isIgnore: t -> bool
-	    val simple: (unit -> unit) -> t
-	 end
+            val default: t
+            val handler: (MLtonThread.Runnable.t -> MLtonThread.Runnable.t) -> t
+            val ignore: t
+            val isDefault: t -> bool
+            val isIgnore: t -> bool
+            val simple: (unit -> unit) -> t
+         end
 
       structure Mask:
-	 sig
-	    type t
-	       
-	    val all: t
-	    val allBut: signal list -> t
-	    val block: t -> unit
-	    val getBlocked: unit -> t
-	    val isMember: t * signal -> bool
-	    val none: t
-	    val setBlocked: t -> unit
-	    val some: signal list -> t
-	    val unblock: t -> unit
-	 end
+         sig
+            type t
+               
+            val all: t
+            val allBut: signal list -> t
+            val block: t -> unit
+            val getBlocked: unit -> t
+            val isMember: t * signal -> bool
+            val none: t
+            val setBlocked: t -> unit
+            val some: signal list -> t
+            val unblock: t -> unit
+         end
 
       val getHandler: t -> Handler.t
       val handled: unit -> Mask.t

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/mlton/signal.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/mlton/signal.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/mlton/signal.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 structure MLtonSignal: MLTON_SIGNAL_EXTRA =
 struct
 
@@ -38,7 +39,7 @@
 structure Mask =
    struct
       datatype t =
-	 AllBut of signal list
+         AllBut of signal list
        | Some of signal list
 
       val allBut = AllBut
@@ -48,52 +49,52 @@
       val none = some []
 
       fun read () =
-	 Some
-	 (Array.foldri
-	  (fn (i, b, sigs) =>
-	   if b
-	      then if (Prim.sigismember(fromInt i)) = 1
-		      then (fromInt i)::sigs
-		      else sigs
-	      else sigs)
-	  []
-	  validSignals)
+         Some
+         (Array.foldri
+          (fn (i, b, sigs) =>
+           if b
+              then if (Prim.sigismember(fromInt i)) = 1
+                      then (fromInt i)::sigs
+                      else sigs
+              else sigs)
+          []
+          validSignals)
 
       fun write m =
-	 case m of
-	    AllBut signals =>
-	       (SysCall.simple Prim.sigfillset
-		; List.app (fn s => SysCall.simple (fn () => Prim.sigdelset s)) signals)
-	  | Some signals =>
-	       (SysCall.simple Prim.sigemptyset
-		; List.app (fn s => SysCall.simple (fn () => Prim.sigaddset s)) signals)
-	       
+         case m of
+            AllBut signals =>
+               (SysCall.simple Prim.sigfillset
+                ; List.app (fn s => SysCall.simple (fn () => Prim.sigdelset s)) signals)
+          | Some signals =>
+               (SysCall.simple Prim.sigemptyset
+                ; List.app (fn s => SysCall.simple (fn () => Prim.sigaddset s)) signals)
+               
       local
-	 fun make (how: how) (m: t) =
-	    (write m; SysCall.simpleRestart (fn () => Prim.sigprocmask how))
+         fun make (how: how) (m: t) =
+            (write m; SysCall.simpleRestart (fn () => Prim.sigprocmask how))
       in
-	 val block = make Prim.block
-	 val unblock = make Prim.unblock
-	 val setBlocked = make Prim.setmask
-	 fun getBlocked () = (make Prim.block none; read ())
+         val block = make Prim.block
+         val unblock = make Prim.unblock
+         val setBlocked = make Prim.setmask
+         fun getBlocked () = (make Prim.block none; read ())
       end
 
       local
-	 fun member (sigs, s) = List.exists (fn s' => s = s') sigs
+         fun member (sigs, s) = List.exists (fn s' => s = s') sigs
       in
-	 fun isMember (mask, s) =
-	    if Array.sub (validSignals, toInt s)
-	       then case mask of
-		       AllBut sigs => not (member (sigs, s))
-		     | Some sigs => member (sigs, s)		  
-	       else raiseInval ()
+         fun isMember (mask, s) =
+            if Array.sub (validSignals, toInt s)
+               then case mask of
+                       AllBut sigs => not (member (sigs, s))
+                     | Some sigs => member (sigs, s)              
+               else raiseInval ()
       end
    end
 
 structure Handler =
    struct
       datatype t =
-	 Default
+         Default
        | Handler of MLtonThread.Runnable.t -> MLtonThread.Runnable.t
        | Ignore
        | InvalidSignal
@@ -106,9 +107,9 @@
 in
    fun initHandler (s: signal): Handler.t =
       if 0 = Prim.isDefault (s, r)
-	 then if !r
-		 then Default
-	      else Ignore
+         then if !r
+                 then Default
+              else Ignore
       else InvalidSignal
 end
 
@@ -116,14 +117,14 @@
    let
       val handlers = Array.tabulate (Prim.numSignals, initHandler o fromInt)
       val _ =
-	 Cleaner.addNew
-	 (Cleaner.atLoadWorld, fn () =>
-	  Array.modifyi (initHandler o fromInt o #1) handlers)
+         Cleaner.addNew
+         (Cleaner.atLoadWorld, fn () =>
+          Array.modifyi (initHandler o fromInt o #1) handlers)
    in
       (fn s: t => Array.sub (handlers, toInt s),
        fn (s: t, h) => if Primitive.MLton.Profile.isOn andalso s = prof
-			  then raiseInval ()
-		       else Array.update (handlers, toInt s, h),
+                          then raiseInval ()
+                       else Array.update (handlers, toInt s, h),
        handlers)
    end
 
@@ -134,7 +135,7 @@
    (Array.foldri
     (fn (s, h, sigs) =>
      case h of 
-	Handler _ => (fromInt s)::sigs
+        Handler _ => (fromInt s)::sigs
       | _ => sigs) [] handlers)
    
 structure Handler =
@@ -148,55 +149,55 @@
       val isIgnore = fn Ignore => true | _ => false
 
       val handler =
-	 (* This let is used so that Thread.setHandler is only used if
-	  * Handler.handler is used.  This prevents threads from being part
-	  * of every program.
-	  *)
-	 let
-	    (* As far as C is concerned, there is only one signal handler.
-	     * As soon as possible after a C signal is received, this signal
-	     * handler walks over the array of all SML handlers, and invokes any
-	     * one for which a C signal has been received.
-	     *
-	     * Any exceptions raised by a signal handler will be caught by
-	     * the topLevelHandler, which is installed in thread.sml.
-	     *)
-	    val _ =
-	       PosixError.SysCall.blocker :=
-	       (fn () => let
-			    val m = Mask.getBlocked ()
-			    val () = Mask.block (handled ())
-			 in
-			    fn () => Mask.setBlocked m
-			 end)
+         (* This let is used so that Thread.setHandler is only used if
+          * Handler.handler is used.  This prevents threads from being part
+          * of every program.
+          *)
+         let
+            (* As far as C is concerned, there is only one signal handler.
+             * As soon as possible after a C signal is received, this signal
+             * handler walks over the array of all SML handlers, and invokes any
+             * one for which a C signal has been received.
+             *
+             * Any exceptions raised by a signal handler will be caught by
+             * the topLevelHandler, which is installed in thread.sml.
+             *)
+            val _ =
+               PosixError.SysCall.blocker :=
+               (fn () => let
+                            val m = Mask.getBlocked ()
+                            val () = Mask.block (handled ())
+                         in
+                            fn () => Mask.setBlocked m
+                         end)
 
-	    val () =
-	       MLtonThread.setHandler
-	       (fn t =>
-		let
-		   val mask = Mask.getBlocked ()
-		   val () = Mask.block (handled ())
-		   val fs = 
-		      case !gcHandler of
-			 Handler f => if Prim.isGCPending () then [f] else []
-		       | _ => []
-		   val fs =
-		      Array.foldri
-		      (fn (s, h, fs) =>
-		       case h of
-			  Handler f =>
-			     if Prim.isPending (fromInt s) then f::fs else fs
-			| _ => fs) fs handlers
-		   val () = Prim.resetPending ()
-		   val () = Mask.setBlocked mask
-		in
-		   List.foldl (fn (f, t) => f t) t fs
-		end)
-	 in
-	    Handler
-	 end
+            val () =
+               MLtonThread.setHandler
+               (fn t =>
+                let
+                   val mask = Mask.getBlocked ()
+                   val () = Mask.block (handled ())
+                   val fs = 
+                      case !gcHandler of
+                         Handler f => if Prim.isGCPending () then [f] else []
+                       | _ => []
+                   val fs =
+                      Array.foldri
+                      (fn (s, h, fs) =>
+                       case h of
+                          Handler f =>
+                             if Prim.isPending (fromInt s) then f::fs else fs
+                        | _ => fs) fs handlers
+                   val () = Prim.resetPending ()
+                   val () = Mask.setBlocked mask
+                in
+                   List.foldl (fn (f, t) => f t) t fs
+                end)
+         in
+            Handler
+         end
 
-      fun simple f = handler (fn t => (f (); t))
+      fun simple (f: unit -> unit) = handler (fn t => (f (); t))
    end
 
 val setHandler = fn (s, h) =>
@@ -205,17 +206,17 @@
     | (_, InvalidSignal) => raiseInval ()
     | (Default, Default) => ()
     | (_, Default) => 
-	 (setHandler (s, Default)
-	  ; SysCall.simpleRestart (fn () => Prim.default s))
+         (setHandler (s, Default)
+          ; SysCall.simpleRestart (fn () => Prim.default s))
     | (Handler _, Handler _) =>
-	 setHandler (s, h)
+         setHandler (s, h)
     | (_, Handler _) =>
-	 (setHandler (s, h)
-	  ; SysCall.simpleRestart (fn () => Prim.handlee s))
+         (setHandler (s, h)
+          ; SysCall.simpleRestart (fn () => Prim.handlee s))
     | (Ignore, Ignore) => ()
     | (_, Ignore) => 
-	 (setHandler (s, Ignore)
-	  ; SysCall.simpleRestart (fn () => Prim.ignore s))
+         (setHandler (s, Ignore)
+          ; SysCall.simpleRestart (fn () => Prim.ignore s))
 
 fun suspend m =
    (Mask.write m

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/mlton/socket.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/mlton/socket.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/mlton/socket.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,11 @@
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 type int = Int.int
 type word = Word.word
 
@@ -4,22 +12,29 @@
 signature MLTON_SOCKET =
    sig
       structure Address:
-	 sig
-	    type t = word
-	 end
+         sig
+            type t = word
+         end
 
+      structure Ctl:
+         sig
+            val getERROR:
+               ('af, 'sock_type) Socket.sock
+               -> (string * Posix.Error.syserror option) option
+         end
+
       structure Host:
-	 sig
-	    type t = {name: string}
+         sig
+            type t = {name: string}
 
-	    val getByAddress: Address.t -> t option
-	    val getByName: string -> t option
-	 end
+            val getByAddress: Address.t -> t option
+            val getByName: string -> t option
+         end
 
       structure Port:
-	 sig
-	    type t = int
-	 end
+         sig
+            type t = int
+         end
 
       type t
 

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/mlton/socket.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/mlton/socket.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/mlton/socket.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,11 @@
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 structure MLtonSocket: MLTON_SOCKET =
 struct
 
@@ -16,7 +24,7 @@
       type t = {name: string}
 
       val get: NetHostDB.entry option -> t option =
-	Option.map (fn entry => {name = NetHostDB.name entry})
+        Option.map (fn entry => {name = NetHostDB.name entry})
 
       val getByAddress = get o NetHostDB.getByAddr o NetHostDB.wordToInAddr
       val getByName = get o NetHostDB.getByName
@@ -63,7 +71,7 @@
 fun accept s =
    let
       val (sock: activeSocket, addr: INetSock.inet Socket.sock_addr) =
-	 Socket.accept s
+         Socket.accept s
       val (in_addr: NetHostDB.in_addr, port: int) = INetSock.fromAddr addr
       val (ins, out) = sockToIO sock
    in
@@ -75,7 +83,7 @@
       val hp: NetHostDB.entry = valOf (NetHostDB.getByName host)
       val res: activeSocket = INetSock.TCP.socket ()
       val addr: INetSock.inet Socket.sock_addr =
-	 INetSock.toAddr (NetHostDB.addr hp, port)
+         INetSock.toAddr (NetHostDB.addr hp, port)
       val _ = Socket.connect (res, addr)
       val (ins, out) = sockToIO res
    in 
@@ -93,5 +101,7 @@
     ; shutdown (TextIO.outFd out, Socket.NO_SENDS))
 
 val fdToSock = Socket.fdToSock
+
+structure Ctl = Socket.CtlExtra
    
 end

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/mlton/syslog.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/mlton/syslog.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/mlton/syslog.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,11 @@
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 (* From Tom 7 <twm@andrew.cmu.edu>. *)
 (* A rather complete interface to the syslog facilities. 
  *
@@ -9,7 +17,7 @@
 signature MLTON_SYSLOG =
    sig
       type openflag
-	 
+         
       val CONS     : openflag
       val NDELAY   : openflag
       val PERROR   : openflag

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/mlton/syslog.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/mlton/syslog.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/mlton/syslog.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,11 @@
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 (* From Tom 7 <twm@andrew.cmu.edu>. *)
 (* Implementation of the SYSLOG interface using MLton FFI.
  * This will only work in MLton.
@@ -18,7 +26,7 @@
 fun openlog (s, opt, fac) =
    let 
       val optf = 
-	 Word32.toInt (foldl Word32.orb 0w0 (map Word32.fromInt opt))
+         Word32.toInt (foldl Word32.orb 0w0 (map Word32.fromInt opt))
       val sys_strdup  = _import "strdup" : string -> word ;
       val sys_openlog = _import "openlog" : word * int * int -> unit ;
    in

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/mlton/text-io.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/mlton/text-io.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/mlton/text-io.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,4 +1,9 @@
-signature MLTON_TEXT_IO =
-   MLTON_IO
-   where type instream = TextIO.instream
-   where type outstream = TextIO.outstream
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
+signature MLTON_TEXT_IO = MLTON_IO

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/mlton/thread.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/mlton/thread.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/mlton/thread.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,8 +1,8 @@
-(* Copyright (C) 2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 2004-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 type int = Int.int
@@ -10,18 +10,18 @@
 signature MLTON_THREAD =
    sig
       structure AtomicState :
-	 sig
-	    datatype t = NonAtomic | Atomic of int
-	 end
+         sig
+            datatype t = NonAtomic | Atomic of int
+         end
       val atomicBegin: unit -> unit
       val atomicEnd: unit -> unit
       val atomically: (unit -> 'a) -> 'a
       val atomicState: unit -> AtomicState.t
 
       structure Runnable :
-	 sig
-	    type t
-	 end
+         sig
+            type t
+         end
 
       type 'a t
 

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/mlton/thread.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/mlton/thread.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/mlton/thread.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 2004-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 structure MLtonThread:> MLTON_THREAD_EXTRA =
 struct
 
@@ -21,7 +22,7 @@
    val atomicEnd = atomicEnd
    val atomicState = fn () =>
       case canHandle () of
-	 0 => AtomicState.NonAtomic
+         0 => AtomicState.NonAtomic
        | n => AtomicState.Atomic n
 end
 
@@ -45,11 +46,11 @@
 fun prepend (T r: 'a t, f: 'b -> 'a): 'b t =
    let
       val t =
-	 case !r of
-	    Dead => raise Fail "prepend to a Dead thread"
-	  | Interrupted _ => raise Fail "prepend to a Interrupted thread"
-	  | New g => New (g o f)
-	  | Paused (g, t) => Paused (fn h => g (f o h), t)
+         case !r of
+            Dead => raise Fail "prepend to a Dead thread"
+          | Interrupted _ => raise Fail "prepend to a Interrupted thread"
+          | New g => New (g o f)
+          | Paused (g, t) => Paused (fn h => g (f o h), t)
    in r := Dead
       ; T (ref t)
    end
@@ -63,68 +64,68 @@
    local
       val func: (unit -> unit) option ref = ref NONE
       val base: Prim.preThread =
-	 let
-	    val () = Prim.copyCurrent ()
-	 in
-	    case !func of
-	       NONE => Prim.savedPre ()
-	     | SOME x =>
-		  (* This branch never returns. *)
-		  let
-		     (* Atomic 1 *)
-		     val () = func := NONE
-		     val () = atomicEnd ()
-		     (* Atomic 0 *)
-		  in
-		     (x () handle e => MLtonExn.topLevelHandler e)
-		     ; die "Thread didn't exit properly.\n"
-		  end
-	 end
+         let
+            val () = Prim.copyCurrent ()
+         in
+            case !func of
+               NONE => Prim.savedPre ()
+             | SOME x =>
+                  (* This branch never returns. *)
+                  let
+                     (* Atomic 1 *)
+                     val () = func := NONE
+                     val () = atomicEnd ()
+                     (* Atomic 0 *)
+                  in
+                     (x () handle e => MLtonExn.topLevelHandler e)
+                     ; die "Thread didn't exit properly.\n"
+                  end
+         end
    in
       fun newThread (f: unit -> unit) : Prim.thread =
-	 let
-	    (* Atomic 2 *)
-	    val () = func := SOME f
-	 in
-	    Prim.copy base
-	 end
+         let
+            (* Atomic 2 *)
+            val () = func := SOME f
+         in
+            Prim.copy base
+         end
    end
    val switching = ref false
 in
    fun 'a atomicSwitch (f: 'a t -> Runnable.t): 'a =
       (* Atomic 1 *)
       if !switching
-	 then let
-		 val () = atomicEnd ()
-		 (* Atomic 0 *)
-	      in
-		 raise Fail "nested Thread.switch"
-	      end
+         then let
+                 val () = atomicEnd ()
+                 (* Atomic 0 *)
+              in
+                 raise Fail "nested Thread.switch"
+              end
       else
-	 let
-	    val _ = switching := true
-	    val r : (unit -> 'a) ref = 
-	       ref (fn () => die "Thread.atomicSwitch didn't set r.\n")
-	    val t: 'a thread ref =
-	       ref (Paused (fn x => r := x, Prim.current ()))
-	    fun fail e = (t := Dead
-			  ; switching := false
-			  ; atomicEnd ()
-			  ; raise e)	
-	    val (T t': Runnable.t) = f (T t) handle e => fail e
-	    val primThread =
-	       case !t' before t' := Dead of
-		  Dead => fail (Fail "switch to a Dead thread")
-		| Interrupted t => t
-		| New g => (atomicBegin (); newThread g)
-		| Paused (f, t) => (f (fn () => ()); t)
-	    val _ = switching := false
-	    (* Atomic 1 when Paused/Interrupted, Atomic 2 when New *)
-	    val _ = Prim.switchTo primThread (* implicit atomicEnd() *)
-	    (* Atomic 0 when resuming *)
-	 in
-	    !r ()
-	 end
+         let
+            val _ = switching := true
+            val r : (unit -> 'a) ref = 
+               ref (fn () => die "Thread.atomicSwitch didn't set r.\n")
+            val t: 'a thread ref =
+               ref (Paused (fn x => r := x, Prim.current ()))
+            fun fail e = (t := Dead
+                          ; switching := false
+                          ; atomicEnd ()
+                          ; raise e)    
+            val (T t': Runnable.t) = f (T t) handle e => fail e
+            val primThread =
+               case !t' before t' := Dead of
+                  Dead => fail (Fail "switch to a Dead thread")
+                | Interrupted t => t
+                | New g => (atomicBegin (); newThread g)
+                | Paused (f, t) => (f (fn () => ()); t)
+            val _ = switching := false
+            (* Atomic 1 when Paused/Interrupted, Atomic 2 when New *)
+            val _ = Prim.switchTo primThread (* implicit atomicEnd() *)
+            (* Atomic 0 when resuming *)
+         in
+            !r ()
+         end
 
    fun switch f =
       (atomicBegin ()
@@ -138,21 +139,21 @@
    case !r of
       Dead => die "Thread.toPrimitive saw Dead.\n"
     | Interrupted t => 
-	 (r := Dead
-	  ; t)
+         (r := Dead
+          ; t)
     | New _ =>
-	 switch
-	 (fn cur : Prim.thread t =>
-	  prepare
-	  (prepend (t, fn () =>
-		    switch
-		    (fn t' : unit t =>
-		     prepare (cur, toPrimitive t'))),
-	   ()))
+         switch
+         (fn cur : Prim.thread t =>
+          prepare
+          (prepend (t, fn () =>
+                    switch
+                    (fn t' : unit t =>
+                     prepare (cur, toPrimitive t'))),
+           ()))
     | Paused (f, t) =>
-	 (r := Dead
-	  ; f (fn () => ()) 
-	  ; t)
+         (r := Dead
+          ; f (fn () => ()) 
+          ; t)
 
 
 local
@@ -164,47 +165,47 @@
 
    fun setHandler (f: Runnable.t -> Runnable.t): unit =
       let
-	 val _ = Primitive.installSignalHandler ()
-	 fun loop (): unit =
-	    let
-	       (* Atomic 1 *)
-	       val _ = state := InHandler
-	       val t = f (fromPrimitive (Prim.saved ()))
-	       val _ = state := Normal
-	       val _ = Prim.finishHandler ()
-	       val _ =
-		  atomicSwitch
-		  (fn (T r) =>
-		   let
-		      val _ =
-			 case !r of
-			    Paused (f, _) => f (fn () => ())
-			  | _ => raise die "Thread.setHandler saw strange thread"
-		   in
-		      t
-		   end) (* implicit atomicEnd () *)
-	    in
-	       loop ()
-	    end
-	 val p =
-	    toPrimitive
-	    (new (fn () => loop () handle e => MLtonExn.topLevelHandler e))
-	 val _ = signalHandler := SOME p
+         val _ = Primitive.installSignalHandler ()
+         fun loop (): unit =
+            let
+               (* Atomic 1 *)
+               val _ = state := InHandler
+               val t = f (fromPrimitive (Prim.saved ()))
+               val _ = state := Normal
+               val _ = Prim.finishHandler ()
+               val _ =
+                  atomicSwitch
+                  (fn (T r) =>
+                   let
+                      val _ =
+                         case !r of
+                            Paused (f, _) => f (fn () => ())
+                          | _ => raise die "Thread.setHandler saw strange thread"
+                   in
+                      t
+                   end) (* implicit atomicEnd () *)
+            in
+               loop ()
+            end
+         val p =
+            toPrimitive
+            (new (fn () => loop () handle e => MLtonExn.topLevelHandler e))
+         val _ = signalHandler := SOME p
       in
-	 Prim.setHandler p
+         Prim.setHandler p
       end
 
    fun switchToHandler () =
       let
-	 (* Atomic 0 *)
-	 val () = atomicBegin ()
+         (* Atomic 0 *)
+         val () = atomicBegin ()
          (* Atomic 1 *)
-	 val () = Prim.startHandler () (* implicit atomicBegin () *)
+         val () = Prim.startHandler () (* implicit atomicBegin () *)
          (* Atomic 2 *)
       in
-	 case !signalHandler of
-	    NONE => raise Fail "no signal handler installed"
-	  | SOME t => Prim.switchTo t (* implicit atomicEnd() *)
+         case !signalHandler of
+            NONE => raise Fail "no signal handler installed"
+          | SOME t => Prim.switchTo t (* implicit atomicEnd() *)
       end
 end
 
@@ -214,37 +215,37 @@
 in
    val register: int * (unit -> unit) -> unit =
       let
-	 val exports = Array.array (Primitive.FFI.numExports, fn () =>
-				    raise Fail "undefined export")
-	 fun loop (): unit =
-	    let
-	       (* Atomic 2 *)
-	       val t = Prim.saved ()
-	       fun doit () =
-		  let
-		     (* Atomic 1 *)
-		     val _ = 
-			(* atomicEnd() after getting args *)
-			(Array.sub (exports, Primitive.FFI.getOp ()) ())
-			handle e => 
-			   (TextIO.output 
-			    (TextIO.stdErr, "Call from C to SML raised exception.\n")
-			    ; MLtonExn.topLevelHandler e)
-			(* atomicBegin() before putting res *)
-		     (* Atomic 1 *)
-		     val _ = Prim.setSaved t
-		     val _ = Prim.returnToC () (* implicit atomicEnd() *)
-		  in
-		     ()
-		  end
-	       val _ = Prim.switchTo (toPrimitive (new doit)) (* implicit atomicEnd() *)
-	    in
-	       loop ()
-	    end
-	 val p = toPrimitive (new (fn () => loop ()))
-	 val _ = Prim.setCallFromCHandler p
+         val exports = Array.array (Primitive.FFI.numExports, fn () =>
+                                    raise Fail "undefined export")
+         fun loop (): unit =
+            let
+               (* Atomic 2 *)
+               val t = Prim.saved ()
+               fun doit () =
+                  let
+                     (* Atomic 1 *)
+                     val _ = 
+                        (* atomicEnd() after getting args *)
+                        (Array.sub (exports, Primitive.FFI.getOp ()) ())
+                        handle e => 
+                           (TextIO.output 
+                            (TextIO.stdErr, "Call from C to SML raised exception.\n")
+                            ; MLtonExn.topLevelHandler e)
+                        (* atomicBegin() before putting res *)
+                     (* Atomic 1 *)
+                     val _ = Prim.setSaved t
+                     val _ = Prim.returnToC () (* implicit atomicEnd() *)
+                  in
+                     ()
+                  end
+               val _ = Prim.switchTo (toPrimitive (new doit)) (* implicit atomicEnd() *)
+            in
+               loop ()
+            end
+         val p = toPrimitive (new (fn () => loop ()))
+         val _ = Prim.setCallFromCHandler p
       in
-	 fn (i, f) => Array.update (exports, i, f)
+         fn (i, f) => Array.update (exports, i, f)
       end
 end
 

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/mlton/vector.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/mlton/vector.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/mlton/vector.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,11 @@
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 type int = Int.int
 
 signature MLTON_VECTOR =

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/mlton/weak.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/mlton/weak.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/mlton/weak.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,10 @@
+(* Copyright (C) 2003-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 signature MLTON_WEAK =
    sig
       type 'a t

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/mlton/weak.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/mlton/weak.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/mlton/weak.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,21 +1,28 @@
+(* Copyright (C) 2003-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 structure MLtonWeak =
    struct
       structure Weak = Primitive.MLton.Weak
-	 
+         
       type 'a t = 'a Weak.t
 
       val new = Weak.new
 
       fun get (w: 'a t): 'a option =
-	 let
-	    (* Need to do the canGet after the get.  If you did the canGet first,
-	     * there could be a GC that invalidates the pointer between the
-	     * canGet and the get.
-	     *)
-	    val x = Weak.get w
-	 in
-	    if Weak.canGet w
-	       then SOME x
-	    else NONE
-	 end
+         let
+            (* Need to do the canGet after the get.  If you did the canGet first,
+             * there could be a GC that invalidates the pointer between the
+             * canGet and the get.
+             *)
+            val x = Weak.get w
+         in
+            if Weak.canGet w
+               then SOME x
+            else NONE
+         end
    end

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/mlton/word.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/mlton/word.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/mlton/word.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,11 @@
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 type word = Word.word
    
 signature MLTON_WORD =
@@ -3,5 +11,5 @@
    sig
       type t
-	 
+         
       val rol: t * word -> t
       val ror: t * word -> t

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/mlton/world.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/mlton/world.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/mlton/world.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,11 @@
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 signature MLTON_WORLD =
    sig
       val load: string -> 'a

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/mlton/world.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/mlton/world.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/mlton/world.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,7 +1,15 @@
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 structure MLtonWorld: MLTON_WORLD =
    struct
       structure Prim = Primitive.World
-	 
+         
       datatype status = Clone | Original
 
       (* Need to worry about:
@@ -9,52 +17,52 @@
        *   - redetermine buffer status when restart
        *)
       fun save' (file: string): status =
-	 let
-	    val fd =
-	       let
-		  open Posix.FileSys
-		  val flags =
-		     O.flags [O.trunc,
-			      PosixPrimitive.FileSys.O.binary]
-		  val mode =
-		     let
-			open S
-		     in
-			flags [irusr, iwusr, irgrp, iwgrp, iroth, iwoth]
-		     end
-	       in
-		  createf (file, O_WRONLY, flags, mode)
-		  handle e =>
-		     raise Fail (concat ["MLton.World.save unable to open ",
-					 file, " due to ",
-					 General.exnMessage e])
-	       end
-	    val _ = Prim.save (Posix.FileSys.fdToWord fd)
-	 in
-	    if Prim.isOriginal ()
-	       then (Posix.IO.close fd; Original)
-	    else (Prim.makeOriginal ()
-		  ; Cleaner.clean Cleaner.atLoadWorld
-		  ; Clone)
-	 end
+         let
+            val fd =
+               let
+                  open Posix.FileSys
+                  val flags =
+                     O.flags [O.trunc,
+                              PosixPrimitive.FileSys.O.binary]
+                  val mode =
+                     let
+                        open S
+                     in
+                        flags [irusr, iwusr, irgrp, iwgrp, iroth, iwoth]
+                     end
+               in
+                  createf (file, O_WRONLY, flags, mode)
+                  handle e =>
+                     raise Fail (concat ["MLton.World.save unable to open ",
+                                         file, " due to ",
+                                         General.exnMessage e])
+               end
+            val _ = Prim.save (Posix.FileSys.fdToWord fd)
+         in
+            if Prim.isOriginal ()
+               then (Posix.IO.close fd; Original)
+            else (Prim.makeOriginal ()
+                  ; Cleaner.clean Cleaner.atLoadWorld
+                  ; Clone)
+         end
 
       fun saveThread (file: string, t: MLtonThread.Runnable.t): unit =
-	 case save' file of
-	    Clone => MLtonThread.switch (fn _ => t)
-	  | Original => ()
-	 
+         case save' file of
+            Clone => MLtonThread.switch (fn _ => t)
+          | Original => ()
+         
       fun save (file: string): status =
-	 if MLtonThread.amInSignalHandler ()
-	    then raise Fail "cannot call MLton.World.save within signal handler"
-	 else save' file
+         if MLtonThread.amInSignalHandler ()
+            then raise Fail "cannot call MLton.World.save within signal handler"
+         else save' file
 
       fun load (file: string): 'a =
-	 if let open OS_FileSys
-	    in access (file, [A_READ])
-	    end
-	    then 
-	       let val c = CommandLine.name ()
-	       in Posix.Process.exec (c, [c, "@MLton", "load-world", file, "--"])
-	       end
-	 else raise Fail (concat ["World.load can not read ", file])
+         if let open OS_FileSys
+            in access (file, [A_READ])
+            end
+            then 
+               let val c = CommandLine.name ()
+               in Posix.Process.exec (c, [c, "@MLton", "load-world", file, "--"])
+               end
+         else raise Fail (concat ["World.load can not read ", file])
    end

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/mlton.mlb
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/mlton.mlb	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/mlton.mlb	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,7 +1,14 @@
+(* Copyright (C) 2004-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 ann  
    "deadCode true"
-   "sequenceUnit true"
-   "warnMatch true"
+   "sequenceNonUnit warn"
+   "nonexhaustiveMatch warn" "redundantMatch warn"
    "warnUnused true" "forceUsed"
 in
    local
@@ -34,7 +41,7 @@
       signature MLTON_WEAK
       signature MLTON_WORD
       signature MLTON_WORLD
-   
+
       structure MLton
    end
 end

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/net/generic-sock.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/net/generic-sock.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/net/generic-sock.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -3,7 +3,7 @@
       val socket: Socket.AF.addr_family * Socket.SOCK.sock_type -> 
                   ('af, 'sock_type) Socket.sock
       val socketPair: Socket.AF.addr_family * Socket.SOCK.sock_type -> 
-	              ('af, 'sock_type) Socket.sock * ('af, 'sock_type) Socket.sock
+                      ('af, 'sock_type) Socket.sock * ('af, 'sock_type) Socket.sock
       val socket': Socket.AF.addr_family * Socket.SOCK.sock_type * int -> 
                    ('af, 'sock_type) Socket.sock
       val socketPair': Socket.AF.addr_family * Socket.SOCK.sock_type * int -> 

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/net/generic-sock.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/net/generic-sock.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/net/generic-sock.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,10 @@
+(* Copyright (C) 2002-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 structure GenericSock : GENERIC_SOCK =
    struct
       structure Prim = Primitive.Socket.GenericSock
@@ -7,25 +14,25 @@
       fun intToSock i = Socket.wordToSock (SysWord.fromInt i)
 
       fun socket' (af, st, p) =
-	 PESC.syscall
-	 (fn () =>
-	  let val n = Prim.socket (NetHostDB.addrFamilyToInt af, st, p)
-	  in (n, fn () => intToSock n)
-	  end)
+         PESC.syscall
+         (fn () =>
+          let val n = Prim.socket (NetHostDB.addrFamilyToInt af, st, p)
+          in (n, fn () => intToSock n)
+          end)
 
       fun socketPair' (af, st, p) =
-	 let
-	    val s1 = ref 0
-	    val s2 = ref 0
-	 in
-	    PESC.syscall
-	    (fn () =>
-	     let val n = Prim.socketPair (NetHostDB.addrFamilyToInt af, st, p, s1, s2)
-	     in (n, fn () => (intToSock (!s1), intToSock (!s2)))
-	     end)
-	 end
+         let
+            val s1 = ref 0
+            val s2 = ref 0
+         in
+            PESC.syscall
+            (fn () =>
+             let val n = Prim.socketPair (NetHostDB.addrFamilyToInt af, st, p, s1, s2)
+             in (n, fn () => (intToSock (!s1), intToSock (!s2)))
+             end)
+         end
       
       fun socket (af, st) = socket' (af, st, 0)
-	 
+         
       fun socketPair (af, st) = socketPair' (af, st, 0)
    end

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/net/inet-sock.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/net/inet-sock.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/net/inet-sock.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -10,15 +10,15 @@
       val fromAddr: sock_addr -> NetHostDB.in_addr * int
       val any: int -> sock_addr
       structure UDP: 
-	 sig
-	   val socket: unit -> dgram_sock
-	   val socket': int -> dgram_sock
-	 end
+         sig
+           val socket: unit -> dgram_sock
+           val socket': int -> dgram_sock
+         end
       structure TCP: 
-	 sig
-	   val socket: unit -> 'mode stream_sock
-	   val socket': int -> 'mode stream_sock
-	   val getNODELAY: 'mode stream_sock -> bool
-	   val setNODELAY: 'mode stream_sock * bool -> unit
-	 end
+         sig
+           val socket: unit -> 'mode stream_sock
+           val socket': int -> 'mode stream_sock
+           val getNODELAY: 'mode stream_sock -> bool
+           val setNODELAY: 'mode stream_sock * bool -> unit
+         end
    end

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/net/inet-sock.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/net/inet-sock.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/net/inet-sock.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,7 +1,14 @@
+(* Copyright (C) 2002-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 structure INetSock:> INET_SOCK =
    struct
       structure Prim = Primitive.Socket.INetSock
-	 
+         
       datatype inet = INET (* a phantom type*)
       type 'sock_type sock = (inet, 'sock_type) Socket.sock
       type 'mode stream_sock = 'mode Socket.stream sock
@@ -11,49 +18,52 @@
       val inetAF = NetHostDB.intToAddrFamily Primitive.Socket.AF.INET
 
       fun toAddr (in_addr, port) =
-	let
-	  val (sa, salen, finish) = Socket.new_sock_addr ()
-	  val _ = Prim.toAddr (NetHostDB.inAddrToWord8Vector in_addr,
-			       Net.htons port, sa, salen)
-	in
-	  finish ()
-	end
+         if port < 0 orelse port >= 0x10000
+            then PosixError.raiseSys PosixError.inval
+         else
+            let
+               val (sa, salen, finish) = Socket.new_sock_addr ()
+               val _ = Prim.toAddr (NetHostDB.inAddrToWord8Vector in_addr,
+                                    Net.htons port, sa, salen)
+            in
+               finish ()
+            end
 
       fun any port = toAddr (NetHostDB.any (), port)
 
       fun fromAddr sa =
-	let
-	  val _ = Prim.fromAddr (Word8Vector.toPoly (Socket.unpackSockAddr sa))
-	  val port = Net.ntohs (Prim.getPort ())
-	  val (ia, finish) = NetHostDB.new_in_addr ()
-	  val _ = Prim.getInAddr (NetHostDB.preInAddrToWord8Array ia)
-	in
-	  (finish (), port)
-	end
+        let
+          val _ = Prim.fromAddr (Word8Vector.toPoly (Socket.unpackSockAddr sa))
+          val port = Net.ntohs (Prim.getPort ())
+          val (ia, finish) = NetHostDB.new_in_addr ()
+          val _ = Prim.getInAddr (NetHostDB.preInAddrToWord8Array ia)
+        in
+          (finish (), port)
+        end
 
       structure UDP =
-	 struct
-	    fun socket' prot =
-	       GenericSock.socket' (inetAF, Socket.SOCK.dgram, prot)
-	       
-	    fun socket () = socket' 0
-	 end
+         struct
+            fun socket' prot =
+               GenericSock.socket' (inetAF, Socket.SOCK.dgram, prot)
+               
+            fun socket () = socket' 0
+         end
       
       structure TCP =
-	 struct
-	    structure Prim = Prim.TCP
+         struct
+            structure Prim = Prim.TCP
 
-	    fun socket' prot =
-	       GenericSock.socket' (inetAF, Socket.SOCK.stream, prot)
-	       
-	    fun socket () = socket' 0
+            fun socket' prot =
+               GenericSock.socket' (inetAF, Socket.SOCK.stream, prot)
+               
+            fun socket () = socket' 0
 
-	    fun getNODELAY sock =
-	      Socket.CtlExtra.getSockOptBool
-	      (Prim.TCP, Prim.NODELAY) sock
+            fun getNODELAY sock =
+              Socket.CtlExtra.getSockOptBool
+              (Prim.TCP, Prim.NODELAY) sock
 
-	    fun setNODELAY (sock,optval) =
-	      Socket.CtlExtra.setSockOptBool
-	      (Prim.TCP, Prim.NODELAY) (sock,optval)
-	 end
+            fun setNODELAY (sock,optval) =
+              Socket.CtlExtra.setSockOptBool
+              (Prim.TCP, Prim.NODELAY) (sock,optval)
+         end
    end

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/net/net-host-db.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/net/net-host-db.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/net/net-host-db.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -3,7 +3,7 @@
       eqtype addr_family
       type entry
       eqtype in_addr
-	 
+         
       val addr: entry -> in_addr
       val addrType: entry -> addr_family
       val addrs: entry -> in_addr list

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/net/net-host-db.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/net/net-host-db.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/net/net-host-db.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,10 @@
+(* Copyright (C) 2002-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 structure NetHostDB:> NET_HOST_DB_EXTRA =
    struct
       structure Prim = Primitive.NetHostDB
@@ -8,203 +15,203 @@
 
       val preInAddrToWord8Array = fn a => a
       val inAddrToWord8Vector = fn v => v
-	 
+         
       structure PW = PackWord32Big
       fun new_in_addr () =
-	let
-	  val ia: pre_in_addr = Array.array (Prim.inAddrLen, 0wx0: Word8.word)
-	  fun finish () = Array.vector ia
-	in
-	  (ia, finish)
-	end
+        let
+          val ia: pre_in_addr = Array.array (Prim.inAddrLen, 0wx0: Word8.word)
+          fun finish () = Array.vector ia
+        in
+          (ia, finish)
+        end
       fun inAddrToWord (ia: in_addr) =
-	Word.fromLargeWord (PW.subVec (Word8Vector.fromPoly ia, 0))
+        Word.fromLargeWord (PW.subVec (Word8Vector.fromPoly ia, 0))
       fun wordToInAddr w =
-	let
-	  val (ia, finish) = new_in_addr ()
-	  val _ = PW.update (Word8Array.fromPoly ia, 0, Word.toLargeWord w)
-	in
-	  finish ()
-	end
+        let
+          val (ia, finish) = new_in_addr ()
+          val _ = PW.update (Word8Array.fromPoly ia, 0, Word.toLargeWord w)
+        in
+          finish ()
+        end
       fun any () = wordToInAddr (Word.fromInt Prim.INADDR_ANY)
       type addr_family = Prim.addr_family
 
       val intToAddrFamily = fn z => z
       val addrFamilyToInt = fn z => z
-	 
+         
       datatype entry = T of {name: string,
-			     aliases: string list,
-			     addrType: addr_family,
-			     addrs: in_addr list}
+                             aliases: string list,
+                             addrType: addr_family,
+                             addrs: in_addr list}
 
       local
-	fun make s (T r) = s r
+        fun make s (T r) = s r
       in
-	val name = make #name
-	val aliases = make #aliases
-	val addrType = make #addrType
-	val addrs = make #addrs
+        val name = make #name
+        val aliases = make #aliases
+        val addrType = make #addrType
+        val addrs = make #addrs
       end
       fun addr entry = hd (addrs entry)
 
       local
-	fun get (b: bool): entry option =
-	  if b
-	    then let
-		   val name = C.CS.toString (Prim.entryName ())
-		   val numAliases = Prim.entryNumAliases ()
-		   fun fill (n, aliases) =
-		     if n < numAliases
-		       then let
-			      val alias =
-				C.CS.toString (Prim.entryAliasesN n)
-			    in
-			      fill (n + 1, alias::aliases)
-			    end
-		       else List.rev aliases
-		   val aliases = fill (0, [])
-		   val addrType = Prim.entryAddrType ()
-		   val length = Prim.entryLength ()
-		   val numAddrs = Prim.entryNumAddrs ()
-		   fun fill (n, addrs) =
-		     if n < numAddrs
-		       then let
-			      val addr = Word8Array.array (length, 0wx0)
-			      val _ =
-				 Prim.entryAddrsN (n, Word8Array.toPoly addr)
-			      val addr =
-				 Word8Vector.toPoly (Word8Array.vector addr)
-			    in
-			      fill (n + 1, addr::addrs)
-			    end
-		       else List.rev addrs
-		   val addrs = fill (0, [])
-		 in
-		   SOME (T {name = name,
-			    aliases = aliases,
-			    addrType = addrType,
-			    addrs = addrs})
-		 end
-	    else NONE
+        fun get (b: bool): entry option =
+          if b
+            then let
+                   val name = C.CS.toString (Prim.entryName ())
+                   val numAliases = Prim.entryNumAliases ()
+                   fun fill (n, aliases) =
+                     if n < numAliases
+                       then let
+                              val alias =
+                                C.CS.toString (Prim.entryAliasesN n)
+                            in
+                              fill (n + 1, alias::aliases)
+                            end
+                       else List.rev aliases
+                   val aliases = fill (0, [])
+                   val addrType = Prim.entryAddrType ()
+                   val length = Prim.entryLength ()
+                   val numAddrs = Prim.entryNumAddrs ()
+                   fun fill (n, addrs) =
+                     if n < numAddrs
+                       then let
+                              val addr = Word8Array.array (length, 0wx0)
+                              val _ =
+                                 Prim.entryAddrsN (n, Word8Array.toPoly addr)
+                              val addr =
+                                 Word8Vector.toPoly (Word8Array.vector addr)
+                            in
+                              fill (n + 1, addr::addrs)
+                            end
+                       else List.rev addrs
+                   val addrs = fill (0, [])
+                 in
+                   SOME (T {name = name,
+                            aliases = aliases,
+                            addrType = addrType,
+                            addrs = addrs})
+                 end
+            else NONE
       in
-	fun getByAddr in_addr = 
-	   get (Prim.getByAddress (in_addr, Vector.length in_addr))
-	fun getByName name = 
-	   get (Prim.getByName (NullString.nullTerm name))
+        fun getByAddr in_addr = 
+           get (Prim.getByAddress (in_addr, Vector.length in_addr))
+        fun getByName name = 
+           get (Prim.getByName (NullString.nullTerm name))
       end
 
       fun getHostName () = 
-	let
-	  val n = 128
-	  val buf = CharArray.array (n, #"\000")
-	  val () =
-	     Posix.Error.SysCall.simple
-	     (fn () => Prim.getHostName (CharArray.toPoly buf, n))
-	in
-	  case CharArray.findi (fn (_, c) => c = #"\000") buf of
-	     NONE => CharArray.vector buf
-	   | SOME (i, _) =>
-		CharArraySlice.vector (CharArraySlice.slice (buf, 0, SOME i))
-	end
+        let
+          val n = 128
+          val buf = CharArray.array (n, #"\000")
+          val () =
+             Posix.Error.SysCall.simple
+             (fn () => Prim.getHostName (CharArray.toPoly buf, n))
+        in
+          case CharArray.findi (fn (_, c) => c = #"\000") buf of
+             NONE => CharArray.vector buf
+           | SOME (i, _) =>
+                CharArraySlice.vector (CharArraySlice.slice (buf, 0, SOME i))
+        end
 
       fun scan reader state =
-	let
-	  fun scanW state =
-	    case reader state of
-	      SOME (#"0", state') => 
-		(case reader state' of
-		    NONE => SOME (0w0, state')
-		  | SOME (c, state'') =>
-		     if Char.isDigit c
-			then StringCvt.wdigits StringCvt.OCT reader state'
-		     else if c = #"x" orelse c = #"X"
-			then StringCvt.wdigits StringCvt.HEX reader state''
-		     else SOME (0w0, state'))
-	    | _ => StringCvt.wdigits StringCvt.DEC reader state
-	  fun loop (n, state, acc) =
-	    if n <= 0
-	      then List.rev acc
-	      else let
-		     fun finish (w, state) =
-		       case reader state of
-			 SOME (#".", state') => 
-			   loop (n - 1, state', (w, state)::acc)
-		       | _ => List.rev ((w, state)::acc)
-		   in
-		     case scanW state of
-		       SOME (w, state') => finish (w, state')
-		     | NONE => List.rev acc
-		   end
-	  val l = loop (4, state, [])
-	  fun get1 w = 
-	    (Word8.fromLarge (Word32.toLarge (Word32.andb (w, 0wxFF))),
-	     Word32.>>(w, 0w8))
-	  fun get2 w =
-	    let 
-	      val (a,w) = get1 w
-	      val (b,w) = get1 w
-	    in (a,b,w) 
-	    end
-	  fun get3 w =
-	    let
-	      val (a,b,w) = get2 w
-	      val (c,w) = get1 w
-	    in (a,b,c,w)
-	    end
-	  fun get4 w =
-	    let
-	      val (a,b,c,w) = get3 w
-	      val (d,w) = get1 w
-	    in (a,b,c,d,w)
-	    end
-	  fun try l =
-	    case l of 
-	      [] => NONE
-	    | [(w, statew)] => 
-		let
-		  val (d,c,b,a,w) = get4 w
-		in
-		  if w = 0wx0
-		    then SOME (Vector.fromList [a,b,c,d], statew)
-		    else NONE
-		end
-	    | [(x, statex), (w, statew)] => 
-		let
-		  val (d,c,b,w) = get3 w
-		  val (a,x) = get1 x
-		in
-		  if w = 0wx0 andalso x = 0wx0
-		    then SOME (Vector.fromList [a,b,c,d], statew)
-		    else try [(x, statex)]
-		end
-	    | [(y, statey), (x, statex), (w, statew)] => 
-		let
-		  val (d,c,w) = get2 w
-		  val (b,x) = get1 x
-		  val (a,y) = get1 y
-		in
-		  if w = 0wx0 andalso x = 0wx0 andalso y = 0wx0
-		    then SOME (Vector.fromList [a,b,c,d], statew)
-		    else try [(y, statey), (x, statex)]
-		end
-	    | [(z, statez), (y, statey), (x, statex), (w, statew)] => 
-		let
-		  val (d,w) = get1 w
-		  val (c,x) = get1 x
-		  val (b,y) = get1 y
-		  val (a,z) = get1 z
-		in
-		  if w = 0wx0 andalso x = 0wx0 andalso y = 0wx0 andalso z = 0wx0
-		    then SOME (Vector.fromList [a,b,c,d], statew)
-		    else try [(z, statez), (y, statey), (x, statex)]
-		end
-	    | _ => NONE
-	in
-	  try l
-	end
+        let
+          fun scanW state =
+            case reader state of
+              SOME (#"0", state') => 
+                (case reader state' of
+                    NONE => SOME (0w0, state')
+                  | SOME (c, state'') =>
+                     if Char.isDigit c
+                        then StringCvt.wdigits StringCvt.OCT reader state'
+                     else if c = #"x" orelse c = #"X"
+                        then StringCvt.wdigits StringCvt.HEX reader state''
+                     else SOME (0w0, state'))
+            | _ => StringCvt.wdigits StringCvt.DEC reader state
+          fun loop (n, state, acc) =
+            if n <= 0
+              then List.rev acc
+              else let
+                     fun finish (w, state) =
+                       case reader state of
+                         SOME (#".", state') => 
+                           loop (n - 1, state', (w, state)::acc)
+                       | _ => List.rev ((w, state)::acc)
+                   in
+                     case scanW state of
+                       SOME (w, state') => finish (w, state')
+                     | NONE => List.rev acc
+                   end
+          val l = loop (4, state, [])
+          fun get1 w = 
+            (Word8.fromLarge (Word32.toLarge (Word32.andb (w, 0wxFF))),
+             Word32.>>(w, 0w8))
+          fun get2 w =
+            let 
+              val (a,w) = get1 w
+              val (b,w) = get1 w
+            in (a,b,w) 
+            end
+          fun get3 w =
+            let
+              val (a,b,w) = get2 w
+              val (c,w) = get1 w
+            in (a,b,c,w)
+            end
+          fun get4 w =
+            let
+              val (a,b,c,w) = get3 w
+              val (d,w) = get1 w
+            in (a,b,c,d,w)
+            end
+          fun try l =
+            case l of 
+              [] => NONE
+            | [(w, statew)] => 
+                let
+                  val (d,c,b,a,w) = get4 w
+                in
+                  if w = 0wx0
+                    then SOME (Vector.fromList [a,b,c,d], statew)
+                    else NONE
+                end
+            | [(x, statex), (w, statew)] => 
+                let
+                  val (d,c,b,w) = get3 w
+                  val (a,x) = get1 x
+                in
+                  if w = 0wx0 andalso x = 0wx0
+                    then SOME (Vector.fromList [a,b,c,d], statew)
+                    else try [(x, statex)]
+                end
+            | [(y, statey), (x, statex), (w, statew)] => 
+                let
+                  val (d,c,w) = get2 w
+                  val (b,x) = get1 x
+                  val (a,y) = get1 y
+                in
+                  if w = 0wx0 andalso x = 0wx0 andalso y = 0wx0
+                    then SOME (Vector.fromList [a,b,c,d], statew)
+                    else try [(y, statey), (x, statex)]
+                end
+            | [(z, statez), (y, statey), (x, statex), (w, statew)] => 
+                let
+                  val (d,w) = get1 w
+                  val (c,x) = get1 x
+                  val (b,y) = get1 y
+                  val (a,z) = get1 z
+                in
+                  if w = 0wx0 andalso x = 0wx0 andalso y = 0wx0 andalso z = 0wx0
+                    then SOME (Vector.fromList [a,b,c,d], statew)
+                    else try [(z, statez), (y, statey), (x, statex)]
+                end
+            | _ => NONE
+        in
+          try l
+        end
 
       fun fromString s = StringCvt.scanString scan s
       fun toString in_addr =
-	String.concatWith "." 
-	(Vector.foldr (fn (w,ss) => (Word8.fmt StringCvt.DEC w)::ss) [] in_addr)
+        String.concatWith "." 
+        (Vector.foldr (fn (w,ss) => (Word8.fmt StringCvt.DEC w)::ss) [] in_addr)
    end

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/net/net-prot-db.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/net/net-prot-db.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/net/net-prot-db.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,10 @@
+(* Copyright (C) 2002-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 structure NetProtDB: NET_PROT_DB =
    struct
       structure Prim = Primitive.NetProtDB
@@ -3,43 +10,43 @@
 
       datatype entry = T of {name: string,
-			     aliases: string list,
-			     protocol: int}
+                             aliases: string list,
+                             protocol: int}
 
       local
-	fun make s (T r) = s r
+        fun make s (T r) = s r
       in
-	val name = make #name
-	val aliases = make #aliases
-	val protocol = make #protocol
+        val name = make #name
+        val aliases = make #aliases
+        val protocol = make #protocol
       end
 
       local
-	fun get (b: bool): entry option =
-	  if b
-	    then let
-		   val name = C.CS.toString (Prim.entryName ())
-		   val numAliases = Prim.entryNumAliases ()
-		   fun fill (n, aliases) =
-		     if n < numAliases
-		       then let
-			      val alias =
-				C.CS.toString (Prim.entryAliasesN n)
-			    in
-			      fill (n + 1, alias::aliases)
-			    end
-		       else List.rev aliases
-		   val aliases = fill (0, [])
-		   val protocol = Prim.entryProtocol ()
-		 in
-		   SOME (T {name = name,
-			    aliases = aliases,
-			    protocol = protocol})
-		 end
-	    else NONE
+        fun get (b: bool): entry option =
+          if b
+            then let
+                   val name = C.CS.toString (Prim.entryName ())
+                   val numAliases = Prim.entryNumAliases ()
+                   fun fill (n, aliases) =
+                     if n < numAliases
+                       then let
+                              val alias =
+                                C.CS.toString (Prim.entryAliasesN n)
+                            in
+                              fill (n + 1, alias::aliases)
+                            end
+                       else List.rev aliases
+                   val aliases = fill (0, [])
+                   val protocol = Prim.entryProtocol ()
+                 in
+                   SOME (T {name = name,
+                            aliases = aliases,
+                            protocol = protocol})
+                 end
+            else NONE
       in
-	fun getByName name = 
-	  get (Prim.getByName (NullString.nullTerm name))
-	fun getByNumber proto = 
-	  get (Prim.getByNumber proto)
+        fun getByName name = 
+          get (Prim.getByName (NullString.nullTerm name))
+        fun getByNumber proto = 
+          get (Prim.getByNumber proto)
       end
    end

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/net/net-serv-db.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/net/net-serv-db.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/net/net-serv-db.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,10 @@
+(* Copyright (C) 2002-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 structure NetServDB: NET_SERV_DB =
    struct
       structure Prim = Primitive.NetServDB
@@ -3,57 +10,57 @@
 
       datatype entry = T of {name: string,
-			     aliases: string list,
-			     port: int,
-			     protocol: string}
+                             aliases: string list,
+                             port: int,
+                             protocol: string}
 
       local
-	fun make s (T r) = s r
+        fun make s (T r) = s r
       in
-	val name = make #name
-	val aliases = make #aliases
-	val port = make #port
-	val protocol = make #protocol
+        val name = make #name
+        val aliases = make #aliases
+        val port = make #port
+        val protocol = make #protocol
       end
 
       local
-	fun get (b: bool): entry option =
-	  if b
-	    then let
-		   val name = C.CS.toString (Prim.entryName ())
-		   val numAliases = Prim.entryNumAliases ()
-		   fun fill (n, aliases) =
-		     if n < numAliases
-		       then let
-			      val alias =
-				C.CS.toString (Prim.entryAliasesN n)
-			    in
-			      fill (n + 1, alias::aliases)
-			    end
-		       else List.rev aliases
-		   val aliases = fill (0, [])
-		   val port = Net.ntohs (Prim.entryPort ())
-		   val protocol = C.CS.toString (Prim.entryProtocol ())
-		 in
-		   SOME (T {name = name,
-			    aliases = aliases,
-			    port = port,
-			    protocol = protocol})
-		 end
-	    else NONE
+        fun get (b: bool): entry option =
+          if b
+            then let
+                   val name = C.CS.toString (Prim.entryName ())
+                   val numAliases = Prim.entryNumAliases ()
+                   fun fill (n, aliases) =
+                     if n < numAliases
+                       then let
+                              val alias =
+                                C.CS.toString (Prim.entryAliasesN n)
+                            in
+                              fill (n + 1, alias::aliases)
+                            end
+                       else List.rev aliases
+                   val aliases = fill (0, [])
+                   val port = Net.ntohs (Prim.entryPort ())
+                   val protocol = C.CS.toString (Prim.entryProtocol ())
+                 in
+                   SOME (T {name = name,
+                            aliases = aliases,
+                            port = port,
+                            protocol = protocol})
+                 end
+            else NONE
       in
-	fun getByName (name, proto) = 
-	  case proto of
-	    SOME proto => get (Prim.getByName (NullString.nullTerm name,
-					       NullString.nullTerm proto))
-	  | NONE => get (Prim.getByNameNull (NullString.nullTerm name))
-	fun getByPort (port, proto) = 
-	  let
-	    val port = Net.htons port
-	  in
-	    case proto of
-	       NONE => get (Prim.getByPortNull port)
-	     | SOME proto =>
-		  get (Prim.getByPort (port, NullString.nullTerm proto))
-	  end
+        fun getByName (name, proto) = 
+          case proto of
+            SOME proto => get (Prim.getByName (NullString.nullTerm name,
+                                               NullString.nullTerm proto))
+          | NONE => get (Prim.getByNameNull (NullString.nullTerm name))
+        fun getByPort (port, proto) = 
+          let
+            val port = Net.htons port
+          in
+            case proto of
+               NONE => get (Prim.getByPortNull port)
+             | SOME proto =>
+                  get (Prim.getByPort (port, NullString.nullTerm proto))
+          end
       end
    end

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/net/net.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/net/net.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/net/net.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,10 @@
+(* Copyright (C) 2002-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 structure Net : NET =
    struct
       structure Prim = Primitive.Net

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/net/socket.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/net/socket.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/net/socket.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -6,7 +6,7 @@
       type out_flags = {don't_route: bool, oob: bool}
       type passive
       datatype shutdown_mode =
-	 NO_RECVS
+         NO_RECVS
        | NO_SENDS
        | NO_RECVS_OR_SENDS
       type ('af,'sock_type) sock
@@ -15,57 +15,57 @@
       type 'mode stream
 
       structure AF:
-	 sig
-	    type addr_family = NetHostDB.addr_family
+         sig
+            type addr_family = NetHostDB.addr_family
 
-	    val fromString: string -> addr_family option
-	    val list: unit -> (string * addr_family) list
-	    val toString: addr_family -> string
-	 end
+            val fromString: string -> addr_family option
+            val list: unit -> (string * addr_family) list
+            val toString: addr_family -> string
+         end
 
       structure SOCK:
-	 sig
-	    eqtype sock_type
+         sig
+            eqtype sock_type
 
-	    val dgram: sock_type
-	    val fromString: string -> sock_type option
-	    val list: unit -> (string * sock_type) list
-	    val stream: sock_type
-	    val toString: sock_type -> string
-	 end
+            val dgram: sock_type
+            val fromString: string -> sock_type option
+            val list: unit -> (string * sock_type) list
+            val stream: sock_type
+            val toString: sock_type -> string
+         end
 
       structure Ctl:
-	 sig
-	    val getATMARK: ('af, active stream) sock -> bool
-	    val getBROADCAST: ('af, 'sock_type) sock -> bool
-	    val getDEBUG: ('af, 'sock_type) sock -> bool
-	    val getDONTROUTE: ('af, 'sock_type) sock -> bool
-	    val getERROR: ('af, 'sock_type) sock -> bool
-	    val getKEEPALIVE: ('af, 'sock_type) sock -> bool
-	    val getLINGER: ('af, 'sock_type) sock -> Time.time option
-	    val getNREAD: ('af, 'sock_type) sock -> int
-	    val getOOBINLINE: ('af, 'sock_type) sock -> bool
-	    val getPeerName: ('af, 'sock_type) sock -> 'af sock_addr
-	    val getRCVBUF: ('af, 'sock_type) sock -> int
-	    val getREUSEADDR: ('af, 'sock_type) sock -> bool
-	    val getSNDBUF: ('af, 'sock_type) sock -> int
-	    val getSockName: ('af, 'sock_type) sock -> 'af sock_addr
-	    val getTYPE: ('af, 'sock_type) sock -> SOCK.sock_type
-	    val setBROADCAST: ('af, 'sock_type) sock * bool -> unit
-	    val setDEBUG: ('af, 'sock_type) sock * bool -> unit
-	    val setDONTROUTE: ('af, 'sock_type) sock * bool -> unit
-	    val setKEEPALIVE: ('af, 'sock_type) sock * bool -> unit
-	    val setLINGER: ('af, 'sock_type) sock * Time.time option -> unit
-	    val setOOBINLINE: ('af, 'sock_type) sock * bool -> unit
-	    val setRCVBUF: ('af, 'sock_type) sock * int -> unit
-	    val setREUSEADDR: ('af, 'sock_type) sock * bool -> unit
-	    val setSNDBUF: ('af, 'sock_type) sock * int -> unit
-	 end
+         sig
+            val getATMARK: ('af, active stream) sock -> bool
+            val getBROADCAST: ('af, 'sock_type) sock -> bool
+            val getDEBUG: ('af, 'sock_type) sock -> bool
+            val getDONTROUTE: ('af, 'sock_type) sock -> bool
+            val getERROR: ('af, 'sock_type) sock -> bool
+            val getKEEPALIVE: ('af, 'sock_type) sock -> bool
+            val getLINGER: ('af, 'sock_type) sock -> Time.time option
+            val getNREAD: ('af, 'sock_type) sock -> int
+            val getOOBINLINE: ('af, 'sock_type) sock -> bool
+            val getPeerName: ('af, 'sock_type) sock -> 'af sock_addr
+            val getRCVBUF: ('af, 'sock_type) sock -> int
+            val getREUSEADDR: ('af, 'sock_type) sock -> bool
+            val getSNDBUF: ('af, 'sock_type) sock -> int
+            val getSockName: ('af, 'sock_type) sock -> 'af sock_addr
+            val getTYPE: ('af, 'sock_type) sock -> SOCK.sock_type
+            val setBROADCAST: ('af, 'sock_type) sock * bool -> unit
+            val setDEBUG: ('af, 'sock_type) sock * bool -> unit
+            val setDONTROUTE: ('af, 'sock_type) sock * bool -> unit
+            val setKEEPALIVE: ('af, 'sock_type) sock * bool -> unit
+            val setLINGER: ('af, 'sock_type) sock * Time.time option -> unit
+            val setOOBINLINE: ('af, 'sock_type) sock * bool -> unit
+            val setRCVBUF: ('af, 'sock_type) sock * int -> unit
+            val setREUSEADDR: ('af, 'sock_type) sock * bool -> unit
+            val setSNDBUF: ('af, 'sock_type) sock * int -> unit
+         end
 
       val accept: ('af, passive stream) sock -> (('af, active stream) sock
-						 * 'af sock_addr)
+                                                 * 'af sock_addr)
       val acceptNB: ('af, passive stream) sock -> (('af, active stream) sock
-						   * 'af sock_addr) option
+                                                   * 'af sock_addr) option
       val bind: ('af, 'sock_type) sock * 'af sock_addr -> unit
       val close: ('af, 'sock_type) sock -> unit
       val connect: ('af, 'sock_type) sock * 'af sock_addr -> unit
@@ -75,89 +75,89 @@
       val listen: ('af, passive stream) sock * int -> unit
       val recvArr: ('af, active stream) sock * Word8ArraySlice.slice -> int
       val recvArr': (('af, active stream) sock
-		     * Word8ArraySlice.slice
-		     * in_flags) -> int
+                     * Word8ArraySlice.slice
+                     * in_flags) -> int
       val recvArrFrom: (('af, dgram) sock * Word8ArraySlice.slice
-			-> int * 'af sock_addr)
+                        -> int * 'af sock_addr)
       val recvArrFrom': (('af, dgram) sock * Word8ArraySlice.slice * in_flags
-			 -> int * 'af sock_addr)
+                         -> int * 'af sock_addr)
       val recvArrFromNB: (('af, dgram) sock * Word8ArraySlice.slice
-			  -> (int * 'af sock_addr) option)
+                          -> (int * 'af sock_addr) option)
       val recvArrFromNB': (('af, dgram) sock * Word8ArraySlice.slice * in_flags
-			   -> (int * 'af sock_addr) option)
+                           -> (int * 'af sock_addr) option)
       val recvArrNB: (('af, active stream) sock
-		      * Word8ArraySlice.slice) -> int option
+                      * Word8ArraySlice.slice) -> int option
       val recvArrNB': (('af, active stream) sock
-		       * Word8ArraySlice.slice
-		       * in_flags) -> int option
+                       * Word8ArraySlice.slice
+                       * in_flags) -> int option
       val recvVec: ('af, active stream) sock * int -> Word8Vector.vector
       val recvVec': (('af, active stream) sock * int * in_flags
-		     -> Word8Vector.vector)
+                     -> Word8Vector.vector)
       val recvVecFrom: (('af, dgram) sock * int
-			-> Word8Vector.vector * 'sock_type sock_addr)
+                        -> Word8Vector.vector * 'af sock_addr)
       val recvVecFrom': (('af, dgram) sock * int * in_flags
-			 -> Word8Vector.vector * 'sock_type sock_addr)
+                         -> Word8Vector.vector * 'af sock_addr)
       val recvVecFromNB: (('af, dgram) sock * int
-			  -> (Word8Vector.vector * 'sock_type sock_addr) option)
+                          -> (Word8Vector.vector * 'af sock_addr) option)
       val recvVecFromNB': (('af, dgram) sock * int * in_flags
-			   -> (Word8Vector.vector * 'sock_type sock_addr) option)
+                           -> (Word8Vector.vector * 'af sock_addr) option)
       val recvVecNB: ('af, active stream) sock * int -> Word8Vector.vector option
       val recvVecNB': (('af, active stream) sock * int * in_flags
-		       -> Word8Vector.vector option)
+                       -> Word8Vector.vector option)
       val sameAddr: 'af sock_addr * 'af sock_addr -> bool
       val sameDesc: sock_desc * sock_desc -> bool
       val select: {exs: sock_desc list,
-		   rds: sock_desc list,
-		   timeout: Time.time option,
-		   wrs: sock_desc list} -> {exs: sock_desc list,
-					    rds: sock_desc list,
-					    wrs: sock_desc list}
+                   rds: sock_desc list,
+                   timeout: Time.time option,
+                   wrs: sock_desc list} -> {exs: sock_desc list,
+                                            rds: sock_desc list,
+                                            wrs: sock_desc list}
       val sendArr: ('af, active stream) sock * Word8ArraySlice.slice -> int
       val sendArr': (('af, active stream) sock
-		     * Word8ArraySlice.slice
-		     * out_flags) -> int
+                     * Word8ArraySlice.slice
+                     * out_flags) -> int
       val sendArrNB: (('af, active stream) sock * Word8ArraySlice.slice
-		      -> int option)
+                      -> int option)
       val sendArrNB': (('af, active stream) sock
-		       * Word8ArraySlice.slice
-		       * out_flags) -> int option
+                       * Word8ArraySlice.slice
+                       * out_flags) -> int option
       val sendArrTo: (('af, dgram) sock
-		      * 'af sock_addr
-		      * Word8ArraySlice.slice) -> unit
+                      * 'af sock_addr
+                      * Word8ArraySlice.slice) -> unit
       val sendArrTo': (('af, dgram) sock
-		       * 'af sock_addr
-		       * Word8ArraySlice.slice
-		       * out_flags) -> unit
+                       * 'af sock_addr
+                       * Word8ArraySlice.slice
+                       * out_flags) -> unit
       val sendArrToNB: (('af, dgram) sock
-			* 'af sock_addr
-			* Word8ArraySlice.slice) -> bool
+                        * 'af sock_addr
+                        * Word8ArraySlice.slice) -> bool
       val sendArrToNB': (('af, dgram) sock
-			 * 'af sock_addr
-			 * Word8ArraySlice.slice
-			 * out_flags) -> bool
+                         * 'af sock_addr
+                         * Word8ArraySlice.slice
+                         * out_flags) -> bool
       val sendVec: ('af, active stream) sock * Word8VectorSlice.slice -> int
       val sendVec': (('af, active stream) sock
-		     * Word8VectorSlice.slice
-		     * out_flags) -> int
+                     * Word8VectorSlice.slice
+                     * out_flags) -> int
       val sendVecNB: (('af, active stream) sock
-		      * Word8VectorSlice.slice) -> int option
+                      * Word8VectorSlice.slice) -> int option
       val sendVecNB': (('af, active stream) sock
-		       * Word8VectorSlice.slice
-		       * out_flags) -> int option
+                       * Word8VectorSlice.slice
+                       * out_flags) -> int option
       val sendVecTo: (('af, dgram) sock
-		      * 'af sock_addr
-		      * Word8VectorSlice.slice) -> unit
+                      * 'af sock_addr
+                      * Word8VectorSlice.slice) -> unit
       val sendVecTo': (('af, dgram) sock
-		       * 'af sock_addr
-		       * Word8VectorSlice.slice
-		       * out_flags) -> unit
+                       * 'af sock_addr
+                       * Word8VectorSlice.slice
+                       * out_flags) -> unit
       val sendVecToNB: (('af, dgram) sock
-			* 'af sock_addr
-			* Word8VectorSlice.slice) -> bool
+                        * 'af sock_addr
+                        * Word8VectorSlice.slice) -> bool
       val sendVecToNB': (('af, dgram) sock
-			 * 'af sock_addr
-			 * Word8VectorSlice.slice
-			 * out_flags) -> bool
+                         * 'af sock_addr
+                         * Word8VectorSlice.slice
+                         * out_flags) -> bool
       val shutdown: ('af, 'mode stream) sock * shutdown_mode -> unit
       val sockDesc: ('af, 'sock_type) sock -> sock_desc
    end
@@ -175,26 +175,29 @@
 
     structure CtlExtra:
        sig
-	  type level = int
-	  type optname = int
-	  type request = int
+          type level = int
+          type optname = int
+          type request = int
 
-(*	  val getSockOptWord: level * optname -> ('af, 'sock_type) sock -> word *)
-(* 	  val setSockOptWord:
- * 	     level * optname -> ('af, 'sock_type) sock * word -> unit
+(*        val getSockOptWord: level * optname -> ('af, 'sock_type) sock -> word *)
+(*        val setSockOptWord:
+ *           level * optname -> ('af, 'sock_type) sock * word -> unit
  *)
-	  val getSockOptInt: level * optname -> ('af, 'sock_type) sock -> int
-	  val setSockOptInt:
-	     level * optname -> ('af, 'sock_type) sock * int -> unit
-	  val getSockOptBool: level * optname -> ('af, 'sock_type) sock -> bool
-	  val setSockOptBool:
-	     level * optname -> ('af, 'sock_type) sock * bool -> unit
+          val getERROR:
+             ('af, 'sock_type) sock
+             -> (string * Posix.Error.syserror option) option
+          val getSockOptInt: level * optname -> ('af, 'sock_type) sock -> int
+          val setSockOptInt:
+             level * optname -> ('af, 'sock_type) sock * int -> unit
+          val getSockOptBool: level * optname -> ('af, 'sock_type) sock -> bool
+          val setSockOptBool:
+             level * optname -> ('af, 'sock_type) sock * bool -> unit
 
-(*	  val getIOCtlWord: request -> ('af, 'sock_type) sock -> word *)
-(*	  val setIOCtlWord: request -> ('af, 'sock_type) sock * word -> unit *)
-	  val getIOCtlInt: request -> ('af, 'sock_type) sock -> int
-(*	  val setIOCtlInt: request -> ('af, 'sock_type) sock * int -> unit *)
-	  val getIOCtlBool: request -> ('af, 'sock_type) sock -> bool
-(*	  val setIOCtlBool: request -> ('af, 'sock_type) sock * bool -> unit *)
+(*        val getIOCtlWord: request -> ('af, 'sock_type) sock -> word *)
+(*        val setIOCtlWord: request -> ('af, 'sock_type) sock * word -> unit *)
+          val getIOCtlInt: request -> ('af, 'sock_type) sock -> int
+(*        val setIOCtlInt: request -> ('af, 'sock_type) sock * int -> unit *)
+          val getIOCtlBool: request -> ('af, 'sock_type) sock -> bool
+(*        val setIOCtlBool: request -> ('af, 'sock_type) sock * bool -> unit *)
        end
   end

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/net/socket.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/net/socket.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/net/socket.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,10 @@
+(* Copyright (C) 2002-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 structure Socket:> SOCKET_EXTRA
    where type SOCK.sock_type = Primitive.Socket.SOCK.sock_type
    where type pre_sock_addr = Word8.word array
@@ -9,9 +16,9 @@
 structure Syscall = Error.SysCall
 structure FileSys = Posix.FileSys
 
-datatype sock = S of Prim.sock
-fun sockToWord (S s) = SysWord.fromInt s
-fun wordToSock s = S (SysWord.toInt s)
+type sock = Prim.sock
+val sockToWord = SysWord.fromInt o Prim.toInt
+val wordToSock = Prim.fromInt o SysWord.toInt
 fun sockToFD sock = FileSys.wordToFD (sockToWord sock)
 fun fdToSock fd = wordToSock (FileSys.fdToWord fd)
 
@@ -23,7 +30,7 @@
       val sa = Array.array (Prim.sockAddrLenMax, 0wx0)
       val salen = ref (Array.length sa)
       fun finish () =
-	 SA (ArraySlice.vector (ArraySlice.slice (sa, 0, SOME (!salen))))
+         SA (ArraySlice.vector (ArraySlice.slice (sa, 0, SOME (!salen))))
    in
       (sa, salen, finish)
    end
@@ -37,20 +44,20 @@
       type addr_family = NetHostDB.addr_family
       val i2a = NetHostDB.intToAddrFamily
       val names = [
-		   ("UNIX", i2a Prim.AF.UNIX),
-		   ("INET", i2a Prim.AF.INET),
-		   ("INET6", i2a Prim.AF.INET6),
-		   ("UNSPEC", i2a Prim.AF.UNSPEC)
-		   ]
+                   ("UNIX", i2a Prim.AF.UNIX),
+                   ("INET", i2a Prim.AF.INET),
+                   ("INET6", i2a Prim.AF.INET6),
+                   ("UNSPEC", i2a Prim.AF.UNSPEC)
+                   ]
       fun list () = names
       fun toString af' =
-	 case List.find (fn (_, af) => af = af') names of
-	    SOME (name, _) => name
-	  | NONE => raise (Fail "Internal error: bogus addr_family")
+         case List.find (fn (_, af) => af = af') names of
+            SOME (name, _) => name
+          | NONE => raise (Fail "Internal error: bogus addr_family")
       fun fromString name' =
-	 case List.find (fn (name, _) => name = name') names of
-	    SOME (_, af) => SOME af
-	  | NONE => NONE
+         case List.find (fn (name, _) => name = name') names of
+            SOME (_, af) => SOME af
+          | NONE => NONE
    end
 
 structure SOCK =
@@ -59,18 +66,18 @@
       val stream = Prim.SOCK.STREAM
       val dgram = Prim.SOCK.DGRAM
       val names = [
-		   ("STREAM", stream),
-		   ("DGRAM", dgram)
-		   ]
+                   ("STREAM", stream),
+                   ("DGRAM", dgram)
+                   ]
       fun list () = names
       fun toString st' =
-	 case List.find (fn (_, st) => st = st') names of
-	    SOME (name, _) => name
-	  | NONE => raise (Fail "Internal error: bogus sock_type")
+         case List.find (fn (_, st) => st = st') names of
+            SOME (name, _) => name
+          | NONE => raise (Fail "Internal error: bogus sock_type")
       fun fromString name' =
-	 case List.find (fn (name, _) => name = name') names of
-	    SOME (_, st) => SOME st
-	  | NONE => NONE
+         case List.find (fn (name, _) => name = name') names of
+            SOME (_, st) => SOME st
+          | NONE => NONE
    end
 
 structure CtlExtra =
@@ -78,116 +85,112 @@
       type level = Prim.Ctl.level
       type optname = Prim.Ctl.optname
       type request = Prim.Ctl.request
-      (* host byte order (LSB) *)
-      structure PW = PackWord32Little
+      
+      (* host byte order *)
+      structure PW = PackWord32Host
 
       val wordLen = PW.bytesPerElem
       fun unmarshalWord (wa, _, s): word = 
-	 Word.fromLargeWord (PW.subArr (wa, s))
+         Word.fromLargeWord (PW.subArr (wa, s))
       val intLen: int = wordLen
       fun unmarshalInt (wa, l, s): int = 
-	 Word.toIntX (unmarshalWord (wa, l, s))
+         Word.toIntX (unmarshalWord (wa, l, s))
       val boolLen: int = intLen
       fun unmarshalBool (wa, l, s): bool = 
-	 if (unmarshalInt (wa, l, s)) = 0 then false else true
+         if (unmarshalInt (wa, l, s)) = 0 then false else true
       val timeOptLen: int = boolLen + intLen
       fun unmarshalTimeOpt (wa, l, s): Time.time option =
-	 if unmarshalBool (wa, l, s)
-	    then SOME (Time.fromSeconds
-		       (LargeInt.fromInt
-			(unmarshalInt (wa, l, s + 1))))
-	 else NONE
+         if unmarshalBool (wa, l, s)
+            then SOME (Time.fromSeconds
+                       (LargeInt.fromInt
+                        (unmarshalInt (wa, l, s + 1))))
+         else NONE
 
       fun marshalWord (w, wa, s) =
-	 PW.update (wa, s, Word.toLargeWord w)
+         PW.update (wa, s, Word.toLargeWord w)
 
       fun marshalInt (i, wa, s) =
-	 marshalWord (Word.fromInt i, wa, s)
+         marshalWord (Word.fromInt i, wa, s)
 
       fun marshalBool (b, wa, s) =
-	 marshalInt (if b then 1 else 0, wa, s)
+         marshalInt (if b then 1 else 0, wa, s)
 
       fun marshalTimeOpt (t, wa, s) =
-	 case t of
-	    NONE => (marshalBool (false, wa, s)
-		     ; marshalInt (0, wa, s + 1))
-	  | SOME t =>
-	       (marshalBool (true, wa, s)
-		; marshalWord (Word.fromLargeInt (Time.toSeconds t)
-			       handle Overflow => Error.raiseSys Error.inval,
-			       wa, s + 1))
+         case t of
+            NONE => (marshalBool (false, wa, s)
+                     ; marshalInt (0, wa, s + 1))
+          | SOME t =>
+               (marshalBool (true, wa, s)
+                ; marshalWord (Word.fromLargeInt (Time.toSeconds t)
+                               handle Overflow => Error.raiseSys Error.inval,
+                               wa, s + 1))
 
       local
-	 fun make (optlen: int,
-		   write: 'a * Word8Array.array * int -> unit,
-		   unmarshal: Word8Array.array * int * int -> 'a) =
-	    let
-	       fun marshal (x: 'a): Word8Vector.vector =
-		  let
-		     val wa = Word8Array.array (optlen, 0wx0)
-		  in
-		     write (x, wa, 0)
-		     ; Word8Array.vector wa
-		  end
-	       fun getSockOpt (level: level, optname: optname) (S s) =
-		  let
-		     val optval = Word8Array.array (optlen, 0wx0)
-		     val optlen = ref optlen
-		  in
-		     Syscall.simple
-		     (fn () =>
-		      Prim.Ctl.getSockOpt (s, level, optname,
-					   Word8Array.toPoly optval,
-					   optlen))
-		     ; unmarshal (optval, !optlen, 0)
-		  end
-	       fun setSockOpt (level: level, optname: optname) (S s, optval) =
-		  let
-		     val optval = marshal optval
-		     val optlen = Word8Vector.length optval
-		  in
-		     Syscall.simple
-		     (fn () => 
-		      Prim.Ctl.setSockOpt (s, level, optname,
-					   Word8Vector.toPoly optval,
-					   optlen))
-		  end
-	       fun getIOCtl (request: request) (S s): 'a =
-		  let
-		     val optval = Word8Array.array (optlen, 0wx0)
-		  in
-		     Syscall.simple
-		     (fn () =>
-		      Prim.Ctl.getIOCtl
-		      (s, request, Word8Array.toPoly optval))
-		     ; unmarshal (optval, optlen, 0)
-		  end
-	       fun setIOCtl (request: request) (S s, optval: 'a): unit =
-		  let
-		     val optval = marshal optval
-		  in
-		     Syscall.simple
-		     (fn () =>
-		      Prim.Ctl.setIOCtl
-		      (s, request, Word8Vector.toPoly optval))
-		  end
-	    in
-	       (getSockOpt, getIOCtl, setSockOpt, setIOCtl)
-	    end
+         fun make (optlen: int,
+                   write: 'a * Word8Array.array * int -> unit,
+                   unmarshal: Word8Array.array * int * int -> 'a) =
+            let
+               fun marshal (x: 'a): Word8Vector.vector =
+                  let
+                     val wa = Word8Array.array (optlen, 0wx0)
+                  in
+                     write (x, wa, 0)
+                     ; Word8Array.vector wa
+                  end
+               fun getSockOpt (level: level, optname: optname) s =
+                  let
+                     val optval = Word8Array.array (optlen, 0wx0)
+                     val optlen = ref optlen
+                  in
+                     Syscall.simple
+                     (fn () =>
+                      Prim.Ctl.getSockOpt (s, level, optname,
+                                           Word8Array.toPoly optval,
+                                           optlen))
+                     ; unmarshal (optval, !optlen, 0)
+                  end
+               fun setSockOpt (level: level, optname: optname) (s, optval) =
+                  let
+                     val optval = marshal optval
+                     val optlen = Word8Vector.length optval
+                  in
+                     Syscall.simple
+                     (fn () => 
+                      Prim.Ctl.setSockOpt (s, level, optname,
+                                           Word8Vector.toPoly optval,
+                                           optlen))
+                  end
+               fun getIOCtl (request: request) s : 'a =
+                  let
+                     val optval = Word8Array.array (optlen, 0wx0)
+                  in
+                     Syscall.simple
+                     (fn () =>
+                      Prim.Ctl.getIOCtl
+                      (s, request, Word8Array.toPoly optval))
+                     ; unmarshal (optval, optlen, 0)
+                  end
+               fun setIOCtl (request: request) (s, optval: 'a): unit =
+                  let
+                     val optval = marshal optval
+                  in
+                     Syscall.simple
+                     (fn () =>
+                      Prim.Ctl.setIOCtl
+                      (s, request, Word8Vector.toPoly optval))
+                  end
+            in
+               (getSockOpt, getIOCtl, setSockOpt, setIOCtl)
+            end
       in
-	 val (getSockOptInt, getIOCtlInt, setSockOptInt, _) =
-	    make (intLen, marshalInt, unmarshalInt)
-	 val (getSockOptBool, getIOCtlBool, setSockOptBool, _) =
-	    make (boolLen, marshalBool, unmarshalBool)
-	 val (getSockOptTimeOpt, _, setSockOptTimeOpt, _) =
-	    make (timeOptLen, marshalTimeOpt, unmarshalTimeOpt)
+         val (getSockOptInt, getIOCtlInt, setSockOptInt, _) =
+            make (intLen, marshalInt, unmarshalInt)
+         val (getSockOptBool, getIOCtlBool, setSockOptBool, _) =
+            make (boolLen, marshalBool, unmarshalBool)
+         val (getSockOptTimeOpt, _, setSockOptTimeOpt, _) =
+            make (timeOptLen, marshalTimeOpt, unmarshalTimeOpt)
       end
-   end
 
-structure Ctl =
-   struct
-      open CtlExtra
-
       val getDEBUG = getSockOptBool (Prim.Ctl.SOCKET, Prim.Ctl.DEBUG)
       val setDEBUG = setSockOptBool (Prim.Ctl.SOCKET, Prim.Ctl.DEBUG)
       val getREUSEADDR = getSockOptBool (Prim.Ctl.SOCKET, Prim.Ctl.REUSEADDR)
@@ -207,46 +210,58 @@
       val getRCVBUF = getSockOptInt (Prim.Ctl.SOCKET, Prim.Ctl.RCVBUF)
       val setRCVBUF = setSockOptInt (Prim.Ctl.SOCKET, Prim.Ctl.RCVBUF)
       fun getTYPE s =
-	 Prim.SOCK.fromInt (getSockOptInt (Prim.Ctl.SOCKET, Prim.Ctl.TYPE) s)
-      val getERROR = getSockOptBool (Prim.Ctl.SOCKET, Prim.Ctl.ERROR)
+         Prim.SOCK.fromInt (getSockOptInt (Prim.Ctl.SOCKET, Prim.Ctl.TYPE) s)
+      fun getERROR s =
+         let
+            val se = getSockOptInt (Prim.Ctl.SOCKET, Prim.Ctl.ERROR) s
+         in
+            if 0 = se
+               then NONE
+            else SOME (Posix.Error.errorMsg se, SOME se)
+         end handle Error.SysErr z => SOME z
       local
-	 fun getName 
-	    (f: Prim.sock * pre_sock_addr * int ref -> int)
-	    (S s) =
-	    let
-	       val (sa, salen, finish) = new_sock_addr ()
-	       val () = Syscall.simple (fn () => f (s, sa, salen))
-	    in
-	       finish ()
-	    end
+         fun getName (s, f: Prim.sock * pre_sock_addr * int ref -> int) =
+            let
+               val (sa, salen, finish) = new_sock_addr ()
+               val () = Syscall.simple (fn () => f (s, sa, salen))
+            in
+               finish ()
+            end
       in
-	 fun getPeerName sock = getName Prim.Ctl.getPeerName sock
-	 fun getSockName sock = getName Prim.Ctl.getSockName sock
+         fun getPeerName s = getName (s, Prim.Ctl.getPeerName)
+         fun getSockName s = getName (s, Prim.Ctl.getSockName)
       end
       val getNREAD = getIOCtlInt Prim.Ctl.NREAD
       val getATMARK = getIOCtlBool Prim.Ctl.ATMARK
    end
 
+structure Ctl =
+   struct
+      open CtlExtra
+
+      val getERROR = isSome o CtlExtra.getERROR
+   end
+
 fun sameAddr (SA sa1, SA sa2) = sa1 = sa2
 
 fun familyOfAddr (SA sa) = NetHostDB.intToAddrFamily (Prim.familyOfAddr sa)
 
-fun bind (S s, SA sa) =
+fun bind (s, SA sa) =
    Syscall.simple (fn () => Prim.bind (s, sa, Vector.length sa))
 
-fun listen (S s, n) = 
+fun listen (s, n) = 
    Syscall.simple (fn () => Prim.listen (s, n))
 
 fun nonBlock' ({restart: bool},
-	       f : unit -> int, post : int -> 'a, again, no : 'a) =
+               f : unit -> int, post : int -> 'a, again, no : 'a) =
    Syscall.syscallErr
    ({clear = false, restart = restart},
     fn () => let val res = f ()
-	     in 
-		{return = res,
-		 post = fn () => post res,
-		 handlers = [(again, fn () => no)]}
-	     end)
+             in 
+                {return = res,
+                 post = fn () => post res,
+                 handlers = [(again, fn () => no)]}
+             end)
 
 fun nonBlock (f, post, no) =
    nonBlock' ({restart = true}, f, post, Error.again, no)
@@ -254,53 +269,54 @@
 local
    structure PIO = PosixPrimitive.IO
 in
-   fun withNonBlock (fd, f: unit -> 'a) =
+   fun withNonBlock (s, f: unit -> 'a) =
       let
-	 val flags = 
-	    Syscall.simpleResultRestart 
-	    (fn () => PIO.fcntl2 (fd, PIO.F_GETFL))
-	 val _ =
-	    Syscall.simpleResultRestart
-	    (fn () => 
-	     PIO.fcntl3 (fd, PIO.F_SETFL,
-			 Word.toIntX
-			 (Word.orb (Word.fromInt flags,
-				    PosixPrimitive.FileSys.O.nonblock))))
+         val fd = PosixPrimitive.FileDesc.fromInt (Prim.toInt s)
+         val flags = 
+            Syscall.simpleResultRestart (fn () => PIO.fcntl2 (fd, PIO.F_GETFL))
+         val _ =
+            Syscall.simpleResultRestart
+            (fn () => 
+             PIO.fcntl3 (fd, PIO.F_SETFL,
+                         Word.toIntX
+                         (Word.orb (Word.fromInt flags,
+                                    PosixPrimitive.FileSys.O.nonblock))))
       in
-	 DynamicWind.wind
-	 (f, fn () => Syscall.simple (fn () => PIO.fcntl3 (fd, PIO.F_SETFL, flags)))
+         DynamicWind.wind
+         (f, fn () =>
+          Syscall.simple (fn () => PIO.fcntl3 (fd, PIO.F_SETFL, flags)))
       end
 end
 
-fun connect (S s, SA sa) =
+fun connect (s, SA sa) =
    Syscall.simple (fn () => Prim.connect (s, sa, Vector.length sa))
 
-fun connectNB (S s, SA sa) =
+fun connectNB (s, SA sa) =
    nonBlock'
    ({restart = false}, fn () => 
     withNonBlock (s, fn () => Prim.connect (s, sa, Vector.length sa)),
     fn _ => true,
     Error.inprogress, false)
 
-fun accept (S s) =
+fun accept s =
    let
       val (sa, salen, finish) = new_sock_addr ()
       val s = Syscall.simpleResultRestart (fn () => Prim.accept (s, sa, salen))
    in
-      (S s, finish ())
+      (Prim.fromInt s, finish ())
    end
 
-fun acceptNB (S s) =
+fun acceptNB s =
    let
       val (sa, salen, finish) = new_sock_addr ()
    in
       nonBlock
       (fn () => withNonBlock (s, fn () => Prim.accept (s, sa, salen)),
-       fn s => SOME (S s, finish ()),
+       fn s => SOME (Prim.fromInt s, finish ()),
        NONE)
    end
 
-fun close (S s) = Syscall.simple (fn () => Prim.close (s))
+fun close s = Syscall.simple (fn () => Prim.close s)
 
 datatype shutdown_mode = NO_RECVS | NO_SENDS | NO_RECVS_OR_SENDS
 
@@ -310,7 +326,7 @@
     | NO_SENDS => Prim.SHUT_WR
     | NO_RECVS_OR_SENDS => Prim.SHUT_RDWR
 
-fun shutdown (S s, m) =
+fun shutdown (s, m) =
    let val m = shutdownModeToHow m
    in Syscall.simple (fn () => Prim.shutdown (s, m))
    end
@@ -323,38 +339,38 @@
    OS.IO.compare (desc1, desc2) = EQUAL
 
 fun select {rds: sock_desc list, 
-	    wrs: sock_desc list, 
-	    exs: sock_desc list, 
-	    timeout: Time.time option} =
+            wrs: sock_desc list, 
+            exs: sock_desc list, 
+            timeout: Time.time option} =
    let
       fun mk poll (sd,pds) =
-	 let
-	    val pd = Option.valOf (OS.IO.pollDesc sd)
-	    val pd = poll pd
-	 in
-	    pd::pds
-	 end
+         let
+            val pd = Option.valOf (OS.IO.pollDesc sd)
+            val pd = poll pd
+         in
+            pd::pds
+         end
       val pds =
-	 (List.foldr (mk OS.IO.pollIn)
-	  (List.foldr (mk OS.IO.pollOut)
-	   (List.foldr (mk OS.IO.pollPri)
-	    [] exs) wrs) rds)
+         (List.foldr (mk OS.IO.pollIn)
+          (List.foldr (mk OS.IO.pollOut)
+           (List.foldr (mk OS.IO.pollPri)
+            [] exs) wrs) rds)
       val pis = OS.IO.poll (pds, timeout)
       val {rds, wrs, exs} =
-	 List.foldr
-	 (fn (pi,{rds,wrs,exs}) =>
-	  let
-	     fun mk (is,l) =
-		if is pi
-		   then (OS.IO.pollToIODesc (OS.IO.infoToPollDesc pi))::l
-		else l
-	  in
-	     {rds = mk (OS.IO.isIn, rds),
-	      wrs = mk (OS.IO.isOut, wrs),
-	      exs = mk (OS.IO.isPri, exs)}
-	  end) 
-	 {rds = [], wrs = [], exs = []}
-	 pis
+         List.foldr
+         (fn (pi,{rds,wrs,exs}) =>
+          let
+             fun mk (is,l) =
+                if is pi
+                   then (OS.IO.pollToIODesc (OS.IO.infoToPollDesc pi))::l
+                else l
+          in
+             {rds = mk (OS.IO.isIn, rds),
+              wrs = mk (OS.IO.isOut, wrs),
+              exs = mk (OS.IO.isPri, exs)}
+          end) 
+         {rds = [], wrs = [], exs = []}
+         pis
    in
       {rds = rds, wrs = wrs, exs = exs}
    end
@@ -365,79 +381,86 @@
 
 fun mk_out_flags {don't_route, oob} =
    Word.orb (if don't_route then Prim.MSG_DONTROUTE else 0wx0,
-		Word.orb (if oob then Prim.MSG_OOB else 0wx0,
-			     0wx0))
+                Word.orb (if oob then Prim.MSG_OOB else 0wx0,
+                             0wx0))
 val no_out_flags = {don't_route = false, oob = false}
 
 local
    fun make (base, toPoly, primSend, primSendTo) =
       let
-	 val base = fn sl => let val (buf, i, sz) = base sl
-			     in (toPoly buf, i, sz)
-			     end
-	 fun send' (S s, sl, out_flags) =
-	    let
-	       val (buf, i, sz) = base sl
-	    in
-	       Syscall.simpleResultRestart
-	       (fn () => primSend (s, buf, i, sz, mk_out_flags out_flags))
-	    end
-	 fun send (sock, buf) = send' (sock, buf, no_out_flags)
-	 fun sendNB' (S s, sl, out_flags) =
-	    let
-	       val (buf, i, sz) = base sl
-	    in
-	       nonBlock
-	       (fn () => primSend (s, buf, i, sz, Word.orb (Prim.MSG_DONTWAIT, mk_out_flags out_flags)),
-		SOME, 
-		NONE)
-	    end
-	 fun sendNB (sock, sl) = sendNB' (sock, sl, no_out_flags)
-	 fun sendTo' (S s, SA sa, sl, out_flags) =
-	    let
-	       val (buf, i, sz) = base sl
-	    in
-	       Syscall.simpleRestart
-	       (fn () => primSendTo (s, buf, i, sz, mk_out_flags out_flags, sa, Vector.length sa))
-	    end
-	 fun sendTo (sock, sock_addr, sl) =
-	    sendTo' (sock, sock_addr, sl, no_out_flags)
-	 fun sendToNB' (S s, SA sa, sl, out_flags) =
-	    let
-	       val (buf, i, sz) = base sl
-	    in
-	       nonBlock 
-	       (fn () => primSendTo (s, buf, i, sz, Word.orb (Prim.MSG_DONTWAIT, mk_out_flags out_flags),
-				     sa, Vector.length sa),
-		fn _ => true,
-		false)
-	    end
-	 fun sendToNB (sock, sa, sl) =
-	    sendToNB' (sock, sa, sl, no_out_flags)
+         val base = fn sl => let val (buf, i, sz) = base sl
+                             in (toPoly buf, i, sz)
+                             end
+         fun send' (s, sl, out_flags) =
+            let
+               val (buf, i, sz) = base sl
+            in
+               Syscall.simpleResultRestart
+               (fn () => primSend (s, buf, i, sz, mk_out_flags out_flags))
+            end
+         fun send (sock, buf) = send' (sock, buf, no_out_flags)
+         fun sendNB' (s, sl, out_flags) =
+            let
+               val (buf, i, sz) = base sl
+            in
+               nonBlock
+               (fn () =>
+                primSend (s, buf, i, sz,
+                          Word.orb (Prim.MSG_DONTWAIT, mk_out_flags out_flags)),
+                SOME, 
+                NONE)
+            end
+         fun sendNB (sock, sl) = sendNB' (sock, sl, no_out_flags)
+         fun sendTo' (s, SA sa, sl, out_flags) =
+            let
+               val (buf, i, sz) = base sl
+            in
+               Syscall.simpleRestart
+               (fn () =>
+                primSendTo (s, buf, i, sz,
+                            mk_out_flags out_flags, sa, Vector.length sa))
+            end
+         fun sendTo (sock, sock_addr, sl) =
+            sendTo' (sock, sock_addr, sl, no_out_flags)
+         fun sendToNB' (s, SA sa, sl, out_flags) =
+            let
+               val (buf, i, sz) = base sl
+            in
+               nonBlock 
+               (fn () =>
+                primSendTo (s, buf, i, sz,
+                            Word.orb (Prim.MSG_DONTWAIT,
+                                      mk_out_flags out_flags),
+                            sa, Vector.length sa),
+                fn _ => true,
+                false)
+            end
+         fun sendToNB (sock, sa, sl) =
+            sendToNB' (sock, sa, sl, no_out_flags)
       in
-	 (send, send', sendNB, sendNB', sendTo, sendTo', sendToNB, sendToNB')
+         (send, send', sendNB, sendNB', sendTo, sendTo', sendToNB, sendToNB')
       end
 in
    val (sendArr, sendArr', sendArrNB, sendArrNB',
-	sendArrTo, sendArrTo', sendArrToNB, sendArrToNB') =
+        sendArrTo, sendArrTo', sendArrToNB, sendArrToNB') =
       make (Word8ArraySlice.base, Word8Array.toPoly,
-	    Prim.sendArr, Prim.sendToArr)
+            Prim.sendArr, Prim.sendToArr)
    val (sendVec, sendVec', sendVecNB, sendVecNB',
-	sendVecTo, sendVecTo', sendVecToNB, sendVecToNB') =
+        sendVecTo, sendVecTo', sendVecToNB, sendVecToNB') =
       make (Word8VectorSlice.base, Word8Vector.toPoly,
-	    Prim.sendVec, Prim.sendToVec)
+            Prim.sendVec, Prim.sendToVec)
 end
 
 type in_flags = {peek: bool, oob: bool}
 
 val no_in_flags = {peek = false, oob = false}
-	    
+            
 fun mk_in_flags {peek, oob} =
    Word.orb (if peek then Prim.MSG_PEEK else 0wx0,
-		Word.orb (if oob then Prim.MSG_OOB else 0wx0,
-			     0wx0))
+                Word.orb (if oob then Prim.MSG_OOB else 0wx0,
+                             0wx0))
 
-fun recvArr' (S s, sl, in_flags) =
+fun recvArr' (s, sl, in_flags) =
    let
       val (buf, i, sz) = Word8ArraySlice.base sl
    in
@@ -454,7 +477,7 @@
    let
       val a = Word8Array.rawArray n
       val bytesRead =
-	 recvArr' (sock, Word8ArraySlice.full a, in_flags)
+         recvArr' (sock, Word8ArraySlice.full a, in_flags)
    in
       getVec (a, n, bytesRead)
    end
@@ -463,13 +486,14 @@
 
 fun recvVec (sock, n) = recvVec' (sock, n, no_in_flags)
 
-fun recvArrFrom' (S s, sl, in_flags) =
+fun recvArrFrom' (s, sl, in_flags) =
    let
       val (buf, i, sz) = Word8ArraySlice.base sl
       val (sa, salen, finish) = new_sock_addr ()
       val n =
-	 Syscall.simpleResultRestart
-	 (fn () => Prim.recvFrom (s, Word8Array.toPoly buf, i, sz, mk_in_flags in_flags, sa, salen))
+         Syscall.simpleResultRestart
+         (fn () => Prim.recvFrom (s, Word8Array.toPoly buf, i, sz,
+                                  mk_in_flags in_flags, sa, salen))
    in
       (n, finish ())
    end
@@ -478,7 +502,7 @@
    let
       val a = Word8Array.fromPoly (Primitive.Array.array n)
       val (bytesRead, sock_addr) =
-	 recvArrFrom' (sock, Word8ArraySlice.full a, in_flags)
+         recvArrFrom' (sock, Word8ArraySlice.full a, in_flags)
    in
       (getVec (a, n, bytesRead), sock_addr)
    end
@@ -489,22 +513,24 @@
 
 fun mk_in_flagsNB z = Word.orb (mk_in_flags z, Prim.MSG_DONTWAIT)
 
-fun recvArrNB' (S s, sl, in_flags) =
+fun recvArrNB' (s, sl, in_flags) =
    let
       val (buf, i, sz) = Word8ArraySlice.base sl
    in
       nonBlock
-      (fn () => Prim.recv (s, Word8Array.toPoly buf, i, sz, mk_in_flagsNB in_flags),
+      (fn () => Prim.recv (s, Word8Array.toPoly buf, i, sz,
+                           mk_in_flagsNB in_flags),
        SOME, 
        NONE)
    end
 
-fun recvVecNB' (S s, n, in_flags) =
+fun recvVecNB' (s, n, in_flags) =
    let
       val a = Word8Array.rawArray n
    in
       nonBlock
-      (fn () => Prim.recv (s, Word8Array.toPoly a, 0, n, mk_in_flagsNB in_flags),
+      (fn () => Prim.recv (s, Word8Array.toPoly a, 0, n,
+                           mk_in_flagsNB in_flags),
        fn bytesRead => SOME (getVec (a, n, bytesRead)),
        NONE)
    end
@@ -513,24 +539,26 @@
 
 fun recvVecNB (sock, n) = recvVecNB' (sock, n, no_in_flags)
 
-fun recvArrFromNB' (S s, sl, in_flags) =
+fun recvArrFromNB' (s, sl, in_flags) =
    let
       val (buf, i, sz) = Word8ArraySlice.base sl
       val (sa, salen, finish) = new_sock_addr ()
    in
       nonBlock
-      (fn () => Prim.recvFrom (s, Word8Array.toPoly buf, i, sz, mk_in_flagsNB in_flags, sa, salen),
+      (fn () => Prim.recvFrom (s, Word8Array.toPoly buf, i, sz,
+                               mk_in_flagsNB in_flags, sa, salen),
        fn n => SOME (n, finish ()),
        NONE)
    end
 
-fun recvVecFromNB' (S s, n, in_flags) =
+fun recvVecFromNB' (s, n, in_flags) =
    let
       val a = Word8Array.fromPoly (Primitive.Array.array n)
       val (sa, salen, finish) = new_sock_addr ()
    in
       nonBlock
-      (fn () => Prim.recvFrom (s, Word8Array.toPoly a, 0, n, mk_in_flagsNB in_flags, sa, salen),
+      (fn () => Prim.recvFrom (s, Word8Array.toPoly a, 0, n,
+                               mk_in_flagsNB in_flags, sa, salen),
        fn bytesRead => SOME (getVec (a, n, bytesRead), finish ()),
        NONE)
    end
@@ -540,7 +568,7 @@
 fun recvVecFromNB (sock, n) = recvVecFromNB' (sock, n, no_in_flags)
 
 (* Phantom type. *)
-type ('af,'sock_type) sock = sock
+type ('af, 'sock_type) sock = sock
 
 type 'af sock_addr = sock_addr
 

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/net/unix-sock.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/net/unix-sock.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/net/unix-sock.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -9,13 +9,13 @@
       val toAddr: string -> sock_addr
       val fromAddr: sock_addr -> string
       structure Strm : 
-	 sig
-	    val socket: unit -> 'mode stream_sock
-	    val socketPair: unit -> 'mode stream_sock * 'mode stream_sock
-	 end
+         sig
+            val socket: unit -> 'mode stream_sock
+            val socketPair: unit -> 'mode stream_sock * 'mode stream_sock
+         end
       structure DGrm : 
-	 sig
-	    val socket: unit -> dgram_sock
-	    val socketPair: unit -> dgram_sock * dgram_sock
-	 end
+         sig
+            val socket: unit -> dgram_sock
+            val socketPair: unit -> dgram_sock * dgram_sock
+         end
    end
\ No newline at end of file

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/net/unix-sock.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/net/unix-sock.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/net/unix-sock.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,10 @@
+(* Copyright (C) 2002-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 structure UnixSock : UNIX_SOCK =
    struct
       structure Prim = Primitive.Socket.UnixSock
@@ -10,34 +17,34 @@
       val unixAF = NetHostDB.intToAddrFamily Primitive.Socket.AF.UNIX
 
       fun toAddr s = 
-	let
-	  val (sa, salen, finish) = Socket.new_sock_addr ()
-	  val _ = Prim.toAddr (NullString.nullTerm s, String.size s, sa, salen)
-	in 
-	  finish ()
-	end
+        let
+          val (sa, salen, finish) = Socket.new_sock_addr ()
+          val _ = Prim.toAddr (NullString.nullTerm s, String.size s, sa, salen)
+        in 
+          finish ()
+        end
  
       fun fromAddr sa = 
-	let
-	  val sa = Socket.unpackSockAddr sa
-	  val sa = Word8Vector.toPoly sa
-	  val len = Prim.pathLen sa
-	  val a = CharArray.array (len, #"\000")
-	  val _ = Prim.fromAddr (sa, CharArray.toPoly a, len)
-	in
-	   CharArraySlice.vector (CharArraySlice.slice (a, 0, SOME len))
-	end 
+        let
+          val sa = Socket.unpackSockAddr sa
+          val sa = Word8Vector.toPoly sa
+          val len = Prim.pathLen sa
+          val a = CharArray.array (len, #"\000")
+          val _ = Prim.fromAddr (sa, CharArray.toPoly a, len)
+        in
+           CharArraySlice.vector (CharArraySlice.slice (a, 0, SOME len))
+        end 
 
       structure Strm =
-	 struct
-	    fun socket () = GenericSock.socket (unixAF, Socket.SOCK.stream)
-	    fun socketPair () =
-	       GenericSock.socketPair (unixAF, Socket.SOCK.stream)
-	 end
+         struct
+            fun socket () = GenericSock.socket (unixAF, Socket.SOCK.stream)
+            fun socketPair () =
+               GenericSock.socketPair (unixAF, Socket.SOCK.stream)
+         end
       structure DGrm =
-	 struct
-	    fun socket () = GenericSock.socket (unixAF, Socket.SOCK.dgram)
-	    fun socketPair () =
-	       GenericSock.socketPair (unixAF, Socket.SOCK.dgram)
-	 end
+         struct
+            fun socket () = GenericSock.socket (unixAF, Socket.SOCK.dgram)
+            fun socketPair () =
+               GenericSock.socketPair (unixAF, Socket.SOCK.dgram)
+         end
    end

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/notes.txt
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/notes.txt	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/notes.txt	2006-02-16 19:34:54 UTC (rev 4361)
@@ -233,7 +233,7 @@
   - Typo in description of findi: s/appi/findi/.
   - Signature sometimes uses Vector.vector instead of plain vector.
   - The equation for mapi can be simplified to:
-	Vector.fromList (foldri (fn (i,a,l) => f(i,a)::l) [] slice)
+        Vector.fromList (foldri (fn (i,a,l) => f(i,a)::l) [] slice)
 
 * MONO_VECTOR_SLICE and ARRAY_SLICE and MONO_ARRAY_SLICE:
   - Typo in synopsis of subslice: s/opt/sz/.
@@ -285,10 +285,10 @@
 
 * The type specification of String.string and CharVector.vector
   is circular:
-	structure String :> STRING
-	       where type string = CharVector.vector
-	structure CharVector :> MONO_VECTOR
-	       where type vector = String.string
+        structure String :> STRING
+               where type string = CharVector.vector
+        structure CharVector :> MONO_VECTOR
+               where type vector = String.string
   Likewise for Substring.substring and CharVectorSlice.slice.
   A respective defining structure should be chosen.
 
@@ -344,12 +344,12 @@
     consistency I propose:
     (1) changing the type of Substring.substring to
         string * int * int option -> substring
-	(for consistency with VectorSlice.slice),
+        (for consistency with VectorSlice.slice),
     (2) renaming Substring.slice to Substring.subsubstring,
         (for consistency with VectorSlice.subslice),
     (3) removing Substring.{app,foldl,foldr} (there are no similar
         functions in the STRING signature, and in both cases they
-	are available through CharVector/CharVectorSlice),
+        are available through CharVector/CharVectorSlice),
     (4) removing String.extract and Substring.extract (the same
         functionality is available through CharVector[Slice]).
   - I believe the deprecated Substring.all can be removed for good.
@@ -387,7 +387,7 @@
     network functionality. More precisely, I propose
     (1) moving the structures Socket, INetSock, GenericSock, and
         the three Net*DB structures into a new wrapper structure
-	Net (renaming Net*DB to *DB),
+        Net (renaming Net*DB to *DB),
     (2) defining a corresponding signature NET,
     (3) renaming the signatures SOCKET, GENERIC_SOCK and INET_SOCK
         to NET_SOCKET, NET_GENERIC_SOCK and NET_INET_SOCK, resp.,
@@ -405,22 +405,22 @@
 * LIST and LIST_PAIR:
   - The IMHO single most convenient extension to the library would
     be indexed morphisms on lists, i.e. adding
-	val appi : (int * 'a -> unit) -> 'a list -> unit
-	val mapi : (int * 'a -> 'b) -> 'a list -> 'b list
-	val foldli : (int * 'a * 'b -> 'b) -> 'b -> 'a list -> 'b
-	val foldri : (int * 'a * 'b -> 'b) -> 'b -> 'a list -> 'b
-	val findi : (int * 'a -> bool) -> 'a list -> (int * 'a) option
+        val appi : (int * 'a -> unit) -> 'a list -> unit
+        val mapi : (int * 'a -> 'b) -> 'a list -> 'b list
+        val foldli : (int * 'a * 'b -> 'b) -> 'b -> 'a list -> 'b
+        val foldri : (int * 'a * 'b -> 'b) -> 'b -> 'a list -> 'b
+        val findi : (int * 'a -> bool) -> 'a list -> (int * 'a) option
   - Likewise for LIST_PAIR.
   - LIST_PAIR does not support partial mapping:
-	val mapPartial : ('a * 'b -> 'c option) ->
-				'a list * 'b list -> 'c list
+        val mapPartial : ('a * 'b -> 'c option) ->
+                                'a list * 'b list -> 'c list
 
 * LIST, VECTOR, ARRAY, etc.:
   - Another function on lists that would be very useful from my
     perspective is
-	val appr : ('a -> unit) -> 'a list -> unit
+        val appr : ('a -> unit) -> 'a list -> unit
     and its indexed sibling
-	val appri : (int * 'a -> unit) -> 'a list -> unit
+        val appri : (int * 'a -> unit) -> 'a list -> unit
     which traverse the list from right to left.
   - Likewise for all aggregate types.
   - All aggregates come with a fromList function. I often feel the
@@ -428,16 +428,16 @@
 
 * OPTION:
   - Often using isSome is a bit clumsy. I thus propose adding the dual
-	val isNone : 'a option -> bool
+        val isNone : 'a option -> bool
 
 * STRING and SUBSTRING:
   - For historical reasons we have {String,Substring}.size instead
     of *.length, which is inconsistent with all other aggregates and
     frequently lets me mix them up when I use them side by side.
     I propose adding aliases
-	String.maxLen
-	String.length
-	Substring.length
+        String.maxLen
+        String.length
+        Substring.length
 
 * WideChar and WideString:
   - There is no convenient way to convert between the standard and
@@ -453,12 +453,12 @@
     scan function and which don't. I believe it makes sense to have
     scan in every signature that has fromString.
   - There should be a function
-	val scanC : (Char.char, 'a) StringCvt.reader
+        val scanC : (Char.char, 'a) StringCvt.reader
                         -> (char, 'a) StringCvt.reader
     to scan strings as C characters. This would make Char.fromCString
     and particularly String.fromCString more modular.
   - How about a dual writer abstraction as with
-	type ('a,'b) writer = 'a * 'b -> 'b option
+        type ('a,'b) writer = 'a * 'b -> 'b option
     and supporting fmt functions for basic types? Such a thing might
     be useful for writing to streams or buffers.
 
@@ -480,14 +480,14 @@
     libraries.
 
 * There is no defining structure for references. I would like to see
-	signature REF
-	structure Ref : REF
+        signature REF
+        structure Ref : REF
   where REF contains:
-	datatype ref = datatype ref
-	val ! : 'a ref -> 'a
-	val := : 'a ref * 'a -> unit
-	val swap : 'a ref * 'a ref -> unit	(* or :=: ? *)
-	val map : ('a -> 'a) -> 'a ref -> 'a ref
+        datatype ref = datatype ref
+        val ! : 'a ref -> 'a
+        val := : 'a ref * 'a -> unit
+        val swap : 'a ref * 'a ref -> unit      (* or :=: ? *)
+        val map : ('a -> 'a) -> 'a ref -> 'a ref
   You might then consider removing ! and := from GENERAL.
 
 * Signature conventions:
@@ -498,7 +498,7 @@
     monomorphic types as well as polymorphic ones).
   - Every equality type should come with an explicit equality
     function
-	val eq : t * t -> bool
+        val eq : t * t -> bool
     to move away from the reliance on eqtypes.
   - There should be a uniform name for canonical constructor
     functions, e.g. "new" (or at least an alias).
@@ -537,8 +537,8 @@
 A few other notes of things I've discovered, some of which are trivial:
 
 The signature for TextIO.StreamIO contains duplicates of
-  where type StreamIO.reader = TextPrimIO.reader
-  where type StreamIO.writer = TextPrimIO.writer
+  where type StreamIO.reader = TextPrimIO.reader
+  where type StreamIO.writer = TextPrimIO.writer
 
 There are declared constants for platformWin32Windows2000 and 
 platformWin32WindowsXP in the Windows structure.  When I proposed the 
@@ -755,7 +755,7 @@
 since Alice is relying on concurrency. However, that does not seem to be
 an issue easily solved.
 
-	- Leif Kornstaedt, Andreas Rossberg
+        - Leif Kornstaedt, Andreas Rossberg
 
 
 The IO structure
@@ -930,7 +930,7 @@
   - The signature of this function is inconsistent with all other
     input functions. It should rather have type
 
-	instream -> elem option * instream
+        instream -> elem option * instream
 
     which in fact appears to be the type assumed in the discussion
     example relating input1 to inputN.
@@ -1221,9 +1221,9 @@
   - Type sharing with BinPrimIO is not specified (unlike for
     TextIO), i.e. the following constraints are missing:
 
-	where type StreamIO.reader = BinPrimIO.reader
-	where type StreamIO.writer = BinPrimIO.writer
-	where type StreamIO.pos = BinPrimIO.pos
+        where type StreamIO.reader = BinPrimIO.reader
+        where type StreamIO.writer = BinPrimIO.writer
+        where type StreamIO.pos = BinPrimIO.pos
 
 ******************************************************************************
 ******************************************************************************

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/overloads.mlb
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/overloads.mlb	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/overloads.mlb	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,12 +1,22 @@
+(* Copyright (C) 2004-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 ann  
    "deadCode true"
-   "sequenceUnit true"
-   "warnMatch true"
+   "sequenceNonUnit warn"
+   "nonexhaustiveMatch warn" "redundantMatch warn"
    "warnUnused true" "forceUsed"
 in
    local 
       basis-2002.mlb 
    in
-      ann "allowOverload true" in libs/basis-2002/top-level/overloads.sml end
+      ann "allowOverload true" 
+      in 
+         libs/basis-2002/top-level/overloads.sml 
+      end
    end
 end

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/pervasive-exns.mlb
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/pervasive-exns.mlb	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/pervasive-exns.mlb	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,7 +1,14 @@
+(* Copyright (C) 2004-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 ann  
    "deadCode true"
-   "sequenceUnit true"
-   "warnMatch true"
+   "sequenceNonUnit warn"
+   "nonexhaustiveMatch warn" "redundantMatch warn"
    "warnUnused true" "forceUsed"
 in
    local
@@ -10,5 +17,5 @@
       libs/basis-2002/top-level/basis-exns.sig
    in
       libs/basis-2002/top-level/pervasive-exns.sml
-    end
+   end
 end

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/pervasive-types.mlb
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/pervasive-types.mlb	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/pervasive-types.mlb	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,7 +1,14 @@
+(* Copyright (C) 2004-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 ann  
    "deadCode true"
-   "sequenceUnit true"
-   "warnMatch true"
+   "sequenceNonUnit warn"
+   "nonexhaustiveMatch warn" "redundantMatch warn"
    "warnUnused true" "forceUsed"
 in
    local
@@ -9,7 +16,6 @@
       basis-2002.mlb
       libs/basis-2002/top-level/basis-types.sig
    in
-
       libs/basis-2002/top-level/pervasive-types.sml
-    end
+   end
 end

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/pervasive-vals.mlb
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/pervasive-vals.mlb	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/pervasive-vals.mlb	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,7 +1,14 @@
+(* Copyright (C) 2004-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 ann  
    "deadCode true"
-   "sequenceUnit true"
-   "warnMatch true"
+   "sequenceNonUnit warn"
+   "nonexhaustiveMatch warn" "redundantMatch warn"
    "warnUnused true" "forceUsed"
 in
    local
@@ -10,5 +17,5 @@
       libs/basis-2002/top-level/basis-vals.sig
    in
       libs/basis-2002/top-level/pervasive-vals.sml
-    end
+   end
 end

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/pervasive.mlb
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/pervasive.mlb	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/pervasive.mlb	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,10 @@
+(* Copyright (C) 2004-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 pervasive-types.mlb
 pervasive-exns.mlb
 pervasive-vals.mlb

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/platform/cygwin.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/platform/cygwin.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/platform/cygwin.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,32 +1,39 @@
+(* Copyright (C) 2004-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 structure Cygwin =
    struct
       structure Prim = Primitive.Cygwin
-	 
+         
       fun toFullWindowsPath p =
-	 C.CS.toString (Prim.toFullWindowsPath (NullString.nullTerm p))
+         C.CS.toString (Prim.toFullWindowsPath (NullString.nullTerm p))
 
       fun toExe cmd =
-	 let
-	    val cmd = toFullWindowsPath cmd
-	    fun addExe () = concat [cmd, ".exe"]
-	    fun loop i =
-	       let
-		  val i = i - 1
-	       in
-		  if i < 0
-		     then addExe ()
-		  else
-		     let
-			val c = String.sub (cmd, i)
-		     in
-			case c of
-			   #"." => cmd
-			 | #"\\" => addExe ()
-			 | _ => loop i
-		     end
-	       end
-	 in
-	    loop (size cmd)
-	 end
+         let
+            val cmd = toFullWindowsPath cmd
+            fun addExe () = concat [cmd, ".exe"]
+            fun loop i =
+               let
+                  val i = i - 1
+               in
+                  if i < 0
+                     then addExe ()
+                  else
+                     let
+                        val c = String.sub (cmd, i)
+                     in
+                        case c of
+                           #"." => cmd
+                         | #"\\" => addExe ()
+                         | _ => loop i
+                     end
+               end
+         in
+            loop (size cmd)
+         end
    end
-	    
+            

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/posix/error.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/posix/error.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/posix/error.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -65,39 +65,39 @@
       val raiseSys: syserror -> 'a
 
       structure SysCall :
-	 sig
-	    val blocker: (unit -> (unit -> unit)) ref
-	    val restartFlag: bool ref
+         sig
+            val blocker: (unit -> (unit -> unit)) ref
+            val restartFlag: bool ref
 
-	    val syscallErr: 
-	       {clear: bool, restart: bool} * 
-	       (unit -> {return: int,
-			 post: unit -> 'a,
-			 handlers: (syserror * (unit -> 'a)) list}) -> 'a
+            val syscallErr: 
+               {clear: bool, restart: bool} * 
+               (unit -> {return: int,
+                         post: unit -> 'a,
+                         handlers: (syserror * (unit -> 'a)) list}) -> 'a
 
-	    (* clear = false, restart = false,
-	     * post = fn () => (), handlers = []
-	     *)
-	    val simple: (unit -> int) -> unit
-	    (* clear = false, restart = true,
-	     * post = fn () => (), handlers = []
-	     *)
-	    val simpleRestart: (unit -> int) -> unit
-	    (* clear = false, restart = false,
-	     * post = fn () => return, handlers = []
-	     *)
-	    val simpleResult: (unit -> int) -> int
-	    (* clear = false, restart = true,
-	     * post = fn () => return, handlers = []
-	     *)
-	    val simpleResultRestart: (unit -> int) -> int
-	    (* clear = false, restart = false,
-	     * handlers = []
-	     *)
-	    val syscall: (unit -> int * (unit -> 'a)) -> 'a
-	    (* clear = false, restart = true,
-	     * handlers = []
-	     *)
-	    val syscallRestart: (unit -> int * (unit -> 'a)) -> 'a
-	 end
+            (* clear = false, restart = false,
+             * post = fn () => (), handlers = []
+             *)
+            val simple: (unit -> int) -> unit
+            (* clear = false, restart = true,
+             * post = fn () => (), handlers = []
+             *)
+            val simpleRestart: (unit -> int) -> unit
+            (* clear = false, restart = false,
+             * post = fn () => return, handlers = []
+             *)
+            val simpleResult: (unit -> int) -> int
+            (* clear = false, restart = true,
+             * post = fn () => return, handlers = []
+             *)
+            val simpleResultRestart: (unit -> int) -> int
+            (* clear = false, restart = false,
+             * handlers = []
+             *)
+            val syscall: (unit -> int * (unit -> 'a)) -> 'a
+            (* clear = false, restart = true,
+             * handlers = []
+             *)
+            val syscallRestart: (unit -> int * (unit -> 'a)) -> 'a
+         end
    end

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/posix/error.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/posix/error.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/posix/error.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,15 +1,16 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 structure PosixError: POSIX_ERROR_EXTRA =
    struct
       structure Prim = PosixPrimitive.Error
       open Prim
-	 
+         
       exception SysErr of string * syserror option
 
       val toWord = SysWord.fromInt
@@ -18,127 +19,127 @@
       val cleared : syserror = 0
 
       fun errorName n =
-	 case List.find (fn (m, _) => n = m) errorNames of
-	    NONE => "<UNKNOWN>"
-	  | SOME (_, s) => s
+         case List.find (fn (m, _) => n = m) errorNames of
+            NONE => "<UNKNOWN>"
+          | SOME (_, s) => s
 
       val _ =
-	 General.addExnMessager
-	 (fn e =>
-	  case e of
-	     SysErr (s, eo) =>
-	        SOME (concat ["SysErr: ", s,
-			      case eo of
-				 NONE => ""
-			       | SOME e => concat [" [", errorName e, "]"]])
-	   | _ => NONE)
+         General.addExnMessager
+         (fn e =>
+          case e of
+             SysErr (s, eo) =>
+                SOME (concat ["SysErr: ", s,
+                              case eo of
+                                 NONE => ""
+                               | SOME e => concat [" [", errorName e, "]"]])
+           | _ => NONE)
 
       fun syserror s =
-	 case List.find (fn (_, s') => s = s') errorNames of
-	    NONE => NONE
-	  | SOME (n, _) => SOME n
+         case List.find (fn (_, s') => s = s') errorNames of
+            NONE => NONE
+          | SOME (n, _) => SOME n
 
       fun errorMsg (n: int) =
-	 let
-	    val cs = strerror n
-	 in
-	    if cs = Primitive.Pointer.null
-	       then "Unknown error"
-	    else C.CS.toString cs
-	 end
+         let
+            val cs = strerror n
+         in
+            if cs = Primitive.Pointer.null
+               then "Unknown error"
+            else C.CS.toString cs
+         end
 
       fun raiseSys n = raise SysErr (errorMsg n, SOME n)
 
       structure SysCall =
-	 struct
-	    structure Thread = Primitive.Thread
+         struct
+            structure Thread = Primitive.Thread
 
-	    val blocker: (unit -> (unit -> unit)) ref =
-	       ref (fn () => (fn () => ()))
-	       (* ref (fn () => raise Fail "blocker not installed") *)
-	    val restartFlag = ref true
+            val blocker: (unit -> (unit -> unit)) ref =
+               ref (fn () => (fn () => ()))
+               (* ref (fn () => raise Fail "blocker not installed") *)
+            val restartFlag = ref true
 
-	    val syscallErr: {clear: bool, restart: bool} * 
-	                    (unit -> {return: int,
-				      post: unit -> 'a,
-				      handlers: (syserror * (unit -> 'a)) list}) -> 'a =
-	       fn ({clear, restart}, f) =>
-	       let
-		  fun call (err: {errno: syserror,
-				  handlers: (syserror * (unit -> 'a)) list} -> 'a): 'a =
-		     let
-			val () = Thread.atomicBegin ()
-			val () = if clear then clearErrno () else ()
-			val {return, post, handlers} = 
-			   f () handle exn => (Thread.atomicEnd (); raise exn)
-		     in
-			if ~1 = return
-			   then
-			      (* Must getErrno () in the critical section. *)
-			      let
-				 val e = getErrno ()
-				 val () = Thread.atomicEnd ()
-			      in
-				 err {errno = e, handlers = handlers}
-			      end
-			   else DynamicWind.wind (post, Thread.atomicEnd)
-		     end
-		  fun err {default: unit -> 'a, 
-			   errno: syserror, 
-			   handlers: (syserror * (unit -> 'a)) list}: 'a =
-		     case List.find (fn (e',_) => errno = e') handlers of
-			NONE => default ()
-		      | SOME (_, handler) => handler ()
-		  fun errBlocked {errno: syserror,
-				  handlers: (syserror * (unit -> 'a)) list}: 'a =
-		     err {default = fn () => raiseSys errno,
-			  errno = errno, handlers = handlers}
-		  fun errUnblocked
-		     {errno: syserror,
-		      handlers: (syserror * (unit -> 'a)) list}: 'a =
-		     err {default = fn () =>
-			  if restart andalso errno = intr andalso !restartFlag
-			     then if Thread.canHandle () = 0
-				     then call errUnblocked
-				     else let val finish = !blocker ()
-					  in 
-					     DynamicWind.wind
-					     (fn () => call errBlocked, finish)
-					  end
-			     else raiseSys errno,
-			  errno = errno, handlers = handlers}
-	       in
-		  call errUnblocked
-	       end
+            val syscallErr: {clear: bool, restart: bool} * 
+                            (unit -> {return: int,
+                                      post: unit -> 'a,
+                                      handlers: (syserror * (unit -> 'a)) list}) -> 'a =
+               fn ({clear, restart}, f) =>
+               let
+                  fun call (err: {errno: syserror,
+                                  handlers: (syserror * (unit -> 'a)) list} -> 'a): 'a =
+                     let
+                        val () = Thread.atomicBegin ()
+                        val () = if clear then clearErrno () else ()
+                        val {return, post, handlers} = 
+                           f () handle exn => (Thread.atomicEnd (); raise exn)
+                     in
+                        if ~1 = return
+                           then
+                              (* Must getErrno () in the critical section. *)
+                              let
+                                 val e = getErrno ()
+                                 val () = Thread.atomicEnd ()
+                              in
+                                 err {errno = e, handlers = handlers}
+                              end
+                           else DynamicWind.wind (post, Thread.atomicEnd)
+                     end
+                  fun err {default: unit -> 'a, 
+                           errno: syserror, 
+                           handlers: (syserror * (unit -> 'a)) list}: 'a =
+                     case List.find (fn (e',_) => errno = e') handlers of
+                        NONE => default ()
+                      | SOME (_, handler) => handler ()
+                  fun errBlocked {errno: syserror,
+                                  handlers: (syserror * (unit -> 'a)) list}: 'a =
+                     err {default = fn () => raiseSys errno,
+                          errno = errno, handlers = handlers}
+                  fun errUnblocked
+                     {errno: syserror,
+                      handlers: (syserror * (unit -> 'a)) list}: 'a =
+                     err {default = fn () =>
+                          if restart andalso errno = intr andalso !restartFlag
+                             then if Thread.canHandle () = 0
+                                     then call errUnblocked
+                                     else let val finish = !blocker ()
+                                          in 
+                                             DynamicWind.wind
+                                             (fn () => call errBlocked, finish)
+                                          end
+                             else raiseSys errno,
+                          errno = errno, handlers = handlers}
+               in
+                  call errUnblocked
+               end
 
-	    local
-	       val simpleResult' = fn ({restart}, f) =>
-		  syscallErr 
-		  ({clear = false, restart = restart}, fn () => 
-		   let val return = f () 
-		   in {return = return, post = fn () => return, handlers = []}
-		   end)
-	    in
-	       val simpleResultRestart = fn f =>
-		  simpleResult' ({restart = true}, f)
-	       val simpleResult = fn f =>
-		  simpleResult' ({restart = false}, f)
-	    end
-	 
+            local
+               val simpleResult' = fn ({restart}, f) =>
+                  syscallErr 
+                  ({clear = false, restart = restart}, fn () => 
+                   let val return = f () 
+                   in {return = return, post = fn () => return, handlers = []}
+                   end)
+            in
+               val simpleResultRestart = fn f =>
+                  simpleResult' ({restart = true}, f)
+               val simpleResult = fn f =>
+                  simpleResult' ({restart = false}, f)
+            end
+         
             val simpleRestart = ignore o simpleResultRestart
-	    val simple = ignore o simpleResult
+            val simple = ignore o simpleResult
 
-	    val syscallRestart = fn f => 
-	       syscallErr 
-	       ({clear = false, restart = true}, fn () => 
-		let val (return, post) = f () 
-		in {return = return, post = post, handlers = []}
-		end)
-	    val syscall = fn f =>
-	       syscallErr 
-	       ({clear = false, restart = false}, fn () => 
-		let val (return, post) = f () 
-		in {return = return, post = post, handlers = []}
-		end)
-	 end
+            val syscallRestart = fn f => 
+               syscallErr 
+               ({clear = false, restart = true}, fn () => 
+                let val (return, post) = f () 
+                in {return = return, post = post, handlers = []}
+                end)
+            val syscall = fn f =>
+               syscallErr 
+               ({clear = false, restart = false}, fn () => 
+                let val (return, post) = f () 
+                in {return = return, post = post, handlers = []}
+                end)
+         end
    end

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/posix/file-sys.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/posix/file-sys.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/posix/file-sys.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -25,37 +25,37 @@
       val stderr: file_desc
 
       structure S: 
-	 sig
-	    eqtype mode
-	    include BIT_FLAGS where type flags = mode
+         sig
+            eqtype mode
+            include BIT_FLAGS where type flags = mode
 
-	    val irwxu: mode
-	    val irusr: mode
-	    val iwusr: mode
-	    val ixusr: mode
-	    val irwxg: mode
-	    val irgrp: mode
-	    val iwgrp: mode
-	    val ixgrp: mode
-	    val irwxo: mode
-	    val iroth: mode
-	    val iwoth: mode
-	    val ixoth: mode
-	    val isuid: mode
-	    val isgid: mode
-	 end
+            val irwxu: mode
+            val irusr: mode
+            val iwusr: mode
+            val ixusr: mode
+            val irwxg: mode
+            val irgrp: mode
+            val iwgrp: mode
+            val ixgrp: mode
+            val irwxo: mode
+            val iroth: mode
+            val iwoth: mode
+            val ixoth: mode
+            val isuid: mode
+            val isgid: mode
+         end
 
       structure O: 
-	 sig
-	   include BIT_FLAGS
+         sig
+           include BIT_FLAGS
 
            val append: flags
-	   val excl: flags
-	   val noctty: flags
-	   val nonblock: flags
-	   val sync: flags
-	   val trunc: flags
-	 end
+           val excl: flags
+           val noctty: flags
+           val nonblock: flags
+           val sync: flags
+           val trunc: flags
+         end
 
       datatype open_mode = O_RDONLY | O_WRONLY | O_RDWR
 
@@ -81,27 +81,27 @@
       val inoToWord: ino -> SysWord.word
 
       structure ST: 
-	 sig
-	    type stat
+         sig
+            type stat
 
-	    val isDir: stat -> bool
-	    val isChr: stat -> bool
-	    val isBlk: stat -> bool
-	    val isReg: stat -> bool
-	    val isFIFO: stat -> bool
-	    val isLink: stat -> bool
-	    val isSock: stat -> bool
-	    val mode: stat -> S.mode
-	    val ino: stat -> ino
-	    val dev: stat -> dev
-	    val nlink: stat -> int
-	    val uid: stat -> uid
-	    val gid: stat -> gid
-	    val size: stat -> Position.int
-	    val atime: stat -> Time.time
-	    val mtime: stat -> Time.time
-	    val ctime: stat -> Time.time
-	 end
+            val isDir: stat -> bool
+            val isChr: stat -> bool
+            val isBlk: stat -> bool
+            val isReg: stat -> bool
+            val isFIFO: stat -> bool
+            val isLink: stat -> bool
+            val isSock: stat -> bool
+            val mode: stat -> S.mode
+            val ino: stat -> ino
+            val dev: stat -> dev
+            val nlink: stat -> int
+            val uid: stat -> uid
+            val gid: stat -> gid
+            val size: stat -> Position.int
+            val atime: stat -> Time.time
+            val mtime: stat -> Time.time
+            val ctime: stat -> Time.time
+         end
 
       val stat: string -> ST.stat
       val lstat: string -> ST.stat

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/posix/file-sys.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/posix/file-sys.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/posix/file-sys.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 structure PosixFileSys: POSIX_FILE_SYS_EXTRA =
    struct
       structure Error = PosixError
@@ -13,15 +14,15 @@
        * instead of LargeInt.int.
        *)
       structure Time =
-	 struct
-	    open Time
+         struct
+            open Time
 
-	    val fromSeconds = fromSeconds o LargeInt.fromInt
+            val fromSeconds = fromSeconds o LargeInt.fromInt
 
-	    fun toSeconds t =
-	       LargeInt.toInt (Time.toSeconds t)
-	       handle Overflow => Error.raiseSys Error.inval
-	 end
+            fun toSeconds t =
+               LargeInt.toInt (Time.toSeconds t)
+               handle Overflow => Error.raiseSys Error.inval
+         end
       
       structure SysCall = Error.SysCall
       structure Prim = PosixPrimitive.FileSys
@@ -29,12 +30,12 @@
       structure Stat = Prim.Stat
       structure Flags = BitFlags
 
-      datatype file_desc = datatype Prim.file_desc
+      type file_desc = Prim.file_desc
       type uid = Prim.uid
       type gid = Prim.gid
 
-      fun fdToWord (FD n) = SysWord.fromInt n
-      val wordToFD = FD o SysWord.toInt
+      val fdToWord = PosixPrimitive.FileDesc.toWord
+      val wordToFD = PosixPrimitive.FileDesc.fromWord
       val fdToIOD = OS.IO.fromFD
       val iodToFD = SOME o OS.IO.toFD
 
@@ -43,211 +44,214 @@
       (*------------------------------------*)
 
       local
-	 structure Prim = Prim.Dirstream
-	 datatype dirstream = DS of Prim.dirstream option ref
+         structure Prim = Prim.Dirstream
+         datatype dirstream = DS of Prim.dirstream option ref
 
-	 fun get (DS r) =
-	    case !r of
-	       NONE => Error.raiseSys Error.badf
-	     | SOME d => d
+         fun get (DS r) =
+            case !r of
+               NONE => Error.raiseSys Error.badf
+             | SOME d => d
       in
-	 type dirstream = dirstream
-	    
-	 fun opendir s =
-	    let
-	       val s = NullString.nullTerm s
-	    in
-	       SysCall.syscall
-	       (fn () =>
-		let
-		   val d = Prim.opendir s
-		in
-		   (if Primitive.Pointer.isNull d then ~1 else 0,
-		    fn () => DS (ref (SOME d)))
-		end)
-	    end
+         type dirstream = dirstream
+            
+         fun opendir s =
+            let
+               val s = NullString.nullTerm s
+            in
+               SysCall.syscall
+               (fn () =>
+                let
+                   val d = Prim.opendir s
+                in
+                   (if Primitive.Pointer.isNull d then ~1 else 0,
+                    fn () => DS (ref (SOME d)))
+                end)
+            end
 
-	 fun readdir d =
-	    let
-	       val d = get d
-	       fun loop () =
-		  let
-		     val res =
-			SysCall.syscallErr
-			({clear = true, restart = false},
-			 fn () =>
-			 let
-			    val cs = Prim.readdir d
-			 in
-			    {return = if Primitive.Pointer.isNull cs
-					 then ~1
-				      else 0,
-			     post = fn () => SOME cs,
-			     handlers = [(Error.cleared, fn () => NONE),
-					 (* MinGW sets errno to ENOENT when it
-					  * returns NULL.
-					  *)
-					 (Error.noent, fn () => NONE)]}
-			 end)
-		  in
-		     case res of
-			NONE => NONE
-		      | SOME cs => 
-			   let
-			      val s = C.CS.toString cs
-			   in
-			      if s = "." orelse s = ".."
-				 then loop ()
-			      else SOME s
-			   end
-		  end
-	    in loop ()
-	    end
+         fun readdir d =
+            let
+               val d = get d
+               fun loop () =
+                  let
+                     val res =
+                        SysCall.syscallErr
+                        ({clear = true, restart = false},
+                         fn () =>
+                         let
+                            val cs = Prim.readdir d
+                         in
+                            {return = if Primitive.Pointer.isNull cs
+                                         then ~1
+                                      else 0,
+                             post = fn () => SOME cs,
+                             handlers = [(Error.cleared, fn () => NONE),
+                                         (* MinGW sets errno to ENOENT when it
+                                          * returns NULL.
+                                          *)
+                                         (Error.noent, fn () => NONE)]}
+                         end)
+                  in
+                     case res of
+                        NONE => NONE
+                      | SOME cs => 
+                           let
+                              val s = C.CS.toString cs
+                           in
+                              if s = "." orelse s = ".."
+                                 then loop ()
+                              else SOME s
+                           end
+                  end
+            in loop ()
+            end
 
-	 fun rewinddir d =
-	    let val d = get d
-	    in 
-	       SysCall.syscallErr
-	       ({clear = true, restart = false},
-		fn () =>
-		let val () = Prim.rewinddir d
-		in
-		   {return = ~1,
-		    post = fn () => (),
-		    handlers = [(Error.cleared, fn () => ())]}
-		end)
-	    end
+         fun rewinddir d =
+            let val d = get d
+            in 
+               SysCall.syscallErr
+               ({clear = true, restart = false},
+                fn () =>
+                let val () = Prim.rewinddir d
+                in
+                   {return = ~1,
+                    post = fn () => (),
+                    handlers = [(Error.cleared, fn () => ())]}
+                end)
+            end
 
-	 fun closedir (DS r) =
-	    case !r of
-	       NONE => ()
-	     | SOME d => (SysCall.simple (fn () => Prim.closedir d); r := NONE)
+         fun closedir (DS r) =
+            case !r of
+               NONE => ()
+             | SOME d => (SysCall.simple (fn () => Prim.closedir d); r := NONE)
       end
-	 
+         
       fun chdir s =
-	 SysCall.simple (fn () => Prim.chdir (NullString.nullTerm s))
+         SysCall.simple (fn () => Prim.chdir (NullString.nullTerm s))
 
       local
-	 val size: int ref = ref 1
-	 fun make () = Primitive.Array.array (!size)
-	 val buffer = ref (make ())
-	    
-	 fun extractToChar (a, c) =
-	    let
-	       val n = Array.length a
-	       (* find the null terminator *)
-	       fun loop i =
-		  if i >= n
-		     then raise Fail "String.extractFromC didn't find terminator"
-		  else if c = Array.sub (a, i)
-			  then i
-		       else loop (i + 1)
-	    in
-	       ArraySlice.vector (ArraySlice.slice (a, 0, SOME (loop 0)))
-	    end
-	 
-	 fun extract a = extractToChar (a, #"\000")
+         val size: int ref = ref 1
+         fun make () = Primitive.Array.array (!size)
+         val buffer = ref (make ())
+            
+         fun extractToChar (a, c) =
+            let
+               val n = Array.length a
+               (* find the null terminator *)
+               fun loop i =
+                  if i >= n
+                     then raise Fail "String.extractFromC didn't find terminator"
+                  else if c = Array.sub (a, i)
+                          then i
+                       else loop (i + 1)
+            in
+               ArraySlice.vector (ArraySlice.slice (a, 0, SOME (loop 0)))
+            end
+         
+         fun extract a = extractToChar (a, #"\000")
       in
-	 fun getcwd () =
-	    if Primitive.Pointer.isNull (Prim.getcwd (!buffer, !size))
-	       then (size := 2 * !size
-		     ; buffer := make ()
-		     ; getcwd ())
-	    else extract (!buffer)
+         fun getcwd () =
+            if Primitive.Pointer.isNull (Prim.getcwd (!buffer, !size))
+               then (size := 2 * !size
+                     ; buffer := make ()
+                     ; getcwd ())
+            else extract (!buffer)
       end
-	 
+
+      val FD = PosixPrimitive.FileDesc.fromInt
+
       val stdin = FD 0
       val stdout = FD 1
       val stderr = FD 2
 
       structure S =
-	 struct
-	    open S Flags
-	 end
+         struct
+            open S Flags
+         end
 
       structure O =
-	 struct
-	    open O Flags
-	 end
+         struct
+            open O Flags
+         end
 
       datatype open_mode = O_RDONLY | O_WRONLY | O_RDWR
 
       fun wordToOpenMode w =
-	 if w = o_rdonly then O_RDONLY
-	 else if w = o_wronly then O_WRONLY
-	      else if w = o_rdwr then O_RDWR
-		   else raise Fail "wordToOpenMode: unknown word"
-		      
+         if w = o_rdonly then O_RDONLY
+         else if w = o_wronly then O_WRONLY
+              else if w = o_rdwr then O_RDWR
+                   else raise Fail "wordToOpenMode: unknown word"
+                      
       val openModeToWord =
-	 fn O_RDONLY => o_rdonly
-	  | O_WRONLY => o_wronly
-	  | O_RDWR => o_rdwr
+         fn O_RDONLY => o_rdonly
+          | O_WRONLY => o_wronly
+          | O_RDWR => o_rdwr
 
       fun createf (pathname, openMode, flags, mode) =
-	 let
-	    val pathname = NullString.nullTerm pathname
-	    val flags = Flags.flags [openModeToWord openMode,
-				     flags,
-				     O.creat]
-	    val fd =
-	       SysCall.simpleResult
-	       (fn () => Prim.openn (pathname, flags, mode))
-	 in FD fd
-	 end
+         let
+            val pathname = NullString.nullTerm pathname
+            val flags = Flags.flags [openModeToWord openMode,
+                                     flags,
+                                     O.creat]
+            val fd =
+               SysCall.simpleResult
+               (fn () => Prim.openn (pathname, flags, mode))
+         in
+            FD fd
+         end
 
       fun openf (pathname, openMode, flags) =
-	 let 
-	    val pathname = NullString.nullTerm pathname
-	    val flags = Flags.flags [openModeToWord openMode, flags]
-	    val fd = 
-	       SysCall.simpleResult
-	       (fn () => Prim.openn (pathname, flags, Flags.empty))
-	 in FD fd
-	 end
-	 
+         let 
+            val pathname = NullString.nullTerm pathname
+            val flags = Flags.flags [openModeToWord openMode, flags]
+            val fd = 
+               SysCall.simpleResult
+               (fn () => Prim.openn (pathname, flags, Flags.empty))
+         in FD fd
+         end
+         
       fun creat (s, m) = createf (s, O_WRONLY, O.trunc, m)
 
       val umask = Prim.umask
 
  
       local
-	 fun wrap p arg = (SysCall.simple (fn () => p arg); ())
-	 fun wrapRestart p arg = (SysCall.simpleRestart (fn () => p arg); ())
-	 fun wrapOldNew p =
-	    wrap (fn {old,new} => p (NullString.nullTerm old,
-				     NullString.nullTerm new))
+         fun wrap p arg = (SysCall.simple (fn () => p arg); ())
+         fun wrapRestart p arg = (SysCall.simpleRestart (fn () => p arg); ())
+         fun wrapOldNew p =
+            wrap (fn {old,new} => p (NullString.nullTerm old,
+                                     NullString.nullTerm new))
       in
-	 val link = wrapOldNew Prim.link
-	 val mkdir = wrap (fn (p, m) => Prim.mkdir (NullString.nullTerm p, m))
-	 val mkfifo = wrap (fn (p, m) => Prim.mkfifo (NullString.nullTerm p, m))
-	 val unlink = wrap (Prim.unlink o NullString.nullTerm)
-	 val rmdir = wrap (Prim.rmdir o NullString.nullTerm)
-	 val rename = wrapOldNew Prim.rename
-	 val symlink = wrapOldNew Prim.symlink
-	 val chmod = wrap (fn (p, m) => Prim.chmod (NullString.nullTerm p, m))
-	 val fchmod = wrap (fn (FD n, m) => Prim.fchmod (n, m))
-	 val chown =
-	    wrap (fn (s, u, g) => Prim.chown (NullString.nullTerm s, u, g))
-	 val fchown = wrap (fn (FD n, u, g) => Prim.fchown (n, u, g))
-	 val ftruncate = wrapRestart (fn (FD n, pos) => Prim.ftruncate (n, pos))
-      end	    
+         val link = wrapOldNew Prim.link
+         val mkdir = wrap (fn (p, m) => Prim.mkdir (NullString.nullTerm p, m))
+         val mkfifo = wrap (fn (p, m) => Prim.mkfifo (NullString.nullTerm p, m))
+         val unlink = wrap (Prim.unlink o NullString.nullTerm)
+         val rmdir = wrap (Prim.rmdir o NullString.nullTerm)
+         val rename = wrapOldNew Prim.rename
+         val symlink = wrapOldNew Prim.symlink
+         val chmod = wrap (fn (p, m) => Prim.chmod (NullString.nullTerm p, m))
+         val fchmod = wrap Prim.fchmod 
+         val chown =
+            wrap (fn (s, u, g) => Prim.chown (NullString.nullTerm s, u, g))
+         val fchown = wrap Prim.fchown
+         val ftruncate = wrapRestart Prim.ftruncate
+      end           
 
       local
-	 val size: int = 1024
-	 val buf = Word8Array.array (size, 0w0)
+         val size: int = 1024
+         val buf = Word8Array.array (size, 0w0)
       in
-	 fun readlink (path: string): string =
-	    let 
-	       val path = NullString.nullTerm path
-	    in
-	       SysCall.syscall
-	       (fn () =>
-		let val len = Prim.readlink (path, Word8Array.toPoly buf, size)
-		in
-		   (len, fn () =>
-		    Byte.unpackString (Word8ArraySlice.slice (buf, 0, SOME len)))
-		end)
-	    end
+         fun readlink (path: string): string =
+            let 
+               val path = NullString.nullTerm path
+            in
+               SysCall.syscall
+               (fn () =>
+                let val len = Prim.readlink (path, Word8Array.toPoly buf, size)
+                in
+                   (len, fn () =>
+                    Byte.unpackString (Word8ArraySlice.slice (buf, 0, SOME len)))
+                end)
+            end
       end
 
       type dev = Prim.dev
@@ -260,144 +264,141 @@
       val inoToWord = SysWord.fromInt
 
       structure ST =
-	 struct
-	    datatype stat =
-	       T of {dev: dev,
-		     ino: ino,
-		     mode: S.mode,
-		     nlink: int,
-		     uid: uid,
-		     gid: gid,
-		     size: Position.int,
-		     atime: Time.time,
-		     mtime: Time.time,
-		     ctime: Time.time}
+         struct
+            datatype stat =
+               T of {dev: dev,
+                     ino: ino,
+                     mode: S.mode,
+                     nlink: int,
+                     uid: uid,
+                     gid: gid,
+                     size: Position.int,
+                     atime: Time.time,
+                     mtime: Time.time,
+                     ctime: Time.time}
 
-	    fun fromC (): stat =
-	       T {dev = Stat.dev (),
-		  ino = Stat.ino (),
-		  mode = Stat.mode (),
-		  nlink = Stat.nlink (),
-		  uid = Stat.uid (),
-		  gid = Stat.gid (),
-		  size = Stat.size (),
-		  atime = Time.fromSeconds (Stat.atime ()),
-		  mtime = Time.fromSeconds (Stat.mtime ()),
-		  ctime = Time.fromSeconds (Stat.ctime ())}
+            fun fromC (): stat =
+               T {dev = Stat.dev (),
+                  ino = Stat.ino (),
+                  mode = Stat.mode (),
+                  nlink = Stat.nlink (),
+                  uid = Stat.uid (),
+                  gid = Stat.gid (),
+                  size = Stat.size (),
+                  atime = Time.fromSeconds (Stat.atime ()),
+                  mtime = Time.fromSeconds (Stat.mtime ()),
+                  ctime = Time.fromSeconds (Stat.ctime ())}
 
-	    local
-	       fun make sel (T r) = sel r
-	    in
-	       val mode = make #mode
-	       val ino = make #ino
-	       val dev = make #dev
-	       val nlink = make #nlink
-	       val uid = make #uid
-	       val gid = make #gid
-	       val size = make #size
-	       val atime = make #atime
-	       val mtime = make #mtime
-	       val ctime = make #ctime
-	    end
+            local
+               fun make sel (T r) = sel r
+            in
+               val mode = make #mode
+               val ino = make #ino
+               val dev = make #dev
+               val nlink = make #nlink
+               val uid = make #uid
+               val gid = make #gid
+               val size = make #size
+               val atime = make #atime
+               val mtime = make #mtime
+               val ctime = make #ctime
+            end
 
-	    local
-	       fun make prim s = prim (mode s)
-	    in
-	       val isDir = make Prim.ST.isDir
-	       val isChr = make Prim.ST.isChr
-	       val isBlk = make Prim.ST.isBlk
-	       val isReg = make Prim.ST.isReg
-	       val isFIFO = make Prim.ST.isFIFO
-	       val isLink = make Prim.ST.isLink
-	       val isSock = make Prim.ST.isSock
-	    end
-	 end
+            local
+               fun make prim s = prim (mode s)
+            in
+               val isDir = make Prim.ST.isDir
+               val isChr = make Prim.ST.isChr
+               val isBlk = make Prim.ST.isBlk
+               val isReg = make Prim.ST.isReg
+               val isFIFO = make Prim.ST.isFIFO
+               val isLink = make Prim.ST.isLink
+               val isSock = make Prim.ST.isSock
+            end
+         end
 
       local
-	 fun make prim arg =
-	    SysCall.syscall
-	    (fn () =>
-	     (prim arg, fn () => 
-	      ST.fromC ()))
+         fun make prim arg =
+            SysCall.syscall (fn () => (prim arg, fn () => ST.fromC ()))
       in
-	 val stat = (make Prim.Stat.stat) o NullString.nullTerm
-	 val lstat = (make Prim.Stat.lstat) o NullString.nullTerm
-	 val fstat = (make Prim.Stat.fstat) o (fn FD fd => fd)
+         val stat = (make Prim.Stat.stat) o NullString.nullTerm
+         val lstat = (make Prim.Stat.lstat) o NullString.nullTerm
+         val fstat = make Prim.Stat.fstat
       end
 
       datatype access_mode = A_READ | A_WRITE | A_EXEC
 
       val conv_access_mode =
-	 fn A_READ => R_OK
-	  | A_WRITE => W_OK
-	  | A_EXEC => X_OK
+         fn A_READ => R_OK
+          | A_WRITE => W_OK
+          | A_EXEC => X_OK
 
       fun access (path: string, mode: access_mode list): bool =
-	 let 
-	    val mode = Flags.flags (F_OK :: (map conv_access_mode mode))
-	    val path = NullString.nullTerm path
-	 in 
-	    SysCall.syscallErr
-	    ({clear = false, restart = false},
-	     fn () =>
-	     let val return = Prim.access (path, mode)
-	     in
-		{return = return,
-		 post = fn () => true,
-		 handlers = [(Error.acces, fn () => false),
-			     (Error.loop, fn () => false),
-			     (Error.nametoolong, fn () => false),
-			     (Error.noent, fn () => false),
-			     (Error.notdir, fn () => false),
-			     (Error.rofs, fn () => false)]}
-	     end)
-	 end
+         let 
+            val mode = Flags.flags (F_OK :: (map conv_access_mode mode))
+            val path = NullString.nullTerm path
+         in 
+            SysCall.syscallErr
+            ({clear = false, restart = false},
+             fn () =>
+             let val return = Prim.access (path, mode)
+             in
+                {return = return,
+                 post = fn () => true,
+                 handlers = [(Error.acces, fn () => false),
+                             (Error.loop, fn () => false),
+                             (Error.nametoolong, fn () => false),
+                             (Error.noent, fn () => false),
+                             (Error.notdir, fn () => false),
+                             (Error.rofs, fn () => false)]}
+             end)
+         end
 
       local
-	 structure U = Prim.Utimbuf
+         structure U = Prim.Utimbuf
       in
-	 fun utime (f: string, opt: {actime: Time.time,
-				     modtime: Time.time} option): unit =
-	    let
-	       val (a, m) =
-		  case opt of
-		     NONE => let val t = Time.now ()
-			     in (t, t)
-			     end
-		   | SOME {actime = a, modtime = m} => (a, m)
-	       val a = Time.toSeconds a
-	       val m = Time.toSeconds m
-	       val f = NullString.nullTerm f
-	    in 
-	       SysCall.syscallRestart
-	       (fn () => 
-		(U.setActime a
-		 ; U.setModtime m
-		 ; (U.utime f, fn () => 
-		    ())))
-	    end
+         fun utime (f: string, opt: {actime: Time.time,
+                                     modtime: Time.time} option): unit =
+            let
+               val (a, m) =
+                  case opt of
+                     NONE => let val t = Time.now ()
+                             in (t, t)
+                             end
+                   | SOME {actime = a, modtime = m} => (a, m)
+               val a = Time.toSeconds a
+               val m = Time.toSeconds m
+               val f = NullString.nullTerm f
+            in 
+               SysCall.syscallRestart
+               (fn () => 
+                (U.setActime a
+                 ; U.setModtime m
+                 ; (U.utime f, fn () => 
+                    ())))
+            end
       end
 
       local
-	 fun convertProperty s =
-	    case List.find (fn (_, s') => s = s') properties of
-	       NONE => Error.raiseSys Error.inval
-	     | SOME (n, _) => n
+         fun convertProperty s =
+            case List.find (fn (_, s') => s = s') properties of
+               NONE => Error.raiseSys Error.inval
+             | SOME (n, _) => n
 
-	 fun make prim (f, s) =
-	    SysCall.syscallErr
-	    ({clear = true, restart = false},
-	     fn () =>
-	     let
-		val return = prim (f, convertProperty s)
-	     in
-		{return = return,
-		 post = fn () => SOME (SysWord.fromInt return),
-		 handlers = [(Error.cleared, fn () => NONE)]}
-	     end)
+         fun make prim (f, s) =
+            SysCall.syscallErr
+            ({clear = true, restart = false},
+             fn () =>
+             let
+                val return = prim (f, convertProperty s)
+             in
+                {return = return,
+                 post = fn () => SOME (SysWord.fromInt return),
+                 handlers = [(Error.cleared, fn () => NONE)]}
+             end)
       in
-	 val pathconf =
-	    make (fn (path, s) => Prim.pathconf (NullString.nullTerm path, s))
-	 val fpathconf = make (fn (FD n, s) => Prim.fpathconf (n, s))
+         val pathconf =
+            make (fn (path, s) => Prim.pathconf (NullString.nullTerm path, s))
+         val fpathconf = make Prim.fpathconf
       end
    end

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/posix/flags.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/posix/flags.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/posix/flags.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,14 +1,15 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 functor BitFlags(val all: SysWord.word): BIT_FLAGS_EXTRA =
    struct
       type flags = SysWord.word
-	 
+         
       val all: flags = all
       val empty: flags = 0w0
 

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/posix/io.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/posix/io.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/posix/io.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -16,23 +16,23 @@
       datatype whence = SEEK_SET | SEEK_CUR | SEEK_END
 
       structure FD:
-	 sig
-	    include BIT_FLAGS
+         sig
+            include BIT_FLAGS
 
             val cloexec: flags 
-	 end
+         end
       
       structure O:
-	 sig
-	    include BIT_FLAGS
+         sig
+            include BIT_FLAGS
 
             val append: flags 
-	    val nonblock: flags 
-	    val sync: flags 
-	 end
+            val nonblock: flags 
+            val sync: flags 
+         end
       
       datatype open_mode = O_RDONLY | O_WRONLY | O_RDWR
-	 
+         
       val dupfd: {old: file_desc, base: file_desc} -> file_desc 
       val getfd: file_desc -> FD.flags 
       val setfd: file_desc * FD.flags -> unit 
@@ -40,42 +40,42 @@
       val setfl: file_desc * O.flags -> unit 
       val lseek: file_desc * Position.int * whence -> Position.int 
       val fsync: file_desc -> unit
-	 
+         
       datatype lock_type = F_RDLCK | F_WRLCK | F_UNLCK
-	 
+         
       structure FLock:
-	 sig
-	    type flock
-	    val flock: {ltype: lock_type,
-			whence: whence,
-			start: Position.int,
-			len: Position.int,
-			pid: pid option} -> flock 
-	    val ltype: flock -> lock_type 
-	    val whence: flock -> whence 
-	    val start: flock -> Position.int 
-	    val len: flock -> Position.int 
-	    val pid: flock -> pid option 
-	 end
+         sig
+            type flock
+            val flock: {ltype: lock_type,
+                        whence: whence,
+                        start: Position.int,
+                        len: Position.int,
+                        pid: pid option} -> flock 
+            val ltype: flock -> lock_type 
+            val whence: flock -> whence 
+            val start: flock -> Position.int 
+            val len: flock -> Position.int 
+            val pid: flock -> pid option 
+         end
       
       val getlk: file_desc * FLock.flock -> FLock.flock 
       val setlk: file_desc * FLock.flock -> FLock.flock 
       val setlkw: file_desc * FLock.flock -> FLock.flock
 
       val mkBinReader: {fd: file_desc,
-			name: string,
-			initBlkMode: bool} -> BinPrimIO.reader
+                        name: string,
+                        initBlkMode: bool} -> BinPrimIO.reader
       val mkTextReader: {fd: file_desc,
-			 name: string,
-			 initBlkMode: bool} -> TextPrimIO.reader
+                         name: string,
+                         initBlkMode: bool} -> TextPrimIO.reader
       val mkBinWriter: {fd: file_desc,
-			name: string,
-			appendMode: bool,
-			initBlkMode: bool,
-			chunkSize: int} -> BinPrimIO.writer
+                        name: string,
+                        appendMode: bool,
+                        initBlkMode: bool,
+                        chunkSize: int} -> BinPrimIO.writer
       val mkTextWriter: {fd: file_desc,
-			 name: string,
-			 appendMode: bool,
-			 initBlkMode: bool,
-			 chunkSize: int} -> TextPrimIO.writer
+                         name: string,
+                         appendMode: bool,
+                         initBlkMode: bool,
+                         chunkSize: int} -> TextPrimIO.writer
    end

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/posix/io.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/posix/io.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/posix/io.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,9 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 structure PosixIO: POSIX_IO =
@@ -15,26 +15,28 @@
 structure SysCall = Error.SysCall
 structure FS = PosixFileSys
 
-datatype file_desc = datatype Prim.file_desc
+type file_desc = Prim.file_desc
 type pid = Pid.t
 
+val FD = PosixPrimitive.FileDesc.fromInt
+val unFD = PosixPrimitive.FileDesc.toInt
+   
 local
-   val a: PosixPrimitive.fd array = Array.array (2, 0)
+   val a: file_desc array = Array.array (2, FD 0)
 in
    fun pipe () =
       SysCall.syscall
       (fn () =>
        (Prim.pipe a,
-	fn () => {infd = FD (Array.sub (a, 0)),
-		  outfd = FD (Array.sub (a, 1))}))
+        fn () => {infd = Array.sub (a, 0),
+                  outfd = Array.sub (a, 1)}))
 end
 
-fun dup (FD fd) = FD (SysCall.simpleResult (fn () => Prim.dup fd))
+fun dup fd = FD (SysCall.simpleResult (fn () => Prim.dup fd))
 
-fun dup2 {old = FD old, new = FD new} =
-   SysCall.simple (fn () => Prim.dup2 (old, new))
+fun dup2 {new, old} = SysCall.simple (fn () => Prim.dup2 (old, new))
 
-fun close (FD fd) = SysCall.simpleRestart (fn () => Prim.close fd)
+fun close fd = SysCall.simpleRestart (fn () => Prim.close fd)
 
 structure FD =
    struct
@@ -44,33 +46,33 @@
 structure O = PosixFileSys.O
 
 datatype open_mode = datatype PosixFileSys.open_mode
-	 
-fun dupfd {old = FD old, base = FD base} =
+         
+fun dupfd {base, old} =
    FD (SysCall.simpleResultRestart 
-       (fn () => Prim.fcntl3 (old, F_DUPFD, base)))
+       (fn () => Prim.fcntl3 (old, F_DUPFD, unFD base)))
 
-fun getfd (FD fd) =
+fun getfd fd =
    Word.fromInt (SysCall.simpleResultRestart 
-		 (fn () => Prim.fcntl2 (fd, F_GETFD)))
+                 (fn () => Prim.fcntl2 (fd, F_GETFD)))
 
-fun setfd (FD fd, flags): unit =
+fun setfd (fd, flags): unit =
    SysCall.simpleRestart
    (fn () => Prim.fcntl3 (fd, F_SETFD, Word.toIntX flags))
-			    
-fun getfl (FD fd): O.flags * open_mode =
+                            
+fun getfl fd : O.flags * open_mode =
    let 
       val n =
-	 SysCall.simpleResultRestart (fn () => Prim.fcntl2 (fd, F_GETFL))
+         SysCall.simpleResultRestart (fn () => Prim.fcntl2 (fd, F_GETFL))
       val w = Word.fromInt n
       val flags = Word.andb (w, Word.notb O_ACCMODE)
       val mode = Word.andb (w, O_ACCMODE)
    in (flags, PosixFileSys.wordToOpenMode mode)
    end
       
-fun setfl (FD fd, flags: O.flags): unit  =
+fun setfl (fd, flags: O.flags): unit  =
    SysCall.simpleRestart
    (fn () => Prim.fcntl3 (fd, F_SETFL, Word.toIntX flags))
-	 
+         
 datatype whence = SEEK_SET | SEEK_CUR | SEEK_END
 
 val whenceToInt =
@@ -82,20 +84,20 @@
    if n = Prim.SEEK_SET
       then SEEK_SET
    else if n = Prim.SEEK_CUR
-	   then SEEK_CUR
-	else if n = Prim.SEEK_END
-		then SEEK_END
-	     else raise Fail "Posix.IO.intToWhence"
-		      
-fun lseek (FD fd, n: Position.int, w: whence): Position.int =
+           then SEEK_CUR
+        else if n = Prim.SEEK_END
+                then SEEK_END
+             else raise Fail "Posix.IO.intToWhence"
+                      
+fun lseek (fd, n: Position.int, w: whence): Position.int =
    SysCall.syscall
    (fn () =>
     let val n = Prim.lseek (fd, n, whenceToInt w)
     in (if n = ~1 then ~1 else 0, fn () => n)
     end)
-	 
-fun fsync (FD fd): unit = SysCall.simple (fn () => Prim.fsync fd)
-	 
+         
+fun fsync fd : unit = SysCall.simple (fn () => Prim.fsync fd)
+         
 datatype lock_type =
    F_RDLCK
   | F_WRLCK
@@ -110,19 +112,19 @@
    if n = Prim.F_RDLCK
       then F_RDLCK
    else if n = Prim.F_WRLCK
-	   then F_WRLCK
-	else if n = Prim.F_UNLCK
-		then F_UNLCK
-	     else raise Fail "Posix.IO.intToLockType"
-	 
+           then F_WRLCK
+        else if n = Prim.F_UNLCK
+                then F_UNLCK
+             else raise Fail "Posix.IO.intToLockType"
+         
 structure FLock =
    struct
       type flock = {ltype: lock_type,
-		    whence: whence,
-		    start: Position.int,
-		    len: Position.int,
-		    pid: pid option}
-			 
+                    whence: whence,
+                    start: Position.int,
+                    len: Position.int,
+                    pid: pid option}
+                         
       fun flock l = l
       val ltype: flock -> lock_type = #ltype
       val whence: flock -> whence = #whence
@@ -135,20 +137,20 @@
    structure P = Prim.FLock
    fun make
       (cmd, usepid)
-      (FD fd, {ltype, whence, start, len, ...}: FLock.flock)
+      (fd, {ltype, whence, start, len, ...}: FLock.flock)
       : FLock.flock  =
       SysCall.syscallRestart
       (fn () =>
        ((P.setType (lockTypeToInt ltype)
-	 ; P.setWhence (whenceToInt whence)
-	 ; P.setStart start
-	 ; P.setLen len
-	 ; P.fcntl (fd, cmd)), fn () => 
-	{ltype = intToLockType (P.typ ()),
-	 whence = intToWhence (P.whence ()),
-	 start = P.start (),
-	 len = P.len (),
-	 pid = if usepid then SOME (P.pid ()) else NONE}))
+         ; P.setWhence (whenceToInt whence)
+         ; P.setStart start
+         ; P.setLen len
+         ; P.fcntl (fd, cmd)), fn () => 
+        {ltype = intToLockType (P.typ ()),
+         whence = intToWhence (P.whence ()),
+         start = P.start (),
+         len = P.len (),
+         pid = if usepid then SOME (P.pid ()) else NONE}))
 in
    val getlk = make (F_GETLK, true)
    val setlk = make (F_SETLK, false)
@@ -170,226 +172,222 @@
    fun isReg fd = FS.ST.isReg(FS.fstat fd)
    fun posFns (closed, fd) = 
       if (isReg fd)
-	 then let
-		 val pos = ref pos0
-		 fun getPos () = !pos
-		 fun setPos p = (if !closed 
-				    then raise IO.ClosedStream 
-				 else ();
-				    pos := lseek(fd,p,SEEK_SET))
-		 fun endPos () = (if !closed 
-				     then raise IO.ClosedStream 
-				  else ();
-				     FS.ST.size(FS.fstat fd))
-		 fun verifyPos () = let
-				       val curPos = lseek(fd, pos0, SEEK_CUR)
-				    in
-				       pos := curPos; curPos
-				    end
-		 val _ = verifyPos ()
-	      in
-		 {pos = pos,
-		  getPos = SOME getPos,
-		  setPos = SOME setPos,
-		  endPos = SOME endPos,
-		  verifyPos = SOME verifyPos}
-	      end
+         then let
+                 val pos = ref pos0
+                 fun getPos () = !pos
+                 fun setPos p = (if !closed 
+                                    then raise IO.ClosedStream 
+                                 else ();
+                                    pos := lseek(fd,p,SEEK_SET))
+                 fun endPos () = (if !closed 
+                                     then raise IO.ClosedStream 
+                                  else ();
+                                     FS.ST.size(FS.fstat fd))
+                 fun verifyPos () = let
+                                       val curPos = lseek(fd, pos0, SEEK_CUR)
+                                    in
+                                       pos := curPos; curPos
+                                    end
+                 val _ = verifyPos ()
+              in
+                 {pos = pos,
+                  getPos = SOME getPos,
+                  setPos = SOME setPos,
+                  endPos = SOME endPos,
+                  verifyPos = SOME verifyPos}
+              end
       else {pos = ref pos0,
-	    getPos = NONE, 
-	    setPos = NONE, 
-	    endPos = NONE, 
-	    verifyPos = NONE}
+            getPos = NONE, 
+            setPos = NONE, 
+            endPos = NONE, 
+            verifyPos = NONE}
 
-   fun fdToInt (FD fd) = fd
-
    fun make {RD, WR, fromVector, read, setMode, toArraySlice, toVectorSlice,
-	     vectorLength, write, writeVec} =
+             vectorLength, write, writeVec} =
       let
-	 val setMode =
-	    fn fd =>
-	    if let
-		  open Primitive.MLton.Platform.OS
-	       in
-		  case host of
-		     MinGW => true
-		   | _ => false
-	       end
-	       then setMode fd
-	    else ()
-	 fun readArr (FD fd, sl): int =
-	    let
-	       val (buf, i, sz) = ArraySlice.base (toArraySlice sl)
-	    in
-	       SysCall.simpleResultRestart
-	       (fn () => read (fd, buf, i, sz))
-	    end
-	 fun readVec (FD fd, n) =
-	    let
-	       val a = Primitive.Array.array n
-	       val bytesRead = 
-		  SysCall.simpleResultRestart
-		  (fn () => read (fd, a, 0, n))
-	    in 
-	       fromVector
-	       (if n = bytesRead
-		   then Vector.fromArray a
-		else ArraySlice.vector (ArraySlice.slice
-					(a, 0, SOME bytesRead)))
-	    end
-	 fun writeArr (FD fd, sl) =
-	    let
-	       val (buf, i, sz) = ArraySlice.base (toArraySlice sl)
-	    in
-	       SysCall.simpleResultRestart
-	       (fn () => write (fd, buf, i, sz))
-	    end
-	 val writeVec =
-	    fn (FD fd, sl) =>
-	    let
-	       val (buf, i, sz) = VectorSlice.base (toVectorSlice sl)
-	    in
-	       SysCall.simpleResultRestart
-	       (fn () => writeVec (fd, buf, i, sz))
-	    end
-	 fun mkReader {fd, name, initBlkMode} =
-	    let
-	       val closed = ref false
-	       val {pos, getPos, setPos, endPos, verifyPos} =
-		  posFns (closed, fd)
-	       val blocking = ref initBlkMode
-	       fun blockingOn () = 
-		  (setfl(fd, O.flags[]); blocking := true)
-	       fun blockingOff () = 
-		  (setfl(fd, O.nonblock); blocking := false)
-	       fun ensureOpen () = 
-		  if !closed then raise IO.ClosedStream else ()
-	       fun incPos k = pos := Position.+ (!pos, Position.fromInt k)
-	       val readVec = fn n => 
-		  let val v = readVec (fd, n)
-		  in incPos (vectorLength v); v
-		  end
-	       val readArr = fn x => 
-		  let val k = readArr (fd, x)
-		  in incPos k; k
-		  end
-	       fun blockWrap f x =
-		  (ensureOpen ();
-		   if !blocking then () else blockingOn ();
-		      f x)
-	       fun noBlockWrap f x =
-		  (ensureOpen ();
-		   if !blocking then blockingOff () else ();
-		      (SOME (f x)
-		       handle (e as PosixError.SysErr (_, SOME cause)) =>
-			  if cause = PosixError.again then NONE else raise e))
-	       val close = 
-		  fn () => if !closed then () else (closed := true; close fd)
-	       val avail = 
-		  if isReg fd
-		     then fn () => if !closed 
-				      then SOME 0
-				   else SOME (Position.toInt
-					      (Position.-
-					       (FS.ST.size (FS.fstat fd),
-						!pos)))
-		  else fn () => if !closed then SOME 0 else NONE
-	       val () = setMode (fdToInt fd)
-	    in
-	       RD {avail = avail,
-		   block = NONE,
-		   canInput = NONE,
-		   chunkSize = Primitive.TextIO.bufSize,
-		   close = close,
-		   endPos = endPos,
-		   getPos = getPos,
-		   ioDesc = SOME (FS.fdToIOD fd),
-		   name = name,
-		   readArr = SOME (blockWrap readArr),
-		   readArrNB = SOME (noBlockWrap readArr),
-		   readVec = SOME (blockWrap readVec),
-		   readVecNB = SOME (noBlockWrap readVec),
-		   setPos = setPos,
-		   verifyPos = verifyPos}
-	    end
-	 fun mkWriter {fd, name, initBlkMode, appendMode, chunkSize} =
-	    let
-	       val closed = ref false
-	       val {pos, getPos, setPos, endPos, verifyPos} =
-		  posFns (closed, fd)
-	       fun incPos k = (pos := Position.+ (!pos, Position.fromInt k); k)
-	       val blocking = ref initBlkMode
-	       val appendFlgs = O.flags(if appendMode then [O.append] else [])
-	       fun updateStatus () = 
-		  let
-		     val flgs = if !blocking
-				   then appendFlgs
-				else O.flags [O.nonblock, appendFlgs]
-		  in
-		     setfl(fd, flgs)
-		  end
-	       fun ensureOpen () = 
-		  if !closed then raise IO.ClosedStream else ()
-	       fun ensureBlock x = 
-		  if !blocking then () else (blocking := x; updateStatus ())
-	       fun putV x = incPos (writeVec x)
-	       fun putA x = incPos (writeArr x)
-	       fun write (put, block) arg = 
-		  (ensureOpen (); ensureBlock block; put (fd, arg))
-	       fun handleBlock writer arg = 
-		  SOME(writer arg)
-		  handle (e as PosixError.SysErr (_, SOME cause)) =>
-		     if cause = PosixError.again then NONE else raise e
-	       val close = 
-		  fn () => if !closed then () else (closed := true; close fd)
-	       val () = setMode (fdToInt fd)
-	    in
-	       WR {block = NONE,
-		   canOutput = NONE,
-		   chunkSize = chunkSize,
-		   close = close,
-		   endPos = endPos,
-		   getPos = getPos,
-		   ioDesc = SOME (FS.fdToIOD fd),
-		   name = name,
-		   setPos = setPos,
-		   verifyPos = verifyPos,
-		   writeArr = SOME (write (putA, true)),
-		   writeArrNB = SOME (handleBlock (write (putA, false))),
-		   writeVec = SOME (write (putV, true)),
-		   writeVecNB = SOME (handleBlock (write (putV, false)))}
-	    end
+         val setMode =
+            fn fd =>
+            if let
+                  open Primitive.MLton.Platform.OS
+               in
+                  case host of
+                     MinGW => true
+                   | _ => false
+               end
+               then setMode fd
+            else ()
+         fun readArr (fd, sl): int =
+            let
+               val (buf, i, sz) = ArraySlice.base (toArraySlice sl)
+            in
+               SysCall.simpleResultRestart (fn () => read (fd, buf, i, sz))
+            end
+         fun readVec (fd, n) =
+            let
+               val a = Primitive.Array.array n
+               val bytesRead = 
+                  SysCall.simpleResultRestart (fn () => read (fd, a, 0, n))
+            in 
+               fromVector
+               (if n = bytesRead
+                   then Vector.fromArray a
+                else ArraySlice.vector (ArraySlice.slice
+                                        (a, 0, SOME bytesRead)))
+            end
+         fun writeArr (fd, sl) =
+            let
+               val (buf, i, sz) = ArraySlice.base (toArraySlice sl)
+            in
+               SysCall.simpleResultRestart
+               (fn () => write (fd, buf, i, sz))
+            end
+         val writeVec =
+            fn (fd, sl) =>
+            let
+               val (buf, i, sz) = VectorSlice.base (toVectorSlice sl)
+            in
+               SysCall.simpleResultRestart
+               (fn () => writeVec (fd, buf, i, sz))
+            end
+         fun mkReader {fd, name, initBlkMode} =
+            let
+               val closed = ref false
+               val {pos, getPos, setPos, endPos, verifyPos} =
+                  posFns (closed, fd)
+               val blocking = ref initBlkMode
+               fun blockingOn () = 
+                  (setfl(fd, O.flags[]); blocking := true)
+               fun blockingOff () = 
+                  (setfl(fd, O.nonblock); blocking := false)
+               fun ensureOpen () = 
+                  if !closed then raise IO.ClosedStream else ()
+               fun incPos k = pos := Position.+ (!pos, Position.fromInt k)
+               val readVec = fn n => 
+                  let val v = readVec (fd, n)
+                  in incPos (vectorLength v); v
+                  end
+               val readArr = fn x => 
+                  let val k = readArr (fd, x)
+                  in incPos k; k
+                  end
+               fun blockWrap f x =
+                  (ensureOpen ();
+                   if !blocking then () else blockingOn ();
+                      f x)
+               fun noBlockWrap f x =
+                  (ensureOpen ();
+                   if !blocking then blockingOff () else ();
+                      (SOME (f x)
+                       handle (e as PosixError.SysErr (_, SOME cause)) =>
+                          if cause = PosixError.again then NONE else raise e))
+               val close = 
+                  fn () => if !closed then () else (closed := true; close fd)
+               val avail = 
+                  if isReg fd
+                     then fn () => if !closed 
+                                      then SOME 0
+                                   else SOME (Position.toInt
+                                              (Position.-
+                                               (FS.ST.size (FS.fstat fd),
+                                                !pos)))
+                  else fn () => if !closed then SOME 0 else NONE
+               val () = setMode fd
+            in
+               RD {avail = avail,
+                   block = NONE,
+                   canInput = NONE,
+                   chunkSize = Primitive.TextIO.bufSize,
+                   close = close,
+                   endPos = endPos,
+                   getPos = getPos,
+                   ioDesc = SOME (FS.fdToIOD fd),
+                   name = name,
+                   readArr = SOME (blockWrap readArr),
+                   readArrNB = SOME (noBlockWrap readArr),
+                   readVec = SOME (blockWrap readVec),
+                   readVecNB = SOME (noBlockWrap readVec),
+                   setPos = setPos,
+                   verifyPos = verifyPos}
+            end
+         fun mkWriter {fd, name, initBlkMode, appendMode, chunkSize} =
+            let
+               val closed = ref false
+               val {pos, getPos, setPos, endPos, verifyPos} =
+                  posFns (closed, fd)
+               fun incPos k = (pos := Position.+ (!pos, Position.fromInt k); k)
+               val blocking = ref initBlkMode
+               val appendFlgs = O.flags(if appendMode then [O.append] else [])
+               fun updateStatus () = 
+                  let
+                     val flgs = if !blocking
+                                   then appendFlgs
+                                else O.flags [O.nonblock, appendFlgs]
+                  in
+                     setfl(fd, flgs)
+                  end
+               fun ensureOpen () = 
+                  if !closed then raise IO.ClosedStream else ()
+               fun ensureBlock x = 
+                  if !blocking then () else (blocking := x; updateStatus ())
+               fun putV x = incPos (writeVec x)
+               fun putA x = incPos (writeArr x)
+               fun write (put, block) arg = 
+                  (ensureOpen (); ensureBlock block; put (fd, arg))
+               fun handleBlock writer arg = 
+                  SOME(writer arg)
+                  handle (e as PosixError.SysErr (_, SOME cause)) =>
+                     if cause = PosixError.again then NONE else raise e
+               val close = 
+                  fn () => if !closed then () else (closed := true; close fd)
+               val () = setMode fd
+            in
+               WR {block = NONE,
+                   canOutput = NONE,
+                   chunkSize = chunkSize,
+                   close = close,
+                   endPos = endPos,
+                   getPos = getPos,
+                   ioDesc = SOME (FS.fdToIOD fd),
+                   name = name,
+                   setPos = setPos,
+                   verifyPos = verifyPos,
+                   writeArr = SOME (write (putA, true)),
+                   writeArrNB = SOME (handleBlock (write (putA, false))),
+                   writeVec = SOME (write (putV, true)),
+                   writeVecNB = SOME (handleBlock (write (putV, false)))}
+            end
       in
-	 {mkReader = mkReader,
-	  mkWriter = mkWriter,
-	  readArr = readArr,
-	  readVec = readVec,
-	  writeArr = writeArr,
-	  writeVec = writeVec}
+         {mkReader = mkReader,
+          mkWriter = mkWriter,
+          readArr = readArr,
+          readVec = readVec,
+          writeArr = writeArr,
+          writeVec = writeVec}
       end
 in
    val {mkReader = mkBinReader, mkWriter = mkBinWriter,
-	readArr, readVec, writeArr, writeVec} =
+        readArr, readVec, writeArr, writeVec} =
       make {RD = BinPrimIO.RD,
-	    WR = BinPrimIO.WR,
-	    fromVector = Word8Vector.fromPoly,
-	    read = readWord8,
-	    setMode = Prim.setbin,
-	    toArraySlice = Word8ArraySlice.toPoly,
-	    toVectorSlice = Word8VectorSlice.toPoly,
-	    vectorLength = Word8Vector.length,
-	    write = writeWord8,
-	    writeVec = writeWord8Vec}
+            WR = BinPrimIO.WR,
+            fromVector = Word8Vector.fromPoly,
+            read = readWord8,
+            setMode = Prim.setbin,
+            toArraySlice = Word8ArraySlice.toPoly,
+            toVectorSlice = Word8VectorSlice.toPoly,
+            vectorLength = Word8Vector.length,
+            write = writeWord8,
+            writeVec = writeWord8Vec}
    val {mkReader = mkTextReader, mkWriter = mkTextWriter, ...} =
       make {RD = TextPrimIO.RD,
-	    WR = TextPrimIO.WR,
-	    fromVector = fn v => v,
-	    read = readChar,
-	    setMode = Prim.settext,
-	    toArraySlice = CharArraySlice.toPoly,
-	    toVectorSlice = CharVectorSlice.toPoly,
-	    vectorLength = CharVector.length,
-	    write = writeChar,
-	    writeVec = writeCharVec}
+            WR = TextPrimIO.WR,
+            fromVector = fn v => v,
+            read = readChar,
+            setMode = Prim.settext,
+            toArraySlice = CharArraySlice.toPoly,
+            toVectorSlice = CharVectorSlice.toPoly,
+            vectorLength = CharVector.length,
+            write = writeChar,
+            writeVec = writeCharVec}
 end
 
 end

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/posix/posix.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/posix/posix.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/posix/posix.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -10,7 +10,7 @@
       structure TTY: POSIX_TTY
 
       sharing type FileSys.file_desc = ProcEnv.file_desc = IO.file_desc
-	 = TTY.file_desc
+         = TTY.file_desc
       sharing type ProcEnv.gid = FileSys.gid = SysDB.gid
       sharing type FileSys.open_mode = IO.open_mode
       sharing type Process.pid = ProcEnv.pid = IO.pid = TTY.pid
@@ -30,7 +30,7 @@
       structure TTY: POSIX_TTY
 
       sharing type FileSys.file_desc = ProcEnv.file_desc = IO.file_desc
-	 = TTY.file_desc
+         = TTY.file_desc
       sharing type ProcEnv.gid = FileSys.gid = SysDB.gid
       sharing type FileSys.open_mode = IO.open_mode
       sharing type Process.pid = ProcEnv.pid = IO.pid = TTY.pid

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/posix/posix.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/posix/posix.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/posix/posix.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 structure Posix: POSIX_EXTRA =
    struct
       structure Error = PosixError
@@ -12,7 +13,7 @@
       structure Signal = PosixSignal
 
       structure Process = PosixProcess
-	 
+         
       structure ProcEnv = PosixProcEnv
       
       structure FileSys = PosixFileSys

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/posix/primitive.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/posix/primitive.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/posix/primitive.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,721 +1,758 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 structure PosixPrimitive =
    struct
       type cstring = Pointer.t
       type cstringArray = Pointer.t
 
-      type fd = int
       type uid = word
       type gid = word
       type size = int
       type ssize = int
       type mode = word
       type time = int
-      datatype file_desc = FD of int
-	 
+
+      structure FileDesc = Primitive.FileDesc
+      type file_desc = FileDesc.t
+      type fd = file_desc
+         
       structure Error =
-	 struct
-	    type syserror = int
+         struct
+            type syserror = int
 
-	    val getErrno = _import "Posix_Error_getErrno": unit -> int;
-	    val clearErrno = _import "Posix_Error_clearErrno": unit -> unit;
-	    val strerror = _import "Posix_Error_strerror": syserror -> cstring;
+            val getErrno = _import "Posix_Error_getErrno": unit -> int;
+            val clearErrno = _import "Posix_Error_clearErrno": unit -> unit;
+            val strerror = _import "Posix_Error_strerror": syserror -> cstring;
 
-	    val acces = _const "Posix_Error_acces": syserror;
-	    val again = _const "Posix_Error_again": syserror;
-	    val badf = _const "Posix_Error_badf": syserror;
-	    val badmsg = _const "Posix_Error_badmsg": syserror;
-	    val busy = _const "Posix_Error_busy": syserror;
-	    val canceled = _const "Posix_Error_canceled": syserror;
-	    val child = _const "Posix_Error_child": syserror;
-	    val deadlk = _const "Posix_Error_deadlk": syserror;
-	    val dom = _const "Posix_Error_dom": syserror;
-	    val exist = _const "Posix_Error_exist": syserror;
-	    val fault = _const "Posix_Error_fault": syserror;
-	    val fbig = _const "Posix_Error_fbig": syserror;
-	    val inprogress = _const "Posix_Error_inprogress": syserror;
-	    val intr = _const "Posix_Error_intr": syserror;
-	    val inval = _const "Posix_Error_inval": syserror;
-	    val io = _const "Posix_Error_io": syserror;
-	    val isdir = _const "Posix_Error_isdir": syserror;
-	    val loop = _const "Posix_Error_loop": syserror;
-	    val mfile = _const "Posix_Error_mfile": syserror;
-	    val mlink = _const "Posix_Error_mlink": syserror;
-	    val msgsize = _const "Posix_Error_msgsize": syserror;
-	    val nametoolong = _const "Posix_Error_nametoolong": syserror;
-	    val nfile = _const "Posix_Error_nfile": syserror;
-	    val nodev = _const "Posix_Error_nodev": syserror;
-	    val noent = _const "Posix_Error_noent": syserror;
-	    val noexec = _const "Posix_Error_noexec": syserror;
-	    val nolck = _const "Posix_Error_nolck": syserror;
-	    val nomem = _const "Posix_Error_nomem": syserror;
-	    val nospc = _const "Posix_Error_nospc": syserror;
-	    val nosys = _const "Posix_Error_nosys": syserror;
-	    val notdir = _const "Posix_Error_notdir": syserror;
-	    val notempty = _const "Posix_Error_notempty": syserror;
-	    val notsup = _const "Posix_Error_notsup": syserror;
-	    val notty = _const "Posix_Error_notty": syserror;
-	    val nxio = _const "Posix_Error_nxio": syserror;
-	    val perm = _const "Posix_Error_perm": syserror;
-	    val pipe = _const "Posix_Error_pipe": syserror;
-	    val range = _const "Posix_Error_range": syserror;
-	    val rofs = _const "Posix_Error_rofs": syserror;
-	    val spipe = _const "Posix_Error_spipe": syserror;
-	    val srch = _const "Posix_Error_srch": syserror;
-	    val toobig = _const "Posix_Error_toobig": syserror;
-	    val xdev = _const "Posix_Error_xdev": syserror;
+            val acces = _const "Posix_Error_acces": syserror;
+            val again = _const "Posix_Error_again": syserror;
+            val badf = _const "Posix_Error_badf": syserror;
+            val badmsg = _const "Posix_Error_badmsg": syserror;
+            val busy = _const "Posix_Error_busy": syserror;
+            val canceled = _const "Posix_Error_canceled": syserror;
+            val child = _const "Posix_Error_child": syserror;
+            val deadlk = _const "Posix_Error_deadlk": syserror;
+            val dom = _const "Posix_Error_dom": syserror;
+            val exist = _const "Posix_Error_exist": syserror;
+            val fault = _const "Posix_Error_fault": syserror;
+            val fbig = _const "Posix_Error_fbig": syserror;
+            val inprogress = _const "Posix_Error_inprogress": syserror;
+            val intr = _const "Posix_Error_intr": syserror;
+            val inval = _const "Posix_Error_inval": syserror;
+            val io = _const "Posix_Error_io": syserror;
+            val isdir = _const "Posix_Error_isdir": syserror;
+            val loop = _const "Posix_Error_loop": syserror;
+            val mfile = _const "Posix_Error_mfile": syserror;
+            val mlink = _const "Posix_Error_mlink": syserror;
+            val msgsize = _const "Posix_Error_msgsize": syserror;
+            val nametoolong = _const "Posix_Error_nametoolong": syserror;
+            val nfile = _const "Posix_Error_nfile": syserror;
+            val nodev = _const "Posix_Error_nodev": syserror;
+            val noent = _const "Posix_Error_noent": syserror;
+            val noexec = _const "Posix_Error_noexec": syserror;
+            val nolck = _const "Posix_Error_nolck": syserror;
+            val nomem = _const "Posix_Error_nomem": syserror;
+            val nospc = _const "Posix_Error_nospc": syserror;
+            val nosys = _const "Posix_Error_nosys": syserror;
+            val notdir = _const "Posix_Error_notdir": syserror;
+            val notempty = _const "Posix_Error_notempty": syserror;
+            val notsup = _const "Posix_Error_notsup": syserror;
+            val notty = _const "Posix_Error_notty": syserror;
+            val nxio = _const "Posix_Error_nxio": syserror;
+            val perm = _const "Posix_Error_perm": syserror;
+            val pipe = _const "Posix_Error_pipe": syserror;
+            val range = _const "Posix_Error_range": syserror;
+            val rofs = _const "Posix_Error_rofs": syserror;
+            val spipe = _const "Posix_Error_spipe": syserror;
+            val srch = _const "Posix_Error_srch": syserror;
+            val toobig = _const "Posix_Error_toobig": syserror;
+            val xdev = _const "Posix_Error_xdev": syserror;
 
-	    val errorNames =
-	       [
-		(acces, "acces"),
-		(again, "again"),
-		(badf, "badf"),
-		(badmsg, "badmsg"),
-		(busy, "busy"),
-		(canceled, "canceled"),
-		(child, "child"),
-		(deadlk, "deadlk"),
-		(dom, "dom"),
-		(exist, "exist"),
-		(fault, "fault"),
-		(fbig, "fbig"),
-		(inprogress, "inprogress"),
-		(intr, "intr"),
-		(inval, "inval"),
-		(io, "io"),
-		(isdir, "isdir"),
-		(loop, "loop"),
-		(mfile, "mfile"),
-		(mlink, "mlink"),
-		(msgsize, "msgsize"),
-		(nametoolong, "nametoolong"),
-		(nfile, "nfile"),
-		(nodev, "nodev"),
-		(noent, "noent"),
-		(noexec, "noexec"),
-		(nolck, "nolck"),
-		(nomem, "nomem"),
-		(nospc, "nospc"),
-		(nosys, "nosys"),
-		(notdir, "notdir"),
-		(notempty, "notempty"),
-		(notsup, "notsup"),
-		(notty, "notty"),
-		(nxio, "nxio"),
-		(perm, "perm"),
-		(pipe, "pipe"),
-		(range, "range"),
-		(rofs, "rofs"),
-		(spipe, "spipe"),
-		(srch, "srch"),
-		(toobig, "toobig"),
-		(xdev, "xdev")
-		]
-	 end
+            val errorNames =
+               [
+                (acces, "acces"),
+                (again, "again"),
+                (badf, "badf"),
+                (badmsg, "badmsg"),
+                (busy, "busy"),
+                (canceled, "canceled"),
+                (child, "child"),
+                (deadlk, "deadlk"),
+                (dom, "dom"),
+                (exist, "exist"),
+                (fault, "fault"),
+                (fbig, "fbig"),
+                (inprogress, "inprogress"),
+                (intr, "intr"),
+                (inval, "inval"),
+                (io, "io"),
+                (isdir, "isdir"),
+                (loop, "loop"),
+                (mfile, "mfile"),
+                (mlink, "mlink"),
+                (msgsize, "msgsize"),
+                (nametoolong, "nametoolong"),
+                (nfile, "nfile"),
+                (nodev, "nodev"),
+                (noent, "noent"),
+                (noexec, "noexec"),
+                (nolck, "nolck"),
+                (nomem, "nomem"),
+                (nospc, "nospc"),
+                (nosys, "nosys"),
+                (notdir, "notdir"),
+                (notempty, "notempty"),
+                (notsup, "notsup"),
+                (notty, "notty"),
+                (nxio, "nxio"),
+                (perm, "perm"),
+                (pipe, "pipe"),
+                (range, "range"),
+                (rofs, "rofs"),
+                (spipe, "spipe"),
+                (srch, "srch"),
+                (toobig, "toobig"),
+                (xdev, "xdev")
+                ]
+         end
       
       structure Signal =
-	 struct
-	    open Primitive.Signal
-	       
-	    val abrt = _const "Posix_Signal_abrt": t;
-	    val alrm = _const "Posix_Signal_alrm": t;
-	    val bus = _const "Posix_Signal_bus": t;
-	    val chld = _const "Posix_Signal_chld": t;
-	    val cont = _const "Posix_Signal_cont": t;
-	    val fpe = _const "Posix_Signal_fpe": t;
-	    val hup = _const "Posix_Signal_hup": t;
-	    val ill = _const "Posix_Signal_ill": t;
-	    val int = _const "Posix_Signal_int": t;
-	    val kill = _const "Posix_Signal_kill": t;
-	    val pipe = _const "Posix_Signal_pipe": t;
-	    val prof = _const "Posix_Signal_prof": t;
-	    val quit = _const "Posix_Signal_quit": t;
-	    val segv = _const "Posix_Signal_segv": t;
-	    val stop = _const "Posix_Signal_stop": t;
-	    val term = _const "Posix_Signal_term": t;
-	    val tstp = _const "Posix_Signal_tstp": t;
-	    val ttin = _const "Posix_Signal_ttin": t;
-	    val ttou = _const "Posix_Signal_ttou": t;
-	    val usr1 = _const "Posix_Signal_usr1": t;
-	    val usr2 = _const "Posix_Signal_usr2": t;
-	    val vtalrm = _const "Posix_Signal_vtalrm": t;
+         struct
+            open Primitive.Signal
+               
+            val abrt = _const "Posix_Signal_abrt": t;
+            val alrm = _const "Posix_Signal_alrm": t;
+            val bus = _const "Posix_Signal_bus": t;
+            val chld = _const "Posix_Signal_chld": t;
+            val cont = _const "Posix_Signal_cont": t;
+            val fpe = _const "Posix_Signal_fpe": t;
+            val hup = _const "Posix_Signal_hup": t;
+            val ill = _const "Posix_Signal_ill": t;
+            val int = _const "Posix_Signal_int": t;
+            val kill = _const "Posix_Signal_kill": t;
+            val pipe = _const "Posix_Signal_pipe": t;
+            val prof = _const "Posix_Signal_prof": t;
+            val quit = _const "Posix_Signal_quit": t;
+            val segv = _const "Posix_Signal_segv": t;
+            val stop = _const "Posix_Signal_stop": t;
+            val term = _const "Posix_Signal_term": t;
+            val tstp = _const "Posix_Signal_tstp": t;
+            val ttin = _const "Posix_Signal_ttin": t;
+            val ttou = _const "Posix_Signal_ttou": t;
+            val usr1 = _const "Posix_Signal_usr1": t;
+            val usr2 = _const "Posix_Signal_usr2": t;
+            val vtalrm = _const "Posix_Signal_vtalrm": t;
 
-	    val block = _const "Posix_Signal_block": how;
-	    val default = _import "Posix_Signal_default": t -> int;
-	    val handleGC = _import "Posix_Signal_handleGC": unit -> unit;
-	    val handlee = _import "Posix_Signal_handle": t -> int;
-	    val ignore = _import "Posix_Signal_ignore": t -> int;
-	    val isDefault =
-	       _import "Posix_Signal_isDefault": t * bool ref -> int;
-	    val isGCPending = _import "Posix_Signal_isGCPending": unit -> bool;
-	    val isPending = _import "Posix_Signal_isPending": t -> bool;
-	    val numSignals = _const "Posix_Signal_numSignals": int;
-	    val resetPending = _import "Posix_Signal_resetPending": unit -> unit;
-	    val setmask = _const "Posix_Signal_setmask": how;
-	    val sigaddset = _import "Posix_Signal_sigaddset": t -> int;
-	    val sigdelset = _import "Posix_Signal_sigdelset": t -> int;
-	    val sigemptyset = _import "Posix_Signal_sigemptyset": unit -> int;
-	    val sigfillset = _import "Posix_Signal_sigfillset": unit -> int;
-	    val sigismember = _import "Posix_Signal_sigismember": t -> int;
-	    val sigprocmask = _import "Posix_Signal_sigprocmask": how -> int;
-	    val suspend = _import "Posix_Signal_suspend": unit -> unit;
-	    val unblock = _const "Posix_Signal_unblock": how;
-	 end
+            val block = _const "Posix_Signal_block": how;
+            val default = _import "Posix_Signal_default": t -> int;
+            val handleGC = _import "Posix_Signal_handleGC": unit -> unit;
+            val handlee = _import "Posix_Signal_handle": t -> int;
+            val ignore = _import "Posix_Signal_ignore": t -> int;
+            val isDefault =
+               _import "Posix_Signal_isDefault": t * bool ref -> int;
+            val isGCPending = _import "Posix_Signal_isGCPending": unit -> bool;
+            val isPending = _import "Posix_Signal_isPending": t -> bool;
+            val numSignals = _const "Posix_Signal_numSignals": int;
+            val resetPending = _import "Posix_Signal_resetPending": unit -> unit;
+            val setmask = _const "Posix_Signal_setmask": how;
+            val sigaddset = _import "Posix_Signal_sigaddset": t -> int;
+            val sigdelset = _import "Posix_Signal_sigdelset": t -> int;
+            val sigemptyset = _import "Posix_Signal_sigemptyset": unit -> int;
+            val sigfillset = _import "Posix_Signal_sigfillset": unit -> int;
+            val sigismember = _import "Posix_Signal_sigismember": t -> int;
+            val sigprocmask = _import "Posix_Signal_sigprocmask": how -> int;
+            val suspend = _import "Posix_Signal_suspend": unit -> unit;
+            val unblock = _const "Posix_Signal_unblock": how;
+         end
       
       structure Process =
-	 struct
-	    val wnohang = _const "Posix_Process_wnohang": word;
-	    structure W =
-	       struct
-		  type flags = word
-		  val untraced = _const "Posix_Process_W_untraced": flags;
-	       end
+         struct
+            val wnohang = _const "Posix_Process_wnohang": word;
+            structure W =
+               struct
+                  type flags = word
+                  val untraced = _const "Posix_Process_W_untraced": flags;
+               end
 
-	    structure Status = Primitive.Status
-	    
-	    val alarm = _import "Posix_Process_alarm": int -> int;
-	    val exece =
-	       _import "Posix_Process_exece"
-	       : NullString.t * NullString.t array * NullString.t array -> int;
-	    val execp =
-	       _import "Posix_Process_execp"
-	       : NullString.t * NullString.t array -> int;
-	    val exit = _import "Posix_Process_exit": int -> unit;
-	    val exitStatus = _import "Posix_Process_exitStatus": Status.t -> int;
-	    val fork = _import "Posix_Process_fork": unit -> Pid.t;
-	    val ifExited = _import "Posix_Process_ifExited": Status.t -> bool;
-	    val ifSignaled = _import "Posix_Process_ifSignaled"
-	       : Status.t -> bool;
-	    val ifStopped = _import "Posix_Process_ifStopped": Status.t -> bool;
-	    val kill = _import "Posix_Process_kill": Pid.t * Signal.t -> int;
-	    val pause = _import "Posix_Process_pause": unit -> int;
-	    val sleep = _import "Posix_Process_sleep": int -> int;
-	    val stopSig = _import "Posix_Process_stopSig": Status.t -> Signal.t;
-	    val termSig = _import "Posix_Process_termSig": Status.t -> Signal.t;
-	    val waitpid =
-	       _import "Posix_Process_waitpid"
-	       : Pid.t * Status.t ref * int -> Pid.t;
-	 end
+            structure Status = Primitive.Status
+            
+            val alarm = _import "Posix_Process_alarm": int -> int;
+            val exece =
+               _import "Posix_Process_exece"
+               : NullString.t * NullString.t array * NullString.t array -> int;
+            val execp =
+               _import "Posix_Process_execp"
+               : NullString.t * NullString.t array -> int;
+            val exit = _import "Posix_Process_exit": int -> unit;
+            val exitStatus = _import "Posix_Process_exitStatus": Status.t -> int;
+            val fork = _import "Posix_Process_fork": unit -> Pid.t;
+            val ifExited = _import "Posix_Process_ifExited": Status.t -> bool;
+            val ifSignaled = _import "Posix_Process_ifSignaled"
+               : Status.t -> bool;
+            val ifStopped = _import "Posix_Process_ifStopped": Status.t -> bool;
+            val kill = _import "Posix_Process_kill": Pid.t * Signal.t -> int;
+            val nanosleep =
+               _import "Posix_Process_nanosleep": int ref * int ref -> int;
+            val pause = _import "Posix_Process_pause": unit -> int;
+(*          val sleep = _import "Posix_Process_sleep": int -> int; *)
+            val stopSig = _import "Posix_Process_stopSig": Status.t -> Signal.t;
+            val system =
+               _import "Posix_Process_system": NullString.t -> Status.t;
+            val termSig = _import "Posix_Process_termSig": Status.t -> Signal.t;
+            val waitpid =
+               _import "Posix_Process_waitpid"
+               : Pid.t * Status.t ref * int -> Pid.t;
+            val cwait =
+               if let
+                     open Primitive.MLton.Platform.OS
+                  in
+                     case host of
+                        Cygwin => true
+                      | MinGW => true
+                      | _ => false
+                  end
+                  then _import "MLton_Process_cwait": Pid.t * Status.t ref -> Pid.t;
+               else fn _ => raise Fail "cwait not defined"
+         end
 
       structure ProcEnv =
-	 struct
-	    val numgroups = _const "Posix_ProcEnv_numgroups": int;
-	    val sysconfNames =
-	       [
-		(* Required *)
-		(_const "Posix_ProcEnv_ARG_MAX": int;, "ARG_MAX"),
-		(_const "Posix_ProcEnv_CHILD_MAX": int;, "CHILD_MAX"),
-		(_const "Posix_ProcEnv_CLK_TCK": int;, "CLK_TCK"),
-		(_const "Posix_ProcEnv_NGROUPS_MAX": int;, "NGROUPS_MAX"),
-		(_const "Posix_ProcEnv_OPEN_MAX": int;, "OPEN_MAX"),
-		(_const "Posix_ProcEnv_STREAM_MAX": int;, "STREAM_MAX"),
-		(_const "Posix_ProcEnv_TZNAME_MAX": int;, "TZNAME_MAX"),
-		(_const "Posix_ProcEnv_JOB_CONTROL": int;, "JOB_CONTROL"),
-		(_const "Posix_ProcEnv_SAVED_IDS": int;, "SAVED_IDS"),
-		(_const "Posix_ProcEnv_VERSION": int;, "VERSION"),
-		(* Optional *)
-		(_const "Posix_ProcEnv_BC_BASE_MAX": int;, "BC_BASE_MAX"),
-		(_const "Posix_ProcEnv_BC_DIM_MAX": int;, "BC_DIM_MAX"),
-		(_const "Posix_ProcEnv_BC_SCALE_MAX": int;, "BC_SCALE_MAX"),
-		(_const "Posix_ProcEnv_BC_STRING_MAX": int;, "BC_STRING_MAX"),
-		(_const "Posix_ProcEnv_COLL_WEIGHTS_MAX": int;,
-		 "COLL_WEIGHTS_MAX"),
-		(_const "Posix_ProcEnv_EXPR_NEST_MAX": int;, "EXPR_NEST_MAX"),
-		(_const "Posix_ProcEnv_LINE_MAX": int;, "LINE_MAX"),
-		(_const "Posix_ProcEnv_RE_DUP_MAX": int;, "RE_DUP_MAX"),
-		(_const "Posix_ProcEnv_2_VERSION": int;, "2_VERSION"),
-		(_const "Posix_ProcEnv_2_FORT_DEV": int;, "2_FORT_DEV"),
-		(_const "Posix_ProcEnv_2_FORT_RUN": int;, "2_FORT_RUN"),
-		(_const "Posix_ProcEnv_2_SW_DEV": int;, "2_SW_DEV")
-		]
-	       
-	    type gid = gid
-	    type uid = uid
-	    datatype file_desc = datatype file_desc
+         struct
+            val numgroups = _const "Posix_ProcEnv_numgroups": int;
+            val sysconfNames =
+               [
+                (* Required *)
+                (_const "Posix_ProcEnv_ARG_MAX": int;, "ARG_MAX"),
+                (_const "Posix_ProcEnv_CHILD_MAX": int;, "CHILD_MAX"),
+                (_const "Posix_ProcEnv_CLK_TCK": int;, "CLK_TCK"),
+                (_const "Posix_ProcEnv_NGROUPS_MAX": int;, "NGROUPS_MAX"),
+                (_const "Posix_ProcEnv_OPEN_MAX": int;, "OPEN_MAX"),
+                (_const "Posix_ProcEnv_STREAM_MAX": int;, "STREAM_MAX"),
+                (_const "Posix_ProcEnv_TZNAME_MAX": int;, "TZNAME_MAX"),
+                (_const "Posix_ProcEnv_JOB_CONTROL": int;, "JOB_CONTROL"),
+                (_const "Posix_ProcEnv_SAVED_IDS": int;, "SAVED_IDS"),
+                (_const "Posix_ProcEnv_VERSION": int;, "VERSION"),
+                (* Optional *)
+                (_const "Posix_ProcEnv_BC_BASE_MAX": int;, "BC_BASE_MAX"),
+                (_const "Posix_ProcEnv_BC_DIM_MAX": int;, "BC_DIM_MAX"),
+                (_const "Posix_ProcEnv_BC_SCALE_MAX": int;, "BC_SCALE_MAX"),
+                (_const "Posix_ProcEnv_BC_STRING_MAX": int;, "BC_STRING_MAX"),
+                (_const "Posix_ProcEnv_COLL_WEIGHTS_MAX": int;,
+                 "COLL_WEIGHTS_MAX"),
+                (_const "Posix_ProcEnv_EXPR_NEST_MAX": int;, "EXPR_NEST_MAX"),
+                (_const "Posix_ProcEnv_LINE_MAX": int;, "LINE_MAX"),
+                (_const "Posix_ProcEnv_RE_DUP_MAX": int;, "RE_DUP_MAX"),
+                (_const "Posix_ProcEnv_2_VERSION": int;, "2_VERSION"),
+                (_const "Posix_ProcEnv_2_FORT_DEV": int;, "2_FORT_DEV"),
+                (_const "Posix_ProcEnv_2_FORT_RUN": int;, "2_FORT_RUN"),
+                (_const "Posix_ProcEnv_2_SW_DEV": int;, "2_SW_DEV")
+                ]
+               
+            type gid = gid
+            type uid = uid
+            type file_desc = file_desc
 
-	    val getegid = _import "Posix_ProcEnv_getegid": unit -> gid;
-	    val geteuid = _import "Posix_ProcEnv_geteuid": unit -> uid;
-	    val getgid = _import "Posix_ProcEnv_getgid": unit -> gid;
-	    val getgroups = _import "Posix_ProcEnv_getgroups": gid array -> int;
-	    val getlogin = _import "Posix_ProcEnv_getlogin": unit -> cstring;
-	    val getpgrp = _import "Posix_ProcEnv_getpgrp": unit -> Pid.t;
-	    val getpid = _import "Posix_ProcEnv_getpid": unit -> Pid.t;
-	    val getppid = _import "Posix_ProcEnv_getppid": unit -> Pid.t;
-	    val getuid = _import "Posix_ProcEnv_getuid": unit -> uid;
-	    val setenv =
-	       _import "Posix_ProcEnv_setenv": NullString.t * NullString.t -> int;
-	    val setgid = _import "Posix_ProcEnv_setgid": gid -> int;
-	    val setpgid = _import "Posix_ProcEnv_setpgid": Pid.t * Pid.t -> int;
-	    val setsid = _import "Posix_ProcEnv_setsid": unit -> Pid.t;
-	    val setuid = _import "Posix_ProcEnv_setuid": uid -> int;
+            val getegid = _import "Posix_ProcEnv_getegid": unit -> gid;
+            val geteuid = _import "Posix_ProcEnv_geteuid": unit -> uid;
+            val getgid = _import "Posix_ProcEnv_getgid": unit -> gid;
+            val getgroups = _import "Posix_ProcEnv_getgroups": gid array -> int;
+            val getlogin = _import "Posix_ProcEnv_getlogin": unit -> cstring;
+            val getpgrp = _import "Posix_ProcEnv_getpgrp": unit -> Pid.t;
+            val getpid = _import "Posix_ProcEnv_getpid": unit -> Pid.t;
+            val getppid = _import "Posix_ProcEnv_getppid": unit -> Pid.t;
+            val getuid = _import "Posix_ProcEnv_getuid": unit -> uid;
+            val setenv =
+               _import "Posix_ProcEnv_setenv": NullString.t * NullString.t -> int;
+            val setgid = _import "Posix_ProcEnv_setgid": gid -> int;
+            val setgroups = _import "Posix_ProcEnv_setgroups": gid array -> int;
+            val setpgid = _import "Posix_ProcEnv_setpgid": Pid.t * Pid.t -> int;
+            val setsid = _import "Posix_ProcEnv_setsid": unit -> Pid.t;
+            val setuid = _import "Posix_ProcEnv_setuid": uid -> int;
 
-	    structure Uname =
-	       struct
-		  val uname = _import "Posix_ProcEnv_Uname_uname": unit -> int;
-		  val sysname =
-		     _import "Posix_ProcEnv_Uname_sysname": unit -> cstring;
-		  val nodename =
-		     _import "Posix_ProcEnv_Uname_nodename": unit -> cstring;
-		  val release =
-		     _import "Posix_ProcEnv_Uname_release": unit -> cstring;
-		  val version =
-		     _import "Posix_ProcEnv_Uname_version": unit -> cstring;
-		  val machine =
-		     _import "Posix_ProcEnv_Uname_machine": unit -> cstring;
-	       end
+            structure Uname =
+               struct
+                  val uname = _import "Posix_ProcEnv_Uname_uname": unit -> int;
+                  val sysname =
+                     _import "Posix_ProcEnv_Uname_sysname": unit -> cstring;
+                  val nodename =
+                     _import "Posix_ProcEnv_Uname_nodename": unit -> cstring;
+                  val release =
+                     _import "Posix_ProcEnv_Uname_release": unit -> cstring;
+                  val version =
+                     _import "Posix_ProcEnv_Uname_version": unit -> cstring;
+                  val machine =
+                     _import "Posix_ProcEnv_Uname_machine": unit -> cstring;
+               end
 
-	    type clock_t = word
-	       
-	    structure Tms =
-	       struct
-		  val utime = _import "Posix_ProcEnv_Tms_utime": unit -> clock_t;
-		  val stime = _import "Posix_ProcEnv_Tms_stime": unit -> clock_t;
-		  val cutime = _import "Posix_ProcEnv_Tms_cutime": unit -> clock_t;
-		  val cstime = _import "Posix_ProcEnv_Tms_cstime": unit -> clock_t;
-	       end
+            type clock_t = word
+               
+            structure Tms =
+               struct
+                  val utime = _import "Posix_ProcEnv_Tms_utime": unit -> clock_t;
+                  val stime = _import "Posix_ProcEnv_Tms_stime": unit -> clock_t;
+                  val cutime = _import "Posix_ProcEnv_Tms_cutime": unit -> clock_t;
+                  val cstime = _import "Posix_ProcEnv_Tms_cstime": unit -> clock_t;
+               end
 
-	    val ctermid = _import "Posix_ProcEnv_ctermid" : unit -> cstring;
-	    val environ = _import "Posix_ProcEnv_environ" : cstringArray;
-	    val getenv = _import "Posix_ProcEnv_getenv" : NullString.t -> cstring;
-	    val isatty = _import "Posix_ProcEnv_isatty" : fd -> bool;
-	    val sysconf = _import "Posix_ProcEnv_sysconf" : int -> int;
-	    val times = _import "Posix_ProcEnv_times" : unit -> clock_t;
-	    val ttyname = _import "Posix_ProcEnv_ttyname" : fd -> cstring;
-	 end 
+            val ctermid = _import "Posix_ProcEnv_ctermid": unit -> cstring;
+            val environ = #1 _symbol "Posix_ProcEnv_environ": cstringArray GetSet.t; ()
+            val getenv = _import "Posix_ProcEnv_getenv": NullString.t -> cstring;
+            val isatty = _import "Posix_ProcEnv_isatty": fd -> bool;
+            val sysconf = _import "Posix_ProcEnv_sysconf": int -> int;
+            val times = _import "Posix_ProcEnv_times": unit -> clock_t;
+            val ttyname = _import "Posix_ProcEnv_ttyname": fd -> cstring;
+         end 
       
       structure FileSys =
-	 struct
-	    datatype file_desc = datatype file_desc
+         struct
+            type file_desc = file_desc
 
-	    type ino = int
-	    type dev = word
-	    type uid = uid
-	    type gid = gid
+            type ino = int
+            type dev = word
+            type uid = uid
+            type gid = gid
 
-	    structure S =
-	       struct
-		  type mode = word
-(*		  val ifsock = _const "Posix_FileSys_S_ifsock": mode; *)
-(*		  val iflnk = _const "Posix_FileSys_S_iflnk": mode; *)
-(*		  val ifreg = _const "Posix_FileSys_S_ifreg": mode; *)
-(*		  val ifblk = _const "Posix_FileSys_S_ifblk": mode; *)
-(*		  val ifdir = _const "Posix_FileSys_S_ifdir": mode; *)
-(*		  val ifchr = _const "Posix_FileSys_S_ifchr": mode; *)
-(*		  val ififo = _const "Posix_FileSys_S_ififo": mode; *)
-		  val irwxu = _const "Posix_FileSys_S_irwxu": mode;
-		  val irusr = _const "Posix_FileSys_S_irusr": mode;
-		  val iwusr = _const "Posix_FileSys_S_iwusr": mode;
-		  val ixusr = _const "Posix_FileSys_S_ixusr": mode;
-		  val irwxg = _const "Posix_FileSys_S_irwxg": mode;
-		  val irgrp = _const "Posix_FileSys_S_irgrp": mode;
-		  val iwgrp = _const "Posix_FileSys_S_iwgrp": mode;
-		  val ixgrp = _const "Posix_FileSys_S_ixgrp": mode;
-		  val irwxo = _const "Posix_FileSys_S_irwxo": mode;
-		  val iroth = _const "Posix_FileSys_S_iroth": mode;
-		  val iwoth = _const "Posix_FileSys_S_iwoth": mode;
-		  val ixoth = _const "Posix_FileSys_S_ixoth": mode;
-		  val isuid = _const "Posix_FileSys_S_isuid": mode;
-		  val isgid = _const "Posix_FileSys_S_isgid": mode;
-	       end
+            structure S =
+               struct
+                  type mode = word
+(*                val ifsock = _const "Posix_FileSys_S_ifsock": mode; *)
+(*                val iflnk = _const "Posix_FileSys_S_iflnk": mode; *)
+(*                val ifreg = _const "Posix_FileSys_S_ifreg": mode; *)
+(*                val ifblk = _const "Posix_FileSys_S_ifblk": mode; *)
+(*                val ifdir = _const "Posix_FileSys_S_ifdir": mode; *)
+(*                val ifchr = _const "Posix_FileSys_S_ifchr": mode; *)
+(*                val ififo = _const "Posix_FileSys_S_ififo": mode; *)
+                  val irwxu = _const "Posix_FileSys_S_irwxu": mode;
+                  val irusr = _const "Posix_FileSys_S_irusr": mode;
+                  val iwusr = _const "Posix_FileSys_S_iwusr": mode;
+                  val ixusr = _const "Posix_FileSys_S_ixusr": mode;
+                  val irwxg = _const "Posix_FileSys_S_irwxg": mode;
+                  val irgrp = _const "Posix_FileSys_S_irgrp": mode;
+                  val iwgrp = _const "Posix_FileSys_S_iwgrp": mode;
+                  val ixgrp = _const "Posix_FileSys_S_ixgrp": mode;
+                  val irwxo = _const "Posix_FileSys_S_irwxo": mode;
+                  val iroth = _const "Posix_FileSys_S_iroth": mode;
+                  val iwoth = _const "Posix_FileSys_S_iwoth": mode;
+                  val ixoth = _const "Posix_FileSys_S_ixoth": mode;
+                  val isuid = _const "Posix_FileSys_S_isuid": mode;
+                  val isgid = _const "Posix_FileSys_S_isgid": mode;
+               end
 
-	    structure O =
-	       struct
-		  type flags = word
-		  val append = _const "Posix_FileSys_O_append": flags;
-		  val creat = _const "Posix_FileSys_O_creat": flags;
-		  val excl = _const "Posix_FileSys_O_excl": flags;
-		  val noctty = _const "Posix_FileSys_O_noctty": flags;
-		  val nonblock = _const "Posix_FileSys_O_nonblock": flags;
-		  val sync = _const "Posix_FileSys_O_sync": flags;
-		  val trunc = _const "Posix_FileSys_O_trunc": flags;
+            structure O =
+               struct
+                  type flags = word
+                  val append = _const "Posix_FileSys_O_append": flags;
+                  val creat = _const "Posix_FileSys_O_creat": flags;
+                  val excl = _const "Posix_FileSys_O_excl": flags;
+                  val noctty = _const "Posix_FileSys_O_noctty": flags;
+                  val nonblock = _const "Posix_FileSys_O_nonblock": flags;
+                  val sync = _const "Posix_FileSys_O_sync": flags;
+                  val trunc = _const "Posix_FileSys_O_trunc": flags;
                   val text = _const "Posix_FileSys_O_text": flags;
                   val binary = _const "Posix_FileSys_O_binary": flags;
-	       end
+               end
 
-	    val o_rdonly = _const "Posix_FileSys_o_rdonly": word;
-	    val o_wronly = _const "Posix_FileSys_o_wronly": word;
-	    val o_rdwr = _const "Posix_FileSys_o_rdwr": word;
-	    val R_OK = _const "Posix_FileSys_R_OK": word;
-	    val W_OK = _const "Posix_FileSys_W_OK": word;
-	    val X_OK = _const "Posix_FileSys_X_OK": word;
-	    val F_OK = _const "Posix_FileSys_F_OK": word;
+            val o_rdonly = _const "Posix_FileSys_o_rdonly": word;
+            val o_wronly = _const "Posix_FileSys_o_wronly": word;
+            val o_rdwr = _const "Posix_FileSys_o_rdwr": word;
+            val R_OK = _const "Posix_FileSys_R_OK": word;
+            val W_OK = _const "Posix_FileSys_W_OK": word;
+            val X_OK = _const "Posix_FileSys_X_OK": word;
+            val F_OK = _const "Posix_FileSys_F_OK": word;
 
-	    val properties =
-	       [
-		(_const "Posix_FileSys_CHOWN_RESTRICTED": int;,
-		 "CHOWN_RESTRICTED"),
-		(_const "Posix_FileSys_LINK_MAX": int;, "LINK_MAX"),
-		(_const "Posix_FileSys_MAX_CANON": int;, "MAX_CANON"),
-		(_const "Posix_FileSys_MAX_INPUT": int;, "MAX_INPUT"),
-		(_const "Posix_FileSys_NAME_MAX": int;, "NAME_MAX"),
-		(_const "Posix_FileSys_NO_TRUNC": int;, "NO_TRUNC"),
-		(_const "Posix_FileSys_PATH_MAX": int;, "PATH_MAX"),
-		(_const "Posix_FileSys_PIPE_BUF": int;, "PIPE_BUF"),
-		(_const "Posix_FileSys_VDISABLE": int;, "VDISABLE"),
-		(_const "Posix_FileSys_ASYNC_IO": int;, "ASYNC_IO"), 
-		(_const "Posix_FileSys_SYNC_IO": int;, "SYNC_IO"), 
-		(_const "Posix_FileSys_PRIO_IO": int;, "PRIO_IO")
-		]
+            val properties =
+               [
+                (_const "Posix_FileSys_CHOWN_RESTRICTED": int;,
+                 "CHOWN_RESTRICTED"),
+                (_const "Posix_FileSys_LINK_MAX": int;, "LINK_MAX"),
+                (_const "Posix_FileSys_MAX_CANON": int;, "MAX_CANON"),
+                (_const "Posix_FileSys_MAX_INPUT": int;, "MAX_INPUT"),
+                (_const "Posix_FileSys_NAME_MAX": int;, "NAME_MAX"),
+                (_const "Posix_FileSys_NO_TRUNC": int;, "NO_TRUNC"),
+                (_const "Posix_FileSys_PATH_MAX": int;, "PATH_MAX"),
+                (_const "Posix_FileSys_PIPE_BUF": int;, "PIPE_BUF"),
+                (_const "Posix_FileSys_VDISABLE": int;, "VDISABLE"),
+                (_const "Posix_FileSys_ASYNC_IO": int;, "ASYNC_IO"), 
+                (_const "Posix_FileSys_SYNC_IO": int;, "SYNC_IO"), 
+                (_const "Posix_FileSys_PRIO_IO": int;, "PRIO_IO")
+                ]
 
-	    structure Dirstream =
-	       struct
-		  type dirstream = Pointer.t
+            structure Dirstream =
+               struct
+                  type dirstream = Pointer.t
 
-		  val closedir =
-		     _import "Posix_FileSys_Dirstream_closedir": dirstream -> int;
-		  val opendir =
-		     _import "Posix_FileSys_Dirstream_opendir"
-		     : NullString.t -> dirstream;
-		  val readdir =
-		     _import "Posix_FileSys_Dirstream_readdir"
-		     : dirstream -> cstring;
-		  val rewinddir =
-		     _import "Posix_FileSys_Dirstream_rewinddir"
-		     : dirstream -> unit;
-	       end
+                  val closedir =
+                     _import "Posix_FileSys_Dirstream_closedir": dirstream -> int;
+                  val opendir =
+                     _import "Posix_FileSys_Dirstream_opendir"
+                     : NullString.t -> dirstream;
+                  val readdir =
+                     _import "Posix_FileSys_Dirstream_readdir"
+                     : dirstream -> cstring;
+                  val rewinddir =
+                     _import "Posix_FileSys_Dirstream_rewinddir"
+                     : dirstream -> unit;
+               end
 
-	    structure Stat =
-	       struct
-		  val dev = _import "Posix_FileSys_Stat_dev": unit -> dev;
-		  val ino = _import "Posix_FileSys_Stat_ino": unit -> ino;
-		  val mode = _import "Posix_FileSys_Stat_mode": unit -> word;
-		  val nlink = _import "Posix_FileSys_Stat_nlink": unit -> int;
-		  val uid = _import "Posix_FileSys_Stat_uid": unit -> uid;
-		  val gid = _import "Posix_FileSys_Stat_gid": unit -> gid;
-		  val size =
-		     _import "Posix_FileSys_Stat_size": unit -> Position.int;
-		  val atime =
-		     _import "Posix_FileSys_Stat_atime": unit -> time;
-		  val mtime =
-		     _import "Posix_FileSys_Stat_mtime": unit -> time;
-		  val ctime =
-		     _import "Posix_FileSys_Stat_ctime": unit -> time;
-		  val fstat = _import "Posix_FileSys_Stat_fstat": fd -> int;
-		  val lstat =
-		     _import "Posix_FileSys_Stat_lstat": NullString.t -> int;
-		  val stat =
-		     _import "Posix_FileSys_Stat_stat": NullString.t -> int;
-	       end
+            structure Stat =
+               struct
+                  val dev = _import "Posix_FileSys_Stat_dev": unit -> dev;
+                  val ino = _import "Posix_FileSys_Stat_ino": unit -> ino;
+                  val mode = _import "Posix_FileSys_Stat_mode": unit -> word;
+                  val nlink = _import "Posix_FileSys_Stat_nlink": unit -> int;
+                  val uid = _import "Posix_FileSys_Stat_uid": unit -> uid;
+                  val gid = _import "Posix_FileSys_Stat_gid": unit -> gid;
+                  val size =
+                     _import "Posix_FileSys_Stat_size": unit -> Position.int;
+                  val atime =
+                     _import "Posix_FileSys_Stat_atime": unit -> time;
+                  val mtime =
+                     _import "Posix_FileSys_Stat_mtime": unit -> time;
+                  val ctime =
+                     _import "Posix_FileSys_Stat_ctime": unit -> time;
+                  val fstat = _import "Posix_FileSys_Stat_fstat": fd -> int;
+                  val lstat =
+                     _import "Posix_FileSys_Stat_lstat": NullString.t -> int;
+                  val stat =
+                     _import "Posix_FileSys_Stat_stat": NullString.t -> int;
+               end
 
-	    structure Utimbuf =
-	       struct
-		  val setActime =
-		     _import "Posix_FileSys_Utimbuf_setActime": time -> unit;
-		  val setModtime =
-		     _import "Posix_FileSys_Utimbuf_setModTime": time -> unit;
-		  val utime =
-		     _import "Posix_FileSys_Utimbuf_utime": NullString.t -> int;
-	       end
+            structure Utimbuf =
+               struct
+                  val setActime =
+                     _import "Posix_FileSys_Utimbuf_setActime": time -> unit;
+                  val setModtime =
+                     _import "Posix_FileSys_Utimbuf_setModTime": time -> unit;
+                  val utime =
+                     _import "Posix_FileSys_Utimbuf_utime": NullString.t -> int;
+               end
 
-	    val access =
-	       _import "Posix_FileSys_access": NullString.t * word -> int;
-	    val chdir = _import "Posix_FileSys_chdir": NullString.t -> int;
-	    val chmod =
-	       _import "Posix_FileSys_chmod": NullString.t * mode -> int;
-	    val chown =
-	       _import "Posix_FileSys_chown": NullString.t * uid * gid -> int;
-	    val fchmod =
-	       _import "Posix_FileSys_fchmod": fd * mode -> int;
-	    val fchown =
-	       _import "Posix_FileSys_fchown": fd * uid * gid -> int;
-	    val fpathconf =
-	       _import "Posix_FileSys_fpathconf": fd * int -> int;
-	    val ftruncate =
-	       _import "Posix_FileSys_ftruncate": fd * Position.int -> int;
-	    val getcwd =
-	       _import "Posix_FileSys_getcwd": char array * size -> cstring;
-	    val link =
-	       _import "Posix_FileSys_link": NullString.t * NullString.t -> int;
-	    val mkdir =
-	       _import "Posix_FileSys_mkdir": NullString.t * word -> int;
-	    val mkfifo =
-	       _import "Posix_FileSys_mkfifo": NullString.t * word -> int;
-	    val openn =
-	       _import "Posix_FileSys_open": NullString.t * word * mode -> fd;
-	    val pathconf =
-	       _import "Posix_FileSys_pathconf": NullString.t * int -> int;
-	    val readlink =
-	       _import "Posix_FileSys_readlink"
-	       : NullString.t * word8 array * int -> int;
-	    val rename =
-	       _import "Posix_FileSys_rename": NullString.t * NullString.t -> int;
-	    val rmdir = _import "Posix_FileSys_rmdir": NullString.t -> int;
-	    val symlink =
-	       _import "Posix_FileSys_symlink"
-	       : NullString.t * NullString.t -> int;
-	    val umask = _import "Posix_FileSys_umask": word -> word;
-	    val unlink = _import "Posix_FileSys_unlink": NullString.t -> int;
+            val access =
+               _import "Posix_FileSys_access": NullString.t * word -> int;
+            val chdir = _import "Posix_FileSys_chdir": NullString.t -> int;
+            val chmod =
+               _import "Posix_FileSys_chmod": NullString.t * mode -> int;
+            val chown =
+               _import "Posix_FileSys_chown": NullString.t * uid * gid -> int;
+            val fchmod =
+               _import "Posix_FileSys_fchmod": fd * mode -> int;
+            val fchown =
+               _import "Posix_FileSys_fchown": fd * uid * gid -> int;
+            val fpathconf =
+               _import "Posix_FileSys_fpathconf": fd * int -> int;
+            val ftruncate =
+               _import "Posix_FileSys_ftruncate": fd * Position.int -> int;
+            val getcwd =
+               _import "Posix_FileSys_getcwd": char array * size -> cstring;
+            val link =
+               _import "Posix_FileSys_link": NullString.t * NullString.t -> int;
+            val mkdir =
+               _import "Posix_FileSys_mkdir": NullString.t * word -> int;
+            val mkfifo =
+               _import "Posix_FileSys_mkfifo": NullString.t * word -> int;
+            val openn =
+               _import "Posix_FileSys_open": NullString.t * word * mode -> int;
+            val pathconf =
+               _import "Posix_FileSys_pathconf": NullString.t * int -> int;
+            val readlink =
+               _import "Posix_FileSys_readlink"
+               : NullString.t * word8 array * int -> int;
+            val rename =
+               _import "Posix_FileSys_rename": NullString.t * NullString.t -> int;
+            val rmdir = _import "Posix_FileSys_rmdir": NullString.t -> int;
+            val symlink =
+               _import "Posix_FileSys_symlink"
+               : NullString.t * NullString.t -> int;
+            val umask = _import "Posix_FileSys_umask": word -> word;
+            val unlink = _import "Posix_FileSys_unlink": NullString.t -> int;
 
-	    structure ST =
-	       struct
-		  val isDir = _import "Posix_FileSys_ST_isDir": word -> bool;
-		  val isChr = _import "Posix_FileSys_ST_isChr": word -> bool;
-		  val isBlk = _import "Posix_FileSys_ST_isBlk": word -> bool;
-		  val isReg = _import "Posix_FileSys_ST_isReg": word -> bool;
-		  val isFIFO =
-		     _import "Posix_FileSys_ST_isFIFO": word -> bool;
-		  val isLink =
-		     _import "Posix_FileSys_ST_isLink": word -> bool;
-		  val isSock =
-		     _import "Posix_FileSys_ST_isSock": word -> bool;
-	       end
-	 end
+            structure ST =
+               struct
+                  val isDir = _import "Posix_FileSys_ST_isDir": word -> bool;
+                  val isChr = _import "Posix_FileSys_ST_isChr": word -> bool;
+                  val isBlk = _import "Posix_FileSys_ST_isBlk": word -> bool;
+                  val isReg = _import "Posix_FileSys_ST_isReg": word -> bool;
+                  val isFIFO =
+                     _import "Posix_FileSys_ST_isFIFO": word -> bool;
+                  val isLink =
+                     _import "Posix_FileSys_ST_isLink": word -> bool;
+                  val isSock =
+                     _import "Posix_FileSys_ST_isSock": word -> bool;
+               end
+         end
 
       structure IO =
-	 struct
-	    val F_DUPFD = _const "Posix_IO_F_DUPFD": int;
-	    val F_GETFD = _const "Posix_IO_F_GETFD": int;
-	    val F_SETFD = _const "Posix_IO_F_SETFD": int;
-	    val F_GETFL = _const "Posix_IO_F_GETFL": int;
-	    val F_SETFL = _const "Posix_IO_F_SETFL": int;
-	    val F_GETLK = _const "Posix_IO_F_GETLK": int;
-	    val F_SETLK = _const "Posix_IO_F_SETLK": int;
-	    val F_RDLCK = _const "Posix_IO_F_RDLCK": int;
-	    val F_WRLCK = _const "Posix_IO_F_WRLCK": int;
-	    val F_UNLCK = _const "Posix_IO_F_UNLCK": int;
-	    val F_SETLKW = _const "Posix_IO_F_SETLKW": int;
-(*	    val F_GETOWN = _const "Posix_IO_F_GETOWN": int; *)
-(*	    val F_SETOWN = _const "Posix_IO_F_SETOWN": int; *)
-	    val O_ACCMODE = _const "Posix_IO_O_ACCMODE": word;
-	    val SEEK_SET = _const "Posix_IO_SEEK_SET": int;
-	    val SEEK_CUR = _const "Posix_IO_SEEK_CUR": int;
-	    val SEEK_END = _const "Posix_IO_SEEK_END": int;
+         struct
+            val F_DUPFD = _const "Posix_IO_F_DUPFD": int;
+            val F_GETFD = _const "Posix_IO_F_GETFD": int;
+            val F_SETFD = _const "Posix_IO_F_SETFD": int;
+            val F_GETFL = _const "Posix_IO_F_GETFL": int;
+            val F_SETFL = _const "Posix_IO_F_SETFL": int;
+            val F_GETLK = _const "Posix_IO_F_GETLK": int;
+            val F_SETLK = _const "Posix_IO_F_SETLK": int;
+            val F_RDLCK = _const "Posix_IO_F_RDLCK": int;
+            val F_WRLCK = _const "Posix_IO_F_WRLCK": int;
+            val F_UNLCK = _const "Posix_IO_F_UNLCK": int;
+            val F_SETLKW = _const "Posix_IO_F_SETLKW": int;
+(*          val F_GETOWN = _const "Posix_IO_F_GETOWN": int; *)
+(*          val F_SETOWN = _const "Posix_IO_F_SETOWN": int; *)
+            val O_ACCMODE = _const "Posix_IO_O_ACCMODE": word;
+            val SEEK_SET = _const "Posix_IO_SEEK_SET": int;
+            val SEEK_CUR = _const "Posix_IO_SEEK_CUR": int;
+            val SEEK_END = _const "Posix_IO_SEEK_END": int;
 
-	    structure FD =
-	       struct
-		  type flags = word
-		  val cloexec = _const "Posix_IO_FD_cloexec": flags;
-	       end
-	    
-	    datatype file_desc = datatype file_desc
+            structure FD =
+               struct
+                  type flags = word
+                  val cloexec = _const "Posix_IO_FD_cloexec": flags;
+               end
+            
+            type file_desc = file_desc
 
-	    structure FLock =
-	       struct
-		  val fcntl = _import "Posix_IO_FLock_fcntl": fd * int -> int;
-		  val typ = _import "Posix_IO_FLock_typ": unit -> int;
-		  val whence = _import "Posix_IO_FLock_whence": unit -> int;
-		  val start =
-		     _import "Posix_IO_FLock_start": unit -> Position.int;
-		  val len =
-		     _import "Posix_IO_FLock_len": unit -> Position.int;
-		  val pid = _import "Posix_IO_FLock_pid": unit -> Pid.t;
-		  val setType = _import "Posix_IO_FLock_setType": int -> unit;
-		  val setWhence =
-		     _import "Posix_IO_FLock_setWhence": int -> unit;
-		  val setStart =
-		     _import "Posix_IO_FLock_setStart": Position.int -> unit;
-		  val setLen =
-		     _import "Posix_IO_FLock_setLen": Position.int -> unit;
-(*		  val setPid = _import "Posix_IO_FLock_setPid": Pid.t -> unit; *)
-	       end
-	    
-	    val close = _import "Posix_IO_close": fd -> int;
-	    val dup = _import "Posix_IO_dup": fd -> fd;
-	    val dup2 = _import "Posix_IO_dup2": fd * fd -> fd;
-	    val fcntl2 = _import "Posix_IO_fcntl2": fd * int -> int;
-	    val fcntl3 = _import "Posix_IO_fcntl3": fd * int * int -> int;
-	    val fsync = _import "Posix_IO_fsync": fd -> int;
-	    val lseek =
-	       _import "Posix_IO_lseek": fd * Position.int * int -> Position.int;
-	    val pipe = _import "Posix_IO_pipe": fd array -> int;
-	    val readChar =
-	       _import "Posix_IO_read": fd * char array * int * size -> ssize;
-	    val setbin = _import "Posix_IO_setbin": fd -> unit;
-	    val settext = _import "Posix_IO_settext": fd -> unit;
-	    val writeChar =
-	       _import "Posix_IO_write": fd * char array * int * size -> ssize;
-	    val writeCharVec =
-	       _import "Posix_IO_write": fd * char vector * int * size -> ssize;
-	    val readWord8 =
-	       _import "Posix_IO_read": fd * word8 array * int * size -> ssize;
-	    val writeWord8 =
-	       _import "Posix_IO_write": fd * word8 array * int * size -> ssize;
-	    val writeWord8Vec =
-	       _import "Posix_IO_write": fd * word8 vector * int * size -> ssize;
-	 end	       
+            structure FLock =
+               struct
+                  val fcntl = _import "Posix_IO_FLock_fcntl": fd * int -> int;
+                  val typ = _import "Posix_IO_FLock_type": unit -> int;
+                  val whence = _import "Posix_IO_FLock_whence": unit -> int;
+                  val start =
+                     _import "Posix_IO_FLock_start": unit -> Position.int;
+                  val len =
+                     _import "Posix_IO_FLock_len": unit -> Position.int;
+                  val pid = _import "Posix_IO_FLock_pid": unit -> Pid.t;
+                  val setType = _import "Posix_IO_FLock_setType": int -> unit;
+                  val setWhence =
+                     _import "Posix_IO_FLock_setWhence": int -> unit;
+                  val setStart =
+                     _import "Posix_IO_FLock_setStart": Position.int -> unit;
+                  val setLen =
+                     _import "Posix_IO_FLock_setLen": Position.int -> unit;
+(*                val setPid = _import "Posix_IO_FLock_setPid": Pid.t -> unit; *)
+               end
+            
+            val close = _import "Posix_IO_close": fd -> int;
+            val dup = _import "Posix_IO_dup": fd -> int;
+            val dup2 = _import "Posix_IO_dup2": fd * fd -> int;
+            val fcntl2 = _import "Posix_IO_fcntl2": fd * int -> int;
+            val fcntl3 = _import "Posix_IO_fcntl3": fd * int * int -> int;
+            val fsync = _import "Posix_IO_fsync": fd -> int;
+            val lseek =
+               _import "Posix_IO_lseek": fd * Position.int * int -> Position.int;
+            val pipe = _import "Posix_IO_pipe": fd array -> int;
+            val readChar =
+               _import "Posix_IO_read": fd * char array * int * size -> ssize;
+            val setbin = 
+               if let
+                     open Primitive.MLton.Platform.OS
+                  in
+                     case host of
+                        MinGW => true
+                      | _ => false
+                  end
+                  then _import "Posix_IO_setbin": fd -> unit;
+               else fn _ => raise Fail "setbin not defined"
+            val settext = 
+               if let
+                     open Primitive.MLton.Platform.OS
+                  in
+                     case host of
+                        MinGW => true
+                      | _ => false
+                  end
+                  then _import "Posix_IO_settext": fd -> unit;
+               else fn _ => raise Fail "settext not defined"
+            val writeChar =
+               _import "Posix_IO_write": fd * char array * int * size -> ssize;
+            val writeCharVec =
+               _import "Posix_IO_write": fd * char vector * int * size -> ssize;
+            val readWord8 =
+               _import "Posix_IO_read": fd * word8 array * int * size -> ssize;
+            val writeWord8 =
+               _import "Posix_IO_write": fd * word8 array * int * size -> ssize;
+            val writeWord8Vec =
+               _import "Posix_IO_write": fd * word8 vector * int * size -> ssize;
+         end           
 
       structure SysDB =
-	 struct
-	    type gid = gid
-	    type uid = uid
+         struct
+            type gid = gid
+            type uid = uid
 
-	    structure Passwd =
-	       struct
-		  val name = _import "Posix_SysDB_Passwd_name": unit -> cstring;
-		  val uid = _import "Posix_SysDB_Passwd_uid": unit -> uid;
-		  val gid = _import "Posix_SysDB_Passwd_gid": unit -> gid;
-		  val dir = _import "Posix_SysDB_Passwd_dir": unit -> cstring;
-		  val shell =
-		     _import "Posix_SysDB_Passwd_shell": unit -> cstring;
-	       end
+            structure Passwd =
+               struct
+                  val name = _import "Posix_SysDB_Passwd_name": unit -> cstring;
+                  val uid = _import "Posix_SysDB_Passwd_uid": unit -> uid;
+                  val gid = _import "Posix_SysDB_Passwd_gid": unit -> gid;
+                  val dir = _import "Posix_SysDB_Passwd_dir": unit -> cstring;
+                  val shell =
+                     _import "Posix_SysDB_Passwd_shell": unit -> cstring;
+               end
 
-	    val getpwnam = _import "Posix_SysDB_getpwnam": NullString.t -> bool;
-	    val getpwuid = _import "Posix_SysDB_getpwuid": uid -> bool;
+            val getpwnam = _import "Posix_SysDB_getpwnam": NullString.t -> bool;
+            val getpwuid = _import "Posix_SysDB_getpwuid": uid -> bool;
 
-	    structure Group =
-	       struct
-		  val name = _import "Posix_SysDB_Group_name": unit -> cstring;
-		  val gid = _import "Posix_SysDB_Group_gid": unit -> gid;
-		  val mem =
-		     _import "Posix_SysDB_Group_mem": unit -> cstringArray;
-	       end
+            structure Group =
+               struct
+                  val name = _import "Posix_SysDB_Group_name": unit -> cstring;
+                  val gid = _import "Posix_SysDB_Group_gid": unit -> gid;
+                  val mem =
+                     _import "Posix_SysDB_Group_mem": unit -> cstringArray;
+               end
 
-	    val getgrgid = _import "Posix_SysDB_getgrgid": gid -> bool;
-	    val getgrnam = _import "Posix_SysDB_getgrnam": NullString.t -> bool;
-	 end
+            val getgrgid = _import "Posix_SysDB_getgrgid": gid -> bool;
+            val getgrnam = _import "Posix_SysDB_getgrnam": NullString.t -> bool;
+         end
 
       structure TTY =
-	 struct
-	    type speed = word
-	    val b0 = _const "Posix_TTY_b0": speed;
-	    val b110 = _const "Posix_TTY_b110": speed;
-	    val b1200 = _const "Posix_TTY_b1200": speed;
-	    val b134 = _const "Posix_TTY_b134": speed;
-	    val b150 = _const "Posix_TTY_b150": speed;
-	    val b1800 = _const "Posix_TTY_b1800": speed;
-	    val b19200 = _const "Posix_TTY_b19200": speed;
-	    val b200 = _const "Posix_TTY_b200": speed;
-	    val b2400 = _const "Posix_TTY_b2400": speed;
-	    val b300 = _const "Posix_TTY_b300": speed;
-	    val b38400 = _const "Posix_TTY_b38400": speed;
-	    val b4800 = _const "Posix_TTY_b4800": speed;
-	    val b50 = _const "Posix_TTY_b50": speed;
-	    val b600 = _const "Posix_TTY_b600": speed;
-	    val b75 = _const "Posix_TTY_b75": speed;
-	    val b9600 = _const "Posix_TTY_b9600": speed;
-	       
-	    datatype file_desc = datatype file_desc
+         struct
+            type speed = word
+            val b0 = _const "Posix_TTY_b0": speed;
+            val b110 = _const "Posix_TTY_b110": speed;
+            val b1200 = _const "Posix_TTY_b1200": speed;
+            val b134 = _const "Posix_TTY_b134": speed;
+            val b150 = _const "Posix_TTY_b150": speed;
+            val b1800 = _const "Posix_TTY_b1800": speed;
+            val b19200 = _const "Posix_TTY_b19200": speed;
+            val b200 = _const "Posix_TTY_b200": speed;
+            val b2400 = _const "Posix_TTY_b2400": speed;
+            val b300 = _const "Posix_TTY_b300": speed;
+            val b38400 = _const "Posix_TTY_b38400": speed;
+            val b4800 = _const "Posix_TTY_b4800": speed;
+            val b50 = _const "Posix_TTY_b50": speed;
+            val b600 = _const "Posix_TTY_b600": speed;
+            val b75 = _const "Posix_TTY_b75": speed;
+            val b9600 = _const "Posix_TTY_b9600": speed;
+               
+            type file_desc = file_desc
 
-	    structure V =
-	       struct
-		  val eof = _const "Posix_TTY_V_eof": int;
-		  val eol = _const "Posix_TTY_V_eol": int;
-		  val erase = _const "Posix_TTY_V_erase": int;
-		  val intr = _const "Posix_TTY_V_intr": int;
-		  val kill = _const "Posix_TTY_V_kill": int;
-		  val min = _const "Posix_TTY_V_min": int;
-		  val nccs = _const "Posix_TTY_V_nccs": int;
-		  val quit = _const "Posix_TTY_V_quit": int;
-		  val start = _const "Posix_TTY_V_start": int;
-		  val stop = _const "Posix_TTY_V_stop": int;
-		  val susp = _const "Posix_TTY_V_susp": int;
-		  val time = _const "Posix_TTY_V_time": int;
-	       end
+            structure V =
+               struct
+                  val eof = _const "Posix_TTY_V_eof": int;
+                  val eol = _const "Posix_TTY_V_eol": int;
+                  val erase = _const "Posix_TTY_V_erase": int;
+                  val intr = _const "Posix_TTY_V_intr": int;
+                  val kill = _const "Posix_TTY_V_kill": int;
+                  val min = _const "Posix_TTY_V_min": int;
+                  val nccs = _const "Posix_TTY_V_nccs": int;
+                  val quit = _const "Posix_TTY_V_quit": int;
+                  val start = _const "Posix_TTY_V_start": int;
+                  val stop = _const "Posix_TTY_V_stop": int;
+                  val susp = _const "Posix_TTY_V_susp": int;
+                  val time = _const "Posix_TTY_V_time": int;
+               end
 
-	    structure I =
-	       struct
-		  type flags = word
-		  val brkint = _const "Posix_TTY_I_brkint": flags;
-		  val icrnl = _const "Posix_TTY_I_icrnl": flags;
-		  val ignbrk = _const "Posix_TTY_I_ignbrk": flags;
-		  val igncr = _const "Posix_TTY_I_igncr": flags;
-		  val ignpar = _const "Posix_TTY_I_ignpar": flags;
-		  val inlcr = _const "Posix_TTY_I_inlcr": flags;
-		  val inpck = _const "Posix_TTY_I_inpck": flags;
-		  val istrip = _const "Posix_TTY_I_istrip": flags;
-		  val ixoff = _const "Posix_TTY_I_ixoff": flags;
-		  val ixon = _const "Posix_TTY_I_ixon": flags;
-		  val parmrk = _const "Posix_TTY_I_parmrk": flags;
-	       end
+            structure I =
+               struct
+                  type flags = word
+                  val brkint = _const "Posix_TTY_I_brkint": flags;
+                  val icrnl = _const "Posix_TTY_I_icrnl": flags;
+                  val ignbrk = _const "Posix_TTY_I_ignbrk": flags;
+                  val igncr = _const "Posix_TTY_I_igncr": flags;
+                  val ignpar = _const "Posix_TTY_I_ignpar": flags;
+                  val inlcr = _const "Posix_TTY_I_inlcr": flags;
+                  val inpck = _const "Posix_TTY_I_inpck": flags;
+                  val istrip = _const "Posix_TTY_I_istrip": flags;
+                  val ixoff = _const "Posix_TTY_I_ixoff": flags;
+                  val ixon = _const "Posix_TTY_I_ixon": flags;
+                  val parmrk = _const "Posix_TTY_I_parmrk": flags;
+               end
 
-	    structure O =
-	       struct
-		  type flags = word
-		  val opost = _const "Posix_TTY_O_opost": flags;
-	       end
+            structure O =
+               struct
+                  type flags = word
+                  val opost = _const "Posix_TTY_O_opost": flags;
+               end
 
-	    structure C =
-	       struct
-		  type flags = word
-		  val clocal = _const "Posix_TTY_C_clocal": flags;
-		  val cread = _const "Posix_TTY_C_cread": flags;
-		  val cs5 = _const "Posix_TTY_C_cs5": flags;
-		  val cs6 = _const "Posix_TTY_C_cs6": flags;
-		  val cs7 = _const "Posix_TTY_C_cs7": flags;
-		  val cs8 = _const "Posix_TTY_C_cs8": flags;
-		  val csize = _const "Posix_TTY_C_csize": flags;
-		  val cstopb = _const "Posix_TTY_C_cstopb": flags;
-		  val hupcl = _const "Posix_TTY_C_hupcl": flags;
-		  val parenb = _const "Posix_TTY_C_parenb": flags;
-		  val parodd = _const "Posix_TTY_C_parodd": flags;
-	       end
+            structure C =
+               struct
+                  type flags = word
+                  val clocal = _const "Posix_TTY_C_clocal": flags;
+                  val cread = _const "Posix_TTY_C_cread": flags;
+                  val cs5 = _const "Posix_TTY_C_cs5": flags;
+                  val cs6 = _const "Posix_TTY_C_cs6": flags;
+                  val cs7 = _const "Posix_TTY_C_cs7": flags;
+                  val cs8 = _const "Posix_TTY_C_cs8": flags;
+                  val csize = _const "Posix_TTY_C_csize": flags;
+                  val cstopb = _const "Posix_TTY_C_cstopb": flags;
+                  val hupcl = _const "Posix_TTY_C_hupcl": flags;
+                  val parenb = _const "Posix_TTY_C_parenb": flags;
+                  val parodd = _const "Posix_TTY_C_parodd": flags;
+               end
 
-	    structure L =
-	       struct
-		  type flags = word
-		  val echo = _const "Posix_TTY_L_echo": flags;
-		  val echoe = _const "Posix_TTY_L_echoe": flags;
-		  val echok = _const "Posix_TTY_L_echok": flags;
-		  val echonl = _const "Posix_TTY_L_echonl": flags;
-		  val icanon = _const "Posix_TTY_L_icanon": flags;
-		  val iexten = _const "Posix_TTY_L_iexten": flags;
-		  val isig = _const "Posix_TTY_L_isig": flags;
-		  val noflsh = _const "Posix_TTY_L_noflsh": flags;
-		  val tostop = _const "Posix_TTY_L_tostop": flags;
-	       end
+            structure L =
+               struct
+                  type flags = word
+                  val echo = _const "Posix_TTY_L_echo": flags;
+                  val echoe = _const "Posix_TTY_L_echoe": flags;
+                  val echok = _const "Posix_TTY_L_echok": flags;
+                  val echonl = _const "Posix_TTY_L_echonl": flags;
+                  val icanon = _const "Posix_TTY_L_icanon": flags;
+                  val iexten = _const "Posix_TTY_L_iexten": flags;
+                  val isig = _const "Posix_TTY_L_isig": flags;
+                  val noflsh = _const "Posix_TTY_L_noflsh": flags;
+                  val tostop = _const "Posix_TTY_L_tostop": flags;
+               end
 
-	    structure TC =
-	       struct
-		  type set_action = int
+            structure TC =
+               struct
+                  type set_action = int
 
-		  val sadrain = _const "Posix_TTY_TC_sadrain": set_action;
-		  val saflush = _const "Posix_TTY_TC_saflush": set_action;
-		  val sanow = _const "Posix_TTY_TC_sanow": set_action;
+                  val sadrain = _const "Posix_TTY_TC_sadrain": set_action;
+                  val saflush = _const "Posix_TTY_TC_saflush": set_action;
+                  val sanow = _const "Posix_TTY_TC_sanow": set_action;
 
-		  type flow_action = int
+                  type flow_action = int
 
-		  val ion = _const "Posix_TTY_TC_ion": flow_action;
-		  val ioff = _const "Posix_TTY_TC_ioff": flow_action;
-		  val ooff = _const "Posix_TTY_TC_ooff": flow_action;
-		  val oon = _const "Posix_TTY_TC_oon": flow_action;
+                  val ion = _const "Posix_TTY_TC_ion": flow_action;
+                  val ioff = _const "Posix_TTY_TC_ioff": flow_action;
+                  val ooff = _const "Posix_TTY_TC_ooff": flow_action;
+                  val oon = _const "Posix_TTY_TC_oon": flow_action;
 
-		  type queue_sel = int
+                  type queue_sel = int
 
-		  val iflush = _const "Posix_TTY_TC_iflush": queue_sel;
-		  val ioflush = _const "Posix_TTY_TC_ioflush": queue_sel;
-		  val oflush = _const "Posix_TTY_TC_oflush": queue_sel;
-	       end		  
+                  val iflush = _const "Posix_TTY_TC_iflush": queue_sel;
+                  val ioflush = _const "Posix_TTY_TC_ioflush": queue_sel;
+                  val oflush = _const "Posix_TTY_TC_oflush": queue_sel;
+               end                
 
-	    structure Termios =
-	       struct
-		  type flag = word
+            structure Termios =
+               struct
+                  type flag = word
 
-		  val iflag = _import "Posix_TTY_Termios_iflag": unit -> flag;
-		  val oflag = _import "Posix_TTY_Termios_oflag": unit -> flag;
-		  val cflag = _import "Posix_TTY_Termios_cflag": unit -> flag;
-		  val lflag = _import "Posix_TTY_Termios_lflag": unit -> flag;
-		  val cc = _import "Posix_TTY_Termios_cc": unit -> cstring;
-		  val ospeed =
-		     _import "Posix_TTY_Termios_cfgetospeed": unit -> speed;
-		  val ispeed =
-		     _import "Posix_TTY_Termios_cfgetispeed": unit -> speed;
-		  val setiflag =
-		     _import "Posix_TTY_Termios_setiflag": flag -> unit;
-		  val setoflag =
-		     _import "Posix_TTY_Termios_setoflag": flag -> unit;
-		  val setcflag =
-		     _import "Posix_TTY_Termios_setcflag": flag -> unit;
-		  val setlflag =
-		     _import "Posix_TTY_Termios_setlflag": flag -> unit;
-		  val setospeed =
-		     _import "Posix_TTY_Termios_setospeed": speed -> int;
-		  val setispeed =
-		     _import "Posix_TTY_Termios_setispeed": speed -> int;
-	       end
+                  val iflag = _import "Posix_TTY_Termios_iflag": unit -> flag;
+                  val oflag = _import "Posix_TTY_Termios_oflag": unit -> flag;
+                  val cflag = _import "Posix_TTY_Termios_cflag": unit -> flag;
+                  val lflag = _import "Posix_TTY_Termios_lflag": unit -> flag;
+                  val cc = _import "Posix_TTY_Termios_cc": unit -> cstring;
+                  val ospeed =
+                     _import "Posix_TTY_Termios_cfgetospeed": unit -> speed;
+                  val ispeed =
+                     _import "Posix_TTY_Termios_cfgetispeed": unit -> speed;
+                  val setiflag =
+                     _import "Posix_TTY_Termios_setiflag": flag -> unit;
+                  val setoflag =
+                     _import "Posix_TTY_Termios_setoflag": flag -> unit;
+                  val setcflag =
+                     _import "Posix_TTY_Termios_setcflag": flag -> unit;
+                  val setlflag =
+                     _import "Posix_TTY_Termios_setlflag": flag -> unit;
+                  val setospeed =
+                     _import "Posix_TTY_Termios_setospeed": speed -> int;
+                  val setispeed =
+                     _import "Posix_TTY_Termios_setispeed": speed -> int;
+               end
 
-	    val drain = _import "Posix_TTY_drain": fd -> int;
-	    val flow = _import "Posix_TTY_flow": fd * TC.flow_action -> int;
-	    val flush = _import "Posix_TTY_flush": fd * TC.queue_sel -> int;
-	    val getattr = _import "Posix_TTY_getattr": fd -> int;
-	    val getpgrp = _import "Posix_TTY_getpgrp": fd -> Pid.t;
-	    val sendbreak = _import "Posix_TTY_sendbreak": fd * int -> int;
-	    val setattr = _import "Posix_TTY_setattr": fd * TC.set_action -> int;
-	    val setpgrp = _import "Posix_TTY_setpgrp": fd * Pid.t -> int;
-	 end
+            val drain = _import "Posix_TTY_drain": fd -> int;
+            val flow = _import "Posix_TTY_flow": fd * TC.flow_action -> int;
+            val flush = _import "Posix_TTY_flush": fd * TC.queue_sel -> int;
+            val getattr = _import "Posix_TTY_getattr": fd -> int;
+            val getpgrp = _import "Posix_TTY_getpgrp": fd -> Pid.t;
+            val sendbreak = _import "Posix_TTY_sendbreak": fd * int -> int;
+            val setattr = _import "Posix_TTY_setattr": fd * TC.set_action -> int;
+            val setpgrp = _import "Posix_TTY_setpgrp": fd * Pid.t -> int;
+         end
    end

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/posix/proc-env.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/posix/proc-env.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/posix/proc-env.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -25,10 +25,10 @@
       val uname: unit -> (string * string) list
       val time: unit -> Time.time
       val times: unit -> {elapsed: Time.time,
-			  utime: Time.time,
-			  stime: Time.time,
-			  cutime: Time.time,
-			  cstime: Time.time}
+                          utime: Time.time,
+                          stime: Time.time,
+                          cutime: Time.time,
+                          cstime: Time.time}
       val getenv: string -> string option
       val environ: unit -> string list
       val ctermid: unit -> string

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/posix/proc-env.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/posix/proc-env.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/posix/proc-env.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 structure PosixProcEnv: POSIX_PROC_ENV =
    struct
       structure Prim = PosixPrimitive.ProcEnv
@@ -13,26 +14,26 @@
       structure CS = C.CS
 
       type pid = Pid.t
-	 
+         
       local
-	 open Prim
+         open Prim
       in
-	 type uid = uid
-	 type gid = gid
-	 datatype file_desc = datatype file_desc
-	 val getpgrp = getpgrp (* No error checking required *)
-	 val getegid = getegid (* No error checking required *)
-	 val geteuid = geteuid (* No error checking required *)
-	 val getgid = getgid (* No error checking required *)
-	 val getpid = getpid (* No error checking required *)
-	 val getppid = getppid (* No error checking required *)
-	 val getuid = getuid (* No error checking required *)
-	 val setgid = fn gid => SysCall.simple (fn () => setgid gid)
-	 val setuid = fn uid => SysCall.simple (fn () => setuid uid)
+         type uid = uid
+         type gid = gid
+         datatype file_desc = datatype file_desc
+         val getpgrp = getpgrp (* No error checking required *)
+         val getegid = getegid (* No error checking required *)
+         val geteuid = geteuid (* No error checking required *)
+         val getgid = getgid (* No error checking required *)
+         val getpid = getpid (* No error checking required *)
+         val getppid = getppid (* No error checking required *)
+         val getuid = getuid (* No error checking required *)
+         val setgid = fn gid => SysCall.simple (fn () => setgid gid)
+         val setuid = fn uid => SysCall.simple (fn () => setuid uid)
       end
 
       fun setsid () = 
-	 Pid.fromInt (SysCall.simpleResult (Pid.toInt o Prim.setsid))
+         Pid.fromInt (SysCall.simpleResult (Pid.toInt o Prim.setsid))
 
       fun id x = x
       val uidToWord = id 
@@ -41,104 +42,104 @@
       val wordToGid = id
 
       local
-	 val a: word array = Primitive.Array.array Prim.numgroups
+         val a: word array = Primitive.Array.array Prim.numgroups
       in
-	 fun getgroups () =
-	    SysCall.syscall
-	    (fn () =>
-	     let val n = Prim.getgroups a
-	     in (n, fn () => 
-		 ArraySlice.toList (ArraySlice.slice (a, 0, SOME n)))
-	     end)
+         fun getgroups () =
+            SysCall.syscall
+            (fn () =>
+             let val n = Prim.getgroups a
+             in (n, fn () => 
+                 ArraySlice.toList (ArraySlice.slice (a, 0, SOME n)))
+             end)
       end
 
       fun getlogin () =
-	 let val cs = Prim.getlogin ()
-	 in if Primitive.Pointer.isNull cs
-	       then raise (Error.SysErr ("no login name", NONE))
-	    else CS.toString cs
-	 end
+         let val cs = Prim.getlogin ()
+         in if Primitive.Pointer.isNull cs
+               then raise (Error.SysErr ("no login name", NONE))
+            else CS.toString cs
+         end
 
       fun setpgid {pid, pgid} =
-	 let
-	    val f =
-	       fn NONE => Pid.fromInt 0
-		| SOME pid => pid
-	    val pid = f pid
-	    val pgid = f pgid
-	 in
-	    SysCall.simple
-	    (fn () => Prim.setpgid (pid, pgid))
-	 end
+         let
+            val f =
+               fn NONE => Pid.fromInt 0
+                | SOME pid => pid
+            val pid = f pid
+            val pgid = f pgid
+         in
+            SysCall.simple
+            (fn () => Prim.setpgid (pid, pgid))
+         end
 
       local
-	 structure Uname = Prim.Uname
+         structure Uname = Prim.Uname
       in
-	 fun uname () =
-	    SysCall.syscall
-	    (fn () =>
-	     (Uname.uname (), fn () =>
-	      [("sysname", CS.toString (Uname.sysname ())),
-	       ("nodename", CS.toString (Uname.nodename ())),
-	       ("release", CS.toString (Uname.release ())),
-	       ("version", CS.toString (Uname.version ())),
-	       ("machine", CS.toString (Uname.machine ()))]))
+         fun uname () =
+            SysCall.syscall
+            (fn () =>
+             (Uname.uname (), fn () =>
+              [("sysname", CS.toString (Uname.sysname ())),
+               ("nodename", CS.toString (Uname.nodename ())),
+               ("release", CS.toString (Uname.release ())),
+               ("version", CS.toString (Uname.version ())),
+               ("machine", CS.toString (Uname.machine ()))]))
       end
 
       val time = Time.now
 
       fun sysconf s =
-	 case List.find (fn (_, s') => s = s') Prim.sysconfNames of
-	    NONE => Error.raiseSys Error.inval
-	  | SOME (n, _) =>
-	       (SysWord.fromInt o SysCall.simpleResult)
-	       (fn () => Prim.sysconf n)
-	       
+         case List.find (fn (_, s') => s = s') Prim.sysconfNames of
+            NONE => Error.raiseSys Error.inval
+          | SOME (n, _) =>
+               (SysWord.fromInt o SysCall.simpleResult)
+               (fn () => Prim.sysconf n)
+               
       local
-	 structure Tms = Prim.Tms
+         structure Tms = Prim.Tms
 
-	 val ticksPerSec = Int.toLarge (SysWord.toIntX (sysconf "CLK_TCK"))
+         val ticksPerSec = Int.toLarge (SysWord.toIntX (sysconf "CLK_TCK"))
 
-	 fun cvt (ticks: word) =
-	    Time.fromTicks (LargeInt.quot
-			    (LargeInt.* (Word.toLargeIntX ticks,
-					 Time.ticksPerSecond),
-			     ticksPerSec))
+         fun cvt (ticks: word) =
+            Time.fromTicks (LargeInt.quot
+                            (LargeInt.* (Word.toLargeIntX ticks,
+                                         Time.ticksPerSecond),
+                             ticksPerSec))
       in
-	 fun times () =
-	    SysCall.syscall 
-	    (fn () =>
-	     let val elapsed = Prim.times () 
-	     in (0, fn () =>
-		 {elapsed = cvt elapsed,
-		  utime = cvt (Tms.utime ()), 
-		  stime = cvt (Tms.stime ()), 
-		  cutime = cvt (Tms.cutime ()), 
-		  cstime = cvt (Tms.cstime ())})
-	     end)
+         fun times () =
+            SysCall.syscall 
+            (fn () =>
+             let val elapsed = Prim.times () 
+             in (0, fn () =>
+                 {elapsed = cvt elapsed,
+                  utime = cvt (Tms.utime ()), 
+                  stime = cvt (Tms.stime ()), 
+                  cutime = cvt (Tms.cutime ()), 
+                  cstime = cvt (Tms.cstime ())})
+             end)
       end
 
       fun environ () = C.CSS.toList Prim.environ
 
       fun getenv name =
-	 let
-	    val cs = Prim.getenv (NullString.nullTerm name)
-	 in
-	    if Primitive.Pointer.isNull cs
-	       then NONE
-	    else SOME (CS.toString cs)
-	 end
+         let
+            val cs = Prim.getenv (NullString.nullTerm name)
+         in
+            if Primitive.Pointer.isNull cs
+               then NONE
+            else SOME (CS.toString cs)
+         end
 
       fun ctermid () = CS.toString (Prim.ctermid ())
 
-      fun isatty (FD n) = Prim.isatty n
+      fun isatty fd = Prim.isatty fd
 
-      fun ttyname (FD n) =
-	 SysCall.syscall
-	 (fn () =>
-	  let val cs = Prim.ttyname n
-	  in 
-	     (if Primitive.Pointer.isNull cs then ~1 else 0,
-	      fn () => CS.toString cs)
-	  end)
+      fun ttyname fd =
+         SysCall.syscall
+         (fn () =>
+          let val cs = Prim.ttyname fd
+          in 
+             (if Primitive.Pointer.isNull cs then ~1 else 0,
+              fn () => CS.toString cs)
+          end)
    end

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/posix/process.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/posix/process.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/posix/process.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -4,24 +4,24 @@
       eqtype pid
 
       structure W:
-	 sig
-	    include BIT_FLAGS
+         sig
+            include BIT_FLAGS
             val untraced: flags 
-	 end
+         end
 
       datatype exit_status =
-	 W_EXITED
+         W_EXITED
        | W_EXITSTATUS of Word8.word
        | W_SIGNALED of signal
        | W_STOPPED of signal 
 
       datatype killpid_arg =
-	 K_PROC of pid
+         K_PROC of pid
        | K_SAME_GROUP
        | K_GROUP of pid 
 
       datatype waitpid_arg =
-	 W_ANY_CHILD
+         W_ANY_CHILD
        | W_CHILD of pid
        | W_SAME_GROUP
        | W_GROUP of pid 

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/posix/process.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/posix/process.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/posix/process.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,9 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 structure PosixProcess: POSIX_PROCESS_EXTRA =
@@ -20,157 +20,182 @@
       val pidToWord = SysWord.fromInt o Pid.toInt
 
       fun fork () =
-	 SysCall.syscall
-	 (fn () =>
-	  let 
-	     val p = Prim.fork ()
-	     val p' = Pid.toInt p
-	  in (p', fn () => if p' = 0 then NONE else SOME p)
-	  end)
+         SysCall.syscall
+         (fn () =>
+          let 
+             val p = Prim.fork ()
+             val p' = Pid.toInt p
+          in (p', fn () => if p' = 0 then NONE else SOME p)
+          end)
 
       val fork =
-	 if Primitive.MLton.Platform.OS.forkIsEnabled
-	    then fork
-	 else fn () => Error.raiseSys Error.nosys
+         if Primitive.MLton.Platform.OS.forkIsEnabled
+            then fork
+         else fn () => Error.raiseSys Error.nosys
 
       val conv = NullString.nullTerm
       val convs = C.CSS.fromList
 
       fun exece (path, args, env): 'a =
-	 let
-	    val path = conv path
-	    val args = convs args
-	    val env = convs env
-	 in
-	    (SysCall.simple
-	     (fn () => Prim.exece (path, args, env))
-	     ; raise Fail "Posix.Process.exece")
-	 end
-	 
+         let
+            val path = conv path
+            val args = convs args
+            val env = convs env
+         in
+            (SysCall.simple
+             (fn () => Prim.exece (path, args, env))
+             ; raise Fail "Posix.Process.exece")
+         end
+         
       fun exec (path, args): 'a =
-	 exece (path, args, PosixProcEnv.environ ())
+         exece (path, args, PosixProcEnv.environ ())
 
       fun execp (file, args): 'a =
-	 let
-	    val file = conv file
-	    val args = convs args
-	 in
-	    (SysCall.simple 
-	     (fn () => Prim.execp (file, args))
-	     ; raise Fail "Posix.Process.execp")
-	 end
+         let
+            val file = conv file
+            val args = convs args
+         in
+            (SysCall.simple 
+             (fn () => Prim.execp (file, args))
+             ; raise Fail "Posix.Process.execp")
+         end
 
       datatype waitpid_arg =
-	 W_ANY_CHILD
+         W_ANY_CHILD
        | W_CHILD of pid
        | W_SAME_GROUP
        | W_GROUP of pid 
 
       datatype exit_status =
-	 W_EXITED
+         W_EXITED
        | W_EXITSTATUS of Word8.word
        | W_SIGNALED of signal
        | W_STOPPED of signal 
 
       fun fromStatus status =
-	 if Prim.ifExited status
-	    then (case Prim.exitStatus status of
-		     0 => W_EXITED
-		   | n => W_EXITSTATUS (Word8.fromInt n))
-	 else if Prim.ifSignaled status
-	    then W_SIGNALED (Prim.termSig status)
-	 else if Prim.ifStopped status
-	    then W_STOPPED (Prim.stopSig status)
-	 else raise Fail "Posix.Process.fromStatus"
+         if Prim.ifExited status
+            then (case Prim.exitStatus status of
+                     0 => W_EXITED
+                   | n => W_EXITSTATUS (Word8.fromInt n))
+         else if Prim.ifSignaled status
+            then W_SIGNALED (Prim.termSig status)
+         else if Prim.ifStopped status
+            then W_STOPPED (Prim.stopSig status)
+         else raise Fail "Posix.Process.fromStatus"
 
       structure W =
-	 struct
-	    open W BitFlags
-	 end
+         struct
+            open W BitFlags
+         end
 
       local
-	 val status: Status.t ref = ref (Status.fromInt 0)
-	 fun wait (wa, status, flags) =
-	    let
-	       val p =
-		  case wa of
-		     W_ANY_CHILD => ~1
-		   | W_CHILD pid => Pid.toInt pid
-		   | W_SAME_GROUP => 0
-		   | W_GROUP pid => ~ (Pid.toInt pid)
-	       val flags = W.flags flags
-	    in
-	       SysCall.syscallRestart
-	       (fn () =>
-		let
-		   val pid = Prim.waitpid (Pid.fromInt p, status,
-					   SysWord.toInt flags)
-		in
-		   (Pid.toInt pid, fn () => pid)
-		end)
-	    end
-	 fun getStatus () = fromStatus (!status)
+         val status: Status.t ref = ref (Status.fromInt 0)
+         fun wait (wa, status, flags) =
+            let
+               val useCwait = 
+                  Primitive.MLton.Platform.OS.useWindowsProcess
+                  andalso case wa of W_CHILD _ => true | _ => false
+               val p =
+                  case wa of
+                     W_ANY_CHILD => ~1
+                   | W_CHILD pid => Pid.toInt pid
+                   | W_SAME_GROUP => 0
+                   | W_GROUP pid => ~ (Pid.toInt pid)
+               val flags = W.flags flags
+            in
+               SysCall.syscallRestart
+               (fn () =>
+                let
+                   val pid = 
+                      if useCwait 
+                         then Prim.cwait (Pid.fromInt p, status)
+                      else Prim.waitpid (Pid.fromInt p, status,
+                                         SysWord.toInt flags)
+                in
+                   (Pid.toInt pid, fn () => pid)
+                end)
+            end
+         fun getStatus () = fromStatus (!status)
       in
-	 fun waitpid (wa, flags) =
-	    let
-	       val pid = wait (wa, status, flags)
-	    in 
-	       (pid, getStatus ())
-	    end
+         fun waitpid (wa, flags) =
+            let
+               val pid = wait (wa, status, flags)
+            in 
+               (pid, getStatus ())
+            end
 
-	 fun waitpid_nh (wa, flags) =
-	    let
-	       val pid = wait (wa, status, wnohang :: flags)
-	    in
-	       if 0 = Pid.toInt pid
-		  then NONE
-	       else SOME (pid, getStatus ())
-	    end
+         fun waitpid_nh (wa, flags) =
+            let
+               val pid = wait (wa, status, wnohang :: flags)
+            in
+               if 0 = Pid.toInt pid
+                  then NONE
+               else SOME (pid, getStatus ())
+            end
       end
 
       fun wait () = waitpid (W_ANY_CHILD, [])
 
       fun exit (w: Word8.word): 'a  =
-	 (* Posix.Process.exit does not call atExit cleaners, as per the basis
-	  * library spec.
-	  *)
-	 (Prim.exit (Word8.toInt w)
-	  ; raise Fail "Posix.Process.exit")
+         (* Posix.Process.exit does not call atExit cleaners, as per the basis
+          * library spec.
+          *)
+         (Prim.exit (Word8.toInt w)
+          ; raise Fail "Posix.Process.exit")
 
       datatype killpid_arg  =
-	 K_PROC of pid
+         K_PROC of pid
        | K_SAME_GROUP
        | K_GROUP of pid 
 
       fun kill (ka: killpid_arg, s: signal): unit =
-	 let
-	    val pid =
-	       case ka of
-		  K_PROC pid => Pid.toInt pid
-		| K_SAME_GROUP => ~1
-		| K_GROUP pid => ~ (Pid.toInt pid)
-	 in
-	    SysCall.simple (fn () => Prim.kill (Pid.fromInt pid, s))
-	 end
+         let
+            val pid =
+               case ka of
+                  K_PROC pid => Pid.toInt pid
+                | K_SAME_GROUP => ~1
+                | K_GROUP pid => ~ (Pid.toInt pid)
+         in
+            SysCall.simple (fn () => Prim.kill (Pid.fromInt pid, s))
+         end
 
       local
-	 fun wrap prim (t: Time.time): Time.time =
-	    Time.fromSeconds
-	    (LargeInt.fromInt 
-	     (prim 
-	      (LargeInt.toInt (Time.toSeconds t)
-	       handle Overflow => Error.raiseSys Error.inval)))
+         fun wrap prim (t: Time.time): Time.time =
+            Time.fromSeconds
+            (LargeInt.fromInt 
+             (prim 
+              (LargeInt.toInt (Time.toSeconds t)
+               handle Overflow => Error.raiseSys Error.inval)))
       in
-	 val alarm = wrap Prim.alarm
-	 val sleep = wrap Prim.sleep
+         val alarm = wrap Prim.alarm
+(*       val sleep = wrap Prim.sleep *)
       end
-	 
+
+      fun sleep (t: Time.time): Time.time =
+         let
+            val (sec, nsec) = IntInf.quotRem (Time.toNanoseconds t, 1000000000)
+            val (sec, nsec) =
+               (IntInf.toInt sec, IntInf.toInt nsec)
+               handle Overflow => Error.raiseSys Error.inval
+            val secRem = ref sec
+            val nsecRem = ref nsec
+            fun remaining () =
+               Time.+ (Time.fromSeconds (Int.toLarge (!secRem)),
+                       Time.fromNanoseconds (Int.toLarge (!nsecRem)))
+         in
+            SysCall.syscallErr
+            ({clear = false, restart = false}, fn () =>
+             {handlers = [(Error.intr, remaining)],
+              post = remaining,
+              return = Prim.nanosleep (secRem, nsecRem)})
+         end
+
       (* FIXME: pause *)
       fun pause () =
-	 SysCall.syscallErr
-	 ({clear = false, restart = false},
-	  fn () =>
-	  {return = Prim.pause (),
-	   post = fn () => (),
-	   handlers = [(Error.intr, fn () => ())]})
+         SysCall.syscallErr
+         ({clear = false, restart = false},
+          fn () =>
+          {return = Prim.pause (),
+           post = fn () => (),
+           handlers = [(Error.intr, fn () => ())]})
    end

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/posix/signal.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/posix/signal.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/posix/signal.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 structure PosixSignal: POSIX_SIGNAL_EXTRA =
    struct
       open PosixPrimitive.Signal

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/posix/stub-mingw.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/posix/stub-mingw.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/posix/stub-mingw.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,10 @@
+(* Copyright (C) 2004-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 (* Stub out functions that are not implemented on MinGW. *)
 local
    structure Error = PosixError
@@ -4,134 +11,135 @@
    val stub: string * ('a -> 'b) -> ('a -> 'b) =
       fn (msg, f) => 
       if let open Primitive.MLton.Platform.OS
-	 in MinGW = host
-	 end
-	 then fn _ => (if true then ()
-		       else (Primitive.Stdio.print msg
-			     ; Primitive.Stdio.print "\n")
-		       ; Error.raiseSys Error.nosys)
+         in MinGW = host
+         end
+         then fn _ => (if true then ()
+                       else (Primitive.Stdio.print msg
+                             ; Primitive.Stdio.print "\n")
+                       ; Error.raiseSys Error.nosys)
       else f
 in
    structure PosixPrimitive =
       struct
-	 open PosixPrimitive
+         open PosixPrimitive
 
-	 structure FileSys =
-	    struct
-	       open FileSys
+         structure FileSys =
+            struct
+               open FileSys
 
-	       val chown = stub ("chown", chown)
-	       val fchown = stub ("fchown", fchown)
-	       val fpathconf = stub ("fpathconf", fpathconf)
-	       val link = stub ("link", link)
-	       val mkfifo = stub ("mkfifo", mkfifo)
-	       val pathconf = stub ("pathconf", pathconf)
-	       val readlink = stub ("readlink", readlink)
-	       val symlink = stub ("symlink", symlink)
-	    end
+               val chown = stub ("chown", chown)
+               val fchown = stub ("fchown", fchown)
+               val fpathconf = stub ("fpathconf", fpathconf)
+               val link = stub ("link", link)
+               val mkfifo = stub ("mkfifo", mkfifo)
+               val pathconf = stub ("pathconf", pathconf)
+               val readlink = stub ("readlink", readlink)
+               val symlink = stub ("symlink", symlink)
+            end
 
-	 structure IO =
-	    struct
-	       open IO
-		  
-	       val fcntl2 = stub ("fcntl2", fcntl2)
-	       val fcntl3 = stub ("fcntl3", fcntl3)
-	    end
+         structure IO =
+            struct
+               open IO
+                  
+               val fcntl2 = stub ("fcntl2", fcntl2)
+               val fcntl3 = stub ("fcntl3", fcntl3)
+            end
 
-	 structure Process =
-	    struct
-	       open Process
+         structure Process =
+            struct
+               open Process
 
-	       val exece = stub ("exece", exece)
-	       val execp = stub ("execp", execp)
-	       val exit = stub ("exit", exit)
-	       val fork = stub ("fork", fork)
-	       val kill = stub ("kill", kill)
-	       val pause = stub ("pause", pause)
-	       val waitpid = stub ("waitpid", waitpid)
-	    end
+               val exece = stub ("exece", exece)
+               val execp = stub ("execp", execp)
+               val exit = stub ("exit", exit)
+               val fork = stub ("fork", fork)
+               val kill = stub ("kill", kill)
+               val pause = stub ("pause", pause)
+               val waitpid = stub ("waitpid", waitpid)
+            end
 
-	 structure ProcEnv =
-	    struct
-	       open ProcEnv
+         structure ProcEnv =
+            struct
+               open ProcEnv
 
-	       val ctermid = stub ("ctermid", ctermid)
-	       val getegid = stub ("getegid", getegid)
-	       val geteuid = stub ("geteuid", geteuid)
-	       val getgid = stub ("getgid", getgid)
-	       val getgroups = stub ("getgroups", getgroups)
-	       val getlogin = stub ("getlogin", getlogin)
-	       val getpgrp = stub ("getpgrp", getpgrp)
-	       val getpid = stub ("getpid", getpid)
-	       val getppid = stub ("getppid", getppid)
-	       val getuid = stub ("getuid", getuid)
-	       val setgid = stub ("setgid", setgid)
-	       val setpgid = stub ("setpgid", setpgid)
-	       val setsid = stub ("setsid", setsid)
-	       val setuid = stub ("setuid", setuid)
-	       val sysconf = stub ("sysconf", sysconf)
-	       val times = stub ("times", times)
-	       val ttyname = stub ("ttyname", ttyname)
-	    end
+               val ctermid = stub ("ctermid", ctermid)
+               val getegid = stub ("getegid", getegid)
+               val geteuid = stub ("geteuid", geteuid)
+               val getgid = stub ("getgid", getgid)
+               val getgroups = stub ("getgroups", getgroups)
+               val getlogin = stub ("getlogin", getlogin)
+               val getpgrp = stub ("getpgrp", getpgrp)
+               val getpid = stub ("getpid", getpid)
+               val getppid = stub ("getppid", getppid)
+               val getuid = stub ("getuid", getuid)
+               val setgid = stub ("setgid", setgid)
+               val setgroups = stub ("stegroups", setgroups)
+               val setpgid = stub ("setpgid", setpgid)
+               val setsid = stub ("setsid", setsid)
+               val setuid = stub ("setuid", setuid)
+               val sysconf = stub ("sysconf", sysconf)
+               val times = stub ("times", times)
+               val ttyname = stub ("ttyname", ttyname)
+            end
 
-	 structure SysDB =
-	    struct
-	       open SysDB
-		  
-	       val getgrgid = stub ("getgrgid", getgrgid)
-	       val getgrnam = stub ("getgrnam", getgrnam)
-	       val getpwuid = stub ("getpwuid", getpwuid)
-	    end
+         structure SysDB =
+            struct
+               open SysDB
+                  
+               val getgrgid = stub ("getgrgid", getgrgid)
+               val getgrnam = stub ("getgrnam", getgrnam)
+               val getpwuid = stub ("getpwuid", getpwuid)
+            end
 
-	 structure TTY =
-	    struct
-	       open TTY
-		  
-	       val drain = stub ("drain", drain)
-	       val flow = stub ("flow", flow)
-	       val flush = stub ("flush", flush)
-	       val getattr = stub ("getattr", getattr)
-	       val getpgrp = stub ("getpgrp", getpgrp)
-	       val sendbreak = stub ("sendbreak", sendbreak)
-	       val setattr = stub ("setattr", setattr)
-	       val setpgrp = stub ("setpgrp", setpgrp)
-	    end
+         structure TTY =
+            struct
+               open TTY
+                  
+               val drain = stub ("drain", drain)
+               val flow = stub ("flow", flow)
+               val flush = stub ("flush", flush)
+               val getattr = stub ("getattr", getattr)
+               val getpgrp = stub ("getpgrp", getpgrp)
+               val sendbreak = stub ("sendbreak", sendbreak)
+               val setattr = stub ("setattr", setattr)
+               val setpgrp = stub ("setpgrp", setpgrp)
+            end
       end
    
    structure Primitive =
       struct
-	 open Primitive
+         open Primitive
 
-	 structure Itimer =
-	    struct
-	       open Itimer
+         structure Itimer =
+            struct
+               open Itimer
 
-	       val set = stub ("set", set)
-	    end
+               val set = stub ("set", set)
+            end
 
-	 structure OS =
-	    struct
-	       open OS
+         structure OS =
+            struct
+               open OS
 
-	       structure IO =
-		  struct
-		     open IO
+               structure IO =
+                  struct
+                     open IO
 
-		     val poll = stub ("poll", poll)
-		  end
-	    end
+                     val poll = stub ("poll", poll)
+                  end
+            end
 
-	 structure Socket =
-	    struct
-	       open Socket
+         structure Socket =
+            struct
+               open Socket
 
-	       structure UnixSock =
-		  struct
-		     open UnixSock
+               structure UnixSock =
+                  struct
+                     open UnixSock
 
-		     val toAddr = stub ("toAddr", toAddr)
-		     val fromAddr = stub ("fromAddr", fromAddr)
-		  end
-	    end
+                     val toAddr = stub ("toAddr", toAddr)
+                     val fromAddr = stub ("fromAddr", fromAddr)
+                  end
+            end
       end
 end

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/posix/sys-db.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/posix/sys-db.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/posix/sys-db.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -4,22 +4,22 @@
       eqtype gid
 
       structure Passwd:
-	 sig
-	    type passwd
-	    val name: passwd -> string 
-	    val uid: passwd -> uid 
-	    val gid: passwd -> gid 
-	    val home: passwd -> string 
-	    val shell: passwd -> string 
-	 end
+         sig
+            type passwd
+            val name: passwd -> string 
+            val uid: passwd -> uid 
+            val gid: passwd -> gid 
+            val home: passwd -> string 
+            val shell: passwd -> string 
+         end
       
       structure Group:
-	 sig
-	    type group
-	    val name: group -> string 
-	    val gid: group -> gid 
-	    val members: group -> string list 
-	 end
+         sig
+            type group
+            val name: group -> string 
+            val gid: group -> gid 
+            val members: group -> string list 
+         end
       
       val getgrgid: gid -> Group.group 
       val getgrnam: string -> Group.group 

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/posix/sys-db.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/posix/sys-db.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/posix/sys-db.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 structure PosixSysDB: POSIX_SYS_DB =
    struct
       structure CS = C.CS
@@ -16,66 +17,66 @@
       type gid = Prim.gid
 
       structure Passwd =
-	 struct
-	    type passwd = {name: string,
-			   uid: uid,
-			   gid: gid,
-			   home: string,
-			   shell: string}
+         struct
+            type passwd = {name: string,
+                           uid: uid,
+                           gid: gid,
+                           home: string,
+                           shell: string}
 
-	    local
-	       structure C = Prim.Passwd
-	    in
-	       fun fromC (f: unit -> bool): passwd =
-		  SysCall.syscall
-		  (fn () =>
-		   (if f () then 0 else ~1,
-		    fn () => {name = CS.toString(C.name()),
-			      uid = C.uid(),
-			      gid = C.gid(),
-			      home = CS.toString(C.dir()),
-			      shell = CS.toString(C.shell())}))
-	    end
+            local
+               structure C = Prim.Passwd
+            in
+               fun fromC (f: unit -> bool): passwd =
+                  SysCall.syscall
+                  (fn () =>
+                   (if f () then 0 else ~1,
+                    fn () => {name = CS.toString(C.name()),
+                              uid = C.uid(),
+                              gid = C.gid(),
+                              home = CS.toString(C.dir()),
+                              shell = CS.toString(C.shell())}))
+            end
 
-	    val name: passwd -> string = #name
-	    val uid: passwd -> uid = #uid
-	    val gid: passwd -> gid = #gid
-	    val home: passwd -> string = #home
-	    val shell: passwd -> string = #shell 
-	 end
+            val name: passwd -> string = #name
+            val uid: passwd -> uid = #uid
+            val gid: passwd -> gid = #gid
+            val home: passwd -> string = #home
+            val shell: passwd -> string = #shell 
+         end
 
       fun getpwnam name = 
-	 let val name = NullString.nullTerm name
-	 in Passwd.fromC (fn () => Prim.getpwnam name)
-	 end
+         let val name = NullString.nullTerm name
+         in Passwd.fromC (fn () => Prim.getpwnam name)
+         end
 
       fun getpwuid uid = Passwd.fromC (fn () => Prim.getpwuid uid)
 
       structure Group =
-	 struct
-	    type group = {name: string,
-			  gid: gid,
-			  members: string list}
+         struct
+            type group = {name: string,
+                          gid: gid,
+                          members: string list}
 
-	    structure Group = Prim.Group
+            structure Group = Prim.Group
 
-	    fun fromC (f: unit -> bool): group =
-	       SysCall.syscall
-	       (fn () =>
-		(if f () then 0 else ~1,
-		 fn () => {name = CS.toString(Group.name()),
-			   gid = Group.gid(),
-			   members = C.CSS.toList(Group.mem())}))
-		  
-	    val name: group -> string = #name
-	    val gid: group -> gid = #gid
-	    val members: group -> string list = #members
-	 end
+            fun fromC (f: unit -> bool): group =
+               SysCall.syscall
+               (fn () =>
+                (if f () then 0 else ~1,
+                 fn () => {name = CS.toString(Group.name()),
+                           gid = Group.gid(),
+                           members = C.CSS.toList(Group.mem())}))
+                  
+            val name: group -> string = #name
+            val gid: group -> gid = #gid
+            val members: group -> string list = #members
+         end
 
       fun getgrnam name = 
-	 let val name = NullString.nullTerm name
-	 in Group.fromC (fn () => Prim.getgrnam name)
-	 end
+         let val name = NullString.nullTerm name
+         in Group.fromC (fn () => Prim.getgrnam name)
+         end
       
       fun getgrgid gid = Group.fromC (fn () => Prim.getgrgid gid)
    end

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/posix/tty.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/posix/tty.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/posix/tty.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -4,84 +4,84 @@
       eqtype file_desc
 
       structure V:
-	 sig
-	    val eof: int 
-	    val eol: int 
-	    val erase: int 
-	    val intr: int 
-	    val kill: int 
-	    val min: int 
-	    val quit: int 
-	    val susp: int 
-	    val time: int 
-	    val start: int 
-	    val stop: int 
-	    val nccs: int
-	       
-	    type cc
-	    val cc: (int * char) list -> cc 
-	    val update: cc * (int * char) list -> cc 
-	    val sub: cc * int -> char 
-	 end
+         sig
+            val eof: int 
+            val eol: int 
+            val erase: int 
+            val intr: int 
+            val kill: int 
+            val min: int 
+            val quit: int 
+            val susp: int 
+            val time: int 
+            val start: int 
+            val stop: int 
+            val nccs: int
+               
+            type cc
+            val cc: (int * char) list -> cc 
+            val update: cc * (int * char) list -> cc 
+            val sub: cc * int -> char 
+         end
 
       structure I:
-	 sig
-	    include BIT_FLAGS
-	    val brkint: flags 
-	    val icrnl: flags 
-	    val ignbrk: flags 
-	    val igncr: flags 
-	    val ignpar: flags 
-	    val inlcr: flags 
-	    val inpck: flags 
-	    val istrip: flags 
-	    val ixoff: flags 
-	    val ixon: flags 
-	    val parmrk: flags 
-	 end
+         sig
+            include BIT_FLAGS
+            val brkint: flags 
+            val icrnl: flags 
+            val ignbrk: flags 
+            val igncr: flags 
+            val ignpar: flags 
+            val inlcr: flags 
+            val inpck: flags 
+            val istrip: flags 
+            val ixoff: flags 
+            val ixon: flags 
+            val parmrk: flags 
+         end
 
       structure O:
-	 sig
-	    include BIT_FLAGS
-	    val opost: flags 
-	 end
+         sig
+            include BIT_FLAGS
+            val opost: flags 
+         end
 
       structure C:
-	 sig
-	    include BIT_FLAGS
-	    val clocal: flags 
-	    val cread: flags 
-	    val cs5: flags 
-	    val cs6: flags 
-	    val cs7: flags 
-	    val cs8: flags 
-	    val csize: flags 
-	    val cstopb: flags 
-	    val hupcl: flags 
-	    val parenb: flags 
-	    val parodd: flags 
-	 end
+         sig
+            include BIT_FLAGS
+            val clocal: flags 
+            val cread: flags 
+            val cs5: flags 
+            val cs6: flags 
+            val cs7: flags 
+            val cs8: flags 
+            val csize: flags 
+            val cstopb: flags 
+            val hupcl: flags 
+            val parenb: flags 
+            val parodd: flags 
+         end
 
       structure L:
-	 sig
-	    include BIT_FLAGS
-	    val echo: flags 
-	    val echoe: flags 
-	    val echok: flags 
-	    val echonl: flags 
-	    val icanon: flags 
-	    val iexten: flags 
-	    val isig: flags 
-	    val noflsh: flags 
-	    val tostop: flags 
-	 end
+         sig
+            include BIT_FLAGS
+            val echo: flags 
+            val echoe: flags 
+            val echok: flags 
+            val echonl: flags 
+            val icanon: flags 
+            val iexten: flags 
+            val isig: flags 
+            val noflsh: flags 
+            val tostop: flags 
+         end
 
       eqtype speed
 
       val compareSpeed: speed * speed -> order 
       val speedToWord: speed -> SysWord.word 
       val wordToSpeed: SysWord.word -> speed
-	 
+         
       val b0: speed 
       val b50: speed 
       val b75: speed 
@@ -102,20 +102,20 @@
       type termios
 
       val termios: {iflag: I.flags,
-		    oflag: O.flags,
-		    cflag: C.flags,
-		    lflag: L.flags,
-		    cc: V.cc,
-		    ispeed: speed,
-		    ospeed: speed} -> termios
+                    oflag: O.flags,
+                    cflag: C.flags,
+                    lflag: L.flags,
+                    cc: V.cc,
+                    ispeed: speed,
+                    ospeed: speed} -> termios
 
       val fieldsOf: termios -> {iflag: I.flags,
-				oflag: O.flags,
-				cflag: C.flags,
-				lflag: L.flags,
-				cc: V.cc,
-				ispeed: speed,
-				ospeed: speed} 
+                                oflag: O.flags,
+                                cflag: C.flags,
+                                lflag: L.flags,
+                                cc: V.cc,
+                                ispeed: speed,
+                                ospeed: speed} 
       val getiflag: termios -> I.flags 
       val getoflag: termios -> O.flags 
       val getcflag: termios -> C.flags 
@@ -123,43 +123,43 @@
       val getcc: termios -> V.cc 
 
       structure CF:
-	 sig
-	    val getospeed: termios -> speed 
-	    val setospeed: termios * speed -> termios 
-	    val getispeed: termios -> speed 
-	    val setispeed: termios * speed -> termios 
-	 end
+         sig
+            val getospeed: termios -> speed 
+            val setospeed: termios * speed -> termios 
+            val getispeed: termios -> speed 
+            val setispeed: termios * speed -> termios 
+         end
 
       structure TC:
-	 sig
-	    eqtype set_action
+         sig
+            eqtype set_action
 
-	    val sanow: set_action 
-	    val sadrain: set_action 
-	    val saflush: set_action 
+            val sanow: set_action 
+            val sadrain: set_action 
+            val saflush: set_action 
 
-	    eqtype flow_action
+            eqtype flow_action
 
-	    val ooff: flow_action 
-	    val oon: flow_action 
-	    val ioff: flow_action 
-	    val ion: flow_action 
+            val ooff: flow_action 
+            val oon: flow_action 
+            val ioff: flow_action 
+            val ion: flow_action 
 
-	    eqtype queue_sel
-	       
-	    val iflush: queue_sel 
-	    val oflush: queue_sel 
-	    val ioflush: queue_sel 
+            eqtype queue_sel
+               
+            val iflush: queue_sel 
+            val oflush: queue_sel 
+            val ioflush: queue_sel 
 
-	    val getattr: file_desc -> termios
-	    val setattr: file_desc * set_action * termios -> unit
+            val getattr: file_desc -> termios
+            val setattr: file_desc * set_action * termios -> unit
 
-	    val sendbreak: file_desc * int -> unit
-	    val drain: file_desc -> unit
-	    val flush: file_desc * queue_sel -> unit
-	    val flow: file_desc * flow_action -> unit
+            val sendbreak: file_desc * int -> unit
+            val drain: file_desc -> unit
+            val flush: file_desc * queue_sel -> unit
+            val flow: file_desc * flow_action -> unit
 
-	    val getpgrp: file_desc -> pid 
-	    val setpgrp: file_desc * pid -> unit
-	 end
+            val getpgrp: file_desc -> pid 
+            val setpgrp: file_desc * pid -> unit
+         end
    end

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/posix/tty.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/posix/tty.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/posix/tty.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 structure PosixTTY: POSIX_TTY =
    struct
       structure Cstring = C.CS
@@ -14,55 +15,55 @@
       structure SysCall = Error.SysCall
 
       type pid = Pid.t
-	 
+         
       datatype file_desc = datatype Prim.file_desc
-	 
+         
       structure V =
-	 struct
-	    open V
+         struct
+            open V
 
-	    type cc = char array
+            type cc = char array
 
-	    val default = #"\000"
+            val default = #"\000"
 
-	    fun new () = Array.array (nccs, default)
+            fun new () = Array.array (nccs, default)
 
-	    fun updates (a, l) = List.app (fn (i, c) => Array.update (a, i, c)) l
+            fun updates (a, l) = List.app (fn (i, c) => Array.update (a, i, c)) l
 
-	    fun cc l = let val a = new ()
-		       in updates (a, l)
-			  ; a
-		       end
+            fun cc l = let val a = new ()
+                       in updates (a, l)
+                          ; a
+                       end
 
-	    fun update (a, l) =
-	       let val a' = new ()
-	       in Array.copy {src = a, dst = a', di = 0}
-		  ; updates (a', l)
-		  ; a'
-	       end
+            fun update (a, l) =
+               let val a' = new ()
+               in Array.copy {src = a, dst = a', di = 0}
+                  ; updates (a', l)
+                  ; a'
+               end
 
-	    val sub = Array.sub
-	 end
+            val sub = Array.sub
+         end
       
       structure I =
-	 struct
-	    open I BitFlags
-	 end
+         struct
+            open I BitFlags
+         end
       
       structure O =
-	 struct
-	    open O BitFlags
-	 end
+         struct
+            open O BitFlags
+         end
       
       structure C =
-	 struct
-	    open C BitFlags
-	 end
+         struct
+            open C BitFlags
+         end
       
       structure L =
-	 struct
-	    open L BitFlags
-	 end
+         struct
+            open L BitFlags
+         end
 
       type speed = Prim.speed
 
@@ -72,12 +73,12 @@
       val wordToSpeed = id
 
       type termios = {iflag: I.flags,
-		      oflag: O.flags,
-		      cflag: C.flags,
-		      lflag: L.flags,
-		      cc: V.cc,
-		      ispeed: speed,
-		      ospeed: speed}
+                      oflag: O.flags,
+                      cflag: C.flags,
+                      lflag: L.flags,
+                      cc: V.cc,
+                      ispeed: speed,
+                      ospeed: speed}
 
       val termios = id
       val fieldsOf = id
@@ -89,84 +90,84 @@
       val getcc: termios -> V.cc = #cc
 
       structure CF =
-	 struct
-	    val getospeed: termios -> speed = #ospeed
-	    fun setospeed ({iflag, oflag, cflag, lflag, cc, ispeed, ...}: termios,
-			  ospeed: speed): termios =
-	       {iflag = iflag,
-		oflag = oflag,
-		cflag = cflag,
-		lflag = lflag,
-		cc = cc,
-		ispeed = ispeed,
-		ospeed = ospeed}
-		
-	    val getispeed: termios -> speed = #ispeed
-	       
-	    fun setispeed ({iflag, oflag, cflag, lflag, cc, ospeed, ...}: termios,
-			  ispeed: speed): termios =
-	       {iflag = iflag,
-		oflag = oflag,
-		cflag = cflag,
-		lflag = lflag,
-		cc = cc,
-		ispeed = ispeed,
-		ospeed = ospeed}
-	 end
+         struct
+            val getospeed: termios -> speed = #ospeed
+            fun setospeed ({iflag, oflag, cflag, lflag, cc, ispeed, ...}: termios,
+                          ospeed: speed): termios =
+               {iflag = iflag,
+                oflag = oflag,
+                cflag = cflag,
+                lflag = lflag,
+                cc = cc,
+                ispeed = ispeed,
+                ospeed = ospeed}
+                
+            val getispeed: termios -> speed = #ispeed
+               
+            fun setispeed ({iflag, oflag, cflag, lflag, cc, ospeed, ...}: termios,
+                          ispeed: speed): termios =
+               {iflag = iflag,
+                oflag = oflag,
+                cflag = cflag,
+                lflag = lflag,
+                cc = cc,
+                ispeed = ispeed,
+                ospeed = ospeed}
+         end
       
       structure Termios = Prim.Termios
-	 
+         
       structure TC =
-	 struct
-	    open Prim.TC 
+         struct
+            open Prim.TC 
 
-	    fun getattr (FD fd) =
-	       SysCall.syscallRestart
-	       (fn () =>
-		(Prim.getattr fd, fn () =>
-		 {iflag = Termios.iflag (),
-		  oflag = Termios.oflag (),
-		  cflag = Termios.cflag (),
-		  lflag = Termios.lflag (),
-		  cc = Cstring.toCharArrayOfLength (Termios.cc (), V.nccs),
-		  ispeed = Termios.ispeed (),
-		  ospeed = Termios.ospeed ()}))
+            fun getattr fd =
+               SysCall.syscallRestart
+               (fn () =>
+                (Prim.getattr fd, fn () =>
+                 {iflag = Termios.iflag (),
+                  oflag = Termios.oflag (),
+                  cflag = Termios.cflag (),
+                  lflag = Termios.lflag (),
+                  cc = Cstring.toCharArrayOfLength (Termios.cc (), V.nccs),
+                  ispeed = Termios.ispeed (),
+                  ospeed = Termios.ospeed ()}))
 
-	    fun setattr (FD fd, a, {iflag, oflag, cflag, lflag, cc, ispeed, ospeed}) =
-	       SysCall.syscallRestart
-	       (fn () =>
-		(Termios.setiflag iflag
-		 ; Termios.setoflag oflag
-		 ; Termios.setcflag cflag
-		 ; Termios.setlflag lflag
-		 ; SysCall.simple (fn () => Termios.setospeed ospeed)
-		 ; SysCall.simple (fn () => Termios.setispeed ispeed)
-		 ; let val cs = Termios.cc () 
-		   in Util.naturalForeach
-		      (V.nccs, fn i => Cstring.update (cs, i, V.sub (cc, i)))
-		   end
-		 ; (Prim.setattr (fd, a), fn () => ())))
+            fun setattr (fd, a,
+                         {iflag, oflag, cflag, lflag, cc, ispeed, ospeed}) =
+               SysCall.syscallRestart
+               (fn () =>
+                (Termios.setiflag iflag
+                 ; Termios.setoflag oflag
+                 ; Termios.setcflag cflag
+                 ; Termios.setlflag lflag
+                 ; SysCall.simple (fn () => Termios.setospeed ospeed)
+                 ; SysCall.simple (fn () => Termios.setispeed ispeed)
+                 ; let val cs = Termios.cc () 
+                   in Util.naturalForeach
+                      (V.nccs, fn i => Cstring.update (cs, i, V.sub (cc, i)))
+                   end
+                 ; (Prim.setattr (fd, a), fn () => ())))
 
-	    fun sendbreak (FD fd, n) =
-	       SysCall.simpleRestart (fn () => Prim.sendbreak (fd, n))
+            fun sendbreak (fd, n) =
+               SysCall.simpleRestart (fn () => Prim.sendbreak (fd, n))
 
-	    fun drain (FD fd) = 
-	       SysCall.simpleRestart (fn () => Prim.drain fd)
-	      
-	    fun flush (FD fd, n) = 
-	       SysCall.simpleRestart (fn () => Prim.flush (fd, n))
-	      
-	    fun flow (FD fd, n) = 
-	       SysCall.simpleRestart (fn () => Prim.flow (fd, n))
-	      
-	    fun getpgrp (FD fd) =
-	       SysCall.syscallRestart
-	       (fn () =>
-		let val pid = Prim.getpgrp fd
-		in (Pid.toInt pid, fn () => pid)
-		end)
-	      
-	    fun setpgrp (FD fd, pid) = 
-	       SysCall.simpleRestart (fn () => Prim.setpgrp (fd, pid))
-	 end
+            fun drain fd = SysCall.simpleRestart (fn () => Prim.drain fd)
+              
+            fun flush (fd, n) =
+               SysCall.simpleRestart (fn () => Prim.flush (fd, n))
+              
+            fun flow (fd, n) =
+               SysCall.simpleRestart (fn () => Prim.flow (fd, n))
+              
+            fun getpgrp fd =
+               SysCall.syscallRestart
+               (fn () =>
+                let val pid = Prim.getpgrp fd
+                in (Pid.toInt pid, fn () => pid)
+                end)
+              
+            fun setpgrp (fd, pid) = 
+               SysCall.simpleRestart (fn () => Prim.setpgrp (fd, pid))
+         end
    end

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/real/IEEE-real.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/real/IEEE-real.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/real/IEEE-real.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -3,29 +3,29 @@
       exception Unordered
       
       datatype real_order = LESS | EQUAL | GREATER | UNORDERED
-	 
+         
       datatype float_class =
-	 NAN
+         NAN
        | INF
        | ZERO
        | NORMAL
        | SUBNORMAL
-	 
+         
       datatype rounding_mode =
-	 TO_NEAREST
+         TO_NEAREST
        | TO_NEGINF
        | TO_POSINF
        | TO_ZERO
 
       type decimal_approx = {class: float_class,
-			     digits: int list,
-			     exp: int,
-			     sign: bool}
-	 
+                             digits: int list,
+                             exp: int,
+                             sign: bool}
+         
       val fromString: string -> decimal_approx option
       val getRoundingMode: unit -> rounding_mode
       val scan: (char, 'a) StringCvt.reader
-	        -> (decimal_approx, 'a) StringCvt.reader
+                -> (decimal_approx, 'a) StringCvt.reader
       val setRoundingMode: rounding_mode -> unit 
       val toString: decimal_approx -> string 
    end

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/real/IEEE-real.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/real/IEEE-real.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/real/IEEE-real.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,9 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 structure IEEEReal: IEEE_REAL_EXTRA =
@@ -11,7 +11,7 @@
       val op + = Int.+
       val op - = Int.-
       val op * = Int.*
-	 
+         
       exception Unordered
       datatype real_order = LESS | EQUAL | GREATER | UNORDERED
 
@@ -21,51 +21,51 @@
        | NORMAL
        | SUBNORMAL
        | ZERO
-	 
+         
       structure Prim = Primitive.IEEEReal
 
       structure RoundingMode =
-	 struct
-	    datatype t =
-	       TO_NEAREST
-	     | TO_NEGINF
-	     | TO_POSINF
-	     | TO_ZERO
+         struct
+            datatype t =
+               TO_NEAREST
+             | TO_NEGINF
+             | TO_POSINF
+             | TO_ZERO
 
-	    local
-	       val modes =
-		  let
-		     open Prim.RoundingMode
-		  in
-		     [(toNearest, TO_NEAREST),
-		      (downward, TO_NEGINF),
-		      (upward, TO_POSINF),
-		      (towardZero, TO_ZERO)]
-		  end
-	    in
-	       val fromInt: int -> t =
-		  fn i =>
-		  case List.find (fn (i', _) => i = i') modes of
-		     NONE => raise Fail "IEEEReal.RoundingMode.fromInt"
-		   | SOME (_, m) => m
-			
-	       val toInt: t -> int =
-		  fn m =>
-		  let
-		     open Prim.RoundingMode
-		     val i =
-			case m of
-			   TO_NEAREST => toNearest
-			 | TO_NEGINF => downward
-			 | TO_POSINF => upward
-			 | TO_ZERO => towardZero
-		  in
-		     if i = noSupport
-			then raise Fail "IEEEReal rounding mode not supported"
-		     else i
-		  end
-	    end
-	 end
+            local
+               val modes =
+                  let
+                     open Prim.RoundingMode
+                  in
+                     [(toNearest, TO_NEAREST),
+                      (downward, TO_NEGINF),
+                      (upward, TO_POSINF),
+                      (towardZero, TO_ZERO)]
+                  end
+            in
+               val fromInt: int -> t =
+                  fn i =>
+                  case List.find (fn (i', _) => i = i') modes of
+                     NONE => raise Fail "IEEEReal.RoundingMode.fromInt"
+                   | SOME (_, m) => m
+                        
+               val toInt: t -> int =
+                  fn m =>
+                  let
+                     open Prim.RoundingMode
+                     val i =
+                        case m of
+                           TO_NEAREST => toNearest
+                         | TO_NEGINF => downward
+                         | TO_POSINF => upward
+                         | TO_ZERO => towardZero
+                  in
+                     if i = noSupport
+                        then raise Fail "IEEEReal rounding mode not supported"
+                     else i
+                  end
+            end
+         end
 
       datatype rounding_mode = datatype RoundingMode.t
 
@@ -73,304 +73,304 @@
       val getRoundingMode = RoundingMode.fromInt o Prim.getRoundingMode
 
       fun withRoundingMode (m: rounding_mode, th: unit -> 'a): 'a =
-	 let
-	    val m' = getRoundingMode ()
-	    val _ = setRoundingMode m
-	    val res = th ()
-	    val _ = setRoundingMode m'
-	 in
-	    res
-	 end
+         let
+            val m' = getRoundingMode ()
+            val _ = setRoundingMode m
+            val res = th ()
+            val _ = setRoundingMode m'
+         in
+            res
+         end
 
       structure DecimalApprox =
-	 struct
-	    type t = {class: float_class,
-		      digits: int list,
-		      exp: int,
-		      sign: bool}
+         struct
+            type t = {class: float_class,
+                      digits: int list,
+                      exp: int,
+                      sign: bool}
 
-	    val inf: t = {class = INF,
-			  digits = [],
-			  exp = 0,
-			  sign = false}
+            val inf: t = {class = INF,
+                          digits = [],
+                          exp = 0,
+                          sign = false}
 
-	    val zero: t = {class = ZERO,
-			   digits = [],
-			   exp = 0,
-			   sign = false}
-	 end
+            val zero: t = {class = ZERO,
+                           digits = [],
+                           exp = 0,
+                           sign = false}
+         end
 
       type decimal_approx = DecimalApprox.t
-	 
+         
       fun 'a scan reader (state: 'a) =
-	 let
-	    val state = StringCvt.skipWS reader state
-	    fun readc (c, state, f) =
-	       case reader state of
-		  NONE => NONE
-		| SOME (c', state') =>
-		     if c = Char.toLower c'
-			then f state'
-		     else NONE
-	    fun readString (s, state, failure, success) =
-	       let
-		  val n = String.size s
-		  fun loop (i, state) =
-		     if i = n
-			then success state
-		     else
-			case reader state of
-			   NONE => failure ()
-			 | SOME (c, state) =>
-			      if Char.toLower c = String.sub (s, i)
-				 then loop (i + 1, state)
-			      else failure ()
-	       in
-		  loop (0, state)
-	       end
-	    fun charToDigit c = Char.ord c - Char.ord #"0"
-	    fun digitStar (ds: int list, state) =
-	       let
-		  fun done () = (rev ds, state)
-	       in
-		  case reader state of
-		     NONE => done ()
-		   | SOME (c, state) =>
-			if Char.isDigit c
-			   then digitStar (charToDigit c :: ds, state)
-			else done ()
-	       end
-	    fun digitPlus (state, failure, success) =
-	       case reader state of
-		  NONE => failure ()
-		| SOME (c, state) =>
-		     if Char.isDigit c
-			then success (digitStar ([charToDigit c], state))
-		     else failure ()
-	    (* [+~-]?[0-9]+ *)
-	    type exp = {digits: int list, negate: bool}
-	    fun 'b afterE (state: 'a,
-			   failure: unit -> 'b,
-			   success: exp * 'a -> 'b)
-	       : 'b =
-	       case reader state of
-		  NONE => failure ()
-		| SOME (c, state) =>
-		     let
-			fun neg () =
-			   digitPlus (state, failure,
-				      fn (ds, state) =>
-				      success ({digits = ds, negate = true},
-					       state))
-		     in
-			case c of
-			   #"+" => digitPlus (state, failure,
-					      fn (ds, state) =>
-					      success ({digits = ds,
-							negate = false},
-						       state))
-			 | #"~" => neg ()
-			 | #"-" => neg ()
-			 | _ =>
-			      if Char.isDigit c
-				 then
-				    let
-				       val (ds, state) =
-					  digitStar ([charToDigit c], state)
-				    in
-				       success ({digits = ds, negate = false},
-						state)
-				    end
-			      else failure ()
-		     end
-	    (* e[+~-]?[0-9]+)? *)
-	    fun exp (state: 'a, failure, success) =
-	       case reader state of
-		  NONE => failure ()
-		| SOME (c, state) =>
-		     case Char.toLower c of
-			#"e" => afterE (state, failure, success)
-		      | _ => failure ()
-	    (* (\.[0-9]+)(e[+~-]?[0-9]+)? *)
-	    fun 'b afterDot (state: 'a,
-			     failure: unit -> 'b,
-			     success: int list * exp * 'a -> 'b) =
-	       digitPlus (state, failure,
-			  fn (frac, state) =>
-			  exp (state,
-			       fn () => success (frac,
-						 {digits = [], negate = false},
-						 state),
-			       fn (e, state) => success (frac, e, state)))
-	    fun stripLeadingZeros (ds: int list): int * int list =
-	       let
-		  fun loop (i, ds) =
-		     case ds of
-			[] => (i, [])
-		      | d :: ds' =>
-			   if d = 0
-			      then loop (i + 1, ds')
-			   else (i, ds)
-	       in
-		  loop (0, ds)
-	       end
-	    fun stripTrailingZeros ds =
-	       case ds of
-		  [] => []
-		| _ =>
-		     case List.last ds of
-			0 => rev (#2 (stripLeadingZeros (rev ds)))
-		      | _ => ds
-	    fun done (whole: int list,
-		      frac: int list,
-		      {digits: int list, negate: bool},
-		      state: 'a) =
-	       let
-		  val (_, il) = stripLeadingZeros whole
-		  val fl = stripTrailingZeros frac
-		  datatype exp =
-		     Int of int
-		   | Overflow of DecimalApprox.t
-		  val exp =
-		     case (SOME (let
-				    val i =
-				       List.foldl (fn (d, n) => n * 10 + d)
-				       0 digits
-				 in
-				    if negate then Int.~ i else i
-				 end)
-			   handle General.Overflow => NONE) of
-			NONE => Overflow (if negate
-					     then DecimalApprox.zero
-					  else DecimalApprox.inf)
-		      | SOME i => Int i
-		  val da =
-		     case il of
-			[] =>
-			   (case fl of
-			       [] => DecimalApprox.zero
-			     | _ =>
-				  case exp of
-				     Int e =>
-					let
-					   val (m, fl) = stripLeadingZeros fl
-					in
-					   {class = NORMAL,
-					    digits = fl,
-					    exp = e - m,
-					    sign = false}
-					end
-				   | Overflow da => da)
-		      | _ =>
-			   case exp of
-			      Int e =>
-				 {class = NORMAL,
-				  digits = stripTrailingZeros (il @ fl),
-				  exp = e + length il,
-				  sign = false}
-			    | Overflow da => da
-	       in
-		  SOME (da, state)
-	       end
-	    fun normal' (c, state) =
-	       case Char.toLower c of
-		  #"i" => readc (#"n", state, fn state =>
-				 readc (#"f", state, fn state =>
-					let
-					   fun res state =
-					      SOME ({class = INF,
-						     digits = [],
-						     exp = 0,
-						     sign = false},
-						    state)
-					in
-					   readString ("inity", state,
-						       fn () => res state,
-						       res)
-					end))
-		| #"n" => readc (#"a", state, fn state =>
-				 readc (#"n", state, fn state =>
-					SOME ({class = NAN,
-					       digits = [],
-					       exp = 0,
-					       sign = false},
-					      state)))
-		(* (([0-9]+(\.[0-9]+)?)|(\.[0-9]+))(e[+~-]?[0-9]+)? *)
-		| #"." => afterDot (state,
-				    fn () => NONE,
-				    fn (frac, exp, state) =>
-				    done ([], frac, exp, state))
-		| _ =>
-		     if Char.isDigit c
-			then
-			   (* ([0-9]+(\.[0-9]+)?)(e[+~-]?[0-9]+)? *)
-			   let
-			      val (whole, state) =
-				 digitStar ([charToDigit c], state)
-			      fun no () = done (whole, [],
-						{digits = [], negate = false},
-						state)
-			   in
-			      case reader state of
-				 NONE => no ()
-			       | SOME (c, state) =>
-				    case Char.toLower c of
-				       #"." =>
-				       afterDot (state, no,
-						 fn (frac, e, state) =>
-						 done (whole, frac, e, state))
-				     | #"e" =>
-					  afterE (state, no,
-						  fn (e, state) =>
-						  done (whole, [], e, state))
-				     | _ => no ()
-			   end
-		     else NONE
-	    fun normal state =
-	       case reader state of
-		  NONE => NONE
-		| SOME z => normal' z
-	    fun negate state =
-	       case normal state of
-		  NONE => NONE
-		| SOME ({class, digits, exp, ...}, state) =>
-		     SOME ({class = class,
-			    digits = digits,
-			    exp = exp,
-			    sign = true},
-			   state)
-	 in
-	    case reader state of
-	       NONE => NONE
-	     | SOME (c, state) =>
-		  case c of
-		     #"~" => negate state
-		   | #"-" => negate state
-		   | #"+" => normal state
-		   | _ => normal' (c, state)
-	 end
+         let
+            val state = StringCvt.skipWS reader state
+            fun readc (c, state, f) =
+               case reader state of
+                  NONE => NONE
+                | SOME (c', state') =>
+                     if c = Char.toLower c'
+                        then f state'
+                     else NONE
+            fun readString (s, state, failure, success) =
+               let
+                  val n = String.size s
+                  fun loop (i, state) =
+                     if i = n
+                        then success state
+                     else
+                        case reader state of
+                           NONE => failure ()
+                         | SOME (c, state) =>
+                              if Char.toLower c = String.sub (s, i)
+                                 then loop (i + 1, state)
+                              else failure ()
+               in
+                  loop (0, state)
+               end
+            fun charToDigit c = Char.ord c - Char.ord #"0"
+            fun digitStar (ds: int list, state) =
+               let
+                  fun done () = (rev ds, state)
+               in
+                  case reader state of
+                     NONE => done ()
+                   | SOME (c, state) =>
+                        if Char.isDigit c
+                           then digitStar (charToDigit c :: ds, state)
+                        else done ()
+               end
+            fun digitPlus (state, failure, success) =
+               case reader state of
+                  NONE => failure ()
+                | SOME (c, state) =>
+                     if Char.isDigit c
+                        then success (digitStar ([charToDigit c], state))
+                     else failure ()
+            (* [+~-]?[0-9]+ *)
+            type exp = {digits: int list, negate: bool}
+            fun 'b afterE (state: 'a,
+                           failure: unit -> 'b,
+                           success: exp * 'a -> 'b)
+               : 'b =
+               case reader state of
+                  NONE => failure ()
+                | SOME (c, state) =>
+                     let
+                        fun neg () =
+                           digitPlus (state, failure,
+                                      fn (ds, state) =>
+                                      success ({digits = ds, negate = true},
+                                               state))
+                     in
+                        case c of
+                           #"+" => digitPlus (state, failure,
+                                              fn (ds, state) =>
+                                              success ({digits = ds,
+                                                        negate = false},
+                                                       state))
+                         | #"~" => neg ()
+                         | #"-" => neg ()
+                         | _ =>
+                              if Char.isDigit c
+                                 then
+                                    let
+                                       val (ds, state) =
+                                          digitStar ([charToDigit c], state)
+                                    in
+                                       success ({digits = ds, negate = false},
+                                                state)
+                                    end
+                              else failure ()
+                     end
+            (* e[+~-]?[0-9]+)? *)
+            fun exp (state: 'a, failure, success) =
+               case reader state of
+                  NONE => failure ()
+                | SOME (c, state) =>
+                     case Char.toLower c of
+                        #"e" => afterE (state, failure, success)
+                      | _ => failure ()
+            (* (\.[0-9]+)(e[+~-]?[0-9]+)? *)
+            fun 'b afterDot (state: 'a,
+                             failure: unit -> 'b,
+                             success: int list * exp * 'a -> 'b) =
+               digitPlus (state, failure,
+                          fn (frac, state) =>
+                          exp (state,
+                               fn () => success (frac,
+                                                 {digits = [], negate = false},
+                                                 state),
+                               fn (e, state) => success (frac, e, state)))
+            fun stripLeadingZeros (ds: int list): int * int list =
+               let
+                  fun loop (i, ds) =
+                     case ds of
+                        [] => (i, [])
+                      | d :: ds' =>
+                           if d = 0
+                              then loop (i + 1, ds')
+                           else (i, ds)
+               in
+                  loop (0, ds)
+               end
+            fun stripTrailingZeros ds =
+               case ds of
+                  [] => []
+                | _ =>
+                     case List.last ds of
+                        0 => rev (#2 (stripLeadingZeros (rev ds)))
+                      | _ => ds
+            fun done (whole: int list,
+                      frac: int list,
+                      {digits: int list, negate: bool},
+                      state: 'a) =
+               let
+                  val (_, il) = stripLeadingZeros whole
+                  val fl = stripTrailingZeros frac
+                  datatype exp =
+                     Int of int
+                   | Overflow of DecimalApprox.t
+                  val exp =
+                     case (SOME (let
+                                    val i =
+                                       List.foldl (fn (d, n) => n * 10 + d)
+                                       0 digits
+                                 in
+                                    if negate then Int.~ i else i
+                                 end)
+                           handle General.Overflow => NONE) of
+                        NONE => Overflow (if negate
+                                             then DecimalApprox.zero
+                                          else DecimalApprox.inf)
+                      | SOME i => Int i
+                  val da =
+                     case il of
+                        [] =>
+                           (case fl of
+                               [] => DecimalApprox.zero
+                             | _ =>
+                                  case exp of
+                                     Int e =>
+                                        let
+                                           val (m, fl) = stripLeadingZeros fl
+                                        in
+                                           {class = NORMAL,
+                                            digits = fl,
+                                            exp = e - m,
+                                            sign = false}
+                                        end
+                                   | Overflow da => da)
+                      | _ =>
+                           case exp of
+                              Int e =>
+                                 {class = NORMAL,
+                                  digits = stripTrailingZeros (il @ fl),
+                                  exp = e + length il,
+                                  sign = false}
+                            | Overflow da => da
+               in
+                  SOME (da, state)
+               end
+            fun normal' (c, state) =
+               case Char.toLower c of
+                  #"i" => readc (#"n", state, fn state =>
+                                 readc (#"f", state, fn state =>
+                                        let
+                                           fun res state =
+                                              SOME ({class = INF,
+                                                     digits = [],
+                                                     exp = 0,
+                                                     sign = false},
+                                                    state)
+                                        in
+                                           readString ("inity", state,
+                                                       fn () => res state,
+                                                       res)
+                                        end))
+                | #"n" => readc (#"a", state, fn state =>
+                                 readc (#"n", state, fn state =>
+                                        SOME ({class = NAN,
+                                               digits = [],
+                                               exp = 0,
+                                               sign = false},
+                                              state)))
+                (* (([0-9]+(\.[0-9]+)?)|(\.[0-9]+))(e[+~-]?[0-9]+)? *)
+                | #"." => afterDot (state,
+                                    fn () => NONE,
+                                    fn (frac, exp, state) =>
+                                    done ([], frac, exp, state))
+                | _ =>
+                     if Char.isDigit c
+                        then
+                           (* ([0-9]+(\.[0-9]+)?)(e[+~-]?[0-9]+)? *)
+                           let
+                              val (whole, state) =
+                                 digitStar ([charToDigit c], state)
+                              fun no () = done (whole, [],
+                                                {digits = [], negate = false},
+                                                state)
+                           in
+                              case reader state of
+                                 NONE => no ()
+                               | SOME (c, state) =>
+                                    case Char.toLower c of
+                                       #"." =>
+                                       afterDot (state, no,
+                                                 fn (frac, e, state) =>
+                                                 done (whole, frac, e, state))
+                                     | #"e" =>
+                                          afterE (state, no,
+                                                  fn (e, state) =>
+                                                  done (whole, [], e, state))
+                                     | _ => no ()
+                           end
+                     else NONE
+            fun normal state =
+               case reader state of
+                  NONE => NONE
+                | SOME z => normal' z
+            fun negate state =
+               case normal state of
+                  NONE => NONE
+                | SOME ({class, digits, exp, ...}, state) =>
+                     SOME ({class = class,
+                            digits = digits,
+                            exp = exp,
+                            sign = true},
+                           state)
+         in
+            case reader state of
+               NONE => NONE
+             | SOME (c, state) =>
+                  case c of
+                     #"~" => negate state
+                   | #"-" => negate state
+                   | #"+" => normal state
+                   | _ => normal' (c, state)
+         end
 
       fun fromString s = StringCvt.scanString scan s
 
       fun toString {class, sign, digits, exp}: string =
-	 let
-	    fun digitStr () = implode (map StringCvt.digitToChar digits)
-	    fun norm () =
-	       let val num = "0." ^ digitStr()
-	       in if exp = 0
-		     then num
-		  else concat [num, "E", Int.toString exp]
-	       end
-	    val num =
-	       case class of
-		  ZERO => "0.0"
-		| NORMAL => norm ()
-		| SUBNORMAL => norm ()
-		| INF => "inf"
-		| NAN => "nan"
-	 in if sign
-	       then "~" ^ num
-	    else num
-	 end
+         let
+            fun digitStr () = implode (map StringCvt.digitToChar digits)
+            fun norm () =
+               let val num = "0." ^ digitStr()
+               in if exp = 0
+                     then num
+                  else concat [num, "E", Int.toString exp]
+               end
+            val num =
+               case class of
+                  ZERO => "0.0"
+                | NORMAL => norm ()
+                | SUBNORMAL => norm ()
+                | INF => "inf"
+                | NAN => "nan"
+         in if sign
+               then "~" ^ num
+            else num
+         end
    end
 

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/real/math.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/real/math.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/real/math.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,7 +1,7 @@
 signature MATH =
    sig
       type real
-	
+        
       val acos: real -> real 
       val asin: real -> real 
       val atan2: real * real -> real 

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/real/pack-real.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/real/pack-real.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/real/pack-real.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,12 +1,20 @@
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 functor PackReal (S: sig
-			type real
-			val bytesPerElem: int
-			val isBigEndian: bool
-			val subVec: word8 vector * int -> real
-			val subVecRev: word8 vector * int -> real
-			val update: word8 array * int * real -> unit
-			val updateRev: word8 array * int * real -> unit
-		     end): PACK_REAL =
+                        type real
+                        val bytesPerElem: int
+                        val isBigEndian: bool
+                        val subVec: word8 vector * int -> real
+                        val subVecRev: word8 vector * int -> real
+                        val update: word8 array * int * real -> unit
+                        val updateRev: word8 array * int * real -> unit
+                     end): PACK_REAL =
 struct
 
 open S
@@ -44,27 +52,27 @@
 
 fun subArr (a, i) =
    subVec (Word8Vector.fromPoly
-	   (Primitive.Vector.fromArray (Word8Array.toPoly a)),
-	   i)
+           (Primitive.Vector.fromArray (Word8Array.toPoly a)),
+           i)
    
 end
 
 structure PackReal32Big: PACK_REAL =
    PackReal (val bytesPerElem: int = 4
-	     val isBigEndian = true
-	     open Primitive.PackReal32)
+             val isBigEndian = true
+             open Primitive.PackReal32)
 structure PackReal32Little: PACK_REAL =
    PackReal (val bytesPerElem: int = 4
-	     val isBigEndian = false
-	     open Primitive.PackReal32)
+             val isBigEndian = false
+             open Primitive.PackReal32)
 structure PackReal64Big: PACK_REAL =
    PackReal (val bytesPerElem: int = 8
-	     val isBigEndian = true
-	     open Primitive.PackReal64)
+             val isBigEndian = true
+             open Primitive.PackReal64)
 structure PackReal64Little: PACK_REAL =
    PackReal (val bytesPerElem: int = 8
-	     val isBigEndian = false
-	     open Primitive.PackReal64)
+             val isBigEndian = false
+             open Primitive.PackReal64)
 
 structure PackRealBig = PackReal64Big
 structure PackRealLittle = PackReal64Little

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/real/real.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/real/real.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/real/real.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,10 @@
+(* Copyright (C) 2003-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 functor Real (R: PRE_REAL): REAL =
    struct
       structure MLton = Primitive.MLton
@@ -3,44 +10,44 @@
       structure Prim = R
       local
-	 open IEEEReal
+         open IEEEReal
       in
-	 datatype z = datatype float_class
-	 datatype rounding_mode = datatype rounding_mode
+         datatype z = datatype float_class
+         datatype rounding_mode = datatype rounding_mode
       end
       infix 4 == != ?=
       type real = Prim.real
 
       local
-	 open Prim
-	 val isBytecode = MLton.Codegen.isBytecode
+         open Prim
+         val isBytecode = MLton.Codegen.isBytecode
       in
-	 val *+ =
-	    if isBytecode
-	       then fn (r1, r2, r3) => r1 * r2 + r3
-	    else *+
-	 val *- =
-	    if isBytecode
-	       then fn (r1, r2, r3) => r1 * r2 - r3
-	    else *-
-	 val op * = op *
-	 val op + = op +
-	 val op - = op -
-	 val op / = op /
-	 val op / = op /
-	 val op < = op <
-	 val op <= = op <=
-	 val op > = op >
-	 val op >= = op >=
-	 val ~ = ~
-	 val abs = abs
-	 val fromInt = fromInt
-	 val fromLarge = fromLarge
-	 val maxFinite = maxFinite
-	 val minNormalPos = minNormalPos
-	 val minPos = minPos
-	 val precision = precision
-	 val radix = radix
-	 val signBit = signBit
-	 val toLarge = toLarge
+         val *+ =
+            if isBytecode
+               then fn (r1, r2, r3) => r1 * r2 + r3
+            else *+
+         val *- =
+            if isBytecode
+               then fn (r1, r2, r3) => r1 * r2 - r3
+            else *-
+         val op * = op *
+         val op + = op +
+         val op - = op -
+         val op / = op /
+         val op / = op /
+         val op < = op <
+         val op <= = op <=
+         val op > = op >
+         val op >= = op >=
+         val ~ = ~
+         val abs = abs
+         val fromInt = fromInt
+         val fromLarge = fromLarge
+         val maxFinite = maxFinite
+         val minNormalPos = minNormalPos
+         val minPos = minPos
+         val precision = precision
+         val radix = radix
+         val signBit = fn r => signBit r <> 0
+         val toLarge = toLarge
       end
 
@@ -57,252 +64,252 @@
       val nan = posInf + negInf
 
       local
-	 val classes =
-	    let
-	       open Primitive.Real64.Class
-	    in
-	       (* order here is chosen based on putting the more commonly used
-		* classes at the front.
-		*)
-	       [(normal, NORMAL),
-		(zero, ZERO),
-		(inf, INF),
-		(nan, NAN),
-		(subnormal, SUBNORMAL)]
-	    end
+         val classes =
+            let
+               open Primitive.Real64.Class
+            in
+               (* order here is chosen based on putting the more commonly used
+                * classes at the front.
+                *)
+               [(normal, NORMAL),
+                (zero, ZERO),
+                (inf, INF),
+                (nan, NAN),
+                (subnormal, SUBNORMAL)]
+            end
       in
-	 fun class x =
-	    let
-	       val i = Prim.class x
-	    in
-	       case List.find (fn (i', _) => i = i') classes of
-		  NONE => raise Fail "Real_class returned bogus integer"
-		| SOME (_, c) => c
-	    end
+         fun class x =
+            let
+               val i = Prim.class x
+            in
+               case List.find (fn (i', _) => i = i') classes of
+                  NONE => raise Fail "Real_class returned bogus integer"
+                | SOME (_, c) => c
+            end
       end
    
       val abs =
-	 if MLton.Codegen.isNative
-	    then abs
-	 else
-	    fn x =>
-	    case class x of
-	       INF => posInf
-	     | NAN => x
-	     | _ => if signBit x then ~x else x
-	 
+         if MLton.Codegen.isNative
+            then abs
+         else
+            fn x =>
+            case class x of
+               INF => posInf
+             | NAN => x
+             | _ => if signBit x then ~x else x
+         
       fun isFinite r =
-	 case class r of
-	    INF => false
-	  | NAN => false
-	  | _ => true
-	       
+         case class r of
+            INF => false
+          | NAN => false
+          | _ => true
+               
       fun isNan r = class r = NAN
 
       fun isNormal r = class r = NORMAL
 
       val op == =
-	 fn (x, y) =>
-	 case (class x, class y) of
-	    (NAN, _) => false
-	  | (_, NAN) => false
-	  | (ZERO, ZERO) => true
-	  | _ => Prim.== (x, y)
+         fn (x, y) =>
+         case (class x, class y) of
+            (NAN, _) => false
+          | (_, NAN) => false
+          | (ZERO, ZERO) => true
+          | _ => Prim.== (x, y)
 
       val op != = not o op ==
 
       val op ?= =
-	 if MLton.Codegen.isNative
-	    then Prim.?=
-	 else
-	    fn (x, y) =>
-	    case (class x, class y) of
-	       (NAN, _) => true
-	     | (_, NAN) => true
-	     | (ZERO, ZERO) => true
-	     | _ => Prim.== (x, y)
+         if MLton.Codegen.isNative
+            then Prim.?=
+         else
+            fn (x, y) =>
+            case (class x, class y) of
+               (NAN, _) => true
+             | (_, NAN) => true
+             | (ZERO, ZERO) => true
+             | _ => Prim.== (x, y)
 
       fun min (x, y) =
-	 if isNan x
-	    then y
-	 else if isNan y
-		 then x
-	      else if x < y then x else y
+         if isNan x
+            then y
+         else if isNan y
+                 then x
+              else if x < y then x else y
 
       fun max (x, y) =
-	 if isNan x
-	    then y
-	 else if isNan y
-		 then x
-	      else if x > y then x else y
+         if isNan x
+            then y
+         else if isNan y
+                 then x
+              else if x > y then x else y
 
       fun sign (x: real): int =
-	 case class x of
-	    NAN => raise Domain
-	  | ZERO => 0
-	  | _ => if x > zero then 1 else ~1
+         case class x of
+            NAN => raise Domain
+          | ZERO => 0
+          | _ => if x > zero then 1 else ~1
 
       fun sameSign (x, y) = signBit x = signBit y
 
       fun copySign (x, y) =
-	 if sameSign (x, y)
-	    then x
-	 else ~ x
+         if sameSign (x, y)
+            then x
+         else ~ x
 
       local
-	 datatype z = datatype IEEEReal.real_order
+         datatype z = datatype IEEEReal.real_order
       in
-	 fun compareReal (x, y) =
-	    case (class x, class y) of
-	       (NAN, _) => UNORDERED
-	     | (_, NAN) => UNORDERED
-	     | (ZERO, ZERO) => EQUAL
-	     | _ => if x < y then LESS
-		    else if x > y then GREATER
-			 else EQUAL
+         fun compareReal (x, y) =
+            case (class x, class y) of
+               (NAN, _) => UNORDERED
+             | (_, NAN) => UNORDERED
+             | (ZERO, ZERO) => EQUAL
+             | _ => if x < y then LESS
+                    else if x > y then GREATER
+                         else EQUAL
       end
 
       local
-	 structure I = IEEEReal
-	 structure G = General
+         structure I = IEEEReal
+         structure G = General
       in
-	 fun compare (x, y) =
-	    case compareReal (x, y) of
-	       I.EQUAL => G.EQUAL
-	     | I.GREATER => G.GREATER
-	     | I.LESS => G.LESS
-	     | I.UNORDERED => raise IEEEReal.Unordered
+         fun compare (x, y) =
+            case compareReal (x, y) of
+               I.EQUAL => G.EQUAL
+             | I.GREATER => G.GREATER
+             | I.LESS => G.LESS
+             | I.UNORDERED => raise IEEEReal.Unordered
       end
    
       fun unordered (x, y) = isNan x orelse isNan y
 
       val nextAfter: real * real -> real =
-	 fn (r, t) =>
-	 case (class r, class t) of
-	    (NAN, _) => nan
-	  | (_, NAN) => nan
-	  | (INF, _) => r
-	  | (ZERO, ZERO) => r
-	  | (ZERO, _) => if t > zero then minPos else ~minPos
-	  | _ =>
-	       if r == t
-		  then r
-	       else
-		  let
-		     fun doit (r, t) =
-			if r == maxFinite andalso t == posInf
-			   then posInf
-			else if r > t
-				then R.nextAfterDown r
-			     else R.nextAfterUp r
-		  in
-		     if r > zero
-			then doit (r, t)
-		     else ~ (doit (~r, ~t))
-		  end
-			 
+         fn (r, t) =>
+         case (class r, class t) of
+            (NAN, _) => nan
+          | (_, NAN) => nan
+          | (INF, _) => r
+          | (ZERO, ZERO) => r
+          | (ZERO, _) => if t > zero then minPos else ~minPos
+          | _ =>
+               if r == t
+                  then r
+               else
+                  let
+                     fun doit (r, t) =
+                        if r == maxFinite andalso t == posInf
+                           then posInf
+                        else if r > t
+                                then R.nextAfterDown r
+                             else R.nextAfterUp r
+                  in
+                     if r > zero
+                        then doit (r, t)
+                     else ~ (doit (~r, ~t))
+                  end
+                         
       val toManExp =
-	 let
-	    val r: int ref = ref 0
-	 in
-	    fn x =>
-	    case class x of
-	       INF => {exp = 0, man = x}
-	     | NAN => {exp = 0, man = nan}
-	     | ZERO => {exp = 0, man = x}
-	     | _ => 
-		  let
-		     val man = Prim.frexp (x, r)
-		  in
-		     {exp = !r, man = man}
-		  end
-	 end
+         let
+            val r: int ref = ref 0
+         in
+            fn x =>
+            case class x of
+               INF => {exp = 0, man = x}
+             | NAN => {exp = 0, man = nan}
+             | ZERO => {exp = 0, man = x}
+             | _ => 
+                  let
+                     val man = Prim.frexp (x, r)
+                  in
+                     {exp = !r, man = man}
+                  end
+         end
 
       fun fromManExp {exp, man} = Prim.ldexp (man, exp)
 
       val fromManExp =
-	 if MLton.Codegen.isNative
-	    then fromManExp
-	 else
-	    fn {exp, man} =>
-	    case class man of
-	       INF => man
-	     | NAN => man
-	     | ZERO => man
-	     | _ => fromManExp {exp = exp, man = man}
+         if MLton.Codegen.isNative
+            then fromManExp
+         else
+            fn {exp, man} =>
+            case class man of
+               INF => man
+             | NAN => man
+             | ZERO => man
+             | _ => fromManExp {exp = exp, man = man}
 
       local
-	 val int = ref zero
+         val int = ref zero
       in
-	 fun split x =
-	    case class x of
-	       INF => {frac = if x > zero then zero else ~zero,
-		       whole = x}
-	     | NAN => {frac = nan, whole = nan}
-	     | _ => 
-		  let
-		     val frac = Prim.modf (x, int)
-		     val whole = !int
-		     (* Some platforms' C libraries don't get sign of zero right.
-		      *)
-		     fun fix y =
-			if class y = ZERO
-			   andalso not (sameSign (x, y))
-			   then ~ y
-			else y
-		  in
-		     {frac = fix frac,
-		      whole = fix whole}
-		  end
+         fun split x =
+            case class x of
+               INF => {frac = if x > zero then zero else ~zero,
+                       whole = x}
+             | NAN => {frac = nan, whole = nan}
+             | _ => 
+                  let
+                     val frac = Prim.modf (x, int)
+                     val whole = !int
+                     (* Some platforms' C libraries don't get sign of zero right.
+                      *)
+                     fun fix y =
+                        if class y = ZERO
+                           andalso not (sameSign (x, y))
+                           then ~ y
+                        else y
+                  in
+                     {frac = fix frac,
+                      whole = fix whole}
+                  end
       end
 
       val realMod = #frac o split
-	 
+         
       fun checkFloat x =
-	 case class x of
-	    INF => raise Overflow
-	  | NAN => raise Div
-	  | _ => x
+         case class x of
+            INF => raise Overflow
+          | NAN => raise Div
+          | _ => x
 
       val maxInt = fromInt Int.maxInt'
       val minInt = fromInt Int.minInt'
 
       fun roundReal (x: real, m: rounding_mode): real =
-	 fromLarge
-	 TO_NEAREST
-	 (IEEEReal.withRoundingMode (m, fn () =>
-				     (Primitive.Real64.round (toLarge x))))
-	 
+         fromLarge
+         TO_NEAREST
+         (IEEEReal.withRoundingMode (m, fn () =>
+                                     (Primitive.Real64.round (toLarge x))))
+         
       fun toInt mode x =
-	 case class x of
-	    INF => raise Overflow
-	  | NAN => raise Domain
-	  | _ =>
-	       if minInt <= x
-		  then if x <= maxInt
-			  then Prim.toInt (roundReal (x, mode))
-		       else if x < maxInt + one
-			       then (case mode of
-					TO_NEGINF => Int.maxInt'
-				      | TO_POSINF => raise Overflow
-				      | TO_ZERO => Int.maxInt'
-				      | TO_NEAREST =>
-					   (* Depends on maxInt being odd. *)
-					   if x - maxInt >= half
-					      then raise Overflow
-					   else Int.maxInt')
-			    else raise Overflow
-	       else if x > minInt - one
-		       then (case mode of
-				TO_NEGINF => raise Overflow
-			      | TO_POSINF => Int.minInt'
-			      | TO_ZERO => Int.minInt'
-			      | TO_NEAREST =>
-				   (* Depends on minInt being even. *)
-				   if x - minInt < ~half
-				      then raise Overflow
-				   else Int.minInt')
-		    else raise Overflow
+         case class x of
+            INF => raise Overflow
+          | NAN => raise Domain
+          | _ =>
+               if minInt <= x
+                  then if x <= maxInt
+                          then Prim.toInt (roundReal (x, mode))
+                       else if x < maxInt + one
+                               then (case mode of
+                                        TO_NEGINF => Int.maxInt'
+                                      | TO_POSINF => raise Overflow
+                                      | TO_ZERO => Int.maxInt'
+                                      | TO_NEAREST =>
+                                           (* Depends on maxInt being odd. *)
+                                           if x - maxInt >= half
+                                              then raise Overflow
+                                           else Int.maxInt')
+                            else raise Overflow
+               else if x > minInt - one
+                       then (case mode of
+                                TO_NEGINF => raise Overflow
+                              | TO_POSINF => Int.minInt'
+                              | TO_ZERO => Int.minInt'
+                              | TO_NEAREST =>
+                                   (* Depends on minInt being even. *)
+                                   if x - minInt < ~half
+                                      then raise Overflow
+                                   else Int.minInt')
+                    else raise Overflow
       
       val floor = toInt TO_NEGINF
       val ceil = toInt TO_POSINF
@@ -310,466 +317,466 @@
       val round = toInt TO_NEAREST
 
       local
-	 fun round mode x =
-	    case class x of
-	       INF => x
-	     | NAN => x
-	     | _ => roundReal (x, mode)
+         fun round mode x =
+            case class x of
+               INF => x
+             | NAN => x
+             | _ => roundReal (x, mode)
       in
-	 val realCeil = round TO_POSINF
-	 val realFloor = round TO_NEGINF
-	 val realRound = round TO_NEAREST
-	 val realTrunc = round TO_ZERO
+         val realCeil = round TO_POSINF
+         val realFloor = round TO_NEGINF
+         val realRound = round TO_NEAREST
+         val realTrunc = round TO_ZERO
       end
 
       fun rem (x, y) =
-	 case class x of
-	    INF => nan
-	  | NAN => nan
-	  | ZERO => zero
-	  | _ =>
-	       case class y of
-		  INF => x
-		| NAN => nan
-		| ZERO => nan
-		| _ => x - realTrunc (x/y) * y
+         case class x of
+            INF => nan
+          | NAN => nan
+          | ZERO => zero
+          | _ =>
+               case class y of
+                  INF => x
+                | NAN => nan
+                | ZERO => nan
+                | _ => x - realTrunc (x/y) * y
 
       (* fromDecimal, scan, fromString: decimal -> binary conversions *)
       exception Bad
       fun fromDecimal ({class, digits, exp, sign}: IEEEReal.decimal_approx) =
-	 let
-	    fun doit () =
-	       let
-		  val exp =
-		     if Int.< (exp, 0)
-			then concat ["-", Int.toString (Int.~ exp)]
-		     else Int.toString exp
-(*		  val x = concat ["0.", digits, "E", exp, "\000"] *)
-		  val n  =
-		     Int.+ (4, Int.+ (List.length digits, String.size exp))
-		  val a = Array.rawArray n
-		  fun up (i, c) = (Array.update (a, i, c); Int.+ (i, 1))
-		  val i = 0
-		  val i = up (i, #"0")
-		  val i = up (i, #".")
-		  val i =
-		     List.foldl
-		     (fn (d, i) =>
-		      if Int.< (d, 0) orelse Int.> (d, 9)
-			 then raise Bad
-		      else up (i, Char.chr (Int.+ (d, Char.ord #"0"))))
-		     i digits
-		  val i = up (i, #"E")
-		  val i = CharVector.foldl (fn (c, i) => up (i, c)) i exp
-		  val _ = up (i, #"\000")
-		  val x = Vector.fromArray a
-		  val x = Prim.strto (NullString.fromString x)
-	       in
-		  if sign
-		     then ~ x
-		  else x
-	       end
-	 in
-	    SOME (case class of
-		     INF => if sign then negInf else posInf
-		   | NAN => nan
-		   | NORMAL => doit ()
-		   | SUBNORMAL => doit ()
-		   | ZERO => if sign then ~ zero else zero)
-	    handle Bad => NONE
-	 end
+         let
+            fun doit () =
+               let
+                  val exp =
+                     if Int.< (exp, 0)
+                        then concat ["-", Int.toString (Int.~ exp)]
+                     else Int.toString exp
+(*                val x = concat ["0.", digits, "E", exp, "\000"] *)
+                  val n  =
+                     Int.+ (4, Int.+ (List.length digits, String.size exp))
+                  val a = Array.rawArray n
+                  fun up (i, c) = (Array.update (a, i, c); Int.+ (i, 1))
+                  val i = 0
+                  val i = up (i, #"0")
+                  val i = up (i, #".")
+                  val i =
+                     List.foldl
+                     (fn (d, i) =>
+                      if Int.< (d, 0) orelse Int.> (d, 9)
+                         then raise Bad
+                      else up (i, Char.chr (Int.+ (d, Char.ord #"0"))))
+                     i digits
+                  val i = up (i, #"E")
+                  val i = CharVector.foldl (fn (c, i) => up (i, c)) i exp
+                  val _ = up (i, #"\000")
+                  val x = Vector.fromArray a
+                  val x = Prim.strto (NullString.fromString x)
+               in
+                  if sign
+                     then ~ x
+                  else x
+               end
+         in
+            SOME (case class of
+                     INF => if sign then negInf else posInf
+                   | NAN => nan
+                   | NORMAL => doit ()
+                   | SUBNORMAL => doit ()
+                   | ZERO => if sign then ~ zero else zero)
+            handle Bad => NONE
+         end
 
       fun scan reader state =
-	 case IEEEReal.scan reader state of
-	    NONE => NONE
-	  | SOME (da, state) => SOME (valOf (fromDecimal da), state)
+         case IEEEReal.scan reader state of
+            NONE => NONE
+          | SOME (da, state) => SOME (valOf (fromDecimal da), state)
 
       val fromString = StringCvt.scanString scan
 
       (* toDecimal, fmt, toString: binary -> decimal conversions. *)
       datatype mode = Fix | Gen | Sci
       local
-	 val decpt: int ref = ref 0
+         val decpt: int ref = ref 0
       in
-	 fun gdtoa (x: real, mode: mode, ndig: int) =
-	    let
-	       val mode =
-		  case mode of
-		     Fix => 3
-		   | Gen => 0
-		   | Sci => 2
-	       val cs = Prim.gdtoa (x, mode, ndig, decpt)
-	    in
-	       (cs, !decpt)
-	    end
+         fun gdtoa (x: real, mode: mode, ndig: int) =
+            let
+               val mode =
+                  case mode of
+                     Fix => 3
+                   | Gen => 0
+                   | Sci => 2
+               val cs = Prim.gdtoa (x, mode, ndig, decpt)
+            in
+               (cs, !decpt)
+            end
       end
    
       fun toDecimal (x: real): IEEEReal.decimal_approx =
-	 case class x of
-	    INF => {class = INF,
-		    digits = [],
-		    exp = 0,
-		    sign = x < zero}
-	  | NAN => {class = NAN,
-		    digits = [],
-		    exp = 0,
-		    sign = false}
-	  | ZERO => {class = ZERO,
-		     digits = [],
-		     exp = 0,
-		     sign = signBit x}
-	  | c => 
-	       let
-		  val (cs, exp) = gdtoa (x, Gen, 0)
-		  fun loop (i, ac) =
-		     if Int.< (i, 0)
-			then ac
-		     else loop (Int.- (i, 1),
-				(Int.- (Char.ord (C.CS.sub (cs, i)),
-					Char.ord #"0"))
-				:: ac)
-		  val digits = loop (Int.- (C.CS.length cs, 1), [])
-	       in
-		  {class = c,
-		   digits = digits,
-		   exp = exp,
-		   sign = x < zero}
-	       end
+         case class x of
+            INF => {class = INF,
+                    digits = [],
+                    exp = 0,
+                    sign = x < zero}
+          | NAN => {class = NAN,
+                    digits = [],
+                    exp = 0,
+                    sign = false}
+          | ZERO => {class = ZERO,
+                     digits = [],
+                     exp = 0,
+                     sign = signBit x}
+          | c => 
+               let
+                  val (cs, exp) = gdtoa (x, Gen, 0)
+                  fun loop (i, ac) =
+                     if Int.< (i, 0)
+                        then ac
+                     else loop (Int.- (i, 1),
+                                (Int.- (Char.ord (C.CS.sub (cs, i)),
+                                        Char.ord #"0"))
+                                :: ac)
+                  val digits = loop (Int.- (C.CS.length cs, 1), [])
+               in
+                  {class = c,
+                   digits = digits,
+                   exp = exp,
+                   sign = x < zero}
+               end
 
       datatype realfmt = datatype StringCvt.realfmt
 
       fun add1 n = Int.+ (n, 1)
-	 
+         
       local
-	 fun fix (sign: string, cs: C.CS.t, decpt: int, ndig: int): string =
-	    let
-	       val length = C.CS.length cs
-	    in
-	       if Int.< (decpt, 0)
-		  then
-		     concat [sign,
-			     "0.",
-			     String.new (Int.~ decpt, #"0"),
-			     C.CS.toString cs,
-			     String.new (Int.+ (Int.- (ndig, length),
-						decpt),
-					 #"0")]
-	       else
-		  let 
-		     val whole =
-			if decpt = 0
-			   then "0"
-			else
-			   String.tabulate (decpt, fn i =>
-					    if Int.< (i, length)
-					       then C.CS.sub (cs, i)
-					    else #"0")
-		  in
-		     if 0 = ndig
-			then concat [sign, whole]
-		     else
-			let
-			   val frac =
-			      String.tabulate
-			      (ndig, fn i =>
-			       let
-				  val j = Int.+ (i, decpt)
-			       in
-				  if Int.< (j, length)
-				     then C.CS.sub (cs, j)
-				  else #"0"
-			       end)
-			in
-			   concat [sign, whole, ".", frac]
-			end
-		  end
-	    end
-	 fun sci (x: real, ndig: int): string =
-	    let
-	       val sign = if x < zero then "~" else ""
-	       val (cs, decpt) = gdtoa (x, Sci, add1 ndig)
-	       val length = C.CS.length cs
-	       val whole = String.tabulate (1, fn _ => C.CS.sub (cs, 0))
-	       val frac =
-		  if 0 = ndig
-		     then ""
-		  else concat [".",
-			       String.tabulate
-			       (ndig, fn i =>
-				let
-				   val j = Int.+ (i, 1)
-				in
-				   if Int.< (j, length)
-				      then C.CS.sub (cs, j)
-				   else #"0"
-				end)]
-	       val exp = Int.- (decpt, 1)
-	       val exp =
-		  let
-		     val (exp, sign) =
-			if Int.< (exp, 0)
-			   then (Int.~ exp, "~")
-			else (exp, "")
-		  in
-		     concat [sign, Int.toString exp]
-		  end
-	    in
-	       concat [sign, whole, frac, "E", exp]
-	    end
-	 fun gen (x: real, n: int): string =
-	    case class x of
-	       INF => if x > zero then "inf" else "~inf"
-	     | NAN => "nan"
-	     | _ => 
-		  let
-		     val (prefix, x) =
-			if x < zero
-			   then ("~", ~ x)
-			else ("", x)
-		     val ss = Substring.full (sci (x, Int.- (n, 1)))
-		     fun isE c = c = #"E"
-		     fun isZero c = c = #"0"
-		     val expS =
-			Substring.string (Substring.taker (not o isE) ss)
-		     val exp = valOf (Int.fromString expS)
-		     val man =
-			String.translate
-			(fn #"." => "" | c => str c)
-			(Substring.string (Substring.dropr isZero
-					   (Substring.takel (not o isE) ss)))
-		     val manSize = String.size man
-		     fun zeros i = CharVector.tabulate (i, fn _ => #"0")
-		     fun dotAt i =
-			concat [String.substring (man, 0, i),
-				".", String.extract (man, i, NONE)]
-		     fun sci () = concat [prefix,
-					  if manSize = 1 then man else dotAt 1,
-					  "E", expS]
-		     val op - = Int.-
-		     val op + = Int.+
-		     val ~ = Int.~
-		     val op >= = Int.>=
-		  in
-		     if exp >= (if manSize = 1 then 3 else manSize + 3)
-			then sci ()
-		     else if exp >= manSize - 1
-			then concat [prefix, man, zeros (exp - (manSize - 1))]
-		     else if exp >= 0
-			then concat [prefix, dotAt (exp + 1)]
-		     else if exp >= (if manSize = 1 then ~2 else ~3)
-			then concat [prefix, "0.", zeros (~exp - 1), man]
-		     else sci ()
-		  end
+         fun fix (sign: string, cs: C.CS.t, decpt: int, ndig: int): string =
+            let
+               val length = C.CS.length cs
+            in
+               if Int.< (decpt, 0)
+                  then
+                     concat [sign,
+                             "0.",
+                             String.new (Int.~ decpt, #"0"),
+                             C.CS.toString cs,
+                             String.new (Int.+ (Int.- (ndig, length),
+                                                decpt),
+                                         #"0")]
+               else
+                  let 
+                     val whole =
+                        if decpt = 0
+                           then "0"
+                        else
+                           String.tabulate (decpt, fn i =>
+                                            if Int.< (i, length)
+                                               then C.CS.sub (cs, i)
+                                            else #"0")
+                  in
+                     if 0 = ndig
+                        then concat [sign, whole]
+                     else
+                        let
+                           val frac =
+                              String.tabulate
+                              (ndig, fn i =>
+                               let
+                                  val j = Int.+ (i, decpt)
+                               in
+                                  if Int.< (j, length)
+                                     then C.CS.sub (cs, j)
+                                  else #"0"
+                               end)
+                        in
+                           concat [sign, whole, ".", frac]
+                        end
+                  end
+            end
+         fun sci (x: real, ndig: int): string =
+            let
+               val sign = if x < zero then "~" else ""
+               val (cs, decpt) = gdtoa (x, Sci, add1 ndig)
+               val length = C.CS.length cs
+               val whole = String.tabulate (1, fn _ => C.CS.sub (cs, 0))
+               val frac =
+                  if 0 = ndig
+                     then ""
+                  else concat [".",
+                               String.tabulate
+                               (ndig, fn i =>
+                                let
+                                   val j = Int.+ (i, 1)
+                                in
+                                   if Int.< (j, length)
+                                      then C.CS.sub (cs, j)
+                                   else #"0"
+                                end)]
+               val exp = Int.- (decpt, 1)
+               val exp =
+                  let
+                     val (exp, sign) =
+                        if Int.< (exp, 0)
+                           then (Int.~ exp, "~")
+                        else (exp, "")
+                  in
+                     concat [sign, Int.toString exp]
+                  end
+            in
+               concat [sign, whole, frac, "E", exp]
+            end
+         fun gen (x: real, n: int): string =
+            case class x of
+               INF => if x > zero then "inf" else "~inf"
+             | NAN => "nan"
+             | _ => 
+                  let
+                     val (prefix, x) =
+                        if x < zero
+                           then ("~", ~ x)
+                        else ("", x)
+                     val ss = Substring.full (sci (x, Int.- (n, 1)))
+                     fun isE c = c = #"E"
+                     fun isZero c = c = #"0"
+                     val expS =
+                        Substring.string (Substring.taker (not o isE) ss)
+                     val exp = valOf (Int.fromString expS)
+                     val man =
+                        String.translate
+                        (fn #"." => "" | c => str c)
+                        (Substring.string (Substring.dropr isZero
+                                           (Substring.takel (not o isE) ss)))
+                     val manSize = String.size man
+                     fun zeros i = CharVector.tabulate (i, fn _ => #"0")
+                     fun dotAt i =
+                        concat [String.substring (man, 0, i),
+                                ".", String.extract (man, i, NONE)]
+                     fun sci () = concat [prefix,
+                                          if manSize = 1 then man else dotAt 1,
+                                          "E", expS]
+                     val op - = Int.-
+                     val op + = Int.+
+                     val ~ = Int.~
+                     val op >= = Int.>=
+                  in
+                     if exp >= (if manSize = 1 then 3 else manSize + 3)
+                        then sci ()
+                     else if exp >= manSize - 1
+                        then concat [prefix, man, zeros (exp - (manSize - 1))]
+                     else if exp >= 0
+                        then concat [prefix, dotAt (exp + 1)]
+                     else if exp >= (if manSize = 1 then ~2 else ~3)
+                        then concat [prefix, "0.", zeros (~exp - 1), man]
+                     else sci ()
+                  end
       in
-	 fun fmt spec =
-	    let
-	       val doit =
-		  case spec of
-		     EXACT => IEEEReal.toString o toDecimal
-		   | FIX opt =>
-			let
-			   val n =
-			      case opt of
-				 NONE => 6
-			       | SOME n =>
-				    if Primitive.safe andalso Int.< (n, 0)
-				       then raise Size
-				    else n
-			in
-			   fn x =>
-			   let
-			      val sign = if x < zero then "~" else ""
-			      val (cs, decpt) = gdtoa (x, Fix, n)
-			   in
-			      fix (sign, cs, decpt, n)
-			   end
-			end
-		   | GEN opt =>
-			let
-			   val n =
-			      case opt of
-				 NONE => 12
-			       | SOME n =>
-				    if Primitive.safe andalso Int.< (n, 1)
-				       then raise Size
-				    else n
-			in
-			   fn x => gen (x, n)
-			end
-		   | SCI opt =>
-			let
-			   val n =
-			      case opt of
-				 NONE => 6
-			       | SOME n =>
-				    if Primitive.safe andalso Int.< (n, 0)
-				       then raise Size
-				    else n
-			in
-			   fn x => sci (x, n)
-			end
-	    in
-	       fn x =>
-	       case class x of
-		  NAN => "nan"
-		| INF => if x > zero then "inf" else "~inf"
-		| _ => doit x
-	    end
+         fun fmt spec =
+            let
+               val doit =
+                  case spec of
+                     EXACT => IEEEReal.toString o toDecimal
+                   | FIX opt =>
+                        let
+                           val n =
+                              case opt of
+                                 NONE => 6
+                               | SOME n =>
+                                    if Primitive.safe andalso Int.< (n, 0)
+                                       then raise Size
+                                    else n
+                        in
+                           fn x =>
+                           let
+                              val sign = if x < zero then "~" else ""
+                              val (cs, decpt) = gdtoa (x, Fix, n)
+                           in
+                              fix (sign, cs, decpt, n)
+                           end
+                        end
+                   | GEN opt =>
+                        let
+                           val n =
+                              case opt of
+                                 NONE => 12
+                               | SOME n =>
+                                    if Primitive.safe andalso Int.< (n, 1)
+                                       then raise Size
+                                    else n
+                        in
+                           fn x => gen (x, n)
+                        end
+                   | SCI opt =>
+                        let
+                           val n =
+                              case opt of
+                                 NONE => 6
+                               | SOME n =>
+                                    if Primitive.safe andalso Int.< (n, 0)
+                                       then raise Size
+                                    else n
+                        in
+                           fn x => sci (x, n)
+                        end
+            in
+               fn x =>
+               case class x of
+                  NAN => "nan"
+                | INF => if x > zero then "inf" else "~inf"
+                | _ => doit x
+            end
       end
    
       val toString = fmt (StringCvt.GEN NONE)
 
       val fromLargeInt: LargeInt.int -> real =
-	 fn i =>
-	 fromInt (IntInf.toInt i)
-	 handle Overflow =>
-	    let
-	       val (i, sign) =
-		  if LargeInt.< (i, 0)
-		     then (LargeInt.~ i, true)
-		  else (i, false)
-	       val x = Prim.strto (NullString.fromString
-				   (concat [LargeInt.toString i, "\000"]))
-	    in
-	       if sign then ~ x else x		   
-	    end
-	 
+         fn i =>
+         fromInt (IntInf.toInt i)
+         handle Overflow =>
+            let
+               val (i, sign) =
+                  if LargeInt.< (i, 0)
+                     then (LargeInt.~ i, true)
+                  else (i, false)
+               val x = Prim.strto (NullString.fromString
+                                   (concat [LargeInt.toString i, "\000"]))
+            in
+               if sign then ~ x else x             
+            end
+         
       val toLargeInt: IEEEReal.rounding_mode -> real -> LargeInt.int =
-	 fn mode => fn x =>
-	 case class x of
-	    INF => raise Overflow
-	  | NAN => raise Domain
-	  | ZERO => 0
-	  | _ =>
-	       let
-		  (* This round may turn x into an INF, so we need to check the
-		   * class again.
-		   *)
-		  val x = roundReal (x, mode)
-	       in
-		  case class x of
-		     INF => raise Overflow
-		   | _ => 
-			if minInt <= x andalso x <= maxInt
-			   then LargeInt.fromInt (Prim.toInt x)
-			else
-			   valOf
-			   (LargeInt.fromString (fmt (StringCvt.FIX (SOME 0)) x))
-	       end
-	 
+         fn mode => fn x =>
+         case class x of
+            INF => raise Overflow
+          | NAN => raise Domain
+          | ZERO => 0
+          | _ =>
+               let
+                  (* This round may turn x into an INF, so we need to check the
+                   * class again.
+                   *)
+                  val x = roundReal (x, mode)
+               in
+                  case class x of
+                     INF => raise Overflow
+                   | _ => 
+                        if minInt <= x andalso x <= maxInt
+                           then LargeInt.fromInt (Prim.toInt x)
+                        else
+                           valOf
+                           (LargeInt.fromString (fmt (StringCvt.FIX (SOME 0)) x))
+               end
+         
       structure Math =
-	 struct
-	    open Prim.Math
+         struct
+            open Prim.Math
 
-	    (* Patch functions to handle out-of-range args.  Many C math
-	     * libraries do not do what the SML Basis Spec requires.
-	     *)
-	       
-	    local
-	       fun patch f x =
-		  if x < ~one orelse x > one
-		     then nan
-		  else f x
-	    in
-	       val acos = patch acos
-	       val asin = patch asin
-	    end
+            (* Patch functions to handle out-of-range args.  Many C math
+             * libraries do not do what the SML Basis Spec requires.
+             *)
+               
+            local
+               fun patch f x =
+                  if x < ~one orelse x > one
+                     then nan
+                  else f x
+            in
+               val acos = patch acos
+               val asin = patch asin
+            end
 
-	    local
-	       fun patch f x = if x < zero then nan else f x
-	    in
-	       val ln = patch ln
-	       val log10 = patch log10
-	    end
+            local
+               fun patch f x = if x < zero then nan else f x
+            in
+               val ln = patch ln
+               val log10 = patch log10
+            end
 
-	    (* The x86 doesn't get exp right on infs. *)
-	    val exp =
-	       if MLton.Codegen.isNative
-		  andalso let open MLton.Platform.Arch in host = X86 end
-		  then (fn x =>
-			case class x of
-			   INF => if x > zero then posInf else zero
-			 | _ => exp x)
-	       else exp
+            (* The x86 doesn't get exp right on infs. *)
+            val exp =
+               if MLton.Codegen.isNative
+                  andalso let open MLton.Platform.Arch in host = X86 end
+                  then (fn x =>
+                        case class x of
+                           INF => if x > zero then posInf else zero
+                         | _ => exp x)
+               else exp
 
-	    (* The Cygwin math library doesn't get pow right on some exceptional
-	     * cases.
-	     *
-	     * The Linux math library doesn't get pow (x, y) right when x < 0
-	     * and y is large (but finite).
-	     *
-	     * So, we define a pow function that gives the correct result on
-	     * exceptional cases, and only calls the C pow with x > 0.
-	     *)
-	    fun isInt (x: real): bool = x == realFloor x
+            (* The Cygwin math library doesn't get pow right on some exceptional
+             * cases.
+             *
+             * The Linux math library doesn't get pow (x, y) right when x < 0
+             * and y is large (but finite).
+             *
+             * So, we define a pow function that gives the correct result on
+             * exceptional cases, and only calls the C pow with x > 0.
+             *)
+            fun isInt (x: real): bool = x == realFloor x
 
-	    (* isEven x assumes isInt x. *)
-	    fun isEven (x: real): bool = isInt (x / two)
+            (* isEven x assumes isInt x. *)
+            fun isEven (x: real): bool = isInt (x / two)
 
-	    fun isOddInt x = isInt x andalso not (isEven x)
+            fun isOddInt x = isInt x andalso not (isEven x)
 
-	    fun isNeg x = x < zero
+            fun isNeg x = x < zero
 
-	    fun pow (x, y) =
-	       case class y of
-		  INF =>
-		     if class x = NAN
-			then nan
-		     else if x < negOne orelse x > one
-			then if isNeg y then zero else posInf
-		     else if negOne < x andalso x < one
-			then if isNeg y then posInf else zero
-		     else (* x = 1 orelse x = ~1 *)
-			nan
-		| NAN => nan
-		| ZERO => one
-		| _ =>
-		     (case class x of
-			 INF =>
-			    if isNeg x
-			       then if isNeg y
-				       then if isOddInt y
-					       then ~ zero
-					    else zero
-				    else if isOddInt y
-					    then negInf
-					 else posInf
-			    else (* x = posInf *)
-			       if isNeg y then zero else posInf
-		       | NAN => nan
-		       | ZERO =>
-			    if isNeg y
-			       then if isOddInt y
-				       then copySign (posInf, x)
-				    else posInf
-			    else if isOddInt y
-				    then x
-				 else zero
-		       | _ =>
-			    if isNeg x
-			       then if isInt y
-				       then if isEven y
-					       then Prim.Math.pow (~ x, y)
-					    else negOne * Prim.Math.pow (~ x, y)
-				    else nan
-			    else Prim.Math.pow (x, y))
+            fun pow (x, y) =
+               case class y of
+                  INF =>
+                     if class x = NAN
+                        then nan
+                     else if x < negOne orelse x > one
+                        then if isNeg y then zero else posInf
+                     else if negOne < x andalso x < one
+                        then if isNeg y then posInf else zero
+                     else (* x = 1 orelse x = ~1 *)
+                        nan
+                | NAN => nan
+                | ZERO => one
+                | _ =>
+                     (case class x of
+                         INF =>
+                            if isNeg x
+                               then if isNeg y
+                                       then if isOddInt y
+                                               then ~ zero
+                                            else zero
+                                    else if isOddInt y
+                                            then negInf
+                                         else posInf
+                            else (* x = posInf *)
+                               if isNeg y then zero else posInf
+                       | NAN => nan
+                       | ZERO =>
+                            if isNeg y
+                               then if isOddInt y
+                                       then copySign (posInf, x)
+                                    else posInf
+                            else if isOddInt y
+                                    then x
+                                 else zero
+                       | _ =>
+                            if isNeg x
+                               then if isInt y
+                                       then if isEven y
+                                               then Prim.Math.pow (~ x, y)
+                                            else negOne * Prim.Math.pow (~ x, y)
+                                    else nan
+                            else Prim.Math.pow (x, y))
 
-	    fun cosh x =
-	       case class x of
-		  INF => x
-		| ZERO => one
-		| _ => R.Math.cosh x
-		     
-	    fun sinh x =
-	       case class x of
-		  INF => x
-		| ZERO => x
-		| _ => R.Math.sinh x
-		     
-	    fun tanh x =
-	       case class x of
-		  INF => if x > zero then one else negOne
-		| ZERO => x
-		| _ => R.Math.tanh x
-	 end
+            fun cosh x =
+               case class x of
+                  INF => x
+                | ZERO => one
+                | _ => R.Math.cosh x
+                     
+            fun sinh x =
+               case class x of
+                  INF => x
+                | ZERO => x
+                | _ => R.Math.sinh x
+                     
+            fun tanh x =
+               case class x of
+                  INF => if x > zero then one else negOne
+                | ZERO => x
+                | _ => R.Math.tanh x
+         end
    end

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/real/real.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/real/real.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/real/real.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -41,10 +41,10 @@
       val nextAfterUp: real -> real
       val precision: int
       val radix: int
-      val signBit: real -> bool
+      val signBit: real -> int
       val strto: NullString.t -> real
       val toInt: real -> int
-      val toLarge: real -> LargeReal.real	 
+      val toLarge: real -> LargeReal.real        
   end
 
 signature REAL_GLOBAL =

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/real/real32.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/real/real32.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/real/real32.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,10 @@
+(* Copyright (C) 2003-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 structure Real32 =
   Real
   (structure P = Primitive.Real32
@@ -8,17 +15,17 @@
    val realToWord: real -> word =
       fn r =>
       Word.fromLarge (PackWord32Little.subVec (PackReal32Little.toBytes r, 0))
-	 
+         
    val wordToReal: word -> real =
       let
-	 val a = Word8Array.array (4, 0w0)
+         val a = Word8Array.array (4, 0w0)
       in
-	 fn w =>
-	 let
-	    val _ = PackWord32Little.update (a, 0, Word.toLarge w)
-	 in
-	    PackReal32Little.subArr (a, 0)
-	 end
+         fn w =>
+         let
+            val _ = PackWord32Little.update (a, 0, Word.toLarge w)
+         in
+            PackReal32Little.subArr (a, 0)
+         end
       end
 
    fun nextAfterUp r = wordToReal (Word.+ (realToWord r, 0w1))

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/real/real64.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/real/real64.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/real/real64.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,10 @@
+(* Copyright (C) 2003-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 structure Real64 =
   Real
   (structure P = Primitive.Real64

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/sml-nj/sml-nj.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/sml-nj/sml-nj.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/sml-nj/sml-nj.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,20 +1,20 @@
 signature SML_OF_NJ =
    sig
       structure Cont:
-	 sig
-	    type 'a cont
-	    val callcc: ('a cont -> 'a) -> 'a
-	    val throw: 'a cont -> 'a -> 'b
-	 end
+         sig
+            type 'a cont
+            val callcc: ('a cont -> 'a) -> 'a
+            val throw: 'a cont -> 'a -> 'b
+         end
       structure SysInfo:
-	 sig
-	    exception UNKNOWN
-	    datatype os_kind = BEOS | MACOS | OS2 | UNIX | WIN32
+         sig
+            exception UNKNOWN
+            datatype os_kind = BEOS | MACOS | OS2 | UNIX | WIN32
 
-	    val getHostArch: unit -> string
-	    val getOSKind: unit -> os_kind
-	    val getOSName: unit -> string
-	 end
+            val getHostArch: unit -> string
+            val getOSKind: unit -> os_kind
+            val getOSName: unit -> string
+         end
 
       val exnHistory: exn -> string list
       val exportFn: string * (string * string list -> OS.Process.status) -> unit

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/sml-nj/sml-nj.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/sml-nj/sml-nj.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/sml-nj/sml-nj.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,33 +1,47 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 structure SMLofNJ: SML_OF_NJ =
    struct
       structure Cont =
-	 struct
-	    structure C = MLton.Cont
+         struct
+            structure C = MLton.Cont
 
-	    type 'a cont = 'a C.t
-	    val callcc = C.callcc
-	    fun throw k v = C.throw (k, v)
-	 end
-      	 
+            type 'a cont = 'a C.t
+            val callcc = C.callcc
+            fun throw k v = C.throw (k, v)
+         end
+         
       structure SysInfo =
-	 struct
-	    exception UNKNOWN
-	    datatype os_kind = BEOS | MACOS | OS2 | UNIX | WIN32
+         struct
+            exception UNKNOWN
+            datatype os_kind = BEOS | MACOS | OS2 | UNIX | WIN32
 
-	    fun getHostArch () =
-	       MLton.Platform.Arch.toString MLton.Platform.Arch.host
-		     
-	    fun getOSKind () = UNIX
+            fun getHostArch () =
+               MLton.Platform.Arch.toString MLton.Platform.Arch.host
+                     
+            fun getOSKind () =
+               let
+                  open MLton.Platform.OS
+               in
+                  case host of
+                     Cygwin => UNIX
+                   | Darwin => MACOS
+                   | FreeBSD => UNIX
+                   | Linux => UNIX
+                   | MinGW => WIN32
+                   | NetBSD => UNIX
+                   | OpenBSD => UNIX
+                   | Solaris => UNIX
+               end
 
-	    fun getOSName () = MLton.Platform.OS.toString MLton.Platform.OS.host
-	 end
+            fun getOSName () = MLton.Platform.OS.toString MLton.Platform.OS.host
+         end
       
       val getCmdName = CommandLine.name
       val getArgs = CommandLine.arguments
@@ -37,21 +51,21 @@
       val exnHistory = MLton.Exn.history
 
       fun exportFn (file: string, f) =
-	 let
-	    open MLton.World OS.Process
-	 in
-	    case save (file ^ ".mlton") of
-	       Original => exit success
-	     | Clone => exit (f (getCmdName (), getArgs ()) handle _ => failure)
-	 end
+         let
+            open MLton.World OS.Process
+         in
+            case save (file ^ ".mlton") of
+               Original => exit success
+             | Clone => exit (f (getCmdName (), getArgs ()) handle _ => failure)
+         end
 
       fun exportML (f: string): bool =
-	 let
-	    open MLton.World
-	 in
-	    case save (f ^ ".mlton") of
-	       Clone => true
-	     | Original => false
-	 end
+         let
+            open MLton.World
+         in
+            case save (f ^ ".mlton") of
+               Clone => true
+             | Original => false
+         end
    end
    

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/sml-nj/unsafe.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/sml-nj/unsafe.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/sml-nj/unsafe.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -29,18 +29,18 @@
 signature UNSAFE =
    sig
       structure Array:
-	 sig
-	    val create: int * 'a -> 'a array
-	    val sub: 'a array * int -> 'a
-	    val update: 'a array * int * 'a -> unit
-	 end
+         sig
+            val create: int * 'a -> 'a array
+            val sub: 'a array * int -> 'a
+            val update: 'a array * int * 'a -> unit
+         end
       structure CharArray: UNSAFE_MONO_ARRAY
       structure CharVector: UNSAFE_MONO_VECTOR
       structure Real64Array: UNSAFE_MONO_ARRAY
       structure Vector:
-	 sig
-	    val sub: 'a vector * int -> 'a
-	 end
+         sig
+            val sub: 'a vector * int -> 'a
+         end
       structure Word8Array: UNSAFE_MONO_ARRAY
       structure Word8Vector: UNSAFE_MONO_VECTOR
    end

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/sml-nj/unsafe.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/sml-nj/unsafe.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/sml-nj/unsafe.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,9 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 functor UnsafeMonoArray (A: MONO_ARRAY_EXTRA): UNSAFE_MONO_ARRAY =
@@ -26,18 +26,18 @@
 structure Unsafe: UNSAFE =
    struct
       structure Array =
-	 struct
-	    val sub = Array.unsafeSub
-	    val update = Array.unsafeUpdate
-	    val create = Array.array
-	 end
+         struct
+            val sub = Array.unsafeSub
+            val update = Array.unsafeUpdate
+            val create = Array.array
+         end
       structure CharArray = UnsafeMonoArray (CharArray)
       structure CharVector = UnsafeMonoVector (CharVector)
       structure Real64Array = UnsafeMonoArray (Real64Array)
       structure Vector =
-      	 struct
-	    val sub = Vector.unsafeSub
-	 end
+         struct
+            val sub = Vector.unsafeSub
+         end
       structure Word8Array = UnsafeMonoArray (Word8Array)
       structure Word8Vector = UnsafeMonoVector (Word8Vector)
    end

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/sml-nj.mlb
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/sml-nj.mlb	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/sml-nj.mlb	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,7 +1,14 @@
+(* Copyright (C) 2004-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 ann  
    "deadCode true"
-   "sequenceUnit true"
-   "warnMatch true"
+   "sequenceNonUnit warn"
+   "nonexhaustiveMatch warn" "redundantMatch warn"
    "warnUnused true" "forceUsed"
 in
    local

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/system/command-line.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/system/command-line.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/system/command-line.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,16 +1,17 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 structure CommandLine: COMMAND_LINE =
    struct
       structure Prim = Primitive.CommandLine
-	 
+         
       fun name () = C.CS.toString (Prim.commandName ())
 
       fun arguments () =
-	 Array.toList (C.CSS.toArrayOfLength (Prim.argv (), Prim.argc ()))
+         Array.toList (C.CSS.toArrayOfLength (Prim.argv (), Prim.argc ()))
    end

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/system/date.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/system/date.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/system/date.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,22 +1,22 @@
 signature DATE =
    sig
       datatype weekday =
-	 Mon | Tue | Wed | Thu | Fri | Sat | Sun
+         Mon | Tue | Wed | Thu | Fri | Sat | Sun
 
       datatype month =
-	 Jan | Feb | Mar | Apr | May | Jun | Jul | Aug | Sep | Oct | Nov | Dec
-	 
+         Jan | Feb | Mar | Apr | May | Jun | Jul | Aug | Sep | Oct | Nov | Dec
+         
       type date
 
       exception Date
       
       val date: {year: int,
-		 month: month,
-		 day: int,
-		 hour: int,
-		 minute: int,
-		 second: int,
-		 offset: Time.time option} -> date 
+                 month: month,
+                 day: int,
+                 hour: int,
+                 minute: int,
+                 second: int,
+                 offset: Time.time option} -> date 
 
       val year: date -> int 
       val month: date -> month 

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/system/date.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/system/date.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/system/date.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,5 +1,8 @@
-(* Modified from the ML Kit Version 3 by sweeks@research.nj.nec.com on 1999-1-3.
- * Further modifications by sweeks@acm.org on 2000-1-18.
+(* Modified from the ML Kit 4.1.4; basislib/Date.sml
+ * by mfluet@acm.org on 2005-8-10 based on
+ *  modifications from the ML Kit Version 3; basislib/Date.sml
+ *  by sweeks@research.nj.nec.com on 1999-1-3 and
+ *  by sweeks@acm.org on 2000-1-18.
  *)
  
 (* Date -- 1995-07-03, 1998-04-07 *)
@@ -8,16 +11,16 @@
   struct
      structure Prim = Primitive.Date
      structure Tm = Prim.Tm
-	
+        
      (* Patch to make Time look like it deals with Int.int
       * instead of LargeInt.int.
       *)
      structure Time =
-	struct
-	   open Time
-	   val toSeconds = LargeInt.toInt o toSeconds
-	   val fromSeconds = fromSeconds o LargeInt.fromInt
-	end
+        struct
+           open Time
+           val toSeconds = LargeInt.toInt o toSeconds
+           val fromSeconds = fromSeconds o LargeInt.fromInt
+        end
 
     datatype weekday = Mon | Tue | Wed | Thu | Fri | Sat | Sun
 
@@ -26,16 +29,16 @@
 
     datatype t =
        T of {day: int, (* 1-31 *)
-	     hour: int, (* 0-23 *)
-	     isDst: bool option, (* daylight savings time in force *)
-	     minute: int, (* 0-59 *)
-	     month: month,
-	     offset: int option, (* signed seconds East of UTC:
-				  * this zone = UTC+t; ~82800 < t <= 82800 *)
-	     second: int, (* 0-61 (allowing for leap seconds) *)
-	     weekDay: weekday,
-	     year: int, (* e.g. 1995 *)
-	     yearDay: int} (* 0-365 *)
+             hour: int, (* 0-23 *)
+             isDst: bool option, (* daylight savings time in force *)
+             minute: int, (* 0-59 *)
+             month: month,
+             offset: int option, (* signed seconds East of UTC:
+                                  * this zone = UTC+t; ~82800 < t <= 82800 *)
+             second: int, (* 0-61 (allowing for leap seconds) *)
+             weekDay: weekday,
+             year: int, (* e.g. 1995 *)
+             yearDay: int} (* 0-365 *)
     type date = t
 
     local
@@ -57,44 +60,44 @@
     (* 86400 = 24*60*6 is the number of seconds per day *)
 
     type tmoz = {tm_hour   : int,
-		 tm_isdst  : int,	(* 0 = no, 1 = yes, ~1 = don't know *)
-		 tm_mday   : int,
-		 tm_min    : int,
-		 tm_mon    : int,
-		 tm_sec    : int, 
-		 tm_wday   : int,
-		 tm_yday   : int,
-		 tm_year   : int}
+                 tm_isdst  : int,       (* 0 = no, 1 = yes, ~1 = don't know *)
+                 tm_mday   : int,
+                 tm_min    : int,
+                 tm_mon    : int,
+                 tm_sec    : int, 
+                 tm_wday   : int,
+                 tm_yday   : int,
+                 tm_year   : int}
 
     local
-       fun make f (n: int): tmoz =
-	  (f (ref n)
-	   ; {tm_hour = Tm.hour (),
-	      tm_isdst = Tm.isdst (),
-	      tm_mday = Tm.mday (),
-	      tm_min = Tm.min (),
-	      tm_mon = Tm.mon (),
-	      tm_sec = Tm.sec (),
-	      tm_wday = Tm.wday (),
-	      tm_yday = Tm.yday (),
-	      tm_year = Tm.year ()})
+       fun make (f: int ref -> unit) (n: int): tmoz =
+          (f (ref n)
+           ; {tm_hour = Tm.hour (),
+              tm_isdst = Tm.isdst (),
+              tm_mday = Tm.mday (),
+              tm_min = Tm.min (),
+              tm_mon = Tm.mon (),
+              tm_sec = Tm.sec (),
+              tm_wday = Tm.wday (),
+              tm_yday = Tm.yday (),
+              tm_year = Tm.year ()})
     in
        val getlocaltime_ = make Prim.localTime
        val getunivtime_ = make Prim.gmTime
     end
 
     fun setTmBuf {tm_hour, tm_isdst, tm_mday, tm_min, tm_mon, tm_sec, tm_wday,
-		 tm_yday, tm_year} =
+                 tm_yday, tm_year} =
        (Tm.setHour tm_hour
-	; Tm.setIsdst tm_isdst
-	; Tm.setMday tm_mday
-	; Tm.setMin tm_min
-	; Tm.setMon tm_mon
-	; Tm.setSec tm_sec
-	; Tm.setWday tm_wday
-	; Tm.setYday tm_yday
-	; Tm.setYear tm_year)
-	
+        ; Tm.setIsdst tm_isdst
+        ; Tm.setMday tm_mday
+        ; Tm.setMin tm_min
+        ; Tm.setMon tm_mon
+        ; Tm.setSec tm_sec
+        ; Tm.setWday tm_wday
+        ; Tm.setYday tm_yday
+        ; Tm.setYear tm_year)
+        
     fun mktime_ (t: tmoz): int = (setTmBuf t; Prim.mkTime ())
 
     (* The offset to add to local time to get UTC: positive West of UTC *)
@@ -102,46 +105,46 @@
 
     val toweekday: int -> weekday =
        fn 0 => Sun | 1 => Mon | 2 => Tue | 3 => Wed
-	| 4 => Thu | 5 => Fri | 6 => Sat 
-	| _ => raise Fail "Internal error: Date.toweekday"
+        | 4 => Thu | 5 => Fri | 6 => Sat 
+        | _ => raise Fail "Internal error: Date.toweekday"
 
     val fromwday: weekday -> int =
        fn Sun => 0 | Mon => 1 | Tue => 2 | Wed => 3 
-	| Thu => 4 | Fri => 5 | Sat => 6
-	     
+        | Thu => 4 | Fri => 5 | Sat => 6
+             
     val tomonth: int -> month =
        fn 0 => Jan | 1 => Feb |  2 => Mar |  3 => Apr
-	| 4 => May | 5 => Jun |  6 => Jul |  7 => Aug
-	| 8 => Sep | 9 => Oct | 10 => Nov | 11 => Dec
-	| _ => raise Fail "Internal error: Date.tomonth"
+        | 4 => May | 5 => Jun |  6 => Jul |  7 => Aug
+        | 8 => Sep | 9 => Oct | 10 => Nov | 11 => Dec
+        | _ => raise Fail "Internal error: Date.tomonth"
 
     val frommonth: month -> int =
        fn Jan => 0 | Feb => 1 | Mar => 2  | Apr => 3
-	| May => 4 | Jun => 5 | Jul => 6  | Aug => 7
-	| Sep => 8 | Oct => 9 | Nov => 10 | Dec => 11
-	
+        | May => 4 | Jun => 5 | Jul => 6  | Aug => 7
+        | Sep => 8 | Oct => 9 | Nov => 10 | Dec => 11
+        
     fun tmozToDate ({tm_hour, tm_isdst, tm_mday, tm_min, tm_mon, tm_sec,
-		    tm_wday, tm_yday, tm_year}: tmoz) offset = 
+                    tm_wday, tm_yday, tm_year}: tmoz) offset = 
        T {day = tm_mday,
-	  hour = tm_hour,
-	  isDst = (case tm_isdst of
-		      0 => SOME false 
-		    | 1 => SOME true
-		    | _ => NONE),
-	  minute = tm_min, 
-	  month = tomonth tm_mon, 
-	  offset = offset,
-	  second = tm_sec,
-	  weekDay = toweekday tm_wday,
-	  year = tm_year + 1900,
-	  yearDay = tm_yday}
+          hour = tm_hour,
+          isDst = (case tm_isdst of
+                      0 => SOME false 
+                    | 1 => SOME true
+                    | _ => NONE),
+          minute = tm_min, 
+          month = tomonth tm_mon, 
+          offset = offset,
+          second = tm_sec,
+          weekDay = toweekday tm_wday,
+          year = tm_year + 1900,
+          yearDay = tm_yday}
 
     fun leapyear (y: int) =
        y mod 4 = 0 andalso y mod 100 <> 0 orelse y mod 400 = 0   
 
     fun monthdays year month : int = 
       case month of
-	 Jan => 31
+         Jan => 31
        | Feb => if leapyear year then 29 else 28
        | Mar => 31
        | Apr => 30
@@ -157,28 +160,28 @@
     (* Check whether date may be passed to ISO/ANSI C functions: *)
 
     fun okDate (T {year, month, day, hour, minute, second, ...}) =
-	1900 <= year 
-	andalso 1 <= day    andalso day    <= monthdays year month
-	andalso 0 <= hour   andalso hour   <= 23
-	andalso 0 <= minute andalso minute <= 59
-	andalso 0 <= second andalso second <= 61 (* leap seconds *)
+        1900 <= year 
+        andalso 1 <= day    andalso day    <= monthdays year month
+        andalso 0 <= hour   andalso hour   <= 23
+        andalso 0 <= minute andalso minute <= 59
+        andalso 0 <= second andalso second <= 61 (* leap seconds *)
 
     fun dateToTmoz (dt as T {year, month, day, hour, minute, second,
-			     weekDay, yearDay, isDst, ...}): tmoz =
-	if not (okDate dt)
-	   then raise Date
-	else {tm_hour = hour,
-	      tm_mday = day,
-	      tm_min = minute, 
-	      tm_mon = frommonth month,
-	      tm_sec = second, 
-	      tm_year = year -? 1900, 
-	      tm_isdst = (case isDst of
-			     SOME false => 0
-			   | SOME true => 1
-			   | NONE=> ~1),
-	      tm_wday = fromwday weekDay,
-	      tm_yday = yearDay}
+                             weekDay, yearDay, isDst, ...}): tmoz =
+        if not (okDate dt)
+           then raise Date
+        else {tm_hour = hour,
+              tm_mday = day,
+              tm_min = minute, 
+              tm_mon = frommonth month,
+              tm_sec = second, 
+              tm_year = year -? 1900, 
+              tm_isdst = (case isDst of
+                             SOME false => 0
+                           | SOME true => 1
+                           | NONE=> ~1),
+              tm_wday = fromwday weekDay,
+              tm_yday = yearDay}
 
     (* -------------------------------------------------- *)
     (* Translated from Emacs's calendar.el:               *)
@@ -186,53 +189,53 @@
     (* Reingold: Number of the day within the year: *)
 
     fun dayinyear (year: int, month: month, day: int): int = 
-	let val monthno = frommonth month
-	in
-	    day - 1 + 31 * monthno
-	    - (if monthno > 1 then 
-		   (27 + 4 * monthno) div 10 - (if leapyear year then 1 else 0)
-	       else 0)
-	end
+        let val monthno = frommonth month
+        in
+            day - 1 + 31 * monthno
+            - (if monthno > 1 then 
+                   (27 + 4 * monthno) div 10 - (if leapyear year then 1 else 0)
+               else 0)
+        end
 
     (* Reingold: Find the number of days elapsed from the (imagined)
        Gregorian date Sunday, December 31, 1 BC to the given date. *)
-	
+        
     fun todaynumber year month day = 
         let val prioryears = year - 1
-	in
-	    dayinyear (year, month, day)
-	  + 1
-	  + 365 * prioryears
-	  + prioryears div 4
+        in
+            dayinyear (year, month, day)
+          + 1
+          + 365 * prioryears
+          + prioryears div 4
           - prioryears div 100
           + prioryears div 400
-	end
+        end
 
     (* Reingold et al: from absolute day number to year, month, date: *)
 
     fun fromdaynumber n = 
-	let val d0 = n - 1
-	    val n400 = d0 div 146097
-	    val d1 = d0 mod 146097
-	    val n100 = d1 div 36524
-	    val d2 = d1 mod 36524
-	    val n4 = d2 div 1461
-	    val d3 = d2 mod 1461
-	    val n1 = d3 div 365
-	    val day = 1 + d3 mod 365
-	    val year = 400 * n400 + 100 * n100 + n4 * 4 + n1 + 1
-	    fun loop month day =
-		let val mdays = monthdays year (tomonth month)
-		in 
-		    if mdays < day then loop (month+1) (day-mdays)
-		    else (year, tomonth month, day)
-		end
-	in 
-	    if n100 = 4 orelse n1 = 4 then 
-		(year-1, Dec, 31)
-	    else
-		loop 0 day 
-	end	    
+        let val d0 = n - 1
+            val n400 = d0 div 146097
+            val d1 = d0 mod 146097
+            val n100 = d1 div 36524
+            val d2 = d1 mod 36524
+            val n4 = d2 div 1461
+            val d3 = d2 mod 1461
+            val n1 = d3 div 365
+            val day = 1 + d3 mod 365
+            val year = 400 * n400 + 100 * n100 + n4 * 4 + n1 + 1
+            fun loop month day =
+                let val mdays = monthdays year (tomonth month)
+                in 
+                    if mdays < day then loop (month+1) (day-mdays)
+                    else (year, tomonth month, day)
+                end
+        in 
+            if n100 = 4 orelse n1 = 4 then 
+                (year-1, Dec, 31)
+            else
+                loop 0 day 
+        end         
 
     (* -------------------------------------------------- *)
 
@@ -241,124 +244,124 @@
     (* Normalize a date, disregarding leap seconds: *)
    
     fun normalizedate yr0 mo0 dy0 hr0 mn0 sec0 offset =
-	let val mn1    = mn0 + sec0 div 60
-	    val second = sec0 mod 60
-	    val hr1    = hr0 + mn1 div 60
-	    val minute = mn1 mod 60
-	    val dayno  = todaynumber yr0 mo0 dy0 + hr1 div 24
-	    val hour   = hr1 mod 24
-	    val (year, month, day) = fromdaynumber dayno
-	    val date1 = T {day = day,
-			   hour = hour,
-			   isDst = (case offset of 
-				       NONE   => NONE 
-				     | SOME _ => SOME false),
-			   minute = minute,
-			   month = month,
-			   offset = offset,
-			   second = second,
-			   weekDay = weekday dayno,
-			   year = year,
-			   yearDay = dayinyear (year, month, day)}
-	in 
+        let val mn1    = mn0 + sec0 div 60
+            val second = sec0 mod 60
+            val hr1    = hr0 + mn1 div 60
+            val minute = mn1 mod 60
+            val dayno  = todaynumber yr0 mo0 dy0 + hr1 div 24
+            val hour   = hr1 mod 24
+            val (year, month, day) = fromdaynumber dayno
+            val date1 = T {day = day,
+                           hour = hour,
+                           isDst = (case offset of 
+                                       NONE   => NONE 
+                                     | SOME _ => SOME false),
+                           minute = minute,
+                           month = month,
+                           offset = offset,
+                           second = second,
+                           weekDay = weekday dayno,
+                           year = year,
+                           yearDay = dayinyear (year, month, day)}
+        in 
             (* One cannot reliably compute DST in non-local timezones,
-	    not even given the offset from UTC.  Countries in the
-	    Northern hemisphere have DST during Mar-Oct, those around
-	    Equator do not have DST, and those in the Southern
-	    hemisphere have DST during Oct-Mar. *)
-	    if year < 1970 orelse year > 2037 then date1
-	    else 
-		case offset of 
-		    NONE   => 
-			tmozToDate (getlocaltime_ (mktime_ (dateToTmoz date1)))
-			offset
-		  | SOME _ => date1
-	end
+            not even given the offset from UTC.  Countries in the
+            Northern hemisphere have DST during Mar-Oct, those around
+            Equator do not have DST, and those in the Southern
+            hemisphere have DST during Oct-Mar. *)
+            if year < 1970 orelse year > 2037 then date1
+            else 
+                case offset of 
+                    NONE   => 
+                        tmozToDate (getlocaltime_ (mktime_ (dateToTmoz date1)))
+                        offset
+                  | SOME _ => date1
+        end
 
     fun fromTimeLocal t = 
-	tmozToDate (getlocaltime_ (Time.toSeconds t)) NONE
+        tmozToDate (getlocaltime_ (Time.toSeconds t)) NONE
 
     fun fromTimeUniv t = 
-	tmozToDate (getunivtime_ (Time.toSeconds t)) (SOME 0)
+        tmozToDate (getunivtime_ (Time.toSeconds t)) (SOME 0)
 
     (* The following implements conversion from a local date to 
      * a Time.time.  It IGNORES wday and yday.
      *)
 
     fun toTime (date as T {offset, ...}) = 
-	let
-	   val secoffset = 
-	      case offset of
-		 NONE      => 0
-	       | SOME secs => localoffset + secs
-	    val clock = mktime_ (dateToTmoz date) - secoffset
-	in
-	    if clock < 0 then raise Date
-	    else Time.fromSeconds clock
-	end
+        let
+           val secoffset = 
+              case offset of
+                 NONE      => 0
+               | SOME secs => localoffset + secs
+            val clock = mktime_ (dateToTmoz date) - secoffset
+        in
+            if clock < 0 then raise Date
+            else Time.fromSeconds clock
+        end
 
     fun localOffset () = Time.fromSeconds (localoffset mod 86400)
 
     local
        val isFormatChar =
-	  let
-	     val a = Array.tabulate (Char.maxOrd + 1, fn _ => false)
-	     val validChars = "aAbBcdHIjmMpSUwWxXyYZ%"
-	  in Util.naturalForeach
-	     (size validChars, fn i =>
-	      Array.update (a, Char.ord (String.sub (validChars, i)), true));
-	     fn c => Array.sub (a, Char.ord c)
-	  end
-    in	   
+          let
+             val a = Array.tabulate (Char.maxOrd + 1, fn _ => false)
+             val validChars = "aAbBcdHIjmMpSUwWxXyYZ%"
+          in Util.naturalForeach
+             (size validChars, fn i =>
+              Array.update (a, Char.ord (String.sub (validChars, i)), true));
+             fn c => Array.sub (a, Char.ord c)
+          end
+    in     
        fun fmt fmtStr d =
-	  let
-	     val _ = setTmBuf (dateToTmoz d)
-	     val bufLen = 50 (* more than enough for a single format char *)
-	     val buf = Primitive.Array.array bufLen
-	     fun strftime fmtChar =
-		let
-		   val len =
-		      Prim.strfTime
-		      (buf, bufLen,
-		       NullString.fromString (concat ["%", str fmtChar, "\000"]))
-		in if len = 0
-		      then raise Fail "Date.fmt"
-		   else ArraySlice.vector (ArraySlice.slice (buf, 0, SOME len))
-		end
-	     val max = size fmtStr
-	     fun loop (i, start, accum) =
-		let
-		   fun newAccum () =
-		      let val len = i - start
-		      in
-			 if len = 0
-			    then accum
-			 else String.extract (fmtStr, start, SOME len) :: accum
-		      end
-		in
-		   if i >= max
-		      then newAccum ()
-		   else
-		      if #"%" = String.sub (fmtStr, i)
-			 then
-			    let
-			       val i = i + 1
-			    in
-			       if i >= max
-				  then newAccum ()
-			       else let
-				       val c = String.sub (fmtStr, i)
-				    in
-				       if isFormatChar c
-					  then loop (i + 1, i + 1,
-						     strftime c :: newAccum ())
-				       else loop (i, i, newAccum ())
-				    end
-			    end
-		      else loop (i + 1, start, accum)
-		end
-	  in concat (rev (loop (0, 0, [])))
-	  end
+          let
+             val _ = setTmBuf (dateToTmoz d)
+             val bufLen = 50 (* more than enough for a single format char *)
+             val buf = Primitive.Array.array bufLen
+             fun strftime fmtChar =
+                let
+                   val len =
+                      Prim.strfTime
+                      (buf, bufLen,
+                       NullString.fromString (concat ["%", str fmtChar, "\000"]))
+                in if len = 0
+                      then raise Fail "Date.fmt"
+                   else ArraySlice.vector (ArraySlice.slice (buf, 0, SOME len))
+                end
+             val max = size fmtStr
+             fun loop (i, start, accum) =
+                let
+                   fun newAccum () =
+                      let val len = i - start
+                      in
+                         if len = 0
+                            then accum
+                         else String.extract (fmtStr, start, SOME len) :: accum
+                      end
+                in
+                   if i >= max
+                      then newAccum ()
+                   else
+                      if #"%" = String.sub (fmtStr, i)
+                         then
+                            let
+                               val i = i + 1
+                            in
+                               if i >= max
+                                  then newAccum ()
+                               else let
+                                       val c = String.sub (fmtStr, i)
+                                    in
+                                       if isFormatChar c
+                                          then loop (i + 1, i + 1,
+                                                     strftime c :: newAccum ())
+                                       else loop (i, i, newAccum ())
+                                    end
+                            end
+                      else loop (i + 1, start, accum)
+                end
+          in concat (rev (loop (0, 0, [])))
+          end
     end
 
     val toString = fmt "%a %b %d %H:%M:%S %Y"
@@ -367,176 +370,176 @@
        
     fun scan (reader: (char, 'a) reader): (t, 'a) reader =
        let
-	  type 'b t = ('b, 'a) reader
-	  val none: 'b t = fn _ => NONE
-	  fun done (b: 'b): 'b t = fn a => SOME (b, a)
-	  fun peek1 (f: char -> 'b t): 'b t =
-	     fn a =>
-	     case reader a of
-		NONE => NONE
-	      | SOME (c, _) => f c a
-	  fun read1 (f: char -> 'b t): 'b t =
-	     fn a =>
-	     case reader a of
-		NONE => NONE
-	      | SOME (c, a) => f c a
-	  fun skipSpace (r: 'b t): 'b t =
-	     let
-		fun loop (): 'b t =
-		   peek1 (fn c =>
-			  if Char.isSpace c
-			     then read1 (fn _ => loop ())
-			  else r)
-	     in
-		loop ()
-	     end
-	  fun readN (n: int, f: string -> 'b t): 'b t =
-	     let
-		fun loop (n: int, ac: char list): 'b t =
-		   if 0 = n
-		      then f (implode (rev ac))
-		   else read1 (fn c => loop (n - 1, c :: ac))
-	     in
-		loop (n, [])
-	     end
-	  fun readChar (c: char, r: 'b t): 'b t =
-	     read1 (fn c' => if c = c' then r else none)
-	  fun readWeekDay (f: weekday -> 'b t): 'b t =
-	     readN (3, fn s =>
-		    case s of
-		       "Mon" => f Mon
-		     | "Tue" => f Tue
-		     | "Wed" => f Wed
-		     | "Thu" => f Thu
-		     | "Fri" => f Fri
-		     | "Sat" => f Sat
-		     | "Sun" => f Sun
-		     | _ => none)
-	  fun readMonth (f: month -> 'b t): 'b t =
-	     readN (3, fn s =>
-		    case s of
-		       "Jan" => f Jan
-		     | "Feb" => f Feb
-		     | "Mar" => f Mar
-		     | "Apr" => f Apr
-		     | "May" => f May
-		     | "Jun" => f Jun
-		     | "Jul" => f Jul
-		     | "Aug" => f Aug
-		     | "Sep" => f Sep
-		     | "Oct" => f Oct
-		     | "Nov" => f Nov
-		     | "Dec" => f Dec
-		     | _ => none)
-	  fun readDigs (n: int, lower: int, upper: int, f: int -> 'b t): 'b t =
-	     readN (n, fn s =>
-		    if not (CharVector.all Char.isDigit s)
-		       then none
-		    else
-		       let
-			  val v =
-			     CharVector.foldl
-			     (fn (c, ac) =>
-			      ac * 10 + (Char.ord c - Char.ord #"0"))
-			     0 s
-		       in
-			  if lower <= v andalso v <= upper
-			     then f v
-			  else none
-		       end)
-	  fun readDay f =
-	     peek1 (fn c =>
-		    if c = #" "
-		       then read1 (fn _ => readDigs (1, 1, 9, f))
-		    else readDigs (2, 1, 31, f))
-	  fun readHour f = readDigs (2, 0, 23, f)
-	  fun readMinute f = readDigs (2, 0, 59, f)
-	  fun readSeconds f = readDigs (2, 0, 61, f)
-	  fun readYear f = readDigs (4, 0, 9999, f)
+          type 'b t = ('b, 'a) reader
+          val none: 'b t = fn _ => NONE
+          fun done (b: 'b): 'b t = fn a => SOME (b, a)
+          fun peek1 (f: char -> 'b t): 'b t =
+             fn a =>
+             case reader a of
+                NONE => NONE
+              | SOME (c, _) => f c a
+          fun read1 (f: char -> 'b t): 'b t =
+             fn a =>
+             case reader a of
+                NONE => NONE
+              | SOME (c, a) => f c a
+          fun skipSpace (r: 'b t): 'b t =
+             let
+                fun loop (): 'b t =
+                   peek1 (fn c =>
+                          if Char.isSpace c
+                             then read1 (fn _ => loop ())
+                          else r)
+             in
+                loop ()
+             end
+          fun readN (n: int, f: string -> 'b t): 'b t =
+             let
+                fun loop (n: int, ac: char list): 'b t =
+                   if 0 = n
+                      then f (implode (rev ac))
+                   else read1 (fn c => loop (n - 1, c :: ac))
+             in
+                loop (n, [])
+             end
+          fun readChar (c: char, r: 'b t): 'b t =
+             read1 (fn c' => if c = c' then r else none)
+          fun readWeekDay (f: weekday -> 'b t): 'b t =
+             readN (3, fn s =>
+                    case s of
+                       "Mon" => f Mon
+                     | "Tue" => f Tue
+                     | "Wed" => f Wed
+                     | "Thu" => f Thu
+                     | "Fri" => f Fri
+                     | "Sat" => f Sat
+                     | "Sun" => f Sun
+                     | _ => none)
+          fun readMonth (f: month -> 'b t): 'b t =
+             readN (3, fn s =>
+                    case s of
+                       "Jan" => f Jan
+                     | "Feb" => f Feb
+                     | "Mar" => f Mar
+                     | "Apr" => f Apr
+                     | "May" => f May
+                     | "Jun" => f Jun
+                     | "Jul" => f Jul
+                     | "Aug" => f Aug
+                     | "Sep" => f Sep
+                     | "Oct" => f Oct
+                     | "Nov" => f Nov
+                     | "Dec" => f Dec
+                     | _ => none)
+          fun readDigs (n: int, lower: int, upper: int, f: int -> 'b t): 'b t =
+             readN (n, fn s =>
+                    if not (CharVector.all Char.isDigit s)
+                       then none
+                    else
+                       let
+                          val v =
+                             CharVector.foldl
+                             (fn (c, ac) =>
+                              ac * 10 + (Char.ord c - Char.ord #"0"))
+                             0 s
+                       in
+                          if lower <= v andalso v <= upper
+                             then f v
+                          else none
+                       end)
+          fun readDay f =
+             peek1 (fn c =>
+                    if c = #" "
+                       then read1 (fn _ => readDigs (1, 1, 9, f))
+                    else readDigs (2, 1, 31, f))
+          fun readHour f = readDigs (2, 0, 23, f)
+          fun readMinute f = readDigs (2, 0, 59, f)
+          fun readSeconds f = readDigs (2, 0, 61, f)
+          fun readYear f = readDigs (4, 0, 9999, f)
        in
-	  skipSpace
-	  (readWeekDay
-	   (fn weekDay =>
-	    readChar
-	    (#" ",
-	     readMonth
-	     (fn month =>
-	      readChar
-	      (#" ",
-	       readDay
-	       (fn day =>
-		readChar
-		(#" ",
-		 readHour
-		 (fn hour =>
-		  readChar
-		  (#":",
-		   readMinute
-		   (fn minute =>
-		    (readChar
-		     (#":",
-		      readSeconds
-		      (fn second =>
-		       readChar
-		       (#" ",
-			readYear
-			(fn year =>
-			 done (T {day = day,
-				  hour = hour,
-				  isDst = NONE,
-				  minute = minute,
-				  month = month,
-				  offset = NONE,
-				  second = second,
-				  weekDay = weekDay,
-				  year = year,
-				  yearDay = dayinyear (year, month, day)}
-			       ))))))))))))))))
+          skipSpace
+          (readWeekDay
+           (fn weekDay =>
+            readChar
+            (#" ",
+             readMonth
+             (fn month =>
+              readChar
+              (#" ",
+               readDay
+               (fn day =>
+                readChar
+                (#" ",
+                 readHour
+                 (fn hour =>
+                  readChar
+                  (#":",
+                   readMinute
+                   (fn minute =>
+                    (readChar
+                     (#":",
+                      readSeconds
+                      (fn second =>
+                       readChar
+                       (#" ",
+                        readYear
+                        (fn year =>
+                         done (T {day = day,
+                                  hour = hour,
+                                  isDst = NONE,
+                                  minute = minute,
+                                  month = month,
+                                  offset = NONE,
+                                  second = second,
+                                  weekDay = weekDay,
+                                  year = year,
+                                  yearDay = dayinyear (year, month, day)}
+                               ))))))))))))))))
        end
        
     fun fromString s = StringCvt.scanString scan s
 
     (* Ignore timezone and DST when comparing dates: *)
     fun compare 
-	(T {year=y1,month=mo1,day=d1,hour=h1,minute=mi1,second=s1, ...},
-	 T {year=y2,month=mo2,day=d2,hour=h2,minute=mi2,second=s2, ...}) =
-	let
-	   fun cmp (v1, v2, cmpnext) = 
-	      case Int.compare (v1, v2) of
-		 EQUAL => cmpnext ()
-	       | r => r
-	in 
-	    cmp (y1, y2, 
-	    fn _ => cmp (frommonth mo1, frommonth mo2, 
-	    fn _ => cmp (d1, d2, 		
-	    fn _ => cmp (h1, h2,
-	    fn _ => cmp (mi1, mi2,
-	    fn _ => cmp (s1, s2,
-	    fn _ => EQUAL))))))
-	end
+        (T {year=y1,month=mo1,day=d1,hour=h1,minute=mi1,second=s1, ...},
+         T {year=y2,month=mo2,day=d2,hour=h2,minute=mi2,second=s2, ...}) =
+        let
+           fun cmp (v1, v2, cmpnext) = 
+              case Int.compare (v1, v2) of
+                 EQUAL => cmpnext ()
+               | r => r
+        in 
+            cmp (y1, y2, 
+            fn _ => cmp (frommonth mo1, frommonth mo2, 
+            fn _ => cmp (d1, d2,                
+            fn _ => cmp (h1, h2,
+            fn _ => cmp (mi1, mi2,
+            fn _ => cmp (s1, s2,
+            fn _ => EQUAL))))))
+        end
 
     fun date { year, month, day, hour, minute, second, offset } =
        if year < 0 then raise Date 
        else
-	  let
-	     val (dayoffset, offset') = 
-		case offset of
-		   NONE => (0, NONE)
-		 | SOME time => 
-		      let
-			 val secs = Time.toSeconds time
-			 val secoffset = 
-			    if secs <= 82800 then ~secs else 86400 - secs
-		      in
-			 (Int.quot (secs, 86400), SOME secoffset)
-		      end
-	     val day' = day + dayoffset
-	  in
-	     normalizedate year month day' hour minute second offset'
-	  end
+          let
+             val (dayoffset, offset') = 
+                case offset of
+                   NONE => (0, NONE)
+                 | SOME time => 
+                      let
+                         val secs = Time.toSeconds time
+                         val secoffset = 
+                            if secs <= 82800 then ~secs else 86400 - secs
+                      in
+                         (Int.quot (secs, 86400), SOME secoffset)
+                      end
+             val day' = day + dayoffset
+          in
+             normalizedate year month day' hour minute second offset'
+          end
 
     fun offset (T {offset, ...}) = 
-	Option.map
-	(fn secs => Time.fromSeconds ((86400 + secs) mod 86400)) 
-	offset
+        Option.map
+        (fn secs => Time.fromSeconds ((86400 + secs) mod 86400)) 
+        offset
   end

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/system/file-sys.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/system/file-sys.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/system/file-sys.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -22,10 +22,10 @@
       val chDir  = P_FSys.chdir
       val getDir = P_FSys.getcwd
       local
-	 structure S = P_FSys.S
-	 val mode777 = S.flags[S.irwxu, S.irwxg, S.irwxo]
+         structure S = P_FSys.S
+         val mode777 = S.flags[S.irwxu, S.irwxg, S.irwxo]
       in
-	 fun mkDir path = P_FSys.mkdir(path, mode777)
+         fun mkDir path = P_FSys.mkdir(path, mode777)
       end
       val rmDir  = P_FSys.rmdir
       val isDir  = P_FSys.ST.isDir o P_FSys.stat
@@ -40,112 +40,112 @@
 
       (* A UNIX specific implementation of fullPath *)
       fun fullPath p =
-	 let
-	    val oldCWD = getDir()
-	    fun mkPath pathFromRoot =
-	       P.toString {arcs = List.rev pathFromRoot,
-			   isAbs = true,
-			   vol = ""}
-	    fun walkPath (n, pathFromRoot, arcs) =
-	       if n = 0
-		  then raise PosixError.SysErr ("too many links", NONE)
-	       else
-		  case arcs of
-		     [] => mkPath pathFromRoot
-		   | arc :: al =>
-			if arc = "" orelse arc = "."
-			   then walkPath (n, pathFromRoot, al)
-			else if arc = ".."
-				then
-				   case pathFromRoot of
-				      [] => walkPath (n, [], al)
-				    | _ :: r =>
-					 (chDir ".."; walkPath (n, r, al))
-		        else
-			   if isLink arc
-			      then expandLink (n, pathFromRoot, arc, al)
-			   else
-			      case al of
-				 [] => mkPath (arc :: pathFromRoot)
-			       | _ =>
-				    (chDir arc
-				     ; walkPath (n, arc :: pathFromRoot, al))
-	    and expandLink (n, pathFromRoot, link, rest) =
-	       let
-		  val {isAbs, arcs, ...} = P.fromString (readLink link)
-		  val arcs = List.@ (arcs, rest)
-	       in 
-		  if isAbs
-		     then gotoRoot (n-1, arcs)
-		  else walkPath (n-1, pathFromRoot, arcs)
-	       end
-	    and gotoRoot (n, arcs) =
-	       (chDir "/"; walkPath (n, [], arcs))
-	    fun computeFullPath arcs =
-	       (gotoRoot (maxLinks, arcs) before chDir oldCWD)
-	       handle ex => (chDir oldCWD; raise ex)
-	 in
-	    case (P.fromString p)
-	       of {isAbs=false, arcs, ...} =>
-		  let
-		     val {arcs=arcs', ...} = P.fromString(oldCWD)
-		  in
-		     computeFullPath (List.@(arcs', arcs))
-		  end
-	     | {isAbs=true, arcs, ...} => computeFullPath arcs
-	 end
+         let
+            val oldCWD = getDir()
+            fun mkPath pathFromRoot =
+               P.toString {arcs = List.rev pathFromRoot,
+                           isAbs = true,
+                           vol = ""}
+            fun walkPath (n, pathFromRoot, arcs) =
+               if n = 0
+                  then raise PosixError.SysErr ("too many links", NONE)
+               else
+                  case arcs of
+                     [] => mkPath pathFromRoot
+                   | arc :: al =>
+                        if arc = "" orelse arc = "."
+                           then walkPath (n, pathFromRoot, al)
+                        else if arc = ".."
+                                then
+                                   case pathFromRoot of
+                                      [] => walkPath (n, [], al)
+                                    | _ :: r =>
+                                         (chDir ".."; walkPath (n, r, al))
+                        else
+                           if isLink arc
+                              then expandLink (n, pathFromRoot, arc, al)
+                           else
+                              case al of
+                                 [] => mkPath (arc :: pathFromRoot)
+                               | _ =>
+                                    (chDir arc
+                                     ; walkPath (n, arc :: pathFromRoot, al))
+            and expandLink (n, pathFromRoot, link, rest) =
+               let
+                  val {isAbs, arcs, ...} = P.fromString (readLink link)
+                  val arcs = List.@ (arcs, rest)
+               in 
+                  if isAbs
+                     then gotoRoot (n-1, arcs)
+                  else walkPath (n-1, pathFromRoot, arcs)
+               end
+            and gotoRoot (n, arcs) =
+               (chDir "/"; walkPath (n, [], arcs))
+            fun computeFullPath arcs =
+               (gotoRoot (maxLinks, arcs) before chDir oldCWD)
+               handle ex => (chDir oldCWD; raise ex)
+         in
+            case (P.fromString p)
+               of {isAbs=false, arcs, ...} =>
+                  let
+                     val {arcs=arcs', ...} = P.fromString(oldCWD)
+                  in
+                     computeFullPath (List.@(arcs', arcs))
+                  end
+             | {isAbs=true, arcs, ...} => computeFullPath arcs
+         end
 
       fun realPath p =
-	 if P.isAbsolute p
-	    then fullPath p
-	 else P.mkRelative {path = fullPath p,
-			    relativeTo = fullPath (getDir ())}
+         if P.isAbsolute p
+            then fullPath p
+         else P.mkRelative {path = fullPath p,
+                            relativeTo = fullPath (getDir ())}
 
       val fileSize = P_FSys.ST.size o P_FSys.stat
 
       val modTime = P_FSys.ST.mtime o P_FSys.stat
 
       fun setTime (path, t) =
-	 P_FSys.utime (path, Option.map (fn t => {actime = t, modtime = t}) t)
+         P_FSys.utime (path, Option.map (fn t => {actime = t, modtime = t}) t)
 
       val remove = P_FSys.unlink
-	 
+         
       val rename = P_FSys.rename
 
       datatype access_mode = datatype Posix.FileSys.access_mode
 
       fun access (path, al) =
-	 let
-	    fun cvt A_READ = P_FSys.A_READ
-	      | cvt A_WRITE = P_FSys.A_WRITE
-	      | cvt A_EXEC = P_FSys.A_EXEC
-	 in
-	    P_FSys.access (path, List.map cvt al)
-	 end
+         let
+            fun cvt A_READ = P_FSys.A_READ
+              | cvt A_WRITE = P_FSys.A_WRITE
+              | cvt A_EXEC = P_FSys.A_EXEC
+         in
+            P_FSys.access (path, List.map cvt al)
+         end
 
       datatype file_id = FID of {dev: SysWord.word, ino: SysWord.word}
 
       fun fileId fname = let
-			    val st = P_FSys.stat fname
-			 in
-			    FID{
-				dev = P_FSys.devToWord(P_FSys.ST.dev st),
-				ino = P_FSys.inoToWord(P_FSys.ST.ino st)
-				}
-			 end
+                            val st = P_FSys.stat fname
+                         in
+                            FID{
+                                dev = P_FSys.devToWord(P_FSys.ST.dev st),
+                                ino = P_FSys.inoToWord(P_FSys.ST.ino st)
+                                }
+                         end
 
       fun hash (FID{dev, ino}) = sysWordToWord(SysWord.+(SysWord.<<(dev, 0w16), ino))
 
       fun compare (FID{dev=d1, ino=i1}, FID{dev=d2, ino=i2}) =
-	 if (SysWord.<(d1, d2))
-	    then General.LESS
-	 else if (SysWord.>(d1, d2))
-		 then General.GREATER
-	      else if (SysWord.<(i1, i2))
-		      then General.LESS
-		   else if (SysWord.>(i1, i2))
-			   then General.GREATER
-			else General.EQUAL
+         if (SysWord.<(d1, d2))
+            then General.LESS
+         else if (SysWord.>(d1, d2))
+                 then General.GREATER
+              else if (SysWord.<(i1, i2))
+                      then General.LESS
+                   else if (SysWord.>(i1, i2))
+                           then General.GREATER
+                        else General.EQUAL
 
    end
 

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/system/io.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/system/io.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/system/io.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -8,15 +8,15 @@
       val kind: iodesc -> iodesc_kind
 
       structure Kind: 
-	 sig
-	    val file: iodesc_kind
-	    val dir: iodesc_kind
-	    val symlink: iodesc_kind
-	    val tty: iodesc_kind
-	    val pipe: iodesc_kind
-	    val socket: iodesc_kind
-	    val device: iodesc_kind
-	 end
+         sig
+            val file: iodesc_kind
+            val dir: iodesc_kind
+            val symlink: iodesc_kind
+            val tty: iodesc_kind
+            val pipe: iodesc_kind
+            val socket: iodesc_kind
+            val device: iodesc_kind
+         end
 
       eqtype poll_desc
       type poll_info

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/system/io.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/system/io.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/system/io.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -22,14 +22,17 @@
 
     datatype iodesc_kind = K of string
 
-    datatype file_desc = datatype PosixPrimitive.file_desc
+    type file_desc = PosixPrimitive.FileDesc.t
 
     fun toFD (iod: iodesc): file_desc =
        valOf (Posix.FileSys.iodToFD iod)
 
+    val FD = PosixPrimitive.FileDesc.fromInt
+    val unFD = PosixPrimitive.FileDesc.toInt
+       
     fun fromInt i = Posix.FileSys.fdToIOD (FD i)
        
-    fun toInt iod = let val FD fd = toFD iod in fd end
+    val toInt: iodesc -> int = unFD o toFD
 
     val toWord = Posix.FileSys.fdToWord o toFD
        
@@ -41,28 +44,28 @@
 
     structure Kind =
       struct
-	val file = K "FILE"
-	val dir = K "DIR"
-	val symlink = K "LINK"
-	val tty = K "TTY"
-	val pipe = K "PIPE"
-	val socket = K "SOCK"
-	val device = K "DEV"
+        val file = K "FILE"
+        val dir = K "DIR"
+        val symlink = K "LINK"
+        val tty = K "TTY"
+        val pipe = K "PIPE"
+        val socket = K "SOCK"
+        val device = K "DEV"
       end
 
   (* return the kind of I/O descriptor *)
     fun kind (iod) = let
-	  val stat = Posix.FileSys.fstat (toFD iod)
-	  in
-	    if      (Posix.FileSys.ST.isReg stat) then Kind.file
-	    else if (Posix.FileSys.ST.isDir stat) then Kind.dir
-	    else if (Posix.FileSys.ST.isChr stat) then Kind.tty
-	    else if (Posix.FileSys.ST.isBlk stat) then Kind.device (* ?? *)
-	    else if (Posix.FileSys.ST.isLink stat) then Kind.symlink
-	    else if (Posix.FileSys.ST.isFIFO stat) then Kind.pipe
-	    else if (Posix.FileSys.ST.isSock stat) then Kind.socket
-	    else K "UNKNOWN"
-	  end
+          val stat = Posix.FileSys.fstat (toFD iod)
+          in
+            if      (Posix.FileSys.ST.isReg stat) then Kind.file
+            else if (Posix.FileSys.ST.isDir stat) then Kind.dir
+            else if (Posix.FileSys.ST.isChr stat) then Kind.tty
+            else if (Posix.FileSys.ST.isBlk stat) then Kind.device (* ?? *)
+            else if (Posix.FileSys.ST.isLink stat) then Kind.symlink
+            else if (Posix.FileSys.ST.isFIFO stat) then Kind.pipe
+            else if (Posix.FileSys.ST.isSock stat) then Kind.socket
+            else K "UNKNOWN"
+          end
 
     type poll_flags = {rd: bool, wr: bool, pri: bool}
     datatype poll_desc = PollDesc of iodesc * poll_flags
@@ -83,11 +86,11 @@
    * for the underlying I/O device, then the Poll exception is raised.
    *)
     fun pollIn (PollDesc (iod, {wr, pri, ...}: poll_flags)) =
-	  PollDesc (iod, {rd=true, wr=wr, pri=pri})
+          PollDesc (iod, {rd=true, wr=wr, pri=pri})
     fun pollOut (PollDesc (iod, {rd, pri, ...}: poll_flags)) =
-	  PollDesc (iod, {rd=rd, wr=true, pri=pri})
+          PollDesc (iod, {rd=rd, wr=true, pri=pri})
     fun pollPri (PollDesc (iod, {rd, wr, ...}: poll_flags)) =
-	  PollDesc (iod, {rd=rd, wr=wr, pri=true})
+          PollDesc (iod, {rd=rd, wr=wr, pri=true})
 
   (* polling function *)
     local
@@ -99,42 +102,42 @@
       and wrBit : Word.word = Primitive.OS.IO.POLLOUT
       and priBit : Word.word = Primitive.OS.IO.POLLPRI
       fun fromPollDesc (PollDesc (iod, {rd, wr, pri})) =
-	    ( toInt iod,
-	      join (rd, rdBit, 
-	      join (wr, wrBit, 
+            ( toInt iod,
+              join (rd, rdBit, 
+              join (wr, wrBit, 
               join (pri, priBit, 0w0)))
-	    )
+            )
       fun toPollInfo (fd, w) = PollInfo (fromInt fd, {
-	      rd = test(w, rdBit), 
-	      wr = test(w, wrBit), 
+              rd = test(w, rdBit), 
+              wr = test(w, wrBit), 
               pri = test(w, priBit)
-	    })
+            })
     in
     fun poll (pds, timeOut) = let
-	  val (fds, eventss) = ListPair.unzip (List.map fromPollDesc pds)
-	  val fds = Vector.fromList fds
-	  val n = Vector.length fds
-	  val eventss = Vector.fromList eventss
+          val (fds, eventss) = ListPair.unzip (List.map fromPollDesc pds)
+          val fds = Vector.fromList fds
+          val n = Vector.length fds
+          val eventss = Vector.fromList eventss
           val timeOut =
-	     case timeOut of
-		NONE => ~1
-	      | SOME t =>
-		   if Time.< (t, Time.zeroTime)
-		      then let open PosixError in raiseSys inval end
-		   else (Int.fromLarge (Time.toMilliseconds t)
-			 handle Overflow => Error.raiseSys Error.inval)
-	  val reventss = Array.array (n, 0w0)
-	  val _ = Posix.Error.SysCall.simpleRestart
-	          (fn () => Prim.poll (fds, eventss, n, timeOut, reventss))
-	  in
-	    Array.foldri
-	    (fn (i, w, l) => 
-	     if w <> 0w0
-	       then (toPollInfo (Vector.sub (fds, i), w))::l
-	       else l)
-	    []
-	    reventss
-	  end
+             case timeOut of
+                NONE => ~1
+              | SOME t =>
+                   if Time.< (t, Time.zeroTime)
+                      then let open PosixError in raiseSys inval end
+                   else (Int.fromLarge (Time.toMilliseconds t)
+                         handle Overflow => Error.raiseSys Error.inval)
+          val reventss = Array.array (n, 0w0)
+          val _ = Posix.Error.SysCall.simpleRestart
+                  (fn () => Prim.poll (fds, eventss, n, timeOut, reventss))
+          in
+            Array.foldri
+            (fn (i, w, l) => 
+             if w <> 0w0
+               then (toPollInfo (Vector.sub (fds, i), w))::l
+               else l)
+            []
+            reventss
+          end
     end (* local *)
 
   (* check for conditions *)

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/system/os.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/system/os.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/system/os.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 structure OS =
    struct
       structure FileSys = OS_FileSys

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/system/path.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/system/path.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/system/path.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,261 +1,325 @@
-(* Modified from MLKitV3 basislib/Path.sml
- * by sweeks@research.nj.nec.com on 1999-1-5.
+(* Modified from the ML Kit 4.1.4; basislib/Path.sml
+ * by mfluet@acm.org on 2005-8-10 based on
+ *  modifications from the ML Kit 3 Version; basislib/Path.sml
+ *  by sweeks@research.nj.nec.com on 1999-1-5.
  *)
 
-(*Path.sml*)
+structure OS_Path: OS_PATH =
+struct
 
-structure OS_Path : OS_PATH = struct
-  exception Path
-  exception InvalidArc
+exception Path
+exception InvalidArc
 
-  (* It would make sense to use substrings for internal versions of
-   * fromString and toString, and to allocate new strings only when
-   * externalizing the strings.
+(* It would make sense to use substrings for internal versions of
+ * fromString and toString, and to allocate new strings only when
+ * externalizing the strings.
 
-   * Impossible cases:
-     UNIX: {isAbs = false, vol = _, arcs = "" :: _}
-     Mac:  {isAbs = true,  vol = _, arcs = "" :: _}
-  *)
+ * Impossible cases:
+ UNIX: {isAbs = false, vol = _, arcs = "" :: _}
+ Mac:  {isAbs = true,  vol = _, arcs = "" :: _}
+ *)
 
-  local
-      val op @ = List.@
-      infix 9 sub
-      val op sub = String.sub
-      val substring = String.extract
-(*KILL 26/02/1998 01:09. tho.:
-      val substring = fn x => ""
-*)
+val op @ = List.@
+infix 9 sub
+val op sub = String.sub
+val substring = String.extract
 
-  val slash = "/"
-  val volslash = "/"
-  fun isslash c = c = #"/"
-  fun validVol s = s = ""
-  fun iscolon c = c = #":"
+(* Testing commands in both cygwin and mingw reveal that BOTH treat
+ * paths exactly the same, and they also match newer windows console
+ * commands (for example command.com and cmd.exe).
+ * 
+ * There is one exception: both cygwin and mingw treat /foo\bar
+ * differently from \foo\bar; there is a special root for '/'.
+ * This is so that cygwin and msys can fake a Unix directory tree.
+ * 
+ * Normal windows commands do not do this. Both msys and cygwin do it
+ * differently. The msys(mingw) approach is for the shell(bash) to
+ * translate the path before calling the command, eg: foo /usr will
+ * run foo with arguement "c:/msys/1.0/". Under cygwin, the path is
+ * passed through as stated and the program has to deal with it. Thus,
+ * for mingw we can (and should) ignore the issue and thus the mlton
+ * compiled application is identical to a windows app. However, under
+ * cygwin, we need to track /* as a special volume.
+ *)
+val isWindows = 
+   let 
+      open Primitive.MLton.Platform.OS 
+   in 
+      host = MinGW orelse host = Cygwin
+   end
+      
+val volumeHack =
+   let
+      open Primitive.MLton.Platform.OS
+   in
+      host = Cygwin
+   end
 
-  val isMinGW = let open Primitive.MLton.Platform.OS in host = MinGW end
+(* the path separator used in canonical paths *)
+val slash = if isWindows then "\\" else "/"
+      
+(* newer windows commands treat both / and \ as path separators
+ * try echo sdfsdf > foo/bar under windows command.com -- it works
+ * 
+ * Sadly this means that toString o fromString is not the identity
+ * b/c foo/bar -> foo\bar. However, there's nothing else one can do!
+ * This diverges from the standard.
+ *)
+fun isslash c = c = #"/" orelse (isWindows andalso c = #"\\")
+fun iscolon c = c = #":"
+      
+(* Under cygwin, the special volume "/" denotes the cygwin pseudo-root
+ *)
+fun isVolumeName v =
+   (isWindows andalso size v = 2 andalso 
+    Char.isAlpha (v sub 0) andalso iscolon (v sub 1))
+   orelse
+   (volumeHack andalso v = "/")
+      
+fun volumeMatch (root, relative) =
+   relative = ""
+   orelse (isVolumeName root
+           andalso isVolumeName relative
+           andalso (Char.toUpper (root sub 0)
+                    = Char.toUpper (relative sub 0)))
+       
+fun canonName a = 
+   if isWindows
+      then String.translate (str o Char.toLower) a
+   else a
+  
+val parentArc  = ".."
+val currentArc = "."
+  
+(* Ahh joy. The SML basis library standard and Windows paths. 
+ * 
+ * The big problem with windows paths is "\foo""
+ * - It's not absolute, since chdir("A:\") may switch from "C:", thus
+   *   changing the meaning of "\foo".
+   *)
+fun validVolume {isAbs, vol} = 
+   if isWindows
+      then isVolumeName vol orelse (not isAbs andalso vol = "")
+   else vol = ""
+  
+fun fromString s =
+   let
+      val (vol, rest) = (* 4:foo has a volume of "4:" even tho invalid *)
+         if isWindows andalso size s >= 2 andalso iscolon (s sub 1)
+            then (substring (s, 0, SOME 2), substring (s, 2, NONE))
+         else 
+            if volumeHack andalso size s >= 1 andalso s sub 0 = #"/"
+               then ("/", s)
+            else ("", s)
+      val (isAbs, arcs) =
+         case (String.fields isslash rest) of
+            "" :: [] => (false, [])
+          | "" :: r => (true, r)
+          | r => (false, r)
+   in
+      {arcs = arcs, isAbs = isAbs, vol = vol}
+   end
+      
+val getVolume = #vol o fromString
+val isAbsolute = #isAbs o fromString
+val isRelative = not o isAbsolute
 
-  fun splitabsvolrest s =
-     if isMinGW
-	then
-	   (* Handle the "C:\" case *)
-	   if size s >= 3 andalso iscolon (s sub 1)
-	      then (true, "", substring(s, 3, NONE))
-	   else (false, "", s)
-     else
-	if size s >= 1 andalso isslash (s sub 0) then
-	   (true, "", substring(s, 1, NONE))
-	else
-	   (false, "", s);
-	   
-  in
+fun isArc s =
+   s = ""
+   orelse (case fromString s of
+              {arcs = [_], isAbs = false, vol = ""} => true
+            | _ => false)
+  
+fun toString {arcs, isAbs, vol} =
+   if not (validVolume {isAbs = isAbs, vol = vol})
+      then raise Path
+   else if not isAbs andalso case arcs of ("" :: _) => true | _ => false
+      then raise Path
+   else if List.exists (not o isArc) arcs
+      then raise InvalidArc
+   else 
+      concat [vol,
+              if isAbs andalso (not volumeHack orelse vol <> "/")
+                 then slash
+              else "",
+              String.concatWith slash arcs]
 
-  val parentArc  = ".."
-  val currentArc = "."
+fun concatArcs (a1, a2) =
+   let
+      val a1 = case List.rev a1 of "" :: r => List.rev r | _ => a1
+   in
+      a1 @ a2
+   end
 
-  fun isAbsolute p = #1 (splitabsvolrest p)
+fun concat (p1, p2) =
+   let
+      val {arcs = a1, isAbs, vol = v1} = fromString p1
+      val {arcs = a2, isAbs = isAbs2, vol = v2} = fromString p2
+   in
+      if isAbs2 orelse not (volumeMatch (v1, v2))
+         then raise Path
+      else toString {arcs = concatArcs (a1, a2), isAbs = isAbs, vol = v1}
+   end
 
-  fun isRelative p = not (isAbsolute p);
+fun getParent p =
+   let
+      val {isAbs, vol, arcs} = fromString p
+      val arcs =
+         List.rev (case List.rev arcs of
+                      [] => [parentArc]
+                    | "." :: r => parentArc :: r
+                    | ".." :: r => parentArc :: parentArc :: r
+                    | _ :: [] => if isAbs then [""] else [currentArc]
+                    | "" :: r => parentArc :: r
+                    | _ :: r => r)
+   in
+      toString {arcs = arcs, isAbs = isAbs, vol = vol}
+   end
 
-  fun fromString p =
-     let
-	val (isAbs, v, rest) = splitabsvolrest p
-     in
-	if not isAbs andalso rest = ""
-	   then {isAbs = false, vol = v, arcs = []}
-	else {arcs = String.fields isslash rest,
-	      isAbs = isAbs,
-	      vol = v}
-     end
+fun mkCanonical p =
+   let
+      val {arcs, isAbs, vol} = fromString p
+      fun backup l =
+         case l of
+            [] => if isAbs then [] else [parentArc]
+          | first :: res =>
+               if first = ".."
+                  then parentArc :: parentArc :: res
+               else res
+      fun reduce arcs =
+         let
+            fun h (l, res) =
+               case l of
+                  [] => (case res of
+                            [] => if isAbs then [""] else [currentArc]
+                          | _ => res )
+                | a1 :: ar =>
+                     if a1 = "" orelse a1 = "."
+                        then h (ar, res)
+                     else if a1 = ".."
+                             then h (ar, backup res)
+                          else h (ar, canonName a1 :: res)
+         in
+            h (arcs, [])
+         end
+   in
+      toString {arcs = List.rev (reduce arcs),
+                isAbs = isAbs,
+                vol = canonName vol}
+   end
 
-  fun toArcOpt s =
-     case fromString s of
-	{arcs = [a], isAbs = false, vol = ""} => SOME a
-      | _ => NONE
+val rec parentize =
+   fn [] => []
+    | _ :: ar => parentArc :: parentize ar
 
-  fun isArc s = s = "" orelse isSome (toArcOpt s)
+fun mkRelative {path = p1, relativeTo = p2} =
+   let
+      val {arcs = arcs1, isAbs = isAbs1, vol = vol1} = fromString p1
+      val {arcs = arcs2, isAbs = isAbs2, vol = vol2} =
+         fromString (mkCanonical p2)
+   in
+      if not isAbs2 then raise Path
+      else if not isAbs1 then p1
+           else
+              let
+                 fun h (a1, a2) =
+                    case (a1, a2) of
+                       ([], []) => ["."]
+                     | (_, []) => a1
+                     | ([], a2) => parentize a2
+                     | (a11 :: a1r, a21 :: a2r) =>
+                          if canonName a11 = a21 then h (a1r, a2r)
+                          else parentize a2 @ (if arcs1 = [""] then [] else a1)
+              in
+                 if not (volumeMatch (vol2, vol1))
+                    then raise Path
+                 else toString {arcs = h (arcs1, arcs2),
+                                isAbs = false,
+                                vol = ""}
+              end
+   end
 
-  fun getVolume p = #2 (splitabsvolrest p)
+fun mkAbsolute {path = p1, relativeTo = p2} =
+   if isRelative p2 then raise Path
+   else if isAbsolute p1 then p1
+   else mkCanonical (concat (p2, p1))
 
-  fun validVolume {isAbs = _, vol} = validVol vol
+fun isCanonical p = mkCanonical p = p
 
-  fun toString {arcs, isAbs, vol} =
-     if not (validVolume {isAbs = isAbs, vol = vol})
-	then raise Path
-     else if List.exists (not o isArc) arcs
-	then raise InvalidArc
-     else
-	let
-	   fun h ([], res) = res
-	     | h (a :: ar, res) = h (ar, a :: slash :: res)
-	in
-	   if isAbs
-	      then
-		 (case arcs of
-		     [] => vol ^ volslash
-		   | a1 :: arest =>
-			String.concat
-			(List.rev (h (arest, [a1, volslash, vol]))))
-	   else
-	      case arcs of
-		 [] => vol
-	       | a1 :: arest =>
-		    if a1 = ""
-		       then raise Path
-		    else String.concat (vol :: List.rev (h (arest, [a1])))
-      end
+fun joinDirFile {dir, file} =
+   let
+      val {arcs, isAbs, vol} = fromString dir
+      val arcs = 
+         case (arcs, file) of
+            ([], "") => []
+          | _ => concatArcs (arcs, [file])
+   in
+      toString {arcs = arcs,
+                isAbs = isAbs,
+                vol = vol}
+   end
 
-  fun concat (p1, p2) =
-      let fun stripslash path =
-	      if isslash (path sub (size path - 1)) then
-		  substring(path, 0, SOME(size path - 1))
-	      else path
-      in
-	  if isAbsolute p2 then raise Path
-	  else
-	     let
-		val (isAbs, v, path) = splitabsvolrest p1
-	     in
-		if isAbs
-		    then if path = ""
-			    then v ^ volslash ^ p2
-			 else String.concat [v, volslash, stripslash path,
-					     slash, p2]
-		else if v = "" andalso path = ""
-			then p2
-		     else String.concat [v, stripslash path, slash, p2]
-	     end
-      end
+fun splitDirFile p =
+   let
+      open List
+      val {isAbs, vol, arcs} = fromString p
+   in
+      case rev arcs of
+         [] => {dir = p, file = ""}
+       | arcn :: farcs =>
+            {dir = toString {arcs = rev farcs, isAbs = isAbs, vol = vol},
+             file = arcn}
 
-  fun getParent p =
-      let open List
-	  val {isAbs, vol, arcs} = fromString p
-	  fun getpar xs =
-	      rev (case rev xs of
-		       [] => [parentArc]
-		     | last :: revrest =>
-			  if last = ""
-			     andalso (case revrest of [] => true | _ => false)
-			     then if isAbs then [] else [parentArc]
-			  else if last = "" orelse last = "."
-			     then parentArc :: revrest
-			  else if last = ".."
-		             then parentArc :: parentArc :: revrest
-			  else revrest)
-      in
-	  case getpar arcs of
-	      []   =>
-		  if isAbs then toString {isAbs=true, vol=vol, arcs=[""]}
-		  else currentArc
-	    | arcs => toString {isAbs=isAbs, vol=vol, arcs=arcs}
-      end
+   end
 
-  fun mkCanonical p =
-      let val {isAbs, vol, arcs} = fromString p
-	  fun backup l =
-	     case l of
-		[] => if isAbs then [] else [parentArc]
-	      | first :: res =>
-		   if first = ".."
-		      then parentArc :: parentArc :: res
-		   else res
-	  fun reduce arcs =
-	      let
-		 fun h l res =
-		    case l of
-		       [] => (case res of
-				 [] => if isAbs then [""] else [currentArc]
-			       | _ => res)
-		     | a1 :: ar =>
-			  if a1 = "" orelse a1 = "."
-			     then h ar res
-			  else if a1 = ".."
-			     then h ar (backup res)
-		          else h ar (a1 :: res)
-	      in h arcs [] end
-      in
-	  toString {isAbs=isAbs, vol=vol, arcs=List.rev (reduce arcs)}
-      end
+val dir = #dir o splitDirFile
+   
+val file = #file o splitDirFile
 
-  fun parentize []      = []
-    | parentize (_::ar) = parentArc :: parentize ar
+fun joinBaseExt {base, ext} =
+   case ext of
+      NONE => base
+    | SOME ex =>
+         if ex = "" then base
+         else String.concat [base, ".", ex]
 
-  fun mkRelative {path = p1, relativeTo = p2} =
-      case (fromString p1, fromString (mkCanonical p2)) of
-	  (_ ,                {isAbs=false,...}) => raise Path
-	| ({isAbs=false,...}, _                ) => p1
-	| ({vol=vol1, arcs=arcs1,...}, {vol=vol2, arcs=arcs2, ...}) =>
-	      let fun h [] [] = ["."]
-		    | h a1 [] = a1
-		    | h [] a2 = parentize a2
-		    | h (a1 as (a11::a1r)) (a2 as (a21::a2r)) =
-		      if a11=a21 then h a1r a2r
-		      else parentize a2 @ (if arcs1 = [""] then [] else a1)
-	      in
-		  if vol1 <> vol2 then raise Path
-		  else toString {isAbs=false, vol="", arcs=h arcs1 arcs2}
-	      end
+fun splitBaseExt s =
+   let
+      val {dir, file} = splitDirFile s
+      open Substring
+      val (fst, snd) = splitr (fn c => c <> #".") (full file)
+   in
+      if isEmpty snd         (* dot at right end     *)
+         orelse isEmpty fst  (* no dot               *)
+         orelse size fst = 1 (* dot at left end only *)
+         then {base = s, ext = NONE}
+      else {base = joinDirFile {dir = dir,
+                                file = string (trimr 1 fst)},
+            ext = SOME (string snd)}
+   end
 
-  fun mkAbsolute {path = p1, relativeTo = p2} =
-      if isRelative p2 then raise Path
-      else if isAbsolute p1 then p1
-      else mkCanonical(concat(p2, p1));
+val ext = #ext o splitBaseExt
+val base = #base o splitBaseExt
 
-  fun isCanonical p = mkCanonical p = p;
-	
-  fun joinDirFile {dir, file} =
-     if isArc file then concat (dir, file) else raise InvalidArc
-
-  fun splitDirFile p =
-      let open List
-	  val {isAbs, vol, arcs} = fromString p
+fun isRoot path =
+   case fromString path of
+      {isAbs = true,  arcs=[""],  ...} => true
+    | _ => false
+  
+fun fromUnixPath s = 
+   if not isWindows then s
+   else if Char.contains s (slash sub 0) then raise InvalidArc
+   else String.translate (fn c => if c = #"/" then slash else str c) s
+     
+fun toUnixPath s = 
+   if not isWindows then s
+   else
+      let
+         val {arcs, isAbs, vol} = fromString s
       in
-	  case rev arcs of
-	      []            =>
-		  {dir = toString {isAbs=isAbs, vol=vol, arcs=[]}, file = ""  }
-	    | arcn :: farcs =>
-		  {dir = toString {isAbs=isAbs, vol=vol, arcs=rev farcs},
-		   file = arcn}
-
+         if vol <> "" andalso not (volumeHack andalso vol = "/") 
+            then raise Path 
+         else (if isAbs then "/" else "") ^ String.concatWith "/" arcs
       end
 
-  fun dir s  = #dir (splitDirFile s);
-  fun file s = #file(splitDirFile s);
-
-  fun joinBaseExt {base, ext} =
-     case ext of
-	NONE => base
-      | SOME ex =>
-	   if ex = ""
-	      then base
-	   else String.concat [base, ".", ex]
-
-  fun splitBaseExt s =
-      let val {dir, file} = splitDirFile s
-	  open Substring
-	  val (fst, snd) = splitr (fn c => c <> #".") (full file)
-      in
-	  if isEmpty snd         (* dot at right end     *)
-	     orelse isEmpty fst  (* no dot               *)
-	     orelse size fst = 1 (* dot at left end only *)
-	      then {base = s, ext = NONE}
-	  else
-	      {base = joinDirFile{dir = dir,
-				  file = string (trimr 1 fst)},
-	       ext = SOME (string snd)}
-      end
-
-  fun ext s  = #ext  (splitBaseExt s)
-  fun base s = #base (splitBaseExt s)
-
-  fun isRoot path =
-     case fromString path of
-	{isAbs = true, arcs= [a], ...} => a = ""
-      | _ => false
-  end
-
-  (* Since MLton only runs on Unix, there is nothing to do for these.*)
-  fun fromUnixPath s = s
-  fun toUnixPath s = s
-end (*structure Path*)
-
-
+end

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/system/pre-os.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/system/pre-os.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/system/pre-os.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,21 +1,28 @@
+(* Copyright (C) 2002-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 structure OS =
    struct
       structure Process =
-	 struct
-	    type status = PosixPrimitive.Process.Status.t
-	 end
+         struct
+            type status = PosixPrimitive.Process.Status.t
+         end
       structure IO :> sig
-			 eqtype iodesc
+                         eqtype iodesc
 
-			 val fromFD: PosixPrimitive.IO.file_desc -> iodesc
-			 val toFD: iodesc -> PosixPrimitive.IO.file_desc
-		      end = 
-		      struct
-			 type iodesc = PosixPrimitive.IO.file_desc
+                         val fromFD: PosixPrimitive.IO.file_desc -> iodesc
+                         val toFD: iodesc -> PosixPrimitive.IO.file_desc
+                      end = 
+                      struct
+                         type iodesc = PosixPrimitive.IO.file_desc
 
-			 val fromFD = fn z => z
-			 val toFD = fn z => z
-		      end
+                         val fromFD = fn z => z
+                         val toFD = fn z => z
+                      end
    end
 
 structure PreOS = OS

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/system/process.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/system/process.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/system/process.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -18,12 +18,10 @@
       include OS_PROCESS
 
       structure Status:
-	 sig
-	    type t
+         sig
+            type t
 
-	    val fromInt: int -> t
-	    val fromPosix: Posix.Process.exit_status -> t
-	 end
-
-      val wait: Posix.Process.pid -> status
+            val fromInt: int -> t
+            val fromPosix: Posix.Process.exit_status -> t
+         end
    end

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/system/process.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/system/process.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/system/process.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -15,63 +15,43 @@
    struct
       open Posix.Process
 
-      structure Signal = MLtonSignal
-	 
       structure Status =
-	 struct
-	    open Primitive.Status
+         struct
+            open Primitive.Status
 
-	    val fromPosix =
-	       fn es =>
-	       let
-		  datatype z = datatype Posix.Process.exit_status
-	       in
-		  case es of
-		     W_EXITED => success
-		   | W_EXITSTATUS w => fromInt (Word8.toInt w)
-		   | W_SIGNALED _ => failure
-		   | W_STOPPED _ => failure
-	       end
-	 end
+            val fromPosix =
+               fn es =>
+               let
+                  datatype z = datatype Posix.Process.exit_status
+               in
+                  case es of
+                     W_EXITED => success
+                   | W_EXITSTATUS w => fromInt (Word8.toInt w)
+                   | W_SIGNALED _ => failure
+                   | W_STOPPED _ => failure
+               end
+         end
 
       type status = Status.t
 
       val failure = Status.failure
       val success = Status.success
       fun isSuccess st = st = success
-	 
-      fun wait (pid: Pid.t): Status.t =
-	 Status.fromPosix (#2 (waitpid (W_CHILD pid, [])))
-	       
+         
       fun system cmd =
-	 let
-	    val pid =
-	       MLtonProcess.spawn {args = ["sh", "-c", cmd],
-				   path = "/bin/sh"}
-	    val old =
-	       List.map (fn s => 
-			 let
-			    open Signal
-			    val old = getHandler s
-			    val _ = setHandler (s, Handler.ignore)
-			 in
-			    (s, old)
-			 end)
-	       [Posix.Signal.int, Posix.Signal.quit]
-	 in
-	    DynamicWind.wind (fn () => wait pid,
-			      fn () => List.app Signal.setHandler old)
-	 end
+         PosixPrimitive.Process.system (NullString.fromString
+                                        (concat [cmd, "\000"]))
 
       val atExit = MLtonProcess.atExit
-	 
+         
       val exit = MLtonProcess.exit
 
       fun terminate x = Posix.Process.exit (Word8.fromInt (Status.toInt x))
 
       val getEnv = Posix.ProcEnv.getenv
 
-      fun sleep t = if Time.<= (t, Time.zeroTime)
-		       then ()
-		    else (ignore (Posix.Process.sleep t); ())
+      fun sleep t =
+         if Time.<= (t, Time.zeroTime)
+            then ()
+         else sleep (Posix.Process.sleep t)
    end

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/system/time.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/system/time.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/system/time.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 structure Time: TIME_EXTRA =
 struct
 
@@ -32,10 +33,10 @@
 local
    fun make ticksPer =
       let
-	 val d = LargeInt.quot (ticksPerSecond, ticksPer)
+         val d = LargeInt.quot (ticksPerSecond, ticksPer)
       in
-	 (fn i => T (LargeInt.* (i, d)),
-	  fn T i => LargeInt.quot (i, d))
+         (fn i => T (LargeInt.* (i, d)),
+          fn T i => LargeInt.quot (i, d))
       end
 in
    val (fromSeconds, toSeconds) = make 1
@@ -68,20 +69,20 @@
 local
    fun getNow (): time =
       (if ~1 = Prim.gettimeofday ()
-	  then raise Fail "Time.now"
+          then raise Fail "Time.now"
        else ()
        ; timeAdd(fromSeconds (LargeInt.fromInt (Prim.sec ())),
-		 fromMicroseconds (LargeInt.fromInt (Prim.usec ()))))
+                 fromMicroseconds (LargeInt.fromInt (Prim.usec ()))))
    val prev = ref (getNow ())
 in
    fun now (): time =
       let
-	 val old = !prev
-	 val t = getNow ()
+         val old = !prev
+         val t = getNow ()
       in
-	 case compare (old, t) of
-	    GREATER => old
-	  | _ => (prev := t; t)
+         case compare (old, t) of
+            GREATER => old
+          | _ => (prev := t; t)
       end
 end
 
@@ -90,65 +91,75 @@
 
 val toString = fmt 3
 
-(* Adapted from MLKitV3 basislib/Time.sml*)
+(* Adapted from the ML Kit 4.1.4; basislib/Time.sml
+ * by mfluet@acm.org on 2005-11-10 based on
+ * by mfluet@acm.org on 2005-8-10 based on
+ *  adaptations from the ML Kit 3 Version; basislib/Time.sml
+ *  by sweeks@research.nj.nec.com on 1999-1-3.
+ *)
 fun scan getc src =
    let
       val charToDigit = StringCvt.charToDigit StringCvt.DEC
       fun pow10 0 = 1
-	| pow10 n = 10 * pow10 (n-1)
+        | pow10 n = 10 * pow10 (n-1)
       fun mkTime sign intv fracv decs =
-	 let
-	    val nsec = (pow10 (10-decs) * fracv + 5) div 10
-	    val t =
-	       LargeInt.+ (LargeInt.* (Int.toLarge intv, ticksPerSecond),
-			   Int.toLarge nsec)
-	    val t = if sign then t else LargeInt.~ t 
-	 in
-	    T t
-	 end
+         let
+            val nsec = 
+               LargeInt.div (LargeInt.+ (LargeInt.* (Int.toLarge (pow10 (10 - decs)), 
+                                                     Int.toLarge fracv),
+                                         5), 
+                             10)
+            val t =
+               LargeInt.+ (LargeInt.* (Int.toLarge intv, ticksPerSecond),
+                           nsec)
+            val t = if sign then t else LargeInt.~ t 
+         in
+            T t
+         end
       fun frac' sign intv fracv decs src =
-	 if Int.>= (decs, 7)
-	    then SOME (mkTime sign intv fracv decs, 
-		       StringCvt.dropl Char.isDigit getc src)
-	 else case getc src of
-	    NONE           => SOME (mkTime sign intv fracv decs, src)
-	  | SOME (c, rest) =>
- 	       (case charToDigit c of
- 		   NONE   => SOME (mkTime sign intv fracv decs, src)
- 		 | SOME d => frac' sign intv (10 * fracv + d) (decs + 1) rest)
+         if Int.>= (decs, 7)
+            then SOME (mkTime sign intv fracv decs, 
+                       StringCvt.dropl Char.isDigit getc src)
+         else case getc src of
+            NONE           => SOME (mkTime sign intv fracv decs, src)
+          | SOME (c, rest) =>
+               (case charToDigit c of
+                   NONE   => SOME (mkTime sign intv fracv decs, src)
+                 | SOME d => frac' sign intv (10 * fracv + d) (decs + 1) rest)
       fun frac sign intv src =
-	 case getc src of
-	    NONE           => NONE
-	  | SOME (c, rest) =>
-	       (case charToDigit c of
-		   NONE   => NONE
-		 | SOME d => frac' sign intv d 1 rest)
+         case getc src of
+            NONE           => NONE
+          | SOME (c, rest) =>
+               (case charToDigit c of
+                   NONE   => NONE
+                 | SOME d => frac' sign intv d 1 rest)
       fun int' sign intv src =
-	 case getc src of
-	    NONE              => SOME (mkTime sign intv 0 7, src)
-	  | SOME (#".", rest) => frac sign intv rest
-	  | SOME (c, rest)    =>
-	       (case charToDigit c of
-		   NONE   => SOME (mkTime sign intv 0 7, src)
-		 | SOME d => int' sign (10 * intv + d) rest)
+         case getc src of
+            NONE              => SOME (mkTime sign intv 0 7, src)
+          | SOME (#".", rest) => frac sign intv rest
+          | SOME (c, rest)    =>
+               (case charToDigit c of
+                   NONE   => SOME (mkTime sign intv 0 7, src)
+                 | SOME d => int' sign (10 * intv + d) rest)
       fun int sign src =
-	 case getc src of
-	    NONE           => NONE
-	  | SOME (c, rest) => 
-	       (case charToDigit c of
-		   NONE   => NONE
-		 | SOME d => int' sign d rest)
+         case getc src of
+            NONE           => NONE
+          | SOME (#".", rest) => frac sign 0 rest
+          | SOME (c, rest) => 
+               (case charToDigit c of
+                   NONE   => NONE
+                 | SOME d => int' sign d rest)
    in 
       case getc (StringCvt.skipWS getc src) of
-	 NONE              => NONE
+         NONE              => NONE
        | SOME (#"+", rest) => int true rest
        | SOME (#"~", rest) => int false rest
        | SOME (#"-", rest) => int false rest
        | SOME (#".", rest) => frac true 0 rest
        | SOME (c, rest)    => 
-	    (case charToDigit c of
-		NONE => NONE
-	      | SOME d => int' true d rest)
+            (case charToDigit c of
+                NONE => NONE
+              | SOME d => int' true d rest)
    end
 handle Overflow => raise Time
 

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/system/timer.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/system/timer.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/system/timer.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -5,9 +5,9 @@
 
       val checkCPUTimer: cpu_timer -> {sys: Time.time, usr: Time.time}
       val checkCPUTimes: cpu_timer -> {gc: {sys: Time.time,
-					     usr: Time.time},
-				       nongc: {sys: Time.time,
-					       usr: Time.time}}
+                                             usr: Time.time},
+                                       nongc: {sys: Time.time,
+                                               usr: Time.time}}
       val checkGCTime: cpu_timer -> Time.time
       val checkRealTimer: real_timer -> Time.time
       val startCPUTimer: unit -> cpu_timer

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/system/timer.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/system/timer.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/system/timer.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,52 +1,60 @@
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 structure Timer: TIMER =
    struct
       structure SysUsr =
-	 struct
-	    datatype t = T of {sys: Time.time, usr: Time.time}
+         struct
+            datatype t = T of {sys: Time.time, usr: Time.time}
 
-	    fun export (T r) = r
-	       
-	    fun (T {sys, usr}) - (T {sys = s', usr = u'}) =
-	       T {sys = Time.- (sys, s'),
-		  usr = Time.- (usr, u')}
-	 end
+            fun export (T r) = r
+               
+            fun (T {sys, usr}) - (T {sys = s', usr = u'}) =
+               T {sys = Time.- (sys, s'),
+                  usr = Time.- (usr, u')}
+         end
       
       type cpu_timer = {gc: SysUsr.t, self: SysUsr.t}
 
       fun startCPUTimer (): cpu_timer =
-	 let
-	    val {gc = {utime = gcu, stime = gcs, ...},
-		 self = {utime = selfu, stime = selfs}, ...} =
-	       MLtonRusage.rusage ()
-	 in
-	    {gc = SysUsr.T {sys = gcs, usr = gcu},
-	     self = SysUsr.T {sys = selfs, usr = selfu}}
-	 end
+         let
+            val {gc = {utime = gcu, stime = gcs, ...},
+                 self = {utime = selfu, stime = selfs}, ...} =
+               MLtonRusage.rusage ()
+         in
+            {gc = SysUsr.T {sys = gcs, usr = gcu},
+             self = SysUsr.T {sys = selfs, usr = selfu}}
+         end
 
       fun checkCPUTimes {gc, self} =
-	 let
-	    val {gc = g', self = s'} = startCPUTimer ()
-	    val gc = SysUsr.- (g', gc)
-	    val self = SysUsr.- (s', self)
-	 in
-	    {gc = SysUsr.export gc,
-	     nongc = SysUsr.export (SysUsr.- (self, gc))}
-	 end
+         let
+            val {gc = g', self = s'} = startCPUTimer ()
+            val gc = SysUsr.- (g', gc)
+            val self = SysUsr.- (s', self)
+         in
+            {gc = SysUsr.export gc,
+             nongc = SysUsr.export (SysUsr.- (self, gc))}
+         end
 
       fun checkCPUTimer timer =
-	 let
-	    val {nongc, gc} = checkCPUTimes timer
-	 in
-	    {sys = Time.+ (#sys gc, #sys nongc),
-	     usr = Time.+ (#usr gc, #usr nongc)}
-	 end
-	       
+         let
+            val {nongc, gc} = checkCPUTimes timer
+         in
+            {sys = Time.+ (#sys gc, #sys nongc),
+             usr = Time.+ (#usr gc, #usr nongc)}
+         end
+               
       val totalCPUTimer =
-	 let
-	    val t = startCPUTimer ()
-	 in
-	    fn () => t
-	 end
+         let
+            val t = startCPUTimer ()
+         in
+            fn () => t
+         end
 
       val checkGCTime = #usr o #gc o checkCPUTimes
 
@@ -55,12 +63,12 @@
       fun startRealTimer (): real_timer = Time.now ()
 
       fun checkRealTimer (t: real_timer): Time.time =
-	 Time.- (startRealTimer (), t)
-	 
+         Time.- (startRealTimer (), t)
+         
       val totalRealTimer =
-	 let
-	    val t = startRealTimer ()
-	 in
-	    fn () => t
-	 end
+         let
+            val t = startRealTimer ()
+         in
+            fn () => t
+         end
    end

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/system/unix.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/system/unix.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/system/unix.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -3,7 +3,7 @@
       type ('a, 'b) proc
       type signal
       datatype exit_status = 
-	 W_EXITED
+         W_EXITED
        | W_EXITSTATUS of Word8.word
        | W_SIGNALED of signal
        | W_STOPPED of signal
@@ -17,7 +17,7 @@
       val kill: ('a, 'b) proc * signal -> unit
       val reap: ('a, 'b) proc -> OS.Process.status
       val streamsOf: ((TextIO.instream, TextIO.outstream) proc
-		      -> TextIO.instream * TextIO.outstream)
+                      -> TextIO.instream * TextIO.outstream)
       val textInstreamOf: (TextIO.instream, 'a) proc -> TextIO.instream
       val textOutstreamOf: ('a, TextIO.outstream) proc -> TextIO.outstream
    end

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/system/unix.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/system/unix.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/system/unix.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 2004-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
- * 
- * Rewritten by wesley@terpstra.ca on 2004-11-23 to use MLtonProcess for the
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
+(* Rewritten by wesley@terpstra.ca on 2004-11-23 to use MLtonProcess for the
  * implementation.
  *)
 
@@ -30,11 +31,11 @@
 local
    fun create {args, env, path} =
       Process.create {args = args,
-		      env = env,
-		      path = path,
-		      stderr = Param.self,
-		      stdin = Param.pipe,
-		      stdout = Param.pipe}
+                      env = env,
+                      path = path,
+                      stderr = Param.self,
+                      stdin = Param.pipe,
+                      stdout = Param.pipe}
 in
    fun execute (path, args) =
       create {args = args, env = NONE, path = path}

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/text/byte.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/text/byte.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/text/byte.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 structure Byte: BYTE =
    struct
       val byteToChar = Primitive.Char.fromWord8
@@ -14,18 +15,18 @@
       val charToByte = Primitive.Char.toWord8
 
       fun packString (a: Word8Array.array, i: int, s: substring): unit =
-	 Util.naturalForeach
-	 (Substring.size s, fn j =>
-	  Word8Array.update (a, i +? j, charToByte (Substring.sub (s, j))))
+         Util.naturalForeach
+         (Substring.size s, fn j =>
+          Word8Array.update (a, i +? j, charToByte (Substring.sub (s, j))))
 
       val stringToBytes = Word8Vector.fromPoly o Primitive.String.toWord8Vector
 
       local
-	 fun make (length, sub) s =
-	    String.tabulate (length s, fn i => byteToChar (sub (s, i)))
+         fun make (length, sub) s =
+            String.tabulate (length s, fn i => byteToChar (sub (s, i)))
       in
-	 val unpackString = make (Word8ArraySlice.length, Word8ArraySlice.sub)
-	 val unpackStringVec =
-	    make (Word8VectorSlice.length, Word8VectorSlice.sub)
+         val unpackString = make (Word8ArraySlice.length, Word8ArraySlice.sub)
+         val unpackStringVec =
+            make (Word8VectorSlice.length, Word8VectorSlice.sub)
       end
    end

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/text/char.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/text/char.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/text/char.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,220 +1,221 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 structure Char: CHAR_EXTRA =
    struct
       open Char0
-	 	       
+                       
       fun control reader state =
-	 case reader state of
-	    NONE => NONE
-	  | SOME (c, state) =>
-	       if #"@" <= c andalso c <= #"_"
-		  then SOME (chr (ord c -? ord #"@"), state)
-	       else NONE
+         case reader state of
+            NONE => NONE
+          | SOME (c, state) =>
+               if #"@" <= c andalso c <= #"_"
+                  then SOME (chr (ord c -? ord #"@"), state)
+               else NONE
 
       fun formatChar reader state =
-	 case reader state of
-	    NONE => NONE
-	  | SOME (c, state) =>
-	       if isSpace c
-		  then SOME ((), state)
-	       else NONE
+         case reader state of
+            NONE => NONE
+          | SOME (c, state) =>
+               if isSpace c
+                  then SOME ((), state)
+               else NONE
 
       fun formatChars reader =
-	 let
-	    fun loop state =
-	       case formatChar reader state of
-		  NONE => state
-		| SOME ((), state) => loop state
-	 in
-	    loop
-	 end
-		  
+         let
+            fun loop state =
+               case formatChar reader state of
+                  NONE => state
+                | SOME ((), state) => loop state
+         in
+            loop
+         end
+                  
       val 'a formatSequences: (char, 'a) StringCvt.reader -> 'a -> 'a =
-	 fn reader =>
-	 let
-	    fun loop state =
-	       case reader state of
-		  SOME (#"\\", state1) =>
-		     (case formatChar reader state1 of
-			 NONE => state
-		       | SOME ((), state2) =>
-			    let
-			       val state3 = formatChars reader state2
-			    in
-			       case reader state3 of
-				  SOME (#"\\", state4) => loop state4
-				| _ => state
-			    end)
-		| _ => state
-	 in
-	    loop
-	 end
+         fn reader =>
+         let
+            fun loop state =
+               case reader state of
+                  SOME (#"\\", state1) =>
+                     (case formatChar reader state1 of
+                         NONE => state
+                       | SOME ((), state2) =>
+                            let
+                               val state3 = formatChars reader state2
+                            in
+                               case reader state3 of
+                                  SOME (#"\\", state4) => loop state4
+                                | _ => state
+                            end)
+                | _ => state
+         in
+            loop
+         end
 
       fun 'a scan (reader: (char, 'a) StringCvt.reader)
-	: (char, 'a) StringCvt.reader =
-	 let
-	    val escape: (char, 'a) StringCvt.reader =
-	       fn state =>
-	       case reader state of
-		  NONE => NONE
-		| SOME (c, state') =>
-		     let
-			fun yes c = SOME (c, state')
-		     in
-			case c of
-			   #"a" => yes #"\a"
-			 | #"b" => yes #"\b"
-			 | #"t" => yes #"\t"
-			 | #"n" => yes #"\n"
-			 | #"v" => yes #"\v"
-			 | #"f" => yes #"\f"
-			 | #"r" => yes #"\r"
-			 | #"\\" => yes #"\\"
-			 | #"\"" => yes #"\""
-			 | #"^" => control reader state'
-			 | #"u" =>
-			      Reader.mapOpt chrOpt
-			      (StringCvt.digitsExact (StringCvt.HEX, 4) reader)
-			      state'
-			 | _ => (* 3 decimal digits *)
-			      Reader.mapOpt chrOpt
-			      (StringCvt.digitsExact (StringCvt.DEC, 3)
-			       reader)
-			      state
-		     end
-	    val main: (char, 'a) StringCvt.reader =
-	       fn state =>
-	       let
-		  val state = formatSequences reader state
-	       in
-		  case reader state of
-		     NONE => NONE
-		   | SOME (c, state) =>
-			if isPrint c
-			   then
-			      case c of
-				 #"\\" => escape state
-			       | #"\"" => NONE
-			       | _ => SOME (c, formatSequences reader state)
-			else NONE
-	       end
-	 in
-	    main
-	 end
+        : (char, 'a) StringCvt.reader =
+         let
+            val escape: (char, 'a) StringCvt.reader =
+               fn state =>
+               case reader state of
+                  NONE => NONE
+                | SOME (c, state') =>
+                     let
+                        fun yes c = SOME (c, state')
+                     in
+                        case c of
+                           #"a" => yes #"\a"
+                         | #"b" => yes #"\b"
+                         | #"t" => yes #"\t"
+                         | #"n" => yes #"\n"
+                         | #"v" => yes #"\v"
+                         | #"f" => yes #"\f"
+                         | #"r" => yes #"\r"
+                         | #"\\" => yes #"\\"
+                         | #"\"" => yes #"\""
+                         | #"^" => control reader state'
+                         | #"u" =>
+                              Reader.mapOpt chrOpt
+                              (StringCvt.digitsExact (StringCvt.HEX, 4) reader)
+                              state'
+                         | _ => (* 3 decimal digits *)
+                              Reader.mapOpt chrOpt
+                              (StringCvt.digitsExact (StringCvt.DEC, 3)
+                               reader)
+                              state
+                     end
+            val main: (char, 'a) StringCvt.reader =
+               fn state =>
+               let
+                  val state = formatSequences reader state
+               in
+                  case reader state of
+                     NONE => NONE
+                   | SOME (c, state) =>
+                        if isPrint c
+                           then
+                              case c of
+                                 #"\\" => escape state
+                               | #"\"" => NONE
+                               | _ => SOME (c, formatSequences reader state)
+                        else NONE
+               end
+         in
+            main
+         end
 
       val fromString = StringCvt.scanString scan
 
       fun 'a scanC (reader: (char, 'a) StringCvt.reader)
-	: (char, 'a) StringCvt.reader =
-	 let
-	    val rec escape =
-	       fn state =>
-	       case reader state of
-		  NONE => NONE
-		| SOME (c, state') =>
-		     let fun yes c = SOME (c, state')
-		     in case c of
-			#"a" => yes #"\a"
-		      | #"b" => yes #"\b"
-		      | #"t" => yes #"\t"
-		      | #"n" => yes #"\n"
-		      | #"v" => yes #"\v"
-		      | #"f" => yes #"\f"
-		      | #"r" => yes #"\r"
-		      | #"?" => yes #"?"
-		      | #"\\" => yes #"\\"
-		      | #"\"" => yes #"\""
-		      | #"'" => yes #"'"
-		      | #"^" => control reader state'
-		      | #"x" =>
-			   Reader.mapOpt chrOpt
-			   (StringCvt.digits StringCvt.HEX reader)
-			   state'
-		      | _ =>
-			   Reader.mapOpt chrOpt
-			   (StringCvt.digitsPlus (StringCvt.OCT, 3) reader)
-			   state
-		     end
-	    and main =
-	       fn NONE => NONE
-		| SOME (c, state) =>
-		     if isPrint c
-			then
-			   case c of
-			      #"\\" => escape state
-			    | _ => SOME (c, state)
-		     else NONE
-	 in
-	    main o reader
-	 end
+        : (char, 'a) StringCvt.reader =
+         let
+            val rec escape =
+               fn state =>
+               case reader state of
+                  NONE => NONE
+                | SOME (c, state') =>
+                     let fun yes c = SOME (c, state')
+                     in case c of
+                        #"a" => yes #"\a"
+                      | #"b" => yes #"\b"
+                      | #"t" => yes #"\t"
+                      | #"n" => yes #"\n"
+                      | #"v" => yes #"\v"
+                      | #"f" => yes #"\f"
+                      | #"r" => yes #"\r"
+                      | #"?" => yes #"?"
+                      | #"\\" => yes #"\\"
+                      | #"\"" => yes #"\""
+                      | #"'" => yes #"'"
+                      | #"^" => control reader state'
+                      | #"x" =>
+                           Reader.mapOpt chrOpt
+                           (StringCvt.digits StringCvt.HEX reader)
+                           state'
+                      | _ =>
+                           Reader.mapOpt chrOpt
+                           (StringCvt.digitsPlus (StringCvt.OCT, 3) reader)
+                           state
+                     end
+            and main =
+               fn NONE => NONE
+                | SOME (c, state) =>
+                     if isPrint c
+                        then
+                           case c of
+                              #"\\" => escape state
+                            | _ => SOME (c, state)
+                     else NONE
+         in
+            main o reader
+         end
 
       val fromCString = StringCvt.scanString scanC
 
       fun padLeft (s: string, n: int): string =
-	 let
-	    val m = String.size s
-	    val diff = n -? m
-	 in if Int.> (diff, 0)
-	       then String.concat [String.new (diff, #"0"), s]
-	    else if diff = 0
-		    then s
-		 else raise Fail "padLeft"
-	 end
+         let
+            val m = String.size s
+            val diff = n -? m
+         in if Int.> (diff, 0)
+               then String.concat [String.new (diff, #"0"), s]
+            else if diff = 0
+                    then s
+                 else raise Fail "padLeft"
+         end
 
       val toString =
-	 memoize
-	 (fn c =>
-	  if isPrint c
-	     then
-		(case c of
-		    #"\\" => "\\\\"
-		  | #"\"" => "\\\""
-		  | _ => String0.str c)
-	  else
-	     case c of
-		#"\a" => "\\a"
-	      | #"\b" => "\\b"
-	      | #"\t" => "\\t"
-	      | #"\n" => "\\n"
-	      | #"\v" => "\\v"
-	      | #"\f" => "\\f"
-	      | #"\r" => "\\r"
-	      | _ =>
-		   if c < #" "
-		      then (String.concat
-			    ["\\^", String0.str (chr (ord c +? ord #"@"))])
-		   else String.concat 
-		        ["\\", padLeft (Int.fmt StringCvt.DEC (ord c), 3)])
+         memoize
+         (fn c =>
+          if isPrint c
+             then
+                (case c of
+                    #"\\" => "\\\\"
+                  | #"\"" => "\\\""
+                  | _ => String0.str c)
+          else
+             case c of
+                #"\a" => "\\a"
+              | #"\b" => "\\b"
+              | #"\t" => "\\t"
+              | #"\n" => "\\n"
+              | #"\v" => "\\v"
+              | #"\f" => "\\f"
+              | #"\r" => "\\r"
+              | _ =>
+                   if c < #" "
+                      then (String.concat
+                            ["\\^", String0.str (chr (ord c +? ord #"@"))])
+                   else String.concat 
+                        ["\\", padLeft (Int.fmt StringCvt.DEC (ord c), 3)])
       
       val toCString =
-	 memoize
-	 (fn c =>
-	  if isPrint c
-	     then
-		(case c of
-		    #"\\" => "\\\\"
-		  | #"\"" => "\\\""
-		  | #"?" => "\\?"
-		  | #"'" => "\\'"
-		  | _ => String0.str c)
-	  else
-	     case c of
-		#"\a" => "\\a"
-	      | #"\b" => "\\b"
-	      | #"\t" => "\\t"
-	      | #"\n" => "\\n"
-	      | #"\v" => "\\v"
-	      | #"\f" => "\\f"
-	      | #"\r" => "\\r"
-	      | _ =>
-		   String.concat
-		   ["\\", padLeft (Int.fmt StringCvt.OCT (ord c), 3)])
+         memoize
+         (fn c =>
+          if isPrint c
+             then
+                (case c of
+                    #"\\" => "\\\\"
+                  | #"\"" => "\\\""
+                  | #"?" => "\\?"
+                  | #"'" => "\\'"
+                  | _ => String0.str c)
+          else
+             case c of
+                #"\a" => "\\a"
+              | #"\b" => "\\b"
+              | #"\t" => "\\t"
+              | #"\n" => "\\n"
+              | #"\v" => "\\v"
+              | #"\f" => "\\f"
+              | #"\r" => "\\r"
+              | _ =>
+                   String.concat
+                   ["\\", padLeft (Int.fmt StringCvt.OCT (ord c), 3)])
    end
 
 structure CharGlobal: CHAR_GLOBAL = Char

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/text/char0.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/text/char0.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/text/char0.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,14 +1,15 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 structure Char0 =
    struct
       open Primitive.Int Primitive.Char
-	 
+         
       type char = char
       type string = string
 
@@ -18,79 +19,79 @@
       val maxChar = #"\255"
 
       fun succ c =
-	 if Primitive.safe andalso c = maxChar
-	    then raise Chr
-	 else Primitive.Char.chr (ord c + 1)
+         if Primitive.safe andalso c = maxChar
+            then raise Chr
+         else Primitive.Char.chr (ord c + 1)
 
       fun pred c =
-	 if Primitive.safe andalso c = minChar
-	    then raise Chr
-	 else Primitive.Char.chr (ord c - 1)
+         if Primitive.safe andalso c = minChar
+            then raise Chr
+         else Primitive.Char.chr (ord c - 1)
 
       fun chrOpt c =
-	 if Primitive.safe andalso Primitive.Int.gtu (c, maxOrd)
-	    then NONE
-	 else SOME (Primitive.Char.chr c)
+         if Primitive.safe andalso Primitive.Int.gtu (c, maxOrd)
+            then NONE
+         else SOME (Primitive.Char.chr c)
 
       fun chr c =
-	 case chrOpt c of
-	    NONE => raise Chr
-	  | SOME c => c
+         case chrOpt c of
+            NONE => raise Chr
+          | SOME c => c
 
       val {compare, ...} = Util.makeCompare (op <)
 
       structure String = String0
 
       fun oneOf s =
-	 let
-	    val a = Array.array (numChars, false)
-	    val n = String.size s
-	    fun loop i =
-	       if Primitive.Int.>= (i, n) then ()
-	       else (Array.update (a, ord (String.sub (s, i)), true)
-		     ; loop (i + 1))
-	 in loop 0
-	    ; fn c => Array.sub (a, ord c)
-	 end
+         let
+            val a = Array.array (numChars, false)
+            val n = String.size s
+            fun loop i =
+               if Primitive.Int.>= (i, n) then ()
+               else (Array.update (a, ord (String.sub (s, i)), true)
+                     ; loop (i + 1))
+         in loop 0
+            ; fn c => Array.sub (a, ord c)
+         end
       val contains = oneOf
 
       fun notOneOf s = not o (oneOf s)
       val notContains = notOneOf
 
       fun memoize (f: char -> 'a): char -> 'a =
-	 let val a = Array.tabulate (numChars, f o chr)
-	 in fn c => Array.sub (a, ord c)
-	 end
-	 
+         let val a = Array.tabulate (numChars, f o chr)
+         in fn c => Array.sub (a, ord c)
+         end
+         
       local
-	 val not = fn f => memoize (not o f)
-	 infix or andd
-	 fun f or g = memoize (fn c => f c orelse g c)
-	 fun f andd g = memoize (fn c => f c andalso g c)
+         val not = fn f => memoize (not o f)
+         infix or andd
+         fun f or g = memoize (fn c => f c orelse g c)
+         fun f andd g = memoize (fn c => f c andalso g c)
       in
-	 val isLower = oneOf "abcdefghijklmnopqrstuvwxyz"
-	 val isUpper = oneOf "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
-	 val isDigit = oneOf "0123456789"
-	 val isAlpha = isUpper or isLower
-	 val isHexDigit = isDigit or (oneOf "abcdefABCDEF")
-	 val isAlphaNum = isAlpha or isDigit
-	 val isPrint = fn c => #" " <= c andalso c <= #"~"
-	 val isSpace = oneOf " \t\r\n\v\f"
-	 val isGraph = (not isSpace) andd isPrint
-	 val isPunct = isGraph andd (not isAlphaNum)
-	 val isCntrl = not isPrint
-	 val isAscii = fn c => c < #"\128"
+         val isLower = oneOf "abcdefghijklmnopqrstuvwxyz"
+         val isUpper = oneOf "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
+         val isDigit = oneOf "0123456789"
+         val isAlpha = isUpper or isLower
+         val isHexDigit = isDigit or (oneOf "abcdefABCDEF")
+         val isAlphaNum = isAlpha or isDigit
+         val isPrint = fn c => #" " <= c andalso c <= #"~"
+         val isSpace = oneOf " \t\r\n\v\f"
+         val isGraph = (not isSpace) andd isPrint
+         val isPunct = isGraph andd (not isAlphaNum)
+         val isCntrl = not isPrint
+         val isAscii = fn c => c < #"\128"
       end
 
       local
-	 fun make (lower, upper, diff) =
-	    memoize (fn c => if lower <= c andalso c <= upper
-			       then chr (ord c +? diff)
-			    else c)
-	 val diff = ord #"A" - ord #"a"
+         fun make (lower, upper, diff) =
+            memoize (fn c => if lower <= c andalso c <= upper
+                               then chr (ord c +? diff)
+                            else c)
+         val diff = ord #"A" - ord #"a"
       in
-	 val toLower = make (#"A", #"Z", ~diff)
-	 val toUpper = make (#"a", #"z", diff)
+         val toLower = make (#"A", #"Z", ~diff)
+         val toUpper = make (#"a", #"z", diff)
       end
    end
 

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/text/string-cvt.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/text/string-cvt.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/text/string-cvt.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -3,13 +3,13 @@
       datatype radix = BIN | OCT | DEC | HEX
 
       datatype realfmt =
-	 SCI of int option 
+         SCI of int option 
        | FIX of int option 
        | GEN of int option 
        | EXACT
-	 
+         
       type ('a, 'b) reader = 'b -> ('a * 'b) option
-	 
+         
       val padLeft: char -> int -> string -> string 
       val padRight: char -> int -> string -> string 
 
@@ -21,7 +21,7 @@
 
       type cs
       val scanString:
-	 ((char, cs) reader -> ('a, cs) reader) -> string -> 'a option
+         ((char, cs) reader -> ('a, cs) reader) -> string -> 'a option
    end
 
 signature STRING_CVT_EXTRA =

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/text/string-cvt.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/text/string-cvt.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/text/string-cvt.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 structure StringCvt: STRING_CVT_EXTRA =
    struct
       open Reader
@@ -14,18 +15,18 @@
       datatype radix = BIN | OCT | DEC | HEX
 
       val radixToInt: radix -> int =
-	 fn BIN => 2
-	  | OCT => 8
-	  | DEC => 10
-	  | HEX => 16
+         fn BIN => 2
+          | OCT => 8
+          | DEC => 10
+          | HEX => 16
       val radixToWord: radix -> word = wordFromInt o radixToInt
 
       datatype realfmt =
-	 SCI of int option 
+         SCI of int option 
        | FIX of int option 
        | GEN of int option 
        | EXACT
-	 
+         
       type ('a, 'b) reader = 'b -> ('a * 'b) option
 
       open Primitive.Int
@@ -34,30 +35,30 @@
       structure String = String0
 
       local
-	 fun pad f (c: char) i s =
-	    let
-	       val n = String.size s
-	    in
-	       if n >= i
-		  then s
-	       else f (s, String0.vector (i -? n, c))
-	    end
+         fun pad f (c: char) i s =
+            let
+               val n = String.size s
+            in
+               if n >= i
+                  then s
+               else f (s, String0.vector (i -? n, c))
+            end
       in
-	 val padLeft = pad (fn (s, pad) => String.^ (pad, s))
-	 val padRight = pad String.^
+         val padLeft = pad (fn (s, pad) => String.^ (pad, s))
+         val padRight = pad String.^
       end
 
       fun splitl p f src =
-	 let fun done chars = String0.implode (rev chars)
-	    fun loop (src, chars) =
-	       case f src of
-		  NONE => (done chars, src)
-		| SOME (c, src') =>
-		     if p c
-			then loop (src', c :: chars)
-		     else (done chars, src)
-	 in loop (src, [])
-	 end
+         let fun done chars = String0.implode (rev chars)
+            fun loop (src, chars) =
+               case f src of
+                  NONE => (done chars, src)
+                | SOME (c, src') =>
+                     if p c
+                        then loop (src', c :: chars)
+                     else (done chars, src)
+         in loop (src, [])
+         end
 
       fun takel p f s = #1 (splitl p f s)
       fun dropl p f s = #2 (splitl p f s)
@@ -67,132 +68,132 @@
       type cs = int
 
       fun stringReader (s: string): (char, cs) reader =
-	 fn i => if i >= String.size s
-		    then NONE
-		 else SOME (String.sub (s, i), i + 1)
-		    
+         fn i => if i >= String.size s
+                    then NONE
+                 else SOME (String.sub (s, i), i + 1)
+                    
       fun 'a scanString (f: ((char, cs) reader -> ('a, cs) reader)) (s: string)
-	: 'a option =
-	 case f (stringReader s) 0 of
-	    NONE => NONE
-	  | SOME (a, _) => SOME a
+        : 'a option =
+         case f (stringReader s) 0 of
+            NONE => NONE
+          | SOME (a, _) => SOME a
 
       local
-	 fun range (add: int, cmin: char, cmax: char): char -> int option =
-	    let val min = Char.ord cmin
-	    in fn c => if Char.<= (cmin, c) andalso Char.<= (c, cmax)
-			  then SOME (add +? Char.ord c -? min)
-		       else NONE
-	    end
+         fun range (add: int, cmin: char, cmax: char): char -> int option =
+            let val min = Char.ord cmin
+            in fn c => if Char.<= (cmin, c) andalso Char.<= (c, cmax)
+                          then SOME (add +? Char.ord c -? min)
+                       else NONE
+            end
 
-	 fun 'a combine (ds: (char -> 'a option) list): char -> 'a option =
-	    Char.memoize
-	    (fn c =>
-	     let
-		val rec loop =
-		   fn [] => NONE
-		    | d :: ds =>
-			 case d c of
-			    NONE => loop ds
-			  | z => z
-	     in loop ds
-	     end)
-	    
-	 val bin = Char.memoize (range (0, #"0", #"1"))
-	 val oct = Char.memoize (range (0, #"0", #"7"))
-	 val dec = Char.memoize (range (0, #"0", #"9"))
-	 val hex = combine [range (0, #"0", #"9"),
-			    range (10, #"a", #"f"),
-			    range (10, #"A", #"F")]
+         fun 'a combine (ds: (char -> 'a option) list): char -> 'a option =
+            Char.memoize
+            (fn c =>
+             let
+                val rec loop =
+                   fn [] => NONE
+                    | d :: ds =>
+                         case d c of
+                            NONE => loop ds
+                          | z => z
+             in loop ds
+             end)
+            
+         val bin = Char.memoize (range (0, #"0", #"1"))
+         val oct = Char.memoize (range (0, #"0", #"7"))
+         val dec = Char.memoize (range (0, #"0", #"9"))
+         val hex = combine [range (0, #"0", #"9"),
+                            range (10, #"a", #"f"),
+                            range (10, #"A", #"F")]
       in
-	 fun charToDigit (radix: radix): char -> int option =
-	    case radix of
-	       BIN => bin
-	     | OCT => oct
-	     | DEC => dec
-	     | HEX => hex
+         fun charToDigit (radix: radix): char -> int option =
+            case radix of
+               BIN => bin
+             | OCT => oct
+             | DEC => dec
+             | HEX => hex
       end
    
       fun charToWDigit radix = (Option.map wordFromInt) o (charToDigit radix)
 
       fun digits (radix, max, accum) reader state =
-	 let
-	    val r = radixToInt radix
-	    fun loop (max, accum, state) =
-	       let fun done () = SOME (accum, state)
-	       in if max <= 0
-		     then done ()
-		  else
-		     case reader state of
-			NONE => done ()
-		      | SOME (c, state) =>
-			   case charToDigit radix c of
-			      NONE => done ()
-			    | SOME n => loop (max - 1, n + accum * r, state)
-	       end
-	 in loop (max, accum, state)
-	 end
+         let
+            val r = radixToInt radix
+            fun loop (max, accum, state) =
+               let fun done () = SOME (accum, state)
+               in if max <= 0
+                     then done ()
+                  else
+                     case reader state of
+                        NONE => done ()
+                      | SOME (c, state) =>
+                           case charToDigit radix c of
+                              NONE => done ()
+                            | SOME n => loop (max - 1, n + accum * r, state)
+               end
+         in loop (max, accum, state)
+         end
 
       fun digitsPlus (radix, max) reader state =
-	 case reader state of
-	    NONE => NONE
-	  | SOME (c, state) =>
-	       case charToDigit radix c of
-		  NONE => NONE
-		| SOME n => digits (radix, max -? 1, n) reader state
+         case reader state of
+            NONE => NONE
+          | SOME (c, state) =>
+               case charToDigit radix c of
+                  NONE => NONE
+                | SOME n => digits (radix, max -? 1, n) reader state
 
       fun digitsExact (radix, num) reader state =
-	 let val r = radixToInt radix
-	    fun loop (num, accum, state) =
-	       if num <= 0
-		  then SOME (accum, state)
-	       else
-		  case reader state of
-		     NONE => NONE
-		   | SOME (c, state) =>
-			case charToDigit radix c of
-			   NONE => NONE
-			 | SOME n => loop (num - 1, n + accum * r, state)
-	 in loop (num, 0, state)
-	 end
+         let val r = radixToInt radix
+            fun loop (num, accum, state) =
+               if num <= 0
+                  then SOME (accum, state)
+               else
+                  case reader state of
+                     NONE => NONE
+                   | SOME (c, state) =>
+                        case charToDigit radix c of
+                           NONE => NONE
+                         | SOME n => loop (num - 1, n + accum * r, state)
+         in loop (num, 0, state)
+         end
 
       fun digits radix reader state =
-	 let 
-	    val r = radixToInt radix
-	    fun loop (accum, state) =
-	       case reader state of
-		  NONE => SOME (accum, state)
-		| SOME (c, state') =>
-		     case charToDigit radix c of
-			NONE => SOME (accum, state)
-		      | SOME n => loop (n + accum * r, state')
-	 in case reader state of
-	    NONE => NONE
-	  | SOME (c, state) =>
-	       case charToDigit radix c of
-		  NONE => NONE
-		| SOME n => loop (n, state)
-	 end
+         let 
+            val r = radixToInt radix
+            fun loop (accum, state) =
+               case reader state of
+                  NONE => SOME (accum, state)
+                | SOME (c, state') =>
+                     case charToDigit radix c of
+                        NONE => SOME (accum, state)
+                      | SOME n => loop (n + accum * r, state')
+         in case reader state of
+            NONE => NONE
+          | SOME (c, state) =>
+               case charToDigit radix c of
+                  NONE => NONE
+                | SOME n => loop (n, state)
+         end
 
       fun wdigits radix reader state =
-	 let 
-	    val op + = Primitive.Word32.+
-	    val op * = Primitive.Word32.*
-	    val r = radixToWord radix
-	    fun loop (accum, state) =
-	       case reader state of
-		  NONE => SOME (accum, state)
-		| SOME (c, state') =>
-		     case charToWDigit radix c of
-			NONE => SOME (accum, state)
-		      | SOME n => loop (n + accum * r, state')
-	 in case reader state of
-	    NONE => NONE
-	  | SOME (c, state) =>
-	       case charToWDigit radix c of
-		  NONE => NONE
-		| SOME n => loop (n, state)
-	 end
+         let 
+            val op + = Primitive.Word32.+
+            val op * = Primitive.Word32.*
+            val r = radixToWord radix
+            fun loop (accum, state) =
+               case reader state of
+                  NONE => SOME (accum, state)
+                | SOME (c, state') =>
+                     case charToWDigit radix c of
+                        NONE => SOME (accum, state)
+                      | SOME n => loop (n + accum * r, state')
+         in case reader state of
+            NONE => NONE
+          | SOME (c, state) =>
+               case charToWDigit radix c of
+                  NONE => NONE
+                | SOME n => loop (n, state)
+         end
 
       fun digitToChar (n: int): char = String.sub ("0123456789ABCDEF", n)
    end

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/text/string.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/text/string.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/text/string.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -2,7 +2,7 @@
    sig
       eqtype char
       eqtype string
-	 
+         
       val ^ : string * string -> string 
       val concat: string list -> string 
       val explode: string -> char list 
@@ -16,7 +16,7 @@
    sig
       include STRING_GLOBAL
 
-	 
+         
       val < : string * string -> bool 
       val <= : string * string -> bool 
       val > : string * string -> bool 

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/text/string.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/text/string.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/text/string.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 structure String: STRING_EXTRA =
    struct
       open String0
@@ -12,11 +13,11 @@
       val toLower = translate (str o Char.toLower)
 
       local
-	 fun make f = f (op = : char * char -> bool)
+         fun make f = f (op = : char * char -> bool)
       in
-	val isPrefix = make isPrefix
-	val isSubstring = make isSubvector
-	val isSuffix = make isSuffix
+        val isPrefix = make isPrefix
+        val isSubstring = make isSubvector
+        val isSuffix = make isSuffix
       end
       val compare = collate Char.compare
       val {<, <=, >, >=} = Util.makeOrder compare
@@ -25,24 +26,24 @@
       val toCString = translate Char.toCString
 
       val scan: (char, 'a) StringCvt.reader -> (string, 'a) StringCvt.reader =
-	 fn reader =>
-	 let
-	    fun loop (state, cs) =
-	       case Char.scan reader state of
-		  NONE => SOME (implode (rev cs),
-				Char.formatSequences reader state)
-		| SOME (c, state) => loop (state, c :: cs)
-	 in
-	    fn state => loop (state, [])
-	 end
-	 
+         fn reader =>
+         let
+            fun loop (state, cs) =
+               case Char.scan reader state of
+                  NONE => SOME (implode (rev cs),
+                                Char.formatSequences reader state)
+                | SOME (c, state) => loop (state, c :: cs)
+         in
+            fn state => loop (state, [])
+         end
+         
       val fromString = StringCvt.scanString scan
-	 
+         
       fun scanString scanChar (reader: (char, 'a) StringCvt.reader)
-	: (string, 'a) StringCvt.reader =
-	 fn state =>
-	 Option.map (fn (cs, state) => (implode cs, state))
-	 (Reader.list (scanChar reader) state)
+        : (string, 'a) StringCvt.reader =
+         fn state =>
+         Option.map (fn (cs, state) => (implode cs, state))
+         (Reader.list (scanChar reader) state)
 
       val fromCString = StringCvt.scanString (scanString Char.scanC)
 

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/text/string0.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/text/string0.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/text/string0.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,9 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 structure String0 = 
@@ -12,16 +12,16 @@
       type char = elem
       type string = vector
       structure Substring0 =
-	 struct
-	    open CharVectorSlice
-	    type char = elem
-	    type string = vector
-	    type substring = slice
-	 end
+         struct
+            open CharVectorSlice
+            type char = elem
+            type string = vector
+            type substring = slice
+         end
       val maxSize = maxLen
       val size = length
       fun extract (s, start, len) = 
-	 CharVectorSlice.vector (CharVectorSlice.slice (s, start, len))
+         CharVectorSlice.vector (CharVectorSlice.slice (s, start, len))
       fun substring (s, start, len) = extract (s, start, SOME len)
       val op ^ = append
       val new = vector

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/text/substring.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/text/substring.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/text/substring.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,9 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 (* The :> is to hide the type substring.  We must add the where's to make char
@@ -27,28 +27,28 @@
       val slice = subslice
       val explode = toList
       local
-	 fun make f = f (op = : char * char -> bool)
+         fun make f = f (op = : char * char -> bool)
       in
-	val isPrefix = make isPrefix
-	val isSubstring = make isSubvector
-	val isSuffix = make isSuffix
-	val position = make position
+        val isPrefix = make isPrefix
+        val isSubstring = make isSubvector
+        val isSuffix = make isSuffix
+        val position = make position
       end
       val compare = collate Char.compare
 (*
       type cs = int
-	 
+         
       fun reader (T {str, start, size}): (char, cs) Reader.reader =
-	 fn i => if i >= size
-		    then NONE
-		 else SOME (String.sub (str, start +? i), i + 1)
-		    
+         fn i => if i >= size
+                    then NONE
+                 else SOME (String.sub (str, start +? i), i + 1)
+                    
       fun 'a scanSubstring
-	 (f: (char, cs) Reader.reader -> ('a, int) Reader.reader)
-	 (ss: substring): 'a option =
-	 case f (reader ss) 0 of
-	    NONE => NONE
-	  | SOME (a, _) => SOME a
+         (f: (char, cs) Reader.reader -> ('a, int) Reader.reader)
+         (ss: substring): 'a option =
+         case f (reader ss) 0 of
+            NONE => NONE
+          | SOME (a, _) => SOME a
 *)
    end
 

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/text/text.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/text/text.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/text/text.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -8,19 +8,19 @@
       structure String: STRING
       structure Substring: SUBSTRING
       sharing type Char.char
-	 = CharArray.elem
-	 = CharArraySlice.elem
-	 = CharVector.elem
-	 = CharVectorSlice.elem
-	 = String.char
-	 = Substring.char
+         = CharArray.elem
+         = CharArraySlice.elem
+         = CharVector.elem
+         = CharVectorSlice.elem
+         = String.char
+         = Substring.char
       sharing type Char.string
-	 = CharArraySlice.vector
-	 = CharVector.vector
-	 = CharArray.vector
-	 = CharVectorSlice.vector
-	 = String.string
-	 = Substring.string
+         = CharArraySlice.vector
+         = CharVector.vector
+         = CharArray.vector
+         = CharVectorSlice.vector
+         = String.string
+         = Substring.string
       sharing type CharArray.array = CharArraySlice.array
       sharing type CharVectorSlice.slice = CharArraySlice.vector_slice
    end

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/text/text.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/text/text.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/text/text.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,10 @@
+(* Copyright (C) 2002-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 structure Text: TEXT =
    struct
       structure Char = Char

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/top-level/arithmetic.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/top-level/arithmetic.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/top-level/arithmetic.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,9 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 val ~ = Int.~

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/top-level/infixes.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/top-level/infixes.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/top-level/infixes.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 infix  7 * / mod div
 infix  6 + - ^
 infixr 5 :: @

Modified: mlton/branches/on-20050420-cmm-branch/basis-library/unsafe.mlb
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/unsafe.mlb	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/unsafe.mlb	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,7 +1,14 @@
+(* Copyright (C) 2004-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 ann  
    "deadCode true"
-   "sequenceUnit true"
-   "warnMatch true"
+   "sequenceNonUnit warn"
+   "nonexhaustiveMatch warn" "redundantMatch warn"
    "warnUnused true" "forceUsed"
 in
    local


Property changes on: mlton/branches/on-20050420-cmm-branch/benchmark
___________________________________________________________________
Name: svn:ignore
   - *~
core
benchmark
benchmark.sml
junk
   + *~
core
benchmark
benchmark.sml
junk


Deleted: mlton/branches/on-20050420-cmm-branch/benchmark/.cvsignore
===================================================================
--- mlton/branches/on-20050420-cmm-branch/benchmark/.cvsignore	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/benchmark/.cvsignore	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,5 +0,0 @@
-*~
-core
-benchmark
-benchmark.sml
-junk

Copied: mlton/branches/on-20050420-cmm-branch/benchmark/.ignore (from rev 4358, mlton/trunk/benchmark/.ignore)

Modified: mlton/branches/on-20050420-cmm-branch/benchmark/Makefile
===================================================================
--- mlton/branches/on-20050420-cmm-branch/benchmark/Makefile	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/benchmark/Makefile	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,11 @@
+## Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ #    Jagannathan, and Stephen Weeks.
+ # Copyright (C) 1997-2000 NEC Research Institute.
+ #
+ # MLton is released under a BSD-style license.
+ # See the file MLton-LICENSE for details.
+ ##
+
 SRC = $(shell cd .. && pwd)
 BUILD = $(SRC)/build
 BIN = $(BUILD)/bin
@@ -5,17 +13,16 @@
 MLTON = mlton
 TARGET = self
 FLAGS = -target $(TARGET)	\
-	-default-ann 'sequenceUnit true' \
+	-default-ann 'sequenceNonUnit warn' \
 	-default-ann 'warnUnused true'
 NAME = benchmark
 PATH = $(BIN):$(shell echo $$PATH)
 
 all: 	$(NAME)
 
-$(NAME): $(shell $(MLTON) -stop f $(NAME).cm)
+$(NAME): $(NAME).mlb $(shell PATH=$(BIN):$$PATH && $(MLTON) -stop f $(NAME).mlb)
 	@echo 'Compiling $(NAME)'
-	$(MLTON) $(FLAGS) $(NAME).cm
-	size $(NAME)
+	$(MLTON) $(FLAGS) $(NAME).mlb
 
 $(NAME).sml: $(NAME).cm $(shell $(MLTON) -stop f $(NAME).cm)
 	mlton -stop sml $(NAME).cm

Modified: mlton/branches/on-20050420-cmm-branch/benchmark/benchmark.cm
===================================================================
--- mlton/branches/on-20050420-cmm-branch/benchmark/benchmark.cm	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/benchmark/benchmark.cm	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,11 @@
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 Group is
 
 sources.cm

Copied: mlton/branches/on-20050420-cmm-branch/benchmark/benchmark.mlb (from rev 4358, mlton/trunk/benchmark/benchmark.mlb)

Modified: mlton/branches/on-20050420-cmm-branch/benchmark/call-main.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/benchmark/call-main.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/benchmark/call-main.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,8 +1,9 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 val _ = Main.main()

Modified: mlton/branches/on-20050420-cmm-branch/benchmark/main.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/benchmark/main.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/benchmark/main.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,20 +1,19 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 structure Main =
 struct
 
 type int = Int.t
 
-val fail = Process.fail
-
 fun usage msg =
    Process.usage {usage = "[-mlkit] [-mosml] [-smlnj] bench1 bench2 ...",
-		  msg = msg}
+                  msg = msg}
 
 val doOnce = ref false
 val doWiki = ref false
@@ -24,13 +23,13 @@
    let
       open FileDesc
       val inFd =
-	 let
-	    open Pervasive.Posix.FileSys
-	 in
-	    openf (file, O_RDONLY, O.flags [])
-	 end
+         let
+            open Pervasive.Posix.FileSys
+         in
+            openf (file, O_RDONLY, O.flags [])
+         end
    in
-      DynamicWind.wind
+      Exn.finally
       (fn () => FileDesc.fluidLet (FileDesc.stdin, inFd, f),
        fn () => FileDesc.close inFd)
    end
@@ -38,22 +37,22 @@
 fun ignoreOutput f =
    let
       val nullFd =
-	 let
-	    open Pervasive.Posix.FileSys
-	 in
-	    openf ("/dev/null", O_WRONLY, O.flags [])
-	 end
+         let
+            open Pervasive.Posix.FileSys
+         in
+            openf ("/dev/null", O_WRONLY, O.flags [])
+         end
       open FileDesc
    in
-      DynamicWind.wind
+      Exn.finally
       (fn () => fluidLet (stderr, nullFd, fn () =>
-			  fluidLet (stdout, nullFd, f)),
+                          fluidLet (stdout, nullFd, f)),
        fn () => close nullFd)
    end
 
 datatype command =
    Explicit of {args: string list,
-		com: string}
+                com: string}
   | Shell of string
 
 fun timeIt ca =
@@ -61,7 +60,7 @@
    (fn () =>
     case ca of
        Explicit {args, com} =>
-	  Process.wait (Process.spawnp {file = com, args = com :: args})
+          Process.wait (Process.spawnp {file = com, args = com :: args})
      | Shell s => Process.system s)
    
 local
@@ -69,20 +68,20 @@
 in
    fun timeCall (com, args): real =
       let 
-	 fun doit ac =
-	    let
-	       val {user, system} = timeIt (Explicit {args = args, com = com})
-	       val op + = Time.+
-	    in ac + user + system
-	    end
-	 fun loop (n, ac: Time.t): real =
-	    if Time.> (ac, trialTime)
-	       then Time.toReal ac / Real.fromInt n
-	    else loop (n + 1, doit ac)
+         fun doit ac =
+            let
+               val {user, system} = timeIt (Explicit {args = args, com = com})
+               val op + = Time.+
+            in ac + user + system
+            end
+         fun loop (n, ac: Time.t): real =
+            if Time.> (ac, trialTime)
+               then Time.toReal ac / Real.fromInt n
+            else loop (n + 1, doit ac)
       in 
-	 if !doOnce
-	    then Time.toReal (doit Time.zero)
-	 else loop (0, Time.zero)
+         if !doOnce
+            then Time.toReal (doit Time.zero)
+         else loop (0, Time.zero)
       end
 end
 
@@ -136,14 +135,14 @@
     case List.peek (benchCounts, fn (b, _, _) => b = s) of
        NONE => Error.bug (concat ["no benchCount for ", s])
      | SOME (_, x86, sparc) =>
-	  Int.toString
-	  let
-	     open MLton.Platform.Arch
-	  in
-	     case host of
-	        Sparc => sparc
-	      | _ => x86
-	  end)
+          Int.toString
+          let
+             open MLton.Platform.Arch
+          in
+             case host of
+                Sparc => sparc
+              | _ => x86
+          end)
 
 fun compileSizeRun {command, exe, doTextPlusData: bool} =
    Escape.new
@@ -151,26 +150,26 @@
     let
        val exe = "./" ^ exe
        val {system, user} = timeIt command
-	  handle _ => Escape.escape (e, {compile = NONE,
-					 run = NONE,
-					 size = NONE})
+          handle _ => Escape.escape (e, {compile = NONE,
+                                         run = NONE,
+                                         size = NONE})
        val compile = SOME (Time.toReal (Time.+ (system, user)))
        val size =
-	  if doTextPlusData
-	     then
-		let 
-		   val {text, data, ...} = Process.size exe
-		in SOME (Position.fromInt (text + data))
-		end
-	  else SOME (File.size exe)
+          if doTextPlusData
+             then
+                let 
+                   val {text, data, ...} = Process.size exe
+                in SOME (Position.fromInt (text + data))
+                end
+          else SOME (File.size exe)
        val run =
-	  timeCall (exe, !runArgs)
-	  handle _ => Escape.escape (e, {compile = compile,
-					 run = NONE,
-					 size = size})
+          timeCall (exe, !runArgs)
+          handle _ => Escape.escape (e, {compile = compile,
+                                         run = NONE,
+                                         size = size})
     in {compile = compile,
-	run = SOME run,
-	size = size}
+        run = SOME run,
+        size = size}
     end)
 
 fun batch bench = concat [bench, ".batch.sml"]
@@ -181,30 +180,30 @@
 in
    fun makeMLton commandPattern =
       case ChoicePattern.expand commandPattern of
-	 Result.No m => usage m
+         Result.No m => usage m
        | Result.Yes coms => 
-	    List.map
-	    (coms, fn com =>
-	     {name = com,
-	      abbrv = "MLton" ^ (Int.toString (Counter.next n)),
-	      test = (fn {bench} =>
-		      compileSizeRun
-		      {command = Shell (concat [com, " -output ", exe, " ", batch bench]),
-		       exe = exe,
-		       doTextPlusData = true})})
+            List.map
+            (coms, fn com =>
+             {name = com,
+              abbrv = "MLton" ^ (Int.toString (Counter.next n)),
+              test = (fn {bench} =>
+                      compileSizeRun
+                      {command = Shell (concat [com, " -output ", exe, " ", batch bench]),
+                       exe = exe,
+                       doTextPlusData = true})})
 end
 
 fun kitCompile {bench} =
    compileSizeRun {command = Explicit {args = [batch bench],
-				       com = "mlkit"},
-		   exe = "run",
-		   doTextPlusData = true}
+                                       com = "mlkit"},
+                   exe = "run",
+                   doTextPlusData = true}
    
 fun mosmlCompile {bench} =
    compileSizeRun
    {command = Explicit {args = ["-orthodox", "-standalone", "-toplevel",
-				batch bench],
-			com = "mosmlc"},
+                                batch bench],
+                        com = "mosmlc"},
     exe = "a.out",
     doTextPlusData = false}
 
@@ -215,153 +214,153 @@
        (* sml should start SML/NJ *)
        val sml = "sml"
        val {system, user} =
-	  File.withTempOut
-	  (fn out =>
-	   (Out.output
-	    (out, "local\nval _ = SMLofNJ.Internals.GC.messages false\n")
-	    ; File.outputContents (concat [bench, ".sml"], out)
-	    ; (Out.output
-	       (out,
-		concat
-		["in val _ = SMLofNJ.exportFn (\"", bench,
-		 "\", fn _ => (Main.doit ", benchCount bench,
-		 "; OS.Process.success))\nend\n"]
-		 ))),
+          File.withTempOut
+          (fn out =>
+           (Out.output
+            (out, "local\nval _ = SMLofNJ.Internals.GC.messages false\n")
+            ; File.outputContents (concat [bench, ".sml"], out)
+            ; (Out.output
+               (out,
+                concat
+                ["in val _ = SMLofNJ.exportFn (\"", bench,
+                 "\", fn _ => (Main.doit ", benchCount bench,
+                 "; OS.Process.success))\nend\n"]
+                 ))),
            fn input => withInput (input, fn () => timeIt (Explicit {args = [],
-								    com = sml})))
+                                                                    com = sml})))
          handle _ => Escape.escape (e, {compile = NONE,
-					run = NONE,
-					size = NONE})
+                                        run = NONE,
+                                        size = NONE})
        val suffix =
-		 let
-		   datatype z = datatype MLton.Platform.Arch.t
-		   datatype z = datatype MLton.Platform.OS.t
-		 in
-		   case (MLton.Platform.Arch.host, MLton.Platform.OS.host) of
-		     (X86, Linux) => ".x86-linux"
-		   | (Sparc, Solaris) => ".sparc-solaris"
-		   | _ => raise Fail "don't know SML/NJ suffix for host type"
-		 end
+                 let
+                   datatype z = datatype MLton.Platform.Arch.t
+                   datatype z = datatype MLton.Platform.OS.t
+                 in
+                   case (MLton.Platform.Arch.host, MLton.Platform.OS.host) of
+                     (X86, Linux) => ".x86-linux"
+                   | (Sparc, Solaris) => ".sparc-solaris"
+                   | _ => raise Fail "don't know SML/NJ suffix for host type"
+                 end
        val heap = concat [bench, suffix]
     in
        if not (File.doesExist heap)
-	  then {compile = NONE,
-		run = NONE,
-		size = NONE}
+          then {compile = NONE,
+                run = NONE,
+                size = NONE}
        else
           let
-	     val compile = Time.toReal (Time.+ (user, system))
-	     val size = SOME (File.size heap)
-	     val run =
-		  timeCall (sml, [concat ["@SMLload=", heap]])
-		  handle _ => Escape.escape (e, {compile = SOME compile,
-						 run = NONE,
-						 size = size})
-	  in {compile = SOME compile,
-	      run = SOME run,
-	      size = size}
-	  end
+             val compile = Time.toReal (Time.+ (user, system))
+             val size = SOME (File.size heap)
+             val run =
+                  timeCall (sml, [concat ["@SMLload=", heap]])
+                  handle _ => Escape.escape (e, {compile = SOME compile,
+                                                 run = NONE,
+                                                 size = size})
+          in {compile = SOME compile,
+              run = SOME run,
+              size = size}
+          end
     end)
-		
+                
 fun polyCompile {bench} =
    Escape.new
    (fn e =>
     let
        val originalDbase = "/usr/lib/poly/ML_dbase"
-       val poly = "poly"
+       val poly = "/usr/bin/poly"
     in File.withTemp
        (fn dbase =>
-	let
-	   val _ = File.copy (originalDbase, dbase)
-	   val original = File.size dbase
-	   val {system, user} =
-	      File.withTempOut
-	      (fn out =>
-	       Out.output
-	       (out,
-		concat ["use \"", bench, ".sml\" handle _ => PolyML.quit ();\n",
-			"if PolyML.commit() then () else ",
-			"(Main.doit ", benchCount bench, "; ());\n",
-			"PolyML.quit();\n"]),
-	       fn input =>
-	       withInput
-	       (input, fn () =>
-		timeIt (Explicit {args = [dbase],
-				  com = "poly"})))
-	   val after = File.size dbase
-	in
-	   if original = after
-	      then {compile = NONE,
-		    run = NONE,
-		    size = NONE}
-	   else
-	       let
-		  val compile = SOME (Time.toReal (Time.+ (user, system)))
-		  val size = SOME (after - original)
-		  val run =
-		     timeCall (poly, [dbase])
-		     handle _ => Escape.escape (e, {compile = compile,
-						    run = NONE,
-						    size = size})
-	       in
-		  {compile = compile,
-		   run = SOME run,
-		   size = size}
-	       end
-	end)
+        let
+           val _ = File.copy (originalDbase, dbase)
+           val original = File.size dbase
+           val {system, user} =
+              File.withTempOut
+              (fn out =>
+               Out.output
+               (out,
+                concat ["use \"", bench, ".sml\" handle _ => PolyML.quit ();\n",
+                        "if PolyML.commit() then () else ",
+                        "(Main.doit ", benchCount bench, "; ());\n",
+                        "PolyML.quit();\n"]),
+               fn input =>
+               withInput
+               (input, fn () =>
+                timeIt (Explicit {args = [dbase],
+                                  com = poly})))
+           val after = File.size dbase
+        in
+           if original = after
+              then {compile = NONE,
+                    run = NONE,
+                    size = NONE}
+           else
+               let
+                  val compile = SOME (Time.toReal (Time.+ (user, system)))
+                  val size = SOME (after - original)
+                  val run =
+                     timeCall (poly, [dbase])
+                     handle _ => Escape.escape (e, {compile = compile,
+                                                    run = NONE,
+                                                    size = size})
+               in
+                  {compile = compile,
+                   run = SOME run,
+                   size = size}
+               end
+        end)
     end)
 
 type 'a data = {bench: string,
-		compiler: string,
-		value: 'a} list
+                compiler: string,
+                value: 'a} list
 
 fun main args =
    let
       val compilers: {name: string,
-		      abbrv: string,
-		      test: {bench: File.t} -> {compile: real option,
-						run: real option,
-						size: Position.int option}} list ref 
-	= ref []
+                      abbrv: string,
+                      test: {bench: File.t} -> {compile: real option,
+                                                run: real option,
+                                                size: Position.int option}} list ref 
+        = ref []
       fun pushCompiler compiler = List.push(compilers, compiler)
       fun pushCompilers compilers' = compilers := (List.rev compilers') @ (!compilers)
 
       fun setData (switch, data, str) =
-	 let
-	    fun die () = usage (concat ["invalid -", switch, " argument: ", str])
-	    open Regexp
-	    val numSave = Save.new ()
-	    val regexpSave = Save.new ()
-	    val re = seq [save (star digit, numSave),
-			  char #",",
-			  save (star any, regexpSave)]
-	    val reC = compileDFA re
-	 in
-	    case Compiled.matchAll (reC, str) of
-	       NONE => die ()
-	     | SOME match => 
-		  let
-		     val num = Match.lookupString (match, numSave)
-		     val num = case Int.fromString num of
-		                  NONE => die ()
-				| SOME num => num
-		     val regexp = Match.lookupString (match, regexpSave)
-		     val (regexp, saves) = 
-		        case Regexp.fromString regexp of
-			   NONE => die ()
-			 | SOME regexp => regexp
-		     val save = if 0 <= num andalso num < Vector.length saves
-				   then Vector.sub (saves, num)
-				else die ()
-		     val regexpC = compileDFA regexp
-		     fun doit s =
-		         Option.map
-			 (Compiled.matchAll (regexpC, s),
-			  fn match => Match.lookupString (match, save))
-		  in
-		    data := SOME (str, doit)
-		  end
-	 end
+         let
+            fun die () = usage (concat ["invalid -", switch, " argument: ", str])
+            open Regexp
+            val numSave = Save.new ()
+            val regexpSave = Save.new ()
+            val re = seq [save (star digit, numSave),
+                          char #",",
+                          save (star any, regexpSave)]
+            val reC = compileDFA re
+         in
+            case Compiled.matchAll (reC, str) of
+               NONE => die ()
+             | SOME match => 
+                  let
+                     val num = Match.lookupString (match, numSave)
+                     val num = case Int.fromString num of
+                                  NONE => die ()
+                                | SOME num => num
+                     val regexp = Match.lookupString (match, regexpSave)
+                     val (regexp, saves) = 
+                        case Regexp.fromString regexp of
+                           NONE => die ()
+                         | SOME regexp => regexp
+                     val save = if 0 <= num andalso num < Vector.length saves
+                                   then Vector.sub (saves, num)
+                                else die ()
+                     val regexpC = compileDFA regexp
+                     fun doit s =
+                         Option.map
+                         (Compiled.matchAll (regexpC, s),
+                          fn match => Match.lookupString (match, save))
+                  in
+                    data := SOME (str, doit)
+                  end
+         end
       val outData : (string * (string -> string option)) option ref = ref NONE
       val setOutData = fn str => setData ("out", outData, str)
       val errData : (string * (string -> string option)) option ref = ref NONE
@@ -370,307 +369,307 @@
        * otherwise.
        *)
        val _ =
-	  let
-	     open MLton.Platform.OS
-	  in
-	     if host = Linux
-		then
-		   let
-		      open MLton.Rlimit
-		      val {hard, ...} = get stackSize
-		   in
-		      set (stackSize, {hard = hard, soft = hard})
-		   end
-	     else ()
-	  end
+          let
+             open MLton.Platform.OS
+          in
+             if host = Linux
+                then
+                   let
+                      open MLton.Rlimit
+                      val {hard, ...} = get stackSize
+                   in
+                      set (stackSize, {hard = hard, soft = hard})
+                   end
+             else ()
+          end
       local
-	 open Popt
+         open Popt
       in
-	 val res =
-	    parse
-	    {switches = args,
-	     opts = [("args",
-		      SpaceString
-		      (fn args =>
-		       runArgs := String.tokens (args, Char.isSpace))),
-		     ("err", SpaceString setErrData),
-		     ("mlkit", 
-		      None (fn () => pushCompiler
-			    {name = "ML-Kit",
-			     abbrv = "ML-Kit",
-			     test = kitCompile})),
-		     ("mosml",
-		      None (fn () => pushCompiler
-			    {name = "Moscow-ML",
-			     abbrv = "Moscow-ML",
-			     test = mosmlCompile})),
-		     ("mlton",
-		      SpaceString (fn arg => pushCompilers
-				   (makeMLton arg))),
-		     ("once", trueRef doOnce),
-		     ("out", SpaceString setOutData),
-		     ("poly",
-		      None (fn () => pushCompiler
-			    {name = "Poly/ML",
-			     abbrv = "Poly/ML",
-			     test = polyCompile})),
-		     ("smlnj",
-		      None (fn () => pushCompiler
-			    {name = "SML/NJ",
-			     abbrv = "SML/NJ",
-			     test = njCompile})),
-		     trace,
-		     ("wiki", trueRef doWiki)]}
+         val res =
+            parse
+            {switches = args,
+             opts = [("args",
+                      SpaceString
+                      (fn args =>
+                       runArgs := String.tokens (args, Char.isSpace))),
+                     ("err", SpaceString setErrData),
+                     ("mlkit", 
+                      None (fn () => pushCompiler
+                            {name = "ML-Kit",
+                             abbrv = "ML-Kit",
+                             test = kitCompile})),
+                     ("mosml",
+                      None (fn () => pushCompiler
+                            {name = "Moscow-ML",
+                             abbrv = "Moscow-ML",
+                             test = mosmlCompile})),
+                     ("mlton",
+                      SpaceString (fn arg => pushCompilers
+                                   (makeMLton arg))),
+                     ("once", trueRef doOnce),
+                     ("out", SpaceString setOutData),
+                     ("poly",
+                      None (fn () => pushCompiler
+                            {name = "Poly/ML",
+                             abbrv = "Poly/ML",
+                             test = polyCompile})),
+                     ("smlnj",
+                      None (fn () => pushCompiler
+                            {name = "SML/NJ",
+                             abbrv = "SML/NJ",
+                             test = njCompile})),
+                     trace,
+                     ("wiki", trueRef doWiki)]}
       end
    in
       case res of
-	 Result.No msg => usage msg
+         Result.No msg => usage msg
        | Result.Yes benchmarks =>
-	    let
-	       val compilers = List.rev (!compilers)
-	       val base = #name (hd compilers)
-	       val _ =
-		  let
-		     open MLton.Signal
-		  in
-		     setHandler (Posix.Signal.pipe, Handler.ignore)
-		  end
-	       fun r2s n r = Real.format (r, Real.Format.fix (SOME n))
-	       val i2s = Int.toCommaString
-	       val p2s = i2s o Position.toInt
-	       val s2s = fn s => s
-	       val failures = ref []
-	       fun show ({compiles, runs, sizes, errs, outs}, {showAll}) =
-		  let
-		     val out = Out.standard
-		     val _ =
-			List.foreach
-			(compilers, fn {name, abbrv, ...} =>
-			 Out.output (out, concat [abbrv, " -- ", name, "\n"]))
-		     val _ =
-			case !failures of
-			   [] => ()
-			 | fs =>
-			    Out.output
-			    (out,
-			     concat ["WARNING: ", base, " failed on: ",
-				     concat (List.separate (fs, ", ")),
-				     "\n"])
-		     fun show (title, data: 'a data, toString, toStringHtml) =
-			let
-			   val _ = Out.output (out, concat [title, "\n"])
-			   val compilers =
-			      List.fold
-			      (compilers, [],
-			       fn ({name = n, abbrv = n', ...}, ac) =>
-			       if showAll
-				  orelse (List.exists
-					  (data, fn {compiler = c, ...} =>
-					   n = c))
-				  then (n, n') :: ac
-			       else ac)
-			   val benchmarks =
-			      List.fold
-			      (benchmarks, [], fn (b, ac) =>
-			       if showAll
-				  orelse List.exists (data, fn {bench, ...} =>
-						      bench = b)
-				  then b :: ac
-			       else ac)
-			   fun rows toString =
-			      ("benchmark"
-			       :: List.revMap (compilers, fn (_, n') => n'))
-			      :: (List.revMap
-				  (benchmarks, fn b =>
-				   b :: (List.revMap
-					 (compilers, fn (n, _) =>
-					  case (List.peek
-						(data, fn {bench = b',
-							   compiler = c', ...} =>
-						 b = b' andalso n = c')) of
-					     NONE => "*"
-					   | SOME {value = v, ...} =>
-						toString v))))
-			   open Justify
-			   val () =
-			      outputTable
-			      (table {columnHeads = NONE,
-				      justs = (Left ::
-					       List.revMap (compilers,
-							    fn _ => Right)),
-				      rows = rows toString},
-			       out)
-			   fun prow ns =
-			      let
-				 fun p s = Out.output (out, s)
-			      in
-				 case ns of
-				    [] => raise Fail "bug"
-				  | b :: ns =>
-				       (p "||"
-					; p b
-					; List.foreach (ns, fn n =>
-							(p "||"; p n))
-					; p "||\n")
-			      end
-			   val _ =
-			      if not (!doWiki)
-				 then ()
-			      else
-				 let
-				    val rows = rows toStringHtml
-				 in					  
-				    prow (hd rows)
-				    ; (List.foreach
-				       (tl rows,
-					fn [] => raise Fail "bug"
-					 | b :: r =>
-					      let
-						 val b = 
-						    concat
-						    ["[attachment:",
-						     b, ".sml ", b, "]"]
-					      in
-						 prow (b :: r)
-					      end))
-				 end
-			in
-			   ()
-			end
-		     val bases = List.keepAll (runs, fn {compiler, ...} =>
-					       compiler = base)
-		     val ratios =
-			List.fold
-			(runs, [], fn ({bench, compiler, value}, ac) =>
-			 if compiler = base andalso not showAll
-			    then ac
-			 else
-			    {bench = bench,
-			     compiler = compiler,
-			     value =
-			     case List.peek (bases, fn {bench = b, ...} =>
-					     bench = b) of
-				NONE => ~1.0
-			      | SOME {value = v, ...} => value / v} :: ac)
-		     val _ = show ("run time ratio", ratios, r2s 2, r2s 1)
-		     val _ = show ("size", sizes, p2s, p2s)
-		     val _ = show ("compile time", compiles, r2s 2, r2s 2)
-		     val _ = show ("run time", runs, r2s 2, r2s 2)
-		     val _ = case !outData of
+            let
+               val compilers = List.rev (!compilers)
+               val base = #name (hd compilers)
+               val _ =
+                  let
+                     open MLton.Signal
+                  in
+                     setHandler (Pervasive.Posix.Signal.pipe, Handler.ignore)
+                  end
+               fun r2s n r = Real.format (r, Real.Format.fix (SOME n))
+               val i2s = Int.toCommaString
+               val p2s = i2s o Position.toInt
+               val s2s = fn s => s
+               val failures = ref []
+               fun show ({compiles, runs, sizes, errs, outs}, {showAll}) =
+                  let
+                     val out = Out.standard
+                     val _ =
+                        List.foreach
+                        (compilers, fn {name, abbrv, ...} =>
+                         Out.output (out, concat [abbrv, " -- ", name, "\n"]))
+                     val _ =
+                        case !failures of
+                           [] => ()
+                         | fs =>
+                            Out.output
+                            (out,
+                             concat ["WARNING: ", base, " failed on: ",
+                                     concat (List.separate (fs, ", ")),
+                                     "\n"])
+                     fun show (title, data: 'a data, toString, toStringHtml) =
+                        let
+                           val _ = Out.output (out, concat [title, "\n"])
+                           val compilers =
+                              List.fold
+                              (compilers, [],
+                               fn ({name = n, abbrv = n', ...}, ac) =>
+                               if showAll
+                                  orelse (List.exists
+                                          (data, fn {compiler = c, ...} =>
+                                           n = c))
+                                  then (n, n') :: ac
+                               else ac)
+                           val benchmarks =
+                              List.fold
+                              (benchmarks, [], fn (b, ac) =>
+                               if showAll
+                                  orelse List.exists (data, fn {bench, ...} =>
+                                                      bench = b)
+                                  then b :: ac
+                               else ac)
+                           fun rows toString =
+                              ("benchmark"
+                               :: List.revMap (compilers, fn (_, n') => n'))
+                              :: (List.revMap
+                                  (benchmarks, fn b =>
+                                   b :: (List.revMap
+                                         (compilers, fn (n, _) =>
+                                          case (List.peek
+                                                (data, fn {bench = b',
+                                                           compiler = c', ...} =>
+                                                 b = b' andalso n = c')) of
+                                             NONE => "*"
+                                           | SOME {value = v, ...} =>
+                                                toString v))))
+                           open Justify
+                           val () =
+                              outputTable
+                              (table {columnHeads = NONE,
+                                      justs = (Left ::
+                                               List.revMap (compilers,
+                                                            fn _ => Right)),
+                                      rows = rows toString},
+                               out)
+                           fun prow ns =
+                              let
+                                 fun p s = Out.output (out, s)
+                              in
+                                 case ns of
+                                    [] => raise Fail "bug"
+                                  | b :: ns =>
+                                       (p "||"
+                                        ; p b
+                                        ; List.foreach (ns, fn n =>
+                                                        (p "||"; p n))
+                                        ; p "||\n")
+                              end
+                           val _ =
+                              if not (!doWiki)
+                                 then ()
+                              else
+                                 let
+                                    val rows = rows toStringHtml
+                                 in                                       
+                                    prow (hd rows)
+                                    ; (List.foreach
+                                       (tl rows,
+                                        fn [] => raise Fail "bug"
+                                         | b :: r =>
+                                              let
+                                                 val b = 
+                                                    concat
+                                                    ["[attachment:",
+                                                     b, ".sml ", b, "]"]
+                                              in
+                                                 prow (b :: r)
+                                              end))
+                                 end
+                        in
+                           ()
+                        end
+                     val bases = List.keepAll (runs, fn {compiler, ...} =>
+                                               compiler = base)
+                     val ratios =
+                        List.fold
+                        (runs, [], fn ({bench, compiler, value}, ac) =>
+                         if compiler = base andalso not showAll
+                            then ac
+                         else
+                            {bench = bench,
+                             compiler = compiler,
+                             value =
+                             case List.peek (bases, fn {bench = b, ...} =>
+                                             bench = b) of
+                                NONE => ~1.0
+                              | SOME {value = v, ...} => value / v} :: ac)
+                     val _ = show ("run time ratio", ratios, r2s 2, r2s 1)
+                     val _ = show ("size", sizes, p2s, p2s)
+                     val _ = show ("compile time", compiles, r2s 2, r2s 2)
+                     val _ = show ("run time", runs, r2s 2, r2s 2)
+                     val _ = case !outData of
                         NONE => ()
                       | SOME (out, _) =>
                            show (concat ["out: ", out], outs, s2s, s2s)
-		     val _ = case !errData of
-			NONE => ()
-		      | SOME (err, _) =>
-			   show (concat ["err: ", err], errs, s2s, s2s)
-		  in ()
-		  end
-	       val totalFailures = ref []
-	       val data = 
-		  List.fold
-		  (benchmarks, {compiles = [], runs = [], sizes = [],
-				outs = [], errs = []},
-		   fn (bench, ac) =>
-		   let
-		      val _ =
-			 File.withOut
-			 (batch bench, fn out =>
-			  (File.outputContents (concat [bench, ".sml"], out)
-			   ; Out.output (out, concat ["val _ = Main.doit ",
-						      benchCount bench,
-						      "\n"])))
-		      val foundOne = ref false
-		      val res =
-			 List.fold
-			 (compilers, ac, fn ({name, abbrv = _, test},
-					     ac as {compiles: real data,
-						    runs: real data,
-						    sizes: Position.int data,
-						    outs: string data,
-						    errs: string data}) =>
-			  if true
-			     then
-				let
-				   val (outTmpFile, _) =
-				      File.temp {prefix = "tmp", suffix = "out"}
-				   val (errTmpFile, _) =
-				      File.temp {prefix = "tmp", suffix = "err"}
-				   val {compile, run, size} =
-				     ignoreOutput
-				     (fn () => test {bench = bench})
-				   val _ =
-				      if name = base
-					 andalso Option.isNone run
-					 then List.push (failures, bench)
-				      else ()
-				   val out = 
-				      case !outData of 
-					 NONE => NONE
-				       | SOME (_, doit) => 
-					    File.foldLines
-					    (outTmpFile, NONE, fn (s, v) =>
-					     let val s = String.removeTrailing
-					                 (s, fn c => 
-							  Char.equals (c, Char.newline))
-					     in
-						case doit s of
-						   NONE => v
-						 | v => v
-					     end)
-				   val err = 
-				      case !errData of 
-					 NONE => NONE
-				       | SOME (_, doit) =>
-					    File.foldLines
-					    (errTmpFile, NONE, fn (s, v) =>
-					     let val s = String.removeTrailing
-						         (s, fn c => 
-							  Char.equals (c, Char.newline))
-					     in
-						case doit s of
-						   NONE => v
-						 | v => v
-					     end)
-				   val _ = File.remove outTmpFile
-				   val _ = File.remove errTmpFile
-				   fun add (v, ac) =
-				      case v of
-					 NONE => ac
-				       | SOME v =>
-					    (foundOne := true
-					     ; {bench = bench,
-						compiler = name,
-						value = v} :: ac)
-				   val ac =
-				      {compiles = add (compile, compiles),
-				       runs = add (run, runs),
-				       sizes = add (size, sizes),
-				       outs = add (out, outs),
-				       errs = add (err, errs)}
-				   val _ = show (ac, {showAll = false})
-				   val _ = Out.flush Out.standard
-				in
-				   ac
-				end
-			  else ac)
-		      val _ =
-			 if !foundOne
-			    then ()
-			 else List.push (totalFailures, bench)
-		   in
-		      res
-		   end)
-	       val _ = show (data, {showAll = true})
-	       val totalFailures = !totalFailures
-	       val _ =
-		  if List.isEmpty totalFailures
-		     then ()
-		  else (print ("The following benchmarks failed completely.\n")
-			; List.foreach (totalFailures, fn s =>
-					print (concat [s, "\n"])))
-	    in ()
-	    end
+                     val _ = case !errData of
+                        NONE => ()
+                      | SOME (err, _) =>
+                           show (concat ["err: ", err], errs, s2s, s2s)
+                  in ()
+                  end
+               val totalFailures = ref []
+               val data = 
+                  List.fold
+                  (benchmarks, {compiles = [], runs = [], sizes = [],
+                                outs = [], errs = []},
+                   fn (bench, ac) =>
+                   let
+                      val _ =
+                         File.withOut
+                         (batch bench, fn out =>
+                          (File.outputContents (concat [bench, ".sml"], out)
+                           ; Out.output (out, concat ["val _ = Main.doit ",
+                                                      benchCount bench,
+                                                      "\n"])))
+                      val foundOne = ref false
+                      val res =
+                         List.fold
+                         (compilers, ac, fn ({name, abbrv = _, test},
+                                             ac as {compiles: real data,
+                                                    runs: real data,
+                                                    sizes: Position.int data,
+                                                    outs: string data,
+                                                    errs: string data}) =>
+                          if true
+                             then
+                                let
+                                   val (outTmpFile, _) =
+                                      File.temp {prefix = "tmp", suffix = "out"}
+                                   val (errTmpFile, _) =
+                                      File.temp {prefix = "tmp", suffix = "err"}
+                                   val {compile, run, size} =
+                                     ignoreOutput
+                                     (fn () => test {bench = bench})
+                                   val _ =
+                                      if name = base
+                                         andalso Option.isNone run
+                                         then List.push (failures, bench)
+                                      else ()
+                                   val out = 
+                                      case !outData of 
+                                         NONE => NONE
+                                       | SOME (_, doit) => 
+                                            File.foldLines
+                                            (outTmpFile, NONE, fn (s, v) =>
+                                             let val s = String.removeTrailing
+                                                         (s, fn c => 
+                                                          Char.equals (c, Char.newline))
+                                             in
+                                                case doit s of
+                                                   NONE => v
+                                                 | v => v
+                                             end)
+                                   val err = 
+                                      case !errData of 
+                                         NONE => NONE
+                                       | SOME (_, doit) =>
+                                            File.foldLines
+                                            (errTmpFile, NONE, fn (s, v) =>
+                                             let val s = String.removeTrailing
+                                                         (s, fn c => 
+                                                          Char.equals (c, Char.newline))
+                                             in
+                                                case doit s of
+                                                   NONE => v
+                                                 | v => v
+                                             end)
+                                   val _ = File.remove outTmpFile
+                                   val _ = File.remove errTmpFile
+                                   fun add (v, ac) =
+                                      case v of
+                                         NONE => ac
+                                       | SOME v =>
+                                            (foundOne := true
+                                             ; {bench = bench,
+                                                compiler = name,
+                                                value = v} :: ac)
+                                   val ac =
+                                      {compiles = add (compile, compiles),
+                                       runs = add (run, runs),
+                                       sizes = add (size, sizes),
+                                       outs = add (out, outs),
+                                       errs = add (err, errs)}
+                                   val _ = show (ac, {showAll = false})
+                                   val _ = Out.flush Out.standard
+                                in
+                                   ac
+                                end
+                          else ac)
+                      val _ =
+                         if !foundOne
+                            then ()
+                         else List.push (totalFailures, bench)
+                   in
+                      res
+                   end)
+               val _ = show (data, {showAll = true})
+               val totalFailures = !totalFailures
+               val _ =
+                  if List.isEmpty totalFailures
+                     then ()
+                  else (print ("The following benchmarks failed completely.\n")
+                        ; List.foreach (totalFailures, fn s =>
+                                        print (concat [s, "\n"])))
+            in ()
+            end
    end
 
 val main = Process.makeMain main

Modified: mlton/branches/on-20050420-cmm-branch/benchmark/sources.cm
===================================================================
--- mlton/branches/on-20050420-cmm-branch/benchmark/sources.cm	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/benchmark/sources.cm	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 Group is
 
 ../lib/mlton/sources.cm

Copied: mlton/branches/on-20050420-cmm-branch/benchmark/sources.mlb (from rev 4358, mlton/trunk/benchmark/sources.mlb)


Property changes on: mlton/branches/on-20050420-cmm-branch/benchmark/tests
___________________________________________________________________
Name: svn:ignore
   - *.batch.sml
*.dot
*.mlton.sml
*.ssa
*.ui
*.uo
*.x86-linux
DLXSimulator
ML_dbase
PM
TEST
a.out
barnes-hut
checksum
chess.ppm
count-graphs
fft
fib
flint.core
fxp
hamlet
hello
imp-for
knuth-bendix
lexgen
life
logic
mandelbrot
matrix-multiply
md5
merge
mlmon.out
mlyacc
mpuz
nucleic
peek
psdes-random
ratio-regions
ray
raytrace
run
simple
smith-normal-form
tailfib
tak
tensor
tmp*
tsp
tyan
vector-concat
vector-rev
vliw
wc-input1
wc-scanStream
z
z.sml
zebra
zern
   + *.batch.sml
*.dot
*.mlton.sml
*.ssa
*.ui
*.uo
*.x86-linux
DLXSimulator
ML_dbase
PM
TEST
a.out
barnes-hut
checksum
chess.ppm
count-graphs
fft
fib
flint.core
fxp
hamlet
hello
imp-for
knuth-bendix
lexgen
life
logic
mandelbrot
matrix-multiply
md5
merge
mlmon.out
mlyacc
mpuz
nucleic
peek
psdes-random
ratio-regions
ray
raytrace
run
simple
smith-normal-form
tailfib
tak
tensor
tmp*
tsp
tyan
vector-concat
vector-rev
vliw
wc-input1
wc-scanStream
z
z.sml
zebra
zern


Deleted: mlton/branches/on-20050420-cmm-branch/benchmark/tests/.cvsignore
===================================================================
--- mlton/branches/on-20050420-cmm-branch/benchmark/tests/.cvsignore	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/benchmark/tests/.cvsignore	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,58 +0,0 @@
-*.batch.sml
-*.dot
-*.mlton.sml
-*.ssa
-*.ui
-*.uo
-*.x86-linux
-DLXSimulator
-ML_dbase
-PM
-TEST
-a.out
-barnes-hut
-checksum
-chess.ppm
-count-graphs
-fft
-fib
-flint.core
-fxp
-hamlet
-hello
-imp-for
-knuth-bendix
-lexgen
-life
-logic
-mandelbrot
-matrix-multiply
-md5
-merge
-mlmon.out
-mlyacc
-mpuz
-nucleic
-peek
-psdes-random
-ratio-regions
-ray
-raytrace
-run
-simple
-smith-normal-form
-tailfib
-tak
-tensor
-tmp*
-tsp
-tyan
-vector-concat
-vector-rev
-vliw
-wc-input1
-wc-scanStream
-z
-z.sml
-zebra
-zern

Copied: mlton/branches/on-20050420-cmm-branch/benchmark/tests/.ignore (from rev 4358, mlton/trunk/benchmark/tests/.ignore)


Property changes on: mlton/branches/on-20050420-cmm-branch/benchmark/tests/DATA
___________________________________________________________________
Name: svn:ignore
   + ml.grm.sig
ml.grm.sml
ml.lex.sml
tmp.s
cmp.s


Deleted: mlton/branches/on-20050420-cmm-branch/benchmark/tests/DATA/.cvsignore
===================================================================
--- mlton/branches/on-20050420-cmm-branch/benchmark/tests/DATA/.cvsignore	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/benchmark/tests/DATA/.cvsignore	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,5 +0,0 @@
-ml.grm.sig
-ml.grm.sml
-ml.lex.sml
-tmp.s
-cmp.s

Copied: mlton/branches/on-20050420-cmm-branch/benchmark/tests/DATA/.ignore (from rev 4358, mlton/trunk/benchmark/tests/DATA/.ignore)

Modified: mlton/branches/on-20050420-cmm-branch/benchmark/tests/DATA/ml.grm
===================================================================
--- mlton/branches/on-20050420-cmm-branch/benchmark/tests/DATA/ml.grm	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/benchmark/tests/DATA/ml.grm	2006-02-16 19:34:54 UTC (rev 4361)
@@ -4,10 +4,10 @@
 fun fire a b c = (a(); b c)
 fun markexp (e as MARKexp _, _, _) = e
   | markexp(e,a,b) = if !System.Control.markabsyn
-			then MARKexp(e,a,b) else e
+                        then MARKexp(e,a,b) else e
 fun markdec((d as MARKdec _, e), _, _) = (d,e)
   | markdec((d,e),a,b) = if !System.Control.markabsyn
-			then (MARKdec(d,a,b),e) else (d,e)
+                        then (MARKdec(d,a,b),e) else (d,e)
 
 fun markdec' d =
   let val (d,e) = markdec d
@@ -18,9 +18,9 @@
   | markdec'' ((s,e),a,b) = markdec'((SEQdec s, e),a,b)
 
 fun markstr(f,a,b) $ = case f $
-			of s as (MARKstr _,x,y) => s
-			 | s as (t,x,y) => if !System.Control.markabsyn
-				  then (MARKstr(t,a,b),x,y) else s
+                        of s as (MARKstr _,x,y) => s
+                         | s as (t,x,y) => if !System.Control.markabsyn
+                                  then (MARKstr(t,a,b),x,y) else s
 
 infix \/ 
 val op \/ = union_tyvars
@@ -28,16 +28,16 @@
 fun V(_,vars) = vars and E(e,_) = e
 
 fun sequence (do1,do2) (env,a2,a3,a4) =
-	let val (r1,env1) = do1 (env,a2,a3,a4)
-	    val (r2,env2) = do2 (Env.atop(env1,env),a2,a3,a4)
-	in (r1 @ r2, Env.atop(env2,env1))
-	end
+        let val (r1,env1) = do1 (env,a2,a3,a4)
+            val (r2,env2) = do2 (Env.atop(env1,env),a2,a3,a4)
+        in (r1 @ r2, Env.atop(env2,env1))
+        end
 
 fun sequence' (do1,do2) env =
-	let val (r1,env1) = do1 env
-	    val (r2,env2) = do2 (Env.atop(env1,env))
+        let val (r1,env1) = do1 env
+            val (r2,env2) = do2 (Env.atop(env1,env))
         in (r1 @ r2, Env.atop(env2,env1))
-	end	
+        end     
 
 fun seqdec (d,e) = ([d],e)
 
@@ -56,82 +56,82 @@
   | ORELSE | ANDALSO | IMPORT
 
 %nonterm  ident of string
-	| id of string
-	| int of int
-	| op_op of unit susp
-	| opid of symbol enved
-	| qid of ((string->symbol) -> symbol list)
-	| qid_p0 of symbol list list
-	| selector of symbol
-	| tycon of symbol list
-	| tlabel of (symbol * ty) enved uvars
-	| tlabels  of (symbol * ty) list enved uvars
-	| ty' of ty enved uvars
-	| tuple_ty of ty list enved uvars
-	| ty of ty enved uvars
-	| ty0_pc of ty list enved uvars
-	| match of rule list evstamped uvars
-	| rule of rule evstamped uvars
-	| elabel of (symbol * exp) evstamped uvars
-	| elabels of (symbol * exp) list evstamped uvars
-	| exp_ps of exp list evstamped uvars
-	| exp of exp evstamped uvars
-	| app_exp of exp precStack evstamped uvars
-	| aexp of exp evstamped uvars
-	| exp_list of exp list evstamped uvars
-	| exp_2c  of exp list evstamped uvars
-	| pat of pat enved uvars
-	| pat' of pat enved uvars
-	| pat'' of pat enved uvars
-	| apat of (pat * fixity * complainer) enved uvars
-	| apat' of (pat * fixity * complainer) enved uvars
-	| apat'' of pat enved uvars
-	| plabel of (symbol * pat) enved uvars
-	| plabels of ((symbol * pat) list * bool) enved uvars
-	| pat_2c of pat list enved uvars
-	| pat_list of pat list enved uvars
-	| vb of vb list evstamped
-	| constraint of ty option enved uvars
-	| rvb of rawrvb list enved
-	| fb' of rawclause list enved uvars
-	| fb of rawclause list list enved uvars
-	| apats of (pat * fixity * complainer) list enved uvars
-	| clause' of (symbol * pat list) enved uvars
-	| clause of rawclause enved uvars
-	| tb of bool -> tb list withenv epathvstamped
-	| tyvars of tyvar list
-	| tyvar_pc of tyvar list
-	| db of (symbol * int * datacon list withenv epathed) list
-	| constrs of (Basics.env * ty  -> (symbol * bool * ty) list) uvars
-	| constr of (Basics.env * ty -> symbol * bool * ty) uvars
-	| eb of eb list withenv epathvstamped uvars
-	| qid_p of structureVar list enved
-	| fixity of fixity
-	| ldec of dec withenv epathvstamped uvars
-	| exp_pa of exp list evstamped
-	| ldecs of dec withenv epathvstamped uvars
-	| ops of symbol list
-	| spec_s of spectype
-	| spec of spectype
-	| strspec of spectype
-	| tyspec of eqprop -> spectype
-	| valspec of spectype
-	| exnspec of spectype
-	| sharespec of spectype
-	| patheqn of (string->symbol) -> symbol list list
-	| sign of bool (* toplevel? *) * bool (* functor param? *) * 
-			Structure (*param*) -> signtype
-	| sigconstraint_op of (Basics.env * Structure) -> Structure option
-	| sigb of signatureVar list withenv enved 
-	| str of strtype
-	| sdecs of dec list withenv epathnstamped
- 	| sdecs' of dec list withenv epathnstamped
-	| sdec of dec withenv epathnstamped
-	| strb of bool -> (symbol*structureVar*strb) list epathstamped
-	| fparam of functorFormal
-	| fctb of (symbol * functorVar * fctb) list enved
-	| importdec of string list
-	| interdec of dec withenv enved
+        | id of string
+        | int of int
+        | op_op of unit susp
+        | opid of symbol enved
+        | qid of ((string->symbol) -> symbol list)
+        | qid_p0 of symbol list list
+        | selector of symbol
+        | tycon of symbol list
+        | tlabel of (symbol * ty) enved uvars
+        | tlabels  of (symbol * ty) list enved uvars
+        | ty' of ty enved uvars
+        | tuple_ty of ty list enved uvars
+        | ty of ty enved uvars
+        | ty0_pc of ty list enved uvars
+        | match of rule list evstamped uvars
+        | rule of rule evstamped uvars
+        | elabel of (symbol * exp) evstamped uvars
+        | elabels of (symbol * exp) list evstamped uvars
+        | exp_ps of exp list evstamped uvars
+        | exp of exp evstamped uvars
+        | app_exp of exp precStack evstamped uvars
+        | aexp of exp evstamped uvars
+        | exp_list of exp list evstamped uvars
+        | exp_2c  of exp list evstamped uvars
+        | pat of pat enved uvars
+        | pat' of pat enved uvars
+        | pat'' of pat enved uvars
+        | apat of (pat * fixity * complainer) enved uvars
+        | apat' of (pat * fixity * complainer) enved uvars
+        | apat'' of pat enved uvars
+        | plabel of (symbol * pat) enved uvars
+        | plabels of ((symbol * pat) list * bool) enved uvars
+        | pat_2c of pat list enved uvars
+        | pat_list of pat list enved uvars
+        | vb of vb list evstamped
+        | constraint of ty option enved uvars
+        | rvb of rawrvb list enved
+        | fb' of rawclause list enved uvars
+        | fb of rawclause list list enved uvars
+        | apats of (pat * fixity * complainer) list enved uvars
+        | clause' of (symbol * pat list) enved uvars
+        | clause of rawclause enved uvars
+        | tb of bool -> tb list withenv epathvstamped
+        | tyvars of tyvar list
+        | tyvar_pc of tyvar list
+        | db of (symbol * int * datacon list withenv epathed) list
+        | constrs of (Basics.env * ty  -> (symbol * bool * ty) list) uvars
+        | constr of (Basics.env * ty -> symbol * bool * ty) uvars
+        | eb of eb list withenv epathvstamped uvars
+        | qid_p of structureVar list enved
+        | fixity of fixity
+        | ldec of dec withenv epathvstamped uvars
+        | exp_pa of exp list evstamped
+        | ldecs of dec withenv epathvstamped uvars
+        | ops of symbol list
+        | spec_s of spectype
+        | spec of spectype
+        | strspec of spectype
+        | tyspec of eqprop -> spectype
+        | valspec of spectype
+        | exnspec of spectype
+        | sharespec of spectype
+        | patheqn of (string->symbol) -> symbol list list
+        | sign of bool (* toplevel? *) * bool (* functor param? *) * 
+                        Structure (*param*) -> signtype
+        | sigconstraint_op of (Basics.env * Structure) -> Structure option
+        | sigb of signatureVar list withenv enved 
+        | str of strtype
+        | sdecs of dec list withenv epathnstamped
+        | sdecs' of dec list withenv epathnstamped
+        | sdec of dec withenv epathnstamped
+        | strb of bool -> (symbol*structureVar*strb) list epathstamped
+        | fparam of functorFormal
+        | fctb of (symbol * functorVar * fctb) list enved
+        | importdec of string list
+        | interdec of dec withenv enved
 
 %pos int
 %arg (error) : pos * pos -> ErrorMsg.severity -> string -> unit
@@ -175,558 +175,558 @@
 
 %%
 
-int	: INT		(INT)
-	| INT0		(INT0)
+int     : INT           (INT)
+        | INT0          (INT0)
 
-id	: ID		(ID)
-	| ASTERISK	("*")
+id      : ID            (ID)
+        | ASTERISK      ("*")
 
-ident	: ID 		(ID)
-	| ASTERISK	("*")
-	| EQUAL		("=")
+ident   : ID            (ID)
+        | ASTERISK      ("*")
+        | EQUAL         ("=")
 
-op_op	: OP		(fn()=> error (OPleft,OPright) WARN "unnecessary `op'")
-	| 		(fn()=>())
+op_op   : OP            (fn()=> error (OPleft,OPright) WARN "unnecessary `op'")
+        |               (fn()=>())
 
-opid	: id		(fn env => let val (v,f) = var'n'fix id
-				    in case lookFIX env f of NONfix => ()
-				      | _ => error (idleft,idright) COMPLAIN
-						"nonfix identifier required";
-				      v
-				   end)
-	| OP ident	(fn _ => varSymbol ident)
+opid    : id            (fn env => let val (v,f) = var'n'fix id
+                                    in case lookFIX env f of NONfix => ()
+                                      | _ => error (idleft,idright) COMPLAIN
+                                                "nonfix identifier required";
+                                      v
+                                   end)
+        | OP ident      (fn _ => varSymbol ident)
 
-qid	: ID DOT qid	(fn kind => strSymbol ID :: qid kind)
-	| ident		(fn kind => [kind ident])
+qid     : ID DOT qid    (fn kind => strSymbol ID :: qid kind)
+        | ident         (fn kind => [kind ident])
 
-selector: id		(labSymbol id)
-	| INT		(Symbol.labSymbol(makestring INT))
+selector: id            (labSymbol id)
+        | INT           (Symbol.labSymbol(makestring INT))
 
-tycon   : ID DOT tycon		(strSymbol ID :: tycon)
-	| ID			([tycSymbol ID])
+tycon   : ID DOT tycon          (strSymbol ID :: tycon)
+        | ID                    ([tycSymbol ID])
 
-tlabel	: selector COLON ty	(fn $ =>(selector, E ty $), V ty)
+tlabel  : selector COLON ty     (fn $ =>(selector, E ty $), V ty)
 
-tlabels : tlabel COMMA tlabels	(fn $ => E tlabel $ :: E tlabels $,
-				 V tlabel \/ V tlabels)
-	| tlabel		(fn $ => [E tlabel $], V tlabel)
+tlabels : tlabel COMMA tlabels  (fn $ => E tlabel $ :: E tlabels $,
+                                 V tlabel \/ V tlabels)
+        | tlabel                (fn $ => [E tlabel $], V tlabel)
 
-ty'	: TYVAR		(let val tyv = mkTyvar(mkUBOUND(tyvSymbol TYVAR))
-			  in (fn _ => VARty tyv, singleton_tyvar tyv)
-			 end)
-	| LBRACE tlabels
-		 RBRACE (fn $ => make_recordTy(E tlabels $,
-						error(LBRACEleft,RBRACEright)),
-			 V tlabels)
-	| LBRACE RBRACE	(fn _ => make_recordTy(nil,
-					error(LBRACEleft,RBRACEright)),
-			 no_tyvars)
-	| LPAREN ty0_pc 
+ty'     : TYVAR         (let val tyv = mkTyvar(mkUBOUND(tyvSymbol TYVAR))
+                          in (fn _ => VARty tyv, singleton_tyvar tyv)
+                         end)
+        | LBRACE tlabels
+                 RBRACE (fn $ => make_recordTy(E tlabels $,
+                                                error(LBRACEleft,RBRACEright)),
+                         V tlabels)
+        | LBRACE RBRACE (fn _ => make_recordTy(nil,
+                                        error(LBRACEleft,RBRACEright)),
+                         no_tyvars)
+        | LPAREN ty0_pc 
           RPAREN tycon  (fn env =>let val ts = E ty0_pc env
-			  in CONty(lookPathArTYC env
-				    (tycon,length ts,
-				     error (tyconleft,tyconright) COMPLAIN),
-				    ts)
-				 end,
-			 V ty0_pc)
-	| LPAREN ty RPAREN	(ty)
-	| ty' tycon	(fn env =>CONty(lookPathArTYC env (tycon,1,
-					error(tyconleft,tyconright)COMPLAIN),
-					[E ty' env]),
-			 V ty')
-	| tycon		(fn env =>CONty(lookPathArTYC env (tycon, 0,
-				  error(tyconleft,tyconright)COMPLAIN),[]),
-			 no_tyvars)
+                          in CONty(lookPathArTYC env
+                                    (tycon,length ts,
+                                     error (tyconleft,tyconright) COMPLAIN),
+                                    ts)
+                                 end,
+                         V ty0_pc)
+        | LPAREN ty RPAREN      (ty)
+        | ty' tycon     (fn env =>CONty(lookPathArTYC env (tycon,1,
+                                        error(tyconleft,tyconright)COMPLAIN),
+                                        [E ty' env]),
+                         V ty')
+        | tycon         (fn env =>CONty(lookPathArTYC env (tycon, 0,
+                                  error(tyconleft,tyconright)COMPLAIN),[]),
+                         no_tyvars)
 
 tuple_ty : ty' ASTERISK 
-		tuple_ty (fn $ => E ty' $ :: E tuple_ty $,
-			  V ty' \/ V tuple_ty)
-	 | ty' ASTERISK 
-		ty'	 (fn $ =>[E ty'1 $, E ty'2 $], V ty'1 \/ V ty'2)
+                tuple_ty (fn $ => E ty' $ :: E tuple_ty $,
+                          V ty' \/ V tuple_ty)
+         | ty' ASTERISK 
+                ty'      (fn $ =>[E ty'1 $, E ty'2 $], V ty'1 \/ V ty'2)
 
-ty	: tuple_ty	(fn $ =>tupleTy(E tuple_ty $), V tuple_ty)
-	| ty ARROW ty	(fn $ =>CONty(arrowTycon, [E ty1 $, E ty2 $]),
-			 V ty1 \/ V ty2)
-	| ty' 		(ty')
-	
-ty0_pc	: ty COMMA ty	(fn $ => [E ty1 $, E ty2 $], V ty1 \/ V ty2)
-	| ty COMMA 
-		ty0_pc 	(fn $ => E ty $ :: E ty0_pc $, V ty \/ V ty0_pc)
+ty      : tuple_ty      (fn $ =>tupleTy(E tuple_ty $), V tuple_ty)
+        | ty ARROW ty   (fn $ =>CONty(arrowTycon, [E ty1 $, E ty2 $]),
+                         V ty1 \/ V ty2)
+        | ty'           (ty')
+        
+ty0_pc  : ty COMMA ty   (fn $ => [E ty1 $, E ty2 $], V ty1 \/ V ty2)
+        | ty COMMA 
+                ty0_pc  (fn $ => E ty $ :: E ty0_pc $, V ty \/ V ty0_pc)
 
-match	: rule		(fn evst => [E rule evst], V rule)
-	| rule BAR 
-		match	(fn evst => E rule evst :: E match evst, 
-			 V rule \/ V match)
+match   : rule          (fn evst => [E rule evst], V rule)
+        | rule BAR 
+                match   (fn evst => E rule evst :: E match evst, 
+                         V rule \/ V match)
 
-rule	: pat DARROW 
-		exp	(makeRULE(E pat, fn $ => markexp(E exp $,expleft,expright),
-					error(patleft,patright)),
-			 V pat \/ V exp)
+rule    : pat DARROW 
+                exp     (makeRULE(E pat, fn $ => markexp(E exp $,expleft,expright),
+                                        error(patleft,patright)),
+                         V pat \/ V exp)
 
 
-elabel	: selector EQUAL
-		 exp	(fn evst => (selector,E exp evst), V exp)
+elabel  : selector EQUAL
+                 exp    (fn evst => (selector,E exp evst), V exp)
 
 elabels : elabel COMMA 
-		elabels	(fn evst => (E elabel evst :: E elabels evst),
-			 V elabel \/ V elabels)
-	| elabel	(fn evst => [E elabel evst], V elabel)
+                elabels (fn evst => (E elabel evst :: E elabels evst),
+                         V elabel \/ V elabels)
+        | elabel        (fn evst => [E elabel evst], V elabel)
 
-exp_ps	: exp		(fn st => [E exp st], V exp)
-	| exp SEMICOLON 
-		exp_ps	(fn st => E exp st :: E exp_ps st, V exp \/ V exp_ps)
+exp_ps  : exp           (fn st => [E exp st], V exp)
+        | exp SEMICOLON 
+                exp_ps  (fn st => E exp st :: E exp_ps st, V exp \/ V exp_ps)
 
-exp	: exp HANDLE 
-		match	(fn st=> makeHANDLEexp(E exp st, E match st),
-				 V exp \/ V match)
+exp     : exp HANDLE 
+                match   (fn st=> makeHANDLEexp(E exp st, E match st),
+                                 V exp \/ V match)
 
-	| exp ORELSE exp
-			(fn st=> ORELSEexp(markexp(E exp1 st, exp1left,exp1right),
-					 markexp(E exp2 st,exp2left,expright)),
-			 V exp1 \/ V exp2)
-	| exp ANDALSO exp
-			(fn st=> ANDALSOexp(markexp(E exp1 st,exp1left,exp1right),
-				markexp(E exp2 st,exp2left,exp2right)),
-			 V exp1 \/ V exp2)
-	| exp COLON ty	(fn (st as (env,_,_))=> CONSTRAINTexp(E exp st,
-						              E ty env),
-			 V exp \/ V ty)
-	| app_exp	(fn st=> exp_finish(E app_exp st,
-					error(app_expright,app_expright)),
-			 V app_exp)
+        | exp ORELSE exp
+                        (fn st=> ORELSEexp(markexp(E exp1 st, exp1left,exp1right),
+                                         markexp(E exp2 st,exp2left,expright)),
+                         V exp1 \/ V exp2)
+        | exp ANDALSO exp
+                        (fn st=> ANDALSOexp(markexp(E exp1 st,exp1left,exp1right),
+                                markexp(E exp2 st,exp2left,exp2right)),
+                         V exp1 \/ V exp2)
+        | exp COLON ty  (fn (st as (env,_,_))=> CONSTRAINTexp(E exp st,
+                                                              E ty env),
+                         V exp \/ V ty)
+        | app_exp       (fn st=> exp_finish(E app_exp st,
+                                        error(app_expright,app_expright)),
+                         V app_exp)
 
-	| FN match	(fn st=> markexp(FNexp(completeMatch(E match st)),
-					 FNleft,matchright),
-			 V match)
-	| CASE exp 
-	   OF match	(fn st=>markexp(CASEexp(E exp st, 
-						completeMatch(E match st)),
-						CASEleft,matchright),
-			 V exp \/ V match)
-	| WHILE exp 
-	   DO exp	(fn st=> WHILEexp(E exp1 st,
-					markexp(E exp2 st,exp2left,exp2right)),
-			 V exp1 \/ V exp2)
-	| IF exp THEN exp 
-	    ELSE exp 	(fn st=>IFexp(E exp1 st, 
-					markexp(E exp2 st,exp2left,exp2right),
-				        markexp(E exp3 st,exp3left,exp3right)),
-			 V exp1 \/ V exp2 \/ V exp3)
-	| RAISE exp	(fn st=>markexp(RAISEexp(E exp st),RAISEleft,expright),
-			 V exp)
+        | FN match      (fn st=> markexp(FNexp(completeMatch(E match st)),
+                                         FNleft,matchright),
+                         V match)
+        | CASE exp 
+           OF match     (fn st=>markexp(CASEexp(E exp st, 
+                                                completeMatch(E match st)),
+                                                CASEleft,matchright),
+                         V exp \/ V match)
+        | WHILE exp 
+           DO exp       (fn st=> WHILEexp(E exp1 st,
+                                        markexp(E exp2 st,exp2left,exp2right)),
+                         V exp1 \/ V exp2)
+        | IF exp THEN exp 
+            ELSE exp    (fn st=>IFexp(E exp1 st, 
+                                        markexp(E exp2 st,exp2left,exp2right),
+                                        markexp(E exp3 st,exp3left,exp3right)),
+                         V exp1 \/ V exp2 \/ V exp3)
+        | RAISE exp     (fn st=>markexp(RAISEexp(E exp st),RAISEleft,expright),
+                         V exp)
 
-app_exp	: aexp 		(fn st => exp_start(markexp(E aexp st, aexpleft,aexpright),
-					    NONfix, 
-					    error (aexpleft,aexpright)),
-			 V aexp)
-        | ident		(fn (env,_,_) => 
-			   let val e = error(identleft,identright)
-			       val (v,f) = var'n'fix ident
-			   in exp_start(markexp(lookID env (v,e),
-						identleft,identright),
-					lookFIX env f, e)
-			   end,
-			 no_tyvars)
-	| app_exp aexp	(fn st => exp_parse(E app_exp st, 
-					markexp(E aexp st, aexpleft,aexpright),
-					NONfix,
-					error (aexpleft,aexpright)),
-			 V app_exp \/ V aexp)
-	| app_exp ident	(fn (st as (env,_,_)) => 
-			   let val e = error(identleft,identright)
-			       val (v,f) = var'n'fix ident
-			   in exp_parse(E app_exp st, 
-					markexp(lookID env (v,e), 
-						identleft,identright),
-					lookFIX env f, e)
-			   end,
-			 V app_exp)
+app_exp : aexp          (fn st => exp_start(markexp(E aexp st, aexpleft,aexpright),
+                                            NONfix, 
+                                            error (aexpleft,aexpright)),
+                         V aexp)
+        | ident         (fn (env,_,_) => 
+                           let val e = error(identleft,identright)
+                               val (v,f) = var'n'fix ident
+                           in exp_start(markexp(lookID env (v,e),
+                                                identleft,identright),
+                                        lookFIX env f, e)
+                           end,
+                         no_tyvars)
+        | app_exp aexp  (fn st => exp_parse(E app_exp st, 
+                                        markexp(E aexp st, aexpleft,aexpright),
+                                        NONfix,
+                                        error (aexpleft,aexpright)),
+                         V app_exp \/ V aexp)
+        | app_exp ident (fn (st as (env,_,_)) => 
+                           let val e = error(identleft,identright)
+                               val (v,f) = var'n'fix ident
+                           in exp_parse(E app_exp st, 
+                                        markexp(lookID env (v,e), 
+                                                identleft,identright),
+                                        lookFIX env f, e)
+                           end,
+                         V app_exp)
 
-aexp	: OP ident		(fn (env,_,_) => lookID env (varSymbol ident, error(identleft,identright)),
-				 no_tyvars)
-	| ID DOT qid		(fn (env,_,_) => 
-				   varcon(lookPathVARCON env (strSymbol ID
-							      ::(qid varSymbol),
-					     error(IDleft,qidright)COMPLAIN)),
-				 no_tyvars)
-	| int			(fn st => INTexp int, no_tyvars)
-	| REAL			(fn st => REALexp REAL, no_tyvars)
-	| STRING		(fn st => STRINGexp STRING, no_tyvars)
-	| HASH selector		(fn st => SELECTORexp selector, no_tyvars)
-	| LBRACE elabels RBRACE	(fn st=> makeRECORDexp(E elabels st,
-				        error(LBRACEleft,RBRACEright)),
-				 V elabels)
-	| LBRACE RBRACE		(fn st=> RECORDexp nil, no_tyvars)
-	| LPAREN RPAREN		(fn st=> unitExp, no_tyvars)
-	| LPAREN exp_ps RPAREN	(fn st=> SEQexp(E exp_ps st), V exp_ps)
-	| LPAREN exp_2c RPAREN	(fn st=> TUPLEexp(E exp_2c st), V exp_2c)
-	| LBRACKET exp_list
-		RBRACKET	(fn st=> LISTexp(E exp_list st), V exp_list)
-	| LBRACKET RBRACKET	(fn st=> nilExp, no_tyvars)
-	| LET ldecs 
-		IN exp_ps END	(fn (env,tv,st) => 
-				    let val (d,env') = E ldecs(env,[],tv,st)
-				        val e = E exp_ps (Env.atop(env',env),tv,st)
-				    in markexp(LETexp(d,SEQexp e),
-					       LETleft,ENDright)
-				    end,
-				 V exp_ps \/ V ldecs)
+aexp    : OP ident              (fn (env,_,_) => lookID env (varSymbol ident, error(identleft,identright)),
+                                 no_tyvars)
+        | ID DOT qid            (fn (env,_,_) => 
+                                   varcon(lookPathVARCON env (strSymbol ID
+                                                              ::(qid varSymbol),
+                                             error(IDleft,qidright)COMPLAIN)),
+                                 no_tyvars)
+        | int                   (fn st => INTexp int, no_tyvars)
+        | REAL                  (fn st => REALexp REAL, no_tyvars)
+        | STRING                (fn st => STRINGexp STRING, no_tyvars)
+        | HASH selector         (fn st => SELECTORexp selector, no_tyvars)
+        | LBRACE elabels RBRACE (fn st=> makeRECORDexp(E elabels st,
+                                        error(LBRACEleft,RBRACEright)),
+                                 V elabels)
+        | LBRACE RBRACE         (fn st=> RECORDexp nil, no_tyvars)
+        | LPAREN RPAREN         (fn st=> unitExp, no_tyvars)
+        | LPAREN exp_ps RPAREN  (fn st=> SEQexp(E exp_ps st), V exp_ps)
+        | LPAREN exp_2c RPAREN  (fn st=> TUPLEexp(E exp_2c st), V exp_2c)
+        | LBRACKET exp_list
+                RBRACKET        (fn st=> LISTexp(E exp_list st), V exp_list)
+        | LBRACKET RBRACKET     (fn st=> nilExp, no_tyvars)
+        | LET ldecs 
+                IN exp_ps END   (fn (env,tv,st) => 
+                                    let val (d,env') = E ldecs(env,[],tv,st)
+                                        val e = E exp_ps (Env.atop(env',env),tv,st)
+                                    in markexp(LETexp(d,SEQexp e),
+                                               LETleft,ENDright)
+                                    end,
+                                 V exp_ps \/ V ldecs)
 
-exp_2c	: exp COMMA exp_2c	(fn st=> E exp st :: E exp_2c st,
-				 V exp \/ V exp_2c)
-	| exp COMMA exp		(fn st=> [E exp1 st, E exp2 st],
-				 V exp1 \/ V exp2)
+exp_2c  : exp COMMA exp_2c      (fn st=> E exp st :: E exp_2c st,
+                                 V exp \/ V exp_2c)
+        | exp COMMA exp         (fn st=> [E exp1 st, E exp2 st],
+                                 V exp1 \/ V exp2)
 
-exp_list : exp			(fn st=> [E exp st], V exp)
-	 | exp COMMA exp_list	(fn st=> E exp st :: E exp_list st,
-				 V exp \/ V exp_list)
+exp_list : exp                  (fn st=> [E exp st], V exp)
+         | exp COMMA exp_list   (fn st=> E exp st :: E exp_list st,
+                                 V exp \/ V exp_list)
 
-pat	: pat'			(pat')
-	| apat apats		(fn $ => make_app_pat(E apat $ ::E apats $),
-				 V apat \/ V apats)
+pat     : pat'                  (pat')
+        | apat apats            (fn $ => make_app_pat(E apat $ ::E apats $),
+                                 V apat \/ V apats)
 
-pat'	: pat AS pat		(fn $ => layered(E pat1 $, E pat2 $,
-						error(pat1left,pat1right)),
-				 V pat1 \/ V pat2)
-	| pat'' 		(pat'')
+pat'    : pat AS pat            (fn $ => layered(E pat1 $, E pat2 $,
+                                                error(pat1left,pat1right)),
+                                 V pat1 \/ V pat2)
+        | pat''                 (pat'')
 
-pat''	: apat apats 
-		COLON ty	(fn env => CONSTRAINTpat(
-					 make_app_pat(E apat env ::E apats env),
-					 E ty env),
-				 V apat \/ V apats \/ V ty)
-	| pat'' COLON ty	(fn env => CONSTRAINTpat(E pat'' env, E ty env),
-				 V pat'' \/ V ty)
+pat''   : apat apats 
+                COLON ty        (fn env => CONSTRAINTpat(
+                                         make_app_pat(E apat env ::E apats env),
+                                         E ty env),
+                                 V apat \/ V apats \/ V ty)
+        | pat'' COLON ty        (fn env => CONSTRAINTpat(E pat'' env, E ty env),
+                                 V pat'' \/ V ty)
 
-apat	: apat'			(apat')
-	| LPAREN pat RPAREN	(fn $ =>(E pat $,NONfix,error(LPARENleft,RPARENright)),
-				 V pat)
+apat    : apat'                 (apat')
+        | LPAREN pat RPAREN     (fn $ =>(E pat $,NONfix,error(LPARENleft,RPARENright)),
+                                 V pat)
 
-apat'	: apat''		(fn $ =>(E apat'' $,NONfix,error(apat''left,apat''right)),
-				 V apat'')
-	| id			(fn env  =>
-				 let val e = error(idleft,idright)
-				     val (v,f) = var'n'fix id
-				  in (pat_id env v, lookFIX env f, e)
-				 end,
-				 no_tyvars)
-	| LPAREN RPAREN		(fn _ =>(unitPat,NONfix,
-					error(LPARENleft,RPARENright)),
-				 no_tyvars)
-	| LPAREN pat COMMA 
-	      pat_list RPAREN	(fn $ =>(TUPLEpat(E pat $ ::E pat_list $),
-					 NONfix,error(LPARENleft,RPARENright)),
-				 V pat \/ V pat_list)
+apat'   : apat''                (fn $ =>(E apat'' $,NONfix,error(apat''left,apat''right)),
+                                 V apat'')
+        | id                    (fn env  =>
+                                 let val e = error(idleft,idright)
+                                     val (v,f) = var'n'fix id
+                                  in (pat_id env v, lookFIX env f, e)
+                                 end,
+                                 no_tyvars)
+        | LPAREN RPAREN         (fn _ =>(unitPat,NONfix,
+                                        error(LPARENleft,RPARENright)),
+                                 no_tyvars)
+        | LPAREN pat COMMA 
+              pat_list RPAREN   (fn $ =>(TUPLEpat(E pat $ ::E pat_list $),
+                                         NONfix,error(LPARENleft,RPARENright)),
+                                 V pat \/ V pat_list)
 
 
-apat''	: OP ident		(fn env =>pat_id env(varSymbol ident), no_tyvars)
-	| ID DOT qid		(fn env =>qid_pat env (strSymbol ID :: qid varSymbol,
-					               error(IDleft,qidright)),
-				 no_tyvars)
-	| int			(fn _ =>INTpat int, no_tyvars)
-	| REAL			(fn _ =>REALpat REAL, no_tyvars)
-	| STRING		(fn _ =>STRINGpat STRING, no_tyvars)
-	| WILD			(fn _ =>WILDpat, no_tyvars)
-	| LBRACKET RBRACKET	(fn _ =>LISTpat nil, no_tyvars)
-	| LBRACKET pat_list 
-		RBRACKET	(fn $ =>LISTpat(E pat_list $), V pat_list)
-	| LBRACE RBRACE		(fn _ =>makeRECORDpat((nil,false),
-						error(LBRACEleft,RBRACEright)),
-				 no_tyvars)
-	| LBRACE plabels RBRACE	(fn $ =>makeRECORDpat(E plabels $,
-						error(LBRACEleft,RBRACEright)),
-				 V plabels)
+apat''  : OP ident              (fn env =>pat_id env(varSymbol ident), no_tyvars)
+        | ID DOT qid            (fn env =>qid_pat env (strSymbol ID :: qid varSymbol,
+                                                       error(IDleft,qidright)),
+                                 no_tyvars)
+        | int                   (fn _ =>INTpat int, no_tyvars)
+        | REAL                  (fn _ =>REALpat REAL, no_tyvars)
+        | STRING                (fn _ =>STRINGpat STRING, no_tyvars)
+        | WILD                  (fn _ =>WILDpat, no_tyvars)
+        | LBRACKET RBRACKET     (fn _ =>LISTpat nil, no_tyvars)
+        | LBRACKET pat_list 
+                RBRACKET        (fn $ =>LISTpat(E pat_list $), V pat_list)
+        | LBRACE RBRACE         (fn _ =>makeRECORDpat((nil,false),
+                                                error(LBRACEleft,RBRACEright)),
+                                 no_tyvars)
+        | LBRACE plabels RBRACE (fn $ =>makeRECORDpat(E plabels $,
+                                                error(LBRACEleft,RBRACEright)),
+                                 V plabels)
 
-plabel	: selector EQUAL pat	(fn $ => (selector,E pat $), V pat)
-	| ID			(fn env => (labSymbol ID, pat_id env(varSymbol ID)), no_tyvars)
-	| ID AS pat		(fn env => (labSymbol ID, LAYEREDpat(pat_id env (varSymbol ID), 
-						E pat env)),
-				 V pat)
-	| ID COLON ty		(fn env => (labSymbol ID, CONSTRAINTpat(pat_id env (varSymbol ID), 
-							   E ty env)),
-				 V ty)
-	| ID COLON ty AS pat	(fn env => (labSymbol ID, LAYEREDpat(CONSTRAINTpat(
-					   pat_id env (varSymbol ID),
-					   E ty env), E pat env)),
-				 V ty \/ V pat)
+plabel  : selector EQUAL pat    (fn $ => (selector,E pat $), V pat)
+        | ID                    (fn env => (labSymbol ID, pat_id env(varSymbol ID)), no_tyvars)
+        | ID AS pat             (fn env => (labSymbol ID, LAYEREDpat(pat_id env (varSymbol ID), 
+                                                E pat env)),
+                                 V pat)
+        | ID COLON ty           (fn env => (labSymbol ID, CONSTRAINTpat(pat_id env (varSymbol ID), 
+                                                           E ty env)),
+                                 V ty)
+        | ID COLON ty AS pat    (fn env => (labSymbol ID, LAYEREDpat(CONSTRAINTpat(
+                                           pat_id env (varSymbol ID),
+                                           E ty env), E pat env)),
+                                 V ty \/ V pat)
 
 plabels : plabel COMMA
-	      plabels	(fn $ =>let val (a,(b,fx))=(E plabel $,E plabels $)
-				in (a::b, fx)
-			        end,
-			 V plabel \/ V plabels)
-	| plabel	(fn $ => ([E plabel $],false), V plabel)
-	| DOTDOTDOT	(fn _ => (nil, true), no_tyvars)
+              plabels   (fn $ =>let val (a,(b,fx))=(E plabel $,E plabels $)
+                                in (a::b, fx)
+                                end,
+                         V plabel \/ V plabels)
+        | plabel        (fn $ => ([E plabel $],false), V plabel)
+        | DOTDOTDOT     (fn _ => (nil, true), no_tyvars)
 
-pat_list: pat			(fn $ => [E pat $], V pat)
-	| pat COMMA pat_list	(fn $ => E pat $ :: E pat_list $,
-				 V pat \/ V pat_list)
+pat_list: pat                   (fn $ => [E pat $], V pat)
+        | pat COMMA pat_list    (fn $ => E pat $ :: E pat_list $,
+                                 V pat \/ V pat_list)
 
-vb	: vb AND vb		(fn st=> vb1 st @ vb2 st)
-	| pat EQUAL exp		(valbind(pat, exp))
+vb      : vb AND vb             (fn st=> vb1 st @ vb2 st)
+        | pat EQUAL exp         (valbind(pat, exp))
 
-constraint :	 		(fn _ =>NONE, no_tyvars)
-	   | COLON ty	 	(fn env =>SOME(E ty env), V ty)
+constraint :                    (fn _ =>NONE, no_tyvars)
+           | COLON ty           (fn env =>SOME(E ty env), V ty)
 
-rvb	: opid constraint 
-		EQUAL FN match	(fn env =>[{name=opid env,
-					 ty=constraint,match=match}])
-	| rvb AND rvb		(fn env => (rvb1 env) @ (rvb2 env))
+rvb     : opid constraint 
+                EQUAL FN match  (fn env =>[{name=opid env,
+                                         ty=constraint,match=match}])
+        | rvb AND rvb           (fn env => (rvb1 env) @ (rvb2 env))
 
-fb'	: clause		(fn $ =>[E clause $], V clause)
-	| clause BAR fb'	(fn $ =>E clause $ ::E fb' $, V clause \/ V fb')
+fb'     : clause                (fn $ =>[E clause $], V clause)
+        | clause BAR fb'        (fn $ =>E clause $ ::E fb' $, V clause \/ V fb')
 
-fb	: fb'			(fn $ => [checkFB(E fb' $,error(fb'left,fb'right))],
-				 V fb')
-	| fb' AND fb		(fn $ => 
-				 checkFB(E fb' $,error(fb'left,fb'right)) :: E fb $, V fb' \/ V fb)
+fb      : fb'                   (fn $ => [checkFB(E fb' $,error(fb'left,fb'right))],
+                                 V fb')
+        | fb' AND fb            (fn $ => 
+                                 checkFB(E fb' $,error(fb'left,fb'right)) :: E fb $, V fb' \/ V fb)
 
-clause'	: LPAREN apat apats 
-		RPAREN apats	(fn $ =>makecl(E apat $ ::E apats1 $,E apats2 $),
-				 V apat \/ V apats1 \/ V apats2)
-	| LPAREN pat' 
-		RPAREN apats	(fn $ =>makecl([],(E pat' $,NONfix,
-						 error(LPARENleft,RPARENright))
-						 ::E apats $),
-				 V pat' \/ V apats)
-	| apat' apats		(fn $ =>makecl([],E apat' $ ::E apats $),
-				 V apat' \/ V apats)
+clause' : LPAREN apat apats 
+                RPAREN apats    (fn $ =>makecl(E apat $ ::E apats1 $,E apats2 $),
+                                 V apat \/ V apats1 \/ V apats2)
+        | LPAREN pat' 
+                RPAREN apats    (fn $ =>makecl([],(E pat' $,NONfix,
+                                                 error(LPARENleft,RPARENright))
+                                                 ::E apats $),
+                                 V pat' \/ V apats)
+        | apat' apats           (fn $ =>makecl([],E apat' $ ::E apats $),
+                                 V apat' \/ V apats)
 
-apats	:			(fn _ =>nil, no_tyvars)
-	| apat apats		(fn $ => E apat $ ::E apats $, 
-			         V apat \/ V apats)
+apats   :                       (fn _ =>nil, no_tyvars)
+        | apat apats            (fn $ => E apat $ ::E apats $, 
+                                 V apat \/ V apats)
 
-clause	: clause' constraint
-		 EQUAL exp	(fn env =>
-				    let val (id,pats) = E clause' env
-				    in {name=id,pats=pats,
-					resultty=E constraint env,
-				   	exp=fn $ => markexp(E exp $,expleft,expright),
-					err=error(clause'left,clause'right)}
-				    end,
-				 V clause' \/ V constraint \/ V exp)
+clause  : clause' constraint
+                 EQUAL exp      (fn env =>
+                                    let val (id,pats) = E clause' env
+                                    in {name=id,pats=pats,
+                                        resultty=E constraint env,
+                                        exp=fn $ => markexp(E exp $,expleft,expright),
+                                        err=error(clause'left,clause'right)}
+                                    end,
+                                 V clause' \/ V constraint \/ V exp)
 
-tb	: tyvars ID EQUAL ty	(makeTB(tyvars, tycSymbol ID, ty,
-					error(tyleft,tyright)))
-	| tb AND tb		(fn nw => sequence(tb1 nw,tb2 nw))
+tb      : tyvars ID EQUAL ty    (makeTB(tyvars, tycSymbol ID, ty,
+                                        error(tyleft,tyright)))
+        | tb AND tb             (fn nw => sequence(tb1 nw,tb2 nw))
 
-tyvars	: TYVAR			  ([mkTyvar(mkUBOUND(tyvSymbol TYVAR))])
-	| LPAREN tyvar_pc RPAREN  (checkUniq(error(tyvar_pcleft,tyvar_pcright),
-				  	     "duplicate type variable")
-					     (List.map(fn ref(UBOUND{name,...})=>name)
-					      tyvar_pc);
-				   tyvar_pc)
-	|			  (nil)
+tyvars  : TYVAR                   ([mkTyvar(mkUBOUND(tyvSymbol TYVAR))])
+        | LPAREN tyvar_pc RPAREN  (checkUniq(error(tyvar_pcleft,tyvar_pcright),
+                                             "duplicate type variable")
+                                             (List.map(fn ref(UBOUND{name,...})=>name)
+                                              tyvar_pc);
+                                   tyvar_pc)
+        |                         (nil)
 
-tyvar_pc: TYVAR				([mkTyvar(mkUBOUND(tyvSymbol TYVAR))])
-	| TYVAR COMMA tyvar_pc		(mkTyvar(mkUBOUND(tyvSymbol TYVAR)) :: tyvar_pc)
+tyvar_pc: TYVAR                         ([mkTyvar(mkUBOUND(tyvSymbol TYVAR))])
+        | TYVAR COMMA tyvar_pc          (mkTyvar(mkUBOUND(tyvSymbol TYVAR)) :: tyvar_pc)
 
-db	: db AND db			(db1 @ db2)
-	| tyvars ident EQUAL constrs   (let val name = tycSymbol ident
-					 in [(name,length tyvars,
-					     makeDB'(tyvars,name,constrs,
-						error(constrsleft,constrsright)))]
-					end)
+db      : db AND db                     (db1 @ db2)
+        | tyvars ident EQUAL constrs   (let val name = tycSymbol ident
+                                         in [(name,length tyvars,
+                                             makeDB'(tyvars,name,constrs,
+                                                error(constrsleft,constrsright)))]
+                                        end)
 
-constrs : constr		(fn $ => [E constr $], V constr)
-	| constr BAR constrs	(fn $ => E constr $ :: E constrs $,
-				 V constr \/ V constrs)
+constrs : constr                (fn $ => [E constr $], V constr)
+        | constr BAR constrs    (fn $ => E constr $ :: E constrs $,
+                                 V constr \/ V constrs)
 
-constr	: op_op ident		(fire op_op (fn(_,t)=> (varSymbol ident,true,t)),
-				 no_tyvars)
-	| op_op ident OF ty	(fire op_op (fn(env,t)=> (varSymbol ident,false,
-					 CONty(arrowTycon,[E ty env, t]))),
-				 V ty)
+constr  : op_op ident           (fire op_op (fn(_,t)=> (varSymbol ident,true,t)),
+                                 no_tyvars)
+        | op_op ident OF ty     (fire op_op (fn(env,t)=> (varSymbol ident,false,
+                                         CONty(arrowTycon,[E ty env, t]))),
+                                 V ty)
 
-eb	: op_op ident			(fire op_op (makeEB(varSymbol ident)), no_tyvars)
-	| op_op ident OF ty		(fire op_op (makeEBof(varSymbol ident,E ty,
-					   error(tyleft,tyright))),
-					 V ty)
-	| op_op ident EQUAL qid		(fire op_op (makeEBeq(varSymbol ident,qid varSymbol,
-					   error(qidleft,qidright))),
-					 no_tyvars)
-	| eb AND eb			(sequence(E eb1,E eb2),
-					 V eb1 \/ V eb2)
+eb      : op_op ident                   (fire op_op (makeEB(varSymbol ident)), no_tyvars)
+        | op_op ident OF ty             (fire op_op (makeEBof(varSymbol ident,E ty,
+                                           error(tyleft,tyright))),
+                                         V ty)
+        | op_op ident EQUAL qid         (fire op_op (makeEBeq(varSymbol ident,qid varSymbol,
+                                           error(qidleft,qidright))),
+                                         no_tyvars)
+        | eb AND eb                     (sequence(E eb1,E eb2),
+                                         V eb1 \/ V eb2)
 
-qid_p0	: qid				([qid strSymbol])
-	| qid qid_p0			(qid strSymbol :: qid_p0)
+qid_p0  : qid                           ([qid strSymbol])
+        | qid qid_p0                    (qid strSymbol :: qid_p0)
 
-qid_p	: qid				(fn env => [getSTRpath env (qid strSymbol,error(qidleft,qidright))])
-	| qid qid_p			(fn env => getSTRpath env (qid strSymbol,error(qidleft,qidright)) :: qid_p env)
+qid_p   : qid                           (fn env => [getSTRpath env (qid strSymbol,error(qidleft,qidright))])
+        | qid qid_p                     (fn env => getSTRpath env (qid strSymbol,error(qidleft,qidright)) :: qid_p env)
 
-fixity	: INFIX				(infixleft 0)
-	| INFIX int			(infixleft int)
-	| INFIXR			(infixright 0)
-	| INFIXR int			(infixright int)
-	| NONFIX			(NONfix)
+fixity  : INFIX                         (infixleft 0)
+        | INFIX int                     (infixleft int)
+        | INFIXR                        (infixright 0)
+        | INFIXR int                    (infixright int)
+        | NONFIX                        (NONfix)
 
-ldec	: VAL vb		(makeVALdec(vb,error(vbleft,vbright)),
-				 no_tyvars)
-	| VAL REC rvb		(makeVALRECdec (rvb,error(rvbleft,rvbright)),
-				 no_tyvars)
-	| FUN fb		(makeFUNdec fb, no_tyvars)
-	| TYPE tb		((fn $ => makeTYPEdec(tb true $,
-						      error(tbleft,tbright))),
-				 no_tyvars)
-	| DATATYPE db		(makeDB(db, nullTB), no_tyvars)
- 	| DATATYPE db 
-		WITHTYPE tb	(makeDB(db,tb), no_tyvars)
-	| ABSTYPE db 
-		WITH ldecs END	(makeABSTYPEdec(db,nullTB,E ldecs),V ldecs)
-	| ABSTYPE db
-		WITHTYPE tb
-		WITH ldecs END  (makeABSTYPEdec(db,tb,E ldecs),V ldecs)
-	| EXCEPTION eb		((fn $ => makeEXCEPTIONdec(E eb $, 
-					          error(ebleft,ebright))),
-				 V eb)
-	| OPEN qid_p		(makeOPENdec qid_p, no_tyvars)
-	| fixity ops		(makeFIXdec(fixity,ops), no_tyvars)
-	| OVERLOAD ident COLON 
-		ty AS exp_pa	(makeOVERLOADdec(varSymbol ident,ty,exp_pa),
-				 no_tyvars)
+ldec    : VAL vb                (makeVALdec(vb,error(vbleft,vbright)),
+                                 no_tyvars)
+        | VAL REC rvb           (makeVALRECdec (rvb,error(rvbleft,rvbright)),
+                                 no_tyvars)
+        | FUN fb                (makeFUNdec fb, no_tyvars)
+        | TYPE tb               ((fn $ => makeTYPEdec(tb true $,
+                                                      error(tbleft,tbright))),
+                                 no_tyvars)
+        | DATATYPE db           (makeDB(db, nullTB), no_tyvars)
+        | DATATYPE db 
+                WITHTYPE tb     (makeDB(db,tb), no_tyvars)
+        | ABSTYPE db 
+                WITH ldecs END  (makeABSTYPEdec(db,nullTB,E ldecs),V ldecs)
+        | ABSTYPE db
+                WITHTYPE tb
+                WITH ldecs END  (makeABSTYPEdec(db,tb,E ldecs),V ldecs)
+        | EXCEPTION eb          ((fn $ => makeEXCEPTIONdec(E eb $, 
+                                                  error(ebleft,ebright))),
+                                 V eb)
+        | OPEN qid_p            (makeOPENdec qid_p, no_tyvars)
+        | fixity ops            (makeFIXdec(fixity,ops), no_tyvars)
+        | OVERLOAD ident COLON 
+                ty AS exp_pa    (makeOVERLOADdec(varSymbol ident,ty,exp_pa),
+                                 no_tyvars)
 
-exp_pa	: exp			(fn st => [E exp st])
-	| exp AND exp_pa	(fn st => E exp st :: exp_pa st)
+exp_pa  : exp                   (fn st => [E exp st])
+        | exp AND exp_pa        (fn st => E exp st :: exp_pa st)
 
-ldecs	: 			(fn $ => (SEQdec nil,Env.empty), no_tyvars)
-	| ldec ldecs		(makeSEQdec(fn $ => markdec(E ldec $,ldecleft,ldecright), 
-					    E ldecs),
-				 V ldec \/ V ldecs)
-	| SEMICOLON ldecs	(ldecs)
-	| LOCAL ldecs 
-	    IN ldecs END ldecs	(makeSEQdec(fn $ => 
-				   markdec(makeLOCALdec(E ldecs1,E ldecs2) $,
-				   	   	   LOCALleft,ENDright),
-				   E ldecs3),
-				   V ldecs1 \/ V ldecs2 \/ V ldecs3)
+ldecs   :                       (fn $ => (SEQdec nil,Env.empty), no_tyvars)
+        | ldec ldecs            (makeSEQdec(fn $ => markdec(E ldec $,ldecleft,ldecright), 
+                                            E ldecs),
+                                 V ldec \/ V ldecs)
+        | SEMICOLON ldecs       (ldecs)
+        | LOCAL ldecs 
+            IN ldecs END ldecs  (makeSEQdec(fn $ => 
+                                   markdec(makeLOCALdec(E ldecs1,E ldecs2) $,
+                                                   LOCALleft,ENDright),
+                                   E ldecs3),
+                                   V ldecs1 \/ V ldecs2 \/ V ldecs3)
 
-ops	: ident			([fixSymbol ident])
-	| ident ops 		(fixSymbol ident :: ops)
+ops     : ident                 ([fixSymbol ident])
+        | ident ops             (fixSymbol ident :: ops)
 
-spec_s	: 			(fn $ => nil)
-	| spec spec_s		(fn $ => spec $ @ spec_s $)
-	| SEMICOLON spec_s	(spec_s)
+spec_s  :                       (fn $ => nil)
+        | spec spec_s           (fn $ => spec $ @ spec_s $)
+        | SEMICOLON spec_s      (spec_s)
 
-spec	: STRUCTURE strspec	(strspec)
-	| DATATYPE db		(make_dtyspec db)
-	| TYPE tyspec		(tyspec UNDEF)
-	| EQTYPE tyspec		(tyspec YES)
-	| VAL valspec		(valspec)
-	| EXCEPTION exnspec	(exnspec)
-	| fixity ops		(make_fixityspec(fixity,ops))
-	| SHARING sharespec	(sharespec)
-	| OPEN qid_p0		(make_openspec(qid_p0,
-					       error(OPENleft,qid_p0right)))
-	| LOCAL spec_s 
-	    IN spec_s END	(fn $ => (spec_s1 $; 
-					  error(spec_s1left,spec_s1right) WARN
-				"LOCAL specs are only partially implemented";
-						spec_s2 $))
-	| INCLUDE ident		(make_includespec (sigSymbol ident,error(identleft,identright)))
+spec    : STRUCTURE strspec     (strspec)
+        | DATATYPE db           (make_dtyspec db)
+        | TYPE tyspec           (tyspec UNDEF)
+        | EQTYPE tyspec         (tyspec YES)
+        | VAL valspec           (valspec)
+        | EXCEPTION exnspec     (exnspec)
+        | fixity ops            (make_fixityspec(fixity,ops))
+        | SHARING sharespec     (sharespec)
+        | OPEN qid_p0           (make_openspec(qid_p0,
+                                               error(OPENleft,qid_p0right)))
+        | LOCAL spec_s 
+            IN spec_s END       (fn $ => (spec_s1 $; 
+                                          error(spec_s1left,spec_s1right) WARN
+                                "LOCAL specs are only partially implemented";
+                                                spec_s2 $))
+        | INCLUDE ident         (make_includespec (sigSymbol ident,error(identleft,identright)))
 
-strspec	: strspec AND strspec	(fn $ => strspec1 $ @ strspec2 $)
-	| ident COLON sign	(make_strspec(strSymbol ident, sign(false,false,NULLstr)))
+strspec : strspec AND strspec   (fn $ => strspec1 $ @ strspec2 $)
+        | ident COLON sign      (make_strspec(strSymbol ident, sign(false,false,NULLstr)))
 
-tyspec	: tyspec AND tyspec	(fn eq => fn $ => 
-				    tyspec1 eq $ @ tyspec2 eq $)
-	| tyvars ID		(fn eq => make_tyspec(eq,tyvars,tycSymbol ID,
-					error(tyvarsleft,IDright)))
+tyspec  : tyspec AND tyspec     (fn eq => fn $ => 
+                                    tyspec1 eq $ @ tyspec2 eq $)
+        | tyvars ID             (fn eq => make_tyspec(eq,tyvars,tycSymbol ID,
+                                        error(tyvarsleft,IDright)))
 
-valspec	: valspec AND valspec	(fn $ => valspec1 $ @ valspec2 $)
-	| op_op ident COLON ty	(fire op_op (make_valspec(varSymbol ident,ty)))
+valspec : valspec AND valspec   (fn $ => valspec1 $ @ valspec2 $)
+        | op_op ident COLON ty  (fire op_op (make_valspec(varSymbol ident,ty)))
 
-exnspec : exnspec AND exnspec	(fn $ => exnspec1 $ @ exnspec2 $)
-	| ident			(make_exnspec(varSymbol ident))
-	| ident OF ty		(make_exnspecOF (varSymbol ident,ty))
+exnspec : exnspec AND exnspec   (fn $ => exnspec1 $ @ exnspec2 $)
+        | ident                 (make_exnspec(varSymbol ident))
+        | ident OF ty           (make_exnspecOF (varSymbol ident,ty))
 
 sharespec: sharespec AND 
-		sharespec	(fn $ => sharespec1 $ @ sharespec2 $)
-	| TYPE patheqn		(make_type_sharespec(patheqn tycSymbol))
-	| patheqn		(make_str_sharespec(patheqn strSymbol))
-	
-patheqn:  qid EQUAL qid		(fn kind => [qid1 kind, qid2 kind])
-	| qid EQUAL patheqn	(fn kind => qid kind :: patheqn kind)
+                sharespec       (fn $ => sharespec1 $ @ sharespec2 $)
+        | TYPE patheqn          (make_type_sharespec(patheqn tycSymbol))
+        | patheqn               (make_str_sharespec(patheqn strSymbol))
+        
+patheqn:  qid EQUAL qid         (fn kind => [qid1 kind, qid2 kind])
+        | qid EQUAL patheqn     (fn kind => qid kind :: patheqn kind)
 
-sign	: ID			(makeSIGid(sigSymbol ID,error(IDleft,IDright)))
-	| SIG spec_s END	(makeSIG(spec_s,error(spec_sleft,spec_sright)))
+sign    : ID                    (makeSIGid(sigSymbol ID,error(IDleft,IDright)))
+        | SIG spec_s END        (makeSIG(spec_s,error(spec_sleft,spec_sright)))
 
-sigconstraint_op :		(fn _ => NONE)
-	| COLON sign		(fn (env,param) =>
-				  SOME(sign(true,false,param) (env,Stampset.newStampsets())))
+sigconstraint_op :              (fn _ => NONE)
+        | COLON sign            (fn (env,param) =>
+                                  SOME(sign(true,false,param) (env,Stampset.newStampsets())))
 
-sigb	: sigb AND sigb		(sequence'(sigb1,sigb2))
-	| ident EQUAL sign	(make_sigb(sigSymbol ident, sign(true,false,NULLstr)))
+sigb    : sigb AND sigb         (sequence'(sigb1,sigb2))
+        | ident EQUAL sign      (make_sigb(sigSymbol ident, sign(true,false,NULLstr)))
 
-str	: qid			(markstr(make_str_qid(qid strSymbol,
-						      error(qidleft,qidright)),qidleft,qidright))
-	| STRUCT sdecs END	(markstr(make_str_struct(sdecs,
-					    error(STRUCTleft,ENDright)),
-					 STRUCTleft,ENDright))
-	| ID LPAREN sdecs 
-			RPAREN	(markstr(make_str_app(fctSymbol ID,error(IDleft,IDright),
-				      (fn $ => let val (s,s')=spread_args sdecs $
-					        in (MARKstr(s,sdecsleft,sdecsright)
-							     ,s')
-					       end)),IDleft,RPARENright))
-	| ID LPAREN str RPAREN	(markstr(make_str_app(fctSymbol ID,error(IDleft,IDright),
-					     single_arg str),IDleft,RPARENright))
-	| LET sdecs IN str END	(markstr(make_str_let(sdecs,str),LETleft,ENDright))
+str     : qid                   (markstr(make_str_qid(qid strSymbol,
+                                                      error(qidleft,qidright)),qidleft,qidright))
+        | STRUCT sdecs END      (markstr(make_str_struct(sdecs,
+                                            error(STRUCTleft,ENDright)),
+                                         STRUCTleft,ENDright))
+        | ID LPAREN sdecs 
+                        RPAREN  (markstr(make_str_app(fctSymbol ID,error(IDleft,IDright),
+                                      (fn $ => let val (s,s')=spread_args sdecs $
+                                                in (MARKstr(s,sdecsleft,sdecsright)
+                                                             ,s')
+                                               end)),IDleft,RPARENright))
+        | ID LPAREN str RPAREN  (markstr(make_str_app(fctSymbol ID,error(IDleft,IDright),
+                                             single_arg str),IDleft,RPARENright))
+        | LET sdecs IN str END  (markstr(make_str_let(sdecs,str),LETleft,ENDright))
 
-sdecs	: sdec sdecs		(sequence(fn $ => markdec'(sdec $,sdecleft, 
+sdecs   : sdec sdecs            (sequence(fn $ => markdec'(sdec $,sdecleft, 
                                                                   sdecright),
-					  sdecs))
-	| SEMICOLON sdecs	(sdecs)
-	| LOCAL sdecs IN sdecs 
-		END sdecs 	(sequence(fn $ => markdec''(makeLOCALsdecs(sdecs1,sdecs2) $,LOCALleft,ENDright),
+                                          sdecs))
+        | SEMICOLON sdecs       (sdecs)
+        | LOCAL sdecs IN sdecs 
+                END sdecs       (sequence(fn $ => markdec''(makeLOCALsdecs(sdecs1,sdecs2) $,LOCALleft,ENDright),
                                         sdecs3))
-	|			(fn $ => (nil,Env.empty))
+        |                       (fn $ => (nil,Env.empty))
 
-sdecs'	: sdec sdecs'		(sequence(fn $ => markdec'(sdec $,sdecleft,sdecright),
-					  sdecs'))
-	| LOCAL sdecs IN sdecs 
-		END sdecs' 	(sequence(fn $ => 
-				     markdec''(makeLOCALsdecs(sdecs1,sdecs2) $,
-					      LOCALleft,ENDright),
+sdecs'  : sdec sdecs'           (sequence(fn $ => markdec'(sdec $,sdecleft,sdecright),
+                                          sdecs'))
+        | LOCAL sdecs IN sdecs 
+                END sdecs'      (sequence(fn $ => 
+                                     markdec''(makeLOCALsdecs(sdecs1,sdecs2) $,
+                                              LOCALleft,ENDright),
                                         sdecs'))
 
-	| LOCAL sdecs IN sdecs 
-		END	 	(fn $ => markdec''(makeLOCALsdecs(sdecs1,sdecs2) $,LOCALleft,ENDright))
+        | LOCAL sdecs IN sdecs 
+                END             (fn $ => markdec''(makeLOCALsdecs(sdecs1,sdecs2) $,LOCALleft,ENDright))
 
-	| sdec			(fn $ => seqdec(markdec(sdec $,sdecleft,sdecright)))
+        | sdec                  (fn $ => seqdec(markdec(sdec $,sdecleft,sdecright)))
 
-sdec	: STRUCTURE strb	(makeSTRBs(strb false))
-	| ABSTRACTION strb	(makeSTRBs(strb true))
-	| SIGNATURE sigb	(makeSIGdec(sigb,error(SIGNATUREleft,sigbright)))
-	| FUNCTOR fctb		(makeFCTdec(fctb,error(FUNCTORleft,fctbright)))
-	| ldec			(fn (env,pa,top,st) => 
-				   let val (dec,env') = markdec(E ldec(env,pa,no_tyvars,st),ldecleft,ldecright)
-			           in Typecheck.decType(Env.atop(env',env),dec,top,error,
-						       (ldecleft,ldecright));
-				      (dec,env')
-				   end)
+sdec    : STRUCTURE strb        (makeSTRBs(strb false))
+        | ABSTRACTION strb      (makeSTRBs(strb true))
+        | SIGNATURE sigb        (makeSIGdec(sigb,error(SIGNATUREleft,sigbright)))
+        | FUNCTOR fctb          (makeFCTdec(fctb,error(FUNCTORleft,fctbright)))
+        | ldec                  (fn (env,pa,top,st) => 
+                                   let val (dec,env') = markdec(E ldec(env,pa,no_tyvars,st),ldecleft,ldecright)
+                                   in Typecheck.decType(Env.atop(env',env),dec,top,error,
+                                                       (ldecleft,ldecright));
+                                      (dec,env')
+                                   end)
 
-strb	: ident sigconstraint_op 
-		EQUAL str	(makeSTRB(strSymbol ident,sigconstraint_op,str,
-				  error(sigconstraint_opleft,sigconstraint_opright)))
-	| strb AND strb		(fn a => fn $ => strb1 a $ @ strb2 a $)
+strb    : ident sigconstraint_op 
+                EQUAL str       (makeSTRB(strSymbol ident,sigconstraint_op,str,
+                                  error(sigconstraint_opleft,sigconstraint_opright)))
+        | strb AND strb         (fn a => fn $ => strb1 a $ @ strb2 a $)
 
-fparam	: ID COLON sign		(single_formal(strSymbol ID, sign(true,true,NULLstr)))
-	| spec_s		(spread_formal(spec_s,
-					       error(spec_sleft,spec_sright)))
+fparam  : ID COLON sign         (single_formal(strSymbol ID, sign(true,true,NULLstr)))
+        | spec_s                (spread_formal(spec_s,
+                                               error(spec_sleft,spec_sright)))
 
-fctb	: ident LPAREN fparam RPAREN
-	   sigconstraint_op EQUAL str	(makeFCTB(fctSymbol ident,fparam,
-						sigconstraint_op,str,
-						error(strleft,strright)))
-	| fctb AND fctb			(fn $ => fctb1 $ @ fctb2 $)
+fctb    : ident LPAREN fparam RPAREN
+           sigconstraint_op EQUAL str   (makeFCTB(fctSymbol ident,fparam,
+                                                sigconstraint_op,str,
+                                                error(strleft,strright)))
+        | fctb AND fctb                 (fn $ => fctb1 $ @ fctb2 $)
 
-importdec: STRING			([STRING])
-	| STRING importdec		(STRING :: importdec)
+importdec: STRING                       ([STRING])
+        | STRING importdec              (STRING :: importdec)
 
-interdec: sdecs'		(fn env=> let val (s,e)= sdecs'(env,[],true,Stampset.globalStamps)
-					  in markdec((SEQdec s,e),sdecs'left,sdecs'right)
-					  end)
-	| IMPORT importdec	(fn env =>(IMPORTdec importdec,env))
-	| exp		 	(fn env=>markdec(toplevelexp(env,exp,error,(expleft,expright)),
-					expleft,expright))
+interdec: sdecs'                (fn env=> let val (s,e)= sdecs'(env,[],true,Stampset.globalStamps)
+                                          in markdec((SEQdec s,e),sdecs'left,sdecs'right)
+                                          end)
+        | IMPORT importdec      (fn env =>(IMPORTdec importdec,env))
+        | exp                   (fn env=>markdec(toplevelexp(env,exp,error,(expleft,expright)),
+                                        expleft,expright))
 

Modified: mlton/branches/on-20050420-cmm-branch/benchmark/tests/DATA/ml.lex
===================================================================
--- mlton/branches/on-20050420-cmm-branch/benchmark/tests/DATA/ml.lex	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/benchmark/tests/DATA/ml.lex	2006-02-16 19:34:54 UTC (rev 4361)
@@ -4,27 +4,27 @@
 type pos = int
 type lexresult = (svalue,pos) Tokens.token
 type lexarg = {comLevel : int ref, 
-	       lineNum : int ref,
-	       linePos : int list ref, (* offsets of lines in file *)
-		charlist : string list ref,
-		stringstart : int ref, (* start of current string or comment*)
-	       err : pos*pos -> ErrorMsg.severity -> string->unit}
+               lineNum : int ref,
+               linePos : int list ref, (* offsets of lines in file *)
+                charlist : string list ref,
+                stringstart : int ref, (* start of current string or comment*)
+               err : pos*pos -> ErrorMsg.severity -> string->unit}
 type arg = lexarg
 type ('a,'b) token = ('a,'b) Tokens.token
 val eof = fn ({comLevel,err,linePos,stringstart,lineNum,charlist}:lexarg) => 
-	   let val pos = Integer.max(!stringstart+2, hd(!linePos))
-	    in if !comLevel>0 then err (!stringstart,pos) COMPLAIN
-					 "unclosed comment" 
-		  	      else ();
-	       Tokens.EOF(pos,pos)
-	   end	
+           let val pos = Integer.max(!stringstart+2, hd(!linePos))
+            in if !comLevel>0 then err (!stringstart,pos) COMPLAIN
+                                         "unclosed comment" 
+                              else ();
+               Tokens.EOF(pos,pos)
+           end  
 fun addString (charlist,s:string) = charlist := s :: (!charlist)
 fun makeString charlist = (implode(rev(!charlist)) before charlist := nil)
 fun makeHexInt sign s = let
       fun digit d = if (d < Ascii.uc_a) then (d - Ascii.zero)
-	    else (10 + (if (d < Ascii.lc_a) then (d - Ascii.uc_a) else (d - Ascii.lc_a)))
+            else (10 + (if (d < Ascii.lc_a) then (d - Ascii.uc_a) else (d - Ascii.lc_a)))
       in
-	revfold (fn (c,a) => sign(a*16, digit(ord c))) (explode s) 0
+        revfold (fn (c,a) => sign(a*16, digit(ord c))) (explode s) 0
       end
 fun makeInt sign s =
     revfold (fn (c,a) => sign(a*10, ord c - Ascii.zero)) (explode s) 0
@@ -42,132 +42,132 @@
 real=(~?)(({num}{frac}?{exp})|({num}{frac}{exp}?));
 hexnum=[0-9a-fA-F]+;
 %%
-<INITIAL>{ws}	=> (continue());
-<INITIAL>\n	=> (inc lineNum; linePos := yypos :: !linePos; continue());
-<INITIAL>"*"	=> (Tokens.ASTERISK(yypos,yypos+1));
-<INITIAL>"|"	=> (Tokens.BAR(yypos,yypos+1));
-<INITIAL>":"	=> (Tokens.COLON(yypos,yypos+1));
-<INITIAL>"="	=> (Tokens.EQUAL(yypos,yypos+1));
-<INITIAL>"_"	=> (Tokens.WILD(yypos,yypos+1));
-<INITIAL>"#"	=> (Tokens.HASH(yypos,yypos+1));
-<INITIAL>","	=> (Tokens.COMMA(yypos,yypos+1));
-<INITIAL>"{"	=> (Tokens.LBRACE(yypos,yypos+1));
-<INITIAL>"}"	=> (Tokens.RBRACE(yypos,yypos+1));
-<INITIAL>"["	=> (Tokens.LBRACKET(yypos,yypos+1));
-<INITIAL>"]"	=> (Tokens.RBRACKET(yypos,yypos+1));
-<INITIAL>";"	=> (Tokens.SEMICOLON(yypos,yypos+1));
-<INITIAL>"("	=> (Tokens.LPAREN(yypos,yypos+1));
-<INITIAL>")"	=> (Tokens.RPAREN(yypos,yypos+1));
-<INITIAL>"and"	=> (Tokens.AND(yypos,yypos+3));
-<INITIAL>"abstraction"	=> (Tokens.ABSTRACTION(yypos,yypos+11));
-<INITIAL>"abstype"	=> (Tokens.ABSTYPE(yypos,yypos+7));
-<INITIAL>"->"		=> (Tokens.ARROW(yypos,yypos+2));
-<INITIAL>"as"		=> (Tokens.AS(yypos,yypos+2));
-<INITIAL>"case"		=> (Tokens.CASE(yypos,yypos+4));
-<INITIAL>"datatype"	=> (Tokens.DATATYPE(yypos,yypos+8));
-<INITIAL>"."		=> (Tokens.DOT(yypos,yypos+1));
-<INITIAL>"..."		=> (Tokens.DOTDOTDOT(yypos,yypos+3));
-<INITIAL>"else"		=> (Tokens.ELSE(yypos,yypos+4));
-<INITIAL>"end"		=> (Tokens.END(yypos,yypos+3));
-<INITIAL>"eqtype"	=> (Tokens.EQTYPE(yypos,yypos+6));
-<INITIAL>"exception"	=> (Tokens.EXCEPTION(yypos,yypos+9));
-<INITIAL>"do"		=> (Tokens.DO(yypos,yypos+2));
-<INITIAL>"=>"		=> (Tokens.DARROW(yypos,yypos+2));
-<INITIAL>"fn"		=> (Tokens.FN(yypos,yypos+2));
-<INITIAL>"fun"		=> (Tokens.FUN(yypos,yypos+3));
-<INITIAL>"functor"	=> (Tokens.FUNCTOR(yypos,yypos+7));
-<INITIAL>"handle"	=> (Tokens.HANDLE(yypos,yypos+6));
-<INITIAL>"if"		=> (Tokens.IF(yypos,yypos+2));
-<INITIAL>"in"		=> (Tokens.IN(yypos,yypos+2));
-<INITIAL>"include"	=> (Tokens.INCLUDE(yypos,yypos+7));
-<INITIAL>"infix"	=> (Tokens.INFIX(yypos,yypos+5));
-<INITIAL>"infixr"	=> (Tokens.INFIXR(yypos,yypos+6));
-<INITIAL>"let"		=> (Tokens.LET(yypos,yypos+3));
-<INITIAL>"local"	=> (Tokens.LOCAL(yypos,yypos+5));
-<INITIAL>"nonfix"	=> (Tokens.NONFIX(yypos,yypos+6));
-<INITIAL>"of"		=> (Tokens.OF(yypos,yypos+2));
-<INITIAL>"op"		=> (Tokens.OP(yypos,yypos+2));
-<INITIAL>"open"		=> (Tokens.OPEN(yypos,yypos+4));
-<INITIAL>"overload"	=> (Tokens.OVERLOAD(yypos,yypos+8));
-<INITIAL>"raise"	=> (Tokens.RAISE(yypos,yypos+5));
-<INITIAL>"rec"		=> (Tokens.REC(yypos,yypos+3));
-<INITIAL>"sharing"	=> (Tokens.SHARING(yypos,yypos+7));
-<INITIAL>"sig"		=> (Tokens.SIG(yypos,yypos+3));
-<INITIAL>"signature"	=> (Tokens.SIGNATURE(yypos,yypos+9));
-<INITIAL>"struct"	=> (Tokens.STRUCT(yypos,yypos+6));
-<INITIAL>"structure"	=> (Tokens.STRUCTURE(yypos,yypos+9));
-<INITIAL>"then"		=> (Tokens.THEN(yypos,yypos+4));
-<INITIAL>"type"		=> (Tokens.TYPE(yypos,yypos+4));
-<INITIAL>"val"		=> (Tokens.VAL(yypos,yypos+3));
-<INITIAL>"while"	=> (Tokens.WHILE(yypos,yypos+5));
-<INITIAL>"with"		=> (Tokens.WITH(yypos,yypos+4));
-<INITIAL>"withtype"	=> (Tokens.WITHTYPE(yypos,yypos+8));
-<INITIAL>"orelse"	=> (Tokens.ORELSE(yypos,yypos+6));
-<INITIAL>"andalso"	=> (Tokens.ANDALSO(yypos,yypos+7));
-<INITIAL>"import"	=> (Tokens.IMPORT(yypos,yypos+6));
-<INITIAL>"'"{idchars}*	=> (Tokens.TYVAR(yytext, yypos, yypos+size yytext));
-<INITIAL>({sym}+|{id})	=> (Tokens.ID(yytext, yypos, yypos+size yytext));
-<INITIAL>{real}	=> (Tokens.REAL(yytext,yypos,yypos+size yytext));
+<INITIAL>{ws}   => (continue());
+<INITIAL>\n     => (inc lineNum; linePos := yypos :: !linePos; continue());
+<INITIAL>"*"    => (Tokens.ASTERISK(yypos,yypos+1));
+<INITIAL>"|"    => (Tokens.BAR(yypos,yypos+1));
+<INITIAL>":"    => (Tokens.COLON(yypos,yypos+1));
+<INITIAL>"="    => (Tokens.EQUAL(yypos,yypos+1));
+<INITIAL>"_"    => (Tokens.WILD(yypos,yypos+1));
+<INITIAL>"#"    => (Tokens.HASH(yypos,yypos+1));
+<INITIAL>","    => (Tokens.COMMA(yypos,yypos+1));
+<INITIAL>"{"    => (Tokens.LBRACE(yypos,yypos+1));
+<INITIAL>"}"    => (Tokens.RBRACE(yypos,yypos+1));
+<INITIAL>"["    => (Tokens.LBRACKET(yypos,yypos+1));
+<INITIAL>"]"    => (Tokens.RBRACKET(yypos,yypos+1));
+<INITIAL>";"    => (Tokens.SEMICOLON(yypos,yypos+1));
+<INITIAL>"("    => (Tokens.LPAREN(yypos,yypos+1));
+<INITIAL>")"    => (Tokens.RPAREN(yypos,yypos+1));
+<INITIAL>"and"  => (Tokens.AND(yypos,yypos+3));
+<INITIAL>"abstraction"  => (Tokens.ABSTRACTION(yypos,yypos+11));
+<INITIAL>"abstype"      => (Tokens.ABSTYPE(yypos,yypos+7));
+<INITIAL>"->"           => (Tokens.ARROW(yypos,yypos+2));
+<INITIAL>"as"           => (Tokens.AS(yypos,yypos+2));
+<INITIAL>"case"         => (Tokens.CASE(yypos,yypos+4));
+<INITIAL>"datatype"     => (Tokens.DATATYPE(yypos,yypos+8));
+<INITIAL>"."            => (Tokens.DOT(yypos,yypos+1));
+<INITIAL>"..."          => (Tokens.DOTDOTDOT(yypos,yypos+3));
+<INITIAL>"else"         => (Tokens.ELSE(yypos,yypos+4));
+<INITIAL>"end"          => (Tokens.END(yypos,yypos+3));
+<INITIAL>"eqtype"       => (Tokens.EQTYPE(yypos,yypos+6));
+<INITIAL>"exception"    => (Tokens.EXCEPTION(yypos,yypos+9));
+<INITIAL>"do"           => (Tokens.DO(yypos,yypos+2));
+<INITIAL>"=>"           => (Tokens.DARROW(yypos,yypos+2));
+<INITIAL>"fn"           => (Tokens.FN(yypos,yypos+2));
+<INITIAL>"fun"          => (Tokens.FUN(yypos,yypos+3));
+<INITIAL>"functor"      => (Tokens.FUNCTOR(yypos,yypos+7));
+<INITIAL>"handle"       => (Tokens.HANDLE(yypos,yypos+6));
+<INITIAL>"if"           => (Tokens.IF(yypos,yypos+2));
+<INITIAL>"in"           => (Tokens.IN(yypos,yypos+2));
+<INITIAL>"include"      => (Tokens.INCLUDE(yypos,yypos+7));
+<INITIAL>"infix"        => (Tokens.INFIX(yypos,yypos+5));
+<INITIAL>"infixr"       => (Tokens.INFIXR(yypos,yypos+6));
+<INITIAL>"let"          => (Tokens.LET(yypos,yypos+3));
+<INITIAL>"local"        => (Tokens.LOCAL(yypos,yypos+5));
+<INITIAL>"nonfix"       => (Tokens.NONFIX(yypos,yypos+6));
+<INITIAL>"of"           => (Tokens.OF(yypos,yypos+2));
+<INITIAL>"op"           => (Tokens.OP(yypos,yypos+2));
+<INITIAL>"open"         => (Tokens.OPEN(yypos,yypos+4));
+<INITIAL>"overload"     => (Tokens.OVERLOAD(yypos,yypos+8));
+<INITIAL>"raise"        => (Tokens.RAISE(yypos,yypos+5));
+<INITIAL>"rec"          => (Tokens.REC(yypos,yypos+3));
+<INITIAL>"sharing"      => (Tokens.SHARING(yypos,yypos+7));
+<INITIAL>"sig"          => (Tokens.SIG(yypos,yypos+3));
+<INITIAL>"signature"    => (Tokens.SIGNATURE(yypos,yypos+9));
+<INITIAL>"struct"       => (Tokens.STRUCT(yypos,yypos+6));
+<INITIAL>"structure"    => (Tokens.STRUCTURE(yypos,yypos+9));
+<INITIAL>"then"         => (Tokens.THEN(yypos,yypos+4));
+<INITIAL>"type"         => (Tokens.TYPE(yypos,yypos+4));
+<INITIAL>"val"          => (Tokens.VAL(yypos,yypos+3));
+<INITIAL>"while"        => (Tokens.WHILE(yypos,yypos+5));
+<INITIAL>"with"         => (Tokens.WITH(yypos,yypos+4));
+<INITIAL>"withtype"     => (Tokens.WITHTYPE(yypos,yypos+8));
+<INITIAL>"orelse"       => (Tokens.ORELSE(yypos,yypos+6));
+<INITIAL>"andalso"      => (Tokens.ANDALSO(yypos,yypos+7));
+<INITIAL>"import"       => (Tokens.IMPORT(yypos,yypos+6));
+<INITIAL>"'"{idchars}*  => (Tokens.TYVAR(yytext, yypos, yypos+size yytext));
+<INITIAL>({sym}+|{id})  => (Tokens.ID(yytext, yypos, yypos+size yytext));
+<INITIAL>{real} => (Tokens.REAL(yytext,yypos,yypos+size yytext));
 <INITIAL>[1-9][0-9]* => (Tokens.INT(makeInt (op +) yytext
-		    handle Overflow => (err (yypos,yypos+size yytext)
-					  COMPLAIN "integer too large"; 1),
-			yypos,yypos+size yytext));
-<INITIAL>{num}	=> (Tokens.INT0(makeInt (op +) yytext
-		    handle Overflow => (err (yypos,yypos+size yytext)
-					  COMPLAIN "integer too large"; 0),
-			yypos,yypos+size yytext));
-<INITIAL>~{num}	=> (Tokens.INT0(makeInt (op -)
-					(substring(yytext,1,size(yytext)-1))
-		    handle Overflow => (err (yypos,yypos+size yytext)
-					 COMPLAIN "integer too large"; 0),
-			yypos,yypos+size yytext));
+                    handle Overflow => (err (yypos,yypos+size yytext)
+                                          COMPLAIN "integer too large"; 1),
+                        yypos,yypos+size yytext));
+<INITIAL>{num}  => (Tokens.INT0(makeInt (op +) yytext
+                    handle Overflow => (err (yypos,yypos+size yytext)
+                                          COMPLAIN "integer too large"; 0),
+                        yypos,yypos+size yytext));
+<INITIAL>~{num} => (Tokens.INT0(makeInt (op -)
+                                        (substring(yytext,1,size(yytext)-1))
+                    handle Overflow => (err (yypos,yypos+size yytext)
+                                         COMPLAIN "integer too large"; 0),
+                        yypos,yypos+size yytext));
 <INITIAL>"0x"{hexnum} => (
-		    Tokens.INT0(makeHexInt (op +) (substring(yytext, 2, size(yytext)-2))
-		        handle Overflow => (err (yypos,yypos+size yytext)
-					    COMPLAIN "integer too large"; 0),
-		      yypos, yypos+size yytext));
+                    Tokens.INT0(makeHexInt (op +) (substring(yytext, 2, size(yytext)-2))
+                        handle Overflow => (err (yypos,yypos+size yytext)
+                                            COMPLAIN "integer too large"; 0),
+                      yypos, yypos+size yytext));
 <INITIAL>"~0x"{hexnum} => (
-		    Tokens.INT0(makeHexInt (op -) (substring(yytext, 3, size(yytext)-3))
-		        handle Overflow => (err (yypos,yypos+size yytext)
-					    COMPLAIN "integer too large"; 0),
-		      yypos, yypos+size yytext));
-<INITIAL>\"	=> (charlist := [""]; stringstart := yypos;
-			YYBEGIN S; continue());
-<INITIAL>"(*"	=> (YYBEGIN A; stringstart := yypos; comLevel := 1; continue());
-<INITIAL>\h	=> (err (yypos,yypos) COMPLAIN "non-Ascii character"; continue());
-<INITIAL>.	=> (err (yypos,yypos) COMPLAIN "illegal token"; continue());
-<A>"(*"		=> (inc comLevel; continue());
-<A>\n		=> (inc lineNum; linePos := yypos :: !linePos; continue());
+                    Tokens.INT0(makeHexInt (op -) (substring(yytext, 3, size(yytext)-3))
+                        handle Overflow => (err (yypos,yypos+size yytext)
+                                            COMPLAIN "integer too large"; 0),
+                      yypos, yypos+size yytext));
+<INITIAL>\"     => (charlist := [""]; stringstart := yypos;
+                        YYBEGIN S; continue());
+<INITIAL>"(*"   => (YYBEGIN A; stringstart := yypos; comLevel := 1; continue());
+<INITIAL>\h     => (err (yypos,yypos) COMPLAIN "non-Ascii character"; continue());
+<INITIAL>.      => (err (yypos,yypos) COMPLAIN "illegal token"; continue());
+<A>"(*"         => (inc comLevel; continue());
+<A>\n           => (inc lineNum; linePos := yypos :: !linePos; continue());
 <A>"*)" => (dec comLevel; if !comLevel=0 then YYBEGIN INITIAL else (); continue());
-<A>.		=> (continue());
-<S>\"	        => (YYBEGIN INITIAL; Tokens.STRING(makeString charlist,
-				!stringstart,yypos+1));
-<S>\n		=> (err (!stringstart,yypos) COMPLAIN "unclosed string";
-		    inc lineNum; linePos := yypos :: !linePos;
-		    YYBEGIN INITIAL; Tokens.STRING(makeString charlist,!stringstart,yypos));
-<S>[^"\\\n]*	=> (addString(charlist,yytext); continue());
-<S>\\\n	       	=> (inc lineNum; linePos := yypos :: !linePos;
-		    YYBEGIN F; continue());
-<S>\\[\ \t]   	=> (YYBEGIN F; continue());
-<F>\n		=> (inc lineNum; linePos := yypos :: !linePos; continue());
-<F>{ws}		=> (continue());
-<F>\\		=> (YYBEGIN S; stringstart := yypos; continue());
-<F>.		=> (err (!stringstart,yypos) COMPLAIN "unclosed string"; 
-		    YYBEGIN INITIAL; Tokens.STRING(makeString charlist,!stringstart,yypos+1));
-<S>\\t		=> (addString(charlist,"\t"); continue());
-<S>\\n		=> (addString(charlist,"\n"); continue());
-<S>\\\\		=> (addString(charlist,"\\"); continue());
-<S>\\\"		=> (addString(charlist,chr(Ascii.dquote)); continue());
-<S>\\\^[@-_]	=> (addString(charlist,chr(ordof(yytext,2)-ord("@"))); continue());
-<S>\\[0-9]{3}	=>
+<A>.            => (continue());
+<S>\"           => (YYBEGIN INITIAL; Tokens.STRING(makeString charlist,
+                                !stringstart,yypos+1));
+<S>\n           => (err (!stringstart,yypos) COMPLAIN "unclosed string";
+                    inc lineNum; linePos := yypos :: !linePos;
+                    YYBEGIN INITIAL; Tokens.STRING(makeString charlist,!stringstart,yypos));
+<S>[^"\\\n]*    => (addString(charlist,yytext); continue());
+<S>\\\n         => (inc lineNum; linePos := yypos :: !linePos;
+                    YYBEGIN F; continue());
+<S>\\[\ \t]     => (YYBEGIN F; continue());
+<F>\n           => (inc lineNum; linePos := yypos :: !linePos; continue());
+<F>{ws}         => (continue());
+<F>\\           => (YYBEGIN S; stringstart := yypos; continue());
+<F>.            => (err (!stringstart,yypos) COMPLAIN "unclosed string"; 
+                    YYBEGIN INITIAL; Tokens.STRING(makeString charlist,!stringstart,yypos+1));
+<S>\\t          => (addString(charlist,"\t"); continue());
+<S>\\n          => (addString(charlist,"\n"); continue());
+<S>\\\\         => (addString(charlist,"\\"); continue());
+<S>\\\"         => (addString(charlist,chr(Ascii.dquote)); continue());
+<S>\\\^[@-_]    => (addString(charlist,chr(ordof(yytext,2)-ord("@"))); continue());
+<S>\\[0-9]{3}   =>
  (let val x = ordof(yytext,1)*100
-	     +ordof(yytext,2)*10
-	     +ordof(yytext,3)
-	     -(Ascii.zero*111)
+             +ordof(yytext,2)*10
+             +ordof(yytext,3)
+             -(Ascii.zero*111)
   in (if x>255
       then err (yypos,yypos+4) COMPLAIN "illegal ascii escape"
       else addString(charlist,chr x);
       continue())
   end);
-<S>\\		=> (err (yypos,yypos+1) COMPLAIN "illegal string escape"; 
-		    continue());
+<S>\\           => (err (yypos,yypos+1) COMPLAIN "illegal string escape"; 
+                    continue());

Modified: mlton/branches/on-20050420-cmm-branch/benchmark/tests/DLXSimulator.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/benchmark/tests/DLXSimulator.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/benchmark/tests/DLXSimulator.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -106,10 +106,10 @@
    (* From page 284 of Numerical Recipes in C. *)
    fun rand (): word =
       let
-	 val res = 0w1664525 * !seed + 0w1013904223
-	 val _ = seed := res
+         val res = 0w1664525 * !seed + 0w1013904223
+         val _ = seed := res
       in
-	 res
+         res
       end
 end
 
@@ -144,7 +144,7 @@
 signature IMMARRAY
   = sig
       type 'a immarray;
-	
+        
       val maxLen : int;
       val immarray : (int * 'a) -> 'a immarray;
       val fromList : 'a list -> 'a immarray;
@@ -152,13 +152,13 @@
   
       val tabulate : int * (int -> 'a) -> 'a immarray;
       val length : 'a immarray -> int;
-	
+        
       val sub : 'a immarray * int -> 'a;
       val update : 'a immarray * int * 'a -> 'a immarray;
       val extract : 'a immarray * int * int option -> 'a immarray;
 
       val copy : {src : 'a immarray, si : int, len : int option, 
-		  dst : 'a immarray, di : int} -> 'a immarray;
+                  dst : 'a immarray, di : int} -> 'a immarray;
 
       val appi : (int * 'a -> unit) -> ('a immarray * int * int option) 
                  -> unit;
@@ -170,7 +170,7 @@
       val foldl : (('a * 'b) -> 'b) -> 'b -> 'a immarray -> 'b;
       val foldr : (('a * 'b) -> 'b) -> 'b -> 'a immarray -> 'b;
       val mapi : ((int * 'a) -> 'b) -> ('a immarray * int * int option)
-	         ->  'b immarray;
+                 ->  'b immarray;
       val map : ('a -> 'b) -> 'a immarray -> 'b immarray;
       val modifyi : ((int * 'a) -> 'a) -> ('a immarray * int * int option) 
                     -> 'a immarray;
@@ -187,7 +187,7 @@
        * treating immarray type as a list.
        *)
       datatype 'a immarray = IA of 'a list;
-	
+        
       (* val maxLen : int
        * The maximum length of immarrays supported.
        * Technically, under this implementation, the maximum length
@@ -212,15 +212,15 @@
       fun fromList l = IA l;
       fun toList (IA ia) = ia;
       fun length (IA ia) = List.length ia;
-	
+        
       (* val sub : 'a immarray * int -> 'a
        * val update : 'a immarray * int * 'a -> 'a immarray
        * These functions sub and update an immarray by index.
        *)
       fun sub (IA ia, i) = List.nth (ia, i);
       fun update (IA ia, i, x) = IA ((List.take (ia, i)) @ 
-				     (x::(List.drop (ia, i + 1))));
-	
+                                     (x::(List.drop (ia, i + 1))));
+        
       (* val extract : 'a immarray * int * int option -> 'a immarray
        * This function extracts an immarray slice from an immarray from
        * one index either through the rest of the immarray (NONE)
@@ -228,24 +228,24 @@
        * Standard ML Basis Library.
        *)
       fun extract (IA ia, i, NONE) = IA (List.drop (ia, i))
-	| extract (IA ia, i, SOME n) = IA (List.take (List.drop (ia, i), n));
-	
+        | extract (IA ia, i, SOME n) = IA (List.take (List.drop (ia, i), n));
+        
       (* val copy : {src : 'a immarray, si : int, len : int option, 
                      dst : 'a immarray, di : int} -> 'a immarray
        * This function copies an immarray slice from src into dst starting
        * at the di element.
        *)
       fun copy {src, si, len, dst=IA ia, di} 
-	= let
-	    val IA sia = extract (src, si, len);
-	    val pre = List.take (ia, di);
-	    val post = case len 
-			 of NONE => List.drop (ia, di+(List.length sia))
-			  | SOME n => List.drop (ia, di+n);
-	  in 
-	    IA (pre @ sia @ post)
-	  end;
-					   
+        = let
+            val IA sia = extract (src, si, len);
+            val pre = List.take (ia, di);
+            val post = case len 
+                         of NONE => List.drop (ia, di+(List.length sia))
+                          | SOME n => List.drop (ia, di+n);
+          in 
+            IA (pre @ sia @ post)
+          end;
+                                           
       (* val appi : ('a * int -> unit) -> ('a immarray * int * int option) 
        *            -> unit
        * val app : ('a -> unit) -> 'a immarray -> unit
@@ -255,14 +255,14 @@
        * and uses an immarray slice argument.
        *)
       local
-	fun appi_aux f i [] = ()
-	  | appi_aux f i (h::t) = (f(i,h); appi_aux f (i + 1) t);
+        fun appi_aux f i [] = ()
+          | appi_aux f i (h::t) = (f(i,h); appi_aux f (i + 1) t);
       in
-	fun appi f (IA ia, i, len) = let 
-				       val IA sia = extract (IA ia, i, len);
-				     in 
-				       appi_aux f i sia
-				     end;
+        fun appi f (IA ia, i, len) = let 
+                                       val IA sia = extract (IA ia, i, len);
+                                     in 
+                                       appi_aux f i sia
+                                     end;
       end;
       fun app f immarr = appi (f o #2) (immarr, 0, NONE);
 
@@ -278,23 +278,23 @@
        * and uses an immarray slice argument.
        *)
       local 
-	fun foldli_aux f b i [] = b
-	  | foldli_aux f b i (h::t) = foldli_aux f (f(i,h,b)) (i+1) t;
-	fun foldri_aux f b i [] = b
-	  | foldri_aux f b i (h::t) = f(i,h,foldri_aux f b (i+1) t);
+        fun foldli_aux f b i [] = b
+          | foldli_aux f b i (h::t) = foldli_aux f (f(i,h,b)) (i+1) t;
+        fun foldri_aux f b i [] = b
+          | foldri_aux f b i (h::t) = f(i,h,foldri_aux f b (i+1) t);
       in
-	fun foldli f b (IA ia, i, len) 
-	  = let 
-	      val IA ia2 = extract (IA ia, i, len);
-	    in 
-	      foldli_aux f b i ia2
-	    end;
-	fun foldri f b (IA ia, i, len) 
-	  = let
-	      val IA ia2 = extract (IA ia, i, len);
-	    in 
-	      foldri_aux f b i ia2
-	    end;
+        fun foldli f b (IA ia, i, len) 
+          = let 
+              val IA ia2 = extract (IA ia, i, len);
+            in 
+              foldli_aux f b i ia2
+            end;
+        fun foldri f b (IA ia, i, len) 
+          = let
+              val IA ia2 = extract (IA ia, i, len);
+            in 
+              foldri_aux f b i ia2
+            end;
       end;
       fun foldl f b (IA ia) = foldli (fn (_,i,x) => f(i,x)) b (IA ia, 0, NONE);
       fun foldr f b (IA ia) = foldri (fn (_,i,x) => f(i,x)) b (IA ia, 0, NONE);
@@ -312,14 +312,14 @@
        * function reduces to the extract function. 
        *)
       local
-	fun mapi_aux f i [] = []
-	  | mapi_aux f i (h::t) = (f (i,h))::(mapi_aux f (i + 1) t);
+        fun mapi_aux f i [] = []
+          | mapi_aux f i (h::t) = (f (i,h))::(mapi_aux f (i + 1) t);
       in
-	fun mapi f (IA ia, i, len) = let 
-				       val IA ia2 = extract (IA ia, i, len);
-				     in 
-				       IA (mapi_aux f i ia2)
-				     end;
+        fun mapi f (IA ia, i, len) = let 
+                                       val IA ia2 = extract (IA ia, i, len);
+                                     in 
+                                       IA (mapi_aux f i ia2)
+                                     end;
       end;
       fun map f (IA ia)= mapi (f o #2) (IA ia, 0, NONE);
 
@@ -333,19 +333,19 @@
        * to the mapped function and uses an immarray slice argument.
        *)
       local
-	fun modifyi_aux f i [] = []
-	  | modifyi_aux f i (h::t) = (f (i,h))::(modifyi_aux f (i + 1) t);
+        fun modifyi_aux f i [] = []
+          | modifyi_aux f i (h::t) = (f (i,h))::(modifyi_aux f (i + 1) t);
       in
-	fun modifyi f (IA ia, i, len)
-	  = let
-	      val pre = List.take (ia, i);
-	      val IA ia2 = extract (IA ia, i, len);
-	      val post = case len 
-			   of NONE => []
-			    | SOME n => List.drop (ia, i+n);
-	    in
-	      IA (pre @ (modifyi_aux f i ia2) @ post)
-	    end;
+        fun modifyi f (IA ia, i, len)
+          = let
+              val pre = List.take (ia, i);
+              val IA ia2 = extract (IA ia, i, len);
+              val post = case len 
+                           of NONE => []
+                            | SOME n => List.drop (ia, i+n);
+            in
+              IA (pre @ (modifyi_aux f i ia2) @ post)
+            end;
       end;
       fun modify f (IA ia) = modifyi (f o #2) (IA ia, 0, NONE);
 
@@ -390,7 +390,7 @@
       val update : 'a immarray2 * int * int * 'a -> 'a immarray2;
       val extract : 'a immarray2 * int * int * int option * int option 
                     -> 'a immarray2;
-		    
+                    
       val copy : {src : 'a immarray2, si : int, sj : int,
                   ilen : int option, jlen : int option,
                   dst : 'a immarray2, di : int, dj : int} -> 'a immarray2;
@@ -414,7 +414,7 @@
       val foldr : traversal -> (('a * 'b) -> 'b) -> 'b -> 'a immarray2 -> 'b
       val mapi : traversal -> (int * int * 'a -> 'b) 
                  -> ('a immarray2 * int * int * int option * int option) 
-	         -> 'b immarray2;
+                 -> 'b immarray2;
       val map : traversal -> ('a -> 'b) -> 'a immarray2 -> 'b immarray2;
       val modifyi : traversal -> ((int * int * 'a) -> 'a) 
                     -> ('a immarray2 * int * int * int option * int option) 
@@ -450,29 +450,29 @@
        * The dimensions function returns the dimensions of an immarray2.
        *)
       fun tabulate RowMajor (r, c, initfn)
-	= let 
-	    fun initrow r = ImmArray.tabulate (c, fn ic => initfn (r,ic));  
-	  in
-	    IA2 (ImmArray.tabulate (r, fn ir => initrow ir))
-	  end
-	| tabulate ColMajor (r, c, initfn)
-	  = turn (tabulate RowMajor (c,r, fn (c,r) => initfn(r,c)))
+        = let 
+            fun initrow r = ImmArray.tabulate (c, fn ic => initfn (r,ic));  
+          in
+            IA2 (ImmArray.tabulate (r, fn ir => initrow ir))
+          end
+        | tabulate ColMajor (r, c, initfn)
+          = turn (tabulate RowMajor (c,r, fn (c,r) => initfn(r,c)))
       and immarray2 (r, c, init) = tabulate RowMajor (r, c, fn (_, _) => init)
       and fromList l 
-	= IA2 (ImmArray.tabulate (length l, 
-				  fn ir => ImmArray.fromList (List.nth(l,ir))))
+        = IA2 (ImmArray.tabulate (length l, 
+                                  fn ir => ImmArray.fromList (List.nth(l,ir))))
       and dimensions (IA2 ia2) = (ImmArray.length ia2, 
-				  ImmArray.length (ImmArray.sub (ia2, 0)))
+                                  ImmArray.length (ImmArray.sub (ia2, 0)))
 
       (* turn : 'a immarray2 -> 'a immarray2
        * This function reverses the rows and columns of an immarray2
        * to allow handling of ColMajor traversals.
        *)
       and turn ia2 = let
-		       val (r,c) = dimensions ia2;
-		     in 
-		       tabulate RowMajor (c,r,fn (cc,rr) => sub (ia2,rr,cc))
-		     end
+                       val (r,c) = dimensions ia2;
+                     in 
+                       tabulate RowMajor (c,r,fn (cc,rr) => sub (ia2,rr,cc))
+                     end
 
       (* val sub : 'a immarray2 * int * int -> 'a
        * val update : 'a immarray2 * int * int * 'a -> 'a immarray2
@@ -480,9 +480,9 @@
        *)
       and sub (IA2 ia2, r, c) = ImmArray.sub(ImmArray.sub (ia2, r), c);
       fun update (IA2 ia2, r, c, x)
-	  = IA2 (ImmArray.update (ia2, r, 
-				  ImmArray.update (ImmArray.sub (ia2, r), 
-						   c, x)));	  
+          = IA2 (ImmArray.update (ia2, r, 
+                                  ImmArray.update (ImmArray.sub (ia2, r), 
+                                                   c, x)));       
 
       (* val extract : 'a immarray2 * int * int * 
        *               int option * int option -> 'a immarray2
@@ -491,9 +491,9 @@
        * immarray2 (NONE, NONE) or for the specfied number of elements.
        *)
       fun extract (IA2 ia2, i, j, rlen, clen)
-	  = IA2 (ImmArray.map (fn ia => ImmArray.extract (ia, j, clen))
-		              (ImmArray.extract (ia2, i, rlen)));
-	
+          = IA2 (ImmArray.map (fn ia => ImmArray.extract (ia, j, clen))
+                              (ImmArray.extract (ia2, i, rlen)));
+        
       (* val nRows : 'a immarray2 -> int
        * val nCols : 'a immarray2 -> int
        * These functions return specific dimensions of an immarray2.
@@ -507,15 +507,15 @@
        * an ImmArray.immarray.
        *)
       fun row (ia2, r) = let
-			   val (c, _) = dimensions ia2;
-			 in
-			   ImmArray.tabulate (c, fn i => sub (ia2, r, i))
-			 end;
+                           val (c, _) = dimensions ia2;
+                         in
+                           ImmArray.tabulate (c, fn i => sub (ia2, r, i))
+                         end;
       fun column (ia2, c) = let
-			      val (_, r) = dimensions ia2;
-			    in
-			      ImmArray.tabulate (r, fn i => sub (ia2, i, c))
-			    end;
+                              val (_, r) = dimensions ia2;
+                            in
+                              ImmArray.tabulate (r, fn i => sub (ia2, i, c))
+                            end;
 
       (* val copy : {src : 'a immarray2, si : int, sj : int,
        *             ilen : int option, jlen : int option,
@@ -524,17 +524,17 @@
        * at the di,dj element.
        *)
       fun copy {src, si, sj, ilen, jlen, dst=IA2 ia2, di, dj}
-	= let
-	    val nilen = case ilen 
-			  of NONE => SOME ((nRows src) - si)
-			   | SOME n => SOME n;
-	  in 
-	    IA2 (ImmArray.modifyi (fn (r, ia) 
-				   => ImmArray.copy {src=row (src, si+r-di),
-						     si=sj, len=jlen, 
-						     dst=ia, di=dj}) 
-		                  (ia2, di, nilen))
-	  end;
+        = let
+            val nilen = case ilen 
+                          of NONE => SOME ((nRows src) - si)
+                           | SOME n => SOME n;
+          in 
+            IA2 (ImmArray.modifyi (fn (r, ia) 
+                                   => ImmArray.copy {src=row (src, si+r-di),
+                                                     si=sj, len=jlen, 
+                                                     dst=ia, di=dj}) 
+                                  (ia2, di, nilen))
+          end;
 
       (* val appi : traversal -> ('a * int * int -> unit) -> 'a immarray2 
        *            -> unit
@@ -545,11 +545,11 @@
        * and uses an immarray2 slice argument.
        *)
       fun appi RowMajor f (IA2 ia2, i, j, rlen, clen)
-	= ImmArray.appi (fn (r,ia) => ImmArray.appi (fn (c,x) => f(r,c,x))
-			                            (ia, j, clen))
-	                (ia2, i, rlen)
-	| appi ColMajor f (ia2, i, j, rlen, clen)
-	= appi RowMajor (fn (c,r,x) => f(r,c,x)) (turn ia2, j, i, clen, rlen); 
+        = ImmArray.appi (fn (r,ia) => ImmArray.appi (fn (c,x) => f(r,c,x))
+                                                    (ia, j, clen))
+                        (ia2, i, rlen)
+        | appi ColMajor f (ia2, i, j, rlen, clen)
+        = appi RowMajor (fn (c,r,x) => f(r,c,x)) (turn ia2, j, i, clen, rlen); 
       fun app tr f (IA2 ia2) = appi tr (f o #3) (IA2 ia2, 0, 0, NONE, NONE);
 
       (* val foldli : traversal -> ((int * int * 'a * 'b) -> 'b) -> 'b 
@@ -566,29 +566,29 @@
        * and uses an immarray2 slice argument.
        *)
       fun foldli RowMajor f b (IA2 ia2, i, j, rlen, clen)
-	= ImmArray.foldli (fn (r,ia,b) 
-			   => ImmArray.foldli (fn (c,x,b) => f(r,c,x,b))
+        = ImmArray.foldli (fn (r,ia,b) 
+                           => ImmArray.foldli (fn (c,x,b) => f(r,c,x,b))
                                               b
                                               (ia, j, clen))
                           b
                           (ia2, i, rlen)
-	| foldli ColMajor f b (ia2, i, j, rlen, clen)
-	= foldli RowMajor (fn (c,r,x,b) => f(r,c,x,b)) b 
+        | foldli ColMajor f b (ia2, i, j, rlen, clen)
+        = foldli RowMajor (fn (c,r,x,b) => f(r,c,x,b)) b 
                  (turn ia2, j, i, clen, rlen);
       fun foldri RowMajor f b (IA2 ia2, i, j, rlen, clen)
-	= ImmArray.foldri (fn (r,ia,b) 
-			   => ImmArray.foldri (fn (c,x,b) => f(r,c,x,b))
+        = ImmArray.foldri (fn (r,ia,b) 
+                           => ImmArray.foldri (fn (c,x,b) => f(r,c,x,b))
                                               b
                                               (ia, j, clen))
                           b
                           (ia2, i, rlen)
-	| foldri ColMajor f b (ia2, i, j, rlen, clen)
-	= foldri RowMajor (fn (c,r,x,b) => f(r,c,x,b)) b 
+        | foldri ColMajor f b (ia2, i, j, rlen, clen)
+        = foldri RowMajor (fn (c,r,x,b) => f(r,c,x,b)) b 
                           (turn ia2, j, i, clen, rlen);
       fun foldl tr f b (IA2 ia2)
-	= foldli tr (fn (_,_,x,b) => f(x,b)) b (IA2 ia2, 0, 0, NONE, NONE);
+        = foldli tr (fn (_,_,x,b) => f(x,b)) b (IA2 ia2, 0, 0, NONE, NONE);
       fun foldr tr f b (IA2 ia2)
-	= foldri tr (fn (_,_,x,b) => f(x,b)) b (IA2 ia2, 0, 0, NONE, NONE);
+        = foldri tr (fn (_,_,x,b) => f(x,b)) b (IA2 ia2, 0, 0, NONE, NONE);
 
       (* val mapi : traversal -> ('a * int * int -> 'b) -> 'a immarray2 
        *            -> 'b immarray2
@@ -604,14 +604,14 @@
        * function reduces to the extract function.
        *)
       fun mapi RowMajor f (IA2 ia2, i, j, rlen, clen)
-	= IA2 (ImmArray.mapi (fn (r,ia) => ImmArray.mapi (fn (c,x) => f(r,c,x))
-			                                 (ia, j, clen))
+        = IA2 (ImmArray.mapi (fn (r,ia) => ImmArray.mapi (fn (c,x) => f(r,c,x))
+                                                         (ia, j, clen))
                              (ia2, i, rlen))
-	| mapi ColMajor f (ia2, i, j, rlen, clen)
-	= turn (mapi RowMajor (fn (c,r,x) => f(r,c,x)) 
+        | mapi ColMajor f (ia2, i, j, rlen, clen)
+        = turn (mapi RowMajor (fn (c,r,x) => f(r,c,x)) 
                      (turn ia2, j, i, clen, rlen))
       fun map tr f (IA2 ia2)
-	= mapi tr (f o #3) (IA2 ia2, 0, 0, NONE, NONE);
+        = mapi tr (f o #3) (IA2 ia2, 0, 0, NONE, NONE);
 
       (* val modifyi : traversal -> (int * int* 'a -> 'a) 
                        -> ('a immarray2 * int * int * int option * int option) 
@@ -624,15 +624,15 @@
        * to the mapped function and uses an immarray2 slice argument.
        *)
       fun modifyi RowMajor f (IA2 ia2, i, j, rlen, clen)
-	= IA2 (ImmArray.modifyi (fn (r,ia) => ImmArray.modifyi (fn (c,x) 
-								=> f(r,c,x)) 
-				                               (ia, j, clen)) 
+        = IA2 (ImmArray.modifyi (fn (r,ia) => ImmArray.modifyi (fn (c,x) 
+                                                                => f(r,c,x)) 
+                                                               (ia, j, clen)) 
               (ia2, i, rlen))
-	| modifyi ColMajor f (ia2, i, j, rlen, clen)
-	= turn (modifyi RowMajor (fn (c,r,x) => f(r,c,x)) 
+        | modifyi ColMajor f (ia2, i, j, rlen, clen)
+        = turn (modifyi RowMajor (fn (c,r,x) => f(r,c,x)) 
                (turn ia2, j, i, clen, rlen));
       fun modify tr f (IA2 ia2) 
-	= modifyi tr (f o #3) (IA2 ia2, 0, 0, NONE, NONE);
+        = modifyi tr (f o #3) (IA2 ia2, 0, 0, NONE, NONE);
 
     end;
 
@@ -657,7 +657,7 @@
   = sig
   
       type registerfile;
-	
+        
       val InitRegisterFile : unit  -> registerfile; 
 
       val LoadRegister : registerfile * int -> Word32.word;
@@ -690,22 +690,22 @@
   = struct
 
       type registerfile = Word32.word ImmArray.immarray;
-	  
+          
       fun InitRegisterFile () 
-	  = ImmArray.update
-	    (ImmArray.update
-	     (ImmArray.update
-	      (ImmArray.update
-	       (ImmArray.immarray(32, 0wx00000000 : Word32.word),
-		00, 0wx00000000 : Word32.word),
-	       28, 0wx00000000 : Word32.word),
-	      29, 0wx00040000 : Word32.word),
-	     30, 0wx00040000 : Word32.word) : registerfile;
-	    
+          = ImmArray.update
+            (ImmArray.update
+             (ImmArray.update
+              (ImmArray.update
+               (ImmArray.immarray(32, 0wx00000000 : Word32.word),
+                00, 0wx00000000 : Word32.word),
+               28, 0wx00000000 : Word32.word),
+              29, 0wx00040000 : Word32.word),
+             30, 0wx00040000 : Word32.word) : registerfile;
+            
       fun LoadRegister (rf, reg) = ImmArray.sub(rf, reg);
 
       fun StoreRegister (rf, reg, data) = ImmArray.update(rf, reg, data);
-	
+        
     end;
     
 
@@ -725,15 +725,15 @@
   = sig
 
       datatype ALUOp = SLL | SRL | SRA |
-	               ADD | ADDU | 
-		       SUB | SUBU | 
-		       AND | OR | XOR | 
-		       SEQ | SNE | 
-		       SLT | SGT | 
-		       SLE | SGE;
+                       ADD | ADDU | 
+                       SUB | SUBU | 
+                       AND | OR | XOR | 
+                       SEQ | SNE | 
+                       SLT | SGT | 
+                       SLE | SGE;
   
       val PerformAL : (ALUOp * Word32.word * Word32.word) -> Word32.word;
-	
+        
     end;
 
 (*****************************************************************************)
@@ -763,70 +763,70 @@
   = struct
 
       datatype ALUOp = SLL | SRL | SRA |
-	               ADD | ADDU | 
-		       SUB | SUBU | 
-		       AND | OR | XOR | 
-		       SEQ | SNE | 
-		       SLT | SGT | 
-		       SLE | SGE;
+                       ADD | ADDU | 
+                       SUB | SUBU | 
+                       AND | OR | XOR | 
+                       SEQ | SNE | 
+                       SLT | SGT | 
+                       SLE | SGE;
 
       fun PerformAL (opcode, s1, s2) =
-	(case opcode
-	   of SLL => 
-	        Word32.<< (s1, Word.fromLarge (Word32.toLarge s2))
-	    | SRL => 
-	        Word32.>> (s1, Word.fromLarge (Word32.toLarge s2))
-	    | SRA => 
-	        Word32.~>> (s1, Word.fromLarge (Word32.toLarge s2))
-	    | ADD => 
-		Word32.fromInt (Int.+ (Word32.toIntX s1,
-						 Word32.toIntX s2))
-	    | ADDU => 
-		Word32.+ (s1, s2)
-	    | SUB =>
-		Word32.fromInt (Int.- (Word32.toIntX s1,
-						 Word32.toIntX s2))
-	    | SUBU => 
-		Word32.- (s1, s2)
-	    | AND => 
-		Word32.andb (s1, s2)
-	    | OR => 
-		Word32.orb (s1, s2)
-	    | XOR => 
-		Word32.xorb (s1, s2)
-	    | SEQ => 
-		if (s1 = s2)
-		  then 0wx00000001 : Word32.word
-		  else 0wx00000000 : Word32.word
-	    | SNE => 
-		if not (s1 = s2)
-		  then 0wx00000001 : Word32.word
-		  else 0wx00000000 : Word32.word
-	    | SLT => 
-		if Int.< (Word32.toIntX s1, Word32.toIntX s2)
-		  then 0wx00000001 : Word32.word
-		  else 0wx00000000 : Word32.word
-	    | SGT => 
-		if Int.> (Word32.toIntX s1, Word32.toIntX s2)
-		  then 0wx00000001 : Word32.word
-		  else 0wx00000000 : Word32.word
-	    | SLE => 
-		if Int.<= (Word32.toIntX s1, Word32.toIntX s2)
-		  then 0wx00000001 : Word32.word
-		  else 0wx00000000 : Word32.word
-	    | SGE => 
-		if Int.>= (Word32.toIntX s1, Word32.toIntX s2)
-		  then 0wx00000001 : Word32.word
-		  else 0wx00000000 : Word32.word)
-	   (* 
-	    * This handle will handle all ALU errors, most
-	    * notably overflow and division by zero, and will
-	    * print an error message and return 0.		  
-	    *)
-	   handle _ => 
-	     (print "Error : ALU returning 0\n";
-	      0wx00000000 : Word32.word);
-	     
+        (case opcode
+           of SLL => 
+                Word32.<< (s1, Word.fromLarge (Word32.toLarge s2))
+            | SRL => 
+                Word32.>> (s1, Word.fromLarge (Word32.toLarge s2))
+            | SRA => 
+                Word32.~>> (s1, Word.fromLarge (Word32.toLarge s2))
+            | ADD => 
+                Word32.fromInt (Int.+ (Word32.toIntX s1,
+                                                 Word32.toIntX s2))
+            | ADDU => 
+                Word32.+ (s1, s2)
+            | SUB =>
+                Word32.fromInt (Int.- (Word32.toIntX s1,
+                                                 Word32.toIntX s2))
+            | SUBU => 
+                Word32.- (s1, s2)
+            | AND => 
+                Word32.andb (s1, s2)
+            | OR => 
+                Word32.orb (s1, s2)
+            | XOR => 
+                Word32.xorb (s1, s2)
+            | SEQ => 
+                if (s1 = s2)
+                  then 0wx00000001 : Word32.word
+                  else 0wx00000000 : Word32.word
+            | SNE => 
+                if not (s1 = s2)
+                  then 0wx00000001 : Word32.word
+                  else 0wx00000000 : Word32.word
+            | SLT => 
+                if Int.< (Word32.toIntX s1, Word32.toIntX s2)
+                  then 0wx00000001 : Word32.word
+                  else 0wx00000000 : Word32.word
+            | SGT => 
+                if Int.> (Word32.toIntX s1, Word32.toIntX s2)
+                  then 0wx00000001 : Word32.word
+                  else 0wx00000000 : Word32.word
+            | SLE => 
+                if Int.<= (Word32.toIntX s1, Word32.toIntX s2)
+                  then 0wx00000001 : Word32.word
+                  else 0wx00000000 : Word32.word
+            | SGE => 
+                if Int.>= (Word32.toIntX s1, Word32.toIntX s2)
+                  then 0wx00000001 : Word32.word
+                  else 0wx00000000 : Word32.word)
+           (* 
+            * This handle will handle all ALU errors, most
+            * notably overflow and division by zero, and will
+            * print an error message and return 0.                
+            *)
+           handle _ => 
+             (print "Error : ALU returning 0\n";
+              0wx00000000 : Word32.word);
+             
     end;
 
 (*****************************************************************************)
@@ -856,7 +856,7 @@
   = sig
 
       type memory;
-	
+        
       val InitMemory : unit -> memory; 
 
       val LoadWord : memory * Word32.word -> memory * Word32.word;
@@ -913,20 +913,20 @@
 
 structure Memory : MEMORY
   = struct
-	
+        
       type memory = Word32.word ImmArray.immarray * (int * int);
-	
+        
       fun InitMemory () =
-	(ImmArray.immarray(Word32.toInt(0wx10000 : Word32.word),
-			   0wx00000000 : Word32.word), 
-	 (0, 0)) : memory;
+        (ImmArray.immarray(Word32.toInt(0wx10000 : Word32.word),
+                           0wx00000000 : Word32.word), 
+         (0, 0)) : memory;
 
       fun AlignWAddress address 
-	  = Word32.<< (Word32.>> (address, 0wx0002), 0wx0002);
-	    
+          = Word32.<< (Word32.>> (address, 0wx0002), 0wx0002);
+            
       fun AlignHWAddress address
-	  = Word32.<< (Word32.>> (address, 0wx0001), 0wx0001);
-	    
+          = Word32.<< (Word32.>> (address, 0wx0001), 0wx0001);
+            
       (* Load and Store provide errorless access to memory.
        * They provide a common interface to memory, while
        * the LoadX and StoreX specifically access words,
@@ -939,221 +939,221 @@
        * by four, and it corresponds to the index of the memory 
        * array where the corresponding aligned address can be found.
        *)
-	  
+          
       fun Load ((mem, (reads, writes)), address)
-	  = let
-	      val aligned_address = AlignWAddress address;
-	      val use_address = Word32.>> (aligned_address, 0wx0002);
-	    in
-	      ((mem, (reads + 1, writes)), 
-	       ImmArray.sub(mem, Word32.toInt(use_address)))
-	    end;
+          = let
+              val aligned_address = AlignWAddress address;
+              val use_address = Word32.>> (aligned_address, 0wx0002);
+            in
+              ((mem, (reads + 1, writes)), 
+               ImmArray.sub(mem, Word32.toInt(use_address)))
+            end;
 
       fun Store ((mem, (reads, writes)), address, data)
- 	  = let
-	      val aligned_address = AlignWAddress address;
-	      val use_address = Word32.>> (aligned_address, 0wx0002);
-	    in
-	      (ImmArray.update(mem, Word32.toInt(use_address), data),
-	       (reads, writes + 1))
-	    end;
+          = let
+              val aligned_address = AlignWAddress address;
+              val use_address = Word32.>> (aligned_address, 0wx0002);
+            in
+              (ImmArray.update(mem, Word32.toInt(use_address), data),
+               (reads, writes + 1))
+            end;
 
 
       fun LoadWord (mem, address)
-	  = let
-	      val aligned_address 
-		  = if address = AlignWAddress address
-		      then address
-		      else (print "Error LW: Memory using aligned address\n";
-			    AlignWAddress address);
-	    in
-	      Load(mem, aligned_address)
-	    end;
-	    
+          = let
+              val aligned_address 
+                  = if address = AlignWAddress address
+                      then address
+                      else (print "Error LW: Memory using aligned address\n";
+                            AlignWAddress address);
+            in
+              Load(mem, aligned_address)
+            end;
+            
       fun StoreWord (mem, address, data)
- 	  = let
-	      val aligned_address
-		  = if address = AlignWAddress address
-		      then address
-		      else (print "Error SW: Memory using aligned address\n";
-			    AlignWAddress address);
-	    in
-	      Store(mem, aligned_address, data)
-	    end;
+          = let
+              val aligned_address
+                  = if address = AlignWAddress address
+                      then address
+                      else (print "Error SW: Memory using aligned address\n";
+                            AlignWAddress address);
+            in
+              Store(mem, aligned_address, data)
+            end;
 
       fun LoadHWord (mem, address)
-	  = let
-	      val aligned_address 
-		  = if address = AlignHWAddress address
-		      then address
-		      else (print "Error LH: Memory using aligned address\n";
-			    AlignHWAddress address);
-	      val (nmem,l_word) = Load(mem, aligned_address);
-	    in
-	      (nmem,
-	       case aligned_address 
-		 of 0wx00000000 : Word32.word
-		   => Word32.~>>(Word32.<<(l_word, 0wx0010), 
-				 0wx0010)
-		  | 0wx00000010 : Word32.word
-		   => Word32.~>>(Word32.<<(l_word, 0wx0000),
-				 0wx0010)
-		  | _ => (print "Error LH: Memory returning 0\n";
-			  0wx00000000 : Word32.word))
-	    end;
+          = let
+              val aligned_address 
+                  = if address = AlignHWAddress address
+                      then address
+                      else (print "Error LH: Memory using aligned address\n";
+                            AlignHWAddress address);
+              val (nmem,l_word) = Load(mem, aligned_address);
+            in
+              (nmem,
+               case aligned_address 
+                 of 0wx00000000 : Word32.word
+                   => Word32.~>>(Word32.<<(l_word, 0wx0010), 
+                                 0wx0010)
+                  | 0wx00000010 : Word32.word
+                   => Word32.~>>(Word32.<<(l_word, 0wx0000),
+                                 0wx0010)
+                  | _ => (print "Error LH: Memory returning 0\n";
+                          0wx00000000 : Word32.word))
+            end;
 
       fun LoadHWordU (mem, address)
-	  = let
-	      val aligned_address 
-		  = if address = AlignHWAddress address
-		      then address
-		      else (print "Error LHU: Memory using aligned address\n";
-			    AlignHWAddress address);
-	      val (nmem, l_word) = Load(mem, aligned_address);
-	    in
-	      (nmem,
-	       case aligned_address 
-		 of 0wx00000000 : Word32.word
-		   => Word32.>>(Word32.<<(l_word, 0wx0010), 
-				0wx0010)
-		  | 0wx00000010 : Word32.word
-		   => Word32.>>(Word32.<<(l_word, 0wx0000),
-				0wx0010)
-		  | _ => (print "Error LHU: Memory returning 0\n";
-			  0wx00000000 : Word32.word))
-	    end;
-	    
+          = let
+              val aligned_address 
+                  = if address = AlignHWAddress address
+                      then address
+                      else (print "Error LHU: Memory using aligned address\n";
+                            AlignHWAddress address);
+              val (nmem, l_word) = Load(mem, aligned_address);
+            in
+              (nmem,
+               case aligned_address 
+                 of 0wx00000000 : Word32.word
+                   => Word32.>>(Word32.<<(l_word, 0wx0010), 
+                                0wx0010)
+                  | 0wx00000010 : Word32.word
+                   => Word32.>>(Word32.<<(l_word, 0wx0000),
+                                0wx0010)
+                  | _ => (print "Error LHU: Memory returning 0\n";
+                          0wx00000000 : Word32.word))
+            end;
+            
       fun StoreHWord (mem, address, data)
- 	  = let
-	      val aligned_address
-		  = if address = AlignHWAddress address
-		      then address
-		      else (print "Error SH: Memory using aligned address\n";
-			    AlignWAddress address);
-	      val (_, s_word) = Load(mem, aligned_address);
-	    in
-	      case aligned_address
-		of 0wx00000000 : Word32.word
-		  => Store(mem, aligned_address,
-			   Word32.orb(Word32.andb(0wxFFFF0000 : Word32.word,
-						  s_word),
-				      Word32.<<(Word32.andb(0wx0000FFFF : 
-							    Word32.word,
-							    data),
-						0wx0000)))
-		 | 0wx00000010 : Word32.word
-		  => Store(mem, aligned_address,
-			   Word32.orb(Word32.andb(0wx0000FFFF : Word32.word,
-						  s_word),
-				      Word32.<<(Word32.andb(0wx0000FFFF : 
-							    Word32.word,
-							    data),
-						0wx0010)))
-		 | _ => (print "Error SH: Memory unchanged\n";
-			 mem)
-	    end;
+          = let
+              val aligned_address
+                  = if address = AlignHWAddress address
+                      then address
+                      else (print "Error SH: Memory using aligned address\n";
+                            AlignWAddress address);
+              val (_, s_word) = Load(mem, aligned_address);
+            in
+              case aligned_address
+                of 0wx00000000 : Word32.word
+                  => Store(mem, aligned_address,
+                           Word32.orb(Word32.andb(0wxFFFF0000 : Word32.word,
+                                                  s_word),
+                                      Word32.<<(Word32.andb(0wx0000FFFF : 
+                                                            Word32.word,
+                                                            data),
+                                                0wx0000)))
+                 | 0wx00000010 : Word32.word
+                  => Store(mem, aligned_address,
+                           Word32.orb(Word32.andb(0wx0000FFFF : Word32.word,
+                                                  s_word),
+                                      Word32.<<(Word32.andb(0wx0000FFFF : 
+                                                            Word32.word,
+                                                            data),
+                                                0wx0010)))
+                 | _ => (print "Error SH: Memory unchanged\n";
+                         mem)
+            end;
 
       fun LoadByte (mem, address)
-	  = let
-	      val aligned_address = address;
-	      val (nmem, l_word) = Load(mem, aligned_address);
-	    in
-	      (nmem,
-	       case aligned_address 
-		 of 0wx00000000 : Word32.word
-		   => Word32.~>>(Word32.<<(l_word, 
-					   0wx0018), 
-				 0wx0018)
-		  | 0wx00000008 : Word32.word
-		   => Word32.~>>(Word32.<<(l_word,
-					   0wx0010),
-				 0wx0018)
-		  | 0wx00000010 : Word32.word
-		   => Word32.~>>(Word32.<<(l_word,
-					   0wx0008),
-				 0wx0018)
-		  | 0wx00000018 : Word32.word
-		   => Word32.~>>(Word32.<<(l_word,
-					   0wx0000),
-				 0wx0018)
-		  | _ => (print "Error LB: Memory returning 0\n";
-			  0wx00000000 : Word32.word))
-	    end;
+          = let
+              val aligned_address = address;
+              val (nmem, l_word) = Load(mem, aligned_address);
+            in
+              (nmem,
+               case aligned_address 
+                 of 0wx00000000 : Word32.word
+                   => Word32.~>>(Word32.<<(l_word, 
+                                           0wx0018), 
+                                 0wx0018)
+                  | 0wx00000008 : Word32.word
+                   => Word32.~>>(Word32.<<(l_word,
+                                           0wx0010),
+                                 0wx0018)
+                  | 0wx00000010 : Word32.word
+                   => Word32.~>>(Word32.<<(l_word,
+                                           0wx0008),
+                                 0wx0018)
+                  | 0wx00000018 : Word32.word
+                   => Word32.~>>(Word32.<<(l_word,
+                                           0wx0000),
+                                 0wx0018)
+                  | _ => (print "Error LB: Memory returning 0\n";
+                          0wx00000000 : Word32.word))
+            end;
 
       fun LoadByteU (mem, address)
-	  = let
-	      val aligned_address = address;
-	      val (nmem, l_word) = Load(mem, aligned_address);
-	    in
-	      (nmem,
-	       case aligned_address 
-		 of 0wx00000000 : Word32.word
-		   => Word32.>>(Word32.<<(l_word,
-					  0wx0018),
-				0wx0018)
-		  | 0wx00000008 : Word32.word
-		   => Word32.>>(Word32.<<(l_word,
-					  0wx0010),
-				0wx0018)
-		  | 0wx00000010 : Word32.word
-		   => Word32.>>(Word32.<<(l_word,
-					  0wx0008),
-				0wx0018)
-		  | 0wx00000018 : Word32.word
-		   => Word32.>>(Word32.<<(l_word,
-					  0wx0000),
-				0wx0018)
-		  | _ => (print "Error LBU: Memory returning 0\n";
-			  0wx00000000 : Word32.word))
-	    end;
-	    
+          = let
+              val aligned_address = address;
+              val (nmem, l_word) = Load(mem, aligned_address);
+            in
+              (nmem,
+               case aligned_address 
+                 of 0wx00000000 : Word32.word
+                   => Word32.>>(Word32.<<(l_word,
+                                          0wx0018),
+                                0wx0018)
+                  | 0wx00000008 : Word32.word
+                   => Word32.>>(Word32.<<(l_word,
+                                          0wx0010),
+                                0wx0018)
+                  | 0wx00000010 : Word32.word
+                   => Word32.>>(Word32.<<(l_word,
+                                          0wx0008),
+                                0wx0018)
+                  | 0wx00000018 : Word32.word
+                   => Word32.>>(Word32.<<(l_word,
+                                          0wx0000),
+                                0wx0018)
+                  | _ => (print "Error LBU: Memory returning 0\n";
+                          0wx00000000 : Word32.word))
+            end;
+            
       fun StoreByte (mem, address, data)
- 	  = let
-	      val aligned_address = address;
-	      val (_, s_word) = Load(mem, aligned_address);
-	    in
-	      case aligned_address
-		of 0wx00000000 : Word32.word
-		  => Store(mem, aligned_address,
-			   Word32.orb(Word32.andb(0wxFFFFFF00 : Word32.word,
-						  s_word),
-				      Word32.<<(Word32.andb(0wx000000FF : 
-							    Word32.word,
-							    data),
-						0wx0000)))
-		 | 0wx00000008 : Word32.word
-		  => Store(mem, aligned_address,
-			   Word32.orb(Word32.andb(0wxFFFF00FF : Word32.word,
-						  s_word),
-				      Word32.<<(Word32.andb(0wx000000FF : 
-							    Word32.word,
-							    data),
-						0wx0008)))
-		 | 0wx00000010 : Word32.word
-		  => Store(mem, aligned_address,
-			   Word32.orb(Word32.andb(0wxFF00FFFF : Word32.word,
-						  s_word),
-				      Word32.<<(Word32.andb(0wx000000FF : 
-							    Word32.word,
-							    data),
-						0wx0010)))
-		 | 0wx00000018 : Word32.word
-		  => Store(mem, aligned_address,
-			   Word32.orb(Word32.andb(0wx00FFFFFF : Word32.word,
-						  s_word),
-				      Word32.<<(Word32.andb(0wx000000FF : 
-							    Word32.word,
-							    data),
-						0wx0018)))
-		 | _ => (print "Error SB: Memory unchanged\n";
-			 mem)
-	    end;
+          = let
+              val aligned_address = address;
+              val (_, s_word) = Load(mem, aligned_address);
+            in
+              case aligned_address
+                of 0wx00000000 : Word32.word
+                  => Store(mem, aligned_address,
+                           Word32.orb(Word32.andb(0wxFFFFFF00 : Word32.word,
+                                                  s_word),
+                                      Word32.<<(Word32.andb(0wx000000FF : 
+                                                            Word32.word,
+                                                            data),
+                                                0wx0000)))
+                 | 0wx00000008 : Word32.word
+                  => Store(mem, aligned_address,
+                           Word32.orb(Word32.andb(0wxFFFF00FF : Word32.word,
+                                                  s_word),
+                                      Word32.<<(Word32.andb(0wx000000FF : 
+                                                            Word32.word,
+                                                            data),
+                                                0wx0008)))
+                 | 0wx00000010 : Word32.word
+                  => Store(mem, aligned_address,
+                           Word32.orb(Word32.andb(0wxFF00FFFF : Word32.word,
+                                                  s_word),
+                                      Word32.<<(Word32.andb(0wx000000FF : 
+                                                            Word32.word,
+                                                            data),
+                                                0wx0010)))
+                 | 0wx00000018 : Word32.word
+                  => Store(mem, aligned_address,
+                           Word32.orb(Word32.andb(0wx00FFFFFF : Word32.word,
+                                                  s_word),
+                                      Word32.<<(Word32.andb(0wx000000FF : 
+                                                            Word32.word,
+                                                            data),
+                                                0wx0018)))
+                 | _ => (print "Error SB: Memory unchanged\n";
+                         mem)
+            end;
 
       fun GetStatistics (mem, (reads, writes))
-	  = "Memory :\n" ^
-	    "Memory Reads : " ^ (Int.toString reads) ^ "\n" ^
-	    "Memory Writes : " ^ (Int.toString writes) ^ "\n";
-	    
+          = "Memory :\n" ^
+            "Memory Reads : " ^ (Int.toString reads) ^ "\n" ^
+            "Memory Writes : " ^ (Int.toString writes) ^ "\n";
+            
     end;
 
 (*****************************************************************************)
@@ -1230,31 +1230,31 @@
  *)
 
 functor CachedMemory (structure CS : CACHESPEC;
-		      structure MEM : MEMORY;) : MEMORY 
+                      structure MEM : MEMORY;) : MEMORY 
   = struct
   
       type cacheline 
-	   = bool * bool * Word32.word * Word32.word ImmArray.immarray;
+           = bool * bool * Word32.word * Word32.word ImmArray.immarray;
 
       type cacheset
-	   = cacheline ImmArray.immarray;
+           = cacheline ImmArray.immarray;
 
       type cache 
-	   = cacheset ImmArray.immarray;
-	    
+           = cacheset ImmArray.immarray;
+            
       type memory = (cache * (int * int * int * int)) * MEM.memory;
-	    
-	    
+            
+            
       (* Performs log[base2] on an integer. *)
       fun exp2 0 = 1
-	| exp2 n = 2 * (exp2 (n-1))
+        | exp2 n = 2 * (exp2 (n-1))
       fun log2 x = let
-		     fun log2_aux n = if exp2 n > x
-					then (n-1)
-					else log2_aux (n+1)
-		   in 
-		     log2_aux 0
-		   end
+                     fun log2_aux n = if exp2 n > x
+                                        then (n-1)
+                                        else log2_aux (n+1)
+                   in 
+                     log2_aux 0
+                   end
 
       open CS;
 
@@ -1267,7 +1267,7 @@
       val BlockOffsetBits = log2 (BlockSize * 4);
       val IndexBits = log2 IndexSize;
       val TagBits = 32 - BlockOffsetBits - IndexBits;
-	    
+            
 
       (*
        * RandEntry returns a random number between 
@@ -1275,11 +1275,11 @@
        * replacement of data in the cache.
        *)
       val RandEntry = let
-			val modulus = Word.fromInt(Associativity - 1)
-		      in 
-			fn () => Word.toInt(Word.mod(rand (),
-						     modulus))
-		      end
+                        val modulus = Word.fromInt(Associativity - 1)
+                      in 
+                        fn () => Word.toInt(Word.mod(rand (),
+                                                     modulus))
+                      end
 
       (* 
        * The InitCache function initializes the cache to
@@ -1287,109 +1287,109 @@
        * to 0wx00000000.  
        *)
       fun InitCache ()
-	  = let
-	      val cacheline = (false, false, 0wx00000000 : Word32.word,
-			       ImmArray.immarray (BlockSize,
-						  0wx00000000 : Word32.word));
-	      val cacheset = ImmArray.immarray (Associativity, cacheline);
-	    in 
-	      (ImmArray.immarray (IndexSize, cacheset),
-	       (0, 0, 0, 0))
-	    end;
-	 
+          = let
+              val cacheline = (false, false, 0wx00000000 : Word32.word,
+                               ImmArray.immarray (BlockSize,
+                                                  0wx00000000 : Word32.word));
+              val cacheset = ImmArray.immarray (Associativity, cacheline);
+            in 
+              (ImmArray.immarray (IndexSize, cacheset),
+               (0, 0, 0, 0))
+            end;
+         
 
       (* 
        * The InitMemory function initializes the cache
        * and the memory being cached.
        *)
       fun InitMemory () = (InitCache (), MEM.InitMemory ()) : memory;
-	    
-	
+            
+        
       (* 
        * GetTag returns the Word32.word corresponding to the tag field of
        * address
        *)
       fun GetTag address 
-	  = Word32.>> (address, 
-		       Word.fromInt (IndexBits + BlockOffsetBits));
-	    
+          = Word32.>> (address, 
+                       Word.fromInt (IndexBits + BlockOffsetBits));
+            
 
       (* 
        * GetIndex returns the Word32.word corresponding to the index
        * field of address.
        *)
       fun GetIndex address
-	  = let
-	      val mask
-		  = Word32.notb 
-		    (Word32.<< 
-		     (Word32.>> (0wxFFFFFFFF : Word32.word,
-				 Word.fromInt (IndexBits + BlockOffsetBits)), 
-		      Word.fromInt (IndexBits + BlockOffsetBits)));
-	    in
-	      Word32.>> (Word32.andb (address, mask),
-			 Word.fromInt (BlockOffsetBits))
-	    end;
-	    
+          = let
+              val mask
+                  = Word32.notb 
+                    (Word32.<< 
+                     (Word32.>> (0wxFFFFFFFF : Word32.word,
+                                 Word.fromInt (IndexBits + BlockOffsetBits)), 
+                      Word.fromInt (IndexBits + BlockOffsetBits)));
+            in
+              Word32.>> (Word32.andb (address, mask),
+                         Word.fromInt (BlockOffsetBits))
+            end;
+            
 
       (* 
        * GetBlockOffset returns the Word32.word corresponding to the
        * block offset field of address.
        *)
       fun GetBlockOffset address
-	  = let
-	      val mask
-		  = Word32.notb 
-		    (Word32.<< 
-		     (Word32.>> (0wxFFFFFFFF : Word32.word,
-				 Word.fromInt BlockOffsetBits), 
-		      Word.fromInt BlockOffsetBits));
-	    in
-	      Word32.andb (address, mask)
-	    end;
-	    
-	   
+          = let
+              val mask
+                  = Word32.notb 
+                    (Word32.<< 
+                     (Word32.>> (0wxFFFFFFFF : Word32.word,
+                                 Word.fromInt BlockOffsetBits), 
+                      Word.fromInt BlockOffsetBits));
+            in
+              Word32.andb (address, mask)
+            end;
+            
+           
       (* 
        * The InCache* family of functions returns a boolean value
        * that determines if the word specified by address is in the
        * cache at the current time (and that the data is valid).
        *)
       fun InCache_aux_entry ((valid, dirty, tag, block), address)
-	  = tag = (GetTag address) andalso valid;
+          = tag = (GetTag address) andalso valid;
 
       fun InCache_aux_set (set, address)
-	  = ImmArray.foldr (fn (entry, result) => 
-			       (InCache_aux_entry (entry, address)) orelse 
-			       result) 
-	                   false 
-			   set;
+          = ImmArray.foldr (fn (entry, result) => 
+                               (InCache_aux_entry (entry, address)) orelse 
+                               result) 
+                           false 
+                           set;
 
       fun InCache (cac, address)
-	  = InCache_aux_set (ImmArray.sub (cac, 
-					   Word32.toInt (GetIndex address)),
-			     address);
+          = InCache_aux_set (ImmArray.sub (cac, 
+                                           Word32.toInt (GetIndex address)),
+                             address);
 
       (* 
        * The ReadCache* family of functions returns the Word32.word 
        * stored at address in the cache.
        *)
       fun ReadCache_aux_entry ((valid, dirty, tag, block), address) 
- 	  = ImmArray.sub (block, 
-			  Word32.toInt (Word32.>> (GetBlockOffset address, 
-						   0wx0002)));
-	
+          = ImmArray.sub (block, 
+                          Word32.toInt (Word32.>> (GetBlockOffset address, 
+                                                   0wx0002)));
+        
       fun ReadCache_aux_set (set, address) 
-	  = ImmArray.foldr (fn (entry, result) =>
-			       if InCache_aux_entry (entry, address)
-				 then ReadCache_aux_entry (entry, address)
-			         else result)
-	                   (0wx00000000 : Word32.word)
-			   set;
-	
+          = ImmArray.foldr (fn (entry, result) =>
+                               if InCache_aux_entry (entry, address)
+                                 then ReadCache_aux_entry (entry, address)
+                                 else result)
+                           (0wx00000000 : Word32.word)
+                           set;
+        
       fun ReadCache (cac, address)
-	  = ReadCache_aux_set (ImmArray.sub (cac, 
-					     Word32.toInt(GetIndex address)),
-			       address);
+          = ReadCache_aux_set (ImmArray.sub (cac, 
+                                             Word32.toInt(GetIndex address)),
+                               address);
 
 
       (* 
@@ -1397,35 +1397,35 @@
        * cache with data stored at address.
        *)
       fun WriteCache_aux_entry ((valid, dirty, tag, block), address, data)
-	  = let
-	      val ndirty = case WriteHit
-			     of Write_Through => false
-			      | Write_Back => true; 
-	    in
-	      (true, ndirty, tag, 
-	       ImmArray.update (block, 
-				Word32.toInt (Word32.>> 
-					      (GetBlockOffset address, 
-					       0wx0002)), 
-				data))
-	    end;
-	    
+          = let
+              val ndirty = case WriteHit
+                             of Write_Through => false
+                              | Write_Back => true; 
+            in
+              (true, ndirty, tag, 
+               ImmArray.update (block, 
+                                Word32.toInt (Word32.>> 
+                                              (GetBlockOffset address, 
+                                               0wx0002)), 
+                                data))
+            end;
+            
       fun WriteCache_aux_set (set, address, data) 
-	  = ImmArray.map (fn entry =>
-			     if InCache_aux_entry (entry, address)
-			       then WriteCache_aux_entry (entry, address, 
-							  data)
-			       else entry)
-	                 set;
+          = ImmArray.map (fn entry =>
+                             if InCache_aux_entry (entry, address)
+                               then WriteCache_aux_entry (entry, address, 
+                                                          data)
+                               else entry)
+                         set;
 
       fun WriteCache (cac, address, data)
-	  = let
-	      val index = Word32.toInt (GetIndex address);
-	      val nset = WriteCache_aux_set (ImmArray.sub (cac, index),
-					     address, data);
-	    in
-	      ImmArray.update (cac, index, nset)
-	    end;
+          = let
+              val index = Word32.toInt (GetIndex address);
+              val nset = WriteCache_aux_set (ImmArray.sub (cac, index),
+                                             address, data);
+            in
+              ImmArray.update (cac, index, nset)
+            end;
 
 
       (* 
@@ -1433,27 +1433,27 @@
        * memory and the block containing address loaded from memory.
        *)
       fun LoadBlock (mem, address)
-	  = ImmArray.foldr (fn (offset, (block, mem)) =>
-			       let
-				 val laddress
-				     = Word32.+ (Word32.<<
-						 (Word32.>> 
-						  (address,
-						   Word.fromInt 
-						   BlockOffsetBits),
-						  Word.fromInt 
-						  BlockOffsetBits), 
-						 Word32.<< (Word32.fromInt 
-							    offset, 
-							    0wx0002));
-				 val (nmem, nword) = MEM.LoadWord (mem, 
-								   laddress);
-			       in
-				 (ImmArray.update (block, offset, nword), nmem)
-			       end)
-	                   (ImmArray.immarray (BlockSize, 
-					       0wx00000000 : Word32.word), mem)
-	                   (ImmArray.tabulate (BlockSize, fn i => i));
+          = ImmArray.foldr (fn (offset, (block, mem)) =>
+                               let
+                                 val laddress
+                                     = Word32.+ (Word32.<<
+                                                 (Word32.>> 
+                                                  (address,
+                                                   Word.fromInt 
+                                                   BlockOffsetBits),
+                                                  Word.fromInt 
+                                                  BlockOffsetBits), 
+                                                 Word32.<< (Word32.fromInt 
+                                                            offset, 
+                                                            0wx0002));
+                                 val (nmem, nword) = MEM.LoadWord (mem, 
+                                                                   laddress);
+                               in
+                                 (ImmArray.update (block, offset, nword), nmem)
+                               end)
+                           (ImmArray.immarray (BlockSize, 
+                                               0wx00000000 : Word32.word), mem)
+                           (ImmArray.tabulate (BlockSize, fn i => i));
 
  
       (* 
@@ -1461,25 +1461,25 @@
        * memory with block stored into the block containing address.
        *)
       fun StoreBlock (block, mem, address)
-	  = ImmArray.foldr (fn (offset, mem) =>
-			       let
-				 val saddress
-				     = Word32.+ (Word32.<<
-						 (Word32.>> 
-						  (address,
-						   Word.fromInt 
-						   BlockOffsetBits),
-						  Word.fromInt 
-						  BlockOffsetBits), 
-						 Word32.<< (Word32.fromInt 
-							    offset, 
-							    0wx0002));
-			       in
-				 MEM.StoreWord (mem, saddress,
-						ImmArray.sub (block, offset))
-			       end)
-	                   mem
-			   (ImmArray.tabulate (BlockSize, fn i => i));
+          = ImmArray.foldr (fn (offset, mem) =>
+                               let
+                                 val saddress
+                                     = Word32.+ (Word32.<<
+                                                 (Word32.>> 
+                                                  (address,
+                                                   Word.fromInt 
+                                                   BlockOffsetBits),
+                                                  Word.fromInt 
+                                                  BlockOffsetBits), 
+                                                 Word32.<< (Word32.fromInt 
+                                                            offset, 
+                                                            0wx0002));
+                               in
+                                 MEM.StoreWord (mem, saddress,
+                                                ImmArray.sub (block, offset))
+                               end)
+                           mem
+                           (ImmArray.tabulate (BlockSize, fn i => i));
 
 
       (* 
@@ -1489,39 +1489,39 @@
        * data written back to memory as needed.
        *)
       fun LoadCache_aux_entry ((valid, dirty, tag, block), mem, address)
-	  = let
-	      val saddress 
-		  = Word32.orb (Word32.<< (tag,
-					   Word.fromInt TagBits),
-				Word32.<< (GetIndex address,
-					   Word.fromInt IndexBits));
-	      val nmem = if valid andalso dirty
-			   then StoreBlock (block, mem, saddress)
-			   else mem;
-	      val (nblock, nnmem) = LoadBlock (nmem, address);
-	    in
-	      ((true, false, GetTag address, nblock), nnmem)
-	    end;
+          = let
+              val saddress 
+                  = Word32.orb (Word32.<< (tag,
+                                           Word.fromInt TagBits),
+                                Word32.<< (GetIndex address,
+                                           Word.fromInt IndexBits));
+              val nmem = if valid andalso dirty
+                           then StoreBlock (block, mem, saddress)
+                           else mem;
+              val (nblock, nnmem) = LoadBlock (nmem, address);
+            in
+              ((true, false, GetTag address, nblock), nnmem)
+            end;
 
       fun LoadCache_aux_set (set, mem, address)
-	  = let
-	      val entry = RandEntry ();
-	      val (nentry, nmem) = LoadCache_aux_entry (ImmArray.sub (set, 
-								      entry),
-							mem, address);
-	    in
-	      (ImmArray.update (set, entry, nentry), nmem)
-	    end;
+          = let
+              val entry = RandEntry ();
+              val (nentry, nmem) = LoadCache_aux_entry (ImmArray.sub (set, 
+                                                                      entry),
+                                                        mem, address);
+            in
+              (ImmArray.update (set, entry, nentry), nmem)
+            end;
 
       fun LoadCache (cac, mem, address) 
-	  = let
-	      val index = Word32.toInt (GetIndex address);
-	      val (nset, nmem) 
-		  = LoadCache_aux_set (ImmArray.sub (cac, index), 
-				       mem, address);
-	    in
-	      (ImmArray.update (cac, index, nset), nmem)
-	    end;
+          = let
+              val index = Word32.toInt (GetIndex address);
+              val (nset, nmem) 
+                  = LoadCache_aux_set (ImmArray.sub (cac, index), 
+                                       mem, address);
+            in
+              (ImmArray.update (cac, index, nset), nmem)
+            end;
 
 
       (* 
@@ -1532,11 +1532,11 @@
        *)
 
       fun AlignWAddress address 
-	  = Word32.<< (Word32.>> (address, 0wx0002), 0wx0002);
-	    
+          = Word32.<< (Word32.>> (address, 0wx0002), 0wx0002);
+            
       fun AlignHWAddress address
-	  = Word32.<< (Word32.>> (address, 0wx0001), 0wx0001);
-	    
+          = Word32.<< (Word32.>> (address, 0wx0001), 0wx0001);
+            
       (* Load and Store provide errorless access to memory.
        * They provide a common interface to memory, while
        * the LoadX and StoreX specifically access words,
@@ -1551,279 +1551,279 @@
        *)
 
       fun Load (((cac, (rh, rm, wh, wm)), mem), address)
-	  = let
-	      val aligned_address = AlignWAddress address;
-	    in
-	      if InCache (cac, aligned_address)
-		then (((cac, (rh + 1, rm, wh, wm)), mem), 
-		      ReadCache (cac, aligned_address))
-	        else let
-		       val (ncac, nmem) 
-			   = LoadCache (cac, mem, aligned_address);
-		     in
-		       (((ncac, (rh, rm + 1, wh, wm)), nmem),
-			ReadCache (ncac, aligned_address))
-		     end
-	    end;
+          = let
+              val aligned_address = AlignWAddress address;
+            in
+              if InCache (cac, aligned_address)
+                then (((cac, (rh + 1, rm, wh, wm)), mem), 
+                      ReadCache (cac, aligned_address))
+                else let
+                       val (ncac, nmem) 
+                           = LoadCache (cac, mem, aligned_address);
+                     in
+                       (((ncac, (rh, rm + 1, wh, wm)), nmem),
+                        ReadCache (ncac, aligned_address))
+                     end
+            end;
 
 
       fun Store (((cac, (rh, rm, wh, wm)), mem), address, data)
-	  = let
-	      val aligned_address = AlignWAddress address;
-	    in
-	      if InCache (cac, aligned_address)
-		then let
-		       val ncac = WriteCache (cac, aligned_address, data);
-		     in
-		       case WriteHit 
-			 of Write_Through => 
-			      ((ncac, (rh, rm, wh + 1, wm)),
-			       MEM.StoreWord (mem, aligned_address, data))
-			  | Write_Back => 
-			      ((ncac, (rh, rm, wh + 1, wm)), mem)
-		     end
-	        else case WriteMiss
-		       of Write_Allocate =>
-			    let
-			      val (ncac, nmem) 
-				= LoadCache (cac, mem, aligned_address);
-			      val nncac
-				= WriteCache (ncac, aligned_address, data);
-			    in
-			      case WriteHit
-				of Write_Through => 
-			             ((nncac, (rh, rm, wh, wm + 1)), 
-				      MEM.StoreWord (nmem, aligned_address, 
-						     data))
-				 | Write_Back =>
-				     ((nncac, (rh, rm, wh, wm + 1)),
-				      nmem)
-			    end
-			| Write_No_Allocate =>
-			    ((cac, (rh, rm, wh, wm + 1)),
-			     MEM.StoreWord (mem, aligned_address, data))
-	    end;
+          = let
+              val aligned_address = AlignWAddress address;
+            in
+              if InCache (cac, aligned_address)
+                then let
+                       val ncac = WriteCache (cac, aligned_address, data);
+                     in
+                       case WriteHit 
+                         of Write_Through => 
+                              ((ncac, (rh, rm, wh + 1, wm)),
+                               MEM.StoreWord (mem, aligned_address, data))
+                          | Write_Back => 
+                              ((ncac, (rh, rm, wh + 1, wm)), mem)
+                     end
+                else case WriteMiss
+                       of Write_Allocate =>
+                            let
+                              val (ncac, nmem) 
+                                = LoadCache (cac, mem, aligned_address);
+                              val nncac
+                                = WriteCache (ncac, aligned_address, data);
+                            in
+                              case WriteHit
+                                of Write_Through => 
+                                     ((nncac, (rh, rm, wh, wm + 1)), 
+                                      MEM.StoreWord (nmem, aligned_address, 
+                                                     data))
+                                 | Write_Back =>
+                                     ((nncac, (rh, rm, wh, wm + 1)),
+                                      nmem)
+                            end
+                        | Write_No_Allocate =>
+                            ((cac, (rh, rm, wh, wm + 1)),
+                             MEM.StoreWord (mem, aligned_address, data))
+            end;
 
       fun LoadWord (mem, address)
-	  = let
-	      val aligned_address 
-		  = if address = AlignWAddress address
-		      then address
-		      else (print "Error LW: Memory using aligned address\n";
-			    AlignWAddress address);
-	    in
-	      Load(mem, aligned_address)
-	    end;
-	    
+          = let
+              val aligned_address 
+                  = if address = AlignWAddress address
+                      then address
+                      else (print "Error LW: Memory using aligned address\n";
+                            AlignWAddress address);
+            in
+              Load(mem, aligned_address)
+            end;
+            
       fun StoreWord (mem, address, data)
- 	  = let
-	      val aligned_address
-		  = if address = AlignWAddress address
-		      then address
-		      else (print "Error SW: Memory using aligned address\n";
-			    AlignWAddress address);
-	    in
-	      Store(mem, aligned_address, data)
-	    end;
+          = let
+              val aligned_address
+                  = if address = AlignWAddress address
+                      then address
+                      else (print "Error SW: Memory using aligned address\n";
+                            AlignWAddress address);
+            in
+              Store(mem, aligned_address, data)
+            end;
 
       fun LoadHWord (mem, address)
-	  = let
-	      val aligned_address 
-		  = if address = AlignHWAddress address
-		      then address
-		      else (print "Error LH: Memory using aligned address\n";
-			    AlignHWAddress address);
-	      val (nmem,l_word) = Load(mem, aligned_address);
-	    in
-	      (nmem,
-	       case aligned_address 
-		 of 0wx00000000 : Word32.word
-		   => Word32.~>>(Word32.<<(l_word, 0wx0010), 
-				 0wx0010)
-		  | 0wx00000010 : Word32.word
-		   => Word32.~>>(Word32.<<(l_word, 0wx0000),
-				 0wx0010)
-		  | _ => (print "Error LH: Memory returning 0\n";
-			  0wx00000000 : Word32.word))
-	    end;
+          = let
+              val aligned_address 
+                  = if address = AlignHWAddress address
+                      then address
+                      else (print "Error LH: Memory using aligned address\n";
+                            AlignHWAddress address);
+              val (nmem,l_word) = Load(mem, aligned_address);
+            in
+              (nmem,
+               case aligned_address 
+                 of 0wx00000000 : Word32.word
+                   => Word32.~>>(Word32.<<(l_word, 0wx0010), 
+                                 0wx0010)
+                  | 0wx00000010 : Word32.word
+                   => Word32.~>>(Word32.<<(l_word, 0wx0000),
+                                 0wx0010)
+                  | _ => (print "Error LH: Memory returning 0\n";
+                          0wx00000000 : Word32.word))
+            end;
 
       fun LoadHWordU (mem, address)
-	  = let
-	      val aligned_address 
-		  = if address = AlignHWAddress address
-		      then address
-		      else (print "Error LHU: Memory using aligned address\n";
-			    AlignHWAddress address);
-	      val (nmem, l_word) = Load(mem, aligned_address);
-	    in
-	      (nmem,
-	       case aligned_address 
-		 of 0wx00000000 : Word32.word
-		   => Word32.>>(Word32.<<(l_word, 0wx0010), 
-				0wx0010)
-		  | 0wx00000010 : Word32.word
-		   => Word32.>>(Word32.<<(l_word, 0wx0000),
-				0wx0010)
-		  | _ => (print "Error LHU: Memory returning 0\n";
-			  0wx00000000 : Word32.word))
-	    end;
-	    
+          = let
+              val aligned_address 
+                  = if address = AlignHWAddress address
+                      then address
+                      else (print "Error LHU: Memory using aligned address\n";
+                            AlignHWAddress address);
+              val (nmem, l_word) = Load(mem, aligned_address);
+            in
+              (nmem,
+               case aligned_address 
+                 of 0wx00000000 : Word32.word
+                   => Word32.>>(Word32.<<(l_word, 0wx0010), 
+                                0wx0010)
+                  | 0wx00000010 : Word32.word
+                   => Word32.>>(Word32.<<(l_word, 0wx0000),
+                                0wx0010)
+                  | _ => (print "Error LHU: Memory returning 0\n";
+                          0wx00000000 : Word32.word))
+            end;
+            
       fun StoreHWord (mem, address, data)
- 	  = let
-	      val aligned_address
-		  = if address = AlignHWAddress address
-		      then address
-		      else (print "Error SH: Memory using aligned address\n";
-			    AlignWAddress address);
-	      val (_, s_word) = Load(mem, aligned_address);
-	    in
-	      case aligned_address
-		of 0wx00000000 : Word32.word
-		  => Store(mem, aligned_address,
-			   Word32.orb(Word32.andb(0wxFFFF0000 : Word32.word,
-						  s_word),
-				      Word32.<<(Word32.andb(0wx0000FFFF : 
-							    Word32.word,
-							    data),
-						0wx0000)))
-		 | 0wx00000010 : Word32.word
-		  => Store(mem, aligned_address,
-			   Word32.orb(Word32.andb(0wx0000FFFF : Word32.word,
-						  s_word),
-				      Word32.<<(Word32.andb(0wx0000FFFF : 
-							    Word32.word,
-							    data),
-						0wx0010)))
-		 | _ => (print "Error SH: Memory unchanged\n";
-			 mem)
-	    end;
+          = let
+              val aligned_address
+                  = if address = AlignHWAddress address
+                      then address
+                      else (print "Error SH: Memory using aligned address\n";
+                            AlignWAddress address);
+              val (_, s_word) = Load(mem, aligned_address);
+            in
+              case aligned_address
+                of 0wx00000000 : Word32.word
+                  => Store(mem, aligned_address,
+                           Word32.orb(Word32.andb(0wxFFFF0000 : Word32.word,
+                                                  s_word),
+                                      Word32.<<(Word32.andb(0wx0000FFFF : 
+                                                            Word32.word,
+                                                            data),
+                                                0wx0000)))
+                 | 0wx00000010 : Word32.word
+                  => Store(mem, aligned_address,
+                           Word32.orb(Word32.andb(0wx0000FFFF : Word32.word,
+                                                  s_word),
+                                      Word32.<<(Word32.andb(0wx0000FFFF : 
+                                                            Word32.word,
+                                                            data),
+                                                0wx0010)))
+                 | _ => (print "Error SH: Memory unchanged\n";
+                         mem)
+            end;
 
       fun LoadByte (mem, address)
-	  = let
-	      val aligned_address = address;
-	      val (nmem, l_word) = Load(mem, aligned_address);
-	    in
-	      (nmem,
-	       case aligned_address 
-		 of 0wx00000000 : Word32.word
-		   => Word32.~>>(Word32.<<(l_word, 
-					   0wx0018), 
-				 0wx0018)
-		  | 0wx00000008 : Word32.word
-		   => Word32.~>>(Word32.<<(l_word,
-					   0wx0010),
-				 0wx0018)
-		  | 0wx00000010 : Word32.word
-		   => Word32.~>>(Word32.<<(l_word,
-					   0wx0008),
-				 0wx0018)
-		  | 0wx00000018 : Word32.word
-		   => Word32.~>>(Word32.<<(l_word,
-					   0wx0000),
-				 0wx0018)
-		  | _ => (print "Error LB: Memory returning 0\n";
-			  0wx00000000 : Word32.word))
-	    end;
+          = let
+              val aligned_address = address;
+              val (nmem, l_word) = Load(mem, aligned_address);
+            in
+              (nmem,
+               case aligned_address 
+                 of 0wx00000000 : Word32.word
+                   => Word32.~>>(Word32.<<(l_word, 
+                                           0wx0018), 
+                                 0wx0018)
+                  | 0wx00000008 : Word32.word
+                   => Word32.~>>(Word32.<<(l_word,
+                                           0wx0010),
+                                 0wx0018)
+                  | 0wx00000010 : Word32.word
+                   => Word32.~>>(Word32.<<(l_word,
+                                           0wx0008),
+                                 0wx0018)
+                  | 0wx00000018 : Word32.word
+                   => Word32.~>>(Word32.<<(l_word,
+                                           0wx0000),
+                                 0wx0018)
+                  | _ => (print "Error LB: Memory returning 0\n";
+                          0wx00000000 : Word32.word))
+            end;
 
       fun LoadByteU (mem, address)
-	  = let
-	      val aligned_address = address;
-	      val (nmem, l_word) = Load(mem, aligned_address);
-	    in
-	      (nmem,
-	       case aligned_address 
-		 of 0wx00000000 : Word32.word
-		   => Word32.>>(Word32.<<(l_word,
-					  0wx0018),
-				0wx0018)
-		  | 0wx00000008 : Word32.word
-		   => Word32.>>(Word32.<<(l_word,
-					  0wx0010),
-				0wx0018)
-		  | 0wx00000010 : Word32.word
-		   => Word32.>>(Word32.<<(l_word,
-					  0wx0008),
-				0wx0018)
-		  | 0wx00000018 : Word32.word
-		   => Word32.>>(Word32.<<(l_word,
-					  0wx0000),
-				0wx0018)
-		  | _ => (print "Error LBU: Memory returning 0\n";
-			  0wx00000000 : Word32.word))
-	    end;
-	    
+          = let
+              val aligned_address = address;
+              val (nmem, l_word) = Load(mem, aligned_address);
+            in
+              (nmem,
+               case aligned_address 
+                 of 0wx00000000 : Word32.word
+                   => Word32.>>(Word32.<<(l_word,
+                                          0wx0018),
+                                0wx0018)
+                  | 0wx00000008 : Word32.word
+                   => Word32.>>(Word32.<<(l_word,
+                                          0wx0010),
+                                0wx0018)
+                  | 0wx00000010 : Word32.word
+                   => Word32.>>(Word32.<<(l_word,
+                                          0wx0008),
+                                0wx0018)
+                  | 0wx00000018 : Word32.word
+                   => Word32.>>(Word32.<<(l_word,
+                                          0wx0000),
+                                0wx0018)
+                  | _ => (print "Error LBU: Memory returning 0\n";
+                          0wx00000000 : Word32.word))
+            end;
+            
       fun StoreByte (mem, address, data)
- 	  = let
-	      val aligned_address = address;
-	      val (_, s_word) = Load(mem, aligned_address);
-	    in
-	      case aligned_address
-		of 0wx00000000 : Word32.word
-		  => Store(mem, aligned_address,
-			   Word32.orb(Word32.andb(0wxFFFFFF00 : Word32.word,
-						  s_word),
-				      Word32.<<(Word32.andb(0wx000000FF : 
-							    Word32.word,
-							    data),
-						0wx0000)))
-		 | 0wx00000008 : Word32.word
-		  => Store(mem, aligned_address,
-			   Word32.orb(Word32.andb(0wxFFFF00FF : Word32.word,
-						  s_word),
-				      Word32.<<(Word32.andb(0wx000000FF : 
-							    Word32.word,
-							    data),
-						0wx0008)))
-		 | 0wx00000010 : Word32.word
-		  => Store(mem, aligned_address,
-			   Word32.orb(Word32.andb(0wxFF00FFFF : Word32.word,
-						  s_word),
-				      Word32.<<(Word32.andb(0wx000000FF : 
-							    Word32.word,
-							    data),
-						0wx0010)))
-		 | 0wx00000018 : Word32.word
-		  => Store(mem, aligned_address,
-			   Word32.orb(Word32.andb(0wx00FFFFFF : Word32.word,
-						  s_word),
-				      Word32.<<(Word32.andb(0wx000000FF : 
-							    Word32.word,
-							    data),
-						0wx0018)))
-		 | _ => (print "Error SB: Memory unchanged\n";
-			 mem)
-	    end;
+          = let
+              val aligned_address = address;
+              val (_, s_word) = Load(mem, aligned_address);
+            in
+              case aligned_address
+                of 0wx00000000 : Word32.word
+                  => Store(mem, aligned_address,
+                           Word32.orb(Word32.andb(0wxFFFFFF00 : Word32.word,
+                                                  s_word),
+                                      Word32.<<(Word32.andb(0wx000000FF : 
+                                                            Word32.word,
+                                                            data),
+                                                0wx0000)))
+                 | 0wx00000008 : Word32.word
+                  => Store(mem, aligned_address,
+                           Word32.orb(Word32.andb(0wxFFFF00FF : Word32.word,
+                                                  s_word),
+                                      Word32.<<(Word32.andb(0wx000000FF : 
+                                                            Word32.word,
+                                                            data),
+                                                0wx0008)))
+                 | 0wx00000010 : Word32.word
+                  => Store(mem, aligned_address,
+                           Word32.orb(Word32.andb(0wxFF00FFFF : Word32.word,
+                                                  s_word),
+                                      Word32.<<(Word32.andb(0wx000000FF : 
+                                                            Word32.word,
+                                                            data),
+                                                0wx0010)))
+                 | 0wx00000018 : Word32.word
+                  => Store(mem, aligned_address,
+                           Word32.orb(Word32.andb(0wx00FFFFFF : Word32.word,
+                                                  s_word),
+                                      Word32.<<(Word32.andb(0wx000000FF : 
+                                                            Word32.word,
+                                                            data),
+                                                0wx0018)))
+                 | _ => (print "Error SB: Memory unchanged\n";
+                         mem)
+            end;
 
       fun GetStatistics ((cac, (rh, rm, wh, wm)), mem)
-	  = let
+          = let
 
-	      val th = rh + wh;
-		
-	      val tm = rm + wm;
+              val th = rh + wh;
+                
+              val tm = rm + wm;
 
-	      val who = case WriteHit
-			  of Write_Through => "Write Through"
-			   | Write_Back => "Write Back";
+              val who = case WriteHit
+                          of Write_Through => "Write Through"
+                           | Write_Back => "Write Back";
 
-	      val wmo = case WriteMiss
-			  of Write_Allocate => "Write Allocate"
-			   | Write_No_Allocate => "Write No Allocate";
+              val wmo = case WriteMiss
+                          of Write_Allocate => "Write Allocate"
+                           | Write_No_Allocate => "Write No Allocate";
 
-	    in
-	      CacheName ^ " :\n" ^
-	      "CacheSize : " ^ (Int.toString CacheSize) ^ "\n" ^
-	      "BlockSize : " ^ (Int.toString BlockSize) ^ "\n" ^
-	      "Associativity : " ^ (Int.toString Associativity) ^ "\n" ^
-	      "Write Hit : " ^ who ^ "\n" ^
-	      "Write Miss : " ^ wmo ^ "\n" ^
-	      "Read hits : " ^ (Int.toString rh) ^ "\n" ^
-	      "Read misses : " ^ (Int.toString rm) ^ "\n" ^
-	      "Write hits : " ^ (Int.toString wh) ^ "\n" ^
-	      "Write misses : " ^ (Int.toString wm) ^ "\n" ^
-	      "Total hits : " ^ (Int.toString th) ^ "\n" ^
-	      "Total misses : " ^ (Int.toString tm) ^ "\n" ^
-	      (MEM.GetStatistics mem)
-	    end;
+            in
+              CacheName ^ " :\n" ^
+              "CacheSize : " ^ (Int.toString CacheSize) ^ "\n" ^
+              "BlockSize : " ^ (Int.toString BlockSize) ^ "\n" ^
+              "Associativity : " ^ (Int.toString Associativity) ^ "\n" ^
+              "Write Hit : " ^ who ^ "\n" ^
+              "Write Miss : " ^ wmo ^ "\n" ^
+              "Read hits : " ^ (Int.toString rh) ^ "\n" ^
+              "Read misses : " ^ (Int.toString rm) ^ "\n" ^
+              "Write hits : " ^ (Int.toString wh) ^ "\n" ^
+              "Write misses : " ^ (Int.toString wm) ^ "\n" ^
+              "Total hits : " ^ (Int.toString th) ^ "\n" ^
+              "Total misses : " ^ (Int.toString tm) ^ "\n" ^
+              (MEM.GetStatistics mem)
+            end;
 
     end;
 
@@ -1843,7 +1843,7 @@
   
       val run_file : string -> unit;
       val run_prog : string list -> unit; 
-	
+        
     end;
 
 (*****************************************************************************)
@@ -1860,43 +1860,43 @@
  *)
 
 functor DLXSimulatorFun (structure RF : REGISTERFILE; 
-			 structure ALU : ALU;
-			 structure MEM : MEMORY; ) : DLXSIMULATOR
+                         structure ALU : ALU;
+                         structure MEM : MEMORY; ) : DLXSIMULATOR
   = struct
-		
+                
       (*
        * The datatype Opcode provides a means of differentiating *
        * among the main opcodes.
        *)
       datatype Opcode = 
-	(* for R-type opcodes *)
-	SPECIAL |
-	(* I-type opcodes *)
-	BEQZ | BNEZ |
-	ADDI | ADDUI | SUBI | SUBUI |
-	ANDI | ORI | XORI |
-	LHI |
-	SLLI | SRLI | SRAI | 
-	SEQI | SNEI | SLTI | SGTI | SLEI | SGEI |
-	LB | LBU | SB |
-	LH | LHU | SH |
-	LW | SW |
-	(* J-type opcodes *)
-	J | JAL | TRAP | JR | JALR |
-	(* Unrecognized opcode *)
-	NON_OP; 
-	    
+        (* for R-type opcodes *)
+        SPECIAL |
+        (* I-type opcodes *)
+        BEQZ | BNEZ |
+        ADDI | ADDUI | SUBI | SUBUI |
+        ANDI | ORI | XORI |
+        LHI |
+        SLLI | SRLI | SRAI | 
+        SEQI | SNEI | SLTI | SGTI | SLEI | SGEI |
+        LB | LBU | SB |
+        LH | LHU | SH |
+        LW | SW |
+        (* J-type opcodes *)
+        J | JAL | TRAP | JR | JALR |
+        (* Unrecognized opcode *)
+        NON_OP; 
+            
       (*
        * The datatype RRFuncCode provides a means of 
        * differentiating among
        * the register-register function codes.
        *) 
       datatype RRFunctCode = NOP | SLL | SRL | SRA |
-	                     ADD | ADDU | SUB | SUBU |
-			     AND | OR | XOR |
-			     SEQ | SNE | SLT | SGT | SLE | SGE |
-			     NON_FUNCT;
-	    
+                             ADD | ADDU | SUB | SUBU |
+                             AND | OR | XOR |
+                             SEQ | SNE | SLT | SGT | SLE | SGE |
+                             NON_FUNCT;
+            
       (*
        * The datatype Instruction provides a means of
        * differentiating among the three different types of
@@ -1907,10 +1907,10 @@
        * An ILLEGAL causes the simulator to end.
        *)
       datatype Instruction 
-	= ITYPE of Opcode * int * int * Word32.word
+        = ITYPE of Opcode * int * int * Word32.word
         | RTYPE of Opcode * int * int * int * int * RRFunctCode 
-	| JTYPE of Opcode * Word32.word 
-	| ILLEGAL;
+        | JTYPE of Opcode * Word32.word 
+        | ILLEGAL;
 
       (*
        * The value HALT is set to the DLX instruction TRAP #0,
@@ -1923,134 +1923,134 @@
        * I-type instruction.
        *)
       fun DecodeIType instr
-	  = let
-	      val opc = Word32.andb (Word32.>> (instr,
-						0wx001A),
-				     0wx0000003F : Word32.word);
-	      
-	      val opcode = case opc
-			     of 0wx00000004 : Word32.word => BEQZ
-			      | 0wx00000005 : Word32.word => BNEZ
-			      | 0wx00000008 : Word32.word => ADDI
-			      | 0wx00000009 : Word32.word => ADDUI
-			      | 0wx0000000A : Word32.word => SUBI
-			      | 0wx0000000B : Word32.word => SUBUI
-			      | 0wx0000000C : Word32.word => ANDI
-			      | 0wx0000000D : Word32.word => ORI
-			      | 0wx0000000E : Word32.word => XORI
-			      | 0wx0000000F : Word32.word => LHI
-			      | 0wx00000014 : Word32.word => SLLI
-			      | 0wx00000016 : Word32.word => SRLI
-			      | 0wx00000017 : Word32.word => SRAI
-			      | 0wx00000018 : Word32.word => SEQI
-			      | 0wx00000019 : Word32.word => SNEI
-			      | 0wx0000001A : Word32.word => SLTI
-			      | 0wx0000001B : Word32.word => SGTI
-			      | 0wx0000001C : Word32.word => SLEI
-			      | 0wx0000001D : Word32.word => SGEI
-			      | 0wx00000020 : Word32.word => LB
-			      | 0wx00000024 : Word32.word => LBU
-			      | 0wx00000028 : Word32.word => SB
-			      | 0wx00000021 : Word32.word => LH
-			      | 0wx00000025 : Word32.word => LHU
-			      | 0wx00000029 : Word32.word => SH
-			      | 0wx00000023 : Word32.word => LW
-			      | 0wx0000002B : Word32.word => SW
-			      | _ => (print "Error : Non I-Type opcode\n";
-				      NON_OP);
-			     
-	      val rs1 = Word32.toInt(Word32.andb (Word32.>> (instr, 0wx0015),
-						  0wx0000001F : Word32.word));
-		    
-	      val rd = Word32.toInt(Word32.andb (Word32.>> (instr, 0wx0010),
-						 0wx0000001F : Word32.word));
-		    
-	      val immediate = Word32.~>> (Word32.<< (instr, 0wx0010),
-					  0wx0010);
+          = let
+              val opc = Word32.andb (Word32.>> (instr,
+                                                0wx001A),
+                                     0wx0000003F : Word32.word);
+              
+              val opcode = case opc
+                             of 0wx00000004 : Word32.word => BEQZ
+                              | 0wx00000005 : Word32.word => BNEZ
+                              | 0wx00000008 : Word32.word => ADDI
+                              | 0wx00000009 : Word32.word => ADDUI
+                              | 0wx0000000A : Word32.word => SUBI
+                              | 0wx0000000B : Word32.word => SUBUI
+                              | 0wx0000000C : Word32.word => ANDI
+                              | 0wx0000000D : Word32.word => ORI
+                              | 0wx0000000E : Word32.word => XORI
+                              | 0wx0000000F : Word32.word => LHI
+                              | 0wx00000014 : Word32.word => SLLI
+                              | 0wx00000016 : Word32.word => SRLI
+                              | 0wx00000017 : Word32.word => SRAI
+                              | 0wx00000018 : Word32.word => SEQI
+                              | 0wx00000019 : Word32.word => SNEI
+                              | 0wx0000001A : Word32.word => SLTI
+                              | 0wx0000001B : Word32.word => SGTI
+                              | 0wx0000001C : Word32.word => SLEI
+                              | 0wx0000001D : Word32.word => SGEI
+                              | 0wx00000020 : Word32.word => LB
+                              | 0wx00000024 : Word32.word => LBU
+                              | 0wx00000028 : Word32.word => SB
+                              | 0wx00000021 : Word32.word => LH
+                              | 0wx00000025 : Word32.word => LHU
+                              | 0wx00000029 : Word32.word => SH
+                              | 0wx00000023 : Word32.word => LW
+                              | 0wx0000002B : Word32.word => SW
+                              | _ => (print "Error : Non I-Type opcode\n";
+                                      NON_OP);
+                             
+              val rs1 = Word32.toInt(Word32.andb (Word32.>> (instr, 0wx0015),
+                                                  0wx0000001F : Word32.word));
+                    
+              val rd = Word32.toInt(Word32.andb (Word32.>> (instr, 0wx0010),
+                                                 0wx0000001F : Word32.word));
+                    
+              val immediate = Word32.~>> (Word32.<< (instr, 0wx0010),
+                                          0wx0010);
 
-	    in
-	      if opcode = NON_OP
-		then ILLEGAL
-	        else ITYPE (opcode, rs1, rd, immediate)
-	    end;
-	    
+            in
+              if opcode = NON_OP
+                then ILLEGAL
+                else ITYPE (opcode, rs1, rd, immediate)
+            end;
+            
       (*
        * The function DecodeRType decodes a Word32.word into an
        * R-type instruction.
        *)
       fun DecodeRType instr
-	  = let
-		
-	      val rs1 = Word32.toInt (Word32.andb (Word32.>> (instr, 0wx0015),
-						   0wx0000001F : Word32.word));
-		
-	      val rs2 = Word32.toInt (Word32.andb (Word32.>> (instr, 0wx0010),
-						   0wx0000001F : Word32.word));
-		
-	      val rd = Word32.toInt (Word32.andb (Word32.>> (instr, 0wx000B),
-						  0wx0000001F : Word32.word));
-		
-	      val shamt 
-		  = Word32.toInt (Word32.andb (Word32.>> (instr, 0wx0006),
-					       0wx0000001F : Word32.word));
-		    
-	      val funct = Word32.andb (instr, 0wx0000003F : Word32.word);
-		    
-	      val functcode = case funct
-				of 0wx00000000 : Word32.word => NOP
-				 | 0wx00000004 : Word32.word => SLL
-				 | 0wx00000006 : Word32.word => SRL
-				 | 0wx00000007 : Word32.word => SRA
-				 | 0wx00000020 : Word32.word => ADD
-				 | 0wx00000021 : Word32.word => ADDU
-				 | 0wx00000022 : Word32.word => SUB
-				 | 0wx00000023 : Word32.word => SUBU
-				 | 0wx00000024 : Word32.word => AND
-				 | 0wx00000025 : Word32.word => OR
-				 | 0wx00000026 : Word32.word => XOR
-				 | 0wx00000028 : Word32.word => SEQ
-				 | 0wx00000029 : Word32.word => SNE
-				 | 0wx0000002A : Word32.word => SLT
-				 | 0wx0000002B : Word32.word => SGT
-				 | 0wx0000002C : Word32.word => SLE
-				 | 0wx0000002D : Word32.word => SGE
-				 | _ => (print "Error : Non R-type funct\n";
-					 NON_FUNCT);
-				     
-	    in
-	      if functcode = NON_FUNCT
-		then ILLEGAL
-	        else RTYPE (SPECIAL, rs1, rs2, rd, shamt, functcode)
-	    end;
-	    
+          = let
+                
+              val rs1 = Word32.toInt (Word32.andb (Word32.>> (instr, 0wx0015),
+                                                   0wx0000001F : Word32.word));
+                
+              val rs2 = Word32.toInt (Word32.andb (Word32.>> (instr, 0wx0010),
+                                                   0wx0000001F : Word32.word));
+                
+              val rd = Word32.toInt (Word32.andb (Word32.>> (instr, 0wx000B),
+                                                  0wx0000001F : Word32.word));
+                
+              val shamt 
+                  = Word32.toInt (Word32.andb (Word32.>> (instr, 0wx0006),
+                                               0wx0000001F : Word32.word));
+                    
+              val funct = Word32.andb (instr, 0wx0000003F : Word32.word);
+                    
+              val functcode = case funct
+                                of 0wx00000000 : Word32.word => NOP
+                                 | 0wx00000004 : Word32.word => SLL
+                                 | 0wx00000006 : Word32.word => SRL
+                                 | 0wx00000007 : Word32.word => SRA
+                                 | 0wx00000020 : Word32.word => ADD
+                                 | 0wx00000021 : Word32.word => ADDU
+                                 | 0wx00000022 : Word32.word => SUB
+                                 | 0wx00000023 : Word32.word => SUBU
+                                 | 0wx00000024 : Word32.word => AND
+                                 | 0wx00000025 : Word32.word => OR
+                                 | 0wx00000026 : Word32.word => XOR
+                                 | 0wx00000028 : Word32.word => SEQ
+                                 | 0wx00000029 : Word32.word => SNE
+                                 | 0wx0000002A : Word32.word => SLT
+                                 | 0wx0000002B : Word32.word => SGT
+                                 | 0wx0000002C : Word32.word => SLE
+                                 | 0wx0000002D : Word32.word => SGE
+                                 | _ => (print "Error : Non R-type funct\n";
+                                         NON_FUNCT);
+                                     
+            in
+              if functcode = NON_FUNCT
+                then ILLEGAL
+                else RTYPE (SPECIAL, rs1, rs2, rd, shamt, functcode)
+            end;
+            
       (*
        * The function DecodeJType decodes a Word32.word into an
        * J-type instruction.
        *)
       fun DecodeJType instr 
-	  = let
+          = let
 
-	      val opc = Word32.andb (Word32.>> (instr, 0wx1A),
-				     0wx0000003F : Word32.word);
-		    
-	      val opcode = case opc
-			     of 0wx00000002 : Word32.word => J
-			      | 0wx00000003 : Word32.word => JAL
-			      | 0wx00000011 : Word32.word => TRAP
-			      | 0wx00000012 : Word32.word => JR
-			      | 0wx00000013 : Word32.word => JALR
-			      | _ => (print "Error : Non J-type opcode\n";
-				      NON_OP);
-				  
-	      val offset = Word32.~>> (Word32.<< (instr, 0wx0006),
-				       0wx0006);
+              val opc = Word32.andb (Word32.>> (instr, 0wx1A),
+                                     0wx0000003F : Word32.word);
+                    
+              val opcode = case opc
+                             of 0wx00000002 : Word32.word => J
+                              | 0wx00000003 : Word32.word => JAL
+                              | 0wx00000011 : Word32.word => TRAP
+                              | 0wx00000012 : Word32.word => JR
+                              | 0wx00000013 : Word32.word => JALR
+                              | _ => (print "Error : Non J-type opcode\n";
+                                      NON_OP);
+                                  
+              val offset = Word32.~>> (Word32.<< (instr, 0wx0006),
+                                       0wx0006);
 
-	    in
-		if opcode = NON_OP
-		    then ILLEGAL
-		    else JTYPE (opcode, offset)
-	    end;
-	    
+            in
+                if opcode = NON_OP
+                    then ILLEGAL
+                    else JTYPE (opcode, offset)
+            end;
+            
       (*
        * The function DecodeInstr decodes a Word32.word into an
        * instruction.  It first checks the opcode, and then calls 
@@ -2058,49 +2058,49 @@
        * complete the decoding process.
        *)
       fun DecodeInstr instr
-	  = let
+          = let
 
-	      val opcode = Word32.andb (Word32.>> (instr, 0wx1A),
-					0wx0000003F : Word32.word);
-		
-	    in
-	      case opcode
-		of 0wx00000000 : Word32.word => DecodeRType instr
-		 | 0wx00000002 : Word32.word => DecodeJType instr
-		 | 0wx00000003 : Word32.word => DecodeJType instr
-		 | 0wx00000004 : Word32.word => DecodeIType instr
-		 | 0wx00000005 : Word32.word => DecodeIType instr
-		 | 0wx00000008 : Word32.word => DecodeIType instr
-		 | 0wx00000009 : Word32.word => DecodeIType instr
-		 | 0wx0000000A : Word32.word => DecodeIType instr
-		 | 0wx0000000B : Word32.word => DecodeIType instr
-		 | 0wx0000000C : Word32.word => DecodeIType instr
-		 | 0wx0000000D : Word32.word => DecodeIType instr
-		 | 0wx0000000E : Word32.word => DecodeIType instr
-		 | 0wx0000000F : Word32.word => DecodeIType instr
-		 | 0wx00000011 : Word32.word => DecodeJType instr
-		 | 0wx00000012 : Word32.word => DecodeJType instr
-		 | 0wx00000013 : Word32.word => DecodeJType instr
-		 | 0wx00000016 : Word32.word => DecodeIType instr
-		 | 0wx00000017 : Word32.word => DecodeIType instr
-		 | 0wx00000018 : Word32.word => DecodeIType instr
-		 | 0wx00000019 : Word32.word => DecodeIType instr
-		 | 0wx0000001A : Word32.word => DecodeIType instr
-		 | 0wx0000001B : Word32.word => DecodeIType instr
-		 | 0wx0000001C : Word32.word => DecodeIType instr
-		 | 0wx0000001D : Word32.word => DecodeIType instr
-		 | 0wx00000020 : Word32.word => DecodeIType instr
-		 | 0wx00000024 : Word32.word => DecodeIType instr
-		 | 0wx00000028 : Word32.word => DecodeIType instr
-		 | 0wx00000021 : Word32.word => DecodeIType instr
-		 | 0wx00000025 : Word32.word => DecodeIType instr
-		 | 0wx00000029 : Word32.word => DecodeIType instr
-		 | 0wx00000023 : Word32.word => DecodeIType instr
-		 | 0wx0000002B : Word32.word => DecodeIType instr
-		 | _ => (print "Error : Unrecognized opcode\n";
-			 ILLEGAL)
-	    end;
-	    
+              val opcode = Word32.andb (Word32.>> (instr, 0wx1A),
+                                        0wx0000003F : Word32.word);
+                
+            in
+              case opcode
+                of 0wx00000000 : Word32.word => DecodeRType instr
+                 | 0wx00000002 : Word32.word => DecodeJType instr
+                 | 0wx00000003 : Word32.word => DecodeJType instr
+                 | 0wx00000004 : Word32.word => DecodeIType instr
+                 | 0wx00000005 : Word32.word => DecodeIType instr
+                 | 0wx00000008 : Word32.word => DecodeIType instr
+                 | 0wx00000009 : Word32.word => DecodeIType instr
+                 | 0wx0000000A : Word32.word => DecodeIType instr
+                 | 0wx0000000B : Word32.word => DecodeIType instr
+                 | 0wx0000000C : Word32.word => DecodeIType instr
+                 | 0wx0000000D : Word32.word => DecodeIType instr
+                 | 0wx0000000E : Word32.word => DecodeIType instr
+                 | 0wx0000000F : Word32.word => DecodeIType instr
+                 | 0wx00000011 : Word32.word => DecodeJType instr
+                 | 0wx00000012 : Word32.word => DecodeJType instr
+                 | 0wx00000013 : Word32.word => DecodeJType instr
+                 | 0wx00000016 : Word32.word => DecodeIType instr
+                 | 0wx00000017 : Word32.word => DecodeIType instr
+                 | 0wx00000018 : Word32.word => DecodeIType instr
+                 | 0wx00000019 : Word32.word => DecodeIType instr
+                 | 0wx0000001A : Word32.word => DecodeIType instr
+                 | 0wx0000001B : Word32.word => DecodeIType instr
+                 | 0wx0000001C : Word32.word => DecodeIType instr
+                 | 0wx0000001D : Word32.word => DecodeIType instr
+                 | 0wx00000020 : Word32.word => DecodeIType instr
+                 | 0wx00000024 : Word32.word => DecodeIType instr
+                 | 0wx00000028 : Word32.word => DecodeIType instr
+                 | 0wx00000021 : Word32.word => DecodeIType instr
+                 | 0wx00000025 : Word32.word => DecodeIType instr
+                 | 0wx00000029 : Word32.word => DecodeIType instr
+                 | 0wx00000023 : Word32.word => DecodeIType instr
+                 | 0wx0000002B : Word32.word => DecodeIType instr
+                 | _ => (print "Error : Unrecognized opcode\n";
+                         ILLEGAL)
+            end;
+            
 
       (*
        * The function PerformIType performs one of the I-Type
@@ -2108,228 +2108,228 @@
        * ALU, and as such, call ALU.PerformAL.
        *)
       fun PerformIType ((BEQZ, rs1, rd, immediate), (PC, rf, mem)) 
-	= if (RF.LoadRegister(rf, rs1) = (0wx00000000 : Word32.word))
-	    then (Word32.fromInt (Int.+ (Word32.toIntX PC,
-						Word32.toIntX
-						(Word32.<< (immediate, 
-							    0wx0002)))),
-		  rf, mem)
-	    else (PC, rf, mem)
-	      
-	| PerformIType ((BNEZ, rs1, rd, immediate), (PC, rf, mem)) 
-	  = if not (RF.LoadRegister(rf, rs1) = (0wx00000000 : Word32.word))
-	      then (Word32.fromInt (Int.+ (Word32.toIntX PC,
-						  Word32.toIntX
-						  (Word32.<< (immediate,
-							      0wx0002)))),
-		    rf, mem)
-	      else (PC, rf, mem)
-	    
-	| PerformIType ((ADDI, rs1, rd, immediate), (PC, rf, mem))
-	  = (PC, 
-	     RF.StoreRegister(rf, rd, 
-			      ALU.PerformAL(ALU.ADD,
-					    RF.LoadRegister(rf, rs1),
-					    immediate)),
-	     mem)
+        = if (RF.LoadRegister(rf, rs1) = (0wx00000000 : Word32.word))
+            then (Word32.fromInt (Int.+ (Word32.toIntX PC,
+                                                Word32.toIntX
+                                                (Word32.<< (immediate, 
+                                                            0wx0002)))),
+                  rf, mem)
+            else (PC, rf, mem)
+              
+        | PerformIType ((BNEZ, rs1, rd, immediate), (PC, rf, mem)) 
+          = if not (RF.LoadRegister(rf, rs1) = (0wx00000000 : Word32.word))
+              then (Word32.fromInt (Int.+ (Word32.toIntX PC,
+                                                  Word32.toIntX
+                                                  (Word32.<< (immediate,
+                                                              0wx0002)))),
+                    rf, mem)
+              else (PC, rf, mem)
+            
+        | PerformIType ((ADDI, rs1, rd, immediate), (PC, rf, mem))
+          = (PC, 
+             RF.StoreRegister(rf, rd, 
+                              ALU.PerformAL(ALU.ADD,
+                                            RF.LoadRegister(rf, rs1),
+                                            immediate)),
+             mem)
 
-	| PerformIType ((ADDUI, rs1, rd, immediate), (PC, rf, mem))
-	  = (PC,
-	     RF.StoreRegister(rf, rd, 
-			      ALU.PerformAL(ALU.ADDU,
-					    RF.LoadRegister(rf, rs1),
-					    immediate)),
-	     mem)
-	    
-	| PerformIType ((SUBI, rs1, rd, immediate), (PC, rf, mem))
-	  = (PC,
-	     RF.StoreRegister(rf, rd, 
-			      ALU.PerformAL(ALU.SUB,
-					    RF.LoadRegister(rf, rs1),
-					    immediate)),
-	     mem)
+        | PerformIType ((ADDUI, rs1, rd, immediate), (PC, rf, mem))
+          = (PC,
+             RF.StoreRegister(rf, rd, 
+                              ALU.PerformAL(ALU.ADDU,
+                                            RF.LoadRegister(rf, rs1),
+                                            immediate)),
+             mem)
+            
+        | PerformIType ((SUBI, rs1, rd, immediate), (PC, rf, mem))
+          = (PC,
+             RF.StoreRegister(rf, rd, 
+                              ALU.PerformAL(ALU.SUB,
+                                            RF.LoadRegister(rf, rs1),
+                                            immediate)),
+             mem)
 
-	| PerformIType ((SUBUI, rs1, rd, immediate), (PC, rf, mem)) 
-	  = (PC,
-	     RF.StoreRegister(rf, rd, 
-			      ALU.PerformAL(ALU.SUBU,
-					    RF.LoadRegister(rf, rs1),
-					    immediate)),
-	     mem)
-	    
-	| PerformIType ((ANDI, rs1, rd, immediate), (PC, rf, mem)) 
-	  = (PC,
-	     RF.StoreRegister(rf, rd, 
-			      ALU.PerformAL(ALU.AND,
-					    RF.LoadRegister(rf, rs1),
-					    immediate)),
-	     mem)
-	    
-	| PerformIType ((ORI, rs1, rd, immediate), (PC, rf, mem)) 
-	  = (PC,
-	     RF.StoreRegister(rf, rd, 
-			      ALU.PerformAL(ALU.OR,
-					    RF.LoadRegister(rf, rs1),
-					    immediate)),
-	     mem)
-	  
-	| PerformIType ((XORI, rs1, rd, immediate), (PC, rf, mem)) 
-	  = (PC,
-	     RF.StoreRegister(rf, rd, 
-			      ALU.PerformAL(ALU.XOR,
-					    RF.LoadRegister(rf, rs1),
-					    immediate)),
-	     mem)
-		    
-	| PerformIType ((LHI, rs1, rd, immediate), (PC, rf, mem)) 
-	  = (PC, RF.StoreRegister(rf, rd, Word32.<< (immediate, 0wx0010)), mem)
+        | PerformIType ((SUBUI, rs1, rd, immediate), (PC, rf, mem)) 
+          = (PC,
+             RF.StoreRegister(rf, rd, 
+                              ALU.PerformAL(ALU.SUBU,
+                                            RF.LoadRegister(rf, rs1),
+                                            immediate)),
+             mem)
+            
+        | PerformIType ((ANDI, rs1, rd, immediate), (PC, rf, mem)) 
+          = (PC,
+             RF.StoreRegister(rf, rd, 
+                              ALU.PerformAL(ALU.AND,
+                                            RF.LoadRegister(rf, rs1),
+                                            immediate)),
+             mem)
+            
+        | PerformIType ((ORI, rs1, rd, immediate), (PC, rf, mem)) 
+          = (PC,
+             RF.StoreRegister(rf, rd, 
+                              ALU.PerformAL(ALU.OR,
+                                            RF.LoadRegister(rf, rs1),
+                                            immediate)),
+             mem)
+          
+        | PerformIType ((XORI, rs1, rd, immediate), (PC, rf, mem)) 
+          = (PC,
+             RF.StoreRegister(rf, rd, 
+                              ALU.PerformAL(ALU.XOR,
+                                            RF.LoadRegister(rf, rs1),
+                                            immediate)),
+             mem)
+                    
+        | PerformIType ((LHI, rs1, rd, immediate), (PC, rf, mem)) 
+          = (PC, RF.StoreRegister(rf, rd, Word32.<< (immediate, 0wx0010)), mem)
 
-	| PerformIType ((SLLI, rs1, rd, immediate), (PC, rf, mem))
-	  = (PC, RF.StoreRegister(rf, rd, 
-				  Word32.<< (RF.LoadRegister(rf, rs1),
-					     Word.fromLarge (Word32.toLarge immediate))),
-	     mem)
+        | PerformIType ((SLLI, rs1, rd, immediate), (PC, rf, mem))
+          = (PC, RF.StoreRegister(rf, rd, 
+                                  Word32.<< (RF.LoadRegister(rf, rs1),
+                                             Word.fromLarge (Word32.toLarge immediate))),
+             mem)
 
-	| PerformIType ((SRLI, rs1, rd, immediate), (PC, rf, mem))
-	  = (PC, RF.StoreRegister(rf, rd, 
-				  Word32.>> (RF.LoadRegister(rf, rs1),
-					     Word.fromLarge (Word32.toLarge immediate))),
-	     mem)
+        | PerformIType ((SRLI, rs1, rd, immediate), (PC, rf, mem))
+          = (PC, RF.StoreRegister(rf, rd, 
+                                  Word32.>> (RF.LoadRegister(rf, rs1),
+                                             Word.fromLarge (Word32.toLarge immediate))),
+             mem)
 
-	| PerformIType ((SRAI, rs1, rd, immediate), (PC, rf, mem))
-	  = (PC, RF.StoreRegister(rf, rd, 
-				  Word32.~>> (RF.LoadRegister(rf, rs1),
-					      Word.fromLarge (Word32.toLarge immediate))),
-	     mem)
+        | PerformIType ((SRAI, rs1, rd, immediate), (PC, rf, mem))
+          = (PC, RF.StoreRegister(rf, rd, 
+                                  Word32.~>> (RF.LoadRegister(rf, rs1),
+                                              Word.fromLarge (Word32.toLarge immediate))),
+             mem)
 
-	| PerformIType ((SEQI, rs1, rd, immediate), (PC, rf, mem))
-	  = (PC,
-	     RF.StoreRegister(rf, rd,
-			      ALU.PerformAL(ALU.SEQ,
-					    RF.LoadRegister(rf, rs1),
-					    immediate)),
-	     mem)
+        | PerformIType ((SEQI, rs1, rd, immediate), (PC, rf, mem))
+          = (PC,
+             RF.StoreRegister(rf, rd,
+                              ALU.PerformAL(ALU.SEQ,
+                                            RF.LoadRegister(rf, rs1),
+                                            immediate)),
+             mem)
 
-	| PerformIType ((SNEI, rs1, rd, immediate), (PC, rf, mem))
-	  = (PC,
-	     RF.StoreRegister(rf, rd,
-			      ALU.PerformAL(ALU.SNE,
-					    RF.LoadRegister(rf, rs1),
-					    immediate)),
-	     mem)
+        | PerformIType ((SNEI, rs1, rd, immediate), (PC, rf, mem))
+          = (PC,
+             RF.StoreRegister(rf, rd,
+                              ALU.PerformAL(ALU.SNE,
+                                            RF.LoadRegister(rf, rs1),
+                                            immediate)),
+             mem)
 
-	| PerformIType ((SLTI, rs1, rd, immediate), (PC, rf, mem))
-	  = (PC,
-	     RF.StoreRegister(rf, rd,
-			      ALU.PerformAL(ALU.SLT,
-					    RF.LoadRegister(rf, rs1),
-					    immediate)),
-	     mem)
+        | PerformIType ((SLTI, rs1, rd, immediate), (PC, rf, mem))
+          = (PC,
+             RF.StoreRegister(rf, rd,
+                              ALU.PerformAL(ALU.SLT,
+                                            RF.LoadRegister(rf, rs1),
+                                            immediate)),
+             mem)
 
-	| PerformIType ((SGTI, rs1, rd, immediate), (PC, rf, mem))
-	  = (PC,
-	     RF.StoreRegister(rf, rd,
-			      ALU.PerformAL(ALU.SGT,
-					    RF.LoadRegister(rf, rs1),
-					    immediate)),
-	     mem)
+        | PerformIType ((SGTI, rs1, rd, immediate), (PC, rf, mem))
+          = (PC,
+             RF.StoreRegister(rf, rd,
+                              ALU.PerformAL(ALU.SGT,
+                                            RF.LoadRegister(rf, rs1),
+                                            immediate)),
+             mem)
 
-	| PerformIType ((SLEI, rs1, rd, immediate), (PC, rf, mem))
-	  = (PC,
-	     RF.StoreRegister(rf, rd,
-			      ALU.PerformAL(ALU.SLE,
-					    RF.LoadRegister(rf, rs1),
-					    immediate)),
-	     mem)
+        | PerformIType ((SLEI, rs1, rd, immediate), (PC, rf, mem))
+          = (PC,
+             RF.StoreRegister(rf, rd,
+                              ALU.PerformAL(ALU.SLE,
+                                            RF.LoadRegister(rf, rs1),
+                                            immediate)),
+             mem)
 
-	| PerformIType ((SGEI, rs1, rd, immediate), (PC, rf, mem))
-	  = (PC,
-	     RF.StoreRegister(rf, rd,
-			      ALU.PerformAL(ALU.SGE,
-					    RF.LoadRegister(rf, rs1),
-					    immediate)),
-	     mem)
-	  
-	| PerformIType ((LB, rs1, rd, immediate), (PC, rf, mem))
-	  = let
-	      val (nmem, l_byte)
-		  = MEM.LoadByte(mem, Word32.+ (RF.LoadRegister(rf, rs1),
-						immediate));
-	    in
-	      (PC,
-	       RF.StoreRegister(rf, rd, l_byte),
-	       nmem)
-	    end
+        | PerformIType ((SGEI, rs1, rd, immediate), (PC, rf, mem))
+          = (PC,
+             RF.StoreRegister(rf, rd,
+                              ALU.PerformAL(ALU.SGE,
+                                            RF.LoadRegister(rf, rs1),
+                                            immediate)),
+             mem)
+          
+        | PerformIType ((LB, rs1, rd, immediate), (PC, rf, mem))
+          = let
+              val (nmem, l_byte)
+                  = MEM.LoadByte(mem, Word32.+ (RF.LoadRegister(rf, rs1),
+                                                immediate));
+            in
+              (PC,
+               RF.StoreRegister(rf, rd, l_byte),
+               nmem)
+            end
 
-	| PerformIType ((LBU, rs1, rd, immediate), (PC, rf, mem))
-	  = let
-	      val (nmem, l_byte)
-		  = MEM.LoadByteU(mem, Word32.+ (RF.LoadRegister(rf, rs1),
-						 immediate));
-	    in
-	      (PC,
-	       RF.StoreRegister(rf, rd, l_byte),
-	       nmem)
-	    end
-	  
-	| PerformIType ((SB, rs1, rd, immediate), (PC, rf, mem))
-	  = (PC,
-	     rf,
-	     MEM.StoreByte(mem, 
-			   Word32.+ (RF.LoadRegister(rf, rs1), immediate),
-			   Word32.andb(0wx000000FF, RF.LoadRegister(rf, rd))))
-	    
-	| PerformIType ((LH, rs1, rd, immediate), (PC, rf, mem))
-	  = let
-	      val (nmem, l_hword)
-		  = MEM.LoadHWord(mem, Word32.+ (RF.LoadRegister(rf, rs1),
-						 immediate));
-	    in
-	      (PC,
-	       RF.StoreRegister(rf, rd, l_hword),
-	       nmem)
-	    end
+        | PerformIType ((LBU, rs1, rd, immediate), (PC, rf, mem))
+          = let
+              val (nmem, l_byte)
+                  = MEM.LoadByteU(mem, Word32.+ (RF.LoadRegister(rf, rs1),
+                                                 immediate));
+            in
+              (PC,
+               RF.StoreRegister(rf, rd, l_byte),
+               nmem)
+            end
+          
+        | PerformIType ((SB, rs1, rd, immediate), (PC, rf, mem))
+          = (PC,
+             rf,
+             MEM.StoreByte(mem, 
+                           Word32.+ (RF.LoadRegister(rf, rs1), immediate),
+                           Word32.andb(0wx000000FF, RF.LoadRegister(rf, rd))))
+            
+        | PerformIType ((LH, rs1, rd, immediate), (PC, rf, mem))
+          = let
+              val (nmem, l_hword)
+                  = MEM.LoadHWord(mem, Word32.+ (RF.LoadRegister(rf, rs1),
+                                                 immediate));
+            in
+              (PC,
+               RF.StoreRegister(rf, rd, l_hword),
+               nmem)
+            end
 
-	| PerformIType ((LHU, rs1, rd, immediate), (PC, rf, mem))
-	  = let
-	      val (nmem, l_hword)
-		  = MEM.LoadHWordU(mem, Word32.+ (RF.LoadRegister(rf, rs1),
-						  immediate));
-	    in
-	      (PC,
-	       RF.StoreRegister(rf, rd, l_hword),
-	       nmem)
-	    end
-	  
-	| PerformIType ((SH, rs1, rd, immediate), (PC, rf, mem))
-	  = (PC,
-	     rf,
-	     MEM.StoreByte(mem, 
-			   Word32.+ (RF.LoadRegister(rf, rs1), immediate),
-			   Word32.andb(0wx0000FFFF, RF.LoadRegister(rf, rd))))
-	    
+        | PerformIType ((LHU, rs1, rd, immediate), (PC, rf, mem))
+          = let
+              val (nmem, l_hword)
+                  = MEM.LoadHWordU(mem, Word32.+ (RF.LoadRegister(rf, rs1),
+                                                  immediate));
+            in
+              (PC,
+               RF.StoreRegister(rf, rd, l_hword),
+               nmem)
+            end
+          
+        | PerformIType ((SH, rs1, rd, immediate), (PC, rf, mem))
+          = (PC,
+             rf,
+             MEM.StoreByte(mem, 
+                           Word32.+ (RF.LoadRegister(rf, rs1), immediate),
+                           Word32.andb(0wx0000FFFF, RF.LoadRegister(rf, rd))))
+            
 
-	| PerformIType ((LW, rs1, rd, immediate), (PC, rf, mem)) 
-	  = let
-	      val (nmem, l_word) 
-		  = MEM.LoadWord(mem, Word32.+ (RF.LoadRegister(rf, rs1),
-						immediate));
-	    in
-	      (PC,
-	       RF.StoreRegister(rf, rd, l_word),
-	       nmem)
-	    end
+        | PerformIType ((LW, rs1, rd, immediate), (PC, rf, mem)) 
+          = let
+              val (nmem, l_word) 
+                  = MEM.LoadWord(mem, Word32.+ (RF.LoadRegister(rf, rs1),
+                                                immediate));
+            in
+              (PC,
+               RF.StoreRegister(rf, rd, l_word),
+               nmem)
+            end
 
-	| PerformIType ((SW, rs1, rd, immediate), (PC, rf, mem)) 
-	  = (PC,
-	     rf,
-	     MEM.StoreWord(mem,
-			   Word32.+ (RF.LoadRegister(rf, rs1), immediate),
-			   RF.LoadRegister(rf, rd)))
-	    
-	| PerformIType ((_, rs1, rd, immediate), (PC, rf, mem)) 
-	  = (print "Error : Non I-Type opcode, performing NOP\n";
-	     (PC, rf, mem));
+        | PerformIType ((SW, rs1, rd, immediate), (PC, rf, mem)) 
+          = (PC,
+             rf,
+             MEM.StoreWord(mem,
+                           Word32.+ (RF.LoadRegister(rf, rs1), immediate),
+                           RF.LoadRegister(rf, rd)))
+            
+        | PerformIType ((_, rs1, rd, immediate), (PC, rf, mem)) 
+          = (print "Error : Non I-Type opcode, performing NOP\n";
+             (PC, rf, mem));
 
 
       (*
@@ -2338,219 +2338,219 @@
        * ALU, and as such, call ALU.PerformAL.
        *)
       fun PerformRType ((SPECIA, rs1, rs2, rd, shamt, NOP), (PC, rf, mem))
-	  = (PC, rf, mem)
+          = (PC, rf, mem)
 
-	| PerformRType ((SPECIAL, rs1, rs2, rd, shamt, SLL), (PC, rf, mem)) 
-	  = (PC,
-	     RF.StoreRegister(rf, rd,
-			      ALU.PerformAL(ALU.SLL,
-					    RF.LoadRegister(rf, rs1),
-					    RF.LoadRegister(rf, rs2))),
-	     mem)
+        | PerformRType ((SPECIAL, rs1, rs2, rd, shamt, SLL), (PC, rf, mem)) 
+          = (PC,
+             RF.StoreRegister(rf, rd,
+                              ALU.PerformAL(ALU.SLL,
+                                            RF.LoadRegister(rf, rs1),
+                                            RF.LoadRegister(rf, rs2))),
+             mem)
 
-	| PerformRType ((SPECIAL, rs1, rs2, rd, shamt, SRL), (PC, rf, mem)) 
-	  = (PC,
-	     RF.StoreRegister(rf, rd,
-			      ALU.PerformAL(ALU.SRL,
-					    RF.LoadRegister(rf, rs1),
-					    RF.LoadRegister(rf, rs2))),
-	     mem)
+        | PerformRType ((SPECIAL, rs1, rs2, rd, shamt, SRL), (PC, rf, mem)) 
+          = (PC,
+             RF.StoreRegister(rf, rd,
+                              ALU.PerformAL(ALU.SRL,
+                                            RF.LoadRegister(rf, rs1),
+                                            RF.LoadRegister(rf, rs2))),
+             mem)
 
-	| PerformRType ((SPECIAL, rs1, rs2, rd, shamt, SRA), (PC, rf, mem)) 
-	  = (PC,
-	     RF.StoreRegister(rf, rd,
-			      ALU.PerformAL(ALU.SRA,
-					    RF.LoadRegister(rf, rs1),
-					    RF.LoadRegister(rf, rs2))),
-	     mem)
+        | PerformRType ((SPECIAL, rs1, rs2, rd, shamt, SRA), (PC, rf, mem)) 
+          = (PC,
+             RF.StoreRegister(rf, rd,
+                              ALU.PerformAL(ALU.SRA,
+                                            RF.LoadRegister(rf, rs1),
+                                            RF.LoadRegister(rf, rs2))),
+             mem)
 
-	| PerformRType ((SPECIAL, rs1, rs2, rd, shamt, ADD), (PC, rf, mem)) 
-	  = (PC,
-	     RF.StoreRegister(rf, rd,
-			      ALU.PerformAL(ALU.ADD,
-					    RF.LoadRegister(rf, rs1),
-					    RF.LoadRegister(rf, rs2))),
-	     mem)
+        | PerformRType ((SPECIAL, rs1, rs2, rd, shamt, ADD), (PC, rf, mem)) 
+          = (PC,
+             RF.StoreRegister(rf, rd,
+                              ALU.PerformAL(ALU.ADD,
+                                            RF.LoadRegister(rf, rs1),
+                                            RF.LoadRegister(rf, rs2))),
+             mem)
 
-	| PerformRType ((SPECIAL, rs1, rs2, rd, shamt, ADDU), (PC, rf, mem)) 
-	  = (PC,
-	     RF.StoreRegister(rf, rd,
-			      ALU.PerformAL(ALU.ADDU,
-					    RF.LoadRegister(rf, rs1),
-					    RF.LoadRegister(rf, rs2))),
-	     mem)
-	  
-	| PerformRType ((SPECIAL, rs1, rs2, rd, shamt, SUB), (PC, rf, mem)) 
-	  = (PC,
-	     RF.StoreRegister(rf, rd,
-			      ALU.PerformAL(ALU.SUB,
-					    RF.LoadRegister(rf, rs1),
-					    RF.LoadRegister(rf, rs2))),
-	     mem)
+        | PerformRType ((SPECIAL, rs1, rs2, rd, shamt, ADDU), (PC, rf, mem)) 
+          = (PC,
+             RF.StoreRegister(rf, rd,
+                              ALU.PerformAL(ALU.ADDU,
+                                            RF.LoadRegister(rf, rs1),
+                                            RF.LoadRegister(rf, rs2))),
+             mem)
+          
+        | PerformRType ((SPECIAL, rs1, rs2, rd, shamt, SUB), (PC, rf, mem)) 
+          = (PC,
+             RF.StoreRegister(rf, rd,
+                              ALU.PerformAL(ALU.SUB,
+                                            RF.LoadRegister(rf, rs1),
+                                            RF.LoadRegister(rf, rs2))),
+             mem)
 
-	| PerformRType ((SPECIAL, rs1, rs2, rd, shamt, SUBU), (PC, rf, mem)) 
-	  = (PC,
-	     RF.StoreRegister(rf, rd,
-			      ALU.PerformAL(ALU.SUBU,
-					    RF.LoadRegister(rf, rs1),
-					    RF.LoadRegister(rf, rs2))),
-	     mem)
-	  
-	| PerformRType ((SPECIAL, rs1, rs2, rd, shamt, AND), (PC, rf, mem))
-	  = (PC,
-	     RF.StoreRegister(rf, rd,
-			      ALU.PerformAL(ALU.AND,
-					    RF.LoadRegister(rf, rs1),
-					    RF.LoadRegister(rf, rs2))),
-	     mem)
-	  
-	| PerformRType ((SPECIAL, rs1, rs2, rd, shamt, OR), (PC, rf, mem)) 
-	  = (PC,
-	     RF.StoreRegister(rf, rd,
-			      ALU.PerformAL(ALU.OR,
-					    RF.LoadRegister(rf, rs1),
-					    RF.LoadRegister(rf, rs2))),
-	     mem)
-	  
-	| PerformRType ((SPECIAL, rs1, rs2, rd, shamt, XOR), (PC, rf, mem)) 
-	  = (PC,
-	     RF.StoreRegister(rf, rd,
-			      ALU.PerformAL(ALU.XOR,
-					    RF.LoadRegister(rf, rs1),
-					    RF.LoadRegister(rf, rs2))),
-	     mem)
-	  
-	| PerformRType ((SPECIAL, rs1, rs2, rd, shamt, SEQ), (PC, rf, mem)) 
-	  = (PC,
-	     RF.StoreRegister(rf, rd,
-			      ALU.PerformAL(ALU.SEQ,
-					    RF.LoadRegister(rf, rs1),
-					    RF.LoadRegister(rf, rs2))),
-	     mem)
-	  
-	| PerformRType ((SPECIAL, rs1, rs2, rd, shamt, SNE), (PC, rf, mem)) 
-	  = (PC,
-	     RF.StoreRegister(rf, rd,
-			      ALU.PerformAL(ALU.SNE,
-					    RF.LoadRegister(rf, rs1),
-					    RF.LoadRegister(rf, rs2))),
-	     mem)
-	  
-	| PerformRType ((SPECIAL, rs1, rs2, rd, shamt, SLT), (PC, rf, mem)) 
-	  = (PC,
-	     RF.StoreRegister(rf, rd,
-			      ALU.PerformAL(ALU.SLT,
-					    RF.LoadRegister(rf, rs1),
-					    RF.LoadRegister(rf, rs2))),
-	     mem)
-	  
-	| PerformRType ((SPECIAL, rs1, rs2, rd, shamt, SGT), (PC, rf, mem)) 
-	  = (PC,
-	     RF.StoreRegister(rf, rd,
-			      ALU.PerformAL(ALU.SGT,
-					    RF.LoadRegister(rf, rs1),
-					    RF.LoadRegister(rf, rs2))),
-	     mem)
-	  
-	| PerformRType ((SPECIAL, rs1, rs2, rd, shamt, SLE), (PC, rf, mem)) 
-	  = (PC,
-	     RF.StoreRegister(rf, rd,
-			      ALU.PerformAL(ALU.SLE,
-					    RF.LoadRegister(rf, rs1),
-					    RF.LoadRegister(rf, rs2))),
-	     mem)
-	  
-	| PerformRType ((SPECIAL, rs1, rs2, rd, shamt, SGE), (PC, rf, mem)) 
-	  = (PC,
-	     RF.StoreRegister(rf, rd,
-			      ALU.PerformAL(ALU.SGE,
-					    RF.LoadRegister(rf, rs1),
-					    RF.LoadRegister(rf, rs2))),
-	     mem)
-	  
-	| PerformRType ((_, rs1, rs2, rd, shamt, _), (PC, rf, mem)) 
-	  = (print "Error : Non R-Type opcode, performing NOP\n";
-	     (PC, rf, mem));
+        | PerformRType ((SPECIAL, rs1, rs2, rd, shamt, SUBU), (PC, rf, mem)) 
+          = (PC,
+             RF.StoreRegister(rf, rd,
+                              ALU.PerformAL(ALU.SUBU,
+                                            RF.LoadRegister(rf, rs1),
+                                            RF.LoadRegister(rf, rs2))),
+             mem)
+          
+        | PerformRType ((SPECIAL, rs1, rs2, rd, shamt, AND), (PC, rf, mem))
+          = (PC,
+             RF.StoreRegister(rf, rd,
+                              ALU.PerformAL(ALU.AND,
+                                            RF.LoadRegister(rf, rs1),
+                                            RF.LoadRegister(rf, rs2))),
+             mem)
+          
+        | PerformRType ((SPECIAL, rs1, rs2, rd, shamt, OR), (PC, rf, mem)) 
+          = (PC,
+             RF.StoreRegister(rf, rd,
+                              ALU.PerformAL(ALU.OR,
+                                            RF.LoadRegister(rf, rs1),
+                                            RF.LoadRegister(rf, rs2))),
+             mem)
+          
+        | PerformRType ((SPECIAL, rs1, rs2, rd, shamt, XOR), (PC, rf, mem)) 
+          = (PC,
+             RF.StoreRegister(rf, rd,
+                              ALU.PerformAL(ALU.XOR,
+                                            RF.LoadRegister(rf, rs1),
+                                            RF.LoadRegister(rf, rs2))),
+             mem)
+          
+        | PerformRType ((SPECIAL, rs1, rs2, rd, shamt, SEQ), (PC, rf, mem)) 
+          = (PC,
+             RF.StoreRegister(rf, rd,
+                              ALU.PerformAL(ALU.SEQ,
+                                            RF.LoadRegister(rf, rs1),
+                                            RF.LoadRegister(rf, rs2))),
+             mem)
+          
+        | PerformRType ((SPECIAL, rs1, rs2, rd, shamt, SNE), (PC, rf, mem)) 
+          = (PC,
+             RF.StoreRegister(rf, rd,
+                              ALU.PerformAL(ALU.SNE,
+                                            RF.LoadRegister(rf, rs1),
+                                            RF.LoadRegister(rf, rs2))),
+             mem)
+          
+        | PerformRType ((SPECIAL, rs1, rs2, rd, shamt, SLT), (PC, rf, mem)) 
+          = (PC,
+             RF.StoreRegister(rf, rd,
+                              ALU.PerformAL(ALU.SLT,
+                                            RF.LoadRegister(rf, rs1),
+                                            RF.LoadRegister(rf, rs2))),
+             mem)
+          
+        | PerformRType ((SPECIAL, rs1, rs2, rd, shamt, SGT), (PC, rf, mem)) 
+          = (PC,
+             RF.StoreRegister(rf, rd,
+                              ALU.PerformAL(ALU.SGT,
+                                            RF.LoadRegister(rf, rs1),
+                                            RF.LoadRegister(rf, rs2))),
+             mem)
+          
+        | PerformRType ((SPECIAL, rs1, rs2, rd, shamt, SLE), (PC, rf, mem)) 
+          = (PC,
+             RF.StoreRegister(rf, rd,
+                              ALU.PerformAL(ALU.SLE,
+                                            RF.LoadRegister(rf, rs1),
+                                            RF.LoadRegister(rf, rs2))),
+             mem)
+          
+        | PerformRType ((SPECIAL, rs1, rs2, rd, shamt, SGE), (PC, rf, mem)) 
+          = (PC,
+             RF.StoreRegister(rf, rd,
+                              ALU.PerformAL(ALU.SGE,
+                                            RF.LoadRegister(rf, rs1),
+                                            RF.LoadRegister(rf, rs2))),
+             mem)
+          
+        | PerformRType ((_, rs1, rs2, rd, shamt, _), (PC, rf, mem)) 
+          = (print "Error : Non R-Type opcode, performing NOP\n";
+             (PC, rf, mem));
 
-	  
+          
       (*
        * The function PerformJType performs one of the J-Type
        * instructions.
        *)
       fun PerformJType ((J, offset), (PC, rf, mem)) 
-	  = (Word32.fromInt (Int.+ (Word32.toIntX PC,
-					   Word32.toIntX 
-					   (Word32.<< (offset, 0wx0002)))), 
-	     rf, mem)
-	  
-	| PerformJType ((JR, offset), (PC, rf, mem)) 
-	  = (RF.LoadRegister(rf,
-			     Word32.toInt(Word32.andb (Word32.>> (offset,
-								  0wx0015),
-						       0wx0000001F : 
-						       Word32.word))),
-	     rf, mem)
-	  
-	| PerformJType ((JAL, offset), (PC, rf, mem)) 
-	  = (Word32.fromInt (Int.+ (Word32.toIntX PC,
-					   Word32.toIntX 
-					   (Word32.<< (offset, 0wx0002)))),
-	     RF.StoreRegister(rf, 31, PC), 
-	     mem)
-	  
-	| PerformJType ((JALR, offset), (PC, rf, mem)) 
-	  = (RF.LoadRegister(rf,
-			     Word32.toInt (Word32.andb (Word32.>> (offset,
-								   0wx0015),
-							0wx0000001F : 
-							Word32.word))),
-	     RF.StoreRegister(rf, 31, PC), 
-	     mem)
-	  
-	| PerformJType ((TRAP, 0wx00000003 : Word32.word), (PC, rf, mem)) 
-	  = let
-	      val x = TextIO.print "Value? ";
-	      val s = "10" (* TextIO.inputLine TextIO.stdIn; *)
-	      val i = Int.fromString s;
-	      val input = if isSome i
-			    then valOf i
-			    else (TextIO.print "Error : Returning 0\n";
-				  Int.fromInt 0);
-	    in
-	      (PC,
-	       RF.StoreRegister(rf, 14, Word32.fromInt input),
-	       mem)
-	    end
-	
-	| PerformJType ((TRAP, 0wx00000004 : Word32.word), (PC, rf, mem)) 
-	  = let
-	      val output =  Int.toString (Word32.toIntX 
-					       (RF.LoadRegister(rf, 14)));
+          = (Word32.fromInt (Int.+ (Word32.toIntX PC,
+                                           Word32.toIntX 
+                                           (Word32.<< (offset, 0wx0002)))), 
+             rf, mem)
+          
+        | PerformJType ((JR, offset), (PC, rf, mem)) 
+          = (RF.LoadRegister(rf,
+                             Word32.toInt(Word32.andb (Word32.>> (offset,
+                                                                  0wx0015),
+                                                       0wx0000001F : 
+                                                       Word32.word))),
+             rf, mem)
+          
+        | PerformJType ((JAL, offset), (PC, rf, mem)) 
+          = (Word32.fromInt (Int.+ (Word32.toIntX PC,
+                                           Word32.toIntX 
+                                           (Word32.<< (offset, 0wx0002)))),
+             RF.StoreRegister(rf, 31, PC), 
+             mem)
+          
+        | PerformJType ((JALR, offset), (PC, rf, mem)) 
+          = (RF.LoadRegister(rf,
+                             Word32.toInt (Word32.andb (Word32.>> (offset,
+                                                                   0wx0015),
+                                                        0wx0000001F : 
+                                                        Word32.word))),
+             RF.StoreRegister(rf, 31, PC), 
+             mem)
+          
+        | PerformJType ((TRAP, 0wx00000003 : Word32.word), (PC, rf, mem)) 
+          = let
+              val x = TextIO.print "Value? ";
+              val s = "10" (* TextIO.inputLine TextIO.stdIn; *)
+              val i = Int.fromString s;
+              val input = if isSome i
+                            then valOf i
+                            else (TextIO.print "Error : Returning 0\n";
+                                  Int.fromInt 0);
+            in
+              (PC,
+               RF.StoreRegister(rf, 14, Word32.fromInt input),
+               mem)
+            end
+        
+        | PerformJType ((TRAP, 0wx00000004 : Word32.word), (PC, rf, mem)) 
+          = let
+              val output =  Int.toString (Word32.toIntX 
+                                               (RF.LoadRegister(rf, 14)));
 
-	    in
-	      (TextIO.print ("Output: " ^ output ^ "\n");
-	       (PC, rf, mem))
-	    end
-	
-	| PerformJType ((_, offset), (PC, rf, mem)) 
-	  = (print "Error : Non J-Type opcode, performing NOP\n";
-	     (PC, rf, mem));
-	    
-	    
+            in
+              (TextIO.print ("Output: " ^ output ^ "\n");
+               (PC, rf, mem))
+            end
+        
+        | PerformJType ((_, offset), (PC, rf, mem)) 
+          = (print "Error : Non J-Type opcode, performing NOP\n";
+             (PC, rf, mem));
+            
+            
       (*
        * The function PerformInstr performs an instruction by
        * passing the instruction to the appropriate auxiliary function.
        *)
       fun PerformInstr (ITYPE instr, (PC, rf, mem))
-	  = PerformIType (instr, (PC, rf, mem))
-	| PerformInstr (RTYPE instr, (PC, rf, mem))
-	  = PerformRType (instr, (PC, rf, mem))
-	| PerformInstr (JTYPE instr, (PC, rf, mem))
-	  = PerformJType (instr, (PC, rf, mem))
-	| PerformInstr (ILLEGAL, (PC, rf, mem))
-	  = (PC, rf, mem);
+          = PerformIType (instr, (PC, rf, mem))
+        | PerformInstr (RTYPE instr, (PC, rf, mem))
+          = PerformRType (instr, (PC, rf, mem))
+        | PerformInstr (JTYPE instr, (PC, rf, mem))
+          = PerformJType (instr, (PC, rf, mem))
+        | PerformInstr (ILLEGAL, (PC, rf, mem))
+          = (PC, rf, mem);
 
-	    
+            
       (*
        * The function CycleLoop represents the basic clock cylce of
        * the DLX processor.  It takes as input the current program
@@ -2562,19 +2562,19 @@
        * the instruction.
        *)
       fun CycleLoop (PC, rf, mem)
-	  = let
-	      val (nmem, instr_word) = MEM.LoadWord (mem, PC);
-	      val instr = DecodeInstr instr_word;
-	      val nPC = Word32.+ (PC, 0wx00000004 : Word32.word);
-	    in
-	      if instr = HALT orelse instr = ILLEGAL
-		then (print "Program halted.\n"; 
-		      print (MEM.GetStatistics (nmem));
-		      ())
-	        else CycleLoop (PerformInstr (instr, (nPC, rf, nmem)))
-	    end
+          = let
+              val (nmem, instr_word) = MEM.LoadWord (mem, PC);
+              val instr = DecodeInstr instr_word;
+              val nPC = Word32.+ (PC, 0wx00000004 : Word32.word);
+            in
+              if instr = HALT orelse instr = ILLEGAL
+                then (print "Program halted.\n"; 
+                      print (MEM.GetStatistics (nmem));
+                      ())
+                else CycleLoop (PerformInstr (instr, (nPC, rf, nmem)))
+            end
 
-	
+        
       (*
        * The function LoadProgAux is an auxilary function that
        * assists in loading a program into memory.  It recursively
@@ -2582,28 +2582,28 @@
        * the address to which the next instruction is to be loaded.
        *)
       fun LoadProgAux ([], mem, address)
-	  = mem
-	| LoadProgAux (instrs::instr_list, mem, address)
-  	  = let
-	      val instro = Word32.fromString instrs;
-	      val instr = if isSome instro
-			    then valOf instro
-			    else (print ("Error : Invalid " ^ 
-					 "instruction format, " ^
-					 "returning NOP\n");
-				  0wx00000000 : Word32.word);
-	    in
-	      LoadProgAux (instr_list,
-			   MEM.StoreWord (mem, address, instr),
-			   Word32.+ (address, 0wx00000004 : Word32.word))
-	    end;
+          = mem
+        | LoadProgAux (instrs::instr_list, mem, address)
+          = let
+              val instro = Word32.fromString instrs;
+              val instr = if isSome instro
+                            then valOf instro
+                            else (print ("Error : Invalid " ^ 
+                                         "instruction format, " ^
+                                         "returning NOP\n");
+                                  0wx00000000 : Word32.word);
+            in
+              LoadProgAux (instr_list,
+                           MEM.StoreWord (mem, address, instr),
+                           Word32.+ (address, 0wx00000004 : Word32.word))
+            end;
 
       (*
        * The function LoadProg takes a list of instructions and memory, and
        * loads the file into memory, beginning at 0x10000.
        *)
       fun LoadProg (instr_list, mem)
-	  = LoadProgAux (instr_list, mem, 0wx00010000 : Word32.word);
+          = LoadProgAux (instr_list, mem, 0wx00010000 : Word32.word);
 
 
       (*
@@ -2611,9 +2611,9 @@
        * instructions in a file into a list.
        *)
       fun ReadFileToInstr file
-	 = (case TextIO.inputLine file of
-	       NONE => []
-	     | SOME l => l :: (ReadFileToInstr file));
+         = (case TextIO.inputLine file of
+               NONE => []
+             | SOME l => l :: (ReadFileToInstr file));
 
 
       (*
@@ -2624,9 +2624,9 @@
        * initialised memory.
        *)
       fun run_prog instructions
-	  = CycleLoop (0wx00010000 : Word32.word,
-		       RF.InitRegisterFile (),
-		       LoadProg (instructions, MEM.InitMemory ()));
+          = CycleLoop (0wx00010000 : Word32.word,
+                       RF.InitRegisterFile (),
+                       LoadProg (instructions, MEM.InitMemory ()));
 
       (*
        * The function run_file is exported by DLXSimulator.
@@ -2636,7 +2636,7 @@
        * initialized memory.
        *)
       fun run_file filename 
-	  = (run_prog o ReadFileToInstr) (TextIO.openIn filename);
+          = (run_prog o ReadFileToInstr) (TextIO.openIn filename);
 
     end;
 
@@ -2659,7 +2659,7 @@
 
       datatype WriteMissOption = Write_Allocate
                                | Write_No_Allocate;
-				 
+                                 
       val CacheName = "Level 1 Cache";
       val CacheSize = 256;
       val BlockSize = 4;
@@ -2672,151 +2672,151 @@
 
 structure L1Cache1 : MEMORY
   = CachedMemory (structure CS = L1CacheSpec1;
-		  structure MEM = Memory; );
+                  structure MEM = Memory; );
 
 
 structure DLXSimulatorC1 : DLXSIMULATOR
   = DLXSimulatorFun (structure RF = RegisterFile;
-		     structure ALU = ALU;
-		     structure MEM = L1Cache1; );
+                     structure ALU = ALU;
+                     structure MEM = L1Cache1; );
 
 (* Example programs *)
 
 val Simple = ["200E002F", 
-	      "44000004", 
-	      "44000000"];
+              "44000004", 
+              "44000000"];
 
 val Twos = ["44000003",
-	    "00000000",
-	    "3D00FFFF",
-	    "3508FFFF",
-	    "010E7026",
-	    "25CE0001",
-	    "44000004",
-	    "00000000",
-	    "44000000",
-	    "00000000"];
+            "00000000",
+            "3D00FFFF",
+            "3508FFFF",
+            "010E7026",
+            "25CE0001",
+            "44000004",
+            "00000000",
+            "44000000",
+            "00000000"];
 
 
 val Abs = ["44000003",
-	   "00000000",
-	   "01C0402A",
-	   "11000002",
-	   "00000000",
-	   "000E7022",
-	   "44000004",
-	   "00000000",
-	   "44000000",
-	   "00000000"]
+           "00000000",
+           "01C0402A",
+           "11000002",
+           "00000000",
+           "000E7022",
+           "44000004",
+           "00000000",
+           "44000000",
+           "00000000"]
 
 val Fact = ["0C000002",
-	    "00000000",
-	    "44000000",
-	    "44000003",
-	    "000E2020",
-	    "2FBD0020",
-	    "AFBF0014",
-	    "AFBE0010",
-	    "27BE0020",
-	    "0C000009",
-	    "00000000",
-	    "8FBE0010",
-	    "8FBF0014",
-	    "27BD0020",
-	    "00027020",
-	    "44000004",
-	    "00001020",
-	    "4BE00000",
-	    "00000000",
-	    "20080001",
-	    "0088402C",
-	    "11000004",
-	    "00000000",
-	    "20020001",
-	    "08000016",
-	    "00000000",
-	    "2FBD0004",
-	    "AFA40000",
-	    "28840001",
-	    "2FBD0020",
-	    "AFBF0014",
-	    "AFBE0010",
-	    "27BE0020",
-	    "0FFFFFF1",
-	    "00000000",
-	    "8FBE0010",
-	    "8FBF0014",
-	    "27BD0020",
-	    "8FA40000",
-	    "27BD0004",
-	    "00004020",
-	    "10800005",
-	    "00000000",
-	    "01024020",
-	    "28840001",
-	    "0BFFFFFB",
-	    "00000000",
-	    "01001020",
-	    "4BE00000",
-	    "00000000"];
+            "00000000",
+            "44000000",
+            "44000003",
+            "000E2020",
+            "2FBD0020",
+            "AFBF0014",
+            "AFBE0010",
+            "27BE0020",
+            "0C000009",
+            "00000000",
+            "8FBE0010",
+            "8FBF0014",
+            "27BD0020",
+            "00027020",
+            "44000004",
+            "00001020",
+            "4BE00000",
+            "00000000",
+            "20080001",
+            "0088402C",
+            "11000004",
+            "00000000",
+            "20020001",
+            "08000016",
+            "00000000",
+            "2FBD0004",
+            "AFA40000",
+            "28840001",
+            "2FBD0020",
+            "AFBF0014",
+            "AFBE0010",
+            "27BE0020",
+            "0FFFFFF1",
+            "00000000",
+            "8FBE0010",
+            "8FBF0014",
+            "27BD0020",
+            "8FA40000",
+            "27BD0004",
+            "00004020",
+            "10800005",
+            "00000000",
+            "01024020",
+            "28840001",
+            "0BFFFFFB",
+            "00000000",
+            "01001020",
+            "4BE00000",
+            "00000000"];
 
 val GCD = ["0C000002",
-	   "00000000",
-	   "44000000",
-	   "44000003",
-	   "00000000",
-	   "000E2020",
-	   "0080402A",
-	   "11000002",
-	   "00000000",
-	   "00042022",
-	   "44000003",
-	   "00000000",
-	   "000E2820",
-	   "00A0402A",
-	   "11000002",
-	   "00000000",
-	   "00052822",
-	   "2FBD0020",
-	   "AFBF0014",
-	   "AFBE0010",
-	   "27BE0020",
-	   "0C00000A",
-	   "00000000",
-	   "8FBE0010",
-	   "8FBF0014",
-	   "27BD0020",
-	   "00027020",
-	   "44000004",
-	   "00000000",
-	   "00001020",
-	   "4BE00000",
-	   "00000000",
-	   "14A00004",
-	   "00000000",
-	   "00801020",
-	   "08000013",
-	   "00000000",
-	   "0085402C",
-	   "15000006",
-	   "00000000",
-	   "00804020",
-	   "00A02020",
-	   "01002820",
-	   "08000002",
-	   "00000000",
-	   "00A42822",
-	   "2FBD0020",
-	   "AFBF0014",
-	   "AFBE0010",
-	   "27BE0020",
-	   "0FFFFFED",
-	   "00000000",
-	   "8FBE0010",
-	   "8FBF0014",
-	   "27BD0020",
-	   "4BE00000",
-	   "00000000"];
+           "00000000",
+           "44000000",
+           "44000003",
+           "00000000",
+           "000E2020",
+           "0080402A",
+           "11000002",
+           "00000000",
+           "00042022",
+           "44000003",
+           "00000000",
+           "000E2820",
+           "00A0402A",
+           "11000002",
+           "00000000",
+           "00052822",
+           "2FBD0020",
+           "AFBF0014",
+           "AFBE0010",
+           "27BE0020",
+           "0C00000A",
+           "00000000",
+           "8FBE0010",
+           "8FBF0014",
+           "27BD0020",
+           "00027020",
+           "44000004",
+           "00000000",
+           "00001020",
+           "4BE00000",
+           "00000000",
+           "14A00004",
+           "00000000",
+           "00801020",
+           "08000013",
+           "00000000",
+           "0085402C",
+           "15000006",
+           "00000000",
+           "00804020",
+           "00A02020",
+           "01002820",
+           "08000002",
+           "00000000",
+           "00A42822",
+           "2FBD0020",
+           "AFBF0014",
+           "AFBE0010",
+           "27BE0020",
+           "0FFFFFED",
+           "00000000",
+           "8FBE0010",
+           "8FBF0014",
+           "27BD0020",
+           "4BE00000",
+           "00000000"];
 
 (*
 val _ = DLXSimulatorC1.run_prog GCD
@@ -2825,21 +2825,21 @@
 structure Main =
    struct
       fun doit () =
-	 (DLXSimulatorC1.run_prog Simple
-	  ; DLXSimulatorC1.run_prog Twos
-	  ; DLXSimulatorC1.run_prog Abs
-	  ; DLXSimulatorC1.run_prog Fact
-	  ; DLXSimulatorC1.run_prog GCD
-	  )
+         (DLXSimulatorC1.run_prog Simple
+          ; DLXSimulatorC1.run_prog Twos
+          ; DLXSimulatorC1.run_prog Abs
+          ; DLXSimulatorC1.run_prog Fact
+          ; DLXSimulatorC1.run_prog GCD
+          )
 
       val doit =
-	 fn size =>
-	 let
-	    fun loop n =
-	       if n = 0
-		  then ()
-	       else (doit();
-		     loop(n-1))
-	 in loop size
-	 end
+         fn size =>
+         let
+            fun loop n =
+               if n = 0
+                  then ()
+               else (doit();
+                     loop(n-1))
+         in loop size
+         end
    end

Modified: mlton/branches/on-20050420-cmm-branch/benchmark/tests/Makefile
===================================================================
--- mlton/branches/on-20050420-cmm-branch/benchmark/tests/Makefile	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/benchmark/tests/Makefile	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,11 @@
+## Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ #    Jagannathan, and Stephen Weeks.
+ # Copyright (C) 1997-2000 NEC Research Institute.
+ #
+ # MLton is released under a BSD-style license.
+ # See the file MLton-LICENSE for details.
+ ##
+
 all:
 
 .PHONY: clean

Modified: mlton/branches/on-20050420-cmm-branch/benchmark/tests/barnes-hut.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/benchmark/tests/barnes-hut.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/benchmark/tests/barnes-hut.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -10,7 +10,7 @@
   sig
     type 'a vec
 
-    val dim : int	(* dimension of the vectors *)
+    val dim : int       (* dimension of the vectors *)
 
     val tabulate : (int -> 'a) -> 'a vec
 
@@ -28,7 +28,7 @@
     val map3v : (('a * 'b * 'c) -> 'd) -> ('a vec * 'b vec * 'c vec) -> 'd vec
     val foldv : ('a * 'b -> 'b) -> 'a vec -> 'b -> 'b
     val format : {lp : string, sep : string, rp : string, cvt : 'a -> string}
-	  -> 'a vec -> string
+          -> 'a vec -> string
     val explode : 'a vec -> 'a list
     val implode : 'a list -> 'a vec
 
@@ -52,11 +52,11 @@
     structure V : VECTOR
 
     datatype body = Body of {
-	mass : real,
-	pos : real V.vec ref,
-	vel : real V.vec ref,
-	acc : real V.vec ref,
-	phi : real ref
+        mass : real,
+        pos : real V.vec ref,
+        vel : real V.vec ref,
+        acc : real V.vec ref,
+        phi : real ref
       }
 
     datatype cell
@@ -66,18 +66,18 @@
     and node
       = Empty
       | Node of {
-	  mass : real ref,
-	  pos : real V.vec ref,
-	  cell : cell
-	}
+          mass : real ref,
+          pos : real V.vec ref,
+          cell : cell
+        }
 
     datatype space = Space of {
-	rmin : real V.vec,
-	rsize : real,
-	root : node
+        rmin : real V.vec,
+        rsize : real,
+        root : node
       }
 
-    val nsub : int	(* number of sub cells / cell (2 ^ V.dim) *)
+    val nsub : int      (* number of sub cells / cell (2 ^ V.dim) *)
 
     val putCell : (cell * int * node) -> unit
     val getCell : (cell * int) -> node
@@ -99,11 +99,11 @@
     structure V = V
 
     datatype body = Body of {
-	mass : real,
-	pos : real V.vec ref,
-	vel : real V.vec ref,
-	acc : real V.vec ref,
-	phi : real ref
+        mass : real,
+        pos : real V.vec ref,
+        vel : real V.vec ref,
+        acc : real V.vec ref,
+        phi : real ref
       }
 
     datatype cell
@@ -113,19 +113,19 @@
     and node
       = Empty
       | Node of {
-	  mass : real ref,
-	  pos : real V.vec ref,
-	  cell : cell
-	}
+          mass : real ref,
+          pos : real V.vec ref,
+          cell : cell
+        }
 
     datatype space = Space of {
-	rmin : real V.vec,
-	rsize : real,
-	root : node
+        rmin : real V.vec,
+        rsize : real,
+        root : node
       }
 
     fun eqBody(Body{mass,pos,vel,acc,phi},
-	       Body{mass=m1,pos=p1,vel=v1,acc=a1,phi=h1}) = 
+               Body{mass=m1,pos=p1,vel=v1,acc=a1,phi=h1}) = 
       (Real.==(mass, m1) andalso Real.==(!phi, !h1)
        andalso V.equal(!pos, !p1) andalso V.equal(!vel, !v1)
        andalso V.equal(!acc, !a1))
@@ -137,10 +137,10 @@
     fun getCell (Cell a, i) = Array.sub(a, i)
     fun mkCell () = Cell(Array.array(nsub, Empty))
     fun mkBodyNode (body as Body{pos, mass, ...}) = Node{
-	    cell = BodyCell body,
-	    mass = ref mass,
-	    pos = ref (!pos)
-	  }
+            cell = BodyCell body,
+            mass = ref mass,
+            pos = ref (!pos)
+          }
     fun mkCellNode cell = Node{cell = cell, mass = ref 0.0, pos = ref V.zerov}
 
   (* debugging code *)
@@ -149,48 +149,48 @@
       val vfmt = V.format{lp="[", rp="]", sep=",", cvt = rfmt}
     in
     fun prBody (Body{mass, pos, vel, acc, phi}) = String.concat [
-	    "B{m=", rfmt mass,
-	    ", p=", vfmt(!pos),
-	    ", v=", vfmt(!vel),
-	    ", a=", vfmt(!acc),
-	    ", phi=", rfmt(!phi), "}"
-	  ]
+            "B{m=", rfmt mass,
+            ", p=", vfmt(!pos),
+            ", v=", vfmt(!vel),
+            ", a=", vfmt(!acc),
+            ", phi=", rfmt(!phi), "}"
+          ]
     fun prNode Empty = "Empty"
       | prNode (Node{mass, pos, cell}) = let
-	  val cell = (case cell
-		 of (Cell _) => "Cell"
-		  | (BodyCell b) => (*prBody b*) "Body"
-		(* end case *))
-	  in
-	    String.concat [
-		"N{m=", rfmt(!mass),
-		", p=", vfmt(!pos),
-		cell, "}"
-	      ]
-	  end
+          val cell = (case cell
+                 of (Cell _) => "Cell"
+                  | (BodyCell b) => (*prBody b*) "Body"
+                (* end case *))
+          in
+            String.concat [
+                "N{m=", rfmt(!mass),
+                ", p=", vfmt(!pos),
+                cell, "}"
+              ]
+          end
     end
 
     fun dumpTree tree = let
-	  fun printf items = TextIO.output(TextIO.stdOut, String.concat items)
-	  fun indent i = StringCvt.padLeft #" " (i+1) ""
-	  fun dump (node, l) = let
-		fun dump' (Node{cell=Cell a, ...}) = let
-		      fun dump'' i = (dump(Array.sub(a, i), l+1); dump''(i+1))
-		      in
-			(dump'' 0) handle _ => ()
-		      end
-		  | dump' _ = ()
-		in
-		  printf [
-		      StringCvt.padLeft #" " 2 (Int.toString l),
-		      indent l,
-		      prNode node, "\n"
-		    ];
-		  dump' node
-		end
-	  in
-	    dump (tree, 0)
-	  end
+          fun printf items = TextIO.output(TextIO.stdOut, String.concat items)
+          fun indent i = StringCvt.padLeft #" " (i+1) ""
+          fun dump (node, l) = let
+                fun dump' (Node{cell=Cell a, ...}) = let
+                      fun dump'' i = (dump(Array.sub(a, i), l+1); dump''(i+1))
+                      in
+                        (dump'' 0) handle _ => ()
+                      end
+                  | dump' _ = ()
+                in
+                  printf [
+                      StringCvt.padLeft #" " 2 (Int.toString l),
+                      indent l,
+                      prNode node, "\n"
+                    ];
+                  dump' node
+                end
+          in
+            dump (tree, 0)
+          end
 
   end; (* Space *)
 
@@ -230,111 +230,111 @@
    * if rp is out of bounds.
    *)
     fun intcoord (rp, rmin, rsize) = let
-	  val xsc = V.divvs (V.subv(rp, rmin), rsize)
-	  fun cvt x = if ((0.0 <= x) andalso (x < 1.0))
-		then floor(rIMAX * x)
-		else raise NotIntCoord
-	  in
-	    V.mapv cvt xsc
-	  end
+          val xsc = V.divvs (V.subv(rp, rmin), rsize)
+          fun cvt x = if ((0.0 <= x) andalso (x < 1.0))
+                then floor(rIMAX * x)
+                else raise NotIntCoord
+          in
+            V.mapv cvt xsc
+          end
 
   (* determine which subcell to select. *)
     fun subindex (iv, l) = let
-	  fun aux (v, (i, k)) = if (Word.andb(Word.fromInt v, Word.fromInt l) <> 0w0)
-		then (i + rshift(S.nsub, k+1), k+1)
-		else (i, k+1)
-	  in
-	    #1 (V.foldv aux iv (0, 0))
-	  end
+          fun aux (v, (i, k)) = if (Word.andb(Word.fromInt v, Word.fromInt l) <> 0w0)
+                then (i + rshift(S.nsub, k+1), k+1)
+                else (i, k+1)
+          in
+            #1 (V.foldv aux iv (0, 0))
+          end
 
   (* enlarge cubical "box", salvaging existing tree structure. *)
     fun expandBox (nd as S.Body{pos, ...}, box as S.Space{rmin, rsize, root}) = (
-	  (intcoord (!pos, rmin, rsize); box)
-	    handle NotIntCoord => let
-	      val rmid = V.addvs (rmin, 0.5 * rsize)
-	      val rmin' = V.map3v (fn (x,y,z) =>
-			      if x < y then z - rsize else z) (!pos, rmid, rmin)
-	      val rsize' = 2.0 * rsize
-	      fun mksub (v, r) = let
-		    val x = intcoord (v, rmin', rsize')
-		    val k = subindex (x, IMAXrs1)
-		    val cell = S.mkCell ()
-		    in
-		      S.putCell (cell, k, r); cell
-		    end
-	      val box = (case root
-		     of S.Empty => S.Space{rmin=rmin', rsize=rsize', root=root}
-		      | _ => S.Space{
-			    rmin = rmin',
-			    rsize = rsize',
-			    root = S.mkCellNode (mksub (rmid, root))
-			  }
-		    (* end case *))
-	      in
-	        expandBox (nd, box)
-	      end)
+          (intcoord (!pos, rmin, rsize); box)
+            handle NotIntCoord => let
+              val rmid = V.addvs (rmin, 0.5 * rsize)
+              val rmin' = V.map3v (fn (x,y,z) =>
+                              if x < y then z - rsize else z) (!pos, rmid, rmin)
+              val rsize' = 2.0 * rsize
+              fun mksub (v, r) = let
+                    val x = intcoord (v, rmin', rsize')
+                    val k = subindex (x, IMAXrs1)
+                    val cell = S.mkCell ()
+                    in
+                      S.putCell (cell, k, r); cell
+                    end
+              val box = (case root
+                     of S.Empty => S.Space{rmin=rmin', rsize=rsize', root=root}
+                      | _ => S.Space{
+                            rmin = rmin',
+                            rsize = rsize',
+                            root = S.mkCellNode (mksub (rmid, root))
+                          }
+                    (* end case *))
+              in
+                expandBox (nd, box)
+              end)
 
 
   (* insert a single node into the tree *)
     fun loadTree (body as S.Body{pos=posp, ...}, S.Space{rmin, rsize, root}) = let
-	  val xp = intcoord (!posp, rmin, rsize)
-	  fun insert (S.Empty, _) = S.mkBodyNode body
-	    | insert (n as S.Node{cell=S.BodyCell _, pos=posq, ...}, l) = let
-		val xq = intcoord (!posq, rmin, rsize)
-		val k = subindex (xq, l)
-		val a = S.mkCell()
-		in
-		  S.putCell(a, k, n);
-		  insert (S.mkCellNode a, l)
-		end
-	    | insert (n as S.Node{cell, ...}, l) = let
-		val k = subindex (xp, l)
-		val subtree = insert (S.getCell (cell, k), rshift(l, 1))
-		in
-		  S.putCell (cell, k, subtree);
-		  n
-		end
-	  in
-	    S.Space{rmin = rmin, rsize = rsize, root = insert (root, IMAXrs1)}
-	  end
+          val xp = intcoord (!posp, rmin, rsize)
+          fun insert (S.Empty, _) = S.mkBodyNode body
+            | insert (n as S.Node{cell=S.BodyCell _, pos=posq, ...}, l) = let
+                val xq = intcoord (!posq, rmin, rsize)
+                val k = subindex (xq, l)
+                val a = S.mkCell()
+                in
+                  S.putCell(a, k, n);
+                  insert (S.mkCellNode a, l)
+                end
+            | insert (n as S.Node{cell, ...}, l) = let
+                val k = subindex (xp, l)
+                val subtree = insert (S.getCell (cell, k), rshift(l, 1))
+                in
+                  S.putCell (cell, k, subtree);
+                  n
+                end
+          in
+            S.Space{rmin = rmin, rsize = rsize, root = insert (root, IMAXrs1)}
+          end
 
   (* descend tree finding center-of-mass coordinates. *)
     fun hackCofM S.Empty = ()
       | hackCofM (S.Node{cell = S.BodyCell _, ...}) = ()
       | hackCofM (S.Node{cell = S.Cell subcells, mass, pos}) = let
-	  fun sumMass (i, totMass, cofm) = if (i < S.nsub)
-		then (case Array.sub(subcells, i)
-		   of S.Empty => sumMass (i+1, totMass, cofm)
-		    | (nd as S.Node{mass, pos, ...}) => let
-			val _ = hackCofM nd
-			val m = !mass
-			in
-			  sumMass (i+1, totMass + m, V.addv(cofm, V.mulvs(!pos, m)))
-			end
-		  (* end case *))
-		else (
-		  mass := totMass;
-		  pos := V.divvs(cofm, totMass))
-	  in
-	    sumMass (0, 0.0, V.zerov)
-	  end
+          fun sumMass (i, totMass, cofm) = if (i < S.nsub)
+                then (case Array.sub(subcells, i)
+                   of S.Empty => sumMass (i+1, totMass, cofm)
+                    | (nd as S.Node{mass, pos, ...}) => let
+                        val _ = hackCofM nd
+                        val m = !mass
+                        in
+                          sumMass (i+1, totMass + m, V.addv(cofm, V.mulvs(!pos, m)))
+                        end
+                  (* end case *))
+                else (
+                  mass := totMass;
+                  pos := V.divvs(cofm, totMass))
+          in
+            sumMass (0, 0.0, V.zerov)
+          end
 
   (* initialize tree structure for hack force calculation. *)
     fun makeTree (bodies, rmin, rsize) = let
-	  fun build ([], space) = space
-	    | build ((body as S.Body{mass, ...}) :: r, space) = 
-	       if Real.==(mass, 0.0) then build (r, space)
-	       else let
-		   val box = expandBox (body, space)
-		   val box = loadTree(body, box)
-		 in build (r, box)
-		 end
-	  val (space as S.Space{root, ...}) =
-	    build (bodies, S.Space{rmin=rmin, rsize=rsize, root=S.Empty})
-	  in
-	    hackCofM root;
-	    space
-	  end
+          fun build ([], space) = space
+            | build ((body as S.Body{mass, ...}) :: r, space) = 
+               if Real.==(mass, 0.0) then build (r, space)
+               else let
+                   val box = expandBox (body, space)
+                   val box = loadTree(body, box)
+                 in build (r, box)
+                 end
+          val (space as S.Space{root, ...}) =
+            build (bodies, S.Space{rmin=rmin, rsize=rsize, root=S.Empty})
+          in
+            hackCofM root;
+            space
+          end
 
   end; (* functor Load *)
 (* grav.sml
@@ -352,7 +352,7 @@
       sharing S.V = V
 
     val hackGrav : {body:S.body, root:S.node, rsize:real, tol:real, eps : real}
-	  -> {n2bterm:int, nbcterm:int, skipSelf:bool}
+          -> {n2bterm:int, nbcterm:int, skipSelf:bool}
 
   end; (* GRAV *)
 
@@ -363,75 +363,75 @@
     structure V = S.V
 
     fun walk {acc0, phi0, pos0, pskip, eps, rsize, tol, root} = let
-	  val skipSelf = ref false
-	  val nbcterm = ref 0 and n2bterm = ref 0
-	  val tolsq = (tol * tol)
-	(* compute a single body-body or body-cell interaction. *)
-	  fun gravsub (S.Empty, phi0, acc0, _) = (phi0, acc0)
-	    | gravsub (p as S.Node{mass, pos, cell, ...}, phi0, acc0, memo) = let
-		val (dr, drsq) = (case memo
-		       of NONE => let
-			    val dr = V.subv(!pos, pos0)
-			    in
-			      (dr, V.dotvp(dr, dr) + (eps*eps))
-			    end
-			| SOME(dr', drsq') => (dr', drsq' + (eps*eps))
-		      (* end case *))
-		val phii = !mass / (Math.sqrt drsq)
-		in
-		  case cell
-		   of (S.Cell _) => nbcterm := !nbcterm + 1
-		    | _ => n2bterm := !n2bterm + 1
-		  (* end case *);
-		  (phi0 - phii, V.addv(acc0, V.mulvs(dr, phii / drsq)))
-		end (* gravsub *)
-	(* recursive routine to do hackwalk operation. This combines the
-	 * subdivp and walksub routines from the C version.
-	 *)
-	  fun walksub (p, dsq, phi0, acc0) = (
+          val skipSelf = ref false
+          val nbcterm = ref 0 and n2bterm = ref 0
+          val tolsq = (tol * tol)
+        (* compute a single body-body or body-cell interaction. *)
+          fun gravsub (S.Empty, phi0, acc0, _) = (phi0, acc0)
+            | gravsub (p as S.Node{mass, pos, cell, ...}, phi0, acc0, memo) = let
+                val (dr, drsq) = (case memo
+                       of NONE => let
+                            val dr = V.subv(!pos, pos0)
+                            in
+                              (dr, V.dotvp(dr, dr) + (eps*eps))
+                            end
+                        | SOME(dr', drsq') => (dr', drsq' + (eps*eps))
+                      (* end case *))
+                val phii = !mass / (Math.sqrt drsq)
+                in
+                  case cell
+                   of (S.Cell _) => nbcterm := !nbcterm + 1
+                    | _ => n2bterm := !n2bterm + 1
+                  (* end case *);
+                  (phi0 - phii, V.addv(acc0, V.mulvs(dr, phii / drsq)))
+                end (* gravsub *)
+        (* recursive routine to do hackwalk operation. This combines the
+         * subdivp and walksub routines from the C version.
+         *)
+          fun walksub (p, dsq, phi0, acc0) = (
 (*print(implode["    walksub: dsq = ", makestring dsq, ", ", S.prNode p, "\n"]);*)
-		case p
-		 of S.Empty => (phi0, acc0)
-		  | (S.Node{cell = S.BodyCell body, ...}) => 
-		      if S.eqBody(body, pskip)
-			then (skipSelf := true; (phi0, acc0))
-			else gravsub (p, phi0, acc0, NONE)
-		  | (S.Node{cell = S.Cell a, pos, ...}) => let
-		      val dr = V.subv(!pos, pos0)
-		      val drsq = V.dotvp(dr, dr)
-		      in
-			if ((tolsq * drsq) < dsq)
-			  then let (* open p up *)
-			    fun loop (i, phi0, acc0) = if (i < S.nsub)
-				  then let
-				    val (phi0', acc0') = walksub (
-					    Array.sub(a, i), dsq/4.0, phi0, acc0)
-				    in
-				      loop (i+1, phi0', acc0')
-				    end
-				  else (phi0, acc0)
-			    in
-			      loop (0, phi0, acc0)
-			    end
-			  else gravsub (p, phi0, acc0, SOME(dr, drsq))
-		      end
-		(* end case *))
-	  val (phi0, acc0) = walksub (root, rsize*rsize, phi0, acc0)
-	  in
-	    { phi0 = phi0, acc0 = acc0,
-	      nbcterm = !nbcterm, n2bterm = !n2bterm, skip = !skipSelf
-	    }
-	  end (* walk *)
+                case p
+                 of S.Empty => (phi0, acc0)
+                  | (S.Node{cell = S.BodyCell body, ...}) => 
+                      if S.eqBody(body, pskip)
+                        then (skipSelf := true; (phi0, acc0))
+                        else gravsub (p, phi0, acc0, NONE)
+                  | (S.Node{cell = S.Cell a, pos, ...}) => let
+                      val dr = V.subv(!pos, pos0)
+                      val drsq = V.dotvp(dr, dr)
+                      in
+                        if ((tolsq * drsq) < dsq)
+                          then let (* open p up *)
+                            fun loop (i, phi0, acc0) = if (i < S.nsub)
+                                  then let
+                                    val (phi0', acc0') = walksub (
+                                            Array.sub(a, i), dsq/4.0, phi0, acc0)
+                                    in
+                                      loop (i+1, phi0', acc0')
+                                    end
+                                  else (phi0, acc0)
+                            in
+                              loop (0, phi0, acc0)
+                            end
+                          else gravsub (p, phi0, acc0, SOME(dr, drsq))
+                      end
+                (* end case *))
+          val (phi0, acc0) = walksub (root, rsize*rsize, phi0, acc0)
+          in
+            { phi0 = phi0, acc0 = acc0,
+              nbcterm = !nbcterm, n2bterm = !n2bterm, skip = !skipSelf
+            }
+          end (* walk *)
 
   (* evaluate grav field at a given particle. *)
     fun hackGrav {body as S.Body{pos, phi, acc, ...}, root, rsize, eps, tol} = let
-	  val {phi0, acc0, nbcterm, n2bterm, skip} = walk {
-		  acc0 = V.zerov, phi0 = 0.0, pos0 = !pos, pskip = body,
-		  eps = eps, rsize = rsize, tol = tol, root = root
-		}
-	  in
-	    phi := phi0;
-	    acc := acc0;
+          val {phi0, acc0, nbcterm, n2bterm, skip} = walk {
+                  acc0 = V.zerov, phi0 = 0.0, pos0 = !pos, pskip = body,
+                  eps = eps, rsize = rsize, tol = tol, root = root
+                }
+          in
+            phi := phi0;
+            acc := acc0;
 (**
 app (fn (fmt, items) => print(Format.format fmt items)) [
   ("pos = [%f %f %f]\n", map Format.REAL (V.explode(!pos))),
@@ -440,8 +440,8 @@
 ];
 raise Fail "";
 **)
-	    {nbcterm=nbcterm, n2bterm=n2bterm, skipSelf=skip}
-	  end (* hackgrav *)
+            {nbcterm=nbcterm, n2bterm=n2bterm, skipSelf=skip}
+          end (* hackgrav *)
 
   end; (* Grav *)
 (* data-io.sml
@@ -457,21 +457,21 @@
     structure S : SPACE
 
     val inputData : string -> {
-	    nbody : int,
-	    bodies : S.body list,
-	    tnow : real,
-	    headline : string
-	  }
+            nbody : int,
+            bodies : S.body list,
+            tnow : real,
+            headline : string
+          }
 
   (* output routines *)
     val initOutput : {
-	    outfile : string, headline : string, nbody : int, tnow : real,
-	    dtime : real, eps : real, tol : real, dtout : real, tstop : real
-	  } -> unit
+            outfile : string, headline : string, nbody : int, tnow : real,
+            dtime : real, eps : real, tol : real, dtout : real, tstop : real
+          } -> unit
     val output : {
-	    nbody : int, bodies : S.body list, n2bcalc : int, nbccalc : int,
-	    selfint : int, tnow : real
-	  } -> unit
+            nbody : int, bodies : S.body list, n2bcalc : int, nbccalc : int,
+            selfint : int, tnow : real
+          } -> unit
     val stopOutput : unit -> unit
 
   end;
@@ -489,86 +489,86 @@
    * but SML/NJ doesn't implement these correctly yet.
    *)
     fun inputData fname = let
-	  val strm = TextIO.openIn fname
-	  val buf = ref(SS.full "")
-	  fun getLn () = (case (TextIO.inputLine strm)
-		 of NONE => raise Fail "inputData: EOF"
-		  | SOME s => buf := SS.full s
-		(* end case *))
-	  fun skipWS () = let
-		val buf' = SS.dropl Char.isSpace (!buf)
-		in
-		  if (SS.isEmpty buf')
-		    then (getLn(); skipWS())
-		    else buf'
-		end
-	  fun readInt () = let
-		val (n, ss) = atoi (skipWS ())
-		in
-		  buf := ss; n
-		end
-	  fun readReal () = let
-		val (r, ss) = valOf (Real.scan SS.getc (skipWS()))
+          val strm = TextIO.openIn fname
+          val buf = ref(SS.full "")
+          fun getLn () = (case (TextIO.inputLine strm)
+                 of NONE => raise Fail "inputData: EOF"
+                  | SOME s => buf := SS.full s
+                (* end case *))
+          fun skipWS () = let
+                val buf' = SS.dropl Char.isSpace (!buf)
                 in
+                  if (SS.isEmpty buf')
+                    then (getLn(); skipWS())
+                    else buf'
+                end
+          fun readInt () = let
+                val (n, ss) = atoi (skipWS ())
+                in
+                  buf := ss; n
+                end
+          fun readReal () = let
+                val (r, ss) = valOf (Real.scan SS.getc (skipWS()))
+                in
                   buf := ss; r
                 end
-	  val nbody = readInt()
-	  val _ = if (nbody < 1)
-		then raise Fail "absurd nbody"
-		else ()
-	  val ndim = readInt()
-	  val _ = if (ndim <> V.dim)
-		then raise Fail "absurd ndim"
-		else ()
-	  val tnow = readReal()
-	  fun iter f = let
-		fun loop (0, l) = l
-		  | loop (n, l) = loop (n-1, f() :: l)
-		in
-		  fn n => loop (n, [])
-		end
-	  fun readVec () = V.implode (rev (iter readReal ndim))
-	  val massList = iter readReal nbody
-	  val posList = iter readVec nbody
-	  val velList = iter readVec nbody
-	  fun mkBodies ([], [], [], l) = l
-	    | mkBodies (m::r1, p::r2, v::r3, l) = let
-		val b = S.Body{
-			mass = m,
-			pos = ref p,
-			vel = ref v,
-			acc = ref V.zerov,
-			phi = ref 0.0
-		      }
-		in
-		  mkBodies(r1, r2, r3, b::l)
-		end
-	  in
-	    TextIO.closeIn strm;
-	    { nbody = nbody,
-	      bodies = mkBodies (massList, posList, velList, []),
-	      tnow = tnow,
-	      headline = concat["Hack code: input file ", fname, "\n"]
-	    }
-	  end
+          val nbody = readInt()
+          val _ = if (nbody < 1)
+                then raise Fail "absurd nbody"
+                else ()
+          val ndim = readInt()
+          val _ = if (ndim <> V.dim)
+                then raise Fail "absurd ndim"
+                else ()
+          val tnow = readReal()
+          fun iter f = let
+                fun loop (0, l) = l
+                  | loop (n, l) = loop (n-1, f() :: l)
+                in
+                  fn n => loop (n, [])
+                end
+          fun readVec () = V.implode (rev (iter readReal ndim))
+          val massList = iter readReal nbody
+          val posList = iter readVec nbody
+          val velList = iter readVec nbody
+          fun mkBodies ([], [], [], l) = l
+            | mkBodies (m::r1, p::r2, v::r3, l) = let
+                val b = S.Body{
+                        mass = m,
+                        pos = ref p,
+                        vel = ref v,
+                        acc = ref V.zerov,
+                        phi = ref 0.0
+                      }
+                in
+                  mkBodies(r1, r2, r3, b::l)
+                end
+          in
+            TextIO.closeIn strm;
+            { nbody = nbody,
+              bodies = mkBodies (massList, posList, velList, []),
+              tnow = tnow,
+              headline = concat["Hack code: input file ", fname, "\n"]
+            }
+          end
 
     local
       val timer = ref (Timer.startCPUTimer ())
     in
     fun initTimer () = timer := Timer.startCPUTimer()
     fun cputime () = let
-	  val {usr, sys, ...} = Timer.checkCPUTimer(!timer)
-	  val totTim = usr
-	  in
-	    (Time.toReal totTim) / 60.0
-	  end
+          val {usr, sys, ...} = Timer.checkCPUTimer(!timer)
+          val totTim = usr
+          in
+            (Time.toReal totTim) / 60.0
+          end
     end
 
     type out_state = {
-	tout : real,
-	dtout : real,
-	dtime : real,
-	strm : TextIO.outstream
+        tout : real,
+        dtout : real,
+        dtime : real,
+        strm : TextIO.outstream
       }
     val outState = ref (NONE : out_state option)
 
@@ -583,126 +583,126 @@
       val fmt = V.format{lp="", sep="", rp="", cvt=itemFmt}
     in
     fun printvec (init, vec) = printf [
-	    "\t ", pad 9 init, fmt vec, "\n"
-	  ]
+            "\t ", pad 9 init, fmt vec, "\n"
+          ]
     end (* local *)
 
     fun stopOutput () = (case (! outState)
-	   of NONE => ()
-	    | (SOME{strm, ...}) => (TextIO.closeOut strm; outState := NONE)
-	  (* end case *))
+           of NONE => ()
+            | (SOME{strm, ...}) => (TextIO.closeOut strm; outState := NONE)
+          (* end case *))
 
     fun initOutput {outfile, headline, nbody, tnow, dtime, eps, tol, dtout, tstop} = (
-	  initTimer();
-	  printf ["\n\t\t", headline, "\n\n"];
-	  printf (map (pad 12) ["nbody", "dtime", "eps", "tol", "dtout", "tstop"]);
-	  printf ["\n"];
-	  printf [fmtInt(12, nbody), fmtReal(12, 5, dtime)];
-	  printf [
-	      fmtInt(12, nbody), fmtReal(12, 5, dtime),
-	      fmtReal(12, 4, eps), fmtReal(12, 2, tol),
-	      fmtReal(12, 3, dtout), fmtReal(12, 2, tstop), "\n\n"
-	    ];
-	  case outfile
-	   of "" => stopOutput()
-	    | _ => outState := SOME{
-		  dtime = dtime,
-		  tout = tnow,
-		  dtout = dtout,
-		  strm = TextIO.openOut outfile
-		}
-	  (* end case *))
+          initTimer();
+          printf ["\n\t\t", headline, "\n\n"];
+          printf (map (pad 12) ["nbody", "dtime", "eps", "tol", "dtout", "tstop"]);
+          printf ["\n"];
+          printf [fmtInt(12, nbody), fmtReal(12, 5, dtime)];
+          printf [
+              fmtInt(12, nbody), fmtReal(12, 5, dtime),
+              fmtReal(12, 4, eps), fmtReal(12, 2, tol),
+              fmtReal(12, 3, dtout), fmtReal(12, 2, tstop), "\n\n"
+            ];
+          case outfile
+           of "" => stopOutput()
+            | _ => outState := SOME{
+                  dtime = dtime,
+                  tout = tnow,
+                  dtout = dtout,
+                  strm = TextIO.openOut outfile
+                }
+          (* end case *))
 
   (* compute set of dynamical diagnostics. *)
     fun diagnostics bodies = let
-	  fun loop ([], arg) = {
-		  mtot = #totM arg,		(* total mass *)
-		  totKE = #totKE arg,		(* total kinetic energy *)
-		  totPE = #totPE arg,		(* total potential energy *)
-		  cOfMPos = #cOfMPos arg,	(* center of mass: position *)
-		  cOfMVel = #cOfMVel arg,	(* center of mass: velocity *)
-		  amVec = #amVec arg		(* angular momentum vector *)
-		}
-	    | loop (S.Body{
-		  mass, pos=ref pos, vel=ref vel, acc=ref acc, phi=ref phi
-	        } :: r, arg) = let
-		val velsq = V.dotvp(vel, vel)
-		val halfMass = 0.5 * mass
-		val posXmass = V.mulvs(pos, mass)
-		in
-		  loop ( r, {
-		      totM = (#totM arg) + mass,
-		      totKE = (#totKE arg) + halfMass * velsq,
-		      totPE = (#totPE arg) + halfMass * phi,
-		      keTen = V.addm(#keTen arg, V.outvp(V.mulvs(vel, halfMass), vel)),
-		      peTen = V.addm(#peTen arg, V.outvp(posXmass, acc)),
-		      cOfMPos = V.addv(#cOfMPos arg, posXmass),
-		      cOfMVel = V.addv(#cOfMVel arg, V.mulvs(vel, mass)),
-		      amVec = V.addv(#amVec arg, V.mulvs(V.crossvp(pos, vel), mass))
-		    })
-		end
-	  in
-	    loop (bodies, {
-		totM = 0.0, totKE = 0.0, totPE = 0.0,
-		keTen = V.zerom, peTen = V.zerom,
-		cOfMPos = V.zerov, cOfMVel = V.zerov,
-		amVec = V.zerov
-	      })
-	  end (* diagnostics *)
+          fun loop ([], arg) = {
+                  mtot = #totM arg,             (* total mass *)
+                  totKE = #totKE arg,           (* total kinetic energy *)
+                  totPE = #totPE arg,           (* total potential energy *)
+                  cOfMPos = #cOfMPos arg,       (* center of mass: position *)
+                  cOfMVel = #cOfMVel arg,       (* center of mass: velocity *)
+                  amVec = #amVec arg            (* angular momentum vector *)
+                }
+            | loop (S.Body{
+                  mass, pos=ref pos, vel=ref vel, acc=ref acc, phi=ref phi
+                } :: r, arg) = let
+                val velsq = V.dotvp(vel, vel)
+                val halfMass = 0.5 * mass
+                val posXmass = V.mulvs(pos, mass)
+                in
+                  loop ( r, {
+                      totM = (#totM arg) + mass,
+                      totKE = (#totKE arg) + halfMass * velsq,
+                      totPE = (#totPE arg) + halfMass * phi,
+                      keTen = V.addm(#keTen arg, V.outvp(V.mulvs(vel, halfMass), vel)),
+                      peTen = V.addm(#peTen arg, V.outvp(posXmass, acc)),
+                      cOfMPos = V.addv(#cOfMPos arg, posXmass),
+                      cOfMVel = V.addv(#cOfMVel arg, V.mulvs(vel, mass)),
+                      amVec = V.addv(#amVec arg, V.mulvs(V.crossvp(pos, vel), mass))
+                    })
+                end
+          in
+            loop (bodies, {
+                totM = 0.0, totKE = 0.0, totPE = 0.0,
+                keTen = V.zerom, peTen = V.zerom,
+                cOfMPos = V.zerov, cOfMVel = V.zerov,
+                amVec = V.zerov
+              })
+          end (* diagnostics *)
 
     fun outputData (strm, tnow, nbody, bodies) = let
-	  fun outInt i = fprintf(strm, ["  ", Int.toString i, "\n"])
-	  fun outReal r = fprintf(strm, [" ", fmtRealE(21, 14, r), "\n"])
-	  fun prReal r = fprintf(strm, [" ", fmtRealE(21, 14, r)])
-	  fun outVec v = let
-		fun out [] = TextIO.output(strm, "\n")
-		  | out (x::r) = (prReal x; out r)
-		in
-		  out(V.explode v)
-		end
-	  in
-	    outInt nbody;
-	    outInt V.dim;
-	    outReal tnow;
-	    app (fn (S.Body{mass, ...}) => outReal mass) bodies;
-	    app (fn (S.Body{pos, ...}) => outVec(!pos)) bodies;
-	    app (fn (S.Body{vel, ...}) => outVec(!vel)) bodies;
-	    printf ["\n\tparticle data written\n"]
-	  end;
+          fun outInt i = fprintf(strm, ["  ", Int.toString i, "\n"])
+          fun outReal r = fprintf(strm, [" ", fmtRealE(21, 14, r), "\n"])
+          fun prReal r = fprintf(strm, [" ", fmtRealE(21, 14, r)])
+          fun outVec v = let
+                fun out [] = TextIO.output(strm, "\n")
+                  | out (x::r) = (prReal x; out r)
+                in
+                  out(V.explode v)
+                end
+          in
+            outInt nbody;
+            outInt V.dim;
+            outReal tnow;
+            app (fn (S.Body{mass, ...}) => outReal mass) bodies;
+            app (fn (S.Body{pos, ...}) => outVec(!pos)) bodies;
+            app (fn (S.Body{vel, ...}) => outVec(!vel)) bodies;
+            printf ["\n\tparticle data written\n"]
+          end;
 
     fun output {nbody, bodies, n2bcalc, nbccalc, selfint, tnow} = let
-	  val nttot = n2bcalc + nbccalc
-	  val nbavg = floor(real n2bcalc / real nbody)
-	  val ncavg = floor(real nbccalc / real nbody)
-	  val data = diagnostics bodies
-	  in
-	    printf ["\n"];
-	    printf (map (pad 9) [
-		"tnow", "T+U", "T/U", "nttot", "nbavg", "ncavg", "selfint",
-		"cputime"
-	      ]);
-	    printf ["\n"];
-	    printf [
-		fmtReal(9, 3, tnow), fmtReal(9, 4, #totKE data + #totPE data),
-		fmtReal(9, 4, #totKE data / #totPE data), fmtInt(9, nttot),
-		fmtInt(9, nbavg), fmtInt(9, ncavg), fmtInt(9, selfint),
-		fmtReal(9, 2, cputime()), "\n\n"
-	      ];
-	    printvec ("cm pos", #cOfMPos data);
-	    printvec ("cm vel", #cOfMVel data);
-	    printvec ("am pos", #amVec data);
-	    case !outState
-	     of NONE => ()
-	      | (SOME{tout, dtout, dtime, strm}) =>
-		  if ((tout - 0.01 * dtime) <= tnow)
-		    then (
-		      outputData (strm, tnow, nbody, bodies);
-		      outState := SOME{
-			  tout=tout+dtout, dtout=dtout, dtime=dtime, strm=strm
-			})
-		    else ()
-	    (* end case *)
-	  end
+          val nttot = n2bcalc + nbccalc
+          val nbavg = floor(real n2bcalc / real nbody)
+          val ncavg = floor(real nbccalc / real nbody)
+          val data = diagnostics bodies
+          in
+            printf ["\n"];
+            printf (map (pad 9) [
+                "tnow", "T+U", "T/U", "nttot", "nbavg", "ncavg", "selfint",
+                "cputime"
+              ]);
+            printf ["\n"];
+            printf [
+                fmtReal(9, 3, tnow), fmtReal(9, 4, #totKE data + #totPE data),
+                fmtReal(9, 4, #totKE data / #totPE data), fmtInt(9, nttot),
+                fmtInt(9, nbavg), fmtInt(9, ncavg), fmtInt(9, selfint),
+                fmtReal(9, 2, cputime()), "\n\n"
+              ];
+            printvec ("cm pos", #cOfMPos data);
+            printvec ("cm vel", #cOfMVel data);
+            printvec ("am pos", #amVec data);
+            case !outState
+             of NONE => ()
+              | (SOME{tout, dtout, dtime, strm}) =>
+                  if ((tout - 0.01 * dtime) <= tnow)
+                    then (
+                      outputData (strm, tnow, nbody, bodies);
+                      outState := SOME{
+                          tout=tout+dtout, dtout=dtout, dtime=dtime, strm=strm
+                        })
+                    else ()
+            (* end case *)
+          end
 
   end; (* DataIO *)
 
@@ -731,49 +731,49 @@
     fun initParam (argv, defl) = defaults := defl
 
     fun prompt items = (
-	  TextIO.output(TextIO.stdOut, String.concat items);
-	  TextIO.flushOut TextIO.stdOut)
+          TextIO.output(TextIO.stdOut, String.concat items);
+          TextIO.flushOut TextIO.stdOut)
 
     structure SS = Substring
 
   (* export version prompts user for value. *)
     fun getParam name = let
-	  fun scanBind [] = NONE
-	    | scanBind (s::r) = let
-		val (_, suffix) = SS.position name (SS.full s)
-		in
-		  if (SS.isEmpty suffix)
-		    then scanBind r
-		    else SOME(SS.string(SS.triml (size name+1) suffix))
-		end
-	  fun get default = (case (TextIO.inputLine TextIO.stdIn)
-		 of NONE => raise EOF
-		  | SOME "\n" => default
-		  | SOME s => substring(s, 0, size s - 1)
-		(* end case *))
-	  in
-	    if (null (! defaults))
-	      then raise Fail "getParam called before initParam"
-	      else ();
-	    case (scanBind (! defaults))
-	     of (SOME s) => (
-		  prompt ["enter ", name, " [", s, "]: "];
-		  get s)
-	      | NONE => (prompt ["enter ", name, ": "]; get "")
-	    (* end case *)
-	  end
+          fun scanBind [] = NONE
+            | scanBind (s::r) = let
+                val (_, suffix) = SS.position name (SS.full s)
+                in
+                  if (SS.isEmpty suffix)
+                    then scanBind r
+                    else SOME(SS.string(SS.triml (size name+1) suffix))
+                end
+          fun get default = (case (TextIO.inputLine TextIO.stdIn)
+                 of NONE => raise EOF
+                  | SOME "\n" => default
+                  | SOME s => substring(s, 0, size s - 1)
+                (* end case *))
+          in
+            if (null (! defaults))
+              then raise Fail "getParam called before initParam"
+              else ();
+            case (scanBind (! defaults))
+             of (SOME s) => (
+                  prompt ["enter ", name, " [", s, "]: "];
+                  get s)
+              | NONE => (prompt ["enter ", name, ": "]; get "")
+            (* end case *)
+          end
 
     local
       fun cvt scanFn = let
-	    fun cvt' name = let
-		  fun get () = (case getParam name of "" => get () | s => s)
-		  val param = get ()
-		  in
-		    (valOf (scanFn param)) handle _ => (cvt' name)
-		  end
-	    in
-	      cvt'
-	    end
+            fun cvt' name = let
+                  fun get () = (case getParam name of "" => get () | s => s)
+                  val param = get ()
+                  in
+                    (valOf (scanFn param)) handle _ => (cvt' name)
+                  end
+            in
+              cvt'
+            end
     in
   (* get integer parameter *)
     val getIParam = cvt Int.fromString
@@ -885,18 +885,18 @@
     structure L : LOAD
 
     val srand : int -> unit
-	(* reset the random number generator *)
+        (* reset the random number generator *)
 
     val testdata : int -> S.body list
-	(* generate the Plummer model data *)
+        (* generate the Plummer model data *)
 
     val go : {
             output : {n2bcalc:int, nbccalc:int, nstep:int, selfint:int, tnow:real}
-		-> unit,
-	    bodies : S.body list, tnow : real, tstop : real,
-	    dtime : real, eps : real, tol : real,
+                -> unit,
+            bodies : S.body list, tnow : real, tstop : real,
+            dtime : real, eps : real, tol : real,
             rmin : real V.vec, rsize : real
-	  } -> unit
+          } -> unit
 
     val doit : unit -> unit
 
@@ -920,210 +920,210 @@
     in
     fun srand s = (seed := real s)
     fun xrand (xl, xh) = let
-	  val r = Rand.random (! seed)
-	  in
-	    seed := r;
-	    xl + (((xh - xl) * r) / 2147483647.0)
-	  end
+          val r = Rand.random (! seed)
+          in
+            seed := r;
+            xl + (((xh - xl) * r) / 2147483647.0)
+          end
     end (* local *)
 
   (* default parameter values *)
     val defaults = [
-	  (* file names for input/output				*)
-	    "in=",              (* snapshot of initial conditions	*)
-	    "out=",             (* stream of output snapshots		*)
+          (* file names for input/output                                *)
+            "in=",              (* snapshot of initial conditions       *)
+            "out=",             (* stream of output snapshots           *)
 
-	  (* params, used if no input specified, to make a Plummer Model*)
-	    "nbody=128",        (* number of particles to generate	*)
-	    "seed=123",         (* random number generator seed		*)
+          (* params, used if no input specified, to make a Plummer Model*)
+            "nbody=128",        (* number of particles to generate      *)
+            "seed=123",         (* random number generator seed         *)
 
-	  (* params to control N-body integration			*)
-	    "dtime=0.025",	(* integration time-step		*)
-	    "eps=0.05",         (* usual potential softening		*)
-	    "tol=1.0",          (* cell subdivision tolerence		*)
-	    "fcells=0.75",      (* cell allocation parameter		*)
+          (* params to control N-body integration                       *)
+            "dtime=0.025",      (* integration time-step                *)
+            "eps=0.05",         (* usual potential softening            *)
+            "tol=1.0",          (* cell subdivision tolerence           *)
+            "fcells=0.75",      (* cell allocation parameter            *)
 
-	    "tstop=2.0",        (* time to stop integration		*)
-	    "dtout=0.25",       (* data-output interval			*)
+            "tstop=2.0",        (* time to stop integration             *)
+            "dtout=0.25",       (* data-output interval                 *)
 
-	    "debug=false",      (* turn on debugging messages		*)
-	    "VERSION=1.0"	(* JEB  06 March 1988			*)
-	  ]
+            "debug=false",      (* turn on debugging messages           *)
+            "VERSION=1.0"       (* JEB  06 March 1988                   *)
+          ]
 
   (* pick a random point on a sphere of specified radius. *)
     fun pickshell rad = let
-	  fun pickvec () = let
-		val vec = V.tabulate (fn _ => xrand(~1.0, 1.0))
-		val rsq = V.dotvp(vec, vec)
-		in
-		  if (rsq > 1.0)
-		    then pickvec ()
-		    else V.mulvs (vec, rad / Math.sqrt(rsq))
-		end
-	  in
-	    pickvec ()
-	  end
+          fun pickvec () = let
+                val vec = V.tabulate (fn _ => xrand(~1.0, 1.0))
+                val rsq = V.dotvp(vec, vec)
+                in
+                  if (rsq > 1.0)
+                    then pickvec ()
+                    else V.mulvs (vec, rad / Math.sqrt(rsq))
+                end
+          in
+            pickvec ()
+          end
 
   (* generate Plummer model initial conditions for test runs, scaled
    * to units such that M = -4E = G = 1 (Henon, Hegge, etc).
    * See Aarseth, SJ, Henon, M, & Wielen, R (1974) Astr & Ap, 37, 183.
    *)
     fun testdata n = let
-	  val mfrac = 0.999 (* mass cut off at mfrac of total *)
-	  val rn = real n
-	  val rsc = (3.0 * pi) / 16.0
-	  val vsc = Math.sqrt(1.0 / rsc)
-	  fun mkBodies (0, cmr, cmv, l) = let
-	      (* offset bodies by normalized cm coordinates.  Also, reverse
-	       * the list to get the same order of bodies as in the C version.
-	       *)
-		val cmr = V.divvs(cmr, rn)
-		val cmv = V.divvs(cmv, rn)
-		fun norm ([], l) = l
-		  | norm ((p as S.Body{pos, vel, ...}) :: r, l) = (
-		      pos := V.subv(!pos, cmr);
-		      vel := V.subv(!vel, cmv);
-		      norm (r, p::l))
-		in
-		  norm (l, [])
-		end
-	    | mkBodies (i, cmr, cmv, l) = let
-		val r = 1.0 / Math.sqrt (pow(xrand(0.0, mfrac), ~2.0/3.0) - 1.0)
-		val pos = pickshell (rsc * r)
-		fun vN () = let		(* von Neumann technique *)
-		      val x = xrand(0.0,1.0)
-		      val y = xrand(0.0,0.1)
-		      in
-			if (y > x*x * (pow (1.0-x*x, 3.5))) then vN () else x
-		      end
-		val v = ((Math.sqrt 2.0) * vN()) / pow(1.0 + r*r, 0.25)
-		val vel = pickshell (vsc * v)
-		val body = S.Body{
-			mass = 1.0 / rn,
-			pos = ref pos,
-			vel = ref vel,
-			acc = ref V.zerov,
-			phi = ref 0.0
-		      }
-		in
-		  mkBodies (i-1, V.addv(cmr, pos), V.addv(cmv, vel), body :: l)
-		end
-	  in
-	    mkBodies (n, V.zerov, V.zerov, [])
-	  end (* testdata *)
+          val mfrac = 0.999 (* mass cut off at mfrac of total *)
+          val rn = real n
+          val rsc = (3.0 * pi) / 16.0
+          val vsc = Math.sqrt(1.0 / rsc)
+          fun mkBodies (0, cmr, cmv, l) = let
+              (* offset bodies by normalized cm coordinates.  Also, reverse
+               * the list to get the same order of bodies as in the C version.
+               *)
+                val cmr = V.divvs(cmr, rn)
+                val cmv = V.divvs(cmv, rn)
+                fun norm ([], l) = l
+                  | norm ((p as S.Body{pos, vel, ...}) :: r, l) = (
+                      pos := V.subv(!pos, cmr);
+                      vel := V.subv(!vel, cmv);
+                      norm (r, p::l))
+                in
+                  norm (l, [])
+                end
+            | mkBodies (i, cmr, cmv, l) = let
+                val r = 1.0 / Math.sqrt (pow(xrand(0.0, mfrac), ~2.0/3.0) - 1.0)
+                val pos = pickshell (rsc * r)
+                fun vN () = let         (* von Neumann technique *)
+                      val x = xrand(0.0,1.0)
+                      val y = xrand(0.0,0.1)
+                      in
+                        if (y > x*x * (pow (1.0-x*x, 3.5))) then vN () else x
+                      end
+                val v = ((Math.sqrt 2.0) * vN()) / pow(1.0 + r*r, 0.25)
+                val vel = pickshell (vsc * v)
+                val body = S.Body{
+                        mass = 1.0 / rn,
+                        pos = ref pos,
+                        vel = ref vel,
+                        acc = ref V.zerov,
+                        phi = ref 0.0
+                      }
+                in
+                  mkBodies (i-1, V.addv(cmr, pos), V.addv(cmv, vel), body :: l)
+                end
+          in
+            mkBodies (n, V.zerov, V.zerov, [])
+          end (* testdata *)
 
   (* startup hierarchical N-body code. This either reads in or generates
    * an initial set of bodies, and other parameters.
    *)
 
     fun startrun argv = let
-	  val _ = GetParam.initParam(argv, defaults)
-	  val {nbody, bodies, tnow, headline} = (case (GetParam.getParam "in")
-		 of "" => let
-		      val nbody = GetParam.getIParam "nbody"
-		      in
-			if (nbody < 1)
-			  then raise Fail "startrun: absurd nbody"
-			  else ();
-			srand (GetParam.getIParam "seed");
-		        { nbody = nbody,
-			  bodies = testdata nbody,
-			  tnow = 0.0,
-			  headline = "Hack code: Plummer model"
-			}
-		      end
-		  | fname => DataIO.inputData fname
-		(* end case *))
-	  in
-	    { nbody = nbody,
-	      bodies = bodies,
-	      headline = headline,
-	      outfile = GetParam.getParam "out",
-	      dtime = GetParam.getRParam "dtime",
-	      eps = GetParam.getRParam "eps",
-	      tol = GetParam.getRParam "tol",
-	      tnow = tnow,
-	      tstop = GetParam.getRParam "tstop",
-	      dtout = GetParam.getRParam "dtout",
-	      debug = GetParam.getBParam "debug",
-	      rmin = V.tabulate (fn _ => ~2.0),
-	      rsize = 4.0
-	    }
-	  end
+          val _ = GetParam.initParam(argv, defaults)
+          val {nbody, bodies, tnow, headline} = (case (GetParam.getParam "in")
+                 of "" => let
+                      val nbody = GetParam.getIParam "nbody"
+                      in
+                        if (nbody < 1)
+                          then raise Fail "startrun: absurd nbody"
+                          else ();
+                        srand (GetParam.getIParam "seed");
+                        { nbody = nbody,
+                          bodies = testdata nbody,
+                          tnow = 0.0,
+                          headline = "Hack code: Plummer model"
+                        }
+                      end
+                  | fname => DataIO.inputData fname
+                (* end case *))
+          in
+            { nbody = nbody,
+              bodies = bodies,
+              headline = headline,
+              outfile = GetParam.getParam "out",
+              dtime = GetParam.getRParam "dtime",
+              eps = GetParam.getRParam "eps",
+              tol = GetParam.getRParam "tol",
+              tnow = tnow,
+              tstop = GetParam.getRParam "tstop",
+              dtout = GetParam.getRParam "dtout",
+              debug = GetParam.getBParam "debug",
+              rmin = V.tabulate (fn _ => ~2.0),
+              rsize = 4.0
+            }
+          end
 
   (* advance N-body system one time-step. *)
     fun stepSystem output {plist, dtime, eps, nstep, rmin, rsize, tnow, tol} = let
-	  val dthf = 0.5 * dtime
-	  val S.Space{rmin, rsize, root} = L.makeTree (plist, rmin, rsize)
-	(* recalculate accelaration *)
-	  fun recalc ([], n2bcalc, nbccalc, selfint) = (n2bcalc, nbccalc, selfint)
-	    | recalc (p::r, n2bcalc, nbccalc, selfint) = let
-		val S.Body{acc as ref acc1, vel, ...} = p
-		val {n2bterm, nbcterm, skipSelf} = G.hackGrav {
-			body = p, root = root, rsize = rsize, eps = eps, tol = tol
-		      }
-		in
-		  if (nstep > 0)
-		    then (* use change in accel to make 2nd order *)
-			 (* correction to vel. *)
-		      vel := V.addv(!vel, V.mulvs(V.subv(!acc, acc1), dthf))
-		    else ();
-		  recalc (r, n2bcalc+n2bterm, nbccalc+nbcterm,
-		    if skipSelf then selfint else (selfint+1))
-		end
-	(* advance bodies *)
-	  fun advance (S.Body{pos, acc, vel, ...}) = let
-		val dvel = V.mulvs (!acc, dthf)
-		val vel1 = V.addv (!vel, dvel)
-		val dpos = V.mulvs (vel1, dtime)
-		in
-		  pos := V.addv (!pos, dpos);
-		  vel := V.addv (vel1, dvel)
-		end
-	  val (n2bcalc, nbccalc, selfint) = recalc (plist, 0, 0, 0)
-	  in
-	    output {nstep=nstep, tnow=tnow, n2bcalc=n2bcalc, nbccalc=nbccalc, selfint=selfint};
-	    app advance plist;
-	    (nstep+1, tnow + dtime)
-	  end
+          val dthf = 0.5 * dtime
+          val S.Space{rmin, rsize, root} = L.makeTree (plist, rmin, rsize)
+        (* recalculate accelaration *)
+          fun recalc ([], n2bcalc, nbccalc, selfint) = (n2bcalc, nbccalc, selfint)
+            | recalc (p::r, n2bcalc, nbccalc, selfint) = let
+                val S.Body{acc as ref acc1, vel, ...} = p
+                val {n2bterm, nbcterm, skipSelf} = G.hackGrav {
+                        body = p, root = root, rsize = rsize, eps = eps, tol = tol
+                      }
+                in
+                  if (nstep > 0)
+                    then (* use change in accel to make 2nd order *)
+                         (* correction to vel. *)
+                      vel := V.addv(!vel, V.mulvs(V.subv(!acc, acc1), dthf))
+                    else ();
+                  recalc (r, n2bcalc+n2bterm, nbccalc+nbcterm,
+                    if skipSelf then selfint else (selfint+1))
+                end
+        (* advance bodies *)
+          fun advance (S.Body{pos, acc, vel, ...}) = let
+                val dvel = V.mulvs (!acc, dthf)
+                val vel1 = V.addv (!vel, dvel)
+                val dpos = V.mulvs (vel1, dtime)
+                in
+                  pos := V.addv (!pos, dpos);
+                  vel := V.addv (vel1, dvel)
+                end
+          val (n2bcalc, nbccalc, selfint) = recalc (plist, 0, 0, 0)
+          in
+            output {nstep=nstep, tnow=tnow, n2bcalc=n2bcalc, nbccalc=nbccalc, selfint=selfint};
+            app advance plist;
+            (nstep+1, tnow + dtime)
+          end
 
   (* given an initial configuration, run the simulation *)
     fun go {
-	  output, bodies, tnow, tstop,
-	  dtime, eps, tol, rsize, rmin
-	} = let
-	  val step = stepSystem output
-	  fun loop (nstep, tnow) = if (tnow < tstop + (0.1 * dtime))
-		then loop (step {
-		    plist = bodies, dtime = dtime, eps = eps, nstep = nstep,
-		    rmin = rmin, rsize = rsize, tnow = tnow, tol = tol
-		  })
-		else ()
-	  in
-	    loop (0, tnow)
-	  end
+          output, bodies, tnow, tstop,
+          dtime, eps, tol, rsize, rmin
+        } = let
+          val step = stepSystem output
+          fun loop (nstep, tnow) = if (tnow < tstop + (0.1 * dtime))
+                then loop (step {
+                    plist = bodies, dtime = dtime, eps = eps, nstep = nstep,
+                    rmin = rmin, rsize = rsize, tnow = tnow, tol = tol
+                  })
+                else ()
+          in
+            loop (0, tnow)
+          end
 
     fun doit () = let
-	  val { nbody, bodies, headline, outfile,
-		dtime, eps, tol, tnow, tstop, dtout,
-		debug, rsize, rmin
-	      } = startrun []
-	  fun output {nstep, tnow, n2bcalc, nbccalc, selfint} = DataIO.output{
-		  bodies = bodies, nbody = nbody,
-		  n2bcalc = n2bcalc, nbccalc = nbccalc,
+          val { nbody, bodies, headline, outfile,
+                dtime, eps, tol, tnow, tstop, dtout,
+                debug, rsize, rmin
+              } = startrun []
+          fun output {nstep, tnow, n2bcalc, nbccalc, selfint} = DataIO.output{
+                  bodies = bodies, nbody = nbody,
+                  n2bcalc = n2bcalc, nbccalc = nbccalc,
                   selfint = selfint, tnow = tnow
-		}
-	  in
-	    DataIO.initOutput {
-		outfile = outfile, headline = headline, nbody = nbody, tnow = tnow,
-		dtime = dtime, eps = eps, tol = tol, dtout = dtout, tstop = tstop
-	      };
-	    go {
-		output=output, bodies=bodies, tnow=tnow, tstop=tstop,
-		dtime=dtime, eps=eps, tol=tol, rsize=rsize, rmin=rmin
-	      };
-	    DataIO.stopOutput()
-	  end (* doit *)
+                }
+          in
+            DataIO.initOutput {
+                outfile = outfile, headline = headline, nbody = nbody, tnow = tnow,
+                dtime = dtime, eps = eps, tol = tol, dtout = dtout, tstop = tstop
+              };
+            go {
+                output=output, bodies=bodies, tnow=tnow, tstop=tstop,
+                dtime=dtime, eps=eps, tol=tol, rsize=rsize, rmin=rmin
+              };
+            DataIO.stopOutput()
+          end (* doit *)
 
   end; (* Main *)
 (* vector3.sml
@@ -1148,16 +1148,16 @@
       Real.==(x, x1) andalso Real.==(y, y1) andalso Real.==(z, z1)
 
     fun addv ({x=x1, y=y1, z=z1} : realvec, {x=x2, y=y2, z=z2}) =
-	  {x=x1+x2, y=y1+y2, z=z1+z2}
+          {x=x1+x2, y=y1+y2, z=z1+z2}
 
     fun subv ({x=x1, y=y1, z=z1} : realvec, {x=x2, y=y2, z=z2}) =
-	  {x=x1-x2, y=y1-y2, z=z1-z2}
+          {x=x1-x2, y=y1-y2, z=z1-z2}
 
     fun dotvp ({x=x1, y=y1, z=z1} : realvec, {x=x2, y=y2, z=z2}) =
-	  x1*x2 + y1*y2 + z1*z2
+          x1*x2 + y1*y2 + z1*z2
 
     fun crossvp ({x=x1, y=y1, z=z1} : realvec, {x=x2, y=y2, z=z2}) =
-	  {x = y1*z2 - z1*y2, y = x1*z2 - z1*x2, z = x1*y2 - y1*x2}
+          {x = y1*z2 - z1*y2, y = x1*z2 - z1*x2, z = x1*y2 - y1*x2}
 
     fun addvs ({x, y, z} : realvec, s) = {x=x+s, y=y+s, z=z+s}
 
@@ -1168,13 +1168,13 @@
     fun mapv f {x, y, z} = {x = f x, y = f y, z = f z}
 
     fun map3v f ({x=x1, y=y1, z=z1}, {x=x2, y=y2, z=z2}, {x=x3, y=y3, z=z3}) =
-	  {x = f(x1, x2, x3), y = f(y1, y2, y3), z = f(z1, z2, z3)}
+          {x = f(x1, x2, x3), y = f(y1, y2, y3), z = f(z1, z2, z3)}
 
     fun foldv f {x, y, z} init = f(z, f(y, f(x, init)))
 
     fun format {lp, rp, sep, cvt} {x, y, z} = String.concat[
-	    lp, cvt x, sep, cvt y, sep, cvt z, rp
-	  ]
+            lp, cvt x, sep, cvt y, sep, cvt z, rp
+          ]
 
     fun explode {x, y, z} = [x, y, z]
 
@@ -1182,28 +1182,28 @@
       | implode _ = raise Fail "implode: bad dimension"
 
     type matrix = {
-	    m00 : real, m01 : real, m02 : real,
-	    m10 : real, m11 : real, m12 : real,
-	    m20 : real, m21 : real, m22 : real
-	  }
+            m00 : real, m01 : real, m02 : real,
+            m10 : real, m11 : real, m12 : real,
+            m20 : real, m21 : real, m22 : real
+          }
 
     val zerom = {
-	    m00 = 0.0, m01 = 0.0, m02 = 0.0,
-	    m10 = 0.0, m11 = 0.0, m12 = 0.0,
-	    m20 = 0.0, m21 = 0.0, m22 = 0.0
-	  }
+            m00 = 0.0, m01 = 0.0, m02 = 0.0,
+            m10 = 0.0, m11 = 0.0, m12 = 0.0,
+            m20 = 0.0, m21 = 0.0, m22 = 0.0
+          }
 
     fun addm (a : matrix, b : matrix) = {
-	    m00=(#m00 a + #m00 b), m01=(#m01 a + #m01 b), m02=(#m02 a + #m02 b),
-	    m10=(#m10 a + #m10 b), m11=(#m11 a + #m11 b), m12=(#m12 a + #m12 b),
-	    m20=(#m20 a + #m20 b), m21=(#m21 a + #m21 b), m22=(#m22 a + #m22 b)
-	  }
+            m00=(#m00 a + #m00 b), m01=(#m01 a + #m01 b), m02=(#m02 a + #m02 b),
+            m10=(#m10 a + #m10 b), m11=(#m11 a + #m11 b), m12=(#m12 a + #m12 b),
+            m20=(#m20 a + #m20 b), m21=(#m21 a + #m21 b), m22=(#m22 a + #m22 b)
+          }
 
     fun outvp ({x=a0, y=a1, z=a2} : realvec, {x=b0, y=b1, z=b2}) = {
-	    m00=(a0*b0), m01=(a0*b1), m02=(a0*b2),
-	    m10=(a1*b0), m11=(a1*b1), m12=(a1*b2),
-	    m20=(a2*b0), m21=(a2*b1), m22=(a2*b2)
-	  }
+            m00=(a0*b0), m01=(a0*b1), m02=(a0*b2),
+            m10=(a1*b0), m11=(a1*b1), m12=(a1*b2),
+            m20=(a2*b0), m21=(a2*b1), m22=(a2*b2)
+          }
 
   end (* VectMath *)
 
@@ -1237,14 +1237,14 @@
     fun testit strm = ()
 
     fun doit n = (
-	  M3.srand 123;
-	  M3.go {
-	      output = fn _ => (),
-	      bodies = M3.testdata n,
-	      tnow = 0.0, tstop = 2.0,
-	      dtime = 0.025, eps = 0.05, tol = 1.0,
-	      rmin = M3.S.V.tabulate (fn _ => ~2.0),
-	      rsize = 4.0
-	    })
+          M3.srand 123;
+          M3.go {
+              output = fn _ => (),
+              bodies = M3.testdata n,
+              tnow = 0.0, tstop = 2.0,
+              dtime = 0.025, eps = 0.05, tol = 1.0,
+              rmin = M3.S.V.tabulate (fn _ => ~2.0),
+              rsize = 4.0
+            })
   end;
 

Modified: mlton/branches/on-20050420-cmm-branch/benchmark/tests/boyer.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/benchmark/tests/boyer.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/benchmark/tests/boyer.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -909,8 +909,8 @@
               Prop (get "implies",[Var 23, Var 22])])
 
     fun testit outstrm = if tautp (apply_subst subst term)
-	  then TextIO.output (outstrm, "Proved!\n")
-	  else TextIO.output (outstrm, "Cannot prove!\n")
+          then TextIO.output (outstrm, "Proved!\n")
+          else TextIO.output (outstrm, "Cannot prove!\n")
 
     fun doit () = (tautp (apply_subst subst term); ())
 
@@ -921,11 +921,11 @@
     val doit = 
        fn n =>
        let
-	  fun loop n =
-	     if n = 0
-	        then ()
-	     else (Main.doit ();
-		   loop(n-1))
+          fun loop n =
+             if n = 0
+                then ()
+             else (Main.doit ();
+                   loop(n-1))
        in loop n
        end
   end;

Modified: mlton/branches/on-20050420-cmm-branch/benchmark/tests/checksum.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/benchmark/tests/checksum.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/benchmark/tests/checksum.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -14,11 +14,11 @@
 fun fold f b (buf, first, last) =
    let
       fun loop (i, ac) =
-	 if i > last
-	    then ac
-	 else loop (i + 1,
-		    f (Word32.fromLarge (PackWord32Little.subArr (buf, i)),
-		       ac))
+         if i > last
+            then ac
+         else loop (i + 1,
+                    f (Word32.fromLarge (PackWord32Little.subArr (buf, i)),
+                       ac))
    in
       loop (first, b)
    end
@@ -28,19 +28,19 @@
 structure Main =
    struct
       fun doit n =
-	 let
-	    val first = 0
-	    val size = 10000000
-	    val buf = Word8Array.array (size, 0w0)
-	    val bytesPerWord = 4
-	    val last = size div bytesPerWord - 1
-	    val rec loop =
-	       fn 0 => ()
-		| n =>
-		     let val w = checksum (buf, first, last)
-			val _ = if w <> 0w0 then raise Fail "bug" else ()
-		     in loop (n - 1)
-		     end
-	 in loop n
-	 end
+         let
+            val first = 0
+            val size = 10000000
+            val buf = Word8Array.array (size, 0w0)
+            val bytesPerWord = 4
+            val last = size div bytesPerWord - 1
+            val rec loop =
+               fn 0 => ()
+                | n =>
+                     let val w = checksum (buf, first, last)
+                        val _ = if w <> 0w0 then raise Fail "bug" else ()
+                     in loop (n - 1)
+                     end
+         in loop n
+         end
    end

Modified: mlton/branches/on-20050420-cmm-branch/benchmark/tests/count-graphs.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/benchmark/tests/count-graphs.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/benchmark/tests/count-graphs.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -6,45 +6,45 @@
  * My favorite high-order procedure.
  *)
 fun fold (lst, folder, state) =
-	let fun loop (lst, state) =
-			case lst of
-			[] => state
-			| first::rest => loop (rest, folder (first, state))
-	in loop (lst, state)
-	end
+        let fun loop (lst, state) =
+                        case lst of
+                        [] => state
+                        | first::rest => loop (rest, folder (first, state))
+        in loop (lst, state)
+        end
 
 fun naturalFold (limit, folder, state) =
-	if limit < 0
-	    then raise Domain
-	    else let fun loop (i, state) =
-			     if i = limit
-				 then state
-				 else loop (i+1, folder (i, state))
-		 in loop (0, state)
-		 end
+        if limit < 0
+            then raise Domain
+            else let fun loop (i, state) =
+                             if i = limit
+                                 then state
+                                 else loop (i+1, folder (i, state))
+                 in loop (0, state)
+                 end
 
 fun naturalAny (limit, ok) =
-	if limit < 0
-	    then raise Domain
-	    else let fun loop i =
-			     i <> limit andalso
-				 (ok i orelse loop (i+1))
-		 in loop 0
-		 end
+        if limit < 0
+            then raise Domain
+            else let fun loop i =
+                             i <> limit andalso
+                                 (ok i orelse loop (i+1))
+                 in loop 0
+                 end
 
 fun naturalAll (limit, ok) =
-	if limit < 0
-	    then raise Domain
-	    else let fun loop i =
-			     i = limit orelse
-				 (ok i andalso loop (i+1))
-		 in loop 0
-		 end
+        if limit < 0
+            then raise Domain
+            else let fun loop i =
+                             i = limit orelse
+                                 (ok i andalso loop (i+1))
+                 in loop 0
+                 end
 (*
  * Fold over all permutations.
  * Universe is a list of all the items to be permuted.
  * pFolder is used to build up the permutation.  It is called via
- *	pFolder (next, pState, state, accross)
+ *      pFolder (next, pState, state, accross)
  * where next is the next item in the permutation, pState is the
  * partially constructed permutation and state is the current fold
  * state over permutations that have already been considered.
@@ -55,47 +55,47 @@
  * return (newPState, newState).
  * When a permutation has been completely constructed, folder is called
  * via
- *	folder (pState, state)
+ *      folder (pState, state)
  * where pState is the final pState and state is the current state.
  * It should return the new state.
  *)
 fun 'a foldOverPermutations (universe, pFolder, pState, folder, state: 'a) =
-	let exception accross of 'a
-	    fun outer (universe, pState, state) =
-		    case universe of
-		    [] => folder (pState, state)
-		    | first::rest =>
-			let fun inner (first, rest, revOut, state) =
-				    let val state =
-						let val (newPState, state) =
-							    pFolder (first,
-								     pState,
-								     state,
-								     accross)
-						in outer (fold (revOut,
-								op ::,
-								rest),
-							  newPState,
-							  state)
-						end handle accross state => state
-				    in case rest of
-				       [] => state
-				       | second::rest =>
-					   inner (second,
-						  rest,
-						  first::revOut,
-						  state)
-				    end
-			in inner (first, rest, [], state)
-			end
-	in outer (universe, pState, state)
-	end
+        let exception accross of 'a
+            fun outer (universe, pState, state) =
+                    case universe of
+                    [] => folder (pState, state)
+                    | first::rest =>
+                        let fun inner (first, rest, revOut, state) =
+                                    let val state =
+                                                let val (newPState, state) =
+                                                            pFolder (first,
+                                                                     pState,
+                                                                     state,
+                                                                     accross)
+                                                in outer (fold (revOut,
+                                                                op ::,
+                                                                rest),
+                                                          newPState,
+                                                          state)
+                                                end handle accross state => state
+                                    in case rest of
+                                       [] => state
+                                       | second::rest =>
+                                           inner (second,
+                                                  rest,
+                                                  first::revOut,
+                                                  state)
+                                    end
+                        in inner (first, rest, [], state)
+                        end
+        in outer (universe, pState, state)
+        end
 (*
  * Fold over all arrangements of bag elements.
  * Universe is a list of lists of items, with equivalent items in the
  * same list.
  * pFolder is used to build up the permutation.  It is called via
- *	pFolder (next, pState, state, accross)
+ *      pFolder (next, pState, state, accross)
  * where next is the next item in the permutation, pState is the
  * partially constructed permutation and state is the current fold
  * state over permutations that have already been considered.
@@ -106,96 +106,96 @@
  * return (newPState, newState).
  * When a permutation has been completely constructed, folder is called
  * via
- *	folder (pState, state)
+ *      folder (pState, state)
  * where pState is the final pState and state is the current state.
  * It should return the new state.
  *)
 fun 'a foldOverBagPerms (universe, pFolder, pState, folder, state: 'a) =
-	let exception accross of 'a
-	    fun outer (universe, pState, state) =
-		    case universe of
-		    [] => folder (pState, state)
-		    | (fbag as (first::fclone))::rest =>
-			let fun inner (fbag, first, fclone, rest, revOut, state) =
-				    let val state =
-						let val (newPState, state) =
-							    pFolder (first,
-								     pState,
-								     state,
-								     accross)
-						in outer (fold (revOut,
-								op ::,
-								case fclone of
-								[] => rest
-								| _ => fclone::rest),
-							  newPState,
-							  state)
-						end handle accross state => state
-				    in case rest of
-				       [] => state
-				       | (sbag as (second::sclone))::rest =>
-					   inner (sbag,
-						  second,
-						  sclone,
-						  rest,
-						  fbag::revOut,
-						  state)
-				    end
-			in inner (fbag, first, fclone, rest, [], state)
-			end
-	in outer (universe, pState, state)
-	end
+        let exception accross of 'a
+            fun outer (universe, pState, state) =
+                    case universe of
+                    [] => folder (pState, state)
+                    | (fbag as (first::fclone))::rest =>
+                        let fun inner (fbag, first, fclone, rest, revOut, state) =
+                                    let val state =
+                                                let val (newPState, state) =
+                                                            pFolder (first,
+                                                                     pState,
+                                                                     state,
+                                                                     accross)
+                                                in outer (fold (revOut,
+                                                                op ::,
+                                                                case fclone of
+                                                                [] => rest
+                                                                | _ => fclone::rest),
+                                                          newPState,
+                                                          state)
+                                                end handle accross state => state
+                                    in case rest of
+                                       [] => state
+                                       | (sbag as (second::sclone))::rest =>
+                                           inner (sbag,
+                                                  second,
+                                                  sclone,
+                                                  rest,
+                                                  fbag::revOut,
+                                                  state)
+                                    end
+                        in inner (fbag, first, fclone, rest, [], state)
+                        end
+        in outer (universe, pState, state)
+        end
 (*
  * Fold over the tree of subsets of the elements of universe.
  * The tree structure comes from the root picking if the first element
  * is in the subset, etc.
  * eFolder is called to build up the subset given a decision on wether
  * or not a given element is in it or not.  It is called via
- *	eFolder (elem, isinc, eState, state, fini)
+ *      eFolder (elem, isinc, eState, state, fini)
  * If this determines the result of folding over all the subsets consistant
  * with the choice so far, then eFolder should raise the exception
- *	fini newState
+ *      fini newState
  * If we need to proceed deeper in the tree, then eFolder should return
  * the tuple
- *	(newEState, newState)
+ *      (newEState, newState)
  * folder is called to buld up the final state, folding over subsets
  * (represented as the terminal eStates).  It is called via
- *	folder (eState, state)
+ *      folder (eState, state)
  * It returns the new state.
  * Note, the order in which elements are folded (via eFolder) is the same
  * as the order in universe.
  *)
 fun 'a foldOverSubsets (universe, eFolder, eState, folder, state: 'a) =
-	let exception fini of 'a
-	    fun f (first, rest, eState) (isinc, state) =
-		    let val (newEState, newState) =
-				eFolder (first,
-					 isinc,
-					 eState,
-					 state,
-					 fini)
-		    in outer (rest, newEState, newState)
-		    end handle fini state => state
-	    and outer (universe, eState, state) =
-			case universe of
-			[] => folder (eState, state)
-			| first::rest =>
-			    let val f = f (first, rest, eState)
-			    in f (false, f (true, state))
-			    end
-	    in outer (universe, eState, state)
-	    end
+        let exception fini of 'a
+            fun f (first, rest, eState) (isinc, state) =
+                    let val (newEState, newState) =
+                                eFolder (first,
+                                         isinc,
+                                         eState,
+                                         state,
+                                         fini)
+                    in outer (rest, newEState, newState)
+                    end handle fini state => state
+            and outer (universe, eState, state) =
+                        case universe of
+                        [] => folder (eState, state)
+                        | first::rest =>
+                            let val f = f (first, rest, eState)
+                            in f (false, f (true, state))
+                            end
+            in outer (universe, eState, state)
+            end
 
 fun f universe =
-	foldOverSubsets (universe,
-			 fn (elem, isinc, set, state, _) =>
-			     (if isinc
-				  then elem::set
-				  else set,
-			      state),
-			 [],
-			 fn (set, sets) => set::sets,
-			 [])
+        foldOverSubsets (universe,
+                         fn (elem, isinc, set, state, _) =>
+                             (if isinc
+                                  then elem::set
+                                  else set,
+                              state),
+                         [],
+                         fn (set, sets) => set::sets,
+                         [])
 (*
  * Given a partitioning of [0, size) into equivalence classes (as a list
  * of the classes, where each class is a list of integers), and where two
@@ -205,46 +205,46 @@
  * In the result, two equivalent vertices in [0, size) remain equivalent
  * iff they are either both connected or neither is connected to size.
  * The vertex size is equivalent to a vertex x in [0, size) iff
- *	connected (size, y) = connected (x, if y = x then size else y)
+ *      connected (size, y) = connected (x, if y = x then size else y)
  * for all y in [0, size).
  *)
 fun refine (size: int,
-	    classes: int list list,
-	    connected: int*int -> bool): int list list =
-	let fun sizeMatch x =
-		(* Check if vertex size is equivalent to vertex x. *)
-		    naturalAll (size,
-				fn y => connected (size, y) =
-					    connected (x,
-						       if y = x
-							   then size
-							   else y))
-	    fun merge (class, (merged, classes)) =
-		(* Add class into classes, testing if size should be merged. *)
-		    if merged
-			then (true, (rev class)::classes)
-			else let val first::_ = class
-			     in if sizeMatch first
-				    then (true, fold (class,
-						      op ::,
-						      [size])::classes)
-				    else (false, (rev class)::classes)
-			     end
-	    fun split (elem, (yes, no)) =
-		    if connected (elem, size)
-			then (elem::yes, no)
-			else (yes, elem::no)
-	    fun subdivide (class, state) =
-		    case class of
-		    [first] => merge (class, state)
-		    | _ => case fold (class, split, ([], [])) of
-			   ([], no) => merge (no, state)
-			   | (yes, []) => merge (yes, state)
-			   | (yes, no) => merge (no, merge (yes, state))
-	in case fold (classes, subdivide, (false, [])) of
-	   (true, classes) => rev classes
-	   | (false, classes) => fold (classes, op ::, [[size]])
-	end
+            classes: int list list,
+            connected: int*int -> bool): int list list =
+        let fun sizeMatch x =
+                (* Check if vertex size is equivalent to vertex x. *)
+                    naturalAll (size,
+                                fn y => connected (size, y) =
+                                            connected (x,
+                                                       if y = x
+                                                           then size
+                                                           else y))
+            fun merge (class, (merged, classes)) =
+                (* Add class into classes, testing if size should be merged. *)
+                    if merged
+                        then (true, (rev class)::classes)
+                        else let val first::_ = class
+                             in if sizeMatch first
+                                    then (true, fold (class,
+                                                      op ::,
+                                                      [size])::classes)
+                                    else (false, (rev class)::classes)
+                             end
+            fun split (elem, (yes, no)) =
+                    if connected (elem, size)
+                        then (elem::yes, no)
+                        else (yes, elem::no)
+            fun subdivide (class, state) =
+                    case class of
+                    [first] => merge (class, state)
+                    | _ => case fold (class, split, ([], [])) of
+                           ([], no) => merge (no, state)
+                           | (yes, []) => merge (yes, state)
+                           | (yes, no) => merge (no, merge (yes, state))
+        in case fold (classes, subdivide, (false, [])) of
+           (true, classes) => rev classes
+           | (false, classes) => fold (classes, op ::, [[size]])
+        end
 (*
  * Given a count of the number of vertices, a partitioning of the vertices
  * into equivalence classes (where two vertices are equivalent iff
@@ -252,55 +252,55 @@
  * two distinct vertices, returns a bool indicating if there is an edge
  * connecting them, check if the graph is minimal.
  * If it is, return
- *	SOME how-many-clones-we-walked-through
+ *      SOME how-many-clones-we-walked-through
  * If not, return NONE.
  * A graph is minimal iff its connection matrix is (weakly) smaller
  * then all its permuted friends, where true is less than false, and
  * the entries are compared lexicographically in the following order:
- *	-
- *	0 -
- *	1 2 -
- *	3 4 5 -
- *	...
+ *      -
+ *      0 -
+ *      1 2 -
+ *      3 4 5 -
+ *      ...
  * Note, the vertices are the integers in [0, nverts).
  *)
 fun minimal (nverts: int,
-	     classes: int list list,
-	     connected: int*int -> bool): int option =
-	let val perm = Array.array (nverts, ~1)
-	    exception fini
-	    fun pFolder (new, old, state, accross) =
-		    let fun loop v =
-				if v = old
-				    then (Array.update (perm, old, new);
-					  (old + 1, state))
-				    else case (connected (old,
-							  v),
-					       connected (new,
-							  Array.sub (perm,
-								     v))) of
-					 (true, false) =>
-					     raise (accross state)
-					 | (false, true) =>
-					     raise fini
-					 | _ =>
-					     loop (v + 1)
-		    in loop 0
-		    end
-	    fun folder (_, state) =
-		    state + 1
-	in SOME (foldOverBagPerms (
-		     classes,
-		     pFolder,
-		     0,
-		     folder,
-		     0)) handle fini => NONE
-	end
+             classes: int list list,
+             connected: int*int -> bool): int option =
+        let val perm = Array.array (nverts, ~1)
+            exception fini
+            fun pFolder (new, old, state, accross) =
+                    let fun loop v =
+                                if v = old
+                                    then (Array.update (perm, old, new);
+                                          (old + 1, state))
+                                    else case (connected (old,
+                                                          v),
+                                               connected (new,
+                                                          Array.sub (perm,
+                                                                     v))) of
+                                         (true, false) =>
+                                             raise (accross state)
+                                         | (false, true) =>
+                                             raise fini
+                                         | _ =>
+                                             loop (v + 1)
+                    in loop 0
+                    end
+            fun folder (_, state) =
+                    state + 1
+        in SOME (foldOverBagPerms (
+                     classes,
+                     pFolder,
+                     0,
+                     folder,
+                     0)) handle fini => NONE
+        end
 (*
  * Fold over the tree of graphs.
  *
  * eFolder is used to fold over the choice of edges via
- *	eFolder (from, to, isinc, eState, state, accross)
+ *      eFolder (from, to, isinc, eState, state, accross)
  * with from > to.
  *
  * If eFolder knows the result of folding over all graphs which agree
@@ -308,11 +308,11 @@
  * exception carrying the resulting state as a value.
  *
  * To continue normally, it should return the tuple
- *	(newEState, newState)
+ *      (newEState, newState)
  *
  * When all decisions are made with regards to edges from `from', folder
  * is called via
- *	folder (size, eState, state, accross)
+ *      folder (size, eState, state, accross)
  * where size is the number of vertices in the graph (the last from+1) and
  * eState is the final eState for edges from `from'.
  *
@@ -323,215 +323,215 @@
  * the new state.
  *)
 fun ('a, 'b) foldOverGraphs (eFolder, eState: 'a, folder, state: 'b) =
-	let exception noextend of 'b
-	    fun makeVertss limit =
-		    Vector.tabulate (limit,
-				     fn nverts =>
-					     List.tabulate (nverts,
-							    fn v => v))
-	    val vertss = ref (makeVertss 0)
-	    fun findVerts size = (
-		    if size >= Vector.length (!vertss)
-			then vertss := makeVertss (size + 1)
-			else ();
-		    Vector.sub (!vertss, size))
-	    fun f (size, eState, state) =
-		    let val state =
-				folder (size, eState, state, noextend)
-		    in g (size+1, state)
-		    end handle noextend state => state
-	    and g (size, state) =
-		    let val indices =
-				findVerts (size - 1)
-			fun SeFolder (to, isinc, eState, state, accross) =
-				eFolder (size-1,
-					 to,
-					 isinc,
-					 eState,
-					 state,
-					 accross)
-			fun Sf (eState, state) =
-				f (size, eState, state)
-		    in foldOverSubsets (
-			indices,
-			SeFolder,
-			eState,
-			Sf,
-			state)
-		    end
-	in f (0, eState, state)
-	end
+        let exception noextend of 'b
+            fun makeVertss limit =
+                    Vector.tabulate (limit,
+                                     fn nverts =>
+                                             List.tabulate (nverts,
+                                                            fn v => v))
+            val vertss = ref (makeVertss 0)
+            fun findVerts size = (
+                    if size >= Vector.length (!vertss)
+                        then vertss := makeVertss (size + 1)
+                        else ();
+                    Vector.sub (!vertss, size))
+            fun f (size, eState, state) =
+                    let val state =
+                                folder (size, eState, state, noextend)
+                    in g (size+1, state)
+                    end handle noextend state => state
+            and g (size, state) =
+                    let val indices =
+                                findVerts (size - 1)
+                        fun SeFolder (to, isinc, eState, state, accross) =
+                                eFolder (size-1,
+                                         to,
+                                         isinc,
+                                         eState,
+                                         state,
+                                         accross)
+                        fun Sf (eState, state) =
+                                f (size, eState, state)
+                    in foldOverSubsets (
+                        indices,
+                        SeFolder,
+                        eState,
+                        Sf,
+                        state)
+                    end
+        in f (0, eState, state)
+        end
 
 (*
  * Given the size of a graph, a list of the vertices (the integers in
  * [0, size)), and the connected function, check if for all full subgraphs,
- *	3*V - 4 - 2*E >= 0 or V <= 1
+ *      3*V - 4 - 2*E >= 0 or V <= 1
  * where V is the number of vertices and E is the number of edges.
  *)
 local fun short lst =
-	case lst of
-	[] => true
-	| [_] => true
-	| _ => false
+        case lst of
+        [] => true
+        | [_] => true
+        | _ => false
 in fun okSoFar (size, verts, connected) =
-	let exception fini of unit
-	    fun eFolder (elem, isinc, eState as (ac, picked), _, accross) =
-		    (if isinc
-			 then (fold (picked,
-				     fn (p, ac) =>
-					 if connected (elem, p)
-					     then ac - 2
-					     else ac,
-				     ac + 3),
-			       elem::picked)
-			 else eState,
-		     ())
-	    fun folder ((ac, picked), state) =
-		    if ac >= 0 orelse short picked
-			then state
-			else raise (fini ())
-	in (foldOverSubsets (
-	       verts,
-	       eFolder,
-	       (~4, []),
-	       folder,
-	       ());
-	    true) handle fini () => false
-	end
+        let exception fini of unit
+            fun eFolder (elem, isinc, eState as (ac, picked), _, accross) =
+                    (if isinc
+                         then (fold (picked,
+                                     fn (p, ac) =>
+                                         if connected (elem, p)
+                                             then ac - 2
+                                             else ac,
+                                     ac + 3),
+                               elem::picked)
+                         else eState,
+                     ())
+            fun folder ((ac, picked), state) =
+                    if ac >= 0 orelse short picked
+                        then state
+                        else raise (fini ())
+        in (foldOverSubsets (
+               verts,
+               eFolder,
+               (~4, []),
+               folder,
+               ());
+            true) handle fini () => false
+        end
 end
 
 fun showGraph (size, connected) =
-	naturalFold (size,
-		     fn (from, _) => (
-			 print ((Int.toString from) ^ ":");
-			 naturalFold (size,
-				      fn (to, _) =>
-					  if from <> to andalso connected (from, to)
-					      then print (" " ^ (Int.toString to))
-					      else (),
-				      ());
-			 print "\n"),
-		     ());
+        naturalFold (size,
+                     fn (from, _) => (
+                         print ((Int.toString from) ^ ":");
+                         naturalFold (size,
+                                      fn (to, _) =>
+                                          if from <> to andalso connected (from, to)
+                                              then print (" " ^ (Int.toString to))
+                                              else (),
+                                      ());
+                         print "\n"),
+                     ());
 
 fun showList (start, sep, stop, trans) lst = (
-	start ();
-	case lst of
-	[] => ()
-	| first::rest => (
-	    trans first;
-	    fold (rest,
-		  fn (item, _) => (
-		      sep ();
-		      trans item),
-		  ()));
-	stop ())
+        start ();
+        case lst of
+        [] => ()
+        | first::rest => (
+            trans first;
+            fold (rest,
+                  fn (item, _) => (
+                      sep ();
+                      trans item),
+                  ()));
+        stop ())
 
 val showIntList = showList (
-		      fn () => print "[",
-		      fn () => print ", ",
-		      fn () => print "]",
-		      fn i => print (Int.toString i))
+                      fn () => print "[",
+                      fn () => print ", ",
+                      fn () => print "]",
+                      fn i => print (Int.toString i))
 
 val showIntListList = showList (
-		      fn () => print "[",
-		      fn () => print ", ",
-		      fn () => print "]",
-		      showIntList)
+                      fn () => print "[",
+                      fn () => print ", ",
+                      fn () => print "]",
+                      showIntList)
 
 fun h (maxSize, folder, state) =
-	let val ctab = Array.tabulate (maxSize,
-				       fn v => Array.array (v, false))
-	    val classesv = Array.array (maxSize+1, [])
-	    fun connected (from, to) =
-		let val (from, to) = if from > to
-					 then (from, to)
-					 else (to, from)
-		in Array.sub (Array.sub (ctab, from), to)
-		end
-	    fun update (from, to, value) =
-		let val (from, to) = if from > to
-					 then (from, to)
-					 else (to, from)
-		in Array.update (Array.sub (ctab, from), to, value)
-		end
-	    fun triangle (vnum, e) =
-		naturalAny (e,
-			    fn f => connected (vnum, f)
-					andalso connected (e, f))
-	    fun eFolder (from, to, isinc, _, state, accross) =
-		    if isinc andalso triangle (from, to)
-			then raise (accross state)
-			else (
-			    update (from, to, isinc);
-			    ((), state))
-	    fun Gfolder (size, _, state, accross) = (
-		    if size <> 0
-			then Array.update (classesv,
-					   size,
-					   refine (size-1,
-						   Array.sub (classesv,
-							      size-1),
-					   connected))
-			else ();
-		    case minimal (size, Array.sub (classesv, size), connected) of
-		    NONE => raise (accross state)
-		    | SOME eatMe =>
-			if okSoFar (size,
-				    List.tabulate (size, fn v => v),
-				    connected)
-			    then let val state =
-					 folder (size, connected, state)
-				 in if size = maxSize
-					then raise (accross state)
-					else state
-				 end
-			    else raise (accross state))
-	in foldOverGraphs (eFolder,
-			   (),
-			   Gfolder,
-			   state)
-	end
+        let val ctab = Array.tabulate (maxSize,
+                                       fn v => Array.array (v, false))
+            val classesv = Array.array (maxSize+1, [])
+            fun connected (from, to) =
+                let val (from, to) = if from > to
+                                         then (from, to)
+                                         else (to, from)
+                in Array.sub (Array.sub (ctab, from), to)
+                end
+            fun update (from, to, value) =
+                let val (from, to) = if from > to
+                                         then (from, to)
+                                         else (to, from)
+                in Array.update (Array.sub (ctab, from), to, value)
+                end
+            fun triangle (vnum, e) =
+                naturalAny (e,
+                            fn f => connected (vnum, f)
+                                        andalso connected (e, f))
+            fun eFolder (from, to, isinc, _, state, accross) =
+                    if isinc andalso triangle (from, to)
+                        then raise (accross state)
+                        else (
+                            update (from, to, isinc);
+                            ((), state))
+            fun Gfolder (size, _, state, accross) = (
+                    if size <> 0
+                        then Array.update (classesv,
+                                           size,
+                                           refine (size-1,
+                                                   Array.sub (classesv,
+                                                              size-1),
+                                           connected))
+                        else ();
+                    case minimal (size, Array.sub (classesv, size), connected) of
+                    NONE => raise (accross state)
+                    | SOME eatMe =>
+                        if okSoFar (size,
+                                    List.tabulate (size, fn v => v),
+                                    connected)
+                            then let val state =
+                                         folder (size, connected, state)
+                                 in if size = maxSize
+                                        then raise (accross state)
+                                        else state
+                                 end
+                            else raise (accross state))
+        in foldOverGraphs (eFolder,
+                           (),
+                           Gfolder,
+                           state)
+        end
 
 local fun final (size: int, connected: int * int -> bool): int =
-	naturalFold (size,
-		     fn (from, ac) =>
-			 naturalFold (from,
-				      fn (to, ac) =>
-					  if connected (from, to)
-					      then ac - 2
-					      else ac,
-				      ac),
-		     3*size - 4)
+        naturalFold (size,
+                     fn (from, ac) =>
+                         naturalFold (from,
+                                      fn (to, ac) =>
+                                          if connected (from, to)
+                                              then ac - 2
+                                              else ac,
+                                      ac),
+                     3*size - 4)
 in fun f maxSize =
-	h (maxSize,
-	   fn (size, connected, state) =>
-		   if final (size, connected) = 0
-		       then state + 1
-		       else state,
-	   0)
+        h (maxSize,
+           fn (size, connected, state) =>
+                   if final (size, connected) = 0
+                       then state + 1
+                       else state,
+           0)
 end
 
 fun doOne arg = (
-	print (arg ^ " -> ");
-	case Int.fromString arg of
-	SOME n =>
-		print ((Int.toString (f n)) ^ "\n")
-	| NONE =>
-		print "NOT A NUMBER\n")
+        print (arg ^ " -> ");
+        case Int.fromString arg of
+        SOME n =>
+                print ((Int.toString (f n)) ^ "\n")
+        | NONE =>
+                print "NOT A NUMBER\n")
 
    structure Main =
       struct
-	 fun doit() =
-	    List.app doOne ["0", "1", "2", "3", "4", "5", "6", "7", "8", "9", "10", "11"]
+         fun doit() =
+            List.app doOne ["0", "1", "2", "3", "4", "5", "6", "7", "8", "9", "10", "11"]
 
-	 val doit =
-	    fn size =>
-	    let
-	       fun loop n =
-		  if n = 0
-		     then ()
-		  else (doit();
-			loop(n-1))
-	    in loop size
-	    end
+         val doit =
+            fn size =>
+            let
+               fun loop n =
+                  if n = 0
+                     then ()
+                  else (doit();
+                        loop(n-1))
+            in loop size
+            end
       end

Modified: mlton/branches/on-20050420-cmm-branch/benchmark/tests/fft.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/benchmark/tests/fft.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/benchmark/tests/fft.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -91,87 +91,87 @@
   let
      fun find_num_points i m =
         if i < np
-	   then find_num_points (i+i) (m+1)
-	else (i,m)
+           then find_num_points (i+i) (m+1)
+        else (i,m)
      val (n,m) = find_num_points 2 1
 (*     val _ = (printi n ;
-	      print "\n" ;
-	      printi m ;
-	      print "\n") *)
+              print "\n" ;
+              printi m ;
+              print "\n") *)
   in
      if n <> np then
-	let
-	   fun loop i =
-	      if i > n then ()
-	      else (update(px, i, 0.0);
-		    update(py, i, 0.0);
-		    loop (i+1))
-	in
-	   loop (np+1);
-	   print "Use "; printi n; print " point fft\n"
-	end
+        let
+           fun loop i =
+              if i > n then ()
+              else (update(px, i, 0.0);
+                    update(py, i, 0.0);
+                    loop (i+1))
+        in
+           loop (np+1);
+           print "Use "; printi n; print " point fft\n"
+        end
      else ();
-	
+        
      let
-	fun loop_k k n2 =
-	   if k >= m then ()
-	   else
-	      let
-		 val n4 = n2 div 4
-		 val e  = tpi / (real n2)
-		 fun loop_j j a =
-		    if j > n4 then ()
-		    else
-		       let val a3 = 3.0 * a
-			  val cc1 = cos(a)
-			  val ss1 = sin(a)
-			  val cc3 = cos(a3)
-			  val ss3 = sin(a3)
-			  fun loop_is is id =
-			     if is >= n
-				then ()
-			     else
-				let
-				   fun loop_i0 i0 =
-				      if i0 >= n
-					 then ()
-				      else
-					 let val i1 = i0 + n4
-					    val i2 = i1 + n4
-					    val i3 = i2 + n4
-					    val r1 = sub(px, i0) - sub(px, i2)
-					    val _ = update(px, i0, sub(px, i0) + sub(px, i2))
-					    val r2 = sub(px, i1) - sub(px, i3)
-					    val _ = update(px, i1, sub(px, i1) + sub(px, i3))
-					    val s1 = sub(py, i0) - sub(py, i2)
-					    val _ = update(py, i0, sub(py, i0) + sub(py, i2))
-					    val s2 = sub(py, i1) - sub(py, i3)
-					    val _ = update(py, i1, sub(py, i1) + sub(py, i3))
-					    val s3 = r1 - s2
-					    val r1 = r1 + s2
-					    val s2 = r2 - s1
-					    val r2 = r2 + s1
-					    val _ = update(px, i2, r1*cc1 - s2*ss1)
-					    val _ = update(py, i2, ~s2*cc1 - r1*ss1)
-					    val _ = update(px, i3, s3*cc3 + r2*ss3)
-					    val _ = update(py, i3, r2*cc3 - s3*ss3)
-					 in
-					    loop_i0 (i0 + id)
-					 end
-				in
-				   loop_i0 is;
-				   loop_is (2 * id - n2 + j) (4 * id)
-				end
-		       in
-			  loop_is j (2 * n2);
-			  loop_j (j+1) (e * real j)
-		       end
-	      in
-		 loop_j 1 0.0;
-		 loop_k (k+1) (n2 div 2)
-	      end
+        fun loop_k k n2 =
+           if k >= m then ()
+           else
+              let
+                 val n4 = n2 div 4
+                 val e  = tpi / (real n2)
+                 fun loop_j j a =
+                    if j > n4 then ()
+                    else
+                       let val a3 = 3.0 * a
+                          val cc1 = cos(a)
+                          val ss1 = sin(a)
+                          val cc3 = cos(a3)
+                          val ss3 = sin(a3)
+                          fun loop_is is id =
+                             if is >= n
+                                then ()
+                             else
+                                let
+                                   fun loop_i0 i0 =
+                                      if i0 >= n
+                                         then ()
+                                      else
+                                         let val i1 = i0 + n4
+                                            val i2 = i1 + n4
+                                            val i3 = i2 + n4
+                                            val r1 = sub(px, i0) - sub(px, i2)
+                                            val _ = update(px, i0, sub(px, i0) + sub(px, i2))
+                                            val r2 = sub(px, i1) - sub(px, i3)
+                                            val _ = update(px, i1, sub(px, i1) + sub(px, i3))
+                                            val s1 = sub(py, i0) - sub(py, i2)
+                                            val _ = update(py, i0, sub(py, i0) + sub(py, i2))
+                                            val s2 = sub(py, i1) - sub(py, i3)
+                                            val _ = update(py, i1, sub(py, i1) + sub(py, i3))
+                                            val s3 = r1 - s2
+                                            val r1 = r1 + s2
+                                            val s2 = r2 - s1
+                                            val r2 = r2 + s1
+                                            val _ = update(px, i2, r1*cc1 - s2*ss1)
+                                            val _ = update(py, i2, ~s2*cc1 - r1*ss1)
+                                            val _ = update(px, i3, s3*cc3 + r2*ss3)
+                                            val _ = update(py, i3, r2*cc3 - s3*ss3)
+                                         in
+                                            loop_i0 (i0 + id)
+                                         end
+                                in
+                                   loop_i0 is;
+                                   loop_is (2 * id - n2 + j) (4 * id)
+                                end
+                       in
+                          loop_is j (2 * n2);
+                          loop_j (j+1) (e * real j)
+                       end
+              in
+                 loop_j 1 0.0;
+                 loop_k (k+1) (n2 div 2)
+              end
      in
-	loop_k 1 n
+        loop_k 1 n
      end;
      
 (************************************)
@@ -181,9 +181,9 @@
 let fun loop_is is id = if is >= n then () else
    let fun loop_i0 i0 = if i0 > n then () else
       let val i1 = i0 + 1
-	 val r1 = sub(px, i0)
-	 val _ = update(px, i0, r1 + sub(px, i1))
-	 val _ = update(px, i1, r1 - sub(px, i1))
+         val r1 = sub(px, i0)
+         val _ = update(px, i0, r1 + sub(px, i1))
+         val _ = update(px, i1, r1 - sub(px, i1))
           val r1 = sub(py, i0)
           val _ = update(py, i0, r1 + sub(py, i1))
           val _ = update(py, i1, r1 - sub(py, i1))
@@ -204,24 +204,24 @@
 
   let
      fun loop_i i j =
-	if i >= n
-	   then ()
-	else
-	   (if i < j
-	       then (let val xt = sub(px, j)
-		     in update(px, j, sub(px, i)); update(px, i, xt)
-		     end;
-		     let val xt = sub(py, j)
-		     in update(py, j, sub(py, i)); update(py, i, xt)
-		     end)
-	    else ();
-	    let
-	       fun loop_k k j =
-		  if k < j then loop_k (k div 2) (j-k) else j+k
-	       val j' = loop_k (n div 2) j
-	    in
-	       loop_i (i+1) j'
-	    end)
+        if i >= n
+           then ()
+        else
+           (if i < j
+               then (let val xt = sub(px, j)
+                     in update(px, j, sub(px, i)); update(px, i, xt)
+                     end;
+                     let val xt = sub(py, j)
+                     in update(py, j, sub(py, i)); update(py, i, xt)
+                     end)
+            else ();
+            let
+               fun loop_k k j =
+                  if k < j then loop_k (k div 2) (j-k) else j+k
+               val j' = loop_k (n div 2) j
+            in
+               loop_i (i+1) j'
+            end)
   in
      loop_i 1 1
   end;

Modified: mlton/branches/on-20050420-cmm-branch/benchmark/tests/fib.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/benchmark/tests/fib.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/benchmark/tests/fib.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -6,13 +6,13 @@
 structure Main =
    struct
       fun doit n =
-	 if n = 0
-	    then ()
-	 else let
-		 val _ = if 165580141 <> fib 41
-			    then raise Fail "bug"
-			 else ()
-	      in
-		 doit (n - 1)
-	      end
+         if n = 0
+            then ()
+         else let
+                 val _ = if 165580141 <> fib 41
+                            then raise Fail "bug"
+                         else ()
+              in
+                 doit (n - 1)
+              end
    end

Modified: mlton/branches/on-20050420-cmm-branch/benchmark/tests/flat-array.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/benchmark/tests/flat-array.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/benchmark/tests/flat-array.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,20 +1,20 @@
 structure Main =
    struct
       fun doit n =
-	 let
-	    val v = Vector.tabulate (1000000, fn i => (i, i + 1))
-	    fun loop n =
-	       if 0 = n
-		  then ()
-	       else
-		  let
-		     val sum = Vector.foldl (fn ((a, b), c) =>
-					     a + b + c handle Overflow => 0) 0 v
-		  in
-		     loop (n - 1)
-		  end
-	 in
-	    loop n
-	 end
+         let
+            val v = Vector.tabulate (1000000, fn i => (i, i + 1))
+            fun loop n =
+               if 0 = n
+                  then ()
+               else
+                  let
+                     val sum = Vector.foldl (fn ((a, b), c) =>
+                                             a + b + c handle Overflow => 0) 0 v
+                  in
+                     loop (n - 1)
+                  end
+         in
+            loop n
+         end
    end
 

Modified: mlton/branches/on-20050420-cmm-branch/benchmark/tests/fxp.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/benchmark/tests/fxp.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/benchmark/tests/fxp.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -57,18 +57,18 @@
       (* run f on x, and measure the runtime. return the result and time.   *)
       (*--------------------------------------------------------------------*)
       fun time f x = let val timer = Timer.startCPUTimer ()
-			 val y     = f x
-			 val ptime = Timer.checkCPUTimer timer
-		     in (y,ptime)
-		     end
-		  
+                         val y     = f x
+                         val ptime = Timer.checkCPUTimer timer
+                     in (y,ptime)
+                     end
+                  
       (*--------------------------------------------------------------------*)
       (* run f n times on x, and measure the runtime. return the time.      *)
       (*--------------------------------------------------------------------*)
       fun timeN n f x = 
-	 let fun iter m = if m<=1 then f x else (ignore (f x); iter (m-1))
-	 in time iter n
-	 end
+         let fun iter m = if m<=1 then f x else (ignore (f x); iter (m-1))
+         in time iter n
+         end
     end
 (* stop of ../../Util/utilTime.sml *)
 (* start of ../../Util/utilString.sml *)
@@ -97,7 +97,7 @@
       val Bool2String    : bool -> string
 
       val Option2xString : string * (('a -> string) -> 'a -> string) 
-	 -> ('a -> string) -> 'a option -> string
+         -> ('a -> string) -> 'a option -> string
       val Option2String0 : ('a -> string) -> 'a option -> string
       val Option2String  : ('a -> string) -> 'a option -> string
 
@@ -118,21 +118,21 @@
       (* "st", "nd", "rd" or "th" to the number.                            *)
       (*--------------------------------------------------------------------*)
       fun numberNth n = 
-	 let val suffix = case n mod 9
-			    of 1 => "st"
-			     | 2 => "nd"
-			     | 3 => "rd"
-			     | _ => "th"
-	 in Int.toString n^suffix
-	 end
+         let val suffix = case n mod 9
+                            of 1 => "st"
+                             | 2 => "nd"
+                             | 3 => "rd"
+                             | _ => "th"
+         in Int.toString n^suffix
+         end
 
       (*--------------------------------------------------------------------*)
       (* is the single character c represented by a word starting with a    *)
       (* vocal in the alphabet? (l~ell->true, k~kay->false)                 *)
       (*--------------------------------------------------------------------*)
       fun vocalLetter c =
-	 case Char.toLower c 
-	   of #"a" => true 
+         case Char.toLower c 
+           of #"a" => true 
             | #"f" => true 
             | #"h" => true 
             | #"i" => true 
@@ -144,19 +144,19 @@
             | #"s" => true 
             | #"x" => true 
             | #"8" => true
-	    | _    => false
-	      
+            | _    => false
+              
       (*--------------------------------------------------------------------*)
       (* is character c a vocal?                                            *)
       (*--------------------------------------------------------------------*)
       fun isVocal c = 
-	 case Char.toLower c
-	   of #"a" => true 
+         case Char.toLower c
+           of #"a" => true 
             | #"e" => true 
             | #"i" => true 
             | #"o" => true 
             | #"u" => true
-	    | _    => false
+            | _    => false
 
       (*--------------------------------------------------------------------*)
       (* does a word require "an" as undefinite article? true if:           *)
@@ -175,22 +175,22 @@
       (* (Is english pronounciation decidable at all?)                      *)
       (*--------------------------------------------------------------------*)
       fun extendsAtoAn word = 
-	 case String.explode word 
-	   of nil => false
-	    | [c] => vocalLetter c
-	    | c1::c2::cs => if not (Char.isLower c1 orelse Char.isLower c2) 
-			       then vocalLetter c1
-			    else case Char.toLower c1
-				   of #"a" => true 
+         case String.explode word 
+           of nil => false
+            | [c] => vocalLetter c
+            | c1::c2::cs => if not (Char.isLower c1 orelse Char.isLower c2) 
+                               then vocalLetter c1
+                            else case Char.toLower c1
+                                   of #"a" => true 
                                     | #"i" => true 
                                     | #"o" => true
-				    | #"e" => Char.toLower c2 <> #"u"
-				    | #"u" => if isVocal c2 then false
-					      else (case cs
-						      of nil => true
-						       | c3::_ => Char.toLower c3 <> #"i")
-				    | _ => false
-						 
+                                    | #"e" => Char.toLower c2 <> #"u"
+                                    | #"u" => if isVocal c2 then false
+                                              else (case cs
+                                                      of nil => true
+                                                       | c3::_ => Char.toLower c3 <> #"i")
+                                    | _ => false
+                                                 
       (*--------------------------------------------------------------------*)
       (* add an undefinite article to a word.                               *)
       (*--------------------------------------------------------------------*)
@@ -202,7 +202,7 @@
       fun nCharsC c n = if n>0 then c::nCharsC c (n-1) else nil
       fun nChars c n = String.implode (nCharsC c n)
       val nBlanks = nChars #" "
-	 
+         
       (*--------------------------------------------------------------------*)
       (* add a minimal number of characters c to the left/right of a string *)
       (* in order to make its length at least n.                            *)
@@ -211,38 +211,38 @@
       fun padxRight c (s,n) = s^(nChars c (n-String.size s))
       val padLeft  = padxLeft  #" "
       val padRight  = padxRight  #" "
-	 
+         
       (*--------------------------------------------------------------------*)
       (* break a string into several lines of length width.                 *)
       (*--------------------------------------------------------------------*)
       fun breakLines width str =
-	 let 
-	    val tokens = String.tokens (fn c => #" "=c) str
-	    fun makeLine(toks,lines) = if null toks then lines 
-				       else (String.concat (rev toks))::lines
-	    fun doit w (toks,lines) nil = makeLine(toks,lines)
-	      | doit w (toks,lines) (one::rest) = 
-	       let 
-		  val l = String.size one
-		  val w1 = w+l
-	       in 
-		  if w1<width then doit (w1+1) (" "::one::toks,lines) rest
-		  else if w1=width then doit 0 (nil,makeLine(one::toks,lines)) rest
-		  else if l>=width then doit 0 (nil,one::makeLine(toks,lines)) rest
-		       else doit (l+1) ([" ",one],makeLine(toks,lines)) rest
-	       end
-	 in List.rev (doit 0 (nil,nil) tokens)
-	 end
+         let 
+            val tokens = String.tokens (fn c => #" "=c) str
+            fun makeLine(toks,lines) = if null toks then lines 
+                                       else (String.concat (rev toks))::lines
+            fun doit w (toks,lines) nil = makeLine(toks,lines)
+              | doit w (toks,lines) (one::rest) = 
+               let 
+                  val l = String.size one
+                  val w1 = w+l
+               in 
+                  if w1<width then doit (w1+1) (" "::one::toks,lines) rest
+                  else if w1=width then doit 0 (nil,makeLine(one::toks,lines)) rest
+                  else if l>=width then doit 0 (nil,one::makeLine(toks,lines)) rest
+                       else doit (l+1) ([" ",one],makeLine(toks,lines)) rest
+               end
+         in List.rev (doit 0 (nil,nil) tokens)
+         end
 
       (*--------------------------------------------------------------------*)
       (* convert the first/all characters of a string to upper case         *)
       (*--------------------------------------------------------------------*)
       fun toUpperFirst str = 
-	 case String.explode str
-	   of nil => ""
-	    | c::cs => String.implode (Char.toUpper c::cs)
+         case String.explode str
+           of nil => ""
+            | c::cs => String.implode (Char.toUpper c::cs)
       fun toUpperString str = 
-	 String.implode(map Char.toUpper (String.explode str))
+         String.implode(map Char.toUpper (String.explode str))
 
       (*--------------------------------------------------------------------*)
       (* return a string representation of an int, char or unit.            *)
@@ -250,22 +250,22 @@
       val Int2String = Int.toString
       val Char2String = Char.toString
       fun Unit2String() = "()"
-	 
+         
       (*--------------------------------------------------------------------*)
       (* return a string representation of a boolean.                       *)
       (*--------------------------------------------------------------------*)
       fun Bool2xString (t,f) b = if b then t else f
       val Bool2String = Bool2xString ("true","false")
-	 
+         
       (*--------------------------------------------------------------------*)
       (* return a string representation of an option.                       *)
       (* the first arg is a string for the NONE case, the second a function *)
       (* that converts x to a string, given a function for doing so.        *)
       (*--------------------------------------------------------------------*)
       fun Option2xString (none,Some2String) x2String opt =
-	 case opt 
-	   of NONE => none
-	    | SOME x => Some2String x2String x
+         case opt 
+           of NONE => none
+            | SOME x => Some2String x2String x
       fun Option2String0 x2String = Option2xString ("",fn f => fn x => f x) x2String
       fun Option2String x2String = Option2xString ("NONE",fn f => fn x => "SOME "^f x) x2String
 
@@ -274,11 +274,11 @@
       (* with sep and finish with post; use X2String for each element.      *)
       (*--------------------------------------------------------------------*)
       fun List2xString (pre,sep,post) X2String nil = pre^post 
-	| List2xString (pre,sep,post) X2String l   = 
-	  let fun doit nil    _   = [post]
-		| doit (x::r) str = str::X2String x::doit r sep
-	  in String.concat (doit l pre)
-	  end
+        | List2xString (pre,sep,post) X2String l   = 
+          let fun doit nil    _   = [post]
+                | doit (x::r) str = str::X2String x::doit r sep
+          in String.concat (doit l pre)
+          end
       fun List2String X2String nil = "[]"
         | List2String X2String l   =
           let fun doit nil    _   = ["]"]
@@ -301,10 +301,10 @@
       (* with sep and finish with post; use X2String for each element.      *)
       (*--------------------------------------------------------------------*)
       fun Vector2xString (pre,sep,post) X2String vec = 
-	 if Vector.length vec=0 then pre^post
-	 else String.concat
-	    (pre::X2String(Vector.sub(vec,0))::
-	     Vector.foldri (fn (_,x,yet) => sep::X2String x::yet) [post] (vec,1,NONE))
+         if Vector.length vec=0 then pre^post
+         else String.concat
+            (pre::X2String(Vector.sub(vec,0))::
+             Vector.foldri (fn (_,x,yet) => sep::X2String x::yet) [post] (vec,1,NONE))
       fun Vector2String X2String vec = Vector2xString ("#[",",","]") X2String vec
    end
 (* stop of ../../Util/utilString.sml *)
@@ -334,60 +334,60 @@
       type 'a Comparer = 'a * 'a -> order
 
       fun comparePair (compareA,compareB) ((a1,b1),(a2,b2)) = 
-	 case compareA(a1,a2)
-	   of EQUAL => compareB(b1,b2)
-	    | order => order 
+         case compareA(a1,a2)
+           of EQUAL => compareB(b1,b2)
+            | order => order 
       fun compareTriple (compareA,compareB,compareC) ((a1,b1,c1),(a2,b2,c2)) = 
-	 case compareA(a1,a2)
-	   of EQUAL => (case compareB(b1,b2)
-			  of EQUAL => compareC(c1,c2)
-			   | order => order) 
-	    | order => order 
+         case compareA(a1,a2)
+           of EQUAL => (case compareB(b1,b2)
+                          of EQUAL => compareC(c1,c2)
+                           | order => order) 
+            | order => order 
 
       val compareInt = Int.compare
       fun compareIntPair((x1,y1),(x2,y2)) =
-	 case Int.compare(x1,x2) 
-	   of EQUAL => Int.compare (y1,y2)
-	    | order => order 
+         case Int.compare(x1,x2) 
+           of EQUAL => Int.compare (y1,y2)
+            | order => order 
       fun compareIntTriple((x1,y1,z1),(x2,y2,z2)) =
-	 case Int.compare(x1,x2) 
-	   of EQUAL => (case Int.compare (y1,y2)
-			  of EQUAL => Int.compare (z1,z2)
-			   | order => order)
-	    | order => order 
+         case Int.compare(x1,x2) 
+           of EQUAL => (case Int.compare (y1,y2)
+                          of EQUAL => Int.compare (z1,z2)
+                           | order => order)
+            | order => order 
 
       val compareWord = Word.compare
       fun compareWordPair((x1,y1),(x2,y2)) =
-	 case Word.compare(x1,x2) 
-	   of EQUAL => Word.compare (y1,y2)
-	    | order => order 
+         case Word.compare(x1,x2) 
+           of EQUAL => Word.compare (y1,y2)
+            | order => order 
       fun compareWordTriple((x1,y1,z1),(x2,y2,z2)) =
-	 case Word.compare(x1,x2) 
-	   of EQUAL => (case Word.compare (y1,y2)
-			  of EQUAL => Word.compare (z1,z2)
-			   | order => order)
-	    | order => order 
+         case Word.compare(x1,x2) 
+           of EQUAL => (case Word.compare (y1,y2)
+                          of EQUAL => Word.compare (z1,z2)
+                           | order => order)
+            | order => order 
 
       fun compareOption compareA opts =
-	 case opts
-	   of (NONE,NONE) => EQUAL
-	    | (NONE,SOME x) => LESS
-	    | (SOME x,NONE) => GREATER
-	    | (SOME x,SOME y) => compareA(x,y)
+         case opts
+           of (NONE,NONE) => EQUAL
+            | (NONE,SOME x) => LESS
+            | (SOME x,NONE) => GREATER
+            | (SOME x,SOME y) => compareA(x,y)
 
       fun compareList compA ll = 
-	 let fun doit (nil,nil) = EQUAL
-	       | doit (nil,_) = LESS
-	       | doit (_,nil) = GREATER
-	       | doit (a1::as1,a2::as2) = case compA(a1,a2)
-					    of EQUAL => doit(as1,as2)
-					     | order => order
-	 in doit ll
-	 end
+         let fun doit (nil,nil) = EQUAL
+               | doit (nil,_) = LESS
+               | doit (_,nil) = GREATER
+               | doit (a1::as1,a2::as2) = case compA(a1,a2)
+                                            of EQUAL => doit(as1,as2)
+                                             | order => order
+         in doit ll
+         end
       
       fun compareVector compA (vec1,vec2) =
-	 let val (l,l2) = (Vector.length vec1,Vector.length vec2)
-	 in case Int.compare(l,l2)
+         let val (l,l2) = (Vector.length vec1,Vector.length vec2)
+         in case Int.compare(l,l2)
               of EQUAL => let fun doit i = if i>=l then EQUAL
                                            else case compA(Vector.sub(vec1,i),Vector.sub(vec2,i))
                                                   of EQUAL => doit (i+1)
@@ -423,16 +423,16 @@
 structure UtilHash : UtilHash =
    struct
       fun hashPair (hashA,hashB) (a,b) = 
-	 0w1327 * hashA a + 0w3853 * hashB b
+         0w1327 * hashA a + 0w3853 * hashB b
       fun hashTriple (hashA,hashB,hashC) (a,b,c) = 
-	 0w1327 * hashA a + 0w3853 * hashB b + 0w2851 * hashC c
+         0w1327 * hashA a + 0w3853 * hashB b + 0w2851 * hashC c
 
       val hashInt =
-	 Word.fromInt
+         Word.fromInt
       fun hashIntPair (i,j) = 
-	 0w1327 * Word.fromInt i + 0w3853 * Word.fromInt j
+         0w1327 * Word.fromInt i + 0w3853 * Word.fromInt j
       fun hashIntTriple (i,j,k) = 
-	 0w1327 * Word.fromInt i + 0w3853 * Word.fromInt j + 0w2851 * Word.fromInt k
+         0w1327 * Word.fromInt i + 0w3853 * Word.fromInt j + 0w2851 * Word.fromInt k
 
       fun hashWord w = w
       fun hashWordPair (i,j) = 0w1327 * i + 0w3853 * j
@@ -440,44 +440,44 @@
 
       val hashChar = Word.fromInt o ord 
       fun hashString s = 
-	 case String.size s
-	   of 0 => 0wx0
-	    | 1 => 0w1 + hashChar(String.sub(s,0))
-	    | 2 => let val w1 = String.sub(s,0)
-		       val w2 = String.sub(s,1)
-		   in 0w2 + hashChar w1 * 0wx1327 + hashChar w2
-		   end
-	    | n => let val w1 = String.sub(s,0)
-		       val w2 = String.sub(s,1)
-		       val wn = String.sub(s,n-1)
-		   in 0w3 + hashChar w1 * 0wx3853 + hashChar w2 * 0wx1327 + hashChar wn
-		   end
-	 
+         case String.size s
+           of 0 => 0wx0
+            | 1 => 0w1 + hashChar(String.sub(s,0))
+            | 2 => let val w1 = String.sub(s,0)
+                       val w2 = String.sub(s,1)
+                   in 0w2 + hashChar w1 * 0wx1327 + hashChar w2
+                   end
+            | n => let val w1 = String.sub(s,0)
+                       val w2 = String.sub(s,1)
+                       val wn = String.sub(s,n-1)
+                   in 0w3 + hashChar w1 * 0wx3853 + hashChar w2 * 0wx1327 + hashChar wn
+                   end
+         
 
       fun hashOption hashA opt = 
-	 case opt
-	   of NONE => 0w0
-	    | SOME a => 0w1 + hashA a
+         case opt
+           of NONE => 0w0
+            | SOME a => 0w1 + hashA a
 
       fun hashList hashA l = 
-	 case l
-	   of nil => 0wx0
-	    | [a] => 0w1 + hashA a
-	    | a1::a2::_ => 0w2 + 0w3853 * hashA a1 + 0wx1327 * hashA a2
+         case l
+           of nil => 0wx0
+            | [a] => 0w1 + hashA a
+            | a1::a2::_ => 0w2 + 0w3853 * hashA a1 + 0wx1327 * hashA a2
 
       fun hashVector hashA cv = 
-	 case Vector.length cv
-	   of 0 => 0wx0
-	    | 1 => 0w1 + hashA(Vector.sub(cv,0))
-	    | 2 => let val w1 = Vector.sub(cv,0)
-		       val w2 = Vector.sub(cv,1)
-		   in 0w2 + hashA w1 * 0wx1327 + hashA w2
-		   end
-	    | n => let val w1 = Vector.sub(cv,0)
-		       val w2 = Vector.sub(cv,1)
-		       val wn = Vector.sub(cv,n-1)
-		   in 0w3 + hashA w1 * 0wx3853 + hashA w2 * 0wx1327 + hashA wn
-		   end
+         case Vector.length cv
+           of 0 => 0wx0
+            | 1 => 0w1 + hashA(Vector.sub(cv,0))
+            | 2 => let val w1 = Vector.sub(cv,0)
+                       val w2 = Vector.sub(cv,1)
+                   in 0w2 + hashA w1 * 0wx1327 + hashA w2
+                   end
+            | n => let val w1 = Vector.sub(cv,0)
+                       val w2 = Vector.sub(cv,1)
+                       val wn = Vector.sub(cv,n-1)
+                   in 0w3 + hashA w1 * 0wx3853 + hashA w2 * 0wx1327 + hashA wn
+                   end
    end
 
 (* stop of ../../Util/utilHash.sml *)
@@ -532,59 +532,59 @@
       (* apply f to each number in [n...m]                                  *)
       (*--------------------------------------------------------------------*)
       fun appInterval f (n,m) =
-	 let fun doit i = 
-	    if i>m then () 
-	    else let val _ = f i
-		 in doit (i+1)
-		 end
-	 in doit n
-	 end
+         let fun doit i = 
+            if i>m then () 
+            else let val _ = f i
+                 in doit (i+1)
+                 end
+         in doit n
+         end
       
       (*--------------------------------------------------------------------*)
       (* insert an integer into a sorted list without duplicates.           *)
       (*--------------------------------------------------------------------*)
       fun insertInt (x:int,l) = 
-	 let fun go nil = [x]
-	       | go (l as y::ys) = case Int.compare (x,y)
-				     of LESS => x::l
-				      | EQUAL => l 
-				      | GREATER =>  y::go ys
-	 in go l
-	 end
+         let fun go nil = [x]
+               | go (l as y::ys) = case Int.compare (x,y)
+                                     of LESS => x::l
+                                      | EQUAL => l 
+                                      | GREATER =>  y::go ys
+         in go l
+         end
 
       (*--------------------------------------------------------------------*)
       (* insert an integer into a sorted list if it is not yet in it.       *)
       (*--------------------------------------------------------------------*)
       fun insertNewInt (x:int,l) = 
-	 let 
-	    fun go nil = SOME [x]
-	      | go (l as y::ys) = case Int.compare (x,y)
-				     of LESS => SOME(x::l)
-				      | EQUAL => NONE 
-				      | GREATER => case go ys
-						     of NONE => NONE
-						      | SOME xys => SOME(y::xys)
-	 in go l
-	 end
+         let 
+            fun go nil = SOME [x]
+              | go (l as y::ys) = case Int.compare (x,y)
+                                     of LESS => SOME(x::l)
+                                      | EQUAL => NONE 
+                                      | GREATER => case go ys
+                                                     of NONE => NONE
+                                                      | SOME xys => SOME(y::xys)
+         in go l
+         end
 
       (*--------------------------------------------------------------------*)
       (* compute the power to the base of two.                              *)
       (*--------------------------------------------------------------------*)
       fun powerOfTwo n = 
-	 if n=0 then 1
-	 else if n mod 2=0 then let val x=powerOfTwo (n div 2) in x*x end
-	      else let val x=powerOfTwo (n-1) in 2*x end
-	   
+         if n=0 then 1
+         else if n mod 2=0 then let val x=powerOfTwo (n div 2) in x*x end
+              else let val x=powerOfTwo (n-1) in 2*x end
+           
       (*--------------------------------------------------------------------*)
       (* find the smallest p with 2^p >= n.                                 *)
       (*--------------------------------------------------------------------*)
       fun nextPowerTwo n = 
-	 let fun doit (p,m) = 
-	    if m>=n then p
-	    else if m*m<2*n then doit (2*p,m*m)
-		 else doit (1+p,2*m)
-	 in doit (1,2)
-	 end
+         let fun doit (p,m) = 
+            if m>=n then p
+            else if m*m<2*n then doit (2*p,m*m)
+                 else doit (1+p,2*m)
+         in doit (1,2)
+         end
    end
 (* stop of ../../Util/utilInt.sml *)
 (* start of ../../Util/utilError.sml *)
@@ -609,33 +609,33 @@
       exception NoSuchFile of string * string
 
       fun formatMessage (indentWidth,lineWidth) strs =
-	 let 
-	    val indent = nBlanks indentWidth
-	    val nl = "\n"^indent
-	    val blank = " "
-	    val dot = "." 
+         let 
+            val indent = nBlanks indentWidth
+            val nl = "\n"^indent
+            val blank = " "
+            val dot = "." 
 
-	    fun isSep c = #" "=c orelse #"\n"=c orelse #"\t"=c
+            fun isSep c = #" "=c orelse #"\n"=c orelse #"\t"=c
 
-	    fun go (w,yet) nil = List.rev ("\n"::yet)
-	      | go (w,yet) (x::xs) = 
-	       let 
-		  val y = if null xs then x^dot else x 
-		  val l = String.size y
-		  val w1 = w+l
-		  val (w2,yet2) = if w1<=lineWidth then (w1,y::yet)
-				  else (indentWidth+l,y::nl::yet)
-		  val (w3,yet3) = if null xs then (w2,yet2)
-				  else (if w2<lineWidth then (w2+1,blank::yet2)
-					else (indentWidth,nl::yet2))
-	       in go (w3,yet3) xs
-	       end
-	    
-	    val tokens = List.concat (map (String.tokens isSep) strs)
-	    val fragments = go (0,nil) tokens
-	 in 
-	    String.concat fragments
-	 end
+            fun go (w,yet) nil = List.rev ("\n"::yet)
+              | go (w,yet) (x::xs) = 
+               let 
+                  val y = if null xs then x^dot else x 
+                  val l = String.size y
+                  val w1 = w+l
+                  val (w2,yet2) = if w1<=lineWidth then (w1,y::yet)
+                                  else (indentWidth+l,y::nl::yet)
+                  val (w3,yet3) = if null xs then (w2,yet2)
+                                  else (if w2<lineWidth then (w2+1,blank::yet2)
+                                        else (indentWidth,nl::yet2))
+               in go (w3,yet3) xs
+               end
+            
+            val tokens = List.concat (map (String.tokens isSep) strs)
+            val fragments = go (0,nil) tokens
+         in 
+            String.concat fragments
+         end
    end
 (* stop of ../../Util/utilError.sml *)
 (* start of ../../Util/SymDict/dict.sml *)
@@ -793,13 +793,13 @@
       fun hashKey(half,mask) x = 
          Word.toInt(Word.andb(mask,Word.>>(square(Key.hash x),half)))
       fun makeHashFun(size,width) =
-	 let 
+         let 
             val mask = 0w2*Word.fromInt size-0w1 
             val half = Word.fromInt((width+1) div 2)
-	 in 
-	    hashKey(half,mask)
-	 end
-	    
+         in 
+            hashKey(half,mask)
+         end
+            
       (*--------------------------------------------------------------------*)
       (* create a new dictionary for 2^w, but at least 2 and at most 2^m    *)
       (* entries, where m is the value of MAX_WIDTH.                        *)
@@ -822,28 +822,28 @@
       (* clear a dictionary. If the 2nd arg is SOME w, use w for resizing.  *)
       (*--------------------------------------------------------------------*)
       fun clearDict (dict:'a Dict,widthOpt) = 
-	 case widthOpt 
-	   of NONE => 
-	      let 
-		 val {tab=ref tab,hashTab=ref hashTab,size,count,def,...} = dict
-		 val _ = appInterval (fn i => Array.update(tab,i,(Key.null,def))) (0,!count-1)
-		 val _ = appInterval (fn i => Array.update(hashTab,i,nullBucket)) (0,!size*2-1)
-	      in 
-		 count := 0
-	      end
-	    | SOME w => 
-	      let 
-		 val {tab,hashTab,hashFun,width,size,count,def,...} = dict
-		 val newWidth = Int.min(Int.max(1,w),MAX_WIDTH)   
-		 val newSize  = Word.toInt(Word.<<(0w1,Word.fromInt(newWidth-1)))
-		 val _ = tab     := (Array.array(newSize,(Key.null,def)))
-		 val _ = hashTab := (Array.array(2*newSize,nullBucket))
-		 val _ = hashFun := (makeHashFun(newSize,newWidth))
-		 val _ = width   := newWidth
-		 val _ = size    := newSize
-	      in
-		 count := 0
-	      end
+         case widthOpt 
+           of NONE => 
+              let 
+                 val {tab=ref tab,hashTab=ref hashTab,size,count,def,...} = dict
+                 val _ = appInterval (fn i => Array.update(tab,i,(Key.null,def))) (0,!count-1)
+                 val _ = appInterval (fn i => Array.update(hashTab,i,nullBucket)) (0,!size*2-1)
+              in 
+                 count := 0
+              end
+            | SOME w => 
+              let 
+                 val {tab,hashTab,hashFun,width,size,count,def,...} = dict
+                 val newWidth = Int.min(Int.max(1,w),MAX_WIDTH)   
+                 val newSize  = Word.toInt(Word.<<(0w1,Word.fromInt(newWidth-1)))
+                 val _ = tab     := (Array.array(newSize,(Key.null,def)))
+                 val _ = hashTab := (Array.array(2*newSize,nullBucket))
+                 val _ = hashFun := (makeHashFun(newSize,newWidth))
+                 val _ = width   := newWidth
+                 val _ = size    := newSize
+              in
+                 count := 0
+              end
       
       (*--------------------------------------------------------------------*)
       (* grow a dictionary to the double size. raise InternalError if the   *)
@@ -853,11 +853,11 @@
          let 
             val oldTab = !tab
             val _ = if !width < MAX_WIDTH then width := !width+1 
-		    else raise InternalError 
-		       ("Dict","growDictionary",
-			String.concat ["growing the ",desc," dictionary ",
-				       "exceeded the system maximum size of ",
-				       Int.toString Array.maxLen," for arrays"]) 
+                    else raise InternalError 
+                       ("Dict","growDictionary",
+                        String.concat ["growing the ",desc," dictionary ",
+                                       "exceeded the system maximum size of ",
+                                       Int.toString Array.maxLen," for arrays"]) 
             val _ = size := !size*2
             val _ = tab  := Array.array(!size,(Key.null,def))
             val _ = hashTab := Array.array(!size*2,nullBucket)
@@ -871,7 +871,7 @@
                in ()
                end
          in 
-	    Array.appi addTo (oldTab,0,NONE)
+            Array.appi addTo (oldTab,0,NONE)
          end
 
       (*--------------------------------------------------------------------*)
@@ -950,7 +950,7 @@
       (* extract the contents of the dictionary to an array.                *)
       (*--------------------------------------------------------------------*)
       fun extractDict({count,tab,...}:'a Dict) = 
-	 Array.tabulate(!count,fn i => Array.sub(!tab,i))
+         Array.tabulate(!count,fn i => Array.sub(!tab,i))
 
       (*--------------------------------------------------------------------*)
       (* print the contents of the dictionary.                              *)
@@ -988,13 +988,13 @@
    sig
       type Key
       type SymTable
-	 
+         
       exception NoSuchSymbol
 
       val nullSymTable  : string -> SymTable
       val makeSymTable  : string * int -> SymTable
       val clearSymTable : SymTable * int option -> unit
-	 
+         
       val hasSymIndex   : SymTable * Key -> int option
       val getSymIndex   : SymTable * Key -> int
       val getSymKey     : SymTable * int -> Key
@@ -1002,7 +1002,7 @@
 
       val assignSymIndex  : SymTable * Key * int -> unit
       val reserveSymIndex : SymTable -> int
-	 
+         
       val extractSymTable : SymTable -> Key vector
       val printSymTable   : SymTable -> unit
    end
@@ -1033,28 +1033,28 @@
       (* buckets are sorted - though they are probably small.               *)
       (*--------------------------------------------------------------------*)
       fun addToBucket (ni as (key,_),bucket) = 
-	 let 
-	    fun doit nil = [ni]
-	      | doit (nis as (ni' as (key',_))::rest) = 
-	       case Key.compare (key',key)
-		 of LESS    => ni'::doit rest
-		  | EQUAL   => ni::rest 
-		  | GREATER => ni::nis
-	 in 
-	    doit bucket
-	 end
+         let 
+            fun doit nil = [ni]
+              | doit (nis as (ni' as (key',_))::rest) = 
+               case Key.compare (key',key)
+                 of LESS    => ni'::doit rest
+                  | EQUAL   => ni::rest 
+                  | GREATER => ni::nis
+         in 
+            doit bucket
+         end
       fun searchBucket (key,bucket) = 
-	 let 
-	    fun doit nil = NONE
-	      | doit ((key',i)::rest) = 
-	       case Key.compare (key',key)
-		 of LESS    => doit rest
-		  | EQUAL   => SOME i 
-		  | GREATER => NONE
-	 in 
-	    doit bucket
-	 end
-		
+         let 
+            fun doit nil = NONE
+              | doit ((key',i)::rest) = 
+               case Key.compare (key',key)
+                 of LESS    => doit rest
+                  | EQUAL   => SOME i 
+                  | GREATER => NONE
+         in 
+            doit bucket
+         end
+                
       (*--------------------------------------------------------------------*)
       (* a symbol table consists of                                         *)
       (* - an array tab holding for each index its key                      *)
@@ -1065,33 +1065,33 @@
       (* - an integer count holding the next free index                     *)
       (*--------------------------------------------------------------------*)
       type SymTable = {desc    : string,
-		       tab     : Key array ref,
-		       hash    : Bucket array ref,
-		       hashFun : (Key -> int) ref,
-		       width   : int ref, (* bit width *)
-		       size    : int ref, (* tab size=2^width, hash size is double *) 
-		       count   : int ref  (* number of entries *)
-		       }
+                       tab     : Key array ref,
+                       hash    : Bucket array ref,
+                       hashFun : (Key -> int) ref,
+                       width   : int ref, (* bit width *)
+                       size    : int ref, (* tab size=2^width, hash size is double *) 
+                       count   : int ref  (* number of entries *)
+                       }
 
       fun nullSymTable desc = {desc    = desc,
-			       tab     = ref (Array.array(1,Key.null)),
-			       hash    = ref (Array.array(2,nullBucket)),
-			       hashFun = ref (fn _ => 0),
-			       count   = ref 0,
-			       size    = ref 1,
-			       width   = ref 0} : SymTable
+                               tab     = ref (Array.array(1,Key.null)),
+                               hash    = ref (Array.array(2,nullBucket)),
+                               hashFun = ref (fn _ => 0),
+                               count   = ref 0,
+                               size    = ref 1,
+                               width   = ref 0} : SymTable
 
       (*--------------------------------------------------------------------*)
       (* how many entries are in the symtable?                              *)
       (*--------------------------------------------------------------------*)
       fun usedSymbols ({count,...}:SymTable) = !count
-	 
+         
       (*--------------------------------------------------------------------*)
       (* what is the table load, i.e. percentage of number of entries to    *)
       (* hash table size = 100*count/(2*size) = 50*count/size.              *)
       (*--------------------------------------------------------------------*)
       fun hashRatio({count,size,...}:SymTable) = 50 * !count div !size
-	 handle Div => 100
+         handle Div => 100
 
       (*--------------------------------------------------------------------*)
       (* this is the hash function. Key.hash hashes data to arbitrary       *)
@@ -1106,101 +1106,101 @@
       (*--------------------------------------------------------------------*)
       fun square (x:word) = Word.*(x,x)
       fun hashKey(half,mask) x = 
-	 Word.toInt(Word.andb(mask,Word.>>(square(Key.hash x),half)))
+         Word.toInt(Word.andb(mask,Word.>>(square(Key.hash x),half)))
       fun makeHashFun(size,width) =
-	 let 
+         let 
             val mask = Word.fromInt(2*size-1) 
             val half = Word.fromInt((width+1) div 2)
-	 in 
-	    hashKey(half,mask)
-	 end
-	    
+         in 
+            hashKey(half,mask)
+         end
+            
       (*--------------------------------------------------------------------*)
       (* create a new symtable for 2^w, but at least 2 and at most 2^m      *)
       (* entries, where m is the value of MAX_WIDTH.                        *)
       (*--------------------------------------------------------------------*)
       fun makeSymTable (desc,w) = 
-	 let 
-	    val width= Int.min(Int.max(1,w),MAX_WIDTH)
-	    val size = Word.toInt(Word.<<(0w1,Word.fromInt(width-1)))
-	 in {desc    = desc,
-	     tab     = ref (Array.array(size,Key.null)),
-	     hash    = ref (Array.array(2*size,nullBucket)),
-	     hashFun = ref (makeHashFun(size,width)),
-	     width   = ref width,
-	     size    = ref size,
-	     count   = ref 0}
-	 end
+         let 
+            val width= Int.min(Int.max(1,w),MAX_WIDTH)
+            val size = Word.toInt(Word.<<(0w1,Word.fromInt(width-1)))
+         in {desc    = desc,
+             tab     = ref (Array.array(size,Key.null)),
+             hash    = ref (Array.array(2*size,nullBucket)),
+             hashFun = ref (makeHashFun(size,width)),
+             width   = ref width,
+             size    = ref size,
+             count   = ref 0}
+         end
       
       (*--------------------------------------------------------------------*)
       (* clear a dictionary. If the 2nd arg is SOME w, use w for resizing.  *)
       (*--------------------------------------------------------------------*)
       fun clearSymTable (symTab:SymTable,widthOpt) = 
-	 case widthOpt 
-	   of NONE => 
-	      let 
-		 val {tab=ref tab,hash=ref hash,size,count,...} = symTab
-		 val _ = appInterval (fn i => Array.update(tab,i,Key.null)) (0,!count-1)
-		 val _ = appInterval (fn i => Array.update(hash,i,nullBucket)) (0,!size*2-1)
-	      in 
-		 count := 0
-	      end
-	    | SOME w => 
-	      let 
-		 val {tab,hash,hashFun,width,size,count,...} = symTab
-		 val newWidth = Int.min(Int.max(1,w),MAX_WIDTH)   
-		 val newSize  = Word.toInt(Word.<<(0w1,Word.fromInt(newWidth-1)))
-		 val _ = tab     := (Array.array(newSize,Key.null))
-		 val _ = hash    := (Array.array(2*newSize,nullBucket))
-		 val _ = hashFun := (makeHashFun(newSize,newWidth))
-		 val _ = width   := newWidth
-		 val _ = size    := newSize
-	      in
-		 count := 0
-	      end
+         case widthOpt 
+           of NONE => 
+              let 
+                 val {tab=ref tab,hash=ref hash,size,count,...} = symTab
+                 val _ = appInterval (fn i => Array.update(tab,i,Key.null)) (0,!count-1)
+                 val _ = appInterval (fn i => Array.update(hash,i,nullBucket)) (0,!size*2-1)
+              in 
+                 count := 0
+              end
+            | SOME w => 
+              let 
+                 val {tab,hash,hashFun,width,size,count,...} = symTab
+                 val newWidth = Int.min(Int.max(1,w),MAX_WIDTH)   
+                 val newSize  = Word.toInt(Word.<<(0w1,Word.fromInt(newWidth-1)))
+                 val _ = tab     := (Array.array(newSize,Key.null))
+                 val _ = hash    := (Array.array(2*newSize,nullBucket))
+                 val _ = hashFun := (makeHashFun(newSize,newWidth))
+                 val _ = width   := newWidth
+                 val _ = size    := newSize
+              in
+                 count := 0
+              end
 
       (*--------------------------------------------------------------------*)
       (* grow a symtable to the double size. raise InternalError if the     *)
       (* table already has maximal size.                                    *)
       (*--------------------------------------------------------------------*)
       fun growTable ({desc,tab,hash,hashFun,width,size,count}:SymTable) = 
-	 let 
-	    val newWidth = if !width < MAX_WIDTH then !width+1 
-			   else raise InternalError 
-			      ("SymTable","growTable",
-			       String.concat ["growing the ",desc," symbol table ",
-					      "exceeded the system maximum size of ",
-					      Int.toString Array.maxLen," for arrays"]) 
-	    val newSize  = !size*2
-	       
-	    val oldTab = !tab
-	    val newTab = Array.array(newSize,Key.null)
-	    val newHash = Array.array(2*newSize,nullBucket)
-	    val newHashFun = makeHashFun(newSize,newWidth)
+         let 
+            val newWidth = if !width < MAX_WIDTH then !width+1 
+                           else raise InternalError 
+                              ("SymTable","growTable",
+                               String.concat ["growing the ",desc," symbol table ",
+                                              "exceeded the system maximum size of ",
+                                              Int.toString Array.maxLen," for arrays"]) 
+            val newSize  = !size*2
+               
+            val oldTab = !tab
+            val newTab = Array.array(newSize,Key.null)
+            val newHash = Array.array(2*newSize,nullBucket)
+            val newHashFun = makeHashFun(newSize,newWidth)
 
-	    fun addToNew (inv as (i,key)) = 
-	       let 
-		  val idx = newHashFun key
-		  val _ = Array.update(newHash,idx,addToBucket((key,i),Array.sub(newHash,idx)))
-		  val _ = Array.update(newTab,i,key)
-	       in ()
-	       end
-	    val _ = Array.appi addToNew (!tab,0,NONE)
+            fun addToNew (inv as (i,key)) = 
+               let 
+                  val idx = newHashFun key
+                  val _ = Array.update(newHash,idx,addToBucket((key,i),Array.sub(newHash,idx)))
+                  val _ = Array.update(newTab,i,key)
+               in ()
+               end
+            val _ = Array.appi addToNew (!tab,0,NONE)
 
-	    val _ = tab   := newTab
-	    val _ = hash  := newHash
-	    val _ = size  := newSize
-	    val _ = width := newWidth
-	    val _ = hashFun := newHashFun
-	 in ()
-	 end
+            val _ = tab   := newTab
+            val _ = hash  := newHash
+            val _ = size  := newSize
+            val _ = width := newWidth
+            val _ = hashFun := newHashFun
+         in ()
+         end
 
       (*--------------------------------------------------------------------*)
       (* lookup the key for an index of the symbol table.                   *)
       (*--------------------------------------------------------------------*)
       fun getSymKey({tab,count,...}:SymTable,idx) =
-	 if !count>idx then Array.sub(!tab,idx)
-	 else raise NoSuchSymbol
+         if !count>idx then Array.sub(!tab,idx)
+         else raise NoSuchSymbol
 
       (*--------------------------------------------------------------------*)
       (* map a Key to its index in the symbol table. if it is not in the    *)
@@ -1208,75 +1208,75 @@
       (* if there is no more free index in the table.                       *)
       (*--------------------------------------------------------------------*)
       fun getSymIndex(st as {tab,hash,hashFun,size,count,...}:SymTable,key) = 
-	 let 
-	    val idx = !hashFun key
-	    val bucket = Array.sub(!hash,idx)
-	 in 
-	    case searchBucket(key,bucket)
-	      of SOME i => i
-	       | NONE => let val i = !count
-			     val (idx',buck') = if !size>i then (idx,bucket)
-						else let val _ = growTable st
-							 val idx' = !hashFun key
-							 val buck' = Array.sub(!hash,idx')
-						     in (idx',buck')
-						     end
-			     val _ = Array.update(!hash,idx',addToBucket((key,i),buck'))
-			     val _ = Array.update(!tab,i,key) 
-			     val _ = count := i+1
-			 in i
-			 end
-	 end
+         let 
+            val idx = !hashFun key
+            val bucket = Array.sub(!hash,idx)
+         in 
+            case searchBucket(key,bucket)
+              of SOME i => i
+               | NONE => let val i = !count
+                             val (idx',buck') = if !size>i then (idx,bucket)
+                                                else let val _ = growTable st
+                                                         val idx' = !hashFun key
+                                                         val buck' = Array.sub(!hash,idx')
+                                                     in (idx',buck')
+                                                     end
+                             val _ = Array.update(!hash,idx',addToBucket((key,i),buck'))
+                             val _ = Array.update(!tab,i,key) 
+                             val _ = count := i+1
+                         in i
+                         end
+         end
       
       (*--------------------------------------------------------------------*)
       (* does a Key have an entry in a symbol table?                        *)
       (*--------------------------------------------------------------------*)
       fun hasSymIndex({hash,hashFun,...}:SymTable,key) = 
-	 let 
-	    val idx = !hashFun key
-	    val buck = Array.sub(!hash,idx)
-	 in 
-	    searchBucket(key,buck)
-	 end
+         let 
+            val idx = !hashFun key
+            val buck = Array.sub(!hash,idx)
+         in 
+            searchBucket(key,buck)
+         end
 
       (*--------------------------------------------------------------------*)
       (* reserve an index for a (yet unknown) key.                          *) 
       (*--------------------------------------------------------------------*)
       fun reserveSymIndex(st as {size,count=count as ref i,...}:SymTable) = 
-	 let 
-	    val _ = if !size>i then () else growTable st
-	    val _ = count := i+1
-	 in i
-	 end
-	 
+         let 
+            val _ = if !size>i then () else growTable st
+            val _ = count := i+1
+         in i
+         end
+         
       (*--------------------------------------------------------------------*)
       (* assign an index to a (previously reserved) index.                  *)
       (*--------------------------------------------------------------------*)
       fun assignSymIndex(st as {count,hash,hashFun,tab,...}:SymTable,key,i) =
-	 if !count<=i then raise NoSuchSymbol
-	 else let val idx = !hashFun key
-		  val buck = Array.sub(!hash,idx)
-		  val newBuck = addToBucket((key,i),buck) 
-		  val _ = Array.update(!hash,idx,newBuck)
-		  val _ = Array.update(!tab,i,key)
-	      in ()
-	      end
-	   
+         if !count<=i then raise NoSuchSymbol
+         else let val idx = !hashFun key
+                  val buck = Array.sub(!hash,idx)
+                  val newBuck = addToBucket((key,i),buck) 
+                  val _ = Array.update(!hash,idx,newBuck)
+                  val _ = Array.update(!tab,i,key)
+              in ()
+              end
+           
       (*--------------------------------------------------------------------*)
       (* extract the contents of a symbol table to a vector.                *)
       (*--------------------------------------------------------------------*)
       fun extractSymTable({count,tab,...}:SymTable) = 
-	 Array.extract(!tab,0,SOME(!count))
+         Array.extract(!tab,0,SOME(!count))
 
       (*--------------------------------------------------------------------*)
       (* print the contents of the symbol table.                            *)
       (*--------------------------------------------------------------------*)
       fun printSymTable ({desc,tab,count,...}:SymTable) = 
-	 (print (desc^" table:\n");
-	  Array.appi 
-	  (fn (n,key) =>
-	   print ("  "^Int.toString n^": "^Key.toString key^"\n")) 
-	  (!tab,0,SOME (!count))) 
+         (print (desc^" table:\n");
+          Array.appi 
+          (fn (n,key) =>
+           print ("  "^Int.toString n^": "^Key.toString key^"\n")) 
+          (!tab,0,SOME (!count))) 
    end
 (* stop of ../../Util/SymDict/symbolTable.sml *)
 (* start of ../../Util/SymDict/intListDict.sml *)
@@ -1340,7 +1340,7 @@
       type Char = Chars.word
       type Data = Char list
       type Vector = Char vector
-	 
+         
       val nullData   : Data 
       val nullVector : Vector
 
@@ -1381,18 +1381,18 @@
       structure Chars = Word
 
       val _ = if Chars.wordSize > 21 then () 
-	      else let val str = ("UniChar: Chars.wordSize is too small.\n"^
-				  "Cannot compile on this system!\n" )
-		       val _ = print str
-		   in raise Fail str
-		   end
+              else let val str = ("UniChar: Chars.wordSize is too small.\n"^
+                                  "Cannot compile on this system!\n" )
+                       val _ = print str
+                   in raise Fail str
+                   end
 
       type Char = Chars.word
       type Data = Char list
 
       type CharInterval = Char * Char
       type CharRange    = CharInterval list
-	 
+         
       type Vector = Char vector
 
       val nullChar = 0wx0:Char
@@ -1411,14 +1411,14 @@
       val Char2char = Byte.byteToChar o Word8.fromLargeWord o Chars.toLargeWord
 
       fun Char2Uni c = 
-	 "U+"^UtilString.toUpperString(StringCvt.padLeft #"0" 4 (Chars.toString c))
+         "U+"^UtilString.toUpperString(StringCvt.padLeft #"0" 4 (Chars.toString c))
       fun Char2String c = 
-	 case c
-	   of 0wx9 => "\\t"
-	    | 0wxA => "\\n"
-	    | _ => if c<0wx100 then String.implode [Char2char c]
-		   else Char2Uni c
-		      
+         case c
+           of 0wx9 => "\\t"
+            | 0wxA => "\\n"
+            | _ => if c<0wx100 then String.implode [Char2char c]
+                   else Char2Uni c
+                      
       fun String2Data s = map char2Char (String.explode s)
       fun Data2String cs = String.concat (map Char2String cs)
       fun Latin2String cs = String.implode (map Char2char cs)
@@ -1428,20 +1428,20 @@
 
       fun Vector2Data vec = Vector.foldr (op ::) nil vec
       fun Vector2String vec =
-	 let 
-	    val maxlen = O_VECTOR_PRINTLEN
-	    val len = Vector.length vec
-	 in  
-	    if len<=maxlen orelse maxlen=0 
-	       then Data2String (Vector2Data vec)
-	    else let 
-		    val cs1 = Vector.foldri 
-		       (fn (_,c,cs) => c::cs) nil (vec,0,SOME (maxlen div 2))
-		    val cs2 = Vector.foldri 
-		       (fn (_,c,cs) => c::cs) nil (vec,len-3-maxlen div 2,NONE)
-		 in Data2String cs1^"..."^Data2String cs2
-		 end
-	 end
+         let 
+            val maxlen = O_VECTOR_PRINTLEN
+            val len = Vector.length vec
+         in  
+            if len<=maxlen orelse maxlen=0 
+               then Data2String (Vector2Data vec)
+            else let 
+                    val cs1 = Vector.foldri 
+                       (fn (_,c,cs) => c::cs) nil (vec,0,SOME (maxlen div 2))
+                    val cs2 = Vector.foldri 
+                       (fn (_,c,cs) => c::cs) nil (vec,len-3-maxlen div 2,NONE)
+                 in Data2String cs1^"..."^Data2String cs2
+                 end
+         end
 
       fun quoteUni q s = let val sQ = Char2String q in sQ^s^sQ end
       fun quoteChar q c = if c=0wx0 then "entity end" else quoteUni q (Char2String c)
@@ -1492,7 +1492,7 @@
 signature Encoding =
    sig
       datatype Encoding = 
-	 NOENC  | ASCII  | EBCDIC | LATIN1 
+         NOENC  | ASCII  | EBCDIC | LATIN1 
        | UCS4B  | UCS4L  | UCS4SB | UCS4SL 
        | UCS2B  | UCS2L  | UTF16B | UTF16L
        | UTF8
@@ -1511,7 +1511,7 @@
       open StringDict
 
       datatype Encoding = 
-	 NOENC  | ASCII  | EBCDIC | LATIN1 
+         NOENC  | ASCII  | EBCDIC | LATIN1 
        | UCS4B  | UCS4L  | UCS4SB | UCS4SL 
        | UCS2B  | UCS2L  | UTF16B | UTF16L
        | UTF8
@@ -1521,60 +1521,60 @@
       val UTF16 = UTF16B
 
       fun encodingName enc =
-	 case enc 
-	   of NOENC  => "NONE"
-	    | ASCII  => "ASCII"
-	    | EBCDIC => "EBCDIC"
-	    | LATIN1 => "ISO-8859-1"
-	    | UCS2B  => "UCS-2"
-	    | UCS2L  => "UCS-2"
-	    | UCS4B  => "UCS-4"
-	    | UCS4L  => "UCS-4"
-	    | UCS4SB => "UCS-4"
-	    | UCS4SL => "UCS-4"
-	    | UTF8   => "UTF-8"
-	    | UTF16B => "UTF-16"
-	    | UTF16L => "UTF-16"
+         case enc 
+           of NOENC  => "NONE"
+            | ASCII  => "ASCII"
+            | EBCDIC => "EBCDIC"
+            | LATIN1 => "ISO-8859-1"
+            | UCS2B  => "UCS-2"
+            | UCS2L  => "UCS-2"
+            | UCS4B  => "UCS-4"
+            | UCS4L  => "UCS-4"
+            | UCS4SB => "UCS-4"
+            | UCS4SL => "UCS-4"
+            | UTF8   => "UTF-8"
+            | UTF16B => "UTF-16"
+            | UTF16L => "UTF-16"
 
       val encDict = makeDict("encoding",6,NOENC)
       val encAliases = 
-	 [(ASCII,["ANSI_X3.4-1968","ANSI_X3.4-1986","ASCII","US-ASCII","US",		       
-		    "ISO646-US","ISO-IR-6","ISO_646.IRV:1991","IBM367","CP367"]),
-	  (EBCDIC,["EBCDIC"]),                 
-	  (LATIN1,["ISO_8859-1:1987","ISO-8859-1","ISO_8859-1",
-		     "ISO-IR-100","CP819","IBM819","L1","LATIN1"]),
-	  (UCS2,["UCS-2","ISO-10646-UCS-2"]),
-	  (UCS4,["UCS-4","ISO-10646-UCS-4"]),
-	  (UTF16,["UTF-16"]),
-	  (UTF8,["UTF-8"])
-	  ]
+         [(ASCII,["ANSI_X3.4-1968","ANSI_X3.4-1986","ASCII","US-ASCII","US",                   
+                    "ISO646-US","ISO-IR-6","ISO_646.IRV:1991","IBM367","CP367"]),
+          (EBCDIC,["EBCDIC"]),                 
+          (LATIN1,["ISO_8859-1:1987","ISO-8859-1","ISO_8859-1",
+                     "ISO-IR-100","CP819","IBM819","L1","LATIN1"]),
+          (UCS2,["UCS-2","ISO-10646-UCS-2"]),
+          (UCS4,["UCS-4","ISO-10646-UCS-4"]),
+          (UTF16,["UTF-16"]),
+          (UTF8,["UTF-8"])
+          ]
       val _ = app (fn (x,ys) => app (fn y => setByKey(encDict,y,x)) ys) encAliases
       fun isEncoding name = getByKey(encDict,name)
 
       fun compatAscii new =
-	 case new
-	   of ASCII  => new
-	    | LATIN1 => new
-	    | UTF8   => new
-	    | _      => NOENC
+         case new
+           of ASCII  => new
+            | LATIN1 => new
+            | UTF8   => new
+            | _      => NOENC
       fun compatUcs4 (old,new) = 
-	 if new=UCS4 then old else NOENC
+         if new=UCS4 then old else NOENC
 
       fun switchEncoding(old,new) =
-	 case old
-	   of NOENC  => NOENC
-	    | ASCII  => compatAscii new
-	    | EBCDIC => if new=EBCDIC then new else NOENC
-	    | LATIN1 => compatAscii new
-	    | UCS4B  => compatUcs4(old,new)
-	    | UCS4L  => compatUcs4(old,new)
-	    | UCS4SB => compatUcs4(old,new)
-	    | UCS4SL => compatUcs4(old,new)
-	    | UTF16B => if new=UTF16 then old else if new=UCS2 then UCS2B else NOENC 
-	    | UTF16L => if new=UTF16 then old else if new=UCS2 then UCS2L else NOENC 
-	    | UCS2B  => if new=UCS2 then old else if new=UTF16 then UTF16B else NOENC
-	    | UCS2L  => if new=UCS2 then old else if new=UTF16 then UTF16L else NOENC
-	    | UTF8   => compatAscii new
+         case old
+           of NOENC  => NOENC
+            | ASCII  => compatAscii new
+            | EBCDIC => if new=EBCDIC then new else NOENC
+            | LATIN1 => compatAscii new
+            | UCS4B  => compatUcs4(old,new)
+            | UCS4L  => compatUcs4(old,new)
+            | UCS4SB => compatUcs4(old,new)
+            | UCS4SL => compatUcs4(old,new)
+            | UTF16B => if new=UTF16 then old else if new=UCS2 then UCS2B else NOENC 
+            | UTF16L => if new=UTF16 then old else if new=UCS2 then UCS2L else NOENC 
+            | UCS2B  => if new=UCS2 then old else if new=UTF16 then UTF16B else NOENC
+            | UCS2L  => if new=UCS2 then old else if new=UTF16 then UTF16L else NOENC
+            | UTF8   => compatAscii new
    end
 (* stop of ../../Unicode/encoding.sml *)
 (* start of ../../Unicode/Encode/encodeBasic.sml *)
@@ -1613,7 +1613,7 @@
       val openOut    = TextIO.openOut
       val output1    = TextIO.output1
       val stdOut     = TextIO.stdOut
-	 
+         
       type File = string * outstream
 
       val stdOutFile = ("-",stdOut)
@@ -1621,9 +1621,9 @@
       fun closeFile(fname,s) = if fname="-" then () else closeOut s
       fun fileName(fname,_) = if fname="-" then "<stdout>" else fname
       fun openFile fname = 
-	 if fname = "-" then (fname,stdOut)
-	 else (fname,openOut fname)
-	    handle IO.Io {name,cause,...} => raise NoSuchFile(name,exnMessage cause)
+         if fname = "-" then (fname,stdOut)
+         else (fname,openOut fname)
+            handle IO.Io {name,cause,...} => raise NoSuchFile(name,exnMessage cause)
       fun writeByte (f as (_,s),b) = f before output1(s,chr(Word8.toInt b))
    end
 (* stop of ../../Unicode/Encode/encodeBasic.sml *)
@@ -1638,7 +1638,7 @@
 signature EncodeError = 
    sig
       datatype EncodeError = 
-	 ERR_ILLEGAL_CHAR of UniChar.Char * string
+         ERR_ILLEGAL_CHAR of UniChar.Char * string
 
       val encodeMessage : EncodeError -> string list
 
@@ -1648,15 +1648,15 @@
 structure EncodeError : EncodeError =
    struct
       open 
-	 UtilString
-	 UniChar
+         UtilString
+         UniChar
 
       datatype EncodeError = 
-	 ERR_ILLEGAL_CHAR of UniChar.Char * string
+         ERR_ILLEGAL_CHAR of UniChar.Char * string
 
       fun encodeMessage err =
-	 case err
-	   of ERR_ILLEGAL_CHAR(c,what) => [Char2Uni c,"is not",prependAnA what,"character"]
+         case err
+           of ERR_ILLEGAL_CHAR(c,what) => [Char2Uni c,"is not",prependAnA what,"character"]
 
       exception EncodeError of EncodeBasic.File * EncodeError 
    end
@@ -1704,7 +1704,7 @@
       val op || = Word8.orb
 
       fun splitSurrogates (c : Char) = 
-	 (((c-0wx10000) >> 0w10)+0wxD800,c && 0wx3FF + 0wxDC00)
+         (((c-0wx10000) >> 0w10)+0wxD800,c && 0wx3FF + 0wxDC00)
 
       fun Char2Byte c = Word8.fromLargeWord(Chars.toLargeWord c)
 
@@ -1713,75 +1713,75 @@
       (*---------------------------------------------------------------------*)
       fun validCharAscii (c : Char) = c<0wx80
       fun writeCharAscii(c,f) = 
-	 if c<0wx80 then writeByte(f,Char2Byte c)
-	 else raise EncodeError(f,ERR_ILLEGAL_CHAR(c,"ASCII"))
+         if c<0wx80 then writeByte(f,Char2Byte c)
+         else raise EncodeError(f,ERR_ILLEGAL_CHAR(c,"ASCII"))
 
       (*---------------------------------------------------------------------*)
       (* Ebcdic                                                              *)
       (*---------------------------------------------------------------------*)
       val latin2ebcdicTab = Word8Vector.fromList 
-	  [0wx00,0wx01,0wx02,0wx03,0wx37,0wx2D,0wx2E,0wx2F,
-	   0wx16,0wx05,0wx25,0wx0B,0wx0C,0wx0D,0wx0E,0wx0F,
-	   0wx10,0wx11,0wx12,0wx13,0wx3C,0wx3D,0wx32,0wx26,
-	   0wx18,0wx19,0wx3F,0wx27,0wx1C,0wx1D,0wx1E,0wx1F,
-	   0wx40,0wx4F,0wx7F,0wx7B,0wx5B,0wx6C,0wx50,0wx7D,
-	   0wx4D,0wx5D,0wx5C,0wx4E,0wx6B,0wx60,0wx4B,0wx61,
-	   0wxF0,0wxF1,0wxF2,0wxF3,0wxF4,0wxF5,0wxF6,0wxF7,
-	   0wxF8,0wxF9,0wx7A,0wx5E,0wx4C,0wx7E,0wx6E,0wx6F,
-	   0wx7C,0wxC1,0wxC2,0wxC3,0wxC4,0wxC5,0wxC6,0wxC7,
-	   0wxC8,0wxC9,0wxD1,0wxD2,0wxD3,0wxD4,0wxD5,0wxD6,
-	   0wxD7,0wxD8,0wxD9,0wxE2,0wxE3,0wxE4,0wxE5,0wxE6,
-	   0wxE7,0wxE8,0wxE9,0wx4A,0wxE0,0wx5A,0wx5F,0wx6D,
-	   0wx79,0wx81,0wx82,0wx83,0wx84,0wx85,0wx86,0wx87,
-	   0wx88,0wx89,0wx91,0wx92,0wx93,0wx94,0wx95,0wx96,
-	   0wx97,0wx98,0wx99,0wxA2,0wxA3,0wxA4,0wxA5,0wxA6,
-	   0wxA7,0wxA8,0wxA9,0wxC0,0wx6A,0wxD0,0wxA1,0wx07,
-	   0wx20,0wx21,0wx22,0wx23,0wx24,0wx15,0wx06,0wx17,
-	   0wx28,0wx29,0wx2A,0wx2B,0wx2C,0wx09,0wx0A,0wx1B,
-	   0wx30,0wx31,0wx1A,0wx33,0wx34,0wx35,0wx36,0wx08,
-	   0wx38,0wx39,0wx3A,0wx3B,0wx04,0wx14,0wx3E,0wxE1,
-	   0wx41,0wx42,0wx43,0wx44,0wx45,0wx46,0wx47,0wx48,
-	   0wx49,0wx51,0wx52,0wx53,0wx54,0wx55,0wx56,0wx57,
-	   0wx58,0wx59,0wx62,0wx63,0wx64,0wx65,0wx66,0wx67,
-	   0wx68,0wx69,0wx70,0wx71,0wx72,0wx73,0wx74,0wx75,
-	   0wx76,0wx77,0wx78,0wx80,0wx8A,0wx8B,0wx8C,0wx8D,
-	   0wx8E,0wx8F,0wx90,0wx9A,0wx9B,0wx9C,0wx9D,0wx9E,
-	   0wx9F,0wxA0,0wxAA,0wxAB,0wxAC,0wxAD,0wxAE,0wxAF,
-	   0wxB0,0wxB1,0wxB2,0wxB3,0wxB4,0wxB5,0wxB6,0wxB7,
-	   0wxB8,0wxB9,0wxBA,0wxBB,0wxBC,0wxBD,0wxBE,0wxBF,
-	   0wxCA,0wxCB,0wxCC,0wxCD,0wxCE,0wxCF,0wxDA,0wxDB,
-	   0wxDC,0wxDD,0wxDE,0wxDF,0wxEA,0wxEB,0wxEC,0wxED,
-	   0wxEE,0wxEF,0wxFA,0wxFB,0wxFC,0wxFD,0wxFE,0wxFF
-	   ]
+          [0wx00,0wx01,0wx02,0wx03,0wx37,0wx2D,0wx2E,0wx2F,
+           0wx16,0wx05,0wx25,0wx0B,0wx0C,0wx0D,0wx0E,0wx0F,
+           0wx10,0wx11,0wx12,0wx13,0wx3C,0wx3D,0wx32,0wx26,
+           0wx18,0wx19,0wx3F,0wx27,0wx1C,0wx1D,0wx1E,0wx1F,
+           0wx40,0wx4F,0wx7F,0wx7B,0wx5B,0wx6C,0wx50,0wx7D,
+           0wx4D,0wx5D,0wx5C,0wx4E,0wx6B,0wx60,0wx4B,0wx61,
+           0wxF0,0wxF1,0wxF2,0wxF3,0wxF4,0wxF5,0wxF6,0wxF7,
+           0wxF8,0wxF9,0wx7A,0wx5E,0wx4C,0wx7E,0wx6E,0wx6F,
+           0wx7C,0wxC1,0wxC2,0wxC3,0wxC4,0wxC5,0wxC6,0wxC7,
+           0wxC8,0wxC9,0wxD1,0wxD2,0wxD3,0wxD4,0wxD5,0wxD6,
+           0wxD7,0wxD8,0wxD9,0wxE2,0wxE3,0wxE4,0wxE5,0wxE6,
+           0wxE7,0wxE8,0wxE9,0wx4A,0wxE0,0wx5A,0wx5F,0wx6D,
+           0wx79,0wx81,0wx82,0wx83,0wx84,0wx85,0wx86,0wx87,
+           0wx88,0wx89,0wx91,0wx92,0wx93,0wx94,0wx95,0wx96,
+           0wx97,0wx98,0wx99,0wxA2,0wxA3,0wxA4,0wxA5,0wxA6,
+           0wxA7,0wxA8,0wxA9,0wxC0,0wx6A,0wxD0,0wxA1,0wx07,
+           0wx20,0wx21,0wx22,0wx23,0wx24,0wx15,0wx06,0wx17,
+           0wx28,0wx29,0wx2A,0wx2B,0wx2C,0wx09,0wx0A,0wx1B,
+           0wx30,0wx31,0wx1A,0wx33,0wx34,0wx35,0wx36,0wx08,
+           0wx38,0wx39,0wx3A,0wx3B,0wx04,0wx14,0wx3E,0wxE1,
+           0wx41,0wx42,0wx43,0wx44,0wx45,0wx46,0wx47,0wx48,
+           0wx49,0wx51,0wx52,0wx53,0wx54,0wx55,0wx56,0wx57,
+           0wx58,0wx59,0wx62,0wx63,0wx64,0wx65,0wx66,0wx67,
+           0wx68,0wx69,0wx70,0wx71,0wx72,0wx73,0wx74,0wx75,
+           0wx76,0wx77,0wx78,0wx80,0wx8A,0wx8B,0wx8C,0wx8D,
+           0wx8E,0wx8F,0wx90,0wx9A,0wx9B,0wx9C,0wx9D,0wx9E,
+           0wx9F,0wxA0,0wxAA,0wxAB,0wxAC,0wxAD,0wxAE,0wxAF,
+           0wxB0,0wxB1,0wxB2,0wxB3,0wxB4,0wxB5,0wxB6,0wxB7,
+           0wxB8,0wxB9,0wxBA,0wxBB,0wxBC,0wxBD,0wxBE,0wxBF,
+           0wxCA,0wxCB,0wxCC,0wxCD,0wxCE,0wxCF,0wxDA,0wxDB,
+           0wxDC,0wxDD,0wxDE,0wxDF,0wxEA,0wxEB,0wxEC,0wxED,
+           0wxEE,0wxEF,0wxFA,0wxFB,0wxFC,0wxFD,0wxFE,0wxFF
+           ]
       fun validCharEbcdic (c : Char) = c<0wx100
       fun writeCharEbcdic(c,f) = 
-	 if c<0wx100 then writeByte(f,Word8Vector.sub(latin2ebcdicTab,Chars.toInt c))
-	 else raise EncodeError(f,ERR_ILLEGAL_CHAR(c,"EBCDIC"))
+         if c<0wx100 then writeByte(f,Word8Vector.sub(latin2ebcdicTab,Chars.toInt c))
+         else raise EncodeError(f,ERR_ILLEGAL_CHAR(c,"EBCDIC"))
 
       (*---------------------------------------------------------------------*)
       (* Latin1                                                              *)
       (*---------------------------------------------------------------------*)
       fun validCharLatin1 (c : Char) = c<0wx100
       fun writeCharLatin1(c,f) = 
-	 if c<0wx100 then writeByte(f,Char2Byte c)
- 	 else raise EncodeError(f,ERR_ILLEGAL_CHAR(c,"LATIN-1"))
+         if c<0wx100 then writeByte(f,Char2Byte c)
+         else raise EncodeError(f,ERR_ILLEGAL_CHAR(c,"LATIN-1"))
 
       (*---------------------------------------------------------------------*)
       (* UCS-4                                                               *)
       (*---------------------------------------------------------------------*)
       fun ucs4Bytes c = (Char2Byte(c >> 0w24),
-			 Char2Byte(c >> 0w16),
-			 Char2Byte(c >> 0w8),
-			 Char2Byte c)
+                         Char2Byte(c >> 0w16),
+                         Char2Byte(c >> 0w8),
+                         Char2Byte c)
       fun writeCharUcs4 perm = 
-	 fn (c,f) => let val bytes = ucs4Bytes c
-			 val (b1,b2,b3,b4) = perm bytes
-			 val f1 = writeByte(f,b1)
-			 val f2 = writeByte(f1,b2)
-			 val f3 = writeByte(f2,b3)
-			 val f4 = writeByte(f3,b4)
-		     in f4
-		     end
+         fn (c,f) => let val bytes = ucs4Bytes c
+                         val (b1,b2,b3,b4) = perm bytes
+                         val f1 = writeByte(f,b1)
+                         val f2 = writeByte(f1,b2)
+                         val f3 = writeByte(f2,b3)
+                         val f4 = writeByte(f3,b4)
+                     in f4
+                     end
       fun permUcs4B x = x
       fun permUcs4L (b1,b2,b3,b4) = (b4,b3,b2,b1)
       fun permUcs4SB (b1,b2,b3,b4) = (b2,b1,b4,b3)
@@ -1796,58 +1796,58 @@
       (* UTF-8                                                               *)
       (*---------------------------------------------------------------------*)
       fun writeCharUtf8(c,f) = 
-	 if c<0wx80 then writeByte(f,Char2Byte c)
-	 else if c<0wx800 
-		 then let val f1 = writeByte(f,0wxC0 || Char2Byte(c >> 0w6))
-			  val f2 = writeByte(f1,0wx80 || Char2Byte(c && 0wx3F))
-		      in f2 
-		      end
-	 else if c<0wx10000
-		 then let val f1 = writeByte(f, 0wxE0 || Char2Byte(c >> 0w12))
-			  val f2 = writeByte(f1,0wx80 || Char2Byte((c >> 0w6) && 0wx3F))
-			  val f3 = writeByte(f2,0wx80 || Char2Byte(c && 0wx3F))
-		      in f3
-		      end
-	 else if c<0wx200000
-		 then let val f1 = writeByte(f, 0wxF0 || Char2Byte(c >> 0w18))
-			  val f2 = writeByte(f1,0wx80 || Char2Byte((c >> 0w12) && 0wx3F))
-			  val f3 = writeByte(f2,0wx80 || Char2Byte((c >> 0w6) && 0wx3F))
-			  val f4 = writeByte(f3,0wx80 || Char2Byte(c && 0wx3F))
-		      in f4
-		      end
-	 else if c<0wx4000000
-		 then let val f1 = writeByte(f, 0wxF8 || Char2Byte(c >> 0w24))
-			  val f2 = writeByte(f1,0wx80 || Char2Byte((c >> 0w18) && 0wx3F))
-			  val f3 = writeByte(f2,0wx80 || Char2Byte((c >> 0w12) && 0wx3F))
-			  val f4 = writeByte(f3,0wx80 || Char2Byte((c >> 0w6) && 0wx3F))
-			  val f5 = writeByte(f4,0wx80 || Char2Byte(c && 0wx3F))
-		      in f5
-		      end
-	      else let val f1 = writeByte(f, 0wxFC || Char2Byte(c >> 0w30))
-		       val f2 = writeByte(f1,0wx80 || Char2Byte((c >> 0w24) && 0wx3F))
-		       val f3 = writeByte(f2,0wx80 || Char2Byte((c >> 0w18) && 0wx3F))
-		       val f4 = writeByte(f3,0wx80 || Char2Byte((c >> 0w12) && 0wx3F))
-		       val f5 = writeByte(f4,0wx80 || Char2Byte((c >> 0w6) && 0wx3F))
-		       val f6 = writeByte(f5,0wx80 || Char2Byte(c && 0wx3F))
-		   in f6
-		   end
+         if c<0wx80 then writeByte(f,Char2Byte c)
+         else if c<0wx800 
+                 then let val f1 = writeByte(f,0wxC0 || Char2Byte(c >> 0w6))
+                          val f2 = writeByte(f1,0wx80 || Char2Byte(c && 0wx3F))
+                      in f2 
+                      end
+         else if c<0wx10000
+                 then let val f1 = writeByte(f, 0wxE0 || Char2Byte(c >> 0w12))
+                          val f2 = writeByte(f1,0wx80 || Char2Byte((c >> 0w6) && 0wx3F))
+                          val f3 = writeByte(f2,0wx80 || Char2Byte(c && 0wx3F))
+                      in f3
+                      end
+         else if c<0wx200000
+                 then let val f1 = writeByte(f, 0wxF0 || Char2Byte(c >> 0w18))
+                          val f2 = writeByte(f1,0wx80 || Char2Byte((c >> 0w12) && 0wx3F))
+                          val f3 = writeByte(f2,0wx80 || Char2Byte((c >> 0w6) && 0wx3F))
+                          val f4 = writeByte(f3,0wx80 || Char2Byte(c && 0wx3F))
+                      in f4
+                      end
+         else if c<0wx4000000
+                 then let val f1 = writeByte(f, 0wxF8 || Char2Byte(c >> 0w24))
+                          val f2 = writeByte(f1,0wx80 || Char2Byte((c >> 0w18) && 0wx3F))
+                          val f3 = writeByte(f2,0wx80 || Char2Byte((c >> 0w12) && 0wx3F))
+                          val f4 = writeByte(f3,0wx80 || Char2Byte((c >> 0w6) && 0wx3F))
+                          val f5 = writeByte(f4,0wx80 || Char2Byte(c && 0wx3F))
+                      in f5
+                      end
+              else let val f1 = writeByte(f, 0wxFC || Char2Byte(c >> 0w30))
+                       val f2 = writeByte(f1,0wx80 || Char2Byte((c >> 0w24) && 0wx3F))
+                       val f3 = writeByte(f2,0wx80 || Char2Byte((c >> 0w18) && 0wx3F))
+                       val f4 = writeByte(f3,0wx80 || Char2Byte((c >> 0w12) && 0wx3F))
+                       val f5 = writeByte(f4,0wx80 || Char2Byte((c >> 0w6) && 0wx3F))
+                       val f6 = writeByte(f5,0wx80 || Char2Byte(c && 0wx3F))
+                   in f6
+                   end
 
       (*---------------------------------------------------------------------*)
       (* UTF-16                                                              *)
       (*---------------------------------------------------------------------*)
       fun oneUtf16 isL (c,f) = 
-	 let val (b1,b2) = (Char2Byte(c >> 0w8),Char2Byte c)
-	 in if isL then writeByte(writeByte(f,b2),b1)
-	    else writeByte(writeByte(f,b1),b2)
-	 end
+         let val (b1,b2) = (Char2Byte(c >> 0w8),Char2Byte c)
+         in if isL then writeByte(writeByte(f,b2),b1)
+            else writeByte(writeByte(f,b1),b2)
+         end
       fun writeCharUtf16 isL = 
-	 fn (c,f) => 
-	 if c<0wx10000 then oneUtf16 isL (c,f)
-	 else let val (hi,lo) = splitSurrogates c
-		  val f1 = oneUtf16 isL (hi,f)
-		  val f2 = oneUtf16 isL (lo,f1)
-	      in f2
-	      end
+         fn (c,f) => 
+         if c<0wx10000 then oneUtf16 isL (c,f)
+         else let val (hi,lo) = splitSurrogates c
+                  val f1 = oneUtf16 isL (hi,f)
+                  val f2 = oneUtf16 isL (lo,f1)
+              in f2
+              end
       val writeCharUtf16B  = writeCharUtf16 false
       val writeCharUtf16L  = writeCharUtf16 true
 
@@ -1855,13 +1855,13 @@
       (* UCS-2                                                               *)
       (*---------------------------------------------------------------------*)
       fun writeCharUcs2 isL = 
-	 fn (c,f) => 
-	 if c<0wx10000 
-	    then let val (b1,b2) = (Char2Byte(c >> 0w8),Char2Byte c)
-		 in if isL then writeByte(writeByte(f,b2),b1)
-		    else writeByte(writeByte(f,b1),b2)
-		 end
-	 else raise EncodeError(f,ERR_ILLEGAL_CHAR(c,"UCS-2"))
+         fn (c,f) => 
+         if c<0wx10000 
+            then let val (b1,b2) = (Char2Byte(c >> 0w8),Char2Byte c)
+                 in if isL then writeByte(writeByte(f,b2),b1)
+                    else writeByte(writeByte(f,b1),b2)
+                 end
+         else raise EncodeError(f,ERR_ILLEGAL_CHAR(c,"UCS-2"))
 
       val writeCharUcs2B  = writeCharUcs2 false
       val writeCharUcs2L  = writeCharUcs2 true
@@ -1899,9 +1899,9 @@
 structure Encode : Encode = 
    struct
       open 
-	 Encoding UtilError
-	 EncodeBasic EncodeError EncodeMisc
-	 
+         Encoding UtilError
+         EncodeBasic EncodeError EncodeMisc
+         
       type EncFile = Encoding * File
 
       val encNoFile = (NOENC,stdOutFile)
@@ -1910,49 +1910,49 @@
       fun encAdapt((enc,_),f) = (enc,f)
 
       fun encValidChar((enc,_),c) = 
-	 case enc
-	   of ASCII  => validCharAscii c
-	    | EBCDIC => validCharEbcdic c
-	    | LATIN1 => validCharLatin1 c
-	    | _ => true
+         case enc
+           of ASCII  => validCharAscii c
+            | EBCDIC => validCharEbcdic c
+            | LATIN1 => validCharLatin1 c
+            | _ => true
 
       fun encPutChar((enc,f),c) = 
-	 let val f1 = 
-	    case enc
-	      of NOENC  => f
-	       | ASCII  => (writeCharAscii(c,f))
-	       | EBCDIC => (writeCharEbcdic(c,f))
-	       | LATIN1 => (writeCharLatin1(c,f))
-	       | UCS2B  => (writeCharUcs2B(c,f))
-	       | UCS2L  => (writeCharUcs2L(c,f))
-	       | UCS4B  => (writeCharUcs4B(c,f))
-	       | UCS4L  => (writeCharUcs4L(c,f))
-	       | UCS4SB => (writeCharUcs4SB(c,f))
-	       | UCS4SL => (writeCharUcs4SL(c,f))
-	       | UTF8   => (writeCharUtf8(c,f))
-	       | UTF16B => (writeCharUtf16B(c,f))
-	       | UTF16L => (writeCharUtf16L(c,f))
-	 in (enc,f1)
-	 end
+         let val f1 = 
+            case enc
+              of NOENC  => f
+               | ASCII  => (writeCharAscii(c,f))
+               | EBCDIC => (writeCharEbcdic(c,f))
+               | LATIN1 => (writeCharLatin1(c,f))
+               | UCS2B  => (writeCharUcs2B(c,f))
+               | UCS2L  => (writeCharUcs2L(c,f))
+               | UCS4B  => (writeCharUcs4B(c,f))
+               | UCS4L  => (writeCharUcs4L(c,f))
+               | UCS4SB => (writeCharUcs4SB(c,f))
+               | UCS4SL => (writeCharUcs4SL(c,f))
+               | UTF8   => (writeCharUtf8(c,f))
+               | UTF16B => (writeCharUtf16B(c,f))
+               | UTF16L => (writeCharUtf16L(c,f))
+         in (enc,f1)
+         end
 
       fun encCloseFile(_,f) = closeFile f
 
       fun encOpenFile (fname,enc,name) = 
-	 let 
-	    val outEnc = 
-	       case enc 
-		 of NOENC => 
-		    (case isEncoding name
-		       of NOENC => raise NoSuchFile(fname,"Unsupported encoding \""^name^"\"")
-			| enc => enc)
-		  | enc => enc
-	    val f   = openFile fname
-	    val f1  = case outEnc 
-			of UTF16B => writeByte(writeByte(f,0wxFE),0wxFF)
-			 | UTF16L => writeByte(writeByte(f,0wxFF),0wxFE)
-			 | _      => f 
-	 in (outEnc,f1)
-	 end
+         let 
+            val outEnc = 
+               case enc 
+                 of NOENC => 
+                    (case isEncoding name
+                       of NOENC => raise NoSuchFile(fname,"Unsupported encoding \""^name^"\"")
+                        | enc => enc)
+                  | enc => enc
+            val f   = openFile fname
+            val f1  = case outEnc 
+                        of UTF16B => writeByte(writeByte(f,0wxFE),0wxFF)
+                         | UTF16L => writeByte(writeByte(f,0wxFF),0wxFE)
+                         | _      => f 
+         in (outEnc,f1)
+         end
    end
 
 (* stop of ../../Unicode/Encode/encode.sml *)
@@ -1984,64 +1984,64 @@
       fun parseNull uri = NullParse.parseDocument uri NONE NullHooks.nullStart
 
       open 
-	 NullCatOptions NullOptions Options NullParserOptions Uri
+         NullCatOptions NullOptions Options NullParserOptions Uri
 
       val usage = List.concat [parserUsage,[("","")],catalogUsage,[("","")],nullUsage]
 
       exception Exit of OS.Process.status 
-	 
+         
       fun null(prog,args) = 
-	 let 
-	    val prog = "fxp"
-	    val hadError = ref false
-	       
-	    fun optError msg = 
-	       let val _ = TextIO.output(TextIO.stdErr,msg^".\n")
-	       in hadError := true
-	       end
-	    fun exitError msg = 
-	       let val _ = TextIO.output(TextIO.stdErr,msg^".\n")
-	       in raise Exit OS.Process.failure 
-	       end
-	    fun exitHelp prog = 
-	       let val _ = printUsage TextIO.stdOut prog usage
-	       in raise Exit OS.Process.success 
-	       end
-	    fun exitVersion prog = 
-	       let val _ = app print [prog," version ",Version.FXP_VERSION,"\n"]
-	       in raise Exit OS.Process.success 
-	       end
-	    
-	    fun summOpt prog = "For a summary of options type "^prog^" --help"
-	    fun noFile(f,cause) = "can't open file '"^f^"': "^exnMessage cause
-	       
-	    val opts = parseOptions args
-	    val _ = setParserDefaults()
-	    val opts1 = setParserOptions (opts,optError)
-	    val _ = setCatalogDefaults()
-	    val opts2 = setCatalogOptions (opts1,optError)
-	    val _ = setNullDefaults()
-	    val (vers,help,err,file) = setNullOptions (opts2,optError)
-	    val _ = if !hadError then exitError (summOpt prog) else ()
-	    val _ = if vers then exitVersion prog else ()
-	    val _ = if help then exitHelp prog else ()
-	    val _ = case err 
-		      of SOME "-" => O_ERROR_DEVICE := TextIO.stdErr
-		       | SOME f => (O_ERROR_DEVICE := TextIO.openOut f
-				    handle IO.Io {cause,...} => exitError(noFile(f,cause)))
-		       | NONE => ()
-	    val f = valOf file handle Option => "-"
-	    val uri = if f="-" then NONE else SOME(String2Uri f)
-	    val status = parseNull uri
-	    val _ = if isSome err then TextIO.closeOut (!O_ERROR_DEVICE) else ()
-	 in status
-	 end
+         let 
+            val prog = "fxp"
+            val hadError = ref false
+               
+            fun optError msg = 
+               let val _ = TextIO.output(TextIO.stdErr,msg^".\n")
+               in hadError := true
+               end
+            fun exitError msg = 
+               let val _ = TextIO.output(TextIO.stdErr,msg^".\n")
+               in raise Exit OS.Process.failure 
+               end
+            fun exitHelp prog = 
+               let val _ = printUsage TextIO.stdOut prog usage
+               in raise Exit OS.Process.success 
+               end
+            fun exitVersion prog = 
+               let val _ = app print [prog," version ",Version.FXP_VERSION,"\n"]
+               in raise Exit OS.Process.success 
+               end
+            
+            fun summOpt prog = "For a summary of options type "^prog^" --help"
+            fun noFile(f,cause) = "can't open file '"^f^"': "^exnMessage cause
+               
+            val opts = parseOptions args
+            val _ = setParserDefaults()
+            val opts1 = setParserOptions (opts,optError)
+            val _ = setCatalogDefaults()
+            val opts2 = setCatalogOptions (opts1,optError)
+            val _ = setNullDefaults()
+            val (vers,help,err,file) = setNullOptions (opts2,optError)
+            val _ = if !hadError then exitError (summOpt prog) else ()
+            val _ = if vers then exitVersion prog else ()
+            val _ = if help then exitHelp prog else ()
+            val _ = case err 
+                      of SOME "-" => O_ERROR_DEVICE := TextIO.stdErr
+                       | SOME f => (O_ERROR_DEVICE := TextIO.openOut f
+                                    handle IO.Io {cause,...} => exitError(noFile(f,cause)))
+                       | NONE => ()
+            val f = valOf file handle Option => "-"
+            val uri = if f="-" then NONE else SOME(String2Uri f)
+            val status = parseNull uri
+            val _ = if isSome err then TextIO.closeOut (!O_ERROR_DEVICE) else ()
+         in status
+         end
       handle Exit status => status 
-	   | exn => 
-	 let val _ = TextIO.output 
-	    (TextIO.stdErr,prog^": Unexpected exception: "^exnMessage exn^".\n")
-	 in OS.Process.failure 
-	 end
+           | exn => 
+         let val _ = TextIO.output 
+            (TextIO.stdErr,prog^": Unexpected exception: "^exnMessage exn^".\n")
+         in OS.Process.failure 
+         end
    end
 *)
 structure NullHard = struct end
@@ -2050,7 +2050,7 @@
 signature Options=
    sig
       datatype Option =
-	 OPT_LONG of string * string option
+         OPT_LONG of string * string option
        | OPT_SHORT of char list
        | OPT_NEG of char list
        | OPT_NOOPT
@@ -2068,9 +2068,9 @@
 structure Options : Options =
    struct
       exception BadOption of string
-	    
+            
       datatype Option =
-	 OPT_LONG of string * string option
+         OPT_LONG of string * string option
        | OPT_SHORT of char list
        | OPT_NEG of char list
        | OPT_NOOPT
@@ -2083,46 +2083,46 @@
       type Usage = UsageItem list
 
       fun parseOptions ss =
-	 let 
-	    fun doOne opt =
-	       if String.isPrefix "--" opt 
-		  then let val opt1 = Substring.extract(opt,2,NONE) 
-			   val (key0,opt2) = Substring.splitl (fn c => #"="<>c) opt1
-			   val key = if Substring.isEmpty key0 then raise BadOption opt 
-				     else Substring.string key0
-			   val valOpt = if Substring.isPrefix "=" opt2
-					   then let val val0 = Substring.triml 1 opt2
-						in if Substring.isEmpty val0 
-						      then raise BadOption opt
-						   else SOME(Substring.string val0)
-						end
-					else NONE
-		       in OPT_LONG(key,valOpt)
-		       end
-		    handle BadOption s => if opt="--" then OPT_NOOPT else OPT_STRING opt
-	       else if String.isPrefix "-" opt 
-		       then let val chars = tl(String.explode opt)
-			    (* val _ = app (fn c => if Char.isAlphaNum c then () 
-		                                    else raise BadOption opt) chars *)
-			    in case chars
-				 of nil => OPT_STRING opt
-				  | #"n"::(cs as _::_) => OPT_NEG cs
-				  | _ => OPT_SHORT chars
-			    end
-			 handle BadOption s => OPT_STRING opt
-		    else OPT_STRING opt
-		       
-	    fun doAll nil = nil
-	      | doAll (s::ss) = let val opt = doOne s
-				in case opt
-				     of OPT_NOOPT => opt::map OPT_STRING ss
-				      | _ => opt::doAll ss
-				end
-	 in doAll ss
-	 end
+         let 
+            fun doOne opt =
+               if String.isPrefix "--" opt 
+                  then let val opt1 = Substring.extract(opt,2,NONE) 
+                           val (key0,opt2) = Substring.splitl (fn c => #"="<>c) opt1
+                           val key = if Substring.isEmpty key0 then raise BadOption opt 
+                                     else Substring.string key0
+                           val valOpt = if Substring.isPrefix "=" opt2
+                                           then let val val0 = Substring.triml 1 opt2
+                                                in if Substring.isEmpty val0 
+                                                      then raise BadOption opt
+                                                   else SOME(Substring.string val0)
+                                                end
+                                        else NONE
+                       in OPT_LONG(key,valOpt)
+                       end
+                    handle BadOption s => if opt="--" then OPT_NOOPT else OPT_STRING opt
+               else if String.isPrefix "-" opt 
+                       then let val chars = tl(String.explode opt)
+                            (* val _ = app (fn c => if Char.isAlphaNum c then () 
+                                                    else raise BadOption opt) chars *)
+                            in case chars
+                                 of nil => OPT_STRING opt
+                                  | #"n"::(cs as _::_) => OPT_NEG cs
+                                  | _ => OPT_SHORT chars
+                            end
+                         handle BadOption s => OPT_STRING opt
+                    else OPT_STRING opt
+                       
+            fun doAll nil = nil
+              | doAll (s::ss) = let val opt = doOne s
+                                in case opt
+                                     of OPT_NOOPT => opt::map OPT_STRING ss
+                                      | _ => opt::doAll ss
+                                end
+         in doAll ss
+         end
 
       fun printUsage stream prog usage = 
-	 let 
+         let 
             val KEY_WIDTH = 30
             val LINE_WIDTH = 80
             val EMPTY_KEY = UtilString.nBlanks KEY_WIDTH
@@ -2136,21 +2136,21 @@
                                              end
             fun makeKey keylist = appendKeys 0 keylist
             val makeText = UtilString.breakLines(LINE_WIDTH-KEY_WIDTH)
-	    fun format (keylist,text) = 
+            fun format (keylist,text) = 
                let val key = makeKey keylist
                in case makeText text
                     of nil => [key]
                      | line::lines => key^line::map (fn line => EMPTY_KEY^line) lines
                end
             val _ = app (fn x => TextIO.output(stream,x))
-	       ["Usage: ",prog," [option ...] file\n","where option is one of:\n\n"]
-	    val _ = app (fn item => app (fn x => TextIO.output(stream,x^"\n")) 
+               ["Usage: ",prog," [option ...] file\n","where option is one of:\n\n"]
+            val _ = app (fn item => app (fn x => TextIO.output(stream,x^"\n")) 
                          (case item 
                             of U_SEP => [""]
                              | U_TITLE txt => ["",txt]
                              | U_ITEM option => format option)) usage
-	 in ()
-	 end
+         in ()
+         end
    end      
 (* stop of ../../Util/options.sml *)
 (* start of ../../config.sml *)
@@ -2218,7 +2218,7 @@
 
       type CharInterval = Char * Char
       type CharRange = CharInterval list
-	 
+         
       val Char2Word = Word.fromLargeWord o Chars.toLargeWord
 
       (*--------------------------------------------------------------------*)
@@ -2252,85 +2252,85 @@
       (* significant bit for c, i.e. the (c && 31==0x1F)th bit set to one.  *)
       (*--------------------------------------------------------------------*)
       fun indexMask c = let val idx = Chars.toInt(c>>0w5)
-			    val mask = 0wx1 <<< Char2Word c & 0w31
-			in (idx,mask)
-			end
+                            val mask = 0wx1 <<< Char2Word c & 0w31
+                        in (idx,mask)
+                        end
 
       (*--------------------------------------------------------------------*)
       (* generate index and mask, then lookup.                              *)
       (*--------------------------------------------------------------------*)
       fun inCharClass(c,vec) = let val (idx,mask) = indexMask c
-			       in mask &&& Vector.sub(vec,idx) <> 0wx0
-			       end 
+                               in mask &&& Vector.sub(vec,idx) <> 0wx0
+                               end 
 
       (*--------------------------------------------------------------------*)
       (* generate a CharClass large enough to hold (max-min+1) characters.  *)
       (*--------------------------------------------------------------------*)
       fun initialize(min,max) = 
-	 Array.array((Chars.toInt max-Chars.toInt min+1) div 32+1,0wx0):MutableClass
+         Array.array((Chars.toInt max-Chars.toInt min+1) div 32+1,0wx0):MutableClass
       fun finalize arr = Array.extract(arr,0,NONE)
-	 
+         
       (*--------------------------------------------------------------------*)
       (* add a single character to a CharClass.                             *)
       (*--------------------------------------------------------------------*)
       fun addChar(cls,min,max,c) =
-	 let 
-	    val (idx,new) = indexMask c
-	    val old = Array.sub(cls,idx)
-	 in
-	    Array.update(cls,idx,old|||new)
-	 end 
-			    
+         let 
+            val (idx,new) = indexMask c
+            val old = Array.sub(cls,idx)
+         in
+            Array.update(cls,idx,old|||new)
+         end 
+                            
       (*--------------------------------------------------------------------*)
       (* add a full range of characters to a CharClass.                     *)
       (* this is the only function that computes the offset before access   *)
       (* to the array.                                                      *)
       (*--------------------------------------------------------------------*)
       fun addCharRange(cls,min,max,range) =
-	 let 
-	    fun doOne (lo,hi) = 
-	       let 
-		  val (l,h) = (lo-min,hi-min)
-		  val (idxL,idxH) = ((Chars.toInt l) div 32,(Chars.toInt h) div 32)
-		  val (bitL,bitH) = (Char2Word l & 0w31,Char2Word h & 0w31)
-	       in 
-		  if idxL=idxH then 
-		     let 
-			val new = (max32>>>(0w31-bitH+bitL))<<<bitL
-			val old = Array.sub(cls,idxL)
-			val _ = Array.update(cls,idxL,old|||new)
-		     in ()
-		     end
-		  else if idxL<idxH then
-		     let
-			val newL = max32<<<bitL
-			val newH = max32>>>(0w31-bitH)
-			val oldL = Array.sub(cls,idxL)
-			val oldH = Array.sub(cls,idxH)
-			val _ = Array.update(cls,idxL,oldL|||newL)
-			val _ = Array.update(cls,idxH,oldH|||newH)
-			val _ = UtilInt.appInterval (fn i => Array.update(cls,i,max32)) 
-			   (idxL+1,idxH-1)
-		     in ()
-		     end
-		       else ()
-	       end
-	    fun doAll nil = nil
-	      | doAll ((lh as (lo,hi))::lhs) = 
-	       if hi<lo then doAll lhs
-	       else if hi<min then doAll lhs
-	       else if lo>max then lh::doAll lhs
-	       else if lo<min andalso hi<=max
-		       then (doOne(min,hi); doAll lhs)
-	       else if lo>=min andalso hi<=max
-		       then (doOne lh; doAll lhs)
-	       else if lo>=min andalso hi>max
-		       then (doOne(lo,max); (max+0w1,hi)::lhs)
-		    else (doOne(min,max); (max+0w1,hi)::lhs)
-	    val _ = doAll range
-	 in 
-	    doAll range
-	 end
+         let 
+            fun doOne (lo,hi) = 
+               let 
+                  val (l,h) = (lo-min,hi-min)
+                  val (idxL,idxH) = ((Chars.toInt l) div 32,(Chars.toInt h) div 32)
+                  val (bitL,bitH) = (Char2Word l & 0w31,Char2Word h & 0w31)
+               in 
+                  if idxL=idxH then 
+                     let 
+                        val new = (max32>>>(0w31-bitH+bitL))<<<bitL
+                        val old = Array.sub(cls,idxL)
+                        val _ = Array.update(cls,idxL,old|||new)
+                     in ()
+                     end
+                  else if idxL<idxH then
+                     let
+                        val newL = max32<<<bitL
+                        val newH = max32>>>(0w31-bitH)
+                        val oldL = Array.sub(cls,idxL)
+                        val oldH = Array.sub(cls,idxH)
+                        val _ = Array.update(cls,idxL,oldL|||newL)
+                        val _ = Array.update(cls,idxH,oldH|||newH)
+                        val _ = UtilInt.appInterval (fn i => Array.update(cls,i,max32)) 
+                           (idxL+1,idxH-1)
+                     in ()
+                     end
+                       else ()
+               end
+            fun doAll nil = nil
+              | doAll ((lh as (lo,hi))::lhs) = 
+               if hi<lo then doAll lhs
+               else if hi<min then doAll lhs
+               else if lo>max then lh::doAll lhs
+               else if lo<min andalso hi<=max
+                       then (doOne(min,hi); doAll lhs)
+               else if lo>=min andalso hi<=max
+                       then (doOne lh; doAll lhs)
+               else if lo>=min andalso hi>max
+                       then (doOne(lo,max); (max+0w1,hi)::lhs)
+                    else (doOne(min,max); (max+0w1,hi)::lhs)
+            val _ = doAll range
+         in 
+            doAll range
+         end
    end
 
 (* stop of ../../Unicode/Chars/charClasses.sml *)
@@ -2342,385 +2342,385 @@
 structure UniRanges = 
    struct
       val digitRange = [(0wx0030,0wx0039),
-			(0wx0660,0wx0669),
-			(0wx06F0,0wx06F9),
-			(0wx0966,0wx096F),
-			(0wx09E6,0wx09EF),
-			(0wx0A66,0wx0A6F),
-			(0wx0AE6,0wx0AEF),
-			(0wx0B66,0wx0B6F),
-			(0wx0BE7,0wx0BEF),
-			(0wx0C66,0wx0C6F),
-			(0wx0CE6,0wx0CEF),
-			(0wx0D66,0wx0D6F),
-			(0wx0E50,0wx0E59),
-			(0wx0ED0,0wx0ED9),
-			(0wx0F20,0wx0F29)
-			] : CharClasses.CharRange
+                        (0wx0660,0wx0669),
+                        (0wx06F0,0wx06F9),
+                        (0wx0966,0wx096F),
+                        (0wx09E6,0wx09EF),
+                        (0wx0A66,0wx0A6F),
+                        (0wx0AE6,0wx0AEF),
+                        (0wx0B66,0wx0B6F),
+                        (0wx0BE7,0wx0BEF),
+                        (0wx0C66,0wx0C6F),
+                        (0wx0CE6,0wx0CEF),
+                        (0wx0D66,0wx0D6F),
+                        (0wx0E50,0wx0E59),
+                        (0wx0ED0,0wx0ED9),
+                        (0wx0F20,0wx0F29)
+                        ] : CharClasses.CharRange
 
       val digitRange09 = [(0wx0030,0wx0039),
-			  (0wx0660,0wx0669),
-			  (0wx06F0,0wx06F9),
-			  (0wx0E50,0wx0E59),
-			  (0wx0ED0,0wx0ED9),
-			  (0wx0F20,0wx0F29)
-			  ] : CharClasses.CharRange
+                          (0wx0660,0wx0669),
+                          (0wx06F0,0wx06F9),
+                          (0wx0E50,0wx0E59),
+                          (0wx0ED0,0wx0ED9),
+                          (0wx0F20,0wx0F29)
+                          ] : CharClasses.CharRange
 
       val digitRange6F = [(0wx0966,0wx096F),
-			  (0wx09E6,0wx09EF),
-			  (0wx0A66,0wx0A6F),
-			  (0wx0AE6,0wx0AEF),
-			  (0wx0B66,0wx0B6F),
-			  (0wx0BE7,0wx0BEF),
-			  (0wx0C66,0wx0C6F),
-			  (0wx0CE6,0wx0CEF),
-			  (0wx0D66,0wx0D6F)
-			  ] : CharClasses.CharRange
+                          (0wx09E6,0wx09EF),
+                          (0wx0A66,0wx0A6F),
+                          (0wx0AE6,0wx0AEF),
+                          (0wx0B66,0wx0B6F),
+                          (0wx0BE7,0wx0BEF),
+                          (0wx0C66,0wx0C6F),
+                          (0wx0CE6,0wx0CEF),
+                          (0wx0D66,0wx0D6F)
+                          ] : CharClasses.CharRange
 
       val baseRange = [(0wx0041,0wx005A),
-		       (0wx0061,0wx007A),
-		       (0wx00C0,0wx00D6),
-		       (0wx00D8,0wx00F6),
-		       (0wx00F8,0wx00FF),
-		       (0wx0100,0wx0131),
-		       (0wx0134,0wx013E),
-		       (0wx0141,0wx0148),
-		       (0wx014A,0wx017E),
-		       (0wx0180,0wx01C3),
-		       (0wx01CD,0wx01F0),
-		       (0wx01F4,0wx01F5),
-		       (0wx01FA,0wx0217),
-		       (0wx0250,0wx02A8),
-		       (0wx02BB,0wx02C1),
-		       (0wx0386,0wx0386),
-		       (0wx0388,0wx038A),
-		       (0wx038C,0wx038C),
-		       (0wx038E,0wx03A1),
-		       (0wx03A3,0wx03CE),
-		       (0wx03D0,0wx03D6),
-		       (0wx03DA,0wx03DA),
-		       (0wx03DC,0wx03DC),
-		       (0wx03DE,0wx03DE),
-		       (0wx03E0,0wx03E0),
-		       (0wx03E2,0wx03F3),
-		       (0wx0401,0wx040C),
-		       (0wx040E,0wx044F),
-		       (0wx0451,0wx045C),
-		       (0wx045E,0wx0481),
-		       (0wx0490,0wx04C4),
-		       (0wx04C7,0wx04C8),
-		       (0wx04CB,0wx04CC),
-		       (0wx04D0,0wx04EB),
-		       (0wx04EE,0wx04F5),
-		       (0wx04F8,0wx04F9),
-		       (0wx0531,0wx0556),
-		       (0wx0559,0wx0559),
-		       (0wx0561,0wx0586),
-		       (0wx05D0,0wx05EA),
-		       (0wx05F0,0wx05F2),
-		       (0wx0621,0wx063A),
-		       (0wx0641,0wx064A),
-		       (0wx0671,0wx06B7),
-		       (0wx06BA,0wx06BE),
-		       (0wx06C0,0wx06CE),
-		       (0wx06D0,0wx06D3),
-		       (0wx06D5,0wx06D5),
-		       (0wx06E5,0wx06E6),
-		       (0wx0905,0wx0939),
-		       (0wx093D,0wx093D),
-		       (0wx0958,0wx0961),
-		       (0wx0985,0wx098C),
-		       (0wx098F,0wx0990),
-		       (0wx0993,0wx09A8),
-		       (0wx09AA,0wx09B0),
-		       (0wx09B2,0wx09B2),
-		       (0wx09B6,0wx09B9),
-		       (0wx09DC,0wx09DD),
-		       (0wx09DF,0wx09E1),
-		       (0wx09F0,0wx09F1),
-		       (0wx0A05,0wx0A0A),
-		       (0wx0A0F,0wx0A10),
-		       (0wx0A13,0wx0A28),
-		       (0wx0A2A,0wx0A30),
-		       (0wx0A32,0wx0A33),
-		       (0wx0A35,0wx0A36),
-		       (0wx0A38,0wx0A39),
-		       (0wx0A59,0wx0A5C),
-		       (0wx0A5E,0wx0A5E),
-		       (0wx0A72,0wx0A74),
-		       (0wx0A85,0wx0A8B),
-		       (0wx0A8D,0wx0A8D),
-		       (0wx0A8F,0wx0A91),
-		       (0wx0A93,0wx0AA8),
-		       (0wx0AAA,0wx0AB0),
-		       (0wx0AB2,0wx0AB3),
-		       (0wx0AB5,0wx0AB9),
-		       (0wx0ABD,0wx0ABD),
-		       (0wx0AE0,0wx0AE0),
-		       (0wx0B05,0wx0B0C),
-		       (0wx0B0F,0wx0B10),
-		       (0wx0B13,0wx0B28),
-		       (0wx0B2A,0wx0B30),
-		       (0wx0B32,0wx0B33),
-		       (0wx0B36,0wx0B39),
-		       (0wx0B3D,0wx0B3D),
-		       (0wx0B5C,0wx0B5D),
-		       (0wx0B5F,0wx0B61),
-		       (0wx0B85,0wx0B8A),
-		       (0wx0B8E,0wx0B90),
-		       (0wx0B92,0wx0B95),
-		       (0wx0B99,0wx0B9A),
-		       (0wx0B9C,0wx0B9C),
-		       (0wx0B9E,0wx0B9F),
-		       (0wx0BA3,0wx0BA4),
-		       (0wx0BA8,0wx0BAA),
-		       (0wx0BAE,0wx0BB5),
-		       (0wx0BB7,0wx0BB9),
-		       (0wx0C05,0wx0C0C),
-		       (0wx0C0E,0wx0C10),
-		       (0wx0C12,0wx0C28),
-		       (0wx0C2A,0wx0C33),
-		       (0wx0C35,0wx0C39),
-		       (0wx0C60,0wx0C61),
-		       (0wx0C85,0wx0C8C),
-		       (0wx0C8E,0wx0C90),
-		       (0wx0C92,0wx0CA8),
-		       (0wx0CAA,0wx0CB3),
-		       (0wx0CB5,0wx0CB9),
-		       (0wx0CDE,0wx0CDE),
-		       (0wx0CE0,0wx0CE1),
-		       (0wx0D05,0wx0D0C),
-		       (0wx0D0E,0wx0D10),
-		       (0wx0D12,0wx0D28),
-		       (0wx0D2A,0wx0D39),
-		       (0wx0D60,0wx0D61),
-		       (0wx0E01,0wx0E2E),
-		       (0wx0E30,0wx0E30),
-		       (0wx0E32,0wx0E33),
-		       (0wx0E40,0wx0E45),
-		       (0wx0E81,0wx0E82),
-		       (0wx0E84,0wx0E84),
-		       (0wx0E87,0wx0E88),
-		       (0wx0E8A,0wx0E8A),
-		       (0wx0E8D,0wx0E8D),
-		       (0wx0E94,0wx0E97),
-		       (0wx0E99,0wx0E9F),
-		       (0wx0EA1,0wx0EA3),
-		       (0wx0EA5,0wx0EA5),
-		       (0wx0EA7,0wx0EA7),
-		       (0wx0EAA,0wx0EAB),
-		       (0wx0EAD,0wx0EAE),
-		       (0wx0EB0,0wx0EB0),
-		       (0wx0EB2,0wx0EB3),
-		       (0wx0EBD,0wx0EBD),
-		       (0wx0EC0,0wx0EC4),
-		       (0wx0F40,0wx0F47),
-		       (0wx0F49,0wx0F69),
-		       (0wx10A0,0wx10C5),
-		       (0wx10D0,0wx10F6),
-		       (0wx1100,0wx1100),
-		       (0wx1102,0wx1103),
-		       (0wx1105,0wx1107),
-		       (0wx1109,0wx1109),
-		       (0wx110B,0wx110C),
-		       (0wx110E,0wx1112),
-		       (0wx113C,0wx113C),
-		       (0wx113E,0wx113E),
-		       (0wx1140,0wx1140),
-		       (0wx114C,0wx114C),
-		       (0wx114E,0wx114E),
-		       (0wx1150,0wx1150),
-		       (0wx1154,0wx1155),
-		       (0wx1159,0wx1159),
-		       (0wx115F,0wx1161),
-		       (0wx1163,0wx1163),
-		       (0wx1165,0wx1165),
-		       (0wx1167,0wx1167),
-		       (0wx1169,0wx1169),
-		       (0wx116D,0wx116E),
-		       (0wx1172,0wx1173),
-		       (0wx1175,0wx1175),
-		       (0wx119E,0wx119E),
-		       (0wx11A8,0wx11A8),
-		       (0wx11AB,0wx11AB),
-		       (0wx11AE,0wx11AF),
-		       (0wx11B7,0wx11B8),
-		       (0wx11BA,0wx11BA),
-		       (0wx11BC,0wx11C2),
-		       (0wx11EB,0wx11EB),
-		       (0wx11F0,0wx11F0),
-		       (0wx11F9,0wx11F9),
-		       (0wx1E00,0wx1E9B),
-		       (0wx1EA0,0wx1EF9),
-		       (0wx1F00,0wx1F15),
-		       (0wx1F18,0wx1F1D),
-		       (0wx1F20,0wx1F45),
-		       (0wx1F48,0wx1F4D),
-		       (0wx1F50,0wx1F57),
-		       (0wx1F59,0wx1F59),
-		       (0wx1F5B,0wx1F5B),
-		       (0wx1F5D,0wx1F5D),
-		       (0wx1F5F,0wx1F7D),
-		       (0wx1F80,0wx1FB4),
-		       (0wx1FB6,0wx1FBC),
-		       (0wx1FBE,0wx1FBE),
-		       (0wx1FC2,0wx1FC4),
-		       (0wx1FC6,0wx1FCC),
-		       (0wx1FD0,0wx1FD3),
-		       (0wx1FD6,0wx1FDB),
-		       (0wx1FE0,0wx1FEC),
-		       (0wx1FF2,0wx1FF4),
-		       (0wx1FF6,0wx1FFC),
-		       (0wx2126,0wx2126),
-		       (0wx212A,0wx212B),
-		       (0wx212E,0wx212E),
-		       (0wx2180,0wx2182),
-		       (0wx3041,0wx3094),
-		       (0wx30A1,0wx30FA),
-		       (0wx3105,0wx312C),
+                       (0wx0061,0wx007A),
+                       (0wx00C0,0wx00D6),
+                       (0wx00D8,0wx00F6),
+                       (0wx00F8,0wx00FF),
+                       (0wx0100,0wx0131),
+                       (0wx0134,0wx013E),
+                       (0wx0141,0wx0148),
+                       (0wx014A,0wx017E),
+                       (0wx0180,0wx01C3),
+                       (0wx01CD,0wx01F0),
+                       (0wx01F4,0wx01F5),
+                       (0wx01FA,0wx0217),
+                       (0wx0250,0wx02A8),
+                       (0wx02BB,0wx02C1),
+                       (0wx0386,0wx0386),
+                       (0wx0388,0wx038A),
+                       (0wx038C,0wx038C),
+                       (0wx038E,0wx03A1),
+                       (0wx03A3,0wx03CE),
+                       (0wx03D0,0wx03D6),
+                       (0wx03DA,0wx03DA),
+                       (0wx03DC,0wx03DC),
+                       (0wx03DE,0wx03DE),
+                       (0wx03E0,0wx03E0),
+                       (0wx03E2,0wx03F3),
+                       (0wx0401,0wx040C),
+                       (0wx040E,0wx044F),
+                       (0wx0451,0wx045C),
+                       (0wx045E,0wx0481),
+                       (0wx0490,0wx04C4),
+                       (0wx04C7,0wx04C8),
+                       (0wx04CB,0wx04CC),
+                       (0wx04D0,0wx04EB),
+                       (0wx04EE,0wx04F5),
+                       (0wx04F8,0wx04F9),
+                       (0wx0531,0wx0556),
+                       (0wx0559,0wx0559),
+                       (0wx0561,0wx0586),
+                       (0wx05D0,0wx05EA),
+                       (0wx05F0,0wx05F2),
+                       (0wx0621,0wx063A),
+                       (0wx0641,0wx064A),
+                       (0wx0671,0wx06B7),
+                       (0wx06BA,0wx06BE),
+                       (0wx06C0,0wx06CE),
+                       (0wx06D0,0wx06D3),
+                       (0wx06D5,0wx06D5),
+                       (0wx06E5,0wx06E6),
+                       (0wx0905,0wx0939),
+                       (0wx093D,0wx093D),
+                       (0wx0958,0wx0961),
+                       (0wx0985,0wx098C),
+                       (0wx098F,0wx0990),
+                       (0wx0993,0wx09A8),
+                       (0wx09AA,0wx09B0),
+                       (0wx09B2,0wx09B2),
+                       (0wx09B6,0wx09B9),
+                       (0wx09DC,0wx09DD),
+                       (0wx09DF,0wx09E1),
+                       (0wx09F0,0wx09F1),
+                       (0wx0A05,0wx0A0A),
+                       (0wx0A0F,0wx0A10),
+                       (0wx0A13,0wx0A28),
+                       (0wx0A2A,0wx0A30),
+                       (0wx0A32,0wx0A33),
+                       (0wx0A35,0wx0A36),
+                       (0wx0A38,0wx0A39),
+                       (0wx0A59,0wx0A5C),
+                       (0wx0A5E,0wx0A5E),
+                       (0wx0A72,0wx0A74),
+                       (0wx0A85,0wx0A8B),
+                       (0wx0A8D,0wx0A8D),
+                       (0wx0A8F,0wx0A91),
+                       (0wx0A93,0wx0AA8),
+                       (0wx0AAA,0wx0AB0),
+                       (0wx0AB2,0wx0AB3),
+                       (0wx0AB5,0wx0AB9),
+                       (0wx0ABD,0wx0ABD),
+                       (0wx0AE0,0wx0AE0),
+                       (0wx0B05,0wx0B0C),
+                       (0wx0B0F,0wx0B10),
+                       (0wx0B13,0wx0B28),
+                       (0wx0B2A,0wx0B30),
+                       (0wx0B32,0wx0B33),
+                       (0wx0B36,0wx0B39),
+                       (0wx0B3D,0wx0B3D),
+                       (0wx0B5C,0wx0B5D),
+                       (0wx0B5F,0wx0B61),
+                       (0wx0B85,0wx0B8A),
+                       (0wx0B8E,0wx0B90),
+                       (0wx0B92,0wx0B95),
+                       (0wx0B99,0wx0B9A),
+                       (0wx0B9C,0wx0B9C),
+                       (0wx0B9E,0wx0B9F),
+                       (0wx0BA3,0wx0BA4),
+                       (0wx0BA8,0wx0BAA),
+                       (0wx0BAE,0wx0BB5),
+                       (0wx0BB7,0wx0BB9),
+                       (0wx0C05,0wx0C0C),
+                       (0wx0C0E,0wx0C10),
+                       (0wx0C12,0wx0C28),
+                       (0wx0C2A,0wx0C33),
+                       (0wx0C35,0wx0C39),
+                       (0wx0C60,0wx0C61),
+                       (0wx0C85,0wx0C8C),
+                       (0wx0C8E,0wx0C90),
+                       (0wx0C92,0wx0CA8),
+                       (0wx0CAA,0wx0CB3),
+                       (0wx0CB5,0wx0CB9),
+                       (0wx0CDE,0wx0CDE),
+                       (0wx0CE0,0wx0CE1),
+                       (0wx0D05,0wx0D0C),
+                       (0wx0D0E,0wx0D10),
+                       (0wx0D12,0wx0D28),
+                       (0wx0D2A,0wx0D39),
+                       (0wx0D60,0wx0D61),
+                       (0wx0E01,0wx0E2E),
+                       (0wx0E30,0wx0E30),
+                       (0wx0E32,0wx0E33),
+                       (0wx0E40,0wx0E45),
+                       (0wx0E81,0wx0E82),
+                       (0wx0E84,0wx0E84),
+                       (0wx0E87,0wx0E88),
+                       (0wx0E8A,0wx0E8A),
+                       (0wx0E8D,0wx0E8D),
+                       (0wx0E94,0wx0E97),
+                       (0wx0E99,0wx0E9F),
+                       (0wx0EA1,0wx0EA3),
+                       (0wx0EA5,0wx0EA5),
+                       (0wx0EA7,0wx0EA7),
+                       (0wx0EAA,0wx0EAB),
+                       (0wx0EAD,0wx0EAE),
+                       (0wx0EB0,0wx0EB0),
+                       (0wx0EB2,0wx0EB3),
+                       (0wx0EBD,0wx0EBD),
+                       (0wx0EC0,0wx0EC4),
+                       (0wx0F40,0wx0F47),
+                       (0wx0F49,0wx0F69),
+                       (0wx10A0,0wx10C5),
+                       (0wx10D0,0wx10F6),
+                       (0wx1100,0wx1100),
+                       (0wx1102,0wx1103),
+                       (0wx1105,0wx1107),
+                       (0wx1109,0wx1109),
+                       (0wx110B,0wx110C),
+                       (0wx110E,0wx1112),
+                       (0wx113C,0wx113C),
+                       (0wx113E,0wx113E),
+                       (0wx1140,0wx1140),
+                       (0wx114C,0wx114C),
+                       (0wx114E,0wx114E),
+                       (0wx1150,0wx1150),
+                       (0wx1154,0wx1155),
+                       (0wx1159,0wx1159),
+                       (0wx115F,0wx1161),
+                       (0wx1163,0wx1163),
+                       (0wx1165,0wx1165),
+                       (0wx1167,0wx1167),
+                       (0wx1169,0wx1169),
+                       (0wx116D,0wx116E),
+                       (0wx1172,0wx1173),
+                       (0wx1175,0wx1175),
+                       (0wx119E,0wx119E),
+                       (0wx11A8,0wx11A8),
+                       (0wx11AB,0wx11AB),
+                       (0wx11AE,0wx11AF),
+                       (0wx11B7,0wx11B8),
+                       (0wx11BA,0wx11BA),
+                       (0wx11BC,0wx11C2),
+                       (0wx11EB,0wx11EB),
+                       (0wx11F0,0wx11F0),
+                       (0wx11F9,0wx11F9),
+                       (0wx1E00,0wx1E9B),
+                       (0wx1EA0,0wx1EF9),
+                       (0wx1F00,0wx1F15),
+                       (0wx1F18,0wx1F1D),
+                       (0wx1F20,0wx1F45),
+                       (0wx1F48,0wx1F4D),
+                       (0wx1F50,0wx1F57),
+                       (0wx1F59,0wx1F59),
+                       (0wx1F5B,0wx1F5B),
+                       (0wx1F5D,0wx1F5D),
+                       (0wx1F5F,0wx1F7D),
+                       (0wx1F80,0wx1FB4),
+                       (0wx1FB6,0wx1FBC),
+                       (0wx1FBE,0wx1FBE),
+                       (0wx1FC2,0wx1FC4),
+                       (0wx1FC6,0wx1FCC),
+                       (0wx1FD0,0wx1FD3),
+                       (0wx1FD6,0wx1FDB),
+                       (0wx1FE0,0wx1FEC),
+                       (0wx1FF2,0wx1FF4),
+                       (0wx1FF6,0wx1FFC),
+                       (0wx2126,0wx2126),
+                       (0wx212A,0wx212B),
+                       (0wx212E,0wx212E),
+                       (0wx2180,0wx2182),
+                       (0wx3041,0wx3094),
+                       (0wx30A1,0wx30FA),
+                       (0wx3105,0wx312C),
                        (0wxAC00,0wxD7A3) 
-		       ] : CharClasses.CharRange
+                       ] : CharClasses.CharRange
 
       val ideoRange = [(0wx3007,0wx3007),
-		       (0wx3021,0wx3029),
+                       (0wx3021,0wx3029),
                        (0wx4E00,0wx9FA5)
-		       ] : CharClasses.CharRange
+                       ] : CharClasses.CharRange
 
       val combRange = [(0wx0300,0wx0345),
-		       (0wx0360,0wx0361),
-		       (0wx0483,0wx0486),
-		       (0wx0591,0wx05A1),
-		       (0wx05A3,0wx05B9),
-		       (0wx05BB,0wx05BD),
-		       (0wx05BF,0wx05BF),
-		       (0wx05C1,0wx05C2),
-		       (0wx05C4,0wx05C4),
-		       (0wx064B,0wx0652),
-		       (0wx0670,0wx0670),
-		       (0wx06D6,0wx06DC),
-		       (0wx06DD,0wx06DF),
-		       (0wx06E0,0wx06E4),
-		       (0wx06E7,0wx06E8),
-		       (0wx06EA,0wx06ED),
-		       (0wx0901,0wx0903),
-		       (0wx093C,0wx093C),
-		       (0wx093E,0wx094C),
-		       (0wx094D,0wx094D),
-		       (0wx0951,0wx0954),
-		       (0wx0962,0wx0963),
-		       (0wx0981,0wx0983),
-		       (0wx09BC,0wx09BC),
-		       (0wx09BE,0wx09BE),
-		       (0wx09BF,0wx09BF),
-		       (0wx09C0,0wx09C4),
-		       (0wx09C7,0wx09C8),
-		       (0wx09CB,0wx09CD),
-		       (0wx09D7,0wx09D7),
-		       (0wx09E2,0wx09E3),
-		       (0wx0A02,0wx0A02),
-		       (0wx0A3C,0wx0A3C),
-		       (0wx0A3E,0wx0A3E),
-		       (0wx0A3F,0wx0A3F),
-		       (0wx0A40,0wx0A42),
-		       (0wx0A47,0wx0A48),
-		       (0wx0A4B,0wx0A4D),
-		       (0wx0A70,0wx0A71),
-		       (0wx0A81,0wx0A83),
-		       (0wx0ABC,0wx0ABC),
-		       (0wx0ABE,0wx0AC5),
-		       (0wx0AC7,0wx0AC9),
-		       (0wx0ACB,0wx0ACD),
-		       (0wx0B01,0wx0B03),
-		       (0wx0B3C,0wx0B3C),
-		       (0wx0B3E,0wx0B43),
-		       (0wx0B47,0wx0B48),
-		       (0wx0B4B,0wx0B4D),
-		       (0wx0B56,0wx0B57),
-		       (0wx0B82,0wx0B83),
-		       (0wx0BBE,0wx0BC2),
-		       (0wx0BC6,0wx0BC8),
-		       (0wx0BCA,0wx0BCD),
-		       (0wx0BD7,0wx0BD7),
-		       (0wx0C01,0wx0C03),
-		       (0wx0C3E,0wx0C44),
-		       (0wx0C46,0wx0C48),
-		       (0wx0C4A,0wx0C4D),
-		       (0wx0C55,0wx0C56),
-		       (0wx0C82,0wx0C83),
-		       (0wx0CBE,0wx0CC4),
-		       (0wx0CC6,0wx0CC8),
-		       (0wx0CCA,0wx0CCD),
-		       (0wx0CD5,0wx0CD6),
-		       (0wx0D02,0wx0D03),
-		       (0wx0D3E,0wx0D43),
-		       (0wx0D46,0wx0D48),
-		       (0wx0D4A,0wx0D4D),
-		       (0wx0D57,0wx0D57),
-		       (0wx0E31,0wx0E31),
-		       (0wx0E34,0wx0E3A),
-		       (0wx0E47,0wx0E4E),
-		       (0wx0EB1,0wx0EB1),
-		       (0wx0EB4,0wx0EB9),
-		       (0wx0EBB,0wx0EBC),
-		       (0wx0EC8,0wx0ECD),
-		       (0wx0F18,0wx0F19),
-		       (0wx0F35,0wx0F35),
-		       (0wx0F37,0wx0F37),
-		       (0wx0F39,0wx0F39),
-		       (0wx0F3E,0wx0F3E),
-		       (0wx0F3F,0wx0F3F),
-		       (0wx0F71,0wx0F84),
-		       (0wx0F86,0wx0F8B),
-		       (0wx0F90,0wx0F95),
-		       (0wx0F97,0wx0F97),
-		       (0wx0F99,0wx0FAD),
-		       (0wx0FB1,0wx0FB7),
-		       (0wx0FB9,0wx0FB9),
-		       (0wx20D0,0wx20DC),
-		       (0wx20E1,0wx20E1),
-		       (0wx302A,0wx302F),
-		       (0wx3099,0wx3099),
-		       (0wx309A,0wx309A)
-		       ] : CharClasses.CharRange
+                       (0wx0360,0wx0361),
+                       (0wx0483,0wx0486),
+                       (0wx0591,0wx05A1),
+                       (0wx05A3,0wx05B9),
+                       (0wx05BB,0wx05BD),
+                       (0wx05BF,0wx05BF),
+                       (0wx05C1,0wx05C2),
+                       (0wx05C4,0wx05C4),
+                       (0wx064B,0wx0652),
+                       (0wx0670,0wx0670),
+                       (0wx06D6,0wx06DC),
+                       (0wx06DD,0wx06DF),
+                       (0wx06E0,0wx06E4),
+                       (0wx06E7,0wx06E8),
+                       (0wx06EA,0wx06ED),
+                       (0wx0901,0wx0903),
+                       (0wx093C,0wx093C),
+                       (0wx093E,0wx094C),
+                       (0wx094D,0wx094D),
+                       (0wx0951,0wx0954),
+                       (0wx0962,0wx0963),
+                       (0wx0981,0wx0983),
+                       (0wx09BC,0wx09BC),
+                       (0wx09BE,0wx09BE),
+                       (0wx09BF,0wx09BF),
+                       (0wx09C0,0wx09C4),
+                       (0wx09C7,0wx09C8),
+                       (0wx09CB,0wx09CD),
+                       (0wx09D7,0wx09D7),
+                       (0wx09E2,0wx09E3),
+                       (0wx0A02,0wx0A02),
+                       (0wx0A3C,0wx0A3C),
+                       (0wx0A3E,0wx0A3E),
+                       (0wx0A3F,0wx0A3F),
+                       (0wx0A40,0wx0A42),
+                       (0wx0A47,0wx0A48),
+                       (0wx0A4B,0wx0A4D),
+                       (0wx0A70,0wx0A71),
+                       (0wx0A81,0wx0A83),
+                       (0wx0ABC,0wx0ABC),
+                       (0wx0ABE,0wx0AC5),
+                       (0wx0AC7,0wx0AC9),
+                       (0wx0ACB,0wx0ACD),
+                       (0wx0B01,0wx0B03),
+                       (0wx0B3C,0wx0B3C),
+                       (0wx0B3E,0wx0B43),
+                       (0wx0B47,0wx0B48),
+                       (0wx0B4B,0wx0B4D),
+                       (0wx0B56,0wx0B57),
+                       (0wx0B82,0wx0B83),
+                       (0wx0BBE,0wx0BC2),
+                       (0wx0BC6,0wx0BC8),
+                       (0wx0BCA,0wx0BCD),
+                       (0wx0BD7,0wx0BD7),
+                       (0wx0C01,0wx0C03),
+                       (0wx0C3E,0wx0C44),
+                       (0wx0C46,0wx0C48),
+                       (0wx0C4A,0wx0C4D),
+                       (0wx0C55,0wx0C56),
+                       (0wx0C82,0wx0C83),
+                       (0wx0CBE,0wx0CC4),
+                       (0wx0CC6,0wx0CC8),
+                       (0wx0CCA,0wx0CCD),
+                       (0wx0CD5,0wx0CD6),
+                       (0wx0D02,0wx0D03),
+                       (0wx0D3E,0wx0D43),
+                       (0wx0D46,0wx0D48),
+                       (0wx0D4A,0wx0D4D),
+                       (0wx0D57,0wx0D57),
+                       (0wx0E31,0wx0E31),
+                       (0wx0E34,0wx0E3A),
+                       (0wx0E47,0wx0E4E),
+                       (0wx0EB1,0wx0EB1),
+                       (0wx0EB4,0wx0EB9),
+                       (0wx0EBB,0wx0EBC),
+                       (0wx0EC8,0wx0ECD),
+                       (0wx0F18,0wx0F19),
+                       (0wx0F35,0wx0F35),
+                       (0wx0F37,0wx0F37),
+                       (0wx0F39,0wx0F39),
+                       (0wx0F3E,0wx0F3E),
+                       (0wx0F3F,0wx0F3F),
+                       (0wx0F71,0wx0F84),
+                       (0wx0F86,0wx0F8B),
+                       (0wx0F90,0wx0F95),
+                       (0wx0F97,0wx0F97),
+                       (0wx0F99,0wx0FAD),
+                       (0wx0FB1,0wx0FB7),
+                       (0wx0FB9,0wx0FB9),
+                       (0wx20D0,0wx20DC),
+                       (0wx20E1,0wx20E1),
+                       (0wx302A,0wx302F),
+                       (0wx3099,0wx3099),
+                       (0wx309A,0wx309A)
+                       ] : CharClasses.CharRange
 
       val extRange = [(0wx00B7,0wx00B7),
-		      (0wx02D0,0wx02D0),
-		      (0wx02D1,0wx02D1),
-		      (0wx0387,0wx0387),
-		      (0wx0640,0wx0640),
-		      (0wx0E46,0wx0E46),
-		      (0wx0EC6,0wx0EC6),
-		      (0wx3005,0wx3005),
-		      (0wx3031,0wx3035),
-		      (0wx309D,0wx309E),
-		      (0wx30FC,0wx30FE)
-		      ] : CharClasses.CharRange
+                      (0wx02D0,0wx02D0),
+                      (0wx02D1,0wx02D1),
+                      (0wx0387,0wx0387),
+                      (0wx0640,0wx0640),
+                      (0wx0E46,0wx0E46),
+                      (0wx0EC6,0wx0EC6),
+                      (0wx3005,0wx3005),
+                      (0wx3031,0wx3035),
+                      (0wx309D,0wx309E),
+                      (0wx30FC,0wx30FE)
+                      ] : CharClasses.CharRange
 
       val nmsRange = List.concat 
-	 [[(0wx3A,0wx3A),(0wx5F,0wx5F)](* :_ *),
-	  baseRange,
-	  ideoRange]
+         [[(0wx3A,0wx3A),(0wx5F,0wx5F)](* :_ *),
+          baseRange,
+          ideoRange]
 
       val nameRange = List.concat 
-	 [[(0wx2D,0wx2D),(0wx2E,0wx2E)](* -. *),
-	  digitRange,
-	  combRange,
-	  extRange,
-	  nmsRange]
+         [[(0wx2D,0wx2D),(0wx2E,0wx2E)](* -. *),
+          digitRange,
+          combRange,
+          extRange,
+          nmsRange]
 
       val pubidRange = List.concat
-	 [map (fn c => (c,c)) [0wx0A,0wx0D,0wx20], (* space,cr,lf *)
-	  map (fn c => (c,c)) (UniChar.String2Data "-'()+,./:=?;!*#@$_%"),
-	  [(0wx0030,0wx0039),(0wx0041,0wx005A),(0wx0061,0wx007A)] (* [0-9A-Za-z] *)
-	  ] : CharClasses.CharRange 
+         [map (fn c => (c,c)) [0wx0A,0wx0D,0wx20], (* space,cr,lf *)
+          map (fn c => (c,c)) (UniChar.String2Data "-'()+,./:=?;!*#@$_%"),
+          [(0wx0030,0wx0039),(0wx0041,0wx005A),(0wx0061,0wx007A)] (* [0-9A-Za-z] *)
+          ] : CharClasses.CharRange 
 
       val encRange =       
-      	 [(0wx002D,0wx002E), (* -.  *)
-	  (0wx0030,0wx0039), (* 0-9 *)
-	  (0wx0041,0wx005A), (* A-Z *)
-	  (0wx005F,0wx005F), (* _   *)
-	  (0wx0061,0wx007A)  (* a-z *)
-	  ] : CharClasses.CharRange
+         [(0wx002D,0wx002E), (* -.  *)
+          (0wx0030,0wx0039), (* 0-9 *)
+          (0wx0041,0wx005A), (* A-Z *)
+          (0wx005F,0wx005F), (* _   *)
+          (0wx0061,0wx007A)  (* a-z *)
+          ] : CharClasses.CharRange
    end
 (* stop of ../../Unicode/Chars/uniRanges.sml *)
 (* start of ../../Unicode/Chars/uniClasses.sml *)
@@ -2780,47 +2780,47 @@
       (* initialize the character classes.                                  *)
       (*--------------------------------------------------------------------*)
       local 
-	 val nmsTemp = initialize(0wx0000,0wx3FFF)
-	 val restNms = addCharRange(nmsTemp,0wx0000,0wx3FFF,nmsRange)
-	 val _ = if restNms=[(0wxAC00,0wxD7A3),(0wx4E00,0wx9FA5)] then () 
-		 else print ("Warning: extra characters after computing nms char class.\n")
+         val nmsTemp = initialize(0wx0000,0wx3FFF)
+         val restNms = addCharRange(nmsTemp,0wx0000,0wx3FFF,nmsRange)
+         val _ = if restNms=[(0wxAC00,0wxD7A3),(0wx4E00,0wx9FA5)] then () 
+                 else print ("Warning: extra characters after computing nms char class.\n")
 
-	 val nameTemp = initialize(0wx0000,0wxFFFF)
-	 val restName = addCharRange(nameTemp,0wx0000,0wx3FFF,nameRange)
-	 val _ = if restName=[(0wxAC00,0wxD7A3),(0wx4E00,0wx9FA5)] then () 
-		 else print ("Warning: extra characters after computing name char class.\n")
+         val nameTemp = initialize(0wx0000,0wxFFFF)
+         val restName = addCharRange(nameTemp,0wx0000,0wx3FFF,nameRange)
+         val _ = if restName=[(0wxAC00,0wxD7A3),(0wx4E00,0wx9FA5)] then () 
+                 else print ("Warning: extra characters after computing name char class.\n")
 
-	 val pubTemp = initialize(0wx0000,0wx007F)
-	 val restPubid = addCharRange(pubTemp,0wx0000,0wx007F,pubidRange)
-	 val _ = if restPubid=nil then () 
-		 else print ("Warning: extra characters after computing pubid char class.\n")
+         val pubTemp = initialize(0wx0000,0wx007F)
+         val restPubid = addCharRange(pubTemp,0wx0000,0wx007F,pubidRange)
+         val _ = if restPubid=nil then () 
+                 else print ("Warning: extra characters after computing pubid char class.\n")
 
-	 val encTemp = initialize(0wx0000,0wx007F)
-	 val restEnc = addCharRange(encTemp,0wx0000,0wx007F,encRange)
-	 val _ = if restEnc=nil then () 
-		 else print ("Warning: extra characters after computing enc char class.\n")
+         val encTemp = initialize(0wx0000,0wx007F)
+         val restEnc = addCharRange(encTemp,0wx0000,0wx007F,encRange)
+         val _ = if restEnc=nil then () 
+                 else print ("Warning: extra characters after computing enc char class.\n")
       in
-	 val nmsClass = finalize nmsTemp
-	 val nameClass = finalize nameTemp
-	 val pubClass = finalize pubTemp
-	 val encClass = finalize encTemp
+         val nmsClass = finalize nmsTemp
+         val nameClass = finalize nameTemp
+         val pubClass = finalize pubTemp
+         val encClass = finalize encTemp
       end
       
       (*--------------------------------------------------------------------*)
       (* is a character a name start char?                                  *)
       (*--------------------------------------------------------------------*)
       fun isNms c = if c<0wx4000 then inCharClass(c,nmsClass) 
-		    else 
-		       c>=0wx4E00 andalso c<=0wx9FA5 orelse
-		       c>=0wxAC00 andalso c<=0wxD7A3
+                    else 
+                       c>=0wx4E00 andalso c<=0wx9FA5 orelse
+                       c>=0wxAC00 andalso c<=0wxD7A3
 
       (*--------------------------------------------------------------------*)
       (* is a character a name char?                                        *)
       (*--------------------------------------------------------------------*)
       fun isName c = if c<0wx4000 then inCharClass(c,nameClass)
-		     else 
-			c>=0wx4E00 andalso c<=0wx9FA5 orelse
-			c>=0wxAC00 andalso c<=0wxD7A3
+                     else 
+                        c>=0wx4E00 andalso c<=0wx9FA5 orelse
+                        c>=0wxAC00 andalso c<=0wxD7A3
 
       (*--------------------------------------------------------------------*)
       (* is a character a pubid char?                                       *)
@@ -2832,12 +2832,12 @@
       (* version number?                                                    *)
       (*--------------------------------------------------------------------*)
       fun isEnc c = 
-	 c<0wx80 andalso inCharClass(c,encClass)
+         c<0wx80 andalso inCharClass(c,encClass)
       fun isEncS (c:UniChar.Char) = 
-	 c>=0wx41 andalso c<=0wx5A orelse
-	 c>=0wx61 andalso c<=0wx7A
+         c>=0wx41 andalso c<=0wx5A orelse
+         c>=0wx61 andalso c<=0wx7A
       fun isVers c = 
-	 isEnc c orelse c=0wx3A (* #":" *)
+         isEnc c orelse c=0wx3A (* #":" *)
 
       (*--------------------------------------------------------------------*)
       (* these are the valid Unicode characters (including surrogates).     *)
@@ -2848,54 +2848,54 @@
       (* XML characters if not checked for Unicode char in advance.         *)
       (*--------------------------------------------------------------------*)
       fun isXml (c:UniChar.Char) = 
-	 c>=0wx0020 andalso c<=0wxD7FF orelse
-	 c>=0wxE000 andalso c<=0wxFFFD orelse
-	 c>=0wx10000 andalso c<=0wx10FFFF orelse
-	 c=0wx9 orelse c=0wxA orelse c=0wxD
+         c>=0wx0020 andalso c<=0wxD7FF orelse
+         c>=0wxE000 andalso c<=0wxFFFD orelse
+         c>=0wx10000 andalso c<=0wx10FFFF orelse
+         c=0wx9 orelse c=0wxA orelse c=0wxD
 
       (*--------------------------------------------------------------------*)
       (* the frontend supresses 0wxD (carriage return), but its is still    *)
       (* present when encoding is recognized.                               *)
       (*--------------------------------------------------------------------*)
       fun isS (c:UniChar.Char) = 
-	 case c
-	   of 0wx09 => true 
-	    | 0wx0A => true 
-	    | 0wx0D => true
-	    | 0wx20 => true
-	    | _ => false
+         case c
+           of 0wx09 => true 
+            | 0wx0A => true 
+            | 0wx0D => true
+            | 0wx20 => true
+            | _ => false
 
       (*--------------------------------------------------------------------*)
       (* is this character an ascii decimal/hexadecimal digit?              *)
       (*--------------------------------------------------------------------*)
       fun isDec (c:UniChar.Char) = 
-	 c>=0wx30 andalso c<=0wx39
+         c>=0wx30 andalso c<=0wx39
       fun isHex (c:UniChar.Char) = 
-	 c>=0wx30 andalso c<=0wx39 orelse     
-	 c>=0wx41 andalso c<=0wx46 orelse
-	 c>=0wx61 andalso c<=0wx66
+         c>=0wx30 andalso c<=0wx39 orelse     
+         c>=0wx41 andalso c<=0wx46 orelse
+         c>=0wx61 andalso c<=0wx66
 
       (*--------------------------------------------------------------------*)
       (* calculate the decimal/hexadecimal value of an ascii (hex-)digit.   *)
       (*--------------------------------------------------------------------*)
       fun decValue (c:UniChar.Char) = 
-	 let val v = c-0wx30
-	 in if v<=0wx9 then SOME v else NONE
-	 end
+         let val v = c-0wx30
+         in if v<=0wx9 then SOME v else NONE
+         end
       fun hexValue (c:UniChar.Char) = 
-	 let val v = c-0wx30
-	 in if v<=0wx9 then SOME v
-	    else (if c>=0wx41 andalso c<=0wx46 then SOME(c-0wx37)
-	    else if c>=0wx61 andalso c<=0wx66 then SOME(c-0wx57)
-		 else NONE)
-	 end
-		    
+         let val v = c-0wx30
+         in if v<=0wx9 then SOME v
+            else (if c>=0wx41 andalso c<=0wx46 then SOME(c-0wx37)
+            else if c>=0wx61 andalso c<=0wx66 then SOME(c-0wx57)
+                 else NONE)
+         end
+                    
       (*--------------------------------------------------------------------*)
       (* is c in [a-z]+[A-Z]?                                               *)
       (*--------------------------------------------------------------------*)
       fun isAsciiLetter (c:UniChar.Char) = 
-	 c>=0wx41 andalso c<=0wx5A orelse 
-	 c>=0wx61 andalso c<=0wx7A 
+         c>=0wx41 andalso c<=0wx5A orelse 
+         c>=0wx61 andalso c<=0wx7A 
    end
 (* stop of ../../Unicode/Chars/uniClasses.sml *)
 (* start of ../../Unicode/Uri/uriDecode.sml *)
@@ -2996,15 +2996,15 @@
             
             fun doit yet nil = yet
               | doit yet (c::cs) =
-	       if #"%"<>c then doit (c::yet) cs
-	       else let val (yet1,cs1) = let val (ch,cs1) = getCharUtf8 cs
-					 in (ch::yet,cs1)
-					 end
-				      handle Failed cs => (yet,cs)
-		    in doit yet1 cs1
-		    end
-	 in 
-	    String.implode(rev(doit nil cs))
+               if #"%"<>c then doit (c::yet) cs
+               else let val (yet1,cs1) = let val (ch,cs1) = getCharUtf8 cs
+                                         in (ch::yet,cs1)
+                                         end
+                                      handle Failed cs => (yet,cs)
+                    in doit yet1 cs1
+                    end
+         in 
+            String.implode(rev(doit nil cs))
          end
 
       (*--------------------------------------------------------------------*)
@@ -3013,8 +3013,8 @@
       fun getChar cs = 
          case cs 
            of #"%"::cs1 => let val (b,cs2) = getQuads cs1 
-			   in (Byte.byteToChar b,cs2)
-			   end
+                           in (Byte.byteToChar b,cs2)
+                           end
             | c::cs1 => (c,cs1)
             | nil => raise Failed nil
                     
@@ -3024,14 +3024,14 @@
             
             fun doit yet nil = yet
               | doit yet (c::cs) = 
-	       let val (yet1,cs1) = let val (ch,cs1) = getChar cs
-				    in (ch::yet,cs1)
-				    end
-				 handle Failed cs => (yet,cs)
-	       in doit yet1 cs1
-	       end
-	 in 
-	    String.implode(rev(doit nil cs))
+               let val (yet1,cs1) = let val (ch,cs1) = getChar cs
+                                    in (ch::yet,cs1)
+                                    end
+                                 handle Failed cs => (yet,cs)
+               in doit yet1 cs1
+               end
+         in 
+            String.implode(rev(doit nil cs))
          end
    end
 (* stop of ../../Unicode/Uri/uriDecode.sml *)
@@ -3066,66 +3066,66 @@
       val Char2Byte = Word8.fromLargeWord o Chars.toLargeWord
 
       fun encodeCharUtf8 c = 
-	 if c<0wx80 then [Char2Byte c]
-	 else if c<0wx800 
-		 then [0wxC0 || Char2Byte(c >>> 0w6),
-		       0wx80 || Char2Byte(c &&& 0wx3F)]
-	 else if c<0wx10000
-		 then [0wxE0 || Char2Byte(c >>> 0w12),
-		       0wx80 || Char2Byte((c >>> 0w6) &&& 0wx3F),
-		       0wx80 || Char2Byte(c &&& 0wx3F)]
-	 else if c<0wx200000
-		 then [0wxF0 || Char2Byte(c >>> 0w18),
-		       0wx80 || Char2Byte((c >>> 0w12) &&& 0wx3F),
-		       0wx80 || Char2Byte((c >>> 0w6) &&& 0wx3F),
-		       0wx80 || Char2Byte(c &&& 0wx3F)]
-	 else if c<0wx4000000
-		 then [0wxF8 || Char2Byte(c >>> 0w24),
-		       0wx80 || Char2Byte((c >>> 0w18) &&& 0wx3F),
-		       0wx80 || Char2Byte((c >>> 0w12) &&& 0wx3F),
-		       0wx80 || Char2Byte((c >>> 0w6) &&& 0wx3F),
-		       0wx80 || Char2Byte(c &&& 0wx3F)]
-	      else [0wxFC || Char2Byte(c >>> 0w30),
-		    0wx80 || Char2Byte((c >>> 0w24) &&& 0wx3F),
-		    0wx80 || Char2Byte((c >>> 0w18) &&& 0wx3F),
-		    0wx80 || Char2Byte((c >>> 0w12) &&& 0wx3F),
-		    0wx80 || Char2Byte((c >>> 0w6) &&& 0wx3F),
-		    0wx80 || Char2Byte(c &&& 0wx3F)]
+         if c<0wx80 then [Char2Byte c]
+         else if c<0wx800 
+                 then [0wxC0 || Char2Byte(c >>> 0w6),
+                       0wx80 || Char2Byte(c &&& 0wx3F)]
+         else if c<0wx10000
+                 then [0wxE0 || Char2Byte(c >>> 0w12),
+                       0wx80 || Char2Byte((c >>> 0w6) &&& 0wx3F),
+                       0wx80 || Char2Byte(c &&& 0wx3F)]
+         else if c<0wx200000
+                 then [0wxF0 || Char2Byte(c >>> 0w18),
+                       0wx80 || Char2Byte((c >>> 0w12) &&& 0wx3F),
+                       0wx80 || Char2Byte((c >>> 0w6) &&& 0wx3F),
+                       0wx80 || Char2Byte(c &&& 0wx3F)]
+         else if c<0wx4000000
+                 then [0wxF8 || Char2Byte(c >>> 0w24),
+                       0wx80 || Char2Byte((c >>> 0w18) &&& 0wx3F),
+                       0wx80 || Char2Byte((c >>> 0w12) &&& 0wx3F),
+                       0wx80 || Char2Byte((c >>> 0w6) &&& 0wx3F),
+                       0wx80 || Char2Byte(c &&& 0wx3F)]
+              else [0wxFC || Char2Byte(c >>> 0w30),
+                    0wx80 || Char2Byte((c >>> 0w24) &&& 0wx3F),
+                    0wx80 || Char2Byte((c >>> 0w18) &&& 0wx3F),
+                    0wx80 || Char2Byte((c >>> 0w12) &&& 0wx3F),
+                    0wx80 || Char2Byte((c >>> 0w6) &&& 0wx3F),
+                    0wx80 || Char2Byte(c &&& 0wx3F)]
 
       fun Byte2Cc b = 
-	 let fun Quad2C b = if b<0wxA then Byte.byteToChar(b+0wx30) else Byte.byteToChar(b+0wx37)
-	 in (Quad2C(b >> 0w4),Quad2C(b && 0wx0F))
-	 end
+         let fun Quad2C b = if b<0wxA then Byte.byteToChar(b+0wx30) else Byte.byteToChar(b+0wx37)
+         in (Quad2C(b >> 0w4),Quad2C(b && 0wx0F))
+         end
 
       fun precedesHex (i,cv) = 
-	 if Vector.length cv <= i+2 then false
-	 else let val (c1,c2) = (Vector.sub(cv,i+1),Vector.sub(cv,i+2))
-	      in isHex c1 andalso isHex c2
-	      end
+         if Vector.length cv <= i+2 then false
+         else let val (c1,c2) = (Vector.sub(cv,i+1),Vector.sub(cv,i+2))
+              in isHex c1 andalso isHex c2
+              end
 
       fun Vector2UriUtf8 cv = 
-	 let val revd = Vector.foldli
-	    (fn (i,c,s) => if c<0wx80 andalso (c<>0wx25 orelse precedesHex(i,cv)) 
-			      then Char2char c::s
-			   else foldl (fn (b,s) => let val (c1,c2) = Byte2Cc b
-						   in c2::c1:: #"%"::s
-						   end) 
-			      s (encodeCharUtf8 c)) 
-	    nil (cv,0,NONE)
-	 in String.implode (rev revd)
-	 end
+         let val revd = Vector.foldli
+            (fn (i,c,s) => if c<0wx80 andalso (c<>0wx25 orelse precedesHex(i,cv)) 
+                              then Char2char c::s
+                           else foldl (fn (b,s) => let val (c1,c2) = Byte2Cc b
+                                                   in c2::c1:: #"%"::s
+                                                   end) 
+                              s (encodeCharUtf8 c)) 
+            nil (cv,0,NONE)
+         in String.implode (rev revd)
+         end
 
       fun Vector2UriLatin cv = 
-	 let val revd = Vector.foldli
-	    (fn (i,c,s) => if c<0wx80 andalso (c<>0wx25 orelse precedesHex(i,cv)) 
-			      then Char2char c::s
-			   else (if c>= 0w100 then s
-				 else let val (c1,c2) = Byte2Cc (Char2Byte c)
-				      in c2::c1:: #"%"::s
-				      end)) 
-	    nil (cv,0,NONE)
-	 in String.implode (rev revd)
-	 end
+         let val revd = Vector.foldli
+            (fn (i,c,s) => if c<0wx80 andalso (c<>0wx25 orelse precedesHex(i,cv)) 
+                              then Char2char c::s
+                           else (if c>= 0w100 then s
+                                 else let val (c1,c2) = Byte2Cc (Char2Byte c)
+                                      in c2::c1:: #"%"::s
+                                      end)) 
+            nil (cv,0,NONE)
+         in String.implode (rev revd)
+         end
 
       val Data2UriUtf8 = Vector2UriUtf8 o Data2Vector
       val Data2UriLatin = Vector2UriLatin o Data2Vector
@@ -3189,149 +3189,149 @@
       val slash = "/"
 
       fun uriSuffix s =
-	 let fun search i = if i<0 then NONE else case String.sub(s,i) 
-						    of #"." => SOME i
-						     | #"/" => NONE
-						     | _ => search (i-1)
-	 in case search (String.size s-1)
-	      of NONE => ""
-	       | SOME i => String.extract(s,i+1,NONE)
-	 end
+         let fun search i = if i<0 then NONE else case String.sub(s,i) 
+                                                    of #"." => SOME i
+                                                     | #"/" => NONE
+                                                     | _ => search (i-1)
+         in case search (String.size s-1)
+              of NONE => ""
+               | SOME i => String.extract(s,i+1,NONE)
+         end
 
       fun isScheme c = 
-	 Char.isAlphaNum c orelse #"+"=c orelse #"-"=c orelse #"."=c
+         Char.isAlphaNum c orelse #"+"=c orelse #"-"=c orelse #"."=c
 
       fun uriAbsolute uri =
-	 let fun search i = 
-	    if i>=String.size uri then false
-	    else let val c=String.sub(uri,i)
-		 in if #":"=c then true else if isScheme c then search (i+1)
-					     else false
-		 end
-	 in 
-	    if uri="" then false
-	    else if Char.isAlpha (String.sub(uri,0)) then search 1
-		 else false
-	 end
+         let fun search i = 
+            if i>=String.size uri then false
+            else let val c=String.sub(uri,i)
+                 in if #":"=c then true else if isScheme c then search (i+1)
+                                             else false
+                 end
+         in 
+            if uri="" then false
+            else if Char.isAlpha (String.sub(uri,0)) then search 1
+                 else false
+         end
       fun uriRelative uri = not (uriAbsolute uri)
-		 
+                 
       fun uriLocal uri =
-	 if String.isPrefix "file:" uri 
-	    then SOME(String.extract(uri,5,NONE)) 
-	 else if uriRelative uri then SOME uri 
-	      else NONE
+         if String.isPrefix "file:" uri 
+            then SOME(String.extract(uri,5,NONE)) 
+         else if uriRelative uri then SOME uri 
+              else NONE
 
       fun uriPath s =
-	 let 
-	    fun search (i,hadSlash) = 
-	       if i<0 then if hadSlash then SOME 0 else NONE
-	       else case String.sub(s,i) 
-		      of #"/" => if hadSlash then NONE else search(i-1,true)
-		       | _ => if hadSlash then SOME(i+1) else search(i-1,false)
-	    val len = String.size s
-	    val posOpt = search(len-1,false)
-	 in case posOpt
-	      of NONE => emptyUri
-	       | SOME i => if i=0 then slash
-			   else String.extract(s,0,SOME(i+1))
-	 end
+         let 
+            fun search (i,hadSlash) = 
+               if i<0 then if hadSlash then SOME 0 else NONE
+               else case String.sub(s,i) 
+                      of #"/" => if hadSlash then NONE else search(i-1,true)
+                       | _ => if hadSlash then SOME(i+1) else search(i-1,false)
+            val len = String.size s
+            val posOpt = search(len-1,false)
+         in case posOpt
+              of NONE => emptyUri
+               | SOME i => if i=0 then slash
+                           else String.extract(s,0,SOME(i+1))
+         end
 
       fun uriAuth uri =
-	 let 
-	    fun searchScheme i = 
-	       if i>=String.size uri then NONE
-	       else let val c=String.sub(uri,i)
-		    in if #":"=c then SOME i else if isScheme c then searchScheme (i+1)
-						  else NONE
-		 end
-	    fun searchSlash i = 
-	       if i>=String.size uri then NONE
-	       else let val c=String.sub(uri,i)
-		    in if #"/"=c then SOME i else searchSlash (i+1)
-		    end
-	 in 
-	    if uri="" then ""
-	    else if not (Char.isAlpha(String.sub(uri,0))) then ""
-		 else case searchScheme 1
-			of NONE => ""
-			 | SOME i => 
-			   if String.size uri<=i+2 then String.extract(uri,0,SOME(i+1))
-			   else if #"/"=String.sub(uri,i+1) andalso #"/"=String.sub(uri,i+2)
-				   then case searchSlash (i+3)
-					  of NONE => uri
-					   | SOME j => String.extract(uri,0,SOME j)
-				else String.extract(uri,0,SOME(i+1))
-	 end
+         let 
+            fun searchScheme i = 
+               if i>=String.size uri then NONE
+               else let val c=String.sub(uri,i)
+                    in if #":"=c then SOME i else if isScheme c then searchScheme (i+1)
+                                                  else NONE
+                 end
+            fun searchSlash i = 
+               if i>=String.size uri then NONE
+               else let val c=String.sub(uri,i)
+                    in if #"/"=c then SOME i else searchSlash (i+1)
+                    end
+         in 
+            if uri="" then ""
+            else if not (Char.isAlpha(String.sub(uri,0))) then ""
+                 else case searchScheme 1
+                        of NONE => ""
+                         | SOME i => 
+                           if String.size uri<=i+2 then String.extract(uri,0,SOME(i+1))
+                           else if #"/"=String.sub(uri,i+1) andalso #"/"=String.sub(uri,i+2)
+                                   then case searchSlash (i+3)
+                                          of NONE => uri
+                                           | SOME j => String.extract(uri,0,SOME j)
+                                else String.extract(uri,0,SOME(i+1))
+         end
 
       fun uriScheme uri =
-	 let 
-	    fun searchScheme i = 
-	       if i>=String.size uri then NONE
-	       else let val c=String.sub(uri,i)
-		    in if #":"=c then SOME i else if isScheme c then searchScheme (i+1)
-						  else NONE
-		 end
-	 in 
-	    if uri="" then ""
-	    else if not (Char.isAlpha(String.sub(uri,0))) then ""
-		 else case searchScheme 1
-			of NONE => ""
-			 | SOME i => String.extract(uri,0,SOME(i+1))
-	 end
+         let 
+            fun searchScheme i = 
+               if i>=String.size uri then NONE
+               else let val c=String.sub(uri,i)
+                    in if #":"=c then SOME i else if isScheme c then searchScheme (i+1)
+                                                  else NONE
+                 end
+         in 
+            if uri="" then ""
+            else if not (Char.isAlpha(String.sub(uri,0))) then ""
+                 else case searchScheme 1
+                        of NONE => ""
+                         | SOME i => String.extract(uri,0,SOME(i+1))
+         end
       
       fun uriJoin(abs,rel) = 
-	 if rel="" then uriPath abs
-	 else if abs="" then rel
-	 else if String.isPrefix "//" rel then uriScheme abs^rel
-	 else if #"/"=String.sub(rel,0) then uriAuth abs^rel
-	 else if uriAbsolute rel then rel
-	      else uriPath abs^rel
+         if rel="" then uriPath abs
+         else if abs="" then rel
+         else if String.isPrefix "//" rel then uriScheme abs^rel
+         else if #"/"=String.sub(rel,0) then uriAuth abs^rel
+         else if uriAbsolute rel then rel
+              else uriPath abs^rel
 
       val compareUri = String.compare
       val hashUri = UtilHash.hashString
 
       fun convertCommand str (src,dst) =
-	 let 
-	    val s = Substring.all str
-	    fun doit ss s = 
-	       if Substring.isEmpty s then ss
-	       else let val (sl,sr) = Substring.splitr (fn c => #"%"<>c) s
-		    in if Substring.isEmpty sl then sr::ss
-		       else let val sl' =  Substring.trimr 1 sl
-			    in case Substring.first sr
-				 of SOME #"1" => let val sr' = Substring.triml 1 sr
-						 in doit (Substring.all src::sr'::ss) sl'
-						 end
-				  | SOME #"2" => let val sr' = Substring.triml 1 sr
-						 in doit (Substring.all dst::sr'::ss) sl'
-						 end
-				  | _ => doit (Substring.all "%"::sr::ss) sl'
-			    end
-		    end
-	    val ss = doit nil s
-	    val s = Substring.concat ss
-	 in s
-	 end
+         let 
+            val s = Substring.all str
+            fun doit ss s = 
+               if Substring.isEmpty s then ss
+               else let val (sl,sr) = Substring.splitr (fn c => #"%"<>c) s
+                    in if Substring.isEmpty sl then sr::ss
+                       else let val sl' =  Substring.trimr 1 sl
+                            in case Substring.first sr
+                                 of SOME #"1" => let val sr' = Substring.triml 1 sr
+                                                 in doit (Substring.all src::sr'::ss) sl'
+                                                 end
+                                  | SOME #"2" => let val sr' = Substring.triml 1 sr
+                                                 in doit (Substring.all dst::sr'::ss) sl'
+                                                 end
+                                  | _ => doit (Substring.all "%"::sr::ss) sl'
+                            end
+                    end
+            val ss = doit nil s
+            val s = Substring.concat ss
+         in s
+         end
 
       fun retrieveRemote uri =
-	 let 
-	    val tmp = OS.FileSys.tmpName()
-	    val cmd = convertCommand Config.retrieveCommand (uri,tmp)
-	    val status = OS.Process.system cmd
-	    val _ = if status = OS.Process.success then ()
-		    else let val _ = (OS.FileSys.remove tmp 
-				      handle OS.SysErr _ => ())
-			     val cmd = convertCommand 
-				Config.retrieveCommand ("<uri>",tmp)
-			 in raise NoSuchFile (uri,"command '"^cmd^"' failed")
-			 end
-	 in (Uri2String uri,tmp,true)
-	 end
+         let 
+            val tmp = OS.FileSys.tmpName()
+            val cmd = convertCommand Config.retrieveCommand (uri,tmp)
+            val status = OS.Process.system cmd
+            val _ = if status = OS.Process.success then ()
+                    else let val _ = (OS.FileSys.remove tmp 
+                                      handle OS.SysErr _ => ())
+                             val cmd = convertCommand 
+                                Config.retrieveCommand ("<uri>",tmp)
+                         in raise NoSuchFile (uri,"command '"^cmd^"' failed")
+                         end
+         in (Uri2String uri,tmp,true)
+         end
 
       fun retrieveUri uri = 
-	 case uriLocal uri
-	   of SOME f => (Uri2String uri,Uri2String f,false) 
-	    | NONE => retrieveRemote uri 
+         case uriLocal uri
+           of SOME f => (Uri2String uri,Uri2String f,false) 
+            | NONE => retrieveRemote uri 
    end
 (* stop of ../../Unicode/Uri/uri.sml *)
 (* start of ../../Parser/version.sml *)
@@ -3377,11 +3377,11 @@
       (* split a list into a list of lists at each element fullfilling p.   *)
       (*--------------------------------------------------------------------*) 
       fun split p l = 
-	 let val (one,ls) = foldr
-	    (fn (a,(curr,ls)) => if p a then (nil,curr::ls) else (a::curr,ls)) 
-	    (nil,nil) l
-	 in one::ls
-	 end
+         let val (one,ls) = foldr
+            (fn (a,(curr,ls)) => if p a then (nil,curr::ls) else (a::curr,ls)) 
+            (nil,nil) l
+         in one::ls
+         end
 
       (*--------------------------------------------------------------------*)
       (* is x a member of l?                                                *)
@@ -3393,16 +3393,16 @@
       (* [f(a1,b1),f(a1,b2),...,f(an,bk-1),f(an,bk)].                       *)
       (*--------------------------------------------------------------------*)
       fun mapAllPairs f (ass,bs) = 
-	 foldr 
-	 (fn (a,cs) => foldr (fn (b,cs) => f(a,b)::cs) cs bs) 
-	 nil ass
+         foldr 
+         (fn (a,cs) => foldr (fn (b,cs) => f(a,b)::cs) cs bs) 
+         nil ass
 
       (*--------------------------------------------------------------------*)
       (* find the first element x of l such that f x = SOME y, and return   *)
       (* f x. If there is no such x, return NONE.                           *)
       (*--------------------------------------------------------------------*)
       fun findAndMap _ nil = NONE 
-	| findAndMap f (x::xs) = case f x of NONE => findAndMap f xs | y => y
+        | findAndMap f (x::xs) = case f x of NONE => findAndMap f xs | y => y
 
       (*--------------------------------------------------------------------*)
       (* find the first element x of l such that f x = true, delete it from *)
@@ -3410,132 +3410,132 @@
       (* return (NONE,l).                                                   *)
       (*--------------------------------------------------------------------*)
       fun findAndDelete _ nil = (NONE,nil)
-	| findAndDelete f (x::xs) = 
-	 if f x then (SOME x,xs)
-	 else let val (y,ys) = findAndDelete f xs in (y,x::ys) end  
+        | findAndDelete f (x::xs) = 
+         if f x then (SOME x,xs)
+         else let val (y,ys) = findAndDelete f xs in (y,x::ys) end  
 
       (*--------------------------------------------------------------------*)
       (* given a function that compares elements, merge two sorted lists.   *)
       (*--------------------------------------------------------------------*)
       fun merge comp (l1,l2) = 
-	 let 
-	    fun go (nil,l) = l 
-	      | go (l,nil) = l
-	      | go (l1 as (x1::r1),l2 as (x2::r2)) = 
-	       case comp(x1,x2) 
-		 of LESS => x1::go(r1,l2)
-		  | EQUAL => go(l1,r2) 
-		  | GREATER =>  x2::go(l1,r2)
-	 in go(l1,l2)
-	 end
+         let 
+            fun go (nil,l) = l 
+              | go (l,nil) = l
+              | go (l1 as (x1::r1),l2 as (x2::r2)) = 
+               case comp(x1,x2) 
+                 of LESS => x1::go(r1,l2)
+                  | EQUAL => go(l1,r2) 
+                  | GREATER =>  x2::go(l1,r2)
+         in go(l1,l2)
+         end
 
       (*--------------------------------------------------------------------*)
       (* given a comparing function, compute the intersection of two        *)
       (* ordered lists.                                                     *)
       (*--------------------------------------------------------------------*)
       fun cap comp (l1,l2) = 
-	 let 
-	    fun go (nil,l) = nil
-	      | go (l,nil) = nil
-	      | go (l1 as (x1::r1),l2 as (x2::r2)) = 
-	       case comp(x1,x2) 
-		 of LESS => go(r1,l2)
-		  | EQUAL => x1::go(r1,r2)
-		  | GREATER =>  go(l1,r2)
-	 in go(l1,l2)
-	 end
+         let 
+            fun go (nil,l) = nil
+              | go (l,nil) = nil
+              | go (l1 as (x1::r1),l2 as (x2::r2)) = 
+               case comp(x1,x2) 
+                 of LESS => go(r1,l2)
+                  | EQUAL => x1::go(r1,r2)
+                  | GREATER =>  go(l1,r2)
+         in go(l1,l2)
+         end
 
       (*--------------------------------------------------------------------*)
       (* given a comparing function, compute the difference of two          *)
       (* ordered lists.                                                     *)
       (*--------------------------------------------------------------------*)
       fun diff comp (l1,l2) = 
-	 let 
-	    fun go (nil,l) = nil
-	      | go (l,nil) = l
-	      | go (l1 as (x1::r1),l2 as (x2::r2)) = 
-	       case comp(x1,x2) 
-		 of LESS => x1::go(r1,l2)
-		  | EQUAL => go(r1,r2)
-		  | GREATER => go(l1,r2)
-	 in go(l1,l2)
-	 end
+         let 
+            fun go (nil,l) = nil
+              | go (l,nil) = l
+              | go (l1 as (x1::r1),l2 as (x2::r2)) = 
+               case comp(x1,x2) 
+                 of LESS => x1::go(r1,l2)
+                  | EQUAL => go(r1,r2)
+                  | GREATER => go(l1,r2)
+         in go(l1,l2)
+         end
 
       (*--------------------------------------------------------------------*)
       (* given a comparing function, find out whether an ordered list is    *)
       (* contained in an other ordered list.                                *)
       (*--------------------------------------------------------------------*)
       fun sub comp (l1,l2) = 
-	 let 
-	    fun go (nil,l) = true
-	      | go (l,nil) = false
-	      | go (l1 as (x1::r1),l2 as (x2::r2)) = 
-	       case comp(x1,x2) 
-		 of LESS => false
-		  | EQUAL => go(r1,r2)
-		  | GREATER => go(l1,r2)
-	 in go(l1,l2)
-	 end
+         let 
+            fun go (nil,l) = true
+              | go (l,nil) = false
+              | go (l1 as (x1::r1),l2 as (x2::r2)) = 
+               case comp(x1,x2) 
+                 of LESS => false
+                  | EQUAL => go(r1,r2)
+                  | GREATER => go(l1,r2)
+         in go(l1,l2)
+         end
 
       (*--------------------------------------------------------------------*)
       (* given a function that compares elements, insert an element into an *)
       (* ordered list.                                                      *)
       (*--------------------------------------------------------------------*)
       fun insert comp (x,l) = 
-	 let 
-	    fun go nil = [x]
-	      | go (l as y::ys) = 
-	       case comp(x,y) 
-		 of LESS => x::l
-		  | EQUAL => l
-		  | GREATER => y::go ys
-	 in go l
-	 end
+         let 
+            fun go nil = [x]
+              | go (l as y::ys) = 
+               case comp(x,y) 
+                 of LESS => x::l
+                  | EQUAL => l
+                  | GREATER => y::go ys
+         in go l
+         end
 
       (*--------------------------------------------------------------------*)
       (* given a function that compares elements, delete an element from    *)
       (* an ordered list.                                                   *)
       (*--------------------------------------------------------------------*)
       fun delete comp (x,l) = 
-	 let 
-	    fun go nil = [x]
-	      | go (l as y::ys) = 
-	       case comp(x,y) 
-		 of LESS => l
-		  | EQUAL => ys
-		  | GREATER => y::go ys
-	 in go l
-	 end
+         let 
+            fun go nil = [x]
+              | go (l as y::ys) = 
+               case comp(x,y) 
+                 of LESS => l
+                  | EQUAL => ys
+                  | GREATER => y::go ys
+         in go l
+         end
 
       (*--------------------------------------------------------------------*)
       (* given a function that compares elements, insert an element into an *)
       (* ordered list.                                                      *)
       (*--------------------------------------------------------------------*)
       fun elem comp (x,l) = 
-	 let 
-	    fun go nil = false
-	      | go (l as y::ys) = 
-	       case comp(x,y) 
-		 of LESS => false
-		  | EQUAL => true
-		  | GREATER => go ys
-	 in go l
-	 end
+         let 
+            fun go nil = false
+              | go (l as y::ys) = 
+               case comp(x,y) 
+                 of LESS => false
+                  | EQUAL => true
+                  | GREATER => go ys
+         in go l
+         end
 
       (*--------------------------------------------------------------------*)
       (* merge-sort a list of elements comparable with the function in the  *)
       (* 1st argument. Preserve duplicate elements.                         *)
       (*--------------------------------------------------------------------*)
       fun sort _ nil = nil 
-	| sort comp l = 
-	 let fun mergeOne (x::y::l) = merge comp (x,y)::mergeOne l
-	       | mergeOne l = l
-	     fun mergeAll [l] = l
-	       | mergeAll ls = mergeAll (mergeOne ls)
-	     val singles = map (fn x => [x]) l
-	 in 
-	    mergeAll singles
-	 end
+        | sort comp l = 
+         let fun mergeOne (x::y::l) = merge comp (x,y)::mergeOne l
+               | mergeOne l = l
+             fun mergeAll [l] = l
+               | mergeAll ls = mergeAll (mergeOne ls)
+             val singles = map (fn x => [x]) l
+         in 
+            mergeAll singles
+         end
 
    end
 
@@ -3546,10 +3546,10 @@
       val O_DFA_INITIAL_WIDTH  : int ref
       val O_DFA_MAX_STATES     : int ref
       val O_DFA_WARN_TOO_LARGE : bool ref
-			   
+                           
       val setDfaDefaults : unit -> unit
       val setDfaOptions  : Options.Option list * (string -> unit) -> Options.Option list
-			   
+                           
       val dfaUsage : Options.Usage
    end
 
@@ -3562,79 +3562,79 @@
       val O_DFA_WARN_TOO_LARGE = ref true
 
       fun setDfaDefaults() = 
-	 let 
-	    val _ = O_DFA_INITIAL_WIDTH   := 4
-	    val _ = O_DFA_MAX_STATES      := 256
-	    val _ = O_DFA_WARN_TOO_LARGE  := true
-	 in ()
-	 end
+         let 
+            val _ = O_DFA_INITIAL_WIDTH   := 4
+            val _ = O_DFA_MAX_STATES      := 256
+            val _ = O_DFA_WARN_TOO_LARGE  := true
+         in ()
+         end
 
       val dfaUsage = 
-	 [U_ITEM(["--dfa-initial-size=n"],"Initial size of DFA transition tables (16)"),
-   	  U_ITEM(["--dfa-initial-width=n"],"Same as --dfa-initial-size=2^n (4)"),
-	  U_ITEM(["--dfa-max-size=n"],"Maximal size of DFAs for ambiguous content models (256)"),
-	  U_ITEM(["--dfa-warn-size[=(yes|no)]"],"Warn about too large DFAs (yes)")
-	  ]
+         [U_ITEM(["--dfa-initial-size=n"],"Initial size of DFA transition tables (16)"),
+          U_ITEM(["--dfa-initial-width=n"],"Same as --dfa-initial-size=2^n (4)"),
+          U_ITEM(["--dfa-max-size=n"],"Maximal size of DFAs for ambiguous content models (256)"),
+          U_ITEM(["--dfa-warn-size[=(yes|no)]"],"Warn about too large DFAs (yes)")
+          ]
 
       fun setDfaOptions(opts,doError) = 
-	 let 
+         let 
             exception Failed of string option
 
             fun getNat str = 
-	       if str="" then raise Failed NONE
-	       else let val cs = String.explode str
-		    in foldl (fn (c,n) => if #"0">c orelse #"9"<c then raise Failed NONE
-					  else 10*n+ord c-48) 0 cs
-		       handle Overflow => raise Failed
-			  (SOME("number "^str^" is too large for this system"))
-		    end
-		 
-	    val yesNo = "'yes' or 'no'"
-	    fun tooLarge n = String.concat ["number ",n," is too large for this system"]
+               if str="" then raise Failed NONE
+               else let val cs = String.explode str
+                    in foldl (fn (c,n) => if #"0">c orelse #"9"<c then raise Failed NONE
+                                          else 10*n+ord c-48) 0 cs
+                       handle Overflow => raise Failed
+                          (SOME("number "^str^" is too large for this system"))
+                    end
+                 
+            val yesNo = "'yes' or 'no'"
+            fun tooLarge n = String.concat ["number ",n," is too large for this system"]
             fun mustHave key = String.concat ["option --",key," must have an argument"]
-	    fun mustBe key what = String.concat 
-	       ["the argument to option --",key," must be ",what]
+            fun mustBe key what = String.concat 
+               ["the argument to option --",key," must be ",what]
 
-	    fun do_yesno(key,valOpt,flag) =
-	       case valOpt 
-		 of NONE => flag := true
-		  | SOME "yes" => flag := true
-		  | SOME "no" => flag := false
-		  | SOME s => doError (mustBe key yesNo)
+            fun do_yesno(key,valOpt,flag) =
+               case valOpt 
+                 of NONE => flag := true
+                  | SOME "yes" => flag := true
+                  | SOME "no" => flag := false
+                  | SOME s => doError (mustBe key yesNo)
 
-	    fun do_num(key,valOpt,flag) =
-	       case valOpt 
-		 of NONE => doError (mustHave key)
-		  | SOME s => flag := getNat s
-		    handle Failed NONE => doError (mustBe key "a number")
-			 | Failed (SOME s) => doError s
+            fun do_num(key,valOpt,flag) =
+               case valOpt 
+                 of NONE => doError (mustHave key)
+                  | SOME s => flag := getNat s
+                    handle Failed NONE => doError (mustBe key "a number")
+                         | Failed (SOME s) => doError s
 
-	    fun do_dfa_ts(key,valOpt,toWidth) =
-	       case valOpt 
-		 of NONE => doError (mustHave key)
-		  | SOME s => O_DFA_INITIAL_WIDTH := toWidth (getNat s)
-		    handle Failed NONE => doError (mustBe key "a number")
-			 | Failed (SOME s) => doError s
+            fun do_dfa_ts(key,valOpt,toWidth) =
+               case valOpt 
+                 of NONE => doError (mustHave key)
+                  | SOME s => O_DFA_INITIAL_WIDTH := toWidth (getNat s)
+                    handle Failed NONE => doError (mustBe key "a number")
+                         | Failed (SOME s) => doError s
 
-	    fun do_long(key,valOpt) = 
-	       case key
-		 of "dfa-initial-size" => true before do_dfa_ts(key,valOpt,nextPowerTwo)
-		  | "dfa-initial-width" => true before do_dfa_ts(key,valOpt,fn i => i)
-		  | "dfa-max-size" => true before do_num(key,valOpt,O_DFA_MAX_STATES)
-		  | "dfa-warn-size" => true before do_yesno(key,valOpt,O_DFA_WARN_TOO_LARGE)
-		  | _ => false
+            fun do_long(key,valOpt) = 
+               case key
+                 of "dfa-initial-size" => true before do_dfa_ts(key,valOpt,nextPowerTwo)
+                  | "dfa-initial-width" => true before do_dfa_ts(key,valOpt,fn i => i)
+                  | "dfa-max-size" => true before do_num(key,valOpt,O_DFA_MAX_STATES)
+                  | "dfa-warn-size" => true before do_yesno(key,valOpt,O_DFA_WARN_TOO_LARGE)
+                  | _ => false
 
-	    and doit nil = nil
-	      | doit (opt::opts) =
-	       case opt
-		 of OPT_NOOPT => opts
-		  | OPT_LONG(key,value) => if do_long(key,value) then doit opts 
-					   else opt::doit opts
-		  | OPT_NEG _ => opt::doit opts
-		  | OPT_SHORT _ => opt::doit opts
-		  | OPT_STRING _ => opt::doit opts
-	 in doit opts
-	 end
+            and doit nil = nil
+              | doit (opt::opts) =
+               case opt
+                 of OPT_NOOPT => opts
+                  | OPT_LONG(key,value) => if do_long(key,value) then doit opts 
+                                           else opt::doit opts
+                  | OPT_NEG _ => opt::doit opts
+                  | OPT_SHORT _ => opt::doit opts
+                  | OPT_STRING _ => opt::doit opts
+         in doit opts
+         end
    end
 
       
@@ -3688,30 +3688,30 @@
 
       val O_CHECK_VERSION = ref true (* check for conforming xml version?   *)
       val O_CHECK_ISO639 = ref true (* check whether a two-letter LangCode  *)
-	                            (* is acording to ISO 639?              *)
+                                    (* is acording to ISO 639?              *)
       val O_CHECK_LANGID = ref true (* check whether a LangCode fullfills   *)
-	                            (* IETF RFC 1766?                       *)
+                                    (* IETF RFC 1766?                       *)
       val O_CHECK_RESERVED = ref false(* check for names starting with xml? *)
       val O_CHECK_PREDEFINED = ref true (* check declarations of predefined *)
       val O_WARN_MULT_ENUM = ref true  (* check whether a token occurs      *)
-	                               (* twice in the enumerated attribute *)
+                                       (* twice in the enumerated attribute *)
                                        (* types of the same element         *)
       val O_WARN_XML_DECL = ref false (* warn if the XML decl is missing?   *)
 
       val O_WARN_ATT_NO_ELEM   = ref true (* warn for undeclared elements   *)
-	                                  (* in att def list declarations?  *)
+                                          (* in att def list declarations?  *)
 
       val O_WARN_MULT_ENT_DECL  = ref true (* warn about redefined entities *)
       val O_WARN_MULT_NOT_DECL  = ref true (* warn about redefined notations*)
       val O_WARN_SHOULD_DECLARE = ref true (* warn if predefined entities   *)
-	                                   (* are not declared in the dtd   *)
+                                           (* are not declared in the dtd   *)
 
       val O_WARN_MULT_ATT_DEF  = ref true (* warn if an attributes is defd  *)
-	                                  (* twice for the same element?    *) 
+                                          (* twice for the same element?    *) 
       val O_WARN_MULT_ATT_DECL = ref true (* warn if there are multiple att *)
-	                                  (* def lists for one element?     *)
+                                          (* def lists for one element?     *)
       val O_WARN_NON_ASCII_URI = ref true (* warn about non-ascii chars in  *)
-	                                  (* system identifiers?            *)
+                                          (* system identifiers?            *)
 
       val O_ERROR_MINIMIZE  = ref true (* try to avoid repeating errors?    *)
 
@@ -3723,216 +3723,216 @@
       val O_INCLUDE_PARAM_ENTS = ref false
 
       fun setParserDefaults() = 
-	 let 
-	    val _ = setDfaDefaults()
+         let 
+            val _ = setDfaDefaults()
 
-	    val _ = O_CHECK_ISO639        := false
-	    val _ = O_CHECK_LANGID        := false
-	    val _ = O_CHECK_PREDEFINED    := true
-	    val _ = O_CHECK_RESERVED      := false
-	    val _ = O_CHECK_VERSION       := true
-	    
-	    val _ = O_WARN_MULT_ENUM      := true
-	    val _ = O_WARN_XML_DECL       := false
-	    val _ = O_WARN_ATT_NO_ELEM    := false
-	    val _ = O_WARN_MULT_ENT_DECL  := false
-	    val _ = O_WARN_MULT_NOT_DECL  := false
-	    val _ = O_WARN_MULT_ATT_DEF   := false
-	    val _ = O_WARN_MULT_ATT_DECL  := false
-	    val _ = O_WARN_SHOULD_DECLARE := true
-	    val _ = O_WARN_NON_ASCII_URI  := true
+            val _ = O_CHECK_ISO639        := false
+            val _ = O_CHECK_LANGID        := false
+            val _ = O_CHECK_PREDEFINED    := true
+            val _ = O_CHECK_RESERVED      := false
+            val _ = O_CHECK_VERSION       := true
+            
+            val _ = O_WARN_MULT_ENUM      := true
+            val _ = O_WARN_XML_DECL       := false
+            val _ = O_WARN_ATT_NO_ELEM    := false
+            val _ = O_WARN_MULT_ENT_DECL  := false
+            val _ = O_WARN_MULT_NOT_DECL  := false
+            val _ = O_WARN_MULT_ATT_DEF   := false
+            val _ = O_WARN_MULT_ATT_DECL  := false
+            val _ = O_WARN_SHOULD_DECLARE := true
+            val _ = O_WARN_NON_ASCII_URI  := true
 
-	    val _ = O_VALIDATE            := true
-	    val _ = O_COMPATIBILITY       := true
-	    val _ = O_INTEROPERABILITY    := false
-	    
-	    val _ = O_ERROR_MINIMIZE      := true
+            val _ = O_VALIDATE            := true
+            val _ = O_COMPATIBILITY       := true
+            val _ = O_INTEROPERABILITY    := false
+            
+            val _ = O_ERROR_MINIMIZE      := true
 
-	    val _ = O_INCLUDE_EXT_PARSED  := false
+            val _ = O_INCLUDE_EXT_PARSED  := false
             val _ = O_INCLUDE_PARAM_ENTS  := false
-	 in ()
-	 end
+         in ()
+         end
 
       val parserUsage = 
-	 [U_ITEM(["-[n]v","--validate[=(yes|no)]"],"Turn on or off validation (yes)"),
-	  U_ITEM(["-[n]c","--compat[=(yes|no)]","--compatibility[=(yes|no)]"],
+         [U_ITEM(["-[n]v","--validate[=(yes|no)]"],"Turn on or off validation (yes)"),
+          U_ITEM(["-[n]c","--compat[=(yes|no)]","--compatibility[=(yes|no)]"],
                  "Turn on or off compatibility checking (yes)"),
-	  U_ITEM(["-[n]i","--interop[=(yes|no)]","--interoperability[=(yes|no)]"],
+          U_ITEM(["-[n]i","--interop[=(yes|no)]","--interoperability[=(yes|no)]"],
                  "Turn on or off interoperability checking (no)"),
           U_SEP,
-	  U_ITEM(["--few-errors[=(yes|no)]"],"Report fewer errors (no)"),
-	  U_ITEM(["--check-reserved[=(yes|no)]"],
+          U_ITEM(["--few-errors[=(yes|no)]"],"Report fewer errors (no)"),
+          U_ITEM(["--check-reserved[=(yes|no)]"],
                  "Checking for reserved names (no)"),
-	  U_ITEM(["--check-predef[=(yes|no)]","--check-predefined[=(yes|no)]"],
+          U_ITEM(["--check-predef[=(yes|no)]","--check-predefined[=(yes|no)]"],
                  "Check declaration of predefined entities (yes)"),
-	  U_ITEM(["--check-lang-id[=(yes|no)]"],"Checking language identifiers (no)"),
-	  U_ITEM(["--check-iso639[=(yes|no)]"],"Check ISO 639 language codes (no)"),
-	  U_ITEM(["--check-xml-version[=(yes|no)]"], "Check XML version number (yes)"),
+          U_ITEM(["--check-lang-id[=(yes|no)]"],"Checking language identifiers (no)"),
+          U_ITEM(["--check-iso639[=(yes|no)]"],"Check ISO 639 language codes (no)"),
+          U_ITEM(["--check-xml-version[=(yes|no)]"], "Check XML version number (yes)"),
           U_SEP,
-	  U_ITEM(["--warn-xml-decl[=(yes|no)]"],"Warn if there is no XML declaration (no)"),
-	  U_ITEM(["--warn-att-elem[=(yes|no)]"],
+          U_ITEM(["--warn-xml-decl[=(yes|no)]"],"Warn if there is no XML declaration (no)"),
+          U_ITEM(["--warn-att-elem[=(yes|no)]"],
                  "Warn about attlist declarations for undeclared elements (no)"),
-	  U_ITEM(["--warn-predefined[=(yes|no)]"],
+          U_ITEM(["--warn-predefined[=(yes|no)]"],
                  "Warn if the predefined entities are not declared (no)"),
-	  U_ITEM(["--warn-mult-decl[=<arg>]"],"Warn about multiple declarations (none)"),
+          U_ITEM(["--warn-mult-decl[=<arg>]"],"Warn about multiple declarations (none)"),
           U_ITEM(["--warn-uri[=(yes|no)]"],"Warn about non-ASCII characters in URIs (yes)"),
           U_ITEM(["--warn[=all]"],"Warn about nearly everything"),
           U_ITEM(["--warn=none"],"Do not print warnings"),
-	  U_SEP,
-	  U_ITEM(["--include-ext[=(yes|no)]","--include-external[=(yes|no)]"],
+          U_SEP,
+          U_ITEM(["--include-ext[=(yes|no)]","--include-external[=(yes|no)]"],
                  "Include external entities in non-validating mode (no)"),
-	  U_ITEM(["--include-par[=(yes|no)]","--include-parameter[=(yes|no)]"],
+          U_ITEM(["--include-par[=(yes|no)]","--include-parameter[=(yes|no)]"],
                  "Include parameter entities and external subset in "^
                  "non-validating mode (no)"),
-	  U_SEP]
-	 @dfaUsage
+          U_SEP]
+         @dfaUsage
 
       fun setParserOptions(opts,doError) = 
-	 let 
-	    datatype What = ATT | ATTLIST | ENT | NOT 
-	       
-	    exception Failed of string option
+         let 
+            datatype What = ATT | ATTLIST | ENT | NOT 
+               
+            exception Failed of string option
 
-	    fun getNat str = 
-	       if str="" then raise Failed NONE
-	       else let val cs = String.explode str
-		    in foldl (fn (c,n) => if #"0">c orelse #"9"<c then raise Failed NONE
-					  else 10*n+ord c-48) 0 cs
-		       handle Overflow => raise Failed
-			  (SOME("number "^str^" is too large for this system"))
-		    end
-		 
-	    val allNone = "'all' or 'none'"
-	    val yesNo = "'yes' or 'no'"
-	    val yesNoWhat = "'yes', 'no' or a list of 'att', 'attlist', 'ent' and 'not'"
-	    fun errorMustBe(key,what) = doError
-	       (String.concat ["the argument to option --",key," must be ",what])
-	    fun errorNoArg key = doError
-	       (String.concat ["option --",key," has no argument"])
-	       
-	    fun do_mult_decl(key,valOpt) =
-	       let 
-		  val all = [ATT,ATTLIST,ENT,NOT]
-		  fun setFlags whats = app (fn (what,flag) => flag := member what whats)
-		     [(ATT,O_WARN_MULT_ATT_DEF),(ATTLIST,O_WARN_MULT_ATT_DECL),
-		      (ENT,O_WARN_MULT_ENT_DECL),(NOT,O_WARN_MULT_NOT_DECL)]
-	       in case valOpt 
-		    of NONE => setFlags all
-		     | SOME "yes" => setFlags all
-		     | SOME "no" => setFlags nil
-		     | SOME s => let val fields = String.fields (fn c => #","=c) s
-				     val whats = map 
-					(fn s => case s
-						   of "att" => ATT
-						    | "attlist" => ATTLIST
-						    | "ent" => ENT
-						    | "not" => NOT
-						    | _ => raise Failed NONE) fields
-				 in setFlags whats
-				 end
-			      handle Failed _ => errorMustBe(key,yesNoWhat)
-	       end
+            fun getNat str = 
+               if str="" then raise Failed NONE
+               else let val cs = String.explode str
+                    in foldl (fn (c,n) => if #"0">c orelse #"9"<c then raise Failed NONE
+                                          else 10*n+ord c-48) 0 cs
+                       handle Overflow => raise Failed
+                          (SOME("number "^str^" is too large for this system"))
+                    end
+                 
+            val allNone = "'all' or 'none'"
+            val yesNo = "'yes' or 'no'"
+            val yesNoWhat = "'yes', 'no' or a list of 'att', 'attlist', 'ent' and 'not'"
+            fun errorMustBe(key,what) = doError
+               (String.concat ["the argument to option --",key," must be ",what])
+            fun errorNoArg key = doError
+               (String.concat ["option --",key," has no argument"])
+               
+            fun do_mult_decl(key,valOpt) =
+               let 
+                  val all = [ATT,ATTLIST,ENT,NOT]
+                  fun setFlags whats = app (fn (what,flag) => flag := member what whats)
+                     [(ATT,O_WARN_MULT_ATT_DEF),(ATTLIST,O_WARN_MULT_ATT_DECL),
+                      (ENT,O_WARN_MULT_ENT_DECL),(NOT,O_WARN_MULT_NOT_DECL)]
+               in case valOpt 
+                    of NONE => setFlags all
+                     | SOME "yes" => setFlags all
+                     | SOME "no" => setFlags nil
+                     | SOME s => let val fields = String.fields (fn c => #","=c) s
+                                     val whats = map 
+                                        (fn s => case s
+                                                   of "att" => ATT
+                                                    | "attlist" => ATTLIST
+                                                    | "ent" => ENT
+                                                    | "not" => NOT
+                                                    | _ => raise Failed NONE) fields
+                                 in setFlags whats
+                                 end
+                              handle Failed _ => errorMustBe(key,yesNoWhat)
+               end
 
-	    fun do_noarg(key,valOpt,flag) = 
-	       case valOpt 
-		 of NONE => flag := true
-		  | SOME _ => errorNoArg key
+            fun do_noarg(key,valOpt,flag) = 
+               case valOpt 
+                 of NONE => flag := true
+                  | SOME _ => errorNoArg key
 
-	    fun do_yesno(key,valOpt,flag) =
-	       case valOpt 
-		 of NONE => flag := true
-		  | SOME "yes" => flag := true
-		  | SOME "no" => flag := false
-		  | SOME s => errorMustBe(key,yesNo)
+            fun do_yesno(key,valOpt,flag) =
+               case valOpt 
+                 of NONE => flag := true
+                  | SOME "yes" => flag := true
+                  | SOME "no" => flag := false
+                  | SOME s => errorMustBe(key,yesNo)
 
-	    fun do_num(key,valOpt,flag) =
-	       case valOpt 
-		 of NONE => errorMustBe(key,"a number")
-		  | SOME s => flag := getNat s
-		    handle Failed NONE => errorMustBe(key,"a number")
-			 | Failed (SOME s) => doError s
+            fun do_num(key,valOpt,flag) =
+               case valOpt 
+                 of NONE => errorMustBe(key,"a number")
+                  | SOME s => flag := getNat s
+                    handle Failed NONE => errorMustBe(key,"a number")
+                         | Failed (SOME s) => doError s
 
-	    fun do_warn(key,valOpt) =
-	       let val all = [O_WARN_MULT_ENUM,O_WARN_ATT_NO_ELEM,   
-			      O_WARN_MULT_ENT_DECL,O_WARN_MULT_NOT_DECL,O_WARN_MULT_ATT_DEF,
-			      O_WARN_MULT_ATT_DECL,O_WARN_SHOULD_DECLARE,O_WARN_XML_DECL]
-		  fun setFlags value = app (fn flag => flag := value) all
-	       in case valOpt
-		    of NONE => setFlags true
-		     | SOME "all" => setFlags true
-		     | SOME "none" => setFlags false
-		     | SOME _ => errorMustBe(key,allNone)
-	       end
+            fun do_warn(key,valOpt) =
+               let val all = [O_WARN_MULT_ENUM,O_WARN_ATT_NO_ELEM,   
+                              O_WARN_MULT_ENT_DECL,O_WARN_MULT_NOT_DECL,O_WARN_MULT_ATT_DEF,
+                              O_WARN_MULT_ATT_DECL,O_WARN_SHOULD_DECLARE,O_WARN_XML_DECL]
+                  fun setFlags value = app (fn flag => flag := value) all
+               in case valOpt
+                    of NONE => setFlags true
+                     | SOME "all" => setFlags true
+                     | SOME "none" => setFlags false
+                     | SOME _ => errorMustBe(key,allNone)
+               end
 
-	    fun do_long(key,valOpt) = 
-	       case key
-		 of "validate" => true before do_yesno(key,valOpt,O_VALIDATE)
-		  | "compat" => true before do_yesno(key,valOpt,O_COMPATIBILITY)
-		  | "compatibility" => true before do_yesno(key,valOpt,O_COMPATIBILITY)
-		  | "interop" => true before do_yesno(key,valOpt,O_INTEROPERABILITY)
-		  | "interoperability" => true before do_yesno(key,valOpt,O_INTEROPERABILITY)
+            fun do_long(key,valOpt) = 
+               case key
+                 of "validate" => true before do_yesno(key,valOpt,O_VALIDATE)
+                  | "compat" => true before do_yesno(key,valOpt,O_COMPATIBILITY)
+                  | "compatibility" => true before do_yesno(key,valOpt,O_COMPATIBILITY)
+                  | "interop" => true before do_yesno(key,valOpt,O_INTEROPERABILITY)
+                  | "interoperability" => true before do_yesno(key,valOpt,O_INTEROPERABILITY)
 
-		  | "few-errors" => true before do_yesno(key,valOpt,O_ERROR_MINIMIZE)
-		    
-		  | "check-reserved" => true before do_yesno(key,valOpt,O_CHECK_RESERVED)
-		  | "check-predef" => true before do_yesno(key,valOpt,O_CHECK_PREDEFINED)
-		  | "check-predefined" => true before do_yesno(key,valOpt,O_CHECK_PREDEFINED)
-		  | "check-lang-id" => true before do_yesno(key,valOpt,O_CHECK_LANGID)
-		  | "check-iso639" => true before do_yesno(key,valOpt,O_CHECK_ISO639)
-		  | "check-xml-version" => true before do_yesno(key,valOpt,O_CHECK_VERSION)
-		    
-		  | "warn" => true before do_warn(key,valOpt)
-		  | "warn-xml-decl" => true before do_yesno(key,valOpt,O_WARN_XML_DECL)
-		  | "warn-att-elem" => true before do_yesno(key,valOpt,O_WARN_ATT_NO_ELEM)
-		  | "warn-predefined" => true before do_yesno(key,valOpt,O_WARN_SHOULD_DECLARE)
-		  | "warn-mult-decl" => true before do_mult_decl(key,valOpt)
-		  | "warn-uri" => true before do_yesno(key,valOpt,O_WARN_NON_ASCII_URI)
-		    
-		  | "include-ext" => true before do_yesno(key,valOpt,O_INCLUDE_EXT_PARSED)
-		  | "include-external" => true before do_yesno(key,valOpt,O_INCLUDE_EXT_PARSED)
-		  | "include-par" => true before do_yesno(key,valOpt,O_INCLUDE_PARAM_ENTS)
-		  | "include-parameter" => true before do_yesno(key,valOpt,O_INCLUDE_PARAM_ENTS)
-		    
-		  | _ => false
+                  | "few-errors" => true before do_yesno(key,valOpt,O_ERROR_MINIMIZE)
+                    
+                  | "check-reserved" => true before do_yesno(key,valOpt,O_CHECK_RESERVED)
+                  | "check-predef" => true before do_yesno(key,valOpt,O_CHECK_PREDEFINED)
+                  | "check-predefined" => true before do_yesno(key,valOpt,O_CHECK_PREDEFINED)
+                  | "check-lang-id" => true before do_yesno(key,valOpt,O_CHECK_LANGID)
+                  | "check-iso639" => true before do_yesno(key,valOpt,O_CHECK_ISO639)
+                  | "check-xml-version" => true before do_yesno(key,valOpt,O_CHECK_VERSION)
+                    
+                  | "warn" => true before do_warn(key,valOpt)
+                  | "warn-xml-decl" => true before do_yesno(key,valOpt,O_WARN_XML_DECL)
+                  | "warn-att-elem" => true before do_yesno(key,valOpt,O_WARN_ATT_NO_ELEM)
+                  | "warn-predefined" => true before do_yesno(key,valOpt,O_WARN_SHOULD_DECLARE)
+                  | "warn-mult-decl" => true before do_mult_decl(key,valOpt)
+                  | "warn-uri" => true before do_yesno(key,valOpt,O_WARN_NON_ASCII_URI)
+                    
+                  | "include-ext" => true before do_yesno(key,valOpt,O_INCLUDE_EXT_PARSED)
+                  | "include-external" => true before do_yesno(key,valOpt,O_INCLUDE_EXT_PARSED)
+                  | "include-par" => true before do_yesno(key,valOpt,O_INCLUDE_PARAM_ENTS)
+                  | "include-parameter" => true before do_yesno(key,valOpt,O_INCLUDE_PARAM_ENTS)
+                    
+                  | _ => false
 
-	    fun do_short cs = 
-	       let fun doOne c = 
-		  case c
-		    of #"v" => false before O_VALIDATE := true
-		     | #"c" => false before O_COMPATIBILITY := true
-		     | #"i" => false before O_INTEROPERABILITY := true
-		     | _ => true
-	       in List.filter doOne cs
-	       end 
+            fun do_short cs = 
+               let fun doOne c = 
+                  case c
+                    of #"v" => false before O_VALIDATE := true
+                     | #"c" => false before O_COMPATIBILITY := true
+                     | #"i" => false before O_INTEROPERABILITY := true
+                     | _ => true
+               in List.filter doOne cs
+               end 
 
-	    fun do_neg cs = 
-	       let fun doOne c = 
-		  case c
-		    of #"v" => false before O_VALIDATE := false
-		     | #"c" => false before O_COMPATIBILITY := false
-		     | #"i" => false before O_INTEROPERABILITY := false
-		     | _ => true
-	       in List.filter doOne cs
-	       end 
+            fun do_neg cs = 
+               let fun doOne c = 
+                  case c
+                    of #"v" => false before O_VALIDATE := false
+                     | #"c" => false before O_COMPATIBILITY := false
+                     | #"i" => false before O_INTEROPERABILITY := false
+                     | _ => true
+               in List.filter doOne cs
+               end 
 
-	    and doit nil = nil
-	      | doit (opt::opts) =
-	       case opt
-		 of OPT_NOOPT => opts
-		  | OPT_LONG(key,value) => if do_long(key,value) then doit opts 
-					   else opt::doit opts
-		  | OPT_SHORT cs => (case do_short cs
-				       of nil => doit opts
-					| rest => OPT_SHORT rest::doit opts)
-		  | OPT_NEG cs => (case do_neg cs
-				       of nil => doit opts
-					| rest => OPT_NEG rest::doit opts)
-		  | OPT_STRING s => opt::doit opts
-	 
-	    val opts1 = setDfaOptions (opts,doError)
-	 in 
-	    doit opts1
-	 end
+            and doit nil = nil
+              | doit (opt::opts) =
+               case opt
+                 of OPT_NOOPT => opts
+                  | OPT_LONG(key,value) => if do_long(key,value) then doit opts 
+                                           else opt::doit opts
+                  | OPT_SHORT cs => (case do_short cs
+                                       of nil => doit opts
+                                        | rest => OPT_SHORT rest::doit opts)
+                  | OPT_NEG cs => (case do_neg cs
+                                       of nil => doit opts
+                                        | rest => OPT_NEG rest::doit opts)
+                  | OPT_STRING s => opt::doit opts
+         
+            val opts1 = setDfaOptions (opts,doError)
+         in 
+            doit opts1
+         end
    end
 (* stop of ../../Parser/Params/parserOptions.sml *)
 (* start of ../../Util/intLists.sml *)
@@ -3984,7 +3984,7 @@
       val hashIntList = hashList hashInt
 
       val IntList2String = List2String Int.toString 
-   end			      
+   end                        
 (* stop of ../../Util/intLists.sml *)
 (* start of ../../Unicode/Chars/dataDict.sml *)
 
@@ -4029,7 +4029,7 @@
       type Dfa
 
       datatype ContentModel =
-	 CM_ELEM of int
+         CM_ELEM of int
        | CM_OPT of ContentModel
        | CM_REP of ContentModel
        | CM_PLUS of ContentModel
@@ -4041,7 +4041,7 @@
    struct
       (*--- visible to the parser ---*)
       datatype ContentModel =
-	 CM_ELEM of int
+         CM_ELEM of int
        | CM_OPT of ContentModel
        | CM_REP of ContentModel
        | CM_PLUS of ContentModel
@@ -4063,11 +4063,11 @@
       type Empty  = bool
       type First  = (State * Sigma) list
       type Follow = First 
-	 
+         
       type Info = State * Empty * First
 
       datatype CM' =
-	 ELEM of Sigma
+         ELEM of Sigma
        | OPT of CM
        | REP of CM
        | PLUS of CM
@@ -4077,7 +4077,7 @@
 
       type Row = Sigma * Sigma * State vector * bool
       val nullRow : Row = (1,0,Vector.fromList nil,false)
-	 
+         
       type Dfa = Row vector
 
       val emptyDfa : Dfa = Vector.fromList [(1,0,Vector.fromList nil,true)] 
@@ -4122,14 +4122,14 @@
 structure DecodeFile : DecodeFile =
    struct
       open
-	 UniChar Uri UtilError 
-	 
+         UniChar Uri UtilError 
+         
       structure Bytes = Word8
       type Byte = Bytes.word
 
       fun Byte2Char b = Chars.fromLargeWord(Bytes.toLargeWord b)
       fun Byte2Hex b = 
-	 "0x"^UtilString.toUpperString(StringCvt.padLeft #"0" 2 (Bytes.toString b))
+         "0x"^UtilString.toUpperString(StringCvt.padLeft #"0" 2 (Bytes.toString b))
       fun Char2Byte c = Bytes.fromLargeWord(Chars.toLargeWord c)
 
       type instream = TextIO.instream 
@@ -4156,72 +4156,72 @@
       (* return the uri of a file.                                          *)
       (*--------------------------------------------------------------------*)
       fun fileUri ((typ,_,_),_,_,_) =
-	 case typ 
-	   of STD => emptyUri
-	    | FNAME(uri,_,_,_) => uri
+         case typ 
+           of STD => emptyUri
+            | FNAME(uri,_,_,_) => uri
       (*--------------------------------------------------------------------*)
       (* return the uri string name of a file.                              *)
       (*--------------------------------------------------------------------*)
       fun fileName ((typ,_,_),_,_,_) =
-	 case typ 
-	   of STD => "<stdin>"
-	    | FNAME(_,str,_,_) => str
+         case typ 
+           of STD => "<stdin>"
+            | FNAME(_,str,_,_) => str
       (*--------------------------------------------------------------------*)
       (* return the uri string and the position in the the file.            *)
       (*--------------------------------------------------------------------*)
       fun filePos ((typ,_,p),_,s,i) =
-	 case typ 
-	   of STD => ("<stdin>",p+i-s)
-	    | FNAME(_,str,_,_) => (str,p+i-s)
+         case typ 
+           of STD => ("<stdin>",p+i-s)
+            | FNAME(_,str,_,_) => (str,p+i-s)
 
       (*--------------------------------------------------------------------*)
       (* open a file; report IO errors by raising NoSuchFile.               *)
       (*--------------------------------------------------------------------*)
       fun openFile uriOpt = 
-	 let val (typ,stream) = 
-	    case uriOpt 
-	      of NONE => (STD,stdIn)
-	       | SOME uri => let val (str,fname,tmp) = retrieveUri uri
-			     in (FNAME(uri,str,fname,tmp),openIn fname)
-			     end
-			  handle IO.Io {name,cause,...} 
-			  => raise NoSuchFile(name,exnMessage cause)
-	 in ((typ,stream,0),nullVec,0,0)
-	 end
+         let val (typ,stream) = 
+            case uriOpt 
+              of NONE => (STD,stdIn)
+               | SOME uri => let val (str,fname,tmp) = retrieveUri uri
+                             in (FNAME(uri,str,fname,tmp),openIn fname)
+                             end
+                          handle IO.Io {name,cause,...} 
+                          => raise NoSuchFile(name,exnMessage cause)
+         in ((typ,stream,0),nullVec,0,0)
+         end
 
       (*--------------------------------------------------------------------*)
       (* close the file; ignore IO errors.                                  *)
       (*--------------------------------------------------------------------*)
       fun closeStream (typ,stream,_) =
-	 case typ
-	   of STD => ()
-	    | FNAME(_,uri,fname,tmp) 
-	      => let val _ = closeIn stream handle IO.Io _ => ()
-		     val _ = (if tmp andalso OS.FileSys.access(fname,nil) 
-				 then OS.FileSys.remove fname else ())
-			handle exn as OS.SysErr _ =>
-			   TextIO.output(TextIO.stdErr,String.concat
-					 ["Error removing temporary file ",fname,"for URI",uri,
-					  "(",exnMessage exn,")\n"])
-			     
-		 in ()
-		 end
+         case typ
+           of STD => ()
+            | FNAME(_,uri,fname,tmp) 
+              => let val _ = closeIn stream handle IO.Io _ => ()
+                     val _ = (if tmp andalso OS.FileSys.access(fname,nil) 
+                                 then OS.FileSys.remove fname else ())
+                        handle exn as OS.SysErr _ =>
+                           TextIO.output(TextIO.stdErr,String.concat
+                                         ["Error removing temporary file ",fname,"for URI",uri,
+                                          "(",exnMessage exn,")\n"])
+                             
+                 in ()
+                 end
       fun closeFile (tsp,_,_,_) = closeStream tsp
-					 
+                                         
       (*--------------------------------------------------------------------*)
       (* read a byte from the file; if at the end of buffer, reload it.     *)
       (* if a reload fails or returns an IO error, raise EndOfFile. --------*)
       (*--------------------------------------------------------------------*)
       fun getByte (tsp,vec,s,i) =
-	 if i<s then (Word8Vector.sub(vec,i),(tsp,vec,s,i+1))
-	 else let val (typ,stream,pos) = tsp
-		  val v = Byte.stringToBytes (input stream) handle IO.Io _ => nullVec
-		  val s = Word8Vector.length v
-	      in if s=0 then let val _ = closeStream tsp
-			     in raise EndOfFile(tsp,v,0,0)
-			     end
-		 else (Word8Vector.sub(v,0),((typ,stream,pos+s),v,s,1))
-	      end
+         if i<s then (Word8Vector.sub(vec,i),(tsp,vec,s,i+1))
+         else let val (typ,stream,pos) = tsp
+                  val v = Byte.stringToBytes (input stream) handle IO.Io _ => nullVec
+                  val s = Word8Vector.length v
+              in if s=0 then let val _ = closeStream tsp
+                             in raise EndOfFile(tsp,v,0,0)
+                             end
+                 else (Word8Vector.sub(v,0),((typ,stream,pos+s),v,s,1))
+              end
 
       (*--------------------------------------------------------------------*)
       (* un-get some bytes. this should only happen while checking for a    *)
@@ -4229,13 +4229,13 @@
       (* that case, otherwise might be very space-consuming.                *)
       (*--------------------------------------------------------------------*)
       fun ungetBytes ((tsp,vec,s,i),bs) =
-	 let val len = length bs
-	 in if len<=i then (tsp,vec,s,i-len)
-	    else let val diff = len-i
-		     val vec0 = Word8Vector.fromList(List.take(bs,diff))
-		 in (tsp,Word8Vector.concat [vec0,vec],s+diff,0)
-		 end
-	 end
+         let val len = length bs
+         in if len<=i then (tsp,vec,s,i-len)
+            else let val diff = len-i
+                     val vec0 = Word8Vector.fromList(List.take(bs,diff))
+                 in (tsp,Word8Vector.concat [vec0,vec],s+diff,0)
+                 end
+         end
    end
 (* stop of ../../Unicode/Decode/decodeFile.sml *)
 (* start of ../../Unicode/Decode/decodeError.sml *)
@@ -4253,24 +4253,24 @@
 signature DecodeError = 
    sig
       datatype DecodeError =
-	  ERR_ILLEGAL_CHAR of DecodeFile.Byte * string
-	| ERR_NON_UNI_UCS4 of UniChar.Char
-	| ERR_EOF_UCS4 of int * DecodeFile.Byte list
-	| ERR_NON_DIRECT_UTF7 of DecodeFile.Byte
-	| ERR_PADDING_UTF7 of UniChar.Char
-	| ERR_ILLFORMED_UTF8 of DecodeFile.Byte * int * int
-	| ERR_ILLEGAL_UTF8 of DecodeFile.Byte
-	| ERR_INVALID_UTF8_SEQ of DecodeFile.Byte list
-	| ERR_EOF_UTF8 of int * int
-	| ERR_NON_UNI_UTF8 of UniChar.Char * int
-	| ERR_EOF_UCS2 of DecodeFile.Byte
-	| ERR_EOF_UTF16 of DecodeFile.Byte
-	| ERR_LOW_SURROGATE of UniChar.Char
-	| ERR_HIGH_SURROGATE of UniChar.Char * UniChar.Char
-	| ERR_EOF_SURROGATE of UniChar.Char
-	| ERR_NO_ENC_DECL of string
-	| ERR_UNSUPPORTED_ENC of string
-	| ERR_INCOMPATIBLE_ENC of string * string
+          ERR_ILLEGAL_CHAR of DecodeFile.Byte * string
+        | ERR_NON_UNI_UCS4 of UniChar.Char
+        | ERR_EOF_UCS4 of int * DecodeFile.Byte list
+        | ERR_NON_DIRECT_UTF7 of DecodeFile.Byte
+        | ERR_PADDING_UTF7 of UniChar.Char
+        | ERR_ILLFORMED_UTF8 of DecodeFile.Byte * int * int
+        | ERR_ILLEGAL_UTF8 of DecodeFile.Byte
+        | ERR_INVALID_UTF8_SEQ of DecodeFile.Byte list
+        | ERR_EOF_UTF8 of int * int
+        | ERR_NON_UNI_UTF8 of UniChar.Char * int
+        | ERR_EOF_UCS2 of DecodeFile.Byte
+        | ERR_EOF_UTF16 of DecodeFile.Byte
+        | ERR_LOW_SURROGATE of UniChar.Char
+        | ERR_HIGH_SURROGATE of UniChar.Char * UniChar.Char
+        | ERR_EOF_SURROGATE of UniChar.Char
+        | ERR_NO_ENC_DECL of string
+        | ERR_UNSUPPORTED_ENC of string
+        | ERR_INCOMPATIBLE_ENC of string * string
 
       val decodeMessage : DecodeError -> string list
 
@@ -4280,78 +4280,78 @@
 structure DecodeError : DecodeError =
    struct
       open 
-	 DecodeFile UtilString UniChar 
+         DecodeFile UtilString UniChar 
 
       datatype DecodeError =
-	  ERR_ILLEGAL_CHAR of DecodeFile.Byte * string
-	| ERR_NON_UNI_UCS4 of UniChar.Char
-	| ERR_EOF_UCS4 of int * DecodeFile.Byte list
-	| ERR_NON_DIRECT_UTF7 of DecodeFile.Byte
-	| ERR_PADDING_UTF7 of UniChar.Char
-	| ERR_ILLFORMED_UTF8 of DecodeFile.Byte * int * int
-	| ERR_ILLEGAL_UTF8 of DecodeFile.Byte
-	| ERR_INVALID_UTF8_SEQ of DecodeFile.Byte list
-	| ERR_EOF_UTF8 of int * int
-	| ERR_NON_UNI_UTF8 of UniChar.Char * int
-	| ERR_EOF_UCS2 of DecodeFile.Byte
-	| ERR_EOF_UTF16 of DecodeFile.Byte
-	| ERR_LOW_SURROGATE of UniChar.Char
-	| ERR_HIGH_SURROGATE of UniChar.Char * UniChar.Char
-	| ERR_EOF_SURROGATE of UniChar.Char
-	| ERR_NO_ENC_DECL of string
-	| ERR_UNSUPPORTED_ENC of string
-	| ERR_INCOMPATIBLE_ENC of string * string
+          ERR_ILLEGAL_CHAR of DecodeFile.Byte * string
+        | ERR_NON_UNI_UCS4 of UniChar.Char
+        | ERR_EOF_UCS4 of int * DecodeFile.Byte list
+        | ERR_NON_DIRECT_UTF7 of DecodeFile.Byte
+        | ERR_PADDING_UTF7 of UniChar.Char
+        | ERR_ILLFORMED_UTF8 of DecodeFile.Byte * int * int
+        | ERR_ILLEGAL_UTF8 of DecodeFile.Byte
+        | ERR_INVALID_UTF8_SEQ of DecodeFile.Byte list
+        | ERR_EOF_UTF8 of int * int
+        | ERR_NON_UNI_UTF8 of UniChar.Char * int
+        | ERR_EOF_UCS2 of DecodeFile.Byte
+        | ERR_EOF_UTF16 of DecodeFile.Byte
+        | ERR_LOW_SURROGATE of UniChar.Char
+        | ERR_HIGH_SURROGATE of UniChar.Char * UniChar.Char
+        | ERR_EOF_SURROGATE of UniChar.Char
+        | ERR_NO_ENC_DECL of string
+        | ERR_UNSUPPORTED_ENC of string
+        | ERR_INCOMPATIBLE_ENC of string * string
 
       fun Char2Hex c = "0x"^UtilString.toUpperString(StringCvt.padLeft #"0" 4 (Chars.toString c))
-	  
+          
       fun decodeMessage err = 
-	 case err
-	   of ERR_ILLEGAL_CHAR(b,what) => 
-	      [Byte2Hex b,"is not",prependAnA what,"character"]
+         case err
+           of ERR_ILLEGAL_CHAR(b,what) => 
+              [Byte2Hex b,"is not",prependAnA what,"character"]
 
-	    | ERR_NON_UNI_UCS4 c => 
-	      ["UCS-4 coded non-Unicode character",Char2Uni c]
-	    | ERR_EOF_UCS4(pos,bytes) => 
-	      ["End of file after",Int2String pos,"bytes of UCS-4 character",
-	       "starting with ",List2String0 Byte2Hex bytes]
-	   
-	    | ERR_NON_DIRECT_UTF7 b => 
-	      ["Indirect UTF-7 character ",Byte2Hex b,"in non-shifted mode"]
-	    | ERR_PADDING_UTF7 pad => 
-	      ["Non-zero padding",Char2Hex pad,"at end of UTF-7 shifted sequence"]
+            | ERR_NON_UNI_UCS4 c => 
+              ["UCS-4 coded non-Unicode character",Char2Uni c]
+            | ERR_EOF_UCS4(pos,bytes) => 
+              ["End of file after",Int2String pos,"bytes of UCS-4 character",
+               "starting with ",List2String0 Byte2Hex bytes]
+           
+            | ERR_NON_DIRECT_UTF7 b => 
+              ["Indirect UTF-7 character ",Byte2Hex b,"in non-shifted mode"]
+            | ERR_PADDING_UTF7 pad => 
+              ["Non-zero padding",Char2Hex pad,"at end of UTF-7 shifted sequence"]
 
-	    | ERR_ILLFORMED_UTF8 (b,len,pos) => 
-	      [numberNth pos,"byte",Byte2Hex b,"of a",Int2String len^"-byte", 
-	       "UTF-8 sequence does not start with bits 10"] 
-	    | ERR_ILLEGAL_UTF8 b => 
-	      ["Byte",Byte2Hex b,"is neither ASCII nor does it start",
-	       "a valid multi-byte UTF-8 sequence"]
-	    | ERR_EOF_UTF8 (len,pos) => 
-	      ["End of file terminates a ",Int2String len^"-byte",
-	       "UTF-8 sequence before the ",numberNth pos,"byte"]
-	    | ERR_NON_UNI_UTF8 (c,len) => 
-	      [Int2String len^"-byte UTF-8 sequence decodes to non-Unicode character",Char2Uni c]
-	    | ERR_INVALID_UTF8_SEQ bs => 
-	      ["Invalid UTF-8 sequence",List2xString (""," ","") Byte2Hex bs]
-	      
-	    | ERR_EOF_UCS2 b => 
-	      ["End of file before second byte of UCS-2 character starting with",Byte2Hex b]
-	    | ERR_EOF_UTF16 b => 
-	      ["End of file before second byte of UTF-16 character starting with",Byte2Hex b]
+            | ERR_ILLFORMED_UTF8 (b,len,pos) => 
+              [numberNth pos,"byte",Byte2Hex b,"of a",Int2String len^"-byte", 
+               "UTF-8 sequence does not start with bits 10"] 
+            | ERR_ILLEGAL_UTF8 b => 
+              ["Byte",Byte2Hex b,"is neither ASCII nor does it start",
+               "a valid multi-byte UTF-8 sequence"]
+            | ERR_EOF_UTF8 (len,pos) => 
+              ["End of file terminates a ",Int2String len^"-byte",
+               "UTF-8 sequence before the ",numberNth pos,"byte"]
+            | ERR_NON_UNI_UTF8 (c,len) => 
+              [Int2String len^"-byte UTF-8 sequence decodes to non-Unicode character",Char2Uni c]
+            | ERR_INVALID_UTF8_SEQ bs => 
+              ["Invalid UTF-8 sequence",List2xString (""," ","") Byte2Hex bs]
+              
+            | ERR_EOF_UCS2 b => 
+              ["End of file before second byte of UCS-2 character starting with",Byte2Hex b]
+            | ERR_EOF_UTF16 b => 
+              ["End of file before second byte of UTF-16 character starting with",Byte2Hex b]
 
-	    | ERR_LOW_SURROGATE c => 
-	      ["Low surrogate",Char2Uni c,"without preceding high surrogate"]
-	    | ERR_HIGH_SURROGATE (c,c1) => 
-	      ["High surrogate",Char2Uni c,"followed by",Char2Uni c1,"instead of low surrogate"]
-	    | ERR_EOF_SURROGATE c => 
-	      ["High surrogate",Char2Uni c,"followed by the end of file"]
+            | ERR_LOW_SURROGATE c => 
+              ["Low surrogate",Char2Uni c,"without preceding high surrogate"]
+            | ERR_HIGH_SURROGATE (c,c1) => 
+              ["High surrogate",Char2Uni c,"followed by",Char2Uni c1,"instead of low surrogate"]
+            | ERR_EOF_SURROGATE c => 
+              ["High surrogate",Char2Uni c,"followed by the end of file"]
 
-	    | ERR_NO_ENC_DECL auto => 
-	      ["Couldn't parse encoding declaration but auto-detected encoding",auto,"required so"]
-	    | ERR_UNSUPPORTED_ENC enc => 
-	      ["Unsupported encoding",enc]
-	    | ERR_INCOMPATIBLE_ENC (enc,auto) => 
-	      ["Encoding",enc,"is incompatible with auto-detected encoding",auto]
+            | ERR_NO_ENC_DECL auto => 
+              ["Couldn't parse encoding declaration but auto-detected encoding",auto,"required so"]
+            | ERR_UNSUPPORTED_ENC enc => 
+              ["Unsupported encoding",enc]
+            | ERR_INCOMPATIBLE_ENC (enc,auto) => 
+              ["Encoding",enc,"is incompatible with auto-detected encoding",auto]
 
       exception DecodeError of File * bool * DecodeError 
    end
@@ -4418,24 +4418,24 @@
 structure DecodeUcs2 : DecodeUcs2 = 
    struct
       open 
-	 UniChar Encoding
-	 DecodeFile DecodeError DecodeUtil
+         UniChar Encoding
+         DecodeFile DecodeError DecodeUtil
 
       fun getCharUcs2b f =
          let 
-	    val (b1,f1) = getByte f
-	    val (b2,f2) = getByte f1 handle exn as EndOfFile f 
-	       => raise DecodeError(f,true,ERR_EOF_UCS2 b1)
-	    val c = Chars.orb(Chars.<<(Byte2Char b1,0w8),Byte2Char b2) 
-	 in (c,f2)
+            val (b1,f1) = getByte f
+            val (b2,f2) = getByte f1 handle exn as EndOfFile f 
+               => raise DecodeError(f,true,ERR_EOF_UCS2 b1)
+            val c = Chars.orb(Chars.<<(Byte2Char b1,0w8),Byte2Char b2) 
+         in (c,f2)
          end
 
       fun getCharUcs2l f =
          let 
-	    val (b1,f1) = getByte f
-	    val (b2,f2) = getByte f1 handle exn as EndOfFile f 
-	       => raise DecodeError(f,true,ERR_EOF_UCS2 b1)
-	    val c = Chars.orb(Chars.<<(Byte2Char b2,0w8),Byte2Char b1) 
+            val (b1,f1) = getByte f
+            val (b2,f2) = getByte f1 handle exn as EndOfFile f 
+               => raise DecodeError(f,true,ERR_EOF_UCS2 b1)
+            val c = Chars.orb(Chars.<<(Byte2Char b2,0w8),Byte2Char b1) 
          in (c,f2)
          end
    end
@@ -4452,70 +4452,70 @@
 structure DecodeMisc : DecodeMisc = 
    struct
       open 
-	 UniChar DecodeFile DecodeError
-	 
+         UniChar DecodeFile DecodeError
+         
       fun getCharEof f = raise EndOfFile f
 
       (*--------------------------------------------------------------------*)
       (* ASCII characters must be lower than 0wx80                          *)
       (*--------------------------------------------------------------------*)
       fun getCharAscii f = 
-	 let val (b,f1) = getByte f
-	 in if b<0wx80 then (Byte2Char b,f1)
-	    else raise DecodeError(f1,false,ERR_ILLEGAL_CHAR(b,"ASCII"))
-	 end
+         let val (b,f1) = getByte f
+         in if b<0wx80 then (Byte2Char b,f1)
+            else raise DecodeError(f1,false,ERR_ILLEGAL_CHAR(b,"ASCII"))
+         end
 
       (*--------------------------------------------------------------------*)
       (* LATIN-1 is the first plane of Unicode.                             *)
       (*--------------------------------------------------------------------*)
       fun getCharLatin1 f = let val (b,f1) = getByte f
-			    in (Byte2Char b,f1)
-			    end
+                            in (Byte2Char b,f1)
+                            end
 
       (*--------------------------------------------------------------------*)
       (* EBCDIC is mapped to the first plane of Unicode.                    *)
       (*--------------------------------------------------------------------*)
       (* according to rfc-1345 (and gnu recode experiments) *)
       val ebcdic2latinTab = Vector.fromList 
-	  [0wx00,0wx01,0wx02,0wx03,0wx9C,0wx09,0wx86,0wx7F,
-	   0wx97,0wx8D,0wx8E,0wx0B,0wx0C,0wx0D,0wx0E,0wx0F,
-	   0wx10,0wx11,0wx12,0wx13,0wx9D,0wx85,0wx08,0wx87,
-	   0wx18,0wx19,0wx92,0wx8F,0wx1C,0wx1D,0wx1E,0wx1F,
-	   0wx80,0wx81,0wx82,0wx83,0wx84,0wx0A,0wx17,0wx1B,
-	   0wx88,0wx89,0wx8A,0wx8B,0wx8C,0wx05,0wx06,0wx07,
-	   0wx90,0wx91,0wx16,0wx93,0wx94,0wx95,0wx96,0wx04,
-	   0wx98,0wx99,0wx9A,0wx9B,0wx14,0wx15,0wx9E,0wx1A,
-	   0wx20,0wxA0,0wxA1,0wxA2,0wxA3,0wxA4,0wxA5,0wxA6,
-	   0wxA7,0wxA8,0wx5B,0wx2E,0wx3C,0wx28,0wx2B,0wx21,
-	   0wx26,0wxA9,0wxAA,0wxAB,0wxAC,0wxAD,0wxAE,0wxAF,
-	   0wxB0,0wxB1,0wx5D,0wx24,0wx2A,0wx29,0wx3B,0wx5E,
-	   0wx2D,0wx2F,0wxB2,0wxB3,0wxB4,0wxB5,0wxB6,0wxB7,
-	   0wxB8,0wxB9,0wx7C,0wx2C,0wx25,0wx5F,0wx3E,0wx3F,
-	   0wxBA,0wxBB,0wxBC,0wxBD,0wxBE,0wxBF,0wxC0,0wxC1,
-	   0wxC2,0wx60,0wx3A,0wx23,0wx40,0wx27,0wx3D,0wx22,
-	   0wxC3,0wx61,0wx62,0wx63,0wx64,0wx65,0wx66,0wx67,
-	   0wx68,0wx69,0wxC4,0wxC5,0wxC6,0wxC7,0wxC8,0wxC9,
-	   0wxCA,0wx6A,0wx6B,0wx6C,0wx6D,0wx6E,0wx6F,0wx70,
-	   0wx71,0wx72,0wxCB,0wxCC,0wxCD,0wxCE,0wxCF,0wxD0,
-	   0wxD1,0wx7E,0wx73,0wx74,0wx75,0wx76,0wx77,0wx78,
-	   0wx79,0wx7A,0wxD2,0wxD3,0wxD4,0wxD5,0wxD6,0wxD7,
-	   0wxD8,0wxD9,0wxDA,0wxDB,0wxDC,0wxDD,0wxDE,0wxDF,
-	   0wxE0,0wxE1,0wxE2,0wxE3,0wxE4,0wxE5,0wxE6,0wxE7,
-	   0wx7B,0wx41,0wx42,0wx43,0wx44,0wx45,0wx46,0wx47,
-	   0wx48,0wx49,0wxE8,0wxE9,0wxEA,0wxEB,0wxEC,0wxED,
-	   0wx7D,0wx4A,0wx4B,0wx4C,0wx4D,0wx4E,0wx4F,0wx50,
-	   0wx51,0wx52,0wxEE,0wxEF,0wxF0,0wxF1,0wxF2,0wxF3,
-	   0wx5C,0wx9F,0wx53,0wx54,0wx55,0wx56,0wx57,0wx58,
-	   0wx59,0wx5A,0wxF4,0wxF5,0wxF6,0wxF7,0wxF8,0wxF9,
-	   0wx30,0wx31,0wx32,0wx33,0wx34,0wx35,0wx36,0wx37,
-	   0wx38,0wx39,0wxFA,0wxFB,0wxFC,0wxFD,0wxFE,0wxFF
-	   ] 
-	   
+          [0wx00,0wx01,0wx02,0wx03,0wx9C,0wx09,0wx86,0wx7F,
+           0wx97,0wx8D,0wx8E,0wx0B,0wx0C,0wx0D,0wx0E,0wx0F,
+           0wx10,0wx11,0wx12,0wx13,0wx9D,0wx85,0wx08,0wx87,
+           0wx18,0wx19,0wx92,0wx8F,0wx1C,0wx1D,0wx1E,0wx1F,
+           0wx80,0wx81,0wx82,0wx83,0wx84,0wx0A,0wx17,0wx1B,
+           0wx88,0wx89,0wx8A,0wx8B,0wx8C,0wx05,0wx06,0wx07,
+           0wx90,0wx91,0wx16,0wx93,0wx94,0wx95,0wx96,0wx04,
+           0wx98,0wx99,0wx9A,0wx9B,0wx14,0wx15,0wx9E,0wx1A,
+           0wx20,0wxA0,0wxA1,0wxA2,0wxA3,0wxA4,0wxA5,0wxA6,
+           0wxA7,0wxA8,0wx5B,0wx2E,0wx3C,0wx28,0wx2B,0wx21,
+           0wx26,0wxA9,0wxAA,0wxAB,0wxAC,0wxAD,0wxAE,0wxAF,
+           0wxB0,0wxB1,0wx5D,0wx24,0wx2A,0wx29,0wx3B,0wx5E,
+           0wx2D,0wx2F,0wxB2,0wxB3,0wxB4,0wxB5,0wxB6,0wxB7,
+           0wxB8,0wxB9,0wx7C,0wx2C,0wx25,0wx5F,0wx3E,0wx3F,
+           0wxBA,0wxBB,0wxBC,0wxBD,0wxBE,0wxBF,0wxC0,0wxC1,
+           0wxC2,0wx60,0wx3A,0wx23,0wx40,0wx27,0wx3D,0wx22,
+           0wxC3,0wx61,0wx62,0wx63,0wx64,0wx65,0wx66,0wx67,
+           0wx68,0wx69,0wxC4,0wxC5,0wxC6,0wxC7,0wxC8,0wxC9,
+           0wxCA,0wx6A,0wx6B,0wx6C,0wx6D,0wx6E,0wx6F,0wx70,
+           0wx71,0wx72,0wxCB,0wxCC,0wxCD,0wxCE,0wxCF,0wxD0,
+           0wxD1,0wx7E,0wx73,0wx74,0wx75,0wx76,0wx77,0wx78,
+           0wx79,0wx7A,0wxD2,0wxD3,0wxD4,0wxD5,0wxD6,0wxD7,
+           0wxD8,0wxD9,0wxDA,0wxDB,0wxDC,0wxDD,0wxDE,0wxDF,
+           0wxE0,0wxE1,0wxE2,0wxE3,0wxE4,0wxE5,0wxE6,0wxE7,
+           0wx7B,0wx41,0wx42,0wx43,0wx44,0wx45,0wx46,0wx47,
+           0wx48,0wx49,0wxE8,0wxE9,0wxEA,0wxEB,0wxEC,0wxED,
+           0wx7D,0wx4A,0wx4B,0wx4C,0wx4D,0wx4E,0wx4F,0wx50,
+           0wx51,0wx52,0wxEE,0wxEF,0wxF0,0wxF1,0wxF2,0wxF3,
+           0wx5C,0wx9F,0wx53,0wx54,0wx55,0wx56,0wx57,0wx58,
+           0wx59,0wx5A,0wxF4,0wxF5,0wxF6,0wxF7,0wxF8,0wxF9,
+           0wx30,0wx31,0wx32,0wx33,0wx34,0wx35,0wx36,0wx37,
+           0wx38,0wx39,0wxFA,0wxFB,0wxFC,0wxFD,0wxFE,0wxFF
+           ] 
+           
       fun ebcdic2latin b = Vector.sub(ebcdic2latinTab,Word8.toInt b)
 
       fun getCharEbcdic f = let val (b,f1) = getByte f
-			    in (ebcdic2latin b,f1)
-			    end
+                            in (ebcdic2latin b,f1)
+                            end
    end
 (* stop of ../../Unicode/Decode/decodeMisc.sml *)
 (* start of ../../Unicode/Decode/decodeUcs4.sml *)
@@ -4545,68 +4545,68 @@
          let 
             val (b1,f1) = getByte f
             val (b2,f2) = getByte f1 handle EndOfFile f 
-	       => raise DecodeError(f,true,ERR_EOF_UCS4(1,[b1]))
+               => raise DecodeError(f,true,ERR_EOF_UCS4(1,[b1]))
             val (b3,f3) = getByte f2 handle EndOfFile f 
-	       => raise DecodeError(f,true,ERR_EOF_UCS4(1,[b1,b2]))
-	    val (b4,f4) = getByte f3 handle EndOfFile f 
-	       => raise DecodeError(f,true,ERR_EOF_UCS4(1,[b1,b2,b3]))
-	    val c = Chars.orb(Chars.orb(Chars.<<(Byte2Char b1,0w24),
-					Chars.<<(Byte2Char b2,0w16)),
-			      Chars.orb(Chars.<<(Byte2Char b3,0w08),
-					Byte2Char b4))
+               => raise DecodeError(f,true,ERR_EOF_UCS4(1,[b1,b2]))
+            val (b4,f4) = getByte f3 handle EndOfFile f 
+               => raise DecodeError(f,true,ERR_EOF_UCS4(1,[b1,b2,b3]))
+            val c = Chars.orb(Chars.orb(Chars.<<(Byte2Char b1,0w24),
+                                        Chars.<<(Byte2Char b2,0w16)),
+                              Chars.orb(Chars.<<(Byte2Char b3,0w08),
+                                        Byte2Char b4))
          in if isUnicode c then (c,f4)
-	    else raise DecodeError(f4,false,ERR_NON_UNI_UCS4 c)
+            else raise DecodeError(f4,false,ERR_NON_UNI_UCS4 c)
          end
 
       fun getCharUcs4l f = 
          let 
             val (b1,f1) = getByte f
             val (b2,f2) = getByte f1 handle EndOfFile f 
-	       => raise DecodeError(f,true,ERR_EOF_UCS4(1,[b1]))
+               => raise DecodeError(f,true,ERR_EOF_UCS4(1,[b1]))
             val (b3,f3) = getByte f2 handle EndOfFile f 
-	       => raise DecodeError(f,true,ERR_EOF_UCS4(1,[b1,b2]))
-	    val (b4,f4) = getByte f3 handle EndOfFile f 
-	       => raise DecodeError(f,true,ERR_EOF_UCS4(1,[b1,b2,b3]))
-	    val c = Chars.orb(Chars.orb(Chars.<<(Byte2Char b4,0w24),
-					Chars.<<(Byte2Char b3,0w16)),
-			      Chars.orb(Chars.<<(Byte2Char b2,0w08),
-					Byte2Char b1))
+               => raise DecodeError(f,true,ERR_EOF_UCS4(1,[b1,b2]))
+            val (b4,f4) = getByte f3 handle EndOfFile f 
+               => raise DecodeError(f,true,ERR_EOF_UCS4(1,[b1,b2,b3]))
+            val c = Chars.orb(Chars.orb(Chars.<<(Byte2Char b4,0w24),
+                                        Chars.<<(Byte2Char b3,0w16)),
+                              Chars.orb(Chars.<<(Byte2Char b2,0w08),
+                                        Byte2Char b1))
          in if isUnicode c then (c,f4)
-	    else raise DecodeError(f4,false,ERR_NON_UNI_UCS4 c)
+            else raise DecodeError(f4,false,ERR_NON_UNI_UCS4 c)
          end
 
       fun getCharUcs4sb f = 
          let 
             val (b1,f1) = getByte f
             val (b2,f2) = getByte f1 handle EndOfFile f 
-	       => raise DecodeError(f,true,ERR_EOF_UCS4(1,[b1]))
+               => raise DecodeError(f,true,ERR_EOF_UCS4(1,[b1]))
             val (b3,f3) = getByte f2 handle EndOfFile f 
-	       => raise DecodeError(f,true,ERR_EOF_UCS4(1,[b1,b2]))
-	    val (b4,f4) = getByte f3 handle EndOfFile f 
-	       => raise DecodeError(f,true,ERR_EOF_UCS4(1,[b1,b2,b3]))
-	    val c = Chars.orb(Chars.orb(Chars.<<(Byte2Char b2,0w24),
-					Chars.<<(Byte2Char b1,0w16)),
-			      Chars.orb(Chars.<<(Byte2Char b4,0w08),
-					Byte2Char b3))
+               => raise DecodeError(f,true,ERR_EOF_UCS4(1,[b1,b2]))
+            val (b4,f4) = getByte f3 handle EndOfFile f 
+               => raise DecodeError(f,true,ERR_EOF_UCS4(1,[b1,b2,b3]))
+            val c = Chars.orb(Chars.orb(Chars.<<(Byte2Char b2,0w24),
+                                        Chars.<<(Byte2Char b1,0w16)),
+                              Chars.orb(Chars.<<(Byte2Char b4,0w08),
+                                        Byte2Char b3))
          in if isUnicode c then (c,f4)
-	    else raise DecodeError(f4,false,ERR_NON_UNI_UCS4 c)
+            else raise DecodeError(f4,false,ERR_NON_UNI_UCS4 c)
          end
 
       fun getCharUcs4sl f = 
          let 
             val (b1,f1) = getByte f
             val (b2,f2) = getByte f1 handle EndOfFile f 
-	       => raise DecodeError(f,true,ERR_EOF_UCS4(1,[b1]))
+               => raise DecodeError(f,true,ERR_EOF_UCS4(1,[b1]))
             val (b3,f3) = getByte f2 handle EndOfFile f 
-	       => raise DecodeError(f,true,ERR_EOF_UCS4(1,[b1,b2]))
-	    val (b4,f4) = getByte f3 handle EndOfFile f 
-	       => raise DecodeError(f,true,ERR_EOF_UCS4(1,[b1,b2,b3]))
-	    val c = Chars.orb(Chars.orb(Chars.<<(Byte2Char b3,0w24),
-					Chars.<<(Byte2Char b4,0w16)),
-			      Chars.orb(Chars.<<(Byte2Char b1,0w08),
-					Byte2Char b2))
+               => raise DecodeError(f,true,ERR_EOF_UCS4(1,[b1,b2]))
+            val (b4,f4) = getByte f3 handle EndOfFile f 
+               => raise DecodeError(f,true,ERR_EOF_UCS4(1,[b1,b2,b3]))
+            val c = Chars.orb(Chars.orb(Chars.<<(Byte2Char b3,0w24),
+                                        Chars.<<(Byte2Char b4,0w16)),
+                              Chars.orb(Chars.<<(Byte2Char b1,0w08),
+                                        Byte2Char b2))
          in if isUnicode c then (c,f4)
-	    else raise DecodeError(f4,false,ERR_NON_UNI_UCS4 c)
+            else raise DecodeError(f4,false,ERR_NON_UNI_UCS4 c)
          end
    end
 
@@ -4628,48 +4628,48 @@
 structure DecodeUtf16 : DecodeUtf16 = 
    struct
       open 
-	 UniChar Encoding
-	 DecodeFile DecodeError DecodeUtil
+         UniChar Encoding
+         DecodeFile DecodeError DecodeUtil
 
       fun getCharUtf16b f =
          let 
-	    val (b1,f1) = getByte f
-	    val (b2,f2) = getByte f1 handle exn as EndOfFile f 
-	       => raise DecodeError(f,true,ERR_EOF_UTF16 b1)
-	    val c = Chars.orb(Chars.<<(Byte2Char b1,0w8),Byte2Char b2) 
+            val (b1,f1) = getByte f
+            val (b2,f2) = getByte f1 handle exn as EndOfFile f 
+               => raise DecodeError(f,true,ERR_EOF_UTF16 b1)
+            val c = Chars.orb(Chars.<<(Byte2Char b1,0w8),Byte2Char b2) 
         in 
-	   if isSurrogate c then (* Chars.orb(c,0wx7FF)=0wxDFFF *)
-	       if isLowSurrogate c then raise DecodeError(f2,false,ERR_LOW_SURROGATE c)
-	       else let 
-		       val (b3,f3) = getByte f2 handle exn as EndOfFile f 
-			  => raise DecodeError(f,true,ERR_EOF_SURROGATE c)
-		       val (b4,f4) = getByte f3 handle exn as EndOfFile f 
-			  => raise DecodeError(f,true,ERR_EOF_UTF16 b3)
-		       val c1 = Chars.orb(Chars.<<(Byte2Char b3,0w8),Byte2Char b4)
-		    in if isLowSurrogate c1 then (combineSurrogates(c,c1),f4)
-		       else raise DecodeError(f4,false,ERR_HIGH_SURROGATE(c,c1))
-		    end
+           if isSurrogate c then (* Chars.orb(c,0wx7FF)=0wxDFFF *)
+               if isLowSurrogate c then raise DecodeError(f2,false,ERR_LOW_SURROGATE c)
+               else let 
+                       val (b3,f3) = getByte f2 handle exn as EndOfFile f 
+                          => raise DecodeError(f,true,ERR_EOF_SURROGATE c)
+                       val (b4,f4) = getByte f3 handle exn as EndOfFile f 
+                          => raise DecodeError(f,true,ERR_EOF_UTF16 b3)
+                       val c1 = Chars.orb(Chars.<<(Byte2Char b3,0w8),Byte2Char b4)
+                    in if isLowSurrogate c1 then (combineSurrogates(c,c1),f4)
+                       else raise DecodeError(f4,false,ERR_HIGH_SURROGATE(c,c1))
+                    end
             else (c,f2)
          end
 
       fun getCharUtf16l f =
          let 
-	    val (b1,f1) = getByte f
-	    val (b2,f2) = getByte f1 handle exn as EndOfFile f 
-	       => raise DecodeError(f,true,ERR_EOF_UTF16 b1)
-	    val c = Chars.orb(Chars.<<(Byte2Char b2,0w8),Byte2Char b1) 
+            val (b1,f1) = getByte f
+            val (b2,f2) = getByte f1 handle exn as EndOfFile f 
+               => raise DecodeError(f,true,ERR_EOF_UTF16 b1)
+            val c = Chars.orb(Chars.<<(Byte2Char b2,0w8),Byte2Char b1) 
          in 
-	    if isSurrogate c then
-	       if isLowSurrogate c then raise DecodeError(f2,false,ERR_LOW_SURROGATE c)
-	       else let 
-		       val (b3,f3) = getByte f2 handle exn as EndOfFile f 
-			  => raise DecodeError(f,true,ERR_EOF_SURROGATE c)
-		       val (b4,f4) = getByte f3 handle exn as EndOfFile f 
-			  => raise DecodeError(f,true,ERR_EOF_UTF16 b3)
-		       val c1 = Chars.orb(Chars.<<(Byte2Char b4,0w8),Byte2Char b3)
-		    in if isLowSurrogate c1 then (combineSurrogates(c,c1),f4)
-		       else raise DecodeError(f4,false,ERR_HIGH_SURROGATE(c,c1))
-		    end
+            if isSurrogate c then
+               if isLowSurrogate c then raise DecodeError(f2,false,ERR_LOW_SURROGATE c)
+               else let 
+                       val (b3,f3) = getByte f2 handle exn as EndOfFile f 
+                          => raise DecodeError(f,true,ERR_EOF_SURROGATE c)
+                       val (b4,f4) = getByte f3 handle exn as EndOfFile f 
+                          => raise DecodeError(f,true,ERR_EOF_UTF16 b3)
+                       val c1 = Chars.orb(Chars.<<(Byte2Char b4,0w8),Byte2Char b3)
+                    in if isLowSurrogate c1 then (combineSurrogates(c,c1),f4)
+                       else raise DecodeError(f4,false,ERR_HIGH_SURROGATE(c,c1))
+                    end
             else (c,f2)
          end
    end
@@ -4683,8 +4683,8 @@
 structure DecodeUtf8 : DecodeUtf8 =
    struct
       open 
-	 UniChar UniClasses UtilError UtilInt
-	 DecodeFile DecodeError DecodeUtil
+         UniChar UniClasses UtilError UtilInt
+         DecodeFile DecodeError DecodeUtil
 
       val THIS_MODULE = "DecodeUtf8"
 
@@ -4697,15 +4697,15 @@
       val op ||| = Chars.orb
 
       val byte1switch = Vector.tabulate 
-	 (256,fn i => 
-	  if i<0x80 then 1 
-	  else if i<0xC0 then 0
-	  else if i<0xE0 then 2
-	  else if i<0xF0 then 3
-	  else if i<0xF8 then 4
-	  else if i<0xFC then 5
-	  else if i<0xFE then 6
-	       else 0)
+         (256,fn i => 
+          if i<0x80 then 1 
+          else if i<0xC0 then 0
+          else if i<0xE0 then 2
+          else if i<0xF0 then 3
+          else if i<0xF8 then 4
+          else if i<0xFC then 5
+          else if i<0xFE then 6
+               else 0)
 
       val diff2 : Char = 0wx00003080
       val diff3 : Char = diff2 <<< 0wx6 ||| 0wx00020080
@@ -4714,142 +4714,142 @@
       val diff6 : Char = diff5 <<< 0wx6 ||| 0wx00000080
 
       fun getCharUtf8 f =
-	 let val (b1,f1) = getByte f
-	 in if b1<0wx80 then (Byte2Char b1,f1)
-	    else let val n = Vector.sub(byte1switch,Word8.toInt b1)
-		 in case n
-		      of 0 (* error   *) => raise DecodeError(f1,false,ERR_ILLEGAL_UTF8 b1)
-		       | 1 => (Byte2Char b1,f1)
-		       | 2 => 
-			 let 
-			    val (b2,f2) = getByte f1 handle EndOfFile f
-			       => raise DecodeError(f,true,ERR_EOF_UTF8(n,2))
-			 in  if b2 && 0wxC0 <> 0wx80 
-				then raise DecodeError(f2,false,ERR_ILLFORMED_UTF8(b2,n,2))
-			     else let val c = Byte2Char b1 <<< 0w6 + Byte2Char b2 - diff2
-				  in if c>=0wx80 then (c,f2)
-				     else raise DecodeError(f2,false,ERR_INVALID_UTF8_SEQ [b1,b2])
-				  end
-			 end
-		       | 3 => 
-			 let 
-			    val (b2,f2) = getByte f1 handle EndOfFile f
-			       => raise DecodeError(f,true,ERR_EOF_UTF8(n,2))
-			    val (b3,f3) = getByte f2 handle EndOfFile f
-			       => raise DecodeError(f,true,ERR_EOF_UTF8(n,3))
-			 in  
-			    if b2 && 0wxC0 <> 0wx80 
-			       then raise DecodeError(f3,false,ERR_ILLFORMED_UTF8(b2,n,2))
-			    else if b3 && 0wxC0 <> 0wx80 
-				    then raise DecodeError(f3,false,ERR_ILLFORMED_UTF8(b2,n,3))
-				 else let val c = (Byte2Char b1 <<< 0w12 + 
-						   Byte2Char b2 <<< 0w06 + 
-						   Byte2Char b3 - diff3)
-				      in if c>=0wx800 then (c,f3)
-					 else raise DecodeError
-					    (f3,false,ERR_INVALID_UTF8_SEQ [b1,b2,b3])
-				      end
-			 end
-		       | 4 => 
-			 let 
-			    val (b2,f2) = getByte f1 handle EndOfFile f
-			       => raise DecodeError(f,true,ERR_EOF_UTF8(n,2))
-			    val (b3,f3) = getByte f2 handle EndOfFile f
-			       => raise DecodeError(f,true,ERR_EOF_UTF8(n,3))
-			    val (b4,f4) = getByte f3 handle EndOfFile f
-			       => raise DecodeError(f,true,ERR_EOF_UTF8(n,4))
-			 in  
-			    if b2 && 0wxC0 <> 0wx80 
-			       then raise DecodeError(f4,false,ERR_ILLFORMED_UTF8(b2,n,2))
-			    else if b3 && 0wxC0 <> 0wx80 
-				    then raise DecodeError(f4,false,ERR_ILLFORMED_UTF8(b2,n,3))
-			    else if b4 && 0wxC0 <> 0wx80 
-				    then raise DecodeError(f4,false,ERR_ILLFORMED_UTF8(b2,n,4))
-				 else let val c = (Byte2Char b1 <<< 0w18 + 
-						   Byte2Char b2 <<< 0w12 + 
-						   Byte2Char b3 <<< 0w06 + 
-						   Byte2Char b4 - diff4)
-				      in 
-					 if c>=0wx100000 andalso c<=0wx10FFFF then (c,f4)
-					 else if c<0wx10000 
-						 then raise DecodeError
-						    (f4,false,ERR_INVALID_UTF8_SEQ [b1,b2,b3,b4])
-					      else raise DecodeError
-						 (f4,false,ERR_NON_UNI_UTF8(c,n))
-				      end
-			 end
-		       | 5 => 
-			 let 
-			    val (b2,f2) = getByte f1 handle EndOfFile f
-			       => raise DecodeError(f,true,ERR_EOF_UTF8(n,2))
-			    val (b3,f3) = getByte f2 handle EndOfFile f
-			       => raise DecodeError(f,true,ERR_EOF_UTF8(n,3))
-			    val (b4,f4) = getByte f3 handle EndOfFile f
-			       => raise DecodeError(f,true,ERR_EOF_UTF8(n,4))
-			    val (b5,f5) = getByte f4 handle EndOfFile f
-			       => raise DecodeError(f,true,ERR_EOF_UTF8(n,5))
-			 in  
-			    if b2 && 0wxC0 <> 0wx80 
-			       then raise DecodeError(f5,false,ERR_ILLFORMED_UTF8(b2,n,2))
-			    else if b3 && 0wxC0 <> 0wx80 
-				    then raise DecodeError(f5,false,ERR_ILLFORMED_UTF8(b2,n,3))
-			    else if b4 && 0wxC0 <> 0wx80 
-				    then raise DecodeError(f5,false,ERR_ILLFORMED_UTF8(b2,n,4))
-			    else if b5 && 0wxC0 <> 0wx80 
-				    then raise DecodeError(f5,false,ERR_ILLFORMED_UTF8(b2,n,5))
-				 else let val c = (Byte2Char b1 <<< 0w24 + 
-						   Byte2Char b2 <<< 0w18 + 
-						   Byte2Char b3 <<< 0w12 + 
-						   Byte2Char b4 <<< 0w06 + 
-						   Byte2Char b5 - diff5)
-				      in if c<0wx200000 
-					    then raise DecodeError
-					       (f5,false,ERR_INVALID_UTF8_SEQ [b1,b2,b3,b4,b5])
-					 else raise DecodeError
-						 (f5,false,ERR_NON_UNI_UTF8(c,n))
-				      end
-			 end
-		       | 6 => 
-			 let 
-			    val (b2,f2) = getByte f1 handle EndOfFile f
-			       => raise DecodeError(f,true,ERR_EOF_UTF8(n,2))
-			    val (b3,f3) = getByte f2 handle EndOfFile f
-			       => raise DecodeError(f,true,ERR_EOF_UTF8(n,3))
-			    val (b4,f4) = getByte f3 handle EndOfFile f
-			       => raise DecodeError(f,true,ERR_EOF_UTF8(n,4))
-			    val (b5,f5) = getByte f4 handle EndOfFile f
-			       => raise DecodeError(f,true,ERR_EOF_UTF8(n,5))
-			    val (b6,f6) = getByte f5 handle EndOfFile f
-			       => raise DecodeError(f,true,ERR_EOF_UTF8(n,6))
-			 in  
-			    if b2 && 0wxC0 <> 0wx80 
-			       then raise DecodeError(f6,false,ERR_ILLFORMED_UTF8(b2,n,2))
-			    else if b3 && 0wxC0 <> 0wx80 
-				    then raise DecodeError(f6,false,ERR_ILLFORMED_UTF8(b2,n,3))
-			    else if b4 && 0wxC0 <> 0wx80 
-				    then raise DecodeError(f6,false,ERR_ILLFORMED_UTF8(b2,n,4))
-			    else if b5 && 0wxC0 <> 0wx80 
-				    then raise DecodeError(f6,false,ERR_ILLFORMED_UTF8(b2,n,5))
-			    else if b6 && 0wxC0 <> 0wx80 
-				    then raise DecodeError(f6,false,ERR_ILLFORMED_UTF8(b2,n,6))
-				 else let val c = (Byte2Char b1 <<< 0w30 + 
-						   Byte2Char b2 <<< 0w24 + 
-						   Byte2Char b3 <<< 0w18 + 
-						   Byte2Char b4 <<< 0w12 + 
-						   Byte2Char b5 <<< 0w06 + 
-						   Byte2Char b6 - diff6)
-				      in if c<0wx4000000 
-					    then raise DecodeError
-					       (f6,false,ERR_INVALID_UTF8_SEQ [b1,b2,b3,b4,b5,b6])
-					 else raise DecodeError
-						 (f6,false,ERR_NON_UNI_UTF8(c,n))
-				      end
-			 end
-		       | _ => raise InternalError(THIS_MODULE,"getCharUtf8",
-						  "byte1switch holds "^Int.toString n^
-						  ">6 for byte "^Bytes.toString b1)
-		 end
-	 end
+         let val (b1,f1) = getByte f
+         in if b1<0wx80 then (Byte2Char b1,f1)
+            else let val n = Vector.sub(byte1switch,Word8.toInt b1)
+                 in case n
+                      of 0 (* error   *) => raise DecodeError(f1,false,ERR_ILLEGAL_UTF8 b1)
+                       | 1 => (Byte2Char b1,f1)
+                       | 2 => 
+                         let 
+                            val (b2,f2) = getByte f1 handle EndOfFile f
+                               => raise DecodeError(f,true,ERR_EOF_UTF8(n,2))
+                         in  if b2 && 0wxC0 <> 0wx80 
+                                then raise DecodeError(f2,false,ERR_ILLFORMED_UTF8(b2,n,2))
+                             else let val c = Byte2Char b1 <<< 0w6 + Byte2Char b2 - diff2
+                                  in if c>=0wx80 then (c,f2)
+                                     else raise DecodeError(f2,false,ERR_INVALID_UTF8_SEQ [b1,b2])
+                                  end
+                         end
+                       | 3 => 
+                         let 
+                            val (b2,f2) = getByte f1 handle EndOfFile f
+                               => raise DecodeError(f,true,ERR_EOF_UTF8(n,2))
+                            val (b3,f3) = getByte f2 handle EndOfFile f
+                               => raise DecodeError(f,true,ERR_EOF_UTF8(n,3))
+                         in  
+                            if b2 && 0wxC0 <> 0wx80 
+                               then raise DecodeError(f3,false,ERR_ILLFORMED_UTF8(b2,n,2))
+                            else if b3 && 0wxC0 <> 0wx80 
+                                    then raise DecodeError(f3,false,ERR_ILLFORMED_UTF8(b2,n,3))
+                                 else let val c = (Byte2Char b1 <<< 0w12 + 
+                                                   Byte2Char b2 <<< 0w06 + 
+                                                   Byte2Char b3 - diff3)
+                                      in if c>=0wx800 then (c,f3)
+                                         else raise DecodeError
+                                            (f3,false,ERR_INVALID_UTF8_SEQ [b1,b2,b3])
+                                      end
+                         end
+                       | 4 => 
+                         let 
+                            val (b2,f2) = getByte f1 handle EndOfFile f
+                               => raise DecodeError(f,true,ERR_EOF_UTF8(n,2))
+                            val (b3,f3) = getByte f2 handle EndOfFile f
+                               => raise DecodeError(f,true,ERR_EOF_UTF8(n,3))
+                            val (b4,f4) = getByte f3 handle EndOfFile f
+                               => raise DecodeError(f,true,ERR_EOF_UTF8(n,4))
+                         in  
+                            if b2 && 0wxC0 <> 0wx80 
+                               then raise DecodeError(f4,false,ERR_ILLFORMED_UTF8(b2,n,2))
+                            else if b3 && 0wxC0 <> 0wx80 
+                                    then raise DecodeError(f4,false,ERR_ILLFORMED_UTF8(b2,n,3))
+                            else if b4 && 0wxC0 <> 0wx80 
+                                    then raise DecodeError(f4,false,ERR_ILLFORMED_UTF8(b2,n,4))
+                                 else let val c = (Byte2Char b1 <<< 0w18 + 
+                                                   Byte2Char b2 <<< 0w12 + 
+                                                   Byte2Char b3 <<< 0w06 + 
+                                                   Byte2Char b4 - diff4)
+                                      in 
+                                         if c>=0wx100000 andalso c<=0wx10FFFF then (c,f4)
+                                         else if c<0wx10000 
+                                                 then raise DecodeError
+                                                    (f4,false,ERR_INVALID_UTF8_SEQ [b1,b2,b3,b4])
+                                              else raise DecodeError
+                                                 (f4,false,ERR_NON_UNI_UTF8(c,n))
+                                      end
+                         end
+                       | 5 => 
+                         let 
+                            val (b2,f2) = getByte f1 handle EndOfFile f
+                               => raise DecodeError(f,true,ERR_EOF_UTF8(n,2))
+                            val (b3,f3) = getByte f2 handle EndOfFile f
+                               => raise DecodeError(f,true,ERR_EOF_UTF8(n,3))
+                            val (b4,f4) = getByte f3 handle EndOfFile f
+                               => raise DecodeError(f,true,ERR_EOF_UTF8(n,4))
+                            val (b5,f5) = getByte f4 handle EndOfFile f
+                               => raise DecodeError(f,true,ERR_EOF_UTF8(n,5))
+                         in  
+                            if b2 && 0wxC0 <> 0wx80 
+                               then raise DecodeError(f5,false,ERR_ILLFORMED_UTF8(b2,n,2))
+                            else if b3 && 0wxC0 <> 0wx80 
+                                    then raise DecodeError(f5,false,ERR_ILLFORMED_UTF8(b2,n,3))
+                            else if b4 && 0wxC0 <> 0wx80 
+                                    then raise DecodeError(f5,false,ERR_ILLFORMED_UTF8(b2,n,4))
+                            else if b5 && 0wxC0 <> 0wx80 
+                                    then raise DecodeError(f5,false,ERR_ILLFORMED_UTF8(b2,n,5))
+                                 else let val c = (Byte2Char b1 <<< 0w24 + 
+                                                   Byte2Char b2 <<< 0w18 + 
+                                                   Byte2Char b3 <<< 0w12 + 
+                                                   Byte2Char b4 <<< 0w06 + 
+                                                   Byte2Char b5 - diff5)
+                                      in if c<0wx200000 
+                                            then raise DecodeError
+                                               (f5,false,ERR_INVALID_UTF8_SEQ [b1,b2,b3,b4,b5])
+                                         else raise DecodeError
+                                                 (f5,false,ERR_NON_UNI_UTF8(c,n))
+                                      end
+                         end
+                       | 6 => 
+                         let 
+                            val (b2,f2) = getByte f1 handle EndOfFile f
+                               => raise DecodeError(f,true,ERR_EOF_UTF8(n,2))
+                            val (b3,f3) = getByte f2 handle EndOfFile f
+                               => raise DecodeError(f,true,ERR_EOF_UTF8(n,3))
+                            val (b4,f4) = getByte f3 handle EndOfFile f
+                               => raise DecodeError(f,true,ERR_EOF_UTF8(n,4))
+                            val (b5,f5) = getByte f4 handle EndOfFile f
+                               => raise DecodeError(f,true,ERR_EOF_UTF8(n,5))
+                            val (b6,f6) = getByte f5 handle EndOfFile f
+                               => raise DecodeError(f,true,ERR_EOF_UTF8(n,6))
+                         in  
+                            if b2 && 0wxC0 <> 0wx80 
+                               then raise DecodeError(f6,false,ERR_ILLFORMED_UTF8(b2,n,2))
+                            else if b3 && 0wxC0 <> 0wx80 
+                                    then raise DecodeError(f6,false,ERR_ILLFORMED_UTF8(b2,n,3))
+                            else if b4 && 0wxC0 <> 0wx80 
+                                    then raise DecodeError(f6,false,ERR_ILLFORMED_UTF8(b2,n,4))
+                            else if b5 && 0wxC0 <> 0wx80 
+                                    then raise DecodeError(f6,false,ERR_ILLFORMED_UTF8(b2,n,5))
+                            else if b6 && 0wxC0 <> 0wx80 
+                                    then raise DecodeError(f6,false,ERR_ILLFORMED_UTF8(b2,n,6))
+                                 else let val c = (Byte2Char b1 <<< 0w30 + 
+                                                   Byte2Char b2 <<< 0w24 + 
+                                                   Byte2Char b3 <<< 0w18 + 
+                                                   Byte2Char b4 <<< 0w12 + 
+                                                   Byte2Char b5 <<< 0w06 + 
+                                                   Byte2Char b6 - diff6)
+                                      in if c<0wx4000000 
+                                            then raise DecodeError
+                                               (f6,false,ERR_INVALID_UTF8_SEQ [b1,b2,b3,b4,b5,b6])
+                                         else raise DecodeError
+                                                 (f6,false,ERR_NON_UNI_UTF8(c,n))
+                                      end
+                         end
+                       | _ => raise InternalError(THIS_MODULE,"getCharUtf8",
+                                                  "byte1switch holds "^Int.toString n^
+                                                  ">6 for byte "^Bytes.toString b1)
+                 end
+         end
    end
 (* stop of ../../Unicode/Decode/decodeUtf8.sml *)
 (* start of ../../Unicode/Decode/decode.sml *)
@@ -4889,9 +4889,9 @@
    struct
       structure Error = DecodeError
       open
-	 UniChar Encoding Error 
-	 DecodeFile DecodeMisc DecodeUcs2 DecodeUcs4 
-	 DecodeUtf16 DecodeUtf8 DecodeUtil
+         UniChar Encoding Error 
+         DecodeFile DecodeMisc DecodeUcs2 DecodeUcs4 
+         DecodeUtf16 DecodeUtf8 DecodeUtil
 
       type DecFile = Encoding * File 
       exception DecEof of DecFile
@@ -4918,92 +4918,92 @@
       (* commit the auto-detected encoding.                                 *)
       (*--------------------------------------------------------------------*)
       fun decCommit (enc,f) = 
-	 case enc
-	   of UTF8 => ()
-	    | UTF16B => ()
-	    | UTF16L => ()
-	    | _ => raise DecError((enc,f),false,ERR_NO_ENC_DECL(encodingName enc))
+         case enc
+           of UTF8 => ()
+            | UTF16B => ()
+            | UTF16L => ()
+            | _ => raise DecError((enc,f),false,ERR_NO_ENC_DECL(encodingName enc))
 
       (*--------------------------------------------------------------------*)
       (* change to another - compatible - encoding.                         *)
       (*--------------------------------------------------------------------*)
       fun decSwitch ((enc,f),decl) =
-	 let
-	    val decEnc = isEncoding decl
-	    val _ = if decEnc<>NOENC then () 
-		    else raise DecError((enc,f),false,ERR_UNSUPPORTED_ENC decl)
-	    val newEnc = switchEncoding(enc,decEnc)
-	    val _ = if decEnc<>NOENC orelse enc=NOENC then () 
-		    else raise DecError((enc,f),false,ERR_INCOMPATIBLE_ENC(encodingName enc,decl))
-	 in (newEnc,f)
-	 end
+         let
+            val decEnc = isEncoding decl
+            val _ = if decEnc<>NOENC then () 
+                    else raise DecError((enc,f),false,ERR_UNSUPPORTED_ENC decl)
+            val newEnc = switchEncoding(enc,decEnc)
+            val _ = if decEnc<>NOENC orelse enc=NOENC then () 
+                    else raise DecError((enc,f),false,ERR_INCOMPATIBLE_ENC(encodingName enc,decl))
+         in (newEnc,f)
+         end
       
       (*--------------------------------------------------------------------*)
       (* get a character from an encoded entity.                            *)
       (*--------------------------------------------------------------------*)
       fun decGetChar (enc,f) =
-	 let val (c,f1) = 
-	    case enc
-	      of NOENC  => raise EndOfFile f
-	       | ASCII  => getCharAscii f
-	       | EBCDIC => getCharEbcdic f
-	       | LATIN1 => getCharLatin1 f
-	       | UCS2B  => getCharUcs2b f
-	       | UCS2L  => getCharUcs2l f
-	       | UCS4B  => getCharUcs4b f
-	       | UCS4L  => getCharUcs4l f
-	       | UCS4SB => getCharUcs4sb f
-	       | UCS4SL => getCharUcs4sl f
-	       | UTF8   => getCharUtf8 f
-	       | UTF16B => getCharUtf16b f
-	       | UTF16L => getCharUtf16l f
-	 in (c,(enc,f1))
-	 end
+         let val (c,f1) = 
+            case enc
+              of NOENC  => raise EndOfFile f
+               | ASCII  => getCharAscii f
+               | EBCDIC => getCharEbcdic f
+               | LATIN1 => getCharLatin1 f
+               | UCS2B  => getCharUcs2b f
+               | UCS2L  => getCharUcs2l f
+               | UCS4B  => getCharUcs4b f
+               | UCS4L  => getCharUcs4l f
+               | UCS4SB => getCharUcs4sb f
+               | UCS4SL => getCharUcs4sl f
+               | UTF8   => getCharUtf8 f
+               | UTF16B => getCharUtf16b f
+               | UTF16L => getCharUtf16l f
+         in (c,(enc,f1))
+         end
       handle EndOfFile f            => raise DecEof(NOENC,f)
-	   | DecodeError(f,eof,err) => raise DecError((enc,f),eof,err)
+           | DecodeError(f,eof,err) => raise DecError((enc,f),eof,err)
 
       (*--------------------------------------------------------------------*)
       (* Load new characters, depending on the current entity's encoding.   *)
       (*--------------------------------------------------------------------*)
       fun decGetArray (enc,f) arr = 
-	 let 
-	    (*--------------------------------------------------------------*)
-	    (* Load the buffer with len new characters, or until the entity *)
-	    (* end is reached. Close the current file in that case.         *)
-	    (* Local exception Ended is needed in order to preserve tail    *)
-	    (* recursion.                                                   *)
-	    (*--------------------------------------------------------------*)
+         let 
+            (*--------------------------------------------------------------*)
+            (* Load the buffer with len new characters, or until the entity *)
+            (* end is reached. Close the current file in that case.         *)
+            (* Local exception Ended is needed in order to preserve tail    *)
+            (* recursion.                                                   *)
+            (*--------------------------------------------------------------*)
             fun loadArray getChar = 
-	       let 
-		  val ende = Array.length arr
-		  exception Error of int * exn
-		  fun doit (idx,f) = 
-		     if idx=ende then (ende,(enc,f),NONE)
-		     else let val (c,f1) = getChar f handle exn => raise Error (idx,exn)
-			      val _ = Array.update(arr,idx,c)
-			  in doit (idx+1,f1)
-			  end
-	       in doit (0,f) handle Error(idx,exn) 
-		  => case exn 
-		       of EndOfFile f => (idx,(NOENC,f),NONE)
-			| DecodeError (f,_,err) => (idx,(enc,f),SOME err)
-			| _ => raise exn
-	       end
-	 in case enc
-	      of NOENC  => (0,(NOENC,f),NONE)
-	       | ASCII  => loadArray getCharAscii 
-	       | EBCDIC => loadArray getCharEbcdic
-	       | LATIN1 => loadArray getCharLatin1
-	       | UCS2B  => loadArray getCharUcs2b 
-	       | UCS2L  => loadArray getCharUcs2l 
-	       | UCS4B  => loadArray getCharUcs4b 
-	       | UCS4L  => loadArray getCharUcs4l 
-	       | UCS4SB => loadArray getCharUcs4sb
-	       | UCS4SL => loadArray getCharUcs4sl
-	       | UTF8   => loadArray getCharUtf8 
-	       | UTF16B => loadArray getCharUtf16b
-	       | UTF16L => loadArray getCharUtf16l
-	 end
+               let 
+                  val ende = Array.length arr
+                  exception Error of int * exn
+                  fun doit (idx,f) = 
+                     if idx=ende then (ende,(enc,f),NONE)
+                     else let val (c,f1) = getChar f handle exn => raise Error (idx,exn)
+                              val _ = Array.update(arr,idx,c)
+                          in doit (idx+1,f1)
+                          end
+               in doit (0,f) handle Error(idx,exn) 
+                  => case exn 
+                       of EndOfFile f => (idx,(NOENC,f),NONE)
+                        | DecodeError (f,_,err) => (idx,(enc,f),SOME err)
+                        | _ => raise exn
+               end
+         in case enc
+              of NOENC  => (0,(NOENC,f),NONE)
+               | ASCII  => loadArray getCharAscii 
+               | EBCDIC => loadArray getCharEbcdic
+               | LATIN1 => loadArray getCharLatin1
+               | UCS2B  => loadArray getCharUcs2b 
+               | UCS2L  => loadArray getCharUcs2l 
+               | UCS4B  => loadArray getCharUcs4b 
+               | UCS4L  => loadArray getCharUcs4l 
+               | UCS4SB => loadArray getCharUcs4sb
+               | UCS4SL => loadArray getCharUcs4sl
+               | UTF8   => loadArray getCharUtf8 
+               | UTF16B => loadArray getCharUtf16b
+               | UTF16L => loadArray getCharUtf16l
+         end
 
 
       (*--------------------------------------------------------------------*)
@@ -5073,49 +5073,49 @@
 
 
       fun decOpenXml uri = 
-	 let 
-	    fun get4Bytes (n,f) = 
-	       if n=4 then (nil,f)
-	       else let val (b,f1) = getByte f
-			val (bs,f2) = get4Bytes (n+1,f1)
-		    in (b::bs,f2)
-		    end
-		 handle EndOfFile f => (nil,f)
-		    
-	    fun detect bs = 
-	      case bs 
-		of
-		  [0wx0,0wx0,0wxFE,0wxFF] => (UCS4B,nil)
-		| [0wxFF,0wxFE,0wx0,0wx0] => (UCS4L,nil)
-		| [0wxFE,0wxFF,0wx0,b4] => 
-		    if b4 <> 0wx0 then (UTF16B,[0wx0,b4])
-		    else (UTF8,bs)
-	        | [0wxFF,0wxFE,b3,0wx0] =>
-		    if b3 <> 0wx0 then (UTF16L,[b3,0wx0])
-		    else (UTF8,bs)
-		| [0wxEF,0wxBB,0wxBF,b4] => (UTF8,[b4])
-		| [0wx0,0wx0,0wx0,0wx3C] => (UCS4B,bs)
-		| [0wx3C,0wx0,0wx0,0wx0] => (UCS4L,bs)
-		| [0wx0,0wx0,0wx3C,0wx0] => (UCS4SB,bs)
-		| [0wx0,0wx3C,0wx0,0wx0] => (UCS4SL,bs)
-		| [0wx0,b2,b3,b4] =>
-		    if (b2=0wx3C orelse b2=0wx25 orelse b2=0wx20 
-			orelse b2=0wx09 orelse b2=0wx0D orelse b2=0wx0A)
-		      andalso (b3<>0wx0 orelse b4<>0wx0) then (UTF16B,bs)
-		    else (UTF8,bs)
-		| [b1,0wx0,b3,b4] =>
-		    if (b1=0wx3C orelse b1=0wx25 orelse b1=0wx20 
-			orelse b1=0wx09 orelse b1=0wx0D orelse b1=0wx0A)
-		      andalso (b3<>0wx0 orelse b4<>0wx0) then (UTF16L,bs)
-		    else (UTF8,bs)
-		| [0wx4C,0wx6F,0wxA7,0wx94] => (EBCDIC,bs)
-		| _ => (UTF8,bs)
+         let 
+            fun get4Bytes (n,f) = 
+               if n=4 then (nil,f)
+               else let val (b,f1) = getByte f
+                        val (bs,f2) = get4Bytes (n+1,f1)
+                    in (b::bs,f2)
+                    end
+                 handle EndOfFile f => (nil,f)
+                    
+            fun detect bs = 
+              case bs 
+                of
+                  [0wx0,0wx0,0wxFE,0wxFF] => (UCS4B,nil)
+                | [0wxFF,0wxFE,0wx0,0wx0] => (UCS4L,nil)
+                | [0wxFE,0wxFF,0wx0,b4] => 
+                    if b4 <> 0wx0 then (UTF16B,[0wx0,b4])
+                    else (UTF8,bs)
+                | [0wxFF,0wxFE,b3,0wx0] =>
+                    if b3 <> 0wx0 then (UTF16L,[b3,0wx0])
+                    else (UTF8,bs)
+                | [0wxEF,0wxBB,0wxBF,b4] => (UTF8,[b4])
+                | [0wx0,0wx0,0wx0,0wx3C] => (UCS4B,bs)
+                | [0wx3C,0wx0,0wx0,0wx0] => (UCS4L,bs)
+                | [0wx0,0wx0,0wx3C,0wx0] => (UCS4SB,bs)
+                | [0wx0,0wx3C,0wx0,0wx0] => (UCS4SL,bs)
+                | [0wx0,b2,b3,b4] =>
+                    if (b2=0wx3C orelse b2=0wx25 orelse b2=0wx20 
+                        orelse b2=0wx09 orelse b2=0wx0D orelse b2=0wx0A)
+                      andalso (b3<>0wx0 orelse b4<>0wx0) then (UTF16B,bs)
+                    else (UTF8,bs)
+                | [b1,0wx0,b3,b4] =>
+                    if (b1=0wx3C orelse b1=0wx25 orelse b1=0wx20 
+                        orelse b1=0wx09 orelse b1=0wx0D orelse b1=0wx0A)
+                      andalso (b3<>0wx0 orelse b4<>0wx0) then (UTF16L,bs)
+                    else (UTF8,bs)
+                | [0wx4C,0wx6F,0wxA7,0wx94] => (EBCDIC,bs)
+                | _ => (UTF8,bs)
 
-	    val f = openFile uri
-	    val (bs,f1) = get4Bytes(0,f)
-	    val (enc,unget) = detect bs
-	 in (enc,ungetBytes(f1,unget))
-	 end
+            val f = openFile uri
+            val (bs,f1) = get4Bytes(0,f)
+            val (enc,unget) = detect bs
+         in (enc,ungetBytes(f1,unget))
+         end
 
       (*--------------------------------------------------------------------*)
       (* open a Unicode file. Check whether it starts with a byte order     *)
@@ -5126,26 +5126,26 @@
       (* encoding.                                                          *)
       (*--------------------------------------------------------------------*)
       fun decOpenUni (uri,default) = 
-	 let
-	    fun def(f,bs) = 
-	       (default,ungetBytes(f,bs))
-	    fun detect f = 
-	       let val (b1,f1) = getByte f 
-	       in case b1
-		    of 0wxFE => (let val (b2,f2) = getByte f1 
-				 in if b2 = 0wxFF then (UTF16B,f2)
-				    else def(f2,[b1,b2])
-				 end handle EndOfFile f => def(f,[b1]))
-		     | 0wxFF => (let val (b2,f2) = getByte f1
-				 in if b2 = 0wxFE then (UTF16L,f2)
-				    else def(f2,[b1,b2])
-				 end handle EndOfFile f => def(f,[b1]))
-		     | _ => def(f1,[b1])
-	       end handle EndOfFile f => def(f,nil)
-	    val f = openFile uri
-	    val (enc,f1) = detect f 
-	 in (enc,f1)
-	 end
+         let
+            fun def(f,bs) = 
+               (default,ungetBytes(f,bs))
+            fun detect f = 
+               let val (b1,f1) = getByte f 
+               in case b1
+                    of 0wxFE => (let val (b2,f2) = getByte f1 
+                                 in if b2 = 0wxFF then (UTF16B,f2)
+                                    else def(f2,[b1,b2])
+                                 end handle EndOfFile f => def(f,[b1]))
+                     | 0wxFF => (let val (b2,f2) = getByte f1
+                                 in if b2 = 0wxFE then (UTF16L,f2)
+                                    else def(f2,[b1,b2])
+                                 end handle EndOfFile f => def(f,[b1]))
+                     | _ => def(f1,[b1])
+               end handle EndOfFile f => def(f,nil)
+            val f = openFile uri
+            val (enc,f1) = detect f 
+         in (enc,f1)
+         end
    end
 
 (* stop of ../../Unicode/Decode/decode.sml *)
@@ -5159,171 +5159,171 @@
       val nullPosition = ("",0,0)
 
       datatype ExpItem = 
-	  EXP_CHAR of UniChar.Char
-	| EXP_DATA of UniChar.Data
-	| EXP_STRING of string
+          EXP_CHAR of UniChar.Char
+        | EXP_DATA of UniChar.Data
+        | EXP_STRING of string
       type Expected = ExpItem list 
       type Found = UniChar.Data
 
       datatype Location = 
-	  LOC_NONE
-	| LOC_AFTER_DTD
-	| LOC_ATT_DECL
-	| LOC_ATT_DEFAULT of Position
-	| LOC_ATT_VALUE
-	| LOC_CDATA
-	| LOC_CHOICE
-	| LOC_COMMENT
-	| LOC_CONTENT
-	| LOC_DECL
-	| LOC_DOC_DECL
-	| LOC_ELEM_DECL
-	| LOC_ENCODING
-	| LOC_ENT_DECL
-	| LOC_ENT_VALUE
-	| LOC_EPILOG
-	| LOC_ETAG
-	| LOC_IGNORED
-	| LOC_INCLUDED
-	| LOC_INT_DECL
-	| LOC_INT_SUBSET
-	| LOC_LITERAL
-	| LOC_MIXED
-	| LOC_NOT_DECL
-	| LOC_OUT_COND
-	| LOC_PROC
-	| LOC_PROLOG
-	| LOC_PUB_LIT
-	| LOC_SEQ
-	| LOC_STAG
-	| LOC_SUBSET
-	| LOC_SYS_LIT
-	| LOC_TEXT_DECL
-	| LOC_VERSION
-	| LOC_XML_DECL
+          LOC_NONE
+        | LOC_AFTER_DTD
+        | LOC_ATT_DECL
+        | LOC_ATT_DEFAULT of Position
+        | LOC_ATT_VALUE
+        | LOC_CDATA
+        | LOC_CHOICE
+        | LOC_COMMENT
+        | LOC_CONTENT
+        | LOC_DECL
+        | LOC_DOC_DECL
+        | LOC_ELEM_DECL
+        | LOC_ENCODING
+        | LOC_ENT_DECL
+        | LOC_ENT_VALUE
+        | LOC_EPILOG
+        | LOC_ETAG
+        | LOC_IGNORED
+        | LOC_INCLUDED
+        | LOC_INT_DECL
+        | LOC_INT_SUBSET
+        | LOC_LITERAL
+        | LOC_MIXED
+        | LOC_NOT_DECL
+        | LOC_OUT_COND
+        | LOC_PROC
+        | LOC_PROLOG
+        | LOC_PUB_LIT
+        | LOC_SEQ
+        | LOC_STAG
+        | LOC_SUBSET
+        | LOC_SYS_LIT
+        | LOC_TEXT_DECL
+        | LOC_VERSION
+        | LOC_XML_DECL
 
       datatype EntityClass =
-	  ENT_GENERAL
-	| ENT_PARAMETER
-	| ENT_EXTERNAL
-	| ENT_UNPARSED
+          ENT_GENERAL
+        | ENT_PARAMETER
+        | ENT_EXTERNAL
+        | ENT_UNPARSED
 
       datatype Item = 
-	  IT_ATT_NAME
-	| IT_CDATA
-	| IT_CHAR of UniChar.Char
-	| IT_CHAR_REF
-	| IT_COND
-	| IT_DATA of UniChar.Data
-	| IT_DECL
-	| IT_DTD
- 	| IT_ELEM
-	| IT_ENT_NAME
-	| IT_ETAG
-	| IT_GEN_ENT
-	| IT_ID_NAME
-	| IT_LANG_ID
-	| IT_NAME
-	| IT_NMTOKEN
-	| IT_NOT_NAME
-	| IT_NOTATION
-	| IT_PAR_ENT 
-	| IT_PAR_REF
-	| IT_REF
-	| IT_STAG
-	| IT_TARGET
+          IT_ATT_NAME
+        | IT_CDATA
+        | IT_CHAR of UniChar.Char
+        | IT_CHAR_REF
+        | IT_COND
+        | IT_DATA of UniChar.Data
+        | IT_DECL
+        | IT_DTD
+        | IT_ELEM
+        | IT_ENT_NAME
+        | IT_ETAG
+        | IT_GEN_ENT
+        | IT_ID_NAME
+        | IT_LANG_ID
+        | IT_NAME
+        | IT_NMTOKEN
+        | IT_NOT_NAME
+        | IT_NOTATION
+        | IT_PAR_ENT 
+        | IT_PAR_REF
+        | IT_REF
+        | IT_STAG
+        | IT_TARGET
 
       datatype Error = 
-	 (* syntax errors *)
-	  ERR_EMPTY of Location
-	| ERR_ENDED_BY_EE of Location
-	| ERR_EXPECTED of Expected * Found
-	| ERR_NON_XML_CHAR of UniChar.Char
-	| ERR_MISSING_WHITE
-	| ERR_NON_XML_CHARREF of UniChar.Char
+         (* syntax errors *)
+          ERR_EMPTY of Location
+        | ERR_ENDED_BY_EE of Location
+        | ERR_EXPECTED of Expected * Found
+        | ERR_NON_XML_CHAR of UniChar.Char
+        | ERR_MISSING_WHITE
+        | ERR_NON_XML_CHARREF of UniChar.Char
 
-	(* other well-formedness errors *)
-	| ERR_CANT_PARSE of Location
-	| ERR_ELEM_ENT_NESTING of UniChar.Data
-	| ERR_ELEM_TYPE_MATCH of UniChar.Data * UniChar.Data
-	| ERR_OMITTED_END_TAG of UniChar.Data
-	| ERR_IGNORED_END_TAG of UniChar.Data * UniChar.Data
-	| ERR_ENDED_IN_PROLOG
-	| ERR_FORBIDDEN_HERE of Item * Location
-	| ERR_ILLEGAL_ENTITY of EntityClass * UniChar.Data * Location 
-	| ERR_MULTIPLE_DTD
-	| ERR_MULT_ATT_SPEC of UniChar.Data
-	| ERR_RECURSIVE_ENTITY of EntityClass * UniChar.Data
-	| ERR_UNDEC_ENTITY of EntityClass * UniChar.Data
+        (* other well-formedness errors *)
+        | ERR_CANT_PARSE of Location
+        | ERR_ELEM_ENT_NESTING of UniChar.Data
+        | ERR_ELEM_TYPE_MATCH of UniChar.Data * UniChar.Data
+        | ERR_OMITTED_END_TAG of UniChar.Data
+        | ERR_IGNORED_END_TAG of UniChar.Data * UniChar.Data
+        | ERR_ENDED_IN_PROLOG
+        | ERR_FORBIDDEN_HERE of Item * Location
+        | ERR_ILLEGAL_ENTITY of EntityClass * UniChar.Data * Location 
+        | ERR_MULTIPLE_DTD
+        | ERR_MULT_ATT_SPEC of UniChar.Data
+        | ERR_RECURSIVE_ENTITY of EntityClass * UniChar.Data
+        | ERR_UNDEC_ENTITY of EntityClass * UniChar.Data
 
-	(* validity errors concerning attributes *)
-	| ERR_AT_LEAST_ONE of Item
-	| ERR_AT_MOST_ONE of Item
-	| ERR_ATT_IS_NOT of UniChar.Data * Item
-	| ERR_EXACTLY_ONE of Item
-	| ERR_FIXED_VALUE of UniChar.Data * UniChar.Vector * UniChar.Vector
-	| ERR_ID_DEFAULT
-	| ERR_MISSING_ATT of UniChar.Data
-	| ERR_MULT_ID_ELEM of UniChar.Data
-	| ERR_MUST_BE_AMONG of Item * UniChar.Data * UniChar.Data list
-	| ERR_MUST_BE_UNPARSED of UniChar.Data * Location
-	| ERR_REPEATED_ID of UniChar.Data
-	| ERR_UNDECL_ATT of UniChar.Data * UniChar.Data
-	| ERR_UNDECL_ID of UniChar.Data * Position list
+        (* validity errors concerning attributes *)
+        | ERR_AT_LEAST_ONE of Item
+        | ERR_AT_MOST_ONE of Item
+        | ERR_ATT_IS_NOT of UniChar.Data * Item
+        | ERR_EXACTLY_ONE of Item
+        | ERR_FIXED_VALUE of UniChar.Data * UniChar.Vector * UniChar.Vector
+        | ERR_ID_DEFAULT
+        | ERR_MISSING_ATT of UniChar.Data
+        | ERR_MULT_ID_ELEM of UniChar.Data
+        | ERR_MUST_BE_AMONG of Item * UniChar.Data * UniChar.Data list
+        | ERR_MUST_BE_UNPARSED of UniChar.Data * Location
+        | ERR_REPEATED_ID of UniChar.Data
+        | ERR_UNDECL_ATT of UniChar.Data * UniChar.Data
+        | ERR_UNDECL_ID of UniChar.Data * Position list
 
-	(* validity errors concerning elements *)
-	| ERR_BAD_ELEM of UniChar.Data * UniChar.Data
-	| ERR_ELEM_CONTENT of Item
-	| ERR_EMPTY_TAG of UniChar.Data
-	| ERR_ENDED_EARLY of UniChar.Data 
-	| ERR_MULT_MIXED of UniChar.Data 
-	| ERR_NONEMPTY of UniChar.Data
-	| ERR_REDEC_ELEM of UniChar.Data
-	| ERR_ROOT_ELEM of UniChar.Data * UniChar.Data
+        (* validity errors concerning elements *)
+        | ERR_BAD_ELEM of UniChar.Data * UniChar.Data
+        | ERR_ELEM_CONTENT of Item
+        | ERR_EMPTY_TAG of UniChar.Data
+        | ERR_ENDED_EARLY of UniChar.Data 
+        | ERR_MULT_MIXED of UniChar.Data 
+        | ERR_NONEMPTY of UniChar.Data
+        | ERR_REDEC_ELEM of UniChar.Data
+        | ERR_ROOT_ELEM of UniChar.Data * UniChar.Data
 
-	(* other validity errors *)
-	| ERR_DECL_ENT_NESTING of Location
-	| ERR_EE_INT_SUBSET 
-	| ERR_GROUP_ENT_NESTING of Location
- 	| ERR_NO_DTD
-	| ERR_STANDALONE_DEF of UniChar.Data
-	| ERR_STANDALONE_ELEM of UniChar.Data
-	| ERR_STANDALONE_ENT of EntityClass *UniChar.Data
-	| ERR_STANDALONE_NORM of UniChar.Data
-	| ERR_UNDECLARED of Item * UniChar.Data * Location
-	  
-	(* miscellaneous errors *)
-	| ERR_DECL_PREDEF of UniChar.Data * UniChar.Vector
-	| ERR_NO_SUCH_FILE of string * string
-	| ERR_RESERVED of UniChar.Data * Item
-	| ERR_VERSION of string
-	| ERR_XML_SPACE
+        (* other validity errors *)
+        | ERR_DECL_ENT_NESTING of Location
+        | ERR_EE_INT_SUBSET 
+        | ERR_GROUP_ENT_NESTING of Location
+        | ERR_NO_DTD
+        | ERR_STANDALONE_DEF of UniChar.Data
+        | ERR_STANDALONE_ELEM of UniChar.Data
+        | ERR_STANDALONE_ENT of EntityClass *UniChar.Data
+        | ERR_STANDALONE_NORM of UniChar.Data
+        | ERR_UNDECLARED of Item * UniChar.Data * Location
+          
+        (* miscellaneous errors *)
+        | ERR_DECL_PREDEF of UniChar.Data * UniChar.Vector
+        | ERR_NO_SUCH_FILE of string * string
+        | ERR_RESERVED of UniChar.Data * Item
+        | ERR_VERSION of string
+        | ERR_XML_SPACE
 
-	(* compatibility errors *)
-	| ERR_AMBIGUOUS of UniChar.Data * int * int
-	| ERR_MUST_ESCAPE of UniChar.Char
+        (* compatibility errors *)
+        | ERR_AMBIGUOUS of UniChar.Data * int * int
+        | ERR_MUST_ESCAPE of UniChar.Char
 
-	(* interoperability errors *)
-	| ERR_EMPTY_TAG_INTER of UniChar.Data
-	| ERR_MUST_BE_EMPTY of UniChar.Data 
+        (* interoperability errors *)
+        | ERR_EMPTY_TAG_INTER of UniChar.Data
+        | ERR_MUST_BE_EMPTY of UniChar.Data 
 
-	(* decoding errors *)
-	| ERR_DECODE_ERROR of Decode.Error.DecodeError
+        (* decoding errors *)
+        | ERR_DECODE_ERROR of Decode.Error.DecodeError
 
       datatype Warning = 
-	  WARN_NO_XML_DECL
+          WARN_NO_XML_DECL
 
-	| WARN_MULT_DECL of Item * UniChar.Data
-	| WARN_SHOULD_DECLARE of UniChar.Data list
+        | WARN_MULT_DECL of Item * UniChar.Data
+        | WARN_SHOULD_DECLARE of UniChar.Data list
 
-	| WARN_ATT_UNDEC_ELEM of UniChar.Data
-	| WARN_MULT_ATT_DECL of UniChar.Data
-	| WARN_MULT_ATT_DEF of UniChar.Data * UniChar.Data
-	| WARN_ENUM_ATTS of UniChar.Data * UniChar.Data list
+        | WARN_ATT_UNDEC_ELEM of UniChar.Data
+        | WARN_MULT_ATT_DECL of UniChar.Data
+        | WARN_MULT_ATT_DEF of UniChar.Data * UniChar.Data
+        | WARN_ENUM_ATTS of UniChar.Data * UniChar.Data list
 
-	| WARN_DFA_TOO_LARGE of UniChar.Data * int
+        | WARN_DFA_TOO_LARGE of UniChar.Data * int
        
-	| WARN_NON_ASCII_URI of UniChar.Char
+        | WARN_NON_ASCII_URI of UniChar.Char
    end
 (* stop of ../../Parser/Error/errorData.sml *)
 (* start of ../../Parser/Error/errorString.sml *)
@@ -5368,21 +5368,21 @@
 structure ErrorString : ErrorString =
    struct
       open
-	 ErrorData UniChar UtilString
-	 
+         ErrorData UniChar UtilString
+         
 
       fun errorChar2String c = 
-	 case c
-	   of 0wx9 => "\\t"
-	    | 0wxA => "\\n"
-	    | _ => if c>=0wx20 andalso c<0wx100 then String.implode [Char2char c]
-		   else "U+"^UtilString.toUpperString
-		      (StringCvt.padLeft #"0" 4 (Chars.toString c))
+         case c
+           of 0wx9 => "\\t"
+            | 0wxA => "\\n"
+            | _ => if c>=0wx20 andalso c<0wx100 then String.implode [Char2char c]
+                   else "U+"^UtilString.toUpperString
+                      (StringCvt.padLeft #"0" 4 (Chars.toString c))
 
       fun errorData2String cs = 
-	 String.concat (map errorChar2String cs)
+         String.concat (map errorChar2String cs)
       fun errorVector2String vec = 
-	 errorData2String (Vector.foldr (op ::) nil vec)
+         errorData2String (Vector.foldr (op ::) nil vec)
       
       val QUOTE = "'"
       fun quoteErrorChar0 c = QUOTE^errorChar2String c^QUOTE
@@ -5392,118 +5392,118 @@
       fun quoteErrorVector v = QUOTE^errorVector2String v^QUOTE
 
       fun Position2String (fname,l,c) = 
-	 if fname="" then "" 
-	 else String.concat ["[",fname,":",Int2String l,".",Int2String c,"]"]
+         if fname="" then "" 
+         else String.concat ["[",fname,":",Int2String l,".",Int2String c,"]"]
 
       fun ExpItem2String exp =
-	 case exp
-	   of EXP_CHAR c => quoteErrorChar c
-	    | EXP_DATA cs => quoteErrorData cs
-	    | EXP_STRING s => s
+         case exp
+           of EXP_CHAR c => quoteErrorChar c
+            | EXP_DATA cs => quoteErrorData cs
+            | EXP_STRING s => s
 
       fun Expected2String exp =
-	 case exp 
-	   of nil => "nothing"
-	    | [one] => ExpItem2String one
-	    | _ => let val l=List.length exp 
-		   in List2xString ("",", ","") ExpItem2String (List.take (exp,l-1))
-		      ^" or "^ExpItem2String (List.last exp)
-		   end
+         case exp 
+           of nil => "nothing"
+            | [one] => ExpItem2String one
+            | _ => let val l=List.length exp 
+                   in List2xString ("",", ","") ExpItem2String (List.take (exp,l-1))
+                      ^" or "^ExpItem2String (List.last exp)
+                   end
       fun Found2String fnd =
-	 case fnd
-	   of [0wx0] => "entity end"
-	    | cs => quoteErrorData cs
+         case fnd
+           of [0wx0] => "entity end"
+            | cs => quoteErrorData cs
 
       fun Location2String loc =
-	 case loc
-	   of LOC_NONE => "nothing"
-	    | LOC_AFTER_DTD => "document instance"
-	    | LOC_ATT_DECL => "attribute list declaration"
-	    | LOC_ATT_DEFAULT pos => "default value declared at "^Position2String pos
-	    | LOC_ATT_VALUE => "attribute value"
-	    | LOC_CDATA => "CDATA section"
-	    | LOC_CHOICE => "choice list"
-	    | LOC_COMMENT => "comment"
-	    | LOC_CONTENT => "content"
-	    | LOC_DECL => "declaration"
-	    | LOC_DOC_DECL => "document type declaration"
-	    | LOC_ELEM_DECL => "element type declaration"
-	    | LOC_ENCODING => "encoding name"
-	    | LOC_ENT_DECL => "entity declaration"
-	    | LOC_ENT_VALUE => "entity value"
-	    | LOC_EPILOG => "epilog"
-	    | LOC_ETAG => "end-tag"
-	    | LOC_IGNORED => "ignored section"
-	    | LOC_INCLUDED => "included section"
-	    | LOC_INT_DECL => "declaration in the internal subset"
-	    | LOC_INT_SUBSET => "internal subset"
-	    | LOC_LITERAL => "literal"
-	    | LOC_MIXED => "Mixed list"
-	    | LOC_NOT_DECL => "notation declaration"
-	    | LOC_OUT_COND => "outside a conditional section"
-	    | LOC_PROLOG => "prolog"
-	    | LOC_PROC => "processing instruction"
-	    | LOC_PUB_LIT => "public identifier"
-	    | LOC_SEQ => "sequence list"
-	    | LOC_STAG => "start-tag"
-	    | LOC_SUBSET => "declaration subset"
-	    | LOC_SYS_LIT => "system identifier"
-	    | LOC_TEXT_DECL => "text declaration"
-	    | LOC_VERSION => "version number"
-	    | LOC_XML_DECL => "XML declaration"
+         case loc
+           of LOC_NONE => "nothing"
+            | LOC_AFTER_DTD => "document instance"
+            | LOC_ATT_DECL => "attribute list declaration"
+            | LOC_ATT_DEFAULT pos => "default value declared at "^Position2String pos
+            | LOC_ATT_VALUE => "attribute value"
+            | LOC_CDATA => "CDATA section"
+            | LOC_CHOICE => "choice list"
+            | LOC_COMMENT => "comment"
+            | LOC_CONTENT => "content"
+            | LOC_DECL => "declaration"
+            | LOC_DOC_DECL => "document type declaration"
+            | LOC_ELEM_DECL => "element type declaration"
+            | LOC_ENCODING => "encoding name"
+            | LOC_ENT_DECL => "entity declaration"
+            | LOC_ENT_VALUE => "entity value"
+            | LOC_EPILOG => "epilog"
+            | LOC_ETAG => "end-tag"
+            | LOC_IGNORED => "ignored section"
+            | LOC_INCLUDED => "included section"
+            | LOC_INT_DECL => "declaration in the internal subset"
+            | LOC_INT_SUBSET => "internal subset"
+            | LOC_LITERAL => "literal"
+            | LOC_MIXED => "Mixed list"
+            | LOC_NOT_DECL => "notation declaration"
+            | LOC_OUT_COND => "outside a conditional section"
+            | LOC_PROLOG => "prolog"
+            | LOC_PROC => "processing instruction"
+            | LOC_PUB_LIT => "public identifier"
+            | LOC_SEQ => "sequence list"
+            | LOC_STAG => "start-tag"
+            | LOC_SUBSET => "declaration subset"
+            | LOC_SYS_LIT => "system identifier"
+            | LOC_TEXT_DECL => "text declaration"
+            | LOC_VERSION => "version number"
+            | LOC_XML_DECL => "XML declaration"
       fun InLocation2String loc =
-	 case loc
-	   of LOC_NONE => ""
-	    | LOC_AFTER_DTD => "after the DTD"
-	    | LOC_CONTENT => "in content"
-	    | LOC_ATT_DEFAULT pos => "in default value declared at "^Position2String pos
-	    | LOC_DOC_DECL => "in the document type declaration"
-	    | LOC_EPILOG => "after the root element"
-	    | LOC_INT_SUBSET => "in the internal subset"
-	    | LOC_OUT_COND => "outside a conditional section"
-	    | LOC_PROLOG => "in prolog"
-	    | LOC_SUBSET => "in the declaration subset"
-	    | LOC_XML_DECL => "in the XML declaration"
-	    | _ => "in "^prependAnA (Location2String loc)
+         case loc
+           of LOC_NONE => ""
+            | LOC_AFTER_DTD => "after the DTD"
+            | LOC_CONTENT => "in content"
+            | LOC_ATT_DEFAULT pos => "in default value declared at "^Position2String pos
+            | LOC_DOC_DECL => "in the document type declaration"
+            | LOC_EPILOG => "after the root element"
+            | LOC_INT_SUBSET => "in the internal subset"
+            | LOC_OUT_COND => "outside a conditional section"
+            | LOC_PROLOG => "in prolog"
+            | LOC_SUBSET => "in the declaration subset"
+            | LOC_XML_DECL => "in the XML declaration"
+            | _ => "in "^prependAnA (Location2String loc)
 
       fun EntityClass2String ent =
-	 case ent
-	   of ENT_GENERAL => "general"
-	    | ENT_PARAMETER => "parameter"
-	    | ENT_UNPARSED => "unparsed"
-	    | ENT_EXTERNAL => "external"
+         case ent
+           of ENT_GENERAL => "general"
+            | ENT_PARAMETER => "parameter"
+            | ENT_UNPARSED => "unparsed"
+            | ENT_EXTERNAL => "external"
 
       fun Item2String item =
-	 case item 
-	   of IT_ATT_NAME => "attribute name"
-	    | IT_CDATA => "CDATA section"
-	    | IT_CHAR c => "character "^quoteErrorChar c
-	    | IT_CHAR_REF => "character reference"
-	    | IT_COND => "conditional section"
-	    | IT_DATA cs => if null cs then "character data" else quoteErrorData cs
-	    | IT_DECL => "declaration"
-	    | IT_DTD => "document type declaration"
-	    | IT_ELEM => "element type"
-	    | IT_ENT_NAME => "entity name"
-	    | IT_ETAG => "end-tag"
-	    | IT_GEN_ENT => "general entity"
-	    | IT_ID_NAME => "ID name"
-	    | IT_LANG_ID => "language identifier"
-	    | IT_NAME => "name"
-	    | IT_NMTOKEN => "name token"
-	    | IT_NOT_NAME => "notation name"
-	    | IT_NOTATION => "notation"
-	    | IT_PAR_ENT => "parameter entity"
-	    | IT_PAR_REF => "parameter entity reference" 
-	    | IT_REF => "reference"
-	    | IT_STAG => "start-tag"
-	    | IT_TARGET => "target name"
+         case item 
+           of IT_ATT_NAME => "attribute name"
+            | IT_CDATA => "CDATA section"
+            | IT_CHAR c => "character "^quoteErrorChar c
+            | IT_CHAR_REF => "character reference"
+            | IT_COND => "conditional section"
+            | IT_DATA cs => if null cs then "character data" else quoteErrorData cs
+            | IT_DECL => "declaration"
+            | IT_DTD => "document type declaration"
+            | IT_ELEM => "element type"
+            | IT_ENT_NAME => "entity name"
+            | IT_ETAG => "end-tag"
+            | IT_GEN_ENT => "general entity"
+            | IT_ID_NAME => "ID name"
+            | IT_LANG_ID => "language identifier"
+            | IT_NAME => "name"
+            | IT_NMTOKEN => "name token"
+            | IT_NOT_NAME => "notation name"
+            | IT_NOTATION => "notation"
+            | IT_PAR_ENT => "parameter entity"
+            | IT_PAR_REF => "parameter entity reference" 
+            | IT_REF => "reference"
+            | IT_STAG => "start-tag"
+            | IT_TARGET => "target name"
 
       fun AnItem2String item =
-	 case item 
-	   of IT_CHAR c => Item2String item
-	    | IT_DATA cs => Item2String item
-	    | _ => prependAnA (Item2String item) 
+         case item 
+           of IT_CHAR c => Item2String item
+            | IT_DATA cs => Item2String item
+            | _ => prependAnA (Item2String item) 
    end
    
 (* stop of ../../Parser/Error/errorString.sml *)
@@ -5525,9 +5525,9 @@
 structure ErrorMessage : ErrorMessage =
    struct
       open 
-	 Decode
-	 UtilString
-	 ErrorData ErrorString
+         Decode
+         UtilString
+         ErrorData ErrorString
 
       val quoteChar0  = quoteErrorChar0
       val quoteChar   = quoteErrorChar
@@ -5536,182 +5536,182 @@
       val quoteVector = quoteErrorVector
 
       fun errorMessage err =
-	 case err
-	   (* syntax errors *)
-	   of ERR_EMPTY loc => ["Empty",Location2String loc]
-	    | ERR_ENDED_BY_EE loc => [toUpperFirst (Location2String loc),"ended by entity end"]
-	    | ERR_EXPECTED (exp,found) => 
-	      ["Expected",Expected2String exp,"but found",Found2String found]	      
-	    | ERR_MISSING_WHITE => ["Missing white space"]
-	    | ERR_NON_XML_CHAR c => ["Non-XML character",quoteChar0 c]
-	    | ERR_NON_XML_CHARREF c => ["Reference to non-XML character",quoteChar0 c]
+         case err
+           (* syntax errors *)
+           of ERR_EMPTY loc => ["Empty",Location2String loc]
+            | ERR_ENDED_BY_EE loc => [toUpperFirst (Location2String loc),"ended by entity end"]
+            | ERR_EXPECTED (exp,found) => 
+              ["Expected",Expected2String exp,"but found",Found2String found]         
+            | ERR_MISSING_WHITE => ["Missing white space"]
+            | ERR_NON_XML_CHAR c => ["Non-XML character",quoteChar0 c]
+            | ERR_NON_XML_CHARREF c => ["Reference to non-XML character",quoteChar0 c]
 
-	    (* other well-formedness errors *)
-	    | ERR_CANT_PARSE loc => ["Cannot parse",Location2String loc]
-	    | ERR_ELEM_ENT_NESTING elem => 	       
-	      ["The first and last character of element",quoteData elem,
-	       "are in different entities"]  
-	    | ERR_ELEM_TYPE_MATCH (elem,other) => 
-	      ["Element",quoteData elem,"was ended by an end-tag for",quoteData other]
-	    | ERR_IGNORED_END_TAG(elem,other) =>
-	      ["An end-tag for element type",quoteData other,"is not allowed in the",
-	       "content of element",quoteData elem]
-	    | ERR_OMITTED_END_TAG elem =>
-	      ["Element",quoteData elem,"has no end-tag"]
-	    | ERR_ENDED_IN_PROLOG => ["Document entity ended in prolog"]
-	    | ERR_FORBIDDEN_HERE(what,loc) => 
-	      [AnItem2String what,"is not allowed",InLocation2String loc]
-	    | ERR_ILLEGAL_ENTITY(what,ent,loc) => 
-	      ["Reference to",EntityClass2String what,"entity",quoteData ent,InLocation2String loc]
-	    | ERR_MULTIPLE_DTD => ["Repeated document type declaration"]
-	    | ERR_MULT_ATT_SPEC att => 
-	      ["A value for attribute",quoteData att,"was already specified in this tag"]
-	    | ERR_RECURSIVE_ENTITY(what,ent) =>
-	      ["Reference to",EntityClass2String what,"entity",quoteData ent,
-	       "that is already open"]
-	    | ERR_UNDEC_ENTITY(what,ent) => 
-	      ["Reference to undeclared",EntityClass2String what,"entity",quoteData ent]
-	      
-	    (* validity errors concerning attributes *)
-	    | ERR_AT_LEAST_ONE what => ["At least one",Item2String what,"must be specified"] 
-	    | ERR_AT_MOST_ONE what => ["Only one",Item2String what,"may be specified"] 
-	    | ERR_ATT_IS_NOT(cs,what) => [quoteData cs,"is not",AnItem2String what] 
-	    | ERR_EXACTLY_ONE what => [toUpperFirst (AnItem2String what),"must be specified"]
-	    | ERR_FIXED_VALUE(att,value,fixed) => 
-	      ["Attribute",quoteData att,"has the value",quoteVector value,
-	       "but was declared with a fixed default value of",quoteVector fixed]
-	    | ERR_ID_DEFAULT => 
-	      ["An ID attribute must have a default value of #IMPLIED or #REQUIRED"]
-	    | ERR_MISSING_ATT att => 
-	      ["No value was specified for required attribute",quoteData att] 
-	    | ERR_MULT_ID_ELEM elem => 
-	      ["Element type",quoteData elem,"already has an ID attribute"]
-	    | ERR_MUST_BE_AMONG (what,x,ys) => 
-	      [toUpperFirst (Item2String what),quoteData x,"is none of",
-	       List2xString ("",",","") quoteData ys]
-	    | ERR_MUST_BE_UNPARSED (name,loc) => 
-	      [quoteData name,InLocation2String loc,"is not the name of an unparsed entity"]
-	    | ERR_REPEATED_ID name => 
-	      ["ID name",quoteData name,"already occurred as an attribute value"]
-	    | ERR_UNDECL_ATT(att,elem) => 
-	      ["Attribute",quoteData att,"was not declared for element type",quoteData elem]
-	    | ERR_UNDECL_ID(name,refs) => 
-	      (if null refs then ["Reference to non-existent ID",quoteData name]
-	       else ["Reference to non-existent ID",quoteData name,
-		     "(also referenced at",List2xString ("",", ",")") Position2String refs])
+            (* other well-formedness errors *)
+            | ERR_CANT_PARSE loc => ["Cannot parse",Location2String loc]
+            | ERR_ELEM_ENT_NESTING elem =>             
+              ["The first and last character of element",quoteData elem,
+               "are in different entities"]  
+            | ERR_ELEM_TYPE_MATCH (elem,other) => 
+              ["Element",quoteData elem,"was ended by an end-tag for",quoteData other]
+            | ERR_IGNORED_END_TAG(elem,other) =>
+              ["An end-tag for element type",quoteData other,"is not allowed in the",
+               "content of element",quoteData elem]
+            | ERR_OMITTED_END_TAG elem =>
+              ["Element",quoteData elem,"has no end-tag"]
+            | ERR_ENDED_IN_PROLOG => ["Document entity ended in prolog"]
+            | ERR_FORBIDDEN_HERE(what,loc) => 
+              [AnItem2String what,"is not allowed",InLocation2String loc]
+            | ERR_ILLEGAL_ENTITY(what,ent,loc) => 
+              ["Reference to",EntityClass2String what,"entity",quoteData ent,InLocation2String loc]
+            | ERR_MULTIPLE_DTD => ["Repeated document type declaration"]
+            | ERR_MULT_ATT_SPEC att => 
+              ["A value for attribute",quoteData att,"was already specified in this tag"]
+            | ERR_RECURSIVE_ENTITY(what,ent) =>
+              ["Reference to",EntityClass2String what,"entity",quoteData ent,
+               "that is already open"]
+            | ERR_UNDEC_ENTITY(what,ent) => 
+              ["Reference to undeclared",EntityClass2String what,"entity",quoteData ent]
+              
+            (* validity errors concerning attributes *)
+            | ERR_AT_LEAST_ONE what => ["At least one",Item2String what,"must be specified"] 
+            | ERR_AT_MOST_ONE what => ["Only one",Item2String what,"may be specified"] 
+            | ERR_ATT_IS_NOT(cs,what) => [quoteData cs,"is not",AnItem2String what] 
+            | ERR_EXACTLY_ONE what => [toUpperFirst (AnItem2String what),"must be specified"]
+            | ERR_FIXED_VALUE(att,value,fixed) => 
+              ["Attribute",quoteData att,"has the value",quoteVector value,
+               "but was declared with a fixed default value of",quoteVector fixed]
+            | ERR_ID_DEFAULT => 
+              ["An ID attribute must have a default value of #IMPLIED or #REQUIRED"]
+            | ERR_MISSING_ATT att => 
+              ["No value was specified for required attribute",quoteData att] 
+            | ERR_MULT_ID_ELEM elem => 
+              ["Element type",quoteData elem,"already has an ID attribute"]
+            | ERR_MUST_BE_AMONG (what,x,ys) => 
+              [toUpperFirst (Item2String what),quoteData x,"is none of",
+               List2xString ("",",","") quoteData ys]
+            | ERR_MUST_BE_UNPARSED (name,loc) => 
+              [quoteData name,InLocation2String loc,"is not the name of an unparsed entity"]
+            | ERR_REPEATED_ID name => 
+              ["ID name",quoteData name,"already occurred as an attribute value"]
+            | ERR_UNDECL_ATT(att,elem) => 
+              ["Attribute",quoteData att,"was not declared for element type",quoteData elem]
+            | ERR_UNDECL_ID(name,refs) => 
+              (if null refs then ["Reference to non-existent ID",quoteData name]
+               else ["Reference to non-existent ID",quoteData name,
+                     "(also referenced at",List2xString ("",", ",")") Position2String refs])
 
-	    (* validity errors concerning elements *)
-	    | ERR_BAD_ELEM (curr,elem) => 
-	      ["Element type",quoteData elem,"not allowed at this point",
-	       "in the content of element",quoteData curr] 
-	    | ERR_ELEM_CONTENT what => 
-	      [toUpperFirst (AnItem2String what),"is not allowed in element content"] 
-	    | ERR_EMPTY_TAG elem => 	 
-	      ["Empty-element tag for element type",quoteData elem,
-	       "whose content model requires non-empty content"]
-	    | ERR_ENDED_EARLY elem =>
-	      ["Element",quoteData elem,"ended before its content was completed"]
-	    | ERR_MULT_MIXED elem =>
-	      ["Element type",quoteData elem,"already occurred in this mixed-content declaration"]
-	    | ERR_NONEMPTY elem =>  
-	      ["The end-tag for element",quoteData elem,"with declared EMPTY content",
-	       "must follow immediately after its start-tag"]
-	    | ERR_REDEC_ELEM elem => ["Element type",quoteData elem,"was already declared"]
-	    | ERR_ROOT_ELEM (dec,root) => 
-	      ["Document element",quoteData root,"does not match the name",
-	       quoteData dec,"in the document type declaration"]
+            (* validity errors concerning elements *)
+            | ERR_BAD_ELEM (curr,elem) => 
+              ["Element type",quoteData elem,"not allowed at this point",
+               "in the content of element",quoteData curr] 
+            | ERR_ELEM_CONTENT what => 
+              [toUpperFirst (AnItem2String what),"is not allowed in element content"] 
+            | ERR_EMPTY_TAG elem =>      
+              ["Empty-element tag for element type",quoteData elem,
+               "whose content model requires non-empty content"]
+            | ERR_ENDED_EARLY elem =>
+              ["Element",quoteData elem,"ended before its content was completed"]
+            | ERR_MULT_MIXED elem =>
+              ["Element type",quoteData elem,"already occurred in this mixed-content declaration"]
+            | ERR_NONEMPTY elem =>  
+              ["The end-tag for element",quoteData elem,"with declared EMPTY content",
+               "must follow immediately after its start-tag"]
+            | ERR_REDEC_ELEM elem => ["Element type",quoteData elem,"was already declared"]
+            | ERR_ROOT_ELEM (dec,root) => 
+              ["Document element",quoteData root,"does not match the name",
+               quoteData dec,"in the document type declaration"]
 
-	    (* other validity errors *)
-	    | ERR_DECL_ENT_NESTING loc => 
-	      ["The first and last character of this",Location2String loc,
-	       "are not in the same entity replacement text"]  
-	    | ERR_EE_INT_SUBSET =>
-	      ["An entity end is not allowed in a declaration in the internal subset"]
-	    | ERR_GROUP_ENT_NESTING loc => 
-	      ["The opening and closing parentheses of this",Location2String loc,
-	       "are not in the same entity replacement text"]  
-	    | ERR_NO_DTD => 
-	      ["There is no document type declaration. Switching to semi-validating mode",
-	       "(will not check for declaredness of entities, elements, etc.)"]
-	    | ERR_STANDALONE_DEF att => 
-	      ["Externally declared attribute",quoteData att,"was defaulted,",
-	       "although the standalone declaration is",quoteString "yes"]
-	    | ERR_STANDALONE_ELEM elem => 
-	      ["White space occurred in the content of externally declared",
-	       "element",quoteData elem,"with declared element content",
-	       "although the standalone declaration is",quoteString "yes"]
-	    | ERR_STANDALONE_ENT(what,ent) => 
-	      ["Reference to externally declared",EntityClass2String what,"entity",
-	       quoteData ent^",","although the standalone declaration is",quoteString "yes"]
-	    | ERR_STANDALONE_NORM att => 
-	      ["The value for externally declared attribute",
-	       quoteData att,"was changed as a result of normalization,",
-	       "although the standalone declaration is",quoteString "yes"]
-	    | ERR_UNDECLARED (what,x,loc) =>
-	      ["Undeclared",Item2String what,quoteData x,InLocation2String loc]
+            (* other validity errors *)
+            | ERR_DECL_ENT_NESTING loc => 
+              ["The first and last character of this",Location2String loc,
+               "are not in the same entity replacement text"]  
+            | ERR_EE_INT_SUBSET =>
+              ["An entity end is not allowed in a declaration in the internal subset"]
+            | ERR_GROUP_ENT_NESTING loc => 
+              ["The opening and closing parentheses of this",Location2String loc,
+               "are not in the same entity replacement text"]  
+            | ERR_NO_DTD => 
+              ["There is no document type declaration. Switching to semi-validating mode",
+               "(will not check for declaredness of entities, elements, etc.)"]
+            | ERR_STANDALONE_DEF att => 
+              ["Externally declared attribute",quoteData att,"was defaulted,",
+               "although the standalone declaration is",quoteString "yes"]
+            | ERR_STANDALONE_ELEM elem => 
+              ["White space occurred in the content of externally declared",
+               "element",quoteData elem,"with declared element content",
+               "although the standalone declaration is",quoteString "yes"]
+            | ERR_STANDALONE_ENT(what,ent) => 
+              ["Reference to externally declared",EntityClass2String what,"entity",
+               quoteData ent^",","although the standalone declaration is",quoteString "yes"]
+            | ERR_STANDALONE_NORM att => 
+              ["The value for externally declared attribute",
+               quoteData att,"was changed as a result of normalization,",
+               "although the standalone declaration is",quoteString "yes"]
+            | ERR_UNDECLARED (what,x,loc) =>
+              ["Undeclared",Item2String what,quoteData x,InLocation2String loc]
 
-	    (* miscellaneous errors *)
-	    | ERR_DECL_PREDEF(ent,def) => 
-	      ["General entity",quoteData ent,"must be declared as internal entity",
-	       "with replacement text",quoteVector def]
-	    | ERR_NO_SUCH_FILE(f,msg) => ["Could not open file",quoteString f,"("^msg^")"]
-	    | ERR_RESERVED(name,what) =>
-	      [quoteData name,"is reserved for standardization and therefore not allowed as",
-	       AnItem2String what]
-	    | ERR_VERSION version => 
-	      ["XML version",quoteString version,"is not supported"]
-	    | ERR_XML_SPACE => 
-	      ["Attribute",quoteString "xml:space","must be given an enumeration type",
-	       "with values",quoteString "default","and",quoteString "preserve","only"]
+            (* miscellaneous errors *)
+            | ERR_DECL_PREDEF(ent,def) => 
+              ["General entity",quoteData ent,"must be declared as internal entity",
+               "with replacement text",quoteVector def]
+            | ERR_NO_SUCH_FILE(f,msg) => ["Could not open file",quoteString f,"("^msg^")"]
+            | ERR_RESERVED(name,what) =>
+              [quoteData name,"is reserved for standardization and therefore not allowed as",
+               AnItem2String what]
+            | ERR_VERSION version => 
+              ["XML version",quoteString version,"is not supported"]
+            | ERR_XML_SPACE => 
+              ["Attribute",quoteString "xml:space","must be given an enumeration type",
+               "with values",quoteString "default","and",quoteString "preserve","only"]
 
-	    (* compatibility errors *)
-	    | ERR_AMBIGUOUS(a,n1,n2) => 	       
-	      ["Content model is ambiguous: conflict between the",numberNth n1,
-	       "and the",numberNth n2,"occurrence of element",quoteData a^".",
-	       "Using an approximation instead"]
-	    | ERR_MUST_ESCAPE c => ["Character",quoteChar c,"must be escaped for compatibility"]
+            (* compatibility errors *)
+            | ERR_AMBIGUOUS(a,n1,n2) =>                
+              ["Content model is ambiguous: conflict between the",numberNth n1,
+               "and the",numberNth n2,"occurrence of element",quoteData a^".",
+               "Using an approximation instead"]
+            | ERR_MUST_ESCAPE c => ["Character",quoteChar c,"must be escaped for compatibility"]
 
-	    (* interoperability errors *)
-	    | ERR_EMPTY_TAG_INTER elem =>
-	      ["Empty-element tag for element",quoteData elem,"with non-EMPTY declared content"]
-	    | ERR_MUST_BE_EMPTY elem => 
-	      ["An empty-element tag must be used for element type",
-	       quoteData elem,"with EMPTY declared content"]
+            (* interoperability errors *)
+            | ERR_EMPTY_TAG_INTER elem =>
+              ["Empty-element tag for element",quoteData elem,"with non-EMPTY declared content"]
+            | ERR_MUST_BE_EMPTY elem => 
+              ["An empty-element tag must be used for element type",
+               quoteData elem,"with EMPTY declared content"]
 
-	    (* decoding errors *) 
-	    | ERR_DECODE_ERROR err => "Decoding error:"::Decode.Error.decodeMessage err
+            (* decoding errors *) 
+            | ERR_DECODE_ERROR err => "Decoding error:"::Decode.Error.decodeMessage err
 
       fun warningMessage warn =
-	 case warn
-	   of WARN_NO_XML_DECL => ["Document entity has no XML declaration"]
+         case warn
+           of WARN_NO_XML_DECL => ["Document entity has no XML declaration"]
 
-	    | WARN_MULT_DECL(what,name) => 
-	      ["Repeated declaration for",Item2String what,quoteData name]
-	    | WARN_SHOULD_DECLARE(ents) =>
-	      let val (one,more) = (hd ents,tl ents)
-	      in case more 
-		   of nil => ["The predefined entity",quoteData one,"should have been declared"]
-		    | _ => ["The predefined entities",List2xString ("",", ","") quoteData more,
-			    "and",quoteData one,"should have been declared"]
-	      end
-	   
-	    | WARN_ATT_UNDEC_ELEM elem =>
-	      ["Attribute-list declaration for undeclared element type",quoteData elem]
-	    | WARN_MULT_ATT_DECL elem => 
-	      ["Repeated attribute-list declaration for element type",quoteData elem]
-	    | WARN_MULT_ATT_DEF(elem,att) =>
-	      ["Repeated definition of attribute",quoteData att,"for element type",quoteData elem]
-	    | WARN_ENUM_ATTS(elem,names) =>
-	      ["The following name tokens occur more than once in the enumerated attribute",
-	       "types of element",quoteData elem^":",List2xString ("",", ","") quoteData names]
+            | WARN_MULT_DECL(what,name) => 
+              ["Repeated declaration for",Item2String what,quoteData name]
+            | WARN_SHOULD_DECLARE(ents) =>
+              let val (one,more) = (hd ents,tl ents)
+              in case more 
+                   of nil => ["The predefined entity",quoteData one,"should have been declared"]
+                    | _ => ["The predefined entities",List2xString ("",", ","") quoteData more,
+                            "and",quoteData one,"should have been declared"]
+              end
+           
+            | WARN_ATT_UNDEC_ELEM elem =>
+              ["Attribute-list declaration for undeclared element type",quoteData elem]
+            | WARN_MULT_ATT_DECL elem => 
+              ["Repeated attribute-list declaration for element type",quoteData elem]
+            | WARN_MULT_ATT_DEF(elem,att) =>
+              ["Repeated definition of attribute",quoteData att,"for element type",quoteData elem]
+            | WARN_ENUM_ATTS(elem,names) =>
+              ["The following name tokens occur more than once in the enumerated attribute",
+               "types of element",quoteData elem^":",List2xString ("",", ","") quoteData names]
 
-	    | WARN_DFA_TOO_LARGE (elem,max) =>
-	      ["The finite state machine for the content model of element type",
-	       quoteData elem,"would have more than the maximal allowed number of",
-	       Int2String max,"states. Using an approximation instead"]
+            | WARN_DFA_TOO_LARGE (elem,max) =>
+              ["The finite state machine for the content model of element type",
+               quoteData elem,"would have more than the maximal allowed number of",
+               Int2String max,"states. Using an approximation instead"]
 
-	    | WARN_NON_ASCII_URI c =>
-	      ["System identifier contains non-ASCII character",quoteChar c]
+            | WARN_NON_ASCII_URI c =>
+              ["System identifier contains non-ASCII character",quoteChar c]
 
    end
 (* stop of ../../Parser/Error/errorMessage.sml *)
@@ -5732,74 +5732,74 @@
       open ErrorData
 
       fun isDecodeError err =
-	 case err
-	   of ERR_DECODE_ERROR _ => true
-	    | _                  => false
+         case err
+           of ERR_DECODE_ERROR _ => true
+            | _                  => false
 
       fun isSyntaxError err = 
-	 case err
-	   of ERR_EMPTY _           => true
-	    | ERR_ENDED_BY_EE _     => true
-	    | ERR_EXPECTED _        => true
-	    | ERR_MISSING_WHITE     => true
-	    | ERR_NON_XML_CHAR _    => true
-	    | ERR_NON_XML_CHARREF _ => true
-	    | _                     => false
+         case err
+           of ERR_EMPTY _           => true
+            | ERR_ENDED_BY_EE _     => true
+            | ERR_EXPECTED _        => true
+            | ERR_MISSING_WHITE     => true
+            | ERR_NON_XML_CHAR _    => true
+            | ERR_NON_XML_CHARREF _ => true
+            | _                     => false
 
       fun isWellFormedError err =
-	 case err
-	   of ERR_CANT_PARSE _       => true
-	    | ERR_ELEM_ENT_NESTING _ => true
-	    | ERR_ELEM_TYPE_MATCH _  => true
-	    | ERR_OMITTED_END_TAG _  => true
-	    | ERR_IGNORED_END_TAG _  => true
-	    | ERR_ENDED_IN_PROLOG    => true
-	    | ERR_FORBIDDEN_HERE _   => true
-	    | ERR_ILLEGAL_ENTITY _   => true
-	    | ERR_MULTIPLE_DTD       => true
-	    | ERR_MULT_ATT_SPEC _    => true
-	    | ERR_RECURSIVE_ENTITY _ => true
-	    | ERR_UNDEC_ENTITY _     => true 
-	    | _ => isSyntaxError err 
+         case err
+           of ERR_CANT_PARSE _       => true
+            | ERR_ELEM_ENT_NESTING _ => true
+            | ERR_ELEM_TYPE_MATCH _  => true
+            | ERR_OMITTED_END_TAG _  => true
+            | ERR_IGNORED_END_TAG _  => true
+            | ERR_ENDED_IN_PROLOG    => true
+            | ERR_FORBIDDEN_HERE _   => true
+            | ERR_ILLEGAL_ENTITY _   => true
+            | ERR_MULTIPLE_DTD       => true
+            | ERR_MULT_ATT_SPEC _    => true
+            | ERR_RECURSIVE_ENTITY _ => true
+            | ERR_UNDEC_ENTITY _     => true 
+            | _ => isSyntaxError err 
 
       fun isFatalError err =
-	 case err
-	   of ERR_NO_SUCH_FILE _ => true
-	    | _ => isWellFormedError err 
+         case err
+           of ERR_NO_SUCH_FILE _ => true
+            | _ => isWellFormedError err 
 
       fun isValidityError err = 
-	 case err
-	   of ERR_AT_LEAST_ONE _      => true
-	    | ERR_AT_MOST_ONE _	      => true
-	    | ERR_ATT_IS_NOT _	      => true
-	    | ERR_EXACTLY_ONE _       => true
-	    | ERR_FIXED_VALUE _       => true
-	    | ERR_ID_DEFAULT   	      => true
-	    | ERR_MISSING_ATT _       => true
-	    | ERR_MULT_ID_ELEM _      => true
-	    | ERR_MUST_BE_AMONG _     => true
-	    | ERR_MUST_BE_UNPARSED _  => true
-	    | ERR_REPEATED_ID _       => true
-	    | ERR_UNDECL_ATT _        => true
-	    | ERR_UNDECL_ID _ 	      => true
-	    | ERR_BAD_ELEM _ 	      => true
-	    | ERR_ELEM_CONTENT _      => true
-	    | ERR_EMPTY_TAG _ 	      => true
-	    | ERR_ENDED_EARLY _	      => true
-	    | ERR_MULT_MIXED _ 	      => true
-	    | ERR_NONEMPTY _ 	      => true
-	    | ERR_REDEC_ELEM _	      => true
-	    | ERR_ROOT_ELEM _	      => true
-	    | ERR_DECL_ENT_NESTING _  => true
-	    | ERR_EE_INT_SUBSET       => true
-	    | ERR_GROUP_ENT_NESTING _ => true
-	    | ERR_NO_DTD 	      => true
-	    | ERR_STANDALONE_DEF _    => true
-	    | ERR_STANDALONE_ELEM _   => true
-	    | ERR_STANDALONE_ENT _    => true
-	    | ERR_STANDALONE_NORM _   => true
-	    | ERR_UNDECLARED _	      => true
-	    | _                       => false
+         case err
+           of ERR_AT_LEAST_ONE _      => true
+            | ERR_AT_MOST_ONE _       => true
+            | ERR_ATT_IS_NOT _        => true
+            | ERR_EXACTLY_ONE _       => true
+            | ERR_FIXED_VALUE _       => true
+            | ERR_ID_DEFAULT          => true
+            | ERR_MISSING_ATT _       => true
+            | ERR_MULT_ID_ELEM _      => true
+            | ERR_MUST_BE_AMONG _     => true
+            | ERR_MUST_BE_UNPARSED _  => true
+            | ERR_REPEATED_ID _       => true
+            | ERR_UNDECL_ATT _        => true
+            | ERR_UNDECL_ID _         => true
+            | ERR_BAD_ELEM _          => true
+            | ERR_ELEM_CONTENT _      => true
+            | ERR_EMPTY_TAG _         => true
+            | ERR_ENDED_EARLY _       => true
+            | ERR_MULT_MIXED _        => true
+            | ERR_NONEMPTY _          => true
+            | ERR_REDEC_ELEM _        => true
+            | ERR_ROOT_ELEM _         => true
+            | ERR_DECL_ENT_NESTING _  => true
+            | ERR_EE_INT_SUBSET       => true
+            | ERR_GROUP_ENT_NESTING _ => true
+            | ERR_NO_DTD              => true
+            | ERR_STANDALONE_DEF _    => true
+            | ERR_STANDALONE_ELEM _   => true
+            | ERR_STANDALONE_ENT _    => true
+            | ERR_STANDALONE_NORM _   => true
+            | ERR_UNDECLARED _        => true
+            | _                       => false
    end
 (* stop of ../../Parser/Error/errorUtil.sml *)
 (* start of ../../Parser/Error/expected.sml *)
@@ -5810,67 +5810,67 @@
 structure Expected = 
    struct
       local 
-	 open UniChar ErrorData 
+         open UniChar ErrorData 
       in 
-	 val expAnElemName  = [EXP_STRING "an element name"]
-	 val expAnEntName   = [EXP_STRING "an entity name"]
-	 val expAName       = [EXP_STRING "a name"]
-	 val expANameToken  = [EXP_STRING "a name token"]
-	 val expANotName    = [EXP_STRING "a notation name"]
-	 val expATarget     = [EXP_STRING "a target name"]
-	 val expAttDefKey   = [EXP_DATA (String2Data "REQUIRED"),EXP_DATA (String2Data "IMPLIED"),
-			       EXP_DATA (String2Data "FIXED")]
-	 val expAttNameGt   = [EXP_STRING "an attribute name",EXP_CHAR 0wx3E]
-	 val expAttSTagEnd  = [EXP_STRING "an attribute name",EXP_CHAR 0wx3E,
-			       EXP_DATA(String2Data "/>")]
-	 val expAttType     = [EXP_CHAR 0wx28,EXP_DATA (String2Data "CDATA"),
-			       EXP_DATA (String2Data "ID"),EXP_DATA (String2Data "IDREF"),
-			       EXP_DATA (String2Data "IDREFS"),EXP_DATA (String2Data "ENTITY"),
-			       EXP_DATA (String2Data "ENTITIES"),EXP_DATA (String2Data "NMTOKEN"),
-			       EXP_DATA (String2Data "NMTOKENS"),EXP_DATA (String2Data "NOTATION")]
-	 val expBarRpar     = [EXP_CHAR 0wx29,EXP_CHAR 0wx7C]
-	 val expCdata       = [EXP_DATA (String2Data "CDATA")]
-	 fun expConCRpar c  = [EXP_CHAR 0wx29,EXP_CHAR c]
-	 val expConRpar     = [EXP_CHAR 0wx29,EXP_CHAR 0wx2C,EXP_CHAR 0wx7C]
-	 val expCondStatus  = [EXP_DATA (String2Data "IGNORE"),EXP_DATA (String2Data "INCLUDE")]
-	 val expContSpec    = [EXP_CHAR 0wx28,EXP_DATA (String2Data "ANY"),
-			       EXP_DATA (String2Data "EMPTY")]
-	 val expElemLpar    = [EXP_STRING "an element name",EXP_CHAR 0wx28]
-	 val expEncStand    = [EXP_DATA (String2Data "encoding"),
-			       EXP_DATA (String2Data "standalone")]
-	 val expDash        = [EXP_CHAR 0wx2D]
-	 val expDashDocLbrk = [EXP_CHAR 0wx2D,EXP_CHAR 0wx5B,EXP_DATA (String2Data "DOCTYPE")]
-	 val expDashLbrack  = [EXP_CHAR 0wx2D,EXP_CHAR 0wx5B]
-	 val expDigitX      = [EXP_STRING "a digit",EXP_CHAR 0wx78]
-	 val expEncoding    = [EXP_DATA (String2Data "encoding")]
-	 val expEncVers     = [EXP_DATA (String2Data "encoding"),EXP_DATA (String2Data "version")]
-	 val expEntNamePero = [EXP_STRING "an entity name",EXP_CHAR 0wx25]
-	 val expEq          = [EXP_CHAR 0wx3D]
-	 val expExclQuest   = [EXP_CHAR 0wx21,EXP_CHAR 0wx3F]
-	 val expExtId       = [EXP_DATA (String2Data "PUBLIC"),EXP_DATA (String2Data "SYSTEM")]
-	 val expGt          = [EXP_CHAR 0wx3E]
-	 val expGtNdata     = [EXP_CHAR 0wx3E,EXP_DATA (String2Data "NDATA")]
-	 val expHexDigit    = [EXP_STRING "a hexadecimal digit"]
-	 val expInSubset    = [EXP_CHAR 0wx3C,EXP_CHAR 0wx5D,EXP_CHAR 0wx25,
-			       EXP_STRING "white space"]
-	 val expLbrack      = [EXP_CHAR 0wx5B]
-	 val expLitQuote    = [EXP_CHAR 0wx22,EXP_CHAR 0wx27]
-	 val expLitQuotExt  = [EXP_CHAR 0wx22,EXP_CHAR 0wx27,
-			       EXP_DATA (String2Data "PUBLIC"),EXP_DATA (String2Data "SYSTEM")]
-	 val expLpar        = [EXP_CHAR 0wx28]
-	 val expNoYes       = [EXP_DATA (String2Data "no"),EXP_DATA (String2Data "yes")]
-	 val expPcdata      = [EXP_DATA (String2Data "PCDATA")]
-	 val expProcEnd     = [EXP_DATA (String2Data "?>")]
-	 val expQuoteRni    = [EXP_CHAR 0wx22,EXP_CHAR 0wx27,EXP_CHAR 0wx23]
-	 val expRbrack      = [EXP_CHAR 0wx5D]
-	 val expRep         = [EXP_CHAR 0wx2A]
-	 val expSemi        = [EXP_CHAR 0wx3B]
-	 val expStandOpt    = [EXP_DATA (String2Data "standalone"),EXP_DATA (String2Data "?>")]
-	 val expStartEnc    = [EXP_STRING "a letter"]
-	 val expStartMarkup = [EXP_DATA (String2Data "--"),EXP_DATA (String2Data "ATTLIST"),
-			       EXP_DATA (String2Data "ELEMENT"),EXP_DATA (String2Data "ENTITY"),
-			       EXP_DATA (String2Data "NOTATION")]
-	 val expVersion     = [EXP_DATA (String2Data "version")]
+         val expAnElemName  = [EXP_STRING "an element name"]
+         val expAnEntName   = [EXP_STRING "an entity name"]
+         val expAName       = [EXP_STRING "a name"]
+         val expANameToken  = [EXP_STRING "a name token"]
+         val expANotName    = [EXP_STRING "a notation name"]
+         val expATarget     = [EXP_STRING "a target name"]
+         val expAttDefKey   = [EXP_DATA (String2Data "REQUIRED"),EXP_DATA (String2Data "IMPLIED"),
+                               EXP_DATA (String2Data "FIXED")]
+         val expAttNameGt   = [EXP_STRING "an attribute name",EXP_CHAR 0wx3E]
+         val expAttSTagEnd  = [EXP_STRING "an attribute name",EXP_CHAR 0wx3E,
+                               EXP_DATA(String2Data "/>")]
+         val expAttType     = [EXP_CHAR 0wx28,EXP_DATA (String2Data "CDATA"),
+                               EXP_DATA (String2Data "ID"),EXP_DATA (String2Data "IDREF"),
+                               EXP_DATA (String2Data "IDREFS"),EXP_DATA (String2Data "ENTITY"),
+                               EXP_DATA (String2Data "ENTITIES"),EXP_DATA (String2Data "NMTOKEN"),
+                               EXP_DATA (String2Data "NMTOKENS"),EXP_DATA (String2Data "NOTATION")]
+         val expBarRpar     = [EXP_CHAR 0wx29,EXP_CHAR 0wx7C]
+         val expCdata       = [EXP_DATA (String2Data "CDATA")]
+         fun expConCRpar c  = [EXP_CHAR 0wx29,EXP_CHAR c]
+         val expConRpar     = [EXP_CHAR 0wx29,EXP_CHAR 0wx2C,EXP_CHAR 0wx7C]
+         val expCondStatus  = [EXP_DATA (String2Data "IGNORE"),EXP_DATA (String2Data "INCLUDE")]
+         val expContSpec    = [EXP_CHAR 0wx28,EXP_DATA (String2Data "ANY"),
+                               EXP_DATA (String2Data "EMPTY")]
+         val expElemLpar    = [EXP_STRING "an element name",EXP_CHAR 0wx28]
+         val expEncStand    = [EXP_DATA (String2Data "encoding"),
+                               EXP_DATA (String2Data "standalone")]
+         val expDash        = [EXP_CHAR 0wx2D]
+         val expDashDocLbrk = [EXP_CHAR 0wx2D,EXP_CHAR 0wx5B,EXP_DATA (String2Data "DOCTYPE")]
+         val expDashLbrack  = [EXP_CHAR 0wx2D,EXP_CHAR 0wx5B]
+         val expDigitX      = [EXP_STRING "a digit",EXP_CHAR 0wx78]
+         val expEncoding    = [EXP_DATA (String2Data "encoding")]
+         val expEncVers     = [EXP_DATA (String2Data "encoding"),EXP_DATA (String2Data "version")]
+         val expEntNamePero = [EXP_STRING "an entity name",EXP_CHAR 0wx25]
+         val expEq          = [EXP_CHAR 0wx3D]
+         val expExclQuest   = [EXP_CHAR 0wx21,EXP_CHAR 0wx3F]
+         val expExtId       = [EXP_DATA (String2Data "PUBLIC"),EXP_DATA (String2Data "SYSTEM")]
+         val expGt          = [EXP_CHAR 0wx3E]
+         val expGtNdata     = [EXP_CHAR 0wx3E,EXP_DATA (String2Data "NDATA")]
+         val expHexDigit    = [EXP_STRING "a hexadecimal digit"]
+         val expInSubset    = [EXP_CHAR 0wx3C,EXP_CHAR 0wx5D,EXP_CHAR 0wx25,
+                               EXP_STRING "white space"]
+         val expLbrack      = [EXP_CHAR 0wx5B]
+         val expLitQuote    = [EXP_CHAR 0wx22,EXP_CHAR 0wx27]
+         val expLitQuotExt  = [EXP_CHAR 0wx22,EXP_CHAR 0wx27,
+                               EXP_DATA (String2Data "PUBLIC"),EXP_DATA (String2Data "SYSTEM")]
+         val expLpar        = [EXP_CHAR 0wx28]
+         val expNoYes       = [EXP_DATA (String2Data "no"),EXP_DATA (String2Data "yes")]
+         val expPcdata      = [EXP_DATA (String2Data "PCDATA")]
+         val expProcEnd     = [EXP_DATA (String2Data "?>")]
+         val expQuoteRni    = [EXP_CHAR 0wx22,EXP_CHAR 0wx27,EXP_CHAR 0wx23]
+         val expRbrack      = [EXP_CHAR 0wx5D]
+         val expRep         = [EXP_CHAR 0wx2A]
+         val expSemi        = [EXP_CHAR 0wx3B]
+         val expStandOpt    = [EXP_DATA (String2Data "standalone"),EXP_DATA (String2Data "?>")]
+         val expStartEnc    = [EXP_STRING "a letter"]
+         val expStartMarkup = [EXP_DATA (String2Data "--"),EXP_DATA (String2Data "ATTLIST"),
+                               EXP_DATA (String2Data "ELEMENT"),EXP_DATA (String2Data "ENTITY"),
+                               EXP_DATA (String2Data "NOTATION")]
+         val expVersion     = [EXP_DATA (String2Data "version")]
       end
    end
 (* stop of ../../Parser/Error/expected.sml *)
@@ -5878,8 +5878,8 @@
 structure Errors =
    struct
       open
-	 UtilError
-	 ErrorData ErrorMessage ErrorString ErrorUtil Expected 
+         UtilError
+         ErrorData ErrorMessage ErrorString ErrorUtil Expected 
    end
 (* stop of ../../Parser/Error/errors.sml *)
 (* start of ../../Parser/Base/baseData.sml *)
@@ -5894,35 +5894,35 @@
       (*--- external ids may have a public id and must have a system id ---*)
       (*--- for notations, however, also the system id can be optional ----*)
       datatype ExternalId = 
-	 EXTID of (string * UniChar.Char) option * (Uri.Uri * Uri.Uri * UniChar.Char) option 
+         EXTID of (string * UniChar.Char) option * (Uri.Uri * Uri.Uri * UniChar.Char) option 
 
       (*--- external ids may have a public id and must have a system id ---*)
       type NotationInfo = ExternalId option
-	 
+         
       (*--- replacement of a general entity ---*)
       datatype GenEntity = 
-	 GE_NULL
+         GE_NULL
        | GE_INTERN of UniChar.Vector * UniChar.Vector
        | GE_EXTERN of ExternalId
        | GE_UNPARSED of ExternalId * int * Errors.Position
       type GenEntInfo = GenEntity * bool
 
       fun isExtGen (GE_EXTERN _) = true
-	| isExtGen _ = false 
-	 
+        | isExtGen _ = false 
+         
       (*--- replacement of a parameter entity ---*)
       datatype ParEntity = 
-	 PE_NULL
+         PE_NULL
        | PE_INTERN of UniChar.Vector * UniChar.Vector
        | PE_EXTERN of ExternalId
       type ParEntInfo = ParEntity * bool
 
       fun isExtPar (PE_EXTERN _) = true
-	| isExtPar _ = false 
-	 
+        | isExtPar _ = false 
+         
       (*--- declared type of an attribute ---*)
       datatype AttType = 
-	 AT_CDATA
+         AT_CDATA
        | AT_NMTOKEN
        | AT_NMTOKENS
        | AT_ID 
@@ -5935,7 +5935,7 @@
 
       (*--- typed attribute value ---*)
       datatype AttValue =
-	 AV_CDATA of UniChar.Vector
+         AV_CDATA of UniChar.Vector
        | AV_NMTOKEN of UniChar.Data
        | AV_NMTOKENS of UniChar.Data list
        | AV_ID of int
@@ -5950,13 +5950,13 @@
 
       (*--- default values of attributes ---*) 
       datatype AttDefault = 
-	 AD_IMPLIED
+         AD_IMPLIED
        | AD_REQUIRED
        | AD_DEFAULT of (UniChar.Vector * UniChar.Vector * AttValue option) 
-	 * (Errors.Position * bool ref)
+         * (Errors.Position * bool ref)
        | AD_FIXED of (UniChar.Vector * UniChar.Vector * AttValue option) 
-	 * (Errors.Position * bool ref)
-	  
+         * (Errors.Position * bool ref)
+          
       (*--- attribute definition (list) ---*)
       (*--- the boolean says whether it was externally declared ---*) 
       type AttDef = int * AttType * AttDefault * bool
@@ -5967,24 +5967,24 @@
 
       (*--- content specification ---*)
       datatype ContentSpec =
-	 CT_ANY
+         CT_ANY
        | CT_EMPTY
        | CT_MIXED of int list
        | CT_ELEMENT of DfaData.ContentModel * DfaData.Dfa
 
       fun isMixed ct = 
-	 case ct 
-	   of CT_ANY     => true
-	    | CT_MIXED _ => true
-	    | _          => false
-	      
+         case ct 
+           of CT_ANY     => true
+            | CT_MIXED _ => true
+            | _          => false
+              
       type ElemInfo = {decl    : (ContentSpec * bool) option,
-		       atts    : (AttDefList * bool) option,
-		       errAtts : int list}
+                       atts    : (AttDefList * bool) option,
+                       errAtts : int list}
 
       val nullElemInfo : ElemInfo = {decl=NONE,
-				     atts=NONE,
-				     errAtts=nil}
+                                     atts=NONE,
+                                     errAtts=nil}
 
       (*--------------------------------------------------------------------*)
       (* the id info tells whether an id value has occurred for a name and  *)
@@ -6022,56 +6022,56 @@
 
 structure DfaString : DfaString =
     struct 
-	open DfaBase UtilString
+        open DfaBase UtilString
 
-	fun State2String q = if q=dfaError then "Error" else Int2String q
-	   
-	fun Info2String Elem2String (q,mt,fst) = String.concat 
-	   (State2String q::Bool2xString ("[empty]","") mt
-	    ::map (fn (q,a) => " "^Elem2String a^"->"^State2String q) fst)
+        fun State2String q = if q=dfaError then "Error" else Int2String q
+           
+        fun Info2String Elem2String (q,mt,fst) = String.concat 
+           (State2String q::Bool2xString ("[empty]","") mt
+            ::map (fn (q,a) => " "^Elem2String a^"->"^State2String q) fst)
 
-	fun ContentModel2String Elem2String cm = 
-	   case cm
-	     of CM_ELEM i => Elem2String i
-	      | CM_OPT cm => ContentModel2String Elem2String cm^"?"
-	      | CM_REP cm => ContentModel2String Elem2String cm^"*"
-	      | CM_PLUS cm => ContentModel2String Elem2String cm^"+"
-	      | CM_ALT cms => List2xString ("(","|",")") (ContentModel2String Elem2String) cms
-	      | CM_SEQ cms => List2xString ("(",",",")") (ContentModel2String Elem2String) cms
-		
-	fun CM2String Elem2String =
-	    let fun cm2s indent cm =
-		case cm
-		  of (ELEM a,info) => String.concat 
-		     [indent,Elem2String a,"  ",Info2String Elem2String info,"\n"]
-		   | (OPT cm',info) => String.concat 
-		     [indent,"?  ",Info2String Elem2String info,"\n",cm2s (indent^" ") cm'] 
-		   | (REP cm',info) => String.concat 
-		     [indent,"*  ",Info2String Elem2String info,"\n",cm2s (indent^" ") cm'] 
-		   | (PLUS cm',info) => String.concat 
-		     [indent,"+  ",Info2String Elem2String info,"\n",cm2s (indent^" ") cm'] 
-		   | (ALT cms,info) => String.concat 
-		     (indent^"|  "::Info2String Elem2String info::"\n"
-		      ::map (cm2s (indent^" ")) cms) 
-		   | (SEQ cms,info) => String.concat 
-		     (indent^",  "::Info2String Elem2String info::"\n"
-		      ::map (cm2s (indent^" ")) cms) 
-	    in cm2s ""
-	    end
-	 
-	fun Row2String Elem2String (lo,hi,tab,fin) =
-	   String.concat 
-	   (Vector.foldri 
-	    (fn (i,q,yet) => if q<0 then yet 
-			     else " "::Elem2String (i+lo)::"->"::State2String q::yet)
-	    (if fin then [" [Final]"] else nil)
-		(tab,0,NONE))
-	   
-	fun Dfa2String Elem2String tab =
-	   String.concat 
-	   (Vector.foldri
-	    (fn (q,row,yet) => State2String q::":"::Row2String Elem2String row::yet)
-	    nil (tab,0,NONE))
+        fun ContentModel2String Elem2String cm = 
+           case cm
+             of CM_ELEM i => Elem2String i
+              | CM_OPT cm => ContentModel2String Elem2String cm^"?"
+              | CM_REP cm => ContentModel2String Elem2String cm^"*"
+              | CM_PLUS cm => ContentModel2String Elem2String cm^"+"
+              | CM_ALT cms => List2xString ("(","|",")") (ContentModel2String Elem2String) cms
+              | CM_SEQ cms => List2xString ("(",",",")") (ContentModel2String Elem2String) cms
+                
+        fun CM2String Elem2String =
+            let fun cm2s indent cm =
+                case cm
+                  of (ELEM a,info) => String.concat 
+                     [indent,Elem2String a,"  ",Info2String Elem2String info,"\n"]
+                   | (OPT cm',info) => String.concat 
+                     [indent,"?  ",Info2String Elem2String info,"\n",cm2s (indent^" ") cm'] 
+                   | (REP cm',info) => String.concat 
+                     [indent,"*  ",Info2String Elem2String info,"\n",cm2s (indent^" ") cm'] 
+                   | (PLUS cm',info) => String.concat 
+                     [indent,"+  ",Info2String Elem2String info,"\n",cm2s (indent^" ") cm'] 
+                   | (ALT cms,info) => String.concat 
+                     (indent^"|  "::Info2String Elem2String info::"\n"
+                      ::map (cm2s (indent^" ")) cms) 
+                   | (SEQ cms,info) => String.concat 
+                     (indent^",  "::Info2String Elem2String info::"\n"
+                      ::map (cm2s (indent^" ")) cms) 
+            in cm2s ""
+            end
+         
+        fun Row2String Elem2String (lo,hi,tab,fin) =
+           String.concat 
+           (Vector.foldri 
+            (fn (i,q,yet) => if q<0 then yet 
+                             else " "::Elem2String (i+lo)::"->"::State2String q::yet)
+            (if fin then [" [Final]"] else nil)
+                (tab,0,NONE))
+           
+        fun Dfa2String Elem2String tab =
+           String.concat 
+           (Vector.foldri
+            (fn (q,row,yet) => State2String q::":"::Row2String Elem2String row::yet)
+            nil (tab,0,NONE))
     end
 (* stop of ../../Parser/Dfa/dfaString.sml *)
 (* start of ../../Parser/Base/baseString.sml *)
@@ -6113,7 +6113,7 @@
       val ParEntity2String  : BaseData.ParEntity -> string
 
       val ElemInfo2xString  : (int -> string) * (int -> string) * (int -> string) 
-	 * (int -> string) * (int -> string) -> BaseData.ElemInfo -> string
+         * (int -> string) * (int -> string) -> BaseData.ElemInfo -> string
 
       val IdInfo2String     : BaseData.IdInfo -> string
    end
@@ -6121,123 +6121,123 @@
 structure BaseString : BaseString = 
    struct
       open 
-	 UtilString Uri
-	 Errors UniChar DfaString
-	 BaseData 
+         UtilString Uri
+         Errors UniChar DfaString
+         BaseData 
 
       val THIS_MODULE = "BaseString"
 
       fun ExternalId2String (EXTID id) = 
-	 case id 
-	   of (SOME(p,pq),SOME(rel,s,sq)) => String.concat
-	      ["PUBLIC ",quoteUni pq p,
-	       " ",quoteUni sq (Uri2String rel),
-	       " @ ",quoteUni sq (Uri2String s)]
-	    | (SOME(p,pq),NONE) => String.concat
-	      ["PUBLIC ",quoteUni pq p]
-	    | (NONE,SOME(rel,s,sq)) => String.concat
-	      ["SYSTEM ",quoteUni sq (Uri2String rel),
-	       " @ ",quoteUni sq (Uri2String s)]
-	    | (NONE,NONE) => "<none>"
+         case id 
+           of (SOME(p,pq),SOME(rel,s,sq)) => String.concat
+              ["PUBLIC ",quoteUni pq p,
+               " ",quoteUni sq (Uri2String rel),
+               " @ ",quoteUni sq (Uri2String s)]
+            | (SOME(p,pq),NONE) => String.concat
+              ["PUBLIC ",quoteUni pq p]
+            | (NONE,SOME(rel,s,sq)) => String.concat
+              ["SYSTEM ",quoteUni sq (Uri2String rel),
+               " @ ",quoteUni sq (Uri2String s)]
+            | (NONE,NONE) => "<none>"
       fun NotationInfo2String not = 
-	 case not 
-	   of NONE => "undeclared"
-	    | SOME extId => ExternalId2String extId
+         case not 
+           of NONE => "undeclared"
+            | SOME extId => ExternalId2String extId
 
       fun GenEntity2xString NotIdx2String ge = 
-	 case ge
-	   of GE_NULL => "NULL"
-	    | GE_INTERN(lit,cv) => let val quote = Vector.sub(lit,0)
-				   in String.concat ["INTERN ",Vector2String lit,
-						     " - ",quoteVector quote cv]
-				   end
-	    | GE_EXTERN id => "EXTERN "^ExternalId2String id
-	    | GE_UNPARSED(id,not,_) => "UNPARSED "^ExternalId2String id^" "^NotIdx2String not
+         case ge
+           of GE_NULL => "NULL"
+            | GE_INTERN(lit,cv) => let val quote = Vector.sub(lit,0)
+                                   in String.concat ["INTERN ",Vector2String lit,
+                                                     " - ",quoteVector quote cv]
+                                   end
+            | GE_EXTERN id => "EXTERN "^ExternalId2String id
+            | GE_UNPARSED(id,not,_) => "UNPARSED "^ExternalId2String id^" "^NotIdx2String not
 
       fun ParEntity2String pe = 
-	 case pe
-	   of PE_NULL => "NULL"
-	    | PE_INTERN(lit,cv) => let val quote = Vector.sub(lit,0)
-				   in String.concat ["INTERN ",Vector2String lit,
-						     " - ",quoteVector quote cv]
-				   end
-	    | PE_EXTERN id => "EXTERN "^ExternalId2String id
+         case pe
+           of PE_NULL => "NULL"
+            | PE_INTERN(lit,cv) => let val quote = Vector.sub(lit,0)
+                                   in String.concat ["INTERN ",Vector2String lit,
+                                                     " - ",quoteVector quote cv]
+                                   end
+            | PE_EXTERN id => "EXTERN "^ExternalId2String id
 
       fun ContentSpec2String Elem2String cs =
-	 case cs
-	   of CT_ANY => "ANY"
-	    | CT_EMPTY => "EMPTY"
-	    | CT_MIXED is => List2xString ("MIXED (","|",")") Elem2String is
-	    | CT_ELEMENT(cm,_) => "ELEMENT "^ContentModel2String Elem2String cm
-	 
+         case cs
+           of CT_ANY => "ANY"
+            | CT_EMPTY => "EMPTY"
+            | CT_MIXED is => List2xString ("MIXED (","|",")") Elem2String is
+            | CT_ELEMENT(cm,_) => "ELEMENT "^ContentModel2String Elem2String cm
+         
       fun AttValue2xString (Att2String,Ent2String,Id2String,Not2String) quote av = 
-	 quoteUni quote (case av
-			   of AV_CDATA buf => Vector2String buf
-			    | AV_NMTOKEN cs => Data2String cs
-			    | AV_NMTOKENS css => List2xString (""," ","") Data2String css
-			    | AV_ID idx => Id2String idx
-			    | AV_IDREF idx => Id2String idx
-			    | AV_IDREFS idxs => List2xString (""," ","") Id2String idxs
-			    | AV_ENTITY idx => Ent2String idx
-			    | AV_ENTITIES idxs => List2xString (""," ","") Ent2String idxs
-			    | AV_GROUP(_,idx) => Att2String idx
-			    | AV_NOTATION(_,idx) => Not2String idx)
+         quoteUni quote (case av
+                           of AV_CDATA buf => Vector2String buf
+                            | AV_NMTOKEN cs => Data2String cs
+                            | AV_NMTOKENS css => List2xString (""," ","") Data2String css
+                            | AV_ID idx => Id2String idx
+                            | AV_IDREF idx => Id2String idx
+                            | AV_IDREFS idxs => List2xString (""," ","") Id2String idxs
+                            | AV_ENTITY idx => Ent2String idx
+                            | AV_ENTITIES idxs => List2xString (""," ","") Ent2String idxs
+                            | AV_GROUP(_,idx) => Att2String idx
+                            | AV_NOTATION(_,idx) => Not2String idx)
 
       fun AttDefault2xString funs ad = 
          case ad 
-	   of AD_DEFAULT ((lit,cv,av),_) => 
-	      let val quote = Vector.sub(lit,0)
-	      in String.concat [quoteVector quote cv," ",
-				Option2String0 (AttValue2xString funs quote) av]
-	      end
-	    | AD_FIXED ((lit,cv,av),_) => 
-	      let val quote = Vector.sub(lit,0)
-	      in String.concat ["#FIXED ",quoteVector quote cv," ",
-				Option2String0 (AttValue2xString funs quote) av]
-	      end
-	    | AD_IMPLIED => "#IMPLIED"
-	    | AD_REQUIRED => "#REQUIRED"
-	  
+           of AD_DEFAULT ((lit,cv,av),_) => 
+              let val quote = Vector.sub(lit,0)
+              in String.concat [quoteVector quote cv," ",
+                                Option2String0 (AttValue2xString funs quote) av]
+              end
+            | AD_FIXED ((lit,cv,av),_) => 
+              let val quote = Vector.sub(lit,0)
+              in String.concat ["#FIXED ",quoteVector quote cv," ",
+                                Option2String0 (AttValue2xString funs quote) av]
+              end
+            | AD_IMPLIED => "#IMPLIED"
+            | AD_REQUIRED => "#REQUIRED"
+          
       fun AttType2xString (Att2String,Not2String) at = 
-	 case at 
-	   of AT_CDATA => "CDATA"
-	    | AT_NMTOKEN => "NMTOKEN"
-	    | AT_NMTOKENS => "NMTOKENS"
-	    | AT_ID => "ID"
-	    | AT_IDREF => "IDREF"
-	    | AT_IDREFS => "IDREFS"
-	    | AT_ENTITY => "ENTITY"
-	    | AT_ENTITIES => "ENTITIES"
-	    | AT_GROUP idxs => List2xString ("(","|",")") Att2String idxs
-	    | AT_NOTATION idxs => List2xString ("NOTATION(","|",")") Not2String idxs
+         case at 
+           of AT_CDATA => "CDATA"
+            | AT_NMTOKEN => "NMTOKEN"
+            | AT_NMTOKENS => "NMTOKENS"
+            | AT_ID => "ID"
+            | AT_IDREF => "IDREF"
+            | AT_IDREFS => "IDREFS"
+            | AT_ENTITY => "ENTITY"
+            | AT_ENTITIES => "ENTITIES"
+            | AT_GROUP idxs => List2xString ("(","|",")") Att2String idxs
+            | AT_NOTATION idxs => List2xString ("NOTATION(","|",")") Not2String idxs
 
       fun AttDef2xString (funs  as (Att2String,_,_,Not2String)) (idx,attType,default,ext) = 
-	 String.concat [Att2String idx," ",
-			AttType2xString (Att2String,Not2String) attType," ",
-			AttDefault2xString funs default,
-			Bool2xString ("[external]","") ext]
-			
+         String.concat [Att2String idx," ",
+                        AttType2xString (Att2String,Not2String) attType," ",
+                        AttDefault2xString funs default,
+                        Bool2xString ("[external]","") ext]
+                        
       fun AttDefList2xString funs adl = List2xString ("",",","") (AttDef2xString funs) adl
 
       fun ElemInfo2xString (Att2String,Elem2String,Ent2String,Id2String,Not2String)
-	 ({decl,atts,...}:ElemInfo) =
-	 let val dec = case decl
-			 of NONE => "elem undeclared"
-			  | SOME(cont,ext) => String.concat 
-			    ["elem declared ",if ext then "ex" else "in","ternally: ",
-			     ContentSpec2String Elem2String cont]
-	     val att = case atts
-			 of NONE => "no atts declared"
-			  | SOME(defs,hadId) => String.concat
-			    ["atts were declared",if hadId then "(has id attribute): " else ": ",
-			     AttDefList2xString (Att2String,Ent2String,Id2String,Not2String) defs]
-	 in dec^att
-	 end
+         ({decl,atts,...}:ElemInfo) =
+         let val dec = case decl
+                         of NONE => "elem undeclared"
+                          | SOME(cont,ext) => String.concat 
+                            ["elem declared ",if ext then "ex" else "in","ternally: ",
+                             ContentSpec2String Elem2String cont]
+             val att = case atts
+                         of NONE => "no atts declared"
+                          | SOME(defs,hadId) => String.concat
+                            ["atts were declared",if hadId then "(has id attribute): " else ": ",
+                             AttDefList2xString (Att2String,Ent2String,Id2String,Not2String) defs]
+         in dec^att
+         end
 
       fun IdInfo2String (decl,refs) = 
-	 Bool2xString ("declared","undeclared") decl^"/"^
-	 (if null refs then "no references"
-	  else List2xString ("references: ",", ","") Position2String refs)
+         Bool2xString ("declared","undeclared") decl^"/"^
+         (if null refs then "no references"
+          else List2xString ("references: ",", ","") Position2String refs)
    end
 
 (* stop of ../../Parser/Base/baseString.sml *)
@@ -6248,8 +6248,8 @@
 structure Base =
    struct
       open 
-	 BaseData
-	 BaseString
+         BaseData
+         BaseString
    end
 (* stop of ../../Parser/Base/base.sml *)
 (* start of ../../Parser/Params/dtd.sml *)
@@ -6260,32 +6260,32 @@
 (*   AttNot2Index        : none                                             *)
 (*   Element2Index       : none                                             *)
 (*   GenEnt2Index        : none                                             *)
-(*   Id2Index            : none 		                            *)
-(*   Index2AttNot        : NoSuchIndex	                                    *)
-(*   Index2Element       : NoSuchIndex	                                    *)
+(*   Id2Index            : none                                             *)
+(*   Index2AttNot        : NoSuchIndex                                      *)
+(*   Index2Element       : NoSuchIndex                                      *)
 (*   Index2GenEnt        : NoSuchIndex                                      *)
-(*   Index2Id            : NoSuchIndex			                    *)
+(*   Index2Id            : NoSuchIndex                                      *)
 (*   Index2ParEnt        : NoSuchIndex                                      *)
 (*   ParEnt2Index        : none                                             *)
 (*   entitiesWellformed  : none                                             *)
-(*   getElement          : NoSuchIndex	                                    *)
+(*   getElement          : NoSuchIndex                                      *)
 (*   getGenEnt           : NoSuchIndex                                      *)
-(*   getId               : NoSuchIndex	                                    *)
-(*   getNotation         : NoSuchIndex	                                    *)
+(*   getId               : NoSuchIndex                                      *)
+(*   getNotation         : NoSuchIndex                                      *)
 (*   getParEnt           : NoSuchIndex                                      *)
-(*   hasNotation         : NoSuchIndex	                                    *)
+(*   hasNotation         : NoSuchIndex                                      *)
 (*   initDtdTables       : none                                             *)
 (*   maxUsedElem         : none                                             *)
 (*   maxUsedId           : none                                             *)
-(*   printAttNotTable    : none				                    *)
-(*   printIdTable        : none				                    *)
+(*   printAttNotTable    : none                                             *)
+(*   printIdTable        : none                                             *)
 (*   printParEntTable    : none                                             *)
-(*   printxElementTable  : none		                                    *)
+(*   printxElementTable  : none                                             *)
 (*   printxGenEntTable   : none                                             *)
-(*   setElement          : NoSuchIndex	                                    *)
+(*   setElement          : NoSuchIndex                                      *)
 (*   setGenEnt           : NoSuchIndex                                      *)
-(*   setId               : NoSuchIndex	                                    *)
-(*   setNotation         : NoSuchIndex	                                    *)
+(*   setId               : NoSuchIndex                                      *)
+(*   setNotation         : NoSuchIndex                                      *)
 (*   setParEnt           : NoSuchIndex                                      *)
 (*--------------------------------------------------------------------------*)
 signature Dtd = 
@@ -6295,11 +6295,11 @@
       val hasDtd       : Dtd -> bool
       val hasExternal  : Dtd -> bool
       val standsAlone  : Dtd -> bool
-	 
+         
       val setHasDtd     : Dtd -> unit
       val setExternal   : Dtd -> unit
       val setStandAlone : Dtd -> bool -> unit
-	 
+         
       val entitiesWellformed : Dtd -> bool
 
       val validPredef  : int -> UniChar.Vector
@@ -6318,7 +6318,7 @@
       val Index2GenEnt    : Dtd -> int -> UniChar.Data
       val Index2AttNot    : Dtd -> int -> UniChar.Data
       val Index2ParEnt    : Dtd -> int -> UniChar.Data
-	 
+         
       val getId       : Dtd -> int -> Base.IdInfo
       val getElement  : Dtd -> int -> Base.ElemInfo
       val getGenEnt   : Dtd -> int -> Base.GenEntInfo
@@ -6339,7 +6339,7 @@
 
       val initDtdTables  : unit -> Dtd
       val printDtdTables : Dtd -> unit
-	 
+         
       val printAttNotTable  : Dtd -> unit
       val printIdTable      : Dtd -> unit
       val printElementTable : Dtd -> unit
@@ -6356,10 +6356,10 @@
 structure Dtd :> Dtd = 
    struct 
       open 
-	 UtilInt
-	 Base UniChar
-	 DataDict DataSymTab
-	 
+         UtilInt
+         Base UniChar
+         DataDict DataSymTab
+         
       val O_TS_ELEM    = ref 6 (* Initial size of element table             *)
       val O_TS_GEN_ENT = ref 6 (* Initial size of general entity table      *)
       val O_TS_ID      = ref 6 (* Initial size of id attribute table        *)
@@ -6370,39 +6370,39 @@
       (* this is how the predefined entities must be declared.              *)
       (*--------------------------------------------------------------------*)
       val predefined = Vector.fromList 
-	 (map (fn (x,y,z) => (String2Data x,String2Vector y,String2Vector z))
-	  [("","",""),
-	   ("amp" ,"'&#38;'","&#38;"),
-	   ("lt"  ,"'&#60;'","&#60;"),
-	   ("gt"  ,"'&#62;'","&#62;"),
-	   ("apos","\"'\""  ,"'"    ),
-	   ("quot","'\"'"   ,"\""   )])
+         (map (fn (x,y,z) => (String2Data x,String2Vector y,String2Vector z))
+          [("","",""),
+           ("amp" ,"'&#38;'","&#38;"),
+           ("lt"  ,"'&#60;'","&#60;"),
+           ("gt"  ,"'&#62;'","&#62;"),
+           ("apos","\"'\""  ,"'"    ),
+           ("quot","'\"'"   ,"\""   )])
       fun validPredef i = #3(Vector.sub(predefined,i))
-	 
+         
       (*--------------------------------------------------------------------*)
       (* this type holds all information relevent to the DTD.               *)
       (*--------------------------------------------------------------------*)
       type Dtd = {hasDtdFlag     : bool ref,
-		  standAloneFlag : bool ref,
-		  externalFlag   : bool ref,
-		  elDict         : ElemInfo DataDict.Dict,
-		  genDict        : GenEntInfo DataDict.Dict,
-		  idDict         : IdInfo DataDict.Dict,
-		  notDict        : NotationInfo DataDict.Dict,
-		  parDict        : ParEntInfo DataDict.Dict,
-		  preRedef       : bool array
-		  }
+                  standAloneFlag : bool ref,
+                  externalFlag   : bool ref,
+                  elDict         : ElemInfo DataDict.Dict,
+                  genDict        : GenEntInfo DataDict.Dict,
+                  idDict         : IdInfo DataDict.Dict,
+                  notDict        : NotationInfo DataDict.Dict,
+                  parDict        : ParEntInfo DataDict.Dict,
+                  preRedef       : bool array
+                  }
 
       fun newDtd() = {hasDtdFlag     = ref false,
-		      standAloneFlag = ref false,
-		      externalFlag   = ref false,
-		      elDict         = nullDict ("element",nullElemInfo),
-		      idDict         = nullDict ("ID name",nullIdInfo),
-		      genDict        = nullDict ("general entity",(GE_NULL,false)),
-		      notDict        = nullDict ("attribute and notation",NONE:NotationInfo),
-		      parDict        = nullDict ("parameter entity",(PE_NULL,false)),
-		      preRedef       = Array.array(6,false)
-		      } : Dtd 
+                      standAloneFlag = ref false,
+                      externalFlag   = ref false,
+                      elDict         = nullDict ("element",nullElemInfo),
+                      idDict         = nullDict ("ID name",nullIdInfo),
+                      genDict        = nullDict ("general entity",(GE_NULL,false)),
+                      notDict        = nullDict ("attribute and notation",NONE:NotationInfo),
+                      parDict        = nullDict ("parameter entity",(PE_NULL,false)),
+                      preRedef       = Array.array(6,false)
+                      } : Dtd 
 
       val default  = String2Data "default"
       val preserve = String2Data "preserve"
@@ -6443,10 +6443,10 @@
       (* bug fixed 080600: changed !hasDtdFlag to not(!hasDtdFlag)          *)
       (*--------------------------------------------------------------------*)
       fun entitiesWellformed ({hasDtdFlag,standAloneFlag,externalFlag,...}:Dtd) = 
-	 not (!hasDtdFlag andalso !externalFlag) orelse !standAloneFlag 
+         not (!hasDtdFlag andalso !externalFlag) orelse !standAloneFlag 
 
       fun initStandalone ({hasDtdFlag,standAloneFlag,externalFlag,...}:Dtd) = 
-	 (hasDtdFlag := false; standAloneFlag := false; externalFlag := false)
+         (hasDtdFlag := false; standAloneFlag := false; externalFlag := false)
 
       (*--------------------------------------------------------------------*)
       (* this array tells whether the predefined entities (index 1-5) have  *)
@@ -6455,8 +6455,8 @@
       fun isRedefined (dtd:Dtd) i = Array.sub(#preRedef dtd,i)
       fun setRedefined (dtd:Dtd) i = Array.update(#preRedef dtd,i,true)
       fun notRedefined dtd = List.mapPartial 
-	 (fn i => if isRedefined dtd i then NONE else SOME(#1(Vector.sub(predefined,i)))) 
-	 [1,2,3,4,5]
+         (fn i => if isRedefined dtd i then NONE else SOME(#1(Vector.sub(predefined,i)))) 
+         [1,2,3,4,5]
 
       fun AttNot2Index  (dtd:Dtd) name = getIndex(#notDict dtd,name)
       fun Element2Index (dtd:Dtd) name = getIndex(#elDict dtd,name)
@@ -6493,15 +6493,15 @@
       (* assigned to "default", "preserve", "xml:lang" and "xml:space".     *)
       (*--------------------------------------------------------------------*)
       fun initAttNotTable (dtd as {idDict,notDict,...}:Dtd) = 
-	 let 
-	    val _ = clearDict(notDict,SOME(!O_TS_ATT_NOT))
-	    val _ = clearDict(idDict,SOME(!O_TS_ID))
-	    val _ = AttNot2Index dtd default
-	    val _ = AttNot2Index dtd preserve
-	    val _ = AttNot2Index dtd xmlLang
-	    val _ = AttNot2Index dtd xmlSpace
-	 in ()
-	 end
+         let 
+            val _ = clearDict(notDict,SOME(!O_TS_ATT_NOT))
+            val _ = clearDict(idDict,SOME(!O_TS_ID))
+            val _ = AttNot2Index dtd default
+            val _ = AttNot2Index dtd preserve
+            val _ = AttNot2Index dtd xmlLang
+            val _ = AttNot2Index dtd xmlSpace
+         in ()
+         end
       fun initElementTable (dtd:Dtd) = clearDict(#elDict dtd,SOME(!O_TS_ELEM))
       (*--------------------------------------------------------------------*)
       (* reserve 0 for gen entity -,    i.e., the document entity.          *) 
@@ -6526,60 +6526,60 @@
       (*   <!ENTITY quot   "&#34;">                                         *)
       (*--------------------------------------------------------------------*)
       fun initEntityTables (dtd as {genDict,parDict,preRedef,...}:Dtd) = 
-	 let 
-	    val _ = clearDict(genDict,SOME(!O_TS_GEN_ENT))
-	    val _ = clearDict(parDict,SOME(!O_TS_PAR_ENT))
-	    val _ = map (fn i => Array.update(preRedef,i,false)) [1,2,3,4,5]
-	    val _ = GenEnt2Index dtd [0wx2D] (* "-" *)
-	    val _ = ParEnt2Index dtd [0wx2D] (* "-" *)
-	    val _ = Vector.appi 
-	       (fn (_,(name,lit,cs)) 
-		=> (setGenEnt dtd (GenEnt2Index dtd name,(GE_INTERN(lit,cs),false)))) 
-	       (predefined,1,NONE)
-	 in ()
-	 end
+         let 
+            val _ = clearDict(genDict,SOME(!O_TS_GEN_ENT))
+            val _ = clearDict(parDict,SOME(!O_TS_PAR_ENT))
+            val _ = map (fn i => Array.update(preRedef,i,false)) [1,2,3,4,5]
+            val _ = GenEnt2Index dtd [0wx2D] (* "-" *)
+            val _ = ParEnt2Index dtd [0wx2D] (* "-" *)
+            val _ = Vector.appi 
+               (fn (_,(name,lit,cs)) 
+                => (setGenEnt dtd (GenEnt2Index dtd name,(GE_INTERN(lit,cs),false)))) 
+               (predefined,1,NONE)
+         in ()
+         end
 
       fun initDtdTables() = 
-	 let
-	    val dtd = newDtd()
-	    val _ = initAttNotTable dtd
-	    val _ = initElementTable dtd
-	    val _ = initEntityTables dtd
-	    val _ = initStandalone dtd
-	 in dtd
-	 end
-			  	    
+         let
+            val dtd = newDtd()
+            val _ = initAttNotTable dtd
+            val _ = initElementTable dtd
+            val _ = initEntityTables dtd
+            val _ = initStandalone dtd
+         in dtd
+         end
+                                    
       local 
-	 val dtd = initDtdTables() 
+         val dtd = initDtdTables() 
       in 
-	 val defaultIdx = AttNot2Index dtd default
-	 val preserveIdx = AttNot2Index dtd preserve
-	 val xmlLangIdx = AttNot2Index dtd xmlLang
-	 val xmlSpaceIdx = AttNot2Index dtd xmlSpace
-	 val xmlSpaceType = AT_GROUP (IntLists.addIntList (preserveIdx,[defaultIdx]))
+         val defaultIdx = AttNot2Index dtd default
+         val preserveIdx = AttNot2Index dtd preserve
+         val xmlLangIdx = AttNot2Index dtd xmlLang
+         val xmlSpaceIdx = AttNot2Index dtd xmlSpace
+         val xmlSpaceType = AT_GROUP (IntLists.addIntList (preserveIdx,[defaultIdx]))
       end
 
       fun printAttNotTable (dtd:Dtd) = 
-	 printDict NotationInfo2String (#notDict dtd)
+         printDict NotationInfo2String (#notDict dtd)
       fun printElementTable dtd = 
-	 printDict (ElemInfo2xString (UniChar.Data2String o (Index2AttNot dtd),
-				      UniChar.Data2String o (Index2Element dtd),
-				      UniChar.Data2String o (Index2GenEnt dtd),
-				      UniChar.Data2String o (Index2Id dtd),
-				      UniChar.Data2String o (Index2AttNot dtd))) (#elDict dtd)
+         printDict (ElemInfo2xString (UniChar.Data2String o (Index2AttNot dtd),
+                                      UniChar.Data2String o (Index2Element dtd),
+                                      UniChar.Data2String o (Index2GenEnt dtd),
+                                      UniChar.Data2String o (Index2Id dtd),
+                                      UniChar.Data2String o (Index2AttNot dtd))) (#elDict dtd)
       fun printGenEntTable dtd = 
-	 printDict (fn (ent,ext) => GenEntity2xString (Data2String o (Index2AttNot dtd)) ent
-		    ^(if ext then "[external]" else "")) (#genDict dtd)
+         printDict (fn (ent,ext) => GenEntity2xString (Data2String o (Index2AttNot dtd)) ent
+                    ^(if ext then "[external]" else "")) (#genDict dtd)
       fun printIdTable (dtd:Dtd) = printDict (IdInfo2String) (#idDict dtd)
       fun printParEntTable (dtd:Dtd) = 
-	 printDict (fn (ent,ext) => ParEntity2String ent
-		    ^(if ext then "[external]" else "")) (#parDict dtd)
+         printDict (fn (ent,ext) => ParEntity2String ent
+                    ^(if ext then "[external]" else "")) (#parDict dtd)
 
       fun printDtdTables dtd = (printAttNotTable dtd;
-				printElementTable dtd;
-				printGenEntTable dtd;
-				printIdTable dtd;
-				printParEntTable dtd)
+                                printElementTable dtd;
+                                printGenEntTable dtd;
+                                printIdTable dtd;
+                                printParEntTable dtd)
    end
 (* stop of ../../Parser/Params/dtd.sml *)
 (* start of ../../Parser/Params/hookData.sml *)
@@ -6608,7 +6608,7 @@
       type DtdInfo       = int * Base.ExternalId option
 
       datatype AttPresent =
-	 AP_IMPLIED
+         AP_IMPLIED
        | AP_MISSING
        | AP_DEFAULT of UniChar.Vector * UniChar.Vector * Base.AttValue option
        | AP_PRESENT of UniChar.Vector * UniChar.Vector * Base.AttValue option
@@ -6628,7 +6628,7 @@
       type EntEndInfo    = Errors.Position
 
       datatype MarkupDecl = 
-	 DEC_ATTLIST of int * (int * Base.AttType * Base.AttDefault) list * bool
+         DEC_ATTLIST of int * (int * Base.AttType * Base.AttDefault) list * bool
        | DEC_ELEMENT of int * Base.ContentSpec * bool
        | DEC_GEN_ENT of int * Base.GenEntity * bool
        | DEC_PAR_ENT of int * Base.ParEntity * bool
@@ -6636,12 +6636,12 @@
       type DeclInfo = StartEnd * MarkupDecl
 
       fun isExtDecl decl =
-	 case decl
-	   of DEC_ATTLIST(_,_,ext) => ext
-	    | DEC_ELEMENT(_,_,ext) => ext
-	    | DEC_GEN_ENT(_,_,ext) => ext
-	    | DEC_PAR_ENT(_,_,ext) => ext
-	    | DEC_NOTATION(_,_,ext) => ext
+         case decl
+           of DEC_ATTLIST(_,_,ext) => ext
+            | DEC_ELEMENT(_,_,ext) => ext
+            | DEC_GEN_ENT(_,_,ext) => ext
+            | DEC_PAR_ENT(_,_,ext) => ext
+            | DEC_NOTATION(_,_,ext) => ext
    end
 (* stop of ../../Parser/Params/hookData.sml *)
 (* start of ../../Parser/Params/hooks.sml *)
@@ -6655,7 +6655,7 @@
       
       val hookXml       : AppData * HookData.XmlInfo -> AppData
       val hookFinish    : AppData -> AppFinal
-	 
+         
       val hookError     : AppData * HookData.ErrorInfo -> AppData
       val hookWarning   : AppData * HookData.WarningInfo -> AppData
 
@@ -6695,9 +6695,9 @@
       open Base Errors Uri
 
       fun resolveExtId (EXTID(_,sys)) =
-	 case sys
-	   of NONE => raise NoSuchFile ("","Could not generate system identifier")
-	    | SOME (base,file,_) => uriJoin(base,file)
+         case sys
+           of NONE => raise NoSuchFile ("","Could not generate system identifier")
+            | SOME (base,file,_) => uriJoin(base,file)
    end
 (* stop of ../../Parser/Params/resolve.sml *)
 (* start of ../../Parser/Dfa/dfaUtil.sml *)
@@ -6733,35 +6733,35 @@
 structure DfaUtil : DfaUtil =
    struct
       open UtilInt DfaBase
-	 
+         
       (*--------------------------------------------------------------------*)
       (* merge two First sets, raise ConflictFirst at conflict: there may   *)
       (* not be two entries (q1,a) and (q2,a) in the same First set, if     *)
       (* nondet is false.                                                   *)
       (*--------------------------------------------------------------------*)
       fun mergeFirst nondet ll = 
-	 let 
-	    fun go_det (nil,l) = l 
-	      | go_det (l,nil) = l
-	      | go_det (l1 as (x1 as (q1,a1))::r1,l2 as (x2 as (q2,a2))::r2) = 
-	       case Int.compare(a1,a2) 
-		 of LESS => x1::go_det(r1,l2) 
-		  | GREATER => x2::go_det(l1,r2)
-		  | EQUAL => raise ConflictFirst(a1,q1,q2)
+         let 
+            fun go_det (nil,l) = l 
+              | go_det (l,nil) = l
+              | go_det (l1 as (x1 as (q1,a1))::r1,l2 as (x2 as (q2,a2))::r2) = 
+               case Int.compare(a1,a2) 
+                 of LESS => x1::go_det(r1,l2) 
+                  | GREATER => x2::go_det(l1,r2)
+                  | EQUAL => raise ConflictFirst(a1,q1,q2)
 
-	    fun go_nondet (nil,l) = l 
-	      | go_nondet (l,nil) = l
-	      | go_nondet (l1 as (x1 as (q1,a1))::r1,l2 as (x2 as (q2,a2))::r2) = 
-	       case Int.compare(a1,a2) 
-		 of LESS => x1::go_nondet(r1,l2) 
-		  | GREATER => x2::go_nondet(l1,r2)
-		  | EQUAL => case Int.compare(q1,q2)
-			       of LESS => x1::go_nondet(r1,l2)
-				| GREATER => x2::go_nondet(l1,r2)
-				| EQUAL => go_nondet(l1,r2)
-	 in 
-	    if nondet then go_nondet ll else go_det ll
-	 end
+            fun go_nondet (nil,l) = l 
+              | go_nondet (l,nil) = l
+              | go_nondet (l1 as (x1 as (q1,a1))::r1,l2 as (x2 as (q2,a2))::r2) = 
+               case Int.compare(a1,a2) 
+                 of LESS => x1::go_nondet(r1,l2) 
+                  | GREATER => x2::go_nondet(l1,r2)
+                  | EQUAL => case Int.compare(q1,q2)
+                               of LESS => x1::go_nondet(r1,l2)
+                                | GREATER => x2::go_nondet(l1,r2)
+                                | EQUAL => go_nondet(l1,r2)
+         in 
+            if nondet then go_nondet ll else go_det ll
+         end
 
       (*--------------------------------------------------------------------*)
       (* merge two Follow sets, raise ConflictFollow at conflict. there may *)
@@ -6771,64 +6771,64 @@
       (* are possible (as opposed to First).                                *)
       (*--------------------------------------------------------------------*)
       fun mergeFollow nondet ll = 
-	 let 
-	    fun go_det (nil,l) = l 
-	      | go_det (l,nil) = l
-	      | go_det (l1 as (x1 as (q1,a1))::r1,l2 as (x2 as (q2,a2))::r2) = 
-	       case Int.compare(a1,a2) 
-		 of LESS => x1::go_det(r1,l2) 
-		  | GREATER => x2::go_det(l1,r2)
-		  | EQUAL => if q1=q2 then go_det(l1,r2)
-			     else raise ConflictFollow(a1,q1,q2)
+         let 
+            fun go_det (nil,l) = l 
+              | go_det (l,nil) = l
+              | go_det (l1 as (x1 as (q1,a1))::r1,l2 as (x2 as (q2,a2))::r2) = 
+               case Int.compare(a1,a2) 
+                 of LESS => x1::go_det(r1,l2) 
+                  | GREATER => x2::go_det(l1,r2)
+                  | EQUAL => if q1=q2 then go_det(l1,r2)
+                             else raise ConflictFollow(a1,q1,q2)
 
-	    fun go_nondet (nil,l) = l 
-	      | go_nondet (l,nil) = l
-	      | go_nondet (l1 as (x1 as (q1,a1))::r1,l2 as (x2 as (q2,a2))::r2) = 
-	       case Int.compare(a1,a2) 
-		 of LESS => x1::go_nondet(r1,l2) 
-		  | GREATER => x2::go_nondet(l1,r2)
-		  | EQUAL => case Int.compare(q1,q2)
-			       of LESS => x1::go_nondet(r1,l2)
-				| GREATER => x2::go_nondet(l1,r2)
-				| EQUAL => go_nondet(l1,r2)
-	 in 
-	    if nondet then go_nondet ll else go_det ll
-	 end
+            fun go_nondet (nil,l) = l 
+              | go_nondet (l,nil) = l
+              | go_nondet (l1 as (x1 as (q1,a1))::r1,l2 as (x2 as (q2,a2))::r2) = 
+               case Int.compare(a1,a2) 
+                 of LESS => x1::go_nondet(r1,l2) 
+                  | GREATER => x2::go_nondet(l1,r2)
+                  | EQUAL => case Int.compare(q1,q2)
+                               of LESS => x1::go_nondet(r1,l2)
+                                | GREATER => x2::go_nondet(l1,r2)
+                                | EQUAL => go_nondet(l1,r2)
+         in 
+            if nondet then go_nondet ll else go_det ll
+         end
 
       (*--------------------------------------------------------------------*)
       (* what are the least and largest symbol occurring in a Follow set?   *)
       (*--------------------------------------------------------------------*)
       fun boundsFollow (nil:Follow) = (1,0)
-	| boundsFollow [(q,a)]      = (a,a)
-	| boundsFollow ((q,a)::xs)  = (a,#2(List.last xs))
+        | boundsFollow [(q,a)]      = (a,a)
+        | boundsFollow ((q,a)::xs)  = (a,#2(List.last xs))
 
       (*--------------------------------------------------------------------*)
       (* return the list of all symbols occurring in a content model.       *)
       (*--------------------------------------------------------------------*)
       fun cmSymbols cm = 
-	 let 
-	    fun do_cm(cm,yet) = 
-	       case cm 
-		 of CM_ELEM a  => insertInt(a,yet)
-		  | CM_OPT cm  => do_cm(cm,yet)
-		  | CM_REP cm  => do_cm(cm,yet)
-		  | CM_PLUS cm => do_cm(cm,yet)
-		  | CM_ALT cms => foldr do_cm yet cms
-		  | CM_SEQ cms => foldr do_cm yet cms
-	 in do_cm(cm,nil)
-	 end
+         let 
+            fun do_cm(cm,yet) = 
+               case cm 
+                 of CM_ELEM a  => insertInt(a,yet)
+                  | CM_OPT cm  => do_cm(cm,yet)
+                  | CM_REP cm  => do_cm(cm,yet)
+                  | CM_PLUS cm => do_cm(cm,yet)
+                  | CM_ALT cms => foldr do_cm yet cms
+                  | CM_SEQ cms => foldr do_cm yet cms
+         in do_cm(cm,nil)
+         end
 
       (*--------------------------------------------------------------------*)
       (* given the follow set and the final flag, make a row in the dfa.    *)
       (*--------------------------------------------------------------------*)
       fun makeRow (flw,fin) = 
-	 let 
-	    val (lo,hi) = boundsFollow flw
-	    val tab = Array.array(hi-lo+1,dfaError)
-	    val _ = app (fn (q,a) => Array.update (tab,a-lo,q)) flw
-	 in 
-	    (lo,hi,Array.extract (tab,0,NONE),fin)
-	 end
+         let 
+            val (lo,hi) = boundsFollow flw
+            val tab = Array.array(hi-lo+1,dfaError)
+            val _ = app (fn (q,a) => Array.update (tab,a-lo,q)) flw
+         in 
+            (lo,hi,Array.extract (tab,0,NONE),fin)
+         end
 
    end
 (* stop of ../../Parser/Dfa/dfaUtil.sml *)
@@ -6883,129 +6883,129 @@
       val !! = W.notb
 
       fun normalize (vec:IntSet) = 
-	 let val max = Vector.foldli
-	    (fn (i,w,max) => if w=0wx0 then i else max) 0 (vec,0,NONE)
-	 in Vector.extract (vec,0,SOME max)
-	 end
+         let val max = Vector.foldli
+            (fn (i,w,max) => if w=0wx0 then i else max) 0 (vec,0,NONE)
+         in Vector.extract (vec,0,SOME max)
+         end
 
       val emptyIntSet = Vector.fromList nil : IntSet
 
       fun fullIntSet n = let val size = (n+wordSize-1) div wordSize
-			     val full = 0w0-0w1:W.word
-			     val bits = (n-1) mod wordSize+1
-			     val last = full >> (Word.fromInt (wordSize-bits))
-			 in Vector.tabulate(n div wordSize+1,
-					    fn i => if i<size-1 then full else last):IntSet
-			 end
+                             val full = 0w0-0w1:W.word
+                             val bits = (n-1) mod wordSize+1
+                             val last = full >> (Word.fromInt (wordSize-bits))
+                         in Vector.tabulate(n div wordSize+1,
+                                            fn i => if i<size-1 then full else last):IntSet
+                         end
 
       fun singleIntSet n = 
-	 let 
-	    val idx = n div wordSize
-	    val mask = 0w1 << (Word.fromInt (n mod wordSize))
-	 in 
-	    Vector.tabulate(idx+1,fn i => if i=idx then mask else 0w0):IntSet
-	 end
+         let 
+            val idx = n div wordSize
+            val mask = 0w1 << (Word.fromInt (n mod wordSize))
+         in 
+            Vector.tabulate(idx+1,fn i => if i=idx then mask else 0w0):IntSet
+         end
 
       fun isEmptyIntSet vec = Vector.length vec=0
 
       fun inIntSet(n,vec) = 
-	 let val idx = n div wordSize
-	 in if idx>=Vector.length vec then false 
-	    else let val mask = 0w1 << (Word.fromInt (n mod wordSize))
-		 in Vector.sub(vec,idx) && mask <> 0w0
-		 end
-	 end
+         let val idx = n div wordSize
+         in if idx>=Vector.length vec then false 
+            else let val mask = 0w1 << (Word.fromInt (n mod wordSize))
+                 in Vector.sub(vec,idx) && mask <> 0w0
+                 end
+         end
 
       fun addIntSet(n,vec) = 
-	 let
-	    val idx = n div wordSize
-	    val mask = 0w1 << (Word.fromInt (n mod wordSize))
-	    val size = Vector.length vec
-	 in 
-	    if size>idx 
-	       then Vector.mapi (fn (i,x) => if i=idx then x||mask else x) (vec,0,NONE)
-	    else Vector.tabulate 
-	       (idx+1,fn i => if i<size then Vector.sub(vec,i) else if i=idx then mask else 0w0)
-	 end
+         let
+            val idx = n div wordSize
+            val mask = 0w1 << (Word.fromInt (n mod wordSize))
+            val size = Vector.length vec
+         in 
+            if size>idx 
+               then Vector.mapi (fn (i,x) => if i=idx then x||mask else x) (vec,0,NONE)
+            else Vector.tabulate 
+               (idx+1,fn i => if i<size then Vector.sub(vec,i) else if i=idx then mask else 0w0)
+         end
 
       fun delIntSet(n,vec) = 
-	 let
-	    val idx = n div wordSize
-	    val size = Vector.length vec
-	    val vec1 = if size<=idx then vec
-		       else let val mask = !! (0w1 << (Word.fromInt (n mod wordSize)))
-			    in Vector.mapi 
-			       (fn (i,x) => if i=idx then x && mask else x) (vec,0,NONE)
-			    end
-	 in normalize vec1
-	 end
+         let
+            val idx = n div wordSize
+            val size = Vector.length vec
+            val vec1 = if size<=idx then vec
+                       else let val mask = !! (0w1 << (Word.fromInt (n mod wordSize)))
+                            in Vector.mapi 
+                               (fn (i,x) => if i=idx then x && mask else x) (vec,0,NONE)
+                            end
+         in normalize vec1
+         end
       
       fun capIntSets(vec1,vec2) = 
-	 let 
-	    val l12 = Int.min(Vector.length vec1,Vector.length vec2)
-	    val v12 = Vector.tabulate(l12,fn i => Vector.sub(vec1,i) && Vector.sub(vec2,i))
-	 in 
-	    normalize v12
-	 end
+         let 
+            val l12 = Int.min(Vector.length vec1,Vector.length vec2)
+            val v12 = Vector.tabulate(l12,fn i => Vector.sub(vec1,i) && Vector.sub(vec2,i))
+         in 
+            normalize v12
+         end
 
       fun cupIntSets(vec1,vec2) = 
-	 let 
-	    val (l1,l2) = (Vector.length vec1,Vector.length vec2)
-	    val (shorter,longer,v) = if l1<=l2 then (l1,l2,vec2) else (l2,l1,vec1)
-	 in 
-	    Vector.tabulate (longer,fn i => if i>=shorter then Vector.sub(v,i)
-					    else Vector.sub(vec1,i) || Vector.sub(vec2,i))
-	 end
+         let 
+            val (l1,l2) = (Vector.length vec1,Vector.length vec2)
+            val (shorter,longer,v) = if l1<=l2 then (l1,l2,vec2) else (l2,l1,vec1)
+         in 
+            Vector.tabulate (longer,fn i => if i>=shorter then Vector.sub(v,i)
+                                            else Vector.sub(vec1,i) || Vector.sub(vec2,i))
+         end
 
       fun diffIntSets(vec1,vec2) = 
-	 let 
-	    val (l1,l2) = (Vector.length vec1,Vector.length vec2)
-	    val vec1 = Vector.tabulate 
-	       (l1,fn i => if i>=l2 then Vector.sub(vec1,i)
-			   else Vector.sub(vec1,i) && !!(Vector.sub(vec2,i)))
-	 in normalize vec1
-	 end
+         let 
+            val (l1,l2) = (Vector.length vec1,Vector.length vec2)
+            val vec1 = Vector.tabulate 
+               (l1,fn i => if i>=l2 then Vector.sub(vec1,i)
+                           else Vector.sub(vec1,i) && !!(Vector.sub(vec2,i)))
+         in normalize vec1
+         end
       
       fun IntList2Set l = List.foldl addIntSet emptyIntSet l
 
       fun IntSet2List vec = 
-	 let 
-	    val size = Vector.length vec
-	    fun doOne (w,off,yet) = 
-	       let fun doit (i,mask) = 
-		  if i=wordSize then yet 
-		  else if w&&mask=0w0 then doit(i+1,mask<<0wx1)
-		       else (off+i)::doit(i+1,mask<<0wx1)
-	       in doit(0,0wx1)
-	       end
-	    fun doAll i = if i>=size then nil
-			  else doOne(Vector.sub(vec,i),wordSize*i,(doAll (i+1)))
-	 in doAll 0
-	 end
+         let 
+            val size = Vector.length vec
+            fun doOne (w,off,yet) = 
+               let fun doit (i,mask) = 
+                  if i=wordSize then yet 
+                  else if w&&mask=0w0 then doit(i+1,mask<<0wx1)
+                       else (off+i)::doit(i+1,mask<<0wx1)
+               in doit(0,0wx1)
+               end
+            fun doAll i = if i>=size then nil
+                          else doOne(Vector.sub(vec,i),wordSize*i,(doAll (i+1)))
+         in doAll 0
+         end
 
       fun compareIntSets (vec1,vec2:IntSet) =
-	 let 
-	    val (l1,l2) = (Vector.length vec1,Vector.length vec2)
-	    val (l12,ifEq) = case Int.compare(l1,l2)
-			       of LESS => (l1,LESS)
-				| order => (l2,order)
-	    fun doit i = if i>=l12 then ifEq
-			 else case W.compare(Vector.sub(vec1,i),Vector.sub(vec2,i))
-				of EQUAL => doit (i+1)
-				 | order => order
-	 in doit 0
-	 end
+         let 
+            val (l1,l2) = (Vector.length vec1,Vector.length vec2)
+            val (l12,ifEq) = case Int.compare(l1,l2)
+                               of LESS => (l1,LESS)
+                                | order => (l2,order)
+            fun doit i = if i>=l12 then ifEq
+                         else case W.compare(Vector.sub(vec1,i),Vector.sub(vec2,i))
+                                of EQUAL => doit (i+1)
+                                 | order => order
+         in doit 0
+         end
 
       val intShift = case Int.precision 
-		       of NONE => 0w0
-			| SOME x => Word.fromInt(Int.max(wordSize-x+1,0))
+                       of NONE => 0w0
+                        | SOME x => Word.fromInt(Int.max(wordSize-x+1,0))
 
       fun hashIntSet vec = 
-	 case Vector.length vec
-	   of 0 => 0w0 
-	    | 1 => Word.fromInt(W.toInt(W.>>(Vector.sub(vec,0),intShift)))
-	    | l => Word.fromInt(W.toInt(W.>>(Vector.sub(vec,0)+Vector.sub(vec,l-1),intShift)))
-   end			      
+         case Vector.length vec
+           of 0 => 0w0 
+            | 1 => Word.fromInt(W.toInt(W.>>(Vector.sub(vec,0),intShift)))
+            | l => Word.fromInt(W.toInt(W.>>(Vector.sub(vec,0)+Vector.sub(vec,l-1),intShift)))
+   end                        
 (* stop of ../../Util/intSets.sml *)
 (* start of ../../Util/SymDict/intSetDict.sml *)
 
@@ -7065,8 +7065,8 @@
 functor DfaPassThree (structure DfaOptions : DfaOptions) : DfaPassThree = 
    struct 
       open 
-	 IntSets IntSetDict DfaBase DfaOptions DfaUtil
-	 
+         IntSets IntSetDict DfaBase DfaOptions DfaUtil
+         
       (*--------------------------------------------------------------------*)
       (* do the subset construction.                                        *)
       (*--------------------------------------------------------------------*)
@@ -7078,50 +7078,50 @@
       (* - delta'(S,a) = {p | (q,a,p) in delta, q in S}                     *) 
       (*--------------------------------------------------------------------*)
       fun makeDet tab = 
-	 let 
-	    (* the new start state is the singleton of the old start state  *)
-	    val sNull = singleIntSet 0
+         let 
+            (* the new start state is the singleton of the old start state  *)
+            val sNull = singleIntSet 0
 
-	    (* create a dictionary for the subsets, make sNull get index 0  *)
-	    val tau = makeDict("",!O_DFA_INITIAL_WIDTH,(nil:Follow,false))
-	    val pInitial = getIndex(tau,sNull) 
+            (* create a dictionary for the subsets, make sNull get index 0  *)
+            val tau = makeDict("",!O_DFA_INITIAL_WIDTH,(nil:Follow,false))
+            val pInitial = getIndex(tau,sNull) 
 
-	    (* enter a new set state. raise DfaTooLarge if the new state    *)
-	    (* would have a too large index                                 *)
-	    fun makeState s = 
-	       let val (max,i) = (!O_DFA_MAX_STATES,getIndex(tau,s))
-	       in if max>i then i else raise DfaTooLarge max
-	       end
+            (* enter a new set state. raise DfaTooLarge if the new state    *)
+            (* would have a too large index                                 *)
+            fun makeState s = 
+               let val (max,i) = (!O_DFA_MAX_STATES,getIndex(tau,s))
+               in if max>i then i else raise DfaTooLarge max
+               end
 
-	    (* compute the follow set for a set state from the follow sets  *)
-	    (* of its members                                               *)
-	    fun makeFollow NONE nil = nil
-	      | makeFollow (SOME(s,a)) nil = [(makeState s,a)]
-	      | makeFollow NONE ((q,a)::qas) = makeFollow (SOME(singleIntSet q,a)) qas
-	      | makeFollow (SOME(s,a)) ((q,b)::qas) = 
-	       if a=b then makeFollow (SOME(addIntSet(q,s),a)) qas
-	       else (makeState s,a)::makeFollow (SOME(singleIntSet q,b)) qas
+            (* compute the follow set for a set state from the follow sets  *)
+            (* of its members                                               *)
+            fun makeFollow NONE nil = nil
+              | makeFollow (SOME(s,a)) nil = [(makeState s,a)]
+              | makeFollow NONE ((q,a)::qas) = makeFollow (SOME(singleIntSet q,a)) qas
+              | makeFollow (SOME(s,a)) ((q,b)::qas) = 
+               if a=b then makeFollow (SOME(addIntSet(q,s),a)) qas
+               else (makeState s,a)::makeFollow (SOME(singleIntSet q,b)) qas
 
-	    (* continue until all entries in the state dictionary are done -*)
-	    fun doit i = 
-	       if i>=usedIndices tau then i
-	       else let val sI = getKey(tau,i)
-			val lI = IntSet2List sI
-			val ffs = map (fn j => Vector.sub(tab,j)) lI
-			val (followJs,finI) = foldl 
-			   (fn ((flwJ,finJ),(flw,fin)) => (mergeFollow true (flwJ,flw),
-							   finJ orelse fin))
-			   (nil,false) ffs
-			val followI = makeFollow NONE followJs
-			val _ = setByIndex(tau,i,(followI,finI))
-		    in doit (i+1)
-		    end
+            (* continue until all entries in the state dictionary are done -*)
+            fun doit i = 
+               if i>=usedIndices tau then i
+               else let val sI = getKey(tau,i)
+                        val lI = IntSet2List sI
+                        val ffs = map (fn j => Vector.sub(tab,j)) lI
+                        val (followJs,finI) = foldl 
+                           (fn ((flwJ,finJ),(flw,fin)) => (mergeFollow true (flwJ,flw),
+                                                           finJ orelse fin))
+                           (nil,false) ffs
+                        val followI = makeFollow NONE followJs
+                        val _ = setByIndex(tau,i,(followI,finI))
+                    in doit (i+1)
+                    end
 
-	    val size = doit 0
-	 in (* finally create a vector holding the new follow/fin pairs     *)
-	    Vector.tabulate (size,fn i => getByIndex(tau,i))
-	 end
-	 
+            val size = doit 0
+         in (* finally create a vector holding the new follow/fin pairs     *)
+            Vector.tabulate (size,fn i => getByIndex(tau,i))
+         end
+         
       (*--------------------------------------------------------------------*)
       (* given a vector of Follow and boolean final condition, make a dfa   *)
       (* out of it. if the first arg is true, then the content model was    *)
@@ -7129,10 +7129,10 @@
       (* in order to obtain a deterministic finite machine.                 *)
       (*--------------------------------------------------------------------*)
       fun passThree nondet tab =  
-	 let 
-	    val det = if nondet then makeDet tab else tab
-	 in Vector.map makeRow det
-	 end
+         let 
+            val det = if nondet then makeDet tab else tab
+         in Vector.map makeRow det
+         end
    end
 (* stop of ../../Parser/Dfa/dfaPassThree.sml *)
 (* start of ../../Parser/Dfa/dfaError.sml *)
@@ -7156,7 +7156,7 @@
 signature DfaError =
    sig
       val countOccs : DfaBase.Sigma * DfaBase.State * DfaBase.State 
-	 -> DfaBase.ContentModel -> DfaBase.Sigma * int * int
+         -> DfaBase.ContentModel -> DfaBase.Sigma * int * int
    end
 
 structure DfaError : DfaError =
@@ -7164,35 +7164,35 @@
       open DfaBase
 
       fun countOccs (a,q1,q2) cm =
-	 let 
-	    val (q1,q2) = if q1>q2 then (q2,q1) else (q1,q2)
+         let 
+            val (q1,q2) = if q1>q2 then (q2,q1) else (q1,q2)
 
-	    fun next a nil = (1,[(a,2)])
-	      | next a ((b,n)::rest) =
-	       if a=b then (n,(b,n+1)::rest)
-	       else if a<b then (1,(a,2)::(b,n)::rest)
-		    else let val (m,new) = next a rest
-			 in (m,(b,n)::new)
-			 end
+            fun next a nil = (1,[(a,2)])
+              | next a ((b,n)::rest) =
+               if a=b then (n,(b,n+1)::rest)
+               else if a<b then (1,(a,2)::(b,n)::rest)
+                    else let val (m,new) = next a rest
+                         in (m,(b,n)::new)
+                         end
 
-	    fun insert a (q,yet,n1,n2) =
-	       let val (n,new) = next a yet
-	       in (q+1,new,if q=q1 then n else n1,if q=q2 then n else n2)
-	       end
+            fun insert a (q,yet,n1,n2) =
+               let val (n,new) = next a yet
+               in (q+1,new,if q=q1 then n else n1,if q=q2 then n else n2)
+               end
 
-	    fun doit (cm,yet) =
-	       case cm
-		 of CM_ELEM a => insert a yet
-		  | CM_OPT cmi => doit (cmi,yet)
-		  | CM_REP cmi => doit (cmi,yet)
-		  | CM_PLUS cmi => doit (cmi,yet)
-		  | CM_ALT cmis => foldl doit yet cmis
-		  | CM_SEQ cmis => foldl doit yet cmis
+            fun doit (cm,yet) =
+               case cm
+                 of CM_ELEM a => insert a yet
+                  | CM_OPT cmi => doit (cmi,yet)
+                  | CM_REP cmi => doit (cmi,yet)
+                  | CM_PLUS cmi => doit (cmi,yet)
+                  | CM_ALT cmis => foldl doit yet cmis
+                  | CM_SEQ cmis => foldl doit yet cmis
 
-	    val (_,_,n1,n2) = doit (cm,(1,nil,0,0))
-	 in 
-	    (a,n1,n2)
-	 end
+            val (_,_,n1,n2) = doit (cm,(1,nil,0,0))
+         in 
+            (a,n1,n2)
+         end
    end
 (* stop of ../../Parser/Dfa/dfaError.sml *)
 (* start of ../../Parser/Dfa/dfaPassOne.sml *)
@@ -7243,43 +7243,43 @@
       (*                   then raise ConflictFirst(a,q1,q2)                *)
       (*--------------------------------------------------------------------*)
       fun passOne nondet cm = 
-	 let 
-	    fun und(a,b) = a andalso b
-	    fun oder(a,b) = a orelse b
-	       
-	    fun op_fst_seq (fst,fsts,mt) = if mt then mergeFirst nondet (fst,fsts) else fst
-	    fun op_fst_or  (fst,fsts,_)  = mergeFirst nondet (fst,fsts)
-	       
-	    fun do_cm cm q =
-	       case cm
-		 of CM_ELEM a  => (ELEM a,(q+1,false,[(q+1,a)]))
-		  | CM_OPT cm  => let val cmi as (_,(q1,_,fst)) = do_cm cm q
-				  in (OPT cmi,(q1,true,fst))
-				  end
-		  | CM_REP cm  => let val cmi as (_,(q1,_,fst)) = do_cm cm q
-				  in (REP cmi,(q1,true,fst))
-				  end
-		  | CM_PLUS cm => let val cmi as (_,info1) = do_cm cm q
-				  in (PLUS cmi,info1) 
-				  end 
-		  | CM_ALT cms => do_cms (ALT,false,oder,op_fst_or) cms q
-		  | CM_SEQ cms => do_cms (SEQ,true,und,op_fst_seq) cms q
-				  
-	    and do_cms(con,null_mt,op_mt,op_fst) cms q = 
-	       let 
-		  fun doit [] q = ([],(q,null_mt,[]))
-		    | doit (cm::cms) q =
-		     let 
-			val cmi as (_,(q1,mt1,fst1)) = do_cm cm q
-			val (cmis,(q2,mt2,fst2)) = doit cms q1
-		     in (cmi::cmis,(q2,op_mt(mt1,mt2),op_fst(fst1,fst2,mt1)))
-		     end
-		  val (cmis,info1) = doit cms q
-	       in (con cmis,info1)
-	       end
-	    
-	 in do_cm cm 0
-	 end
+         let 
+            fun und(a,b) = a andalso b
+            fun oder(a,b) = a orelse b
+               
+            fun op_fst_seq (fst,fsts,mt) = if mt then mergeFirst nondet (fst,fsts) else fst
+            fun op_fst_or  (fst,fsts,_)  = mergeFirst nondet (fst,fsts)
+               
+            fun do_cm cm q =
+               case cm
+                 of CM_ELEM a  => (ELEM a,(q+1,false,[(q+1,a)]))
+                  | CM_OPT cm  => let val cmi as (_,(q1,_,fst)) = do_cm cm q
+                                  in (OPT cmi,(q1,true,fst))
+                                  end
+                  | CM_REP cm  => let val cmi as (_,(q1,_,fst)) = do_cm cm q
+                                  in (REP cmi,(q1,true,fst))
+                                  end
+                  | CM_PLUS cm => let val cmi as (_,info1) = do_cm cm q
+                                  in (PLUS cmi,info1) 
+                                  end 
+                  | CM_ALT cms => do_cms (ALT,false,oder,op_fst_or) cms q
+                  | CM_SEQ cms => do_cms (SEQ,true,und,op_fst_seq) cms q
+                                  
+            and do_cms(con,null_mt,op_mt,op_fst) cms q = 
+               let 
+                  fun doit [] q = ([],(q,null_mt,[]))
+                    | doit (cm::cms) q =
+                     let 
+                        val cmi as (_,(q1,mt1,fst1)) = do_cm cm q
+                        val (cmis,(q2,mt2,fst2)) = doit cms q1
+                     in (cmi::cmis,(q2,op_mt(mt1,mt2),op_fst(fst1,fst2,mt1)))
+                     end
+                  val (cmis,info1) = doit cms q
+               in (con cmis,info1)
+               end
+            
+         in do_cm cm 0
+         end
    end
 (* stop of ../../Parser/Dfa/dfaPassOne.sml *)
 (* start of ../../Parser/Dfa/dfaPassTwo.sml *)
@@ -7306,59 +7306,59 @@
 structure DfaPassTwo : DfaPassTwo = 
    struct 
       open DfaBase DfaUtil
-	 
+         
       (*--------------------------------------------------------------------*)
       (* Given a CM annotated with leaf numbers (states), Empty and First,  *)
       (* compute Follow and Fin foreach node, and generate the transition   *)
       (* row if node is a leaf. Follow and Fin are computed top-down:       *)
       (*                                                                    *)
-      (* (Top-Level):							    *)
+      (* (Top-Level):                                                       *)
       (* Follow e = {}, Fin e = true                                        *)
-      (* 								    *)
-      (* (e=e1?):							    *)
-      (* Follow e1 = Follow e, Fin e1 = Fin e				    *)
-      (* 								    *)
-      (* (e=e1*, e=e1+)							    *)
-      (* Follow e1 = Follow e1 ++ First e1, Fin e1 = Fin e		    *)
-      (*								    *)
-      (* (e=e1|...|eN) = 						    *)
-      (* Follow eI = Follow e, Fin eI = Fin e for i=0...n		    *)
-      (*								    *)
-      (* (e=e1,...,eN) = 						    *)
-      (* Follow eN = Follow e, Fin eN = Fin e				    *)
+      (*                                                                    *)
+      (* (e=e1?):                                                           *)
+      (* Follow e1 = Follow e, Fin e1 = Fin e                               *)
+      (*                                                                    *)
+      (* (e=e1*, e=e1+)                                                     *)
+      (* Follow e1 = Follow e1 ++ First e1, Fin e1 = Fin e                  *)
+      (*                                                                    *)
+      (* (e=e1|...|eN) =                                                    *)
+      (* Follow eI = Follow e, Fin eI = Fin e for i=0...n                   *)
+      (*                                                                    *)
+      (* (e=e1,...,eN) =                                                    *)
+      (* Follow eN = Follow e, Fin eN = Fin e                               *)
       (* Follow eI = First eI+1,                if Empty eI+1 = false, i<n  *)
       (*             First eI+1 ++ Follow eI+1, if Empty eI+1 = true,  i<n  *)
-      (* Fin eI = false,    if Empty eI+1 = false, i<n			    *)
-      (*          Fin eI+1, if Empty eI+1 = true,  i<n			    *)
+      (* Fin eI = false,    if Empty eI+1 = false, i<n                      *)
+      (*          Fin eI+1, if Empty eI+1 = true,  i<n                      *)
       (*                                                                    *)
       (* F1++F2 = F1 U F2, if a2<>a1 forall (q1,a1) in F1, (q1,a1) in F1}   *)
       (*          error,   if exist (q1,a) in F1, (q2,a) in F2              *)
       (*                   then raise ConflictFirst(a,q1,q2)                *)
       (*--------------------------------------------------------------------*)
       fun passTwo nondet (cmi as (_,(n,mt,fst))) =                                   
-	 let 
-	    val table = Array.array(n+1,(nil,false))
-	       	    
-	    val _ = Array.update(table,0,(fst,mt))
+         let 
+            val table = Array.array(n+1,(nil,false))
+                    
+            val _ = Array.update(table,0,(fst,mt))
 
-	    fun do_cm (ff as (flw,fin)) (cm,(q,mt,fst)) =
-	       case cm 
-		 of ELEM a   => Array.update(table,q,ff)
-		  | OPT cmi  => do_cm ff cmi
-		  | REP cmi  => do_cm (mergeFollow nondet (fst,flw),fin) cmi
-		  | PLUS cmi => do_cm (mergeFollow nondet (fst,flw),fin) cmi
-		  | ALT cmis => app (do_cm ff) cmis
-		  | SEQ cmis => ignore (do_seq ff cmis)
-	    and do_seq ff cmis = foldr 
-	       (fn (cmi as (_,(_,mt,fst)),ff as (flw,fin)) 
-		=> (do_cm ff cmi; 
-		    if mt then (mergeFollow nondet (fst,flw),fin) else (fst,false))) 
-	       ff cmis
+            fun do_cm (ff as (flw,fin)) (cm,(q,mt,fst)) =
+               case cm 
+                 of ELEM a   => Array.update(table,q,ff)
+                  | OPT cmi  => do_cm ff cmi
+                  | REP cmi  => do_cm (mergeFollow nondet (fst,flw),fin) cmi
+                  | PLUS cmi => do_cm (mergeFollow nondet (fst,flw),fin) cmi
+                  | ALT cmis => app (do_cm ff) cmis
+                  | SEQ cmis => ignore (do_seq ff cmis)
+            and do_seq ff cmis = foldr 
+               (fn (cmi as (_,(_,mt,fst)),ff as (flw,fin)) 
+                => (do_cm ff cmi; 
+                    if mt then (mergeFollow nondet (fst,flw),fin) else (fst,false))) 
+               ff cmis
 
-	    val _ = do_cm (nil,true) cmi
+            val _ = do_cm (nil,true) cmi
 
-	 in Array.extract (table,0,NONE)
-	 end
+         in Array.extract (table,0,NONE)
+         end
     end
 (* stop of ../../Parser/Dfa/dfaPassTwo.sml *)
 (* start of ../../Parser/Dfa/dfa.sml *)
@@ -7395,7 +7395,7 @@
 signature Dfa = 
    sig
       eqtype DfaState
-	 
+         
       val dfaError   : DfaState
       val dfaInitial : DfaState
 
@@ -7413,11 +7413,11 @@
    end
 
 functor Dfa (structure DfaOptions : DfaOptions) : Dfa =
-   struct	
+   struct       
       structure DfaPassThree = DfaPassThree (structure DfaOptions = DfaOptions) 
 
       open 
-	 DfaBase DfaError DfaPassOne DfaPassTwo DfaString DfaUtil
+         DfaBase DfaError DfaPassOne DfaPassTwo DfaString DfaUtil
 
       type DfaState = State
 
@@ -7426,53 +7426,53 @@
       (* are the symbols occurring in the input dfa.                        *)
       (*--------------------------------------------------------------------*)
       fun makeChoiceDfa cm =
-	 let 
-	    val syms = cmSymbols cm
-	    val flw = map (fn a => (dfaInitial,a)) syms
-	 in 
-	    Vector.fromList [makeRow(flw,true)]
-	 end
+         let 
+            val syms = cmSymbols cm
+            val flw = map (fn a => (dfaInitial,a)) syms
+         in 
+            Vector.fromList [makeRow(flw,true)]
+         end
 
       (*--------------------------------------------------------------------*)
       (* create a dfa for an ambiguous content model. Raise DfaTooLarge if  *)
       (* the subset construction yields too many states.                    *)
       (*--------------------------------------------------------------------*)
       fun makeAmbiguous cm = 
-	 let 
-	    val cmi = DfaPassOne.passOne true cm
-	    val tab = DfaPassTwo.passTwo true cmi
-	    val dfa = DfaPassThree.passThree true tab
-	 in dfa
-	 end
-	    
+         let 
+            val cmi = DfaPassOne.passOne true cm
+            val tab = DfaPassTwo.passTwo true cmi
+            val dfa = DfaPassThree.passThree true tab
+         in dfa
+         end
+            
       (*--------------------------------------------------------------------*)
       (* generate a dfa for a content model. Raise Ambiguous if the content *)
       (* model is ambiguous.                                                *)
       (*--------------------------------------------------------------------*)
       fun makeDfa cm = 
-	 let 
-	    val cmi = DfaPassOne.passOne false cm
-	    val tab = DfaPassTwo.passTwo false cmi
-	    val dfa = DfaPassThree.passThree false tab
-	 in dfa
-	 end
+         let 
+            val cmi = DfaPassOne.passOne false cm
+            val tab = DfaPassTwo.passTwo false cmi
+            val dfa = DfaPassThree.passThree false tab
+         in dfa
+         end
       handle ConflictFirst aqq => raise Ambiguous (countOccs aqq cm)
-	   | ConflictFollow aqq => raise Ambiguous (countOccs aqq cm)
+           | ConflictFollow aqq => raise Ambiguous (countOccs aqq cm)
       
       (*--------------------------------------------------------------------*)
       (* make one transitions in the dfa.                                   *)
       (*--------------------------------------------------------------------*)
       fun dfaTrans(tab,q,a) = 
-	 if q<0 then dfaDontCare 
-	 else let val (lo,hi,tab,_) = Vector.sub(tab,q)
-	      in if a>=lo andalso a<=hi then Vector.sub(tab,a-lo) else dfaError
-	      end
+         if q<0 then dfaDontCare 
+         else let val (lo,hi,tab,_) = Vector.sub(tab,q)
+              in if a>=lo andalso a<=hi then Vector.sub(tab,a-lo) else dfaError
+              end
 
       (*--------------------------------------------------------------------*)
       (* check whether a dfa's state is an accepting state.                 *)
       (*--------------------------------------------------------------------*)
       fun dfaFinal (tab,q) = 
-	 q<0 orelse #4(Vector.sub(tab,q):Row)
+         q<0 orelse #4(Vector.sub(tab,q):Row)
    end
 (* stop of ../../Parser/Dfa/dfa.sml *)
 (* start of ../../Parser/entities.sml *)
@@ -7575,7 +7575,7 @@
       (* Make an EntId from the entity's index.                             *)
       (*--------------------------------------------------------------------*)
       fun makeEntId(idx,isParam) = 
-	 if isParam then PARAMETER idx else GENERAL idx
+         if isParam then PARAMETER idx else GENERAL idx
 
       (*--------------------------------------------------------------------*)
       (* A non-empty stack is:                                              *)
@@ -7625,13 +7625,13 @@
       (*--------------------------------------------------------------------*)
       datatype ExtType = SPECIAL of Special | NORMAL of EntId * State
       and State = 
-	  LOOKED  of Data * State
-	| ENDED of EntId * State
-	| CLOSED of DecFile * int * int * ExtType
-	| INT of Vector * int * int * (EntId * State)
-	| EXT1 of DecFile * int * int * bool * ExtType
-	| EXT2 of CharBuffer * int * int * int * int * bool
-	 * (DecFile * DecodeError option * ExtType)
+          LOOKED  of Data * State
+        | ENDED of EntId * State
+        | CLOSED of DecFile * int * int * ExtType
+        | INT of Vector * int * int * (EntId * State)
+        | EXT1 of DecFile * int * int * bool * ExtType
+        | EXT2 of CharBuffer * int * int * int * int * bool
+         * (DecFile * DecodeError option * ExtType)
 
       exception CantOpenFile of (string * string) * AppData
 
@@ -7639,14 +7639,14 @@
       (* Extract the unique number from a state.                            *)
       (*--------------------------------------------------------------------*)
       fun getExtEntId extType =
-	 case extType 
-	   of SPECIAL DOC_ENTITY => GENERAL 0
-	    | SPECIAL EXT_SUBSET => PARAMETER 0
-	    | NORMAL(id,_) => id
+         case extType 
+           of SPECIAL DOC_ENTITY => GENERAL 0
+            | SPECIAL EXT_SUBSET => PARAMETER 0
+            | NORMAL(id,_) => id
       fun getEntId q =
          case q 
-	   of LOOKED (_,q) => getEntId q
-	    | ENDED(id,_) => id
+           of LOOKED (_,q) => getEntId q
+            | ENDED(id,_) => id
             | CLOSED(_,_,_,extType) => getExtEntId extType
             | INT(_,_,_,(id,_)) => id
             | EXT1(_,_,_,_,extType) => getExtEntId extType
@@ -7662,11 +7662,11 @@
             | INT(_,_,_,(_,other)) => getPos other
             | CLOSED(dec,l,col,_) => (decName dec,l,col)
             | EXT1(dec,l,col,_,_) => (decName dec,l,col)
-	    | EXT2(_,_,_,l,col,_,(dec,_,_)) => (decName dec,l,col)
+            | EXT2(_,_,_,l,col,_,(dec,_,_)) => (decName dec,l,col)
             | LOOKED (cs,q) => let val (f,l,c) = getPos q
-	                           val k = length cs 
-			       in if c>=k then (f,l,c-k) else (f,l,0)
-			       end
+                                   val k = length cs 
+                               in if c>=k then (f,l,c-k) else (f,l,0)
+                               end
 
       (*--------------------------------------------------------------------*)
       (* get the path of the nearest enclosing external entity.             *)
@@ -7674,7 +7674,7 @@
       fun getUri q =
          case q 
            of LOOKED (_,q) => getUri q
-	    | ENDED(_,other) => getUri other
+            | ENDED(_,other) => getUri other
             | INT(_,_,_,(_,other)) => getUri other
             | CLOSED(dec,l,col,_) => decUri dec
             | EXT1(dec,l,col,_,_) => decUri dec
@@ -7684,35 +7684,35 @@
       (* close all files, return nothing.                                   *)
       (*--------------------------------------------------------------------*)
       fun closeAll q =
-	 case q
-	   of LOOKED(_,other) => closeAll other
-	    | ENDED(_,other) => closeAll other
-	    | CLOSED(_,_,_,SPECIAL _) => ()
-	    | CLOSED(_,_,_,NORMAL(_,other)) => closeAll other
-	    | INT(_,_,_,(_,other)) => closeAll other
-	    | EXT1(dec,_,_,_,SPECIAL _) => ignore(decClose dec)
-	    | EXT1(dec,_,_,_,NORMAL(_,other)) => (decClose dec; closeAll other)
-	    | EXT2(_,_,_,_,_,_,(dec,_,SPECIAL _)) => ignore(decClose dec)
-	    | EXT2(_,_,_,_,_,_,(dec,_,NORMAL(_,other))) => (decClose dec; closeAll other)
+         case q
+           of LOOKED(_,other) => closeAll other
+            | ENDED(_,other) => closeAll other
+            | CLOSED(_,_,_,SPECIAL _) => ()
+            | CLOSED(_,_,_,NORMAL(_,other)) => closeAll other
+            | INT(_,_,_,(_,other)) => closeAll other
+            | EXT1(dec,_,_,_,SPECIAL _) => ignore(decClose dec)
+            | EXT1(dec,_,_,_,NORMAL(_,other)) => (decClose dec; closeAll other)
+            | EXT2(_,_,_,_,_,_,(dec,_,SPECIAL _)) => ignore(decClose dec)
+            | EXT2(_,_,_,_,_,_,(dec,_,NORMAL(_,other))) => (decClose dec; closeAll other)
 
       (*--------------------------------------------------------------------*)
       (* is this entity already on the stack?                               *)
       (*--------------------------------------------------------------------*)
       fun isOpen (idx,isParam,q) =
-	 let val id = makeEntId(idx,isParam)
-	    fun doit q =
-	       case q 
-		 of LOOKED (_,other) => doit other
-		  | ENDED(id',other) => id=id' orelse doit other
-		  | CLOSED(_,_,_,SPECIAL _) => false
-		  | CLOSED(_,_,_,NORMAL(id',other)) => id=id' orelse doit other
-		  | INT(_,_,_,(id',other)) => id=id' orelse doit other
-		  | EXT1(_,_,_,_,SPECIAL _) => false
-		  | EXT1(_,_,_,_,NORMAL(id',other)) => id=id' orelse doit other
-		  | EXT2(_,_,_,_,_,_,(_,_,SPECIAL _)) => false
-		  | EXT2(_,_,_,_,_,_,(_,_,NORMAL(id',other))) => id=id' orelse doit other
-	 in doit q
-	 end
+         let val id = makeEntId(idx,isParam)
+            fun doit q =
+               case q 
+                 of LOOKED (_,other) => doit other
+                  | ENDED(id',other) => id=id' orelse doit other
+                  | CLOSED(_,_,_,SPECIAL _) => false
+                  | CLOSED(_,_,_,NORMAL(id',other)) => id=id' orelse doit other
+                  | INT(_,_,_,(id',other)) => id=id' orelse doit other
+                  | EXT1(_,_,_,_,SPECIAL _) => false
+                  | EXT1(_,_,_,_,NORMAL(id',other)) => id=id' orelse doit other
+                  | EXT2(_,_,_,_,_,_,(_,_,SPECIAL _)) => false
+                  | EXT2(_,_,_,_,_,_,(_,_,NORMAL(id',other))) => id=id' orelse doit other
+         in doit q
+         end
 
       (*--------------------------------------------------------------------*)
       (* are we in the internal subset, i.e., in the document entity?       *)
@@ -7723,7 +7723,7 @@
       fun inDocEntity q = 
          case q 
            of LOOKED (_,q) => inDocEntity q
-	    | ENDED(_,other) => inDocEntity other 
+            | ENDED(_,other) => inDocEntity other 
             | INT(_,_,_,(_,other)) => inDocEntity other 
             | CLOSED(_,_,_,NORMAL _) => false
             | CLOSED(_,_,_,SPECIAL what) => what=DOC_ENTITY
@@ -7757,79 +7757,79 @@
       (* Open an external/internal entity.                                  *)
       (*--------------------------------------------------------------------*)
       fun pushIntern(q,id,isParam,vec) = 
-	 INT(vec,Vector.length vec,0,(makeEntId(id,isParam),q))
+         INT(vec,Vector.length vec,0,(makeEntId(id,isParam),q))
       fun pushExtern(q,id,isParam,uri) = 
          let 
-	    val dec = decOpenXml (SOME uri)
-	    val auto = decEncoding dec
-	    val q1 = EXT1(dec,1,0,false,NORMAL(makeEntId(id,isParam),q))
-	 in (q1,auto)
-	 end
+            val dec = decOpenXml (SOME uri)
+            val auto = decEncoding dec
+            val q1 = EXT1(dec,1,0,false,NORMAL(makeEntId(id,isParam),q))
+         in (q1,auto)
+         end
       fun pushSpecial(what,uri) = 
          let 
-	    val dec = decOpenXml uri
-	    val auto = decEncoding dec
-	    val q = EXT1(dec,1,0,false,SPECIAL what)
-	 in (q,auto)
-	 end
+            val dec = decOpenXml uri
+            val auto = decEncoding dec
+            val q = EXT1(dec,1,0,false,SPECIAL what)
+         in (q,auto)
+         end
 
       (*--------------------------------------------------------------------*)
       (* confirm the autodetected encoding of an external entity.           *) 
       (*--------------------------------------------------------------------*)
       fun commitAuto(a,q) =
-	 case q 
-	   of EXT1(dec,l,col,brk,typ) => 
-	      let
-		 val a1 = a before decCommit dec
-		    handle DecError(_,_,err) 
-		    => hookError(a,(getPos q,ERR_DECODE_ERROR err))
-		 val (arr,n,dec1,err) = initArray dec
-	      in (a1,EXT2(arr,n,0,l,col,brk,(dec1,err,typ)))
-	      end
+         case q 
+           of EXT1(dec,l,col,brk,typ) => 
+              let
+                 val a1 = a before decCommit dec
+                    handle DecError(_,_,err) 
+                    => hookError(a,(getPos q,ERR_DECODE_ERROR err))
+                 val (arr,n,dec1,err) = initArray dec
+              in (a1,EXT2(arr,n,0,l,col,brk,(dec1,err,typ)))
+              end
 (*
-	      in (a1,EXT1(dec,l,col,brk,typ))
-	      end
+              in (a1,EXT1(dec,l,col,brk,typ))
+              end
 *)
-	    | LOOKED(cs,q1) => let val (a1,q2) = commitAuto (a,q1)
-			       in (a1,LOOKED(cs,q2))
-			       end
-	    | CLOSED _ => (a,q)
-	    | _ => raise InternalError(THIS_MODULE,"commitAuto",
-				       "entity is neither EXT1 nor CLOSED nor LOOKED")
+            | LOOKED(cs,q1) => let val (a1,q2) = commitAuto (a,q1)
+                               in (a1,LOOKED(cs,q2))
+                               end
+            | CLOSED _ => (a,q)
+            | _ => raise InternalError(THIS_MODULE,"commitAuto",
+                                       "entity is neither EXT1 nor CLOSED nor LOOKED")
 
       (*--------------------------------------------------------------------*)
       (* change from the autodetected encoding to the declared one.         *) 
       (*--------------------------------------------------------------------*) 
       fun changeAuto (a,q,decl) = 
-	 case q 
-	   of EXT1(dec,l,col,brk,typ) => 
-	      let
-		 val dec1 = decSwitch(dec,decl)
-		    handle DecError(dec,_,err) 
-		    => let val a1 = hookError(a,(getPos q,ERR_DECODE_ERROR err))
-			   val _ = decClose dec
-			   val uri = decName dec
-			   val msg = case err 
-				       of ERR_UNSUPPORTED_ENC _ => "Unsupported encoding"
-					| _ => "Declared encoding incompatible"
-					  ^"with auto-detected encoding"
-		       in raise CantOpenFile ((uri,msg),a1)
-		       end
-		 val newEnc = decEncoding dec1
-		 val (arr,n,dec2,err) = initArray dec1
-	      in (a,EXT2(arr,n,0,l,col,brk,(dec2,err,typ)),newEnc)
-	      end
+         case q 
+           of EXT1(dec,l,col,brk,typ) => 
+              let
+                 val dec1 = decSwitch(dec,decl)
+                    handle DecError(dec,_,err) 
+                    => let val a1 = hookError(a,(getPos q,ERR_DECODE_ERROR err))
+                           val _ = decClose dec
+                           val uri = decName dec
+                           val msg = case err 
+                                       of ERR_UNSUPPORTED_ENC _ => "Unsupported encoding"
+                                        | _ => "Declared encoding incompatible"
+                                          ^"with auto-detected encoding"
+                       in raise CantOpenFile ((uri,msg),a1)
+                       end
+                 val newEnc = decEncoding dec1
+                 val (arr,n,dec2,err) = initArray dec1
+              in (a,EXT2(arr,n,0,l,col,brk,(dec2,err,typ)),newEnc)
+              end
 (*
-	      in (a,EXT1(dec1,l,col,brk,typ),newEnc)
-	      end
+              in (a,EXT1(dec1,l,col,brk,typ),newEnc)
+              end
 *)
 
-	    | LOOKED(cs,q1) => let val (a2,q2,enc2) = changeAuto(a,q1,decl)
-			       in (a2,LOOKED(cs,q2),enc2)
-			       end
-	    | CLOSED(dec,_,_,_) => (a,q,decEncoding dec)
-	    | _ => raise InternalError(THIS_MODULE,"changeAuto",
-				       "entity is neither EXT1 nor CLOSED nor LOOKED")
+            | LOOKED(cs,q1) => let val (a2,q2,enc2) = changeAuto(a,q1,decl)
+                               in (a2,LOOKED(cs,q2),enc2)
+                               end
+            | CLOSED(dec,_,_,_) => (a,q,decEncoding dec)
+            | _ => raise InternalError(THIS_MODULE,"changeAuto",
+                                       "entity is neither EXT1 nor CLOSED nor LOOKED")
 
       (*--------------------------------------------------------------------*)
       (* Get one character from the current entity. Possibly reload buffer. *)
@@ -7841,50 +7841,50 @@
          case q 
            of ENDED(_,other) => getChar(a,other)
             | CLOSED(_,_,_,typ) => 
-	      (case typ 
-		 of SPECIAL _ => raise InternalError (THIS_MODULE,"getChar",
-						      "attempt to read beyond special entity end")
-		  | NORMAL(_,other) => getChar(a,other))
+              (case typ 
+                 of SPECIAL _ => raise InternalError (THIS_MODULE,"getChar",
+                                                      "attempt to read beyond special entity end")
+                  | NORMAL(_,other) => getChar(a,other))
             | INT(vec,s,i,io) => 
               if i>=s then (0wx0,a,ENDED io)
-	      else (Vector.sub(vec,i),a,INT(vec,s,i+1,io)) 
+              else (Vector.sub(vec,i),a,INT(vec,s,i+1,io)) 
             | EXT1(dec,l,col,br,typ) => 
               (let 
-		  val (c,dec1) = decGetChar dec
-	       in 
-		  if (* c>=0wx20 orelse c=0wx09 *)
-		     c>=0wx0020 
-		     andalso (c<=0wxD7FF 
-			      orelse c>=0wxE000 andalso (c<=0wxFFFD 
-							 orelse c>=0wx10000))
-		     orelse c=0wx9
-		     then (c,a,EXT1(dec1,l,col+1,false,typ)) 
-		  else if c=0wxA 
-			  then if br then getChar(a,EXT1(dec1,l,col,false,typ))
-			       else (c,a,EXT1(dec1,l+1,0,false,typ))
-		       else (if c=0wxD then (0wxA,a,EXT1(dec1,l+1,0,true,typ))
-			     else let val a1 = hookError(a,(getPos q,ERR_NON_XML_CHAR c))
-				  in getChar(a1,EXT1(dec1,l,col+1,false,typ))
-				  end)
-	       end
-		  handle DecEof dec => (0wx0,a,CLOSED(dec,l,col,typ))
-		       | DecError(dec,eof,err) => 
-				       let val err = ERR_DECODE_ERROR err
-					   val a1 = hookError(a,(getPos q,err))
-				       in if eof then (0wx0,a,CLOSED(dec,l,col,typ))
-					  else getChar(a1,EXT1(dec,col,l,br,typ))
-				       end)
+                  val (c,dec1) = decGetChar dec
+               in 
+                  if (* c>=0wx20 orelse c=0wx09 *)
+                     c>=0wx0020 
+                     andalso (c<=0wxD7FF 
+                              orelse c>=0wxE000 andalso (c<=0wxFFFD 
+                                                         orelse c>=0wx10000))
+                     orelse c=0wx9
+                     then (c,a,EXT1(dec1,l,col+1,false,typ)) 
+                  else if c=0wxA 
+                          then if br then getChar(a,EXT1(dec1,l,col,false,typ))
+                               else (c,a,EXT1(dec1,l+1,0,false,typ))
+                       else (if c=0wxD then (0wxA,a,EXT1(dec1,l+1,0,true,typ))
+                             else let val a1 = hookError(a,(getPos q,ERR_NON_XML_CHAR c))
+                                  in getChar(a1,EXT1(dec1,l,col+1,false,typ))
+                                  end)
+               end
+                  handle DecEof dec => (0wx0,a,CLOSED(dec,l,col,typ))
+                       | DecError(dec,eof,err) => 
+                                       let val err = ERR_DECODE_ERROR err
+                                           val a1 = hookError(a,(getPos q,err))
+                                       in if eof then (0wx0,a,CLOSED(dec,l,col,typ))
+                                          else getChar(a1,EXT1(dec,col,l,br,typ))
+                                       end)
             | EXT2(arr,s,i,l,col,br,det) => 
               if i<s 
                  then let val c = Array.sub(arr,i)
                       in if (* c>=0wx20 orelse c=0wx09 *)
-			 (* c>=0wx0020 andalso c<=0wxD7FF orelse c=0wx9 orelse *)
-			 (* c>=0wxE000 andalso c<=0wxFFFD orelse c>=0wx10000 *)
-			 c>=0wx0020 
-			 andalso (c<=0wxD7FF 
-				  orelse c>=0wxE000 andalso (c<=0wxFFFD 
-							     orelse c>=0wx10000))
-			 orelse c=0wx9
+                         (* c>=0wx0020 andalso c<=0wxD7FF orelse c=0wx9 orelse *)
+                         (* c>=0wxE000 andalso c<=0wxFFFD orelse c>=0wx10000 *)
+                         c>=0wx0020 
+                         andalso (c<=0wxD7FF 
+                                  orelse c>=0wxE000 andalso (c<=0wxFFFD 
+                                                             orelse c>=0wx10000))
+                         orelse c=0wx9
                             then (c,a,EXT2(arr,s,i+1,l,col+1,false,det)) 
                       else if c=0wxA 
                               then if br then getChar(a,EXT2(arr,s,i+1,l,col,false,det))
@@ -7895,14 +7895,14 @@
                                       end)
                       end
               else let val (dec,err,typ) = det
-		       val (a1,(n,dec1,err1)) = 
-			  case err 
-			    of NONE => if s=BUFSIZE then (a,decGetArray dec arr)
-				       else (a,(0,dec,NONE))
-			     | SOME err => (hookError(a,(getPos q,ERR_DECODE_ERROR err)),
-					    decGetArray dec arr)
+                       val (a1,(n,dec1,err1)) = 
+                          case err 
+                            of NONE => if s=BUFSIZE then (a,decGetArray dec arr)
+                                       else (a,(0,dec,NONE))
+                             | SOME err => (hookError(a,(getPos q,ERR_DECODE_ERROR err)),
+                                            decGetArray dec arr)
                    in if n=0 andalso not (isSome err1)
-			 then (0wx0,a1,CLOSED(dec1,l,col,typ))
+                         then (0wx0,a1,CLOSED(dec1,l,col,typ))
                       else getChar(a1,EXT2(arr,n,0,l,col,br,(dec1,err1,typ)))
                    end
             | LOOKED(nil,q) => getChar(a,q)
@@ -7925,26 +7925,26 @@
 (* and for doing checks on components of declarations.                      *)
 (*--------------------------------------------------------------------------*)
 functor DtdDeclare (structure Dtd           : Dtd
-		    structure Entities      : Entities
-		    structure ParserOptions : ParserOptions) = 
+                    structure Entities      : Entities
+                    structure ParserOptions : ParserOptions) = 
    struct
       open
-	 UtilInt UtilList
-	 Base Dtd Errors Entities ParserOptions UniChar UniClasses
-	 
+         UtilInt UtilList
+         Base Dtd Errors Entities ParserOptions UniChar UniClasses
+         
       (*--------------------------------------------------------------------*)
       (* check whether a sequence a chars is the b-adic representation of a *)
       (* character's code, terminated by ";". base will be 10 or 16, isBase *)
       (* will check for a character being a decimal/hexadecimal number.     *)
       (*--------------------------------------------------------------------*)
       fun checkBasimal (base,baseValue) (ch:Char,cs) = 
-	 let fun doit _ (nil:Data) = false
-	       | doit yet [0wx3B] = yet=ch
-	       | doit yet (c::cs) = case baseValue c
-				      of NONE => false
-				       | SOME v => doit (base*yet+v) cs
-	 in doit 0w0 cs
-	 end
+         let fun doit _ (nil:Data) = false
+               | doit yet [0wx3B] = yet=ch
+               | doit yet (c::cs) = case baseValue c
+                                      of NONE => false
+                                       | SOME v => doit (base*yet+v) cs
+         in doit 0w0 cs
+         end
       val checkDecimal = checkBasimal (0w10,decValue)
       val checkHeximal = checkBasimal (0wx10,hexValue)
 
@@ -7952,14 +7952,14 @@
       (* check a character reference for identifying a character.           *)
       (*--------------------------------------------------------------------*)
       fun checkRef (ch,0wx26::0wx23::0wx78::cs) (* "&#x..." *) = checkHeximal(ch,cs)
-	| checkRef (ch,0wx26::0wx23::cs) (* "&#..." *) = checkDecimal(ch,cs)
-	| checkRef _ = false
+        | checkRef (ch,0wx26::0wx23::cs) (* "&#..." *) = checkDecimal(ch,cs)
+        | checkRef _ = false
 
       (*--------------------------------------------------------------------*)
       (* check for a single character ch.                                   *)
       (*--------------------------------------------------------------------*)
       fun checkSingle (ch,[c]) = c=ch
-	| checkSingle _ = false 
+        | checkSingle _ = false 
 
       (*--------------------------------------------------------------------*)
       (* check a predefined entity for being well defined. Note that both   *)
@@ -7967,13 +7967,13 @@
       (* for 'amp' which must be escaped.                                   *)
       (*--------------------------------------------------------------------*)
       fun checkPredef (idx,cs) =
-	 case idx
-	   of 1 => checkRef(0wx26,cs) 
-	    | 2 => checkSingle(0wx3C,cs) orelse checkRef(0wx3C,cs) 
-	    | 3 => checkSingle(0wx3E,cs) orelse checkRef(0wx3E,cs) 
-	    | 4 => checkSingle(0wx27,cs) orelse checkRef(0wx27,cs) 
-	    | 5 => checkSingle(0wx22,cs) orelse checkRef(0wx22,cs) 
-	    | _ => true
+         case idx
+           of 1 => checkRef(0wx26,cs) 
+            | 2 => checkSingle(0wx3C,cs) orelse checkRef(0wx3C,cs) 
+            | 3 => checkSingle(0wx3E,cs) orelse checkRef(0wx3E,cs) 
+            | 4 => checkSingle(0wx27,cs) orelse checkRef(0wx27,cs) 
+            | 5 => checkSingle(0wx22,cs) orelse checkRef(0wx22,cs) 
+            | _ => true
 
       (*--------------------------------------------------------------------*)
       (* Given the declaration of an entity check whether it is predefined. *)
@@ -8002,29 +8002,29 @@
       (* print an error if the declaration is not correct.                  *)
       (*--------------------------------------------------------------------*)
       fun checkPredefined dtd (a,q) (idx,ent) = 
-	 if !O_VALIDATE andalso idx>=1 andalso idx<=5 then 
-	    let
-	       val a1 = if !O_WARN_MULT_ENT_DECL andalso isRedefined dtd idx
-			   then let val warn = WARN_MULT_DECL(IT_GEN_ENT,Index2GenEnt dtd idx)
-				in hookWarning(a,(getPos q,warn))
-				end
-			else a before setRedefined dtd idx
-	       val a2 = 
-		  if !O_CHECK_PREDEFINED then 
-		     let val correct = 
-			case ent 
-			  of GE_INTERN(_,rep) => checkPredef (idx,Vector2Data rep) 
-			   | _ => false
-		     in if correct then a1
-			else let val err = ERR_DECL_PREDEF(Index2GenEnt dtd idx,validPredef idx)
-			     in hookError(a1,(getPos q,err))
-			     end
-		     end
-		  else a1
-	    in (true,a2)
-	    end
-	 else (false,a)
-	    
+         if !O_VALIDATE andalso idx>=1 andalso idx<=5 then 
+            let
+               val a1 = if !O_WARN_MULT_ENT_DECL andalso isRedefined dtd idx
+                           then let val warn = WARN_MULT_DECL(IT_GEN_ENT,Index2GenEnt dtd idx)
+                                in hookWarning(a,(getPos q,warn))
+                                end
+                        else a before setRedefined dtd idx
+               val a2 = 
+                  if !O_CHECK_PREDEFINED then 
+                     let val correct = 
+                        case ent 
+                          of GE_INTERN(_,rep) => checkPredef (idx,Vector2Data rep) 
+                           | _ => false
+                     in if correct then a1
+                        else let val err = ERR_DECL_PREDEF(Index2GenEnt dtd idx,validPredef idx)
+                             in hookError(a1,(getPos q,err))
+                             end
+                     end
+                  else a1
+            in (true,a2)
+            end
+         else (false,a)
+            
       (*--------------------------------------------------------------------*)
       (* add an entity declaration to the DTD tables. 4.2                   *)
       (*                                                                    *)
@@ -8040,21 +8040,21 @@
       (* declared previously.                                               *)
       (*--------------------------------------------------------------------*)
       fun addGenEnt dtd (a,q) (idx,ent,ext) = 
-	 case getGenEnt dtd idx
-	   of (GE_NULL,_) => a before setGenEnt dtd (idx,(ent,ext))
-	    | _ => let val (pre,a1) = checkPredefined dtd (a,q) (idx,ent) 
-		   in if pre orelse not (!O_WARN_MULT_ENT_DECL) then a1
-		      else hookWarning(a1,(getPos q,WARN_MULT_DECL
-					   (IT_GEN_ENT,Index2GenEnt dtd idx)))
-		   end
+         case getGenEnt dtd idx
+           of (GE_NULL,_) => a before setGenEnt dtd (idx,(ent,ext))
+            | _ => let val (pre,a1) = checkPredefined dtd (a,q) (idx,ent) 
+                   in if pre orelse not (!O_WARN_MULT_ENT_DECL) then a1
+                      else hookWarning(a1,(getPos q,WARN_MULT_DECL
+                                           (IT_GEN_ENT,Index2GenEnt dtd idx)))
+                   end
 
       fun addParEnt dtd (a,q) (idx,ent,ext) = 
-	 case getParEnt dtd idx
-	   of (PE_NULL,_) => a before setParEnt dtd (idx,(ent,ext))
-	    | _ => if !O_WARN_MULT_ENT_DECL 
-		      then hookWarning(a,(getPos q,WARN_MULT_DECL
-					  (IT_PAR_ENT,Index2ParEnt dtd idx)))
-		   else a
+         case getParEnt dtd idx
+           of (PE_NULL,_) => a before setParEnt dtd (idx,(ent,ext))
+            | _ => if !O_WARN_MULT_ENT_DECL 
+                      then hookWarning(a,(getPos q,WARN_MULT_DECL
+                                          (IT_PAR_ENT,Index2ParEnt dtd idx)))
+                   else a
 
       (*--------------------------------------------------------------------*)
       (* at option print a warning if not all predefined entities have been *)
@@ -8065,12 +8065,12 @@
       (*   "4.6 Predefined Entities".                                       *)
       (*--------------------------------------------------------------------*)
       fun checkPreDefined dtd (a,q) = 
-	 if !O_VALIDATE andalso !O_INTEROPERABILITY andalso 
-	    !O_WARN_SHOULD_DECLARE andalso hasDtd dtd  
-	    then case notRedefined dtd
-		   of nil => a
-		    | ents => hookWarning(a,(getPos q,WARN_SHOULD_DECLARE ents))
-	 else a
+         if !O_VALIDATE andalso !O_INTEROPERABILITY andalso 
+            !O_WARN_SHOULD_DECLARE andalso hasDtd dtd  
+            then case notRedefined dtd
+                   of nil => a
+                    | ents => hookWarning(a,(getPos q,WARN_SHOULD_DECLARE ents))
+         else a
 
       (*--------------------------------------------------------------------*)
       (* add a notation declaration to the DTD tables.                      *)
@@ -8083,12 +8083,12 @@
       (* declared previously.                                               *)
       (*--------------------------------------------------------------------*)
       fun addNotation dtd (a,q) (idx,nt) = 
-	 if hasNotation dtd idx 
-	    then if !O_WARN_MULT_NOT_DECL 
-		    then hookWarning(a,(getPos q,WARN_MULT_DECL
-					(IT_NOTATION,Index2AttNot dtd idx)))
-		 else a
-	 else a before setNotation dtd (idx,nt)
+         if hasNotation dtd idx 
+            then if !O_WARN_MULT_NOT_DECL 
+                    then hookWarning(a,(getPos q,WARN_MULT_DECL
+                                        (IT_NOTATION,Index2AttNot dtd idx)))
+                 else a
+         else a before setNotation dtd (idx,nt)
 
       (*--------------------------------------------------------------------*)
       (* add an element declaration to the element table. Only the content  *)
@@ -8101,15 +8101,15 @@
       (* declared previously.                                               *)
       (*--------------------------------------------------------------------*)
       fun addElement dtd (a,q) (idx,cont,ext) = 
-	 let val {decl,atts,errAtts,...} = getElement dtd idx
-	 in case decl
-	      of NONE => a before setElement dtd (idx,{decl    = SOME(cont,ext),
-						       atts    = atts,
-						       errAtts = errAtts})
-	       | SOME _ => if !O_VALIDATE 
-			      then hookError(a,(getPos q,ERR_REDEC_ELEM(Index2Element dtd idx))) 
-			   else a
-	 end
+         let val {decl,atts,errAtts,...} = getElement dtd idx
+         in case decl
+              of NONE => a before setElement dtd (idx,{decl    = SOME(cont,ext),
+                                                       atts    = atts,
+                                                       errAtts = errAtts})
+               | SOME _ => if !O_VALIDATE 
+                              then hookError(a,(getPos q,ERR_REDEC_ELEM(Index2Element dtd idx))) 
+                           else a
+         end
 
       (*--------------------------------------------------------------------*)
       (* at option, pretend an element is declared by adding a default      *)
@@ -8140,18 +8140,18 @@
       (* attribute list declaration.                                        *)
       (*--------------------------------------------------------------------*)
       fun enterAttList dtd (a,q) idx =
-	 let 
-	    val {decl,atts,errAtts,...} = getElement dtd idx
-	    val a1 = if isSome decl orelse not (!O_WARN_ATT_NO_ELEM) then a
-		     else hookWarning(a,(getPos q,WARN_ATT_UNDEC_ELEM(Index2Element dtd idx)))
-	 in 
-	    case atts
-	      of NONE => a1 before 
-		 setElement dtd (idx,{decl=decl,atts=SOME(nil,false),errAtts=errAtts}) 
-	       | _ => if !O_INTEROPERABILITY andalso !O_WARN_MULT_ATT_DECL 
-			 then hookWarning(a1,(getPos q,WARN_MULT_ATT_DECL(Index2Element dtd idx)))
-		      else a1
-	 end
+         let 
+            val {decl,atts,errAtts,...} = getElement dtd idx
+            val a1 = if isSome decl orelse not (!O_WARN_ATT_NO_ELEM) then a
+                     else hookWarning(a,(getPos q,WARN_ATT_UNDEC_ELEM(Index2Element dtd idx)))
+         in 
+            case atts
+              of NONE => a1 before 
+                 setElement dtd (idx,{decl=decl,atts=SOME(nil,false),errAtts=errAtts}) 
+               | _ => if !O_INTEROPERABILITY andalso !O_WARN_MULT_ATT_DECL 
+                         then hookWarning(a1,(getPos q,WARN_MULT_ATT_DECL(Index2Element dtd idx)))
+                      else a1
+         end
 
       (*--------------------------------------------------------------------*)
       (* check whether attribute "xml:space" is declared correctly. 2.10:   *)
@@ -8162,8 +8162,8 @@
       (*   type whose only possible values are "default" and "preserve".    *)
       (*--------------------------------------------------------------------*)
       fun checkAttDef (a,q) (aidx,attType,_,_) =
-	 if aidx<>xmlSpaceIdx orelse attType=xmlSpaceType then a 
-	 else hookError(a,(getPos q,ERR_XML_SPACE))
+         if aidx<>xmlSpaceIdx orelse attType=xmlSpaceType then a 
+         else hookError(a,(getPos q,ERR_XML_SPACE))
 
       (*--------------------------------------------------------------------*)
       (* enter a definition of a single attribute to the element table.     *)
@@ -8191,42 +8191,42 @@
       (* return the new application data.                                   *)
       (*--------------------------------------------------------------------*)
       fun addAttribute dtd (a,q) (eidx,attDef as (att,attType,attDefault,_)) =
-	 let 
-	    val a1 = checkAttDef (a,q) attDef
+         let 
+            val a1 = checkAttDef (a,q) attDef
 
-	    fun doit nil = (false,[attDef],a)
-	      | doit (atts as (ad as (aidx,_,_,_))::rest) = 
-	       if aidx=att 
-		  then let val a1 = if !O_INTEROPERABILITY andalso !O_WARN_MULT_ATT_DEF 
-				       then let val warn = WARN_MULT_ATT_DEF
-					  (Index2Element dtd eidx,Index2AttNot dtd att)
-					    in hookWarning(a,(getPos q,warn))
-					    end
-				    else a
-		       in (true,atts,a1)
-		       end
-	       else (if aidx<att then (false,attDef::atts,a)
-		     else let val (redefined,atts1,a1) = doit rest 
-			  in (redefined,ad::atts1,a1)
-			  end)
+            fun doit nil = (false,[attDef],a)
+              | doit (atts as (ad as (aidx,_,_,_))::rest) = 
+               if aidx=att 
+                  then let val a1 = if !O_INTEROPERABILITY andalso !O_WARN_MULT_ATT_DEF 
+                                       then let val warn = WARN_MULT_ATT_DEF
+                                          (Index2Element dtd eidx,Index2AttNot dtd att)
+                                            in hookWarning(a,(getPos q,warn))
+                                            end
+                                    else a
+                       in (true,atts,a1)
+                       end
+               else (if aidx<att then (false,attDef::atts,a)
+                     else let val (redefined,atts1,a1) = doit rest 
+                          in (redefined,ad::atts1,a1)
+                          end)
 
-	    val {decl,atts,errAtts,...} = getElement dtd eidx
-	    val (defs,hadId) = getOpt(atts,(nil,false))
-	    val (redefined,defs1,a1) = doit defs
-	    val (newId,a1) = if isIdType attType 
-				then let val a1 = if hadId andalso (not redefined) andalso !O_VALIDATE 
-						     then hookError(a,(getPos q,ERR_MULT_ID_ELEM
-								       (Index2Element dtd eidx)))
-						  else a
-				     in (true,a1)
-				     end
-			     else (hadId,a)
-	    val (_,defs1,a1) = doit defs
-	    val _ = setElement dtd (eidx,{decl    = decl,
-					  atts    = SOME(defs1,newId),
-					  errAtts = errAtts})
-	 in a1
-	 end
+            val {decl,atts,errAtts,...} = getElement dtd eidx
+            val (defs,hadId) = getOpt(atts,(nil,false))
+            val (redefined,defs1,a1) = doit defs
+            val (newId,a1) = if isIdType attType 
+                                then let val a1 = if hadId andalso (not redefined) andalso !O_VALIDATE 
+                                                     then hookError(a,(getPos q,ERR_MULT_ID_ELEM
+                                                                       (Index2Element dtd eidx)))
+                                                  else a
+                                     in (true,a1)
+                                     end
+                             else (hadId,a)
+            val (_,defs1,a1) = doit defs
+            val _ = setElement dtd (eidx,{decl    = decl,
+                                          atts    = SOME(defs1,newId),
+                                          errAtts = errAtts})
+         in a1
+         end
       
       (*--------------------------------------------------------------------*)
       (* check whether a name starts with (a case variant of) "xml" and if  *)
@@ -8245,21 +8245,21 @@
       (* print an error if the name is reserved and not standardized.       *)
       (*--------------------------------------------------------------------*)
       fun startsWithXml name =
-	 case name
-	   of c1::c2::c3::cs => (c1=0wx58 orelse c1=0wx78) andalso 
-	      (c2=0wx4D orelse c2=0wx6D) andalso (c3=0wx4C orelse c3=0wx6C)
-	    | _ => false
+         case name
+           of c1::c2::c3::cs => (c1=0wx58 orelse c1=0wx78) andalso 
+              (c2=0wx4D orelse c2=0wx6D) andalso (c3=0wx4C orelse c3=0wx6C)
+            | _ => false
       fun checkAttName (a,q) name = 
-	 if !O_CHECK_RESERVED andalso startsWithXml name then 
-	    case name 
-	      of [0wx78,0wx6d,0wx6c,0wx3a,0wx6c,0wx61,0wx6e,0wx67] (* ":lang" *) => a
-	       | [0wx78,0wx6d,0wx6c,0wx3a,0wx73,0wx70,0wx61,0wx63,0wx65] (* ":space" *) => a
-	       | _ => hookError(a,(getPos q,ERR_RESERVED(name,IT_ATT_NAME)))
-	 else a
+         if !O_CHECK_RESERVED andalso startsWithXml name then 
+            case name 
+              of [0wx78,0wx6d,0wx6c,0wx3a,0wx6c,0wx61,0wx6e,0wx67] (* ":lang" *) => a
+               | [0wx78,0wx6d,0wx6c,0wx3a,0wx73,0wx70,0wx61,0wx63,0wx65] (* ":space" *) => a
+               | _ => hookError(a,(getPos q,ERR_RESERVED(name,IT_ATT_NAME)))
+         else a
       fun checkElemName (a,q) name = 
-	 if !O_CHECK_RESERVED andalso startsWithXml name 
-	    then hookError(a,(getPos q,ERR_RESERVED(name,IT_ELEM)))
-	 else a
+         if !O_CHECK_RESERVED andalso startsWithXml name 
+            then hookError(a,(getPos q,ERR_RESERVED(name,IT_ELEM)))
+         else a
 
       (*--------------------------------------------------------------------*)
       (* check for each element in the dtd, whether a name token occurs     *)
@@ -8270,51 +8270,51 @@
       (* return nothing.                                                    *)
       (*--------------------------------------------------------------------*)
       fun checkMultEnum dtd (a,q) =
-	 if !O_INTEROPERABILITY andalso !O_WARN_MULT_ENUM then 
-	    let 
-	       fun doElem a idx = 
-		  let
+         if !O_INTEROPERABILITY andalso !O_WARN_MULT_ENUM then 
+            let 
+               fun doElem a idx = 
+                  let
                      (*-----------------------------------------------------*)
-		     (* for each i, add i to yet if it not in that list.    *)
-		     (* otherwise add it to dup.                            *)
+                     (* for each i, add i to yet if it not in that list.    *)
+                     (* otherwise add it to dup.                            *)
                      (*-----------------------------------------------------*)
-		     fun do_list yd nil = yd
-		       | do_list (yet,dup) (i::is) = 
-			let val yd' = case insertNewInt (i,yet)
-					of NONE => (yet,insertInt (i,dup))
-					 | SOME new => (new,dup)
-			in do_list yd' is
-			end
+                     fun do_list yd nil = yd
+                       | do_list (yet,dup) (i::is) = 
+                        let val yd' = case insertNewInt (i,yet)
+                                        of NONE => (yet,insertInt (i,dup))
+                                         | SOME new => (new,dup)
+                        in do_list yd' is
+                        end
                      (*-----------------------------------------------------*)
-		     (* For each enumerated attribute type call the appro-  *)
-		     (* priate function.                                    *)
+                     (* For each enumerated attribute type call the appro-  *)
+                     (* priate function.                                    *)
                      (*-----------------------------------------------------*)
-		     fun doit (yet,dup) nil = dup
-		       | doit (yet,dup) ((_,attType,_,_)::rest) =
-			case attType
-			  of AT_GROUP is => doit (do_list (yet,dup) is) rest
-			   | AT_NOTATION is => doit (do_list (yet,dup) is) rest
-			   | _ => doit (yet,dup) rest
+                     fun doit (yet,dup) nil = dup
+                       | doit (yet,dup) ((_,attType,_,_)::rest) =
+                        case attType
+                          of AT_GROUP is => doit (do_list (yet,dup) is) rest
+                           | AT_NOTATION is => doit (do_list (yet,dup) is) rest
+                           | _ => doit (yet,dup) rest
 
-		     val defs = case #atts(getElement dtd idx)
-				  of NONE => nil
-				   | SOME(defs,_) => defs
-		     val dup = doit (nil,nil) defs
-		  in 
-		     if null dup then a
-		     else hookWarning(a,(getPos q,WARN_ENUM_ATTS
-					 (Index2Element dtd idx,map (Index2AttNot dtd) dup)))
-		  end
+                     val defs = case #atts(getElement dtd idx)
+                                  of NONE => nil
+                                   | SOME(defs,_) => defs
+                     val dup = doit (nil,nil) defs
+                  in 
+                     if null dup then a
+                     else hookWarning(a,(getPos q,WARN_ENUM_ATTS
+                                         (Index2Element dtd idx,map (Index2AttNot dtd) dup)))
+                  end
                (*-----------------------------------------------------------*)
                (* the highest used index is usedIndices-1.                  *)
                (*-----------------------------------------------------------*)
-	       val maxIdx = maxUsedElem dtd
+               val maxIdx = maxUsedElem dtd
 
-	       fun doit a i = if i>maxIdx then a else doit (doElem a i) (i+1)
-	    in 
-	       doit a 0
-	    end
-	 else a
+               fun doit a i = if i>maxIdx then a else doit (doElem a i) (i+1)
+            in 
+               doit a 0
+            end
+         else a
 
       (*--------------------------------------------------------------------*)
       (* check for all id names refereneced by some IDREF attribute whether *)
@@ -8325,19 +8325,19 @@
       (* return nothing.                                                    *)
       (*--------------------------------------------------------------------*)
       fun checkDefinedIds dtd (a,q) = 
-	 if !O_VALIDATE then 
-	    let 
-	       val maxId = maxUsedId dtd
-	       
-	       fun doOne a i = let val (decl,refs) = getId dtd i
-			       in if decl orelse null refs then a
-				  else hookError(a,(hd refs,ERR_UNDECL_ID(Index2Id dtd i,tl refs)))
-			       end
-	       fun doAll a i = if i>maxId then a else doAll (doOne a i) (i+1)
-	    in 
-	       doAll a 0
-	    end 
-	 else a
+         if !O_VALIDATE then 
+            let 
+               val maxId = maxUsedId dtd
+               
+               fun doOne a i = let val (decl,refs) = getId dtd i
+                               in if decl orelse null refs then a
+                                  else hookError(a,(hd refs,ERR_UNDECL_ID(Index2Id dtd i,tl refs)))
+                               end
+               fun doAll a i = if i>maxId then a else doAll (doOne a i) (i+1)
+            in 
+               doAll a 0
+            end 
+         else a
 
       (*--------------------------------------------------------------------*)
       (* check for all declared unparsed entities, whether their notations  *)
@@ -8348,22 +8348,22 @@
       (* return nothing.                                                    *)
       (*--------------------------------------------------------------------*)
       fun checkUnparsed dtd a = 
-	 if !O_VALIDATE then 
-	    let 
-	       val maxGen = maxUsedGen dtd
-	       
-	       fun doOne a i = 
-		  case getGenEnt dtd i
-		    of (GE_UNPARSED(_,nidx,pos),_) => 
-		       if hasNotation dtd nidx then a
-		       else hookError(a,(pos,ERR_UNDECLARED
-					 (IT_NOTATION,Index2AttNot dtd nidx,LOC_NONE)))
-		     | _ => a
-	       fun doAll a i = if i>maxGen then a else doAll (doOne a i) (i+1)
-	    in 
-	       doAll a 0
-	    end 
-	 else a
+         if !O_VALIDATE then 
+            let 
+               val maxGen = maxUsedGen dtd
+               
+               fun doOne a i = 
+                  case getGenEnt dtd i
+                    of (GE_UNPARSED(_,nidx,pos),_) => 
+                       if hasNotation dtd nidx then a
+                       else hookError(a,(pos,ERR_UNDECLARED
+                                         (IT_NOTATION,Index2AttNot dtd nidx,LOC_NONE)))
+                     | _ => a
+               fun doAll a i = if i>maxGen then a else doAll (doOne a i) (i+1)
+            in 
+               doAll a 0
+            end 
+         else a
    end
 (* stop of ../../Parser/Dtd/dtdDeclare.sml *)
 (* start of ../../Parser/Dtd/dtdAttributes.sml *)
@@ -8377,15 +8377,15 @@
 (*   makeAttValue        : AttValue InternalError                           *) 
 (*--------------------------------------------------------------------------*)
 functor DtdAttributes (structure Dtd           : Dtd
-		       structure Entities      : Entities
-		       structure ParserOptions : ParserOptions) = 
+                       structure Entities      : Entities
+                       structure ParserOptions : ParserOptions) = 
    struct
       structure DtdDeclare = DtdDeclare (structure Dtd = Dtd
-					 structure Entities = Entities
-					 structure ParserOptions = ParserOptions)
+                                         structure Entities = Entities
+                                         structure ParserOptions = ParserOptions)
       open 
-	 UniChar UniClasses UtilList 
-	 Base Dtd DtdDeclare Errors Entities HookData ParserOptions 
+         UniChar UniClasses UtilList 
+         Base Dtd DtdDeclare Errors Entities HookData ParserOptions 
 
       val THIS_MODULE = "DtdAttributes"
       
@@ -8395,47 +8395,47 @@
       (* this is the list of language codes in ISO 639.                     *)
       (*--------------------------------------------------------------------*)
       val iso639codes = 
-	 Vector.fromList 
-	 ["AA","AB","AF","AM","AR","AS","AY","AZ",
-	  "BA","BE","BG","BH","BI","BN","BO","BR",
-	  "CA","CO","CS","CY",
-	  "DA","DE","DZ",
-	  "EL","EN","EO","ES","ET","EU",
-	  "FA","FI","FJ","FO","FR","FY",
-	  "GA","GD","GL","GN","GU",
-	  "HA","HE","HI","HR","HU","HY",
-	  "IA","ID","IE","IK","IN","IS","IT","IU","IW",
-	  "JA","JI","JW",
-	  "KA","KK","KL","KM","KN","KO","KS","KU","KY",
-	  "LA","LN","LO","LT","LV",
-	  "MG","MI","MK","ML","MN","MO","MR","MS","MT","MY",
-	  "NA","NE","NL","NO",
-	  "OC","OM","OR",
-	  "PA","PL","PS","PT",
-	  "QU",
-	  "RM","RN","RO","RU","RW",
-	  "SA","SD","SG","SH","SI","SK","SL","SM","SN","SO","SQ","SR","SS","ST","SU","SV","SW",
-	  "TA","TE","TG","TH","TI","TK","TL","TN","TO","TR","TS","TT","TW",
-	  "UG","UK","UR","UZ",
-	  "VI","VO",
-	  "WO",
-	  "XH",
-	  "YI","YO",
-	  "ZA","ZH","ZU"]
+         Vector.fromList 
+         ["AA","AB","AF","AM","AR","AS","AY","AZ",
+          "BA","BE","BG","BH","BI","BN","BO","BR",
+          "CA","CO","CS","CY",
+          "DA","DE","DZ",
+          "EL","EN","EO","ES","ET","EU",
+          "FA","FI","FJ","FO","FR","FY",
+          "GA","GD","GL","GN","GU",
+          "HA","HE","HI","HR","HU","HY",
+          "IA","ID","IE","IK","IN","IS","IT","IU","IW",
+          "JA","JI","JW",
+          "KA","KK","KL","KM","KN","KO","KS","KU","KY",
+          "LA","LN","LO","LT","LV",
+          "MG","MI","MK","ML","MN","MO","MR","MS","MT","MY",
+          "NA","NE","NL","NO",
+          "OC","OM","OR",
+          "PA","PL","PS","PT",
+          "QU",
+          "RM","RN","RO","RU","RW",
+          "SA","SD","SG","SH","SI","SK","SL","SM","SN","SO","SQ","SR","SS","ST","SU","SV","SW",
+          "TA","TE","TG","TH","TI","TK","TL","TN","TO","TR","TS","TT","TW",
+          "UG","UK","UR","UZ",
+          "VI","VO",
+          "WO",
+          "XH",
+          "YI","YO",
+          "ZA","ZH","ZU"]
 
       (*--------------------------------------------------------------------*)
       (* a two-dimensional field [0..25][0..25] of booleans for ISO 639.    *)
       (*--------------------------------------------------------------------*)
       val iso639field = 
-	 let 
-	    val arr = Array.tabulate(26,fn _ => Array.array(26,false))
-	    val _ = Vector.map 
-	       (fn s => Array.update(Array.sub(arr,ord(String.sub(s,0))-65),
-				     ord(String.sub(s,1))-65,
-				     true)) 
-	       iso639codes
-	 in Vector.tabulate(26,fn i => Array.extract (Array.sub(arr,i),0,NONE))
-	 end
+         let 
+            val arr = Array.tabulate(26,fn _ => Array.array(26,false))
+            val _ = Vector.map 
+               (fn s => Array.update(Array.sub(arr,ord(String.sub(s,0))-65),
+                                     ord(String.sub(s,1))-65,
+                                     true)) 
+               iso639codes
+         in Vector.tabulate(26,fn i => Array.extract (Array.sub(arr,i),0,NONE))
+         end
 
       (*--------------------------------------------------------------------*)
       (* for a letter, compute ord(toUpper c)-ord(#"A"), for subscripting.  *)
@@ -8447,27 +8447,27 @@
       (* are these two letters an ISO 639 code?                             *)
       (*--------------------------------------------------------------------*)
       fun isIso639 (c1,c2) =
-	 if !O_CHECK_ISO639 then 
-	    Vector.sub(Vector.sub(iso639field,cIndex c1),cIndex c2)
-	    handle Subscript => false
-	 else isAsciiLetter c1 andalso isAsciiLetter c2
-	
+         if !O_CHECK_ISO639 then 
+            Vector.sub(Vector.sub(iso639field,cIndex c1),cIndex c2)
+            handle Subscript => false
+         else isAsciiLetter c1 andalso isAsciiLetter c2
+        
       (*--------------------------------------------------------------------*)
       (* does this match Subcode ('-' Subcode)* ?                           *)
       (* is this a sequence of ('-' Subcode) ?                              *)
       (* Iana codes and user codes also end on ([a-z] | [A-Z])+             *)
       (*--------------------------------------------------------------------*)
       fun isSubcode' nil = false
-	| isSubcode' (c::cs) = 
-	 let fun doit nil = true
-	       | doit (c::cs) = if c=0wx2D then isSubcode' cs
-				else isAsciiLetter c andalso doit cs
-	 in isAsciiLetter c andalso doit cs
-	 end
+        | isSubcode' (c::cs) = 
+         let fun doit nil = true
+               | doit (c::cs) = if c=0wx2D then isSubcode' cs
+                                else isAsciiLetter c andalso doit cs
+         in isAsciiLetter c andalso doit cs
+         end
       fun isSubcode nil = true
-	| isSubcode (c::cs) = c=0wx2D andalso isSubcode' cs
+        | isSubcode (c::cs) = c=0wx2D andalso isSubcode' cs
       val isIanaUser = isSubcode'
-	 
+         
       (*--------------------------------------------------------------------*)
       (* Check whether a "xml:lang" attribute matches the LanguageID        *)
       (* production. 2.12:                                                  *)
@@ -8483,19 +8483,19 @@
       (* not have a valid value.                                            *)
       (*--------------------------------------------------------------------*)
       fun checkAttSpec (a,q) (aidx,cs) = 
-	 if !O_CHECK_LANGID andalso aidx=xmlLangIdx
-	    then let val valid = case cs
-				   of c::0wx2D::cs' => (c=0wx49 orelse
-							c=0wx69 orelse
-							c=0wx58 orelse 
-							c=0wx78) andalso isIanaUser cs'
-				    | c1::c2::cs' => isIso639 (c1,c2) andalso isSubcode cs'
-				    | _ => false 
-		 in 
-		    if valid then a 
-		    else raise AttValue(hookError(a,(getPos q,ERR_ATT_IS_NOT(cs,IT_LANG_ID))))
-		 end
-	 else a
+         if !O_CHECK_LANGID andalso aidx=xmlLangIdx
+            then let val valid = case cs
+                                   of c::0wx2D::cs' => (c=0wx49 orelse
+                                                        c=0wx69 orelse
+                                                        c=0wx58 orelse 
+                                                        c=0wx78) andalso isIanaUser cs'
+                                    | c1::c2::cs' => isIso639 (c1,c2) andalso isSubcode cs'
+                                    | _ => false 
+                 in 
+                    if valid then a 
+                    else raise AttValue(hookError(a,(getPos q,ERR_ATT_IS_NOT(cs,IT_LANG_ID))))
+                 end
+         else a
 
       (*--------------------------------------------------------------------*)
       (* Normalize an attribute value of type other than CDATA, and split   *)
@@ -8516,71 +8516,71 @@
       (* value as a char vector.                                            *)
       (*--------------------------------------------------------------------*)
       fun splitAttValue av =
-	 let 
-	    fun doOne nil = (nil,nil,nil)
-	      | doOne (c::cs) = if c=0wx20 then let val (toks,ys) = doAll true cs
-						in (nil,toks,ys)
-						end
-				else let val (tok,toks,ys) = doOne cs
-				     in ((c::tok),toks,c::ys)
-				     end
-	    and doAll addS nil = (nil,nil)
-	      | doAll addS (c::cs) = if c=0wx20 then doAll addS cs
-				     else let val (tok,toks,ys) = doOne cs
-					  in ((c::tok)::toks,
-					      if addS then 0wx20::c::ys else c::ys)
-					  end
-		    
-	    val (tokens,normed) = doAll false av
-	 in (Data2Vector normed,tokens)
-	 end
+         let 
+            fun doOne nil = (nil,nil,nil)
+              | doOne (c::cs) = if c=0wx20 then let val (toks,ys) = doAll true cs
+                                                in (nil,toks,ys)
+                                                end
+                                else let val (tok,toks,ys) = doOne cs
+                                     in ((c::tok),toks,c::ys)
+                                     end
+            and doAll addS nil = (nil,nil)
+              | doAll addS (c::cs) = if c=0wx20 then doAll addS cs
+                                     else let val (tok,toks,ys) = doOne cs
+                                          in ((c::tok)::toks,
+                                              if addS then 0wx20::c::ys else c::ys)
+                                          end
+                    
+            val (tokens,normed) = doAll false av
+         in (Data2Vector normed,tokens)
+         end
       (*--------------------------------------------------------------------*)
       (* normalize an attribute value other than CDATA according to 3.3.3.  *)
       (*                                                                    *)
       (* return the normalized att value as a Vector.                       *)
       (*--------------------------------------------------------------------*)
       fun normAttValue av =
-	 let fun doOne nil = nil
-	       | doOne (c::cs) = if c=0wx20 then doAll true cs
-				 else c::doOne cs
-	     and doAll addS nil = nil
-	       | doAll addS (c::cs) = if c=0wx20 then doAll addS cs
-				      else let val ys = doOne cs
-					   in if addS then 0wx20::c::ys else c::ys
-					   end
-	     val normed = doAll false av
-	 in Data2Vector normed
-	 end
+         let fun doOne nil = nil
+               | doOne (c::cs) = if c=0wx20 then doAll true cs
+                                 else c::doOne cs
+             and doAll addS nil = nil
+               | doAll addS (c::cs) = if c=0wx20 then doAll addS cs
+                                      else let val ys = doOne cs
+                                           in if addS then 0wx20::c::ys else c::ys
+                                           end
+             val normed = doAll false av
+         in Data2Vector normed
+         end
 
       (*--------------------------------------------------------------------*)
       (* Check whether a sequence of chars forms a name (token).            *) 
       (*--------------------------------------------------------------------*)
       fun isNmToken cs = List.all isName cs
       fun isaName nil = false
-	| isaName (c::cs) = isNms c andalso List.all isName cs
+        | isaName (c::cs) = isNms c andalso List.all isName cs
 
       (*--------------------------------------------------------------------*)
       (* Check whether a list of tokens is a single what fulfilling isWhat. *)
       (* print an error and raise AttValue if it is not.                    *)
       (*--------------------------------------------------------------------*)
       fun checkOne (isWhat,what,detail) (a,q) toks = 
-	 case toks 
-	   of nil => raise AttValue (hookError(a,(getPos q,ERR_EXACTLY_ONE detail)))
-	    | [one] => if isWhat one then one 
-		       else raise AttValue(hookError(a,(getPos q,ERR_ATT_IS_NOT(one,what))))
-	    | more => raise AttValue(hookError(a,(getPos q,ERR_AT_MOST_ONE detail)))
+         case toks 
+           of nil => raise AttValue (hookError(a,(getPos q,ERR_EXACTLY_ONE detail)))
+            | [one] => if isWhat one then one 
+                       else raise AttValue(hookError(a,(getPos q,ERR_ATT_IS_NOT(one,what))))
+            | more => raise AttValue(hookError(a,(getPos q,ERR_AT_MOST_ONE detail)))
       (*--------------------------------------------------------------------*)
       (* Check whether a list of tokens is non-empty and all elements ful-  *)
       (* fil isWhat.                                                        *)
       (* print an error and raise AttValue if not.                          *)
       (*--------------------------------------------------------------------*)
       fun checkList (isWhat,what,detail) (a,q) toks = 
-	 case toks 
-	   of nil => raise AttValue (hookError(a,(getPos q,ERR_AT_LEAST_ONE detail)))
-	    | _ => app (fn one => if isWhat one then () 
-				  else let val err = ERR_ATT_IS_NOT(one,what)
-				       in raise AttValue(hookError(a,(getPos q,err)))
-				       end) toks
+         case toks 
+           of nil => raise AttValue (hookError(a,(getPos q,ERR_AT_LEAST_ONE detail)))
+            | _ => app (fn one => if isWhat one then () 
+                                  else let val err = ERR_ATT_IS_NOT(one,what)
+                                       in raise AttValue(hookError(a,(getPos q,err)))
+                                       end) toks
       (*--------------------------------------------------------------------*)
       (* Convert a list of tokens into an ID att value. 3.3.1:              *)
       (*                                                                    *)
@@ -8597,18 +8597,18 @@
       (* print an error and raise AttValue if it is not a name.             *)
       (*--------------------------------------------------------------------*)
       fun takeId (dtd,inDtd) (a,q) toks = 
-	 let val one = checkOne (isaName,IT_NAME,IT_ID_NAME) (a,q) toks 
-	     val idx = Id2Index dtd one
-	     val _ = if inDtd then ()
-		     else let val (decl,refs) = getId dtd idx
-			  in if decl then let val err = ERR_REPEATED_ID one
-					  in raise AttValue (hookError(a,(getPos q,err)))
-					  end
-			     else setId dtd (idx,(true,refs))
-			  end
-	 in (SOME(AV_ID idx),a)
-	 end
-	    
+         let val one = checkOne (isaName,IT_NAME,IT_ID_NAME) (a,q) toks 
+             val idx = Id2Index dtd one
+             val _ = if inDtd then ()
+                     else let val (decl,refs) = getId dtd idx
+                          in if decl then let val err = ERR_REPEATED_ID one
+                                          in raise AttValue (hookError(a,(getPos q,err)))
+                                          end
+                             else setId dtd (idx,(true,refs))
+                          end
+         in (SOME(AV_ID idx),a)
+         end
+            
       (*--------------------------------------------------------------------*)
       (* Convert a list of tokens into an IDREF/IDREFS att value. 3.3.1:    *)
       (*                                                                    *)
@@ -8618,21 +8618,21 @@
       (* print an error an raise AttValue if it is not a (list of) name(s). *)
       (*--------------------------------------------------------------------*)
       fun setIdRef (dtd,q) idx =
-	 let val (decl,refs) = getId dtd idx
-	 in setId dtd (idx,(decl,getPos q::refs))
-	 end
+         let val (decl,refs) = getId dtd idx
+         in setId dtd (idx,(decl,getPos q::refs))
+         end
       fun takeIdref (dtd,_) (a,q) toks = 
-	 let val one = checkOne (isaName,IT_NAME,IT_ID_NAME) (a,q) toks 
-	     val idx=Id2Index dtd one
-	     val _ = setIdRef (dtd,q) idx
-	 in (SOME(AV_IDREF idx),a)
-	 end
+         let val one = checkOne (isaName,IT_NAME,IT_ID_NAME) (a,q) toks 
+             val idx=Id2Index dtd one
+             val _ = setIdRef (dtd,q) idx
+         in (SOME(AV_IDREF idx),a)
+         end
       fun takeIdrefs (dtd,_) (a,q) toks = 
-	 let val _ = checkList (isaName,IT_NAME,IT_ID_NAME) (a,q) toks 
-	     val idxs = map (Id2Index dtd) toks
-	     val _ = app (setIdRef (dtd,q)) idxs
-	 in (SOME(AV_IDREFS idxs),a)
-	 end
+         let val _ = checkList (isaName,IT_NAME,IT_ID_NAME) (a,q) toks 
+             val idxs = map (Id2Index dtd) toks
+             val _ = app (setIdRef (dtd,q)) idxs
+         in (SOME(AV_IDREFS idxs),a)
+         end
 
       (*--------------------------------------------------------------------*)
       (* Convert a list of tokens into an ENTITY/IES att value. 3.3.1:      *)
@@ -8646,29 +8646,29 @@
       (* parsed entity.                                                     *)
       (*--------------------------------------------------------------------*)
       fun checkEntity (dtd,inDtd) (a,q) name =
-	 let val idx = GenEnt2Index dtd name
-	     val (ent,_) = getGenEnt dtd idx
-	     val _ = if inDtd then ()
-		     else case ent
-			    of GE_UNPARSED _ => ()
-			     | GE_NULL => let val err = ERR_UNDECLARED(IT_GEN_ENT,name,LOC_NONE)
-					  in raise AttValue (hookError(a,(getPos q,err)))
-					  end
-			     | _ => let val err = ERR_MUST_BE_UNPARSED(name,LOC_NONE)
-				    in raise AttValue (hookError(a,(getPos q,err)))
-				    end
-	 in idx
-	 end
+         let val idx = GenEnt2Index dtd name
+             val (ent,_) = getGenEnt dtd idx
+             val _ = if inDtd then ()
+                     else case ent
+                            of GE_UNPARSED _ => ()
+                             | GE_NULL => let val err = ERR_UNDECLARED(IT_GEN_ENT,name,LOC_NONE)
+                                          in raise AttValue (hookError(a,(getPos q,err)))
+                                          end
+                             | _ => let val err = ERR_MUST_BE_UNPARSED(name,LOC_NONE)
+                                    in raise AttValue (hookError(a,(getPos q,err)))
+                                    end
+         in idx
+         end
       fun takeEntity (dtd,inDtd) (aq as (a,_)) toks = 
-	 let val one = checkOne (isaName,IT_NAME,IT_ENT_NAME) aq toks 
-	     val idx = checkEntity (dtd,inDtd) aq one
-	 in (SOME(AV_ENTITY idx),a)
-	 end
+         let val one = checkOne (isaName,IT_NAME,IT_ENT_NAME) aq toks 
+             val idx = checkEntity (dtd,inDtd) aq one
+         in (SOME(AV_ENTITY idx),a)
+         end
       fun takeEntities (dtd,inDtd) (aq as (a,_)) toks = 
-	 let val _ = checkList (isaName,IT_NAME,IT_ENT_NAME) aq toks 
-	     val idxs = map (checkEntity (dtd,inDtd) aq) toks
-	 in (SOME(AV_ENTITIES idxs),a)
-	 end
+         let val _ = checkList (isaName,IT_NAME,IT_ENT_NAME) aq toks 
+             val idxs = map (checkEntity (dtd,inDtd) aq) toks
+         in (SOME(AV_ENTITIES idxs),a)
+         end
 
       (*--------------------------------------------------------------------*)
       (* Convert a list of tokens into a NOTATION att value. 3.3.1:         *)
@@ -8682,16 +8682,16 @@
       (* in the list given as 1st arg.                                      *)
       (*--------------------------------------------------------------------*)
       fun takeNotation is (dtd,inDtd) (aq as (a,q)) toks = 
-	 let val one = checkOne (isaName,IT_NAME,IT_NOT_NAME) aq toks 
-	     val idx = AttNot2Index dtd one
-	     val _ = if member idx is then ()
-		     else let val nots = map (Index2AttNot dtd) is
-			      val err = ERR_MUST_BE_AMONG(IT_NOT_NAME,one,nots)
-			  in raise AttValue (hookError(a,(getPos q,err)))
-			  end 
-	 in (SOME(AV_NOTATION(is,idx)),a)
-	 end
-	    
+         let val one = checkOne (isaName,IT_NAME,IT_NOT_NAME) aq toks 
+             val idx = AttNot2Index dtd one
+             val _ = if member idx is then ()
+                     else let val nots = map (Index2AttNot dtd) is
+                              val err = ERR_MUST_BE_AMONG(IT_NOT_NAME,one,nots)
+                          in raise AttValue (hookError(a,(getPos q,err)))
+                          end 
+         in (SOME(AV_NOTATION(is,idx)),a)
+         end
+            
       (*--------------------------------------------------------------------*)
       (* Convert a list of tokens into an enumerated att value. 3.3.1:      *)
       (*                                                                    *)
@@ -8704,16 +8704,16 @@
       (* in the list given as 1st arg.                                      *)
       (*--------------------------------------------------------------------*)
       fun takeGroup is (dtd,_) (aq as (a,q)) toks = 
-	 let val one = checkOne (isNmToken,IT_NMTOKEN,IT_NMTOKEN) aq toks 
-	     val idx = AttNot2Index dtd one
-	     val _ = if member idx is then ()
-		     else let val toks = map (Index2AttNot dtd) is
-			      val err = ERR_MUST_BE_AMONG(IT_NMTOKEN,one,toks)
-			  in raise AttValue (hookError(a,(getPos q,err)))
-			  end
-	 in (SOME(AV_GROUP(is,idx)),a)
-	 end
-	       
+         let val one = checkOne (isNmToken,IT_NMTOKEN,IT_NMTOKEN) aq toks 
+             val idx = AttNot2Index dtd one
+             val _ = if member idx is then ()
+                     else let val toks = map (Index2AttNot dtd) is
+                              val err = ERR_MUST_BE_AMONG(IT_NMTOKEN,one,toks)
+                          in raise AttValue (hookError(a,(getPos q,err)))
+                          end
+         in (SOME(AV_GROUP(is,idx)),a)
+         end
+               
       (*--------------------------------------------------------------------*)
       (* Given an attribute type and a list of characters, construct the    *)
       (* corresponding AttValue.                                            *)
@@ -8722,44 +8722,44 @@
       (* is ill-formed.                                                     *)
       (*--------------------------------------------------------------------*)
       fun makeAttValue dtd (a,q) (aidx,attType,ext,inDtd,cs) =
-	 if attType=AT_CDATA 
-	    then let val cv = Data2Vector cs
-		 in if !O_VALIDATE andalso hasDtd dtd
-		       then (cv,(SOME(AV_CDATA cv),checkAttSpec (a,q) (aidx,cs)))
-		    else (cv,(NONE,a))
-		 end
-	 else 
-	    if !O_VALIDATE andalso hasDtd dtd then 
-	       let 
-		  val a1 = checkAttSpec (a,q) (aidx,cs)
-		  val (cv,toks) = splitAttValue cs
-		  val a2 = 
-		     if ext andalso standsAlone dtd
-			then let val cdata = Data2Vector cs
-			     in if cdata=cv then a1
-				else let val err = ERR_STANDALONE_NORM(Index2AttNot dtd aidx)
-					   val _ = setStandAlone dtd (not (!O_ERROR_MINIMIZE))
-				     in hookError(a1,(getPos q,err))
-				     end
-			     end
-		     else a1
-	       in case attType 
-		    of AT_NMTOKEN => (cv,(SOME(AV_NMTOKEN(checkOne(isNmToken,IT_NMTOKEN,
-								   IT_NMTOKEN) (a2,q) toks)),a2))
-		     | AT_NMTOKENS => (cv,(SOME(AV_NMTOKENS toks),a2)) before
-		       checkList(isNmToken,IT_NMTOKEN,IT_NMTOKEN) (a2,q) toks
-		     | AT_ID => (cv,takeId (dtd,inDtd) (a2,q) toks)
-		     | AT_IDREF => (cv,takeIdref (dtd,inDtd) (a2,q) toks)
-		     | AT_IDREFS => (cv,takeIdrefs (dtd,inDtd) (a2,q) toks)
-		     | AT_ENTITY => (cv,takeEntity (dtd,inDtd) (a2,q) toks)
-		     | AT_ENTITIES => (cv,takeEntities (dtd,inDtd) (a2,q) toks)
-		     | AT_GROUP is => (cv,takeGroup is (dtd,inDtd) (a2,q) toks)
-		     | AT_NOTATION is => (cv,takeNotation is (dtd,inDtd) (a2,q) toks)
-		     | AT_CDATA => raise InternalError(THIS_MODULE,"makeAttValue",
-						       "AT_CDATA in the innermost case")
-	       end
-	    else (normAttValue cs,(NONE,a))
-	       
+         if attType=AT_CDATA 
+            then let val cv = Data2Vector cs
+                 in if !O_VALIDATE andalso hasDtd dtd
+                       then (cv,(SOME(AV_CDATA cv),checkAttSpec (a,q) (aidx,cs)))
+                    else (cv,(NONE,a))
+                 end
+         else 
+            if !O_VALIDATE andalso hasDtd dtd then 
+               let 
+                  val a1 = checkAttSpec (a,q) (aidx,cs)
+                  val (cv,toks) = splitAttValue cs
+                  val a2 = 
+                     if ext andalso standsAlone dtd
+                        then let val cdata = Data2Vector cs
+                             in if cdata=cv then a1
+                                else let val err = ERR_STANDALONE_NORM(Index2AttNot dtd aidx)
+                                           val _ = setStandAlone dtd (not (!O_ERROR_MINIMIZE))
+                                     in hookError(a1,(getPos q,err))
+                                     end
+                             end
+                     else a1
+               in case attType 
+                    of AT_NMTOKEN => (cv,(SOME(AV_NMTOKEN(checkOne(isNmToken,IT_NMTOKEN,
+                                                                   IT_NMTOKEN) (a2,q) toks)),a2))
+                     | AT_NMTOKENS => (cv,(SOME(AV_NMTOKENS toks),a2)) before
+                       checkList(isNmToken,IT_NMTOKEN,IT_NMTOKEN) (a2,q) toks
+                     | AT_ID => (cv,takeId (dtd,inDtd) (a2,q) toks)
+                     | AT_IDREF => (cv,takeIdref (dtd,inDtd) (a2,q) toks)
+                     | AT_IDREFS => (cv,takeIdrefs (dtd,inDtd) (a2,q) toks)
+                     | AT_ENTITY => (cv,takeEntity (dtd,inDtd) (a2,q) toks)
+                     | AT_ENTITIES => (cv,takeEntities (dtd,inDtd) (a2,q) toks)
+                     | AT_GROUP is => (cv,takeGroup is (dtd,inDtd) (a2,q) toks)
+                     | AT_NOTATION is => (cv,takeNotation is (dtd,inDtd) (a2,q) toks)
+                     | AT_CDATA => raise InternalError(THIS_MODULE,"makeAttValue",
+                                                       "AT_CDATA in the innermost case")
+               end
+            else (normAttValue cs,(NONE,a))
+               
       (*--------------------------------------------------------------------*)
       (* given an attribute value literal and the attribute type, generate  *)
       (* the AttValue, and check whether it complies with its default value.*)
@@ -8777,16 +8777,16 @@
       (* return the value as a AttPresent value.                            *)
       (*--------------------------------------------------------------------*)
       fun checkAttValue dtd (a,q) ((aidx,attType,defVal,ext),literal,cs) = 
-	 let val (cv,(av,a1)) = makeAttValue dtd (a,q) (aidx,attType,ext,false,cs)
-	 in if !O_VALIDATE andalso hasDtd dtd then 
-	    case defVal 
-	      of AD_FIXED((def,cv',_),_) => 
-		 if cv=cv' then (AP_PRESENT(literal,cv,av),a1)
-		 else raise AttValue
-		    (hookError(a1,(getPos q,ERR_FIXED_VALUE(Index2AttNot dtd aidx,cv,cv'))))
-	       | _ => (AP_PRESENT(literal,cv,av),a1)
-	    else (AP_PRESENT(literal,cv,av),a1)
-	 end
+         let val (cv,(av,a1)) = makeAttValue dtd (a,q) (aidx,attType,ext,false,cs)
+         in if !O_VALIDATE andalso hasDtd dtd then 
+            case defVal 
+              of AD_FIXED((def,cv',_),_) => 
+                 if cv=cv' then (AP_PRESENT(literal,cv,av),a1)
+                 else raise AttValue
+                    (hookError(a1,(getPos q,ERR_FIXED_VALUE(Index2AttNot dtd aidx,cv,cv'))))
+               | _ => (AP_PRESENT(literal,cv,av),a1)
+            else (AP_PRESENT(literal,cv,av),a1)
+         end
 
       (*--------------------------------------------------------------------*)
       (* check a defaulted attribute value for validity.                    *)
@@ -8797,29 +8797,29 @@
       (* defaulted, so no need to check for duplicate ID attributes.        *)
       (*--------------------------------------------------------------------*)
       fun checkDefaultValue dtd (a,q,pos) av =
-	 let 
-	    fun checkEntity (idx,a) = 
-	       let val (ent,_) = getGenEnt dtd idx
-	       in case ent
-		    of GE_UNPARSED _ => a
-		     | GE_NULL => hookError(a,(getPos q,ERR_UNDECLARED
-					       (IT_GEN_ENT,Index2GenEnt dtd idx,
-						LOC_ATT_DEFAULT pos)))
-		     | _ => hookError(a,(getPos q,ERR_MUST_BE_UNPARSED 
-					 (Index2GenEnt dtd idx,LOC_ATT_DEFAULT pos)))
-	       end
-	    
-	    fun checkNotation (idx,a) =
-	       if hasNotation dtd idx then a
-	       else hookError(a,(getPos q,ERR_UNDECLARED
-				 (IT_NOTATION,Index2AttNot dtd idx,LOC_ATT_DEFAULT pos)))
-	 in 
-	    case av
-	      of SOME(AV_ENTITY i) => checkEntity (i,a)
-	       | SOME(AV_ENTITIES is) => foldl checkEntity a is
-	       | SOME(AV_NOTATION(_,i)) => checkNotation(i,a)
-	       | _ => a
-	 end
+         let 
+            fun checkEntity (idx,a) = 
+               let val (ent,_) = getGenEnt dtd idx
+               in case ent
+                    of GE_UNPARSED _ => a
+                     | GE_NULL => hookError(a,(getPos q,ERR_UNDECLARED
+                                               (IT_GEN_ENT,Index2GenEnt dtd idx,
+                                                LOC_ATT_DEFAULT pos)))
+                     | _ => hookError(a,(getPos q,ERR_MUST_BE_UNPARSED 
+                                         (Index2GenEnt dtd idx,LOC_ATT_DEFAULT pos)))
+               end
+            
+            fun checkNotation (idx,a) =
+               if hasNotation dtd idx then a
+               else hookError(a,(getPos q,ERR_UNDECLARED
+                                 (IT_NOTATION,Index2AttNot dtd idx,LOC_ATT_DEFAULT pos)))
+         in 
+            case av
+              of SOME(AV_ENTITY i) => checkEntity (i,a)
+               | SOME(AV_ENTITIES is) => foldl checkEntity a is
+               | SOME(AV_NOTATION(_,i)) => checkNotation(i,a)
+               | _ => a
+         end
 
       (*--------------------------------------------------------------------*)
       (* Generate the attributes not specified in a start-tag, the defs of  *)
@@ -8841,37 +8841,37 @@
       (* return the AttSpecList of all attributes for this tag.             *)
       (*--------------------------------------------------------------------*)
       fun genMissingAtts dtd (a,q) (defs,specd) = 
-	 let 
-	    fun default a (idx,(v as (_,_,av),(pos,checked)),ext) = 
-	       let val a1 = if ext andalso !O_VALIDATE andalso standsAlone dtd
-			       then let val err = ERR_STANDALONE_DEF(Index2AttNot dtd idx)
-					val _ = setStandAlone dtd (not (!O_ERROR_MINIMIZE))
-				    in hookError(a,(getPos q,err))
-				    end
-			    else a
-		   val a2 = if !O_VALIDATE andalso not (!checked andalso !O_ERROR_MINIMIZE)
-			       then checkDefaultValue dtd (a1,q,pos) av before checked := true
-			    else a1 
-	       in (AP_DEFAULT v,a1)
-	       end
-	    fun doit a nil = (specd,a)
-	      | doit a ((idx,_,dv,ext)::rest) = 
-	       let val (value,a1) = 
-		  case dv 
-		    of AD_DEFAULT v => default a (idx,v,ext)
-		     | AD_FIXED v => default a (idx,v,ext)
-		     | AD_IMPLIED => (AP_IMPLIED,a)
-		     | AD_REQUIRED => 
-		       let val a1 = if not (!O_VALIDATE) then a
-				    else hookError(a,(getPos q,
-						      ERR_MISSING_ATT(Index2AttNot dtd idx)))
-		       in (AP_MISSING,a1)
-		       end
-		   val (other,a2) = doit a1 rest
-	       in ((idx,value,NONE)::other,a2)
-	       end
-	 in doit a defs
-	 end
+         let 
+            fun default a (idx,(v as (_,_,av),(pos,checked)),ext) = 
+               let val a1 = if ext andalso !O_VALIDATE andalso standsAlone dtd
+                               then let val err = ERR_STANDALONE_DEF(Index2AttNot dtd idx)
+                                        val _ = setStandAlone dtd (not (!O_ERROR_MINIMIZE))
+                                    in hookError(a,(getPos q,err))
+                                    end
+                            else a
+                   val a2 = if !O_VALIDATE andalso not (!checked andalso !O_ERROR_MINIMIZE)
+                               then checkDefaultValue dtd (a1,q,pos) av before checked := true
+                            else a1 
+               in (AP_DEFAULT v,a1)
+               end
+            fun doit a nil = (specd,a)
+              | doit a ((idx,_,dv,ext)::rest) = 
+               let val (value,a1) = 
+                  case dv 
+                    of AD_DEFAULT v => default a (idx,v,ext)
+                     | AD_FIXED v => default a (idx,v,ext)
+                     | AD_IMPLIED => (AP_IMPLIED,a)
+                     | AD_REQUIRED => 
+                       let val a1 = if not (!O_VALIDATE) then a
+                                    else hookError(a,(getPos q,
+                                                      ERR_MISSING_ATT(Index2AttNot dtd idx)))
+                       in (AP_MISSING,a1)
+                       end
+                   val (other,a2) = doit a1 rest
+               in ((idx,value,NONE)::other,a2)
+               end
+         in doit a defs
+         end
 
       (*--------------------------------------------------------------------*)
       (* process an undeclared attribute in a start-tag.                    *)
@@ -8883,27 +8883,27 @@
       (* return nothing.                                                    *)
       (*--------------------------------------------------------------------*)
       fun handleUndeclAtt dtd (a,q) (aidx,att,eidx,elem) =
-	 if !O_ERROR_MINIMIZE then 
-	    let val {decl,atts,errAtts} = getElement dtd eidx
-	    in if member aidx errAtts then a
-	       else let val a1 = if !O_VALIDATE andalso hasDtd dtd
-				    then let val err = ERR_UNDECL_ATT(att,elem)
-					 in hookError(a,(getPos q,err))
-					 end
-				 else a
-			val a2 = checkAttName (a1,q) att
-			val _ = setElement dtd (eidx,{decl    = decl,
-						      atts    = atts,
-						      errAtts = aidx::errAtts})
-		    in a2
-		    end
-	    end
-	 else let val a1 = if !O_VALIDATE andalso hasDtd dtd
-			      then hookError(a,(getPos q,ERR_UNDECL_ATT(att,elem)))
-			   else a
-	      in checkAttName (a1,q) att
-	      end
-	   
+         if !O_ERROR_MINIMIZE then 
+            let val {decl,atts,errAtts} = getElement dtd eidx
+            in if member aidx errAtts then a
+               else let val a1 = if !O_VALIDATE andalso hasDtd dtd
+                                    then let val err = ERR_UNDECL_ATT(att,elem)
+                                         in hookError(a,(getPos q,err))
+                                         end
+                                 else a
+                        val a2 = checkAttName (a1,q) att
+                        val _ = setElement dtd (eidx,{decl    = decl,
+                                                      atts    = atts,
+                                                      errAtts = aidx::errAtts})
+                    in a2
+                    end
+            end
+         else let val a1 = if !O_VALIDATE andalso hasDtd dtd
+                              then hookError(a,(getPos q,ERR_UNDECL_ATT(att,elem)))
+                           else a
+              in checkAttName (a1,q) att
+              end
+           
    end
 (* stop of ../../Parser/Dtd/dtdAttributes.sml *)
 (* start of ../../Parser/Dtd/dtdManager.sml *)
@@ -8920,14 +8920,14 @@
 (*                                                                          *)
 (* Exceptions raised by functions in this structure:                        *)
 (*   initDtdTables     : none                                               *)
-(*   AttIdx2String     : NoSuchSymbol		                            *)
+(*   AttIdx2String     : NoSuchSymbol                                       *)
 (*   ElemIdx2String    : NoSuchIndex                                        *)         
-(*   GenEntIdx2String  : NoSuchIndex		                            *)
-(*   IdIdx2String      : NoSuchIndex		                            *)
-(*   NotIdx2String     : NoSuchIndex 		                            *)
-(*   GenEntity2String  : NoSuchIndex		                            *)
+(*   GenEntIdx2String  : NoSuchIndex                                        *)
+(*   IdIdx2String      : NoSuchIndex                                        *)
+(*   NotIdx2String     : NoSuchIndex                                        *)
+(*   GenEntity2String  : NoSuchIndex                                        *)
 (*   ElemInfo2String   : NoSuchIndex NoSuchSymbol                           *)
-(*   printGenEntTable  : NoSuchIndex		                            *)
+(*   printGenEntTable  : NoSuchIndex                                        *)
 (*   printElementTable : NoSuchIndex NoSuchSymbol                           *)
 (*   printDtdTables    : NoSuchIndex NoSuchSymbol                           *)
 (*--------------------------------------------------------------------------*)
@@ -8939,15 +8939,15 @@
       exception AttValue of AppData
 
       val makeAttValue  : Dtd -> AppData * State 
-	 -> int * Base.AttType * bool * bool * UniChar.Data 
-	 -> UniChar.Vector * (Base.AttValue option * AppData)
+         -> int * Base.AttType * bool * bool * UniChar.Data 
+         -> UniChar.Vector * (Base.AttValue option * AppData)
       val checkAttValue : Dtd -> AppData * State 
-	 -> Base.AttDef * UniChar.Vector * UniChar.Data
-	 -> HookData.AttPresent * AppData
+         -> Base.AttDef * UniChar.Vector * UniChar.Data
+         -> HookData.AttPresent * AppData
       val genMissingAtts  : Dtd -> AppData * State 
-	 -> Base.AttDefList * HookData.AttSpecList -> HookData.AttSpecList * AppData
+         -> Base.AttDefList * HookData.AttSpecList -> HookData.AttSpecList * AppData
       val handleUndeclAtt : Dtd -> AppData * State 
-	 -> int * UniChar.Data * int * UniChar.Data -> AppData
+         -> int * UniChar.Data * int * UniChar.Data -> AppData
       val handleUndeclElement : Dtd -> int -> Base.ElemInfo
 
       val checkAttName    : AppData * State -> UniChar.Data -> AppData
@@ -8967,16 +8967,16 @@
    end
 
 functor DtdManager (structure Dtd           : Dtd
-		    structure Hooks         : Hooks
-		    structure ParserOptions : ParserOptions) : DtdManager =
+                    structure Hooks         : Hooks
+                    structure ParserOptions : ParserOptions) : DtdManager =
    struct
       structure Entities      = Entities      (structure Hooks = Hooks)
       structure DtdAttributes = DtdAttributes (structure Dtd = Dtd
-					       structure Entities = Entities
-					       structure ParserOptions = ParserOptions)	 
+                                               structure Entities = Entities
+                                               structure ParserOptions = ParserOptions)  
       open 
-	 Dtd
-	 DtdAttributes
+         Dtd
+         DtdAttributes
    end
 (* stop of ../../Parser/Dtd/dtdManager.sml *)
 (* start of ../../Parser/Parse/parseBase.sml *)
@@ -9007,26 +9007,26 @@
 (* own structure, but like this the code is more easier to read).           *)
 (*--------------------------------------------------------------------------*)
 functor ParseBase (structure Dtd           : Dtd
-		   structure Hooks         : Hooks
-		   structure Resolve       : Resolve
-		   structure ParserOptions : ParserOptions) : ParseBase =
+                   structure Hooks         : Hooks
+                   structure Resolve       : Resolve
+                   structure ParserOptions : ParserOptions) : ParseBase =
    struct
       structure DfaOptions = ParserOptions.DfaOptions
       structure Dfa = Dfa (structure DfaOptions = DfaOptions)
       structure DtdManager = DtdManager (structure Dtd = Dtd
-					 structure Hooks = Hooks
-					 structure ParserOptions = ParserOptions)
+                                         structure Hooks = Hooks
+                                         structure ParserOptions = ParserOptions)
       open 
-	 Base DtdManager DfaOptions Dfa Errors ParserOptions Resolve UniChar
-	 
+         Base DtdManager DfaOptions Dfa Errors ParserOptions Resolve UniChar
+         
       exception NoSuchChar of AppData * State
       exception NoSuchEntity of AppData * State
       exception NotFound of UniChar.Char * AppData * State
       exception SyntaxError of UniChar.Char * AppData * State
       
       fun expectedOrEnded (exp,ended) c =
-	 if c=0wx00 then ERR_ENDED_BY_EE ended
-	 else ERR_EXPECTED(exp,[c])
+         if c=0wx00 then ERR_ENDED_BY_EE ended
+         else ERR_EXPECTED(exp,[c])
 
    (*--------------------------------------------------------------------*)
    (* Besides "?>" also recognize ">" as end delimiter, because the typo *)
@@ -9037,104 +9037,104 @@
    (*--------------------------------------------------------------------*)
    fun recoverXml caq =
       let 
-	 fun do_lit ch (c,a,q) =
-	    case c
-	      of 0wx00 => (c,a,q)
-	       | 0wx3F (* #"?" *) => 
-		 let val (c1,a1,q1) = getChar (a,q)
-		 in if c1=0wx3E (* #">" *) then (c1,a1,q1)
-		    else do_lit ch (c1,a1,q1)
-		 end
-	       | _ => if c=ch then (getChar (a,q))
-		      else do_lit ch (getChar (a,q))
-	 fun doit (c,a,q) = 
-	    case c
-	      of 0wx00 => (c,a,q)
-	       | 0wx22 (* #""""*) => doit (do_lit c (getChar (a,q)))
-	       | 0wx25 (* #"%" *) => (c,a,q)
-	       | 0wx26 (* #"&" *) => (c,a,q)
-	       | 0wx27 (* #"'" *) => doit (do_lit c (getChar (a,q)))
-	       | 0wx3C (* #"<" *) => (c,a,q)
-	       | 0wx3E (* #">" *) => (getChar (a,q))
-	       | _ => doit (getChar (a,q))
+         fun do_lit ch (c,a,q) =
+            case c
+              of 0wx00 => (c,a,q)
+               | 0wx3F (* #"?" *) => 
+                 let val (c1,a1,q1) = getChar (a,q)
+                 in if c1=0wx3E (* #">" *) then (c1,a1,q1)
+                    else do_lit ch (c1,a1,q1)
+                 end
+               | _ => if c=ch then (getChar (a,q))
+                      else do_lit ch (getChar (a,q))
+         fun doit (c,a,q) = 
+            case c
+              of 0wx00 => (c,a,q)
+               | 0wx22 (* #""""*) => doit (do_lit c (getChar (a,q)))
+               | 0wx25 (* #"%" *) => (c,a,q)
+               | 0wx26 (* #"&" *) => (c,a,q)
+               | 0wx27 (* #"'" *) => doit (do_lit c (getChar (a,q)))
+               | 0wx3C (* #"<" *) => (c,a,q)
+               | 0wx3E (* #">" *) => (getChar (a,q))
+               | _ => doit (getChar (a,q))
       in 
-	 doit caq
+         doit caq
       end
    
    fun recoverETag caq =
       let 
-	 fun do_lit ch (c,a,q) =
-	    case c
-	      of 0wx00 => (c,a,q)
-	       | _ => if c=ch then (getChar (a,q))
-		      else do_lit ch (getChar (a,q))
-	 fun doit (c,a,q) = 
-	    case c
-	      of 0wx00 => (c,a,q)
-	       | 0wx22 (* #""""*) => doit (do_lit c (getChar (a,q)))
-	       | 0wx26 (* #"&" *) => (c,a,q)
-	       | 0wx27 (* #"'" *) => doit (do_lit c (getChar (a,q)))
-	       | 0wx3E (* #">" *) => (getChar (a,q))
-	       | 0wx3C (* #"<" *) => (c,a,q)
-	       | _ => doit (getChar (a,q))
+         fun do_lit ch (c,a,q) =
+            case c
+              of 0wx00 => (c,a,q)
+               | _ => if c=ch then (getChar (a,q))
+                      else do_lit ch (getChar (a,q))
+         fun doit (c,a,q) = 
+            case c
+              of 0wx00 => (c,a,q)
+               | 0wx22 (* #""""*) => doit (do_lit c (getChar (a,q)))
+               | 0wx26 (* #"&" *) => (c,a,q)
+               | 0wx27 (* #"'" *) => doit (do_lit c (getChar (a,q)))
+               | 0wx3E (* #">" *) => (getChar (a,q))
+               | 0wx3C (* #"<" *) => (c,a,q)
+               | _ => doit (getChar (a,q))
       in 
-	 doit caq
+         doit caq
       end
    
    fun recoverSTag caq =
       let 
-	 fun do_lit ch (c,a,q) =
-	    case c
-	      of 0wx00 => (c,a,q)
-	       | _ => if c=ch then (getChar (a,q))
-		      else do_lit ch (getChar (a,q))
-	 fun doit (c,a,q) = 
-	    case c
-	      of 0wx00 => (false,(c,a,q))
-	       | 0wx22 (* #""""*) => doit (do_lit c (getChar (a,q)))
-	       | 0wx26 (* #"&" *) => (false,(c,a,q))
-	       | 0wx27 (* #"'" *) => doit (do_lit c (getChar (a,q)))
-	       | 0wx2F (* #"/" *) => let val (c1,a1,q1) = getChar (a,q)
-				     in if c1=0wx3E (* #">" *) then (true,(c1,a1,q1))
-					else doit (c1,a1,q1)
-				     end
-	       | 0wx3E (* #">" *) => (false,getChar (a,q))
-	       | 0wx3C (* #"<" *) => (false,(c,a,q))
-	       | _ => doit (getChar (a,q))
+         fun do_lit ch (c,a,q) =
+            case c
+              of 0wx00 => (c,a,q)
+               | _ => if c=ch then (getChar (a,q))
+                      else do_lit ch (getChar (a,q))
+         fun doit (c,a,q) = 
+            case c
+              of 0wx00 => (false,(c,a,q))
+               | 0wx22 (* #""""*) => doit (do_lit c (getChar (a,q)))
+               | 0wx26 (* #"&" *) => (false,(c,a,q))
+               | 0wx27 (* #"'" *) => doit (do_lit c (getChar (a,q)))
+               | 0wx2F (* #"/" *) => let val (c1,a1,q1) = getChar (a,q)
+                                     in if c1=0wx3E (* #">" *) then (true,(c1,a1,q1))
+                                        else doit (c1,a1,q1)
+                                     end
+               | 0wx3E (* #">" *) => (false,getChar (a,q))
+               | 0wx3C (* #"<" *) => (false,(c,a,q))
+               | _ => doit (getChar (a,q))
       in 
-	 doit caq
+         doit caq
       end
    
    fun recoverDecl hasSubset caq = 
       let 
-	 fun do_lit ch (c,a,q) =
-	    if c=0wx00 then (c,a,q)
-	    else if c=ch then getChar (a,q)
-		 else do_lit ch (getChar(a,q))
-	 fun do_decl (c,a,q) =
-	    case c
-	      of 0wx00 => (c,a,q)
-	       | 0wx22 (* #"\""*) => do_decl (do_lit c (getChar (a,q)))
-	       | 0wx27 (* #"'" *) => do_decl (do_lit c (getChar (a,q)))
-	       | 0wx3E (* #">" *) => getChar (a,q)
-	       | _ => do_decl (getChar (a,q))
+         fun do_lit ch (c,a,q) =
+            if c=0wx00 then (c,a,q)
+            else if c=ch then getChar (a,q)
+                 else do_lit ch (getChar(a,q))
+         fun do_decl (c,a,q) =
+            case c
+              of 0wx00 => (c,a,q)
+               | 0wx22 (* #"\""*) => do_decl (do_lit c (getChar (a,q)))
+               | 0wx27 (* #"'" *) => do_decl (do_lit c (getChar (a,q)))
+               | 0wx3E (* #">" *) => getChar (a,q)
+               | _ => do_decl (getChar (a,q))
          fun do_subset (c,a,q) =
-	    case c
-	      of 0wx00 => (c,a,q)
-	       | 0wx3C (* #"<" *) => do_subset (do_decl (getChar (a,q)))
-	       | 0wx5D (* #"]" *) => getChar (a,q)
-	       | _ => do_subset (getChar (a,q))
-	 fun doit (c,a,q) =
-	    case c
-	      of 0wx00 => if isSpecial q then (c,a,q) else doit (getChar (a,q))
-	       | 0wx22 (* #"\""*) => doit (do_lit c (getChar (a,q)))
-	       | 0wx25 (* #"%" *) => if hasSubset then (c,a,q) else doit (getChar (a,q))
-	       | 0wx27 (* #"'" *) => doit (do_lit c (getChar (a,q)))
-	       | 0wx3C (* #"<" *) => (c,a,q)
-	       | 0wx3E (* #">" *) => getChar (a,q)
-	       | 0wx5B (* #"[" *) => if hasSubset then doit (do_subset (getChar (a,q)))
-				     else doit (getChar (a,q))
-	       | _ => doit (getChar (a,q))
+            case c
+              of 0wx00 => (c,a,q)
+               | 0wx3C (* #"<" *) => do_subset (do_decl (getChar (a,q)))
+               | 0wx5D (* #"]" *) => getChar (a,q)
+               | _ => do_subset (getChar (a,q))
+         fun doit (c,a,q) =
+            case c
+              of 0wx00 => if isSpecial q then (c,a,q) else doit (getChar (a,q))
+               | 0wx22 (* #"\""*) => doit (do_lit c (getChar (a,q)))
+               | 0wx25 (* #"%" *) => if hasSubset then (c,a,q) else doit (getChar (a,q))
+               | 0wx27 (* #"'" *) => doit (do_lit c (getChar (a,q)))
+               | 0wx3C (* #"<" *) => (c,a,q)
+               | 0wx3E (* #">" *) => getChar (a,q)
+               | 0wx5B (* #"[" *) => if hasSubset then doit (do_subset (getChar (a,q)))
+                                     else doit (getChar (a,q))
+               | _ => doit (getChar (a,q))
       in doit caq
       end
 
@@ -9154,7 +9154,7 @@
       include ParseBase
 
       val parseName    : UniChar.Char * AppData * State 
-	 -> UniChar.Data * (UniChar.Char * AppData * State)
+         -> UniChar.Data * (UniChar.Char * AppData * State)
       val parseNmtoken : UniChar.Char * AppData * State 
          -> UniChar.Data * (UniChar.Char * AppData * State)
 
@@ -9189,11 +9189,11 @@
       (* character and the remaining state.                                 *)
       (*--------------------------------------------------------------------*)
       fun parseName' (c,a,q) = 
-	 if isName c 
-	    then let val (cs,caq1) = parseName'(getChar(a,q))
-		 in (c::cs,caq1)
-		 end
-	 else (nil,(c,a,q))
+         if isName c 
+            then let val (cs,caq1) = parseName'(getChar(a,q))
+                 in (c::cs,caq1)
+                 end
+         else (nil,(c,a,q))
       fun parseName (c,a,q) = 
          if isNms c 
             then let val (cs,caq1) = parseName'(getChar(a,q))
@@ -9265,7 +9265,7 @@
       include ParseBase
 
       val parseName    : UniChar.Char * AppData * State 
-	 -> UniChar.Data * (UniChar.Char * AppData * State)
+         -> UniChar.Data * (UniChar.Char * AppData * State)
       val parseNmtoken : UniChar.Char * AppData * State 
          -> UniChar.Data * (UniChar.Char * AppData * State)
       val parseNameLit : UniChar.Data -> UniChar.Char * AppData * State
@@ -9280,14 +9280,14 @@
       val skipSmay : UniChar.Char * AppData * State -> bool * (UniChar.Char * AppData * State)
 
       val parseSopt : UniChar.Data -> UniChar.Char * AppData * State 
-	 -> UniChar.Data * (UniChar.Char * AppData * State)
+         -> UniChar.Data * (UniChar.Char * AppData * State)
       val parseSmay : UniChar.Data -> UniChar.Char * AppData * State 
-	 -> bool * (UniChar.Data * (UniChar.Char * AppData * State))
-	 
+         -> bool * (UniChar.Data * (UniChar.Char * AppData * State))
+         
       val skipEq : UniChar.Char * AppData * State 
-	 -> UniChar.Char * AppData * State
+         -> UniChar.Char * AppData * State
       val parseEq : UniChar.Char * AppData * State 
-	 -> UniChar.Data * (UniChar.Char * AppData * State)
+         -> UniChar.Data * (UniChar.Char * AppData * State)
 
       val parseComment   : Errors.Position -> AppData * State -> (UniChar.Char * AppData * State)
       val parseProcInstr : Errors.Position -> AppData * State -> (UniChar.Char * AppData * State)
@@ -9324,16 +9324,16 @@
    (*--------------------------------------------------------------------*)
    fun skipSopt (c,a,q) =
       case c 
-	of 0wx09 => skipSopt (getChar (a,q))
-	 | 0wx0A => skipSopt (getChar (a,q))
-	 | 0wx20 => skipSopt (getChar (a,q))
-	 | _ => (c,a,q)
+        of 0wx09 => skipSopt (getChar (a,q))
+         | 0wx0A => skipSopt (getChar (a,q))
+         | 0wx20 => skipSopt (getChar (a,q))
+         | _ => (c,a,q)
    fun parseSopt cs (c,a,q) =
       case c 
-	of 0wx09 => parseSopt (c::cs) (getChar (a,q))
-	 | 0wx0A => parseSopt (c::cs) (getChar (a,q))
-	 | 0wx20 => parseSopt (c::cs) (getChar (a,q))
-	 | _ => (cs,(c,a,q))
+        of 0wx09 => parseSopt (c::cs) (getChar (a,q))
+         | 0wx0A => parseSopt (c::cs) (getChar (a,q))
+         | 0wx20 => parseSopt (c::cs) (getChar (a,q))
+         | _ => (cs,(c,a,q))
    (*--------------------------------------------------------------------*)
    (* parse optional white space.                                        *)
    (*--------------------------------------------------------------------*)
@@ -9342,16 +9342,16 @@
    (*--------------------------------------------------------------------*)
    fun skipSmay (c,a,q) =
       case c 
-	of 0wx09 => (true,skipSopt (getChar (a,q)))
-	 | 0wx0A => (true,skipSopt (getChar (a,q)))
-	 | 0wx20 => (true,skipSopt (getChar (a,q)))
-	 | _ => (false,(c,a,q))
+        of 0wx09 => (true,skipSopt (getChar (a,q)))
+         | 0wx0A => (true,skipSopt (getChar (a,q)))
+         | 0wx20 => (true,skipSopt (getChar (a,q)))
+         | _ => (false,(c,a,q))
    fun parseSmay cs (c,a,q) =
       case c 
-	of 0wx09 => (true,parseSopt (c::cs) (getChar (a,q)))
-	 | 0wx0A => (true,parseSopt (c::cs) (getChar (a,q)))
-	 | 0wx20 => (true,parseSopt (c::cs) (getChar (a,q)))
-	 | _ => (false,(cs,(c,a,q)))
+        of 0wx09 => (true,parseSopt (c::cs) (getChar (a,q)))
+         | 0wx0A => (true,parseSopt (c::cs) (getChar (a,q)))
+         | 0wx20 => (true,parseSopt (c::cs) (getChar (a,q)))
+         | _ => (false,(cs,(c,a,q)))
    (*--------------------------------------------------------------------*)
    (* parse required white space.                                        *)
    (*--------------------------------------------------------------------*)
@@ -9361,10 +9361,10 @@
    (*--------------------------------------------------------------------*)
    fun skipS (c,a,q) = 
       case c
-	of 0wx09 => skipSopt (getChar (a,q))
-	 | 0wx0A => skipSopt (getChar (a,q))
-	 | 0wx20 => skipSopt (getChar (a,q))
-	 | _ => (c,hookError(a,(getPos q,ERR_MISSING_WHITE)),q)
+        of 0wx09 => skipSopt (getChar (a,q))
+         | 0wx0A => skipSopt (getChar (a,q))
+         | 0wx20 => skipSopt (getChar (a,q))
+         | _ => (c,hookError(a,(getPos q,ERR_MISSING_WHITE)),q)
 
    (*--------------------------------------------------------------------*)
    (* parse a "=" together with surrounding white space. Cf. 28:         *)
@@ -9379,19 +9379,19 @@
    fun skipEq caq = 
       let val (c1,a1,q1) = skipSopt caq
       in if c1=0wx3D then skipSopt (getChar (a1,q1))
-	 else let val a2 = hookError(a1,(getPos q1,ERR_EXPECTED(expEq,[c1])))
-	      in raise SyntaxError(c1,a2,q1)
-	      end
+         else let val a2 = hookError(a1,(getPos q1,ERR_EXPECTED(expEq,[c1])))
+              in raise SyntaxError(c1,a2,q1)
+              end
       end
    fun parseEq caq = 
       let val (cs1,(c1,a1,q1)) = parseSopt nil caq
       in if c1=0wx3D 
-	    then let val (cs2,caq2)= parseSopt (c1::cs1) (getChar (a1,q1))
-		 in (rev cs2,caq2)
-		 end
-	 else let val a2 = hookError(a1,(getPos q1,ERR_EXPECTED(expEq,[c1])))
-	      in raise SyntaxError(c1,a2,q1)
-	      end
+            then let val (cs2,caq2)= parseSopt (c1::cs1) (getChar (a1,q1))
+                 in (rev cs2,caq2)
+                 end
+         else let val a2 = hookError(a1,(getPos q1,ERR_EXPECTED(expEq,[c1])))
+              in raise SyntaxError(c1,a2,q1)
+              end
       end
 
    (*--------------------------------------------------------------------*)
@@ -9414,32 +9414,32 @@
    (*--------------------------------------------------------------------*)
    fun parseComment startPos aq =
       let 
-	 fun check_end yet (a0,q0) =
-	    let val (c,a,q) = getChar (a0,q0)
-	    in if c=0wx2D (* #"-" *)
-		  then let val (c1,a1,q1) = getChar (a,q)
-		       in if c1=0wx3E (* #">" *) 
-			     then let val cs = Data2Vector(rev yet)
-				      val a2 = hookComment(a1,((startPos,getPos q1),cs))
-				  in getChar(a2,q1)
-				  end
-			  else let val a2 = if not (!O_COMPATIBILITY) then a1 
-					    else hookError(a1,(getPos q0,ERR_FORBIDDEN_HERE
-							       (IT_DATA [c,c],LOC_COMMENT)))
-			       in doit (c::c::yet) (c1,a2,q1)
-			       end
-		       end
-	       else doit (0wx2D::yet) (c,a,q)
-	    end
-	  and doit yet (c,a,q) = 
-	     if c=0wx2D (* #"-" *) then check_end yet (a,q)
-	     else if c<>0wx00 then doit (c::yet) (getChar (a,q))
-		  else let val err = ERR_ENDED_BY_EE LOC_COMMENT
-			   val a1 = hookError(a,(getPos q,err))
-			   val cs = Data2Vector(rev yet)
-			   val a2 = hookComment(a1,((startPos,getPos q),cs))
-		       in (c,a2,q)
-		       end
+         fun check_end yet (a0,q0) =
+            let val (c,a,q) = getChar (a0,q0)
+            in if c=0wx2D (* #"-" *)
+                  then let val (c1,a1,q1) = getChar (a,q)
+                       in if c1=0wx3E (* #">" *) 
+                             then let val cs = Data2Vector(rev yet)
+                                      val a2 = hookComment(a1,((startPos,getPos q1),cs))
+                                  in getChar(a2,q1)
+                                  end
+                          else let val a2 = if not (!O_COMPATIBILITY) then a1 
+                                            else hookError(a1,(getPos q0,ERR_FORBIDDEN_HERE
+                                                               (IT_DATA [c,c],LOC_COMMENT)))
+                               in doit (c::c::yet) (c1,a2,q1)
+                               end
+                       end
+               else doit (0wx2D::yet) (c,a,q)
+            end
+          and doit yet (c,a,q) = 
+             if c=0wx2D (* #"-" *) then check_end yet (a,q)
+             else if c<>0wx00 then doit (c::yet) (getChar (a,q))
+                  else let val err = ERR_ENDED_BY_EE LOC_COMMENT
+                           val a1 = hookError(a,(getPos q,err))
+                           val cs = Data2Vector(rev yet)
+                           val a2 = hookComment(a1,((startPos,getPos q),cs))
+                       in (c,a2,q)
+                       end
       in doit nil (getChar aq) 
       end
 
@@ -9457,12 +9457,12 @@
    (*--------------------------------------------------------------------*)
    fun checkPiTarget (a,q) name = 
       case name
-	of [c1,c2,c3] => if ((c1=0wx58 orelse c1=0wx78) andalso 
-			     (c2=0wx4D orelse c2=0wx6D) andalso
-			     (c3=0wx4C orelse c3=0wx6C)) 
-			    then hookError(a,(getPos q,ERR_RESERVED(name,IT_TARGET)))
-			 else a
-	 | _ => a
+        of [c1,c2,c3] => if ((c1=0wx58 orelse c1=0wx78) andalso 
+                             (c2=0wx4D orelse c2=0wx6D) andalso
+                             (c3=0wx4C orelse c3=0wx6C)) 
+                            then hookError(a,(getPos q,ERR_RESERVED(name,IT_TARGET)))
+                         else a
+         | _ => a
    (*--------------------------------------------------------------------*)
    (* parse a processing instruction, the initial "<?" and target        *)
    (* already consumed. cf. 2.5:                                         *)
@@ -9480,24 +9480,24 @@
    (*--------------------------------------------------------------------*)
    fun parseProcInstr' (startPos,target,txtPos,yetText) caq =
       let 
-	 fun doit text (c1,a1,q1) = 
-	    case c1 
-	      of 0wx00 => let val a2 = hookError(a1,(getPos q1,ERR_ENDED_BY_EE LOC_PROC))
-			  in (text,getPos q1,(c1,a2,q1))
-			  end
-	       | 0wx3F => (* #"?" *)
-			  let val (c2,a2,q2) = getChar (a1,q1)
-			  in case c2
-			       of 0wx3E => (* #">" *) (text,getPos q2,getChar(a2,q2))
-				| _ => doit (c1::text) (c2,a2,q2)
-			  end
-	       | _ => doit (c1::text) (getChar (a1,q1))
-		    
-	 val (cs,endPos,(c2,a2,q2)) = doit yetText caq  
-	 val text = Data2Vector(rev cs)
-	 val a3 = hookProcInst(a2,((startPos,endPos),target,txtPos,text))
+         fun doit text (c1,a1,q1) = 
+            case c1 
+              of 0wx00 => let val a2 = hookError(a1,(getPos q1,ERR_ENDED_BY_EE LOC_PROC))
+                          in (text,getPos q1,(c1,a2,q1))
+                          end
+               | 0wx3F => (* #"?" *)
+                          let val (c2,a2,q2) = getChar (a1,q1)
+                          in case c2
+                               of 0wx3E => (* #">" *) (text,getPos q2,getChar(a2,q2))
+                                | _ => doit (c1::text) (c2,a2,q2)
+                          end
+               | _ => doit (c1::text) (getChar (a1,q1))
+                    
+         val (cs,endPos,(c2,a2,q2)) = doit yetText caq  
+         val text = Data2Vector(rev cs)
+         val a3 = hookProcInst(a2,((startPos,endPos),target,txtPos,text))
       in 
-	 (c2,a3,q2)
+         (c2,a3,q2)
       end
    (*--------------------------------------------------------------------*)
    (* parse a processing instruction, the initial "<?" already read.     *)
@@ -9514,34 +9514,34 @@
    (*--------------------------------------------------------------------*)
    fun parseProcInstr startPos (a,q) =
       let 
-	 (* NotFound is handled after the 'in .. end' *)
-	 val (target,(c1,a1,q1)) = parseName (getChar(a,q))
-	 val a1 = checkPiTarget (a1,q) target
+         (* NotFound is handled after the 'in .. end' *)
+         val (target,(c1,a1,q1)) = parseName (getChar(a,q))
+         val a1 = checkPiTarget (a1,q) target
       in 
-	 case c1 
-	   of 0wx00 => 
-	      let 
-		 val a2 = hookError(a1,(getPos q1,ERR_ENDED_BY_EE LOC_PROC))
-		 val a3 = hookProcInst(a2,((startPos,getPos q1),target,getPos q1,nullVector))
-	      in (c1,a3,q1) 
-	      end
-	    | 0wx3F => (* #"?" *)
-	      let val (c2,a2,q2) = getChar (a1,q1)
-	      in case c2
-		   of 0wx3E => (* #">" *) 
+         case c1 
+           of 0wx00 => 
+              let 
+                 val a2 = hookError(a1,(getPos q1,ERR_ENDED_BY_EE LOC_PROC))
+                 val a3 = hookProcInst(a2,((startPos,getPos q1),target,getPos q1,nullVector))
+              in (c1,a3,q1) 
+              end
+            | 0wx3F => (* #"?" *)
+              let val (c2,a2,q2) = getChar (a1,q1)
+              in case c2
+                   of 0wx3E => (* #">" *) 
                       let val a3 = hookProcInst(a2,((startPos,getPos q2),target,
                                                     getPos q1,nullVector))
                       in getChar (a3,q2)
                       end
-		    | _ => let val a3 = hookError(a2,(getPos q1,ERR_MISSING_WHITE))
-			   in parseProcInstr' (startPos,target,getPos q1,[c1]) (c2,a3,q2)
-			   end
-	      end
-	    | _ => let val (hadS,(c2,a2,q2)) = skipSmay (c1,a1,q1) 
-		       val a3 = if hadS then a2 
-				else hookError(a2,(getPos q2,ERR_MISSING_WHITE))
-		   in parseProcInstr' (startPos,target,getPos q2,nil) (c2,a3,q2)
-		   end
+                    | _ => let val a3 = hookError(a2,(getPos q1,ERR_MISSING_WHITE))
+                           in parseProcInstr' (startPos,target,getPos q1,[c1]) (c2,a3,q2)
+                           end
+              end
+            | _ => let val (hadS,(c2,a2,q2)) = skipSmay (c1,a1,q1) 
+                       val a3 = if hadS then a2 
+                                else hookError(a2,(getPos q2,ERR_MISSING_WHITE))
+                   in parseProcInstr' (startPos,target,getPos q2,nil) (c2,a3,q2)
+                   end
       end
    handle NotFound(c,a,q) => 
       let val a1 = hookError(a,(getPos q,ERR_EXPECTED(expATarget,[c]))) 
@@ -9556,7 +9556,7 @@
       include ParseBase
 
       val parseName    : UniChar.Char * AppData * State 
-	 -> UniChar.Data * (UniChar.Char * AppData * State)
+         -> UniChar.Data * (UniChar.Char * AppData * State)
       val parseNmtoken : UniChar.Char * AppData * State 
          -> UniChar.Data * (UniChar.Char * AppData * State)
       val parseNameLit : UniChar.Data -> UniChar.Char * AppData * State
@@ -9570,20 +9570,20 @@
       val skipSopt : UniChar.Char * AppData * State -> UniChar.Char * AppData * State
       val skipSmay : UniChar.Char * AppData * State -> bool * (UniChar.Char * AppData * State)
       val parseSopt : UniChar.Data -> UniChar.Char * AppData * State 
-	 -> UniChar.Data * (UniChar.Char * AppData * State)
+         -> UniChar.Data * (UniChar.Char * AppData * State)
       val parseSmay : UniChar.Data -> UniChar.Char * AppData * State 
-	 -> bool * (UniChar.Data * (UniChar.Char * AppData * State))
+         -> bool * (UniChar.Data * (UniChar.Char * AppData * State))
       val parseEq : UniChar.Char * AppData * State 
-	 -> UniChar.Data * (UniChar.Char * AppData * State)
+         -> UniChar.Data * (UniChar.Char * AppData * State)
       ----------------------------------------------------------------------*)
       include ParseMisc
 
       val openDocument : Uri.Uri option -> AppData 
-	 -> Encoding.Encoding * HookData.XmlDecl option * (UniChar.Char * AppData * State)
+         -> Encoding.Encoding * HookData.XmlDecl option * (UniChar.Char * AppData * State)
       val openSubset   : Uri.Uri -> AppData 
-	 -> Encoding.Encoding * HookData.TextDecl option * (UniChar.Char * AppData * State)
+         -> Encoding.Encoding * HookData.TextDecl option * (UniChar.Char * AppData * State)
       val openExtern   : int * bool * Uri.Uri -> AppData * State 
-	 -> Encoding.Encoding * HookData.TextDecl option * (UniChar.Char * AppData * State)
+         -> Encoding.Encoding * HookData.TextDecl option * (UniChar.Char * AppData * State)
    end
 
 (*--------------------------------------------------------------------------*)
@@ -9602,7 +9602,7 @@
    open 
       Errors UniChar UniClasses UtilString
       ParseMisc
-	 
+         
    fun checkVersionNum (a,q) version =
       if not (!O_CHECK_VERSION) orelse version="1.0" then a 
       else hookError(a,(getPos q,ERR_VERSION version))
@@ -9625,39 +9625,39 @@
    (*--------------------------------------------------------------------*)
    fun parseVersionNum quote aq =
       let 
-	 fun doit text (c,a,q) = 
-	    if c=quote then (text,getChar (a,q))
-	    else if isVers c then doit (c::text) (getChar (a,q))
-	    else if c=0wx0
-		    then let val a1 = hookError(a,(getPos q,ERR_ENDED_BY_EE LOC_VERSION))
-			 in (text,(c,a1,q))
-			 end
-		 else let val err = ERR_FORBIDDEN_HERE(IT_CHAR c,LOC_VERSION)
-			  val a1 = hookError(a,(getPos q,err))
-		      in doit text (getChar (a1,q))
-		      end
+         fun doit text (c,a,q) = 
+            if c=quote then (text,getChar (a,q))
+            else if isVers c then doit (c::text) (getChar (a,q))
+            else if c=0wx0
+                    then let val a1 = hookError(a,(getPos q,ERR_ENDED_BY_EE LOC_VERSION))
+                         in (text,(c,a1,q))
+                         end
+                 else let val err = ERR_FORBIDDEN_HERE(IT_CHAR c,LOC_VERSION)
+                          val a1 = hookError(a,(getPos q,err))
+                      in doit text (getChar (a1,q))
+                      end
 
-	 val (c1,a1,q1) = getChar aq
+         val (c1,a1,q1) = getChar aq
 
-	 val (text,(c2,a2,q2)) = 
-	    if isVers c1 then doit [c1] (getChar (a1,q1))
-	    else if c1=quote 
-		    then let val a2 = hookError(a1,(getPos q1,ERR_EMPTY LOC_VERSION))
-			 in (nil,getChar (a2,q1))
-			 end
-	    else if c1=0wx00 
-		    then let val a2 = hookError(a1,(getPos q1,ERR_ENDED_BY_EE LOC_VERSION))
-			     val a3 = hookError(a2,(getPos q1,ERR_EMPTY LOC_VERSION))
-			 in (nil,(c1,a3,q1)) 
-			 end
-		 else let val err = ERR_FORBIDDEN_HERE(IT_CHAR c1,LOC_VERSION)
-			  val a2 = hookError(a1,(getPos q1,err))
-		      in doit nil (getChar (a2,q1))
-		      end
-	 val version = Latin2String (rev text)
-	 val a3 = checkVersionNum (a2,q1) version
+         val (text,(c2,a2,q2)) = 
+            if isVers c1 then doit [c1] (getChar (a1,q1))
+            else if c1=quote 
+                    then let val a2 = hookError(a1,(getPos q1,ERR_EMPTY LOC_VERSION))
+                         in (nil,getChar (a2,q1))
+                         end
+            else if c1=0wx00 
+                    then let val a2 = hookError(a1,(getPos q1,ERR_ENDED_BY_EE LOC_VERSION))
+                             val a3 = hookError(a2,(getPos q1,ERR_EMPTY LOC_VERSION))
+                         in (nil,(c1,a3,q1)) 
+                         end
+                 else let val err = ERR_FORBIDDEN_HERE(IT_CHAR c1,LOC_VERSION)
+                          val a2 = hookError(a1,(getPos q1,err))
+                      in doit nil (getChar (a2,q1))
+                      end
+         val version = Latin2String (rev text)
+         val a3 = checkVersionNum (a2,q1) version
       in 
-	 (SOME version,(c2,a3,q2))
+         (SOME version,(c2,a3,q2))
       end
    (*--------------------------------------------------------------------*)
    (* parse a version info starting after 'version'. Cf. 2.8:            *)
@@ -9676,11 +9676,11 @@
    fun parseVersionInfo caq =
       let val (c1,a1,q1) = skipEq caq
       in case c1
-	   of 0wx22 (* '""' *) => parseVersionNum c1 (a1,q1) 
-	    | 0wx27 (* "'" *)  => parseVersionNum c1 (a1,q1) 
-	    | _ => let val a2 = hookError(a1,(getPos q1,ERR_EXPECTED(expLitQuote,[c1])))
-		   in raise SyntaxError(c1,a2,q1)	
-		   end
+           of 0wx22 (* '""' *) => parseVersionNum c1 (a1,q1) 
+            | 0wx27 (* "'" *)  => parseVersionNum c1 (a1,q1) 
+            | _ => let val a2 = hookError(a1,(getPos q1,ERR_EXPECTED(expLitQuote,[c1])))
+                   in raise SyntaxError(c1,a2,q1)       
+                   end
       end   
 
    (*--------------------------------------------------------------------*)
@@ -9704,38 +9704,38 @@
    (*--------------------------------------------------------------------*)
    fun parseEncName quote aq =
       let 
-	 fun doit text (c,a,q) = 
-	    if c=quote then (text,getChar (a,q))
-	    else if isEnc c then doit (c::text) (getChar (a,q))
-	    else if c=0wx00
-		    then let val a1 = hookError(a,(getPos q,ERR_ENDED_BY_EE LOC_ENCODING))
-			 in (text,(c,a1,q))
-			 end
-		 else let val err = ERR_FORBIDDEN_HERE(IT_CHAR c,LOC_ENCODING)
-			  val a1 = hookError(a,(getPos q,err))
-		      in doit text (getChar (a,q))
-		      end
+         fun doit text (c,a,q) = 
+            if c=quote then (text,getChar (a,q))
+            else if isEnc c then doit (c::text) (getChar (a,q))
+            else if c=0wx00
+                    then let val a1 = hookError(a,(getPos q,ERR_ENDED_BY_EE LOC_ENCODING))
+                         in (text,(c,a1,q))
+                         end
+                 else let val err = ERR_FORBIDDEN_HERE(IT_CHAR c,LOC_ENCODING)
+                          val a1 = hookError(a,(getPos q,err))
+                      in doit text (getChar (a,q))
+                      end
 
-	 val (c1,a1,q1) = getChar aq
+         val (c1,a1,q1) = getChar aq
 
-	 val (text,caq2) = 
-	    if isEncS c1 then doit [c1] (getChar (a1,q1))
-	    else if c1=quote 
-		    then let val a2 = hookError(a1,(getPos q1,ERR_EMPTY LOC_ENCODING))
-			 in (nil,getChar (a2,q1)) 
-			 end
-	    else if c1=0wx00 
-		    then let val a2 = hookError(a1,(getPos q1,ERR_ENDED_BY_EE LOC_ENCODING))
-			     val a3 = hookError(a2,(getPos q1,ERR_EMPTY LOC_ENCODING))
-			 in (nil,(c1,a3,q1))
-			 end
-		 else let val a2 = hookError(a1,(getPos q1,ERR_EXPECTED(expStartEnc,[c1])))
-		      in doit nil (getChar (a2,q1))
-		      end
+         val (text,caq2) = 
+            if isEncS c1 then doit [c1] (getChar (a1,q1))
+            else if c1=quote 
+                    then let val a2 = hookError(a1,(getPos q1,ERR_EMPTY LOC_ENCODING))
+                         in (nil,getChar (a2,q1)) 
+                         end
+            else if c1=0wx00 
+                    then let val a2 = hookError(a1,(getPos q1,ERR_ENDED_BY_EE LOC_ENCODING))
+                             val a3 = hookError(a2,(getPos q1,ERR_EMPTY LOC_ENCODING))
+                         in (nil,(c1,a3,q1))
+                         end
+                 else let val a2 = hookError(a1,(getPos q1,ERR_EXPECTED(expStartEnc,[c1])))
+                      in doit nil (getChar (a2,q1))
+                      end
 
-	 val enc = toUpperString (Latin2String (rev text))
+         val enc = toUpperString (Latin2String (rev text))
       in 
-	 (enc,caq2)
+         (enc,caq2)
       end
    (*--------------------------------------------------------------------*)
    (* parse an encoding decl starting after 'encoding'. Cf. 4.3.3:       *)
@@ -9755,11 +9755,11 @@
    fun parseEncodingDecl caq =
       let val (c1,a1,q1) = skipEq caq 
       in case c1
-	   of 0wx22 (* '""' *) => parseEncName c1 (a1,q1) 
-	    | 0wx27 (* "'" *)  => parseEncName c1 (a1,q1) 
-	    | _ => let val a2 = hookError(a1,(getPos q1,ERR_EXPECTED(expLitQuote,[c1])))
-		   in raise SyntaxError(c1,a2,q1)	
-		   end
+           of 0wx22 (* '""' *) => parseEncName c1 (a1,q1) 
+            | 0wx27 (* "'" *)  => parseEncName c1 (a1,q1) 
+            | _ => let val a2 = hookError(a1,(getPos q1,ERR_EXPECTED(expLitQuote,[c1])))
+                   in raise SyntaxError(c1,a2,q1)       
+                   end
       end
 
    (*--------------------------------------------------------------------*)
@@ -9782,31 +9782,31 @@
    (*--------------------------------------------------------------------*)
    fun parseStandaloneDecl caq0 =
       let 
-	 val (quote,a,q) = skipEq caq0
+         val (quote,a,q) = skipEq caq0
 
-	 fun doit text (c,a,q) = 
-	    if c=quote then (text,getChar (a,q))
-	    else if c<>0wx0 then doit (c::text) (getChar (a,q))
-		 else let val a1 = hookError(a,(getPos q,ERR_ENDED_BY_EE LOC_LITERAL))
-		      in (text,(c,a1,q)) 
-		      end
+         fun doit text (c,a,q) = 
+            if c=quote then (text,getChar (a,q))
+            else if c<>0wx0 then doit (c::text) (getChar (a,q))
+                 else let val a1 = hookError(a,(getPos q,ERR_ENDED_BY_EE LOC_LITERAL))
+                      in (text,(c,a1,q)) 
+                      end
 
-	 val caq1 as (_,_,q1) = 
-	    case quote
-	      of 0wx22 (* '""' *) => (getChar (a,q))
-	       | 0wx27 (* "'" *)  => (getChar (a,q))
-	       | _ => let val a1 = hookError(a,(getPos q,ERR_EXPECTED(expLitQuote,[quote])))
-		      in raise SyntaxError(quote,a1,q)	
-		      end
-	 val (text,caq2) = doit nil caq1
+         val caq1 as (_,_,q1) = 
+            case quote
+              of 0wx22 (* '""' *) => (getChar (a,q))
+               | 0wx27 (* "'" *)  => (getChar (a,q))
+               | _ => let val a1 = hookError(a,(getPos q,ERR_EXPECTED(expLitQuote,[quote])))
+                      in raise SyntaxError(quote,a1,q)  
+                      end
+         val (text,caq2) = doit nil caq1
       in 
-	 case text
-	   of [0wx73,0wx65,0wx79] (* reversed "yes" *) => (SOME true,caq2)
-	    | [0wx6f,0wx6e]       (* reversed "no"  *) => (SOME false,caq2)
-	    | revd => let val (c2,a2,q2) = caq2 
-			  val a3 = hookError(a2,(getPos q1,ERR_EXPECTED(expNoYes,revd)))
-		      in (NONE,(c2,a3,q2))
-		      end   
+         case text
+           of [0wx73,0wx65,0wx79] (* reversed "yes" *) => (SOME true,caq2)
+            | [0wx6f,0wx6e]       (* reversed "no"  *) => (SOME false,caq2)
+            | revd => let val (c2,a2,q2) = caq2 
+                          val a3 = hookError(a2,(getPos q1,ERR_EXPECTED(expNoYes,revd)))
+                      in (NONE,(c2,a3,q2))
+                      end   
       end
 
    (*--------------------------------------------------------------------*)
@@ -9841,146 +9841,146 @@
    (*--------------------------------------------------------------------*)
    fun parseXmlDecl auto caq =
       let 
-	 (*-----------------------------------------------------------------*)
-	 (* skip the '?>' at the end of the xml declaration.                *)
-	 (*                                                                 *) 
-	 (* print an error and raise SyntaxState if no '?>' is found.       *) 
-	 (*                                                                 *) 
-	 (* return the info passed as first arg, and the next char & state. *)
-	 (*-----------------------------------------------------------------*)
-	 (* might raise: SyntaxState                                        *) 
-	 (*-----------------------------------------------------------------*)
-	 fun skipXmlDeclEnd enc res (c,a,q) = 
-	    if c=0wx3F (* "#?" *) 
-	       then let val (c1,a1,q1) = getChar (a,q)
-		    in if c1=0wx3E (* #">" *) then (enc,SOME res,getChar (a1,q1))
-		       else let val a2 = hookError(a1,(getPos q1,ERR_EXPECTED(expGt,[c1]))) 
-			    in raise SyntaxError (c1,a2,q1)
-			    end
-		    end
-	    else let val a1 = hookError(a,(getPos q,ERR_EXPECTED(expProcEnd,[c]))) 
-		 in raise SyntaxError (c,a1,q)
-		 end
-	 (*-----------------------------------------------------------------*)
-	 (* parse the remainder after the keyword 'standalone', the version *)
-	 (* and encoding already parsed and given in the first arg.         *) 
-	 (*                                                                 *) 
-	 (* pass the version,encoding and sd status to skipXmlDeclEnd       *)
-	 (*-----------------------------------------------------------------*)
-	 (* might raise: SyntaxState                                        *) 
-	 (*-----------------------------------------------------------------*)
-	 fun parseXmlDeclAfterS enc (v,e) caq = 
-	    let 
-	       val (alone,caq1) = parseStandaloneDecl caq
-	       val caq2 = skipSopt caq1
-	    in skipXmlDeclEnd enc (v,e,alone) caq2
-	    end
-	 (*-----------------------------------------------------------------*)
-	 (* parse the remainder after the encoding declaration, the version *)
-	 (* and encoding already parsed and given in the first arg.         *) 
-	 (*                                                                 *) 
-	 (* print an error if a name other than 'standalone' is found.      *) 
-	 (*                                                                 *) 
-	 (* pass the version and encoding to parseXmlDeclAfterS.            *)
-	 (*-----------------------------------------------------------------*)
-	 (* might raise: SyntaxState                                        *) 
-	 (*-----------------------------------------------------------------*)
-	 fun parseXmlDeclBeforeS enc (v,e) caq = 
-	    let
-	       val (hadS,caq1 as (_,_,q1)) = skipSmay caq
-	       val (name,(c2,a2,q2)) = parseName caq1 (* NotFound handled below *)
-	       val a3 = if hadS then a2 
-			else hookError(a2,(getPos q1,ERR_MISSING_WHITE))
-	    in case name 
-		 of [0wx73,0wx74,0wx61,0wx6e,0wx64,0wx61,0wx6c,0wx6f,0wx6e,0wx65] => 
-		  (* "standalone" *) parseXmlDeclAfterS enc (v,e) (c2,a3,q2)
-		  | _ => let val a4 = hookError(a3,(getPos q1,ERR_EXPECTED(expStandOpt,name)))
-			 in parseXmlDeclAfterS enc (v,e) (c2,a4,q2)
-			 end
-	    end
-	 handle NotFound caq => (* exception raised by parseName *) 
-	    skipXmlDeclEnd enc (v,e,NONE) caq 
-	 (*-----------------------------------------------------------------*)
-	 (* parse the remainder after the keyword 'encoding', the version   *)
-	 (* already parsed and given in the first arg.                      *) 
-	 (*                                                                 *) 
-	 (* pass the version and encoding and to parseXmlDeclBeforeS        *)
-	 (*-----------------------------------------------------------------*)
-	 (* might raise: SyntaxState                                        *) 
-	 (*-----------------------------------------------------------------*)
-	 fun parseXmlDeclAfterE ver caq = 
-	    let 
-	       val (enc,(c1,a1,q1)) = parseEncodingDecl caq
-	       val (a2,q2,enc1) = changeAuto(a1,q1,enc)
-	    in 
-	       parseXmlDeclBeforeS enc1 (ver,SOME enc) (c1,a2,q2)
-	    end
-	 (*-----------------------------------------------------------------*)
-	 (* parse the remainder after the version info, the version already *)
-	 (* parsed and given in the first arg.                              *) 
-	 (*                                                                 *) 
-	 (* print an error if a name other than 'encoding' or 'standalone'  *)
-	 (* is found.                                                       *) 
-	 (*                                                                 *) 
-	 (* pass obtained/default values to parseXmlDeclAfter[E|S] or to    *)
-	 (* skipXmlDeclEnd.                                                 *)
-	 (*-----------------------------------------------------------------*)
-	 (* might raise: SyntaxState                                        *) 
-	 (*-----------------------------------------------------------------*)
-	 fun parseXmlDeclBeforeE ver caq = 
-	    let
-	       val (hadS,caq1 as (_,_,q1)) = skipSmay caq
-	       val (name,(c2,a2,q2)) = parseName caq1 (* NotFound handled below *)
-	       val a3 = if hadS then a2 
-			else hookError(a2,(getPos q1,ERR_MISSING_WHITE))
-	    in 
-	       case name 
-		 of [0wx65,0wx6e,0wx63,0wx6f,0wx64,0wx69,0wx6e,0wx67] => 
-		  (* "encoding" *) parseXmlDeclAfterE ver (c2,a3,q2)
-		  | [0wx73,0wx74,0wx61,0wx6e,0wx64,0wx61,0wx6c,0wx6f,0wx6e,0wx65] => 
-		  (* "standalone" *) parseXmlDeclAfterS auto (ver,NONE) (c2,a3,q2)
-		  | _ => let val a4 = hookError(a3,(getPos q1,ERR_EXPECTED(expEncStand,name)))
-			 in parseXmlDeclAfterE ver (c2,a4,q2)
-			 end
-	    end
-	 handle NotFound caq => (* exception raised by parseName *) 
-	    skipXmlDeclEnd auto (ver,NONE,NONE) caq 
+         (*-----------------------------------------------------------------*)
+         (* skip the '?>' at the end of the xml declaration.                *)
+         (*                                                                 *) 
+         (* print an error and raise SyntaxState if no '?>' is found.       *) 
+         (*                                                                 *) 
+         (* return the info passed as first arg, and the next char & state. *)
+         (*-----------------------------------------------------------------*)
+         (* might raise: SyntaxState                                        *) 
+         (*-----------------------------------------------------------------*)
+         fun skipXmlDeclEnd enc res (c,a,q) = 
+            if c=0wx3F (* "#?" *) 
+               then let val (c1,a1,q1) = getChar (a,q)
+                    in if c1=0wx3E (* #">" *) then (enc,SOME res,getChar (a1,q1))
+                       else let val a2 = hookError(a1,(getPos q1,ERR_EXPECTED(expGt,[c1]))) 
+                            in raise SyntaxError (c1,a2,q1)
+                            end
+                    end
+            else let val a1 = hookError(a,(getPos q,ERR_EXPECTED(expProcEnd,[c]))) 
+                 in raise SyntaxError (c,a1,q)
+                 end
+         (*-----------------------------------------------------------------*)
+         (* parse the remainder after the keyword 'standalone', the version *)
+         (* and encoding already parsed and given in the first arg.         *) 
+         (*                                                                 *) 
+         (* pass the version,encoding and sd status to skipXmlDeclEnd       *)
+         (*-----------------------------------------------------------------*)
+         (* might raise: SyntaxState                                        *) 
+         (*-----------------------------------------------------------------*)
+         fun parseXmlDeclAfterS enc (v,e) caq = 
+            let 
+               val (alone,caq1) = parseStandaloneDecl caq
+               val caq2 = skipSopt caq1
+            in skipXmlDeclEnd enc (v,e,alone) caq2
+            end
+         (*-----------------------------------------------------------------*)
+         (* parse the remainder after the encoding declaration, the version *)
+         (* and encoding already parsed and given in the first arg.         *) 
+         (*                                                                 *) 
+         (* print an error if a name other than 'standalone' is found.      *) 
+         (*                                                                 *) 
+         (* pass the version and encoding to parseXmlDeclAfterS.            *)
+         (*-----------------------------------------------------------------*)
+         (* might raise: SyntaxState                                        *) 
+         (*-----------------------------------------------------------------*)
+         fun parseXmlDeclBeforeS enc (v,e) caq = 
+            let
+               val (hadS,caq1 as (_,_,q1)) = skipSmay caq
+               val (name,(c2,a2,q2)) = parseName caq1 (* NotFound handled below *)
+               val a3 = if hadS then a2 
+                        else hookError(a2,(getPos q1,ERR_MISSING_WHITE))
+            in case name 
+                 of [0wx73,0wx74,0wx61,0wx6e,0wx64,0wx61,0wx6c,0wx6f,0wx6e,0wx65] => 
+                  (* "standalone" *) parseXmlDeclAfterS enc (v,e) (c2,a3,q2)
+                  | _ => let val a4 = hookError(a3,(getPos q1,ERR_EXPECTED(expStandOpt,name)))
+                         in parseXmlDeclAfterS enc (v,e) (c2,a4,q2)
+                         end
+            end
+         handle NotFound caq => (* exception raised by parseName *) 
+            skipXmlDeclEnd enc (v,e,NONE) caq 
+         (*-----------------------------------------------------------------*)
+         (* parse the remainder after the keyword 'encoding', the version   *)
+         (* already parsed and given in the first arg.                      *) 
+         (*                                                                 *) 
+         (* pass the version and encoding and to parseXmlDeclBeforeS        *)
+         (*-----------------------------------------------------------------*)
+         (* might raise: SyntaxState                                        *) 
+         (*-----------------------------------------------------------------*)
+         fun parseXmlDeclAfterE ver caq = 
+            let 
+               val (enc,(c1,a1,q1)) = parseEncodingDecl caq
+               val (a2,q2,enc1) = changeAuto(a1,q1,enc)
+            in 
+               parseXmlDeclBeforeS enc1 (ver,SOME enc) (c1,a2,q2)
+            end
+         (*-----------------------------------------------------------------*)
+         (* parse the remainder after the version info, the version already *)
+         (* parsed and given in the first arg.                              *) 
+         (*                                                                 *) 
+         (* print an error if a name other than 'encoding' or 'standalone'  *)
+         (* is found.                                                       *) 
+         (*                                                                 *) 
+         (* pass obtained/default values to parseXmlDeclAfter[E|S] or to    *)
+         (* skipXmlDeclEnd.                                                 *)
+         (*-----------------------------------------------------------------*)
+         (* might raise: SyntaxState                                        *) 
+         (*-----------------------------------------------------------------*)
+         fun parseXmlDeclBeforeE ver caq = 
+            let
+               val (hadS,caq1 as (_,_,q1)) = skipSmay caq
+               val (name,(c2,a2,q2)) = parseName caq1 (* NotFound handled below *)
+               val a3 = if hadS then a2 
+                        else hookError(a2,(getPos q1,ERR_MISSING_WHITE))
+            in 
+               case name 
+                 of [0wx65,0wx6e,0wx63,0wx6f,0wx64,0wx69,0wx6e,0wx67] => 
+                  (* "encoding" *) parseXmlDeclAfterE ver (c2,a3,q2)
+                  | [0wx73,0wx74,0wx61,0wx6e,0wx64,0wx61,0wx6c,0wx6f,0wx6e,0wx65] => 
+                  (* "standalone" *) parseXmlDeclAfterS auto (ver,NONE) (c2,a3,q2)
+                  | _ => let val a4 = hookError(a3,(getPos q1,ERR_EXPECTED(expEncStand,name)))
+                         in parseXmlDeclAfterE ver (c2,a4,q2)
+                         end
+            end
+         handle NotFound caq => (* exception raised by parseName *) 
+            skipXmlDeclEnd auto (ver,NONE,NONE) caq 
 
-	 (*-----------------------------------------------------------------*)
-	 (* do the main work. if the first name is not 'version' then it    *)
-	 (* might be 'encoding' or 'standalone'. Then take the default      *) 
-	 (* NONE for version and - if needed - encoding and call the        *)
-	 (* appropriate function. otherwise assume a typo and parse the     *)
-	 (* version number, then call parseXmlDeclBeforeE. if no name is    *) 
-	 (* found at all, proceed with skipXmlDeclEnd.                      *)
-	 (*                                                                 *)
-	 (* print an error and raise SyntaxState if an entity end is found. *)
-	 (* print an error and raise SyntaxState if appropriate.            *)
-	 (* print an error if a name other than 'version' is found.         *)
-	 (*-----------------------------------------------------------------*)
-	 (* might raise: SyntaxState                                        *) 
-	 (*-----------------------------------------------------------------*)
-	 val caq1 as (_,_,q1) = skipSopt caq 
-	 val (name,(caq2 as (c2,a2,q2))) = parseName caq1 
-	    handle NotFound (c,a,q) => let val err = ERR_EXPECTED(expVersion,[c])
-					   val a1 = hookError(a,(getPos q,err))
-				       in raise SyntaxError (c,a1,q)
-				       end
+         (*-----------------------------------------------------------------*)
+         (* do the main work. if the first name is not 'version' then it    *)
+         (* might be 'encoding' or 'standalone'. Then take the default      *) 
+         (* NONE for version and - if needed - encoding and call the        *)
+         (* appropriate function. otherwise assume a typo and parse the     *)
+         (* version number, then call parseXmlDeclBeforeE. if no name is    *) 
+         (* found at all, proceed with skipXmlDeclEnd.                      *)
+         (*                                                                 *)
+         (* print an error and raise SyntaxState if an entity end is found. *)
+         (* print an error and raise SyntaxState if appropriate.            *)
+         (* print an error if a name other than 'version' is found.         *)
+         (*-----------------------------------------------------------------*)
+         (* might raise: SyntaxState                                        *) 
+         (*-----------------------------------------------------------------*)
+         val caq1 as (_,_,q1) = skipSopt caq 
+         val (name,(caq2 as (c2,a2,q2))) = parseName caq1 
+            handle NotFound (c,a,q) => let val err = ERR_EXPECTED(expVersion,[c])
+                                           val a1 = hookError(a,(getPos q,err))
+                                       in raise SyntaxError (c,a1,q)
+                                       end
       in 
-	 if name=[0wx76,0wx65,0wx72,0wx73,0wx69,0wx6f,0wx6e] (* "version" *)
-	    then let val (ver,caq3) = parseVersionInfo caq2 
-		 in parseXmlDeclBeforeE ver caq3
-		 end
-	 else let val a3 = hookError(a2,(getPos q1,ERR_EXPECTED(expVersion,name)))
-	      in case name
-		   of [0wx65,0wx6e,0wx63,0wx6f,0wx64,0wx69,0wx6e,0wx67] => 
-		    (* "encoding" *) parseXmlDeclAfterE NONE (c2,a3,q2)
-		    | [0wx73,0wx74,0wx61,0wx6e,0wx64,0wx61,0wx6c,0wx6f,0wx6e,0wx65] => 
-		    (* "standalone" *) parseXmlDeclAfterS auto (NONE,NONE) (c2,a3,q2)
-		    | _ => let val (ver,caq3) = parseVersionInfo (c2,a3,q2) 
-			   in parseXmlDeclBeforeE ver caq3
-			   end
-	      end
+         if name=[0wx76,0wx65,0wx72,0wx73,0wx69,0wx6f,0wx6e] (* "version" *)
+            then let val (ver,caq3) = parseVersionInfo caq2 
+                 in parseXmlDeclBeforeE ver caq3
+                 end
+         else let val a3 = hookError(a2,(getPos q1,ERR_EXPECTED(expVersion,name)))
+              in case name
+                   of [0wx65,0wx6e,0wx63,0wx6f,0wx64,0wx69,0wx6e,0wx67] => 
+                    (* "encoding" *) parseXmlDeclAfterE NONE (c2,a3,q2)
+                    | [0wx73,0wx74,0wx61,0wx6e,0wx64,0wx61,0wx6c,0wx6f,0wx6e,0wx65] => 
+                    (* "standalone" *) parseXmlDeclAfterS auto (NONE,NONE) (c2,a3,q2)
+                    | _ => let val (ver,caq3) = parseVersionInfo (c2,a3,q2) 
+                           in parseXmlDeclBeforeE ver caq3
+                           end
+              end
       end
       (*----------------------------------------------------------------*)
       (* catch entity end exceptions raised by subfunctions, print an   *)
@@ -9988,8 +9988,8 @@
       (*----------------------------------------------------------------*)
    handle SyntaxError(c,a,q) => 
       let val err = if c=0wx0 then ERR_ENDED_BY_EE LOC_XML_DECL
-		    else ERR_CANT_PARSE LOC_XML_DECL
-	  val a1 = hookError(a,(getPos q,err))
+                    else ERR_CANT_PARSE LOC_XML_DECL
+          val a1 = hookError(a,(getPos q,err))
       in (auto,NONE,recoverXml(c,a1,q))
       end
 
@@ -10021,98 +10021,98 @@
    (*--------------------------------------------------------------------*)
    fun parseTextDecl auto caq =
       let 
-	 (*-----------------------------------------------------------------*)
-	 (* skip the '?>' at the end of the text declaration.               *)
-	 (*                                                                 *) 
-	 (* print an error and raise SyntaxState if no '?>' is found.       *) 
-	 (*                                                                 *) 
-	 (* return the info passed as first arg, and the next char & state. *)
-	 (*-----------------------------------------------------------------*)
-	 (* might raise: SyntaxState                                        *) 
-	 (*-----------------------------------------------------------------*)
-	 fun skipTextDeclEnd enc res (c,a,q) = 
-	    if c=0wx3F (* "#?" *) 
-	       then let val (c1,a1,q1) = getChar (a,q)
-		    in if c1=0wx3E (* #">" *) then (enc,SOME res,getChar (a1,q1))
-		       else let val a2 = hookError(a1,(getPos q1,ERR_EXPECTED(expGt,[c1])))
-			    in raise SyntaxError(c1,a2,q1)
-			    end
-		    end
-	    else let val a1 = hookError(a,(getPos q,ERR_EXPECTED(expProcEnd,[c])))
-		 in raise SyntaxError(c,a1,q)
-		 end
-	 (*-----------------------------------------------------------------*)
-	 (* parse the remainder after the keyword 'encoding', the version   *)
-	 (* already parsed and given in the first arg.                      *) 
-	 (*                                                                 *) 
-	 (* pass the version and encoding and to skipTextDeclEnd.           *)
-	 (*-----------------------------------------------------------------*)
-	 (* might raise: SyntaxState                                        *) 
-	 (*-----------------------------------------------------------------*)
-	 fun parseTextDeclAfterE ver caq = 
-	    let 
-	       val (enc,(c1,a1,q1)) = parseEncodingDecl caq
-	       val (a2,q2,enc1) = changeAuto(a1,q1,enc)
-	       val caq3 = skipSopt (c1,a2,q2)
-	    in skipTextDeclEnd enc1 (ver,SOME enc) caq3
-	    end
-	 (*-----------------------------------------------------------------*)
-	 (* parse the remainder after the version info, the version given   *)
-	 (* as first argument.                                              *) 
-	 (*                                                                 *) 
-	 (* print an error and raise SyntaxState is no name is found.       *) 
-	 (* print an error if a name other than 'encoding' is found.        *) 
-	 (*                                                                 *) 
-	 (* pass obtained/default values to parseTextDeclAfterE.            *)
-	 (*-----------------------------------------------------------------*)
-	 (* might raise: SyntaxState                                        *) 
-	 (*-----------------------------------------------------------------*)
-	 fun parseTextDeclBeforeE ver caq = 
-	    let
-	       val caq1 as (_,_,q1) = skipS caq 
-	       val (name,caq2) = parseName caq1
-		  handle NotFound (c,a,q) => let val err = ERR_EXPECTED(expEncoding,[c])
-						 val a1 = hookError(a,(getPos q,err))
-					     in raise SyntaxError (c,a1,q)
-					     end
-	    in 
-	       if name=[0wx65,0wx6e,0wx63,0wx6f,0wx64,0wx69,0wx6e,0wx67] (* "encoding" *) 
-		  then parseTextDeclAfterE ver caq2
-	       else let val (c2,a2,q2) = caq2
-			val a3 = hookError(a2,(getPos q1,ERR_EXPECTED(expEncoding,name)))
-		    in parseTextDeclAfterE ver (c2,a3,q2)
-		    end
-	    end
-	 (*-----------------------------------------------------------------*)
-	 (* do the main work. if the first name is neither 'version' nor    *)
-	 (* 'encoding' then assume typo of 'version'. Then parse the        *)
-	 (* version number, call parseTextDeclBeforeE. if no name is found  *) 
-	 (* at all, proceed with skipTextDeclEnd.                           *)
-	 (*                                                                 *)
-	 (* print an error and raise SyntaxState if appropriate.            *)
-	 (* print an error if a name other than 'version' or 'encoding' is  *)
-	 (* found.                                                          *)
-	 (*-----------------------------------------------------------------*)
-	 (* might raise: SyntaxState                                        *) 
-	 (*-----------------------------------------------------------------*)
-	 val caq1 as (_,_,q1) = skipSopt caq 
-	 val (name,caq2) = parseName caq1 
-	    handle NotFound (c,a,q) => let val err = ERR_EXPECTED(expEncVers,[c])
-					   val a1 = hookError(a,(getPos q,err))
-				       in raise SyntaxError(c,a1,q)
-				       end
+         (*-----------------------------------------------------------------*)
+         (* skip the '?>' at the end of the text declaration.               *)
+         (*                                                                 *) 
+         (* print an error and raise SyntaxState if no '?>' is found.       *) 
+         (*                                                                 *) 
+         (* return the info passed as first arg, and the next char & state. *)
+         (*-----------------------------------------------------------------*)
+         (* might raise: SyntaxState                                        *) 
+         (*-----------------------------------------------------------------*)
+         fun skipTextDeclEnd enc res (c,a,q) = 
+            if c=0wx3F (* "#?" *) 
+               then let val (c1,a1,q1) = getChar (a,q)
+                    in if c1=0wx3E (* #">" *) then (enc,SOME res,getChar (a1,q1))
+                       else let val a2 = hookError(a1,(getPos q1,ERR_EXPECTED(expGt,[c1])))
+                            in raise SyntaxError(c1,a2,q1)
+                            end
+                    end
+            else let val a1 = hookError(a,(getPos q,ERR_EXPECTED(expProcEnd,[c])))
+                 in raise SyntaxError(c,a1,q)
+                 end
+         (*-----------------------------------------------------------------*)
+         (* parse the remainder after the keyword 'encoding', the version   *)
+         (* already parsed and given in the first arg.                      *) 
+         (*                                                                 *) 
+         (* pass the version and encoding and to skipTextDeclEnd.           *)
+         (*-----------------------------------------------------------------*)
+         (* might raise: SyntaxState                                        *) 
+         (*-----------------------------------------------------------------*)
+         fun parseTextDeclAfterE ver caq = 
+            let 
+               val (enc,(c1,a1,q1)) = parseEncodingDecl caq
+               val (a2,q2,enc1) = changeAuto(a1,q1,enc)
+               val caq3 = skipSopt (c1,a2,q2)
+            in skipTextDeclEnd enc1 (ver,SOME enc) caq3
+            end
+         (*-----------------------------------------------------------------*)
+         (* parse the remainder after the version info, the version given   *)
+         (* as first argument.                                              *) 
+         (*                                                                 *) 
+         (* print an error and raise SyntaxState is no name is found.       *) 
+         (* print an error if a name other than 'encoding' is found.        *) 
+         (*                                                                 *) 
+         (* pass obtained/default values to parseTextDeclAfterE.            *)
+         (*-----------------------------------------------------------------*)
+         (* might raise: SyntaxState                                        *) 
+         (*-----------------------------------------------------------------*)
+         fun parseTextDeclBeforeE ver caq = 
+            let
+               val caq1 as (_,_,q1) = skipS caq 
+               val (name,caq2) = parseName caq1
+                  handle NotFound (c,a,q) => let val err = ERR_EXPECTED(expEncoding,[c])
+                                                 val a1 = hookError(a,(getPos q,err))
+                                             in raise SyntaxError (c,a1,q)
+                                             end
+            in 
+               if name=[0wx65,0wx6e,0wx63,0wx6f,0wx64,0wx69,0wx6e,0wx67] (* "encoding" *) 
+                  then parseTextDeclAfterE ver caq2
+               else let val (c2,a2,q2) = caq2
+                        val a3 = hookError(a2,(getPos q1,ERR_EXPECTED(expEncoding,name)))
+                    in parseTextDeclAfterE ver (c2,a3,q2)
+                    end
+            end
+         (*-----------------------------------------------------------------*)
+         (* do the main work. if the first name is neither 'version' nor    *)
+         (* 'encoding' then assume typo of 'version'. Then parse the        *)
+         (* version number, call parseTextDeclBeforeE. if no name is found  *) 
+         (* at all, proceed with skipTextDeclEnd.                           *)
+         (*                                                                 *)
+         (* print an error and raise SyntaxState if appropriate.            *)
+         (* print an error if a name other than 'version' or 'encoding' is  *)
+         (* found.                                                          *)
+         (*-----------------------------------------------------------------*)
+         (* might raise: SyntaxState                                        *) 
+         (*-----------------------------------------------------------------*)
+         val caq1 as (_,_,q1) = skipSopt caq 
+         val (name,caq2) = parseName caq1 
+            handle NotFound (c,a,q) => let val err = ERR_EXPECTED(expEncVers,[c])
+                                           val a1 = hookError(a,(getPos q,err))
+                                       in raise SyntaxError(c,a1,q)
+                                       end
       in case name 
-	   of [0wx76,0wx65,0wx72,0wx73,0wx69,0wx6f,0wx6e] => (* "version" *)
-	      let val (ver,caq3) = parseVersionInfo caq2 
-	      in parseTextDeclBeforeE ver caq3
-	      end
-	    | [0wx65,0wx6e,0wx63,0wx6f,0wx64,0wx69,0wx6e,0wx67] => (* "encoding" *)
-	      parseTextDeclAfterE NONE caq2
-	    | _ => let val (c2,a2,q2) = caq2
-		       val a3 = hookError(a2,(getPos q1,ERR_EXPECTED(expEncVers,name)))
-		       val (ver,caq3) = parseVersionInfo (c2,a3,q2) 
-		   in parseTextDeclBeforeE ver caq3
-		   end
+           of [0wx76,0wx65,0wx72,0wx73,0wx69,0wx6f,0wx6e] => (* "version" *)
+              let val (ver,caq3) = parseVersionInfo caq2 
+              in parseTextDeclBeforeE ver caq3
+              end
+            | [0wx65,0wx6e,0wx63,0wx6f,0wx64,0wx69,0wx6e,0wx67] => (* "encoding" *)
+              parseTextDeclAfterE NONE caq2
+            | _ => let val (c2,a2,q2) = caq2
+                       val a3 = hookError(a2,(getPos q1,ERR_EXPECTED(expEncVers,name)))
+                       val (ver,caq3) = parseVersionInfo (c2,a3,q2) 
+                   in parseTextDeclBeforeE ver caq3
+                   end
       end
       (*----------------------------------------------------------------*)
       (* catch entity end exceptions raised by subfunctions, print an   *)
@@ -10120,11 +10120,11 @@
       (*----------------------------------------------------------------*)
    handle SyntaxError(c,a,q) => 
       let val err = if c=0wx0 then ERR_ENDED_BY_EE LOC_TEXT_DECL
-		    else ERR_CANT_PARSE LOC_TEXT_DECL
-	  val a1 = hookError(a,(getPos q,err))
+                    else ERR_CANT_PARSE LOC_TEXT_DECL
+          val a1 = hookError(a,(getPos q,err))
       in (auto,NONE,recoverXml(c,a1,q))
       end
-	 
+         
    (*--------------------------------------------------------------------*)
    (* check for the string "<?xml" followed by a white space. The first  *)
    (* paramter seen is a prefix of that string already consued. If the   *)
@@ -10138,15 +10138,15 @@
    (*--------------------------------------------------------------------*)
    fun checkForXml aq =
       let 
-	 val unseen = [0wx3c,0wx3f,0wx78,0wx6d,0wx6c]
-	 fun doit (seen,unseen) (a,q) = 
-	    let val (c1,a1,q1) = getChar (a,q)
-	    in case unseen 
-		 of nil => if isS c1 then (true,(a1,q1))
-			   else (false,(a1,ungetChars(q1,rev(c1::seen))))
-		  | c::cs => if c1=c then doit (c1::seen,cs) (a1,q1)
-			     else (false,(a1,ungetChars(q1,rev(c1::seen))))
-	    end
+         val unseen = [0wx3c,0wx3f,0wx78,0wx6d,0wx6c]
+         fun doit (seen,unseen) (a,q) = 
+            let val (c1,a1,q1) = getChar (a,q)
+            in case unseen 
+                 of nil => if isS c1 then (true,(a1,q1))
+                           else (false,(a1,ungetChars(q1,rev(c1::seen))))
+                  | c::cs => if c1=c then doit (c1::seen,cs) (a1,q1)
+                             else (false,(a1,ungetChars(q1,rev(c1::seen))))
+            end
       in doit (nil,unseen) aq
       end
 
@@ -10168,11 +10168,11 @@
    fun findTextDecl (parseDecl,warn) auto aq =
       let val (hasXml,aq1) = checkForXml aq
       in if hasXml then parseDecl auto (getChar aq1)
-	 else let val (a1,q1) = aq1
-		  val (a2,q2) = commitAuto(a1,q1)
-		  val a3 = if warn then hookWarning(a2,(getPos q2,WARN_NO_XML_DECL)) else a2
-	      in (auto,NONE,getChar(a3,q2))
-	      end
+         else let val (a1,q1) = aq1
+                  val (a2,q2) = commitAuto(a1,q1)
+                  val a3 = if warn then hookWarning(a2,(getPos q2,WARN_NO_XML_DECL)) else a2
+              in (auto,NONE,getChar(a3,q2))
+              end
       end
 
    (*--------------------------------------------------------------------*)
@@ -10237,7 +10237,7 @@
       include ParseBase
 
       val parseName    : UniChar.Char * AppData * State 
-	 -> UniChar.Data * (UniChar.Char * AppData * State)
+         -> UniChar.Data * (UniChar.Char * AppData * State)
       val parseNmtoken : UniChar.Char * AppData * State 
          -> UniChar.Data * (UniChar.Char * AppData * State)
       val parseEntName : UniChar.Data * UniChar.Data -> UniChar.Char * AppData * State 
@@ -10249,45 +10249,45 @@
       val skipSopt : UniChar.Char * AppData * State -> UniChar.Char * AppData * State
       val skipSmay : UniChar.Char * AppData * State -> bool * (UniChar.Char * AppData * State)
       val parseSopt : UniChar.Data -> UniChar.Char * AppData * State 
-	 -> UniChar.Data * (UniChar.Char * AppData * State)
+         -> UniChar.Data * (UniChar.Char * AppData * State)
       val parseSmay : UniChar.Data -> UniChar.Char * AppData * State 
-	 -> bool * (UniChar.Data * (UniChar.Char * AppData * State))
+         -> bool * (UniChar.Data * (UniChar.Char * AppData * State))
       val parseEq : UniChar.Char * AppData * State 
-	 -> UniChar.Data * (UniChar.Char * AppData * State)
+         -> UniChar.Data * (UniChar.Char * AppData * State)
 
       val openExtern   : int * Uri.Uri -> AppData * State 
-	 -> Encoding.Encoding * HookData.TextDecl option * (UniChar.Char * AppData * State)
+         -> Encoding.Encoding * HookData.TextDecl option * (UniChar.Char * AppData * State)
       val openDocument : Uri.Uri option -> AppData 
-	 -> Encoding.Encoding * HookData.XmlDecl option * (UniChar.Char * AppData * State)
+         -> Encoding.Encoding * HookData.XmlDecl option * (UniChar.Char * AppData * State)
       val openSubset   : Uri.Uri -> AppData 
-	 -> Encoding.Encoding * HookData.TextDecl option * (UniChar.Char * AppData * State)
+         -> Encoding.Encoding * HookData.TextDecl option * (UniChar.Char * AppData * State)
       ----------------------------------------------------------------------*)
       include ParseXml
 
       val parseCharRef : AppData * State -> UniChar.Char *  AppData * State
       val parseGenRef  : Dtd -> UniChar.Char * AppData * State 
-	 -> (int * Base.GenEntity) * (AppData * State)
+         -> (int * Base.GenEntity) * (AppData * State)
       val parseParRef  : Dtd -> UniChar.Char * AppData * State 
-	 -> (int * Base.ParEntity) * (AppData * State)
+         -> (int * Base.ParEntity) * (AppData * State)
 
       val parseCharRefLit : UniChar.Data -> AppData * State 
-	 -> UniChar.Data * (UniChar.Char * AppData * State)
+         -> UniChar.Data * (UniChar.Char * AppData * State)
       val parseGenRefLit  : Dtd -> UniChar.Data -> UniChar.Char *  AppData * State 
-	 -> UniChar.Data * ((int * Base.GenEntity) *  (AppData * State))
+         -> UniChar.Data * ((int * Base.GenEntity) *  (AppData * State))
       val parseParRefLit  : Dtd -> UniChar.Data -> UniChar.Char *  AppData * State 
-	 -> UniChar.Data * ((int * Base.ParEntity) *  (AppData * State))
+         -> UniChar.Data * ((int * Base.ParEntity) *  (AppData * State))
 
       val skipCharRef   : AppData * State -> (UniChar.Char *  AppData * State)
       val skipReference : UniChar.Char * AppData * State -> (UniChar.Char *  AppData * State)
 
       val skipPS    : Dtd -> UniChar.Char * AppData * State 
-	 -> UniChar.Char * AppData * State
+         -> UniChar.Char * AppData * State
       val skipPSopt : Dtd -> UniChar.Char * AppData * State 
-	 -> UniChar.Char * AppData * State
+         -> UniChar.Char * AppData * State
       val skipPSmay : Dtd -> UniChar.Char * AppData * State 
-	 -> bool * (UniChar.Char * AppData * State)
+         -> bool * (UniChar.Char * AppData * State)
       val skipPSdec : Dtd -> UniChar.Char * AppData * State 
-	 -> bool * (UniChar.Char * AppData * State)
+         -> bool * (UniChar.Char * AppData * State)
     end
 
 (*--------------------------------------------------------------------------*)
@@ -10337,120 +10337,120 @@
    (*--------------------------------------------------------------------*)
    fun parseCharRef aq =
       let 
-	 (*--------------------------------------------------------------*)
-	 (* parse a (hexa)decimal number, accumulating the value in the  *)
-	 (* first parameter.                                             *)
-	 (*                                                              *)
-	 (* return the numbers value as a Char.                          *)
-	 (*--------------------------------------------------------------*)
-	 fun do_hex_n yet (c,a,q) = 
-	    case hexValue c
-	      of NONE => (yet,(c,a,q))
-	       | SOME v => do_hex_n (0wx10*yet+v) (getChar (a,q))
-	 fun do_dec_n yet (c,a,q) = 
-	    case decValue c
-	      of NONE => (yet,(c,a,q))
-	       | SOME v => do_dec_n (0wx0A*yet+v) (getChar (a,q))
-	 (*--------------------------------------------------------------*)
-	 (* Parse a (hexa)decimal number of at least one digit.          *)
-	 (*                                                              *)
-	 (* raise SyntaxError if no hexdigit is found first.             *)
-	 (*                                                              *)
-	 (* return the numbers value as a Char.                          *)
-	 (*--------------------------------------------------------------*)
-	 fun do_hex_1 (c,a,q) =
-	    case hexValue c 
-	      of SOME v => do_hex_n v (getChar (a,q))
-	       | NONE => let val a1 = hookError(a,(getPos q,ERR_EXPECTED(expHexDigit,[c])))
-			 in raise SyntaxError(c,a1,q)
-			 end
-	 (*--------------------------------------------------------------*)
-	 (* Parse a decimal number of at least one digit, or a hexnumber *)
-	 (* if the first character is 'x'.                               *)
-	 (*                                                              *)
-	 (* raise SyntaxError if neither 'x' nor digit is found first.   *)
-	 (*                                                              *)
-	 (* return the number's value as a Char.                         *)
-	 (*--------------------------------------------------------------*)
-	 fun do_dec_1 (c,a,q) =
-	    case decValue c 
-	      of SOME v => do_dec_n v (getChar (a,q))
-	       | NONE => if c=0wx78 (* #"x" *) 
-			    then do_hex_1 (getChar (a,q))
-			 else let val a1 = hookError(a,(getPos q,ERR_EXPECTED(expDigitX,[c])))
-			      in raise SyntaxError(c,a1,q)
-			      end
-			       
-	 val (ch,(c1,a1,q1)) = do_dec_1 (getChar aq)
+         (*--------------------------------------------------------------*)
+         (* parse a (hexa)decimal number, accumulating the value in the  *)
+         (* first parameter.                                             *)
+         (*                                                              *)
+         (* return the numbers value as a Char.                          *)
+         (*--------------------------------------------------------------*)
+         fun do_hex_n yet (c,a,q) = 
+            case hexValue c
+              of NONE => (yet,(c,a,q))
+               | SOME v => do_hex_n (0wx10*yet+v) (getChar (a,q))
+         fun do_dec_n yet (c,a,q) = 
+            case decValue c
+              of NONE => (yet,(c,a,q))
+               | SOME v => do_dec_n (0wx0A*yet+v) (getChar (a,q))
+         (*--------------------------------------------------------------*)
+         (* Parse a (hexa)decimal number of at least one digit.          *)
+         (*                                                              *)
+         (* raise SyntaxError if no hexdigit is found first.             *)
+         (*                                                              *)
+         (* return the numbers value as a Char.                          *)
+         (*--------------------------------------------------------------*)
+         fun do_hex_1 (c,a,q) =
+            case hexValue c 
+              of SOME v => do_hex_n v (getChar (a,q))
+               | NONE => let val a1 = hookError(a,(getPos q,ERR_EXPECTED(expHexDigit,[c])))
+                         in raise SyntaxError(c,a1,q)
+                         end
+         (*--------------------------------------------------------------*)
+         (* Parse a decimal number of at least one digit, or a hexnumber *)
+         (* if the first character is 'x'.                               *)
+         (*                                                              *)
+         (* raise SyntaxError if neither 'x' nor digit is found first.   *)
+         (*                                                              *)
+         (* return the number's value as a Char.                         *)
+         (*--------------------------------------------------------------*)
+         fun do_dec_1 (c,a,q) =
+            case decValue c 
+              of SOME v => do_dec_n v (getChar (a,q))
+               | NONE => if c=0wx78 (* #"x" *) 
+                            then do_hex_1 (getChar (a,q))
+                         else let val a1 = hookError(a,(getPos q,ERR_EXPECTED(expDigitX,[c])))
+                              in raise SyntaxError(c,a1,q)
+                              end
+                               
+         val (ch,(c1,a1,q1)) = do_dec_1 (getChar aq)
 
-	 val _ = if c1=0wx3B then () 
-		 else let val a2 = hookError(a1,(getPos q1,ERR_EXPECTED(expSemi,[c1])))
-		      in raise SyntaxError(c1,a2,q1)
-		      end
+         val _ = if c1=0wx3B then () 
+                 else let val a2 = hookError(a1,(getPos q1,ERR_EXPECTED(expSemi,[c1])))
+                      in raise SyntaxError(c1,a2,q1)
+                      end
 
-	 val _ = if isXml ch then ()
-		 else let val a2 = hookError(a1,(getPos q1,ERR_NON_XML_CHARREF ch))
-		      in raise NoSuchChar (a2,q1)
-		      end
+         val _ = if isXml ch then ()
+                 else let val a2 = hookError(a1,(getPos q1,ERR_NON_XML_CHARREF ch))
+                      in raise NoSuchChar (a2,q1)
+                      end
       in (ch,a1,q1)
       end
    fun parseCharRefLit cs aq =
       let 
-	 (*--------------------------------------------------------------*)
-	 (* parse a (hexa)decimal number, accumulating the value in the  *)
-	 (* first parameter.                                             *)
-	 (*                                                              *)
-	 (* return the numbers value as a Char.                          *)
-	 (*--------------------------------------------------------------*)
-	 fun do_hex_n (cs,yet) (c,a,q) = 
-	    case hexValue c
-	      of NONE => (cs,yet,(c,a,q))
-	       | SOME v => do_hex_n (c::cs,0wx10*yet+v) (getChar (a,q))
-	 fun do_dec_n (cs,yet) (c,a,q) = 
-	    case decValue c
-	      of NONE => (cs,yet,(c,a,q))
-	       | SOME v => do_dec_n (c::cs,0wx0A*yet+v) (getChar (a,q))
-	 (*--------------------------------------------------------------*)
-	 (* Parse a (hexa)decimal number of at least one digit.          *)
-	 (*                                                              *)
-	 (* raise SyntaxError if no hexdigit is found first.             *)
-	 (*                                                              *)
-	 (* return the numbers value as a Char.                          *)
-	 (*--------------------------------------------------------------*)
-	 fun do_hex_1 cs (c,a,q) =
-	    case hexValue c 
-	      of SOME v => do_hex_n (c::cs,v) (getChar (a,q))
-	       | NONE => let val a1 = hookError(a,(getPos q,ERR_EXPECTED(expHexDigit,[c])))
-			 in raise SyntaxError(c,a1,q)
-			 end
-	 (*--------------------------------------------------------------*)
-	 (* Parse a decimal number of at least one digit, or a hexnumber *)
-	 (* if the first character is 'x'.                               *)
-	 (*                                                              *)
-	 (* raise SyntaxError if neither 'x' nor digit is found first.   *)
-	 (*                                                              *)
-	 (* return the number's value as a Char.                         *)
-	 (*--------------------------------------------------------------*)
-	 fun do_dec_1 cs (c,a,q) =
-	    case decValue c 
-	      of SOME v => do_dec_n (c::cs,v) (getChar (a,q))
-	       | NONE => if c=0wx78 (* #"x" *) 
-			    then do_hex_1 (c::cs) (getChar (a,q))
-			 else let val a1 = hookError(a,(getPos q,ERR_EXPECTED(expDigitX,[c])))
-			      in raise SyntaxError(c,a1,q)
-			      end
-			       
-	 val (cs1,ch,(c1,a1,q1)) = do_dec_1 cs (getChar aq)
+         (*--------------------------------------------------------------*)
+         (* parse a (hexa)decimal number, accumulating the value in the  *)
+         (* first parameter.                                             *)
+         (*                                                              *)
+         (* return the numbers value as a Char.                          *)
+         (*--------------------------------------------------------------*)
+         fun do_hex_n (cs,yet) (c,a,q) = 
+            case hexValue c
+              of NONE => (cs,yet,(c,a,q))
+               | SOME v => do_hex_n (c::cs,0wx10*yet+v) (getChar (a,q))
+         fun do_dec_n (cs,yet) (c,a,q) = 
+            case decValue c
+              of NONE => (cs,yet,(c,a,q))
+               | SOME v => do_dec_n (c::cs,0wx0A*yet+v) (getChar (a,q))
+         (*--------------------------------------------------------------*)
+         (* Parse a (hexa)decimal number of at least one digit.          *)
+         (*                                                              *)
+         (* raise SyntaxError if no hexdigit is found first.             *)
+         (*                                                              *)
+         (* return the numbers value as a Char.                          *)
+         (*--------------------------------------------------------------*)
+         fun do_hex_1 cs (c,a,q) =
+            case hexValue c 
+              of SOME v => do_hex_n (c::cs,v) (getChar (a,q))
+               | NONE => let val a1 = hookError(a,(getPos q,ERR_EXPECTED(expHexDigit,[c])))
+                         in raise SyntaxError(c,a1,q)
+                         end
+         (*--------------------------------------------------------------*)
+         (* Parse a decimal number of at least one digit, or a hexnumber *)
+         (* if the first character is 'x'.                               *)
+         (*                                                              *)
+         (* raise SyntaxError if neither 'x' nor digit is found first.   *)
+         (*                                                              *)
+         (* return the number's value as a Char.                         *)
+         (*--------------------------------------------------------------*)
+         fun do_dec_1 cs (c,a,q) =
+            case decValue c 
+              of SOME v => do_dec_n (c::cs,v) (getChar (a,q))
+               | NONE => if c=0wx78 (* #"x" *) 
+                            then do_hex_1 (c::cs) (getChar (a,q))
+                         else let val a1 = hookError(a,(getPos q,ERR_EXPECTED(expDigitX,[c])))
+                              in raise SyntaxError(c,a1,q)
+                              end
+                               
+         val (cs1,ch,(c1,a1,q1)) = do_dec_1 cs (getChar aq)
 
-	 val _ = if c1=0wx3B then () 
-		 else let val a2 = hookError(a1,(getPos q1,ERR_EXPECTED(expSemi,[c1])))
-		      in raise SyntaxError(c1,a2,q1)
-		      end
+         val _ = if c1=0wx3B then () 
+                 else let val a2 = hookError(a1,(getPos q1,ERR_EXPECTED(expSemi,[c1])))
+                      in raise SyntaxError(c1,a2,q1)
+                      end
 
-	 val _ = if isXml ch then ()
-		 else let val a2 = hookError(a1,(getPos q1,ERR_NON_XML_CHARREF ch))
-		      in raise NoSuchChar (a2,q1)
-		      end
+         val _ = if isXml ch then ()
+                 else let val a2 = hookError(a1,(getPos q1,ERR_NON_XML_CHARREF ch))
+                      in raise NoSuchChar (a2,q1)
+                      end
       in (c1::cs1,(ch,a1,q1))
       end
 
@@ -10506,99 +10506,99 @@
    (*--------------------------------------------------------------------*)
    fun parseGenRef dtd (caq as (_,_,q)) = 
       let 
-	 val (name,(c1,a1,q1)) = parseName caq
-	    handle NotFound (c,a,q) => let val err = ERR_EXPECTED(expAnEntName,[c])
-					   val a1 = hookError(a,(getPos q,err))
-				       in raise SyntaxError(c,a1,q)
-				       end
-	 val _ = if c1=0wx3B then () 
-		 else let val a2 = hookError(a1,(getPos q1,ERR_EXPECTED(expSemi,[c1])))
-		      in raise SyntaxError(c1,a2,q1)
-		      end
-						    
-	 val idx = GenEnt2Index dtd name
-	 val (ent,ext) = getGenEnt dtd idx 
-	       
-	 val _ = (* check whether entity is undeclared/unparsed/open *)
-	    case ent
-	      of GE_NULL => 
-		 if entitiesWellformed dtd
-		    then let val err = ERR_UNDEC_ENTITY(ENT_GENERAL,name)
-			     val a2 = hookError(a1,(getPos q,err))
-			 in raise NoSuchEntity (a2,q1)
-			 end
-		 else if useParamEnts()
-			 then let val err = ERR_UNDECLARED(IT_GEN_ENT,name,LOC_NONE)
-				  val a2 = hookError(a1,(getPos q,err))
-			      in raise NoSuchEntity (a2,q1)
-			      end
-		      else ()
-	       | GE_UNPARSED _ => let val err = ERR_ILLEGAL_ENTITY(ENT_UNPARSED,name,LOC_NONE)
-				      val a2 = hookError(a1,(getPos q,err))
-				  in raise NoSuchEntity (a2,q1)
-				  end
-	       | _ => if isOpen(idx,false,q1) 
-			 then let val err = ERR_RECURSIVE_ENTITY(ENT_GENERAL,name)
-				  val a2 = hookError(a1,(getPos q,err))
-			      in raise NoSuchEntity (a2,q1)
-			      end
-		      else ()
-			    
-	 val a2 = 
-	    if ext andalso !O_VALIDATE andalso standsAlone dtd andalso inDocEntity q1
-	       then let val _ = if !O_ERROR_MINIMIZE then setStandAlone dtd false else ()
-		    in hookError(a1,(getPos q,ERR_STANDALONE_ENT(ENT_GENERAL,name)))
-		    end
-	    else a1
+         val (name,(c1,a1,q1)) = parseName caq
+            handle NotFound (c,a,q) => let val err = ERR_EXPECTED(expAnEntName,[c])
+                                           val a1 = hookError(a,(getPos q,err))
+                                       in raise SyntaxError(c,a1,q)
+                                       end
+         val _ = if c1=0wx3B then () 
+                 else let val a2 = hookError(a1,(getPos q1,ERR_EXPECTED(expSemi,[c1])))
+                      in raise SyntaxError(c1,a2,q1)
+                      end
+                                                    
+         val idx = GenEnt2Index dtd name
+         val (ent,ext) = getGenEnt dtd idx 
+               
+         val _ = (* check whether entity is undeclared/unparsed/open *)
+            case ent
+              of GE_NULL => 
+                 if entitiesWellformed dtd
+                    then let val err = ERR_UNDEC_ENTITY(ENT_GENERAL,name)
+                             val a2 = hookError(a1,(getPos q,err))
+                         in raise NoSuchEntity (a2,q1)
+                         end
+                 else if useParamEnts()
+                         then let val err = ERR_UNDECLARED(IT_GEN_ENT,name,LOC_NONE)
+                                  val a2 = hookError(a1,(getPos q,err))
+                              in raise NoSuchEntity (a2,q1)
+                              end
+                      else ()
+               | GE_UNPARSED _ => let val err = ERR_ILLEGAL_ENTITY(ENT_UNPARSED,name,LOC_NONE)
+                                      val a2 = hookError(a1,(getPos q,err))
+                                  in raise NoSuchEntity (a2,q1)
+                                  end
+               | _ => if isOpen(idx,false,q1) 
+                         then let val err = ERR_RECURSIVE_ENTITY(ENT_GENERAL,name)
+                                  val a2 = hookError(a1,(getPos q,err))
+                              in raise NoSuchEntity (a2,q1)
+                              end
+                      else ()
+                            
+         val a2 = 
+            if ext andalso !O_VALIDATE andalso standsAlone dtd andalso inDocEntity q1
+               then let val _ = if !O_ERROR_MINIMIZE then setStandAlone dtd false else ()
+                    in hookError(a1,(getPos q,ERR_STANDALONE_ENT(ENT_GENERAL,name)))
+                    end
+            else a1
 
-      in ((idx,ent),(a2,q1))	    
+      in ((idx,ent),(a2,q1))        
       end
    fun parseGenRefLit dtd cs (caq as (_,_,q)) = 
       let 
-	 val (cs1,name,(c1,a1,q1)) = parseNameLit cs caq
-	    handle NotFound (c,a,q) => let val err = ERR_EXPECTED(expAnEntName,[c])
-					   val a1 = hookError(a,(getPos q,err))
-				       in raise SyntaxError(c,a1,q)
-				       end
-	 val _ = if c1=0wx3B then () 
-		 else let val a2 = hookError(a1,(getPos q1,ERR_EXPECTED(expSemi,[c1])))
-		      in raise SyntaxError(c1,a2,q1)
-		      end
-						    
-	 val idx = GenEnt2Index dtd name
-	 val (ent,ext) = getGenEnt dtd idx 
-	       
-	 val _ = (* check whether entity is undeclared/unparsed/open *)
-	    case ent
-	      of GE_NULL => 
-		 if entitiesWellformed dtd 
-		    then let val err = ERR_UNDEC_ENTITY(ENT_GENERAL,name)
-			     val a2 = hookError(a1,(getPos q,err))
-			 in raise NoSuchEntity (a2,q1)
-			 end
-		 else if useParamEnts()
-			 then let val err = ERR_UNDECLARED(IT_GEN_ENT,name,LOC_NONE)
-				  val a2 = hookError(a1,(getPos q,err))
-			      in raise NoSuchEntity (a2,q1)
-			      end
-		      else ()
-	       | GE_UNPARSED _ => let val err = ERR_ILLEGAL_ENTITY(ENT_UNPARSED,name,LOC_NONE)
-				      val a2 = hookError(a1,(getPos q,err))
-				  in raise NoSuchEntity (a2,q1)
-				  end
-	       | _ => if isOpen(idx,false,q1) 
-			 then let val err = ERR_RECURSIVE_ENTITY(ENT_GENERAL,name)
-				  val a2 = hookError(a1,(getPos q,err))
-			      in raise NoSuchEntity (a2,q1)
-			      end
-		      else ()
-			    
-	 val a2 = 
-	    if ext andalso !O_VALIDATE andalso standsAlone dtd andalso inDocEntity q1
-	       then let val _ = if !O_ERROR_MINIMIZE then setStandAlone dtd false else ()
-		    in hookError(a1,(getPos q,ERR_STANDALONE_ENT(ENT_GENERAL,name)))
-		    end
-	    else a1
+         val (cs1,name,(c1,a1,q1)) = parseNameLit cs caq
+            handle NotFound (c,a,q) => let val err = ERR_EXPECTED(expAnEntName,[c])
+                                           val a1 = hookError(a,(getPos q,err))
+                                       in raise SyntaxError(c,a1,q)
+                                       end
+         val _ = if c1=0wx3B then () 
+                 else let val a2 = hookError(a1,(getPos q1,ERR_EXPECTED(expSemi,[c1])))
+                      in raise SyntaxError(c1,a2,q1)
+                      end
+                                                    
+         val idx = GenEnt2Index dtd name
+         val (ent,ext) = getGenEnt dtd idx 
+               
+         val _ = (* check whether entity is undeclared/unparsed/open *)
+            case ent
+              of GE_NULL => 
+                 if entitiesWellformed dtd 
+                    then let val err = ERR_UNDEC_ENTITY(ENT_GENERAL,name)
+                             val a2 = hookError(a1,(getPos q,err))
+                         in raise NoSuchEntity (a2,q1)
+                         end
+                 else if useParamEnts()
+                         then let val err = ERR_UNDECLARED(IT_GEN_ENT,name,LOC_NONE)
+                                  val a2 = hookError(a1,(getPos q,err))
+                              in raise NoSuchEntity (a2,q1)
+                              end
+                      else ()
+               | GE_UNPARSED _ => let val err = ERR_ILLEGAL_ENTITY(ENT_UNPARSED,name,LOC_NONE)
+                                      val a2 = hookError(a1,(getPos q,err))
+                                  in raise NoSuchEntity (a2,q1)
+                                  end
+               | _ => if isOpen(idx,false,q1) 
+                         then let val err = ERR_RECURSIVE_ENTITY(ENT_GENERAL,name)
+                                  val a2 = hookError(a1,(getPos q,err))
+                              in raise NoSuchEntity (a2,q1)
+                              end
+                      else ()
+                            
+         val a2 = 
+            if ext andalso !O_VALIDATE andalso standsAlone dtd andalso inDocEntity q1
+               then let val _ = if !O_ERROR_MINIMIZE then setStandAlone dtd false else ()
+                    in hookError(a1,(getPos q,ERR_STANDALONE_ENT(ENT_GENERAL,name)))
+                    end
+            else a1
 
       in (c1::cs1,((idx,ent),(a2,q1)))
       end
@@ -10645,84 +10645,84 @@
    (*--------------------------------------------------------------------*)
    fun parseParRef dtd (caq as (_,_,q)) = 
       let 
-	 val (name,(c1,a1,q1)) = parseName caq 
-	    handle NotFound(c,a,q) => let val err = ERR_EXPECTED(expAnEntName,[c])
-					  val a1 = hookError(a,(getPos q,err))
-				      in raise SyntaxError(c,a1,q)
-				      end
-		  
-	 val _ = if c1=0wx3B then () 
-		 else let val err = ERR_EXPECTED(expSemi,[c1])
-			  val a2 = hookError(a1,(getPos q1,err))
-		      in raise SyntaxError(c1,a2,q1)
-		      end
-		       
+         val (name,(c1,a1,q1)) = parseName caq 
+            handle NotFound(c,a,q) => let val err = ERR_EXPECTED(expAnEntName,[c])
+                                          val a1 = hookError(a,(getPos q,err))
+                                      in raise SyntaxError(c,a1,q)
+                                      end
+                  
+         val _ = if c1=0wx3B then () 
+                 else let val err = ERR_EXPECTED(expSemi,[c1])
+                          val a2 = hookError(a1,(getPos q1,err))
+                      in raise SyntaxError(c1,a2,q1)
+                      end
+                       
          val _ = setExternal dtd;
-	 val idx = ParEnt2Index dtd name
-	 val (ent,ext) = getParEnt dtd idx 
-	       
-	 val _ = (* check whether entity is declared *)
-	    case ent 
-	      of PE_NULL =>  
-		 if entitiesWellformed dtd
-		    then let val err = ERR_UNDEC_ENTITY(ENT_PARAMETER,name)
-			     val a2 = hookError(a1,(getPos q,err))
-			 in raise NoSuchEntity (a2,q1)
-			 end
-		 else if useParamEnts()
-			 then let val err = ERR_UNDECLARED(IT_PAR_ENT,name,LOC_NONE)
-				  val a2 = hookError(a1,(getPos q,err))
-			      in raise NoSuchEntity (a2,q1)
-			      end
-		      else ()
-	       (* check whether the entity is already open *)
-	       | _ => if isOpen(idx,true,q1) 
-			 then let val err = ERR_RECURSIVE_ENTITY(ENT_PARAMETER,name)
-				  val a2 = hookError(a1,(getPos q,err))
-			      in raise NoSuchEntity (a2,q1)
-			      end
-		      else ()
-      in ((idx,ent),(a1,q1))	 
+         val idx = ParEnt2Index dtd name
+         val (ent,ext) = getParEnt dtd idx 
+               
+         val _ = (* check whether entity is declared *)
+            case ent 
+              of PE_NULL =>  
+                 if entitiesWellformed dtd
+                    then let val err = ERR_UNDEC_ENTITY(ENT_PARAMETER,name)
+                             val a2 = hookError(a1,(getPos q,err))
+                         in raise NoSuchEntity (a2,q1)
+                         end
+                 else if useParamEnts()
+                         then let val err = ERR_UNDECLARED(IT_PAR_ENT,name,LOC_NONE)
+                                  val a2 = hookError(a1,(getPos q,err))
+                              in raise NoSuchEntity (a2,q1)
+                              end
+                      else ()
+               (* check whether the entity is already open *)
+               | _ => if isOpen(idx,true,q1) 
+                         then let val err = ERR_RECURSIVE_ENTITY(ENT_PARAMETER,name)
+                                  val a2 = hookError(a1,(getPos q,err))
+                              in raise NoSuchEntity (a2,q1)
+                              end
+                      else ()
+      in ((idx,ent),(a1,q1))     
       end
    fun parseParRefLit dtd cs (caq as (_,_,q)) = 
       let 
-	 val (cs1,name,(c1,a1,q1)) = parseNameLit cs caq 
-	    handle NotFound(c,a,q) => let val err = ERR_EXPECTED(expAnEntName,[c])
-					  val a1 = hookError(a,(getPos q,err))
-				      in raise SyntaxError(c,a1,q)
-				      end
-		  
-	 val _ = if c1=0wx3B then () 
-		 else let val err = ERR_EXPECTED(expSemi,[c1])
-			  val a2 = hookError(a1,(getPos q1,err))
-		      in raise SyntaxError(c1,a2,q1)
-		      end
-		       
+         val (cs1,name,(c1,a1,q1)) = parseNameLit cs caq 
+            handle NotFound(c,a,q) => let val err = ERR_EXPECTED(expAnEntName,[c])
+                                          val a1 = hookError(a,(getPos q,err))
+                                      in raise SyntaxError(c,a1,q)
+                                      end
+                  
+         val _ = if c1=0wx3B then () 
+                 else let val err = ERR_EXPECTED(expSemi,[c1])
+                          val a2 = hookError(a1,(getPos q1,err))
+                      in raise SyntaxError(c1,a2,q1)
+                      end
+                       
          val _ = setExternal dtd;
-	 val idx = ParEnt2Index dtd name
-	 val (ent,ext) = getParEnt dtd idx 
-	       
-	 val _ = (* check whether entity is declared *)
-	    case ent 
-	      of PE_NULL =>  
-		 if entitiesWellformed dtd 
-		    then let val err = ERR_UNDEC_ENTITY(ENT_PARAMETER,name)
-			     val a2 = hookError(a1,(getPos q,err))
-			 in raise NoSuchEntity (a2,q1)
-			 end
-		 else if useParamEnts()
-			 then let val err = ERR_UNDECLARED(IT_PAR_ENT,name,LOC_NONE)
-				  val a2 = hookError(a1,(getPos q,err))
-			      in raise NoSuchEntity (a2,q1)
-			      end
-		      else ()
-	       (* check whether the entity is already open *)
-	       | _ => if isOpen(idx,true,q1) 
-			 then let val err = ERR_RECURSIVE_ENTITY(ENT_PARAMETER,name)
-				  val a2 = hookError(a1,(getPos q,err))
-			      in raise NoSuchEntity (a2,q1)
-			      end
-		      else ()
+         val idx = ParEnt2Index dtd name
+         val (ent,ext) = getParEnt dtd idx 
+               
+         val _ = (* check whether entity is declared *)
+            case ent 
+              of PE_NULL =>  
+                 if entitiesWellformed dtd 
+                    then let val err = ERR_UNDEC_ENTITY(ENT_PARAMETER,name)
+                             val a2 = hookError(a1,(getPos q,err))
+                         in raise NoSuchEntity (a2,q1)
+                         end
+                 else if useParamEnts()
+                         then let val err = ERR_UNDECLARED(IT_PAR_ENT,name,LOC_NONE)
+                                  val a2 = hookError(a1,(getPos q,err))
+                              in raise NoSuchEntity (a2,q1)
+                              end
+                      else ()
+               (* check whether the entity is already open *)
+               | _ => if isOpen(idx,true,q1) 
+                         then let val err = ERR_RECURSIVE_ENTITY(ENT_PARAMETER,name)
+                                  val a2 = hookError(a1,(getPos q,err))
+                              in raise NoSuchEntity (a2,q1)
+                              end
+                      else ()
       in (c1::cs1,((idx,ent),(a1,q1)))
       end
 
@@ -10738,15 +10738,15 @@
    fun skipReference caq = 
       let val (_,(c1,a1,q1)) = parseName caq 
       in if c1=0wx3B then getChar (a1,q1) 
-	 else let val err = ERR_EXPECTED(expSemi,[c1])
-		  val a2 = hookError(a1,(getPos q1,err))
-	      in (c1,a2,q1)    
-	      end
+         else let val err = ERR_EXPECTED(expSemi,[c1])
+                  val a2 = hookError(a1,(getPos q1,err))
+              in (c1,a2,q1)    
+              end
       end
    handle NotFound (c,a,q) => let val err = ERR_EXPECTED(expAnEntName,[c])
-				  val a1 = hookError(a,(getPos q,err))
-			      in (c,a1,q)	    
-			      end
+                                  val a1 = hookError(a,(getPos q,err))
+                              in (c,a1,q)           
+                              end
 
    (*--------------------------------------------------------------------*)
    (* skip a character reference, the "&#" already read. See 4.1:        *)
@@ -10760,29 +10760,29 @@
    (*--------------------------------------------------------------------*)
    fun skipCharRef aq =
       let 
-	 (*--------------------------------------------------------------*)
-	 (* skip a (hexa)decimal number.                                 *)
-	 (*--------------------------------------------------------------*)
-	 fun skip_ximal isX (c,a,q) = 
-	    if isX c then skip_ximal isX (getChar (a,q)) else (c,a,q)
-			       
-	 val (c1,a1,q1) = getChar aq
-	 val (c2,a2,q2) = 
-	    if isDec c1 then skip_ximal isDec (getChar (a1,q1))
-	    else if c1=0wx78 (* #"x" *) 
-		    then let val (c2,a2,q2) = getChar (a1,q1)
-			 in if isHex c2 then skip_ximal isHex (getChar (a2,q2))
-			    else let val err = ERR_EXPECTED(expHexDigit,[c2])
-				     val a3 = hookError(a2,(getPos q2,err))
-				 in raise SyntaxError(c2,a3,q2)
-				 end
-			 end
-		 else let val a2 = hookError(a1,(getPos q1,ERR_EXPECTED(expDigitX,[c1])))
-		      in raise SyntaxError (c1,a2,q1)
-		      end
-				   
+         (*--------------------------------------------------------------*)
+         (* skip a (hexa)decimal number.                                 *)
+         (*--------------------------------------------------------------*)
+         fun skip_ximal isX (c,a,q) = 
+            if isX c then skip_ximal isX (getChar (a,q)) else (c,a,q)
+                               
+         val (c1,a1,q1) = getChar aq
+         val (c2,a2,q2) = 
+            if isDec c1 then skip_ximal isDec (getChar (a1,q1))
+            else if c1=0wx78 (* #"x" *) 
+                    then let val (c2,a2,q2) = getChar (a1,q1)
+                         in if isHex c2 then skip_ximal isHex (getChar (a2,q2))
+                            else let val err = ERR_EXPECTED(expHexDigit,[c2])
+                                     val a3 = hookError(a2,(getPos q2,err))
+                                 in raise SyntaxError(c2,a3,q2)
+                                 end
+                         end
+                 else let val a2 = hookError(a1,(getPos q1,ERR_EXPECTED(expDigitX,[c1])))
+                      in raise SyntaxError (c1,a2,q1)
+                      end
+                                   
       in if c2=0wx3B then getChar (a2,q2) 
-	 else (c2,hookError(a2,(getPos q2,ERR_EXPECTED(expSemi,[c2]))),q2)
+         else (c2,hookError(a2,(getPos q2,ERR_EXPECTED(expSemi,[c2]))),q2)
       end
    handle SyntaxError caq => caq
 
@@ -10844,19 +10844,19 @@
    (*--------------------------------------------------------------------*)
    fun skipPSopt dtd caq =
       let fun doit (c,a,q) = 
-	 case c
-	   of 0wx00 => 
-	      if isSpecial q then (c,a,q) 
-	      else let val a1 = if !O_VALIDATE andalso inDocEntity q 
-				   then hookError(a,(getPos q,ERR_EE_INT_SUBSET))
-				else a
-		   in doit (getChar (a1,q))
-		   end
-	    | 0wx09 => doit (getChar (a,q))
-	    | 0wx0A => doit (getChar (a,q))
-	    | 0wx20 => doit (getChar (a,q))
-	    | 0wx25 (* #"%" *) => doit (doParRef dtd (getChar (a,q)))
-	 | _ => (c,a,q)
+         case c
+           of 0wx00 => 
+              if isSpecial q then (c,a,q) 
+              else let val a1 = if !O_VALIDATE andalso inDocEntity q 
+                                   then hookError(a,(getPos q,ERR_EE_INT_SUBSET))
+                                else a
+                   in doit (getChar (a1,q))
+                   end
+            | 0wx09 => doit (getChar (a,q))
+            | 0wx0A => doit (getChar (a,q))
+            | 0wx20 => doit (getChar (a,q))
+            | 0wx25 (* #"%" *) => doit (doParRef dtd (getChar (a,q)))
+         | _ => (c,a,q)
       in doit caq
       end
    (*--------------------------------------------------------------------*)
@@ -10872,18 +10872,18 @@
    (*--------------------------------------------------------------------*)
    fun skipPSmay dtd (c,a,q) =
       case c 
-	of 0wx00 => 
-	   if isSpecial q then (false,(c,a,q)) 
-	   else let val a1 = if !O_VALIDATE andalso inDocEntity q 
-				then hookError(a,(getPos q,ERR_EE_INT_SUBSET))
-			     else a
-		in (true,skipPSopt dtd (getChar (a1,q)))
-		end
-	 | 0wx09 => (true,skipPSopt dtd (getChar (a,q)))
-	 | 0wx0A => (true,skipPSopt dtd (getChar (a,q)))
-	 | 0wx20 => (true,skipPSopt dtd (getChar (a,q)))
+        of 0wx00 => 
+           if isSpecial q then (false,(c,a,q)) 
+           else let val a1 = if !O_VALIDATE andalso inDocEntity q 
+                                then hookError(a,(getPos q,ERR_EE_INT_SUBSET))
+                             else a
+                in (true,skipPSopt dtd (getChar (a1,q)))
+                end
+         | 0wx09 => (true,skipPSopt dtd (getChar (a,q)))
+         | 0wx0A => (true,skipPSopt dtd (getChar (a,q)))
+         | 0wx20 => (true,skipPSopt dtd (getChar (a,q)))
          | 0wx25 (* #"%" *) => (true,skipPSopt dtd (doParRef dtd (getChar (a,q))))
-	 | _ => (false,(c,a,q))
+         | _ => (false,(c,a,q))
    (*--------------------------------------------------------------------*)
    (* parse required white space.                                        *)
    (*                                                                    *)
@@ -10897,18 +10897,18 @@
    (*--------------------------------------------------------------------*)
    fun skipPS dtd (c,a,q) = 
       case c
-	of 0wx00 => 
-	   if isSpecial q then (c,hookError(a,(getPos q,ERR_MISSING_WHITE)),q)
-	   else let val a1 = if !O_VALIDATE andalso inDocEntity q 
-				then hookError(a,(getPos q,ERR_EE_INT_SUBSET))
-			     else a
-		in skipPSopt dtd (getChar (a1,q))
-		end
-	 | 0wx09 => skipPSopt dtd (getChar (a,q))
-	 | 0wx0A => skipPSopt dtd (getChar (a,q))
-	 | 0wx20 => skipPSopt dtd (getChar (a,q))
+        of 0wx00 => 
+           if isSpecial q then (c,hookError(a,(getPos q,ERR_MISSING_WHITE)),q)
+           else let val a1 = if !O_VALIDATE andalso inDocEntity q 
+                                then hookError(a,(getPos q,ERR_EE_INT_SUBSET))
+                             else a
+                in skipPSopt dtd (getChar (a1,q))
+                end
+         | 0wx09 => skipPSopt dtd (getChar (a,q))
+         | 0wx0A => skipPSopt dtd (getChar (a,q))
+         | 0wx20 => skipPSopt dtd (getChar (a,q))
          | 0wx25 (* #"%" *) => skipPSopt dtd (doParRef dtd (getChar (a,q)))
-	 | _ => (c,hookError(a,(getPos q,ERR_MISSING_WHITE)),q)
+         | _ => (c,hookError(a,(getPos q,ERR_MISSING_WHITE)),q)
    (*--------------------------------------------------------------------*)
    (* parse required white space, taking care of a single '%' character. *)
    (* this is only needed before the entity name in an entity decl.      *)
@@ -10924,31 +10924,31 @@
    (*--------------------------------------------------------------------*)
    fun skipPSdec dtd caq = 
       let fun doit req (c,a,q) = 
-	 case c
-	   of 0wx00 => 
-	      if isSpecial q then (false,(c,a,q)) 
-	      else let val a1 = if !O_VALIDATE andalso inDocEntity q 
-				   then hookError(a,(getPos q,ERR_EE_INT_SUBSET))
-				else a
-		   in doit false (getChar (a1,q))
-		   end
-	    | 0wx09 => doit false (getChar (a,q))
-	    | 0wx0A => doit false (getChar (a,q))
-	    | 0wx20 => doit false (getChar (a,q))
-	    | 0wx25 => (* #"%" *)
-		   let val (c1,a1,q1) = getChar (a,q)
-		   in if isNms c1 then doit false (doParRef dtd (c1,a1,q1))
-		      else let val a2 = if req then hookError(a1,(getPos q,ERR_MISSING_WHITE))
-					else a1
-			   in (true,(c1,a2,q1))
-			   end
-		   end
-	    | _ => let val a1 = if req then hookError(a,(getPos q,ERR_MISSING_WHITE))
-				else a
-		   in (false,(c,a1,q))
-		   end
+         case c
+           of 0wx00 => 
+              if isSpecial q then (false,(c,a,q)) 
+              else let val a1 = if !O_VALIDATE andalso inDocEntity q 
+                                   then hookError(a,(getPos q,ERR_EE_INT_SUBSET))
+                                else a
+                   in doit false (getChar (a1,q))
+                   end
+            | 0wx09 => doit false (getChar (a,q))
+            | 0wx0A => doit false (getChar (a,q))
+            | 0wx20 => doit false (getChar (a,q))
+            | 0wx25 => (* #"%" *)
+                   let val (c1,a1,q1) = getChar (a,q)
+                   in if isNms c1 then doit false (doParRef dtd (c1,a1,q1))
+                      else let val a2 = if req then hookError(a1,(getPos q,ERR_MISSING_WHITE))
+                                        else a1
+                           in (true,(c1,a2,q1))
+                           end
+                   end
+            | _ => let val a1 = if req then hookError(a,(getPos q,ERR_MISSING_WHITE))
+                                else a
+                   in (false,(c,a1,q))
+                   end
       in 
-	 doit true caq 
+         doit true caq 
       end
 end
 (* stop of ../../Parser/Parse/parseRefs.sml *)
@@ -10959,7 +10959,7 @@
       include ParseBase
 
       val parseName    : UniChar.Char * AppData * State 
-	 -> UniChar.Data * (UniChar.Char * AppData * State)
+         -> UniChar.Data * (UniChar.Char * AppData * State)
       val parseNmtoken : UniChar.Char * AppData * State 
          -> UniChar.Data * (UniChar.Char * AppData * State)
 
@@ -10969,48 +10969,48 @@
       val skipSopt : UniChar.Char * AppData * State -> UniChar.Char * AppData * State
       val skipSmay : UniChar.Char * AppData * State -> bool * (UniChar.Char * AppData * State)
       val parseSopt : UniChar.Data -> UniChar.Char * AppData * State 
-	 -> UniChar.Data * (UniChar.Char * AppData * State)
+         -> UniChar.Data * (UniChar.Char * AppData * State)
       val parseSmay : UniChar.Data -> UniChar.Char * AppData * State 
-	 -> bool * (UniChar.Data * (UniChar.Char * AppData * State))
+         -> bool * (UniChar.Data * (UniChar.Char * AppData * State))
       val parseEq : UniChar.Char * AppData * State 
-	 -> UniChar.Data * (UniChar.Char * AppData * State)
+         -> UniChar.Data * (UniChar.Char * AppData * State)
 
       val openExtern   : int * Uri.Uri -> AppData * State 
-	 -> Encoding.Encoding * HookData.TextDecl option * (UniChar.Char * AppData * State)
+         -> Encoding.Encoding * HookData.TextDecl option * (UniChar.Char * AppData * State)
       val openDocument : Uri.Uri option -> AppData 
-	 -> Encoding.Encoding * HookData.XmlDecl option * (UniChar.Char * AppData * State)
+         -> Encoding.Encoding * HookData.XmlDecl option * (UniChar.Char * AppData * State)
       val openSubset   : Uri.Uri -> AppData 
-	 -> Encoding.Encoding * HookData.TextDecl option * (UniChar.Char * AppData * State)
+         -> Encoding.Encoding * HookData.TextDecl option * (UniChar.Char * AppData * State)
 
       val skipCharRef     : AppData * State -> (UniChar.Char *  AppData * State)
       val skipReference   : UniChar.Char * AppData * State -> (UniChar.Char *  AppData * State)
       val parseGenRef     : Dtd -> UniChar.Char * AppData * State 
-	 -> (int * Base.GenEntity) * (AppData * State)
+         -> (int * Base.GenEntity) * (AppData * State)
       val parseParRef     : Dtd -> UniChar.Char * AppData * State 
-	 -> (int * Base.ParEntity) * (AppData * State)
+         -> (int * Base.ParEntity) * (AppData * State)
       val parseCharRefLit : UniChar.Data -> AppData * State 
-	 -> UniChar.Data * (UniChar.Char * AppData * State)
+         -> UniChar.Data * (UniChar.Char * AppData * State)
       val skipPS    : Dtd -> UniChar.Char * AppData * State 
-	 -> UniChar.Char * AppData * State
+         -> UniChar.Char * AppData * State
       val skipPSopt : Dtd -> UniChar.Char * AppData * State 
-	 -> UniChar.Char * AppData * State
+         -> UniChar.Char * AppData * State
       val skipPSmay : Dtd -> UniChar.Char * AppData * State 
-	 -> bool * (UniChar.Char * AppData * State)
+         -> bool * (UniChar.Char * AppData * State)
       val skipPSdec : Dtd -> UniChar.Char * AppData * State 
-	 -> bool * (UniChar.Char * AppData * State)
+         -> bool * (UniChar.Char * AppData * State)
       ----------------------------------------------------------------------*)
       include ParseRefs
 
       val parseSystemLiteral : UniChar.Char * AppData * State 
-	 -> Uri.Uri * UniChar.Char * (UniChar.Char * AppData * State)
+         -> Uri.Uri * UniChar.Char * (UniChar.Char * AppData * State)
       val parsePubidLiteral  : UniChar.Char * AppData * State 
-	 -> string * UniChar.Char * (UniChar.Char * AppData * State)
+         -> string * UniChar.Char * (UniChar.Char * AppData * State)
 
       val parseAttValue : Dtd -> UniChar.Char * AppData * State 
-	 -> UniChar.Vector * UniChar.Data * (UniChar.Char * AppData * State)
+         -> UniChar.Vector * UniChar.Data * (UniChar.Char * AppData * State)
       val parseEntityValue : Dtd -> (UniChar.Vector * UniChar.Vector -> 'a) 
-	 -> UniChar.Char * AppData * State 
-	 -> 'a * (UniChar.Char * AppData * State)
+         -> UniChar.Char * AppData * State 
+         -> 'a * (UniChar.Char * AppData * State)
    end
 
 (*--------------------------------------------------------------------------*)
@@ -11050,23 +11050,23 @@
       (* might raise: none                                                  *) 
       (*--------------------------------------------------------------------*)
       fun parseSystemLiteral' quote aq =
-	 let 
-	    fun doit text (c,a,q) = 
-	       if c=quote then (text,getChar (a,q))
-	       else if c=0wx0 
-		       then let val a1 = hookError(a,(getPos q,ERR_ENDED_BY_EE LOC_SYS_LIT))
-			    in (text,(c,a1,q))
-			    end
-	       else if c>0wx7F andalso !O_WARN_NON_ASCII_URI 
-		       then let val a1 = hookWarning(a,(getPos q,WARN_NON_ASCII_URI c))
-			    in doit (c::text) (getChar(a1,q))
-			    end
-		    else doit (c::text) (getChar(a,q))
-	    
-	    val (text,caq1) = doit nil (getChar aq)
-	 in 
-	    (Data2Uri(rev text),quote,caq1)
-	 end
+         let 
+            fun doit text (c,a,q) = 
+               if c=quote then (text,getChar (a,q))
+               else if c=0wx0 
+                       then let val a1 = hookError(a,(getPos q,ERR_ENDED_BY_EE LOC_SYS_LIT))
+                            in (text,(c,a1,q))
+                            end
+               else if c>0wx7F andalso !O_WARN_NON_ASCII_URI 
+                       then let val a1 = hookWarning(a,(getPos q,WARN_NON_ASCII_URI c))
+                            in doit (c::text) (getChar(a1,q))
+                            end
+                    else doit (c::text) (getChar(a,q))
+            
+            val (text,caq1) = doit nil (getChar aq)
+         in 
+            (Data2Uri(rev text),quote,caq1)
+         end
       (*--------------------------------------------------------------------*)
       (* parse a system literal.                                            *)
       (*                                                                    *)
@@ -11080,11 +11080,11 @@
       (* might raise: NotFound                                              *) 
       (*--------------------------------------------------------------------*)
       fun parseSystemLiteral (c,a,q) = 
-	 if c=0wx22 (* "'" *) orelse 
-	    c=0wx27 (* '"' *) 
-	    then parseSystemLiteral' c (a,q)
-	 else raise NotFound (c,a,q)
-		     
+         if c=0wx22 (* "'" *) orelse 
+            c=0wx27 (* '"' *) 
+            then parseSystemLiteral' c (a,q)
+         else raise NotFound (c,a,q)
+                     
       (*--------------------------------------------------------------------*)
       (* parse a pubid literal, the quote character ("'" or '"') already ---*)
       (* read and passed as first argument.  cf. 2.3:                       *)
@@ -11101,30 +11101,30 @@
       (* might raise: none                                                  *) 
       (*--------------------------------------------------------------------*)
       fun parsePubidLiteral' quote aq =
-	 let 
-	    fun doit (hadSpace,atStart,text) aq = 
-	       let val (c1,a1,q1) = getChar aq
-	       in case c1 
-		    of 0wx00 => let val a2 = hookError(a1,(getPos q1,ERR_ENDED_BY_EE LOC_PUB_LIT))
-				in (text,(c1,a2,q1)) 
-				end
-		     | 0wx0A => doit (true,atStart,text) (a1,q1)
-		     | 0wx20 => doit (true,atStart,text) (a1,q1)
-		     | _ => 
-		       if c1=quote then (text,getChar (a1,q1))
-		       else if not (isPubid c1) 
-			       then let val err = ERR_FORBIDDEN_HERE(IT_CHAR c1,LOC_PUB_LIT)
-					val a2 = hookError(a1,(getPos q1,err))
-				    in doit (hadSpace,atStart,text) (a2,q1)
-				    end
-		       else if hadSpace andalso not atStart 
-			       then doit (false,false,c1::0wx20::text) (a1,q1)
-			    else doit (false,false,c1::text) (a1,q1)
-	       end 
-	    val (text,caq1) = doit (false,true,nil) aq
-	 in 
-	    (Latin2String(rev text),quote,caq1)
-	 end
+         let 
+            fun doit (hadSpace,atStart,text) aq = 
+               let val (c1,a1,q1) = getChar aq
+               in case c1 
+                    of 0wx00 => let val a2 = hookError(a1,(getPos q1,ERR_ENDED_BY_EE LOC_PUB_LIT))
+                                in (text,(c1,a2,q1)) 
+                                end
+                     | 0wx0A => doit (true,atStart,text) (a1,q1)
+                     | 0wx20 => doit (true,atStart,text) (a1,q1)
+                     | _ => 
+                       if c1=quote then (text,getChar (a1,q1))
+                       else if not (isPubid c1) 
+                               then let val err = ERR_FORBIDDEN_HERE(IT_CHAR c1,LOC_PUB_LIT)
+                                        val a2 = hookError(a1,(getPos q1,err))
+                                    in doit (hadSpace,atStart,text) (a2,q1)
+                                    end
+                       else if hadSpace andalso not atStart 
+                               then doit (false,false,c1::0wx20::text) (a1,q1)
+                            else doit (false,false,c1::text) (a1,q1)
+               end 
+            val (text,caq1) = doit (false,true,nil) aq
+         in 
+            (Latin2String(rev text),quote,caq1)
+         end
       (*--------------------------------------------------------------------*)
       (* parse a pubid literal.                                             *)
       (*                                                                    *)
@@ -11139,10 +11139,10 @@
       (* might raise: NotFound                                              *) 
       (*--------------------------------------------------------------------*)
       fun parsePubidLiteral (c,a,q) = 
-	 if c=0wx22 (* "'" *) orelse 
-	    c=0wx27 (* '"' *) 
-	    then parsePubidLiteral' c (a,q)
-	 else raise NotFound (c,a,q)
+         if c=0wx22 (* "'" *) orelse 
+            c=0wx27 (* '"' *) 
+            then parsePubidLiteral' c (a,q)
+         else raise NotFound (c,a,q)
 
       (*--------------------------------------------------------------------*)
       (* parse an entity value and the quote character ("'" or '"') passed  *)
@@ -11179,95 +11179,95 @@
       (* might raise: none                                                  *) 
       (*--------------------------------------------------------------------*)
       fun parseEntityValue' dtd (quote,con) aq =
-	 let fun doit (level,hadCr,lit,text) (c1,a1,q1) = 
-	    case c1
-	      of 0wx00 => if level=0 then let val err = ERR_ENDED_BY_EE LOC_ENT_VALUE
-					      val a2 = hookError(a1,(getPos q1,err))
-					  in (lit,text,(c1,a2,q1))
-					  end
-			  else doit (level-1,false,lit,text) (getChar (a1,q1))
-	       | 0wx25 => (* #"%" *)
-		 let val (level1,lit1,caq2) = 
-		    if inDocEntity q1 
-		       then let val err = ERR_FORBIDDEN_HERE(IT_PAR_REF,LOC_INT_DECL)
-				val a2 = hookError(a1,(getPos q1,err))
-			    in (level,lit,skipReference (getChar(a2,q1)))
-			    end
-		    else
-		       let val (lit1,((id,ent),(a2,q2))) = 
-			  if level=0 then parseParRefLit dtd (c1::lit) (getChar(a1,q1))
-			  else (lit,parseParRef dtd (getChar(a1,q1)))
-		       in case ent
-			    of PE_NULL => (level,lit1,getChar(a2,q2))
-			     | PE_INTERN(_,rep) => 
-			       let val q3 = pushIntern(q2,id,true,rep)
-			       in (level+1,lit1,getChar(a2,q3))
-			       end
-			     | PE_EXTERN extId => 
-			       let 
-				  val fname = resolveExtId extId
-				  val caq3 = #3(openExtern (id,true,fname) (a2,q2))
-			       in (level+1,lit1,caq3)
-			       end handle CantOpenFile(fmsg,a) 
-			       => let val err = ERR_NO_SUCH_FILE fmsg
-				      val a1 = hookError(a,(getPos q1,err))
-				  in (level,lit1,getChar(a1,q1))
-				  end
-		       end (* ignore syntax errors in references *)
-		    handle SyntaxError caq => (level,lit,caq) 
-			 | NoSuchEntity aq => (level,lit,getChar aq)
-		 in doit (level1,false,lit1,text) caq2
-		 end
-	       | 0wx26 => (* #"&" *)
-		 let val (c2,a2,q2) = getChar (a1,q1)
-		 in (if c2=0wx23 (* #"#" *)
-			(*--------------------------------------------------*)
-			(* it's a character reference.                      *)
-			(*--------------------------------------------------*)
-			then (if level=0
-				 then 
-				    let val (lit3,(ch,a3,q3)) = 
-				       parseCharRefLit (c2::c1::lit) (a2,q2)
-				    in doit (level,false,lit3,ch::text) (getChar(a3,q3))
-				    end
-			      else let val (ch,a3,q3) = parseCharRef (a2,q2)
-				   in doit (level,false,lit,ch::text) (getChar(a3,q3))
-				   end)
-			   (* ignore errors in char references *)
-			   handle SyntaxError caq => doit (level,false,lit,text) caq
-				| NoSuchChar aq => doit (level,false,lit,text) (getChar aq)
-		     (*-----------------------------------------------------*)
-		     (* it's a general entity reference.                    *)
-		     (*-----------------------------------------------------*)
-		     else let 
-			     val (fnd,lit3,text3,(c3,a3,q3)) = 
-				parseEntName (c1::lit,c1::text) (c2,a2,q2)
-			     val (lit4,text4,caq4) = 
-				if not fnd then (lit,text,(c3,a3,q3))
-				else if c3=0wx3B (* #";" *) 
-					then (c3::lit3,c3::text3,(getChar(a3,q3)))
-				     else let val err = ERR_EXPECTED(expSemi,[c3])
-					      val a4 = hookError(a3,(getPos q3,err))
-					  in (lit,text,(c3,a4,q3))
-					  end
-			  in doit (level,false,lit4,text4) caq4
-			  end
-		       )
-		 end
-	       | 0wx0A => doit (level,false,if level=0 then c1::lit else lit,
-				if hadCr then text else c1::text) (getChar (a1,q1))
-	       | 0wx0D => doit (level,true,if level=0 then c1::lit else lit,0wx0A::text) 
-			  (getChar (a1,q1))
-	       | _ => if c1=quote andalso level=0 then (lit,text,getChar(a1,q1))
-		      else doit (level,false,if level=0 then c1::lit else lit,c1::text) 
-			 (getChar (a1,q1))
+         let fun doit (level,hadCr,lit,text) (c1,a1,q1) = 
+            case c1
+              of 0wx00 => if level=0 then let val err = ERR_ENDED_BY_EE LOC_ENT_VALUE
+                                              val a2 = hookError(a1,(getPos q1,err))
+                                          in (lit,text,(c1,a2,q1))
+                                          end
+                          else doit (level-1,false,lit,text) (getChar (a1,q1))
+               | 0wx25 => (* #"%" *)
+                 let val (level1,lit1,caq2) = 
+                    if inDocEntity q1 
+                       then let val err = ERR_FORBIDDEN_HERE(IT_PAR_REF,LOC_INT_DECL)
+                                val a2 = hookError(a1,(getPos q1,err))
+                            in (level,lit,skipReference (getChar(a2,q1)))
+                            end
+                    else
+                       let val (lit1,((id,ent),(a2,q2))) = 
+                          if level=0 then parseParRefLit dtd (c1::lit) (getChar(a1,q1))
+                          else (lit,parseParRef dtd (getChar(a1,q1)))
+                       in case ent
+                            of PE_NULL => (level,lit1,getChar(a2,q2))
+                             | PE_INTERN(_,rep) => 
+                               let val q3 = pushIntern(q2,id,true,rep)
+                               in (level+1,lit1,getChar(a2,q3))
+                               end
+                             | PE_EXTERN extId => 
+                               let 
+                                  val fname = resolveExtId extId
+                                  val caq3 = #3(openExtern (id,true,fname) (a2,q2))
+                               in (level+1,lit1,caq3)
+                               end handle CantOpenFile(fmsg,a) 
+                               => let val err = ERR_NO_SUCH_FILE fmsg
+                                      val a1 = hookError(a,(getPos q1,err))
+                                  in (level,lit1,getChar(a1,q1))
+                                  end
+                       end (* ignore syntax errors in references *)
+                    handle SyntaxError caq => (level,lit,caq) 
+                         | NoSuchEntity aq => (level,lit,getChar aq)
+                 in doit (level1,false,lit1,text) caq2
+                 end
+               | 0wx26 => (* #"&" *)
+                 let val (c2,a2,q2) = getChar (a1,q1)
+                 in (if c2=0wx23 (* #"#" *)
+                        (*--------------------------------------------------*)
+                        (* it's a character reference.                      *)
+                        (*--------------------------------------------------*)
+                        then (if level=0
+                                 then 
+                                    let val (lit3,(ch,a3,q3)) = 
+                                       parseCharRefLit (c2::c1::lit) (a2,q2)
+                                    in doit (level,false,lit3,ch::text) (getChar(a3,q3))
+                                    end
+                              else let val (ch,a3,q3) = parseCharRef (a2,q2)
+                                   in doit (level,false,lit,ch::text) (getChar(a3,q3))
+                                   end)
+                           (* ignore errors in char references *)
+                           handle SyntaxError caq => doit (level,false,lit,text) caq
+                                | NoSuchChar aq => doit (level,false,lit,text) (getChar aq)
+                     (*-----------------------------------------------------*)
+                     (* it's a general entity reference.                    *)
+                     (*-----------------------------------------------------*)
+                     else let 
+                             val (fnd,lit3,text3,(c3,a3,q3)) = 
+                                parseEntName (c1::lit,c1::text) (c2,a2,q2)
+                             val (lit4,text4,caq4) = 
+                                if not fnd then (lit,text,(c3,a3,q3))
+                                else if c3=0wx3B (* #";" *) 
+                                        then (c3::lit3,c3::text3,(getChar(a3,q3)))
+                                     else let val err = ERR_EXPECTED(expSemi,[c3])
+                                              val a4 = hookError(a3,(getPos q3,err))
+                                          in (lit,text,(c3,a4,q3))
+                                          end
+                          in doit (level,false,lit4,text4) caq4
+                          end
+                       )
+                 end
+               | 0wx0A => doit (level,false,if level=0 then c1::lit else lit,
+                                if hadCr then text else c1::text) (getChar (a1,q1))
+               | 0wx0D => doit (level,true,if level=0 then c1::lit else lit,0wx0A::text) 
+                          (getChar (a1,q1))
+               | _ => if c1=quote andalso level=0 then (lit,text,getChar(a1,q1))
+                      else doit (level,false,if level=0 then c1::lit else lit,c1::text) 
+                         (getChar (a1,q1))
 
-	    val (lit,text,caq1) = doit (0,false,nil,nil) (getChar aq)
-	    val literal = Data2Vector(quote::rev(quote::lit))
-	    val repText = Data2Vector(rev text)
-	 in 
-	    (con(literal,repText),caq1)
-	 end
+            val (lit,text,caq1) = doit (0,false,nil,nil) (getChar aq)
+            val literal = Data2Vector(quote::rev(quote::lit))
+            val repText = Data2Vector(rev text)
+         in 
+            (con(literal,repText),caq1)
+         end
       (*--------------------------------------------------------------------*)
       (* parse an entity value.                                             *)
       (*                                                                    *)
@@ -11282,10 +11282,10 @@
       (* might raise: NotFound                                              *) 
       (*--------------------------------------------------------------------*)
       fun parseEntityValue dtd con (c,a,q) = 
-	 if c=0wx22 (* "'" *) orelse 
-	    c=0wx27 (* '"' *) 
-	    then parseEntityValue' dtd (c,con) (a,q)
-	 else raise NotFound (c,a,q)
+         if c=0wx22 (* "'" *) orelse 
+            c=0wx27 (* '"' *) 
+            then parseEntityValue' dtd (c,con) (a,q)
+         else raise NotFound (c,a,q)
 
       (*--------------------------------------------------------------------*)
       (* parse and normalize an attribute value, consume the final quote    *)
@@ -11337,79 +11337,79 @@
       (* might raise: NotFound                                              *) 
       (*--------------------------------------------------------------------*)
       fun parseAttValue dtd (quote,a,q) =
-	 let fun doit (lhlt as (level,lit,text)) (c1,a1,q1) = 
-	    case c1
-	      of 0wx00 => if level=0 then let val err = ERR_ENDED_BY_EE LOC_ATT_VALUE
-					      val a2 = hookError(a1,(getPos q1,err))
-					  in (lit,text,(c1,a2,q1))
-					  end
-			  else doit (level-1,lit,text) (getChar (a1,q1))
-	       | 0wx26 => (* #"&" *)
-		 let 
-		    val (c2,a2,q2) = getChar (a1,q1)
-		    val ((level1,lit1,text1),caq3) = 
-		       (if c2=0wx23 (* #"#" *)
-			   (*--------------------------------------------------*)
-			   (* it's a character reference.                      *)
-			   (*--------------------------------------------------*)
-			   then if level=0
-				   then 
-				      let val (lit3,(ch,a3,q3)) = 
-					 parseCharRefLit (c2::c1::lit) (a2,q2)
-				      in ((level,lit3,ch::text),getChar(a3,q3))
-				      end
-				else let val (ch,a3,q3) = parseCharRef (a2,q2)
-				     in ((level,lit,ch::text),getChar (a3,q3))
-				     end
-			(*-----------------------------------------------------*)
-			(* it's a general entity reference.                    *)
-			(*-----------------------------------------------------*)
-			else 
-			   let val (lit3,((id,ent),(a3,q3))) = 
-			      if level=0 then parseGenRefLit dtd (c1::lit) (c2,a2,q2)
-			      else (nil,parseGenRef dtd (c2,a2,q2))
-			   in case ent
-				of GE_NULL => ((level,lit3,text),getChar(a3,q3))
-				 | GE_INTERN(_,rep) => 
-				   let val q4 = pushIntern(q3,id,false,rep)
-				   in ((level+1,lit3,text),getChar (a3,q4))
-				   end
-				 | GE_EXTERN _ => 
-				   let val err = ERR_ILLEGAL_ENTITY
-				      (ENT_EXTERNAL,Index2GenEnt dtd id,LOC_ATT_VALUE)
-				       val a4 = hookError(a3,(getPos q2,err))
-				   in ((level,lit,text),getChar (a4,q3))
-				   end
-				   | GE_UNPARSED _ => raise InternalError
-				   (THIS_MODULE,"parseAttValue'",
-				    "parseGenRef returned GE_UNPARSED")
-			   end)
-			   (*------------------------------------------------------*)
-			   (* handle any errors in references by ignoring them.    *)
-			   (*------------------------------------------------------*)
-			   handle SyntaxError caq => ((level,lit,text),caq)
-				| NoSuchEntity aq => ((level,lit,text),getChar aq)
-				| NoSuchChar aq => ((level,lit,text),getChar aq)
-		 in doit (level1,lit1,text1) caq3
-		 end
-	       | 0wx3C => let val err = ERR_FORBIDDEN_HERE(IT_CHAR c1,LOC_ATT_VALUE)
-			      val a2 = hookError(a1,(getPos q1,err))
-			      val lit1 = if level=0 then c1::lit else lit
-			  in doit (level,lit1,c1::text) (getChar (a2,q1))
-			  end
-	       | _ => if isS c1 then doit (level,if level=0 then c1::lit else lit,0wx20::text) 
-			  (getChar (a1,q1))
-		      else (if c1=quote andalso level=0 then (lit,text,getChar (a1,q1))
-			    else doit (level,if level=0 then c1::lit else lit,c1::text) 
-			       (getChar (a1,q1)))
-	     
+         let fun doit (lhlt as (level,lit,text)) (c1,a1,q1) = 
+            case c1
+              of 0wx00 => if level=0 then let val err = ERR_ENDED_BY_EE LOC_ATT_VALUE
+                                              val a2 = hookError(a1,(getPos q1,err))
+                                          in (lit,text,(c1,a2,q1))
+                                          end
+                          else doit (level-1,lit,text) (getChar (a1,q1))
+               | 0wx26 => (* #"&" *)
+                 let 
+                    val (c2,a2,q2) = getChar (a1,q1)
+                    val ((level1,lit1,text1),caq3) = 
+                       (if c2=0wx23 (* #"#" *)
+                           (*--------------------------------------------------*)
+                           (* it's a character reference.                      *)
+                           (*--------------------------------------------------*)
+                           then if level=0
+                                   then 
+                                      let val (lit3,(ch,a3,q3)) = 
+                                         parseCharRefLit (c2::c1::lit) (a2,q2)
+                                      in ((level,lit3,ch::text),getChar(a3,q3))
+                                      end
+                                else let val (ch,a3,q3) = parseCharRef (a2,q2)
+                                     in ((level,lit,ch::text),getChar (a3,q3))
+                                     end
+                        (*-----------------------------------------------------*)
+                        (* it's a general entity reference.                    *)
+                        (*-----------------------------------------------------*)
+                        else 
+                           let val (lit3,((id,ent),(a3,q3))) = 
+                              if level=0 then parseGenRefLit dtd (c1::lit) (c2,a2,q2)
+                              else (nil,parseGenRef dtd (c2,a2,q2))
+                           in case ent
+                                of GE_NULL => ((level,lit3,text),getChar(a3,q3))
+                                 | GE_INTERN(_,rep) => 
+                                   let val q4 = pushIntern(q3,id,false,rep)
+                                   in ((level+1,lit3,text),getChar (a3,q4))
+                                   end
+                                 | GE_EXTERN _ => 
+                                   let val err = ERR_ILLEGAL_ENTITY
+                                      (ENT_EXTERNAL,Index2GenEnt dtd id,LOC_ATT_VALUE)
+                                       val a4 = hookError(a3,(getPos q2,err))
+                                   in ((level,lit,text),getChar (a4,q3))
+                                   end
+                                   | GE_UNPARSED _ => raise InternalError
+                                   (THIS_MODULE,"parseAttValue'",
+                                    "parseGenRef returned GE_UNPARSED")
+                           end)
+                           (*------------------------------------------------------*)
+                           (* handle any errors in references by ignoring them.    *)
+                           (*------------------------------------------------------*)
+                           handle SyntaxError caq => ((level,lit,text),caq)
+                                | NoSuchEntity aq => ((level,lit,text),getChar aq)
+                                | NoSuchChar aq => ((level,lit,text),getChar aq)
+                 in doit (level1,lit1,text1) caq3
+                 end
+               | 0wx3C => let val err = ERR_FORBIDDEN_HERE(IT_CHAR c1,LOC_ATT_VALUE)
+                              val a2 = hookError(a1,(getPos q1,err))
+                              val lit1 = if level=0 then c1::lit else lit
+                          in doit (level,lit1,c1::text) (getChar (a2,q1))
+                          end
+               | _ => if isS c1 then doit (level,if level=0 then c1::lit else lit,0wx20::text) 
+                          (getChar (a1,q1))
+                      else (if c1=quote andalso level=0 then (lit,text,getChar (a1,q1))
+                            else doit (level,if level=0 then c1::lit else lit,c1::text) 
+                               (getChar (a1,q1)))
+             
 
-	     val _ = if quote=0wx22 orelse quote=0wx27 (* "'",'"' *) then () 
-		     else raise NotFound (quote,a,q)
-	     val (lit,text,caq1) = doit (0,nil,nil) (getChar(a,q))
-	 in 
-	    (Data2Vector(quote::rev(quote::lit)),rev text,caq1)
-	 end
+             val _ = if quote=0wx22 orelse quote=0wx27 (* "'",'"' *) then () 
+                     else raise NotFound (quote,a,q)
+             val (lit,text,caq1) = doit (0,nil,nil) (getChar(a,q))
+         in 
+            (Data2Vector(quote::rev(quote::lit)),rev text,caq1)
+         end
    end
 (* stop of ../../Parser/Parse/parseLiterals.sml *)
 (* start of ../../Parser/Parse/parseTags.sml *)
@@ -11419,7 +11419,7 @@
       include ParseBase
 
       val parseName    : UniChar.Char * AppData * State 
-	 -> UniChar.Data * (UniChar.Char * AppData * State)
+         -> UniChar.Data * (UniChar.Char * AppData * State)
       val parseNmtoken : UniChar.Char * AppData * State 
          -> UniChar.Data * (UniChar.Char * AppData * State)
 
@@ -11430,47 +11430,47 @@
       val skipSmay : UniChar.Char * AppData * State -> bool * (UniChar.Char * AppData * State)
 
       val openExtern   : int * Uri.Uri -> AppData * State 
-	 -> Encoding.Encoding * HookData.TextDecl option * (UniChar.Char * AppData * State)
+         -> Encoding.Encoding * HookData.TextDecl option * (UniChar.Char * AppData * State)
       val openDocument : Uri.Uri option -> AppData 
-	 -> Encoding.Encoding * HookData.XmlDecl option * (UniChar.Char * AppData * State)
+         -> Encoding.Encoding * HookData.XmlDecl option * (UniChar.Char * AppData * State)
       val openSubset   : Uri.Uri -> AppData 
-	 -> Encoding.Encoding * HookData.TextDecl option * (UniChar.Char * AppData * State)
+         -> Encoding.Encoding * HookData.TextDecl option * (UniChar.Char * AppData * State)
 
       val skipCharRef     : AppData * State -> (UniChar.Char *  AppData * State)
       val skipReference   : UniChar.Char * AppData * State -> (UniChar.Char *  AppData * State)
       val parseGenRef     : Dtd -> UniChar.Char * AppData * State 
-	 -> (int * Base.GenEntity) * (AppData * State)
+         -> (int * Base.GenEntity) * (AppData * State)
       val parseParRef     : Dtd -> UniChar.Char * AppData * State 
-	 -> (int * Base.ParEntity) * (AppData * State)
+         -> (int * Base.ParEntity) * (AppData * State)
       val parseCharRefLit : UniChar.Data -> AppData * State 
-	 -> UniChar.Data * (UniChar.Char * AppData * State)
+         -> UniChar.Data * (UniChar.Char * AppData * State)
       val skipPS    : Dtd -> UniChar.Char * AppData * State 
-	 -> UniChar.Char * AppData * State
+         -> UniChar.Char * AppData * State
       val skipPSopt : Dtd -> UniChar.Char * AppData * State 
-	 -> UniChar.Char * AppData * State
+         -> UniChar.Char * AppData * State
       val skipPSmay : Dtd -> UniChar.Char * AppData * State 
-	 -> bool * (UniChar.Char * AppData * State)
+         -> bool * (UniChar.Char * AppData * State)
       val skipPSdec : Dtd -> UniChar.Char * AppData * State 
-	 -> bool * (UniChar.Char * AppData * State)
+         -> bool * (UniChar.Char * AppData * State)
 
       val parseSystemLiteral : UniChar.Char * AppData * State 
-	 -> Uri.Uri * UniChar.Char * (UniChar.Char * AppData * State)
+         -> Uri.Uri * UniChar.Char * (UniChar.Char * AppData * State)
       val parsePubidLiteral  : UniChar.Char * AppData * State 
-	 -> string * UniChar.Char * (UniChar.Char * AppData * State)
+         -> string * UniChar.Char * (UniChar.Char * AppData * State)
       val parseAttValue : Dtd -> UniChar.Char * AppData * State 
-	 -> UniChar.Vector * UniChar.Data * (UniChar.Char * AppData * State)
+         -> UniChar.Vector * UniChar.Data * (UniChar.Char * AppData * State)
       val parseEntityValue : Dtd -> (UniChar.Vector * UniChar.Vector -> 'a) 
-	 -> UniChar.Char * AppData * State 
-	 -> 'a * (UniChar.Char * AppData * State)
+         -> UniChar.Char * AppData * State 
+         -> 'a * (UniChar.Char * AppData * State)
       ----------------------------------------------------------------------*)
       include ParseLiterals
 
       val skipTag   : Errors.Location -> AppData * State -> (UniChar.Char * AppData * State)
 
       val parseETag : Dtd -> AppData * State 
-	 -> int * UniChar.Data * Errors.Position * (UniChar.Char * AppData * State)
+         -> int * UniChar.Data * Errors.Position * (UniChar.Char * AppData * State)
       val parseSTag : Dtd -> Errors.Position -> UniChar.Char * AppData * State 
-	 -> (HookData.StartTagInfo * Base.ElemInfo) * (UniChar.Char * AppData * State)
+         -> (HookData.StartTagInfo * Base.ElemInfo) * (UniChar.Char * AppData * State)
    end
 
 (*--------------------------------------------------------------------------*)
@@ -11512,35 +11512,35 @@
    (*--------------------------------------------------------------------*)
    fun parseETag dtd aq = 
       let
-	 val caq0 as (_,_,q0) = getChar aq
-	 val (elem,(c1,a1,q1)) = parseName caq0 
-	    handle NotFound (c,a,q) => let val err = expectedOrEnded (expAName,LOC_ETAG) c
-					   val a1 = hookError(a,(getPos q,err))
-					   val caq1 = recoverETag (c,a1,q)
-				       in raise SyntaxError caq1
-				       end
-	 val idx = Element2Index dtd elem
-	 val elemInfo as {decl,...} = getElement dtd idx
-	 val a1' = if isSome decl then a1 
-		   else let val a2 = if not (!O_VALIDATE andalso hasDtd dtd) then a1 
-				     else let val err = ERR_UNDECLARED(IT_ELEM,elem,LOC_ETAG)
+         val caq0 as (_,_,q0) = getChar aq
+         val (elem,(c1,a1,q1)) = parseName caq0 
+            handle NotFound (c,a,q) => let val err = expectedOrEnded (expAName,LOC_ETAG) c
+                                           val a1 = hookError(a,(getPos q,err))
+                                           val caq1 = recoverETag (c,a1,q)
+                                       in raise SyntaxError caq1
+                                       end
+         val idx = Element2Index dtd elem
+         val elemInfo as {decl,...} = getElement dtd idx
+         val a1' = if isSome decl then a1 
+                   else let val a2 = if not (!O_VALIDATE andalso hasDtd dtd) then a1 
+                                     else let val err = ERR_UNDECLARED(IT_ELEM,elem,LOC_ETAG)
                                               val a1' = hookError(a1,(getPos q0,err))
                                               val _ = if not (!O_ERROR_MINIMIZE) then ()
                                                       else ignore (handleUndeclElement dtd idx)
-					  in a1'
-					  end
-			in checkElemName (a2,q0) elem
-			end
+                                          in a1'
+                                          end
+                        in checkElemName (a2,q0) elem
+                        end
 
-	 val (cs,(c2,a2,q2)) = parseSopt nil (c1,a1',q1)
-	 val space = rev cs
+         val (cs,(c2,a2,q2)) = parseSopt nil (c1,a1',q1)
+         val space = rev cs
       in 
-	 if c2=0wx3E (* #">" *) then (idx,space,getPos q2,getChar(a2,q2))
-	 else let val err = expectedOrEnded (expGt,LOC_ETAG) c2
-		  val a3 = hookError(a2,(getPos q2,err))
-		  val caq3 = recoverETag(c2,a3,q2)
-	      in (idx,space,getPos q2,caq3)
-	      end
+         if c2=0wx3E (* #">" *) then (idx,space,getPos q2,getChar(a2,q2))
+         else let val err = expectedOrEnded (expGt,LOC_ETAG) c2
+                  val a3 = hookError(a2,(getPos q2,err))
+                  val caq3 = recoverETag(c2,a3,q2)
+              in (idx,space,getPos q2,caq3)
+              end
       end
 
    (*--------------------------------------------------------------------*)
@@ -11590,18 +11590,18 @@
    (*--------------------------------------------------------------------*)
    fun parseSTag dtd startPos (caq as (_,_,q)) = 
       let 
-	 val (elem,(c1,a1,q1)) = parseName caq 
-	    handle NotFound (c,a,q) => let val err = expectedOrEnded (expAName,LOC_STAG) c
-					   val a1 = hookError(a,(getPos q,err))
-					   val (_,caq1) = recoverSTag (c,a1,q)
-				       in raise SyntaxError (c,a1,q)
-				       end
-	 val eidx = Element2Index dtd elem
-	 val elemInfo as {atts,decl,...} = getElement dtd eidx
-	 val defs = case atts
-		      of NONE => nil
-		       | SOME (defs,_) => defs
-	 val (a1',elemInfo) = 
+         val (elem,(c1,a1,q1)) = parseName caq 
+            handle NotFound (c,a,q) => let val err = expectedOrEnded (expAName,LOC_STAG) c
+                                           val a1 = hookError(a,(getPos q,err))
+                                           val (_,caq1) = recoverSTag (c,a1,q)
+                                       in raise SyntaxError (c,a1,q)
+                                       end
+         val eidx = Element2Index dtd elem
+         val elemInfo as {atts,decl,...} = getElement dtd eidx
+         val defs = case atts
+                      of NONE => nil
+                       | SOME (defs,_) => defs
+         val (a1',elemInfo) = 
             if isSome decl then (a1,elemInfo)
             else 
                let val (a2,newInfo) = 
@@ -11615,94 +11615,94 @@
                in (checkElemName (a2,q) elem,newInfo)
                end
             
-	 val hscaq2 = parseSmay nil (c1,a1',q1)
-	       
-	 (*--------------------------------------------------------------*)	       
-	 (* yet are the indices of attributes encountered yet, old are   *)
-	 (* the valid attributes specified yet, and todo are the defs of *)
-	 (* attributes yet to be specified. hadS indicates whether white *)
-	 (* space preceded.                                              *)
-	 (*--------------------------------------------------------------*)	       
-	 fun doit (yet,old,todo) (hadS,(sp,(c,a,q))) = 
-	    case c 
-	      of 0wx3E (* #">" *) => (old,todo,sp,false,q,getChar(a,q))
-	       | 0wx2F (* #"/" *) => 
-		 let val (c1,a1,q1) = getChar(a,q) 
-		 in if c1=0wx3E (* #">" *) then (old,todo,sp,true,q1,getChar(a1,q1))
-		    else let val err = expectedOrEnded (expGt,LOC_STAG) c1
-			     val a2 = hookError(a1,(getPos q1,err))
-			     val (mt,caq2) = recoverSTag (c1,a2,q1)
-			 in (old,todo,sp,mt,q,caq2)
-			 end
-		 end
-	       | _ => 
-		 if not (isNms c) 
-		    then let val err = expectedOrEnded (expAttSTagEnd,LOC_STAG) c
-			     val a1 = hookError(a,(getPos q,err))
-			     val (mt,caq1) = recoverSTag (c,a1,q)
-			 in (old,todo,sp,mt,q,caq1)
-			 end
-		 else 
-		    let(* first parse the name of the attribute          *)  
-		       val (att,(c1,a1,q1)) = parseName (c,a,q)
-		       val a2 = if hadS then a1 
-				else hookError(a1,(getPos q,ERR_MISSING_WHITE))
-			     
-		       (* now get its index, check whether it already    *)
-		       (* occurred and get its definition.               *)
-		       val aidx = AttNot2Index dtd att
-		       val (hadIt,a3) = 
-			  if member aidx yet 
-			     then (true,hookError(a2,(getPos q,ERR_MULT_ATT_SPEC att)))
-			  else (false,a2)
+         val hscaq2 = parseSmay nil (c1,a1',q1)
+               
+         (*--------------------------------------------------------------*)            
+         (* yet are the indices of attributes encountered yet, old are   *)
+         (* the valid attributes specified yet, and todo are the defs of *)
+         (* attributes yet to be specified. hadS indicates whether white *)
+         (* space preceded.                                              *)
+         (*--------------------------------------------------------------*)            
+         fun doit (yet,old,todo) (hadS,(sp,(c,a,q))) = 
+            case c 
+              of 0wx3E (* #">" *) => (old,todo,sp,false,q,getChar(a,q))
+               | 0wx2F (* #"/" *) => 
+                 let val (c1,a1,q1) = getChar(a,q) 
+                 in if c1=0wx3E (* #">" *) then (old,todo,sp,true,q1,getChar(a1,q1))
+                    else let val err = expectedOrEnded (expGt,LOC_STAG) c1
+                             val a2 = hookError(a1,(getPos q1,err))
+                             val (mt,caq2) = recoverSTag (c1,a2,q1)
+                         in (old,todo,sp,mt,q,caq2)
+                         end
+                 end
+               | _ => 
+                 if not (isNms c) 
+                    then let val err = expectedOrEnded (expAttSTagEnd,LOC_STAG) c
+                             val a1 = hookError(a,(getPos q,err))
+                             val (mt,caq1) = recoverSTag (c,a1,q)
+                         in (old,todo,sp,mt,q,caq1)
+                         end
+                 else 
+                    let(* first parse the name of the attribute          *)  
+                       val (att,(c1,a1,q1)) = parseName (c,a,q)
+                       val a2 = if hadS then a1 
+                                else hookError(a1,(getPos q,ERR_MISSING_WHITE))
+                             
+                       (* now get its index, check whether it already    *)
+                       (* occurred and get its definition.               *)
+                       val aidx = AttNot2Index dtd att
+                       val (hadIt,a3) = 
+                          if member aidx yet 
+                             then (true,hookError(a2,(getPos q,ERR_MULT_ATT_SPEC att)))
+                          else (false,a2)
 
-		       val (def,rest) = findAndDelete (fn (i,_,_,_) => i=aidx) todo
-		       val a4 = if isSome def orelse hadIt then a3
-				else handleUndeclAtt dtd (a3,q) (aidx,att,eidx,elem) 
+                       val (def,rest) = findAndDelete (fn (i,_,_,_) => i=aidx) todo
+                       val a4 = if isSome def orelse hadIt then a3
+                                else handleUndeclAtt dtd (a3,q) (aidx,att,eidx,elem) 
 
-		       (* consume the " = ", ignore errors               *)
-		       val (eq,caq5 as (_,_,q5)) = parseEq (c1,a4,q1) 
-			  handle SyntaxError caq => ([0wx3D],caq)
-			     
-		       (* now parse the attribute value                  *)
-		       val (literal,value,(c6,a6,q6)) = parseAttValue dtd caq5
+                       (* consume the " = ", ignore errors               *)
+                       val (eq,caq5 as (_,_,q5)) = parseEq (c1,a4,q1) 
+                          handle SyntaxError caq => ([0wx3D],caq)
+                             
+                       (* now parse the attribute value                  *)
+                       val (literal,value,(c6,a6,q6)) = parseAttValue dtd caq5
 
-		       (* possibly make a new AttSpec                    *)
-		       val space = rev sp
-		       val (new,a7) = 
-			  if hadIt then (old,a6) 
-			  else case def 
-				 of NONE => 
-				    if !O_VALIDATE andalso hasDtd dtd then (old,a6)
-				    else (let val (attVal,a7) = checkAttValue dtd (a6,q5) 
-					     (defaultAttDef aidx,literal,value)
-					  in ((aidx,attVal,SOME(space,eq))::old,a7)
-					  end
-					     handle AttValue a => (old,a))
-				  | SOME ad => 
-				       let val (attVal,a7) = checkAttValue dtd (a6,q5) 
-					  (ad,literal,value)
-				       in ((aidx,attVal,SOME(space,eq))::old,a7)
-				       end
-				    handle AttValue a => (old,a)
-		       val hscaq8 = parseSmay nil (c6,a7,q6)
-		    in 
-		       doit (aidx::yet,new,rest) hscaq8 
-		    end
-		 handle NotFound (c,a,q) (* raised by parseAttValue above     *)
-		 => let val err = expectedOrEnded (expLitQuote,LOC_STAG) c
-			val a1 = hookError(a,(getPos q,err))
-			val (mt,caq1) = recoverSTag (c,a1,q)
-		    in (old,todo,sp,mt,q,caq1)
-		    end
-		    
-	 val (specd,todo,sp,empty,qe,(c3,a3,q3)) = doit (nil,nil,defs) hscaq2
-	 val space = rev sp
+                       (* possibly make a new AttSpec                    *)
+                       val space = rev sp
+                       val (new,a7) = 
+                          if hadIt then (old,a6) 
+                          else case def 
+                                 of NONE => 
+                                    if !O_VALIDATE andalso hasDtd dtd then (old,a6)
+                                    else (let val (attVal,a7) = checkAttValue dtd (a6,q5) 
+                                             (defaultAttDef aidx,literal,value)
+                                          in ((aidx,attVal,SOME(space,eq))::old,a7)
+                                          end
+                                             handle AttValue a => (old,a))
+                                  | SOME ad => 
+                                       let val (attVal,a7) = checkAttValue dtd (a6,q5) 
+                                          (ad,literal,value)
+                                       in ((aidx,attVal,SOME(space,eq))::old,a7)
+                                       end
+                                    handle AttValue a => (old,a)
+                       val hscaq8 = parseSmay nil (c6,a7,q6)
+                    in 
+                       doit (aidx::yet,new,rest) hscaq8 
+                    end
+                 handle NotFound (c,a,q) (* raised by parseAttValue above     *)
+                 => let val err = expectedOrEnded (expLitQuote,LOC_STAG) c
+                        val a1 = hookError(a,(getPos q,err))
+                        val (mt,caq1) = recoverSTag (c,a1,q)
+                    in (old,todo,sp,mt,q,caq1)
+                    end
+                    
+         val (specd,todo,sp,empty,qe,(c3,a3,q3)) = doit (nil,nil,defs) hscaq2
+         val space = rev sp
 
-	 (* generate the defaults for unspecified attributes *)
-	 val (all,a4) = genMissingAtts dtd (a3,qe) (todo,rev specd)
+         (* generate the defaults for unspecified attributes *)
+         val (all,a4) = genMissingAtts dtd (a3,qe) (todo,rev specd)
       in 
-	 ((((startPos,getPos q3),eidx,all,space,empty),elemInfo),(c3,a4,q3))
+         ((((startPos,getPos q3),eidx,all,space,empty),elemInfo),(c3,a4,q3))
       end
 
    (*--------------------------------------------------------------------*)
@@ -11719,29 +11719,29 @@
    (*--------------------------------------------------------------------*)
    fun skipTag loc aq = 
       let 
-	 fun do_lit ch (c,a,q) =
-	    if c=0wx00 then let val a1 = hookError(a,(getPos q,ERR_ENDED_BY_EE loc))
-			    in (c,a1,q)
-			    end
-	    else if c=ch then doit (getChar(a,q))
-		 else do_lit ch (getChar(a,q))
-		       
-	 and doit (c,a,q) =
-	    case c
-	      of 0wx00 => let val a1 = hookError(a,(getPos q,ERR_ENDED_BY_EE loc))
-			  in (c,a1,q)
-			  end
-	       | 0wx22 (* #"\""*) => do_lit c (getChar(a,q))
-	       | 0wx27 (* #"'" *) => do_lit c (getChar(a,q))
-	       | 0wx2F (* #"/" *) => (case getChar(a,q)
-					of (0wx3E,a1,q1) (* #">" *) => getChar(a1,q1) 
-					 | caq1 => doit caq1)
-	       | 0wx3E (* #">" *) => getChar(a,q)
-	       | _ => doit(getChar(a,q))
+         fun do_lit ch (c,a,q) =
+            if c=0wx00 then let val a1 = hookError(a,(getPos q,ERR_ENDED_BY_EE loc))
+                            in (c,a1,q)
+                            end
+            else if c=ch then doit (getChar(a,q))
+                 else do_lit ch (getChar(a,q))
+                       
+         and doit (c,a,q) =
+            case c
+              of 0wx00 => let val a1 = hookError(a,(getPos q,ERR_ENDED_BY_EE loc))
+                          in (c,a1,q)
+                          end
+               | 0wx22 (* #"\""*) => do_lit c (getChar(a,q))
+               | 0wx27 (* #"'" *) => do_lit c (getChar(a,q))
+               | 0wx2F (* #"/" *) => (case getChar(a,q)
+                                        of (0wx3E,a1,q1) (* #">" *) => getChar(a1,q1) 
+                                         | caq1 => doit caq1)
+               | 0wx3E (* #">" *) => getChar(a,q)
+               | _ => doit(getChar(a,q))
       in doit (getChar aq)
       end
 end
-			
+                        
 (* stop of ../../Parser/Parse/parseTags.sml *)
 (* start of ../../Parser/Parse/parseDecl.sml *)
 signature ParseDecl =
@@ -11750,7 +11750,7 @@
       include ParseBase
 
       val parseName    : UniChar.Char * AppData * State 
-	 -> UniChar.Data * (UniChar.Char * AppData * State)
+         -> UniChar.Data * (UniChar.Char * AppData * State)
 
       val parseComment   : Errors.Position -> AppData * State -> (UniChar.Char * AppData * State)
       val parseProcInstr : Errors.Position -> AppData * State -> (UniChar.Char * AppData * State)
@@ -11759,44 +11759,44 @@
       val skipSmay : UniChar.Char * AppData * State -> bool * (UniChar.Char * AppData * State)
 
       val openExtern   : int * Uri.Uri -> AppData * State 
-	 -> Encoding.Encoding * HookData.TextDecl option * (UniChar.Char * AppData * State)
+         -> Encoding.Encoding * HookData.TextDecl option * (UniChar.Char * AppData * State)
       val openDocument : Uri.Uri option -> AppData 
-	 -> Encoding.Encoding * HookData.XmlDecl option * (UniChar.Char * AppData * State)
+         -> Encoding.Encoding * HookData.XmlDecl option * (UniChar.Char * AppData * State)
       val openSubset   : Uri.Uri -> AppData 
-	 -> Encoding.Encoding * HookData.TextDecl option * (UniChar.Char * AppData * State)
+         -> Encoding.Encoding * HookData.TextDecl option * (UniChar.Char * AppData * State)
 
       val skipCharRef     : AppData * State -> (UniChar.Char *  AppData * State)
       val skipReference   : UniChar.Char * AppData * State -> (UniChar.Char *  AppData * State)
       val parseGenRef     : Dtd -> UniChar.Char * AppData * State 
-	 -> (int * Base.GenEntity) * (AppData * State)
+         -> (int * Base.GenEntity) * (AppData * State)
       val parseParRef     : Dtd -> UniChar.Char * AppData * State 
-	 -> (int * Base.ParEntity) * (AppData * State)
+         -> (int * Base.ParEntity) * (AppData * State)
       val parseCharRefLit : UniChar.Data -> AppData * State 
-	 -> UniChar.Data * (UniChar.Char * AppData * State)
+         -> UniChar.Data * (UniChar.Char * AppData * State)
       val skipPSopt       : Dtd -> UniChar.Char * AppData * State 
-	 -> UniChar.Char * AppData * State
+         -> UniChar.Char * AppData * State
 
       val skipTag   : Errors.Location -> AppData * State -> (UniChar.Char * AppData * State)
       val parseETag : Dtd -> AppData * State 
-	 -> int * UniChar.Data * Errors.Position * (UniChar.Char * AppData * State)
+         -> int * UniChar.Data * Errors.Position * (UniChar.Char * AppData * State)
       val parseSTag : Dtd -> Errors.Position -> UniChar.Char * AppData * State 
-	 -> (HookData.StartTagInfo * Base.ElemInfo) * (UniChar.Char * AppData * State)
+         -> (HookData.StartTagInfo * Base.ElemInfo) * (UniChar.Char * AppData * State)
       ----------------------------------------------------------------------*)
       include ParseTags
 
       val skipDecl : bool -> UniChar.Char * AppData * State -> UniChar.Char * AppData * State
 
       val parseExtIdSub : Dtd -> UniChar.Char * AppData * State 
-	 -> Base.ExternalId * bool * (UniChar.Char * AppData * State) 
+         -> Base.ExternalId * bool * (UniChar.Char * AppData * State) 
       
       val parseEntityDecl   : Dtd -> EntId * Errors.Position * bool 
-	 -> UniChar.Char * AppData * State -> UniChar.Char * AppData * State 
+         -> UniChar.Char * AppData * State -> UniChar.Char * AppData * State 
       val parseElementDecl  : Dtd -> EntId * Errors.Position * bool 
-	 -> UniChar.Char * AppData * State -> UniChar.Char * AppData * State 
+         -> UniChar.Char * AppData * State -> UniChar.Char * AppData * State 
       val parseNotationDecl : Dtd -> EntId * Errors.Position * bool 
-	 -> UniChar.Char * AppData * State -> UniChar.Char * AppData * State 
+         -> UniChar.Char * AppData * State -> UniChar.Char * AppData * State 
       val parseAttListDecl  : Dtd -> EntId * Errors.Position * bool 
-	 -> UniChar.Char * AppData * State -> UniChar.Char * AppData * State 
+         -> UniChar.Char * AppData * State -> UniChar.Char * AppData * State 
    end
 
 (*--------------------------------------------------------------------------*)
@@ -11833,32 +11833,32 @@
    (*--------------------------------------------------------------------*)
    fun skipDecl hasSubset caq = 
       let 
-	 fun do_lit ch (c,a,q) =
-	    if c=0wx00 then (c,a,q)
-	    else if c=ch then getChar (a,q)
-		 else do_lit ch (getChar(a,q))
-	 fun do_decl (c,a,q) =
-	    case c
-	      of 0wx00 => (c,a,q)
-	       | 0wx22 (* #"\""" *) => do_decl (do_lit c (getChar(a,q)))
-	       | 0wx27 (* #"'" *) => do_decl (do_lit c (getChar(a,q)))
-	       | 0wx3E (* #">" *) => getChar(a,q)
-	       | _ => do_decl (getChar(a,q))
+         fun do_lit ch (c,a,q) =
+            if c=0wx00 then (c,a,q)
+            else if c=ch then getChar (a,q)
+                 else do_lit ch (getChar(a,q))
+         fun do_decl (c,a,q) =
+            case c
+              of 0wx00 => (c,a,q)
+               | 0wx22 (* #"\""" *) => do_decl (do_lit c (getChar(a,q)))
+               | 0wx27 (* #"'" *) => do_decl (do_lit c (getChar(a,q)))
+               | 0wx3E (* #">" *) => getChar(a,q)
+               | _ => do_decl (getChar(a,q))
          fun do_subset (c,a,q) =
-	    case c
-	      of 0wx00 => (c,a,q)
-	       | 0wx3C (* #"<" *) => do_subset (do_decl (getChar(a,q)))
-	       | 0wx5D (* #"]" *) => getChar(a,q)
-	       | _ => do_subset (getChar(a,q))
-	 fun doit (c,a,q) =
-	    case c
-	      of 0wx00 => (c,hookError(a,(getPos q,ERR_ENDED_BY_EE LOC_DECL)),q) 
-	       | 0wx22 (* #"\"""*) => doit (do_lit c (getChar(a,q)))
-	       | 0wx27 (* #"'" *) => doit (do_lit c (getChar(a,q)))
-	       | 0wx3E (* #">" *) => getChar(a,q)
-	       | 0wx5B (* #"[" *) => if hasSubset then doit (do_subset (getChar(a,q)))
-				     else doit (getChar(a,q))
-	       | _ => doit (getChar(a,q))
+            case c
+              of 0wx00 => (c,a,q)
+               | 0wx3C (* #"<" *) => do_subset (do_decl (getChar(a,q)))
+               | 0wx5D (* #"]" *) => getChar(a,q)
+               | _ => do_subset (getChar(a,q))
+         fun doit (c,a,q) =
+            case c
+              of 0wx00 => (c,hookError(a,(getPos q,ERR_ENDED_BY_EE LOC_DECL)),q) 
+               | 0wx22 (* #"\"""*) => doit (do_lit c (getChar(a,q)))
+               | 0wx27 (* #"'" *) => doit (do_lit c (getChar(a,q)))
+               | 0wx3E (* #">" *) => getChar(a,q)
+               | 0wx5B (* #"[" *) => if hasSubset then doit (do_subset (getChar(a,q)))
+                                     else doit (getChar(a,q))
+               | _ => doit (getChar(a,q))
       in doit caq
       end
    
@@ -11885,51 +11885,51 @@
    (*--------------------------------------------------------------------*)
    fun parseExternalId dtd optSys (caq as (_,_,q))=
       let 
-	 (* do not handle NotFound: in this case no extId was found *)
-	 val (name,caq1) = parseName caq
-	 val caq2 as (_,_,q2)= skipPS dtd caq1 
+         (* do not handle NotFound: in this case no extId was found *)
+         val (name,caq1) = parseName caq
+         val caq2 as (_,_,q2)= skipPS dtd caq1 
       in 
-	 case name
-	   of [0wx50,0wx55,0wx42,0wx4c,0wx49,0wx43] => (* "PUBLIC" *)
-	      let 
-		 val (pub,pquote,caq3) = parsePubidLiteral caq2
-		    handle NotFound (c,a,q) => let val err = ERR_EXPECTED(expLitQuote,[c])
-						   val a1 = hookError(a,(getPos q,err))
-					       in raise SyntaxError (c,a1,q)
-					       end 
-		 val (hadS,caq4 as (_,_,q4)) = skipPSmay dtd caq3
-	      in let 
-		    val (sys,squote,(c5,a5,q5)) = parseSystemLiteral caq4
-		    val base = getUri q4
-		    val a6 = if hadS then a5 else hookError(a5,(getPos q4,ERR_MISSING_WHITE))
-		    val (hadS6,caq6) = skipPSmay dtd (c5,a6,q5)
-		 in 
-		    (EXTID(SOME(pub,pquote),SOME(base,sys,squote)),hadS6,caq6)
-		 end
-	      handle NotFound (c,a,q) => (* no system id *)
-		 if optSys then (EXTID(SOME(pub,pquote),NONE),hadS,(c,a,q))
-		 else let val a1 = hookError(a,(getPos q,ERR_EXPECTED(expLitQuote,[c])))
-		      in raise SyntaxError (c,a1,q)
-		      end
-	      end
-	      
-	    | [0wx53,0wx59,0wx53,0wx54,0wx45,0wx4d] => (* "SYSTEM" *)
-	      let 
-		 val (sys,squote,caq3) = parseSystemLiteral caq2
-		    handle NotFound (c,a,q) => let val err = ERR_EXPECTED(expLitQuote,[c])
-						   val a1 = hookError(a,(getPos q,err))
-					       in raise SyntaxError (c,a1,q)
-					       end
-		 val base = getUri q2
-		 val (hadS,caq4) = skipPSmay dtd caq3
-	      in 
-		 (EXTID(NONE,SOME(base,sys,squote)),hadS,caq4)
-	      end
+         case name
+           of [0wx50,0wx55,0wx42,0wx4c,0wx49,0wx43] => (* "PUBLIC" *)
+              let 
+                 val (pub,pquote,caq3) = parsePubidLiteral caq2
+                    handle NotFound (c,a,q) => let val err = ERR_EXPECTED(expLitQuote,[c])
+                                                   val a1 = hookError(a,(getPos q,err))
+                                               in raise SyntaxError (c,a1,q)
+                                               end 
+                 val (hadS,caq4 as (_,_,q4)) = skipPSmay dtd caq3
+              in let 
+                    val (sys,squote,(c5,a5,q5)) = parseSystemLiteral caq4
+                    val base = getUri q4
+                    val a6 = if hadS then a5 else hookError(a5,(getPos q4,ERR_MISSING_WHITE))
+                    val (hadS6,caq6) = skipPSmay dtd (c5,a6,q5)
+                 in 
+                    (EXTID(SOME(pub,pquote),SOME(base,sys,squote)),hadS6,caq6)
+                 end
+              handle NotFound (c,a,q) => (* no system id *)
+                 if optSys then (EXTID(SOME(pub,pquote),NONE),hadS,(c,a,q))
+                 else let val a1 = hookError(a,(getPos q,ERR_EXPECTED(expLitQuote,[c])))
+                      in raise SyntaxError (c,a1,q)
+                      end
+              end
+              
+            | [0wx53,0wx59,0wx53,0wx54,0wx45,0wx4d] => (* "SYSTEM" *)
+              let 
+                 val (sys,squote,caq3) = parseSystemLiteral caq2
+                    handle NotFound (c,a,q) => let val err = ERR_EXPECTED(expLitQuote,[c])
+                                                   val a1 = hookError(a,(getPos q,err))
+                                               in raise SyntaxError (c,a1,q)
+                                               end
+                 val base = getUri q2
+                 val (hadS,caq4) = skipPSmay dtd caq3
+              in 
+                 (EXTID(NONE,SOME(base,sys,squote)),hadS,caq4)
+              end
 
-	    | _ => let val (c2,a2,q2) = caq2
-		       val a3 = hookError(a2,(getPos q,ERR_EXPECTED(expExtId,name)))
-		   in raise SyntaxError (c2,a3,q2)
-		   end
+            | _ => let val (c2,a2,q2) = caq2
+                       val a3 = hookError(a2,(getPos q,ERR_EXPECTED(expExtId,name)))
+                   in raise SyntaxError (c2,a3,q2)
+                   end
       end
    (*--------------------------------------------------------------------*)
    (* parse an external id in an entity definition. Cf. 4.2.2:           *)
@@ -11940,8 +11940,8 @@
    (*--------------------------------------------------------------------*)
    fun parseExtIdEnt dtd caq = parseExternalId dtd false caq
       handle NotFound (c,a,q) => let val err = ERR_EXPECTED(expLitQuotExt,[c])
-				 in raise SyntaxError (c,hookError(a,(getPos q,err)),q)
-				 end
+                                 in raise SyntaxError (c,hookError(a,(getPos q,err)),q)
+                                 end
    (*--------------------------------------------------------------------*)
    (* parse an external or public id in a notation declaration.          *)
    (*                                                                    *) 
@@ -11952,8 +11952,8 @@
    (*--------------------------------------------------------------------*)
    fun parseExtIdNot dtd caq = parseExternalId dtd true caq
       handle NotFound (c,a,q) => let val err = ERR_EXPECTED(expExtId,[c])
-				 in raise SyntaxError (c,hookError(a,(getPos q,err)),q)
-				 end
+                                 in raise SyntaxError (c,hookError(a,(getPos q,err)),q)
+                                 end
    (*--------------------------------------------------------------------*)
    (* parse an external id for the external subset.                      *)
    (*                                                                    *) 
@@ -11985,36 +11985,36 @@
    (*--------------------------------------------------------------------*)
    fun parseParEntDecl dtd (startEnt,startPos,ext) caq =
       let 
-	 val caq1 as (_,_,q1) = skipPS dtd caq 
+         val caq1 as (_,_,q1) = skipPS dtd caq 
 
-	 val (name,caq2) = parseName caq1
-	    handle NotFound (c,a,q) => let val err = ERR_EXPECTED(expAnEntName,[c]) 
-				       in raise SyntaxError (c,hookError(a,(getPos q,err)),q)
-				       end
-	 val idx = ParEnt2Index dtd name
-	 val caq3 = skipPS dtd caq2 
+         val (name,caq2) = parseName caq1
+            handle NotFound (c,a,q) => let val err = ERR_EXPECTED(expAnEntName,[c]) 
+                                       in raise SyntaxError (c,hookError(a,(getPos q,err)),q)
+                                       end
+         val idx = ParEnt2Index dtd name
+         val caq3 = skipPS dtd caq2 
 
-	 val (ent,(c4,a4,q4)) = 
-	    let val (ent,caq4) = parseEntityValue dtd PE_INTERN caq3
-	        val caq5 = skipPSopt dtd caq4
-	    in (ent,caq5)
-	    end
-	 handle NotFound caq => 
-	    let val (extId,_,caq1) = parseExtIdEnt dtd caq
-	    in (PE_EXTERN extId,caq1)
-	    end
+         val (ent,(c4,a4,q4)) = 
+            let val (ent,caq4) = parseEntityValue dtd PE_INTERN caq3
+                val caq5 = skipPSopt dtd caq4
+            in (ent,caq5)
+            end
+         handle NotFound caq => 
+            let val (extId,_,caq1) = parseExtIdEnt dtd caq
+            in (PE_EXTERN extId,caq1)
+            end
 
-	 val a5 = if useParamEnts() orelse not ext then addParEnt dtd (a4,q1) (idx,ent,ext) else a4
-	 val a6 = hookDecl(a5,((startPos,getPos q4),DEC_PAR_ENT(idx,ent,ext)))
+         val a5 = if useParamEnts() orelse not ext then addParEnt dtd (a4,q1) (idx,ent,ext) else a4
+         val a6 = hookDecl(a5,((startPos,getPos q4),DEC_PAR_ENT(idx,ent,ext)))
       in 
-	 if c4<>0wx3E (* #">" *) 
-	    then let val a7 = hookError(a6,(getPos q4,ERR_EXPECTED(expGt,[c4])))
-		 in raise SyntaxError(c4,a7,q4)
-		 end
-	 else let val a7 = if not (!O_VALIDATE) orelse getEntId q4=startEnt then a6
-			   else hookError(a6,(getPos q4,ERR_DECL_ENT_NESTING LOC_ENT_DECL))
-	      in getChar(a7,q4)
-	      end
+         if c4<>0wx3E (* #">" *) 
+            then let val a7 = hookError(a6,(getPos q4,ERR_EXPECTED(expGt,[c4])))
+                 in raise SyntaxError(c4,a7,q4)
+                 end
+         else let val a7 = if not (!O_VALIDATE) orelse getEntId q4=startEnt then a6
+                           else hookError(a6,(getPos q4,ERR_DECL_ENT_NESTING LOC_ENT_DECL))
+              in getChar(a7,q4)
+              end
       end
 
    (*--------------------------------------------------------------------*)
@@ -12052,72 +12052,72 @@
    (*--------------------------------------------------------------------*)
    fun parseGenEntDecl dtd (startEnt,startPos,ext) (caq as (_,_,q)) =
       let 
-	 val (name,caq1) = parseName caq
-	    handle NotFound (c,a,q) => let val err = ERR_EXPECTED(expEntNamePero,[c]) 
-				       in raise SyntaxError (c,hookError(a,(getPos q,err)),q)
-				       end
-	 val idx = GenEnt2Index dtd name
-	 val caq2 = skipPS dtd caq1 
+         val (name,caq1) = parseName caq
+            handle NotFound (c,a,q) => let val err = ERR_EXPECTED(expEntNamePero,[c]) 
+                                       in raise SyntaxError (c,hookError(a,(getPos q,err)),q)
+                                       end
+         val idx = GenEnt2Index dtd name
+         val caq2 = skipPS dtd caq1 
 
-	 val (ent,expEnd,(c3,a3,q3)) = 
-	    (*-----------------------------------------------------------*)
-	    (* Try for an internal entity. Then '>' must follow.         *)
-	    (*-----------------------------------------------------------*)
-	    let 
-	       val (ent,caq3) = parseEntityValue dtd GE_INTERN caq2
-	       val caq4 = skipPSopt dtd caq3
-	    in 
-	       (ent,expGt,caq4)
-	    end
-	 handle NotFound cq => (* raised by parseEntityValue *)
-	    (*-----------------------------------------------------------*)
-	    (* Must be external. First parse the external identifier.    *)
-	    (*-----------------------------------------------------------*)
-	    let 
-	       val (extId,hadS,caq1 as (_,_,q1)) = parseExtIdEnt dtd caq2
-	    in let 
-		  (*-----------------------------------------------------*)
-		  (* Does a name follow? Then is must be 'NDATA' and the *)
-		  (* notation name follows. Thus the entity is unparsed. *)
-		  (* Also, only '>' may come next.                       *)
-		  (* NotFound is handled at the end of the let.          *)
-		  (*-----------------------------------------------------*)
-		  val (key,(c2,a2,q2)) = parseName caq1 
-		  val a3 = if hadS then a2 else hookError(a2,(getPos q1,ERR_MISSING_WHITE))
-		  val a4 = if key = [0wx4e,0wx44,0wx41,0wx54,0wx41] (* "NDATA" *) then a3
-			   else hookError(a3,(getPos q1,ERR_EXPECTED(expGtNdata,key)))
-				 
-		  val caq5 as (_,_,q5) = skipPS dtd (c2,a4,q2) 
-			   
-		  val (not,caq6) = parseName caq5
-		     handle NotFound (c,a,q) => let val err = ERR_EXPECTED(expANotName,[c])
-						    val a1 = hookError(a,(getPos q,err))
-						in raise SyntaxError (c,a1,q)
-						end
-		  val notIdx = AttNot2Index dtd not
-		  val caq7 = skipPSopt dtd caq6
-	       in 
-		  (GE_UNPARSED(extId,notIdx,getPos q5),expGt,caq7)
-	       end
-	    handle NotFound caq => 
-	       (*--------------------------------------------------------*)
-	       (* No 'NDATA' present, so it's parsed external entity.    *)
-	       (* A 'NDATA' might have followed.                         *)
-	       (*--------------------------------------------------------*)
-	       (GE_EXTERN extId,expGtNdata,caq)
-	    end
-		       
-	 val a4 = if useParamEnts() orelse not ext then addGenEnt dtd (a3,q) (idx,ent,ext) else a3
-	 val a5 = hookDecl(a4,((startPos,getPos q3),DEC_GEN_ENT(idx,ent,ext)))
+         val (ent,expEnd,(c3,a3,q3)) = 
+            (*-----------------------------------------------------------*)
+            (* Try for an internal entity. Then '>' must follow.         *)
+            (*-----------------------------------------------------------*)
+            let 
+               val (ent,caq3) = parseEntityValue dtd GE_INTERN caq2
+               val caq4 = skipPSopt dtd caq3
+            in 
+               (ent,expGt,caq4)
+            end
+         handle NotFound cq => (* raised by parseEntityValue *)
+            (*-----------------------------------------------------------*)
+            (* Must be external. First parse the external identifier.    *)
+            (*-----------------------------------------------------------*)
+            let 
+               val (extId,hadS,caq1 as (_,_,q1)) = parseExtIdEnt dtd caq2
+            in let 
+                  (*-----------------------------------------------------*)
+                  (* Does a name follow? Then is must be 'NDATA' and the *)
+                  (* notation name follows. Thus the entity is unparsed. *)
+                  (* Also, only '>' may come next.                       *)
+                  (* NotFound is handled at the end of the let.          *)
+                  (*-----------------------------------------------------*)
+                  val (key,(c2,a2,q2)) = parseName caq1 
+                  val a3 = if hadS then a2 else hookError(a2,(getPos q1,ERR_MISSING_WHITE))
+                  val a4 = if key = [0wx4e,0wx44,0wx41,0wx54,0wx41] (* "NDATA" *) then a3
+                           else hookError(a3,(getPos q1,ERR_EXPECTED(expGtNdata,key)))
+                                 
+                  val caq5 as (_,_,q5) = skipPS dtd (c2,a4,q2) 
+                           
+                  val (not,caq6) = parseName caq5
+                     handle NotFound (c,a,q) => let val err = ERR_EXPECTED(expANotName,[c])
+                                                    val a1 = hookError(a,(getPos q,err))
+                                                in raise SyntaxError (c,a1,q)
+                                                end
+                  val notIdx = AttNot2Index dtd not
+                  val caq7 = skipPSopt dtd caq6
+               in 
+                  (GE_UNPARSED(extId,notIdx,getPos q5),expGt,caq7)
+               end
+            handle NotFound caq => 
+               (*--------------------------------------------------------*)
+               (* No 'NDATA' present, so it's parsed external entity.    *)
+               (* A 'NDATA' might have followed.                         *)
+               (*--------------------------------------------------------*)
+               (GE_EXTERN extId,expGtNdata,caq)
+            end
+                       
+         val a4 = if useParamEnts() orelse not ext then addGenEnt dtd (a3,q) (idx,ent,ext) else a3
+         val a5 = hookDecl(a4,((startPos,getPos q3),DEC_GEN_ENT(idx,ent,ext)))
       in 
-	 if c3<>0wx3E (* #">" *) 
-	    then let val a6 = hookError(a5,(getPos q3,ERR_EXPECTED(expGt,[c3])))
-		 in raise SyntaxError(c3,a6,q3)
-		 end
-	 else let val a6 = if not (!O_VALIDATE) orelse getEntId q3=startEnt then a5
-			   else hookError(a5,(getPos q3,ERR_DECL_ENT_NESTING LOC_ENT_DECL))
-	      in getChar(a6,q3)
-	      end
+         if c3<>0wx3E (* #">" *) 
+            then let val a6 = hookError(a5,(getPos q3,ERR_EXPECTED(expGt,[c3])))
+                 in raise SyntaxError(c3,a6,q3)
+                 end
+         else let val a6 = if not (!O_VALIDATE) orelse getEntId q3=startEnt then a5
+                           else hookError(a5,(getPos q3,ERR_DECL_ENT_NESTING LOC_ENT_DECL))
+              in getChar(a6,q3)
+              end
       end
 
    (*--------------------------------------------------------------------*)
@@ -12144,14 +12144,14 @@
    (*--------------------------------------------------------------------*)
    fun parseEntityDecl dtd pars caq = 
       let 
-	 val (hadPero,caq1) = skipPSdec dtd caq 
+         val (hadPero,caq1) = skipPSdec dtd caq 
       in 
-	 if hadPero then parseParEntDecl dtd pars caq1
-	 else parseGenEntDecl dtd pars caq1
+         if hadPero then parseParEntDecl dtd pars caq1
+         else parseGenEntDecl dtd pars caq1
       end
    handle exn as SyntaxError (c,a,q) => 
       let val a1 = if c=0wx00 then hookError(a,(getPos q,ERR_ENDED_BY_EE LOC_ENT_DECL)) 
-		   else a
+                   else a
       in recoverDecl false (c,a1,q)
       end
 
@@ -12179,31 +12179,31 @@
    (*--------------------------------------------------------------------*)
    fun parseNotationDecl dtd (startEnt,startPos,ext) caq =
       let 
-	 val caq1 as (_,_,q1) = skipPS dtd caq 
-	 val (name,caq2) = parseName caq1
-	    handle NotFound (c,a,q) => let val err = ERR_EXPECTED(expANotName,[c]) 
-				       in raise SyntaxError (c,hookError(a,(getPos q,err)),q)
-				       end
-	 val idx = AttNot2Index dtd name
-	 val caq3 = skipPS dtd caq2 
-	       
-	 val (extId,_,(c4,a4,q4)) = parseExtIdNot dtd caq3
-		       
-	 val a5 = if useParamEnts() orelse not ext then addNotation dtd (a4,q1) (idx,extId) else a4
-	 val a6 = hookDecl(a5,((startPos,getPos q4),DEC_NOTATION(idx,extId,ext)))
+         val caq1 as (_,_,q1) = skipPS dtd caq 
+         val (name,caq2) = parseName caq1
+            handle NotFound (c,a,q) => let val err = ERR_EXPECTED(expANotName,[c]) 
+                                       in raise SyntaxError (c,hookError(a,(getPos q,err)),q)
+                                       end
+         val idx = AttNot2Index dtd name
+         val caq3 = skipPS dtd caq2 
+               
+         val (extId,_,(c4,a4,q4)) = parseExtIdNot dtd caq3
+                       
+         val a5 = if useParamEnts() orelse not ext then addNotation dtd (a4,q1) (idx,extId) else a4
+         val a6 = hookDecl(a5,((startPos,getPos q4),DEC_NOTATION(idx,extId,ext)))
       in 
-	 if c4<>0wx3E (* #">" *) 
-	    then let val a7 = hookError(a6,(getPos q4,ERR_EXPECTED(expGt,[c4])))
-		 in raise SyntaxError (c4,a7,q4)
-		 end
-	 else let val a7 = if not (!O_VALIDATE) orelse getEntId q4=startEnt then a6
-			   else hookError(a6,(getPos q4,ERR_DECL_ENT_NESTING LOC_NOT_DECL))
-	      in getChar(a7,q4)
-	      end
+         if c4<>0wx3E (* #">" *) 
+            then let val a7 = hookError(a6,(getPos q4,ERR_EXPECTED(expGt,[c4])))
+                 in raise SyntaxError (c4,a7,q4)
+                 end
+         else let val a7 = if not (!O_VALIDATE) orelse getEntId q4=startEnt then a6
+                           else hookError(a6,(getPos q4,ERR_DECL_ENT_NESTING LOC_NOT_DECL))
+              in getChar(a7,q4)
+              end
       end
    handle exn as SyntaxError(c,a,q) => 
       let val a1 = if c=0wx00 then hookError(a,(getPos q,ERR_ENDED_BY_EE LOC_NOT_DECL)) 
-		   else a
+                   else a
       in recoverDecl false (c,a1,q)
       end
 
@@ -12241,55 +12241,55 @@
    (*--------------------------------------------------------------------*)
    fun parseMixed dtd lparEnt (caq as (_,_,q)) = 
       let 
-	 fun doit is (c,a,q) = 
-	    case c 
-	      of 0wx29 (* #")" *) => 
-		 let val a1 = if not (!O_VALIDATE) orelse getEntId q=lparEnt then a
-			      else hookError(a,(getPos q,ERR_GROUP_ENT_NESTING LOC_MIXED))
-		 in (rev is,getChar(a1,q))
-		 end
-	       | 0wx7C (* #"|" *) => 
-		 let
-		    val caq1 as (_,_,q1) = skipPSopt dtd (getChar(a,q))
-			  
-		    val (name,(c2,a2,q2)) = parseName caq1
-		       handle NotFound (c,a,q) => let val err = ERR_EXPECTED(expAName,[c])
-						      val a1 = hookError(a,(getPos q,err))
-						  in raise SyntaxError (c,a1,q)
-						  end
-		    val i = Element2Index dtd name
-		    val (newis,a3) = 
-		       if not (member i is) then (i::is,a2)
-		       else let val a3 = if !O_VALIDATE 
-					    then hookError(a2,(getPos q1,ERR_MULT_MIXED name))
-					 else a2
-			    in (is,a3)
-			    end
-		    val caq3 = skipPSopt dtd (c2,a3,q2)
-		 in doit newis caq3
-		 end
-	       | _ => let val a1 = hookError(a,(getPos q,ERR_EXPECTED(expBarRpar,[c])))
-		      in raise SyntaxError (c,a1,q)
-		      end
-		    
-	 val (name,(c1,a1,q1)) = parseName caq
-	    handle NotFound (c,a,q) => let val err = ERR_EXPECTED(expPcdata,[c])
-				       in raise SyntaxError (c,hookError(a,(getPos q,err)),q)
-				       end
-	 val a2 = case name
-		    of [0wx50,0wx43,0wx44,0wx41,0wx54,0wx41] (* "PCDATA" *) => a1
-		     | _ => hookError(a1,(getPos q,ERR_EXPECTED(expPcdata,name)))
-			 
-	 val caq2 = skipPSopt dtd (c1,a2,q1)
-	 val (is,(c3,a3,q3)) = doit nil caq2
-	       
-	 val caq4 = if c3=0wx2A (* #"*" *) then getChar(a3,q3)
-		    else let val a4 = if null is then a3 
-				      else hookError(a3,(getPos q3,ERR_EXPECTED(expRep,[c3])))
-			 in (c3,a4,q3)
-			 end
+         fun doit is (c,a,q) = 
+            case c 
+              of 0wx29 (* #")" *) => 
+                 let val a1 = if not (!O_VALIDATE) orelse getEntId q=lparEnt then a
+                              else hookError(a,(getPos q,ERR_GROUP_ENT_NESTING LOC_MIXED))
+                 in (rev is,getChar(a1,q))
+                 end
+               | 0wx7C (* #"|" *) => 
+                 let
+                    val caq1 as (_,_,q1) = skipPSopt dtd (getChar(a,q))
+                          
+                    val (name,(c2,a2,q2)) = parseName caq1
+                       handle NotFound (c,a,q) => let val err = ERR_EXPECTED(expAName,[c])
+                                                      val a1 = hookError(a,(getPos q,err))
+                                                  in raise SyntaxError (c,a1,q)
+                                                  end
+                    val i = Element2Index dtd name
+                    val (newis,a3) = 
+                       if not (member i is) then (i::is,a2)
+                       else let val a3 = if !O_VALIDATE 
+                                            then hookError(a2,(getPos q1,ERR_MULT_MIXED name))
+                                         else a2
+                            in (is,a3)
+                            end
+                    val caq3 = skipPSopt dtd (c2,a3,q2)
+                 in doit newis caq3
+                 end
+               | _ => let val a1 = hookError(a,(getPos q,ERR_EXPECTED(expBarRpar,[c])))
+                      in raise SyntaxError (c,a1,q)
+                      end
+                    
+         val (name,(c1,a1,q1)) = parseName caq
+            handle NotFound (c,a,q) => let val err = ERR_EXPECTED(expPcdata,[c])
+                                       in raise SyntaxError (c,hookError(a,(getPos q,err)),q)
+                                       end
+         val a2 = case name
+                    of [0wx50,0wx43,0wx44,0wx41,0wx54,0wx41] (* "PCDATA" *) => a1
+                     | _ => hookError(a1,(getPos q,ERR_EXPECTED(expPcdata,name)))
+                         
+         val caq2 = skipPSopt dtd (c1,a2,q1)
+         val (is,(c3,a3,q3)) = doit nil caq2
+               
+         val caq4 = if c3=0wx2A (* #"*" *) then getChar(a3,q3)
+                    else let val a4 = if null is then a3 
+                                      else hookError(a3,(getPos q3,ERR_EXPECTED(expRep,[c3])))
+                         in (c3,a4,q3)
+                         end
       in 
-	 (CT_MIXED is,caq4)
+         (CT_MIXED is,caq4)
       end
 
    (*--------------------------------------------------------------------*)
@@ -12306,10 +12306,10 @@
    (*--------------------------------------------------------------------*)
    fun parseOcc cm (c,a,q) =
       case c
-	of 0wx3F (* #"?" *) => (CM_OPT cm,getChar(a,q))
-	 | 0wx2A (* #"*" *) => (CM_REP cm,getChar(a,q))
-	 | 0wx2B (* #"+" *) => (CM_PLUS cm,getChar(a,q))
-	 | _ => (cm,(c,a,q))
+        of 0wx3F (* #"?" *) => (CM_OPT cm,getChar(a,q))
+         | 0wx2A (* #"*" *) => (CM_REP cm,getChar(a,q))
+         | 0wx2B (* #"+" *) => (CM_PLUS cm,getChar(a,q))
+         | _ => (cm,(c,a,q))
 
    (*--------------------------------------------------------------------*)
    (* parse a content particle. Cf. 3.2.1:                               *)
@@ -12335,24 +12335,24 @@
    (*--------------------------------------------------------------------*)
    fun parseCP dtd (c,a,q) = 
       case c
-	of 0wx28 (* #"(" *) => 
-	   let 
-	      val lparEnt = getEntId q
-	      val caq1 = skipPSopt dtd (getChar (a,q))
-	   in parseGroup dtd lparEnt caq1
-	   end
-	 | _ => (* must be an element name *)
-	   let 
-	      val (name,caq1) = parseName (c,a,q)
-		 handle NotFound (c,a,q) => let val err = ERR_EXPECTED(expElemLpar,[c])
-						val a1 = hookError(a,(getPos q,err))
-					    in raise SyntaxError (c,a1,q)
-					    end
-	      val idx = Element2Index dtd name
-	   in 
-	      parseOcc (CM_ELEM idx) caq1
-	   end
-	
+        of 0wx28 (* #"(" *) => 
+           let 
+              val lparEnt = getEntId q
+              val caq1 = skipPSopt dtd (getChar (a,q))
+           in parseGroup dtd lparEnt caq1
+           end
+         | _ => (* must be an element name *)
+           let 
+              val (name,caq1) = parseName (c,a,q)
+                 handle NotFound (c,a,q) => let val err = ERR_EXPECTED(expElemLpar,[c])
+                                                val a1 = hookError(a,(getPos q,err))
+                                            in raise SyntaxError (c,a1,q)
+                                            end
+              val idx = Element2Index dtd name
+           in 
+              parseOcc (CM_ELEM idx) caq1
+           end
+        
    (*--------------------------------------------------------------------*)
    (* parse a seq/choice, the first content particle and the connector   *)
    (* already parsed; the connector, the type of group and the entity id *)
@@ -12381,27 +12381,27 @@
    (*--------------------------------------------------------------------*)
    and parseGroup' dtd (con,loc,lparEnt) caq =
       let fun doit caq =
-	 let
-	    val caq1 = skipPSopt dtd caq
-	    val (cp,caq2) = parseCP dtd caq1
-	    val (c3,a3,q3) = skipPSopt dtd caq2 
-	 in 
-	    if c3=0wx29 (* #")" ( *) 
-	       then let val a4 = if not (!O_VALIDATE) orelse getEntId q3=lparEnt then a3
-				 else hookError(a3,(getPos q3,ERR_GROUP_ENT_NESTING loc))
-		    in ([cp],getChar(a4,q3))
-		    end
-	    else (if c3=con then let val (cps,caq4) = doit (getChar(a3,q3))
-				 in (cp::cps,caq4)
-				 end
-		  else let val err = ERR_EXPECTED(expConCRpar con,[c3])
-		       in raise SyntaxError (c3,hookError(a3,(getPos q3,err)),q3)
-		       end)
-	 end
+         let
+            val caq1 = skipPSopt dtd caq
+            val (cp,caq2) = parseCP dtd caq1
+            val (c3,a3,q3) = skipPSopt dtd caq2 
+         in 
+            if c3=0wx29 (* #")" ( *) 
+               then let val a4 = if not (!O_VALIDATE) orelse getEntId q3=lparEnt then a3
+                                 else hookError(a3,(getPos q3,ERR_GROUP_ENT_NESTING loc))
+                    in ([cp],getChar(a4,q3))
+                    end
+            else (if c3=con then let val (cps,caq4) = doit (getChar(a3,q3))
+                                 in (cp::cps,caq4)
+                                 end
+                  else let val err = ERR_EXPECTED(expConCRpar con,[c3])
+                       in raise SyntaxError (c3,hookError(a3,(getPos q3,err)),q3)
+                       end)
+         end
       in 
-	 doit caq
+         doit caq
       end
-					
+                                        
    (*--------------------------------------------------------------------*)
    (* parse a seq/choice, the first content particle parsed; the entity  *)
    (* id of the opening parenthesis are given in first arg. Cf. 3.2.1:   *)
@@ -12423,26 +12423,26 @@
    (*--------------------------------------------------------------------*)
    and parseGroup dtd lparEnt caq =
       let 
-	 val (cp,caq1) = parseCP dtd caq
-	 val (c2,a2,q2) = skipPSopt dtd caq1
-	 val (group,caq3) = 
-	    case c2
-	      of 0wx29 (* #")" *) => 
-		 let val a3 = if not (!O_VALIDATE) orelse getEntId q2=lparEnt then a2
-			      else hookError(a2,(getPos q2,ERR_GROUP_ENT_NESTING LOC_SEQ))
-		 in (CM_SEQ[cp],getChar(a3,q2))
-		 end
-	       | 0wx2C (* #"," *) => 
-		 let val (cps,caq3) = parseGroup' dtd (c2,LOC_SEQ,lparEnt) (getChar(a2,q2))
-		 in (CM_SEQ(cp::cps),caq3)
-		 end
-	       | 0wx7C (* #"|" *) => 
-		 let val (cps,caq3) = parseGroup' dtd (c2,LOC_CHOICE,lparEnt) (getChar(a2,q2))
-		 in (CM_ALT(cp::cps),caq3)
-		 end
-	       | _ => let val a3 = hookError(a2,(getPos q2,ERR_EXPECTED(expConRpar,[c2])))
-		      in raise SyntaxError (c2,a3,q2)
-		      end
+         val (cp,caq1) = parseCP dtd caq
+         val (c2,a2,q2) = skipPSopt dtd caq1
+         val (group,caq3) = 
+            case c2
+              of 0wx29 (* #")" *) => 
+                 let val a3 = if not (!O_VALIDATE) orelse getEntId q2=lparEnt then a2
+                              else hookError(a2,(getPos q2,ERR_GROUP_ENT_NESTING LOC_SEQ))
+                 in (CM_SEQ[cp],getChar(a3,q2))
+                 end
+               | 0wx2C (* #"," *) => 
+                 let val (cps,caq3) = parseGroup' dtd (c2,LOC_SEQ,lparEnt) (getChar(a2,q2))
+                 in (CM_SEQ(cp::cps),caq3)
+                 end
+               | 0wx7C (* #"|" *) => 
+                 let val (cps,caq3) = parseGroup' dtd (c2,LOC_CHOICE,lparEnt) (getChar(a2,q2))
+                 in (CM_ALT(cp::cps),caq3)
+                 end
+               | _ => let val a3 = hookError(a2,(getPos q2,ERR_EXPECTED(expConRpar,[c2])))
+                      in raise SyntaxError (c2,a3,q2)
+                      end
       in parseOcc group caq3
       end
    
@@ -12485,46 +12485,46 @@
    (*--------------------------------------------------------------------*)
    fun parseContentSpec dtd curr (c,a,q) = 
       case c
-	of 0wx28 (* #"(" *) => 
-	   let 
-	      val (c1,a1,q1) = skipPSopt dtd (getChar(a,q))
-	      val lparEnt = getEntId q
-	   in 
-	      if c1=0wx23 (* #"#" *) 
-		 then parseMixed dtd lparEnt (getChar(a1,q1)) 
-	      else let val (cm,(c2,a2,q2)) = parseGroup dtd lparEnt (c1,a1,q1)
-		       val (dfa,a3) = (makeDfa cm,a2) handle Ambiguous(a,n1,n2) 
-			  => if !O_COMPATIBILITY 
-				then let val err = ERR_AMBIGUOUS(Index2Element dtd a,n1,n2)
-					 val a3 = hookError(a2,(getPos q,err))
-					 val dfa = makeChoiceDfa cm
-				     in (dfa,a3)
-				     end
-			     else (makeAmbiguous cm,a2) handle DfaTooLarge max
-				=> let val a3 = if !O_DFA_WARN_TOO_LARGE 
-						   then hookWarning
-						      (a2,(getPos q,WARN_DFA_TOO_LARGE(curr,max)))
-						else a2
-				       val dfa = makeChoiceDfa cm
-				   in (dfa,a3)
-				   end
-		   in (CT_ELEMENT(cm,dfa),(c2,a3,q2))
-		   end
-	   end
-	 | _ => (* must be ANY or EMPTY *)
-	   let 
-	      val (name,caq1 as (c1,a1,q1)) = parseName (c,a,q)
-		 handle NotFound (c,a,q) => 
-		    let val err = ERR_EXPECTED(expContSpec,[c])
-		    in raise SyntaxError(c,hookError(a,(getPos q,err)),q)
-		    end 
-	   in case name
-		of [0wx41,0wx4e,0wx59]             (* "ANY"   *) => (CT_ANY,caq1)
-		 | [0wx45,0wx4d,0wx50,0wx54,0wx59] (* "EMPTY" *) => (CT_EMPTY,caq1)
-		 | _ => let val a2 = hookError(a1,(getPos q,ERR_EXPECTED(expContSpec,name)))
-			in (CT_ANY,(c1,a2,q1))
-			end
-	   end
+        of 0wx28 (* #"(" *) => 
+           let 
+              val (c1,a1,q1) = skipPSopt dtd (getChar(a,q))
+              val lparEnt = getEntId q
+           in 
+              if c1=0wx23 (* #"#" *) 
+                 then parseMixed dtd lparEnt (getChar(a1,q1)) 
+              else let val (cm,(c2,a2,q2)) = parseGroup dtd lparEnt (c1,a1,q1)
+                       val (dfa,a3) = (makeDfa cm,a2) handle Ambiguous(a,n1,n2) 
+                          => if !O_COMPATIBILITY 
+                                then let val err = ERR_AMBIGUOUS(Index2Element dtd a,n1,n2)
+                                         val a3 = hookError(a2,(getPos q,err))
+                                         val dfa = makeChoiceDfa cm
+                                     in (dfa,a3)
+                                     end
+                             else (makeAmbiguous cm,a2) handle DfaTooLarge max
+                                => let val a3 = if !O_DFA_WARN_TOO_LARGE 
+                                                   then hookWarning
+                                                      (a2,(getPos q,WARN_DFA_TOO_LARGE(curr,max)))
+                                                else a2
+                                       val dfa = makeChoiceDfa cm
+                                   in (dfa,a3)
+                                   end
+                   in (CT_ELEMENT(cm,dfa),(c2,a3,q2))
+                   end
+           end
+         | _ => (* must be ANY or EMPTY *)
+           let 
+              val (name,caq1 as (c1,a1,q1)) = parseName (c,a,q)
+                 handle NotFound (c,a,q) => 
+                    let val err = ERR_EXPECTED(expContSpec,[c])
+                    in raise SyntaxError(c,hookError(a,(getPos q,err)),q)
+                    end 
+           in case name
+                of [0wx41,0wx4e,0wx59]             (* "ANY"   *) => (CT_ANY,caq1)
+                 | [0wx45,0wx4d,0wx50,0wx54,0wx59] (* "EMPTY" *) => (CT_EMPTY,caq1)
+                 | _ => let val a2 = hookError(a1,(getPos q,ERR_EXPECTED(expContSpec,name)))
+                        in (CT_ANY,(c1,a2,q1))
+                        end
+           end
 
    (*--------------------------------------------------------------------*)
    (* parse an element declaration, the initial '<!ELEMENT' already      *)
@@ -12551,35 +12551,35 @@
    (*--------------------------------------------------------------------*)
    fun parseElementDecl dtd (startEnt,startPos,ext) caq =
       let 
-	 val (caq1 as (_,_,q1))= skipPS dtd caq 
-	 val (name,(c2,a2,q2)) = parseName caq1
-	    handle NotFound (c,a,q) => let val err = ERR_EXPECTED(expAnElemName,[c])
-				       in raise SyntaxError(c,hookError(a,(getPos q,err)),q)
-				       end
-	 val a3 = checkElemName (a2,q1) name
-	 val idx = Element2Index dtd name
-	 val caq3 = skipPS dtd (c2,a3,q2) 
-	       
-	 val (contSpec,(c4,a4,q4)) = parseContentSpec dtd name caq3
+         val (caq1 as (_,_,q1))= skipPS dtd caq 
+         val (name,(c2,a2,q2)) = parseName caq1
+            handle NotFound (c,a,q) => let val err = ERR_EXPECTED(expAnElemName,[c])
+                                       in raise SyntaxError(c,hookError(a,(getPos q,err)),q)
+                                       end
+         val a3 = checkElemName (a2,q1) name
+         val idx = Element2Index dtd name
+         val caq3 = skipPS dtd (c2,a3,q2) 
+               
+         val (contSpec,(c4,a4,q4)) = parseContentSpec dtd name caq3
 
-	 val a5 = if useParamEnts() orelse not ext then addElement dtd (a4,q1) (idx,contSpec,ext) 
-		  else a4
-	 val a5' = hookDecl(a5,((startPos,getPos q4),DEC_ELEMENT(idx,contSpec,ext)))
+         val a5 = if useParamEnts() orelse not ext then addElement dtd (a4,q1) (idx,contSpec,ext) 
+                  else a4
+         val a5' = hookDecl(a5,((startPos,getPos q4),DEC_ELEMENT(idx,contSpec,ext)))
 
-	 val (c6,a6,q6) = skipPSopt dtd (c4,a5',q4)
+         val (c6,a6,q6) = skipPSopt dtd (c4,a5',q4)
       in  
-	 if c6<>0wx3E (* #">" *) 
-	    then let val a7 = hookError(a6,(getPos q6,ERR_EXPECTED(expGt,[c6])))
-		 in raise SyntaxError(c6,a7,q6)
-		 end
-	 else let val a7 = if not (!O_VALIDATE) orelse getEntId q6=startEnt then a6
-			   else hookError(a6,(getPos q6,ERR_DECL_ENT_NESTING LOC_ELEM_DECL))
-	      in getChar(a7,q6)
-	      end
+         if c6<>0wx3E (* #">" *) 
+            then let val a7 = hookError(a6,(getPos q6,ERR_EXPECTED(expGt,[c6])))
+                 in raise SyntaxError(c6,a7,q6)
+                 end
+         else let val a7 = if not (!O_VALIDATE) orelse getEntId q6=startEnt then a6
+                           else hookError(a6,(getPos q6,ERR_DECL_ENT_NESTING LOC_ELEM_DECL))
+              in getChar(a7,q6)
+              end
       end
    handle exn as SyntaxError (c,a,q) => 
       let val a1 = if c=0wx00 then hookError(a,(getPos q,ERR_ENDED_BY_EE LOC_ELEM_DECL))
-		   else a
+                   else a
       in recoverDecl false (c,a1,q)
       end
 
@@ -12602,22 +12602,22 @@
    (*--------------------------------------------------------------------*)
    fun parseEnumerated dtd (expWhat,parseToken,Token2Index) caq =
       let fun doit idxs caq = 
-	 let 
-	    val caq1 as (_,_,q1) = skipPSopt dtd caq
-	    val (nt,(c2,a2,q2)) = parseToken caq1
-	       handle NotFound (c,a,q) => let val err = ERR_EXPECTED(expWhat,[c])
-					  in raise SyntaxError(c,hookError(a,(getPos q,err)),q)
-					  end
-	    val (idx,a3) = Token2Index dtd (a2,q1) nt
-	    val (c4,a4,q4) = skipPSopt dtd (c2,a3,q2)
-	    val newIdxs = insertInt(idx,idxs)
-	 in case c4 
-	      of 0wx7C (* #"|" *) => doit newIdxs (getChar(a4,q4))
-	       | 0wx29 (* #")" *) => (newIdxs,getChar(a4,q4))
-	       | _ => let val a5 = hookError(a4,(getPos q4,ERR_EXPECTED(expBarRpar,[c4])))
-		      in raise SyntaxError (c4,a5,q4)
-		      end
-	 end
+         let 
+            val caq1 as (_,_,q1) = skipPSopt dtd caq
+            val (nt,(c2,a2,q2)) = parseToken caq1
+               handle NotFound (c,a,q) => let val err = ERR_EXPECTED(expWhat,[c])
+                                          in raise SyntaxError(c,hookError(a,(getPos q,err)),q)
+                                          end
+            val (idx,a3) = Token2Index dtd (a2,q1) nt
+            val (c4,a4,q4) = skipPSopt dtd (c2,a3,q2)
+            val newIdxs = insertInt(idx,idxs)
+         in case c4 
+              of 0wx7C (* #"|" *) => doit newIdxs (getChar(a4,q4))
+               | 0wx29 (* #")" *) => (newIdxs,getChar(a4,q4))
+               | _ => let val a5 = hookError(a4,(getPos q4,ERR_EXPECTED(expBarRpar,[c4])))
+                      in raise SyntaxError (c4,a5,q4)
+                      end
+         end
       in doit nil caq
       end
 
@@ -12635,9 +12635,9 @@
    fun Token2NmtokenIndex dtd (a,_) token = (AttNot2Index dtd token,a)
    fun Token2NotationIndex dtd (a,q) token =
       let 
-	 val idx = AttNot2Index dtd token
-	 val a1 = if not (!O_VALIDATE) orelse hasNotation dtd idx then a
-		  else hookError(a,(getPos q,ERR_UNDECLARED(IT_NOTATION,token,LOC_NONE)))
+         val idx = AttNot2Index dtd token
+         val a1 = if not (!O_VALIDATE) orelse hasNotation dtd idx then a
+                  else hookError(a,(getPos q,ERR_UNDECLARED(IT_NOTATION,token,LOC_NONE)))
       in (idx,a1)
       end
 
@@ -12677,47 +12677,47 @@
    (*--------------------------------------------------------------------*)
    fun parseAttType dtd elem (c,a,q) = 
       if c=0wx28 (* #"(" *) then 
-	 let val (idxs,caq1) = parseEnumerated dtd 
-	    (expANameToken,parseNmtoken,Token2NmtokenIndex) (getChar(a,q))
-	 in (AT_GROUP idxs,caq1)
-	 end
+         let val (idxs,caq1) = parseEnumerated dtd 
+            (expANameToken,parseNmtoken,Token2NmtokenIndex) (getChar(a,q))
+         in (AT_GROUP idxs,caq1)
+         end
       else let val (name,caq1 as (c1,a1,q1)) = parseName (c,a,q)
-	 handle NotFound cq => let val err = ERR_EXPECTED(expAttType,[c])
-			       in raise SyntaxError (c,hookError(a,(getPos q,err)),q)
-			       end
-	   in case name 
-		of [0wx43,0wx44,0wx41,0wx54,0wx41] (* "CDATA" *) => 
-		   (AT_CDATA,caq1)
-		 | [0wx49,0wx44] (* "ID" *) => 
-		   (AT_ID,caq1)
-		 | [0wx49,0wx44,0wx52,0wx45,0wx46] (* "IDREF" *) => 
-		   (AT_IDREF,caq1)
-		 | [0wx49,0wx44,0wx52,0wx45,0wx46,0wx53] (* "IDREFS" *) => 
-		   (AT_IDREFS,caq1)
-		 | [0wx45,0wx4e,0wx54,0wx49,0wx54,0wx59] (* "ENTITY" *) => 
-		   (AT_ENTITY,caq1)
-		 | [0wx45,0wx4e,0wx54,0wx49,0wx54,0wx49,0wx45,0wx53] (* "ENTITIES" *) => 
-		   (AT_ENTITIES,caq1)
-		 | [0wx4e,0wx4d,0wx54,0wx4f,0wx4b,0wx45,0wx4e] (* "NMTOKEN" *) => 
-		   (AT_NMTOKEN,caq1)
-		 | [0wx4e,0wx4d,0wx54,0wx4f,0wx4b,0wx45,0wx4e,0wx53] (* "NMTOKEN" *) => 
-		   (AT_NMTOKENS,caq1)
-		 | [0wx4e,0wx4f,0wx54,0wx41,0wx54,0wx49,0wx4f,0wx4e] (* "NOTATION" *) => 
-		   let val (c2,a2,q2) = skipPSopt dtd caq1
-		   in case c2 
-			of 0wx28 (* #"(" *) => 
-			   let val (idxs,caq3) = parseEnumerated dtd 
-			      (expANotName,parseName,Token2NotationIndex) (getChar(a2,q2))
-			   in (AT_NOTATION idxs,caq3)
-			   end
-			 | _ => let val err = ERR_EXPECTED(expLpar,[c2])
-				in raise SyntaxError(c2,hookError(a2,(getPos q2,err)),q2)
-				end
-		   end
-		 | _ => let val a2 = hookError(a1,(getPos q,ERR_EXPECTED(expAttType,name))) 
-			in raise SyntaxError (c1,a2,q1)
-			end
-	   end
+         handle NotFound cq => let val err = ERR_EXPECTED(expAttType,[c])
+                               in raise SyntaxError (c,hookError(a,(getPos q,err)),q)
+                               end
+           in case name 
+                of [0wx43,0wx44,0wx41,0wx54,0wx41] (* "CDATA" *) => 
+                   (AT_CDATA,caq1)
+                 | [0wx49,0wx44] (* "ID" *) => 
+                   (AT_ID,caq1)
+                 | [0wx49,0wx44,0wx52,0wx45,0wx46] (* "IDREF" *) => 
+                   (AT_IDREF,caq1)
+                 | [0wx49,0wx44,0wx52,0wx45,0wx46,0wx53] (* "IDREFS" *) => 
+                   (AT_IDREFS,caq1)
+                 | [0wx45,0wx4e,0wx54,0wx49,0wx54,0wx59] (* "ENTITY" *) => 
+                   (AT_ENTITY,caq1)
+                 | [0wx45,0wx4e,0wx54,0wx49,0wx54,0wx49,0wx45,0wx53] (* "ENTITIES" *) => 
+                   (AT_ENTITIES,caq1)
+                 | [0wx4e,0wx4d,0wx54,0wx4f,0wx4b,0wx45,0wx4e] (* "NMTOKEN" *) => 
+                   (AT_NMTOKEN,caq1)
+                 | [0wx4e,0wx4d,0wx54,0wx4f,0wx4b,0wx45,0wx4e,0wx53] (* "NMTOKEN" *) => 
+                   (AT_NMTOKENS,caq1)
+                 | [0wx4e,0wx4f,0wx54,0wx41,0wx54,0wx49,0wx4f,0wx4e] (* "NOTATION" *) => 
+                   let val (c2,a2,q2) = skipPSopt dtd caq1
+                   in case c2 
+                        of 0wx28 (* #"(" *) => 
+                           let val (idxs,caq3) = parseEnumerated dtd 
+                              (expANotName,parseName,Token2NotationIndex) (getChar(a2,q2))
+                           in (AT_NOTATION idxs,caq3)
+                           end
+                         | _ => let val err = ERR_EXPECTED(expLpar,[c2])
+                                in raise SyntaxError(c2,hookError(a2,(getPos q2,err)),q2)
+                                end
+                   end
+                 | _ => let val a2 = hookError(a1,(getPos q,ERR_EXPECTED(expAttType,name))) 
+                        in raise SyntaxError (c1,a2,q1)
+                        end
+           end
 
    (*--------------------------------------------------------------------*)
    (* parse an attribute default, for an attribute whose type is given   *)
@@ -12749,59 +12749,59 @@
    (*--------------------------------------------------------------------*)
    fun parseDefaultDecl dtd (aidx,attType) (c,a,q) =
       if c=0wx23 (* #"#" *) then  
-	 let 
-	    val caq0 as (_,_,q0) = (getChar(a,q))
-	    val (name,caq1) = parseName caq0
-	       handle NotFound (c,a,q) => let val err = ERR_EXPECTED(expAttDefKey,[c])
-					  in raise SyntaxError(c,hookError(a,(getPos q,err)),q)
-					  end
-	 in case name 
-	      of [0wx46,0wx49,0wx58,0wx45,0wx44] (* "FIXED" *) => 
-		 let 
-		    val caq2 as (_,_,q2) = skipPS dtd caq1 
-		    val (lit,text,(c3,a3,q3)) = parseAttValue dtd caq2
-		       handle NotFound (c,a,q) => let val err = ERR_EXPECTED(expLitQuote,[c])
-						      val a1 = hookError(a,(getPos q,err))
-						  in raise SyntaxError (c,a1,q)
-						  end
-		 in 
-		    if !O_VALIDATE andalso isIdType attType 
-		       then let val a4 = hookError(a3,(getPos q,ERR_ID_DEFAULT))
-			    in (AD_IMPLIED,(c3,a4,q3))
-			    end
-		    else 
-		       let val (cv,(av,a4)) = makeAttValue dtd (a3,q2) 
-			  (aidx,attType,false,true,text)
-		       in (AD_FIXED((lit,cv,av),(getPos q2,ref false)),(c3,a4,q3))
-		       end
-		      handle AttValue a => (AD_IMPLIED,(c3,a,q3))
-		 end
+         let 
+            val caq0 as (_,_,q0) = (getChar(a,q))
+            val (name,caq1) = parseName caq0
+               handle NotFound (c,a,q) => let val err = ERR_EXPECTED(expAttDefKey,[c])
+                                          in raise SyntaxError(c,hookError(a,(getPos q,err)),q)
+                                          end
+         in case name 
+              of [0wx46,0wx49,0wx58,0wx45,0wx44] (* "FIXED" *) => 
+                 let 
+                    val caq2 as (_,_,q2) = skipPS dtd caq1 
+                    val (lit,text,(c3,a3,q3)) = parseAttValue dtd caq2
+                       handle NotFound (c,a,q) => let val err = ERR_EXPECTED(expLitQuote,[c])
+                                                      val a1 = hookError(a,(getPos q,err))
+                                                  in raise SyntaxError (c,a1,q)
+                                                  end
+                 in 
+                    if !O_VALIDATE andalso isIdType attType 
+                       then let val a4 = hookError(a3,(getPos q,ERR_ID_DEFAULT))
+                            in (AD_IMPLIED,(c3,a4,q3))
+                            end
+                    else 
+                       let val (cv,(av,a4)) = makeAttValue dtd (a3,q2) 
+                          (aidx,attType,false,true,text)
+                       in (AD_FIXED((lit,cv,av),(getPos q2,ref false)),(c3,a4,q3))
+                       end
+                      handle AttValue a => (AD_IMPLIED,(c3,a,q3))
+                 end
 
-	       | [0wx49,0wx4d,0wx50,0wx4c,0wx49,0wx45,0wx44] (* "IMPLIED" *) => 
-		 (AD_IMPLIED,caq1)
-	       | [0wx52,0wx45,0wx51,0wx55,0wx49,0wx52,0wx45,0wx44] (* "REQUIRED" *) => 
-		 (AD_REQUIRED,caq1)
-	       | _ => let val (c1,a1,q1) = caq1
-			  val a2 = hookError(a1,(getPos q0,ERR_EXPECTED(expAttDefKey,name)))
-		      in raise SyntaxError (c1,a2,q1)
-		      end
-	 end
+               | [0wx49,0wx4d,0wx50,0wx4c,0wx49,0wx45,0wx44] (* "IMPLIED" *) => 
+                 (AD_IMPLIED,caq1)
+               | [0wx52,0wx45,0wx51,0wx55,0wx49,0wx52,0wx45,0wx44] (* "REQUIRED" *) => 
+                 (AD_REQUIRED,caq1)
+               | _ => let val (c1,a1,q1) = caq1
+                          val a2 = hookError(a1,(getPos q0,ERR_EXPECTED(expAttDefKey,name)))
+                      in raise SyntaxError (c1,a2,q1)
+                      end
+         end
       else let 
-	      val (lit,text,(c1,a1,q1)) = parseAttValue dtd (c,a,q)
-		 handle NotFound (c,a,q) => let val err = ERR_EXPECTED(expQuoteRni,[c])
-						val a1 = hookError(a,(getPos q,err))
-					    in raise SyntaxError(c,a1,q)
-					    end
-	   in 
-	      if !O_VALIDATE andalso isIdType attType 
-		 then let val a2 = hookError(a1,(getPos q,ERR_ID_DEFAULT))
-		      in (AD_IMPLIED,(c1,a2,q1))
-		      end
-	      else let val (cv,(av,a2)) = makeAttValue dtd (a1,q) (aidx,attType,false,true,text)
-		   in (AD_DEFAULT((lit,cv,av),(getPos q,ref false)),(c1,a2,q1))
-		   end
-		handle AttValue a => (AD_IMPLIED,(c1,a,q1))
-	   end
+              val (lit,text,(c1,a1,q1)) = parseAttValue dtd (c,a,q)
+                 handle NotFound (c,a,q) => let val err = ERR_EXPECTED(expQuoteRni,[c])
+                                                val a1 = hookError(a,(getPos q,err))
+                                            in raise SyntaxError(c,a1,q)
+                                            end
+           in 
+              if !O_VALIDATE andalso isIdType attType 
+                 then let val a2 = hookError(a1,(getPos q,ERR_ID_DEFAULT))
+                      in (AD_IMPLIED,(c1,a2,q1))
+                      end
+              else let val (cv,(av,a2)) = makeAttValue dtd (a1,q) (aidx,attType,false,true,text)
+                   in (AD_DEFAULT((lit,cv,av),(getPos q,ref false)),(c1,a2,q1))
+                   end
+                handle AttValue a => (AD_IMPLIED,(c1,a,q1))
+           end
 
    (*--------------------------------------------------------------------*)
    (* parse an attribute definition, the referred element given as 1st   *)
@@ -12819,23 +12819,23 @@
    (*--------------------------------------------------------------------*)
    fun parseAttDef dtd (elem,ext) caq =
       let 
-	 val (hadS,caq1 as (_,_,q1)) = skipPSmay dtd caq
-	    
-	 val (name,(c2,a2,q2)) = parseName caq1 (* NotFound falls through to the next level *)
-	 val a3 = if hadS then a2 else hookError(a2,(getPos q1,ERR_MISSING_WHITE))
-	 val a4 = checkAttName (a3,q1) name
-	 val idx = AttNot2Index dtd name
-	    
-	 val caq5 = skipPS dtd (c2,a4,q2) 
-	 val (attType,caq6) = parseAttType dtd elem caq5
-	 val caq7 = skipPS dtd caq6 
-	       
-	 val (attDef,(c8,a8,q8)) = parseDefaultDecl dtd (idx,attType) caq7
-	    
-	 val a9 = if useParamEnts() orelse not ext 
-		     then addAttribute dtd (a8,q1) (elem,(idx,attType,attDef,ext)) else a8
+         val (hadS,caq1 as (_,_,q1)) = skipPSmay dtd caq
+            
+         val (name,(c2,a2,q2)) = parseName caq1 (* NotFound falls through to the next level *)
+         val a3 = if hadS then a2 else hookError(a2,(getPos q1,ERR_MISSING_WHITE))
+         val a4 = checkAttName (a3,q1) name
+         val idx = AttNot2Index dtd name
+            
+         val caq5 = skipPS dtd (c2,a4,q2) 
+         val (attType,caq6) = parseAttType dtd elem caq5
+         val caq7 = skipPS dtd caq6 
+               
+         val (attDef,(c8,a8,q8)) = parseDefaultDecl dtd (idx,attType) caq7
+            
+         val a9 = if useParamEnts() orelse not ext 
+                     then addAttribute dtd (a8,q1) (elem,(idx,attType,attDef,ext)) else a8
       in 
-	 ((idx,attType,attDef),(c8,a9,q8))
+         ((idx,attType,attDef),(c8,a9,q8))
       end
    
    (*--------------------------------------------------------------------*)
@@ -12865,39 +12865,39 @@
    (*--------------------------------------------------------------------*)
    fun parseAttListDecl dtd (startEnt,startPos,ext) caq = 
       let 
-	 val caq1 as (_,_,q1) = skipPS dtd caq 
-	 val (name,(c2,a2,q2)) = parseName caq1
-	    handle NotFound (c,a,q) => let val err = ERR_EXPECTED(expAnElemName,[c])
-				       in raise SyntaxError (c,hookError(a,(getPos q,err)),q)
-				       end
-	 val a3 = checkElemName (a2,q1) name
-	 val idx = Element2Index dtd name
+         val caq1 as (_,_,q1) = skipPS dtd caq 
+         val (name,(c2,a2,q2)) = parseName caq1
+            handle NotFound (c,a,q) => let val err = ERR_EXPECTED(expAnElemName,[c])
+                                       in raise SyntaxError (c,hookError(a,(getPos q,err)),q)
+                                       end
+         val a3 = checkElemName (a2,q1) name
+         val idx = Element2Index dtd name
 
-	 val a4 = if !O_VALIDATE orelse not ext then enterAttList dtd (a3,q1) idx else a3
-	       
-	 fun doit attDefs caq = 
-	    let val (attDef,caq1) = parseAttDef dtd (idx,ext) caq
-	       handle NotFound (c,a,q) => raise NotFound 
-		  (c,hookDecl(a,((startPos,getPos q),DEC_ATTLIST(idx,rev attDefs,ext))),q)
-		    | SyntaxError (c,a,q) => raise SyntaxError
-		  (c,hookDecl(a,((startPos,getPos q),DEC_ATTLIST(idx,rev attDefs,ext))),q)
-	    in doit (attDef::attDefs) caq1
-	    end
-			   
-	 val (c5,a5,q5) = doit nil (c2,a4,q2) handle NotFound caq => caq
+         val a4 = if !O_VALIDATE orelse not ext then enterAttList dtd (a3,q1) idx else a3
+               
+         fun doit attDefs caq = 
+            let val (attDef,caq1) = parseAttDef dtd (idx,ext) caq
+               handle NotFound (c,a,q) => raise NotFound 
+                  (c,hookDecl(a,((startPos,getPos q),DEC_ATTLIST(idx,rev attDefs,ext))),q)
+                    | SyntaxError (c,a,q) => raise SyntaxError
+                  (c,hookDecl(a,((startPos,getPos q),DEC_ATTLIST(idx,rev attDefs,ext))),q)
+            in doit (attDef::attDefs) caq1
+            end
+                           
+         val (c5,a5,q5) = doit nil (c2,a4,q2) handle NotFound caq => caq
       in 
-	 if c5 <> 0wx3E (* #">" *) 
-	    then let val a6 = hookError(a5,(getPos q5,ERR_EXPECTED(expAttNameGt,[c5])))
-		 in raise SyntaxError (c5,a6,q5)
-		 end
-	 else let val a6 = if not (!O_VALIDATE) orelse getEntId q5=startEnt then a5
-			   else hookError(a5,(getPos q5,ERR_DECL_ENT_NESTING LOC_ATT_DECL))
-	      in getChar(a6,q5)
-	      end
+         if c5 <> 0wx3E (* #">" *) 
+            then let val a6 = hookError(a5,(getPos q5,ERR_EXPECTED(expAttNameGt,[c5])))
+                 in raise SyntaxError (c5,a6,q5)
+                 end
+         else let val a6 = if not (!O_VALIDATE) orelse getEntId q5=startEnt then a5
+                           else hookError(a5,(getPos q5,ERR_DECL_ENT_NESTING LOC_ATT_DECL))
+              in getChar(a6,q5)
+              end
       end
    handle exn as SyntaxError (c,a,q) => 
       let val a1 = if c=0wx00 then hookError(a,(getPos q,ERR_ENDED_BY_EE LOC_ATT_DECL))
-		   else a
+                   else a
       in recoverDecl false (c,a,q)
       end
 end
@@ -12909,35 +12909,35 @@
       include ParseBase
 
       val parseName    : UniChar.Char * AppData * State 
-	 -> UniChar.Data * (UniChar.Char * AppData * State)
+         -> UniChar.Data * (UniChar.Char * AppData * State)
 
       val openExtern   : int * Uri.Uri -> AppData * State 
-	 -> Encoding.Encoding * HookData.TextDecl option * (UniChar.Char * AppData * State)
+         -> Encoding.Encoding * HookData.TextDecl option * (UniChar.Char * AppData * State)
       val openDocument : Uri.Uri option -> AppData 
-	 -> Encoding.Encoding * HookData.XmlDecl option * (UniChar.Char * AppData * State)
+         -> Encoding.Encoding * HookData.XmlDecl option * (UniChar.Char * AppData * State)
 
       val skipCharRef     : AppData * State -> (UniChar.Char *  AppData * State)
       val skipReference   : UniChar.Char * AppData * State -> (UniChar.Char *  AppData * State)
       val parseGenRef     : Dtd -> UniChar.Char * AppData * State 
-	 -> (int * Base.GenEntity) * (AppData * State)
+         -> (int * Base.GenEntity) * (AppData * State)
       val parseCharRefLit : UniChar.Data -> AppData * State 
-	 -> UniChar.Data * (UniChar.Char * AppData * State)
+         -> UniChar.Data * (UniChar.Char * AppData * State)
 
       val parseComment   : Errors.Position -> AppData * State -> (UniChar.Char * AppData * State)
       val parseProcInstr : Errors.Position -> AppData * State -> (UniChar.Char * AppData * State)
 
       val skipTag   : Errors.Location -> AppData * State -> (UniChar.Char * AppData * State)
       val parseETag : Dtd -> AppData * State 
-	 -> int * UniChar.Data * Errors.Position * (UniChar.Char * AppData * State)
+         -> int * UniChar.Data * Errors.Position * (UniChar.Char * AppData * State)
       val parseSTag : Dtd -> Errors.Position -> UniChar.Char * AppData * State 
-	 -> (HookData.StartTagInfo * Base.ElemInfo) * (UniChar.Char * AppData * State)
+         -> (HookData.StartTagInfo * Base.ElemInfo) * (UniChar.Char * AppData * State)
 
       val skipDecl : bool -> UniChar.Char * AppData * State -> UniChar.Char * AppData * State
       ----------------------------------------------------------------------*)
       include ParseDecl
       
       val parseDocTypeDecl : Dtd -> (UniChar.Char * AppData * State) 
-	 -> int option * (UniChar.Char * AppData * State)
+         -> int option * (UniChar.Char * AppData * State)
    end
 
 (*--------------------------------------------------------------------------*)
@@ -12989,36 +12989,36 @@
    (*--------------------------------------------------------------------*)
    fun parseMarkupDecl dtd (startEnt,startPos) (c,a,q) =
       case c 
-	of 0wx2D => (* #"-" *)
-	   let val (c1,a1,q1) = getChar (a,q)
-	   in if c1<>0wx2D (* #"-" *) 
-		 then let val a2 = hookError(a1,(getPos q1,ERR_EXPECTED(expDash,[c1])))
-		      in recoverDecl false (c1,a2,q1)
-		      end
-	      else parseComment startPos (a1,q1)
-	   end
-	 | _ => let 
-		   val (name,caq1) = parseName (c,a,q)
-		      handle NotFound (c,a,q) => let val err = ERR_EXPECTED(expStartMarkup,[c])
-						     val a1 = hookError(a,(getPos q,err))
-						 in raise SyntaxError (c,a1,q)
-						 end
-		   val ext = hasExternal dtd
-		in case name 
-		     of [0wx45,0wx4c,0wx45,0wx4d,0wx45,0wx4e,0wx54] (* "ELEMENT" *) => 
-			parseElementDecl dtd (startEnt,startPos,ext) caq1
-		      | [0wx41,0wx54,0wx54,0wx4c,0wx49,0wx53,0wx54] (* "ATTLIST" *) => 
-			parseAttListDecl dtd (startEnt,startPos,ext) caq1
-		      | [0wx4e,0wx4f,0wx54,0wx41,0wx54,0wx49,0wx4f,0wx4e] (* "NOTATION" *) =>
-			parseNotationDecl dtd (startEnt,startPos,ext) caq1
-		      | [0wx45,0wx4e,0wx54,0wx49,0wx54,0wx59] (* "ENTITY" *) =>
-			parseEntityDecl dtd (startEnt,startPos,ext) caq1
-		      | _ => let val (c1,a1,q1) = caq1
-				 val err = ERR_EXPECTED(expStartMarkup,name)
-				 val a2 = hookError(a1,(getPos q,err))
-			     in recoverDecl false (c1,a2,q1)
-			     end
-		end
+        of 0wx2D => (* #"-" *)
+           let val (c1,a1,q1) = getChar (a,q)
+           in if c1<>0wx2D (* #"-" *) 
+                 then let val a2 = hookError(a1,(getPos q1,ERR_EXPECTED(expDash,[c1])))
+                      in recoverDecl false (c1,a2,q1)
+                      end
+              else parseComment startPos (a1,q1)
+           end
+         | _ => let 
+                   val (name,caq1) = parseName (c,a,q)
+                      handle NotFound (c,a,q) => let val err = ERR_EXPECTED(expStartMarkup,[c])
+                                                     val a1 = hookError(a,(getPos q,err))
+                                                 in raise SyntaxError (c,a1,q)
+                                                 end
+                   val ext = hasExternal dtd
+                in case name 
+                     of [0wx45,0wx4c,0wx45,0wx4d,0wx45,0wx4e,0wx54] (* "ELEMENT" *) => 
+                        parseElementDecl dtd (startEnt,startPos,ext) caq1
+                      | [0wx41,0wx54,0wx54,0wx4c,0wx49,0wx53,0wx54] (* "ATTLIST" *) => 
+                        parseAttListDecl dtd (startEnt,startPos,ext) caq1
+                      | [0wx4e,0wx4f,0wx54,0wx41,0wx54,0wx49,0wx4f,0wx4e] (* "NOTATION" *) =>
+                        parseNotationDecl dtd (startEnt,startPos,ext) caq1
+                      | [0wx45,0wx4e,0wx54,0wx49,0wx54,0wx59] (* "ENTITY" *) =>
+                        parseEntityDecl dtd (startEnt,startPos,ext) caq1
+                      | _ => let val (c1,a1,q1) = caq1
+                                 val err = ERR_EXPECTED(expStartMarkup,name)
+                                 val a2 = hookError(a1,(getPos q,err))
+                             in recoverDecl false (c1,a2,q1)
+                             end
+                end
 
    (*--------------------------------------------------------------------*)
    (* skip an ignored section, starting after the '<![IGNORE[', consume  *)
@@ -13048,43 +13048,43 @@
    (*--------------------------------------------------------------------*)
    fun skipIgnored caq = 
       let 
-	 (*--------------------------------------------------------------*)
-	 (* level counts the nesting of conditional sections.            *)
-	 (* if the second char after a "<" ("]") is not a "[" ("]"), it  *)
-	 (* can nevertheless start another delimiter and is therefore    *)
-	 (* fed into a recursive call of doit.                           *)
-	 (*--------------------------------------------------------------*)
-	 fun doit level (c,a,q) = 
-	    case c
-	      of 0wx00 => (c,hookError(a,(getPos q,ERR_ENDED_BY_EE LOC_IGNORED)),q) 
-	       | 0wx3C (* #"<" *) =>  
-		 let val (c1,a1,q1) = getChar (a,q)
-		 in if c1=0wx21 (* #"!" *) 
-		       then let val (c2,a2,q2) = (getChar(a1,q1))
-			    in if c2=0wx5B (* #"[" *) then doit (level+1) (getChar(a2,q2))
-			       else doit level (c2,a2,q2)
-			    end
-		    else doit level (c1,a1,q1)
-		 end
-	       | 0wx5D (* #"]" *) => 
-		 let val (c1,a1,q1) = getChar (a,q)
-		 in if c1=0wx5D (* #"]" *) then doit' level (getChar (a1,q1))
-		    else doit level (c1,a1,q1)
-		 end
-	       | _ => doit level (getChar (a,q))
-	 (*--------------------------------------------------------------*)
-	 (* if the second "]" is followed by a "]", then this might be   *)
-	 (* the real second "]". Therefore doit' loops as long as it     *)
-	 (* finds "]"'s.                                                 *)
-	 (*--------------------------------------------------------------*)
-	 and doit' level (c,a,q) = 
-	    case c
-	      of 0wx3E (* #">" *) =>  if level>0 then doit (level-1) (getChar (a,q))
-				      else getChar (a,q)
-	       | 0wx5D (* #"]" *) => doit' level (getChar (a,q))
-	       | _ => doit level (c,a,q)
+         (*--------------------------------------------------------------*)
+         (* level counts the nesting of conditional sections.            *)
+         (* if the second char after a "<" ("]") is not a "[" ("]"), it  *)
+         (* can nevertheless start another delimiter and is therefore    *)
+         (* fed into a recursive call of doit.                           *)
+         (*--------------------------------------------------------------*)
+         fun doit level (c,a,q) = 
+            case c
+              of 0wx00 => (c,hookError(a,(getPos q,ERR_ENDED_BY_EE LOC_IGNORED)),q) 
+               | 0wx3C (* #"<" *) =>  
+                 let val (c1,a1,q1) = getChar (a,q)
+                 in if c1=0wx21 (* #"!" *) 
+                       then let val (c2,a2,q2) = (getChar(a1,q1))
+                            in if c2=0wx5B (* #"[" *) then doit (level+1) (getChar(a2,q2))
+                               else doit level (c2,a2,q2)
+                            end
+                    else doit level (c1,a1,q1)
+                 end
+               | 0wx5D (* #"]" *) => 
+                 let val (c1,a1,q1) = getChar (a,q)
+                 in if c1=0wx5D (* #"]" *) then doit' level (getChar (a1,q1))
+                    else doit level (c1,a1,q1)
+                 end
+               | _ => doit level (getChar (a,q))
+         (*--------------------------------------------------------------*)
+         (* if the second "]" is followed by a "]", then this might be   *)
+         (* the real second "]". Therefore doit' loops as long as it     *)
+         (* finds "]"'s.                                                 *)
+         (*--------------------------------------------------------------*)
+         and doit' level (c,a,q) = 
+            case c
+              of 0wx3E (* #">" *) =>  if level>0 then doit (level-1) (getChar (a,q))
+                                      else getChar (a,q)
+               | 0wx5D (* #"]" *) => doit' level (getChar (a,q))
+               | _ => doit level (c,a,q)
       in 
-	 doit 0 caq
+         doit 0 caq
       end
       
    (*--------------------------------------------------------------------*)
@@ -13138,179 +13138,179 @@
    (*--------------------------------------------------------------------*)
    fun parseSubset dtd caq = 
       let 
-	 datatype CondStatus = IGNORE | INCLUDE 
+         datatype CondStatus = IGNORE | INCLUDE 
 
-	 fun do_data caq =
-	    let fun doit hadError ws (c,a,q) =
-	       case c
-		 of 0wx00 => (ws,(c,a,q))
-		  | 0wx09 => doit false (c::ws) (getChar(a,q))
-		  | 0wx0A => doit false (c::ws) (getChar(a,q))
-		  | 0wx20 => doit false (c::ws) (getChar(a,q))
-		  | 0wx25 => (ws,(c,a,q))
-		  | 0wx3C => (ws,(c,a,q))
-		  | 0wx5D => (ws,(c,a,q))
-		  | _ => if hadError then doit true ws (getChar(a,q))
-			 else let val err = ERR_FORBIDDEN_HERE(IT_DATA nil,LOC_SUBSET)
-				  val a1 = hookError (a,(getPos q,err))
-			      in doit true ws (getChar(a1,q))
-			      end
+         fun do_data caq =
+            let fun doit hadError ws (c,a,q) =
+               case c
+                 of 0wx00 => (ws,(c,a,q))
+                  | 0wx09 => doit false (c::ws) (getChar(a,q))
+                  | 0wx0A => doit false (c::ws) (getChar(a,q))
+                  | 0wx20 => doit false (c::ws) (getChar(a,q))
+                  | 0wx25 => (ws,(c,a,q))
+                  | 0wx3C => (ws,(c,a,q))
+                  | 0wx5D => (ws,(c,a,q))
+                  | _ => if hadError then doit true ws (getChar(a,q))
+                         else let val err = ERR_FORBIDDEN_HERE(IT_DATA nil,LOC_SUBSET)
+                                  val a1 = hookError (a,(getPos q,err))
+                              in doit true ws (getChar(a1,q))
+                              end
 
-		val (ws,(c1,a1,q1)) = doit false nil caq
-		val a2 = if null ws then a1
-			 else hookWhite(a1,Data2Vector (rev ws))
-	    in (c1,a2,q1)
-	    end
+                val (ws,(c1,a1,q1)) = doit false nil caq
+                val a2 = if null ws then a1
+                         else hookWhite(a1,Data2Vector (rev ws))
+            in (c1,a2,q1)
+            end
 
-	 fun doit cond (c,a,q) = 
-	    case c
-	      of 0wx00 => 
-		 if isSpecial q 
-		    (*---------------------------------------------------*)
-		    (* the external subset ends at and of special entity.*)
-		    (* so does the internal subset, but with error.      *) 
-		    (*---------------------------------------------------*)
-		    then 
-		       let val a1 = 
-			  if inDocEntity q 
-			     then hookError(a,(getPos q,ERR_ENDED_BY_EE LOC_INT_SUBSET))
-			  else if cond=0 then a
-			       else hookError(a,(getPos q,ERR_ENDED_BY_EE LOC_INCLUDED))
-		       in (c,a1,q)
-		       end
-		 else let val a1 = hookEntEnd (a,getPos q)
-		      in doit cond (getChar(a1,q))
-		      end
-		       
-	       (* ignore errors in parameter references -----------------*)
-	       | 0wx25 (* #"%" *) =>  
-		      let 
-			 val caq2 = 
-			    let val ((id,ent),(a1,q1)) = parseParRef dtd (getChar(a,q))
-			    in if !O_VALIDATE orelse !O_INCLUDE_PARAM_ENTS then 
-			       case ent
-				 of PE_NULL => getChar(a1,q1)
-				  | PE_INTERN(_,rep) => 
-				    let 
-				       val q2 = pushIntern(q1,id,true,rep)
-				       val a2 = hookParRef(a1,((getPos q,getPos q1),id,ent,true))
-				    in getChar(a2,q2)
-				    end
-				  | PE_EXTERN extId => 
-				    let 
-				       val a2 = hookParRef(a1,((getPos q,getPos q1),id,ent,true))
-				       val caq3 = 
-					  #3(openExtern (id,true,resolveExtId extId) (a2,q1))
-					  handle CantOpenFile(fmsg,a) 
-					  => let val err = ERR_NO_SUCH_FILE fmsg
-						 val a1 = hookError(a,(getPos q1,err))
-						 val a2 = hookEntEnd (a1,getPos q1)
-					     in (getChar(a2,q1))
-					     end
-				    in caq3
-				    end
+         fun doit cond (c,a,q) = 
+            case c
+              of 0wx00 => 
+                 if isSpecial q 
+                    (*---------------------------------------------------*)
+                    (* the external subset ends at and of special entity.*)
+                    (* so does the internal subset, but with error.      *) 
+                    (*---------------------------------------------------*)
+                    then 
+                       let val a1 = 
+                          if inDocEntity q 
+                             then hookError(a,(getPos q,ERR_ENDED_BY_EE LOC_INT_SUBSET))
+                          else if cond=0 then a
+                               else hookError(a,(getPos q,ERR_ENDED_BY_EE LOC_INCLUDED))
+                       in (c,a1,q)
+                       end
+                 else let val a1 = hookEntEnd (a,getPos q)
+                      in doit cond (getChar(a1,q))
+                      end
+                       
+               (* ignore errors in parameter references -----------------*)
+               | 0wx25 (* #"%" *) =>  
+                      let 
+                         val caq2 = 
+                            let val ((id,ent),(a1,q1)) = parseParRef dtd (getChar(a,q))
+                            in if !O_VALIDATE orelse !O_INCLUDE_PARAM_ENTS then 
+                               case ent
+                                 of PE_NULL => getChar(a1,q1)
+                                  | PE_INTERN(_,rep) => 
+                                    let 
+                                       val q2 = pushIntern(q1,id,true,rep)
+                                       val a2 = hookParRef(a1,((getPos q,getPos q1),id,ent,true))
+                                    in getChar(a2,q2)
+                                    end
+                                  | PE_EXTERN extId => 
+                                    let 
+                                       val a2 = hookParRef(a1,((getPos q,getPos q1),id,ent,true))
+                                       val caq3 = 
+                                          #3(openExtern (id,true,resolveExtId extId) (a2,q1))
+                                          handle CantOpenFile(fmsg,a) 
+                                          => let val err = ERR_NO_SUCH_FILE fmsg
+                                                 val a1 = hookError(a,(getPos q1,err))
+                                                 val a2 = hookEntEnd (a1,getPos q1)
+                                             in (getChar(a2,q1))
+                                             end
+                                    in caq3
+                                    end
                                (* changed 080600: setExternal is already called by parseParRef *)
-			       else let val a2 = hookParRef(a1,((getPos q,getPos q1),id,ent,false))
-				    in getChar(a2,q1)
-				    end
-			    end
-			 handle SyntaxError caq => caq
-			      | NoSuchEntity aq => getChar aq
-		      in doit cond caq2
-		      end 
+                               else let val a2 = hookParRef(a1,((getPos q,getPos q1),id,ent,false))
+                                    in getChar(a2,q1)
+                                    end
+                            end
+                         handle SyntaxError caq => caq
+                              | NoSuchEntity aq => getChar aq
+                      in doit cond caq2
+                      end 
 
-	       | 0wx3C (* #"<" *) =>  
-		      let val (c1,a1,q1) = getChar(a,q)
-		      in case c1
-			   of 0wx3F => (* #"?" *)
-			      let val caq2 = parseProcInstr (getPos q) (a1,q1)
-			      in doit cond caq2
-			      end
-			    | 0wx21 => (* #"!" *) 
-			      let val (c2,a2,q2) = (getChar(a1,q1))
-			      in if c2=0wx5B (* #"[" *) 
-				    then do_cond cond q (a2,q2)
-				 else 
-				    let val caq3 = parseMarkupDecl dtd 
-				       (getEntId q,getPos q) (c2,a2,q2)
-				    in doit cond caq3
-				    end
-			      end
-			    | _ => let val err = ERR_EXPECTED(expExclQuest,[c1])
-				       val a2 = hookError(a1,(getPos q1,err))
-				       val caq3 = recoverDecl false (c1,a2,q1)
-				   in doit cond caq3
-				   end
-		      end
+               | 0wx3C (* #"<" *) =>  
+                      let val (c1,a1,q1) = getChar(a,q)
+                      in case c1
+                           of 0wx3F => (* #"?" *)
+                              let val caq2 = parseProcInstr (getPos q) (a1,q1)
+                              in doit cond caq2
+                              end
+                            | 0wx21 => (* #"!" *) 
+                              let val (c2,a2,q2) = (getChar(a1,q1))
+                              in if c2=0wx5B (* #"[" *) 
+                                    then do_cond cond q (a2,q2)
+                                 else 
+                                    let val caq3 = parseMarkupDecl dtd 
+                                       (getEntId q,getPos q) (c2,a2,q2)
+                                    in doit cond caq3
+                                    end
+                              end
+                            | _ => let val err = ERR_EXPECTED(expExclQuest,[c1])
+                                       val a2 = hookError(a1,(getPos q1,err))
+                                       val caq3 = recoverDecl false (c1,a2,q1)
+                                   in doit cond caq3
+                                   end
+                      end
 
-	       | 0wx5D (* #"]" *) => do_brack cond q (getChar(a,q))
-	       | _ => let val caq1 = do_data (c,a,q)
-		      in doit cond caq1
-		      end
-		      
-	 and do_brack cond q0 (c,a,q) =
-	    if inDocEntity q then (c,a,q)
-	    else if c=0wx5D (* #"]" *) 
-		    then let val (c1,a1,q1) = getChar(a,q)
-			 in if c1=0wx3E (* #">" *)
-			       (* ignore wrong "]]>"'s ------------------*)
-			       then if cond=0 
-				       then let val err = ERR_FORBIDDEN_HERE(IT_DATA [c,c,c1],
-									     LOC_OUT_COND)
-						val a2 = hookError(a1,(getPos q0,err))
-					    in doit cond (getChar(a2,q1))
-					    end
-				    else doit (cond-1) (getChar(a1,q1))
-			    (* the second "]" may start another "]]>" ---*) 
-			    else let val a2 = hookError(a1,(getPos q1,ERR_EXPECTED(expGt,[c1])))
-				 in do_brack cond q (c1,a2,q1)
-				 end
-			 end
-		 else let val a1 = hookError(a,(getPos q,ERR_EXPECTED(expRbrack,[c])))
-		      in doit cond (c,a1,q)
-		      end
+               | 0wx5D (* #"]" *) => do_brack cond q (getChar(a,q))
+               | _ => let val caq1 = do_data (c,a,q)
+                      in doit cond caq1
+                      end
+                      
+         and do_brack cond q0 (c,a,q) =
+            if inDocEntity q then (c,a,q)
+            else if c=0wx5D (* #"]" *) 
+                    then let val (c1,a1,q1) = getChar(a,q)
+                         in if c1=0wx3E (* #">" *)
+                               (* ignore wrong "]]>"'s ------------------*)
+                               then if cond=0 
+                                       then let val err = ERR_FORBIDDEN_HERE(IT_DATA [c,c,c1],
+                                                                             LOC_OUT_COND)
+                                                val a2 = hookError(a1,(getPos q0,err))
+                                            in doit cond (getChar(a2,q1))
+                                            end
+                                    else doit (cond-1) (getChar(a1,q1))
+                            (* the second "]" may start another "]]>" ---*) 
+                            else let val a2 = hookError(a1,(getPos q1,ERR_EXPECTED(expGt,[c1])))
+                                 in do_brack cond q (c1,a2,q1)
+                                 end
+                         end
+                 else let val a1 = hookError(a,(getPos q,ERR_EXPECTED(expRbrack,[c])))
+                      in doit cond (c,a1,q)
+                      end
 
-	 and do_cond cond q0 (a,q) =
-	    let 
-	       (* marked sections are forbidden in the internal subset. -*)
-	       val inInt = inDocEntity q
-	       val a1 = if inInt then hookError (a,(getPos q0,ERR_FORBIDDEN_HERE
-						    (IT_COND,LOC_INT_SUBSET)))
-			else a
+         and do_cond cond q0 (a,q) =
+            let 
+               (* marked sections are forbidden in the internal subset. -*)
+               val inInt = inDocEntity q
+               val a1 = if inInt then hookError (a,(getPos q0,ERR_FORBIDDEN_HERE
+                                                    (IT_COND,LOC_INT_SUBSET)))
+                        else a
 
-	       val caq2 as (_,_,q2) = skipPSopt dtd (getChar(a1,q))
+               val caq2 as (_,_,q2) = skipPSopt dtd (getChar(a1,q))
 
-	       val (status,caq3) = 
-		  let 
-		     val (name,(c3,a3,q3)) = parseName caq2 
-		     (* ignore sections with bad status keyword ---------*)
-		     val (status,a4) = 
-			case name 
-			  of [0wx49,0wx47,0wx4e,0wx4f,0wx52,0wx45] => (IGNORE,a3)
-			   | [0wx49,0wx4e,0wx43,0wx4c,0wx55,0wx44,0wx45] => (INCLUDE,a3)
-			   | _ => let val err = ERR_EXPECTED(expCondStatus,name)
-				      val a4 = hookError(a3,(getPos q2,err))
-				  in (IGNORE,a4)
-				  end
-		     val (c5,a5,q5) = skipPSopt dtd (c3,a4,q3)
-		  in (* ignore sections without "[" after keyword -------*)
-		     if c5=0wx5B then (status,getChar(a5,q5)) 
-		     else let val a6 = hookError(a5,(getPos q5,ERR_EXPECTED(expLbrack,[c5])))
-			  in (IGNORE,(c5,a6,q5))
-			  end
-		  end
-	       handle NotFound (c,a,q) => let val err = ERR_EXPECTED(expCondStatus,[c])
-					      val a1 = hookError(a,(getPos q,err))
-					  in (IGNORE,(c,a1,q))
-					  end
-	    in 
-	       (* ignore sections in the internal subset ----------------*)
-	       case (status,inInt) 
-		 of (INCLUDE,_) => doit (cond+1) caq3
-		  | (_,_)       => doit cond (skipIgnored caq3)
-	    end
+               val (status,caq3) = 
+                  let 
+                     val (name,(c3,a3,q3)) = parseName caq2 
+                     (* ignore sections with bad status keyword ---------*)
+                     val (status,a4) = 
+                        case name 
+                          of [0wx49,0wx47,0wx4e,0wx4f,0wx52,0wx45] => (IGNORE,a3)
+                           | [0wx49,0wx4e,0wx43,0wx4c,0wx55,0wx44,0wx45] => (INCLUDE,a3)
+                           | _ => let val err = ERR_EXPECTED(expCondStatus,name)
+                                      val a4 = hookError(a3,(getPos q2,err))
+                                  in (IGNORE,a4)
+                                  end
+                     val (c5,a5,q5) = skipPSopt dtd (c3,a4,q3)
+                  in (* ignore sections without "[" after keyword -------*)
+                     if c5=0wx5B then (status,getChar(a5,q5)) 
+                     else let val a6 = hookError(a5,(getPos q5,ERR_EXPECTED(expLbrack,[c5])))
+                          in (IGNORE,(c5,a6,q5))
+                          end
+                  end
+               handle NotFound (c,a,q) => let val err = ERR_EXPECTED(expCondStatus,[c])
+                                              val a1 = hookError(a,(getPos q,err))
+                                          in (IGNORE,(c,a1,q))
+                                          end
+            in 
+               (* ignore sections in the internal subset ----------------*)
+               case (status,inInt) 
+                 of (INCLUDE,_) => doit (cond+1) caq3
+                  | (_,_)       => doit cond (skipIgnored caq3)
+            end
       in 
-	 doit 0 caq
+         doit 0 caq
       end
 
    (*--------------------------------------------------------------------*)
@@ -13339,11 +13339,11 @@
    (*--------------------------------------------------------------------*)
    fun parseExternalSubset dtd (a,q) extId = 
       let 
-	 val uri = resolveExtId extId
-	 val (enc,textDecl,(c1,a1,q1)) = openSubset uri a
-	 val a2 = hookExtSubset (a1,(uri,enc,textDecl))
-	 val (_,a3,q3) = parseSubset dtd (c1,a2,q1)
-	 val _ = closeAll q3
+         val uri = resolveExtId extId
+         val (enc,textDecl,(c1,a1,q1)) = openSubset uri a
+         val a2 = hookExtSubset (a1,(uri,enc,textDecl))
+         val (_,a3,q3) = parseSubset dtd (c1,a2,q1)
+         val _ = closeAll q3
       in a3
       end
    handle CantOpenFile(fmsg,a) => hookError(a,(getPos q,ERR_NO_SUCH_FILE fmsg))
@@ -13366,55 +13366,55 @@
    (*--------------------------------------------------------------------*)
    fun parseDocTypeDecl dtd caq = 
       let 
-	 val _ = setHasDtd dtd
-	 val caq1 = skipS caq 
-		  
-	 val (doc,caq2) = parseName caq1 
-	    handle NotFound (c,a,q) => let val err = ERR_EXPECTED(expAName,[c])
-				       in raise SyntaxError (c,hookError(a,(getPos q,err)),q)
-				       end
-	 val idx = Element2Index dtd doc
+         val _ = setHasDtd dtd
+         val caq1 = skipS caq 
+                  
+         val (doc,caq2) = parseName caq1 
+            handle NotFound (c,a,q) => let val err = ERR_EXPECTED(expAName,[c])
+                                       in raise SyntaxError (c,hookError(a,(getPos q,err)),q)
+                                       end
+         val idx = Element2Index dtd doc
 
-	 val (hadS,caq3 as (_,_,q3)) = skipSmay caq2
-	 val (ext,(c4,a4,q4)) = let val (extId,_,(c4,a4,q4)) = parseExtIdSub dtd caq3
-				    val a5 = if hadS then a4 
-					     else hookError(a4,(getPos q3,ERR_MISSING_WHITE))
-				in (SOME extId,(c4,a5,q4))
-				end
-			     handle NotFound caq => (NONE,caq)
-					  
-	 val a4' = hookDocType(a4,(idx,ext))
-	 val (c5,a5,q5) = case c4
-			    of 0wx5B (* #"[" *) => 
-			       let val caq5 = parseInternalSubset dtd (a4',q4)
-			       in skipSopt caq5
-			       end
-			     | _ => (c4,a4',q4)
-				       
-	 val a6 = case ext 
-		    of NONE => a5
-		     | SOME extId => let val _ = setExternal dtd
-				     in if !O_VALIDATE orelse !O_INCLUDE_PARAM_ENTS 
+         val (hadS,caq3 as (_,_,q3)) = skipSmay caq2
+         val (ext,(c4,a4,q4)) = let val (extId,_,(c4,a4,q4)) = parseExtIdSub dtd caq3
+                                    val a5 = if hadS then a4 
+                                             else hookError(a4,(getPos q3,ERR_MISSING_WHITE))
+                                in (SOME extId,(c4,a5,q4))
+                                end
+                             handle NotFound caq => (NONE,caq)
+                                          
+         val a4' = hookDocType(a4,(idx,ext))
+         val (c5,a5,q5) = case c4
+                            of 0wx5B (* #"[" *) => 
+                               let val caq5 = parseInternalSubset dtd (a4',q4)
+                               in skipSopt caq5
+                               end
+                             | _ => (c4,a4',q4)
+                                       
+         val a6 = case ext 
+                    of NONE => a5
+                     | SOME extId => let val _ = setExternal dtd
+                                     in if !O_VALIDATE orelse !O_INCLUDE_PARAM_ENTS 
                                            then parseExternalSubset dtd (a5,q5) extId
-					else a5
-				     end
-				       
-	 val a7 = checkMultEnum dtd (a6,q5)
-	 val a7'= checkPreDefined dtd (a7,q5)
-	 val a8 = checkUnparsed dtd a7'
-				       
-	 val (c9,a9,q9) = if c5=0wx3E (* #">" *) then getChar(a8,q5)
-			  else let val err = expectedOrEnded(expGt,LOC_DOC_DECL) c5
-				   val a9 = hookError(a8,(getPos q5,err)) 
-			       in recoverDecl false (c5,a9,q5)
-			       end
+                                        else a5
+                                     end
+                                       
+         val a7 = checkMultEnum dtd (a6,q5)
+         val a7'= checkPreDefined dtd (a7,q5)
+         val a8 = checkUnparsed dtd a7'
+                                       
+         val (c9,a9,q9) = if c5=0wx3E (* #">" *) then getChar(a8,q5)
+                          else let val err = expectedOrEnded(expGt,LOC_DOC_DECL) c5
+                                   val a9 = hookError(a8,(getPos q5,err)) 
+                               in recoverDecl false (c5,a9,q5)
+                               end
       in 
-	 (SOME idx,(c9,hookEndDtd(a9,getPos q9),q9))
+         (SOME idx,(c9,hookEndDtd(a9,getPos q9),q9))
       end
    handle exn as SyntaxError(c,a,q) => 
       let val a1 = if c=0wx00 then hookError(a,(getPos q,ERR_ENDED_BY_EE LOC_DOC_DECL))
-		   else a
-	  val (c2,a2,q2) = recoverDecl true (c,a1,q)
+                   else a
+          val (c2,a2,q2) = recoverDecl true (c,a1,q)
       in (NONE,(c2,hookEndDtd(a2,getPos q2),q2))
       end
 end
@@ -13426,10 +13426,10 @@
       include ParseBase
       
       val parseName    : UniChar.Char * AppData * State 
-	 -> UniChar.Data * (UniChar.Char * AppData * State)
+         -> UniChar.Data * (UniChar.Char * AppData * State)
 
       val openDocument : Uri.Uri option -> AppData 
-	 -> Encoding.Encoding * HookData.XmlDecl option * (UniChar.Char * AppData * State)
+         -> Encoding.Encoding * HookData.XmlDecl option * (UniChar.Char * AppData * State)
 
       val skipCharRef   : AppData * State -> (UniChar.Char *  AppData * State)
       val skipReference : UniChar.Char * AppData * State -> (UniChar.Char *  AppData * State)
@@ -13439,21 +13439,21 @@
 
       val skipTag   : Errors.Location -> AppData * State -> (UniChar.Char * AppData * State)
       val parseSTag : Dtd -> Errors.Position -> UniChar.Char * AppData * State 
-	 -> (HookData.StartTagInfo * Base.ElemInfo) * (UniChar.Char * AppData * State)
+         -> (HookData.StartTagInfo * Base.ElemInfo) * (UniChar.Char * AppData * State)
 
       val skipDecl : bool -> UniChar.Char * AppData * State -> UniChar.Char * AppData * State
 
       val parseDocTypeDecl : Dtd -> (UniChar.Char * AppData * State) 
-	 -> int option * (UniChar.Char * AppData * State)
+         -> int option * (UniChar.Char * AppData * State)
       ----------------------------------------------------------------------*)
       include ParseDtd
 
       val skipBadSection : UniChar.Char * AppData * State -> (UniChar.Char * AppData * State)
 
       val parseElement : Dtd * int list * State * (HookData.StartTagInfo * Base.ElemInfo) 
-	 * (UniChar.Char * AppData * State)
-	 -> (int * UniChar.Data * Errors.Position * Errors.Position) option 
-	 * (UniChar.Char * AppData * State)
+         * (UniChar.Char * AppData * State)
+         -> (int * UniChar.Data * Errors.Position * Errors.Position) option 
+         * (UniChar.Char * AppData * State)
    end
 
 (*--------------------------------------------------------------------------*)
@@ -13494,26 +13494,26 @@
    (*--------------------------------------------------------------------*)
    fun skipBadSection caq =
       let(*--------------------------------------------------------------*)
-	 (* for a sequence of "]"s, check whether the last two are       *)
-	 (* followed by a ">"                                            *)
-	 (*--------------------------------------------------------------*)
-	 fun checkEnd aq = 
-	    let val (c1,a1,q1) = getChar aq
-	    in case c1
-		 of 0wx3E (* #">" *) => getChar(a1,q1)
-		  | 0wx5D (* #"]" *) => checkEnd(a1,q1)
-		  | _ => doit(c1,a1,q1)
-	    end
-	 and doit (c,a,q) = 
-	    case c 
-	      of 0wx00 => let val a1 = hookError(a,(getPos q,ERR_ENDED_BY_EE LOC_CDATA))
-			  in (c,a1,q)
-			  end
-	       | 0wx5D (* #"]" *) => let val (c1,a1,q1) = getChar(a,q)
-				     in if c1=0wx5D (* #"]" *) then checkEnd(a1,q1)
-					else doit (c1,a1,q1)
-				  end
-	       | _ => doit (getChar(a,q))
+         (* for a sequence of "]"s, check whether the last two are       *)
+         (* followed by a ">"                                            *)
+         (*--------------------------------------------------------------*)
+         fun checkEnd aq = 
+            let val (c1,a1,q1) = getChar aq
+            in case c1
+                 of 0wx3E (* #">" *) => getChar(a1,q1)
+                  | 0wx5D (* #"]" *) => checkEnd(a1,q1)
+                  | _ => doit(c1,a1,q1)
+            end
+         and doit (c,a,q) = 
+            case c 
+              of 0wx00 => let val a1 = hookError(a,(getPos q,ERR_ENDED_BY_EE LOC_CDATA))
+                          in (c,a1,q)
+                          end
+               | 0wx5D (* #"]" *) => let val (c1,a1,q1) = getChar(a,q)
+                                     in if c1=0wx5D (* #"]" *) then checkEnd(a1,q1)
+                                        else doit (c1,a1,q1)
+                                  end
+               | _ => doit (getChar(a,q))
       in doit caq
       end
    
@@ -13601,26 +13601,26 @@
    (*--------------------------------------------------------------------*)
    fun parseCDataSection startPos aq =
       let 
-	 val caq0 as (_,_,q0) = (getChar aq) 
-	 val (name,(c1,a1,q1)) = parseName caq0
-	    handle NotFound (c,a,q) => let val err = expectedOrEnded(expCdata,LOC_CDATA) c
-				       in raise SyntaxError(c,hookError(a,(getPos q,err)),q)
-				       end
-				    
-	 val _ = if name = [0wx43,0wx44,0wx41,0wx54,0wx41] (* "CDATA" *) then ()
-		 else let val err = ERR_EXPECTED(expCdata,name)
-		      in raise SyntaxError(c1,hookError(a1,(getPos q0,err)),q1)
-		      end
-		   
-	 val _ = if c1=0wx5B (* #"[" *) then ()
-		 else let val err = expectedOrEnded(expLbrack,LOC_CDATA) c1
-		      in raise SyntaxError(c1,hookError(a1,(getPos q1,err)),q1)
-		      end
+         val caq0 as (_,_,q0) = (getChar aq) 
+         val (name,(c1,a1,q1)) = parseName caq0
+            handle NotFound (c,a,q) => let val err = expectedOrEnded(expCdata,LOC_CDATA) c
+                                       in raise SyntaxError(c,hookError(a,(getPos q,err)),q)
+                                       end
+                                    
+         val _ = if name = [0wx43,0wx44,0wx41,0wx54,0wx41] (* "CDATA" *) then ()
+                 else let val err = ERR_EXPECTED(expCdata,name)
+                      in raise SyntaxError(c1,hookError(a1,(getPos q0,err)),q1)
+                      end
+                   
+         val _ = if c1=0wx5B (* #"[" *) then ()
+                 else let val err = expectedOrEnded(expLbrack,LOC_CDATA) c1
+                      in raise SyntaxError(c1,hookError(a1,(getPos q1,err)),q1)
+                      end
       in 
-	 parseCDataSection'(a1,q1)
+         parseCDataSection'(a1,q1)
       end      
    handle SyntaxError caq => skipBadSection caq
-	 
+         
    (*--------------------------------------------------------------------*)
    (* parse element or empty content. The second arg holds the unique    *)
    (* number of the element's first characters's entity, the index of    *)
@@ -13672,274 +13672,274 @@
    (*--------------------------------------------------------------------*)
    fun parseElementContent dtd (openElems,startEnt,curr,dfa,ext,mt) caq = 
       let       
-	 (*--------------------------------------------------------------*)
-	 (* check whether the dfa allows a transition/an end tag here.   *)
-	 (* print an error if not. After a transition return the new     *)
-	 (* dfa state.                                                   *)
-	 (*--------------------------------------------------------------*)
-	 fun fin_elem (a,pos,dfa,p) = 
-	    if dfaFinal(dfa,p) then a
-	    else hookError(a,(pos,ERR_ENDED_EARLY(Index2Element dtd curr)))
-	 fun trans_elem (a,q,dfa,p,el) = 
-	    let val p1 = dfaTrans(dfa,p,el)
-	    in if p1<>dfaError then (p1,a)
-	       else let val err = ERR_BAD_ELEM(Index2Element dtd curr,Index2Element dtd el)
-		    in (p1,hookError(a,(getPos q,err)))
-		    end 
-	    end
+         (*--------------------------------------------------------------*)
+         (* check whether the dfa allows a transition/an end tag here.   *)
+         (* print an error if not. After a transition return the new     *)
+         (* dfa state.                                                   *)
+         (*--------------------------------------------------------------*)
+         fun fin_elem (a,pos,dfa,p) = 
+            if dfaFinal(dfa,p) then a
+            else hookError(a,(pos,ERR_ENDED_EARLY(Index2Element dtd curr)))
+         fun trans_elem (a,q,dfa,p,el) = 
+            let val p1 = dfaTrans(dfa,p,el)
+            in if p1<>dfaError then (p1,a)
+               else let val err = ERR_BAD_ELEM(Index2Element dtd curr,Index2Element dtd el)
+                    in (p1,hookError(a,(getPos q,err)))
+                    end 
+            end
 
-	 (*--------------------------------------------------------------*)
-	 (* consume all white space and skip all data until the next "<" *)
-	 (* or "&". print an error for each sequence of data encountered.*)
-	 (*                                                              *)
-	 (* add the white space as data to the user data.                *)
-	 (* return the next char and state.                              *)
-	 (*--------------------------------------------------------------*)
-	 fun do_char_elem (c0,a0,q0) = 
-	    let 
-	       (*--------------------------------------------------------------*)
-	       (* read data characters until the next "<", "&" or entity end.  *)
-	       (* add the data to the user data when an error occurs or no     *)
-	       (* more data follows.                                           *)
-	       (*                                                              *)
-	       (* return the modified user data with the next char and state.  *)
-	       (*--------------------------------------------------------------*)
-	       fun data_hook(a,q,cs) = 
-		  if null cs then a 
-		  else hookData(a,((getPos q0,getPos q),Data2Vector(rev cs),true))
+         (*--------------------------------------------------------------*)
+         (* consume all white space and skip all data until the next "<" *)
+         (* or "&". print an error for each sequence of data encountered.*)
+         (*                                                              *)
+         (* add the white space as data to the user data.                *)
+         (* return the next char and state.                              *)
+         (*--------------------------------------------------------------*)
+         fun do_char_elem (c0,a0,q0) = 
+            let 
+               (*--------------------------------------------------------------*)
+               (* read data characters until the next "<", "&" or entity end.  *)
+               (* add the data to the user data when an error occurs or no     *)
+               (* more data follows.                                           *)
+               (*                                                              *)
+               (* return the modified user data with the next char and state.  *)
+               (*--------------------------------------------------------------*)
+               fun data_hook(a,q,cs) = 
+                  if null cs then a 
+                  else hookData(a,((getPos q0,getPos q),Data2Vector(rev cs),true))
                fun after_error (caq as (c,a,q)) =
                   case c
                     of 0wx00            => caq
                      | 0wx26 (* #"&" *) => caq
                      | 0wx3C (* #"<" *) => caq
                      | _ => after_error(getChar(a,q))
-	       fun do_data (yet,aq as (_,q)) = 
-		  let val (c1,a1,q1) = getChar aq
-		  in case c1
-		       of 0wx00            => (c1,data_hook(a1,q,yet),q1)
-			| 0wx26 (* #"&" *) => (c1,data_hook(a1,q,yet),q1)
-			| 0wx3C (* #"<" *) => (c1,data_hook(a1,q,yet),q1)
-			| _ => 
-			  if isS c1 then do_data (c1::yet,(a1,q1))
-			  else let val a2 = data_hook(a1,q,yet)
+               fun do_data (yet,aq as (_,q)) = 
+                  let val (c1,a1,q1) = getChar aq
+                  in case c1
+                       of 0wx00            => (c1,data_hook(a1,q,yet),q1)
+                        | 0wx26 (* #"&" *) => (c1,data_hook(a1,q,yet),q1)
+                        | 0wx3C (* #"<" *) => (c1,data_hook(a1,q,yet),q1)
+                        | _ => 
+                          if isS c1 then do_data (c1::yet,(a1,q1))
+                          else let val a2 = data_hook(a1,q,yet)
                                    val err = ERR_ELEM_CONTENT(IT_DATA nil)
                                    val a3 = hookError(a2,(getPos q1,err))
                                in after_error (getChar(a3,q1))
                                end
-		  end
-	    in 
-	       if isS c0 then 
-		  let val a1 = if not (ext andalso standsAlone dtd) then a0
-			       else let val err = ERR_STANDALONE_ELEM(Index2Element dtd curr)
-					val _ = setStandAlone dtd (not (!O_ERROR_MINIMIZE))
-				    in hookError(a0,(getPos q0,err))
-				    end
-		  in do_data ([c0],(a1,q0))
-		  end
-	       else let val a1 = hookError(a0,(getPos q0,ERR_ELEM_CONTENT(IT_DATA nil)))
-		    in after_error(getChar(a1,q0))
-		    end
-	    end
-	 (*--------------------------------------------------------------*)
-	 (* consume a reference, handling errors by ignoring them.       *)
-	 (*--------------------------------------------------------------*)
-	 fun do_ref (q,(c1,a1,q1)) = 
-	    if c1=0wx23 (* #"#" *)
-	       (*------------------------------------------------------*)
-	       (* it's a character reference.                          *)
-	       (*------------------------------------------------------*)
-	       then let val err = ERR_ELEM_CONTENT IT_CHAR_REF
-		        val a2 = hookError(a1,(getPos q,err))
-		    in skipCharRef(a2,q1)
-		    end
-	    (*---------------------------------------------------------*)
-	    (* it's a general entity reference.                        *)
-	    (*---------------------------------------------------------*)
-	    else let val ((id,ent),(a2,q2)) = parseGenRef dtd (c1,a1,q1)
-		 in case ent
-		      of GE_NULL => 
-			 let val a3 = hookGenRef(a2,((getPos q,getPos q2),id,ent,false))
-			 in (getChar(a3,q2))
-			 end
-		       | GE_INTERN(_,rep) => 
-			 let 
-			    val q3 = pushIntern(q2,id,false,rep)
-			    val a3 = hookGenRef(a2,((getPos q,getPos q2),id,ent,true))
-			 in (getChar(a3,q3))
-			 end
-		       | GE_EXTERN ext => 
-			 if !O_VALIDATE orelse !O_INCLUDE_EXT_PARSED 
-			    then 
-			       let 
-				  val a3 = hookGenRef(a2,((getPos q,getPos q2),id,ent,true))
-				  val caq4 = #3(openExtern (id,false,resolveExtId ext) (a3,q2))
-				     handle CantOpenFile(fmsg,a) 
-				     => let val err = ERR_NO_SUCH_FILE fmsg
-					    val a2 = hookError(a,(getPos q2,err))
-					    val a3 = hookEntEnd(a2,getPos q2)
-					in (getChar(a3,q2))
-					end
-			       in caq4
-			       end
-			 else let val a3 = hookGenRef(a2,((getPos q,getPos q2),id,ent,false))
-			      in getChar(a3,q2)
-			      end
-		       | GE_UNPARSED _ => 
-			      raise InternalError
-				 (THIS_MODULE,"parseElementContent",
-				  "parseGenRef returned GE_UNPARSED")
-		 end
-	     (*-------------------------------------------------------*)
-	     (* handle any errors in references by ignoring them.     *)
-	     (*-------------------------------------------------------*)
-	  handle SyntaxError caq => caq
-	       | NoSuchEntity aq => getChar aq
-		      		    
-	 (*--------------------------------------------------------------*)
-	 (* handle an end-tag. finish the element in the user data and   *)
-	 (* return.                                                      *)
-	 (*                                                              *)
-	 (* print an error if the element's content is not yet finished. *)
-	 (* print an error if the end-tag is for another element.        *)
-	 (* print an error if the element's first character was not in   *)
-	 (* the same entity.                                             *)
-	 (*--------------------------------------------------------------*)
-	 and do_etag (p,etag as (elem,space,startPos,endPos),(c,a,q)) = 
-	    let 
-	       fun checkNesting a = 
-		  if getEntId q=startEnt then a
-		  else hookError(a,(startPos,ERR_ELEM_ENT_NESTING(Index2Element dtd curr)))
-	    in 
-	       if elem=curr then let val a1 = fin_elem (a,startPos,dfa,p)
-				     val a2 = checkNesting a1
-				     val a3 = hookEndTag
-					(a2,((startPos,endPos),curr,SOME(elem,space)))
-				 in (NONE,(c,a3,q))
-				 end
-	       else if member elem openElems 
-		       then let val err = ERR_OMITTED_END_TAG(Index2Element dtd curr)
-				val a1 = hookError(a,(startPos,err))
-				val a2 = fin_elem (a1,startPos,dfa,p)
-				val a3 = hookEndTag(a2,((startPos,endPos),curr,NONE))
-			    in (SOME etag,(c,a3,q))
-			    end
-	       else if dfaFinal(dfa,p)
-		       then let val err = ERR_ELEM_TYPE_MATCH(Index2Element dtd curr,
-							      Index2Element dtd elem)
-				val a1 = hookError(a,(startPos,err))
-				val a2 = checkNesting a1
-				val a3 = hookEndTag(a2,((startPos,endPos),curr,SOME(elem,space)))
-			    in (NONE,(c,a3,q))
-			    end
-		    else let val err = ERR_IGNORED_END_TAG(Index2Element dtd curr,
-							   Index2Element dtd elem)
-			     val a1 = hookError(a,(startPos,err))
-			 in do_elem(p,(c,a1,q))
-			 end
-	    end
+                  end
+            in 
+               if isS c0 then 
+                  let val a1 = if not (ext andalso standsAlone dtd) then a0
+                               else let val err = ERR_STANDALONE_ELEM(Index2Element dtd curr)
+                                        val _ = setStandAlone dtd (not (!O_ERROR_MINIMIZE))
+                                    in hookError(a0,(getPos q0,err))
+                                    end
+                  in do_data ([c0],(a1,q0))
+                  end
+               else let val a1 = hookError(a0,(getPos q0,ERR_ELEM_CONTENT(IT_DATA nil)))
+                    in after_error(getChar(a1,q0))
+                    end
+            end
+         (*--------------------------------------------------------------*)
+         (* consume a reference, handling errors by ignoring them.       *)
+         (*--------------------------------------------------------------*)
+         fun do_ref (q,(c1,a1,q1)) = 
+            if c1=0wx23 (* #"#" *)
+               (*------------------------------------------------------*)
+               (* it's a character reference.                          *)
+               (*------------------------------------------------------*)
+               then let val err = ERR_ELEM_CONTENT IT_CHAR_REF
+                        val a2 = hookError(a1,(getPos q,err))
+                    in skipCharRef(a2,q1)
+                    end
+            (*---------------------------------------------------------*)
+            (* it's a general entity reference.                        *)
+            (*---------------------------------------------------------*)
+            else let val ((id,ent),(a2,q2)) = parseGenRef dtd (c1,a1,q1)
+                 in case ent
+                      of GE_NULL => 
+                         let val a3 = hookGenRef(a2,((getPos q,getPos q2),id,ent,false))
+                         in (getChar(a3,q2))
+                         end
+                       | GE_INTERN(_,rep) => 
+                         let 
+                            val q3 = pushIntern(q2,id,false,rep)
+                            val a3 = hookGenRef(a2,((getPos q,getPos q2),id,ent,true))
+                         in (getChar(a3,q3))
+                         end
+                       | GE_EXTERN ext => 
+                         if !O_VALIDATE orelse !O_INCLUDE_EXT_PARSED 
+                            then 
+                               let 
+                                  val a3 = hookGenRef(a2,((getPos q,getPos q2),id,ent,true))
+                                  val caq4 = #3(openExtern (id,false,resolveExtId ext) (a3,q2))
+                                     handle CantOpenFile(fmsg,a) 
+                                     => let val err = ERR_NO_SUCH_FILE fmsg
+                                            val a2 = hookError(a,(getPos q2,err))
+                                            val a3 = hookEntEnd(a2,getPos q2)
+                                        in (getChar(a3,q2))
+                                        end
+                               in caq4
+                               end
+                         else let val a3 = hookGenRef(a2,((getPos q,getPos q2),id,ent,false))
+                              in getChar(a3,q2)
+                              end
+                       | GE_UNPARSED _ => 
+                              raise InternalError
+                                 (THIS_MODULE,"parseElementContent",
+                                  "parseGenRef returned GE_UNPARSED")
+                 end
+             (*-------------------------------------------------------*)
+             (* handle any errors in references by ignoring them.     *)
+             (*-------------------------------------------------------*)
+          handle SyntaxError caq => caq
+               | NoSuchEntity aq => getChar aq
+                                    
+         (*--------------------------------------------------------------*)
+         (* handle an end-tag. finish the element in the user data and   *)
+         (* return.                                                      *)
+         (*                                                              *)
+         (* print an error if the element's content is not yet finished. *)
+         (* print an error if the end-tag is for another element.        *)
+         (* print an error if the element's first character was not in   *)
+         (* the same entity.                                             *)
+         (*--------------------------------------------------------------*)
+         and do_etag (p,etag as (elem,space,startPos,endPos),(c,a,q)) = 
+            let 
+               fun checkNesting a = 
+                  if getEntId q=startEnt then a
+                  else hookError(a,(startPos,ERR_ELEM_ENT_NESTING(Index2Element dtd curr)))
+            in 
+               if elem=curr then let val a1 = fin_elem (a,startPos,dfa,p)
+                                     val a2 = checkNesting a1
+                                     val a3 = hookEndTag
+                                        (a2,((startPos,endPos),curr,SOME(elem,space)))
+                                 in (NONE,(c,a3,q))
+                                 end
+               else if member elem openElems 
+                       then let val err = ERR_OMITTED_END_TAG(Index2Element dtd curr)
+                                val a1 = hookError(a,(startPos,err))
+                                val a2 = fin_elem (a1,startPos,dfa,p)
+                                val a3 = hookEndTag(a2,((startPos,endPos),curr,NONE))
+                            in (SOME etag,(c,a3,q))
+                            end
+               else if dfaFinal(dfa,p)
+                       then let val err = ERR_ELEM_TYPE_MATCH(Index2Element dtd curr,
+                                                              Index2Element dtd elem)
+                                val a1 = hookError(a,(startPos,err))
+                                val a2 = checkNesting a1
+                                val a3 = hookEndTag(a2,((startPos,endPos),curr,SOME(elem,space)))
+                            in (NONE,(c,a3,q))
+                            end
+                    else let val err = ERR_IGNORED_END_TAG(Index2Element dtd curr,
+                                                           Index2Element dtd elem)
+                             val a1 = hookError(a,(startPos,err))
+                         in do_elem(p,(c,a1,q))
+                         end
+            end
 
-	 (*--------------------------------------------------------------*)
-	 (* handle a declaration, proc. instr or tag.                    *)
-	 (*--------------------------------------------------------------*)
-	 and do_lt (p,q,(c1,a1,q1)) =
-	    case c1
-	      of 0wx21 (* #"!" *) => 
-	         (*------------------------------------------------------*)
-		 (* its a declaration, cdata section or comment.         *)
+         (*--------------------------------------------------------------*)
+         (* handle a declaration, proc. instr or tag.                    *)
+         (*--------------------------------------------------------------*)
+         and do_lt (p,q,(c1,a1,q1)) =
+            case c1
+              of 0wx21 (* #"!" *) => 
+                 (*------------------------------------------------------*)
+                 (* its a declaration, cdata section or comment.         *)
                  (* Only comments are valid.                             *)
-	         (*------------------------------------------------------*)
-		 let val (c2,a2,q2) = getChar(a1,q1)
-		     val caq3 =  
-			case c2
-			  of 0wx2D (* #"-" *) => 
-			     let val (c3,a3,q3) = getChar(a2,q2)
-			     in if c3=0wx2D then parseComment (getPos q) (a3,q3)
-				else let val err = ERR_EXPECTED(expDash,[c3])
-					 val a4 = hookError(a3,(getPos q3,err))
-				     in recoverDecl false (c3,a4,q3)
-				     end
-			     end
-			   | 0wx5B (* #"[" *) => 
-			     let val a3 = hookError(a2,(getPos q2,ERR_ELEM_CONTENT IT_CDATA))
-			     in skipBadSection (getChar(a3,q2))
-			     end
-			   | _ => (c2,hookError(a2,(getPos q2,ERR_EXPECTED(expDash,[c2]))),q2)
-		 in do_elem(p,caq3)
-		 end
-	       | 0wx2F (* #"/" *) => 
-		 (let val (elem,space,endPos,caq2) = parseETag dtd (a1,q1)
-		  in do_etag (p,(elem,space,getPos q,endPos),caq2)
-		  end
-		     handle SyntaxError caq => do_elem(p,caq))
-	       | 0wx3F (* #"?" *) => do_elem (p,parseProcInstr (getPos q) (a1,q1))
-	       | _ => 
-		 (*------------------------------------------------------*)
-		 (* it's a start tag. the recursive call to parseElement *)
-		 (* might return an end-tag that has to be consumed.     *)
-		 (*------------------------------------------------------*)
-		 if isNms c1 then 
-		    let val (p1,(opt,caq2)) = 
-		       (let val (stag as ((_,elem,_,_,_),_),(c2,a2,q2)) = 
-			   parseSTag dtd (getPos q) (c1,a1,q1)
-			    val (p1,a3) = trans_elem (a2,q1,dfa,p,elem)
-			in (p1,parseElement (dtd,curr::openElems,q,stag,(c2,a3,q2)))
-			end)
-			   handle SyntaxError caq => (p,(NONE,caq))
-		    in case opt
-			 of NONE => do_elem (p1,caq2)
-			  | SOME etag => do_etag (p1,etag,caq2)
-		    end
-		 else let val err = ERR_FORBIDDEN_HERE(IT_CHAR 0wx3C,LOC_CONTENT)
-			  val a2 = hookError(a1,(getPos q,err))
-		      in do_elem (p,(c1,a2,q1)) 
-		      end
+                 (*------------------------------------------------------*)
+                 let val (c2,a2,q2) = getChar(a1,q1)
+                     val caq3 =  
+                        case c2
+                          of 0wx2D (* #"-" *) => 
+                             let val (c3,a3,q3) = getChar(a2,q2)
+                             in if c3=0wx2D then parseComment (getPos q) (a3,q3)
+                                else let val err = ERR_EXPECTED(expDash,[c3])
+                                         val a4 = hookError(a3,(getPos q3,err))
+                                     in recoverDecl false (c3,a4,q3)
+                                     end
+                             end
+                           | 0wx5B (* #"[" *) => 
+                             let val a3 = hookError(a2,(getPos q2,ERR_ELEM_CONTENT IT_CDATA))
+                             in skipBadSection (getChar(a3,q2))
+                             end
+                           | _ => (c2,hookError(a2,(getPos q2,ERR_EXPECTED(expDash,[c2]))),q2)
+                 in do_elem(p,caq3)
+                 end
+               | 0wx2F (* #"/" *) => 
+                 (let val (elem,space,endPos,caq2) = parseETag dtd (a1,q1)
+                  in do_etag (p,(elem,space,getPos q,endPos),caq2)
+                  end
+                     handle SyntaxError caq => do_elem(p,caq))
+               | 0wx3F (* #"?" *) => do_elem (p,parseProcInstr (getPos q) (a1,q1))
+               | _ => 
+                 (*------------------------------------------------------*)
+                 (* it's a start tag. the recursive call to parseElement *)
+                 (* might return an end-tag that has to be consumed.     *)
+                 (*------------------------------------------------------*)
+                 if isNms c1 then 
+                    let val (p1,(opt,caq2)) = 
+                       (let val (stag as ((_,elem,_,_,_),_),(c2,a2,q2)) = 
+                           parseSTag dtd (getPos q) (c1,a1,q1)
+                            val (p1,a3) = trans_elem (a2,q1,dfa,p,elem)
+                        in (p1,parseElement (dtd,curr::openElems,q,stag,(c2,a3,q2)))
+                        end)
+                           handle SyntaxError caq => (p,(NONE,caq))
+                    in case opt
+                         of NONE => do_elem (p1,caq2)
+                          | SOME etag => do_etag (p1,etag,caq2)
+                    end
+                 else let val err = ERR_FORBIDDEN_HERE(IT_CHAR 0wx3C,LOC_CONTENT)
+                          val a2 = hookError(a1,(getPos q,err))
+                      in do_elem (p,(c1,a2,q1)) 
+                      end
 
-	 (*--------------------------------------------------------------*)
-	 (* do element content. handle the document end by printing an   *)
-	 (* error and finishing like with an end-tag.                    *)
-	 (*--------------------------------------------------------------*)
-	 and do_elem (p,(c,a,q)) = 
-	    case c 
-	      of 0wx00 => if isSpecial q 
-			     then let val err = ERR_OMITTED_END_TAG(Index2Element dtd curr) 
-				      val a1 = hookError(a,(getPos q,err))
-				      val pos = getPos q
-				      val a2 = fin_elem (a1,pos,dfa,p)
-				      val a3 = hookEndTag(a2,((pos,pos),curr,NONE))
-				  in (NONE,(c,a3,q))
-				  end
-			  else let val a1 = hookEntEnd(a,getPos q)
-			       in do_elem (p,getChar(a1,q))
-			       end
-	       | 0wx26 (* #"&" *) => do_elem (p,do_ref (q,getChar(a,q)))
-	       | 0wx3C (* #"<" *) => do_lt (p,q,getChar(a,q))
-	       | _ => do_elem (p,do_char_elem (c,a,q))
-			 		      
-	 (*--------------------------------------------------------------*)
-	 (* do empty content. if the first thing to come is the current  *)
-	 (* element's end-tag, finish it. Otherwise print an error and   *)
-	 (* continue as for element content.                             *) 
-	 (*--------------------------------------------------------------*)
-	 and do_empty (c,a,q) = 
-	    if c<>0wx3C (* #"<" *) 
-	       then let val a1 = hookError(a,(getPos q,ERR_NONEMPTY(Index2Element dtd curr)))
-		    in do_elem (dfaInitial,(c,a1,q))
-		    end
-	    else 
-	       let val (c1,a1,q1) = getChar(a,q)
-	       in if c1<>0wx2F (* #"/" *) 
-		     then let val err = ERR_NONEMPTY(Index2Element dtd curr)
-			      val a2 = hookError(a1,(getPos q,err))
-			  in do_lt (dfaInitial,q,(c1,a2,q1))
-			  end
-		  else let val (elem,space,endPos,caq2) = parseETag dtd (a1,q1)
-		       in do_etag (dfaInitial,(elem,space,getPos q,endPos),caq2)
-		       end 
-		    handle SyntaxError caq => do_elem (dfaInitial,caq)
-	       end
-	       
+         (*--------------------------------------------------------------*)
+         (* do element content. handle the document end by printing an   *)
+         (* error and finishing like with an end-tag.                    *)
+         (*--------------------------------------------------------------*)
+         and do_elem (p,(c,a,q)) = 
+            case c 
+              of 0wx00 => if isSpecial q 
+                             then let val err = ERR_OMITTED_END_TAG(Index2Element dtd curr) 
+                                      val a1 = hookError(a,(getPos q,err))
+                                      val pos = getPos q
+                                      val a2 = fin_elem (a1,pos,dfa,p)
+                                      val a3 = hookEndTag(a2,((pos,pos),curr,NONE))
+                                  in (NONE,(c,a3,q))
+                                  end
+                          else let val a1 = hookEntEnd(a,getPos q)
+                               in do_elem (p,getChar(a1,q))
+                               end
+               | 0wx26 (* #"&" *) => do_elem (p,do_ref (q,getChar(a,q)))
+               | 0wx3C (* #"<" *) => do_lt (p,q,getChar(a,q))
+               | _ => do_elem (p,do_char_elem (c,a,q))
+                                              
+         (*--------------------------------------------------------------*)
+         (* do empty content. if the first thing to come is the current  *)
+         (* element's end-tag, finish it. Otherwise print an error and   *)
+         (* continue as for element content.                             *) 
+         (*--------------------------------------------------------------*)
+         and do_empty (c,a,q) = 
+            if c<>0wx3C (* #"<" *) 
+               then let val a1 = hookError(a,(getPos q,ERR_NONEMPTY(Index2Element dtd curr)))
+                    in do_elem (dfaInitial,(c,a1,q))
+                    end
+            else 
+               let val (c1,a1,q1) = getChar(a,q)
+               in if c1<>0wx2F (* #"/" *) 
+                     then let val err = ERR_NONEMPTY(Index2Element dtd curr)
+                              val a2 = hookError(a1,(getPos q,err))
+                          in do_lt (dfaInitial,q,(c1,a2,q1))
+                          end
+                  else let val (elem,space,endPos,caq2) = parseETag dtd (a1,q1)
+                       in do_etag (dfaInitial,(elem,space,getPos q,endPos),caq2)
+                       end 
+                    handle SyntaxError caq => do_elem (dfaInitial,caq)
+               end
+               
       in if mt then do_empty caq 
-	 else do_elem (dfaInitial,caq)
+         else do_elem (dfaInitial,caq)
       end
 
    (*--------------------------------------------------------------------*)
@@ -13996,267 +13996,267 @@
    (*--------------------------------------------------------------------*)
    and parseMixedContent dtd (openElems,startEnt,curr,validate) caq =
       let 
-	 (*--------------------------------------------------------------*)
-	 (* read data characters until the next "<", "&" or entity end.  *)
-	 (* add the data to the user data when an error occurs or no     *)
-	 (* more data follows.                                           *)
-	 (*                                                              *)
-	 (* return the modified user data with the next char and state.  *)
-	 (*--------------------------------------------------------------*)
-	 fun do_data (br,(c0,a0,q0)) =
-	    let 
-	       val pos0 = ref (getPos q0)
-	       val _ = Array.update(dataBuffer,0,c0)
+         (*--------------------------------------------------------------*)
+         (* read data characters until the next "<", "&" or entity end.  *)
+         (* add the data to the user data when an error occurs or no     *)
+         (* more data follows.                                           *)
+         (*                                                              *)
+         (* return the modified user data with the next char and state.  *)
+         (*--------------------------------------------------------------*)
+         fun do_data (br,(c0,a0,q0)) =
+            let 
+               val pos0 = ref (getPos q0)
+               val _ = Array.update(dataBuffer,0,c0)
 
-	       fun data_hook (i,(a,q)) = 
-		  hookData(a,((!pos0,getPos q),Array.extract(dataBuffer,0,SOME i),false))
-	       fun takeOne (c,qE,i,aq as (a,q)) = 
-		  if i<DATA_BUFSIZE then (i+1,aq) before Array.update(dataBuffer,i,c)
-		  else let val a1 = data_hook(i,(a,qE))
-			   val _ = pos0 := getPos q
-			   val _ =  Array.update(dataBuffer,0,c)
-		       in (1,(a1,q))
-		       end
-	       fun do_br (n,(i,aq as (_,q))) = 
-		  let val (c1,a1,q1) = getChar aq 
-		  in case c1
-		       of 0wx00            => (c1,data_hook(i,(a1,q)),q1)
-			| 0wx26 (* #"&" *) => (c1,data_hook(i,(a1,q)),q1)
-			| 0wx3C (* #"<" *) => (c1,data_hook(i,(a1,q)),q1)
-			| 0wx5D (* #"]" *) => do_br (n+1,takeOne(c1,q,i,(a1,q1)))
-			| 0wx3E (* #">" *) => 
-			  let val a2 = if n=1 then a1 
-				       else hookError(a1,(getPos q1,ERR_MUST_ESCAPE c1)) 
-			  in doit (takeOne(c1,q,i,(a2,q1)))
-			  end
-			| _ => doit (takeOne(c1,q,i,(a1,q1)))
-		  end
-	       and doit (i,aq as (_,q)) = 
-		  let val (c1,a1,q1) = getChar aq
-		  in case c1
-		       of 0wx00            => (c1,data_hook(i,(a1,q)),q1)
-			| 0wx26 (* #"&" *) => (c1,data_hook(i,(a1,q)),q1)
-			| 0wx3C (* #"<" *) => (c1,data_hook(i,(a1,q)),q1)
-			| 0wx5D (* #"]" *) => if !O_COMPATIBILITY 
-						 then do_br (1,takeOne(c1,q,i,(a1,q1)))
-					      else doit (takeOne(c1,q,i,(a1,q1)))
-			| _ => doit (takeOne(c1,q,i,(a1,q1)))
-		  end
-	    in 
-	       if br then do_br (1,(1,(a0,q0)))
-	       else doit (1,(a0,q0))
-	    end
-	 (*
+               fun data_hook (i,(a,q)) = 
+                  hookData(a,((!pos0,getPos q),Array.extract(dataBuffer,0,SOME i),false))
+               fun takeOne (c,qE,i,aq as (a,q)) = 
+                  if i<DATA_BUFSIZE then (i+1,aq) before Array.update(dataBuffer,i,c)
+                  else let val a1 = data_hook(i,(a,qE))
+                           val _ = pos0 := getPos q
+                           val _ =  Array.update(dataBuffer,0,c)
+                       in (1,(a1,q))
+                       end
+               fun do_br (n,(i,aq as (_,q))) = 
+                  let val (c1,a1,q1) = getChar aq 
+                  in case c1
+                       of 0wx00            => (c1,data_hook(i,(a1,q)),q1)
+                        | 0wx26 (* #"&" *) => (c1,data_hook(i,(a1,q)),q1)
+                        | 0wx3C (* #"<" *) => (c1,data_hook(i,(a1,q)),q1)
+                        | 0wx5D (* #"]" *) => do_br (n+1,takeOne(c1,q,i,(a1,q1)))
+                        | 0wx3E (* #">" *) => 
+                          let val a2 = if n=1 then a1 
+                                       else hookError(a1,(getPos q1,ERR_MUST_ESCAPE c1)) 
+                          in doit (takeOne(c1,q,i,(a2,q1)))
+                          end
+                        | _ => doit (takeOne(c1,q,i,(a1,q1)))
+                  end
+               and doit (i,aq as (_,q)) = 
+                  let val (c1,a1,q1) = getChar aq
+                  in case c1
+                       of 0wx00            => (c1,data_hook(i,(a1,q)),q1)
+                        | 0wx26 (* #"&" *) => (c1,data_hook(i,(a1,q)),q1)
+                        | 0wx3C (* #"<" *) => (c1,data_hook(i,(a1,q)),q1)
+                        | 0wx5D (* #"]" *) => if !O_COMPATIBILITY 
+                                                 then do_br (1,takeOne(c1,q,i,(a1,q1)))
+                                              else doit (takeOne(c1,q,i,(a1,q1)))
+                        | _ => doit (takeOne(c1,q,i,(a1,q1)))
+                  end
+            in 
+               if br then do_br (1,(1,(a0,q0)))
+               else doit (1,(a0,q0))
+            end
+         (*
          fun do_data (br,(c0,a0,q0)) =
-	    let 
-	       fun data_hook (yet,(a,q)) = 
-		  hookData(a,((getPos q0,getPos q),Data2Vector(rev yet),false))
-	       fun do_br (n,yet,aq as (_,q)) = 
-		  let val (c1,a1,q1) = getChar aq 
-		  in case c1
-		       of 0wx00            => (c1,data_hook(yet,(a1,q)),q1)
-			| 0wx26 (* #"&" *) => (c1,data_hook(yet,(a1,q)),q1)
-			| 0wx3C (* #"<" *) => (c1,data_hook(yet,(a1,q)),q1)
-			| 0wx5D (* #"]" *) => do_br (n+1,c1::yet,(a1,q1))
-			| 0wx3E (* #">" *) => 
-			  let val a2 = if n=1 then a1 
-				       else hookError(a1,(getPos q1,ERR_MUST_ESCAPE c1)) 
-			  in doit (c1::yet,(a2,q1))
-			  end
-			| _ => doit (c1::yet,(a1,q1))
-		  end
-	       and doit (yet,aq as (_,q)) = 
-		  let val (c1,a1,q1) = getChar aq
-		  in case c1
-		       of 0wx00            => (c1,data_hook(yet,(a1,q)),q1)
-			| 0wx26 (* #"&" *) => (c1,data_hook(yet,(a1,q)),q1)
-			| 0wx3C (* #"<" *) => (c1,data_hook(yet,(a1,q)),q1)
-			| 0wx5D (* #"]" *) => if !O_COMPATIBILITY 
-						 then do_br (1,c1::yet,(a1,q1))
-					      else doit (c1::yet,(a1,q1))
-			| _ => doit (c1::yet,(a1,q1))
-		  end
-	    in 
-	       if br then do_br (1,[0wx5D],(a0,q0))
-	       else doit ([c0],(a0,q0))
-	    end
-	 *)
+            let 
+               fun data_hook (yet,(a,q)) = 
+                  hookData(a,((getPos q0,getPos q),Data2Vector(rev yet),false))
+               fun do_br (n,yet,aq as (_,q)) = 
+                  let val (c1,a1,q1) = getChar aq 
+                  in case c1
+                       of 0wx00            => (c1,data_hook(yet,(a1,q)),q1)
+                        | 0wx26 (* #"&" *) => (c1,data_hook(yet,(a1,q)),q1)
+                        | 0wx3C (* #"<" *) => (c1,data_hook(yet,(a1,q)),q1)
+                        | 0wx5D (* #"]" *) => do_br (n+1,c1::yet,(a1,q1))
+                        | 0wx3E (* #">" *) => 
+                          let val a2 = if n=1 then a1 
+                                       else hookError(a1,(getPos q1,ERR_MUST_ESCAPE c1)) 
+                          in doit (c1::yet,(a2,q1))
+                          end
+                        | _ => doit (c1::yet,(a1,q1))
+                  end
+               and doit (yet,aq as (_,q)) = 
+                  let val (c1,a1,q1) = getChar aq
+                  in case c1
+                       of 0wx00            => (c1,data_hook(yet,(a1,q)),q1)
+                        | 0wx26 (* #"&" *) => (c1,data_hook(yet,(a1,q)),q1)
+                        | 0wx3C (* #"<" *) => (c1,data_hook(yet,(a1,q)),q1)
+                        | 0wx5D (* #"]" *) => if !O_COMPATIBILITY 
+                                                 then do_br (1,c1::yet,(a1,q1))
+                                              else doit (c1::yet,(a1,q1))
+                        | _ => doit (c1::yet,(a1,q1))
+                  end
+            in 
+               if br then do_br (1,[0wx5D],(a0,q0))
+               else doit ([c0],(a0,q0))
+            end
+         *)
 
-	 (*--------------------------------------------------------------*)
-	 (* consume a reference, handling errors by ignoring them.       *)
-	 (*--------------------------------------------------------------*)
-	 fun do_ref (q0,(c,a,q)) = 
-	    if c=0wx23 (* #"#" *)
-	       (*------------------------------------------------------*)
-	       (* it's a character reference.                          *)
-	       (*------------------------------------------------------*)
-	       then let val (cs,(ch,a1,q1)) = parseCharRefLit [0wx23,0wx26] (a,q)
-			val cv = Data2Vector(rev cs)
-			val a2 = hookCharRef(a1,((getPos q0,getPos q1),ch,cv))
-		    in getChar(a2,q1)
-		    end
-		 handle SyntaxError caq => caq
-		      | NoSuchChar aq => getChar aq 
-	    (*---------------------------------------------------------*)
-	    (* it's a general entity reference.                        *)
-	    (*---------------------------------------------------------*)
-	    else let val ((id,ent),(a1,q1)) = parseGenRef dtd (c,a,q)
-		 in case ent
-		      of GE_NULL => 
-			 let val a2 = hookGenRef(a1,((getPos q0,getPos q1),id,ent,false))
-			 in getChar(a2,q1)
-			 end
-		       | GE_INTERN(_,rep) => 
-			 let 
-			    val q2 = pushIntern(q1,id,false,rep)
-			    val a2 = hookGenRef(a1,((getPos q0,getPos q1),id,ent,true))
-			 in getChar(a2,q2)
-			 end
-		       | GE_EXTERN ext => 
-			 if !O_VALIDATE orelse !O_INCLUDE_EXT_PARSED 
-			    then 
-			       let 
-				  val a2 = hookGenRef(a1,((getPos q0,getPos q1),id,ent,true))
-				  val caq3 = #3(openExtern (id,false,resolveExtId ext) (a2,q1))
-				     handle CantOpenFile(fmsg,a) 
-				     => let val err = ERR_NO_SUCH_FILE fmsg
-					    val a1 = hookError(a,(getPos q1,err))
-					    val a2 = hookEntEnd(a1,getPos q1)
-					in (getChar(a2,q1))
-					end
-			       in caq3
-			       end
-			 else let val a2 = hookGenRef(a1,((getPos q0,getPos q1),id,ent,false))
-			      in getChar(a2,q1)
-			      end
-		       | GE_UNPARSED _ => 
-			      raise InternalError
-				 ("THIS_MODULE","parseMixedContent",
-				  "parseGenRef returned GE_UNPARSED")
-		 end
-	     (*-------------------------------------------------------*)
-	     (* handle any errors in references by ignoring them.     *)
-	     (*-------------------------------------------------------*)
-	  handle SyntaxError caq => caq
-	       | NoSuchEntity aq => getChar aq 
-		      		    
-	 (*--------------------------------------------------------------*)
-	 (* handle an end-tag. finish the element in the user data and   *)
-	 (* return.                                                      *)
-	 (*                                                              *)
-	 (* print an error if the element's content is not yet finished. *)
-	 (* print an error if the end-tag is for another element.        *)
-	 (* print an error if the element's first character was not in   *)
-	 (* the same entity.                                             *)
-	 (*--------------------------------------------------------------*)
-	 and do_etag (etag as (elem,space,startPos,endPos),(c,a,q)) = 
-	    let 
-	       fun checkNesting a = 
-		  if getEntId q=startEnt then a
-		  else hookError(a,(startPos,ERR_ELEM_ENT_NESTING(Index2Element dtd curr)))
-	    in 
-	       if elem=curr then let val a1 = checkNesting a
-				     val a2 = hookEndTag
-					(a1,((startPos,endPos),curr,SOME(elem,space)))
-				 in (NONE,(c,a2,q))
-				 end
-	       else if member elem openElems 
-		       then let val err = ERR_OMITTED_END_TAG(Index2Element dtd curr)
-				val a1 = hookError(a,(startPos,err))
-				val a2 = hookEndTag(a1,((startPos,endPos),curr,NONE))
-			    in (SOME etag,(c,a2,q))
-			    end
-		    else let val err = ERR_ELEM_TYPE_MATCH(Index2Element dtd curr,
-							   Index2Element dtd elem)
-			     val a1 = hookError(a,(startPos,err))
-			     val a2 = checkNesting a1
-			     val a3 = hookEndTag(a2,((startPos,endPos),curr,SOME(elem,space)))
-			 in (NONE,(c,a3,q))
-			 end
-	    end
+         (*--------------------------------------------------------------*)
+         (* consume a reference, handling errors by ignoring them.       *)
+         (*--------------------------------------------------------------*)
+         fun do_ref (q0,(c,a,q)) = 
+            if c=0wx23 (* #"#" *)
+               (*------------------------------------------------------*)
+               (* it's a character reference.                          *)
+               (*------------------------------------------------------*)
+               then let val (cs,(ch,a1,q1)) = parseCharRefLit [0wx23,0wx26] (a,q)
+                        val cv = Data2Vector(rev cs)
+                        val a2 = hookCharRef(a1,((getPos q0,getPos q1),ch,cv))
+                    in getChar(a2,q1)
+                    end
+                 handle SyntaxError caq => caq
+                      | NoSuchChar aq => getChar aq 
+            (*---------------------------------------------------------*)
+            (* it's a general entity reference.                        *)
+            (*---------------------------------------------------------*)
+            else let val ((id,ent),(a1,q1)) = parseGenRef dtd (c,a,q)
+                 in case ent
+                      of GE_NULL => 
+                         let val a2 = hookGenRef(a1,((getPos q0,getPos q1),id,ent,false))
+                         in getChar(a2,q1)
+                         end
+                       | GE_INTERN(_,rep) => 
+                         let 
+                            val q2 = pushIntern(q1,id,false,rep)
+                            val a2 = hookGenRef(a1,((getPos q0,getPos q1),id,ent,true))
+                         in getChar(a2,q2)
+                         end
+                       | GE_EXTERN ext => 
+                         if !O_VALIDATE orelse !O_INCLUDE_EXT_PARSED 
+                            then 
+                               let 
+                                  val a2 = hookGenRef(a1,((getPos q0,getPos q1),id,ent,true))
+                                  val caq3 = #3(openExtern (id,false,resolveExtId ext) (a2,q1))
+                                     handle CantOpenFile(fmsg,a) 
+                                     => let val err = ERR_NO_SUCH_FILE fmsg
+                                            val a1 = hookError(a,(getPos q1,err))
+                                            val a2 = hookEntEnd(a1,getPos q1)
+                                        in (getChar(a2,q1))
+                                        end
+                               in caq3
+                               end
+                         else let val a2 = hookGenRef(a1,((getPos q0,getPos q1),id,ent,false))
+                              in getChar(a2,q1)
+                              end
+                       | GE_UNPARSED _ => 
+                              raise InternalError
+                                 ("THIS_MODULE","parseMixedContent",
+                                  "parseGenRef returned GE_UNPARSED")
+                 end
+             (*-------------------------------------------------------*)
+             (* handle any errors in references by ignoring them.     *)
+             (*-------------------------------------------------------*)
+          handle SyntaxError caq => caq
+               | NoSuchEntity aq => getChar aq 
+                                    
+         (*--------------------------------------------------------------*)
+         (* handle an end-tag. finish the element in the user data and   *)
+         (* return.                                                      *)
+         (*                                                              *)
+         (* print an error if the element's content is not yet finished. *)
+         (* print an error if the end-tag is for another element.        *)
+         (* print an error if the element's first character was not in   *)
+         (* the same entity.                                             *)
+         (*--------------------------------------------------------------*)
+         and do_etag (etag as (elem,space,startPos,endPos),(c,a,q)) = 
+            let 
+               fun checkNesting a = 
+                  if getEntId q=startEnt then a
+                  else hookError(a,(startPos,ERR_ELEM_ENT_NESTING(Index2Element dtd curr)))
+            in 
+               if elem=curr then let val a1 = checkNesting a
+                                     val a2 = hookEndTag
+                                        (a1,((startPos,endPos),curr,SOME(elem,space)))
+                                 in (NONE,(c,a2,q))
+                                 end
+               else if member elem openElems 
+                       then let val err = ERR_OMITTED_END_TAG(Index2Element dtd curr)
+                                val a1 = hookError(a,(startPos,err))
+                                val a2 = hookEndTag(a1,((startPos,endPos),curr,NONE))
+                            in (SOME etag,(c,a2,q))
+                            end
+                    else let val err = ERR_ELEM_TYPE_MATCH(Index2Element dtd curr,
+                                                           Index2Element dtd elem)
+                             val a1 = hookError(a,(startPos,err))
+                             val a2 = checkNesting a1
+                             val a3 = hookEndTag(a2,((startPos,endPos),curr,SOME(elem,space)))
+                         in (NONE,(c,a3,q))
+                         end
+            end
 
-	 (*--------------------------------------------------------------*)
-	 (* handle a declaration, proc. instr or tag. If it is an end-   *)
-	 (* tag, finish the element in the user data and return.         *)
-	 (*                                                              *)
-	 (* print an error if the element's content is not yet finished. *)
-	 (* print an error if the end-tag is for another element.        *)
-	 (* print an error if the element's first character was not in   *)
-	 (* the same entity.                                             *)
-	 (*--------------------------------------------------------------*)
-	 and do_lt (q,(c1,a1,q1)) =
-	    case c1
-	      of 0wx21 (* #"!" *) => 
-	         (*------------------------------------------------------*)
-		 (* its a declaration, cdata section or comment.         *)
+         (*--------------------------------------------------------------*)
+         (* handle a declaration, proc. instr or tag. If it is an end-   *)
+         (* tag, finish the element in the user data and return.         *)
+         (*                                                              *)
+         (* print an error if the element's content is not yet finished. *)
+         (* print an error if the end-tag is for another element.        *)
+         (* print an error if the element's first character was not in   *)
+         (* the same entity.                                             *)
+         (*--------------------------------------------------------------*)
+         and do_lt (q,(c1,a1,q1)) =
+            case c1
+              of 0wx21 (* #"!" *) => 
+                 (*------------------------------------------------------*)
+                 (* its a declaration, cdata section or comment.         *)
                  (* Only comments and cdata sections are valid.          *)
-	         (*------------------------------------------------------*)
-		 let val (c2,a2,q2) = getChar(a1,q1)
-		     val caq3 =  
-			case c2
-			  of 0wx2D (* #"-" *) => 
-			     let val (c3,a3,q3) = getChar(a2,q2)
-			     in if c3=0wx2D then parseComment (getPos q) (a3,q3)
-				else let val err = ERR_EXPECTED(expDash,[c3])
-					 val a4 = hookError(a3,(getPos q3,err))
-				     in recoverDecl false (c3,a4,q3)
-				     end
-			     end
-			   | 0wx5B (* #"[" *) => parseCDataSection (getPos q) (a2,q2)
-			   | _ => 
-			     (c2,hookError(a2,(getPos q2,ERR_EXPECTED(expDashLbrack,[c2]))),q2)
-		 in do_mixed caq3
-		 end
-	       | 0wx2F (* #"/" *) => 
-		 (let val (elem,space,endPos,caq2) = parseETag dtd (a1,q1)
-		  in do_etag ((elem,space,getPos q,endPos),caq2)
-		  end
-		     handle SyntaxError caq => do_mixed caq)
-	       | 0wx3F (* #"?" *) => do_mixed (parseProcInstr (getPos q) (a1,q1))
-	       | _ => 
-		 (*------------------------------------------------------*)
-		 (* it's a start tag. the recursive call to parseElement *)
-		 (* might return an end-tag that has to be consumed.     *)
-		 (*------------------------------------------------------*)
-		 if isNms c1 then 
-		    let val (opt,caq2) = 
-		       (let val (stag as ((_,elem,_,_,_),_),(c2,a2,q2)) = 
-			   parseSTag dtd (getPos q) (c1,a1,q1)
-			    val a3 = validate (a2,q1) elem
-			in parseElement (dtd,curr::openElems,q,stag,(c2,a3,q2))
-			end
-			   handle SyntaxError caq => (NONE,caq))
-		    in case opt
-			 of NONE => do_mixed caq2
-			  | SOME etag => do_etag (etag,caq2)
-		    end
-		 else let val err = ERR_FORBIDDEN_HERE(IT_CHAR 0wx3C,LOC_CONTENT)
-			  val a2 = hookError(a1,(getPos q,err))
-		      in do_mixed (c1,a2,q1)
-		      end
+                 (*------------------------------------------------------*)
+                 let val (c2,a2,q2) = getChar(a1,q1)
+                     val caq3 =  
+                        case c2
+                          of 0wx2D (* #"-" *) => 
+                             let val (c3,a3,q3) = getChar(a2,q2)
+                             in if c3=0wx2D then parseComment (getPos q) (a3,q3)
+                                else let val err = ERR_EXPECTED(expDash,[c3])
+                                         val a4 = hookError(a3,(getPos q3,err))
+                                     in recoverDecl false (c3,a4,q3)
+                                     end
+                             end
+                           | 0wx5B (* #"[" *) => parseCDataSection (getPos q) (a2,q2)
+                           | _ => 
+                             (c2,hookError(a2,(getPos q2,ERR_EXPECTED(expDashLbrack,[c2]))),q2)
+                 in do_mixed caq3
+                 end
+               | 0wx2F (* #"/" *) => 
+                 (let val (elem,space,endPos,caq2) = parseETag dtd (a1,q1)
+                  in do_etag ((elem,space,getPos q,endPos),caq2)
+                  end
+                     handle SyntaxError caq => do_mixed caq)
+               | 0wx3F (* #"?" *) => do_mixed (parseProcInstr (getPos q) (a1,q1))
+               | _ => 
+                 (*------------------------------------------------------*)
+                 (* it's a start tag. the recursive call to parseElement *)
+                 (* might return an end-tag that has to be consumed.     *)
+                 (*------------------------------------------------------*)
+                 if isNms c1 then 
+                    let val (opt,caq2) = 
+                       (let val (stag as ((_,elem,_,_,_),_),(c2,a2,q2)) = 
+                           parseSTag dtd (getPos q) (c1,a1,q1)
+                            val a3 = validate (a2,q1) elem
+                        in parseElement (dtd,curr::openElems,q,stag,(c2,a3,q2))
+                        end
+                           handle SyntaxError caq => (NONE,caq))
+                    in case opt
+                         of NONE => do_mixed caq2
+                          | SOME etag => do_etag (etag,caq2)
+                    end
+                 else let val err = ERR_FORBIDDEN_HERE(IT_CHAR 0wx3C,LOC_CONTENT)
+                          val a2 = hookError(a1,(getPos q,err))
+                      in do_mixed (c1,a2,q1)
+                      end
 
-	 (*--------------------------------------------------------------*)
-	 (* do mixed content. handle the document end by printing an     *)
-	 (* error and finishing like with an end-tag.                    *)
-	 (*--------------------------------------------------------------*)
-	 and do_mixed (c,a,q) = 
-	    case c 
-	      of 0wx00 => if isSpecial q 
-			     then let val err = ERR_OMITTED_END_TAG(Index2Element dtd curr)
-				      val a1 = hookError(a,(getPos q,err))
-				      val pos = getPos q
-				      val a2 = hookEndTag(a1,((pos,pos),curr,NONE))
-				  in (NONE,(c,a2,q))
-				  end
-			  else let val a1 = hookEntEnd(a,getPos q)
-			       in do_mixed (getChar(a1,q))
-			       end
-	       | 0wx26 (* #"&" *) => do_mixed (do_ref (q,getChar(a,q)))
-	       | 0wx3C (* #"<" *) => do_lt (q,getChar(a,q))
-	       | 0wx5D => do_mixed (do_data (!O_COMPATIBILITY,(c,a,q)))
-	       | _ => do_mixed (do_data (false,(c,a,q)))
+         (*--------------------------------------------------------------*)
+         (* do mixed content. handle the document end by printing an     *)
+         (* error and finishing like with an end-tag.                    *)
+         (*--------------------------------------------------------------*)
+         and do_mixed (c,a,q) = 
+            case c 
+              of 0wx00 => if isSpecial q 
+                             then let val err = ERR_OMITTED_END_TAG(Index2Element dtd curr)
+                                      val a1 = hookError(a,(getPos q,err))
+                                      val pos = getPos q
+                                      val a2 = hookEndTag(a1,((pos,pos),curr,NONE))
+                                  in (NONE,(c,a2,q))
+                                  end
+                          else let val a1 = hookEntEnd(a,getPos q)
+                               in do_mixed (getChar(a1,q))
+                               end
+               | 0wx26 (* #"&" *) => do_mixed (do_ref (q,getChar(a,q)))
+               | 0wx3C (* #"<" *) => do_lt (q,getChar(a,q))
+               | 0wx5D => do_mixed (do_data (!O_COMPATIBILITY,(c,a,q)))
+               | _ => do_mixed (do_data (false,(c,a,q)))
       in 
-	 do_mixed caq
+         do_mixed caq
       end
 
    (*--------------------------------------------------------------------*)
@@ -14276,65 +14276,65 @@
    (*--------------------------------------------------------------------*)
    and parseElement (dtd,openElems,q0,(stag as (_,curr,_,_,mt),elemInfo),(c,a,q)) =
       let 
-	 (*--------------------------------------------------------------*)
-	 (* validate whether an element is allowed in mixed/any content. *) 
-	 (*--------------------------------------------------------------*)
-	 fun trans_any (a,_) _ = a
-	 fun trans_mixed is (a,q) i = 
-	    if member i is then a
-	    else let val err = ERR_BAD_ELEM(Index2Element dtd curr,Index2Element dtd i)
-		 in hookError(a,(getPos q,err))
-		 end
+         (*--------------------------------------------------------------*)
+         (* validate whether an element is allowed in mixed/any content. *) 
+         (*--------------------------------------------------------------*)
+         fun trans_any (a,_) _ = a
+         fun trans_mixed is (a,q) i = 
+            if member i is then a
+            else let val err = ERR_BAD_ELEM(Index2Element dtd curr,Index2Element dtd i)
+                 in hookError(a,(getPos q,err))
+                 end
       in 
-	 (*-----------------------------------------------------------*)
-	 (* For empty-element tags, verify that the element's declar. *)
-	 (* allows empty content.                                     *)
-	 (*-----------------------------------------------------------*)
-	 if mt then 
-	    let val a1 = 
-	       if not (!O_VALIDATE andalso hasDtd dtd) then a
-	       else 
-		  case #decl elemInfo
-		    of (SOME(CT_EMPTY,_)) => a
-		     | (SOME(CT_ELEMENT(_,dfa),_)) => 
-		       if not (dfaFinal(dfa,dfaInitial)) 
-			  then hookError(a,(getPos q0,ERR_EMPTY_TAG(Index2Element dtd curr)))
-		       else if not (!O_INTEROPERABILITY) then a
-			    else hookError
-			       (a,(getPos q0,ERR_EMPTY_TAG_INTER (Index2Element dtd curr)))
-		     | _ => if not (!O_INTEROPERABILITY) then a
-			    else hookError(a,(getPos q0,ERR_EMPTY_TAG_INTER
-					      (Index2Element dtd curr)))
-	    in (NONE,(c,hookStartTag(a1,stag),q))
-	    end
-	 (*-----------------------------------------------------------*)
-	 (* for normal start-tags, check whether the element's decl.  *)
-	 (* requires an empty-element tag, or empty content, then     *)
-	 (* call the appropriate function that parses the content.    *)
-	 (*-----------------------------------------------------------*)
-	 else 
-	    let val startEnt = getEntId q0
-	    in if !O_VALIDATE then  
-	       case getOpt(#decl elemInfo,(CT_ANY,false))
-		 of (CT_ANY,_) => parseMixedContent dtd  
-		    (openElems,startEnt,curr,trans_any) (c,hookStartTag(a,stag),q)
-		  | (CT_MIXED is,_) => parseMixedContent dtd 
-		    (openElems,startEnt,curr,trans_mixed is) (c,hookStartTag(a,stag),q) 
-		  | (CT_ELEMENT(_,dfa),ext) => parseElementContent dtd 
-		    (openElems,startEnt,curr,dfa,ext,false) 
-		    (c,hookStartTag(a,stag),q) 
-		  | (CT_EMPTY,_) => 
-		    let val a1 = if not (!O_INTEROPERABILITY) then a
-				 else let val err = ERR_MUST_BE_EMPTY(Index2Element dtd curr)
-				      in hookError(a,(getPos q0,err))
-				      end
-			val a2 = hookStartTag(a1,stag)
-		    in parseElementContent dtd 
-		       (openElems,startEnt,curr,emptyDfa,false,true) (c,a2,q)
-		    end
-	       else parseMixedContent dtd 
-		  (openElems,startEnt,curr,trans_any) (c,hookStartTag(a,stag),q)
-	    end
+         (*-----------------------------------------------------------*)
+         (* For empty-element tags, verify that the element's declar. *)
+         (* allows empty content.                                     *)
+         (*-----------------------------------------------------------*)
+         if mt then 
+            let val a1 = 
+               if not (!O_VALIDATE andalso hasDtd dtd) then a
+               else 
+                  case #decl elemInfo
+                    of (SOME(CT_EMPTY,_)) => a
+                     | (SOME(CT_ELEMENT(_,dfa),_)) => 
+                       if not (dfaFinal(dfa,dfaInitial)) 
+                          then hookError(a,(getPos q0,ERR_EMPTY_TAG(Index2Element dtd curr)))
+                       else if not (!O_INTEROPERABILITY) then a
+                            else hookError
+                               (a,(getPos q0,ERR_EMPTY_TAG_INTER (Index2Element dtd curr)))
+                     | _ => if not (!O_INTEROPERABILITY) then a
+                            else hookError(a,(getPos q0,ERR_EMPTY_TAG_INTER
+                                              (Index2Element dtd curr)))
+            in (NONE,(c,hookStartTag(a1,stag),q))
+            end
+         (*-----------------------------------------------------------*)
+         (* for normal start-tags, check whether the element's decl.  *)
+         (* requires an empty-element tag, or empty content, then     *)
+         (* call the appropriate function that parses the content.    *)
+         (*-----------------------------------------------------------*)
+         else 
+            let val startEnt = getEntId q0
+            in if !O_VALIDATE then  
+               case getOpt(#decl elemInfo,(CT_ANY,false))
+                 of (CT_ANY,_) => parseMixedContent dtd  
+                    (openElems,startEnt,curr,trans_any) (c,hookStartTag(a,stag),q)
+                  | (CT_MIXED is,_) => parseMixedContent dtd 
+                    (openElems,startEnt,curr,trans_mixed is) (c,hookStartTag(a,stag),q) 
+                  | (CT_ELEMENT(_,dfa),ext) => parseElementContent dtd 
+                    (openElems,startEnt,curr,dfa,ext,false) 
+                    (c,hookStartTag(a,stag),q) 
+                  | (CT_EMPTY,_) => 
+                    let val a1 = if not (!O_INTEROPERABILITY) then a
+                                 else let val err = ERR_MUST_BE_EMPTY(Index2Element dtd curr)
+                                      in hookError(a,(getPos q0,err))
+                                      end
+                        val a2 = hookStartTag(a1,stag)
+                    in parseElementContent dtd 
+                       (openElems,startEnt,curr,emptyDfa,false,true) (c,a2,q)
+                    end
+               else parseMixedContent dtd 
+                  (openElems,startEnt,curr,trans_any) (c,hookStartTag(a,stag),q)
+            end
       end
 end
 (* stop of ../../Parser/Parse/parseContent.sml *)
@@ -14351,14 +14351,14 @@
     structure Resolve       : Resolve
     structure ParserOptions : ParserOptions) : 
        sig
-	  val parseDocument : Uri.Uri option -> Dtd.Dtd option -> Hooks.AppData -> Hooks.AppFinal 
+          val parseDocument : Uri.Uri option -> Dtd.Dtd option -> Hooks.AppData -> Hooks.AppFinal 
        end
       = 
 struct
    structure ParseBase = ParseBase (structure Dtd = Dtd
-				    structure Hooks = Hooks
-				    structure Resolve = Resolve
-				    structure ParserOptions = ParserOptions) 
+                                    structure Hooks = Hooks
+                                    structure Resolve = Resolve
+                                    structure ParserOptions = ParserOptions) 
       
    structure ParseContent = ParseContent (structure ParseBase = ParseBase)
 
@@ -14372,180 +14372,180 @@
       PROLOG
     | EPILOG
     | INSTANCE of int option
-	 
+         
    fun locOf wher =
       case wher 
-	of PROLOG => LOC_PROLOG
-	 | INSTANCE _ => LOC_PROLOG
-	 | EPILOG => LOC_EPILOG
+        of PROLOG => LOC_PROLOG
+         | INSTANCE _ => LOC_PROLOG
+         | EPILOG => LOC_EPILOG
 
    fun checkRoot dtd (a,q) (doc,stag as ((_,elem,_,_,_),_)) =
       if !O_VALIDATE 
-	 then case doc
-		of NONE => a
-		 | SOME doc => 
-		   if doc=elem then a
-		   else let val err = ERR_ROOT_ELEM(Index2Element dtd doc,
-						    Index2Element dtd elem)
-			in hookError(a,(getPos q,err))
-			end
+         then case doc
+                of NONE => a
+                 | SOME doc => 
+                   if doc=elem then a
+                   else let val err = ERR_ROOT_ELEM(Index2Element dtd doc,
+                                                    Index2Element dtd elem)
+                        in hookError(a,(getPos q,err))
+                        end
       else a
 
    fun parseDoc dtd caq =
       let 
-	 fun do_data wher caq =
-	    let fun doit hadError ws (c,a,q) =
-	       case c
-		 of 0wx00            => (ws,(c,a,q))
-		  | 0wx26 (* #"&" *) => (ws,(c,a,q))
-		  | 0wx3C (* #"<" *) => (ws,(c,a,q))
-		  | 0wx09 (* #"\t"*) => doit hadError (c::ws) (getChar(a,q))
-		  | 0wx0A (* #"\n"*) => doit hadError (c::ws) (getChar(a,q))
-		  | 0wx20 (* #" " *) => doit hadError (c::ws) (getChar(a,q))
-		  | _ => let val a1 = if hadError then a
+         fun do_data wher caq =
+            let fun doit hadError ws (c,a,q) =
+               case c
+                 of 0wx00            => (ws,(c,a,q))
+                  | 0wx26 (* #"&" *) => (ws,(c,a,q))
+                  | 0wx3C (* #"<" *) => (ws,(c,a,q))
+                  | 0wx09 (* #"\t"*) => doit hadError (c::ws) (getChar(a,q))
+                  | 0wx0A (* #"\n"*) => doit hadError (c::ws) (getChar(a,q))
+                  | 0wx20 (* #" " *) => doit hadError (c::ws) (getChar(a,q))
+                  | _ => let val a1 = if hadError then a
                                       else hookError(a,(getPos q,ERR_FORBIDDEN_HERE
                                                         (IT_DATA nil,locOf wher)))
                          in doit true ws (getChar(a1,q))
                          end
 
-		val (ws,(c1,a1,q1)) = doit false nil caq
-		val a2 = if null ws then a1
-			 else hookWhite(a1,Data2Vector (rev ws))
-	    in (c1,a2,q1)
-	    end
-			    
-	 fun do_decl wher q0 (c,a,q) =
-	    case c
-	      of 0wx2D (* #"-" *) => 
-		 let val (c1,a1,q1) = getChar(a,q)
-		 in if c1=0wx2D then (wher,parseComment (getPos q0) (a1,q1))
-		    else let val err = ERR_EXPECTED(expDash,[c1])
-			     val a2 = hookError(a1,(getPos q1,err))
-			     val caq2 = recoverDecl false (c1,a2,q1)
-			 in (wher,caq2)
-			 end
-		 end
-	       | 0wx5B (* #"[" *) => 
-		 let 
-		    val err = ERR_FORBIDDEN_HERE (IT_CDATA,locOf wher)
-		    val a1 = hookError(a,(getPos q0,err))
-		    val caq2 = skipBadSection (getChar(a1,q))
-		 in (wher,caq2)
-		 end
-	       | _ => 
-		 case wher 
-		   of PROLOG => 
-		      (let val (name,(c1,a1,q1)) = parseName (c,a,q)
-			  handle NotFound (c,a,q) => 
-			     let val err = expectedOrEnded(expDashDocLbrk,LOC_DECL) c
-			     in raise SyntaxError (c,hookError(a,(getPos q,err)),q)
-			     end
-			     
-			   val _ = if name=[0wx44,0wx4f,0wx43,0wx54,0wx59,0wx50,0wx45] 
-				   (* "DOCTYPE" *) then ()
-				   else let val err = ERR_EXPECTED(expDashDocLbrk,name)
-					    val a2 = hookError(a1,(getPos q,err))
-					in raise SyntaxError (c1,a2,q1)
-					end
-					
-			   val (doc,caq2) = parseDocTypeDecl dtd (c1,a1,q1)
-		       in (INSTANCE doc,caq2)
-		       end
-			  handle SyntaxError caq => (PROLOG,recoverDecl true caq))
-			  
-		    | _ => let val loc = if wher=EPILOG then LOC_EPILOG else LOC_AFTER_DTD
-			       val err = ERR_FORBIDDEN_HERE (IT_DECL,loc)
-			       val a1 = hookError(a,(getPos q0,err))
-			       val caq2 = skipDecl true (c,a1,q)
-			   in (wher,caq2)
-			   end
-			   
-	 and doit wher (c,a,q) = 
-	    case c 
-	      of 0wx00 => if isSpecial q then (wher,(a,q))
-			  else doit wher (getChar(a,q))
-	       (*--------------------------------------------------------------*)
-	       (* References are forbidden outside the document element        *) 
-	       (*--------------------------------------------------------------*)
-	       | 0wx26 (* #"&" *) => 
-	         let 
-		    val (c1,a1,q1) = getChar(a,q)
-		    val caq2 = 
-		       if c1=0wx23 (* #"#" *)
-			  then let val err = ERR_FORBIDDEN_HERE(IT_CHAR_REF,locOf wher)
-				   val a2 = hookError(a1,(getPos q,err))
-			       in skipCharRef (a2,q1)
-			       end
-		       else let val err = ERR_FORBIDDEN_HERE(IT_REF,locOf wher)
-				val a2 = hookError(a1,(getPos q,err))
-			    in skipReference (c1,a2,q1)
-			    end
-		 in doit wher caq2
-		 end
-	       | 0wx3C (* #"<" *) => 
-		 let val (c1,a1,q1) = getChar (a,q)
-		 in case c1
-		      of 0wx21 (* #"!" *) => 
-			 let val (wher1,caq2) = do_decl wher q (getChar(a1,q1))
-			 in doit wher1 caq2
-			 end
-		       | 0wx2F (* #"/" *) => 
-			 let 
-			    val err = ERR_FORBIDDEN_HERE(IT_ETAG,locOf wher)
-			    val a2 = hookError(a1,(getPos q,err))
-			    val caq3 = skipTag LOC_ETAG (a2,q1)
-			 in doit wher caq3
-			 end
-		       | 0wx3F (* #"?" *) => doit wher (parseProcInstr (getPos q) (a1,q1))
-		       | _ => 
-			 if isName c1 then 
-			    let val wher1 = 
-			       case wher
-				 of PROLOG => INSTANCE NONE
-				  | _ => wher
-			    in case wher1 
-				 of PROLOG => 
-				    raise InternalError(THIS_MODULE,"parseDoc.doit","")
-				  | EPILOG => 
-				    let 
-				       val err = ERR_FORBIDDEN_HERE(IT_STAG,LOC_EPILOG)
-				       val a2 = hookError(a1,(getPos q,err))
-				       val caq3 = skipTag LOC_STAG (a2,q1)
-				    in doit EPILOG caq3
-				    end
-				  | INSTANCE doc => 
-				    (let 
-					val a2 = 
-					   if not (!O_VALIDATE) orelse isSome doc then a1
-					   else hookError(a1,(getPos q,ERR_NO_DTD))
-					val (stag,(c3,a3,q3)) = parseSTag 
-					   dtd (getPos q) (c1,a2,q1)
-					val a4 = checkRoot dtd (a3,q1) (doc,stag)
-					val (opt,(c5,a5,q5)) = parseElement 
-					   (dtd,nil,q,stag,(c3,a4,q3))
-					val a6 = checkDefinedIds dtd (a5,q5)
-				     in case opt
-					  of NONE => doit EPILOG (c5,a6,q5)
-					   | SOME (_,_,startPos,_) => 
-					     let 
-						val err = ERR_FORBIDDEN_HERE(IT_ETAG,LOC_EPILOG)
-						val a7 = hookError(a6,(startPos,err))
-					     in doit EPILOG (c5,a7,q5)
-					     end
-				     end
-					handle SyntaxError caq => doit wher1 caq)
-			    end
-			 else let val err = ERR_FORBIDDEN_HERE(IT_CHAR 0wx3C,locOf wher)
-				  val a2 = hookError(a1,(getPos q,err))
-			      in doit wher (c1,a2,q1)
-					  end
-		 end
-	       | _ => let val caq1 = do_data wher (c,a,q)
-		      in doit wher caq1
-		      end
+                val (ws,(c1,a1,q1)) = doit false nil caq
+                val a2 = if null ws then a1
+                         else hookWhite(a1,Data2Vector (rev ws))
+            in (c1,a2,q1)
+            end
+                            
+         fun do_decl wher q0 (c,a,q) =
+            case c
+              of 0wx2D (* #"-" *) => 
+                 let val (c1,a1,q1) = getChar(a,q)
+                 in if c1=0wx2D then (wher,parseComment (getPos q0) (a1,q1))
+                    else let val err = ERR_EXPECTED(expDash,[c1])
+                             val a2 = hookError(a1,(getPos q1,err))
+                             val caq2 = recoverDecl false (c1,a2,q1)
+                         in (wher,caq2)
+                         end
+                 end
+               | 0wx5B (* #"[" *) => 
+                 let 
+                    val err = ERR_FORBIDDEN_HERE (IT_CDATA,locOf wher)
+                    val a1 = hookError(a,(getPos q0,err))
+                    val caq2 = skipBadSection (getChar(a1,q))
+                 in (wher,caq2)
+                 end
+               | _ => 
+                 case wher 
+                   of PROLOG => 
+                      (let val (name,(c1,a1,q1)) = parseName (c,a,q)
+                          handle NotFound (c,a,q) => 
+                             let val err = expectedOrEnded(expDashDocLbrk,LOC_DECL) c
+                             in raise SyntaxError (c,hookError(a,(getPos q,err)),q)
+                             end
+                             
+                           val _ = if name=[0wx44,0wx4f,0wx43,0wx54,0wx59,0wx50,0wx45] 
+                                   (* "DOCTYPE" *) then ()
+                                   else let val err = ERR_EXPECTED(expDashDocLbrk,name)
+                                            val a2 = hookError(a1,(getPos q,err))
+                                        in raise SyntaxError (c1,a2,q1)
+                                        end
+                                        
+                           val (doc,caq2) = parseDocTypeDecl dtd (c1,a1,q1)
+                       in (INSTANCE doc,caq2)
+                       end
+                          handle SyntaxError caq => (PROLOG,recoverDecl true caq))
+                          
+                    | _ => let val loc = if wher=EPILOG then LOC_EPILOG else LOC_AFTER_DTD
+                               val err = ERR_FORBIDDEN_HERE (IT_DECL,loc)
+                               val a1 = hookError(a,(getPos q0,err))
+                               val caq2 = skipDecl true (c,a1,q)
+                           in (wher,caq2)
+                           end
+                           
+         and doit wher (c,a,q) = 
+            case c 
+              of 0wx00 => if isSpecial q then (wher,(a,q))
+                          else doit wher (getChar(a,q))
+               (*--------------------------------------------------------------*)
+               (* References are forbidden outside the document element        *) 
+               (*--------------------------------------------------------------*)
+               | 0wx26 (* #"&" *) => 
+                 let 
+                    val (c1,a1,q1) = getChar(a,q)
+                    val caq2 = 
+                       if c1=0wx23 (* #"#" *)
+                          then let val err = ERR_FORBIDDEN_HERE(IT_CHAR_REF,locOf wher)
+                                   val a2 = hookError(a1,(getPos q,err))
+                               in skipCharRef (a2,q1)
+                               end
+                       else let val err = ERR_FORBIDDEN_HERE(IT_REF,locOf wher)
+                                val a2 = hookError(a1,(getPos q,err))
+                            in skipReference (c1,a2,q1)
+                            end
+                 in doit wher caq2
+                 end
+               | 0wx3C (* #"<" *) => 
+                 let val (c1,a1,q1) = getChar (a,q)
+                 in case c1
+                      of 0wx21 (* #"!" *) => 
+                         let val (wher1,caq2) = do_decl wher q (getChar(a1,q1))
+                         in doit wher1 caq2
+                         end
+                       | 0wx2F (* #"/" *) => 
+                         let 
+                            val err = ERR_FORBIDDEN_HERE(IT_ETAG,locOf wher)
+                            val a2 = hookError(a1,(getPos q,err))
+                            val caq3 = skipTag LOC_ETAG (a2,q1)
+                         in doit wher caq3
+                         end
+                       | 0wx3F (* #"?" *) => doit wher (parseProcInstr (getPos q) (a1,q1))
+                       | _ => 
+                         if isName c1 then 
+                            let val wher1 = 
+                               case wher
+                                 of PROLOG => INSTANCE NONE
+                                  | _ => wher
+                            in case wher1 
+                                 of PROLOG => 
+                                    raise InternalError(THIS_MODULE,"parseDoc.doit","")
+                                  | EPILOG => 
+                                    let 
+                                       val err = ERR_FORBIDDEN_HERE(IT_STAG,LOC_EPILOG)
+                                       val a2 = hookError(a1,(getPos q,err))
+                                       val caq3 = skipTag LOC_STAG (a2,q1)
+                                    in doit EPILOG caq3
+                                    end
+                                  | INSTANCE doc => 
+                                    (let 
+                                        val a2 = 
+                                           if not (!O_VALIDATE) orelse isSome doc then a1
+                                           else hookError(a1,(getPos q,ERR_NO_DTD))
+                                        val (stag,(c3,a3,q3)) = parseSTag 
+                                           dtd (getPos q) (c1,a2,q1)
+                                        val a4 = checkRoot dtd (a3,q1) (doc,stag)
+                                        val (opt,(c5,a5,q5)) = parseElement 
+                                           (dtd,nil,q,stag,(c3,a4,q3))
+                                        val a6 = checkDefinedIds dtd (a5,q5)
+                                     in case opt
+                                          of NONE => doit EPILOG (c5,a6,q5)
+                                           | SOME (_,_,startPos,_) => 
+                                             let 
+                                                val err = ERR_FORBIDDEN_HERE(IT_ETAG,LOC_EPILOG)
+                                                val a7 = hookError(a6,(startPos,err))
+                                             in doit EPILOG (c5,a7,q5)
+                                             end
+                                     end
+                                        handle SyntaxError caq => doit wher1 caq)
+                            end
+                         else let val err = ERR_FORBIDDEN_HERE(IT_CHAR 0wx3C,locOf wher)
+                                  val a2 = hookError(a1,(getPos q,err))
+                              in doit wher (c1,a2,q1)
+                                          end
+                 end
+               | _ => let val caq1 = do_data wher (c,a,q)
+                      in doit wher caq1
+                      end
       in 
-	 doit PROLOG caq
-      end	       
+         doit PROLOG caq
+      end              
 
    (* to false. (cf. 2.9)                                                *)
    (*                                                                    *) 
@@ -14553,21 +14553,21 @@
    (*   value "no" is assumed.                                           *)
    fun parseDocument uriOpt dtdOpt a = 
       let 
-	 val dtd = case dtdOpt 
-		     of NONE => initDtdTables () 
-		      | SOME dtd => dtd 
-	 val (enc,xmlDecl,(c1,a1,q1)) = openDocument uriOpt a
-	 val uri = getUri q1
-	 val alone = case xmlDecl 
-		       of (SOME(_,_,SOME sa)) => sa
-			| _ => false
-	 val _ = if alone then setStandAlone dtd true else ()
-	 val a2 = hookXml(a1,(uri,enc,xmlDecl))
-	 val (wher,(a3,q3)) = parseDoc dtd (c1,a2,q1)
-	 val _ = closeAll q3
-	 val a4 = case wher 
-		    of EPILOG => a3
-		     | _ => hookError(a3,(getPos q3,ERR_ENDED_IN_PROLOG))
+         val dtd = case dtdOpt 
+                     of NONE => initDtdTables () 
+                      | SOME dtd => dtd 
+         val (enc,xmlDecl,(c1,a1,q1)) = openDocument uriOpt a
+         val uri = getUri q1
+         val alone = case xmlDecl 
+                       of (SOME(_,_,SOME sa)) => sa
+                        | _ => false
+         val _ = if alone then setStandAlone dtd true else ()
+         val a2 = hookXml(a1,(uri,enc,xmlDecl))
+         val (wher,(a3,q3)) = parseDoc dtd (c1,a2,q1)
+         val _ = closeAll q3
+         val a4 = case wher 
+                    of EPILOG => a3
+                     | _ => hookError(a3,(getPos q3,ERR_ENDED_IN_PROLOG))
       in hookFinish a4
       end
    handle CantOpenFile(fmsg,a) => 
@@ -14594,18 +14594,18 @@
       val Position2String : Position -> string
 
       datatype Location =
-	 LOC_CATALOG
+         LOC_CATALOG
        | LOC_COMMENT
        | LOC_NOCOMMENT
        | LOC_PUBID
        | LOC_SYSID
-	 
+         
       datatype Expected =
-	 EXP_NAME
+         EXP_NAME
        | EXP_LITERAL
 
       datatype CatError =
-	 ERR_DECODE_ERROR of Decode.Error.DecodeError
+         ERR_DECODE_ERROR of Decode.Error.DecodeError
        | ERR_NO_SUCH_FILE of string * string
        | ERR_ILLEGAL_HERE of UniChar.Char * Location
        | ERR_MISSING_WHITE 
@@ -14626,43 +14626,43 @@
       val nullPosition = ("",0,0)
 
       fun Position2String (fname,l,c) = 
-	 if fname="" then "" 
-	 else String.concat ["[",fname,":",Int2String l,".",Int2String c,"]"]
+         if fname="" then "" 
+         else String.concat ["[",fname,":",Int2String l,".",Int2String c,"]"]
 
       datatype Location =
-	 LOC_CATALOG
+         LOC_CATALOG
        | LOC_COMMENT
        | LOC_NOCOMMENT
        | LOC_PUBID
        | LOC_SYSID
 
       fun Location2String loc =
-	 case loc 
-	   of LOC_CATALOG => "catalog file"
-	    | LOC_COMMENT => "comment"
-	    | LOC_NOCOMMENT => "something other than a comment"
-	    | LOC_PUBID   => "public identifier"
-	    | LOC_SYSID   => "system identifier"
+         case loc 
+           of LOC_CATALOG => "catalog file"
+            | LOC_COMMENT => "comment"
+            | LOC_NOCOMMENT => "something other than a comment"
+            | LOC_PUBID   => "public identifier"
+            | LOC_SYSID   => "system identifier"
       
       fun InLocation2String loc =
-	 case loc 
-	   of LOC_CATALOG => "in a catalog file"
-	    | LOC_COMMENT => "in a comment"
-	    | LOC_NOCOMMENT => "outside of comments"
-	    | LOC_PUBID   => "in a public identifier"
-	    | LOC_SYSID   => "in a system identifier"
+         case loc 
+           of LOC_CATALOG => "in a catalog file"
+            | LOC_COMMENT => "in a comment"
+            | LOC_NOCOMMENT => "outside of comments"
+            | LOC_PUBID   => "in a public identifier"
+            | LOC_SYSID   => "in a system identifier"
 
       datatype Expected =
-	 EXP_NAME
+         EXP_NAME
        | EXP_LITERAL
 
       fun Expected2String exp =
-	 case exp
-	   of EXP_NAME => "a name"
-	    | EXP_LITERAL => "a literal"
+         case exp
+           of EXP_NAME => "a name"
+            | EXP_LITERAL => "a literal"
 
       datatype CatError =
-	 ERR_DECODE_ERROR of Decode.Error.DecodeError
+         ERR_DECODE_ERROR of Decode.Error.DecodeError
        | ERR_NO_SUCH_FILE of string * string
        | ERR_ILLEGAL_HERE of UniChar.Char * Location
        | ERR_MISSING_WHITE 
@@ -14673,26 +14673,26 @@
        | ERR_NON_PUBID of UniChar.Data * UniChar.Data
 
       fun catMessage err =
-	 case err
-	   of ERR_DECODE_ERROR err => Decode.Error.decodeMessage err
-	    | ERR_NO_SUCH_FILE(f,msg) => ["Could not open file",quoteErrorString f,"("^msg^")"]
-	      
-	    | ERR_ILLEGAL_HERE (c,loc) => 
-	      ["Character",quoteErrorChar c,"is not allowed",InLocation2String loc]
-	      
-	    | ERR_MISSING_WHITE => ["Missing white space"]
-	    | ERR_EOF loc => [toUpperFirst (Location2String loc),"ended by end of file"]
-	    | ERR_EXPECTED (exp,c) => 
-	      ["Expected",Expected2String exp,"but found",quoteErrorChar c]
+         case err
+           of ERR_DECODE_ERROR err => Decode.Error.decodeMessage err
+            | ERR_NO_SUCH_FILE(f,msg) => ["Could not open file",quoteErrorString f,"("^msg^")"]
+              
+            | ERR_ILLEGAL_HERE (c,loc) => 
+              ["Character",quoteErrorChar c,"is not allowed",InLocation2String loc]
+              
+            | ERR_MISSING_WHITE => ["Missing white space"]
+            | ERR_EOF loc => [toUpperFirst (Location2String loc),"ended by end of file"]
+            | ERR_EXPECTED (exp,c) => 
+              ["Expected",Expected2String exp,"but found",quoteErrorChar c]
 
-	    | ERR_XML err => errorMessage err
-	    | ERR_MISSING_ATT(elem,att) => 
-	      ["Element",quoteErrorData elem,"has no",quoteErrorData att,"attribute"]
-	    | ERR_NON_PUBID(att,cs) => 
-	      ["Value specified for attribute",quoteErrorData att,"contains non-PublicId",
-	       case cs 
-		 of [c] => "character"^quoteErrorChar c
-		  | cs => List2xString ("characters ",", ","") quoteErrorChar cs]
+            | ERR_XML err => errorMessage err
+            | ERR_MISSING_ATT(elem,att) => 
+              ["Element",quoteErrorData elem,"has no",quoteErrorData att,"attribute"]
+            | ERR_NON_PUBID(att,cs) => 
+              ["Value specified for attribute",quoteErrorData att,"contains non-PublicId",
+               case cs 
+                 of [c] => "character"^quoteErrorChar c
+                  | cs => List2xString ("characters ",", ","") quoteErrorChar cs]
    end
 (* stop of ../../Catalog/catError.sml *)
 (* start of ../../Catalog/catParams.sml *)
@@ -14740,12 +14740,12 @@
 structure CatData =
    struct
       datatype CatEntry =
-	 E_BASE of Uri.Uri
+         E_BASE of Uri.Uri
        | E_DELEGATE of string * Uri.Uri
        | E_EXTEND of Uri.Uri
        | E_MAP of string * Uri.Uri
        | E_REMAP of Uri.Uri * Uri.Uri
-	 
+         
       type Catalog = Uri.Uri * CatEntry list
    end
 (* stop of ../../Catalog/catData.sml *)
@@ -14763,7 +14763,7 @@
    sig
       type CatFile
       type Position
-	 
+         
       val catOpenFile  : Uri.Uri -> CatFile 
       val catCloseFile : CatFile -> unit
       val catGetChar   : CatFile -> UniChar.Char * CatFile
@@ -14779,49 +14779,49 @@
       val startPos = (0,1,false)
 
       datatype CatFile =
-	 NOFILE of string * PosInfo 
+         NOFILE of string * PosInfo 
        | DIRECT of DecFile * PosInfo
 
       fun catPos cf =
-	 case cf 
-	   of NOFILE (uri,(col,line,_)) => (uri,line,col)
-	    | DIRECT (dec,(col,line,_)) => (decName dec,line,col)
-	      
+         case cf 
+           of NOFILE (uri,(col,line,_)) => (uri,line,col)
+            | DIRECT (dec,(col,line,_)) => (decName dec,line,col)
+              
       fun catOpenFile uri =
-	 let val dec = decOpenUni(SOME uri,!O_CATALOG_ENC)
-	 in DIRECT(dec,startPos)
-	 end
+         let val dec = decOpenUni(SOME uri,!O_CATALOG_ENC)
+         in DIRECT(dec,startPos)
+         end
       handle NoSuchFile fmsg => let val _ = catError(nullPosition,ERR_NO_SUCH_FILE fmsg)
-				in NOFILE(Uri2String uri,startPos)
-				end
-	 
+                                in NOFILE(Uri2String uri,startPos)
+                                end
+         
       fun catCloseFile cf =
-	 case cf
-	   of NOFILE _ => ()
-	    | DIRECT(dec,_) => ignore (decClose dec)
+         case cf
+           of NOFILE _ => ()
+            | DIRECT(dec,_) => ignore (decClose dec)
 
       fun catGetChar cf =
-	 case cf
-	   of NOFILE _ => (0wx00,cf)
-	    | DIRECT(dec,(col,line,brk)) => 
-	      (let val (c,dec1) = decGetChar dec
-	       in case c
-		    of 0wx09 => (c,DIRECT(dec1,(col+1,line,false)))
-		     | 0wx0A => if brk then catGetChar(DIRECT(dec1,(col,line,false)))
-				else (c,DIRECT(dec1,(0,line+1,false)))
-		     | 0wx0D => (0wx0A,DIRECT(dec1,(0,line+1,true)))
-		     | _     => if c>=0wx20 then (c,DIRECT(dec1,(col+1,line,false)))
-				else let val err = ERR_ILLEGAL_HERE(c,LOC_CATALOG)
-					 val _ = catError(catPos cf,err)
-				     in catGetChar(DIRECT(dec1,(col+1,line,false))) 
-				     end
-	       end 
-		  handle DecEof dec => (0wx00,NOFILE(decName dec,(col,line,brk)))
-		       | DecError(dec,_,err) => 
-		     let val _ = catError(catPos cf,ERR_DECODE_ERROR err)
-		     in catGetChar(DIRECT(dec,(col,line,false)))
-		     end
-		     )
+         case cf
+           of NOFILE _ => (0wx00,cf)
+            | DIRECT(dec,(col,line,brk)) => 
+              (let val (c,dec1) = decGetChar dec
+               in case c
+                    of 0wx09 => (c,DIRECT(dec1,(col+1,line,false)))
+                     | 0wx0A => if brk then catGetChar(DIRECT(dec1,(col,line,false)))
+                                else (c,DIRECT(dec1,(0,line+1,false)))
+                     | 0wx0D => (0wx0A,DIRECT(dec1,(0,line+1,true)))
+                     | _     => if c>=0wx20 then (c,DIRECT(dec1,(col+1,line,false)))
+                                else let val err = ERR_ILLEGAL_HERE(c,LOC_CATALOG)
+                                         val _ = catError(catPos cf,err)
+                                     in catGetChar(DIRECT(dec1,(col+1,line,false))) 
+                                     end
+               end 
+                  handle DecEof dec => (0wx00,NOFILE(decName dec,(col,line,brk)))
+                       | DecError(dec,_,err) => 
+                     let val _ = catError(catPos cf,ERR_DECODE_ERROR err)
+                     in catGetChar(DIRECT(dec,(col,line,false)))
+                     end
+                     )
    end
 
 (* stop of ../../Catalog/catFile.sml *)
@@ -14852,18 +14852,18 @@
       val getChar = catGetChar
 
       fun parseName' (c,f) = 
-	 if isName c then let val (cs,cf1) = parseName' (getChar f)
-			  in (c::cs,cf1)
-			  end
-	 else (nil,(c,f))
+         if isName c then let val (cs,cf1) = parseName' (getChar f)
+                          in (c::cs,cf1)
+                          end
+         else (nil,(c,f))
       fun parseName (c,f) = 
-	 if isNms c then let val (cs,cf1) = parseName' (getChar f)
-			 in (c::cs,cf1)
-			 end
-	 else raise NotFound (c,f)
+         if isNms c then let val (cs,cf1) = parseName' (getChar f)
+                         in (c::cs,cf1)
+                         end
+         else raise NotFound (c,f)
 
       datatype Keyword = 
-	 KW_BASE
+         KW_BASE
        | KW_CATALOG
        | KW_DELEGATE
        | KW_PUBLIC
@@ -14871,253 +14871,253 @@
        | KW_OTHER of UniChar.Data
 
       fun parseKeyword cf = 
-	 let 
-	    val (name,cf1) = parseName cf
-	    val kw = case name
-		       of [0wx42,0wx41,0wx53,0wx45] => KW_BASE
-			| [0wx43,0wx41,0wx54,0wx41,0wx4c,0wx4f,0wx47] => KW_CATALOG
-			| [0wx44,0wx45,0wx4c,0wx45,0wx47,0wx41,0wx54,0wx45] => KW_DELEGATE
-			| [0wx50,0wx55,0wx42,0wx4c,0wx49,0wx43] => KW_PUBLIC
-			| [0wx53,0wx59,0wx53,0wx54,0wx45,0wx4d] => KW_SYSTEM
-			| _ => KW_OTHER name
-	 in (kw,cf1)
-	 end
+         let 
+            val (name,cf1) = parseName cf
+            val kw = case name
+                       of [0wx42,0wx41,0wx53,0wx45] => KW_BASE
+                        | [0wx43,0wx41,0wx54,0wx41,0wx4c,0wx4f,0wx47] => KW_CATALOG
+                        | [0wx44,0wx45,0wx4c,0wx45,0wx47,0wx41,0wx54,0wx45] => KW_DELEGATE
+                        | [0wx50,0wx55,0wx42,0wx4c,0wx49,0wx43] => KW_PUBLIC
+                        | [0wx53,0wx59,0wx53,0wx54,0wx45,0wx4d] => KW_SYSTEM
+                        | _ => KW_OTHER name
+         in (kw,cf1)
+         end
 
       fun parseSysLit' quote f =
-	 let 
-	    fun doit text (c,f) = 
-	       if c=quote then (text,getChar f)
-	       else if c<>0wx0 then doit (c::text) (getChar f)
-		    else let val _ = catError(catPos f,ERR_EOF LOC_SYSID)
-			 in (text,(c,f))
-			 end
-	    val (text,cf1) = doit nil (getChar f)
-	 in (Data2Uri(rev text),cf1)
-	 end
+         let 
+            fun doit text (c,f) = 
+               if c=quote then (text,getChar f)
+               else if c<>0wx0 then doit (c::text) (getChar f)
+                    else let val _ = catError(catPos f,ERR_EOF LOC_SYSID)
+                         in (text,(c,f))
+                         end
+            val (text,cf1) = doit nil (getChar f)
+         in (Data2Uri(rev text),cf1)
+         end
       fun parseSysLit req (c,f) = 
-	 if c=0wx22 orelse c=0wx27 then parseSysLit' c f 
-	 else if req then let val _ = catError(catPos f,ERR_EXPECTED(EXP_LITERAL,c))
-			  in raise SyntaxError (c,f) 
-			  end
-	      else raise NotFound (c,f)
+         if c=0wx22 orelse c=0wx27 then parseSysLit' c f 
+         else if req then let val _ = catError(catPos f,ERR_EXPECTED(EXP_LITERAL,c))
+                          in raise SyntaxError (c,f) 
+                          end
+              else raise NotFound (c,f)
 
       fun parsePubLit' quote f =
-	 let 
-	    fun doit (hadSpace,atStart,text) (c,f) = 
-	       case c
-		 of 0wx0 => let val _ = catError(catPos f,ERR_EOF LOC_PUBID)
-			    in (text,(c,f))
-			    end
-		  | 0wx0A => doit (true,atStart,text) (getChar f)
-		  | 0wx20 => doit (true,atStart,text) (getChar f)
-		  | _ => 
-		    if c=quote then (text,getChar f)
-		    else if isPubid c 
-			    then if hadSpace andalso not atStart 
-				    then doit (false,false,c::0wx20::text) (getChar f)
-				 else doit (false,false,c::text) (getChar f)
-			 else let val _ = catError(catPos f,ERR_ILLEGAL_HERE(c,LOC_PUBID))
-			      in doit (hadSpace,atStart,text) (getChar f)
-			      end
-	    val (text,cf1) = doit (false,true,nil) (getChar f)
-	 in (Latin2String(rev text),cf1)
-	 end
+         let 
+            fun doit (hadSpace,atStart,text) (c,f) = 
+               case c
+                 of 0wx0 => let val _ = catError(catPos f,ERR_EOF LOC_PUBID)
+                            in (text,(c,f))
+                            end
+                  | 0wx0A => doit (true,atStart,text) (getChar f)
+                  | 0wx20 => doit (true,atStart,text) (getChar f)
+                  | _ => 
+                    if c=quote then (text,getChar f)
+                    else if isPubid c 
+                            then if hadSpace andalso not atStart 
+                                    then doit (false,false,c::0wx20::text) (getChar f)
+                                 else doit (false,false,c::text) (getChar f)
+                         else let val _ = catError(catPos f,ERR_ILLEGAL_HERE(c,LOC_PUBID))
+                              in doit (hadSpace,atStart,text) (getChar f)
+                              end
+            val (text,cf1) = doit (false,true,nil) (getChar f)
+         in (Latin2String(rev text),cf1)
+         end
       fun parsePubLit (c,f) = 
-	 if c=0wx22 orelse c=0wx27 then parsePubLit' c f 
-	 else let val _ = catError(catPos f,ERR_EXPECTED(EXP_LITERAL,c))
-	      in raise SyntaxError (c,f) 
-	      end
+         if c=0wx22 orelse c=0wx27 then parsePubLit' c f 
+         else let val _ = catError(catPos f,ERR_EXPECTED(EXP_LITERAL,c))
+              in raise SyntaxError (c,f) 
+              end
 
       fun skipComment (c,f) =
-	 case c 
-	   of 0wx00 => let val _ = catError(catPos f,ERR_EOF LOC_COMMENT)
-		       in (c,f)
-		       end
-	    | 0wx2D => let val (c1,f1) = getChar f
-		       in if c1 = 0wx2D then (getChar f1) else skipComment (c1,f1)
-		       end
-	    | _ => skipComment (getChar f)
+         case c 
+           of 0wx00 => let val _ = catError(catPos f,ERR_EOF LOC_COMMENT)
+                       in (c,f)
+                       end
+            | 0wx2D => let val (c1,f1) = getChar f
+                       in if c1 = 0wx2D then (getChar f1) else skipComment (c1,f1)
+                       end
+            | _ => skipComment (getChar f)
       fun skipCopt (c,f) =
-	 case c 
-	   of 0wx00 => (c,f)
-	    | 0wx2D => let val (c1,f1) = getChar f
-		       in if c1=0wx2D then skipComment (getChar f1)
-			  else let val _ = catError(catPos f,ERR_ILLEGAL_HERE(c,LOC_NOCOMMENT))
-			       in (c1,f1)
-			       end
-		       end
-	    | _ => (c,f)
+         case c 
+           of 0wx00 => (c,f)
+            | 0wx2D => let val (c1,f1) = getChar f
+                       in if c1=0wx2D then skipComment (getChar f1)
+                          else let val _ = catError(catPos f,ERR_ILLEGAL_HERE(c,LOC_NOCOMMENT))
+                               in (c1,f1)
+                               end
+                       end
+            | _ => (c,f)
 
       fun skipScomm req0 cf = 
-	 let
-	    fun endit req (c,f) =
-	       if req andalso c<>0wx00 
-		  then let val _ = catError(catPos f,ERR_MISSING_WHITE)
-		       in (c,f) 
-		       end 
-	       else (c,f)
-	    fun doit req (c,f) = 
-	       case c
-		 of 0wx00 => endit req (c,f)
-		  | 0wx09 => doit false (getChar f)
-		  | 0wx0A => doit false (getChar f)
-		  | 0wx20 => doit false (getChar f)
-		  | 0wx22 => endit req (c,f)
-		  | 0wx27 => endit req (c,f)
-		  | 0wx2D => 
-		    let val (c1,f1) = getChar f
-		    in if c1=0wx2D 
-			  then let val _ = if not req then ()
-					   else catError(catPos f1,ERR_MISSING_WHITE)
-				   val cf1 = skipComment (getChar f1)
-			       in doit true cf1
-					end
-		       else let val _ = catError(catPos f,ERR_ILLEGAL_HERE(c,LOC_NOCOMMENT))
-			    in doit req (c1,f1)
-			    end
-		    end
-		  | _ => if isNms c then endit req (c,f) 
-			 else let val _ = catError(catPos f,ERR_ILLEGAL_HERE(c,LOC_NOCOMMENT))
-			      in doit req (getChar f)
-			      end
-	 in doit req0 cf
-	 end
+         let
+            fun endit req (c,f) =
+               if req andalso c<>0wx00 
+                  then let val _ = catError(catPos f,ERR_MISSING_WHITE)
+                       in (c,f) 
+                       end 
+               else (c,f)
+            fun doit req (c,f) = 
+               case c
+                 of 0wx00 => endit req (c,f)
+                  | 0wx09 => doit false (getChar f)
+                  | 0wx0A => doit false (getChar f)
+                  | 0wx20 => doit false (getChar f)
+                  | 0wx22 => endit req (c,f)
+                  | 0wx27 => endit req (c,f)
+                  | 0wx2D => 
+                    let val (c1,f1) = getChar f
+                    in if c1=0wx2D 
+                          then let val _ = if not req then ()
+                                           else catError(catPos f1,ERR_MISSING_WHITE)
+                                   val cf1 = skipComment (getChar f1)
+                               in doit true cf1
+                                        end
+                       else let val _ = catError(catPos f,ERR_ILLEGAL_HERE(c,LOC_NOCOMMENT))
+                            in doit req (c1,f1)
+                            end
+                    end
+                  | _ => if isNms c then endit req (c,f) 
+                         else let val _ = catError(catPos f,ERR_ILLEGAL_HERE(c,LOC_NOCOMMENT))
+                              in doit req (getChar f)
+                              end
+         in doit req0 cf
+         end
       
       val skipWS = skipScomm true 
       val skipCommWS = (skipScomm false) o skipCopt 
       val skipWSComm = skipScomm false
 
       fun skipOther cf =
-	 let 
-	    val cf1 = skipWS cf
-	    val cf2 = let val (_,cf') = parseName cf1
-		      in skipWS cf'
-		      end 
-		   handle NotFound cf => cf
+         let 
+            val cf1 = skipWS cf
+            val cf2 = let val (_,cf') = parseName cf1
+                      in skipWS cf'
+                      end 
+                   handle NotFound cf => cf
 
-	    fun doit cf =
-	       let val (_,cf1) = parseSysLit false cf
-	       in doit (skipWS cf1)
-	       end
-	    handle NotFound(c,f) => (c,f)
-	 in
-	    (NONE,doit cf2)
-	 end
+            fun doit cf =
+               let val (_,cf1) = parseSysLit false cf
+               in doit (skipWS cf1)
+               end
+            handle NotFound(c,f) => (c,f)
+         in
+            (NONE,doit cf2)
+         end
 
       fun parseBase cf =
-	 let 
-	    val cf1 = skipWS cf
-	    val (lit,cf2) = parseSysLit true cf1
-	    val cf3 = skipWS cf2
-	 in 
-	    (SOME(E_BASE lit),cf3)
-	 end
+         let 
+            val cf1 = skipWS cf
+            val (lit,cf2) = parseSysLit true cf1
+            val cf3 = skipWS cf2
+         in 
+            (SOME(E_BASE lit),cf3)
+         end
 
       fun parseExtend cf =
-	 let 
-	    val cf1 = skipWS cf
-	    val (lit,cf2) = parseSysLit true cf1
-	    val cf3 = skipWS cf2
-	 in 
-	    (SOME(E_EXTEND lit),cf3)
-	 end
+         let 
+            val cf1 = skipWS cf
+            val (lit,cf2) = parseSysLit true cf1
+            val cf3 = skipWS cf2
+         in 
+            (SOME(E_EXTEND lit),cf3)
+         end
 
       fun parseDelegate cf =
-	 let 
-	    val cf1 = skipWS cf
-	    val (pub,cf2) = parsePubLit cf1
-	    val cf3 = skipWS cf2
-	    val (sys,cf4) = parseSysLit true cf3
-	    val cf5 = skipWS cf4
-	 in 
-	    (SOME(E_DELEGATE(pub,sys)),cf5)
-	 end
+         let 
+            val cf1 = skipWS cf
+            val (pub,cf2) = parsePubLit cf1
+            val cf3 = skipWS cf2
+            val (sys,cf4) = parseSysLit true cf3
+            val cf5 = skipWS cf4
+         in 
+            (SOME(E_DELEGATE(pub,sys)),cf5)
+         end
 
       fun parseRemap cf =
-	 let 
-	    val cf1 = skipWS cf
-	    val (sys0,cf2) = parseSysLit true cf1
-	    val cf3 = skipWS cf2
-	    val (sys,cf4) = parseSysLit true cf3
-	    val cf5 = skipWS cf4
-	 in 
-	    (SOME(E_REMAP(sys0,sys)),cf5)
-	 end
+         let 
+            val cf1 = skipWS cf
+            val (sys0,cf2) = parseSysLit true cf1
+            val cf3 = skipWS cf2
+            val (sys,cf4) = parseSysLit true cf3
+            val cf5 = skipWS cf4
+         in 
+            (SOME(E_REMAP(sys0,sys)),cf5)
+         end
 
       fun parseMap cf =
-	 let 
-	    val cf1 = skipWS cf
-	    val (pub,cf2) = parsePubLit cf1
-	    val cf3 = skipWS cf2
-	    val (sys,cf4) = parseSysLit true cf3
-	    val cf5 = skipWS cf4
-	 in 
-	    (SOME(E_MAP(pub,sys)),cf5)
-	 end
+         let 
+            val cf1 = skipWS cf
+            val (pub,cf2) = parsePubLit cf1
+            val cf3 = skipWS cf2
+            val (sys,cf4) = parseSysLit true cf3
+            val cf5 = skipWS cf4
+         in 
+            (SOME(E_MAP(pub,sys)),cf5)
+         end
 
       fun recover cf =
-	 let 
-	    fun do_lit q (c,f) = 
-	       if c=0wx00 then (c,f) 
-	       else if c=q then getChar f 
-		    else do_lit q (getChar f)
-	    fun do_com (c,f) = 
-	       case c
-		  of 0wx00 => (c,f)
-		   | 0wx2D => let val (c1,f1) = getChar f
-			      in if c1=0wx2D then getChar f1
-				 else do_com (c1,f1)
-			      end
-		   | _ => do_com (getChar f)
-	    fun doit (c,f) =
-	       case c
-		 of 0wx00 => (c,f)
-		  | 0wx22 => doit (do_lit c (getChar f)) 
-		  | 0wx27 => doit (do_lit c (getChar f)) 
-		  | 0wx2D => let val (c1,f1) = getChar f
-			     in if c1=0wx2D then doit (do_com (getChar f1))
-				else doit (c1,f1)
-			     end
-		  | _ => if isNms c then (c,f)
-			 else doit (getChar f)
-	 in doit cf
-	 end
+         let 
+            fun do_lit q (c,f) = 
+               if c=0wx00 then (c,f) 
+               else if c=q then getChar f 
+                    else do_lit q (getChar f)
+            fun do_com (c,f) = 
+               case c
+                  of 0wx00 => (c,f)
+                   | 0wx2D => let val (c1,f1) = getChar f
+                              in if c1=0wx2D then getChar f1
+                                 else do_com (c1,f1)
+                              end
+                   | _ => do_com (getChar f)
+            fun doit (c,f) =
+               case c
+                 of 0wx00 => (c,f)
+                  | 0wx22 => doit (do_lit c (getChar f)) 
+                  | 0wx27 => doit (do_lit c (getChar f)) 
+                  | 0wx2D => let val (c1,f1) = getChar f
+                             in if c1=0wx2D then doit (do_com (getChar f1))
+                                else doit (c1,f1)
+                             end
+                  | _ => if isNms c then (c,f)
+                         else doit (getChar f)
+         in doit cf
+         end
       
       fun parseEntry (cf as (c,f)) = 
-	 let val (kw,cf1) = parseKeyword cf handle NotFound cf => raise SyntaxError cf
-	 in case kw
-	      of KW_BASE => parseBase cf1
-	       | KW_CATALOG => parseExtend cf1
-	       | KW_DELEGATE => parseDelegate cf1
-	       | KW_SYSTEM => parseRemap cf1
-	       | KW_PUBLIC => parseMap cf1
-	       | KW_OTHER _ => skipOther cf1
-	 end
+         let val (kw,cf1) = parseKeyword cf handle NotFound cf => raise SyntaxError cf
+         in case kw
+              of KW_BASE => parseBase cf1
+               | KW_CATALOG => parseExtend cf1
+               | KW_DELEGATE => parseDelegate cf1
+               | KW_SYSTEM => parseRemap cf1
+               | KW_PUBLIC => parseMap cf1
+               | KW_OTHER _ => skipOther cf1
+         end
       handle SyntaxError cf => (NONE,recover cf)
 
       fun parseDocument cf =
-	 let 
-	    fun doit (c,f) =
-	       if c=0wx0 then nil before catCloseFile f
-	       else let val (opt,cf1) = parseEntry (c,f)
-			val entries = doit cf1
-		    in case opt
-			 of NONE => entries
-			  | SOME entry => entry::entries
-		    end
+         let 
+            fun doit (c,f) =
+               if c=0wx0 then nil before catCloseFile f
+               else let val (opt,cf1) = parseEntry (c,f)
+                        val entries = doit cf1
+                    in case opt
+                         of NONE => entries
+                          | SOME entry => entry::entries
+                    end
 
-	    val cf1 = skipCommWS cf
-	 in 
-	    doit cf1
-	 end
+            val cf1 = skipCommWS cf
+         in 
+            doit cf1
+         end
 
       fun parseSoCat uri = 
-	 let 
-	    val f = catOpenFile uri
-	    val cf1 = getChar f
-	 in 
-	    (uri,parseDocument cf1)
-	 end
+         let 
+            val f = catOpenFile uri
+            val cf1 = getChar f
+         in 
+            (uri,parseDocument cf1)
+         end
    end
 (* stop of ../../Catalog/socatParse.sml *)
 (* start of ../../Catalog/catDtd.sml *)
@@ -15142,7 +15142,7 @@
 structure CatDtd =  
    struct
       open Dtd
-	 
+         
       val baseGi     = UniChar.String2Data "Base"
       val delegateGi = UniChar.String2Data "Delegate"
       val extendGi   = UniChar.String2Data "Extend"
@@ -15154,25 +15154,25 @@
       val sysidAtt   = UniChar.String2Data "SystemId"
 
       fun initDtdTables () = 
-	 let 
-	    val dtd = Dtd.initDtdTables()
-	    val _ = app (ignore o (Element2Index dtd)) [baseGi,delegateGi,extendGi,mapGi,remapGi]
-	    val _ = app (ignore o (AttNot2Index dtd)) [hrefAtt,pubidAtt,sysidAtt]
-	 in dtd
-	 end
+         let 
+            val dtd = Dtd.initDtdTables()
+            val _ = app (ignore o (Element2Index dtd)) [baseGi,delegateGi,extendGi,mapGi,remapGi]
+            val _ = app (ignore o (AttNot2Index dtd)) [hrefAtt,pubidAtt,sysidAtt]
+         in dtd
+         end
 
       local 
-	 val dtd = initDtdTables()
+         val dtd = initDtdTables()
       in 
-	 val baseIdx     = Element2Index dtd baseGi
-	 val delegateIdx = Element2Index dtd delegateGi
-	 val extendIdx   = Element2Index dtd extendGi
-	 val mapIdx      = Element2Index dtd mapGi
-	 val remapIdx    = Element2Index dtd remapGi
+         val baseIdx     = Element2Index dtd baseGi
+         val delegateIdx = Element2Index dtd delegateGi
+         val extendIdx   = Element2Index dtd extendGi
+         val mapIdx      = Element2Index dtd mapGi
+         val remapIdx    = Element2Index dtd remapGi
 
-	 val hrefIdx     = AttNot2Index dtd hrefAtt
-	 val pubidIdx    = AttNot2Index dtd pubidAtt
-	 val sysidIdx    = AttNot2Index dtd sysidAtt
+         val hrefIdx     = AttNot2Index dtd hrefAtt
+         val pubidIdx    = AttNot2Index dtd pubidAtt
+         val sysidIdx    = AttNot2Index dtd sysidAtt
       end
    end
 (* stop of ../../Catalog/catDtd.sml *)
@@ -15184,7 +15184,7 @@
 
       fun hookXml(a,_) = a
       fun hookFinish a = a
-	 
+         
       fun hookError(a,_) = a
       fun hookWarning(a,_) = a
 
@@ -15218,11 +15218,11 @@
    end
 
 functor CatHooks (structure Params : CatParams
-		  structure Dtd    : CatDtd   ) =
+                  structure Dtd    : CatDtd   ) =
    struct
       open 
-	 Dtd HookData IgnoreHooks Params UniChar UniClasses Uri UtilList
-	 CatData CatError
+         Dtd HookData IgnoreHooks Params UniChar UniClasses Uri UtilList
+         CatData CatError
 
       type AppData = Dtd * CatEntry list 
       type AppFinal = CatEntry list
@@ -15230,73 +15230,73 @@
       fun initCatHooks dtd = (dtd,nil)
 
       fun hookError (a,(pos,err)) = a before catError (pos,ERR_XML err)
-	 
+         
       fun getAtt dtd (pos,elem,att,trans) atts = 
-	 let
-	    val cvOpt = findAndMap 
-	       (fn (i,ap,_) => if i<>att then NONE
-			       else case ap 
-				      of AP_DEFAULT(_,cv,_) => SOME cv
-				       | AP_PRESENT(_,cv,_) => SOME cv
-				       | _ => NONE)
-	       atts
-	 in case cvOpt 
-	      of SOME cv => trans (pos,att) cv
-	       | NONE => NONE before catError
-		 (pos,ERR_MISSING_ATT(Index2Element dtd elem,Index2AttNot dtd att))
-	 end
+         let
+            val cvOpt = findAndMap 
+               (fn (i,ap,_) => if i<>att then NONE
+                               else case ap 
+                                      of AP_DEFAULT(_,cv,_) => SOME cv
+                                       | AP_PRESENT(_,cv,_) => SOME cv
+                                       | _ => NONE)
+               atts
+         in case cvOpt 
+              of SOME cv => trans (pos,att) cv
+               | NONE => NONE before catError
+                 (pos,ERR_MISSING_ATT(Index2Element dtd elem,Index2AttNot dtd att))
+         end
 
       fun makePubid dtd (pos,att) cv = 
-	 let val (cs,bad) = 
-	    Vector.foldr
-	    (fn (c,(cs,bad)) => if isPubid c then (Char2char c::cs,bad)
-				else (cs,c::bad)) 
-	    (nil,nil) cv
-	 in if null bad then SOME(String.implode cs)
-	    else NONE before catError(pos,ERR_NON_PUBID(Index2AttNot dtd att,bad))
-	 end
+         let val (cs,bad) = 
+            Vector.foldr
+            (fn (c,(cs,bad)) => if isPubid c then (Char2char c::cs,bad)
+                                else (cs,c::bad)) 
+            (nil,nil) cv
+         in if null bad then SOME(String.implode cs)
+            else NONE before catError(pos,ERR_NON_PUBID(Index2AttNot dtd att,bad))
+         end
 
       fun makeUri (pos,att) cv = SOME cv
   
       fun hookStartTag (a as (dtd,items),((_,pos),elem,atts,_,_)) = 
-	 if elem=baseIdx 
-	    then let val hrefOpt = getAtt dtd (pos,elem,hrefIdx,makeUri) atts
-		 in case hrefOpt
-		      of NONE => a
-		       | SOME href => (dtd,E_BASE (Vector2Uri href)::items)
-		 end
-	 else if elem=delegateIdx
-		 then let val hrefOpt = getAtt dtd (pos,elem,hrefIdx,makeUri) atts
-			  val pubidOpt = getAtt dtd (pos,elem,pubidIdx,makePubid dtd) atts
-		      in case (hrefOpt,pubidOpt)
-			   of (SOME href,SOME pubid) => 
-			      (dtd,E_DELEGATE(pubid,Vector2Uri href)::items)
-			    | _ => a
-		      end
-	 else if elem=extendIdx
-		 then let val hrefOpt = getAtt dtd (pos,elem,hrefIdx,makeUri) atts
-		      in case hrefOpt
-			   of NONE => a
-			    | SOME href => (dtd,E_EXTEND (Vector2Uri href)::items)
-		      end
-	 else if elem=mapIdx
-		 then let val hrefOpt = getAtt dtd (pos,elem,hrefIdx,makeUri) atts
-			  val pubidOpt = getAtt dtd (pos,elem,pubidIdx,makePubid dtd) atts
-		      in case (hrefOpt,pubidOpt)
-			   of (SOME href,SOME pubid) => 
-			      (dtd,E_MAP(pubid,Vector2Uri href)::items)
-			    | _ => a
-		      end
-	 else if elem=remapIdx
-		 then let val hrefOpt = getAtt dtd (pos,elem,hrefIdx,makeUri) atts
-			  val sysidOpt = getAtt dtd (pos,elem,sysidIdx,makeUri) atts
-		      in case (hrefOpt,sysidOpt)
-			   of (SOME href,SOME sysid) => 
-			      (dtd,E_REMAP(Vector2Uri sysid,Vector2Uri href)::items)
-			    | _ => a
-		      end
-	      else a
-		 
+         if elem=baseIdx 
+            then let val hrefOpt = getAtt dtd (pos,elem,hrefIdx,makeUri) atts
+                 in case hrefOpt
+                      of NONE => a
+                       | SOME href => (dtd,E_BASE (Vector2Uri href)::items)
+                 end
+         else if elem=delegateIdx
+                 then let val hrefOpt = getAtt dtd (pos,elem,hrefIdx,makeUri) atts
+                          val pubidOpt = getAtt dtd (pos,elem,pubidIdx,makePubid dtd) atts
+                      in case (hrefOpt,pubidOpt)
+                           of (SOME href,SOME pubid) => 
+                              (dtd,E_DELEGATE(pubid,Vector2Uri href)::items)
+                            | _ => a
+                      end
+         else if elem=extendIdx
+                 then let val hrefOpt = getAtt dtd (pos,elem,hrefIdx,makeUri) atts
+                      in case hrefOpt
+                           of NONE => a
+                            | SOME href => (dtd,E_EXTEND (Vector2Uri href)::items)
+                      end
+         else if elem=mapIdx
+                 then let val hrefOpt = getAtt dtd (pos,elem,hrefIdx,makeUri) atts
+                          val pubidOpt = getAtt dtd (pos,elem,pubidIdx,makePubid dtd) atts
+                      in case (hrefOpt,pubidOpt)
+                           of (SOME href,SOME pubid) => 
+                              (dtd,E_MAP(pubid,Vector2Uri href)::items)
+                            | _ => a
+                      end
+         else if elem=remapIdx
+                 then let val hrefOpt = getAtt dtd (pos,elem,hrefIdx,makeUri) atts
+                          val sysidOpt = getAtt dtd (pos,elem,sysidIdx,makeUri) atts
+                      in case (hrefOpt,sysidOpt)
+                           of (SOME href,SOME sysid) => 
+                              (dtd,E_REMAP(Vector2Uri sysid,Vector2Uri href)::items)
+                            | _ => a
+                      end
+              else a
+                 
       fun hookFinish (_,items) = rev items
    end
 (* stop of ../../Catalog/catHooks.sml *)
@@ -15311,64 +15311,64 @@
       structure SocatParse = SocatParse (structure Params = Params) 
 
       structure ParserOptions = 
-	 struct
-	    structure Options = ParserOptions()
-	    open Options
-	       
-	    local 
-	       fun setDefaults() = 
-		  let 
-		     val _ = setParserDefaults()
-			
-		     val _ = O_WARN_MULT_ENUM      := false
-		     val _ = O_WARN_XML_DECL       := false
-		     val _ = O_WARN_ATT_NO_ELEM    := false
-		     val _ = O_WARN_MULT_ENT_DECL  := false
-		     val _ = O_WARN_MULT_NOT_DECL  := false
-		     val _ = O_WARN_MULT_ATT_DEF   := false
-		     val _ = O_WARN_MULT_ATT_DECL  := false
-		     val _ = O_WARN_SHOULD_DECLARE := false
-			
-		     val _ = O_VALIDATE            := false
-		     val _ = O_COMPATIBILITY       := false
-		     val _ = O_INTEROPERABILITY    := false
-			
-		     val _ = O_INCLUDE_EXT_PARSED  := true
-		  in ()
-		  end
-	    in 
-	       val setParserDefaults = setDefaults
-	    end
+         struct
+            structure Options = ParserOptions()
+            open Options
+               
+            local 
+               fun setDefaults() = 
+                  let 
+                     val _ = setParserDefaults()
+                        
+                     val _ = O_WARN_MULT_ENUM      := false
+                     val _ = O_WARN_XML_DECL       := false
+                     val _ = O_WARN_ATT_NO_ELEM    := false
+                     val _ = O_WARN_MULT_ENT_DECL  := false
+                     val _ = O_WARN_MULT_NOT_DECL  := false
+                     val _ = O_WARN_MULT_ATT_DEF   := false
+                     val _ = O_WARN_MULT_ATT_DECL  := false
+                     val _ = O_WARN_SHOULD_DECLARE := false
+                        
+                     val _ = O_VALIDATE            := false
+                     val _ = O_COMPATIBILITY       := false
+                     val _ = O_INTEROPERABILITY    := false
+                        
+                     val _ = O_INCLUDE_EXT_PARSED  := true
+                  in ()
+                  end
+            in 
+               val setParserDefaults = setDefaults
+            end
 
-	 end
+         end
       structure CatHooks = CatHooks (structure Params = Params
-				     structure Dtd    = CatDtd)
+                                     structure Dtd    = CatDtd)
       structure Parse = Parse (structure Dtd = CatDtd
-			       structure Hooks = CatHooks
-			       structure Resolve = ResolveNull
-			       structure ParserOptions = ParserOptions)
-	 
+                               structure Hooks = CatHooks
+                               structure Resolve = ResolveNull
+                               structure ParserOptions = ParserOptions)
+         
       open CatHooks CatDtd Parse ParserOptions SocatParse Uri
 
       fun parseXmlCat uri = 
-	 let 
-	    val _ = setParserDefaults()
-	    val dtd = initDtdTables()
-	    val items = parseDocument (SOME uri) (SOME dtd) (initCatHooks dtd)
-	 in 
-	    (uri,items)
-	 end
+         let 
+            val _ = setParserDefaults()
+            val dtd = initDtdTables()
+            val items = parseDocument (SOME uri) (SOME dtd) (initCatHooks dtd)
+         in 
+            (uri,items)
+         end
 
       fun isSocatSuffix x = x="soc" orelse x="SOC"
       fun isXmlSuffix x = x="xml" orelse x="XML"
 
       fun parseCatalog uri = 
-	 let val suffix = uriSuffix uri
-	 in if isSocatSuffix suffix then parseSoCat uri 
- 	    else (if isXmlSuffix suffix then parseXmlCat uri
-		  else (if !O_PREFER_SOCAT then parseSoCat uri 
-			else parseXmlCat uri))
-	 end
+         let val suffix = uriSuffix uri
+         in if isSocatSuffix suffix then parseSoCat uri 
+            else (if isXmlSuffix suffix then parseXmlCat uri
+                  else (if !O_PREFER_SOCAT then parseSoCat uri 
+                        else parseXmlCat uri))
+         end
    end
 (* stop of ../../Catalog/catParse.sml *)
 (* start of ../../Catalog/catalog.sml *)
@@ -15393,123 +15393,123 @@
       open CatData CatParse Params Uri UriDict
 
       val catDict = makeDict("catalog",6,NONE:Catalog option)
-	 
+         
       fun getCatalog uri = 
-	 let val idx = getIndex(catDict,uri)
-	 in case getByIndex(catDict,idx)
-	      of SOME cat => cat
-	       | NONE => let val cat = parseCatalog uri
-			     val _ = setByIndex(catDict,idx,SOME cat)
-			 in cat
-			 end
-	 end
+         let val idx = getIndex(catDict,uri)
+         in case getByIndex(catDict,idx)
+              of SOME cat => cat
+               | NONE => let val cat = parseCatalog uri
+                             val _ = setByIndex(catDict,idx,SOME cat)
+                         in cat
+                         end
+         end
 
       datatype SearchType =  
-	  SYS of Uri
-	| PUB of string
+          SYS of Uri
+        | PUB of string
       datatype SearchResult = 
-	  FOUND of Uri * Uri
-	| NOTFOUND of Uri list
-	  
+          FOUND of Uri * Uri
+        | NOTFOUND of Uri list
+          
       fun searchId id =
-	 let
-	    fun searchOne (base,other) nil = NOTFOUND other
-	      | searchOne (base,other) (entry::entries) = 
-	       case entry
-		 of E_BASE path => 
-		    let val newBase = uriJoin(base,path)
-		    in searchOne (newBase,other) entries
-		    end
-		  | E_EXTEND path => 
-		    let val fullPath = uriJoin(base,path)
-		    in searchOne (base,fullPath::other) entries 
-		    end
-		  | E_DELEGATE(prefix,path) => 
-		    (case id
-		       of PUB pid => if String.isPrefix prefix pid 
-					then let val fullPath = uriJoin(base,path)
-					     in searchOne (base,fullPath::other) entries
-					     end
-				     else searchOne (base,other) entries 
-			| SYS _ => searchOne (base,other) entries)
-		  | E_MAP(pubid,path) => 
-		    (case id 
-		       of PUB pid => if pubid=pid then FOUND (base,path)
-				     else searchOne (base,other) entries
-			| _ => searchOne (base,other) entries)
-		  | E_REMAP(sysid,path) => 
-	            (case id
-		       of SYS sid => if sysid=sid then FOUND(base,path)
-				     else searchOne (base,other) entries 
-			| _ => searchOne (base,other) entries)
-			
-	    fun searchLevel other nil = NOTFOUND(rev other)
-	      | searchLevel other (fname::fnames) = 
-	       let 
-		  val (base,entries) = getCatalog fname
-	       in 
-		  case searchOne (base,other) entries 
-		    of FOUND bp => FOUND bp
-		     | NOTFOUND other' => searchLevel other' fnames
-	       end
+         let
+            fun searchOne (base,other) nil = NOTFOUND other
+              | searchOne (base,other) (entry::entries) = 
+               case entry
+                 of E_BASE path => 
+                    let val newBase = uriJoin(base,path)
+                    in searchOne (newBase,other) entries
+                    end
+                  | E_EXTEND path => 
+                    let val fullPath = uriJoin(base,path)
+                    in searchOne (base,fullPath::other) entries 
+                    end
+                  | E_DELEGATE(prefix,path) => 
+                    (case id
+                       of PUB pid => if String.isPrefix prefix pid 
+                                        then let val fullPath = uriJoin(base,path)
+                                             in searchOne (base,fullPath::other) entries
+                                             end
+                                     else searchOne (base,other) entries 
+                        | SYS _ => searchOne (base,other) entries)
+                  | E_MAP(pubid,path) => 
+                    (case id 
+                       of PUB pid => if pubid=pid then FOUND (base,path)
+                                     else searchOne (base,other) entries
+                        | _ => searchOne (base,other) entries)
+                  | E_REMAP(sysid,path) => 
+                    (case id
+                       of SYS sid => if sysid=sid then FOUND(base,path)
+                                     else searchOne (base,other) entries 
+                        | _ => searchOne (base,other) entries)
+                        
+            fun searchLevel other nil = NOTFOUND(rev other)
+              | searchLevel other (fname::fnames) = 
+               let 
+                  val (base,entries) = getCatalog fname
+               in 
+                  case searchOne (base,other) entries 
+                    of FOUND bp => FOUND bp
+                     | NOTFOUND other' => searchLevel other' fnames
+               end
 
-	    fun searchAll fnames = 
-	       if null fnames then NONE
-	       else case searchLevel nil fnames
-		      of FOUND bp => SOME bp
-		       | NOTFOUND other => searchAll other
+            fun searchAll fnames = 
+               if null fnames then NONE
+               else case searchLevel nil fnames
+                      of FOUND bp => SOME bp
+                       | NOTFOUND other => searchAll other
 
-	    val fnames = !O_CATALOG_FILES
-	 in 
-	    case id
-	      of PUB _ => searchAll fnames
-	       | SYS _ => if !O_SUPPORT_REMAP then searchAll fnames else NONE
-	 end
+            val fnames = !O_CATALOG_FILES
+         in 
+            case id
+              of PUB _ => searchAll fnames
+               | SYS _ => if !O_SUPPORT_REMAP then searchAll fnames else NONE
+         end
 
       fun resolveExtId (pub,sys) =
-	 let 
-	    fun resolvePubCat () = 
-	       case pub
-		 of NONE => NONE
-		  | SOME id => case searchId (PUB id)
-				 of NONE => NONE
-				  | SOME(base,sysid) => case searchId (SYS sysid)
-							  of NONE => SOME(base,sysid)
-							   | new => new
-							    
-	    fun resolveSysCat () = 
-	       case sys 
-		 of NONE => NONE
-		  | SOME(base,id) => searchId (SYS id)
+         let 
+            fun resolvePubCat () = 
+               case pub
+                 of NONE => NONE
+                  | SOME id => case searchId (PUB id)
+                                 of NONE => NONE
+                                  | SOME(base,sysid) => case searchId (SYS sysid)
+                                                          of NONE => SOME(base,sysid)
+                                                           | new => new
+                                                            
+            fun resolveSysCat () = 
+               case sys 
+                 of NONE => NONE
+                  | SOME(base,id) => searchId (SYS id)
 
-	    fun resolveCat () =
-	       if !O_PREFER_SYSID 
-		  then case resolveSysCat ()
-			 of NONE => resolvePubCat ()
-			  | found => found
-	       else case resolvePubCat ()
-		      of NONE => resolveSysCat ()
-		       | found => found
+            fun resolveCat () =
+               if !O_PREFER_SYSID 
+                  then case resolveSysCat ()
+                         of NONE => resolvePubCat ()
+                          | found => found
+               else case resolvePubCat ()
+                      of NONE => resolveSysCat ()
+                       | found => found
 
-	    fun resolve () =
-	       if !O_PREFER_CATALOG 
-		  then case resolveCat ()
-			 of NONE => (case sys
-				       of NONE => NONE
-					| SOME(base,id) => SOME(base,id))
-			  | found => found
-	       else case sys 
-		      of NONE => resolvePubCat ()
-		       | SOME(base,id) => SOME(base,id)
-	 in 
-	    if null (!O_CATALOG_FILES) 
-	       then case sys 
-		      of NONE => NONE
-		       | SOME(base,id) => SOME (uriJoin (base,id))
-	    else case resolve ()
-		   of NONE => NONE
-		    | SOME bp => SOME (uriJoin bp)
-	 end
+            fun resolve () =
+               if !O_PREFER_CATALOG 
+                  then case resolveCat ()
+                         of NONE => (case sys
+                                       of NONE => NONE
+                                        | SOME(base,id) => SOME(base,id))
+                          | found => found
+               else case sys 
+                      of NONE => resolvePubCat ()
+                       | SOME(base,id) => SOME(base,id)
+         in 
+            if null (!O_CATALOG_FILES) 
+               then case sys 
+                      of NONE => NONE
+                       | SOME(base,id) => SOME (uriJoin (base,id))
+            else case resolve ()
+                   of NONE => NONE
+                    | SOME bp => SOME (uriJoin bp)
+         end
    end
 (* stop of ../../Catalog/catalog.sml *)
 (* start of ../../Catalog/catResolve.sml *)
@@ -15523,20 +15523,20 @@
 functor ResolveCatalog ( structure Params : CatParams ) : Resolve = 
    struct
       structure Catalog = Catalog ( structure Params = Params )
-	 
+         
       open Base Errors
 
       fun resolveExtId (id as EXTID(pub,sys)) =
-	 let val pub1 = case pub
-			  of NONE => NONE
-			   | SOME (str,_) => SOME str
-	     val sys1 = case sys
-			  of NONE => NONE 
-			   | SOME (base,file,_) => SOME(base,file)
-	 in case Catalog.resolveExtId (pub1,sys1)
-	      of NONE => raise NoSuchFile ("","Could not generate system identifier")
-	       | SOME uri => uri
-	 end
+         let val pub1 = case pub
+                          of NONE => NONE
+                           | SOME (str,_) => SOME str
+             val sys1 = case sys
+                          of NONE => NONE 
+                           | SOME (base,file,_) => SOME(base,file)
+         in case Catalog.resolveExtId (pub1,sys1)
+              of NONE => raise NoSuchFile ("","Could not generate system identifier")
+               | SOME uri => uri
+         end
    end
 (* stop of ../../Catalog/catResolve.sml *)
 (* start of ../../Catalog/catOptions.sml *)
@@ -15548,7 +15548,7 @@
       val O_PREFER_CATALOG : bool ref
       val O_SUPPORT_REMAP  : bool ref
       val O_CATALOG_ENC    : Encoding.Encoding ref
-	 
+         
       val setCatalogDefaults : unit -> unit
       val setCatalogOptions  : Options.Option list * (string -> unit) -> Options.Option list
 
@@ -15567,114 +15567,114 @@
       val O_CATALOG_ENC    = ref LATIN1
 
       fun setCatalogDefaults() = 
-	 let 
-	    val _ = O_CATALOG_FILES  := nil
-	    val _ = O_PREFER_SOCAT   := false
-	    val _ = O_PREFER_SYSID   := false
-	    val _ = O_PREFER_CATALOG := true
-	    val _ = O_SUPPORT_REMAP  := true
-	    val _ = O_CATALOG_ENC    := LATIN1
-	 in ()
-	 end
+         let 
+            val _ = O_CATALOG_FILES  := nil
+            val _ = O_PREFER_SOCAT   := false
+            val _ = O_PREFER_SYSID   := false
+            val _ = O_PREFER_CATALOG := true
+            val _ = O_SUPPORT_REMAP  := true
+            val _ = O_CATALOG_ENC    := LATIN1
+         in ()
+         end
       
       val catalogUsage = 
-	 [U_ITEM(["-C <url>","--catalog=<url>"],"Use catalog <url>"),
+         [U_ITEM(["-C <url>","--catalog=<url>"],"Use catalog <url>"),
           U_ITEM(["--catalog-syntax=(soc|xml)"],"Default syntax for catalogs (xml)"),
           U_ITEM(["--catalog-encoding=<enc>"],"Default encoding for Socat catalogs (LATIN1)"), 
-	  U_ITEM(["--catalog-remap=[(yes|no)]"],"Support remapping of system identifiers (yes)"),
+          U_ITEM(["--catalog-remap=[(yes|no)]"],"Support remapping of system identifiers (yes)"),
           U_ITEM(["--catalog-priority=(map|remap|sys)"],"Resolving strategy in catalogs (map)")
-	  ]
+          ]
 
       fun setCatalogOptions (opts,doError) = 
-	 let 
-	    val catalogs = ref nil:string list ref
+         let 
+            val catalogs = ref nil:string list ref
 
-	    fun hasNoArg key = "option "^key^" has no argument"
-	    fun mustHave key = String.concat ["option ",key," must have an argument"]
-	    fun mustBe(key,what) = String.concat ["the argument to --",key," must be ",what]
+            fun hasNoArg key = "option "^key^" has no argument"
+            fun mustHave key = String.concat ["option ",key," must have an argument"]
+            fun mustBe(key,what) = String.concat ["the argument to --",key," must be ",what]
 
-	    val yesNo       = "'yes' or 'no'"
-	    val mapRemapSys = "'map', 'remap' or 'sys'"
-	    val encName     = "'ascii', 'latin1', 'utf8' or 'utf16'"
-	    val syntaxName  = "'soc' or 'xml'"
+            val yesNo       = "'yes' or 'no'"
+            val mapRemapSys = "'map', 'remap' or 'sys'"
+            val encName     = "'ascii', 'latin1', 'utf8' or 'utf16'"
+            val syntaxName  = "'soc' or 'xml'"
 
-	    fun do_catalog valOpt =
-	       case valOpt 
-		 of NONE => doError(mustHave "--catalog")
-		  | SOME s => catalogs := s::(!catalogs)
+            fun do_catalog valOpt =
+               case valOpt 
+                 of NONE => doError(mustHave "--catalog")
+                  | SOME s => catalogs := s::(!catalogs)
 
-	    fun do_prio valOpt =
-	       let fun set(cat,sys) = (O_PREFER_CATALOG := cat; O_PREFER_SYSID := sys) 
-	       in case valOpt 
-		    of NONE => doError(mustHave "--catalog-priority")
-		     | SOME "map" => set(true,false)
-		     | SOME "remap" => set(true,true)
-		     | SOME "sys" => set(false,true)
-		     | SOME s => doError(mustBe("catalog-priority",mapRemapSys))
-	       end
+            fun do_prio valOpt =
+               let fun set(cat,sys) = (O_PREFER_CATALOG := cat; O_PREFER_SYSID := sys) 
+               in case valOpt 
+                    of NONE => doError(mustHave "--catalog-priority")
+                     | SOME "map" => set(true,false)
+                     | SOME "remap" => set(true,true)
+                     | SOME "sys" => set(false,true)
+                     | SOME s => doError(mustBe("catalog-priority",mapRemapSys))
+               end
 
-	    fun do_enc valOpt =
-	       case valOpt 
-		 of NONE => doError(mustHave "--catalog-encoding")
-		  | SOME s => case isEncoding s 
-				of NOENC => doError("unsupported encoding "^s)
-				 | enc => O_CATALOG_ENC := enc
+            fun do_enc valOpt =
+               case valOpt 
+                 of NONE => doError(mustHave "--catalog-encoding")
+                  | SOME s => case isEncoding s 
+                                of NOENC => doError("unsupported encoding "^s)
+                                 | enc => O_CATALOG_ENC := enc
 
-	    fun do_remap valOpt =
-	       case valOpt 
-		 of NONE => doError(mustHave "--catalog-remap")
-		  | SOME "no" => O_SUPPORT_REMAP := false
-		  | SOME "yes" => O_SUPPORT_REMAP := true
-		  | SOME s => doError(mustBe("catalog-remap",yesNo))
+            fun do_remap valOpt =
+               case valOpt 
+                 of NONE => doError(mustHave "--catalog-remap")
+                  | SOME "no" => O_SUPPORT_REMAP := false
+                  | SOME "yes" => O_SUPPORT_REMAP := true
+                  | SOME s => doError(mustBe("catalog-remap",yesNo))
 
-	    fun do_syntax valOpt =
-	       case valOpt 
-		 of NONE => doError(mustHave "--catalog-syntax")
-		  | SOME "soc" => O_PREFER_SOCAT := true
-		  | SOME "xml" => O_PREFER_SOCAT := false
-		  | SOME s => doError(mustBe("catalog-remap",syntaxName))
+            fun do_syntax valOpt =
+               case valOpt 
+                 of NONE => doError(mustHave "--catalog-syntax")
+                  | SOME "soc" => O_PREFER_SOCAT := true
+                  | SOME "xml" => O_PREFER_SOCAT := false
+                  | SOME s => doError(mustBe("catalog-remap",syntaxName))
 
-	    fun do_long(key,valOpt) = 
-	       case key
-		 of "catalog" => true before do_catalog valOpt
-		  | "catalog-remap" => true before do_remap valOpt
-		  | "catalog-syntax" => true before do_syntax valOpt
-		  | "catalog-encoding" => true before do_enc valOpt
-		  | "catalog-priority" => true before do_prio valOpt
-		  | _ => false
+            fun do_long(key,valOpt) = 
+               case key
+                 of "catalog" => true before do_catalog valOpt
+                  | "catalog-remap" => true before do_remap valOpt
+                  | "catalog-syntax" => true before do_syntax valOpt
+                  | "catalog-encoding" => true before do_enc valOpt
+                  | "catalog-priority" => true before do_prio valOpt
+                  | _ => false
 
-	    fun do_short cs opts =
-	       case cs 
-		 of nil => doit opts
-		  | [#"C"] => 
-		    (case opts 
-		       of OPT_STRING s::opts1 => (catalogs := s::(!catalogs);
-						  doit opts1)
-			| _ => let val _ = doError (mustHave "-C")
-			       in doit opts
-			       end)
-  		  | cs => 
-		    let val cs1 = List.filter
-		       (fn c => if #"C"<>c then true
-				else false before doError (mustHave "-C")) cs
-		    in if null cs1 then doit opts else (OPT_SHORT cs1)::doit opts
-		    end
-		 
-	    and doit nil = nil
-	      | doit (opt::opts) =
-	       case opt
-		 of OPT_NOOPT => opts
-		  | OPT_LONG(key,value) => if do_long(key,value) then doit opts 
-					   else opt::doit opts
-		  | OPT_SHORT cs => do_short cs opts
-		  | OPT_NEG cs => opt::doit opts
-		  | OPT_STRING s => opt::doit opts
-	 
-	    val opts1 = doit opts
-	    val uris = map String2Uri (!catalogs)
-	    val _ = O_CATALOG_FILES := uris
-	 in opts1
-	 end
+            fun do_short cs opts =
+               case cs 
+                 of nil => doit opts
+                  | [#"C"] => 
+                    (case opts 
+                       of OPT_STRING s::opts1 => (catalogs := s::(!catalogs);
+                                                  doit opts1)
+                        | _ => let val _ = doError (mustHave "-C")
+                               in doit opts
+                               end)
+                  | cs => 
+                    let val cs1 = List.filter
+                       (fn c => if #"C"<>c then true
+                                else false before doError (mustHave "-C")) cs
+                    in if null cs1 then doit opts else (OPT_SHORT cs1)::doit opts
+                    end
+                 
+            and doit nil = nil
+              | doit (opt::opts) =
+               case opt
+                 of OPT_NOOPT => opts
+                  | OPT_LONG(key,value) => if do_long(key,value) then doit opts 
+                                           else opt::doit opts
+                  | OPT_SHORT cs => do_short cs opts
+                  | OPT_NEG cs => opt::doit opts
+                  | OPT_STRING s => opt::doit opts
+         
+            val opts1 = doit opts
+            val uris = map String2Uri (!catalogs)
+            val _ = O_CATALOG_FILES := uris
+         in opts1
+         end
    end
 (* stop of ../../Catalog/catOptions.sml *)
 (* start of nullOptions.sml *)
@@ -15782,13 +15782,13 @@
       val nullStart = OS.Process.success
 
       fun printError(pos,err) = if !O_SILENT then () else TextIO.output
-	 (!O_ERROR_DEVICE,formatMessage (4,!O_ERROR_LINEWIDTH) 
-	  (Position2String pos
+         (!O_ERROR_DEVICE,formatMessage (4,!O_ERROR_LINEWIDTH) 
+          (Position2String pos
            ::(if isFatalError err then "Fatal error:" else "Error:")
            ::errorMessage err))
       fun printWarning(pos,warn) = if !O_SILENT then () else TextIO.output
-	 (!O_ERROR_DEVICE,formatMessage (4,!O_ERROR_LINEWIDTH) 
-	  (Position2String pos^" Warning:"::warningMessage warn))
+         (!O_ERROR_DEVICE,formatMessage (4,!O_ERROR_LINEWIDTH) 
+          (Position2String pos^" Warning:"::warningMessage warn))
 
       fun hookError   (_,pe) = OS.Process.failure before printError pe
       fun hookWarning (status,pw) = status before printWarning pw 
@@ -15800,80 +15800,80 @@
       structure ParserOptions = ParserOptions ()
       structure CatOptions = CatOptions ()
       structure CatParams =
-	 struct
-	    open CatError CatOptions NullOptions Uri UtilError 
+         struct
+            open CatError CatOptions NullOptions Uri UtilError 
 
-	    fun catError(pos,err) = if !O_SILENT then () else TextIO.output
-	       (!O_ERROR_DEVICE,formatMessage (4,!O_ERROR_LINEWIDTH) 
-		(Position2String pos^" Error in catalog:"::catMessage err))
-	 end
+            fun catError(pos,err) = if !O_SILENT then () else TextIO.output
+               (!O_ERROR_DEVICE,formatMessage (4,!O_ERROR_LINEWIDTH) 
+                (Position2String pos^" Error in catalog:"::catMessage err))
+         end
       structure Resolve   = ResolveCatalog (structure Params  = CatParams) 
       structure ParseNull = Parse          (structure Dtd = Dtd 
-					    structure Hooks = NullHooks
-				            structure Resolve = Resolve
-					    structure ParserOptions = ParserOptions)
+                                            structure Hooks = NullHooks
+                                            structure Resolve = Resolve
+                                            structure ParserOptions = ParserOptions)
 
       fun parseNull uri = ParseNull.parseDocument uri NONE NullHooks.nullStart
 
       open 
-	 CatOptions NullOptions Options ParserOptions Uri
+         CatOptions NullOptions Options ParserOptions Uri
 
       val usage = List.concat [parserUsage,[U_SEP],catalogUsage,[U_SEP],nullUsage]
 
       exception Exit of OS.Process.status 
-	 
+         
       fun null(prog,args) = 
-	 let 
-	    val prog = "fxp"
-	    val hadError = ref false
-	       
-	    fun optError msg = 
-	       let val _ = TextIO.output(TextIO.stdErr,msg^".\n")
-	       in hadError := true
-	       end
-	    fun exitError msg = 
-	       let val _ = TextIO.output(TextIO.stdErr,msg^".\n")
-	       in raise Exit OS.Process.failure 
-	       end
-	    fun exitHelp prog = 
-	       let val _ = printUsage TextIO.stdOut prog usage
-	       in raise Exit OS.Process.success 
-	       end
-	    fun exitVersion prog = 
-	       let val _ = app print [prog," version ",Version.FXP_VERSION,"\n"]
-	       in raise Exit OS.Process.success 
-	       end
-	    
-	    fun summOpt prog = "For a summary of options type "^prog^" --help"
-	    fun noFile(f,cause) = "can't open file '"^f^"': "^exnMessage cause
-	       
-	    val opts = parseOptions args
-	    val _ = setParserDefaults()
-	    val opts1 = setParserOptions (opts,optError)
-	    val _ = setCatalogDefaults()
-	    val opts2 = setCatalogOptions (opts1,optError)
-	    val _ = setNullDefaults()
-	    val (vers,help,err,file) = setNullOptions (opts2,optError)
-	    val _ = if !hadError then exitError (summOpt prog) else ()
-	    val _ = if vers then exitVersion prog else ()
-	    val _ = if help then exitHelp prog else ()
-	    val _ = case err 
-		      of SOME "-" => O_ERROR_DEVICE := TextIO.stdErr
-		       | SOME f => (O_ERROR_DEVICE := TextIO.openOut f
-				    handle IO.Io {cause,...} => exitError(noFile(f,cause)))
-		       | NONE => ()
-	    val f = valOf file handle Option => "-"
-	    val uri = if f="-" then NONE else SOME(String2Uri f)
-	    val status = parseNull uri
-	    val _ = if isSome err then TextIO.closeOut (!O_ERROR_DEVICE) else ()
-	 in status
-	 end
+         let 
+            val prog = "fxp"
+            val hadError = ref false
+               
+            fun optError msg = 
+               let val _ = TextIO.output(TextIO.stdErr,msg^".\n")
+               in hadError := true
+               end
+            fun exitError msg = 
+               let val _ = TextIO.output(TextIO.stdErr,msg^".\n")
+               in raise Exit OS.Process.failure 
+               end
+            fun exitHelp prog = 
+               let val _ = printUsage TextIO.stdOut prog usage
+               in raise Exit OS.Process.success 
+               end
+            fun exitVersion prog = 
+               let val _ = app print [prog," version ",Version.FXP_VERSION,"\n"]
+               in raise Exit OS.Process.success 
+               end
+            
+            fun summOpt prog = "For a summary of options type "^prog^" --help"
+            fun noFile(f,cause) = "can't open file '"^f^"': "^exnMessage cause
+               
+            val opts = parseOptions args
+            val _ = setParserDefaults()
+            val opts1 = setParserOptions (opts,optError)
+            val _ = setCatalogDefaults()
+            val opts2 = setCatalogOptions (opts1,optError)
+            val _ = setNullDefaults()
+            val (vers,help,err,file) = setNullOptions (opts2,optError)
+            val _ = if !hadError then exitError (summOpt prog) else ()
+            val _ = if vers then exitVersion prog else ()
+            val _ = if help then exitHelp prog else ()
+            val _ = case err 
+                      of SOME "-" => O_ERROR_DEVICE := TextIO.stdErr
+                       | SOME f => (O_ERROR_DEVICE := TextIO.openOut f
+                                    handle IO.Io {cause,...} => exitError(noFile(f,cause)))
+                       | NONE => ()
+            val f = valOf file handle Option => "-"
+            val uri = if f="-" then NONE else SOME(String2Uri f)
+            val status = parseNull uri
+            val _ = if isSome err then TextIO.closeOut (!O_ERROR_DEVICE) else ()
+         in status
+         end
       handle Exit status => status 
-	   | exn => 
-	 let val _ = TextIO.output 
-	    (TextIO.stdErr,prog^": Unexpected exception: "^exnMessage exn^".\n")
-	 in OS.Process.failure 
-	 end
+           | exn => 
+         let val _ = TextIO.output 
+            (TextIO.stdErr,prog^": Unexpected exception: "^exnMessage exn^".\n")
+         in OS.Process.failure 
+         end
    end
 
 (* stop of null.sml *)

Modified: mlton/branches/on-20050420-cmm-branch/benchmark/tests/hamlet.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/benchmark/tests/hamlet.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/benchmark/tests/hamlet.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -84,15 +84,15 @@
   sig
 
     exception Unimplemented of string
-	(* raised to report unimplemented features *)
+        (* raised to report unimplemented features *)
     exception Impossible of string
-	(* raised to report internal errors *)
+        (* raised to report internal errors *)
 
     exception NotFound
-	(* raised by searching operations *)
+        (* raised by searching operations *)
 
     val failure : {module : string, func : string, msg : string} -> 'a
-	(* raise the exception Fail with a standard format message. *)
+        (* raise the exception Fail with a standard format message. *)
 
     val version : {date : string, system : string, version_id : int list}
     val banner : string
@@ -120,21 +120,21 @@
 
   (* raise the exception Fail with a standard format message. *)
     fun failure {module, func, msg} =
-	  raise (Fail(concat[module, ".", func, ": ", msg]))
+          raise (Fail(concat[module, ".", func, ": ", msg]))
 
     val version = {
-	    date = "June 1, 1996", 
-	    system = "SML/NJ Library",
-	    version_id = [1, 0]
-	  }
+            date = "June 1, 1996", 
+            system = "SML/NJ Library",
+            version_id = [1, 0]
+          }
 
     fun f ([], l) = l
       | f ([x : int], l) = (Int.toString x)::l
       | f (x::r, l) = (Int.toString x) :: "." :: f(r, l)
 
     val banner = concat (
-	    #system version :: ", Version " ::
-	    f (#version_id version, [", ", #date version]))
+            #system version :: ", Version " ::
+            f (#version_id version, [", ", #date version]))
 
   end (* LibBase *)
 
@@ -156,94 +156,94 @@
     type 'a map
 
     val empty : 'a map
-	(* The empty map *)
+        (* The empty map *)
 
     val isEmpty : 'a map -> bool
-	(* Return true if and only if the map is empty *)
+        (* Return true if and only if the map is empty *)
 
     val singleton : (Key.ord_key * 'a) -> 'a map
-	(* return the specified singleton map *)
+        (* return the specified singleton map *)
 
     val insert  : 'a map * Key.ord_key * 'a -> 'a map
     val insert' : ((Key.ord_key * 'a) * 'a map) -> 'a map
-	(* Insert an item. *)
+        (* Insert an item. *)
 
     val find : 'a map * Key.ord_key -> 'a option
-	(* Look for an item, return NONE if the item doesn't exist *)
+        (* Look for an item, return NONE if the item doesn't exist *)
 
     val inDomain : ('a map * Key.ord_key) -> bool
-	(* return true, if the key is in the domain of the map *)
+        (* return true, if the key is in the domain of the map *)
 
     val remove : 'a map * Key.ord_key -> 'a map * 'a
-	(* Remove an item, returning new map and value removed.
+        (* Remove an item, returning new map and value removed.
          * Raises LibBase.NotFound if not found.
-	 *)
+         *)
 
     val first : 'a map -> 'a option
     val firsti : 'a map -> (Key.ord_key * 'a) option
-	(* return the first item in the map (or NONE if it is empty) *)
+        (* return the first item in the map (or NONE if it is empty) *)
 
     val numItems : 'a map ->  int
-	(* Return the number of items in the map *)
+        (* Return the number of items in the map *)
 
     val listItems  : 'a map -> 'a list
     val listItemsi : 'a map -> (Key.ord_key * 'a) list
-	(* Return an ordered list of the items (and their keys) in the map. *)
+        (* Return an ordered list of the items (and their keys) in the map. *)
 
     val listKeys : 'a map -> Key.ord_key list
-	(* return an ordered list of the keys in the map. *)
+        (* return an ordered list of the keys in the map. *)
 
     val collate : ('a * 'a -> order) -> ('a map * 'a map) -> order
-	(* given an ordering on the map's range, return an ordering
-	 * on the map.
-	 *)
+        (* given an ordering on the map's range, return an ordering
+         * on the map.
+         *)
 
     val unionWith  : ('a * 'a -> 'a) -> ('a map * 'a map) -> 'a map
     val unionWithi : (Key.ord_key * 'a * 'a -> 'a) -> ('a map * 'a map) -> 'a map
-	(* return a map whose domain is the union of the domains of the two input
-	 * maps, using the supplied function to define the map on elements that
-	 * are in both domains.
-	 *)
+        (* return a map whose domain is the union of the domains of the two input
+         * maps, using the supplied function to define the map on elements that
+         * are in both domains.
+         *)
 
     val intersectWith  : ('a * 'b -> 'c) -> ('a map * 'b map) -> 'c map
     val intersectWithi : (Key.ord_key * 'a * 'b -> 'c) -> ('a map * 'b map) -> 'c map
-	(* return a map whose domain is the intersection of the domains of the
-	 * two input maps, using the supplied function to define the range.
-	 *)
+        (* return a map whose domain is the intersection of the domains of the
+         * two input maps, using the supplied function to define the range.
+         *)
 
     val app  : ('a -> unit) -> 'a map -> unit
     val appi : ((Key.ord_key * 'a) -> unit) -> 'a map -> unit
-	(* Apply a function to the entries of the map in map order. *)
+        (* Apply a function to the entries of the map in map order. *)
 
     val map  : ('a -> 'b) -> 'a map -> 'b map
     val mapi : (Key.ord_key * 'a -> 'b) -> 'a map -> 'b map
-	(* Create a new map by applying a map function to the
+        (* Create a new map by applying a map function to the
          * name/value pairs in the map.
          *)
 
     val foldl  : ('a * 'b -> 'b) -> 'b -> 'a map -> 'b
     val foldli : (Key.ord_key * 'a * 'b -> 'b) -> 'b -> 'a map -> 'b
-	(* Apply a folding function to the entries of the map
+        (* Apply a folding function to the entries of the map
          * in increasing map order.
          *)
 
     val foldr  : ('a * 'b -> 'b) -> 'b -> 'a map -> 'b
     val foldri : (Key.ord_key * 'a * 'b -> 'b) -> 'b -> 'a map -> 'b
-	(* Apply a folding function to the entries of the map
+        (* Apply a folding function to the entries of the map
          * in decreasing map order.
          *)
 
     val filter  : ('a -> bool) -> 'a map -> 'a map
     val filteri : (Key.ord_key * 'a -> bool) -> 'a map -> 'a map
-	(* Filter out those elements of the map that do not satisfy the
-	 * predicate.  The filtering is done in increasing map order.
-	 *)
+        (* Filter out those elements of the map that do not satisfy the
+         * predicate.  The filtering is done in increasing map order.
+         *)
 
     val mapPartial  : ('a -> 'b option) -> 'a map -> 'b map
     val mapPartiali : (Key.ord_key * 'a -> 'b option) -> 'a map -> 'b map
-	(* map a partial function over the elements of a map in increasing
-	 * map order.
-	 *)
+        (* map a partial function over the elements of a map in increasing
+         * map order.
+         *)
 
   end (* ORD_MAP *)
 (* stop of smlnj-lib/Util/ord-map-sig.sml *)
@@ -269,8 +269,8 @@
  *      University of Southampton
  *   Address:  Electronics & Computer Science
  *             University of Southampton
- *	     Southampton  SO9 5NH
- *	     Great Britian
+ *           Southampton  SO9 5NH
+ *           Great Britian
  *   E-mail:   sra@ecs.soton.ac.uk
  *
  *   Comments:
@@ -309,7 +309,7 @@
           cnt : int, 
           left : 'a map, 
           right : 'a map
-	}
+        }
 
     val empty = E
 
@@ -414,136 +414,136 @@
     fun insert' ((k, x), m) = insert(m, k, x)
 
     fun inDomain (set, x) = let 
-	  fun mem E = false
-	    | mem (T(n as {key,left,right,...})) = (case K.compare (x,key)
-		 of GREATER => mem right
-		  | EQUAL => true
-		  | LESS => mem left
-		(* end case *))
-	  in
-	    mem set
-	  end
+          fun mem E = false
+            | mem (T(n as {key,left,right,...})) = (case K.compare (x,key)
+                 of GREATER => mem right
+                  | EQUAL => true
+                  | LESS => mem left
+                (* end case *))
+          in
+            mem set
+          end
 
     fun find (set, x) = let 
-	  fun mem E = NONE
-	    | mem (T(n as {key,left,right,...})) = (case K.compare (x,key)
-		 of GREATER => mem right
-		  | EQUAL => SOME(#value n)
-		  | LESS => mem left
-		(* end case *))
-	  in
-	    mem set
-	  end
+          fun mem E = NONE
+            | mem (T(n as {key,left,right,...})) = (case K.compare (x,key)
+                 of GREATER => mem right
+                  | EQUAL => SOME(#value n)
+                  | LESS => mem left
+                (* end case *))
+          in
+            mem set
+          end
 
     fun remove (E,x) = raise LibBase.NotFound
       | remove (set as T{key,left,right,value,...},x) = (
           case K.compare (key,x)
-	   of GREATER => let
-		val (left', v) = remove(left, x)
-		in
-		  (T'(key, value, left', right), v)
-		end
+           of GREATER => let
+                val (left', v) = remove(left, x)
+                in
+                  (T'(key, value, left', right), v)
+                end
             | LESS => let
-		val (right', v) = remove (right, x)
-		in
-		  (T'(key, value, left, right'), v)
-		end
+                val (right', v) = remove (right, x)
+                in
+                  (T'(key, value, left, right'), v)
+                end
             | _ => (delete'(left,right),value)
-	  (* end case *))
+          (* end case *))
 
     fun listItems d = let
-	  fun d2l (E, l) = l
-	    | d2l (T{key,value,left,right,...}, l) =
-		d2l(left, value::(d2l(right,l)))
-	  in
-	    d2l (d,[])
-	  end
+          fun d2l (E, l) = l
+            | d2l (T{key,value,left,right,...}, l) =
+                d2l(left, value::(d2l(right,l)))
+          in
+            d2l (d,[])
+          end
 
     fun listItemsi d = let
-	  fun d2l (E, l) = l
-	    | d2l (T{key,value,left,right,...}, l) =
-		d2l(left, (key,value)::(d2l(right,l)))
-	  in
-	    d2l (d,[])
-	  end
+          fun d2l (E, l) = l
+            | d2l (T{key,value,left,right,...}, l) =
+                d2l(left, (key,value)::(d2l(right,l)))
+          in
+            d2l (d,[])
+          end
 
     fun listKeys d = let
-	  fun d2l (E, l) = l
-	    | d2l (T{key,left,right,...}, l) = d2l(left, key::(d2l(right,l)))
-	  in
-	    d2l (d,[])
-	  end
+          fun d2l (E, l) = l
+            | d2l (T{key,left,right,...}, l) = d2l(left, key::(d2l(right,l)))
+          in
+            d2l (d,[])
+          end
 
     local
       fun next ((t as T{right, ...})::rest) = (t, left(right, rest))
-	| next _ = (E, [])
+        | next _ = (E, [])
       and left (E, rest) = rest
-	| left (t as T{left=l, ...}, rest) = left(l, t::rest)
+        | left (t as T{left=l, ...}, rest) = left(l, t::rest)
     in
     fun collate cmpRng (s1, s2) = let
-	  fun cmp (t1, t2) = (case (next t1, next t2)
-		 of ((E, _), (E, _)) => EQUAL
-		  | ((E, _), _) => LESS
-		  | (_, (E, _)) => GREATER
-		  | ((T{key=x1, value=y1, ...}, r1), (T{key=x2, value=y2, ...}, r2)) => (
-		      case Key.compare(x1, x2)
-		       of EQUAL => (case cmpRng(y1, y2)
-			     of EQUAL => cmp (r1, r2)
-			      | order => order
-			    (* end case *))
-			| order => order
-		      (* end case *))
-		(* end case *))
-	  in
-	    cmp (left(s1, []), left(s2, []))
-	  end
+          fun cmp (t1, t2) = (case (next t1, next t2)
+                 of ((E, _), (E, _)) => EQUAL
+                  | ((E, _), _) => LESS
+                  | (_, (E, _)) => GREATER
+                  | ((T{key=x1, value=y1, ...}, r1), (T{key=x2, value=y2, ...}, r2)) => (
+                      case Key.compare(x1, x2)
+                       of EQUAL => (case cmpRng(y1, y2)
+                             of EQUAL => cmp (r1, r2)
+                              | order => order
+                            (* end case *))
+                        | order => order
+                      (* end case *))
+                (* end case *))
+          in
+            cmp (left(s1, []), left(s2, []))
+          end
     end (* local *)
 
     fun appi f d = let
-	  fun app' E = ()
-	    | app' (T{key,value,left,right,...}) = (
-		app' left; f(key, value); app' right)
-	  in
-	    app' d
-	  end
+          fun app' E = ()
+            | app' (T{key,value,left,right,...}) = (
+                app' left; f(key, value); app' right)
+          in
+            app' d
+          end
     fun app f d = let
-	  fun app' E = ()
-	    | app' (T{value,left,right,...}) = (
-		app' left; f value; app' right)
-	  in
-	    app' d
-	  end
+          fun app' E = ()
+            | app' (T{value,left,right,...}) = (
+                app' left; f value; app' right)
+          in
+            app' d
+          end
 
     fun mapi f d = let
-	  fun map' E = E
-	    | map' (T{key,value,left,right,cnt}) = let
-		val left' = map' left
-		val value' = f(key, value)
-		val right' = map' right
-		in
-		  T{cnt=cnt, key=key, value=value', left = left', right = right'}
-		end
-	  in
-	    map' d
-	  end
+          fun map' E = E
+            | map' (T{key,value,left,right,cnt}) = let
+                val left' = map' left
+                val value' = f(key, value)
+                val right' = map' right
+                in
+                  T{cnt=cnt, key=key, value=value', left = left', right = right'}
+                end
+          in
+            map' d
+          end
     fun map f d = mapi (fn (_, x) => f x) d
 
     fun foldli f init d = let
-	  fun fold (E, v) = v
-	    | fold (T{key,value,left,right,...}, v) =
-		fold (right, f(key, value, fold(left, v)))
-	  in
-	    fold (d, init)
-	  end
+          fun fold (E, v) = v
+            | fold (T{key,value,left,right,...}, v) =
+                fold (right, f(key, value, fold(left, v)))
+          in
+            fold (d, init)
+          end
     fun foldl f init d = foldli (fn (_, v, accum) => f (v, accum)) init d
 
     fun foldri f init d = let
-	  fun fold (E,v) = v
-	    | fold (T{key,value,left,right,...},v) =
-		fold (left, f(key, value, fold(right, v)))
-	  in
-	    fold (d, init)
-	  end
+          fun fold (E,v) = v
+            | fold (T{key,value,left,right,...},v) =
+                fold (left, f(key, value, fold(right, v)))
+          in
+            fold (d, init)
+          end
     fun foldr f init d = foldri (fn (_, v, accum) => f (v, accum)) init d
 
 (** To be implemented **
@@ -558,94 +558,94 @@
  * at some point.
  *)
     fun unionWith f (m1, m2) = let
-	  fun ins  f (key, x, m) = (case find(m, key)
-		 of NONE => insert(m, key, x)
-		  | (SOME x') => insert(m, key, f(x, x'))
-		(* end case *))
-	  in
-	    if (numItems m1 > numItems m2)
-	      then foldli (ins (fn (a, b) => f (b, a))) m1 m2
-	      else foldli (ins f) m2 m1
-	  end
+          fun ins  f (key, x, m) = (case find(m, key)
+                 of NONE => insert(m, key, x)
+                  | (SOME x') => insert(m, key, f(x, x'))
+                (* end case *))
+          in
+            if (numItems m1 > numItems m2)
+              then foldli (ins (fn (a, b) => f (b, a))) m1 m2
+              else foldli (ins f) m2 m1
+          end
     fun unionWithi f (m1, m2) = let
-	  fun ins f (key, x, m) = (case find(m, key)
-		 of NONE => insert(m, key, x)
-		  | (SOME x') => insert(m, key, f(key, x, x'))
-		(* end case *))
-	  in
-	    if (numItems m1 > numItems m2)
-	      then foldli (ins (fn (k, a, b) => f (k, b, a))) m1 m2
-	      else foldli (ins f) m2 m1
-	  end
+          fun ins f (key, x, m) = (case find(m, key)
+                 of NONE => insert(m, key, x)
+                  | (SOME x') => insert(m, key, f(key, x, x'))
+                (* end case *))
+          in
+            if (numItems m1 > numItems m2)
+              then foldli (ins (fn (k, a, b) => f (k, b, a))) m1 m2
+              else foldli (ins f) m2 m1
+          end
 
     fun intersectWith f (m1, m2) = let
-	(* iterate over the elements of m1, checking for membership in m2 *)
-	  fun intersect f (m1, m2) = let
-		fun ins (key, x, m) = (case find(m2, key)
-		       of NONE => m
-			| (SOME x') => insert(m, key, f(x, x'))
-		      (* end case *))
-		in
-		  foldli ins empty m1
-		end
-	  in
-	    if (numItems m1 > numItems m2)
-	      then intersect f (m1, m2)
-	      else intersect (fn (a, b) => f(b, a)) (m2, m1)
-	  end
+        (* iterate over the elements of m1, checking for membership in m2 *)
+          fun intersect f (m1, m2) = let
+                fun ins (key, x, m) = (case find(m2, key)
+                       of NONE => m
+                        | (SOME x') => insert(m, key, f(x, x'))
+                      (* end case *))
+                in
+                  foldli ins empty m1
+                end
+          in
+            if (numItems m1 > numItems m2)
+              then intersect f (m1, m2)
+              else intersect (fn (a, b) => f(b, a)) (m2, m1)
+          end
     fun intersectWithi f (m1, m2) = let
-	(* iterate over the elements of m1, checking for membership in m2 *)
-	  fun intersect f (m1, m2) = let
-		fun ins (key, x, m) = (case find(m2, key)
-		       of NONE => m
-			| (SOME x') => insert(m, key, f(key, x, x'))
-		      (* end case *))
-		in
-		  foldli ins empty m1
-		end
-	  in
-	    if (numItems m1 > numItems m2)
-	      then intersect f (m1, m2)
-	      else intersect (fn (k, a, b) => f(k, b, a)) (m2, m1)
-	  end
+        (* iterate over the elements of m1, checking for membership in m2 *)
+          fun intersect f (m1, m2) = let
+                fun ins (key, x, m) = (case find(m2, key)
+                       of NONE => m
+                        | (SOME x') => insert(m, key, f(key, x, x'))
+                      (* end case *))
+                in
+                  foldli ins empty m1
+                end
+          in
+            if (numItems m1 > numItems m2)
+              then intersect f (m1, m2)
+              else intersect (fn (k, a, b) => f(k, b, a)) (m2, m1)
+          end
 
   (* this is a generic implementation of filter.  It should
    * be specialized to the data-structure at some point.
    *)
     fun filter predFn m = let
-	  fun f (key, item, m) = if predFn item
-		then insert(m, key, item)
-		else m
-	  in
-	    foldli f empty m
-	  end
+          fun f (key, item, m) = if predFn item
+                then insert(m, key, item)
+                else m
+          in
+            foldli f empty m
+          end
     fun filteri predFn m = let
-	  fun f (key, item, m) = if predFn(key, item)
-		then insert(m, key, item)
-		else m
-	  in
-	    foldli f empty m
-	  end
+          fun f (key, item, m) = if predFn(key, item)
+                then insert(m, key, item)
+                else m
+          in
+            foldli f empty m
+          end
 
   (* this is a generic implementation of mapPartial.  It should
    * be specialized to the data-structure at some point.
    *)
     fun mapPartial f m = let
-	  fun g (key, item, m) = (case f item
-		 of NONE => m
-		  | (SOME item') => insert(m, key, item')
-		(* end case *))
-	  in
-	    foldli g empty m
-	  end
+          fun g (key, item, m) = (case f item
+                 of NONE => m
+                  | (SOME item') => insert(m, key, item')
+                (* end case *))
+          in
+            foldli g empty m
+          end
     fun mapPartiali f m = let
-	  fun g (key, item, m) = (case f(key, item)
-		 of NONE => m
-		  | (SOME item') => insert(m, key, item')
-		(* end case *))
-	  in
-	    foldli g empty m
-	  end
+          fun g (key, item, m) = (case f(key, item)
+                 of NONE => m
+                  | (SOME item') => insert(m, key, item')
+                (* end case *))
+          in
+            foldli g empty m
+          end
 
   end (* functor BinaryMapFn *)
 (* stop of smlnj-lib/Util/binary-map-fn.sml *)
@@ -666,14 +666,14 @@
 
     include ORD_MAP
 
-    val fromList:	(Key.ord_key * 'a) list -> 'a map
+    val fromList:       (Key.ord_key * 'a) list -> 'a map
 
-    val all:		('a -> bool) -> 'a map -> bool
-    val exists:		('a -> bool) -> 'a map -> bool
-    val alli:		(Key.ord_key * 'a -> bool) -> 'a map -> bool
-    val existsi:	(Key.ord_key * 'a -> bool) -> 'a map -> bool
+    val all:            ('a -> bool) -> 'a map -> bool
+    val exists:         ('a -> bool) -> 'a map -> bool
+    val alli:           (Key.ord_key * 'a -> bool) -> 'a map -> bool
+    val existsi:        (Key.ord_key * 'a -> bool) -> 'a map -> bool
 
-    val disjoint:	'a map * 'a map -> bool
+    val disjoint:       'a map * 'a map -> bool
 
   end
 (* stop of FIN_MAP.sml *)
@@ -696,14 +696,14 @@
 
     open BinaryMap
 
-    fun fromList kvs	= List.foldl (fn((k, v),m) => insert(m, k, v)) empty kvs
+    fun fromList kvs    = List.foldl (fn((k, v),m) => insert(m, k, v)) empty kvs
 
-    fun all p		= foldl (fn(v, b) => b andalso p v) true
-    fun exists p	= foldl (fn(v, b) => b orelse p v) false
-    fun alli p		= foldli (fn(k, v, b) => b andalso p(k, v)) true
-    fun existsi p	= foldli (fn(k, v, b) => b orelse p(k, v)) false
+    fun all p           = foldl (fn(v, b) => b andalso p v) true
+    fun exists p        = foldl (fn(v, b) => b orelse p v) false
+    fun alli p          = foldli (fn(k, v, b) => b andalso p(k, v)) true
+    fun existsi p       = foldli (fn(k, v, b) => b orelse p(k, v)) false
 
-    fun disjoint(m1,m2)	= isEmpty(intersectWith #2 (m1, m2))
+    fun disjoint(m1,m2) = isEmpty(intersectWith #2 (m1, m2))
 
   end
 (* stop of FinMapFn.sml *)
@@ -724,16 +724,16 @@
 
     (* Type [Section 2.4] *)
 
-    eqtype Id					(* [id] *)
+    eqtype Id                                   (* [id] *)
 
     (* Operations *)
 
-    val invent:		unit -> Id
+    val invent:         unit -> Id
 
-    val fromString:	string -> Id
-    val toString:	Id -> string
+    val fromString:     string -> Id
+    val toString:       Id -> string
 
-    val compare:	Id * Id -> order
+    val compare:        Id * Id -> order
 
   end
 (* stop of ID.sml *)
@@ -754,7 +754,7 @@
 
     (* Type [Section 2.4] *)
 
-    type Id = string				(* [id] *)
+    type Id = string                            (* [id] *)
 
 
     (* Creation *)
@@ -790,10 +790,10 @@
  *)
 
 structure SigIdMap   = FinMapFn(type ord_key = SigId.Id
-				val  compare = SigId.compare)
+                                val  compare = SigId.compare)
 
 structure FunIdMap   = FinMapFn(type ord_key = FunId.Id
-				val  compare = FunId.compare)
+                                val  compare = FunId.compare)
 (* stop of AssembliesModule.sml *)
 (* start of LONGID.sml *)
 (*
@@ -820,23 +820,23 @@
 
     (* Type [Section 2.4] *)
 
-    eqtype longId				(* [longid] *)
+    eqtype longId                               (* [longid] *)
 
 
     (* Operations *)
 
-    val invent:		unit   -> longId
-    val fromId:		Id     -> longId
-    val toId:		longId -> Id
-    val toString:	longId -> string
+    val invent:         unit   -> longId
+    val fromId:         Id     -> longId
+    val toId:           longId -> Id
+    val toString:       longId -> string
 
-    val strengthen:	StrId * longId -> longId
-    val implode:	StrId list * Id -> longId
-    val explode:	longId -> StrId list * Id
+    val strengthen:     StrId * longId -> longId
+    val implode:        StrId list * Id -> longId
+    val explode:        longId -> StrId list * Id
 
-    val isUnqualified:	longId -> bool
+    val isUnqualified:  longId -> bool
 
-    val compare:	longId * longId -> order
+    val compare:        longId * longId -> order
 
   end
 (* stop of LONGID.sml *)
@@ -853,10 +853,10 @@
 
 
 functor LongIdFn(structure Id:    ID
-		 structure StrId: ID
-		) :> LONGID where type Id.Id    = Id.Id
-			    and   type StrId.Id = StrId.Id
-		  =
+                 structure StrId: ID
+                ) :> LONGID where type Id.Id    = Id.Id
+                            and   type StrId.Id = StrId.Id
+                  =
   struct
 
     (* Import *)
@@ -870,7 +870,7 @@
 
     (* Type [Section 2.4] *)
 
-    type longId	= StrId list * Id			(* [longid] *)
+    type longId = StrId list * Id                       (* [longid] *)
 
 
     (* Conversions *)
@@ -880,12 +880,12 @@
     fun invent()        = ([],Id.invent())
 
     fun toString(strids, id) =
-	let
-	    fun prefix   []     = Id.toString id
-	      | prefix(id::ids) = StrId.toString id ^ "." ^ prefix ids
-	in
-	    prefix strids
-	end
+        let
+            fun prefix   []     = Id.toString id
+              | prefix(id::ids) = StrId.toString id ^ "." ^ prefix ids
+        in
+            prefix strids
+        end
 
     fun strengthen(strid, (strids, id)) = (strid::strids, id)
 
@@ -898,7 +898,7 @@
     (* Ordering *)
 
     fun compare(longid1, longid2) =
-	    String.compare(toString longid1, toString longid2)
+            String.compare(toString longid1, toString longid2)
 
   end
 (* stop of LongIdFn.sml *)
@@ -915,11 +915,11 @@
 structure StrId     = IdFn()
 
 structure LongVId   = LongIdFn(structure Id    = VId
-			       structure StrId = StrId)
+                               structure StrId = StrId)
 structure LongTyCon = LongIdFn(structure Id    = TyCon
-			       structure StrId = StrId)
+                               structure StrId = StrId)
 structure LongStrId = LongIdFn(structure Id    = StrId
-			       structure StrId = StrId)
+                               structure StrId = StrId)
 (* stop of IdsCore.sml *)
 (* start of smlnj-lib/Util/ord-set-sig.sml *)
 (* ordset-sig.sml
@@ -938,41 +938,41 @@
     type set
 
     val empty : set
-	(* The empty set *)
+        (* The empty set *)
 
     val singleton : item -> set
-	(* Create a singleton set *)
+        (* Create a singleton set *)
 
     val add  : set * item -> set
     val add' : (item * set) -> set
-	(* Insert an item. *)
+        (* Insert an item. *)
 
     val addList : set * item list -> set
-	(* Insert items from list. *)
+        (* Insert items from list. *)
 
     val delete : set * item -> set
-	(* Remove an item. Raise NotFound if not found. *)
+        (* Remove an item. Raise NotFound if not found. *)
 
     val member : set * item -> bool
-	(* Return true if and only if item is an element in the set *)
+        (* Return true if and only if item is an element in the set *)
 
     val isEmpty : set -> bool
-	(* Return true if and only if the set is empty *)
+        (* Return true if and only if the set is empty *)
 
     val equal : (set * set) -> bool
-	(* Return true if and only if the two sets are equal *)
+        (* Return true if and only if the two sets are equal *)
 
     val compare : (set * set) -> order
-	(* does a lexical comparison of two sets *)
+        (* does a lexical comparison of two sets *)
 
     val isSubset : (set * set) -> bool
-	(* Return true if and only if the first set is a subset of the second *)
+        (* Return true if and only if the first set is a subset of the second *)
 
     val numItems : set ->  int
-	(* Return the number of items in the table *)
+        (* Return the number of items in the table *)
 
     val listItems : set -> item list
-	(* Return an ordered list of the items in the set *)
+        (* Return an ordered list of the items in the set *)
 
     val union : set * set -> set
         (* Union *)
@@ -984,22 +984,22 @@
         (* Difference *)
 
     val map : (item -> item) -> set -> set
-	(* Create a new set by applying a map function to the elements
-	 * of the set.
+        (* Create a new set by applying a map function to the elements
+         * of the set.
          *)
      
     val app : (item -> unit) -> set -> unit
-	(* Apply a function to the entries of the set 
+        (* Apply a function to the entries of the set 
          * in decreasing order
          *)
 
     val foldl : (item * 'b -> 'b) -> 'b -> set -> 'b
-	(* Apply a folding function to the entries of the set 
+        (* Apply a folding function to the entries of the set 
          * in increasing order
          *)
 
     val foldr : (item * 'b -> 'b) -> 'b -> set -> 'b
-	(* Apply a folding function to the entries of the set 
+        (* Apply a folding function to the entries of the set 
          * in decreasing order
          *)
 
@@ -1084,11 +1084,11 @@
     datatype set
       = E 
       | T of {
-	  elt : item, 
+          elt : item, 
           cnt : int, 
           left : set,
           right : set
-	}
+        }
 
     fun numItems E = 0
       | numItems (T{cnt,...}) = cnt
@@ -1284,16 +1284,16 @@
     val add = add
 
     fun member (set, x) = let
-	  fun pk E = false
-	    | pk (T{elt=v, left=l, right=r, ...}) = (
-		case K.compare(x,v)
-		 of LESS => pk l
-		  | EQUAL => true
-		  | GREATER => pk r
-		(* end case *))
-	  in
-	    pk set
-	  end
+          fun pk E = false
+            | pk (T{elt=v, left=l, right=r, ...}) = (
+                case K.compare(x,v)
+                 of LESS => pk l
+                  | EQUAL => true
+                  | GREATER => pk r
+                (* end case *))
+          in
+            pk set
+          end
 
     local
         (* true if every item in t is in t' *)
@@ -1323,24 +1323,24 @@
 
     local
       fun next ((t as T{right, ...})::rest) = (t, left(right, rest))
-	| next _ = (E, [])
+        | next _ = (E, [])
       and left (E, rest) = rest
-	| left (t as T{left=l, ...}, rest) = left(l, t::rest)
+        | left (t as T{left=l, ...}, rest) = left(l, t::rest)
     in
     fun compare (s1, s2) = let
-	  fun cmp (t1, t2) = (case (next t1, next t2)
-		 of ((E, _), (E, _)) => EQUAL
-		  | ((E, _), _) => LESS
-		  | (_, (E, _)) => GREATER
-		  | ((T{elt=e1, ...}, r1), (T{elt=e2, ...}, r2)) => (
-		      case Key.compare(e1, e2)
-		       of EQUAL => cmp (r1, r2)
-			| order => order
-		      (* end case *))
-		(* end case *))
-	  in
-	    cmp (left(s1, []), left(s2, []))
-	  end
+          fun cmp (t1, t2) = (case (next t1, next t2)
+                 of ((E, _), (E, _)) => EQUAL
+                  | ((E, _), _) => LESS
+                  | (_, (E, _)) => GREATER
+                  | ((T{elt=e1, ...}, r1), (T{elt=e2, ...}, r2)) => (
+                      case Key.compare(e1, e2)
+                       of EQUAL => cmp (r1, r2)
+                        | order => order
+                      (* end case *))
+                (* end case *))
+          in
+            cmp (left(s1, []), left(s2, []))
+          end
     end
 
     fun delete (E,x) = raise LibBase.NotFound
@@ -1355,12 +1355,12 @@
     fun intersection (E, _) = E
       | intersection (_, E) = E
       | intersection (s, T{elt=v,left=l,right=r,...}) = let
-	  val l2 = split_lt(s,v)
-	  val r2 = split_gt(s,v)
+          val l2 = split_lt(s,v)
+          val r2 = split_gt(s,v)
           in
             if member(s,v)
-	      then concat3(intersection(l2,l),v,intersection(r2,r))
-	      else concat(intersection(l2,l),intersection(r2,r))
+              then concat3(intersection(l2,l),v,intersection(r2,r))
+              else concat(intersection(l2,l),intersection(r2,r))
           end
 
     fun difference (E,s) = E
@@ -1373,12 +1373,12 @@
           end
 
     fun map f set = let
-	  fun map'(acc, E) = acc
-	    | map'(acc, T{elt,left,right,...}) =
-		map' (add (map' (acc, left), f elt), right)
-	  in 
-	    map' (E, set)
-	  end
+          fun map'(acc, E) = acc
+            | map'(acc, T{elt,left,right,...}) =
+                map' (add (map' (acc, left), f elt), right)
+          in 
+            map' (E, set)
+          end
 
     fun app apf =
          let fun apply E = ()
@@ -1389,17 +1389,17 @@
          end
 
     fun foldl f b set = let
-	  fun foldf (E, b) = b
-	    | foldf (T{elt,left,right,...}, b) = 
-		foldf (right, f(elt, foldf (left, b)))
+          fun foldf (E, b) = b
+            | foldf (T{elt,left,right,...}, b) = 
+                foldf (right, f(elt, foldf (left, b)))
           in
             foldf (set, b)
           end
 
     fun foldr f b set = let
-	  fun foldf (E, b) = b
-	    | foldf (T{elt,left,right,...}, b) = 
-		foldf (left, f(elt, foldf (right, b)))
+          fun foldf (E, b) = b
+            | foldf (T{elt,left,right,...}, b) = 
+                foldf (left, f(elt, foldf (right, b)))
           in
             foldf (set, b)
           end
@@ -1407,20 +1407,20 @@
     fun listItems set = foldr (op::) [] set
 
     fun filter pred set =
-	  foldl (fn (item, s) => if (pred item) then add(s, item) else s)
-	    empty set
+          foldl (fn (item, s) => if (pred item) then add(s, item) else s)
+            empty set
 
     fun find p E = NONE
       | find p (T{elt,left,right,...}) = (case find p left
-	   of NONE => if (p elt)
-		then SOME elt
-		else find p right
-	    | a => a
-	  (* end case *))
+           of NONE => if (p elt)
+                then SOME elt
+                else find p right
+            | a => a
+          (* end case *))
 
     fun exists p E = false
       | exists p (T{elt, left, right,...}) =
-	  (exists p left) orelse (p elt) orelse (exists p right)
+          (exists p left) orelse (p elt) orelse (exists p right)
 
   end (* BinarySetFn *)
 (* stop of smlnj-lib/Util/binary-set-fn.sml *)
@@ -1481,23 +1481,23 @@
 
     (* Type [Sections 2.4 and 4.1]*)
 
-    eqtype TyVar			(* [alpha] or [tyvar] *)
+    eqtype TyVar                        (* [alpha] or [tyvar] *)
 
 
     (* Operations *)
 
-    val invent:		bool -> TyVar
-    val fromIndex:	bool -> int -> TyVar
-    val fromString:	string -> TyVar
-    val toString:	TyVar -> string
+    val invent:         bool -> TyVar
+    val fromIndex:      bool -> int -> TyVar
+    val fromString:     string -> TyVar
+    val toString:       TyVar -> string
 
-    val admitsEquality:	TyVar -> bool
-    val isExplicit:	TyVar -> bool
+    val admitsEquality: TyVar -> bool
+    val isExplicit:     TyVar -> bool
 
-    val instance:	TyVar -> TyVar
-    val normalise:	TyVar * int -> TyVar
+    val instance:       TyVar -> TyVar
+    val normalise:      TyVar * int -> TyVar
 
-    val compare:	TyVar * TyVar -> order
+    val compare:        TyVar * TyVar -> order
 
   end
 (* stop of TYVAR.sml *)
@@ -1519,29 +1519,29 @@
 
     (* Type [Sections 2.4 and 4.1]*)
 
-    type TyVar = { name: string, equality: bool }	(* [alpha] or [tyvar] *)
+    type TyVar = { name: string, equality: bool }       (* [alpha] or [tyvar] *)
 
 
     (* Creation *)
 
     fun invent equality =
-	{ name="'#" ^ Stamp.toString(Stamp.stamp()),
-	  equality=equality }
+        { name="'#" ^ Stamp.toString(Stamp.stamp()),
+          equality=equality }
 
     fun fromIndex equality n =
-	let
-	    fun rep(0,c) = c
-	      | rep(n,c) = c ^ rep(n-1,c)
+        let
+            fun rep(0,c) = c
+              | rep(n,c) = c ^ rep(n-1,c)
 
-	    val c    = String.str(Char.chr(Char.ord #"a" + n mod 26))
-	    val name = (if equality then "''" else "'") ^ rep(n div 26, c)
-	in
-	    { name=name, equality=equality }
-	end
+            val c    = String.str(Char.chr(Char.ord #"a" + n mod 26))
+            val name = (if equality then "''" else "'") ^ rep(n div 26, c)
+        in
+            { name=name, equality=equality }
+        end
 
     fun fromString s =
-    	{ name = s,
-    	  equality = String.size(s) > 1 andalso String.sub(s,1) = #"'" }
+        { name = s,
+          equality = String.size(s) > 1 andalso String.sub(s,1) = #"'" }
 
     fun toString{name,equality}       = name
 
@@ -1551,7 +1551,7 @@
     fun admitsEquality{name,equality} = equality
 
     fun isExplicit{name,equality} =
-	String.size name = 1 orelse String.sub(name,1) <> #"#"
+        String.size name = 1 orelse String.sub(name,1) <> #"#"
 
 
     (* Small helpers *)
@@ -1564,7 +1564,7 @@
     (* Ordering *)
 
     fun compare(alpha1: TyVar, alpha2: TyVar) =
-	String.compare(#name alpha1, #name alpha2)
+        String.compare(#name alpha1, #name alpha2)
 
   end
 (* stop of TyVar.sml *)
@@ -1593,26 +1593,26 @@
 
     (* Type [Section 4.1] *)
 
-    eqtype TyName					(* [t] *)
+    eqtype TyName                                       (* [t] *)
 
     datatype Equality = NOEQ | EQ | SPECIALEQ
 
 
     (* Operations *)
 
-    val tyname:		TyCon * int * Equality * int -> TyName
-    val invent:		int * Equality -> TyName
-    val rename:		TyName -> TyName
-    val removeEquality:	TyName -> TyName
-    val Abs:		TyName -> TyName
+    val tyname:         TyCon * int * Equality * int -> TyName
+    val invent:         int * Equality -> TyName
+    val rename:         TyName -> TyName
+    val removeEquality: TyName -> TyName
+    val Abs:            TyName -> TyName
 
-    val arity:		TyName -> int
-    val equality:	TyName -> Equality
-    val span:		TyName -> int
-    val tycon:		TyName -> TyCon
-    val toString:	TyName -> string
+    val arity:          TyName -> int
+    val equality:       TyName -> Equality
+    val span:           TyName -> int
+    val tycon:          TyName -> TyCon
+    val toString:       TyName -> string
 
-    val compare:	TyName * TyName -> order
+    val compare:        TyName * TyName -> order
 
   end
 (* stop of TYNAME.sml *)
@@ -1644,24 +1644,24 @@
 
     datatype Equality = NOEQ | EQ | SPECIALEQ
 
-    type TyName =				      (* [t] *)
-	 { tycon:       TyCon
-	 , stamp:       stamp
-	 , arity:       int
-	 , equality:    Equality
-	 , span: 	int
-	 }
+    type TyName =                                     (* [t] *)
+         { tycon:       TyCon
+         , stamp:       stamp
+         , arity:       int
+         , equality:    Equality
+         , span:        int
+         }
 
 
     (* Creation *)
 
     fun tyname(tycon, arity, equality, span) =
-	{ tycon    = tycon
-	, stamp    = Stamp.stamp()
-	, arity    = arity
-	, equality = equality
-	, span     = span
-	}
+        { tycon    = tycon
+        , stamp    = Stamp.stamp()
+        , arity    = arity
+        , equality = equality
+        , span     = span
+        }
 
     fun invent(arity, equality) = tyname(TyCon.invent(), arity, equality, 0)
 
@@ -1669,13 +1669,13 @@
     (* Creation from existing *)
 
     fun rename{tycon, stamp, arity, equality, span} =
-	    tyname(tycon, arity, equality, span)
+            tyname(tycon, arity, equality, span)
 
     fun removeEquality{tycon, stamp, arity, equality, span} =
-	    tyname(tycon, arity, NOEQ, span)
+            tyname(tycon, arity, NOEQ, span)
 
     fun Abs{tycon, stamp, arity, equality, span} =
-	    tyname(tycon, arity, NOEQ, 0)
+            tyname(tycon, arity, NOEQ, 0)
 
 
     (* Attributes [Section 4.1] *)
@@ -1707,12 +1707,12 @@
 
     (* Type [Section 2.2] *)
 
-    datatype SCon =				(* [scon] *)
-	  INT    of int
-	| WORD   of word
-	| STRING of string
-	| CHAR   of char
-	| REAL   of real
+    datatype SCon =                             (* [scon] *)
+          INT    of int
+        | WORD   of word
+        | STRING of string
+        | CHAR   of char
+        | REAL   of real
 
     (* Operations *)
 
@@ -1741,12 +1741,12 @@
 
     (* Type [Section 2.2] *)
 
-    datatype SCon =				(* [scon] *)
-	  INT    of int
-	| WORD   of word
-	| STRING of string
-	| CHAR   of char
-	| REAL   of real
+    datatype SCon =                             (* [scon] *)
+          INT    of int
+        | WORD   of word
+        | STRING of string
+        | CHAR   of char
+        | REAL   of real
 
 
     (* Conversions *)
@@ -1788,16 +1788,16 @@
 
     (* Type [Section 2.4] *)
 
-    eqtype Lab					(* [lab] *)
+    eqtype Lab                                  (* [lab] *)
 
 
     (* Operations *)
 
-    val fromString:	string -> Lab
-    val fromInt:	int    -> Lab
-    val toString:	Lab    -> string
+    val fromString:     string -> Lab
+    val fromInt:        int    -> Lab
+    val toString:       Lab    -> string
 
-    val compare:	Lab * Lab -> order
+    val compare:        Lab * Lab -> order
 
   end
 (* stop of LAB.sml *)
@@ -1814,7 +1814,7 @@
 
     (* Type [Section 2.4] *)
 
-    type Lab = string					(* [lab] *)
+    type Lab = string                                   (* [lab] *)
 
 
     (* Conversions *)
@@ -1828,8 +1828,8 @@
 
     fun compare(lab1,lab2) =
       case (Int.fromString lab1, Int.fromString lab2)
-	of (SOME i1, SOME i2) => Int.compare(i1,i2)
-	 |     _              => String.compare(lab1,lab2)
+        of (SOME i1, SOME i2) => Int.compare(i1,i2)
+         |     _              => String.compare(lab1,lab2)
 
   end
 (* stop of Lab.sml *)
@@ -1841,38 +1841,38 @@
  *)
 
 structure TyVarSet   = FinSetFn(type ord_key = TyVar.TyVar
-				val  compare = TyVar.compare)
+                                val  compare = TyVar.compare)
 
 structure TyNameSet  = FinSetFn(type ord_key = TyName.TyName
-				val  compare = TyName.compare)
+                                val  compare = TyName.compare)
 
 structure SConSet    = FinSetFn(type ord_key = SCon.SCon
-				val  compare = SCon.compare)
+                                val  compare = SCon.compare)
 
 structure VIdSet     = FinSetFn(type ord_key = VId.Id
-				val  compare = VId.compare)
+                                val  compare = VId.compare)
 
 structure LongVIdSet = FinSetFn(type ord_key = LongVId.longId
-				val  compare = LongVId.compare)
+                                val  compare = LongVId.compare)
 
 
 structure LabMap     = FinMapFn(type ord_key = Lab.Lab
-				val  compare = Lab.compare)
+                                val  compare = Lab.compare)
 
 structure VIdMap     = FinMapFn(type ord_key = VId.Id
-				val  compare = VId.compare)
+                                val  compare = VId.compare)
 
 structure TyConMap   = FinMapFn(type ord_key = TyCon.Id
-				val  compare = TyCon.compare)
+                                val  compare = TyCon.compare)
 
 structure TyVarMap   = FinMapFn(type ord_key = TyVar.TyVar
-				val  compare = TyVar.compare)
+                                val  compare = TyVar.compare)
 
 structure TyNameMap  = FinMapFn(type ord_key = TyName.TyName
-				val  compare = TyName.compare)
+                                val  compare = TyName.compare)
 
 structure StrIdMap   = FinMapFn(type ord_key = StrId.Id
-				val  compare = StrId.compare)
+                                val  compare = StrId.compare)
 (* stop of AssembliesCoreStatic.sml *)
 (* start of OVERLOADINGCLASS.sml *)
 (*
@@ -1908,25 +1908,25 @@
 
     (* Type *)
 
-    type OverloadingClass				(* [O] *)
+    type OverloadingClass                               (* [O] *)
 
 
     (* Operations *)
 
-    val make:		TyNameSet * TyName -> OverloadingClass
+    val make:           TyNameSet * TyName -> OverloadingClass
 
-    val isEmpty:	OverloadingClass -> bool
-    val isSingular:	OverloadingClass -> bool
-    val default:	OverloadingClass -> TyName
-    val set:		OverloadingClass -> TyNameSet
-    val member:		OverloadingClass * TyName -> bool
-    val getItem:	OverloadingClass -> TyName
+    val isEmpty:        OverloadingClass -> bool
+    val isSingular:     OverloadingClass -> bool
+    val default:        OverloadingClass -> TyName
+    val set:            OverloadingClass -> TyNameSet
+    val member:         OverloadingClass * TyName -> bool
+    val getItem:        OverloadingClass -> TyName
 
-    val makeEquality:	OverloadingClass -> OverloadingClass option
-    val intersection:	OverloadingClass * OverloadingClass ->
-					   OverloadingClass option
-    val union:		OverloadingClass * OverloadingClass ->
-					   OverloadingClass
+    val makeEquality:   OverloadingClass -> OverloadingClass option
+    val intersection:   OverloadingClass * OverloadingClass ->
+                                           OverloadingClass option
+    val union:          OverloadingClass * OverloadingClass ->
+                                           OverloadingClass
 
   end
 (* stop of OVERLOADINGCLASS.sml *)
@@ -1964,7 +1964,7 @@
 
     (* Type *)
 
-    type OverloadingClass = TyNameSet * TyName		(* [O] *)
+    type OverloadingClass = TyNameSet * TyName          (* [O] *)
 
 
     (* Simple operations *)
@@ -1982,33 +1982,33 @@
     (* Filter equality types *)
 
     fun makeEquality (T,t) =
-	let
-	    val T' = TyNameSet.filter (fn t => TyName.equality t = TyName.EQ) T
-	in
-	    if TyNameSet.isEmpty T' then
-		NONE
-	    else if TyName.equality t <> TyName.NOEQ then
-		SOME(T',t)
-	    else
-		raise Fail "OverloadingClass.makeEquality: \
-			   \inconsistent overloading classes"
-	end
+        let
+            val T' = TyNameSet.filter (fn t => TyName.equality t = TyName.EQ) T
+        in
+            if TyNameSet.isEmpty T' then
+                NONE
+            else if TyName.equality t <> TyName.NOEQ then
+                SOME(T',t)
+            else
+                raise Fail "OverloadingClass.makeEquality: \
+                           \inconsistent overloading classes"
+        end
 
 
     (* Intersection and union *)
 
     fun intersection((T1,t1), (T2,t2)) =
-	let
-	    val T' = TyNameSet.intersection(T1,T2)
-	in
-	    if TyNameSet.isEmpty T' then
-		NONE
-	    else if t1 = t2 then
-		SOME(T',t1)
-	    else
-		raise Fail "OverloadingClass.intersect: \
-			   \inconsistent overloading classes"
-	end
+        let
+            val T' = TyNameSet.intersection(T1,T2)
+        in
+            if TyNameSet.isEmpty T' then
+                NONE
+            else if t1 = t2 then
+                SOME(T',t1)
+            else
+                raise Fail "OverloadingClass.intersect: \
+                           \inconsistent overloading classes"
+        end
 
 
     fun union((T1,t1), (T2,t2)) = ( TyNameSet.union(T1,T2), t2 )
@@ -2053,64 +2053,64 @@
 
     (* Types [Section 4.2] *)
 
-    datatype RowVar = CLOSEDRow | FLEXRow of bool		(* [r] *)
+    datatype RowVar = CLOSEDRow | FLEXRow of bool               (* [r] *)
 
-    datatype Type' =						(* [tau] *)
-	  TyVar      of TyVar
-	| RowType    of (*RowType*) (Type' ref LabMap * RowVar)
-	| FunType    of (*FunType*) (Type' ref * Type' ref)
-	| ConsType   of (*ConsType*)(Type' ref list * TyName)
-	| Overloaded of OverloadingClass
-	| Link       of (*Type*) Type' ref
+    datatype Type' =                                            (* [tau] *)
+          TyVar      of TyVar
+        | RowType    of (*RowType*) (Type' ref LabMap * RowVar)
+        | FunType    of (*FunType*) (Type' ref * Type' ref)
+        | ConsType   of (*ConsType*)(Type' ref list * TyName)
+        | Overloaded of OverloadingClass
+        | Link       of (*Type*) Type' ref
 
     type Type         = Type' ref
 
-    type RowType      = Type LabMap * RowVar			(* [rho] *)
+    type RowType      = Type LabMap * RowVar                    (* [rho] *)
     type FunType      = Type * Type
     type ConsType     = Type list * TyName
 
-    type TypeFcn      = TyVar list * Type			(* [theta] *)
+    type TypeFcn      = TyVar list * Type                       (* [theta] *)
 
-    type Substitution = Type TyVarMap				(* [mu] *)
-    type Realisation  = TypeFcn TyNameMap			(* [phi] *)
+    type Substitution = Type TyVarMap                           (* [mu] *)
+    type Realisation  = TypeFcn TyNameMap                       (* [phi] *)
 
 
     (* Operations *)
 
-    val invent:			unit -> Type
-    val fromTyVar:		TyVar -> Type
-    val fromRowType:		RowType -> Type
-    val fromFunType:		FunType -> Type
-    val fromConsType:		ConsType -> Type
-    val fromOverloadingClass:	OverloadingClass -> Type
+    val invent:                 unit -> Type
+    val fromTyVar:              TyVar -> Type
+    val fromRowType:            RowType -> Type
+    val fromFunType:            FunType -> Type
+    val fromConsType:           ConsType -> Type
+    val fromOverloadingClass:   OverloadingClass -> Type
 
-    val range:			Type -> Type
-    val tyname:			Type -> TyName
+    val range:                  Type -> Type
+    val tyname:                 Type -> TyName
 
-    val normalise:		Type -> Type
-    val substitute:		Substitution -> Type -> Type
-    val realise:		Realisation  -> Type -> Type
+    val normalise:              Type -> Type
+    val substitute:             Substitution -> Type -> Type
+    val realise:                Realisation  -> Type -> Type
 
-    val tyvars:			Type -> TyVarSet
-    val tynames:		Type -> TyNameSet
-    val admitsEquality:		Type -> bool
-    val isFlexible:		Type -> bool
+    val tyvars:                 Type -> TyVarSet
+    val tynames:                Type -> TyNameSet
+    val admitsEquality:         Type -> bool
+    val isFlexible:             Type -> bool
 
     exception Unify
-    val unify:			Type * Type -> unit (* Unify *)
-    val unifyRestricted:	TyVarSet -> Type * Type -> unit (* Unify *)
-    val makeEquality:		Type -> unit (* Unify *)
+    val unify:                  Type * Type -> unit (* Unify *)
+    val unifyRestricted:        TyVarSet -> Type * Type -> unit (* Unify *)
+    val makeEquality:           Type -> unit (* Unify *)
 
-    val defaultOverloaded:	Type -> unit
+    val defaultOverloaded:      Type -> unit
 
 
     (* Operations on rows *)
 
-    val emptyRho:		RowType
-    val singletonRho:		Lab * Type -> RowType
-    val insertRho:		RowType * Lab * Type -> RowType
-    val inventRho:		unit -> RowType
-    val findLab:		RowType * Lab -> Type option
+    val emptyRho:               RowType
+    val singletonRho:           Lab * Type -> RowType
+    val insertRho:              RowType * Lab * Type -> RowType
+    val inventRho:              unit -> RowType
+    val findLab:                RowType * Lab -> Type option
 
   end
 (* stop of TYPE.sml *)
@@ -2152,26 +2152,26 @@
 
     (* Types [Section 4.2] *)
 
-    datatype RowVar = CLOSEDRow | FLEXRow of bool	(* [r] *)
+    datatype RowVar = CLOSEDRow | FLEXRow of bool       (* [r] *)
 
-    datatype Type' =					(* [tau] *)
-	  TyVar      of TyVar
-	| RowType    of RowType
-	| FunType    of FunType
-	| ConsType   of ConsType
-	| Overloaded of OverloadingClass
-	| Link       of Type
+    datatype Type' =                                    (* [tau] *)
+          TyVar      of TyVar
+        | RowType    of RowType
+        | FunType    of FunType
+        | ConsType   of ConsType
+        | Overloaded of OverloadingClass
+        | Link       of Type
 
     withtype Type     = Type' ref
 
-    and RowType       = Type' ref LabMap * RowVar	(* [rho] *)
+    and RowType       = Type' ref LabMap * RowVar       (* [rho] *)
     and FunType       = Type' ref * Type' ref
     and ConsType      = Type' ref list * TyName
 
-    type TypeFcn      = TyVar list * Type		(* [theta] *)
+    type TypeFcn      = TyVar list * Type               (* [theta] *)
 
-    type Substitution = Type TyVarMap			(* [mu] *)
-    type Realisation  = TypeFcn TyNameMap		(* [phi] *)
+    type Substitution = Type TyVarMap                   (* [mu] *)
+    type Realisation  = TypeFcn TyNameMap               (* [phi] *)
 
 
     (* Creation *)
@@ -2192,108 +2192,108 @@
 
     fun tyname(ref(ConsType(taus,t)))  = t
       | tyname  _                      =
-	    raise Fail "Type.tyname: non-constructed type"
+            raise Fail "Type.tyname: non-constructed type"
 
 
     (* Induce sharing on equal type variables in a type *)
 
     fun normalise tau =
-	let
-	    (* Note that Overloaded nodes also have to be shared.
-	     * But since such types are always pre-built rather than
-	     * infered, we just take care that we construct them with
-	     * proper sharing and ignore Overloaded nodes here.
-	     *)
+        let
+            (* Note that Overloaded nodes also have to be shared.
+             * But since such types are always pre-built rather than
+             * infered, we just take care that we construct them with
+             * proper sharing and ignore Overloaded nodes here.
+             *)
 
-	    val alphas = ref []
+            val alphas = ref []
 
-	    fun normalise(tau as ref(TyVar(alpha))) =
-		(case List.find (fn(alpha1,_) => alpha1 = alpha) (!alphas)
-		   of SOME(_,tau1) => tau1
-		    | NONE         => ( alphas := (alpha,tau) :: !alphas
-				      ; tau
-				      )
-		)
-	      | normalise(ref(Link(tau)))  = normalise tau
-	      | normalise(tau as ref tau') = ( tau := normalise' tau' ; tau )
+            fun normalise(tau as ref(TyVar(alpha))) =
+                (case List.find (fn(alpha1,_) => alpha1 = alpha) (!alphas)
+                   of SOME(_,tau1) => tau1
+                    | NONE         => ( alphas := (alpha,tau) :: !alphas
+                                      ; tau
+                                      )
+                )
+              | normalise(ref(Link(tau)))  = normalise tau
+              | normalise(tau as ref tau') = ( tau := normalise' tau' ; tau )
 
-	    and normalise'(RowType(Rho,r)) =
-		    RowType(LabMap.map normalise Rho, r)
+            and normalise'(RowType(Rho,r)) =
+                    RowType(LabMap.map normalise Rho, r)
 
-	      | normalise'(FunType(tau1,tau2)) =
-		    FunType(normalise tau1, normalise tau2)
+              | normalise'(FunType(tau1,tau2)) =
+                    FunType(normalise tau1, normalise tau2)
 
-	      | normalise'(ConsType(taus,t)) =
-		    ConsType(List.map normalise taus, t)
+              | normalise'(ConsType(taus,t)) =
+                    ConsType(List.map normalise taus, t)
 
-	      | normalise'(Overloaded(O)) =
-		    Overloaded(O)
+              | normalise'(Overloaded(O)) =
+                    Overloaded(O)
 
-	      | normalise' _ =
-		    raise Fail "Type.normalise: bypassed type variable or link"
-	in
-	    normalise tau
-	end
+              | normalise' _ =
+                    raise Fail "Type.normalise: bypassed type variable or link"
+        in
+            normalise tau
+        end
 
 
 
     (* Cloning under a substitution and a type realisation *)
 
     fun clone (mu,phi) tau =
-	let
-	    (* Cloning must respect sharing, so an association list is used
-	     * to remember nodes already visited together with their copy.
-	     *)
+        let
+            (* Cloning must respect sharing, so an association list is used
+             * to remember nodes already visited together with their copy.
+             *)
 
-	    val mu'    = ref mu
-	    val cloned = ref []
+            val mu'    = ref mu
+            val cloned = ref []
 
-	    fun clone tau =
-		case List.find (fn(tau1,_) => tau1 = tau) (!cloned)
-		  of SOME(_,tau2) => tau2
-		   | NONE         => let val tau2 = clone' tau in
-					 cloned := (tau,tau2) :: !cloned
-					; tau2
-				     end
+            fun clone tau =
+                case List.find (fn(tau1,_) => tau1 = tau) (!cloned)
+                  of SOME(_,tau2) => tau2
+                   | NONE         => let val tau2 = clone' tau in
+                                         cloned := (tau,tau2) :: !cloned
+                                        ; tau2
+                                     end
 
-	    and clone'(tau as ref(TyVar(alpha))) =
-		(case TyVarMap.find(!mu', alpha)
-		   of NONE     => tau
-		    | SOME tau => tau
-		)
-	      | clone'(ref(RowType(Rho,r))) =
-		    ref(RowType(LabMap.map clone Rho, r))
+            and clone'(tau as ref(TyVar(alpha))) =
+                (case TyVarMap.find(!mu', alpha)
+                   of NONE     => tau
+                    | SOME tau => tau
+                )
+              | clone'(ref(RowType(Rho,r))) =
+                    ref(RowType(LabMap.map clone Rho, r))
 
-	      | clone'(ref(FunType(tau1,tau2))) =
-		    ref(FunType(clone tau1, clone tau2))
+              | clone'(ref(FunType(tau1,tau2))) =
+                    ref(FunType(clone tau1, clone tau2))
 
-	      | clone'(tau as ref(ConsType(taus,t))) =
-		let
-		    val taus2 = List.map clone taus
-		in
-		    case TyNameMap.find(phi, t)
-		      of NONE              => ref(ConsType(taus2,t))
-		       | SOME(alphas,tau1) =>
-			 let
-			    val cloned' = !cloned
-			 in
-			    mu' := ListPair.foldl
-				    (fn(alpha,tau2,mu) =>
-					TyVarMap.insert(mu,alpha,tau2))
-				    (!mu') (alphas,taus2)
-			    ; clone' tau1
-			    before cloned := cloned'
-			 end
-		end
+              | clone'(tau as ref(ConsType(taus,t))) =
+                let
+                    val taus2 = List.map clone taus
+                in
+                    case TyNameMap.find(phi, t)
+                      of NONE              => ref(ConsType(taus2,t))
+                       | SOME(alphas,tau1) =>
+                         let
+                            val cloned' = !cloned
+                         in
+                            mu' := ListPair.foldl
+                                    (fn(alpha,tau2,mu) =>
+                                        TyVarMap.insert(mu,alpha,tau2))
+                                    (!mu') (alphas,taus2)
+                            ; clone' tau1
+                            before cloned := cloned'
+                         end
+                end
 
-	      | clone'(ref(Overloaded(O))) =
-		    ref(Overloaded(O))
+              | clone'(ref(Overloaded(O))) =
+                    ref(Overloaded(O))
 
-	      | clone'(ref(Link(tau))) =
-		    clone tau
-	in
-	    clone tau
-	end
+              | clone'(ref(Link(tau))) =
+                    clone tau
+        in
+            clone tau
+        end
 
 
     (* Substitution, and realisation [Section 5.2] *)
@@ -2309,21 +2309,21 @@
     and tyvars'(TyVar(alpha)) = TyVarSet.singleton alpha
 
       | tyvars'(RowType(Rho,r)) =
-	    LabMap.foldl (fn(tau,U) => TyVarSet.union(U, tyvars tau))
-			 TyVarSet.empty Rho
+            LabMap.foldl (fn(tau,U) => TyVarSet.union(U, tyvars tau))
+                         TyVarSet.empty Rho
 
       | tyvars'(FunType(tau1,tau2)) =
-	    TyVarSet.union(tyvars tau1, tyvars tau2)
+            TyVarSet.union(tyvars tau1, tyvars tau2)
  
       | tyvars'(ConsType(taus,t)) =
-	    List.foldl (fn(tau,U) => TyVarSet.union(U, tyvars tau))
-		       TyVarSet.empty taus
+            List.foldl (fn(tau,U) => TyVarSet.union(U, tyvars tau))
+                       TyVarSet.empty taus
 
       | tyvars'(Overloaded(O)) =
-	    TyVarSet.empty
+            TyVarSet.empty
 
       | tyvars'(Link(tau)) =
-	    tyvars tau
+            tyvars tau
 
 
     fun tynames(ref tau') = tynames' tau'
@@ -2331,26 +2331,26 @@
     and tynames'(TyVar(alpha)) = TyNameSet.empty
 
       | tynames'(RowType(Rho,r)) =
-	    LabMap.foldl (fn(tau,T) =>
-			  TyNameSet.union(T, tynames tau)) TyNameSet.empty Rho
+            LabMap.foldl (fn(tau,T) =>
+                          TyNameSet.union(T, tynames tau)) TyNameSet.empty Rho
 
       | tynames'(FunType(tau1,tau2)) =
-	    TyNameSet.union(tynames tau1, tynames tau2)
+            TyNameSet.union(tynames tau1, tynames tau2)
  
       | tynames'(ConsType(taus,t)) =
-	let
-	    val T = List.foldl (fn(tau,T) => TyNameSet.union(T, tynames tau))
-			       TyNameSet.empty taus
-	in
-	    TyNameSet.add(T, t)
-	end
+        let
+            val T = List.foldl (fn(tau,T) => TyNameSet.union(T, tynames tau))
+                               TyNameSet.empty taus
+        in
+            TyNameSet.add(T, t)
+        end
 
       | tynames'(Overloaded(O)) =
-	    (* Conservative approximation *)
-	    OverloadingClass.set O
+            (* Conservative approximation *)
+            OverloadingClass.set O
 
       | tynames'(Link(tau)) =
-	    tynames tau
+            tynames tau
 
 
 
@@ -2359,29 +2359,29 @@
     fun admitsEquality(ref tau') = admitsEquality' tau'
 
     and admitsEquality'(TyVar alpha) =
-	    TyVar.admitsEquality alpha orelse
-	    not(TyVar.isExplicit alpha)
+            TyVar.admitsEquality alpha orelse
+            not(TyVar.isExplicit alpha)
 
       | admitsEquality'(RowType(Rho,CLOSEDRow)) =
-	    LabMap.all admitsEquality Rho
+            LabMap.all admitsEquality Rho
 
       | admitsEquality'(RowType(Rho,FLEXRow _)) =
-	    raise Fail "Type.admitsEquality: flexible row"
+            raise Fail "Type.admitsEquality: flexible row"
 
       | admitsEquality'(FunType _) = false
 
       | admitsEquality'(ConsType(taus,t)) =
-	(case TyName.equality t
-	   of TyName.SPECIALEQ => true
-	    | TyName.EQ        => List.all admitsEquality taus
-	    | TyName.NOEQ      => false
-	)
+        (case TyName.equality t
+           of TyName.SPECIALEQ => true
+            | TyName.EQ        => List.all admitsEquality taus
+            | TyName.NOEQ      => false
+        )
 
       | admitsEquality'(Overloaded(O)) =
-	    raise Fail "Type.admitsEquality: overloaded type"
+            raise Fail "Type.admitsEquality: overloaded type"
 
       | admitsEquality'(Link(tau)) =
-	    admitsEquality tau
+            admitsEquality tau
 
 
 
@@ -2392,13 +2392,13 @@
     and isFlexible'(TyVar(alpha')) = false
 
       | isFlexible'(RowType(Rho,r)) =
-	    r <> CLOSEDRow orelse LabMap.exists isFlexible Rho
+            r <> CLOSEDRow orelse LabMap.exists isFlexible Rho
 
       | isFlexible'(FunType(tau1,tau2)) =
-	    isFlexible tau1 orelse isFlexible tau2
+            isFlexible tau1 orelse isFlexible tau2
 
       | isFlexible'(ConsType(taus,t)) =
-	    List.exists isFlexible taus
+            List.exists isFlexible taus
 
       | isFlexible'(Overloaded(O)) = false
 
@@ -2414,34 +2414,34 @@
     fun occurs(alpha, ref tau') = occurs'(alpha, tau')
 
     and occurs'(alpha, TyVar(alpha')) =
-	    alpha = alpha'
+            alpha = alpha'
 
       | occurs'(alpha, RowType(Rho,r)) =
-	    LabMap.exists (fn tau => occurs(alpha, tau)) Rho
+            LabMap.exists (fn tau => occurs(alpha, tau)) Rho
 
       | occurs'(alpha, FunType(tau1,tau2)) =
-	    occurs(alpha, tau1) orelse occurs(alpha, tau2)
+            occurs(alpha, tau1) orelse occurs(alpha, tau2)
 
       | occurs'(alpha, ConsType(taus,t)) =
-	    List.exists (fn tau => occurs(alpha, tau)) taus
+            List.exists (fn tau => occurs(alpha, tau)) taus
 
       | occurs'(alpha, Overloaded(O)) =
-	    false
+            false
 
       | occurs'(alpha, Link(tau)) =
-	    occurs(alpha, tau)
+            occurs(alpha, tau)
 
 
     fun unify(ref(Link(tau1)), tau2) = unify(tau1, tau2)
       | unify(tau1, ref(Link(tau2))) = unify(tau1, tau2)
 
       | unify(tau1 as ref tau1', tau2 as ref tau2') =
-	if tau1 = tau2 then () else
-	let
-	    val tau' = Link(ref(unify'(tau1',tau2')))
-	in
-	    tau1 := tau' ; tau2 := tau'
-	end
+        if tau1 = tau2 then () else
+        let
+            val tau' = Link(ref(unify'(tau1',tau2')))
+        in
+            tau1 := tau' ; tau2 := tau'
+        end
 
     and unify'(TyVar(alpha), tau')  = unifyTyVar(alpha, tau')
       | unify'(tau', TyVar(alpha))  = unifyTyVar(alpha, tau')
@@ -2449,167 +2449,167 @@
       | unify'(tau', Overloaded(O)) = unifyOverloaded(O, tau')
 
       | unify'(tau' as FunType(tau11,tau12), FunType(tau21,tau22)) =
-	  ( unify(tau11,tau21)
-	  ; unify(tau12,tau22)
-	  ; tau'
-	  )
+          ( unify(tau11,tau21)
+          ; unify(tau12,tau22)
+          ; tau'
+          )
 
       | unify'(RowType(Rho1,r1), RowType(Rho2,r2)) =
-	let
-	    fun unifyField r (lab, tau1, Rho) =
-		case LabMap.find(Rho, lab)
-		  of SOME tau2  => ( unify(tau1,tau2)
-				   ; #1(LabMap.remove(Rho,lab))
-				   )
-		   | NONE =>
-		case r
-		  of CLOSEDRow  => raise Unify
-		   | FLEXRow eq => ( if eq then makeEquality tau1 else ()
-				   ; Rho
-				   )
+        let
+            fun unifyField r (lab, tau1, Rho) =
+                case LabMap.find(Rho, lab)
+                  of SOME tau2  => ( unify(tau1,tau2)
+                                   ; #1(LabMap.remove(Rho,lab))
+                                   )
+                   | NONE =>
+                case r
+                  of CLOSEDRow  => raise Unify
+                   | FLEXRow eq => ( if eq then makeEquality tau1 else ()
+                                   ; Rho
+                                   )
 
-	    val Rho1'  = LabMap.foldli (unifyField r1) Rho1 Rho2
-	    val _      = LabMap.foldli (unifyField r2) Rho2 Rho1'
-	    val r      = case (r1,r2)
-			   of (CLOSEDRow, _) => CLOSEDRow
-			    | (_, CLOSEDRow) => CLOSEDRow
-			    | (FLEXRow eq1, FLEXRow eq2) =>
-				  FLEXRow(eq1 orelse eq2)
-	in
-	    RowType(LabMap.unionWith #2 (Rho2,Rho1'), r)
-	end
+            val Rho1'  = LabMap.foldli (unifyField r1) Rho1 Rho2
+            val _      = LabMap.foldli (unifyField r2) Rho2 Rho1'
+            val r      = case (r1,r2)
+                           of (CLOSEDRow, _) => CLOSEDRow
+                            | (_, CLOSEDRow) => CLOSEDRow
+                            | (FLEXRow eq1, FLEXRow eq2) =>
+                                  FLEXRow(eq1 orelse eq2)
+        in
+            RowType(LabMap.unionWith #2 (Rho2,Rho1'), r)
+        end
 
 
       | unify'(tau' as ConsType(taus1,t1), ConsType(taus2,t2)) =
-	if t1 = t2 then
-	    ( ListPair.app unify (taus1,taus2)
-	    ; tau'
-	    )
-	else
-	    raise Unify
+        if t1 = t2 then
+            ( ListPair.app unify (taus1,taus2)
+            ; tau'
+            )
+        else
+            raise Unify
 
       | unify' _ = raise Unify
 
 
     and unifyTyVar(alpha1, TyVar(alpha2)) =
-	if alpha1 = alpha2 then
-	    TyVar(alpha2)
-	else if not(TyVar.isExplicit alpha1) then
-	    bindTyVar(alpha1, TyVar(alpha2))
-	else if not(TyVar.isExplicit alpha2) then
-	    bindTyVar(alpha2, TyVar(alpha1))
-	else
-	    raise Unify
+        if alpha1 = alpha2 then
+            TyVar(alpha2)
+        else if not(TyVar.isExplicit alpha1) then
+            bindTyVar(alpha1, TyVar(alpha2))
+        else if not(TyVar.isExplicit alpha2) then
+            bindTyVar(alpha2, TyVar(alpha1))
+        else
+            raise Unify
 
       | unifyTyVar(alpha, tau') =
-	if TyVar.isExplicit alpha orelse occurs'(alpha, tau') then
-	    raise Unify
-	else
-	    bindTyVar(alpha, tau')
+        if TyVar.isExplicit alpha orelse occurs'(alpha, tau') then
+            raise Unify
+        else
+            bindTyVar(alpha, tau')
 
     and bindTyVar(alpha, tau') =
-	if TyVar.admitsEquality alpha then
-	    makeEquality' tau'
-	else
-	    tau'
+        if TyVar.admitsEquality alpha then
+            makeEquality' tau'
+        else
+            tau'
 
 
     and unifyOverloaded(O, TyVar(alpha2)) =
-	    unifyTyVar(alpha2, Overloaded(O))
+            unifyTyVar(alpha2, Overloaded(O))
 
       | unifyOverloaded(O, tau' as ConsType([],t)) =
-	if OverloadingClass.member(O, t) then
-	    tau'
-	else
-	    raise Unify
+        if OverloadingClass.member(O, t) then
+            tau'
+        else
+            raise Unify
 
       | unifyOverloaded(O1, Overloaded(O2)) =
-	(case OverloadingClass.intersection(O1,O2)
-	   of NONE   => raise Unify
-	    | SOME O => Overloaded(O)
-	)
+        (case OverloadingClass.intersection(O1,O2)
+           of NONE   => raise Unify
+            | SOME O => Overloaded(O)
+        )
 
       | unifyOverloaded(O, _) =
-	    raise Unify
+            raise Unify
 
 
     and makeEquality(tau as ref tau') = tau := makeEquality' tau'
 
     and makeEquality'(TyVar(alpha)) =
-	if TyVar.admitsEquality alpha then
-	    TyVar(alpha)
-	else if TyVar.isExplicit alpha then
-	    raise Unify
-	else
-	    TyVar(TyVar.invent true)
+        if TyVar.admitsEquality alpha then
+            TyVar(alpha)
+        else if TyVar.isExplicit alpha then
+            raise Unify
+        else
+            TyVar(TyVar.invent true)
 
       | makeEquality'(RowType(Rho,r)) =
-	    ( LabMap.app makeEquality Rho
-	    ; RowType(Rho, case r of CLOSEDRow => CLOSEDRow
-				   | FLEXRow _ => FLEXRow true)
-	    )
+            ( LabMap.app makeEquality Rho
+            ; RowType(Rho, case r of CLOSEDRow => CLOSEDRow
+                                   | FLEXRow _ => FLEXRow true)
+            )
 
       | makeEquality'(FunType _) =
-	    raise Unify
+            raise Unify
 
       | makeEquality'(tau' as ConsType(taus,t)) =
-	(case TyName.equality t
-	   of TyName.SPECIALEQ => tau'
-	    | TyName.EQ        => ( List.app makeEquality taus ; tau' )
-	    | TyName.NOEQ      => raise Unify
-	)
+        (case TyName.equality t
+           of TyName.SPECIALEQ => tau'
+            | TyName.EQ        => ( List.app makeEquality taus ; tau' )
+            | TyName.NOEQ      => raise Unify
+        )
 
       | makeEquality'(Overloaded(O)) =
-	(case OverloadingClass.makeEquality O
-	   of NONE    => raise Unify
-	    | SOME O' => Overloaded(O')
-	)
+        (case OverloadingClass.makeEquality O
+           of NONE    => raise Unify
+            | SOME O' => Overloaded(O')
+        )
       | makeEquality'(Link(tau)) =
-	    ( makeEquality tau ; Link(tau) )
+            ( makeEquality tau ; Link(tau) )
 
 
 
     fun unifyRestricted U (tau1,tau2) =
-	let
-	    fun skolemise(alpha, mu) =
-		let
-		   val equality = if TyVar.admitsEquality alpha then TyName.EQ
-								else TyName.NOEQ
-		   val tau'     = ConsType([], TyName.invent(0,equality))
-		in
-		   TyVarMap.insert(mu, alpha, ref tau')
-		end
+        let
+            fun skolemise(alpha, mu) =
+                let
+                   val equality = if TyVar.admitsEquality alpha then TyName.EQ
+                                                                else TyName.NOEQ
+                   val tau'     = ConsType([], TyName.invent(0,equality))
+                in
+                   TyVarMap.insert(mu, alpha, ref tau')
+                end
 
-	    val mu = TyVarSet.foldl skolemise TyVarMap.empty U
-	in
-	    unify(substitute mu tau1, substitute mu tau2)
-	end
+            val mu = TyVarSet.foldl skolemise TyVarMap.empty U
+        in
+            unify(substitute mu tau1, substitute mu tau2)
+        end
 
 
 
     (* Assign default type to overloaded type components [Appendix E] *)
 
     fun defaultOverloaded(tau as ref(Overloaded(O))) =
-	    tau := ConsType([], OverloadingClass.default O)
+            tau := ConsType([], OverloadingClass.default O)
 
       | defaultOverloaded(ref tau') = defaultOverloaded' tau'
 
     and defaultOverloaded'(TyVar(alpha')) = ()
 
       | defaultOverloaded'(RowType(Rho,r)) =
-	    LabMap.app defaultOverloaded Rho
+            LabMap.app defaultOverloaded Rho
 
       | defaultOverloaded'(FunType(tau1,tau2)) =
-	    ( defaultOverloaded tau1 ; defaultOverloaded tau2 )
+            ( defaultOverloaded tau1 ; defaultOverloaded tau2 )
 
       | defaultOverloaded'(ConsType(taus,t)) =
-	    List.app defaultOverloaded taus
+            List.app defaultOverloaded taus
 
       | defaultOverloaded'(Overloaded(O)) =
-	    raise Fail "Type.defaultOverloaded: bypassed overloaded type"
+            raise Fail "Type.defaultOverloaded: bypassed overloaded type"
 
       | defaultOverloaded'(Link(tau)) =
-	    defaultOverloaded tau
+            defaultOverloaded tau
 
 
 
@@ -2651,26 +2651,26 @@
 
     (* Type [Section 4.2] *)
 
-    type TypeScheme = TyVar list * Type			(* [sigma] *)
+    type TypeScheme = TyVar list * Type                 (* [sigma] *)
 
 
     (* Operations *)
 
-    val instance:	TypeScheme -> Type
-    val instance':	TypeScheme -> TyVar list * Type
-    val Clos:		Type -> TypeScheme
-    val ClosRestricted:	TyVarSet -> Type -> TypeScheme
-    val isClosed:	TypeScheme -> bool
+    val instance:       TypeScheme -> Type
+    val instance':      TypeScheme -> TyVar list * Type
+    val Clos:           Type -> TypeScheme
+    val ClosRestricted: TyVarSet -> Type -> TypeScheme
+    val isClosed:       TypeScheme -> bool
 
-    val tyvars:		TypeScheme -> TyVarSet
-    val tynames:	TypeScheme -> TyNameSet
-    val normalise:	TypeScheme -> TypeScheme
+    val tyvars:         TypeScheme -> TyVarSet
+    val tynames:        TypeScheme -> TyNameSet
+    val normalise:      TypeScheme -> TypeScheme
 
-    val generalises:	TypeScheme * TypeScheme -> bool
-    val equals:		TypeScheme * TypeScheme -> bool
+    val generalises:    TypeScheme * TypeScheme -> bool
+    val equals:         TypeScheme * TypeScheme -> bool
 
-    val substitute:	Substitution -> TypeScheme -> TypeScheme
-    val realise:	Realisation  -> TypeScheme -> TypeScheme
+    val substitute:     Substitution -> TypeScheme -> TypeScheme
+    val realise:        Realisation  -> TypeScheme -> TypeScheme
 
   end
 (* stop of TYPESCHEME.sml *)
@@ -2702,32 +2702,32 @@
 
     (* Type [Section 4.2] *)
 
-    type TypeScheme = TyVar list * Type			(* [sigma] *)
+    type TypeScheme = TyVar list * Type                 (* [sigma] *)
 
 
     (* Some helper (this should be in the library...) *)
 
     fun List_foldri f y0 xs =
-	let
-	    fun fold(n,  [])   = y0
-	      | fold(n, x::xs) = f(n, x, fold(n+1,xs))
-	in
-	    fold(0,xs)
-	end
+        let
+            fun fold(n,  [])   = y0
+              | fold(n, x::xs) = f(n, x, fold(n+1,xs))
+        in
+            fold(0,xs)
+        end
 
 
 
     (* Type variable and type name extraction [Section 4.2] *)
 
     fun tyvars (alphas,tau) =
-	let
-	    val U = Type.tyvars tau
-	in
-	    List.foldl
-		(fn(alpha,U) => TyVarSet.delete(U,alpha)
-				handle LibBase.NotFound => U)
-		U alphas
-	end
+        let
+            val U = Type.tyvars tau
+        in
+            List.foldl
+                (fn(alpha,U) => TyVarSet.delete(U,alpha)
+                                handle LibBase.NotFound => U)
+                U alphas
+        end
 
     fun tynames (alphas,tau) = Type.tynames tau
 
@@ -2736,15 +2736,15 @@
     (* Instantiation *)
 
     fun instance' (alphas,tau) =
-	let
-	    val alphas' = List.map TyVar.instance alphas
-	    val mu      = ListPair.foldl
-			     (fn(alpha, alpha', mu) =>
-			      TyVarMap.insert(mu, alpha, Type.fromTyVar alpha'))
-			     TyVarMap.empty (alphas, alphas')
-	in
-	    ( alphas', Type.substitute mu tau )
-	end
+        let
+            val alphas' = List.map TyVar.instance alphas
+            val mu      = ListPair.foldl
+                             (fn(alpha, alpha', mu) =>
+                              TyVarMap.insert(mu, alpha, Type.fromTyVar alpha'))
+                             TyVarMap.empty (alphas, alphas')
+        in
+            ( alphas', Type.substitute mu tau )
+        end
 
     fun instance sigma = #2(instance' sigma)
 
@@ -2753,77 +2753,77 @@
     (* Generalisation [Section 4.5] *)
 
     fun generalisesType(sigma, tau) =
-	let
-	    val U = Type.tyvars tau
-	in
-	    ( Type.unifyRestricted U (instance sigma, tau) ; true )
-	    handle Type.Unify => false
-	end
+        let
+            val U = Type.tyvars tau
+        in
+            ( Type.unifyRestricted U (instance sigma, tau) ; true )
+            handle Type.Unify => false
+        end
 
     fun generalises(sigma1, sigma2) =
-	    generalisesType(sigma1, instance sigma2)
+            generalisesType(sigma1, instance sigma2)
 
 
 
     (* Closure [Section 4.8] *)
 
     fun Clos tau =
-	    (* Does not copy! *)
-	    ( TyVarSet.listItems(Type.tyvars tau), tau )
+            (* Does not copy! *)
+            ( TyVarSet.listItems(Type.tyvars tau), tau )
 
     fun ClosRestricted U tau =
-	    ( TyVarSet.listItems(TyVarSet.difference(Type.tyvars tau, U)), tau )
+            ( TyVarSet.listItems(TyVarSet.difference(Type.tyvars tau, U)), tau )
 
     fun isClosed (alphas,tau) =
-	TyVarSet.isSubset(Type.tyvars tau, TyVarSet.fromList alphas)
+        TyVarSet.isSubset(Type.tyvars tau, TyVarSet.fromList alphas)
 
 
     (* Comparison [Section 4.5] *)
 
     fun equals((alphas1,tau1), (alphas2,tau2)) =
-	List.length alphas1 = List.length alphas2 andalso
-	let
-	    fun insert(alpha1, alpha2, mu) =
-		TyVarMap.insert(mu, alpha1, Type.fromTyVar alpha2)
+        List.length alphas1 = List.length alphas2 andalso
+        let
+            fun insert(alpha1, alpha2, mu) =
+                TyVarMap.insert(mu, alpha1, Type.fromTyVar alpha2)
 
-	    val (alphas2',tau2') = instance' (alphas2,tau2)
-	    val mu    = ListPair.foldl insert TyVarMap.empty (alphas1,alphas2')
-	    val tau1' = Type.substitute mu tau1
-	    val U     = TyVarSet.fromList alphas2'
-	in
-	    ( Type.unifyRestricted U (tau1',tau2') ; true )
-	    handle Type.Unify => false
-	end
+            val (alphas2',tau2') = instance' (alphas2,tau2)
+            val mu    = ListPair.foldl insert TyVarMap.empty (alphas1,alphas2')
+            val tau1' = Type.substitute mu tau1
+            val U     = TyVarSet.fromList alphas2'
+        in
+            ( Type.unifyRestricted U (tau1',tau2') ; true )
+            handle Type.Unify => false
+        end
 
 
     (* Normalisation (for output) *)
 
     fun normalise (alphas,tau) =
-	let
-	    fun insert(n, alpha, (alphas',mu)) =
-		let
-		    val alpha' = TyVar.normalise(alpha, n)
-		    val tau    = Type.fromTyVar alpha'
-		in
-		    ( alpha'::alphas', TyVarMap.insert(mu, alpha,tau) )
-		end
+        let
+            fun insert(n, alpha, (alphas',mu)) =
+                let
+                    val alpha' = TyVar.normalise(alpha, n)
+                    val tau    = Type.fromTyVar alpha'
+                in
+                    ( alpha'::alphas', TyVarMap.insert(mu, alpha,tau) )
+                end
 
-	    val (alphas',mu) = List_foldri insert (nil,TyVarMap.empty) alphas
-	in
-	    ( alphas', Type.substitute mu tau )
-	end
+            val (alphas',mu) = List_foldri insert (nil,TyVarMap.empty) alphas
+        in
+            ( alphas', Type.substitute mu tau )
+        end
 
 
     (* Substitution *)
 
     fun substitute mu (alphas,tau) =
-	let
-	    val mu' = List.foldl (fn(alpha,mu) =>
-				    #1(TyVarMap.remove(mu,alpha))
-				    handle LibBase.NotFound => mu) mu alphas
-	in
-	    ( alphas, Type.substitute mu' tau )
-	end
+        let
+            val mu' = List.foldl (fn(alpha,mu) =>
+                                    #1(TyVarMap.remove(mu,alpha))
+                                    handle LibBase.NotFound => mu) mu alphas
+        in
+            ( alphas, Type.substitute mu' tau )
+        end
 
 
     (* Realisation [Section 5.2] *)
@@ -2857,31 +2857,31 @@
 
     (* Type [Section 4.2] *)
 
-    type TypeFcn = Type.TypeFcn			(* [theta] *)
+    type TypeFcn = Type.TypeFcn                 (* [theta] *)
 
 
     (* Operations *)
 
-    val fromTyName:	TyName  -> TypeFcn
-    val toTyName:	TypeFcn -> TyName option
-    val isClosed:	TypeFcn -> bool
+    val fromTyName:     TyName  -> TypeFcn
+    val toTyName:       TypeFcn -> TyName option
+    val isClosed:       TypeFcn -> bool
 
-    val arity:		TypeFcn -> int
-    val admitsEquality:	TypeFcn -> bool
+    val arity:          TypeFcn -> int
+    val admitsEquality: TypeFcn -> bool
 
-    val tyvars:		TypeFcn -> TyVarSet
-    val tynames:	TypeFcn -> TyNameSet
-    val normalise:	TypeFcn -> TypeFcn
-    val rename:		TypeFcn -> TypeFcn
+    val tyvars:         TypeFcn -> TyVarSet
+    val tynames:        TypeFcn -> TyNameSet
+    val normalise:      TypeFcn -> TypeFcn
+    val rename:         TypeFcn -> TypeFcn
 
-    val equals:		TypeFcn * TypeFcn -> bool
+    val equals:         TypeFcn * TypeFcn -> bool
 
     exception Apply
-    val apply:		Type list * TypeFcn -> Type	(* may raise Apply *)
+    val apply:          Type list * TypeFcn -> Type     (* may raise Apply *)
 
-    val realise:	Realisation -> TypeFcn -> TypeFcn
+    val realise:        Realisation -> TypeFcn -> TypeFcn
 
-    val makeEquality:	TypeFcn -> unit
+    val makeEquality:   TypeFcn -> unit
 
   end
 (* stop of TYPEFCN.sml *)
@@ -2910,12 +2910,12 @@
 
     (* Type [Section 4.2] *)
 
-    type TypeFcn = Type.TypeFcn				(* [theta] *)
+    type TypeFcn = Type.TypeFcn                         (* [theta] *)
 
 
     (* Operations *)
 
-    val tyvars    = TypeScheme.tyvars		(* same type ;-) *)
+    val tyvars    = TypeScheme.tyvars           (* same type ;-) *)
     val tynames   = TypeScheme.tynames
     val equals    = TypeScheme.equals
     val isClosed  = TypeScheme.isClosed
@@ -2932,39 +2932,39 @@
     (* Equality [Section 4.4] *)
 
     fun admitsEquality (alphas,tau) =
-	let
-	    fun insert(alpha, mu) =
-		TyVarMap.insert(mu, alpha, Type.fromTyVar(TyVar.invent true))
+        let
+            fun insert(alpha, mu) =
+                TyVarMap.insert(mu, alpha, Type.fromTyVar(TyVar.invent true))
 
-	    val mu = List.foldl insert TyVarMap.empty alphas
-	in
-	    Type.admitsEquality(Type.substitute mu tau)
-	end
+            val mu = List.foldl insert TyVarMap.empty alphas
+        in
+            Type.admitsEquality(Type.substitute mu tau)
+        end
     
 
     (* Eta-conversion [Section 4.4] *)
 
     fun fromTyName t =
-	let
-	    val alphas = List.tabulate(TyName.arity t, TyVar.fromIndex false)
-	in
-	    ( alphas, Type.fromConsType(List.map Type.fromTyVar alphas, t) )
-	end
+        let
+            val alphas = List.tabulate(TyName.arity t, TyVar.fromIndex false)
+        in
+            ( alphas, Type.fromConsType(List.map Type.fromTyVar alphas, t) )
+        end
 
     fun toTyName(alphas, ref(Type.ConsType(taus,t))) = t
       | toTyName _ = raise Fail "TypeFcn.toTyName: invalid type function"
 
     fun toTyName(alphas, ref(Type.ConsType(taus,t))) =
-	let
-	    fun isSame(alpha, ref(Type.TyVar alpha')) = alpha = alpha'
-	      | isSame(alpha,            _          ) = false
-	in
-	    if List.length alphas = List.length taus
-	    andalso ListPair.all isSame (alphas, taus) then
-		SOME t
-	    else
-		NONE
-	end
+        let
+            fun isSame(alpha, ref(Type.TyVar alpha')) = alpha = alpha'
+              | isSame(alpha,            _          ) = false
+        in
+            if List.length alphas = List.length taus
+            andalso ListPair.all isSame (alphas, taus) then
+                SOME t
+            else
+                NONE
+        end
 
       | toTyName _ = NONE
 
@@ -2974,13 +2974,13 @@
     exception Apply
 
     fun apply(taus, (alphas,tau)) =
-	if List.length taus <> List.length alphas then raise Apply else
-	let
-	    fun insert(alpha, tau, mu) = TyVarMap.insert(mu, alpha, tau)
-	    val mu = ListPair.foldl insert TyVarMap.empty (alphas, taus)
-	in
-	    Type.substitute mu tau
-	end
+        if List.length taus <> List.length alphas then raise Apply else
+        let
+            fun insert(alpha, tau, mu) = TyVarMap.insert(mu, alpha, tau)
+            val mu = ListPair.foldl insert TyVarMap.empty (alphas, taus)
+        in
+            Type.substitute mu tau
+        end
 
 
     (* Make it an equality type *)
@@ -3002,7 +3002,7 @@
 
     (* Type [Section 4.1] *)
 
-    datatype IdStatus = c | e | v			(* [is] *)
+    datatype IdStatus = c | e | v                       (* [is] *)
 
 
     (* Operations *)
@@ -3024,7 +3024,7 @@
 
     (* Type [Section 4.1] *)
 
-    datatype IdStatus = c | e | v			(* [is] *)
+    datatype IdStatus = c | e | v                       (* [is] *)
 
 
     (* Generalisation [Section 5.5] *)
@@ -3069,7 +3069,7 @@
     (* Export types [Section 4.2 and 6.3] *)
 
     datatype ('a,'b) Str' = Str of (*Env*)
-			    ('a,'b) Str' StrIdMap * 'b TyConMap * 'a VIdMap
+                            ('a,'b) Str' StrIdMap * 'b TyConMap * 'a VIdMap
 
     type 'a ValEnv'       = 'a VIdMap
     type 'b TyEnv'        = 'b TyConMap
@@ -3080,27 +3080,27 @@
 
     (* Operations *)
 
-    val empty:		('a,'b) Env'
+    val empty:          ('a,'b) Env'
 
-    val fromSE:		('a,'b) StrEnv'		-> ('a,'b) Env'
-    val fromTE:		'b TyEnv'		-> ('a,'b) Env'
-    val fromVE:		'a ValEnv'		-> ('a,'b) Env'
-    val fromVEandTE:	'a ValEnv' * 'b TyEnv'	-> ('a,'b) Env'
+    val fromSE:         ('a,'b) StrEnv'         -> ('a,'b) Env'
+    val fromTE:         'b TyEnv'               -> ('a,'b) Env'
+    val fromVE:         'a ValEnv'              -> ('a,'b) Env'
+    val fromVEandTE:    'a ValEnv' * 'b TyEnv'  -> ('a,'b) Env'
 
-    val plus:		('a,'b) Env' * ('a,'b) Env'    -> ('a,'b) Env'
-    val plusVE:		('a,'b) Env' * 'a ValEnv'      -> ('a,'b) Env'
-    val plusTE:		('a,'b) Env' * 'b TyEnv'       -> ('a,'b) Env'
-    val plusSE:		('a,'b) Env' * ('a,'b) StrEnv' -> ('a,'b) Env'
-    val plusVEandTE:	('a,'b) Env' * ('a ValEnv' * 'b TyEnv') -> ('a,'b) Env'
+    val plus:           ('a,'b) Env' * ('a,'b) Env'    -> ('a,'b) Env'
+    val plusVE:         ('a,'b) Env' * 'a ValEnv'      -> ('a,'b) Env'
+    val plusTE:         ('a,'b) Env' * 'b TyEnv'       -> ('a,'b) Env'
+    val plusSE:         ('a,'b) Env' * ('a,'b) StrEnv' -> ('a,'b) Env'
+    val plusVEandTE:    ('a,'b) Env' * ('a ValEnv' * 'b TyEnv') -> ('a,'b) Env'
 
-    val findVId:	('a,'b) Env' * VId       -> 'a option
-    val findTyCon:	('a,'b) Env' * TyCon     -> 'b option
-    val findStrId:	('a,'b) Env' * StrId     -> ('a,'b) Str' option
-    val findLongVId:	('a,'b) Env' * longVId   -> 'a option
-    val findLongTyCon:	('a,'b) Env' * longTyCon -> 'b option
-    val findLongStrId:	('a,'b) Env' * longStrId -> ('a,'b) Str' option
+    val findVId:        ('a,'b) Env' * VId       -> 'a option
+    val findTyCon:      ('a,'b) Env' * TyCon     -> 'b option
+    val findStrId:      ('a,'b) Env' * StrId     -> ('a,'b) Str' option
+    val findLongVId:    ('a,'b) Env' * longVId   -> 'a option
+    val findLongTyCon:  ('a,'b) Env' * longTyCon -> 'b option
+    val findLongStrId:  ('a,'b) Env' * longStrId -> ('a,'b) Str' option
 
-    val disjoint:	('a,'b) Env' * ('a,'b) Env' -> bool
+    val disjoint:       ('a,'b) Env' * ('a,'b) Env' -> bool
 
   end
 (* stop of GENERIC_ENV.sml *)
@@ -3140,11 +3140,11 @@
     (* Export types [Section 4.2 and 6.3] *)
 
     datatype ('a,'b) Str' = Str of (*Env*)
-			   ('a,'b) Str' StrIdMap * 'b TyConMap * 'a VIdMap
+                           ('a,'b) Str' StrIdMap * 'b TyConMap * 'a VIdMap
 
-    type 'a ValEnv'       = 'a VIdMap				(* [VE] *)
-    type 'b TyEnv'        = 'b TyConMap				(* [TE] *)
-    type ('a,'b) StrEnv'  = ('a,'b) Str' StrIdMap		(* [SE] *)
+    type 'a ValEnv'       = 'a VIdMap                           (* [VE] *)
+    type 'b TyEnv'        = 'b TyConMap                         (* [TE] *)
+    type ('a,'b) StrEnv'  = ('a,'b) Str' StrIdMap               (* [SE] *)
 
     type ('a,'b) Env'     = ('a,'b) StrEnv' * 'b TyEnv' * 'a ValEnv' (* [E] *)
 
@@ -3164,19 +3164,19 @@
     infix plus plusVE plusTE plusSE plusVEandTE
 
     fun (SE,TE,VE) plus (SE',TE',VE') =
-	( StrIdMap.unionWith #2 (SE,SE')
-	, TyConMap.unionWith #2 (TE,TE')
-	, VIdMap.unionWith   #2 (VE,VE')
-	)
+        ( StrIdMap.unionWith #2 (SE,SE')
+        , TyConMap.unionWith #2 (TE,TE')
+        , VIdMap.unionWith   #2 (VE,VE')
+        )
 
     fun (SE,TE,VE) plusVE VE' = ( SE, TE, VIdMap.unionWith #2 (VE,VE') )
     fun (SE,TE,VE) plusTE TE' = ( SE, TyConMap.unionWith #2 (TE,TE'), VE )
     fun (SE,TE,VE) plusSE SE' = ( StrIdMap.unionWith #2 (SE,SE'), TE, VE )
     fun (SE,TE,VE) plusVEandTE (VE',TE') =
-	( SE
-	, TyConMap.unionWith #2 (TE,TE')
-	, VIdMap.unionWith   #2 (VE,VE')
-	)
+        ( SE
+        , TyConMap.unionWith #2 (TE,TE')
+        , VIdMap.unionWith   #2 (VE,VE')
+        )
 
 
     (* Application (lookup) [Section 4.3] *)
@@ -3187,15 +3187,15 @@
 
     fun findLongX'(E, findX,      [],       x) = findX(E, x)
       | findLongX'(E, findX, strid::strids, x) =
-	    Option.mapPartial (fn E => findLongX'(E, findX, strids, x))
-			      (Option.map (fn Str E => E) (findStrId(E, strid)))
+            Option.mapPartial (fn E => findLongX'(E, findX, strids, x))
+                              (Option.map (fn Str E => E) (findStrId(E, strid)))
 
     fun findLongX (explodeLongX, findX) (E, longX) =
-	let
-	    val (strids,x) = explodeLongX longX
-	in
-	    findLongX'(E, findX, strids, x)
-	end
+        let
+            val (strids,x) = explodeLongX longX
+        in
+            findLongX'(E, findX, strids, x)
+        end
 
     fun findLongVId   x = findLongX (LongVId.explode,   findVId) x
     fun findLongTyCon x = findLongX (LongTyCon.explode, findTyCon) x
@@ -3205,9 +3205,9 @@
     (* Disjointness *)
 
     fun disjoint((SE1,TE1,VE1), (SE2,TE2,VE2)) =
-	    StrIdMap.disjoint(SE1,SE2) andalso
-	    TyConMap.disjoint(TE1,TE2) andalso
-	    VIdMap.disjoint(VE1,VE2)
+            StrIdMap.disjoint(SE1,SE2) andalso
+            TyConMap.disjoint(TE1,TE2) andalso
+            VIdMap.disjoint(VE1,VE2)
 
   end
 (* stop of GenericEnvFn.sml *)
@@ -3243,36 +3243,36 @@
     (* Export types [Section 4.2] *)
 
     type ValStr = TypeScheme * IdStatus
-    type ValEnv = ValStr VIdMap					(* [VE] *)
+    type ValEnv = ValStr VIdMap                                 (* [VE] *)
 
     type TyStr  = TypeFcn * ValEnv
-    type TyEnv  = TyStr TyConMap				(* [TE] *)
+    type TyEnv  = TyStr TyConMap                                (* [TE] *)
 
     type Str    = (ValStr, TyStr) Str'
-    type StrEnv = Str StrIdMap					(* [SE] *)
+    type StrEnv = Str StrIdMap                                  (* [SE] *)
  
-    type Env    = StrEnv * TyEnv * ValEnv			(* [E] *)
+    type Env    = StrEnv * TyEnv * ValEnv                       (* [E] *)
 
 
     (* Operations *)
 
-    val tyvarsVE:		ValEnv -> TyVarSet
-    val tyvars:			Env    -> TyVarSet
-    val tynamesTE:		TyEnv  -> TyNameSet
-    val tynamesSE:		StrEnv -> TyNameSet
-    val tynames:		Env    -> TyNameSet
+    val tyvarsVE:               ValEnv -> TyVarSet
+    val tyvars:                 Env    -> TyVarSet
+    val tynamesTE:              TyEnv  -> TyNameSet
+    val tynamesSE:              StrEnv -> TyNameSet
+    val tynames:                Env    -> TyNameSet
 
-    val isWellFormed:		Env -> bool
+    val isWellFormed:           Env -> bool
 
-    val Clos:			ValEnv -> ValEnv
-    val containsFlexibleType:	ValEnv -> bool
-    val defaultOverloaded:	ValEnv -> unit
-    val makeEquality:		TyEnv  -> unit
-    val maximiseEquality:	TyEnv * ValEnv -> TyEnv * ValEnv
-    val Abs:			TyEnv * Env -> Env
-    val realise:		Realisation -> Env -> Env
+    val Clos:                   ValEnv -> ValEnv
+    val containsFlexibleType:   ValEnv -> bool
+    val defaultOverloaded:      ValEnv -> unit
+    val makeEquality:           TyEnv  -> unit
+    val maximiseEquality:       TyEnv * ValEnv -> TyEnv * ValEnv
+    val Abs:                    TyEnv * Env -> Env
+    val realise:                Realisation -> Env -> Env
 
-    val enriches:		Env * Env -> bool
+    val enriches:               Env * Env -> bool
 
   end
 (* stop of STATIC_ENV.sml *)
@@ -3310,15 +3310,15 @@
     (* Export types [Section 4.2] *)
 
     type ValStr = TypeScheme * IdStatus
-    type ValEnv = ValStr VIdMap					(* [VE] *)
+    type ValEnv = ValStr VIdMap                                 (* [VE] *)
 
     type TyStr  = TypeFcn * ValEnv
-    type TyEnv  = TyStr TyConMap				(* [TE] *)
+    type TyEnv  = TyStr TyConMap                                (* [TE] *)
 
     type Str    = (ValStr, TyStr) Str'
-    type StrEnv = Str StrIdMap					(* [SE] *)
+    type StrEnv = Str StrIdMap                                  (* [SE] *)
  
-    type Env    = StrEnv * TyEnv * ValEnv			(* [E] *)
+    type Env    = StrEnv * TyEnv * ValEnv                       (* [E] *)
 
 
     (* Further modifications [Section 4.3] *)
@@ -3331,97 +3331,97 @@
     (* Type variable and type name set [Section 4.2] *)
 
     fun tyvarsVE VE =
-	VIdMap.foldl
-	    (fn((sigma,is), U) => TyVarSet.union(U, TypeScheme.tyvars sigma))
-	    TyVarSet.empty VE
+        VIdMap.foldl
+            (fn((sigma,is), U) => TyVarSet.union(U, TypeScheme.tyvars sigma))
+            TyVarSet.empty VE
 
     fun tyvarsTE TE =
-	TyConMap.foldl
-	    (fn((theta,VE), U) => TyVarSet.union(TyVarSet.union
-				(U, TypeFcn.tyvars theta), tyvarsVE VE))
-	    TyVarSet.empty TE
+        TyConMap.foldl
+            (fn((theta,VE), U) => TyVarSet.union(TyVarSet.union
+                                (U, TypeFcn.tyvars theta), tyvarsVE VE))
+            TyVarSet.empty TE
 
     fun tyvarsSE SE =
-	StrIdMap.foldl
-	    (fn(Str E, U) => TyVarSet.union(U, tyvars E))
-	    TyVarSet.empty SE
+        StrIdMap.foldl
+            (fn(Str E, U) => TyVarSet.union(U, tyvars E))
+            TyVarSet.empty SE
 
     and tyvars (SE,TE,VE) =
-	TyVarSet.union(TyVarSet.union(tyvarsSE SE, tyvarsTE TE), tyvarsVE VE)
+        TyVarSet.union(TyVarSet.union(tyvarsSE SE, tyvarsTE TE), tyvarsVE VE)
 
 
     fun tynamesVE VE =
-	VIdMap.foldl
-	    (fn((sigma,is), T) => TyNameSet.union(T, TypeScheme.tynames sigma))
-	    TyNameSet.empty VE
+        VIdMap.foldl
+            (fn((sigma,is), T) => TyNameSet.union(T, TypeScheme.tynames sigma))
+            TyNameSet.empty VE
 
     fun tynamesTE TE =
-	TyConMap.foldl
-	    (fn((theta,VE), T) => TyNameSet.union(TyNameSet.union
-				(T, TypeFcn.tynames theta), tynamesVE VE))
-	    TyNameSet.empty TE
+        TyConMap.foldl
+            (fn((theta,VE), T) => TyNameSet.union(TyNameSet.union
+                                (T, TypeFcn.tynames theta), tynamesVE VE))
+            TyNameSet.empty TE
 
     fun tynamesSE SE =
-	StrIdMap.foldl
-	    (fn(Str E, T) => TyNameSet.union(T, tynames E))
-	    TyNameSet.empty SE
+        StrIdMap.foldl
+            (fn(Str E, T) => TyNameSet.union(T, tynames E))
+            TyNameSet.empty SE
 
     and tynames (SE,TE,VE) =
-	TyNameSet.union(TyNameSet.union(tynamesSE SE, tynamesTE TE),
-					tynamesVE VE)
+        TyNameSet.union(TyNameSet.union(tynamesSE SE, tynamesTE TE),
+                                        tynamesVE VE)
 
 
     (* Well-formedness [Section 4.9] *)
 
     fun isWellFormedTyStr (theta,VE) =
-	VIdMap.isEmpty VE orelse isSome(TypeFcn.toTyName theta)
+        VIdMap.isEmpty VE orelse isSome(TypeFcn.toTyName theta)
 
     fun isWellFormedTE TE =
-	TyConMap.all isWellFormedTyStr TE
+        TyConMap.all isWellFormedTyStr TE
 
     fun isWellFormedSE SE =
-	StrIdMap.all (fn Str E => isWellFormed E) SE
+        StrIdMap.all (fn Str E => isWellFormed E) SE
 
     and isWellFormed (SE,TE,VE) =
-	isWellFormedTE TE andalso isWellFormedSE SE
+        isWellFormedTE TE andalso isWellFormedSE SE
 
 
 
     (* Closure [Section 4.8] *)
 
     fun Clos VE =
-	    VIdMap.map (fn((_,tau), is) => (TypeScheme.Clos tau, is)) VE
+            VIdMap.map (fn((_,tau), is) => (TypeScheme.Clos tau, is)) VE
 
 
     (* Check for unresolved flexible record types [Section 4.11, item 1] *)
 
     fun containsFlexibleType VE =
-	    VIdMap.exists (fn((_,tau), is) => Type.isFlexible tau) VE
+            VIdMap.exists (fn((_,tau), is) => Type.isFlexible tau) VE
 
 
     (* Assign default types to overloaded types [Appendix E] *)
 
     fun defaultOverloaded VE =
-	    VIdMap.app (fn((_,tau), is) => Type.defaultOverloaded tau) VE
+            VIdMap.app (fn((_,tau), is) => Type.defaultOverloaded tau) VE
 
 
     (* Realisation [Section 5.2] *)
 
     fun realiseVE phi VE =
-	VIdMap.map (fn(sigma,is) => ( TypeScheme.realise phi sigma, is )) VE
+        VIdMap.map (fn(sigma,is) => ( TypeScheme.realise phi sigma, is )) VE
 
     and realiseTE phi TE =
-	TyConMap.map (fn(theta,VE) => ( TypeFcn.realise phi theta
-				      , realiseVE phi VE
-				      )) TE
+        TyConMap.map (fn(theta,VE) => ( TypeFcn.realise phi theta
+                                      , realiseVE phi VE
+                                      )) TE
     and realiseSE phi SE =
-	StrIdMap.map (fn(Str E) => Str(realise phi E)) SE
+        StrIdMap.map (fn(Str E) => Str(realise phi E)) SE
 
     and realise phi (SE,TE,VE) =
-	( realiseSE phi SE
-	, realiseTE phi TE
-	, realiseVE phi VE
-	)
+        ( realiseSE phi SE
+        , realiseTE phi TE
+        , realiseVE phi VE
+        )
 
 
     (* Make all type names bound in a type environment equality types *)
@@ -3429,7 +3429,7 @@
     (* Assumes abstract types, i.e. no constructors. *)
 
     fun makeEquality TE =
-	TyConMap.app (fn(theta,VE) => TypeFcn.makeEquality theta) TE
+        TyConMap.app (fn(theta,VE) => TypeFcn.makeEquality theta) TE
 
 
 
@@ -3440,37 +3440,37 @@
     fun admitsEqualityValStr ((_,tau),_) = Type.admitsEquality tau
 
     fun maximiseEquality(TE,VE) =
-	let
-	    fun checkTyStr((theta,VE), (phi,changed)) = 
-		let
-		    val t = valOf(TypeFcn.toTyName theta)
-		in
-		    if TyName.equality t = TyName.EQ
-		    andalso not(VIdMap.all admitsEqualityValStr VE) then
-			( TyNameMap.insert(phi,
-					   t,
-					   TypeFcn.fromTyName
-						(TyName.removeEquality t)
-					  )
-			, true
-			)
-		    else
-			( phi, changed )
-		end
+        let
+            fun checkTyStr((theta,VE), (phi,changed)) = 
+                let
+                    val t = valOf(TypeFcn.toTyName theta)
+                in
+                    if TyName.equality t = TyName.EQ
+                    andalso not(VIdMap.all admitsEqualityValStr VE) then
+                        ( TyNameMap.insert(phi,
+                                           t,
+                                           TypeFcn.fromTyName
+                                                (TyName.removeEquality t)
+                                          )
+                        , true
+                        )
+                    else
+                        ( phi, changed )
+                end
 
-	    fun checkTE(TE, phi) =
-		let
-		    val (phi',change) = TyConMap.foldl checkTyStr (phi,false) TE
-		    val TE'           = realiseTE phi' TE
-		in
-		    if change then checkTE(TE', phi')
-			      else (TE', phi')
-		end
+            fun checkTE(TE, phi) =
+                let
+                    val (phi',change) = TyConMap.foldl checkTyStr (phi,false) TE
+                    val TE'           = realiseTE phi' TE
+                in
+                    if change then checkTE(TE', phi')
+                              else (TE', phi')
+                end
 
-	    val (TE',phi) = checkTE(TE, TyNameMap.empty)
-	in
-	    ( TE', realiseVE phi VE )
-	end
+            val (TE',phi) = checkTE(TE, TyNameMap.empty)
+        in
+            ( TE', realiseVE phi VE )
+        end
 
 
 
@@ -3479,78 +3479,78 @@
     fun AbsTE(TE) = TyConMap.map (fn(theta,_) => (theta,VIdMap.empty)) TE
 
     fun Abs(TE,E) =
-	let
-	    val ts  = tynamesTE TE
-	    val phi = TyNameSet.foldl
-			(fn(t,phi) => TyNameMap.insert(phi, t,
-					TypeFcn.fromTyName(TyName.Abs t)))
-			TyNameMap.empty ts
-	in
-	    realise phi (AbsTE(TE) TEplus E)
-	end
+        let
+            val ts  = tynamesTE TE
+            val phi = TyNameSet.foldl
+                        (fn(t,phi) => TyNameMap.insert(phi, t,
+                                        TypeFcn.fromTyName(TyName.Abs t)))
+                        TyNameMap.empty ts
+        in
+            realise phi (AbsTE(TE) TEplus E)
+        end
 
 
     (* Disjointness *)
 
     fun disjoint((SE1,TE1,VE1), (SE2,TE2,VE2)) =
-	    StrIdMap.disjoint(SE1,SE2) andalso
-	    TyConMap.disjoint(TE1,TE2) andalso
-	    VIdMap.disjoint(VE1,VE2)
+            StrIdMap.disjoint(SE1,SE2) andalso
+            TyConMap.disjoint(TE1,TE2) andalso
+            VIdMap.disjoint(VE1,VE2)
 
 
     (* Enrichment [Section 5.5] *)
 
     fun equalsVE(VE1,VE2) =
-	VIdMap.numItems VE1 = VIdMap.numItems VE2 andalso
-	VIdMap.alli
-	    (fn(vid, (sigma1,is1)) =>
-		case VIdMap.find(VE2, vid)
-		  of NONE             => false
-		   | SOME(sigma2,is2) =>
-			TypeScheme.equals(sigma1,sigma2) andalso is1 = is2
-	    )
-	    VE1
+        VIdMap.numItems VE1 = VIdMap.numItems VE2 andalso
+        VIdMap.alli
+            (fn(vid, (sigma1,is1)) =>
+                case VIdMap.find(VE2, vid)
+                  of NONE             => false
+                   | SOME(sigma2,is2) =>
+                        TypeScheme.equals(sigma1,sigma2) andalso is1 = is2
+            )
+            VE1
 
 
     fun enriches((SE1,TE1,VE1), (SE2,TE2,VE2)) =
-	    enrichesSE(SE1,SE2) andalso
-	    enrichesTE(TE1,TE2) andalso
-	    enrichesVE(VE1,VE2)
+            enrichesSE(SE1,SE2) andalso
+            enrichesTE(TE1,TE2) andalso
+            enrichesVE(VE1,VE2)
 
     and enrichesSE(SE1,SE2) =
-	StrIdMap.alli
-	    (fn(strid, Str E2) =>
-		case StrIdMap.find(SE1, strid)
-		  of NONE         => false
-		   | SOME(Str E1) => enriches(E1,E2)
-	    )
-	    SE2
+        StrIdMap.alli
+            (fn(strid, Str E2) =>
+                case StrIdMap.find(SE1, strid)
+                  of NONE         => false
+                   | SOME(Str E1) => enriches(E1,E2)
+            )
+            SE2
 
     and enrichesTE(TE1,TE2) =
-	TyConMap.alli
-	    (fn(tycon, tystr2) =>
-		case TyConMap.find(TE1, tycon)
-		  of NONE        => false
-		   | SOME tystr1 => enrichesTyStr(tystr1,tystr2)
-	    )
-	    TE2
+        TyConMap.alli
+            (fn(tycon, tystr2) =>
+                case TyConMap.find(TE1, tycon)
+                  of NONE        => false
+                   | SOME tystr1 => enrichesTyStr(tystr1,tystr2)
+            )
+            TE2
 
     and enrichesVE(VE1,VE2) =
-	VIdMap.alli
-	    (fn(vid, valstr2) =>
-		case VIdMap.find(VE1, vid)
-		  of NONE         => false
-		   | SOME valstr1 => enrichesValStr(valstr1,valstr2)
-	    )
-	    VE2
+        VIdMap.alli
+            (fn(vid, valstr2) =>
+                case VIdMap.find(VE1, vid)
+                  of NONE         => false
+                   | SOME valstr1 => enrichesValStr(valstr1,valstr2)
+            )
+            VE2
 
     and enrichesTyStr((theta1,VE1), (theta2,VE2)) =
-	    TypeFcn.equals(theta1,theta2) andalso
-	    ( VIdMap.isEmpty VE2 orelse equalsVE(VE1,VE2) )
+            TypeFcn.equals(theta1,theta2) andalso
+            ( VIdMap.isEmpty VE2 orelse equalsVE(VE1,VE2) )
 
     and enrichesValStr((sigma1,is1), (sigma2,is2)) =
-	    TypeScheme.generalises(sigma1,sigma2) andalso
-	    IdStatus.generalises(is1,is2)
+            TypeScheme.generalises(sigma1,sigma2) andalso
+            IdStatus.generalises(is1,is2)
 
   end
 (* stop of StaticEnv.sml *)
@@ -3575,18 +3575,18 @@
 
     (* Type [Section 5.1] *)
 
-    type Sig = TyNameSet * Env				(* [Sigma] *)
+    type Sig = TyNameSet * Env                          (* [Sigma] *)
 
 
     (* Operations *)
 
-    val tyvars:		Sig -> TyVarSet
-    val tynames:	Sig -> TyNameSet
+    val tyvars:         Sig -> TyVarSet
+    val tynames:        Sig -> TyNameSet
 
-    val rename:		Sig -> Sig
+    val rename:         Sig -> Sig
 
     exception Match
-    val match:		Env * Sig -> Env * Realisation (* Matching *)
+    val match:          Env * Sig -> Env * Realisation (* Matching *)
 
   end
 (* stop of SIG.sml *)
@@ -3611,7 +3611,7 @@
 
     (* Type [Section 5.1] *)
 
-    type Sig = TyNameSet * Env				(* [Sigma] *)
+    type Sig = TyNameSet * Env                          (* [Sigma] *)
 
 
     (* Type variable and type name extraction [Section 4.2] *)
@@ -3623,16 +3623,16 @@
     (* Alpha Renaming *)
 
     fun rename (T,E) =
-	let
-	    val phi' = TyNameSet.foldl
-			 (fn(t,phi')=> TyNameMap.insert(phi',t,TyName.rename t))
-			 TyNameMap.empty T
-	    val phi = TyNameMap.map TypeFcn.fromTyName phi'
-	    val T'  = TyNameSet.map (fn t => valOf(TyNameMap.find(phi',t))) T
-	    val E'  = StaticEnv.realise phi E
-	in
-	    (T',E')
-	end
+        let
+            val phi' = TyNameSet.foldl
+                         (fn(t,phi')=> TyNameMap.insert(phi',t,TyName.rename t))
+                         TyNameMap.empty T
+            val phi = TyNameMap.map TypeFcn.fromTyName phi'
+            val T'  = TyNameSet.map (fn t => valOf(TyNameMap.find(phi',t))) T
+            val E'  = StaticEnv.realise phi E
+        in
+            (T',E')
+        end
 
 
     (* Matching [Section 5.6] *)
@@ -3640,60 +3640,60 @@
     exception Match
 
     fun matchTypeFcn(theta', theta, phi, T) =
-	if TypeFcn.arity theta <> TypeFcn.arity theta' then
-	    raise Match
-	else
-	case TypeFcn.toTyName theta
-	  of NONE   => phi
-	   | SOME t =>
-		if isSome(TyNameMap.find(phi, t))
-		orelse not(TyNameSet.member(T, t)) then
-		    phi
-		else
-		let
-		    val phi' = TyNameMap.insert(phi, t, TypeFcn.rename theta')
-		in
-		    TyNameMap.map (TypeFcn.realise phi') phi'
-		end
+        if TypeFcn.arity theta <> TypeFcn.arity theta' then
+            raise Match
+        else
+        case TypeFcn.toTyName theta
+          of NONE   => phi
+           | SOME t =>
+                if isSome(TyNameMap.find(phi, t))
+                orelse not(TyNameSet.member(T, t)) then
+                    phi
+                else
+                let
+                    val phi' = TyNameMap.insert(phi, t, TypeFcn.rename theta')
+                in
+                    TyNameMap.map (TypeFcn.realise phi') phi'
+                end
 
     fun matchTE(TE', TE, phi, T) =
-	let
-	    fun matchTyStr(tycon, (theta,VE), phi) =
-		case TyConMap.find(TE', tycon)
-		  of NONE             => raise Match
-		   | SOME(theta',VE') => matchTypeFcn(theta', theta, phi, T)
-	in
-	    TyConMap.foldli matchTyStr phi TE
-	end
+        let
+            fun matchTyStr(tycon, (theta,VE), phi) =
+                case TyConMap.find(TE', tycon)
+                  of NONE             => raise Match
+                   | SOME(theta',VE') => matchTypeFcn(theta', theta, phi, T)
+        in
+            TyConMap.foldli matchTyStr phi TE
+        end
 
     fun matchSE(SE', SE, phi, T) =
-	let
-	    fun matchStr(strid, StaticEnv.Str E, phi) =
-		case StrIdMap.find(SE', strid)
-		  of NONE                   => raise Match
-		   | SOME(StaticEnv.Str E') => matchE(E', E, phi, T)
-	in
-	    StrIdMap.foldli matchStr phi SE
-	end
+        let
+            fun matchStr(strid, StaticEnv.Str E, phi) =
+                case StrIdMap.find(SE', strid)
+                  of NONE                   => raise Match
+                   | SOME(StaticEnv.Str E') => matchE(E', E, phi, T)
+        in
+            StrIdMap.foldli matchStr phi SE
+        end
 
     and matchE((SE',TE',VE'), (SE,TE,VE), phi, T) =
-	let
-	    val phi1 = matchTE(TE', TE, phi, T)
-	    val phi2 = matchSE(SE', SE, phi1, T)
-	in
-	    phi2
-	end
+        let
+            val phi1 = matchTE(TE', TE, phi, T)
+            val phi2 = matchSE(SE', SE, phi1, T)
+        in
+            phi2
+        end
 
     fun match(E', (T,E)) =
-	let
-	    val phi = matchE(E', E, TyNameMap.empty, T)
-	    val E'' = StaticEnv.realise phi E
-	in
-	    if StaticEnv.enriches(E',E'') then
-		(E'', phi)
-	    else
-		raise Match
-	end
+        let
+            val phi = matchE(E', E, TyNameMap.empty, T)
+            val E'' = StaticEnv.realise phi E
+        in
+            if StaticEnv.enriches(E',E'') then
+                (E'', phi)
+            else
+                raise Match
+        end
 
   end
 (* stop of Sig.sml *)
@@ -3718,13 +3718,13 @@
 
     (* Type [Section 5.1] *)
 
-    type FunSig = TyNameSet * (Env * Sig)		(* [Phi] *)
+    type FunSig = TyNameSet * (Env * Sig)               (* [Phi] *)
 
 
     (* Operations *)
 
-    val tyvars:		FunSig -> TyVarSet
-    val tynames:	FunSig -> TyNameSet
+    val tyvars:         FunSig -> TyVarSet
+    val tynames:        FunSig -> TyNameSet
 
   end
 (* stop of FUNSIG.sml *)
@@ -3749,17 +3749,17 @@
 
     (* Type [Section 5.1] *)
 
-    type FunSig = TyNameSet * (Env * Sig)		(* [Phi] *)
+    type FunSig = TyNameSet * (Env * Sig)               (* [Phi] *)
 
 
     (* Type variable and type name extraction [Section 4.2] *)
 
     fun tyvars (T,(E,Sigma)) =
-	TyVarSet.union(StaticEnv.tyvars E, Sig.tyvars Sigma)
+        TyVarSet.union(StaticEnv.tyvars E, Sig.tyvars Sigma)
 
     fun tynames (T,(E,Sigma)) =
-	TyNameSet.difference(TyNameSet.union(StaticEnv.tynames E,
-					     Sig.tynames Sigma), T)
+        TyNameSet.difference(TyNameSet.union(StaticEnv.tynames E,
+                                             Sig.tynames Sigma), T)
 
   end
 (* stop of FunSig.sml *)
@@ -3798,29 +3798,29 @@
 
     (* Type [Section 4.2] *)
 
-    type Context = TyNameSet * TyVarSet * Env		(* [C] *)
+    type Context = TyNameSet * TyVarSet * Env           (* [C] *)
 
 
     (* Operations *)
 
-    val Tof:		Context -> TyNameSet
-    val Uof:		Context -> TyVarSet
-    val Eof:		Context -> Env
+    val Tof:            Context -> TyNameSet
+    val Uof:            Context -> TyVarSet
+    val Eof:            Context -> Env
 
-    val plusVE:		Context * ValEnv   -> Context
-    val plusU:		Context * TyVarSet -> Context
-    val oplusE:		Context * Env      -> Context
-    val oplusTE:	Context * TyEnv    -> Context
-    val oplusVEandTE:	Context * (ValEnv * TyEnv) -> Context
+    val plusVE:         Context * ValEnv   -> Context
+    val plusU:          Context * TyVarSet -> Context
+    val oplusE:         Context * Env      -> Context
+    val oplusTE:        Context * TyEnv    -> Context
+    val oplusVEandTE:   Context * (ValEnv * TyEnv) -> Context
 
-    val findVId:	Context * VId       -> ValStr option
-    val findTyCon:	Context * TyCon     -> TyStr option
-    val findStrId:	Context * StrId     -> Str option
-    val findLongVId:	Context * longVId   -> ValStr option
-    val findLongTyCon:	Context * longTyCon -> TyStr option
-    val findLongStrId:	Context * longStrId -> Str option
+    val findVId:        Context * VId       -> ValStr option
+    val findTyCon:      Context * TyCon     -> TyStr option
+    val findStrId:      Context * StrId     -> Str option
+    val findLongVId:    Context * longVId   -> ValStr option
+    val findLongTyCon:  Context * longTyCon -> TyStr option
+    val findLongStrId:  Context * longStrId -> Str option
 
-    val tyvars:		Context -> TyVarSet
+    val tyvars:         Context -> TyVarSet
 
   end
 (* stop of CONTEXT.sml *)
@@ -3859,7 +3859,7 @@
 
     (* Type [Section 4.2] *)
 
-    type Context = TyNameSet * TyVarSet * Env		(* [C] *)
+    type Context = TyNameSet * TyVarSet * Env           (* [C] *)
 
 
     (* Projections [Section 4.3] *)
@@ -3877,22 +3877,22 @@
     fun (T,U,E) plusU  U' = ( T, TyVarSet.union(U,U'), E )
 
     fun (T,U,E) oplusE E' =
-	( TyNameSet.union(T, StaticEnv.tynames E)
-	, U
-	, StaticEnv.plus(E,E')
-	)
+        ( TyNameSet.union(T, StaticEnv.tynames E)
+        , U
+        , StaticEnv.plus(E,E')
+        )
 
     fun (T,U,E) oplusTE TE =
-	( TyNameSet.union(T, StaticEnv.tynamesTE TE)
-	, U
-	, StaticEnv.plusTE(E,TE)
-	)
+        ( TyNameSet.union(T, StaticEnv.tynamesTE TE)
+        , U
+        , StaticEnv.plusTE(E,TE)
+        )
 
     fun (T,U,E) oplusVEandTE (VE,TE) =
-	( TyNameSet.union(T, StaticEnv.tynamesTE TE)
-	, U
-	, StaticEnv.plusVEandTE(E, (VE,TE))
-	)
+        ( TyNameSet.union(T, StaticEnv.tynamesTE TE)
+        , U
+        , StaticEnv.plusVEandTE(E, (VE,TE))
+        )
 
 
     (* Application (lookup) [Section 4.3] *)
@@ -3944,38 +3944,38 @@
 
     (* Types [Section 5.1] *)
 
-    type SigEnv = Sig SigIdMap					(* [G] *)
-    type FunEnv = FunSig FunIdMap				(* [F] *)
+    type SigEnv = Sig SigIdMap                                  (* [G] *)
+    type FunEnv = FunSig FunIdMap                               (* [F] *)
 
-    type Basis  = TyNameSet * FunEnv * SigEnv * Env		(* [B] *)
+    type Basis  = TyNameSet * FunEnv * SigEnv * Env             (* [B] *)
 
 
     (* Operations *)
 
-    val empty:		Basis
-    val fromTandE:	TyNameSet * Env    -> Basis
-    val fromTandF:	TyNameSet * FunEnv -> Basis
-    val fromTandG:	TyNameSet * SigEnv -> Basis
+    val empty:          Basis
+    val fromTandE:      TyNameSet * Env    -> Basis
+    val fromTandF:      TyNameSet * FunEnv -> Basis
+    val fromTandG:      TyNameSet * SigEnv -> Basis
 
-    val Tof:		Basis -> TyNameSet
-    val Cof:		Basis -> Context
+    val Tof:            Basis -> TyNameSet
+    val Cof:            Basis -> Context
 
-    val plus:		Basis * Basis     -> Basis
-    val plusT:		Basis * TyNameSet -> Basis
-    val oplusSE:	Basis * StrEnv    -> Basis
-    val oplusG:		Basis * SigEnv    -> Basis
-    val oplusF:		Basis * FunEnv    -> Basis
-    val oplusE:		Basis * Env       -> Basis
+    val plus:           Basis * Basis     -> Basis
+    val plusT:          Basis * TyNameSet -> Basis
+    val oplusSE:        Basis * StrEnv    -> Basis
+    val oplusG:         Basis * SigEnv    -> Basis
+    val oplusF:         Basis * FunEnv    -> Basis
+    val oplusE:         Basis * Env       -> Basis
 
-    val findStrId:	Basis * StrId     -> Str option
-    val findSigId:	Basis * SigId     -> Sig option
-    val findFunId:	Basis * FunId     -> FunSig option
-    val findLongStrId:	Basis * longStrId -> Str option
-    val findLongTyCon:	Basis * longTyCon -> TyStr option
+    val findStrId:      Basis * StrId     -> Str option
+    val findSigId:      Basis * SigId     -> Sig option
+    val findFunId:      Basis * FunId     -> FunSig option
+    val findLongStrId:  Basis * longStrId -> Str option
+    val findLongTyCon:  Basis * longTyCon -> TyStr option
 
     val tyvars:         Basis  -> TyVarSet
-    val tynamesF:	FunEnv -> TyNameSet
-    val tynamesG:	SigEnv -> TyNameSet
+    val tynamesF:       FunEnv -> TyNameSet
+    val tynamesG:       SigEnv -> TyNameSet
  
   end
 (* stop of STATIC_BASIS.sml *)
@@ -4011,46 +4011,46 @@
 
     (* Types [Section 5.1] *)
 
-    type SigEnv = Sig SigIdMap					(* [G] *)
-    type FunEnv = FunSig FunIdMap				(* [F] *)
+    type SigEnv = Sig SigIdMap                                  (* [G] *)
+    type FunEnv = FunSig FunIdMap                               (* [F] *)
 
-    type Basis  = TyNameSet * FunEnv * SigEnv * Env		(* [B] *)
+    type Basis  = TyNameSet * FunEnv * SigEnv * Env             (* [B] *)
 
 
 
     (* Calculation of type variable and type name sets [Section 4.2] *)
 
     fun tyvarsG G =
-	SigIdMap.foldl
-	    (fn(Sigma, U) => TyVarSet.union(U, Sig.tyvars Sigma))
-	    TyVarSet.empty G
+        SigIdMap.foldl
+            (fn(Sigma, U) => TyVarSet.union(U, Sig.tyvars Sigma))
+            TyVarSet.empty G
 
     fun tyvarsF F =
-	FunIdMap.foldl
-	    (fn(Phi, U) => TyVarSet.union(U, FunSig.tyvars Phi))
-	    TyVarSet.empty F
+        FunIdMap.foldl
+            (fn(Phi, U) => TyVarSet.union(U, FunSig.tyvars Phi))
+            TyVarSet.empty F
 
     fun tyvars (T,F,G,E) = TyVarSet.union(TyVarSet.union(
-				tyvarsF F, tyvarsG G), StaticEnv.tyvars E)
+                                tyvarsF F, tyvarsG G), StaticEnv.tyvars E)
     
 
 
     fun tynamesG G =
-	SigIdMap.foldl
-	    (fn(Sigma, T) => TyNameSet.union(T, Sig.tynames Sigma))
-	    TyNameSet.empty G
+        SigIdMap.foldl
+            (fn(Sigma, T) => TyNameSet.union(T, Sig.tynames Sigma))
+            TyNameSet.empty G
 
     fun tynamesF F =
-	FunIdMap.foldl
-	    (fn(Phi, T) => TyNameSet.union(T, FunSig.tynames Phi))
-	    TyNameSet.empty F
+        FunIdMap.foldl
+            (fn(Phi, T) => TyNameSet.union(T, FunSig.tynames Phi))
+            TyNameSet.empty F
 
 
 
     (* Injection [Sections 4.3 and 5.1] *)
 
     val empty =
-	( TyNameSet.empty, FunIdMap.empty, SigIdMap.empty, StaticEnv.empty )
+        ( TyNameSet.empty, FunIdMap.empty, SigIdMap.empty, StaticEnv.empty )
 
     fun fromTandE(T,E) = ( T, FunIdMap.empty, SigIdMap.empty, E )
     fun fromTandF(T,F) = ( T, F, SigIdMap.empty, StaticEnv.empty )
@@ -4068,41 +4068,41 @@
     infix plus plusT oplusG oplusF oplusE oplusSE
 
     fun (T,F,G,E) plus (T',F',G',E') =
-	( TyNameSet.union(T,T')
-	, FunIdMap.unionWith #2 (F,F')
-	, SigIdMap.unionWith #2 (G,G')
-	, StaticEnv.plus(E,E')
-	)
+        ( TyNameSet.union(T,T')
+        , FunIdMap.unionWith #2 (F,F')
+        , SigIdMap.unionWith #2 (G,G')
+        , StaticEnv.plus(E,E')
+        )
 
     fun (T,F,G,E) plusT T' = ( TyNameSet.union(T,T'), F, G, E )
 
     fun (T,F,G,E) oplusG G' =
-	( TyNameSet.union(T, tynamesG G')
-	, F
-	, SigIdMap.unionWith #2 (G,G')
-	, E
-	)
+        ( TyNameSet.union(T, tynamesG G')
+        , F
+        , SigIdMap.unionWith #2 (G,G')
+        , E
+        )
 
     fun (T,F,G,E) oplusF F' =
-	( TyNameSet.union(T, tynamesF F')
-	, FunIdMap.unionWith #2 (F,F')
-	, G
-	, E
-	)
+        ( TyNameSet.union(T, tynamesF F')
+        , FunIdMap.unionWith #2 (F,F')
+        , G
+        , E
+        )
 
     fun (T,F,G,E) oplusE E' =
-	( TyNameSet.union(T, StaticEnv.tynames E')
-	, F
-	, G
-	, StaticEnv.plus(E,E')
-	)
+        ( TyNameSet.union(T, StaticEnv.tynames E')
+        , F
+        , G
+        , StaticEnv.plus(E,E')
+        )
 
     fun (T,F,G,E) oplusSE SE =
-	( TyNameSet.union(T, StaticEnv.tynamesSE SE)
-	, F
-	, G
-	, StaticEnv.plusSE(E,SE)
-	)
+        ( TyNameSet.union(T, StaticEnv.tynamesSE SE)
+        , F
+        , G
+        , StaticEnv.plusSE(E,SE)
+        )
 
     (* Application (lookup) [Sections 5.1 and 4.3] *)
 
@@ -4110,9 +4110,9 @@
     fun findSigId((T,F,G,E), sigid) = SigIdMap.find(G, sigid)
     fun findFunId((T,F,G,E), funid) = FunIdMap.find(F, funid)
     fun findLongStrId((T,F,G,E), longstrid) =
-	StaticEnv.findLongStrId(E, longstrid)
+        StaticEnv.findLongStrId(E, longstrid)
     fun findLongTyCon((T,F,G,E), longtycon) =
-	StaticEnv.findLongTyCon(E, longtycon)
+        StaticEnv.findLongTyCon(E, longtycon)
 
   end
 (* stop of StaticBasis.sml *)
@@ -4136,30 +4136,30 @@
 
     (* Predefined monomorphic types [Figure 24] *)
 
-    val tauBool:	Type
-    val tauInt:		Type
-    val tauWord:	Type
-    val tauReal:	Type
-    val tauString:	Type
-    val tauChar:	Type
-    val tauExn:		Type
+    val tauBool:        Type
+    val tauInt:         Type
+    val tauWord:        Type
+    val tauReal:        Type
+    val tauString:      Type
+    val tauChar:        Type
+    val tauExn:         Type
 
     (* Overloading classes [Appendix E.1] *)
 
-    val Int:		OverloadingClass
-    val Real:		OverloadingClass
-    val Word:		OverloadingClass
-    val String:		OverloadingClass
-    val Char:		OverloadingClass
-    val WordInt:	OverloadingClass
-    val RealInt:	OverloadingClass
-    val Num:		OverloadingClass
-    val NumTxt:		OverloadingClass
+    val Int:            OverloadingClass
+    val Real:           OverloadingClass
+    val Word:           OverloadingClass
+    val String:         OverloadingClass
+    val Char:           OverloadingClass
+    val WordInt:        OverloadingClass
+    val RealInt:        OverloadingClass
+    val Num:            OverloadingClass
+    val NumTxt:         OverloadingClass
 
     (* Initial environment [Appendix C] *)
 
-    val T0:		TyNameSet
-    val E0:		Env
+    val T0:             TyNameSet
+    val E0:             Env
 
   end
 (* stop of INITIAL_STATIC_ENV.sml *)
@@ -4190,13 +4190,13 @@
     (* Helpers *)
 
     fun pairType(tau1,tau2) =
-	let
-	    val Rho = LabMap.insert(LabMap.insert(LabMap.empty,
-						  Lab.fromInt 1, tau1),
-						  Lab.fromInt 2, tau2)
-	in
-	    fromRowType (Rho,CLOSEDRow)
-	end
+        let
+            val Rho = LabMap.insert(LabMap.insert(LabMap.empty,
+                                                  Lab.fromInt 1, tau1),
+                                                  Lab.fromInt 2, tau2)
+        in
+            fromRowType (Rho,CLOSEDRow)
+        end
 
 
     (* VIds [Figure 25] *)
@@ -4241,7 +4241,7 @@
     val tExn    = TyName.tyname(tyconExn,    0, TyName.NOEQ, 0)
 
     val T0      = TyNameSet.fromList[tBool, tInt, tWord, tReal, tString, tChar,
-				     tList, tRef, tExn]
+                                     tList, tRef, tExn]
 
 
     (* Types *)
@@ -4266,14 +4266,14 @@
     (* TypeSchemes [Figure 25] *)
 
     val sigmaEq     = ([alphaEq], fromFunType(pairType(tauAlphaEq,tauAlphaEq),
-					      tauBool))
+                                              tauBool))
     val sigmaAssign = ([alpha],   fromFunType(pairType(tauAlphaRef,tauAlpha),
-					      tauUnit))
+                                              tauUnit))
     val sigmaFalse  = ([], tauBool)
     val sigmaTrue   = ([], tauBool)
     val sigmaNil    = ([alpha], tauAlphaList)
     val sigmaCons   = ([alpha], fromFunType(pairType(tauAlpha, tauAlphaList),
-					    tauAlphaList))
+                                            tauAlphaList))
     val sigmaRef    = ([alpha], fromFunType(tauAlpha, tauAlphaRef))
 
     val sigmaMatch  = ([], tauExn)
@@ -4313,9 +4313,9 @@
 
     val VEEmpty = VIdMap.empty
     val VEBool  = VIdMap.fromList[(vidFalse, valstrFalse),
-				  (vidTrue,  valstrTrue)] : ValEnv
+                                  (vidTrue,  valstrTrue)] : ValEnv
     val VEList  = VIdMap.fromList[(vidNil,   valstrNil),
-				  (vidCons,  valstrCons)]
+                                  (vidCons,  valstrCons)]
     val VERef   = VIdMap.fromList[(vidRef,   valstrRef)]
 
     val tystrUnit   = (thetaUnit,   VEEmpty)
@@ -4335,41 +4335,41 @@
     val SE0 = StrIdMap.empty
 
     val TE0 = TyConMap.fromList[(tyconUnit,   tystrUnit),
- 				(tyconBool,   tystrBool),
- 				(tyconInt,    tystrInt),
- 				(tyconWord,   tystrWord),
- 				(tyconReal,   tystrReal),
- 				(tyconString, tystrString),
- 				(tyconChar,   tystrChar),
- 				(tyconList,   tystrList),
- 				(tyconRef,    tystrRef),
- 				(tyconExn,    tystrExn)]
+                                (tyconBool,   tystrBool),
+                                (tyconInt,    tystrInt),
+                                (tyconWord,   tystrWord),
+                                (tyconReal,   tystrReal),
+                                (tyconString, tystrString),
+                                (tyconChar,   tystrChar),
+                                (tyconList,   tystrList),
+                                (tyconRef,    tystrRef),
+                                (tyconExn,    tystrExn)]
 
     val VE0 = VIdMap.fromList  [(vidEq,     valstrEq),
-				(vidAssign, valstrAssign),
-				(vidRef,    valstrRef),
-				(vidNil,    valstrNil),
-				(vidCons,   valstrCons),
-				(vidFalse,  valstrFalse),
-				(vidTrue,   valstrTrue),
-				(vidMatch,  valstrMatch),
-				(vidBind,   valstrBind)]
+                                (vidAssign, valstrAssign),
+                                (vidRef,    valstrRef),
+                                (vidNil,    valstrNil),
+                                (vidCons,   valstrCons),
+                                (vidFalse,  valstrFalse),
+                                (vidTrue,   valstrTrue),
+                                (vidMatch,  valstrMatch),
+                                (vidBind,   valstrBind)]
 
     val E0 = (SE0,TE0,VE0)
 
 
     (* Overloading classes [Section E.1] *)
 
-    val Int	= OverloadingClass.make(TyNameSet.singleton tInt,    tInt)
-    val Real	= OverloadingClass.make(TyNameSet.singleton tReal,   tReal)
-    val Word	= OverloadingClass.make(TyNameSet.singleton tWord,   tWord)
-    val String	= OverloadingClass.make(TyNameSet.singleton tString, tString)
-    val Char	= OverloadingClass.make(TyNameSet.singleton tChar,   tChar)
-    val WordInt	= OverloadingClass.union(Word, Int)	(* default is 2nd *)
-    val RealInt	= OverloadingClass.union(Real, Int)
-    val Num	= OverloadingClass.union(Word, RealInt)
-    val Txt	= OverloadingClass.union(String, Char)
-    val NumTxt	= OverloadingClass.union(Txt, Num)
+    val Int     = OverloadingClass.make(TyNameSet.singleton tInt,    tInt)
+    val Real    = OverloadingClass.make(TyNameSet.singleton tReal,   tReal)
+    val Word    = OverloadingClass.make(TyNameSet.singleton tWord,   tWord)
+    val String  = OverloadingClass.make(TyNameSet.singleton tString, tString)
+    val Char    = OverloadingClass.make(TyNameSet.singleton tChar,   tChar)
+    val WordInt = OverloadingClass.union(Word, Int)     (* default is 2nd *)
+    val RealInt = OverloadingClass.union(Real, Int)
+    val Num     = OverloadingClass.union(Word, RealInt)
+    val Txt     = OverloadingClass.union(String, Char)
+    val NumTxt  = OverloadingClass.union(Txt, Num)
 
   end
 (* stop of InitialStaticEnv.sml *)
@@ -4437,7 +4437,7 @@
 
     (* Type [Section 6.2] *)
 
-    eqtype ExName					(* [en] *)
+    eqtype ExName                                       (* [en] *)
 
 
     (* Operations *)
@@ -4468,10 +4468,10 @@
 
     (* Type [Section 6.2] *)
 
-    type ExName =				      (* [en] *)
-	 { vid:   VId
-	 , stamp: stamp
-	 }
+    type ExName =                                     (* [en] *)
+         { vid:   VId
+         , stamp: stamp
+         }
 
 
     (* Creation *)
@@ -4487,7 +4487,7 @@
     (* Ordering *)
 
     fun compare(en1: ExName, en2: ExName) =
-	    Stamp.compare(#stamp en1, #stamp en2)
+            Stamp.compare(#stamp en1, #stamp en2)
 
   end
 (* stop of ExName.sml *)
@@ -4503,7 +4503,7 @@
 
     (* Type [Section 6.2] *)
 
-    eqtype Addr					(* [a] *)
+    eqtype Addr                                 (* [a] *)
 
 
     (* Operations *)
@@ -4526,7 +4526,7 @@
 
     (* Type [Section 6.2] *)
 
-    type Addr =	Stamp.stamp				(* [a] *)
+    type Addr = Stamp.stamp                             (* [a] *)
 
 
     (* Operations *)
@@ -4544,10 +4544,10 @@
  *)
 
 structure ExNameSet  = FinSetFn(type ord_key = ExName.ExName
-				val  compare = ExName.compare)
+                                val  compare = ExName.compare)
 
 structure AddrMap    = FinMapFn(type ord_key = Addr.Addr
-				val  compare = Addr.compare)
+                                val  compare = Addr.compare)
 (* stop of AssembliesCoreDynamic.sml *)
 (* start of SVAL.sml *)
 (*
@@ -4562,12 +4562,12 @@
 
     (* Type [Section 6.2] *)
 
-    datatype SVal =				(* [sv] *)
-	  INT    of int
-	| WORD   of word
-	| STRING of string
-	| CHAR   of char
-	| REAL   of real
+    datatype SVal =                             (* [sv] *)
+          INT    of int
+        | WORD   of word
+        | STRING of string
+        | CHAR   of char
+        | REAL   of real
 
     (* Operations *)
 
@@ -4589,12 +4589,12 @@
 
     (* Type [Section 6.2] *)
 
-    datatype SVal =				(* [sv] *)
-	  INT    of int
-	| WORD   of word
-	| STRING of string
-	| CHAR   of char
-	| REAL   of real
+    datatype SVal =                             (* [sv] *)
+          INT    of int
+        | WORD   of word
+        | STRING of string
+        | CHAR   of char
+        | REAL   of real
 
 
     (* Conversions *)
@@ -4642,24 +4642,24 @@
 
     (* Types [Sections 6.2 and 6.3] *)
 
-    type BasVal = string			(* [b] *)
+    type BasVal = string                        (* [b] *)
 
-    datatype 'a Val =				(* [v] *)
-	  :=
-	| SVal   of SVal
-	| BasVal of BasVal
-	| VId    of VId
-	| VIdVal of VId * 'a Val
-	| ExVal  of 'a ExVal
-	| Record of (*Record*) 'a Val LabMap
-	| Addr   of Addr
-	| FcnClosure of 'a
+    datatype 'a Val =                           (* [v] *)
+          :=
+        | SVal   of SVal
+        | BasVal of BasVal
+        | VId    of VId
+        | VIdVal of VId * 'a Val
+        | ExVal  of 'a ExVal
+        | Record of (*Record*) 'a Val LabMap
+        | Addr   of Addr
+        | FcnClosure of 'a
 
-    and 'a ExVal =				(* [e] *)
-	  ExName    of ExName
-	| ExNameVal of ExName * 'a Val
+    and 'a ExVal =                              (* [e] *)
+          ExName    of ExName
+        | ExNameVal of ExName * 'a Val
 
-    type 'a Record = 'a Val LabMap		(* [r] *)
+    type 'a Record = 'a Val LabMap              (* [r] *)
 
 
     (* Operations *)
@@ -4698,25 +4698,25 @@
 
     (* Types [Sections 6.2 and 6.3] *)
 
-    type BasVal = string			(* [b] *)
+    type BasVal = string                        (* [b] *)
 
 
-    datatype 'a Val =				(* [v] *)
-	  op:=
-	| SVal   of SVal
-	| BasVal of BasVal
-	| VId    of VId
-	| VIdVal of VId * 'a Val
-	| ExVal  of 'a ExVal
-	| Record of 'a Record
-	| Addr   of Addr
-	| FcnClosure of 'a
+    datatype 'a Val =                           (* [v] *)
+          op:=
+        | SVal   of SVal
+        | BasVal of BasVal
+        | VId    of VId
+        | VIdVal of VId * 'a Val
+        | ExVal  of 'a ExVal
+        | Record of 'a Record
+        | Addr   of Addr
+        | FcnClosure of 'a
 
-    and 'a ExVal =				(* [e] *)
-	  ExName    of ExName
-	| ExNameVal of ExName * 'a Val
+    and 'a ExVal =                              (* [e] *)
+          ExName    of ExName
+        | ExNameVal of ExName * 'a Val
 
-    withtype 'a Record = 'a Val LabMap		(* [r] *)
+    withtype 'a Record = 'a Val LabMap          (* [r] *)
 
 
     (* Operations *)
@@ -4725,10 +4725,10 @@
 
 
     fun unpair(Record r) =
-	(case (LabMap.find(r, Lab.fromInt 1), LabMap.find(r, Lab.fromInt 2))
-	   of (SOME v1, SOME v2) => SOME(v1, v2)
-	    | _ => NONE
-	)
+        (case (LabMap.find(r, Lab.fromInt 1), LabMap.find(r, Lab.fromInt 2))
+           of (SOME v1, SOME v2) => SOME(v1, v2)
+            | _ => NONE
+        )
       | unpair _ = NONE
 
 
@@ -4741,18 +4741,18 @@
       | equal(Addr a1,           Addr a2          ) = a1 = a2
 
       | equal(VIdVal(vid1, v1), VIdVal(vid2, v2)) =
-	    vid1 = vid2 andalso equal(v1, v2)
+            vid1 = vid2 andalso equal(v1, v2)
 
       | equal(ExVal(ExNameVal(en1,v1)), ExVal(ExNameVal(en2,v2))) =
-	    en1 = en2 andalso equal(v1, v2)
+            en1 = en2 andalso equal(v1, v2)
 
       | equal(Record r1, Record r2) =
-	    LabMap.numItems r1 = LabMap.numItems r2 andalso
-	    LabMap.alli (fn(lab, v1) =>
-			   case LabMap.find(r2, lab)
-			     of SOME v2 => equal(v1, v2)
-			      | NONE    => false
-			) r1
+            LabMap.numItems r1 = LabMap.numItems r2 andalso
+            LabMap.alli (fn(lab, v1) =>
+                           case LabMap.find(r2, lab)
+                             of SOME v2 => equal(v1, v2)
+                              | NONE    => false
+                        ) r1
 
       | equal _ = false
 
@@ -4785,17 +4785,17 @@
 
     (* Types [Section 6.3] *)
 
-    type 'a Mem   = 'a Val AddrMap			(* [mem] *)
+    type 'a Mem   = 'a Val AddrMap                      (* [mem] *)
 
-    type 'a State = 'a Mem * ExNameSet			(* [s] *)
+    type 'a State = 'a Mem * ExNameSet                  (* [s] *)
 
 
     (* Operations *)
 
-    val insertAddr:	'a State * Addr * 'a Val -> 'a State
-    val insertExName:	'a State * ExName        -> 'a State
+    val insertAddr:     'a State * Addr * 'a Val -> 'a State
+    val insertExName:   'a State * ExName        -> 'a State
 
-    val findAddr:	'a State * Addr -> 'a Val option
+    val findAddr:       'a State * Addr -> 'a Val option
 
   end
 (* stop of STATE.sml *)
@@ -4826,9 +4826,9 @@
 
     (* Types [Section 6.3] *)
 
-    type 'a Mem   = 'a Val AddrMap			(* [mem] *)
+    type 'a Mem   = 'a Val AddrMap                      (* [mem] *)
 
-    type 'a State = 'a Mem * ExNameSet			(* [s] *)
+    type 'a State = 'a Mem * ExNameSet                  (* [s] *)
 
 
     (* Operations *)
@@ -4865,15 +4865,15 @@
 
     type Info
 
-    type SCon		= SCon.SCon
-    type Lab		= Lab.Lab
-    type VId		= VId.Id
-    type TyCon		= TyCon.Id
-    type TyVar		= TyVar.TyVar
-    type StrId		= StrId.Id
-    type longVId	= LongVId.longId
-    type longTyCon	= LongTyCon.longId
-    type longStrId	= LongStrId.longId
+    type SCon           = SCon.SCon
+    type Lab            = Lab.Lab
+    type VId            = VId.Id
+    type TyCon          = TyCon.Id
+    type TyVar          = TyVar.TyVar
+    type StrId          = StrId.Id
+    type longVId        = LongVId.longId
+    type longTyCon      = LongTyCon.longId
+    type longStrId      = LongStrId.longId
 
 
     (* Optional keyword `op' *)
@@ -4884,124 +4884,124 @@
     (* Expressions [Figures 2 and 4] *)
 
     datatype AtExp =
-	  SCONAtExp      of Info * SCon
-	| LONGVIDAtExp   of Info * Op * longVId
-	| RECORDAtExp    of Info * ExpRow option
-	| LETAtExp       of Info * Dec * Exp
-	| PARAtExp       of Info * Exp
+          SCONAtExp      of Info * SCon
+        | LONGVIDAtExp   of Info * Op * longVId
+        | RECORDAtExp    of Info * ExpRow option
+        | LETAtExp       of Info * Dec * Exp
+        | PARAtExp       of Info * Exp
 
     and ExpRow =
-	  ExpRow         of Info * Lab * Exp * ExpRow option
+          ExpRow         of Info * Lab * Exp * ExpRow option
 
     and Exp =
-	  ATEXPExp       of Info * AtExp
-	| APPExp         of Info * Exp * AtExp
-	| TYPEDExp       of Info * Exp * Ty
-	| HANDLEExp      of Info * Exp * Match
-	| RAISEExp       of Info * Exp
-	| FNExp          of Info * Match
+          ATEXPExp       of Info * AtExp
+        | APPExp         of Info * Exp * AtExp
+        | TYPEDExp       of Info * Exp * Ty
+        | HANDLEExp      of Info * Exp * Match
+        | RAISEExp       of Info * Exp
+        | FNExp          of Info * Match
 
     (* Matches [Figures 2 and 4] *)
 
     and Match =
-	  Match          of Info * Mrule * Match option
+          Match          of Info * Mrule * Match option
 
     and Mrule =
-	  Mrule          of Info * Pat * Exp
+          Mrule          of Info * Pat * Exp
 
     (* Declarations [Figures 2 and 4] *)
 
     and Dec =
-	  VALDec         of Info * TyVarseq * ValBind
-	| TYPEDec        of Info * TypBind
-	| DATATYPEDec    of Info * DatBind
-	| REPLICATIONDec of Info * TyCon * longTyCon
-	| ABSTYPEDec     of Info * DatBind * Dec
-	| EXCEPTIONDec   of Info * ExBind
-	| LOCALDec       of Info * Dec * Dec
-	| OPENDec        of Info * longStrId list
-	| EMPTYDec       of Info
-	| SEQDec         of Info * Dec * Dec
+          VALDec         of Info * TyVarseq * ValBind
+        | TYPEDec        of Info * TypBind
+        | DATATYPEDec    of Info * DatBind
+        | REPLICATIONDec of Info * TyCon * longTyCon
+        | ABSTYPEDec     of Info * DatBind * Dec
+        | EXCEPTIONDec   of Info * ExBind
+        | LOCALDec       of Info * Dec * Dec
+        | OPENDec        of Info * longStrId list
+        | EMPTYDec       of Info
+        | SEQDec         of Info * Dec * Dec
 
     (* Bindings [Figures 2 and 4] *)
 
     and ValBind =
-	  PLAINValBind   of Info * Pat * Exp * ValBind option
-	| RECValBind     of Info * ValBind
+          PLAINValBind   of Info * Pat * Exp * ValBind option
+        | RECValBind     of Info * ValBind
 
     and TypBind =
-	  TypBind        of Info * TyVarseq * TyCon * Ty * TypBind option
+          TypBind        of Info * TyVarseq * TyCon * Ty * TypBind option
 
     and DatBind =
-	  DatBind        of Info * TyVarseq * TyCon * ConBind * DatBind option
+          DatBind        of Info * TyVarseq * TyCon * ConBind * DatBind option
 
     and ConBind =
-	  ConBind        of Info * Op * VId * Ty option * ConBind option
+          ConBind        of Info * Op * VId * Ty option * ConBind option
 
     and ExBind =
-	  NEWExBind      of Info * Op * VId * Ty option * ExBind option
-	| EQUALExBind    of Info * Op * VId * Op * longVId * ExBind option
+          NEWExBind      of Info * Op * VId * Ty option * ExBind option
+        | EQUALExBind    of Info * Op * VId * Op * longVId * ExBind option
 
     (* Patterns [Figures 2 and 3] *)
 
     and AtPat =
-	  WILDCARDAtPat  of Info
-	| SCONAtPat      of Info * SCon
-	| LONGVIDAtPat   of Info * Op * longVId
-	| RECORDAtPat    of Info * PatRow option
-	| PARAtPat       of Info * Pat
+          WILDCARDAtPat  of Info
+        | SCONAtPat      of Info * SCon
+        | LONGVIDAtPat   of Info * Op * longVId
+        | RECORDAtPat    of Info * PatRow option
+        | PARAtPat       of Info * Pat
 
     and PatRow =
-	  WILDCARDPatRow of Info
-	| ROWPatRow      of Info * Lab * Pat * PatRow option
+          WILDCARDPatRow of Info
+        | ROWPatRow      of Info * Lab * Pat * PatRow option
 
     and Pat =
-	  ATPATPat       of Info * AtPat
-	| CONPat         of Info * Op * longVId * AtPat
-	| TYPEDPat       of Info * Pat * Ty
-	| ASPat          of Info * Op * VId * Ty option * Pat
+          ATPATPat       of Info * AtPat
+        | CONPat         of Info * Op * longVId * AtPat
+        | TYPEDPat       of Info * Pat * Ty
+        | ASPat          of Info * Op * VId * Ty option * Pat
 
     (* Type expressions [Figures 2 and 3] *)
 
     and Ty =
-	  TYVARTy        of Info * TyVar
-	| RECORDTy       of Info * TyRow option
-	| TYCONTy        of Info * Tyseq * longTyCon
-	| ARROWTy        of Info * Ty * Ty
-	| PARTy          of Info * Ty
+          TYVARTy        of Info * TyVar
+        | RECORDTy       of Info * TyRow option
+        | TYCONTy        of Info * Tyseq * longTyCon
+        | ARROWTy        of Info * Ty * Ty
+        | PARTy          of Info * Ty
 
     and TyRow =
-	  TyRow          of Info * Lab * Ty * TyRow option
+          TyRow          of Info * Lab * Ty * TyRow option
 
     (* Sequences [Section 2.8] *)
 
     and Tyseq =
-	  Tyseq          of Info * Ty list
+          Tyseq          of Info * Ty list
 
     and TyVarseq =
-	  TyVarseq       of Info * TyVar list
+          TyVarseq       of Info * TyVar list
 
 
     (* Operations *)
 
-    val infoAtExp:	AtExp	-> Info
-    val infoExpRow:	ExpRow	-> Info
-    val infoExp:	Exp	-> Info
-    val infoMatch:	Match	-> Info
-    val infoMrule:	Mrule	-> Info
-    val infoDec:	Dec	-> Info
-    val infoValBind:	ValBind	-> Info
-    val infoTypBind:	TypBind	-> Info
-    val infoDatBind:	DatBind	-> Info
-    val infoConBind:	ConBind	-> Info
-    val infoExBind:	ExBind	-> Info
-    val infoAtPat:	AtPat	-> Info
-    val infoPatRow:	PatRow	-> Info
-    val infoPat:	Pat	-> Info
-    val infoTy:		Ty	-> Info
-    val infoTyRow:	TyRow	-> Info
-    val infoTyseq:	Tyseq	-> Info
-    val infoTyVarseq:	TyVarseq -> Info
+    val infoAtExp:      AtExp   -> Info
+    val infoExpRow:     ExpRow  -> Info
+    val infoExp:        Exp     -> Info
+    val infoMatch:      Match   -> Info
+    val infoMrule:      Mrule   -> Info
+    val infoDec:        Dec     -> Info
+    val infoValBind:    ValBind -> Info
+    val infoTypBind:    TypBind -> Info
+    val infoDatBind:    DatBind -> Info
+    val infoConBind:    ConBind -> Info
+    val infoExBind:     ExBind  -> Info
+    val infoAtPat:      AtPat   -> Info
+    val infoPatRow:     PatRow  -> Info
+    val infoPat:        Pat     -> Info
+    val infoTy:         Ty      -> Info
+    val infoTyRow:      TyRow   -> Info
+    val infoTyseq:      Tyseq   -> Info
+    val infoTyVarseq:   TyVarseq -> Info
 
   end
 (* stop of GRAMMAR_CORE.sml *)
@@ -5028,17 +5028,17 @@
 
     (* Import *)
 
-    type Info		= Info
+    type Info           = Info
 
-    type SCon		= SCon.SCon
-    type Lab		= Lab.Lab
-    type VId		= VId.Id
-    type TyCon		= TyCon.Id
-    type TyVar		= TyVar.TyVar
-    type StrId		= StrId.Id
-    type longVId	= LongVId.longId
-    type longTyCon	= LongTyCon.longId
-    type longStrId	= LongStrId.longId
+    type SCon           = SCon.SCon
+    type Lab            = Lab.Lab
+    type VId            = VId.Id
+    type TyCon          = TyCon.Id
+    type TyVar          = TyVar.TyVar
+    type StrId          = StrId.Id
+    type longVId        = LongVId.longId
+    type longTyCon      = LongTyCon.longId
+    type longStrId      = LongStrId.longId
 
 
     (* Optional keyword `op' *)
@@ -5049,173 +5049,173 @@
     (* Expressions [Figures 2 and 4] *)
 
     datatype AtExp =
-	  SCONAtExp      of Info * SCon
-	| LONGVIDAtExp   of Info * Op * longVId
-	| RECORDAtExp    of Info * ExpRow option
-	| LETAtExp       of Info * Dec * Exp
-	| PARAtExp       of Info * Exp
+          SCONAtExp      of Info * SCon
+        | LONGVIDAtExp   of Info * Op * longVId
+        | RECORDAtExp    of Info * ExpRow option
+        | LETAtExp       of Info * Dec * Exp
+        | PARAtExp       of Info * Exp
 
     and ExpRow =
-	  ExpRow         of Info * Lab * Exp * ExpRow option
+          ExpRow         of Info * Lab * Exp * ExpRow option
 
     and Exp =
-	  ATEXPExp       of Info * AtExp
-	| APPExp         of Info * Exp * AtExp
-	| TYPEDExp       of Info * Exp * Ty
-	| HANDLEExp      of Info * Exp * Match
-	| RAISEExp       of Info * Exp
-	| FNExp          of Info * Match
+          ATEXPExp       of Info * AtExp
+        | APPExp         of Info * Exp * AtExp
+        | TYPEDExp       of Info * Exp * Ty
+        | HANDLEExp      of Info * Exp * Match
+        | RAISEExp       of Info * Exp
+        | FNExp          of Info * Match
 
     (* Matches [Figures 2 and 4] *)
 
     and Match =
-	  Match          of Info * Mrule * Match option
+          Match          of Info * Mrule * Match option
 
     and Mrule =
-	  Mrule          of Info * Pat * Exp
+          Mrule          of Info * Pat * Exp
 
     (* Declarations [Figures 2 and 4] *)
 
     and Dec =
-	  VALDec         of Info * TyVarseq * ValBind
-	| TYPEDec        of Info * TypBind
-	| DATATYPEDec    of Info * DatBind
-	| REPLICATIONDec of Info * TyCon * longTyCon
-	| ABSTYPEDec     of Info * DatBind * Dec
-	| EXCEPTIONDec   of Info * ExBind
-	| LOCALDec       of Info * Dec * Dec
-	| OPENDec        of Info * longStrId list
-	| EMPTYDec       of Info
-	| SEQDec         of Info * Dec * Dec
+          VALDec         of Info * TyVarseq * ValBind
+        | TYPEDec        of Info * TypBind
+        | DATATYPEDec    of Info * DatBind
+        | REPLICATIONDec of Info * TyCon * longTyCon
+        | ABSTYPEDec     of Info * DatBind * Dec
+        | EXCEPTIONDec   of Info * ExBind
+        | LOCALDec       of Info * Dec * Dec
+        | OPENDec        of Info * longStrId list
+        | EMPTYDec       of Info
+        | SEQDec         of Info * Dec * Dec
 
     (* Bindings [Figures 2 and 4] *)
 
     and ValBind =
-	  PLAINValBind   of Info * Pat * Exp * ValBind option
-	| RECValBind     of Info * ValBind
+          PLAINValBind   of Info * Pat * Exp * ValBind option
+        | RECValBind     of Info * ValBind
 
     and TypBind =
-	  TypBind        of Info * TyVarseq * TyCon * Ty * TypBind option
+          TypBind        of Info * TyVarseq * TyCon * Ty * TypBind option
 
     and DatBind =
-	  DatBind        of Info * TyVarseq * TyCon * ConBind * DatBind option
+          DatBind        of Info * TyVarseq * TyCon * ConBind * DatBind option
 
     and ConBind =
-	  ConBind        of Info * Op * VId * Ty option * ConBind option
+          ConBind        of Info * Op * VId * Ty option * ConBind option
 
     and ExBind =
-	  NEWExBind      of Info * Op * VId * Ty option * ExBind option
-	| EQUALExBind    of Info * Op * VId * Op * longVId * ExBind option
+          NEWExBind      of Info * Op * VId * Ty option * ExBind option
+        | EQUALExBind    of Info * Op * VId * Op * longVId * ExBind option
 
     (* Patterns [Figures 2 and 3] *)
 
     and AtPat =
-	  WILDCARDAtPat  of Info
-	| SCONAtPat      of Info * SCon
-	| LONGVIDAtPat   of Info * Op * longVId
-	| RECORDAtPat    of Info * PatRow option
-	| PARAtPat       of Info * Pat
+          WILDCARDAtPat  of Info
+        | SCONAtPat      of Info * SCon
+        | LONGVIDAtPat   of Info * Op * longVId
+        | RECORDAtPat    of Info * PatRow option
+        | PARAtPat       of Info * Pat
 
     and PatRow =
-	  WILDCARDPatRow of Info
-	| ROWPatRow      of Info * Lab * Pat * PatRow option
+          WILDCARDPatRow of Info
+        | ROWPatRow      of Info * Lab * Pat * PatRow option
 
     and Pat =
-	  ATPATPat       of Info * AtPat
-	| CONPat         of Info * Op * longVId * AtPat
-	| TYPEDPat       of Info * Pat * Ty
-	| ASPat          of Info * Op * VId * Ty option * Pat
+          ATPATPat       of Info * AtPat
+        | CONPat         of Info * Op * longVId * AtPat
+        | TYPEDPat       of Info * Pat * Ty
+        | ASPat          of Info * Op * VId * Ty option * Pat
 
     (* Type expressions [Figures 2 and 3] *)
 
     and Ty =
-	  TYVARTy        of Info * TyVar
-	| RECORDTy       of Info * TyRow option
-	| TYCONTy        of Info * Tyseq * longTyCon
-	| ARROWTy        of Info * Ty * Ty
-	| PARTy          of Info * Ty
+          TYVARTy        of Info * TyVar
+        | RECORDTy       of Info * TyRow option
+        | TYCONTy        of Info * Tyseq * longTyCon
+        | ARROWTy        of Info * Ty * Ty
+        | PARTy          of Info * Ty
 
     and TyRow =
-	  TyRow          of Info * Lab * Ty * TyRow option
+          TyRow          of Info * Lab * Ty * TyRow option
 
     (* Sequences [Section 2.8] *)
 
     and Tyseq =
-	  Tyseq          of Info * Ty list
+          Tyseq          of Info * Ty list
 
     and TyVarseq =
-	  TyVarseq       of Info * TyVar list
+          TyVarseq       of Info * TyVar list
 
 
 
     (* Extracting info fields *)
 
-    fun infoAtExp(SCONAtExp(I,_))		= I
-      | infoAtExp(LONGVIDAtExp(I,_,_))		= I
-      | infoAtExp(RECORDAtExp(I,_))		= I
-      | infoAtExp(LETAtExp(I,_,_))		= I
-      | infoAtExp(PARAtExp(I,_))		= I
+    fun infoAtExp(SCONAtExp(I,_))               = I
+      | infoAtExp(LONGVIDAtExp(I,_,_))          = I
+      | infoAtExp(RECORDAtExp(I,_))             = I
+      | infoAtExp(LETAtExp(I,_,_))              = I
+      | infoAtExp(PARAtExp(I,_))                = I
 
-    fun infoExpRow(ExpRow(I,_,_,_))		= I
+    fun infoExpRow(ExpRow(I,_,_,_))             = I
 
-    fun infoExp(ATEXPExp(I,_))			= I
-      | infoExp(APPExp(I,_,_))			= I
-      | infoExp(TYPEDExp(I,_,_))		= I
-      | infoExp(HANDLEExp(I,_,_))		= I
-      | infoExp(RAISEExp(I,_))			= I
-      | infoExp(FNExp(I,_))			= I
+    fun infoExp(ATEXPExp(I,_))                  = I
+      | infoExp(APPExp(I,_,_))                  = I
+      | infoExp(TYPEDExp(I,_,_))                = I
+      | infoExp(HANDLEExp(I,_,_))               = I
+      | infoExp(RAISEExp(I,_))                  = I
+      | infoExp(FNExp(I,_))                     = I
 
-    fun infoMatch(Match(I,_,_))			= I
+    fun infoMatch(Match(I,_,_))                 = I
 
-    fun infoMrule(Mrule(I,_,_))			= I
+    fun infoMrule(Mrule(I,_,_))                 = I
 
-    fun infoDec(VALDec(I,_,_))			= I
-      | infoDec(TYPEDec(I,_))			= I
-      | infoDec(DATATYPEDec(I,_))		= I
-      | infoDec(REPLICATIONDec(I,_,_))		= I
-      | infoDec(ABSTYPEDec(I,_,_))		= I
-      | infoDec(EXCEPTIONDec(I,_))		= I
-      | infoDec(LOCALDec(I,_,_))		= I
-      | infoDec(OPENDec(I,_))			= I
-      | infoDec(EMPTYDec(I))			= I
-      | infoDec(SEQDec(I,_,_))			= I
+    fun infoDec(VALDec(I,_,_))                  = I
+      | infoDec(TYPEDec(I,_))                   = I
+      | infoDec(DATATYPEDec(I,_))               = I
+      | infoDec(REPLICATIONDec(I,_,_))          = I
+      | infoDec(ABSTYPEDec(I,_,_))              = I
+      | infoDec(EXCEPTIONDec(I,_))              = I
+      | infoDec(LOCALDec(I,_,_))                = I
+      | infoDec(OPENDec(I,_))                   = I
+      | infoDec(EMPTYDec(I))                    = I
+      | infoDec(SEQDec(I,_,_))                  = I
 
-    fun infoValBind(PLAINValBind(I,_,_,_))	= I
-      | infoValBind(RECValBind(I,_))		= I
+    fun infoValBind(PLAINValBind(I,_,_,_))      = I
+      | infoValBind(RECValBind(I,_))            = I
 
-    fun infoTypBind(TypBind(I,_,_,_,_))		= I
+    fun infoTypBind(TypBind(I,_,_,_,_))         = I
 
-    fun infoDatBind(DatBind(I,_,_,_,_))		= I
+    fun infoDatBind(DatBind(I,_,_,_,_))         = I
 
-    fun infoConBind(ConBind(I,_,_,_,_))		= I
+    fun infoConBind(ConBind(I,_,_,_,_))         = I
 
-    fun infoExBind(NEWExBind(I,_,_,_,_))	= I
-      | infoExBind(EQUALExBind(I,_,_,_,_,_))	= I
+    fun infoExBind(NEWExBind(I,_,_,_,_))        = I
+      | infoExBind(EQUALExBind(I,_,_,_,_,_))    = I
 
-    fun infoAtPat(WILDCARDAtPat(I))		= I
-      | infoAtPat(SCONAtPat(I,_))		= I
-      | infoAtPat(LONGVIDAtPat(I,_,_))		= I
-      | infoAtPat(RECORDAtPat(I,_))		= I
-      | infoAtPat(PARAtPat(I,_))		= I
+    fun infoAtPat(WILDCARDAtPat(I))             = I
+      | infoAtPat(SCONAtPat(I,_))               = I
+      | infoAtPat(LONGVIDAtPat(I,_,_))          = I
+      | infoAtPat(RECORDAtPat(I,_))             = I
+      | infoAtPat(PARAtPat(I,_))                = I
 
-    fun infoPatRow(WILDCARDPatRow(I))		= I
-      | infoPatRow(ROWPatRow(I,_,_,_))		= I
+    fun infoPatRow(WILDCARDPatRow(I))           = I
+      | infoPatRow(ROWPatRow(I,_,_,_))          = I
 
-    fun infoPat(ATPATPat(I,_))			= I
-      | infoPat(CONPat(I,_,_,_))		= I
-      | infoPat(TYPEDPat(I,_,_))		= I
-      | infoPat(ASPat(I,_,_,_,_))		= I
+    fun infoPat(ATPATPat(I,_))                  = I
+      | infoPat(CONPat(I,_,_,_))                = I
+      | infoPat(TYPEDPat(I,_,_))                = I
+      | infoPat(ASPat(I,_,_,_,_))               = I
 
-    fun infoTy(TYVARTy(I,_))			= I
-      | infoTy(RECORDTy(I,_))			= I
-      | infoTy(TYCONTy(I,_,_))			= I
-      | infoTy(ARROWTy(I,_,_))			= I
-      | infoTy(PARTy(I,_))			= I
+    fun infoTy(TYVARTy(I,_))                    = I
+      | infoTy(RECORDTy(I,_))                   = I
+      | infoTy(TYCONTy(I,_,_))                  = I
+      | infoTy(ARROWTy(I,_,_))                  = I
+      | infoTy(PARTy(I,_))                      = I
 
-    fun infoTyRow(TyRow(I,_,_,_))		= I
+    fun infoTyRow(TyRow(I,_,_,_))               = I
 
-    fun infoTyseq(Tyseq(I,_))			= I
-    fun infoTyVarseq(TyVarseq(I,_))		= I
+    fun infoTyseq(Tyseq(I,_))                   = I
+    fun infoTyVarseq(TyVarseq(I,_))             = I
 
   end
 (* stop of GrammarCoreFn.sml *)
@@ -5252,9 +5252,9 @@
     fun between(r1: region, r2: region) = (#2 r1, #1 r2)
 
     fun compare((m1,n1), (m2,n2)) =
-	case Int.compare(m1, m2)
-	  of EQUAL => Int.compare(n1, n2)
-	   | order => order
+        case Int.compare(m1, m2)
+          of EQUAL => Int.compare(n1, n2)
+           | order => order
 
   end
 (* stop of Source.sml *)
@@ -5281,30 +5281,30 @@
 
     type Info
 
-    type VId		= Core.VId
-    type TyCon		= Core.TyCon
-    type TyVar		= Core.TyVar
-    type StrId		= Core.StrId
-    type longVId	= Core.longVId
-    type longTyCon	= Core.longTyCon
-    type longStrId	= Core.longStrId
-    type Dec		= Core.Dec
-    type Ty		= Core.Ty
-    type TyVarseq	= Core.TyVarseq
+    type VId            = Core.VId
+    type TyCon          = Core.TyCon
+    type TyVar          = Core.TyVar
+    type StrId          = Core.StrId
+    type longVId        = Core.longVId
+    type longTyCon      = Core.longTyCon
+    type longStrId      = Core.longStrId
+    type Dec            = Core.Dec
+    type Ty             = Core.Ty
+    type TyVarseq       = Core.TyVarseq
 
-    type SigId		= SigId.Id
-    type FunId		= FunId.Id
+    type SigId          = SigId.Id
+    type FunId          = FunId.Id
 
 
     (* Structures [Figures 5 and 6] *)
 
     datatype StrExp =
-	  STRUCTStrExp    of Info * StrDec
-	| LONGSTRIDStrExp of Info * longStrId
-	| TRANSStrExp     of Info * StrExp * SigExp
-	| OPAQStrExp      of Info * StrExp * SigExp
-	| APPStrExp       of Info * FunId * StrExp
-	| LETStrExp       of Info * StrDec * StrExp
+          STRUCTStrExp    of Info * StrDec
+        | LONGSTRIDStrExp of Info * longStrId
+        | TRANSStrExp     of Info * StrExp * SigExp
+        | OPAQStrExp      of Info * StrExp * SigExp
+        | APPStrExp       of Info * FunId * StrExp
+        | LETStrExp       of Info * StrDec * StrExp
 
     and StrDec =
           DECStrDec       of Info * Dec
@@ -5332,33 +5332,33 @@
     (* Specifications [Figures 5 and 7] *)
 
     and Spec =
-	  VALSpec         of Info * ValDesc
-	| TYPESpec        of Info * TypDesc
-	| EQTYPESpec      of Info * TypDesc
-	| DATATYPESpec    of Info * DatDesc
-	| REPLICATIONSpec of Info * TyCon * longTyCon
-	| EXCEPTIONSpec   of Info * ExDesc
-	| STRUCTURESpec   of Info * StrDesc
-	| INCLUDESpec     of Info * SigExp
-	| EMPTYSpec       of Info
-	| SEQSpec         of Info * Spec * Spec
-	| SHARINGTYPESpec of Info * Spec * longTyCon list
-	| SHARINGSpec     of Info * Spec * longStrId list
+          VALSpec         of Info * ValDesc
+        | TYPESpec        of Info * TypDesc
+        | EQTYPESpec      of Info * TypDesc
+        | DATATYPESpec    of Info * DatDesc
+        | REPLICATIONSpec of Info * TyCon * longTyCon
+        | EXCEPTIONSpec   of Info * ExDesc
+        | STRUCTURESpec   of Info * StrDesc
+        | INCLUDESpec     of Info * SigExp
+        | EMPTYSpec       of Info
+        | SEQSpec         of Info * Spec * Spec
+        | SHARINGTYPESpec of Info * Spec * longTyCon list
+        | SHARINGSpec     of Info * Spec * longStrId list
 
     and ValDesc =
-	  ValDesc         of Info * VId * Ty * ValDesc option
+          ValDesc         of Info * VId * Ty * ValDesc option
 
     and TypDesc =
-	  TypDesc         of Info * TyVarseq * TyCon * TypDesc option
+          TypDesc         of Info * TyVarseq * TyCon * TypDesc option
 
     and DatDesc =
-	  DatDesc         of Info * TyVarseq * TyCon * ConDesc * DatDesc option
+          DatDesc         of Info * TyVarseq * TyCon * ConDesc * DatDesc option
 
     and ConDesc =
-	  ConDesc         of Info * VId * Ty option * ConDesc option
+          ConDesc         of Info * VId * Ty option * ConDesc option
 
     and ExDesc =
-	  ExDesc          of Info * VId * Ty option * ExDesc option
+          ExDesc          of Info * VId * Ty option * ExDesc option
 
     and StrDesc =
           StrDesc         of Info * StrId * SigExp * StrDesc option
@@ -5382,21 +5382,21 @@
 
     (* Operations *)
 
-    val infoStrExp:	StrExp  -> Info
-    val infoStrDec:	StrDec  -> Info
-    val infoStrBind:	StrBind -> Info
-    val infoSigExp:	SigExp  -> Info
-    val infoSigBind:	SigBind -> Info
-    val infoSpec:	Spec    -> Info
-    val infoValDesc:	ValDesc -> Info
-    val infoTypDesc:	TypDesc -> Info
-    val infoDatDesc:	DatDesc -> Info
-    val infoConDesc:	ConDesc -> Info
-    val infoExDesc:	ExDesc  -> Info
-    val infoStrDesc:	StrDesc -> Info
-    val infoFunDec:	FunDec  -> Info
-    val infoFunBind:	FunBind -> Info
-    val infoTopDec:	TopDec  -> Info
+    val infoStrExp:     StrExp  -> Info
+    val infoStrDec:     StrDec  -> Info
+    val infoStrBind:    StrBind -> Info
+    val infoSigExp:     SigExp  -> Info
+    val infoSigBind:    SigBind -> Info
+    val infoSpec:       Spec    -> Info
+    val infoValDesc:    ValDesc -> Info
+    val infoTypDesc:    TypDesc -> Info
+    val infoDatDesc:    DatDesc -> Info
+    val infoConDesc:    ConDesc -> Info
+    val infoExDesc:     ExDesc  -> Info
+    val infoStrDesc:    StrDesc -> Info
+    val infoFunDec:     FunDec  -> Info
+    val infoFunBind:    FunBind -> Info
+    val infoTopDec:     TopDec  -> Info
 
   end
 (* stop of GRAMMAR_MODULE.sml *)
@@ -5415,8 +5415,8 @@
 
 
 functor GrammarModuleFn(type Info
-			structure Core: GRAMMAR_CORE
-		       ) : GRAMMAR_MODULE =
+                        structure Core: GRAMMAR_CORE
+                       ) : GRAMMAR_MODULE =
   struct
 
     (* Import *)
@@ -5433,12 +5433,12 @@
     (* Structures [Figures 5 and 6] *)
 
     datatype StrExp =
-	  STRUCTStrExp    of Info * StrDec
-	| LONGSTRIDStrExp of Info * longStrId
-	| TRANSStrExp     of Info * StrExp * SigExp
-	| OPAQStrExp      of Info * StrExp * SigExp
-	| APPStrExp       of Info * FunId * StrExp
-	| LETStrExp       of Info * StrDec * StrExp
+          STRUCTStrExp    of Info * StrDec
+        | LONGSTRIDStrExp of Info * longStrId
+        | TRANSStrExp     of Info * StrExp * SigExp
+        | OPAQStrExp      of Info * StrExp * SigExp
+        | APPStrExp       of Info * FunId * StrExp
+        | LETStrExp       of Info * StrDec * StrExp
 
     and StrDec =
           DECStrDec       of Info * Dec
@@ -5466,33 +5466,33 @@
     (* Specifications [Figures 5 and 7] *)
 
     and Spec =
-	  VALSpec         of Info * ValDesc
-	| TYPESpec        of Info * TypDesc
-	| EQTYPESpec      of Info * TypDesc
-	| DATATYPESpec    of Info * DatDesc
-	| REPLICATIONSpec of Info * TyCon * longTyCon
-	| EXCEPTIONSpec   of Info * ExDesc
-	| STRUCTURESpec   of Info * StrDesc
-	| INCLUDESpec     of Info * SigExp
-	| EMPTYSpec       of Info
-	| SEQSpec         of Info * Spec * Spec
-	| SHARINGTYPESpec of Info * Spec * longTyCon list
-	| SHARINGSpec     of Info * Spec * longStrId list
+          VALSpec         of Info * ValDesc
+        | TYPESpec        of Info * TypDesc
+        | EQTYPESpec      of Info * TypDesc
+        | DATATYPESpec    of Info * DatDesc
+        | REPLICATIONSpec of Info * TyCon * longTyCon
+        | EXCEPTIONSpec   of Info * ExDesc
+        | STRUCTURESpec   of Info * StrDesc
+        | INCLUDESpec     of Info * SigExp
+        | EMPTYSpec       of Info
+        | SEQSpec         of Info * Spec * Spec
+        | SHARINGTYPESpec of Info * Spec * longTyCon list
+        | SHARINGSpec     of Info * Spec * longStrId list
 
     and ValDesc =
-	  ValDesc         of Info * VId * Ty * ValDesc option
+          ValDesc         of Info * VId * Ty * ValDesc option
 
     and TypDesc =
-	  TypDesc         of Info * TyVarseq * TyCon * TypDesc option
+          TypDesc         of Info * TyVarseq * TyCon * TypDesc option
 
     and DatDesc =
-	  DatDesc         of Info * TyVarseq * TyCon * ConDesc * DatDesc option
+          DatDesc         of Info * TyVarseq * TyCon * ConDesc * DatDesc option
 
     and ConDesc =
-	  ConDesc         of Info * VId * Ty option * ConDesc option
+          ConDesc         of Info * VId * Ty option * ConDesc option
 
     and ExDesc =
-	  ExDesc          of Info * VId * Ty option * ExDesc option
+          ExDesc          of Info * VId * Ty option * ExDesc option
 
     and StrDesc =
           StrDesc         of Info * StrId * SigExp * StrDesc option
@@ -5516,56 +5516,56 @@
 
     (* Extracting info fields *)
 
-    fun infoStrExp(STRUCTStrExp(I,_))		= I
-      | infoStrExp(LONGSTRIDStrExp(I,_))	= I
-      | infoStrExp(TRANSStrExp(I,_,_))		= I
-      | infoStrExp(OPAQStrExp(I,_,_))		= I
-      | infoStrExp(APPStrExp(I,_,_))		= I
-      | infoStrExp(LETStrExp(I,_,_))		= I
+    fun infoStrExp(STRUCTStrExp(I,_))           = I
+      | infoStrExp(LONGSTRIDStrExp(I,_))        = I
+      | infoStrExp(TRANSStrExp(I,_,_))          = I
+      | infoStrExp(OPAQStrExp(I,_,_))           = I
+      | infoStrExp(APPStrExp(I,_,_))            = I
+      | infoStrExp(LETStrExp(I,_,_))            = I
 
-    fun infoStrDec(DECStrDec(I,_))		= I
-      | infoStrDec(STRUCTUREStrDec(I,_))	= I
-      | infoStrDec(LOCALStrDec(I,_,_))		= I
-      | infoStrDec(EMPTYStrDec(I))		= I
-      | infoStrDec(SEQStrDec(I,_,_))		= I
+    fun infoStrDec(DECStrDec(I,_))              = I
+      | infoStrDec(STRUCTUREStrDec(I,_))        = I
+      | infoStrDec(LOCALStrDec(I,_,_))          = I
+      | infoStrDec(EMPTYStrDec(I))              = I
+      | infoStrDec(SEQStrDec(I,_,_))            = I
 
-    fun infoStrBind(StrBind(I,_,_,_))		= I
+    fun infoStrBind(StrBind(I,_,_,_))           = I
 
-    fun infoSigExp(SIGSigExp(I,_))		= I
-      | infoSigExp(SIGIDSigExp(I,_))		= I
-      | infoSigExp(WHERETYPESigExp(I,_,_,_,_))	= I
+    fun infoSigExp(SIGSigExp(I,_))              = I
+      | infoSigExp(SIGIDSigExp(I,_))            = I
+      | infoSigExp(WHERETYPESigExp(I,_,_,_,_))  = I
 
-    fun infoSigDec(SigDec(I,_))			= I
+    fun infoSigDec(SigDec(I,_))                 = I
 
-    fun infoSigBind(SigBind(I,_,_,_))		= I
+    fun infoSigBind(SigBind(I,_,_,_))           = I
 
-    fun infoSpec(VALSpec(I,_))			= I
-      | infoSpec(TYPESpec(I,_))			= I
-      | infoSpec(EQTYPESpec(I,_))		= I
-      | infoSpec(DATATYPESpec(I,_))		= I
-      | infoSpec(REPLICATIONSpec(I,_,_))	= I
-      | infoSpec(EXCEPTIONSpec(I,_))		= I
-      | infoSpec(STRUCTURESpec(I,_))		= I
-      | infoSpec(INCLUDESpec(I,_))		= I
-      | infoSpec(EMPTYSpec(I))			= I
-      | infoSpec(SEQSpec(I,_,_))		= I
-      | infoSpec(SHARINGTYPESpec(I,_,_))	= I
-      | infoSpec(SHARINGSpec(I,_,_))		= I
+    fun infoSpec(VALSpec(I,_))                  = I
+      | infoSpec(TYPESpec(I,_))                 = I
+      | infoSpec(EQTYPESpec(I,_))               = I
+      | infoSpec(DATATYPESpec(I,_))             = I
+      | infoSpec(REPLICATIONSpec(I,_,_))        = I
+      | infoSpec(EXCEPTIONSpec(I,_))            = I
+      | infoSpec(STRUCTURESpec(I,_))            = I
+      | infoSpec(INCLUDESpec(I,_))              = I
+      | infoSpec(EMPTYSpec(I))                  = I
+      | infoSpec(SEQSpec(I,_,_))                = I
+      | infoSpec(SHARINGTYPESpec(I,_,_))        = I
+      | infoSpec(SHARINGSpec(I,_,_))            = I
 
-    fun infoValDesc(ValDesc(I,_,_,_))		= I
-    fun infoTypDesc(TypDesc(I,_,_,_))		= I
-    fun infoDatDesc(DatDesc(I,_,_,_,_))		= I
-    fun infoConDesc(ConDesc(I,_,_,_))		= I
-    fun infoExDesc(ExDesc(I,_,_,_))		= I
-    fun infoStrDesc(StrDesc(I,_,_,_))		= I
+    fun infoValDesc(ValDesc(I,_,_,_))           = I
+    fun infoTypDesc(TypDesc(I,_,_,_))           = I
+    fun infoDatDesc(DatDesc(I,_,_,_,_))         = I
+    fun infoConDesc(ConDesc(I,_,_,_))           = I
+    fun infoExDesc(ExDesc(I,_,_,_))             = I
+    fun infoStrDesc(StrDesc(I,_,_,_))           = I
 
-    fun infoFunDec(FunDec(I,_))			= I
+    fun infoFunDec(FunDec(I,_))                 = I
 
-    fun infoFunBind(FunBind(I,_,_,_,_,_))	= I
+    fun infoFunBind(FunBind(I,_,_,_,_,_))       = I
 
-    fun infoTopDec(STRDECTopDec(I,_,_))		= I
-      | infoTopDec(SIGDECTopDec(I,_,_))		= I
-      | infoTopDec(FUNDECTopDec(I,_,_))		= I
+    fun infoTopDec(STRDECTopDec(I,_,_))         = I
+      | infoTopDec(SIGDECTopDec(I,_,_))         = I
+      | infoTopDec(FUNDECTopDec(I,_,_))         = I
 
   end
 (* stop of GrammarModuleFn.sml *)
@@ -5584,7 +5584,7 @@
 
     structure Module: GRAMMAR_MODULE
 
-    type Info	= Module.Info
+    type Info   = Module.Info
 
     type TopDec = Module.TopDec
 
@@ -5609,8 +5609,8 @@
 
 
 functor GrammarProgramFn(type Info
-			 structure Module: GRAMMAR_MODULE
-			) : GRAMMAR_PROGRAM =
+                         structure Module: GRAMMAR_MODULE
+                        ) : GRAMMAR_PROGRAM =
   struct
 
     (* Import *)
@@ -5636,10 +5636,10 @@
 structure GrammarCore    = GrammarCoreFn(type Info = Source.region)
 
 structure GrammarModule  = GrammarModuleFn(type Info = Source.region
-					   structure Core = GrammarCore)
+                                           structure Core = GrammarCore)
 
 structure GrammarProgram = GrammarProgramFn(type Info = Source.region
-					    structure Module = GrammarModule)
+                                            structure Module = GrammarModule)
 (* stop of Grammars.sml *)
 (* start of DYNAMIC_ENV.sml *)
 (*
@@ -5670,31 +5670,31 @@
     (* Export types [Section 6.6] *)
 
     datatype FcnClosure =
-	     FcnClosure of Match
-			* ( (*Env*)
-			    ( FcnClosure Val * IdStatus
-			    , (FcnClosure Val * IdStatus) VIdMap
-			    ) Str' StrIdMap
-			  * (FcnClosure Val * IdStatus) VIdMap TyConMap 
-			  * (FcnClosure Val * IdStatus) VIdMap
-			  )
-			* (*ValEnv*) (FcnClosure Val * IdStatus) VIdMap
+             FcnClosure of Match
+                        * ( (*Env*)
+                            ( FcnClosure Val * IdStatus
+                            , (FcnClosure Val * IdStatus) VIdMap
+                            ) Str' StrIdMap
+                          * (FcnClosure Val * IdStatus) VIdMap TyConMap 
+                          * (FcnClosure Val * IdStatus) VIdMap
+                          )
+                        * (*ValEnv*) (FcnClosure Val * IdStatus) VIdMap
 
     type ValStr = FcnClosure Val * IdStatus
-    type ValEnv = ValStr VIdMap				(* [VE] *)
+    type ValEnv = ValStr VIdMap                         (* [VE] *)
 
     type TyStr  = ValEnv
-    type TyEnv  = TyStr TyConMap			(* [TE] *)
+    type TyEnv  = TyStr TyConMap                        (* [TE] *)
 
     type Str    = (ValStr, TyStr) Str'
-    type StrEnv = Str StrIdMap				(* [SE] *)
+    type StrEnv = Str StrIdMap                          (* [SE] *)
 
-    type Env    = StrEnv * TyEnv * ValEnv		(* [E] *)
+    type Env    = StrEnv * TyEnv * ValEnv               (* [E] *)
 
 
     (* Operations *)
 
-    val Rec:	ValEnv -> ValEnv
+    val Rec:    ValEnv -> ValEnv
 
   end
 (* stop of DYNAMIC_ENV.sml *)
@@ -5730,28 +5730,28 @@
     (* Export types [Section 6.6] *)
 
     datatype FcnClosure =
-	     FcnClosure of Match * ((*Env*) StrEnv * TyEnv * ValEnv) * ValEnv
+             FcnClosure of Match * ((*Env*) StrEnv * TyEnv * ValEnv) * ValEnv
 
-    withtype ValEnv = (FcnClosure Val * IdStatus) VIdMap	  (* [VE] *)
+    withtype ValEnv = (FcnClosure Val * IdStatus) VIdMap          (* [VE] *)
     and      TyEnv  = (FcnClosure Val * IdStatus) VIdMap TyConMap (* [TE] *)
     and      StrEnv = (FcnClosure Val * IdStatus,
-		       (FcnClosure Val * IdStatus) VIdMap) Str' StrIdMap
-    								  (* [SE] *)
+                       (FcnClosure Val * IdStatus) VIdMap) Str' StrIdMap
+                                                                  (* [SE] *)
     type ValStr = FcnClosure Val * IdStatus
     type TyStr  = ValEnv
     type Str    = (ValStr, TyStr) Str'
 
-    type Env    = StrEnv * TyEnv * ValEnv			  (* [E] *)
+    type Env    = StrEnv * TyEnv * ValEnv                         (* [E] *)
 
 
     (* Unrolling [Section 6.6] *)
 
     fun Rec VE =
-	    VIdMap.map
-		(fn (Val.FcnClosure(FcnClosure(match',E',VE')), IdStatus.v) =>
-		    (Val.FcnClosure(FcnClosure(match',E',VE)), IdStatus.v)
-		  | valstr => valstr
-		) VE
+            VIdMap.map
+                (fn (Val.FcnClosure(FcnClosure(match',E',VE')), IdStatus.v) =>
+                    (Val.FcnClosure(FcnClosure(match',E',VE)), IdStatus.v)
+                  | valstr => valstr
+                ) VE
 
   end
 (* stop of DynamicEnv.sml *)
@@ -5875,14 +5875,14 @@
 
     val VEUnit   = VIdMap.empty
     val VEBool   = VIdMap.fromList[(vidFalse, valstrFalse),
-				   (vidTrue,  valstrTrue)] : ValEnv
+                                   (vidTrue,  valstrTrue)] : ValEnv
     val VEInt    = VIdMap.empty
     val VEWord   = VIdMap.empty
     val VEReal   = VIdMap.empty
     val VEString = VIdMap.empty
     val VEChar   = VIdMap.empty
     val VEList   = VIdMap.fromList[(vidNil,   valstrNil),
-				   (vidCons,  valstrCons)] : ValEnv
+                                   (vidCons,  valstrCons)] : ValEnv
     val VERef    = VIdMap.fromList[(vidRef,   valstrRef)] : ValEnv
     val VEExn    = VIdMap.empty
 
@@ -5892,25 +5892,25 @@
     val SE0 = StrIdMap.empty
 
     val TE0 = TyConMap.fromList[(tyconUnit,   VEUnit),
- 				(tyconBool,   VEBool),
- 				(tyconInt,    VEInt),
- 				(tyconWord,   VEWord),
- 				(tyconReal,   VEReal),
- 				(tyconString, VEString),
- 				(tyconChar,   VEChar),
- 				(tyconList,   VEList),
- 				(tyconRef,    VERef),
- 				(tyconExn,    VEExn)]
+                                (tyconBool,   VEBool),
+                                (tyconInt,    VEInt),
+                                (tyconWord,   VEWord),
+                                (tyconReal,   VEReal),
+                                (tyconString, VEString),
+                                (tyconChar,   VEChar),
+                                (tyconList,   VEList),
+                                (tyconRef,    VERef),
+                                (tyconExn,    VEExn)]
 
     val VE0 = VIdMap.fromList  [(vidEq,     valstrEq),
-				(vidAssign, valstrAssign),
-				(vidRef,    valstrRef),
-				(vidNil,    valstrNil),
-				(vidCons,   valstrCons),
-				(vidFalse,  valstrFalse),
-				(vidTrue,   valstrTrue),
-				(vidMatch,  valstrMatch),
-				(vidBind,   valstrBind)] : ValEnv
+                                (vidAssign, valstrAssign),
+                                (vidRef,    valstrRef),
+                                (vidNil,    valstrNil),
+                                (vidCons,   valstrCons),
+                                (vidFalse,  valstrFalse),
+                                (vidTrue,   valstrTrue),
+                                (vidMatch,  valstrMatch),
+                                (vidBind,   valstrBind)] : ValEnv
 
     val E0 = (SE0,TE0,VE0)
 
@@ -5946,24 +5946,24 @@
 
     (* Export types [Section 7.2] *)
 
-    type ValInt = IdStatus VIdMap				(* [VI] *)
-    type TyInt  = ValInt TyConMap				(* [TI] *)
+    type ValInt = IdStatus VIdMap                               (* [VI] *)
+    type TyInt  = ValInt TyConMap                               (* [TI] *)
 
     type Str    = (IdStatus, ValInt) Str'
-    type StrInt = Str StrIdMap					(* [SI] *)
+    type StrInt = Str StrIdMap                                  (* [SI] *)
  
-    type Int    = StrInt * TyInt * ValInt			(* [I] *)
+    type Int    = StrInt * TyInt * ValInt                       (* [I] *)
 
 
     (* Operations *)
 
-    val fromSI:		StrInt -> Int
-    val fromTI:		TyInt  -> Int
-    val fromVI:		ValInt -> Int
-    val fromVIandTI:	ValInt * TyInt -> Int
+    val fromSI:         StrInt -> Int
+    val fromTI:         TyInt  -> Int
+    val fromVI:         ValInt -> Int
+    val fromVIandTI:    ValInt * TyInt -> Int
 
-    val Inter:		Env -> Int
-    val cutdown:	Env * Int -> Env
+    val Inter:          Env -> Int
+    val cutdown:        Env * Int -> Env
 
   end
 (* stop of INTERFACE.sml *)
@@ -5992,13 +5992,13 @@
 
     (* Export types [Section 7.2] *)
 
-    type ValInt = IdStatus VIdMap				(* [VI] *)
-    type TyInt  = ValInt TyConMap				(* [TI] *)
+    type ValInt = IdStatus VIdMap                               (* [VI] *)
+    type TyInt  = ValInt TyConMap                               (* [TI] *)
 
     type Str    = (IdStatus, ValInt) Str'
-    type StrInt = Str StrIdMap					(* [SI] *)
+    type StrInt = Str StrIdMap                                  (* [SI] *)
  
-    type Int    = StrInt * TyInt * ValInt			(* [I] *)
+    type Int    = StrInt * TyInt * ValInt                       (* [I] *)
 
 
     (* Injections [Section 4.3] *)
@@ -6021,32 +6021,32 @@
     (* Cutting down environments [Section 7.2] *)
 
     fun cutdownVE(VE, VI) =
-	VIdMap.foldli
-	    (fn(vid, is, VE') =>
-		case VIdMap.find(VE, vid)
-		  of SOME(v,is') => VIdMap.insert(VE', vid, (v,is))
-		   | NONE        => VE'
-	    ) VIdMap.empty VI
+        VIdMap.foldli
+            (fn(vid, is, VE') =>
+                case VIdMap.find(VE, vid)
+                  of SOME(v,is') => VIdMap.insert(VE', vid, (v,is))
+                   | NONE        => VE'
+            ) VIdMap.empty VI
 
     fun cutdownTE(TE, TI) =
-	TyConMap.foldli
-	    (fn(tycon, VI', TE') =>
-		case TyConMap.find(TE, tycon)
-		  of SOME VE' => TyConMap.insert(TE', tycon, cutdownVE(VE',VI'))
-		   | NONE     => TE'
-	    ) TyConMap.empty TI
+        TyConMap.foldli
+            (fn(tycon, VI', TE') =>
+                case TyConMap.find(TE, tycon)
+                  of SOME VE' => TyConMap.insert(TE', tycon, cutdownVE(VE',VI'))
+                   | NONE     => TE'
+            ) TyConMap.empty TI
 
     fun cutdownSE(SE, SI) =
-	StrIdMap.foldli
-	    (fn(strid, Str I, SE') =>
-		case StrIdMap.find(SE, strid)
-		  of SOME(DynamicEnv.Str E) =>
-		       StrIdMap.insert(SE', strid, DynamicEnv.Str(cutdown(E,I)))
-		   | NONE => SE'
-	    ) StrIdMap.empty SI
+        StrIdMap.foldli
+            (fn(strid, Str I, SE') =>
+                case StrIdMap.find(SE, strid)
+                  of SOME(DynamicEnv.Str E) =>
+                       StrIdMap.insert(SE', strid, DynamicEnv.Str(cutdown(E,I)))
+                   | NONE => SE'
+            ) StrIdMap.empty SI
 
     and cutdown((SE,TE,VE), (SI,TI,VI)) =
-	( cutdownSE(SE, SI), cutdownTE(TE, TI), cutdownVE(VE, VI) )
+        ( cutdownSE(SE, SI), cutdownTE(TE, TI), cutdownVE(VE, VI) )
 
   end
 (* stop of Interface.sml *)
@@ -6081,35 +6081,35 @@
     (* Types [Section 7.2] *)
 
     datatype FunctorClosure =
-	FunctorClosure of (StrId * Int) * StrExp *
-			(*Basis*) (FunctorClosure FunIdMap * Int SigIdMap * Env)
+        FunctorClosure of (StrId * Int) * StrExp *
+                        (*Basis*) (FunctorClosure FunIdMap * Int SigIdMap * Env)
 
-    type SigEnv   = Int SigIdMap				(* [G] *)
-    type FunEnv   = FunctorClosure FunIdMap			(* [F] *)
+    type SigEnv   = Int SigIdMap                                (* [G] *)
+    type FunEnv   = FunctorClosure FunIdMap                     (* [F] *)
 
-    type Basis    = FunEnv * SigEnv * Env			(* [B] *)
+    type Basis    = FunEnv * SigEnv * Env                       (* [B] *)
 
 
     (* Operations *)
 
-    val empty:		Basis
-    val fromE:		Env    -> Basis
-    val fromF:		FunEnv -> Basis
-    val fromG:		SigEnv -> Basis
+    val empty:          Basis
+    val fromE:          Env    -> Basis
+    val fromF:          FunEnv -> Basis
+    val fromG:          SigEnv -> Basis
 
-    val Eof:		Basis    -> Env
+    val Eof:            Basis    -> Env
 
-    val plus:		Basis * Basis     -> Basis
-    val plusSE:		Basis * StrEnv    -> Basis
-    val plusG:		Basis * SigEnv    -> Basis
-    val plusF:		Basis * FunEnv    -> Basis
-    val plusE:		Basis * Env       -> Basis
+    val plus:           Basis * Basis     -> Basis
+    val plusSE:         Basis * StrEnv    -> Basis
+    val plusG:          Basis * SigEnv    -> Basis
+    val plusF:          Basis * FunEnv    -> Basis
+    val plusE:          Basis * Env       -> Basis
 
-    val findStrId:	Basis * StrId     -> Str option
-    val findSigId:	Basis * SigId     -> Int option
-    val findFunId:	Basis * FunId     -> FunctorClosure option
-    val findLongStrId:	Basis * longStrId -> Str option
-    val findLongTyCon:	Basis * longTyCon -> ValEnv option
+    val findStrId:      Basis * StrId     -> Str option
+    val findSigId:      Basis * SigId     -> Int option
+    val findFunId:      Basis * FunId     -> FunctorClosure option
+    val findLongStrId:  Basis * longStrId -> Str option
+    val findLongTyCon:  Basis * longTyCon -> ValEnv option
  
   end
 (* stop of DYNAMIC_BASIS.sml *)
@@ -6145,13 +6145,13 @@
     (* Types [Section 7.2] *)
 
     datatype FunctorClosure =
-	FunctorClosure of (StrId * Int) * StrExp *
-			  (*Basis*) (FunEnv * SigEnv * Env)
+        FunctorClosure of (StrId * Int) * StrExp *
+                          (*Basis*) (FunEnv * SigEnv * Env)
 
-    withtype SigEnv   = Int SigIdMap				(* [G] *)
-    and      FunEnv   = FunctorClosure FunIdMap			(* [F] *)
+    withtype SigEnv   = Int SigIdMap                            (* [G] *)
+    and      FunEnv   = FunctorClosure FunIdMap                 (* [F] *)
 
-    type     Basis    = FunEnv * SigEnv * Env			(* [B] *)
+    type     Basis    = FunEnv * SigEnv * Env                   (* [B] *)
 
 
 
@@ -6174,10 +6174,10 @@
     infix plus plusG plusF plusE plusSE IBplusI
 
     fun (F,G,E) plus (F',G',E') =
-	( FunIdMap.unionWith #2 (F,F')
-	, SigIdMap.unionWith #2 (G,G')
-	, DynamicEnv.plus(E,E')
-	)
+        ( FunIdMap.unionWith #2 (F,F')
+        , SigIdMap.unionWith #2 (G,G')
+        , DynamicEnv.plus(E,E')
+        )
 
     fun (F,G,E) plusG  G' = ( F, SigIdMap.unionWith #2 (G,G'), E )
     fun (F,G,E) plusF  F' = ( FunIdMap.unionWith #2 (F,F'), G, E )
@@ -6191,9 +6191,9 @@
     fun findSigId((F,G,E), sigid) = SigIdMap.find(G, sigid)
     fun findFunId((F,G,E), funid) = FunIdMap.find(F, funid)
     fun findLongStrId((F,G,E), longstrid) =
-	DynamicEnv.findLongStrId(E, longstrid)
+        DynamicEnv.findLongStrId(E, longstrid)
     fun findLongTyCon((F,G,E), longtycon) =
-	DynamicEnv.findLongTyCon(E, longtycon)
+        DynamicEnv.findLongTyCon(E, longtycon)
 
   end
 (* stop of DynamicBasis.sml *)
@@ -6303,13 +6303,13 @@
     (* Helper *)
 
     fun print((pos1,pos2), message) =
-	let
-	    val a = Int.toString pos1
-	    val b = Int.toString pos2
-	in
-	    TextIO.output(TextIO.stdErr, a ^ "-" ^ b ^ ": " ^ message ^ "\n")
-	  ; TextIO.flushOut TextIO.stdErr
-	end
+        let
+            val a = Int.toString pos1
+            val b = Int.toString pos2
+        in
+            TextIO.output(TextIO.stdErr, a ^ "-" ^ b ^ ": " ^ message ^ "\n")
+          ; TextIO.flushOut TextIO.stdErr
+        end
 
 
     (* Export *)
@@ -6317,12 +6317,12 @@
     exception Error of position * string
 
     fun error(pos, message) =
-	( print(pos, message)
-	; raise Error(pos, message)
-	)
+        ( print(pos, message)
+        ; raise Error(pos, message)
+        )
 
     fun warning(pos, message) =
-	print(pos, "warning: " ^ message)
+        print(pos, "warning: " ^ message)
 
   end
 (* stop of Error.sml *)
@@ -6355,18 +6355,18 @@
     datatype Assoc = LEFT | RIGHT
 
     type InfStatus = Assoc * int
-    type InfEnv    = InfStatus VIdMap.map	(* [J] *)
+    type InfEnv    = InfStatus VIdMap.map       (* [J] *)
 
-    val empty:		InfEnv
-    val assign:		InfEnv * VId list * InfStatus -> InfEnv
-    val cancel:		InfEnv * VId list -> InfEnv
+    val empty:          InfEnv
+    val assign:         InfEnv * VId list * InfStatus -> InfEnv
+    val cancel:         InfEnv * VId list -> InfEnv
 
 
     (* Resolving phrases containing infixed identifiers *)
 
-    val parseExp:	InfEnv * AtExp list -> Exp
-    val parsePat:	InfEnv * AtPat list -> Pat
-    val parseFmrule:	InfEnv * AtPat list -> Op * VId * AtPat list
+    val parseExp:       InfEnv * AtExp list -> Exp
+    val parsePat:       InfEnv * AtPat list -> Pat
+    val parseFmrule:    InfEnv * AtPat list -> Op * VId * AtPat list
 
   end
 (* stop of INFIX.sml *)
@@ -6392,7 +6392,7 @@
 
     type InfStatus = Assoc * int
 
-    type InfEnv    = InfStatus VIdMap.map		(* [J] *)
+    type InfEnv    = InfStatus VIdMap.map               (* [J] *)
 
 
 
@@ -6401,56 +6401,56 @@
     val empty = VIdMap.empty
 
     fun assign(J, vids, infstatus) =
-	let
-	    fun insert(vid, J) = VIdMap.insert(J, vid, infstatus)
-	in
-	    List.foldl insert J vids
-	end
+        let
+            fun insert(vid, J) = VIdMap.insert(J, vid, infstatus)
+        in
+            List.foldl insert J vids
+        end
 
     fun cancel(J, vids) =
-	let
-	    fun remove(vid, J) = #1(VIdMap.remove(J, vid))
-	in
-	    List.foldl remove J vids
-	end
+        let
+            fun remove(vid, J) = #1(VIdMap.remove(J, vid))
+        in
+            List.foldl remove J vids
+        end
 
 
 
     (* Helpers for error messages *)
 
-    val error				= Error.error
-    fun errorVId(I, s, vid)		= error(I, s ^ VId.toString vid)
-    fun errorLongVId(I, s, longvid)	= error(I, s ^ LongVId.toString longvid)
+    val error                           = Error.error
+    fun errorVId(I, s, vid)             = error(I, s ^ VId.toString vid)
+    fun errorLongVId(I, s, longvid)     = error(I, s ^ LongVId.toString longvid)
 
 
 
     (* Categorisation of atomic expressions and patterns *)
 
     datatype 'a FixityCategory = NONFIX of 'a
-			       | INFIX  of InfStatus * VId * Info
+                               | INFIX  of InfStatus * VId * Info
 
     fun isInfix J (longvid) =
-	LongVId.isUnqualified longvid andalso
-	VIdMap.find(J, LongVId.toId longvid) <> NONE
+        LongVId.isUnqualified longvid andalso
+        VIdMap.find(J, LongVId.toId longvid) <> NONE
 
     fun categoriseLongVId J (atomic, I, longvid) =
-	if LongVId.isUnqualified longvid then
-	    let
-		val vid = LongVId.toId longvid
-	    in
-		case VIdMap.find(J, vid)
-		  of NONE           => NONFIX(atomic)
-		   | SOME infstatus => INFIX(infstatus, vid, I)
-	    end
-	else
-	    NONFIX(atomic)
+        if LongVId.isUnqualified longvid then
+            let
+                val vid = LongVId.toId longvid
+            in
+                case VIdMap.find(J, vid)
+                  of NONE           => NONFIX(atomic)
+                   | SOME infstatus => INFIX(infstatus, vid, I)
+            end
+        else
+            NONFIX(atomic)
 
     fun categoriseAtExp J (atexp as LONGVIDAtExp(I, SANSOp, longvid)) =
-	    categoriseLongVId J (atexp, I, longvid)
+            categoriseLongVId J (atexp, I, longvid)
       | categoriseAtExp J (atexp) = NONFIX(atexp)
 
     fun categoriseAtPat J (atpat as LONGVIDAtPat(I, SANSOp, longvid)) =
-	    categoriseLongVId J (atpat, I, longvid)
+            categoriseLongVId J (atpat, I, longvid)
       | categoriseAtPat J (atpat) = NONFIX(atpat)
 
 
@@ -6458,55 +6458,55 @@
     (* Resolving infixing [Section 2.6] *)
 
     fun parse(app, infapp, es) =
-	let
-	    fun loop(NONFIX(e)::[], []) = e
+        let
+            fun loop(NONFIX(e)::[], []) = e
 
-	      | loop(NONFIX(e2)::NONFIX(e1)::s', i) =
-		    (* reduce nonfix application *)
-		    loop(NONFIX(app(e1, e2))::s', i)
+              | loop(NONFIX(e2)::NONFIX(e1)::s', i) =
+                    (* reduce nonfix application *)
+                    loop(NONFIX(app(e1, e2))::s', i)
 
-	      | loop(s, NONFIX(e)::i') =
-		    (* shift *)
-		    loop(NONFIX(e)::s, i')
+              | loop(s, NONFIX(e)::i') =
+                    (* shift *)
+                    loop(NONFIX(e)::s, i')
 
-	      | loop(s as NONFIX(e)::[], INFIX(x)::i') =
-		    (* shift *)
-		    loop(INFIX(x)::s, i')
+              | loop(s as NONFIX(e)::[], INFIX(x)::i') =
+                    (* shift *)
+                    loop(INFIX(x)::s, i')
 
-	      | loop(NONFIX(e2)::INFIX(_,vid,_)::NONFIX(e1)::s', []) =
-		    (* reduce infix application *)
-		    loop(NONFIX(infapp(e1, vid, e2))::s', [])
+              | loop(NONFIX(e2)::INFIX(_,vid,_)::NONFIX(e1)::s', []) =
+                    (* reduce infix application *)
+                    loop(NONFIX(infapp(e1, vid, e2))::s', [])
 
-	      | loop(s as NONFIX(e2)::INFIX((a1,p1),vid1,I1)::NONFIX(e1)::s',
-		       i as INFIX(x2 as ((a2,p2),vid2,I2))::i') =
-		if p1 > p2 then
-		    (* reduce infix application *)
-		    loop(NONFIX(infapp(e1, vid1, e2))::s', i)
-		else if p1 < p2 then
-		    (* shift *)
-		    loop(INFIX(x2)::s, i')
-		else if a1 <> a2 then
-		    error(Source.over(I1,I2), "conflicting infix associativity")
-		else if a1 = LEFT then
-		    (* reduce infix application *)
-		    loop(NONFIX(infapp(e1, vid1, e2))::s', i)
-		else (* a1 = RIGHT *)
-		    (* shift *)
-		    loop(INFIX(x2)::s, i')
+              | loop(s as NONFIX(e2)::INFIX((a1,p1),vid1,I1)::NONFIX(e1)::s',
+                       i as INFIX(x2 as ((a2,p2),vid2,I2))::i') =
+                if p1 > p2 then
+                    (* reduce infix application *)
+                    loop(NONFIX(infapp(e1, vid1, e2))::s', i)
+                else if p1 < p2 then
+                    (* shift *)
+                    loop(INFIX(x2)::s, i')
+                else if a1 <> a2 then
+                    error(Source.over(I1,I2), "conflicting infix associativity")
+                else if a1 = LEFT then
+                    (* reduce infix application *)
+                    loop(NONFIX(infapp(e1, vid1, e2))::s', i)
+                else (* a1 = RIGHT *)
+                    (* shift *)
+                    loop(INFIX(x2)::s, i')
 
-	      | loop(INFIX(_, vid, I)::s, []) =
-		    errorVId(I, "misplaced infix identifier ", vid)
+              | loop(INFIX(_, vid, I)::s, []) =
+                    errorVId(I, "misplaced infix identifier ", vid)
 
-	      | loop(INFIX(x)::s, INFIX(_, vid, I)::i) =
-		    errorVId(I, "misplaced infix identifier ", vid)
+              | loop(INFIX(x)::s, INFIX(_, vid, I)::i) =
+                    errorVId(I, "misplaced infix identifier ", vid)
 
-	      | loop([], INFIX(_, vid, I)::i) =
-		    errorVId(I, "misplaced infix identifier ", vid)
+              | loop([], INFIX(_, vid, I)::i) =
+                    errorVId(I, "misplaced infix identifier ", vid)
 
-	      | loop _ = raise Fail "Infix.parse: inconsistency"
-	in
-	    loop([], es)
-	end
+              | loop _ = raise Fail "Infix.parse: inconsistency"
+        in
+            loop([], es)
+        end
 
 
     (* Resolving infixed expressions [Section 2.6] *)
@@ -6515,44 +6515,44 @@
       | atexpExp atexp             = ATEXPExp(infoAtExp atexp, atexp)
 
     fun appExp(atexp1, atexp2) =
-	let
-	    val I1 = infoAtExp atexp1
-	    val I2 = infoAtExp atexp2
-	    val I  = Source.over(I1, I2)
-	in
-	    PARAtExp(I, APPExp(I, atexpExp atexp1, atexp2))
-	end
+        let
+            val I1 = infoAtExp atexp1
+            val I2 = infoAtExp atexp2
+            val I  = Source.over(I1, I2)
+        in
+            PARAtExp(I, APPExp(I, atexpExp atexp1, atexp2))
+        end
 
     fun pairExp(atexp1, atexp2) =
-	let
-	    val I1	= infoAtExp atexp1
-	    val I2	= infoAtExp atexp2
-	    val lab1	= Lab.fromInt 1
-	    val lab2	= Lab.fromInt 2
-	    val exprow2	= ExpRow(I2, lab2, atexpExp atexp2, NONE)
-	    val exprow1	= ExpRow(I1, lab1, atexpExp atexp1, SOME exprow2)
-	in
-	    RECORDAtExp(Source.over(I1,I2), SOME exprow1)
-	end
+        let
+            val I1      = infoAtExp atexp1
+            val I2      = infoAtExp atexp2
+            val lab1    = Lab.fromInt 1
+            val lab2    = Lab.fromInt 2
+            val exprow2 = ExpRow(I2, lab2, atexpExp atexp2, NONE)
+            val exprow1 = ExpRow(I1, lab1, atexpExp atexp1, SOME exprow2)
+        in
+            RECORDAtExp(Source.over(I1,I2), SOME exprow1)
+        end
 
     fun infappExp(atexp1, vid, atexp2) =
-	let
-	    val Ivid	= Source.between(infoAtExp atexp1, infoAtExp atexp2)
-	    val longvid	= LongVId.fromId vid
-	    val atexp1'	= LONGVIDAtExp(Ivid, SANSOp, longvid)
-	    val atexp2'	= pairExp(atexp1, atexp2)
-	in
-	    appExp(atexp1', atexp2')
-	end
+        let
+            val Ivid    = Source.between(infoAtExp atexp1, infoAtExp atexp2)
+            val longvid = LongVId.fromId vid
+            val atexp1' = LONGVIDAtExp(Ivid, SANSOp, longvid)
+            val atexp2' = pairExp(atexp1, atexp2)
+        in
+            appExp(atexp1', atexp2')
+        end
 
 
     fun parseExp(J, atexps) =
-	let
-	    val atexp = parse(appExp, infappExp,
-			      List.map (categoriseAtExp J) atexps)
-	in
-	    atexpExp atexp
-	end
+        let
+            val atexp = parse(appExp, infappExp,
+                              List.map (categoriseAtExp J) atexps)
+        in
+            atexpExp atexp
+        end
 
 
     (* Resolving infixed patterns [Section 2.6] *)
@@ -6561,115 +6561,115 @@
       | atpatPat atpat             = ATPATPat(infoAtPat atpat, atpat)
 
     fun conPat(LONGVIDAtPat(I1, op_opt, longvid), atpat) =
-	let
-	    val I2 = infoAtPat atpat
-	    val I  = Source.over(I1, I2)
-	in
-	    PARAtPat(I, CONPat(I, op_opt, longvid, atpat))
-	end
+        let
+            val I2 = infoAtPat atpat
+            val I  = Source.over(I1, I2)
+        in
+            PARAtPat(I, CONPat(I, op_opt, longvid, atpat))
+        end
 
       | conPat(_, atpat) =
-	    error(infoAtPat atpat, "misplaced atomic pattern")
+            error(infoAtPat atpat, "misplaced atomic pattern")
 
     fun pairPat(atpat1, atpat2) =
-	let
-	    val I1	= infoAtPat atpat1
-	    val I2	= infoAtPat atpat2
-	    val lab1	= Lab.fromInt 1
-	    val lab2	= Lab.fromInt 2
-	    val patrow2	= ROWPatRow(I2, lab2, atpatPat atpat2, NONE)
-	    val patrow1	= ROWPatRow(I1, lab1, atpatPat atpat1, SOME patrow2)
-	in
-	    RECORDAtPat(Source.over(I1,I2), SOME patrow1)
-	end
+        let
+            val I1      = infoAtPat atpat1
+            val I2      = infoAtPat atpat2
+            val lab1    = Lab.fromInt 1
+            val lab2    = Lab.fromInt 2
+            val patrow2 = ROWPatRow(I2, lab2, atpatPat atpat2, NONE)
+            val patrow1 = ROWPatRow(I1, lab1, atpatPat atpat1, SOME patrow2)
+        in
+            RECORDAtPat(Source.over(I1,I2), SOME patrow1)
+        end
 
     fun infconPat(atpat1, vid, atpat2) =
-	let
-	    val Ivid	= Source.between(infoAtPat atpat1, infoAtPat atpat2)
-	    val longvid	= LongVId.fromId vid
-	    val atpat1'	= LONGVIDAtPat(Ivid, SANSOp, longvid)
-	    val atpat2'	= pairPat(atpat1, atpat2)
-	in
-	    conPat(atpat1', atpat2')
-	end
+        let
+            val Ivid    = Source.between(infoAtPat atpat1, infoAtPat atpat2)
+            val longvid = LongVId.fromId vid
+            val atpat1' = LONGVIDAtPat(Ivid, SANSOp, longvid)
+            val atpat2' = pairPat(atpat1, atpat2)
+        in
+            conPat(atpat1', atpat2')
+        end
 
 
     fun parsePat(J, atpats) =
-	let
-	    val atpat = parse(conPat, infconPat,
-			      List.map (categoriseAtPat J) atpats)
-	in
-	    atpatPat atpat
-	end
+        let
+            val atpat = parse(conPat, infconPat,
+                              List.map (categoriseAtPat J) atpats)
+        in
+            atpatPat atpat
+        end
 
 
     (* Resolving fun match rules [Figure 21, note] *)
 
     fun parseFmrule(J, atpats) =
-	(*
-	 * Allowed is the following:
-	 * (1) <op> vid atpat+
-	 * (2) (atpat infix_vid atpat) atpat*
-	 * (3) atpat infix_vid atpat
-	 *)
-	let
-	    fun checkNonfixity []           = true
-	      | checkNonfixity(NONFIX _::t) = checkNonfixity t
-	      | checkNonfixity(INFIX(_, vid, I)::t) =
-		    errorVId(I, "misplaced infix identifier ", vid)
+        (*
+         * Allowed is the following:
+         * (1) <op> vid atpat+
+         * (2) (atpat infix_vid atpat) atpat*
+         * (3) atpat infix_vid atpat
+         *)
+        let
+            fun checkNonfixity []           = true
+              | checkNonfixity(NONFIX _::t) = checkNonfixity t
+              | checkNonfixity(INFIX(_, vid, I)::t) =
+                    errorVId(I, "misplaced infix identifier ", vid)
 
-	    fun maybeNonfixClause(ps) =
-		case List.hd atpats
-		  of LONGVIDAtPat(I, op_opt, longvid) =>
-			if not(LongVId.isUnqualified longvid) then
-			    errorLongVId(I, "misplaced long identifier ",
-					 longvid)
-			else if List.length atpats < 2 then
-			    error(I, "missing function arguments")
-			else
-			    ( checkNonfixity ps	(* including 1st *)
-			    ; ( op_opt, LongVId.toId longvid, List.tl atpats )
-			    )
-		   | WILDCARDAtPat(I) =>
-			error(I, "misplaced wildcard pattern")
-		   | SCONAtPat(I, _) =>
-			error(I, "misplaced constant pattern")
-		   | RECORDAtPat(I, _) =>
-			error(I, "misplaced record or tuple pattern")
-		   | PARAtPat(I, _) =>
-			error(I, "misplaced parenthesised pattern")
+            fun maybeNonfixClause(ps) =
+                case List.hd atpats
+                  of LONGVIDAtPat(I, op_opt, longvid) =>
+                        if not(LongVId.isUnqualified longvid) then
+                            errorLongVId(I, "misplaced long identifier ",
+                                         longvid)
+                        else if List.length atpats < 2 then
+                            error(I, "missing function arguments")
+                        else
+                            ( checkNonfixity ps (* including 1st *)
+                            ; ( op_opt, LongVId.toId longvid, List.tl atpats )
+                            )
+                   | WILDCARDAtPat(I) =>
+                        error(I, "misplaced wildcard pattern")
+                   | SCONAtPat(I, _) =>
+                        error(I, "misplaced constant pattern")
+                   | RECORDAtPat(I, _) =>
+                        error(I, "misplaced record or tuple pattern")
+                   | PARAtPat(I, _) =>
+                        error(I, "misplaced parenthesised pattern")
 
-	    fun maybeParenthesisedInfixClause(ps) =
-	        case List.hd ps
-		  of NONFIX(PARAtPat(_, CONPat(I, SANSOp, longvid, atpat))) =>
-			if not(LongVId.isUnqualified longvid) then
-			    errorLongVId(I, "misplaced long identifier ",
-					 longvid)
-			else if not(isInfix J longvid) then
-			    error(I, "misplaced non-infix pattern")
-			else
-			    (* Now, longvid has infix status but is sans `op',
-			       so it can only result from resolving an
-			       appropriate infix construction. *)
-			    ( checkNonfixity(List.tl ps)
-			    ; ( SANSOp, LongVId.toId longvid,
-				atpat::List.tl atpats )
-			    )
+            fun maybeParenthesisedInfixClause(ps) =
+                case List.hd ps
+                  of NONFIX(PARAtPat(_, CONPat(I, SANSOp, longvid, atpat))) =>
+                        if not(LongVId.isUnqualified longvid) then
+                            errorLongVId(I, "misplaced long identifier ",
+                                         longvid)
+                        else if not(isInfix J longvid) then
+                            error(I, "misplaced non-infix pattern")
+                        else
+                            (* Now, longvid has infix status but is sans `op',
+                               so it can only result from resolving an
+                               appropriate infix construction. *)
+                            ( checkNonfixity(List.tl ps)
+                            ; ( SANSOp, LongVId.toId longvid,
+                                atpat::List.tl atpats )
+                            )
 
-	           | NONFIX(PARAtPat(_, pat)) =>
-			error(infoPat pat, "misplaced non-infix pattern")
+                   | NONFIX(PARAtPat(_, pat)) =>
+                        error(infoPat pat, "misplaced non-infix pattern")
 
-	 	   | _ => maybeNonfixClause(ps)
+                   | _ => maybeNonfixClause(ps)
 
-	    fun maybePlainInfixClause(ps) =
-	        case ps
-	          of [NONFIX atpat1, INFIX(_, vid, I), NONFIX atpat2] =>
-			 ( SANSOp, vid, pairPat(atpat1, atpat2)::[] )
+            fun maybePlainInfixClause(ps) =
+                case ps
+                  of [NONFIX atpat1, INFIX(_, vid, I), NONFIX atpat2] =>
+                         ( SANSOp, vid, pairPat(atpat1, atpat2)::[] )
 
-		   | _ => maybeParenthesisedInfixClause(ps)
-	in
-	    maybePlainInfixClause(List.map (categoriseAtPat J) atpats)
-	end
+                   | _ => maybeParenthesisedInfixClause(ps)
+        in
+            maybePlainInfixClause(List.map (categoriseAtPat J) atpats)
+        end
 
   end
 (* stop of Infix.sml *)
@@ -6716,8 +6716,8 @@
     (* Export *)
 
     val J0 = VIdMap.fromList[(vidCons,   (Infix.RIGHT, 5)),
-			     (vidEqual,  (Infix.LEFT,  4)),
-			     (vidAssign, (Infix.LEFT,  3))]
+                             (vidEqual,  (Infix.LEFT,  4)),
+                             (vidAssign, (Infix.LEFT,  3))]
   end
 (* stop of InitialInfixEnv.sml *)
 (* start of BASIS.sml *)
@@ -6732,20 +6732,20 @@
 
     (* Import types *)
 
-    type StaticBasis  = StaticBasis.Basis		(* [B_STAT] *)
-    type DynamicBasis = DynamicBasis.Basis		(* [B_DYN] *)
+    type StaticBasis  = StaticBasis.Basis               (* [B_STAT] *)
+    type DynamicBasis = DynamicBasis.Basis              (* [B_DYN] *)
 
     (* Type [Section 8] *)
 
-    type Basis = StaticBasis * DynamicBasis		(* [B] *)
+    type Basis = StaticBasis * DynamicBasis             (* [B] *)
 
 
     (* Operations *)
 
-    val B_STATof:	Basis -> StaticBasis
-    val B_DYNof:	Basis -> DynamicBasis
+    val B_STATof:       Basis -> StaticBasis
+    val B_DYNof:        Basis -> DynamicBasis
 
-    val oplus:		Basis * Basis -> Basis
+    val oplus:          Basis * Basis -> Basis
 
   end
 (* stop of BASIS.sml *)
@@ -6761,12 +6761,12 @@
 
     (* Import types *)
 
-    type StaticBasis  = StaticBasis.Basis		(* [B_STAT] *)
-    type DynamicBasis = DynamicBasis.Basis		(* [B_DYN] *)
+    type StaticBasis  = StaticBasis.Basis               (* [B_STAT] *)
+    type DynamicBasis = DynamicBasis.Basis              (* [B_DYN] *)
 
     (* Type [Section 8] *)
 
-    type Basis = StaticBasis * DynamicBasis		(* [B] *)
+    type Basis = StaticBasis * DynamicBasis             (* [B] *)
 
 
     (* Projections *)
@@ -6780,9 +6780,9 @@
     infix oplus
 
     fun (B_STAT,B_DYN) oplus (B_STAT',B_DYN') =
-	    ( StaticBasis.plus(B_STAT, B_STAT')
-	    , DynamicBasis.plus(B_DYN, B_DYN')
-	    )
+            ( StaticBasis.plus(B_STAT, B_STAT')
+            , DynamicBasis.plus(B_DYN, B_DYN')
+            )
 
   end
 (* stop of Basis.sml *)
@@ -6805,7 +6805,7 @@
 
     (* Definitions [Section 6.2] *)
 
-    type Pack = FcnClosure ExVal			(* [p] *)
+    type Pack = FcnClosure ExVal                        (* [p] *)
 
     exception Pack of Pack
 
@@ -6830,7 +6830,7 @@
 
     (* Definitions [Section 6.2] *)
 
-    type Pack = FcnClosure ExVal			(* [p] *)
+    type Pack = FcnClosure ExVal                        (* [p] *)
 
     exception Pack of Pack
 
@@ -6894,10 +6894,10 @@
     exception TypeError
 
     fun APPLY("=", v) =
-	(case Val.unpair v
-	   of SOME vv => Val.toBoolVal(Val.equal vv)
-	    | NONE    => raise TypeError
-	)
+        (case Val.unpair v
+           of SOME vv => Val.toBoolVal(Val.equal vv)
+            | NONE    => raise TypeError
+        )
       | APPLY _ = raise Fail "BasVal.APPLY: unknown basic value"
 
   end
@@ -6971,9 +6971,9 @@
     fun errorLab(I, s, lab)         = error(I, s ^ Lab.toString lab)
     fun errorLongVId(I, s, longvid) = error(I, s ^ LongVId.toString longvid)
     fun errorLongTyCon(I, s, longtycon) =
-	    error(I, s ^ LongTyCon.toString longtycon)
+            error(I, s ^ LongTyCon.toString longtycon)
     fun errorLongStrId(I, s, longstrid) =
-	    error(I, s ^ LongStrId.toString longstrid)
+            error(I, s ^ LongStrId.toString longstrid)
 
 
     (* Helpers for environment modification *)
@@ -7004,579 +7004,579 @@
     (* Atomic Expressions *)
 
     fun evalAtExp(s,E, SCONAtExp(I, scon)) =
-	(* [Rule 90] *)
-	valSCon scon
+        (* [Rule 90] *)
+        valSCon scon
 
       | evalAtExp(s,E, LONGVIDAtExp(I, _, longvid)) =
-	(* [Rule 91] *)
-	let
-	    val (v,is) = case DynamicEnv.findLongVId(E, longvid)
-			   of SOME valstr => valstr
-			    | NONE =>
-			      errorLongVId(I, "runtime error: \
-					      \unknown identifier ", longvid)
-	in
-	    v
-	end
+        (* [Rule 91] *)
+        let
+            val (v,is) = case DynamicEnv.findLongVId(E, longvid)
+                           of SOME valstr => valstr
+                            | NONE =>
+                              errorLongVId(I, "runtime error: \
+                                              \unknown identifier ", longvid)
+        in
+            v
+        end
 
       | evalAtExp(s,E, RECORDAtExp(I, exprow_opt)) =
-	(* [Rule 92] *)
-	let
-	    val r = case exprow_opt
-		      of NONE        => LabMap.empty
-		       | SOME exprow => evalExpRow(s,E, exprow)
-	in
-	    Val.Record r
-	end
+        (* [Rule 92] *)
+        let
+            val r = case exprow_opt
+                      of NONE        => LabMap.empty
+                       | SOME exprow => evalExpRow(s,E, exprow)
+        in
+            Val.Record r
+        end
 
       | evalAtExp(s,E, LETAtExp(I, dec, exp)) =
-	(* [Rule 93] *)
-	let
-	    val E' = evalDec(s,E, dec)
-	    val v  = evalExp(s,E plus E', exp)
-	in
-	    v
-	end
+        (* [Rule 93] *)
+        let
+            val E' = evalDec(s,E, dec)
+            val v  = evalExp(s,E plus E', exp)
+        in
+            v
+        end
 
       | evalAtExp(s,E, PARAtExp(I, exp)) =
-	(* [Rule 94] *)
-	let
-	    val v = evalExp(s,E, exp)
-	in
-	    v
-	end
+        (* [Rule 94] *)
+        let
+            val v = evalExp(s,E, exp)
+        in
+            v
+        end
 
 
     (* Expression Rows *)
 
     and evalExpRow(s,E, ExpRow(I, lab, exp, exprow_opt)) =
-	(* [Rule 95] *)
-	let
-	    val v = evalExp(s,E, exp)
-	    val r = case exprow_opt
-		      of NONE        => LabMap.empty
-		       | SOME exprow => evalExpRow(s,E, exprow)
-	in
-	    LabMap.insert(r, lab, v)
-	end
+        (* [Rule 95] *)
+        let
+            val v = evalExp(s,E, exp)
+            val r = case exprow_opt
+                      of NONE        => LabMap.empty
+                       | SOME exprow => evalExpRow(s,E, exprow)
+        in
+            LabMap.insert(r, lab, v)
+        end
 
 
     (* Expressions *)
 
     and evalExp(s,E, ATEXPExp(I, atexp)) =
-	(* [Rule 96] *)
-	let
-	    val v = evalAtExp(s,E, atexp)
-	in
-	    v
-	end
+        (* [Rule 96] *)
+        let
+            val v = evalAtExp(s,E, atexp)
+        in
+            v
+        end
 
       | evalExp(s,E, APPExp(I, exp, atexp)) =
-	(* [Rules 97 to 103] *)
-	let
-	    val v1 = evalExp(s,E, exp)
-	    val v  = evalAtExp(s,E, atexp)
-	in
-	    case v1
-	      of Val.VId vid =>
-		 if vid = VId.fromString "ref" then
-		     (* [Rule 99] *)
-		     let
-		         val a = Addr.addr()
-		     in
-			  s := State.insertAddr(!s, a, v)
-			; Val.Addr a
-		     end
-		 else
-		     (* [Rule 97] *)
-		     Val.VIdVal (vid,v)
+        (* [Rules 97 to 103] *)
+        let
+            val v1 = evalExp(s,E, exp)
+            val v  = evalAtExp(s,E, atexp)
+        in
+            case v1
+              of Val.VId vid =>
+                 if vid = VId.fromString "ref" then
+                     (* [Rule 99] *)
+                     let
+                         val a = Addr.addr()
+                     in
+                          s := State.insertAddr(!s, a, v)
+                        ; Val.Addr a
+                     end
+                 else
+                     (* [Rule 97] *)
+                     Val.VIdVal (vid,v)
 
-	       | Val.ExVal(Val.ExName en) =>
-		 (* [Rule 98] *)
-		 Val.ExVal(Val.ExNameVal(en,v))
+               | Val.ExVal(Val.ExName en) =>
+                 (* [Rule 98] *)
+                 Val.ExVal(Val.ExNameVal(en,v))
 
-	       | Val.:= =>
-		 (* [Rule 100] *)
-		 (case Val.unpair v
-		    of SOME(Val.Addr a, v) =>
-			( s := State.insertAddr(!s, a, v)
-			; Val.Record LabMap.empty
-			)
-		     | _ => error(I, "runtime type error: address expected")
-		 )
+               | Val.:= =>
+                 (* [Rule 100] *)
+                 (case Val.unpair v
+                    of SOME(Val.Addr a, v) =>
+                        ( s := State.insertAddr(!s, a, v)
+                        ; Val.Record LabMap.empty
+                        )
+                     | _ => error(I, "runtime type error: address expected")
+                 )
 
-	       | Val.BasVal b =>
-		 (* [Rule 101] *)
-		 BasVal.APPLY(b, v)
+               | Val.BasVal b =>
+                 (* [Rule 101] *)
+                 BasVal.APPLY(b, v)
 
-	       | Val.FcnClosure(DynamicEnv.FcnClosure(match,E',VE)) =>
-		 (* [Rule 102] *)
-		 (let
-		     val v' = evalMatch(s,E' plusVE DynamicEnv.Rec VE, v, match)
-		  in
-		     v'
-		  end
-		  handle FAIL =>
-		     (* [Rule 103] *)
-		     raise Pack(Val.ExName InitialDynamicEnv.enMatch)
-		 )
-	       | _ =>
-		 error(I, "runtime type error: applicative value expected")
-	end
+               | Val.FcnClosure(DynamicEnv.FcnClosure(match,E',VE)) =>
+                 (* [Rule 102] *)
+                 (let
+                     val v' = evalMatch(s,E' plusVE DynamicEnv.Rec VE, v, match)
+                  in
+                     v'
+                  end
+                  handle FAIL =>
+                     (* [Rule 103] *)
+                     raise Pack(Val.ExName InitialDynamicEnv.enMatch)
+                 )
+               | _ =>
+                 error(I, "runtime type error: applicative value expected")
+        end
 
       | evalExp(s,E, TYPEDExp(I, exp, _)) =
-	(* Omitted [Section 6.1] *)
-	evalExp(s,E, exp)
+        (* Omitted [Section 6.1] *)
+        evalExp(s,E, exp)
 
       | evalExp(s,E, HANDLEExp(I, exp, match)) =
-	(* [Rule 104 to 106] *)
-	(let
-	    val v = evalExp(s,E, exp)
-	 in
-	    (* [Rule 104] *)
-	    v
-	 end
-	 handle Pack.Pack e =>
-	    let
-		val v = evalMatch(s,E,Val.ExVal e, match)
-	    in
-		(* [Rule 105] *)
-		v
-	    end
-	    handle FAIL =>
-		(* [Rule 106] *)
-		raise Pack.Pack e
-	)
+        (* [Rule 104 to 106] *)
+        (let
+            val v = evalExp(s,E, exp)
+         in
+            (* [Rule 104] *)
+            v
+         end
+         handle Pack.Pack e =>
+            let
+                val v = evalMatch(s,E,Val.ExVal e, match)
+            in
+                (* [Rule 105] *)
+                v
+            end
+            handle FAIL =>
+                (* [Rule 106] *)
+                raise Pack.Pack e
+        )
 
       | evalExp(s,E, RAISEExp(I, exp)) =
-	(* [Rule 107] *)
-	let
-	    val e = case evalExp(s,E, exp)
-		      of Val.ExVal e => e
-		       | _ => error(I, "runtime type error: \
-				       \exception value expected")
-	in
-	    raise Pack.Pack e
-	end
+        (* [Rule 107] *)
+        let
+            val e = case evalExp(s,E, exp)
+                      of Val.ExVal e => e
+                       | _ => error(I, "runtime type error: \
+                                       \exception value expected")
+        in
+            raise Pack.Pack e
+        end
 
       | evalExp(s,E, FNExp(I, match)) =
-	(* [Rule 108] *)
-	Val.FcnClosure(DynamicEnv.FcnClosure(match,E,VIdMap.empty))
+        (* [Rule 108] *)
+        Val.FcnClosure(DynamicEnv.FcnClosure(match,E,VIdMap.empty))
 
 
     (* Matches *)
 
     and evalMatch(s,E,v, Match(I, mrule, match_opt)) =
-	(* [Rules 109 to 111] *)
-	let
-	    val v' = evalMrule(s,E,v, mrule)
-	in
-	    (* [Rule 109] *)
-	    v'
-	end
-	handle FAIL =>
-	    case match_opt
-	      of NONE =>
-		 (* [Rule 110] *)
-		 raise FAIL
+        (* [Rules 109 to 111] *)
+        let
+            val v' = evalMrule(s,E,v, mrule)
+        in
+            (* [Rule 109] *)
+            v'
+        end
+        handle FAIL =>
+            case match_opt
+              of NONE =>
+                 (* [Rule 110] *)
+                 raise FAIL
 
-	       | SOME match =>
-		 (* [Rule 111] *)
-		 let
-		     val v' = evalMatch(s,E,v, match)
-		 in
-		     v'
-		 end
+               | SOME match =>
+                 (* [Rule 111] *)
+                 let
+                     val v' = evalMatch(s,E,v, match)
+                 in
+                     v'
+                 end
 
 
     (* Match rules *)
 
     and evalMrule(s,E,v, Mrule(I, pat, exp)) =
-	(* [Rules 112 and 113] *)
-	let
-	    val VE = evalPat(s,E,v, pat)
-	    (* [Rule 112] *)
-	    val v' = evalExp(s,E plusVE VE, exp)
-	in
-	    v'
-	end
-	(* FAIL on evalPat propagates through [Rule 113] *)
+        (* [Rules 112 and 113] *)
+        let
+            val VE = evalPat(s,E,v, pat)
+            (* [Rule 112] *)
+            val v' = evalExp(s,E plusVE VE, exp)
+        in
+            v'
+        end
+        (* FAIL on evalPat propagates through [Rule 113] *)
 
 
     (* Declarations *)
 
     and evalDec(s,E, VALDec(I, tyvarseq, valbind)) =
-	(* [Rule 114] *)
-	let
-	    val VE = evalValBind(s,E, valbind)
-	in
-	    DynamicEnv.fromVE VE
-	end
+        (* [Rule 114] *)
+        let
+            val VE = evalValBind(s,E, valbind)
+        in
+            DynamicEnv.fromVE VE
+        end
 
       | evalDec(s,E, TYPEDec(I, typbind)) =
-	(* [Rule 115] *)
-	let
-	    val TE = evalTypBind(typbind)
-	in
-	    DynamicEnv.fromTE TE
-	end
+        (* [Rule 115] *)
+        let
+            val TE = evalTypBind(typbind)
+        in
+            DynamicEnv.fromTE TE
+        end
 
       | evalDec(s,E, DATATYPEDec(I, datbind)) =
-	(* [Rule 116] *)
-	let
-	    val (VE,TE) = evalDatBind(datbind)
-	in
-	    DynamicEnv.fromVEandTE(VE,TE)
-	end
+        (* [Rule 116] *)
+        let
+            val (VE,TE) = evalDatBind(datbind)
+        in
+            DynamicEnv.fromVEandTE(VE,TE)
+        end
 
       | evalDec(s,E, REPLICATIONDec(I, tycon, longtycon)) =
-	(* [Rule 117] *)
-	let
-	    val VE = case DynamicEnv.findLongTyCon(E, longtycon)
-		       of SOME VE => VE
-			| NONE =>
-			  errorLongTyCon(I, "runtime error: unknown type ",
-					    longtycon)
-	in
-	    DynamicEnv.fromVEandTE(VE, TyConMap.singleton(tycon, VE))
-	end
+        (* [Rule 117] *)
+        let
+            val VE = case DynamicEnv.findLongTyCon(E, longtycon)
+                       of SOME VE => VE
+                        | NONE =>
+                          errorLongTyCon(I, "runtime error: unknown type ",
+                                            longtycon)
+        in
+            DynamicEnv.fromVEandTE(VE, TyConMap.singleton(tycon, VE))
+        end
 
       | evalDec(s,E, ABSTYPEDec(I, datbind, dec)) =
-	(* [Rule 118] *)
-	let
-	    val (VE,TE) = evalDatBind(datbind)
-	    val    E'   = evalDec(s,E plusVEandTE (VE,TE), dec)
-	in
-	    E'
-	end
+        (* [Rule 118] *)
+        let
+            val (VE,TE) = evalDatBind(datbind)
+            val    E'   = evalDec(s,E plusVEandTE (VE,TE), dec)
+        in
+            E'
+        end
 
       | evalDec(s,E, EXCEPTIONDec(I, exbind)) =
-	(* [Rule 119] *)
-	let
-	    val VE = evalExBind(s,E, exbind)
-	in
-	    DynamicEnv.fromVE VE
-	end
+        (* [Rule 119] *)
+        let
+            val VE = evalExBind(s,E, exbind)
+        in
+            DynamicEnv.fromVE VE
+        end
 
       | evalDec(s,E, LOCALDec(I, dec1, dec2)) =
-	(* [Rule 120] *)
-	let
-	    val E1 = evalDec(s,E, dec1)
-	    val E2 = evalDec(s,E plus E1, dec2)
-	in
-	    E2
-	end
+        (* [Rule 120] *)
+        let
+            val E1 = evalDec(s,E, dec1)
+            val E2 = evalDec(s,E plus E1, dec2)
+        in
+            E2
+        end
 
       | evalDec(s,E, OPENDec(I, longstrids)) =
-	(* [Rule 121] *)
-	let
-	    val Es =
-		List.map
-		    (fn longstrid =>
-			case DynamicEnv.findLongStrId(E, longstrid)
-			  of SOME(DynamicEnv.Str E) => E
-			   | NONE =>
-			     errorLongStrId(I, "runtime error: unknown \
-					       \structure ", longstrid) )
-		    longstrids
-	in
-	    List.foldl DynamicEnv.plus DynamicEnv.empty Es
-	end
+        (* [Rule 121] *)
+        let
+            val Es =
+                List.map
+                    (fn longstrid =>
+                        case DynamicEnv.findLongStrId(E, longstrid)
+                          of SOME(DynamicEnv.Str E) => E
+                           | NONE =>
+                             errorLongStrId(I, "runtime error: unknown \
+                                               \structure ", longstrid) )
+                    longstrids
+        in
+            List.foldl DynamicEnv.plus DynamicEnv.empty Es
+        end
 
       | evalDec(s,E, EMPTYDec(I)) =
-	(* [Rule 122] *)
-	DynamicEnv.empty
+        (* [Rule 122] *)
+        DynamicEnv.empty
 
       | evalDec(s,E, SEQDec(I, dec1, dec2)) =
-	(* [Rule 123] *)
-	let
-	    val E1 = evalDec(s,E, dec1)
-	    val E2 = evalDec(s,E plus E1, dec2)
-	in
-	    E1 plus E2
-	end
+        (* [Rule 123] *)
+        let
+            val E1 = evalDec(s,E, dec1)
+            val E2 = evalDec(s,E plus E1, dec2)
+        in
+            E1 plus E2
+        end
 
 
     (* Value Bindings *)
 
     and evalValBind(s,E, PLAINValBind(I, pat, exp, valbind_opt)) =
-	(* [Rule 124 and 125] *)
-	(let
-	    val v   = evalExp(s,E, exp)
-	    val VE  = evalPat(s,E,v, pat)
-	    (* [Rule 124] *)
-	    val VE' = case valbind_opt
-			of NONE         => VIdMap.empty
-			 | SOME valbind => evalValBind(s,E, valbind)
-	 in
-	    VIdMap.unionWith #2 (VE, VE')
-	 end
-	 handle FAIL =>
-	    (* [Rule 125] *)
-	    raise Pack.Pack(Val.ExName InitialDynamicEnv.enBind)
-	)
+        (* [Rule 124 and 125] *)
+        (let
+            val v   = evalExp(s,E, exp)
+            val VE  = evalPat(s,E,v, pat)
+            (* [Rule 124] *)
+            val VE' = case valbind_opt
+                        of NONE         => VIdMap.empty
+                         | SOME valbind => evalValBind(s,E, valbind)
+         in
+            VIdMap.unionWith #2 (VE, VE')
+         end
+         handle FAIL =>
+            (* [Rule 125] *)
+            raise Pack.Pack(Val.ExName InitialDynamicEnv.enBind)
+        )
 
       | evalValBind(s,E, RECValBind(I, valbind)) =
-	(* [Rule 126] *)
-	let
-	    val VE = evalValBind(s,E, valbind)
-	in
-	    DynamicEnv.Rec VE
-	end
+        (* [Rule 126] *)
+        let
+            val VE = evalValBind(s,E, valbind)
+        in
+            DynamicEnv.Rec VE
+        end
 
 
     (* Type Bindings *)
 
     and evalTypBind(TypBind(I, tyvarseq, tycon, ty, typbind_opt)) =
-	(* [Rule 127] *)
-	let
-	    val TE = case typbind_opt
-		       of NONE         => TyConMap.empty
-			| SOME typbind => evalTypBind(typbind)
-	in
-	    TyConMap.insert(TE, tycon, VIdMap.empty)
-	end
+        (* [Rule 127] *)
+        let
+            val TE = case typbind_opt
+                       of NONE         => TyConMap.empty
+                        | SOME typbind => evalTypBind(typbind)
+        in
+            TyConMap.insert(TE, tycon, VIdMap.empty)
+        end
 
 
     (* Datatype Bindings *)
 
     and evalDatBind(DatBind(I, tyvarseq, tycon, conbind, datbind_opt)) =
-	(* [Rule 128] *)
-	let
-	    val  VE       = evalConBind(conbind)
-	    val (VE',TE') = case datbind_opt
-			      of NONE          => ( VIdMap.empty, TyConMap.empty )
-			       | SOME datbind' => evalDatBind(datbind')
-	in
-	    ( VIdMap.unionWith #2 (VE, VE')
-	    , TyConMap.insert(TE', tycon, VE)
-	    )
-	end
+        (* [Rule 128] *)
+        let
+            val  VE       = evalConBind(conbind)
+            val (VE',TE') = case datbind_opt
+                              of NONE          => ( VIdMap.empty, TyConMap.empty )
+                               | SOME datbind' => evalDatBind(datbind')
+        in
+            ( VIdMap.unionWith #2 (VE, VE')
+            , TyConMap.insert(TE', tycon, VE)
+            )
+        end
 
 
     (* Constructor Bindings *)
 
     and evalConBind(ConBind(I, _, vid, _, conbind_opt)) =
-	(* [Rule 129] *)
-	let
-	    val VE = case conbind_opt
-		       of NONE         => VIdMap.empty
-			| SOME conbind => evalConBind(conbind)
-	in
-	    VIdMap.insert(VE, vid, (Val.VId vid,IdStatus.c))
-	end
+        (* [Rule 129] *)
+        let
+            val VE = case conbind_opt
+                       of NONE         => VIdMap.empty
+                        | SOME conbind => evalConBind(conbind)
+        in
+            VIdMap.insert(VE, vid, (Val.VId vid,IdStatus.c))
+        end
 
 
     (* Exception Bindings *)
 
     and evalExBind(s,E, NEWExBind(I, _, vid, _, exbind_opt)) =
-	(* [Rule 130] *)
-	let
-	    val en = ExName.exname vid
-	    val VE = case exbind_opt
-		       of NONE        => VIdMap.empty
-			| SOME exbind => evalExBind(s,E, exbind)
-	in
-	    s := State.insertExName(!s, en)
-	  ; VIdMap.insert(VE, vid, (Val.ExVal(Val.ExName en),IdStatus.e))
-	end
+        (* [Rule 130] *)
+        let
+            val en = ExName.exname vid
+            val VE = case exbind_opt
+                       of NONE        => VIdMap.empty
+                        | SOME exbind => evalExBind(s,E, exbind)
+        in
+            s := State.insertExName(!s, en)
+          ; VIdMap.insert(VE, vid, (Val.ExVal(Val.ExName en),IdStatus.e))
+        end
 
       | evalExBind(s,E, EQUALExBind(I, _, vid, _, longvid, exbind_opt)) =
-	(* [Rule 131] *)
-	let
-	    val en = case DynamicEnv.findLongVId(E, longvid)
-		       of SOME(en,IdStatus.e) => en
-			| SOME _ =>
-			  errorLongVId(I, "runtime error: non-exception \
-					  \identifier ", longvid)
-			| NONE =>
-			  errorLongVId(I, "runtime error: unknown identifier ",
-					  longvid)
-	    val VE = case exbind_opt
-		       of NONE        => VIdMap.empty
-			| SOME exbind => evalExBind(s,E, exbind)
-	in
-	    VIdMap.insert(VE, vid, (en,IdStatus.e))
-	end
+        (* [Rule 131] *)
+        let
+            val en = case DynamicEnv.findLongVId(E, longvid)
+                       of SOME(en,IdStatus.e) => en
+                        | SOME _ =>
+                          errorLongVId(I, "runtime error: non-exception \
+                                          \identifier ", longvid)
+                        | NONE =>
+                          errorLongVId(I, "runtime error: unknown identifier ",
+                                          longvid)
+            val VE = case exbind_opt
+                       of NONE        => VIdMap.empty
+                        | SOME exbind => evalExBind(s,E, exbind)
+        in
+            VIdMap.insert(VE, vid, (en,IdStatus.e))
+        end
 
 
     (* Atomic Patterns *)
 
     and evalAtPat(s,E,v, WILDCARDAtPat(I)) =
-	(* [Rule 132] *)
-	VIdMap.empty
+        (* [Rule 132] *)
+        VIdMap.empty
 
       | evalAtPat(s,E,v, SCONAtPat(I, scon)) =
-	(* [Rule 133 and 134] *)
-	(case v
-	   of Val.SVal sv =>
-	      if Val.equal(v, valSCon(scon)) then
-		 (* [Rule 133] *)
-		 VIdMap.empty
-	      else
-		 (* [Rule 134] *)
-		 raise FAIL
+        (* [Rule 133 and 134] *)
+        (case v
+           of Val.SVal sv =>
+              if Val.equal(v, valSCon(scon)) then
+                 (* [Rule 133] *)
+                 VIdMap.empty
+              else
+                 (* [Rule 134] *)
+                 raise FAIL
 
-	    | _ => error(I, "runtime type error: special constant expected")
-	)
+            | _ => error(I, "runtime type error: special constant expected")
+        )
 
       | evalAtPat(s,E,v, LONGVIDAtPat(I, _, longvid)) =
-	(* [Rule 135 to 137] *)
-	let
-	    val (strids,vid) = LongVId.explode longvid
-	in
-	    if List.null strids andalso
-	       ( case DynamicEnv.findVId(E, vid)
-		   of NONE       => true
-		    | SOME(_,is) => is = IdStatus.v ) then
-		(* [Rule 135] *)
-		VIdMap.singleton(vid, (v,IdStatus.v))
-	    else
-		let
-		    val (v',is) = case DynamicEnv.findLongVId(E, longvid)
-				    of SOME valstr => valstr
-				     | NONE =>
-					errorLongVId(I,"runtime error: \
-						       \unknown constructor ",
-							longvid)
-		in
-		    if Val.equal(v, v') then
-			(* [Rule 136] *)
-			VIdMap.empty
-		    else
-			(* [Rule 137] *)
-			raise FAIL
-		end
-	end
+        (* [Rule 135 to 137] *)
+        let
+            val (strids,vid) = LongVId.explode longvid
+        in
+            if List.null strids andalso
+               ( case DynamicEnv.findVId(E, vid)
+                   of NONE       => true
+                    | SOME(_,is) => is = IdStatus.v ) then
+                (* [Rule 135] *)
+                VIdMap.singleton(vid, (v,IdStatus.v))
+            else
+                let
+                    val (v',is) = case DynamicEnv.findLongVId(E, longvid)
+                                    of SOME valstr => valstr
+                                     | NONE =>
+                                        errorLongVId(I,"runtime error: \
+                                                       \unknown constructor ",
+                                                        longvid)
+                in
+                    if Val.equal(v, v') then
+                        (* [Rule 136] *)
+                        VIdMap.empty
+                    else
+                        (* [Rule 137] *)
+                        raise FAIL
+                end
+        end
 
       | evalAtPat(s,E,v, RECORDAtPat(I, patrow_opt)) =
-	(* [Rule 138] *)
-	let
-	    val r  = case v
-		       of Val.Record r => r
-		        | _ =>
-			  error(I, "runtime type error: record expected")
+        (* [Rule 138] *)
+        let
+            val r  = case v
+                       of Val.Record r => r
+                        | _ =>
+                          error(I, "runtime type error: record expected")
 
-	    val VE = case patrow_opt
-		       of NONE        =>
-			  if LabMap.isEmpty r then
-			     VIdMap.empty
-			  else
-			     error(I, "runtime type error: \
-				      \empty record expected")
+            val VE = case patrow_opt
+                       of NONE        =>
+                          if LabMap.isEmpty r then
+                             VIdMap.empty
+                          else
+                             error(I, "runtime type error: \
+                                      \empty record expected")
 
-			| SOME patrow =>
-			      evalPatRow(s,E,r, patrow)
-	in
-	    VE
-	end
+                        | SOME patrow =>
+                              evalPatRow(s,E,r, patrow)
+        in
+            VE
+        end
 
       | evalAtPat(s,E,v, PARAtPat(I, pat)) =
-	(* [Rule 139] *)
-	let
-	    val VE = evalPat(s,E,v, pat)
-	in
-	    VE
-	end
+        (* [Rule 139] *)
+        let
+            val VE = evalPat(s,E,v, pat)
+        in
+            VE
+        end
 
 
     (* Pattern Rows *)
 
     and evalPatRow(s,E,r, WILDCARDPatRow(I)) =
-	(* [Rule 140] *)
-	VIdMap.empty
+        (* [Rule 140] *)
+        VIdMap.empty
 
       | evalPatRow(s,E,r, ROWPatRow(I, lab, pat, patrow_opt)) =
-	(* [Rule 141 and 142] *)
-	let
-	    val v   = case LabMap.find(r, lab)
-		        of SOME v => v
-		         | _ => errorLab(I, "runtime type error: \
-					    \unmatched label ", lab)
-	    val VE  = evalPat(s,E,v, pat)
-	    (* [Rule 142] *)
-	    val VE' = case patrow_opt
-			of NONE        => VIdMap.empty
-			 | SOME patrow => evalPatRow(s,E,r, patrow)
-	in
-	    VIdMap.unionWithi #2 (VE, VE')
-	end
-	(* FAIL on evalPat propagates through [Rule 142] *)
+        (* [Rule 141 and 142] *)
+        let
+            val v   = case LabMap.find(r, lab)
+                        of SOME v => v
+                         | _ => errorLab(I, "runtime type error: \
+                                            \unmatched label ", lab)
+            val VE  = evalPat(s,E,v, pat)
+            (* [Rule 142] *)
+            val VE' = case patrow_opt
+                        of NONE        => VIdMap.empty
+                         | SOME patrow => evalPatRow(s,E,r, patrow)
+        in
+            VIdMap.unionWithi #2 (VE, VE')
+        end
+        (* FAIL on evalPat propagates through [Rule 142] *)
 
 
     (* Patterns *)
 
     and evalPat(s,E,v, ATPATPat(I, atpat)) =
-	(* [Rule 143] *)
-	let
-	    val VE = evalAtPat(s,E,v, atpat)
-	in
-	    VE
-	end
+        (* [Rule 143] *)
+        let
+            val VE = evalAtPat(s,E,v, atpat)
+        in
+            VE
+        end
 
       | evalPat(s,E,v, CONPat(I, _, longvid, atpat)) =
-	(* [Rules 144 to 148] *)
-	(case (DynamicEnv.findLongVId(E, longvid), v)
-	   of ( SOME(Val.VId vid, IdStatus.c),
-		     Val.VIdVal(vid',v') ) =>	
-		 if vid = VId.fromString "ref" then
-		    error(I, "runtime type error: address expected")
-		 else if vid = vid' then
-		    (* [Rule 144] *)
-		    let
-			val VE = evalAtPat(s,E,v', atpat)
-		    in
-			VE
-		    end
-		 else
-		    (* [Rule 145] *)
-		    raise FAIL
+        (* [Rules 144 to 148] *)
+        (case (DynamicEnv.findLongVId(E, longvid), v)
+           of ( SOME(Val.VId vid, IdStatus.c),
+                     Val.VIdVal(vid',v') ) =>   
+                 if vid = VId.fromString "ref" then
+                    error(I, "runtime type error: address expected")
+                 else if vid = vid' then
+                    (* [Rule 144] *)
+                    let
+                        val VE = evalAtPat(s,E,v', atpat)
+                    in
+                        VE
+                    end
+                 else
+                    (* [Rule 145] *)
+                    raise FAIL
 
-	    | ( SOME(Val.ExVal(Val.ExName en),IdStatus.e),
-		     Val.ExVal(Val.ExNameVal(en',v')) ) =>	
-	         if en = en' then
-		    (* [Rule 146] *)
-		    let
-			val VE = evalAtPat(s,E,v', atpat)
-		    in
-			VE
-		    end
-		 else
-		    (* [Rule 147] *)
-		    raise FAIL
+            | ( SOME(Val.ExVal(Val.ExName en),IdStatus.e),
+                     Val.ExVal(Val.ExNameVal(en',v')) ) =>      
+                 if en = en' then
+                    (* [Rule 146] *)
+                    let
+                        val VE = evalAtPat(s,E,v', atpat)
+                    in
+                        VE
+                    end
+                 else
+                    (* [Rule 147] *)
+                    raise FAIL
 
-	    | ( SOME(Val.VId vid, IdStatus.c),
-		     Val.Addr a ) =>	
-		 if vid = VId.fromString "ref" then
-		    (* [Rule 148] *)
-		    let
-			val v =  case State.findAddr(!s, a)
-				   of SOME v => v
-				    | NONE   =>
-				      raise Fail "EvalCore.evalPat: \
-						 \invalid address"
-			val VE = evalAtPat(s,E,v, atpat)
-		    in
-			VE
-		    end
-		else
-		    error(I, "runtime type error: reference expected")
+            | ( SOME(Val.VId vid, IdStatus.c),
+                     Val.Addr a ) =>    
+                 if vid = VId.fromString "ref" then
+                    (* [Rule 148] *)
+                    let
+                        val v =  case State.findAddr(!s, a)
+                                   of SOME v => v
+                                    | NONE   =>
+                                      raise Fail "EvalCore.evalPat: \
+                                                 \invalid address"
+                        val VE = evalAtPat(s,E,v, atpat)
+                    in
+                        VE
+                    end
+                else
+                    error(I, "runtime type error: reference expected")
 
-	    | _ =>
-		 error(I, "runtime type error: constructor expected")
-	)
+            | _ =>
+                 error(I, "runtime type error: constructor expected")
+        )
 
       | evalPat(s,E,v, TYPEDPat(I, pat, _)) =
-	(* Omitted [Section 6.1] *)
-	evalPat(s,E,v, pat)
+        (* Omitted [Section 6.1] *)
+        evalPat(s,E,v, pat)
 
       | evalPat(s,E,v, ASPat(I, _, vid, _, pat)) =
-	(* [Rule 149] *)
-	let
-	    val VE = evalPat(s,E,v, pat)
-	in
-	    VIdMap.insert(VE, vid, (v,IdStatus.v))
-	end
+        (* [Rule 149] *)
+        let
+            val VE = evalPat(s,E,v, pat)
+        in
+            VIdMap.insert(VE, vid, (v,IdStatus.v))
+        end
 
   end
 (* stop of EvalCore.sml *)
@@ -7605,17 +7605,17 @@
 
     (* Types [Section 7.2] *)
 
-    type IntBasis = SigEnv * Int				(* [IB] *)
+    type IntBasis = SigEnv * Int                                (* [IB] *)
 
 
     (* Operations *)
 
-    val Inter:		Basis -> IntBasis
+    val Inter:          Basis -> IntBasis
 
-    val plusI:		IntBasis * Int    -> IntBasis
+    val plusI:          IntBasis * Int    -> IntBasis
 
-    val findSigId:	IntBasis * SigId     -> Int option
-    val findLongTyCon:	IntBasis * longTyCon -> ValInt option
+    val findSigId:      IntBasis * SigId     -> Int option
+    val findLongTyCon:  IntBasis * longTyCon -> ValInt option
  
   end
 (* stop of INTBASIS.sml *)
@@ -7645,7 +7645,7 @@
 
     (* Types [Section 7.2] *)
 
-    type IntBasis = SigEnv * Int				(* [IB] *)
+    type IntBasis = SigEnv * Int                                (* [IB] *)
 
 
     (* Injections [Section 7.2] *)
@@ -7742,9 +7742,9 @@
     fun errorFunId(I, s, funid) = error(I, s ^ FunId.toString funid)
 
     fun errorLongTyCon(I, s, longtycon) =
-	error(I, s ^ LongTyCon.toString longtycon)
+        error(I, s ^ LongTyCon.toString longtycon)
     fun errorLongStrId(I, s, longstrid) =
-	error(I, s ^ LongStrId.toString longstrid)
+        error(I, s ^ LongStrId.toString longstrid)
 
 
     (* Helpers for basis modification *)
@@ -7765,419 +7765,419 @@
     (* Structure Expressions *)
 
     fun evalStrExp(s,B, STRUCTStrExp(I, strdec)) =
-	(* [Rule 150] *)
-	let
-	    val E = evalStrDec(s,B, strdec)
-	in
-	    E
-	end
+        (* [Rule 150] *)
+        let
+            val E = evalStrDec(s,B, strdec)
+        in
+            E
+        end
 
       | evalStrExp(s,B, LONGSTRIDStrExp(I, longstrid)) =
-	(* [Rule 151] *)
-	let
-	    val E = case DynamicBasis.findLongStrId(B, longstrid)
-		      of SOME(DynamicEnv.Str E) => E
-		       | NONE =>
-			 errorLongStrId(I, "runtime error: unknown structure ",
-					   longstrid)
-	in
-	    E
-	end
+        (* [Rule 151] *)
+        let
+            val E = case DynamicBasis.findLongStrId(B, longstrid)
+                      of SOME(DynamicEnv.Str E) => E
+                       | NONE =>
+                         errorLongStrId(I, "runtime error: unknown structure ",
+                                           longstrid)
+        in
+            E
+        end
 
       | evalStrExp(s,B, TRANSStrExp(I, strexp, sigexp)) =
-	(* [Rule 152] *)
-	let
-	    val E = evalStrExp(s,B, strexp)
-	    val I = evalSigExp(IntBasis.Inter B, sigexp)
-	in
-	    Interface.cutdown(E, I)
-	end
+        (* [Rule 152] *)
+        let
+            val E = evalStrExp(s,B, strexp)
+            val I = evalSigExp(IntBasis.Inter B, sigexp)
+        in
+            Interface.cutdown(E, I)
+        end
 
       | evalStrExp(s,B, OPAQStrExp(I, strexp, sigexp)) =
-	(* [Rule 153] *)
-	let
-	    val E = evalStrExp(s,B, strexp)
-	    val I = evalSigExp(IntBasis.Inter B, sigexp)
-	in
-	    Interface.cutdown(E, I)
-	end
+        (* [Rule 153] *)
+        let
+            val E = evalStrExp(s,B, strexp)
+            val I = evalSigExp(IntBasis.Inter B, sigexp)
+        in
+            Interface.cutdown(E, I)
+        end
 
       | evalStrExp(s,B, APPStrExp(I, funid, strexp)) =
-	(* [Rule 154] *)
-	let
-	    val DynamicBasis.FunctorClosure((strid, I), strexp', B') =
-		      case DynamicBasis.findFunId(B, funid)
-			of SOME funcclos => funcclos
-			 | NONE => errorFunId(I, "runtime error: \
-						 \unknown functor ", funid)
-	    val E  = evalStrExp(s,B, strexp)
-	    val E' = evalStrExp(
-			s,
-			B' plusSE
-			    StrIdMap.singleton(strid, 
-			    	DynamicEnv.Str(Interface.cutdown(E, I))),
-			strexp')
-	in
-	    E'
-	end
+        (* [Rule 154] *)
+        let
+            val DynamicBasis.FunctorClosure((strid, I), strexp', B') =
+                      case DynamicBasis.findFunId(B, funid)
+                        of SOME funcclos => funcclos
+                         | NONE => errorFunId(I, "runtime error: \
+                                                 \unknown functor ", funid)
+            val E  = evalStrExp(s,B, strexp)
+            val E' = evalStrExp(
+                        s,
+                        B' plusSE
+                            StrIdMap.singleton(strid, 
+                                DynamicEnv.Str(Interface.cutdown(E, I))),
+                        strexp')
+        in
+            E'
+        end
 
       | evalStrExp(s,B, LETStrExp(I, strdec, strexp)) =
-	(* [Rule 155] *)
-	let
-	    val E  = evalStrDec(s,B, strdec)
-	    val E' = evalStrExp(s,B plusE E, strexp)
-	in
-	    E'
-	end
+        (* [Rule 155] *)
+        let
+            val E  = evalStrDec(s,B, strdec)
+            val E' = evalStrExp(s,B plusE E, strexp)
+        in
+            E'
+        end
 
 
     (* Structure-level Declarations *)
 
     and evalStrDec(s,B, DECStrDec(I, dec)) =
-	(* [Rule 156] *)
-	let
-	    val E' = EvalCore.evalDec(s,DynamicBasis.Eof B, dec)
-	in
-	    E'
-	end
+        (* [Rule 156] *)
+        let
+            val E' = EvalCore.evalDec(s,DynamicBasis.Eof B, dec)
+        in
+            E'
+        end
 
       | evalStrDec(s,B, STRUCTUREStrDec(I, strbind)) =
-	(* [Rule 157] *)
-	let
-	    val SE = evalStrBind(s,B, strbind)
-	in
-	    DynamicEnv.fromSE SE
-	end
+        (* [Rule 157] *)
+        let
+            val SE = evalStrBind(s,B, strbind)
+        in
+            DynamicEnv.fromSE SE
+        end
 
       | evalStrDec(s,B, LOCALStrDec(I, strdec1, strdec2)) =
-	(* [Rule 158] *)
-	let
-	    val E1 = evalStrDec(s,B, strdec1)
-	    val E2 = evalStrDec(s,B plusE E1, strdec2)
-	in
-	    E2
-	end
+        (* [Rule 158] *)
+        let
+            val E1 = evalStrDec(s,B, strdec1)
+            val E2 = evalStrDec(s,B plusE E1, strdec2)
+        in
+            E2
+        end
 
       | evalStrDec(s,B, EMPTYStrDec(I)) =
-	(* [Rule 159] *)
-	DynamicEnv.empty
+        (* [Rule 159] *)
+        DynamicEnv.empty
 
       | evalStrDec(s,B, SEQStrDec(I, strdec1, strdec2)) =
-	(* [Rule 160] *)
-	let
-	    val E1 = evalStrDec(s,B, strdec1)
-	    val E2 = evalStrDec(s,B plusE E1, strdec2)
-	in
-	    DynamicEnv.plus(E1, E2)
-	end
+        (* [Rule 160] *)
+        let
+            val E1 = evalStrDec(s,B, strdec1)
+            val E2 = evalStrDec(s,B plusE E1, strdec2)
+        in
+            DynamicEnv.plus(E1, E2)
+        end
 
 
     (* Structure Bindings *)
 
     and evalStrBind(s,B, StrBind(I, strid, strexp, strbind_opt)) =
-	(* [Rule 161] *)
-	let
-	    val E  = evalStrExp(s,B, strexp)
-	    val SE = case strbind_opt
-		       of NONE         => StrIdMap.empty
-		        | SOME strbind => evalStrBind(s,B, strbind)
-	in
-	    StrIdMap.insert(SE, strid, DynamicEnv.Str E)
-	end
+        (* [Rule 161] *)
+        let
+            val E  = evalStrExp(s,B, strexp)
+            val SE = case strbind_opt
+                       of NONE         => StrIdMap.empty
+                        | SOME strbind => evalStrBind(s,B, strbind)
+        in
+            StrIdMap.insert(SE, strid, DynamicEnv.Str E)
+        end
 
 
     (* Signature Expressions *)
 
     and evalSigExp(IB, SIGSigExp(I, spec)) =
-	(* [Rule 162] *)
-	let
-	    val I = evalSpec(IB, spec)
-	in
-	    I
-	end
+        (* [Rule 162] *)
+        let
+            val I = evalSpec(IB, spec)
+        in
+            I
+        end
 
       | evalSigExp(IB, SIGIDSigExp(I, sigid)) =
-	(* [Rule 163] *)
-	let
-	    val I = case IntBasis.findSigId(IB, sigid)
-		      of SOME I => I
-		       | NONE   => errorSigId(I, "runtime error: unknown \
-						 \signature ",sigid)
-	in
-	    I
-	end
+        (* [Rule 163] *)
+        let
+            val I = case IntBasis.findSigId(IB, sigid)
+                      of SOME I => I
+                       | NONE   => errorSigId(I, "runtime error: unknown \
+                                                 \signature ",sigid)
+        in
+            I
+        end
 
       | evalSigExp(IB, WHERETYPESigExp(I, sigexp, _, _, _)) =
-	(* Omitted [Section 7.1] *)
-	evalSigExp(IB, sigexp)
+        (* Omitted [Section 7.1] *)
+        evalSigExp(IB, sigexp)
 
 
     (* Signature Declarations *)
 
     and evalSigDec(IB, SigDec(I, sigbind)) =
-	(* [Rule 164] *)
-	let
-	    val G = evalSigBind(IB, sigbind)
-	in
-	    G
-	end
+        (* [Rule 164] *)
+        let
+            val G = evalSigBind(IB, sigbind)
+        in
+            G
+        end
 
 
     (* Signature Bindings *)
 
     and evalSigBind(IB, SigBind(I, sigid, sigexp, sigbind_opt)) =
-	(* [Rule 165] *)
-	let
-	    val I = evalSigExp(IB, sigexp)
-	    val G = case sigbind_opt
-		      of NONE         => SigIdMap.empty
-		       | SOME sigbind => evalSigBind(IB, sigbind)
-	in
-	    SigIdMap.insert(G, sigid, I)
-	end
+        (* [Rule 165] *)
+        let
+            val I = evalSigExp(IB, sigexp)
+            val G = case sigbind_opt
+                      of NONE         => SigIdMap.empty
+                       | SOME sigbind => evalSigBind(IB, sigbind)
+        in
+            SigIdMap.insert(G, sigid, I)
+        end
 
 
     (* Specifications *)
 
     and evalSpec(IB, VALSpec(I, valdesc)) =
-	(* [Rule 166] *)
-	let
-	    val VI = evalValDesc(valdesc)
-	in
-	    Interface.fromVI VI
-	end
+        (* [Rule 166] *)
+        let
+            val VI = evalValDesc(valdesc)
+        in
+            Interface.fromVI VI
+        end
 
       | evalSpec(IB, TYPESpec(I, typdesc)) =
-	(* [Rule 167] *)
-	let
-	    val TI = evalTypDesc(typdesc)
-	in
-	    Interface.fromTI TI
-	end
+        (* [Rule 167] *)
+        let
+            val TI = evalTypDesc(typdesc)
+        in
+            Interface.fromTI TI
+        end
 
       | evalSpec(IB, EQTYPESpec(I, typdesc)) =
-	(* [Rule 168] *)
-	let
-	    val TI = evalTypDesc(typdesc)
-	in
-	    Interface.fromTI TI
-	end
+        (* [Rule 168] *)
+        let
+            val TI = evalTypDesc(typdesc)
+        in
+            Interface.fromTI TI
+        end
 
       | evalSpec(IB, DATATYPESpec(I, datdesc)) =
-	(* [Rule 169] *)
-	let
-	    val (VI,TI) = evalDatDesc(datdesc)
-	in
-	    Interface.fromVIandTI(VI,TI)
-	end
+        (* [Rule 169] *)
+        let
+            val (VI,TI) = evalDatDesc(datdesc)
+        in
+            Interface.fromVIandTI(VI,TI)
+        end
 
       | evalSpec(IB, REPLICATIONSpec(I, tycon, longtycon)) =
-	(* [Rule 170] *)
-	let
-	    val VI = case IntBasis.findLongTyCon(IB, longtycon)
-		       of SOME VI => VI
-			| NONE => errorLongTyCon(I, "runtime error: \
-						    \unknown type ", longtycon)
-	    val TI = TyConMap.singleton(tycon, VI)
-	in
-	    Interface.fromVIandTI(VI,TI)
-	end
+        (* [Rule 170] *)
+        let
+            val VI = case IntBasis.findLongTyCon(IB, longtycon)
+                       of SOME VI => VI
+                        | NONE => errorLongTyCon(I, "runtime error: \
+                                                    \unknown type ", longtycon)
+            val TI = TyConMap.singleton(tycon, VI)
+        in
+            Interface.fromVIandTI(VI,TI)
+        end
 
       | evalSpec(IB, EXCEPTIONSpec(I, exdesc)) =
-	(* [Rule 171] *)
-	let
-	    val VI = evalExDesc(exdesc)
-	in
-	    Interface.fromVI VI
-	end
+        (* [Rule 171] *)
+        let
+            val VI = evalExDesc(exdesc)
+        in
+            Interface.fromVI VI
+        end
 
       | evalSpec(IB, STRUCTURESpec(I, strdesc)) =
-	(* [Rule 172] *)
-	let
-	    val SI = evalStrDesc(IB, strdesc)
-	in
-	    Interface.fromSI SI
-	end
+        (* [Rule 172] *)
+        let
+            val SI = evalStrDesc(IB, strdesc)
+        in
+            Interface.fromSI SI
+        end
 
       | evalSpec(IB, INCLUDESpec(I, sigexp)) =
-	(* [Rule 173] *)
-	let
-	    val I = evalSigExp(IB, sigexp)
-	in
-	    I
-	end
+        (* [Rule 173] *)
+        let
+            val I = evalSigExp(IB, sigexp)
+        in
+            I
+        end
 
       | evalSpec(IB, EMPTYSpec(I)) =
-	(* [Rule 174] *)
-	Interface.empty
+        (* [Rule 174] *)
+        Interface.empty
 
       | evalSpec(IB, SEQSpec(I, spec1, spec2)) =
-	(* [Rule 77] *)
-	let
-	    val I1 = evalSpec(IB, spec1)
-	    val I2 = evalSpec(IntBasis.plusI(IB, I1), spec2)
-	in
-	    Interface.plus(I1,I2)
-	end
+        (* [Rule 77] *)
+        let
+            val I1 = evalSpec(IB, spec1)
+            val I2 = evalSpec(IntBasis.plusI(IB, I1), spec2)
+        in
+            Interface.plus(I1,I2)
+        end
 
       | evalSpec(IB, SHARINGTYPESpec(I, spec, longtycons)) =
-	(* Omitted [Section 7.1] *)
-	evalSpec(IB, spec)
+        (* Omitted [Section 7.1] *)
+        evalSpec(IB, spec)
 
       | evalSpec(IB, SHARINGSpec(I, spec, longstrids)) =
-	(* Omitted [Section 7.1] *)
-	evalSpec(IB, spec)
+        (* Omitted [Section 7.1] *)
+        evalSpec(IB, spec)
 
 
     (* Value Descriptions *)
 
     and evalValDesc(ValDesc(I, vid, _, valdesc_opt)) =
-	(* [Rule 176] *)
-	let
-	    val VI = case valdesc_opt
-		       of NONE         => VIdMap.empty
-			| SOME valdesc => evalValDesc(valdesc)
-	in
-	    VIdMap.insert(VI, vid, IdStatus.v)
-	end
+        (* [Rule 176] *)
+        let
+            val VI = case valdesc_opt
+                       of NONE         => VIdMap.empty
+                        | SOME valdesc => evalValDesc(valdesc)
+        in
+            VIdMap.insert(VI, vid, IdStatus.v)
+        end
 
 
     (* Type Descriptions *)
 
     and evalTypDesc(TypDesc(I, tyvarseq, tycon, typdesc_opt)) =
-	(* [Rule 177] *)
-	let
-	    val TI = case typdesc_opt
-		       of NONE         => TyConMap.empty
-			| SOME typdesc => evalTypDesc(typdesc)
-	in
-	    TyConMap.insert(TI, tycon, VIdMap.empty)
-	end
+        (* [Rule 177] *)
+        let
+            val TI = case typdesc_opt
+                       of NONE         => TyConMap.empty
+                        | SOME typdesc => evalTypDesc(typdesc)
+        in
+            TyConMap.insert(TI, tycon, VIdMap.empty)
+        end
 
 
     (* Datatype Descriptions *)
 
     and evalDatDesc(DatDesc(I, tyvarseq, tycon, condesc, datdesc_opt)) =
-	(* [Rule 178] *)
-	let
-	    val  VI       = evalConDesc(condesc)
-	    val (VI',TI') = case datdesc_opt
-			      of NONE          => ( VIdMap.empty, TyConMap.empty )
-			       | SOME datdesc' => evalDatDesc(datdesc')
-	in
-	    ( VIdMap.unionWith #2 (VI, VI')
-	    , TyConMap.insert(TI', tycon, VI)
-	    )
-	end
+        (* [Rule 178] *)
+        let
+            val  VI       = evalConDesc(condesc)
+            val (VI',TI') = case datdesc_opt
+                              of NONE          => ( VIdMap.empty, TyConMap.empty )
+                               | SOME datdesc' => evalDatDesc(datdesc')
+        in
+            ( VIdMap.unionWith #2 (VI, VI')
+            , TyConMap.insert(TI', tycon, VI)
+            )
+        end
 
 
     (* Constructor Descriptions *)
 
     and evalConDesc(ConDesc(I, vid, _, condesc_opt)) =
-	(* [Rule 179] *)
-	let
-	    val VI = case condesc_opt
-		       of NONE         => VIdMap.empty
-			| SOME condesc => evalConDesc(condesc)
-	in
-	    VIdMap.insert(VI, vid, IdStatus.c)
-	end
+        (* [Rule 179] *)
+        let
+            val VI = case condesc_opt
+                       of NONE         => VIdMap.empty
+                        | SOME condesc => evalConDesc(condesc)
+        in
+            VIdMap.insert(VI, vid, IdStatus.c)
+        end
 
 
     (* Exception Description *)
 
     and evalExDesc(ExDesc(I, vid, _, exdesc_opt)) =
-	(* [Rule 180] *)
-	let
-	    val VI = case exdesc_opt
-		       of NONE        => VIdMap.empty
-			| SOME exdesc => evalExDesc(exdesc)
-	in
-	    VIdMap.insert(VI, vid, IdStatus.e)
-	end
+        (* [Rule 180] *)
+        let
+            val VI = case exdesc_opt
+                       of NONE        => VIdMap.empty
+                        | SOME exdesc => evalExDesc(exdesc)
+        in
+            VIdMap.insert(VI, vid, IdStatus.e)
+        end
 
 
     (* Structure Descriptions *)
 
     and evalStrDesc(IB, StrDesc(I, strid, sigexp, strdesc_opt)) =
-	(* [Rule 181] *)
-	let
-	    val I  = evalSigExp(IB, sigexp)
-	    val SI = case strdesc_opt
-		       of NONE         => StrIdMap.empty
-		        | SOME strdesc => evalStrDesc(IB, strdesc)
-	in
-	    StrIdMap.insert(SI, strid, Interface.Str I)
-	end
+        (* [Rule 181] *)
+        let
+            val I  = evalSigExp(IB, sigexp)
+            val SI = case strdesc_opt
+                       of NONE         => StrIdMap.empty
+                        | SOME strdesc => evalStrDesc(IB, strdesc)
+        in
+            StrIdMap.insert(SI, strid, Interface.Str I)
+        end
 
 
     (* Functor Bindings *)
 
     and evalFunBind(B, FunBind(I, funid, strid, sigexp, strexp, funbind_opt)) =
-	(* [Rule 182] *)
-	(* Note that there is a typo in this rule. *)
-	let
-	    val I  = evalSigExp(IntBasis.Inter B, sigexp)
-	    val F  = case funbind_opt
-		       of NONE         => FunIdMap.empty
-			| SOME funbind => evalFunBind(B, funbind)
-	in
-	    FunIdMap.insert(F, funid,
-			    DynamicBasis.FunctorClosure((strid,I),strexp,B))
-	end
+        (* [Rule 182] *)
+        (* Note that there is a typo in this rule. *)
+        let
+            val I  = evalSigExp(IntBasis.Inter B, sigexp)
+            val F  = case funbind_opt
+                       of NONE         => FunIdMap.empty
+                        | SOME funbind => evalFunBind(B, funbind)
+        in
+            FunIdMap.insert(F, funid,
+                            DynamicBasis.FunctorClosure((strid,I),strexp,B))
+        end
 
 
     (* Functor Declarations *)
 
     and evalFunDec(B, FunDec(I, funbind)) =
-	(* [Rule 183] *)
-	let
-	    val F = evalFunBind(B, funbind)
-	in
-	    F
-	end
+        (* [Rule 183] *)
+        let
+            val F = evalFunBind(B, funbind)
+        in
+            F
+        end
 
 
     (* Top-level Declarations *)
 
     and evalTopDec(s,B, STRDECTopDec(I, strdec, topdec_opt)) =
-	(* [Rule 184] *)
-	(* Note the mistake in the conclusion of this rule. *)
-	let
-	    val E   = evalStrDec(s,B, strdec)
-	    val B'  = DynamicBasis.fromE E
-	    val B'' = case topdec_opt
-			of NONE        => DynamicBasis.empty
-			 | SOME topdec => evalTopDec(s,B plus B', topdec)
-	in
-	    B' plus B''
-	end
+        (* [Rule 184] *)
+        (* Note the mistake in the conclusion of this rule. *)
+        let
+            val E   = evalStrDec(s,B, strdec)
+            val B'  = DynamicBasis.fromE E
+            val B'' = case topdec_opt
+                        of NONE        => DynamicBasis.empty
+                         | SOME topdec => evalTopDec(s,B plus B', topdec)
+        in
+            B' plus B''
+        end
 
       | evalTopDec(s,B, SIGDECTopDec(I, sigdec, topdec_opt)) =
-	(* [Rule 185] *)
-	(* Note the mistake in the conclusion of this rule. *)
-	let
-	    val G   = evalSigDec(IntBasis.Inter B, sigdec)
-	    val B'  = DynamicBasis.fromG G
-	    val B'' = case topdec_opt
-			of NONE        => DynamicBasis.empty
-			 | SOME topdec => evalTopDec(s,B plus B', topdec)
-	in
-	    B' plus B''
-	end
+        (* [Rule 185] *)
+        (* Note the mistake in the conclusion of this rule. *)
+        let
+            val G   = evalSigDec(IntBasis.Inter B, sigdec)
+            val B'  = DynamicBasis.fromG G
+            val B'' = case topdec_opt
+                        of NONE        => DynamicBasis.empty
+                         | SOME topdec => evalTopDec(s,B plus B', topdec)
+        in
+            B' plus B''
+        end
 
       | evalTopDec(s,B, FUNDECTopDec(I, fundec, topdec_opt)) =
-	(* [Rule 186] *)
-	(* Note the mistake in the conclusion of this rule. *)
-	let
-	    val F   = evalFunDec(B, fundec)
-	    val B'  = DynamicBasis.fromF F
-	    val B'' = case topdec_opt
-			of NONE        => DynamicBasis.empty
-			 | SOME topdec => evalTopDec(s,B plus B', topdec)
-	in
-	    B' plus B''
-	end
+        (* [Rule 186] *)
+        (* Note the mistake in the conclusion of this rule. *)
+        let
+            val F   = evalFunDec(B, fundec)
+            val B'  = DynamicBasis.fromF F
+            val B'' = case topdec_opt
+                        of NONE        => DynamicBasis.empty
+                         | SOME topdec => evalTopDec(s,B plus B', topdec)
+        in
+            B' plus B''
+        end
 
   end
 (* stop of EvalModule.sml *)
@@ -8201,26 +8201,26 @@
 
     type doc
 
-    val empty :		doc			(* empty document *)
-    val break :		doc			(* space or line break *)
-    val ebreak :	doc			(* empty or line break *)
-    val text :		string -> doc		(* raw text *)
+    val empty :         doc                     (* empty document *)
+    val break :         doc                     (* space or line break *)
+    val ebreak :        doc                     (* empty or line break *)
+    val text :          string -> doc           (* raw text *)
 
-    val ^^ :		doc * doc -> doc	(* concatenation *)
-    val ^/^ :		doc * doc -> doc	(* concatenation with break *)
+    val ^^ :            doc * doc -> doc        (* concatenation *)
+    val ^/^ :           doc * doc -> doc        (* concatenation with break *)
 
-    val hbox :		doc -> doc		(* horizontal box *)
-    val vbox :		doc -> doc		(* vertical box *)
-    val fbox :		doc -> doc		(* fill box (h and v) *)
-    val abox :		doc -> doc		(* auto box (h or v) *)
+    val hbox :          doc -> doc              (* horizontal box *)
+    val vbox :          doc -> doc              (* vertical box *)
+    val fbox :          doc -> doc              (* fill box (h and v) *)
+    val abox :          doc -> doc              (* auto box (h or v) *)
 
-    val nest :		int -> doc -> doc	(* indentation by k char's *)
-    val below :		doc -> doc		(* keep current indentation *)
+    val nest :          int -> doc -> doc       (* indentation by k char's *)
+    val below :         doc -> doc              (* keep current indentation *)
 
-    val isEmpty :	doc -> bool
+    val isEmpty :       doc -> bool
 
-    val toString :	doc * int -> string
-    val output :	TextIO.outstream * doc * int -> unit
+    val toString :      doc * int -> string
+    val output :        TextIO.outstream * doc * int -> unit
 
   end
 (* stop of PRETTY_PRINT.sml *)
@@ -8247,57 +8247,57 @@
     datatype mode = H | V | F | A
 
     datatype doc =
-	  EMPTY
-	| BREAK of string
-	| TEXT  of string
-	| CONS  of doc * doc
-	| BOX   of mode * doc
-	| NEST  of int * doc
-	| BELOW of doc
+          EMPTY
+        | BREAK of string
+        | TEXT  of string
+        | CONS  of doc * doc
+        | BOX   of mode * doc
+        | NEST  of int * doc
+        | BELOW of doc
 
     datatype prim =
-	  PTEXT of string
-	| PLINE of int
+          PTEXT of string
+        | PLINE of int
 
 
     (* Interface operators *)
 
     infixr ^^ ^/^
 
-    val empty	= EMPTY
-    val break	= BREAK " "
-    val ebreak	= BREAK ""
-    val text	= TEXT
+    val empty   = EMPTY
+    val break   = BREAK " "
+    val ebreak  = BREAK ""
+    val text    = TEXT
 
-    fun x ^^ EMPTY	= x
-      | EMPTY ^^ y	= y
-      | x ^^ y		= CONS(x, y)
+    fun x ^^ EMPTY      = x
+      | EMPTY ^^ y      = y
+      | x ^^ y          = CONS(x, y)
 
-    fun x ^/^ EMPTY	= x
-      | EMPTY ^/^ y	= y
-      | x ^/^ y		= CONS(x, CONS(break, y))
+    fun x ^/^ EMPTY     = x
+      | EMPTY ^/^ y     = y
+      | x ^/^ y         = CONS(x, CONS(break, y))
 
-    fun below EMPTY	= EMPTY
-      | below x		= BELOW x
+    fun below EMPTY     = EMPTY
+      | below x         = BELOW x
 
-    fun hbox EMPTY	= EMPTY
-      | hbox x		= BOX(H, x)
+    fun hbox EMPTY      = EMPTY
+      | hbox x          = BOX(H, x)
 
-    fun vbox EMPTY	= EMPTY
-      | vbox x		= BOX(V, x)
+    fun vbox EMPTY      = EMPTY
+      | vbox x          = BOX(V, x)
 
-    fun fbox EMPTY	= EMPTY
-      | fbox x		= BOX(F, x)
+    fun fbox EMPTY      = EMPTY
+      | fbox x          = BOX(F, x)
 
-    fun abox EMPTY	= EMPTY
-      | abox x		= BOX(A, x)
+    fun abox EMPTY      = EMPTY
+      | abox x          = BOX(A, x)
 
-    fun nest k EMPTY	= EMPTY
-      | nest k x	= NEST(k, x)
+    fun nest k EMPTY    = EMPTY
+      | nest k x        = NEST(k, x)
 
 
-    fun isEmpty EMPTY	= true
-      | isEmpty _	= false
+    fun isEmpty EMPTY   = true
+      | isEmpty _       = false
 
 
     (* Check whether the first line of a document fits into remaining characters *)
@@ -8307,47 +8307,47 @@
      *)
 
     fun fits(w, z) =
-	w >= 0 andalso
-	case z
-	  of []			=> true
-	   | (i,m,EMPTY)::z	=> fits(w, z)
-	   | (i,m,CONS(x,y))::z	=> fits(w, (i,m,x)::(i,m,y)::z)
-	   | (i,m,TEXT s)::z	=> fits(w - String.size s, z)
-	   | (i,H,BREAK s)::z	=> fits(w - String.size s, z)
-	   | (i,A,BREAK s)::z	=> false
-	   | (i,m,BREAK s)::z	=> true
-	   | (i,m,BOX(V,x))::z	=> fits(w, (i,A,x)::z)
-	   | (i,m,BOX(n,x))::z	=> fits(w, (i,H,x)::z)
-	   | (i,m,NEST(j,x))::z	=> fits(w, (i,m,x)::z)
-	   | (i,m,BELOW x)::z	=> fits(w, (i,m,x)::z)
+        w >= 0 andalso
+        case z
+          of []                 => true
+           | (i,m,EMPTY)::z     => fits(w, z)
+           | (i,m,CONS(x,y))::z => fits(w, (i,m,x)::(i,m,y)::z)
+           | (i,m,TEXT s)::z    => fits(w - String.size s, z)
+           | (i,H,BREAK s)::z   => fits(w - String.size s, z)
+           | (i,A,BREAK s)::z   => false
+           | (i,m,BREAK s)::z   => true
+           | (i,m,BOX(V,x))::z  => fits(w, (i,A,x)::z)
+           | (i,m,BOX(n,x))::z  => fits(w, (i,H,x)::z)
+           | (i,m,NEST(j,x))::z => fits(w, (i,m,x)::z)
+           | (i,m,BELOW x)::z   => fits(w, (i,m,x)::z)
 
 
     (* Layout *)
 
     fun best(w, k, z, a) =
-	case z
-	  of []			=> List.rev a
-	   | (i,m,EMPTY)::z	=> best(w, k, z, a)
-	   | (i,m,CONS(x,y))::z	=> best(w, k, (i,m,x)::(i,m,y)::z, a)
-	   | (i,m,TEXT s)::z	=> best(w, k + String.size s, z, PTEXT(s)::a)
-	   | (i,H,BREAK s)::z	=> horizontal(w, k, s, z, a)
-	   | (i,V,BREAK s)::z	=> vertical(w, i, z, a)
-	   | (i,F,BREAK s)::z	=> if fits(w - k - String.size s, z)
-				   then horizontal(w, k, s, z, a)
-				   else vertical(w, i, z, a)
-	   | (i,A,BREAK s)::z	=> raise Fail "PrettyPrint.best"
-	   | (i,m,BOX(A,x))::z	=> if fits(w - k, (i,H,x)::z)
-				   then best(w, k, (i,H,x)::z, a)
-				   else best(w, k, (i,V,x)::z, a)
-	   | (i,m,BOX(n,x))::z	=> best(w, k, (i,n,x)::z, a)
-	   | (i,m,NEST(j,x))::z	=> best(w, k, (i+j,m,x)::z, a)
-	   | (i,m,BELOW x)::z	=> best(w, k, (k,m,x)::z, a)
+        case z
+          of []                 => List.rev a
+           | (i,m,EMPTY)::z     => best(w, k, z, a)
+           | (i,m,CONS(x,y))::z => best(w, k, (i,m,x)::(i,m,y)::z, a)
+           | (i,m,TEXT s)::z    => best(w, k + String.size s, z, PTEXT(s)::a)
+           | (i,H,BREAK s)::z   => horizontal(w, k, s, z, a)
+           | (i,V,BREAK s)::z   => vertical(w, i, z, a)
+           | (i,F,BREAK s)::z   => if fits(w - k - String.size s, z)
+                                   then horizontal(w, k, s, z, a)
+                                   else vertical(w, i, z, a)
+           | (i,A,BREAK s)::z   => raise Fail "PrettyPrint.best"
+           | (i,m,BOX(A,x))::z  => if fits(w - k, (i,H,x)::z)
+                                   then best(w, k, (i,H,x)::z, a)
+                                   else best(w, k, (i,V,x)::z, a)
+           | (i,m,BOX(n,x))::z  => best(w, k, (i,n,x)::z, a)
+           | (i,m,NEST(j,x))::z => best(w, k, (i+j,m,x)::z, a)
+           | (i,m,BELOW x)::z   => best(w, k, (k,m,x)::z, a)
 
     and horizontal(w, k, s, z, a) =
-	    best(w, k + String.size s, z, PTEXT(s)::a)
+            best(w, k + String.size s, z, PTEXT(s)::a)
 
     and vertical(w, i, z, a) =
-	    best(w, i, z, PLINE(i)::a)
+            best(w, i, z, PLINE(i)::a)
 
 
     fun layout(doc, w) = best(w, 0, [(0,V,doc)], [])
@@ -8358,7 +8358,7 @@
 
     fun primToString(PTEXT s) = s
       | primToString(PLINE i) = 
-	    String.implode(#"\n" :: List.tabulate(i, fn _ => #" "))
+            String.implode(#"\n" :: List.tabulate(i, fn _ => #" "))
 
     val toString = String.concat o List.map primToString o layout
 
@@ -8371,9 +8371,9 @@
 
     fun outputPrim os (PTEXT s) = TextIO.output(os, s)
       | outputPrim os (PLINE i) =
-	    ( TextIO.output1(os, #"\n")
-	    ; loop i (fn() => TextIO.output1(os, #" "))
-	    )
+            ( TextIO.output1(os, #"\n")
+            ; loop i (fn() => TextIO.output1(os, #" "))
+            )
 
     fun output(os, doc, w) = List.app (outputPrim os) (layout(doc, w))
 
@@ -8389,16 +8389,16 @@
 
     type doc = PrettyPrint.doc
 
-    val nest:		doc -> doc
+    val nest:           doc -> doc
 
-    val paren:		doc -> doc
-    val brace:		doc -> doc
-    val brack:		doc -> doc
+    val paren:          doc -> doc
+    val brace:          doc -> doc
+    val brack:          doc -> doc
 
-    val ppCommaList:	('a -> doc) -> 'a list -> doc
-    val ppStarList:	('a -> doc) -> 'a list -> doc
-    val ppSeq:		('a -> doc) -> 'a list -> doc
-    val ppSeqPrec:	(int -> 'a -> doc) -> int -> 'a list -> doc
+    val ppCommaList:    ('a -> doc) -> 'a list -> doc
+    val ppStarList:     ('a -> doc) -> 'a list -> doc
+    val ppSeq:          ('a -> doc) -> 'a list -> doc
+    val ppSeqPrec:      (int -> 'a -> doc) -> int -> 'a list -> doc
 
   end
 (* stop of PP_MISC.sml *)
@@ -8428,12 +8428,12 @@
     fun ppCommaList ppX   []    = empty
       | ppCommaList ppX   [x]   = ppX x
       | ppCommaList ppX (x::xs) = ppX x ^^ text "," ^^ break ^^
-				  ppCommaList ppX xs
+                                  ppCommaList ppX xs
 
     fun ppStarList ppX   []     = empty
       | ppStarList ppX   [x]    = ppX x
       | ppStarList ppX (x::xs)  = hbox(ppX x ^^ break ^^ text "*") ^^ break ^^
-				  ppStarList ppX xs
+                                  ppStarList ppX xs
 
     fun ppSeqPrec ppXPrec n []  = empty
       | ppSeqPrec ppXPrec n [x] = ppXPrec n x
@@ -8493,124 +8493,124 @@
     (* Values *)
 
     (* Precedence:
-     *	0 : plain expressions
-     *	1 : constructor arguments
+     *  0 : plain expressions
+     *  1 : constructor arguments
      *)
 
     fun ppVal  (s, v) = fbox(below(nest(ppValPrec (0, s) v)))
     and ppExVal(s, e) = fbox(below(nest(ppExValPrec (0, s) e)))
 
     and ppValPrec (p, s) (op:=) =
-	    ppFn
+            ppFn
 
       | ppValPrec (p, s) (SVal sv) =
-	    ppSVal sv
+            ppSVal sv
 
       | ppValPrec (p, s) (BasVal b) =
-	    ppFn
+            ppFn
 
       | ppValPrec (p, s) (VId vid) =
-	    ppVId vid
+            ppVId vid
 
       | ppValPrec (p, s) (v as VIdVal(vid, v')) =
-	let
-	    exception NotAList
+        let
+            exception NotAList
 
-	    fun items(VId vid, vs) =
-		if vid <> VId.fromString "nil" then
-		    raise NotAList
-		else
-		    List.rev vs
+            fun items(VId vid, vs) =
+                if vid <> VId.fromString "nil" then
+                    raise NotAList
+                else
+                    List.rev vs
 
-	      | items(VIdVal(vid, v), vs) =
-		if vid <> VId.fromString "::" then
-		    raise NotAList
-		else
-		    (case Val.unpair v
-		       of NONE         => raise NotAList
-		        | SOME(v1, v2) => items(v2, v1::vs)
-		    )
+              | items(VIdVal(vid, v), vs) =
+                if vid <> VId.fromString "::" then
+                    raise NotAList
+                else
+                    (case Val.unpair v
+                       of NONE         => raise NotAList
+                        | SOME(v1, v2) => items(v2, v1::vs)
+                    )
 
-	      | items(_, vs) = raise NotAList
-	in
-	    let
-		val vs = items(v, [])
-	    in
-		brack(ppCommaList (ppValPrec (0, s)) vs)
-	    end
-	    handle NotAList =>
-	    let
-		val doc = ppVId vid ^/^ ppValPrec (1, s) v'
-	    in
-		if p = 0 then
-		    doc
-		else
-		    paren doc
-	    end
-	end
+              | items(_, vs) = raise NotAList
+        in
+            let
+                val vs = items(v, [])
+            in
+                brack(ppCommaList (ppValPrec (0, s)) vs)
+            end
+            handle NotAList =>
+            let
+                val doc = ppVId vid ^/^ ppValPrec (1, s) v'
+            in
+                if p = 0 then
+                    doc
+                else
+                    paren doc
+            end
+        end
 
       | ppValPrec (p, s) (ExVal e) =
-	    ppExValPrec (p, s) e
+            ppExValPrec (p, s) e
 
       | ppValPrec (p, s) (Record r) =
-	let
-	    fun isTuple(   [],     n) = n > 2
-	      | isTuple(lab::labs, n) =
-		    lab = Lab.fromInt n andalso isTuple(labs, n+1)
+        let
+            fun isTuple(   [],     n) = n > 2
+              | isTuple(lab::labs, n) =
+                    lab = Lab.fromInt n andalso isTuple(labs, n+1)
 
-	    val labvs     = LabMap.listItemsi r
-	    val (labs,vs) = ListPair.unzip labvs
-	in
-	    if List.null labs then
-		text "()"
-	    else if isTuple(labs, 1) then
-		paren(ppCommaList (ppValPrec (0, s)) vs)
-	    else
-		brace(ppCommaList (ppLabVal s) labvs)
-	end
+            val labvs     = LabMap.listItemsi r
+            val (labs,vs) = ListPair.unzip labvs
+        in
+            if List.null labs then
+                text "()"
+            else if isTuple(labs, 1) then
+                paren(ppCommaList (ppValPrec (0, s)) vs)
+            else
+                brace(ppCommaList (ppLabVal s) labvs)
+        end
 
       | ppValPrec (p, s) (Addr a) =
-	let
-	    val v   = case State.findAddr(s, a)
-			of SOME v => v
-			 | NONE   => raise Fail "PPVal.ppVal: invalid address"
+        let
+            val v   = case State.findAddr(s, a)
+                        of SOME v => v
+                         | NONE   => raise Fail "PPVal.ppVal: invalid address"
 
-	    val doc = text "ref" ^/^ ppValPrec (1, s) v
-	in
-	    if p = 0 then
-		doc
-	    else
-		paren doc
-	end
+            val doc = text "ref" ^/^ ppValPrec (1, s) v
+        in
+            if p = 0 then
+                doc
+            else
+                paren doc
+        end
 
       | ppValPrec (p, s) (FcnClosure _) =
-	    ppFn
+            ppFn
 
 
     and ppLabVal s (lab, v) =
-	    abox(
-		hbox(
-		    ppLab lab ^/^
-		    text "="
-		) ^^
-		below(nest(break ^^
-		    ppVal(s, v)
-		))
-	    )
+            abox(
+                hbox(
+                    ppLab lab ^/^
+                    text "="
+                ) ^^
+                below(nest(break ^^
+                    ppVal(s, v)
+                ))
+            )
 
 
     and ppExValPrec (p, s) (ExName en) =
-	    ppExName en
+            ppExName en
 
       | ppExValPrec (p, s) (ExNameVal(en, v)) =
-	let
-	    val doc = ppExName en ^/^ ppValPrec (1, s) v
-	in
-	    if p = 0 then
-		doc
-	    else
-		paren doc
-	end
+        let
+            val doc = ppExName en ^/^ ppValPrec (1, s) v
+        in
+            if p = 0 then
+                doc
+            else
+                paren doc
+        end
 
   end
 (* stop of PPVal.sml *)
@@ -8661,92 +8661,92 @@
     (* Environments *)
 
     fun ppValEnv(s, VE) =
-	VIdMap.foldri
-	    (fn(vid, (v,IdStatus.v), doc) =>
-		abox(
-		    hbox(
-			text "val" ^/^
-			ppVId vid ^/^
-			text "="
-		    ) ^^
-		    nest(break ^^
-			abox(PPVal.ppVal(s, v))
-		    )
-		) ^/^
-		doc
+        VIdMap.foldri
+            (fn(vid, (v,IdStatus.v), doc) =>
+                abox(
+                    hbox(
+                        text "val" ^/^
+                        ppVId vid ^/^
+                        text "="
+                    ) ^^
+                    nest(break ^^
+                        abox(PPVal.ppVal(s, v))
+                    )
+                ) ^/^
+                doc
 
-	     | (vid, (v,_), doc) => doc
-	    )
-	    empty VE
+             | (vid, (v,_), doc) => doc
+            )
+            empty VE
 
     fun ppExEnv VE =
-	VIdMap.foldri
-	    (fn(vid, (v,IdStatus.e), doc) =>
-		hbox(
-		    text "exception" ^/^
-		    ppVId vid
-		) ^/^
-		doc
+        VIdMap.foldri
+            (fn(vid, (v,IdStatus.e), doc) =>
+                hbox(
+                    text "exception" ^/^
+                    ppVId vid
+                ) ^/^
+                doc
 
-	     | (vid, (v,_), doc) => doc
-	    )
-	    empty VE
+             | (vid, (v,_), doc) => doc
+            )
+            empty VE
 
     fun ppConEnv VE =
-	VIdMap.foldli
-	    (fn(vid, (v,IdStatus.c), doc) =>
-		hbox(
-		    text "con" ^/^
-		    ppVId vid
-		) ^/^
-		doc
+        VIdMap.foldli
+            (fn(vid, (v,IdStatus.c), doc) =>
+                hbox(
+                    text "con" ^/^
+                    ppVId vid
+                ) ^/^
+                doc
 
-	     | (vid, (v,_), doc) => doc
-	    )
-	    empty VE
+             | (vid, (v,_), doc) => doc
+            )
+            empty VE
 
     fun ppStrEnv(s, SE) =
-	StrIdMap.foldri
-	    (fn(strid, S, doc) =>
-		abox(
-		    hbox(
-			text "structure" ^/^
-			ppStrId strid ^/^
-			text "="
-		    ) ^^
-		    nest(break ^^
-			ppStr(s, S)
-		    )
-		) ^/^
-		doc
-	    )
-	    empty SE
+        StrIdMap.foldri
+            (fn(strid, S, doc) =>
+                abox(
+                    hbox(
+                        text "structure" ^/^
+                        ppStrId strid ^/^
+                        text "="
+                    ) ^^
+                    nest(break ^^
+                        ppStr(s, S)
+                    )
+                ) ^/^
+                doc
+            )
+            empty SE
 
     and ppEnv(s, (SE,TE,VE)) =
-	    vbox(
-		ppStrEnv(s, SE) ^/^
-		ppConEnv VE ^/^
-		ppExEnv  VE ^/^
-		ppValEnv(s, VE)
-	    )
+            vbox(
+                ppStrEnv(s, SE) ^/^
+                ppConEnv VE ^/^
+                ppExEnv  VE ^/^
+                ppValEnv(s, VE)
+            )
 
 
     (* Structures *)
 
     and ppStr(s, DynamicEnv.Str E) =
-	let
-	    val doc = ppEnv(s, E)
-	in
-	    abox(below(
-		text "struct" ^^
-		(if isEmpty doc then
-		    empty
-		 else
-		    nest(vbox(break ^^ doc))
-		) ^^ break ^^
-		text "end"
-	    ))
-	end
+        let
+            val doc = ppEnv(s, E)
+        in
+            abox(below(
+                text "struct" ^^
+                (if isEmpty doc then
+                    empty
+                 else
+                    nest(vbox(break ^^ doc))
+                ) ^^ break ^^
+                text "end"
+            ))
+        end
 
   end
 (* stop of PPDynamicEnv.sml *)
@@ -8792,25 +8792,25 @@
     (* Environments *)
 
     fun ppFunEnv F =
-	FunIdMap.foldri
-	    (fn(funid, _, doc) =>
-		hbox(
-		    text "functor" ^/^
-		    ppFunId funid
-		) ^/^
-		doc
-	    )
-	    empty F
+        FunIdMap.foldri
+            (fn(funid, _, doc) =>
+                hbox(
+                    text "functor" ^/^
+                    ppFunId funid
+                ) ^/^
+                doc
+            )
+            empty F
 
 
     (* Basis *)
 
     fun ppBasis(s, (F,G,E)) =
-	    vbox(
-		ppFunEnv F ^/^
-		PPDynamicEnv.ppEnv(s, E) ^/^
-		text ""
-	    )
+            vbox(
+                ppFunEnv F ^/^
+                PPDynamicEnv.ppEnv(s, E) ^/^
+                text ""
+            )
 
   end
 (* stop of PPDynamicBasis.sml *)
@@ -8831,9 +8831,9 @@
  *     (2) There is no requirement of consistency for constructors in
  *         sharing specifications or type realisations (actually, we
  *         consider this a serious bug). For example,
- *		datatype t1 = A | B
- *		datatype t2 = C
- *		sharing type t1 = t2
+ *              datatype t1 = A | B
+ *              datatype t2 = C
+ *              sharing type t1 = t2
  *         is a legal specification. This allows a mix of the constructors
  *         to appear in matches, rendering the terms of irredundancy and
  *         exhaustiveness meaningless. We make no attempt to detect this,
@@ -8853,8 +8853,8 @@
 
     (* Operations *)
 
-    val checkPat:	Env * Pat   -> unit
-    val checkMatch:	Env * Match -> unit
+    val checkPat:       Env * Pat   -> unit
+    val checkMatch:     Env * Match -> unit
 
   end
 (* stop of CHECK_PATTERN.sml *)
@@ -8875,9 +8875,9 @@
  *     (2) There is no requirement of consistency for constructors in
  *         sharing specifications or type realisations (actually, we
  *         consider this a serious bug). For example,
- *		datatype t1 = A | B
- *		datatype t2 = C
- *		sharing type t1 = t2
+ *              datatype t1 = A | B
+ *              datatype t2 = C
+ *              sharing type t1 = t2
  *         is a legal specification. This allows a mix of the constructors
  *         to appear in matches, rendering the terms of irredundancy and
  *         exhaustiveness meaningless. We make no attempt to detect this,
@@ -8928,20 +8928,20 @@
     (* Value description *)
 
     datatype description =
-	  ANY
-	| SCON      of SCon
-	| NOT_SCON  of SConSet
-	| EXCON     of longVId * description option
-	| NOT_EXCON of LongVIdSet
-	| CON       of VId * description option
-	| NOT_CON   of VIdSet
-	| RECORD    of description LabMap
+          ANY
+        | SCON      of SCon
+        | NOT_SCON  of SConSet
+        | EXCON     of longVId * description option
+        | NOT_EXCON of LongVIdSet
+        | CON       of VId * description option
+        | NOT_CON   of VIdSet
+        | RECORD    of description LabMap
 
     datatype context =
-	  EXCON'  of longVId
-	| CON'    of VId
-	| LAB'    of Lab
-	| RECORD' of description LabMap
+          EXCON'  of longVId
+        | CON'    of VId
+        | LAB'    of Lab
+        | RECORD' of description LabMap
 
     type knowledge = description * context list
 
@@ -8952,13 +8952,13 @@
     (* Extending the context on partial success *)
 
     fun augment(EXCON'(longvid)::context, desc) =
-	    augment(context, EXCON(longvid, SOME desc))
+            augment(context, EXCON(longvid, SOME desc))
 
       | augment(CON'(vid)::context, desc) =
-	    augment(context, CON(vid, SOME desc))
+            augment(context, CON(vid, SOME desc))
 
       | augment(LAB'(lab)::RECORD'(descs)::context, desc) =
-	    RECORD'(LabMap.insert(descs, lab, desc)) :: context
+            RECORD'(LabMap.insert(descs, lab, desc)) :: context
 
       | augment _ = raise Fail "CheckPattern.augment: invalid context"
 
@@ -8966,16 +8966,16 @@
     (* Building the description on failure *)
 
     fun build([], desc) =
-	    desc
+            desc
 
       | build(EXCON'(longvid)::context, desc) =
-	    build(context, EXCON(longvid, SOME desc))
+            build(context, EXCON(longvid, SOME desc))
 
       | build(CON'(vid)::context, desc) =
-	    build(context, CON(vid, SOME desc))
+            build(context, CON(vid, SOME desc))
 
       | build(LAB'(lab)::RECORD'(descs)::context, desc) =
-	    build(context, RECORD(LabMap.insert(descs, lab, desc)))
+            build(context, RECORD(LabMap.insert(descs, lab, desc)))
 
       | build _ = raise Fail "CheckPattern.build: invalid context"
 
@@ -8983,7 +8983,7 @@
     (* Result type for static matching *)
 
     structure RegionSet = FinSetFn(type ord_key = Source.region
-				   val compare  = Source.compare)
+                                   val compare  = Source.compare)
 
     type result = RegionSet.set * bool
 
@@ -8991,279 +8991,279 @@
     val failure = ( RegionSet.empty, false )
 
     fun branch((P1, exhaustive1), (P2, exhaustive2)) =
-	    ( RegionSet.union(P1, P2), exhaustive1 andalso exhaustive2 )
+            ( RegionSet.union(P1, P2), exhaustive1 andalso exhaustive2 )
 
     fun reached(I, (P, exhaustive)) =
-	    ( RegionSet.add(P, I), exhaustive )
+            ( RegionSet.add(P, I), exhaustive )
 
 
 
     (* Static pattern matching *)
 
     fun matchMatch(E, desc, Match(_, mrule, match_opt)) =
-	    matchMrule(E, desc, mrule, match_opt)
+            matchMrule(E, desc, mrule, match_opt)
 
 
     and matchMrule(E, desc, Mrule(I, pat, exp), match_opt) =
-	    reached(I, matchPat(E, (desc, []), pat, ([], match_opt)))
+            reached(I, matchPat(E, (desc, []), pat, ([], match_opt)))
 
 
     and matchAtPat(E, know, atpat, cont) =
-	case atpat
-	  of WILDCARDAtPat(_) =>
-		succeed(E, know, cont)
+        case atpat
+          of WILDCARDAtPat(_) =>
+                succeed(E, know, cont)
 
-	   | SCONAtPat(_, scon) =>
-		matchSCon(E, know, scon, cont)
+           | SCONAtPat(_, scon) =>
+                matchSCon(E, know, scon, cont)
 
-	   | LONGVIDAtPat(_, _, longvid) =>
-	       (case StaticEnv.findLongVId(E, longvid)
-		  of NONE =>
-			succeed(E, know, cont)
+           | LONGVIDAtPat(_, _, longvid) =>
+               (case StaticEnv.findLongVId(E, longvid)
+                  of NONE =>
+                        succeed(E, know, cont)
 
-		   | SOME(sigma, IdStatus.v) =>
-			succeed(E, know, cont)
+                   | SOME(sigma, IdStatus.v) =>
+                        succeed(E, know, cont)
 
-		   | SOME(sigma, IdStatus.e) =>
-			matchExCon(E, know, longvid, NONE, cont)
+                   | SOME(sigma, IdStatus.e) =>
+                        matchExCon(E, know, longvid, NONE, cont)
 
-		   | SOME((_,tau), IdStatus.c) =>
-		     let
-			val vid  = LongVId.toId longvid
-			val span = TyName.span(Type.tyname(Type.range tau))
-		     in
-			matchCon(E, know, vid, span, NONE, cont)
-		     end
-	       )
+                   | SOME((_,tau), IdStatus.c) =>
+                     let
+                        val vid  = LongVId.toId longvid
+                        val span = TyName.span(Type.tyname(Type.range tau))
+                     in
+                        matchCon(E, know, vid, span, NONE, cont)
+                     end
+               )
 
-	   | RECORDAtPat(_, patrow_opt) =>
-		matchRecord(E, know, patrow_opt, cont)
+           | RECORDAtPat(_, patrow_opt) =>
+                matchRecord(E, know, patrow_opt, cont)
 
-	   | PARAtPat(_, pat) =>
-		matchPat(E, know, pat, cont)
+           | PARAtPat(_, pat) =>
+                matchPat(E, know, pat, cont)
 
 
     and matchPat(E, know, pat, cont) =
-	case pat
-	  of ATPATPat(_, atpat) =>
-		matchAtPat(E, know, atpat, cont)
+        case pat
+          of ATPATPat(_, atpat) =>
+                matchAtPat(E, know, atpat, cont)
 
-	   | CONPat(_, _, longvid, atpat) =>
-	       (case StaticEnv.findLongVId(E, longvid)
-		  of SOME(sigma, IdStatus.e) =>
-			matchExCon(E, know, longvid, SOME atpat, cont)
+           | CONPat(_, _, longvid, atpat) =>
+               (case StaticEnv.findLongVId(E, longvid)
+                  of SOME(sigma, IdStatus.e) =>
+                        matchExCon(E, know, longvid, SOME atpat, cont)
 
-		   | SOME((_,tau), IdStatus.c) =>
-		     let
-			val vid  = LongVId.toId longvid
-			val span = TyName.span(Type.tyname(Type.range tau))
-		     in
-			matchCon(E, know, vid, span, SOME atpat, cont)
-		     end
+                   | SOME((_,tau), IdStatus.c) =>
+                     let
+                        val vid  = LongVId.toId longvid
+                        val span = TyName.span(Type.tyname(Type.range tau))
+                     in
+                        matchCon(E, know, vid, span, SOME atpat, cont)
+                     end
 
-		   | _ => raise Fail "CheckMatching.matchPat: \
-				     \invalid constructed pattern"
-	       )
+                   | _ => raise Fail "CheckMatching.matchPat: \
+                                     \invalid constructed pattern"
+               )
 
-	  | TYPEDPat(_, pat, ty) =>
-		matchPat(E, know, pat, cont)
+          | TYPEDPat(_, pat, ty) =>
+                matchPat(E, know, pat, cont)
 
-	  | ASPat(_, _, vid, ty_opt, pat) =>
-		matchPat(E, know, pat, cont)
+          | ASPat(_, _, vid, ty_opt, pat) =>
+                matchPat(E, know, pat, cont)
 
 
     and matchRecord(E, (desc, context), patrow_opt, cont) =
-	let
-	    val descs = case desc
-			  of ANY          => LabMap.empty
-			   | RECORD descs => descs
-			   | _ =>
-			     raise Fail "CheckPattern.matchRecord: type error"
-	in
-	    matchPatRowOpt(E, RECORD'(descs)::context, patrow_opt, cont)
-	end
+        let
+            val descs = case desc
+                          of ANY          => LabMap.empty
+                           | RECORD descs => descs
+                           | _ =>
+                             raise Fail "CheckPattern.matchRecord: type error"
+        in
+            matchPatRowOpt(E, RECORD'(descs)::context, patrow_opt, cont)
+        end
 
 
     and matchPatRowOpt(E, RECORD'(descs)::context, patrow_opt,
-					cont as (patrow_opts, match_opt)) =
-	(case patrow_opt
-	   of SOME(ROWPatRow(_, lab, pat, patrow_opt')) =>
-	      let
-		  val desc' = case LabMap.find(descs, lab)
-				of NONE       => ANY
-				 | SOME desc' => desc'
-	      in
-		  matchPat(E, (desc', LAB'(lab)::RECORD'(descs)::context), pat,
-			   (patrow_opt'::patrow_opts, match_opt))
-	      end
+                                        cont as (patrow_opts, match_opt)) =
+        (case patrow_opt
+           of SOME(ROWPatRow(_, lab, pat, patrow_opt')) =>
+              let
+                  val desc' = case LabMap.find(descs, lab)
+                                of NONE       => ANY
+                                 | SOME desc' => desc'
+              in
+                  matchPat(E, (desc', LAB'(lab)::RECORD'(descs)::context), pat,
+                           (patrow_opt'::patrow_opts, match_opt))
+              end
 
-	    | _ =>
-		  succeed(E, (RECORD descs, context), cont)
-	)
+            | _ =>
+                  succeed(E, (RECORD descs, context), cont)
+        )
       | matchPatRowOpt _ =
-	    raise Fail "CheckPattern.matchPatRowOpt: inconsistent context"
+            raise Fail "CheckPattern.matchPatRowOpt: inconsistent context"
 
 
     and matchSCon(E, know as (desc, context), scon, cont) =
-	let
-	   val knowSucc       = (SCON scon, context)
-	   fun knowFail scons = (NOT_SCON(SConSet.add(scons, scon)), context)
-	in
-	   case desc
-	     of ANY =>
-		branch(succeed(E, knowSucc, cont),
-		       fail(E, knowFail SConSet.empty, cont)
-		      )
+        let
+           val knowSucc       = (SCON scon, context)
+           fun knowFail scons = (NOT_SCON(SConSet.add(scons, scon)), context)
+        in
+           case desc
+             of ANY =>
+                branch(succeed(E, knowSucc, cont),
+                       fail(E, knowFail SConSet.empty, cont)
+                      )
 
-	      | SCON scon' =>
-		if SCon.compare(scon, scon') = EQUAL then
-		    succeed(E, know, cont)
-		else
-		    fail(E, know, cont)
+              | SCON scon' =>
+                if SCon.compare(scon, scon') = EQUAL then
+                    succeed(E, know, cont)
+                else
+                    fail(E, know, cont)
 
-	      | NOT_SCON scons =>
-		if SConSet.member(scons, scon) then
-		    fail(E, know, cont)
-		else
-		    branch(succeed(E, knowSucc, cont),
-		 	   fail(E, knowFail scons, cont)
-			  )
+              | NOT_SCON scons =>
+                if SConSet.member(scons, scon) then
+                    fail(E, know, cont)
+                else
+                    branch(succeed(E, knowSucc, cont),
+                           fail(E, knowFail scons, cont)
+                          )
 
-	      | _ => raise Fail "CheckPattern.matchSCon: type error"
-	end
+              | _ => raise Fail "CheckPattern.matchSCon: type error"
+        end
 
 
     and matchExCon(E, know as (desc, context), longvid, atpat_opt, cont) =
-	let
-	   val knowSucc = (EXCON(longvid, NONE), EXCON'(longvid)::context)
-	   fun knowFail longvids =
-		(NOT_EXCON(LongVIdSet.add(longvids, longvid)), context)
-	in
-	   case desc
-	     of ANY =>
-		branch(matchArgOpt(E, knowSucc, SOME ANY, atpat_opt, cont),
-		       fail(E, knowFail LongVIdSet.empty, cont)
-		      )
+        let
+           val knowSucc = (EXCON(longvid, NONE), EXCON'(longvid)::context)
+           fun knowFail longvids =
+                (NOT_EXCON(LongVIdSet.add(longvids, longvid)), context)
+        in
+           case desc
+             of ANY =>
+                branch(matchArgOpt(E, knowSucc, SOME ANY, atpat_opt, cont),
+                       fail(E, knowFail LongVIdSet.empty, cont)
+                      )
 
-	      | EXCON(longvid', desc_opt) =>
-		if longvid = longvid' then
-		    matchArgOpt(E, knowSucc, desc_opt, atpat_opt, cont)
-		else
-		    fail(E, know, cont)
+              | EXCON(longvid', desc_opt) =>
+                if longvid = longvid' then
+                    matchArgOpt(E, knowSucc, desc_opt, atpat_opt, cont)
+                else
+                    fail(E, know, cont)
 
-	      | NOT_EXCON longvids =>
-		if LongVIdSet.member(longvids, longvid) then
-		    fail(E, know, cont)
-		else
-		    branch(matchArgOpt(E, knowSucc, SOME ANY, atpat_opt, cont),
-			   fail(E, knowFail longvids, cont)
-			  )
+              | NOT_EXCON longvids =>
+                if LongVIdSet.member(longvids, longvid) then
+                    fail(E, know, cont)
+                else
+                    branch(matchArgOpt(E, knowSucc, SOME ANY, atpat_opt, cont),
+                           fail(E, knowFail longvids, cont)
+                          )
 
-	      | _ => raise Fail "CheckPattern.matchSCon: type error"
-	end
+              | _ => raise Fail "CheckPattern.matchSCon: type error"
+        end
 
 
     and matchCon(E, know as (desc, context), vid, span, atpat_opt, cont) =
-	let
-	   val knowSucc      = (CON(vid, NONE), CON'(vid)::context)
-	   fun knowFail vids = (NOT_CON(VIdSet.add(vids, vid)), context)
-	in
-	   case desc
-	     of ANY =>
-		if span = 1 then
-		    matchArgOpt(E, knowSucc, SOME ANY, atpat_opt, cont)
-		else
-		    branch(matchArgOpt(E, knowSucc, SOME ANY, atpat_opt, cont),
-			   fail(E, knowFail VIdSet.empty, cont)
-		    )
+        let
+           val knowSucc      = (CON(vid, NONE), CON'(vid)::context)
+           fun knowFail vids = (NOT_CON(VIdSet.add(vids, vid)), context)
+        in
+           case desc
+             of ANY =>
+                if span = 1 then
+                    matchArgOpt(E, knowSucc, SOME ANY, atpat_opt, cont)
+                else
+                    branch(matchArgOpt(E, knowSucc, SOME ANY, atpat_opt, cont),
+                           fail(E, knowFail VIdSet.empty, cont)
+                    )
 
-	      | CON(vid', desc_opt) =>
-		if vid = vid' then
-		    matchArgOpt(E, knowSucc, desc_opt, atpat_opt, cont)
-		else
-		    fail(E, know, cont)
+              | CON(vid', desc_opt) =>
+                if vid = vid' then
+                    matchArgOpt(E, knowSucc, desc_opt, atpat_opt, cont)
+                else
+                    fail(E, know, cont)
 
-	      | NOT_CON vids =>
-		if VIdSet.member(vids, vid) then
-		    fail(E, know, cont)
-		else if VIdSet.numItems vids = span - 1 then
-		    matchArgOpt(E, knowSucc, SOME ANY, atpat_opt, cont)
-		else
-		    branch(matchArgOpt(E, knowSucc, SOME ANY, atpat_opt, cont),
-			   fail(E, knowFail vids, cont)
-			  )
+              | NOT_CON vids =>
+                if VIdSet.member(vids, vid) then
+                    fail(E, know, cont)
+                else if VIdSet.numItems vids = span - 1 then
+                    matchArgOpt(E, knowSucc, SOME ANY, atpat_opt, cont)
+                else
+                    branch(matchArgOpt(E, knowSucc, SOME ANY, atpat_opt, cont),
+                           fail(E, knowFail vids, cont)
+                          )
 
-	      | _ => raise Fail "CheckPattern.matchSCon: type error"
-	end
+              | _ => raise Fail "CheckPattern.matchSCon: type error"
+        end
 
 
     and matchArgOpt(E, (desc, context), desc_opt, atpat_opt, cont) =
-	case atpat_opt
-	  of NONE =>
-		succeed(E, (desc, List.tl context), cont)
+        case atpat_opt
+          of NONE =>
+                succeed(E, (desc, List.tl context), cont)
 
-	   | SOME atpat =>
-		matchAtPat(E, (valOf desc_opt, context), atpat, cont)
+           | SOME atpat =>
+                matchAtPat(E, (valOf desc_opt, context), atpat, cont)
 
 
 
     and succeed(E, know, ([], match_opt)) =
-	    success
+            success
 
       | succeed(E, (desc, context), (patrow_opt::patrow_opts, match_opt)) =
-	let
-	    val context' = augment(context, desc)
-	in
-	    matchPatRowOpt(E, context', patrow_opt, (patrow_opts, match_opt))
-	end
+        let
+            val context' = augment(context, desc)
+        in
+            matchPatRowOpt(E, context', patrow_opt, (patrow_opts, match_opt))
+        end
 
 
     and fail(E, know, (_, NONE)) =
-	    failure
+            failure
 
       | fail(E, (desc, context), (_, SOME match)) =
-	    matchMatch(E, build(context, desc), match)
+            matchMatch(E, build(context, desc), match)
 
 
 
     (* Checking matches [Section 4.11, item 2] *)
 
     fun checkReachableMrule(reachables, Mrule(I, _, _)) =
-	    if RegionSet.member(reachables, I) then
-		()
-	    else
-		Error.warning(I, "redundant match rule")
+            if RegionSet.member(reachables, I) then
+                ()
+            else
+                Error.warning(I, "redundant match rule")
 
     fun checkReachableMatchOpt(reachables, NONE)                             = ()
       | checkReachableMatchOpt(reachables, SOME(Match(_, mrule, match_opt))) =
-	    ( checkReachableMrule(reachables, mrule)
-	    ; checkReachableMatchOpt(reachables, match_opt)
-	    )
+            ( checkReachableMrule(reachables, mrule)
+            ; checkReachableMatchOpt(reachables, match_opt)
+            )
 
     fun checkMatch(E, match) =
-	let
-	    val (reachables, exhaustive) = matchMatch(E, ANY, match)
-	in
-	    checkReachableMatchOpt(reachables, SOME match)
-	  ; if exhaustive then
-		()
-	    else
-		Error.warning(infoMatch match, "match not exhaustive")
-	end
+        let
+            val (reachables, exhaustive) = matchMatch(E, ANY, match)
+        in
+            checkReachableMatchOpt(reachables, SOME match)
+          ; if exhaustive then
+                ()
+            else
+                Error.warning(infoMatch match, "match not exhaustive")
+        end
 
 
 
     (* Checking single patterns [Section 4.11, item 3] *)
 
     fun checkPat(E, pat) =
-	let
-	    val (_, exhaustive) = matchPat(E, (ANY, []), pat, ([], NONE))
-	in
-	    if exhaustive then
-		()
-	    else
-		Error.warning(infoPat pat, "pattern not exhaustive")
-	end
+        let
+            val (_, exhaustive) = matchPat(E, (ANY, []), pat, ([], NONE))
+        in
+            if exhaustive then
+                ()
+            else
+                Error.warning(infoPat pat, "pattern not exhaustive")
+        end
 
   end
 (* stop of CheckPattern.sml *)
@@ -9300,13 +9300,13 @@
 
     (* Export *)
 
-    val elabDec:		bool * Context * Dec -> Env
-    val elabTy:			Context * Ty -> Type
+    val elabDec:                bool * Context * Dec -> Env
+    val elabTy:                 Context * Ty -> Type
 
-    val tyvars:			TyVarseq -> TyVarSet * TyVar list
+    val tyvars:                 TyVarseq -> TyVarSet * TyVar list
 
-    val validBindVId:		VId -> bool
-    val validConBindVId:	VId -> bool
+    val validBindVId:           VId -> bool
+    val validConBindVId:        VId -> bool
 
   end
 (* stop of ELAB_CORE.sml *)
@@ -9377,9 +9377,9 @@
 
     fun errorLongVId(I, s, longvid) = error(I, s ^ LongVId.toString longvid)
     fun errorLongTyCon(I, s, longtycon) =
-	    error(I, s ^ LongTyCon.toString longtycon)
+            error(I, s ^ LongTyCon.toString longtycon)
     fun errorLongStrId(I, s, longstrid) =
-	    error(I, s ^ LongStrId.toString longstrid)
+            error(I, s ^ LongStrId.toString longstrid)
 
 
 
@@ -9399,31 +9399,31 @@
     (* Checking restriction for vids in binding [Section 2.9, 5th bullet] *)
 
     fun validBindVId vid =
-	    vid <> VId.fromString "true" andalso
-	    vid <> VId.fromString "false" andalso
-	    vid <> VId.fromString "nil" andalso
-	    vid <> VId.fromString "::"  andalso
-	    vid <> VId.fromString "ref"
+            vid <> VId.fromString "true" andalso
+            vid <> VId.fromString "false" andalso
+            vid <> VId.fromString "nil" andalso
+            vid <> VId.fromString "::"  andalso
+            vid <> VId.fromString "ref"
 
     fun validConBindVId vid =
-	    validBindVId vid andalso
-	    vid <> VId.fromString "it"
+            validBindVId vid andalso
+            vid <> VId.fromString "it"
 
 
     (* Treating tyvarseqs *)
 
     fun tyvars(TyVarseq(I, tyvars)) =
-	let
-	    fun collect(     [],       U) = U
-	      | collect(tyvar::tyvars, U) =
-		    if TyVarSet.member(U, tyvar) then
-			(* Syntactic restriction [Section 2.9, 3rd bullet] *)
-			errorTyVar(I, "duplicate type variable ", tyvar)
-		    else
-			collect(tyvars, TyVarSet.add(U, tyvar))
-	in
-	    ( collect(tyvars, TyVarSet.empty), tyvars )
-	end
+        let
+            fun collect(     [],       U) = U
+              | collect(tyvar::tyvars, U) =
+                    if TyVarSet.member(U, tyvar) then
+                        (* Syntactic restriction [Section 2.9, 3rd bullet] *)
+                        errorTyVar(I, "duplicate type variable ", tyvar)
+                    else
+                        collect(tyvars, TyVarSet.add(U, tyvar))
+        in
+            ( collect(tyvars, TyVarSet.empty), tyvars )
+        end
 
 
 
@@ -9434,7 +9434,7 @@
       | typeSCon(SCon.CHAR _) = Type.fromOverloadingClass InitialStaticEnv.Char
       | typeSCon(SCon.REAL _) = Type.fromOverloadingClass InitialStaticEnv.Real
       | typeSCon(SCon.STRING _) =
-	    Type.fromOverloadingClass InitialStaticEnv.String
+            Type.fromOverloadingClass InitialStaticEnv.String
 
 
     (* Calculate sets of unguarded explicit type variables [Section 4.6] *)
@@ -9443,94 +9443,94 @@
         val op+ = TyVarSet.union
 
         fun ? tyvarsX  NONE    = TyVarSet.empty
-	  | ? tyvarsX (SOME x) = tyvarsX x
+          | ? tyvarsX (SOME x) = tyvarsX x
     in
 
     fun unguardedTyVarsAtExp(RECORDAtExp(_, exprow_opt)) =
-	    ?unguardedTyVarsExpRow exprow_opt
+            ?unguardedTyVarsExpRow exprow_opt
       | unguardedTyVarsAtExp(LETAtExp(_, dec, exp)) =
-	    unguardedTyVarsDec dec + unguardedTyVarsExp exp
+            unguardedTyVarsDec dec + unguardedTyVarsExp exp
       | unguardedTyVarsAtExp(PARAtExp(_, exp)) =
-	    unguardedTyVarsExp exp
+            unguardedTyVarsExp exp
       | unguardedTyVarsAtExp _ = TyVarSet.empty
 
     and unguardedTyVarsExpRow(ExpRow(_, lab, exp, exprow_opt)) =
-	    unguardedTyVarsExp exp + ?unguardedTyVarsExpRow exprow_opt
+            unguardedTyVarsExp exp + ?unguardedTyVarsExpRow exprow_opt
 
     and unguardedTyVarsExp(ATEXPExp(_, atexp)) =
-	    unguardedTyVarsAtExp atexp
+            unguardedTyVarsAtExp atexp
       | unguardedTyVarsExp(APPExp(_, exp, atexp)) =
-	    unguardedTyVarsExp exp + unguardedTyVarsAtExp atexp
+            unguardedTyVarsExp exp + unguardedTyVarsAtExp atexp
       | unguardedTyVarsExp(TYPEDExp(_, exp, ty)) =
-	    unguardedTyVarsExp exp + unguardedTyVarsTy ty
+            unguardedTyVarsExp exp + unguardedTyVarsTy ty
       | unguardedTyVarsExp(HANDLEExp(_, exp, match)) =
-	    unguardedTyVarsExp exp + unguardedTyVarsMatch match
+            unguardedTyVarsExp exp + unguardedTyVarsMatch match
       | unguardedTyVarsExp(RAISEExp(_, exp)) =
-	    unguardedTyVarsExp exp
+            unguardedTyVarsExp exp
       | unguardedTyVarsExp(FNExp(_, match)) =
-	    unguardedTyVarsMatch match
+            unguardedTyVarsMatch match
 
     and unguardedTyVarsMatch(Match(_, mrule, match_opt)) =
-	    unguardedTyVarsMrule mrule + ?unguardedTyVarsMatch match_opt
+            unguardedTyVarsMrule mrule + ?unguardedTyVarsMatch match_opt
 
     and unguardedTyVarsMrule(Mrule(_, pat, exp)) =
-	    unguardedTyVarsPat pat + unguardedTyVarsExp exp
+            unguardedTyVarsPat pat + unguardedTyVarsExp exp
 
     and unguardedTyVarsDec(ABSTYPEDec(_, datbind, dec)) =
-	    unguardedTyVarsDec dec
+            unguardedTyVarsDec dec
       | unguardedTyVarsDec(EXCEPTIONDec(_, exbind)) =
-	    unguardedTyVarsExBind exbind
+            unguardedTyVarsExBind exbind
       | unguardedTyVarsDec(LOCALDec(_, dec1, dec2)) =
-	    unguardedTyVarsDec dec1 + unguardedTyVarsDec dec2
+            unguardedTyVarsDec dec1 + unguardedTyVarsDec dec2
       | unguardedTyVarsDec(SEQDec(_, dec1, dec2)) =
-	    unguardedTyVarsDec dec1 + unguardedTyVarsDec dec2
+            unguardedTyVarsDec dec1 + unguardedTyVarsDec dec2
       | unguardedTyVarsDec _ = TyVarSet.empty
 
     and unguardedTyVarsValBind(PLAINValBind(_, pat, exp, valbind_opt)) =
-	    unguardedTyVarsPat pat + unguardedTyVarsExp exp +
-	    ?unguardedTyVarsValBind valbind_opt
+            unguardedTyVarsPat pat + unguardedTyVarsExp exp +
+            ?unguardedTyVarsValBind valbind_opt
       | unguardedTyVarsValBind(RECValBind(_, valbind)) =
-	    unguardedTyVarsValBind valbind
+            unguardedTyVarsValBind valbind
 
     and unguardedTyVarsExBind(NEWExBind(_, _, vid, ty_opt, exbind_opt)) =
-	    ?unguardedTyVarsTy ty_opt + ?unguardedTyVarsExBind exbind_opt
+            ?unguardedTyVarsTy ty_opt + ?unguardedTyVarsExBind exbind_opt
       | unguardedTyVarsExBind(EQUALExBind(_, _, vid, _, longvid, exbind_opt)) =
-	    ?unguardedTyVarsExBind exbind_opt
+            ?unguardedTyVarsExBind exbind_opt
 
     and unguardedTyVarsAtPat(RECORDAtPat(_, patrow_opt)) =
-	    ?unguardedTyVarsPatRow patrow_opt
+            ?unguardedTyVarsPatRow patrow_opt
       | unguardedTyVarsAtPat(PARAtPat(_, pat)) =
-	    unguardedTyVarsPat pat
+            unguardedTyVarsPat pat
       | unguardedTyVarsAtPat _ = TyVarSet.empty
 
     and unguardedTyVarsPatRow(WILDCARDPatRow(_)) = TyVarSet.empty
       | unguardedTyVarsPatRow(ROWPatRow(_, lab, pat, patrow_opt)) =
-	    unguardedTyVarsPat pat + ?unguardedTyVarsPatRow patrow_opt
+            unguardedTyVarsPat pat + ?unguardedTyVarsPatRow patrow_opt
 
     and unguardedTyVarsPat(ATPATPat(_, atpat)) =
-	    unguardedTyVarsAtPat atpat
+            unguardedTyVarsAtPat atpat
       | unguardedTyVarsPat(CONPat(_, _, longvid, atpat)) =
-	    unguardedTyVarsAtPat atpat
+            unguardedTyVarsAtPat atpat
       | unguardedTyVarsPat(TYPEDPat(_, pat, ty)) =
-	    unguardedTyVarsPat pat + unguardedTyVarsTy ty
+            unguardedTyVarsPat pat + unguardedTyVarsTy ty
       | unguardedTyVarsPat(ASPat(_, _, vid, ty_opt, pat)) =
-	    ?unguardedTyVarsTy ty_opt + unguardedTyVarsPat pat
+            ?unguardedTyVarsTy ty_opt + unguardedTyVarsPat pat
 
     and unguardedTyVarsTy(TYVARTy(_, tyvar)) = TyVarSet.singleton tyvar
       | unguardedTyVarsTy(RECORDTy(_, tyrow_opt)) =
-	    ?unguardedTyVarsTyRow tyrow_opt
+            ?unguardedTyVarsTyRow tyrow_opt
       | unguardedTyVarsTy(TYCONTy(_, tyseq, longtycon)) =
-	    unguardedTyVarsTyseq tyseq
+            unguardedTyVarsTyseq tyseq
       | unguardedTyVarsTy(ARROWTy(_, ty, ty')) =
-	    unguardedTyVarsTy ty + unguardedTyVarsTy ty'
+            unguardedTyVarsTy ty + unguardedTyVarsTy ty'
       | unguardedTyVarsTy(PARTy(_, ty)) =
-	    unguardedTyVarsTy ty
+            unguardedTyVarsTy ty
 
     and unguardedTyVarsTyRow(TyRow(_, lab, ty, tyrow_opt)) =
-	    unguardedTyVarsTy ty + ?unguardedTyVarsTyRow tyrow_opt
+            unguardedTyVarsTy ty + ?unguardedTyVarsTyRow tyrow_opt
 
     and unguardedTyVarsTyseq(Tyseq(_, tys)) =
-	    List.foldl (fn(ty,U) => unguardedTyVarsTy ty + U) TyVarSet.empty tys
+            List.foldl (fn(ty,U) => unguardedTyVarsTy ty + U) TyVarSet.empty tys
 
     end (* local *)
 
@@ -9540,30 +9540,30 @@
 
     local
         fun ? boundByX(NONE,   vid) = false
-	  | ? boundByX(SOME x, vid) = boundByX(x, vid)
+          | ? boundByX(SOME x, vid) = boundByX(x, vid)
     in
 
     fun boundByAtPat(WILDCARDAtPat(_), vid)   = false
       | boundByAtPat(SCONAtPat(_, scon), vid) = false
       | boundByAtPat(LONGVIDAtPat(_, _, longvid), vid) =
-	let
-	    val (strids,vid') = LongVId.explode longvid
-	in
-	    List.null strids andalso vid = vid'
-	end
+        let
+            val (strids,vid') = LongVId.explode longvid
+        in
+            List.null strids andalso vid = vid'
+        end
       | boundByAtPat(RECORDAtPat(_, patrow_opt), vid) =
-	    ?boundByPatRow(patrow_opt, vid)
+            ?boundByPatRow(patrow_opt, vid)
       | boundByAtPat(PARAtPat(_, pat), vid) = boundByPat(pat, vid)
 
     and boundByPatRow(WILDCARDPatRow(_), vid) = false
       | boundByPatRow(ROWPatRow(_, lab, pat, patrow_opt), vid) =
-	    boundByPat(pat, vid) orelse ?boundByPatRow(patrow_opt, vid)
+            boundByPat(pat, vid) orelse ?boundByPatRow(patrow_opt, vid)
 
     and boundByPat(ATPATPat(_, atpat), vid)           = boundByAtPat(atpat, vid)
       | boundByPat(CONPat(_, _, longvid, atpat), vid) = boundByAtPat(atpat, vid)
       | boundByPat(TYPEDPat(_, pat, ty), vid)         = boundByPat(pat, vid)
       | boundByPat(ASPat(_, _, vid', ty_opt, pat), vid) =
-	    vid = vid' orelse boundByPat(pat, vid)
+            vid = vid' orelse boundByPat(pat, vid)
 
     end (* local *)
 
@@ -9573,33 +9573,33 @@
 
     local
         fun ? isNonExpansiveX C  NONE    = true
-	  | ? isNonExpansiveX C (SOME x) = isNonExpansiveX C x
+          | ? isNonExpansiveX C (SOME x) = isNonExpansiveX C x
     in
 
     fun isNonExpansiveAtExp C (SCONAtExp(_, scon))          = true
       | isNonExpansiveAtExp C (LONGVIDAtExp(_, _, longvid)) = true
       | isNonExpansiveAtExp C (RECORDAtExp(_, exprow_opt))  =
-	    ?isNonExpansiveExpRow C exprow_opt
+            ?isNonExpansiveExpRow C exprow_opt
       | isNonExpansiveAtExp C (PARAtExp(_, exp))    = isNonExpansiveExp C exp
       | isNonExpansiveAtExp C  _                    = false
 
     and isNonExpansiveExpRow C (ExpRow(_, lab, exp, exprow_opt)) =
-	    isNonExpansiveExp C exp andalso ?isNonExpansiveExpRow C exprow_opt
+            isNonExpansiveExp C exp andalso ?isNonExpansiveExpRow C exprow_opt
 
     and isNonExpansiveExp C (ATEXPExp(_, atexp))   = isNonExpansiveAtExp C atexp
       | isNonExpansiveExp C (APPExp(_, exp, atexp)) =
-	    isConExp C exp andalso isNonExpansiveAtExp C atexp
+            isConExp C exp andalso isNonExpansiveAtExp C atexp
       | isNonExpansiveExp C (TYPEDExp(_, exp, ty))  = isNonExpansiveExp C exp
       | isNonExpansiveExp C (FNExp(_, match))       = true
       | isNonExpansiveExp C  _                      = false
 
     and isConAtExp C (PARAtExp(_, exp))            = isConExp C exp
       | isConAtExp C (LONGVIDAtExp(_, _, longvid)) =
-	    LongVId.explode longvid <> ([],VId.fromString "ref") andalso
-	    (case Context.findLongVId(C, longvid)
-	       of SOME(_,is) => is=IdStatus.c orelse is=IdStatus.e
-		| NONE       => false
-	    )
+            LongVId.explode longvid <> ([],VId.fromString "ref") andalso
+            (case Context.findLongVId(C, longvid)
+               of SOME(_,is) => is=IdStatus.c orelse is=IdStatus.e
+                | NONE       => false
+            )
       | isConAtExp C  _                            = false
 
     and isConExp C (ATEXPExp(_, atexp))                  = isConAtExp C atexp
@@ -9613,30 +9613,30 @@
     (* Closure of value environments [Section 4.8] *)
 
     fun hasNonExpansiveRHS C (vid, PLAINValBind(I, pat, exp, valbind_opt)) =
-	if boundByPat(pat, vid) then
-	    isNonExpansiveExp C exp
-	else
-	    hasNonExpansiveRHS C (vid, valOf valbind_opt)
+        if boundByPat(pat, vid) then
+            isNonExpansiveExp C exp
+        else
+            hasNonExpansiveRHS C (vid, valOf valbind_opt)
 
       | hasNonExpansiveRHS C (vid, RECValBind _) =
-	    (* A rec valbind can only contain functions. *)
-	    true
+            (* A rec valbind can only contain functions. *)
+            true
 
     fun Clos (C,valbind) VE =
-	let
-	    val tyvarsC = Context.tyvars C
+        let
+            val tyvarsC = Context.tyvars C
 
-	    fun alphas(vid, tau) =
-		if hasNonExpansiveRHS C (vid, valbind) then
-		    TyVarSet.listItems
-			(TyVarSet.difference(Type.tyvars tau, tyvarsC))
-		else
-		    []
-	in
-	    VIdMap.mapi
-		(fn(vid, ((_,tau),is)) => ((alphas(vid,tau),tau),is))
-		VE
-	end
+            fun alphas(vid, tau) =
+                if hasNonExpansiveRHS C (vid, valbind) then
+                    TyVarSet.listItems
+                        (TyVarSet.difference(Type.tyvars tau, tyvarsC))
+                else
+                    []
+        in
+            VIdMap.mapi
+                (fn(vid, ((_,tau),is)) => ((alphas(vid,tau),tau),is))
+                VE
+        end
 
 
     (* Inference rules [Section 4.10] *)
@@ -9645,619 +9645,619 @@
     (* Atomic Expressions *)
 
     fun elabAtExp(C, SCONAtExp(I, scon)) =
-	(* [Rule 1] *)
-	typeSCon scon
+        (* [Rule 1] *)
+        typeSCon scon
 
       | elabAtExp(C, LONGVIDAtExp(I, _, longvid)) =
-	(* [Rule 2] *)
-	let
-	    val (sigma,is) = case Context.findLongVId(C, longvid)
-			       of SOME valstr => valstr
-			        | NONE =>
-				  errorLongVId(I, "unknown identifier ",longvid)
-	    val tau = TypeScheme.instance sigma
-	in
-	    tau
-	end
+        (* [Rule 2] *)
+        let
+            val (sigma,is) = case Context.findLongVId(C, longvid)
+                               of SOME valstr => valstr
+                                | NONE =>
+                                  errorLongVId(I, "unknown identifier ",longvid)
+            val tau = TypeScheme.instance sigma
+        in
+            tau
+        end
 
       | elabAtExp(C, RECORDAtExp(I, exprow_opt)) =
-	(* [Rule 3] *)
-	let
-	    val rho = case exprow_opt
-			of NONE        => Type.emptyRho
-			 | SOME exprow => elabExpRow(C, exprow)
-	in
-	    Type.fromRowType rho
-	end
+        (* [Rule 3] *)
+        let
+            val rho = case exprow_opt
+                        of NONE        => Type.emptyRho
+                         | SOME exprow => elabExpRow(C, exprow)
+        in
+            Type.fromRowType rho
+        end
 
       | elabAtExp(C, LETAtExp(I, dec, exp)) =
-	(* [Rule 4] *)
-	let
-	    val E   = elabDec(false, C, dec)
-	    val tau = elabExp(C oplusE E, exp)
-	in
-	    if TyNameSet.isSubset(Type.tynames tau, Context.Tof C) then
-		tau
-	    else
-		error(I, "escaping local type name in let expression")
-	end
+        (* [Rule 4] *)
+        let
+            val E   = elabDec(false, C, dec)
+            val tau = elabExp(C oplusE E, exp)
+        in
+            if TyNameSet.isSubset(Type.tynames tau, Context.Tof C) then
+                tau
+            else
+                error(I, "escaping local type name in let expression")
+        end
 
       | elabAtExp(C, PARAtExp(I, exp)) =
-	(* [Rule 5] *)
-	let
-	    val tau = elabExp(C, exp)
-	in
-	    tau
-	end
+        (* [Rule 5] *)
+        let
+            val tau = elabExp(C, exp)
+        in
+            tau
+        end
 
 
     (* Expression Rows *)
 
     and elabExpRow(C, ExpRow(I, lab, exp, exprow_opt)) =
-	(* [Rule 6] *)
-	let
-	    val tau = elabExp(C, exp)
-	    val rho = case exprow_opt
-			of NONE        => Type.emptyRho
-			 | SOME exprow => elabExpRow(C, exprow)
-	in
-	    if isSome(Type.findLab(rho, lab)) then
-		(* Syntactic restriction [Section 2.9, 1st bullet] *)
-		errorLab(I, "duplicate label ", lab)
-	    else
-		Type.insertRho(rho, lab, tau)
-	end
+        (* [Rule 6] *)
+        let
+            val tau = elabExp(C, exp)
+            val rho = case exprow_opt
+                        of NONE        => Type.emptyRho
+                         | SOME exprow => elabExpRow(C, exprow)
+        in
+            if isSome(Type.findLab(rho, lab)) then
+                (* Syntactic restriction [Section 2.9, 1st bullet] *)
+                errorLab(I, "duplicate label ", lab)
+            else
+                Type.insertRho(rho, lab, tau)
+        end
 
 
     (* Expressions *)
 
     and elabExp(C, ATEXPExp(I, atexp)) =
-	(* [Rule 7] *)
-	let
-	    val tau = elabAtExp(C, atexp)
-	in
-	    tau
-	end
+        (* [Rule 7] *)
+        let
+            val tau = elabAtExp(C, atexp)
+        in
+            tau
+        end
 
       | elabExp(C, APPExp(I, exp, atexp)) =
-	(* [Rule 8] *)
-	let
-	    val tau1 = elabExp(C, exp)
-	    val tau' = elabAtExp(C, atexp)
-	    val tau  = Type.invent()
-	in
-	    Type.unify(tau1, Type.fromFunType(tau',tau))
-	    handle Type.Unify => error(I, "type mismatch on application")
-	  ; tau
-	end
+        (* [Rule 8] *)
+        let
+            val tau1 = elabExp(C, exp)
+            val tau' = elabAtExp(C, atexp)
+            val tau  = Type.invent()
+        in
+            Type.unify(tau1, Type.fromFunType(tau',tau))
+            handle Type.Unify => error(I, "type mismatch on application")
+          ; tau
+        end
 
       | elabExp(C, TYPEDExp(I, exp, ty)) =
-	(* [Rule 9] *)
-	let
-	    val tau1 = elabExp(C, exp)
-	    val tau  = elabTy(C, ty)
-	in
-	    Type.unify(tau1,tau)
-	    handle Type.Unify =>
-		   error(I, "expression does not match annotation")
-	  ; tau
-	end
+        (* [Rule 9] *)
+        let
+            val tau1 = elabExp(C, exp)
+            val tau  = elabTy(C, ty)
+        in
+            Type.unify(tau1,tau)
+            handle Type.Unify =>
+                   error(I, "expression does not match annotation")
+          ; tau
+        end
 
       | elabExp(C, HANDLEExp(I, exp, match)) =
-	(* [Rule 10] *)
-	let
-	    val tau1 = elabExp(C, exp)
-	    val tau2 = elabMatch(C, match)
-	in
-	    Type.unify(tau1,tau2)
-	    handle Type.Unify =>
-		   error(I, "type mismatch between expression and handler")
-	  ; tau1
-	end
+        (* [Rule 10] *)
+        let
+            val tau1 = elabExp(C, exp)
+            val tau2 = elabMatch(C, match)
+        in
+            Type.unify(tau1,tau2)
+            handle Type.Unify =>
+                   error(I, "type mismatch between expression and handler")
+          ; tau1
+        end
 
       | elabExp(C, RAISEExp(I, exp)) =
-	(* [Rule 11] *)
-	let
-	    val tau1 = elabExp(C, exp)
-	in
-	    Type.unify(tau1, InitialStaticEnv.tauExn)
-	    handle Type.Unify =>
-		   error(I, "raised expression is not an exception")
-	  ; Type.invent()
-	end
+        (* [Rule 11] *)
+        let
+            val tau1 = elabExp(C, exp)
+        in
+            Type.unify(tau1, InitialStaticEnv.tauExn)
+            handle Type.Unify =>
+                   error(I, "raised expression is not an exception")
+          ; Type.invent()
+        end
 
       | elabExp(C, FNExp(I, match)) =
-	(* [Rule 12] *)
-	let
-	    val tau = elabMatch(C, match)
-	in
-	    (* Further restriction [Section 4.11, item 2] *)
-	    CheckPattern.checkMatch(Context.Eof C, match)
-	  ; tau
-	end
+        (* [Rule 12] *)
+        let
+            val tau = elabMatch(C, match)
+        in
+            (* Further restriction [Section 4.11, item 2] *)
+            CheckPattern.checkMatch(Context.Eof C, match)
+          ; tau
+        end
 
 
     (* Matches *)
 
     and elabMatch(C, Match(I, mrule, match_opt)) =
-	(* [Rule 13] *)
-	let
-	    val tau = elabMrule(C, mrule)
-	in
-	    case match_opt
-	      of NONE       => tau
-	       | SOME match =>
-		 let
-		     val tau2 = elabMatch(C, match)
-		 in
-		     Type.unify(tau, tau2)
-		     handle Type.Unify =>
-			    error(I, "type mismatch between different matches")
-		   ; tau
-		 end
-	end
+        (* [Rule 13] *)
+        let
+            val tau = elabMrule(C, mrule)
+        in
+            case match_opt
+              of NONE       => tau
+               | SOME match =>
+                 let
+                     val tau2 = elabMatch(C, match)
+                 in
+                     Type.unify(tau, tau2)
+                     handle Type.Unify =>
+                            error(I, "type mismatch between different matches")
+                   ; tau
+                 end
+        end
 
 
     (* Match rules *)
 
     and elabMrule(C, Mrule(I, pat, exp)) =
-	(* [Rule 14] *)
-	let
-	    val (VE,tau) = elabPat(C, pat)
-	    val  tau'    = elabExp(C plusVE VE, exp)
-	    (* Side condition on type names is always ensured. *)
-	in
-	    Type.fromFunType(tau,tau')
-	end
+        (* [Rule 14] *)
+        let
+            val (VE,tau) = elabPat(C, pat)
+            val  tau'    = elabExp(C plusVE VE, exp)
+            (* Side condition on type names is always ensured. *)
+        in
+            Type.fromFunType(tau,tau')
+        end
 
 
     (* Declarations *)
 
     and elabDec(toplevel, C, VALDec(I, tyvarseq, valbind)) =
-	(* [Rule 15] *)
-	let
-	    val U'  = #1(tyvars(tyvarseq))
-		      (* Collect implicitly bound tyvars [Section 4.6] *)
-	    val U   = TyVarSet.union(U',
-			TyVarSet.difference(unguardedTyVarsValBind valbind,
-					    Context.Uof C))
-	    val VE  = elabValBind(toplevel, C plusU U, valbind)
-	    val VE' = Clos(C,valbind) VE
-	    val  _  = StaticEnv.defaultOverloaded VE'
-	in
-	    if not(TyVarSet.isEmpty(
-				TyVarSet.intersection(Context.Uof C, U))) then
-		(* Syntactic restriction [Section 2.9, last bullet] *)
-		error(I, "some type variables shadow previous ones")
-	    else if StaticEnv.containsFlexibleType VE' then
-		(* Further restriction [Section 4.11, item 1] *)
-		error(I, "unresolved flexible record type")
-	    else if TyVarSet.isEmpty(
-			TyVarSet.intersection(U, StaticEnv.tyvarsVE VE')) then
-		StaticEnv.fromVE VE'
-	    else
-		error(I, "some explicit type variables cannot be generalised")
-	end
+        (* [Rule 15] *)
+        let
+            val U'  = #1(tyvars(tyvarseq))
+                      (* Collect implicitly bound tyvars [Section 4.6] *)
+            val U   = TyVarSet.union(U',
+                        TyVarSet.difference(unguardedTyVarsValBind valbind,
+                                            Context.Uof C))
+            val VE  = elabValBind(toplevel, C plusU U, valbind)
+            val VE' = Clos(C,valbind) VE
+            val  _  = StaticEnv.defaultOverloaded VE'
+        in
+            if not(TyVarSet.isEmpty(
+                                TyVarSet.intersection(Context.Uof C, U))) then
+                (* Syntactic restriction [Section 2.9, last bullet] *)
+                error(I, "some type variables shadow previous ones")
+            else if StaticEnv.containsFlexibleType VE' then
+                (* Further restriction [Section 4.11, item 1] *)
+                error(I, "unresolved flexible record type")
+            else if TyVarSet.isEmpty(
+                        TyVarSet.intersection(U, StaticEnv.tyvarsVE VE')) then
+                StaticEnv.fromVE VE'
+            else
+                error(I, "some explicit type variables cannot be generalised")
+        end
 
       | elabDec(toplevel, C, TYPEDec(I, typbind)) =
-	(* [Rule 16] *)
-	let
-	    val TE = elabTypBind(C, typbind)
-	in
-	    StaticEnv.fromTE TE
-	end
+        (* [Rule 16] *)
+        let
+            val TE = elabTypBind(C, typbind)
+        in
+            StaticEnv.fromTE TE
+        end
 
       | elabDec(toplevel, C, DATATYPEDec(I, datbind)) =
-	(* [Rule 17] *)
-	let
-	    val      TE1  = lhsDatBind datbind
-	    val (VE2,TE2) = elabDatBind(C oplusTE TE1, datbind)
-	    val (TE, VE)  = StaticEnv.maximiseEquality(TE2,VE2)
-	    (* Side condition on type names is always ensured. *)
-	in
-	    StaticEnv.fromVEandTE(VE,TE)
-	end
+        (* [Rule 17] *)
+        let
+            val      TE1  = lhsDatBind datbind
+            val (VE2,TE2) = elabDatBind(C oplusTE TE1, datbind)
+            val (TE, VE)  = StaticEnv.maximiseEquality(TE2,VE2)
+            (* Side condition on type names is always ensured. *)
+        in
+            StaticEnv.fromVEandTE(VE,TE)
+        end
 
       | elabDec(toplevel, C, REPLICATIONDec(I, tycon, longtycon)) =
-	(* [Rule 18] *)
-	let
-	    val (theta,VE) = case Context.findLongTyCon(C, longtycon)
-			      of SOME tystr => tystr
-			       | NONE =>
-				 errorLongTyCon(I, "unknown type ", longtycon)
-	    val  TE        = TyConMap.singleton(tycon, (theta,VE))
-	in
-	    StaticEnv.fromVEandTE(VE,TE)
-	end
+        (* [Rule 18] *)
+        let
+            val (theta,VE) = case Context.findLongTyCon(C, longtycon)
+                              of SOME tystr => tystr
+                               | NONE =>
+                                 errorLongTyCon(I, "unknown type ", longtycon)
+            val  TE        = TyConMap.singleton(tycon, (theta,VE))
+        in
+            StaticEnv.fromVEandTE(VE,TE)
+        end
 
       | elabDec(toplevel, C, ABSTYPEDec(I, datbind, dec)) =
-	(* [Rule 19] *)
-	let
-	    val      TE1  = lhsDatBind datbind
-	    val (VE2,TE2) = elabDatBind(C oplusTE TE1, datbind)
-	    val (TE, VE)  = StaticEnv.maximiseEquality(TE2,VE2)
-	    val    E      = elabDec(false, C oplusVEandTE (VE,TE), dec)
-	    (* Side condition on type names is always ensured. *)
-	in
-	    StaticEnv.Abs(TE,E)
-	end
+        (* [Rule 19] *)
+        let
+            val      TE1  = lhsDatBind datbind
+            val (VE2,TE2) = elabDatBind(C oplusTE TE1, datbind)
+            val (TE, VE)  = StaticEnv.maximiseEquality(TE2,VE2)
+            val    E      = elabDec(false, C oplusVEandTE (VE,TE), dec)
+            (* Side condition on type names is always ensured. *)
+        in
+            StaticEnv.Abs(TE,E)
+        end
 
       | elabDec(toplevel, C, EXCEPTIONDec(I, exbind)) =
-	(* [Rule 20] *)
-	let
-	    val VE = elabExBind(C, exbind)
-	in
-	    StaticEnv.fromVE VE
-	end
+        (* [Rule 20] *)
+        let
+            val VE = elabExBind(C, exbind)
+        in
+            StaticEnv.fromVE VE
+        end
 
       | elabDec(toplevel, C, LOCALDec(I, dec1, dec2)) =
-	(* [Rule 21] *)
-	let
-	    val E1 = elabDec(false, C, dec1)
-	    val E2 = elabDec(false, C oplusE E1, dec2)
-	in
-	    E2
-	end
+        (* [Rule 21] *)
+        let
+            val E1 = elabDec(false, C, dec1)
+            val E2 = elabDec(false, C oplusE E1, dec2)
+        in
+            E2
+        end
 
       | elabDec(toplevel, C, OPENDec(I, longstrids)) =
-	(* [Rule 22] *)
-	let
-	    val Es =
-		List.map
-		    (fn longstrid =>
-			case Context.findLongStrId(C, longstrid)
-			  of SOME(StaticEnv.Str E) => E
-			   | NONE =>
-			     errorLongStrId(I, "unknown structure ", longstrid))
-		    longstrids
-	in
-	    List.foldl StaticEnv.plus StaticEnv.empty Es
-	end
+        (* [Rule 22] *)
+        let
+            val Es =
+                List.map
+                    (fn longstrid =>
+                        case Context.findLongStrId(C, longstrid)
+                          of SOME(StaticEnv.Str E) => E
+                           | NONE =>
+                             errorLongStrId(I, "unknown structure ", longstrid))
+                    longstrids
+        in
+            List.foldl StaticEnv.plus StaticEnv.empty Es
+        end
 
       | elabDec(toplevel, C, EMPTYDec(I)) =
-	(* [Rule 23] *)
-	StaticEnv.empty
+        (* [Rule 23] *)
+        StaticEnv.empty
 
       | elabDec(toplevel, C, SEQDec(I, dec1, dec2)) =
-	(* [Rule 24] *)
-	let
-	    val E1 = elabDec(toplevel, C, dec1)
-	    val E2 = elabDec(toplevel, C oplusE E1, dec2)
-	in
-	    StaticEnv.plus(E1, E2)
-	end
+        (* [Rule 24] *)
+        let
+            val E1 = elabDec(toplevel, C, dec1)
+            val E2 = elabDec(toplevel, C oplusE E1, dec2)
+        in
+            StaticEnv.plus(E1, E2)
+        end
 
 
     (* Value Bindings *)
 
     and elabValBind(toplevel, C, PLAINValBind(I, pat, exp, valbind_opt)) =
-	(* [Rule 25] *)
-	let
-	    val (VE,tau1) = elabPat(C, pat)
-	    val     tau2  = elabExp(C, exp)
-	    val VE'       = case valbind_opt
-			      of NONE         => VIdMap.empty
-			       | SOME valbind => elabValBind(toplevel, C, valbind)
-	in
-	    Type.unify(tau1,tau2)
-	    handle Type.Unify =>
-		   error(I, "type mismatch between pattern and expression")
-	  ; if toplevel then () else
-		(* Further restriction [Section 4.11, item 3] *)
-		CheckPattern.checkPat(Context.Eof C, pat)
-	  ; VIdMap.unionWithi
-		(fn(vid,_,_) =>
-		 (* Syntactic restriction [Section 2.9, 2nd bullet] *)
-		 errorVId(I, "duplicate variable ", vid))
-		(VE,VE')
-	end
+        (* [Rule 25] *)
+        let
+            val (VE,tau1) = elabPat(C, pat)
+            val     tau2  = elabExp(C, exp)
+            val VE'       = case valbind_opt
+                              of NONE         => VIdMap.empty
+                               | SOME valbind => elabValBind(toplevel, C, valbind)
+        in
+            Type.unify(tau1,tau2)
+            handle Type.Unify =>
+                   error(I, "type mismatch between pattern and expression")
+          ; if toplevel then () else
+                (* Further restriction [Section 4.11, item 3] *)
+                CheckPattern.checkPat(Context.Eof C, pat)
+          ; VIdMap.unionWithi
+                (fn(vid,_,_) =>
+                 (* Syntactic restriction [Section 2.9, 2nd bullet] *)
+                 errorVId(I, "duplicate variable ", vid))
+                (VE,VE')
+        end
 
       | elabValBind(toplevel, C, RECValBind(I, valbind)) =
-	(* [Rule 26] *)
-	let
-	    val VE1 = lhsRecValBind valbind
-	    val VE  = elabValBind(toplevel, C plusVE VE1, valbind)
-	    (* Side condition on type names is always ensured. *)
-	in
-	    VE
-	end
+        (* [Rule 26] *)
+        let
+            val VE1 = lhsRecValBind valbind
+            val VE  = elabValBind(toplevel, C plusVE VE1, valbind)
+            (* Side condition on type names is always ensured. *)
+        in
+            VE
+        end
 
 
     (* Type Bindings *)
 
     and elabTypBind(C, TypBind(I, tyvarseq, tycon, ty, typbind_opt)) =
-	(* [Rule 27] *)
-	let
-	    val (U,alphas) = tyvars tyvarseq
-	    val tau        = elabTy(C, ty)
-	    val TE         = case typbind_opt
-			       of NONE         => TyConMap.empty
-				| SOME typbind => elabTypBind(C, typbind)
-	in
-	    if not(TyVarSet.isSubset(Type.tyvars tau, U)) then
-		(* Syntactic restriction (missing in the Definition!) *)
-		error(I, "free type variables in type binding")
-	    else if isSome(TyConMap.find(TE, tycon)) then
-		(* Syntactic restriction [Section 2.9, 2nd bullet] *)
-		errorTyCon(I, "duplicate type constructor ", tycon)
-	    else
-		TyConMap.insert(TE, tycon, ((alphas,tau),VIdMap.empty))
-	end
+        (* [Rule 27] *)
+        let
+            val (U,alphas) = tyvars tyvarseq
+            val tau        = elabTy(C, ty)
+            val TE         = case typbind_opt
+                               of NONE         => TyConMap.empty
+                                | SOME typbind => elabTypBind(C, typbind)
+        in
+            if not(TyVarSet.isSubset(Type.tyvars tau, U)) then
+                (* Syntactic restriction (missing in the Definition!) *)
+                error(I, "free type variables in type binding")
+            else if isSome(TyConMap.find(TE, tycon)) then
+                (* Syntactic restriction [Section 2.9, 2nd bullet] *)
+                errorTyCon(I, "duplicate type constructor ", tycon)
+            else
+                TyConMap.insert(TE, tycon, ((alphas,tau),VIdMap.empty))
+        end
 
 
     (* Datatype Bindings *)
 
     and elabDatBind(C, DatBind(I, tyvarseq, tycon, conbind, datbind_opt)) =
-	(* [Rule 28, part 2] *)
-	let
-	    val (U,alphas)   = tyvars tyvarseq
-	    val (alphas,tau) = case Context.findTyCon(C, tycon)
-				 of SOME(theta,VE) => theta
-				  | NONE => (* lhsDatBind inserted it! *)
-				    raise Fail "ElabCore.elabDatBind: \
-						\tycon not pre-bound"
-	    val VE       = elabConBind(C,tau, conbind)
-	    val(VE',TE') = case datbind_opt
-			     of NONE         => ( VIdMap.empty, TyConMap.empty )
-			      | SOME datbind => elabDatBind(C, datbind)
-				(* Side condition on t is always true. *)
-	    val ClosVE   = if TyVarSet.isSubset(StaticEnv.tyvarsVE VE, U) then
-			     StaticEnv.Clos VE
-			   else
-			     (* Syntactic restriction (missing in Definition!)*)
-			     error(I, "free type variables in datatype binding")
-	in
-	    if isSome(TyConMap.find(TE', tycon)) then
-		  (* Syntactic restriction [Section 2.9, 2nd bullet] *)
-		  errorTyCon(I, "duplicate type constructor ", tycon)
-	    else
-	    ( VIdMap.unionWithi (fn(vid,_,_) =>
-		  (* Syntactic restriction [Section 2.9, 2nd bullet] *)
-		  errorVId(I, "duplicate data cnstructor ", vid)) (ClosVE,VE')
-	    , TyConMap.insert(TE', tycon, ((alphas,tau),ClosVE))
-	    )
-	end
+        (* [Rule 28, part 2] *)
+        let
+            val (U,alphas)   = tyvars tyvarseq
+            val (alphas,tau) = case Context.findTyCon(C, tycon)
+                                 of SOME(theta,VE) => theta
+                                  | NONE => (* lhsDatBind inserted it! *)
+                                    raise Fail "ElabCore.elabDatBind: \
+                                                \tycon not pre-bound"
+            val VE       = elabConBind(C,tau, conbind)
+            val(VE',TE') = case datbind_opt
+                             of NONE         => ( VIdMap.empty, TyConMap.empty )
+                              | SOME datbind => elabDatBind(C, datbind)
+                                (* Side condition on t is always true. *)
+            val ClosVE   = if TyVarSet.isSubset(StaticEnv.tyvarsVE VE, U) then
+                             StaticEnv.Clos VE
+                           else
+                             (* Syntactic restriction (missing in Definition!)*)
+                             error(I, "free type variables in datatype binding")
+        in
+            if isSome(TyConMap.find(TE', tycon)) then
+                  (* Syntactic restriction [Section 2.9, 2nd bullet] *)
+                  errorTyCon(I, "duplicate type constructor ", tycon)
+            else
+            ( VIdMap.unionWithi (fn(vid,_,_) =>
+                  (* Syntactic restriction [Section 2.9, 2nd bullet] *)
+                  errorVId(I, "duplicate data cnstructor ", vid)) (ClosVE,VE')
+            , TyConMap.insert(TE', tycon, ((alphas,tau),ClosVE))
+            )
+        end
 
 
     (* Constructor Bindings *)
 
     and elabConBind(C,tau, ConBind(I, _, vid, ty_opt, conbind_opt)) =
-	(* [Rule 29] *)
-	let
-	    val tau1 = case ty_opt
-			 of NONE    => tau
-			  | SOME ty =>
-			    let
-				val tau' = elabTy(C, ty)
-			    in
-			        Type.fromFunType(tau',tau)
-			    end
-	    val VE   = case conbind_opt
-			 of NONE         => VIdMap.empty
-			  | SOME conbind => elabConBind(C,tau, conbind)
-	in
-	    if isSome(VIdMap.find(VE, vid)) then
-		(* Syntactic restriction [Section 2.9, 2nd bullet] *)
-		errorVId(I, "duplicate data constructor ", vid)
-	    else if not(validConBindVId vid) then
-		(* Syntactic restriction [Section 2.9, 5th bullet] *)
-		errorVId(I, "illegal rebinding of identifier ", vid)
-	    else
-		VIdMap.insert(VE, vid, (([],tau1),IdStatus.c))
-	end
+        (* [Rule 29] *)
+        let
+            val tau1 = case ty_opt
+                         of NONE    => tau
+                          | SOME ty =>
+                            let
+                                val tau' = elabTy(C, ty)
+                            in
+                                Type.fromFunType(tau',tau)
+                            end
+            val VE   = case conbind_opt
+                         of NONE         => VIdMap.empty
+                          | SOME conbind => elabConBind(C,tau, conbind)
+        in
+            if isSome(VIdMap.find(VE, vid)) then
+                (* Syntactic restriction [Section 2.9, 2nd bullet] *)
+                errorVId(I, "duplicate data constructor ", vid)
+            else if not(validConBindVId vid) then
+                (* Syntactic restriction [Section 2.9, 5th bullet] *)
+                errorVId(I, "illegal rebinding of identifier ", vid)
+            else
+                VIdMap.insert(VE, vid, (([],tau1),IdStatus.c))
+        end
 
 
     (* Exception Bindings *)
 
     and elabExBind(C, NEWExBind(I, _, vid, ty_opt, exbind_opt)) =
-	(* [Rule 30] *)
-	let
-	    val tau1 = case ty_opt
-			 of NONE    => InitialStaticEnv.tauExn
-			  | SOME ty =>
-			    let
-				val tau = elabTy(C, ty)
-			    in
-			        Type.fromFunType(tau, InitialStaticEnv.tauExn)
-			    end
-	    val VE   = case exbind_opt
-			 of NONE        => VIdMap.empty
-			  | SOME exbind => elabExBind(C, exbind)
-	in
-	    if isSome(VIdMap.find(VE, vid)) then
-		(* Syntactic restriction [Section 2.9, 2nd bullet] *)
-		errorVId(I, "duplicate exception constructor ", vid)
-	    else if not(validConBindVId vid) then
-		(* Syntactic restriction [Section 2.9, 5th bullet] *)
-		errorVId(I, "illegal rebinding of identifier ", vid)
-	    else
-		VIdMap.insert(VE, vid, (([],tau1),IdStatus.e))
-	end
+        (* [Rule 30] *)
+        let
+            val tau1 = case ty_opt
+                         of NONE    => InitialStaticEnv.tauExn
+                          | SOME ty =>
+                            let
+                                val tau = elabTy(C, ty)
+                            in
+                                Type.fromFunType(tau, InitialStaticEnv.tauExn)
+                            end
+            val VE   = case exbind_opt
+                         of NONE        => VIdMap.empty
+                          | SOME exbind => elabExBind(C, exbind)
+        in
+            if isSome(VIdMap.find(VE, vid)) then
+                (* Syntactic restriction [Section 2.9, 2nd bullet] *)
+                errorVId(I, "duplicate exception constructor ", vid)
+            else if not(validConBindVId vid) then
+                (* Syntactic restriction [Section 2.9, 5th bullet] *)
+                errorVId(I, "illegal rebinding of identifier ", vid)
+            else
+                VIdMap.insert(VE, vid, (([],tau1),IdStatus.e))
+        end
 
       | elabExBind(C, EQUALExBind(I, _, vid, _, longvid, exbind_opt)) =
-	(* [Rule 31] *)
-	let
-	    val tau = case Context.findLongVId(C, longvid)
-		        of SOME(([],tau),IdStatus.e) => tau
-			 | SOME _ =>
-			   errorLongVId(I, "non-exception identifier ", longvid)
-			 | NONE =>
-			   errorLongVId(I, "unknown identifier ", longvid)
-	    val VE  = case exbind_opt
-			of NONE        => VIdMap.empty
-			 | SOME exbind => elabExBind(C, exbind)
-	in
-	    if isSome(VIdMap.find(VE, vid)) then
-		(* Syntactic restriction [Section 2.9, 2nd bullet] *)
-		errorVId(I, "duplicate exception constructor ", vid)
-	    else
-		VIdMap.insert(VE, vid, (([],tau),IdStatus.e))
-	end
+        (* [Rule 31] *)
+        let
+            val tau = case Context.findLongVId(C, longvid)
+                        of SOME(([],tau),IdStatus.e) => tau
+                         | SOME _ =>
+                           errorLongVId(I, "non-exception identifier ", longvid)
+                         | NONE =>
+                           errorLongVId(I, "unknown identifier ", longvid)
+            val VE  = case exbind_opt
+                        of NONE        => VIdMap.empty
+                         | SOME exbind => elabExBind(C, exbind)
+        in
+            if isSome(VIdMap.find(VE, vid)) then
+                (* Syntactic restriction [Section 2.9, 2nd bullet] *)
+                errorVId(I, "duplicate exception constructor ", vid)
+            else
+                VIdMap.insert(VE, vid, (([],tau),IdStatus.e))
+        end
 
 
     (* Atomic Patterns *)
 
     and elabAtPat(C, WILDCARDAtPat(I)) =
-	(* [Rule 32] *)
-	( VIdMap.empty, Type.invent() )
+        (* [Rule 32] *)
+        ( VIdMap.empty, Type.invent() )
 
       | elabAtPat(C, SCONAtPat(I, scon)) =
-	(* [Rule 33] *)
-	(case scon
-	   of SCon.REAL _ =>
-	      (* Syntactic restriction [Section 2.9, 6th bullet] *)
-	      error(I, "real constant in pattern")
-	    | _ =>
-	      ( VIdMap.empty, typeSCon scon )
-	)
+        (* [Rule 33] *)
+        (case scon
+           of SCon.REAL _ =>
+              (* Syntactic restriction [Section 2.9, 6th bullet] *)
+              error(I, "real constant in pattern")
+            | _ =>
+              ( VIdMap.empty, typeSCon scon )
+        )
 
       | elabAtPat(C, LONGVIDAtPat(I, _, longvid)) =
-	(* [Rule 34 and 35] *)
-	let
-	    val (strids,vid) = LongVId.explode longvid
-	in
-	    if List.null strids andalso
-	       ( case Context.findVId(C, vid)
-		   of NONE           => true
-		    | SOME(sigma,is) => is = IdStatus.v ) then
-		(* [Rule 34] *)
-		let
-		    val tau = Type.invent()
-		in
-		    ( VIdMap.singleton(vid, (([],tau),IdStatus.v))
-		    , tau )
-		end
-	    else
-		(* [Rule 35] *)
-		let
-		    val (sigma,is) = case Context.findLongVId(C, longvid)
-				       of SOME valstr => valstr
-				        | NONE =>
-					  errorLongVId(I,"unknown constructor ",
-							 longvid)
-		    val  tau       = TypeScheme.instance sigma
-		    (* Note that tau will always be a ConsType. *)
-		in
-		    if is <> IdStatus.v then
-			( VIdMap.empty, tau )
-		    else
-			error(I, "non-constructor long identifier in pattern")
-		end
-	end
+        (* [Rule 34 and 35] *)
+        let
+            val (strids,vid) = LongVId.explode longvid
+        in
+            if List.null strids andalso
+               ( case Context.findVId(C, vid)
+                   of NONE           => true
+                    | SOME(sigma,is) => is = IdStatus.v ) then
+                (* [Rule 34] *)
+                let
+                    val tau = Type.invent()
+                in
+                    ( VIdMap.singleton(vid, (([],tau),IdStatus.v))
+                    , tau )
+                end
+            else
+                (* [Rule 35] *)
+                let
+                    val (sigma,is) = case Context.findLongVId(C, longvid)
+                                       of SOME valstr => valstr
+                                        | NONE =>
+                                          errorLongVId(I,"unknown constructor ",
+                                                         longvid)
+                    val  tau       = TypeScheme.instance sigma
+                    (* Note that tau will always be a ConsType. *)
+                in
+                    if is <> IdStatus.v then
+                        ( VIdMap.empty, tau )
+                    else
+                        error(I, "non-constructor long identifier in pattern")
+                end
+        end
 
       | elabAtPat(C, RECORDAtPat(I, patrow_opt)) =
-	(* [Rule 36] *)
-	let
-	    val (VE,rho) = case patrow_opt
-			     of NONE        => ( VIdMap.empty, Type.emptyRho )
-			      | SOME patrow => elabPatRow(C, patrow)
-	in
-	    (VE, Type.fromRowType rho)
-	end
+        (* [Rule 36] *)
+        let
+            val (VE,rho) = case patrow_opt
+                             of NONE        => ( VIdMap.empty, Type.emptyRho )
+                              | SOME patrow => elabPatRow(C, patrow)
+        in
+            (VE, Type.fromRowType rho)
+        end
 
       | elabAtPat(C, PARAtPat(I, pat)) =
-	(* [Rule 37] *)
-	let
-	    val (VE,tau) = elabPat(C, pat)
-	in
-	    (VE,tau)
-	end
+        (* [Rule 37] *)
+        let
+            val (VE,tau) = elabPat(C, pat)
+        in
+            (VE,tau)
+        end
 
 
     (* Pattern Rows *)
 
     and elabPatRow(C, WILDCARDPatRow(I)) =
-	(* [Rule 38] *)
-	( VIdMap.empty, Type.inventRho() )
+        (* [Rule 38] *)
+        ( VIdMap.empty, Type.inventRho() )
 
       | elabPatRow(C, ROWPatRow(I, lab, pat, patrow_opt)) =
-	(* [Rule 39] *)
-	let
-	    val (VE,tau)  = elabPat(C, pat)
-	    val (VE',rho) = case patrow_opt
-			      of NONE        => ( VIdMap.empty, Type.emptyRho )
-			       | SOME patrow => elabPatRow(C, patrow)
-	in
-	    if isSome(Type.findLab(rho, lab)) then
-		(* Syntactic restriction [Section 2.9, 1st bullet] *)
-		errorLab(I, "duplicate label ", lab)
-	    else
-		( VIdMap.unionWithi (fn(vid,_,_) =>
-		      errorVId(I, "duplicate variable ", vid)) (VE,VE')
-		, Type.insertRho(rho, lab, tau)
-		)
-	end
+        (* [Rule 39] *)
+        let
+            val (VE,tau)  = elabPat(C, pat)
+            val (VE',rho) = case patrow_opt
+                              of NONE        => ( VIdMap.empty, Type.emptyRho )
+                               | SOME patrow => elabPatRow(C, patrow)
+        in
+            if isSome(Type.findLab(rho, lab)) then
+                (* Syntactic restriction [Section 2.9, 1st bullet] *)
+                errorLab(I, "duplicate label ", lab)
+            else
+                ( VIdMap.unionWithi (fn(vid,_,_) =>
+                      errorVId(I, "duplicate variable ", vid)) (VE,VE')
+                , Type.insertRho(rho, lab, tau)
+                )
+        end
 
 
     (* Patterns *)
 
     and elabPat(C, ATPATPat(I, atpat)) =
-	(* [Rule 40] *)
-	let
-	    val (VE,tau) = elabAtPat(C, atpat)
-	in
-	    (VE,tau)
-	end
+        (* [Rule 40] *)
+        let
+            val (VE,tau) = elabAtPat(C, atpat)
+        in
+            (VE,tau)
+        end
 
       | elabPat(C, CONPat(I, _, longvid, atpat)) =
-	(* [Rule 41] *)
-	let
-	    val (sigma,is) = case Context.findLongVId(C, longvid)
-			       of SOME valstr => valstr
-			        | NONE =>
-				errorLongVId(I, "unknown constructor ", longvid)
-	    val _          = if is <> IdStatus.v then () else
-				errorLongVId(I, "non-constructor ", longvid)
-	    val (tau',tau) = case !(TypeScheme.instance sigma)
-			       of Type.FunType(tau',tau) => (tau', tau)
-			        | _ =>
-				errorLongVId(I,"misplaced nullary constructor ",
-						longvid)
-	    val (VE,tau'2)  = elabAtPat(C, atpat)
-	in
-	    Type.unify(tau',tau'2)
-	    handle Type.Unify =>
-		   error(I, "type mismatch in constructor pattern")
-	  ; (VE,tau)
-	end
+        (* [Rule 41] *)
+        let
+            val (sigma,is) = case Context.findLongVId(C, longvid)
+                               of SOME valstr => valstr
+                                | NONE =>
+                                errorLongVId(I, "unknown constructor ", longvid)
+            val _          = if is <> IdStatus.v then () else
+                                errorLongVId(I, "non-constructor ", longvid)
+            val (tau',tau) = case !(TypeScheme.instance sigma)
+                               of Type.FunType(tau',tau) => (tau', tau)
+                                | _ =>
+                                errorLongVId(I,"misplaced nullary constructor ",
+                                                longvid)
+            val (VE,tau'2)  = elabAtPat(C, atpat)
+        in
+            Type.unify(tau',tau'2)
+            handle Type.Unify =>
+                   error(I, "type mismatch in constructor pattern")
+          ; (VE,tau)
+        end
 
       | elabPat(C, TYPEDPat(I, pat, ty)) =
-	(* [Rule 42] *)
-	let
-	    val (VE,tau1) = elabPat(C, pat)
-	    val     tau   = elabTy(C, ty)
-	in
-	    Type.unify(tau1,tau)
-	    handle Type.Unify => error(I, "pattern does not match annotation")
-	  ; (VE,tau)
-	end
+        (* [Rule 42] *)
+        let
+            val (VE,tau1) = elabPat(C, pat)
+            val     tau   = elabTy(C, ty)
+        in
+            Type.unify(tau1,tau)
+            handle Type.Unify => error(I, "pattern does not match annotation")
+          ; (VE,tau)
+        end
 
       | elabPat(C, ASPat(I, _, vid, ty_opt, pat)) =
-	(* [Rule 43] *)
-	let
-	    val (VE1,tau1) = elabPat(C, pat)
-	    val (VE, tau)  =
-		case ty_opt
-		  of NONE    => (VE1,tau1)
-		   | SOME ty =>
-		     let
-			 val tau = elabTy(C, ty)
-		     in
-			 Type.unify(tau1,tau)
-			 handle Type.Unify =>
-				error(I, "pattern does not match annotation")
-		       ; (VE1,tau)
-		     end
-	in
-	    if not( case Context.findVId(C, vid)
-		      of NONE           => true
-		       | SOME(sigma,is) => is = IdStatus.v ) then
-		errorVId(I, "misplaced constructor ", vid)
-	    else if isSome(VIdMap.find(VE, vid)) then
-		errorVId(I, "duplicate variable ", vid)
-	    else
-		( VIdMap.insert(VE, vid, (([],tau),IdStatus.v)), tau )
-	end
+        (* [Rule 43] *)
+        let
+            val (VE1,tau1) = elabPat(C, pat)
+            val (VE, tau)  =
+                case ty_opt
+                  of NONE    => (VE1,tau1)
+                   | SOME ty =>
+                     let
+                         val tau = elabTy(C, ty)
+                     in
+                         Type.unify(tau1,tau)
+                         handle Type.Unify =>
+                                error(I, "pattern does not match annotation")
+                       ; (VE1,tau)
+                     end
+        in
+            if not( case Context.findVId(C, vid)
+                      of NONE           => true
+                       | SOME(sigma,is) => is = IdStatus.v ) then
+                errorVId(I, "misplaced constructor ", vid)
+            else if isSome(VIdMap.find(VE, vid)) then
+                errorVId(I, "duplicate variable ", vid)
+            else
+                ( VIdMap.insert(VE, vid, (([],tau),IdStatus.v)), tau )
+        end
 
 
     (* Type Expressions *)
@@ -10265,198 +10265,198 @@
     and elabTy(C, ty) = Type.normalise(elabTy'(C, ty))
 
     and elabTy'(C, TYVARTy(I, tyvar)) =
-	(* [Rule 44] *)
-	let
-	    val alpha = tyvar
-	in
-	    Type.fromTyVar alpha
-	end
+        (* [Rule 44] *)
+        let
+            val alpha = tyvar
+        in
+            Type.fromTyVar alpha
+        end
 
       | elabTy'(C, RECORDTy(I, tyrow_opt)) =
-	(* [Rule 45] *)
-	let
-	    val rho = case tyrow_opt
-			of NONE       => Type.emptyRho
-			 | SOME tyrow => elabTyRow'(C, tyrow)
-	in
-	    Type.fromRowType rho
-	end
+        (* [Rule 45] *)
+        let
+            val rho = case tyrow_opt
+                        of NONE       => Type.emptyRho
+                         | SOME tyrow => elabTyRow'(C, tyrow)
+        in
+            Type.fromRowType rho
+        end
 
       | elabTy'(C, TYCONTy(I, tyseq, longtycon)) =
-	(* [Rule 46] *)
-	let
-	    val Tyseq(I',tys) = tyseq
-	    val k             = List.length tys
-	    val taus          = List.map (fn ty => elabTy'(C, ty)) tys
-	    val (theta,VE)    =
-		case Context.findLongTyCon(C, longtycon)
-		  of SOME tystr => tystr
-		   | NONE =>
-		     errorLongTyCon(I, "unknown type constructor ", longtycon)
-	in
-	    TypeFcn.apply(taus, theta)
-	    handle TypeFcn.Apply =>
-		errorLongTyCon(I, "arity mismatch at type application ",
-				  longtycon)
-	end
+        (* [Rule 46] *)
+        let
+            val Tyseq(I',tys) = tyseq
+            val k             = List.length tys
+            val taus          = List.map (fn ty => elabTy'(C, ty)) tys
+            val (theta,VE)    =
+                case Context.findLongTyCon(C, longtycon)
+                  of SOME tystr => tystr
+                   | NONE =>
+                     errorLongTyCon(I, "unknown type constructor ", longtycon)
+        in
+            TypeFcn.apply(taus, theta)
+            handle TypeFcn.Apply =>
+                errorLongTyCon(I, "arity mismatch at type application ",
+                                  longtycon)
+        end
 
       | elabTy'(C, ARROWTy(I, ty, ty')) =
-	(* [Rule 47] *)
-	let
-	    val tau  = elabTy'(C, ty)
-	    val tau' = elabTy'(C, ty')
-	in
-	    Type.fromFunType(tau,tau')
-	end
+        (* [Rule 47] *)
+        let
+            val tau  = elabTy'(C, ty)
+            val tau' = elabTy'(C, ty')
+        in
+            Type.fromFunType(tau,tau')
+        end
 
       | elabTy'(C, PARTy(I, ty)) =
-	(* [Rule 48] *)
-	let
-	    val tau = elabTy'(C, ty)
-	in
-	    tau
-	end
+        (* [Rule 48] *)
+        let
+            val tau = elabTy'(C, ty)
+        in
+            tau
+        end
 
 
     (* Type-expression Rows *)
 
     and elabTyRow'(C, TyRow(I, lab, ty, tyrow_opt)) =
-	(* [Rule 49] *)
-	let
-	    val tau = elabTy'(C, ty)
-	    val rho = case tyrow_opt
-			of NONE       => Type.emptyRho
-			 | SOME tyrow => elabTyRow'(C, tyrow)
-	in
-	    if isSome(Type.findLab(rho, lab)) then
-		(* Syntactic restriction [Section 2.9, 1st bullet] *)
-		errorLab(I, "duplicate label ", lab)
-	    else
-		Type.insertRho(rho, lab, tau)
-	end
+        (* [Rule 49] *)
+        let
+            val tau = elabTy'(C, ty)
+            val rho = case tyrow_opt
+                        of NONE       => Type.emptyRho
+                         | SOME tyrow => elabTyRow'(C, tyrow)
+        in
+            if isSome(Type.findLab(rho, lab)) then
+                (* Syntactic restriction [Section 2.9, 1st bullet] *)
+                errorLab(I, "duplicate label ", lab)
+            else
+                Type.insertRho(rho, lab, tau)
+        end
 
 
 
     (* Build tentative VE from LHSs of recursive valbind *)
 
     and lhsRecValBind(PLAINValBind(I, pat, exp, valbind_opt)) =
-	let
-	    val VE  = lhsRecValBindPat pat
-	    val VE' = case valbind_opt
-			of NONE         => VIdMap.empty
-			 | SOME valbind => lhsRecValBind valbind
-	    val _   = case exp
-			of FNExp _ => ()
-			 | _ =>
-			   (* Syntactic restriction [Section 2.9, 4th bullet] *)
-			   error(I, "illegal expression within recursive \
-				    \value binding")
-	in
-	    VIdMap.unionWithi
-		(fn(vid,_,_) =>
-		       (* Syntactic restriction [Section 2.9, 2nd bullet] *)
-		       errorVId(I, "duplicate variable ", vid))  (VE,VE')
-	end
+        let
+            val VE  = lhsRecValBindPat pat
+            val VE' = case valbind_opt
+                        of NONE         => VIdMap.empty
+                         | SOME valbind => lhsRecValBind valbind
+            val _   = case exp
+                        of FNExp _ => ()
+                         | _ =>
+                           (* Syntactic restriction [Section 2.9, 4th bullet] *)
+                           error(I, "illegal expression within recursive \
+                                    \value binding")
+        in
+            VIdMap.unionWithi
+                (fn(vid,_,_) =>
+                       (* Syntactic restriction [Section 2.9, 2nd bullet] *)
+                       errorVId(I, "duplicate variable ", vid))  (VE,VE')
+        end
 
       | lhsRecValBind(RECValBind(I, valbind)) =
-	    lhsRecValBind valbind
+            lhsRecValBind valbind
 
     and lhsRecValBindPat(ATPATPat(I, atpat)) =
-	    lhsRecValBindAtPat atpat
+            lhsRecValBindAtPat atpat
 
       | lhsRecValBindPat(CONPat(I, _, longvid, atpat)) =
-	    lhsRecValBindAtPat atpat
+            lhsRecValBindAtPat atpat
 
       | lhsRecValBindPat(TYPEDPat(I, pat, ty)) =
-	    lhsRecValBindPat pat
+            lhsRecValBindPat pat
 
       | lhsRecValBindPat(ASPat(I, _, vid, ty_opt, pat)) =
-	let
-	    val VE = lhsRecValBindPat pat
-	in
-	    if isSome(VIdMap.find(VE, vid)) then
-		(* Syntactic restriction [Section 2.9, 2nd bullet] *)
-		errorVId(I, "duplicate variable ", vid)
-	    else if not(validBindVId vid) then
-		(* Syntactic restriction [Section 2.9, 5th bullet] *)
-		errorVId(I, "illegal rebinding of identifier ", vid)
-	    else
-		VIdMap.insert(VE, vid, (([],Type.invent()), IdStatus.v))
-	end
+        let
+            val VE = lhsRecValBindPat pat
+        in
+            if isSome(VIdMap.find(VE, vid)) then
+                (* Syntactic restriction [Section 2.9, 2nd bullet] *)
+                errorVId(I, "duplicate variable ", vid)
+            else if not(validBindVId vid) then
+                (* Syntactic restriction [Section 2.9, 5th bullet] *)
+                errorVId(I, "illegal rebinding of identifier ", vid)
+            else
+                VIdMap.insert(VE, vid, (([],Type.invent()), IdStatus.v))
+        end
 
     and lhsRecValBindAtPat(WILDCARDAtPat(I)) =
-	    VIdMap.empty
+            VIdMap.empty
 
       | lhsRecValBindAtPat(SCONAtPat(I, scon)) =
-	    VIdMap.empty
+            VIdMap.empty
 
       | lhsRecValBindAtPat(LONGVIDAtPat(I, _, longvid)) =
-	   (case LongVId.explode longvid
-	      of ([], vid) =>
-	 	    if not(validBindVId vid) then
-			(* Syntactic restriction [Section 2.9, 5th bullet] *)
-			errorVId(I, "illegal rebinding of identifier ", vid)
-		    else
-			VIdMap.singleton(vid, (([],Type.invent()),IdStatus.v))
+           (case LongVId.explode longvid
+              of ([], vid) =>
+                    if not(validBindVId vid) then
+                        (* Syntactic restriction [Section 2.9, 5th bullet] *)
+                        errorVId(I, "illegal rebinding of identifier ", vid)
+                    else
+                        VIdMap.singleton(vid, (([],Type.invent()),IdStatus.v))
 
-	       | _ => VIdMap.empty
-	   )
+               | _ => VIdMap.empty
+           )
 
       | lhsRecValBindAtPat(RECORDAtPat(I, patrow_opt)) =
-	   (case patrow_opt
-	      of NONE        => VIdMap.empty
-	       | SOME patrow => lhsRecValBindPatRow patrow
-	   )
+           (case patrow_opt
+              of NONE        => VIdMap.empty
+               | SOME patrow => lhsRecValBindPatRow patrow
+           )
 
       | lhsRecValBindAtPat(PARAtPat(I, pat)) =
-	    lhsRecValBindPat pat
+            lhsRecValBindPat pat
 
     and lhsRecValBindPatRow(WILDCARDPatRow(I)) =
-	    VIdMap.empty
+            VIdMap.empty
 
       | lhsRecValBindPatRow(ROWPatRow(I, lab, pat, patrow_opt)) =
-	let
-	    val VE = lhsRecValBindPat pat
-	in
-	    case patrow_opt
-	      of NONE        => VE
-	       | SOME patrow =>
-		 let
-		     val VE' = lhsRecValBindPatRow patrow
-		 in
-		     VIdMap.unionWithi (fn(vid,_,_) =>
-			 (* Syntactic restriction [Section 2.9, 2nd bullet] *)
-			 errorVId(I, "duplicate variable ", vid)) (VE,VE')
-		 end
-	end
+        let
+            val VE = lhsRecValBindPat pat
+        in
+            case patrow_opt
+              of NONE        => VE
+               | SOME patrow =>
+                 let
+                     val VE' = lhsRecValBindPatRow patrow
+                 in
+                     VIdMap.unionWithi (fn(vid,_,_) =>
+                         (* Syntactic restriction [Section 2.9, 2nd bullet] *)
+                         errorVId(I, "duplicate variable ", vid)) (VE,VE')
+                 end
+        end
 
 
 
     (* Build tentative TE from LHSs of datbind *)
 
     and lhsDatBind(DatBind(I, tyvarseq, tycon, conbind, datbind_opt)) =
-	(* [Rule 28, part 1] *)
-	let
-	    val (U,alphas) = tyvars tyvarseq
-	    val k          = List.length alphas
-	    val span       = lhsConBind conbind
-	    val t          = TyName.tyname(tycon, k, TyName.EQ, span)
-	    val tau        = Type.fromConsType(List.map Type.fromTyVar alphas,t)
-	    val TE'        = case datbind_opt
-			       of NONE         => TyConMap.empty
-				| SOME datbind => lhsDatBind datbind
-	in
-	    if isSome(TyConMap.find(TE', tycon)) then
-		(* Syntactic restriction [Section 2.9, 2nd bullet] *)
-		errorTyCon(I, "duplicate type constructor ", tycon)
-	    else
-		TyConMap.insert(TE', tycon, ((alphas,tau), VIdMap.empty))
-	end
+        (* [Rule 28, part 1] *)
+        let
+            val (U,alphas) = tyvars tyvarseq
+            val k          = List.length alphas
+            val span       = lhsConBind conbind
+            val t          = TyName.tyname(tycon, k, TyName.EQ, span)
+            val tau        = Type.fromConsType(List.map Type.fromTyVar alphas,t)
+            val TE'        = case datbind_opt
+                               of NONE         => TyConMap.empty
+                                | SOME datbind => lhsDatBind datbind
+        in
+            if isSome(TyConMap.find(TE', tycon)) then
+                (* Syntactic restriction [Section 2.9, 2nd bullet] *)
+                errorTyCon(I, "duplicate type constructor ", tycon)
+            else
+                TyConMap.insert(TE', tycon, ((alphas,tau), VIdMap.empty))
+        end
 
     and lhsConBind(ConBind(I, _, vid, ty_opt, conbind_opt)) =
-	case conbind_opt
-	  of NONE         => 1
-	   | SOME conbind => 1 + lhsConBind conbind
+        case conbind_opt
+          of NONE         => 1
+           | SOME conbind => 1 + lhsConBind conbind
 
   end
 (* stop of ElabCore.sml *)
@@ -10481,7 +10481,7 @@
 
     (* Export *)
 
-    val elabTopDec:	Basis * TopDec -> Basis
+    val elabTopDec:     Basis * TopDec -> Basis
 
   end
 (* stop of ELAB_MODULE.sml *)
@@ -10520,9 +10520,9 @@
     fun errorFunId(I, s, funid) = error(I, s ^ FunId.toString funid)
 
     fun errorLongTyCon(I, s, longtycon) =
-	error(I, s ^ LongTyCon.toString longtycon)
+        error(I, s ^ LongTyCon.toString longtycon)
     fun errorLongStrId(I, s, longstrid) =
-	error(I, s ^ LongStrId.toString longstrid)
+        error(I, s ^ LongStrId.toString longstrid)
 
 
     (* Helpers for basis modification *)
@@ -10544,707 +10544,707 @@
     (* Structure Expressions *)
 
     fun elabStrExp(B, STRUCTStrExp(I, strdec)) =
-	(* [Rule 50] *)
-	let
-	    val E = elabStrDec(false, B, strdec)
-	in
-	    E
-	end
+        (* [Rule 50] *)
+        let
+            val E = elabStrDec(false, B, strdec)
+        in
+            E
+        end
 
       | elabStrExp(B, LONGSTRIDStrExp(I, longstrid)) =
-	(* [Rule 51] *)
-	let
-	    val E = case StaticBasis.findLongStrId(B, longstrid)
-		      of SOME(StaticEnv.Str E) => E
-		       | NONE =>
-			 errorLongStrId(I, "unknown structure ", longstrid)
-	in
-	    E
-	end
+        (* [Rule 51] *)
+        let
+            val E = case StaticBasis.findLongStrId(B, longstrid)
+                      of SOME(StaticEnv.Str E) => E
+                       | NONE =>
+                         errorLongStrId(I, "unknown structure ", longstrid)
+        in
+            E
+        end
 
       | elabStrExp(B, TRANSStrExp(I, strexp, sigexp)) =
-	(* [Rule 52] *)
-	let
-	    val E      = elabStrExp(B, strexp)
-	    val Sigma  = elabSigExp(B, sigexp)
-	    val (E',_) = Sig.match(E, Sigma)
-			 handle Sig.Match =>
-				error(I, "structure does not match constraint")
-	in
-	    E'
-	end
+        (* [Rule 52] *)
+        let
+            val E      = elabStrExp(B, strexp)
+            val Sigma  = elabSigExp(B, sigexp)
+            val (E',_) = Sig.match(E, Sigma)
+                         handle Sig.Match =>
+                                error(I, "structure does not match constraint")
+        in
+            E'
+        end
 
       | elabStrExp(B, OPAQStrExp(I, strexp, sigexp)) =
-	(* [Rule 53] *)
-	let
-	    val E       = elabStrExp(B, strexp)
-	    val (T',E') = Sig.rename(elabSigExp(B, sigexp))
-	    val (E'',_) = Sig.match(E, (T',E'))
-			  handle Sig.Match =>
-				 error(I, "structure does not match constraint")
-	    (* Renaming ensures side condition on T' *)
-	in
-	    E'
-	end
+        (* [Rule 53] *)
+        let
+            val E       = elabStrExp(B, strexp)
+            val (T',E') = Sig.rename(elabSigExp(B, sigexp))
+            val (E'',_) = Sig.match(E, (T',E'))
+                          handle Sig.Match =>
+                                 error(I, "structure does not match constraint")
+            (* Renaming ensures side condition on T' *)
+        in
+            E'
+        end
 
       | elabStrExp(B, APPStrExp(I, funid, strexp)) =
-	(* [Rule 54] *)
-	let
-	    val E = elabStrExp(B, strexp)
-	    val (T1'',(E1'',(T1',E1'))) =
-		      case StaticBasis.findFunId(B, funid)
-			of SOME Phi => Phi
-			 | NONE     => errorFunId(I, "unknown functor ", funid)
-	    val (E'',phi) = Sig.match(E, (T1'',E1''))
-			    handle Sig.Match =>
-				error(I, "structure does not match constraint")
-	    val (T',E')   = Sig.rename (T1', StaticEnv.realise phi E1')
-	    (* Renaming ensures side condition on T' *)
-	in
-	    E'
-	end
+        (* [Rule 54] *)
+        let
+            val E = elabStrExp(B, strexp)
+            val (T1'',(E1'',(T1',E1'))) =
+                      case StaticBasis.findFunId(B, funid)
+                        of SOME Phi => Phi
+                         | NONE     => errorFunId(I, "unknown functor ", funid)
+            val (E'',phi) = Sig.match(E, (T1'',E1''))
+                            handle Sig.Match =>
+                                error(I, "structure does not match constraint")
+            val (T',E')   = Sig.rename (T1', StaticEnv.realise phi E1')
+            (* Renaming ensures side condition on T' *)
+        in
+            E'
+        end
 
       | elabStrExp(B, LETStrExp(I, strdec, strexp)) =
-	(* [Rule 55] *)
-	let
-	    val E1 = elabStrDec(false, B, strdec)
-	    val E2 = elabStrExp(B oplusE E1, strexp)
-	in
-	    E2
-	end
+        (* [Rule 55] *)
+        let
+            val E1 = elabStrDec(false, B, strdec)
+            val E2 = elabStrExp(B oplusE E1, strexp)
+        in
+            E2
+        end
 
 
     (* Structure-level Declarations *)
 
     and elabStrDec(toplevel, B, DECStrDec(I, dec)) =
-	(* [Rule 56] *)
-	let
-	    val E = ElabCore.elabDec(toplevel, StaticBasis.Cof B, dec)
-	in
-	    E
-	end
+        (* [Rule 56] *)
+        let
+            val E = ElabCore.elabDec(toplevel, StaticBasis.Cof B, dec)
+        in
+            E
+        end
 
       | elabStrDec(toplevel, B, STRUCTUREStrDec(I, strbind)) =
-	(* [Rule 57] *)
-	let
-	    val SE = elabStrBind(B, strbind)
-	in
-	    StaticEnv.fromSE SE
-	end
+        (* [Rule 57] *)
+        let
+            val SE = elabStrBind(B, strbind)
+        in
+            StaticEnv.fromSE SE
+        end
 
       | elabStrDec(toplevel, B, LOCALStrDec(I, strdec1, strdec2)) =
-	(* [Rule 58] *)
-	let
-	    val E1 = elabStrDec(false, B, strdec1)
-	    val E2 = elabStrDec(false, B oplusE E1, strdec2)
-	in
-	    E2
-	end
+        (* [Rule 58] *)
+        let
+            val E1 = elabStrDec(false, B, strdec1)
+            val E2 = elabStrDec(false, B oplusE E1, strdec2)
+        in
+            E2
+        end
 
       | elabStrDec(toplevel, B, EMPTYStrDec(I)) =
-	(* [Rule 59] *)
-	StaticEnv.empty
+        (* [Rule 59] *)
+        StaticEnv.empty
 
       | elabStrDec(toplevel, B, SEQStrDec(I, strdec1, strdec2)) =
-	(* [Rule 60] *)
-	let
-	    val E1 = elabStrDec(toplevel, B, strdec1)
-	    val E2 = elabStrDec(toplevel, B oplusE E1, strdec2)
-	in
-	    StaticEnv.plus(E1,E2)
-	end
+        (* [Rule 60] *)
+        let
+            val E1 = elabStrDec(toplevel, B, strdec1)
+            val E2 = elabStrDec(toplevel, B oplusE E1, strdec2)
+        in
+            StaticEnv.plus(E1,E2)
+        end
 
 
     (* Structure Bindings *)
 
     and elabStrBind(B, StrBind(I, strid, strexp, strbind_opt)) =
-	(* [Rule 61] *)
-	let
-	    val E  = elabStrExp(B, strexp)
-	    val SE = case strbind_opt
-		       of NONE         => StrIdMap.empty
-		        | SOME strbind =>
-			  elabStrBind(B plusT StaticEnv.tynames E, strbind)
-	in
-	    if isSome(StrIdMap.find(SE, strid)) then
-		(* Syntactic restriction [Section 3.5, 1st bullet] *)
-		errorStrId(I, "duplicate structure identifier ", strid)
-	    else
-		StrIdMap.insert(SE, strid, StaticEnv.Str E)
-	end
+        (* [Rule 61] *)
+        let
+            val E  = elabStrExp(B, strexp)
+            val SE = case strbind_opt
+                       of NONE         => StrIdMap.empty
+                        | SOME strbind =>
+                          elabStrBind(B plusT StaticEnv.tynames E, strbind)
+        in
+            if isSome(StrIdMap.find(SE, strid)) then
+                (* Syntactic restriction [Section 3.5, 1st bullet] *)
+                errorStrId(I, "duplicate structure identifier ", strid)
+            else
+                StrIdMap.insert(SE, strid, StaticEnv.Str E)
+        end
 
 
     (* Signature Expressions *)
 
     and elabSigExpE(B, SIGSigExp(I, spec)) =
-	(* [Rule 62] *)
-	let
-	    val E = elabSpec(B, spec)
-	in
-	    E
-	end
+        (* [Rule 62] *)
+        let
+            val E = elabSpec(B, spec)
+        in
+            E
+        end
 
       | elabSigExpE(B, SIGIDSigExp(I, sigid)) =
-	(* [Rule 63] *)
-	let
-	    val (T,E) = case StaticBasis.findSigId(B, sigid)
-			  of SOME Sigma => Sig.rename Sigma
-			   | NONE => errorSigId(I, "unknown signature ",sigid)
-	in
-	    E
-	end
+        (* [Rule 63] *)
+        let
+            val (T,E) = case StaticBasis.findSigId(B, sigid)
+                          of SOME Sigma => Sig.rename Sigma
+                           | NONE => errorSigId(I, "unknown signature ",sigid)
+        in
+            E
+        end
 
       | elabSigExpE(B, WHERETYPESigExp(I, sigexp, tyvarseq, longtycon, ty)) =
-	(* [Rule 64] *)
-	let
-	    val E      = elabSigExpE(B, sigexp)
-	    val alphas = #2(ElabCore.tyvars tyvarseq)
-	    val tau    = ElabCore.elabTy(StaticBasis.Cof B, ty)
-	    val t      = case StaticEnv.findLongTyCon(E,longtycon)
-			   of NONE =>
-			      errorLongTyCon(I, "unknown type ", longtycon)
-			    | SOME(theta,VE) =>
-			 case TypeFcn.toTyName theta
-			   of NONE =>
-			      errorLongTyCon(I, "non-flexible type ", longtycon)
-			    | SOME t => t
-	    val  _     = if not(TyNameSet.member(StaticBasis.Tof B, t)) then ()
-			 else errorLongTyCon(I, "rigid type ", longtycon)
-	    val phi    = TyNameMap.singleton(t, (alphas,tau))
-	    val  _     = if TyName.equality t = TyName.NOEQ
-			 orelse TypeFcn.admitsEquality (alphas,tau) then () else
-			  error(I, "type realisation does not respect equality")
-	    val E'     = StaticEnv.realise phi E
-	    val  _     = if StaticEnv.isWellFormed E' then () else
-			  error(I, "type realisation does not respect datatype")
-	in
-	    E'
-	end
+        (* [Rule 64] *)
+        let
+            val E      = elabSigExpE(B, sigexp)
+            val alphas = #2(ElabCore.tyvars tyvarseq)
+            val tau    = ElabCore.elabTy(StaticBasis.Cof B, ty)
+            val t      = case StaticEnv.findLongTyCon(E,longtycon)
+                           of NONE =>
+                              errorLongTyCon(I, "unknown type ", longtycon)
+                            | SOME(theta,VE) =>
+                         case TypeFcn.toTyName theta
+                           of NONE =>
+                              errorLongTyCon(I, "non-flexible type ", longtycon)
+                            | SOME t => t
+            val  _     = if not(TyNameSet.member(StaticBasis.Tof B, t)) then ()
+                         else errorLongTyCon(I, "rigid type ", longtycon)
+            val phi    = TyNameMap.singleton(t, (alphas,tau))
+            val  _     = if TyName.equality t = TyName.NOEQ
+                         orelse TypeFcn.admitsEquality (alphas,tau) then () else
+                          error(I, "type realisation does not respect equality")
+            val E'     = StaticEnv.realise phi E
+            val  _     = if StaticEnv.isWellFormed E' then () else
+                          error(I, "type realisation does not respect datatype")
+        in
+            E'
+        end
 
     and elabSigExp(B, sigexp) =
-	(* [Rule 65] *)
-	let
-	    val E = elabSigExpE(B, sigexp)
-	    val T = TyNameSet.difference(StaticEnv.tynames E, StaticBasis.Tof B)
-	in
-	    (T,E)
-	end
+        (* [Rule 65] *)
+        let
+            val E = elabSigExpE(B, sigexp)
+            val T = TyNameSet.difference(StaticEnv.tynames E, StaticBasis.Tof B)
+        in
+            (T,E)
+        end
 
 
     (* Signature Declarations *)
 
     and elabSigDec(B, SigDec(I, sigbind)) =
-	(* [Rule 66] *)
-	let
-	    val G = elabSigBind(B, sigbind)
-	in
-	    G
-	end
+        (* [Rule 66] *)
+        let
+            val G = elabSigBind(B, sigbind)
+        in
+            G
+        end
 
 
     (* Signature Bindings *)
 
     and elabSigBind(B, SigBind(I, sigid, sigexp, sigbind_opt)) =
-	(* [Rule 67] *)
-	let
-	    val Sigma = elabSigExp(B, sigexp)
-	    val G     = case sigbind_opt
-			  of NONE         => SigIdMap.empty
-			   | SOME sigbind => elabSigBind(B, sigbind)
-	in
-	    if isSome(SigIdMap.find(G, sigid)) then
-		(* Syntactic restriction [Section 3.5, 1st bullet] *)
-		errorSigId(I, "duplicate signature identifier ", sigid)
-	    else
-		SigIdMap.insert(G, sigid, Sigma)
-	end
+        (* [Rule 67] *)
+        let
+            val Sigma = elabSigExp(B, sigexp)
+            val G     = case sigbind_opt
+                          of NONE         => SigIdMap.empty
+                           | SOME sigbind => elabSigBind(B, sigbind)
+        in
+            if isSome(SigIdMap.find(G, sigid)) then
+                (* Syntactic restriction [Section 3.5, 1st bullet] *)
+                errorSigId(I, "duplicate signature identifier ", sigid)
+            else
+                SigIdMap.insert(G, sigid, Sigma)
+        end
 
 
     (* Specifications *)
 
     and elabSpec(B, VALSpec(I, valdesc)) =
-	(* [Rule 68] *)
-	let
-	    val VE = elabValDesc(StaticBasis.Cof B, valdesc)
-	in
-	    StaticEnv.fromVE(StaticEnv.Clos VE)
-	end
+        (* [Rule 68] *)
+        let
+            val VE = elabValDesc(StaticBasis.Cof B, valdesc)
+        in
+            StaticEnv.fromVE(StaticEnv.Clos VE)
+        end
 
       | elabSpec(B, TYPESpec(I, typdesc)) =
-	(* [Rule 69] *)
-	let
-	    val TE = elabTypDesc(StaticBasis.Cof B, typdesc)
-	    (* Side condition on type names is always ensured. *)
-	in
-	    StaticEnv.fromTE TE
-	end
+        (* [Rule 69] *)
+        let
+            val TE = elabTypDesc(StaticBasis.Cof B, typdesc)
+            (* Side condition on type names is always ensured. *)
+        in
+            StaticEnv.fromTE TE
+        end
 
       | elabSpec(B, EQTYPESpec(I, typdesc)) =
-	(* [Rule 70] *)
-	let
-	    val TE = elabTypDesc(StaticBasis.Cof B, typdesc)
-	    val _  = StaticEnv.makeEquality TE
-	in
-	    StaticEnv.fromTE TE
-	end
+        (* [Rule 70] *)
+        let
+            val TE = elabTypDesc(StaticBasis.Cof B, typdesc)
+            val _  = StaticEnv.makeEquality TE
+        in
+            StaticEnv.fromTE TE
+        end
 
       | elabSpec(B, DATATYPESpec(I, datdesc)) =
-	(* [Rule 71] *)
-	let
-	    val      TE1  = lhsDatDesc datdesc
-	    val (VE2,TE2) = elabDatDesc(Context.oplusTE(StaticBasis.Cof B,TE1),
-					datdesc)
-	    val (TE, VE)  = StaticEnv.maximiseEquality(TE2,VE2)
-	    (* Side condition on type names is always ensured. *)
-	in
-	    StaticEnv.fromVEandTE(VE,TE)
-	end
+        (* [Rule 71] *)
+        let
+            val      TE1  = lhsDatDesc datdesc
+            val (VE2,TE2) = elabDatDesc(Context.oplusTE(StaticBasis.Cof B,TE1),
+                                        datdesc)
+            val (TE, VE)  = StaticEnv.maximiseEquality(TE2,VE2)
+            (* Side condition on type names is always ensured. *)
+        in
+            StaticEnv.fromVEandTE(VE,TE)
+        end
 
       | elabSpec(B, REPLICATIONSpec(I, tycon, longtycon)) =
-	(* [Rule 72] *)
-	let
-	    val (theta,VE) = case StaticBasis.findLongTyCon(B, longtycon)
-			      of SOME tystr => tystr
-			       | NONE =>
-				 errorLongTyCon(I, "unknown type ", longtycon)
-	    val  TE        = TyConMap.singleton(tycon, (theta,VE))
-	in
-	    StaticEnv.fromVEandTE(VE,TE)
-	end
+        (* [Rule 72] *)
+        let
+            val (theta,VE) = case StaticBasis.findLongTyCon(B, longtycon)
+                              of SOME tystr => tystr
+                               | NONE =>
+                                 errorLongTyCon(I, "unknown type ", longtycon)
+            val  TE        = TyConMap.singleton(tycon, (theta,VE))
+        in
+            StaticEnv.fromVEandTE(VE,TE)
+        end
 
       | elabSpec(B, EXCEPTIONSpec(I, exdesc)) =
-	(* [Rule 73] *)
-	let
-	    val VE = elabExDesc(StaticBasis.Cof B, exdesc)
-	in
-	    StaticEnv.fromVE VE
-	end
+        (* [Rule 73] *)
+        let
+            val VE = elabExDesc(StaticBasis.Cof B, exdesc)
+        in
+            StaticEnv.fromVE VE
+        end
 
       | elabSpec(B, STRUCTURESpec(I, strdesc)) =
-	(* [Rule 74] *)
-	let
-	    val SE = elabStrDesc(B, strdesc)
-	in
-	    StaticEnv.fromSE SE
-	end
+        (* [Rule 74] *)
+        let
+            val SE = elabStrDesc(B, strdesc)
+        in
+            StaticEnv.fromSE SE
+        end
 
       | elabSpec(B, INCLUDESpec(I, sigexp)) =
-	(* [Rule 75] *)
-	let
-	    val E = elabSigExpE(B, sigexp)
-	in
-	    E
-	end
+        (* [Rule 75] *)
+        let
+            val E = elabSigExpE(B, sigexp)
+        in
+            E
+        end
 
       | elabSpec(B, EMPTYSpec(I)) =
-	(* [Rule 76] *)
-	StaticEnv.empty
+        (* [Rule 76] *)
+        StaticEnv.empty
 
       | elabSpec(B, SEQSpec(I, spec1, spec2)) =
-	(* [Rule 77] *)
-	let
-	    val E1 = elabSpec(B, spec1)
-	    val E2 = elabSpec(B oplusE E1, spec2)
-	    val _  = if StaticEnv.disjoint(E1,E2) then () else
-		     error(I, "duplicate specifications in signature")
-	in
-	    StaticEnv.plus(E1,E2)
-	end
+        (* [Rule 77] *)
+        let
+            val E1 = elabSpec(B, spec1)
+            val E2 = elabSpec(B oplusE E1, spec2)
+            val _  = if StaticEnv.disjoint(E1,E2) then () else
+                     error(I, "duplicate specifications in signature")
+        in
+            StaticEnv.plus(E1,E2)
+        end
 
       | elabSpec(B, SHARINGTYPESpec(I, spec, longtycons)) =
-	(* [Rule 78] *)
-	let
-	    val E  = elabSpec(B, spec)
-	    val ts =
-		List.map
-		(fn longtycon =>
-		 case StaticEnv.findLongTyCon(E, longtycon)
-		   of NONE =>
-			errorLongTyCon(I, "unknown type ", longtycon)
-		    | SOME(theta,VE) =>
-		 case TypeFcn.toTyName theta
-		   of NONE =>
-			errorLongTyCon(I, "non-flexible type ", longtycon)
-		    | SOME t =>
-		      if TyNameSet.member(StaticBasis.Tof B, t) then
-			errorLongTyCon(I, "rigid type ", longtycon)
-		      else
-			t
-		)
-		longtycons
-	    val equality = if List.exists
-				(fn t => TyName.equality t <> TyName.NOEQ) ts
-			   then TyName.EQ
-			   else TyName.NOEQ
-	    val span  = List.foldl
-				(fn(t, span) => Int.max(TyName.span t, span))
-				0 ts
-	    val t1    = List.hd ts
-	    val t     = TyName.tyname(TyName.tycon t1, TyName.arity t1,
-				      equality, span)
-	    val theta = TypeFcn.fromTyName t
-	    val phi   = List.foldl
-			    (fn(ti, phi) => TyNameMap.insert(phi, ti, theta))
-			    TyNameMap.empty ts
-	in
-	    StaticEnv.realise phi E
-	end
+        (* [Rule 78] *)
+        let
+            val E  = elabSpec(B, spec)
+            val ts =
+                List.map
+                (fn longtycon =>
+                 case StaticEnv.findLongTyCon(E, longtycon)
+                   of NONE =>
+                        errorLongTyCon(I, "unknown type ", longtycon)
+                    | SOME(theta,VE) =>
+                 case TypeFcn.toTyName theta
+                   of NONE =>
+                        errorLongTyCon(I, "non-flexible type ", longtycon)
+                    | SOME t =>
+                      if TyNameSet.member(StaticBasis.Tof B, t) then
+                        errorLongTyCon(I, "rigid type ", longtycon)
+                      else
+                        t
+                )
+                longtycons
+            val equality = if List.exists
+                                (fn t => TyName.equality t <> TyName.NOEQ) ts
+                           then TyName.EQ
+                           else TyName.NOEQ
+            val span  = List.foldl
+                                (fn(t, span) => Int.max(TyName.span t, span))
+                                0 ts
+            val t1    = List.hd ts
+            val t     = TyName.tyname(TyName.tycon t1, TyName.arity t1,
+                                      equality, span)
+            val theta = TypeFcn.fromTyName t
+            val phi   = List.foldl
+                            (fn(ti, phi) => TyNameMap.insert(phi, ti, theta))
+                            TyNameMap.empty ts
+        in
+            StaticEnv.realise phi E
+        end
 
       | elabSpec(B, SHARINGSpec(I, spec, longstrids)) =
-	(* [Appendix A] *)
-	let
-	    fun shareFlexibleTyName(t1, t2, phi) =
-		let
-		    val equality = if TyName.equality t1 <> TyName.NOEQ
-				   orelse TyName.equality t2 <> TyName.NOEQ
-				   then TyName.EQ
-				   else TyName.NOEQ
-		    val t        = TyName.tyname(TyName.tycon t1,
-						 TyName.arity t1,
-						 equality,
-						 Int.max(TyName.span t1,
-							 TyName.span t2))
-		    val theta    = TypeFcn.fromTyName t
-		in
-		    TyNameMap.insert(TyNameMap.insert(phi,
-			t1, theta),
-			t2, theta)
-		end
+        (* [Appendix A] *)
+        let
+            fun shareFlexibleTyName(t1, t2, phi) =
+                let
+                    val equality = if TyName.equality t1 <> TyName.NOEQ
+                                   orelse TyName.equality t2 <> TyName.NOEQ
+                                   then TyName.EQ
+                                   else TyName.NOEQ
+                    val t        = TyName.tyname(TyName.tycon t1,
+                                                 TyName.arity t1,
+                                                 equality,
+                                                 Int.max(TyName.span t1,
+                                                         TyName.span t2))
+                    val theta    = TypeFcn.fromTyName t
+                in
+                    TyNameMap.insert(TyNameMap.insert(phi,
+                        t1, theta),
+                        t2, theta)
+                end
 
-	    fun shareTE(TE1, TE2, phi) =
-		TyConMap.foldli
-		    (fn(tycon, (theta1,VE1), phi) =>
-			case TyConMap.find(TE2, tycon)
-			  of NONE             => phi
-			   | SOME(theta2,VE2) =>
-			case (TypeFcn.toTyName(TypeFcn.realise phi theta1),
-			      TypeFcn.toTyName(TypeFcn.realise phi theta2))
-			  of (SOME t1, SOME t2) =>
-			     if TyNameSet.member(StaticBasis.Tof B, t1)
-			     orelse TyNameSet.member(StaticBasis.Tof B,t2) then
-				errorTyCon(I, "structure contains rigid type ",
-					      tycon)
-			     else
-				shareFlexibleTyName(t1, t2, phi)
-			   | _ =>
-			     errorTyCon(I, "structure contains non-flexible \
-					   \type ", tycon)
-		    )
-		    phi TE1
+            fun shareTE(TE1, TE2, phi) =
+                TyConMap.foldli
+                    (fn(tycon, (theta1,VE1), phi) =>
+                        case TyConMap.find(TE2, tycon)
+                          of NONE             => phi
+                           | SOME(theta2,VE2) =>
+                        case (TypeFcn.toTyName(TypeFcn.realise phi theta1),
+                              TypeFcn.toTyName(TypeFcn.realise phi theta2))
+                          of (SOME t1, SOME t2) =>
+                             if TyNameSet.member(StaticBasis.Tof B, t1)
+                             orelse TyNameSet.member(StaticBasis.Tof B,t2) then
+                                errorTyCon(I, "structure contains rigid type ",
+                                              tycon)
+                             else
+                                shareFlexibleTyName(t1, t2, phi)
+                           | _ =>
+                             errorTyCon(I, "structure contains non-flexible \
+                                           \type ", tycon)
+                    )
+                    phi TE1
 
-	    fun shareSE(SE1, SE2, phi) =
-		StrIdMap.foldli
-		    (fn(strid, StaticEnv.Str E1, phi) =>
-			case StrIdMap.find(SE2, strid)
-			  of NONE                   => phi
-			   | SOME(StaticEnv.Str E2) => shareE(E1, E2, phi)
-		    )
-		    phi SE1
+            fun shareSE(SE1, SE2, phi) =
+                StrIdMap.foldli
+                    (fn(strid, StaticEnv.Str E1, phi) =>
+                        case StrIdMap.find(SE2, strid)
+                          of NONE                   => phi
+                           | SOME(StaticEnv.Str E2) => shareE(E1, E2, phi)
+                    )
+                    phi SE1
 
-	    and shareE((SE1,TE1,VE1), (SE2,TE2,VE2), phi) =
-		let
-		    val phi'  = shareTE(TE1, TE2, phi)
-		    val phi'' = shareSE(SE1, SE2, phi')
-		in
-		    phi''
-		end
+            and shareE((SE1,TE1,VE1), (SE2,TE2,VE2), phi) =
+                let
+                    val phi'  = shareTE(TE1, TE2, phi)
+                    val phi'' = shareSE(SE1, SE2, phi')
+                in
+                    phi''
+                end
 
-	    fun share1(E1,   [],   phi) = phi
-	      | share1(E1, E2::Es, phi) =
-		let
-		    val phi' = shareE(E1, E2, phi)
-		in
-		    share1(E1, Es, phi')
-		end
+            fun share1(E1,   [],   phi) = phi
+              | share1(E1, E2::Es, phi) =
+                let
+                    val phi' = shareE(E1, E2, phi)
+                in
+                    share1(E1, Es, phi')
+                end
 
-	    fun shareAll( [],   phi) = phi
-	      | shareAll(E::Es, phi) =
-		let
-		    val phi' = share1(E, Es, phi)
-		in
-		    shareAll(Es, phi')
-		end
+            fun shareAll( [],   phi) = phi
+              | shareAll(E::Es, phi) =
+                let
+                    val phi' = share1(E, Es, phi)
+                in
+                    shareAll(Es, phi')
+                end
 
-	    val E   = elabSpec(B, spec)
-	    val Es  = List.map
-			(fn longstrid =>
-			 case StaticEnv.findLongStrId(E, longstrid)
-			   of SOME(StaticEnv.Str E') => E'
-			    | NONE =>
-			      errorLongStrId(I, "unknown structure ", longstrid)
-			) longstrids
-	    val phi = shareAll(Es, TyNameMap.empty)
-	in
-	    StaticEnv.realise phi E
-	end
+            val E   = elabSpec(B, spec)
+            val Es  = List.map
+                        (fn longstrid =>
+                         case StaticEnv.findLongStrId(E, longstrid)
+                           of SOME(StaticEnv.Str E') => E'
+                            | NONE =>
+                              errorLongStrId(I, "unknown structure ", longstrid)
+                        ) longstrids
+            val phi = shareAll(Es, TyNameMap.empty)
+        in
+            StaticEnv.realise phi E
+        end
 
 
     (* Value Descriptions *)
 
     and elabValDesc(C, ValDesc(I, vid, ty, valdesc_opt)) =
-	(* [Rule 79] *)
-	let
-	    val tau = ElabCore.elabTy(C, ty)
-	    val VE  = case valdesc_opt
-			of NONE         => VIdMap.empty
-			 | SOME valdesc => elabValDesc(C, valdesc)
-	in
-	    if isSome(VIdMap.find(VE, vid)) then
-		(* Syntactic restriction [Section 3.5, 2nd bullet] *)
-		errorVId(I, "duplicate variable ", vid)
-	    else if not(ElabCore.validBindVId vid) then
-		(* Syntactic restriction [Section 3.5, 5th bullet] *)
-		errorVId(I, "illegal specification of identifier ", vid)
-	    else
-		VIdMap.insert(VE, vid, (([],tau),IdStatus.v))
-	end
+        (* [Rule 79] *)
+        let
+            val tau = ElabCore.elabTy(C, ty)
+            val VE  = case valdesc_opt
+                        of NONE         => VIdMap.empty
+                         | SOME valdesc => elabValDesc(C, valdesc)
+        in
+            if isSome(VIdMap.find(VE, vid)) then
+                (* Syntactic restriction [Section 3.5, 2nd bullet] *)
+                errorVId(I, "duplicate variable ", vid)
+            else if not(ElabCore.validBindVId vid) then
+                (* Syntactic restriction [Section 3.5, 5th bullet] *)
+                errorVId(I, "illegal specification of identifier ", vid)
+            else
+                VIdMap.insert(VE, vid, (([],tau),IdStatus.v))
+        end
 
 
     (* Type Descriptions *)
 
     and elabTypDesc(C, TypDesc(I, tyvarseq, tycon, typdesc_opt)) =
-	(* [Rule 80] *)
-	let
-	    val alphas = #2(ElabCore.tyvars tyvarseq)
-	    val k      = List.length alphas
-	    val t      = TyName.tyname(tycon, k, TyName.NOEQ, 0)
-	    val TE     = case typdesc_opt
-			   of NONE         => TyConMap.empty
-			    | SOME typdesc => elabTypDesc(C, typdesc)
-			      (* Side condition on t is always true. *)
-	    val tau    = Type.fromConsType (List.map Type.fromTyVar alphas, t)
-	in
-	    if isSome(TyConMap.find(TE, tycon)) then
-		(* Syntactic restriction [Section 3.5, 2nd bullet] *)
-		errorTyCon(I, "duplicate type constructor ", tycon)
-	    else
-		TyConMap.insert(TE, tycon, ((alphas,tau),VIdMap.empty))
-	end
+        (* [Rule 80] *)
+        let
+            val alphas = #2(ElabCore.tyvars tyvarseq)
+            val k      = List.length alphas
+            val t      = TyName.tyname(tycon, k, TyName.NOEQ, 0)
+            val TE     = case typdesc_opt
+                           of NONE         => TyConMap.empty
+                            | SOME typdesc => elabTypDesc(C, typdesc)
+                              (* Side condition on t is always true. *)
+            val tau    = Type.fromConsType (List.map Type.fromTyVar alphas, t)
+        in
+            if isSome(TyConMap.find(TE, tycon)) then
+                (* Syntactic restriction [Section 3.5, 2nd bullet] *)
+                errorTyCon(I, "duplicate type constructor ", tycon)
+            else
+                TyConMap.insert(TE, tycon, ((alphas,tau),VIdMap.empty))
+        end
 
 
     (* Datatype Descriptions *)
 
     and elabDatDesc(C, DatDesc(I, tyvarseq, tycon, condesc, datdesc_opt)) =
-	(* [Rule 81, part 2] *)
-	let
-	    val (U,alphas)   = ElabCore.tyvars tyvarseq
-	    val (alphas,tau) = case Context.findTyCon(C, tycon)
-				 of SOME(theta,VE) => theta
-				  | NONE => (* lhsDatDesc inserted it! *)
-				    raise Fail "ElabCore.elabDatDesc: \
-						\tycon not pre-bound"
-	    val VE       = elabConDesc(C,tau, condesc)
-	    val(VE',TE') = case datdesc_opt
-			     of NONE         => ( VIdMap.empty, TyConMap.empty )
-			      | SOME datdesc => elabDatDesc(C, datdesc)
-				(* Side condition on t is always true. *)
-	    val ClosVE   = if TyVarSet.isSubset(StaticEnv.tyvarsVE VE, U) then
-			     StaticEnv.Clos VE
-			   else
-			     (* Syntactic restriction [Section 3.5,4th bullet]*)
-			     error(I, "free type variables \
-				      \in datatype description")
-	in
-	    if isSome(TyConMap.find(TE', tycon)) then
-		  (* Syntactic restriction [Section 3.5, 2nd bullet] *)
-		  errorTyCon(I, "duplicate type constructor ", tycon)
-	    else
-	    ( VIdMap.unionWithi (fn(vid,_,_) =>
-		  (* Syntactic restriction [Section 3.5, 2nd bullet] *)
-		  errorVId(I, "duplicate data cnstructor ", vid)) (ClosVE,VE')
-	    , TyConMap.insert(TE', tycon, ((alphas,tau),ClosVE))
-	    )
-	end
+        (* [Rule 81, part 2] *)
+        let
+            val (U,alphas)   = ElabCore.tyvars tyvarseq
+            val (alphas,tau) = case Context.findTyCon(C, tycon)
+                                 of SOME(theta,VE) => theta
+                                  | NONE => (* lhsDatDesc inserted it! *)
+                                    raise Fail "ElabCore.elabDatDesc: \
+                                                \tycon not pre-bound"
+            val VE       = elabConDesc(C,tau, condesc)
+            val(VE',TE') = case datdesc_opt
+                             of NONE         => ( VIdMap.empty, TyConMap.empty )
+                              | SOME datdesc => elabDatDesc(C, datdesc)
+                                (* Side condition on t is always true. *)
+            val ClosVE   = if TyVarSet.isSubset(StaticEnv.tyvarsVE VE, U) then
+                             StaticEnv.Clos VE
+                           else
+                             (* Syntactic restriction [Section 3.5,4th bullet]*)
+                             error(I, "free type variables \
+                                      \in datatype description")
+        in
+            if isSome(TyConMap.find(TE', tycon)) then
+                  (* Syntactic restriction [Section 3.5, 2nd bullet] *)
+                  errorTyCon(I, "duplicate type constructor ", tycon)
+            else
+            ( VIdMap.unionWithi (fn(vid,_,_) =>
+                  (* Syntactic restriction [Section 3.5, 2nd bullet] *)
+                  errorVId(I, "duplicate data cnstructor ", vid)) (ClosVE,VE')
+            , TyConMap.insert(TE', tycon, ((alphas,tau),ClosVE))
+            )
+        end
 
 
     (* Constructor Descriptions *)
 
     and elabConDesc(C,tau, ConDesc(I, vid, ty_opt, condesc_opt)) =
-	(* [Rule 82] *)
-	let
-	    val tau1 = case ty_opt
-			 of NONE    => tau
-			  | SOME ty =>
-			    let
-				val tau' = ElabCore.elabTy(C, ty)
-			    in
-			        Type.fromFunType(tau',tau)
-			    end
-	    val VE   = case condesc_opt
-			 of NONE         => VIdMap.empty
-			  | SOME condesc => elabConDesc(C,tau, condesc)
-	in
-	    if isSome(VIdMap.find(VE, vid)) then
-		(* Syntactic restriction [Section 3.5, 2nd bullet] *)
-		errorVId(I, "duplicate data constructor ", vid)
-	    else if not(ElabCore.validConBindVId vid) then
-		(* Syntactic restriction [Section 3.5, 5th bullet] *)
-		errorVId(I, "illegal specifiation of identifier ", vid)
-	    else
-		VIdMap.insert(VE, vid, (([],tau1),IdStatus.c))
-	end
+        (* [Rule 82] *)
+        let
+            val tau1 = case ty_opt
+                         of NONE    => tau
+                          | SOME ty =>
+                            let
+                                val tau' = ElabCore.elabTy(C, ty)
+                            in
+                                Type.fromFunType(tau',tau)
+                            end
+            val VE   = case condesc_opt
+                         of NONE         => VIdMap.empty
+                          | SOME condesc => elabConDesc(C,tau, condesc)
+        in
+            if isSome(VIdMap.find(VE, vid)) then
+                (* Syntactic restriction [Section 3.5, 2nd bullet] *)
+                errorVId(I, "duplicate data constructor ", vid)
+            else if not(ElabCore.validConBindVId vid) then
+                (* Syntactic restriction [Section 3.5, 5th bullet] *)
+                errorVId(I, "illegal specifiation of identifier ", vid)
+            else
+                VIdMap.insert(VE, vid, (([],tau1),IdStatus.c))
+        end
 
 
     (* Exception Description *)
 
     and elabExDesc(C, ExDesc(I, vid, ty_opt, exdesc_opt)) =
-	(* [Rule 83] *)
-	let
-	    val tau1 = case ty_opt
-			 of NONE    => InitialStaticEnv.tauExn
-			  | SOME ty =>
-			    let
-				val tau = ElabCore.elabTy(C, ty)
-				val  _  = if TyVarSet.isEmpty(Type.tyvars tau)
-					  then () else
-					  error(I, "free type variables \
-						   \in exception description")
-			    in
-			        Type.fromFunType(tau, InitialStaticEnv.tauExn)
-			    end
-	    val VE   = case exdesc_opt
-			 of NONE        => VIdMap.empty
-			  | SOME exdesc => elabExDesc(C, exdesc)
-	in
-	    if isSome(VIdMap.find(VE, vid)) then
-		(* Syntactic restriction [Section 3.5, 2nd bullet] *)
-		errorVId(I, "duplicate exception constructor ", vid)
-	    else if not(ElabCore.validConBindVId vid) then
-		(* Syntactic restriction [Section 3.5, 5th bullet] *)
-		errorVId(I, "illegal specification of identifier ", vid)
-	    else
-		VIdMap.insert(VE, vid, (([],tau1),IdStatus.e))
-	end
+        (* [Rule 83] *)
+        let
+            val tau1 = case ty_opt
+                         of NONE    => InitialStaticEnv.tauExn
+                          | SOME ty =>
+                            let
+                                val tau = ElabCore.elabTy(C, ty)
+                                val  _  = if TyVarSet.isEmpty(Type.tyvars tau)
+                                          then () else
+                                          error(I, "free type variables \
+                                                   \in exception description")
+                            in
+                                Type.fromFunType(tau, InitialStaticEnv.tauExn)
+                            end
+            val VE   = case exdesc_opt
+                         of NONE        => VIdMap.empty
+                          | SOME exdesc => elabExDesc(C, exdesc)
+        in
+            if isSome(VIdMap.find(VE, vid)) then
+                (* Syntactic restriction [Section 3.5, 2nd bullet] *)
+                errorVId(I, "duplicate exception constructor ", vid)
+            else if not(ElabCore.validConBindVId vid) then
+                (* Syntactic restriction [Section 3.5, 5th bullet] *)
+                errorVId(I, "illegal specification of identifier ", vid)
+            else
+                VIdMap.insert(VE, vid, (([],tau1),IdStatus.e))
+        end
 
 
     (* Structure Descriptions *)
 
     and elabStrDesc(B, StrDesc(I, strid, sigexp, strdesc_opt)) =
-	(* [Rule 84] *)
-	let
-	    val E  = elabSigExpE(B, sigexp)
-	    val SE = case strdesc_opt
-		       of NONE         => StrIdMap.empty
-		        | SOME strdesc =>
-			  elabStrDesc(B plusT StaticEnv.tynames E, strdesc)
-	in
-	    if isSome(StrIdMap.find(SE, strid)) then
-		(* Syntactic restriction [Section 3.5, 2nd bullet] *)
-		errorStrId(I, "duplicate structure identifier ", strid)
-	    else
-		StrIdMap.insert(SE, strid, StaticEnv.Str E)
-	end
+        (* [Rule 84] *)
+        let
+            val E  = elabSigExpE(B, sigexp)
+            val SE = case strdesc_opt
+                       of NONE         => StrIdMap.empty
+                        | SOME strdesc =>
+                          elabStrDesc(B plusT StaticEnv.tynames E, strdesc)
+        in
+            if isSome(StrIdMap.find(SE, strid)) then
+                (* Syntactic restriction [Section 3.5, 2nd bullet] *)
+                errorStrId(I, "duplicate structure identifier ", strid)
+            else
+                StrIdMap.insert(SE, strid, StaticEnv.Str E)
+        end
 
 
     (* Functor Declarations *)
 
     and elabFunDec(B, FunDec(I, funbind)) =
-	(* [Rule 85] *)
-	let
-	    val F = elabFunBind(B, funbind)
-	in
-	    F
-	end
+        (* [Rule 85] *)
+        let
+            val F = elabFunBind(B, funbind)
+        in
+            F
+        end
 
 
     (* Functor Bindings *)
 
     and elabFunBind(B, FunBind(I, funid, strid, sigexp, strexp, funbind_opt)) =
-	(* [Rule 86] *)
-	let
-	    val (T,E) = elabSigExp(B, sigexp)
-	    val  E'   = elabStrExp(
-			   B oplusSE StrIdMap.singleton(strid,StaticEnv.Str E),
-			   strexp)
-	    (* Side condition on T is always ensured. *)
-	    val T'    = TyNameSet.difference(StaticEnv.tynames E',
-				TyNameSet.union(StaticBasis.Tof B, T))
-	    val F     = case funbind_opt
-			  of NONE         => FunIdMap.empty
-			   | SOME funbind => elabFunBind(B, funbind)
-	in
-	    if isSome(FunIdMap.find(F, funid)) then
-		(* Syntactic restriction [Section 3.5, 1st bullet] *)
-		errorFunId(I, "duplicate functor identifier ", funid)
-	    else
-		FunIdMap.insert(F, funid, (T,(E,(T',E'))))
-	end
+        (* [Rule 86] *)
+        let
+            val (T,E) = elabSigExp(B, sigexp)
+            val  E'   = elabStrExp(
+                           B oplusSE StrIdMap.singleton(strid,StaticEnv.Str E),
+                           strexp)
+            (* Side condition on T is always ensured. *)
+            val T'    = TyNameSet.difference(StaticEnv.tynames E',
+                                TyNameSet.union(StaticBasis.Tof B, T))
+            val F     = case funbind_opt
+                          of NONE         => FunIdMap.empty
+                           | SOME funbind => elabFunBind(B, funbind)
+        in
+            if isSome(FunIdMap.find(F, funid)) then
+                (* Syntactic restriction [Section 3.5, 1st bullet] *)
+                errorFunId(I, "duplicate functor identifier ", funid)
+            else
+                FunIdMap.insert(F, funid, (T,(E,(T',E'))))
+        end
 
 
     (* Top-level Declarations *)
 
     and elabTopDec(B, STRDECTopDec(I, strdec, topdec_opt)) =
-	(* [Rule 87] *)
-	let
-	    val E   = elabStrDec(true, B, strdec)
-	    val B'  = case topdec_opt
-			of NONE        => StaticBasis.empty
-			 | SOME topdec => elabTopDec(B oplusE E, topdec)
-	    val B'' = StaticBasis.plus
-			(StaticBasis.fromTandE(StaticEnv.tynames E, E), B')
-	in
-	    if TyVarSet.isEmpty(StaticBasis.tyvars B'') then
-		B''
-	    else
-		error(I, "free type variables on top-level")
-	end
+        (* [Rule 87] *)
+        let
+            val E   = elabStrDec(true, B, strdec)
+            val B'  = case topdec_opt
+                        of NONE        => StaticBasis.empty
+                         | SOME topdec => elabTopDec(B oplusE E, topdec)
+            val B'' = StaticBasis.plus
+                        (StaticBasis.fromTandE(StaticEnv.tynames E, E), B')
+        in
+            if TyVarSet.isEmpty(StaticBasis.tyvars B'') then
+                B''
+            else
+                error(I, "free type variables on top-level")
+        end
 
       | elabTopDec(B, SIGDECTopDec(I, sigdec, topdec_opt)) =
-	(* [Rule 88] *)
-	let
-	    val G   = elabSigDec(B, sigdec)
-	    val B'  = case topdec_opt
-			of NONE        => StaticBasis.empty
-			 | SOME topdec => elabTopDec(B oplusG G, topdec)
-	    val B'' = StaticBasis.plus
-			(StaticBasis.fromTandG(StaticBasis.tynamesG G, G), B')
-	in
-	    B''
-	end
+        (* [Rule 88] *)
+        let
+            val G   = elabSigDec(B, sigdec)
+            val B'  = case topdec_opt
+                        of NONE        => StaticBasis.empty
+                         | SOME topdec => elabTopDec(B oplusG G, topdec)
+            val B'' = StaticBasis.plus
+                        (StaticBasis.fromTandG(StaticBasis.tynamesG G, G), B')
+        in
+            B''
+        end
 
       | elabTopDec(B, FUNDECTopDec(I, fundec, topdec_opt)) =
-	(* [Rule 89] *)
-	let
-	    val F   = elabFunDec(B, fundec)
-	    val B'  = case topdec_opt
-			of NONE        => StaticBasis.empty
-			 | SOME topdec => elabTopDec(B oplusF F, topdec)
-	    val B'' = StaticBasis.plus
-			(StaticBasis.fromTandF(StaticBasis.tynamesF F, F), B')
-	in
-	    if TyVarSet.isEmpty(StaticBasis.tyvars B'') then
-		B''
-	    else
-		error(I, "free type variables on top-level")
-	end
+        (* [Rule 89] *)
+        let
+            val F   = elabFunDec(B, fundec)
+            val B'  = case topdec_opt
+                        of NONE        => StaticBasis.empty
+                         | SOME topdec => elabTopDec(B oplusF F, topdec)
+            val B'' = StaticBasis.plus
+                        (StaticBasis.fromTandF(StaticBasis.tynamesF F, F), B')
+        in
+            if TyVarSet.isEmpty(StaticBasis.tyvars B'') then
+                B''
+            else
+                error(I, "free type variables on top-level")
+        end
 
 
 
     (* Build tentative TE from LHSs of datdesc *)
 
     and lhsDatDesc(DatDesc(I, tyvarseq, tycon, condesc, datdesc_opt)) =
-	(* [Rule 81, part 1] *)
-	let
-	    val (U,alphas) = ElabCore.tyvars tyvarseq
-	    val k          = List.length alphas
-	    val span       = lhsConDesc condesc
-	    val t          = TyName.tyname(tycon, k, TyName.EQ, span)
-	    val tau        = Type.fromConsType(List.map Type.fromTyVar alphas,t)
-	    val TE'        = case datdesc_opt
-			       of NONE         => TyConMap.empty
-				| SOME datdesc => lhsDatDesc datdesc
-	in
-	    if isSome(TyConMap.find(TE', tycon)) then
-		(* Syntactic restriction [Section 3.5, 2nd bullet] *)
-		errorTyCon(I, "duplicate type constructor ", tycon)
-	    else
-		TyConMap.insert(TE', tycon, ((alphas,tau), VIdMap.empty))
-	end
+        (* [Rule 81, part 1] *)
+        let
+            val (U,alphas) = ElabCore.tyvars tyvarseq
+            val k          = List.length alphas
+            val span       = lhsConDesc condesc
+            val t          = TyName.tyname(tycon, k, TyName.EQ, span)
+            val tau        = Type.fromConsType(List.map Type.fromTyVar alphas,t)
+            val TE'        = case datdesc_opt
+                               of NONE         => TyConMap.empty
+                                | SOME datdesc => lhsDatDesc datdesc
+        in
+            if isSome(TyConMap.find(TE', tycon)) then
+                (* Syntactic restriction [Section 3.5, 2nd bullet] *)
+                errorTyCon(I, "duplicate type constructor ", tycon)
+            else
+                TyConMap.insert(TE', tycon, ((alphas,tau), VIdMap.empty))
+        end
 
     and lhsConDesc(ConDesc(I, vid, ty_opt, condesc_opt)) =
-	case condesc_opt
-	  of NONE         => 1
-	   | SOME condesc => 1 + lhsConDesc condesc
+        case condesc_opt
+          of NONE         => 1
+           | SOME condesc => 1 + lhsConDesc condesc
 
   end
 (* stop of ElabModule.sml *)
@@ -11260,8 +11260,8 @@
     type Type       = Type.Type
     type TypeScheme = TypeScheme.TypeScheme
 
-    val ppType:		Type -> doc
-    val ppTypeScheme:	TypeScheme -> doc
+    val ppType:         Type -> doc
+    val ppTypeScheme:   TypeScheme -> doc
 
   end
 (* stop of PP_TYPE.sml *)
@@ -11291,13 +11291,13 @@
     fun ppTyName t    = text(TyName.toString t)
 
     fun ppOverloadingClass O =
-	let
-	    val T  = OverloadingClass.set O
-	    val t  = OverloadingClass.default O
-	    val ts = t :: TyNameSet.listItems(TyNameSet.delete(T,t))
-	in
-	    brack(ppCommaList ppTyName ts)
-	end
+        let
+            val T  = OverloadingClass.set O
+            val t  = OverloadingClass.default O
+            val ts = t :: TyNameSet.listItems(TyNameSet.delete(T,t))
+        in
+            brack(ppCommaList ppTyName ts)
+        end
 
 
     fun ppRowVar CLOSEDRow  = empty
@@ -11307,9 +11307,9 @@
     (* Types *)
 
     (* Precedence:
-     *	0 : function arrow (ty1 -> ty2)
-     *	1 : tuple (ty1 * ... * tyn)
-     *	2 : constructed type (tyseq tycon)
+     *  0 : function arrow (ty1 -> ty2)
+     *  1 : tuple (ty1 * ... * tyn)
+     *  2 : constructed type (tyseq tycon)
      *)
 
     fun ppType tau = fbox(below(nest(ppTypePrec 0 tau)))
@@ -11319,70 +11319,70 @@
     and ppType'Prec p (TyVar(alpha))   = ppTyVar alpha
 
       | ppType'Prec p (RowType(Rho,r)) =
-	let
-	    fun isTuple(   [],     n) = n > 2
-	      | isTuple(lab::labs, n) =
-		    lab = Lab.fromInt n andalso isTuple(labs, n+1)
+        let
+            fun isTuple(   [],     n) = n > 2
+              | isTuple(lab::labs, n) =
+                    lab = Lab.fromInt n andalso isTuple(labs, n+1)
 
-	    val labtaus     = LabMap.listItemsi Rho
-	    val (labs,taus) = ListPair.unzip labtaus
-	in
-	    if r = CLOSEDRow andalso List.null labs then
-		text "unit"
-	    else if r = CLOSEDRow andalso isTuple(labs, 1) then
-		let
-		    val doc = ppStarList (ppTypePrec 2) taus
-		in
-		    if p > 1 then
-			paren doc
-		    else
-			fbox(below(nest doc))
-		end
-	    else
-		brace(ppCommaList ppLabType labtaus ^^ ppRowVar r)
-	end
+            val labtaus     = LabMap.listItemsi Rho
+            val (labs,taus) = ListPair.unzip labtaus
+        in
+            if r = CLOSEDRow andalso List.null labs then
+                text "unit"
+            else if r = CLOSEDRow andalso isTuple(labs, 1) then
+                let
+                    val doc = ppStarList (ppTypePrec 2) taus
+                in
+                    if p > 1 then
+                        paren doc
+                    else
+                        fbox(below(nest doc))
+                end
+            else
+                brace(ppCommaList ppLabType labtaus ^^ ppRowVar r)
+        end
 
       | ppType'Prec p (FunType(tau1,tau2)) =
-	let
-	    val doc = ppTypePrec 1 tau1 ^/^
-		      text "->" ^/^
-		      ppTypePrec 0 tau2
-	in
-	    if p > 0 then
-		paren doc
-	    else
-		doc
-	end
+        let
+            val doc = ppTypePrec 1 tau1 ^/^
+                      text "->" ^/^
+                      ppTypePrec 0 tau2
+        in
+            if p > 0 then
+                paren doc
+            else
+                doc
+        end
 
       | ppType'Prec p (ConsType(taus,t)) =
-	    fbox(nest(ppSeqPrec ppTypePrec 2 taus ^/^ ppTyName t))
+            fbox(nest(ppSeqPrec ppTypePrec 2 taus ^/^ ppTyName t))
 
       | ppType'Prec p (Overloaded(O)) =
-	    text "'" ^^ ppOverloadingClass O
+            text "'" ^^ ppOverloadingClass O
 
       | ppType'Prec p (Link tau) =
-	    ppTypePrec p tau
+            ppTypePrec p tau
 
     and ppLabType(lab, tau) =
-	    abox(
-		hbox(
-		    ppLab lab ^/^
-		    text ":"
-		) ^^
-		below(nest(break ^^
-		    ppType tau
-		))
-	    )
+            abox(
+                hbox(
+                    ppLab lab ^/^
+                    text ":"
+                ) ^^
+                below(nest(break ^^
+                    ppType tau
+                ))
+            )
 
 
     (* Type schemes *)
 
     fun ppTypeScheme sigma =
-	let
-	    val (alphas,tau) = TypeScheme.normalise sigma
-	in
-	    ppType tau
-	end
+        let
+            val (alphas,tau) = TypeScheme.normalise sigma
+        in
+            ppType tau
+        end
 
   end
 (* stop of PPType.sml *)
@@ -11442,168 +11442,168 @@
     (* Environments *)
 
     fun ppConTypeScheme (_, ref(Type.FunType(tau,_))) =
-	    text "of" ^^ break ^^ PPType.ppType tau
+            text "of" ^^ break ^^ PPType.ppType tau
 
       | ppConTypeScheme _ = empty
 
 
     fun ppValEnv VE =
-	VIdMap.foldri
-	    (fn(vid, (sigma,IdStatus.v), doc) =>
-		abox(
-		    hbox(
-			text "val" ^/^
-			ppVId vid ^/^
-			text ":"
-		    ) ^^
-		    nest(break ^^
-			abox(PPType.ppTypeScheme sigma)
-		    )
-		) ^/^
-		doc
+        VIdMap.foldri
+            (fn(vid, (sigma,IdStatus.v), doc) =>
+                abox(
+                    hbox(
+                        text "val" ^/^
+                        ppVId vid ^/^
+                        text ":"
+                    ) ^^
+                    nest(break ^^
+                        abox(PPType.ppTypeScheme sigma)
+                    )
+                ) ^/^
+                doc
 
-	     | (vid, (sigma,_), doc) => doc
-	    )
-	    empty VE
+             | (vid, (sigma,_), doc) => doc
+            )
+            empty VE
 
     fun ppExEnv VE =
-	VIdMap.foldri
-	    (fn(vid, (sigma,IdStatus.e), doc) =>
-		abox(
-		    hbox(
-			text "exception" ^/^
-			ppVId vid
-		    ) ^^
-		    nest(break ^^
-			abox(ppConTypeScheme sigma)
-		    )
-		) ^/^
-		doc
+        VIdMap.foldri
+            (fn(vid, (sigma,IdStatus.e), doc) =>
+                abox(
+                    hbox(
+                        text "exception" ^/^
+                        ppVId vid
+                    ) ^^
+                    nest(break ^^
+                        abox(ppConTypeScheme sigma)
+                    )
+                ) ^/^
+                doc
 
-	     | (vid, (sigma,_), doc) => doc
-	    )
-	    empty VE
+             | (vid, (sigma,_), doc) => doc
+            )
+            empty VE
 
     fun ppConEnv VE =
-	VIdMap.foldli
-	    (fn(vid, (sigma,_), doc) =>
-		doc ^/^
-		abox(
-		    hbox(
-			(if isEmpty doc then empty else text "|") ^/^
-			ppVId vid
-		    ) ^^
-		    nest(text "" ^/^
-			abox(ppConTypeScheme sigma)
-		    )
-		)
-	    )
-	    empty VE
+        VIdMap.foldli
+            (fn(vid, (sigma,_), doc) =>
+                doc ^/^
+                abox(
+                    hbox(
+                        (if isEmpty doc then empty else text "|") ^/^
+                        ppVId vid
+                    ) ^^
+                    nest(text "" ^/^
+                        abox(ppConTypeScheme sigma)
+                    )
+                )
+            )
+            empty VE
 
 
     fun absTy(T, tycon, theta) =
-	case TypeFcn.toTyName theta
-	  of NONE    => NONE
-	   | SOME t  => if TyName.tycon t = tycon
-			andalso TyNameSet.member(T, t) then
-			    SOME(TyName.equality t <> TyName.NOEQ)
-			else
-			    NONE
+        case TypeFcn.toTyName theta
+          of NONE    => NONE
+           | SOME t  => if TyName.tycon t = tycon
+                        andalso TyNameSet.member(T, t) then
+                            SOME(TyName.equality t <> TyName.NOEQ)
+                        else
+                            NONE
 
     fun ppAbsTyEnv(T,TE) =
-	TyConMap.foldri
-	    (fn(tycon, (theta as (alphas,tau), VE), doc) =>
-		if VIdMap.isEmpty VE then
-		case absTy(T, tycon, theta)
-		 of NONE    => doc
-		  | SOME eq =>
-		    abox(
-			hbox(
-			    text(if eq then "eqtype" else "type") ^/^
-			    ppSeq ppTyVar alphas ^/^
-			    ppTyCon tycon
-			)
-		    ) ^/^
-		    doc
-		else
-		    doc
-	    )
-	    empty TE
+        TyConMap.foldri
+            (fn(tycon, (theta as (alphas,tau), VE), doc) =>
+                if VIdMap.isEmpty VE then
+                case absTy(T, tycon, theta)
+                 of NONE    => doc
+                  | SOME eq =>
+                    abox(
+                        hbox(
+                            text(if eq then "eqtype" else "type") ^/^
+                            ppSeq ppTyVar alphas ^/^
+                            ppTyCon tycon
+                        )
+                    ) ^/^
+                    doc
+                else
+                    doc
+            )
+            empty TE
 
     fun ppSynTyEnv(T,TE) =
-	TyConMap.foldri
-	    (fn(tycon, (theta as (alphas,tau), VE), doc) =>
-		if VIdMap.isEmpty VE
-		andalso not(isSome(absTy(T, tycon, theta))) then
-		    abox(
-			hbox(
-			    text "type" ^/^
-			    ppSeq ppTyVar alphas ^/^
-			    ppTyCon tycon ^/^
-			    text "="
-			) ^^
-			nest(break ^^
-			    abox(PPType.ppType tau)
-			)
-		    ) ^/^
-		    doc
-		else
-		    doc
-	    )
-	    empty TE
+        TyConMap.foldri
+            (fn(tycon, (theta as (alphas,tau), VE), doc) =>
+                if VIdMap.isEmpty VE
+                andalso not(isSome(absTy(T, tycon, theta))) then
+                    abox(
+                        hbox(
+                            text "type" ^/^
+                            ppSeq ppTyVar alphas ^/^
+                            ppTyCon tycon ^/^
+                            text "="
+                        ) ^^
+                        nest(break ^^
+                            abox(PPType.ppType tau)
+                        )
+                    ) ^/^
+                    doc
+                else
+                    doc
+            )
+            empty TE
 
     fun ppDataTyEnv TE =
-	TyConMap.foldri
-	    (fn(tycon, ((alphas,tau),VE), doc) =>
-		if VIdMap.isEmpty VE then
-		    doc
-		else
-		    abox(
-		        hbox(
-			    text "datatype" ^/^
-			    ppSeq ppTyVar alphas ^/^
-			    ppTyCon tycon ^/^
-			    text "="
-			) ^^
-			nest(break ^^
-			    abox(ppConEnv VE)
-			)
-		    ) ^/^
-		    doc
-	    )
-	    empty TE
+        TyConMap.foldri
+            (fn(tycon, ((alphas,tau),VE), doc) =>
+                if VIdMap.isEmpty VE then
+                    doc
+                else
+                    abox(
+                        hbox(
+                            text "datatype" ^/^
+                            ppSeq ppTyVar alphas ^/^
+                            ppTyCon tycon ^/^
+                            text "="
+                        ) ^^
+                        nest(break ^^
+                            abox(ppConEnv VE)
+                        )
+                    ) ^/^
+                    doc
+            )
+            empty TE
 
     fun ppTyEnv(T,TE) =
-	    vbox(
-		ppAbsTyEnv(T,TE) ^/^
-		ppSynTyEnv(T,TE) ^/^
-		ppDataTyEnv TE
-	    )
+            vbox(
+                ppAbsTyEnv(T,TE) ^/^
+                ppSynTyEnv(T,TE) ^/^
+                ppDataTyEnv TE
+            )
 
     fun ppStrEnv(T,SE) =
-	StrIdMap.foldri
-	    (fn(strid, StaticEnv.Str E, doc) =>
-		abox(
-		    hbox(
-			text "structure" ^/^
-			ppStrId strid ^/^
-			text ":"
-		    ) ^^
-		    nest(break ^^
-			ppSig (T,E)
-		    )
-		) ^/^
-		doc
-	    )
-	    empty SE
+        StrIdMap.foldri
+            (fn(strid, StaticEnv.Str E, doc) =>
+                abox(
+                    hbox(
+                        text "structure" ^/^
+                        ppStrId strid ^/^
+                        text ":"
+                    ) ^^
+                    nest(break ^^
+                        ppSig (T,E)
+                    )
+                ) ^/^
+                doc
+            )
+            empty SE
 
     and ppEnv'(T,(SE,TE,VE)) =
-	    vbox(
-		ppStrEnv(T,SE) ^/^
-		ppTyEnv(T,TE) ^/^
-		ppExEnv VE ^/^
-		ppValEnv VE
-	    )
+            vbox(
+                ppStrEnv(T,SE) ^/^
+                ppTyEnv(T,TE) ^/^
+                ppExEnv VE ^/^
+                ppValEnv VE
+            )
 
     and ppEnv E = ppEnv'(TyNameSet.empty,E)
 
@@ -11611,20 +11611,20 @@
     (* Signatures *)
 
     and ppSig (T,E) =
-	let
-	    val doc = ppEnv'(T, E)
-	in
-	    abox(below(
-		text "sig" ^^
-		brace(ppCommaList ppTyName (TyNameSet.listItems T)) ^^
-		(if isEmpty doc then
-		    empty
-		 else
-		    nest(vbox(break ^^ doc))
-		) ^^ break ^^
-		text "end"
-	    ))
-	end
+        let
+            val doc = ppEnv'(T, E)
+        in
+            abox(below(
+                text "sig" ^^
+                brace(ppCommaList ppTyName (TyNameSet.listItems T)) ^^
+                (if isEmpty doc then
+                    empty
+                 else
+                    nest(vbox(break ^^ doc))
+                ) ^^ break ^^
+                text "end"
+            ))
+        end
 
   end
 (* stop of PPStaticEnv.sml *)
@@ -11676,62 +11676,62 @@
     (* Environments *)
 
     fun ppSigEnv G =
-	SigIdMap.foldri
-	    (fn(sigid, Sigma, doc) =>
-		abox(
-		    hbox(
-			text "signature" ^/^
-			ppSigId sigid ^/^
-			text "="
-		    ) ^^
-		    nest(break ^^
-			PPStaticEnv.ppSig Sigma
-		    )
-		) ^/^
-		doc
-	    )
-	    empty G
+        SigIdMap.foldri
+            (fn(sigid, Sigma, doc) =>
+                abox(
+                    hbox(
+                        text "signature" ^/^
+                        ppSigId sigid ^/^
+                        text "="
+                    ) ^^
+                    nest(break ^^
+                        PPStaticEnv.ppSig Sigma
+                    )
+                ) ^/^
+                doc
+            )
+            empty G
 
     fun ppFunEnv F =
-	FunIdMap.foldri
-	    (fn(funid, (T,(E,Sigma)), doc) =>
-		abox(
-		    hbox(
-			text "functor" ^/^
-			ppFunId funid
-		    ) ^^
-		    nest(ebreak ^^
-			abox(
-			    hbox(
-				text "(" ^^
-				text "Arg" ^/^
-				text ":"
-			    ) ^^
-			    nest(break ^^
-				PPStaticEnv.ppSig(T,E)
-			    ) ^^ ebreak ^^
-			    hbox(
-				text ")" ^/^
-				text ":"
-			    )
-			) ^/^
-			PPStaticEnv.ppSig Sigma
-		    )
-		) ^/^
-		doc
-	    )
-	    empty F
+        FunIdMap.foldri
+            (fn(funid, (T,(E,Sigma)), doc) =>
+                abox(
+                    hbox(
+                        text "functor" ^/^
+                        ppFunId funid
+                    ) ^^
+                    nest(ebreak ^^
+                        abox(
+                            hbox(
+                                text "(" ^^
+                                text "Arg" ^/^
+                                text ":"
+                            ) ^^
+                            nest(break ^^
+                                PPStaticEnv.ppSig(T,E)
+                            ) ^^ ebreak ^^
+                            hbox(
+                                text ")" ^/^
+                                text ":"
+                            )
+                        ) ^/^
+                        PPStaticEnv.ppSig Sigma
+                    )
+                ) ^/^
+                doc
+            )
+            empty F
 
 
     (* Basis *)
 
     fun ppBasis (T,F,G,E) =
-	    vbox(
-		ppSigEnv G ^/^
-		ppFunEnv F ^/^
-		PPStaticEnv.ppEnv E ^/^
-		text ""
-	    )
+            vbox(
+                ppSigEnv G ^/^
+                ppFunEnv F ^/^
+                PPStaticEnv.ppEnv E ^/^
+                text ""
+            )
 
   end
 (* stop of PPStaticBasis.sml *)
@@ -11779,58 +11779,58 @@
     (* Environments *)
 
     fun ppValEnv(s, (VE_STAT,VE_DYN)) =
-	VIdMap.foldri
-	    (fn(vid, (sigma,IdStatus.v), doc) =>
-	     let
-		val (v,is) = valOf(VIdMap.find(VE_DYN, vid))
-	     in
-		fbox(
-		    hbox(
-			text "val" ^/^
-			ppVId vid
-		    ) ^^
-		    nest(break ^^
-			text "=" ^/^
-			below(abox(PPVal.ppVal(s, v))) ^/^
-			text ":" ^/^
-			below(abox(PPType.ppTypeScheme sigma))
-		    )
-		) ^/^
-		doc
-	     end
+        VIdMap.foldri
+            (fn(vid, (sigma,IdStatus.v), doc) =>
+             let
+                val (v,is) = valOf(VIdMap.find(VE_DYN, vid))
+             in
+                fbox(
+                    hbox(
+                        text "val" ^/^
+                        ppVId vid
+                    ) ^^
+                    nest(break ^^
+                        text "=" ^/^
+                        below(abox(PPVal.ppVal(s, v))) ^/^
+                        text ":" ^/^
+                        below(abox(PPType.ppTypeScheme sigma))
+                    )
+                ) ^/^
+                doc
+             end
 
-	     | (vid, (sigma,_), doc) => doc
-	    )
-	    empty VE_STAT
+             | (vid, (sigma,_), doc) => doc
+            )
+            empty VE_STAT
 
     fun ppStrEnv(s, T, (SE_STAT,SE_DYN)) =
-	StrIdMap.foldri
-	    (fn(strid, StaticEnv.Str E_STAT, doc) =>
-	     let
-		val DynamicEnv.Str E_DYN = valOf(StrIdMap.find(SE_DYN, strid))
-	     in
-		abox(
-		    hbox(
-			text "structure" ^/^
-			ppStrId strid ^/^
-			text "="
-		    ) ^^
-		    nest(break ^^
-			ppStr (s, T, (E_STAT,E_DYN))
-		    )
-		) ^/^
-		doc
-	     end
-	    )
-	    empty SE_STAT
+        StrIdMap.foldri
+            (fn(strid, StaticEnv.Str E_STAT, doc) =>
+             let
+                val DynamicEnv.Str E_DYN = valOf(StrIdMap.find(SE_DYN, strid))
+             in
+                abox(
+                    hbox(
+                        text "structure" ^/^
+                        ppStrId strid ^/^
+                        text "="
+                    ) ^^
+                    nest(break ^^
+                        ppStr (s, T, (E_STAT,E_DYN))
+                    )
+                ) ^/^
+                doc
+             end
+            )
+            empty SE_STAT
 
     and ppEnv'(s, T, ((SE_STAT,TE_STAT,VE_STAT), (SE_DYN, TE_DYN, VE_DYN))) =
-	    vbox(
-		ppStrEnv(s, T, (SE_STAT,SE_DYN)) ^/^
-		PPStaticEnv.ppTyEnv(T,TE_STAT) ^/^
-		PPStaticEnv.ppExEnv VE_STAT ^/^
-		ppValEnv(s, (VE_STAT,VE_DYN))
-	    )
+            vbox(
+                ppStrEnv(s, T, (SE_STAT,SE_DYN)) ^/^
+                PPStaticEnv.ppTyEnv(T,TE_STAT) ^/^
+                PPStaticEnv.ppExEnv VE_STAT ^/^
+                ppValEnv(s, (VE_STAT,VE_DYN))
+            )
 
     and ppEnv(s, E) = ppEnv'(s, TyNameSet.empty, E)
 
@@ -11838,19 +11838,19 @@
     (* Structures *)
 
     and ppStr(s, T, E) =
-	let
-	    val doc = ppEnv'(s, T, E)
-	in
-	    abox(below(
-		text "struct" ^^
-		(if isEmpty doc then
-		    empty
-		 else
-		    nest(vbox(break ^^ doc))
-		) ^^ break ^^
-		text "end"
-	    ))
-	end
+        let
+            val doc = ppEnv'(s, T, E)
+        in
+            abox(below(
+                text "struct" ^^
+                (if isEmpty doc then
+                    empty
+                 else
+                    nest(vbox(break ^^ doc))
+                ) ^^ break ^^
+                text "end"
+            ))
+        end
 
   end
 (* stop of PPEnv.sml *)
@@ -11891,12 +11891,12 @@
     (* Basis *)
 
     fun ppBasis (s, ((T,F_STAT,G_STAT,E_STAT), (F_DYN,G_DYN,E_DYN))) =
-	    vbox(
-		PPStaticBasis.ppSigEnv G_STAT ^/^
-		PPStaticBasis.ppFunEnv F_STAT ^/^
-		PPEnv.ppEnv(s, (E_STAT,E_DYN)) ^/^
-		text ""
-	    )
+            vbox(
+                PPStaticBasis.ppSigEnv G_STAT ^/^
+                PPStaticBasis.ppFunEnv F_STAT ^/^
+                PPEnv.ppEnv(s, (E_STAT,E_DYN)) ^/^
+                text ""
+            )
 
   end
 (* stop of PPBasis.sml *)
@@ -11927,9 +11927,9 @@
 
     (* Export *)
 
-    val execProgram:	State ref * Basis * Program -> Basis
-    val elabProgram:	StaticBasis * Program -> StaticBasis
-    val evalProgram:	State ref * DynamicBasis * Program -> DynamicBasis
+    val execProgram:    State ref * Basis * Program -> Basis
+    val elabProgram:    StaticBasis * Program -> StaticBasis
+    val evalProgram:    State ref * DynamicBasis * Program -> DynamicBasis
 
   end
 (* stop of PROGRAM.sml *)
@@ -11965,28 +11965,28 @@
     val width = 79
 
     fun printException(s, e) =
-	( TextIO.output(TextIO.stdOut, "Uncaught exception: ")
-	; PrettyPrint.output(TextIO.stdOut, PPVal.ppExVal(s, e), width)
-	; TextIO.output1(TextIO.stdOut, #"\n")
-	; TextIO.flushOut TextIO.stdOut
-	)
+        ( TextIO.output(TextIO.stdOut, "Uncaught exception: ")
+        ; PrettyPrint.output(TextIO.stdOut, PPVal.ppExVal(s, e), width)
+        ; TextIO.output1(TextIO.stdOut, #"\n")
+        ; TextIO.flushOut TextIO.stdOut
+        )
 
     fun printStaticBasis B_STAT =
-	( PrettyPrint.output(TextIO.stdOut, PPStaticBasis.ppBasis B_STAT,
-			     width)
-	; TextIO.flushOut TextIO.stdOut
-	)
+        ( PrettyPrint.output(TextIO.stdOut, PPStaticBasis.ppBasis B_STAT,
+                             width)
+        ; TextIO.flushOut TextIO.stdOut
+        )
 
     fun printDynamicBasis(s, B_DYN) =
-	( PrettyPrint.output(TextIO.stdOut, PPDynamicBasis.ppBasis(s, B_DYN),
-			     width)
-	; TextIO.flushOut TextIO.stdOut
-	)
+        ( PrettyPrint.output(TextIO.stdOut, PPDynamicBasis.ppBasis(s, B_DYN),
+                             width)
+        ; TextIO.flushOut TextIO.stdOut
+        )
 
     fun printBasis(s, B) =
-	( PrettyPrint.output(TextIO.stdOut, PPBasis.ppBasis(s, B), width)
-	; TextIO.flushOut TextIO.stdOut
-	)
+        ( PrettyPrint.output(TextIO.stdOut, PPBasis.ppBasis(s, B), width)
+        ; TextIO.flushOut TextIO.stdOut
+        )
 
 
     (* Helpers for basis modification *)
@@ -11999,92 +11999,92 @@
     (* Inference rules [Section 8] *)
 
     fun execProgram(s,B, Program(I, topdec, program_opt)) =
-	(* [Rules 187 to 189] *)
-	let
-	    val B_STAT1 = ElabModule.elabTopDec(Basis.B_STATof B, topdec)
-	    val B_DYN1  = EvalModule.evalTopDec(s,Basis.B_DYNof B, topdec)
-	    (* [Rule 189] *)
-	    val _   = printBasis(!s, (B_STAT1,B_DYN1))
-	    val B'  = B oplus (B_STAT1,B_DYN1)
-	    val B'' = case program_opt
-			of NONE         => B'
-			 | SOME program => execProgram(s,B', program)
-	in
-	    B''
-	end
-	handle Error.Error m =>
-	       (* [Rule 187] *)
-	       let
-		   val B' = case program_opt
-			      of NONE         => B
-			       | SOME program => execProgram(s,B, program)
-	       in
-		   B'
-	       end
+        (* [Rules 187 to 189] *)
+        let
+            val B_STAT1 = ElabModule.elabTopDec(Basis.B_STATof B, topdec)
+            val B_DYN1  = EvalModule.evalTopDec(s,Basis.B_DYNof B, topdec)
+            (* [Rule 189] *)
+            val _   = printBasis(!s, (B_STAT1,B_DYN1))
+            val B'  = B oplus (B_STAT1,B_DYN1)
+            val B'' = case program_opt
+                        of NONE         => B'
+                         | SOME program => execProgram(s,B', program)
+        in
+            B''
+        end
+        handle Error.Error m =>
+               (* [Rule 187] *)
+               let
+                   val B' = case program_opt
+                              of NONE         => B
+                               | SOME program => execProgram(s,B, program)
+               in
+                   B'
+               end
 
-	     | Pack.Pack e =>
-	       (* [Rule 188] *)
-	       let
-		   val _  = printException(!s, e)
-		   val B' = case program_opt
-			      of NONE         => B
-			       | SOME program => execProgram(s,B, program)
-	       in
-		   B'
-	       end
+             | Pack.Pack e =>
+               (* [Rule 188] *)
+               let
+                   val _  = printException(!s, e)
+                   val B' = case program_opt
+                              of NONE         => B
+                               | SOME program => execProgram(s,B, program)
+               in
+                   B'
+               end
 
 
     (* Elaboration only *)
 
     fun elabProgram(B_STAT, Program(I, topdec, program_opt)) =
-	let
-	    val B_STAT1  = ElabModule.elabTopDec(B_STAT, topdec)
-	    val  _       = printStaticBasis B_STAT1
-	    val B_STAT'  = StaticBasis.plus(B_STAT, B_STAT1)
-	    val B_STAT'' = case program_opt
-			     of NONE         => B_STAT'
-			      | SOME program => elabProgram(B_STAT', program)
-	in
-	    B_STAT''
-	end
-	handle Error.Error m =>
-	       B_STAT
+        let
+            val B_STAT1  = ElabModule.elabTopDec(B_STAT, topdec)
+            val  _       = printStaticBasis B_STAT1
+            val B_STAT'  = StaticBasis.plus(B_STAT, B_STAT1)
+            val B_STAT'' = case program_opt
+                             of NONE         => B_STAT'
+                              | SOME program => elabProgram(B_STAT', program)
+        in
+            B_STAT''
+        end
+        handle Error.Error m =>
+               B_STAT
 
 
     (* Evaluation only *)
 
     fun evalProgram(s,B_DYN, Program(I, topdec, program_opt)) =
-	let
-	    val B_DYN1  = EvalModule.evalTopDec(s,B_DYN, topdec)
-	    val  _      = printDynamicBasis(!s, B_DYN1)
-	    val B_DYN'  = DynamicBasis.plus(B_DYN, B_DYN1)
-	    val B_DYN'' = case program_opt
-			    of NONE         => B_DYN'
-			     | SOME program => evalProgram(s,B_DYN', program)
-	in
-	    B_DYN''
-	end
-	handle Error.Error m =>
-	       (* Runtime error *)
-	       let
-		   val B_DYN' = case program_opt
-				  of NONE         => B_DYN
-				   | SOME program =>
-					evalProgram(s,B_DYN, program)
-	       in
-		   B_DYN'
-	       end
+        let
+            val B_DYN1  = EvalModule.evalTopDec(s,B_DYN, topdec)
+            val  _      = printDynamicBasis(!s, B_DYN1)
+            val B_DYN'  = DynamicBasis.plus(B_DYN, B_DYN1)
+            val B_DYN'' = case program_opt
+                            of NONE         => B_DYN'
+                             | SOME program => evalProgram(s,B_DYN', program)
+        in
+            B_DYN''
+        end
+        handle Error.Error m =>
+               (* Runtime error *)
+               let
+                   val B_DYN' = case program_opt
+                                  of NONE         => B_DYN
+                                   | SOME program =>
+                                        evalProgram(s,B_DYN, program)
+               in
+                   B_DYN'
+               end
 
-	     | Pack.Pack e =>
-	       let
-		   val  _     = printException(!s, e)
-		   val B_DYN' = case program_opt
-				  of NONE         => B_DYN
-				   | SOME program =>
-					evalProgram(s,B_DYN, program)
-	       in
-		   B_DYN'
-	       end
+             | Pack.Pack e =>
+               let
+                   val  _     = printException(!s, e)
+                   val B_DYN' = case program_opt
+                                  of NONE         => B_DYN
+                                   | SOME program =>
+                                        evalProgram(s,B_DYN, program)
+               in
+                   B_DYN'
+               end
 
   end
 (* stop of Program.sml *)
@@ -12114,29 +12114,29 @@
 signature LR_TABLE =
     sig
         datatype ('a,'b) pairlist = EMPTY | PAIR of 'a * 'b * ('a,'b) pairlist
-	datatype state = STATE of int
-	datatype term = T of int
-	datatype nonterm = NT of int
-	datatype action = SHIFT of state
-			| REDUCE of int
-			| ACCEPT
-			| ERROR
-	type table
-	
-	val numStates : table -> int
-	val numRules : table -> int
-	val describeActions : table -> state ->
-				(term,action) pairlist * action
-	val describeGoto : table -> state -> (nonterm,state) pairlist
-	val action : table -> state * term -> action
-	val goto : table -> state * nonterm -> state
-	val initialState : table -> state
-	exception Goto of state * nonterm
+        datatype state = STATE of int
+        datatype term = T of int
+        datatype nonterm = NT of int
+        datatype action = SHIFT of state
+                        | REDUCE of int
+                        | ACCEPT
+                        | ERROR
+        type table
+        
+        val numStates : table -> int
+        val numRules : table -> int
+        val describeActions : table -> state ->
+                                (term,action) pairlist * action
+        val describeGoto : table -> state -> (nonterm,state) pairlist
+        val action : table -> state * term -> action
+        val goto : table -> state * nonterm -> state
+        val initialState : table -> state
+        exception Goto of state * nonterm
 
-	val mkLrTable : {actions : ((term,action) pairlist * action) array,
-			 gotos : (nonterm,state) pairlist array,
-			 numStates : int, numRules : int,
-			 initialState : state} -> table
+        val mkLrTable : {actions : ((term,action) pairlist * action) array,
+                         gotos : (nonterm,state) pairlist array,
+                         numStates : int, numRules : int,
+                         initialState : state} -> table
     end
 
 (* TOKEN: signature revealing the internal structure of a token. This signature
@@ -12153,14 +12153,14 @@
    type 'a token which functions to construct tokens would create.  A
    constructor function for a integer token might be
 
-	  INT: int * 'a * 'a -> 'a token.
+          INT: int * 'a * 'a -> 'a token.
  
    This is not possible because we need to have tokens with the representation
    given below for the polymorphic parser.
 
    Thus our constructur functions for tokens have the form:
 
-	  INT: int * 'a * 'a -> (svalue,'a) token
+          INT: int * 'a * 'a -> (svalue,'a) token
 
    This in turn has had an impact on the signature that lexers for SML-Yacc
    must match and the types that a user must declare in the user declarations
@@ -12169,46 +12169,46 @@
 
 signature TOKEN =
     sig
-	structure LrTable : LR_TABLE
+        structure LrTable : LR_TABLE
         datatype ('a,'b) token = TOKEN of LrTable.term * ('a * 'b * 'b)
-	val sameToken : ('a,'b) token * ('a,'b) token -> bool
+        val sameToken : ('a,'b) token * ('a,'b) token -> bool
     end
 
 (* LR_PARSER: signature for a polymorphic LR parser *)
 
 signature LR_PARSER =
     sig
-	structure Stream: STREAM
-	structure LrTable : LR_TABLE
-	structure Token : TOKEN
+        structure Stream: STREAM
+        structure LrTable : LR_TABLE
+        structure Token : TOKEN
 
-	sharing LrTable = Token.LrTable
+        sharing LrTable = Token.LrTable
 
-	exception ParseError
+        exception ParseError
 
-	val parse : {table : LrTable.table,
-		     lexer : ('_b,'_c) Token.token Stream.stream,
-		     arg: 'arg,
-		     saction : int *
-			       '_c *
-				(LrTable.state * ('_b * '_c * '_c)) list * 
-				'arg ->
-				     LrTable.nonterm *
-				     ('_b * '_c * '_c) *
-				     ((LrTable.state *('_b * '_c * '_c)) list),
-		     void : '_b,
-		     ec : { is_keyword : LrTable.term -> bool,
-			    noShift : LrTable.term -> bool,
-			    preferred_change : (LrTable.term list * LrTable.term list) list,
-			    errtermvalue : LrTable.term -> '_b,
-			    showTerminal : LrTable.term -> string,
-			    terms: LrTable.term list,
-			    error : string * '_c * '_c -> unit
-			   },
-		     lookahead : int  (* max amount of lookahead used in *)
-				      (* error correction *)
-			} -> '_b *
-			     (('_b,'_c) Token.token Stream.stream)
+        val parse : {table : LrTable.table,
+                     lexer : ('_b,'_c) Token.token Stream.stream,
+                     arg: 'arg,
+                     saction : int *
+                               '_c *
+                                (LrTable.state * ('_b * '_c * '_c)) list * 
+                                'arg ->
+                                     LrTable.nonterm *
+                                     ('_b * '_c * '_c) *
+                                     ((LrTable.state *('_b * '_c * '_c)) list),
+                     void : '_b,
+                     ec : { is_keyword : LrTable.term -> bool,
+                            noShift : LrTable.term -> bool,
+                            preferred_change : (LrTable.term list * LrTable.term list) list,
+                            errtermvalue : LrTable.term -> '_b,
+                            showTerminal : LrTable.term -> string,
+                            terms: LrTable.term list,
+                            error : string * '_c * '_c -> unit
+                           },
+                     lookahead : int  (* max amount of lookahead used in *)
+                                      (* error correction *)
+                        } -> '_b *
+                             (('_b,'_c) Token.token Stream.stream)
     end
 
 (* LEXER: a signature that most lexers produced for use with SML-Yacc's
@@ -12225,12 +12225,12 @@
 signature LEXER =
    sig
        structure UserDeclarations :
-	   sig
-	        type ('a,'b) token
-		type pos
-		type svalue
-	   end
-	val makeLexer : (int -> string) -> unit -> 
+           sig
+                type ('a,'b) token
+                type pos
+                type svalue
+           end
+        val makeLexer : (int -> string) -> unit -> 
          (UserDeclarations.svalue,UserDeclarations.pos) UserDeclarations.token
    end
 
@@ -12241,13 +12241,13 @@
 signature ARG_LEXER =
    sig
        structure UserDeclarations :
-	   sig
-	        type ('a,'b) token
-		type pos
-		type svalue
-		type arg
-	   end
-	val makeLexer : (int -> string) -> UserDeclarations.arg -> unit -> 
+           sig
+                type ('a,'b) token
+                type pos
+                type svalue
+                type arg
+           end
+        val makeLexer : (int -> string) -> UserDeclarations.arg -> unit -> 
          (UserDeclarations.svalue,UserDeclarations.pos) UserDeclarations.token
    end
 
@@ -12264,57 +12264,57 @@
    sig
         (* the type of line numbers *)
 
-	type pos
+        type pos
 
-	(* the type of semantic values *)
+        (* the type of semantic values *)
 
-	type svalue
+        type svalue
 
          (* the type of the user-supplied argument to the parser *)
- 	type arg
+        type arg
  
-	(* the intended type of the result of the parser.  This value is
-	   produced by applying extract from the structure Actions to the
-	   final semantic value resultiing from a parse.
-	 *)
+        (* the intended type of the result of the parser.  This value is
+           produced by applying extract from the structure Actions to the
+           final semantic value resultiing from a parse.
+         *)
 
-	type result
+        type result
 
-	structure LrTable : LR_TABLE
-	structure Token : TOKEN
-	sharing Token.LrTable = LrTable
+        structure LrTable : LR_TABLE
+        structure Token : TOKEN
+        sharing Token.LrTable = LrTable
 
-	(* structure Actions contains the functions which mantain the
-	   semantic values stack in the parser.  Void is used to provide
-	   a default value for the semantic stack.
-	 *)
+        (* structure Actions contains the functions which mantain the
+           semantic values stack in the parser.  Void is used to provide
+           a default value for the semantic stack.
+         *)
 
-	structure Actions : 
-	  sig
-	      val actions : int * pos *
-		   (LrTable.state * (svalue * pos * pos)) list * arg->
-		         LrTable.nonterm * (svalue * pos * pos) *
-			 ((LrTable.state *(svalue * pos * pos)) list)
-	      val void : svalue
-	      val extract : svalue -> result
-	  end
+        structure Actions : 
+          sig
+              val actions : int * pos *
+                   (LrTable.state * (svalue * pos * pos)) list * arg->
+                         LrTable.nonterm * (svalue * pos * pos) *
+                         ((LrTable.state *(svalue * pos * pos)) list)
+              val void : svalue
+              val extract : svalue -> result
+          end
 
-	(* structure EC contains information used to improve error
-	   recovery in an error-correcting parser *)
+        (* structure EC contains information used to improve error
+           recovery in an error-correcting parser *)
 
-	structure EC :
-	   sig
-	     val is_keyword : LrTable.term -> bool
-	     val noShift : LrTable.term -> bool
- 	     val preferred_change : (LrTable.term list * LrTable.term list) list
-	     val errtermvalue : LrTable.term -> svalue
-	     val showTerminal : LrTable.term -> string
-	     val terms: LrTable.term list
-	   end
+        structure EC :
+           sig
+             val is_keyword : LrTable.term -> bool
+             val noShift : LrTable.term -> bool
+             val preferred_change : (LrTable.term list * LrTable.term list) list
+             val errtermvalue : LrTable.term -> svalue
+             val showTerminal : LrTable.term -> string
+             val terms: LrTable.term list
+           end
 
-	(* table is the LR table for the parser *)
+        (* table is the LR table for the parser *)
 
-	val table : LrTable.table
+        val table : LrTable.table
     end
 
 (* signature PARSER is the signature that most user parsers created by 
@@ -12324,42 +12324,42 @@
 signature PARSER =
     sig
         structure Token : TOKEN
-	structure Stream : STREAM
-	exception ParseError
+        structure Stream : STREAM
+        exception ParseError
 
-	(* type pos is the type of line numbers *)
+        (* type pos is the type of line numbers *)
 
-	type pos
+        type pos
 
-	(* type result is the type of the result from the parser *)
+        (* type result is the type of the result from the parser *)
 
-	type result
+        type result
 
          (* the type of the user-supplied argument to the parser *)
- 	type arg
-	
-	(* type svalue is the type of semantic values for the semantic value
-	   stack
-	 *)
+        type arg
+        
+        (* type svalue is the type of semantic values for the semantic value
+           stack
+         *)
 
-	type svalue
+        type svalue
 
-	(* val makeLexer is used to create a stream of tokens for the parser *)
+        (* val makeLexer is used to create a stream of tokens for the parser *)
 
-	val makeLexer : (int -> string) ->
-			 (svalue,pos) Token.token Stream.stream
+        val makeLexer : (int -> string) ->
+                         (svalue,pos) Token.token Stream.stream
 
-	(* val parse takes a stream of tokens and a function to print
-	   errors and returns a value of type result and a stream containing
-	   the unused tokens
-	 *)
+        (* val parse takes a stream of tokens and a function to print
+           errors and returns a value of type result and a stream containing
+           the unused tokens
+         *)
 
-	val parse : int * ((svalue,pos) Token.token Stream.stream) *
-		    (string * pos * pos -> unit) * arg ->
-				result * (svalue,pos) Token.token Stream.stream
+        val parse : int * ((svalue,pos) Token.token Stream.stream) *
+                    (string * pos * pos -> unit) * arg ->
+                                result * (svalue,pos) Token.token Stream.stream
 
-	val sameToken : (svalue,pos) Token.token * (svalue,pos) Token.token ->
-				bool
+        val sameToken : (svalue,pos) Token.token * (svalue,pos) Token.token ->
+                                bool
      end
 
 (* signature ARG_PARSER is the signature that will be matched by parsers whose
@@ -12369,23 +12369,23 @@
 signature ARG_PARSER = 
     sig
         structure Token : TOKEN
-	structure Stream : STREAM
-	exception ParseError
+        structure Stream : STREAM
+        exception ParseError
 
-	type arg
-	type lexarg
-	type pos
-	type result
-	type svalue
+        type arg
+        type lexarg
+        type pos
+        type result
+        type svalue
 
-	val makeLexer : (int -> string) -> lexarg ->
-			 (svalue,pos) Token.token Stream.stream
-	val parse : int * ((svalue,pos) Token.token Stream.stream) *
-		    (string * pos * pos -> unit) * arg ->
-				result * (svalue,pos) Token.token Stream.stream
+        val makeLexer : (int -> string) -> lexarg ->
+                         (svalue,pos) Token.token Stream.stream
+        val parse : int * ((svalue,pos) Token.token Stream.stream) *
+                    (string * pos * pos -> unit) * arg ->
+                                result * (svalue,pos) Token.token Stream.stream
 
-	val sameToken : (svalue,pos) Token.token * (svalue,pos) Token.token ->
-				bool
+        val sameToken : (svalue,pos) Token.token * (svalue,pos) Token.token ->
+                                bool
      end
 
 (* stop of ml-yacc/lib/base.sig *)
@@ -12400,14 +12400,14 @@
 *)
 
 functor Join(structure Lex : LEXER
-	     structure ParserData: PARSER_DATA
-	     structure LrParser : LR_PARSER
-	     sharing ParserData.LrTable = LrParser.LrTable
-	     sharing ParserData.Token = LrParser.Token
-	     sharing type Lex.UserDeclarations.svalue = ParserData.svalue
-	     sharing type Lex.UserDeclarations.pos = ParserData.pos
-	     sharing type Lex.UserDeclarations.token = ParserData.Token.token)
-		 : PARSER =
+             structure ParserData: PARSER_DATA
+             structure LrParser : LR_PARSER
+             sharing ParserData.LrTable = LrParser.LrTable
+             sharing ParserData.Token = LrParser.Token
+             sharing type Lex.UserDeclarations.svalue = ParserData.svalue
+             sharing type Lex.UserDeclarations.pos = ParserData.pos
+             sharing type Lex.UserDeclarations.token = ParserData.Token.token)
+                 : PARSER =
 struct
     structure Token = ParserData.Token
     structure Stream = LrParser.Stream
@@ -12420,20 +12420,20 @@
     type svalue = ParserData.svalue
     val makeLexer = LrParser.Stream.streamify o Lex.makeLexer
     val parse = fn (lookahead,lexer,error,arg) =>
-	(fn (a,b) => (ParserData.Actions.extract a,b))
+        (fn (a,b) => (ParserData.Actions.extract a,b))
      (LrParser.parse {table = ParserData.table,
-	        lexer=lexer,
-		lookahead=lookahead,
-		saction = ParserData.Actions.actions,
-		arg=arg,
-		void= ParserData.Actions.void,
-	        ec = {is_keyword = ParserData.EC.is_keyword,
-		      noShift = ParserData.EC.noShift,
-		      preferred_change = ParserData.EC.preferred_change,
-		      errtermvalue = ParserData.EC.errtermvalue,
-		      error=error,
-		      showTerminal = ParserData.EC.showTerminal,
-		      terms = ParserData.EC.terms}}
+                lexer=lexer,
+                lookahead=lookahead,
+                saction = ParserData.Actions.actions,
+                arg=arg,
+                void= ParserData.Actions.void,
+                ec = {is_keyword = ParserData.EC.is_keyword,
+                      noShift = ParserData.EC.noShift,
+                      preferred_change = ParserData.EC.preferred_change,
+                      errtermvalue = ParserData.EC.errtermvalue,
+                      error=error,
+                      showTerminal = ParserData.EC.showTerminal,
+                      terms = ParserData.EC.terms}}
       )
      val sameToken = Token.sameToken
 end
@@ -12444,14 +12444,14 @@
  *)
 
 functor JoinWithArg(structure Lex : ARG_LEXER
-	     structure ParserData: PARSER_DATA
-	     structure LrParser : LR_PARSER
-	     sharing ParserData.LrTable = LrParser.LrTable
-	     sharing ParserData.Token = LrParser.Token
-	     sharing type Lex.UserDeclarations.svalue = ParserData.svalue
-	     sharing type Lex.UserDeclarations.pos = ParserData.pos
-	     sharing type Lex.UserDeclarations.token = ParserData.Token.token)
-		 : ARG_PARSER  =
+             structure ParserData: PARSER_DATA
+             structure LrParser : LR_PARSER
+             sharing ParserData.LrTable = LrParser.LrTable
+             sharing ParserData.Token = LrParser.Token
+             sharing type Lex.UserDeclarations.svalue = ParserData.svalue
+             sharing type Lex.UserDeclarations.pos = ParserData.pos
+             sharing type Lex.UserDeclarations.token = ParserData.Token.token)
+                 : ARG_PARSER  =
 struct
     structure Token = ParserData.Token
     structure Stream = LrParser.Stream
@@ -12465,22 +12465,22 @@
     type svalue = ParserData.svalue
 
     val makeLexer = fn s => fn arg =>
-		 LrParser.Stream.streamify (Lex.makeLexer s arg)
+                 LrParser.Stream.streamify (Lex.makeLexer s arg)
     val parse = fn (lookahead,lexer,error,arg) =>
-	(fn (a,b) => (ParserData.Actions.extract a,b))
+        (fn (a,b) => (ParserData.Actions.extract a,b))
      (LrParser.parse {table = ParserData.table,
-	        lexer=lexer,
-		lookahead=lookahead,
-		saction = ParserData.Actions.actions,
-		arg=arg,
-		void= ParserData.Actions.void,
-	        ec = {is_keyword = ParserData.EC.is_keyword,
-		      noShift = ParserData.EC.noShift,
-		      preferred_change = ParserData.EC.preferred_change,
-		      errtermvalue = ParserData.EC.errtermvalue,
-		      error=error,
-		      showTerminal = ParserData.EC.showTerminal,
-		      terms = ParserData.EC.terms}}
+                lexer=lexer,
+                lookahead=lookahead,
+                saction = ParserData.Actions.actions,
+                arg=arg,
+                void= ParserData.Actions.void,
+                ec = {is_keyword = ParserData.EC.is_keyword,
+                      noShift = ParserData.EC.noShift,
+                      preferred_change = ParserData.EC.preferred_change,
+                      errtermvalue = ParserData.EC.errtermvalue,
+                      error=error,
+                      showTerminal = ParserData.EC.showTerminal,
+                      terms = ParserData.EC.terms}}
       )
     val sameToken = Token.sameToken
 end;
@@ -12489,60 +12489,60 @@
 (* ML-Yacc Parser Generator (c) 1989 Andrew W. Appel, David R. Tarditi *)
 structure LrTable : LR_TABLE = 
     struct
-	open Array List
-	infix 9 sub
-	datatype ('a,'b) pairlist = EMPTY
-				  | PAIR of 'a * 'b * ('a,'b) pairlist
-	datatype term = T of int
-	datatype nonterm = NT of int
-	datatype state = STATE of int
-	datatype action = SHIFT of state
-			| REDUCE of int (* rulenum from grammar *)
-			| ACCEPT
-			| ERROR
-	exception Goto of state * nonterm
-	type table = {states: int, rules : int,initialState: state,
-		      action: ((term,action) pairlist * action) array,
-		      goto :  (nonterm,state) pairlist array}
-	val numStates = fn ({states,...} : table) => states
-	val numRules = fn ({rules,...} : table) => rules
-	val describeActions =
-	   fn ({action,...} : table) => 
-	           fn (STATE s) => action sub s
-	val describeGoto =
-	   fn ({goto,...} : table) =>
-	           fn (STATE s) => goto sub s
-	fun findTerm (T term,row,default) =
-	    let fun find (PAIR (T key,data,r)) =
-		       if key < term then find r
-		       else if key=term then data
-		       else default
-		   | find EMPTY = default
-	    in find row
-	    end
-	fun findNonterm (NT nt,row) =
-	    let fun find (PAIR (NT key,data,r)) =
-		       if key < nt then find r
-		       else if key=nt then SOME data
-		       else NONE
-		   | find EMPTY = NONE
-	    in find row
-	    end
-	val action = fn ({action,...} : table) =>
-		fn (STATE state,term) =>
-		  let val (row,default) = action sub state
-		  in findTerm(term,row,default)
-		  end
-	val goto = fn ({goto,...} : table) =>
-			fn (a as (STATE state,nonterm)) =>
-			  case findNonterm(nonterm,goto sub state)
-			  of SOME state => state
-			   | NONE => raise (Goto a)
-	val initialState = fn ({initialState,...} : table) => initialState
-	val mkLrTable = fn {actions,gotos,initialState,numStates,numRules} =>
-	     ({action=actions,goto=gotos,
-	       states=numStates,
-	       rules=numRules,
+        open Array List
+        infix 9 sub
+        datatype ('a,'b) pairlist = EMPTY
+                                  | PAIR of 'a * 'b * ('a,'b) pairlist
+        datatype term = T of int
+        datatype nonterm = NT of int
+        datatype state = STATE of int
+        datatype action = SHIFT of state
+                        | REDUCE of int (* rulenum from grammar *)
+                        | ACCEPT
+                        | ERROR
+        exception Goto of state * nonterm
+        type table = {states: int, rules : int,initialState: state,
+                      action: ((term,action) pairlist * action) array,
+                      goto :  (nonterm,state) pairlist array}
+        val numStates = fn ({states,...} : table) => states
+        val numRules = fn ({rules,...} : table) => rules
+        val describeActions =
+           fn ({action,...} : table) => 
+                   fn (STATE s) => action sub s
+        val describeGoto =
+           fn ({goto,...} : table) =>
+                   fn (STATE s) => goto sub s
+        fun findTerm (T term,row,default) =
+            let fun find (PAIR (T key,data,r)) =
+                       if key < term then find r
+                       else if key=term then data
+                       else default
+                   | find EMPTY = default
+            in find row
+            end
+        fun findNonterm (NT nt,row) =
+            let fun find (PAIR (NT key,data,r)) =
+                       if key < nt then find r
+                       else if key=nt then SOME data
+                       else NONE
+                   | find EMPTY = NONE
+            in find row
+            end
+        val action = fn ({action,...} : table) =>
+                fn (STATE state,term) =>
+                  let val (row,default) = action sub state
+                  in findTerm(term,row,default)
+                  end
+        val goto = fn ({goto,...} : table) =>
+                        fn (a as (STATE state,nonterm)) =>
+                          case findNonterm(nonterm,goto sub state)
+                          of SOME state => state
+                           | NONE => raise (Goto a)
+        val initialState = fn ({initialState,...} : table) => initialState
+        val mkLrTable = fn {actions,gotos,initialState,numStates,numRules} =>
+             ({action=actions,goto=gotos,
+               states=numStates,
+               rules=numRules,
                initialState=initialState} : table)
 end;
 (* stop of ml-yacc/lib/lrtable.sml *)
@@ -12560,7 +12560,7 @@
 
    fun get(ref(EVAL t)) = t
      | get(s as ref(UNEVAL f)) = 
-	    let val t = (f(), ref(UNEVAL f)) in s := EVAL t; t end
+            let val t = (f(), ref(UNEVAL f)) in s := EVAL t; t end
 
    fun streamify f = ref(UNEVAL f)
    fun cons(a,s) = ref(EVAL(a,s))
@@ -12574,10 +12574,10 @@
    routine added to it.  The routine used is described in detail in this
    article:
 
-	'A Practical Method for LR and LL Syntactic Error Diagnosis and
-	 Recovery', by M. Burke and G. Fisher, ACM Transactions on
-	 Programming Langauges and Systems, Vol. 9, No. 2, April 1987,
-	 pp. 164-197.
+        'A Practical Method for LR and LL Syntactic Error Diagnosis and
+         Recovery', by M. Burke and G. Fisher, ACM Transactions on
+         Programming Langauges and Systems, Vol. 9, No. 2, April 1987,
+         pp. 164-197.
 
     This program is an implementation is the partial, deferred method discussed
     in the article.  The algorithm and data structures used in the program
@@ -12593,60 +12593,60 @@
 
     Data Structures:
     ----------------
-	
-	* The parser:
+        
+        * The parser:
 
-	   The state stack has the type
+           The state stack has the type
 
-		 (state * (semantic value * line # * line #)) list
+                 (state * (semantic value * line # * line #)) list
 
-	   The parser keeps a queue of (state stack * lexer pair).  A lexer pair
-	 consists of a terminal * value pair and a lexer.  This allows the 
-	 parser to reconstruct the states for terminals to the left of a
-	 syntax error, and attempt to make error corrections there.
+           The parser keeps a queue of (state stack * lexer pair).  A lexer pair
+         consists of a terminal * value pair and a lexer.  This allows the 
+         parser to reconstruct the states for terminals to the left of a
+         syntax error, and attempt to make error corrections there.
 
-	   The queue consists of a pair of lists (x,y).  New additions to
-	 the queue are cons'ed onto y.  The first element of x is the top
-	 of the queue.  If x is nil, then y is reversed and used
-	 in place of x.
+           The queue consists of a pair of lists (x,y).  New additions to
+         the queue are cons'ed onto y.  The first element of x is the top
+         of the queue.  If x is nil, then y is reversed and used
+         in place of x.
 
     Algorithm:
     ----------
 
-	* The steady-state parser:  
+        * The steady-state parser:  
 
-	    This parser keeps the length of the queue of state stacks at
-	a steady state by always removing an element from the front when
-	another element is placed on the end.
+            This parser keeps the length of the queue of state stacks at
+        a steady state by always removing an element from the front when
+        another element is placed on the end.
 
-	    It has these arguments:
+            It has these arguments:
 
-	   stack: current stack
-	   queue: value of the queue
-	   lexPair ((terminal,value),lex stream)
+           stack: current stack
+           queue: value of the queue
+           lexPair ((terminal,value),lex stream)
 
-	When SHIFT is encountered, the state to shift to and the value are
-	are pushed onto the state stack.  The state stack and lexPair are
-	placed on the queue.  The front element of the queue is removed.
+        When SHIFT is encountered, the state to shift to and the value are
+        are pushed onto the state stack.  The state stack and lexPair are
+        placed on the queue.  The front element of the queue is removed.
 
-	When REDUCTION is encountered, the rule is applied to the current
-	stack to yield a triple (nonterm,value,new stack).  A new
-	stack is formed by adding (goto(top state of stack,nonterm),value)
-	to the stack.
+        When REDUCTION is encountered, the rule is applied to the current
+        stack to yield a triple (nonterm,value,new stack).  A new
+        stack is formed by adding (goto(top state of stack,nonterm),value)
+        to the stack.
 
-	When ACCEPT is encountered, the top value from the stack and the
-	lexer are returned.
+        When ACCEPT is encountered, the top value from the stack and the
+        lexer are returned.
 
-	When an ERROR is encountered, fixError is called.  FixError
-	takes the arguments to the parser, fixes the error if possible and
+        When an ERROR is encountered, fixError is called.  FixError
+        takes the arguments to the parser, fixes the error if possible and
         returns a new set of arguments.
 
-	* The distance-parser:
+        * The distance-parser:
 
-	This parser includes an additional argument distance.  It pushes
-	elements on the queue until it has parsed distance tokens, or an
-	ACCEPT or ERROR occurs.  It returns a stack, lexer, the number of
-	tokens left unparsed, a queue, and an action option.
+        This parser includes an additional argument distance.  It pushes
+        elements on the queue until it has parsed distance tokens, or an
+        ACCEPT or ERROR occurs.  It returns a stack, lexer, the number of
+        tokens left unparsed, a queue, and an action option.
 *)
 
 signature FIFO = 
@@ -12661,7 +12661,7 @@
    it wastes space in the release version.
 
 functor ParserGen(structure LrTable : LR_TABLE
-		  structure Stream : STREAM) : LR_PARSER =
+                  structure Stream : STREAM) : LR_PARSER =
 *)
 
 structure LrParser :> LR_PARSER =
@@ -12670,10 +12670,10 @@
       structure Stream = Stream
 
       structure Token : TOKEN =
-	struct
-	    structure LrTable = LrTable
-	    datatype ('a,'b) token = TOKEN of LrTable.term * ('a * 'b * 'b)
-	    val sameToken = fn (TOKEN(t,_),TOKEN(t',_)) => t=t'
+        struct
+            structure LrTable = LrTable
+            datatype ('a,'b) token = TOKEN of LrTable.term * ('a * 'b * 'b)
+            val sameToken = fn (TOKEN(t,_),TOKEN(t',_)) => t=t'
         end
 
       open LrTable
@@ -12686,13 +12686,13 @@
 
       structure Fifo :> FIFO =
         struct
-	  type 'a queue = ('a list * 'a list)
-	  val empty = (nil,nil)
-	  exception Empty
-	  fun get(a::x, y) = (a, (x,y))
-	    | get(nil, nil) = raise Empty
-	    | get(nil, y) = get(rev y, nil)
- 	  fun put(a,(x,y)) = (x,a::y)
+          type 'a queue = ('a list * 'a list)
+          val empty = (nil,nil)
+          exception Empty
+          fun get(a::x, y) = (a, (x,y))
+            | get(nil, nil) = raise Empty
+            | get(nil, y) = get(rev y, nil)
+          fun put(a,(x,y)) = (x,a::y)
         end
 
       type ('a,'b) elem = (state * ('a * 'b * 'b))
@@ -12700,29 +12700,29 @@
       type ('a,'b) lexv = ('a,'b) token
       type ('a,'b) lexpair = ('a,'b) lexv * (('a,'b) lexv Stream.stream)
       type ('a,'b) distanceParse =
-		 ('a,'b) lexpair *
-		 ('a,'b) stack * 
-		 (('a,'b) stack * ('a,'b) lexpair) Fifo.queue *
-		 int ->
-		   ('a,'b) lexpair *
-		   ('a,'b) stack * 
-		   (('a,'b) stack * ('a,'b) lexpair) Fifo.queue *
-		   int *
-		   action option
+                 ('a,'b) lexpair *
+                 ('a,'b) stack * 
+                 (('a,'b) stack * ('a,'b) lexpair) Fifo.queue *
+                 int ->
+                   ('a,'b) lexpair *
+                   ('a,'b) stack * 
+                   (('a,'b) stack * ('a,'b) lexpair) Fifo.queue *
+                   int *
+                   action option
 
       type ('a,'b) ecRecord =
-	 {is_keyword : term -> bool,
+         {is_keyword : term -> bool,
           preferred_change : (term list * term list) list,
-	  error : string * 'b * 'b -> unit,
-	  errtermvalue : term -> 'a,
-	  terms : term list,
-	  showTerminal : term -> string,
-	  noShift : term -> bool}
+          error : string * 'b * 'b -> unit,
+          errtermvalue : term -> 'a,
+          terms : term list,
+          showTerminal : term -> string,
+          noShift : term -> bool}
 
       local 
-	 val print = fn s => TextIO.output(TextIO.stdOut,s)
-	 val println = fn s => (print s; print "\n")
-	 val showState = fn (STATE s) => "STATE " ^ (Int.toString s)
+         val print = fn s => TextIO.output(TextIO.stdOut,s)
+         val println = fn s => (print s; print "\n")
+         val showState = fn (STATE s) => "STATE " ^ (Int.toString s)
       in
         fun printStack(stack: ('a,'b) stack, n: int) =
          case stack
@@ -12733,11 +12733,11 @@
             | nil => ()
                 
         fun prAction showTerminal
-		 (stack as (state,_) :: _, next as (TOKEN (term,_),_), action) =
+                 (stack as (state,_) :: _, next as (TOKEN (term,_),_), action) =
              (println "Parse: state stack:";
               printStack(stack, 0);
               print("       state="
-                         ^ showState state	
+                         ^ showState state      
                          ^ " next="
                          ^ showTerminal term
                          ^ " action="
@@ -12746,206 +12746,206 @@
                 of SHIFT state => println ("SHIFT " ^ (showState state))
                  | REDUCE i => println ("REDUCE " ^ (Int.toString i))
                  | ERROR => println "ERROR"
-		 | ACCEPT => println "ACCEPT")
+                 | ACCEPT => println "ACCEPT")
         | prAction _ (_,_,action) = ()
      end
 
     (* ssParse: parser which maintains the queue of (state * lexvalues) in a
-	steady-state.  It takes a table, showTerminal function, saction
-	function, and fixError function.  It parses until an ACCEPT is
-	encountered, or an exception is raised.  When an error is encountered,
-	fixError is called with the arguments of parseStep (lexv,stack,and
-	queue).  It returns the lexv, and a new stack and queue adjusted so
-	that the lexv can be parsed *)
-	
+        steady-state.  It takes a table, showTerminal function, saction
+        function, and fixError function.  It parses until an ACCEPT is
+        encountered, or an exception is raised.  When an error is encountered,
+        fixError is called with the arguments of parseStep (lexv,stack,and
+        queue).  It returns the lexv, and a new stack and queue adjusted so
+        that the lexv can be parsed *)
+        
     val ssParse =
       fn (table,showTerminal,saction,fixError,arg) =>
-	let val prAction = prAction showTerminal
-	    val action = LrTable.action table
-	    val goto = LrTable.goto table
-	    fun parseStep(args as
-			 (lexPair as (TOKEN (terminal, value as (_,leftPos,_)),
-				      lexer
-				      ),
-			  stack as (state,_) :: _,
-			  queue)) =
-	      let val nextAction = action (state,terminal)
-	          val _ = if DEBUG1 then prAction(stack,lexPair,nextAction)
-			  else ()
-	      in case nextAction
-		 of SHIFT s =>
-		  let val newStack = (s,value) :: stack
-		      val newLexPair = Stream.get lexer
-		      val (_,newQueue) =Fifo.get(Fifo.put((newStack,newLexPair),
-							    queue))
-		  in parseStep(newLexPair,(s,value)::stack,newQueue)
-		  end
-		 | REDUCE i =>
-		     (case saction(i,leftPos,stack,arg)
-		      of (nonterm,value,stack as (state,_) :: _) =>
-		          parseStep(lexPair,(goto(state,nonterm),value)::stack,
-				    queue)
-		       | _ => raise (ParseImpossible 197))
-		 | ERROR => parseStep(fixError args)
-		 | ACCEPT => 
-			(case stack
-			 of (_,(topvalue,_,_)) :: _ =>
-				let val (token,restLexer) = lexPair
-				in (topvalue,Stream.cons(token,restLexer))
-				end
-			  | _ => raise (ParseImpossible 202))
-	      end
-	    | parseStep _ = raise (ParseImpossible 204)
-	in parseStep
-	end
+        let val prAction = prAction showTerminal
+            val action = LrTable.action table
+            val goto = LrTable.goto table
+            fun parseStep(args as
+                         (lexPair as (TOKEN (terminal, value as (_,leftPos,_)),
+                                      lexer
+                                      ),
+                          stack as (state,_) :: _,
+                          queue)) =
+              let val nextAction = action (state,terminal)
+                  val _ = if DEBUG1 then prAction(stack,lexPair,nextAction)
+                          else ()
+              in case nextAction
+                 of SHIFT s =>
+                  let val newStack = (s,value) :: stack
+                      val newLexPair = Stream.get lexer
+                      val (_,newQueue) =Fifo.get(Fifo.put((newStack,newLexPair),
+                                                            queue))
+                  in parseStep(newLexPair,(s,value)::stack,newQueue)
+                  end
+                 | REDUCE i =>
+                     (case saction(i,leftPos,stack,arg)
+                      of (nonterm,value,stack as (state,_) :: _) =>
+                          parseStep(lexPair,(goto(state,nonterm),value)::stack,
+                                    queue)
+                       | _ => raise (ParseImpossible 197))
+                 | ERROR => parseStep(fixError args)
+                 | ACCEPT => 
+                        (case stack
+                         of (_,(topvalue,_,_)) :: _ =>
+                                let val (token,restLexer) = lexPair
+                                in (topvalue,Stream.cons(token,restLexer))
+                                end
+                          | _ => raise (ParseImpossible 202))
+              end
+            | parseStep _ = raise (ParseImpossible 204)
+        in parseStep
+        end
 
     (*  distanceParse: parse until n tokens are shifted, or accept or
-	error are encountered.  Takes a table, showTerminal function, and
-	semantic action function.  Returns a parser which takes a lexPair
-	(lex result * lexer), a state stack, a queue, and a distance
-	(must be > 0) to parse.  The parser returns a new lex-value, a stack
-	with the nth token shifted on top, a queue, a distance, and action
-	option. *)
+        error are encountered.  Takes a table, showTerminal function, and
+        semantic action function.  Returns a parser which takes a lexPair
+        (lex result * lexer), a state stack, a queue, and a distance
+        (must be > 0) to parse.  The parser returns a new lex-value, a stack
+        with the nth token shifted on top, a queue, a distance, and action
+        option. *)
 
     val distanceParse =
       fn (table,showTerminal,saction,arg) =>
-	let val prAction = prAction showTerminal
-	    val action = LrTable.action table
-	    val goto = LrTable.goto table
-	    fun parseStep(lexPair,stack,queue,0) = (lexPair,stack,queue,0,NONE)
-	      | parseStep(lexPair as (TOKEN (terminal, value as (_,leftPos,_)),
-				      lexer
-				     ),
-			  stack as (state,_) :: _,
-			  queue,distance) =
-	      let val nextAction = action(state,terminal)
-	          val _ = if DEBUG1 then prAction(stack,lexPair,nextAction)
-			  else ()
-	      in case nextAction
-		 of SHIFT s =>
-		  let val newStack = (s,value) :: stack
-		      val newLexPair = Stream.get lexer
-		  in parseStep(newLexPair,(s,value)::stack,
-			       Fifo.put((newStack,newLexPair),queue),distance-1)
-		  end
-		 | REDUCE i =>
-		    (case saction(i,leftPos,stack,arg)
-		      of (nonterm,value,stack as (state,_) :: _) =>
-		         parseStep(lexPair,(goto(state,nonterm),value)::stack,
-				 queue,distance)
-		      | _ => raise (ParseImpossible 240))
-		 | ERROR => (lexPair,stack,queue,distance,SOME nextAction)
-		 | ACCEPT => (lexPair,stack,queue,distance,SOME nextAction)
-	      end
-	   | parseStep _ = raise (ParseImpossible 242)
-	in parseStep : ('_a,'_b) distanceParse 
-	end
+        let val prAction = prAction showTerminal
+            val action = LrTable.action table
+            val goto = LrTable.goto table
+            fun parseStep(lexPair,stack,queue,0) = (lexPair,stack,queue,0,NONE)
+              | parseStep(lexPair as (TOKEN (terminal, value as (_,leftPos,_)),
+                                      lexer
+                                     ),
+                          stack as (state,_) :: _,
+                          queue,distance) =
+              let val nextAction = action(state,terminal)
+                  val _ = if DEBUG1 then prAction(stack,lexPair,nextAction)
+                          else ()
+              in case nextAction
+                 of SHIFT s =>
+                  let val newStack = (s,value) :: stack
+                      val newLexPair = Stream.get lexer
+                  in parseStep(newLexPair,(s,value)::stack,
+                               Fifo.put((newStack,newLexPair),queue),distance-1)
+                  end
+                 | REDUCE i =>
+                    (case saction(i,leftPos,stack,arg)
+                      of (nonterm,value,stack as (state,_) :: _) =>
+                         parseStep(lexPair,(goto(state,nonterm),value)::stack,
+                                 queue,distance)
+                      | _ => raise (ParseImpossible 240))
+                 | ERROR => (lexPair,stack,queue,distance,SOME nextAction)
+                 | ACCEPT => (lexPair,stack,queue,distance,SOME nextAction)
+              end
+           | parseStep _ = raise (ParseImpossible 242)
+        in parseStep : ('_a,'_b) distanceParse 
+        end
 
 (* mkFixError: function to create fixError function which adjusts parser state
    so that parse may continue in the presence of an error *)
 
 fun mkFixError({is_keyword,terms,errtermvalue,
-	      preferred_change,noShift,
-	      showTerminal,error,...} : ('_a,'_b) ecRecord,
-	     distanceParse : ('_a,'_b) distanceParse,
-	     minAdvance,maxAdvance) 
+              preferred_change,noShift,
+              showTerminal,error,...} : ('_a,'_b) ecRecord,
+             distanceParse : ('_a,'_b) distanceParse,
+             minAdvance,maxAdvance) 
 
             (lexv as (TOKEN (term,value as (_,leftPos,_)),_),stack,queue) =
     let val _ = if DEBUG2 then
-			error("syntax error found at " ^ (showTerminal term),
-			      leftPos,leftPos)
-		else ()
+                        error("syntax error found at " ^ (showTerminal term),
+                              leftPos,leftPos)
+                else ()
 
         fun tokAt(t,p) = TOKEN(t,(errtermvalue t,p,p))
 
-	val minDelta = 3
+        val minDelta = 3
 
-	(* pull all the state * lexv elements from the queue *)
+        (* pull all the state * lexv elements from the queue *)
 
-	val stateList = 
-	   let fun f q = let val (elem,newQueue) = Fifo.get q
-			 in elem :: (f newQueue)
-			 end handle Fifo.Empty => nil
-	   in f queue
-	   end
+        val stateList = 
+           let fun f q = let val (elem,newQueue) = Fifo.get q
+                         in elem :: (f newQueue)
+                         end handle Fifo.Empty => nil
+           in f queue
+           end
 
-	(* now number elements of stateList, giving distance from
-	   error token *)
+        (* now number elements of stateList, giving distance from
+           error token *)
 
-	val (_, numStateList) =
-	      List.foldr (fn (a,(num,r)) => (num+1,(a,num)::r)) (0, []) stateList
+        val (_, numStateList) =
+              List.foldr (fn (a,(num,r)) => (num+1,(a,num)::r)) (0, []) stateList
 
-	(* Represent the set of potential changes as a linked list.
+        (* Represent the set of potential changes as a linked list.
 
-	   Values of datatype Change hold information about a potential change.
+           Values of datatype Change hold information about a potential change.
 
-	   oper = oper to be applied
-	   pos = the # of the element in stateList that would be altered.
-	   distance = the number of tokens beyond the error token which the
-	     change allows us to parse.
-	   new = new terminal * value pair at that point
-	   orig = original terminal * value pair at the point being changed.
-	 *)
+           oper = oper to be applied
+           pos = the # of the element in stateList that would be altered.
+           distance = the number of tokens beyond the error token which the
+             change allows us to parse.
+           new = new terminal * value pair at that point
+           orig = original terminal * value pair at the point being changed.
+         *)
 
-	datatype ('a,'b) change = CHANGE of
-	   {pos : int, distance : int, leftPos: 'b, rightPos: 'b,
-	    new : ('a,'b) lexv list, orig : ('a,'b) lexv list}
+        datatype ('a,'b) change = CHANGE of
+           {pos : int, distance : int, leftPos: 'b, rightPos: 'b,
+            new : ('a,'b) lexv list, orig : ('a,'b) lexv list}
 
 
          val showTerms = concat o map (fn TOKEN(t,_) => " " ^ showTerminal t)
 
-	 val printChange = fn c =>
-	  let val CHANGE {distance,new,orig,pos,...} = c
-	  in (print ("{distance= " ^ (Int.toString distance));
-	      print (",orig ="); print(showTerms orig);
-	      print (",new ="); print(showTerms new);
-	      print (",pos= " ^ (Int.toString pos));
-	      print "}\n")
-	  end
+         val printChange = fn c =>
+          let val CHANGE {distance,new,orig,pos,...} = c
+          in (print ("{distance= " ^ (Int.toString distance));
+              print (",orig ="); print(showTerms orig);
+              print (",new ="); print(showTerms new);
+              print (",pos= " ^ (Int.toString pos));
+              print "}\n")
+          end
 
-	val printChangeList = app printChange
+        val printChangeList = app printChange
 
 (* parse: given a lexPair, a stack, and the distance from the error
    token, return the distance past the error token that we are able to parse.*)
 
-	fun parse (lexPair,stack,queuePos : int) =
-	    case distanceParse(lexPair,stack,Fifo.empty,queuePos+maxAdvance+1)
+        fun parse (lexPair,stack,queuePos : int) =
+            case distanceParse(lexPair,stack,Fifo.empty,queuePos+maxAdvance+1)
              of (_,_,_,distance,SOME ACCEPT) => 
-		        if maxAdvance-distance-1 >= 0 
-			    then maxAdvance 
-			    else maxAdvance-distance-1
-	      | (_,_,_,distance,_) => maxAdvance - distance - 1
+                        if maxAdvance-distance-1 >= 0 
+                            then maxAdvance 
+                            else maxAdvance-distance-1
+              | (_,_,_,distance,_) => maxAdvance - distance - 1
 
 (* catList: concatenate results of scanning list *)
 
-	fun catList l f = List.foldr (fn(a,r)=> f a @ r) [] l
+        fun catList l f = List.foldr (fn(a,r)=> f a @ r) [] l
 
         fun keywordsDelta new = if List.exists (fn(TOKEN(t,_))=>is_keyword t) new
-	               then minDelta else 0
+                       then minDelta else 0
 
         fun tryChange{lex,stack,pos,leftPos,rightPos,orig,new} =
-	     let val lex' = List.foldr (fn (t',p)=>(t',Stream.cons p)) lex new
-		 val distance = parse(lex',stack,pos+length new-length orig)
-	      in if distance >= minAdvance + keywordsDelta new 
-		   then [CHANGE{pos=pos,leftPos=leftPos,rightPos=rightPos,
-				distance=distance,orig=orig,new=new}] 
-		   else []
-	     end
+             let val lex' = List.foldr (fn (t',p)=>(t',Stream.cons p)) lex new
+                 val distance = parse(lex',stack,pos+length new-length orig)
+              in if distance >= minAdvance + keywordsDelta new 
+                   then [CHANGE{pos=pos,leftPos=leftPos,rightPos=rightPos,
+                                distance=distance,orig=orig,new=new}] 
+                   else []
+             end
 
 
 (* tryDelete: Try to delete n terminals.
               Return single-element [success] or nil.
-	      Do not delete unshiftable terminals. *)
+              Do not delete unshiftable terminals. *)
 
 
     fun tryDelete n ((stack,lexPair as (TOKEN(term,(_,l,r)),_)),qPos) =
-	let fun del(0,accum,left,right,lexPair) =
-	          tryChange{lex=lexPair,stack=stack,
-			    pos=qPos,leftPos=left,rightPos=right,
-			    orig=rev accum, new=[]}
-	      | del(n,accum,left,right,(tok as TOKEN(term,(_,_,r)),lexer)) =
-		   if noShift term then []
-		   else del(n-1,tok::accum,left,r,Stream.get lexer)
+        let fun del(0,accum,left,right,lexPair) =
+                  tryChange{lex=lexPair,stack=stack,
+                            pos=qPos,leftPos=left,rightPos=right,
+                            orig=rev accum, new=[]}
+              | del(n,accum,left,right,(tok as TOKEN(term,(_,_,r)),lexer)) =
+                   if noShift term then []
+                   else del(n-1,tok::accum,left,r,Stream.get lexer)
          in del(n,[],l,r,lexPair)
         end
 
@@ -12953,159 +12953,159 @@
        return a list of the successes  *)
 
         fun tryInsert((stack,lexPair as (TOKEN(_,(_,l,_)),_)),queuePos) =
-	       catList terms (fn t =>
-		 tryChange{lex=lexPair,stack=stack,
-			   pos=queuePos,orig=[],new=[tokAt(t,l)],
-			   leftPos=l,rightPos=l})
-			      
+               catList terms (fn t =>
+                 tryChange{lex=lexPair,stack=stack,
+                           pos=queuePos,orig=[],new=[tokAt(t,l)],
+                           leftPos=l,rightPos=l})
+                              
 (* trySubst: try to substitute tokens for the current terminal;
        return a list of the successes  *)
 
         fun trySubst ((stack,lexPair as (orig as TOKEN (term,(_,l,r)),lexer)),
-		      queuePos) =
-	      if noShift term then []
-	      else
-		  catList terms (fn t =>
-		      tryChange{lex=Stream.get lexer,stack=stack,
-				pos=queuePos,
-				leftPos=l,rightPos=r,orig=[orig],
-				new=[tokAt(t,r)]})
+                      queuePos) =
+              if noShift term then []
+              else
+                  catList terms (fn t =>
+                      tryChange{lex=Stream.get lexer,stack=stack,
+                                pos=queuePos,
+                                leftPos=l,rightPos=r,orig=[orig],
+                                new=[tokAt(t,r)]})
 
      (* do_delete(toks,lexPair) tries to delete tokens "toks" from "lexPair".
          If it succeeds, returns SOME(toks',l,r,lp), where
-	     toks' is the actual tokens (with positions and values) deleted,
-	     (l,r) are the (leftmost,rightmost) position of toks', 
-	     lp is what remains of the stream after deletion 
+             toks' is the actual tokens (with positions and values) deleted,
+             (l,r) are the (leftmost,rightmost) position of toks', 
+             lp is what remains of the stream after deletion 
      *)
         fun do_delete(nil,lp as (TOKEN(_,(_,l,_)),_)) = SOME(nil,l,l,lp)
           | do_delete([t],(tok as TOKEN(t',(_,l,r)),lp')) =
-	       if t=t'
-		   then SOME([tok],l,r,Stream.get lp')
+               if t=t'
+                   then SOME([tok],l,r,Stream.get lp')
                    else NONE
           | do_delete(t::rest,(tok as TOKEN(t',(_,l,r)),lp')) =
-	       if t=t'
-		   then case do_delete(rest,Stream.get lp')
+               if t=t'
+                   then case do_delete(rest,Stream.get lp')
                          of SOME(deleted,l',r',lp'') =>
-			       SOME(tok::deleted,l,r',lp'')
-			  | NONE => NONE
-		   else NONE
-			     
+                               SOME(tok::deleted,l,r',lp'')
+                          | NONE => NONE
+                   else NONE
+                             
         fun tryPreferred((stack,lexPair),queuePos) =
-	    catList preferred_change (fn (delete,insert) =>
-	       if List.exists noShift delete then [] (* should give warning at
-						 parser-generation time *)
+            catList preferred_change (fn (delete,insert) =>
+               if List.exists noShift delete then [] (* should give warning at
+                                                 parser-generation time *)
                else case do_delete(delete,lexPair)
                      of SOME(deleted,l,r,lp) => 
-			    tryChange{lex=lp,stack=stack,pos=queuePos,
-				      leftPos=l,rightPos=r,orig=deleted,
-				      new=map (fn t=>(tokAt(t,r))) insert}
-		      | NONE => [])
+                            tryChange{lex=lp,stack=stack,pos=queuePos,
+                                      leftPos=l,rightPos=r,orig=deleted,
+                                      new=map (fn t=>(tokAt(t,r))) insert}
+                      | NONE => [])
 
-	val changes = catList numStateList tryPreferred @
-	                catList numStateList tryInsert @
-			  catList numStateList trySubst @
-			    catList numStateList (tryDelete 1) @
-			      catList numStateList (tryDelete 2) @
-			        catList numStateList (tryDelete 3)
+        val changes = catList numStateList tryPreferred @
+                        catList numStateList tryInsert @
+                          catList numStateList trySubst @
+                            catList numStateList (tryDelete 1) @
+                              catList numStateList (tryDelete 2) @
+                                catList numStateList (tryDelete 3)
 
-	val findMaxDist = fn l => 
-	  foldr (fn (CHANGE {distance,...},high) => Int.max(distance,high)) 0 l
+        val findMaxDist = fn l => 
+          foldr (fn (CHANGE {distance,...},high) => Int.max(distance,high)) 0 l
 
 (* maxDist: max distance past error taken that we could parse *)
 
-	val maxDist = findMaxDist changes
+        val maxDist = findMaxDist changes
 
 (* remove changes which did not parse maxDist tokens past the error token *)
 
         val changes = catList changes 
-	      (fn(c as CHANGE{distance,...}) => 
-		  if distance=maxDist then [c] else [])
+              (fn(c as CHANGE{distance,...}) => 
+                  if distance=maxDist then [c] else [])
 
       in case changes 
-	  of (l as change :: _) =>
-	      let fun print_msg (CHANGE {new,orig,leftPos,rightPos,...}) =
-		  let val s = 
-		      case (orig,new)
-			  of (_::_,[]) => "deleting " ^ (showTerms orig)
-	                   | ([],_::_) => "inserting " ^ (showTerms new)
-			   | _ => "replacing " ^ (showTerms orig) ^
-				 " with " ^ (showTerms new)
-		  in error ("syntax error: " ^ s,leftPos,rightPos)
-		  end
-		   
-		  val _ = 
-		      (if length l > 1 andalso DEBUG2 then
-			   (print "multiple fixes possible; could fix it by:\n";
-			    app print_msg l;
-			    print "chosen correction:\n")
-		       else ();
-		       print_msg change)
+          of (l as change :: _) =>
+              let fun print_msg (CHANGE {new,orig,leftPos,rightPos,...}) =
+                  let val s = 
+                      case (orig,new)
+                          of (_::_,[]) => "deleting " ^ (showTerms orig)
+                           | ([],_::_) => "inserting " ^ (showTerms new)
+                           | _ => "replacing " ^ (showTerms orig) ^
+                                 " with " ^ (showTerms new)
+                  in error ("syntax error: " ^ s,leftPos,rightPos)
+                  end
+                   
+                  val _ = 
+                      (if length l > 1 andalso DEBUG2 then
+                           (print "multiple fixes possible; could fix it by:\n";
+                            app print_msg l;
+                            print "chosen correction:\n")
+                       else ();
+                       print_msg change)
 
-		  (* findNth: find nth queue entry from the error
-		   entry.  Returns the Nth queue entry and the  portion of
-		   the queue from the beginning to the nth-1 entry.  The
-		   error entry is at the end of the queue.
+                  (* findNth: find nth queue entry from the error
+                   entry.  Returns the Nth queue entry and the  portion of
+                   the queue from the beginning to the nth-1 entry.  The
+                   error entry is at the end of the queue.
 
-		   Examples:
+                   Examples:
 
-		   queue = a b c d e
-		   findNth 0 = (e,a b c d)
-		   findNth 1 =  (d,a b c)
-		   *)
+                   queue = a b c d e
+                   findNth 0 = (e,a b c d)
+                   findNth 1 =  (d,a b c)
+                   *)
 
-		  val findNth = fn n =>
-		      let fun f (h::t,0) = (h,rev t)
-			    | f (h::t,n) = f(t,n-1)
-			    | f (nil,_) = let exception FindNth
-					  in raise FindNth
-					  end
-		      in f (rev stateList,n)
-		      end
-		
-		  val CHANGE {pos,orig,new,...} = change
-		  val (last,queueFront) = findNth pos
-		  val (stack,lexPair) = last
+                  val findNth = fn n =>
+                      let fun f (h::t,0) = (h,rev t)
+                            | f (h::t,n) = f(t,n-1)
+                            | f (nil,_) = let exception FindNth
+                                          in raise FindNth
+                                          end
+                      in f (rev stateList,n)
+                      end
+                
+                  val CHANGE {pos,orig,new,...} = change
+                  val (last,queueFront) = findNth pos
+                  val (stack,lexPair) = last
 
-		  val lp1 = foldl(fn (_,(_,r)) => Stream.get r) lexPair orig
-		  val lp2 = foldr(fn(t,r)=>(t,Stream.cons r)) lp1 new
+                  val lp1 = foldl(fn (_,(_,r)) => Stream.get r) lexPair orig
+                  val lp2 = foldr(fn(t,r)=>(t,Stream.cons r)) lp1 new
 
-		  val restQueue = 
-		      Fifo.put((stack,lp2),
-			       foldl Fifo.put Fifo.empty queueFront)
+                  val restQueue = 
+                      Fifo.put((stack,lp2),
+                               foldl Fifo.put Fifo.empty queueFront)
 
-		  val (lexPair,stack,queue,_,_) =
-		      distanceParse(lp2,stack,restQueue,pos)
+                  val (lexPair,stack,queue,_,_) =
+                      distanceParse(lp2,stack,restQueue,pos)
 
-	      in (lexPair,stack,queue)
-	      end
-	| nil => (error("syntax error found at " ^ (showTerminal term),
-			leftPos,leftPos); raise ParseError)
+              in (lexPair,stack,queue)
+              end
+        | nil => (error("syntax error found at " ^ (showTerminal term),
+                        leftPos,leftPos); raise ParseError)
     end
 
    val parse = fn {arg,table,lexer,saction,void,lookahead,
-		   ec=ec as {showTerminal,...} : ('_a,'_b) ecRecord} =>
-	let val distance = 15   (* defer distance tokens *)
-	    val minAdvance = 1  (* must parse at least 1 token past error *)
-	    val maxAdvance = Int.max(lookahead,0)(* max distance for parse check *)
-	    val lexPair = Stream.get lexer
-	    val (TOKEN (_,(_,leftPos,_)),_) = lexPair
-	    val startStack = [(initialState table,(void,leftPos,leftPos))]
-	    val startQueue = Fifo.put((startStack,lexPair),Fifo.empty)
-	    val distanceParse = distanceParse(table,showTerminal,saction,arg)
-	    val fixError = mkFixError(ec,distanceParse,minAdvance,maxAdvance)
-	    val ssParse = ssParse(table,showTerminal,saction,fixError,arg)
-	    fun loop (lexPair,stack,queue,_,SOME ACCEPT) =
-		   ssParse(lexPair,stack,queue)
-	      | loop (lexPair,stack,queue,0,_) = ssParse(lexPair,stack,queue)
-	      | loop (lexPair,stack,queue,distance,SOME ERROR) =
-		 let val (lexPair,stack,queue) = fixError(lexPair,stack,queue)
-		 in loop (distanceParse(lexPair,stack,queue,distance))
-		 end
-	      | loop _ = let exception ParseInternal
-			 in raise ParseInternal
-			 end
-	in loop (distanceParse(lexPair,startStack,startQueue,distance))
-	end
+                   ec=ec as {showTerminal,...} : ('_a,'_b) ecRecord} =>
+        let val distance = 15   (* defer distance tokens *)
+            val minAdvance = 1  (* must parse at least 1 token past error *)
+            val maxAdvance = Int.max(lookahead,0)(* max distance for parse check *)
+            val lexPair = Stream.get lexer
+            val (TOKEN (_,(_,leftPos,_)),_) = lexPair
+            val startStack = [(initialState table,(void,leftPos,leftPos))]
+            val startQueue = Fifo.put((startStack,lexPair),Fifo.empty)
+            val distanceParse = distanceParse(table,showTerminal,saction,arg)
+            val fixError = mkFixError(ec,distanceParse,minAdvance,maxAdvance)
+            val ssParse = ssParse(table,showTerminal,saction,fixError,arg)
+            fun loop (lexPair,stack,queue,_,SOME ACCEPT) =
+                   ssParse(lexPair,stack,queue)
+              | loop (lexPair,stack,queue,0,_) = ssParse(lexPair,stack,queue)
+              | loop (lexPair,stack,queue,distance,SOME ERROR) =
+                 let val (lexPair,stack,queue) = fixError(lexPair,stack,queue)
+                 in loop (distanceParse(lexPair,stack,queue,distance))
+                 end
+              | loop _ = let exception ParseInternal
+                         in raise ParseInternal
+                         end
+        in loop (distanceParse(lexPair,startStack,startQueue,distance))
+        end
  end;
 
 (* stop of ml-yacc/lib/parser2.sml *)
@@ -13153,41 +13153,41 @@
 
     (* Expressions [Figure 15] *)
 
-    val UNITAtExp:	Info					-> AtExp
-    val TUPLEAtExp:	Info * Exp list				-> AtExp
-    val HASHAtExp:	Info * Lab				-> AtExp
-    val CASEExp:	Info * Exp * Match			-> Exp
-    val IFExp:		Info * Exp * Exp * Exp			-> Exp
-    val ANDALSOExp:	Info * Exp * Exp			-> Exp
-    val ORELSEExp:	Info * Exp * Exp			-> Exp
-    val SEQAtExp:	Info * Exp list				-> AtExp
-    val LETAtExp:	Info * Dec * Exp list			-> AtExp
-    val WHILEExp:	Info * Exp * Exp			-> Exp
-    val LISTAtExp:	Info * Exp list				-> AtExp
+    val UNITAtExp:      Info                                    -> AtExp
+    val TUPLEAtExp:     Info * Exp list                         -> AtExp
+    val HASHAtExp:      Info * Lab                              -> AtExp
+    val CASEExp:        Info * Exp * Match                      -> Exp
+    val IFExp:          Info * Exp * Exp * Exp                  -> Exp
+    val ANDALSOExp:     Info * Exp * Exp                        -> Exp
+    val ORELSEExp:      Info * Exp * Exp                        -> Exp
+    val SEQAtExp:       Info * Exp list                         -> AtExp
+    val LETAtExp:       Info * Dec * Exp list                   -> AtExp
+    val WHILEExp:       Info * Exp * Exp                        -> Exp
+    val LISTAtExp:      Info * Exp list                         -> AtExp
 
     (* Patterns [Figure 16] *)
 
-    val UNITAtPat:	Info					-> AtPat
-    val TUPLEAtPat:	Info * Pat list				-> AtPat
-    val LISTAtPat:	Info * Pat list				-> AtPat
+    val UNITAtPat:      Info                                    -> AtPat
+    val TUPLEAtPat:     Info * Pat list                         -> AtPat
+    val LISTAtPat:      Info * Pat list                         -> AtPat
 
-    val VIDPatRow:	Info * VId * Ty option * Pat option * PatRow option
-								-> PatRow
+    val VIDPatRow:      Info * VId * Ty option * Pat option * PatRow option
+                                                                -> PatRow
     (* Types [Figure 16] *)
 
-    val TUPLETy:	Info * Ty list				-> Ty
+    val TUPLETy:        Info * Ty list                          -> Ty
 
     (* Function-value bindings [Figure 17] *)
 
-    val FvalBind:	Info * Fmatch * FvalBind option		-> FvalBind
-    val Fmatch:		Info * Fmrule * Fmatch option		-> Fmatch
-    val Fmrule:		Info * Op * VId * AtPat list * Ty option * Exp -> Fmrule
+    val FvalBind:       Info * Fmatch * FvalBind option         -> FvalBind
+    val Fmatch:         Info * Fmrule * Fmatch option           -> Fmatch
+    val Fmrule:         Info * Op * VId * AtPat list * Ty option * Exp -> Fmrule
 
     (* Declarations [Figure 17] *)
 
-    val FUNDec:		Info * TyVarseq * FvalBind		-> Dec
-    val DATATYPEDec:	Info * DatBind * TypBind option		-> Dec
-    val ABSTYPEDec:	Info * DatBind * TypBind option * Dec	-> Dec
+    val FUNDec:         Info * TyVarseq * FvalBind              -> Dec
+    val DATATYPEDec:    Info * DatBind * TypBind option         -> Dec
+    val ABSTYPEDec:     Info * DatBind * TypBind option * Dec   -> Dec
 
   end
 (* stop of DERIVED_FORMS_CORE.sml *)
@@ -13256,9 +13256,9 @@
 
 
     fun LONGVIDExp(I, longvid) = C.ATEXPExp(I, C.LONGVIDAtExp(I, C.SANSOp,
-								 longvid))
+                                                                 longvid))
     fun LONGVIDPat(I, longvid) = C.ATPATPat(I, C.LONGVIDAtPat(I, C.SANSOp,
-								 longvid))
+                                                                 longvid))
 
     fun VIDExp(I, vid)         = LONGVIDExp(I, LongVId.fromId vid)
     fun VIDPat(I, vid)         = LONGVIDPat(I, LongVId.fromId vid)
@@ -13276,92 +13276,92 @@
     (* Rewriting of withtype declarations [Appendix A, 2nd bullet] *)
 
     fun lookupTyCon(tycon, C.TypBind(_, tyvarseq, tycon', ty, typbind_opt)) =
-	    if tycon' = tycon then
-		(tyvarseq, ty)
-	    else
-	  	lookupTyCon(tycon, Option.valOf typbind_opt)
-		(* may raise Option *)
+            if tycon' = tycon then
+                (tyvarseq, ty)
+            else
+                lookupTyCon(tycon, Option.valOf typbind_opt)
+                (* may raise Option *)
 
 
     fun replaceTy (C.TyVarseq(_,tyvars), C.Tyseq(i',tys)) (C.TYVARTy(i,tyvar)) =
-	let
-	    fun loop(tyvar'::tyvars', ty'::tys') =
-		    if tyvar' = tyvar then
-			ty'
-		    else
-			loop(tyvars', tys')
-	      | loop([],_) =
-		    Error.error(i, "unbound type variable")
-	      | loop(_,[]) =
-		    Error.error(i', "type sequence has wrong arity")
-	in
-	    loop(tyvars, tys)
-	end
+        let
+            fun loop(tyvar'::tyvars', ty'::tys') =
+                    if tyvar' = tyvar then
+                        ty'
+                    else
+                        loop(tyvars', tys')
+              | loop([],_) =
+                    Error.error(i, "unbound type variable")
+              | loop(_,[]) =
+                    Error.error(i', "type sequence has wrong arity")
+        in
+            loop(tyvars, tys)
+        end
 
       | replaceTy tyvarseq_tyseq (C.RECORDTy(I, tyrow_opt)) =
-	    C.RECORDTy(I, Option.map (replaceTyRow tyvarseq_tyseq) tyrow_opt)
+            C.RECORDTy(I, Option.map (replaceTyRow tyvarseq_tyseq) tyrow_opt)
 
       | replaceTy tyvarseq_tyseq (C.TYCONTy(I, tyseq', tycon)) =
-	    C.TYCONTy(I, replaceTyseq tyvarseq_tyseq tyseq', tycon)
+            C.TYCONTy(I, replaceTyseq tyvarseq_tyseq tyseq', tycon)
 
       | replaceTy tyvarseq_tyseq (C.ARROWTy(I, ty1, ty2)) =
-	    C.ARROWTy(I, replaceTy tyvarseq_tyseq ty1,
-			 replaceTy tyvarseq_tyseq ty2)
+            C.ARROWTy(I, replaceTy tyvarseq_tyseq ty1,
+                         replaceTy tyvarseq_tyseq ty2)
 
       | replaceTy tyvarseq_tyseq (C.PARTy(I, ty)) =
-	    C.PARTy(I, replaceTy tyvarseq_tyseq ty)
+            C.PARTy(I, replaceTy tyvarseq_tyseq ty)
 
     and replaceTyRow tyvarseq_tyseq (C.TyRow(I, lab, ty, tyrow_opt)) =
-	    C.TyRow(I, lab, replaceTy tyvarseq_tyseq ty, 
-		       Option.map (replaceTyRow tyvarseq_tyseq) tyrow_opt)
+            C.TyRow(I, lab, replaceTy tyvarseq_tyseq ty, 
+                       Option.map (replaceTyRow tyvarseq_tyseq) tyrow_opt)
 
-    and replaceTyseq tyvarseq_tyseq (C.Tyseq(I, tys)) =	  
-	    C.Tyseq(I, List.map (replaceTy tyvarseq_tyseq) tys)
+    and replaceTyseq tyvarseq_tyseq (C.Tyseq(I, tys)) =   
+            C.Tyseq(I, List.map (replaceTy tyvarseq_tyseq) tys)
 
 
     fun rewriteTy typbind (ty as C.TYVARTy _) = ty
 
       | rewriteTy typbind (C.RECORDTy(I, tyrow_opt)) =
-	    C.RECORDTy(I, Option.map (rewriteTyRow typbind) tyrow_opt)
+            C.RECORDTy(I, Option.map (rewriteTyRow typbind) tyrow_opt)
 
       | rewriteTy typbind (C.TYCONTy(I, tyseq, longtycon)) =
-	let 
-	    val tyseq'          = rewriteTyseq typbind tyseq
-	    val (strids, tycon) = LongTyCon.explode longtycon
-	in
-	    if not(List.null strids) then
-		C.TYCONTy(I, tyseq', longtycon)
-	    else
-		let 
-	            val (tyvarseq', ty') = lookupTyCon(tycon, typbind)
-		in
-		    replaceTy (tyvarseq',tyseq') ty'
-		end
-		handle Option => C.TYCONTy(I, tyseq', longtycon)
-	end
+        let 
+            val tyseq'          = rewriteTyseq typbind tyseq
+            val (strids, tycon) = LongTyCon.explode longtycon
+        in
+            if not(List.null strids) then
+                C.TYCONTy(I, tyseq', longtycon)
+            else
+                let 
+                    val (tyvarseq', ty') = lookupTyCon(tycon, typbind)
+                in
+                    replaceTy (tyvarseq',tyseq') ty'
+                end
+                handle Option => C.TYCONTy(I, tyseq', longtycon)
+        end
 
       | rewriteTy typbind (C.ARROWTy(I, ty1, ty2)) =
-	    C.ARROWTy(I, rewriteTy typbind ty1, rewriteTy typbind ty2)
+            C.ARROWTy(I, rewriteTy typbind ty1, rewriteTy typbind ty2)
 
       | rewriteTy typbind (C.PARTy(I, ty)) =
-	    C.PARTy(I, rewriteTy typbind ty)
+            C.PARTy(I, rewriteTy typbind ty)
 
     and rewriteTyRow typbind (C.TyRow(I, lab, ty, tyrow_opt)) =
-	    C.TyRow(I, lab, rewriteTy typbind ty,
-		       Option.map (rewriteTyRow typbind) tyrow_opt)
+            C.TyRow(I, lab, rewriteTy typbind ty,
+                       Option.map (rewriteTyRow typbind) tyrow_opt)
 
     and rewriteTyseq typbind (C.Tyseq(I, tys)) =
-	    C.Tyseq(I, List.map (rewriteTy typbind) tys)
+            C.Tyseq(I, List.map (rewriteTy typbind) tys)
 
     fun rewriteConBind typbind (C.ConBind(I, op_opt, vid, ty_opt, conbind_opt))=
-	    C.ConBind(I, op_opt, vid,
-			 Option.map (rewriteTy typbind) ty_opt,
-			 Option.map (rewriteConBind typbind) conbind_opt)
+            C.ConBind(I, op_opt, vid,
+                         Option.map (rewriteTy typbind) ty_opt,
+                         Option.map (rewriteConBind typbind) conbind_opt)
 
     fun rewriteDatBind typbind (C.DatBind(I, tyvarseq, tycon, conbind,
-							      datbind_opt)) =
-	    C.DatBind(I, tyvarseq, tycon, rewriteConBind typbind conbind,
-			 Option.map (rewriteDatBind typbind) datbind_opt)
+                                                              datbind_opt)) =
+            C.DatBind(I, tyvarseq, tycon, rewriteConBind typbind conbind,
+                         Option.map (rewriteDatBind typbind) datbind_opt)
 
 
     (* Patterns [Figure 16] *)
@@ -13370,39 +13370,39 @@
 
     fun TUPLEAtPat(I, [pat]) = C.PARAtPat(I, pat)
       | TUPLEAtPat(I,  pats) =
-	let
-	    fun toPatRow(n,    []     ) = NONE
-	      | toPatRow(n, pat::pats') =
-		  SOME(C.ROWPatRow(I, Lab.fromInt n, pat, toPatRow(n+1,pats')))
-	in
-	    C.RECORDAtPat(I, toPatRow(1, pats))
-	end
+        let
+            fun toPatRow(n,    []     ) = NONE
+              | toPatRow(n, pat::pats') =
+                  SOME(C.ROWPatRow(I, Lab.fromInt n, pat, toPatRow(n+1,pats')))
+        in
+            C.RECORDAtPat(I, toPatRow(1, pats))
+        end
 
     fun LISTAtPat(I, pats)  =
-	let
-	    fun toPatList    []       = NILPat(I)
-	      | toPatList(pat::pats') =
-		C.CONPat(I, C.SANSOp, longvidCONS,
-			     TUPLEAtPat(I, [pat,toPatList pats']))
-	in
-	    C.PARAtPat(I, toPatList pats)
-	end
+        let
+            fun toPatList    []       = NILPat(I)
+              | toPatList(pat::pats') =
+                C.CONPat(I, C.SANSOp, longvidCONS,
+                             TUPLEAtPat(I, [pat,toPatList pats']))
+        in
+            C.PARAtPat(I, toPatList pats)
+        end
 
 
     (* Pattern Rows [Figure 16] *)
 
     fun VIDPatRow(I, vid, ty_opt, pat_opt, patrow_opt) =
-	let
-	    val lab    = Lab.fromString(VId.toString vid)
-	    val vidPat = VIDPat(I, vid)
-	    val pat    =
-		case (ty_opt, pat_opt)
-		  of (NONE,    NONE) => vidPat
-		   | (SOME ty, NONE) => C.TYPEDPat(I, vidPat, ty)
-		   | ( _ , SOME pat) => C.ASPat(I, C.SANSOp,vid,ty_opt,pat)
-	in
-	    C.ROWPatRow(I, lab, pat, patrow_opt)
-	end
+        let
+            val lab    = Lab.fromString(VId.toString vid)
+            val vidPat = VIDPat(I, vid)
+            val pat    =
+                case (ty_opt, pat_opt)
+                  of (NONE,    NONE) => vidPat
+                   | (SOME ty, NONE) => C.TYPEDPat(I, vidPat, ty)
+                   | ( _ , SOME pat) => C.ASPat(I, C.SANSOp,vid,ty_opt,pat)
+        in
+            C.ROWPatRow(I, lab, pat, patrow_opt)
+        end
 
 
     (* Expressions [Figure 15] *)
@@ -13411,187 +13411,187 @@
 
     fun TUPLEAtExp(I, [exp]) = C.PARAtExp(I, exp)
       | TUPLEAtExp(I,  exps) =
-	let
-	    fun toExpRow(n,    []     ) = NONE
-	      | toExpRow(n, exp::exps') =
-		  SOME(C.ExpRow(I, Lab.fromInt n, exp, toExpRow(n+1, exps')))
-	in
-	    C.RECORDAtExp(I, toExpRow(1, exps))
-	end
+        let
+            fun toExpRow(n,    []     ) = NONE
+              | toExpRow(n, exp::exps') =
+                  SOME(C.ExpRow(I, Lab.fromInt n, exp, toExpRow(n+1, exps')))
+        in
+            C.RECORDAtExp(I, toExpRow(1, exps))
+        end
 
     fun HASHAtExp(I, lab) =
-	let
-	    val vid    = VId.invent()
-	    val dots   = C.WILDCARDPatRow(I)
-	    val patrow = C.ROWPatRow(I, lab, VIDPat(I, vid), SOME dots)
-	    val pat    = C.ATPATPat(I, C.RECORDAtPat(I, SOME patrow))
-	    val mrule  = C.Mrule(I, pat, VIDExp(I, vid))
-	    val match  = C.Match(I, mrule, NONE)
-	in
-	    C.PARAtExp(I, C.FNExp(I, match))
-	end
+        let
+            val vid    = VId.invent()
+            val dots   = C.WILDCARDPatRow(I)
+            val patrow = C.ROWPatRow(I, lab, VIDPat(I, vid), SOME dots)
+            val pat    = C.ATPATPat(I, C.RECORDAtPat(I, SOME patrow))
+            val mrule  = C.Mrule(I, pat, VIDExp(I, vid))
+            val match  = C.Match(I, mrule, NONE)
+        in
+            C.PARAtExp(I, C.FNExp(I, match))
+        end
 
     fun CASEExp(I, exp, match) =
-	let
-	    val function = C.ATEXPExp(I, C.PARAtExp(I, C.FNExp(I, match)))
-	in
-	    C.APPExp(I, function, C.PARAtExp(I, exp))
-	end
+        let
+            val function = C.ATEXPExp(I, C.PARAtExp(I, C.FNExp(I, match)))
+        in
+            C.APPExp(I, function, C.PARAtExp(I, exp))
+        end
 
     fun IFExp(I, exp1, exp2, exp3) =
-	let
-	    val mruleTrue  = C.Mrule(I, TRUEPat(I), exp2)
-	    val mruleFalse = C.Mrule(I, FALSEPat(I), exp3)
-	    val matchFalse = C.Match(I, mruleFalse, NONE)
-	    val matchTrue  = C.Match(I, mruleTrue, SOME matchFalse)
-	in
-	    CASEExp(I, exp1, matchTrue)
-	end
+        let
+            val mruleTrue  = C.Mrule(I, TRUEPat(I), exp2)
+            val mruleFalse = C.Mrule(I, FALSEPat(I), exp3)
+            val matchFalse = C.Match(I, mruleFalse, NONE)
+            val matchTrue  = C.Match(I, mruleTrue, SOME matchFalse)
+        in
+            CASEExp(I, exp1, matchTrue)
+        end
 
     fun ORELSEExp (I, exp1, exp2) = IFExp(I, exp1, TRUEExp(I), exp2)
 
     fun ANDALSOExp(I, exp1, exp2) = IFExp(I, exp1, exp2, FALSEExp(I))
 
     fun SEQAtExp(I, exps) =
-	let
-	    val wildcard             = C.ATPATPat(I, C.WILDCARDAtPat(I))
+        let
+            val wildcard             = C.ATPATPat(I, C.WILDCARDAtPat(I))
 
-	    fun toExpSeq []          = raise Fail "DerivedFormsCore.SEQAtExp: \
-						  \empty exp list"
-	      | toExpSeq [exp]       = exp
-	      | toExpSeq(exp::exps') =
-		  let
-		      val mrule = C.Mrule(I, wildcard, toExpSeq exps')
-		      val match = C.Match(I, mrule, NONE)
-		  in
-		      CASEExp(I, exp, match)
-		  end
-	in
-	    C.PARAtExp(I, toExpSeq exps)
-	end
+            fun toExpSeq []          = raise Fail "DerivedFormsCore.SEQAtExp: \
+                                                  \empty exp list"
+              | toExpSeq [exp]       = exp
+              | toExpSeq(exp::exps') =
+                  let
+                      val mrule = C.Mrule(I, wildcard, toExpSeq exps')
+                      val match = C.Match(I, mrule, NONE)
+                  in
+                      CASEExp(I, exp, match)
+                  end
+        in
+            C.PARAtExp(I, toExpSeq exps)
+        end
 
     fun LETAtExp(I, dec, [exp]) = C.LETAtExp(I, dec, exp)
       | LETAtExp(I, dec,  exps) =
-	    C.LETAtExp(I, dec, C.ATEXPExp(I, SEQAtExp(I, exps)))
+            C.LETAtExp(I, dec, C.ATEXPExp(I, SEQAtExp(I, exps)))
 
     fun WHILEExp(I, exp1, exp2) =
-	let
-	    val vid       = VId.invent()
-	    val vidExp    = VIDExp(I, vid)
-	    val unitAtExp = UNITAtExp(I)
-	    val unitExp   = C.ATEXPExp(I, unitAtExp)
-	    val callVid   = C.APPExp(I, vidExp, unitAtExp)
+        let
+            val vid       = VId.invent()
+            val vidExp    = VIDExp(I, vid)
+            val unitAtExp = UNITAtExp(I)
+            val unitExp   = C.ATEXPExp(I, unitAtExp)
+            val callVid   = C.APPExp(I, vidExp, unitAtExp)
 
-	    val seqExp    = C.ATEXPExp(I, SEQAtExp(I, [exp2, callVid]))
-	    val fnBody    = IFExp(I, exp1, seqExp, unitExp)
-	    val mrule     = C.Mrule(I, C.ATPATPat(I, UNITAtPat(I)), fnBody)
-	    val match     = C.Match(I, mrule, NONE)
-	    val fnExp     = C.FNExp(I, match)
-	    val fnBind    = C.PLAINValBind(I, VIDPat(I, vid), fnExp, NONE)
-	    val valbind   = C.RECValBind(I, fnBind)
-	    val dec       = C.VALDec(I, C.TyVarseq(I, []), valbind)
-	in
-	    C.ATEXPExp(I, C.LETAtExp(I, dec, callVid))
-	end
+            val seqExp    = C.ATEXPExp(I, SEQAtExp(I, [exp2, callVid]))
+            val fnBody    = IFExp(I, exp1, seqExp, unitExp)
+            val mrule     = C.Mrule(I, C.ATPATPat(I, UNITAtPat(I)), fnBody)
+            val match     = C.Match(I, mrule, NONE)
+            val fnExp     = C.FNExp(I, match)
+            val fnBind    = C.PLAINValBind(I, VIDPat(I, vid), fnExp, NONE)
+            val valbind   = C.RECValBind(I, fnBind)
+            val dec       = C.VALDec(I, C.TyVarseq(I, []), valbind)
+        in
+            C.ATEXPExp(I, C.LETAtExp(I, dec, callVid))
+        end
 
     fun LISTAtExp(I, exps) =
-	let
-	    fun toExpList    []       = NILExp(I)
-	      | toExpList(exp::exps') =
-		  C.APPExp(I, CONSExp(I), TUPLEAtExp(I, [exp, toExpList exps']))
-	in
-	    C.PARAtExp(I, toExpList exps)
-	end
+        let
+            fun toExpList    []       = NILExp(I)
+              | toExpList(exp::exps') =
+                  C.APPExp(I, CONSExp(I), TUPLEAtExp(I, [exp, toExpList exps']))
+        in
+            C.PARAtExp(I, toExpList exps)
+        end
 
 
     (* Type Expressions [Figure 16] *)
 
     fun TUPLETy(I, [ty]) = ty
       | TUPLETy(I,  tys) =
-	let
-	    fun toTyRow(n,   []    ) = NONE
-	      | toTyRow(n, ty::tys') =
-		  SOME(C.TyRow(I, Lab.fromInt n, ty, toTyRow(n+1, tys')))
-	in
-	    C.RECORDTy(I, toTyRow(1, tys))
-	end
+        let
+            fun toTyRow(n,   []    ) = NONE
+              | toTyRow(n, ty::tys') =
+                  SOME(C.TyRow(I, Lab.fromInt n, ty, toTyRow(n+1, tys')))
+        in
+            C.RECORDTy(I, toTyRow(1, tys))
+        end
 
 
     (* Function-value Bindings [Figure 17] *)
 
     fun FvalBind(I, (match, vid, arity), fvalbind_opt) =
-	let
-	    fun abstract(0, vidExps) =
-		let
-		    val exp = C.ATEXPExp(I, TUPLEAtExp(I, List.rev vidExps))
-		in
-		    CASEExp(I, exp, match)
-		end
+        let
+            fun abstract(0, vidExps) =
+                let
+                    val exp = C.ATEXPExp(I, TUPLEAtExp(I, List.rev vidExps))
+                in
+                    CASEExp(I, exp, match)
+                end
 
-	      | abstract(n, vidExps) =
-		let
-		    val vid   = VId.invent()
-		    val exp   = VIDExp(I, vid)
-		    val pat   = VIDPat(I, vid)
-		    val mrule = C.Mrule(I, pat, abstract(n-1, exp::vidExps))
-		in
-		    C.FNExp(I, C.Match(I, mrule, NONE))
-		end
+              | abstract(n, vidExps) =
+                let
+                    val vid   = VId.invent()
+                    val exp   = VIDExp(I, vid)
+                    val pat   = VIDPat(I, vid)
+                    val mrule = C.Mrule(I, pat, abstract(n-1, exp::vidExps))
+                in
+                    C.FNExp(I, C.Match(I, mrule, NONE))
+                end
 
-	    val exp = abstract(arity, [])
-	    val pat = VIDPat(I, vid)
-	in
-	    C.PLAINValBind(I, pat, exp, fvalbind_opt)
-	end
+            val exp = abstract(arity, [])
+            val pat = VIDPat(I, vid)
+        in
+            C.PLAINValBind(I, pat, exp, fvalbind_opt)
+        end
 
 
     fun Fmatch(I, (mrule, vid, arity), NONE) =
-	    ( C.Match(I, mrule, NONE), vid, arity )
+            ( C.Match(I, mrule, NONE), vid, arity )
 
       | Fmatch(I, (mrule, vid, arity), SOME(match, vid', arity')) =
-	    if vid <> vid' then
-		Error.error(I, "inconsistent function identifier")
-	     else if arity <> arity' then
-		Error.error(I, "inconsistent function arity")
-	     else
-		( C.Match(I, mrule, SOME match), vid, arity )
+            if vid <> vid' then
+                Error.error(I, "inconsistent function identifier")
+             else if arity <> arity' then
+                Error.error(I, "inconsistent function arity")
+             else
+                ( C.Match(I, mrule, SOME match), vid, arity )
 
 
     fun Fmrule(I, _, vid, atpats, ty_opt, exp) =
-	let
-	    val pats = List.map (fn atpat => C.ATPATPat(I, atpat)) atpats
-	    val pat' = C.ATPATPat(I, TUPLEAtPat(I, pats))
-	    val exp' = case ty_opt
-			 of NONE    => exp
-			  | SOME ty => C.TYPEDExp(I, exp, ty)
-	    val arity = List.length atpats
-	in
-	    ( C.Mrule(I, pat', exp'), vid, arity )
-	end
+        let
+            val pats = List.map (fn atpat => C.ATPATPat(I, atpat)) atpats
+            val pat' = C.ATPATPat(I, TUPLEAtPat(I, pats))
+            val exp' = case ty_opt
+                         of NONE    => exp
+                          | SOME ty => C.TYPEDExp(I, exp, ty)
+            val arity = List.length atpats
+        in
+            ( C.Mrule(I, pat', exp'), vid, arity )
+        end
 
 
     (* Declarations [Figure 17] *)
 
     fun FUNDec(I, tyvarseq, fvalbind) =
-	    C.VALDec(I, tyvarseq, C.RECValBind(I, fvalbind))
+            C.VALDec(I, tyvarseq, C.RECValBind(I, fvalbind))
 
     fun DATATYPEDec(I, datbind, NONE)         = C.DATATYPEDec(I, datbind)
       | DATATYPEDec(I, datbind, SOME typbind) =
-	let
-	    val datbind' = rewriteDatBind typbind datbind
-	in
-	    C.SEQDec(I, C.DATATYPEDec(C.infoDatBind datbind, datbind'),
-			C.TYPEDec(C.infoTypBind typbind, typbind))
-	end
+        let
+            val datbind' = rewriteDatBind typbind datbind
+        in
+            C.SEQDec(I, C.DATATYPEDec(C.infoDatBind datbind, datbind'),
+                        C.TYPEDec(C.infoTypBind typbind, typbind))
+        end
 
     fun ABSTYPEDec(I, datbind, NONE, dec)         = C.ABSTYPEDec(I, datbind,dec)
       | ABSTYPEDec(I, datbind, SOME typbind, dec) =
-	let
-	    val I'       = C.infoTypBind typbind
-	    val datbind' = rewriteDatBind typbind datbind
-	in
-	    C.ABSTYPEDec(I, datbind', C.SEQDec(I, C.TYPEDec(I', typbind), dec))
-	end
+        let
+            val I'       = C.infoTypBind typbind
+            val datbind' = rewriteDatBind typbind datbind
+        in
+            C.ABSTYPEDec(I, datbind', C.SEQDec(I, C.TYPEDec(I', typbind), dec))
+        end
 
   end
 (* stop of DerivedFormsCore.sml *)
@@ -13641,39 +13641,39 @@
     (* Structure Bindings [Figure 18] *)
 
     val TRANSStrBind:     Info * StrId * SigExp option * StrExp
-			       * StrBind option			-> StrBind
+                               * StrBind option                 -> StrBind
     val OPAQStrBind:      Info * StrId * SigExp * StrExp
-			       * StrBind option			-> StrBind
+                               * StrBind option                 -> StrBind
 
     (* Structure Expressions [Figure 18] *)
 
-    val APPDECStrExp:     Info * FunId * StrDec			-> StrExp
+    val APPDECStrExp:     Info * FunId * StrDec                 -> StrExp
 
     (* Functor Bindings [Figure 18] *)
 
     val TRANSFunBind:     Info * FunId * StrId * SigExp * SigExp option
-			       * StrExp * FunBind option	-> FunBind
+                               * StrExp * FunBind option        -> FunBind
     val OPAQFunBind:      Info * FunId * StrId * SigExp * SigExp
-			       * StrExp * FunBind option	-> FunBind
+                               * StrExp * FunBind option        -> FunBind
     val TRANSSPECFunBind: Info * FunId * Spec * SigExp option
-			       * StrExp * FunBind option	-> FunBind
+                               * StrExp * FunBind option        -> FunBind
     val OPAQSPECFunBind:  Info * FunId * Spec * SigExp
-                               * StrExp * FunBind option	-> FunBind
+                               * StrExp * FunBind option        -> FunBind
 
     (* Specifications [Figure 19] *)
 
-    val SYNSpec:          Info * SynDesc			-> Spec
-    val INCLUDEMULTISpec: Info * SigId list			-> Spec
+    val SYNSpec:          Info * SynDesc                        -> Spec
+    val INCLUDEMULTISpec: Info * SigId list                     -> Spec
 
     val SynDesc:          Info * TyVarseq * TyCon * Ty
-			       * SynDesc option			-> SynDesc
+                               * SynDesc option                 -> SynDesc
 
     (* Signature Expressions [Figure 19] *)
 
-    val WHERETYPESigExp:  Info * SigExp * TyReaDesc		-> SigExp
+    val WHERETYPESigExp:  Info * SigExp * TyReaDesc             -> SigExp
 
     val TyReaDesc:        Info * TyVarseq * longTyCon * Ty
-			       * TyReaDesc option		-> TyReaDesc
+                               * TyReaDesc option               -> TyReaDesc
   end
 (* stop of DERIVED_FORMS_MODULE.sml *)
 (* start of DerivedFormsModule.sml *)
@@ -13725,110 +13725,110 @@
     (* Structure Bindings [Figure 18] *)
 
     fun TRANSStrBind(I, strid, NONE, strexp, strbind_opt) =
-	    M.StrBind(I, strid, strexp, strbind_opt)
+            M.StrBind(I, strid, strexp, strbind_opt)
 
       | TRANSStrBind(I, strid, SOME sigexp, strexp, strbind_opt) =
-	    M.StrBind(I, strid, M.TRANSStrExp(I, strexp, sigexp), strbind_opt)
+            M.StrBind(I, strid, M.TRANSStrExp(I, strexp, sigexp), strbind_opt)
 
     fun OPAQStrBind(I, strid, sigexp, strexp, strbind_opt) =
-	    M.StrBind(I, strid, M.OPAQStrExp(I, strexp, sigexp), strbind_opt)
+            M.StrBind(I, strid, M.OPAQStrExp(I, strexp, sigexp), strbind_opt)
 
 
     (* Structure Expressions [Figure 18] *)
 
     fun APPDECStrExp(I, funid, strdec) =
-	    M.APPStrExp(I, funid, M.STRUCTStrExp(M.infoStrDec strdec, strdec))
+            M.APPStrExp(I, funid, M.STRUCTStrExp(M.infoStrDec strdec, strdec))
 
 
     (* Functor Bindings [Figure 18] *)
 
     fun TRANSFunBind(I, funid, strid, sigexp, NONE, strexp, funbind_opt) =
-	    M.FunBind(I, funid, strid, sigexp, strexp, funbind_opt)
+            M.FunBind(I, funid, strid, sigexp, strexp, funbind_opt)
 
       | TRANSFunBind(I, funid, strid,sigexp, SOME sigexp', strexp, funbind_opt)=
-	    M.FunBind(I, funid, strid, sigexp, M.TRANSStrExp(I, strexp,sigexp'),
-			 funbind_opt)
+            M.FunBind(I, funid, strid, sigexp, M.TRANSStrExp(I, strexp,sigexp'),
+                         funbind_opt)
 
     fun OPAQFunBind(I, funid, strid, sigexp, sigexp', strexp, funbind_opt) =
-	    M.FunBind(I, funid, strid, sigexp, M.OPAQStrExp(I, strexp, sigexp'),
-			 funbind_opt)
+            M.FunBind(I, funid, strid, sigexp, M.OPAQStrExp(I, strexp, sigexp'),
+                         funbind_opt)
 
 
     fun TRANSSPECFunBind(I, funid, spec, sigexp_opt, strexp, funbind_opt) =
-	let
-	    val I'     = M.infoStrExp strexp
-	    val strid  = StrId.invent()
-	    val sigexp = M.SIGSigExp(M.infoSpec spec, spec)
+        let
+            val I'     = M.infoStrExp strexp
+            val strid  = StrId.invent()
+            val sigexp = M.SIGSigExp(M.infoSpec spec, spec)
 
-	    val strdec = M.DECStrDec(I', C.OPENDec(I',[LongStrId.fromId strid]))
-	    val strexp'= case sigexp_opt
-			   of NONE         => strexp
-			    | SOME sigexp' => M.TRANSStrExp(I', strexp, sigexp')
-	    val letexp = M.LETStrExp(I', strdec, strexp')
-	in
-	    M.FunBind(I, funid, strid, sigexp, letexp, funbind_opt)
-	end
+            val strdec = M.DECStrDec(I', C.OPENDec(I',[LongStrId.fromId strid]))
+            val strexp'= case sigexp_opt
+                           of NONE         => strexp
+                            | SOME sigexp' => M.TRANSStrExp(I', strexp, sigexp')
+            val letexp = M.LETStrExp(I', strdec, strexp')
+        in
+            M.FunBind(I, funid, strid, sigexp, letexp, funbind_opt)
+        end
 
     fun OPAQSPECFunBind(I, funid, spec, sigexp', strexp, funbind_opt) =
-	let
-	    val I'     = M.infoStrExp strexp
-	    val strid  = StrId.invent()
-	    val sigexp = M.SIGSigExp(M.infoSpec spec, spec)
+        let
+            val I'     = M.infoStrExp strexp
+            val strid  = StrId.invent()
+            val sigexp = M.SIGSigExp(M.infoSpec spec, spec)
 
-	    val strdec = M.DECStrDec(I', C.OPENDec(I',[LongStrId.fromId strid]))
-	    val strexp'= M.TRANSStrExp(I', strexp, sigexp')
-	    val letexp = M.LETStrExp(I', strdec, strexp')
-	in
-	    M.FunBind(I, funid, strid, sigexp, letexp, funbind_opt)
-	end
+            val strdec = M.DECStrDec(I', C.OPENDec(I',[LongStrId.fromId strid]))
+            val strexp'= M.TRANSStrExp(I', strexp, sigexp')
+            val letexp = M.LETStrExp(I', strdec, strexp')
+        in
+            M.FunBind(I, funid, strid, sigexp, letexp, funbind_opt)
+        end
 
 
     (* Specifications [Figure 19] *)
 
     fun SYNSpec(I, [])                            = M.EMPTYSpec(I)
       | SYNSpec(I, (I',tyvarseq,tycon,ty)::syns') =
-	let
-	    val longtycon = LongTyCon.fromId tycon
-	    val typdesc = M.TypDesc(I', tyvarseq, tycon, NONE)
-	    val sigexp  = M.SIGSigExp(I', M.TYPESpec(I', typdesc))
-	    val sigexp' = M.WHERETYPESigExp(I', sigexp, tyvarseq, longtycon, ty)
-	    val spec1   = M.INCLUDESpec(I', sigexp')
-	in
-	    M.SEQSpec(I, spec1, SYNSpec(I, syns'))
-	end
+        let
+            val longtycon = LongTyCon.fromId tycon
+            val typdesc = M.TypDesc(I', tyvarseq, tycon, NONE)
+            val sigexp  = M.SIGSigExp(I', M.TYPESpec(I', typdesc))
+            val sigexp' = M.WHERETYPESigExp(I', sigexp, tyvarseq, longtycon, ty)
+            val spec1   = M.INCLUDESpec(I', sigexp')
+        in
+            M.SEQSpec(I, spec1, SYNSpec(I, syns'))
+        end
 
     fun INCLUDEMULTISpec(I,      []       ) = M.EMPTYSpec(I)
       | INCLUDEMULTISpec(I, sigid::sigids') =
-	let
-	    val spec1 = M.INCLUDESpec(I, M.SIGIDSigExp(I, sigid))
-	in
-	    M.SEQSpec(I, spec1, INCLUDEMULTISpec(I, sigids'))
-	end
+        let
+            val spec1 = M.INCLUDESpec(I, M.SIGIDSigExp(I, sigid))
+        in
+            M.SEQSpec(I, spec1, INCLUDEMULTISpec(I, sigids'))
+        end
 
 
     fun SynDesc(I, tyvarseq, tycon, ty, NONE) =
-	    (I, tyvarseq, tycon, ty) :: []
+            (I, tyvarseq, tycon, ty) :: []
 
       | SynDesc(I, tyvarseq, tycon, ty, SOME syndesc) =
-	    (I, tyvarseq, tycon, ty) :: syndesc
+            (I, tyvarseq, tycon, ty) :: syndesc
 
 
     (* Signature Expressions [Figure 19] *)
 
     fun WHERETYPESigExp(I, sigexp,                           []     ) = sigexp
       | WHERETYPESigExp(I, sigexp, (I',tyvarseq,longtycon,ty)::reas') =
-	let
-	    val sigexp' = M.WHERETYPESigExp(I', sigexp, tyvarseq, longtycon, ty)
-	in
-	    WHERETYPESigExp(I, sigexp', reas')
-	end
+        let
+            val sigexp' = M.WHERETYPESigExp(I', sigexp, tyvarseq, longtycon, ty)
+        in
+            WHERETYPESigExp(I, sigexp', reas')
+        end
 
 
     fun TyReaDesc(I, tyvarseq, longtycon, ty, NONE) =
-	    (I, tyvarseq, longtycon, ty) :: []
+            (I, tyvarseq, longtycon, ty) :: []
 
       | TyReaDesc(I, tyvarseq, longtycon, ty, SOME tyreadesc) =
-	    (I, tyvarseq, longtycon, ty) :: tyreadesc
+            (I, tyvarseq, longtycon, ty) :: tyreadesc
 
   end
 (* stop of DerivedFormsModule.sml *)
@@ -13854,8 +13854,8 @@
 
     (* Programs [Figure 18] *)
 
-    val TOPDECProgram:	Info * TopDec * Program option -> Program
-    val EXPProgram:	Info *  Exp   * Program option -> Program
+    val TOPDECProgram:  Info * TopDec * Program option -> Program
+    val EXPProgram:     Info *  Exp   * Program option -> Program
 
   end
 (* stop of DERIVED_FORMS_PROGRAM.sml *)
@@ -13886,18 +13886,18 @@
     (* Programs [Figure 18] *)
 
     fun TOPDECProgram(I, topdec, program_opt) =
-	    P.Program(I, topdec, program_opt)
+            P.Program(I, topdec, program_opt)
 
     fun EXPProgram(I, exp, program_opt) =
-	let
-	    val longvid = LongVId.fromId(VId.fromString "it")
-	    val pat     = C.ATPATPat(I, C.LONGVIDAtPat(I, C.SANSOp, longvid))
-	    val valbind = C.PLAINValBind(I, pat, exp, NONE)
-	    val dec     = C.VALDec(I, C.TyVarseq(I, []), valbind)
-	    val topdec  = M.STRDECTopDec(I, M.DECStrDec(I, dec), NONE)
-	in
-	    P.Program(I, topdec, program_opt)
-	end
+        let
+            val longvid = LongVId.fromId(VId.fromString "it")
+            val pat     = C.ATPATPat(I, C.LONGVIDAtPat(I, C.SANSOp, longvid))
+            val valbind = C.PLAINValBind(I, pat, exp, NONE)
+            val dec     = C.VALDec(I, C.TyVarseq(I, []), valbind)
+            val topdec  = M.STRDECTopDec(I, M.DECStrDec(I, dec), NONE)
+        in
+            P.Program(I, topdec, program_opt)
+        end
 
   end
 (* stop of DerivedFormsProgram.sml *)
@@ -13995,49 +13995,49 @@
 struct
 structure Header = 
 struct
-(*										*)
-(* Standard ML syntactical analysis						*)
-(*										*)
-(* Definition, sections 2, 3, and 8, Appendix A and B				*)
-(*										*)
-(* Notes:									*)
-(*   - Two phrases named Fmatch and Fmrule have been added to factorize		*)
-(*     Fvalbind.								*)
-(*   - A phrase named SynDesc has been added to factorize type synonym		*)
-(*     specifications. Similarly, a phrase named TyReaDesc has been added to	*)
-(*     factorize type realisation signature expressions.			*)
-(*   - Infix expressions [Definition, section 2.6] are resolved externally in	*)
-(*     structure Infix. The parser just maintains the infix environment J by	*)
-(*     side effect. To achieve correct treatment of scoped fixity directives,	*)
-(*     a stack of environments is used. To handle `local' we even need a	*)
-(*     second environment J' (together with a a second stack).			*)
-(*   - Syntactic restrictions [Definition, sections 2.9 and 3.5] are checked	*)
-(*     during elaboration, as well as the Fvalbind derived form.		*)
-(*   - The Definition is not clear about whether `=' should also be legal as	*)
-(*     a tycon. Since this would result in massive conflicts, and a type named	*)
-(*     `=' could only be used legally if an implementation would be mad enough	*)
-(*     to predefine it anyway, we simply disallow it.				*)
-(*   - The Definition is also vague about what consists a non-infixed occurance	*)
-(*     of an infix identifier: we assume any occurances in expressions		*)
-(*     or patterns. This implies that uses of the keyword `op' in constructor	*)
-(*     and exception bindings are completely redundant.				*)
-(*   - Datatype replication requires rules for datatype to be duplicated to	*)
-(*     avoid conflicts on empty tyvarseqs.					*)
-(*   - Layered patterns require some grammar transformation hack, see pat.	*)
-(*   - The messy `sigexp where type ... and type ...' syntax requires some	*)
-(*     really ugly transformations (in absence of a lookahead of 2), watch out	*)
-(*     for non-terminals of the form xxx__AND_yyybind_opt.			*)
-(*   - ML-Yacc does not seem to like comments that stretch over several		*)
-(*     lines... Similarly, comments in semantic actions make it puke...		*)
-(*										*)
-(* Bugs:									*)
-(*   - We do NOT support declarations like					*)
-(*	  fun f p1 = case e1 of p2 => e2					*)
-(*	    | f p3 = e3								*)
-(*     (without parentheses around the case) because the transformations	*)
-(*     required to support this would be even a magnitude uglier than those	*)
-(*     above. In fact, no compiler I know of supports this.			*)
-(*										*)
+(*                                                                              *)
+(* Standard ML syntactical analysis                                             *)
+(*                                                                              *)
+(* Definition, sections 2, 3, and 8, Appendix A and B                           *)
+(*                                                                              *)
+(* Notes:                                                                       *)
+(*   - Two phrases named Fmatch and Fmrule have been added to factorize         *)
+(*     Fvalbind.                                                                *)
+(*   - A phrase named SynDesc has been added to factorize type synonym          *)
+(*     specifications. Similarly, a phrase named TyReaDesc has been added to    *)
+(*     factorize type realisation signature expressions.                        *)
+(*   - Infix expressions [Definition, section 2.6] are resolved externally in   *)
+(*     structure Infix. The parser just maintains the infix environment J by    *)
+(*     side effect. To achieve correct treatment of scoped fixity directives,   *)
+(*     a stack of environments is used. To handle `local' we even need a        *)
+(*     second environment J' (together with a a second stack).                  *)
+(*   - Syntactic restrictions [Definition, sections 2.9 and 3.5] are checked    *)
+(*     during elaboration, as well as the Fvalbind derived form.                *)
+(*   - The Definition is not clear about whether `=' should also be legal as    *)
+(*     a tycon. Since this would result in massive conflicts, and a type named  *)
+(*     `=' could only be used legally if an implementation would be mad enough  *)
+(*     to predefine it anyway, we simply disallow it.                           *)
+(*   - The Definition is also vague about what consists a non-infixed occurance *)
+(*     of an infix identifier: we assume any occurances in expressions          *)
+(*     or patterns. This implies that uses of the keyword `op' in constructor   *)
+(*     and exception bindings are completely redundant.                         *)
+(*   - Datatype replication requires rules for datatype to be duplicated to     *)
+(*     avoid conflicts on empty tyvarseqs.                                      *)
+(*   - Layered patterns require some grammar transformation hack, see pat.      *)
+(*   - The messy `sigexp where type ... and type ...' syntax requires some      *)
+(*     really ugly transformations (in absence of a lookahead of 2), watch out  *)
+(*     for non-terminals of the form xxx__AND_yyybind_opt.                      *)
+(*   - ML-Yacc does not seem to like comments that stretch over several         *)
+(*     lines... Similarly, comments in semantic actions make it puke...         *)
+(*                                                                              *)
+(* Bugs:                                                                        *)
+(*   - We do NOT support declarations like                                      *)
+(*        fun f p1 = case e1 of p2 => e2                                        *)
+(*          | f p3 = e3                                                         *)
+(*     (without parentheses around the case) because the transformations        *)
+(*     required to support this would be even a magnitude uglier than those     *)
+(*     above. In fact, no compiler I know of supports this.                     *)
+(*                                                                              *)
 
 
 
@@ -14058,74 +14058,74 @@
 
     (* Handling infix environments *)
 
-    val J  = ref Infix.empty	(* context *)
-    val J' = ref Infix.empty	(* local environment (+ enclosing one) *)
+    val J  = ref Infix.empty    (* context *)
+    val J' = ref Infix.empty    (* local environment (+ enclosing one) *)
 
     val stackJ  = ref [] : Infix.InfEnv list ref
     val stackJ' = ref [] : Infix.InfEnv list ref
 
     fun initJandJ'(J0) =
-	(
-	    J       := J0;
-	    J'      := J0;
-	    stackJ  := [];
-	    stackJ' := []
-	)
+        (
+            J       := J0;
+            J'      := J0;
+            stackJ  := [];
+            stackJ' := []
+        )
 
     fun pushJ() =
-	(
-	    stackJ  := !J :: !stackJ
-	)
+        (
+            stackJ  := !J :: !stackJ
+        )
 
     fun popJ() =
-	(
-	    J       := List.hd(!stackJ);
-	    stackJ  := List.tl(!stackJ)
-	)
+        (
+            J       := List.hd(!stackJ);
+            stackJ  := List.tl(!stackJ)
+        )
 
     fun pushJ'shiftJ() =
-	(
-	    stackJ' := !J' :: !stackJ';
-	    J'      := List.hd(!stackJ)
-	)
+        (
+            stackJ' := !J' :: !stackJ';
+            J'      := List.hd(!stackJ)
+        )
 
     fun popJandJ'() =
-	(
-	    J       := !J';
-	    J'      := List.hd(!stackJ');
-	    stackJ  := List.tl(!stackJ);
-	    stackJ' := List.tl(!stackJ')
-	)
+        (
+            J       := !J';
+            J'      := List.hd(!stackJ');
+            stackJ  := List.tl(!stackJ);
+            stackJ' := List.tl(!stackJ')
+        )
 
 
     fun assignInfix(infstatus, vids) =
-	(
-	    J  := Infix.assign(!J, vids, infstatus);
-	    J' := Infix.assign(!J', vids, infstatus)
-	)
+        (
+            J  := Infix.assign(!J, vids, infstatus);
+            J' := Infix.assign(!J', vids, infstatus)
+        )
 
     fun cancelInfix(vids) =
-	(
-	    J  := Infix.cancel(!J, vids);
-	    J' := Infix.cancel(!J', vids)
-	)
+        (
+            J  := Infix.cancel(!J, vids);
+            J' := Infix.cancel(!J', vids)
+        )
 
 
     (* Helper for long identifiers *)
 
     fun toLongId toId (strids, id) =
-	    ( List.map StrId.fromString strids, toId id )
+            ( List.map StrId.fromString strids, toId id )
 
 
     (* Helper to handle typed patterns (needed because of layered patterns) *)
 
     fun typedPat(pat,   []   ) = pat
       | typedPat(pat, ty::tys) =
-	let
-	    val I = Source.over(infoPat pat, infoTy ty)
-	in
-	    typedPat(TYPEDPat(I, pat, ty), tys)
-	end
+        let
+            val I = Source.over(infoPat pat, infoTy ty)
+        in
+            typedPat(TYPEDPat(I, pat, ty), tys)
+        end
 
 
 
@@ -16167,7 +16167,7 @@
 val longvid as longvid1=longvid1 ()
  in (
  LONGVIDAtExp(I(OP_optleft,longvidright),
-				       OP_opt, longvid) 
+                                       OP_opt, longvid) 
 ) end
 )
  in (LrTable.NT 15,(result,OP_opt1left,longvid1right),rest671) end
@@ -16200,7 +16200,7 @@
 LBRACK1left,_))::rest671) => let val result=MlyValue.atexp(fn _ => 
 let val exp_COMMA_list0 as exp_COMMA_list01=exp_COMMA_list01 ()
  in ( LISTAtExp(I(LBRACKleft,RBRACKright),
-				    exp_COMMA_list0 ))
+                                    exp_COMMA_list0 ))
  end
 )
  in (LrTable.NT 15,(result,LBRACK1left,RBRACK1right),rest671) end
@@ -16222,7 +16222,7 @@
 ()
 val popInfix1=popInfix1 ()
  in ( LETAtExp(I(LETleft,ENDright),
-				   dec, exp_SEMICOLON_list1) )
+                                   dec, exp_SEMICOLON_list1) )
  end
 )
  in (LrTable.NT 15,(result,LET1left,END1right),rest671) end
@@ -16307,7 +16307,7 @@
 val COMMA_exprow_opt as COMMA_exprow_opt1=COMMA_exprow_opt1 ()
  in (
  ExpRow(I(lableft,COMMA_exprow_optright),
-	  				 lab, exp, COMMA_exprow_opt) 
+                                         lab, exp, COMMA_exprow_opt) 
 ) end
 )
  in (LrTable.NT 21,(result,lab1left,COMMA_exprow_opt1right),rest671)
@@ -16423,7 +16423,7 @@
 val BAR_match_opt as BAR_match_opt1=BAR_match_opt1 ()
  in (
  Match(I(mruleleft,BAR_match_optright),
-					mrule, BAR_match_opt) )
+                                        mrule, BAR_match_opt) )
  end
 )
  in (LrTable.NT 27,(result,mrule1left,BAR_match_opt1right),rest671)
@@ -16486,7 +16486,7 @@
 MlyValue.dec1'(fn _ => let val valbind as valbind1=valbind1 ()
  in (
  VALDec(I(VALleft,valbindright),
-			     TyVarseq(I(defaultPos,defaultPos), []), valbind) 
+                             TyVarseq(I(defaultPos,defaultPos), []), valbind) 
 ) end
 )
  in (LrTable.NT 32,(result,VAL1left,valbind1right),rest671) end
@@ -16504,7 +16504,7 @@
 ()
  in (
  FUNDec(I(FUNleft,fvalbindright),
-			    TyVarseq(I(defaultPos,defaultPos), []), fvalbind) 
+                            TyVarseq(I(defaultPos,defaultPos), []), fvalbind) 
 ) end
 )
  in (LrTable.NT 32,(result,FUN1left,fvalbind1right),rest671) end
@@ -16531,7 +16531,7 @@
 WITHTYPE_typbind_opt1 ()
  in (
  DATATYPEDec(I(DATATYPEleft,WITHTYPE_typbind_optright),
-				     datbind0, WITHTYPE_typbind_opt) 
+                                     datbind0, WITHTYPE_typbind_opt) 
 ) end
 )
  in (LrTable.NT 32,(result,DATATYPE1left,WITHTYPE_typbind_opt1right),
@@ -16545,7 +16545,7 @@
 WITHTYPE_typbind_opt1 ()
  in (
  DATATYPEDec(I(DATATYPEleft,WITHTYPE_typbind_optright),
-				      datbind1, WITHTYPE_typbind_opt) 
+                                      datbind1, WITHTYPE_typbind_opt) 
 ) end
 )
  in (LrTable.NT 32,(result,DATATYPE1left,WITHTYPE_typbind_opt1right),
@@ -16557,7 +16557,7 @@
 val longtycon as longtycon1=longtycon1 ()
  in (
  REPLICATIONDec(I(DATATYPEleft,longtyconright),
-					 tycon, longtycon) 
+                                         tycon, longtycon) 
 ) end
 )
  in (LrTable.NT 32,(result,DATATYPE1left,longtycon1right),rest671) end
@@ -16571,7 +16571,7 @@
 val dec as dec1=dec1 ()
  in (
  ABSTYPEDec(I(ABSTYPEleft,ENDright), datbind,
-				     WITHTYPE_typbind_opt, dec) 
+                                     WITHTYPE_typbind_opt, dec) 
 ) end
 )
  in (LrTable.NT 32,(result,ABSTYPE1left,END1right),rest671) end
@@ -16587,7 +16587,7 @@
 val longstrid_list1 as longstrid_list11=longstrid_list11 ()
  in (
  OPENDec(I(OPENleft,longstrid_list1right),
-				  longstrid_list1) )
+                                  longstrid_list1) )
  end
 )
  in (LrTable.NT 32,(result,OPEN1left,longstrid_list11right),rest671)
@@ -16599,7 +16599,7 @@
 val vid_list1 as vid_list11=vid_list11 ()
  in (
  assignInfix((Infix.LEFT, d_opt), vid_list1);
-			  EMPTYDec(I(INFIXleft,vid_list1right)) 
+                          EMPTYDec(I(INFIXleft,vid_list1right)) 
 ) end
 )
  in (LrTable.NT 32,(result,INFIX1left,vid_list11right),rest671) end
@@ -16610,7 +16610,7 @@
 val vid_list1 as vid_list11=vid_list11 ()
  in (
  assignInfix((Infix.RIGHT, d_opt), vid_list1);
-			  EMPTYDec(I(INFIXRleft,vid_list1right)) 
+                          EMPTYDec(I(INFIXRleft,vid_list1right)) 
 ) end
 )
  in (LrTable.NT 32,(result,INFIXR1left,vid_list11right),rest671) end
@@ -16620,7 +16620,7 @@
 vid_list11 ()
  in (
  cancelInfix(vid_list1);
-			  EMPTYDec(I(NONFIXleft,vid_list1right)) )
+                          EMPTYDec(I(NONFIXleft,vid_list1right)) )
  end
 )
  in (LrTable.NT 32,(result,NONFIX1left,vid_list11right),rest671) end
@@ -16678,7 +16678,7 @@
 val AND_valbind_opt as AND_valbind_opt1=AND_valbind_opt1 ()
  in (
  PLAINValBind(I(patleft,AND_valbind_optright),
-				       pat, exp, AND_valbind_opt) 
+                                       pat, exp, AND_valbind_opt) 
 ) end
 )
  in (LrTable.NT 37,(result,pat1left,AND_valbind_opt1right),rest671)
@@ -16705,7 +16705,7 @@
 val AND_fvalbind_opt as AND_fvalbind_opt1=AND_fvalbind_opt1 ()
  in (
  FvalBind(I(fmatchleft,AND_fvalbind_optright),
-				     fmatch, AND_fvalbind_opt) 
+                                     fmatch, AND_fvalbind_opt) 
 ) end
 )
  in (LrTable.NT 39,(result,fmatch1left,AND_fvalbind_opt1right),rest671
@@ -16726,7 +16726,7 @@
 val BAR_fmatch_opt as BAR_fmatch_opt1=BAR_fmatch_opt1 ()
  in (
  Fmatch(I(fmruleleft,BAR_fmatch_optright),
-				 fmrule, BAR_fmatch_opt) 
+                                 fmrule, BAR_fmatch_opt) 
 ) end
 )
  in (LrTable.NT 41,(result,fmrule1left,BAR_fmatch_opt1right),rest671)
@@ -16749,12 +16749,12 @@
 val exp as exp1=exp1 ()
  in (
  let
-			    val (op_opt, vid, atpats) =
-				Infix.parseFmrule(!J, atpat_list1)
-			  in
-			    Fmrule(I(atpat_list1left,expright),
-				   op_opt, vid, atpats, COLON_ty_opt, exp)
-			  end 
+                            val (op_opt, vid, atpats) =
+                                Infix.parseFmrule(!J, atpat_list1)
+                          in
+                            Fmrule(I(atpat_list1left,expright),
+                                   op_opt, vid, atpats, COLON_ty_opt, exp)
+                          end 
 ) end
 )
  in (LrTable.NT 43,(result,atpat_list11left,exp1right),rest671) end
@@ -16769,7 +16769,7 @@
 val AND_typbind_opt as AND_typbind_opt1=AND_typbind_opt1 ()
  in (
  TypBind(I(tyvarseqleft,AND_typbind_optright),
-				  tyvarseq, tycon, ty, AND_typbind_opt) 
+                                  tyvarseq, tycon, ty, AND_typbind_opt) 
 ) end
 )
  in (LrTable.NT 44,(result,tyvarseq1left,AND_typbind_opt1right),
@@ -16794,7 +16794,7 @@
 val AND_datbind_opt as AND_datbind_opt1=AND_datbind_opt1 ()
  in (
  DatBind(I(tyvarseqleft,AND_datbind_optright),
-				  tyvarseq, tycon, conbind, AND_datbind_opt) 
+                                  tyvarseq, tycon, conbind, AND_datbind_opt) 
 ) end
 )
  in (LrTable.NT 46,(result,tyvarseq1left,AND_datbind_opt1right),
@@ -16808,8 +16808,8 @@
 val AND_datbind_opt as AND_datbind_opt1=AND_datbind_opt1 ()
  in (
  DatBind(I(tyconleft,AND_datbind_optright),
-				  TyVarseq(I(defaultPos,defaultPos), []),
-				  tycon, conbind, AND_datbind_opt) 
+                                  TyVarseq(I(defaultPos,defaultPos), []),
+                                  tycon, conbind, AND_datbind_opt) 
 ) end
 )
  in (LrTable.NT 47,(result,tycon1left,AND_datbind_opt1right),rest671)
@@ -16825,7 +16825,7 @@
 val AND_datbind_opt as AND_datbind_opt1=AND_datbind_opt1 ()
  in (
  DatBind(I(tyvarseq1left,AND_datbind_optright),
-				  tyvarseq1, tycon, conbind, AND_datbind_opt) 
+                                  tyvarseq1, tycon, conbind, AND_datbind_opt) 
 ) end
 )
  in (LrTable.NT 48,(result,tyvarseq11left,AND_datbind_opt1right),
@@ -16850,7 +16850,7 @@
 val BAR_conbind_opt as BAR_conbind_opt1=BAR_conbind_opt1 ()
  in (
  ConBind(I(OP_optleft,BAR_conbind_optright),
-				  OP_opt, vid', OF_ty_opt, BAR_conbind_opt) 
+                                  OP_opt, vid', OF_ty_opt, BAR_conbind_opt) 
 ) end
 )
  in (LrTable.NT 50,(result,OP_opt1left,BAR_conbind_opt1right),rest671)
@@ -16881,7 +16881,7 @@
 val AND_exbind_opt as AND_exbind_opt1=AND_exbind_opt1 ()
  in (
  NEWExBind(I(OP_optleft,AND_exbind_optright),
-				    OP_opt, vid', OF_ty_opt, AND_exbind_opt) 
+                                    OP_opt, vid', OF_ty_opt, AND_exbind_opt) 
 ) end
 )
  in (LrTable.NT 53,(result,OP_opt1left,AND_exbind_opt1right),rest671)
@@ -16898,8 +16898,8 @@
 val AND_exbind_opt as AND_exbind_opt1=AND_exbind_opt1 ()
  in (
  EQUALExBind(I(OP_opt1left,AND_exbind_optright),
-				      OP_opt1, vid', OP_opt2, longvid,
-				      AND_exbind_opt) 
+                                      OP_opt1, vid', OP_opt2, longvid,
+                                      AND_exbind_opt) 
 ) end
 )
  in (LrTable.NT 53,(result,OP_opt1left,AND_exbind_opt1right),rest671)
@@ -16926,7 +16926,7 @@
 val longvid' as longvid'1=longvid'1 ()
  in (
  LONGVIDAtPat(I(OP_optleft,longvid'right),
-				       OP_opt, longvid') 
+                                       OP_opt, longvid') 
 ) end
 )
  in (LrTable.NT 55,(result,OP_opt1left,longvid'1right),rest671) end
@@ -16963,7 +16963,7 @@
 LBRACK1left,_))::rest671) => let val result=MlyValue.atpat'(fn _ => 
 let val pat_COMMA_list0 as pat_COMMA_list01=pat_COMMA_list01 ()
  in ( LISTAtPat(I(LBRACKleft,RBRACKright),
-				    pat_COMMA_list0) )
+                                    pat_COMMA_list0) )
  end
 )
  in (LrTable.NT 56,(result,LBRACK1left,RBRACK1right),rest671) end
@@ -17020,7 +17020,7 @@
 val COMMA_patrow_opt as COMMA_patrow_opt1=COMMA_patrow_opt1 ()
  in (
  ROWPatRow(I(lableft,COMMA_patrow_optright),
-				      lab, pat, COMMA_patrow_opt) 
+                                      lab, pat, COMMA_patrow_opt) 
 ) end
 )
  in (LrTable.NT 60,(result,lab1left,COMMA_patrow_opt1right),rest671)
@@ -17036,8 +17036,8 @@
 val COMMA_patrow_opt as COMMA_patrow_opt1=COMMA_patrow_opt1 ()
  in (
  VIDPatRow(I(vid'left,COMMA_patrow_optright),
-				    vid', COLON_ty_opt, AS_pat_opt,
-				    COMMA_patrow_opt) 
+                                    vid', COLON_ty_opt, AS_pat_opt,
+                                    COMMA_patrow_opt) 
 ) end
 )
  in (LrTable.NT 60,(result,vid'1left,COMMA_patrow_opt1right),rest671)
@@ -17098,7 +17098,7 @@
 val COLON_ty_list1 as COLON_ty_list11=COLON_ty_list11 ()
  in (
  let val pat = Infix.parsePat(!J, [atpat'])
-			  in typedPat(pat, COLON_ty_list1) end 
+                          in typedPat(pat, COLON_ty_list1) end 
 ) end
 )
  in (LrTable.NT 65,(result,atpat'1left,COLON_ty_list11right),rest671)
@@ -17110,7 +17110,7 @@
 val COLON_ty_list1 as COLON_ty_list11=COLON_ty_list11 ()
  in (
  let val pat = Infix.parsePat(!J, atpat_list2)
-			  in typedPat(pat, COLON_ty_list1) end 
+                          in typedPat(pat, COLON_ty_list1) end 
 ) end
 )
  in (LrTable.NT 65,(result,atpat_list21left,COLON_ty_list11right),
@@ -17124,10 +17124,10 @@
 val COLON_ty_list1 as COLON_ty_list11=COLON_ty_list11 ()
  in (
  let val atpat = LONGVIDAtPat(I(OP_optleft,vid'right),
-						       OP_opt,
-						       LongVId.fromId vid')
-			      val pat   = Infix.parsePat(!J, [atpat])
-			  in typedPat(pat, COLON_ty_list1) end 
+                                                       OP_opt,
+                                                       LongVId.fromId vid')
+                              val pat   = Infix.parsePat(!J, [atpat])
+                          in typedPat(pat, COLON_ty_list1) end 
 ) end
 )
  in (LrTable.NT 65,(result,OP_opt1left,COLON_ty_list11right),rest671)
@@ -17141,11 +17141,11 @@
 val COLON_ty_list1 as COLON_ty_list11=COLON_ty_list11 ()
  in (
  let val longvid = LongVId.implode
-						(toLongId VId.fromString LONGID)
-			      val atpat = LONGVIDAtPat(I(OP_optleft,LONGIDright),
-						       OP_opt, longvid)
-			      val pat   = Infix.parsePat(!J, [atpat])
-			  in typedPat(pat, COLON_ty_list1) end 
+                                                (toLongId VId.fromString LONGID)
+                              val atpat = LONGVIDAtPat(I(OP_optleft,LONGIDright),
+                                                       OP_opt, longvid)
+                              val pat   = Infix.parsePat(!J, [atpat])
+                          in typedPat(pat, COLON_ty_list1) end 
 ) end
 )
  in (LrTable.NT 65,(result,OP_opt1left,COLON_ty_list11right),rest671)
@@ -17160,11 +17160,11 @@
 val pat as pat1=pat1 ()
  in (
  Infix.parsePat(!J,
-				 [ LONGVIDAtPat(I(OP_optleft,vid'right),
-						OP_opt,
-						LongVId.implode([],vid')) ] ) ;
-			  ASPat(I(OP_optleft,patright),
-				OP_opt, vid', COLON_ty_opt, pat) 
+                                 [ LONGVIDAtPat(I(OP_optleft,vid'right),
+                                                OP_opt,
+                                                LongVId.implode([],vid')) ] ) ;
+                          ASPat(I(OP_optleft,patright),
+                                OP_opt, vid', COLON_ty_opt, pat) 
 ) end
 )
  in (LrTable.NT 65,(result,OP_opt1left,pat1right),rest671) end
@@ -17222,7 +17222,7 @@
 ty_STAR_list1=ty_STAR_list1 ()
  in (
  TUPLETy(I(ty_STAR_listleft,ty_STAR_listright),
-				   ty_STAR_list) )
+                                   ty_STAR_list) )
  end
 )
  in (LrTable.NT 70,(result,ty_STAR_list1left,ty_STAR_list1right),
@@ -17253,7 +17253,7 @@
  as tyseq1=tyseq1 ()
 val longtycon as longtycon1=longtycon1 ()
  in ( TYCONTy(I(tyseqleft,longtyconright),
-					  tyseq, longtycon) )
+                                          tyseq, longtycon) )
  end
 )
  in (LrTable.NT 72,(result,tyseq1left,longtycon1right),rest671) end
@@ -17284,7 +17284,7 @@
 val COMMA_tyrow_opt as COMMA_tyrow_opt1=COMMA_tyrow_opt1 ()
  in (
  TyRow(I(lableft,COMMA_tyrow_optright),
-				lab, ty, COMMA_tyrow_opt) 
+                                lab, ty, COMMA_tyrow_opt) 
 ) end
 )
  in (LrTable.NT 74,(result,lab1left,COMMA_tyrow_opt1right),rest671)
@@ -17310,7 +17310,7 @@
 constyright as consty1right))::rest671) => let val result=
 MlyValue.tyseq(fn _ => let val consty as consty1=consty1 ()
  in ( Tyseq(I(constyleft,constyright),
-						[consty]) ) end
+                                                [consty]) ) end
 )
  in (LrTable.NT 77,(result,consty1left,consty1right),rest671) end
 | (191,rest671) => let val result=MlyValue.tyseq(fn _ => (
@@ -17321,7 +17321,7 @@
 let val result=MlyValue.tyseq(fn _ => let val ty_COMMA_list2 as 
 ty_COMMA_list21=ty_COMMA_list21 ()
  in ( Tyseq(I(LPARleft,RPARright),
-						ty_COMMA_list2) ) end
+                                                ty_COMMA_list2) ) end
 )
  in (LrTable.NT 77,(result,LPAR1left,RPAR1right),rest671) end
 | (193,(_,(MlyValue.ty_COMMA_list2 ty_COMMA_list21,_,
@@ -17348,13 +17348,13 @@
  end
 | (196,rest671) => let val result=MlyValue.tyvarseq(fn _ => (
  TyVarseq(I(defaultPos,defaultPos),
-						   []) ))
+                                                   []) ))
  in (LrTable.NT 79,(result,defaultPos,defaultPos),rest671) end
 | (197,(_,(MlyValue.tyvar tyvar1,tyvarleft as tyvar1left,tyvarright
  as tyvar1right))::rest671) => let val result=MlyValue.tyvarseq1(fn _
  => let val tyvar as tyvar1=tyvar1 ()
  in ( TyVarseq(I(tyvarleft,tyvarright),
-						   [tyvar]) ) end
+                                                   [tyvar]) ) end
 )
  in (LrTable.NT 80,(result,tyvar1left,tyvar1right),rest671) end
 | (198,(_,(_,_,RPARright as RPAR1right))::(_,(
@@ -17363,7 +17363,7 @@
  => let val tyvar_COMMA_list1 as tyvar_COMMA_list11=tyvar_COMMA_list11
  ()
  in ( TyVarseq(I(LPARleft,RPARright),
-						   tyvar_COMMA_list1) )
+                                                   tyvar_COMMA_list1) )
  end
 )
  in (LrTable.NT 80,(result,LPAR1left,RPAR1right),rest671) end
@@ -17395,7 +17395,7 @@
 val sigexp as sigexp1=sigexp1 ()
  in (
  TRANSStrExp(I(strexpleft,sigexpright),
-				      strexp, sigexp) )
+                                      strexp, sigexp) )
  end
 )
  in (LrTable.NT 82,(result,strexp1left,sigexp1right),rest671) end
@@ -17423,7 +17423,7 @@
 longstrid1 ()
  in (
  LONGSTRIDStrExp(I(longstridleft,longstridright),
-					  longstrid) )
+                                          longstrid) )
  end
 )
  in (LrTable.NT 83,(result,longstrid1left,longstrid1right),rest671)
@@ -17476,7 +17476,7 @@
 val strdec12=strdec12 ()
  in (
  SEQStrDec(I(strdec11left,strdec12right),
-				    strdec11, strdec12) 
+                                    strdec11, strdec12) 
 ) end
 )
  in (LrTable.NT 85,(result,strdec11left,strdec12right),rest671) end
@@ -17496,7 +17496,7 @@
 result=MlyValue.strdec1'(fn _ => let val strbind as strbind1=strbind1 
 ()
  in ( STRUCTUREStrDec(I(STRUCTUREleft,strbindright),
-					  strbind) )
+                                          strbind) )
  end
 )
  in (LrTable.NT 86,(result,STRUCTURE1left,strbind1right),rest671) end
@@ -17523,10 +17523,10 @@
 strexp__AND_strbind_opt1 ()
  in (
  TRANSStrBind(I(stridleft,
-					 strexp__AND_strbind_optright),
-				       strid, COLON_sigexp_opt,
-				       #1 strexp__AND_strbind_opt,
-				       #2 strexp__AND_strbind_opt) 
+                                         strexp__AND_strbind_optright),
+                                       strid, COLON_sigexp_opt,
+                                       #1 strexp__AND_strbind_opt,
+                                       #2 strexp__AND_strbind_opt) 
 ) end
 )
  in (LrTable.NT 87,(result,strid1left,strexp__AND_strbind_opt1right),
@@ -17541,8 +17541,8 @@
 strexp__AND_strbind_opt1 ()
  in (
  OPAQStrBind(I(stridleft,strexp__AND_strbind_optright),
-				      strid, sigexp, #1 strexp__AND_strbind_opt,
-				      #2 strexp__AND_strbind_opt) 
+                                      strid, sigexp, #1 strexp__AND_strbind_opt,
+                                      #2 strexp__AND_strbind_opt) 
 ) end
 )
  in (LrTable.NT 87,(result,strid1left,strexp__AND_strbind_opt1right),
@@ -17574,9 +17574,9 @@
 sigexp__AND_strbind_opt1 ()
  in (
  ( TRANSStrExp(I(strexpleft,
-					  sigexp__AND_strbind_optright),
-					strexp, #1 sigexp__AND_strbind_opt),
-			    #2 sigexp__AND_strbind_opt ) 
+                                          sigexp__AND_strbind_optright),
+                                        strexp, #1 sigexp__AND_strbind_opt),
+                            #2 sigexp__AND_strbind_opt ) 
 ) end
 )
  in (LrTable.NT 89,(result,strexp1left,sigexp__AND_strbind_opt1right),
@@ -17590,9 +17590,9 @@
 sigexp__AND_strbind_opt1 ()
  in (
  ( OPAQStrExp(I(strexpleft,
-					 sigexp__AND_strbind_optright),
-				       strexp, #1 sigexp__AND_strbind_opt),
-			    #2 sigexp__AND_strbind_opt ) 
+                                         sigexp__AND_strbind_optright),
+                                       strexp, #1 sigexp__AND_strbind_opt),
+                            #2 sigexp__AND_strbind_opt ) 
 ) end
 )
  in (LrTable.NT 89,(result,strexp1left,sigexp__AND_strbind_opt1right),
@@ -17616,10 +17616,10 @@
 tyreadesc__AND_strbind_opt1 ()
  in (
  ( WHERETYPESigExp(I(sigexpleft,
-					      tyreadesc__AND_strbind_optright),
-					   sigexp,
-					   #1 tyreadesc__AND_strbind_opt),
-			    #2 tyreadesc__AND_strbind_opt ) 
+                                              tyreadesc__AND_strbind_optright),
+                                           sigexp,
+                                           #1 tyreadesc__AND_strbind_opt),
+                            #2 tyreadesc__AND_strbind_opt ) 
 ) end
 )
  in (LrTable.NT 90,(result,sigexp1left,
@@ -17639,10 +17639,10 @@
 AND_tyreadesc_opt__AND_strbind_opt1 ()
  in (
  ( TyReaDesc(I(TYPEleft,
-				       AND_tyreadesc_opt__AND_strbind_optright),
-				      tyvarseq, longtycon, ty,
-				      #1 AND_tyreadesc_opt__AND_strbind_opt),
-			    #2 AND_tyreadesc_opt__AND_strbind_opt ) 
+                                       AND_tyreadesc_opt__AND_strbind_optright),
+                                      tyvarseq, longtycon, ty,
+                                      #1 AND_tyreadesc_opt__AND_strbind_opt),
+                            #2 AND_tyreadesc_opt__AND_strbind_opt ) 
 ) end
 )
  in (LrTable.NT 91,(result,TYPE1left,
@@ -17663,7 +17663,7 @@
 tyreadesc__AND_strbind_opt1 ()
  in (
  ( SOME(#1 tyreadesc__AND_strbind_opt),
-				    #2 tyreadesc__AND_strbind_opt ) 
+                                    #2 tyreadesc__AND_strbind_opt ) 
 ) end
 )
  in (LrTable.NT 92,(result,AND1left,tyreadesc__AND_strbind_opt1right),
@@ -17690,7 +17690,7 @@
 val tyreadesc as tyreadesc1=tyreadesc1 ()
  in (
  WHERETYPESigExp(I(sigexpleft,tyreadescright),
-					  sigexp, tyreadesc) 
+                                          sigexp, tyreadesc) 
 ) end
 )
  in (LrTable.NT 94,(result,sigexp1left,tyreadesc1right),rest671) end
@@ -17720,8 +17720,8 @@
 sigexp__AND_sigbind_opt1 ()
  in (
  SigBind(I(sigidleft,sigexp__AND_sigbind_optright),
-				  sigid, #1 sigexp__AND_sigbind_opt,
-				  #2 sigexp__AND_sigbind_opt) 
+                                  sigid, #1 sigexp__AND_sigbind_opt,
+                                  #2 sigexp__AND_sigbind_opt) 
 ) end
 )
  in (LrTable.NT 97,(result,sigid1left,sigexp__AND_sigbind_opt1right),
@@ -17754,10 +17754,10 @@
 tyreadesc__AND_sigbind_opt1 ()
  in (
  ( WHERETYPESigExp(I(sigexpleft,
-					      tyreadesc__AND_sigbind_optright),
-					   sigexp,
-					   #1 tyreadesc__AND_sigbind_opt),
-			    #2 tyreadesc__AND_sigbind_opt ) 
+                                              tyreadesc__AND_sigbind_optright),
+                                           sigexp,
+                                           #1 tyreadesc__AND_sigbind_opt),
+                            #2 tyreadesc__AND_sigbind_opt ) 
 ) end
 )
  in (LrTable.NT 99,(result,sigexp1left,
@@ -17777,10 +17777,10 @@
 AND_tyreadesc_opt__AND_sigbind_opt1 ()
  in (
  ( TyReaDesc(I(TYPEleft,
-				       AND_tyreadesc_opt__AND_sigbind_optright),
-				      tyvarseq, longtycon, ty,
-				      #1 AND_tyreadesc_opt__AND_sigbind_opt),
-			    #2 AND_tyreadesc_opt__AND_sigbind_opt ) 
+                                       AND_tyreadesc_opt__AND_sigbind_optright),
+                                      tyvarseq, longtycon, ty,
+                                      #1 AND_tyreadesc_opt__AND_sigbind_opt),
+                            #2 AND_tyreadesc_opt__AND_sigbind_opt ) 
 ) end
 )
  in (LrTable.NT 100,(result,TYPE1left,
@@ -17801,7 +17801,7 @@
 tyreadesc__AND_sigbind_opt1 ()
  in (
  ( SOME(#1 tyreadesc__AND_sigbind_opt),
-				    #2 tyreadesc__AND_sigbind_opt ) 
+                                    #2 tyreadesc__AND_sigbind_opt ) 
 ) end
 )
  in (LrTable.NT 101,(result,AND1left,tyreadesc__AND_sigbind_opt1right)
@@ -17817,8 +17817,8 @@
 val AND_tyreadesc_opt as AND_tyreadesc_opt1=AND_tyreadesc_opt1 ()
  in (
  TyReaDesc(I(TYPEleft,AND_tyreadesc_optright),
-				    tyvarseq, longtycon, ty,
-				    AND_tyreadesc_opt) 
+                                    tyvarseq, longtycon, ty,
+                                    AND_tyreadesc_opt) 
 ) end
 )
  in (LrTable.NT 102,(result,TYPE1left,AND_tyreadesc_opt1right),rest671
@@ -17865,9 +17865,9 @@
 longtycon_EQUALS_list21=longtycon_EQUALS_list21 ()
  in (
  SHARINGTYPESpec(I(SHARINGleft,
-					    longtycon_EQUALS_list2right),
-					  EMPTYSpec(I(SHARINGleft,SHARINGleft)),
-					  longtycon_EQUALS_list2) 
+                                            longtycon_EQUALS_list2right),
+                                          EMPTYSpec(I(SHARINGleft,SHARINGleft)),
+                                          longtycon_EQUALS_list2) 
 ) end
 )
  in (LrTable.NT 105,(result,SHARING1left,longtycon_EQUALS_list21right)
@@ -17880,8 +17880,8 @@
 longtycon_EQUALS_list21 ()
  in (
  SHARINGTYPESpec(I(spec1left,
-					    longtycon_EQUALS_list2right),
-					  spec1, longtycon_EQUALS_list2) 
+                                            longtycon_EQUALS_list2right),
+                                          spec1, longtycon_EQUALS_list2) 
 ) end
 )
  in (LrTable.NT 105,(result,spec11left,longtycon_EQUALS_list21right),
@@ -17893,9 +17893,9 @@
 longstrid_EQUALS_list21=longstrid_EQUALS_list21 ()
  in (
  SHARINGSpec(I(SHARINGleft,
-					longstrid_EQUALS_list2right),
-				      EMPTYSpec(I(SHARINGleft,SHARINGleft)),
-				      longstrid_EQUALS_list2) 
+                                        longstrid_EQUALS_list2right),
+                                      EMPTYSpec(I(SHARINGleft,SHARINGleft)),
+                                      longstrid_EQUALS_list2) 
 ) end
 )
  in (LrTable.NT 105,(result,SHARING1left,longstrid_EQUALS_list21right)
@@ -17908,7 +17908,7 @@
 longstrid_EQUALS_list21 ()
  in (
  SHARINGSpec(I(spec1left,longstrid_EQUALS_list2right),
-				      spec1, longstrid_EQUALS_list2) 
+                                      spec1, longstrid_EQUALS_list2) 
 ) end
 )
  in (LrTable.NT 105,(result,spec11left,longstrid_EQUALS_list21right),
@@ -17958,7 +17958,7 @@
 val longtycon as longtycon1=longtycon1 ()
  in (
  REPLICATIONSpec(I(DATATYPEleft,longtyconright),
-					  tycon, longtycon) 
+                                          tycon, longtycon) 
 ) end
 )
  in (LrTable.NT 106,(result,DATATYPE1left,longtycon1right),rest671)
@@ -17987,7 +17987,7 @@
 sigid_list21=sigid_list21 ()
  in (
  INCLUDEMULTISpec(I(INCLUDEleft,sigid_list2right),
-					   sigid_list2) 
+                                           sigid_list2) 
 ) end
 )
  in (LrTable.NT 106,(result,INCLUDE1left,sigid_list21right),rest671)
@@ -18075,7 +18075,7 @@
 val AND_valdesc_opt as AND_valdesc_opt1=AND_valdesc_opt1 ()
  in (
  ValDesc(I(vid'left,AND_valdesc_optright),
-				  vid', ty, AND_valdesc_opt) 
+                                  vid', ty, AND_valdesc_opt) 
 ) end
 )
  in (LrTable.NT 112,(result,vid'1left,AND_valdesc_opt1right),rest671)
@@ -18098,7 +18098,7 @@
 val AND_typdesc_opt as AND_typdesc_opt1=AND_typdesc_opt1 ()
  in (
  TypDesc(I(tyvarseqleft,AND_typdesc_optright),
-				  tyvarseq, tycon, AND_typdesc_opt) 
+                                  tyvarseq, tycon, AND_typdesc_opt) 
 ) end
 )
  in (LrTable.NT 114,(result,tyvarseq1left,AND_typdesc_opt1right),
@@ -18123,7 +18123,7 @@
 val AND_syndesc_opt as AND_syndesc_opt1=AND_syndesc_opt1 ()
  in (
  SynDesc(I(tyvarseqleft,AND_syndesc_optright),
-				  tyvarseq, tycon, ty, AND_syndesc_opt) 
+                                  tyvarseq, tycon, ty, AND_syndesc_opt) 
 ) end
 )
  in (LrTable.NT 116,(result,tyvarseq1left,AND_syndesc_opt1right),
@@ -18148,7 +18148,7 @@
 val AND_datdesc_opt as AND_datdesc_opt1=AND_datdesc_opt1 ()
  in (
  DatDesc(I(tyvarseqleft,AND_datdesc_optright),
-	  			  tyvarseq, tycon, condesc, AND_datdesc_opt) 
+                                  tyvarseq, tycon, condesc, AND_datdesc_opt) 
 ) end
 )
  in (LrTable.NT 118,(result,tyvarseq1left,AND_datdesc_opt1right),
@@ -18162,8 +18162,8 @@
 val AND_datdesc_opt as AND_datdesc_opt1=AND_datdesc_opt1 ()
  in (
  DatDesc(I(tyconleft,AND_datdesc_optright),
-	  			  TyVarseq(I(defaultPos,defaultPos), []),
-				  tycon, condesc, AND_datdesc_opt) 
+                                  TyVarseq(I(defaultPos,defaultPos), []),
+                                  tycon, condesc, AND_datdesc_opt) 
 ) end
 )
  in (LrTable.NT 119,(result,tycon1left,AND_datdesc_opt1right),rest671)
@@ -18179,7 +18179,7 @@
 val AND_datdesc_opt as AND_datdesc_opt1=AND_datdesc_opt1 ()
  in (
  DatDesc(I(tyvarseq1left,AND_datdesc_optright),
-	  			  tyvarseq1, tycon, condesc, AND_datdesc_opt) 
+                                  tyvarseq1, tycon, condesc, AND_datdesc_opt) 
 ) end
 )
  in (LrTable.NT 120,(result,tyvarseq11left,AND_datdesc_opt1right),
@@ -18202,7 +18202,7 @@
 val BAR_condesc_opt as BAR_condesc_opt1=BAR_condesc_opt1 ()
  in (
  ConDesc(I(vid'left,BAR_condesc_optright),
-				  vid', OF_ty_opt, BAR_condesc_opt) 
+                                  vid', OF_ty_opt, BAR_condesc_opt) 
 ) end
 )
  in (LrTable.NT 122,(result,vid'1left,BAR_condesc_opt1right),rest671)
@@ -18225,7 +18225,7 @@
 val AND_exdesc_opt as AND_exdesc_opt1=AND_exdesc_opt1 ()
  in (
  ExDesc(I(vid'left,AND_exdesc_optright),
-	  			 vid', OF_ty_opt, AND_exdesc_opt) 
+                                 vid', OF_ty_opt, AND_exdesc_opt) 
 ) end
 )
  in (LrTable.NT 124,(result,vid'1left,AND_exdesc_opt1right),rest671)
@@ -18247,8 +18247,8 @@
 sigexp__AND_strdesc_opt1 ()
  in (
  StrDesc(I(stridleft,sigexp__AND_strdesc_optright),
-	  			  strid, #1 sigexp__AND_strdesc_opt,
-				  #2 sigexp__AND_strdesc_opt) 
+                                  strid, #1 sigexp__AND_strdesc_opt,
+                                  #2 sigexp__AND_strdesc_opt) 
 ) end
 )
  in (LrTable.NT 126,(result,strid1left,sigexp__AND_strdesc_opt1right),
@@ -18281,10 +18281,10 @@
 tyreadesc__AND_strdesc_opt1 ()
  in (
  ( WHERETYPESigExp(I(sigexpleft,
-					      tyreadesc__AND_strdesc_optright),
-					   sigexp,
-					   #1 tyreadesc__AND_strdesc_opt),
-			    #2 tyreadesc__AND_strdesc_opt ) 
+                                              tyreadesc__AND_strdesc_optright),
+                                           sigexp,
+                                           #1 tyreadesc__AND_strdesc_opt),
+                            #2 tyreadesc__AND_strdesc_opt ) 
 ) end
 )
  in (LrTable.NT 128,(result,sigexp1left,
@@ -18304,10 +18304,10 @@
 AND_tyreadesc_opt__AND_strdesc_opt1 ()
  in (
  ( TyReaDesc(I(TYPEleft,
-				       AND_tyreadesc_opt__AND_strdesc_optright),
-				      tyvarseq, longtycon, ty,
-				      #1 AND_tyreadesc_opt__AND_strdesc_opt),
-			    #2 AND_tyreadesc_opt__AND_strdesc_opt ) 
+                                       AND_tyreadesc_opt__AND_strdesc_optright),
+                                      tyvarseq, longtycon, ty,
+                                      #1 AND_tyreadesc_opt__AND_strdesc_opt),
+                            #2 AND_tyreadesc_opt__AND_strdesc_opt ) 
 ) end
 )
  in (LrTable.NT 129,(result,TYPE1left,
@@ -18328,7 +18328,7 @@
 tyreadesc__AND_strdesc_opt1 ()
  in (
  ( SOME(#1 tyreadesc__AND_strdesc_opt),
-				    #2 tyreadesc__AND_strdesc_opt ) 
+                                    #2 tyreadesc__AND_strdesc_opt ) 
 ) end
 )
  in (LrTable.NT 130,(result,AND1left,tyreadesc__AND_strdesc_opt1right)
@@ -18353,10 +18353,10 @@
 strexp__AND_funbind_opt1 ()
  in (
  TRANSFunBind(I(funidleft,
-					 strexp__AND_funbind_optright),
-				       funid, strid, sigexp, COLON_sigexp_opt,
-				       #1 strexp__AND_funbind_opt,
-				       #2 strexp__AND_funbind_opt) 
+                                         strexp__AND_funbind_optright),
+                                       funid, strid, sigexp, COLON_sigexp_opt,
+                                       #1 strexp__AND_funbind_opt,
+                                       #2 strexp__AND_funbind_opt) 
 ) end
 )
  in (LrTable.NT 132,(result,funid1left,strexp__AND_funbind_opt1right),
@@ -18374,9 +18374,9 @@
 strexp__AND_funbind_opt1 ()
  in (
  OPAQFunBind(I(funidleft,strexp__AND_funbind_optright),
-				      funid, strid, sigexp1, sigexp2,
-				      #1 strexp__AND_funbind_opt,
-				      #2 strexp__AND_funbind_opt) 
+                                      funid, strid, sigexp1, sigexp2,
+                                      #1 strexp__AND_funbind_opt,
+                                      #2 strexp__AND_funbind_opt) 
 ) end
 )
  in (LrTable.NT 132,(result,funid1left,strexp__AND_funbind_opt1right),
@@ -18393,10 +18393,10 @@
 strexp__AND_funbind_opt1 ()
  in (
  TRANSSPECFunBind(I(funidleft,
-					     strexp__AND_funbind_optright),
-					   funid, spec, COLON_sigexp_opt,
-					   #1 strexp__AND_funbind_opt,
-					   #2 strexp__AND_funbind_opt) 
+                                             strexp__AND_funbind_optright),
+                                           funid, spec, COLON_sigexp_opt,
+                                           #1 strexp__AND_funbind_opt,
+                                           #2 strexp__AND_funbind_opt) 
 ) end
 )
  in (LrTable.NT 132,(result,funid1left,strexp__AND_funbind_opt1right),
@@ -18413,10 +18413,10 @@
 strexp__AND_funbind_opt1 ()
  in (
  OPAQSPECFunBind(I(funidleft,
-					    strexp__AND_funbind_optright),
-					  funid, spec, sigexp,
-					  #1 strexp__AND_funbind_opt,
-					  #2 strexp__AND_funbind_opt) 
+                                            strexp__AND_funbind_optright),
+                                          funid, spec, sigexp,
+                                          #1 strexp__AND_funbind_opt,
+                                          #2 strexp__AND_funbind_opt) 
 ) end
 )
  in (LrTable.NT 132,(result,funid1left,strexp__AND_funbind_opt1right),
@@ -18448,9 +18448,9 @@
 sigexp__AND_funbind_opt1 ()
  in (
  ( TRANSStrExp(I(strexpleft,
-					  sigexp__AND_funbind_optright),
-					strexp, #1 sigexp__AND_funbind_opt),
-			    #2 sigexp__AND_funbind_opt ) 
+                                          sigexp__AND_funbind_optright),
+                                        strexp, #1 sigexp__AND_funbind_opt),
+                            #2 sigexp__AND_funbind_opt ) 
 ) end
 )
  in (LrTable.NT 134,(result,strexp1left,sigexp__AND_funbind_opt1right)
@@ -18464,9 +18464,9 @@
 sigexp__AND_funbind_opt1 ()
  in (
  ( OPAQStrExp(I(strexpleft,
-					 sigexp__AND_funbind_optright),
-				       strexp, #1 sigexp__AND_funbind_opt),
-			    #2 sigexp__AND_funbind_opt ) 
+                                         sigexp__AND_funbind_optright),
+                                       strexp, #1 sigexp__AND_funbind_opt),
+                            #2 sigexp__AND_funbind_opt ) 
 ) end
 )
  in (LrTable.NT 134,(result,strexp1left,sigexp__AND_funbind_opt1right)
@@ -18490,10 +18490,10 @@
 tyreadesc__AND_funbind_opt1 ()
  in (
  ( WHERETYPESigExp(I(sigexpleft,
-					      tyreadesc__AND_funbind_optright),
-					   sigexp,
-					   #1 tyreadesc__AND_funbind_opt),
-			    #2 tyreadesc__AND_funbind_opt ) 
+                                              tyreadesc__AND_funbind_optright),
+                                           sigexp,
+                                           #1 tyreadesc__AND_funbind_opt),
+                            #2 tyreadesc__AND_funbind_opt ) 
 ) end
 )
  in (LrTable.NT 135,(result,sigexp1left,
@@ -18513,10 +18513,10 @@
 AND_tyreadesc_opt__AND_funbind_opt1 ()
  in (
  ( TyReaDesc(I(TYPEleft,
-				       AND_tyreadesc_opt__AND_funbind_optright),
-				      tyvarseq, longtycon, ty,
-				      #1 AND_tyreadesc_opt__AND_funbind_opt),
-			    #2 AND_tyreadesc_opt__AND_funbind_opt ) 
+                                       AND_tyreadesc_opt__AND_funbind_optright),
+                                      tyvarseq, longtycon, ty,
+                                      #1 AND_tyreadesc_opt__AND_funbind_opt),
+                            #2 AND_tyreadesc_opt__AND_funbind_opt ) 
 ) end
 )
  in (LrTable.NT 136,(result,TYPE1left,
@@ -18537,7 +18537,7 @@
 tyreadesc__AND_funbind_opt1 ()
  in (
  ( SOME(#1 tyreadesc__AND_funbind_opt),
-			    #2 tyreadesc__AND_funbind_opt ) 
+                            #2 tyreadesc__AND_funbind_opt ) 
 ) end
 )
  in (LrTable.NT 137,(result,AND1left,tyreadesc__AND_funbind_opt1right)
@@ -18550,8 +18550,8 @@
  in (LrTable.NT 138,(result,topdec11left,topdec11right),rest671) end
 | (319,rest671) => let val result=MlyValue.topdec(fn _ => (
  STRDECTopDec(I(defaultPos,defaultPos),
-				       EMPTYStrDec(I(defaultPos,defaultPos)),
-				       NONE) 
+                                       EMPTYStrDec(I(defaultPos,defaultPos)),
+                                       NONE) 
 ))
  in (LrTable.NT 138,(result,defaultPos,defaultPos),rest671) end
 | (320,(_,(MlyValue.topdec_opt topdec_opt1,_,topdec_optright as 
@@ -18561,7 +18561,7 @@
 val topdec_opt as topdec_opt1=topdec_opt1 ()
  in (
  STRDECTopDec(I(strdec1'left,topdec_optright),
-				       strdec1', topdec_opt) 
+                                       strdec1', topdec_opt) 
 ) end
 )
  in (LrTable.NT 139,(result,strdec1'1left,topdec_opt1right),rest671)
@@ -18573,7 +18573,7 @@
 val topdec_opt as topdec_opt1=topdec_opt1 ()
  in (
  SIGDECTopDec(I(sigdecleft,topdec_optright),
-				       sigdec, topdec_opt) 
+                                       sigdec, topdec_opt) 
 ) end
 )
  in (LrTable.NT 139,(result,sigdec1left,topdec_opt1right),rest671) end
@@ -18584,7 +18584,7 @@
 val topdec_opt as topdec_opt1=topdec_opt1 ()
  in (
  FUNDECTopDec(I(fundecleft,topdec_optright),
-				       fundec, topdec_opt) 
+                                       fundec, topdec_opt) 
 ) end
 )
  in (LrTable.NT 139,(result,fundec1left,topdec_opt1right),rest671) end
@@ -18612,7 +18612,7 @@
 val program_opt as program_opt1=program_opt1 ()
  in (
  TOPDECProgram(I(topdecleft,SEMICOLONright),
-					topdec, program_opt) 
+                                        topdec, program_opt) 
 ) end
 )
  in (LrTable.NT 142,(result,topdec1left,program_opt1right),rest671)
@@ -18624,7 +18624,7 @@
 val program_opt as program_opt1=program_opt1 ()
  in (
  EXPProgram(I(expleft,SEMICOLONright),
-				     exp, program_opt) )
+                                     exp, program_opt) )
  end
 )
  in (LrTable.NT 142,(result,exp1left,program_opt1right),rest671) end
@@ -18642,7 +18642,7 @@
 val void = MlyValue.VOID
 val extract = fn a => (fn MlyValue.program x => x
 | _ => let exception ParseInternal
-	in raise ParseInternal end) a ()
+        in raise ParseInternal end) a ()
 end
 end
 structure Tokens : Parser_TOKENS =
@@ -18839,14 +18839,14 @@
 
     (* Handling nested comments *)
 
-    val nesting = ref 0		(* non-reentrant side-effect way :-P *)
+    val nesting = ref 0         (* non-reentrant side-effect way :-P *)
 
 
     fun eof() =
-	if !nesting = 0 then
-	    Tokens.EOF(0, 0)
-	else
-	    Error.error((0,0), "unclosed comment")
+        if !nesting = 0 then
+            Tokens.EOF(0, 0)
+        else
+            Error.error((0,0), "unclosed comment")
 
 
 
@@ -18856,31 +18856,31 @@
 
 
     fun toLRPos(yypos, yytext) =
-	let
-	    val yypos = yypos - 2	(* bug in ML-Lex... *)
-	in
-	    (yypos, yypos + String.size yytext)
-	end
+        let
+            val yypos = yypos - 2       (* bug in ML-Lex... *)
+        in
+            (yypos, yypos + String.size yytext)
+        end
 
     fun token(TOKEN, yypos, yytext) =
         TOKEN(toLRPos(yypos, yytext))
 
     fun tokenOf(TOKEN, toVal, yypos, yytext) =
-	let
-	    val i as (l,r) = toLRPos(yypos, yytext)
-	in
-	    TOKEN(toVal(yytext, i), l, r)
-	end
+        let
+            val i as (l,r) = toLRPos(yypos, yytext)
+        in
+            TOKEN(toVal(yytext, i), l, r)
+        end
 
     fun error(yypos, yytext, s) =
-	    Error.error(toLRPos(yypos,yytext), s)
+            Error.error(toLRPos(yypos,yytext), s)
 
     fun invalid(yypos, yytext) =
-	let
-	    val s = "invalid character `" ^ String.toCString yytext ^ "'"
-	in
-	    error(yypos, yytext, s)
-	end
+        let
+            val s = "invalid character `" ^ String.toCString yytext ^ "'"
+        in
+            error(yypos, yytext, s)
+        end
 
 
 
@@ -18889,13 +18889,13 @@
     fun toId(s, i)     = s
 
     fun toLongId(s, i) =
-	let
-	    fun split  []    = raise Fail "Lexer.toLongId: empty longid"
-	      | split [x]    = ([],x)
-	      | split(x::xs) = let val (ys,y) = split xs in (x::ys,y) end
-	in
-	    split(String.fields (fn c => c = #".") s)
-	end
+        let
+            fun split  []    = raise Fail "Lexer.toLongId: empty longid"
+              | split [x]    = ([],x)
+              | split(x::xs) = let val (ys,y) = split xs in (x::ys,y) end
+        in
+            split(String.fields (fn c => c = #".") s)
+        end
 
 
     (* Convert constants [Section 2.2] *)
@@ -18903,106 +18903,106 @@
     local open StringCvt in
 
     fun toInt(s,i) =
-	(case String.explode s
-	  of #"0" :: #"x" :: s' =>
-		  valOf(scanString (Int.scan HEX) (String.implode s'))
-	   | #"~" :: #"0" :: #"x" :: s' =>
-		  ~(valOf(scanString (Int.scan HEX) (String.implode s')))
-	   | _ => valOf(scanString (Int.scan DEC) s)
-	) handle Overflow =>
-		Error.error(i, "integer constant too big")
+        (case String.explode s
+          of #"0" :: #"x" :: s' =>
+                  valOf(scanString (Int.scan HEX) (String.implode s'))
+           | #"~" :: #"0" :: #"x" :: s' =>
+                  ~(valOf(scanString (Int.scan HEX) (String.implode s')))
+           | _ => valOf(scanString (Int.scan DEC) s)
+        ) handle Overflow =>
+                Error.error(i, "integer constant too big")
 
     fun toWord(s,i) =
-	(case String.explode s
-	  of #"0" :: #"w" :: #"x" :: s' =>
-		valOf(scanString (Word.scan HEX) (String.implode s'))
-	   | #"0" :: #"w" :: s' =>
-		valOf(scanString (Word.scan DEC) (String.implode s'))
-	   | _ => raise Fail "Lexer.toWord: invalid word constant"
-	) handle Overflow =>
-		Error.error(i, "word constant too big")
+        (case String.explode s
+          of #"0" :: #"w" :: #"x" :: s' =>
+                valOf(scanString (Word.scan HEX) (String.implode s'))
+           | #"0" :: #"w" :: s' =>
+                valOf(scanString (Word.scan DEC) (String.implode s'))
+           | _ => raise Fail "Lexer.toWord: invalid word constant"
+        ) handle Overflow =>
+                Error.error(i, "word constant too big")
 
     fun toReal(s,i) = valOf(scanString Real.scan s)
 
 
     fun toString(s,i) =
-	let
-	    fun convert(#"\\"::s, cs)  = escape(s, cs)
-	      | convert([#"\""],  cs)  = cs
-	      | convert(c::s,     cs)  = convert(s, c::cs)
-	      | convert([],       cs)  =
-		    raise Fail "Lexer.toString: unclosed string literal"
+        let
+            fun convert(#"\\"::s, cs)  = escape(s, cs)
+              | convert([#"\""],  cs)  = cs
+              | convert(c::s,     cs)  = convert(s, c::cs)
+              | convert([],       cs)  =
+                    raise Fail "Lexer.toString: unclosed string literal"
 
-	    and escape(#"a"::s, cs)    = convert(s, #"\a"::cs)
-	      | escape(#"b"::s, cs)    = convert(s, #"\b"::cs)
-	      | escape(#"t"::s, cs)    = convert(s, #"\t"::cs)
-	      | escape(#"n"::s, cs)    = convert(s, #"\n"::cs)
-	      | escape(#"v"::s, cs)    = convert(s, #"\v"::cs)
-	      | escape(#"f"::s, cs)    = convert(s, #"\f"::cs)
-	      | escape(#"r"::s, cs)    = convert(s, #"\r"::cs)
-	      | escape(#"\""::s, cs)   = convert(s, #"\""::cs)
-	      | escape(#"\\"::s, cs)   = convert(s, #"\\"::cs)
-	      | escape(#"^"::c::s, cs) =
-		    convert(s, Char.chr(Char.ord c - 64)::cs)
+            and escape(#"a"::s, cs)    = convert(s, #"\a"::cs)
+              | escape(#"b"::s, cs)    = convert(s, #"\b"::cs)
+              | escape(#"t"::s, cs)    = convert(s, #"\t"::cs)
+              | escape(#"n"::s, cs)    = convert(s, #"\n"::cs)
+              | escape(#"v"::s, cs)    = convert(s, #"\v"::cs)
+              | escape(#"f"::s, cs)    = convert(s, #"\f"::cs)
+              | escape(#"r"::s, cs)    = convert(s, #"\r"::cs)
+              | escape(#"\""::s, cs)   = convert(s, #"\""::cs)
+              | escape(#"\\"::s, cs)   = convert(s, #"\\"::cs)
+              | escape(#"^"::c::s, cs) =
+                    convert(s, Char.chr(Char.ord c - 64)::cs)
 
-	      | escape(#"u"::x1::x2::x3::x4::s, cs) =
-		    convert(s, unicode[x1,x2,x3,x4]::cs)
+              | escape(#"u"::x1::x2::x3::x4::s, cs) =
+                    convert(s, unicode[x1,x2,x3,x4]::cs)
 
-	      | escape(c::s, cs) =
-		if Char.isDigit c then
-		    case s
-		      of c2::c3::s => convert(s, ascii[c,c2,c3]::cs)
-		       | _ => raise Fail
-				"Lexer.toString: invalid ASCII escape sequence"
-		else if Char.isSpace c then
-		    escapeGap(s,cs)
-		else
-		    raise Fail "Lexer.toString: invalid escape sequence"
+              | escape(c::s, cs) =
+                if Char.isDigit c then
+                    case s
+                      of c2::c3::s => convert(s, ascii[c,c2,c3]::cs)
+                       | _ => raise Fail
+                                "Lexer.toString: invalid ASCII escape sequence"
+                else if Char.isSpace c then
+                    escapeGap(s,cs)
+                else
+                    raise Fail "Lexer.toString: invalid escape sequence"
 
-	      | escape([], cs) =
-		    raise Fail "Lexer.toString: empty escape character"
+              | escape([], cs) =
+                    raise Fail "Lexer.toString: empty escape character"
 
-	    and escapeGap(c::s, cs) =
-		    if Char.isSpace c then
-			escapeGap(s, cs)
-		    else (* c = #"\\" *)
-			convert(s, cs)
+            and escapeGap(c::s, cs) =
+                    if Char.isSpace c then
+                        escapeGap(s, cs)
+                    else (* c = #"\\" *)
+                        convert(s, cs)
 
-	      | escapeGap([], cs) =
-		    raise Fail "Lexer.toString: invalid string gap"
+              | escapeGap([], cs) =
+                    raise Fail "Lexer.toString: invalid string gap"
 
             and ascii s =
-		Char.chr(valOf(scanString (Int.scan DEC) (String.implode s)))
-		handle Chr =>
-			 Error.error(i, "ASCII escape character too big")
-		     | Overflow =>
-			 Error.error(i, "ASCII escape character too big")
+                Char.chr(valOf(scanString (Int.scan DEC) (String.implode s)))
+                handle Chr =>
+                         Error.error(i, "ASCII escape character too big")
+                     | Overflow =>
+                         Error.error(i, "ASCII escape character too big")
 
-	    and unicode s =
-		Char.chr(valOf(scanString (Int.scan HEX) (String.implode s)))
-		handle Chr =>
-			 Error.error(i, "unicode escape character too big")
-		     | Overflow =>
-			 Error.error(i, "unicode escape character too big")
+            and unicode s =
+                Char.chr(valOf(scanString (Int.scan HEX) (String.implode s)))
+                handle Chr =>
+                         Error.error(i, "unicode escape character too big")
+                     | Overflow =>
+                         Error.error(i, "unicode escape character too big")
 
-	    val cs = List.tl(String.explode s)
-	in
-	    String.implode(List.rev(convert(cs, [])))
-	end
+            val cs = List.tl(String.explode s)
+        in
+            String.implode(List.rev(convert(cs, [])))
+        end
 
 
     fun toChar(s,i) =
-	let
-	    val s'  = String.substring(s, 1, String.size s-1)
-	    val ss' = toString(s',i)
-	in
-	    if String.size ss' = 1 then
-		String.sub(ss',0)
-	    else if ss' = "" then
-		Error.error(i, "empty character constant")
-	    else
-		Error.error(i, "character constant too long")
-	end
+        let
+            val s'  = String.substring(s, 1, String.size s-1)
+            val ss' = toString(s',i)
+        in
+            if String.size ss' = 1 then
+                String.sub(ss',0)
+            else if ss' = "" then
+                Error.error(i, "empty character constant")
+            else
+                Error.error(i, "character constant too long")
+        end
 
     end (* local *)
 
@@ -19010,7 +19010,7 @@
 end (* end of user routines *)
 exception LexError (* raised if illegal leaf action tried *)
 structure Internal =
-	struct
+        struct
 
 datatype yyfinstate = N of int
 type statedata = {fin : yyfinstate list, trans: string}
@@ -22420,8 +22420,8 @@
 {fin = [(N 468)], trans = 0}])
 end
 structure StartStates =
-	struct
-	datatype yystartstate = STARTSTATE of int
+        struct
+        datatype yystartstate = STARTSTATE of int
 
 (* start state definitions *)
 
@@ -22430,36 +22430,36 @@
 
 end
 type result = UserDeclarations.lexresult
-	exception LexerError (* raised if illegal leaf action tried *)
+        exception LexerError (* raised if illegal leaf action tried *)
 end
 
 type int = Int.int
 fun makeLexer (yyinput: int -> string) =
-let	val yygone0:int=1
-	val yyb = ref "\n" 		(* buffer *)
-	val yybl: int ref = ref 1		(*buffer length *)
-	val yybufpos: int ref = ref 1		(* location of next character to use *)
-	val yygone: int ref = ref yygone0	(* position in file of beginning of buffer *)
-	val yydone = ref false		(* eof found yet? *)
-	val yybegin: int ref = ref 1		(*Current 'start state' for lexer *)
+let     val yygone0:int=1
+        val yyb = ref "\n"              (* buffer *)
+        val yybl: int ref = ref 1               (*buffer length *)
+        val yybufpos: int ref = ref 1           (* location of next character to use *)
+        val yygone: int ref = ref yygone0       (* position in file of beginning of buffer *)
+        val yydone = ref false          (* eof found yet? *)
+        val yybegin: int ref = ref 1            (*Current 'start state' for lexer *)
 
-	val YYBEGIN = fn (Internal.StartStates.STARTSTATE x) =>
-		 yybegin := x
+        val YYBEGIN = fn (Internal.StartStates.STARTSTATE x) =>
+                 yybegin := x
 
 fun lex () : Internal.result =
 let fun continue() = lex() in
   let fun scan (s,AcceptingLeaves : Internal.yyfinstate list list,l,i0: int) =
-	let fun action (i: int,nil) = raise LexError
-	| action (i,nil::l) = action (i-1,l)
-	| action (i,(node::acts)::l) =
-		case node of
-		    Internal.N yyk => 
-			(let fun yymktext() = String.substring(!yyb,i0,i-i0)
-			     val yypos: int = i0+ !yygone
-			open UserDeclarations Internal.StartStates
+        let fun action (i: int,nil) = raise LexError
+        | action (i,nil::l) = action (i-1,l)
+        | action (i,(node::acts)::l) =
+                case node of
+                    Internal.N yyk => 
+                        (let fun yymktext() = String.substring(!yyb,i0,i-i0)
+                             val yypos: int = i0+ !yygone
+                        open UserDeclarations Internal.StartStates
  in (yybufpos := i; case yyk of 
 
-			(* Application actions *)
+                        (* Application actions *)
 
   10 => let val yytext=yymktext() in  token(STAR,      yypos, yytext)  end
 | 109 => let val yytext=yymktext() in  token(EXCEPTION, yypos, yytext)  end
@@ -22524,8 +22524,8 @@
 | 458 => ( nesting := 1 ; YYBEGIN COMMENT ; continue() )
 | 461 => ( nesting := !nesting+1 ; continue() )
 | 464 => ( nesting := !nesting-1 ;
-			     if !nesting = 0 then YYBEGIN INITIAL else () ;
-			     continue() )
+                             if !nesting = 0 then YYBEGIN INITIAL else () ;
+                             continue() )
 | 466 => ( continue() )
 | 468 => ( continue() )
 | 470 => let val yytext=yymktext() in  error(yypos, yytext, "invalid string")  end
@@ -22544,35 +22544,35 @@
 | 99 => let val yytext=yymktext() in  token(EQTYPE,    yypos, yytext)  end
 | _ => raise Internal.LexerError
 
-		) end )
+                ) end )
 
-	val {fin,trans} = Vector.sub(Internal.tab, s)
-	val NewAcceptingLeaves = fin::AcceptingLeaves
-	in if l = !yybl then
-	     if trans = #trans(Vector.sub(Internal.tab,0))
-	       then action(l,NewAcceptingLeaves
-) else	    let val newchars= if !yydone then "" else yyinput 1024
-	    in if (String.size newchars)=0
-		  then (yydone := true;
-		        if (l=i0) then UserDeclarations.eof ()
-		                  else action(l,NewAcceptingLeaves))
-		  else (if i0=l then yyb := newchars
-		     else yyb := String.substring(!yyb,i0,l-i0)^newchars;
-		     yygone := !yygone+i0;
-		     yybl := String.size (!yyb);
-		     scan (s,AcceptingLeaves,l-i0,0))
-	    end
-	  else let val NewChar = Char.ord(CharVector.sub(!yyb,l))
-		val NewState = Char.ord(CharVector.sub(trans,NewChar))
-		in if NewState=0 then action(l,NewAcceptingLeaves)
-		else scan(NewState,NewAcceptingLeaves,l+1,i0)
-	end
-	end
+        val {fin,trans} = Vector.sub(Internal.tab, s)
+        val NewAcceptingLeaves = fin::AcceptingLeaves
+        in if l = !yybl then
+             if trans = #trans(Vector.sub(Internal.tab,0))
+               then action(l,NewAcceptingLeaves
+) else      let val newchars= if !yydone then "" else yyinput 1024
+            in if (String.size newchars)=0
+                  then (yydone := true;
+                        if (l=i0) then UserDeclarations.eof ()
+                                  else action(l,NewAcceptingLeaves))
+                  else (if i0=l then yyb := newchars
+                     else yyb := String.substring(!yyb,i0,l-i0)^newchars;
+                     yygone := !yygone+i0;
+                     yybl := String.size (!yyb);
+                     scan (s,AcceptingLeaves,l-i0,0))
+            end
+          else let val NewChar = Char.ord(CharVector.sub(!yyb,l))
+                val NewState = Char.ord(CharVector.sub(trans,NewChar))
+                in if NewState=0 then action(l,NewAcceptingLeaves)
+                else scan(NewState,NewAcceptingLeaves,l+1,i0)
+        end
+        end
 (*
-	val start= if String.substring(!yyb,!yybufpos-1,1)="\n"
+        val start= if String.substring(!yyb,!yybufpos-1,1)="\n"
 then !yybegin+1 else !yybegin
 *)
-	in scan(!yybegin (* start *),nil,!yybufpos,!yybufpos)
+        in scan(!yybegin (* start *),nil,!yybufpos,!yybufpos)
     end
 end
   in lex
@@ -22612,29 +22612,29 @@
     structure LrVals = LrValsFn(structure Token      = LrParser.Token)
     structure Lexer  = LexerFn (structure Tokens     = LrVals.Tokens)
     structure Parser = Join    (structure LrParser   = LrParser
-				structure ParserData = LrVals.ParserData
-				structure Lex        = Lexer)
+                                structure ParserData = LrVals.ParserData
+                                structure Lex        = Lexer)
 
 
     (* The actual parsing function *)
 
     fun parse(J, source) =
-	let
-	    val yyread = ref false
-	    fun yyinput _ =
-		if !yyread then
-		    ""
-		else
-		    ( yyread := true; source )
+        let
+            val yyread = ref false
+            fun yyinput _ =
+                if !yyread then
+                    ""
+                else
+                    ( yyread := true; source )
 
-	    val lexer = Parser.makeLexer yyinput
+            val lexer = Parser.makeLexer yyinput
 
-	    fun onError(s, pos1, pos2) = Error.error((pos1,pos2), s)
+            fun onError(s, pos1, pos2) = Error.error((pos1,pos2), s)
 
-	    val ((program,J'), lexer') = Parser.parse(0, lexer, onError, J)
-	in
-	    (J',program)
-	end
+            val ((program,J'), lexer') = Parser.parse(0, lexer, onError, J)
+        in
+            (J',program)
+        end
 
   end
 (* stop of Parse.sml *)
@@ -22646,25 +22646,25 @@
 signature SML =
   sig
 
-    val parseString:	string -> unit	(* Parse only *)
-    val elabString:	string -> unit	(* Parse and elaborate *)
-    val evalString:	string -> unit	(* Parse and evaluate *)
-    val execString:	string -> unit	(* Parse, elaborate, and evaluate *)
+    val parseString:    string -> unit  (* Parse only *)
+    val elabString:     string -> unit  (* Parse and elaborate *)
+    val evalString:     string -> unit  (* Parse and evaluate *)
+    val execString:     string -> unit  (* Parse, elaborate, and evaluate *)
 
-    val parseFile:	string -> unit
-    val elabFile:	string -> unit
-    val evalFile:	string -> unit
-    val execFile:	string -> unit
+    val parseFile:      string -> unit
+    val elabFile:       string -> unit
+    val evalFile:       string -> unit
+    val execFile:       string -> unit
 
-    val parseFiles:	string -> unit
-    val elabFiles:	string -> unit
-    val evalFiles:	string -> unit
-    val execFiles:	string -> unit
+    val parseFiles:     string -> unit
+    val elabFiles:      string -> unit
+    val evalFiles:      string -> unit
+    val execFiles:      string -> unit
 
-    val parseSession:	unit -> unit
-    val elabSession:	unit -> unit
-    val evalSession:	unit -> unit
-    val execSession:	unit -> unit
+    val parseSession:   unit -> unit
+    val elabSession:    unit -> unit
+    val evalSession:    unit -> unit
+    val execSession:    unit -> unit
 
   end
 (* stop of SML.sml *)
@@ -22688,12 +22688,12 @@
     (* Parsing only *)
 
     fun parse J source =
-	let
-	    val (J',program) = Parse.parse(J, source)
-	    val    _         = TextIO.output(TextIO.stdOut, "OK\n")
-	in
-	    J'
-	end
+        let
+            val (J',program) = Parse.parse(J, source)
+            val    _         = TextIO.output(TextIO.stdOut, "OK\n")
+        in
+            J'
+        end
 
     val parseInitialArg = J0
     val parseInitial    = parse parseInitialArg
@@ -22704,12 +22704,12 @@
     val elabInitialArg = (J0, B_STAT0)
 
     fun elab (J, B_STAT) source =
-	let
-	    val (J',program) = Parse.parse(J, source)
-	    val B_STAT'      = Program.elabProgram(B_STAT, program)
-	in
-	    (J', B_STAT')
-	end
+        let
+            val (J',program) = Parse.parse(J, source)
+            val B_STAT'      = Program.elabProgram(B_STAT, program)
+        in
+            (J', B_STAT')
+        end
 
 
     (* Parsing and evaluation *)
@@ -22717,13 +22717,13 @@
     val evalInitialArg = (J0, B_DYN0, s0)
 
     fun eval (J, B_DYN, s) source =
-	let
-	    val (J',program) = Parse.parse(J, source)
-	    val s'           = ref s
-	    val B_DYN'       = Program.evalProgram(s', B_DYN, program)
-	in
-	    (J', B_DYN', !s')
-	end
+        let
+            val (J',program) = Parse.parse(J, source)
+            val s'           = ref s
+            val B_DYN'       = Program.evalProgram(s', B_DYN, program)
+        in
+            (J', B_DYN', !s')
+        end
 
 
     (* Parsing, elaboration, and evaluation *)
@@ -22731,20 +22731,20 @@
     val execInitialArg = (J0, B0, s0)
 
     fun exec (J, B, s) source =
-	let
-	    val (J',program) = Parse.parse(J, source)
-	    val s'           = ref s
-	    val B'           = Program.execProgram(s', B, program)
-	in
-	    (J', B', !s' )
-	end
+        let
+            val (J',program) = Parse.parse(J, source)
+            val s'           = ref s
+            val B'           = Program.execProgram(s', B, program)
+        in
+            (J', B', !s' )
+        end
 
 
     (* Processing of strings *)
 
     fun processString (process, arg) source =
-	    ignore(process arg source)
-	    handle Error.Error _ => ()	(* Syntax error *)
+            ignore(process arg source)
+            handle Error.Error _ => ()  (* Syntax error *)
 
     val parseString = processString(parse, parseInitialArg)
     val elabString  = processString(elab, elabInitialArg)
@@ -22755,14 +22755,14 @@
     (* Processing of files *)
 
     fun processFile (process, arg) name =
-	let
-	    val file   = TextIO.openIn name
-	    val source = TextIO.inputAll file
-	    val _      = TextIO.closeIn file
-	in
-	    ignore(process arg source)
-	    handle Error.Error _ => ()	(* Syntax error *)
-	end
+        let
+            val file   = TextIO.openIn name
+            val source = TextIO.inputAll file
+            val _      = TextIO.closeIn file
+        in
+            ignore(process arg source)
+            handle Error.Error _ => ()  (* Syntax error *)
+        end
 
     val parseFile = processFile(parse, parseInitialArg)
     val elabFile  = processFile(elab, elabInitialArg)
@@ -22773,30 +22773,30 @@
     (* Processing several files mentioned in a list file *)
 
     fun processFiles (process, initialArg) name =
-	let
-	    val file    = TextIO.openIn name
-	    val content = TextIO.inputAll file
-	    val _       = TextIO.closeIn file
+        let
+            val file    = TextIO.openIn name
+            val content = TextIO.inputAll file
+            val _       = TextIO.closeIn file
 
-	    val _       = Stamp.reset()
+            val _       = Stamp.reset()
 
-	    fun loop(arg,     [] )     = ()
-	      | loop(arg,  "" ::names) = loop(arg, names)
-	      | loop(arg, name::names) =
-		let
-		    val file   = TextIO.openIn name
-		    val source = TextIO.inputAll file
-		    val _      = TextIO.closeIn file
-		    val _      = TextIO.output(TextIO.stdOut,
-					       ">> File \"" ^ name ^ "\":\n")
-		in
-		    loop(process arg source, names)
-		    handle Error.Error _ =>	(* Syntax error *)
-			loop(arg, names)
-		end
-	in
-	    loop(initialArg, String.fields Char.isSpace content)
-	end
+            fun loop(arg,     [] )     = ()
+              | loop(arg,  "" ::names) = loop(arg, names)
+              | loop(arg, name::names) =
+                let
+                    val file   = TextIO.openIn name
+                    val source = TextIO.inputAll file
+                    val _      = TextIO.closeIn file
+                    val _      = TextIO.output(TextIO.stdOut,
+                                               ">> File \"" ^ name ^ "\":\n")
+                in
+                    loop(process arg source, names)
+                    handle Error.Error _ =>     (* Syntax error *)
+                        loop(arg, names)
+                end
+        in
+            loop(initialArg, String.fields Char.isSpace content)
+        end
 
     val parseFiles = processFiles(parse, parseInitialArg)
     val elabFiles  = processFiles(elab,  elabInitialArg)
@@ -22807,23 +22807,23 @@
     (* Session *)
 
     fun processSession(process, initialArg) =
-	let
-	   val ins = !ins
-	    fun loop arg =
-		let
-		    val _      = TextIO.output(TextIO.stdOut, "SML> ")
-		    val _      = TextIO.flushOut TextIO.stdOut
-		in
-		   case TextIO.inputLine ins of
-		      NONE => ()
-		    | SOME source =>
-			loop(process arg source)
-			handle Error.Error _ =>	(* Syntax error *)
-			    loop arg
-		end
-	in
-	    loop initialArg
-	end
+        let
+           val ins = !ins
+            fun loop arg =
+                let
+                    val _      = TextIO.output(TextIO.stdOut, "SML> ")
+                    val _      = TextIO.flushOut TextIO.stdOut
+                in
+                   case TextIO.inputLine ins of
+                      NONE => ()
+                    | SOME source =>
+                        loop(process arg source)
+                        handle Error.Error _ => (* Syntax error *)
+                            loop arg
+                end
+        in
+            loop initialArg
+        end
 
     fun parseSession() = processSession(parse, parseInitialArg)
     fun elabSession()  = processSession(elab,  elabInitialArg)
@@ -22843,28 +22843,28 @@
     val version = "0.5"
 
     fun usage() =
-	( TextIO.output(TextIO.stdErr,
-	    "Usage: hamlet -<mode>\n\
-	    \where <mode> is one of:\n\
-	    \  h   help:       print this message\n\
-	    \  p   parse mode: just parse input\n\
-	    \  l   elab mode:  parse and elaborate\n\
-	    \  v   eval mode:  parse and evaluate (no type checking!)\n\
-	    \  x   exec mode:  parse, elaborate, and evaluate\n"
-	  )
-	; TextIO.flushOut TextIO.stdErr
-	; OS.Process.failure
-	)
+        ( TextIO.output(TextIO.stdErr,
+            "Usage: hamlet -<mode>\n\
+            \where <mode> is one of:\n\
+            \  h   help:       print this message\n\
+            \  p   parse mode: just parse input\n\
+            \  l   elab mode:  parse and elaborate\n\
+            \  v   eval mode:  parse and evaluate (no type checking!)\n\
+            \  x   exec mode:  parse, elaborate, and evaluate\n"
+          )
+        ; TextIO.flushOut TextIO.stdErr
+        ; OS.Process.failure
+        )
 
     fun start process =
-	( TextIO.output(TextIO.stdOut, "HaMLet " ^ version ^
-				       " - to be or not to be SML\n")
-	; TextIO.flushOut TextIO.stdOut
-	; process()
-	; TextIO.output(TextIO.stdOut, "\n")
-	; TextIO.flushOut TextIO.stdOut
-	; OS.Process.success
-	)
+        ( TextIO.output(TextIO.stdOut, "HaMLet " ^ version ^
+                                       " - to be or not to be SML\n")
+        ; TextIO.flushOut TextIO.stdOut
+        ; process()
+        ; TextIO.output(TextIO.stdOut, "\n")
+        ; TextIO.flushOut TextIO.stdOut
+        ; OS.Process.success
+        )
 
     fun main' ["-h"] = ( usage() ; OS.Process.success )
       | main' ["-p"] = start Sml.parseSession
@@ -22883,18 +22883,18 @@
 structure Main =
    struct
       fun doit size =
-	 let
-	    open TextIO
-	    fun loop n =
-	       if n < 0
-		  then ()
-	       else
-		  let
-		     val _ = ins := openIn "DATA/hamlet-input.sml"
-		     val _ = Main.main' ["-x"]
-		  in loop (n - 1)
-		  end
-	 in 
-	    loop size
-	 end
+         let
+            open TextIO
+            fun loop n =
+               if n < 0
+                  then ()
+               else
+                  let
+                     val _ = ins := openIn "DATA/hamlet-input.sml"
+                     val _ = Main.main' ["-x"]
+                  in loop (n - 1)
+                  end
+         in 
+            loop size
+         end
    end

Modified: mlton/branches/on-20050420-cmm-branch/benchmark/tests/imp-for.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/benchmark/tests/imp-for.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/benchmark/tests/imp-for.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -3,8 +3,8 @@
   = let
       val i = ref start
       fun loop () = if !i >= stop
-		      then ()
-		      else (f (!i) ; i := !i + 1 ; loop ())
+                      then ()
+                      else (f (!i) ; i := !i + 1 ; loop ())
     in
       loop ()
     end
@@ -13,20 +13,20 @@
 struct
   fun doit ()
     = let
-	val x = ref 0
+        val x = ref 0
 
-	val _ = for (0, 10, fn _ =>
-	        for (0, 10, fn _ =>
-	        for (0, 10, fn _ =>
-	        for (0, 10, fn _ =>
-	        for (0, 10, fn _ =>
-		for (0, 10, fn _ => 
-		for (0, 10, fn _ => 
-		     x := !x + 1)))))))
+        val _ = for (0, 10, fn _ =>
+                for (0, 10, fn _ =>
+                for (0, 10, fn _ =>
+                for (0, 10, fn _ =>
+                for (0, 10, fn _ =>
+                for (0, 10, fn _ => 
+                for (0, 10, fn _ => 
+                     x := !x + 1)))))))
       in
-	if (!x) <> 10000000
-	  then raise Fail "bug"
-	  else ()
+        if (!x) <> 10000000
+          then raise Fail "bug"
+          else ()
       end
   val doit = fn size => for (0, size, fn _ => doit ())
 end

Modified: mlton/branches/on-20050420-cmm-branch/benchmark/tests/knuth-bendix.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/benchmark/tests/knuth-bendix.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/benchmark/tests/knuth-bendix.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -27,31 +27,31 @@
     val name = "Knuth-Bendix"
 
     fun length l = let
-	  fun j(k, nil) = k
-	    | j(k, a::x) = j(k+1,x)
-	  in
-	    j(0,l)
-	  end
+          fun j(k, nil) = k
+            | j(k, a::x) = j(k+1,x)
+          in
+            j(0,l)
+          end
     fun op @ (nil, l) = l
       | op @ (a::r, l) = a :: (r@l)
     fun rev l = let
-	  fun f (nil, h) = h
-	    | f (a::r, h) = f(r, a::h)
-	  in
-	    f(l,nil)
-	  end
+          fun f (nil, h) = h
+            | f (a::r, h) = f(r, a::h)
+          in
+            f(l,nil)
+          end
     fun app f = let
-	  fun app_rec [] = ()
+          fun app_rec [] = ()
             | app_rec (a::L) = (f a; app_rec L)
         in
-	  app_rec
+          app_rec
         end
     fun map f = let
-	  fun map_rec [] = []
+          fun map_rec [] = []
             | map_rec (a::L) = f a :: map_rec L
           in
-	    map_rec
-  	  end
+            map_rec
+          end
 
 (******* Quelques definitions du prelude CAML **************)
 
@@ -191,7 +191,7 @@
           else
             (v,M) :: subst
         | match_rec subst (Term(op1,sons1), Term(op2,sons2)) =
-	  if op1 = op2 then it_list2 match_rec subst sons1 sons2
+          if op1 = op2 then it_list2 match_rec subst sons1 sons2
                        else failwith "matching"
         | match_rec _ _ = failwith "matching"
   in match_rec [] (term1,term2)
@@ -217,7 +217,7 @@
       else [(n2,term1)]
   | unify (Term(op1,sons1), Term(op2,sons2)) =
       if op1 = op2 then 
-	it_list2 (fn s => fn (t1,t2) => compsubst (unify(substitute s t1,
+        it_list2 (fn s => fn (t1,t2) => compsubst (unify(substitute s t1,
                                                          substitute s t2)) s)
                  [] sons1 sons2
       else failwith "unify"
@@ -239,7 +239,7 @@
       else
        (print_string oper;
         case sons of
-	     []   => ()
+             []   => ()
           | t::lt =>(print_string "(";
                      pretty_term t;
                      app (fn t => (print_string ","; pretty_term t)) lt;
@@ -264,8 +264,8 @@
 
 (* checks that rules are numbered in sequence and returns their number *)
 fun check_rules l = it_list (fn n => fn (k,_) =>
-	  if k=n+1 then k else failwith "Rule numbers not in sequence")
-	0 l
+          if k=n+1 then k else failwith "Rule numbers not in sequence")
+        0 l
 
 fun pretty_rule (k,(n,(M,N))) =
  (print_num k; print_string " : ";
@@ -589,11 +589,11 @@
     val doit =
        fn size =>
        let
-	  fun loop n =
-	     if n = 0
-		then ()
-	     else (doit();
-		   loop(n-1))
+          fun loop n =
+             if n = 0
+                then ()
+             else (doit();
+                   loop(n-1))
        in loop size
        end
     

Modified: mlton/branches/on-20050420-cmm-branch/benchmark/tests/lexgen.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/benchmark/tests/lexgen.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/benchmark/tests/lexgen.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -17,40 +17,40 @@
 see the COPYRIGHT NOTICE for details and restrictions.
 
     Changes:
-	07/25/89 (drt): added %header declaration, code to place
-		user declarations at same level as makeLexer, etc.
-		This is needed for the parser generator.
-	  /10/89 (appel): added %arg declaration (see lexgen.doc).
-	  /04/90 (drt): fixed following bug: couldn't use the lexer after an
-		error occurred -- NextTok and inquote weren't being reset
-	10/22/91 (drt): disabled use of lookahead
-	10/23/92 (drt): disabled use of $ operator (which involves lookahead),
-		added handlers for dictionary lookup routine
-	11/02/92 (drt): changed handler for exception Reject in generated lexer
-		to Internal.Reject
+        07/25/89 (drt): added %header declaration, code to place
+                user declarations at same level as makeLexer, etc.
+                This is needed for the parser generator.
+          /10/89 (appel): added %arg declaration (see lexgen.doc).
+          /04/90 (drt): fixed following bug: couldn't use the lexer after an
+                error occurred -- NextTok and inquote weren't being reset
+        10/22/91 (drt): disabled use of lookahead
+        10/23/92 (drt): disabled use of $ operator (which involves lookahead),
+                added handlers for dictionary lookup routine
+        11/02/92 (drt): changed handler for exception Reject in generated lexer
+                to Internal.Reject
         02/01/94 (appel): Moved the exception handler for Reject in such
-		a way as to allow tail-recursion (improves performance
-		wonderfully!).
-	02/01/94 (appel): Fixed a bug in parsing of state names.
-	05/19/94 (Mikael Pettersson, mpe@ida.liu.se):
-		Transition tables are usually represented as strings, but
-		when the range is too large, int vectors constructed by
-		code like "Vector.vector[1,2,3,...]" are used instead.
-		The problem with this isn't that the vector itself takes
-		a lot of space, but that the code generated by SML/NJ to
-		construct the intermediate list at run-time is *HUGE*. My
-		fix is to encode an int vector as a string literal (using
-		two bytes per int) and emit code to decode the string to
-		a vector at run-time. SML/NJ compiles string literals into
-		substrings in the code, so this uses much less space.
-	06/02/94 (jhr): Modified export-lex.sml to conform to new installation
-		scheme.  Also removed tab characters from string literals.
-	10/05/94 (jhr): Changed generator to produce code that uses the new
-		basis style strings and characters.
-	10/06/94 (jhr) Modified code to compile under new basis style strings
-		and characters.
-	02/08/95 (jhr) Modified to use new List module interface.
-	05/18/95 (jhr) changed Vector.vector to Vector.fromList
+                a way as to allow tail-recursion (improves performance
+                wonderfully!).
+        02/01/94 (appel): Fixed a bug in parsing of state names.
+        05/19/94 (Mikael Pettersson, mpe@ida.liu.se):
+                Transition tables are usually represented as strings, but
+                when the range is too large, int vectors constructed by
+                code like "Vector.vector[1,2,3,...]" are used instead.
+                The problem with this isn't that the vector itself takes
+                a lot of space, but that the code generated by SML/NJ to
+                construct the intermediate list at run-time is *HUGE*. My
+                fix is to encode an int vector as a string literal (using
+                two bytes per int) and emit code to decode the string to
+                a vector at run-time. SML/NJ compiles string literals into
+                substrings in the code, so this uses much less space.
+        06/02/94 (jhr): Modified export-lex.sml to conform to new installation
+                scheme.  Also removed tab characters from string literals.
+        10/05/94 (jhr): Changed generator to produce code that uses the new
+                basis style strings and characters.
+        10/06/94 (jhr) Modified code to compile under new basis style strings
+                and characters.
+        02/08/95 (jhr) Modified to use new List module interface.
+        05/18/95 (jhr) changed Vector.vector to Vector.fromList
 *
  * $Log: lexgen.sml,v $
  * Revision 1.6  1996/10/03  14:57:30  jhr
@@ -138,15 +138,15 @@
 *)
 
 functor RedBlack(B : sig type key
-			 val > : key*key->bool
-		     end):
-	    sig type tree
-		type key
-		val empty : tree
-		val insert : key * tree -> tree
-		val lookup : key * tree -> key
-	 	exception notfound of key
-	    end =
+                         val > : key*key->bool
+                     end):
+            sig type tree
+                type key
+                val empty : tree
+                val insert : key * tree -> tree
+                val lookup : key * tree -> key
+                exception notfound of key
+            end =
 struct
  open B
  datatype color = RED | BLACK
@@ -156,43 +156,43 @@
  fun insert (key,t) =
   let fun f empty = tree(key,RED,empty,empty)
         | f (tree(k,BLACK,l,r)) =
-	    if key>k
-	    then case f r
-		 of r as tree(rk,RED, rl as tree(rlk,RED,rll,rlr),rr) =>
-			(case l
-			 of tree(lk,RED,ll,lr) =>
-				tree(k,RED,tree(lk,BLACK,ll,lr),
-					   tree(rk,BLACK,rl,rr))
-			  | _ => tree(rlk,BLACK,tree(k,RED,l,rll),
-						tree(rk,RED,rlr,rr)))
-		  | r as tree(rk,RED,rl, rr as tree(rrk,RED,rrl,rrr)) =>
-			(case l
-			 of tree(lk,RED,ll,lr) =>
-				tree(k,RED,tree(lk,BLACK,ll,lr),
-					   tree(rk,BLACK,rl,rr))
-			  | _ => tree(rk,BLACK,tree(k,RED,l,rl),rr))
-	          | r => tree(k,BLACK,l,r)
-	    else if k>key
-	    then case f l
-	         of l as tree(lk,RED,ll, lr as tree(lrk,RED,lrl,lrr)) =>
-			(case r
-			 of tree(rk,RED,rl,rr) =>
-				tree(k,RED,tree(lk,BLACK,ll,lr),
-					   tree(rk,BLACK,rl,rr))
-			  | _ => tree(lrk,BLACK,tree(lk,RED,ll,lrl),
-						tree(k,RED,lrr,r)))
-		  | l as tree(lk,RED, ll as tree(llk,RED,lll,llr), lr) =>
-			(case r
-			 of tree(rk,RED,rl,rr) =>
-				tree(k,RED,tree(lk,BLACK,ll,lr),
-					   tree(rk,BLACK,rl,rr))
-			  | _ => tree(lk,BLACK,ll,tree(k,RED,lr,r)))
-	          | l => tree(k,BLACK,l,r)
-	    else tree(key,BLACK,l,r)
+            if key>k
+            then case f r
+                 of r as tree(rk,RED, rl as tree(rlk,RED,rll,rlr),rr) =>
+                        (case l
+                         of tree(lk,RED,ll,lr) =>
+                                tree(k,RED,tree(lk,BLACK,ll,lr),
+                                           tree(rk,BLACK,rl,rr))
+                          | _ => tree(rlk,BLACK,tree(k,RED,l,rll),
+                                                tree(rk,RED,rlr,rr)))
+                  | r as tree(rk,RED,rl, rr as tree(rrk,RED,rrl,rrr)) =>
+                        (case l
+                         of tree(lk,RED,ll,lr) =>
+                                tree(k,RED,tree(lk,BLACK,ll,lr),
+                                           tree(rk,BLACK,rl,rr))
+                          | _ => tree(rk,BLACK,tree(k,RED,l,rl),rr))
+                  | r => tree(k,BLACK,l,r)
+            else if k>key
+            then case f l
+                 of l as tree(lk,RED,ll, lr as tree(lrk,RED,lrl,lrr)) =>
+                        (case r
+                         of tree(rk,RED,rl,rr) =>
+                                tree(k,RED,tree(lk,BLACK,ll,lr),
+                                           tree(rk,BLACK,rl,rr))
+                          | _ => tree(lrk,BLACK,tree(lk,RED,ll,lrl),
+                                                tree(k,RED,lrr,r)))
+                  | l as tree(lk,RED, ll as tree(llk,RED,lll,llr), lr) =>
+                        (case r
+                         of tree(rk,RED,rl,rr) =>
+                                tree(k,RED,tree(lk,BLACK,ll,lr),
+                                           tree(rk,BLACK,rl,rr))
+                          | _ => tree(lk,BLACK,ll,tree(k,RED,lr,r)))
+                  | l => tree(k,BLACK,l,r)
+            else tree(key,BLACK,l,r)
         | f (tree(k,RED,l,r)) =
-	    if key>k then tree(k,RED,l, f r)
-	    else if k>key then tree(k,RED, f l, r)
-	    else tree(key,RED,l,r)
+            if key>k then tree(k,RED,l, f r)
+            else if k>key then tree(k,RED, f l, r)
+            else tree(key,RED,l,r)
    in case f t
       of tree(k,RED, l as tree(_,RED,_,_), r) => tree(k,BLACK,l,r)
        | tree(k,RED, l, r as tree(_,RED,_,_)) => tree(k,BLACK,l,r)
@@ -202,10 +202,10 @@
 
  fun lookup (key,t) =
   let fun look empty = raise (notfound key)
-	| look (tree(k,_,l,r)) =
-		if k>key then look l
-		else if key>k then look r
-		else k
+        | look (tree(k,_,l,r)) =
+                if k>key then look l
+                else if key>k then look r
+                else k
    in look t
   end
 
@@ -222,19 +222,19 @@
    infix 9 sub
 
    datatype token = CHARS of bool array | QMARK | STAR | PLUS | BAR
-	  | LP | RP | CARAT | DOLLAR | SLASH | STATE of string list
-	  | REPS of int * int | ID of string | ACTION of string
-	  | BOF | EOF | ASSIGN | SEMI | ARROW | LEXMARK | LEXSTATES  |
-	    COUNT | REJECT | FULLCHARSET | STRUCT | HEADER | ARG
-	
+          | LP | RP | CARAT | DOLLAR | SLASH | STATE of string list
+          | REPS of int * int | ID of string | ACTION of string
+          | BOF | EOF | ASSIGN | SEMI | ARROW | LEXMARK | LEXSTATES  |
+            COUNT | REJECT | FULLCHARSET | STRUCT | HEADER | ARG
+        
    datatype exp = EPS | CLASS of bool array * int | CLOSURE of exp
-		| ALT of exp * exp | CAT of exp * exp | TRAIL of int
-		| END of int
+                | ALT of exp * exp | CAT of exp * exp | TRAIL of int
+                | END of int
 
    (* flags describing input Lex spec. - unnecessary code is omitted *)
    (* if possible *)
 
-   val CharFormat = ref false;	
+   val CharFormat = ref false;  
    val UsesTrailingContext = ref false;
    val UsesPrevNewLine = ref false;
    
@@ -258,11 +258,11 @@
    val StrDecl = ref false
 
    val ResetFlags = fn () => (CountNewLines := false; HaveReject := false;
-			      UsesTrailingContext := false;
-			       CharSetSize := 129; StrName := "Mlex";
-				HeaderCode := ""; HeaderDecl:= false;
-				ArgCode := NONE; 
-				StrDecl := false)
+                              UsesTrailingContext := false;
+                               CharSetSize := 129; StrName := "Mlex";
+                                HeaderCode := ""; HeaderDecl:= false;
+                                ArgCode := NONE; 
+                                StrDecl := false)
 
    val LexOut = ref(TextIO.stdOut)
    fun say x = TextIO.output(!LexOut, x)
@@ -270,51 +270,51 @@
 (* Union: merge two sorted lists of integers *)
 
 fun union(a,b) = let val rec merge = fn
-	  (nil,nil,z) => z
-	| (nil,el::more,z) => merge(nil,more,el::z)
-	| (el::more,nil,z) => merge(more,nil,el::z)
-	| (x::morex,y::morey,z) => if (x:int)=(y:int)
-		then merge(morex,morey,x::z)
-		else if x>y then merge(morex,y::morey,x::z)
-		else merge(x::morex,morey,y::z)
-	in merge(rev a,rev b,nil)
+          (nil,nil,z) => z
+        | (nil,el::more,z) => merge(nil,more,el::z)
+        | (el::more,nil,z) => merge(more,nil,el::z)
+        | (x::morex,y::morey,z) => if (x:int)=(y:int)
+                then merge(morex,morey,x::z)
+                else if x>y then merge(morex,y::morey,x::z)
+                else merge(x::morex,morey,y::z)
+        in merge(rev a,rev b,nil)
 end
 
 (* Nullable: compute if a important expression parse tree node is nullable *)
 
 val rec nullable = fn
-	  EPS => true
-	| CLASS(_) => false
-	| CLOSURE(_) => true
-	| ALT(n1,n2) => nullable(n1) orelse nullable(n2)
-	| CAT(n1,n2) => nullable(n1) andalso nullable(n2)
-	| TRAIL(_) => true
-	| END(_) => false
+          EPS => true
+        | CLASS(_) => false
+        | CLOSURE(_) => true
+        | ALT(n1,n2) => nullable(n1) orelse nullable(n2)
+        | CAT(n1,n2) => nullable(n1) andalso nullable(n2)
+        | TRAIL(_) => true
+        | END(_) => false
 
 (* FIRSTPOS: firstpos function for parse tree expressions *)
 
 and firstpos = fn
-	  EPS => nil
-	| CLASS(_,i) => [i]
-	| CLOSURE(n) => firstpos(n)
-	| ALT(n1,n2) => union(firstpos(n1),firstpos(n2))
-	| CAT(n1,n2) => if nullable(n1) then union(firstpos(n1),firstpos(n2))
-		else firstpos(n1)
-	| TRAIL(i) => [i]
-	| END(i) => [i]
+          EPS => nil
+        | CLASS(_,i) => [i]
+        | CLOSURE(n) => firstpos(n)
+        | ALT(n1,n2) => union(firstpos(n1),firstpos(n2))
+        | CAT(n1,n2) => if nullable(n1) then union(firstpos(n1),firstpos(n2))
+                else firstpos(n1)
+        | TRAIL(i) => [i]
+        | END(i) => [i]
 
 (* LASTPOS: Lastpos function for parse tree expressions *)
 
 and lastpos = fn
-	  EPS => nil
-	| CLASS(_,i) => [i]
-	| CLOSURE(n) => lastpos(n)
-	| ALT(n1,n2) => union(lastpos(n1),lastpos(n2))
-	| CAT(n1,n2) => if nullable(n2) then union(lastpos(n1),lastpos(n2))
-		else lastpos(n2)
-	| TRAIL(i) => [i]
-	| END(i) => [i]
-	;
+          EPS => nil
+        | CLASS(_,i) => [i]
+        | CLOSURE(n) => lastpos(n)
+        | ALT(n1,n2) => union(lastpos(n1),lastpos(n2))
+        | CAT(n1,n2) => if nullable(n2) then union(lastpos(n1),lastpos(n2))
+                else lastpos(n2)
+        | TRAIL(i) => [i]
+        | END(i) => [i]
+        ;
 
 (* ++: Increment an integer reference *)
 
@@ -367,42 +367,42 @@
 abstype ibuf =
       BUF of TextIO.instream * {b : string ref, p : int ref}
 with
-	fun make_ibuf(s) = BUF (s, {b=ref"", p = ref 0})
-	fun close_ibuf (BUF (s,_)) = TextIO.closeIn(s)
-	exception eof
-	fun getch (a as (BUF(s,{b,p}))) = 
-		 if (!p = (size (!b)))
-		   then (b := TextIO.inputN(s, 1024);
-			 p := 0;
-			 if (size (!b))=0
-			    then raise eof 
-			    else getch a)
-		   else (let val ch = String.sub(!b,!p)
-			 in (if ch = #"\n"
-				 then LineNum := !LineNum + 1
-				 else ();
-			     p := !p + 1;
-			     ch)
-			 end)
+        fun make_ibuf(s) = BUF (s, {b=ref"", p = ref 0})
+        fun close_ibuf (BUF (s,_)) = TextIO.closeIn(s)
+        exception eof
+        fun getch (a as (BUF(s,{b,p}))) = 
+                 if (!p = (size (!b)))
+                   then (b := TextIO.inputN(s, 1024);
+                         p := 0;
+                         if (size (!b))=0
+                            then raise eof 
+                            else getch a)
+                   else (let val ch = String.sub(!b,!p)
+                         in (if ch = #"\n"
+                                 then LineNum := !LineNum + 1
+                                 else ();
+                             p := !p + 1;
+                             ch)
+                         end)
 
-	fun ungetch(BUF(s,{b,p})) = (
-	   p := !p - 1;
-	   if String.sub(!b,!p) = #"\n"
-	      then LineNum := !LineNum - 1
-	      else ())
+        fun ungetch(BUF(s,{b,p})) = (
+           p := !p - 1;
+           if String.sub(!b,!p) = #"\n"
+              then LineNum := !LineNum - 1
+              else ())
 end;
 
 exception Error
 
 fun prErr x = (
       TextIO.output (TextIO.stdErr, String.concat [
-	  "ml-lex: error, line ", (Int.toString (!LineNum)), ": ", x, "\n"
-	]);
+          "ml-lex: error, line ", (Int.toString (!LineNum)), ": ", x, "\n"
+        ]);
       raise Error)
 fun prSynErr x = (
       TextIO.output (TextIO.stdErr, String.concat [
-	  "ml-lex: syntax error, line ", (Int.toString (!LineNum)), ": ", x, "\n"
-	]);
+          "ml-lex: syntax error, line ", (Int.toString (!LineNum)), ": ", x, "\n"
+        ]);
       raise Error)
 
 exception SyntaxError; (* error in user's input file *)
@@ -416,301 +416,301 @@
 
 fun AdvanceTok () : unit = let
       fun isLetter c =
-	    ((c >= #"a") andalso (c <= #"z")) orelse
-	    ((c >= #"A") andalso (c <= #"Z"))
+            ((c >= #"a") andalso (c <= #"z")) orelse
+            ((c >= #"A") andalso (c <= #"Z"))
       fun isDigit c = (c >= #"0") andalso (c <= #"9")
     (* check for valid (non-leading) identifier character (added by JHR) *)
       fun isIdentChr c =
-	    ((isLetter c) orelse (isDigit c) orelse (c = #"_") orelse (c = #"'"))
+            ((isLetter c) orelse (isDigit c) orelse (c = #"_") orelse (c = #"'"))
       fun atoi s = let
-	    fun num (c::r, n) = if isDigit c
-		  then num (r, 10*n + (Char.ord c - Char.ord #"0"))
-		  else n
-	      | num ([], n) = n
-	    in
-	      num (explode s, 0)
-	    end
+            fun num (c::r, n) = if isDigit c
+                  then num (r, 10*n + (Char.ord c - Char.ord #"0"))
+                  else n
+              | num ([], n) = n
+            in
+              num (explode s, 0)
+            end
 
       fun skipws () = (case nextch()
-	     of #" " => skipws()
-	      | #"\t" => skipws() 
-	      | #"\n" => skipws()
-	      | x => x
-	    (* end case *))
-		
+             of #" " => skipws()
+              | #"\t" => skipws() 
+              | #"\n" => skipws()
+              | x => x
+            (* end case *))
+                
       and nextch () = getch(!LexBuf) 
 
       and escaped () = (case nextch()
-	     of #"b" => #"\008"
-	      | #"n" => #"\n"
-	      | #"t" => #"\t"
-	      | #"h" => #"\128"
-	      | x => let
-		  fun err t = prErr("illegal ascii escape '"^(implode(rev t))^"'")
-		  fun cvt c = (Char.ord c - Char.ord #"0")
-		  fun f (n, c, t) = if c=3
-			then if n >= (!CharSetSize)
-			  then err t
-			  else Char.chr n
-		        else let val ch=nextch()
-			  in
-			    if isDigit ch
-			      then f(n*10+(cvt ch), c+1, ch::t)
-		  	      else err t
-			  end
-		  in
-		    if isDigit x then f(cvt x, 1, [x]) else x
-		  end
-	    (* end case *))
-	
+             of #"b" => #"\008"
+              | #"n" => #"\n"
+              | #"t" => #"\t"
+              | #"h" => #"\128"
+              | x => let
+                  fun err t = prErr("illegal ascii escape '"^(implode(rev t))^"'")
+                  fun cvt c = (Char.ord c - Char.ord #"0")
+                  fun f (n, c, t) = if c=3
+                        then if n >= (!CharSetSize)
+                          then err t
+                          else Char.chr n
+                        else let val ch=nextch()
+                          in
+                            if isDigit ch
+                              then f(n*10+(cvt ch), c+1, ch::t)
+                              else err t
+                          end
+                  in
+                    if isDigit x then f(cvt x, 1, [x]) else x
+                  end
+            (* end case *))
+        
       and onechar x =
-	 let val c = array(!CharSetSize, false)
-	 in
-	    update(c, Char.ord(x), true);
-	    CHARS(c)
-	 end
-		
+         let val c = array(!CharSetSize, false)
+         in
+            update(c, Char.ord(x), true);
+            CHARS(c)
+         end
+                
       in case !LexState of 0 => let val makeTok = fn () =>
-		case skipws()
-			(* Lex % operators *)
-		 of #"%" => (case nextch() of 
-		  	  #"%" => LEXMARK
-			| a => let fun f s =
-				    let val a = nextch()
-				    in if isLetter a then f(a::s)
-					else (ungetch(!LexBuf);
-					      implode(rev s))
-				    end
-				val command = f [a]
-				in if command = "reject" then REJECT
-				   else if command = "count" then COUNT
-				   else if command = "full" then FULLCHARSET
-				   else if command = "s" then LEXSTATES
-				   else if command = "S" then LEXSTATES
-				   else if command = "structure" then STRUCT
-				   else if command = "header" then HEADER
-				   else if command = "arg" then ARG
-			           else prErr "unknown % operator "
-			        end
-			     )
-			(* semicolon (for end of LEXSTATES) *)
-		| #";" => SEMI
-			(* anything else *)
-		| ch => if isLetter(ch) then
-			 let fun getID matched =
-			     let val x = nextch()
+                case skipws()
+                        (* Lex % operators *)
+                 of #"%" => (case nextch() of 
+                          #"%" => LEXMARK
+                        | a => let fun f s =
+                                    let val a = nextch()
+                                    in if isLetter a then f(a::s)
+                                        else (ungetch(!LexBuf);
+                                              implode(rev s))
+                                    end
+                                val command = f [a]
+                                in if command = "reject" then REJECT
+                                   else if command = "count" then COUNT
+                                   else if command = "full" then FULLCHARSET
+                                   else if command = "s" then LEXSTATES
+                                   else if command = "S" then LEXSTATES
+                                   else if command = "structure" then STRUCT
+                                   else if command = "header" then HEADER
+                                   else if command = "arg" then ARG
+                                   else prErr "unknown % operator "
+                                end
+                             )
+                        (* semicolon (for end of LEXSTATES) *)
+                | #";" => SEMI
+                        (* anything else *)
+                | ch => if isLetter(ch) then
+                         let fun getID matched =
+                             let val x = nextch()
 (**** fix by JHR
-			     in if isLetter(x) orelse isDigit(x) orelse
+                             in if isLetter(x) orelse isDigit(x) orelse
                                    x = "_" orelse x = "'"
 ****)
-			     in if (isIdentChr x)
-				 then getID (x::matched)
-				 else (ungetch(!LexBuf); implode(rev matched))
-			     end
-			in ID(getID [ch])
-			end
-		      else (prSynErr ("bad character: " ^ String.str ch))
-	in NextTok := makeTok()
-	end
-	| 1 => let val rec makeTok = fn () =>
-		if !inquote then case nextch() of
-			(* inside quoted string *)
-		  #"\\" => onechar(escaped())
-		| #"\"" => (inquote := false; makeTok())
-		| x => onechar(x)
-		else case skipws() of
-			(* single character operators *)
-		  #"?" => QMARK
-		| #"*" => STAR
-		| #"+" => PLUS
-		| #"|" => BAR
-		| #"(" => LP
-		| #")" => RP
-		| #"^" => CARAT
-		| #"$" => DOLLAR
-		| #"/" => SLASH
-		| #";" => SEMI
-		| #"." => let val c = array(!CharSetSize,true) in
-				update(c,10,false); CHARS(c)
-			end
-			(* assign and arrow *)
-		| #"=" => let val c = nextch() in
-			if c = #">" then ARROW else (ungetch(!LexBuf); ASSIGN)
-		end
-			(* character set *)
-		| #"[" => let val rec classch = fn () => let val x = skipws()
-				in if x = #"\\" then escaped() else x
-				end;
-			val first = classch();
-			val flag = (first <> #"^");
-			val c = array(!CharSetSize,not flag);
-			fun add NONE = ()
-			  | add (SOME x) = update(c, Char.ord(x), flag)
-			and range (x, y) = if x>y
-			      then (prErr "bad char. range")
-			      else let
-				val i = ref(Char.ord(x)) and j = Char.ord(y)
-				in while !i<=j do (
-				  add (SOME(Char.chr(!i)));
-				  i := !i + 1)
-				end
-			and getClass last = (case classch()
-			     of #"]" => (add(last); c)
-			      | #"-" => (case last
-				   of NONE => getClass(SOME #"-")
-				    | (SOME last') => let val x = classch()
-					in
-					  if x = #"]"
-					    then (add(last); add(SOME #"-"); c)
-					    else (range(last',x); getClass(NONE))
-					end
-				  (* end case *))
-			      | x => (add(last); getClass(SOME x))
-			    (* end case *))
-		in CHARS(getClass(if first = #"^" then NONE else SOME first))
-		end
-			(* Start States specification *)
-		| #"<" => let val rec get_state = fn (prev,matched) =>
-			case nextch() of
-			  #">" => matched::prev
-			| #"," => get_state(matched::prev,"")
-			| x => if isIdentChr(x)
-				then get_state(prev,matched ^ String.str x)
-				else (prSynErr "bad start state list")
-		in STATE(get_state(nil,""))
-		end
-			(* {id} or repititions *)
-		| #"{" => let val ch = nextch() in if isLetter(ch) then
-			let fun getID matched = (case nextch()
-			  of #"}" => matched
-			   | x => if (isIdentChr x) then
-				getID(matched ^ String.str x)
-				else (prErr "invalid char. class name")
-			 (* end case *))
-			in ID(getID(String.str ch))
-			end
-			else if isDigit(ch) then
-			 let fun get_r (matched, r1) = (case nextch()
-				 of #"}" => let val n = atoi(matched) in
-					if r1 = ~1 then (n,n) else (r1,n)
-					end
-				  | #"," => if r1 = ~1 then get_r("",atoi(matched))
-				       else (prErr "invalid repetitions spec.")
-				  | x => if isDigit(x)
-				    then get_r(matched ^ String.str x,r1)
-			            else (prErr "invalid char in repetitions spec")
-				(* end case *))
-			 in REPS(get_r(String.str ch,~1))
-			 end
-			else (prErr "bad repetitions spec")
-		end
-			(* Lex % operators *)
-		| #"%" => if nextch() = #"%" then LEXMARK else 
-			    (ungetch(!LexBuf); onechar (#"%"))
-			(* backslash escape *)
-		| #"\\" => onechar(escaped())
-			(* start quoted string *)
-		| #"\"" => (inquote := true; makeTok())
-			(* anything else *)
-		| ch => onechar(ch)
-	in NextTok := makeTok()
-	end
-	| 2 => NextTok :=
-	     (case skipws()
-		 of #"(" => let
-			fun GetAct (lpct,x) = (case getch(!LexBuf)
-			       of #"(" => GetAct (lpct+1, #"("::x)
-				| #")" => if lpct = 0 then (implode (rev x))
-					 	      else GetAct(lpct-1, #")"::x)
-				| y => GetAct(lpct,y::x)
-			      (* end case *))
-			in ACTION (GetAct (0,nil))
-			end
-		 | #";" => SEMI
-		 | c => (prSynErr ("invalid character " ^ String.str c)))
-	| _ => raise LexError
+                             in if (isIdentChr x)
+                                 then getID (x::matched)
+                                 else (ungetch(!LexBuf); implode(rev matched))
+                             end
+                        in ID(getID [ch])
+                        end
+                      else (prSynErr ("bad character: " ^ String.str ch))
+        in NextTok := makeTok()
+        end
+        | 1 => let val rec makeTok = fn () =>
+                if !inquote then case nextch() of
+                        (* inside quoted string *)
+                  #"\\" => onechar(escaped())
+                | #"\"" => (inquote := false; makeTok())
+                | x => onechar(x)
+                else case skipws() of
+                        (* single character operators *)
+                  #"?" => QMARK
+                | #"*" => STAR
+                | #"+" => PLUS
+                | #"|" => BAR
+                | #"(" => LP
+                | #")" => RP
+                | #"^" => CARAT
+                | #"$" => DOLLAR
+                | #"/" => SLASH
+                | #";" => SEMI
+                | #"." => let val c = array(!CharSetSize,true) in
+                                update(c,10,false); CHARS(c)
+                        end
+                        (* assign and arrow *)
+                | #"=" => let val c = nextch() in
+                        if c = #">" then ARROW else (ungetch(!LexBuf); ASSIGN)
+                end
+                        (* character set *)
+                | #"[" => let val rec classch = fn () => let val x = skipws()
+                                in if x = #"\\" then escaped() else x
+                                end;
+                        val first = classch();
+                        val flag = (first <> #"^");
+                        val c = array(!CharSetSize,not flag);
+                        fun add NONE = ()
+                          | add (SOME x) = update(c, Char.ord(x), flag)
+                        and range (x, y) = if x>y
+                              then (prErr "bad char. range")
+                              else let
+                                val i = ref(Char.ord(x)) and j = Char.ord(y)
+                                in while !i<=j do (
+                                  add (SOME(Char.chr(!i)));
+                                  i := !i + 1)
+                                end
+                        and getClass last = (case classch()
+                             of #"]" => (add(last); c)
+                              | #"-" => (case last
+                                   of NONE => getClass(SOME #"-")
+                                    | (SOME last') => let val x = classch()
+                                        in
+                                          if x = #"]"
+                                            then (add(last); add(SOME #"-"); c)
+                                            else (range(last',x); getClass(NONE))
+                                        end
+                                  (* end case *))
+                              | x => (add(last); getClass(SOME x))
+                            (* end case *))
+                in CHARS(getClass(if first = #"^" then NONE else SOME first))
+                end
+                        (* Start States specification *)
+                | #"<" => let val rec get_state = fn (prev,matched) =>
+                        case nextch() of
+                          #">" => matched::prev
+                        | #"," => get_state(matched::prev,"")
+                        | x => if isIdentChr(x)
+                                then get_state(prev,matched ^ String.str x)
+                                else (prSynErr "bad start state list")
+                in STATE(get_state(nil,""))
+                end
+                        (* {id} or repititions *)
+                | #"{" => let val ch = nextch() in if isLetter(ch) then
+                        let fun getID matched = (case nextch()
+                          of #"}" => matched
+                           | x => if (isIdentChr x) then
+                                getID(matched ^ String.str x)
+                                else (prErr "invalid char. class name")
+                         (* end case *))
+                        in ID(getID(String.str ch))
+                        end
+                        else if isDigit(ch) then
+                         let fun get_r (matched, r1) = (case nextch()
+                                 of #"}" => let val n = atoi(matched) in
+                                        if r1 = ~1 then (n,n) else (r1,n)
+                                        end
+                                  | #"," => if r1 = ~1 then get_r("",atoi(matched))
+                                       else (prErr "invalid repetitions spec.")
+                                  | x => if isDigit(x)
+                                    then get_r(matched ^ String.str x,r1)
+                                    else (prErr "invalid char in repetitions spec")
+                                (* end case *))
+                         in REPS(get_r(String.str ch,~1))
+                         end
+                        else (prErr "bad repetitions spec")
+                end
+                        (* Lex % operators *)
+                | #"%" => if nextch() = #"%" then LEXMARK else 
+                            (ungetch(!LexBuf); onechar (#"%"))
+                        (* backslash escape *)
+                | #"\\" => onechar(escaped())
+                        (* start quoted string *)
+                | #"\"" => (inquote := true; makeTok())
+                        (* anything else *)
+                | ch => onechar(ch)
+        in NextTok := makeTok()
+        end
+        | 2 => NextTok :=
+             (case skipws()
+                 of #"(" => let
+                        fun GetAct (lpct,x) = (case getch(!LexBuf)
+                               of #"(" => GetAct (lpct+1, #"("::x)
+                                | #")" => if lpct = 0 then (implode (rev x))
+                                                      else GetAct(lpct-1, #")"::x)
+                                | y => GetAct(lpct,y::x)
+                              (* end case *))
+                        in ACTION (GetAct (0,nil))
+                        end
+                 | #";" => SEMI
+                 | c => (prSynErr ("invalid character " ^ String.str c)))
+        | _ => raise LexError
 end
 handle eof => NextTok := EOF ;
 
 fun GetTok (_:unit) : token = 
-	let val t = !NextTok in AdvanceTok(); t
-	end;
+        let val t = !NextTok in AdvanceTok(); t
+        end;
 val SymTab = ref (create String.<=) : (string,exp) dictionary ref
 
 fun GetExp () : exp =
 
-	let val rec optional = fn e => ALT(EPS,e)
+        let val rec optional = fn e => ALT(EPS,e)
 
-	    and lookup' = fn name =>
-		lookup(!SymTab) name 
-		handle LOOKUP => prErr ("bad regular expression name: "^
-					    name)
+            and lookup' = fn name =>
+                lookup(!SymTab) name 
+                handle LOOKUP => prErr ("bad regular expression name: "^
+                                            name)
 
-	and newline = fn () => let val c = array(!CharSetSize,false) in
-		update(c,10,true); c
-		end
-	
-	and endline = fn e => trail(e,CLASS(newline(),0))
-	
-	and trail = fn (e1,e2) => CAT(CAT(e1,TRAIL(0)),e2)
-	
-	and closure1 = fn e => CAT(e,CLOSURE(e))
-	
-	and repeat = fn (min,max,e) => let val rec rep = fn
-		  (0,0) => EPS
-		| (0,1) => ALT(e,EPS)
-		| (0,i) => CAT(rep(0,1),rep(0,i-1))
-		| (i,j) => CAT(e,rep(i-1,j-1))
-	in rep(min,max)
-	end
-	
-	and exp0 = fn () => case GetTok() of
-		  CHARS(c) => exp1(CLASS(c,0))
-		| LP => let val e = exp0() in
-		 if !NextTok = RP then
-		  (AdvanceTok(); exp1(e))
-		 else (prSynErr "missing '('") end
-		| ID(name) => exp1(lookup' name)
-		| _ => raise SyntaxError
-		
-	and exp1 = fn (e) => case !NextTok of
-		  SEMI => e
-		| ARROW => e
-		| EOF => e
-		| LP => exp2(e,exp0())
-		| RP => e
-		| t => (AdvanceTok(); case t of
-			  QMARK => exp1(optional(e))
-			| STAR => exp1(CLOSURE(e))
-			| PLUS => exp1(closure1(e))
-			| CHARS(c) => exp2(e,CLASS(c,0))
-			| BAR => ALT(e,exp0())
-			| DOLLAR => (UsesTrailingContext := true; endline(e))
-			| SLASH => (UsesTrailingContext := true;
-				    trail(e,exp0()))
-			| REPS(i,j) => exp1(repeat(i,j,e))
-			| ID(name) => exp2(e,lookup' name)
-			| _ => raise SyntaxError)
-			
-	and exp2 = fn (e1,e2) => case !NextTok of
-		  SEMI => CAT(e1,e2)
-		| ARROW => CAT(e1,e2)
-		| EOF => CAT(e1,e2)
-		| LP => exp2(CAT(e1,e2),exp0())
-		| RP => CAT(e1,e2)
-		| t => (AdvanceTok(); case t of
-		  	  QMARK => exp1(CAT(e1,optional(e2)))
-			| STAR => exp1(CAT(e1,CLOSURE(e2)))
-			| PLUS => exp1(CAT(e1,closure1(e2)))
-			| CHARS(c) => exp2(CAT(e1,e2),CLASS(c,0))
-			| BAR => ALT(CAT(e1,e2),exp0())
-			| DOLLAR => (UsesTrailingContext := true;
-				     endline(CAT(e1,e2)))
-			| SLASH => (UsesTrailingContext := true;
-				    trail(CAT(e1,e2),exp0()))
-			| REPS(i,j) => exp1(CAT(e1,repeat(i,j,e2)))
-			| ID(name) => exp2(CAT(e1,e2),lookup' name)
-			| _ => raise SyntaxError)
+        and newline = fn () => let val c = array(!CharSetSize,false) in
+                update(c,10,true); c
+                end
+        
+        and endline = fn e => trail(e,CLASS(newline(),0))
+        
+        and trail = fn (e1,e2) => CAT(CAT(e1,TRAIL(0)),e2)
+        
+        and closure1 = fn e => CAT(e,CLOSURE(e))
+        
+        and repeat = fn (min,max,e) => let val rec rep = fn
+                  (0,0) => EPS
+                | (0,1) => ALT(e,EPS)
+                | (0,i) => CAT(rep(0,1),rep(0,i-1))
+                | (i,j) => CAT(e,rep(i-1,j-1))
+        in rep(min,max)
+        end
+        
+        and exp0 = fn () => case GetTok() of
+                  CHARS(c) => exp1(CLASS(c,0))
+                | LP => let val e = exp0() in
+                 if !NextTok = RP then
+                  (AdvanceTok(); exp1(e))
+                 else (prSynErr "missing '('") end
+                | ID(name) => exp1(lookup' name)
+                | _ => raise SyntaxError
+                
+        and exp1 = fn (e) => case !NextTok of
+                  SEMI => e
+                | ARROW => e
+                | EOF => e
+                | LP => exp2(e,exp0())
+                | RP => e
+                | t => (AdvanceTok(); case t of
+                          QMARK => exp1(optional(e))
+                        | STAR => exp1(CLOSURE(e))
+                        | PLUS => exp1(closure1(e))
+                        | CHARS(c) => exp2(e,CLASS(c,0))
+                        | BAR => ALT(e,exp0())
+                        | DOLLAR => (UsesTrailingContext := true; endline(e))
+                        | SLASH => (UsesTrailingContext := true;
+                                    trail(e,exp0()))
+                        | REPS(i,j) => exp1(repeat(i,j,e))
+                        | ID(name) => exp2(e,lookup' name)
+                        | _ => raise SyntaxError)
+                        
+        and exp2 = fn (e1,e2) => case !NextTok of
+                  SEMI => CAT(e1,e2)
+                | ARROW => CAT(e1,e2)
+                | EOF => CAT(e1,e2)
+                | LP => exp2(CAT(e1,e2),exp0())
+                | RP => CAT(e1,e2)
+                | t => (AdvanceTok(); case t of
+                          QMARK => exp1(CAT(e1,optional(e2)))
+                        | STAR => exp1(CAT(e1,CLOSURE(e2)))
+                        | PLUS => exp1(CAT(e1,closure1(e2)))
+                        | CHARS(c) => exp2(CAT(e1,e2),CLASS(c,0))
+                        | BAR => ALT(CAT(e1,e2),exp0())
+                        | DOLLAR => (UsesTrailingContext := true;
+                                     endline(CAT(e1,e2)))
+                        | SLASH => (UsesTrailingContext := true;
+                                    trail(CAT(e1,e2),exp0()))
+                        | REPS(i,j) => exp1(CAT(e1,repeat(i,j,e2)))
+                        | ID(name) => exp2(CAT(e1,e2),lookup' name)
+                        | _ => raise SyntaxError)
 in exp0()
 end;
 val StateTab = ref(create(String.<=)) : (string,int) dictionary ref 
@@ -720,127 +720,127 @@
 fun GetStates () : int list =
 
    let fun add nil sl = sl
-  	  | add (x::y) sl = add y (union ([lookup (!StateTab)(x)
-					   handle LOOKUP =>
-					      prErr ("bad state name: "^x)
-					  ],sl))
+          | add (x::y) sl = add y (union ([lookup (!StateTab)(x)
+                                           handle LOOKUP =>
+                                              prErr ("bad state name: "^x)
+                                          ],sl))
 
-	fun addall i sl = 
-	    if i <= !StateNum then addall (i+2) (union ([i],sl))
-	    else sl
+        fun addall i sl = 
+            if i <= !StateNum then addall (i+2) (union ([i],sl))
+            else sl
 
-	fun incall (x::y) = (x+1)::incall y
-	  | incall nil = nil
+        fun incall (x::y) = (x+1)::incall y
+          | incall nil = nil
 
-	fun addincs nil = nil
-  	  | addincs (x::y) = x::(x+1)::addincs y
+        fun addincs nil = nil
+          | addincs (x::y) = x::(x+1)::addincs y
 
-	val state_list =
-	   case !NextTok of 
-	     STATE s => (AdvanceTok(); LexState := 1; add s nil)
-	     | _ => addall 1 nil
-		
+        val state_list =
+           case !NextTok of 
+             STATE s => (AdvanceTok(); LexState := 1; add s nil)
+             | _ => addall 1 nil
+                
       in case !NextTok
-	   of CARAT => (LexState := 1; AdvanceTok(); UsesPrevNewLine := true;
-			incall state_list)
-	    | _ => addincs state_list
+           of CARAT => (LexState := 1; AdvanceTok(); UsesPrevNewLine := true;
+                        incall state_list)
+            | _ => addincs state_list
       end
 
 val LeafNum = ref ~1;
 
 fun renum(e : exp) : exp =
-	let val rec label = fn
-	  EPS => EPS
-	| CLASS(x,_) => CLASS(x,++LeafNum)
-	| CLOSURE(e) => CLOSURE(label(e))
-	| ALT(e1,e2) => ALT(label(e1),label(e2))
-	| CAT(e1,e2) => CAT(label(e1),label(e2))
-	| TRAIL(i) => TRAIL(++LeafNum)
-	| END(i) => END(++LeafNum)
+        let val rec label = fn
+          EPS => EPS
+        | CLASS(x,_) => CLASS(x,++LeafNum)
+        | CLOSURE(e) => CLOSURE(label(e))
+        | ALT(e1,e2) => ALT(label(e1),label(e2))
+        | CAT(e1,e2) => CAT(label(e1),label(e2))
+        | TRAIL(i) => TRAIL(++LeafNum)
+        | END(i) => END(++LeafNum)
 in label(e)
 end;
 
 exception ParseError;
 
 fun parse() : (string * (int list * exp) list * ((string,string) dictionary)) =
-	let val Accept = ref (create String.<=) : (string,string) dictionary ref
-	val rec ParseRtns = fn l => case getch(!LexBuf) of
-		  #"%" => let val c = getch(!LexBuf) in
-		    	   if c = #"%" then (implode (rev l))
-			   else ParseRtns(c :: #"%" :: l)
-			end
-		| c => ParseRtns(c::l)
-	and ParseDefs = fn () =>
-		(LexState:=0; AdvanceTok(); case !NextTok of
-		  LEXMARK => ()
-		| LEXSTATES =>
-		   let fun f () = (case !NextTok of (ID i) =>
-				    (StateTab := enter(!StateTab)(i,++StateNum);
-				     ++StateNum; AdvanceTok(); f())
-					| _ => ())
-		   in AdvanceTok(); f ();
-		      if !NextTok=SEMI then ParseDefs() else 
-			(prSynErr "expected ';'")
-		   end
-		| ID x => (LexState:=1; AdvanceTok(); if GetTok() = ASSIGN
-			  then (SymTab := enter(!SymTab)(x,GetExp());
-			       if !NextTok = SEMI then ParseDefs()
-			       else (prSynErr "expected ';'"))
-			else raise SyntaxError)
-		| REJECT => (HaveReject := true; ParseDefs())
-		| COUNT => (CountNewLines := true; ParseDefs())
-		| FULLCHARSET => (CharSetSize := 256; ParseDefs())
-		| HEADER => (LexState := 2; AdvanceTok();
-			     case GetTok()
-			     of ACTION s => 
-				if (!StrDecl) then
-				   (prErr "cannot have both %s and %header \
-				    \declarations")
-				else if (!HeaderDecl) then
-				   (prErr "duplicate %header declarations")
-				else 
-				    (HeaderCode := s; LexState := 0;
-				     HeaderDecl := true; ParseDefs())
-				| _ => raise SyntaxError)
+        let val Accept = ref (create String.<=) : (string,string) dictionary ref
+        val rec ParseRtns = fn l => case getch(!LexBuf) of
+                  #"%" => let val c = getch(!LexBuf) in
+                           if c = #"%" then (implode (rev l))
+                           else ParseRtns(c :: #"%" :: l)
+                        end
+                | c => ParseRtns(c::l)
+        and ParseDefs = fn () =>
+                (LexState:=0; AdvanceTok(); case !NextTok of
+                  LEXMARK => ()
+                | LEXSTATES =>
+                   let fun f () = (case !NextTok of (ID i) =>
+                                    (StateTab := enter(!StateTab)(i,++StateNum);
+                                     ++StateNum; AdvanceTok(); f())
+                                        | _ => ())
+                   in AdvanceTok(); f ();
+                      if !NextTok=SEMI then ParseDefs() else 
+                        (prSynErr "expected ';'")
+                   end
+                | ID x => (LexState:=1; AdvanceTok(); if GetTok() = ASSIGN
+                          then (SymTab := enter(!SymTab)(x,GetExp());
+                               if !NextTok = SEMI then ParseDefs()
+                               else (prSynErr "expected ';'"))
+                        else raise SyntaxError)
+                | REJECT => (HaveReject := true; ParseDefs())
+                | COUNT => (CountNewLines := true; ParseDefs())
+                | FULLCHARSET => (CharSetSize := 256; ParseDefs())
+                | HEADER => (LexState := 2; AdvanceTok();
+                             case GetTok()
+                             of ACTION s => 
+                                if (!StrDecl) then
+                                   (prErr "cannot have both %s and %header \
+                                    \declarations")
+                                else if (!HeaderDecl) then
+                                   (prErr "duplicate %header declarations")
+                                else 
+                                    (HeaderCode := s; LexState := 0;
+                                     HeaderDecl := true; ParseDefs())
+                                | _ => raise SyntaxError)
                 | ARG => (LexState := 2; AdvanceTok();
-			     case GetTok()
-			     of ACTION s => 
-				(case !ArgCode
-				   of SOME _ => prErr "duplicate %arg declarations"
-				    | NONE => ArgCode := SOME s;
-				 LexState := 0;
-				 ParseDefs())
-				| _ => raise SyntaxError)
-		| STRUCT => (AdvanceTok();
-			    case !NextTok of
-			       (ID i) =>
-			        if (!HeaderDecl) then
-				   (prErr "cannot have both %s and %header \
-				    \declarations")
-				else if (!StrDecl) then
-				   (prErr "duplicate %s declarations")
-				else StrName := i
-			         | _  => (prErr "expected ID");
-				ParseDefs())
-		| _ => raise SyntaxError)
-	and ParseRules =
-		fn rules => (LexState:=1; AdvanceTok(); case !NextTok of
-		  LEXMARK => rules
-		| EOF => rules
-		| _ =>
-		 let val s = GetStates()
-		     val e = renum(CAT(GetExp(),END(0)))
-		 in
-		 if !NextTok = ARROW then 
-		   (LexState:=2; AdvanceTok();
-		    case GetTok() of ACTION(act) =>
-		      if !NextTok=SEMI then
-		        (Accept:=enter(!Accept) (Int.toString (!LeafNum),act);
-		         ParseRules((s,e)::rules))
-		      else (prSynErr "expected ';'")
-		    | _ => raise SyntaxError)
-		  else (prSynErr "expected '=>'")
-		end)
+                             case GetTok()
+                             of ACTION s => 
+                                (case !ArgCode
+                                   of SOME _ => prErr "duplicate %arg declarations"
+                                    | NONE => ArgCode := SOME s;
+                                 LexState := 0;
+                                 ParseDefs())
+                                | _ => raise SyntaxError)
+                | STRUCT => (AdvanceTok();
+                            case !NextTok of
+                               (ID i) =>
+                                if (!HeaderDecl) then
+                                   (prErr "cannot have both %s and %header \
+                                    \declarations")
+                                else if (!StrDecl) then
+                                   (prErr "duplicate %s declarations")
+                                else StrName := i
+                                 | _  => (prErr "expected ID");
+                                ParseDefs())
+                | _ => raise SyntaxError)
+        and ParseRules =
+                fn rules => (LexState:=1; AdvanceTok(); case !NextTok of
+                  LEXMARK => rules
+                | EOF => rules
+                | _ =>
+                 let val s = GetStates()
+                     val e = renum(CAT(GetExp(),END(0)))
+                 in
+                 if !NextTok = ARROW then 
+                   (LexState:=2; AdvanceTok();
+                    case GetTok() of ACTION(act) =>
+                      if !NextTok=SEMI then
+                        (Accept:=enter(!Accept) (Int.toString (!LeafNum),act);
+                         ParseRules((s,e)::rules))
+                      else (prSynErr "expected ';'")
+                    | _ => raise SyntaxError)
+                  else (prSynErr "expected '=>'")
+                end)
 in let val usercode = ParseRtns nil
    in (ParseDefs(); (usercode,ParseRules(nil),!Accept))
    end
@@ -848,158 +848,158 @@
 
 fun makebegin () : unit =
    let fun make nil = ()
-	 | make ((x,n:int)::y)=(say "val "; say x; say " = " ;
-				say "STARTSTATE ";
-				say (Int.toString n); say ";\n"; make y)
+         | make ((x,n:int)::y)=(say "val "; say x; say " = " ;
+                                say "STARTSTATE ";
+                                say (Int.toString n); say ";\n"; make y)
    in say "\n(* start state definitions *)\n\n"; make(listofdict(!StateTab))
    end
                        
 structure L = 
-	struct
-	  nonfix >
-	  type key = int list * string
-	  fun > ((key,item:string),(key',item')) =
-	    let fun f ((a:int)::a') (b::b') = if Int.> (a,b) then true
-					   else if a=b then f a' b'
-					   else false
-		  | f _ _ = false
-	    in f key key'
-	    end
-	end
+        struct
+          nonfix >
+          type key = int list * string
+          fun > ((key,item:string),(key',item')) =
+            let fun f ((a:int)::a') (b::b') = if Int.> (a,b) then true
+                                           else if a=b then f a' b'
+                                           else false
+                  | f _ _ = false
+            in f key key'
+            end
+        end
 
 structure RB = RedBlack(L)
 
 fun maketable (fins:(int * (int list)) list,
-	     tcs :(int * (int list)) list,
-	     tcpairs: (int * int) list,
-	     trans : (int*(int list)) list) : unit =
+             tcs :(int * (int list)) list,
+             tcpairs: (int * int) list,
+             trans : (int*(int list)) list) : unit =
 
 (* Fins = (state #, list of final leaves for the state) list
    tcs = (state #, list of trailing context leaves which begin in this state)
-	 list
+         list
    tcpairs = (trailing context leaf, end leaf) list
    trans = (state #,list of transitions for state) list *)
 
    let datatype elem = N of int | T of int | D of int
        val count = ref 0
        val _ = (if length(trans)<256 then CharFormat := true
-		 else CharFormat := false;
-		 if !UsesTrailingContext then
-    		     (say "\ndatatype yyfinstate = N of int | \
-			   \ T of int | D of int\n")
-		 else say "\ndatatype yyfinstate = N of int";
-		 say "\ntype statedata = {fin : yyfinstate list, trans: ";
-		 case !CharFormat of
-		       true => say "string}"
-		     | false => say "int Vector.vector}";
-	         say "\n(* transition & final state table *)\nval tab = let\n";
-		 case !CharFormat of
-		       true => ()
-		     | false =>
-			 (say "fun decode s k =\n";
-			  say "  let val k' = k + k\n";
-			  say "      val hi = Char.ord(String.sub(s, k'))\n";
-			  say "      val lo = Char.ord(String.sub(s, k' + 1))\n";
-			  say "  in hi * 256 + lo end\n"))
-	val newfins =
-	  let fun IsEndLeaf t =
-	     let fun f ((l,e)::r) = if (e=t) then true else f r
-		   | f nil = false in f tcpairs end
+                 else CharFormat := false;
+                 if !UsesTrailingContext then
+                     (say "\ndatatype yyfinstate = N of int | \
+                           \ T of int | D of int\n")
+                 else say "\ndatatype yyfinstate = N of int";
+                 say "\ntype statedata = {fin : yyfinstate list, trans: ";
+                 case !CharFormat of
+                       true => say "string}"
+                     | false => say "int Vector.vector}";
+                 say "\n(* transition & final state table *)\nval tab = let\n";
+                 case !CharFormat of
+                       true => ()
+                     | false =>
+                         (say "fun decode s k =\n";
+                          say "  let val k' = k + k\n";
+                          say "      val hi = Char.ord(String.sub(s, k'))\n";
+                          say "      val lo = Char.ord(String.sub(s, k' + 1))\n";
+                          say "  in hi * 256 + lo end\n"))
+        val newfins =
+          let fun IsEndLeaf t =
+             let fun f ((l,e)::r) = if (e=t) then true else f r
+                   | f nil = false in f tcpairs end
 
-	 fun GetEndLeaf t = 
-	   let fun f ((tl,el)::r) = if (tl=t) then el else f r
+         fun GetEndLeaf t = 
+           let fun f ((tl,el)::r) = if (tl=t) then el else f r
            in f tcpairs
-	   end
-	 fun GetTrConLeaves s =
-	   let fun f ((s',l)::r) = if (s = s') then l else f r
-	         | f nil = nil
-	   in f tcs
-	   end
-	 fun sort_leaves s =
-	   let fun insert (x:int) (a::b) =
-		 if (x <= a) then x::(a::b)
-		 else a::(insert x b)
-		 | insert x nil = [x]
-	   in List.foldr (fn (x,r) => insert x r) [] s
-	   end
-	 fun conv a = if (IsEndLeaf a) then (D a) else (N a)
-	 fun merge (a::a',b::b') =
-	   if (a <= b) then (conv a)::merge(a',b::b')
-	   else (T b)::(merge(a::a',b'))
-	   | merge (a::a',nil) = (conv a)::(merge (a',nil))
-	   | merge (nil,b::b') = (T b)::(merge (b',nil))
-	   | merge (nil,nil) = nil
+           end
+         fun GetTrConLeaves s =
+           let fun f ((s',l)::r) = if (s = s') then l else f r
+                 | f nil = nil
+           in f tcs
+           end
+         fun sort_leaves s =
+           let fun insert (x:int) (a::b) =
+                 if (x <= a) then x::(a::b)
+                 else a::(insert x b)
+                 | insert x nil = [x]
+           in List.foldr (fn (x,r) => insert x r) [] s
+           end
+         fun conv a = if (IsEndLeaf a) then (D a) else (N a)
+         fun merge (a::a',b::b') =
+           if (a <= b) then (conv a)::merge(a',b::b')
+           else (T b)::(merge(a::a',b'))
+           | merge (a::a',nil) = (conv a)::(merge (a',nil))
+           | merge (nil,b::b') = (T b)::(merge (b',nil))
+           | merge (nil,nil) = nil
 
-	in map (fn (x,l) =>
-	  rev (merge (l,
-		sort_leaves (map (fn x => GetEndLeaf x) (GetTrConLeaves x)))))
-		    fins
-	end
+        in map (fn (x,l) =>
+          rev (merge (l,
+                sort_leaves (map (fn x => GetEndLeaf x) (GetTrConLeaves x)))))
+                    fins
+        end
 
-	val rs =
-	 let open RB
-	     fun makeItems x =
-	       let fun emit8(x, pos) = let
-		     val s = StringCvt.padLeft #"0" 3 (Int.toString x)
-		     in
-		       case pos
-			 of 16	=> (say "\\\n\\\\"; say s; 1)
-			  | _	=> (say "\\"; say s; pos+1)
-		     end
-		   fun emit16(x, pos) =
-		     let val hi8 = x div 256
-			 val lo8 = x - hi8 * 256	(* x rem 256 *)
-		     in
-		       emit8(lo8, emit8(hi8, pos))
-		     end
-		   fun MakeString([], _, _) = ()
-		     | MakeString(x::xs, emitter, pos) =
-			MakeString(xs, emitter, emitter(x, pos))
-	        in case !CharFormat of
-		    true => (say " =\n\""; MakeString(x,emit8,0); say "\"\n")
-		  | false => (say " = Vector.tabulate("; say (Int.toString(length x));
-			     say ", decode\n\""; MakeString(x,emit16,0); say "\")\n")
-	        end
-	    fun makeEntry(nil,rs,t) = rev rs
-	      | makeEntry(((l:int,x)::y),rs,t) =
-	          let val name = "s" ^ (Int.toString l)
-		  in let val (r,n) = lookup ((x,name),t)
-		      in makeEntry(y,(n::rs),t)
-		      end handle notfound _ => (count := !count+1;
-		         say "val "; say name; makeItems x;
-		          makeEntry(y,(name::rs),(insert ((x,name),t))))
-	   	  end
-	in (makeEntry(trans,nil,empty))
-	end
+        val rs =
+         let open RB
+             fun makeItems x =
+               let fun emit8(x, pos) = let
+                     val s = StringCvt.padLeft #"0" 3 (Int.toString x)
+                     in
+                       case pos
+                         of 16  => (say "\\\n\\\\"; say s; 1)
+                          | _   => (say "\\"; say s; pos+1)
+                     end
+                   fun emit16(x, pos) =
+                     let val hi8 = x div 256
+                         val lo8 = x - hi8 * 256        (* x rem 256 *)
+                     in
+                       emit8(lo8, emit8(hi8, pos))
+                     end
+                   fun MakeString([], _, _) = ()
+                     | MakeString(x::xs, emitter, pos) =
+                        MakeString(xs, emitter, emitter(x, pos))
+                in case !CharFormat of
+                    true => (say " =\n\""; MakeString(x,emit8,0); say "\"\n")
+                  | false => (say " = Vector.tabulate("; say (Int.toString(length x));
+                             say ", decode\n\""; MakeString(x,emit16,0); say "\")\n")
+                end
+            fun makeEntry(nil,rs,t) = rev rs
+              | makeEntry(((l:int,x)::y),rs,t) =
+                  let val name = "s" ^ (Int.toString l)
+                  in let val (r,n) = lookup ((x,name),t)
+                      in makeEntry(y,(n::rs),t)
+                      end handle notfound _ => (count := !count+1;
+                         say "val "; say name; makeItems x;
+                          makeEntry(y,(name::rs),(insert ((x,name),t))))
+                  end
+        in (makeEntry(trans,nil,empty))
+        end
 
-	fun makeTable(nil,nil) = ()
-	  | makeTable(a::a',b::b') =
-	     let fun makeItems nil = ()
-		   | makeItems (hd::tl) =
-		     let val (t,n) =
-			 case hd of
-			   (N i) => ("(N ",i)
-			 | (T i) => ("(T ",i)
-			 | (D i) => ("(D ",i)
-		     in (say t; say (Int.toString n); say ")";
-			 if null tl
-			 then ()
-			 else (say ","; makeItems tl))
-		     end
-	      in (say "{fin = ["; makeItems b;
-		  say "], trans = "; say a; say "}";
-		  if null a'
-		  then ()
-		  else (say ",\n"; makeTable(a',b')))
-	      end
+        fun makeTable(nil,nil) = ()
+          | makeTable(a::a',b::b') =
+             let fun makeItems nil = ()
+                   | makeItems (hd::tl) =
+                     let val (t,n) =
+                         case hd of
+                           (N i) => ("(N ",i)
+                         | (T i) => ("(T ",i)
+                         | (D i) => ("(D ",i)
+                     in (say t; say (Int.toString n); say ")";
+                         if null tl
+                         then ()
+                         else (say ","; makeItems tl))
+                     end
+              in (say "{fin = ["; makeItems b;
+                  say "], trans = "; say a; say "}";
+                  if null a'
+                  then ()
+                  else (say ",\n"; makeTable(a',b')))
+              end
 
-	fun msg x = () (*TextIO.output(TextIO.stdOut, x)*)
+        fun msg x = () (*TextIO.output(TextIO.stdOut, x)*)
 
   in (say "in Vector.fromList\n["; makeTable(rs,newfins); say "]\nend\n";
     msg ("\nNumber of states = " ^ (Int.toString (length trans)));
     msg ("\nNumber of distinct rows = " ^ (Int.toString (!count)));
     msg ("\nApprox. memory size of trans. table = " ^
-	  (Int.toString (!count*(!CharSetSize)*(if !CharFormat then 1 else 8))));
+          (Int.toString (!count*(!CharSetSize)*(if !CharFormat then 1 else 8))));
     msg " bytes\n")
 end
 
@@ -1009,40 +1009,40 @@
 
 fun makeaccept ends =
     let fun startline f = if f then say "  " else say "| "
-	 fun make(nil,f) = (startline f; say "_ => raise Internal.LexerError\n")
-	  | make((x,a)::y,f) = (startline f; say x; say " => (";
-				 say a; say ")\n"; make(y,false))
+         fun make(nil,f) = (startline f; say "_ => raise Internal.LexerError\n")
+          | make((x,a)::y,f) = (startline f; say x; say " => (";
+                                 say a; say ")\n"; make(y,false))
     in make (listofdict(ends),true)
     end
-			
+                        
 fun leafdata(e:(int list * exp) list) =
-	let val fp = array(!LeafNum + 1,nil)
-	and leaf = array(!LeafNum + 1,EPS)
-	and tcpairs = ref nil
-	and trailmark = ref ~1;
-	val rec add = fn
-		  (nil,x) => ()
-		| (hd::tl,x) => (update(fp,hd,union(fp sub hd,x));
-			add(tl,x))
-	and moredata = fn
-		  CLOSURE(e1) =>
-			(moredata(e1); add(lastpos(e1),firstpos(e1)))
-		| ALT(e1,e2) => (moredata(e1); moredata(e2))
-		| CAT(e1,e2) => (moredata(e1); moredata(e2);
-			add(lastpos(e1),firstpos(e2)))
-		| CLASS(x,i) => update(leaf,i,CLASS(x,i))
-		| TRAIL(i) => (update(leaf,i,TRAIL(i)); if !trailmark = ~1
-			then trailmark := i else ())
-		| END(i) => (update(leaf,i,END(i)); if !trailmark <> ~1
-			then (tcpairs := (!trailmark,i)::(!tcpairs);
-			trailmark := ~1) else ())
-		| _ => ()
-	and makedata = fn
-		  nil => ()
-		| (_,x)::tl => (moredata(x);makedata(tl))
-	in trailmark := ~1; makedata(e); (fp,leaf,!tcpairs)
-	end;
-	
+        let val fp = array(!LeafNum + 1,nil)
+        and leaf = array(!LeafNum + 1,EPS)
+        and tcpairs = ref nil
+        and trailmark = ref ~1;
+        val rec add = fn
+                  (nil,x) => ()
+                | (hd::tl,x) => (update(fp,hd,union(fp sub hd,x));
+                        add(tl,x))
+        and moredata = fn
+                  CLOSURE(e1) =>
+                        (moredata(e1); add(lastpos(e1),firstpos(e1)))
+                | ALT(e1,e2) => (moredata(e1); moredata(e2))
+                | CAT(e1,e2) => (moredata(e1); moredata(e2);
+                        add(lastpos(e1),firstpos(e2)))
+                | CLASS(x,i) => update(leaf,i,CLASS(x,i))
+                | TRAIL(i) => (update(leaf,i,TRAIL(i)); if !trailmark = ~1
+                        then trailmark := i else ())
+                | END(i) => (update(leaf,i,END(i)); if !trailmark <> ~1
+                        then (tcpairs := (!trailmark,i)::(!tcpairs);
+                        trailmark := ~1) else ())
+                | _ => ()
+        and makedata = fn
+                  nil => ()
+                | (_,x)::tl => (moredata(x);makedata(tl))
+        in trailmark := ~1; makedata(e); (fp,leaf,!tcpairs)
+        end;
+        
 fun makedfa(rules) =
 let val StateTab = ref (create(String.<=)) : (string,int) dictionary ref
     val fintab = ref (create(Int.<=)) : (int,(int list)) dictionary ref
@@ -1051,89 +1051,89 @@
     val (fp, leaf, tcpairs) = leafdata(rules);
 
 fun visit (state,statenum) =
-	let val transitions = gettrans(state) in
-	   fintab := enter(!fintab)(statenum,getfin(state));
-	   tctab := enter(!tctab)(statenum,gettc(state));
-	   transtab := enter(!transtab)(statenum,transitions)
-	end
-	
+        let val transitions = gettrans(state) in
+           fintab := enter(!fintab)(statenum,getfin(state));
+           tctab := enter(!tctab)(statenum,gettc(state));
+           transtab := enter(!transtab)(statenum,transitions)
+        end
+        
 and visitstarts (states) =
-	let fun vs nil i = ()
-	      | vs (hd::tl) i = (visit (hd,i); vs tl (i+1))
-	in vs states 0
-	end
-	
+        let fun vs nil i = ()
+              | vs (hd::tl) i = (visit (hd,i); vs tl (i+1))
+        in vs states 0
+        end
+        
 and hashstate(s: int list) =
-	let val rec hs =
-	        fn (nil,z) => z
-		 | ((x:int)::y,z) => hs(y,z ^ " " ^ (Int.toString x))
-	in hs(s,"")
-	end
-	
+        let val rec hs =
+                fn (nil,z) => z
+                 | ((x:int)::y,z) => hs(y,z ^ " " ^ (Int.toString x))
+        in hs(s,"")
+        end
+        
 and find(s) = lookup(!StateTab)(hashstate(s))
 
 and add(s,n) = StateTab := enter(!StateTab)(hashstate(s),n)
 
 and getstate (state) =
-	find(state)
-	handle LOOKUP => let val n = ++StateNum in
-		add(state,n); visit(state,n); n
-		end
-		
+        find(state)
+        handle LOOKUP => let val n = ++StateNum in
+                add(state,n); visit(state,n); n
+                end
+                
 and getfin state =
-	let fun f nil fins = fins
-	      | f (hd::tl) fins =
-	         case (leaf sub hd) 
-	            of END _ => f tl (hd::fins)
-	             | _ => f tl fins
-	in f state nil
-	end
+        let fun f nil fins = fins
+              | f (hd::tl) fins =
+                 case (leaf sub hd) 
+                    of END _ => f tl (hd::fins)
+                     | _ => f tl fins
+        in f state nil
+        end
 
 and gettc state =
-	let fun f nil fins = fins
-	      | f (hd::tl) fins =
-	         case (leaf sub hd) 
-	            of TRAIL _ => f tl (hd::fins)
-	             | _ => f tl fins
-	in f state nil
-	end
+        let fun f nil fins = fins
+              | f (hd::tl) fins =
+                 case (leaf sub hd) 
+                    of TRAIL _ => f tl (hd::fins)
+                     | _ => f tl fins
+        in f state nil
+        end
 
 and gettrans (state) =
       let fun loop c tlist =
-	 let fun cktrans nil r = r
-	       | cktrans (hd::tl) r =
-		  case (leaf sub hd) of
-	           CLASS(i,_)=>
-			(if (i sub c) then cktrans tl (union(r,fp sub hd))
-		         else cktrans tl r handle Subscript => 
-						cktrans tl r
-			)
-		   | _ => cktrans tl r
-	 in if c >= 0 then
-	      let val v=cktrans state nil
-	      in loop (c-1) (if v=nil then 0::tlist else (getstate v)::tlist)
-	      end
-	    else tlist
-	 end
+         let fun cktrans nil r = r
+               | cktrans (hd::tl) r =
+                  case (leaf sub hd) of
+                   CLASS(i,_)=>
+                        (if (i sub c) then cktrans tl (union(r,fp sub hd))
+                         else cktrans tl r handle Subscript => 
+                                                cktrans tl r
+                        )
+                   | _ => cktrans tl r
+         in if c >= 0 then
+              let val v=cktrans state nil
+              in loop (c-1) (if v=nil then 0::tlist else (getstate v)::tlist)
+              end
+            else tlist
+         end
      in loop ((!CharSetSize) - 1) nil
      end
-	
+        
 and startstates() =
-	let val startarray = array(!StateNum + 1, nil);
+        let val startarray = array(!StateNum + 1, nil);
             fun listofarray(a,n) =
-  		let fun f i l = if i >= 0 then  f (i-1) ((a sub i)::l) else l
- 		in f (n-1) nil end
-	val rec makess = fn
-		  nil => ()
-		| (startlist,e)::tl => (fix(startlist,firstpos(e));makess(tl))
-	and fix = fn
-		  (nil,_) => ()
-		| (s::tl,firsts) => (update(startarray,s,
-			union(firsts,startarray sub s));
-			fix(tl,firsts))
-	in makess(rules);listofarray(startarray, !StateNum + 1)
-	end
-	
+                let fun f i l = if i >= 0 then  f (i-1) ((a sub i)::l) else l
+                in f (n-1) nil end
+        val rec makess = fn
+                  nil => ()
+                | (startlist,e)::tl => (fix(startlist,firstpos(e));makess(tl))
+        and fix = fn
+                  (nil,_) => ()
+                | (s::tl,firsts) => (update(startarray,s,
+                        union(firsts,startarray sub s));
+                        fix(tl,firsts))
+        in makess(rules);listofarray(startarray, !StateNum + 1)
+        end
+        
 in visitstarts(startstates());
 (listofdict(!fintab),listofdict(!transtab),listofdict(!tctab),tcpairs)
 end
@@ -1161,148 +1161,148 @@
       fun PrintLexer (ends) =
     let val sayln = fn x => (say x; say "\n")
      in case !ArgCode 
-	 of NONE => (sayln "fun lex () : Internal.result =";
-		     sayln "let fun continue() = lex() in")
-	  | SOME s => (say "fun lex "; say "(yyarg as ("; say s; sayln ")) =";
-		       sayln "let fun continue() : Internal.result = ");
-	 say "  let fun scan (s,AcceptingLeaves : Internal.yyfinstate";
-	 sayln " list list,l,i0) =";
-	 if !UsesTrailingContext
-	     then say "\tlet fun action (i,nil,rs)"
-	     else say "\tlet fun action (i,nil)";
-	 sayln " = raise LexError";
-	 if !UsesTrailingContext
-	     then sayln "\t| action (i,nil::l,rs) = action(i-1,l,rs)"
-	     else sayln "\t| action (i,nil::l) = action (i-1,l)";
-	 if !UsesTrailingContext
-	     then sayln "\t| action (i,(node::acts)::l,rs) ="
-	     else sayln "\t| action (i,(node::acts)::l) =";
-	 sayln "\t\tcase node of";
-	 sayln "\t\t    Internal.N yyk => ";
-	 sayln "\t\t\t(let val yytext = substring(!yyb,i0,i-i0)\n\
-	       \\t\t\t     val yypos = i0+ !yygone";
-	 if !CountNewLines 
-	    then (sayln "\t\t\tval _ = yylineno := CharVector.foldl";
-	  	  sayln "\t\t\t\t(fn (#\"\\n\", n) => n+1 | (_, n) => n) (!yylineno) yytext")
-	    else ();
-	 if !HaveReject
-	     then (say "\t\t\tfun REJECT() = action(i,acts::l";
-		   if !UsesTrailingContext
-		       then sayln ",rs)" else sayln ")")
-	     else ();	 
-	 sayln "\t\t\topen UserDeclarations Internal.StartStates";
-	 sayln " in (yybufpos := i; case yyk of ";
-	 sayln "";
-	 sayln "\t\t\t(* Application actions *)\n";
-	 makeaccept(ends);
-	 say "\n\t\t) end ";
-	 say ")\n\n";
-	 if (!UsesTrailingContext) then say skel_mid2 else ();
-	 sayln "\tval {fin,trans} = Vector.sub(Internal.tab, s)";
-	 sayln "\tval NewAcceptingLeaves = fin::AcceptingLeaves";
-	 sayln "\tin if l = !yybl then";
-	 sayln "\t     if trans = #trans(Vector.sub(Internal.tab,0))";
-	 sayln "\t       then action(l,NewAcceptingLeaves";
-	 if !UsesTrailingContext then say ",nil" else ();
+         of NONE => (sayln "fun lex () : Internal.result =";
+                     sayln "let fun continue() = lex() in")
+          | SOME s => (say "fun lex "; say "(yyarg as ("; say s; sayln ")) =";
+                       sayln "let fun continue() : Internal.result = ");
+         say "  let fun scan (s,AcceptingLeaves : Internal.yyfinstate";
+         sayln " list list,l,i0) =";
+         if !UsesTrailingContext
+             then say "\tlet fun action (i,nil,rs)"
+             else say "\tlet fun action (i,nil)";
+         sayln " = raise LexError";
+         if !UsesTrailingContext
+             then sayln "\t| action (i,nil::l,rs) = action(i-1,l,rs)"
+             else sayln "\t| action (i,nil::l) = action (i-1,l)";
+         if !UsesTrailingContext
+             then sayln "\t| action (i,(node::acts)::l,rs) ="
+             else sayln "\t| action (i,(node::acts)::l) =";
+         sayln "\t\tcase node of";
+         sayln "\t\t    Internal.N yyk => ";
+         sayln "\t\t\t(let val yytext = substring(!yyb,i0,i-i0)\n\
+               \\t\t\t     val yypos = i0+ !yygone";
+         if !CountNewLines 
+            then (sayln "\t\t\tval _ = yylineno := CharVector.foldl";
+                  sayln "\t\t\t\t(fn (#\"\\n\", n) => n+1 | (_, n) => n) (!yylineno) yytext")
+            else ();
+         if !HaveReject
+             then (say "\t\t\tfun REJECT() = action(i,acts::l";
+                   if !UsesTrailingContext
+                       then sayln ",rs)" else sayln ")")
+             else ();    
+         sayln "\t\t\topen UserDeclarations Internal.StartStates";
+         sayln " in (yybufpos := i; case yyk of ";
+         sayln "";
+         sayln "\t\t\t(* Application actions *)\n";
+         makeaccept(ends);
+         say "\n\t\t) end ";
+         say ")\n\n";
+         if (!UsesTrailingContext) then say skel_mid2 else ();
+         sayln "\tval {fin,trans} = Vector.sub(Internal.tab, s)";
+         sayln "\tval NewAcceptingLeaves = fin::AcceptingLeaves";
+         sayln "\tin if l = !yybl then";
+         sayln "\t     if trans = #trans(Vector.sub(Internal.tab,0))";
+         sayln "\t       then action(l,NewAcceptingLeaves";
+         if !UsesTrailingContext then say ",nil" else ();
          say ") else";
-	 sayln "\t    let val newchars= if !yydone then \"\" else yyinput 1024";
-	 sayln "\t    in if (size newchars)=0";
-	 sayln "\t\t  then (yydone := true;";
-	 say "\t\t        if (l=i0) then UserDeclarations.eof ";
-	 sayln (case !ArgCode of NONE => "()" | SOME _ => "yyarg");
-	 say   "\t\t                  else action(l,NewAcceptingLeaves";
-	 if !UsesTrailingContext then
-	    sayln ",nil))" else sayln "))";
-	 sayln "\t\t  else (if i0=l then yyb := newchars";
-	 sayln "\t\t     else yyb := substring(!yyb,i0,l-i0)^newchars;";
-	 sayln "\t\t     yygone := !yygone+i0;";
-	 sayln "\t\t     yybl := size (!yyb);";
-	 sayln "\t\t     scan (s,AcceptingLeaves,l-i0,0))";
-	 sayln "\t    end";
-	 sayln "\t  else let val NewChar = Char.ord(String.sub(!yyb,l))";
-	   say "\t\tval NewState = ";
-	   case (!CharFormat,!CharSetSize)
-	    of (true,129) => sayln "if NewChar<128 then Char.ord(String.sub(trans,NewChar)) else Char.ord(String.sub(trans,128))"
-	     | (true,256) => sayln "Char.ord(String.sub(trans,NewChar))"
-	     | (false,129) => sayln "if NewChar<128 then Vector.sub(trans, NewChar) else Vector.sub(trans, 128)"
-	     | (false,256) => sayln "Vector.sub(trans, NewChar)";
-	 say "\t\tin if NewState=0 then action(l,NewAcceptingLeaves";
-	 if !UsesTrailingContext then sayln ",nil)" else sayln ")";
-	 sayln "\t\telse scan(NewState,NewAcceptingLeaves,l+1,i0)";
-	 sayln "\tend";
-	 sayln "\tend";
-	 if !UsesPrevNewLine then () else sayln "(*";
-	 sayln "\tval start= if substring(!yyb,!yybufpos-1,1)=\"\\n\"";
-	 sayln "then !yybegin+1 else !yybegin";
-	 if !UsesPrevNewLine then () else sayln "*)";
-	 say "\tin scan(";
-	 if !UsesPrevNewLine then say "start" 
-	 else say "!yybegin (* start *)";
-	 sayln ",nil,!yybufpos,!yybufpos)";
-	 sayln "    end";
-	 sayln (case !ArgCode of NONE => "end" | SOME _ => "in continue end");
-	 sayln "  in lex";
-	 sayln "  end";
-	 sayln "end"
-	end
+         sayln "\t    let val newchars= if !yydone then \"\" else yyinput 1024";
+         sayln "\t    in if (size newchars)=0";
+         sayln "\t\t  then (yydone := true;";
+         say "\t\t        if (l=i0) then UserDeclarations.eof ";
+         sayln (case !ArgCode of NONE => "()" | SOME _ => "yyarg");
+         say   "\t\t                  else action(l,NewAcceptingLeaves";
+         if !UsesTrailingContext then
+            sayln ",nil))" else sayln "))";
+         sayln "\t\t  else (if i0=l then yyb := newchars";
+         sayln "\t\t     else yyb := substring(!yyb,i0,l-i0)^newchars;";
+         sayln "\t\t     yygone := !yygone+i0;";
+         sayln "\t\t     yybl := size (!yyb);";
+         sayln "\t\t     scan (s,AcceptingLeaves,l-i0,0))";
+         sayln "\t    end";
+         sayln "\t  else let val NewChar = Char.ord(String.sub(!yyb,l))";
+           say "\t\tval NewState = ";
+           case (!CharFormat,!CharSetSize)
+            of (true,129) => sayln "if NewChar<128 then Char.ord(String.sub(trans,NewChar)) else Char.ord(String.sub(trans,128))"
+             | (true,256) => sayln "Char.ord(String.sub(trans,NewChar))"
+             | (false,129) => sayln "if NewChar<128 then Vector.sub(trans, NewChar) else Vector.sub(trans, 128)"
+             | (false,256) => sayln "Vector.sub(trans, NewChar)";
+         say "\t\tin if NewState=0 then action(l,NewAcceptingLeaves";
+         if !UsesTrailingContext then sayln ",nil)" else sayln ")";
+         sayln "\t\telse scan(NewState,NewAcceptingLeaves,l+1,i0)";
+         sayln "\tend";
+         sayln "\tend";
+         if !UsesPrevNewLine then () else sayln "(*";
+         sayln "\tval start= if substring(!yyb,!yybufpos-1,1)=\"\\n\"";
+         sayln "then !yybegin+1 else !yybegin";
+         if !UsesPrevNewLine then () else sayln "*)";
+         say "\tin scan(";
+         if !UsesPrevNewLine then say "start" 
+         else say "!yybegin (* start *)";
+         sayln ",nil,!yybufpos,!yybufpos)";
+         sayln "    end";
+         sayln (case !ArgCode of NONE => "end" | SOME _ => "in continue end");
+         sayln "  in lex";
+         sayln "  end";
+         sayln "end"
+        end
 
     in (UsesPrevNewLine := false;
-	ResetFlags();
+        ResetFlags();
         LexBuf := make_ibuf(TextIO.openIn infile);
         NextTok := BOF;
         inquote := false;
-	LexOut := TextIO.openOut(outfile);
-	StateNum := 2;
-	LineNum := 1;
-	StateTab := enter(create(String.<=))("INITIAL",1);
-	LeafNum := ~1;
-	let
-	   val (user_code,rules,ends) =
-	       parse() handle x =>
-               	  (close_ibuf(!LexBuf);
-		   TextIO.closeOut(!LexOut);
-		   raise x)
-	   val (fins,trans,tctab,tcpairs) = makedfa(rules)
-	   val _ = if !UsesTrailingContext then
-	              (close_ibuf(!LexBuf);
-		       TextIO.closeOut(!LexOut);
-		       prErr "lookahead is unimplemented")
-		   else ()
-	in
-	  if (!HeaderDecl)
-	      then say (!HeaderCode)
-	      else say ("structure " ^ (!StrName));
-	  say "=\n";
-	  say skel_hd;
-	  say user_code;
-	  say "end (* end of user routines *)\n";
-	  say "exception LexError (* raised if illegal leaf ";
-	  say "action tried *)\n";
-	  say "structure Internal =\n\tstruct\n";
-	  maketable(fins,tctab,tcpairs,trans);
-	  say "structure StartStates =\n\tstruct\n";
-	  say "\tdatatype yystartstate = STARTSTATE of int\n";
-	  makebegin();
-	  say "\nend\n";
-	  say "type result = UserDeclarations.lexresult\n";
-	  say "\texception LexerError (* raised if illegal leaf ";
-	  say "action tried *)\n";
-	  say "end\n\n";
-	  say "fun makeLexer yyinput = \n";
-	  say "let \n";
-	  if !CountNewLines then say "\tval yylineno = ref 0\n\n" else ();
-	  say "\tval yyb = ref \"\\n\" \t\t(* buffer *)\n\
-	  \\tval yybl = ref 1\t\t(*buffer length *)\n\
-	  \\tval yybufpos = ref 1\t\t(* location of next character to use *)\n\
-	  \\tval yygone = ref 1\t\t(* position in file of beginning of buffer *)\n\
-	  \\tval yydone = ref false\t\t(* eof found yet? *)\n\
-	  \\tval yybegin = ref 1\t\t(*Current 'start state' for lexer *)\n\
-  	  \\n\tval YYBEGIN = fn (Internal.StartStates.STARTSTATE x) =>\n\
-	  \\t\t yybegin := x\n\n";
-	  PrintLexer(ends);
-	  close_ibuf(!LexBuf);
-	   TextIO.closeOut(!LexOut)
-	 end)
+        LexOut := TextIO.openOut(outfile);
+        StateNum := 2;
+        LineNum := 1;
+        StateTab := enter(create(String.<=))("INITIAL",1);
+        LeafNum := ~1;
+        let
+           val (user_code,rules,ends) =
+               parse() handle x =>
+                  (close_ibuf(!LexBuf);
+                   TextIO.closeOut(!LexOut);
+                   raise x)
+           val (fins,trans,tctab,tcpairs) = makedfa(rules)
+           val _ = if !UsesTrailingContext then
+                      (close_ibuf(!LexBuf);
+                       TextIO.closeOut(!LexOut);
+                       prErr "lookahead is unimplemented")
+                   else ()
+        in
+          if (!HeaderDecl)
+              then say (!HeaderCode)
+              else say ("structure " ^ (!StrName));
+          say "=\n";
+          say skel_hd;
+          say user_code;
+          say "end (* end of user routines *)\n";
+          say "exception LexError (* raised if illegal leaf ";
+          say "action tried *)\n";
+          say "structure Internal =\n\tstruct\n";
+          maketable(fins,tctab,tcpairs,trans);
+          say "structure StartStates =\n\tstruct\n";
+          say "\tdatatype yystartstate = STARTSTATE of int\n";
+          makebegin();
+          say "\nend\n";
+          say "type result = UserDeclarations.lexresult\n";
+          say "\texception LexerError (* raised if illegal leaf ";
+          say "action tried *)\n";
+          say "end\n\n";
+          say "fun makeLexer yyinput = \n";
+          say "let \n";
+          if !CountNewLines then say "\tval yylineno = ref 0\n\n" else ();
+          say "\tval yyb = ref \"\\n\" \t\t(* buffer *)\n\
+          \\tval yybl = ref 1\t\t(*buffer length *)\n\
+          \\tval yybufpos = ref 1\t\t(* location of next character to use *)\n\
+          \\tval yygone = ref 1\t\t(* position in file of beginning of buffer *)\n\
+          \\tval yydone = ref false\t\t(* eof found yet? *)\n\
+          \\tval yybegin = ref 1\t\t(*Current 'start state' for lexer *)\n\
+          \\n\tval YYBEGIN = fn (Internal.StartStates.STARTSTATE x) =>\n\
+          \\t\t yybegin := x\n\n";
+          PrintLexer(ends);
+          close_ibuf(!LexBuf);
+           TextIO.closeOut(!LexOut)
+         end)
     end
 end
 
@@ -1313,11 +1313,11 @@
     val doit =
        fn size =>
        let
-	  fun loop n =
-	     if n = 0
-		then ()
-	     else (doit();
-		   loop(n-1))
+          fun loop n =
+             if n = 0
+                then ()
+             else (doit();
+                   loop(n-1))
        in loop size
        end
 

Modified: mlton/branches/on-20050420-cmm-branch/benchmark/tests/life.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/benchmark/tests/life.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/benchmark/tests/life.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -14,17 +14,17 @@
     fun error str = raise ex_undefined str
 
     fun accumulate f = let
-	  fun foldf a [] = a
+          fun foldf a [] = a
             | foldf a (b::x) = foldf (f a b) x
           in
-	    foldf
-	  end
+            foldf
+          end
 
     fun filter p = let
-	  fun consifp x a = if p a then a::x else x
+          fun consifp x a = if p a then a::x else x
           in
-	    rev o accumulate consifp []
-	  end
+            rev o accumulate consifp []
+          end
 
 
     fun exists p = let fun existsp [] = false
@@ -71,7 +71,7 @@
                    if member x3 a then f (a::xover) x3 x2 x1 x else
                    if member x2 a then f xover (a::x3) x2 x1 x else
                    if member x1 a then f xover x3 (a::x2) x1 x else
-		                       f xover x3 x2 (a::x1) x
+                                       f xover x3 x2 (a::x1) x
               and diff x y = filter (not o member y) x
            in f [] [] [] [] x end
      in 
@@ -84,16 +84,16 @@
                   val isalive = member living
                   val liveneighbours = length o filter isalive o neighbours
                   fun twoorthree n = n=2 orelse n=3
-	          val survivors = filter (twoorthree o liveneighbours) living
-	          val newnbrlist = collect (filter (not o isalive) o neighbours) living
-	          val newborn = occurs3 newnbrlist
-	       in mkgen (survivors @ newborn) end
+                  val survivors = filter (twoorthree o liveneighbours) living
+                  val newnbrlist = collect (filter (not o isalive) o neighbours) living
+                  val newborn = occurs3 newnbrlist
+               in mkgen (survivors @ newborn) end
      end
     end
 
     fun neighbours (i,j) = [(i-1,j-1),(i-1,j),(i-1,j+1),
-			    (i,j-1),(i,j+1),
-			    (i+1,j-1),(i+1,j),(i+1,j+1)]
+                            (i,j-1),(i,j+1),
+                            (i+1,j-1),(i+1,j),(i+1,j+1)]
 
     local val xstart = 0 and ystart = 0
           fun markafter n string = string ^ spaces n ^ "0"
@@ -126,7 +126,7 @@
        end
 
     val genB = mkgen(glider at (2,2) @ bail at (2,12)
-		     @ rotate (barberpole 4) at (5,20))
+                     @ rotate (barberpole 4) at (5,20))
 
     fun nthgen g 0 = g | nthgen g i = nthgen (mk_nextgen_fn neighbours g) (i-1)
 
@@ -144,11 +144,11 @@
     val doit =
        fn size =>
        let
-	  fun loop n =
-	     if n = 0
-		then ()
-	     else (doit();
-		   loop(n-1))
+          fun loop n =
+             if n = 0
+                then ()
+             else (doit();
+                   loop(n-1))
        in loop size
        end
     

Modified: mlton/branches/on-20050420-cmm-branch/benchmark/tests/logic.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/benchmark/tests/logic.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/benchmark/tests/logic.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -9,7 +9,7 @@
     | INT of int
     | CON of string
     | REF of term option ref
-	
+        
   exception BadArg of string
 end;
 
@@ -23,29 +23,29 @@
       val trail_counter = ref 0
   in
       fun unwind_trail (0, tr) = tr
-	| unwind_trail (n, r::tr) =
-	  ( r := NONE ; unwind_trail (n-1, tr) )
-	| unwind_trail (_, nil) =
-	  raise BadArg "unwind_trail"
+        | unwind_trail (n, r::tr) =
+          ( r := NONE ; unwind_trail (n-1, tr) )
+        | unwind_trail (_, nil) =
+          raise BadArg "unwind_trail"
 
       fun reset_trail () = ( global_trail := nil )
 
       fun trail func =
-	  let 
-	      val tc0 = !trail_counter
-	  in
-	      ( func () ;
-	       global_trail := 
-	         unwind_trail (!trail_counter-tc0, !global_trail) ;
-	       trail_counter := tc0 )
-	  end
-	
+          let 
+              val tc0 = !trail_counter
+          in
+              ( func () ;
+               global_trail := 
+                 unwind_trail (!trail_counter-tc0, !global_trail) ;
+               trail_counter := tc0 )
+          end
+        
       fun bind (r, t) =
-	  ( r := SOME t ;
-	   global_trail := r::(!global_trail) ;
-	   trail_counter := !trail_counter+1 )
+          ( r := SOME t ;
+           global_trail := r::(!global_trail) ;
+           trail_counter := !trail_counter+1 )
   end (* local *)
-end; (* Trail *)	
+end; (* Trail *)        
 
 (* unify.sml *)
 
@@ -57,57 +57,57 @@
       | same_ref _ = false
 
     fun occurs_check r t =
-	let
-	    fun oc (STR(_,ts)) = ocs ts
-	      | oc (REF(r')) = 
-		(case !r' of
-		     SOME(s) => oc s
-		   | _ => r <> r')
-	      | oc (CON _) = true
-	      | oc (INT _) = true
-	    and ocs nil = true
-	      | ocs (t::ts) = oc t andalso ocs ts
-	in
-	    oc t
-	end
+        let
+            fun oc (STR(_,ts)) = ocs ts
+              | oc (REF(r')) = 
+                (case !r' of
+                     SOME(s) => oc s
+                   | _ => r <> r')
+              | oc (CON _) = true
+              | oc (INT _) = true
+            and ocs nil = true
+              | ocs (t::ts) = oc t andalso ocs ts
+        in
+            oc t
+        end
     fun deref (t as (REF(x))) = 
-	(case !x of 
-	     SOME(s) => deref s
-	   | _ => t)
+        (case !x of 
+             SOME(s) => deref s
+           | _ => t)
       | deref t = t
     fun unify' (REF(r), t) sc = unify_REF (r,t) sc
       | unify' (s, REF(r)) sc = unify_REF (r,s) sc
       | unify' (STR(f,ts), STR(g,ss)) sc =
-	if (f = g)
-	    then unifys (ts,ss) sc
-	else ()
+        if (f = g)
+            then unifys (ts,ss) sc
+        else ()
       | unify' (CON(f), CON(g)) sc =
-	if (f = g) then
-	    sc ()
-	else
-	    ()
+        if (f = g) then
+            sc ()
+        else
+            ()
       | unify' (INT(f), INT(g)) sc =
-	if (f = g) then
-	    sc ()
-	else
-	    ()
+        if (f = g) then
+            sc ()
+        else
+            ()
       | unify' (_, _) sc = ()
     and unifys (nil, nil) sc = sc ()
       | unifys (t::ts, s::ss) sc =
-	unify' (deref(t), deref(s))
-	(fn () => unifys (ts, ss) sc)
+        unify' (deref(t), deref(s))
+        (fn () => unifys (ts, ss) sc)
       | unifys _ sc = ()
     and unify_REF (r, t) sc =
-	if same_ref (r, t)
-	    then sc ()
-	else if occurs_check r t
-		 then ( bind(r, t) ; sc () )
-	     else ()
+        if same_ref (r, t)
+            then sc ()
+        else if occurs_check r t
+                 then ( bind(r, t) ; sc () )
+             else ()
   in
     val deref = deref
     fun unify (s, t) = unify' (deref(s), deref(t))
   end (* local *)
-end; (* Unify *)	 
+end; (* Unify *)         
 
 (* data.sml *)
 
@@ -350,19 +350,19 @@
     exception Done 
 
     fun testit strm = Data.exists(fn Z => Data.solution2 Z (fn () => raise Done))
-	  handle Done => TextIO.output(strm, "yes\n")
+          handle Done => TextIO.output(strm, "yes\n")
 
     fun doit () = Data.exists(fn Z => Data.solution2 Z (fn () => raise Done))
-	  handle Done => ()
+          handle Done => ()
 
     val doit =
        fn size =>
        let
-	  fun loop n =
-	     if n = 0
-		then ()
-	     else (doit();
-		   loop(n-1))
+          fun loop n =
+             if n = 0
+                then ()
+             else (doit();
+                   loop(n-1))
        in loop size
        end
 

Modified: mlton/branches/on-20050420-cmm-branch/benchmark/tests/mandelbrot.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/benchmark/tests/mandelbrot.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/benchmark/tests/mandelbrot.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -21,15 +21,15 @@
     val sum_iterations = ref 0
 
     fun loop1 i = if (i >= sz)
-	  then ()
-	  else let
+          then ()
+          else let
             val c_im : real = y_base - (delta * real i)
             fun loop2 j = if (j >= sz)
-		  then ()
-		  else let
+                  then ()
+                  else let
                     val c_re = x_base * (delta + real j)
-		    fun loop3 (count, z_re : real, z_im : real) = if (count < maxCount)
-			  then let
+                    fun loop3 (count, z_re : real, z_im : real) = if (count < maxCount)
+                          then let
                             val z_re_sq = z_re * z_re
                             val z_im_sq = z_im * z_im
                             in
@@ -43,12 +43,12 @@
                                        z_re_im + z_re_im + c_im)
                                   end
                             end (* loop3 *)
-			  else count
-		    val count = loop3 (0, c_re, c_im)
-		    in
-		      sum_iterations := !sum_iterations + count;
-		      loop2 (j+1)
-		    end
+                          else count
+                    val count = loop3 (0, c_re, c_im)
+                    in
+                      sum_iterations := !sum_iterations + count;
+                      loop2 (j+1)
+                    end
             in
               loop2 0;
               loop1 (i+1)
@@ -59,16 +59,16 @@
     val doit =
        fn size =>
        let
-	  fun loop n =
-	     if n = 0
-		then ()
-	     else (doit();
-		   loop(n-1))
+          fun loop n =
+             if n = 0
+                then ()
+             else (doit();
+                   loop(n-1))
        in loop size
        end
     fun testit outstrm = (
-	  sum_iterations := 0;
-	  loop1 0;
-	  TextIO.output (outstrm, Int.toString(!sum_iterations) ^ " iterations\n"))
+          sum_iterations := 0;
+          loop1 0;
+          TextIO.output (outstrm, Int.toString(!sum_iterations) ^ " iterations\n"))
 
   end (* Mandelbrot *)

Modified: mlton/branches/on-20050420-cmm-branch/benchmark/tests/matrix-multiply.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/benchmark/tests/matrix-multiply.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/benchmark/tests/matrix-multiply.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -4,9 +4,9 @@
 fun 'a fold (n : int, b : 'a, f : int * 'a -> 'a) =
    let
       fun loop (i : int, b : 'a) : 'a =
-	 if i = n
-	    then b
-	 else loop (i + 1, f (i, b))
+         if i = n
+            then b
+         else loop (i + 1, f (i, b))
    in loop (0, b)
    end
 
@@ -20,40 +20,40 @@
       val r2 = Array.nRows a2
       val c2 = Array.nCols a2
    in if c1 <> r2
-	 then raise Fail "mult"
+         then raise Fail "mult"
       else
-	 let val a = Array2.array (r1, c2, 0.0)
-	    fun dot (r, c) =
-	       fold (c1, 0.0, fn (i, sum) =>
-		    sum + Array.sub (a1, r, i) * Array.sub (a2, i, c))
-	 in foreach (r1, fn r =>
-		    foreach (c2, fn c =>
-			    Array.update (a, r, c, dot (r,c))));
-	    a
-	 end
+         let val a = Array2.array (r1, c2, 0.0)
+            fun dot (r, c) =
+               fold (c1, 0.0, fn (i, sum) =>
+                    sum + Array.sub (a1, r, i) * Array.sub (a2, i, c))
+         in foreach (r1, fn r =>
+                    foreach (c2, fn c =>
+                            Array.update (a, r, c, dot (r,c))));
+            a
+         end
    end
 
 structure Main =
    struct
       fun doit () =
-	 let
-	    val dim = 500
-	    val a = Array.tabulate Array.RowMajor (dim, dim, fn (r, c) =>
-						   Real.fromInt (r + c))
-	 in
-	    if Real.== (41541750.0, Array2.sub (mult (a, a), 0, 0))
-	       then ()
-	    else raise Fail "bug"
-	 end
+         let
+            val dim = 500
+            val a = Array.tabulate Array.RowMajor (dim, dim, fn (r, c) =>
+                                                   Real.fromInt (r + c))
+         in
+            if Real.== (41541750.0, Array2.sub (mult (a, a), 0, 0))
+               then ()
+            else raise Fail "bug"
+         end
       
       val doit =
-	 fn size =>
-	 let
-	    fun loop n =
-	       if n = 0
-		  then ()
-	       else (doit ();
-		     loop (n-1))
-	 in loop size
-	 end
+         fn size =>
+         let
+            fun loop n =
+               if n = 0
+                  then ()
+               else (doit ();
+                     loop (n-1))
+         in loop size
+         end
    end

Modified: mlton/branches/on-20050420-cmm-branch/benchmark/tests/md5.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/benchmark/tests/md5.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/benchmark/tests/md5.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -19,22 +19,22 @@
     structure W32 = Word32
     structure W8V = 
       struct
-	open Word8Vector
-	fun extract (vec, s, l) =
-	   let
-	      val n =
-		 case l of
-		    NONE => length vec - s
-		  | SOME i => i
-	   in
-	      tabulate (n, fn i => sub (vec, s + i))
-	   end
+        open Word8Vector
+        fun extract (vec, s, l) =
+           let
+              val n =
+                 case l of
+                    NONE => length vec - s
+                  | SOME i => i
+           in
+              tabulate (n, fn i => sub (vec, s + i))
+           end
       end
     type word64  = {hi:W32.word,lo:W32.word}
     type word128 = {A:W32.word, B:W32.word, C:W32.word,  D:W32.word}
     type md5state = {digest:word128,
-		       mlen:word64, 
-		        buf:Word8Vector.vector}
+                       mlen:word64, 
+                        buf:Word8Vector.vector}
 
 
 
@@ -50,13 +50,13 @@
   
     fun packLittle wrds = let
       fun loop [] = []
-	| loop (w::ws) = let
-	    val b0 = Word8.fromLarge (W32.toLarge w)
-	    val b1 = Word8.fromLarge (W32.toLarge (W32.>> (w,0w8)))
-	    val b2 = Word8.fromLarge (W32.toLarge (W32.>> (w,0w16)))
-	    val b3 = Word8.fromLarge (W32.toLarge (W32.>> (w,0w24)))
-	  in b0::b1::b2::b3:: (loop ws)
-	  end
+        | loop (w::ws) = let
+            val b0 = Word8.fromLarge (W32.toLarge w)
+            val b1 = Word8.fromLarge (W32.toLarge (W32.>> (w,0w8)))
+            val b2 = Word8.fromLarge (W32.toLarge (W32.>> (w,0w16)))
+            val b3 = Word8.fromLarge (W32.toLarge (W32.>> (w,0w24)))
+          in b0::b1::b2::b3:: (loop ws)
+          end
     in W8V.fromList (loop wrds)
     end
     
@@ -80,9 +80,9 @@
     fun PADDING i =  W8V.tabulate (i,(fn 0 => 0wx80 | _ => 0wx0))
 
     fun F (x,y,z) = W32.orb (W32.andb (x,y),
-			   W32.andb (W32.notb x,z))
+                           W32.andb (W32.notb x,z))
     fun G (x,y,z) = W32.orb (W32.andb (x,z),
-			   W32.andb (y,W32.notb z))
+                           W32.andb (y,W32.notb z))
     fun H (x,y,z) = W32.xorb (x,W32.xorb (y,z))
     fun I (x,y,z) = W32.xorb (y,W32.orb (x,W32.notb z))
     fun ROTATE_LEFT (x,n) =
@@ -93,7 +93,7 @@
       val a = ROTATE_LEFT (a,s)
     in W32.+ (a,b)
     end
-			    
+                            
     val FF = XX F
     val GG = XX G
     val HH = XX H
@@ -101,26 +101,26 @@
 
     val empty_buf = W8V.tabulate (0,(fn x => raise (Fail "buf")))
     val init = {digest= {A=0wx67452301,
-			B=0wxefcdab89,
-			C=0wx98badcfe,
-			D=0wx10325476},
-		mlen=w64_zero,
-		buf=empty_buf} : md5state
+                        B=0wxefcdab89,
+                        C=0wx98badcfe,
+                        D=0wx10325476},
+                mlen=w64_zero,
+                buf=empty_buf} : md5state
 
     fun update ({buf,digest,mlen}:md5state,input) = let
       val inputLen = W8V.length input
       val needBytes = 64 - W8V.length buf
       fun loop (i,digest) =
-	if i + 63 < inputLen then
-	  loop (i + 64,transform (digest,i,input))
-	else (i,digest)
+        if i + 63 < inputLen then
+          loop (i + 64,transform (digest,i,input))
+        else (i,digest)
       val (buf,(i,digest)) =
-	if inputLen >= needBytes then  let
-	  val buf = W8V.concat [buf,W8V.extract (input,0,SOME needBytes)]
-	  val digest = transform (digest,0,buf)
-	in (empty_buf,loop (needBytes,digest))
-	end
-	else (buf,(0,digest))
+        if inputLen >= needBytes then  let
+          val buf = W8V.concat [buf,W8V.extract (input,0,SOME needBytes)]
+          val digest = transform (digest,0,buf)
+        in (empty_buf,loop (needBytes,digest))
+        end
+        else (buf,(0,digest))
       val buf = W8V.concat [buf, W8V.extract (input,i,SOME (inputLen-i))]
       val mlen = mul8add (mlen,inputLen)
     in {buf=buf,digest=digest,mlen=mlen}
@@ -160,7 +160,7 @@
       val d = FF (d, a, b, c, x_13, S12, 0wxfd987193) (* 14 *)
       val c = FF (c, d, a, b, x_14, S13, 0wxa679438e) (* 15 *)
       val b = FF (b, c, d, a, x_15, S14, 0wx49b40821) (* 16 *)
-	  
+          
       (* Round 2 *)
       val a = GG (a, b, c, d, x_01, S21, 0wxf61e2562) (* 17 *)
       val d = GG (d, a, b, c, x_06, S22, 0wxc040b340) (* 18 *)
@@ -178,7 +178,7 @@
       val d = GG (d, a, b, c, x_02, S22, 0wxfcefa3f8) (* 30 *)
       val c = GG (c, d, a, b, x_07, S23, 0wx676f02d9) (* 31 *)
       val b = GG (b, c, d, a, x_12, S24, 0wx8d2a4c8a) (* 32 *)
-	  
+          
       (* Round 3 *)
       val a = HH (a, b, c, d, x_05, S31, 0wxfffa3942) (* 33 *)
       val d = HH (d, a, b, c, x_08, S32, 0wx8771f681) (* 34 *)
@@ -196,7 +196,7 @@
       val d = HH (d, a, b, c, x_12, S32, 0wxe6db99e5) (* 46 *)
       val c = HH (c, d, a, b, x_15, S33, 0wx1fa27cf8) (* 47 *)
       val b = HH (b, c, d, a, x_02, S34, 0wxc4ac5665) (* 48 *)
-	  
+          
       (* Round 4 *)
       val a = II (a, b, c, d, x_00, S41, 0wxf4292244) (* 49 *)
       val d = II (d, a, b, c, x_07, S42, 0wx432aff97) (* 50 *)
@@ -225,8 +225,8 @@
     val hxd = "0123456789abcdef"
     fun toHexString v = let
       fun byte2hex (b,acc) =
-	(String.sub (hxd,(Word8.toInt b) div 16))::
-	(String.sub (hxd,(Word8.toInt b) mod 16))::acc
+        (String.sub (hxd,(Word8.toInt b) div 16))::
+        (String.sub (hxd,(Word8.toInt b) mod 16))::acc
       val digits = Word8Vector.foldr byte2hex [] v
     in String.implode (digits)
     end
@@ -241,17 +241,17 @@
        ("message digest", "f96b697d7cb7938d525a2f31aaf161d0"),
        ("abcdefghijklmnopqrstuvwxyz", "c3fcd3d76192e4007dfb496cca67e13b"),
        ("ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789",
-	"d174ab98d277d9f5a5611c2c9f419d9f"),
+        "d174ab98d277d9f5a5611c2c9f419d9f"),
        ("12345678901234567890123456789012345678901234567890123456789012345678901234567890",
-	"57edf4a22be3c955ac49da2e2107b67a")]
+        "57edf4a22be3c955ac49da2e2107b67a")]
    
     fun do_tests () =  let
       fun f (x,s) = let
-	val mstate = MD5.update (MD5.init,Byte.stringToBytes x)
-	val hash = MD5.final (mstate)
+        val mstate = MD5.update (MD5.init,Byte.stringToBytes x)
+        val hash = MD5.final (mstate)
       in print ("   input: "^x^"\n");
-	print ("expected: "^s^"\n");
-	print ("produced: "^MD5.toHexString (hash)^"\n")
+        print ("expected: "^s^"\n");
+        print ("produced: "^MD5.toHexString (hash)^"\n")
       end
     in List.app f tests
     end
@@ -260,9 +260,9 @@
     fun time_test () = let
       val block = Word8Vector.tabulate (BLOCK_LEN,Word8.fromInt)
       fun loop (n,s) =
-	if n < BLOCK_COUNT then
-	  loop (n+1,MD5.update (s,block))
-	else s
+        if n < BLOCK_COUNT then
+          loop (n+1,MD5.update (s,block))
+        else s
     in
        loop (0,MD5.init)
     end
@@ -271,8 +271,8 @@
 structure Main =
    struct
       fun doit n =
-	 if n = 0
-	    then ()
-	 else (Test.time_test ()
-	       ; doit (n - 1))
+         if n = 0
+            then ()
+         else (Test.time_test ()
+               ; doit (n - 1))
    end

Modified: mlton/branches/on-20050420-cmm-branch/benchmark/tests/merge.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/benchmark/tests/merge.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/benchmark/tests/merge.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -4,28 +4,28 @@
       ([], _) => l2
     | (_, []) => l1
     | (x1 :: l1', x2 :: l2') =>
-	 if x1 <= x2
-	    then x1 :: merge (l1', l2)
-	 else x2 :: merge (l1, l2')
+         if x1 <= x2
+            then x1 :: merge (l1', l2)
+         else x2 :: merge (l1, l2')
       
 structure Main =
    struct
       fun doit size =
-	 let
-	    val len = 100000
-	    val l1 = List.tabulate (len, fn i => i * 2)
-	    val l2 = List.tabulate (len, fn i => i * 2 + 1)
+         let
+            val len = 100000
+            val l1 = List.tabulate (len, fn i => i * 2)
+            val l2 = List.tabulate (len, fn i => i * 2 + 1)
 
-	    fun test () =
-	       if 0 = hd (merge (l1, l2))
-		  then ()
-	       else raise Fail "bug"
+            fun test () =
+               if 0 = hd (merge (l1, l2))
+                  then ()
+               else raise Fail "bug"
 
-	    fun loop n =
-	       if n = 0
-		  then ()
-	       else (test (); loop (n - 1))
-	 in
-	    loop size
-	 end
+            fun loop n =
+               if n = 0
+                  then ()
+               else (test (); loop (n - 1))
+         in
+            loop size
+         end
    end

Modified: mlton/branches/on-20050420-cmm-branch/benchmark/tests/mlyacc.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/benchmark/tests/mlyacc.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/benchmark/tests/mlyacc.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -12,41 +12,41 @@
       type elem
       exception Select_arb
       val app : (elem -> unit) -> set -> unit
-	  and card: set -> int
+          and card: set -> int
           and closure: set * (elem -> set) -> set
           and difference: set * set -> set
           and elem_eq: (elem * elem -> bool)
-	  and elem_gt : (elem * elem -> bool)
+          and elem_gt : (elem * elem -> bool)
           and empty: set
-	  and exists: (elem * set) -> bool
-	  and find : (elem * set)  ->  elem option
-	  and fold: ((elem * 'b) -> 'b) -> set -> 'b -> 'b
+          and exists: (elem * set) -> bool
+          and find : (elem * set)  ->  elem option
+          and fold: ((elem * 'b) -> 'b) -> set -> 'b -> 'b
           and insert: (elem * set) -> set
           and is_empty: set -> bool
           and make_list: set -> elem list
           and make_set: (elem list -> set)
           and partition: (elem -> bool) -> (set -> set * set)
           and remove: (elem * set) -> set
-	  and revfold: ((elem * 'b) -> 'b) -> set -> 'b -> 'b
+          and revfold: ((elem * 'b) -> 'b) -> set -> 'b -> 'b
           and select_arb: set -> elem
-	  and set_eq: (set * set) -> bool
-	  and set_gt: (set * set) -> bool
+          and set_eq: (set * set) -> bool
+          and set_gt: (set * set) -> bool
           and singleton: (elem -> set)
           and union: set * set -> set
    end
 
 signature TABLE =
    sig
-	type 'a table
-	type key
-	val size : 'a table -> int
-	val empty: 'a table
-	val exists: (key * 'a table) -> bool
-	val find : (key * 'a table)  ->  'a option
-	val insert: ((key * 'a) * 'a table) -> 'a table
-	val make_table : (key * 'a ) list -> 'a table
-	val make_list : 'a table -> (key * 'a) list
-	val fold : ((key * 'a) * 'b -> 'b) -> 'a table -> 'b -> 'b
+        type 'a table
+        type key
+        val size : 'a table -> int
+        val empty: 'a table
+        val exists: (key * 'a table) -> bool
+        val find : (key * 'a table)  ->  'a option
+        val insert: ((key * 'a) * 'a table) -> 'a table
+        val make_table : (key * 'a ) list -> 'a table
+        val make_list : 'a table -> (key * 'a) list
+        val fold : ((key * 'a) * 'b -> 'b) -> 'a table -> 'b -> 'b
    end
 
 signature HASH =
@@ -91,29 +91,29 @@
 signature LR_TABLE =
     sig
         datatype ('a,'b) pairlist = EMPTY | PAIR of 'a * 'b * ('a,'b) pairlist
-	datatype state = STATE of int
-	datatype term = T of int
-	datatype nonterm = NT of int
-	datatype action = SHIFT of state
-			| REDUCE of int
-			| ACCEPT
-			| ERROR
-	type table
-	
-	val numStates : table -> int
-	val numRules : table -> int
-	val describeActions : table -> state ->
-				(term,action) pairlist * action
-	val describeGoto : table -> state -> (nonterm,state) pairlist
-	val action : table -> state * term -> action
-	val goto : table -> state * nonterm -> state
-	val initialState : table -> state
-	exception Goto of state * nonterm
+        datatype state = STATE of int
+        datatype term = T of int
+        datatype nonterm = NT of int
+        datatype action = SHIFT of state
+                        | REDUCE of int
+                        | ACCEPT
+                        | ERROR
+        type table
+        
+        val numStates : table -> int
+        val numRules : table -> int
+        val describeActions : table -> state ->
+                                (term,action) pairlist * action
+        val describeGoto : table -> state -> (nonterm,state) pairlist
+        val action : table -> state * term -> action
+        val goto : table -> state * nonterm -> state
+        val initialState : table -> state
+        exception Goto of state * nonterm
 
-	val mkLrTable : {actions : ((term,action) pairlist * action) array,
-			 gotos : (nonterm,state) pairlist array,
-			 numStates : int, numRules : int,
-			 initialState : state} -> table
+        val mkLrTable : {actions : ((term,action) pairlist * action) array,
+                         gotos : (nonterm,state) pairlist array,
+                         numStates : int, numRules : int,
+                         initialState : state} -> table
     end
 
 (* TOKEN: signature revealing the internal structure of a token. This signature
@@ -130,14 +130,14 @@
    type 'a token which functions to construct tokens would create.  A
    constructor function for a integer token might be
 
-	  INT: int * 'a * 'a -> 'a token.
+          INT: int * 'a * 'a -> 'a token.
  
    This is not possible because we need to have tokens with the representation
    given below for the polymorphic parser.
 
    Thus our constructur functions for tokens have the form:
 
-	  INT: int * 'a * 'a -> (svalue,'a) token
+          INT: int * 'a * 'a -> (svalue,'a) token
 
    This in turn has had an impact on the signature that lexers for SML-Yacc
    must match and the types that a user must declare in the user declarations
@@ -146,46 +146,46 @@
 
 signature TOKEN =
     sig
-	structure LrTable : LR_TABLE
+        structure LrTable : LR_TABLE
         datatype ('a,'b) token = TOKEN of LrTable.term * ('a * 'b * 'b)
-	val sameToken : ('a,'b) token * ('a,'b) token -> bool
+        val sameToken : ('a,'b) token * ('a,'b) token -> bool
     end
 
 (* LR_PARSER: signature for a polymorphic LR parser *)
 
 signature LR_PARSER =
     sig
-	structure Stream: STREAM
-	structure LrTable : LR_TABLE
-	structure Token : TOKEN
+        structure Stream: STREAM
+        structure LrTable : LR_TABLE
+        structure Token : TOKEN
 
-	sharing LrTable = Token.LrTable
+        sharing LrTable = Token.LrTable
 
-	exception ParseError
+        exception ParseError
 
-	val parse : {table : LrTable.table,
-		     lexer : ('b,'c) Token.token Stream.stream,
-		     arg: 'arg,
-		     saction : int *
-			       'c *
-				(LrTable.state * ('b * 'c * 'c)) list * 
-				'arg ->
-				     LrTable.nonterm *
-				     ('b * 'c * 'c) *
-				     ((LrTable.state *('b * 'c * 'c)) list),
-		     void : 'b,
-		     ec : { is_keyword : LrTable.term -> bool,
-			    noShift : LrTable.term -> bool,
-			    preferred_change : (LrTable.term list * LrTable.term list) list,
-			    errtermvalue : LrTable.term -> 'b,
-			    showTerminal : LrTable.term -> string,
-			    terms: LrTable.term list,
-			    error : string * 'c * 'c -> unit
-			   },
-		     lookahead : int  (* max amount of lookahead used in *)
-				      (* error correction *)
-			} -> 'b *
-			     (('b,'c) Token.token Stream.stream)
+        val parse : {table : LrTable.table,
+                     lexer : ('b,'c) Token.token Stream.stream,
+                     arg: 'arg,
+                     saction : int *
+                               'c *
+                                (LrTable.state * ('b * 'c * 'c)) list * 
+                                'arg ->
+                                     LrTable.nonterm *
+                                     ('b * 'c * 'c) *
+                                     ((LrTable.state *('b * 'c * 'c)) list),
+                     void : 'b,
+                     ec : { is_keyword : LrTable.term -> bool,
+                            noShift : LrTable.term -> bool,
+                            preferred_change : (LrTable.term list * LrTable.term list) list,
+                            errtermvalue : LrTable.term -> 'b,
+                            showTerminal : LrTable.term -> string,
+                            terms: LrTable.term list,
+                            error : string * 'c * 'c -> unit
+                           },
+                     lookahead : int  (* max amount of lookahead used in *)
+                                      (* error correction *)
+                        } -> 'b *
+                             (('b,'c) Token.token Stream.stream)
     end
 
 (* LEXER: a signature that most lexers produced for use with SML-Yacc's
@@ -202,12 +202,12 @@
 signature LEXER =
    sig
        structure UserDeclarations :
-	   sig
-	        type ('a,'b) token
-		type pos
-		type svalue
-	   end
-	val makeLexer : (int -> string) -> unit -> 
+           sig
+                type ('a,'b) token
+                type pos
+                type svalue
+           end
+        val makeLexer : (int -> string) -> unit -> 
          (UserDeclarations.svalue,UserDeclarations.pos) UserDeclarations.token
    end
 
@@ -218,13 +218,13 @@
 signature ARG_LEXER =
    sig
        structure UserDeclarations :
-	   sig
-	        type ('a,'b) token
-		type pos
-		type svalue
-		type arg
-	   end
-	val makeLexer : (int -> string) -> UserDeclarations.arg -> unit -> 
+           sig
+                type ('a,'b) token
+                type pos
+                type svalue
+                type arg
+           end
+        val makeLexer : (int -> string) -> UserDeclarations.arg -> unit -> 
          (UserDeclarations.svalue,UserDeclarations.pos) UserDeclarations.token
    end
 
@@ -241,57 +241,57 @@
    sig
         (* the type of line numbers *)
 
-	type pos
+        type pos
 
-	(* the type of semantic values *)
+        (* the type of semantic values *)
 
-	type svalue
+        type svalue
 
          (* the type of the user-supplied argument to the parser *)
- 	type arg
+        type arg
  
-	(* the intended type of the result of the parser.  This value is
-	   produced by applying extract from the structure Actions to the
-	   final semantic value resultiing from a parse.
-	 *)
+        (* the intended type of the result of the parser.  This value is
+           produced by applying extract from the structure Actions to the
+           final semantic value resultiing from a parse.
+         *)
 
-	type result
+        type result
 
-	structure LrTable : LR_TABLE
-	structure Token : TOKEN
-	sharing Token.LrTable = LrTable
+        structure LrTable : LR_TABLE
+        structure Token : TOKEN
+        sharing Token.LrTable = LrTable
 
-	(* structure Actions contains the functions which mantain the
-	   semantic values stack in the parser.  Void is used to provide
-	   a default value for the semantic stack.
-	 *)
+        (* structure Actions contains the functions which mantain the
+           semantic values stack in the parser.  Void is used to provide
+           a default value for the semantic stack.
+         *)
 
-	structure Actions : 
-	  sig
-	      val actions : int * pos *
-		   (LrTable.state * (svalue * pos * pos)) list * arg->
-		         LrTable.nonterm * (svalue * pos * pos) *
-			 ((LrTable.state *(svalue * pos * pos)) list)
-	      val void : svalue
-	      val extract : svalue -> result
-	  end
+        structure Actions : 
+          sig
+              val actions : int * pos *
+                   (LrTable.state * (svalue * pos * pos)) list * arg->
+                         LrTable.nonterm * (svalue * pos * pos) *
+                         ((LrTable.state *(svalue * pos * pos)) list)
+              val void : svalue
+              val extract : svalue -> result
+          end
 
-	(* structure EC contains information used to improve error
-	   recovery in an error-correcting parser *)
+        (* structure EC contains information used to improve error
+           recovery in an error-correcting parser *)
 
-	structure EC :
-	   sig
-	     val is_keyword : LrTable.term -> bool
-	     val noShift : LrTable.term -> bool
- 	     val preferred_change : (LrTable.term list * LrTable.term list) list
-	     val errtermvalue : LrTable.term -> svalue
-	     val showTerminal : LrTable.term -> string
-	     val terms: LrTable.term list
-	   end
+        structure EC :
+           sig
+             val is_keyword : LrTable.term -> bool
+             val noShift : LrTable.term -> bool
+             val preferred_change : (LrTable.term list * LrTable.term list) list
+             val errtermvalue : LrTable.term -> svalue
+             val showTerminal : LrTable.term -> string
+             val terms: LrTable.term list
+           end
 
-	(* table is the LR table for the parser *)
+        (* table is the LR table for the parser *)
 
-	val table : LrTable.table
+        val table : LrTable.table
     end
 
 (* signature PARSER is the signature that most user parsers created by 
@@ -301,42 +301,42 @@
 signature PARSER =
     sig
         structure Token : TOKEN
-	structure Stream : STREAM
-	exception ParseError
+        structure Stream : STREAM
+        exception ParseError
 
-	(* type pos is the type of line numbers *)
+        (* type pos is the type of line numbers *)
 
-	type pos
+        type pos
 
-	(* type result is the type of the result from the parser *)
+        (* type result is the type of the result from the parser *)
 
-	type result
+        type result
 
          (* the type of the user-supplied argument to the parser *)
- 	type arg
-	
-	(* type svalue is the type of semantic values for the semantic value
-	   stack
-	 *)
+        type arg
+        
+        (* type svalue is the type of semantic values for the semantic value
+           stack
+         *)
 
-	type svalue
+        type svalue
 
-	(* val makeLexer is used to create a stream of tokens for the parser *)
+        (* val makeLexer is used to create a stream of tokens for the parser *)
 
-	val makeLexer : (int -> string) ->
-			 (svalue,pos) Token.token Stream.stream
+        val makeLexer : (int -> string) ->
+                         (svalue,pos) Token.token Stream.stream
 
-	(* val parse takes a stream of tokens and a function to print
-	   errors and returns a value of type result and a stream containing
-	   the unused tokens
-	 *)
+        (* val parse takes a stream of tokens and a function to print
+           errors and returns a value of type result and a stream containing
+           the unused tokens
+         *)
 
-	val parse : int * ((svalue,pos) Token.token Stream.stream) *
-		    (string * pos * pos -> unit) * arg ->
-				result * (svalue,pos) Token.token Stream.stream
+        val parse : int * ((svalue,pos) Token.token Stream.stream) *
+                    (string * pos * pos -> unit) * arg ->
+                                result * (svalue,pos) Token.token Stream.stream
 
-	val sameToken : (svalue,pos) Token.token * (svalue,pos) Token.token ->
-				bool
+        val sameToken : (svalue,pos) Token.token * (svalue,pos) Token.token ->
+                                bool
      end
 
 (* signature ARG_PARSER is the signature that will be matched by parsers whose
@@ -346,23 +346,23 @@
 signature ARG_PARSER = 
     sig
         structure Token : TOKEN
-	structure Stream : STREAM
-	exception ParseError
+        structure Stream : STREAM
+        exception ParseError
 
-	type arg
-	type lexarg
-	type pos
-	type result
-	type svalue
+        type arg
+        type lexarg
+        type pos
+        type result
+        type svalue
 
-	val makeLexer : (int -> string) -> lexarg ->
-			 (svalue,pos) Token.token Stream.stream
-	val parse : int * ((svalue,pos) Token.token Stream.stream) *
-		    (string * pos * pos -> unit) * arg ->
-				result * (svalue,pos) Token.token Stream.stream
+        val makeLexer : (int -> string) -> lexarg ->
+                         (svalue,pos) Token.token Stream.stream
+        val parse : int * ((svalue,pos) Token.token Stream.stream) *
+                    (string * pos * pos -> unit) * arg ->
+                                result * (svalue,pos) Token.token Stream.stream
 
-	val sameToken : (svalue,pos) Token.token * (svalue,pos) Token.token ->
-				bool
+        val sameToken : (svalue,pos) Token.token * (svalue,pos) Token.token ->
+                                bool
      end
 
 (* ML-Yacc Parser Generator (c) 1989, 1991 Andrew W. Appel, David R. Tarditi 
@@ -404,22 +404,22 @@
 
     datatype prec = LEFT | RIGHT | NONASSOC
     datatype control = NODEFAULT | VERBOSE | PARSER_NAME of symbol |
-	               FUNCTOR of string  | START_SYM of symbol |
-		       NSHIFT of symbol list | POS of string | PURE |
-		       PARSE_ARG of string * string
-			   
+                       FUNCTOR of string  | START_SYM of symbol |
+                       NSHIFT of symbol list | POS of string | PURE |
+                       PARSE_ARG of string * string
+                           
     datatype rule = RULE of {lhs : symbol, rhs : symbol list,
-		             code : string, prec : symbol option}
+                             code : string, prec : symbol option}
 
     datatype declData = DECL of 
-			{eop : symbol list,
-			 keyword : symbol list,
-			 nonterm : (symbol * ty option) list option,
-			 prec : (prec * (symbol list)) list,
-			 change: (symbol list * symbol list) list,
-			 term : (symbol * ty option) list option,
-			 control : control list,
-			 value : (symbol * string) list}
+                        {eop : symbol list,
+                         keyword : symbol list,
+                         nonterm : (symbol * ty option) list option,
+                         prec : (prec * (symbol list)) list,
+                         change: (symbol list * symbol list) list,
+                         term : (symbol * ty option) list option,
+                         control : control list,
+                         value : (symbol * string) list}
 
      val join_decls : declData * declData * inputSource * pos -> declData
 
@@ -440,215 +440,215 @@
 
 signature GRAMMAR =
     sig
-	
-	datatype term = T of int
-	datatype nonterm = NT of int
-	datatype symbol = TERM of term | NONTERM of nonterm
+        
+        datatype term = T of int
+        datatype nonterm = NT of int
+        datatype symbol = TERM of term | NONTERM of nonterm
 
-	(* grammar:
-	     terminals should be numbered from 0 to terms-1,
-	     nonterminals should be numbered from 0 to nonterms-1,
-	     rules should be numbered between 0 and (length rules) - 1,
-	     higher precedence binds tighter,
-	     start nonterminal should not occur on the rhs of any rule
-	*)
+        (* grammar:
+             terminals should be numbered from 0 to terms-1,
+             nonterminals should be numbered from 0 to nonterms-1,
+             rules should be numbered between 0 and (length rules) - 1,
+             higher precedence binds tighter,
+             start nonterminal should not occur on the rhs of any rule
+        *)
 
-	datatype grammar = GRAMMAR of
-			{rules: {lhs : nonterm, rhs : symbol list,
-				 precedence : int option, rulenum : int } list,
-			terms: int,
-			nonterms: int,
-			start : nonterm,
-			eop : term list,
-			noshift : term list,
-			precedence : term -> int option,
-			termToString : term -> string,
-			nontermToString : nonterm -> string} 
+        datatype grammar = GRAMMAR of
+                        {rules: {lhs : nonterm, rhs : symbol list,
+                                 precedence : int option, rulenum : int } list,
+                        terms: int,
+                        nonterms: int,
+                        start : nonterm,
+                        eop : term list,
+                        noshift : term list,
+                        precedence : term -> int option,
+                        termToString : term -> string,
+                        nontermToString : nonterm -> string} 
    end
 
 (* signature for internal version of grammar *)
 
 signature INTGRAMMAR =
     sig
-	structure Grammar  : GRAMMAR
-	structure SymbolAssoc : TABLE
-	structure NontermAssoc : TABLE
+        structure Grammar  : GRAMMAR
+        structure SymbolAssoc : TABLE
+        structure NontermAssoc : TABLE
 
-	sharing type SymbolAssoc.key = Grammar.symbol
-	sharing type NontermAssoc.key = Grammar.nonterm
+        sharing type SymbolAssoc.key = Grammar.symbol
+        sharing type NontermAssoc.key = Grammar.nonterm
 
-	datatype rule = RULE of
-		{lhs : Grammar.nonterm,
-		 rhs : Grammar.symbol list,
+        datatype rule = RULE of
+                {lhs : Grammar.nonterm,
+                 rhs : Grammar.symbol list,
 
-	(* internal number of rule - convenient for producing LR graph *)
+        (* internal number of rule - convenient for producing LR graph *)
 
-		 num : int,	
-		 rulenum : int,
-		 precedence : int option}
+                 num : int,     
+                 rulenum : int,
+                 precedence : int option}
 
-	val gtTerm : Grammar.term * Grammar.term -> bool
-	val eqTerm : Grammar.term * Grammar.term -> bool
+        val gtTerm : Grammar.term * Grammar.term -> bool
+        val eqTerm : Grammar.term * Grammar.term -> bool
 
-	val gtNonterm : Grammar.nonterm * Grammar.nonterm -> bool
-	val eqNonterm : Grammar.nonterm * Grammar.nonterm -> bool
+        val gtNonterm : Grammar.nonterm * Grammar.nonterm -> bool
+        val eqNonterm : Grammar.nonterm * Grammar.nonterm -> bool
 
-	val gtSymbol : Grammar.symbol * Grammar.symbol -> bool
-	val eqSymbol : Grammar.symbol * Grammar.symbol -> bool
+        val gtSymbol : Grammar.symbol * Grammar.symbol -> bool
+        val eqSymbol : Grammar.symbol * Grammar.symbol -> bool
 
-	(* Debugging information will be generated only if DEBUG is true. *)
+        (* Debugging information will be generated only if DEBUG is true. *)
 
-	val DEBUG : bool
+        val DEBUG : bool
 
-	val prRule : (Grammar.symbol -> string) * (Grammar.nonterm -> string) *
-				(string -> 'b) -> rule -> unit
-	val prGrammar : (Grammar.symbol -> string)*(Grammar.nonterm -> string) *
-				(string -> unit) -> Grammar.grammar -> unit
+        val prRule : (Grammar.symbol -> string) * (Grammar.nonterm -> string) *
+                                (string -> 'b) -> rule -> unit
+        val prGrammar : (Grammar.symbol -> string)*(Grammar.nonterm -> string) *
+                                (string -> unit) -> Grammar.grammar -> unit
     end
 
 signature CORE =
     sig
-	structure Grammar : GRAMMAR
-	structure IntGrammar : INTGRAMMAR
-	sharing Grammar = IntGrammar.Grammar
+        structure Grammar : GRAMMAR
+        structure IntGrammar : INTGRAMMAR
+        sharing Grammar = IntGrammar.Grammar
 
-	datatype item = ITEM of
-			{ rule : IntGrammar.rule,
-			  dot : int,
+        datatype item = ITEM of
+                        { rule : IntGrammar.rule,
+                          dot : int,
 
 (* rhsAfter: The portion of the rhs of a rule that lies after the dot *)
 
-			  rhsAfter: Grammar.symbol list }
+                          rhsAfter: Grammar.symbol list }
 
 (* eqItem and gtItem compare items *)
 
-	val eqItem : item * item -> bool
-	val gtItem : item * item -> bool
+        val eqItem : item * item -> bool
+        val gtItem : item * item -> bool
 
 (* functions for maintaining ordered item lists *)
 
-	val insert : item * item list -> item list
-	val union : item list * item list -> item list
+        val insert : item * item list -> item list
+        val union : item list * item list -> item list
 
 (* core:  a set of items.  It is represented by an ordered list of items. 
    The list is in ascending order The rule numbers and the positions of the
    dots are used to order the items. *)
 
-	datatype core = CORE of item list * int (* state # *)
+        datatype core = CORE of item list * int (* state # *)
 
 (* gtCore and eqCore compare the lists of items *)
 
-	val gtCore : core * core -> bool
-	val eqCore : core * core -> bool
+        val gtCore : core * core -> bool
+        val eqCore : core * core -> bool
 
 (* functions for debugging *)
 
-	val prItem : (Grammar.symbol -> string) * (Grammar.nonterm -> string) *
-				(string -> unit) -> item -> unit
-	val prCore : (Grammar.symbol -> string) * (Grammar.nonterm -> string) *
-				(string -> unit) -> core -> unit
+        val prItem : (Grammar.symbol -> string) * (Grammar.nonterm -> string) *
+                                (string -> unit) -> item -> unit
+        val prCore : (Grammar.symbol -> string) * (Grammar.nonterm -> string) *
+                                (string -> unit) -> core -> unit
 end
 
 signature CORE_UTILS =
     sig
 
-	structure Grammar : GRAMMAR
-	structure IntGrammar : INTGRAMMAR
-	structure Core : CORE
+        structure Grammar : GRAMMAR
+        structure IntGrammar : INTGRAMMAR
+        structure Core : CORE
 
-	sharing Grammar = IntGrammar.Grammar = Core.Grammar
-	sharing IntGrammar = Core.IntGrammar
+        sharing Grammar = IntGrammar.Grammar = Core.Grammar
+        sharing IntGrammar = Core.IntGrammar
 
 (* mkFuncs: create functions for the set of productions derived from a
    nonterminal, the cores that result from shift/gotos from a core,
     and return a list of rules *)
 
-	val mkFuncs : Grammar.grammar ->
-		{ produces : Grammar.nonterm -> IntGrammar.rule list,
+        val mkFuncs : Grammar.grammar ->
+                { produces : Grammar.nonterm -> IntGrammar.rule list,
 
 (* shifts: take a core and compute all the cores that result from shifts/gotos
    on symbols *)
 
-		  shifts : Core.core -> (Grammar.symbol*Core.item list) list,
-		  rules: IntGrammar.rule list,
+                  shifts : Core.core -> (Grammar.symbol*Core.item list) list,
+                  rules: IntGrammar.rule list,
 
 (* epsProds: take a core compute epsilon productions for it *)
 
-		  epsProds : Core.core -> IntGrammar.rule list}
-	end
+                  epsProds : Core.core -> IntGrammar.rule list}
+        end
 
 signature LRGRAPH =
     sig
-	structure Grammar : GRAMMAR
-	structure IntGrammar : INTGRAMMAR
-	structure Core : CORE
+        structure Grammar : GRAMMAR
+        structure IntGrammar : INTGRAMMAR
+        structure Core : CORE
 
-	sharing Grammar = IntGrammar.Grammar = Core.Grammar
-	sharing IntGrammar = Core.IntGrammar
+        sharing Grammar = IntGrammar.Grammar = Core.Grammar
+        sharing IntGrammar = Core.IntGrammar
 
-	type graph
-	val edges : Core.core * graph -> {edge:Grammar.symbol,to:Core.core} list
-	val nodes : graph -> Core.core list
-	val shift : graph -> int * Grammar.symbol -> int (* int = state # *)
-	val core : graph -> int -> Core.core (* get core for a state *)
+        type graph
+        val edges : Core.core * graph -> {edge:Grammar.symbol,to:Core.core} list
+        val nodes : graph -> Core.core list
+        val shift : graph -> int * Grammar.symbol -> int (* int = state # *)
+        val core : graph -> int -> Core.core (* get core for a state *)
 
 (* mkGraph: compute the LR(0) sets of items *)
 
-	val mkGraph :  Grammar.grammar ->
-			 {graph : graph,
-			  produces : Grammar.nonterm -> IntGrammar.rule list,
-			  rules : IntGrammar.rule list,
-			  epsProds: Core.core -> IntGrammar.rule list}
+        val mkGraph :  Grammar.grammar ->
+                         {graph : graph,
+                          produces : Grammar.nonterm -> IntGrammar.rule list,
+                          rules : IntGrammar.rule list,
+                          epsProds: Core.core -> IntGrammar.rule list}
 
-	val prGraph: (Grammar.symbol -> string)*(Grammar.nonterm -> string) *
-				(string -> unit) -> graph -> unit
+        val prGraph: (Grammar.symbol -> string)*(Grammar.nonterm -> string) *
+                                (string -> unit) -> graph -> unit
     end
 
 signature LOOK =
     sig
- 	structure Grammar : GRAMMAR
-	structure IntGrammar : INTGRAMMAR
-	sharing Grammar = IntGrammar.Grammar
+        structure Grammar : GRAMMAR
+        structure IntGrammar : INTGRAMMAR
+        sharing Grammar = IntGrammar.Grammar
 
-	val union : Grammar.term list * Grammar.term list -> Grammar.term list
-	val make_set : Grammar.term list -> Grammar.term list
+        val union : Grammar.term list * Grammar.term list -> Grammar.term list
+        val make_set : Grammar.term list -> Grammar.term list
 
-	val mkFuncs :  {rules : IntGrammar.rule list, nonterms : int,
-			produces : Grammar.nonterm -> IntGrammar.rule list} ->
-		 	    {nullable: Grammar.nonterm -> bool,
-			     first : Grammar.symbol list -> Grammar.term list}
+        val mkFuncs :  {rules : IntGrammar.rule list, nonterms : int,
+                        produces : Grammar.nonterm -> IntGrammar.rule list} ->
+                            {nullable: Grammar.nonterm -> bool,
+                             first : Grammar.symbol list -> Grammar.term list}
 
-	val prLook : (Grammar.term -> string) * (string -> unit) -> 
-			Grammar.term list -> unit
+        val prLook : (Grammar.term -> string) * (string -> unit) -> 
+                        Grammar.term list -> unit
    end
 
 signature LALR_GRAPH =
     sig
-	structure Grammar : GRAMMAR
-	structure IntGrammar : INTGRAMMAR
-	structure Core : CORE
-	structure Graph : LRGRAPH
+        structure Grammar : GRAMMAR
+        structure IntGrammar : INTGRAMMAR
+        structure Core : CORE
+        structure Graph : LRGRAPH
 
-	sharing Grammar = IntGrammar.Grammar = Core.Grammar = Graph.Grammar
-	sharing IntGrammar = Core.IntGrammar = Graph.IntGrammar
-	sharing Core = Graph.Core
+        sharing Grammar = IntGrammar.Grammar = Core.Grammar = Graph.Grammar
+        sharing IntGrammar = Core.IntGrammar = Graph.IntGrammar
+        sharing Core = Graph.Core
 
-	datatype lcore = LCORE of (Core.item * Grammar.term list) list * int
-	val addLookahead : {graph : Graph.graph,
-			    first : Grammar.symbol list -> Grammar.term list,
-			    eop : Grammar.term list,
-			    nonterms : int,
-			    nullable: Grammar.nonterm -> bool,
-			    produces : Grammar.nonterm -> IntGrammar.rule list,
-			    rules : IntGrammar.rule list,
-			    epsProds : Core.core -> IntGrammar.rule list,
-			    print : string -> unit,  (* for debugging *)
-			    termToString : Grammar.term -> string,
-			    nontermToString : Grammar.nonterm -> string} ->
-				lcore list
-	val prLcore : (Grammar.symbol -> string) * (Grammar.nonterm -> string) *
-		      (Grammar.term -> string) * (string -> unit) ->
-					 lcore -> unit
+        datatype lcore = LCORE of (Core.item * Grammar.term list) list * int
+        val addLookahead : {graph : Graph.graph,
+                            first : Grammar.symbol list -> Grammar.term list,
+                            eop : Grammar.term list,
+                            nonterms : int,
+                            nullable: Grammar.nonterm -> bool,
+                            produces : Grammar.nonterm -> IntGrammar.rule list,
+                            rules : IntGrammar.rule list,
+                            epsProds : Core.core -> IntGrammar.rule list,
+                            print : string -> unit,  (* for debugging *)
+                            termToString : Grammar.term -> string,
+                            nontermToString : Grammar.nonterm -> string} ->
+                                lcore list
+        val prLcore : (Grammar.symbol -> string) * (Grammar.nonterm -> string) *
+                      (Grammar.term -> string) * (string -> unit) ->
+                                         lcore -> unit
     end
 
 (* LR_ERRS: errors found while constructing an LR table *)
@@ -664,16 +664,16 @@
        START n : start symbol found on the rhs of rule n *)
 
     datatype err = RR of LrTable.term * LrTable.state * int * int
-		 | SR of LrTable.term * LrTable.state * int
-		 | NS of LrTable.term * int  
-		 | NOT_REDUCED of int
-	         | START of int
+                 | SR of LrTable.term * LrTable.state * int
+                 | NS of LrTable.term * int  
+                 | NOT_REDUCED of int
+                 | START of int
 
      val summary : err list -> {rr : int, sr: int,
-			    not_reduced : int, start : int,nonshift : int}
+                            not_reduced : int, start : int,nonshift : int}
 
      val printSummary : (string -> unit) -> err list -> unit
-				      
+                                      
   end
 
 (* PRINT_STRUCT: prints a structure which includes a value 'table' and a
@@ -684,13 +684,13 @@
   
 signature PRINT_STRUCT =
   sig
-	structure LrTable : LR_TABLE
-	val makeStruct :
-		{table : LrTable.table,
-		 name : string,
-		 print: string -> unit,
+        structure LrTable : LR_TABLE
+        val makeStruct :
+                {table : LrTable.table,
+                 name : string,
+                 print: string -> unit,
                  verbose : bool
-		} -> int
+                } -> int
   end
 
 (* VERBOSE: signature for a structure which takes a table and creates a
@@ -698,17 +698,17 @@
 
 signature VERBOSE =
   sig
-	structure Errs : LR_ERRS
-	val printVerbose :
-		{table : Errs.LrTable.table,
+        structure Errs : LR_ERRS
+        val printVerbose :
+                {table : Errs.LrTable.table,
                  entries : int,
-	         termToString : Errs.LrTable.term -> string,
-	         nontermToString : Errs.LrTable.nonterm -> string,
-		 stateErrs : Errs.LrTable.state -> Errs.err list,
-		 errs : Errs.err list,
-		 print: string -> unit,
-		 printCores : (string -> unit) -> Errs.LrTable.state -> unit,
-		 printRule : (string -> unit) -> int -> unit} -> unit
+                 termToString : Errs.LrTable.term -> string,
+                 nontermToString : Errs.LrTable.nonterm -> string,
+                 stateErrs : Errs.LrTable.state -> Errs.err list,
+                 errs : Errs.err list,
+                 print: string -> unit,
+                 printCores : (string -> unit) -> Errs.LrTable.state -> unit,
+                 printRule : (string -> unit) -> int -> unit} -> unit
   end
 
 (* MAKE_LR_TABLE: signature for a structure which includes a structure
@@ -717,22 +717,22 @@
 
 signature MAKE_LR_TABLE =
    sig
-	structure Grammar : GRAMMAR
-	structure Errs : LR_ERRS
-	structure LrTable : LR_TABLE
-	sharing Errs.LrTable = LrTable
+        structure Grammar : GRAMMAR
+        structure Errs : LR_ERRS
+        structure LrTable : LR_TABLE
+        sharing Errs.LrTable = LrTable
 
-	sharing type LrTable.term = Grammar.term
-	sharing type LrTable.nonterm = Grammar.nonterm
+        sharing type LrTable.term = Grammar.term
+        sharing type LrTable.nonterm = Grammar.nonterm
 
-	(* boolean value determines whether default reductions will be used.
-	   If it is true, reductions will be used. *)
+        (* boolean value determines whether default reductions will be used.
+           If it is true, reductions will be used. *)
 
-	val mkTable : Grammar.grammar * bool ->
-	       LrTable.table *
-	      (LrTable.state -> Errs.err list) *   (* errors in a state *)
-	      ((string -> unit) -> LrTable.state -> unit) *
-	       Errs.err list	(* list of all errors *)
+        val mkTable : Grammar.grammar * bool ->
+               LrTable.table *
+              (LrTable.state -> Errs.err list) *   (* errors in a state *)
+              ((string -> unit) -> LrTable.state -> unit) *
+               Errs.err list    (* list of all errors *)
    end;
 
 (* SHRINK_LR_TABLE: finds unique action entry rows in the  action table
@@ -746,9 +746,9 @@
           row, and a list of unique rows *)
        structure LrTable : LR_TABLE
        val shrinkActionList : LrTable.table * bool ->
-	        (int * int list *
-	           ((LrTable.term,LrTable.action) LrTable.pairlist *
-		    LrTable.action) list) * int
+                (int * int list *
+                   ((LrTable.term,LrTable.action) LrTable.pairlist *
+                    LrTable.action) list) * int
     end
 (* ML-Yacc Parser Generator (c) 1989 Andrew W. Appel, David R. Tarditi 
  *
@@ -765,102 +765,102 @@
 
 functor HeaderFun () : HEADER =
   struct
-	val DEBUG = true
+        val DEBUG = true
 
-	type pos = int
+        type pos = int
         val lineno = ref 0
         val text = ref (nil: string list)
         type inputSource = {name : string,
-			    errStream : TextIO.outstream,
-			    inStream : TextIO.instream,
-			    errorOccurred : bool ref}
+                            errStream : TextIO.outstream,
+                            inStream : TextIO.instream,
+                            errorOccurred : bool ref}
 
-	val newSource = 
-	  fn (s : string,i : TextIO.instream ,errs : TextIO.outstream) =>
-	      {name=s,errStream=errs,inStream=i,
-	       errorOccurred = ref false}
-			
-	val errorOccurred = fn (s : inputSource) =>fn () => !(#errorOccurred s)
+        val newSource = 
+          fn (s : string,i : TextIO.instream ,errs : TextIO.outstream) =>
+              {name=s,errStream=errs,inStream=i,
+               errorOccurred = ref false}
+                        
+        val errorOccurred = fn (s : inputSource) =>fn () => !(#errorOccurred s)
 
-	val pr = fn out : TextIO.outstream => fn s : string => TextIO.output(out,s)
+        val pr = fn out : TextIO.outstream => fn s : string => TextIO.output(out,s)
 
-	val error = fn {name,errStream, errorOccurred,...} : inputSource =>
-	      let val pr = pr errStream
-	      in fn l : pos => fn msg : string =>
-	          (pr name; pr ", line "; pr (Int.toString l); pr ": Error: ";
-	           pr msg; pr "\n"; errorOccurred := true)
-	      end
+        val error = fn {name,errStream, errorOccurred,...} : inputSource =>
+              let val pr = pr errStream
+              in fn l : pos => fn msg : string =>
+                  (pr name; pr ", line "; pr (Int.toString l); pr ": Error: ";
+                   pr msg; pr "\n"; errorOccurred := true)
+              end
 
-	val warn = fn {name,errStream, errorOccurred,...} : inputSource =>
-	      let val pr = pr errStream
-	      in fn l : pos => fn msg : string =>
-	          (pr name; pr ", line "; pr (Int.toString l); pr ": Warning: ";
-	           pr msg; pr "\n")
-	      end
+        val warn = fn {name,errStream, errorOccurred,...} : inputSource =>
+              let val pr = pr errStream
+              in fn l : pos => fn msg : string =>
+                  (pr name; pr ", line "; pr (Int.toString l); pr ": Warning: ";
+                   pr msg; pr "\n")
+              end
 
         datatype prec = LEFT | RIGHT | NONASSOC
 
-	datatype symbol = SYMBOL of string * pos
+        datatype symbol = SYMBOL of string * pos
         val symbolName = fn SYMBOL(s,_) => s
         val symbolPos = fn SYMBOL(_,p) => p
         val symbolMake = fn sp => SYMBOL sp
     
-	type ty = string
+        type ty = string
         val tyName = fn i => i
         val tyMake = fn i => i
  
-	datatype control = NODEFAULT | VERBOSE | PARSER_NAME of symbol |
-			   FUNCTOR of string  | START_SYM of symbol |
-			   NSHIFT of symbol list | POS of string | PURE |
-			   PARSE_ARG of string * string
-			   
-	datatype declData = DECL of
-			{eop : symbol list,
-			 keyword : symbol list,
-			 nonterm : (symbol*ty option) list option,
-			 prec : (prec * (symbol list)) list,
-			 change: (symbol list * symbol list) list,
-			 term : (symbol* ty option) list option,
-			 control : control list,
-			 value : (symbol * string) list}
+        datatype control = NODEFAULT | VERBOSE | PARSER_NAME of symbol |
+                           FUNCTOR of string  | START_SYM of symbol |
+                           NSHIFT of symbol list | POS of string | PURE |
+                           PARSE_ARG of string * string
+                           
+        datatype declData = DECL of
+                        {eop : symbol list,
+                         keyword : symbol list,
+                         nonterm : (symbol*ty option) list option,
+                         prec : (prec * (symbol list)) list,
+                         change: (symbol list * symbol list) list,
+                         term : (symbol* ty option) list option,
+                         control : control list,
+                         value : (symbol * string) list}
 
-	type rhsData = {rhs:symbol list,code:string, prec:symbol option} list
-	datatype rule = RULE of {lhs : symbol, rhs : symbol list,
-		                 code : string, prec : symbol option}
+        type rhsData = {rhs:symbol list,code:string, prec:symbol option} list
+        datatype rule = RULE of {lhs : symbol, rhs : symbol list,
+                                 code : string, prec : symbol option}
 
- 	type parseResult = string * declData * rule list
+        type parseResult = string * declData * rule list
         val getResult = fn p => p
 
-	fun join_decls
-	      (DECL {eop=e,control=c,keyword=k,nonterm=n,prec,
-		change=su,term=t,value=v}:declData,
-	       DECL {eop=e',control=c',keyword=k',nonterm=n',prec=prec',
-		     change=su',term=t',value=v'} : declData,
+        fun join_decls
+              (DECL {eop=e,control=c,keyword=k,nonterm=n,prec,
+                change=su,term=t,value=v}:declData,
+               DECL {eop=e',control=c',keyword=k',nonterm=n',prec=prec',
+                     change=su',term=t',value=v'} : declData,
                inputSource,pos) =
-	  let val ignore = fn s => 
-	                (warn inputSource pos ("ignoring duplicate " ^ s ^
-					    " declaration"))
-	      val join = fn (e,NONE,NONE) => NONE
-			  | (e,NONE,a) => a
-			  | (e,a,NONE) => a
-			  | (e,a,b) => (ignore e; a)
-	      fun mergeControl (nil,a) = [a]
-		| mergeControl (l as h::t,a) =
-		     case (h,a)
-	  	     of (PARSER_NAME _,PARSER_NAME n1) => (ignore "%name"; l)
-		      | (FUNCTOR _,FUNCTOR _) => (ignore "%header"; l)
-		      | (PARSE_ARG _,PARSE_ARG _) => (ignore "%arg"; l)
-		      | (START_SYM _,START_SYM s) => (ignore "%start"; l)
-		      | (POS _,POS _) => (ignore "%pos"; l)
-		      | (NSHIFT a,NSHIFT b) => (NSHIFT (a@b)::t)
-		      | _ => h :: mergeControl(t,a)
-	      fun loop (nil,r) = r
-		| loop (h::t,r) = loop(t,mergeControl(r,h))
-	 in DECL {eop=e@e',control=loop(c',c),keyword=k'@k,
-	    nonterm=join("%nonterm",n,n'), prec=prec@prec',
-	    change=su@su', term=join("%term",t,t'),value=v@v'} :
-	           declData
-	end
+          let val ignore = fn s => 
+                        (warn inputSource pos ("ignoring duplicate " ^ s ^
+                                            " declaration"))
+              val join = fn (e,NONE,NONE) => NONE
+                          | (e,NONE,a) => a
+                          | (e,a,NONE) => a
+                          | (e,a,b) => (ignore e; a)
+              fun mergeControl (nil,a) = [a]
+                | mergeControl (l as h::t,a) =
+                     case (h,a)
+                     of (PARSER_NAME _,PARSER_NAME n1) => (ignore "%name"; l)
+                      | (FUNCTOR _,FUNCTOR _) => (ignore "%header"; l)
+                      | (PARSE_ARG _,PARSE_ARG _) => (ignore "%arg"; l)
+                      | (START_SYM _,START_SYM s) => (ignore "%start"; l)
+                      | (POS _,POS _) => (ignore "%pos"; l)
+                      | (NSHIFT a,NSHIFT b) => (NSHIFT (a@b)::t)
+                      | _ => h :: mergeControl(t,a)
+              fun loop (nil,r) = r
+                | loop (h::t,r) = loop(t,mergeControl(r,h))
+         in DECL {eop=e@e',control=loop(c',c),keyword=k'@k,
+            nonterm=join("%nonterm",n,n'), prec=prec@prec',
+            change=su@su', term=join("%term",t,t'),value=v@v'} :
+                   declData
+        end
 end;
 
 structure Header = HeaderFun();
@@ -920,8 +920,8 @@
 end
 functor MlyaccLrValsFun(structure Hdr : HEADER 
                                         where type prec = Header.prec
-			structure Token : TOKEN) = 
-			     
+                        structure Token : TOKEN) = 
+                             
 struct
 structure ParserData=
 struct
@@ -1336,8 +1336,8 @@
  in (LrTable.NT 5,(result,MPC_DECLS1left,MPC_DECL1right),rest671) end
 | (2,rest671) => let val result=MlyValue.MPC_DECLS(fn _ => (
 DECL {prec=nil,nonterm=NONE,term=NONE,eop=nil,control=nil,
-		   keyword=nil,change=nil,
-		   value=nil}
+                   keyword=nil,change=nil,
+                   value=nil}
 ))
  in (LrTable.NT 5,(result,defaultPos,defaultPos),rest671) end
 | (3,(_,(MlyValue.CONSTR_LIST CONSTR_LIST1,_,CONSTR_LIST1right))::(_,(
@@ -1345,9 +1345,9 @@
 let val CONSTR_LIST as CONSTR_LIST1=CONSTR_LIST1 ()
  in (
 DECL { prec=nil,nonterm=NONE,
-	       term = SOME CONSTR_LIST, eop =nil,control=nil,
-		change=nil,keyword=nil,
-		value=nil}
+               term = SOME CONSTR_LIST, eop =nil,control=nil,
+                change=nil,keyword=nil,
+                value=nil}
 ) end
 )
  in (LrTable.NT 4,(result,TERM1left,CONSTR_LIST1right),rest671) end
@@ -1356,8 +1356,8 @@
  => let val CONSTR_LIST as CONSTR_LIST1=CONSTR_LIST1 ()
  in (
 DECL { prec=nil,control=nil,nonterm= SOME CONSTR_LIST,
-	       term = NONE, eop=nil,change=nil,keyword=nil,
-	       value=nil}
+               term = NONE, eop=nil,change=nil,keyword=nil,
+               value=nil}
 ) end
 )
  in (LrTable.NT 4,(result,NONTERM1left,CONSTR_LIST1right),rest671) end
@@ -1367,8 +1367,8 @@
 val ID_LIST as ID_LIST1=ID_LIST1 ()
  in (
 DECL {prec= [(PREC,ID_LIST)],control=nil,
-	      nonterm=NONE,term=NONE,eop=nil,change=nil,
-	      keyword=nil,value=nil}
+              nonterm=NONE,term=NONE,eop=nil,change=nil,
+              keyword=nil,value=nil}
 ) end
 )
  in (LrTable.NT 4,(result,PREC1left,ID_LIST1right),rest671) end
@@ -1376,8 +1376,8 @@
  => let val result=MlyValue.MPC_DECL(fn _ => let val ID as ID1=ID1 ()
  in (
 DECL {prec=nil,control=[START_SYM (symbolMake ID)],nonterm=NONE,
-	       term = NONE, eop = nil,change=nil,keyword=nil,
-	       value=nil}
+               term = NONE, eop = nil,change=nil,keyword=nil,
+               value=nil}
 ) end
 )
  in (LrTable.NT 4,(result,START1left,ID1right),rest671) end
@@ -1386,8 +1386,8 @@
 _ => let val ID_LIST as ID_LIST1=ID_LIST1 ()
  in (
 DECL {prec=nil,control=nil,nonterm=NONE,term=NONE,
-		eop=ID_LIST, change=nil,keyword=nil,
-	 	value=nil}
+                eop=ID_LIST, change=nil,keyword=nil,
+                value=nil}
 ) end
 )
  in (LrTable.NT 4,(result,PERCENT_EOP1left,ID_LIST1right),rest671) end
@@ -1396,8 +1396,8 @@
  => let val ID_LIST as ID_LIST1=ID_LIST1 ()
  in (
 DECL {prec=nil,control=nil,nonterm=NONE,term=NONE,eop=nil,
-		change=nil,keyword=ID_LIST,
-	 	value=nil}
+                change=nil,keyword=ID_LIST,
+                value=nil}
 ) end
 )
  in (LrTable.NT 4,(result,KEYWORD1left,ID_LIST1right),rest671) end
@@ -1406,8 +1406,8 @@
 let val ID_LIST as ID_LIST1=ID_LIST1 ()
  in (
 DECL {prec=nil,control=nil,nonterm=NONE,term=NONE,eop=nil,
-		    change=map (fn i=>([],[i])) ID_LIST,keyword=nil,
-		    value=nil}
+                    change=map (fn i=>([],[i])) ID_LIST,keyword=nil,
+                    value=nil}
 ) end
 )
  in (LrTable.NT 4,(result,PREFER1left,ID_LIST1right),rest671) end
@@ -1416,8 +1416,8 @@
  => let val CHANGE_DECL as CHANGE_DECL1=CHANGE_DECL1 ()
  in (
 DECL {prec=nil,control=nil,nonterm=NONE,term=NONE,eop=nil,
-		change=CHANGE_DECL,keyword=nil,
-		value=nil}
+                change=CHANGE_DECL,keyword=nil,
+                value=nil}
 ) end
 )
  in (LrTable.NT 4,(result,CHANGE1left,CHANGE_DECL1right),rest671) end
@@ -1426,8 +1426,8 @@
 let val SUBST_DECL as SUBST_DECL1=SUBST_DECL1 ()
  in (
 DECL {prec=nil,control=nil,nonterm=NONE,term=NONE,eop=nil,
-		change=SUBST_DECL,keyword=nil,
-		value=nil}
+                change=SUBST_DECL,keyword=nil,
+                value=nil}
 ) end
 )
  in (LrTable.NT 4,(result,SUBST1left,SUBST_DECL1right),rest671) end
@@ -1436,8 +1436,8 @@
  => let val ID_LIST as ID_LIST1=ID_LIST1 ()
  in (
 DECL {prec=nil,control=[NSHIFT ID_LIST],nonterm=NONE,term=NONE,
-	            eop=nil,change=nil,keyword=nil,
-		    value=nil}
+                    eop=nil,change=nil,keyword=nil,
+                    value=nil}
 ) end
 )
  in (LrTable.NT 4,(result,NOSHIFT1left,ID_LIST1right),rest671) end
@@ -1446,8 +1446,8 @@
 fn _ => let val PROG as PROG1=PROG1 ()
  in (
 DECL {prec=nil,control=[FUNCTOR PROG],nonterm=NONE,term=NONE,
-	            eop=nil,change=nil,keyword=nil,
-		    value=nil}
+                    eop=nil,change=nil,keyword=nil,
+                    value=nil}
 ) end
 )
  in (LrTable.NT 4,(result,PERCENT_HEADER1left,PROG1right),rest671) end
@@ -1455,8 +1455,8 @@
  => let val result=MlyValue.MPC_DECL(fn _ => let val ID as ID1=ID1 ()
  in (
 DECL {prec=nil,control=[PARSER_NAME (symbolMake ID)],
-	            nonterm=NONE,term=NONE,
-		    eop=nil,change=nil,keyword=nil, value=nil}
+                    nonterm=NONE,term=NONE,
+                    eop=nil,change=nil,keyword=nil, value=nil}
 ) end
 )
  in (LrTable.NT 4,(result,NAME1left,ID1right),rest671) end
@@ -1466,33 +1466,33 @@
 val TY as TY1=TY1 ()
  in (
 DECL {prec=nil,control=[PARSE_ARG(PROG,TY)],nonterm=NONE,
-	            term=NONE,eop=nil,change=nil,keyword=nil,
-		     value=nil}
+                    term=NONE,eop=nil,change=nil,keyword=nil,
+                     value=nil}
 ) end
 )
  in (LrTable.NT 4,(result,PERCENT_ARG1left,TY1right),rest671) end
 | (16,(_,(_,VERBOSE1left,VERBOSE1right))::rest671) => let val result=
 MlyValue.MPC_DECL(fn _ => (
 DECL {prec=nil,control=[Hdr.VERBOSE],
-	        nonterm=NONE,term=NONE,eop=nil,
-	        change=nil,keyword=nil,
-		value=nil}
+                nonterm=NONE,term=NONE,eop=nil,
+                change=nil,keyword=nil,
+                value=nil}
 ))
  in (LrTable.NT 4,(result,VERBOSE1left,VERBOSE1right),rest671) end
 | (17,(_,(_,NODEFAULT1left,NODEFAULT1right))::rest671) => let val 
 result=MlyValue.MPC_DECL(fn _ => (
 DECL {prec=nil,control=[Hdr.NODEFAULT],
-	        nonterm=NONE,term=NONE,eop=nil,
-	        change=nil,keyword=nil,
-		value=nil}
+                nonterm=NONE,term=NONE,eop=nil,
+                change=nil,keyword=nil,
+                value=nil}
 ))
  in (LrTable.NT 4,(result,NODEFAULT1left,NODEFAULT1right),rest671) end
 | (18,(_,(_,PERCENT_PURE1left,PERCENT_PURE1right))::rest671) => let 
 val result=MlyValue.MPC_DECL(fn _ => (
 DECL {prec=nil,control=[Hdr.PURE],
-	        nonterm=NONE,term=NONE,eop=nil,
-	        change=nil,keyword=nil,
-		value=nil}
+                nonterm=NONE,term=NONE,eop=nil,
+                change=nil,keyword=nil,
+                value=nil}
 ))
  in (LrTable.NT 4,(result,PERCENT_PURE1left,PERCENT_PURE1right),
 rest671) end
@@ -1501,9 +1501,9 @@
 =TY1 ()
  in (
 DECL {prec=nil,control=[Hdr.POS TY],
-	        nonterm=NONE,term=NONE,eop=nil,
-	        change=nil,keyword=nil,
-		value=nil}
+                nonterm=NONE,term=NONE,eop=nil,
+                change=nil,keyword=nil,
+                value=nil}
 ) end
 )
  in (LrTable.NT 4,(result,PERCENT_POS1left,TY1right),rest671) end
@@ -1513,9 +1513,9 @@
 val PROG as PROG1=PROG1 ()
  in (
 DECL {prec=nil,control=nil,
-	        nonterm=NONE,term=NONE,eop=nil,
-	        change=nil,keyword=nil,
-		value=[(symbolMake ID,PROG)]}
+                nonterm=NONE,term=NONE,eop=nil,
+                change=nil,keyword=nil,
+                value=[(symbolMake ID,PROG)]}
 ) end
 )
  in (LrTable.NT 4,(result,VALUE1left,PROG1right),rest671) end
@@ -1600,9 +1600,9 @@
 val RHS_LIST as RHS_LIST1=RHS_LIST1 ()
  in (
 map (fn {rhs,code,prec} =>
-    	          Hdr.RULE {lhs=symbolMake ID,rhs=rhs,
-			       code=code,prec=prec})
-	 RHS_LIST
+                  Hdr.RULE {lhs=symbolMake ID,rhs=rhs,
+                               code=code,prec=prec})
+         RHS_LIST
 ) end
 )
  in (LrTable.NT 9,(result,ID1left,RHS_LIST1right),rest671) end
@@ -1746,7 +1746,7 @@
 val void = MlyValue.VOID
 val extract = fn a => (fn MlyValue.BEGIN x => x
 | _ => let exception ParseInternal
-	in raise ParseInternal end) a ()
+        in raise ParseInternal end) a ()
 end
 end
 structure Tokens : Mlyacc_TOKENS =
@@ -1847,60 +1847,60 @@
 
 structure LrTable : LR_TABLE = 
     struct
-	open Array List
-	infix 9 sub
-	datatype ('a,'b) pairlist = EMPTY
-				  | PAIR of 'a * 'b * ('a,'b) pairlist
-	datatype term = T of int
-	datatype nonterm = NT of int
-	datatype state = STATE of int
-	datatype action = SHIFT of state
-			| REDUCE of int (* rulenum from grammar *)
-			| ACCEPT
-			| ERROR
-	exception Goto of state * nonterm
-	type table = {states: int, rules : int,initialState: state,
-		      action: ((term,action) pairlist * action) array,
-		      goto :  (nonterm,state) pairlist array}
-	val numStates = fn ({states,...} : table) => states
-	val numRules = fn ({rules,...} : table) => rules
-	val describeActions =
-	   fn ({action,...} : table) => 
-	           fn (STATE s) => action sub s
-	val describeGoto =
-	   fn ({goto,...} : table) =>
-	           fn (STATE s) => goto sub s
-	fun findTerm (T term,row,default) =
-	    let fun find (PAIR (T key,data,r)) =
-		       if key < term then find r
-		       else if key=term then data
-		       else default
-		   | find EMPTY = default
-	    in find row
-	    end
-	fun findNonterm (NT nt,row) =
-	    let fun find (PAIR (NT key,data,r)) =
-		       if key < nt then find r
-		       else if key=nt then SOME data
-		       else NONE
-		   | find EMPTY = NONE
-	    in find row
-	    end
-	val action = fn ({action,...} : table) =>
-		fn (STATE state,term) =>
-		  let val (row,default) = action sub state
-		  in findTerm(term,row,default)
-		  end
-	val goto = fn ({goto,...} : table) =>
-			fn (a as (STATE state,nonterm)) =>
-			  case findNonterm(nonterm,goto sub state)
-			  of SOME state => state
-			   | NONE => raise (Goto a)
-	val initialState = fn ({initialState,...} : table) => initialState
-	val mkLrTable = fn {actions,gotos,initialState,numStates,numRules} =>
-	     ({action=actions,goto=gotos,
-	       states=numStates,
-	       rules=numRules,
+        open Array List
+        infix 9 sub
+        datatype ('a,'b) pairlist = EMPTY
+                                  | PAIR of 'a * 'b * ('a,'b) pairlist
+        datatype term = T of int
+        datatype nonterm = NT of int
+        datatype state = STATE of int
+        datatype action = SHIFT of state
+                        | REDUCE of int (* rulenum from grammar *)
+                        | ACCEPT
+                        | ERROR
+        exception Goto of state * nonterm
+        type table = {states: int, rules : int,initialState: state,
+                      action: ((term,action) pairlist * action) array,
+                      goto :  (nonterm,state) pairlist array}
+        val numStates = fn ({states,...} : table) => states
+        val numRules = fn ({rules,...} : table) => rules
+        val describeActions =
+           fn ({action,...} : table) => 
+                   fn (STATE s) => action sub s
+        val describeGoto =
+           fn ({goto,...} : table) =>
+                   fn (STATE s) => goto sub s
+        fun findTerm (T term,row,default) =
+            let fun find (PAIR (T key,data,r)) =
+                       if key < term then find r
+                       else if key=term then data
+                       else default
+                   | find EMPTY = default
+            in find row
+            end
+        fun findNonterm (NT nt,row) =
+            let fun find (PAIR (NT key,data,r)) =
+                       if key < nt then find r
+                       else if key=nt then SOME data
+                       else NONE
+                   | find EMPTY = NONE
+            in find row
+            end
+        val action = fn ({action,...} : table) =>
+                fn (STATE state,term) =>
+                  let val (row,default) = action sub state
+                  in findTerm(term,row,default)
+                  end
+        val goto = fn ({goto,...} : table) =>
+                        fn (a as (STATE state,nonterm)) =>
+                          case findNonterm(nonterm,goto sub state)
+                          of SOME state => state
+                           | NONE => raise (Goto a)
+        val initialState = fn ({initialState,...} : table) => initialState
+        val mkLrTable = fn {actions,gotos,initialState,numStates,numRules} =>
+             ({action=actions,goto=gotos,
+               states=numStates,
+               rules=numRules,
                initialState=initialState} : table)
 end;
 (* ML-Yacc Parser Generator (c) 1989 Andrew W. Appel, David R. Tarditi 
@@ -1922,7 +1922,7 @@
 
    fun get(ref(EVAL t)) = t
      | get(s as ref(UNEVAL f)) = 
-	    let val t = (f(), ref(UNEVAL f)) in s := EVAL t; t end
+            let val t = (f(), ref(UNEVAL f)) in s := EVAL t; t end
 
    fun streamify f = ref(UNEVAL f)
    fun cons(a,s) = ref(EVAL(a,s))
@@ -1948,10 +1948,10 @@
    routine added to it.  The routine used is described in detail in this
    article:
 
-	'A Practical Method for LR and LL Syntactic Error Diagnosis and
-	 Recovery', by M. Burke and G. Fisher, ACM Transactions on
-	 Programming Langauges and Systems, Vol. 9, No. 2, April 1987,
-	 pp. 164-197.
+        'A Practical Method for LR and LL Syntactic Error Diagnosis and
+         Recovery', by M. Burke and G. Fisher, ACM Transactions on
+         Programming Langauges and Systems, Vol. 9, No. 2, April 1987,
+         pp. 164-197.
 
     This program is an implementation is the partial, deferred method discussed
     in the article.  The algorithm and data structures used in the program
@@ -1967,60 +1967,60 @@
 
     Data Structures:
     ----------------
-	
-	* The parser:
+        
+        * The parser:
 
-	   The state stack has the type
+           The state stack has the type
 
-		 (state * (semantic value * line # * line #)) list
+                 (state * (semantic value * line # * line #)) list
 
-	   The parser keeps a queue of (state stack * lexer pair).  A lexer pair
-	 consists of a terminal * value pair and a lexer.  This allows the 
-	 parser to reconstruct the states for terminals to the left of a
-	 syntax error, and attempt to make error corrections there.
+           The parser keeps a queue of (state stack * lexer pair).  A lexer pair
+         consists of a terminal * value pair and a lexer.  This allows the 
+         parser to reconstruct the states for terminals to the left of a
+         syntax error, and attempt to make error corrections there.
 
-	   The queue consists of a pair of lists (x,y).  New additions to
-	 the queue are cons'ed onto y.  The first element of x is the top
-	 of the queue.  If x is nil, then y is reversed and used
-	 in place of x.
+           The queue consists of a pair of lists (x,y).  New additions to
+         the queue are cons'ed onto y.  The first element of x is the top
+         of the queue.  If x is nil, then y is reversed and used
+         in place of x.
 
     Algorithm:
     ----------
 
-	* The steady-state parser:  
+        * The steady-state parser:  
 
-	    This parser keeps the length of the queue of state stacks at
-	a steady state by always removing an element from the front when
-	another element is placed on the end.
+            This parser keeps the length of the queue of state stacks at
+        a steady state by always removing an element from the front when
+        another element is placed on the end.
 
-	    It has these arguments:
+            It has these arguments:
 
-	   stack: current stack
-	   queue: value of the queue
-	   lexPair ((terminal,value),lex stream)
+           stack: current stack
+           queue: value of the queue
+           lexPair ((terminal,value),lex stream)
 
-	When SHIFT is encountered, the state to shift to and the value are
-	are pushed onto the state stack.  The state stack and lexPair are
-	placed on the queue.  The front element of the queue is removed.
+        When SHIFT is encountered, the state to shift to and the value are
+        are pushed onto the state stack.  The state stack and lexPair are
+        placed on the queue.  The front element of the queue is removed.
 
-	When REDUCTION is encountered, the rule is applied to the current
-	stack to yield a triple (nonterm,value,new stack).  A new
-	stack is formed by adding (goto(top state of stack,nonterm),value)
-	to the stack.
+        When REDUCTION is encountered, the rule is applied to the current
+        stack to yield a triple (nonterm,value,new stack).  A new
+        stack is formed by adding (goto(top state of stack,nonterm),value)
+        to the stack.
 
-	When ACCEPT is encountered, the top value from the stack and the
-	lexer are returned.
+        When ACCEPT is encountered, the top value from the stack and the
+        lexer are returned.
 
-	When an ERROR is encountered, fixError is called.  FixError
-	takes the arguments to the parser, fixes the error if possible and
+        When an ERROR is encountered, fixError is called.  FixError
+        takes the arguments to the parser, fixes the error if possible and
         returns a new set of arguments.
 
-	* The distance-parser:
+        * The distance-parser:
 
-	This parser includes an additional argument distance.  It pushes
-	elements on the queue until it has parsed distance tokens, or an
-	ACCEPT or ERROR occurs.  It returns a stack, lexer, the number of
-	tokens left unparsed, a queue, and an action option.
+        This parser includes an additional argument distance.  It pushes
+        elements on the queue until it has parsed distance tokens, or an
+        ACCEPT or ERROR occurs.  It returns a stack, lexer, the number of
+        tokens left unparsed, a queue, and an action option.
 *)
 
 signature FIFO = 
@@ -2035,7 +2035,7 @@
    it wastes space in the release version.
 
 functor ParserGen(structure LrTable : LR_TABLE
-		  structure Stream : STREAM) : LR_PARSER =
+                  structure Stream : STREAM) : LR_PARSER =
 *)
 
 structure LrParser :> LR_PARSER =
@@ -2044,10 +2044,10 @@
       structure Stream = Stream
 
       structure Token : TOKEN =
-	struct
-	    structure LrTable = LrTable
-	    datatype ('a,'b) token = TOKEN of LrTable.term * ('a * 'b * 'b)
-	    val sameToken = fn (TOKEN(t,_),TOKEN(t',_)) => t=t'
+        struct
+            structure LrTable = LrTable
+            datatype ('a,'b) token = TOKEN of LrTable.term * ('a * 'b * 'b)
+            val sameToken = fn (TOKEN(t,_),TOKEN(t',_)) => t=t'
         end
 
       open LrTable
@@ -2060,13 +2060,13 @@
 
       structure Fifo :> FIFO =
         struct
-	  type 'a queue = ('a list * 'a list)
-	  val empty = (nil,nil)
-	  exception Empty
-	  fun get(a::x, y) = (a, (x,y))
-	    | get(nil, nil) = raise Empty
-	    | get(nil, y) = get(rev y, nil)
- 	  fun put(a,(x,y)) = (x,a::y)
+          type 'a queue = ('a list * 'a list)
+          val empty = (nil,nil)
+          exception Empty
+          fun get(a::x, y) = (a, (x,y))
+            | get(nil, nil) = raise Empty
+            | get(nil, y) = get(rev y, nil)
+          fun put(a,(x,y)) = (x,a::y)
         end
 
       type ('a,'b) elem = (state * ('a * 'b * 'b))
@@ -2074,29 +2074,29 @@
       type ('a,'b) lexv = ('a,'b) token
       type ('a,'b) lexpair = ('a,'b) lexv * (('a,'b) lexv Stream.stream)
       type ('a,'b) distanceParse =
-		 ('a,'b) lexpair *
-		 ('a,'b) stack * 
-		 (('a,'b) stack * ('a,'b) lexpair) Fifo.queue *
-		 int ->
-		   ('a,'b) lexpair *
-		   ('a,'b) stack * 
-		   (('a,'b) stack * ('a,'b) lexpair) Fifo.queue *
-		   int *
-		   action option
+                 ('a,'b) lexpair *
+                 ('a,'b) stack * 
+                 (('a,'b) stack * ('a,'b) lexpair) Fifo.queue *
+                 int ->
+                   ('a,'b) lexpair *
+                   ('a,'b) stack * 
+                   (('a,'b) stack * ('a,'b) lexpair) Fifo.queue *
+                   int *
+                   action option
 
       type ('a,'b) ecRecord =
-	 {is_keyword : term -> bool,
+         {is_keyword : term -> bool,
           preferred_change : (term list * term list) list,
-	  error : string * 'b * 'b -> unit,
-	  errtermvalue : term -> 'a,
-	  terms : term list,
-	  showTerminal : term -> string,
-	  noShift : term -> bool}
+          error : string * 'b * 'b -> unit,
+          errtermvalue : term -> 'a,
+          terms : term list,
+          showTerminal : term -> string,
+          noShift : term -> bool}
 
       local 
-	 val print = fn s => TextIO.output(TextIO.stdOut,s)
-	 val println = fn s => (print s; print "\n")
-	 val showState = fn (STATE s) => "STATE " ^ (Int.toString s)
+         val print = fn s => TextIO.output(TextIO.stdOut,s)
+         val println = fn s => (print s; print "\n")
+         val showState = fn (STATE s) => "STATE " ^ (Int.toString s)
       in
         fun printStack(stack: ('a,'b) stack, n: int) =
          case stack
@@ -2107,11 +2107,11 @@
             | nil => ()
                 
         fun prAction showTerminal
-		 (stack as (state,_) :: _, next as (TOKEN (term,_),_), action) =
+                 (stack as (state,_) :: _, next as (TOKEN (term,_),_), action) =
              (println "Parse: state stack:";
               printStack(stack, 0);
               print("       state="
-                         ^ showState state	
+                         ^ showState state      
                          ^ " next="
                          ^ showTerminal term
                          ^ " action="
@@ -2120,206 +2120,206 @@
                 of SHIFT state => println ("SHIFT " ^ (showState state))
                  | REDUCE i => println ("REDUCE " ^ (Int.toString i))
                  | ERROR => println "ERROR"
-		 | ACCEPT => println "ACCEPT")
+                 | ACCEPT => println "ACCEPT")
         | prAction _ (_,_,action) = ()
      end
 
     (* ssParse: parser which maintains the queue of (state * lexvalues) in a
-	steady-state.  It takes a table, showTerminal function, saction
-	function, and fixError function.  It parses until an ACCEPT is
-	encountered, or an exception is raised.  When an error is encountered,
-	fixError is called with the arguments of parseStep (lexv,stack,and
-	queue).  It returns the lexv, and a new stack and queue adjusted so
-	that the lexv can be parsed *)
-	
+        steady-state.  It takes a table, showTerminal function, saction
+        function, and fixError function.  It parses until an ACCEPT is
+        encountered, or an exception is raised.  When an error is encountered,
+        fixError is called with the arguments of parseStep (lexv,stack,and
+        queue).  It returns the lexv, and a new stack and queue adjusted so
+        that the lexv can be parsed *)
+        
     val ssParse =
       fn (table,showTerminal,saction,fixError,arg) =>
-	let val prAction = prAction showTerminal
-	    val action = LrTable.action table
-	    val goto = LrTable.goto table
-	    fun parseStep(args as
-			 (lexPair as (TOKEN (terminal, value as (_,leftPos,_)),
-				      lexer
-				      ),
-			  stack as (state,_) :: _,
-			  queue)) =
-	      let val nextAction = action (state,terminal)
-	          val _ = if DEBUG1 then prAction(stack,lexPair,nextAction)
-			  else ()
-	      in case nextAction
-		 of SHIFT s =>
-		  let val newStack = (s,value) :: stack
-		      val newLexPair = Stream.get lexer
-		      val (_,newQueue) =Fifo.get(Fifo.put((newStack,newLexPair),
-							    queue))
-		  in parseStep(newLexPair,(s,value)::stack,newQueue)
-		  end
-		 | REDUCE i =>
-		     (case saction(i,leftPos,stack,arg)
-		      of (nonterm,value,stack as (state,_) :: _) =>
-		          parseStep(lexPair,(goto(state,nonterm),value)::stack,
-				    queue)
-		       | _ => raise (ParseImpossible 197))
-		 | ERROR => parseStep(fixError args)
-		 | ACCEPT => 
-			(case stack
-			 of (_,(topvalue,_,_)) :: _ =>
-				let val (token,restLexer) = lexPair
-				in (topvalue,Stream.cons(token,restLexer))
-				end
-			  | _ => raise (ParseImpossible 202))
-	      end
-	    | parseStep _ = raise (ParseImpossible 204)
-	in parseStep
-	end
+        let val prAction = prAction showTerminal
+            val action = LrTable.action table
+            val goto = LrTable.goto table
+            fun parseStep(args as
+                         (lexPair as (TOKEN (terminal, value as (_,leftPos,_)),
+                                      lexer
+                                      ),
+                          stack as (state,_) :: _,
+                          queue)) =
+              let val nextAction = action (state,terminal)
+                  val _ = if DEBUG1 then prAction(stack,lexPair,nextAction)
+                          else ()
+              in case nextAction
+                 of SHIFT s =>
+                  let val newStack = (s,value) :: stack
+                      val newLexPair = Stream.get lexer
+                      val (_,newQueue) =Fifo.get(Fifo.put((newStack,newLexPair),
+                                                            queue))
+                  in parseStep(newLexPair,(s,value)::stack,newQueue)
+                  end
+                 | REDUCE i =>
+                     (case saction(i,leftPos,stack,arg)
+                      of (nonterm,value,stack as (state,_) :: _) =>
+                          parseStep(lexPair,(goto(state,nonterm),value)::stack,
+                                    queue)
+                       | _ => raise (ParseImpossible 197))
+                 | ERROR => parseStep(fixError args)
+                 | ACCEPT => 
+                        (case stack
+                         of (_,(topvalue,_,_)) :: _ =>
+                                let val (token,restLexer) = lexPair
+                                in (topvalue,Stream.cons(token,restLexer))
+                                end
+                          | _ => raise (ParseImpossible 202))
+              end
+            | parseStep _ = raise (ParseImpossible 204)
+        in parseStep
+        end
 
     (*  distanceParse: parse until n tokens are shifted, or accept or
-	error are encountered.  Takes a table, showTerminal function, and
-	semantic action function.  Returns a parser which takes a lexPair
-	(lex result * lexer), a state stack, a queue, and a distance
-	(must be > 0) to parse.  The parser returns a new lex-value, a stack
-	with the nth token shifted on top, a queue, a distance, and action
-	option. *)
+        error are encountered.  Takes a table, showTerminal function, and
+        semantic action function.  Returns a parser which takes a lexPair
+        (lex result * lexer), a state stack, a queue, and a distance
+        (must be > 0) to parse.  The parser returns a new lex-value, a stack
+        with the nth token shifted on top, a queue, a distance, and action
+        option. *)
 
     val distanceParse =
       fn (table,showTerminal,saction,arg) =>
-	let val prAction = prAction showTerminal
-	    val action = LrTable.action table
-	    val goto = LrTable.goto table
-	    fun parseStep(lexPair,stack,queue,0) = (lexPair,stack,queue,0,NONE)
-	      | parseStep(lexPair as (TOKEN (terminal, value as (_,leftPos,_)),
-				      lexer
-				     ),
-			  stack as (state,_) :: _,
-			  queue,distance) =
-	      let val nextAction = action(state,terminal)
-	          val _ = if DEBUG1 then prAction(stack,lexPair,nextAction)
-			  else ()
-	      in case nextAction
-		 of SHIFT s =>
-		  let val newStack = (s,value) :: stack
-		      val newLexPair = Stream.get lexer
-		  in parseStep(newLexPair,(s,value)::stack,
-			       Fifo.put((newStack,newLexPair),queue),distance-1)
-		  end
-		 | REDUCE i =>
-		    (case saction(i,leftPos,stack,arg)
-		      of (nonterm,value,stack as (state,_) :: _) =>
-		         parseStep(lexPair,(goto(state,nonterm),value)::stack,
-				 queue,distance)
-		      | _ => raise (ParseImpossible 240))
-		 | ERROR => (lexPair,stack,queue,distance,SOME nextAction)
-		 | ACCEPT => (lexPair,stack,queue,distance,SOME nextAction)
-	      end
-	   | parseStep _ = raise (ParseImpossible 242)
-	in parseStep : ('a,'b) distanceParse 
-	end
+        let val prAction = prAction showTerminal
+            val action = LrTable.action table
+            val goto = LrTable.goto table
+            fun parseStep(lexPair,stack,queue,0) = (lexPair,stack,queue,0,NONE)
+              | parseStep(lexPair as (TOKEN (terminal, value as (_,leftPos,_)),
+                                      lexer
+                                     ),
+                          stack as (state,_) :: _,
+                          queue,distance) =
+              let val nextAction = action(state,terminal)
+                  val _ = if DEBUG1 then prAction(stack,lexPair,nextAction)
+                          else ()
+              in case nextAction
+                 of SHIFT s =>
+                  let val newStack = (s,value) :: stack
+                      val newLexPair = Stream.get lexer
+                  in parseStep(newLexPair,(s,value)::stack,
+                               Fifo.put((newStack,newLexPair),queue),distance-1)
+                  end
+                 | REDUCE i =>
+                    (case saction(i,leftPos,stack,arg)
+                      of (nonterm,value,stack as (state,_) :: _) =>
+                         parseStep(lexPair,(goto(state,nonterm),value)::stack,
+                                 queue,distance)
+                      | _ => raise (ParseImpossible 240))
+                 | ERROR => (lexPair,stack,queue,distance,SOME nextAction)
+                 | ACCEPT => (lexPair,stack,queue,distance,SOME nextAction)
+              end
+           | parseStep _ = raise (ParseImpossible 242)
+        in parseStep : ('a,'b) distanceParse 
+        end
 
 (* mkFixError: function to create fixError function which adjusts parser state
    so that parse may continue in the presence of an error *)
 
 fun mkFixError({is_keyword,terms,errtermvalue,
-	      preferred_change,noShift,
-	      showTerminal,error,...} : ('a,'b) ecRecord,
-	     distanceParse : ('a,'b) distanceParse,
-	     minAdvance,maxAdvance) 
+              preferred_change,noShift,
+              showTerminal,error,...} : ('a,'b) ecRecord,
+             distanceParse : ('a,'b) distanceParse,
+             minAdvance,maxAdvance) 
 
             (lexv as (TOKEN (term,value as (_,leftPos,_)),_),stack,queue) =
     let val _ = if DEBUG2 then
-			error("syntax error found at " ^ (showTerminal term),
-			      leftPos,leftPos)
-		else ()
+                        error("syntax error found at " ^ (showTerminal term),
+                              leftPos,leftPos)
+                else ()
 
         fun tokAt(t,p) = TOKEN(t,(errtermvalue t,p,p))
 
-	val minDelta = 3
+        val minDelta = 3
 
-	(* pull all the state * lexv elements from the queue *)
+        (* pull all the state * lexv elements from the queue *)
 
-	val stateList = 
-	   let fun f q = let val (elem,newQueue) = Fifo.get q
-			 in elem :: (f newQueue)
-			 end handle Fifo.Empty => nil
-	   in f queue
-	   end
+        val stateList = 
+           let fun f q = let val (elem,newQueue) = Fifo.get q
+                         in elem :: (f newQueue)
+                         end handle Fifo.Empty => nil
+           in f queue
+           end
 
-	(* now number elements of stateList, giving distance from
-	   error token *)
+        (* now number elements of stateList, giving distance from
+           error token *)
 
-	val (_, numStateList) =
-	      List.foldr (fn (a,(num,r)) => (num+1,(a,num)::r)) (0, []) stateList
+        val (_, numStateList) =
+              List.foldr (fn (a,(num,r)) => (num+1,(a,num)::r)) (0, []) stateList
 
-	(* Represent the set of potential changes as a linked list.
+        (* Represent the set of potential changes as a linked list.
 
-	   Values of datatype Change hold information about a potential change.
+           Values of datatype Change hold information about a potential change.
 
-	   oper = oper to be applied
-	   pos = the # of the element in stateList that would be altered.
-	   distance = the number of tokens beyond the error token which the
-	     change allows us to parse.
-	   new = new terminal * value pair at that point
-	   orig = original terminal * value pair at the point being changed.
-	 *)
+           oper = oper to be applied
+           pos = the # of the element in stateList that would be altered.
+           distance = the number of tokens beyond the error token which the
+             change allows us to parse.
+           new = new terminal * value pair at that point
+           orig = original terminal * value pair at the point being changed.
+         *)
 
-	datatype ('a,'b) change = CHANGE of
-	   {pos : int, distance : int, leftPos: 'b, rightPos: 'b,
-	    new : ('a,'b) lexv list, orig : ('a,'b) lexv list}
+        datatype ('a,'b) change = CHANGE of
+           {pos : int, distance : int, leftPos: 'b, rightPos: 'b,
+            new : ('a,'b) lexv list, orig : ('a,'b) lexv list}
 
 
          val showTerms = concat o map (fn TOKEN(t,_) => " " ^ showTerminal t)
 
-	 val printChange = fn c =>
-	  let val CHANGE {distance,new,orig,pos,...} = c
-	  in (print ("{distance= " ^ (Int.toString distance));
-	      print (",orig ="); print(showTerms orig);
-	      print (",new ="); print(showTerms new);
-	      print (",pos= " ^ (Int.toString pos));
-	      print "}\n")
-	  end
+         val printChange = fn c =>
+          let val CHANGE {distance,new,orig,pos,...} = c
+          in (print ("{distance= " ^ (Int.toString distance));
+              print (",orig ="); print(showTerms orig);
+              print (",new ="); print(showTerms new);
+              print (",pos= " ^ (Int.toString pos));
+              print "}\n")
+          end
 
-	val printChangeList = app printChange
+        val printChangeList = app printChange
 
 (* parse: given a lexPair, a stack, and the distance from the error
    token, return the distance past the error token that we are able to parse.*)
 
-	fun parse (lexPair,stack,queuePos : int) =
-	    case distanceParse(lexPair,stack,Fifo.empty,queuePos+maxAdvance+1)
+        fun parse (lexPair,stack,queuePos : int) =
+            case distanceParse(lexPair,stack,Fifo.empty,queuePos+maxAdvance+1)
              of (_,_,_,distance,SOME ACCEPT) => 
-		        if maxAdvance-distance-1 >= 0 
-			    then maxAdvance 
-			    else maxAdvance-distance-1
-	      | (_,_,_,distance,_) => maxAdvance - distance - 1
+                        if maxAdvance-distance-1 >= 0 
+                            then maxAdvance 
+                            else maxAdvance-distance-1
+              | (_,_,_,distance,_) => maxAdvance - distance - 1
 
 (* catList: concatenate results of scanning list *)
 
-	fun catList l f = List.foldr (fn(a,r)=> f a @ r) [] l
+        fun catList l f = List.foldr (fn(a,r)=> f a @ r) [] l
 
         fun keywordsDelta new = if List.exists (fn(TOKEN(t,_))=>is_keyword t) new
-	               then minDelta else 0
+                       then minDelta else 0
 
         fun tryChange{lex,stack,pos,leftPos,rightPos,orig,new} =
-	     let val lex' = List.foldr (fn (t',p)=>(t',Stream.cons p)) lex new
-		 val distance = parse(lex',stack,pos+length new-length orig)
-	      in if distance >= minAdvance + keywordsDelta new 
-		   then [CHANGE{pos=pos,leftPos=leftPos,rightPos=rightPos,
-				distance=distance,orig=orig,new=new}] 
-		   else []
-	     end
+             let val lex' = List.foldr (fn (t',p)=>(t',Stream.cons p)) lex new
+                 val distance = parse(lex',stack,pos+length new-length orig)
+              in if distance >= minAdvance + keywordsDelta new 
+                   then [CHANGE{pos=pos,leftPos=leftPos,rightPos=rightPos,
+                                distance=distance,orig=orig,new=new}] 
+                   else []
+             end
 
 
 (* tryDelete: Try to delete n terminals.
               Return single-element [success] or nil.
-	      Do not delete unshiftable terminals. *)
+              Do not delete unshiftable terminals. *)
 
 
     fun tryDelete n ((stack,lexPair as (TOKEN(term,(_,l,r)),_)),qPos) =
-	let fun del(0,accum,left,right,lexPair) =
-	          tryChange{lex=lexPair,stack=stack,
-			    pos=qPos,leftPos=left,rightPos=right,
-			    orig=rev accum, new=[]}
-	      | del(n,accum,left,right,(tok as TOKEN(term,(_,_,r)),lexer)) =
-		   if noShift term then []
-		   else del(n-1,tok::accum,left,r,Stream.get lexer)
+        let fun del(0,accum,left,right,lexPair) =
+                  tryChange{lex=lexPair,stack=stack,
+                            pos=qPos,leftPos=left,rightPos=right,
+                            orig=rev accum, new=[]}
+              | del(n,accum,left,right,(tok as TOKEN(term,(_,_,r)),lexer)) =
+                   if noShift term then []
+                   else del(n-1,tok::accum,left,r,Stream.get lexer)
          in del(n,[],l,r,lexPair)
         end
 
@@ -2327,171 +2327,171 @@
        return a list of the successes  *)
 
         fun tryInsert((stack,lexPair as (TOKEN(_,(_,l,_)),_)),queuePos) =
-	       catList terms (fn t =>
-		 tryChange{lex=lexPair,stack=stack,
-			   pos=queuePos,orig=[],new=[tokAt(t,l)],
-			   leftPos=l,rightPos=l})
-			      
+               catList terms (fn t =>
+                 tryChange{lex=lexPair,stack=stack,
+                           pos=queuePos,orig=[],new=[tokAt(t,l)],
+                           leftPos=l,rightPos=l})
+                              
 (* trySubst: try to substitute tokens for the current terminal;
        return a list of the successes  *)
 
         fun trySubst ((stack,lexPair as (orig as TOKEN (term,(_,l,r)),lexer)),
-		      queuePos) =
-	      if noShift term then []
-	      else
-		  catList terms (fn t =>
-		      tryChange{lex=Stream.get lexer,stack=stack,
-				pos=queuePos,
-				leftPos=l,rightPos=r,orig=[orig],
-				new=[tokAt(t,r)]})
+                      queuePos) =
+              if noShift term then []
+              else
+                  catList terms (fn t =>
+                      tryChange{lex=Stream.get lexer,stack=stack,
+                                pos=queuePos,
+                                leftPos=l,rightPos=r,orig=[orig],
+                                new=[tokAt(t,r)]})
 
      (* do_delete(toks,lexPair) tries to delete tokens "toks" from "lexPair".
          If it succeeds, returns SOME(toks',l,r,lp), where
-	     toks' is the actual tokens (with positions and values) deleted,
-	     (l,r) are the (leftmost,rightmost) position of toks', 
-	     lp is what remains of the stream after deletion 
+             toks' is the actual tokens (with positions and values) deleted,
+             (l,r) are the (leftmost,rightmost) position of toks', 
+             lp is what remains of the stream after deletion 
      *)
         fun do_delete(nil,lp as (TOKEN(_,(_,l,_)),_)) = SOME(nil,l,l,lp)
           | do_delete([t],(tok as TOKEN(t',(_,l,r)),lp')) =
-	       if t=t'
-		   then SOME([tok],l,r,Stream.get lp')
+               if t=t'
+                   then SOME([tok],l,r,Stream.get lp')
                    else NONE
           | do_delete(t::rest,(tok as TOKEN(t',(_,l,r)),lp')) =
-	       if t=t'
-		   then case do_delete(rest,Stream.get lp')
+               if t=t'
+                   then case do_delete(rest,Stream.get lp')
                          of SOME(deleted,l',r',lp'') =>
-			       SOME(tok::deleted,l,r',lp'')
-			  | NONE => NONE
-		   else NONE
-			     
+                               SOME(tok::deleted,l,r',lp'')
+                          | NONE => NONE
+                   else NONE
+                             
         fun tryPreferred((stack,lexPair),queuePos) =
-	    catList preferred_change (fn (delete,insert) =>
-	       if List.exists noShift delete then [] (* should give warning at
-						 parser-generation time *)
+            catList preferred_change (fn (delete,insert) =>
+               if List.exists noShift delete then [] (* should give warning at
+                                                 parser-generation time *)
                else case do_delete(delete,lexPair)
                      of SOME(deleted,l,r,lp) => 
-			    tryChange{lex=lp,stack=stack,pos=queuePos,
-				      leftPos=l,rightPos=r,orig=deleted,
-				      new=map (fn t=>(tokAt(t,r))) insert}
-		      | NONE => [])
+                            tryChange{lex=lp,stack=stack,pos=queuePos,
+                                      leftPos=l,rightPos=r,orig=deleted,
+                                      new=map (fn t=>(tokAt(t,r))) insert}
+                      | NONE => [])
 
-	val changes = catList numStateList tryPreferred @
-	                catList numStateList tryInsert @
-			  catList numStateList trySubst @
-			    catList numStateList (tryDelete 1) @
-			      catList numStateList (tryDelete 2) @
-			        catList numStateList (tryDelete 3)
+        val changes = catList numStateList tryPreferred @
+                        catList numStateList tryInsert @
+                          catList numStateList trySubst @
+                            catList numStateList (tryDelete 1) @
+                              catList numStateList (tryDelete 2) @
+                                catList numStateList (tryDelete 3)
 
-	val findMaxDist = fn l => 
-	  foldr (fn (CHANGE {distance,...},high) => Int.max(distance,high)) 0 l
+        val findMaxDist = fn l => 
+          foldr (fn (CHANGE {distance,...},high) => Int.max(distance,high)) 0 l
 
 (* maxDist: max distance past error taken that we could parse *)
 
-	val maxDist = findMaxDist changes
+        val maxDist = findMaxDist changes
 
 (* remove changes which did not parse maxDist tokens past the error token *)
 
         val changes = catList changes 
-	      (fn(c as CHANGE{distance,...}) => 
-		  if distance=maxDist then [c] else [])
+              (fn(c as CHANGE{distance,...}) => 
+                  if distance=maxDist then [c] else [])
 
       in case changes 
-	  of (l as change :: _) =>
-	      let fun print_msg (CHANGE {new,orig,leftPos,rightPos,...}) =
-		  let val s = 
-		      case (orig,new)
-			  of (_::_,[]) => "deleting " ^ (showTerms orig)
-	                   | ([],_::_) => "inserting " ^ (showTerms new)
-			   | _ => "replacing " ^ (showTerms orig) ^
-				 " with " ^ (showTerms new)
-		  in error ("syntax error: " ^ s,leftPos,rightPos)
-		  end
-		   
-		  val _ = 
-		      (if length l > 1 andalso DEBUG2 then
-			   (print "multiple fixes possible; could fix it by:\n";
-			    app print_msg l;
-			    print "chosen correction:\n")
-		       else ();
-		       print_msg change)
+          of (l as change :: _) =>
+              let fun print_msg (CHANGE {new,orig,leftPos,rightPos,...}) =
+                  let val s = 
+                      case (orig,new)
+                          of (_::_,[]) => "deleting " ^ (showTerms orig)
+                           | ([],_::_) => "inserting " ^ (showTerms new)
+                           | _ => "replacing " ^ (showTerms orig) ^
+                                 " with " ^ (showTerms new)
+                  in error ("syntax error: " ^ s,leftPos,rightPos)
+                  end
+                   
+                  val _ = 
+                      (if length l > 1 andalso DEBUG2 then
+                           (print "multiple fixes possible; could fix it by:\n";
+                            app print_msg l;
+                            print "chosen correction:\n")
+                       else ();
+                       print_msg change)
 
-		  (* findNth: find nth queue entry from the error
-		   entry.  Returns the Nth queue entry and the  portion of
-		   the queue from the beginning to the nth-1 entry.  The
-		   error entry is at the end of the queue.
+                  (* findNth: find nth queue entry from the error
+                   entry.  Returns the Nth queue entry and the  portion of
+                   the queue from the beginning to the nth-1 entry.  The
+                   error entry is at the end of the queue.
 
-		   Examples:
+                   Examples:
 
-		   queue = a b c d e
-		   findNth 0 = (e,a b c d)
-		   findNth 1 =  (d,a b c)
-		   *)
+                   queue = a b c d e
+                   findNth 0 = (e,a b c d)
+                   findNth 1 =  (d,a b c)
+                   *)
 
-		  val findNth = fn n =>
-		      let fun f (h::t,0) = (h,rev t)
-			    | f (h::t,n) = f(t,n-1)
-			    | f (nil,_) = let exception FindNth
-					  in raise FindNth
-					  end
-		      in f (rev stateList,n)
-		      end
-		
-		  val CHANGE {pos,orig,new,...} = change
-		  val (last,queueFront) = findNth pos
-		  val (stack,lexPair) = last
+                  val findNth = fn n =>
+                      let fun f (h::t,0) = (h,rev t)
+                            | f (h::t,n) = f(t,n-1)
+                            | f (nil,_) = let exception FindNth
+                                          in raise FindNth
+                                          end
+                      in f (rev stateList,n)
+                      end
+                
+                  val CHANGE {pos,orig,new,...} = change
+                  val (last,queueFront) = findNth pos
+                  val (stack,lexPair) = last
 
-		  val lp1 = foldl(fn (_,(_,r)) => Stream.get r) lexPair orig
-		  val lp2 = foldr(fn(t,r)=>(t,Stream.cons r)) lp1 new
+                  val lp1 = foldl(fn (_,(_,r)) => Stream.get r) lexPair orig
+                  val lp2 = foldr(fn(t,r)=>(t,Stream.cons r)) lp1 new
 
-		  val restQueue = 
-		      Fifo.put((stack,lp2),
-			       foldl Fifo.put Fifo.empty queueFront)
+                  val restQueue = 
+                      Fifo.put((stack,lp2),
+                               foldl Fifo.put Fifo.empty queueFront)
 
-		  val (lexPair,stack,queue,_,_) =
-		      distanceParse(lp2,stack,restQueue,pos)
+                  val (lexPair,stack,queue,_,_) =
+                      distanceParse(lp2,stack,restQueue,pos)
 
-	      in (lexPair,stack,queue)
-	      end
-	| nil => (error("syntax error found at " ^ (showTerminal term),
-			leftPos,leftPos); raise ParseError)
+              in (lexPair,stack,queue)
+              end
+        | nil => (error("syntax error found at " ^ (showTerminal term),
+                        leftPos,leftPos); raise ParseError)
     end
 
    val parse = fn {arg,table,lexer,saction,void,lookahead,
-		   ec=ec as {showTerminal,...} : ('a,'b) ecRecord} =>
-	let val distance = 15   (* defer distance tokens *)
-	    val minAdvance = 1  (* must parse at least 1 token past error *)
-	    val maxAdvance = Int.max(lookahead,0)(* max distance for parse check *)
-	    val lexPair = Stream.get lexer
-	    val (TOKEN (_,(_,leftPos,_)),_) = lexPair
-	    val startStack = [(initialState table,(void,leftPos,leftPos))]
-	    val startQueue = Fifo.put((startStack,lexPair),Fifo.empty)
-	    val distanceParse = distanceParse(table,showTerminal,saction,arg)
-	    val fixError = mkFixError(ec,distanceParse,minAdvance,maxAdvance)
-	    val ssParse = ssParse(table,showTerminal,saction,fixError,arg)
-	    fun loop (lexPair,stack,queue,_,SOME ACCEPT) =
-		   ssParse(lexPair,stack,queue)
-	      | loop (lexPair,stack,queue,0,_) = ssParse(lexPair,stack,queue)
-	      | loop (lexPair,stack,queue,distance,SOME ERROR) =
-		 let val (lexPair,stack,queue) = fixError(lexPair,stack,queue)
-		 in loop (distanceParse(lexPair,stack,queue,distance))
-		 end
-	      | loop _ = let exception ParseInternal
-			 in raise ParseInternal
-			 end
-	in loop (distanceParse(lexPair,startStack,startQueue,distance))
-	end
+                   ec=ec as {showTerminal,...} : ('a,'b) ecRecord} =>
+        let val distance = 15   (* defer distance tokens *)
+            val minAdvance = 1  (* must parse at least 1 token past error *)
+            val maxAdvance = Int.max(lookahead,0)(* max distance for parse check *)
+            val lexPair = Stream.get lexer
+            val (TOKEN (_,(_,leftPos,_)),_) = lexPair
+            val startStack = [(initialState table,(void,leftPos,leftPos))]
+            val startQueue = Fifo.put((startStack,lexPair),Fifo.empty)
+            val distanceParse = distanceParse(table,showTerminal,saction,arg)
+            val fixError = mkFixError(ec,distanceParse,minAdvance,maxAdvance)
+            val ssParse = ssParse(table,showTerminal,saction,fixError,arg)
+            fun loop (lexPair,stack,queue,_,SOME ACCEPT) =
+                   ssParse(lexPair,stack,queue)
+              | loop (lexPair,stack,queue,0,_) = ssParse(lexPair,stack,queue)
+              | loop (lexPair,stack,queue,distance,SOME ERROR) =
+                 let val (lexPair,stack,queue) = fixError(lexPair,stack,queue)
+                 in loop (distanceParse(lexPair,stack,queue,distance))
+                 end
+              | loop _ = let exception ParseInternal
+                         in raise ParseInternal
+                         end
+        in loop (distanceParse(lexPair,startStack,startQueue,distance))
+        end
  end;
 
 (* drt (12/15/89) -- needed only when the code above is functorized
 
 structure LrParser = ParserGen(structure LrTable=LrTable
-			     structure Stream=Stream);
+                             structure Stream=Stream);
 *)
 functor LexMLYACC(structure Tokens : Mlyacc_TOKENS
-		  structure Hdr : HEADER
+                  structure Hdr : HEADER
                                   where type prec = Header.prec
                                   and type inputSource = Header.inputSource
-				      and type pos = int)
+                                      and type pos = int)
                   : ARG_LEXER =
    struct
     structure UserDeclarations =
@@ -2520,27 +2520,27 @@
 val actionstart = ref 0
 
 val eof = fn i => (if (!pcount)>0 then
-			error i (!actionstart)
-			      " eof encountered in action beginning here !"
-		   else (); EOF(!lineno,!lineno))
+                        error i (!actionstart)
+                              " eof encountered in action beginning here !"
+                   else (); EOF(!lineno,!lineno))
 
 val Add = fn s => (text := s::(!text))
 
 local val dict = [("%prec",PREC_TAG),("%term",TERM),
-		  ("%nonterm",NONTERM), ("%eop",PERCENT_EOP),("%start",START),
-		  ("%prefer",PREFER),("%subst",SUBST),("%change",CHANGE),
-		  ("%keyword",KEYWORD),("%name",NAME),
-		  ("%verbose",VERBOSE), ("%nodefault",NODEFAULT),
-		  ("%value",VALUE), ("%noshift",NOSHIFT),
-		  ("%header",PERCENT_HEADER),("%pure",PERCENT_PURE),
-		  ("%arg",PERCENT_ARG),
-		  ("%pos",PERCENT_POS)]
+                  ("%nonterm",NONTERM), ("%eop",PERCENT_EOP),("%start",START),
+                  ("%prefer",PREFER),("%subst",SUBST),("%change",CHANGE),
+                  ("%keyword",KEYWORD),("%name",NAME),
+                  ("%verbose",VERBOSE), ("%nodefault",NODEFAULT),
+                  ("%value",VALUE), ("%noshift",NOSHIFT),
+                  ("%header",PERCENT_HEADER),("%pure",PERCENT_PURE),
+                  ("%arg",PERCENT_ARG),
+                  ("%pos",PERCENT_POS)]
 in val lookup =
     fn (s,left,right) =>
-	 let fun f ((a,d)::b) = if a=s then d(left,right) else f b
-	       | f nil = UNKNOWN(s,left,right)
-	 in f dict
-	 end
+         let fun f ((a,d)::b) = if a=s then d(left,right) else f b
+               | f nil = UNKNOWN(s,left,right)
+         in f dict
+         end
 end
 
 fun inc (ri as ref i) = (ri := i+1)
@@ -2549,7 +2549,7 @@
 end (* end of user routines *)
 exception LexError (* raised if illegal leaf action tried *)
 structure Internal =
-	struct
+        struct
 
 datatype yyfinstate = N of int
 type statedata = {fin : yyfinstate list, trans: string}
@@ -3123,8 +3123,8 @@
 {fin = [(N 122)], trans = s0}]
 end
 structure StartStates =
-	struct
-	datatype yystartstate = STARTSTATE of int
+        struct
+        datatype yystartstate = STARTSTATE of int
 
 (* start state definitions *)
 
@@ -3138,71 +3138,71 @@
 
 end
 type result = UserDeclarations.lexresult
-	exception LexerError (* raised if illegal leaf action tried *)
+        exception LexerError (* raised if illegal leaf action tried *)
 end
 
 fun makeLexer yyinput = 
 let 
-	val yyb = ref "\n" 		(* buffer *)
-	val yybl = ref 1		(*buffer length *)
-	val yybufpos = ref 1		(* location of next character to use *)
-	val yygone = ref 1		(* position in file of beginning of buffer *)
-	val yydone = ref false		(* eof found yet? *)
-	val yybegin = ref 1		(*Current 'start state' for lexer *)
+        val yyb = ref "\n"              (* buffer *)
+        val yybl = ref 1                (*buffer length *)
+        val yybufpos = ref 1            (* location of next character to use *)
+        val yygone = ref 1              (* position in file of beginning of buffer *)
+        val yydone = ref false          (* eof found yet? *)
+        val yybegin = ref 1             (*Current 'start state' for lexer *)
 
-	val YYBEGIN = fn (Internal.StartStates.STARTSTATE x) =>
-		 yybegin := x
+        val YYBEGIN = fn (Internal.StartStates.STARTSTATE x) =>
+                 yybegin := x
 
 fun lex (yyarg as (inputSource)) =
 let fun continue() : Internal.result = 
   let fun scan (s,AcceptingLeaves : Internal.yyfinstate list list,l,i0) =
-	let fun action (i,nil) = raise LexError
-	| action (i,nil::l) = action (i-1,l)
-	| action (i,(node::acts)::l) =
-		case node of
-		    Internal.N yyk => 
-			(let val yytext = substring(!yyb,i0,i-i0)
-			     val yypos = i0+ !yygone
-			open UserDeclarations Internal.StartStates
+        let fun action (i,nil) = raise LexError
+        | action (i,nil::l) = action (i-1,l)
+        | action (i,(node::acts)::l) =
+                case node of
+                    Internal.N yyk => 
+                        (let val yytext = substring(!yyb,i0,i-i0)
+                             val yypos = i0+ !yygone
+                        open UserDeclarations Internal.StartStates
  in (yybufpos := i; case yyk of 
 
-			(* Application actions *)
+                        (* Application actions *)
 
   100 => (Add yytext; YYBEGIN STRING; continue())
 | 103 => (Add yytext; continue())
 | 105 => (Add yytext; continue())
 | 108 => (Add yytext; dec commentLevel;
-		    if !commentLevel=0
-			 then BOGUS_VALUE(!lineno,!lineno)
-			 else continue()
-		   )
+                    if !commentLevel=0
+                         then BOGUS_VALUE(!lineno,!lineno)
+                         else continue()
+                   )
 | 11 => (Add yytext; continue())
 | 111 => (Add yytext; inc commentLevel; continue())
 | 114 => (Add yytext; continue())
 | 116 => (continue())
 | 119 => (dec commentLevel;
-		          if !commentLevel=0 then YYBEGIN A else ();
-			  continue ())
+                          if !commentLevel=0 then YYBEGIN A else ();
+                          continue ())
 | 122 => (inc commentLevel; continue())
 | 125 => (continue())
 | 127 => (Add yytext; YYBEGIN CODE; continue())
 | 129 => (Add yytext; continue())
 | 131 => (Add yytext; error inputSource (!lineno) "unclosed string";
- 	            inc lineno; YYBEGIN CODE; continue())
+                    inc lineno; YYBEGIN CODE; continue())
 | 134 => (Add yytext; continue())
 | 137 => (Add yytext; continue())
 | 14 => (YYBEGIN A; HEADER (concat (rev (!text)),!lineno,!lineno))
 | 140 => (Add yytext;
-			if substring(yytext,1,1)="\n" then inc lineno else ();
-		     	YYBEGIN F; continue())
+                        if substring(yytext,1,1)="\n" then inc lineno else ();
+                        YYBEGIN F; continue())
 | 143 => (Add yytext; continue())
 | 145 => (Add yytext; YYBEGIN STRING; continue())
 | 147 => (Add yytext; error inputSource (!lineno) "unclosed string";
-		    YYBEGIN CODE; continue())
+                    YYBEGIN CODE; continue())
 | 16 => (Add yytext; inc lineno; continue())
 | 18 => (Add yytext; continue())
 | 2 => (Add yytext; YYBEGIN COMMENT; commentLevel := 1;
-		    continue() before YYBEGIN INITIAL)
+                    continue() before YYBEGIN INITIAL)
 | 20 => (inc lineno; continue ())
 | 25 => (continue())
 | 28 => (OF(!lineno,!lineno))
@@ -3220,51 +3220,51 @@
 | 73 => (TYVAR(yytext,!lineno,!lineno))
 | 77 => (IDDOT(yytext,!lineno,!lineno))
 | 8 => (Add yytext; YYBEGIN COMMENT; commentLevel := 1;
-		    continue() before YYBEGIN CODE)
+                    continue() before YYBEGIN CODE)
 | 80 => (INT (yytext,!lineno,!lineno))
 | 83 => (DELIMITER(!lineno,!lineno))
 | 85 => (COLON(!lineno,!lineno))
 | 87 => (BAR(!lineno,!lineno))
 | 90 => (ID ((yytext,!lineno),!lineno,!lineno))
 | 92 => (pcount := 1; actionstart := (!lineno);
-		    text := nil; YYBEGIN CODE; continue() before YYBEGIN A)
+                    text := nil; YYBEGIN CODE; continue() before YYBEGIN A)
 | 94 => (UNKNOWN(yytext,!lineno,!lineno))
 | 96 => (inc pcount; Add yytext; continue())
 | 98 => (dec pcount;
-		    if !pcount = 0 then
-			 PROG (concat (rev (!text)),!lineno,!lineno)
-		    else (Add yytext; continue()))
+                    if !pcount = 0 then
+                         PROG (concat (rev (!text)),!lineno,!lineno)
+                    else (Add yytext; continue()))
 | _ => raise Internal.LexerError
 
-		) end )
+                ) end )
 
-	val {fin,trans} = Vector.sub(Internal.tab, s)
-	val NewAcceptingLeaves = fin::AcceptingLeaves
-	in if l = !yybl then
-	     if trans = #trans(Vector.sub(Internal.tab,0))
-	       then action(l,NewAcceptingLeaves
-) else	    let val newchars= if !yydone then "" else yyinput 1024
-	    in if (size newchars)=0
-		  then (yydone := true;
-		        if (l=i0) then UserDeclarations.eof yyarg
-		                  else action(l,NewAcceptingLeaves))
-		  else (if i0=l then yyb := newchars
-		     else yyb := substring(!yyb,i0,l-i0)^newchars;
-		     yygone := !yygone+i0;
-		     yybl := size (!yyb);
-		     scan (s,AcceptingLeaves,l-i0,0))
-	    end
-	  else let val NewChar = Char.ord(String.sub(!yyb,l))
-		val NewState = if NewChar<128 then Char.ord(String.sub(trans,NewChar)) else Char.ord(String.sub(trans,128))
-		in if NewState=0 then action(l,NewAcceptingLeaves)
-		else scan(NewState,NewAcceptingLeaves,l+1,i0)
-	end
-	end
+        val {fin,trans} = Vector.sub(Internal.tab, s)
+        val NewAcceptingLeaves = fin::AcceptingLeaves
+        in if l = !yybl then
+             if trans = #trans(Vector.sub(Internal.tab,0))
+               then action(l,NewAcceptingLeaves
+) else      let val newchars= if !yydone then "" else yyinput 1024
+            in if (size newchars)=0
+                  then (yydone := true;
+                        if (l=i0) then UserDeclarations.eof yyarg
+                                  else action(l,NewAcceptingLeaves))
+                  else (if i0=l then yyb := newchars
+                     else yyb := substring(!yyb,i0,l-i0)^newchars;
+                     yygone := !yygone+i0;
+                     yybl := size (!yyb);
+                     scan (s,AcceptingLeaves,l-i0,0))
+            end
+          else let val NewChar = Char.ord(String.sub(!yyb,l))
+                val NewState = if NewChar<128 then Char.ord(String.sub(trans,NewChar)) else Char.ord(String.sub(trans,128))
+                in if NewState=0 then action(l,NewAcceptingLeaves)
+                else scan(NewState,NewAcceptingLeaves,l+1,i0)
+        end
+        end
 (*
-	val start= if substring(!yyb,!yybufpos-1,1)="\n"
+        val start= if substring(!yyb,!yybufpos-1,1)="\n"
 then !yybegin+1 else !yybegin
 *)
-	in scan(!yybegin (* start *),nil,!yybufpos,!yybufpos)
+        in scan(!yybegin (* start *),nil,!yybufpos,!yybufpos)
     end
 in continue end
   in lex
@@ -3286,14 +3286,14 @@
 *)
 
 functor Join(structure Lex : LEXER
-	     structure ParserData: PARSER_DATA
-	     structure LrParser : LR_PARSER
-	     sharing ParserData.LrTable = LrParser.LrTable
-	     sharing ParserData.Token = LrParser.Token
-	     sharing type Lex.UserDeclarations.svalue = ParserData.svalue
-	     sharing type Lex.UserDeclarations.pos = ParserData.pos
-	     sharing type Lex.UserDeclarations.token = ParserData.Token.token)
-		 : PARSER =
+             structure ParserData: PARSER_DATA
+             structure LrParser : LR_PARSER
+             sharing ParserData.LrTable = LrParser.LrTable
+             sharing ParserData.Token = LrParser.Token
+             sharing type Lex.UserDeclarations.svalue = ParserData.svalue
+             sharing type Lex.UserDeclarations.pos = ParserData.pos
+             sharing type Lex.UserDeclarations.token = ParserData.Token.token)
+                 : PARSER =
 struct
     structure Token = ParserData.Token
     structure Stream = LrParser.Stream
@@ -3306,20 +3306,20 @@
     type svalue = ParserData.svalue
     val makeLexer = LrParser.Stream.streamify o Lex.makeLexer
     val parse = fn (lookahead,lexer,error,arg) =>
-	(fn (a,b) => (ParserData.Actions.extract a,b))
+        (fn (a,b) => (ParserData.Actions.extract a,b))
      (LrParser.parse {table = ParserData.table,
-	        lexer=lexer,
-		lookahead=lookahead,
-		saction = ParserData.Actions.actions,
-		arg=arg,
-		void= ParserData.Actions.void,
-	        ec = {is_keyword = ParserData.EC.is_keyword,
-		      noShift = ParserData.EC.noShift,
-		      preferred_change = ParserData.EC.preferred_change,
-		      errtermvalue = ParserData.EC.errtermvalue,
-		      error=error,
-		      showTerminal = ParserData.EC.showTerminal,
-		      terms = ParserData.EC.terms}}
+                lexer=lexer,
+                lookahead=lookahead,
+                saction = ParserData.Actions.actions,
+                arg=arg,
+                void= ParserData.Actions.void,
+                ec = {is_keyword = ParserData.EC.is_keyword,
+                      noShift = ParserData.EC.noShift,
+                      preferred_change = ParserData.EC.preferred_change,
+                      errtermvalue = ParserData.EC.errtermvalue,
+                      error=error,
+                      showTerminal = ParserData.EC.showTerminal,
+                      terms = ParserData.EC.terms}}
       )
      val sameToken = Token.sameToken
 end
@@ -3330,14 +3330,14 @@
  *)
 
 functor JoinWithArg(structure Lex : ARG_LEXER
-	     structure ParserData: PARSER_DATA
-	     structure LrParser : LR_PARSER
-	     sharing ParserData.LrTable = LrParser.LrTable
-	     sharing ParserData.Token = LrParser.Token
-	     sharing type Lex.UserDeclarations.svalue = ParserData.svalue
-	     sharing type Lex.UserDeclarations.pos = ParserData.pos
-	     sharing type Lex.UserDeclarations.token = ParserData.Token.token)
-		 : ARG_PARSER  =
+             structure ParserData: PARSER_DATA
+             structure LrParser : LR_PARSER
+             sharing ParserData.LrTable = LrParser.LrTable
+             sharing ParserData.Token = LrParser.Token
+             sharing type Lex.UserDeclarations.svalue = ParserData.svalue
+             sharing type Lex.UserDeclarations.pos = ParserData.pos
+             sharing type Lex.UserDeclarations.token = ParserData.Token.token)
+                 : ARG_PARSER  =
 struct
     structure Token = ParserData.Token
     structure Stream = LrParser.Stream
@@ -3351,22 +3351,22 @@
     type svalue = ParserData.svalue
 
     val makeLexer = fn s => fn arg =>
-		 LrParser.Stream.streamify (Lex.makeLexer s arg)
+                 LrParser.Stream.streamify (Lex.makeLexer s arg)
     val parse = fn (lookahead,lexer,error,arg) =>
-	(fn (a,b) => (ParserData.Actions.extract a,b))
+        (fn (a,b) => (ParserData.Actions.extract a,b))
      (LrParser.parse {table = ParserData.table,
-	        lexer=lexer,
-		lookahead=lookahead,
-		saction = ParserData.Actions.actions,
-		arg=arg,
-		void= ParserData.Actions.void,
-	        ec = {is_keyword = ParserData.EC.is_keyword,
-		      noShift = ParserData.EC.noShift,
-		      preferred_change = ParserData.EC.preferred_change,
-		      errtermvalue = ParserData.EC.errtermvalue,
-		      error=error,
-		      showTerminal = ParserData.EC.showTerminal,
-		      terms = ParserData.EC.terms}}
+                lexer=lexer,
+                lookahead=lookahead,
+                saction = ParserData.Actions.actions,
+                arg=arg,
+                void= ParserData.Actions.void,
+                ec = {is_keyword = ParserData.EC.is_keyword,
+                      noShift = ParserData.EC.noShift,
+                      preferred_change = ParserData.EC.preferred_change,
+                      errtermvalue = ParserData.EC.errtermvalue,
+                      error=error,
+                      showTerminal = ParserData.EC.showTerminal,
+                      terms = ParserData.EC.terms}}
       )
     val sameToken = Token.sameToken
 end;
@@ -3384,31 +3384,31 @@
  *)
 
 functor ParseGenParserFun(S : sig
-				 structure Parser : ARG_PARSER
-				 structure Header : HEADER
-				 sharing type Parser.pos = Header.pos
-				 sharing type Parser.result = Header.parseResult
-				 sharing type Parser.arg = Header.inputSource =
-				    Parser.lexarg
-			      end where type Header.pos = int
-			 ) : PARSE_GEN_PARSER =
+                                 structure Parser : ARG_PARSER
+                                 structure Header : HEADER
+                                 sharing type Parser.pos = Header.pos
+                                 sharing type Parser.result = Header.parseResult
+                                 sharing type Parser.arg = Header.inputSource =
+                                    Parser.lexarg
+                              end where type Header.pos = int
+                         ) : PARSE_GEN_PARSER =
 
  struct
     open S
       structure Header = Header
       val parse = fn file =>
           let
-	      val in_str = TextIO.openIn file
-	      val source = Header.newSource(file,in_str,TextIO.stdOut)
-	      val error = fn (s : string,i:int,_) =>
-		              Header.error source i s
-	      val stream =  Parser.makeLexer (fn i => (TextIO.inputN(in_str,i)))
-		            source
-	      val (result,_) = (Header.lineno := 1; 
-				Header.text := nil;
-		                Parser.parse(15,stream,error,source))
-	   in (TextIO.closeIn in_str; (result,source))
-	   end
+              val in_str = TextIO.openIn file
+              val source = Header.newSource(file,in_str,TextIO.stdOut)
+              val error = fn (s : string,i:int,_) =>
+                              Header.error source i s
+              val stream =  Parser.makeLexer (fn i => (TextIO.inputN(in_str,i)))
+                            source
+              val (result,_) = (Header.lineno := 1; 
+                                Header.text := nil;
+                                Parser.parse(15,stream,error,source))
+           in (TextIO.closeIn in_str; (result,source))
+           end
   end;
 (* ML-Yacc Parser Generator (c) 1989 Andrew W. Appel, David R. Tarditi 
  *
@@ -3450,9 +3450,9 @@
 *)
 
 functor ListOrdSet(B : sig type elem
-		  	val gt : elem * elem -> bool
-			val eq : elem * elem -> bool
-		    end ) : ORDSET =
+                        val gt : elem * elem -> bool
+                        val eq : elem * elem -> bool
+                    end ) : ORDSET =
 
 struct
  type elem = B.elem
@@ -3464,56 +3464,56 @@
  val empty = nil
 
  val insert = fn (key,s) =>
-	let fun f (l as (h::t)) =
-		 if elem_gt(key,h) then h::(f t)
-		 else if elem_eq(key,h) then key::t
-		 else key::l
- 	      | f nil = [key]
-	in f s
-	end
-		
+        let fun f (l as (h::t)) =
+                 if elem_gt(key,h) then h::(f t)
+                 else if elem_eq(key,h) then key::t
+                 else key::l
+              | f nil = [key]
+        in f s
+        end
+                
  val select_arb = fn nil => raise Select_arb
- 		   | a::b => a
+                   | a::b => a
 
  val exists = fn (key,s) =>
-	let fun f (h::t) = if elem_gt(key,h) then f t
-			   else elem_eq(h,key) 
- 	      | f nil = false
-	in f s
-	end
+        let fun f (h::t) = if elem_gt(key,h) then f t
+                           else elem_eq(h,key) 
+              | f nil = false
+        in f s
+        end
 
  val find = fn (key,s) =>
-	let fun f (h::t) = if elem_gt(key,h) then f t
-			   else if elem_eq(h,key) then SOME h
-			   else NONE
- 	      | f nil = NONE
-	in f s
-	end
+        let fun f (h::t) = if elem_gt(key,h) then f t
+                           else if elem_eq(h,key) then SOME h
+                           else NONE
+              | f nil = NONE
+        in f s
+        end
    
  fun revfold f lst init = List.foldl f init lst
  fun fold f lst init = List.foldr f init lst
  val app = List.app
 
 fun set_eq(h::t,h'::t') = 
-	(case elem_eq(h,h')
-	  of true => set_eq(t,t')
-	   | a => a)
+        (case elem_eq(h,h')
+          of true => set_eq(t,t')
+           | a => a)
   | set_eq(nil,nil) = true
   | set_eq _ = false
 
 fun set_gt(h::t,h'::t') =
-	(case elem_gt(h,h')
-	  of false => (case (elem_eq(h,h'))
-			of true => set_gt(t,t')
-			 | a => a)
-	   |  a => a)
+        (case elem_gt(h,h')
+          of false => (case (elem_eq(h,h'))
+                        of true => set_gt(t,t')
+                         | a => a)
+           |  a => a)
   | set_gt(_::_,nil) = true
   | set_gt _ = false
-		
+                
 fun union(a as (h::t),b as (h'::t')) =
-	  if elem_gt(h',h) then h::union(t,b)
-	  else if elem_eq(h,h') then h::union(t,t')
-	  else h'::union(a,t')
+          if elem_gt(h',h) then h::union(t,b)
+          else if elem_eq(h,h') then h::union(t,t')
+          else h'::union(a,t')
   | union(nil,s) = s
   | union(s,nil) = s
 
@@ -3525,13 +3525,13 @@
 
 val partition = fn f => fn s =>
     fold (fn (e,(yes,no)) =>
-	    if (f e) then (e::yes,no) else (e::no,yes)) s (nil,nil)
+            if (f e) then (e::yes,no) else (e::no,yes)) s (nil,nil)
 
 val remove = fn (e,s) =>
     let fun f (l as (h::t)) = if elem_gt(h,e) then l
-			      else if elem_eq(h,e) then t
-			      else h::(f t)
-	  | f nil = nil
+                              else if elem_eq(h,e) then t
+                              else h::(f t)
+          | f nil = nil
     in f s
     end
 
@@ -3540,27 +3540,27 @@
  fun difference (nil,_) = nil
    | difference (r,nil) = r
    | difference (a as (h::t),b as (h'::t')) =
-	  if elem_gt (h',h) then h::difference(t,b)
-	  else if elem_eq(h',h) then difference(t,t')
-	  else difference(a,t')
+          if elem_gt (h',h) then h::difference(t,b)
+          else if elem_eq(h',h) then difference(t,t')
+          else difference(a,t')
 
  fun singleton X = [X]
 
  fun card(S) = fold (fn (a,count) => count+1) S 0
 
       local
-	    fun closure'(from, f, result) =
-	      if is_empty from then result
-	      else
-		let val (more,result) =
-			fold (fn (a,(more',result')) =>
-				let val more = f a
-				    val new = difference(more,result)
-				in (union(more',new),union(result',new))
-				end) from
-				 (empty,result)
-		in closure'(more,f,result)
-		end
+            fun closure'(from, f, result) =
+              if is_empty from then result
+              else
+                let val (more,result) =
+                        fold (fn (a,(more',result')) =>
+                                let val more = f a
+                                    val new = difference(more,result)
+                                in (union(more',new),union(result',new))
+                                end) from
+                                 (empty,result)
+                in closure'(more,f,result)
+                end
       in
          fun closure(start, f) = closure'(start, f, start)
       end
@@ -3593,10 +3593,10 @@
 *)
 
 functor RbOrdSet (B : sig type elem
-			 val eq : (elem*elem) -> bool
-		 	 val gt : (elem*elem) -> bool
-		     end
-		) : ORDSET =
+                         val eq : (elem*elem) -> bool
+                         val gt : (elem*elem) -> bool
+                     end
+                ) : ORDSET =
 struct
 
  type elem = B.elem
@@ -3612,43 +3612,43 @@
  fun insert(key,t) =
   let fun f EMPTY = TREE(key,RED,EMPTY,EMPTY)
         | f (TREE(k,BLACK,l,r)) =
-	    if elem_gt (key,k)
-	    then case f r
-		 of r as TREE(rk,RED, rl as TREE(rlk,RED,rll,rlr),rr) =>
-			(case l
-			 of TREE(lk,RED,ll,lr) =>
-				TREE(k,RED,TREE(lk,BLACK,ll,lr),
-					   TREE(rk,BLACK,rl,rr))
-			  | _ => TREE(rlk,BLACK,TREE(k,RED,l,rll),
-						TREE(rk,RED,rlr,rr)))
-		  | r as TREE(rk,RED,rl, rr as TREE(rrk,RED,rrl,rrr)) =>
-			(case l
-			 of TREE(lk,RED,ll,lr) =>
-				TREE(k,RED,TREE(lk,BLACK,ll,lr),
-					   TREE(rk,BLACK,rl,rr))
-			  | _ => TREE(rk,BLACK,TREE(k,RED,l,rl),rr))
-	          | r => TREE(k,BLACK,l,r)
-	    else if elem_gt(k,key)
-	    then case f l
-	         of l as TREE(lk,RED,ll, lr as TREE(lrk,RED,lrl,lrr)) =>
-			(case r
-			 of TREE(rk,RED,rl,rr) =>
-				TREE(k,RED,TREE(lk,BLACK,ll,lr),
-					   TREE(rk,BLACK,rl,rr))
-			  | _ => TREE(lrk,BLACK,TREE(lk,RED,ll,lrl),
-						TREE(k,RED,lrr,r)))
-		  | l as TREE(lk,RED, ll as TREE(llk,RED,lll,llr), lr) =>
-			(case r
-			 of TREE(rk,RED,rl,rr) =>
-				TREE(k,RED,TREE(lk,BLACK,ll,lr),
-					   TREE(rk,BLACK,rl,rr))
-			  | _ => TREE(lk,BLACK,ll,TREE(k,RED,lr,r)))
-	          | l => TREE(k,BLACK,l,r)
-	    else TREE(key,BLACK,l,r)
+            if elem_gt (key,k)
+            then case f r
+                 of r as TREE(rk,RED, rl as TREE(rlk,RED,rll,rlr),rr) =>
+                        (case l
+                         of TREE(lk,RED,ll,lr) =>
+                                TREE(k,RED,TREE(lk,BLACK,ll,lr),
+                                           TREE(rk,BLACK,rl,rr))
+                          | _ => TREE(rlk,BLACK,TREE(k,RED,l,rll),
+                                                TREE(rk,RED,rlr,rr)))
+                  | r as TREE(rk,RED,rl, rr as TREE(rrk,RED,rrl,rrr)) =>
+                        (case l
+                         of TREE(lk,RED,ll,lr) =>
+                                TREE(k,RED,TREE(lk,BLACK,ll,lr),
+                                           TREE(rk,BLACK,rl,rr))
+                          | _ => TREE(rk,BLACK,TREE(k,RED,l,rl),rr))
+                  | r => TREE(k,BLACK,l,r)
+            else if elem_gt(k,key)
+            then case f l
+                 of l as TREE(lk,RED,ll, lr as TREE(lrk,RED,lrl,lrr)) =>
+                        (case r
+                         of TREE(rk,RED,rl,rr) =>
+                                TREE(k,RED,TREE(lk,BLACK,ll,lr),
+                                           TREE(rk,BLACK,rl,rr))
+                          | _ => TREE(lrk,BLACK,TREE(lk,RED,ll,lrl),
+                                                TREE(k,RED,lrr,r)))
+                  | l as TREE(lk,RED, ll as TREE(llk,RED,lll,llr), lr) =>
+                        (case r
+                         of TREE(rk,RED,rl,rr) =>
+                                TREE(k,RED,TREE(lk,BLACK,ll,lr),
+                                           TREE(rk,BLACK,rl,rr))
+                          | _ => TREE(lk,BLACK,ll,TREE(k,RED,lr,r)))
+                  | l => TREE(k,BLACK,l,r)
+            else TREE(key,BLACK,l,r)
         | f (TREE(k,RED,l,r)) =
-	    if elem_gt(key,k) then TREE(k,RED,l, f r)
-	    else if elem_gt(k,key) then TREE(k,RED, f l, r)
-	    else TREE(key,RED,l,r)
+            if elem_gt(key,k) then TREE(k,RED,l, f r)
+            else if elem_gt(k,key) then TREE(k,RED, f l, r)
+            else TREE(key,RED,l,r)
    in case f t
       of TREE(k,RED, l as TREE(_,RED,_,_), r) => TREE(k,BLACK,l,r)
        | TREE(k,RED, l, r as TREE(_,RED,_,_)) => TREE(k,BLACK,l,r)
@@ -3660,33 +3660,33 @@
    
  fun exists(key,t) =
   let fun look EMPTY = false
-	| look (TREE(k,_,l,r)) =
-		if elem_gt(k,key) then look l
-		else if elem_gt(key,k) then look r
-		else true
+        | look (TREE(k,_,l,r)) =
+                if elem_gt(k,key) then look l
+                else if elem_gt(key,k) then look r
+                else true
    in look t
    end
 
  fun find(key,t) =
   let fun look EMPTY = NONE
-	| look (TREE(k,_,l,r)) =
-		if elem_gt(k,key) then look l
-		else if elem_gt(key,k) then look r
-		else SOME k
+        | look (TREE(k,_,l,r)) =
+                if elem_gt(k,key) then look l
+                else if elem_gt(key,k) then look r
+                else SOME k
    in look t
   end
 
   fun revfold f t start =
      let fun scan (EMPTY,value) = value
-	   | scan (TREE(k,_,l,r),value) = scan(r,f(k,scan(l,value)))
+           | scan (TREE(k,_,l,r),value) = scan(r,f(k,scan(l,value)))
      in scan(t,start)
      end
 
    fun fold f t start =
-	let fun scan(EMPTY,value) = value
-	      | scan(TREE(k,_,l,r),value) = scan(l,f(k,scan(r,value)))
-	in scan(t,start)
-	end
+        let fun scan(EMPTY,value) = value
+              | scan(TREE(k,_,l,r),value) = scan(l,f(k,scan(r,value)))
+        in scan(t,start)
+        end
 
    fun app f t =
       let fun scan EMPTY = ()
@@ -3699,25 +3699,25 @@
 
    fun set_eq (tree1 as (TREE _),tree2 as (TREE _)) =
      let datatype pos = L | R | M
-	 exception Done
-	 fun getvalue(stack as ((a,position)::b)) =
-	    (case a
-	     of (TREE(k,_,l,r)) =>
-		(case position
-		 of L => getvalue ((l,L)::(a,M)::b)
-		  | M => (k,case r of  EMPTY => b | _ => (a,R)::b)
-		  | R => getvalue ((r,L)::b)
-		 )
-	      | EMPTY => getvalue b
-	     )
-	    | getvalue(nil) = raise Done
-	  fun f (nil,nil) = true
-	    | f (s1 as (_ :: _),s2 as (_ :: _ )) =
-			  let val (v1,news1) = getvalue s1
-			      and (v2,news2) = getvalue s2
-			  in (elem_eq(v1,v2)) andalso f(news1,news2)
-			  end
-	    | f _ = false
+         exception Done
+         fun getvalue(stack as ((a,position)::b)) =
+            (case a
+             of (TREE(k,_,l,r)) =>
+                (case position
+                 of L => getvalue ((l,L)::(a,M)::b)
+                  | M => (k,case r of  EMPTY => b | _ => (a,R)::b)
+                  | R => getvalue ((r,L)::b)
+                 )
+              | EMPTY => getvalue b
+             )
+            | getvalue(nil) = raise Done
+          fun f (nil,nil) = true
+            | f (s1 as (_ :: _),s2 as (_ :: _ )) =
+                          let val (v1,news1) = getvalue s1
+                              and (v2,news2) = getvalue s2
+                          in (elem_eq(v1,v2)) andalso f(news1,news2)
+                          end
+            | f _ = false
       in f ((tree1,L)::nil,(tree2,L)::nil) handle Done => false
       end
     | set_eq (EMPTY,EMPTY) = true
@@ -3727,26 +3727,26 @@
 
    fun set_gt (tree1,tree2) =
      let datatype pos = L | R | M
-	 exception Done
-	 fun getvalue(stack as ((a,position)::b)) =
-	    (case a
-	     of (TREE(k,_,l,r)) =>
-		(case position
-		 of L => getvalue ((l,L)::(a,M)::b)
-		  | M => (k,case r of EMPTY => b | _ => (a,R)::b)
-		  | R => getvalue ((r,L)::b)
-		 )
-	      | EMPTY => getvalue b
-	     )
-	    | getvalue(nil) = raise Done
-	  fun f (nil,nil) = false
-	    | f (s1 as (_ :: _),s2 as (_ :: _ )) =
-			  let val (v1,news1) = getvalue s1
-			      and (v2,news2) = getvalue s2
-			  in (elem_gt(v1,v2)) orelse (elem_eq(v1,v2) andalso f(news1,news2))
-			  end
-	    | f (_,nil) = true
-	    | f (nil,_) = false
+         exception Done
+         fun getvalue(stack as ((a,position)::b)) =
+            (case a
+             of (TREE(k,_,l,r)) =>
+                (case position
+                 of L => getvalue ((l,L)::(a,M)::b)
+                  | M => (k,case r of EMPTY => b | _ => (a,R)::b)
+                  | R => getvalue ((r,L)::b)
+                 )
+              | EMPTY => getvalue b
+             )
+            | getvalue(nil) = raise Done
+          fun f (nil,nil) = false
+            | f (s1 as (_ :: _),s2 as (_ :: _ )) =
+                          let val (v1,news1) = getvalue s1
+                              and (v2,news2) = getvalue s2
+                          in (elem_gt(v1,v2)) orelse (elem_eq(v1,v2) andalso f(news1,news2))
+                          end
+            | f (_,nil) = true
+            | f (nil,_) = false
       in f ((tree1,L)::nil,(tree2,L)::nil) handle Done => false
       end
 
@@ -3758,9 +3758,9 @@
       fun make_set l = List.foldr insert empty l
 
       fun partition F S = fold (fn (a,(Yes,No)) =>
-				if F(a) then (insert(a,Yes),No)
-				else (Yes,insert(a,No)))
-			     S (empty,empty)
+                                if F(a) then (insert(a,Yes),No)
+                                else (Yes,insert(a,No)))
+                             S (empty,empty)
 
       fun remove(X, XSet) =
              let val (YSet, _) =
@@ -3769,9 +3769,9 @@
              end
 
       fun difference(Xs, Ys) =
-	   fold (fn (p as (a,Xs')) =>
-		      if exists(a,Ys) then Xs' else insert p)
-	   Xs empty
+           fold (fn (p as (a,Xs')) =>
+                      if exists(a,Ys) then Xs' else insert p)
+           Xs empty
 
       fun singleton X = insert(X,empty)
 
@@ -3780,18 +3780,18 @@
       fun union(Xs,Ys)= fold insert Ys Xs
 
       local
-	    fun closure'(from, f, result) =
-	      if is_empty from then result
-	      else
-		let val (more,result) =
-			fold (fn (a,(more',result')) =>
-				let val more = f a
-				    val new = difference(more,result)
-				in (union(more',new),union(result',new))
-				end) from
-				 (empty,result)
-		in closure'(more,f,result)
-		end
+            fun closure'(from, f, result) =
+              if is_empty from then result
+              else
+                let val (more,result) =
+                        fold (fn (a,(more',result')) =>
+                                let val more = f a
+                                    val new = difference(more,result)
+                                in (union(more',new),union(result',new))
+                                end) from
+                                 (empty,result)
+                in closure'(more,f,result)
+                end
       in
          fun closure(start, f) = closure'(start, f, start)
       end
@@ -3800,29 +3800,29 @@
 (*
 signature TABLE =
    sig
-	type 'a table
-	type key
-	val size : 'a table -> int
-	val empty: 'a table
-	val exists: (key * 'a table) -> bool
-	val find : (key * 'a table)  ->  'a option
-	val insert: ((key * 'a) * 'a table) -> 'a table
-	val make_table : (key * 'a ) list -> 'a table
-	val make_list : 'a table -> (key * 'a) list
-	val fold : ((key * 'a) * 'b -> 'b) -> 'a table -> 'b -> 'b
+        type 'a table
+        type key
+        val size : 'a table -> int
+        val empty: 'a table
+        val exists: (key * 'a table) -> bool
+        val find : (key * 'a table)  ->  'a option
+        val insert: ((key * 'a) * 'a table) -> 'a table
+        val make_table : (key * 'a ) list -> 'a table
+        val make_list : 'a table -> (key * 'a) list
+        val fold : ((key * 'a) * 'b -> 'b) -> 'a table -> 'b -> 'b
    end
 *)
 functor Table (B : sig type key
-		      val gt : (key * key) -> bool
-		     end
-		) : TABLE =
+                      val gt : (key * key) -> bool
+                     end
+                ) : TABLE =
 struct
 
  datatype Color = RED | BLACK
  type key = B.key
 
  abstype 'a table = EMPTY
-		  | TREE of ((B.key * 'a ) * Color * 'a table * 'a table)
+                  | TREE of ((B.key * 'a ) * Color * 'a table * 'a table)
  with
 
  val empty = EMPTY
@@ -3830,45 +3830,45 @@
  fun insert(elem as (key,data),t) =
   let val key_gt = fn (a,_) => B.gt(key,a)
       val key_lt = fn (a,_) => B.gt(a,key)
-	fun f EMPTY = TREE(elem,RED,EMPTY,EMPTY)
+        fun f EMPTY = TREE(elem,RED,EMPTY,EMPTY)
         | f (TREE(k,BLACK,l,r)) =
-	    if key_gt k
-	    then case f r
-		 of r as TREE(rk,RED, rl as TREE(rlk,RED,rll,rlr),rr) =>
-			(case l
-			 of TREE(lk,RED,ll,lr) =>
-				TREE(k,RED,TREE(lk,BLACK,ll,lr),
-					   TREE(rk,BLACK,rl,rr))
-			  | _ => TREE(rlk,BLACK,TREE(k,RED,l,rll),
-						TREE(rk,RED,rlr,rr)))
-		  | r as TREE(rk,RED,rl, rr as TREE(rrk,RED,rrl,rrr)) =>
-			(case l
-			 of TREE(lk,RED,ll,lr) =>
-				TREE(k,RED,TREE(lk,BLACK,ll,lr),
-					   TREE(rk,BLACK,rl,rr))
-			  | _ => TREE(rk,BLACK,TREE(k,RED,l,rl),rr))
-	          | r => TREE(k,BLACK,l,r)
-	    else if key_lt k
-	    then case f l
-	         of l as TREE(lk,RED,ll, lr as TREE(lrk,RED,lrl,lrr)) =>
-			(case r
-			 of TREE(rk,RED,rl,rr) =>
-				TREE(k,RED,TREE(lk,BLACK,ll,lr),
-					   TREE(rk,BLACK,rl,rr))
-			  | _ => TREE(lrk,BLACK,TREE(lk,RED,ll,lrl),
-						TREE(k,RED,lrr,r)))
-		  | l as TREE(lk,RED, ll as TREE(llk,RED,lll,llr), lr) =>
-			(case r
-			 of TREE(rk,RED,rl,rr) =>
-				TREE(k,RED,TREE(lk,BLACK,ll,lr),
-					   TREE(rk,BLACK,rl,rr))
-			  | _ => TREE(lk,BLACK,ll,TREE(k,RED,lr,r)))
-	          | l => TREE(k,BLACK,l,r)
-	    else TREE(elem,BLACK,l,r)
+            if key_gt k
+            then case f r
+                 of r as TREE(rk,RED, rl as TREE(rlk,RED,rll,rlr),rr) =>
+                        (case l
+                         of TREE(lk,RED,ll,lr) =>
+                                TREE(k,RED,TREE(lk,BLACK,ll,lr),
+                                           TREE(rk,BLACK,rl,rr))
+                          | _ => TREE(rlk,BLACK,TREE(k,RED,l,rll),
+                                                TREE(rk,RED,rlr,rr)))
+                  | r as TREE(rk,RED,rl, rr as TREE(rrk,RED,rrl,rrr)) =>
+                        (case l
+                         of TREE(lk,RED,ll,lr) =>
+                                TREE(k,RED,TREE(lk,BLACK,ll,lr),
+                                           TREE(rk,BLACK,rl,rr))
+                          | _ => TREE(rk,BLACK,TREE(k,RED,l,rl),rr))
+                  | r => TREE(k,BLACK,l,r)
+            else if key_lt k
+            then case f l
+                 of l as TREE(lk,RED,ll, lr as TREE(lrk,RED,lrl,lrr)) =>
+                        (case r
+                         of TREE(rk,RED,rl,rr) =>
+                                TREE(k,RED,TREE(lk,BLACK,ll,lr),
+                                           TREE(rk,BLACK,rl,rr))
+                          | _ => TREE(lrk,BLACK,TREE(lk,RED,ll,lrl),
+                                                TREE(k,RED,lrr,r)))
+                  | l as TREE(lk,RED, ll as TREE(llk,RED,lll,llr), lr) =>
+                        (case r
+                         of TREE(rk,RED,rl,rr) =>
+                                TREE(k,RED,TREE(lk,BLACK,ll,lr),
+                                           TREE(rk,BLACK,rl,rr))
+                          | _ => TREE(lk,BLACK,ll,TREE(k,RED,lr,r)))
+                  | l => TREE(k,BLACK,l,r)
+            else TREE(elem,BLACK,l,r)
         | f (TREE(k,RED,l,r)) =
-	    if key_gt k then TREE(k,RED,l, f r)
-	    else if key_lt k then TREE(k,RED, f l, r)
-	    else TREE(elem,RED,l,r)
+            if key_gt k then TREE(k,RED,l, f r)
+            else if key_lt k then TREE(k,RED, f l, r)
+            else TREE(elem,RED,l,r)
    in case f t
       of TREE(k,RED, l as TREE(_,RED,_,_), r) => TREE(k,BLACK,l,r)
        | TREE(k,RED, l, r as TREE(_,RED,_,_)) => TREE(k,BLACK,l,r)
@@ -3877,27 +3877,27 @@
 
  fun exists(key,t) =
   let fun look EMPTY = false
-	| look (TREE((k,_),_,l,r)) =
-		if B.gt(k,key) then look l
-		else if B.gt(key,k) then look r
-		else true
+        | look (TREE((k,_),_,l,r)) =
+                if B.gt(k,key) then look l
+                else if B.gt(key,k) then look r
+                else true
    in look t
    end
 
  fun find(key,t) =
   let fun look EMPTY = NONE
-	| look (TREE((k,data),_,l,r)) =
-		if B.gt(k,key) then look l
-		else if B.gt(key,k) then look r
-		else SOME data
+        | look (TREE((k,data),_,l,r)) =
+                if B.gt(k,key) then look l
+                else if B.gt(key,k) then look r
+                else SOME data
    in look t
   end
 
   fun fold f t start =
-	let fun scan(EMPTY,value) = value
-	      | scan(TREE(k,_,l,r),value) = scan(l,f(k,scan(r,value)))
-	in scan(t,start)
-	end
+        let fun scan(EMPTY,value) = value
+              | scan(TREE(k,_,l,r),value) = scan(l,f(k,scan(r,value)))
+        in scan(t,start)
+        end
 
   fun make_table l = List.foldr insert empty l
 
@@ -3927,19 +3927,19 @@
    a unique integer between 0 and n-1 *)
 
 functor Hash(B : sig type elem
-		     val gt : elem * elem -> bool
-		 end) : HASH =
+                     val gt : elem * elem -> bool
+                 end) : HASH =
 struct
     type elem=B.elem
     structure HashTable = Table(type key=B.elem
-				val gt = B.gt)
+                                val gt = B.gt)
 
     type table = {count : int, table : int HashTable.table}
 
     val empty = {count=0,table=HashTable.empty}
     val size = fn {count,table} => count
     val add = fn (e,{count,table}) =>
-		{count=count+1,table=HashTable.insert((e,count),table)}
+                {count=count+1,table=HashTable.insert((e,count),table)}
     val find = fn (e,{table,count}) => HashTable.find(e,table)
     val exists = fn (e,{table,count}) => HashTable.exists(e,table)
 end;
@@ -3957,75 +3957,75 @@
  *)
 
 functor mkCore(structure IntGrammar : INTGRAMMAR) : CORE =
-	struct
-		open IntGrammar
-		open  Grammar
-		structure IntGrammar = IntGrammar
-		structure Grammar = Grammar
+        struct
+                open IntGrammar
+                open  Grammar
+                structure IntGrammar = IntGrammar
+                structure Grammar = Grammar
 
-		datatype item = ITEM of
-				{ rule : rule,
-				  dot : int,
-				  rhsAfter : symbol list
-				}
+                datatype item = ITEM of
+                                { rule : rule,
+                                  dot : int,
+                                  rhsAfter : symbol list
+                                }
 
-		val eqItem = fn (ITEM{rule=RULE{num=n,...},dot=d,...},
-				 ITEM{rule=RULE{num=m,...},dot=e,...}) =>
-					n=m andalso d=e
+                val eqItem = fn (ITEM{rule=RULE{num=n,...},dot=d,...},
+                                 ITEM{rule=RULE{num=m,...},dot=e,...}) =>
+                                        n=m andalso d=e
 
-		val gtItem =  fn (ITEM{rule=RULE{num=n,...},dot=d,...},
-				  ITEM{rule=RULE{num=m,...},dot=e,...}) =>
-					n>m orelse (n=m andalso d>e)
+                val gtItem =  fn (ITEM{rule=RULE{num=n,...},dot=d,...},
+                                  ITEM{rule=RULE{num=m,...},dot=e,...}) =>
+                                        n>m orelse (n=m andalso d>e)
 
-		structure ItemList = ListOrdSet
-			(struct
-				type elem = item
-				val eq = eqItem
-				val gt = gtItem
-			end)
-		
-		open ItemList
-		datatype core = CORE of item list * int
+                structure ItemList = ListOrdSet
+                        (struct
+                                type elem = item
+                                val eq = eqItem
+                                val gt = gtItem
+                        end)
+                
+                open ItemList
+                datatype core = CORE of item list * int
 
-		val gtCore = fn (CORE (a,_),CORE (b,_)) => ItemList.set_gt(a,b)
-		val eqCore = fn (CORE (a,_),CORE (b,_)) => ItemList.set_eq(a,b)
+                val gtCore = fn (CORE (a,_),CORE (b,_)) => ItemList.set_gt(a,b)
+                val eqCore = fn (CORE (a,_),CORE (b,_)) => ItemList.set_eq(a,b)
 
-		(* functions for printing and debugging *)
+                (* functions for printing and debugging *)
 
-		 val prItem = fn (symbolToString,nontermToString,print) =>
-		   let val printInt = print o (Int.toString : int -> string)
-		       val prSymbol = print o symbolToString
-		       val prNonterm = print o nontermToString
-		       fun showRest nil = ()
-			 | showRest (h::t) = (prSymbol h; print " "; showRest t)
-		       fun showRhs (l,0) = (print ". "; showRest l)
-			 | showRhs (nil,_) = ()
-			 | showRhs (h::t,n) = (prSymbol h;
-					       print " ";
-					       showRhs(t,n-1))
-		   in fn (ITEM {rule=RULE {lhs,rhs,rulenum,num,...},
-				dot,rhsAfter,...}) =>
-			(prNonterm lhs; print " : "; showRhs(rhs,dot);
-		 	 case rhsAfter 
-			 of nil => (print " (reduce by rule "; 
-				    printInt rulenum;
-				    print ")")
-			  | _ => ();
-			  if DEBUG then 
-			     (print " (num "; printInt num; print ")")
-			  else ())
-		   end
+                 val prItem = fn (symbolToString,nontermToString,print) =>
+                   let val printInt = print o (Int.toString : int -> string)
+                       val prSymbol = print o symbolToString
+                       val prNonterm = print o nontermToString
+                       fun showRest nil = ()
+                         | showRest (h::t) = (prSymbol h; print " "; showRest t)
+                       fun showRhs (l,0) = (print ". "; showRest l)
+                         | showRhs (nil,_) = ()
+                         | showRhs (h::t,n) = (prSymbol h;
+                                               print " ";
+                                               showRhs(t,n-1))
+                   in fn (ITEM {rule=RULE {lhs,rhs,rulenum,num,...},
+                                dot,rhsAfter,...}) =>
+                        (prNonterm lhs; print " : "; showRhs(rhs,dot);
+                         case rhsAfter 
+                         of nil => (print " (reduce by rule "; 
+                                    printInt rulenum;
+                                    print ")")
+                          | _ => ();
+                          if DEBUG then 
+                             (print " (num "; printInt num; print ")")
+                          else ())
+                   end
 
-	         val prCore = fn a as (_,_,print) =>
-		    let val prItem = prItem a
-		    in fn (CORE (items,state)) =>
-			  (print "state ";
-			   print (Int.toString state);
-		   	   print ":\n\n";
-		   	   app (fn i => (print "\t";
-					 prItem i; print "\n")) items;
-			   print "\n")
-		    end
+                 val prCore = fn a as (_,_,print) =>
+                    let val prItem = prItem a
+                    in fn (CORE (items,state)) =>
+                          (print "state ";
+                           print (Int.toString state);
+                           print ":\n\n";
+                           app (fn i => (print "\t";
+                                         prItem i; print "\n")) items;
+                           print "\n")
+                    end
 end;
 (* ML-Yacc Parser Generator (c) 1989 Andrew W. Appel, David R. Tarditi 
  *
@@ -4036,39 +4036,39 @@
  *)
 
 functor mkCoreUtils(structure Core : CORE) : CORE_UTILS =
-	struct
-	        open Array List
-		infix 9 sub
-		val DEBUG = true
-		structure Core = Core
-		structure IntGrammar = Core.IntGrammar
-		structure Grammar = IntGrammar.Grammar
+        struct
+                open Array List
+                infix 9 sub
+                val DEBUG = true
+                structure Core = Core
+                structure IntGrammar = Core.IntGrammar
+                structure Grammar = IntGrammar.Grammar
 
-		open Grammar IntGrammar Core
+                open Grammar IntGrammar Core
 
-		structure Assoc = SymbolAssoc
+                structure Assoc = SymbolAssoc
 
-		structure NtList = ListOrdSet
-			(struct
-				type elem = nonterm
-				val eq = eqNonterm
-				val gt = gtNonterm
-			 end)
+                structure NtList = ListOrdSet
+                        (struct
+                                type elem = nonterm
+                                val eq = eqNonterm
+                                val gt = gtNonterm
+                         end)
 
-	val mkFuncs = fn (GRAMMAR {rules,terms,nonterms,...}) =>
-	   let val derives=array(nonterms,nil : rule list)
+        val mkFuncs = fn (GRAMMAR {rules,terms,nonterms,...}) =>
+           let val derives=array(nonterms,nil : rule list)
 
 (* sort rules by their lhs nonterminal by placing them in an array indexed
    in their lhs nonterminal *)
 
-	       val _ =
-		 let val f = fn {lhs=lhs as (NT n), rhs, precedence,rulenum} =>
-			let val rule=RULE{lhs=lhs,rhs=rhs,precedence=precedence,
-					  rulenum=rulenum,num=0}
-		        in update(derives,n,rule::(derives sub n))
-			end
-		  in app f rules
-		  end
+               val _ =
+                 let val f = fn {lhs=lhs as (NT n), rhs, precedence,rulenum} =>
+                        let val rule=RULE{lhs=lhs,rhs=rhs,precedence=precedence,
+                                          rulenum=rulenum,num=0}
+                        in update(derives,n,rule::(derives sub n))
+                        end
+                  in app f rules
+                  end
 
 (* renumber rules so that rule numbers increase monotonically with
    the number of their lhs nonterminal, and so that rules are numbered
@@ -4077,62 +4077,62 @@
    productions for nonterm i+1 are numbered from k+1 to m, and
    productions for nonterm 0 start at 0 *)
 
-		val _ =
-		   let val f =
-		         fn (RULE{lhs,rhs,precedence,rulenum,num}, (l,i)) =>
-			    (RULE{lhs=lhs,rhs=rhs, precedence=precedence,
-				  rulenum=rulenum, num=i}::l,i+1)
-			fun g(i,num) =
-		          if i<nonterms then
-			    let val (l,n) =
-				        List.foldr f ([], num) (derives sub i)
-			    in update(derives,i,rev l); g(i+1,n)
-			    end
-			  else ()
-		    in g(0,0)
-		    end
+                val _ =
+                   let val f =
+                         fn (RULE{lhs,rhs,precedence,rulenum,num}, (l,i)) =>
+                            (RULE{lhs=lhs,rhs=rhs, precedence=precedence,
+                                  rulenum=rulenum, num=i}::l,i+1)
+                        fun g(i,num) =
+                          if i<nonterms then
+                            let val (l,n) =
+                                        List.foldr f ([], num) (derives sub i)
+                            in update(derives,i,rev l); g(i+1,n)
+                            end
+                          else ()
+                    in g(0,0)
+                    end
 
 (* list of rules - sorted by rule number. *)
 
-		 val rules = 
-		     let fun g i =
-			if i < nonterms then (derives sub i) @ (g (i+1))
-			else nil
-		     in g 0
-		     end
+                 val rules = 
+                     let fun g i =
+                        if i < nonterms then (derives sub i) @ (g (i+1))
+                        else nil
+                     in g 0
+                     end
 
 (* produces: set of productions with nonterminal n as the lhs.  The set
    of productions *must* be sorted by rule number, because functions
    below assume that this list is sorted *)
 
-		val produces = fn (NT n) =>
-		  if DEBUG andalso (n<0 orelse n>=nonterms) then
-		     let exception Produces of int in raise (Produces n) end
-		  else derives sub n
+                val produces = fn (NT n) =>
+                  if DEBUG andalso (n<0 orelse n>=nonterms) then
+                     let exception Produces of int in raise (Produces n) end
+                  else derives sub n
 
-		val memoize = fn f =>
-		   let fun loop i = if i = nonterms then nil
-				  else f (NT i) :: (loop (i+1))
-		       val data = Array.fromList(loop 0)
-		   in fn (NT i) => data sub i
-		   end
+                val memoize = fn f =>
+                   let fun loop i = if i = nonterms then nil
+                                  else f (NT i) :: (loop (i+1))
+                       val data = Array.fromList(loop 0)
+                   in fn (NT i) => data sub i
+                   end
 
  (* compute nonterminals which must be added to a closure when a given
     nonterminal is added, i.e all nonterminals C for each nonterminal A such
     that A =*=> Cx *)
 
-		val nontermClosure =
-			let val collectNonterms = fn n =>
-			      List.foldr (fn (r,l) =>
-				  case r
-				  of RULE {rhs=NONTERM n :: _,...} =>
-					    NtList.insert(n,l)
-				   | _ => l) NtList.empty (produces n)
-			    val closureNonterm = fn n =>
-				   NtList.closure(NtList.singleton n,
-						  collectNonterms)
-			in memoize closureNonterm
-			end
+                val nontermClosure =
+                        let val collectNonterms = fn n =>
+                              List.foldr (fn (r,l) =>
+                                  case r
+                                  of RULE {rhs=NONTERM n :: _,...} =>
+                                            NtList.insert(n,l)
+                                   | _ => l) NtList.empty (produces n)
+                            val closureNonterm = fn n =>
+                                   NtList.closure(NtList.singleton n,
+                                                  collectNonterms)
+                        in memoize closureNonterm
+                        end
 
 (* ntShifts: Take the items produced by a nonterminal, and sort them
    by their first symbol.  For each first symbol, make sure the item
@@ -4146,36 +4146,36 @@
    already in order, the list for each symbol will also end up in order.
  *)
 
-		fun sortItems nt =
-		 let fun add_item (a as RULE{rhs=symbol::rest,...},r) =
-		       let val item = ITEM{rule=a,dot=1,rhsAfter=rest}
-		       in Assoc.insert((symbol,case Assoc.find (symbol,r)
-			  			of SOME l => item::l
-			   			 | NONE => [item]),r)
-		       end
-		       | add_item (_,r) = r
-		 in List.foldr add_item Assoc.empty (produces nt)
-		 end
+                fun sortItems nt =
+                 let fun add_item (a as RULE{rhs=symbol::rest,...},r) =
+                       let val item = ITEM{rule=a,dot=1,rhsAfter=rest}
+                       in Assoc.insert((symbol,case Assoc.find (symbol,r)
+                                                of SOME l => item::l
+                                                 | NONE => [item]),r)
+                       end
+                       | add_item (_,r) = r
+                 in List.foldr add_item Assoc.empty (produces nt)
+                 end
 
-		 val ntShifts = memoize sortItems
+                 val ntShifts = memoize sortItems
 
 (* getNonterms: get the nonterminals with a .  before them in a core.
    Returns a list of nonterminals in ascending order *)
 
-		fun getNonterms l =
-		  List.foldr (fn (ITEM {rhsAfter=NONTERM sym ::_, ...},r) =>
-				NtList.insert(sym,r)
-			      | (_,r) => r) [] l
+                fun getNonterms l =
+                  List.foldr (fn (ITEM {rhsAfter=NONTERM sym ::_, ...},r) =>
+                                NtList.insert(sym,r)
+                              | (_,r) => r) [] l
 
 (* closureNonterms: compute the nonterminals that would have a . before them
    in the closure of the core.  Returns a list of nonterminals in ascending
    order *)
-		fun closureNonterms a =
-			let val nonterms = getNonterms a
-		 	in List.foldr (fn (nt,r) =>
-				   NtList.union(nontermClosure nt,r))
-			   nonterms nonterms
-			end
+                fun closureNonterms a =
+                        let val nonterms = getNonterms a
+                        in List.foldr (fn (nt,r) =>
+                                   NtList.union(nontermClosure nt,r))
+                           nonterms nonterms
+                        end
 
 (* shifts: compute the core sets that result from shift/gotoing on 
    the closure of a kernal set.  The items in core sets are sorted, of
@@ -4198,64 +4198,64 @@
 back to front (=> that the items end up in ascending order), and never had any
 duplicate items (each item is derived from only one nonterminal). *)
 
-	fun shifts (CORE (itemList,_)) =
-	    let
+        fun shifts (CORE (itemList,_)) =
+            let
 
 (* mergeShiftItems: add an item list for a shift/goto symbol to the table *)
 
 fun mergeShiftItems (args as ((k,l),r)) =
-		  case Assoc.find(k,r)
-		  of NONE => Assoc.insert args
-		   | SOME old => Assoc.insert ((k,l@old),r)
+                  case Assoc.find(k,r)
+                  of NONE => Assoc.insert args
+                   | SOME old => Assoc.insert ((k,l@old),r)
 
 (* mergeItems: add all items derived from a nonterminal to the table.  We've
    kept these items sorted by their shift/goto symbol (the first symbol on
    their rhs) *)
 
-		fun mergeItems (n,r) =
-			Assoc.fold mergeShiftItems (ntShifts n) r
+                fun mergeItems (n,r) =
+                        Assoc.fold mergeShiftItems (ntShifts n) r
 
 (* nonterms: a list of nonterminals that are in a core after the
    closure operation *)
 
-		val nonterms = closureNonterms itemList
+                val nonterms = closureNonterms itemList
 
 (* now create a table which for each shift/goto symbol gives the sorted list
    of closure items which would result from first taking all the closure items
    and then sorting them by the shift/goto symbols *)
 
-		val newsets = List.foldr mergeItems Assoc.empty nonterms
+                val newsets = List.foldr mergeItems Assoc.empty nonterms
 
 (* finally prepare to insert the kernal items of a core *)
 
-		fun insertItem ((k,i),r) =
-		   case (Assoc.find(k,r))
-		     of NONE => Assoc.insert((k,[i]),r)
-		      | SOME l => Assoc.insert((k,Core.insert(i,l)),r)
-		fun shiftCores(ITEM{rule,dot,rhsAfter=symbol::rest},r) =
-		   insertItem((symbol,
-			      ITEM{rule=rule,dot=dot+1,rhsAfter=rest}),r)
-		  | shiftCores(_,r) = r
+                fun insertItem ((k,i),r) =
+                   case (Assoc.find(k,r))
+                     of NONE => Assoc.insert((k,[i]),r)
+                      | SOME l => Assoc.insert((k,Core.insert(i,l)),r)
+                fun shiftCores(ITEM{rule,dot,rhsAfter=symbol::rest},r) =
+                   insertItem((symbol,
+                              ITEM{rule=rule,dot=dot+1,rhsAfter=rest}),r)
+                  | shiftCores(_,r) = r
 
 (* insert the kernal items of a core *)
 
-		val newsets = List.foldr shiftCores newsets itemList
-	   in Assoc.make_list newsets
-	   end
+                val newsets = List.foldr shiftCores newsets itemList
+           in Assoc.make_list newsets
+           end
 
 (* nontermEpsProds: returns a list of epsilon productions produced by a
    nonterminal sorted by rule number. ** Depends on produces returning
    an ordered list **.  It does not alter the order in which the rules
    were returned by produces; it only removes non-epsilon productions *)
 
-	   val nontermEpsProds =
-	      let val f = fn nt =>
-		  List.foldr
-		    (fn (rule as RULE {rhs=nil,...},results) => rule :: results
-		      | (_,results) => results)
-		    [] (produces nt)
-	       in memoize f
-	       end 
+           val nontermEpsProds =
+              let val f = fn nt =>
+                  List.foldr
+                    (fn (rule as RULE {rhs=nil,...},results) => rule :: results
+                      | (_,results) => results)
+                    [] (produces nt)
+               in memoize f
+               end 
 
 (* epsProds: take a core and compute a list of epsilon productions for it
    sorted by rule number.  ** Depends on closureNonterms returning a list
@@ -4264,10 +4264,10 @@
    an ordered item list for each production 
 *)
 
-	fun epsProds (CORE (itemList,state)) =
-	   let val prods = map nontermEpsProds (closureNonterms itemList)
-	   in List.concat prods
-	   end
+        fun epsProds (CORE (itemList,state)) =
+           let val prods = map nontermEpsProds (closureNonterms itemList)
+           in List.concat prods
+           end
 
      in {produces=produces,shifts=shifts,rules=rules,epsProds=epsProds}
      end
@@ -4286,101 +4286,101 @@
  *)
 
 functor mkGraph(structure IntGrammar : INTGRAMMAR
-		structure Core : CORE
-		structure CoreUtils : CORE_UTILS
-		sharing IntGrammar = Core.IntGrammar = CoreUtils.IntGrammar
-		sharing CoreUtils.Core = Core
-		) : LRGRAPH =
-	struct
-	        open Array List
-		infix 9 sub
-		structure Core = Core
-		structure Grammar = IntGrammar.Grammar
-		structure IntGrammar = IntGrammar
-		open Core Core.Grammar CoreUtils IntGrammar
+                structure Core : CORE
+                structure CoreUtils : CORE_UTILS
+                sharing IntGrammar = Core.IntGrammar = CoreUtils.IntGrammar
+                sharing CoreUtils.Core = Core
+                ) : LRGRAPH =
+        struct
+                open Array List
+                infix 9 sub
+                structure Core = Core
+                structure Grammar = IntGrammar.Grammar
+                structure IntGrammar = IntGrammar
+                open Core Core.Grammar CoreUtils IntGrammar
 
-		structure NodeSet = RbOrdSet
-			(struct
-				type elem = core
-				val eq = eqCore
-				val gt = gtCore
-			end)
+                structure NodeSet = RbOrdSet
+                        (struct
+                                type elem = core
+                                val eq = eqCore
+                                val gt = gtCore
+                        end)
 
-		open NodeSet
-		exception Shift of int * symbol
+                open NodeSet
+                exception Shift of int * symbol
 
-		type graph = {edges: {edge:symbol,to:core} list array,
-			      nodes: core list,nodeArray : core array}
-		val edges = fn (CORE (_,i),{edges,...}:graph) => edges sub i
-		val nodes = fn ({nodes,...} : graph) => nodes
-		val shift = fn ({edges,nodes,...} : graph) => fn a as (i,sym) =>
-			let fun find nil = raise (Shift a)
-			      | find ({edge,to=CORE (_,state)} :: r) =
-					if gtSymbol(sym,edge) then find r
-					else if eqSymbol(edge,sym) then state
-					else raise (Shift a)
-			in find (edges sub i)
-			end
+                type graph = {edges: {edge:symbol,to:core} list array,
+                              nodes: core list,nodeArray : core array}
+                val edges = fn (CORE (_,i),{edges,...}:graph) => edges sub i
+                val nodes = fn ({nodes,...} : graph) => nodes
+                val shift = fn ({edges,nodes,...} : graph) => fn a as (i,sym) =>
+                        let fun find nil = raise (Shift a)
+                              | find ({edge,to=CORE (_,state)} :: r) =
+                                        if gtSymbol(sym,edge) then find r
+                                        else if eqSymbol(edge,sym) then state
+                                        else raise (Shift a)
+                        in find (edges sub i)
+                        end
 
-		val core = fn ({nodeArray,...} : graph) =>
-				 fn i => nodeArray sub i
+                val core = fn ({nodeArray,...} : graph) =>
+                                 fn i => nodeArray sub i
 
-		val mkGraph = fn (g as (GRAMMAR {start,...})) =>
-		   let val {shifts,produces,rules,epsProds} =
-				  CoreUtils.mkFuncs g
-		       fun add_goto ((symbol,a),(nodes,edges,future,num)) =
-				case find(CORE (a,0),nodes)
-				  of NONE =>
-				     let val core =CORE (a,num)
-					 val edge = {edge=symbol,to=core}
-				     in (insert(core,nodes),edge::edges,
-					 core::future,num+1)
-				     end
-				   | (SOME c) =>
-					let val edge={edge=symbol,to=c}
-					in (nodes,edge::edges,future,num)
-					end
-		       fun f (nodes,node_list,edge_list,nil,nil,num) =
-			    let val nodes=rev node_list
-			    in {nodes=nodes,
-				edges=Array.fromList (rev edge_list),
-				nodeArray = Array.fromList nodes
-			 	}
-			    end
-			 | f (nodes,node_list,edge_list,nil,y,num) =
-				f (nodes,node_list,edge_list,rev y,nil,num)
-			 | f (nodes,node_list,edge_list,h::t,y,num) =
-			 	let val (nodes,edges,future,num) =
-				   List.foldr add_goto (nodes,[],y,num) (shifts h)
-				in f (nodes,h::node_list,
-				       edges::edge_list,t,future,num)
-				end
-		in {graph=
-		   let val makeItem = fn (r as (RULE {rhs,...})) =>
-						ITEM{rule=r,dot=0,rhsAfter=rhs}
-			val initialItemList = map makeItem (produces start)
-		        val orderedItemList =
-			   List.foldr Core.insert [] initialItemList
- 			val initial = CORE (orderedItemList,0)
-		   in f(empty,nil,nil,[initial],nil,1)
-		   end,
-		   produces=produces,
-		   rules=rules,
-		   epsProds=epsProds}
-		end
-	val prGraph = fn a as (nontermToString,termToString,print) => fn g =>
-	   let val printCore = prCore a
-	       val printSymbol = print o nontermToString
-	       val nodes = nodes g
-	       val printEdges = fn n => 
-		 List.app (fn {edge,to=CORE (_,state)} =>
-			(print "\tshift on ";
-			 printSymbol edge;
-			 print " to ";
-			 print (Int.toString state);
-			 print "\n")) (edges (n,g))
-	 in List.app (fn c => (printCore c; print "\n"; printEdges c)) nodes
-	 end
+                val mkGraph = fn (g as (GRAMMAR {start,...})) =>
+                   let val {shifts,produces,rules,epsProds} =
+                                  CoreUtils.mkFuncs g
+                       fun add_goto ((symbol,a),(nodes,edges,future,num)) =
+                                case find(CORE (a,0),nodes)
+                                  of NONE =>
+                                     let val core =CORE (a,num)
+                                         val edge = {edge=symbol,to=core}
+                                     in (insert(core,nodes),edge::edges,
+                                         core::future,num+1)
+                                     end
+                                   | (SOME c) =>
+                                        let val edge={edge=symbol,to=c}
+                                        in (nodes,edge::edges,future,num)
+                                        end
+                       fun f (nodes,node_list,edge_list,nil,nil,num) =
+                            let val nodes=rev node_list
+                            in {nodes=nodes,
+                                edges=Array.fromList (rev edge_list),
+                                nodeArray = Array.fromList nodes
+                                }
+                            end
+                         | f (nodes,node_list,edge_list,nil,y,num) =
+                                f (nodes,node_list,edge_list,rev y,nil,num)
+                         | f (nodes,node_list,edge_list,h::t,y,num) =
+                                let val (nodes,edges,future,num) =
+                                   List.foldr add_goto (nodes,[],y,num) (shifts h)
+                                in f (nodes,h::node_list,
+                                       edges::edge_list,t,future,num)
+                                end
+                in {graph=
+                   let val makeItem = fn (r as (RULE {rhs,...})) =>
+                                                ITEM{rule=r,dot=0,rhsAfter=rhs}
+                        val initialItemList = map makeItem (produces start)
+                        val orderedItemList =
+                           List.foldr Core.insert [] initialItemList
+                        val initial = CORE (orderedItemList,0)
+                   in f(empty,nil,nil,[initial],nil,1)
+                   end,
+                   produces=produces,
+                   rules=rules,
+                   epsProds=epsProds}
+                end
+        val prGraph = fn a as (nontermToString,termToString,print) => fn g =>
+           let val printCore = prCore a
+               val printSymbol = print o nontermToString
+               val nodes = nodes g
+               val printEdges = fn n => 
+                 List.app (fn {edge,to=CORE (_,state)} =>
+                        (print "\tshift on ";
+                         printSymbol edge;
+                         print " to ";
+                         print (Int.toString state);
+                         print "\n")) (edges (n,g))
+         in List.app (fn c => (printCore c; print "\n"; printEdges c)) nodes
+         end
 end;
 (* ML-Yacc Parser Generator (c) 1989 Andrew W. Appel, David R. Tarditi 
  *
@@ -4392,115 +4392,115 @@
 
 functor mkLook (structure IntGrammar : INTGRAMMAR) : LOOK =
     struct
-	open Array List
-	infix 9 sub
-	structure Grammar = IntGrammar.Grammar
-	structure IntGrammar = IntGrammar
-	open Grammar IntGrammar
+        open Array List
+        infix 9 sub
+        structure Grammar = IntGrammar.Grammar
+        structure IntGrammar = IntGrammar
+        open Grammar IntGrammar
 
-	structure TermSet = ListOrdSet
-		(struct
-			type elem = term
-			val eq = eqTerm
-			val gt = gtTerm
-		end)
+        structure TermSet = ListOrdSet
+                (struct
+                        type elem = term
+                        val eq = eqTerm
+                        val gt = gtTerm
+                end)
 
-	val union = TermSet.union
-	val make_set = TermSet.make_set
+        val union = TermSet.union
+        val make_set = TermSet.make_set
 
-	val prLook = fn (termToString,print) =>
-		let val printTerm = print o termToString
-		    fun f nil = print " "
-		      | f (a :: b) = (printTerm a; print " "; f b)
-		in f
-		end
+        val prLook = fn (termToString,print) =>
+                let val printTerm = print o termToString
+                    fun f nil = print " "
+                      | f (a :: b) = (printTerm a; print " "; f b)
+                in f
+                end
 
-	structure NontermSet = ListOrdSet
-		(struct
-			type elem = nonterm
-			val eq = eqNonterm
-			val gt = gtNonterm
-		end)
-	
-	val mkFuncs = fn {rules : rule list, nonterms : int,
-			  produces : nonterm -> rule list} =>
+        structure NontermSet = ListOrdSet
+                (struct
+                        type elem = nonterm
+                        val eq = eqNonterm
+                        val gt = gtNonterm
+                end)
+        
+        val mkFuncs = fn {rules : rule list, nonterms : int,
+                          produces : nonterm -> rule list} =>
 
-	let
+        let
 
-	(* nullable: create a function which tells if a nonterminal is nullable
-	   or not.
+        (* nullable: create a function which tells if a nonterminal is nullable
+           or not.
 
-	   Method: Keep an array of booleans.  The nth entry is true if
-	   NT i is nullable.  If is false if we don't know whether NT i
-	   is nullable.
+           Method: Keep an array of booleans.  The nth entry is true if
+           NT i is nullable.  If is false if we don't know whether NT i
+           is nullable.
 
-	   Keep a list of rules whose remaining rhs we must prove to be
-	   null.  First, scan the list of rules and remove those rules
-	   whose rhs contains a terminal.  These rules are not nullable.
+           Keep a list of rules whose remaining rhs we must prove to be
+           null.  First, scan the list of rules and remove those rules
+           whose rhs contains a terminal.  These rules are not nullable.
 
-	   Now iterate through the rules that were left:
-		   (1) if there is no remaining rhs we have proved that
-		    the rule is nullable, mark the nonterminal for the
-		    rule as nullable
-		   (2) if the first element of the remaining rhs is
-		       nullable, place the rule back on the list with
-		       the rest of the rhs
-		   (3) if we don't know whether the nonterminal is nullable,
-		       place it back on the list
-		   (4) repeat until the list does not change.
+           Now iterate through the rules that were left:
+                   (1) if there is no remaining rhs we have proved that
+                    the rule is nullable, mark the nonterminal for the
+                    rule as nullable
+                   (2) if the first element of the remaining rhs is
+                       nullable, place the rule back on the list with
+                       the rest of the rhs
+                   (3) if we don't know whether the nonterminal is nullable,
+                       place it back on the list
+                   (4) repeat until the list does not change.
 
-	   We have found all the possible nullable rules. 
+           We have found all the possible nullable rules. 
       *)
 
-	val nullable =
-	  let fun ok_rhs nil = true
-		| ok_rhs ((TERM _)::_) = false
-		| ok_rhs ((NONTERM i)::r) = ok_rhs r
-	      fun add_rule (RULE {lhs,rhs,...},r) =
-		 if ok_rhs rhs then (lhs,map (fn (NONTERM (NT i)) => i) rhs)::r
-		 else r
-	      val items = List.foldr add_rule [] rules
-	      val nullable = array(nonterms,false)
-	      val f = fn ((NT i,nil),(l,_)) => (update(nullable,i,true);
-				 	       (l,true))
-		       | (a as (lhs,(h::t)),(l,change)) =>
-				case (nullable sub h) 
-				  of false => (a::l,change)
-				   | true => ((lhs,t)::l,true)
-	      fun prove(l,true) = prove(List.foldr f (nil,false) l)
-		| prove(_,false) = ()
-	in (prove(items,true); fn (NT i) => nullable sub i)
-	end
+        val nullable =
+          let fun ok_rhs nil = true
+                | ok_rhs ((TERM _)::_) = false
+                | ok_rhs ((NONTERM i)::r) = ok_rhs r
+              fun add_rule (RULE {lhs,rhs,...},r) =
+                 if ok_rhs rhs then (lhs,map (fn (NONTERM (NT i)) => i) rhs)::r
+                 else r
+              val items = List.foldr add_rule [] rules
+              val nullable = array(nonterms,false)
+              val f = fn ((NT i,nil),(l,_)) => (update(nullable,i,true);
+                                               (l,true))
+                       | (a as (lhs,(h::t)),(l,change)) =>
+                                case (nullable sub h) 
+                                  of false => (a::l,change)
+                                   | true => ((lhs,t)::l,true)
+              fun prove(l,true) = prove(List.foldr f (nil,false) l)
+                | prove(_,false) = ()
+        in (prove(items,true); fn (NT i) => nullable sub i)
+        end
 
      (* scanRhs : look at a list of symbols, scanning past nullable
-	nonterminals, applying addSymbol to the symbols scanned *)
+        nonterminals, applying addSymbol to the symbols scanned *)
 
     fun scanRhs addSymbol =
-	let fun f (nil,result) = result
-      	      | f ((sym as NONTERM nt) :: rest,result) =
-		if nullable nt then f (rest,addSymbol(sym,result))
-		else addSymbol(sym,result)
-      	      | f ((sym as TERM _) :: _,result) = addSymbol(sym,result)
-	in f 
-	end
+        let fun f (nil,result) = result
+              | f ((sym as NONTERM nt) :: rest,result) =
+                if nullable nt then f (rest,addSymbol(sym,result))
+                else addSymbol(sym,result)
+              | f ((sym as TERM _) :: _,result) = addSymbol(sym,result)
+        in f 
+        end
 
      (* accumulate: look at the start of the right-hand-sides of rules,
-	looking past nullable nonterminals, applying addObj to the visible
-	symbols. *)
+        looking past nullable nonterminals, applying addObj to the visible
+        symbols. *)
 
       fun accumulate(rules, empty, addObj) =
        List.foldr (fn (RULE {rhs,...},r) =>(scanRhs addObj) (rhs,r)) empty rules
 
       val nontermMemo = fn f =>
-	let val lookup = array(nonterms,nil)
-	    fun g i = if i=nonterms then ()
-		      else (update(lookup,i,f (NT i)); g (i+1))
-	in (g 0; fn (NT j) => lookup sub j)
-	end
+        let val lookup = array(nonterms,nil)
+            fun g i = if i=nonterms then ()
+                      else (update(lookup,i,f (NT i)); g (i+1))
+        in (g 0; fn (NT j) => lookup sub j)
+        end
 
      (* first1: the FIRST set of a nonterminal in the grammar. Only looks
-	at other terminals, but it is clever enough to move past nullable
-	nonterminals at the start of a production. *)
+        at other terminals, but it is clever enough to move past nullable
+        nonterminals at the start of a production. *)
 
       fun first1 nt = accumulate(produces nt, TermSet.empty,
                                  fn (TERM t, set) => TermSet.insert (t,set)
@@ -4509,40 +4509,40 @@
       val first1 = nontermMemo(first1)
 
      (* starters1: given a nonterminal "nt", return the set of nonterminals
-	which can start its productions. Looks past nullables, but doesn't
-	recurse *)
+        which can start its productions. Looks past nullables, but doesn't
+        recurse *)
 
       fun starters1 nt = accumulate(produces nt, nil,
                                     fn (NONTERM nt, set) =>
-					 NontermSet.insert(nt,set)
+                                         NontermSet.insert(nt,set)
                                      | (_, set) => set)
 
      val starters1 = nontermMemo(starters1)
 
      (* first: maps a nonterminal to its first-set. Get all the starters of
-	the nonterminal, get the first1 terminal set of each of these,
-	union the whole lot together *)
+        the nonterminal, get the first1 terminal set of each of these,
+        union the whole lot together *)
 
       fun first nt =
-	     List.foldr (fn (a,r) => TermSet.union(r,first1 a))
- 	       [] (NontermSet.closure (NontermSet.singleton nt, starters1))
+             List.foldr (fn (a,r) => TermSet.union(r,first1 a))
+               [] (NontermSet.closure (NontermSet.singleton nt, starters1))
 
       val first = nontermMemo(first)
 
      (* prefix: all possible terminals starting a symbol list *)
 
       fun prefix symbols =
-	  scanRhs (fn (TERM t,r) => TermSet.insert(t,r)
-		    | (NONTERM nt,r) => TermSet.union(first nt,r))
-	  (symbols,nil)
+          scanRhs (fn (TERM t,r) => TermSet.insert(t,r)
+                    | (NONTERM nt,r) => TermSet.union(first nt,r))
+          (symbols,nil)
 
       fun nullable_string ((TERM t) :: r) = false
-	| nullable_string ((NONTERM nt) :: r) =
-		(case (nullable nt)
-		   of true => nullable_string r
-		    | f => f)
-	| nullable_string nil = true
-	  
+        | nullable_string ((NONTERM nt) :: r) =
+                (case (nullable nt)
+                   of true => nullable_string r
+                    | f => f)
+        | nullable_string nil = true
+          
     in {nullable = nullable, first = prefix}
     end
 end;
@@ -4563,94 +4563,94 @@
  *)
 
 functor mkLalr ( structure IntGrammar : INTGRAMMAR
-		structure Core : CORE
-		structure Graph : LRGRAPH
-		structure Look: LOOK
-		sharing Graph.Core = Core
-		sharing Graph.IntGrammar = Core.IntGrammar =
-			Look.IntGrammar = IntGrammar) : LALR_GRAPH =
+                structure Core : CORE
+                structure Graph : LRGRAPH
+                structure Look: LOOK
+                sharing Graph.Core = Core
+                sharing Graph.IntGrammar = Core.IntGrammar =
+                        Look.IntGrammar = IntGrammar) : LALR_GRAPH =
     struct
-	open Array List
-	infix 9 sub
-	open IntGrammar.Grammar IntGrammar Core Graph Look
-	structure Graph = Graph
-	structure Core = Core
-	structure Grammar = IntGrammar.Grammar
-	structure IntGrammar = IntGrammar
+        open Array List
+        infix 9 sub
+        open IntGrammar.Grammar IntGrammar Core Graph Look
+        structure Graph = Graph
+        structure Core = Core
+        structure Grammar = IntGrammar.Grammar
+        structure IntGrammar = IntGrammar
 
-	datatype tmpcore = TMPCORE of (item * term list ref) list * int
-	datatype lcore = LCORE of (item * term list) list * int
-	
+        datatype tmpcore = TMPCORE of (item * term list ref) list * int
+        datatype lcore = LCORE of (item * term list) list * int
+        
 
-	 val prLcore =
-	  fn a as (SymbolToString,nontermToString,termToString,print) =>
-	    let val printItem = prItem (SymbolToString,nontermToString,print)
-		val printLookahead = prLook(termToString,print)
-	    in fn (LCORE (items,state)) =>
-		(print "\n";
-		 print "state ";
-		 print (Int.toString state);
-		 print " :\n\n";
-		 List.app (fn (item,lookahead) =>
-			(print "{";
-			 printItem item;
-			 print ",";
-			 printLookahead lookahead;
-			 print "}\n")) items)
-	    end
+         val prLcore =
+          fn a as (SymbolToString,nontermToString,termToString,print) =>
+            let val printItem = prItem (SymbolToString,nontermToString,print)
+                val printLookahead = prLook(termToString,print)
+            in fn (LCORE (items,state)) =>
+                (print "\n";
+                 print "state ";
+                 print (Int.toString state);
+                 print " :\n\n";
+                 List.app (fn (item,lookahead) =>
+                        (print "{";
+                         printItem item;
+                         print ",";
+                         printLookahead lookahead;
+                         print "}\n")) items)
+            end
 
-	exception Lalr of int
+        exception Lalr of int
 
-	structure ItemList = ListOrdSet
-		(struct
-		   type elem = item * term list ref
-		   val eq = fn ((a,_),(b,_)) => eqItem(a,b)
-		   val gt = fn ((a,_),(b,_)) => gtItem(a,b)
-		 end)
+        structure ItemList = ListOrdSet
+                (struct
+                   type elem = item * term list ref
+                   val eq = fn ((a,_),(b,_)) => eqItem(a,b)
+                   val gt = fn ((a,_),(b,_)) => gtItem(a,b)
+                 end)
 
-	structure NontermSet = ListOrdSet
-		(struct
-		   type elem = nonterm
-		   val gt = gtNonterm
-		   val eq = eqNonterm
-		 end)
+        structure NontermSet = ListOrdSet
+                (struct
+                   type elem = nonterm
+                   val gt = gtNonterm
+                   val eq = eqNonterm
+                 end)
 
 (* NTL: nonterms with lookahead *)
 
-	structure NTL = RbOrdSet
-		(struct
-		   type elem = nonterm * term list
-		   val gt = fn ((i,_),(j,_)) => gtNonterm(i,j)
-		   val eq = fn ((i,_),(j,_)) => eqNonterm(i,j)
-		 end)
+        structure NTL = RbOrdSet
+                (struct
+                   type elem = nonterm * term list
+                   val gt = fn ((i,_),(j,_)) => gtNonterm(i,j)
+                   val eq = fn ((i,_),(j,_)) => eqNonterm(i,j)
+                 end)
 
-	val DEBUG = false
+        val DEBUG = false
 
-	val addLookahead  = fn {graph,nullable,first,eop,
-				rules,produces,nonterms,epsProds,
-				print,termToString,nontermToString} =>
-	  let
+        val addLookahead  = fn {graph,nullable,first,eop,
+                                rules,produces,nonterms,epsProds,
+                                print,termToString,nontermToString} =>
+          let
 
-		val eop = Look.make_set eop
+                val eop = Look.make_set eop
 
-		val symbolToString = fn (TERM t) => termToString t
-				      | (NONTERM t) => nontermToString t
+                val symbolToString = fn (TERM t) => termToString t
+                                      | (NONTERM t) => nontermToString t
 
-		val print = if DEBUG then print
-			    else fn _ => ()
+                val print = if DEBUG then print
+                            else fn _ => ()
 
-		val prLook = if DEBUG then prLook (termToString,print)
-			     else fn _ => ()
+                val prLook = if DEBUG then prLook (termToString,print)
+                             else fn _ => ()
 
-		val prNonterm = print o nontermToString
+                val prNonterm = print o nontermToString
 
-		val prRule = if DEBUG
-			      then prRule(symbolToString,nontermToString,print)
-			      else fn _ => ()
+                val prRule = if DEBUG
+                              then prRule(symbolToString,nontermToString,print)
+                              else fn _ => ()
 
-		val printInt = print o (Int.toString : int -> string)
+                val printInt = print o (Int.toString : int -> string)
 
-		val printItem = prItem(symbolToString,nontermToString,print)
+                val printItem = prItem(symbolToString,nontermToString,print)
 
 (* look_pos: position in the rhs of a rule at which we should start placing
    lookahead ref cells, i.e. the minimum place at which A -> x .B y, where
@@ -4658,271 +4658,271 @@
    given by the number of symbols before the place.  The place before the first
    symbol is 0, etc. *)
 
-	     val look_pos =
-		 let val positions = array(length rules,0)
+             val look_pos =
+                 let val positions = array(length rules,0)
 
 (* rule_pos: calculate place in the rhs of a rule at which we should start
    placing lookahead ref cells *)
 
-		      val rule_pos = fn (RULE {rhs,...}) =>
-			case (rev rhs)
-			  of nil => 0
-			   | (TERM t) :: r => length rhs
-			   | (l as (NONTERM n) :: r) =>
+                      val rule_pos = fn (RULE {rhs,...}) =>
+                        case (rev rhs)
+                          of nil => 0
+                           | (TERM t) :: r => length rhs
+                           | (l as (NONTERM n) :: r) =>
 
-			      (* f assumes that everything after n in the
-				 rule has proven to be nullable so far.
-				 Remember that the rhs has been reversed,
-				 implying that this is true initially *)
-				
-					(* A -> .z t B y, where y is nullable *)
+                              (* f assumes that everything after n in the
+                                 rule has proven to be nullable so far.
+                                 Remember that the rhs has been reversed,
+                                 implying that this is true initially *)
+                                
+                                        (* A -> .z t B y, where y is nullable *)
 
-			      let fun f (NONTERM b :: (r as (TERM _ :: _))) =
-					(length r)
+                              let fun f (NONTERM b :: (r as (TERM _ :: _))) =
+                                        (length r)
 
-					(* A -> .z B C y *)
+                                        (* A -> .z B C y *)
 
-				    | f (NONTERM c :: (r as (NONTERM b :: _))) =
-					 if nullable c then f r
-					 else (length r)
+                                    | f (NONTERM c :: (r as (NONTERM b :: _))) =
+                                         if nullable c then f r
+                                         else (length r)
 
-					(* A -> .B y, where y is nullable *)
+                                        (* A -> .B y, where y is nullable *)
 
-				    | f (NONTERM b :: nil) = 0 
-			      in  f l
-			      end
-			     
-		 	val check_rule = fn (rule as RULE {num,...}) =>
-			    let val pos = rule_pos rule
-			    in (print "look_pos: ";
-			 	prRule rule;
-				print " = ";
-				printInt pos;
-				print "\n";
-				update(positions,num,rule_pos rule))
-			    end
-		   in app check_rule rules;
-		    fn RULE{num,...} => (positions sub num)
-		   end
+                                    | f (NONTERM b :: nil) = 0 
+                              in  f l
+                              end
+                             
+                        val check_rule = fn (rule as RULE {num,...}) =>
+                            let val pos = rule_pos rule
+                            in (print "look_pos: ";
+                                prRule rule;
+                                print " = ";
+                                printInt pos;
+                                print "\n";
+                                update(positions,num,rule_pos rule))
+                            end
+                   in app check_rule rules;
+                    fn RULE{num,...} => (positions sub num)
+                   end
 
 (* rest_is_null: true for items of the form A -> x .B y, where y is nullable *)
 
-	     val rest_is_null =
-		 fn (ITEM{rule,dot, rhsAfter=NONTERM _ :: _}) =>
-			 dot >= (look_pos rule)
-		  | _ => false
+             val rest_is_null =
+                 fn (ITEM{rule,dot, rhsAfter=NONTERM _ :: _}) =>
+                         dot >= (look_pos rule)
+                  | _ => false
 
 (* map core to a new core including only items of the form A -> x. or
    A -> x. B y, where y =*=> epsilon.  It also adds epsilon productions to the
    core. Each item is given a ref cell to hold the lookahead nonterminals for
    it.*)
 
-	      val map_core =
-		let val f = fn (item as ITEM {rhsAfter=nil,...},r) =>
-				(item,ref nil) :: r
-			     | (item,r) =>
-				 if (rest_is_null item)
-				    then (item,ref nil)::r
-				    else r
-		in fn (c as CORE (items,state)) =>
-		   let val epsItems =
-			   map  (fn rule=>(ITEM{rule=rule,dot=0,rhsAfter=nil},
-					   ref (nil : term list))
-				) (epsProds c)
-		   in TMPCORE(ItemList.union(List.foldr f [] items,epsItems),state)
-		   end
-		end
+              val map_core =
+                let val f = fn (item as ITEM {rhsAfter=nil,...},r) =>
+                                (item,ref nil) :: r
+                             | (item,r) =>
+                                 if (rest_is_null item)
+                                    then (item,ref nil)::r
+                                    else r
+                in fn (c as CORE (items,state)) =>
+                   let val epsItems =
+                           map  (fn rule=>(ITEM{rule=rule,dot=0,rhsAfter=nil},
+                                           ref (nil : term list))
+                                ) (epsProds c)
+                   in TMPCORE(ItemList.union(List.foldr f [] items,epsItems),state)
+                   end
+                end
 
-	      val new_nodes = map map_core (nodes graph)
+              val new_nodes = map map_core (nodes graph)
 
-	      exception Find
+              exception Find
 
 (* findRef: state * item -> lookahead ref cell for item *)
 
-	      val findRef = 
-		let val states = Array.fromList new_nodes
-		    val dummy = ref nil
-		in fn (state,item) =>
-		    let val TMPCORE (l,_) = states sub state
-		    in case ItemList.find((item,dummy),l)
-				   of SOME (_,look_ref) => look_ref
-				    | NONE => (print "find failed: state ";
-					       printInt state;
-					       print "\nitem =\n";
-					       printItem item;
-					       print "\nactual items =\n";
-					       app (fn (i,_) => (printItem i;
-						    print "\n")) l;
-						raise Find)
-		    end
-		end 
-			
+              val findRef = 
+                let val states = Array.fromList new_nodes
+                    val dummy = ref nil
+                in fn (state,item) =>
+                    let val TMPCORE (l,_) = states sub state
+                    in case ItemList.find((item,dummy),l)
+                                   of SOME (_,look_ref) => look_ref
+                                    | NONE => (print "find failed: state ";
+                                               printInt state;
+                                               print "\nitem =\n";
+                                               printItem item;
+                                               print "\nactual items =\n";
+                                               app (fn (i,_) => (printItem i;
+                                                    print "\n")) l;
+                                                raise Find)
+                    end
+                end 
+                        
 
 (* findRuleRefs: state -> rule -> lookahead refs for rule. *)
-		
-	       val findRuleRefs =
-		 let val shift = shift graph
-		 in fn state =>
-			(* handle epsilon productions *)
-		  fn (rule as RULE {rhs=nil,...}) => 
-			 [findRef(state,ITEM{rule=rule,dot=0,rhsAfter=nil})]
-		   | (rule as RULE {rhs=sym::rest,...}) =>
-		   let	val pos = Int.max(look_pos rule,1)
-			fun scan'(state,nil,pos,result) =
-				findRef(state,ITEM{rule=rule,
-						   dot=pos,
-						   rhsAfter=nil}) :: result
-			  | scan'(state,rhs as sym::rest,pos,result) =
-				scan'(shift(state,sym), rest, pos+1,
-				      findRef(state,ITEM{rule=rule,
-							 dot=pos,
-							 rhsAfter=rhs})::result)
-				
+                
+               val findRuleRefs =
+                 let val shift = shift graph
+                 in fn state =>
+                        (* handle epsilon productions *)
+                  fn (rule as RULE {rhs=nil,...}) => 
+                         [findRef(state,ITEM{rule=rule,dot=0,rhsAfter=nil})]
+                   | (rule as RULE {rhs=sym::rest,...}) =>
+                   let  val pos = Int.max(look_pos rule,1)
+                        fun scan'(state,nil,pos,result) =
+                                findRef(state,ITEM{rule=rule,
+                                                   dot=pos,
+                                                   rhsAfter=nil}) :: result
+                          | scan'(state,rhs as sym::rest,pos,result) =
+                                scan'(shift(state,sym), rest, pos+1,
+                                      findRef(state,ITEM{rule=rule,
+                                                         dot=pos,
+                                                         rhsAfter=rhs})::result)
+                                
 (* find first item of the form A -> x .B y, where y =*=> epsilon and
    x is not epsilon, or A -> x.  use scan' to pick up all refs after this
    point *)
 
-			 fun scan(state,nil,_) =
-			   [findRef(state,ITEM{rule=rule,dot=pos,rhsAfter=nil})]
-			   | scan(state,rhs,0) = scan'(state,rhs,pos,nil)
-			   | scan(state,sym::rest,place) =
-				    scan(shift(state,sym),rest,place-1)
+                         fun scan(state,nil,_) =
+                           [findRef(state,ITEM{rule=rule,dot=pos,rhsAfter=nil})]
+                           | scan(state,rhs,0) = scan'(state,rhs,pos,nil)
+                           | scan(state,sym::rest,place) =
+                                    scan(shift(state,sym),rest,place-1)
 
-		  in scan(shift(state,sym),rest,pos-1)
-		  end
+                  in scan(shift(state,sym),rest,pos-1)
+                  end
 
-	     end
+             end
 
 (* function to compute for some nonterminal n the set of nonterminals A added
    through the closure of nonterminal n such that n =c*=> .A x, where x is
    nullable *)
 
-	      val nonterms_w_null = fn nt =>
-		  let val collect_nonterms = fn n =>
-		    List.foldr (fn (rule as RULE {rhs=rhs as NONTERM n :: _,...},r) =>
-			   (case
-			     (rest_is_null(ITEM {dot=0,rhsAfter=rhs,rule=rule}))
-				 of true => n :: r
-				  | false => r)
-			   | (_,r) => r) [] (produces n)
-		       fun dfs(a as (n,r)) =
-			 if (NontermSet.exists a) then r 
-			 else List.foldr dfs (NontermSet.insert(n,r))
-				(collect_nonterms n)
-		  in dfs(nt,NontermSet.empty)
-		  end
+              val nonterms_w_null = fn nt =>
+                  let val collect_nonterms = fn n =>
+                    List.foldr (fn (rule as RULE {rhs=rhs as NONTERM n :: _,...},r) =>
+                           (case
+                             (rest_is_null(ITEM {dot=0,rhsAfter=rhs,rule=rule}))
+                                 of true => n :: r
+                                  | false => r)
+                           | (_,r) => r) [] (produces n)
+                       fun dfs(a as (n,r)) =
+                         if (NontermSet.exists a) then r 
+                         else List.foldr dfs (NontermSet.insert(n,r))
+                                (collect_nonterms n)
+                  in dfs(nt,NontermSet.empty)
+                  end
 
-		val nonterms_w_null =
-		   let val data = array(nonterms,NontermSet.empty)
-		       fun f n = if n=nonterms then ()
-				 else (update(data,n,nonterms_w_null (NT n));
-				       f (n+1))
-		   in (f 0; fn (NT nt) => data sub nt)
-		   end
+                val nonterms_w_null =
+                   let val data = array(nonterms,NontermSet.empty)
+                       fun f n = if n=nonterms then ()
+                                 else (update(data,n,nonterms_w_null (NT n));
+                                       f (n+1))
+                   in (f 0; fn (NT nt) => data sub nt)
+                   end
 
 (* look_info: for some nonterminal n the set of nonterms A added
    through the closure of the nonterminal such that n =c+=> .Ax and the
    lookahead accumlated for each nonterm A *)
 
-		val look_info = fn nt =>
-		   let val collect_nonterms = fn n =>
-		      List.foldr (fn (RULE {rhs=NONTERM n :: t,...},r) =>
-			     (case NTL.find ((n,nil),r)
-			      of SOME (key,data) =>
-			         NTL.insert((n,Look.union(data,first t)),r)
-			       | NONE => NTL.insert ((n,first t),r))
-			     | (_,r) => r)
-		            NTL.empty (produces n)
-			fun dfs(a as ((key1,data1),r)) =
-			  case (NTL.find a)
-			   of SOME (_,data2) =>
-			       NTL.insert((key1,Look.union(data1,data2)),r)
-			    | NONE => NTL.fold dfs (collect_nonterms key1)
-						   (NTL.insert a)
-		    in dfs((nt,nil),NTL.empty)
-		    end
+                val look_info = fn nt =>
+                   let val collect_nonterms = fn n =>
+                      List.foldr (fn (RULE {rhs=NONTERM n :: t,...},r) =>
+                             (case NTL.find ((n,nil),r)
+                              of SOME (key,data) =>
+                                 NTL.insert((n,Look.union(data,first t)),r)
+                               | NONE => NTL.insert ((n,first t),r))
+                             | (_,r) => r)
+                            NTL.empty (produces n)
+                        fun dfs(a as ((key1,data1),r)) =
+                          case (NTL.find a)
+                           of SOME (_,data2) =>
+                               NTL.insert((key1,Look.union(data1,data2)),r)
+                            | NONE => NTL.fold dfs (collect_nonterms key1)
+                                                   (NTL.insert a)
+                    in dfs((nt,nil),NTL.empty)
+                    end
 
-		val look_info = 
-		  if not DEBUG then look_info
-		  else fn nt =>
-		       (print "look_info of "; prNonterm nt; print "=\n";
-			let val info = look_info nt
-			in (NTL.app (fn (nt,lookahead) =>
-				    (prNonterm nt; print ": "; prLook lookahead;
-				     print "\n\n")) info;
-			   info)
-			end)
+                val look_info = 
+                  if not DEBUG then look_info
+                  else fn nt =>
+                       (print "look_info of "; prNonterm nt; print "=\n";
+                        let val info = look_info nt
+                        in (NTL.app (fn (nt,lookahead) =>
+                                    (prNonterm nt; print ": "; prLook lookahead;
+                                     print "\n\n")) info;
+                           info)
+                        end)
 
 (* prop_look: propagate lookaheads for nonterms added in the closure of a
    nonterm.  Lookaheads must be propagated from each nonterminal m to
    all nonterminals { n | m =c+=> nx, where x=*=>epsilon} *)
 
-		  val prop_look = fn ntl =>
-		    let val upd_lookhd = fn new_look => fn (nt,r) =>
-			  case NTL.find ((nt,new_look),r)
-			  of SOME (_,old_look) =>
-			     NTL.insert((nt, Look.union(new_look,old_look)),r)
-			   | NONE => raise (Lalr 241)
-		         val upd_nonterm = fn ((nt,look),r) =>
-			   NontermSet.fold (upd_lookhd look)
-					   (nonterms_w_null nt) r
-		     in NTL.fold upd_nonterm ntl ntl
-		     end
+                  val prop_look = fn ntl =>
+                    let val upd_lookhd = fn new_look => fn (nt,r) =>
+                          case NTL.find ((nt,new_look),r)
+                          of SOME (_,old_look) =>
+                             NTL.insert((nt, Look.union(new_look,old_look)),r)
+                           | NONE => raise (Lalr 241)
+                         val upd_nonterm = fn ((nt,look),r) =>
+                           NontermSet.fold (upd_lookhd look)
+                                           (nonterms_w_null nt) r
+                     in NTL.fold upd_nonterm ntl ntl
+                     end
 
-		val prop_look = 
-		  if not DEBUG then prop_look
-		  else fn ntl =>
-		    (print "prop_look =\n";
-		     let val info = prop_look ntl
-		     in (NTL.app (fn (nt,lookahead) =>
-				    (prNonterm nt;
-				     print ": ";
-				     prLook lookahead;
-				     print "\n\n")) info; info)
-		     end)
+                val prop_look = 
+                  if not DEBUG then prop_look
+                  else fn ntl =>
+                    (print "prop_look =\n";
+                     let val info = prop_look ntl
+                     in (NTL.app (fn (nt,lookahead) =>
+                                    (prNonterm nt;
+                                     print ": ";
+                                     prLook lookahead;
+                                     print "\n\n")) info; info)
+                     end)
 
 (* now put the information from these functions together.  Create a function
    which takes a nonterminal n and returns a list of triplets of
-	 (a nonterm added through closure,
-	  the lookahead for the nonterm,
-	  whether the nonterm should include the lookahead for the nonterminal
-	  whose closure is being taken (i.e. first(y) for an item j of the
-	  form A -> x .n y and lookahead(j) if y =*=> epsilon)
+         (a nonterm added through closure,
+          the lookahead for the nonterm,
+          whether the nonterm should include the lookahead for the nonterminal
+          whose closure is being taken (i.e. first(y) for an item j of the
+          form A -> x .n y and lookahead(j) if y =*=> epsilon)
 *)
 
-		 val closure_nonterms =
-		   let val data =
-			  array(nonterms,nil: (nonterm * term list * bool) list)
-		       val do_nonterm = fn i =>
-			let val nonterms_followed_by_null =
-				nonterms_w_null i
-			    val nonterms_added_through_closure = 
-			      NTL.make_list (prop_look (look_info i))
-			    val result =
-			    map (fn (nt,l) =>
-			 (nt,l,NontermSet.exists (nt,nonterms_followed_by_null))
-				) nonterms_added_through_closure
-			 in if DEBUG then
-			       (print "closure_nonterms = ";
-				prNonterm i;
-				print "\n";
-				app (fn (nt,look,nullable) =>
-				  (prNonterm nt;
-				   print ":";
-				   prLook look;
-				   case nullable
-				     of false => print "(false)\n"
-				      | true => print "(true)\n")) result;
-				print "\n")
-			     else ();
-			     result
-			 end
-		        fun f i =
-			  if i=nonterms then ()
-			  else (update(data,i,do_nonterm (NT i)); f (i+1))
-			val _ = f 0
-		    in fn (NT i) => data sub i
-		    end
+                 val closure_nonterms =
+                   let val data =
+                          array(nonterms,nil: (nonterm * term list * bool) list)
+                       val do_nonterm = fn i =>
+                        let val nonterms_followed_by_null =
+                                nonterms_w_null i
+                            val nonterms_added_through_closure = 
+                              NTL.make_list (prop_look (look_info i))
+                            val result =
+                            map (fn (nt,l) =>
+                         (nt,l,NontermSet.exists (nt,nonterms_followed_by_null))
+                                ) nonterms_added_through_closure
+                         in if DEBUG then
+                               (print "closure_nonterms = ";
+                                prNonterm i;
+                                print "\n";
+                                app (fn (nt,look,nullable) =>
+                                  (prNonterm nt;
+                                   print ":";
+                                   prLook look;
+                                   case nullable
+                                     of false => print "(false)\n"
+                                      | true => print "(true)\n")) result;
+                                print "\n")
+                             else ();
+                             result
+                         end
+                        fun f i =
+                          if i=nonterms then ()
+                          else (update(data,i,do_nonterm (NT i)); f (i+1))
+                        val _ = f 0
+                    in fn (NT i) => data sub i
+                    end
 
 (* add_nonterm_lookahead: Add lookahead to all completion items for rules added
    when the closure of a given nonterm in some state is taken.  It returns
@@ -4932,105 +4932,105 @@
    A -> x.
 *)
 
-		val add_nonterm_lookahead = fn (nt,state) =>
-		  let val f = fn ((nt,lookahead,nullable),r) =>
-			let val refs = map (findRuleRefs state) (produces nt)
-			    val refs = List.concat refs
-			    val _ = app (fn r =>
-				     r := (Look.union (!r,lookahead))) refs
-			in if nullable then refs @ r else r
-			end
-		 in List.foldr f [] (closure_nonterms nt)
-		 end
+                val add_nonterm_lookahead = fn (nt,state) =>
+                  let val f = fn ((nt,lookahead,nullable),r) =>
+                        let val refs = map (findRuleRefs state) (produces nt)
+                            val refs = List.concat refs
+                            val _ = app (fn r =>
+                                     r := (Look.union (!r,lookahead))) refs
+                        in if nullable then refs @ r else r
+                        end
+                 in List.foldr f [] (closure_nonterms nt)
+                 end
 
 (* scan_core: Scan a core for all items of the form A -> x .B y.  Applies
    add_nonterm_lookahead to each such B, and then merges first(y) into
    the list of refs returned by add_nonterm_lookahead.  It returns
    a list of ref * ref list for all the items where y =*=> epsilon *)
 
-		val scan_core = fn (CORE (l,state)) =>
-		  let fun f ((item as ITEM{rhsAfter= NONTERM b :: y,
-					   dot,rule})::t,r) =
-			(case (add_nonterm_lookahead(b,state))
-			  of nil => r
-			   | l =>
-			    let val first_y = first y
-			        val newr  = if dot >= (look_pos rule)
-					then (findRef(state,item),l)::r
-					else r
-			    in (app (fn r =>
-					 r := Look.union(!r,first_y)) l;
-			        f (t,newr))
-			    end)
-			| f (_ :: t,r) = f (t,r)
-			| f (nil,r) = r
-		  in f (l,nil)
-		  end
+                val scan_core = fn (CORE (l,state)) =>
+                  let fun f ((item as ITEM{rhsAfter= NONTERM b :: y,
+                                           dot,rule})::t,r) =
+                        (case (add_nonterm_lookahead(b,state))
+                          of nil => r
+                           | l =>
+                            let val first_y = first y
+                                val newr  = if dot >= (look_pos rule)
+                                        then (findRef(state,item),l)::r
+                                        else r
+                            in (app (fn r =>
+                                         r := Look.union(!r,first_y)) l;
+                                f (t,newr))
+                            end)
+                        | f (_ :: t,r) = f (t,r)
+                        | f (nil,r) = r
+                  in f (l,nil)
+                  end
 
 (* add end-of-parse symbols to set of items consisting of all items
    immediately derived from the start symbol *)
 
-		val add_eop = fn (c as CORE (l,state),eop) =>
-		  let fun f (item as ITEM {rule,dot,...}) =
-		    let val refs = findRuleRefs state rule
-		    in
+                val add_eop = fn (c as CORE (l,state),eop) =>
+                  let fun f (item as ITEM {rule,dot,...}) =
+                    let val refs = findRuleRefs state rule
+                    in
 
 (* first take care of kernal items.  Add the end-of-parse symbols to
    the lookahead sets for these items.  Epsilon productions of the
    start symbol do not need to be handled specially because they will
    be in the kernal also *)
 
-		       app (fn r => r := Look.union(!r,eop)) refs;
+                       app (fn r => r := Look.union(!r,eop)) refs;
 
 (* now take care of closure items.  These are all nonterminals C which
    have a derivation S =+=> .C x, where x is nullable *)
 
-		       if dot >= (look_pos rule) then
-		       	  case item
-			  of ITEM{rhsAfter=NONTERM b :: _,...} =>
-			     (case add_nonterm_lookahead(b,state)
-			      of nil => ()
-			       | l => app (fn r => r := Look.union(!r,eop)) l)
-			   | _ => ()
-		       else ()
-		    end
-		  in app f l
-		  end
+                       if dot >= (look_pos rule) then
+                          case item
+                          of ITEM{rhsAfter=NONTERM b :: _,...} =>
+                             (case add_nonterm_lookahead(b,state)
+                              of nil => ()
+                               | l => app (fn r => r := Look.union(!r,eop)) l)
+                           | _ => ()
+                       else ()
+                    end
+                  in app f l
+                  end
 
-		val iterate = fn l =>
-		   let fun f lookahead (nil,done) = done
-			 | f lookahead (h::t,done) =
-			    let val old = !h
-			    in h := Look.union (old,lookahead);
-			       if (length (!h)) <> (length old)
-					 then f lookahead (t,false)
-					 else f lookahead(t,done)
-			    end
-		       fun g ((from,to)::rest,done) =
-			let val new_done = f (!from) (to,done)
-			in g (rest,new_done)
-			end
-			 | g (nil,done) = done
-		       fun loop true = ()
-			 | loop false = loop (g (l,true))
-		   in loop false
-		   end
+                val iterate = fn l =>
+                   let fun f lookahead (nil,done) = done
+                         | f lookahead (h::t,done) =
+                            let val old = !h
+                            in h := Look.union (old,lookahead);
+                               if (length (!h)) <> (length old)
+                                         then f lookahead (t,false)
+                                         else f lookahead(t,done)
+                            end
+                       fun g ((from,to)::rest,done) =
+                        let val new_done = f (!from) (to,done)
+                        in g (rest,new_done)
+                        end
+                         | g (nil,done) = done
+                       fun loop true = ()
+                         | loop false = loop (g (l,true))
+                   in loop false
+                   end
 
-		val lookahead = List.concat (map scan_core (nodes graph))
+                val lookahead = List.concat (map scan_core (nodes graph))
 
 (* used to scan the item list of a TMPCORE and remove the items not
    being reduced *)
 
-		val create_lcore_list =
-			fn ((item as ITEM {rhsAfter=nil,...},ref l),r) =>
-				(item,l) :: r
-			 | (_,r) => r
+                val create_lcore_list =
+                        fn ((item as ITEM {rhsAfter=nil,...},ref l),r) =>
+                                (item,l) :: r
+                         | (_,r) => r
 
-	in  add_eop(Graph.core graph 0,eop);
-	    iterate lookahead;
-	    map (fn (TMPCORE (l,state)) =>
-		       LCORE (List.foldr create_lcore_list [] l, state)) new_nodes
-	end
+        in  add_eop(Graph.core graph 0,eop);
+            iterate lookahead;
+            map (fn (TMPCORE (l,state)) =>
+                       LCORE (List.foldr create_lcore_list [] l, state)) new_nodes
+        end
 end;
 (* ML-Yacc Parser Generator (c) 1989 Andrew W. Appel, David R. Tarditi 
  *
@@ -5049,110 +5049,110 @@
  *)
 
 functor mkMakeLrTable (structure IntGrammar : INTGRAMMAR
-		     structure LrTable : LR_TABLE
-		     sharing type LrTable.term = IntGrammar.Grammar.term
-		     sharing type LrTable.nonterm = IntGrammar.Grammar.nonterm
-		    ) : MAKE_LR_TABLE = 
+                     structure LrTable : LR_TABLE
+                     sharing type LrTable.term = IntGrammar.Grammar.term
+                     sharing type LrTable.nonterm = IntGrammar.Grammar.nonterm
+                    ) : MAKE_LR_TABLE = 
    struct 
         open Array List
-	infix 9 sub
-	structure Core = mkCore(structure IntGrammar = IntGrammar)
-	structure CoreUtils = mkCoreUtils(structure IntGrammar = IntGrammar
-				  	  structure Core = Core)
-	structure Graph = mkGraph(structure IntGrammar = IntGrammar
-			  	  structure Core = Core
-			  	  structure CoreUtils = CoreUtils)
-	structure Look = mkLook(structure IntGrammar = IntGrammar)
-	structure Lalr = mkLalr(structure IntGrammar = IntGrammar
-				structure Core = Core
-				structure Graph = Graph
-				structure Look = Look)
-	structure LrTable = LrTable
-	structure IntGrammar = IntGrammar
-	structure Grammar = IntGrammar.Grammar
-	structure GotoList = ListOrdSet
-		(struct
-		   type elem = Grammar.nonterm * LrTable.state
-		   val eq = fn ((Grammar.NT a,_),(Grammar.NT b,_)) => a=b
-		   val gt = fn ((Grammar.NT a,_),(Grammar.NT b,_)) => a>b
-		end)
-	structure Errs : LR_ERRS =
-	    struct
-		structure LrTable = LrTable
-		datatype err = RR of LrTable.term * LrTable.state * int * int
-			     | SR of LrTable.term * LrTable.state * int
-			     | NOT_REDUCED of int
-			     | NS of LrTable.term * int
-			     | START of int
+        infix 9 sub
+        structure Core = mkCore(structure IntGrammar = IntGrammar)
+        structure CoreUtils = mkCoreUtils(structure IntGrammar = IntGrammar
+                                          structure Core = Core)
+        structure Graph = mkGraph(structure IntGrammar = IntGrammar
+                                  structure Core = Core
+                                  structure CoreUtils = CoreUtils)
+        structure Look = mkLook(structure IntGrammar = IntGrammar)
+        structure Lalr = mkLalr(structure IntGrammar = IntGrammar
+                                structure Core = Core
+                                structure Graph = Graph
+                                structure Look = Look)
+        structure LrTable = LrTable
+        structure IntGrammar = IntGrammar
+        structure Grammar = IntGrammar.Grammar
+        structure GotoList = ListOrdSet
+                (struct
+                   type elem = Grammar.nonterm * LrTable.state
+                   val eq = fn ((Grammar.NT a,_),(Grammar.NT b,_)) => a=b
+                   val gt = fn ((Grammar.NT a,_),(Grammar.NT b,_)) => a>b
+                end)
+        structure Errs : LR_ERRS =
+            struct
+                structure LrTable = LrTable
+                datatype err = RR of LrTable.term * LrTable.state * int * int
+                             | SR of LrTable.term * LrTable.state * int
+                             | NOT_REDUCED of int
+                             | NS of LrTable.term * int
+                             | START of int
 
-	        val summary = fn l =>
-		   let val numRR = ref 0
-		       val numSR = ref 0
-		       val numSTART = ref 0
-		       val numNOT_REDUCED = ref 0
-		       val numNS = ref 0
-		       fun loop (h::t) = 
-		       (case h
-		         of RR _ => numRR := !numRR+1
-			  | SR _ => numSR := !numSR+1
-			  | START _ => numSTART := !numSTART+1
-			  | NOT_REDUCED _ => numNOT_REDUCED := !numNOT_REDUCED+1
-			  | NS _ => numNS := !numNS+1; loop t)
-		      | loop nil = {rr = !numRR, sr = !numSR,
-			        start = !numSTART,
-			        not_reduced = !numNOT_REDUCED,
-			        nonshift = !numNS}
-		  in loop l
-		  end
+                val summary = fn l =>
+                   let val numRR = ref 0
+                       val numSR = ref 0
+                       val numSTART = ref 0
+                       val numNOT_REDUCED = ref 0
+                       val numNS = ref 0
+                       fun loop (h::t) = 
+                       (case h
+                         of RR _ => numRR := !numRR+1
+                          | SR _ => numSR := !numSR+1
+                          | START _ => numSTART := !numSTART+1
+                          | NOT_REDUCED _ => numNOT_REDUCED := !numNOT_REDUCED+1
+                          | NS _ => numNS := !numNS+1; loop t)
+                      | loop nil = {rr = !numRR, sr = !numSR,
+                                start = !numSTART,
+                                not_reduced = !numNOT_REDUCED,
+                                nonshift = !numNS}
+                  in loop l
+                  end
 
-		  val printSummary = fn say => fn l =>
-		   let val {rr,sr,start,
-			    not_reduced,nonshift} = summary l
-		       val say_plural = fn (i,s) =>
-			  (say (Int.toString i); say " ";
-			   case i
-			     of 1 => (say s)
-			      | _ => (say s; say "s"))
-		       val say_error = fn (args as (i,s)) =>
-			  case i
-			  of 0 => ()
-			   | i => (say_plural args; say "\n")
-		   in say_error(rr,"reduce/reduce conflict");
-		      say_error(sr,"shift/reduce conflict");
-		      if nonshift<>0 then
-			   (say "non-shiftable terminal used on the rhs of ";
-			   say_plural(start,"rule"); say "\n")
-		      else ();
-		      if start<>0 then (say "start symbol used on the rhs of ";
-					say_plural(start,"rule"); say "\n")
-		      else ();
-		      if not_reduced<>0 then (say_plural(not_reduced,"rule");
-					      say " not reduced\n")
-		      else ()
-		end
-	    end
+                  val printSummary = fn say => fn l =>
+                   let val {rr,sr,start,
+                            not_reduced,nonshift} = summary l
+                       val say_plural = fn (i,s) =>
+                          (say (Int.toString i); say " ";
+                           case i
+                             of 1 => (say s)
+                              | _ => (say s; say "s"))
+                       val say_error = fn (args as (i,s)) =>
+                          case i
+                          of 0 => ()
+                           | i => (say_plural args; say "\n")
+                   in say_error(rr,"reduce/reduce conflict");
+                      say_error(sr,"shift/reduce conflict");
+                      if nonshift<>0 then
+                           (say "non-shiftable terminal used on the rhs of ";
+                           say_plural(start,"rule"); say "\n")
+                      else ();
+                      if start<>0 then (say "start symbol used on the rhs of ";
+                                        say_plural(start,"rule"); say "\n")
+                      else ();
+                      if not_reduced<>0 then (say_plural(not_reduced,"rule");
+                                              say " not reduced\n")
+                      else ()
+                end
+            end
 
 
-	open IntGrammar Grammar Errs LrTable Core 
+        open IntGrammar Grammar Errs LrTable Core 
 
 (* rules for resolving conflicts:
 
-	shift/reduce:
+        shift/reduce:
 
-		  If either the terminal or the rule has no
-		  precedence, a shift/reduce conflict is reported.
-		  A shift is chosen for the table.
+                  If either the terminal or the rule has no
+                  precedence, a shift/reduce conflict is reported.
+                  A shift is chosen for the table.
 
-		  If both have precedences, the action with the
-		  higher precedence is chosen.
+                  If both have precedences, the action with the
+                  higher precedence is chosen.
 
-		  If the precedences are equal, neither the
-		  shift nor the reduce is chosen.
+                  If the precedences are equal, neither the
+                  shift nor the reduce is chosen.
 
       reduce/reduce:
 
-		  A reduce/reduce conflict is reported.  The lowest
-		  numbered rule is chosen for reduction.
+                  A reduce/reduce conflict is reported.  The lowest
+                  numbered rule is chosen for reduction.
 *)
 
 
@@ -5174,11 +5174,11 @@
 can be compared against them.  All reduce/reduce conflicts, however,
 can be generated given a list of the reduce/reduce conflicts generated
 by this method.
-	
+        
    This can be done by taking the transitive closure of the relation given
 by the list.  If reduce/reduce (a,b) and reduce/reduce (b,c)  are true,
 then reduce/reduce (a,c) is true.   The relation is symmetric and transitive.
-		  
+                  
 Adding shifts:
 
     Finally scan the list merging in shifts and resolving conflicts
@@ -5194,241 +5194,241 @@
 *)
 
     val mergeReduces =
-	let val merge = fn state =>
-	  let fun f (j as (pair1 as (T t1,action1)) :: r1,
-		     k as (pair2 as (T t2,action2)) :: r2,result,errs) =
-	  	    if t1 < t2 then f(r1,k,pair1::result,errs)
-		    else if t1 > t2 then f(j,r2,pair2::result,errs)
-		    else let val REDUCE num1 = action1
-			     val REDUCE num2 = action2
-			     val errs = RR(T t1,state,num1,num2) :: errs
-			     val action = if num1 < num2 then pair1 else pair2
-		         in f(r1,r2,action::result,errs)
-		          end
-		| f (nil,nil,result,errs) = (rev result,errs)
-		| f (pair1::r,nil,result,errs) = f(r,nil,pair1::result,errs)
-		| f (nil,pair2 :: r,result,errs) = f(nil,r,pair2::result,errs)
-	    in f
-	    end
-	 in fn state => fn ((ITEM {rule=RULE {rulenum,...},...}, lookahead),
-		 (reduces,errs)) =>
-		let val action = REDUCE rulenum
-		    val actions = map (fn a=>(a,action)) lookahead
-		in case reduces
-		   of nil => (actions,errs)
-		    | _ =>  merge state (reduces,actions,nil,errs)
-		end
-	 end
+        let val merge = fn state =>
+          let fun f (j as (pair1 as (T t1,action1)) :: r1,
+                     k as (pair2 as (T t2,action2)) :: r2,result,errs) =
+                    if t1 < t2 then f(r1,k,pair1::result,errs)
+                    else if t1 > t2 then f(j,r2,pair2::result,errs)
+                    else let val REDUCE num1 = action1
+                             val REDUCE num2 = action2
+                             val errs = RR(T t1,state,num1,num2) :: errs
+                             val action = if num1 < num2 then pair1 else pair2
+                         in f(r1,r2,action::result,errs)
+                          end
+                | f (nil,nil,result,errs) = (rev result,errs)
+                | f (pair1::r,nil,result,errs) = f(r,nil,pair1::result,errs)
+                | f (nil,pair2 :: r,result,errs) = f(nil,r,pair2::result,errs)
+            in f
+            end
+         in fn state => fn ((ITEM {rule=RULE {rulenum,...},...}, lookahead),
+                 (reduces,errs)) =>
+                let val action = REDUCE rulenum
+                    val actions = map (fn a=>(a,action)) lookahead
+                in case reduces
+                   of nil => (actions,errs)
+                    | _ =>  merge state (reduces,actions,nil,errs)
+                end
+         end
 
   val computeActions = fn (rules,precedence,graph,defaultReductions) =>
      
     let val rulePrec =
-	  let val precData = array(length rules,NONE : int option)
-	  in app (fn RULE {rulenum=r,precedence=p,...} => update(precData,r,p))
-	     rules;
-	     fn i => precData sub i
-	  end
+          let val precData = array(length rules,NONE : int option)
+          in app (fn RULE {rulenum=r,precedence=p,...} => update(precData,r,p))
+             rules;
+             fn i => precData sub i
+          end
 
-	fun mergeShifts(state,shifts,nil) = (shifts,nil)
-	  | mergeShifts(state,nil,reduces) = (reduces,nil)
-	  | mergeShifts(state,shifts,reduces) =
-	  let fun f(shifts as (pair1 as (T t1,_)) :: r1,
-			reduces as (pair2 as (T t2,action)) :: r2,
-			result,errs) =
-		if t1 < t2 then f(r1,reduces,pair1 :: result,errs)
-		else if t1 > t2 then f(shifts,r2,pair2 :: result,errs)
-		else let val REDUCE rulenum = action
-			 val (term1,_) = pair1
-		     in case (precedence term1,rulePrec rulenum)
-		      of (SOME i,SOME j) =>
-		         if i>j then f(r1,r2,pair1 :: result,errs)
-		         else if j>i then f(r1,r2,pair2 :: result,errs)
-			 else f(r1,r2,(T t1, ERROR)::result,errs)
-		       | (_,_) =>
-			   f(r1,r2,pair1 :: result,
-			     SR (term1,state,rulenum)::errs)
-		     end
-	   	| f (nil,nil,result,errs) = (rev result,errs)
-	   	| f (nil,h::t,result,errs) =
-		   	f (nil,t,h::result,errs)
-	   	| f (h::t,nil,result,errs) = 
-		   	f (t,nil,h::result,errs)
-	  in f(shifts,reduces,nil,nil)
-	  end
+        fun mergeShifts(state,shifts,nil) = (shifts,nil)
+          | mergeShifts(state,nil,reduces) = (reduces,nil)
+          | mergeShifts(state,shifts,reduces) =
+          let fun f(shifts as (pair1 as (T t1,_)) :: r1,
+                        reduces as (pair2 as (T t2,action)) :: r2,
+                        result,errs) =
+                if t1 < t2 then f(r1,reduces,pair1 :: result,errs)
+                else if t1 > t2 then f(shifts,r2,pair2 :: result,errs)
+                else let val REDUCE rulenum = action
+                         val (term1,_) = pair1
+                     in case (precedence term1,rulePrec rulenum)
+                      of (SOME i,SOME j) =>
+                         if i>j then f(r1,r2,pair1 :: result,errs)
+                         else if j>i then f(r1,r2,pair2 :: result,errs)
+                         else f(r1,r2,(T t1, ERROR)::result,errs)
+                       | (_,_) =>
+                           f(r1,r2,pair1 :: result,
+                             SR (term1,state,rulenum)::errs)
+                     end
+                | f (nil,nil,result,errs) = (rev result,errs)
+                | f (nil,h::t,result,errs) =
+                        f (nil,t,h::result,errs)
+                | f (h::t,nil,result,errs) = 
+                        f (t,nil,h::result,errs)
+          in f(shifts,reduces,nil,nil)
+          end
 
-	fun mapCore ({edge=symbol,to=CORE (_,state)}::r,shifts,gotos) =
-	        (case symbol
-		 of (TERM t) => mapCore (r,(t,SHIFT(STATE state))::shifts,gotos)
-		  | (NONTERM nt) => mapCore(r,shifts,(nt,STATE state)::gotos)
-		)
-	  | mapCore (nil,shifts,gotos) = (rev shifts,rev gotos)
+        fun mapCore ({edge=symbol,to=CORE (_,state)}::r,shifts,gotos) =
+                (case symbol
+                 of (TERM t) => mapCore (r,(t,SHIFT(STATE state))::shifts,gotos)
+                  | (NONTERM nt) => mapCore(r,shifts,(nt,STATE state)::gotos)
+                )
+          | mapCore (nil,shifts,gotos) = (rev shifts,rev gotos)
 
-	fun pruneError ((_,ERROR)::rest) = pruneError rest
-	  | pruneError (a::rest) = a :: pruneError rest
-	  | pruneError nil = nil
+        fun pruneError ((_,ERROR)::rest) = pruneError rest
+          | pruneError (a::rest) = a :: pruneError rest
+          | pruneError nil = nil
 
   in fn (Lalr.LCORE (reduceItems,state),c as CORE (shiftItems,state')) =>
-	if DEBUG andalso (state <> state') then
-		 let exception MkTable in raise MkTable end
-	else
-	 let val (shifts,gotos) = mapCore (Graph.edges(c,graph),nil,nil)
-	     val tableState = STATE state
-	 in case reduceItems
-		of nil => ((shifts,ERROR),gotos,nil)
-		 | h :: nil =>
-		    let val (ITEM {rule=RULE {rulenum,...},...}, l) = h
-		        val (reduces,_) = mergeReduces tableState (h,(nil,nil))
-			val (actions,errs) = mergeShifts(tableState,
-							 shifts,reduces)
-			val actions' = pruneError actions
-		        val (actions,default) =
-			   let fun hasReduce (nil,actions) = 
-			                      (rev actions,REDUCE rulenum)
-				 | hasReduce ((a as (_,SHIFT _)) :: r,actions) =
-						hasReduce(r,a::actions)
-				 | hasReduce (_ :: r,actions) =
-						 hasReduce(r,actions)
-			       fun loop (nil,actions) = (rev actions,ERROR)
-				 | loop ((a as (_,SHIFT _)) :: r,actions) =
-						loop(r,a::actions)
-				 | loop ((a as (_,REDUCE _)) :: r,actions) =
-						hasReduce(r,actions)
-				 | loop (_ :: r,actions) = loop(r,actions)
-			  in if defaultReductions 
-			       andalso length actions = length actions'
-			     then loop(actions,nil)
-			     else (actions',ERROR)
-			  end
-		     in ((actions,default), gotos,errs)
-		    end
-		 | l =>
-		  let val (reduces,errs1) =
-			 List.foldr (mergeReduces tableState) (nil,nil) l
-		      val (actions,errs2) =
-			 mergeShifts(tableState,shifts,reduces)
-	     	  in ((pruneError actions,ERROR),gotos,errs1@errs2)
-		  end
-	 end
-   end			
+        if DEBUG andalso (state <> state') then
+                 let exception MkTable in raise MkTable end
+        else
+         let val (shifts,gotos) = mapCore (Graph.edges(c,graph),nil,nil)
+             val tableState = STATE state
+         in case reduceItems
+                of nil => ((shifts,ERROR),gotos,nil)
+                 | h :: nil =>
+                    let val (ITEM {rule=RULE {rulenum,...},...}, l) = h
+                        val (reduces,_) = mergeReduces tableState (h,(nil,nil))
+                        val (actions,errs) = mergeShifts(tableState,
+                                                         shifts,reduces)
+                        val actions' = pruneError actions
+                        val (actions,default) =
+                           let fun hasReduce (nil,actions) = 
+                                              (rev actions,REDUCE rulenum)
+                                 | hasReduce ((a as (_,SHIFT _)) :: r,actions) =
+                                                hasReduce(r,a::actions)
+                                 | hasReduce (_ :: r,actions) =
+                                                 hasReduce(r,actions)
+                               fun loop (nil,actions) = (rev actions,ERROR)
+                                 | loop ((a as (_,SHIFT _)) :: r,actions) =
+                                                loop(r,a::actions)
+                                 | loop ((a as (_,REDUCE _)) :: r,actions) =
+                                                hasReduce(r,actions)
+                                 | loop (_ :: r,actions) = loop(r,actions)
+                          in if defaultReductions 
+                               andalso length actions = length actions'
+                             then loop(actions,nil)
+                             else (actions',ERROR)
+                          end
+                     in ((actions,default), gotos,errs)
+                    end
+                 | l =>
+                  let val (reduces,errs1) =
+                         List.foldr (mergeReduces tableState) (nil,nil) l
+                      val (actions,errs2) =
+                         mergeShifts(tableState,shifts,reduces)
+                  in ((pruneError actions,ERROR),gotos,errs1@errs2)
+                  end
+         end
+   end                  
 
-	val mkTable = fn (grammar as GRAMMAR{rules,terms,nonterms,start,
-				  precedence,termToString,noshift,
-				  nontermToString,eop},defaultReductions) =>
-	     let val symbolToString = fn (TERM t) => termToString t
-				       | (NONTERM nt) => nontermToString nt
-	         val {rules,graph,produces,epsProds,...} = Graph.mkGraph grammar
-		 val {nullable,first} =
-		   Look.mkFuncs{rules=rules,produces=produces,nonterms=nonterms}
-		 val lcores = Lalr.addLookahead
-					    {graph=graph,
-					     nullable=nullable,
-					     produces=produces,
-					     eop=eop,
-					     nonterms=nonterms,
-					     first=first,
-					     rules=rules,
-					     epsProds=epsProds,
-					     print=(fn s=>TextIO.output(TextIO.stdOut,s)),
-					     termToString = termToString,
-					     nontermToString = nontermToString}
+        val mkTable = fn (grammar as GRAMMAR{rules,terms,nonterms,start,
+                                  precedence,termToString,noshift,
+                                  nontermToString,eop},defaultReductions) =>
+             let val symbolToString = fn (TERM t) => termToString t
+                                       | (NONTERM nt) => nontermToString nt
+                 val {rules,graph,produces,epsProds,...} = Graph.mkGraph grammar
+                 val {nullable,first} =
+                   Look.mkFuncs{rules=rules,produces=produces,nonterms=nonterms}
+                 val lcores = Lalr.addLookahead
+                                            {graph=graph,
+                                             nullable=nullable,
+                                             produces=produces,
+                                             eop=eop,
+                                             nonterms=nonterms,
+                                             first=first,
+                                             rules=rules,
+                                             epsProds=epsProds,
+                                             print=(fn s=>TextIO.output(TextIO.stdOut,s)),
+                                             termToString = termToString,
+                                             nontermToString = nontermToString}
 
-		  fun zip (h::t,h'::t') = (h,h') :: zip(t,t')
-		    | zip (nil,nil) = nil
-		    | zip _ = let exception MkTable in raise MkTable end
-		  
-		  fun unzip l =
-		   let fun f ((a,b,c)::r,j,k,l) = f(r,a::j,b::k,c::l)
-			 | f (nil,j,k,l) = (rev j,rev k,rev l)
-		   in f(l,nil,nil,nil)
-		   end
-		
-		   val (actions,gotos,errs) =
-			let val doState =
-		            computeActions(rules,precedence,graph,
-					   defaultReductions)
-			in unzip (map doState (zip(lcores,Graph.nodes graph)))
-			end
+                  fun zip (h::t,h'::t') = (h,h') :: zip(t,t')
+                    | zip (nil,nil) = nil
+                    | zip _ = let exception MkTable in raise MkTable end
+                  
+                  fun unzip l =
+                   let fun f ((a,b,c)::r,j,k,l) = f(r,a::j,b::k,c::l)
+                         | f (nil,j,k,l) = (rev j,rev k,rev l)
+                   in f(l,nil,nil,nil)
+                   end
+                
+                   val (actions,gotos,errs) =
+                        let val doState =
+                            computeActions(rules,precedence,graph,
+                                           defaultReductions)
+                        in unzip (map doState (zip(lcores,Graph.nodes graph)))
+                        end
 
-		  (* add goto from state 0 to a new state.  The new state
-		     has accept actions for all of the end-of-parse symbols *)
+                  (* add goto from state 0 to a new state.  The new state
+                     has accept actions for all of the end-of-parse symbols *)
 
-		   val (actions,gotos,errs) =
-		     case gotos
-		     of nil => (actions,gotos,errs)
-		      | h :: t =>
-			let val newStateActions = 
-		           (map (fn t => (t,ACCEPT)) (Look.make_set eop),ERROR)
-			   val state0Goto = 
-			       GotoList.insert((start,STATE (length actions)),h)
-			in (actions @ [newStateActions],
-			    state0Goto :: (t @ [nil]),
-			    errs @ [nil])
-			end 
+                   val (actions,gotos,errs) =
+                     case gotos
+                     of nil => (actions,gotos,errs)
+                      | h :: t =>
+                        let val newStateActions = 
+                           (map (fn t => (t,ACCEPT)) (Look.make_set eop),ERROR)
+                           val state0Goto = 
+                               GotoList.insert((start,STATE (length actions)),h)
+                        in (actions @ [newStateActions],
+                            state0Goto :: (t @ [nil]),
+                            errs @ [nil])
+                        end 
 
-		val startErrs =
-	 	  List.foldr (fn (RULE {rhs,rulenum,...},r) =>
-			if (exists (fn NONTERM a => a=start
-				     | _ => false) rhs)
-			  then START rulenum :: r
-			  else r) [] rules
+                val startErrs =
+                  List.foldr (fn (RULE {rhs,rulenum,...},r) =>
+                        if (exists (fn NONTERM a => a=start
+                                     | _ => false) rhs)
+                          then START rulenum :: r
+                          else r) [] rules
 
-		val nonshiftErrs =
-	 	  List.foldr (fn (RULE {rhs,rulenum,...},r) =>
-		          (List.foldr (fn (nonshift,r) =>
-			   if (exists (fn TERM a => a=nonshift
-				     | _ => false) rhs)
-			    then NS(nonshift,rulenum) :: r
-			    else r) r noshift)
-		       ) [] rules
+                val nonshiftErrs =
+                  List.foldr (fn (RULE {rhs,rulenum,...},r) =>
+                          (List.foldr (fn (nonshift,r) =>
+                           if (exists (fn TERM a => a=nonshift
+                                     | _ => false) rhs)
+                            then NS(nonshift,rulenum) :: r
+                            else r) r noshift)
+                       ) [] rules
 
-		val notReduced =
-		  let val ruleReduced = array(length rules,false)
-		      val test = fn REDUCE i => update(ruleReduced,i,true)
-				  | _ => ()
-		      val _ = app (fn (actions,default) =>
-				     (app (fn (_,r) => test r) actions;
-				      test default)
-				  ) actions;
-		      fun scan (i,r) =
-			 if i >= 0 then
-			      scan(i-1, if ruleReduced sub i then r
-					else NOT_REDUCED i :: r)
-			else r
-		  in scan(Array.length ruleReduced-1,nil)
-	    	  end handle Subscript =>
-			(if DEBUG then
-				print "rules not numbered correctly!"
-			 else (); nil)
+                val notReduced =
+                  let val ruleReduced = array(length rules,false)
+                      val test = fn REDUCE i => update(ruleReduced,i,true)
+                                  | _ => ()
+                      val _ = app (fn (actions,default) =>
+                                     (app (fn (_,r) => test r) actions;
+                                      test default)
+                                  ) actions;
+                      fun scan (i,r) =
+                         if i >= 0 then
+                              scan(i-1, if ruleReduced sub i then r
+                                        else NOT_REDUCED i :: r)
+                        else r
+                  in scan(Array.length ruleReduced-1,nil)
+                  end handle Subscript =>
+                        (if DEBUG then
+                                print "rules not numbered correctly!"
+                         else (); nil)
 
-		val numstates = length actions
+                val numstates = length actions
 
-	        val allErrs = startErrs @ notReduced @ nonshiftErrs @ 
-			      (List.concat errs)
+                val allErrs = startErrs @ notReduced @ nonshiftErrs @ 
+                              (List.concat errs)
 
                 fun convert_to_pairlist(nil : ('a * 'b) list): ('a,'b) pairlist =
-		      EMPTY
+                      EMPTY
                   | convert_to_pairlist ((a,b) :: r) =
-		      PAIR(a,b,convert_to_pairlist r)
+                      PAIR(a,b,convert_to_pairlist r)
 
-	      in (mkLrTable {actions=Array.fromList(map (fn (a,b) =>
-				     (convert_to_pairlist a,b)) actions),
-			     gotos=Array.fromList (map convert_to_pairlist gotos),
-			     numRules=length rules,numStates=length actions,
-			     initialState=STATE 0},
-		  let val errArray = Array.fromList errs
-		  in fn (STATE state) => errArray sub state
-		  end,
+              in (mkLrTable {actions=Array.fromList(map (fn (a,b) =>
+                                     (convert_to_pairlist a,b)) actions),
+                             gotos=Array.fromList (map convert_to_pairlist gotos),
+                             numRules=length rules,numStates=length actions,
+                             initialState=STATE 0},
+                  let val errArray = Array.fromList errs
+                  in fn (STATE state) => errArray sub state
+                  end,
 
-		  fn print =>
- 		    let val printCore =
-			  prCore(symbolToString,nontermToString,print)
-			val core = Graph.core graph
-		    in fn STATE state =>
-			 printCore (if state=(numstates-1) then
-					 Core.CORE (nil,state)
-				        else (core state))
-		    end,
-		    allErrs)
+                  fn print =>
+                    let val printCore =
+                          prCore(symbolToString,nontermToString,print)
+                        val core = Graph.core graph
+                    in fn STATE state =>
+                         printCore (if state=(numstates-1) then
+                                         Core.CORE (nil,state)
+                                        else (core state))
+                    end,
+                    allErrs)
               end
 end;
 (* ML-Yacc Parser Generator (c) 1989 Andrew W. Appel, David R. Tarditi 
@@ -5445,103 +5445,103 @@
  *)
 
 structure Grammar : GRAMMAR =
-	struct
+        struct
 
-		(* define types term and nonterm using those in LrTable
-		   datatype term = T of int 
-		   datatype nonterm = NT of int *)
+                (* define types term and nonterm using those in LrTable
+                   datatype term = T of int 
+                   datatype nonterm = NT of int *)
 
-		open LrTable
-		datatype symbol = TERM of term | NONTERM of nonterm
-		datatype grammar = GRAMMAR of
-				{rules: {lhs: nonterm,
-				 	 rhs: symbol list, 
-				 	 precedence: int option,
-				 	 rulenum: int} list,
-				noshift : term list,
-				eop : term list,
-				terms: int,
-				nonterms: int,
-				start : nonterm,
-				precedence : term -> int option,
-				termToString : term -> string,
-				nontermToString : nonterm -> string}
+                open LrTable
+                datatype symbol = TERM of term | NONTERM of nonterm
+                datatype grammar = GRAMMAR of
+                                {rules: {lhs: nonterm,
+                                         rhs: symbol list, 
+                                         precedence: int option,
+                                         rulenum: int} list,
+                                noshift : term list,
+                                eop : term list,
+                                terms: int,
+                                nonterms: int,
+                                start : nonterm,
+                                precedence : term -> int option,
+                                termToString : term -> string,
+                                nontermToString : nonterm -> string}
 end;
 
 structure IntGrammar : INTGRAMMAR =
-	struct
-		structure Grammar = Grammar
-		open Grammar
+        struct
+                structure Grammar = Grammar
+                open Grammar
 
-		datatype rule = RULE of
-			 	{lhs: nonterm,
-				 rhs: symbol list,
-				 num: int,(* internal # assigned by coreutils *)
-				 rulenum: int,
-				 precedence: int option}
-		
-		val eqTerm = (op =)
-		val gtTerm = fn (T i,T j) => i>j
+                datatype rule = RULE of
+                                {lhs: nonterm,
+                                 rhs: symbol list,
+                                 num: int,(* internal # assigned by coreutils *)
+                                 rulenum: int,
+                                 precedence: int option}
+                
+                val eqTerm = (op =)
+                val gtTerm = fn (T i,T j) => i>j
 
-		val eqNonterm = (op =)
-		val gtNonterm = fn (NT i,NT j) => i>j
+                val eqNonterm = (op =)
+                val gtNonterm = fn (NT i,NT j) => i>j
 
-		val eqSymbol = (op =)
-		val gtSymbol = fn (TERM (T i),TERM (T j)) => i>j
-				| (NONTERM (NT i),NONTERM (NT j)) => i>j
-				| (TERM _,NONTERM _) => false
-				| (NONTERM _,TERM _) => true
+                val eqSymbol = (op =)
+                val gtSymbol = fn (TERM (T i),TERM (T j)) => i>j
+                                | (NONTERM (NT i),NONTERM (NT j)) => i>j
+                                | (TERM _,NONTERM _) => false
+                                | (NONTERM _,TERM _) => true
 
 
-		structure SymbolAssoc = Table(type key = symbol
-					      val gt = gtSymbol)
+                structure SymbolAssoc = Table(type key = symbol
+                                              val gt = gtSymbol)
 
-		structure NontermAssoc = Table(type key =  nonterm
-					       val gt = gtNonterm)
+                structure NontermAssoc = Table(type key =  nonterm
+                                               val gt = gtNonterm)
 
-		val DEBUG = false
+                val DEBUG = false
 
-		val prRule = fn (a as symbolToString,nontermToString,print) =>
-		   let val printSymbol = print o symbolToString
-		       fun printRhs (h::t) = (printSymbol h; print " ";
-					      printRhs t)
-			 | printRhs nil = ()
-		   in fn (RULE {lhs,rhs,num,rulenum,precedence,...}) =>
-			((print o nontermToString) lhs; print " : ";
-			 printRhs rhs;
-			 if DEBUG then (print " num = ";
-					print (Int.toString num);
-					print " rulenum = ";
-					print (Int.toString rulenum);
-					print " precedence = ";
-					case precedence
-					    of NONE => print " none"
-					     | (SOME i) =>
-						 print (Int.toString i);
-					())
-			else ())
-		   end
-			
-		val prGrammar =
-			 fn (a as (symbolToString,nontermToString,print)) =>
-			     fn (GRAMMAR {rules,terms,nonterms,start,...}) =>
-		 let val printRule =
-			let val prRule = prRule a
-			in  fn {lhs,rhs,precedence,rulenum} =>
-		   	     (prRule (RULE {lhs=lhs,rhs=rhs,num=0,
-				      rulenum=rulenum, precedence=precedence});
-			      print "\n")
-			end
-		 in print "grammar = \n";
-		    List.app printRule rules;
-		    print "\n";
-		    print (" terms = " ^ (Int.toString terms) ^
-			     " nonterms = " ^ (Int.toString nonterms) ^
-			     " start = ");
-		    (print o nontermToString) start;
-		    ()
-		 end
-	end;
+                val prRule = fn (a as symbolToString,nontermToString,print) =>
+                   let val printSymbol = print o symbolToString
+                       fun printRhs (h::t) = (printSymbol h; print " ";
+                                              printRhs t)
+                         | printRhs nil = ()
+                   in fn (RULE {lhs,rhs,num,rulenum,precedence,...}) =>
+                        ((print o nontermToString) lhs; print " : ";
+                         printRhs rhs;
+                         if DEBUG then (print " num = ";
+                                        print (Int.toString num);
+                                        print " rulenum = ";
+                                        print (Int.toString rulenum);
+                                        print " precedence = ";
+                                        case precedence
+                                            of NONE => print " none"
+                                             | (SOME i) =>
+                                                 print (Int.toString i);
+                                        ())
+                        else ())
+                   end
+                        
+                val prGrammar =
+                         fn (a as (symbolToString,nontermToString,print)) =>
+                             fn (GRAMMAR {rules,terms,nonterms,start,...}) =>
+                 let val printRule =
+                        let val prRule = prRule a
+                        in  fn {lhs,rhs,precedence,rulenum} =>
+                             (prRule (RULE {lhs=lhs,rhs=rhs,num=0,
+                                      rulenum=rulenum, precedence=precedence});
+                              print "\n")
+                        end
+                 in print "grammar = \n";
+                    List.app printRule rules;
+                    print "\n";
+                    print (" terms = " ^ (Int.toString terms) ^
+                             " nonterms = " ^ (Int.toString nonterms) ^
+                             " start = ");
+                    (print o nontermToString) start;
+                    ()
+                 end
+        end;
 (* ML-Yacc Parser Generator (c) 1989 Andrew W. Appel, David R. Tarditi 
  *
  * $Log$
@@ -5560,82 +5560,82 @@
    structure Errs = Errs
    open Errs Errs.LrTable
    val mkPrintAction = fn print =>
-	let val printInt = print o (Int.toString : int -> string)
-	in fn (SHIFT (STATE i)) =>
-			(print "\tshift ";
-		 	 printInt i;
-		 	print "\n")
-	     | (REDUCE rulenum) =>
-			(print "\treduce by rule ";
-		 	 printInt rulenum;
-		 	 print "\n")
-	     | ACCEPT => print "\taccept\n"
-	     | ERROR => print "\terror\n"
-	end
+        let val printInt = print o (Int.toString : int -> string)
+        in fn (SHIFT (STATE i)) =>
+                        (print "\tshift ";
+                         printInt i;
+                        print "\n")
+             | (REDUCE rulenum) =>
+                        (print "\treduce by rule ";
+                         printInt rulenum;
+                         print "\n")
+             | ACCEPT => print "\taccept\n"
+             | ERROR => print "\terror\n"
+        end
    val mkPrintGoto = fn (printNonterm,print) =>
       let val printInt = print o (Int.toString : int -> string)
       in fn (nonterm,STATE i) =>
-		(print "\t";
-		 printNonterm nonterm;
-		 print "\tgoto ";
-		 printInt i;
-		 print "\n")
+                (print "\t";
+                 printNonterm nonterm;
+                 print "\tgoto ";
+                 printInt i;
+                 print "\n")
       end
 
    val mkPrintTermAction = fn (printTerm,print) =>
- 	let val printAction = mkPrintAction print
-	in fn (term,action) =>
-		(print "\t";
-		 printTerm term;
-		 printAction action)
-	end
+        let val printAction = mkPrintAction print
+        in fn (term,action) =>
+                (print "\t";
+                 printTerm term;
+                 printAction action)
+        end
    val mkPrintGoto = fn (printNonterm,print) =>
-	fn (nonterm,STATE i) =>
-	    let val printInt = print o (Int.toString : int -> string)
-	    in (print "\t";
-		printNonterm nonterm;
-		print "\tgoto ";
-		printInt i;
-		print "\n")
-	    end
+        fn (nonterm,STATE i) =>
+            let val printInt = print o (Int.toString : int -> string)
+            in (print "\t";
+                printNonterm nonterm;
+                print "\tgoto ";
+                printInt i;
+                print "\n")
+            end
    val mkPrintError = fn (printTerm,printRule,print) =>
      let val printInt = print o (Int.toString : int -> string)
-	 val printState = fn STATE s => (print " state "; printInt s)
+         val printState = fn STATE s => (print " state "; printInt s)
      in fn (RR (term,state,r1,r2)) =>
-		(print "error: ";
-		 printState state;
-		 print ": reduce/reduce conflict between rule ";
-		 printInt r1;
-		 print " and rule ";
-		 printInt r2;
-		 print " on ";
-		 printTerm term;
-		 print "\n")
-	 | (SR (term,state,r1)) =>
-		(print "error: ";
-		 printState state;
-		 print ": shift/reduce conflict ";
-		 print "(shift ";
-		 printTerm term;
-		 print ", reduce by rule ";
-		 printInt r1;
-		 print ")\n")
-	 | NOT_REDUCED i =>
-		(print "warning: rule <";
-		 printRule i;
-		 print "> will never be reduced\n")
-	 | START i => 
-	        (print "warning: start symbol appears on the rhs of ";
-	         print "<";
-	         printRule i;
-		 print ">\n")
-	 | NS (term,i) =>
-	        (print "warning: non-shiftable terminal ";
-		 printTerm term;
-		 print  "appears on the rhs of ";
-	         print "<";
-	         printRule i;
-		 print ">\n")
+                (print "error: ";
+                 printState state;
+                 print ": reduce/reduce conflict between rule ";
+                 printInt r1;
+                 print " and rule ";
+                 printInt r2;
+                 print " on ";
+                 printTerm term;
+                 print "\n")
+         | (SR (term,state,r1)) =>
+                (print "error: ";
+                 printState state;
+                 print ": shift/reduce conflict ";
+                 print "(shift ";
+                 printTerm term;
+                 print ", reduce by rule ";
+                 printInt r1;
+                 print ")\n")
+         | NOT_REDUCED i =>
+                (print "warning: rule <";
+                 printRule i;
+                 print "> will never be reduced\n")
+         | START i => 
+                (print "warning: start symbol appears on the rhs of ";
+                 print "<";
+                 printRule i;
+                 print ">\n")
+         | NS (term,i) =>
+                (print "warning: non-shiftable terminal ";
+                 printTerm term;
+                 print  "appears on the rhs of ";
+                 print "<";
+                 printRule i;
+                 print ">\n")
       end
    structure PairList : sig 
                           val app : ('a * 'b -> unit) -> ('a,'b) pairlist -> unit
@@ -5644,70 +5644,70 @@
        =
       struct
          val app = fn f =>
-	     let fun g EMPTY = ()
+             let fun g EMPTY = ()
                    | g (PAIR(a,b,r)) = (f(a,b); g r)
              in g
              end
          val length = fn l =>
-	     let fun g(EMPTY,len) = len
+             let fun g(EMPTY,len) = len
                    | g(PAIR(_,_,r),len) = g(r,len+1)
              in g(l,0)
              end
       end
    val printVerbose =
-	fn {termToString,nontermToString,table,stateErrs,entries:int,
-	    print,printRule,errs,printCores} =>
-	   let 
-		val printTerm = print o termToString
-		val printNonterm = print o nontermToString
+        fn {termToString,nontermToString,table,stateErrs,entries:int,
+            print,printRule,errs,printCores} =>
+           let 
+                val printTerm = print o termToString
+                val printNonterm = print o nontermToString
 
-		val printCore = printCores print
-		val printTermAction = mkPrintTermAction(printTerm,print)
-		val printAction = mkPrintAction print
-		val printGoto = mkPrintGoto(printNonterm,print)
-		val printError = mkPrintError(printTerm,printRule print,print)
+                val printCore = printCores print
+                val printTermAction = mkPrintTermAction(printTerm,print)
+                val printAction = mkPrintAction print
+                val printGoto = mkPrintGoto(printNonterm,print)
+                val printError = mkPrintError(printTerm,printRule print,print)
 
-		val gotos = LrTable.describeGoto table
-		val actions = LrTable.describeActions table
-		val states = numStates table
+                val gotos = LrTable.describeGoto table
+                val actions = LrTable.describeActions table
+                val states = numStates table
 
                 val gotoTableSize = ref 0
                 val actionTableSize = ref 0
-		
-		val _ = if length errs > 0 
-			   then (printSummary print errs;
-			         print "\n";
-				 app printError errs)
-			   else ()  
-		fun loop i =
-		  if i=states then ()
-		  else let val s = STATE i
-		       in (app printError (stateErrs s);
-			   print "\n";
-			   printCore s;
-			   let val (actionList,default) = actions s
-			       val gotoList = gotos s
-			   in (PairList.app printTermAction actionList;
-			       print "\n";
-			       PairList.app printGoto gotoList;
-			       print "\n";
-			       print "\t.";
-			       printAction default;
-			       print "\n";
-			       gotoTableSize:=(!gotoTableSize)+
-			                      PairList.length gotoList;
-			       actionTableSize := (!actionTableSize) +
-			                       PairList.length actionList + 1
-			       ) 
-			   end;
-			   loop (i+1))
-			end
-	  in loop 0;
-	      print (Int.toString entries ^ " of " ^
-		     Int.toString (!actionTableSize)^
-		     " action table entries left after compaction\n");
-	      print (Int.toString (!gotoTableSize)^ " goto table entries\n")
-	  end
+                
+                val _ = if length errs > 0 
+                           then (printSummary print errs;
+                                 print "\n";
+                                 app printError errs)
+                           else ()  
+                fun loop i =
+                  if i=states then ()
+                  else let val s = STATE i
+                       in (app printError (stateErrs s);
+                           print "\n";
+                           printCore s;
+                           let val (actionList,default) = actions s
+                               val gotoList = gotos s
+                           in (PairList.app printTermAction actionList;
+                               print "\n";
+                               PairList.app printGoto gotoList;
+                               print "\n";
+                               print "\t.";
+                               printAction default;
+                               print "\n";
+                               gotoTableSize:=(!gotoTableSize)+
+                                              PairList.length gotoList;
+                               actionTableSize := (!actionTableSize) +
+                                               PairList.length actionList + 1
+                               ) 
+                           end;
+                           loop (i+1))
+                        end
+          in loop 0;
+              print (Int.toString entries ^ " of " ^
+                     Int.toString (!actionTableSize)^
+                     " action table entries left after compaction\n");
+              print (Int.toString (!gotoTableSize)^ " goto table entries\n")
+          end
 end;
 
 
@@ -5725,8 +5725,8 @@
  *)
 
 functor mkPrintStruct(structure LrTable : LR_TABLE
-		      structure ShrinkLrTable : SHRINK_LR_TABLE
-		      sharing LrTable = ShrinkLrTable.LrTable):PRINT_STRUCT =
+                      structure ShrinkLrTable : SHRINK_LR_TABLE
+                      sharing LrTable = ShrinkLrTable.LrTable):PRINT_STRUCT =
    struct
       open Array List
       infix 9 sub
@@ -5735,15 +5735,15 @@
       
      
       (* lineLength = approximately the largest number of characters to allow
-	 on a line when printing out an encode string *)
-	  
+         on a line when printing out an encode string *)
+          
       val lineLength = 72
 
       (* maxLength = length of a table entry.  All table entries are encoded
-	 using two 16-bit integers, one for the terminal number and the other
-	 for the entry.  Each integer is printed as two characters (low byte,
-	 high byte), using the ML ascii escape sequence.  We need 4
-	 characters for each escape sequence and 16 characters for each entry
+         using two 16-bit integers, one for the terminal number and the other
+         for the entry.  Each integer is printed as two characters (low byte,
+         high byte), using the ML ascii escape sequence.  We need 4
+         characters for each escape sequence and 16 characters for each entry
       *)
 
       val maxLength =  16
@@ -5753,112 +5753,112 @@
       val numEntries = lineLength div maxLength
 
       (* convert integer between 0 and 255 to the three character ascii
-	 decimal escape sequence for it *)
+         decimal escape sequence for it *)
 
       val chr =
-	let val lookup = Array.array(256,"\000")
-	    val intToString = fn i =>
-		if i>=100 then "\\" ^ (Int.toString i)
-		else if i>=10 then "\\0" ^ (Int.toString i)
-		else  "\\00" ^ (Int.toString i)
-	    fun loop n = if n=256 then ()
-			 else (Array.update(lookup,n,intToString n); loop (n+1))
-	in loop 0; fn i => lookup sub i
-	end
+        let val lookup = Array.array(256,"\000")
+            val intToString = fn i =>
+                if i>=100 then "\\" ^ (Int.toString i)
+                else if i>=10 then "\\0" ^ (Int.toString i)
+                else  "\\00" ^ (Int.toString i)
+            fun loop n = if n=256 then ()
+                         else (Array.update(lookup,n,intToString n); loop (n+1))
+        in loop 0; fn i => lookup sub i
+        end
 
       val makeStruct = fn {table,name,print,verbose} =>
        let
-	 val states = numStates table
-	 val rules = numRules table
+         val states = numStates table
+         val rules = numRules table
          fun printPairList (prEntry : 'a * 'b -> unit) l =
-	       let fun f (EMPTY,_) = ()
+               let fun f (EMPTY,_) = ()
                      | f (PAIR(a,b,r),count) =
-			    if count >= numEntries then
-			       (print "\\\n\\"; prEntry(a,b); f(r,1))
-			    else (prEntry(a,b); f(r,(count+1)))
+                            if count >= numEntries then
+                               (print "\\\n\\"; prEntry(a,b); f(r,1))
+                            else (prEntry(a,b); f(r,(count+1)))
                in f(l,0)
                end
          val printList : ('a -> unit) -> 'a list -> unit =
            fn prEntry => fn l =>
                 let fun f (nil,_) = ()
                       | f (a :: r,count) =
-			     if count >= numEntries then
-				 (print "\\\n\\"; prEntry a; f(r,1))
-				else (prEntry a; f(r,count+1))
+                             if count >= numEntries then
+                                 (print "\\\n\\"; prEntry a; f(r,1))
+                                else (prEntry a; f(r,count+1))
                 in f(l,0)
                 end
-	 val prEnd = fn _ => print "\\000\\000\\\n\\"
-	 fun printPairRow prEntry =
-	       let val printEntries = printPairList prEntry
-	       in fn l => (printEntries l; prEnd())
-	       end
-	 fun printPairRowWithDefault (prEntry,prDefault) =
-	       let val f = printPairRow prEntry
-	       in fn (l,default) => (prDefault default; f l)
-	       end
-	 fun printTable (printRow,count) =
-	       (print "\"\\\n\\";
-		let fun f i = if i=count then ()
-			       else (printRow i; f (i+1))
-		in f 0
-		end;
-		print"\"\n")
-	 val printChar = print o chr
+         val prEnd = fn _ => print "\\000\\000\\\n\\"
+         fun printPairRow prEntry =
+               let val printEntries = printPairList prEntry
+               in fn l => (printEntries l; prEnd())
+               end
+         fun printPairRowWithDefault (prEntry,prDefault) =
+               let val f = printPairRow prEntry
+               in fn (l,default) => (prDefault default; f l)
+               end
+         fun printTable (printRow,count) =
+               (print "\"\\\n\\";
+                let fun f i = if i=count then ()
+                               else (printRow i; f (i+1))
+                in f 0
+                end;
+                print"\"\n")
+         val printChar = print o chr
 
-	  (* print an integer between 0 and 2^16-1 as a 2-byte character,
-	     with the low byte first *)
+          (* print an integer between 0 and 2^16-1 as a 2-byte character,
+             with the low byte first *)
 
-	 val printInt = fn i => (printChar (i mod 256);
-				  printChar (i div 256))
+         val printInt = fn i => (printChar (i mod 256);
+                                  printChar (i div 256))
 
-	 (* encode actions as integers:
+         (* encode actions as integers:
 
-		ACCEPT => 0
-		ERROR => 1
-		SHIFT i => 2 + i
-		REDUCE rulenum => numstates+2+rulenum
-	 *)
+                ACCEPT => 0
+                ERROR => 1
+                SHIFT i => 2 + i
+                REDUCE rulenum => numstates+2+rulenum
+         *)
 
-	 val printAction =
-	      fn (REDUCE rulenum) => printInt (rulenum+states+2)
-		 | (SHIFT (STATE i)) => printInt (i+2)
-		 | ACCEPT => printInt 0
-		 | ERROR => printInt 1
-	
-	 val printTermAction = fn (T t,action) =>
-		(printInt (t+1); printAction action)
+         val printAction =
+              fn (REDUCE rulenum) => printInt (rulenum+states+2)
+                 | (SHIFT (STATE i)) => printInt (i+2)
+                 | ACCEPT => printInt 0
+                 | ERROR => printInt 1
+        
+         val printTermAction = fn (T t,action) =>
+                (printInt (t+1); printAction action)
 
-	 val printGoto = fn (NT n,STATE s) => (printInt (n+1); printInt s)
+         val printGoto = fn (NT n,STATE s) => (printInt (n+1); printInt s)
 
-	 val ((rowCount,rowNumbers,actionRows),entries)= 
-	           shrinkActionList(table,verbose)
+         val ((rowCount,rowNumbers,actionRows),entries)= 
+                   shrinkActionList(table,verbose)
          val getActionRow = let val a = Array.fromList actionRows
-	                    in fn i => a sub i
-			    end
-	 val printGotoRow : int -> unit = 
-	       let val f = printPairRow printGoto
+                            in fn i => a sub i
+                            end
+         val printGotoRow : int -> unit = 
+               let val f = printPairRow printGoto
                    val g = describeGoto table
                in fn i => f (g (STATE i))
                end
         val printActionRow =
-	      let val f = printPairRowWithDefault(printTermAction,printAction)
+              let val f = printPairRowWithDefault(printTermAction,printAction)
               in fn i => f (getActionRow i)
               end
-	in print "val ";
-	   print name;
-	   print "=";
-	   print "let val actionRows =\n";
-	   printTable(printActionRow,rowCount);
-	   print "val actionRowNumbers =\n\"";
-	   printList (fn i => printInt i) rowNumbers;
-	   print "\"\n";
-	   print "val gotoT =\n"; 
-	   printTable(printGotoRow,states);
-	   print "val numstates = ";
-	   print (Int.toString states);
-	   print "\nval numrules = ";
-	   print (Int.toString rules);
-	   print "\n\
+        in print "val ";
+           print name;
+           print "=";
+           print "let val actionRows =\n";
+           printTable(printActionRow,rowCount);
+           print "val actionRowNumbers =\n\"";
+           printList (fn i => printInt i) rowNumbers;
+           print "\"\n";
+           print "val gotoT =\n"; 
+           printTable(printGotoRow,states);
+           print "val numstates = ";
+           print (Int.toString states);
+           print "\nval numrules = ";
+           print (Int.toString rules);
+           print "\n\
 \val s = ref \"\" and index = ref 0\n\
 \val string_to_int = fn () => \n\
 \let val i = !index\n\
@@ -5955,7 +5955,7 @@
 
         It returns a triple consisting of:
 
-	  * the number of equivalence classes
+          * the number of equivalence classes
           * a list which maps each original entry to an equivalence
             class.  The nth entry in this list gives the equivalence
             class for the nth entry in the original entry list.
@@ -5993,7 +5993,7 @@
                  fun scan (a :: b :: rest) = merge(a,b) :: scan rest
                    | scan l = l
 
-	         (* loop: calls scan on a list of lists until only
+                 (* loop: calls scan on a list of lists until only
                     one list is left.  It terminates only if the list of
                     lists is nonempty.  (The pattern match for sort
                     ensures this.) *)
@@ -6030,14 +6030,14 @@
 
          We then return the length of R, R, and the list that results from
          permuting SE by P.
-     *)	
+     *) 
 
        type entry = A.entry
              
        val gt = fn ((a,_),(b,_)) => A.gt(a,b)
 
        structure Sort = MergeSortFun(type entry = A.entry * int
-     				     val gt = gt)
+                                     val gt = gt)
        val assignIndex =
           fn l =>
              let fun loop (index,nil) = nil
@@ -6046,13 +6046,13 @@
              end 
     
        local fun loop ((e,_) :: t, prev, class, R , SE) =
-	       if A.eq(e,prev)
-		 then loop(t,e,class,R, class :: SE)
-		 else loop(t,e,class+1,e :: R, (class + 1) :: SE)
-	     | loop (nil,_,_,R,SE) = (rev R, rev SE)
+               if A.eq(e,prev)
+                 then loop(t,e,class,R, class :: SE)
+                 else loop(t,e,class+1,e :: R, (class + 1) :: SE)
+             | loop (nil,_,_,R,SE) = (rev R, rev SE)
        in val createEquivalences =
-	   fn nil => (nil,nil)
-	    | (e,_) :: t => loop(t, e, 0, [e],[0])
+           fn nil => (nil,nil)
+            | (e,_) :: t => loop(t, e, 0, [e],[0])
        end
 
        val inversePermute = fn permutation =>
@@ -6060,20 +6060,20 @@
                | l as h :: _ =>
                    let val result = array(length l,h)
                        fun loop (elem :: r, dest :: s) =
-			     (update(result,dest,elem); loop(r,s))
+                             (update(result,dest,elem); loop(r,s))
                          | loop _ = ()
                        fun listofarray i =
-			  if i < Array.length result then 
-				(result sub i) :: listofarray (i+1)
+                          if i < Array.length result then 
+                                (result sub i) :: listofarray (i+1)
                           else nil
                     in loop (l,permutation); listofarray 0
-		    end
+                    end
 
        fun makePermutation x = map (fn (_,b) => b) x
 
        val equivalences = fn l =>
-	   let val EP = assignIndex l
-	       val sorted = Sort.sort EP
+           let val EP = assignIndex l
+               val sorted = Sort.sort EP
                val P = makePermutation sorted
                val (R, SE) = createEquivalences sorted
             in (length R, inversePermute P SE, R)
@@ -6082,20 +6082,20 @@
 
 functor ShrinkLrTableFun(structure LrTable : LR_TABLE) : SHRINK_LR_TABLE =
     struct
-	structure LrTable = LrTable
+        structure LrTable = LrTable
         open LrTable
         val gtAction = fn (a,b) =>
-	      case a
+              case a
               of SHIFT (STATE s) => 
-		   (case b of SHIFT (STATE s') => s>s' | _ => true)
+                   (case b of SHIFT (STATE s') => s>s' | _ => true)
                | REDUCE i => (case b of SHIFT _ => false | REDUCE i' => i>i'
                                       | _ => true)
                | ACCEPT => (case b of ERROR => true | _ => false)
                | ERROR =>  false
         structure ActionEntryList =
-	    struct
-		type entry = (term,action) pairlist * action
-		val rec eqlist =
+            struct
+                type entry = (term,action) pairlist * action
+                val rec eqlist =
                       fn (EMPTY,EMPTY) => true
                        | (PAIR (T t,d,r),PAIR(T t',d',r')) =>
                              t=t' andalso d=d' andalso eqlist(r,r')
@@ -6103,18 +6103,18 @@
                  val rec gtlist =
                             fn (PAIR _,EMPTY) => true
                              | (PAIR(T t,d,r),PAIR(T t',d',r')) =>
-				     t>t' orelse (t=t' andalso
+                                     t>t' orelse (t=t' andalso
                                        (gtAction(d,d') orelse
-					 (d=d' andalso gtlist(r,r'))))
+                                         (d=d' andalso gtlist(r,r'))))
                              | _ => false
-		 val eq = fn ((l,a),(l',a')) => a=a' andalso eqlist(l,l')
+                 val eq = fn ((l,a),(l',a')) => a=a' andalso eqlist(l,l')
                  val gt = fn ((l,a),(l',a')) => gtAction(a,a')
-		                orelse (a=a' andalso gtlist(l,l'))
+                                orelse (a=a' andalso gtlist(l,l'))
             end
 (*        structure GotoEntryList =
             struct
-	       type entry = (nonterm,state) pairlist
-	       val rec eq = 
+               type entry = (nonterm,state) pairlist
+               val rec eq = 
                     fn (EMPTY,EMPTY) => true
                      | (PAIR (t,d,r),PAIR(t',d',r')) =>
                             t=t' andalso d=d' andalso eq(r,r')
@@ -6128,24 +6128,24 @@
             end *)
         structure EquivActionList = EquivFun(ActionEntryList)
         val states = fn max =>
-	    let fun f i=if i<max then STATE i :: f(i+1) else nil
+            let fun f i=if i<max then STATE i :: f(i+1) else nil
             in f 0
             end
         val length : ('a,'b) pairlist -> int =
            fn l =>
-	     let fun g(EMPTY,len) = len
+             let fun g(EMPTY,len) = len
                    | g(PAIR(_,_,r),len) = g(r,len+1)
              in g(l,0)
              end
         val size : (('a,'b) pairlist * 'c) list -> int =
-	   fn l =>
-	     let val c = ref 0
+           fn l =>
+             let val c = ref 0
              in (app (fn (row,_) => c := !c + length row) l; !c)
              end
        val shrinkActionList = 
-	 fn (table,verbose) =>
-	   case EquivActionList.equivalences
-	             (map (describeActions table) (states (numStates table)))
+         fn (table,verbose) =>
+           case EquivActionList.equivalences
+                     (map (describeActions table) (states (numStates table)))
            of result as (_,_,l) => (result,if verbose then size l else 0)
 end;
 (* ML-Yacc Parser Generator (c) 1989 Andrew W. Appel, David R. Tarditi 
@@ -6196,15 +6196,15 @@
  *)
 
 functor ParseGenFun(structure ParseGenParser : PARSE_GEN_PARSER where type Header.pos = int
-		    structure MakeTable : MAKE_LR_TABLE
-		    structure Verbose : VERBOSE
-		    structure PrintStruct : PRINT_STRUCT
+                    structure MakeTable : MAKE_LR_TABLE
+                    structure Verbose : VERBOSE
+                    structure PrintStruct : PRINT_STRUCT
 
-		    sharing MakeTable.LrTable = PrintStruct.LrTable
-		    sharing MakeTable.Errs = Verbose.Errs
+                    sharing MakeTable.LrTable = PrintStruct.LrTable
+                    sharing MakeTable.Errs = Verbose.Errs
 
                     structure Absyn : ABSYN
-		    ) : PARSE_GEN =
+                    ) : PARSE_GEN =
   struct
     open Array List
     infix 9 sub
@@ -6218,23 +6218,23 @@
     val lineLength = 70
 
     (* record type describing names of structures in the program being
- 	generated *)
+        generated *)
 
     datatype names = NAMES 
-			of {miscStruct : string,  (* Misc{n} struct name *)
-			    tableStruct : string, (* LR table structure *)
-			    tokenStruct : string, (* Tokens{n} struct name *)
-			    actionsStruct : string, (* Actions structure *)
-			    valueStruct: string, (* semantic value structure *)
-			    ecStruct : string,  (* error correction structure *)
-			    arg: string, (* user argument for parser *)
-			    tokenSig : string,  (* TOKENS{n} signature *)
-			    miscSig :string, (* Signature for Misc structure *)
-			    dataStruct:string, (* name of structure in Misc *)
-						(* which holds parser data *)
-			    dataSig:string (* signature for this structure *)
-					
-		 	    }
+                        of {miscStruct : string,  (* Misc{n} struct name *)
+                            tableStruct : string, (* LR table structure *)
+                            tokenStruct : string, (* Tokens{n} struct name *)
+                            actionsStruct : string, (* Actions structure *)
+                            valueStruct: string, (* semantic value structure *)
+                            ecStruct : string,  (* error correction structure *)
+                            arg: string, (* user argument for parser *)
+                            tokenSig : string,  (* TOKENS{n} signature *)
+                            miscSig :string, (* Signature for Misc structure *)
+                            dataStruct:string, (* name of structure in Misc *)
+                                                (* which holds parser data *)
+                            dataSig:string (* signature for this structure *)
+                                        
+                            }
 
     val DEBUG = true
     exception Semantic
@@ -6242,279 +6242,279 @@
     (* common functions and values used in printing out program *)
 
     datatype values = VALS
-		      of {say : string -> unit,
-			  saydot : string -> unit,
-			  sayln : string -> unit,
-			  pureActions: bool,
-			  pos_type : string,
-			  arg_type : string,
-			  ntvoid : string,
-			  termvoid : string,
-			  start : Grammar.nonterm,
-			  hasType : Grammar.symbol -> bool,
+                      of {say : string -> unit,
+                          saydot : string -> unit,
+                          sayln : string -> unit,
+                          pureActions: bool,
+                          pos_type : string,
+                          arg_type : string,
+                          ntvoid : string,
+                          termvoid : string,
+                          start : Grammar.nonterm,
+                          hasType : Grammar.symbol -> bool,
 
-			  (* actual (user) name of terminal *)
+                          (* actual (user) name of terminal *)
 
-			  termToString : Grammar.term -> string,
-			  symbolToString : Grammar.symbol -> string,
+                          termToString : Grammar.term -> string,
+                          symbolToString : Grammar.symbol -> string,
 
-			  (* type symbol comes from the HDR structure,
-			     and is now abstract *)
+                          (* type symbol comes from the HDR structure,
+                             and is now abstract *)
 
-			  term : (Header.symbol * ty option) list,
-			  nonterm : (Header.symbol * ty option) list,
-			  terms : Grammar.term list}
-			  
+                          term : (Header.symbol * ty option) list,
+                          nonterm : (Header.symbol * ty option) list,
+                          terms : Grammar.term list}
+                          
     structure SymbolHash = Hash(type elem = string
-	    		        val gt = (op >) : string*string -> bool)
+                                val gt = (op >) : string*string -> bool)
 
     structure TermTable = Table(type key = Grammar.term
-				val gt = fn (T i,T j) => i > j)
+                                val gt = fn (T i,T j) => i > j)
 
     structure SymbolTable = Table(
-	type key = Grammar.symbol
-	val gt = fn (TERM(T i),TERM(T j)) => i>j
-		  | (NONTERM(NT i),NONTERM(NT j)) => i>j
-		  | (NONTERM _,TERM _) => true
-		  | (TERM _,NONTERM _) => false)
+        type key = Grammar.symbol
+        val gt = fn (TERM(T i),TERM(T j)) => i>j
+                  | (NONTERM(NT i),NONTERM(NT j)) => i>j
+                  | (NONTERM _,TERM _) => true
+                  | (TERM _,NONTERM _) => false)
 
     (* printTypes: function to print the following types in the LrValues
        structure and a structure containing the datatype svalue:
 
-		type svalue -- it holds semantic values on the parse
-				   stack
-		type pos -- the type of line numbers
-		type result -- the type of the value that results
-				   from the parse
+                type svalue -- it holds semantic values on the parse
+                                   stack
+                type pos -- the type of line numbers
+                type result -- the type of the value that results
+                                   from the parse
 
-	The type svalue is set equal to the datatype svalue declared
-	in the structure named by valueStruct.  The datatype svalue
-	is declared inside the structure named by valueStruct to deal
-	with the scope of constructors.
+        The type svalue is set equal to the datatype svalue declared
+        in the structure named by valueStruct.  The datatype svalue
+        is declared inside the structure named by valueStruct to deal
+        with the scope of constructors.
     *)
 
     val printTypes = fn (VALS {say,sayln,term,nonterm,symbolToString,pos_type,
-				 arg_type,
-				 termvoid,ntvoid,saydot,hasType,start,
-				 pureActions,...},
-			   NAMES {valueStruct,...},symbolType) =>
+                                 arg_type,
+                                 termvoid,ntvoid,saydot,hasType,start,
+                                 pureActions,...},
+                           NAMES {valueStruct,...},symbolType) =>
      let val prConstr = fn (symbol,SOME s) => 
-			   say (" | " ^ (symbolName symbol) ^ " of " ^
-			          (if pureActions then "" else "unit -> ") ^
-				" (" ^ tyName s ^ ")"
-				)
-			 | _ => ()
+                           say (" | " ^ (symbolName symbol) ^ " of " ^
+                                  (if pureActions then "" else "unit -> ") ^
+                                " (" ^ tyName s ^ ")"
+                                )
+                         | _ => ()
      in sayln "local open Header in";
-	sayln ("type pos = " ^ pos_type);
-	sayln ("type arg = " ^ arg_type);
-	sayln ("structure " ^ valueStruct ^ " = ");
-	sayln "struct";
-	say ("datatype svalue = " ^ termvoid ^ " | " ^ ntvoid ^ " of" ^
-	     (if pureActions then "" else " unit -> ") ^ " unit");
-	app prConstr term;
-	app prConstr nonterm;
-	sayln "\nend";
-	sayln ("type svalue = " ^ valueStruct ^ ".svalue");
-	say "type result = ";
-	case symbolType (NONTERM start)
-	of NONE => sayln "unit"
-	 | SOME t => (say (tyName t); sayln "");
-	sayln "end"
+        sayln ("type pos = " ^ pos_type);
+        sayln ("type arg = " ^ arg_type);
+        sayln ("structure " ^ valueStruct ^ " = ");
+        sayln "struct";
+        say ("datatype svalue = " ^ termvoid ^ " | " ^ ntvoid ^ " of" ^
+             (if pureActions then "" else " unit -> ") ^ " unit");
+        app prConstr term;
+        app prConstr nonterm;
+        sayln "\nend";
+        sayln ("type svalue = " ^ valueStruct ^ ".svalue");
+        say "type result = ";
+        case symbolType (NONTERM start)
+        of NONE => sayln "unit"
+         | SOME t => (say (tyName t); sayln "");
+        sayln "end"
     end
 
      (* function to print Tokens{n} structure *)
 
     val printTokenStruct =
      fn (VALS {say, sayln, termToString, hasType,termvoid,terms,
-	       pureActions,...},
-	 NAMES {miscStruct,tableStruct,valueStruct,
-		tokenStruct,tokenSig,dataStruct,...}) =>
-		(sayln ("structure " ^ tokenStruct ^ " : " ^ tokenSig ^ " =");
-		 sayln "struct";
-	         sayln ("type svalue = " ^ dataStruct ^ ".svalue");
-		 sayln "type ('a,'b) token = ('a,'b) Token.token";
-		 let val f = fn term as T i =>
-			(say "fun "; say (termToString term);
-			 say " (";
-		         if (hasType (TERM term)) then say "i," else ();
-			 say "p1,p2) = Token.TOKEN (";
-			 say (dataStruct ^ "." ^ tableStruct ^ ".T ");
-			 say (Int.toString i);
-			 say ",(";
-			 say (dataStruct ^ "." ^ valueStruct ^ ".");
-			 if (hasType (TERM term)) then 
-			    (say (termToString term);
-			     if pureActions then say " i"
-			     else say " (fn () => i)")
-			 else say termvoid;
-			 say ",";
-			 sayln "p1,p2))")
-		in app f terms
-		end;
-		sayln "end")
-			  
+               pureActions,...},
+         NAMES {miscStruct,tableStruct,valueStruct,
+                tokenStruct,tokenSig,dataStruct,...}) =>
+                (sayln ("structure " ^ tokenStruct ^ " : " ^ tokenSig ^ " =");
+                 sayln "struct";
+                 sayln ("type svalue = " ^ dataStruct ^ ".svalue");
+                 sayln "type ('a,'b) token = ('a,'b) Token.token";
+                 let val f = fn term as T i =>
+                        (say "fun "; say (termToString term);
+                         say " (";
+                         if (hasType (TERM term)) then say "i," else ();
+                         say "p1,p2) = Token.TOKEN (";
+                         say (dataStruct ^ "." ^ tableStruct ^ ".T ");
+                         say (Int.toString i);
+                         say ",(";
+                         say (dataStruct ^ "." ^ valueStruct ^ ".");
+                         if (hasType (TERM term)) then 
+                            (say (termToString term);
+                             if pureActions then say " i"
+                             else say " (fn () => i)")
+                         else say termvoid;
+                         say ",";
+                         sayln "p1,p2))")
+                in app f terms
+                end;
+                sayln "end")
+                          
     (* function to print signatures out - takes print function which
-	does not need to insert line breaks *)
+        does not need to insert line breaks *)
 
     val printSigs = fn (VALS {term,...},
-			NAMES {tokenSig,tokenStruct,miscSig,
-				dataStruct, dataSig, ...},
-			say) =>
+                        NAMES {tokenSig,tokenStruct,miscSig,
+                                dataStruct, dataSig, ...},
+                        say) =>
           say  ("signature " ^ tokenSig ^ " =\nsig\n\
-		 \type ('a,'b) token\ntype svalue\n" ^
-		 (List.foldr (fn ((s,ty),r) => String.concat [
-		    "val ", symbolName s,
-		    (case ty
-		     of NONE => ": " 
-		      | SOME l => ": (" ^ (tyName l) ^ ") * "),
-		    " 'a * 'a -> (svalue,'a) token\n", r]) "" term) ^
-		 "end\nsignature " ^ miscSig ^
-		  "=\nsig\nstructure Tokens : " ^ tokenSig ^
-		  "\nstructure " ^ dataStruct ^ ":" ^ dataSig ^
-		  "\nsharing type " ^ dataStruct ^
-		  ".Token.token = Tokens.token\nsharing type " ^
-		  dataStruct ^ ".svalue = Tokens.svalue\nend\n")
-		
+                 \type ('a,'b) token\ntype svalue\n" ^
+                 (List.foldr (fn ((s,ty),r) => String.concat [
+                    "val ", symbolName s,
+                    (case ty
+                     of NONE => ": " 
+                      | SOME l => ": (" ^ (tyName l) ^ ") * "),
+                    " 'a * 'a -> (svalue,'a) token\n", r]) "" term) ^
+                 "end\nsignature " ^ miscSig ^
+                  "=\nsig\nstructure Tokens : " ^ tokenSig ^
+                  "\nstructure " ^ dataStruct ^ ":" ^ dataSig ^
+                  "\nsharing type " ^ dataStruct ^
+                  ".Token.token = Tokens.token\nsharing type " ^
+                  dataStruct ^ ".svalue = Tokens.svalue\nend\n")
+                
     (* function to print structure for error correction *)
 
     val printEC = fn (keyword : term list,
-		      preferred_change : (term list * term list) list,
-		      noshift : term list,
-		      value : (term * string) list,
-		      VALS {termToString, say,sayln,terms,saydot,hasType,
-			    termvoid,pureActions,...},
-		      NAMES {ecStruct,tableStruct,valueStruct,...}) =>
+                      preferred_change : (term list * term list) list,
+                      noshift : term list,
+                      value : (term * string) list,
+                      VALS {termToString, say,sayln,terms,saydot,hasType,
+                            termvoid,pureActions,...},
+                      NAMES {ecStruct,tableStruct,valueStruct,...}) =>
        let
 
-	 val sayterm = fn (T i) => (say "(T "; say (Int.toString i); say ")")
+         val sayterm = fn (T i) => (say "(T "; say (Int.toString i); say ")")
 
-	 val printBoolCase = fn ( l : term list) =>
-	    (say "fn ";
-	     app (fn t => (sayterm t; say " => true"; say " | ")) l;
-	     sayln "_ => false")
+         val printBoolCase = fn ( l : term list) =>
+            (say "fn ";
+             app (fn t => (sayterm t; say " => true"; say " | ")) l;
+             sayln "_ => false")
 
-	 val printTermList = fn (l : term list) =>
-	    (app (fn t => (sayterm t; say " :: ")) l; sayln "nil")
+         val printTermList = fn (l : term list) =>
+            (app (fn t => (sayterm t; say " :: ")) l; sayln "nil")
 
-	 fun printChange () =
-	    (sayln "val preferred_change = ";
-	     app (fn (d,i) =>
-		    (say"("; printTermList d; say ","; printTermList i; 
-		     sayln ")::"
-		    )
-		 ) preferred_change;
-	     sayln "nil")
+         fun printChange () =
+            (sayln "val preferred_change = ";
+             app (fn (d,i) =>
+                    (say"("; printTermList d; say ","; printTermList i; 
+                     sayln ")::"
+                    )
+                 ) preferred_change;
+             sayln "nil")
 
-	 val printErrValues = fn (l : (term * string) list) =>
-	    (sayln "local open Header in";
-	     sayln "val errtermvalue=";
-	     say "fn ";
-	     app (fn (t,s) =>
-		    (sayterm t; say " => ";
-		     saydot valueStruct; say (termToString t);
-		     say "(";
-		     if pureActions then () else say "fn () => ";
-		     say "("; say s; say "))";
-		     sayln " | "
-		    )
-		 ) l;
-	    say "_ => ";
-	    say (valueStruct ^ ".");
-	    sayln termvoid; sayln "end")
-	      
+         val printErrValues = fn (l : (term * string) list) =>
+            (sayln "local open Header in";
+             sayln "val errtermvalue=";
+             say "fn ";
+             app (fn (t,s) =>
+                    (sayterm t; say " => ";
+                     saydot valueStruct; say (termToString t);
+                     say "(";
+                     if pureActions then () else say "fn () => ";
+                     say "("; say s; say "))";
+                     sayln " | "
+                    )
+                 ) l;
+            say "_ => ";
+            say (valueStruct ^ ".");
+            sayln termvoid; sayln "end")
+              
 
-	  val printNames = fn () =>
-		let val f = fn term =>
-			 (sayterm term; say " => "; say "\"";
-			  say (termToString term); sayln "\""; say "  | ")
-		in (sayln "val showTerminal =";
-		    say "fn ";
-		    app f terms;
-		    sayln "_ => \"bogus-term\"")
-		end
+          val printNames = fn () =>
+                let val f = fn term =>
+                         (sayterm term; say " => "; say "\"";
+                          say (termToString term); sayln "\""; say "  | ")
+                in (sayln "val showTerminal =";
+                    say "fn ";
+                    app f terms;
+                    sayln "_ => \"bogus-term\"")
+                end
 
-	   val ecTerms = 
-		List.foldr (fn (t,r) =>
-		  if hasType (TERM t) orelse exists (fn (a,_)=>a=t) value
-		    then r
-		    else t::r)
-		[] terms
-				  
-	in  say "structure ";
-	    say ecStruct;
-	    sayln "=";
-	    sayln "struct";
-	    say "open ";
-	    sayln tableStruct;
-	    sayln "val is_keyword =";
-	    printBoolCase keyword;
-	    printChange();
-	    sayln "val noShift = ";
-	    printBoolCase noshift;
-	    printNames ();
-	    printErrValues value;
-	    say "val terms = ";
-	    printTermList ecTerms;
-	    sayln "end"
-	end
+           val ecTerms = 
+                List.foldr (fn (t,r) =>
+                  if hasType (TERM t) orelse exists (fn (a,_)=>a=t) value
+                    then r
+                    else t::r)
+                [] terms
+                                  
+        in  say "structure ";
+            say ecStruct;
+            sayln "=";
+            sayln "struct";
+            say "open ";
+            sayln tableStruct;
+            sayln "val is_keyword =";
+            printBoolCase keyword;
+            printChange();
+            sayln "val noShift = ";
+            printBoolCase noshift;
+            printNames ();
+            printErrValues value;
+            say "val terms = ";
+            printTermList ecTerms;
+            sayln "end"
+        end
 
 val printAction = fn (rules,
-			  VALS {hasType,say,sayln,termvoid,ntvoid,
-			        symbolToString,saydot,start,pureActions,...},
-			  NAMES {actionsStruct,valueStruct,tableStruct,arg,...}) =>
+                          VALS {hasType,say,sayln,termvoid,ntvoid,
+                                symbolToString,saydot,start,pureActions,...},
+                          NAMES {actionsStruct,valueStruct,tableStruct,arg,...}) =>
 let val printAbsynRule = Absyn.printRule(say,sayln)
     val is_nonterm = fn (NONTERM i) => true | _ => false
     val numberRhs = fn r =>
-	List.foldl (fn (e,(r,table)) =>
-		let val num = case SymbolTable.find(e,table)
-			       of SOME i => i
-				| NONE => 1
-		 in ((e,num,hasType e orelse is_nonterm e)::r,
-		     SymbolTable.insert((e,num+1),table))
-		 end) (nil,SymbolTable.empty) r
+        List.foldl (fn (e,(r,table)) =>
+                let val num = case SymbolTable.find(e,table)
+                               of SOME i => i
+                                | NONE => 1
+                 in ((e,num,hasType e orelse is_nonterm e)::r,
+                     SymbolTable.insert((e,num+1),table))
+                 end) (nil,SymbolTable.empty) r
 
     val saySym = symbolToString
 
     val printCase = fn (i:int, r as {lhs=lhs as (NT lhsNum),prec,
-				        rhs,code,rulenum}) =>
+                                        rhs,code,rulenum}) =>
 
        (* mkToken: Build an argument *)
 
        let open Absyn
-	   val mkToken = fn (sym,num : int,typed) =>
-	     let val symString = symbolToString sym
-	       val symNum = symString ^ (Int.toString num)
-	     in PTUPLE[WILD,
-		     PTUPLE[if not (hasType sym) then
-			      (if is_nonterm sym then
-				   PAPP(valueStruct^"."^ntvoid,
-					PVAR symNum)
-			      else WILD)
-			   else	
-			       PAPP(valueStruct^"."^symString,
-			         if num=1 andalso pureActions
-				     then AS(PVAR symNum,PVAR symString)
-				 else PVAR symNum),
-			     if num=1 then AS(PVAR (symString^"left"),
-					      PVAR(symNum^"left"))
-			     else PVAR(symNum^"left"),
-			     if num=1 then AS(PVAR(symString^"right"),
-					      PVAR(symNum^"right"))
-			     else PVAR(symNum^"right")]]
-	     end
+           val mkToken = fn (sym,num : int,typed) =>
+             let val symString = symbolToString sym
+               val symNum = symString ^ (Int.toString num)
+             in PTUPLE[WILD,
+                     PTUPLE[if not (hasType sym) then
+                              (if is_nonterm sym then
+                                   PAPP(valueStruct^"."^ntvoid,
+                                        PVAR symNum)
+                              else WILD)
+                           else 
+                               PAPP(valueStruct^"."^symString,
+                                 if num=1 andalso pureActions
+                                     then AS(PVAR symNum,PVAR symString)
+                                 else PVAR symNum),
+                             if num=1 then AS(PVAR (symString^"left"),
+                                              PVAR(symNum^"left"))
+                             else PVAR(symNum^"left"),
+                             if num=1 then AS(PVAR(symString^"right"),
+                                              PVAR(symNum^"right"))
+                             else PVAR(symNum^"right")]]
+             end
 
             val numberedRhs = #1 (numberRhs rhs)
 
-	(* construct case pattern *)
+        (* construct case pattern *)
 
-	   val pat = PTUPLE[PINT i,PLIST(map mkToken numberedRhs @
-					   [PVAR "rest671"])]
+           val pat = PTUPLE[PINT i,PLIST(map mkToken numberedRhs @
+                                           [PVAR "rest671"])]
 
-	(* remove terminals in argument list w/o types *)
+        (* remove terminals in argument list w/o types *)
 
-	   val argsWithTypes =
-		  List.foldr (fn ((_,_,false),r) => r
-			 | (s as (_,_,true),r) => s::r) nil numberedRhs
+           val argsWithTypes =
+                  List.foldr (fn ((_,_,false),r) => r
+                         | (s as (_,_,true),r) => s::r) nil numberedRhs
 
         (* construct case body *)
 
@@ -6524,294 +6524,294 @@
            val code = CODE code
            val rest = EVAR "rest671"
 
-	   val body =
-	     LET([VB(resultpat,
-		     EAPP(EVAR(valueStruct^"."^
-			     (if hasType (NONTERM lhs)
-				  then saySym(NONTERM lhs)
+           val body =
+             LET([VB(resultpat,
+                     EAPP(EVAR(valueStruct^"."^
+                             (if hasType (NONTERM lhs)
+                                  then saySym(NONTERM lhs)
                                   else ntvoid)),
                           if pureActions then code
-		          else if argsWithTypes=nil then FN(WILD,code)
+                          else if argsWithTypes=nil then FN(WILD,code)
                           else
-			   FN(WILD,
-			     let val body =
-				LET(map (fn (sym,num:int,_) =>
-				  let val symString = symbolToString sym
-				      val symNum = symString ^ Int.toString num
-				  in VB(if num=1 then
-					     AS(PVAR symString,PVAR symNum)
-					else PVAR symNum,
-					EAPP(EVAR symNum,UNIT))
-				  end) (rev argsWithTypes),
-		                      code)
-			     in if hasType (NONTERM lhs) then
-				    body else SEQ(body,UNIT)
-			     end)))],
+                           FN(WILD,
+                             let val body =
+                                LET(map (fn (sym,num:int,_) =>
+                                  let val symString = symbolToString sym
+                                      val symNum = symString ^ Int.toString num
+                                  in VB(if num=1 then
+                                             AS(PVAR symString,PVAR symNum)
+                                        else PVAR symNum,
+                                        EAPP(EVAR symNum,UNIT))
+                                  end) (rev argsWithTypes),
+                                      code)
+                             in if hasType (NONTERM lhs) then
+                                    body else SEQ(body,UNIT)
+                             end)))],
                    ETUPLE[EAPP(EVAR(tableStruct^".NT"),EINT(lhsNum)),
-			  case rhs
-			  of nil => ETUPLE[resultexp,defaultPos,defaultPos]
-			   | r =>let val (rsym,rnum,_) = hd(numberedRhs)
-				     val (lsym,lnum,_) = hd(rev numberedRhs)
-				 in ETUPLE[resultexp,
-					   EVAR (symbolToString lsym ^
-						 Int.toString lnum ^ "left"),
-					   EVAR (symbolToString rsym ^
-						  Int.toString rnum ^ "right")]
-				 end,
+                          case rhs
+                          of nil => ETUPLE[resultexp,defaultPos,defaultPos]
+                           | r =>let val (rsym,rnum,_) = hd(numberedRhs)
+                                     val (lsym,lnum,_) = hd(rev numberedRhs)
+                                 in ETUPLE[resultexp,
+                                           EVAR (symbolToString lsym ^
+                                                 Int.toString lnum ^ "left"),
+                                           EVAR (symbolToString rsym ^
+                                                  Int.toString rnum ^ "right")]
+                                 end,
                            rest])
     in printAbsynRule (RULE(pat,body))
     end
 
-	  val prRules = fn () =>
-	     (sayln "fn (i392,defaultPos,stack,";
-	      say   "    ("; say arg; sayln "):arg) =>";
-	      sayln "case (i392,stack)";
-	      say "of ";
-	      app (fn (rule as {rulenum,...}) =>
-		   (printCase(rulenum,rule); say "| ")) rules;
-	     sayln "_ => raise (mlyAction i392)")
+          val prRules = fn () =>
+             (sayln "fn (i392,defaultPos,stack,";
+              say   "    ("; say arg; sayln "):arg) =>";
+              sayln "case (i392,stack)";
+              say "of ";
+              app (fn (rule as {rulenum,...}) =>
+                   (printCase(rulenum,rule); say "| ")) rules;
+             sayln "_ => raise (mlyAction i392)")
 
-   	in say "structure ";
-	   say actionsStruct;
-	   sayln " =";
-	   sayln "struct ";
-	   sayln "exception mlyAction of int";
-	   sayln "local open Header in";
-	   sayln "val actions = ";
-	   prRules();
-	   sayln "end";
-	   say "val void = ";
-	   saydot valueStruct;
-	   sayln termvoid;
-	   say "val extract = ";
-	   say "fn a => (fn ";
-	   saydot valueStruct;
-	   if hasType (NONTERM start)
-	      then say (symbolToString (NONTERM start))
-	      else say "ntVOID";
-	   sayln " x => x";
-	   sayln "| _ => let exception ParseInternal";
-	   say "\tin raise ParseInternal end) a ";
-	   sayln (if pureActions then "" else "()");
-	   sayln "end"
-	end
+        in say "structure ";
+           say actionsStruct;
+           sayln " =";
+           sayln "struct ";
+           sayln "exception mlyAction of int";
+           sayln "local open Header in";
+           sayln "val actions = ";
+           prRules();
+           sayln "end";
+           say "val void = ";
+           saydot valueStruct;
+           sayln termvoid;
+           say "val extract = ";
+           say "fn a => (fn ";
+           saydot valueStruct;
+           if hasType (NONTERM start)
+              then say (symbolToString (NONTERM start))
+              else say "ntVOID";
+           sayln " x => x";
+           sayln "| _ => let exception ParseInternal";
+           say "\tin raise ParseInternal end) a ";
+           sayln (if pureActions then "" else "()");
+           sayln "end"
+        end
 
     val make_parser = fn ((header,
-	 DECL {eop,change,keyword,nonterm,prec,
-	       term, control,value} : declData,
-	       rules : rule list),spec,error : pos -> string -> unit,
-	       wasError : unit -> bool) =>
+         DECL {eop,change,keyword,nonterm,prec,
+               term, control,value} : declData,
+               rules : rule list),spec,error : pos -> string -> unit,
+               wasError : unit -> bool) =>
      let
-	val verbose = List.exists (fn VERBOSE=>true | _ => false) control
-	val defaultReductions = not (List.exists (fn NODEFAULT=>true | _ => false) control)
-	val pos_type =
-	   let fun f nil = NONE
-		 | f ((POS s)::r) = SOME s 
-		 | f (_::r) = f r
-	   in f control
-	   end
-	val start =
-	   let fun f nil = NONE
-		 | f ((START_SYM s)::r) = SOME s 
-		 | f (_::r) = f r
-	   in f control
-	   end
-	val name =
-	   let fun f nil = NONE
-		 | f ((PARSER_NAME s)::r) = SOME s 
-		 | f (_::r) = f r
-	   in f control
-	   end
-	val header_decl =
-	   let fun f nil = NONE
-		 | f ((FUNCTOR s)::r) = SOME s 
-		 | f (_::r) = f r
-	   in f control
-	   end
-	val arg_decl =
-	   let fun f nil = ("()","unit")
-		 | f ((PARSE_ARG s)::r) = s 
-		 | f (_::r) = f r
-	   in f control
-	   end
+        val verbose = List.exists (fn VERBOSE=>true | _ => false) control
+        val defaultReductions = not (List.exists (fn NODEFAULT=>true | _ => false) control)
+        val pos_type =
+           let fun f nil = NONE
+                 | f ((POS s)::r) = SOME s 
+                 | f (_::r) = f r
+           in f control
+           end
+        val start =
+           let fun f nil = NONE
+                 | f ((START_SYM s)::r) = SOME s 
+                 | f (_::r) = f r
+           in f control
+           end
+        val name =
+           let fun f nil = NONE
+                 | f ((PARSER_NAME s)::r) = SOME s 
+                 | f (_::r) = f r
+           in f control
+           end
+        val header_decl =
+           let fun f nil = NONE
+                 | f ((FUNCTOR s)::r) = SOME s 
+                 | f (_::r) = f r
+           in f control
+           end
+        val arg_decl =
+           let fun f nil = ("()","unit")
+                 | f ((PARSE_ARG s)::r) = s 
+                 | f (_::r) = f r
+           in f control
+           end
 
-	val noshift =
-	   let fun f nil = nil
-		 | f ((NSHIFT s)::r) = s 
-		 | f (_::r) = f r
-	   in f control
-	   end
+        val noshift =
+           let fun f nil = nil
+                 | f ((NSHIFT s)::r) = s 
+                 | f (_::r) = f r
+           in f control
+           end
 
-	val pureActions =
-	   let fun f nil = false
-		 | f ((PURE)::r) = true 
-		 | f (_::r) = f r
-	   in f control
-	   end
+        val pureActions =
+           let fun f nil = false
+                 | f ((PURE)::r) = true 
+                 | f (_::r) = f r
+           in f control
+           end
 
-	val term =
-	 case term
-	   of NONE => (error 1 "missing %term definition"; nil)
-	    | SOME l => l
+        val term =
+         case term
+           of NONE => (error 1 "missing %term definition"; nil)
+            | SOME l => l
 
-	val nonterm =
-	 case nonterm
-	  of NONE => (error 1 "missing %nonterm definition"; nil)
-	   | SOME l => l
+        val nonterm =
+         case nonterm
+          of NONE => (error 1 "missing %nonterm definition"; nil)
+           | SOME l => l
 
-	val pos_type =
-	 case pos_type
-	  of NONE => (error 1 "missing %pos definition"; "")
-	   | SOME l => l
+        val pos_type =
+         case pos_type
+          of NONE => (error 1 "missing %pos definition"; "")
+           | SOME l => l
 
 
-	val termHash = 
-	  List.foldr (fn ((symbol,_),table) =>
-	      let val name = symbolName symbol
-	      in if SymbolHash.exists(name,table) then
-		   (error (symbolPos symbol)
-		          ("duplicate definition of " ^ name ^ " in %term");
-		    table)
-		else SymbolHash.add(name,table)
+        val termHash = 
+          List.foldr (fn ((symbol,_),table) =>
+              let val name = symbolName symbol
+              in if SymbolHash.exists(name,table) then
+                   (error (symbolPos symbol)
+                          ("duplicate definition of " ^ name ^ " in %term");
+                    table)
+                else SymbolHash.add(name,table)
               end) SymbolHash.empty term
 
-	val isTerm = fn name => SymbolHash.exists(name,termHash)
+        val isTerm = fn name => SymbolHash.exists(name,termHash)
 
-	val symbolHash = 
-	  List.foldr (fn ((symbol,_),table) =>
-	    let val name = symbolName symbol
-	    in if SymbolHash.exists(name,table) then
-		 (error (symbolPos symbol)
-	             (if isTerm name then
-		          name ^ " is defined as a terminal and a nonterminal"
-		      else 
-			  "duplicate definition of " ^ name ^ " in %nonterm");
-		     table)
+        val symbolHash = 
+          List.foldr (fn ((symbol,_),table) =>
+            let val name = symbolName symbol
+            in if SymbolHash.exists(name,table) then
+                 (error (symbolPos symbol)
+                     (if isTerm name then
+                          name ^ " is defined as a terminal and a nonterminal"
+                      else 
+                          "duplicate definition of " ^ name ^ " in %nonterm");
+                     table)
              else SymbolHash.add(name,table)
             end) termHash nonterm
 
-	fun makeUniqueId s =
-		if SymbolHash.exists(s,symbolHash) then makeUniqueId (s ^ "'")
-		else s
+        fun makeUniqueId s =
+                if SymbolHash.exists(s,symbolHash) then makeUniqueId (s ^ "'")
+                else s
 
-	val _ = if wasError() then raise Semantic else ()
+        val _ = if wasError() then raise Semantic else ()
 
-	val numTerms = SymbolHash.size termHash
-	val numNonterms = SymbolHash.size symbolHash - numTerms
+        val numTerms = SymbolHash.size termHash
+        val numNonterms = SymbolHash.size symbolHash - numTerms
 
-	val symError = fn sym => fn err => fn symbol =>
-	  error (symbolPos symbol)
-	        (symbolName symbol^" in "^err^" is not defined as a " ^ sym)
+        val symError = fn sym => fn err => fn symbol =>
+          error (symbolPos symbol)
+                (symbolName symbol^" in "^err^" is not defined as a " ^ sym)
 
-	val termNum : string -> Header.symbol -> term =
-	  let val termError = symError "terminal" 
-	  in fn stmt =>
-	     let val stmtError = termError stmt
-	     in fn symbol =>
-	        case SymbolHash.find(symbolName symbol,symbolHash)
-	        of NONE => (stmtError symbol; T ~1)
-	         | SOME i => T (if i<numTerms then i
-			        else (stmtError symbol; ~1))
-	     end
-	  end
-			
-	val nontermNum : string -> Header.symbol -> nonterm =
-	  let val nontermError = symError "nonterminal" 
-	  in fn stmt =>
-	     let val stmtError = nontermError stmt
-	     in fn symbol =>
-	        case SymbolHash.find(symbolName symbol,symbolHash)
-	        of NONE => (stmtError symbol; NT ~1)
-	         | SOME i => if i>=numTerms then NT (i-numTerms)
-			     else (stmtError symbol;NT ~1)
-	     end
-	  end
+        val termNum : string -> Header.symbol -> term =
+          let val termError = symError "terminal" 
+          in fn stmt =>
+             let val stmtError = termError stmt
+             in fn symbol =>
+                case SymbolHash.find(symbolName symbol,symbolHash)
+                of NONE => (stmtError symbol; T ~1)
+                 | SOME i => T (if i<numTerms then i
+                                else (stmtError symbol; ~1))
+             end
+          end
+                        
+        val nontermNum : string -> Header.symbol -> nonterm =
+          let val nontermError = symError "nonterminal" 
+          in fn stmt =>
+             let val stmtError = nontermError stmt
+             in fn symbol =>
+                case SymbolHash.find(symbolName symbol,symbolHash)
+                of NONE => (stmtError symbol; NT ~1)
+                 | SOME i => if i>=numTerms then NT (i-numTerms)
+                             else (stmtError symbol;NT ~1)
+             end
+          end
 
-	val symbolNum : string -> Header.symbol -> Grammar.symbol =
-	  let val symbolError = symError "symbol" 
-	  in fn stmt =>
-	     let val stmtError = symbolError stmt
-	     in fn symbol =>
-	        case SymbolHash.find(symbolName symbol,symbolHash)
-	        of NONE => (stmtError symbol; NONTERM (NT ~1))
-	         | SOME i => if i>=numTerms then NONTERM(NT (i-numTerms))
-			     else TERM(T i)
-	     end
-	  end
+        val symbolNum : string -> Header.symbol -> Grammar.symbol =
+          let val symbolError = symError "symbol" 
+          in fn stmt =>
+             let val stmtError = symbolError stmt
+             in fn symbol =>
+                case SymbolHash.find(symbolName symbol,symbolHash)
+                of NONE => (stmtError symbol; NONTERM (NT ~1))
+                 | SOME i => if i>=numTerms then NONTERM(NT (i-numTerms))
+                             else TERM(T i)
+             end
+          end
 
 (* map all symbols in the following values to terminals and check that
    the symbols are defined as terminals:
 
-	eop : symbol list
-	keyword: symbol list
-	prec: (lexvalue * (symbol list)) list
-	change: (symbol list * symbol list) list
+        eop : symbol list
+        keyword: symbol list
+        prec: (lexvalue * (symbol list)) list
+        change: (symbol list * symbol list) list
 *)
 
-	val eop = map (termNum "%eop") eop
-	val keyword = map (termNum "%keyword") keyword
-	val prec = map (fn (a,l) => 
-			(a,case a
-			   of LEFT => map (termNum "%left") l
-			    | RIGHT => map (termNum "%right") l
-			    | NONASSOC => map (termNum "%nonassoc") l
-			)) prec
-	val change =
-	 let val mapTerm = termNum "%prefer, %subst, or %change"
-	 in map (fn (a,b) => (map mapTerm a, map mapTerm b)) change
-	 end
-	val noshift = map (termNum "%noshift") noshift
-	val value =
-	  let val mapTerm = termNum "%value"
-	  in map (fn (a,b) => (mapTerm a,b)) value
-	  end
-	val (rules,_) =
-	   let val symbolNum = symbolNum "rule"
-	       val nontermNum = nontermNum "rule"
-	       val termNum = termNum "%prec tag"
+        val eop = map (termNum "%eop") eop
+        val keyword = map (termNum "%keyword") keyword
+        val prec = map (fn (a,l) => 
+                        (a,case a
+                           of LEFT => map (termNum "%left") l
+                            | RIGHT => map (termNum "%right") l
+                            | NONASSOC => map (termNum "%nonassoc") l
+                        )) prec
+        val change =
+         let val mapTerm = termNum "%prefer, %subst, or %change"
+         in map (fn (a,b) => (map mapTerm a, map mapTerm b)) change
+         end
+        val noshift = map (termNum "%noshift") noshift
+        val value =
+          let val mapTerm = termNum "%value"
+          in map (fn (a,b) => (mapTerm a,b)) value
+          end
+        val (rules,_) =
+           let val symbolNum = symbolNum "rule"
+               val nontermNum = nontermNum "rule"
+               val termNum = termNum "%prec tag"
            in List.foldr
-	   (fn (RULE {lhs,rhs,code,prec},(l,n)) =>
-	     ( {lhs=nontermNum lhs,rhs=map symbolNum rhs,
-	        code=code,prec=case prec
-				of NONE => NONE
-				 | SOME t => SOME (termNum t),
-		 rulenum=n}::l,n-1))
-		 (nil,length rules-1) rules
-	end
+           (fn (RULE {lhs,rhs,code,prec},(l,n)) =>
+             ( {lhs=nontermNum lhs,rhs=map symbolNum rhs,
+                code=code,prec=case prec
+                                of NONE => NONE
+                                 | SOME t => SOME (termNum t),
+                 rulenum=n}::l,n-1))
+                 (nil,length rules-1) rules
+        end
 
-	val _ = if wasError() then raise Semantic else ()
+        val _ = if wasError() then raise Semantic else ()
 
-	(* termToString: map terminals back to strings *)
+        (* termToString: map terminals back to strings *)
 
-	val termToString =
-	   let val data = array(numTerms,"")
-	       val unmap = fn (symbol,_) =>
-		   let val name = symbolName symbol
+        val termToString =
+           let val data = array(numTerms,"")
+               val unmap = fn (symbol,_) =>
+                   let val name = symbolName symbol
                    in update(data,
-			     case SymbolHash.find(name,symbolHash)
-			     of SOME i => i,name)
+                             case SymbolHash.find(name,symbolHash)
+                             of SOME i => i,name)
                    end
-	       val _ = app unmap term
-	   in fn T i =>
-		if DEBUG andalso (i<0 orelse i>=numTerms)
-		  then "bogus-num" ^ (Int.toString i)
-		  else data sub i
-	   end
+               val _ = app unmap term
+           in fn T i =>
+                if DEBUG andalso (i<0 orelse i>=numTerms)
+                  then "bogus-num" ^ (Int.toString i)
+                  else data sub i
+           end
 
-	val nontermToString = 
-	   let val data = array(numNonterms,"")
-	       val unmap = fn (symbol,_) =>
-		    let val name = symbolName symbol
-		    in update(data,
-			      case SymbolHash.find(name,symbolHash)
-			      of SOME i => i-numTerms,name)
-		    end
-	       val _ = app unmap nonterm
-	   in fn NT i =>
-		if DEBUG andalso (i<0 orelse i>=numNonterms)
-		  then "bogus-num" ^ (Int.toString i)
-		  else data sub i
-	   end
+        val nontermToString = 
+           let val data = array(numNonterms,"")
+               val unmap = fn (symbol,_) =>
+                    let val name = symbolName symbol
+                    in update(data,
+                              case SymbolHash.find(name,symbolHash)
+                              of SOME i => i-numTerms,name)
+                    end
+               val _ = app unmap nonterm
+           in fn NT i =>
+                if DEBUG andalso (i<0 orelse i>=numNonterms)
+                  then "bogus-num" ^ (Int.toString i)
+                  else data sub i
+           end
 
 (* create functions mapping terminals to precedence numbers and rules to
   precedence numbers.
@@ -6825,9 +6825,9 @@
   Internally, a tighter binding has a higher precedence number.  We give
   precedences using multiples of 3:
 
-		p+2 = right associative (force shift of symbol)
-		p+1 = precedence for rule
-		p = left associative (force reduction of rule)
+                p+2 = right associative (force shift of symbol)
+                p+1 = precedence for rule
+                p = left associative (force reduction of rule)
 
   Nonassociative terminals are given also given a precedence of p+1.  The
 table generator detects when the associativity of a nonassociative terminal
@@ -6836,206 +6836,206 @@
 
   A rule is given the precedence of its rightmost terminal *)
 
-	val termPrec =
-	    let val precData = array(numTerms, NONE : int option)
-	        val addPrec = fn termPrec => fn term as (T i) =>
-		   case precData sub i
-		   of SOME _ =>
-		     error 1 ("multiple precedences specified for terminal " ^
-			    (termToString term))
-		    | NONE => update(precData,i,termPrec)
-		val termPrec = fn ((LEFT,_) ,i) => i
-			      | ((RIGHT,_),i) => i+2
-			      | ((NONASSOC,l),i) => i+1
-		val _ = List.foldl (fn (args as ((_,l),i)) =>
-			        (app (addPrec (SOME (termPrec args))) l; i+3))
-			  0 prec
-	   in fn (T i) =>
-		if  DEBUG andalso (i < 0 orelse i >= numTerms) then
-			NONE
-		else precData sub i
-	   end
+        val termPrec =
+            let val precData = array(numTerms, NONE : int option)
+                val addPrec = fn termPrec => fn term as (T i) =>
+                   case precData sub i
+                   of SOME _ =>
+                     error 1 ("multiple precedences specified for terminal " ^
+                            (termToString term))
+                    | NONE => update(precData,i,termPrec)
+                val termPrec = fn ((LEFT,_) ,i) => i
+                              | ((RIGHT,_),i) => i+2
+                              | ((NONASSOC,l),i) => i+1
+                val _ = List.foldl (fn (args as ((_,l),i)) =>
+                                (app (addPrec (SOME (termPrec args))) l; i+3))
+                          0 prec
+           in fn (T i) =>
+                if  DEBUG andalso (i < 0 orelse i >= numTerms) then
+                        NONE
+                else precData sub i
+           end
 
         val elimAssoc =  fn i => (i - (i mod 3) + 1)
-	val rulePrec = 
-	   let fun findRightTerm (nil,r) = r
-	         | findRightTerm (TERM t :: tail,r) =
-				 findRightTerm(tail,SOME t)
-		 | findRightTerm (_ :: tail,r) = findRightTerm(tail,r)
-	   in fn rhs =>
-		 case findRightTerm(rhs,NONE)
-		 of NONE => NONE
-		  | SOME term => 
-		       case termPrec term
-		       of SOME i => SOME  (elimAssoc i)
-		        | a => a
-	   end
+        val rulePrec = 
+           let fun findRightTerm (nil,r) = r
+                 | findRightTerm (TERM t :: tail,r) =
+                                 findRightTerm(tail,SOME t)
+                 | findRightTerm (_ :: tail,r) = findRightTerm(tail,r)
+           in fn rhs =>
+                 case findRightTerm(rhs,NONE)
+                 of NONE => NONE
+                  | SOME term => 
+                       case termPrec term
+                       of SOME i => SOME  (elimAssoc i)
+                        | a => a
+           end
 
-	val grammarRules =
-	  let val conv = fn {lhs,rhs,code,prec,rulenum} =>
-		{lhs=lhs,rhs =rhs,precedence=
-			case prec
-			  of SOME t => (case termPrec t
-			                of SOME i => SOME(elimAssoc i)
+        val grammarRules =
+          let val conv = fn {lhs,rhs,code,prec,rulenum} =>
+                {lhs=lhs,rhs =rhs,precedence=
+                        case prec
+                          of SOME t => (case termPrec t
+                                        of SOME i => SOME(elimAssoc i)
                                          | a => a)
-			   | _ => rulePrec rhs,
-	         rulenum=rulenum}
-	  in map conv rules
-	  end
+                           | _ => rulePrec rhs,
+                 rulenum=rulenum}
+          in map conv rules
+          end
 
     (* get start symbol *)
 
-	val start =
-	 case start
-	   of NONE => #lhs (hd grammarRules)
-	    | SOME name => 
-		nontermNum "%start" name
+        val start =
+         case start
+           of NONE => #lhs (hd grammarRules)
+            | SOME name => 
+                nontermNum "%start" name
 
-	val symbolType = 
-	   let val data = array(numTerms+numNonterms,NONE : ty option)
-	       val unmap = fn (symbol,ty) =>
-		      update(data,
-			     case SymbolHash.find(symbolName symbol,symbolHash)
-			     of SOME i => i,ty)
-	       val _ = (app unmap term; app unmap nonterm)
-	   in fn NONTERM(NT i) =>
-		if DEBUG andalso (i<0 orelse i>=numNonterms)
-		  then NONE
-		  else data sub (i+numTerms)
-	       | TERM (T i) =>
-		if DEBUG andalso (i<0 orelse i>=numTerms)
-		  then NONE
-		  else data sub i
-	   end
+        val symbolType = 
+           let val data = array(numTerms+numNonterms,NONE : ty option)
+               val unmap = fn (symbol,ty) =>
+                      update(data,
+                             case SymbolHash.find(symbolName symbol,symbolHash)
+                             of SOME i => i,ty)
+               val _ = (app unmap term; app unmap nonterm)
+           in fn NONTERM(NT i) =>
+                if DEBUG andalso (i<0 orelse i>=numNonterms)
+                  then NONE
+                  else data sub (i+numTerms)
+               | TERM (T i) =>
+                if DEBUG andalso (i<0 orelse i>=numTerms)
+                  then NONE
+                  else data sub i
+           end
 
-	val symbolToString = 
-	     fn NONTERM i => nontermToString i
-	      | TERM i => termToString i
+        val symbolToString = 
+             fn NONTERM i => nontermToString i
+              | TERM i => termToString i
 
-	val grammar  = GRAMMAR {rules=grammarRules,
-				 terms=numTerms,nonterms=numNonterms,
-				 eop = eop, start=start,noshift=noshift,
-				 termToString = termToString,
-				 nontermToString = nontermToString,
-				 precedence = termPrec}
+        val grammar  = GRAMMAR {rules=grammarRules,
+                                 terms=numTerms,nonterms=numNonterms,
+                                 eop = eop, start=start,noshift=noshift,
+                                 termToString = termToString,
+                                 nontermToString = nontermToString,
+                                 precedence = termPrec}
 
-	val name' = case name 
-	            of NONE => ""
-		     | SOME s => symbolName s
+        val name' = case name 
+                    of NONE => ""
+                     | SOME s => symbolName s
 
-	val names = NAMES {miscStruct=name' ^ "LrValsFun",
-			   valueStruct="MlyValue",
-			   tableStruct="LrTable",
-			   tokenStruct="Tokens",
-			   actionsStruct="Actions",
-			   ecStruct="EC",
-			   arg= #1 arg_decl,
-			   tokenSig = name' ^ "_TOKENS",
-			   miscSig = name' ^ "_LRVALS",
-			   dataStruct = "ParserData",
-			   dataSig = "PARSER_DATA"}
-		       
-	val (table,stateErrs,corePrint,errs) =
-		 MakeTable.mkTable(grammar,defaultReductions)
+        val names = NAMES {miscStruct=name' ^ "LrValsFun",
+                           valueStruct="MlyValue",
+                           tableStruct="LrTable",
+                           tokenStruct="Tokens",
+                           actionsStruct="Actions",
+                           ecStruct="EC",
+                           arg= #1 arg_decl,
+                           tokenSig = name' ^ "_TOKENS",
+                           miscSig = name' ^ "_LRVALS",
+                           dataStruct = "ParserData",
+                           dataSig = "PARSER_DATA"}
+                       
+        val (table,stateErrs,corePrint,errs) =
+                 MakeTable.mkTable(grammar,defaultReductions)
 
         val entries = ref 0 (* save number of action table entries here *)
-	
+        
     in  let val result = TextIO.openOut (spec ^ ".sml")
- 	    val sigs = TextIO.openOut (spec ^ ".sig")
-	    val pos = ref 0
-	    val pr = fn s => TextIO.output(result,s)
-	    val say = fn s => let val l = String.size s
-			           val newPos = (!pos) + l
-			      in if newPos > lineLength 
-				    then (pr "\n"; pos := l)
-				    else (pos := newPos);
-				   pr s
-			      end
-	    val saydot = fn s => (say (s ^ "."))
-	    val sayln = fn t => (pr t; pr "\n"; pos := 0)
-	    val termvoid = makeUniqueId "VOID"
-	    val ntvoid = makeUniqueId "ntVOID"
-	    val hasType = fn s => case symbolType s
-				  of NONE => false
-				   | _ => true
-	    val terms = let fun f n = if n=numTerms then nil
-				      else (T n) :: f(n+1)
-		        in f 0
-		        end
+            val sigs = TextIO.openOut (spec ^ ".sig")
+            val pos = ref 0
+            val pr = fn s => TextIO.output(result,s)
+            val say = fn s => let val l = String.size s
+                                   val newPos = (!pos) + l
+                              in if newPos > lineLength 
+                                    then (pr "\n"; pos := l)
+                                    else (pos := newPos);
+                                   pr s
+                              end
+            val saydot = fn s => (say (s ^ "."))
+            val sayln = fn t => (pr t; pr "\n"; pos := 0)
+            val termvoid = makeUniqueId "VOID"
+            val ntvoid = makeUniqueId "ntVOID"
+            val hasType = fn s => case symbolType s
+                                  of NONE => false
+                                   | _ => true
+            val terms = let fun f n = if n=numTerms then nil
+                                      else (T n) :: f(n+1)
+                        in f 0
+                        end
             val values = VALS {say=say,sayln=sayln,saydot=saydot,
-		 	       termvoid=termvoid, ntvoid = ntvoid,
-			       hasType=hasType, pos_type = pos_type,
-			       arg_type = #2 arg_decl,
-			       start=start,pureActions=pureActions,
-			       termToString=termToString,
-			       symbolToString=symbolToString,term=term,
-			       nonterm=nonterm,terms=terms}
+                               termvoid=termvoid, ntvoid = ntvoid,
+                               hasType=hasType, pos_type = pos_type,
+                               arg_type = #2 arg_decl,
+                               start=start,pureActions=pureActions,
+                               termToString=termToString,
+                               symbolToString=symbolToString,term=term,
+                               nonterm=nonterm,terms=terms}
 
-	    val (NAMES {miscStruct,tableStruct,dataStruct,tokenSig,tokenStruct,dataSig,...}) = names
+            val (NAMES {miscStruct,tableStruct,dataStruct,tokenSig,tokenStruct,dataSig,...}) = names
          in case header_decl
-	    of NONE => (say "functor "; say miscStruct; 
-			sayln "(structure Token : TOKEN)";
-			say " : sig structure ";
-			say dataStruct;
-			say " : "; sayln dataSig;
-			say "       structure ";
-			say tokenStruct; say " : "; sayln tokenSig;
-			sayln "   end")
-	     | SOME s => say s;
-	    sayln " = ";
-	    sayln "struct";
-	    sayln ("structure " ^ dataStruct ^ "=");
-	    sayln "struct";
-	    sayln "structure Header = ";
-	    sayln "struct";
-	    sayln header;
-	    sayln "end";
-	    sayln "structure LrTable = Token.LrTable";
-	    sayln "structure Token = Token";
-	    sayln "local open LrTable in ";
-	    entries := PrintStruct.makeStruct{table=table,print=pr,
-					      name = "table",
-				              verbose=verbose};
-	    sayln "end";
-	    printTypes(values,names,symbolType);
-	    printEC (keyword,change,noshift,value,values,names);
-	    printAction(rules,values,names);
-	    sayln "end";
-	    printTokenStruct(values,names);
-	    sayln "end";
-	    printSigs(values,names,fn s => TextIO.output(sigs,s));    
-	    TextIO.closeOut sigs;
-	    TextIO.closeOut result;
-	    MakeTable.Errs.printSummary
-	    (fn s => () (* commented out by sweeks so it runs silently
-			 TextIO.output(TextIO.stdOut,s) *)) errs
-	end;
+            of NONE => (say "functor "; say miscStruct; 
+                        sayln "(structure Token : TOKEN)";
+                        say " : sig structure ";
+                        say dataStruct;
+                        say " : "; sayln dataSig;
+                        say "       structure ";
+                        say tokenStruct; say " : "; sayln tokenSig;
+                        sayln "   end")
+             | SOME s => say s;
+            sayln " = ";
+            sayln "struct";
+            sayln ("structure " ^ dataStruct ^ "=");
+            sayln "struct";
+            sayln "structure Header = ";
+            sayln "struct";
+            sayln header;
+            sayln "end";
+            sayln "structure LrTable = Token.LrTable";
+            sayln "structure Token = Token";
+            sayln "local open LrTable in ";
+            entries := PrintStruct.makeStruct{table=table,print=pr,
+                                              name = "table",
+                                              verbose=verbose};
+            sayln "end";
+            printTypes(values,names,symbolType);
+            printEC (keyword,change,noshift,value,values,names);
+            printAction(rules,values,names);
+            sayln "end";
+            printTokenStruct(values,names);
+            sayln "end";
+            printSigs(values,names,fn s => TextIO.output(sigs,s));    
+            TextIO.closeOut sigs;
+            TextIO.closeOut result;
+            MakeTable.Errs.printSummary
+            (fn s => () (* commented out by sweeks so it runs silently
+                         TextIO.output(TextIO.stdOut,s) *)) errs
+        end;
         if verbose then
-	 let val f = TextIO.openOut (spec ^ ".desc")
-	     val say = fn s=> TextIO.output(f,s)
-	     val printRule =
-	        let val rules = Array.fromList grammarRules
-	        in fn say => 
-		   let val prRule = fn {lhs,rhs,precedence,rulenum} =>
-		     ((say o nontermToString) lhs; say " : ";
-		      app (fn s => (say (symbolToString s); say " ")) rhs)
-	           in fn i => prRule (rules sub i)
-	           end
-	        end
-	 in Verbose.printVerbose
-	    {termToString=termToString,nontermToString=nontermToString,
-	     table=table, stateErrs=stateErrs,errs = errs,entries = !entries,
-	     print=say, printCores=corePrint,printRule=printRule};
-	    TextIO.closeOut f
-	 end
+         let val f = TextIO.openOut (spec ^ ".desc")
+             val say = fn s=> TextIO.output(f,s)
+             val printRule =
+                let val rules = Array.fromList grammarRules
+                in fn say => 
+                   let val prRule = fn {lhs,rhs,precedence,rulenum} =>
+                     ((say o nontermToString) lhs; say " : ";
+                      app (fn s => (say (symbolToString s); say " ")) rhs)
+                   in fn i => prRule (rules sub i)
+                   end
+                end
+         in Verbose.printVerbose
+            {termToString=termToString,nontermToString=nontermToString,
+             table=table, stateErrs=stateErrs,errs = errs,entries = !entries,
+             print=say, printCores=corePrint,printRule=printRule};
+            TextIO.closeOut f
+         end
         else ()
     end
 
     val parseGen = fn spec =>
-		let val (result,inputSource) = ParseGenParser.parse spec
-		in make_parser(getResult result,spec,Header.error inputSource,
-				errorOccurred inputSource)
-		end
+                let val (result,inputSource) = ParseGenParser.parse spec
+                in make_parser(getResult result,spec,Header.error inputSource,
+                                errorOccurred inputSource)
+                end
 end;
 (* ML-Yacc Parser Generator (c) 1991 Andrew W. Appel, David R. Tarditi 
  *
@@ -7081,11 +7081,11 @@
       | idchar c = Char.isAlpha c orelse Char.isDigit c
 
     fun code_to_ids s = let
-	  fun g(nil,r) = r
+          fun g(nil,r) = r
             | g(a as (h::t),r) = if Char.isAlpha h then f(t,[h],r) else g(t,r)
           and f(nil,accum,r)= implode(rev accum)::r
             | f(a as (h::t),accum,r) =
-		if idchar h then f(t,h::accum,r) else g(a,implode (rev accum) :: r)
+                if idchar h then f(t,h::accum,r) else g(a,implode (rev accum) :: r)
           in g(explode s,nil)
           end
 
@@ -7112,7 +7112,7 @@
                           of WILD => WILD
                            | pat' => PAPP(s,pat'))
                      | (PLIST l) =>
-	                  let val l' = map f l
+                          let val l' = map f l
                           in if List.exists(fn WILD=>false | _ => true) l'
                                 then PLIST l'
                              else WILD
@@ -7140,7 +7140,7 @@
                      | f(FN(p,e)) = FN(simplifyPat p,f e) 
                      | f(LET(dl,e)) = 
                           LET(map (fn VB(p,e) =>
-	                          VB(simplifyPat p,f e)) dl,
+                                  VB(simplifyPat p,f e)) dl,
                               f e)
                      | f(SEQ(a,b)) = SEQ(f a,f b)
                      | f a = a
@@ -7150,7 +7150,7 @@
        end
 
        fun printRule (say : string -> unit, sayln:string -> unit) = let
-	 val lp = ["("]
+         val lp = ["("]
          val rp = [")"]
          val sp = [" "]
          val sm = [";"]
@@ -7158,15 +7158,15 @@
          val cr = ["\n"]
          val unit = ["()"]
           fun printExp c =
-	   let fun f (CODE c) = ["(",c,")"]
+           let fun f (CODE c) = ["(",c,")"]
                  | f (EAPP(EVAR a,UNIT)) = [a," ","()"]
                  | f (EAPP(EVAR a,EINT i)) =  [a," ",Int.toString i]
                  | f (EAPP(EVAR a,EVAR b)) = [a," ",b]
                  | f (EAPP(EVAR a,b)) = List.concat[[a],lp,f b,rp]
                  | f (EAPP(a,b)) = List.concat [lp,f a,rp,lp,f b,rp]
-	         | f (EINT i) = [Int.toString i]
+                 | f (EINT i) = [Int.toString i]
                  | f (ETUPLE (a::r)) = 
-	              let fun scan nil = [rp]
+                      let fun scan nil = [rp]
                             | scan (h :: t) = cm :: f h :: scan t
                       in List.concat (lp :: f a :: scan r)
                       end
@@ -7175,10 +7175,10 @@
                  | f (FN (p,b)) = List.concat[["fn "],printPat p,[" => "],f b]
                  | f (LET (nil,body)) = f body
                  | f (LET (dl,body)) =
-	              let fun scan nil = [[" in "],f body,[" end"],cr]
+                      let fun scan nil = [[" in "],f body,[" end"],cr]
                             | scan (h :: t) = printDecl h :: scan t
-	              in List.concat(["let "] :: scan dl)
-	              end
+                      in List.concat(["let "] :: scan dl)
+                      end
                  | f (SEQ (a,b)) = List.concat [lp,f a,sm,f b,rp]
                  | f (UNIT) = unit
           in f c
@@ -7186,21 +7186,21 @@
          and printDecl (VB (pat,exp)) =
                   List.concat[["val "],printPat pat,["="],printExp exp,cr]
          and printPat c =
-	   let fun f (AS(PVAR a,PVAR b)) = [a," as ",b]
+           let fun f (AS(PVAR a,PVAR b)) = [a," as ",b]
                  | f (AS(a,b)) = List.concat [lp,f a,[") as ("],f b,rp]
                  | f (PAPP(a,WILD)) = [a," ","_"]
                  | f (PAPP(a,PINT i)) =  [a," ",Int.toString i]
                  | f (PAPP(a,PVAR b)) = [a," ",b]
                  | f (PAPP(a,b)) = List.concat [lp,[a],sp,f b,rp]
-	         | f (PINT i) = [Int.toString i]
+                 | f (PINT i) = [Int.toString i]
                  | f (PLIST nil) = ["<bogus-list>"]
                  | f (PLIST l) =
-	              let fun scan (h :: nil) = [f h]
+                      let fun scan (h :: nil) = [f h]
                             | scan (h :: t) = f h :: ["::"] :: scan t
                       in List.concat (scan l)
                       end
                  | f (PTUPLE (a::r)) = 
-	              let fun scan nil = [rp]
+                      let fun scan nil = [rp]
                             | scan (h :: t) = cm :: f h :: scan t
                       in List.concat (lp :: f a :: scan r)
                       end
@@ -7209,12 +7209,12 @@
                  | f WILD = ["_"]
            in f c
            end
-	   fun oursay "\n" = sayln ""
-	     | oursay a = say a
+           fun oursay "\n" = sayln ""
+             | oursay a = say a
          in fn a => 
-	      let val RULE(p,e) = simplifyRule a
+              let val RULE(p,e) = simplifyRule a
               in app oursay (printPat p);
-	         say " => ";
+                 say " => ";
                  app oursay (printExp e)
               end
          end
@@ -7231,20 +7231,20 @@
 (* create parser *)
 
    structure LrVals = MlyaccLrValsFun(structure Token = LrParser.Token
-				      structure Hdr = Header)
+                                      structure Hdr = Header)
    structure Lex = LexMLYACC(structure Tokens = LrVals.Tokens
-			     structure Hdr = Header)
+                             structure Hdr = Header)
    structure Parser = JoinWithArg(structure Lex=Lex
-			         structure ParserData = LrVals.ParserData
-			         structure LrParser= LrParser)
+                                 structure ParserData = LrVals.ParserData
+                                 structure LrParser= LrParser)
    structure ParseGenParser =
-	   ParseGenParserFun(structure Parser = Parser
-	                     structure Header = Header)
+           ParseGenParserFun(structure Parser = Parser
+                             structure Header = Header)
 
 (* create structure for computing LALR table from a grammar *)
 
    structure MakeLrTable = mkMakeLrTable(structure IntGrammar =IntGrammar
-				     structure LrTable = LrTable)
+                                     structure LrTable = LrTable)
 
 (* create structures for printing LALR tables:
 
@@ -7254,7 +7254,7 @@
    structure Verbose = mkVerbose(structure Errs = MakeLrTable.Errs)
    structure PrintStruct =
        mkPrintStruct(structure LrTable = MakeLrTable.LrTable
-		     structure ShrinkLrTable =
+                     structure ShrinkLrTable =
                           ShrinkLrTableFun(structure LrTable=LrTable))
 in
 
@@ -7262,10 +7262,10 @@
   does semantic checks, creates table, and prints it *)
 
    structure ParseGen = ParseGenFun(structure ParseGenParser = ParseGenParser
-			            structure MakeTable = MakeLrTable
-			            structure Verbose = Verbose
-			            structure PrintStruct = PrintStruct
-				    structure Absyn = Absyn)
+                                    structure MakeTable = MakeLrTable
+                                    structure Verbose = Verbose
+                                    structure PrintStruct = PrintStruct
+                                    structure Absyn = Absyn)
 end
 
 signature BMARK =
@@ -7281,11 +7281,11 @@
     val s = OS.FileSys.getDir()
     fun doit size =
        let
-	  fun loop n =
-	     if n = 0
-		then ()
-	     else (ParseGen.parseGen(s^"/DATA/ml.grm");
-		   loop(n - 1))
+          fun loop n =
+             if n = 0
+                then ()
+             else (ParseGen.parseGen(s^"/DATA/ml.grm");
+                   loop(n - 1))
        in loop size
        end
     fun testit _ = ParseGen.parseGen(s^"/DATA/ml.grm")

Modified: mlton/branches/on-20050420-cmm-branch/benchmark/tests/model-elimination.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/benchmark/tests/model-elimination.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/benchmark/tests/model-elimination.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -18,11 +18,11 @@
    sig
       type ppstream
       type ppconsumer = { consumer  : string -> unit,
-			 linewidth : int,
-			 flush     : unit -> unit }
+                         linewidth : int,
+                         flush     : unit -> unit }
 
       datatype break_style = 
-	 CONSISTENT
+         CONSISTENT
        | INCONSISTENT
 
       val mk_ppstream    : ppconsumer -> ppstream
@@ -299,12 +299,12 @@
   fun top (Istack stk) =
       case !stk
         of nil => raise Fail "PP-error: top: badly formed block"
-	 | x::_ => x
+         | x::_ => x
   fun push (x,(Istack stk)) = stk := x::(!stk)
   fun pop (Istack stk) =
       case !stk
         of nil => raise Fail "PP-error: pop: badly formed block"
-	 | _::rest => stk := rest
+         | _::rest => stk := rest
 end
 
 (* The delim_stack is used to compute the size of blocks. It is
@@ -375,8 +375,8 @@
 type ppstream = ppstream_
 
 type ppconsumer = {consumer : string -> unit,
-		   linewidth : int,
-		   flush : unit -> unit}
+                   linewidth : int,
+                   flush : unit -> unit}
 
 fun mk_ppstream {consumer,linewidth,flush} =
     if (linewidth<5)
@@ -384,17 +384,17 @@
     else let val buf_size = 3*linewidth
           in magic(
              PPS{consumer = consumer,
-		 linewidth = linewidth,
-		 flush = flush,
-		 the_token_buffer = array(buf_size, initial_token_value),
-		 the_delim_stack = new_delim_stack buf_size,
-		 the_indent_stack = mk_indent_stack (),
-		 ++ = fn i => i := ((!i + 1) mod buf_size),
-		 space_left = ref linewidth,
-		 left_index = ref 0, right_index = ref 0,
-		 left_sum = ref 0, right_sum = ref 0}
+                 linewidth = linewidth,
+                 flush = flush,
+                 the_token_buffer = array(buf_size, initial_token_value),
+                 the_delim_stack = new_delim_stack buf_size,
+                 the_indent_stack = mk_indent_stack (),
+                 ++ = fn i => i := ((!i + 1) mod buf_size),
+                 space_left = ref linewidth,
+                 left_index = ref 0, right_index = ref 0,
+                 left_sum = ref 0, right_sum = ref 0}
                  ) : ppstream
-	 end
+         end
 
 fun dest_ppstream(pps : ppstream) =
   let val PPS{consumer,linewidth,flush, ...} = magic pps
@@ -407,13 +407,13 @@
   val space_table = Vector.tabulate(100, fn i => mk_space(i,[]))
   fun nspaces n = Vector.sub(space_table, n)
       handle General.Subscript =>
-	if n < 0
-	then ""
-	else let val n2 = n div 2
-		 val n2_spaces = nspaces n2
-		 val extra = if (n = (2*n2)) then "" else space
+        if n < 0
+        then ""
+        else let val n2 = n div 2
+                 val n2_spaces = nspaces n2
+                 val extra = if (n = (2*n2)) then "" else space
               in String.concat [n2_spaces, n2_spaces, extra]
-	     end
+             end
 in
   fun cr_indent (ofn, i) = ofn ("\n"^(nspaces i))
   fun indent (ofn,i) = ofn (nspaces i)
@@ -437,30 +437,30 @@
        (push ((if (!Block_size > sp_left)
                then ONE_PER_LINE (linewidth - (sp_left - Block_offset))
                else FITS),
-	      the_indent_stack);
+              the_indent_stack);
         Pblocks := rst)
   | print_BB(PPS{the_indent_stack,linewidth,space_left=ref sp_left,...},
              {Pblocks as ref({Block_size,Block_offset,...}::rst),Ublocks=ref[]}) =
        (push ((if (!Block_size > sp_left)
                then PACK_ONTO_LINE (linewidth - (sp_left - Block_offset))
                else FITS),
-	      the_indent_stack);
+              the_indent_stack);
         Pblocks := rst)
   | print_BB (PPS{the_indent_stack, linewidth, space_left=ref sp_left,...},
               {Ublocks,...}) =
       let fun pr_end_Ublock [{How_to_indent=CONSISTENT,Block_size,Block_offset}] l =
-		(push ((if (!Block_size > sp_left)
-			then ONE_PER_LINE (linewidth - (sp_left - Block_offset))
-			else FITS),
-		       the_indent_stack);
+                (push ((if (!Block_size > sp_left)
+                        then ONE_PER_LINE (linewidth - (sp_left - Block_offset))
+                        else FITS),
+                       the_indent_stack);
                  List.rev l)
-	    | pr_end_Ublock [{Block_size,Block_offset,...}] l =
-		(push ((if (!Block_size > sp_left)
-			then PACK_ONTO_LINE (linewidth - (sp_left - Block_offset))
-			else FITS),
-		       the_indent_stack);
+            | pr_end_Ublock [{Block_size,Block_offset,...}] l =
+                (push ((if (!Block_size > sp_left)
+                        then PACK_ONTO_LINE (linewidth - (sp_left - Block_offset))
+                        else FITS),
+                       the_indent_stack);
                  List.rev l)
-	    | pr_end_Ublock (a::rst) l = pr_end_Ublock rst (a::l)
+            | pr_end_Ublock (a::rst) l = pr_end_Ublock rst (a::l)
             | pr_end_Ublock _ _ =
                 raise Fail "PP-error: print_BB: internal error"
        in Ublocks := pr_end_Ublock(!Ublocks) []
@@ -472,7 +472,7 @@
       raise Fail "PP-error: print_E"
   | print_E (istack,{Pend, ...}) =
       let fun pop_n_times 0 = ()
-	    | pop_n_times n = (pop istack; pop_n_times(n-1))
+            | pop_n_times n = (pop istack; pop_n_times(n-1))
        in pop_n_times(!Pend); Pend := 0
       end
 
@@ -489,21 +489,21 @@
                  BR{Distance_to_next_break,Number_of_blanks,Break_offset}) =
      (case (top the_indent_stack)
         of FITS =>
-	     (space_left := (!space_left) - Number_of_blanks;
+             (space_left := (!space_left) - Number_of_blanks;
               indent (consumer,Number_of_blanks))
          | (ONE_PER_LINE cursor) =>
              let val new_cursor = cursor + Break_offset
               in space_left := linewidth - new_cursor;
                  cr_indent (consumer,new_cursor)
-	     end
+             end
          | (PACK_ONTO_LINE cursor) =>
-	     if (!Distance_to_next_break > (!space_left))
-	     then let val new_cursor = cursor + Break_offset
-		   in space_left := linewidth - new_cursor;
-		      cr_indent(consumer,new_cursor)
-		  end
-	     else (space_left := !space_left - Number_of_blanks;
-		   indent (consumer,Number_of_blanks)))
+             if (!Distance_to_next_break > (!space_left))
+             then let val new_cursor = cursor + Break_offset
+                   in space_left := linewidth - new_cursor;
+                      cr_indent(consumer,new_cursor)
+                  end
+             else (space_left := !space_left - Number_of_blanks;
+                   indent (consumer,Number_of_blanks)))
 
 
 fun clear_ppstream(pps : ppstream) =
@@ -512,17 +512,17 @@
                 left_index, right_index,space_left,linewidth,...}
               = magic pps
         val buf_size = 3*linewidth
-	fun set i =
-	    if (i = buf_size)
-	    then ()
-	    else (update(the_token_buffer,i,initial_token_value);
-		  set (i+1))
+        fun set i =
+            if (i = buf_size)
+            then ()
+            else (update(the_token_buffer,i,initial_token_value);
+                  set (i+1))
      in set 0;
-	clear_indent_stack the_indent_stack;
-	reset_delim_stack the_delim_stack;
-	left_sum := 0; right_sum := 0;
-	left_index := 0; right_index := 0;
-	space_left := linewidth
+        clear_indent_stack the_indent_stack;
+        reset_delim_stack the_delim_stack;
+        left_sum := 0; right_sum := 0;
+        left_index := 0; right_index := 0;
+        space_left := linewidth
     end
 
 
@@ -544,44 +544,44 @@
     (!left_index = !right_index) andalso
     (case (the_token_buffer sub (!left_index))
        of (BB {Pblocks = ref [], Ublocks = ref []}) => true
-	| (BB _) => false
-	| (E {Pend = ref 0, Uend = ref 0}) => true
-	| (E _) => false
-	| _ => true)
+        | (BB _) => false
+        | (E {Pend = ref 0, Uend = ref 0}) => true
+        | (E _) => false
+        | _ => true)
 
 fun advance_left (ppstrm as PPS{consumer,left_index,left_sum,
                                 the_token_buffer,++,...},
                   instr) =
     let val NEG = ~1
-	val POS = 0
-	fun inc_left_sum (BR{Number_of_blanks, ...}) =
-		 left_sum := (!left_sum) + Number_of_blanks
-	  | inc_left_sum (S{Length, ...}) = left_sum := (!left_sum) + Length
-	  | inc_left_sum _ = ()
+        val POS = 0
+        fun inc_left_sum (BR{Number_of_blanks, ...}) =
+                 left_sum := (!left_sum) + Number_of_blanks
+          | inc_left_sum (S{Length, ...}) = left_sum := (!left_sum) + Length
+          | inc_left_sum _ = ()
 
-	fun last_size [{Block_size, ...}:block_info] = !Block_size
-	  | last_size (_::rst) = last_size rst
+        fun last_size [{Block_size, ...}:block_info] = !Block_size
+          | last_size (_::rst) = last_size rst
           | last_size _ = raise Fail "PP-error: last_size: internal error"
-	fun token_size (S{Length, ...}) = Length
-	  | token_size (BB b) =
-	     (case b
+        fun token_size (S{Length, ...}) = Length
+          | token_size (BB b) =
+             (case b
                 of {Pblocks = ref [], Ublocks = ref []} =>
                      raise Fail "PP-error: BB_size"
-	         | {Pblocks as ref(_::_),Ublocks=ref[]} => POS
-		 | {Ublocks, ...} => last_size (!Ublocks))
-	  | token_size (E{Pend = ref 0, Uend = ref 0}) =
+                 | {Pblocks as ref(_::_),Ublocks=ref[]} => POS
+                 | {Ublocks, ...} => last_size (!Ublocks))
+          | token_size (E{Pend = ref 0, Uend = ref 0}) =
               raise Fail "PP-error: token_size.E"
-	  | token_size (E{Pend = ref 0, ...}) = NEG
-	  | token_size (E _) = POS
-	  | token_size (BR {Distance_to_next_break, ...}) = !Distance_to_next_break
-	fun loop (instr) =
-	    if (token_size instr < 0)  (* synchronization point; cannot advance *)
-	    then ()
-	    else (print_token(ppstrm,instr);
-		  inc_left_sum instr;
-		  if (pointers_coincide ppstrm)
-		  then ()
-		  else (* increment left index *)
+          | token_size (E{Pend = ref 0, ...}) = NEG
+          | token_size (E _) = POS
+          | token_size (BR {Distance_to_next_break, ...}) = !Distance_to_next_break
+        fun loop (instr) =
+            if (token_size instr < 0)  (* synchronization point; cannot advance *)
+            then ()
+            else (print_token(ppstrm,instr);
+                  inc_left_sum instr;
+                  if (pointers_coincide ppstrm)
+                  then ()
+                  else (* increment left index *)
 
     (* When this is evaluated, we know that the left_index has not yet
        caught up to the right_index. If we are at a BB or an E, we can
@@ -593,19 +593,19 @@
        that the index is not pushed onto the delim_stack. This can lead to
        mangled output.)
     *)
-		       (case (the_token_buffer sub (!left_index))
-			  of (BB {Pblocks = ref [], Ublocks = ref []}) =>
-			       (update(the_token_buffer,!left_index,
-				       initial_token_value);
-				++left_index)
-			   | (BB _) => ()
-			   | (E {Pend = ref 0, Uend = ref 0}) =>
-			       (update(the_token_buffer,!left_index,
-				       initial_token_value);
-				++left_index)
-			   | (E _) => ()
-			   | _ => ++left_index;
-			loop (the_token_buffer sub (!left_index))))
+                       (case (the_token_buffer sub (!left_index))
+                          of (BB {Pblocks = ref [], Ublocks = ref []}) =>
+                               (update(the_token_buffer,!left_index,
+                                       initial_token_value);
+                                ++left_index)
+                           | (BB _) => ()
+                           | (E {Pend = ref 0, Uend = ref 0}) =>
+                               (update(the_token_buffer,!left_index,
+                                       initial_token_value);
+                                ++left_index)
+                           | (E _) => ()
+                           | _ => ++left_index;
+                        loop (the_token_buffer sub (!left_index))))
      in loop instr
     end
 
@@ -618,21 +618,21 @@
   in
    (if (delim_stack_is_empty the_delim_stack)
     then (left_index := 0;
-	  left_sum := 1;
-	  right_index := 0;
-	  right_sum := 1)
+          left_sum := 1;
+          right_index := 0;
+          right_sum := 1)
     else BB_inc_right_index ppstrm;
     case (the_token_buffer sub (!right_index))
       of (BB {Ublocks, ...}) =>
-	   Ublocks := {Block_size = ref (~(!right_sum)),
-		       Block_offset = offset,
-		       How_to_indent = style}::(!Ublocks)
+           Ublocks := {Block_size = ref (~(!right_sum)),
+                       Block_offset = offset,
+                       How_to_indent = style}::(!Ublocks)
        | _ => (update(the_token_buffer, !right_index,
-		      BB{Pblocks = ref [],
-			 Ublocks = ref [{Block_size = ref (~(!right_sum)),
-					 Block_offset = offset,
-					 How_to_indent = style}]});
-	       push_delim_stack (!right_index, the_delim_stack)))
+                      BB{Pblocks = ref [],
+                         Ublocks = ref [{Block_size = ref (~(!right_sum)),
+                                         Block_offset = offset,
+                                         How_to_indent = style}]});
+               push_delim_stack (!right_index, the_delim_stack)))
   end
 
 fun end_block(pps : ppstream) =
@@ -643,42 +643,42 @@
     if (delim_stack_is_empty the_delim_stack)
     then print_token(ppstrm,(E{Pend = ref 1, Uend = ref 0}))
     else (E_inc_right_index ppstrm;
-	  case (the_token_buffer sub (!right_index))
+          case (the_token_buffer sub (!right_index))
             of (E{Uend, ...}) => Uend := !Uend + 1
-	     | _ => (update(the_token_buffer,!right_index,
-			    E{Uend = ref 1, Pend = ref 0});
-		     push_delim_stack (!right_index, the_delim_stack)))
+             | _ => (update(the_token_buffer,!right_index,
+                            E{Uend = ref 1, Pend = ref 0});
+                     push_delim_stack (!right_index, the_delim_stack)))
   end
 
 local
   fun check_delim_stack(PPS{the_token_buffer,the_delim_stack,right_sum,...}) =
       let fun check k =
-	      if (delim_stack_is_empty the_delim_stack)
-	      then ()
-	      else case(the_token_buffer sub (top_delim_stack the_delim_stack))
-		     of (BB{Ublocks as ref ((b as {Block_size, ...})::rst),
-			    Pblocks}) =>
-			   if (k>0)
-			   then (Block_size := !right_sum + !Block_size;
-				 Pblocks := b :: (!Pblocks);
-				 Ublocks := rst;
-				 if (List.length rst = 0)
-				 then pop_delim_stack the_delim_stack
-				 else ();
-				 check(k-1))
-			   else ()
-		      | (E{Pend,Uend}) =>
-			   (Pend := (!Pend) + (!Uend);
-			    Uend := 0;
-			    pop_delim_stack the_delim_stack;
-			    check(k + !Pend))
-		      | (BR{Distance_to_next_break, ...}) =>
-			   (Distance_to_next_break :=
-			      !right_sum + !Distance_to_next_break;
-			    pop_delim_stack the_delim_stack;
-			    if (k>0)
-			    then check k
-			    else ())
+              if (delim_stack_is_empty the_delim_stack)
+              then ()
+              else case(the_token_buffer sub (top_delim_stack the_delim_stack))
+                     of (BB{Ublocks as ref ((b as {Block_size, ...})::rst),
+                            Pblocks}) =>
+                           if (k>0)
+                           then (Block_size := !right_sum + !Block_size;
+                                 Pblocks := b :: (!Pblocks);
+                                 Ublocks := rst;
+                                 if (List.length rst = 0)
+                                 then pop_delim_stack the_delim_stack
+                                 else ();
+                                 check(k-1))
+                           else ()
+                      | (E{Pend,Uend}) =>
+                           (Pend := (!Pend) + (!Uend);
+                            Uend := 0;
+                            pop_delim_stack the_delim_stack;
+                            check(k + !Pend))
+                      | (BR{Distance_to_next_break, ...}) =>
+                           (Distance_to_next_break :=
+                              !right_sum + !Distance_to_next_break;
+                            pop_delim_stack the_delim_stack;
+                            if (k>0)
+                            then check k
+                            else ())
                       | _ => raise Fail "PP-error: check_delim_stack.catchall"
        in check 0
       end
@@ -692,12 +692,12 @@
     in
       (if (delim_stack_is_empty the_delim_stack)
        then (left_index := 0; right_index := 0;
-	     left_sum := 1;   right_sum := 1)
+             left_sum := 1;   right_sum := 1)
        else ++right_index;
        update(the_token_buffer, !right_index,
-	      BR{Distance_to_next_break = ref (~(!right_sum)),
-		 Number_of_blanks = n,
-		 Break_offset = break_offset});
+              BR{Distance_to_next_break = ref (~(!right_sum)),
+                 Number_of_blanks = n,
+                 Break_offset = break_offset});
        check_delim_stack ppstrm;
        right_sum := (!right_sum) + n;
        push_delim_stack (!right_index,the_delim_stack))
@@ -711,7 +711,7 @@
       (if (delim_stack_is_empty the_delim_stack)
        then ()
        else (check_delim_stack ppstrm;
-	     advance_left(ppstrm, the_token_buffer sub (!left_index)));
+             advance_left(ppstrm, the_token_buffer sub (!left_index)));
        flush())
     end
 
@@ -729,40 +729,40 @@
                 left_index,space_left,++,...}
               = ppstrm
         fun fnl [{Block_size, ...}:block_info] = Block_size := INFINITY
-	  | fnl (_::rst) = fnl rst
+          | fnl (_::rst) = fnl rst
           | fnl _ = raise Fail "PP-error: fnl: internal error"
 
-	fun set(dstack,BB{Ublocks as ref[{Block_size,...}:block_info],...}) =
-	      (pop_bottom_delim_stack dstack;
-	       Block_size := INFINITY)
-	  | set (_,BB {Ublocks = ref(_::rst), ...}) = fnl rst
-	  | set (dstack, E{Pend,Uend}) =
-	      (Pend := (!Pend) + (!Uend);
-	       Uend := 0;
-	       pop_bottom_delim_stack dstack)
-	  | set (dstack,BR{Distance_to_next_break,...}) =
-	      (pop_bottom_delim_stack dstack;
-	       Distance_to_next_break := INFINITY)
+        fun set(dstack,BB{Ublocks as ref[{Block_size,...}:block_info],...}) =
+              (pop_bottom_delim_stack dstack;
+               Block_size := INFINITY)
+          | set (_,BB {Ublocks = ref(_::rst), ...}) = fnl rst
+          | set (dstack, E{Pend,Uend}) =
+              (Pend := (!Pend) + (!Uend);
+               Uend := 0;
+               pop_bottom_delim_stack dstack)
+          | set (dstack,BR{Distance_to_next_break,...}) =
+              (pop_bottom_delim_stack dstack;
+               Distance_to_next_break := INFINITY)
           | set _ = raise (Fail "PP-error: add_string.set")
 
-	fun check_stream () =
-	    if ((!right_sum - !left_sum) > !space_left)
-	    then if (delim_stack_is_empty the_delim_stack)
-		 then ()
-		 else let val i = bottom_delim_stack the_delim_stack
-		       in if (!left_index = i)
-			  then set (the_delim_stack, the_token_buffer sub i)
-			  else ();
-			  advance_left(ppstrm,
+        fun check_stream () =
+            if ((!right_sum - !left_sum) > !space_left)
+            then if (delim_stack_is_empty the_delim_stack)
+                 then ()
+                 else let val i = bottom_delim_stack the_delim_stack
+                       in if (!left_index = i)
+                          then set (the_delim_stack, the_token_buffer sub i)
+                          else ();
+                          advance_left(ppstrm,
                                        the_token_buffer sub (!left_index));
-		          if (pointers_coincide ppstrm)
-		          then ()
-		          else check_stream ()
-		      end
-	    else ()
+                          if (pointers_coincide ppstrm)
+                          then ()
+                          else check_stream ()
+                      end
+            else ()
 
-	val slen = String.size s
-	val S_token = S{String = s, Length = slen}
+        val slen = String.size s
+        val S_token = S{String = s, Length = slen}
 
     in if (delim_stack_is_empty the_delim_stack)
        then print_token(ppstrm,S_token)
@@ -792,10 +792,10 @@
 
 fun pp_to_string linewidth ppfn ob =
     let val l = ref ([]:string list)
-	fun attach s = l := (s::(!l))
+        fun attach s = l := (s::(!l))
      in with_pp {consumer = attach, linewidth=linewidth, flush = fn()=>()}
-		(fn ppstrm =>  ppfn ppstrm ob);
-	String.concat(List.rev(!l))
+                (fn ppstrm =>  ppfn ppstrm ob);
+        String.concat(List.rev(!l))
     end
 end
 (*#line 0.0 "$HOME/dev/sml/basic/src/Binarymap.sig"*)
@@ -893,8 +893,8 @@
  *      University of Southampton
  *   Address:  Electronics & Computer Science
  *             University of Southampton
- *	     Southampton  SO9 5NH
- *	     Great Britian
+ *           Southampton  SO9 5NH
+ *           Great Britian
  *   E-mail:   sra@ecs.soton.ac.uk
  *
  *   Comments:
@@ -926,10 +926,10 @@
 and ('key, 'a) tree =
     E 
   | T of {key   : 'key, 
-	  value : 'a, 
-	  cnt   : int, 
-	  left  : ('key, 'a) tree, 
-	  right : ('key, 'a) tree}
+          value : 'a, 
+          cnt   : int, 
+          left  : ('key, 'a) tree, 
+          right : ('key, 'a) tree}
 
 fun treeSize E            = 0
   | treeSize (T{cnt,...}) = cnt
@@ -950,12 +950,12 @@
           N(a,av,x,N(b,bv,y,z))
       | single_R _ = raise Match
     fun double_L (a,av,w,T{key=c,value=cv, 
-			   left=T{key=b,value=bv,left=x,right=y,...},
-			   right=z,...}) =
+                           left=T{key=b,value=bv,left=x,right=y,...},
+                           right=z,...}) =
           N(b,bv,N(a,av,w,x),N(c,cv,y,z))
       | double_L _ = raise Match
     fun double_R (c,cv,T{key=a,value=av,left=w,
-			 right=T{key=b,value=bv,left=x,right=y,...},...},z) = 
+                         right=T{key=b,value=bv,left=x,right=y,...},...},z) = 
           N(b,bv,N(a,av,w,x),N(c,cv,y,z))
       | double_R _ = raise Match
 
@@ -1002,55 +1002,55 @@
   
       fun delmin (T{left=E,right,...}) = right
         | delmin (T{key,value,left,right,...}) = 
-	  T'(key,value,delmin left,right)
+          T'(key,value,delmin left,right)
         | delmin _ = raise Match
     in
       fun delete' (E,r) = r
         | delete' (l,E) = l
         | delete' (l,r) = let val (mink,minv) = min r 
-			  in T'(mink,minv,l,delmin r) end
+                          in T'(mink,minv,l,delmin r) end
     end
 in
     fun mkDict cmpKey = DICT(cmpKey, E)
     
     fun insert (DICT (cmpKey, t),x,v) = 
-	let fun ins E = T{key=x,value=v,cnt=1,left=E,right=E}
-	      | ins (T(set as {key,left,right,value,...})) =
-		case cmpKey (key,x) of
-		    GREATER => T'(key,value,ins left,right)
-		  | LESS    => T'(key,value,left,ins right)
-		  | _       => 
-			T{key=x,value=v,left=left,right=right,cnt= #cnt set}
-	in DICT(cmpKey, ins t) end
+        let fun ins E = T{key=x,value=v,cnt=1,left=E,right=E}
+              | ins (T(set as {key,left,right,value,...})) =
+                case cmpKey (key,x) of
+                    GREATER => T'(key,value,ins left,right)
+                  | LESS    => T'(key,value,left,ins right)
+                  | _       => 
+                        T{key=x,value=v,left=left,right=right,cnt= #cnt set}
+        in DICT(cmpKey, ins t) end
 
     fun find (DICT(cmpKey, t), x) =
-	let fun mem E = raise NotFound
-	      | mem (T(n as {key,left,right,...})) =
-		case cmpKey (x,key) of
-		    GREATER => mem right
-		  | LESS    => mem left
-		  | _       => #value n
-	in mem t end
+        let fun mem E = raise NotFound
+              | mem (T(n as {key,left,right,...})) =
+                case cmpKey (x,key) of
+                    GREATER => mem right
+                  | LESS    => mem left
+                  | _       => #value n
+        in mem t end
 
     fun peek arg = (SOME(find arg)) handle NotFound => NONE
 
     fun remove (DICT(cmpKey, t), x) = 
-	let fun rm E = raise NotFound
-	      | rm (set as T{key,left,right,value,...}) = 
-		(case cmpKey (key,x) of
-		     GREATER => let val (left', v) = rm left
-				in (T'(key, value, left', right), v) end
-		   | LESS    => let val (right', v) = rm right
-				in (T'(key, value, left, right'), v) end
-		   | _       => (delete'(left,right),value))
-	    val (newtree, valrm) = rm t
-	in (DICT(cmpKey, newtree), valrm) end
+        let fun rm E = raise NotFound
+              | rm (set as T{key,left,right,value,...}) = 
+                (case cmpKey (key,x) of
+                     GREATER => let val (left', v) = rm left
+                                in (T'(key, value, left', right), v) end
+                   | LESS    => let val (right', v) = rm right
+                                in (T'(key, value, left, right'), v) end
+                   | _       => (delete'(left,right),value))
+            val (newtree, valrm) = rm t
+        in (DICT(cmpKey, newtree), valrm) end
 
     fun listItems (DICT(_, d)) = 
-	let fun d2l E res = res
-	      | d2l (T{key,value,left,right,...}) res =
-		d2l left ((key,value) :: d2l right res)
-	in d2l d [] end
+        let fun d2l E res = res
+              | d2l (T{key,value,left,right,...}) res =
+                d2l left ((key,value) :: d2l right res)
+        in d2l d [] end
 
     fun revapp f (DICT(_, d)) = let
       fun a E = ()
@@ -1083,13 +1083,13 @@
       in DICT(cmpKey, a d) end
 
     fun transform f (DICT(cmpKey, d)) = 
-	let fun a E = E
-	      | a (T{key,value,left,right,cnt}) = 
-		let val left' = a left
-		in
-		    T{cnt=cnt, key=key, value=f value, left = left', 
-		      right = a right}
-		end
+        let fun a E = E
+              | a (T{key,value,left,right,cnt}) = 
+                let val left' = a left
+                in
+                    T{cnt=cnt, key=key, value=f value, left = left', 
+                      right = a right}
+                end
       in DICT(cmpKey, a d) end
 end
 
@@ -2543,8 +2543,8 @@
   val sort_ops : infixities -> infixities =
     let
        fun order {prec, tok = _, left_assoc = _}
-	  {prec = prec', tok = _, left_assoc = _} =
-	  prec < prec'
+          {prec = prec', tok = _, left_assoc = _} =
+          prec < prec'
     in sort order
     end;
   fun unflatten ({tok, prec, left_assoc}, ([], _)) =

Modified: mlton/branches/on-20050420-cmm-branch/benchmark/tests/mpuz.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/benchmark/tests/mpuz.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/benchmark/tests/mpuz.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -14,17 +14,17 @@
       open List
 
       fun exists(l, p) = List.exists p l
-	 
+         
       fun map(l, f) = List.map f l
 
       fun fold(l, b, f) =
-	 let
-	    fun loop(l, b) =
-	       case l of
-		  [] => b
-		| x :: l => loop(l, f(x, b))
-	 in loop(l, b)
-	 end
+         let
+            fun loop(l, b) =
+               case l of
+                  [] => b
+                | x :: l => loop(l, f(x, b))
+         in loop(l, b)
+         end
 
       fun foreach(l, f) = fold(l, (), fn (x, ()) => f x)
    end
@@ -34,108 +34,108 @@
       open String
 
       fun fold(s, b, f) =
-	 let
-	    val n = size s
-	    fun loop(i, b) =
-	       if i = n
-		  then b
-	       else loop(i + 1, f(String.sub(s, i), b))
-	 in loop(0, b)
-	 end
+         let
+            val n = size s
+            fun loop(i, b) =
+               if i = n
+                  then b
+               else loop(i + 1, f(String.sub(s, i), b))
+         in loop(0, b)
+         end
    end
 
 structure Mpuz =
    struct
       fun solve(a, b, c, d, e) =
-	 let
-	    fun printNewline() = print "\n"
-	    val sub = Array.sub
-	    val update = Array.update
+         let
+            fun printNewline() = print "\n"
+            val sub = Array.sub
+            val update = Array.update
 
-	    val letters =
-	       List.fold
-	       ([a, b, c, d, e], [], fn (s, letters) =>
-		String.fold
-		(s, letters, fn (c, letters) =>
-		 if List.exists(letters, fn c' => c = c')
-		    then letters
-		 else c :: letters))
+            val letters =
+               List.fold
+               ([a, b, c, d, e], [], fn (s, letters) =>
+                String.fold
+                (s, letters, fn (c, letters) =>
+                 if List.exists(letters, fn c' => c = c')
+                    then letters
+                 else c :: letters))
 
-	    val letterValues =
-	       Array.array(Char.ord Char.maxChar + 1, 0)
+            val letterValues =
+               Array.array(Char.ord Char.maxChar + 1, 0)
 
-	    fun letterValue(c) =
-	       Array.sub(letterValues, ord c)
+            fun letterValue(c) =
+               Array.sub(letterValues, ord c)
 
-	    fun setLetterValue(c, v) =
-	       Array.update(letterValues, ord c, v)
+            fun setLetterValue(c, v) =
+               Array.update(letterValues, ord c, v)
 
-	    fun stringValue(s) =
-	       String.fold(s, 0, fn (c, v) => v * 10 + letterValue c)
+            fun stringValue(s) =
+               String.fold(s, 0, fn (c, v) => v * 10 + letterValue c)
 
-	    fun printResult() =
-	       (List.foreach
-		(letters, fn c =>
-		 print(concat[String.str(c), " = ",
-			      Int.toString(letterValue(c)), " "]))
-		; print "\n")
+            fun printResult() =
+               (List.foreach
+                (letters, fn c =>
+                 print(concat[String.str(c), " = ",
+                              Int.toString(letterValue(c)), " "]))
+                ; print "\n")
 
-	    fun testOk() =
-	       let
-		  val b0 = letterValue(String.sub(b, 1))
-		  val b1 = letterValue(String.sub(b, 0))
-		  val a = stringValue a
-		  val b = stringValue b
-		  val c = stringValue c
-		  val d = stringValue d
-		  val e = stringValue e
-	       in if a * b0 = c
-		     andalso a * b1 = d
-		     andalso a * b = e
-		     andalso c + d * 10 = e
-		     then printResult()
-		  else ()
-	       end
+            fun testOk() =
+               let
+                  val b0 = letterValue(String.sub(b, 1))
+                  val b1 = letterValue(String.sub(b, 0))
+                  val a = stringValue a
+                  val b = stringValue b
+                  val c = stringValue c
+                  val d = stringValue d
+                  val e = stringValue e
+               in if a * b0 = c
+                     andalso a * b1 = d
+                     andalso a * b = e
+                     andalso c + d * 10 = e
+                     then printResult()
+                  else ()
+               end
 
-	    val values = List.map([0, 1, 2, 3, 4, 5, 6, 7, 8, 9], fn v =>
-				  (v, ref false))
+            val values = List.map([0, 1, 2, 3, 4, 5, 6, 7, 8, 9], fn v =>
+                                  (v, ref false))
 
-	    (* Try all assignments of values to letters. *)
-	    fun loop(letters) =
-	       case letters of
-		  [] => testOk()
-		| c :: letters =>
-		     List.foreach
-		     (values, fn (v, r) =>
-		      if !r
-			 then ()
-		      else (r := true
-			    ; setLetterValue(c, v)
-			    ; loop(letters)
-			    ; r := false))
+            (* Try all assignments of values to letters. *)
+            fun loop(letters) =
+               case letters of
+                  [] => testOk()
+                | c :: letters =>
+                     List.foreach
+                     (values, fn (v, r) =>
+                      if !r
+                         then ()
+                      else (r := true
+                            ; setLetterValue(c, v)
+                            ; loop(letters)
+                            ; r := false))
 
-	 in loop(letters)
-	 end
+         in loop(letters)
+         end
    end
 
 structure Main =
    struct
       fun doit() =
-	 Mpuz.solve("AGH", "FB", "CBEE", "GHFD", "FGIJE")
+         Mpuz.solve("AGH", "FB", "CBEE", "GHFD", "FGIJE")
       (*
        * Solution:
        * J = 0 I = 1 D = 8 E = 2 C = 5 B = 6 F = 4 H = 7 G = 3 A = 9
        *)
 
       val doit =
-	 fn size =>
-	 let
-	    fun loop n =
-	       if n = 0
-		  then ()
-	       else (doit();
-		     loop(n-1))
-	 in
-	    loop size
-	 end
+         fn size =>
+         let
+            fun loop n =
+               if n = 0
+                  then ()
+               else (doit();
+                     loop(n-1))
+         in
+            loop size
+         end
    end

Modified: mlton/branches/on-20050420-cmm-branch/benchmark/tests/nucleic.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/benchmark/tests/nucleic.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/benchmark/tests/nucleic.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -19,13 +19,13 @@
 
 fun math_atan2 y x =
       if (x > 0.0)
-	then Math.atan (y / x)
+        then Math.atan (y / x)
       else if Real.==(x, 0.0)
-	then if y < 0.0
-	  then constant_minus_pi2
+        then if y < 0.0
+          then constant_minus_pi2
           else Math.atan (y / x) + constant_minus_pi
       else if Real.==(x, 0.0)
-	then constant_pi2
+        then constant_pi2
         else (Math.atan (y / x) + constant_pi)
 
 (* -- POINTS ----------------------------------------------------------------*)
@@ -3463,180 +3463,180 @@
 (* Anticodon*)
 
     fun anticodon () =
-	  queue_to_list (search [] (anticodon_domains ()) anticodon_constraint)
+          queue_to_list (search [] (anticodon_domains ()) anticodon_constraint)
 
     fun anticodon_length () = length(anticodon())
 
 
     fun pseudoknot_domains () =
        [
-	reference rA  23,
-	wc_Dumas  rU   8 23,
-	helix3'   rG  22 23,
-	wc_Dumas  rC   9 22,
-	helix3'   rG  21 22,
-	wc_Dumas  rC  10 21,
-	helix3'   rC  20 21,
-	wc_Dumas  rG  11 20,
-	helix3'   rU' 19 20, (* <-. *)
-	wc_Dumas  rA  12 19, (*   | Distance *)
+        reference rA  23,
+        wc_Dumas  rU   8 23,
+        helix3'   rG  22 23,
+        wc_Dumas  rC   9 22,
+        helix3'   rG  21 22,
+        wc_Dumas  rC  10 21,
+        helix3'   rC  20 21,
+        wc_Dumas  rG  11 20,
+        helix3'   rU' 19 20, (* <-. *)
+        wc_Dumas  rA  12 19, (*   | Distance *)
 (*                                | Constraint *)
 (* ; Helix 1               ;      | 4.0 Angstroms *)
-	helix3'   rC   3 19, (*   | *)
-	wc_Dumas  rG  13  3, (*   | *)
-	helix3'   rC   2  3, (*   | *)
-	wc_Dumas  rG  14  2, (*   | *)
-	helix3'   rC   1  2, (*   | *)
-	wc_Dumas  rG' 15  1, (*   | *)
+        helix3'   rC   3 19, (*   | *)
+        wc_Dumas  rG  13  3, (*   | *)
+        helix3'   rC   2  3, (*   | *)
+        wc_Dumas  rG  14  2, (*   | *)
+        helix3'   rC   1  2, (*   | *)
+        wc_Dumas  rG' 15  1, (*   | *)
 (*                                | *)
 (* L2 LOOP                        | *)
-	p_o3'     rUs 16 15, (*   | *)
-	p_o3'     rCs 17 16, (*   | *)
-	p_o3'     rAs 18 17, (* <-' *)
+        p_o3'     rUs 16 15, (*   | *)
+        p_o3'     rCs 17 16, (*   | *)
+        p_o3'     rAs 18 17, (* <-' *)
 (*                                  *)
 (* L1 LOOP *)
-	helix3'   rU   7  8, (* <-. *)
-	p_o3'     rCs  4  3, (*   | Constraint *)
-	stacked5' rU   5  4, (*   | 4.5 Angstroms *)
-	stacked5' rC   6  5 (* <-' *)
-	]
+        helix3'   rU   7  8, (* <-. *)
+        p_o3'     rCs  4  3, (*   | Constraint *)
+        stacked5' rU   5  4, (*   | 4.5 Angstroms *)
+        stacked5' rC   6  5 (* <-' *)
+        ]
 
        fun pseudoknot_constraint (i, t, n) partial_inst =
-	  case i of
-	     18 =>
-		let
-		   val p = atom_pos nuc_P (get_var 19 partial_inst)
-		   val o3' = atom_pos nuc_O3' (i, t, n)
-		in
-		   pt_dist p o3' <= 4.0
-		end
-	   | 6 =>
-		let
-		   val p = atom_pos nuc_P (get_var 7 partial_inst)
-		   val o3' = atom_pos nuc_O3' (i, t, n)
-		in
-		   pt_dist p o3' <= 4.5
-		end
-	   | _ => true
+          case i of
+             18 =>
+                let
+                   val p = atom_pos nuc_P (get_var 19 partial_inst)
+                   val o3' = atom_pos nuc_O3' (i, t, n)
+                in
+                   pt_dist p o3' <= 4.0
+                end
+           | 6 =>
+                let
+                   val p = atom_pos nuc_P (get_var 7 partial_inst)
+                   val o3' = atom_pos nuc_O3' (i, t, n)
+                in
+                   pt_dist p o3' <= 4.5
+                end
+           | _ => true
 
        fun pseudoknot () =
-	  search [] (pseudoknot_domains ()) pseudoknot_constraint
+          search [] (pseudoknot_domains ()) pseudoknot_constraint
 
        fun maximum (xs: real list) =
-	  let
-	     fun loop (m, l) =
-		case l of
-		   [] => m
-		 | x :: l => loop (if x > m then x else m, l)
-	  in
-	     case xs of
-		[] => raise Fail "bug"
-	      | x :: xs => loop (x, xs)
-	  end
+          let
+             fun loop (m, l) =
+                case l of
+                   [] => m
+                 | x :: l => loop (if x > m then x else m, l)
+          in
+             case xs of
+                [] => raise Fail "bug"
+              | x :: xs => loop (x, xs)
+          end
        
        fun list_of_common_atoms n =
-	  [
-	   nuc_P    n,
-	   nuc_O1P  n,
-	   nuc_O2P  n,
-	   nuc_O5'  n,
-	   nuc_C5'  n,
-	   nuc_H5'  n,
-	   nuc_H5'' n,
-	   nuc_C4'  n,
-	   nuc_H4'  n,
-	   nuc_O4'  n,
-	   nuc_C1'  n,
-	   nuc_H1'  n,
-	   nuc_C2'  n,
-	   nuc_H2'' n,
-	   nuc_O2'  n,
-	   nuc_H2'  n,
-	   nuc_C3'  n,
-	   nuc_H3'  n,
-	   nuc_O3'  n,
-	   nuc_N1   n,
-	   nuc_N3   n,
-	   nuc_C2   n,
-	   nuc_C4   n,
-	   nuc_C5   n,
-	   nuc_C6   n
-	   ]
+          [
+           nuc_P    n,
+           nuc_O1P  n,
+           nuc_O2P  n,
+           nuc_O5'  n,
+           nuc_C5'  n,
+           nuc_H5'  n,
+           nuc_H5'' n,
+           nuc_C4'  n,
+           nuc_H4'  n,
+           nuc_O4'  n,
+           nuc_C1'  n,
+           nuc_H1'  n,
+           nuc_C2'  n,
+           nuc_H2'' n,
+           nuc_O2'  n,
+           nuc_H2'  n,
+           nuc_C3'  n,
+           nuc_H3'  n,
+           nuc_O3'  n,
+           nuc_N1   n,
+           nuc_N3   n,
+           nuc_C2   n,
+           nuc_C4   n,
+           nuc_C5   n,
+           nuc_C6   n
+           ]
 
        fun list_of_specific_atoms n =
-	  if is_A n
-	     then [
-		   rA_N6   n,
-		   rA_N7   n,
-		   rA_N9   n,
-		   rA_C8   n,
-		   rA_H2   n,
-		   rA_H61  n,
-		   rA_H62  n,
-		   rA_H8   n
-		   ]
-	  else if is_C n
-	     then [
-		   rC_N4   n,
-		   rC_O2   n,
-		   rC_H41  n,
-		   rC_H42  n,
-		   rC_H5   n,
-		   rC_H6   n
-		   ]
+          if is_A n
+             then [
+                   rA_N6   n,
+                   rA_N7   n,
+                   rA_N9   n,
+                   rA_C8   n,
+                   rA_H2   n,
+                   rA_H61  n,
+                   rA_H62  n,
+                   rA_H8   n
+                   ]
+          else if is_C n
+             then [
+                   rC_N4   n,
+                   rC_O2   n,
+                   rC_H41  n,
+                   rC_H42  n,
+                   rC_H5   n,
+                   rC_H6   n
+                   ]
           else if is_G n
-	     then [
-		   rG_N2   n,
-		   rG_N7   n,
-		   rG_N9   n,
-		   rG_C8   n,
-		   rG_O6   n,
-		   rG_H1   n,
-		   rG_H21  n,
-		   rG_H22  n,
-		   rG_H8   n
-		   ]
-	  else [
-		rU_O2   n,
-		rU_O4   n,
-		rU_H3   n,
-		rU_H5   n,
-		rU_H6   n
-		]
+             then [
+                   rG_N2   n,
+                   rG_N7   n,
+                   rG_N9   n,
+                   rG_C8   n,
+                   rG_O6   n,
+                   rG_H1   n,
+                   rG_H21  n,
+                   rG_H22  n,
+                   rG_H8   n
+                   ]
+          else [
+                rU_O2   n,
+                rU_O4   n,
+                rU_H3   n,
+                rU_H5   n,
+                rU_H6   n
+                ]
 
        fun list_of_atoms n =
-	  List.@ (list_of_common_atoms n,
-		  list_of_specific_atoms n)
-	  
+          List.@ (list_of_common_atoms n,
+                  list_of_specific_atoms n)
+          
        fun var_most_distant_atom (i, t, n) =
-	  let
-	     fun distance pos =
-		let
-		   val (x, y, z) = tfo_apply t pos
-		in
-		   Real.Math.sqrt (x * x + y * y + z * z)
-		end
-	  in
-	     maximum (List.map distance (list_of_atoms n))
-	  end
+          let
+             fun distance pos =
+                let
+                   val (x, y, z) = tfo_apply t pos
+                in
+                   Real.Math.sqrt (x * x + y * y + z * z)
+                end
+          in
+             maximum (List.map distance (list_of_atoms n))
+          end
     
        fun sol_most_distant_atom s =
-	  maximum (List.map var_most_distant_atom s)
+          maximum (List.map var_most_distant_atom s)
        
        fun most_distant_atom sols =
-	  maximum (List.map sol_most_distant_atom sols)
+          maximum (List.map sol_most_distant_atom sols)
        
        fun doit () =
-	  let
-	     val result = most_distant_atom (pseudoknot ())
-	     val x = result / 33.797594890762724
-	     val _ =
-		if x > 0.999999 andalso x < 1.000001
-		   then ()
-		else raise Fail "bug"
-	  in
-	     ()
-	  end
+          let
+             val result = most_distant_atom (pseudoknot ())
+             val x = result / 33.797594890762724
+             val _ =
+                if x > 0.999999 andalso x < 1.000001
+                   then ()
+                else raise Fail "bug"
+          in
+             ()
+          end
 end;
 
 signature BMARK =
@@ -3655,12 +3655,12 @@
     val doit =
        fn size =>
        let
-	  fun loop n =
-	     if n = 0
-		then ()
-	     else (doit();
-		   loop(n-1))
+          fun loop n =
+             if n = 0
+                then ()
+             else (doit();
+                   loop(n-1))
        in
-	  loop size
+          loop size
        end
   end;

Modified: mlton/branches/on-20050420-cmm-branch/benchmark/tests/output1.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/benchmark/tests/output1.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/benchmark/tests/output1.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,22 +1,22 @@
 structure Main =
    struct
       fun once () =
-	 let
-	    val count = 1000000000
-	    open TextIO
-	    val out = openOut "/dev/null"
-	    fun loop n =
-	       if n = 0
-		  then ()
-	       else (output1 (out, #"a"); loop (n - 1))
-	    val _ = loop count
-	    val _ = closeOut out
-	 in
-	    ()
-	 end
+         let
+            val count = 1000000000
+            open TextIO
+            val out = openOut "/dev/null"
+            fun loop n =
+               if n = 0
+                  then ()
+               else (output1 (out, #"a"); loop (n - 1))
+            val _ = loop count
+            val _ = closeOut out
+         in
+            ()
+         end
 
       fun doit n =
-	 if n = 0
-	    then ()
-	 else (once (); doit (n - 1))
+         if n = 0
+            then ()
+         else (once (); doit (n - 1))
    end

Modified: mlton/branches/on-20050420-cmm-branch/benchmark/tests/peek.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/benchmark/tests/peek.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/benchmark/tests/peek.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -5,7 +5,7 @@
 
       val new: unit -> t
       val addPeek: unit -> {add: t * 'a -> unit,
-			    peek: t -> 'a option}
+                            peek: t -> 'a option}
    end =
    struct
       datatype t = T of exn list ref
@@ -13,43 +13,43 @@
       fun new () = T (ref [])
 
       fun addPeek () =
-	 let
-	    exception E of 'a
-	    fun add (T r, x) = r := E x :: !r
-	    fun peek (T r) =
-	       let
-		  val rec loop =
-		     fn [] => NONE
-		      | E x :: _ => SOME x
-		      | _ :: l => loop l
-	       in loop (!r)
-	       end
-	 in {add = add, peek = peek}
-	 end
+         let
+            exception E of 'a
+            fun add (T r, x) = r := E x :: !r
+            fun peek (T r) =
+               let
+                  val rec loop =
+                     fn [] => NONE
+                      | E x :: _ => SOME x
+                      | _ :: l => loop l
+               in loop (!r)
+               end
+         in {add = add, peek = peek}
+         end
    end
 
 structure Main =
    struct
       fun inner () =
-	 let
-	    val l = Plist.new ()
-	    val {add, peek} = Plist.addPeek ()
-	    val _ = add (l, 13)
-	    fun loop (i, ac) =
-	       if i = 0
-		  then ac
-	       else loop (i - 1, ac + valOf (peek l))
-	    val n = loop (10000000, 0)
-	    val _ = print (concat [Int.toString n, "\n"])
-	 in ()
-	 end
+         let
+            val l = Plist.new ()
+            val {add, peek} = Plist.addPeek ()
+            val _ = add (l, 13)
+            fun loop (i, ac) =
+               if i = 0
+                  then ac
+               else loop (i - 1, ac + valOf (peek l))
+            val n = loop (10000000, 0)
+            val _ = print (concat [Int.toString n, "\n"])
+         in ()
+         end
 
       fun doit size =
-	 let
-	    fun loop i =
-	       if i = 0
-		  then ()
-	       else (inner (); loop (i - 1))
-	 in loop 1000
-	 end
+         let
+            fun loop i =
+               if i = 0
+                  then ()
+               else (inner (); loop (i - 1))
+         in loop 1000
+         end
    end

Modified: mlton/branches/on-20050420-cmm-branch/benchmark/tests/psdes-random.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/benchmark/tests/psdes-random.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/benchmark/tests/psdes-random.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -6,10 +6,10 @@
    let
    fun natFold (start, stop, ac, f) =
       let
-	 fun loop (i, ac) =
-	    if i = stop
-	       then ac
-	    else loop (i + 1, f (i, ac))
+         fun loop (i, ac) =
+            if i = stop
+               then ac
+            else loop (i + 1, f (i, ac))
       in loop (start, ac)
       end
    val niter: int = 4
@@ -26,12 +26,12 @@
       natFold
       (0, niter, (lword, irword), fn (i, (lword, irword)) =>
        let
-	  val ia = xorb (irword, c1 i)
-	  val itmpl = andb (ia, 0wxffff)
-	  val itmph = >> (ia, half)
-	  val ib = itmpl * itmpl + notb (itmph * itmph)
+          val ia = xorb (irword, c1 i)
+          val itmpl = andb (ia, 0wxffff)
+          val itmph = >> (ia, half)
+          val ib = itmpl * itmpl + notb (itmph * itmph)
        in (irword,
-	   xorb (lword, itmpl * itmph + xorb (c2 i, reverse ib)))
+           xorb (lword, itmpl * itmph + xorb (c2 i, reverse ib)))
        end)
    val zero: word = 0wx13 
    val lword: word ref = ref 0w13
@@ -39,23 +39,23 @@
    val needTo = ref true
    fun word () =
       if !needTo
-	 then
-	    let
-	       val (l, i) = psdes (!lword, !irword)
-	       val _ = lword := l
-	       val _ = irword := i
-	       val _ = needTo := false
-	    in
-	       l
-	    end
+         then
+            let
+               val (l, i) = psdes (!lword, !irword)
+               val _ = lword := l
+               val _ = irword := i
+               val _ = needTo := false
+            in
+               l
+            end
       else (needTo := true
-	    ; !irword)
+            ; !irword)
    fun loop (i, w) =
       if i = 0
-	 then
-	    if w = 0wx132B1B67
-	       then ()
-	    else raise Fail "bug"
+         then
+            if w = 0wx132B1B67
+               then ()
+            else raise Fail "bug"
       else loop (Int.- (i, 1), w + word())
    in
       loop (150000000, 0w0)
@@ -64,10 +64,10 @@
 structure Main =
    struct
       fun doit n =
-	 if n = 0
-	    then ()
-	 else (once ()
-	       ; doit (n - 1))
+         if n = 0
+            then ()
+         else (once ()
+               ; doit (n - 1))
    end
 
 val _ = Main.doit 2

Modified: mlton/branches/on-20050420-cmm-branch/benchmark/tests/ratio-regions.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/benchmark/tests/ratio-regions.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/benchmark/tests/ratio-regions.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -42,12 +42,12 @@
 fun min l =
    case l of
       x :: l => let
-		   fun loop(l, min) =
-		      case l of
-			 [] => min
-		       | x :: l => loop(l, Int.min(min, x))
-		in loop(l, x)
-		end
+                   fun loop(l, min) =
+                      case l of
+                         [] => min
+                       | x :: l => loop(l, Int.min(min, x))
+                in loop(l, x)
+                end
     | _ => raise Fail "min"
 
 fun every_n(n, p) =
@@ -65,9 +65,9 @@
 fun some_vector(v, p) =
    let
       fun loop i =
-	 i < vector_length v
-	 andalso (p(vector_ref(v, i))
-		  orelse loop(i + 1))
+         i < vector_length v
+         andalso (p(vector_ref(v, i))
+                  orelse loop(i + 1))
    in loop 0
    end
 
@@ -91,23 +91,23 @@
 fun pormat(control_string: string, values: pormatValue list): unit =
    let
       fun loop(i: int, values: pormatValue list): unit =
-	 if not(i = string_length control_string)
-	    then
-	       let val c = string_ref(control_string, i)
-	       in if c = #"~"
-		     then let val c2 = string_ref(control_string, i + 1)
-			  in case (c2, values) of
-			     (#"s", Int n :: values) =>
-				(print(Int.toString n) ; loop(i + 2, values))
-			   | (#"a", String s :: values) => 
-				(print s ; loop(i + 2, values))
-			   | (#"%", _) =>
-				(print "\n"; loop(i + 2, values))
-			   | _ => (write_char c; loop(i + 1, values))
-			  end
-		  else (write_char c ; loop(i + 1, values))
-	       end
-	 else ()
+         if not(i = string_length control_string)
+            then
+               let val c = string_ref(control_string, i)
+               in if c = #"~"
+                     then let val c2 = string_ref(control_string, i + 1)
+                          in case (c2, values) of
+                             (#"s", Int n :: values) =>
+                                (print(Int.toString n) ; loop(i + 2, values))
+                           | (#"a", String s :: values) => 
+                                (print s ; loop(i + 2, values))
+                           | (#"%", _) =>
+                                (print "\n"; loop(i + 2, values))
+                           | _ => (write_char c; loop(i + 1, values))
+                          end
+                  else (write_char c ; loop(i + 1, values))
+               end
+         else ()
    in loop(0, values)
    end
 
@@ -179,408 +179,408 @@
       val m2 = 2 * height * width + 2
       val q = make_vector(2 * height * width + 3, [])
       fun cf_right(y, x) =
-	 matrix_ref(c_right, y, x) - matrix_ref(f_right, y, x)
+         matrix_ref(c_right, y, x) - matrix_ref(f_right, y, x)
       fun cf_left(y, x) =
-	 matrix_ref(c_right, y, x - 1) + matrix_ref(f_right, y, x - 1)
+         matrix_ref(c_right, y, x - 1) + matrix_ref(f_right, y, x - 1)
       fun cf_down(y, x) =
-	 matrix_ref(c_down, y, x) - matrix_ref(f_down, y, x)
+         matrix_ref(c_down, y, x) - matrix_ref(f_down, y, x)
       fun cf_up(y, x) =
-	 matrix_ref(c_down, y - 1, x) + matrix_ref(f_down, y - 1, x)
+         matrix_ref(c_down, y - 1, x) + matrix_ref(f_down, y - 1, x)
       fun ef_right(y, x) = positive(cf_right(y, x))
       fun ef_left(y, x) = positive(cf_left(y, x))
       fun ef_down(y, x) = positive(cf_down(y, x))
       fun ef_up(y, x) = positive(cf_up(y, x))
       fun preflow_push v =
-	 let
-	    fun enqueue(y, x) =
-	       if not(matrix_ref(marked, y, x))
-		  then
-		     (vector_set(q,
-				 matrix_ref(h, y, x),
-				 (cons((x, y),
-				       vector_ref(q, matrix_ref(h, y, x)))))
-		      ; matrix_set(marked, y, x, true))
-	       else ()
-	    fun cf_t(y, x) = v * matrix_ref(w, y, x) - matrix_ref(f_t, y, x)
-	    fun ef_t(y, x) = positive(cf_t(y, x))
-	    fun can_push_right(y, x) =
-	       x < width - 1
-	       andalso not(zero(matrix_ref(e, y, x)))
-	       andalso ef_right(y, x)
-	       andalso matrix_ref(h, y, x) = matrix_ref(h, y, x + 1) + 1
-	    fun can_push_left(y, x) =
-	       x > 0
-	       andalso not(zero(matrix_ref(e, y, x)))
-	       andalso ef_left(y, x)
-	       andalso matrix_ref(h, y, x) = matrix_ref(h, y, x - 1) + 1
-	    fun can_push_down(y, x) =
-	       y < height - 1
-	       andalso not(zero(matrix_ref(e, y, x)))
-	       andalso ef_down(y, x)
-	       andalso matrix_ref(h, y, x) = matrix_ref(h, y + 1, x) + 1
-	    fun can_push_up(y, x) =
-	       y > 0
-	       andalso not(zero(matrix_ref(e, y, x)))
-	       andalso ef_up(y, x)
-	       andalso matrix_ref(h, y, x) = matrix_ref(h, y - 1, x) + 1
-	    fun can_push_t(y, x) =
-	       not(zero(matrix_ref(e, y, x)))
-	       andalso ef_t(y, x)
-	       andalso matrix_ref(h, y, x) = 1
-	    fun can_lift(y, x) =
-	       not(zero(matrix_ref(e, y, x)))
-	       andalso (if x = width - 1
-			   then matrix_ref(h, y, x) <= m1
-			else (not(ef_right(y, x))
-			      orelse
-			      matrix_ref(h, y, x) <= matrix_ref(h, y, x + 1)))
-	       andalso (if x = 0
-			   then matrix_ref(h, y, x) <= m1
-			else (not(ef_left(y, x))
-			      orelse
-			      matrix_ref(h, y, x) <= matrix_ref(h, y, x - 1)))
-	       andalso (if y = height - 1
-			   then matrix_ref(h, y, x) <= m1
-			else (not(ef_down(y, x))
-			      orelse
-			      matrix_ref(h, y, x) <= matrix_ref(h, y + 1, x)))
-	       andalso (if y = 0
-			   then matrix_ref(h, y, x) <= m1
-			else (not(ef_up(y, x))
-			      orelse
-			      matrix_ref(h, y, x) <= matrix_ref(h, y - 1, x)))
-	       andalso (not(ef_t(y, x)) orelse matrix_ref(h, y, x) = 0)
-	    fun push_right(y, x) =
-	       (* (pormat "Push right ~s ~s~%" y x) *)
-	       let val df_u_v = positive_min(matrix_ref(e, y, x), cf_right(y, x))
-	       in matrix_set(f_right, y, x, matrix_ref(f_right, y, x) + df_u_v)
-		  ; matrix_set(e, y, x,
-			       positive_minus(matrix_ref(e, y, x), df_u_v))
-		  ; matrix_set(e, y, x + 1,
-			       positive_plus(matrix_ref(e, y, x + 1), df_u_v))
-		  ; enqueue(y, x + 1)
-	       end
-	    fun push_left(y, x) =
-	       (* (pormat "Push left ~s ~s~%" y x) *)
-	       let val df_u_v = positive_min(matrix_ref(e, y, x), cf_left(y, x))
-	       in matrix_set(f_right, y, x - 1,
-			     matrix_ref(f_right, y, x - 1) - df_u_v)
-		  ; matrix_set(e, y, x,
-			       positive_minus(matrix_ref(e, y, x), df_u_v))
-		  ; matrix_set(e, y, x - 1,
-			       positive_plus(matrix_ref(e, y, x - 1), df_u_v))
-		  ; enqueue(y, x - 1)
-	       end
+         let
+            fun enqueue(y, x) =
+               if not(matrix_ref(marked, y, x))
+                  then
+                     (vector_set(q,
+                                 matrix_ref(h, y, x),
+                                 (cons((x, y),
+                                       vector_ref(q, matrix_ref(h, y, x)))))
+                      ; matrix_set(marked, y, x, true))
+               else ()
+            fun cf_t(y, x) = v * matrix_ref(w, y, x) - matrix_ref(f_t, y, x)
+            fun ef_t(y, x) = positive(cf_t(y, x))
+            fun can_push_right(y, x) =
+               x < width - 1
+               andalso not(zero(matrix_ref(e, y, x)))
+               andalso ef_right(y, x)
+               andalso matrix_ref(h, y, x) = matrix_ref(h, y, x + 1) + 1
+            fun can_push_left(y, x) =
+               x > 0
+               andalso not(zero(matrix_ref(e, y, x)))
+               andalso ef_left(y, x)
+               andalso matrix_ref(h, y, x) = matrix_ref(h, y, x - 1) + 1
+            fun can_push_down(y, x) =
+               y < height - 1
+               andalso not(zero(matrix_ref(e, y, x)))
+               andalso ef_down(y, x)
+               andalso matrix_ref(h, y, x) = matrix_ref(h, y + 1, x) + 1
+            fun can_push_up(y, x) =
+               y > 0
+               andalso not(zero(matrix_ref(e, y, x)))
+               andalso ef_up(y, x)
+               andalso matrix_ref(h, y, x) = matrix_ref(h, y - 1, x) + 1
+            fun can_push_t(y, x) =
+               not(zero(matrix_ref(e, y, x)))
+               andalso ef_t(y, x)
+               andalso matrix_ref(h, y, x) = 1
+            fun can_lift(y, x) =
+               not(zero(matrix_ref(e, y, x)))
+               andalso (if x = width - 1
+                           then matrix_ref(h, y, x) <= m1
+                        else (not(ef_right(y, x))
+                              orelse
+                              matrix_ref(h, y, x) <= matrix_ref(h, y, x + 1)))
+               andalso (if x = 0
+                           then matrix_ref(h, y, x) <= m1
+                        else (not(ef_left(y, x))
+                              orelse
+                              matrix_ref(h, y, x) <= matrix_ref(h, y, x - 1)))
+               andalso (if y = height - 1
+                           then matrix_ref(h, y, x) <= m1
+                        else (not(ef_down(y, x))
+                              orelse
+                              matrix_ref(h, y, x) <= matrix_ref(h, y + 1, x)))
+               andalso (if y = 0
+                           then matrix_ref(h, y, x) <= m1
+                        else (not(ef_up(y, x))
+                              orelse
+                              matrix_ref(h, y, x) <= matrix_ref(h, y - 1, x)))
+               andalso (not(ef_t(y, x)) orelse matrix_ref(h, y, x) = 0)
+            fun push_right(y, x) =
+               (* (pormat "Push right ~s ~s~%" y x) *)
+               let val df_u_v = positive_min(matrix_ref(e, y, x), cf_right(y, x))
+               in matrix_set(f_right, y, x, matrix_ref(f_right, y, x) + df_u_v)
+                  ; matrix_set(e, y, x,
+                               positive_minus(matrix_ref(e, y, x), df_u_v))
+                  ; matrix_set(e, y, x + 1,
+                               positive_plus(matrix_ref(e, y, x + 1), df_u_v))
+                  ; enqueue(y, x + 1)
+               end
+            fun push_left(y, x) =
+               (* (pormat "Push left ~s ~s~%" y x) *)
+               let val df_u_v = positive_min(matrix_ref(e, y, x), cf_left(y, x))
+               in matrix_set(f_right, y, x - 1,
+                             matrix_ref(f_right, y, x - 1) - df_u_v)
+                  ; matrix_set(e, y, x,
+                               positive_minus(matrix_ref(e, y, x), df_u_v))
+                  ; matrix_set(e, y, x - 1,
+                               positive_plus(matrix_ref(e, y, x - 1), df_u_v))
+                  ; enqueue(y, x - 1)
+               end
 
-	    fun push_down(y, x) =
-	       (* (pormat "Push down ~s ~s~%" y x) *)
-	       let val df_u_v = positive_min(matrix_ref(e, y, x), cf_down(y, x))
-	       in matrix_set(f_down, y, x, matrix_ref(f_down, y, x) + df_u_v)
-		  ; matrix_set(e, y, x,
-			       positive_minus(matrix_ref(e, y, x), df_u_v))
-		  ; matrix_set(e, y + 1, x,
-			       positive_plus(matrix_ref(e, y + 1, x), df_u_v))
-		  ; enqueue(y + 1, x)
-	       end
+            fun push_down(y, x) =
+               (* (pormat "Push down ~s ~s~%" y x) *)
+               let val df_u_v = positive_min(matrix_ref(e, y, x), cf_down(y, x))
+               in matrix_set(f_down, y, x, matrix_ref(f_down, y, x) + df_u_v)
+                  ; matrix_set(e, y, x,
+                               positive_minus(matrix_ref(e, y, x), df_u_v))
+                  ; matrix_set(e, y + 1, x,
+                               positive_plus(matrix_ref(e, y + 1, x), df_u_v))
+                  ; enqueue(y + 1, x)
+               end
             fun push_up(y, x) =
-	       (* ;;(pormat "Push up ~s ~s~%" y x) *)
-	       let val df_u_v = positive_min(matrix_ref(e, y, x), cf_up(y, x))
-	       in matrix_set(f_down, y - 1, x,
-			     matrix_ref(f_down, y - 1, x) - df_u_v)
-		  ; matrix_set(e, y, x,
-			       positive_minus(matrix_ref(e, y, x), df_u_v))
-		  ; matrix_set(e, y - 1, x,
-			       positive_plus(matrix_ref(e, y - 1, x), df_u_v))
-		  ; enqueue(y - 1, x)
-	       end
-	    fun push_t(y, x) =
-	       (* ;;(pormat "Push t ~s ~s~%" y x) *)
-	       let val df_u_v = positive_min(matrix_ref(e, y, x), cf_t(y, x))
-	       in matrix_set(f_t, y, x, matrix_ref(f_t, y, x) + df_u_v)
-		  ; matrix_set(e, y, x,
-			       positive_minus(matrix_ref(e, y, x), df_u_v))
-	       end
-	    fun lift(y, x) =
-	       (* ;;(pormat "Lift ~s ~s~%" y x) *)
-	       matrix_set
-	       (h, y, x,
-		1 + min[if x = width - 1
-			   then m1
-			else if ef_right(y, x)
-				then matrix_ref(h, y, x + 1)
-			     else m2,
-		        if x = 0
-			   then m1
-			else if ef_left(y, x)
-				then matrix_ref(h, y, x - 1)
-			     else m2,
-			if y = height - 1
-			   then m1
-			else if ef_down(y, x)
-				then matrix_ref(h, y + 1, x)
-			     else m2,
-			if y = 0
-			   then m1
-			else if ef_up(y, x)
-				then matrix_ref(h, y - 1, x)
-			     else m2,
-			if ef_t(y, x) then 0 else m2])
-	    fun relabel() =
-	       (* ;;(pormat "Relabel~%") *)
-	       let
-		  datatype 'a queue =
-		     Nil
-	           | Cons of 'a * 'a queue ref
-		  fun null(q: 'q queue ref) =
-		     case !q of
-			Nil => true
-		      | _ => false
-		  val q: (int * int) queue ref = ref Nil
-		  val tail: (int * int) queue ref = ref Nil
-		  fun enqueue(y, x, value) =
-		     if value < matrix_ref(h, y, x)
-			then (matrix_set(h, y, x, value)
-			      ; if not(matrix_ref(marked, y, x))
-				   then (matrix_set(marked, y, x, true)
-					 ; (case !tail of
-					       Nil => 
-						  (tail := Cons((x, y), ref Nil)
-						   ; q := !tail)
-					     | Cons(_, cdr) =>
-						  (cdr := Cons((x, y), ref Nil)
-						   ; tail := !cdr)))
-				else ())
-		     else ()
-		  fun dequeue() =
-		     case !q of
-			Nil => raise Fail "dequeue"
-		      | Cons(p, rest) => 
-			 (matrix_set(marked, y p, x p, false)
-			  ; q := !rest
-			  ; if null q then tail := Nil else ()
-			  ; p)
-	       in doo(height, fn y =>
-		     doo(width, fn x =>
-			(matrix_set(h, y, x, m1)
-			 ; matrix_set(marked, y, x, false))))
-		  ; doo(height, fn y =>
-		       doo(width, fn x =>
-			  if ef_t(y, x)
-			     andalso matrix_ref(h, y, x) > 1
-			     then enqueue(y, x, 1)
-			  else ()))
-		  ; let
-		       fun loop() =
-			  if not(null q)
-			     then
-				(let val p = dequeue()
-				     val x = x p
-				     val y = y p
-				     val value = matrix_ref(h, y, x) + 1
-				 in if x > 0 andalso ef_right(y, x - 1)
-				       then enqueue(y, x - 1, value)
-				    else ()
-				    ; if x < width - 1 andalso ef_left(y, x + 1)
-					 then enqueue(y, x + 1, value)
-				      else ()
-				    ; if y > 0 andalso ef_down(y - 1, x)
-					 then enqueue(y - 1, x, value)
-				      else ()
-				    ; if y < height - 1 andalso ef_up(y + 1, x)
-					 then enqueue(y + 1, x, value)
-				      else ()
-				 end
-				 ; loop())
-			  else ()
-		    in loop()
-		    end
-	       end (* relabel *)
-	 in doo(height, fn y =>
-	       doo(width, fn x =>
-		  (matrix_set(e, y, x, 0)
-		   ; matrix_set(f_t, y, x, 0))))
-	    ; doo(height, fn y =>
-		 doo(width - 1, fn x =>
-		    matrix_set(f_right, y, x, 0)))
-	    ; doo(height - 1, fn y =>
-		 doo(width, fn x =>
-		    matrix_set(f_down, y, x, 0)))
-	    ; doo(height, fn y =>
-		 (matrix_set(e, y, width - 1, ~1)
-		  ; matrix_set(e, y, 0, ~1)))
-	    ; doo(width - 1, fn x =>
-		 (matrix_set(e, height - 1, x, ~1)
-		  ; matrix_set(e, 0, x, ~1)))
-	    ; let val pushes = ref 0
-		  val lifts = ref 0
-		  val relabels = ref 0
-		  fun loop(i, p) =
-		     if zero(modulo(i, 6)) andalso not p
-			then (relabel()
-			      ; relabels := !relabels + 1
-			      ; if every_n(height, fn y =>
-					   every_n(width, fn x =>
-						   zero(matrix_ref(e, y, x))
-						   orelse
-						   matrix_ref(h, y, x) = m1))
-				   then
-				      (* Every vertex with excess capacity is not reachable from the sink in
-				       * the inverse residual network. So terminate early because we have
-				       * already found a min cut. In this case, the preflows and excess
-				       * capacities will not be correct. But the cut is indicated by the
-				       * heights. Vertices reachable from the source have height
-				       * HEIGHT * WIDTH + 2 while vertices reachable from the sink have
-				       * smaller height. Early termination is necessary with relabeling to
-				       * prevent an infinite loop. The loop arises because vertices that are
-				       * not reachable from the sink in the inverse residual network have
-				       * their height reset to HEIGHT * WIDTH + 2 by the relabeling
-				       * process. If there are such vertices with excess capacity, this is
-				       * not high enough for the excess capacity to be pushed back to the
-				       * perimeter. So after relabeling, vertices get lifted to try to push
-				      * excess capacity back to the perimeter but then a relabeling happens
-				      * to soon and foils this lifting. Terminating when all vertices with
-				      * excess capacity are not reachable from the sink in the inverse
-				      * residual network eliminates this problem.
-				      *)
-				      (pormat
-				       ("~s push~a, ~s lift~a, ~s relabel~a, ~s wave~a, terminated early~%",
-					[Int(! pushes),
-					 String(if !pushes = 1 then "" else "es"),
-					 Int(! lifts),
-					 String(if !lifts = 1 then "" else "s"),
-					 Int(! relabels),
-					 String(if !relabels = 1 then "" else "s"),
-					 Int i,
-					 String(if i = 1 then "" else "s")]))
-				else
-				   (* We need to rebuild the priority queue after relabeling since the
-				    * heights might have changed and the priority queue is indexed by
-				    * height. This also assumes that a relabel is done before any pushes
-				    * or lifts.
-				    *)
-				   (doo(vector_length q, fn k =>
-				       vector_set(q, k, []))
-				    ; doo(height, fn y =>
-					 doo(width, fn x =>
-					    matrix_set(marked, y, x, false)))
-				    ; doo(height, fn y =>
-					 doo(width, fn x => 
-					    if not(zero(matrix_ref(e, y, x)))
-					       then enqueue(y, x)
-					    else ()))
-				    ; loop(i, true)))
-		     else if some_vector(q, fn ps =>
-					 some(ps, fn p =>
-					      let val x = x p
-						 val y = y p
-					      in can_push_right(y, x)
-						 orelse can_push_left(y, x)
-						 orelse can_push_down(y, x)
-						 orelse can_push_up(y, x)
-						 orelse can_push_t(y, x)
-						 orelse can_lift(y, x)
-					      end))
-			     then
-				(
-				 let fun loop k =
-				    if not(negative k)
-				       then
-					  (
-					   let val ps = vector_ref(q, k)
-					   in vector_set(q, k, [])
-					      ; (for_each
-						 (ps, fn p =>
-						  matrix_set(marked, y p, x p,
-							     false)))
-					      ; (for_each
-						 (ps, fn p =>
-						  let val x = x p
-						     val y = y p
-						  in if can_push_right(y, x)
-							then (pushes := !pushes + 1
-							      ; push_right(y, x))
-						     else ()
-						        ; if can_push_left(y, x)
-							     then (pushes := !pushes + 1
-								   ; push_left(y, x))
-							  else ()
-							     ; if can_push_down(y, x)
-								  then (pushes := !pushes + 1
-									; push_down(y, x))
-							       else ()
-								  ; if can_push_up(y, x)
-								       then (pushes := !pushes + 1
-									     ; push_up(y, x))
-								    else ()
-								       ; if can_push_t(y, x)
-									    then (pushes := !pushes + 1
-										  ; push_t(y, x))
-									 else ()
-									    ; if can_lift(y, x)
-										 then (lifts := !lifts + 1
-										       ; lift(y, x))
-									      else ()
-										 ; if not(zero(matrix_ref(e, y, x)))
-										      then enqueue(y, x)
-										   else ()
-						  end))
-					   end
-					; loop(k - 1))
-				    else ()
-				 in loop(vector_length q - 1)
-				 end
-			      ; loop(i + 1, false))
-			  else
-			     (* This is so MIN_CUT and MIN_CUT_INCLUDES_EVERY_EDGE_TO_T work. *)
-			     (relabel()
-			      ; relabels := !relabels + 1
-			      ; (pormat("~s push~a, ~s lift~a, ~s relabel~a, ~s wave~a~%",
-					  [Int(! pushes), 
-					   String(if !pushes = 1 then "" else "es"),
-					   Int(! lifts),
-					   String(if !lifts = 1 then "" else "s"),
-					   Int(! relabels),
-					   String(if !relabels = 1 then "" else "s"),
-					   Int i,
-					   String(if i = 1 then "" else "s")])))
-	      in loop(0, false)
-	      end
-	 end
+               (* ;;(pormat "Push up ~s ~s~%" y x) *)
+               let val df_u_v = positive_min(matrix_ref(e, y, x), cf_up(y, x))
+               in matrix_set(f_down, y - 1, x,
+                             matrix_ref(f_down, y - 1, x) - df_u_v)
+                  ; matrix_set(e, y, x,
+                               positive_minus(matrix_ref(e, y, x), df_u_v))
+                  ; matrix_set(e, y - 1, x,
+                               positive_plus(matrix_ref(e, y - 1, x), df_u_v))
+                  ; enqueue(y - 1, x)
+               end
+            fun push_t(y, x) =
+               (* ;;(pormat "Push t ~s ~s~%" y x) *)
+               let val df_u_v = positive_min(matrix_ref(e, y, x), cf_t(y, x))
+               in matrix_set(f_t, y, x, matrix_ref(f_t, y, x) + df_u_v)
+                  ; matrix_set(e, y, x,
+                               positive_minus(matrix_ref(e, y, x), df_u_v))
+               end
+            fun lift(y, x) =
+               (* ;;(pormat "Lift ~s ~s~%" y x) *)
+               matrix_set
+               (h, y, x,
+                1 + min[if x = width - 1
+                           then m1
+                        else if ef_right(y, x)
+                                then matrix_ref(h, y, x + 1)
+                             else m2,
+                        if x = 0
+                           then m1
+                        else if ef_left(y, x)
+                                then matrix_ref(h, y, x - 1)
+                             else m2,
+                        if y = height - 1
+                           then m1
+                        else if ef_down(y, x)
+                                then matrix_ref(h, y + 1, x)
+                             else m2,
+                        if y = 0
+                           then m1
+                        else if ef_up(y, x)
+                                then matrix_ref(h, y - 1, x)
+                             else m2,
+                        if ef_t(y, x) then 0 else m2])
+            fun relabel() =
+               (* ;;(pormat "Relabel~%") *)
+               let
+                  datatype 'a queue =
+                     Nil
+                   | Cons of 'a * 'a queue ref
+                  fun null(q: 'q queue ref) =
+                     case !q of
+                        Nil => true
+                      | _ => false
+                  val q: (int * int) queue ref = ref Nil
+                  val tail: (int * int) queue ref = ref Nil
+                  fun enqueue(y, x, value) =
+                     if value < matrix_ref(h, y, x)
+                        then (matrix_set(h, y, x, value)
+                              ; if not(matrix_ref(marked, y, x))
+                                   then (matrix_set(marked, y, x, true)
+                                         ; (case !tail of
+                                               Nil => 
+                                                  (tail := Cons((x, y), ref Nil)
+                                                   ; q := !tail)
+                                             | Cons(_, cdr) =>
+                                                  (cdr := Cons((x, y), ref Nil)
+                                                   ; tail := !cdr)))
+                                else ())
+                     else ()
+                  fun dequeue() =
+                     case !q of
+                        Nil => raise Fail "dequeue"
+                      | Cons(p, rest) => 
+                         (matrix_set(marked, y p, x p, false)
+                          ; q := !rest
+                          ; if null q then tail := Nil else ()
+                          ; p)
+               in doo(height, fn y =>
+                     doo(width, fn x =>
+                        (matrix_set(h, y, x, m1)
+                         ; matrix_set(marked, y, x, false))))
+                  ; doo(height, fn y =>
+                       doo(width, fn x =>
+                          if ef_t(y, x)
+                             andalso matrix_ref(h, y, x) > 1
+                             then enqueue(y, x, 1)
+                          else ()))
+                  ; let
+                       fun loop() =
+                          if not(null q)
+                             then
+                                (let val p = dequeue()
+                                     val x = x p
+                                     val y = y p
+                                     val value = matrix_ref(h, y, x) + 1
+                                 in if x > 0 andalso ef_right(y, x - 1)
+                                       then enqueue(y, x - 1, value)
+                                    else ()
+                                    ; if x < width - 1 andalso ef_left(y, x + 1)
+                                         then enqueue(y, x + 1, value)
+                                      else ()
+                                    ; if y > 0 andalso ef_down(y - 1, x)
+                                         then enqueue(y - 1, x, value)
+                                      else ()
+                                    ; if y < height - 1 andalso ef_up(y + 1, x)
+                                         then enqueue(y + 1, x, value)
+                                      else ()
+                                 end
+                                 ; loop())
+                          else ()
+                    in loop()
+                    end
+               end (* relabel *)
+         in doo(height, fn y =>
+               doo(width, fn x =>
+                  (matrix_set(e, y, x, 0)
+                   ; matrix_set(f_t, y, x, 0))))
+            ; doo(height, fn y =>
+                 doo(width - 1, fn x =>
+                    matrix_set(f_right, y, x, 0)))
+            ; doo(height - 1, fn y =>
+                 doo(width, fn x =>
+                    matrix_set(f_down, y, x, 0)))
+            ; doo(height, fn y =>
+                 (matrix_set(e, y, width - 1, ~1)
+                  ; matrix_set(e, y, 0, ~1)))
+            ; doo(width - 1, fn x =>
+                 (matrix_set(e, height - 1, x, ~1)
+                  ; matrix_set(e, 0, x, ~1)))
+            ; let val pushes = ref 0
+                  val lifts = ref 0
+                  val relabels = ref 0
+                  fun loop(i, p) =
+                     if zero(modulo(i, 6)) andalso not p
+                        then (relabel()
+                              ; relabels := !relabels + 1
+                              ; if every_n(height, fn y =>
+                                           every_n(width, fn x =>
+                                                   zero(matrix_ref(e, y, x))
+                                                   orelse
+                                                   matrix_ref(h, y, x) = m1))
+                                   then
+                                      (* Every vertex with excess capacity is not reachable from the sink in
+                                       * the inverse residual network. So terminate early because we have
+                                       * already found a min cut. In this case, the preflows and excess
+                                       * capacities will not be correct. But the cut is indicated by the
+                                       * heights. Vertices reachable from the source have height
+                                       * HEIGHT * WIDTH + 2 while vertices reachable from the sink have
+                                       * smaller height. Early termination is necessary with relabeling to
+                                       * prevent an infinite loop. The loop arises because vertices that are
+                                       * not reachable from the sink in the inverse residual network have
+                                       * their height reset to HEIGHT * WIDTH + 2 by the relabeling
+                                       * process. If there are such vertices with excess capacity, this is
+                                       * not high enough for the excess capacity to be pushed back to the
+                                       * perimeter. So after relabeling, vertices get lifted to try to push
+                                      * excess capacity back to the perimeter but then a relabeling happens
+                                      * to soon and foils this lifting. Terminating when all vertices with
+                                      * excess capacity are not reachable from the sink in the inverse
+                                      * residual network eliminates this problem.
+                                      *)
+                                      (pormat
+                                       ("~s push~a, ~s lift~a, ~s relabel~a, ~s wave~a, terminated early~%",
+                                        [Int(! pushes),
+                                         String(if !pushes = 1 then "" else "es"),
+                                         Int(! lifts),
+                                         String(if !lifts = 1 then "" else "s"),
+                                         Int(! relabels),
+                                         String(if !relabels = 1 then "" else "s"),
+                                         Int i,
+                                         String(if i = 1 then "" else "s")]))
+                                else
+                                   (* We need to rebuild the priority queue after relabeling since the
+                                    * heights might have changed and the priority queue is indexed by
+                                    * height. This also assumes that a relabel is done before any pushes
+                                    * or lifts.
+                                    *)
+                                   (doo(vector_length q, fn k =>
+                                       vector_set(q, k, []))
+                                    ; doo(height, fn y =>
+                                         doo(width, fn x =>
+                                            matrix_set(marked, y, x, false)))
+                                    ; doo(height, fn y =>
+                                         doo(width, fn x => 
+                                            if not(zero(matrix_ref(e, y, x)))
+                                               then enqueue(y, x)
+                                            else ()))
+                                    ; loop(i, true)))
+                     else if some_vector(q, fn ps =>
+                                         some(ps, fn p =>
+                                              let val x = x p
+                                                 val y = y p
+                                              in can_push_right(y, x)
+                                                 orelse can_push_left(y, x)
+                                                 orelse can_push_down(y, x)
+                                                 orelse can_push_up(y, x)
+                                                 orelse can_push_t(y, x)
+                                                 orelse can_lift(y, x)
+                                              end))
+                             then
+                                (
+                                 let fun loop k =
+                                    if not(negative k)
+                                       then
+                                          (
+                                           let val ps = vector_ref(q, k)
+                                           in vector_set(q, k, [])
+                                              ; (for_each
+                                                 (ps, fn p =>
+                                                  matrix_set(marked, y p, x p,
+                                                             false)))
+                                              ; (for_each
+                                                 (ps, fn p =>
+                                                  let val x = x p
+                                                     val y = y p
+                                                  in if can_push_right(y, x)
+                                                        then (pushes := !pushes + 1
+                                                              ; push_right(y, x))
+                                                     else ()
+                                                        ; if can_push_left(y, x)
+                                                             then (pushes := !pushes + 1
+                                                                   ; push_left(y, x))
+                                                          else ()
+                                                             ; if can_push_down(y, x)
+                                                                  then (pushes := !pushes + 1
+                                                                        ; push_down(y, x))
+                                                               else ()
+                                                                  ; if can_push_up(y, x)
+                                                                       then (pushes := !pushes + 1
+                                                                             ; push_up(y, x))
+                                                                    else ()
+                                                                       ; if can_push_t(y, x)
+                                                                            then (pushes := !pushes + 1
+                                                                                  ; push_t(y, x))
+                                                                         else ()
+                                                                            ; if can_lift(y, x)
+                                                                                 then (lifts := !lifts + 1
+                                                                                       ; lift(y, x))
+                                                                              else ()
+                                                                                 ; if not(zero(matrix_ref(e, y, x)))
+                                                                                      then enqueue(y, x)
+                                                                                   else ()
+                                                  end))
+                                           end
+                                        ; loop(k - 1))
+                                    else ()
+                                 in loop(vector_length q - 1)
+                                 end
+                              ; loop(i + 1, false))
+                          else
+                             (* This is so MIN_CUT and MIN_CUT_INCLUDES_EVERY_EDGE_TO_T work. *)
+                             (relabel()
+                              ; relabels := !relabels + 1
+                              ; (pormat("~s push~a, ~s lift~a, ~s relabel~a, ~s wave~a~%",
+                                          [Int(! pushes), 
+                                           String(if !pushes = 1 then "" else "es"),
+                                           Int(! lifts),
+                                           String(if !lifts = 1 then "" else "s"),
+                                           Int(! relabels),
+                                           String(if !relabels = 1 then "" else "s"),
+                                           Int i,
+                                           String(if i = 1 then "" else "s")])))
+              in loop(0, false)
+              end
+         end
            fun min_cut_includes_every_edge_to_t() =
-	      (* This requires that a relabel was done immediately before returning from 
-	       * PREFLOW_PUSH.
-	       *)
-	     every_n(height, fn y =>
-		     every_n(width, fn x =>
-			     matrix_ref(h, y, x) = m1))
-	   fun min_cut() =
-	      (* This requires that a relabel was done immediately before returning from
-	       * PREFLOW_PUSH
-	       *)
-	      map_n_vector
-	      (height, fn y =>
-	       map_n_vector(width, fn x =>
-			    not(matrix_ref(h, y, x) = m1)))
-	   fun loop(lg_v, v_max) =
-	      if negative lg_v
-		 then (pormat("V-MAX=~s~%",[Int v_max])
-		       ; preflow_push(v_max + 1)
-		       ; min_cut())
-	      else let val v = v_max + let
-					  fun loop(i, c) =
-					     if (zero i)
-						then c
-					     else loop(i - 1, c + c)
-				       in loop(lg_v, 1)
-				       end
-		   in pormat("LG-V=~s, V-MAX=~s, V=~s~%",
-			     [Int lg_v, Int v_max, Int v])
-		      ; preflow_push v
-		      ; loop(lg_v - 1,
-			     if min_cut_includes_every_edge_to_t()
-				then v
-			     else v_max)
-		   end
+              (* This requires that a relabel was done immediately before returning from 
+               * PREFLOW_PUSH.
+               *)
+             every_n(height, fn y =>
+                     every_n(width, fn x =>
+                             matrix_ref(h, y, x) = m1))
+           fun min_cut() =
+              (* This requires that a relabel was done immediately before returning from
+               * PREFLOW_PUSH
+               *)
+              map_n_vector
+              (height, fn y =>
+               map_n_vector(width, fn x =>
+                            not(matrix_ref(h, y, x) = m1)))
+           fun loop(lg_v, v_max) =
+              if negative lg_v
+                 then (pormat("V-MAX=~s~%",[Int v_max])
+                       ; preflow_push(v_max + 1)
+                       ; min_cut())
+              else let val v = v_max + let
+                                          fun loop(i, c) =
+                                             if (zero i)
+                                                then c
+                                             else loop(i - 1, c + c)
+                                       in loop(lg_v, 1)
+                                       end
+                   in pormat("LG-V=~s, V-MAX=~s, V=~s~%",
+                             [Int lg_v, Int v_max, Int v])
+                      ; preflow_push v
+                      ; loop(lg_v - 1,
+                             if min_cut_includes_every_edge_to_t()
+                                then v
+                             else v_max)
+                   end
    in loop(lg_max_v, 0)
    end
 
@@ -593,28 +593,28 @@
       val c_right = make_matrix(height, width - 1, ~1)
       val c_down = make_matrix(height - 1, width, ~1)
    in doo(height, fn y =>
-	  doo(width - 1, fn x =>
-	      matrix_set
-	      (c_right, y, x,
-	       if (y >= quotient(height, 4)
-		   andalso y < quotient(3 * height, 4)
-		   andalso (x = quotient(width, 4) - 1
-			    orelse x = quotient(3 * width, 4) - 1))
-		  then 1
-	       else 128)))
+          doo(width - 1, fn x =>
+              matrix_set
+              (c_right, y, x,
+               if (y >= quotient(height, 4)
+                   andalso y < quotient(3 * height, 4)
+                   andalso (x = quotient(width, 4) - 1
+                            orelse x = quotient(3 * width, 4) - 1))
+                  then 1
+               else 128)))
       ; doo(height - 1, fn y =>
-	    doo(width, fn x =>
-		matrix_set
-		(c_down, y, x,
-		 if (x >= quotient(width, 4)
-		     andalso x < quotient(3 * width, 4)
-		     andalso (y = quotient(height, 4) - 1
-			      orelse y = quotient(3 * height, 4) - 1))
-		    then 1
-		 else 128)))
+            doo(width, fn x =>
+                matrix_set
+                (c_down, y, x,
+                 if (x >= quotient(width, 4)
+                     andalso x < quotient(3 * width, 4)
+                     andalso (y = quotient(height, 4) - 1
+                              orelse y = quotient(3 * height, 4) - 1))
+                    then 1
+                 else 128)))
       ; rao_ratio_region(c_right, c_down,
-			 make_matrix(height, width, 1),
-			 lg_max_v)
+                         make_matrix(height, width, 1),
+                         lg_max_v)
    end
 
 end

Modified: mlton/branches/on-20050420-cmm-branch/benchmark/tests/ray.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/benchmark/tests/ray.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/benchmark/tests/ray.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -17,11 +17,11 @@
     datatype ray = Ray of {s : point, d : vector}
 
     datatype camera = Camera of {
-	vp : point,
-	ul : point,
-	ur : point,
-	ll : point,
-	lr : point
+        vp : point,
+        ul : point,
+        ur : point,
+        ll : point,
+        lr : point
       }
 
     datatype color = Color of {red : real, grn : real, blu : real}
@@ -84,55 +84,55 @@
       open Objects
       val dict = ref ([] : {key : string, value : object} list)
       fun dictInsert (NAME key, value) = let
-	    fun find [] = [{key=key, value=value}]
-	      | find (x::r) = if (key = #key x)
-		  then {key=key, value=value}::r
-		  else x :: (find r)
-	    in
-	      dict := find(!dict)
-	    end
-	| dictInsert _ = raise Fail "dictInsert"
+            fun find [] = [{key=key, value=value}]
+              | find (x::r) = if (key = #key x)
+                  then {key=key, value=value}::r
+                  else x :: (find r)
+            in
+              dict := find(!dict)
+            end
+        | dictInsert _ = raise Fail "dictInsert"
       fun prObj outStrm obj = let
-	    fun printf args = TextIO.output(outStrm, implode args)
-	    fun pr (NUMBER n) = printf["  ", Real.toString n, "\n"]
-	      | pr (NAME s) = printf["  ",  s, "\n"]
-	      | pr (LITERAL s) = printf["  ", s, "\n"]
-	      | pr (LIST l) = app pr l
-	      | pr MARK = printf["  MARK\n"]
-	      | pr (OPERATOR _) = printf["  <operator>\n"]
-	      | pr TOP = printf["  TOP OF STACK\n"]
-	      | pr _ = printf["  <object>\n"]
-	    in
-	      pr obj
-	    end
+            fun printf args = TextIO.output(outStrm, implode args)
+            fun pr (NUMBER n) = printf["  ", Real.toString n, "\n"]
+              | pr (NAME s) = printf["  ",  s, "\n"]
+              | pr (LITERAL s) = printf["  ", s, "\n"]
+              | pr (LIST l) = app pr l
+              | pr MARK = printf["  MARK\n"]
+              | pr (OPERATOR _) = printf["  <operator>\n"]
+              | pr TOP = printf["  TOP OF STACK\n"]
+              | pr _ = printf["  <object>\n"]
+            in
+              pr obj
+            end
     in
 
     exception Stop
 
     fun error opName stk = let
-	  fun prStk ([], _) = ()
-	    | prStk (_, 0) = ()
-	    | prStk (obj::r, i) = (prObj TextIO.stdErr obj; prStk(r, i-1))
-	  in
-	    TextIO.output(TextIO.stdErr, "ERROR: "^opName^"\n");
-	    prStk (stk, 10);
-	    raise (Fail opName)
-	  end
+          fun prStk ([], _) = ()
+            | prStk (_, 0) = ()
+            | prStk (obj::r, i) = (prObj TextIO.stdErr obj; prStk(r, i-1))
+          in
+            TextIO.output(TextIO.stdErr, "ERROR: "^opName^"\n");
+            prStk (stk, 10);
+            raise (Fail opName)
+          end
 
     fun installOperator (name, rator) =
-	  dictInsert (NAME name, OPERATOR rator)
+          dictInsert (NAME name, OPERATOR rator)
 
     fun ps_def (v::k::r) = (dictInsert(k, v); r)
       | ps_def stk = error "ps_def" stk
 
     local
       fun binOp (f, opName) = let
-	    fun g ((NUMBER arg1)::(NUMBER arg2)::r) =
-		  NUMBER(f(arg2, arg1)) :: r
-	      | g stk = error opName stk
-	    in
-	      g
-	    end
+            fun g ((NUMBER arg1)::(NUMBER arg2)::r) =
+                  NUMBER(f(arg2, arg1)) :: r
+              | g stk = error opName stk
+            in
+              g
+            end
     in
     val ps_add = binOp (op +, "add")
     val ps_sub = binOp (op -, "sub")
@@ -152,87 +152,87 @@
 
   (* initialize dictionary and begin parsing input *)
     fun parse inStrm = let
-	  fun getc () = case TextIO.input1 inStrm of NONE => ""
+          fun getc () = case TextIO.input1 inStrm of NONE => ""
                                | SOME c => Char.toString c
-	  fun peek () = case TextIO.lookahead inStrm
+          fun peek () = case TextIO.lookahead inStrm
                          of SOME x => Char.toString x
                           | _ => ""
-	(* parse one token from inStrm *)
-	  fun toke deferred = let
-		fun doChar "" = exit OS.Process.success
-		  | doChar "%" = let
-		      fun lp "\n" = doChar(getc())
-			| lp "" = exit OS.Process.success
-			| lp _ = lp(getc())
-		      in
-			lp(getc())
-		      end
-		  | doChar "{" = (MARK, deferred+1)
-		  | doChar "}" = (UNMARK, deferred-1)
-		  | doChar c = if Char.isSpace (fromStr c)
-		      then doChar(getc())
-		      else let
-			fun lp buf = (case peek()
-			       of "{" => buf
-				| "}" => buf
-				| "%" => buf
-				| c => if Char.isSpace(fromStr c)
-				    then buf
-				    else (getc(); lp(c::buf))
-			      (* end case *))
-			val tok = implode (rev (lp [c]))
-			val hd = ordof(tok, 0)
-			in
-			  if (hd = ord (#"/"))
-			    then (LITERAL(substring(tok, 1, size tok - 1)), deferred)
-			  else 
+        (* parse one token from inStrm *)
+          fun toke deferred = let
+                fun doChar "" = exit OS.Process.success
+                  | doChar "%" = let
+                      fun lp "\n" = doChar(getc())
+                        | lp "" = exit OS.Process.success
+                        | lp _ = lp(getc())
+                      in
+                        lp(getc())
+                      end
+                  | doChar "{" = (MARK, deferred+1)
+                  | doChar "}" = (UNMARK, deferred-1)
+                  | doChar c = if Char.isSpace (fromStr c)
+                      then doChar(getc())
+                      else let
+                        fun lp buf = (case peek()
+                               of "{" => buf
+                                | "}" => buf
+                                | "%" => buf
+                                | c => if Char.isSpace(fromStr c)
+                                    then buf
+                                    else (getc(); lp(c::buf))
+                              (* end case *))
+                        val tok = implode (rev (lp [c]))
+                        val hd = ordof(tok, 0)
+                        in
+                          if (hd = ord (#"/"))
+                            then (LITERAL(substring(tok, 1, size tok - 1)), deferred)
+                          else 
                             if ((Char.isDigit (chr hd)) orelse (hd = ord (#"-")))
-			    then (NUMBER(strToReal(tok)), deferred)
-			    else (NAME tok, deferred)
-			end
-		in
-		  doChar(getc())
-		end
-	(* execute a token (if not deferred) *)
-	  fun exec (UNMARK, stk, _) = let
-		fun lp ([], _) = raise Fail "MARK"
-		  | lp (MARK::r, l) = (LIST l)::r
-		  | lp (x::r, l) = lp (r, x::l)
-		  in
-		    lp (stk, [])
-		  end
-	    | exec (OPERATOR f, stk, 0) = f stk
-	    | exec (LIST l, stk, 0) = let
-		fun execBody ([], stk) = stk
-		  | execBody (obj::r, stk) = (exec(obj, stk, 0); execBody(r, stk))
-		in
-		  execBody (l, stk)
-		end
-	    | exec (NAME s, stk, 0) = let
-		fun find [] = raise Fail "undefined name"
-		  | find ({key, value}::r) = if (key = s) then value else find r
-		in
-		  exec (find (!dict), stk, 0)
-		end
-	    | exec (obj, stk, _) = obj::stk
-	  fun lp (stk, level) = let
-		val (obj, level) = toke level
-		val stk = exec (obj, stk, level)
-		in
-		  lp (stk, level)
-		end
-	  in
-	    installOperator ("add", ps_add);
-	    installOperator ("def", ps_def);
-	    installOperator ("div", ps_div);
-	    installOperator ("dup", ps_dup);
-	    installOperator ("mul", ps_mul);
-	    installOperator ("print", ps_print);
-	    installOperator ("rand", ps_rand);
-	    installOperator ("stop", ps_stop);
-	    installOperator ("sub", ps_sub);
-	    (lp ([], 0)) handle Stop => ()
-	  end (* parse *)
+                            then (NUMBER(strToReal(tok)), deferred)
+                            else (NAME tok, deferred)
+                        end
+                in
+                  doChar(getc())
+                end
+        (* execute a token (if not deferred) *)
+          fun exec (UNMARK, stk, _) = let
+                fun lp ([], _) = raise Fail "MARK"
+                  | lp (MARK::r, l) = (LIST l)::r
+                  | lp (x::r, l) = lp (r, x::l)
+                  in
+                    lp (stk, [])
+                  end
+            | exec (OPERATOR f, stk, 0) = f stk
+            | exec (LIST l, stk, 0) = let
+                fun execBody ([], stk) = stk
+                  | execBody (obj::r, stk) = (exec(obj, stk, 0); execBody(r, stk))
+                in
+                  execBody (l, stk)
+                end
+            | exec (NAME s, stk, 0) = let
+                fun find [] = raise Fail "undefined name"
+                  | find ({key, value}::r) = if (key = s) then value else find r
+                in
+                  exec (find (!dict), stk, 0)
+                end
+            | exec (obj, stk, _) = obj::stk
+          fun lp (stk, level) = let
+                val (obj, level) = toke level
+                val stk = exec (obj, stk, level)
+                in
+                  lp (stk, level)
+                end
+          in
+            installOperator ("add", ps_add);
+            installOperator ("def", ps_def);
+            installOperator ("div", ps_div);
+            installOperator ("dup", ps_dup);
+            installOperator ("mul", ps_mul);
+            installOperator ("print", ps_print);
+            installOperator ("rand", ps_rand);
+            installOperator ("stop", ps_stop);
+            installOperator ("sub", ps_sub);
+            (lp ([], 0)) handle Stop => ()
+          end (* parse *)
 
     end (* local *)
 
@@ -257,120 +257,120 @@
     fun ptMinusPt (PT{x, y, z}, PT{x=x', y=y', z=z'}) = VEC{l=x-x', m=y-y', n=z-z'}
 
     fun wave (PT{x, y, z}, PT{x=x', y=y', z=z'}, w) = PT{
-	    x = w * (x' - x) + x,
-	    y = w * (y' - y) + y,
-	    z = w * (z' - z) + z
-	  }
+            x = w * (x' - x) + x,
+            y = w * (y' - y) + y,
+            z = w * (z' - z) + z
+          }
 
     fun dotProd (VEC{l, m, n}, VEC{l=l', m=m', n=n'}) = ((l*l') + (m*m') + (n*n'))
 
   (* normal vector to sphere *)
     fun normalSphere (Visible{h, s as Sphere{c, ...}}) = let
-	  val n = ptMinusPt(h, c)
-	  val norm = Math.sqrt(dotProd(n, n))
-	  in
-	    scaleVector(1.0 / norm, n)
-	  end
+          val n = ptMinusPt(h, c)
+          val norm = Math.sqrt(dotProd(n, n))
+          in
+            scaleVector(1.0 / norm, n)
+          end
 
   (* intersect a ray with a sphere *)
     fun intersectSphere (Ray ray, s as Sphere sphere) = let
-	  val a = dotProd(#d ray, #d ray)
-	  val sdiffc = ptMinusPt(#s ray, #c sphere)
-	  val b = 2.0 * dotProd(sdiffc, #d ray)
-	  val c = dotProd(sdiffc, sdiffc) - (#r sphere * #r sphere)
-	  val d = b*b - 4.0*a*c
-	  in
-	    if (d <= 0.0)
-	      then Miss
-	      else let
-		val d = Math.sqrt(d)
-		val t1 = (~b - d) / (2.0 * a)
-		val t2 = (~b + d) / (2.0 * a)
-		val t = if ((t1 > 0.0) andalso (t1 < t2)) then t1 else t2
-		in
-		  Hit{t=t, s=s}
-		end
-	  end
+          val a = dotProd(#d ray, #d ray)
+          val sdiffc = ptMinusPt(#s ray, #c sphere)
+          val b = 2.0 * dotProd(sdiffc, #d ray)
+          val c = dotProd(sdiffc, sdiffc) - (#r sphere * #r sphere)
+          val d = b*b - 4.0*a*c
+          in
+            if (d <= 0.0)
+              then Miss
+              else let
+                val d = Math.sqrt(d)
+                val t1 = (~b - d) / (2.0 * a)
+                val t2 = (~b + d) / (2.0 * a)
+                val t = if ((t1 > 0.0) andalso (t1 < t2)) then t1 else t2
+                in
+                  Hit{t=t, s=s}
+                end
+          end
 
   (* simple shading function *)
     fun shade {light, phi} (visible as Visible{h, s}) = let
-	  val l = ptMinusPt(light, h)
-	  val n = normalSphere(visible)
-	  val irradiance = phi * dotProd(l,n) / dotProd(l,l);
-	  val irradiance = (if (irradiance < 0.0) then 0.0 else irradiance) + 0.05
-	  val Sphere{color=Color{red, grn, blu}, ...} = s
-	  in
-	    Color{red=red*irradiance, grn=grn*irradiance, blu=blu*irradiance}
-	  end
+          val l = ptMinusPt(light, h)
+          val n = normalSphere(visible)
+          val irradiance = phi * dotProd(l,n) / dotProd(l,l);
+          val irradiance = (if (irradiance < 0.0) then 0.0 else irradiance) + 0.05
+          val Sphere{color=Color{red, grn, blu}, ...} = s
+          in
+            Color{red=red*irradiance, grn=grn*irradiance, blu=blu*irradiance}
+          end
 
     fun trace (ray as (Ray ray'), objList) = let
-	  fun closest (Miss, x) = x
-	    | closest (x, Miss) = x
-	    | closest (h1 as Hit{t=t1, ...}, h2 as Hit{t=t2, ...}) =
-		if (t2 < t1) then h2 else h1
-	  fun lp ([], Hit{t, s}) = Visible{
-		  h = vecPlusPt(scaleVector(t, #d ray'), #s ray'),
-		  s = s
-		}
-	    | lp (s :: r, closestHit) =
-		lp (r, closest (closestHit, intersectSphere (ray, s)))
-	    | lp _ = raise Fail "trace"
-	  in
-	    lp (objList, Miss)
-	  end
+          fun closest (Miss, x) = x
+            | closest (x, Miss) = x
+            | closest (h1 as Hit{t=t1, ...}, h2 as Hit{t=t2, ...}) =
+                if (t2 < t1) then h2 else h1
+          fun lp ([], Hit{t, s}) = Visible{
+                  h = vecPlusPt(scaleVector(t, #d ray'), #s ray'),
+                  s = s
+                }
+            | lp (s :: r, closestHit) =
+                lp (r, closest (closestHit, intersectSphere (ray, s)))
+            | lp _ = raise Fail "trace"
+          in
+            lp (objList, Miss)
+          end
 
     fun camera (Camera cam) (x, y) = let
-	  val l = wave (#ul cam, #ll cam, y)
-	  val r = wave (#ur cam, #lr cam, y)
-	  val image_point = wave(l, r, x)
-	  in
-	    Ray{d = ptMinusPt(image_point, #vp cam), s = #vp cam}
-	  end
+          val l = wave (#ul cam, #ll cam, y)
+          val r = wave (#ur cam, #lr cam, y)
+          val image_point = wave(l, r, x)
+          in
+            Ray{d = ptMinusPt(image_point, #vp cam), s = #vp cam}
+          end
 
     val shade = shade {light = PT{x = 10.0, y = ~10.0, z = ~10.0}, phi = 16.0}
     val camera = camera (Camera{
-	    vp = PT{x = 0.0, y = 0.0, z = ~3.0},
-	    ul = PT{x = ~1.0, y = ~1.0, z = 0.0},
-	    ur = PT{x = 1.0, y = ~1.0, z = 0.0},
-	    ll = PT{x = ~1.0, y = 1.0, z = 0.0},
-	    lr = PT{x = 1.0, y = 1.0, z = 0.0}
-	  })
+            vp = PT{x = 0.0, y = 0.0, z = ~3.0},
+            ul = PT{x = ~1.0, y = ~1.0, z = 0.0},
+            ur = PT{x = 1.0, y = ~1.0, z = 0.0},
+            ll = PT{x = ~1.0, y = 1.0, z = 0.0},
+            lr = PT{x = 1.0, y = 1.0, z = 0.0}
+          })
 
     fun image objList (x, y) = shade (trace(camera(x, y), objList))
 
     fun picture (picName, objList) = let
-	  val outStrm = TextIO.openOut picName
-	  val image = image objList
-	  val print = fn x => TextIO.output (outStrm, x)
-	  fun putc c = TextIO.output1(outStrm, chr c)
-	  fun doPixel (i, j) = let
-		val x = (real i) / 512.0
-		val y = (real j) / 512.0
-		val (Color c) = image (x, y)
-		fun cvt x = if (x >= 1.0) then 255 else floor(256.0*x)
-		in
-		  putc (cvt (#red c));
-		  putc (cvt (#grn c));
-		  putc (cvt (#blu c))
-		end
-	  fun lp_j j = if (j < 512)
-		then let
-		  fun lp_i i = if (i < 512)
-			then (doPixel(i, j); lp_i(i+1))
-			else ()
-		  in
-		    lp_i 0; lp_j(j+1)
-		  end
-		else ()
-	  in
-	    print "TYPE=dump\n";
-	    print "WINDOW=0 0 512 512\n";
-	    print "NCHAN=3\n";
-	    print "CHAN=rgb\n";
-	    print "\n";
-	    lp_j 0;
-	    TextIO.closeOut outStrm
-	  end
+          val outStrm = TextIO.openOut picName
+          val image = image objList
+          val print = fn x => TextIO.output (outStrm, x)
+          fun putc c = TextIO.output1(outStrm, chr c)
+          fun doPixel (i, j) = let
+                val x = (real i) / 512.0
+                val y = (real j) / 512.0
+                val (Color c) = image (x, y)
+                fun cvt x = if (x >= 1.0) then 255 else floor(256.0*x)
+                in
+                  putc (cvt (#red c));
+                  putc (cvt (#grn c));
+                  putc (cvt (#blu c))
+                end
+          fun lp_j j = if (j < 512)
+                then let
+                  fun lp_i i = if (i < 512)
+                        then (doPixel(i, j); lp_i(i+1))
+                        else ()
+                  in
+                    lp_i 0; lp_j(j+1)
+                  end
+                else ()
+          in
+            print "TYPE=dump\n";
+            print "WINDOW=0 0 512 512\n";
+            print "NCHAN=3\n";
+            print "CHAN=rgb\n";
+            print "\n";
+            lp_j 0;
+            TextIO.closeOut outStrm
+          end
 
     end (* local *)
   end; (* Ray *)
@@ -391,33 +391,33 @@
    * usage: red-value green-value blue-value color
    *)
     fun ps_color ((NUMBER blu)::(NUMBER grn)::(NUMBER red)::r) =
-	  (COLOR(Color{red=red, grn=grn, blu=blu})) :: r
+          (COLOR(Color{red=red, grn=grn, blu=blu})) :: r
       | ps_color stk = Interp.error "color" stk
 
   (* pop radius, coordinates of center, and a color and push a sphere
    * usage: radius x y z color-value sphere
    *)
     fun ps_sphere (
-	  (COLOR c)::(NUMBER z)::(NUMBER y)::(NUMBER x)::(NUMBER rad)::r
-	) = SPHERE(Sphere{c=PT{x=x, y=y, z=z}, r=rad, color=c}) :: r
+          (COLOR c)::(NUMBER z)::(NUMBER y)::(NUMBER x)::(NUMBER rad)::r
+        ) = SPHERE(Sphere{c=PT{x=x, y=y, z=z}, r=rad, color=c}) :: r
       | ps_sphere stk = Interp.error "sphere" stk
 
   (* build an object list from solids on the stack, then invoke raytracer *)
     fun ps_raytrace ((LITERAL picName)::r) = let
-	  fun mkObjList ([], l) = l
-	    | mkObjList ((SPHERE s)::r, l) = mkObjList(r, s::l)
-	    | mkObjList (_::r, l) = mkObjList(r, l)
-	  in
-	    Ray.picture(picName, mkObjList(r, []));
-	    []
-	  end
+          fun mkObjList ([], l) = l
+            | mkObjList ((SPHERE s)::r, l) = mkObjList(r, s::l)
+            | mkObjList (_::r, l) = mkObjList(r, l)
+          in
+            Ray.picture(picName, mkObjList(r, []));
+            []
+          end
       | ps_raytrace stk = Interp.error "raytrace" stk
 
   (* add ray tracing operations to interpreter dictionary *)
     fun rtInit () = (
-	  Interp.installOperator("color", ps_color);
-	  Interp.installOperator("sphere", ps_sphere);
-	  Interp.installOperator("raytrace", ps_raytrace))
+          Interp.installOperator("color", ps_color);
+          Interp.installOperator("sphere", ps_sphere);
+          Interp.installOperator("raytrace", ps_raytrace))
 
     end (* local *)
   end;
@@ -439,20 +439,20 @@
 
     fun doit n =
        let
-	  fun loop n =
-	     if n = 0
-		then ()
-	     else
-		let
-		   val strm = TextIO.openIn "DATA/ray"
-		   val _ = Interface.rtInit()
-		   val _ = Interp.parse strm
-		   val _ = TextIO.closeIn strm
-		in
-		   loop (n - 1)
-		end
+          fun loop n =
+             if n = 0
+                then ()
+             else
+                let
+                   val strm = TextIO.openIn "DATA/ray"
+                   val _ = Interface.rtInit()
+                   val _ = Interp.parse strm
+                   val _ = TextIO.closeIn strm
+                in
+                   loop (n - 1)
+                end
        in
-	  loop n
+          loop n
        end
 
     fun testit _ = ()

Modified: mlton/branches/on-20050420-cmm-branch/benchmark/tests/raytrace.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/benchmark/tests/raytrace.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/benchmark/tests/raytrace.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -49,35 +49,35 @@
    struct
       local open Array
       in
-	 val array = array
-	 val copy = copy
-	 val of_list = fromList
-	 val length = length
-	 val sub = sub
-	 val update = update
-	 val unsafe_get = Array.sub
-	 val unsafe_set = Array.update
-	 val make = array
-	 fun map f a = Array.tabulate(length a, fn i => f(Array.sub(a, i)))
-	 val init = tabulate
+         val array = array
+         val copy = copy
+         val of_list = fromList
+         val length = length
+         val sub = sub
+         val update = update
+         val unsafe_get = Array.sub
+         val unsafe_set = Array.update
+         val make = array
+         fun map f a = Array.tabulate(length a, fn i => f(Array.sub(a, i)))
+         val init = tabulate
       end
    end
 
 fun for(a: int, b, f) =
    let
       fun loop a =
-	 if a > b
-	    then ()
-	 else (f a; loop(a + 1))
+         if a > b
+            then ()
+         else (f a; loop(a + 1))
    in loop a
    end
 
 fun forDown(b: int, a, f) =
    let
       fun loop b =
-	 if b < a
-	    then ()
-	 else (f b; loop(b - 1))
+         if b < a
+            then ()
+         else (f b; loop(b - 1))
    in loop b
    end
 
@@ -110,26 +110,26 @@
    end =
    struct
       datatype ('a, 'b) t = T of (string * 'b) list ref
-	    
+            
       fun create _ = T (ref [])
 
       fun add (T t) k d = t := (k, d) :: !t
 
       fun find (T (ref t)) k =
-	 case List.find (fn (k', _) => k = k') t of
-	    NONE => raise Not_found
-	  | SOME(_, d) => d
+         case List.find (fn (k', _) => k = k') t of
+            NONE => raise Not_found
+          | SOME(_, d) => d
    end
 
 structure List =
    struct
       local open List
       in
-	 val iter = app
-	 val map = map
-	 val filter = filter
-	 val nth = nth
-	 val rev = rev
+         val iter = app
+         val map = map
+         val filter = filter
+         val nth = nth
+         val rev = rev
       end
    end
 
@@ -203,21 +203,21 @@
 
 val identity =
    Array.of_list[1.0, 0.0, 0.0, 0.0,
-		  0.0, 1.0, 0.0, 0.0,
-		  0.0, 0.0, 1.0, 0.0,
-		  0.0, 0.0, 0.0, 1.0]
+                  0.0, 1.0, 0.0, 0.0,
+                  0.0, 0.0, 1.0, 0.0,
+                  0.0, 0.0, 0.0, 1.0]
 
 fun translate(x, y, z) =
    Array.of_list[1.0, 0.0, 0.0, ~ x,
-		  0.0, 1.0, 0.0, ~ y,
-		  0.0, 0.0, 1.0, ~ z,
-		  0.0, 0.0, 0.0, 1.0]
+                  0.0, 1.0, 0.0, ~ y,
+                  0.0, 0.0, 1.0, ~ z,
+                  0.0, 0.0, 0.0, 1.0]
 
 fun unscale(x, y, z) =
    Array.of_list[ x,  0.0, 0.0, 0.0,
-		  0.0, y,  0.0, 0.0,
-		  0.0, 0.0, z,  0.0,
-		  0.0, 0.0, 0.0, 1.0]
+                  0.0, y,  0.0, 0.0,
+                  0.0, 0.0, z,  0.0,
+                  0.0, 0.0, 0.0, 1.0]
   
 fun scale(x, y, z) = unscale (1.0 / x, 1.0 / y, 1.0 / z)
 
@@ -231,9 +231,9 @@
      val si = dsin t
   in
      Array.of_list[ 1.0,   0.0,  0.0, 0.0,
-		    0.0,   co,  si, 0.0,
-		    0.0, ~ si, co, 0.0,
-		    0.0,   0.0,  0.0, 1.0 ]
+                    0.0,   co,  si, 0.0,
+                    0.0, ~ si, co, 0.0,
+                    0.0,   0.0,  0.0, 1.0 ]
   end
 
 fun rotatey t =
@@ -242,9 +242,9 @@
      val si = dsin t
   in
      Array.of_list[ co, 0.0, ~ si, 0.0,
-		    0.0, 1.0,   0.0,  0.0,
-		    si, 0.0,   co,  0.0,
-		    0.0, 0.0,   0.0,  1.0 ]
+                    0.0, 1.0,   0.0,  0.0,
+                    si, 0.0,   co,  0.0,
+                    0.0, 0.0,   0.0,  1.0 ]
   end
 
 fun rotatez t =
@@ -253,9 +253,9 @@
      val si = dsin t
   in
      Array.of_list[   co,  si, 0.0, 0.0,
-		    ~ si, co, 0.0, 0.0,
-		    0.0,  0.0, 1.0, 0.0,
-		    0.0,  0.0, 0.0, 1.0 ]
+                    ~ si, co, 0.0, 0.0,
+                    0.0,  0.0, 1.0, 0.0,
+                    0.0,  0.0, 0.0, 1.0 ]
   end
 
 (*** Operations on matrices ***)
@@ -268,20 +268,20 @@
      val m'' = Array.make (16, 0.0)
   in
      for(0, 3, fn i =>
-	 for(0, 3, fn j => let
-	    fun lp (4, s) = s
-	      | lp (k, s) = lp (k+1, s + get(m, i, k) * get(m', k, j))
-	    in
-	      set(m'', i, j, lp(0, 0.0))
-	    end))
+         for(0, 3, fn j => let
+            fun lp (4, s) = s
+              | lp (k, s) = lp (k+1, s + get(m, i, k) * get(m', k, j))
+            in
+              set(m'', i, j, lp(0, 0.0))
+            end))
      ; m''
   end
 
 fun transpose m =
   let val m' = Array.make (16, 0.0)
   in for(0, 3, fn i =>
-	 for(0, 3, fn j =>
-	     set (m', i, j, get (m, j, i))))
+         for(0, 3, fn j =>
+             set (m', i, j, get (m, j, i))))
      ; m'
   end
 
@@ -341,7 +341,7 @@
       include LEX_TOKEN_STRUCTS
       
       datatype t =
-	 Binder of string
+         Binder of string
        | Bool of bool
        | Eof
        | Identifier of string
@@ -391,7 +391,7 @@
 end (* end of user routines *)
 exception LexError (* raised if illegal leaf action tried *)
 structure Internal =
-	struct
+        struct
 
 datatype yyfinstate = N of int
 type statedata = {fin : yyfinstate list, trans: string}
@@ -616,8 +616,8 @@
 {fin = [(N 60),(N 62)], trans = 0}])
 end
 structure StartStates =
-	struct
-	datatype yystartstate = STARTSTATE of int
+        struct
+        datatype yystartstate = STARTSTATE of int
 
 (* start state definitions *)
 
@@ -627,49 +627,49 @@
 
 end
 type result = UserDeclarations.lexresult
-	exception LexerError (* raised if illegal leaf action tried *)
+        exception LexerError (* raised if illegal leaf action tried *)
 end
 
 type int = Int.int
 fun makeLexer (yyinput: int -> string) =
-let	val yygone0:int=1
-	val yyb = ref "\n" 		(* buffer *)
-	val yybl: int ref = ref 1		(*buffer length *)
-	val yybufpos: int ref = ref 1		(* location of next character to use *)
-	val yygone: int ref = ref yygone0	(* position in file of beginning of buffer *)
-	val yydone = ref false		(* eof found yet? *)
-	val yybegin: int ref = ref 1		(*Current 'start state' for lexer *)
+let     val yygone0:int=1
+        val yyb = ref "\n"              (* buffer *)
+        val yybl: int ref = ref 1               (*buffer length *)
+        val yybufpos: int ref = ref 1           (* location of next character to use *)
+        val yygone: int ref = ref yygone0       (* position in file of beginning of buffer *)
+        val yydone = ref false          (* eof found yet? *)
+        val yybegin: int ref = ref 1            (*Current 'start state' for lexer *)
 
-	val YYBEGIN = fn (Internal.StartStates.STARTSTATE x) =>
-		 yybegin := x
+        val YYBEGIN = fn (Internal.StartStates.STARTSTATE x) =>
+                 yybegin := x
 
 fun lex (yyarg as (())) =
 let fun continue() : Internal.result = 
   let fun scan (s,AcceptingLeaves : Internal.yyfinstate list list,l,i0: int) =
-	let fun action (i: int,nil) = raise LexError
-	| action (i,nil::l) = action (i-1,l)
-	| action (i,(node::acts)::l) =
-		case node of
-		    Internal.N yyk => 
-			(let fun yymktext() = String.substring(!yyb,i0,i-i0)
-			     val yypos: int = i0+ !yygone
-			fun REJECT() = action(i,acts::l)
-			open UserDeclarations Internal.StartStates
+        let fun action (i: int,nil) = raise LexError
+        | action (i,nil::l) = action (i-1,l)
+        | action (i,(node::acts)::l) =
+                case node of
+                    Internal.N yyk => 
+                        (let fun yymktext() = String.substring(!yyb,i0,i-i0)
+                             val yypos: int = i0+ !yygone
+                        fun REJECT() = action(i,acts::l)
+                        open UserDeclarations Internal.StartStates
  in (yybufpos := i; case yyk of 
 
-			(* Application actions *)
+                        (* Application actions *)
 
   11 => (Token.Lbrace)
 | 13 => (Token.Rbrace)
 | 20 => let val yytext=yymktext() in Token.Binder(String.extract(yytext, 1, NONE)) end
 | 35 => let val yytext=yymktext() in Token.Real(case Real.fromString yytext of
-				  NONE =>
-				     fail(concat["bad real constant ", yytext])
-				| SOME r => r) end
+                                  NONE =>
+                                     fail(concat["bad real constant ", yytext])
+                                | SOME r => r) end
 | 39 => let val yytext=yymktext() in Token.Int(case Int.fromString yytext of
-				NONE => 
-				   fail(concat["bad int constant ", yytext])
-			      | SOME i => i) end
+                                NONE => 
+                                   fail(concat["bad int constant ", yytext])
+                              | SOME i => i) end
 | 41 => (chars := []; YYBEGIN S; continue())
 | 43 => (YYBEGIN C; continue())
 | 49 => let val yytext=yymktext() in Token.Identifier yytext end
@@ -677,45 +677,45 @@
 | 55 => (YYBEGIN INITIAL; continue())
 | 58 => (continue())
 | 60 => (let val s = (implode(rev(!chars)) before chars := nil)
-	       in YYBEGIN INITIAL
-		  ; Token.String s
-	       end)
+               in YYBEGIN INITIAL
+                  ; Token.String s
+               end)
 | 62 => let val yytext=yymktext() in chars := String.sub(yytext, 0) :: !chars
-	       ; continue() end
+               ; continue() end
 | 7 => (Token.Lbracket)
 | 9 => (Token.Rbracket)
 | _ => raise Internal.LexerError
 
-		) end )
+                ) end )
 
-	val {fin,trans} = Vector.sub(Internal.tab, s)
-	val NewAcceptingLeaves = fin::AcceptingLeaves
-	in if l = !yybl then
-	     if trans = #trans(Vector.sub(Internal.tab,0))
-	       then action(l,NewAcceptingLeaves
-) else	    let val newchars= if !yydone then "" else yyinput 1024
-	    in if (String.size newchars)=0
-		  then (yydone := true;
-		        if (l=i0) then UserDeclarations.eof yyarg
-		                  else action(l,NewAcceptingLeaves))
-		  else (if i0=l then yyb := newchars
-		     else yyb := String.substring(!yyb,i0,l-i0)^newchars;
-		     yygone := !yygone+i0;
-		     yybl := String.size (!yyb);
-		     scan (s,AcceptingLeaves,l-i0,0))
-	    end
-	  else let val NewChar = Char.ord(CharVector.sub(!yyb,l))
-		val NewChar = if NewChar<128 then NewChar else 128
-		val NewState = Char.ord(CharVector.sub(trans,NewChar))
-		in if NewState=0 then action(l,NewAcceptingLeaves)
-		else scan(NewState,NewAcceptingLeaves,l+1,i0)
-	end
-	end
+        val {fin,trans} = Vector.sub(Internal.tab, s)
+        val NewAcceptingLeaves = fin::AcceptingLeaves
+        in if l = !yybl then
+             if trans = #trans(Vector.sub(Internal.tab,0))
+               then action(l,NewAcceptingLeaves
+) else      let val newchars= if !yydone then "" else yyinput 1024
+            in if (String.size newchars)=0
+                  then (yydone := true;
+                        if (l=i0) then UserDeclarations.eof yyarg
+                                  else action(l,NewAcceptingLeaves))
+                  else (if i0=l then yyb := newchars
+                     else yyb := String.substring(!yyb,i0,l-i0)^newchars;
+                     yygone := !yygone+i0;
+                     yybl := String.size (!yyb);
+                     scan (s,AcceptingLeaves,l-i0,0))
+            end
+          else let val NewChar = Char.ord(CharVector.sub(!yyb,l))
+                val NewChar = if NewChar<128 then NewChar else 128
+                val NewState = Char.ord(CharVector.sub(trans,NewChar))
+                in if NewState=0 then action(l,NewAcceptingLeaves)
+                else scan(NewState,NewAcceptingLeaves,l+1,i0)
+        end
+        end
 (*
-	val start= if String.substring(!yyb,!yybufpos-1,1)="\n"
+        val start= if String.substring(!yyb,!yybufpos-1,1)="\n"
 then !yybegin+1 else !yybegin
 *)
-	in scan(!yybegin (* start *),nil,!yybufpos,!yybufpos)
+        in scan(!yybegin (* start *),nil,!yybufpos,!yybufpos)
     end
 in continue end
   in lex
@@ -727,7 +727,7 @@
       (**** Basic types: programs, values, ... ****)
 
       datatype k =
-	 Acos | Addi | Addf | Apply | Asin | Clampf | Cone | Cos | Cube
+         Acos | Addi | Addf | Apply | Asin | Clampf | Cone | Cos | Cube
        | Cylinder | Difference | Divi | Divf | Eqi | Eqf | Floor | Frac
        | Get | Getx | Gety | Getz | If | Intersect | Length | Lessi | Lessf
        | Light | Modi | Muli | Mulf | Negi | Negf | Plane | Point
@@ -737,7 +737,7 @@
 
       (* Program tokens *)
       datatype t =
-	 Fun of t list
+         Fun of t list
        | Arr of t list
        | Ident of string
        | Binder of string
@@ -749,7 +749,7 @@
 
       (* internal representation of program tokens *)
       datatype t' =
-	 Fun' of t' list
+         Fun' of t' list
        | Arr' of t' list
        | Ident' of int (* index to environment stack *)
        | Binder'
@@ -758,48 +758,48 @@
      | Float' of float
      | Bool' of bool
      | String' of string
-	*)
+        *)
        | Prim' of k
        | Val' of v (* inlined value *)
 
       (* Values *)
       and v =
-	 VInt of int
-	| VFloat of float
-	| VBool of bool
-	| VStr of string
-	| VClos of v list * t' list
-	| VFun of (v list -> v list) (* XXX for the compiler *)
-	| VArr of v array
-	| VPoint of v * v * v (* XXX Maybe these should be floats? *)
-	| VObj of obj
-	| VLight of v * v
-	| VPtLight of v * v
-	| VStLight of v * v * v * v * v
+         VInt of int
+        | VFloat of float
+        | VBool of bool
+        | VStr of string
+        | VClos of v list * t' list
+        | VFun of (v list -> v list) (* XXX for the compiler *)
+        | VArr of v array
+        | VPoint of v * v * v (* XXX Maybe these should be floats? *)
+        | VObj of obj
+        | VLight of v * v
+        | VPtLight of v * v
+        | VStLight of v * v * v * v * v
 
       and obj =
-	 OObj of kind * closure ref
-	| OTransform of
-	  obj *
-	  Matrix.t *     (* World to object *)
-	  Matrix.t *     (* Object to world *)
-	  float *        (* Scale factor *)
-	  bool           (* Isometry? *)
-	| OUnion of obj * obj
-	| OInter of obj * obj
-	| ODiff of obj * obj
+         OObj of kind * closure ref
+        | OTransform of
+          obj *
+          Matrix.t *     (* World to object *)
+          Matrix.t *     (* Object to world *)
+          float *        (* Scale factor *)
+          bool           (* Isometry? *)
+        | OUnion of obj * obj
+        | OInter of obj * obj
+        | ODiff of obj * obj
 
       and kind =
-	 OSphere
-	| OCube
-	| OCylind
-	| OCone
-	| OPlane
+         OSphere
+        | OCube
+        | OCylind
+        | OCone
+        | OPlane
 
       and closure =
-	 Unopt of v (* Unoptimized function *)
-	| Opt of v
-	| Cst of (float * float * float * float * float * float)
+         Unopt of v (* Unoptimized function *)
+        | Opt of v
+        | Cst of (float * float * float * float * float * float)
 
       (* Translation of an identifier *)
       val translate : string -> t
@@ -976,43 +976,43 @@
 fun read(ins: TextIO.instream): t list =
    let
       val lex: unit -> LexToken.t =
-	 Lex.makeLexer(fn n => TextIO.inputN(ins, n))()
+         Lex.makeLexer(fn n => TextIO.inputN(ins, n))()
       local
-	 val next: LexToken.t option ref = ref NONE
+         val next: LexToken.t option ref = ref NONE
       in
-	 fun token(): LexToken.t =
-	    case !next of
-	       NONE => lex()
-	     | SOME t => (next := NONE; t)
-	 fun save(t: LexToken.t): unit =
-	    next := SOME t
+         fun token(): LexToken.t =
+            case !next of
+               NONE => lex()
+             | SOME t => (next := NONE; t)
+         fun save(t: LexToken.t): unit =
+            next := SOME t
       end
       fun bad() = failwith "invalid input"
       fun many(done: LexToken.t -> bool): t list =
-	 let
-	    fun loop(ac: t list) =
-	       case one() of
-		  NONE => if done(token())
-			     then rev ac
-			  else bad()
-		| SOME t => loop(t :: ac)
-	 in loop []
-	 end
+         let
+            fun loop(ac: t list) =
+               case one() of
+                  NONE => if done(token())
+                             then rev ac
+                          else bad()
+                | SOME t => loop(t :: ac)
+         in loop []
+         end
       and one(): t option =
-	 let fun tok t = SOME t
-	 in case token() of
-	    LexToken.Binder x => tok(Binder x)
-	  | LexToken.Bool b => tok(Bool b)
-	  | LexToken.Identifier x => tok(translate x)
-	  | LexToken.Int i => tok(Int i)
-	  | LexToken.Lbrace =>
-	       SOME(Fun(many(fn LexToken.Rbrace => true | _ => false)))
-	  | LexToken.Lbracket =>
-	       SOME(Arr(many(fn LexToken.Rbracket => true | _ =>false)))
-	  | LexToken.Real r => tok(Float r)
-	  | LexToken.String s => tok(String s)
-	  | t => (save t; NONE)
-	 end
+         let fun tok t = SOME t
+         in case token() of
+            LexToken.Binder x => tok(Binder x)
+          | LexToken.Bool b => tok(Bool b)
+          | LexToken.Identifier x => tok(translate x)
+          | LexToken.Int i => tok(Int i)
+          | LexToken.Lbrace =>
+               SOME(Fun(many(fn LexToken.Rbrace => true | _ => false)))
+          | LexToken.Lbracket =>
+               SOME(Arr(many(fn LexToken.Rbracket => true | _ =>false)))
+          | LexToken.Real r => tok(Float r)
+          | LexToken.String s => tok(String s)
+          | t => (save t; NONE)
+         end
    in many(fn LexToken.Eof => true | _ => false)
    end
 
@@ -1070,9 +1070,9 @@
      val f = open_out_bin file
   in output_string (f, "P6\n# PL Club - translated to SML\n")
      ; output_string (f, concat[Int.toString width, " ",
-			       Int.toString height, "\n255\n"])
+                               Int.toString height, "\n255\n"])
      ; output_string (f, Byte.unpackString (Word8ArraySlice.slice
-					    (img, 0, NONE)))
+                                            (img, 0, NONE)))
      ; close_out f
   end
 
@@ -1096,15 +1096,15 @@
 signature RENDER =
    sig
       include CAML
-	 
+         
       val apply : (Program.v * Program.v list -> Program.v list) ref
       val inline_closure : (Program.v -> Program.v) ref
 
       val f :
-	 (*amb:*)(float * float * float) * (*lights:*) Program.v array *
-	 (*obj:*)Program.obj * (*depth:*)int * (*fov:*)float *
-	 (*wid:*)int * (*ht:*)int *
-	 (*file:*)string -> unit
+         (*amb:*)(float * float * float) * (*lights:*) Program.v array *
+         (*obj:*)Program.obj * (*depth:*)int * (*fov:*)float *
+         (*wid:*)int * (*ht:*)int *
+         (*file:*)string -> unit
    end
 structure Render: RENDER =
 struct
@@ -1165,65 +1165,65 @@
   case ob of
     OObj (OSphere, f) =>
        if isom
-	  then
-	     let
-		val center = vmul (m1, origin)
-		val radius = scale * scale
-	     in
-		SBound (SObj (SSphere (center, radius), f, m), center, radius)
-	     end
+          then
+             let
+                val center = vmul (m1, origin)
+                val radius = scale * scale
+             in
+                SBound (SObj (SSphere (center, radius), f, m), center, radius)
+             end
        else
-	  let
-	     val center = vmul (m1, origin)
-	     val radius = scale * scale
-	  in
-	     SBound (SObj (SEllips, f, m), center, radius)
-	  end
+          let
+             val center = vmul (m1, origin)
+             val radius = scale * scale
+          in
+             SBound (SObj (SEllips, f, m), center, radius)
+          end
   | OObj (OCube, f) =>
       let
-	 val (nx, nx') = plane_eq(m, (1.0, 0.0, 0.0, 0.0))
-	 val (ny, ny') = plane_eq(m, (0.0, 1.0, 0.0, 0.0))
-	 val (nz, nz') = plane_eq(m, (0.0, 0.0, 1.0, 0.0))
-	 val c = SObj (SCube (nx', ny', nz'), f, m)
+         val (nx, nx') = plane_eq(m, (1.0, 0.0, 0.0, 0.0))
+         val (ny, ny') = plane_eq(m, (0.0, 1.0, 0.0, 0.0))
+         val (nz, nz') = plane_eq(m, (0.0, 0.0, 1.0, 0.0))
+         val c = SObj (SCube (nx', ny', nz'), f, m)
       in
-	 SBound (c, vmul (m1, cube_center), scale * scale * 0.75)
+         SBound (c, vmul (m1, cube_center), scale * scale * 0.75)
       end
   | OObj (OCylind, f) =>
       let
-	 val (n, n') = plane_eq(m, (0.0, 1.0, 0.0, 0.0))
-	 val c = SObj (SCylind n', f, m)
+         val (n, n') = plane_eq(m, (0.0, 1.0, 0.0, 0.0))
+         val c = SObj (SCylind n', f, m)
       in
-	 SBound (c, vmul(m1, cylinder_center), scale * scale * 1.25)
+         SBound (c, vmul(m1, cylinder_center), scale * scale * 1.25)
       end
   | OObj (OCone, f) =>
       let
-	 val (n, n') = plane_eq(m, (0.0, 1.0, 0.0, 0.0))
-	 val c = SObj (SCone n', f, m)
+         val (n, n') = plane_eq(m, (0.0, 1.0, 0.0, 0.0))
+         val c = SObj (SCone n', f, m)
       in
-	 SBound (c, vmul(m1, cone_center), scale * scale)
+         SBound (c, vmul(m1, cone_center), scale * scale)
       end
   | OObj (OPlane, f) =>
       let
-	 val (n, n') = plane_eq(m, (0.0, 1.0, 0.0, 0.0))
+         val (n, n') = plane_eq(m, (0.0, 1.0, 0.0, 0.0))
       in
-	 SObj (SPlane (n, n'), f, m)
+         SObj (SPlane (n, n'), f, m)
       end
   | OTransform (o', m', m'1, scale', isom') =>
       intern_obj
         (Matrix.mul(m', m), Matrix.mul(m1, m'1),
-	 scale * scale', isom andalso isom', o')
+         scale * scale', isom andalso isom', o')
   | OUnion (o1, o2) =>
       SUnion (intern_obj(m, m1, scale, isom, o1),
-	      intern_obj(m, m1, scale, isom, o2))
+              intern_obj(m, m1, scale, isom, o2))
   | OInter (o1, o2) =>
       SInter (intern_obj(m, m1, scale, isom, o1),
-	      intern_obj(m, m1, scale, isom, o2))
+              intern_obj(m, m1, scale, isom, o2))
   | ODiff (ODiff (o1, o2), o3) =>
       (* Better to have unions that diffs for introducing bounds *)
       intern_obj(m, m1, scale, isom, (ODiff (o1, OUnion (o2, o3))))
   | ODiff (o1, o2) =>
       SDiff (intern_obj(m, m1, scale, isom, o1),
-	     intern_obj(m, m1, scale, isom, o2))
+             intern_obj(m, m1, scale, isom, o2))
 
 fun intern_lights a =
   Array.map
@@ -1265,25 +1265,25 @@
 fun add_bound (r0, (x, r, cost, sc)) =
   if r0 < 0.0
      then
-	 if r < 0.0 orelse cost <= 1
-	    then (cost, sc)
-	 else
-	    (1, SBound (sc, x, r))
+         if r < 0.0 orelse cost <= 1
+            then (cost, sc)
+         else
+            (1, SBound (sc, x, r))
   else
      (* Cost of bounds *)
      let
-	val c0 = r0 + r * float cost 
-	(* Cost ofout bounds *)
-	val c1 = r0 * float cost
+        val c0 = r0 + r * float cost 
+        (* Cost ofout bounds *)
+        val c1 = r0 * float cost
      in
-	if c0 < c1 then
-	   (1, SBound (sc, x, r))
-	else
-	   (cost, sc)
+        if c0 < c1 then
+           (1, SBound (sc, x, r))
+        else
+           (cost, sc)
      end
 
 fun union_bound (dsc1 as (x1, r1, cost1, sc1),
-		 dsc2 as (x2, r2, cost2, sc2)) =
+                 dsc2 as (x2, r2, cost2, sc2)) =
   if r1 < 0.0 then
     let
        val (cost2', sc2') = add_bound(r1, dsc2)
@@ -1303,43 +1303,43 @@
        val r2' = sqrt r2
     in
        if d + r2' <= r1' then
-	  let
-	     val (cost2', sc2') = add_bound (r1, dsc2)
-	  in
-	     (x1, r1, cost1 + cost2', SUnion (sc1, sc2'))
-	  end
+          let
+             val (cost2', sc2') = add_bound (r1, dsc2)
+          in
+             (x1, r1, cost1 + cost2', SUnion (sc1, sc2'))
+          end
        else if d + r1' <= r2' then
-	  let
-	     val (cost1', sc1') = add_bound (r2, dsc1)
-	  in
-	     (x2, r2, cost1' + cost2, SUnion (sc1', sc2))
-	  end
-	    else
-	       let
-		  val r' = (r1' + r2' + d) * 0.5
-		  val r = r' * r'
-		  val x = add_scaled (x1, (r' - r1') / d, sub(x2, x1))
-		  val (cost1', sc1') = add_bound (r, dsc1)
-		  val (cost2', sc2') = add_bound (r, dsc2)
-	       in
-		  (x, r, cost1' + cost2', SUnion (sc1', sc2'))
-	       end
+          let
+             val (cost1', sc1') = add_bound (r2, dsc1)
+          in
+             (x2, r2, cost1' + cost2, SUnion (sc1', sc2))
+          end
+            else
+               let
+                  val r' = (r1' + r2' + d) * 0.5
+                  val r = r' * r'
+                  val x = add_scaled (x1, (r' - r1') / d, sub(x2, x1))
+                  val (cost1', sc1') = add_bound (r, dsc1)
+                  val (cost2', sc2') = add_bound (r, dsc2)
+               in
+                  (x, r, cost1' + cost2', SUnion (sc1', sc2'))
+               end
     end
  
 fun union_radius (dsc1 as (x1, r1, cost1, sc1),
-		  dsc2 as (x2, r2, cost2, sc2)) =
+                  dsc2 as (x2, r2, cost2, sc2)) =
     let
        val d = sqrt (square (sub (x2, x1)))
        val r1' = sqrt r1
        val r2' = sqrt r2
     in
        if d + r2' <= r1' then r1 else
-	  if d + r1' <= r2' then r2 else
-	     let
-		val r' = (r1' + r2' + d) * 0.5
-	     in
-		r' * r'
-	     end
+          if d + r1' <= r2' then r2 else
+             let
+                val r' = (r1' + r2' + d) * 0.5
+             in
+                r' * r'
+             end
     end
 
 fun merge2 l =
@@ -1360,63 +1360,63 @@
   | [sc1, sc2] => [union_bound(sc1, sc2)]
   | _ =>
        let
-	  val c = Array.of_list l
-	  val n = Array.length c
-	  val m = Array2.array(n, n, infinity)
-	  val _ =
-	     for(0, n - 1, fn i =>
-		 for(0, n - 1, fn j =>
-		     if i <> j
-			then Array2.update(m, i, j,
-					   union_radius
-					   (Array.sub(c, i), Array.sub(c, j)))
-		     else ()))
-	  val remain = Array.init (n, fn i => i)
-	  val _ =
-	     forDown
-	     (n - 1, 1, fn k =>
-	      let
-		 val gain = ref infinity
-		 val i0 = ref 0
-		 val j0 = ref 0
-		 val _ =
-		    for(0, k, fn i =>
-			for(0, k, fn j =>
-			    let
-			       val i' = Array.sub(remain, i)
-			       val j' = Array.sub(remain, j)
-			    in
-			       if Array2.sub(m, i', j') < !gain
-				  then 
-				     (gain := Array2.sub(m, i', j')
-				      ; i0 := i
-				      ; j0 := j)
-			       else ()
-			    end))
-		 val i = Array.sub(remain, !i0)
-		 val j = Array.sub(remain, !j0)
-	      in
-		 Array.update(remain, !j0, Array.sub(remain, k));
-		 Array.update(c, i,
-			      union_bound (Array.sub(c, i), Array.sub(c, j)));
-		 for(0, k - 1, fn j0 =>
-		     let
-			val j = Array.sub(remain, j0)
-		     in
-			if i <> j
-			   then
-			      (
-			       Array2.update
-			       (m, i, j,
-				union_radius
-				(Array.sub(c, i), Array.sub(c, j)));
-			       Array2.update
-			       (m, j, i,
-				union_radius
-				(Array.sub(c, i), Array.sub(c, j))))
-			else ()
-		     end)
-	      end)
+          val c = Array.of_list l
+          val n = Array.length c
+          val m = Array2.array(n, n, infinity)
+          val _ =
+             for(0, n - 1, fn i =>
+                 for(0, n - 1, fn j =>
+                     if i <> j
+                        then Array2.update(m, i, j,
+                                           union_radius
+                                           (Array.sub(c, i), Array.sub(c, j)))
+                     else ()))
+          val remain = Array.init (n, fn i => i)
+          val _ =
+             forDown
+             (n - 1, 1, fn k =>
+              let
+                 val gain = ref infinity
+                 val i0 = ref 0
+                 val j0 = ref 0
+                 val _ =
+                    for(0, k, fn i =>
+                        for(0, k, fn j =>
+                            let
+                               val i' = Array.sub(remain, i)
+                               val j' = Array.sub(remain, j)
+                            in
+                               if Array2.sub(m, i', j') < !gain
+                                  then 
+                                     (gain := Array2.sub(m, i', j')
+                                      ; i0 := i
+                                      ; j0 := j)
+                               else ()
+                            end))
+                 val i = Array.sub(remain, !i0)
+                 val j = Array.sub(remain, !j0)
+              in
+                 Array.update(remain, !j0, Array.sub(remain, k));
+                 Array.update(c, i,
+                              union_bound (Array.sub(c, i), Array.sub(c, j)));
+                 for(0, k - 1, fn j0 =>
+                     let
+                        val j = Array.sub(remain, j0)
+                     in
+                        if i <> j
+                           then
+                              (
+                               Array2.update
+                               (m, i, j,
+                                union_radius
+                                (Array.sub(c, i), Array.sub(c, j)));
+                               Array2.update
+                               (m, j, i,
+                                union_radius
+                                (Array.sub(c, i), Array.sub(c, j))))
+                        else ()
+                     end)
+              end)
        in [Array.sub(c, Array.sub(remain, 0))]
        end
 
@@ -1426,40 +1426,40 @@
       (origin, ~1.0, object_cost kind, sc)
   | SUnion _ =>
        let
-	  val l = List.map optimize_rec (flatten_union sc)
-	  val unbounded = List.filter (fn (_, r, _, _) => r < 0.0) l
-	  val bounded = List.filter (fn (_, r, _, _) => r >= 0.0) l
+          val l = List.map optimize_rec (flatten_union sc)
+          val unbounded = List.filter (fn (_, r, _, _) => r < 0.0) l
+          val bounded = List.filter (fn (_, r, _, _) => r >= 0.0) l
        in
-	  merge_union (opt_union bounded @ unbounded)
+          merge_union (opt_union bounded @ unbounded)
        end
   | SInter (sc1, sc2) =>
        let
-	  val (x1, r1, cost1, sc1) = optimize_rec sc1
-	  val (x2, r2, cost2, sc2) = optimize_rec sc2
+          val (x1, r1, cost1, sc1) = optimize_rec sc1
+          val (x2, r2, cost2, sc2) = optimize_rec sc2
        in
-	  (* XXX We could have a tighter bound... *)
-	  if r2 < 0.0 then
-	     (x2, r2, cost2, SInter (sc1, sc2))
-	  else if r1 < 0.0 then
-	     (x1, r1, cost1, SInter (sc2, sc1))
-	       else if r1 < r2 then
-		  (x1, r1, cost1, SInter (sc1, sc2))
-		    else
-		       (x2, r2, cost1, SInter (sc2, sc1))
+          (* XXX We could have a tighter bound... *)
+          if r2 < 0.0 then
+             (x2, r2, cost2, SInter (sc1, sc2))
+          else if r1 < 0.0 then
+             (x1, r1, cost1, SInter (sc2, sc1))
+               else if r1 < r2 then
+                  (x1, r1, cost1, SInter (sc1, sc2))
+                    else
+                       (x2, r2, cost1, SInter (sc2, sc1))
        end
   | SDiff (sc1, sc2) =>
        let
-	  val (x1, r1, cost1, sc1) = optimize_rec sc1
-	  val dsc2 as (x2, r2, cost2, sc2) = optimize_rec sc2
-	  val (cost2', sc2') = add_bound (r1, dsc2)
+          val (x1, r1, cost1, sc1) = optimize_rec sc1
+          val dsc2 as (x2, r2, cost2, sc2) = optimize_rec sc2
+          val (cost2', sc2') = add_bound (r1, dsc2)
        in
-	  (x1, r1, cost1, SDiff (sc1, sc2'))
+          (x1, r1, cost1, SDiff (sc1, sc2'))
        end
   | SBound (sc1, x, r) =>
        let
-	  val (_, _, cost1, sc1) = optimize_rec sc1
+          val (_, _, cost1, sc1) = optimize_rec sc1
        in
-	  (x, r, cost1, sc1)
+          (x, r, cost1, sc1)
        end
 
 fun optimize sc = #2 (add_bound (~1.0, optimize_rec sc))
@@ -1476,18 +1476,18 @@
     if t1' < t2
        then i1 :: union(r1, l2)
     else if t2' < t1
-	    then i2 :: union(l1, r2)
-	 else
-	    if t1 < t2 then
-	       if t1' < t2' then
-		  union(r1, (t1, o1, t2', o2')::r2)
-	       else
-		  union((t1, o1, t1', o1')::r1, r2)
-	    else
-	       if t1' < t2' then
-		  union(r1, ((t2, o2, t2', o2')::r2))
-	       else
-		  union((t2, o2, t1', o1')::r1, r2)
+            then i2 :: union(l1, r2)
+         else
+            if t1 < t2 then
+               if t1' < t2' then
+                  union(r1, (t1, o1, t2', o2')::r2)
+               else
+                  union((t1, o1, t1', o1')::r1, r2)
+            else
+               if t1' < t2' then
+                  union(r1, ((t2, o2, t2', o2')::r2))
+               else
+                  union((t2, o2, t1', o1')::r1, r2)
 
 fun inter (l1, l2) : (float * scene * float * scene) list = (* ES: checked *)
   case (l1, l2) of
@@ -1498,18 +1498,18 @@
     if t1' <= t2
        then inter(r1, l2)
     else if t2' <= t1
-	    then inter(l1, r2)
-	 else
-	    if t1 < t2 then
-	       if t1' < t2' then
-		  (t2, o2, t1', o1') :: inter(r1, l2)
-	       else
-		  i2 :: inter(l1, r2)
-	    else
-	       if t1' < t2' then
-		  i1 :: inter(r1, l2)
-	       else
-		  (t1, o1, t2', o2') :: inter(l1, r2)
+            then inter(l1, r2)
+         else
+            if t1 < t2 then
+               if t1' < t2' then
+                  (t2, o2, t1', o1') :: inter(r1, l2)
+               else
+                  i2 :: inter(l1, r2)
+            else
+               if t1' < t2' then
+                  i1 :: inter(r1, l2)
+               else
+                  (t1, o1, t2', o2') :: inter(l1, r2)
 
 fun diff (l1, l2) : (float * scene * float * scene) list = (* ES: checked *)
   case (l1, l2) of
@@ -1520,18 +1520,18 @@
     if t1' <= t2
        then i1 :: diff(r1, l2)
     else if t2' <= t1
-	    then diff(l1, r2)
-	 else
-	    if t1 < t2 then
-	       if t1' < t2' then
-		  (t1, o1, t2, o2) :: diff(r1, l2)
-	       else
-		  (t1, o1, t2, o2) :: diff((t2', o2', t1', o1') :: r1, r2)
-	    else
-	       if t1' < t2' then
-		  diff(r1, l2)
-	       else
-		  diff((t2', o2', t1', o1') :: r1, r2)
+            then diff(l1, r2)
+         else
+            if t1 < t2 then
+               if t1' < t2' then
+                  (t1, o1, t2, o2) :: diff(r1, l2)
+               else
+                  (t1, o1, t2, o2) :: diff((t2', o2', t1', o1') :: r1, r2)
+            else
+               if t1' < t2' then
+                  diff(r1, l2)
+               else
+                  diff((t2', o2', t1', o1') :: r1, r2)
 
 (* intersection of ray and object *)
 fun plane (orig, dir, scene, eq) : (float * scene * float * scene) list =
@@ -1542,15 +1542,15 @@
       val t = ~ porig / pdir
    in
       if porig < 0.0 then
-	 if t > 0.0 then
-	    [(0.0, scene, t, scene)]
-	 else
-	    [(0.0, scene, infinity, scene)]
+         if t > 0.0 then
+            [(0.0, scene, t, scene)]
+         else
+            [(0.0, scene, infinity, scene)]
       else
-	 if t > 0.0 then
-	    [(t, scene, infinity, scene)]
-	 else
-	    []
+         if t > 0.0 then
+            [(t, scene, infinity, scene)]
+         else
+            []
    end
 
 fun band (obj, x, v, i) : (float * scene * float * scene) list = (* ES: checked *)
@@ -1560,15 +1560,15 @@
       val t2' = if t1 >= t2 then t1 else t2
    in
       if t2' < 0.0 then
-	 []
+         []
       else
-	 let val t1' = if t1 <= t2 then t1 else t2
-	 in
-	    if t1' < 0.0 then
-	       [(0.0, obj, t2', obj)]
-	    else
-	       [(t1', obj, t2', obj)]
-	 end
+         let val t1' = if t1 <= t2 then t1 else t2
+         in
+            if t1' < 0.0 then
+               [(0.0, obj, t2', obj)]
+            else
+               [(t1', obj, t2', obj)]
+         end
    end
 
 fun cube (orig, dir, scene, m): (float * scene * float * scene) list =
@@ -1578,11 +1578,11 @@
       val v = vmul (m, dir)
    in
       case band (scene, x, v, #1) of
-	 [] => []
+         [] => []
        | l0 =>
-	    case inter (l0, band (scene, x, v, #2)) of
-	       [] => []
-	     | l1 => inter (l1, band (scene, x, v, #3))
+            case inter (l0, band (scene, x, v, #2)) of
+               [] => []
+             | l1 => inter (l1, band (scene, x, v, #3))
    end
 
 fun sphere (orig, dir, scene, x, r2): (float * scene * float * scene) list =
@@ -1596,18 +1596,18 @@
       val d2 = v2 - p * p / dir2
       val delta = r2 - d2
    in  if delta <= 0.0
-	  then []
+          then []
        else
-	  let
-	     val sq = sqrt (delta / dir2)
-	     val t1 = p / dir2 - sq
-	     val t2 = p / dir2 + sq
-	  in
-	     if t2 < 0.0
-		then []
-	     else
-		[(max_float (0.0, t1), scene, t2, scene)]
-	  end
+          let
+             val sq = sqrt (delta / dir2)
+             val t1 = p / dir2 - sq
+             val t2 = p / dir2 + sq
+          in
+             if t2 < 0.0
+                then []
+             else
+                [(max_float (0.0, t1), scene, t2, scene)]
+          end
    end
 
 fun ellipsoid (orig, dir, scene, m): (float * scene * float * scene) list =
@@ -1621,17 +1621,17 @@
       val delta = xv * xv - v2 * (x2 - 2.0)
    in
       if delta <= 0.0 then
-	 []
+         []
       else
-	 let
-	    val sq = sqrt delta
-	    val t1 = (~ xv - sq) / v2
-	    val t2 = (~ xv + sq) / v2
-	 in    if t2 < 0.0 then
-	    []
-	       else
-		  [(max_float (0.0, t1), scene, t2, scene)]
-	 end
+         let
+            val sq = sqrt delta
+            val t1 = (~ xv - sq) / v2
+            val t2 = (~ xv + sq) / v2
+         in    if t2 < 0.0 then
+            []
+               else
+                  [(max_float (0.0, t1), scene, t2, scene)]
+         end
    end
 
 fun cylinder (orig, dir, scene, m): (float * scene * float * scene) list =
@@ -1644,19 +1644,19 @@
       val delta = xv * xv - v2 * x2
    in
       if delta <= 0.0 then
-	 []
+         []
       else
-	 let
-	    val sq = sqrt delta
-	    val t1 = (~ xv - sq) / v2
-	    val t2 = (~ xv + sq) / v2
-	 in    if t2 < 0.0 then
-	    []
-	       else
-		  inter
-		  ([(max_float (0.0, t1), scene, t2, scene)],
-		   band (scene, x, v, #2))
-	 end
+         let
+            val sq = sqrt delta
+            val t1 = (~ xv - sq) / v2
+            val t2 = (~ xv + sq) / v2
+         in    if t2 < 0.0 then
+            []
+               else
+                  inter
+                  ([(max_float (0.0, t1), scene, t2, scene)],
+                   band (scene, x, v, #2))
+         end
    end
 
 fun cone (orig, dir, scene, m): (float * scene * float * scene) list = 
@@ -1669,30 +1669,30 @@
       val delta = xv * xv - v2 * x2
    in
       if delta <= 0.0 then
-	 []
+         []
       else
-	 let
-	    val sq = sqrt delta
-	    val t1 = (~ xv - sq) / v2
-	    val t2 = (~ xv + sq) / v2
-	 in
-	    if t1 <= t2 then
-	       if t2 < 0.0 then
-		  []
-	       else
-		  inter
-		  ([(max_float(0.0, t1), scene, t2, scene)],
-		   band (scene, x, v, #2))
-	    else
-	       inter
-	       (if t1 <= 0.0 then
-		   [(0.0, scene, infinity, scene)]
-		else if t2 <= 0.0 then
-		   [(t1, scene, infinity, scene)]
-		     else
-			[(0.0, scene, t2, scene), (t1, scene, infinity, scene)],
-	        band (scene, x, v, #2))
-	 end
+         let
+            val sq = sqrt delta
+            val t1 = (~ xv - sq) / v2
+            val t2 = (~ xv + sq) / v2
+         in
+            if t1 <= t2 then
+               if t2 < 0.0 then
+                  []
+               else
+                  inter
+                  ([(max_float(0.0, t1), scene, t2, scene)],
+                   band (scene, x, v, #2))
+            else
+               inter
+               (if t1 <= 0.0 then
+                   [(0.0, scene, infinity, scene)]
+                else if t2 <= 0.0 then
+                   [(t1, scene, infinity, scene)]
+                     else
+                        [(0.0, scene, t2, scene), (t1, scene, infinity, scene)],
+                band (scene, x, v, #2))
+         end
    end
 
 (* XXX Maybe we should check whether the sphere is completely behind us ? *)
@@ -1725,30 +1725,30 @@
       plane (orig, dir, scene, eq)
   | SBound (sc, x, r2) =>
       if intersect (orig, dir, x, r2)
-	 then find_all (orig, dir, sc)
+         then find_all (orig, dir, sc)
       else []
   | SUnion (sc1, sc2) =>
       union (find_all (orig, dir, sc1), find_all (orig, dir, sc2))
   | SInter (sc1, sc2) =>
       let val l1 = find_all (orig, dir, sc1)
       in
-	 case l1 of
-	    [] => []
-	  | _ => inter(l1, find_all (orig, dir, sc2))
+         case l1 of
+            [] => []
+          | _ => inter(l1, find_all (orig, dir, sc2))
       end
   | SDiff (sc1, sc2) =>
       let val l1 = find_all(orig, dir, sc1)
       in
-	 case l1 of
-	    [] => []
-	  | _ => diff(l1, find_all(orig, dir, sc2))
+         case l1 of
+            [] => []
+          | _ => diff(l1, find_all(orig, dir, sc2))
       end
 
 fun filter_inter_list l =
   case l of
     (t, _, _, _)::r =>
        if t < epsilon
-	  then filter_inter_list r
+          then filter_inter_list r
        else l
   | _ => l
 
@@ -1756,7 +1756,7 @@
   let val l = filter_inter_list l0
   in
      case l of
-	[] => false
+        [] => false
       | (t, _, _, _)::r => (not bounded orelse  t <= 1.0)
   end
 
@@ -1764,21 +1764,21 @@
   case scene of
     SObj (kind, _, m) =>
        (case
-	   (case kind of
-	       SSphere (x, r2) => sphere (orig, dir, scene, x, r2)
-	     | SEllips         => ellipsoid (orig, dir, scene, m)
-	     | SCube _         => cube (orig, dir, scene, m)
-	     | SCylind _       => cylinder (orig, dir, scene, m)
-	     | SCone _         => cone (orig, dir, scene, m)
-	     | SPlane (eq, _)  => plane (orig, dir, scene, eq)) of
-	       [] => false
-	     | [(t, _, _, _)] =>
-		  if bounded andalso t > 1.0
-		     then false
-		  else if t < epsilon
-			  then false
-		       else true
-	     | _ => true)
+           (case kind of
+               SSphere (x, r2) => sphere (orig, dir, scene, x, r2)
+             | SEllips         => ellipsoid (orig, dir, scene, m)
+             | SCube _         => cube (orig, dir, scene, m)
+             | SCylind _       => cylinder (orig, dir, scene, m)
+             | SCone _         => cone (orig, dir, scene, m)
+             | SPlane (eq, _)  => plane (orig, dir, scene, eq)) of
+               [] => false
+             | [(t, _, _, _)] =>
+                  if bounded andalso t > 1.0
+                     then false
+                  else if t < epsilon
+                          then false
+                       else true
+             | _ => true)
   | SBound (sc, x, r2) =>
       intersect (orig, dir, x, r2)  andalso hit (orig, dir, sc, bounded)
   | SUnion (sc1, sc2) =>
@@ -1786,17 +1786,17 @@
   | SInter (sc1, sc2) =>
       let val l1 = find_all (orig, dir, sc1)
       in
-	 case l1 of
-	    [] => false
-	  | _ => hit_from_inter bounded (inter(l1, find_all (orig, dir, sc2)))
+         case l1 of
+            [] => false
+          | _ => hit_from_inter bounded (inter(l1, find_all (orig, dir, sc2)))
       end
   | SDiff (sc1, sc2) =>
       let
-	 val l1 = find_all(orig, dir, sc1)
+         val l1 = find_all(orig, dir, sc1)
       in
-	 case l1 of
-	    [] => false
-	  | _ => hit_from_inter bounded (diff(l1, find_all(orig, dir, sc2)))
+         case l1 of
+            [] => false
+          | _ => hit_from_inter bounded (diff(l1, find_all(orig, dir, sc2)))
       end
 
 fun visible (desc: desc, orig, dir, bounded) =
@@ -1822,22 +1822,22 @@
 fun texture_coord (kind, x: v) = (* section 3.6 *) (* ES: checked *)
    let
       fun ellipsOrSphere() =
-	 let
-	    val y = #2 x
-	    val v = (y + 1.0) * 0.5
-	 in
-	    if v < epsilon
-	       then [VFloat v, VFloat 0.0, VInt 0]
-	    else
-	       let
-		  val u = angle (#1 x, #3 x / sqrt (1.0 - y * y))
-	       in
-		  [VFloat v, VFloat u, VInt 0]
-	       end
-	 end
+         let
+            val y = #2 x
+            val v = (y + 1.0) * 0.5
+         in
+            if v < epsilon
+               then [VFloat v, VFloat 0.0, VInt 0]
+            else
+               let
+                  val u = angle (#1 x, #3 x / sqrt (1.0 - y * y))
+               in
+                  [VFloat v, VFloat u, VInt 0]
+               end
+         end
    in  (* [v; u; face] *)
       case kind of
-	 SEllips => ellipsOrSphere()
+         SEllips => ellipsOrSphere()
        | SSphere _ => ellipsOrSphere()
        | SCube _ =>
       if abs_float (#3 x) < epsilon then
@@ -1859,27 +1859,27 @@
         [VFloat (((#3 x) + 1.0) * 0.5), VFloat (((#1 x) + 1.0) * 0.5), VInt 1]
       else
         let
-	   val u = angle (#1 x, #3 x)
-	in
-	   [VFloat (#2 x), VFloat u, VInt 0]
-	end
+           val u = angle (#1 x, #3 x)
+        in
+           [VFloat (#2 x), VFloat u, VInt 0]
+        end
   | SCone _ =>
       let val v = (#2 x)
       in
-	 if abs_float v < epsilon then
-	    [VFloat v, VFloat 0.0, VInt 0]
-	 else
-	    if abs_float ((#2 x) - 1.0) < epsilon
-	       then
-		  [VFloat (((#3 x) + 1.0) * 0.5),
-		   VFloat (((#1 x) + 1.0) * 0.5),
-		   VInt 1]
-	    else
-	       let
-		  val u = angle (#1 x, (#3 x) / v)
-	       in
-		  [VFloat v, VFloat u, VInt 0]
-	       end
+         if abs_float v < epsilon then
+            [VFloat v, VFloat 0.0, VInt 0]
+         else
+            if abs_float ((#2 x) - 1.0) < epsilon
+               then
+                  [VFloat (((#3 x) + 1.0) * 0.5),
+                   VFloat (((#1 x) + 1.0) * 0.5),
+                   VInt 1]
+            else
+               let
+                  val u = angle (#1 x, (#3 x) / v)
+               in
+                  [VFloat v, VFloat u, VInt 0]
+               end
       end
   | SPlane _ =>
       [VFloat (#3 x), VFloat (#1 x), VInt 0]
@@ -1892,37 +1892,37 @@
   | SEllips =>
       let val (n0, n1, n2, _) = vmul (transpose m, x')
       in
-	 normalize(n0, n1, n2, 0.0)
+         normalize(n0, n1, n2, 0.0)
       end
   | SCylind n =>
       if abs_float (#2 x') < epsilon
-	 orelse abs_float (#2 x') - 1.0 < epsilon then
+         orelse abs_float (#2 x') - 1.0 < epsilon then
         n
       else
         (* XXX Could be optimized... *)
         let
-	   val (n0, n1, n2, _) = vmul (transpose m, (#1 x', 0.0, #3 x', 0.0))
-	in
-	   normalize(n0, n1, n2, 0.0)
-	end
+           val (n0, n1, n2, _) = vmul (transpose m, (#1 x', 0.0, #3 x', 0.0))
+        in
+           normalize(n0, n1, n2, 0.0)
+        end
   | SCone n =>
       if abs_float (#2 x') - 1.0 < epsilon
-	 then n
+         then n
       else
         let
-	   val (n0, n1, n2, _) =
-	      vmul (transpose m, (#1 x', ~(#2 x'), #3 x', 0.0))
-	in
-	   normalize(n0, n1, n2, 0.0)
-	end
+           val (n0, n1, n2, _) =
+              vmul (transpose m, (#1 x', ~(#2 x'), #3 x', 0.0))
+        in
+           normalize(n0, n1, n2, 0.0)
+        end
   | SCube (nx, ny, nz) =>
       if abs_float (#3 x') < epsilon
-	 orelse abs_float (#3 x') - 1.0 < epsilon
-	 then nz
+         orelse abs_float (#3 x') - 1.0 < epsilon
+         then nz
       else if abs_float (#1 x') < epsilon
- 	      orelse abs_float (#1 x') - 1.0 < epsilon
-	      then nx
-	   else ny
+              orelse abs_float (#1 x') - 1.0 < epsilon
+              then nx
+           else ny
   | SPlane (_, n) =>
       n
 
@@ -1939,7 +1939,7 @@
       val dir = normalize dir
    in
       case filter_inter_list (find_all(orig, dir, #scene desc)) of
-	 [] => black
+         [] => black
        | (t, ob, _, _) :: _ => trace_2(desc, depth, orig, dir, t, ob)
    end
 
@@ -1948,134 +1948,134 @@
       val x = add_scaled (orig, t, dir)
    in
       case obj of
-	 SObj (kind, f, m) =>
-	    let
-	       val x' = vmul (m, x)
-	       val (n, ks, kd, cr, cg, cb) =
-		  (case !f of
-		      Unopt g =>
-			 (* First we check whether the function would fail *)
-			 let
-			    val res = apply_surface_fun(g, texture_coord(kind, x'))
-			    fun stuck() = f := Opt (!inline_closure g)
-			 in
-			    (* Then, we check whether it is a constant function *)
-			    ((ignore (apply_surface_fun(g, 
-				      [VInt 0, VInt 0, VFloat 0.0]))
-			      ; f := Cst res)
-			     handle Stuck_computation _ => stuck()
-				  | Stuck_computation' => stuck())
-			    ; res
-			 end
-		    | Opt g =>
-			 apply_surface_fun (g, texture_coord (kind, x'))
-		    | Cst res =>
-			 res)
+         SObj (kind, f, m) =>
+            let
+               val x' = vmul (m, x)
+               val (n, ks, kd, cr, cg, cb) =
+                  (case !f of
+                      Unopt g =>
+                         (* First we check whether the function would fail *)
+                         let
+                            val res = apply_surface_fun(g, texture_coord(kind, x'))
+                            fun stuck() = f := Opt (!inline_closure g)
+                         in
+                            (* Then, we check whether it is a constant function *)
+                            ((ignore (apply_surface_fun(g, 
+                                      [VInt 0, VInt 0, VFloat 0.0]))
+                              ; f := Cst res)
+                             handle Stuck_computation _ => stuck()
+                                  | Stuck_computation' => stuck())
+                            ; res
+                         end
+                    | Opt g =>
+                         apply_surface_fun (g, texture_coord (kind, x'))
+                    | Cst res =>
+                         res)
                val nm = normal (kind, m, x', x)
-	       val p = prod (dir, nm)
-	       val nm = if p > 0.0 then neg nm else nm
-	       val p = ~(abs_float p)
-	       (* Ambient composant *)
-	       val (ar, ag, ab) = #amb desc
-	       val r = ref (kd * ar)
-	       val g = ref (kd * ag)
-	       val b = ref (kd * ab)
-		  (* Lights *)
-	       val lights = #lights desc
-	       val _ =
-		  for(0, Array.length lights - 1, fn i =>
-		      case (Array.sub(lights, i)) of
-			 Light (ldir, (lr, lg, lb)) =>
-			    let
-			       val p' = prod (ldir, nm)
-			    in
-			       if p' > 0.0 andalso visible (desc, x, ldir, false)
-				  then
-				     let
-					val int =
-					   if ks > epsilon then
-					      kd * p' +
-					      ks * prod (normalize
-							 (sub (ldir, dir)),
-							 nm) ** n
-					   else
-					      kd * p'
-				     in
-					r := !r + int * lr;
-					g := !g + int * lg;
-					b := !b + int * lb
-				     end
-			       else ()
-			    end
-		       | PtLight (src, (lr, lg, lb)) =>
-			    let
-			       val ldir = sub (src, x)
-			       val ldir' = normalize ldir
-			       val p' = prod (ldir', nm)
-			    in
-			       if p' > 0.0 andalso visible(desc, x, ldir, true)
-				  then
-				     let
-					val int =
-					   if ks > epsilon
-					      then
-						 kd * p' +
-						 ks * prod (normalize (sub (ldir', dir)),
-							    nm) ** n
-					   else
-					      kd * p'
-					val int = 100.0 * int / (99.0 + square ldir)
-				     in
-					r := !r + int * lr;
-					g := !g + int * lg;
-					b := !b + int * lb
-				     end
-			       else ()
-			    end
-		       | StLight (src, maindir, (lr, lg, lb), cutoff, exp) =>
-			    let
-			       val ldir = sub (src, x)
-			       val ldir' = normalize ldir
-			       val p' = prod (ldir', nm)
-			       val p'' = prod (ldir', maindir)
-			    in
-			       if p' > 0.0 andalso p'' > cutoff
-				  andalso visible(desc, x, ldir, true)
-				  then
-				     let
-					val int =
-					   if ks > epsilon
-					      then
-						 kd * p' +
-						 ks * prod (normalize (sub(ldir', dir)),
-							    nm) ** n
-					   else
-					      kd * p'
-					val int =
-					   100.0 * int / (99.0 + square ldir) *
-					   (p'' ** exp)
-				     in
-					r := !r + int * lr;
-					g := !g + int * lg;
-					b := !b + int * lb
-				     end
-			       else ()
-			    end)
-	       val _ =
-		  (* Reflexion *)
-		  if ks > epsilon  andalso depth > 0
-		     then
-			let
-			   val dir' = add_scaled (dir, ~2.0 * p, nm)
-			   val (r', g', b') = trace(desc, depth - 1, x, dir')
-			in
-			   r := !r + ks * r';
-			   g := !g + ks * g';
-			   b := !b + ks * b'
-			end
-		  else ()
-	    in (!r * cr, !g * cg, !b * cb)
-	    end
+               val p = prod (dir, nm)
+               val nm = if p > 0.0 then neg nm else nm
+               val p = ~(abs_float p)
+               (* Ambient composant *)
+               val (ar, ag, ab) = #amb desc
+               val r = ref (kd * ar)
+               val g = ref (kd * ag)
+               val b = ref (kd * ab)
+                  (* Lights *)
+               val lights = #lights desc
+               val _ =
+                  for(0, Array.length lights - 1, fn i =>
+                      case (Array.sub(lights, i)) of
+                         Light (ldir, (lr, lg, lb)) =>
+                            let
+                               val p' = prod (ldir, nm)
+                            in
+                               if p' > 0.0 andalso visible (desc, x, ldir, false)
+                                  then
+                                     let
+                                        val int =
+                                           if ks > epsilon then
+                                              kd * p' +
+                                              ks * prod (normalize
+                                                         (sub (ldir, dir)),
+                                                         nm) ** n
+                                           else
+                                              kd * p'
+                                     in
+                                        r := !r + int * lr;
+                                        g := !g + int * lg;
+                                        b := !b + int * lb
+                                     end
+                               else ()
+                            end
+                       | PtLight (src, (lr, lg, lb)) =>
+                            let
+                               val ldir = sub (src, x)
+                               val ldir' = normalize ldir
+                               val p' = prod (ldir', nm)
+                            in
+                               if p' > 0.0 andalso visible(desc, x, ldir, true)
+                                  then
+                                     let
+                                        val int =
+                                           if ks > epsilon
+                                              then
+                                                 kd * p' +
+                                                 ks * prod (normalize (sub (ldir', dir)),
+                                                            nm) ** n
+                                           else
+                                              kd * p'
+                                        val int = 100.0 * int / (99.0 + square ldir)
+                                     in
+                                        r := !r + int * lr;
+                                        g := !g + int * lg;
+                                        b := !b + int * lb
+                                     end
+                               else ()
+                            end
+                       | StLight (src, maindir, (lr, lg, lb), cutoff, exp) =>
+                            let
+                               val ldir = sub (src, x)
+                               val ldir' = normalize ldir
+                               val p' = prod (ldir', nm)
+                               val p'' = prod (ldir', maindir)
+                            in
+                               if p' > 0.0 andalso p'' > cutoff
+                                  andalso visible(desc, x, ldir, true)
+                                  then
+                                     let
+                                        val int =
+                                           if ks > epsilon
+                                              then
+                                                 kd * p' +
+                                                 ks * prod (normalize (sub(ldir', dir)),
+                                                            nm) ** n
+                                           else
+                                              kd * p'
+                                        val int =
+                                           100.0 * int / (99.0 + square ldir) *
+                                           (p'' ** exp)
+                                     in
+                                        r := !r + int * lr;
+                                        g := !g + int * lg;
+                                        b := !b + int * lb
+                                     end
+                               else ()
+                            end)
+               val _ =
+                  (* Reflexion *)
+                  if ks > epsilon  andalso depth > 0
+                     then
+                        let
+                           val dir' = add_scaled (dir, ~2.0 * p, nm)
+                           val (r', g', b') = trace(desc, depth - 1, x, dir')
+                        in
+                           r := !r + ks * r';
+                           g := !g + ks * g';
+                           b := !b + ks * b'
+                        end
+                  else ()
+            in (!r * cr, !g * cg, !b * cb)
+            end
        | _ => raise(Fail "assert false")
    end
 
@@ -2084,8 +2084,8 @@
       val i = truncate (c * 256.0)
    in
       if i < 0 then 0 else
-	 if i >= 256 then 255 else
-	    i
+         if i >= 256 then 255 else
+            i
    end
 
 fun f (amb, lights, obj, depth: int, fov, wid, ht, file) =
@@ -2101,17 +2101,17 @@
       val desc = { amb = amb, lights = intern_lights lights, scene = scene }
    in
       for(0, ht - 1, fn j =>
-	  for(0, wid - 1, fn i =>
-	      let
-		 val dir =
-		    (x0 + (float i + 0.5) * delta,
-		     y0 - (float j + 0.5) * delta,
-		     1.0,
-		     0.0)
-		 val (r, g, b) = trace(desc, depth, orig, dir)
-	      in
-		 Ppm.setp (img, i, j, conv r, conv g, conv b)
-	      end))
+          for(0, wid - 1, fn i =>
+              let
+                 val dir =
+                    (x0 + (float i + 0.5) * delta,
+                     y0 - (float j + 0.5) * delta,
+                     1.0,
+                     0.0)
+                 val (r, g, b) = trace(desc, depth, orig, dir)
+              in
+                 Ppm.setp (img, i, j, conv r, conv g, conv b)
+              end))
       ; Ppm.dump (file, img)
    end
 
@@ -2137,45 +2137,45 @@
   case env of
      [] => failwith ("Unbound variable \"" ^ s ^ "\"")
    | s' :: env' =>
-	if s = s'
-	   then 0
-	else 1 + (lookup(env', s))
+        if s = s'
+           then 0
+        else 1 + (lookup(env', s))
 
 (* XXX embed values *)
 fun conv (absenv, p) =
    case p of
       [] => []
     | Float x :: Float y :: Float z :: Prim Point :: r =>
-	 Val' (VPoint (VFloat x, VFloat y, VFloat z)) :: conv(absenv, r)
+         Val' (VPoint (VFloat x, VFloat y, VFloat z)) :: conv(absenv, r)
     | t :: r =>
-	 (case t of
-	     Fun p' => Fun' (conv(absenv, p')) :: conv(absenv, r)
-	   | Arr p' => Arr' (conv(absenv, p')) :: conv(absenv, r)
-	   | Ident s => Ident' (lookup(absenv, s)) :: conv(absenv, r)
-	   | Binder s => Binder' :: conv (s :: absenv, r)
-	   | Int i => Val' (VInt i) :: conv(absenv, r)
-	   | Float f => Val' (VFloat f) :: conv(absenv, r)
-	   | Bool b => Val' (VBool b) :: conv(absenv, r)
-	   | String s => Val' (VStr s) :: conv(absenv, r)
-	   | Prim k => Prim' k :: conv(absenv, r))
+         (case t of
+             Fun p' => Fun' (conv(absenv, p')) :: conv(absenv, r)
+           | Arr p' => Arr' (conv(absenv, p')) :: conv(absenv, r)
+           | Ident s => Ident' (lookup(absenv, s)) :: conv(absenv, r)
+           | Binder s => Binder' :: conv (s :: absenv, r)
+           | Int i => Val' (VInt i) :: conv(absenv, r)
+           | Float f => Val' (VFloat f) :: conv(absenv, r)
+           | Bool b => Val' (VBool b) :: conv(absenv, r)
+           | String s => Val' (VStr s) :: conv(absenv, r)
+           | Prim k => Prim' k :: conv(absenv, r))
 
 fun inline (offset, env, p) =
    case p of
       [] => []
     | t :: r =>
-	 let
-	    fun normal() = t :: inline(offset, env, r)
-	 in case t of
-	    Fun' p' => Fun' (inline(offset, env, p')) :: inline(offset, env, r)
-	  | Arr' p' => Arr' (inline(offset, env, p')) :: inline(offset, env, r)
-	  | Ident' i =>
-	       if i >= offset
-		  then Val' (List.nth (env, i - offset)) :: inline(offset, env, r)
-	       else normal()
-	  | Binder' => Binder' :: inline (1 + offset, env, r)
-	  | Prim' _ => normal()
-	  | Val' _ => normal()
-	 end
+         let
+            fun normal() = t :: inline(offset, env, r)
+         in case t of
+            Fun' p' => Fun' (inline(offset, env, p')) :: inline(offset, env, r)
+          | Arr' p' => Arr' (inline(offset, env, p')) :: inline(offset, env, r)
+          | Ident' i =>
+               if i >= offset
+                  then Val' (List.nth (env, i - offset)) :: inline(offset, env, r)
+               else normal()
+          | Binder' => Binder' :: inline (1 + offset, env, r)
+          | Prim' _ => normal()
+          | Val' _ => normal()
+         end
 
 val inline_closure =
    fn (VClos (env, p)) => VClos ([], inline(0, env, p))
@@ -2292,7 +2292,7 @@
                            Matrix.scale (x, y, z),
                            Matrix.unscale (x, y, z),
                            Real.max (abs_float x,
-				     (Real.max (abs_float y, abs_float z))),
+                                     (Real.max (abs_float y, abs_float z))),
                            false)) :: st'),
         r)
   | (VFloat s :: VObj ob :: st', Prim' Uscale :: r) =>
@@ -2364,7 +2364,7 @@
       val st = eval([], [], (conv([], p)))
    in
       case st of
-	 [] => ()
+         [] => ()
        | _ => failwith "error"
    end handle Stuck_computation (env, st, p) => failwith "stuck"
       
@@ -2372,17 +2372,17 @@
 structure Main =
    struct
       fun doit () =
-	 Eval.f (Program.read (TextIO.openIn "DATA/chess.gml"))
-	 handle _ => ()
+         Eval.f (Program.read (TextIO.openIn "DATA/chess.gml"))
+         handle _ => ()
 
       val doit =
-	 fn n =>
-	 let
-	    fun loop n =
-	       if n = 0
-		  then ()
-	       else (doit();
-		     loop(n-1))
-	 in loop n
-	 end
+         fn n =>
+         let
+            fun loop n =
+               if n = 0
+                  then ()
+               else (doit();
+                     loop(n-1))
+         in loop n
+         end
    end

Modified: mlton/branches/on-20050420-cmm-branch/benchmark/tests/simple.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/benchmark/tests/simple.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/benchmark/tests/simple.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -18,8 +18,8 @@
     type 'a array2 = {size : (int*int), value : 'a Array.array}
     exception Subscript = Subscript
     fun index ((i1:int,i2:int),(s1,s2)) =
-	if i1>=0 andalso i1<s1 andalso i2>=0 andalso i2<s2 then i1*s2+i2 
-	else raise Subscript
+        if i1>=0 andalso i1<s1 andalso i2>=0 andalso i2<s2 then i1*s2+i2 
+        else raise Subscript
     fun array(bnds as (i1,i2), v) = {size=bnds, value=Array.array(i1*i2, v)}
     fun op sub ({size,value}, indx) = Array.sub(value, index(indx,size))
     fun update ({size=size,value=A},i,v) = Array.update(A,index(i,size),v)
@@ -56,13 +56,13 @@
 
 fun for {from=start:int,step=delta:int, to=endd:int} body =
     if delta>0 andalso endd>=start then 
-	let fun f x = if x > endd then () else (body x; f(x+delta))
-	in f start
-	end
+        let fun f x = if x > endd then () else (body x; f(x+delta))
+        in f start
+        end
     else if endd<=start then
-	let fun f x = if x < endd then () else (body x; f(x+delta))
-	in f start
-	end
+        let fun f x = if x < endd then () else (body x; f(x+delta))
+        in f start
+        end
     else ()
 fun from(n,m) = if n>m then [] else n::from(n+1,m)
 fun flatten [] = []
@@ -77,9 +77,9 @@
 fun printarray2 (A as (M:real Array2.array2,((l1,u1),(l2,u2)))) =
     for {from=l1,step=1,to=u1} (fn i =>
         (print "[";
-	 for {from=l2,step=1,to=u2-1} (fn j => 
-	      print (Real.toString (sub2(A,(i,j))) ^ ", "));
-	 print (Real.toString (sub2(A,(i,u2))) ^ "]\n")))
+         for {from=l2,step=1,to=u2-1} (fn j => 
+              print (Real.toString (sub2(A,(i,j))) ^ ", "));
+         print (Real.toString (sub2(A,(i,u2))) ^ "]\n")))
 fun array1((l,u),v) = (Array.array(u-l+1,v),(l,u))
 fun sub1((A,(l:int,u:int)),i:int) = Array.sub(A,i-l) 
 fun update1((A,(l,_)),i,v) = Array.update(A,i-l,v)
@@ -90,15 +90,15 @@
  *)
 val grid_size = ((2,grid_max), (2,grid_max))
 
-fun north (k,l) = (k-1,l)	
-fun south (k,l) = (k+1,l)		
+fun north (k,l) = (k-1,l)       
+fun south (k,l) = (k+1,l)               
 
 fun east (k,l) = (k,l+1)
 fun west (k,l) = (k,l-1)
 
 val northeast = north o east
 val southeast = south o east
-val northwest = north o west		
+val northwest = north o west            
 val southwest = south o west
 
 fun farnorth x = (north o north ) x
@@ -109,7 +109,7 @@
 fun zone_A(k,l) = (k,l)
 fun zone_B(k,l) = (k+1,l)
 
-fun zone_C(k,l) = (k+1,l+1)		
+fun zone_C(k,l) = (k+1,l+1)             
 fun zone_D(k,l) = (k,l+1)
 
 val  zone_corner_northeast = north   
@@ -117,35 +117,35 @@
 fun  zone_corner_southeast zone = zone
 val  zone_corner_southwest = west
 
-val ((kmin,kmax),(lmin,lmax)) 	= grid_size
-val dimension_all_nodes   	= ((kmin-1,kmax+1),(lmin-1,lmax+1))
+val ((kmin,kmax),(lmin,lmax))   = grid_size
+val dimension_all_nodes         = ((kmin-1,kmax+1),(lmin-1,lmax+1))
 fun for_all_nodes f =
     for {from=kmin-1, step=1, to=kmax+1} (fn k =>
        for {from=lmin-1, step=1, to=lmax+1} (fn l => f k l))
 
-val dimension_interior_nodes  	= ((kmin,kmax),(lmin,lmax))
+val dimension_interior_nodes    = ((kmin,kmax),(lmin,lmax))
 fun for_interior_nodes f =
     for {from=kmin, step=1, to=kmax} (fn k =>
        for {from=lmin, step=1, to=lmax} (fn l => f k l))
 
-val dimension_all_zones  	= ((kmin,kmax+1),(lmin,lmax+1))
+val dimension_all_zones         = ((kmin,kmax+1),(lmin,lmax+1))
 fun for_all_zones f =
     for {from=kmin, step=1, to=kmax+1} (fn k =>
        for {from=lmin, step=1, to=lmax+1} (fn l => f (k,l)))
 
-val dimension_interior_zones  	= ((kmin+1,kmax),(lmin+1,lmax))
+val dimension_interior_zones    = ((kmin+1,kmax),(lmin+1,lmax))
 fun for_interior_zones f =
     for {from=kmin+1, step=1, to=kmax} (fn k =>
        for {from=lmin+1, step=1, to=lmax} (fn l => f (k,l)))
 
 fun map_interior_nodes f =
     flatten(map (fn k => (map (fn l => f (k,l)) 
-			      (from(lmin,lmax))))
-	        (from(kmin,kmax)))
+                              (from(lmin,lmax))))
+                (from(kmin,kmax)))
 fun map_interior_zones f =
     flatten(map (fn k => (map (fn l => f (k,l)) 
                                (from(lmin+1,lmax))))
-	         (from(kmin+1,kmax)))
+                 (from(kmin+1,kmax)))
 
 fun for_north_ward_interior_zones f =
     for {from=kmax, step= ~1, to=kmin+1} (fn k =>
@@ -194,44 +194,44 @@
 val  deltat_maximum = 0.01
 val  specific_heat = 0.1
 val  p_coeffs = let val M = array2(((0,2),(0,2)), 0.0)
-		in update2(M, (1,1), 0.06698); M
-		end
+                in update2(M, (1,1), 0.06698); M
+                end
 val e_coeffs = let val M = array2(((0,2),(0,2)), 0.0)
-	       in update2(M, (0,1), 0.1); M
-	       end
+               in update2(M, (0,1), 0.1); M
+               end
 val p_poly   = array2(((1,4),(1,5)),p_coeffs)
 
 val e_poly   = array2(((1,4),(1,5)), e_coeffs)
 
 val rho_table = let val V = array1((1,3), 0.0)
-		in  update1(V,2,1.0);
-		    update1(V,3,100.0);
-		    V
-		end
+                in  update1(V,2,1.0);
+                    update1(V,3,100.0);
+                    V
+                end
 val theta_table = let val V = array1((1,4), 0.0)
-		  in update1(V,2,3.0);
-		      update1(V,3,300.0);
-		      update1(V,4,3000.0);
-		      V
-		  end
+                  in update1(V,2,3.0);
+                      update1(V,3,300.0);
+                      update1(V,4,3000.0);
+                      V
+                  end
 
 val extract_energy_tables_from_constants  = (e_poly,2,rho_table,theta_table)
 val extract_pressure_tables_from_constants = (p_poly,2,rho_table,theta_table)
 
 val nbc = let val M = array2(dimension_all_zones, 1)
-	  in for {from=lmin+1,step=1,to=lmax} (fn j => update2(M,(kmax+1, j),2));
-	      update2(M,(kmin,lmin),4);
-	      update2(M,(kmin,lmax+1),4);
-	      update2(M,(kmax+1,lmin),4);
-	      update2(M,(kmax+1,lmax+1),4);
-	      M
-	  end
+          in for {from=lmin+1,step=1,to=lmax} (fn j => update2(M,(kmax+1, j),2));
+              update2(M,(kmin,lmin),4);
+              update2(M,(kmin,lmax+1),4);
+              update2(M,(kmax+1,lmin),4);
+              update2(M,(kmax+1,lmax+1),4);
+              M
+          end
 val pbb = let val A = array1((1,4), 0.0)
-	  in update1(A,2,6.0); A
-	  end
+          in update1(A,2,6.0); A
+          end
 val pb  = let val A = array1((1,4), 1.0)
-	  in update1(A,2,0.0); update1(A,3,0.0); A
-	  end
+          in update1(A,2,0.0); update1(A,3,0.0); A
+          end
 val qb  =     pb
 
 val all_zero_nodes = array2(dimension_all_nodes, 0.0)
@@ -245,48 +245,48 @@
 
 fun make_position_matrix interior_function =
     let val r' = array2(dimension_all_nodes, 0.0)
-	val z' = array2(dimension_all_nodes, 0.0)
-	fun boundary_position (rx,zx,ry,zy,ra,za) =
-	    let val (rax, zax)  =  (ra - rx, za - zx)
-		val (ryx, zyx)  =  (ry - rx, zy - zx)
-		val omega       =  2.0*(rax*ryx + zax*zyx)/(ryx*ryx + zyx*zyx)
-		val rb 	    	=  rx - rax + omega*ryx
-		val zb 	    	=  zx - zax + omega*zyx
-	    in (rb, zb)
-	    end
-	
-	fun reflect_node (x_dir, y_dir, a_dir, node) =
-	    let val rx = reflect x_dir  node  r'
-		val zx = reflect x_dir  node  z'
-		val ry = reflect y_dir  node  r'
-		val zy = reflect y_dir  node  z'
-		val ra = reflect a_dir  node  r'
-		val za = reflect a_dir  node  z'
-	    in boundary_position (rx, zx, ry, zy, ra, za)
-	    end
-	fun u2 (rv,zv) n = (update2(r',n,rv); update2(z',n,zv))
+        val z' = array2(dimension_all_nodes, 0.0)
+        fun boundary_position (rx,zx,ry,zy,ra,za) =
+            let val (rax, zax)  =  (ra - rx, za - zx)
+                val (ryx, zyx)  =  (ry - rx, zy - zx)
+                val omega       =  2.0*(rax*ryx + zax*zyx)/(ryx*ryx + zyx*zyx)
+                val rb          =  rx - rax + omega*ryx
+                val zb          =  zx - zax + omega*zyx
+            in (rb, zb)
+            end
+        
+        fun reflect_node (x_dir, y_dir, a_dir, node) =
+            let val rx = reflect x_dir  node  r'
+                val zx = reflect x_dir  node  z'
+                val ry = reflect y_dir  node  r'
+                val zy = reflect y_dir  node  z'
+                val ra = reflect a_dir  node  r'
+                val za = reflect a_dir  node  z'
+            in boundary_position (rx, zx, ry, zy, ra, za)
+            end
+        fun u2 (rv,zv) n = (update2(r',n,rv); update2(z',n,zv))
     in
-	for_interior_nodes (fn k => fn l => u2 (interior_function (k,l)) (k,l));
-	for_north_nodes(fn n => u2 (reflect_node(south,southeast,farsouth,n)) n);
-	for_south_nodes (fn n => u2(reflect_node(north,northeast,farnorth,n)) n);
-	for_east_nodes (fn n => u2(reflect_node(west, southwest, farwest, n)) n);
-	for_west_nodes (fn n => u2(reflect_node(east, southeast, fareast, n)) n);
-	u2 (reflect_node(south, southwest, farsouth, west_of_north_east))
-	   west_of_north_east;
+        for_interior_nodes (fn k => fn l => u2 (interior_function (k,l)) (k,l));
+        for_north_nodes(fn n => u2 (reflect_node(south,southeast,farsouth,n)) n);
+        for_south_nodes (fn n => u2(reflect_node(north,northeast,farnorth,n)) n);
+        for_east_nodes (fn n => u2(reflect_node(west, southwest, farwest, n)) n);
+        for_west_nodes (fn n => u2(reflect_node(east, southeast, fareast, n)) n);
+        u2 (reflect_node(south, southwest, farsouth, west_of_north_east))
+           west_of_north_east;
         u2 (reflect_node(north, northwest, farnorth, west_of_south_east)) 
-	   west_of_south_east;
-	u2 (reflect_node(west, northwest, farwest, north_of_south_east))
-	   north_of_south_east;
-	u2 (reflect_node(east, northeast, fareast, north_of_south_west))
-	   north_of_south_west;
-	u2 (reflect_node(southwest, west, farwest, north_east_corner))
-	   north_east_corner;
-	u2 (reflect_node(northwest, west, farwest, south_east_corner))
-	   south_east_corner;
-	u2 (reflect_node(southeast, south, farsouth, north_west_corner))
-	   north_west_corner;
-	u2 (reflect_node(northeast, east, fareast, south_west_corner))
-	   south_west_corner; 
+           west_of_south_east;
+        u2 (reflect_node(west, northwest, farwest, north_of_south_east))
+           north_of_south_east;
+        u2 (reflect_node(east, northeast, fareast, north_of_south_west))
+           north_of_south_west;
+        u2 (reflect_node(southwest, west, farwest, north_east_corner))
+           north_east_corner;
+        u2 (reflect_node(northwest, west, farwest, south_east_corner))
+           south_east_corner;
+        u2 (reflect_node(southeast, south, farsouth, north_west_corner))
+           north_west_corner;
+        u2 (reflect_node(northeast, east, fareast, south_west_corner))
+           south_west_corner; 
         (r',z')
     end
 
@@ -297,19 +297,19 @@
  *)
 fun zone_area_vol ((r,z), zone) =
     let val (r1,z1)=(sub2(r,zone_corner_southwest zone),
-		     sub2(z,zone_corner_southwest zone))
-	val (r2,z2)=(sub2(r,zone_corner_southeast zone),
-		     sub2(z,zone_corner_southeast zone))
-	val (r3,z3)=(sub2(r,zone_corner_northeast zone),
-		     sub2(z,zone_corner_northeast zone))
-	val (r4,z4)=(sub2(r,zone_corner_northwest zone),
-		     sub2(z,zone_corner_northwest zone))
-	val area1  =  (r2-r1)*(z3-z1) - (r3-r2)*(z3-z2)
-	val radius1  =  0.3333  *(r1+r2+r3)
-	val volume1  =  area1 * radius1
-	val area2  =  (r3-r1)*(z4-z3) - (r4-r3)*(z3-z1)
-	val radius2  =  0.3333 *(r1+r3+r4)
-	val volume2  =  area2 * radius2
+                     sub2(z,zone_corner_southwest zone))
+        val (r2,z2)=(sub2(r,zone_corner_southeast zone),
+                     sub2(z,zone_corner_southeast zone))
+        val (r3,z3)=(sub2(r,zone_corner_northeast zone),
+                     sub2(z,zone_corner_northeast zone))
+        val (r4,z4)=(sub2(r,zone_corner_northwest zone),
+                     sub2(z,zone_corner_northwest zone))
+        val area1  =  (r2-r1)*(z3-z1) - (r3-r2)*(z3-z2)
+        val radius1  =  0.3333  *(r1+r2+r3)
+        val volume1  =  area1 * radius1
+        val area2  =  (r3-r1)*(z4-z3) - (r4-r3)*(z3-z1)
+        val radius2  =  0.3333 *(r1+r3+r4)
+        val volume2  =  area2 * radius2
     in  (area1+area2, volume1+volume2)
     end
 
@@ -318,29 +318,29 @@
  *)
 fun make_velocity((u,w),(r,z),p,q,alpha,rho,delta_t) =
     let fun line_integral (p,z,node) : real =
- 	    sub2(p,zone_A node)*(sub2(z,west node) - sub2(z,north node)) +
-	    sub2(p,zone_B node)*(sub2(z,south node) - sub2(z,west node)) +
-	    sub2(p,zone_C node)*(sub2(z,east node) - sub2(z,south node)) +
-	    sub2(p,zone_D node)*(sub2(z,north node) - sub2(z,east node))
-	fun regional_mass node =
-	    0.5 * (sub2(rho, zone_A node)*sub2(alpha,zone_A node) +
-		   sub2(rho, zone_B node)*sub2(alpha,zone_B node) +
-		   sub2(rho, zone_C node)*sub2(alpha,zone_C node) +
-		   sub2(rho, zone_D node)*sub2(alpha,zone_D node))
-	fun velocity node =
-	    let val d = regional_mass node
-		val n1 = ~(line_integral(p,z,node)) - line_integral(q,z,node)
-		val n2 = line_integral(p,r,node) + line_integral(q,r,node)
-		val u_dot = n1/d
-		val w_dot = n2/d
-	    in (sub2(u,node)+delta_t*u_dot, sub2(w,node)+delta_t*w_dot)
-	    end
-	val U = array2(dimension_interior_nodes,0.0)
-	val W = array2(dimension_interior_nodes,0.0)
+            sub2(p,zone_A node)*(sub2(z,west node) - sub2(z,north node)) +
+            sub2(p,zone_B node)*(sub2(z,south node) - sub2(z,west node)) +
+            sub2(p,zone_C node)*(sub2(z,east node) - sub2(z,south node)) +
+            sub2(p,zone_D node)*(sub2(z,north node) - sub2(z,east node))
+        fun regional_mass node =
+            0.5 * (sub2(rho, zone_A node)*sub2(alpha,zone_A node) +
+                   sub2(rho, zone_B node)*sub2(alpha,zone_B node) +
+                   sub2(rho, zone_C node)*sub2(alpha,zone_C node) +
+                   sub2(rho, zone_D node)*sub2(alpha,zone_D node))
+        fun velocity node =
+            let val d = regional_mass node
+                val n1 = ~(line_integral(p,z,node)) - line_integral(q,z,node)
+                val n2 = line_integral(p,r,node) + line_integral(q,r,node)
+                val u_dot = n1/d
+                val w_dot = n2/d
+            in (sub2(u,node)+delta_t*u_dot, sub2(w,node)+delta_t*w_dot)
+            end
+        val U = array2(dimension_interior_nodes,0.0)
+        val W = array2(dimension_interior_nodes,0.0)
     in for_interior_nodes (fn k => fn l => let val (uv,wv) = velocity (k,l)
-					   in update2(U,(k,l),uv);
-					      update2(W,(k,l),wv)
-					   end);
+                                           in update2(U,(k,l),uv);
+                                              update2(W,(k,l),wv)
+                                           end);
        (U,W)
     end
 
@@ -349,36 +349,36 @@
 fun make_position ((r,z),delta_t,(u',w')) =
     let fun interior_position node = 
             (sub2(r,node) + delta_t*sub2(u',node), 
-	     sub2(z,node) + delta_t*sub2(w',node))
+             sub2(z,node) + delta_t*sub2(w',node))
     in make_position_matrix interior_position
     end
-	
+        
 
 fun make_area_density_volume(rho, s, x') =
     let val alpha' = array2(dimension_all_zones, 0.0)
-	val s' = array2(dimension_all_zones, 0.0)
-	val rho' = array2(dimension_all_zones, 0.0)
-	fun interior_area zone = 
- 	    let val (area, vol) = zone_area_vol (x', zone)
-		val density =  sub2(rho,zone)*sub2(s,zone) / vol
-	    in (area,vol,density)
-	    end
-	fun reflect_area_vol_density reflect_function = 
-	    (reflect_function alpha',reflect_function s',reflect_function rho')
-	fun update_asr (zone,(a,s,r)) = (update2(alpha',zone,a);
-					 update2(s',zone,s);
-					 update2(rho',zone,r))
-	fun r_area_vol_den (reflect_dir,zone) =
-	    let val asr =  reflect_area_vol_density (reflect_dir zone)
-	    in update_asr(zone, asr)
-	    end
+        val s' = array2(dimension_all_zones, 0.0)
+        val rho' = array2(dimension_all_zones, 0.0)
+        fun interior_area zone = 
+            let val (area, vol) = zone_area_vol (x', zone)
+                val density =  sub2(rho,zone)*sub2(s,zone) / vol
+            in (area,vol,density)
+            end
+        fun reflect_area_vol_density reflect_function = 
+            (reflect_function alpha',reflect_function s',reflect_function rho')
+        fun update_asr (zone,(a,s,r)) = (update2(alpha',zone,a);
+                                         update2(s',zone,s);
+                                         update2(rho',zone,r))
+        fun r_area_vol_den (reflect_dir,zone) =
+            let val asr =  reflect_area_vol_density (reflect_dir zone)
+            in update_asr(zone, asr)
+            end
     in
-	for_interior_zones (fn zone => update_asr(zone, interior_area zone));
+        for_interior_zones (fn zone => update_asr(zone, interior_area zone));
         for_south_zones (fn zone => r_area_vol_den(reflect_north, zone));
         for_east_zones (fn zone => r_area_vol_den(reflect_west, zone));
         for_west_zones (fn zone => r_area_vol_den(reflect_east, zone));
         for_north_zones (fn zone => r_area_vol_den(reflect_south, zone));
-	(alpha', rho', s')
+        (alpha', rho', s')
     end 
 
 
@@ -386,49 +386,49 @@
  * Artifical Viscosity (page 11)
  *)
 fun make_viscosity(p,(u',w'),(r',z'), alpha',rho') = 
-    let	fun interior_viscosity zone =
-	let fun upper_del f = 
-	    0.5 * ((sub2(f,zone_corner_southeast zone) - 
-		    sub2(f,zone_corner_northeast zone)) +
-		   (sub2(f,zone_corner_southwest zone) - 
-		    sub2(f,zone_corner_northwest zone)))
-	    fun lower_del f = 
-		0.5 * ((sub2(f,zone_corner_southeast zone) - 
-			sub2(f,zone_corner_southwest zone)) +
-		       (sub2(f,zone_corner_northeast zone) - 
-			sub2(f,zone_corner_northwest zone)))
-	    val xi 	= pow(upper_del   r',2) + pow(upper_del   z',2)
-	    val eta = pow(lower_del   r',2) + pow(lower_del   z',2)
-	    val upper_disc =  (upper_del r')*(lower_del w') - 
-		              (upper_del z')*(lower_del u')
-	    val lower_disc = (upper_del u')*(lower_del z') -
-		             (upper_del w') * (lower_del r')
-	    val upper_ubar = if upper_disc<0.0   then upper_disc/xi    else 0.0
-	    val lower_ubar = if lower_disc<0.0   then lower_disc/eta    else 0.0
-	    val gamma    = 1.6
-	    val speed_of_sound  =  gamma*sub2(p,zone)/sub2(rho',zone)
-	    val ubar  =  pow(upper_ubar,2) + pow(lower_ubar,2)
-	    val viscosity   =  
-		sub2(rho',zone)*(1.5*ubar + 0.5*speed_of_sound*(Math.sqrt ubar))
-	    val length   = Math.sqrt(pow(upper_del r',2) + pow(lower_del r',2))
-	    val courant_delta = 0.5* sub2(alpha',zone)/(speed_of_sound*length)
-	in (viscosity, courant_delta)
-	end
-	val q' = array2(dimension_all_zones, 0.0)
-	val d  = array2(dimension_all_zones, 0.0)
-	fun reflect_viscosity_cdelta (direction, zone) =
-	    sub2(q',direction zone) * sub1(qb, sub2(nbc,zone))
-	fun do_zones (dir,zone) = 
-	    update2(q',zone,reflect_viscosity_cdelta (dir,zone))
+    let fun interior_viscosity zone =
+        let fun upper_del f = 
+            0.5 * ((sub2(f,zone_corner_southeast zone) - 
+                    sub2(f,zone_corner_northeast zone)) +
+                   (sub2(f,zone_corner_southwest zone) - 
+                    sub2(f,zone_corner_northwest zone)))
+            fun lower_del f = 
+                0.5 * ((sub2(f,zone_corner_southeast zone) - 
+                        sub2(f,zone_corner_southwest zone)) +
+                       (sub2(f,zone_corner_northeast zone) - 
+                        sub2(f,zone_corner_northwest zone)))
+            val xi      = pow(upper_del   r',2) + pow(upper_del   z',2)
+            val eta = pow(lower_del   r',2) + pow(lower_del   z',2)
+            val upper_disc =  (upper_del r')*(lower_del w') - 
+                              (upper_del z')*(lower_del u')
+            val lower_disc = (upper_del u')*(lower_del z') -
+                             (upper_del w') * (lower_del r')
+            val upper_ubar = if upper_disc<0.0   then upper_disc/xi    else 0.0
+            val lower_ubar = if lower_disc<0.0   then lower_disc/eta    else 0.0
+            val gamma    = 1.6
+            val speed_of_sound  =  gamma*sub2(p,zone)/sub2(rho',zone)
+            val ubar  =  pow(upper_ubar,2) + pow(lower_ubar,2)
+            val viscosity   =  
+                sub2(rho',zone)*(1.5*ubar + 0.5*speed_of_sound*(Math.sqrt ubar))
+            val length   = Math.sqrt(pow(upper_del r',2) + pow(lower_del r',2))
+            val courant_delta = 0.5* sub2(alpha',zone)/(speed_of_sound*length)
+        in (viscosity, courant_delta)
+        end
+        val q' = array2(dimension_all_zones, 0.0)
+        val d  = array2(dimension_all_zones, 0.0)
+        fun reflect_viscosity_cdelta (direction, zone) =
+            sub2(q',direction zone) * sub1(qb, sub2(nbc,zone))
+        fun do_zones (dir,zone) = 
+            update2(q',zone,reflect_viscosity_cdelta (dir,zone))
     in
-	for_interior_zones (fn zone => let val (qv,dv) = interior_viscosity zone
-				       in update2(q',zone,qv);
-					   update2(d,zone,dv)
-				       end);
-	for_south_zones (fn zone => do_zones(north,zone));
-	for_east_zones (fn zone => do_zones(west,zone));
-	for_west_zones (fn zone => do_zones(east,zone));
-	for_north_zones (fn zone => do_zones(south,zone));
+        for_interior_zones (fn zone => let val (qv,dv) = interior_viscosity zone
+                                       in update2(q',zone,qv);
+                                           update2(d,zone,dv)
+                                       end);
+        for_south_zones (fn zone => do_zones(north,zone));
+        for_east_zones (fn zone => do_zones(west,zone));
+        for_west_zones (fn zone => do_zones(east,zone));
+        for_north_zones (fn zone => do_zones(south,zone));
         (q', d) 
     end
 
@@ -438,33 +438,33 @@
 
 fun polynomial(G,degree,rho_table,theta_table,rho_value,theta_value) =
     let fun table_search (table, value) =
-	    let val (low, high) = bounds1  table
-		fun search_down  i =  if  value > sub1(table,i-1)  then i
-				      else search_down (i-1)
-	    in  
-		if  value>sub1(table,high)  then  high+1
-		else if  value <= sub1(table,low)  then low
-		     else search_down   high
-	    end
-	val rho_index = table_search(rho_table, rho_value)
-	val theta_index = table_search(theta_table, theta_value)
-	val A =  sub2(G, (rho_index, theta_index))
-	fun from(n,m) = if n>m then [] else n::from(n+1,m)
-	fun f(i,j) = sub2(A,(i,j))*pow(rho_value,i)*pow(theta_value,j)
+            let val (low, high) = bounds1  table
+                fun search_down  i =  if  value > sub1(table,i-1)  then i
+                                      else search_down (i-1)
+            in  
+                if  value>sub1(table,high)  then  high+1
+                else if  value <= sub1(table,low)  then low
+                     else search_down   high
+            end
+        val rho_index = table_search(rho_table, rho_value)
+        val theta_index = table_search(theta_table, theta_value)
+        val A =  sub2(G, (rho_index, theta_index))
+        fun from(n,m) = if n>m then [] else n::from(n+1,m)
+        fun f(i,j) = sub2(A,(i,j))*pow(rho_value,i)*pow(theta_value,j)
     in
-	sum_list (map (fn i => sum_list(map (fn j => f (i,j)) (from(0,degree))))
-		      (from (0,degree)))
+        sum_list (map (fn i => sum_list(map (fn j => f (i,j)) (from(0,degree))))
+                      (from (0,degree)))
     end
 fun zonal_pressure  (rho_value:real,  theta_value:real)  =
     let val (G,degree,rho_table,theta_table) = 
-		            extract_pressure_tables_from_constants
+                            extract_pressure_tables_from_constants
     in polynomial(G, degree, rho_table, theta_table, rho_value, theta_value)
     end
 
 
 fun zonal_energy (rho_value, theta_value) = 
     let val (G, degree, rho_table, theta_table) = 
-	   		    extract_energy_tables_from_constants
+                            extract_energy_tables_from_constants
     in polynomial(G, degree, rho_table, theta_table, rho_value, theta_value)
     end
 val dx =   0.000001
@@ -472,14 +472,14 @@
 
 
 fun newton_raphson (f,x) =
-    let	fun iter (x,fx) =
-	    if fx > tiny then 
-		let val fxdx = f(x+dx)
-		    val denom = fxdx - fx
-		in if denom < tiny then iter(x,tiny)
-		   else iter(x-fx*dx/denom, fxdx)
-		end
-	    else x
+    let fun iter (x,fx) =
+            if fx > tiny then 
+                let val fxdx = f(x+dx)
+                    val denom = fxdx - fx
+                in if denom < tiny then iter(x,tiny)
+                   else iter(x-fx*dx/denom, fxdx)
+                end
+            else x
     in iter(x, f x)
     end
 
@@ -489,31 +489,31 @@
 
 fun make_temperature(p,epsilon,rho,theta,rho_prime,q_prime) =
     let fun interior_temperature   zone =
-	    let val qkl = sub2(q_prime,zone)
-		val rho_kl = sub2(rho,zone)
-		val rho_prime_kl = sub2(rho_prime,zone)
-		val tau_kl = (1.0 /rho_prime_kl - 1.0/rho_kl)
-		fun energy_equation epsilon_kl   theta_kl =
-		    epsilon_kl -  zonal_energy(rho_kl,theta_kl)
-		val epsilon_0 = sub2(epsilon,zone)
-		fun revised_energy pkl =  epsilon_0 - (pkl + qkl) * tau_kl
-		fun revised_temperature  epsilon_kl   theta_kl =
-		    newton_raphson ((energy_equation epsilon_kl), theta_kl)
-		fun revised_pressure  theta_kl = zonal_pressure(rho_kl, theta_kl)
-		val p_0 = sub2(p,zone)
-		val theta_0 = sub2(theta,zone)
-		val epsilon_1 =  revised_energy    p_0
-		val theta_1 =  revised_temperature    epsilon_1    theta_0
-		val p_1 =  revised_pressure    theta_1
-		val epsilon_2 =  revised_energy    p_1
-		val theta_2 =  revised_temperature    epsilon_2    theta_1
-	    in  theta_2
-	    end
-	val M = array2(dimension_all_zones, constant_heat_source)
+            let val qkl = sub2(q_prime,zone)
+                val rho_kl = sub2(rho,zone)
+                val rho_prime_kl = sub2(rho_prime,zone)
+                val tau_kl = (1.0 /rho_prime_kl - 1.0/rho_kl)
+                fun energy_equation epsilon_kl   theta_kl =
+                    epsilon_kl -  zonal_energy(rho_kl,theta_kl)
+                val epsilon_0 = sub2(epsilon,zone)
+                fun revised_energy pkl =  epsilon_0 - (pkl + qkl) * tau_kl
+                fun revised_temperature  epsilon_kl   theta_kl =
+                    newton_raphson ((energy_equation epsilon_kl), theta_kl)
+                fun revised_pressure  theta_kl = zonal_pressure(rho_kl, theta_kl)
+                val p_0 = sub2(p,zone)
+                val theta_0 = sub2(theta,zone)
+                val epsilon_1 =  revised_energy    p_0
+                val theta_1 =  revised_temperature    epsilon_1    theta_0
+                val p_1 =  revised_pressure    theta_1
+                val epsilon_2 =  revised_energy    p_1
+                val theta_2 =  revised_temperature    epsilon_2    theta_1
+            in  theta_2
+            end
+        val M = array2(dimension_all_zones, constant_heat_source)
     in
-	for_interior_zones
-	      (fn zone => update2(M, zone, interior_temperature zone));
-	M
+        for_interior_zones
+              (fn zone => update2(M, zone, interior_temperature zone));
+        M
     end
 
 
@@ -523,14 +523,14 @@
 
 fun make_cc(alpha_prime, theta_hat) =
     let fun interior_cc zone =  
-	    (0.0001 * pow(sub2(theta_hat,zone),2) *
-	    (Math.sqrt (abs(sub2(theta_hat,zone)))) / sub2(alpha_prime,zone))
-	    handle Sqrt => (print (Real.toString (sub2(theta_hat, zone)));
-			    print ("\nzone =(" ^ Int.toString (#1 zone) ^ "," ^ 
-				   Int.toString (#2 zone) ^ ")\n");
-			    printarray2 theta_hat;
-			    raise Sqrt)
-	val cc = array2(dimension_all_zones, 0.0)
+            (0.0001 * pow(sub2(theta_hat,zone),2) *
+            (Math.sqrt (abs(sub2(theta_hat,zone)))) / sub2(alpha_prime,zone))
+            handle Sqrt => (print (Real.toString (sub2(theta_hat, zone)));
+                            print ("\nzone =(" ^ Int.toString (#1 zone) ^ "," ^ 
+                                   Int.toString (#2 zone) ^ ")\n");
+                            printarray2 theta_hat;
+                            raise Sqrt)
+        val cc = array2(dimension_all_zones, 0.0)
     in
        for_interior_zones(fn zone => update2(cc,zone, interior_cc zone));
        for_south_zones(fn zone => update2(cc,zone, reflect_north zone cc));
@@ -542,99 +542,99 @@
 
 fun make_sigma(deltat, rho_prime, alpha_prime) =
     let fun interior_sigma   zone =  
-	    sub2(rho_prime,zone)*sub2(alpha_prime,zone)*specific_heat/ deltat
-	val M = array2(dimension_interior_zones, 0.0)
-	fun ohandle zone =
-	    (print (Real.toString (sub2(rho_prime, zone)) ^ " ");
-	     print (Real.toString (sub2(alpha_prime, zone)) ^ " ");
-	     print (Real.toString specific_heat ^ " ");
-	     print (Real.toString deltat ^ "\n");
-	     raise Overflow)
-		    
+            sub2(rho_prime,zone)*sub2(alpha_prime,zone)*specific_heat/ deltat
+        val M = array2(dimension_interior_zones, 0.0)
+        fun ohandle zone =
+            (print (Real.toString (sub2(rho_prime, zone)) ^ " ");
+             print (Real.toString (sub2(alpha_prime, zone)) ^ " ");
+             print (Real.toString specific_heat ^ " ");
+             print (Real.toString deltat ^ "\n");
+             raise Overflow)
+                    
     in  if !Control.trace 
         then print ("\t\tmake_sigma:deltat = " ^ Real.toString deltat ^ "\n")
-	else ();
-(***	for_interior_zones(fn zone => update2(M,zone, interior_sigma zone)) **)
-	for_interior_zones(fn zone => (update2(M,zone, interior_sigma zone)
-				       handle Overflow => ohandle zone));
-	M
+        else ();
+(***    for_interior_zones(fn zone => update2(M,zone, interior_sigma zone)) **)
+        for_interior_zones(fn zone => (update2(M,zone, interior_sigma zone)
+                                       handle Overflow => ohandle zone));
+        M
     end
 
 fun make_gamma  ((r_prime,z_prime), cc, succeeding, adjacent) =
     let fun interior_gamma   zone =
-	    let val r1 = sub2(r_prime, zone_corner_southeast   zone)
-		val z1 = sub2(z_prime, zone_corner_southeast   zone)
-		val r2 = sub2(r_prime, zone_corner_southeast (adjacent   zone))
-		val z2 = sub2(z_prime, zone_corner_southeast (adjacent   zone))
-		val cross_section = 0.5*(r1+r2)*(pow(r1 - r2,2)+pow(z1 - z2,2))
-		val (c1,c2) = (sub2(cc, zone), sub2(cc, succeeding zone))
-		val specific_conductivity =  2.0 * c1 * c2 / (c1 + c2)
-	    in cross_section  *  specific_conductivity
-	    end
-	val M = array2(dimension_all_zones, 0.0)
+            let val r1 = sub2(r_prime, zone_corner_southeast   zone)
+                val z1 = sub2(z_prime, zone_corner_southeast   zone)
+                val r2 = sub2(r_prime, zone_corner_southeast (adjacent   zone))
+                val z2 = sub2(z_prime, zone_corner_southeast (adjacent   zone))
+                val cross_section = 0.5*(r1+r2)*(pow(r1 - r2,2)+pow(z1 - z2,2))
+                val (c1,c2) = (sub2(cc, zone), sub2(cc, succeeding zone))
+                val specific_conductivity =  2.0 * c1 * c2 / (c1 + c2)
+            in cross_section  *  specific_conductivity
+            end
+        val M = array2(dimension_all_zones, 0.0)
     in
-	for_interior_zones(fn zone => update2(M,zone,interior_gamma zone));
- 	M
+        for_interior_zones(fn zone => update2(M,zone,interior_gamma zone));
+        M
     end
 
 fun make_ab(theta, sigma, Gamma, preceding) =
     let val a = array2(dimension_all_zones, 0.0)
-	val b = array2(dimension_all_zones, 0.0)
-	fun interior_ab   zone =
-  	    let val denom = sub2(sigma, zone) + sub2(Gamma, zone) +
-		            sub2(Gamma, preceding zone) * 
-			    (1.0 - sub2(a, preceding zone))
-		val nume1 = sub2(Gamma,zone)
-		val nume2 = sub2(Gamma,preceding zone)*sub2(b,preceding zone) +
-		            sub2(sigma,zone) * sub2(theta,zone)
-	    in  (nume1/denom,  nume2 / denom)  
-	    end
-	val f  = fn zone => update2(b,zone,sub2(theta,zone))
+        val b = array2(dimension_all_zones, 0.0)
+        fun interior_ab   zone =
+            let val denom = sub2(sigma, zone) + sub2(Gamma, zone) +
+                            sub2(Gamma, preceding zone) * 
+                            (1.0 - sub2(a, preceding zone))
+                val nume1 = sub2(Gamma,zone)
+                val nume2 = sub2(Gamma,preceding zone)*sub2(b,preceding zone) +
+                            sub2(sigma,zone) * sub2(theta,zone)
+            in  (nume1/denom,  nume2 / denom)  
+            end
+        val f  = fn zone => update2(b,zone,sub2(theta,zone))
     in
-	for_north_zones f;
-	for_south_zones f;
-	for_west_zones f;
-	for_east_zones f;
-	for_interior_zones(fn zone => let val ab = interior_ab zone
-				      in update2(a,zone,#1 ab);
-					  update2(b,zone,#2 ab)
-				      end);
-	(a,b)
+        for_north_zones f;
+        for_south_zones f;
+        for_west_zones f;
+        for_east_zones f;
+        for_interior_zones(fn zone => let val ab = interior_ab zone
+                                      in update2(a,zone,#1 ab);
+                                          update2(b,zone,#2 ab)
+                                      end);
+        (a,b)
     end
 
 fun make_theta (a, b, succeeding, int_zones) =
     let val theta = array2(dimension_all_zones, constant_heat_source)
-	fun interior_theta zone =  
-	    sub2(a,zone) * sub2(theta,succeeding zone)+ sub2(b,zone)
+        fun interior_theta zone =  
+            sub2(a,zone) * sub2(theta,succeeding zone)+ sub2(b,zone)
     in
-	int_zones (fn (k,l) => update2(theta, (k,l), interior_theta (k,l)));
-	theta
+        int_zones (fn (k,l) => update2(theta, (k,l), interior_theta (k,l)));
+        theta
     end
 
 fun compute_heat_conduction(theta_hat, deltat, x', alpha', rho') =
-    let val sigma 	= make_sigma(deltat,  rho',  alpha')
-	val _ = if !Control.trace then print "\tdone make_sigma\n" else ()
+    let val sigma       = make_sigma(deltat,  rho',  alpha')
+        val _ = if !Control.trace then print "\tdone make_sigma\n" else ()
 
-	val cc 		= make_cc(alpha',  theta_hat)
-	val _ = if !Control.trace then print "\tdone make_cc\n" else ()
+        val cc          = make_cc(alpha',  theta_hat)
+        val _ = if !Control.trace then print "\tdone make_cc\n" else ()
 
-	val Gamma_k  	= make_gamma(  x', cc, north, east)
-	val _ = if !Control.trace then print "\tdone make_gamma\n" else ()
+        val Gamma_k     = make_gamma(  x', cc, north, east)
+        val _ = if !Control.trace then print "\tdone make_gamma\n" else ()
 
-	val (a_k,b_k)  	= make_ab(theta_hat, sigma, Gamma_k, north)
-	val _ = if !Control.trace then print "\tdone make_ab\n" else ()
+        val (a_k,b_k)   = make_ab(theta_hat, sigma, Gamma_k, north)
+        val _ = if !Control.trace then print "\tdone make_ab\n" else ()
 
-	val theta_k  	= make_theta(a_k,b_k,south,for_north_ward_interior_zones)
-	val _ = if !Control.trace then print "\tdone make_theta\n" else ()
+        val theta_k     = make_theta(a_k,b_k,south,for_north_ward_interior_zones)
+        val _ = if !Control.trace then print "\tdone make_theta\n" else ()
 
-	val Gamma_l  	= make_gamma(x', cc, west, south)
-	val _ = if !Control.trace then print "\tdone make_gamma\n" else ()
+        val Gamma_l     = make_gamma(x', cc, west, south)
+        val _ = if !Control.trace then print "\tdone make_gamma\n" else ()
 
-	val (a_l,b_l) 	= make_ab(theta_k, sigma, Gamma_l, west)
-	val _ = if !Control.trace then print "\tdone make_ab\n" else ()
+        val (a_l,b_l)   = make_ab(theta_k, sigma, Gamma_l, west)
+        val _ = if !Control.trace then print "\tdone make_ab\n" else ()
 
-	val theta_l  	= make_theta(a_l,b_l,east,for_west_ward_interior_zones)
-	val _ = if !Control.trace then print "\tdone make_theta\n" else ()
+        val theta_l     = make_theta(a_l,b_l,east,for_west_ward_interior_zones)
+        val _ = if !Control.trace then print "\tdone make_theta\n" else ()
     in  (theta_l, Gamma_k, Gamma_l)
     end
 
@@ -644,35 +644,35 @@
  *)
 fun make_pressure(rho', theta')  =
     let val p = array2(dimension_all_zones, 0.0)
-	fun boundary_p(direction, zone) = 
-	    sub1(pbb, sub2(nbc, zone)) + 
-	    sub1(pb,sub2(nbc,zone)) * sub2(p, direction zone)
+        fun boundary_p(direction, zone) = 
+            sub1(pbb, sub2(nbc, zone)) + 
+            sub1(pb,sub2(nbc,zone)) * sub2(p, direction zone)
     in
-	for_interior_zones
-	    (fn zone => update2(p,zone,zonal_pressure(sub2(rho',zone),
-						      sub2(theta',zone))));
-	for_south_zones(fn zone => update2(p,zone,boundary_p(north,zone)));
-	for_east_zones(fn zone => update2(p,zone,boundary_p(west,zone)));
-	for_west_zones(fn zone => update2(p,zone,boundary_p(east,zone)));
-	for_north_zones(fn zone => update2(p,zone,boundary_p(south,zone)));
-	p
+        for_interior_zones
+            (fn zone => update2(p,zone,zonal_pressure(sub2(rho',zone),
+                                                      sub2(theta',zone))));
+        for_south_zones(fn zone => update2(p,zone,boundary_p(north,zone)));
+        for_east_zones(fn zone => update2(p,zone,boundary_p(west,zone)));
+        for_west_zones(fn zone => update2(p,zone,boundary_p(east,zone)));
+        for_north_zones(fn zone => update2(p,zone,boundary_p(south,zone)));
+        p
     end
 
 fun make_energy(rho', theta')  =
     let val epsilon' = array2(dimension_all_zones, 0.0)
     in
-	for_interior_zones
-	  (fn zone => update2(epsilon', zone, zonal_energy(sub2(rho',zone),
-							   sub2(theta',zone))));
+        for_interior_zones
+          (fn zone => update2(epsilon', zone, zonal_energy(sub2(rho',zone),
+                                                           sub2(theta',zone))));
         for_south_zones
-	  (fn zone => update2(epsilon',zone, reflect_north zone epsilon'));
+          (fn zone => update2(epsilon',zone, reflect_north zone epsilon'));
         for_west_zones
-	  (fn zone => update2(epsilon',zone, reflect_east zone epsilon'));
+          (fn zone => update2(epsilon',zone, reflect_east zone epsilon'));
         for_east_zones
-	  (fn zone => update2(epsilon',zone, reflect_west  zone epsilon'));
-	for_north_zones
-	  (fn zone => update2(epsilon',zone, reflect_south zone epsilon'));
-	epsilon'
+          (fn zone => update2(epsilon',zone, reflect_west  zone epsilon'));
+        for_north_zones
+          (fn zone => update2(epsilon',zone, reflect_south zone epsilon'));
+        epsilon'
     end
 
 
@@ -681,41 +681,41 @@
  *)
 
 fun compute_energy_error  ((u',w'),(r',z'),p',q',epsilon',theta',rho',alpha',
-			   Gamma_k,Gamma_l,deltat)  =
+                           Gamma_k,Gamma_l,deltat)  =
     let fun mass zone =  sub2(rho',zone) * sub2(alpha',zone):real
-	val internal_energy = 
-	    sum_list (map_interior_zones (fn z => sub2(epsilon',z)*(mass z)))
-	fun kinetic   node =
-	    let val average_mass =  0.25*((mass (zone_A  node)) + 
-					  (mass (zone_B  node)) +
-					  (mass (zone_C  node)) + 
-					  (mass (zone_D  node)))
-		val v_square = pow(sub2(u',node),2) + pow(sub2(w',node),2)
-	    in 0.5 * average_mass * v_square
-	    end
-	val kinetic_energy =  sum_list (map_interior_nodes kinetic)
+        val internal_energy = 
+            sum_list (map_interior_zones (fn z => sub2(epsilon',z)*(mass z)))
+        fun kinetic   node =
+            let val average_mass =  0.25*((mass (zone_A  node)) + 
+                                          (mass (zone_B  node)) +
+                                          (mass (zone_C  node)) + 
+                                          (mass (zone_D  node)))
+                val v_square = pow(sub2(u',node),2) + pow(sub2(w',node),2)
+            in 0.5 * average_mass * v_square
+            end
+        val kinetic_energy =  sum_list (map_interior_nodes kinetic)
       fun work_done (node1, node2)  =
-	  let val (r1, r2) = (sub2(r',node1), sub2(r',node2))
-	      val (z1, z2) = (sub2(z',node1), sub2(z',node2))
-	      val (u1, u2) = (sub2(p',node1), sub2(p',node2))
-	      val (w1, w2) = (sub2(z',node1), sub2(z',node2))
-	      val (p1, p2) = (sub2(p',node1), sub2(p',node2))
-	      val (q1, q2) = (sub2(q',node1), sub2(q',node2))
-	      val force =  0.5*(p1+p2+q1+q2)
-	      val radius = 0.5* (r1+r2)
-	      val area =   0.5* ((r1-r2)*(u1-u2) - (z1-z2)*(w1-w2))
-	  in  force * radius * area * deltat
-	  end
+          let val (r1, r2) = (sub2(r',node1), sub2(r',node2))
+              val (z1, z2) = (sub2(z',node1), sub2(z',node2))
+              val (u1, u2) = (sub2(p',node1), sub2(p',node2))
+              val (w1, w2) = (sub2(z',node1), sub2(z',node2))
+              val (p1, p2) = (sub2(p',node1), sub2(p',node2))
+              val (q1, q2) = (sub2(q',node1), sub2(q',node2))
+              val force =  0.5*(p1+p2+q1+q2)
+              val radius = 0.5* (r1+r2)
+              val area =   0.5* ((r1-r2)*(u1-u2) - (z1-z2)*(w1-w2))
+          in  force * radius * area * deltat
+          end
 
       fun from(n,m) = if n > m then [] else n::from(n+1,m)
       val north_line = 
-	  map (fn l => (west(kmin,l),(kmin,l))) (from(lmin+1,lmax))
+          map (fn l => (west(kmin,l),(kmin,l))) (from(lmin+1,lmax))
       val south_line =
-	  map (fn l => (west(kmax,l),(kmax,l))) (from(lmin+1,lmax))
+          map (fn l => (west(kmax,l),(kmax,l))) (from(lmin+1,lmax))
       val east_line  =
-	  map (fn k => (south(k,lmax),(k,lmax))) (from(kmin+1,kmax))
+          map (fn k => (south(k,lmax),(k,lmax))) (from(kmin+1,kmax))
       val west_line  =
-	  map (fn k => (south(k,lmin+1),(k,lmin+1))) (from(kmin+1,kmax))
+          map (fn k => (south(k,lmin+1),(k,lmin+1))) (from(kmin+1,kmax))
 
       val w1 = sum_list (map work_done north_line)
       val w2  = sum_list (map work_done south_line)
@@ -724,24 +724,24 @@
       val boundary_work =  w1 + w2 + w3 + w4
 
       fun heat_flow  Gamma (zone1,zone2)  =
-	deltat * sub2(Gamma, zone1) * (sub2(theta',zone1) - sub2(theta',zone2))
+        deltat * sub2(Gamma, zone1) * (sub2(theta',zone1) - sub2(theta',zone2))
 
       val north_flow =
-	  let val k = kmin+1 
-	  in map (fn l => (north(k,l),(k,l))) (from(lmin+1,lmax))
-	  end
+          let val k = kmin+1 
+          in map (fn l => (north(k,l),(k,l))) (from(lmin+1,lmax))
+          end
       val south_flow =
-	  let val k = kmax
-	  in map (fn l => (south(k,l),(k,l))) (from(lmin+2,lmax-1))
-	  end
+          let val k = kmax
+          in map (fn l => (south(k,l),(k,l))) (from(lmin+2,lmax-1))
+          end
       val east_flow  =
-	  let val l = lmax
-	  in map (fn k => (east(k,l),(k,l))) (from(kmin+2,kmax))
-	  end
+          let val l = lmax
+          in map (fn k => (east(k,l),(k,l))) (from(kmin+2,kmax))
+          end
       val west_flow  =
-	  let val l = lmin+1
-	  in map (fn k => (west(k,l),(k,l))) (from(kmin+2,kmax))
-	  end
+          let val l = lmin+1
+          in map (fn k => (west(k,l),(k,l))) (from(kmin+2,kmax))
+          end
 
      val h1  = sum_list    (map (heat_flow  Gamma_k)   north_flow)
      val h2  = sum_list    (map (heat_flow  Gamma_k)   south_flow)
@@ -749,17 +749,17 @@
      val h4  = sum_list    (map (heat_flow  Gamma_l)   west_flow)
      val boundary_heat =  h1 + h2 + h3 + h4
     in 
-	internal_energy  +  kinetic_energy  -  boundary_heat  -  boundary_work
+        internal_energy  +  kinetic_energy  -  boundary_heat  -  boundary_work
     end
 
 fun compute_time_step(d, theta_hat,  theta') =
     let val deltat_courant =
-	    min_list (map_interior_zones (fn zone => sub2(d,zone)))
-	val deltat_conduct =
-	    max_list (map_interior_zones 
-		        (fn z => (abs(sub2(theta_hat,z) - sub2(theta', z))/
-				  sub2(theta_hat,z))))
-	val deltat_minimum = min (deltat_courant, deltat_conduct)
+            min_list (map_interior_zones (fn zone => sub2(d,zone)))
+        val deltat_conduct =
+            max_list (map_interior_zones 
+                        (fn z => (abs(sub2(theta_hat,z) - sub2(theta', z))/
+                                  sub2(theta_hat,z))))
+        val deltat_minimum = min (deltat_courant, deltat_conduct)
     in min   (deltat_maximum,  deltat_minimum)
     end
 
@@ -767,106 +767,106 @@
 fun compute_initial_state () = 
     let 
         val v  = (all_zero_nodes, all_zero_nodes)
-	val x  = let fun interior_position  (k,l)  =
-	                 let val pi = 3.1415926535898
-			     val rp = real (lmax - lmin)
-			     val z1 = real(10 + k - kmin)
-			     val zz = (~0.5 + real(l - lmin) / rp) * pi
-			 in (z1 * Math.cos zz,  z1 * Math.sin zz)
-			 end
-		 in  make_position_matrix interior_position
-		 end
-	val (alpha,s) = 
-	    let val (alpha_prime,s_prime) = 
-		    let val A = array2(dimension_all_zones, 0.0)
-			val S = array2(dimension_all_zones, 0.0)
-			fun reflect_area_vol f = (f A, f S)
+        val x  = let fun interior_position  (k,l)  =
+                         let val pi = 3.1415926535898
+                             val rp = real (lmax - lmin)
+                             val z1 = real(10 + k - kmin)
+                             val zz = (~0.5 + real(l - lmin) / rp) * pi
+                         in (z1 * Math.cos zz,  z1 * Math.sin zz)
+                         end
+                 in  make_position_matrix interior_position
+                 end
+        val (alpha,s) = 
+            let val (alpha_prime,s_prime) = 
+                    let val A = array2(dimension_all_zones, 0.0)
+                        val S = array2(dimension_all_zones, 0.0)
+                        fun reflect_area_vol f = (f A, f S)
 
-			fun u2 (f,z) = 
-			    let val (a,s) = reflect_area_vol(f z)
-			    in update2(A,z,a);
-				update2(S,z,s)
-			    end
-		    in
-			for_interior_zones 
-			   (fn z => let val (a,s) = zone_area_vol(x, z)
-				    in update2(A,z,a);
-					update2(S,z,s)
-				    end);
-			for_south_zones (fn z => u2 (reflect_north, z));
-			for_east_zones (fn z => u2 (reflect_west, z));
-			for_west_zones (fn z => u2 (reflect_east, z));
-			for_north_zones (fn z => u2 (reflect_south, z));
-			(A,S)
-		    end
-	    in  (alpha_prime,s_prime)
-	    end
-	val rho  = let val R = array2(dimension_all_zones, 0.0)
-		   in for_all_zones (fn z => update2(R,z,1.4)); R
-		   end
-	val theta = 
-	    let val T = array2(dimension_all_zones, constant_heat_source)
-	    in for_interior_zones(fn z => update2(T,z,0.0001));
-		T
-	    end
-	val p       = make_pressure(rho, theta)
-	val q       = all_zero_zones
-	val epsilon = make_energy(rho, theta)
-	val  deltat  = 0.01
-	val  c       = 0.0
+                        fun u2 (f,z) = 
+                            let val (a,s) = reflect_area_vol(f z)
+                            in update2(A,z,a);
+                                update2(S,z,s)
+                            end
+                    in
+                        for_interior_zones 
+                           (fn z => let val (a,s) = zone_area_vol(x, z)
+                                    in update2(A,z,a);
+                                        update2(S,z,s)
+                                    end);
+                        for_south_zones (fn z => u2 (reflect_north, z));
+                        for_east_zones (fn z => u2 (reflect_west, z));
+                        for_west_zones (fn z => u2 (reflect_east, z));
+                        for_north_zones (fn z => u2 (reflect_south, z));
+                        (A,S)
+                    end
+            in  (alpha_prime,s_prime)
+            end
+        val rho  = let val R = array2(dimension_all_zones, 0.0)
+                   in for_all_zones (fn z => update2(R,z,1.4)); R
+                   end
+        val theta = 
+            let val T = array2(dimension_all_zones, constant_heat_source)
+            in for_interior_zones(fn z => update2(T,z,0.0001));
+                T
+            end
+        val p       = make_pressure(rho, theta)
+        val q       = all_zero_zones
+        val epsilon = make_energy(rho, theta)
+        val  deltat  = 0.01
+        val  c       = 0.0
     in
-	(v,x,alpha,s,rho,p,q,epsilon,theta,deltat,c)
+        (v,x,alpha,s,rho,p,q,epsilon,theta,deltat,c)
     end
 
 
 fun compute_next_state state =
     let
-	val (v,x,alpha,s,rho,p,q,epsilon,theta,deltat,c) = state
-	val v'  = make_velocity (v, x, p, q, alpha, rho, deltat)
-	val _ = if !Control.trace then print "done make_velocity\n" else ()
+        val (v,x,alpha,s,rho,p,q,epsilon,theta,deltat,c) = state
+        val v'  = make_velocity (v, x, p, q, alpha, rho, deltat)
+        val _ = if !Control.trace then print "done make_velocity\n" else ()
 
-	val x'  = make_position(x,deltat,v') 
-	          handle Overflow =>(printarray2 (#1 v'); 
-				     printarray2 (#2 v');
-				     raise Overflow)
-	val _ = if !Control.trace then print "done make_position\n" else ()
+        val x'  = make_position(x,deltat,v') 
+                  handle Overflow =>(printarray2 (#1 v'); 
+                                     printarray2 (#2 v');
+                                     raise Overflow)
+        val _ = if !Control.trace then print "done make_position\n" else ()
 
-	val (alpha',rho',s')  = make_area_density_volume (rho,  s , x')
-	val _ = if !Control.trace then print "done make_area_density_volume\n"
-		else ()
+        val (alpha',rho',s')  = make_area_density_volume (rho,  s , x')
+        val _ = if !Control.trace then print "done make_area_density_volume\n"
+                else ()
 
-	val (q',d)  = make_viscosity (p,  v',  x',  alpha',  rho')
-	val _ = if !Control.trace then print "done make_viscosity\n" else ()
+        val (q',d)  = make_viscosity (p,  v',  x',  alpha',  rho')
+        val _ = if !Control.trace then print "done make_viscosity\n" else ()
 
-	val theta_hat  = make_temperature (p, epsilon, rho, theta, rho', q')
-	val _ = if !Control.trace then print "done make_temperature\n" else ()
+        val theta_hat  = make_temperature (p, epsilon, rho, theta, rho', q')
+        val _ = if !Control.trace then print "done make_temperature\n" else ()
 
-	val (theta',Gamma_k,Gamma_l) =
-	    compute_heat_conduction (theta_hat, deltat, x', alpha', rho')
-	val _ = if !Control.trace then print "done compute_heat_conduction\n"
-		else ()
+        val (theta',Gamma_k,Gamma_l) =
+            compute_heat_conduction (theta_hat, deltat, x', alpha', rho')
+        val _ = if !Control.trace then print "done compute_heat_conduction\n"
+                else ()
 
-	val p'  = make_pressure(rho', theta')
-	val _ = if !Control.trace then print "done make_pressure\n" else ()
+        val p'  = make_pressure(rho', theta')
+        val _ = if !Control.trace then print "done make_pressure\n" else ()
 
-	val epsilon'  = make_energy (rho', theta')
-	val _ = if !Control.trace then print "done make_energy\n" else ()
+        val epsilon'  = make_energy (rho', theta')
+        val _ = if !Control.trace then print "done make_energy\n" else ()
 
-	val c'  = compute_energy_error (v', x', p', q', epsilon', theta', rho', 
-					alpha', Gamma_k, Gamma_l,  deltat)
-	val _ = if !Control.trace then print "done compute_energy_error\n" 
-		else ()
+        val c'  = compute_energy_error (v', x', p', q', epsilon', theta', rho', 
+                                        alpha', Gamma_k, Gamma_l,  deltat)
+        val _ = if !Control.trace then print "done compute_energy_error\n" 
+                else ()
 
-	val deltat'  = compute_time_step (d, theta_hat, theta')
-	val _ = if !Control.trace then print "done compute_time_step\n\n" else ()
+        val deltat'  = compute_time_step (d, theta_hat, theta')
+        val _ = if !Control.trace then print "done compute_time_step\n\n" else ()
     in
-	(v',x',alpha',s',rho',p',q',  epsilon',theta',deltat',c')
+        (v',x',alpha',s',rho',p',q',  epsilon',theta',deltat',c')
     end
 
 fun runit () = 
     let fun iter (i,state) = if i = 0 then state
-			     else (print ".";
-				   iter(i-1, compute_next_state state))
+                             else (print ".";
+                                   iter(i-1, compute_next_state state))
     in iter(step_count, compute_initial_state())
     end
 
@@ -906,23 +906,23 @@
     fun testit outstrm = print_state (runit())
 
     fun doit () = let
-	  val (_, _, _, _, _, _, _, _, _, delta', c') = runit()
-	  val delta = Real.trunc delta'
-	  val c = Real.trunc (c' * 10000.0)
-	  in
-	    if (c = 6787 andalso delta = ~33093)
-	      then ()
-	      else TextIO.output (TextIO.stdErr, "*** ERROR ***\n")
-	  end
+          val (_, _, _, _, _, _, _, _, _, delta', c') = runit()
+          val delta = Real.trunc delta'
+          val c = Real.trunc (c' * 10000.0)
+          in
+            if (c = 6787 andalso delta = ~33093)
+              then ()
+              else TextIO.output (TextIO.stdErr, "*** ERROR ***\n")
+          end
 
     val doit =
        fn n =>
        let
-	  fun loop n =
-	     if n = 0
-		then ()
-	     else (doit();
-		   loop(n-1))
+          fun loop n =
+             if n = 0
+                then ()
+             else (doit();
+                   loop(n-1))
        in loop n
        end
 

Modified: mlton/branches/on-20050420-cmm-branch/benchmark/tests/smith-normal-form.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/benchmark/tests/smith-normal-form.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/benchmark/tests/smith-normal-form.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -31,224 +31,224 @@
       exception foldError
    
       fun make (height: int, width: int, generator: int * int -> 'entry)
-	 : 'entry matrix =
-	 if height < 0 orelse width < 0
-	    then raise sizeError
-	 else (height,
-	       width,
-	       Array.tabulate (height*width,
-			       fn z => generator (z div width,
-						  z mod width)))
+         : 'entry matrix =
+         if height < 0 orelse width < 0
+            then raise sizeError
+         else (height,
+               width,
+               Array.tabulate (height*width,
+                               fn z => generator (z div width,
+                                                  z mod width)))
    
       fun height (height, _, _) = height
    
       fun width (width, _, _) = width
    
       fun fetch ((height, width, mat), row, col) =
-	 if 0 <= row
-	    andalso row < height
-	    andalso 0 <= col
-	    andalso col < width
-	    then Array.sub (mat, col + width*row)
-	 else raise index
+         if 0 <= row
+            andalso row < height
+            andalso 0 <= col
+            andalso col < width
+            then Array.sub (mat, col + width*row)
+         else raise index
    
       fun fetchRow ((height, width, mat), row) =
-	 if 0 <= row andalso row < height
-	    then let val offset = width * row
-		 in fn col =>
-		    if 0 <= col andalso col < width
-		       then Array.sub (mat, col + offset)
-		    else raise index
-		 end
-	 else raise index
+         if 0 <= row andalso row < height
+            then let val offset = width * row
+                 in fn col =>
+                    if 0 <= col andalso col < width
+                       then Array.sub (mat, col + offset)
+                    else raise index
+                 end
+         else raise index
    
       fun fetchCol ((height, width, mat), col) =
-	 if 0 <= col andalso col < width
-	    then fn row =>
-	       if 0 <= row andalso row < height
-		  then Array.sub (mat, col + width*row)
-	       else raise index
-	 else raise index
+         if 0 <= col andalso col < width
+            then fn row =>
+               if 0 <= row andalso row < height
+                  then Array.sub (mat, col + width*row)
+               else raise index
+         else raise index
    
       fun store ((height, width, mat), row, col, entry) =
-	 if 0 <= row
-	    andalso row < height
-	    andalso 0 <= col
-	    andalso col < width
-	    then Array.update (mat, col + width*row, entry)
-	 else raise index
+         if 0 <= row
+            andalso row < height
+            andalso 0 <= col
+            andalso col < width
+            then Array.update (mat, col + width*row, entry)
+         else raise index
    
       fun storeRow ((height, width, mat), row) =
-	 if 0 <= row andalso row < height
-	    then let val offset = width * row
-		 in fn (col, entry) =>
-		    if 0 <= col andalso col < width
-		       then Array.update (mat, col + offset, entry)
-		    else raise index
-		 end
-	 else raise index
+         if 0 <= row andalso row < height
+            then let val offset = width * row
+                 in fn (col, entry) =>
+                    if 0 <= col andalso col < width
+                       then Array.update (mat, col + offset, entry)
+                    else raise index
+                 end
+         else raise index
    
       fun storeCol ((height, width, mat), col) =
-	 if 0 <= col andalso col < width
-	    then fn (row, entry) =>
-	       if 0 <= row andalso row < height
-		  then Array.update (mat, col + width*row, entry)
-	       else raise index
-	 else raise index
+         if 0 <= col andalso col < width
+            then fn (row, entry) =>
+               if 0 <= row andalso row < height
+                  then Array.update (mat, col + width*row, entry)
+               else raise index
+         else raise index
    
       fun swapLoop (from1: int -> 'entry,
-		    to1: int * 'entry -> unit,
-		    from2: int -> 'entry,
-		    to2: int * 'entry -> unit,
-		    limit: int): unit =
-	 let fun loop (i: int): unit =
-	    if i = limit
-	       then ()
-	    else let val tmp = from1 i
-		 in to1 (i, from2 i);
-		    to2 (i, tmp);
-		    loop (i + 1)
-		 end
-	 in loop 0
-	 end
+                    to1: int * 'entry -> unit,
+                    from2: int -> 'entry,
+                    to2: int * 'entry -> unit,
+                    limit: int): unit =
+         let fun loop (i: int): unit =
+            if i = limit
+               then ()
+            else let val tmp = from1 i
+                 in to1 (i, from2 i);
+                    to2 (i, tmp);
+                    loop (i + 1)
+                 end
+         in loop 0
+         end
    
       fun rowSwap (mat as (height, width, _), row1, row2): unit =
-	 if 0 <= row1 andalso row1 < height
-	    andalso 0 <= row2 andalso row2 < height
-	    then if row1 = row2
-		    then ()
-		 else swapLoop (fetchRow (mat, row1),
-				storeRow (mat, row1),
-				fetchRow (mat, row2),
-				storeRow (mat, row2),
-				width)
-	 else raise index
+         if 0 <= row1 andalso row1 < height
+            andalso 0 <= row2 andalso row2 < height
+            then if row1 = row2
+                    then ()
+                 else swapLoop (fetchRow (mat, row1),
+                                storeRow (mat, row1),
+                                fetchRow (mat, row2),
+                                storeRow (mat, row2),
+                                width)
+         else raise index
    
       fun colSwap (mat as (height, width, _), col1, col2): unit =
-	 if 0 <= col1 andalso col1 < width
-	    andalso 0 <= col2 andalso col2 < width
-	    then if col1 = col2
-		    then ()
-		 else swapLoop (fetchCol (mat, col1),
-				storeCol (mat, col1),
-				fetchCol (mat, col2),
-				storeCol (mat, col2),
-				height)
-	 else raise index
+         if 0 <= col1 andalso col1 < width
+            andalso 0 <= col2 andalso col2 < width
+            then if col1 = col2
+                    then ()
+                 else swapLoop (fetchCol (mat, col1),
+                                storeCol (mat, col1),
+                                fetchCol (mat, col2),
+                                storeCol (mat, col2),
+                                height)
+         else raise index
    
       fun opLoop (from1: int -> 'entry,
-		  from2: int -> 'entry,
-		  to2: int * 'entry -> unit,
-		  limit: int,
-		  f: 'entry * 'entry -> 'entry): unit =
-	 let fun loop (i: int): unit =
-	    if i = limit
-	       then ()
-	    else (
-		  to2 (i,
-		       f (from1 i, from2 i));
-		  loop (i + 1))
-	 in loop 0
-	 end
+                  from2: int -> 'entry,
+                  to2: int * 'entry -> unit,
+                  limit: int,
+                  f: 'entry * 'entry -> 'entry): unit =
+         let fun loop (i: int): unit =
+            if i = limit
+               then ()
+            else (
+                  to2 (i,
+                       f (from1 i, from2 i));
+                  loop (i + 1))
+         in loop 0
+         end
    
       fun rowOp (mat as (height, width, _),
-		 row1,
-		 row2,
-		 f: 'entry * 'entry -> 'entry): unit =
-	 if 0 <= row1 andalso row1 < height
-	    andalso 0 <= row2 andalso row2 < height
-	    andalso row1 <> row2
-	    then opLoop (fetchRow (mat, row1),
-			 fetchRow (mat, row2),
-			 storeRow (mat, row2),
-			 width,
-			 f)
-	 else raise index
+                 row1,
+                 row2,
+                 f: 'entry * 'entry -> 'entry): unit =
+         if 0 <= row1 andalso row1 < height
+            andalso 0 <= row2 andalso row2 < height
+            andalso row1 <> row2
+            then opLoop (fetchRow (mat, row1),
+                         fetchRow (mat, row2),
+                         storeRow (mat, row2),
+                         width,
+                         f)
+         else raise index
    
       fun colOp (mat as (height, width, _),
-		 col1,
-		 col2,
-		 f: 'entry * 'entry -> 'entry): unit =
-	 if 0 <= col1 andalso col1 < width
-	    andalso 0 <= col2 andalso col2 < width
-	    andalso col1 <> col2
-	    then opLoop (fetchCol (mat, col1),
-			 fetchCol (mat, col2),
-			 storeCol (mat, col2),
-			 height,
-			 f)
-	 else raise index
+                 col1,
+                 col2,
+                 f: 'entry * 'entry -> 'entry): unit =
+         if 0 <= col1 andalso col1 < width
+            andalso 0 <= col2 andalso col2 < width
+            andalso col1 <> col2
+            then opLoop (fetchCol (mat, col1),
+                         fetchCol (mat, col2),
+                         storeCol (mat, col2),
+                         height,
+                         f)
+         else raise index
    
       fun copy ((height, width, mat)) =
-	 (height,
-	  width,
-	  Array.tabulate (Array.length mat,
-			  fn i => Array.sub (mat, i)))
+         (height,
+          width,
+          Array.tabulate (Array.length mat,
+                          fn i => Array.sub (mat, i)))
    
       fun map ((height, width, mat: 'entry1 Array.array),
-	       f: 'entry1 -> 'entry2)
-	 : 'entry2 matrix =
-	 (height,
-	  width,
-	  Array.tabulate (Array.length mat,
-			  fn i => f (Array.sub (mat, i))))
+               f: 'entry1 -> 'entry2)
+         : 'entry2 matrix =
+         (height,
+          width,
+          Array.tabulate (Array.length mat,
+                          fn i => f (Array.sub (mat, i))))
    
       (* Natural fold a range of integers in reverse. *)
       fun naturalFold (limit: int,
-		       state: 'state,
-		       folder: int * 'state -> 'state): 'state =
-	 let fun loop (i: int, state: 'state) =
-	    if i = 0
-	       then state
-	    else loop (i - 1, folder (i - 1, state))
-	 in if limit < 0
-	       then raise foldError
-	    else loop (limit, state)
-	 end
+                       state: 'state,
+                       folder: int * 'state -> 'state): 'state =
+         let fun loop (i: int, state: 'state) =
+            if i = 0
+               then state
+            else loop (i - 1, folder (i - 1, state))
+         in if limit < 0
+               then raise foldError
+            else loop (limit, state)
+         end
    
    
       local val blank8 = Byte.charToByte #" "
    
-	 fun makeBlanks size =
-	    let val blanks = Word8Vector.tabulate (size,
-						   fn _ => blank8)
-	    in Byte.bytesToString blanks
-	    end
+         fun makeBlanks size =
+            let val blanks = Word8Vector.tabulate (size,
+                                                   fn _ => blank8)
+            in Byte.bytesToString blanks
+            end
    
       in fun toString (mat: 'entry matrix, f: 'entry -> string): string =
-	 let val mat as (height, width, _) = map (mat, f)
-	    fun maxSize from (i, width) = Int.max (String.size (from i),
-						   width)
-	    fun colWidth col = naturalFold (height,
-					    0,
-					    maxSize (fetchCol (mat,
-							       col)))
-	    val widths = Vector.tabulate (width, colWidth)
-	    fun doRow (row: int, ac: string list): string list =
-	       let val from = fetchRow (mat, row)
-		  fun loop (col: int, ac: string list) =
-		     let val next = from col
-			val ac = next::ac
-			val s = String.size next
-			val pad = Vector.sub (widths, col) - s
-			val ac = if pad <= 0
-				    then ac
-				 else (makeBlanks pad)::ac
-		     in if col = 0
-			   then ac
-			else loop (col - 1,
-				   " "::ac)
-		     end
-		  val ac = "\n"::ac
-	       in if width = 0
-		     then ac
-		  else loop (width - 1, ac)
-	       end
-	    val pieces = naturalFold (height,
-				      [],
-				      doRow)
-	 in String.concat pieces
-	 end
+         let val mat as (height, width, _) = map (mat, f)
+            fun maxSize from (i, width) = Int.max (String.size (from i),
+                                                   width)
+            fun colWidth col = naturalFold (height,
+                                            0,
+                                            maxSize (fetchCol (mat,
+                                                               col)))
+            val widths = Vector.tabulate (width, colWidth)
+            fun doRow (row: int, ac: string list): string list =
+               let val from = fetchRow (mat, row)
+                  fun loop (col: int, ac: string list) =
+                     let val next = from col
+                        val ac = next::ac
+                        val s = String.size next
+                        val pad = Vector.sub (widths, col) - s
+                        val ac = if pad <= 0
+                                    then ac
+                                 else (makeBlanks pad)::ac
+                     in if col = 0
+                           then ac
+                        else loop (col - 1,
+                                   " "::ac)
+                     end
+                  val ac = "\n"::ac
+               in if width = 0
+                     then ac
+                  else loop (width - 1, ac)
+               end
+            val pieces = naturalFold (height,
+                                      [],
+                                      doRow)
+         in String.concat pieces
+         end
       end
    end
 
@@ -264,135 +264,135 @@
       val mat = Matrix.copy mat
       val range = Int.min (width, height)
       fun dd pos =
-	 let val matCol = Matrix.fetchCol (mat, pos)
-	    val matRow = Matrix.fetchRow (mat, pos)
-	    val _ = print ("dd: pos = " ^ (Int.toString pos) ^ "\n")
-	    fun swapRowLoop (best, bestRow, bestCol, row) =
-	       if row >= height
-		  then (Matrix.rowSwap (mat, pos, bestRow);
-			Matrix.colSwap (mat, pos, bestCol))
-	       else let val matRow = Matrix.fetchRow (mat, row)
-			fun swapColLoop (best, bestRow, bestCol, col) =
-			   if col >= width
-			      then swapRowLoop (best, bestRow, bestCol, row + 1)
-			   else let val next = matRow col
-				in if smaller (next, best)
-				      then swapColLoop (next, row, col, col + 1)
-				   else swapColLoop (best, bestRow, bestCol, col + 1)
-				end
-		    in swapColLoop (best, bestRow, bestCol, pos)
-		    end
-	    fun rowLoop row =
-	       if row < height
-		  then if (matCol row) = zero
-			  then rowLoop (row + 1)
-		       else (Matrix.rowOp (mat,
-					   pos,
-					   row,
-					   let val x = IntInf.~ (IntInf.quot(matCol row, matCol pos))
-					   in fn (lhs, rhs) => IntInf.+ (IntInf.* (lhs, x), rhs)
-					   end);
-			     if (matCol row) = zero
-				then rowLoop (row + 1)
-			     else hitPosAgain ())
-	       else let fun colLoop col =
-		  if col < width
-		     then if (matRow col) = zero
-			     then colLoop (col + 1)
-			  else (Matrix.colOp (mat,
-					      pos,
-					      col,
-					      let val x = IntInf.~ (IntInf.quot (matRow col, matRow pos))
-					      in fn (lhs, rhs) => IntInf.+ (IntInf.* (lhs, x), rhs)
-					      end);
-				if (matRow col) = zero
-				   then colLoop (col + 1)
-				else hitPosAgain ())
-		  else ()
-		    in colLoop (pos + 1)
-		    end
-	    and hitPosAgain () = (swapRowLoop (zero, pos, pos, pos);
-				  rowLoop (pos + 1))
-	 in hitPosAgain ()
-	 end
+         let val matCol = Matrix.fetchCol (mat, pos)
+            val matRow = Matrix.fetchRow (mat, pos)
+            val _ = print ("dd: pos = " ^ (Int.toString pos) ^ "\n")
+            fun swapRowLoop (best, bestRow, bestCol, row) =
+               if row >= height
+                  then (Matrix.rowSwap (mat, pos, bestRow);
+                        Matrix.colSwap (mat, pos, bestCol))
+               else let val matRow = Matrix.fetchRow (mat, row)
+                        fun swapColLoop (best, bestRow, bestCol, col) =
+                           if col >= width
+                              then swapRowLoop (best, bestRow, bestCol, row + 1)
+                           else let val next = matRow col
+                                in if smaller (next, best)
+                                      then swapColLoop (next, row, col, col + 1)
+                                   else swapColLoop (best, bestRow, bestCol, col + 1)
+                                end
+                    in swapColLoop (best, bestRow, bestCol, pos)
+                    end
+            fun rowLoop row =
+               if row < height
+                  then if (matCol row) = zero
+                          then rowLoop (row + 1)
+                       else (Matrix.rowOp (mat,
+                                           pos,
+                                           row,
+                                           let val x = IntInf.~ (IntInf.quot(matCol row, matCol pos))
+                                           in fn (lhs, rhs) => IntInf.+ (IntInf.* (lhs, x), rhs)
+                                           end);
+                             if (matCol row) = zero
+                                then rowLoop (row + 1)
+                             else hitPosAgain ())
+               else let fun colLoop col =
+                  if col < width
+                     then if (matRow col) = zero
+                             then colLoop (col + 1)
+                          else (Matrix.colOp (mat,
+                                              pos,
+                                              col,
+                                              let val x = IntInf.~ (IntInf.quot (matRow col, matRow pos))
+                                              in fn (lhs, rhs) => IntInf.+ (IntInf.* (lhs, x), rhs)
+                                              end);
+                                if (matRow col) = zero
+                                   then colLoop (col + 1)
+                                else hitPosAgain ())
+                  else ()
+                    in colLoop (pos + 1)
+                    end
+            and hitPosAgain () = (swapRowLoop (zero, pos, pos, pos);
+                                  rowLoop (pos + 1))
+         in hitPosAgain ()
+         end
       fun loop pos =
-	 if pos = range
-	    then mat
-	 else (dd pos;
-	       loop (pos + 1))
+         if pos = range
+            then mat
+         else (dd pos;
+               loop (pos + 1))
    in loop 0
    end
 
 val table = [[ 8,  ~3,   1,   3,   6,   9,  ~2,   4,  ~9,  ~9,   2,   3,   8,  ~1,   3,  ~5,   4,  ~3,  ~5,  ~6,   8,   1,   4,  ~5,   7,  ~4,  ~4,  ~7,   7,   1,   4,  ~3,   8,   4,  ~4,  ~8,   5,  ~9,   3,  ~4,   1,   9,  ~8,  ~6,  ~2,   8,  ~9,  ~5,  ~3,  ~3],
-	     [ 0,   8,  ~6,  ~2,  ~3,   4,   5,  ~2,   7,  ~7,  ~6,  ~7,  ~3,  ~4,   9,   7,  ~3,   3,   0,   3,   3,  ~8,  ~8,   2,   3,   8,   3,  ~2,  ~4,   3,  ~6,  ~6,  ~2,   6,   5,  ~1,  ~3,   1,   8,  ~8,   2,   1,  ~7,  ~7,  ~7,  ~3,  ~6,   6,  ~4,  ~9],
-	     [ 0,  ~5,   8,  ~9,   2,   4,   2,   7,  ~4,   9,  ~3,   6,  ~2,   3,  ~3,   0,  ~9,   5,   8,  ~1,   2,  ~8,   3,   4,  ~6,   5,  ~6,  ~5,  ~8,   0,  ~5,   3,  ~2,  ~5,   8,   7,  ~1,   1,  ~1,   7,   6,   3,   6,   5,   6,   8,   7,   9,   7,  ~3],
-	     [ 5,   4,   7,   2,   3,  ~9,   7,  ~7,   3,  ~8,   7,   5,   5,  ~2,  ~6,  ~3,   6,   5,   3,  ~1,  ~1,   4,   5,  ~5,   5,   9,   9,   3,   8,  ~3,  ~1,   9,  ~9,   6,  ~7,   7,   4,   6,  ~8,  ~9,   0,  ~3,  ~2,  ~7,   1,  ~2,  ~6,   7,   7,   7],
-	     [ 2,   9,   9,   3,  ~4,   0,   9,   2,   5,   3,  ~5,  ~3,  ~1,   1,   8,  ~6,   2,  ~4,  ~8,  ~7,  ~8,   4,   5,   8,  ~1,  ~1,   7,   2,   5,   5,  ~4,  ~7,  ~3,  ~7,   6,  ~4,  ~5,  ~8,  ~5,  ~9,  ~8,   5,  ~5,  ~5,   0,   8,   8,   6,   4,  ~1],
-	     [ 5,   5,   1,  ~7,   3,  ~5,   4,   9,   3,   4,   4,  ~5,   7,  ~1,   7,   4,  ~7,   7,  ~7,  ~2,   9,  ~9,   0,  ~4,  ~4,   0,   2,   6,   3,  ~1,   6,   6,   8,  ~6,  ~4,  ~9,   3,  ~2,  ~5,   5,  ~3,   2,  ~1,  ~6,   9,   3,  ~3,  ~8,  ~9,   7],
-	     [ 7,   1,   2,   7,   6,   5,  ~6,  ~3,  ~4,  ~8,   0,   9,   6,   1,   2,  ~5,   4,   4,   4,  ~6,  ~7,  ~9,  ~6,   2,  ~4,   5,  ~2,   1,   0,   1,  ~8,   7,  ~7,  ~5,   4,   1,  ~5,   4,  ~4,  ~2,  ~3,   1,   1,   3,   4,  ~4,  ~5,   9,   8,  ~2],
-	     [ 6,   2,  ~1,  ~8,   4,  ~7,   7,  ~3,  ~2,  ~5,   3,   0,   3,  ~9,   3,   3,   9,  ~1,   4,   8,  ~9,   6,  ~5,   9,   5,  ~1,  ~1,  ~9,   7,  ~2,   3,   9,   8,   9,   2,   7,   7,   6,  ~1,  ~1,  ~2,  ~2,  ~7,   3,  ~6,   0,  ~9,   4,   3,   7],
-	     [ 0,  ~6,  ~3,  ~7,  ~1,   5,  ~2,   8,  ~5,  ~3,  ~8,   7,  ~2,  ~2,   0,  ~8,   4,   8,   9,  ~5,  ~4,  ~8,  ~1,   7,   1,   1,   6,  ~9,  ~4,   0,   8,   4,   3,  ~7,   6,   0,   1,   8,   6,  ~1,  ~1,  ~7,   9,  ~9,  ~5,  ~2,  ~2,  ~1,   1,   0],
-	     [~4,   9,   6,  ~3,  ~2,  ~6,  ~3,   4,   8,  ~8,   1,  ~5,   9,   7,   9,   7,  ~9,  ~6,   6,   1,  ~3,   3,  ~3,  ~7,   1,   7,  ~7,   0,  ~2,   7,  ~4,  ~6,   0,   1,  ~3,  ~5,  ~9,  ~7,   8,   4,   9,  ~8,  ~8,  ~7,  ~6,   7,   6,  ~3,  ~8,   5],
-	     [ 6,   7,  ~5,  ~9,   6,   1,   8,   4,  ~2,   7,  ~7,  ~1,  ~9,   1,  ~6,  ~5,   4,   9,   6,   0,  ~8,  ~3,   1,  ~3,   8,  ~3,   2,   9,  ~3,  ~9,  ~1,  ~3,   4,   3,   2,  ~9,  ~5,  ~3,   8,  ~4,   8,   5,  ~4,   7,   6,  ~8,   7,   6,  ~5,   5],
-	     [ 1,   7,  ~8,  ~9,  ~7,  ~3,   8,   9,  ~7,  ~1,  ~7,   4,   0,   0,   1,  ~5,   9,  ~8,  ~1,  ~2,   3,   5,   9,  ~9,   5,   4,  ~9,   1,  ~4,  ~2,   3,  ~4,   8,  ~6,  ~4,  ~8,  ~5,  ~5,   4,  ~2,  ~4,  ~1,  ~9,  ~5,   2,  ~9,   2,  ~9,  ~2,  ~3],
-	     [~5,  ~4,  ~4,   9,   2,   7,  ~2,   6,   7,   2,  ~9,   4,   2,   7,   8,  ~9,   2,   5,   3,   9,   6,   3,   0,  ~7,  ~6,  ~7,   6,  ~2,   9,  ~3,  ~6,   9,  ~9,   2,   2,  ~6,  ~1,   4,  ~3,   3,   0,   6,  ~3,   4,   9,   9,  ~6,   5,   5,  ~5],
-	     [ 5,  ~7,   8,  ~4,   8,   8,  ~4,  ~9,   6,   0,  ~3,   6,   0,   8,   8,  ~6,  ~2,   5,   4,  ~1,  ~8,   1,  ~3,  ~1,   2,   3,  ~9,  ~9,  ~5,   1,   8,  ~5,  ~3,   0,  ~4,  ~9,   0,  ~6,   3,  ~1,  ~7,   0,   8,   9,  ~6,  ~1,  ~9,   1,  ~6,   2],
-	     [ 7,  ~5,  ~1,   5,  ~2,   7,   0,  ~7,  ~1,   8,   8,  ~3,   9,  ~5,   7,  ~8,  ~8,  ~4,   3,   2,  ~1,   8,  ~2,   1,   2,   5,   0,  ~6,   7,   3,   3,   7,  ~5,   5,  ~1,   1,   0,  ~8,   1,   0,   0,  ~4,   6,   9,  ~5,  ~6,   3,  ~5,   8,   5],
-	     [~4,  ~2,   3,  ~3,  ~1,   2,  ~2,  ~1,  ~9,  ~5,   1,   0,   0,   2,   9,  ~3,  ~9,   2,   9,   3,   8,  ~3,   4,   8,   8,   3,  ~3,  ~1,  ~4,   4,  ~6,  ~9,   5,  ~2,   1,   3,  ~7,  ~5,  ~6,  ~5,  ~8,   4,  ~8,  ~3,   5,   0,   7,  ~9,   6,   2],
-	     [ 5,   1,   4,  ~3,  ~1,  ~9,   5,  ~8,  ~8,   6,   1,   1,  ~2,   7,   5,   6,  ~4,   2,  ~7,   0,  ~7,  ~3,  ~5,   9,   3,   4,  ~6,   8,  ~4,   3,   6,   0,   2,   3,  ~6,   3,   9,   4,   1,  ~4,   6,  ~5,  ~7,   0,  ~1,  ~8,  ~3,  ~9,   9,   7],
-	     [ 2,  ~6,  ~1,   8,   4,  ~3,  ~1,  ~6,  ~2,  ~8,  ~2,  ~1,  ~1,  ~5,  ~9,  ~8,   9,  ~9,   5,   1,   9,  ~1,  ~6,   9,  ~7,   2,   8,  ~7,   4,  ~9,   7,   6,  ~2,   1,  ~2,  ~7,   8,   0,   5,   0,  ~5,  ~7,  ~6,   0,   4,   0,   3,  ~8,   5,   4],
-	     [~2,   9,  ~9,  ~6,   1,  ~8,   8,   4,  ~6,   8,   1,  ~3,  ~7,   8,  ~5,   2,  ~8,   1,   3,  ~2,   6,   6,   6,   1,   0,   0,  ~7,   7,  ~3,  ~3,   0,  ~4,   3,  ~7,  ~6,   7,   5,   9,  ~5,   7,  ~8,   2,   3,  ~8,  ~7,   6,  ~5,  ~5,  ~8,  ~9],
-	     [~7,  ~4,   4,   1,  ~1,  ~3,  ~8,   3,   7,   9,   8,   3,   0,   4,   4,  ~1,  ~5,   4,   2,   2,   0,   6,  ~6,   2,  ~9,   8,  ~9,   3,  ~2,   2,   6,   6,   1,   7,   1,   0,  ~8,   2,   3,  ~3,   8,   9,   5,   5,  ~6,   4,  ~7,  ~4,  ~2,  ~3],
-	     [~5,   8,   6,   1,  ~6,  ~6,   6,   1,   1,  ~3,  ~9,  ~6,   2,  ~7,   2,  ~1,   6,  ~6,   0,   2,  ~7,   8,  ~8,   4,   9,  ~3,   9,  ~7,  ~9,  ~6,  ~4,  ~4,  ~5,   8,   2,  ~5,  ~4,  ~3,   5,   2,   1,  ~3,  ~3,  ~7,  ~9,   3,   7,  ~7,   3,  ~8],
-	     [~4,  ~7,  ~2,   2,  ~4,  ~2,   6,  ~3,  ~1,  ~4,   0,  ~5,   9,   7,  ~6,  ~9,   7,  ~9,  ~6,   2,  ~3,   1,   5,  ~9,   4,  ~5,   4,  ~9,   1,  ~2,  ~2,   4,   0,   4,  ~8,  ~8,   3,  ~1,  ~5,  ~4,  ~9,  ~7,   7,   6,   3,  ~9,   6,   4,  ~4,  ~7],
-	     [~9,   6,   6,  ~5,  ~1,  ~7,   4,  ~9,   4,  ~1,   6,  ~4,   7,   2,   8,   7,   3,   1,  ~7,   7,   7,   9,   8,  ~9,   7,   2,   1,   2,  ~8,   4,   5,   6,   7,   2,  ~7,   6,   8,   4,  ~9,   7,  ~5,   6,   9,  ~1,   9,   2,   0,   9,   3,   6],
-	     [ 4,  ~3,   8,   0,  ~2,  ~2,   2,  ~3,   8,   3,   1,  ~8,  ~5,  ~2,   5,   6,   8,   0,  ~3,   4,  ~2,   4,  ~9,  ~5,   7,   6,  ~4,  ~7,   2,   4,  ~3,  ~8,  ~9,   9,   8,  ~9,   3,  ~7,   4,  ~7,  ~5,   4,   9,   3,  ~6,  ~3,  ~7,   4,   2,  ~2],
-	     [~8,  ~8,   6,  ~2,  ~6,   8,  ~3,   3,  ~1,  ~7,   1,   9,   1,   7,  ~6,   8,  ~2,  ~9,  ~1,   3,  ~4,   7,   8,  ~1,   9,  ~9,   6,  ~3,   5,   0,   2,   5,  ~1,  ~6,  ~6,   1,   8,   6,  ~3,  ~9,  ~1,   9,  ~2,   9,  ~8,  ~7,  ~3,   6,  ~3,  ~3],
-	     [ 5,  ~2,   3,   0,  ~9,  ~8,  ~6,   1,   8,   0,   1,   2,  ~8,  ~2,   0,  ~9,  ~8,   0,   5,  ~3,  ~4,   5,   6,  ~2,  ~5,   0,  ~9,   9,  ~9,  ~5,   9,   9,  ~5,  ~2,   4,   3,   8,  ~8,  ~7,   5,  ~3,  ~2,   2,   3,   9,   7,  ~1,   0,   4,  ~1],
-	     [~4,   5,  ~5,   7,   8,   9,   7,  ~3,   1,   9,  ~7,  ~1,   8,  ~5,  ~1,   2,  ~8,   1,   0,   9,  ~8,  ~1,   6,  ~1,   9,  ~8,   7,   4,  ~8,   7,   0,  ~6,   2,   3,   7,   4,  ~3,  ~5,   9,  ~3,   0,   6,  ~9,   2,   4,  ~8,   6,  ~7,   9,   1],
-	     [ 7,   0,  ~9,   6,   8,   2,   2,   5,  ~6,  ~6,   9,  ~5,   9,   2,   2,  ~8,   0,  ~6,  ~9,  ~6,  ~4,  ~9,   8,  ~2,   9,   7,  ~5,  ~1,   7,   2,  ~7,   7,  ~1,  ~3,   6,   6,   1,  ~4,   0,  ~1,  ~6,  ~5,   6,  ~7,  ~3,  ~2,   8,   2,  ~9,   8],
-	     [ 8,  ~7,  ~9,  ~6,   9,  ~7,  ~7,   6,  ~8,   9,   5,  ~4,   1,  ~7,  ~8,  ~6,  ~3,   8,  ~8,   1,  ~8,   6,   9,  ~3,  ~7,   7,   1,   6,   1,   0,   8,  ~5,  ~8,   8,  ~9,   0,   4,   4,   3,  ~4,   6,  ~3,  ~9,   0,   4,  ~4,  ~5,  ~9,  ~5,  ~8],
-	     [~3,  ~2,   8,   1,  ~1,  ~1,  ~4,   3,   7,  ~2,  ~9,   9,  ~8,  ~9,   6,  ~4,   7,  ~1,  ~5,  ~3,  ~9,   0,  ~3,   0,   7,   9,   1,  ~2,   7,  ~9,  ~6,   3,   3,  ~4,  ~7,  ~3,  ~4,  ~8,  ~2,  ~3,  ~9,  ~2,  ~6,   3,  ~6,  ~4,   7,  ~5,  ~8,  ~1],
-	     [~9,  ~9,  ~2,  ~9,  ~9,   9,   6,   6,   7,   5,  ~1,  ~2,   1,   5,   2,  ~3,  ~4,   1,  ~6,   0,  ~3,  ~9,  ~1,   7,   0,  ~9,   5,  ~2,  ~2,   5,   3,   4,  ~1,   6,  ~6,   3,  ~6,   7,  ~1,   5,  ~8,  ~4,  ~2,  ~2,  ~6,  ~5,  ~6,   3,  ~1,   4],
-	     [ 7,   7,   8,   7,   6,   1,  ~2,   5,  ~6,   9,   4,   8,   5,   0,  ~4,  ~2,  ~2,  ~5,  ~2,  ~6,   9,  ~8,  ~2,  ~5,  ~9,   3,  ~6,  ~3,  ~4,  ~5,  ~2,   6,   1,   6,  ~5,   0,  ~3,  ~2,   4,  ~6,   1,   6,  ~1,   3,  ~9,   2,  ~3,   1,   5,  ~6],
-	     [ 6,   4,  ~7,   3,  ~7,   9,   1,  ~7,  ~8,   0,  ~6,   8,   4,   1,   9,   6,   8,   3,   0,   9,   0,   4,   9,  ~7,  ~7,   1,   5,   1,  ~5,   6,   9,   2,   4,   1,  ~9,   8,   4,   5,   8,   3,   2,  ~9,  ~6,  ~9,   9,  ~9,   7,  ~6,  ~4,   3],
-	     [~3,  ~9,  ~4,   2,   3,   9,  ~9,   8,  ~9,   9,  ~4,  ~9,  ~5,   5,   0,   7,   3,  ~5,  ~8,   2,  ~3,   0,  ~9,  ~3,   1,   9,   4,   5,  ~1,   8,   0,  ~4,  ~2,   9,  ~4,  ~1,   3,   5,   9,  ~1,   1,   4,  ~8,  ~2,  ~3,   5,   1,   5,  ~6,   7],
-	     [ 9,  ~3,   2,  ~9,   3,   4,   0,   7,  ~5,   9,   0,  ~6,   7,  ~2,   3,  ~7,   2,  ~5,  ~2,   6,   3,  ~9,  ~5,  ~9,   5,   2,  ~5,  ~3,   8,  ~5,   6,   2,   9,  ~7,  ~7,  ~7,  ~6,   9,  ~3,   6,   0,   6,  ~6,  ~9,   4,  ~3,  ~9,   0,  ~4,  ~9],
-	     [~4,  ~8,   8,  ~7,   7,   0,  ~6,  ~6,   8,  ~9,  ~4,   5,  ~3,  ~1,   7,  ~5,  ~6,  ~1,   8,   6,  ~2,   1,  ~1,   5,  ~9,   1,  ~1,  ~7,  ~6,  ~6,  ~6,  ~4,   6,   3,  ~5,  ~5,  ~6,   2,   3,  ~6,  ~8,  ~3,   8,  ~2,  ~5,  ~4,  ~3,   1,   4,  ~4],
-	     [ 4,  ~6,   2,   6,   2,  ~8,   8,   5,   8,  ~2,   0,  ~6,  ~1,  ~6,  ~2,   2,   6,  ~9,  ~7,  ~6,  ~4,  ~4,  ~7,  ~2,   8,   6,   3,  ~7,  ~6,   8,   2,   3,   4,   5,   3,   4,  ~6,   8,   8,  ~1,   4,  ~5,   6,   2,   8,  ~3,  ~9,  ~2,   6,   7],
-	     [ 3,  ~4,   0,  ~3,  ~5,   0,  ~2,  ~6,  ~2,   8,   5,  ~9,  ~4,  ~8,  ~6,   0,   8,   9,   1,  ~2,   8,   2,  ~2,   8,   9,   3,   3,   5,  ~9,  ~3,  ~2,   7,   2,   9,   0,   4,   8,  ~9,   0,  ~6,   9,  ~9,   9,  ~4,   8,  ~8,  ~8,   2,  ~3,   2],
-	     [~1,   3,  ~9,  ~8,  ~7,   6,  ~6,   3,   0,   5,  ~5,   1,   2,  ~2,  ~3,   7,   7,   3,  ~4,  ~2,  ~9,  ~5,  ~1,   9,   6,   8,   2,   8,   7,  ~3,   4,   6,   6,   0,  ~2,   2,  ~7,  ~7,   6,  ~3,   8,   2,   1,   0,   8,  ~1,   3,   9,   8,   6],
-	     [ 1,  ~2,  ~3,   6,   5,   5,  ~6,  ~4,  ~5,   1,   1,   6,  ~7,  ~4,  ~3,   4,   4,  ~8,  ~9,   7,  ~2,  ~3,  ~7,  ~2,   1,   2,   0,   8,  ~6,  ~5,  ~5,   7,   8,   5,  ~2,   3,   9,   0,   5,   1,   3,  ~4,  ~6,   1,   4,  ~9,  ~2,   5,   4,   3],
-	     [ 3,   3,   9,  ~2,   6,   9,   4,   9,   4,  ~8,   5,  ~1,   3,  ~2,   1,  ~7,  ~3,   2,   2,   0,  ~3,   3,   8,   2,   0,  ~5,   7,   1,   4,  ~8,   8,  ~9,  ~1,   1,  ~9,  ~4,   5,   2,   2,   8,   6,   1,   6,  ~2,   2,   7,   1,  ~6,  ~1,  ~1],
-	     [ 4,  ~2,   4,  ~1,  ~5,  ~1,   5,  ~2,   3,  ~4,  ~5,   0,   2,  ~4,   6,   4,  ~3,   2,   2,   5,  ~6,  ~7,  ~9,  ~1,  ~9,  ~9,   6,   0,   6,   5,   9,  ~1,   3,  ~3,  ~8,   8,  ~8,   8,   4,   5,  ~1,  ~5,   1,   0,   3,  ~2,   5,   6,   6,   5],
-	     [~4,   9,   6,   8,  ~9,   5,   5,  ~3,  ~7,   7,   6,   8,  ~8,   0,   4,  ~1,   9,   5,  ~7,   0,  ~1,  ~2,   3,   6,   0,   4,  ~3,   1,   4,   6,   4,   0,   5,  ~1,   7,  ~7,  ~6,  ~8,  ~3,  ~6,   7,  ~1,  ~3,  ~2,  ~3,  ~5,   3,   1,  ~8,  ~9],
-	     [~6,   4,  ~5,   9,   9,  ~7,  ~1,  ~8,  ~4,   2,  ~6,   0,  ~6,  ~6,   7,   6,   0,   1,   7,  ~7,   0,  ~4,  ~6,  ~8,  ~9,   5,  ~6,  ~9,   2,  ~7,  ~2,  ~6,   9,   4,  ~5,   0,   4,  ~4,  ~5,   6,   9,   1,  ~6,  ~5,   3,  ~1,   7,  ~7,  ~6,   7],
-	     [~8,   7,   7,  ~6,   7,  ~4,   8,   0,  ~9,  ~8,  ~3,   7,  ~3,   3,   8,  ~7,  ~2,  ~7,   5,   5,  ~5,   4,   6,   2,   4,   1,   4,  ~9,  ~3,   8,   8,  ~9,  ~4,  ~2,   1,  ~3,   1,   3,   9,  ~5,  ~8,  ~2,   7,   8,   9,   2,   0,   1,  ~9,   6],
-	     [~7,   1,  ~9,   5,  ~5,  ~5,   7,   6,  ~5,  ~9,  ~6,  ~8,  ~6,   9,   7,   9,   0,  ~5,   7,   7,  ~6,   4,   5,  ~9,  ~1,  ~2,  ~7,   3,  ~5,  ~2,  ~5,   5,  ~3,  ~4,  ~2,  ~8,   2,  ~8,   0,  ~8,   0,  ~8,   9,   8,  ~5,  ~5,   1,   3,   5,  ~4],
-	     [~8,  ~8,   0,  ~5,  ~8,  ~6,   3,  ~6,  ~4,   6,   1,  ~5,  ~6,  ~8,  ~4,  ~6,  ~2,  ~6,   6,  ~4,   8,   8,   4,  ~5,  ~1,   0,   9,  ~8,  ~3,  ~1,  ~8,   7,  ~3,   0,  ~7,   1,  ~7,  ~1,  ~7,   3,  ~7,   3,  ~4,  ~8,   8,  ~7,  ~9,  ~8,   3,   2],
-	     [ 3,   6,   8,  ~9,   7,   1,  ~9,   9,   3,   8,   6,   4,  ~2,   1,  ~8,   4,  ~7,  ~4,  ~3,   3,  ~5,  ~6,  ~7,  ~2,   0,  ~4,   5,   2,   5,   6,   3,  ~8,   2,  ~5,  ~7,   6,   8,  ~2,  ~5,  ~4,   9,   9,   2,  ~2,  ~2,   7,   4,   4,  ~2,   3],
-	     [ 6,   6,  ~5,  ~2,  ~8,  ~2,  ~9,   0,   2,   4,  ~6,  ~9,   9,   0,  ~8,  ~3,  ~1,  ~2,  ~1,   6,   8,   2,  ~9,   5,  ~2,   1,   7,  ~6,   5,   1,  ~1,   4,  ~4,  ~7,  ~6,  ~3,  ~8,   2,   2,   5,   5,  ~6,   5,   3,   3,   7,   4,   7,  ~3,  ~9],
-	     [~9,   6,  ~4,   1,   3,  ~8,  ~8,  ~8,  ~1,   5,   1,   1,  ~1,   6,   5,   1,  ~1,   5,  ~8,   8,  ~7,  ~5,  ~1,  ~1,   6,  ~8,  ~3,  ~1,  ~2,  ~6,  ~5,  ~5,  ~6,   0,   2,   2,   7,  ~1,  ~5,  ~7,  ~1,  ~3,   7,   6,   0,   2,   4,  ~5,   0,  ~4]]
+             [ 0,   8,  ~6,  ~2,  ~3,   4,   5,  ~2,   7,  ~7,  ~6,  ~7,  ~3,  ~4,   9,   7,  ~3,   3,   0,   3,   3,  ~8,  ~8,   2,   3,   8,   3,  ~2,  ~4,   3,  ~6,  ~6,  ~2,   6,   5,  ~1,  ~3,   1,   8,  ~8,   2,   1,  ~7,  ~7,  ~7,  ~3,  ~6,   6,  ~4,  ~9],
+             [ 0,  ~5,   8,  ~9,   2,   4,   2,   7,  ~4,   9,  ~3,   6,  ~2,   3,  ~3,   0,  ~9,   5,   8,  ~1,   2,  ~8,   3,   4,  ~6,   5,  ~6,  ~5,  ~8,   0,  ~5,   3,  ~2,  ~5,   8,   7,  ~1,   1,  ~1,   7,   6,   3,   6,   5,   6,   8,   7,   9,   7,  ~3],
+             [ 5,   4,   7,   2,   3,  ~9,   7,  ~7,   3,  ~8,   7,   5,   5,  ~2,  ~6,  ~3,   6,   5,   3,  ~1,  ~1,   4,   5,  ~5,   5,   9,   9,   3,   8,  ~3,  ~1,   9,  ~9,   6,  ~7,   7,   4,   6,  ~8,  ~9,   0,  ~3,  ~2,  ~7,   1,  ~2,  ~6,   7,   7,   7],
+             [ 2,   9,   9,   3,  ~4,   0,   9,   2,   5,   3,  ~5,  ~3,  ~1,   1,   8,  ~6,   2,  ~4,  ~8,  ~7,  ~8,   4,   5,   8,  ~1,  ~1,   7,   2,   5,   5,  ~4,  ~7,  ~3,  ~7,   6,  ~4,  ~5,  ~8,  ~5,  ~9,  ~8,   5,  ~5,  ~5,   0,   8,   8,   6,   4,  ~1],
+             [ 5,   5,   1,  ~7,   3,  ~5,   4,   9,   3,   4,   4,  ~5,   7,  ~1,   7,   4,  ~7,   7,  ~7,  ~2,   9,  ~9,   0,  ~4,  ~4,   0,   2,   6,   3,  ~1,   6,   6,   8,  ~6,  ~4,  ~9,   3,  ~2,  ~5,   5,  ~3,   2,  ~1,  ~6,   9,   3,  ~3,  ~8,  ~9,   7],
+             [ 7,   1,   2,   7,   6,   5,  ~6,  ~3,  ~4,  ~8,   0,   9,   6,   1,   2,  ~5,   4,   4,   4,  ~6,  ~7,  ~9,  ~6,   2,  ~4,   5,  ~2,   1,   0,   1,  ~8,   7,  ~7,  ~5,   4,   1,  ~5,   4,  ~4,  ~2,  ~3,   1,   1,   3,   4,  ~4,  ~5,   9,   8,  ~2],
+             [ 6,   2,  ~1,  ~8,   4,  ~7,   7,  ~3,  ~2,  ~5,   3,   0,   3,  ~9,   3,   3,   9,  ~1,   4,   8,  ~9,   6,  ~5,   9,   5,  ~1,  ~1,  ~9,   7,  ~2,   3,   9,   8,   9,   2,   7,   7,   6,  ~1,  ~1,  ~2,  ~2,  ~7,   3,  ~6,   0,  ~9,   4,   3,   7],
+             [ 0,  ~6,  ~3,  ~7,  ~1,   5,  ~2,   8,  ~5,  ~3,  ~8,   7,  ~2,  ~2,   0,  ~8,   4,   8,   9,  ~5,  ~4,  ~8,  ~1,   7,   1,   1,   6,  ~9,  ~4,   0,   8,   4,   3,  ~7,   6,   0,   1,   8,   6,  ~1,  ~1,  ~7,   9,  ~9,  ~5,  ~2,  ~2,  ~1,   1,   0],
+             [~4,   9,   6,  ~3,  ~2,  ~6,  ~3,   4,   8,  ~8,   1,  ~5,   9,   7,   9,   7,  ~9,  ~6,   6,   1,  ~3,   3,  ~3,  ~7,   1,   7,  ~7,   0,  ~2,   7,  ~4,  ~6,   0,   1,  ~3,  ~5,  ~9,  ~7,   8,   4,   9,  ~8,  ~8,  ~7,  ~6,   7,   6,  ~3,  ~8,   5],
+             [ 6,   7,  ~5,  ~9,   6,   1,   8,   4,  ~2,   7,  ~7,  ~1,  ~9,   1,  ~6,  ~5,   4,   9,   6,   0,  ~8,  ~3,   1,  ~3,   8,  ~3,   2,   9,  ~3,  ~9,  ~1,  ~3,   4,   3,   2,  ~9,  ~5,  ~3,   8,  ~4,   8,   5,  ~4,   7,   6,  ~8,   7,   6,  ~5,   5],
+             [ 1,   7,  ~8,  ~9,  ~7,  ~3,   8,   9,  ~7,  ~1,  ~7,   4,   0,   0,   1,  ~5,   9,  ~8,  ~1,  ~2,   3,   5,   9,  ~9,   5,   4,  ~9,   1,  ~4,  ~2,   3,  ~4,   8,  ~6,  ~4,  ~8,  ~5,  ~5,   4,  ~2,  ~4,  ~1,  ~9,  ~5,   2,  ~9,   2,  ~9,  ~2,  ~3],
+             [~5,  ~4,  ~4,   9,   2,   7,  ~2,   6,   7,   2,  ~9,   4,   2,   7,   8,  ~9,   2,   5,   3,   9,   6,   3,   0,  ~7,  ~6,  ~7,   6,  ~2,   9,  ~3,  ~6,   9,  ~9,   2,   2,  ~6,  ~1,   4,  ~3,   3,   0,   6,  ~3,   4,   9,   9,  ~6,   5,   5,  ~5],
+             [ 5,  ~7,   8,  ~4,   8,   8,  ~4,  ~9,   6,   0,  ~3,   6,   0,   8,   8,  ~6,  ~2,   5,   4,  ~1,  ~8,   1,  ~3,  ~1,   2,   3,  ~9,  ~9,  ~5,   1,   8,  ~5,  ~3,   0,  ~4,  ~9,   0,  ~6,   3,  ~1,  ~7,   0,   8,   9,  ~6,  ~1,  ~9,   1,  ~6,   2],
+             [ 7,  ~5,  ~1,   5,  ~2,   7,   0,  ~7,  ~1,   8,   8,  ~3,   9,  ~5,   7,  ~8,  ~8,  ~4,   3,   2,  ~1,   8,  ~2,   1,   2,   5,   0,  ~6,   7,   3,   3,   7,  ~5,   5,  ~1,   1,   0,  ~8,   1,   0,   0,  ~4,   6,   9,  ~5,  ~6,   3,  ~5,   8,   5],
+             [~4,  ~2,   3,  ~3,  ~1,   2,  ~2,  ~1,  ~9,  ~5,   1,   0,   0,   2,   9,  ~3,  ~9,   2,   9,   3,   8,  ~3,   4,   8,   8,   3,  ~3,  ~1,  ~4,   4,  ~6,  ~9,   5,  ~2,   1,   3,  ~7,  ~5,  ~6,  ~5,  ~8,   4,  ~8,  ~3,   5,   0,   7,  ~9,   6,   2],
+             [ 5,   1,   4,  ~3,  ~1,  ~9,   5,  ~8,  ~8,   6,   1,   1,  ~2,   7,   5,   6,  ~4,   2,  ~7,   0,  ~7,  ~3,  ~5,   9,   3,   4,  ~6,   8,  ~4,   3,   6,   0,   2,   3,  ~6,   3,   9,   4,   1,  ~4,   6,  ~5,  ~7,   0,  ~1,  ~8,  ~3,  ~9,   9,   7],
+             [ 2,  ~6,  ~1,   8,   4,  ~3,  ~1,  ~6,  ~2,  ~8,  ~2,  ~1,  ~1,  ~5,  ~9,  ~8,   9,  ~9,   5,   1,   9,  ~1,  ~6,   9,  ~7,   2,   8,  ~7,   4,  ~9,   7,   6,  ~2,   1,  ~2,  ~7,   8,   0,   5,   0,  ~5,  ~7,  ~6,   0,   4,   0,   3,  ~8,   5,   4],
+             [~2,   9,  ~9,  ~6,   1,  ~8,   8,   4,  ~6,   8,   1,  ~3,  ~7,   8,  ~5,   2,  ~8,   1,   3,  ~2,   6,   6,   6,   1,   0,   0,  ~7,   7,  ~3,  ~3,   0,  ~4,   3,  ~7,  ~6,   7,   5,   9,  ~5,   7,  ~8,   2,   3,  ~8,  ~7,   6,  ~5,  ~5,  ~8,  ~9],
+             [~7,  ~4,   4,   1,  ~1,  ~3,  ~8,   3,   7,   9,   8,   3,   0,   4,   4,  ~1,  ~5,   4,   2,   2,   0,   6,  ~6,   2,  ~9,   8,  ~9,   3,  ~2,   2,   6,   6,   1,   7,   1,   0,  ~8,   2,   3,  ~3,   8,   9,   5,   5,  ~6,   4,  ~7,  ~4,  ~2,  ~3],
+             [~5,   8,   6,   1,  ~6,  ~6,   6,   1,   1,  ~3,  ~9,  ~6,   2,  ~7,   2,  ~1,   6,  ~6,   0,   2,  ~7,   8,  ~8,   4,   9,  ~3,   9,  ~7,  ~9,  ~6,  ~4,  ~4,  ~5,   8,   2,  ~5,  ~4,  ~3,   5,   2,   1,  ~3,  ~3,  ~7,  ~9,   3,   7,  ~7,   3,  ~8],
+             [~4,  ~7,  ~2,   2,  ~4,  ~2,   6,  ~3,  ~1,  ~4,   0,  ~5,   9,   7,  ~6,  ~9,   7,  ~9,  ~6,   2,  ~3,   1,   5,  ~9,   4,  ~5,   4,  ~9,   1,  ~2,  ~2,   4,   0,   4,  ~8,  ~8,   3,  ~1,  ~5,  ~4,  ~9,  ~7,   7,   6,   3,  ~9,   6,   4,  ~4,  ~7],
+             [~9,   6,   6,  ~5,  ~1,  ~7,   4,  ~9,   4,  ~1,   6,  ~4,   7,   2,   8,   7,   3,   1,  ~7,   7,   7,   9,   8,  ~9,   7,   2,   1,   2,  ~8,   4,   5,   6,   7,   2,  ~7,   6,   8,   4,  ~9,   7,  ~5,   6,   9,  ~1,   9,   2,   0,   9,   3,   6],
+             [ 4,  ~3,   8,   0,  ~2,  ~2,   2,  ~3,   8,   3,   1,  ~8,  ~5,  ~2,   5,   6,   8,   0,  ~3,   4,  ~2,   4,  ~9,  ~5,   7,   6,  ~4,  ~7,   2,   4,  ~3,  ~8,  ~9,   9,   8,  ~9,   3,  ~7,   4,  ~7,  ~5,   4,   9,   3,  ~6,  ~3,  ~7,   4,   2,  ~2],
+             [~8,  ~8,   6,  ~2,  ~6,   8,  ~3,   3,  ~1,  ~7,   1,   9,   1,   7,  ~6,   8,  ~2,  ~9,  ~1,   3,  ~4,   7,   8,  ~1,   9,  ~9,   6,  ~3,   5,   0,   2,   5,  ~1,  ~6,  ~6,   1,   8,   6,  ~3,  ~9,  ~1,   9,  ~2,   9,  ~8,  ~7,  ~3,   6,  ~3,  ~3],
+             [ 5,  ~2,   3,   0,  ~9,  ~8,  ~6,   1,   8,   0,   1,   2,  ~8,  ~2,   0,  ~9,  ~8,   0,   5,  ~3,  ~4,   5,   6,  ~2,  ~5,   0,  ~9,   9,  ~9,  ~5,   9,   9,  ~5,  ~2,   4,   3,   8,  ~8,  ~7,   5,  ~3,  ~2,   2,   3,   9,   7,  ~1,   0,   4,  ~1],
+             [~4,   5,  ~5,   7,   8,   9,   7,  ~3,   1,   9,  ~7,  ~1,   8,  ~5,  ~1,   2,  ~8,   1,   0,   9,  ~8,  ~1,   6,  ~1,   9,  ~8,   7,   4,  ~8,   7,   0,  ~6,   2,   3,   7,   4,  ~3,  ~5,   9,  ~3,   0,   6,  ~9,   2,   4,  ~8,   6,  ~7,   9,   1],
+             [ 7,   0,  ~9,   6,   8,   2,   2,   5,  ~6,  ~6,   9,  ~5,   9,   2,   2,  ~8,   0,  ~6,  ~9,  ~6,  ~4,  ~9,   8,  ~2,   9,   7,  ~5,  ~1,   7,   2,  ~7,   7,  ~1,  ~3,   6,   6,   1,  ~4,   0,  ~1,  ~6,  ~5,   6,  ~7,  ~3,  ~2,   8,   2,  ~9,   8],
+             [ 8,  ~7,  ~9,  ~6,   9,  ~7,  ~7,   6,  ~8,   9,   5,  ~4,   1,  ~7,  ~8,  ~6,  ~3,   8,  ~8,   1,  ~8,   6,   9,  ~3,  ~7,   7,   1,   6,   1,   0,   8,  ~5,  ~8,   8,  ~9,   0,   4,   4,   3,  ~4,   6,  ~3,  ~9,   0,   4,  ~4,  ~5,  ~9,  ~5,  ~8],
+             [~3,  ~2,   8,   1,  ~1,  ~1,  ~4,   3,   7,  ~2,  ~9,   9,  ~8,  ~9,   6,  ~4,   7,  ~1,  ~5,  ~3,  ~9,   0,  ~3,   0,   7,   9,   1,  ~2,   7,  ~9,  ~6,   3,   3,  ~4,  ~7,  ~3,  ~4,  ~8,  ~2,  ~3,  ~9,  ~2,  ~6,   3,  ~6,  ~4,   7,  ~5,  ~8,  ~1],
+             [~9,  ~9,  ~2,  ~9,  ~9,   9,   6,   6,   7,   5,  ~1,  ~2,   1,   5,   2,  ~3,  ~4,   1,  ~6,   0,  ~3,  ~9,  ~1,   7,   0,  ~9,   5,  ~2,  ~2,   5,   3,   4,  ~1,   6,  ~6,   3,  ~6,   7,  ~1,   5,  ~8,  ~4,  ~2,  ~2,  ~6,  ~5,  ~6,   3,  ~1,   4],
+             [ 7,   7,   8,   7,   6,   1,  ~2,   5,  ~6,   9,   4,   8,   5,   0,  ~4,  ~2,  ~2,  ~5,  ~2,  ~6,   9,  ~8,  ~2,  ~5,  ~9,   3,  ~6,  ~3,  ~4,  ~5,  ~2,   6,   1,   6,  ~5,   0,  ~3,  ~2,   4,  ~6,   1,   6,  ~1,   3,  ~9,   2,  ~3,   1,   5,  ~6],
+             [ 6,   4,  ~7,   3,  ~7,   9,   1,  ~7,  ~8,   0,  ~6,   8,   4,   1,   9,   6,   8,   3,   0,   9,   0,   4,   9,  ~7,  ~7,   1,   5,   1,  ~5,   6,   9,   2,   4,   1,  ~9,   8,   4,   5,   8,   3,   2,  ~9,  ~6,  ~9,   9,  ~9,   7,  ~6,  ~4,   3],
+             [~3,  ~9,  ~4,   2,   3,   9,  ~9,   8,  ~9,   9,  ~4,  ~9,  ~5,   5,   0,   7,   3,  ~5,  ~8,   2,  ~3,   0,  ~9,  ~3,   1,   9,   4,   5,  ~1,   8,   0,  ~4,  ~2,   9,  ~4,  ~1,   3,   5,   9,  ~1,   1,   4,  ~8,  ~2,  ~3,   5,   1,   5,  ~6,   7],
+             [ 9,  ~3,   2,  ~9,   3,   4,   0,   7,  ~5,   9,   0,  ~6,   7,  ~2,   3,  ~7,   2,  ~5,  ~2,   6,   3,  ~9,  ~5,  ~9,   5,   2,  ~5,  ~3,   8,  ~5,   6,   2,   9,  ~7,  ~7,  ~7,  ~6,   9,  ~3,   6,   0,   6,  ~6,  ~9,   4,  ~3,  ~9,   0,  ~4,  ~9],
+             [~4,  ~8,   8,  ~7,   7,   0,  ~6,  ~6,   8,  ~9,  ~4,   5,  ~3,  ~1,   7,  ~5,  ~6,  ~1,   8,   6,  ~2,   1,  ~1,   5,  ~9,   1,  ~1,  ~7,  ~6,  ~6,  ~6,  ~4,   6,   3,  ~5,  ~5,  ~6,   2,   3,  ~6,  ~8,  ~3,   8,  ~2,  ~5,  ~4,  ~3,   1,   4,  ~4],
+             [ 4,  ~6,   2,   6,   2,  ~8,   8,   5,   8,  ~2,   0,  ~6,  ~1,  ~6,  ~2,   2,   6,  ~9,  ~7,  ~6,  ~4,  ~4,  ~7,  ~2,   8,   6,   3,  ~7,  ~6,   8,   2,   3,   4,   5,   3,   4,  ~6,   8,   8,  ~1,   4,  ~5,   6,   2,   8,  ~3,  ~9,  ~2,   6,   7],
+             [ 3,  ~4,   0,  ~3,  ~5,   0,  ~2,  ~6,  ~2,   8,   5,  ~9,  ~4,  ~8,  ~6,   0,   8,   9,   1,  ~2,   8,   2,  ~2,   8,   9,   3,   3,   5,  ~9,  ~3,  ~2,   7,   2,   9,   0,   4,   8,  ~9,   0,  ~6,   9,  ~9,   9,  ~4,   8,  ~8,  ~8,   2,  ~3,   2],
+             [~1,   3,  ~9,  ~8,  ~7,   6,  ~6,   3,   0,   5,  ~5,   1,   2,  ~2,  ~3,   7,   7,   3,  ~4,  ~2,  ~9,  ~5,  ~1,   9,   6,   8,   2,   8,   7,  ~3,   4,   6,   6,   0,  ~2,   2,  ~7,  ~7,   6,  ~3,   8,   2,   1,   0,   8,  ~1,   3,   9,   8,   6],
+             [ 1,  ~2,  ~3,   6,   5,   5,  ~6,  ~4,  ~5,   1,   1,   6,  ~7,  ~4,  ~3,   4,   4,  ~8,  ~9,   7,  ~2,  ~3,  ~7,  ~2,   1,   2,   0,   8,  ~6,  ~5,  ~5,   7,   8,   5,  ~2,   3,   9,   0,   5,   1,   3,  ~4,  ~6,   1,   4,  ~9,  ~2,   5,   4,   3],
+             [ 3,   3,   9,  ~2,   6,   9,   4,   9,   4,  ~8,   5,  ~1,   3,  ~2,   1,  ~7,  ~3,   2,   2,   0,  ~3,   3,   8,   2,   0,  ~5,   7,   1,   4,  ~8,   8,  ~9,  ~1,   1,  ~9,  ~4,   5,   2,   2,   8,   6,   1,   6,  ~2,   2,   7,   1,  ~6,  ~1,  ~1],
+             [ 4,  ~2,   4,  ~1,  ~5,  ~1,   5,  ~2,   3,  ~4,  ~5,   0,   2,  ~4,   6,   4,  ~3,   2,   2,   5,  ~6,  ~7,  ~9,  ~1,  ~9,  ~9,   6,   0,   6,   5,   9,  ~1,   3,  ~3,  ~8,   8,  ~8,   8,   4,   5,  ~1,  ~5,   1,   0,   3,  ~2,   5,   6,   6,   5],
+             [~4,   9,   6,   8,  ~9,   5,   5,  ~3,  ~7,   7,   6,   8,  ~8,   0,   4,  ~1,   9,   5,  ~7,   0,  ~1,  ~2,   3,   6,   0,   4,  ~3,   1,   4,   6,   4,   0,   5,  ~1,   7,  ~7,  ~6,  ~8,  ~3,  ~6,   7,  ~1,  ~3,  ~2,  ~3,  ~5,   3,   1,  ~8,  ~9],
+             [~6,   4,  ~5,   9,   9,  ~7,  ~1,  ~8,  ~4,   2,  ~6,   0,  ~6,  ~6,   7,   6,   0,   1,   7,  ~7,   0,  ~4,  ~6,  ~8,  ~9,   5,  ~6,  ~9,   2,  ~7,  ~2,  ~6,   9,   4,  ~5,   0,   4,  ~4,  ~5,   6,   9,   1,  ~6,  ~5,   3,  ~1,   7,  ~7,  ~6,   7],
+             [~8,   7,   7,  ~6,   7,  ~4,   8,   0,  ~9,  ~8,  ~3,   7,  ~3,   3,   8,  ~7,  ~2,  ~7,   5,   5,  ~5,   4,   6,   2,   4,   1,   4,  ~9,  ~3,   8,   8,  ~9,  ~4,  ~2,   1,  ~3,   1,   3,   9,  ~5,  ~8,  ~2,   7,   8,   9,   2,   0,   1,  ~9,   6],
+             [~7,   1,  ~9,   5,  ~5,  ~5,   7,   6,  ~5,  ~9,  ~6,  ~8,  ~6,   9,   7,   9,   0,  ~5,   7,   7,  ~6,   4,   5,  ~9,  ~1,  ~2,  ~7,   3,  ~5,  ~2,  ~5,   5,  ~3,  ~4,  ~2,  ~8,   2,  ~8,   0,  ~8,   0,  ~8,   9,   8,  ~5,  ~5,   1,   3,   5,  ~4],
+             [~8,  ~8,   0,  ~5,  ~8,  ~6,   3,  ~6,  ~4,   6,   1,  ~5,  ~6,  ~8,  ~4,  ~6,  ~2,  ~6,   6,  ~4,   8,   8,   4,  ~5,  ~1,   0,   9,  ~8,  ~3,  ~1,  ~8,   7,  ~3,   0,  ~7,   1,  ~7,  ~1,  ~7,   3,  ~7,   3,  ~4,  ~8,   8,  ~7,  ~9,  ~8,   3,   2],
+             [ 3,   6,   8,  ~9,   7,   1,  ~9,   9,   3,   8,   6,   4,  ~2,   1,  ~8,   4,  ~7,  ~4,  ~3,   3,  ~5,  ~6,  ~7,  ~2,   0,  ~4,   5,   2,   5,   6,   3,  ~8,   2,  ~5,  ~7,   6,   8,  ~2,  ~5,  ~4,   9,   9,   2,  ~2,  ~2,   7,   4,   4,  ~2,   3],
+             [ 6,   6,  ~5,  ~2,  ~8,  ~2,  ~9,   0,   2,   4,  ~6,  ~9,   9,   0,  ~8,  ~3,  ~1,  ~2,  ~1,   6,   8,   2,  ~9,   5,  ~2,   1,   7,  ~6,   5,   1,  ~1,   4,  ~4,  ~7,  ~6,  ~3,  ~8,   2,   2,   5,   5,  ~6,   5,   3,   3,   7,   4,   7,  ~3,  ~9],
+             [~9,   6,  ~4,   1,   3,  ~8,  ~8,  ~8,  ~1,   5,   1,   1,  ~1,   6,   5,   1,  ~1,   5,  ~8,   8,  ~7,  ~5,  ~1,  ~1,   6,  ~8,  ~3,  ~1,  ~2,  ~6,  ~5,  ~5,  ~6,   0,   2,   2,   7,  ~1,  ~5,  ~7,  ~1,  ~3,   7,   6,   0,   2,   4,  ~5,   0,  ~4]]
 
 fun f (x, y) = List.nth (List.nth (table, x), y)
 fun show m = print (Matrix.toString (m, IntInf.toString))
 structure Main =
    struct
       fun snf() =
-	 let val dim = 35
-	    val big = Matrix.map (Matrix.make (dim, dim, f), IntInf.fromInt)
-	    val entry = Matrix.fetch(smithNormalForm big, dim - 1, dim - 1)
-(*	    val _ = print (concat [IntInf.toString entry, "\n"]) *)
-	 in if entry = valOf (IntInf.fromString
-			      "~1027954043102083189860753402541358641712697245")
-	       then ()
-	    else raise Fail "bug"
-	 end
+         let val dim = 35
+            val big = Matrix.map (Matrix.make (dim, dim, f), IntInf.fromInt)
+            val entry = Matrix.fetch(smithNormalForm big, dim - 1, dim - 1)
+(*          val _ = print (concat [IntInf.toString entry, "\n"]) *)
+         in if entry = valOf (IntInf.fromString
+                              "~1027954043102083189860753402541358641712697245")
+               then ()
+            else raise Fail "bug"
+         end
       fun doit n =
-	 let
-	    val rec loop =
-	       fn 0 => ()
-		| n => (snf(); loop(n - 1))
-	 in loop n
-	 end
+         let
+            val rec loop =
+               fn 0 => ()
+                | n => (snf(); loop(n - 1))
+         in loop n
+         end
    end

Modified: mlton/branches/on-20050420-cmm-branch/benchmark/tests/tailfib.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/benchmark/tests/tailfib.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/benchmark/tests/tailfib.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -6,18 +6,18 @@
 structure Main =
    struct
       fun doit() =
-	 if 701408733 <> fib 44
-	    then raise Fail "bug"
-	 else ()
+         if 701408733 <> fib 44
+            then raise Fail "bug"
+         else ()
 
       val doit =
-	fn n =>
-	let
-	  fun loop n =
-	    if n = 0
-	      then ()
-	      else (doit();
-		    loop(n-1))
-	in loop (n * 1000000)
-	end
+        fn n =>
+        let
+          fun loop n =
+            if n = 0
+              then ()
+              else (doit();
+                    loop(n-1))
+        in loop (n * 1000000)
+        end
    end

Modified: mlton/branches/on-20050420-cmm-branch/benchmark/tests/tak.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/benchmark/tests/tak.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/benchmark/tests/tak.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -2,8 +2,8 @@
    if not (y < x)
       then z
    else tak (tak (x - 1, y, z),
-	     tak (y - 1, z, x),
-	     tak (z - 1, x, y))
+             tak (y - 1, z, x),
+             tak (z - 1, x, y))
 
 val rec f =
    fn 0 => ()

Modified: mlton/branches/on-20050420-cmm-branch/benchmark/tests/tensor.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/benchmark/tests/tensor.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/benchmark/tests/tensor.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -44,8 +44,8 @@
 
 3. All advertising materials mentioning features or use of this
    software must display the following acknowledgement:
-	This product includes software developed by Juan Jose
-	Garcia Ripoll.
+        This product includes software developed by Juan Jose
+        Garcia Ripoll.
 
 4. The name of Juan Jose Garcia Ripoll may not be used to endorse
    or promote products derived from this software without
@@ -67,394 +67,394 @@
 
 structure EvalTimer =
     struct
-	local
-	    val TIME = ref (Time.now())
-	in
-	    fun timerOn () =
-		(TIME := Time.now(); ())
-	    fun timerRead () =
-		Time.toMilliseconds(Time.-(Time.now(),!TIME))
-	    fun timerOff () =
-		let val delta = timerRead()
-		in
-		    print "Elapsed: ";
-		    print (LargeInt.toString delta);
-		    print " ms\n"
-		end
-	    fun time f = (timerOn(); f(); timerOff())
-	end
+        local
+            val TIME = ref (Time.now())
+        in
+            fun timerOn () =
+                (TIME := Time.now(); ())
+            fun timerRead () =
+                Time.toMilliseconds(Time.-(Time.now(),!TIME))
+            fun timerOff () =
+                let val delta = timerRead()
+                in
+                    print "Elapsed: ";
+                    print (LargeInt.toString delta);
+                    print " ms\n"
+                end
+            fun time f = (timerOn(); f(); timerOff())
+        end
     end
 structure Loop =
     struct
-	fun all (a, b, f) =
-	    if a > b then
-		true
-	    else if f a then
-		all (a+1, b, f)
-	    else
-		false
+        fun all (a, b, f) =
+            if a > b then
+                true
+            else if f a then
+                all (a+1, b, f)
+            else
+                false
 
-	fun any (a, b, f) =
-	    if a > b then
-		false
-	    else if f a then
-		true
-	    else
-		any (a+1, b, f)
+        fun any (a, b, f) =
+            if a > b then
+                false
+            else if f a then
+                true
+            else
+                any (a+1, b, f)
 
-	fun app (a, b, f) =
-	    if a < b then
-		(f a; app (a+1, b, f))
-	    else
-		()
+        fun app (a, b, f) =
+            if a < b then
+                (f a; app (a+1, b, f))
+            else
+                ()
 
-	fun app' (a, b, d, f) =
-	    if a < b then
-		(f a; app' (a+d, b, d, f))
-	    else
-		()
+        fun app' (a, b, d, f) =
+            if a < b then
+                (f a; app' (a+d, b, d, f))
+            else
+                ()
 
-	fun appi' (a, b, d, f) =
-	    if a < b then
-		(f a; appi' (a+d, b, d, f))
-	    else
-		()
+        fun appi' (a, b, d, f) =
+            if a < b then
+                (f a; appi' (a+d, b, d, f))
+            else
+                ()
     end
 (*
-  INDEX		-Signature-
+  INDEX         -Signature-
 
   Indices are a enumerable finite set of data with an order and a map
   to a continous nonnegative interval of integers.  In the sample
   implementation, Index, each index is a list of integers,
-	[i1,...,in]
+        [i1,...,in]
   and each set of indices is defined by a shape, which has the same
   shape of an index but with each integer incremented by one
-	shape = [k1,...,kn]
-	0 <= i1 < k1
+        shape = [k1,...,kn]
+        0 <= i1 < k1
 
   type storage = RowMajor | ColumnMajor
   order : storage
-	Identifies:
-		1) the underlying algorithms for this structure
-		2) the most significant index
-		3) the index that varies more slowly
-		4) the total order
-	RowMajor means that first index is most significant and varies
-	more slowly, while ColumnMajor means that last index is the most
-	significant and varies more slowly. For instance
-		RowMajor => [0,0]<[0,1]<[1,0]<[1,1] (C, C++, Pascal)
-		ColumnMajor => [0,0]>[1,0]>[0,1]>[1,1] (Fortran)
+        Identifies:
+                1) the underlying algorithms for this structure
+                2) the most significant index
+                3) the index that varies more slowly
+                4) the total order
+        RowMajor means that first index is most significant and varies
+        more slowly, while ColumnMajor means that last index is the most
+        significant and varies more slowly. For instance
+                RowMajor => [0,0]<[0,1]<[1,0]<[1,1] (C, C++, Pascal)
+                ColumnMajor => [0,0]>[1,0]>[0,1]>[1,1] (Fortran)
   last shape
   first shape
-	Returns the last/first index that belongs to the sed defined by
-	'shape'.
+        Returns the last/first index that belongs to the sed defined by
+        'shape'.
   inBounds shape index
-	Checkes whether 'index' belongs to the set defined by 'shape'.
+        Checkes whether 'index' belongs to the set defined by 'shape'.
   toInt shape index
-	As we said, indices can be sorted and mapped to a finite set of
-	integers. 'toInt' obtaines the integer number that corresponds to
-	a certain index.
+        As we said, indices can be sorted and mapped to a finite set of
+        integers. 'toInt' obtaines the integer number that corresponds to
+        a certain index.
   indexer shape
-	It is equivalent to the partial evaluation 'toInt shape' but
-	optimized for 'shape'.
+        It is equivalent to the partial evaluation 'toInt shape' but
+        optimized for 'shape'.
 
   next shape index
   prev shape index
   next' shape index
   prev' shape index
-	Obtain the following or previous index to the one we supply.
-	next and prev return an object of type 'index option' so that
-	if there is no such following/previous, the output is NONE.
-	On the other hand, next'/prev' raise an exception when the
-	output is not well defined and their output is always of type
-	index. next/prev/next'/prev' raise an exception if 'index'
-	does not belong to the set of 'shape'.
+        Obtain the following or previous index to the one we supply.
+        next and prev return an object of type 'index option' so that
+        if there is no such following/previous, the output is NONE.
+        On the other hand, next'/prev' raise an exception when the
+        output is not well defined and their output is always of type
+        index. next/prev/next'/prev' raise an exception if 'index'
+        does not belong to the set of 'shape'.
 
   all shape f
   any shape f
   app shape f
-	Iterates 'f' over every index of the set defined by 'shape'.
-	'all' stops when 'f' first returns false, 'any' stops when
-	'f' first returns true and 'app' does not stop and discards the
-	output of 'f'.
+        Iterates 'f' over every index of the set defined by 'shape'.
+        'all' stops when 'f' first returns false, 'any' stops when
+        'f' first returns true and 'app' does not stop and discards the
+        output of 'f'.
 
   compare(a,b)
-	Returns LESS/GREATER/EQUAL according to the total order which
-	is defined in the set of all indices.
+        Returns LESS/GREATER/EQUAL according to the total order which
+        is defined in the set of all indices.
   <,>,eq,<=,>=,<>
-	Reduced comparisons which are defined in terms of 'compare'.
+        Reduced comparisons which are defined in terms of 'compare'.
 
   validShape t
   validIndex t
-	Checks whether 't' conforms a valid shape or index.
+        Checks whether 't' conforms a valid shape or index.
 
   iteri shape f
 *)
 
 signature INDEX =
     sig
-	type t
-	type indexer = t -> int
-	datatype storage = RowMajor | ColumnMajor
+        type t
+        type indexer = t -> int
+        datatype storage = RowMajor | ColumnMajor
 
-	exception Index
-	exception Shape
+        exception Index
+        exception Shape
 
-	val order : storage
-	val toInt : t -> t -> int
-	val length : t -> int
-	val first : t -> t
-	val last : t -> t
-	val next : t -> t -> t option
-	val prev : t -> t -> t option
-	val next' : t -> t -> t
-	val prev' : t -> t -> t
-	val indexer : t -> (t -> int)
+        val order : storage
+        val toInt : t -> t -> int
+        val length : t -> int
+        val first : t -> t
+        val last : t -> t
+        val next : t -> t -> t option
+        val prev : t -> t -> t option
+        val next' : t -> t -> t
+        val prev' : t -> t -> t
+        val indexer : t -> (t -> int)
 
-	val inBounds : t -> t -> bool
-	val compare : t * t -> order
-	val < : t * t -> bool
-	val > : t * t -> bool
-	val eq : t * t -> bool
-	val <= : t * t -> bool
-	val >= : t * t -> bool
-	val <> : t * t -> bool
-	val - : t * t -> t
+        val inBounds : t -> t -> bool
+        val compare : t * t -> order
+        val < : t * t -> bool
+        val > : t * t -> bool
+        val eq : t * t -> bool
+        val <= : t * t -> bool
+        val >= : t * t -> bool
+        val <> : t * t -> bool
+        val - : t * t -> t
 
-	val validShape : t -> bool
-	val validIndex : t -> bool
+        val validShape : t -> bool
+        val validIndex : t -> bool
 
-	val all : t -> (t -> bool) -> bool
-	val any : t -> (t -> bool) -> bool
-	val app : t -> (t -> unit) -> unit
+        val all : t -> (t -> bool) -> bool
+        val any : t -> (t -> bool) -> bool
+        val app : t -> (t -> unit) -> unit
     end
 structure Index : INDEX =
     struct
-	type t = int list
-	type indexer = t -> int
-	datatype storage = RowMajor | ColumnMajor
+        type t = int list
+        type indexer = t -> int
+        datatype storage = RowMajor | ColumnMajor
 
-	exception Index
-	exception Shape
+        exception Index
+        exception Shape
 
-	val order = ColumnMajor
+        val order = ColumnMajor
 
-	fun validShape shape = List.all (fn x => x > 0) shape
+        fun validShape shape = List.all (fn x => x > 0) shape
 
-	fun validIndex index = List.all (fn x => x >= 0) index
+        fun validIndex index = List.all (fn x => x >= 0) index
 
-	fun toInt shape index =
-	    let fun loop ([], [], accum, _) = accum
-		  | loop ([], _, _, _) = raise Index
-		  | loop (_, [], _, _) = raise Index
-		  | loop (i::ri, l::rl, accum, fac) =
-		if (i >= 0) andalso (i < l) then
-		    loop (ri, rl, i*fac + accum, fac*l)
-		else
-		    raise Index
-	    in loop (index, shape, 0, 1)
-	    end
+        fun toInt shape index =
+            let fun loop ([], [], accum, _) = accum
+                  | loop ([], _, _, _) = raise Index
+                  | loop (_, [], _, _) = raise Index
+                  | loop (i::ri, l::rl, accum, fac) =
+                if (i >= 0) andalso (i < l) then
+                    loop (ri, rl, i*fac + accum, fac*l)
+                else
+                    raise Index
+            in loop (index, shape, 0, 1)
+            end
 
-	(* ----- CACHED LINEAR INDEXER -----
+        (* ----- CACHED LINEAR INDEXER -----
 
-	   An indexer is a function that takes a list of
-	   indices, validates it and produces a nonnegative
-	   integer number. In short, the indexer is the
-	   mapper from indices to element positions in
-	   arrays.
+           An indexer is a function that takes a list of
+           indices, validates it and produces a nonnegative
+           integer number. In short, the indexer is the
+           mapper from indices to element positions in
+           arrays.
 
-	   'indexer' builds such a mapper by optimizing
-	   the most common cases, which are 1d and 2d
-	   tensors.
-	 *)
+           'indexer' builds such a mapper by optimizing
+           the most common cases, which are 1d and 2d
+           tensors.
+         *)
     local
-	fun doindexer [] _ = raise Shape
-	  | doindexer [a] [dx] =
-	    let fun f [x] = if (x > 0) andalso (x < a)
-		            then x
-			    else raise Index
-		  | f _ = raise Index
-	    in f end
-	  | doindexer [a,b] [dx, dy] =
-	    let fun f [x,y] = if ((x > 0) andalso (x < a) andalso
-				  (y > 0) andalso (y < b))
-			      then x + dy * y
-			      else raise Index
-		  | f _ = raise Index
-	    in f end
-	  | doindexer [a,b,c] [dx,dy,dz] =
-	    let fun f [x,y,z] = if ((x > 0) andalso (x < a) andalso
-				    (y > 0) andalso (y < b) andalso
-				    (z > 0) andalso (z < c))
-				then x + dy * y + dz * z
-				else raise Index
-		  | f _ = raise Index
-	    in f end
-	  | doindexer shape memo =
-	    let fun f [] [] accum [] = accum
-		  | f _  _  _ [] = raise Index
-		  | f (fac::rf) (ndx::ri) accum (dim::rd) =
-		    if (ndx >= 0) andalso (ndx < dim) then
-			f rf ri (accum + ndx * fac) rd
-		    else
-			raise Index
-	    in f shape memo 0
-	    end
+        fun doindexer [] _ = raise Shape
+          | doindexer [a] [dx] =
+            let fun f [x] = if (x > 0) andalso (x < a)
+                            then x
+                            else raise Index
+                  | f _ = raise Index
+            in f end
+          | doindexer [a,b] [dx, dy] =
+            let fun f [x,y] = if ((x > 0) andalso (x < a) andalso
+                                  (y > 0) andalso (y < b))
+                              then x + dy * y
+                              else raise Index
+                  | f _ = raise Index
+            in f end
+          | doindexer [a,b,c] [dx,dy,dz] =
+            let fun f [x,y,z] = if ((x > 0) andalso (x < a) andalso
+                                    (y > 0) andalso (y < b) andalso
+                                    (z > 0) andalso (z < c))
+                                then x + dy * y + dz * z
+                                else raise Index
+                  | f _ = raise Index
+            in f end
+          | doindexer shape memo =
+            let fun f [] [] accum [] = accum
+                  | f _  _  _ [] = raise Index
+                  | f (fac::rf) (ndx::ri) accum (dim::rd) =
+                    if (ndx >= 0) andalso (ndx < dim) then
+                        f rf ri (accum + ndx * fac) rd
+                    else
+                        raise Index
+            in f shape memo 0
+            end
     in
-	fun indexer shape =
-	    let fun memoize accum [] = []
-		  | memoize accum (dim::rd) =
-		    accum :: (memoize (dim * accum) rd)
-	    in
-		if validShape shape
-		then doindexer shape (memoize 1 shape)
-		else raise Shape
-	    end
+        fun indexer shape =
+            let fun memoize accum [] = []
+                  | memoize accum (dim::rd) =
+                    accum :: (memoize (dim * accum) rd)
+            in
+                if validShape shape
+                then doindexer shape (memoize 1 shape)
+                else raise Shape
+            end
     end
 
-	fun length shape =
-	    let fun prod (a,b) =
-		if b < 0 then raise Shape else a * b
-	    in foldl prod 1 shape
-	    end
+        fun length shape =
+            let fun prod (a,b) =
+                if b < 0 then raise Shape else a * b
+            in foldl prod 1 shape
+            end
 
-	fun first shape = map (fn x => 0) shape
+        fun first shape = map (fn x => 0) shape
 
-	fun last [] = []
-	  | last (size :: rest) =
-	    if size < 1
-	    then raise Shape
-	    else size - 1 :: last rest
+        fun last [] = []
+          | last (size :: rest) =
+            if size < 1
+            then raise Shape
+            else size - 1 :: last rest
 
-	fun next' [] [] = raise Subscript
-	  | next' _ [] = raise Index
-	  | next' [] _ = raise Index
-	  | next' (dimension::restd) (index::resti) =
-	    if (index + 1) < dimension
-	    then (index + 1) :: resti
-	    else 0 :: (next' restd resti)
+        fun next' [] [] = raise Subscript
+          | next' _ [] = raise Index
+          | next' [] _ = raise Index
+          | next' (dimension::restd) (index::resti) =
+            if (index + 1) < dimension
+            then (index + 1) :: resti
+            else 0 :: (next' restd resti)
 
-	fun prev' [] [] = raise Subscript
-	  | prev' _ [] = raise Index
-	  | prev' [] _ = raise Index
-	  | prev' (dimension::restd) (index::resti) =
-	    if (index > 0)
-	    then index - 1 :: resti
-	    else dimension - 1 :: prev' restd resti
+        fun prev' [] [] = raise Subscript
+          | prev' _ [] = raise Index
+          | prev' [] _ = raise Index
+          | prev' (dimension::restd) (index::resti) =
+            if (index > 0)
+            then index - 1 :: resti
+            else dimension - 1 :: prev' restd resti
 
-	fun next shape index = (SOME (next' shape index)) handle
-	    Subscript => NONE
+        fun next shape index = (SOME (next' shape index)) handle
+            Subscript => NONE
 
-	fun prev shape index = (SOME (prev' shape index)) handle
-	    Subscript => NONE
+        fun prev shape index = (SOME (prev' shape index)) handle
+            Subscript => NONE
 
-	fun inBounds shape index =
-	    ListPair.all (fn (x,y) => (x >= 0) andalso (x < y))
-	    (index, shape)
+        fun inBounds shape index =
+            ListPair.all (fn (x,y) => (x >= 0) andalso (x < y))
+            (index, shape)
 
-	fun compare ([],[]) = EQUAL
-	  | compare (_, []) = raise Index
-	  | compare ([],_) = raise Index
-	  | compare (a::ra, b::rb) =
-	    case Int.compare (a,b) of
-		EQUAL => compare (ra,rb)
-	      | LESS => LESS
-	      | GREATER => GREATER
+        fun compare ([],[]) = EQUAL
+          | compare (_, []) = raise Index
+          | compare ([],_) = raise Index
+          | compare (a::ra, b::rb) =
+            case Int.compare (a,b) of
+                EQUAL => compare (ra,rb)
+              | LESS => LESS
+              | GREATER => GREATER
 
     local
-	fun iterator a inner =
-	    let fun loop accum f =
-		let fun innerloop i =
-		    if i < a
-		    then if inner (i::accum) f
-			 then innerloop (i+1)
-			 else false
-		    else true
-		in innerloop 0
-		end
-	    in loop
-	    end
-	fun build_iterator [a] =
-	    let fun loop accum f =
-		let fun innerloop i =
-		    if i < a
-		    then if f (i::accum)
-			 then innerloop (i+1)
-			 else false
-		    else true
-		in innerloop 0
-		end
-	    in loop
-	    end
-	  | build_iterator (a::rest) = iterator a (build_iterator rest)
+        fun iterator a inner =
+            let fun loop accum f =
+                let fun innerloop i =
+                    if i < a
+                    then if inner (i::accum) f
+                         then innerloop (i+1)
+                         else false
+                    else true
+                in innerloop 0
+                end
+            in loop
+            end
+        fun build_iterator [a] =
+            let fun loop accum f =
+                let fun innerloop i =
+                    if i < a
+                    then if f (i::accum)
+                         then innerloop (i+1)
+                         else false
+                    else true
+                in innerloop 0
+                end
+            in loop
+            end
+          | build_iterator (a::rest) = iterator a (build_iterator rest)
     in
-	fun all shape = build_iterator shape []
+        fun all shape = build_iterator shape []
     end
 
     local
-	fun iterator a inner =
-	    let fun loop accum f =
-		let fun innerloop i =
-		    if i < a
-		    then if inner (i::accum) f
-			 then true
-			 else innerloop (i+1)
-		    else false
-		in innerloop 0
-		end
-	    in loop
-	    end
-	fun build_iterator [a] =
-	    let fun loop accum f =
-		let fun innerloop i =
-		    if i < a
-		    then if f (i::accum)
-			 then true
-			 else innerloop (i+1)
-		    else false
-		in innerloop 0
-		end
-	    in loop
-	    end
-	  | build_iterator (a::rest) = iterator a (build_iterator rest)
+        fun iterator a inner =
+            let fun loop accum f =
+                let fun innerloop i =
+                    if i < a
+                    then if inner (i::accum) f
+                         then true
+                         else innerloop (i+1)
+                    else false
+                in innerloop 0
+                end
+            in loop
+            end
+        fun build_iterator [a] =
+            let fun loop accum f =
+                let fun innerloop i =
+                    if i < a
+                    then if f (i::accum)
+                         then true
+                         else innerloop (i+1)
+                    else false
+                in innerloop 0
+                end
+            in loop
+            end
+          | build_iterator (a::rest) = iterator a (build_iterator rest)
     in
-	fun any shape = build_iterator shape []
+        fun any shape = build_iterator shape []
     end
 
     local
-	fun iterator a inner =
-	    let fun loop accum f =
-		let fun innerloop i =
-		    if i < a
-		    then (inner (i::accum) f;
-			  innerloop (i+1))
-		    else ()
-		in innerloop 0
-		end
-	    in loop
-	    end
-	fun build_iterator [a] =
-	    let fun loop accum f =
-		let fun innerloop i =
-		    if i < a
-		    then (f (i::accum); innerloop (i+1))
-		    else ()
-		in innerloop 0
-		end
-	    in loop
-	    end
-	  | build_iterator (a::rest) = iterator a (build_iterator rest)
+        fun iterator a inner =
+            let fun loop accum f =
+                let fun innerloop i =
+                    if i < a
+                    then (inner (i::accum) f;
+                          innerloop (i+1))
+                    else ()
+                in innerloop 0
+                end
+            in loop
+            end
+        fun build_iterator [a] =
+            let fun loop accum f =
+                let fun innerloop i =
+                    if i < a
+                    then (f (i::accum); innerloop (i+1))
+                    else ()
+                in innerloop 0
+                end
+            in loop
+            end
+          | build_iterator (a::rest) = iterator a (build_iterator rest)
     in
-	fun app shape = build_iterator shape []
+        fun app shape = build_iterator shape []
     end
 
-	fun a < b = compare(a,b) = LESS
-	fun a > b = compare(a,b) = GREATER
-	fun eq (a, b) = compare(a,b) = EQUAL
-	fun a <> b = not (a = b)
-	fun a <= b = not (a > b)
-	fun a >= b = not (a < b)
-	fun a - b = ListPair.map Int.- (a,b)
+        fun a < b = compare(a,b) = LESS
+        fun a > b = compare(a,b) = GREATER
+        fun eq (a, b) = compare(a,b) = EQUAL
+        fun a <> b = not (a = b)
+        fun a <= b = not (a > b)
+        fun a >= b = not (a < b)
+        fun a - b = ListPair.map Int.- (a,b)
 
     end
 (*
@@ -465,85 +465,85 @@
 *)
 
 (*
- TENSOR		- Signature -
+ TENSOR         - Signature -
 
  Polymorphic tensors of any type. With 'tensor' we denote a (mutable)
  array of any rank, with as many indices as one wishes, and that may
  be traversed (map, fold, etc) according to any of those indices.
 
  type 'a tensor
-	Polymorphic tensor whose elements are all of type 'a.
+        Polymorphic tensor whose elements are all of type 'a.
  val storage = RowMajor | ColumnMajor
-	RowMajor = data is stored in consecutive cells, first index
-	varying fastest (FORTRAN convention)
-	ColumnMajor = data is stored in consecutive cells, last
-	index varying fastest (C,C++,Pascal,CommonLisp convention)
+        RowMajor = data is stored in consecutive cells, first index
+        varying fastest (FORTRAN convention)
+        ColumnMajor = data is stored in consecutive cells, last
+        index varying fastest (C,C++,Pascal,CommonLisp convention)
  new ([i1,...,in],init)
-	Build a new tensor with n indices, each of sizes i1...in,
-	filled with 'init'.
+        Build a new tensor with n indices, each of sizes i1...in,
+        filled with 'init'.
  fromArray (shape,data)
  fromList (shape,data)
-	Use 'data' to fill a tensor of that shape. An exception is
-	raised if 'data' is too large or too small to properly
-	fill the vector. Later use of a 'data' array is disregarded
-	-- one must think that the tensor now owns the array.
+        Use 'data' to fill a tensor of that shape. An exception is
+        raised if 'data' is too large or too small to properly
+        fill the vector. Later use of a 'data' array is disregarded
+        -- one must think that the tensor now owns the array.
  length tensor
  rank tensor
  shape tensor
-	Return the number of elements, the number of indices and
-	the shape (size of each index) of the tensor.
+        Return the number of elements, the number of indices and
+        the shape (size of each index) of the tensor.
  toArray tensor
-	Return the data of the tensor in the form of an array.
-	Mutation of this array may lead to unexpected behavior.
+        Return the data of the tensor in the form of an array.
+        Mutation of this array may lead to unexpected behavior.
 
  sub (tensor,[i1,...,in])
  update (tensor,[i1,...,in],new_value)
-	Access the element that is indexed by the numbers [i1,..,in]
+        Access the element that is indexed by the numbers [i1,..,in]
 
  app f a
  appi f a
-	The same as 'map' and 'mapi' but the function 'f' outputs
-	nothing and no new array is produced, i.e. one only seeks
-	the side effect that 'f' may produce.
+        The same as 'map' and 'mapi' but the function 'f' outputs
+        nothing and no new array is produced, i.e. one only seeks
+        the side effect that 'f' may produce.
  map2 operation a b
-	Apply function 'f' to pairs of elements of 'a' and 'b'
-	and build a new tensor with the output. Both operands
-	must have the same shape or an exception is raised.
-	The procedure is sequential, as specified by 'storage'.
+        Apply function 'f' to pairs of elements of 'a' and 'b'
+        and build a new tensor with the output. Both operands
+        must have the same shape or an exception is raised.
+        The procedure is sequential, as specified by 'storage'.
  foldl operation a n
-	Fold-left the elements of tensor 'a' along the n-th
-	index.
+        Fold-left the elements of tensor 'a' along the n-th
+        index.
  all test a
  any test a
-	Folded boolean tests on the elements of the tensor.
+        Folded boolean tests on the elements of the tensor.
 *)
 
 signature TENSOR =
     sig
-	structure Array : ARRAY
-	structure Index : INDEX
-	type index = Index.t
-	type 'a tensor
+        structure Array : ARRAY
+        structure Index : INDEX
+        type index = Index.t
+        type 'a tensor
 
-	val new : index * 'a -> 'a tensor
-	val tabulate : index * (index -> 'a) -> 'a tensor
-	val length : 'a tensor -> int
-	val rank : 'a tensor -> int
-	val shape : 'a tensor -> (index)
-	val reshape : index -> 'a tensor -> 'a tensor
-	val fromList : index * 'a list -> 'a tensor
-	val fromArray : index * 'a array -> 'a tensor
-	val toArray : 'a tensor -> 'a array
+        val new : index * 'a -> 'a tensor
+        val tabulate : index * (index -> 'a) -> 'a tensor
+        val length : 'a tensor -> int
+        val rank : 'a tensor -> int
+        val shape : 'a tensor -> (index)
+        val reshape : index -> 'a tensor -> 'a tensor
+        val fromList : index * 'a list -> 'a tensor
+        val fromArray : index * 'a array -> 'a tensor
+        val toArray : 'a tensor -> 'a array
 
-	val sub : 'a tensor * index -> 'a
-	val update : 'a tensor * index * 'a -> unit
-	val map : ('a -> 'b) -> 'a tensor -> 'b tensor
-	val map2 : ('a * 'b -> 'c) -> 'a tensor -> 'b tensor -> 'c tensor
-	val app : ('a -> unit) -> 'a tensor -> unit
-	val appi : (int * 'a -> unit) -> 'a tensor -> unit
-	val foldl : ('c * 'a -> 'c) -> 'c -> 'a tensor -> int -> 'c tensor
-	val all : ('a -> bool) -> 'a tensor -> bool
-	val any : ('a -> bool) -> 'a tensor -> bool
+        val sub : 'a tensor * index -> 'a
+        val update : 'a tensor * index * 'a -> unit
+        val map : ('a -> 'b) -> 'a tensor -> 'b tensor
+        val map2 : ('a * 'b -> 'c) -> 'a tensor -> 'b tensor -> 'c tensor
+        val app : ('a -> unit) -> 'a tensor -> unit
+        val appi : (int * 'a -> unit) -> 'a tensor -> unit
+        val foldl : ('c * 'a -> 'c) -> 'c -> 'a tensor -> int -> 'c tensor
+        val all : ('a -> bool) -> 'a tensor -> bool
+        val any : ('a -> bool) -> 'a tensor -> bool
     end
 
 (*
@@ -555,152 +555,152 @@
 
 structure Tensor : TENSOR =
     struct
-	structure Array = Array
-	structure Index = Index
-	    
-	type index = Index.t
-	type 'a tensor = {shape : index, indexer : Index.indexer, data : 'a array}
+        structure Array = Array
+        structure Index = Index
+            
+        type index = Index.t
+        type 'a tensor = {shape : index, indexer : Index.indexer, data : 'a array}
 
-	exception Shape
-	exception Match
-	exception Index
+        exception Shape
+        exception Match
+        exception Index
 
     local
     (*----- LOCALS -----*)
 
-	fun make' (shape, data) =
-	    {shape = shape, indexer = Index.indexer shape, data = data}
+        fun make' (shape, data) =
+            {shape = shape, indexer = Index.indexer shape, data = data}
 
-	fun toInt {shape, indexer, data} index = indexer index
+        fun toInt {shape, indexer, data} index = indexer index
 
-	fun array_map f a =
-	    let fun apply index = f(Array.sub(a,index)) in
-		Array.tabulate(Array.length a, apply)
-	    end
+        fun array_map f a =
+            let fun apply index = f(Array.sub(a,index)) in
+                Array.tabulate(Array.length a, apply)
+            end
 
-	fun splitList (l as (a::rest), place) =
-	    let fun loop (left,here,right) 0 =  (List.rev left,here,right)
-		  | loop (_,_,[]) place = raise Index
-		  | loop (left,here,a::right) place = 
-		loop (here::left,a,right) (place-1)
-	    in
-		if place <= 0 then
-		    loop ([],a,rest) (List.length rest - place)
-		else
-		    loop ([],a,rest) (place - 1)
-	    end
+        fun splitList (l as (a::rest), place) =
+            let fun loop (left,here,right) 0 =  (List.rev left,here,right)
+                  | loop (_,_,[]) place = raise Index
+                  | loop (left,here,a::right) place = 
+                loop (here::left,a,right) (place-1)
+            in
+                if place <= 0 then
+                    loop ([],a,rest) (List.length rest - place)
+                else
+                    loop ([],a,rest) (place - 1)
+            end
 
     in
     (*----- STRUCTURAL OPERATIONS & QUERIES ------*)
 
-	fun new (shape, init) =
-	    if not (Index.validShape shape) then
-		raise Shape
-	    else
-		let val length = Index.length shape in
-		    {shape = shape,
-		     indexer = Index.indexer shape,
-		     data = Array.array(length,init)}
-		end
+        fun new (shape, init) =
+            if not (Index.validShape shape) then
+                raise Shape
+            else
+                let val length = Index.length shape in
+                    {shape = shape,
+                     indexer = Index.indexer shape,
+                     data = Array.array(length,init)}
+                end
 
-	fun toArray {shape, indexer, data} = data
+        fun toArray {shape, indexer, data} = data
 
-	fun length {shape, indexer, data} =  Array.length data
+        fun length {shape, indexer, data} =  Array.length data
 
-	fun shape {shape, indexer, data} = shape
+        fun shape {shape, indexer, data} = shape
 
-	fun rank t = List.length (shape t)
+        fun rank t = List.length (shape t)
 
-	fun reshape new_shape tensor =
-	    if Index.validShape new_shape then
-		case (Index.length new_shape) = length tensor of
-		    true => make'(new_shape, toArray tensor)
-		  | false => raise Match
-	    else
-		raise Shape
+        fun reshape new_shape tensor =
+            if Index.validShape new_shape then
+                case (Index.length new_shape) = length tensor of
+                    true => make'(new_shape, toArray tensor)
+                  | false => raise Match
+            else
+                raise Shape
 
-	fun fromArray (s, a) =
-	    case Index.validShape s andalso 
-		 ((Index.length s) = (Array.length a)) of
-		 true => make'(s, a)
-	       | false => raise Shape
+        fun fromArray (s, a) =
+            case Index.validShape s andalso 
+                 ((Index.length s) = (Array.length a)) of
+                 true => make'(s, a)
+               | false => raise Shape
 
-	fun fromList (s, a) = fromArray (s, Array.fromList a)
+        fun fromList (s, a) = fromArray (s, Array.fromList a)
 
-	fun tabulate (shape,f) =
-	    if Index.validShape shape then
-		let val last = Index.last shape
-		    val length = Index.length shape
-		    val c = Array.array(length, f last)
-		    fun dotable (c, indices, i) =
-			(Array.update(c, i, f indices);
-			 case i of
-			     0 => c
-			   | i => dotable(c, Index.prev' shape indices, i-1))
-		in
-		    make'(shape,dotable(c, Index.prev' shape last, length-1))
-		end
-	    else
-		raise Shape
+        fun tabulate (shape,f) =
+            if Index.validShape shape then
+                let val last = Index.last shape
+                    val length = Index.length shape
+                    val c = Array.array(length, f last)
+                    fun dotable (c, indices, i) =
+                        (Array.update(c, i, f indices);
+                         case i of
+                             0 => c
+                           | i => dotable(c, Index.prev' shape indices, i-1))
+                in
+                    make'(shape,dotable(c, Index.prev' shape last, length-1))
+                end
+            else
+                raise Shape
 
-	(*----- ELEMENTWISE OPERATIONS -----*)
+        (*----- ELEMENTWISE OPERATIONS -----*)
 
-	fun sub (t, index) = Array.sub(#data t, toInt t index)
+        fun sub (t, index) = Array.sub(#data t, toInt t index)
 
-	fun update (t, index, value) =
-	    Array.update(toArray t, toInt t index, value)
+        fun update (t, index, value) =
+            Array.update(toArray t, toInt t index, value)
 
-	fun map f {shape, indexer, data} =
-	    {shape = shape, indexer = indexer, data = array_map f data}
+        fun map f {shape, indexer, data} =
+            {shape = shape, indexer = indexer, data = array_map f data}
 
-	fun map2 f t1 t2=
-	    let val {shape, indexer, data} = t1
-		val {shape=shape2, indexer=indexer2, data=data2} = t2
-		fun apply i = f (Array.sub(data,i), Array.sub(data2,i))
-		val len = Array.length data
-	    in
-		if Index.eq(shape, shape2) then
-		    {shape = shape,
-		     indexer = indexer,
-		     data = Array.tabulate(len, apply)}
-		else
-		    raise Match
-	end
+        fun map2 f t1 t2=
+            let val {shape, indexer, data} = t1
+                val {shape=shape2, indexer=indexer2, data=data2} = t2
+                fun apply i = f (Array.sub(data,i), Array.sub(data2,i))
+                val len = Array.length data
+            in
+                if Index.eq(shape, shape2) then
+                    {shape = shape,
+                     indexer = indexer,
+                     data = Array.tabulate(len, apply)}
+                else
+                    raise Match
+        end
 
-	fun appi f tensor = Array.appi f (toArray tensor)
+        fun appi f tensor = Array.appi f (toArray tensor)
 
-	fun app f tensor = Array.app f (toArray tensor)
+        fun app f tensor = Array.app f (toArray tensor)
 
-	fun all f tensor =
-	    let val a = toArray tensor
-	    in Loop.all(0, length tensor - 1, fn i =>
-			f (Array.sub(a, i)))
-	    end
+        fun all f tensor =
+            let val a = toArray tensor
+            in Loop.all(0, length tensor - 1, fn i =>
+                        f (Array.sub(a, i)))
+            end
 
-	fun any f tensor =
-	    let val a = toArray tensor
-	    in Loop.any(0, length tensor - 1, fn i =>
-			f (Array.sub(a, i)))
-	    end
+        fun any f tensor =
+            let val a = toArray tensor
+            in Loop.any(0, length tensor - 1, fn i =>
+                        f (Array.sub(a, i)))
+            end
 
-	fun foldl f init {shape, indexer, data=a} index =
-	    let val (head,lk,tail) = splitList(shape, index)
-		val li = Index.length head
-		val lj = Index.length tail
-		val c = Array.array(li * lj,init)
-		fun loopi (0, _,  _)  = ()
-		  | loopi (i, ia, ic) =
-		    (Array.update(c, ic, f(Array.sub(c,ic), Array.sub(a,ia)));
-		     loopi (i-1, ia+1, ic+1))
-		fun loopk (0, ia, _)  = ia
-		  | loopk (k, ia, ic) = (loopi (li, ia, ic);
-					 loopk (k-1, ia+li, ic))
-		fun loopj (0, _,  _)  = ()
-		  | loopj (j, ia, ic) = loopj (j-1, loopk(lk,ia,ic), ic+li)
-	    in
-		loopj (lj, 0, 0);
-		make'(head @ tail, c)
-	    end
+        fun foldl f init {shape, indexer, data=a} index =
+            let val (head,lk,tail) = splitList(shape, index)
+                val li = Index.length head
+                val lj = Index.length tail
+                val c = Array.array(li * lj,init)
+                fun loopi (0, _,  _)  = ()
+                  | loopi (i, ia, ic) =
+                    (Array.update(c, ic, f(Array.sub(c,ic), Array.sub(a,ia)));
+                     loopi (i-1, ia+1, ic+1))
+                fun loopk (0, ia, _)  = ia
+                  | loopk (k, ia, ic) = (loopi (li, ia, ic);
+                                         loopk (k-1, ia+li, ic))
+                fun loopj (0, _,  _)  = ()
+                  | loopj (j, ia, ic) = loopj (j-1, loopk(lk,ia,ic), ic+li)
+            in
+                loopj (lj, 0, 0);
+                make'(head @ tail, c)
+            end
 
     end
     end (* Tensor *)
@@ -713,108 +713,108 @@
 *)
 
 (*
- MONO_TENSOR		- signature -
+ MONO_TENSOR            - signature -
 
  Monomorphic tensor of arbitrary data (not only numbers). Operations
  should be provided to run the data in several ways, according to one
  index.
 
  type tensor
-	The type of the tensor itself
+        The type of the tensor itself
  type elem
-	The type of every element
+        The type of every element
  val storage = RowMajor | ColumnMajor
-	RowMajor = data is stored in consecutive cells, first index
-	varying fastest (FORTRAN convention)
-	ColumnMajor = data is stored in consecutive cells, last
-	index varying fastest (C,C++,Pascal,CommonLisp convention)
+        RowMajor = data is stored in consecutive cells, first index
+        varying fastest (FORTRAN convention)
+        ColumnMajor = data is stored in consecutive cells, last
+        index varying fastest (C,C++,Pascal,CommonLisp convention)
  new ([i1,...,in],init)
-	Build a new tensor with n indices, each of sizes i1...in,
-	filled with 'init'.
+        Build a new tensor with n indices, each of sizes i1...in,
+        filled with 'init'.
  fromArray (shape,data)
  fromList (shape,data)
-	Use 'data' to fill a tensor of that shape. An exception is
-	raised if 'data' is too large or too small to properly
-	fill the vector. Later use of a 'data' array is disregarded
-	-- one must think that the tensor now owns the array.
+        Use 'data' to fill a tensor of that shape. An exception is
+        raised if 'data' is too large or too small to properly
+        fill the vector. Later use of a 'data' array is disregarded
+        -- one must think that the tensor now owns the array.
  length tensor
  rank tensor
  shape tensor
-	Return the number of elements, the number of indices and
-	the shape (size of each index) of the tensor.
+        Return the number of elements, the number of indices and
+        the shape (size of each index) of the tensor.
  toArray tensor
-	Return the data of the tensor in the form of an array.
-	Mutation of this array may lead to unexpected behavior.
-	The data in the array is stored according to `storage'.
+        Return the data of the tensor in the form of an array.
+        Mutation of this array may lead to unexpected behavior.
+        The data in the array is stored according to `storage'.
 
  sub (tensor,[i1,...,in])
  update (tensor,[i1,...,in],new_value)
-	Access the element that is indexed by the numbers [i1,..,in]
+        Access the element that is indexed by the numbers [i1,..,in]
 
  map f a
  mapi f a
-	Produce a new array by mapping the function sequentially
-	as specified by 'storage', to each element of tensor 'a'.
-	In 'mapi' the function receives a (indices,value) tuple,
-	while in 'map' it only receives the value.
+        Produce a new array by mapping the function sequentially
+        as specified by 'storage', to each element of tensor 'a'.
+        In 'mapi' the function receives a (indices,value) tuple,
+        while in 'map' it only receives the value.
  app f a
  appi f a
-	The same as 'map' and 'mapi' but the function 'f' outputs
-	nothing and no new array is produced, i.e. one only seeks
-	the side effect that 'f' may produce.
+        The same as 'map' and 'mapi' but the function 'f' outputs
+        nothing and no new array is produced, i.e. one only seeks
+        the side effect that 'f' may produce.
  map2 operation a b
-	Apply function 'f' to pairs of elements of 'a' and 'b'
-	and build a new tensor with the output. Both operands
-	must have the same shape or an exception is raised.
-	The procedure is sequential, as specified by 'storage'.
+        Apply function 'f' to pairs of elements of 'a' and 'b'
+        and build a new tensor with the output. Both operands
+        must have the same shape or an exception is raised.
+        The procedure is sequential, as specified by 'storage'.
  foldl operation a n
-	Fold-left the elements of tensor 'a' along the n-th
-	index.
+        Fold-left the elements of tensor 'a' along the n-th
+        index.
  all test a
  any test a
-	Folded boolean tests on the elements of the tensor.
+        Folded boolean tests on the elements of the tensor.
 
  map', map2', foldl'
-	Polymorphic versions of map, map2, foldl.
+        Polymorphic versions of map, map2, foldl.
 *)
 
 signature MONO_TENSOR =
     sig
-	structure Array : MONO_ARRAY
-	structure Index : INDEX
-	type index = Index.t
-	type elem
-	type tensor
-	type t = tensor
+        structure Array : MONO_ARRAY
+        structure Index : INDEX
+        type index = Index.t
+        type elem
+        type tensor
+        type t = tensor
 
-	val new : index * elem -> tensor
-	val tabulate : index * (index -> elem) -> tensor
-	val length : tensor -> int
-	val rank : tensor -> int
-	val shape : tensor -> (index)
-	val reshape : index -> tensor -> tensor
-	val fromList : index * elem list -> tensor
-	val fromArray : index * Array.array -> tensor
-	val toArray : tensor -> Array.array
+        val new : index * elem -> tensor
+        val tabulate : index * (index -> elem) -> tensor
+        val length : tensor -> int
+        val rank : tensor -> int
+        val shape : tensor -> (index)
+        val reshape : index -> tensor -> tensor
+        val fromList : index * elem list -> tensor
+        val fromArray : index * Array.array -> tensor
+        val toArray : tensor -> Array.array
 
-	val sub : tensor * index -> elem
-	val update : tensor * index * elem -> unit
-	val map : (elem -> elem) -> tensor -> tensor
-	val map2 : (elem * elem -> elem) -> tensor -> tensor -> tensor
-	val app : (elem -> unit) -> tensor -> unit
-	val appi : (int * elem -> unit) -> tensor -> unit
-	val foldl : (elem * 'a -> 'a) -> 'a -> tensor -> tensor
-	val foldln : (elem * elem -> elem) -> elem -> tensor -> int -> tensor
-	val all : (elem -> bool) -> tensor -> bool
-	val any : (elem -> bool) -> tensor -> bool
+        val sub : tensor * index -> elem
+        val update : tensor * index * elem -> unit
+        val map : (elem -> elem) -> tensor -> tensor
+        val map2 : (elem * elem -> elem) -> tensor -> tensor -> tensor
+        val app : (elem -> unit) -> tensor -> unit
+        val appi : (int * elem -> unit) -> tensor -> unit
+        val foldl : (elem * 'a -> 'a) -> 'a -> tensor -> tensor
+        val foldln : (elem * elem -> elem) -> elem -> tensor -> int -> tensor
+        val all : (elem -> bool) -> tensor -> bool
+        val any : (elem -> bool) -> tensor -> bool
 
-	val map' : (elem -> 'a) -> tensor -> 'a Tensor.tensor
-	val map2' : (elem * elem -> 'a) -> tensor -> tensor -> 'a Tensor.tensor
-	val foldl' : ('a * elem -> 'a) -> 'a -> tensor -> int -> 'a Tensor.tensor
+        val map' : (elem -> 'a) -> tensor -> 'a Tensor.tensor
+        val map2' : (elem * elem -> 'a) -> tensor -> tensor -> 'a Tensor.tensor
+        val foldl' : ('a * elem -> 'a) -> 'a -> tensor -> int -> 'a Tensor.tensor
     end
 
 (*
- NUMBER		- Signature -
+ NUMBER         - Signature -
 
  Guarantees a structure with a minimal number of mathematical operations
  so as to build an algebraic structure named Tensor.
@@ -822,203 +822,203 @@
 
 signature NUMBER =
     sig
-	type t
-	val zero : t
-	val one  : t
-	val ~ : t -> t
-	val + : t * t -> t
-	val - : t * t -> t
-	val * : t * t -> t
-	val / : t * t -> t
-	val toString : t -> string
+        type t
+        val zero : t
+        val one  : t
+        val ~ : t -> t
+        val + : t * t -> t
+        val - : t * t -> t
+        val * : t * t -> t
+        val / : t * t -> t
+        val toString : t -> string
     end
 
 signature NUMBER =
     sig
-	type t
-	val zero : t
-	val one : t
+        type t
+        val zero : t
+        val one : t
 
-	val + : t * t -> t
-	val - : t * t -> t
-	val * : t * t -> t
-	val *+ : t * t * t -> t
-	val *- : t * t * t -> t
-	val ** : t * int -> t
+        val + : t * t -> t
+        val - : t * t -> t
+        val * : t * t -> t
+        val *+ : t * t * t -> t
+        val *- : t * t * t -> t
+        val ** : t * int -> t
 
-	val ~ : t -> t
-	val abs : t -> t
-	val signum : t -> t
+        val ~ : t -> t
+        val abs : t -> t
+        val signum : t -> t
 
-	val == : t * t -> bool
-	val != : t * t -> bool
+        val == : t * t -> bool
+        val != : t * t -> bool
 
-	val toString : t -> string
-	val fromInt : int -> t
-	val scan : (char,'a) StringCvt.reader -> (t,'a) StringCvt.reader
+        val toString : t -> string
+        val fromInt : int -> t
+        val scan : (char,'a) StringCvt.reader -> (t,'a) StringCvt.reader
     end
 
 signature INTEGRAL_NUMBER =
     sig
-	include NUMBER
+        include NUMBER
 
-	val quot : t * t -> t
-	val rem  : t * t -> t
-	val mod  : t * t -> t
-	val div  : t * t -> t
+        val quot : t * t -> t
+        val rem  : t * t -> t
+        val mod  : t * t -> t
+        val div  : t * t -> t
 
-	val compare : t * t -> order
-	val < : t * t -> bool
-	val > : t * t -> bool
-	val <= : t * t -> bool
-	val >= : t * t -> bool
+        val compare : t * t -> order
+        val < : t * t -> bool
+        val > : t * t -> bool
+        val <= : t * t -> bool
+        val >= : t * t -> bool
 
-	val max : t * t -> t
-	val min : t * t -> t
+        val max : t * t -> t
+        val min : t * t -> t
     end
 
 signature FRACTIONAL_NUMBER =
     sig
-	include NUMBER
+        include NUMBER
 
-	val pi : t
-	val e : t
+        val pi : t
+        val e : t
 
-	val / : t * t -> t
-	val recip : t -> t
+        val / : t * t -> t
+        val recip : t -> t
 
-	val ln : t -> t
-	val pow : t * t -> t
-	val exp : t -> t
-	val sqrt : t -> t
+        val ln : t -> t
+        val pow : t * t -> t
+        val exp : t -> t
+        val sqrt : t -> t
 
-	val cos : t -> t
-	val sin : t -> t
-	val tan : t -> t
-	val sinh : t -> t
-	val cosh : t -> t
-	val tanh : t -> t
+        val cos : t -> t
+        val sin : t -> t
+        val tan : t -> t
+        val sinh : t -> t
+        val cosh : t -> t
+        val tanh : t -> t
 
-	val acos : t -> t
-	val asin : t -> t
-	val atan : t -> t
-	val asinh : t -> t
-	val acosh : t -> t
-	val atanh : t -> t
-	val atan2 : t * t -> t
+        val acos : t -> t
+        val asin : t -> t
+        val atan : t -> t
+        val asinh : t -> t
+        val acosh : t -> t
+        val atanh : t -> t
+        val atan2 : t * t -> t
     end
 
 signature REAL_NUMBER =
     sig
-	include FRACTIONAL_NUMBER
+        include FRACTIONAL_NUMBER
 
-	val compare : t * t -> order
-	val < : t * t -> bool
-	val > : t * t -> bool
-	val <= : t * t -> bool
-	val >= : t * t -> bool
+        val compare : t * t -> order
+        val < : t * t -> bool
+        val > : t * t -> bool
+        val <= : t * t -> bool
+        val >= : t * t -> bool
 
-	val max : t * t -> t
-	val min : t * t -> t
+        val max : t * t -> t
+        val min : t * t -> t
     end
 
 signature COMPLEX_NUMBER =
     sig
-	include FRACTIONAL_NUMBER
+        include FRACTIONAL_NUMBER
 
-	structure Real : REAL_NUMBER
-	type real = Real.t
+        structure Real : REAL_NUMBER
+        type real = Real.t
 
-	val make : real * real -> t
-	val split : t -> real * real
-	val realPart : t -> real
-	val imagPart : t -> real
-	val abs2 : t -> real
+        val make : real * real -> t
+        val split : t -> real * real
+        val realPart : t -> real
+        val imagPart : t -> real
+        val abs2 : t -> real
     end
 
 structure INumber : INTEGRAL_NUMBER =
     struct
-	open Int
-	type t = Int.int
-	val zero = 0
-	val one = 1
+        open Int
+        type t = Int.int
+        val zero = 0
+        val one = 1
 
-	infix **
-	fun i ** n =
-	    let fun loop 0 = 1
-		  | loop 1 = i
-		  | loop n =
-		let val x = loop (Int.div(n, 2))
-		    val m = Int.mod(n, 2)
-		in
-		    if m = 0 then
-			x * x
-		    else
-			x * x * i
-		end
-	    in if n < 0
-	       then raise Domain
-	       else loop n
-	    end
+        infix **
+        fun i ** n =
+            let fun loop 0 = 1
+                  | loop 1 = i
+                  | loop n =
+                let val x = loop (Int.div(n, 2))
+                    val m = Int.mod(n, 2)
+                in
+                    if m = 0 then
+                        x * x
+                    else
+                        x * x * i
+                end
+            in if n < 0
+               then raise Domain
+               else loop n
+            end
 
-	fun signum i = case compare(i, 0) of
-	    GREATER => 1
-	  | EQUAL => 0
-	  | LESS => ~1
+        fun signum i = case compare(i, 0) of
+            GREATER => 1
+          | EQUAL => 0
+          | LESS => ~1
 
-	infix ==
-	infix !=
-	fun a == b = a = b
-	fun a != b = (a <> b)
-	fun *+(b,c,a) = b * c + a
-	fun *-(b,c,a) = b * c - b
+        infix ==
+        infix !=
+        fun a == b = a = b
+        fun a != b = (a <> b)
+        fun *+(b,c,a) = b * c + a
+        fun *-(b,c,a) = b * c - b
 
-	fun scan getc = Int.scan StringCvt.DEC getc
+        fun scan getc = Int.scan StringCvt.DEC getc
     end
 
 structure RNumber : REAL_NUMBER =
     struct
-	open Real
-	open Real.Math
-	type t = Real.real
-	val zero = 0.0
-	val one = 1.0
+        open Real
+        open Real.Math
+        type t = Real.real
+        val zero = 0.0
+        val one = 1.0
 
-	fun signum x = case compare(x,0.0) of
-	    LESS => ~1.0
-	  | GREATER => 1.0
-	  | EQUAL => 0.0
+        fun signum x = case compare(x,0.0) of
+            LESS => ~1.0
+          | GREATER => 1.0
+          | EQUAL => 0.0
 
-	fun recip x = 1.0 / x
+        fun recip x = 1.0 / x
 
-	infix **
-	fun i ** n =
-	    let fun loop 0 = one
-		  | loop 1 = i
-		  | loop n =
-		let val x = loop (Int.div(n, 2))
-		    val m = Int.mod(n, 2)
-		in
-		    if m = 0 then
-			x * x
-		    else
-			x * x * i
-		end
-	    in if Int.<(n, 0)
-	       then raise Domain
-	       else loop n
-	    end
+        infix **
+        fun i ** n =
+            let fun loop 0 = one
+                  | loop 1 = i
+                  | loop n =
+                let val x = loop (Int.div(n, 2))
+                    val m = Int.mod(n, 2)
+                in
+                    if m = 0 then
+                        x * x
+                    else
+                        x * x * i
+                end
+            in if Int.<(n, 0)
+               then raise Domain
+               else loop n
+            end
 
-	fun max (a, b) = if a < b then b else a
-	fun min (a, b) = if a < b then a else b
+        fun max (a, b) = if a < b then b else a
+        fun min (a, b) = if a < b then a else b
 
-	fun asinh x = ln (x + sqrt(1.0 + x * x))
-	fun acosh x = ln (x + (x + 1.0) * sqrt((x - 1.0)/(x + 1.0)))
-	fun atanh x = ln ((1.0 + x) / sqrt(1.0 - x * x))
+        fun asinh x = ln (x + sqrt(1.0 + x * x))
+        fun acosh x = ln (x + (x + 1.0) * sqrt((x - 1.0)/(x + 1.0)))
+        fun atanh x = ln ((1.0 + x) / sqrt(1.0 - x * x))
 
     end
 (*
- Complex(R)	- Functor -
+ Complex(R)     - Functor -
 
  Provides support for complex numbers based on tuples. Should be
  highly efficient as most operations can be inlined.
@@ -1026,160 +1026,160 @@
 
 structure CNumber : COMPLEX_NUMBER =
 struct
-	structure Real = RNumber
+        structure Real = RNumber
 
-	type t = Real.t * Real.t
-	type real = Real.t
+        type t = Real.t * Real.t
+        type real = Real.t
 
-	val zero = (0.0,0.0)
-	val one = (1.0,0.0)
-	val pi = (Real.pi, 0.0)
-	val e = (Real.e, 0.0)
+        val zero = (0.0,0.0)
+        val one = (1.0,0.0)
+        val pi = (Real.pi, 0.0)
+        val e = (Real.e, 0.0)
 
-	fun make (r,i) = (r,i) : t
-	fun split z = z
-	fun realPart (r,_) = r
-	fun imagPart (_,i) = i
+        fun make (r,i) = (r,i) : t
+        fun split z = z
+        fun realPart (r,_) = r
+        fun imagPart (_,i) = i
 
-	fun abs2 (r,i) = Real.+(Real.*(r,r),Real.*(i,i)) (* FIXME!!! *)
-	fun arg (r,i) = Real.atan2(i,r)
-	fun modulus z = Real.sqrt(abs2 z)
-	fun abs z = (modulus z, 0.0)
-	fun signum (z as (r,i)) =
-	    let val m = modulus z
-	    in (Real./(r,m), Real./(i,m))
-	    end
+        fun abs2 (r,i) = Real.+(Real.*(r,r),Real.*(i,i)) (* FIXME!!! *)
+        fun arg (r,i) = Real.atan2(i,r)
+        fun modulus z = Real.sqrt(abs2 z)
+        fun abs z = (modulus z, 0.0)
+        fun signum (z as (r,i)) =
+            let val m = modulus z
+            in (Real./(r,m), Real./(i,m))
+            end
 
-	fun ~ (r1,i1) = (Real.~ r1, Real.~ i1)
-	fun (r1,i1) + (r2,i2) = (Real.+(r1,r2), Real.+(i1,i2))
-	fun (r1,i1) - (r2,i2) = (Real.-(r1,r2), Real.-(i1,i1))
-	fun (r1,i1) * (r2,i2) = (Real.-(Real.*(r1,r2),Real.*(i1,i2)),
-				 Real.+(Real.*(r1,i2),Real.*(r2,i1)))
-	fun (r1,i1) / (r2,i2) =
-	    let val modulus = abs2(r2,i2)
-		val (nr,ni) = (r1,i1) * (r2,i2)
-	    in
-		(Real./(nr,modulus), Real./(ni,modulus))
-	    end
-	fun *+((r1,i1),(r2,i2),(r0,i0)) =
-	    (Real.*+(Real.~ i1, i2, Real.*+(r1,r2,r0)),
-	     Real.*+(r2, i2, Real.*+(r1,i2,i0)))
-	fun *-((r1,i1),(r2,i2),(r0,i0)) =
-	    (Real.*+(Real.~ i1, i2, Real.*-(r1,r2,r0)),
-	     Real.*+(r2, i2, Real.*-(r1,i2,i0)))
+        fun ~ (r1,i1) = (Real.~ r1, Real.~ i1)
+        fun (r1,i1) + (r2,i2) = (Real.+(r1,r2), Real.+(i1,i2))
+        fun (r1,i1) - (r2,i2) = (Real.-(r1,r2), Real.-(i1,i1))
+        fun (r1,i1) * (r2,i2) = (Real.-(Real.*(r1,r2),Real.*(i1,i2)),
+                                 Real.+(Real.*(r1,i2),Real.*(r2,i1)))
+        fun (r1,i1) / (r2,i2) =
+            let val modulus = abs2(r2,i2)
+                val (nr,ni) = (r1,i1) * (r2,i2)
+            in
+                (Real./(nr,modulus), Real./(ni,modulus))
+            end
+        fun *+((r1,i1),(r2,i2),(r0,i0)) =
+            (Real.*+(Real.~ i1, i2, Real.*+(r1,r2,r0)),
+             Real.*+(r2, i2, Real.*+(r1,i2,i0)))
+        fun *-((r1,i1),(r2,i2),(r0,i0)) =
+            (Real.*+(Real.~ i1, i2, Real.*-(r1,r2,r0)),
+             Real.*+(r2, i2, Real.*-(r1,i2,i0)))
 
-	infix **
-	fun i ** n =
-	    let fun loop 0 = one
-		  | loop 1 = i
-		  | loop n =
-		let val x = loop (Int.div(n, 2))
-		    val m = Int.mod(n, 2)
-		in
-		    if m = 0 then
-			x * x
-		    else
-			x * x * i
-		end
-	    in if Int.<(n, 0)
-		   then raise Domain
-	       else loop n
-	    end
+        infix **
+        fun i ** n =
+            let fun loop 0 = one
+                  | loop 1 = i
+                  | loop n =
+                let val x = loop (Int.div(n, 2))
+                    val m = Int.mod(n, 2)
+                in
+                    if m = 0 then
+                        x * x
+                    else
+                        x * x * i
+                end
+            in if Int.<(n, 0)
+                   then raise Domain
+               else loop n
+            end
 
-	fun recip (r1, i1) = 
-	    let val modulus = abs2(r1, i1)
-	    in (Real./(r1, modulus), Real./(Real.~ i1, modulus))
-	    end
-	fun ==(z, w) = Real.==(realPart z, realPart w) andalso Real.==(imagPart z, imagPart w)
-	fun !=(z, w) = Real.!=(realPart z, realPart w) andalso Real.!=(imagPart z, imagPart w)
-	fun fromInt i = (Real.fromInt i, 0.0)
-	fun toString (r,i) =
-	    String.concat ["(",Real.toString r,",",Real.toString i,")"]
+        fun recip (r1, i1) = 
+            let val modulus = abs2(r1, i1)
+            in (Real./(r1, modulus), Real./(Real.~ i1, modulus))
+            end
+        fun ==(z, w) = Real.==(realPart z, realPart w) andalso Real.==(imagPart z, imagPart w)
+        fun !=(z, w) = Real.!=(realPart z, realPart w) andalso Real.!=(imagPart z, imagPart w)
+        fun fromInt i = (Real.fromInt i, 0.0)
+        fun toString (r,i) =
+            String.concat ["(",Real.toString r,",",Real.toString i,")"]
 
-	fun exp (x, y) =
-	    let val expx = Real.exp x
-	    in (Real.*(x, (Real.cos y)), Real.*(x, (Real.sin y)))
-	    end
+        fun exp (x, y) =
+            let val expx = Real.exp x
+            in (Real.*(x, (Real.cos y)), Real.*(x, (Real.sin y)))
+            end
 
     local
-	val half = Real.recip (Real.fromInt 2)
+        val half = Real.recip (Real.fromInt 2)
     in
-	fun sqrt (z as (x,y)) =
-	    if Real.==(x, 0.0) andalso Real.==(y, 0.0) then
-		zero
-	    else
-		let val m = Real.+(modulus z, Real.abs x)
-		    val u' = Real.sqrt (Real.*(m, half))
-		    val v' = Real./(Real.abs y , Real.+(u',u'))
-		    val (u,v) = if Real.<(x, 0.0) then (v',u') else (u',v')
-		in (u, if Real.<(y, 0.0) then Real.~ v else v)
-		end
+        fun sqrt (z as (x,y)) =
+            if Real.==(x, 0.0) andalso Real.==(y, 0.0) then
+                zero
+            else
+                let val m = Real.+(modulus z, Real.abs x)
+                    val u' = Real.sqrt (Real.*(m, half))
+                    val v' = Real./(Real.abs y , Real.+(u',u'))
+                    val (u,v) = if Real.<(x, 0.0) then (v',u') else (u',v')
+                in (u, if Real.<(y, 0.0) then Real.~ v else v)
+                end
     end
-	fun ln z = (Real.ln (modulus z), arg z)
+        fun ln z = (Real.ln (modulus z), arg z)
 
-	fun pow (z, n) =
-	    let val l = ln z
-	    in exp (l * n)
-	    end
+        fun pow (z, n) =
+            let val l = ln z
+            in exp (l * n)
+            end
 
-	fun sin (x, y) = (Real.*(Real.sin x, Real.cosh y),
-			  Real.*(Real.cos x, Real.sinh y))
-	fun cos (x, y) = (Real.*(Real.cos x, Real.cosh y),
-			  Real.~ (Real.*(Real.sin x, Real.sinh y)))
-	fun tan (x, y) =
-	    let val (sx, cx) = (Real.sin x, Real.cos x)
-		val (shy, chy) = (Real.sinh y, Real.cosh y)
-		val a = (Real.*(sx, chy), Real.*(cx, shy))
-		val b = (Real.*(cx, chy), Real.*(Real.~ sx, shy))
-	    in a / b
-	    end
+        fun sin (x, y) = (Real.*(Real.sin x, Real.cosh y),
+                          Real.*(Real.cos x, Real.sinh y))
+        fun cos (x, y) = (Real.*(Real.cos x, Real.cosh y),
+                          Real.~ (Real.*(Real.sin x, Real.sinh y)))
+        fun tan (x, y) =
+            let val (sx, cx) = (Real.sin x, Real.cos x)
+                val (shy, chy) = (Real.sinh y, Real.cosh y)
+                val a = (Real.*(sx, chy), Real.*(cx, shy))
+                val b = (Real.*(cx, chy), Real.*(Real.~ sx, shy))
+            in a / b
+            end
 
-	fun sinh (x, y) = (Real.*(Real.cos y, Real.sinh x),
-			   Real.*(Real.sin y, Real.cosh x))
-	fun cosh (x, y) = (Real.*(Real.cos y, Real.cosh x),
-			   Real.*(Real.sin y, Real.sinh x))
-	fun tanh (x, y) =
-	    let val (sy, cy) = (Real.sin y, Real.cos y)
-		val (shx, chx) = (Real.sinh x, Real.cosh x)
-		val a = (Real.*(cy, shx), Real.*(sy, chx))
-		val b = (Real.*(cy, chx), Real.*(sy, shx))
-	    in a / b
-	    end
+        fun sinh (x, y) = (Real.*(Real.cos y, Real.sinh x),
+                           Real.*(Real.sin y, Real.cosh x))
+        fun cosh (x, y) = (Real.*(Real.cos y, Real.cosh x),
+                           Real.*(Real.sin y, Real.sinh x))
+        fun tanh (x, y) =
+            let val (sy, cy) = (Real.sin y, Real.cos y)
+                val (shx, chx) = (Real.sinh x, Real.cosh x)
+                val a = (Real.*(cy, shx), Real.*(sy, chx))
+                val b = (Real.*(cy, chx), Real.*(sy, shx))
+            in a / b
+            end
 
-	fun asin (z as (x,y)) =
-	    let val w = sqrt (one - z * z)
-		val (x',y') = ln ((Real.~ y, x) + w)
-	    in (y', Real.~ x')
-	    end
+        fun asin (z as (x,y)) =
+            let val w = sqrt (one - z * z)
+                val (x',y') = ln ((Real.~ y, x) + w)
+            in (y', Real.~ x')
+            end
 
-	fun acos (z as (x,y)) = 
-	    let val (x', y') = sqrt (one + z * z)
-		val (x'', y'') = ln (z + (Real.~ y', x'))
-	    in (y'', Real.~ x'')
-	    end
+        fun acos (z as (x,y)) = 
+            let val (x', y') = sqrt (one + z * z)
+                val (x'', y'') = ln (z + (Real.~ y', x'))
+            in (y'', Real.~ x'')
+            end
 
-	fun atan (z as (x,y)) =
-	    let val w = sqrt (one + z*z)
-		val (x',y') = ln ((Real.-(1.0, y), x) / w)
-	    in (y', Real.~ x')
-	    end
+        fun atan (z as (x,y)) =
+            let val w = sqrt (one + z*z)
+                val (x',y') = ln ((Real.-(1.0, y), x) / w)
+            in (y', Real.~ x')
+            end
 
-	fun atan2 (y, x) = atan(y / x)
+        fun atan2 (y, x) = atan(y / x)
 
-	fun asinh x = ln (x + sqrt(one + x * x))
-	fun acosh x = ln (x + (x + one) * sqrt((x - one)/(x + one)))
-	fun atanh x = ln ((one + x) / sqrt(one - x * x))
+        fun asinh x = ln (x + sqrt(one + x * x))
+        fun acosh x = ln (x + (x + one) * sqrt((x - one)/(x + one)))
+        fun atanh x = ln ((one + x) / sqrt(one - x * x))
 
-	fun scan getc =
-	    let val scanner = Real.scan getc
-	    in fn stream => 
-		  case scanner stream of
-		      NONE => NONE
-		    | SOME (a, rest) =>
-		      case scanner rest of
-			  NONE => NONE
-			| SOME (b, rest) => SOME (make(a,b), rest)
-	    end
+        fun scan getc =
+            let val scanner = Real.scan getc
+            in fn stream => 
+                  case scanner stream of
+                      NONE => NONE
+                    | SOME (a, rest) =>
+                      case scanner rest of
+                          NONE => NONE
+                        | SOME (b, rest) => SOME (make(a,b), rest)
+            end
 
 end (* ComplexNumber *)
 
@@ -1192,445 +1192,445 @@
 
 structure INumberArray =
     struct
-	open Array
-	type array = INumber.t array
-	type vector = INumber.t vector
-	type elem  = INumber.t
-	structure Vector =
-	    struct
-		open Vector
-		type vector = INumber.t Vector.vector
-		type elem = INumber.t
-	    end
-	fun map f a = tabulate(length a, fn x => (f (sub(a,x))))
-	fun mapi f a = tabulate(length a, fn x => (f (x,sub(a,x))))
-	fun map2 f a b = tabulate(length a, fn x => (f(sub(a,x),sub(b,x))))
+        open Array
+        type array = INumber.t array
+        type vector = INumber.t vector
+        type elem  = INumber.t
+        structure Vector =
+            struct
+                open Vector
+                type vector = INumber.t Vector.vector
+                type elem = INumber.t
+            end
+        fun map f a = tabulate(length a, fn x => (f (sub(a,x))))
+        fun mapi f a = tabulate(length a, fn x => (f (x,sub(a,x))))
+        fun map2 f a b = tabulate(length a, fn x => (f(sub(a,x),sub(b,x))))
     end
 
 structure RNumberArray =
     struct
-	open Real64Array
-	val sub = Unsafe.Real64Array.sub
-	val update = Unsafe.Real64Array.update
-	fun map f a = tabulate(length a, fn x => (f (sub(a,x))))
-	fun mapi f a = tabulate(length a, fn x => (f (x,sub(a,x))))
-	fun map2 f a b = tabulate(length a, fn x => (f(sub(a,x),sub(b,x))))
+        open Real64Array
+        val sub = Unsafe.Real64Array.sub
+        val update = Unsafe.Real64Array.update
+        fun map f a = tabulate(length a, fn x => (f (sub(a,x))))
+        fun mapi f a = tabulate(length a, fn x => (f (x,sub(a,x))))
+        fun map2 f a b = tabulate(length a, fn x => (f(sub(a,x),sub(b,x))))
     end
 
 (*--------------------- COMPLEX ARRAY -------------------------*)
 
 structure BasicCNumberArray =
 struct
-	structure Complex : COMPLEX_NUMBER = CNumber
-	structure Array : MONO_ARRAY = RNumberArray
+        structure Complex : COMPLEX_NUMBER = CNumber
+        structure Array : MONO_ARRAY = RNumberArray
 
-	type elem = Complex.t
-	type array = Array.array * Array.array
+        type elem = Complex.t
+        type array = Array.array * Array.array
 
-	val maxLen = Array.maxLen
+        val maxLen = Array.maxLen
 
-	fun length (a,b) = Array.length a
+        fun length (a,b) = Array.length a
 
-	fun sub ((a,b),index) = Complex.make(Array.sub(a,index),Array.sub(b,index))
+        fun sub ((a,b),index) = Complex.make(Array.sub(a,index),Array.sub(b,index))
 
-	fun update ((a,b),index,z) =
-	    let val (re,im) = Complex.split z in
-		Array.update(a, index, re);
-		Array.update(b, index, im)
-	    end
+        fun update ((a,b),index,z) =
+            let val (re,im) = Complex.split z in
+                Array.update(a, index, re);
+                Array.update(b, index, im)
+            end
 
     local
         fun makeRange (a, start, NONE) = makeRange(a, start, SOME (length a - 1))
-	  | makeRange (a, start, SOME last) =
-	    let val len = length a
-		val diff = last - start
-	    in
-		if (start >= len) orelse (last >= len) then
-		    raise Subscript
-		else if diff < 0 then
-		    (a, start, 0)
-		else
-		    (a, start, diff + 1)
-	    end
+          | makeRange (a, start, SOME last) =
+            let val len = length a
+                val diff = last - start
+            in
+                if (start >= len) orelse (last >= len) then
+                    raise Subscript
+                else if diff < 0 then
+                    (a, start, 0)
+                else
+                    (a, start, diff + 1)
+            end
 
     in
 
-	fun array (size,z:elem) =
-	    let val realsize = size * 2
-		val r = Complex.realPart z
-		val i = Complex.imagPart z in
-		    (Array.array(size,r), Array.array(size,i))
-	    end
+        fun array (size,z:elem) =
+            let val realsize = size * 2
+                val r = Complex.realPart z
+                val i = Complex.imagPart z in
+                    (Array.array(size,r), Array.array(size,i))
+            end
 
-	fun zeroarray size =
-	    (Array.array(size,Complex.Real.zero),
-	     Array.array(size,Complex.Real.zero))
+        fun zeroarray size =
+            (Array.array(size,Complex.Real.zero),
+             Array.array(size,Complex.Real.zero))
 
-	fun tabulate (size,f) =
-	    let val a = array(size, Complex.zero)
-		fun loop i =
-		    case i = size of
-			true => a
-		      | false => (update(a, i, f i); loop (i+1))
-	    in
-		loop 0
-	    end
+        fun tabulate (size,f) =
+            let val a = array(size, Complex.zero)
+                fun loop i =
+                    case i = size of
+                        true => a
+                      | false => (update(a, i, f i); loop (i+1))
+            in
+                loop 0
+            end
 
-	fun fromList list =
-	    let val length = List.length list
-		val a = zeroarray length
-		fun loop (_, []) = a
-		  | loop (i, z::rest) = (update(a, i, z);
-					 loop (i+1, rest))
-	    in
-		loop(0,list)
-	    end
+        fun fromList list =
+            let val length = List.length list
+                val a = zeroarray length
+                fun loop (_, []) = a
+                  | loop (i, z::rest) = (update(a, i, z);
+                                         loop (i+1, rest))
+            in
+                loop(0,list)
+            end
 
-	fun extract range =
-	    let val (a, start, len) = makeRange range
-		fun copy i = sub(a, i + start)
-	    in tabulate(len, copy)
-	    end
+        fun extract range =
+            let val (a, start, len) = makeRange range
+                fun copy i = sub(a, i + start)
+            in tabulate(len, copy)
+            end
 
-	fun concat array_list =
-	    let val total_length = foldl (op +) 0 (map length array_list)
-		val a = array(total_length, Complex.zero)
-		fun copy (_, []) = a
-		  | copy (pos, v::rest) =
-		    let fun loop i =
-			case i = 0 of
-			    true => ()
-			  | false => (update(a, i+pos, sub(v, i)); loop (i-1))
-		    in (loop (length v - 1); copy(length v + pos, rest))
-		    end
-	    in
-		copy(0, array_list)
-	    end
+        fun concat array_list =
+            let val total_length = foldl (op +) 0 (map length array_list)
+                val a = array(total_length, Complex.zero)
+                fun copy (_, []) = a
+                  | copy (pos, v::rest) =
+                    let fun loop i =
+                        case i = 0 of
+                            true => ()
+                          | false => (update(a, i+pos, sub(v, i)); loop (i-1))
+                    in (loop (length v - 1); copy(length v + pos, rest))
+                    end
+            in
+                copy(0, array_list)
+            end
 
-	fun copy {src : array, si : int, len : int option, dst : array, di : int } =
-	    let val (a, ia, la) = makeRange (src, si, len)
-		val (b, ib, lb) = makeRange (dst, di, len)
-		fun copy i =
-		    case i < 0 of
-			true => ()
-		      | false => (update(b, i+ib, sub(a, i+ia)); copy (i-1))
-	    in copy (la - 1)
-	    end
+        fun copy {src : array, si : int, len : int option, dst : array, di : int } =
+            let val (a, ia, la) = makeRange (src, si, len)
+                val (b, ib, lb) = makeRange (dst, di, len)
+                fun copy i =
+                    case i < 0 of
+                        true => ()
+                      | false => (update(b, i+ib, sub(a, i+ia)); copy (i-1))
+            in copy (la - 1)
+            end
 
-	val copyVec = copy
+        val copyVec = copy
 
-	fun modifyi f range =
-	    let val (a, start, len) = makeRange range
-		val last = start + len
-		fun loop i =
-		    case i >= last of
-			true => ()
-		      | false => (update(a, i, f(i, sub(a,i))); loop (i+1))
-	    in loop start
-	    end
+        fun modifyi f range =
+            let val (a, start, len) = makeRange range
+                val last = start + len
+                fun loop i =
+                    case i >= last of
+                        true => ()
+                      | false => (update(a, i, f(i, sub(a,i))); loop (i+1))
+            in loop start
+            end
 
-	fun modify f a =
-	    let val last = length a
-		fun loop i =
-		    case i >= last of
-			true => ()
-		      | false => (update(a, i, f(sub(a,i))); loop (i+1))
-	    in loop 0
-	    end
+        fun modify f a =
+            let val last = length a
+                fun loop i =
+                    case i >= last of
+                        true => ()
+                      | false => (update(a, i, f(sub(a,i))); loop (i+1))
+            in loop 0
+            end
 
-	fun app f a =
-	    let val size = length a
-		fun loop i =
-		    case i = size of
-			true => ()
-		      | false => (f(sub(a,i)); loop (i+1))
-	    in
-		loop 0
-	    end
+        fun app f a =
+            let val size = length a
+                fun loop i =
+                    case i = size of
+                        true => ()
+                      | false => (f(sub(a,i)); loop (i+1))
+            in
+                loop 0
+            end
 
-	fun appi f range =
-	    let val (a, start, len) = makeRange range
-		val last = start + len
-		fun loop i =
-		    case i >= last of
-			true => ()
-		      | false => (f(i, sub(a,i)); loop (i+1))
-	    in
-		loop start
-	    end
+        fun appi f range =
+            let val (a, start, len) = makeRange range
+                val last = start + len
+                fun loop i =
+                    case i >= last of
+                        true => ()
+                      | false => (f(i, sub(a,i)); loop (i+1))
+            in
+                loop start
+            end
 
-	fun map f a =
-	    let val len = length a
-		val c = zeroarray len
-		fun loop ~1 = c
-		  | loop i = (update(a, i, f(sub(a,i))); loop (i-1))
-	    in loop (len-1)
-	    end
+        fun map f a =
+            let val len = length a
+                val c = zeroarray len
+                fun loop ~1 = c
+                  | loop i = (update(a, i, f(sub(a,i))); loop (i-1))
+            in loop (len-1)
+            end
 
-	fun map2 f a b =
-	    let val len = length a
-		val c = zeroarray len
-		fun loop ~1 = c
-		  | loop i = (update(c, i, f(sub(a,i),sub(b,i)));
-			      loop (i-1))
-	    in loop (len-1)
-	    end
+        fun map2 f a b =
+            let val len = length a
+                val c = zeroarray len
+                fun loop ~1 = c
+                  | loop i = (update(c, i, f(sub(a,i),sub(b,i)));
+                              loop (i-1))
+            in loop (len-1)
+            end
 
-	fun mapi f range =
-	    let val (a, start, len) = makeRange range
-		fun rule i = f (i+start, sub(a, i+start))
-	    in tabulate(len, rule)
-	    end
+        fun mapi f range =
+            let val (a, start, len) = makeRange range
+                fun rule i = f (i+start, sub(a, i+start))
+            in tabulate(len, rule)
+            end
 
-	fun foldli f init range =
-	    let val (a, start, len) = makeRange range
-		val last = start + len - 1
-		fun loop (i, accum) =
-		    case i > last of
-			true => accum
-		      | false => loop (i+1, f(i, sub(a,i), accum))
-	    in loop (start, init)
-	    end
+        fun foldli f init range =
+            let val (a, start, len) = makeRange range
+                val last = start + len - 1
+                fun loop (i, accum) =
+                    case i > last of
+                        true => accum
+                      | false => loop (i+1, f(i, sub(a,i), accum))
+            in loop (start, init)
+            end
 
-	fun foldri f init range =
-	    let val (a, start, len) = makeRange range
-		val last = start + len - 1
-		fun loop (i, accum) =
-		    case i < start of
-			true => accum
-		      | false => loop (i-1, f(i, sub(a,i), accum))
-	    in loop (last, init)
-	    end
+        fun foldri f init range =
+            let val (a, start, len) = makeRange range
+                val last = start + len - 1
+                fun loop (i, accum) =
+                    case i < start of
+                        true => accum
+                      | false => loop (i-1, f(i, sub(a,i), accum))
+            in loop (last, init)
+            end
 
-	fun foldl f init a = foldli (fn (_, a, x) => f(a,x)) init (a,0,NONE)
-	fun foldr f init a = foldri (fn (_, x, a) => f(x,a)) init (a,0,NONE)
+        fun foldl f init a = foldli (fn (_, a, x) => f(a,x)) init (a,0,NONE)
+        fun foldr f init a = foldri (fn (_, x, a) => f(x,a)) init (a,0,NONE)
     end
 end (* BasicCNumberArray *)
 
 
 structure CNumberArray =
     struct
-	structure Vector =
-	    struct
-		open BasicCNumberArray
-		type vector = array
-	    end : MONO_VECTOR
-	type vector = Vector.vector
-	open BasicCNumberArray
+        structure Vector =
+            struct
+                open BasicCNumberArray
+                type vector = array
+            end : MONO_VECTOR
+        type vector = Vector.vector
+        open BasicCNumberArray
     end (* CNumberArray *)
 structure INumber : INTEGRAL_NUMBER =
     struct
-	open Int
-	type t = Int.int
-	val zero = 0
-	val one = 1
-	infix **
-	fun i ** n =
-	    let fun loop 0 = 1
-		  | loop 1 = i
-		  | loop n =
-		let val x = loop (Int.div(n, 2))
-		    val m = Int.mod(n, 2)
-		in
-		    if m = 0 then
-			x * x
-		    else
-			x * x * i
-		end
-	    in if n < 0
-	       then raise Domain
-	       else loop n
-	    end
-	fun signum i = case compare(i, 0) of
-	    GREATER => 1
-	  | EQUAL => 0
-	  | LESS => ~1
-	infix ==
-	infix !=
-	fun a == b = a = b
-	fun a != b = (a <> b)
-	fun *+(b,c,a) = b * c + a
-	fun *-(b,c,a) = b * c - b
-	fun scan getc = Int.scan StringCvt.DEC getc
+        open Int
+        type t = Int.int
+        val zero = 0
+        val one = 1
+        infix **
+        fun i ** n =
+            let fun loop 0 = 1
+                  | loop 1 = i
+                  | loop n =
+                let val x = loop (Int.div(n, 2))
+                    val m = Int.mod(n, 2)
+                in
+                    if m = 0 then
+                        x * x
+                    else
+                        x * x * i
+                end
+            in if n < 0
+               then raise Domain
+               else loop n
+            end
+        fun signum i = case compare(i, 0) of
+            GREATER => 1
+          | EQUAL => 0
+          | LESS => ~1
+        infix ==
+        infix !=
+        fun a == b = a = b
+        fun a != b = (a <> b)
+        fun *+(b,c,a) = b * c + a
+        fun *-(b,c,a) = b * c - b
+        fun scan getc = Int.scan StringCvt.DEC getc
     end
 structure RNumber : REAL_NUMBER =
     struct
-	open Real
-	open Real.Math
-	type t = Real.real
-	val zero = 0.0
-	val one = 1.0
-	fun signum x = case compare(x,0.0) of
-	    LESS => ~1.0
-	  | GREATER => 1.0
-	  | EQUAL => 0.0
-	fun recip x = 1.0 / x
-	infix **
-	fun i ** n =
-	    let fun loop 0 = one
-		  | loop 1 = i
-		  | loop n =
-		let val x = loop (Int.div(n, 2))
-		    val m = Int.mod(n, 2)
-		in
-		    if m = 0 then
-			x * x
-		    else
-			x * x * i
-		end
-	    in if Int.<(n, 0)
-	       then raise Domain
-	       else loop n
-	    end
-	fun max (a, b) = if a < b then b else a
-	fun min (a, b) = if a < b then a else b
-	fun asinh x = ln (x + sqrt(1.0 + x * x))
-	fun acosh x = ln (x + (x + 1.0) * sqrt((x - 1.0)/(x + 1.0)))
-	fun atanh x = ln ((1.0 + x) / sqrt(1.0 - x * x))
+        open Real
+        open Real.Math
+        type t = Real.real
+        val zero = 0.0
+        val one = 1.0
+        fun signum x = case compare(x,0.0) of
+            LESS => ~1.0
+          | GREATER => 1.0
+          | EQUAL => 0.0
+        fun recip x = 1.0 / x
+        infix **
+        fun i ** n =
+            let fun loop 0 = one
+                  | loop 1 = i
+                  | loop n =
+                let val x = loop (Int.div(n, 2))
+                    val m = Int.mod(n, 2)
+                in
+                    if m = 0 then
+                        x * x
+                    else
+                        x * x * i
+                end
+            in if Int.<(n, 0)
+               then raise Domain
+               else loop n
+            end
+        fun max (a, b) = if a < b then b else a
+        fun min (a, b) = if a < b then a else b
+        fun asinh x = ln (x + sqrt(1.0 + x * x))
+        fun acosh x = ln (x + (x + 1.0) * sqrt((x - 1.0)/(x + 1.0)))
+        fun atanh x = ln ((1.0 + x) / sqrt(1.0 - x * x))
     end
 (*
- Complex(R)	- Functor -
+ Complex(R)     - Functor -
  Provides support for complex numbers based on tuples. Should be
  highly efficient as most operations can be inlined.
  *)
 structure CNumber : COMPLEX_NUMBER =
 struct
-	structure Real = RNumber
-	type t = Real.t * Real.t
-	type real = Real.t
-	val zero = (0.0,0.0)
-	val one = (1.0,0.0)
-	val pi = (Real.pi, 0.0)
-	val e = (Real.e, 0.0)
-	fun make (r,i) = (r,i) : t
-	fun split z = z
-	fun realPart (r,_) = r
-	fun imagPart (_,i) = i
-	fun abs2 (r,i) = Real.+(Real.*(r,r),Real.*(i,i)) (* FIXME!!! *)
-	fun arg (r,i) = Real.atan2(i,r)
-	fun modulus z = Real.sqrt(abs2 z)
-	fun abs z = (modulus z, 0.0)
-	fun signum (z as (r,i)) =
-	    let val m = modulus z
-	    in (Real./(r,m), Real./(i,m))
-	    end
-	fun ~ (r1,i1) = (Real.~ r1, Real.~ i1)
-	fun (r1,i1) + (r2,i2) = (Real.+(r1,r2), Real.+(i1,i2))
-	fun (r1,i1) - (r2,i2) = (Real.-(r1,r2), Real.-(i1,i1))
-	fun (r1,i1) * (r2,i2) = (Real.-(Real.*(r1,r2),Real.*(i1,i2)),
-				 Real.+(Real.*(r1,i2),Real.*(r2,i1)))
-	fun (r1,i1) / (r2,i2) =
-	    let val modulus = abs2(r2,i2)
-		val (nr,ni) = (r1,i1) * (r2,i2)
-	    in
-		(Real./(nr,modulus), Real./(ni,modulus))
-	    end
-	fun *+((r1,i1),(r2,i2),(r0,i0)) =
-	    (Real.*+(Real.~ i1, i2, Real.*+(r1,r2,r0)),
-	     Real.*+(r2, i2, Real.*+(r1,i2,i0)))
-	fun *-((r1,i1),(r2,i2),(r0,i0)) =
-	    (Real.*+(Real.~ i1, i2, Real.*-(r1,r2,r0)),
-	     Real.*+(r2, i2, Real.*-(r1,i2,i0)))
-	infix **
-	fun i ** n =
-	    let fun loop 0 = one
-		  | loop 1 = i
-		  | loop n =
-		let val x = loop (Int.div(n, 2))
-		    val m = Int.mod(n, 2)
-		in
-		    if m = 0 then
-			x * x
-		    else
-			x * x * i
-		end
-	    in if Int.<(n, 0)
-		   then raise Domain
-	       else loop n
-	    end
-	fun recip (r1, i1) = 
-	    let val modulus = abs2(r1, i1)
-	    in (Real./(r1, modulus), Real./(Real.~ i1, modulus))
-	    end
-	fun ==(z, w) = Real.==(realPart z, realPart w) andalso Real.==(imagPart z, imagPart w)
-	fun !=(z, w) = Real.!=(realPart z, realPart w) andalso Real.!=(imagPart z, imagPart w)
-	fun fromInt i = (Real.fromInt i, 0.0)
-	fun toString (r,i) =
-	    String.concat ["(",Real.toString r,",",Real.toString i,")"]
-	fun exp (x, y) =
-	    let val expx = Real.exp x
-	    in (Real.*(x, (Real.cos y)), Real.*(x, (Real.sin y)))
-	    end
+        structure Real = RNumber
+        type t = Real.t * Real.t
+        type real = Real.t
+        val zero = (0.0,0.0)
+        val one = (1.0,0.0)
+        val pi = (Real.pi, 0.0)
+        val e = (Real.e, 0.0)
+        fun make (r,i) = (r,i) : t
+        fun split z = z
+        fun realPart (r,_) = r
+        fun imagPart (_,i) = i
+        fun abs2 (r,i) = Real.+(Real.*(r,r),Real.*(i,i)) (* FIXME!!! *)
+        fun arg (r,i) = Real.atan2(i,r)
+        fun modulus z = Real.sqrt(abs2 z)
+        fun abs z = (modulus z, 0.0)
+        fun signum (z as (r,i)) =
+            let val m = modulus z
+            in (Real./(r,m), Real./(i,m))
+            end
+        fun ~ (r1,i1) = (Real.~ r1, Real.~ i1)
+        fun (r1,i1) + (r2,i2) = (Real.+(r1,r2), Real.+(i1,i2))
+        fun (r1,i1) - (r2,i2) = (Real.-(r1,r2), Real.-(i1,i1))
+        fun (r1,i1) * (r2,i2) = (Real.-(Real.*(r1,r2),Real.*(i1,i2)),
+                                 Real.+(Real.*(r1,i2),Real.*(r2,i1)))
+        fun (r1,i1) / (r2,i2) =
+            let val modulus = abs2(r2,i2)
+                val (nr,ni) = (r1,i1) * (r2,i2)
+            in
+                (Real./(nr,modulus), Real./(ni,modulus))
+            end
+        fun *+((r1,i1),(r2,i2),(r0,i0)) =
+            (Real.*+(Real.~ i1, i2, Real.*+(r1,r2,r0)),
+             Real.*+(r2, i2, Real.*+(r1,i2,i0)))
+        fun *-((r1,i1),(r2,i2),(r0,i0)) =
+            (Real.*+(Real.~ i1, i2, Real.*-(r1,r2,r0)),
+             Real.*+(r2, i2, Real.*-(r1,i2,i0)))
+        infix **
+        fun i ** n =
+            let fun loop 0 = one
+                  | loop 1 = i
+                  | loop n =
+                let val x = loop (Int.div(n, 2))
+                    val m = Int.mod(n, 2)
+                in
+                    if m = 0 then
+                        x * x
+                    else
+                        x * x * i
+                end
+            in if Int.<(n, 0)
+                   then raise Domain
+               else loop n
+            end
+        fun recip (r1, i1) = 
+            let val modulus = abs2(r1, i1)
+            in (Real./(r1, modulus), Real./(Real.~ i1, modulus))
+            end
+        fun ==(z, w) = Real.==(realPart z, realPart w) andalso Real.==(imagPart z, imagPart w)
+        fun !=(z, w) = Real.!=(realPart z, realPart w) andalso Real.!=(imagPart z, imagPart w)
+        fun fromInt i = (Real.fromInt i, 0.0)
+        fun toString (r,i) =
+            String.concat ["(",Real.toString r,",",Real.toString i,")"]
+        fun exp (x, y) =
+            let val expx = Real.exp x
+            in (Real.*(x, (Real.cos y)), Real.*(x, (Real.sin y)))
+            end
     local
-	val half = Real.recip (Real.fromInt 2)
+        val half = Real.recip (Real.fromInt 2)
     in
-	fun sqrt (z as (x,y)) =
-	    if Real.==(x, 0.0) andalso Real.==(y, 0.0) then
-		zero
-	    else
-		let val m = Real.+(modulus z, Real.abs x)
-		    val u' = Real.sqrt (Real.*(m, half))
-		    val v' = Real./(Real.abs y , Real.+(u',u'))
-		    val (u,v) = if Real.<(x, 0.0) then (v',u') else (u',v')
-		in (u, if Real.<(y, 0.0) then Real.~ v else v)
-		end
+        fun sqrt (z as (x,y)) =
+            if Real.==(x, 0.0) andalso Real.==(y, 0.0) then
+                zero
+            else
+                let val m = Real.+(modulus z, Real.abs x)
+                    val u' = Real.sqrt (Real.*(m, half))
+                    val v' = Real./(Real.abs y , Real.+(u',u'))
+                    val (u,v) = if Real.<(x, 0.0) then (v',u') else (u',v')
+                in (u, if Real.<(y, 0.0) then Real.~ v else v)
+                end
     end
-	fun ln z = (Real.ln (modulus z), arg z)
-	fun pow (z, n) =
-	    let val l = ln z
-	    in exp (l * n)
-	    end
-	fun sin (x, y) = (Real.*(Real.sin x, Real.cosh y),
-			  Real.*(Real.cos x, Real.sinh y))
-	fun cos (x, y) = (Real.*(Real.cos x, Real.cosh y),
-			  Real.~ (Real.*(Real.sin x, Real.sinh y)))
-	fun tan (x, y) =
-	    let val (sx, cx) = (Real.sin x, Real.cos x)
-		val (shy, chy) = (Real.sinh y, Real.cosh y)
-		val a = (Real.*(sx, chy), Real.*(cx, shy))
-		val b = (Real.*(cx, chy), Real.*(Real.~ sx, shy))
-	    in a / b
-	    end
-	fun sinh (x, y) = (Real.*(Real.cos y, Real.sinh x),
-			   Real.*(Real.sin y, Real.cosh x))
-	fun cosh (x, y) = (Real.*(Real.cos y, Real.cosh x),
-			   Real.*(Real.sin y, Real.sinh x))
-	fun tanh (x, y) =
-	    let val (sy, cy) = (Real.sin y, Real.cos y)
-		val (shx, chx) = (Real.sinh x, Real.cosh x)
-		val a = (Real.*(cy, shx), Real.*(sy, chx))
-		val b = (Real.*(cy, chx), Real.*(sy, shx))
-	    in a / b
-	    end
-	fun asin (z as (x,y)) =
-	    let val w = sqrt (one - z * z)
-		val (x',y') = ln ((Real.~ y, x) + w)
-	    in (y', Real.~ x')
-	    end
-	fun acos (z as (x,y)) = 
-	    let val (x', y') = sqrt (one + z * z)
-		val (x'', y'') = ln (z + (Real.~ y', x'))
-	    in (y'', Real.~ x'')
-	    end
-	fun atan (z as (x,y)) =
-	    let val w = sqrt (one + z*z)
-		val (x',y') = ln ((Real.-(1.0, y), x) / w)
-	    in (y', Real.~ x')
-	    end
-	fun atan2 (y, x) = atan(y / x)
-	fun asinh x = ln (x + sqrt(one + x * x))
-	fun acosh x = ln (x + (x + one) * sqrt((x - one)/(x + one)))
-	fun atanh x = ln ((one + x) / sqrt(one - x * x))
-	fun scan getc =
-	    let val scanner = Real.scan getc
-	    in fn stream => 
-		  case scanner stream of
-		      NONE => NONE
-		    | SOME (a, rest) =>
-		      case scanner rest of
-			  NONE => NONE
-			| SOME (b, rest) => SOME (make(a,b), rest)
-	    end
+        fun ln z = (Real.ln (modulus z), arg z)
+        fun pow (z, n) =
+            let val l = ln z
+            in exp (l * n)
+            end
+        fun sin (x, y) = (Real.*(Real.sin x, Real.cosh y),
+                          Real.*(Real.cos x, Real.sinh y))
+        fun cos (x, y) = (Real.*(Real.cos x, Real.cosh y),
+                          Real.~ (Real.*(Real.sin x, Real.sinh y)))
+        fun tan (x, y) =
+            let val (sx, cx) = (Real.sin x, Real.cos x)
+                val (shy, chy) = (Real.sinh y, Real.cosh y)
+                val a = (Real.*(sx, chy), Real.*(cx, shy))
+                val b = (Real.*(cx, chy), Real.*(Real.~ sx, shy))
+            in a / b
+            end
+        fun sinh (x, y) = (Real.*(Real.cos y, Real.sinh x),
+                           Real.*(Real.sin y, Real.cosh x))
+        fun cosh (x, y) = (Real.*(Real.cos y, Real.cosh x),
+                           Real.*(Real.sin y, Real.sinh x))
+        fun tanh (x, y) =
+            let val (sy, cy) = (Real.sin y, Real.cos y)
+                val (shx, chx) = (Real.sinh x, Real.cosh x)
+                val a = (Real.*(cy, shx), Real.*(sy, chx))
+                val b = (Real.*(cy, chx), Real.*(sy, shx))
+            in a / b
+            end
+        fun asin (z as (x,y)) =
+            let val w = sqrt (one - z * z)
+                val (x',y') = ln ((Real.~ y, x) + w)
+            in (y', Real.~ x')
+            end
+        fun acos (z as (x,y)) = 
+            let val (x', y') = sqrt (one + z * z)
+                val (x'', y'') = ln (z + (Real.~ y', x'))
+            in (y'', Real.~ x'')
+            end
+        fun atan (z as (x,y)) =
+            let val w = sqrt (one + z*z)
+                val (x',y') = ln ((Real.-(1.0, y), x) / w)
+            in (y', Real.~ x')
+            end
+        fun atan2 (y, x) = atan(y / x)
+        fun asinh x = ln (x + sqrt(one + x * x))
+        fun acosh x = ln (x + (x + one) * sqrt((x - one)/(x + one)))
+        fun atanh x = ln ((one + x) / sqrt(one - x * x))
+        fun scan getc =
+            let val scanner = Real.scan getc
+            in fn stream => 
+                  case scanner stream of
+                      NONE => NONE
+                    | SOME (a, rest) =>
+                      case scanner rest of
+                          NONE => NONE
+                        | SOME (b, rest) => SOME (make(a,b), rest)
+            end
 end (* ComplexNumber *)
 (*
  Copyright (c) Juan Jose Garcia Ripoll.
@@ -1639,68 +1639,68 @@
 *)
 structure PrettyPrint :>
     sig
-	datatype modifier =
-		 Int of int |
-		 Real of real |
-		 Complex of CNumber.t |
-		 String of string
-	val list : ('a -> string) -> 'a list  -> unit
-	val intList : int list -> unit
-	val realList : real list -> unit
-	val stringList : string list -> unit
-	val array : ('a -> string) -> 'a array -> unit
-	val intArray : int array -> unit
-	val realArray : real array -> unit
-	val stringArray : string array -> unit
-	val sequence :
-	    int -> ((int * 'a -> unit) -> 'b -> unit) -> ('a -> string) -> 'b -> unit
-	val print : modifier list -> unit
+        datatype modifier =
+                 Int of int |
+                 Real of real |
+                 Complex of CNumber.t |
+                 String of string
+        val list : ('a -> string) -> 'a list  -> unit
+        val intList : int list -> unit
+        val realList : real list -> unit
+        val stringList : string list -> unit
+        val array : ('a -> string) -> 'a array -> unit
+        val intArray : int array -> unit
+        val realArray : real array -> unit
+        val stringArray : string array -> unit
+        val sequence :
+            int -> ((int * 'a -> unit) -> 'b -> unit) -> ('a -> string) -> 'b -> unit
+        val print : modifier list -> unit
     end =
 struct
     datatype modifier =
-	     Int of int |
-	     Real of real |
-	     Complex of CNumber.t |
-	     String of string     
+             Int of int |
+             Real of real |
+             Complex of CNumber.t |
+             String of string     
     fun list _ [] = print "[]"
       | list cvt (a::resta) =
-	let fun loop a [] = (print(cvt a); print "]")
-	      | loop a (b::restb) = (print(cvt a); print ", "; loop b restb)
-	in
-	    print "[";
-	    loop a resta
-	end
+        let fun loop a [] = (print(cvt a); print "]")
+              | loop a (b::restb) = (print(cvt a); print ", "; loop b restb)
+        in
+            print "[";
+            loop a resta
+        end
     fun boolList a = list Bool.toString a
     fun intList a = list Int.toString a
     fun realList a = list Real.toString a
     fun stringList a = list (fn x => x) a
     fun array cvt a =
-	let val length = Array.length a - 1
-	    fun print_one (i,x) =
-		(print(cvt x); if not(i = length) then print ", " else ())
-	in
-	    Array.appi print_one a
-	end
+        let val length = Array.length a - 1
+            fun print_one (i,x) =
+                (print(cvt x); if not(i = length) then print ", " else ())
+        in
+            Array.appi print_one a
+        end
     fun boolArray a = array Bool.toString a
     fun intArray a = array Int.toString a
     fun realArray a = array Real.toString a
     fun stringArray a = array (fn x => x) a
     fun sequence length appi cvt seq =
-	let val length = length - 1
-	    fun print_one (i:int,x) =
-		(print(cvt x); if not(i = length) then print ", " else ())
-	in
-	    print "[";
-	    appi print_one seq;
-	    print "]\n"
-	end
+        let val length = length - 1
+            fun print_one (i:int,x) =
+                (print(cvt x); if not(i = length) then print ", " else ())
+        in
+            print "[";
+            appi print_one seq;
+            print "]\n"
+        end
     fun print b =
-	let fun printer (Int a) = INumber.toString a
-	      | printer (Real a) = RNumber.toString a
-	      | printer (Complex a) = CNumber.toString a
-	      | printer (String a) = a
-	in  List.app (fn x => (TextIO.print (printer x))) b
-	end
+        let fun printer (Int a) = INumber.toString a
+              | printer (Real a) = RNumber.toString a
+              | printer (Complex a) = CNumber.toString a
+              | printer (String a) = a
+        in  List.app (fn x => (TextIO.print (printer x))) b
+        end
 end (* PrettyPrint *)
 fun print' x = List.app print x
 (*
@@ -1710,206 +1710,206 @@
 *)
 structure INumberArray =
     struct
-	open Array
-	type array = INumber.t array
-	type vector = INumber.t vector
-	type elem  = INumber.t
-	structure Vector =
-	    struct
-		open Vector
-		type vector = INumber.t Vector.vector
-		type elem = INumber.t
-	    end
-	fun map f a = tabulate(length a, fn x => (f (sub(a,x))))
-	fun mapi f a = tabulate(length a, fn x => (f (x,sub(a,x))))
-	fun map2 f a b = tabulate(length a, fn x => (f(sub(a,x),sub(b,x))))
+        open Array
+        type array = INumber.t array
+        type vector = INumber.t vector
+        type elem  = INumber.t
+        structure Vector =
+            struct
+                open Vector
+                type vector = INumber.t Vector.vector
+                type elem = INumber.t
+            end
+        fun map f a = tabulate(length a, fn x => (f (sub(a,x))))
+        fun mapi f a = tabulate(length a, fn x => (f (x,sub(a,x))))
+        fun map2 f a b = tabulate(length a, fn x => (f(sub(a,x),sub(b,x))))
     end
 structure RNumberArray =
     struct
-	open Real64Array
-	val sub = Unsafe.Real64Array.sub
-	val update = Unsafe.Real64Array.update
-	fun map f a = tabulate(length a, fn x => (f (sub(a,x))))
-	fun mapi f a = tabulate(length a, fn x => (f (x,sub(a,x))))
-	fun map2 f a b = tabulate(length a, fn x => (f(sub(a,x),sub(b,x))))
+        open Real64Array
+        val sub = Unsafe.Real64Array.sub
+        val update = Unsafe.Real64Array.update
+        fun map f a = tabulate(length a, fn x => (f (sub(a,x))))
+        fun mapi f a = tabulate(length a, fn x => (f (x,sub(a,x))))
+        fun map2 f a b = tabulate(length a, fn x => (f(sub(a,x),sub(b,x))))
     end
 (*--------------------- COMPLEX ARRAY -------------------------*)
 structure BasicCNumberArray =
 struct
-	structure Complex : COMPLEX_NUMBER = CNumber
-	structure Array : MONO_ARRAY = RNumberArray
-	type elem = Complex.t
-	type array = Array.array * Array.array
-	val maxLen = Array.maxLen
-	fun length (a,b) = Array.length a
-	fun sub ((a,b),index) = Complex.make(Array.sub(a,index),Array.sub(b,index))
-	fun update ((a,b),index,z) =
-	    let val (re,im) = Complex.split z in
-		Array.update(a, index, re);
-		Array.update(b, index, im)
-	    end
+        structure Complex : COMPLEX_NUMBER = CNumber
+        structure Array : MONO_ARRAY = RNumberArray
+        type elem = Complex.t
+        type array = Array.array * Array.array
+        val maxLen = Array.maxLen
+        fun length (a,b) = Array.length a
+        fun sub ((a,b),index) = Complex.make(Array.sub(a,index),Array.sub(b,index))
+        fun update ((a,b),index,z) =
+            let val (re,im) = Complex.split z in
+                Array.update(a, index, re);
+                Array.update(b, index, im)
+            end
     local
         fun makeRange (a, start, NONE) = makeRange(a, start, SOME (length a - 1))
-	  | makeRange (a, start, SOME last) =
-	    let val len = length a
-		val diff = last - start
-	    in
-		if (start >= len) orelse (last >= len) then
-		    raise Subscript
-		else if diff < 0 then
-		    (a, start, 0)
-		else
-		    (a, start, diff + 1)
-	    end
+          | makeRange (a, start, SOME last) =
+            let val len = length a
+                val diff = last - start
+            in
+                if (start >= len) orelse (last >= len) then
+                    raise Subscript
+                else if diff < 0 then
+                    (a, start, 0)
+                else
+                    (a, start, diff + 1)
+            end
     in
-	fun array (size,z:elem) =
-	    let val realsize = size * 2
-		val r = Complex.realPart z
-		val i = Complex.imagPart z in
-		    (Array.array(size,r), Array.array(size,i))
-	    end
-	fun zeroarray size =
-	    (Array.array(size,Complex.Real.zero),
-	     Array.array(size,Complex.Real.zero))
-	fun tabulate (size,f) =
-	    let val a = array(size, Complex.zero)
-		fun loop i =
-		    case i = size of
-			true => a
-		      | false => (update(a, i, f i); loop (i+1))
-	    in
-		loop 0
-	    end
-	fun fromList list =
-	    let val length = List.length list
-		val a = zeroarray length
-		fun loop (_, []) = a
-		  | loop (i, z::rest) = (update(a, i, z);
-					 loop (i+1, rest))
-	    in
-		loop(0,list)
-	    end
-	fun extract range =
-	    let val (a, start, len) = makeRange range
-		fun copy i = sub(a, i + start)
-	    in tabulate(len, copy)
-	    end
-	fun concat array_list =
-	    let val total_length = foldl (op +) 0 (map length array_list)
-		val a = array(total_length, Complex.zero)
-		fun copy (_, []) = a
-		  | copy (pos, v::rest) =
-		    let fun loop i =
-			case i = 0 of
-			    true => ()
-			  | false => (update(a, i+pos, sub(v, i)); loop (i-1))
-		    in (loop (length v - 1); copy(length v + pos, rest))
-		    end
-	    in
-		copy(0, array_list)
-	    end
-	fun copy {src : array, si : int, len : int option, dst : array, di : int } =
-	    let val (a, ia, la) = makeRange (src, si, len)
-		val (b, ib, lb) = makeRange (dst, di, len)
-		fun copy i =
-		    case i < 0 of
-			true => ()
-		      | false => (update(b, i+ib, sub(a, i+ia)); copy (i-1))
-	    in copy (la - 1)
-	    end
-	val copyVec = copy
-	fun modifyi f range =
-	    let val (a, start, len) = makeRange range
-		val last = start + len
-		fun loop i =
-		    case i >= last of
-			true => ()
-		      | false => (update(a, i, f(i, sub(a,i))); loop (i+1))
-	    in loop start
-	    end
-	fun modify f a =
-	    let val last = length a
-		fun loop i =
-		    case i >= last of
-			true => ()
-		      | false => (update(a, i, f(sub(a,i))); loop (i+1))
-	    in loop 0
-	    end
-	fun app f a =
-	    let val size = length a
-		fun loop i =
-		    case i = size of
-			true => ()
-		      | false => (f(sub(a,i)); loop (i+1))
-	    in
-		loop 0
-	    end
-	fun appi f range =
-	    let val (a, start, len) = makeRange range
-		val last = start + len
-		fun loop i =
-		    case i >= last of
-			true => ()
-		      | false => (f(i, sub(a,i)); loop (i+1))
-	    in
-		loop start
-	    end
-	fun map f a =
-	    let val len = length a
-		val c = zeroarray len
-		fun loop ~1 = c
-		  | loop i = (update(a, i, f(sub(a,i))); loop (i-1))
-	    in loop (len-1)
-	    end
-	fun map2 f a b =
-	    let val len = length a
-		val c = zeroarray len
-		fun loop ~1 = c
-		  | loop i = (update(c, i, f(sub(a,i),sub(b,i)));
-			      loop (i-1))
-	    in loop (len-1)
-	    end
-	fun mapi f range =
-	    let val (a, start, len) = makeRange range
-		fun rule i = f (i+start, sub(a, i+start))
-	    in tabulate(len, rule)
-	    end
-	fun foldli f init range =
-	    let val (a, start, len) = makeRange range
-		val last = start + len - 1
-		fun loop (i, accum) =
-		    case i > last of
-			true => accum
-		      | false => loop (i+1, f(i, sub(a,i), accum))
-	    in loop (start, init)
-	    end
-	fun foldri f init range =
-	    let val (a, start, len) = makeRange range
-		val last = start + len - 1
-		fun loop (i, accum) =
-		    case i < start of
-			true => accum
-		      | false => loop (i-1, f(i, sub(a,i), accum))
-	    in loop (last, init)
-	    end
-	fun foldl f init a = foldli (fn (_, a, x) => f(a,x)) init (a,0,NONE)
-	fun foldr f init a = foldri (fn (_, x, a) => f(x,a)) init (a,0,NONE)
+        fun array (size,z:elem) =
+            let val realsize = size * 2
+                val r = Complex.realPart z
+                val i = Complex.imagPart z in
+                    (Array.array(size,r), Array.array(size,i))
+            end
+        fun zeroarray size =
+            (Array.array(size,Complex.Real.zero),
+             Array.array(size,Complex.Real.zero))
+        fun tabulate (size,f) =
+            let val a = array(size, Complex.zero)
+                fun loop i =
+                    case i = size of
+                        true => a
+                      | false => (update(a, i, f i); loop (i+1))
+            in
+                loop 0
+            end
+        fun fromList list =
+            let val length = List.length list
+                val a = zeroarray length
+                fun loop (_, []) = a
+                  | loop (i, z::rest) = (update(a, i, z);
+                                         loop (i+1, rest))
+            in
+                loop(0,list)
+            end
+        fun extract range =
+            let val (a, start, len) = makeRange range
+                fun copy i = sub(a, i + start)
+            in tabulate(len, copy)
+            end
+        fun concat array_list =
+            let val total_length = foldl (op +) 0 (map length array_list)
+                val a = array(total_length, Complex.zero)
+                fun copy (_, []) = a
+                  | copy (pos, v::rest) =
+                    let fun loop i =
+                        case i = 0 of
+                            true => ()
+                          | false => (update(a, i+pos, sub(v, i)); loop (i-1))
+                    in (loop (length v - 1); copy(length v + pos, rest))
+                    end
+            in
+                copy(0, array_list)
+            end
+        fun copy {src : array, si : int, len : int option, dst : array, di : int } =
+            let val (a, ia, la) = makeRange (src, si, len)
+                val (b, ib, lb) = makeRange (dst, di, len)
+                fun copy i =
+                    case i < 0 of
+                        true => ()
+                      | false => (update(b, i+ib, sub(a, i+ia)); copy (i-1))
+            in copy (la - 1)
+            end
+        val copyVec = copy
+        fun modifyi f range =
+            let val (a, start, len) = makeRange range
+                val last = start + len
+                fun loop i =
+                    case i >= last of
+                        true => ()
+                      | false => (update(a, i, f(i, sub(a,i))); loop (i+1))
+            in loop start
+            end
+        fun modify f a =
+            let val last = length a
+                fun loop i =
+                    case i >= last of
+                        true => ()
+                      | false => (update(a, i, f(sub(a,i))); loop (i+1))
+            in loop 0
+            end
+        fun app f a =
+            let val size = length a
+                fun loop i =
+                    case i = size of
+                        true => ()
+                      | false => (f(sub(a,i)); loop (i+1))
+            in
+                loop 0
+            end
+        fun appi f range =
+            let val (a, start, len) = makeRange range
+                val last = start + len
+                fun loop i =
+                    case i >= last of
+                        true => ()
+                      | false => (f(i, sub(a,i)); loop (i+1))
+            in
+                loop start
+            end
+        fun map f a =
+            let val len = length a
+                val c = zeroarray len
+                fun loop ~1 = c
+                  | loop i = (update(a, i, f(sub(a,i))); loop (i-1))
+            in loop (len-1)
+            end
+        fun map2 f a b =
+            let val len = length a
+                val c = zeroarray len
+                fun loop ~1 = c
+                  | loop i = (update(c, i, f(sub(a,i),sub(b,i)));
+                              loop (i-1))
+            in loop (len-1)
+            end
+        fun mapi f range =
+            let val (a, start, len) = makeRange range
+                fun rule i = f (i+start, sub(a, i+start))
+            in tabulate(len, rule)
+            end
+        fun foldli f init range =
+            let val (a, start, len) = makeRange range
+                val last = start + len - 1
+                fun loop (i, accum) =
+                    case i > last of
+                        true => accum
+                      | false => loop (i+1, f(i, sub(a,i), accum))
+            in loop (start, init)
+            end
+        fun foldri f init range =
+            let val (a, start, len) = makeRange range
+                val last = start + len - 1
+                fun loop (i, accum) =
+                    case i < start of
+                        true => accum
+                      | false => loop (i-1, f(i, sub(a,i), accum))
+            in loop (last, init)
+            end
+        fun foldl f init a = foldli (fn (_, a, x) => f(a,x)) init (a,0,NONE)
+        fun foldr f init a = foldri (fn (_, x, a) => f(x,a)) init (a,0,NONE)
     end
 end (* BasicCNumberArray *)
 structure CNumberArray =
     struct
-	structure Vector =
-	    struct
-		open BasicCNumberArray
-		type vector = array
-	    end : MONO_VECTOR
-	type vector = Vector.vector
-	open BasicCNumberArray
+        structure Vector =
+            struct
+                open BasicCNumberArray
+                type vector = array
+            end : MONO_VECTOR
+        type vector = Vector.vector
+        open BasicCNumberArray
     end (* CNumberArray *)
 structure ITensor =
     struct
-	structure Number = INumber
-	structure Array = INumberArray
+        structure Number = INumber
+        structure Array = INumberArray
 (*
  Copyright (c) Juan Jose Garcia Ripoll.
  All rights reserved.
@@ -1918,283 +1918,283 @@
 structure MonoTensor  =
     struct
 (* PARAMETERS
-	structure Array = Array
+        structure Array = Array
 *)
-	structure Index  = Index
-	type elem = Array.elem
-	type index = Index.t
-	type tensor = {shape : index, indexer : Index.indexer, data : Array.array}
-	type t = tensor
-	exception Shape
-	exception Match
-	exception Index
+        structure Index  = Index
+        type elem = Array.elem
+        type index = Index.t
+        type tensor = {shape : index, indexer : Index.indexer, data : Array.array}
+        type t = tensor
+        exception Shape
+        exception Match
+        exception Index
     local
     (*----- LOCALS -----*)
-	fun make' (shape, data) =
-	    {shape = shape, indexer = Index.indexer shape, data = data}
-	fun toInt {shape, indexer, data} index = indexer index
-	fun splitList (l as (a::rest), place) =
-	    let fun loop (left,here,right) 0 =  (List.rev left,here,right)
-		  | loop (_,_,[]) place = raise Index
-		  | loop (left,here,a::right) place = 
-		loop (here::left,a,right) (place-1)
-	    in
-		if place <= 0 then
-		    loop ([],a,rest) (List.length rest - place)
-		else
-		    loop ([],a,rest) (place - 1)
-	    end
+        fun make' (shape, data) =
+            {shape = shape, indexer = Index.indexer shape, data = data}
+        fun toInt {shape, indexer, data} index = indexer index
+        fun splitList (l as (a::rest), place) =
+            let fun loop (left,here,right) 0 =  (List.rev left,here,right)
+                  | loop (_,_,[]) place = raise Index
+                  | loop (left,here,a::right) place = 
+                loop (here::left,a,right) (place-1)
+            in
+                if place <= 0 then
+                    loop ([],a,rest) (List.length rest - place)
+                else
+                    loop ([],a,rest) (place - 1)
+            end
     in
     (*----- STRUCTURAL OPERATIONS & QUERIES ------*)
-	fun new (shape, init) =
-	    if not (Index.validShape shape) then
-		raise Shape
-	    else
-		let val length = Index.length shape in
-		    {shape = shape,
-		     indexer = Index.indexer shape,
-		     data = Array.array(length,init)}
-		end
-	fun toArray {shape, indexer, data} = data
-	fun length {shape, indexer, data} =  Array.length data
-	fun shape {shape, indexer, data} = shape
-	fun rank t = List.length (shape t)
-	fun reshape new_shape tensor =
-	    if Index.validShape new_shape then
-		case (Index.length new_shape) = length tensor of
-		    true => make'(new_shape, toArray tensor)
-		  | false => raise Match
-	    else
-		raise Shape
-	fun fromArray (s, a) =
-	    case Index.validShape s andalso 
-		 ((Index.length s) = (Array.length a)) of
-		 true => make'(s, a)
-	       | false => raise Shape
-	fun fromList (s, a) = fromArray (s, Array.fromList a)
-	fun tabulate (shape,f) =
-	    if Index.validShape shape then
-		let val last = Index.last shape
-		    val length = Index.length shape
-		    val c = Array.array(length, f last)
-		    fun dotable (c, indices, i) =
-			(Array.update(c, i, f indices);
-			 if i <= 1
-			 then c
-			 else dotable(c, Index.prev' shape indices, i-1))
-		in make'(shape,dotable(c, Index.prev' shape last, length-2))
-		end
-	    else
-		raise Shape
-	(*----- ELEMENTWISE OPERATIONS -----*)
-	fun sub (t, index) = Array.sub(#data t, toInt t index)
-	fun update (t, index, value) =
-	    Array.update(toArray t, toInt t index, value)
-	fun map f {shape, indexer, data} =
-	    {shape = shape, indexer = indexer, data = Array.map f data}
-	fun map2 f t1 t2=
-	    let val {shape=shape1, indexer=indexer1, data=data1} = t1
-		val {shape=shape2, indexer=indexer2, data=data2} = t2
-	    in
-		if Index.eq(shape1,shape2) then
-		    {shape = shape1,
-		     indexer = indexer1,
-		     data = Array.map2 f data1 data2}
-		else
-		    raise Match
-	end
-	fun appi f tensor = Array.appi f (toArray tensor)
-	fun app f tensor = Array.app f (toArray tensor)
-	fun all f tensor =
-	    let val a = toArray tensor
-	    in Loop.all(0, length tensor - 1, fn i =>
-			f (Array.sub(a, i)))
-	    end
-	fun any f tensor =
-	    let val a = toArray tensor
-	    in Loop.any(0, length tensor - 1, fn i =>
-			f (Array.sub(a, i)))
-	    end
-	fun foldl f init tensor = Array.foldl f init (toArray tensor)
-	fun foldln f init {shape, indexer, data=a} index =
-	    let val (head,lk,tail) = splitList(shape, index)
-		val li = Index.length head
-		val lj = Index.length tail
-		val c = Array.array(li * lj,init)
-		fun loopi (0, _,  _)  = ()
-		  | loopi (i, ia, ic) =
-		    (Array.update(c, ic, f(Array.sub(c,ic), Array.sub(a,ia)));
-		     loopi (i-1, ia+1, ic+1))
-		fun loopk (0, ia, _)  = ia
-		  | loopk (k, ia, ic) = (loopi (li, ia, ic);
-					 loopk (k-1, ia+li, ic))
-		fun loopj (0, _,  _)  = ()
-		  | loopj (j, ia, ic) = loopj (j-1, loopk(lk,ia,ic), ic+li)
-	    in
-		loopj (lj, 0, 0);
-		make'(head @ tail, c)
-	    end
-	(* --- POLYMORPHIC ELEMENTWISE OPERATIONS --- *)
-	fun array_map' f a =
-	    let fun apply index = f(Array.sub(a,index)) in
-		Tensor.Array.tabulate(Array.length a, apply)
-	    end
-	fun map' f t = Tensor.fromArray(shape t, array_map' f (toArray t))
-	fun map2' f t1 t2 =
-	    let val d1 = toArray t1
-		val d2 = toArray t2
-		fun apply i = f (Array.sub(d1,i), Array.sub(d2,i))
-		val len = Array.length d1
-	    in
-		if Index.eq(shape t1, shape t2) then
-		    Tensor.fromArray(shape t1, Tensor.Array.tabulate(len,apply))
-		else
-		    raise Match
-	    end
-	fun foldl' f init {shape, indexer, data=a} index =
-	    let val (head,lk,tail) = splitList(shape, index)
-		val li = Index.length head
-		val lj = Index.length tail
-		val c = Tensor.Array.array(li * lj,init)
-		fun loopi (0, _,  _)  = ()
-		  | loopi (i, ia, ic) =
-		    (Tensor.Array.update(c,ic,f(Tensor.Array.sub(c,ic),Array.sub(a,ia)));
-		     loopi (i-1, ia+1, ic+1))
-		fun loopk (0, ia, _)  = ia
-		  | loopk (k, ia, ic) = (loopi (li, ia, ic);
-					 loopk (k-1, ia+li, ic))
-		fun loopj (0, _,  _)  = ()
-		  | loopj (j, ia, ic) = loopj (j-1, loopk(lk,ia,ic), ic+li)
-	    in
-		loopj (lj, 0, 0);
-		make'(head @ tail, c)
-	    end
+        fun new (shape, init) =
+            if not (Index.validShape shape) then
+                raise Shape
+            else
+                let val length = Index.length shape in
+                    {shape = shape,
+                     indexer = Index.indexer shape,
+                     data = Array.array(length,init)}
+                end
+        fun toArray {shape, indexer, data} = data
+        fun length {shape, indexer, data} =  Array.length data
+        fun shape {shape, indexer, data} = shape
+        fun rank t = List.length (shape t)
+        fun reshape new_shape tensor =
+            if Index.validShape new_shape then
+                case (Index.length new_shape) = length tensor of
+                    true => make'(new_shape, toArray tensor)
+                  | false => raise Match
+            else
+                raise Shape
+        fun fromArray (s, a) =
+            case Index.validShape s andalso 
+                 ((Index.length s) = (Array.length a)) of
+                 true => make'(s, a)
+               | false => raise Shape
+        fun fromList (s, a) = fromArray (s, Array.fromList a)
+        fun tabulate (shape,f) =
+            if Index.validShape shape then
+                let val last = Index.last shape
+                    val length = Index.length shape
+                    val c = Array.array(length, f last)
+                    fun dotable (c, indices, i) =
+                        (Array.update(c, i, f indices);
+                         if i <= 1
+                         then c
+                         else dotable(c, Index.prev' shape indices, i-1))
+                in make'(shape,dotable(c, Index.prev' shape last, length-2))
+                end
+            else
+                raise Shape
+        (*----- ELEMENTWISE OPERATIONS -----*)
+        fun sub (t, index) = Array.sub(#data t, toInt t index)
+        fun update (t, index, value) =
+            Array.update(toArray t, toInt t index, value)
+        fun map f {shape, indexer, data} =
+            {shape = shape, indexer = indexer, data = Array.map f data}
+        fun map2 f t1 t2=
+            let val {shape=shape1, indexer=indexer1, data=data1} = t1
+                val {shape=shape2, indexer=indexer2, data=data2} = t2
+            in
+                if Index.eq(shape1,shape2) then
+                    {shape = shape1,
+                     indexer = indexer1,
+                     data = Array.map2 f data1 data2}
+                else
+                    raise Match
+        end
+        fun appi f tensor = Array.appi f (toArray tensor)
+        fun app f tensor = Array.app f (toArray tensor)
+        fun all f tensor =
+            let val a = toArray tensor
+            in Loop.all(0, length tensor - 1, fn i =>
+                        f (Array.sub(a, i)))
+            end
+        fun any f tensor =
+            let val a = toArray tensor
+            in Loop.any(0, length tensor - 1, fn i =>
+                        f (Array.sub(a, i)))
+            end
+        fun foldl f init tensor = Array.foldl f init (toArray tensor)
+        fun foldln f init {shape, indexer, data=a} index =
+            let val (head,lk,tail) = splitList(shape, index)
+                val li = Index.length head
+                val lj = Index.length tail
+                val c = Array.array(li * lj,init)
+                fun loopi (0, _,  _)  = ()
+                  | loopi (i, ia, ic) =
+                    (Array.update(c, ic, f(Array.sub(c,ic), Array.sub(a,ia)));
+                     loopi (i-1, ia+1, ic+1))
+                fun loopk (0, ia, _)  = ia
+                  | loopk (k, ia, ic) = (loopi (li, ia, ic);
+                                         loopk (k-1, ia+li, ic))
+                fun loopj (0, _,  _)  = ()
+                  | loopj (j, ia, ic) = loopj (j-1, loopk(lk,ia,ic), ic+li)
+            in
+                loopj (lj, 0, 0);
+                make'(head @ tail, c)
+            end
+        (* --- POLYMORPHIC ELEMENTWISE OPERATIONS --- *)
+        fun array_map' f a =
+            let fun apply index = f(Array.sub(a,index)) in
+                Tensor.Array.tabulate(Array.length a, apply)
+            end
+        fun map' f t = Tensor.fromArray(shape t, array_map' f (toArray t))
+        fun map2' f t1 t2 =
+            let val d1 = toArray t1
+                val d2 = toArray t2
+                fun apply i = f (Array.sub(d1,i), Array.sub(d2,i))
+                val len = Array.length d1
+            in
+                if Index.eq(shape t1, shape t2) then
+                    Tensor.fromArray(shape t1, Tensor.Array.tabulate(len,apply))
+                else
+                    raise Match
+            end
+        fun foldl' f init {shape, indexer, data=a} index =
+            let val (head,lk,tail) = splitList(shape, index)
+                val li = Index.length head
+                val lj = Index.length tail
+                val c = Tensor.Array.array(li * lj,init)
+                fun loopi (0, _,  _)  = ()
+                  | loopi (i, ia, ic) =
+                    (Tensor.Array.update(c,ic,f(Tensor.Array.sub(c,ic),Array.sub(a,ia)));
+                     loopi (i-1, ia+1, ic+1))
+                fun loopk (0, ia, _)  = ia
+                  | loopk (k, ia, ic) = (loopi (li, ia, ic);
+                                         loopk (k-1, ia+li, ic))
+                fun loopj (0, _,  _)  = ()
+                  | loopj (j, ia, ic) = loopj (j-1, loopk(lk,ia,ic), ic+li)
+            in
+                loopj (lj, 0, 0);
+                make'(head @ tail, c)
+            end
     end
     end (* MonoTensor *)
-	open MonoTensor
+        open MonoTensor
     local
-	(*
-	 LEFT INDEX CONTRACTION:
-	 a = a(i1,i2,...,in)
-	 b = b(j1,j2,...,jn)
-	 c = c(i2,...,in,j2,...,jn)
-	 = sum(a(k,i2,...,jn)*b(k,j2,...jn)) forall k
-	 MEANINGFUL VARIABLES:
-	 lk = i1 = j1
-	 li = i2*...*in
-	 lj = j2*...*jn
-	 *)
- 	fun do_fold_first a b c lk lj li =
-	    let fun loopk (0, _,  _,  accum) = accum
-		  | loopk (k, ia, ib, accum) =
-		    let val delta = Number.*(Array.sub(a,ia),Array.sub(b,ib))
-		    in loopk (k-1, ia+1, ib+1, Number.+(delta,accum))
-		    end
-		fun loopj (0, ib, ic) = c
-		  | loopj (j, ib, ic) =
-		    let fun loopi (0, ia, ic) = ic
-			  | loopi (i, ia, ic) =
-			(Array.update(c, ic, loopk(lk, ia, ib, Number.zero));
-			 loopi(i-1, ia+lk, ic+1))
-		    in
-			loopj(j-1, ib+lk, loopi(li, 0, ic))
-		    end
-	    in loopj(lj, 0, 0)
-	    end
+        (*
+         LEFT INDEX CONTRACTION:
+         a = a(i1,i2,...,in)
+         b = b(j1,j2,...,jn)
+         c = c(i2,...,in,j2,...,jn)
+         = sum(a(k,i2,...,jn)*b(k,j2,...jn)) forall k
+         MEANINGFUL VARIABLES:
+         lk = i1 = j1
+         li = i2*...*in
+         lj = j2*...*jn
+         *)
+        fun do_fold_first a b c lk lj li =
+            let fun loopk (0, _,  _,  accum) = accum
+                  | loopk (k, ia, ib, accum) =
+                    let val delta = Number.*(Array.sub(a,ia),Array.sub(b,ib))
+                    in loopk (k-1, ia+1, ib+1, Number.+(delta,accum))
+                    end
+                fun loopj (0, ib, ic) = c
+                  | loopj (j, ib, ic) =
+                    let fun loopi (0, ia, ic) = ic
+                          | loopi (i, ia, ic) =
+                        (Array.update(c, ic, loopk(lk, ia, ib, Number.zero));
+                         loopi(i-1, ia+lk, ic+1))
+                    in
+                        loopj(j-1, ib+lk, loopi(li, 0, ic))
+                    end
+            in loopj(lj, 0, 0)
+            end
     in
-	fun +* ta tb =
-	    let val (rank_a,lk::rest_a,a) = (rank ta, shape ta, toArray ta)
-		val (rank_b,lk2::rest_b,b) = (rank tb, shape tb, toArray tb)
-	    in if not(lk = lk2)
-	       then raise Match
-	       else let val li = Index.length rest_a
-			val lj = Index.length rest_b
-			val c = Array.array(li*lj,Number.zero)
-		    in fromArray(rest_a @ rest_b,
-				 do_fold_first a b c lk li lj)
-		    end
-	    end
+        fun +* ta tb =
+            let val (rank_a,lk::rest_a,a) = (rank ta, shape ta, toArray ta)
+                val (rank_b,lk2::rest_b,b) = (rank tb, shape tb, toArray tb)
+            in if not(lk = lk2)
+               then raise Match
+               else let val li = Index.length rest_a
+                        val lj = Index.length rest_b
+                        val c = Array.array(li*lj,Number.zero)
+                    in fromArray(rest_a @ rest_b,
+                                 do_fold_first a b c lk li lj)
+                    end
+            end
     end
     local
-	(*
-	 LAST INDEX CONTRACTION:
-	 a = a(i1,i2,...,in)
-	 b = b(j1,j2,...,jn)
-	 c = c(i2,...,in,j2,...,jn)
-	 = sum(mult(a(i1,i2,...,k),b(j1,j2,...,k))) forall k
-	 MEANINGFUL VARIABLES:
-	 lk = in = jn
-	 li = i1*...*i(n-1)
-	 lj = j1*...*j(n-1)
-	 *)
-	fun do_fold_last a b c lk lj li =
-	    let fun loopi (0, ia, ic, fac) = ()
-		  | loopi (i, ia, ic, fac) =
-		    let val old = Array.sub(c,ic)
-			val inc = Number.*(Array.sub(a,ia),fac)
-		    in
-			Array.update(c,ic,Number.+(old,inc));
-			loopi(i-1, ia+1, ic+1, fac)
-		    end
-		fun loopj (j, ib, ic) =
-		    let fun loopk (0, ia, ib) = ()
-			  | loopk (k, ia, ib) =
-			    (loopi(li, ia, ic, Array.sub(b,ib));
-			     loopk(k-1, ia+li, ib+lj))
-		    in case j of
-			   0 => c
-			 | _ => (loopk(lk, 0, ib);
-				 loopj(j-1, ib+1, ic+li))
-		    end (* loopj *)
-	    in
-		loopj(lj, 0, 0)
-	    end
+        (*
+         LAST INDEX CONTRACTION:
+         a = a(i1,i2,...,in)
+         b = b(j1,j2,...,jn)
+         c = c(i2,...,in,j2,...,jn)
+         = sum(mult(a(i1,i2,...,k),b(j1,j2,...,k))) forall k
+         MEANINGFUL VARIABLES:
+         lk = in = jn
+         li = i1*...*i(n-1)
+         lj = j1*...*j(n-1)
+         *)
+        fun do_fold_last a b c lk lj li =
+            let fun loopi (0, ia, ic, fac) = ()
+                  | loopi (i, ia, ic, fac) =
+                    let val old = Array.sub(c,ic)
+                        val inc = Number.*(Array.sub(a,ia),fac)
+                    in
+                        Array.update(c,ic,Number.+(old,inc));
+                        loopi(i-1, ia+1, ic+1, fac)
+                    end
+                fun loopj (j, ib, ic) =
+                    let fun loopk (0, ia, ib) = ()
+                          | loopk (k, ia, ib) =
+                            (loopi(li, ia, ic, Array.sub(b,ib));
+                             loopk(k-1, ia+li, ib+lj))
+                    in case j of
+                           0 => c
+                         | _ => (loopk(lk, 0, ib);
+                                 loopj(j-1, ib+1, ic+li))
+                    end (* loopj *)
+            in
+                loopj(lj, 0, 0)
+            end
     in
-	fun *+ ta tb  =
-	    let val (rank_a,shape_a,a) = (rank ta, shape ta, toArray ta)
-		val (rank_b,shape_b,b) = (rank tb, shape tb, toArray tb)
-		val (lk::rest_a) = List.rev shape_a
-		val (lk2::rest_b) = List.rev shape_b
-	    in if not(lk = lk2)
-	       then raise Match
-	       else let val li = Index.length rest_a
-			val lj = Index.length rest_b
-			val c = Array.array(li*lj,Number.zero)
-		    in fromArray(List.rev rest_a @ List.rev rest_b,
-				 do_fold_last a b c lk li lj)
-		    end
-	    end
+        fun *+ ta tb  =
+            let val (rank_a,shape_a,a) = (rank ta, shape ta, toArray ta)
+                val (rank_b,shape_b,b) = (rank tb, shape tb, toArray tb)
+                val (lk::rest_a) = List.rev shape_a
+                val (lk2::rest_b) = List.rev shape_b
+            in if not(lk = lk2)
+               then raise Match
+               else let val li = Index.length rest_a
+                        val lj = Index.length rest_b
+                        val c = Array.array(li*lj,Number.zero)
+                    in fromArray(List.rev rest_a @ List.rev rest_b,
+                                 do_fold_last a b c lk li lj)
+                    end
+            end
     end
-	(* ALGEBRAIC OPERATIONS *)
-	infix **
-	infix ==
-	infix !=
-	fun a + b = map2 Number.+ a b
-	fun a - b = map2 Number.- a b
-	fun a * b = map2 Number.* a b
-	fun a ** i = map (fn x => (Number.**(x,i))) a
-	fun ~ a = map Number.~ a
-	fun abs a = map Number.abs a
-	fun signum a = map Number.signum a
-	fun a == b = map2' Number.== a b
-	fun a != b = map2' Number.!= a b
-	fun toString a = raise Domain
-	fun fromInt a = new([1], Number.fromInt a)
-	(* TENSOR SPECIFIC OPERATIONS *)
-	fun *> n = map (fn x => Number.*(n,x))
-	fun print t =
-	    (PrettyPrint.intList (shape t);
-	     TextIO.print "\n";
-	     PrettyPrint.sequence (length t) appi Number.toString t)
-	fun normInf a =
-	    let fun accum (y,x) = Number.max(x,Number.abs y)
-	    in  foldl accum Number.zero a
-	    end
+        (* ALGEBRAIC OPERATIONS *)
+        infix **
+        infix ==
+        infix !=
+        fun a + b = map2 Number.+ a b
+        fun a - b = map2 Number.- a b
+        fun a * b = map2 Number.* a b
+        fun a ** i = map (fn x => (Number.**(x,i))) a
+        fun ~ a = map Number.~ a
+        fun abs a = map Number.abs a
+        fun signum a = map Number.signum a
+        fun a == b = map2' Number.== a b
+        fun a != b = map2' Number.!= a b
+        fun toString a = raise Domain
+        fun fromInt a = new([1], Number.fromInt a)
+        (* TENSOR SPECIFIC OPERATIONS *)
+        fun *> n = map (fn x => Number.*(n,x))
+        fun print t =
+            (PrettyPrint.intList (shape t);
+             TextIO.print "\n";
+             PrettyPrint.sequence (length t) appi Number.toString t)
+        fun normInf a =
+            let fun accum (y,x) = Number.max(x,Number.abs y)
+            in  foldl accum Number.zero a
+            end
     end (* NumberTensor *)
 structure RTensor =
     struct
-	structure Number = RNumber
-	structure Array = RNumberArray
+        structure Number = RNumber
+        structure Array = RNumberArray
 (*
  Copyright (c) Juan Jose Garcia Ripoll.
  All rights reserved.
@@ -2203,305 +2203,305 @@
 structure MonoTensor  =
     struct
 (* PARAMETERS
-	structure Array = Array
+        structure Array = Array
 *)
-	structure Index  = Index
-	type elem = Array.elem
-	type index = Index.t
-	type tensor = {shape : index, indexer : Index.indexer, data : Array.array}
-	type t = tensor
-	exception Shape
-	exception Match
-	exception Index
+        structure Index  = Index
+        type elem = Array.elem
+        type index = Index.t
+        type tensor = {shape : index, indexer : Index.indexer, data : Array.array}
+        type t = tensor
+        exception Shape
+        exception Match
+        exception Index
     local
     (*----- LOCALS -----*)
-	fun make' (shape, data) =
-	    {shape = shape, indexer = Index.indexer shape, data = data}
-	fun toInt {shape, indexer, data} index = indexer index
-	fun splitList (l as (a::rest), place) =
-	    let fun loop (left,here,right) 0 =  (List.rev left,here,right)
-		  | loop (_,_,[]) place = raise Index
-		  | loop (left,here,a::right) place = 
-		loop (here::left,a,right) (place-1)
-	    in
-		if place <= 0 then
-		    loop ([],a,rest) (List.length rest - place)
-		else
-		    loop ([],a,rest) (place - 1)
-	    end
+        fun make' (shape, data) =
+            {shape = shape, indexer = Index.indexer shape, data = data}
+        fun toInt {shape, indexer, data} index = indexer index
+        fun splitList (l as (a::rest), place) =
+            let fun loop (left,here,right) 0 =  (List.rev left,here,right)
+                  | loop (_,_,[]) place = raise Index
+                  | loop (left,here,a::right) place = 
+                loop (here::left,a,right) (place-1)
+            in
+                if place <= 0 then
+                    loop ([],a,rest) (List.length rest - place)
+                else
+                    loop ([],a,rest) (place - 1)
+            end
     in
     (*----- STRUCTURAL OPERATIONS & QUERIES ------*)
-	fun new (shape, init) =
-	    if not (Index.validShape shape) then
-		raise Shape
-	    else
-		let val length = Index.length shape in
-		    {shape = shape,
-		     indexer = Index.indexer shape,
-		     data = Array.array(length,init)}
-		end
-	fun toArray {shape, indexer, data} = data
-	fun length {shape, indexer, data} =  Array.length data
-	fun shape {shape, indexer, data} = shape
-	fun rank t = List.length (shape t)
-	fun reshape new_shape tensor =
-	    if Index.validShape new_shape then
-		case (Index.length new_shape) = length tensor of
-		    true => make'(new_shape, toArray tensor)
-		  | false => raise Match
-	    else
-		raise Shape
-	fun fromArray (s, a) =
-	    case Index.validShape s andalso 
-		 ((Index.length s) = (Array.length a)) of
-		 true => make'(s, a)
-	       | false => raise Shape
-	fun fromList (s, a) = fromArray (s, Array.fromList a)
-	fun tabulate (shape,f) =
-	    if Index.validShape shape then
-		let val last = Index.last shape
-		    val length = Index.length shape
-		    val c = Array.array(length, f last)
-		    fun dotable (c, indices, i) =
-			(Array.update(c, i, f indices);
-			 if i <= 1
-			 then c
-			 else dotable(c, Index.prev' shape indices, i-1))
-		in make'(shape,dotable(c, Index.prev' shape last, length-2))
-		end
-	    else
-		raise Shape
-	(*----- ELEMENTWISE OPERATIONS -----*)
-	fun sub (t, index) = Array.sub(#data t, toInt t index)
-	fun update (t, index, value) =
-	    Array.update(toArray t, toInt t index, value)
-	fun map f {shape, indexer, data} =
-	    {shape = shape, indexer = indexer, data = Array.map f data}
-	fun map2 f t1 t2=
-	    let val {shape=shape1, indexer=indexer1, data=data1} = t1
-		val {shape=shape2, indexer=indexer2, data=data2} = t2
-	    in
-		if Index.eq(shape1,shape2) then
-		    {shape = shape1,
-		     indexer = indexer1,
-		     data = Array.map2 f data1 data2}
-		else
-		    raise Match
-	end
-	fun appi f tensor = Array.appi f (toArray tensor)
-	fun app f tensor = Array.app f (toArray tensor)
-	fun all f tensor =
-	    let val a = toArray tensor
-	    in Loop.all(0, length tensor - 1, fn i =>
-			f (Array.sub(a, i)))
-	    end
-	fun any f tensor =
-	    let val a = toArray tensor
-	    in Loop.any(0, length tensor - 1, fn i =>
-			f (Array.sub(a, i)))
-	    end
-	fun foldl f init tensor = Array.foldl f init (toArray tensor)
-	fun foldln f init {shape, indexer, data=a} index =
-	    let val (head,lk,tail) = splitList(shape, index)
-		val li = Index.length head
-		val lj = Index.length tail
-		val c = Array.array(li * lj,init)
-		fun loopi (0, _,  _)  = ()
-		  | loopi (i, ia, ic) =
-		    (Array.update(c, ic, f(Array.sub(c,ic), Array.sub(a,ia)));
-		     loopi (i-1, ia+1, ic+1))
-		fun loopk (0, ia, _)  = ia
-		  | loopk (k, ia, ic) = (loopi (li, ia, ic);
-					 loopk (k-1, ia+li, ic))
-		fun loopj (0, _,  _)  = ()
-		  | loopj (j, ia, ic) = loopj (j-1, loopk(lk,ia,ic), ic+li)
-	    in
-		loopj (lj, 0, 0);
-		make'(head @ tail, c)
-	    end
-	(* --- POLYMORPHIC ELEMENTWISE OPERATIONS --- *)
-	fun array_map' f a =
-	    let fun apply index = f(Array.sub(a,index)) in
-		Tensor.Array.tabulate(Array.length a, apply)
-	    end
-	fun map' f t = Tensor.fromArray(shape t, array_map' f (toArray t))
-	fun map2' f t1 t2 =
-	    let val d1 = toArray t1
-		val d2 = toArray t2
-		fun apply i = f (Array.sub(d1,i), Array.sub(d2,i))
-		val len = Array.length d1
-	    in
-		if Index.eq(shape t1, shape t2) then
-		    Tensor.fromArray(shape t1, Tensor.Array.tabulate(len,apply))
-		else
-		    raise Match
-	    end
-	fun foldl' f init {shape, indexer, data=a} index =
-	    let val (head,lk,tail) = splitList(shape, index)
-		val li = Index.length head
-		val lj = Index.length tail
-		val c = Tensor.Array.array(li * lj,init)
-		fun loopi (0, _,  _)  = ()
-		  | loopi (i, ia, ic) =
-		    (Tensor.Array.update(c,ic,f(Tensor.Array.sub(c,ic),Array.sub(a,ia)));
-		     loopi (i-1, ia+1, ic+1))
-		fun loopk (0, ia, _)  = ia
-		  | loopk (k, ia, ic) = (loopi (li, ia, ic);
-					 loopk (k-1, ia+li, ic))
-		fun loopj (0, _,  _)  = ()
-		  | loopj (j, ia, ic) = loopj (j-1, loopk(lk,ia,ic), ic+li)
-	    in
-		loopj (lj, 0, 0);
-		make'(head @ tail, c)
-	    end
+        fun new (shape, init) =
+            if not (Index.validShape shape) then
+                raise Shape
+            else
+                let val length = Index.length shape in
+                    {shape = shape,
+                     indexer = Index.indexer shape,
+                     data = Array.array(length,init)}
+                end
+        fun toArray {shape, indexer, data} = data
+        fun length {shape, indexer, data} =  Array.length data
+        fun shape {shape, indexer, data} = shape
+        fun rank t = List.length (shape t)
+        fun reshape new_shape tensor =
+            if Index.validShape new_shape then
+                case (Index.length new_shape) = length tensor of
+                    true => make'(new_shape, toArray tensor)
+                  | false => raise Match
+            else
+                raise Shape
+        fun fromArray (s, a) =
+            case Index.validShape s andalso 
+                 ((Index.length s) = (Array.length a)) of
+                 true => make'(s, a)
+               | false => raise Shape
+        fun fromList (s, a) = fromArray (s, Array.fromList a)
+        fun tabulate (shape,f) =
+            if Index.validShape shape then
+                let val last = Index.last shape
+                    val length = Index.length shape
+                    val c = Array.array(length, f last)
+                    fun dotable (c, indices, i) =
+                        (Array.update(c, i, f indices);
+                         if i <= 1
+                         then c
+                         else dotable(c, Index.prev' shape indices, i-1))
+                in make'(shape,dotable(c, Index.prev' shape last, length-2))
+                end
+            else
+                raise Shape
+        (*----- ELEMENTWISE OPERATIONS -----*)
+        fun sub (t, index) = Array.sub(#data t, toInt t index)
+        fun update (t, index, value) =
+            Array.update(toArray t, toInt t index, value)
+        fun map f {shape, indexer, data} =
+            {shape = shape, indexer = indexer, data = Array.map f data}
+        fun map2 f t1 t2=
+            let val {shape=shape1, indexer=indexer1, data=data1} = t1
+                val {shape=shape2, indexer=indexer2, data=data2} = t2
+            in
+                if Index.eq(shape1,shape2) then
+                    {shape = shape1,
+                     indexer = indexer1,
+                     data = Array.map2 f data1 data2}
+                else
+                    raise Match
+        end
+        fun appi f tensor = Array.appi f (toArray tensor)
+        fun app f tensor = Array.app f (toArray tensor)
+        fun all f tensor =
+            let val a = toArray tensor
+            in Loop.all(0, length tensor - 1, fn i =>
+                        f (Array.sub(a, i)))
+            end
+        fun any f tensor =
+            let val a = toArray tensor
+            in Loop.any(0, length tensor - 1, fn i =>
+                        f (Array.sub(a, i)))
+            end
+        fun foldl f init tensor = Array.foldl f init (toArray tensor)
+        fun foldln f init {shape, indexer, data=a} index =
+            let val (head,lk,tail) = splitList(shape, index)
+                val li = Index.length head
+                val lj = Index.length tail
+                val c = Array.array(li * lj,init)
+                fun loopi (0, _,  _)  = ()
+                  | loopi (i, ia, ic) =
+                    (Array.update(c, ic, f(Array.sub(c,ic), Array.sub(a,ia)));
+                     loopi (i-1, ia+1, ic+1))
+                fun loopk (0, ia, _)  = ia
+                  | loopk (k, ia, ic) = (loopi (li, ia, ic);
+                                         loopk (k-1, ia+li, ic))
+                fun loopj (0, _,  _)  = ()
+                  | loopj (j, ia, ic) = loopj (j-1, loopk(lk,ia,ic), ic+li)
+            in
+                loopj (lj, 0, 0);
+                make'(head @ tail, c)
+            end
+        (* --- POLYMORPHIC ELEMENTWISE OPERATIONS --- *)
+        fun array_map' f a =
+            let fun apply index = f(Array.sub(a,index)) in
+                Tensor.Array.tabulate(Array.length a, apply)
+            end
+        fun map' f t = Tensor.fromArray(shape t, array_map' f (toArray t))
+        fun map2' f t1 t2 =
+            let val d1 = toArray t1
+                val d2 = toArray t2
+                fun apply i = f (Array.sub(d1,i), Array.sub(d2,i))
+                val len = Array.length d1
+            in
+                if Index.eq(shape t1, shape t2) then
+                    Tensor.fromArray(shape t1, Tensor.Array.tabulate(len,apply))
+                else
+                    raise Match
+            end
+        fun foldl' f init {shape, indexer, data=a} index =
+            let val (head,lk,tail) = splitList(shape, index)
+                val li = Index.length head
+                val lj = Index.length tail
+                val c = Tensor.Array.array(li * lj,init)
+                fun loopi (0, _,  _)  = ()
+                  | loopi (i, ia, ic) =
+                    (Tensor.Array.update(c,ic,f(Tensor.Array.sub(c,ic),Array.sub(a,ia)));
+                     loopi (i-1, ia+1, ic+1))
+                fun loopk (0, ia, _)  = ia
+                  | loopk (k, ia, ic) = (loopi (li, ia, ic);
+                                         loopk (k-1, ia+li, ic))
+                fun loopj (0, _,  _)  = ()
+                  | loopj (j, ia, ic) = loopj (j-1, loopk(lk,ia,ic), ic+li)
+            in
+                loopj (lj, 0, 0);
+                make'(head @ tail, c)
+            end
     end
     end (* MonoTensor *)
-	open MonoTensor
+        open MonoTensor
     local
-	(*
-	 LEFT INDEX CONTRACTION:
-	 a = a(i1,i2,...,in)
-	 b = b(j1,j2,...,jn)
-	 c = c(i2,...,in,j2,...,jn)
-	 = sum(a(k,i2,...,jn)*b(k,j2,...jn)) forall k
-	 MEANINGFUL VARIABLES:
-	 lk = i1 = j1
-	 li = i2*...*in
-	 lj = j2*...*jn
-	 *)
- 	fun do_fold_first a b c lk lj li =
-	    let fun loopk (0, _,  _,  accum) = accum
-		  | loopk (k, ia, ib, accum) =
-		    let val delta = Number.*(Array.sub(a,ia),Array.sub(b,ib))
-		    in loopk (k-1, ia+1, ib+1, Number.+(delta,accum))
-		    end
-		fun loopj (0, ib, ic) = c
-		  | loopj (j, ib, ic) =
-		    let fun loopi (0, ia, ic) = ic
-			  | loopi (i, ia, ic) =
-			(Array.update(c, ic, loopk(lk, ia, ib, Number.zero));
-			 loopi(i-1, ia+lk, ic+1))
-		    in
-			loopj(j-1, ib+lk, loopi(li, 0, ic))
-		    end
-	    in loopj(lj, 0, 0)
-	    end
+        (*
+         LEFT INDEX CONTRACTION:
+         a = a(i1,i2,...,in)
+         b = b(j1,j2,...,jn)
+         c = c(i2,...,in,j2,...,jn)
+         = sum(a(k,i2,...,jn)*b(k,j2,...jn)) forall k
+         MEANINGFUL VARIABLES:
+         lk = i1 = j1
+         li = i2*...*in
+         lj = j2*...*jn
+         *)
+        fun do_fold_first a b c lk lj li =
+            let fun loopk (0, _,  _,  accum) = accum
+                  | loopk (k, ia, ib, accum) =
+                    let val delta = Number.*(Array.sub(a,ia),Array.sub(b,ib))
+                    in loopk (k-1, ia+1, ib+1, Number.+(delta,accum))
+                    end
+                fun loopj (0, ib, ic) = c
+                  | loopj (j, ib, ic) =
+                    let fun loopi (0, ia, ic) = ic
+                          | loopi (i, ia, ic) =
+                        (Array.update(c, ic, loopk(lk, ia, ib, Number.zero));
+                         loopi(i-1, ia+lk, ic+1))
+                    in
+                        loopj(j-1, ib+lk, loopi(li, 0, ic))
+                    end
+            in loopj(lj, 0, 0)
+            end
     in
-	fun +* ta tb =
-	    let val (rank_a,lk::rest_a,a) = (rank ta, shape ta, toArray ta)
-		val (rank_b,lk2::rest_b,b) = (rank tb, shape tb, toArray tb)
-	    in if not(lk = lk2)
-	       then raise Match
-	       else let val li = Index.length rest_a
-			val lj = Index.length rest_b
-			val c = Array.array(li*lj,Number.zero)
-		    in fromArray(rest_a @ rest_b,
-				 do_fold_first a b c lk li lj)
-		    end
-	    end
+        fun +* ta tb =
+            let val (rank_a,lk::rest_a,a) = (rank ta, shape ta, toArray ta)
+                val (rank_b,lk2::rest_b,b) = (rank tb, shape tb, toArray tb)
+            in if not(lk = lk2)
+               then raise Match
+               else let val li = Index.length rest_a
+                        val lj = Index.length rest_b
+                        val c = Array.array(li*lj,Number.zero)
+                    in fromArray(rest_a @ rest_b,
+                                 do_fold_first a b c lk li lj)
+                    end
+            end
     end
     local
-	(*
-	 LAST INDEX CONTRACTION:
-	 a = a(i1,i2,...,in)
-	 b = b(j1,j2,...,jn)
-	 c = c(i2,...,in,j2,...,jn)
-	 = sum(mult(a(i1,i2,...,k),b(j1,j2,...,k))) forall k
-	 MEANINGFUL VARIABLES:
-	 lk = in = jn
-	 li = i1*...*i(n-1)
-	 lj = j1*...*j(n-1)
-	 *)
-	fun do_fold_last a b c lk lj li =
-	    let fun loopi (0, ia, ic, fac) = ()
-		  | loopi (i, ia, ic, fac) =
-		    let val old = Array.sub(c,ic)
-			val inc = Number.*(Array.sub(a,ia),fac)
-		    in
-			Array.update(c,ic,Number.+(old,inc));
-			loopi(i-1, ia+1, ic+1, fac)
-		    end
-		fun loopj (j, ib, ic) =
-		    let fun loopk (0, ia, ib) = ()
-			  | loopk (k, ia, ib) =
-			    (loopi(li, ia, ic, Array.sub(b,ib));
-			     loopk(k-1, ia+li, ib+lj))
-		    in case j of
-			   0 => c
-			 | _ => (loopk(lk, 0, ib);
-				 loopj(j-1, ib+1, ic+li))
-		    end (* loopj *)
-	    in
-		loopj(lj, 0, 0)
-	    end
+        (*
+         LAST INDEX CONTRACTION:
+         a = a(i1,i2,...,in)
+         b = b(j1,j2,...,jn)
+         c = c(i2,...,in,j2,...,jn)
+         = sum(mult(a(i1,i2,...,k),b(j1,j2,...,k))) forall k
+         MEANINGFUL VARIABLES:
+         lk = in = jn
+         li = i1*...*i(n-1)
+         lj = j1*...*j(n-1)
+         *)
+        fun do_fold_last a b c lk lj li =
+            let fun loopi (0, ia, ic, fac) = ()
+                  | loopi (i, ia, ic, fac) =
+                    let val old = Array.sub(c,ic)
+                        val inc = Number.*(Array.sub(a,ia),fac)
+                    in
+                        Array.update(c,ic,Number.+(old,inc));
+                        loopi(i-1, ia+1, ic+1, fac)
+                    end
+                fun loopj (j, ib, ic) =
+                    let fun loopk (0, ia, ib) = ()
+                          | loopk (k, ia, ib) =
+                            (loopi(li, ia, ic, Array.sub(b,ib));
+                             loopk(k-1, ia+li, ib+lj))
+                    in case j of
+                           0 => c
+                         | _ => (loopk(lk, 0, ib);
+                                 loopj(j-1, ib+1, ic+li))
+                    end (* loopj *)
+            in
+                loopj(lj, 0, 0)
+            end
     in
-	fun *+ ta tb  =
-	    let val (rank_a,shape_a,a) = (rank ta, shape ta, toArray ta)
-		val (rank_b,shape_b,b) = (rank tb, shape tb, toArray tb)
-		val (lk::rest_a) = List.rev shape_a
-		val (lk2::rest_b) = List.rev shape_b
-	    in if not(lk = lk2)
-	       then raise Match
-	       else let val li = Index.length rest_a
-			val lj = Index.length rest_b
-			val c = Array.array(li*lj,Number.zero)
-		    in fromArray(List.rev rest_a @ List.rev rest_b,
-				 do_fold_last a b c lk li lj)
-		    end
-	    end
+        fun *+ ta tb  =
+            let val (rank_a,shape_a,a) = (rank ta, shape ta, toArray ta)
+                val (rank_b,shape_b,b) = (rank tb, shape tb, toArray tb)
+                val (lk::rest_a) = List.rev shape_a
+                val (lk2::rest_b) = List.rev shape_b
+            in if not(lk = lk2)
+               then raise Match
+               else let val li = Index.length rest_a
+                        val lj = Index.length rest_b
+                        val c = Array.array(li*lj,Number.zero)
+                    in fromArray(List.rev rest_a @ List.rev rest_b,
+                                 do_fold_last a b c lk li lj)
+                    end
+            end
     end
-	(* ALGEBRAIC OPERATIONS *)
-	infix **
-	infix ==
-	infix !=
-	fun a + b = map2 Number.+ a b
-	fun a - b = map2 Number.- a b
-	fun a * b = map2 Number.* a b
-	fun a ** i = map (fn x => (Number.**(x,i))) a
-	fun ~ a = map Number.~ a
-	fun abs a = map Number.abs a
-	fun signum a = map Number.signum a
-	fun a == b = map2' Number.== a b
-	fun a != b = map2' Number.!= a b
-	fun toString a = raise Domain
-	fun fromInt a = new([1], Number.fromInt a)
-	(* TENSOR SPECIFIC OPERATIONS *)
-	fun *> n = map (fn x => Number.*(n,x))
-	fun print t =
-	    (PrettyPrint.intList (shape t);
-	     TextIO.print "\n";
-	     PrettyPrint.sequence (length t) appi Number.toString t)
-	fun a / b = map2 Number./ a b
-	fun recip a = map Number.recip a
-	fun ln a = map Number.ln a
-	fun pow (a, b) = map (fn x => (Number.pow(x,b))) a
-	fun exp a = map Number.exp a
-	fun sqrt a = map Number.sqrt a
-	fun cos a = map Number.cos a
-	fun sin a = map Number.sin a
-	fun tan a = map Number.tan a
-	fun sinh a = map Number.sinh a
-	fun cosh a = map Number.cosh a
-	fun tanh a = map Number.tanh a
-	fun asin a = map Number.asin a
-	fun acos a = map Number.acos a
-	fun atan a = map Number.atan a
-	fun asinh a = map Number.asinh a
-	fun acosh a = map Number.acosh a
-	fun atanh a = map Number.atanh a
-	fun atan2 (a,b) = map2 Number.atan2 a b
-	fun normInf a =
-	    let fun accum (y,x) = Number.max(x,Number.abs y)
-	    in  foldl accum Number.zero a
-	    end
-	fun norm1 a =
-	    let fun accum (y,x) = Number.+(x,Number.abs y)
-	    in  foldl accum Number.zero a
-	    end
-	fun norm2 a =
-	    let fun accum (y,x) = Number.+(x, Number.*(y,y))
-	    in Number.sqrt(foldl accum Number.zero a)
-	    end
+        (* ALGEBRAIC OPERATIONS *)
+        infix **
+        infix ==
+        infix !=
+        fun a + b = map2 Number.+ a b
+        fun a - b = map2 Number.- a b
+        fun a * b = map2 Number.* a b
+        fun a ** i = map (fn x => (Number.**(x,i))) a
+        fun ~ a = map Number.~ a
+        fun abs a = map Number.abs a
+        fun signum a = map Number.signum a
+        fun a == b = map2' Number.== a b
+        fun a != b = map2' Number.!= a b
+        fun toString a = raise Domain
+        fun fromInt a = new([1], Number.fromInt a)
+        (* TENSOR SPECIFIC OPERATIONS *)
+        fun *> n = map (fn x => Number.*(n,x))
+        fun print t =
+            (PrettyPrint.intList (shape t);
+             TextIO.print "\n";
+             PrettyPrint.sequence (length t) appi Number.toString t)
+        fun a / b = map2 Number./ a b
+        fun recip a = map Number.recip a
+        fun ln a = map Number.ln a
+        fun pow (a, b) = map (fn x => (Number.pow(x,b))) a
+        fun exp a = map Number.exp a
+        fun sqrt a = map Number.sqrt a
+        fun cos a = map Number.cos a
+        fun sin a = map Number.sin a
+        fun tan a = map Number.tan a
+        fun sinh a = map Number.sinh a
+        fun cosh a = map Number.cosh a
+        fun tanh a = map Number.tanh a
+        fun asin a = map Number.asin a
+        fun acos a = map Number.acos a
+        fun atan a = map Number.atan a
+        fun asinh a = map Number.asinh a
+        fun acosh a = map Number.acosh a
+        fun atanh a = map Number.atanh a
+        fun atan2 (a,b) = map2 Number.atan2 a b
+        fun normInf a =
+            let fun accum (y,x) = Number.max(x,Number.abs y)
+            in  foldl accum Number.zero a
+            end
+        fun norm1 a =
+            let fun accum (y,x) = Number.+(x,Number.abs y)
+            in  foldl accum Number.zero a
+            end
+        fun norm2 a =
+            let fun accum (y,x) = Number.+(x, Number.*(y,y))
+            in Number.sqrt(foldl accum Number.zero a)
+            end
     end (* RTensor *)
 structure CTensor =
 struct
@@ -2515,261 +2515,261 @@
 structure MonoTensor  =
     struct
 (* PARAMETERS
-	structure Array = Array
+        structure Array = Array
 *)
-	structure Index  = Index
-	type elem = Array.elem
-	type index = Index.t
-	type tensor = {shape : index, indexer : Index.indexer, data : Array.array}
-	type t = tensor
-	exception Shape
-	exception Match
-	exception Index
+        structure Index  = Index
+        type elem = Array.elem
+        type index = Index.t
+        type tensor = {shape : index, indexer : Index.indexer, data : Array.array}
+        type t = tensor
+        exception Shape
+        exception Match
+        exception Index
     local
     (*----- LOCALS -----*)
-	fun make' (shape, data) =
-	    {shape = shape, indexer = Index.indexer shape, data = data}
-	fun toInt {shape, indexer, data} index = indexer index
-	fun splitList (l as (a::rest), place) =
-	    let fun loop (left,here,right) 0 =  (List.rev left,here,right)
-		  | loop (_,_,[]) place = raise Index
-		  | loop (left,here,a::right) place = 
-		loop (here::left,a,right) (place-1)
-	    in
-		if place <= 0 then
-		    loop ([],a,rest) (List.length rest - place)
-		else
-		    loop ([],a,rest) (place - 1)
-	    end
+        fun make' (shape, data) =
+            {shape = shape, indexer = Index.indexer shape, data = data}
+        fun toInt {shape, indexer, data} index = indexer index
+        fun splitList (l as (a::rest), place) =
+            let fun loop (left,here,right) 0 =  (List.rev left,here,right)
+                  | loop (_,_,[]) place = raise Index
+                  | loop (left,here,a::right) place = 
+                loop (here::left,a,right) (place-1)
+            in
+                if place <= 0 then
+                    loop ([],a,rest) (List.length rest - place)
+                else
+                    loop ([],a,rest) (place - 1)
+            end
     in
     (*----- STRUCTURAL OPERATIONS & QUERIES ------*)
-	fun new (shape, init) =
-	    if not (Index.validShape shape) then
-		raise Shape
-	    else
-		let val length = Index.length shape in
-		    {shape = shape,
-		     indexer = Index.indexer shape,
-		     data = Array.array(length,init)}
-		end
-	fun toArray {shape, indexer, data} = data
-	fun length {shape, indexer, data} =  Array.length data
-	fun shape {shape, indexer, data} = shape
-	fun rank t = List.length (shape t)
-	fun reshape new_shape tensor =
-	    if Index.validShape new_shape then
-		case (Index.length new_shape) = length tensor of
-		    true => make'(new_shape, toArray tensor)
-		  | false => raise Match
-	    else
-		raise Shape
-	fun fromArray (s, a) =
-	    case Index.validShape s andalso 
-		 ((Index.length s) = (Array.length a)) of
-		 true => make'(s, a)
-	       | false => raise Shape
-	fun fromList (s, a) = fromArray (s, Array.fromList a)
-	fun tabulate (shape,f) =
-	    if Index.validShape shape then
-		let val last = Index.last shape
-		    val length = Index.length shape
-		    val c = Array.array(length, f last)
-		    fun dotable (c, indices, i) =
-			(Array.update(c, i, f indices);
-			 if i <= 1
-			 then c
-			 else dotable(c, Index.prev' shape indices, i-1))
-		in make'(shape,dotable(c, Index.prev' shape last, length-2))
-		end
-	    else
-		raise Shape
-	(*----- ELEMENTWISE OPERATIONS -----*)
-	fun sub (t, index) = Array.sub(#data t, toInt t index)
-	fun update (t, index, value) =
-	    Array.update(toArray t, toInt t index, value)
-	fun map f {shape, indexer, data} =
-	    {shape = shape, indexer = indexer, data = Array.map f data}
-	fun map2 f t1 t2=
-	    let val {shape=shape1, indexer=indexer1, data=data1} = t1
-		val {shape=shape2, indexer=indexer2, data=data2} = t2
-	    in
-		if Index.eq(shape1,shape2) then
-		    {shape = shape1,
-		     indexer = indexer1,
-		     data = Array.map2 f data1 data2}
-		else
-		    raise Match
-	end
-	fun appi f tensor = Array.appi f (toArray tensor, 0, NONE)
-	fun app f tensor = Array.app f (toArray tensor)
-	fun all f tensor =
-	    let val a = toArray tensor
-	    in Loop.all(0, length tensor - 1, fn i =>
-			f (Array.sub(a, i)))
-	    end
-	fun any f tensor =
-	    let val a = toArray tensor
-	    in Loop.any(0, length tensor - 1, fn i =>
-			f (Array.sub(a, i)))
-	    end
-	fun foldl f init tensor = Array.foldl f init (toArray tensor)
-	fun foldln f init {shape, indexer, data=a} index =
-	    let val (head,lk,tail) = splitList(shape, index)
-		val li = Index.length head
-		val lj = Index.length tail
-		val c = Array.array(li * lj,init)
-		fun loopi (0, _,  _)  = ()
-		  | loopi (i, ia, ic) =
-		    (Array.update(c, ic, f(Array.sub(c,ic), Array.sub(a,ia)));
-		     loopi (i-1, ia+1, ic+1))
-		fun loopk (0, ia, _)  = ia
-		  | loopk (k, ia, ic) = (loopi (li, ia, ic);
-					 loopk (k-1, ia+li, ic))
-		fun loopj (0, _,  _)  = ()
-		  | loopj (j, ia, ic) = loopj (j-1, loopk(lk,ia,ic), ic+li)
-	    in
-		loopj (lj, 0, 0);
-		make'(head @ tail, c)
-	    end
-	(* --- POLYMORPHIC ELEMENTWISE OPERATIONS --- *)
-	fun array_map' f a =
-	    let fun apply index = f(Array.sub(a,index)) in
-		Tensor.Array.tabulate(Array.length a, apply)
-	    end
-	fun map' f t = Tensor.fromArray(shape t, array_map' f (toArray t))
-	fun map2' f t1 t2 =
-	    let val d1 = toArray t1
-		val d2 = toArray t2
-		fun apply i = f (Array.sub(d1,i), Array.sub(d2,i))
-		val len = Array.length d1
-	    in
-		if Index.eq(shape t1, shape t2) then
-		    Tensor.fromArray(shape t1, Tensor.Array.tabulate(len,apply))
-		else
-		    raise Match
-	    end
-	fun foldl' f init {shape, indexer, data=a} index =
-	    let val (head,lk,tail) = splitList(shape, index)
-		val li = Index.length head
-		val lj = Index.length tail
-		val c = Tensor.Array.array(li * lj,init)
-		fun loopi (0, _,  _)  = ()
-		  | loopi (i, ia, ic) =
-		    (Tensor.Array.update(c,ic,f(Tensor.Array.sub(c,ic),Array.sub(a,ia)));
-		     loopi (i-1, ia+1, ic+1))
-		fun loopk (0, ia, _)  = ia
-		  | loopk (k, ia, ic) = (loopi (li, ia, ic);
-					 loopk (k-1, ia+li, ic))
-		fun loopj (0, _,  _)  = ()
-		  | loopj (j, ia, ic) = loopj (j-1, loopk(lk,ia,ic), ic+li)
-	    in
-		loopj (lj, 0, 0);
-		make'(head @ tail, c)
-	    end
+        fun new (shape, init) =
+            if not (Index.validShape shape) then
+                raise Shape
+            else
+                let val length = Index.length shape in
+                    {shape = shape,
+                     indexer = Index.indexer shape,
+                     data = Array.array(length,init)}
+                end
+        fun toArray {shape, indexer, data} = data
+        fun length {shape, indexer, data} =  Array.length data
+        fun shape {shape, indexer, data} = shape
+        fun rank t = List.length (shape t)
+        fun reshape new_shape tensor =
+            if Index.validShape new_shape then
+                case (Index.length new_shape) = length tensor of
+                    true => make'(new_shape, toArray tensor)
+                  | false => raise Match
+            else
+                raise Shape
+        fun fromArray (s, a) =
+            case Index.validShape s andalso 
+                 ((Index.length s) = (Array.length a)) of
+                 true => make'(s, a)
+               | false => raise Shape
+        fun fromList (s, a) = fromArray (s, Array.fromList a)
+        fun tabulate (shape,f) =
+            if Index.validShape shape then
+                let val last = Index.last shape
+                    val length = Index.length shape
+                    val c = Array.array(length, f last)
+                    fun dotable (c, indices, i) =
+                        (Array.update(c, i, f indices);
+                         if i <= 1
+                         then c
+                         else dotable(c, Index.prev' shape indices, i-1))
+                in make'(shape,dotable(c, Index.prev' shape last, length-2))
+                end
+            else
+                raise Shape
+        (*----- ELEMENTWISE OPERATIONS -----*)
+        fun sub (t, index) = Array.sub(#data t, toInt t index)
+        fun update (t, index, value) =
+            Array.update(toArray t, toInt t index, value)
+        fun map f {shape, indexer, data} =
+            {shape = shape, indexer = indexer, data = Array.map f data}
+        fun map2 f t1 t2=
+            let val {shape=shape1, indexer=indexer1, data=data1} = t1
+                val {shape=shape2, indexer=indexer2, data=data2} = t2
+            in
+                if Index.eq(shape1,shape2) then
+                    {shape = shape1,
+                     indexer = indexer1,
+                     data = Array.map2 f data1 data2}
+                else
+                    raise Match
+        end
+        fun appi f tensor = Array.appi f (toArray tensor, 0, NONE)
+        fun app f tensor = Array.app f (toArray tensor)
+        fun all f tensor =
+            let val a = toArray tensor
+            in Loop.all(0, length tensor - 1, fn i =>
+                        f (Array.sub(a, i)))
+            end
+        fun any f tensor =
+            let val a = toArray tensor
+            in Loop.any(0, length tensor - 1, fn i =>
+                        f (Array.sub(a, i)))
+            end
+        fun foldl f init tensor = Array.foldl f init (toArray tensor)
+        fun foldln f init {shape, indexer, data=a} index =
+            let val (head,lk,tail) = splitList(shape, index)
+                val li = Index.length head
+                val lj = Index.length tail
+                val c = Array.array(li * lj,init)
+                fun loopi (0, _,  _)  = ()
+                  | loopi (i, ia, ic) =
+                    (Array.update(c, ic, f(Array.sub(c,ic), Array.sub(a,ia)));
+                     loopi (i-1, ia+1, ic+1))
+                fun loopk (0, ia, _)  = ia
+                  | loopk (k, ia, ic) = (loopi (li, ia, ic);
+                                         loopk (k-1, ia+li, ic))
+                fun loopj (0, _,  _)  = ()
+                  | loopj (j, ia, ic) = loopj (j-1, loopk(lk,ia,ic), ic+li)
+            in
+                loopj (lj, 0, 0);
+                make'(head @ tail, c)
+            end
+        (* --- POLYMORPHIC ELEMENTWISE OPERATIONS --- *)
+        fun array_map' f a =
+            let fun apply index = f(Array.sub(a,index)) in
+                Tensor.Array.tabulate(Array.length a, apply)
+            end
+        fun map' f t = Tensor.fromArray(shape t, array_map' f (toArray t))
+        fun map2' f t1 t2 =
+            let val d1 = toArray t1
+                val d2 = toArray t2
+                fun apply i = f (Array.sub(d1,i), Array.sub(d2,i))
+                val len = Array.length d1
+            in
+                if Index.eq(shape t1, shape t2) then
+                    Tensor.fromArray(shape t1, Tensor.Array.tabulate(len,apply))
+                else
+                    raise Match
+            end
+        fun foldl' f init {shape, indexer, data=a} index =
+            let val (head,lk,tail) = splitList(shape, index)
+                val li = Index.length head
+                val lj = Index.length tail
+                val c = Tensor.Array.array(li * lj,init)
+                fun loopi (0, _,  _)  = ()
+                  | loopi (i, ia, ic) =
+                    (Tensor.Array.update(c,ic,f(Tensor.Array.sub(c,ic),Array.sub(a,ia)));
+                     loopi (i-1, ia+1, ic+1))
+                fun loopk (0, ia, _)  = ia
+                  | loopk (k, ia, ic) = (loopi (li, ia, ic);
+                                         loopk (k-1, ia+li, ic))
+                fun loopj (0, _,  _)  = ()
+                  | loopj (j, ia, ic) = loopj (j-1, loopk(lk,ia,ic), ic+li)
+            in
+                loopj (lj, 0, 0);
+                make'(head @ tail, c)
+            end
     end
     end (* MonoTensor *)
     open MonoTensor
     local
-	(*
-	 LEFT INDEX CONTRACTION:
-	 a = a(i1,i2,...,in)
-	 b = b(j1,j2,...,jn)
-	 c = c(i2,...,in,j2,...,jn)
-	 = sum(a(k,i2,...,jn)*b(k,j2,...jn)) forall k
-	 MEANINGFUL VARIABLES:
-	 lk = i1 = j1
-	 li = i2*...*in
-	 lj = j2*...*jn
-	 *)
-	fun do_fold_first a b c lk lj li =
-	    let fun loopk (0, _, _, r, i) = Number.make(r,i)
-		  | loopk (k, ia, ib, r, i) =
-		    let val (ar, ai) = Array.sub(a,ia)
-			val (br, bi) = Array.sub(b,ib)
-			val dr = ar * br - ai * bi
-			val di = ar * bi + ai * br
-		    in loopk (k-1, ia+1, ib+1, r+dr, i+di)
-		    end
-		fun loopj (0, ib, ic) = c
-		  | loopj (j, ib, ic) =
-		    let fun loopi (0, ia, ic) = ic
-			  | loopi (i, ia, ic) =
-			    (Array.update(c, ic, loopk(lk, ia, ib, RNumber.zero, RNumber.zero));
-			     loopi(i-1, ia+lk, ic+1))
-		    in loopj(j-1, ib+lk, loopi(li, 0, ic))
-		    end
-	    in loopj(lj, 0, 0)
-	    end
+        (*
+         LEFT INDEX CONTRACTION:
+         a = a(i1,i2,...,in)
+         b = b(j1,j2,...,jn)
+         c = c(i2,...,in,j2,...,jn)
+         = sum(a(k,i2,...,jn)*b(k,j2,...jn)) forall k
+         MEANINGFUL VARIABLES:
+         lk = i1 = j1
+         li = i2*...*in
+         lj = j2*...*jn
+         *)
+        fun do_fold_first a b c lk lj li =
+            let fun loopk (0, _, _, r, i) = Number.make(r,i)
+                  | loopk (k, ia, ib, r, i) =
+                    let val (ar, ai) = Array.sub(a,ia)
+                        val (br, bi) = Array.sub(b,ib)
+                        val dr = ar * br - ai * bi
+                        val di = ar * bi + ai * br
+                    in loopk (k-1, ia+1, ib+1, r+dr, i+di)
+                    end
+                fun loopj (0, ib, ic) = c
+                  | loopj (j, ib, ic) =
+                    let fun loopi (0, ia, ic) = ic
+                          | loopi (i, ia, ic) =
+                            (Array.update(c, ic, loopk(lk, ia, ib, RNumber.zero, RNumber.zero));
+                             loopi(i-1, ia+lk, ic+1))
+                    in loopj(j-1, ib+lk, loopi(li, 0, ic))
+                    end
+            in loopj(lj, 0, 0)
+            end
     in
-	fun +* ta tb =
-	    let val (rank_a,lk::rest_a,a) = (rank ta, shape ta, toArray ta)
-		val (rank_b,lk2::rest_b,b) = (rank tb, shape tb, toArray tb)
-	    in if not(lk = lk2)
-	       then raise Match
-	       else let val li = Index.length rest_a
-			val lj = Index.length rest_b
-			val c = Array.array(li*lj,Number.zero)
-		    in fromArray(rest_a @ rest_b, do_fold_first a b c lk li lj)
-		    end
-	    end
+        fun +* ta tb =
+            let val (rank_a,lk::rest_a,a) = (rank ta, shape ta, toArray ta)
+                val (rank_b,lk2::rest_b,b) = (rank tb, shape tb, toArray tb)
+            in if not(lk = lk2)
+               then raise Match
+               else let val li = Index.length rest_a
+                        val lj = Index.length rest_b
+                        val c = Array.array(li*lj,Number.zero)
+                    in fromArray(rest_a @ rest_b, do_fold_first a b c lk li lj)
+                    end
+            end
     end
     local
-	(*
-	 LAST INDEX CONTRACTION:
-	 a = a(i1,i2,...,in)
-	 b = b(j1,j2,...,jn)
-	 c = c(i2,...,in,j2,...,jn)
-	 = sum(mult(a(i1,i2,...,k),b(j1,j2,...,k))) forall k
-	 MEANINGFUL VARIABLES:
-	 lk = in = jn
-	 li = i1*...*i(n-1)
-	 lj = j1*...*j(n-1)
-	 *)
-	fun do_fold_last a b c lk lj li =
-	    let fun loopi(0, _, _, _, _) = ()
-		  | loopi(i, ia, ic, br, bi) =
-		    let val (cr,ci) = Array.sub(c,ic)
-			val (ar,ai) = Array.sub(a,ia)
-			val dr = (ar * br - ai * bi)
-			val di = (ar * bi + ai * br)
-		    in
-			Array.update(c,ic,Number.make(cr+dr,ci+di));
-			loopi(i-1, ia+1, ic+1, br, bi)
-		    end
-		fun loopj(j, ib, ic) =
-		    let fun loopk(0, _, _) = ()
-			  | loopk(k, ia, ib) =
-			    let val (br, bi) = Array.sub(b,ib)
-			    in
-				loopi(li, ia, ic, br, bi);
-				loopk(k-1, ia+li, ib+lj)
-			    end
-		in case j of
-		    0 => c
-		  | _ => (loopk(lk, 0, ib);
-			  loopj(j-1, ib+1, ic+li))
-		end (* loopj *)
-	    in
-		loopj(lj, 0, 0)
-	    end
+        (*
+         LAST INDEX CONTRACTION:
+         a = a(i1,i2,...,in)
+         b = b(j1,j2,...,jn)
+         c = c(i2,...,in,j2,...,jn)
+         = sum(mult(a(i1,i2,...,k),b(j1,j2,...,k))) forall k
+         MEANINGFUL VARIABLES:
+         lk = in = jn
+         li = i1*...*i(n-1)
+         lj = j1*...*j(n-1)
+         *)
+        fun do_fold_last a b c lk lj li =
+            let fun loopi(0, _, _, _, _) = ()
+                  | loopi(i, ia, ic, br, bi) =
+                    let val (cr,ci) = Array.sub(c,ic)
+                        val (ar,ai) = Array.sub(a,ia)
+                        val dr = (ar * br - ai * bi)
+                        val di = (ar * bi + ai * br)
+                    in
+                        Array.update(c,ic,Number.make(cr+dr,ci+di));
+                        loopi(i-1, ia+1, ic+1, br, bi)
+                    end
+                fun loopj(j, ib, ic) =
+                    let fun loopk(0, _, _) = ()
+                          | loopk(k, ia, ib) =
+                            let val (br, bi) = Array.sub(b,ib)
+                            in
+                                loopi(li, ia, ic, br, bi);
+                                loopk(k-1, ia+li, ib+lj)
+                            end
+                in case j of
+                    0 => c
+                  | _ => (loopk(lk, 0, ib);
+                          loopj(j-1, ib+1, ic+li))
+                end (* loopj *)
+            in
+                loopj(lj, 0, 0)
+            end
     in
-	fun *+ ta tb  =
-	    let val (rank_a,shape_a,a) = (rank ta, shape ta, toArray ta)
-		val (rank_b,shape_b,b) = (rank tb, shape tb, toArray tb)
-		val (lk::rest_a) = List.rev shape_a
-		val (lk2::rest_b) = List.rev shape_b
-	    in
-		if not(lk = lk2) then
-		    raise Match
-		else
-		    let val li = Index.length rest_a
-			val lj = Index.length rest_b
-			val c = Array.array(li*lj,Number.zero)
-		    in
-			fromArray(List.rev rest_a @ List.rev rest_b,
-				  do_fold_last a b c lk li lj)
-		    end
-	    end
+        fun *+ ta tb  =
+            let val (rank_a,shape_a,a) = (rank ta, shape ta, toArray ta)
+                val (rank_b,shape_b,b) = (rank tb, shape tb, toArray tb)
+                val (lk::rest_a) = List.rev shape_a
+                val (lk2::rest_b) = List.rev shape_b
+            in
+                if not(lk = lk2) then
+                    raise Match
+                else
+                    let val li = Index.length rest_a
+                        val lj = Index.length rest_b
+                        val c = Array.array(li*lj,Number.zero)
+                    in
+                        fromArray(List.rev rest_a @ List.rev rest_b,
+                                  do_fold_last a b c lk li lj)
+                    end
+            end
     end
     (* ALGEBRAIC OPERATIONS *)
     infix **
@@ -2789,9 +2789,9 @@
     (* TENSOR SPECIFIC OPERATIONS *)
     fun *> n = map (fn x => Number.*(n,x))
     fun print t =
-	(PrettyPrint.intList (shape t);
-	 TextIO.print "\n";
-	 PrettyPrint.sequence (length t) appi Number.toString t)
+        (PrettyPrint.intList (shape t);
+         TextIO.print "\n";
+         PrettyPrint.sequence (length t) appi Number.toString t)
     fun a / b = map2 Number./ a b
     fun recip a = map Number.recip a
     fun ln a = map Number.ln a
@@ -2812,17 +2812,17 @@
     fun atanh a = map Number.atanh a
     fun atan2 (a,b) = map2 Number.atan2 a b
     fun normInf a =
-	let fun accum (y,x) = RNumber.max(x, Number.realPart(Number.abs y))
-	in  foldl accum RNumber.zero a
-	end
+        let fun accum (y,x) = RNumber.max(x, Number.realPart(Number.abs y))
+        in  foldl accum RNumber.zero a
+        end
     fun norm1 a =
-	let fun accum (y,x) = RNumber.+(x, Number.realPart(Number.abs y))
-	in  foldl accum RNumber.zero a
-	end
+        let fun accum (y,x) = RNumber.+(x, Number.realPart(Number.abs y))
+        in  foldl accum RNumber.zero a
+        end
     fun norm2 a =
-	let fun accum (y,x) = RNumber.+(x, Number.abs2 y)
-	in RNumber.sqrt(foldl accum RNumber.zero a)
-	end
+        let fun accum (y,x) = RNumber.+(x, Number.abs2 y)
+        in RNumber.sqrt(foldl accum RNumber.zero a)
+        end
 end (* CTensor *)
 structure MathFile =
 struct
@@ -2842,13 +2842,13 @@
 
 fun listRead eltScan file =
     let val length = intRead file
-	fun eltRead file = assert(TextIO.scanStream eltScan file)
-	fun loop (0,accum) = accum
-	  | loop (i,accum) = loop(i-1, eltRead file :: accum)
+        fun eltRead file = assert(TextIO.scanStream eltScan file)
+        fun loop (0,accum) = accum
+          | loop (i,accum) = loop(i-1, eltRead file :: accum)
     in
-	if length < 0
-	then raise Data
-	else List.rev(loop(length,[]))
+        if length < 0
+        then raise Data
+        else List.rev(loop(length,[]))
     end
 
 fun intListRead file = listRead INumber.scan file
@@ -2857,35 +2857,35 @@
 
 fun intTensorRead file =
     let val shape = intListRead file
-	val length = Index.length shape
-	val first = intRead file
-	val a = ITensor.Array.array(length, first)
-	fun loop 0 = ITensor.fromArray(shape, a)
-	  | loop j = (ITensor.Array.update(a, length-j, intRead file);
-		      loop (j-1))
+        val length = Index.length shape
+        val first = intRead file
+        val a = ITensor.Array.array(length, first)
+        fun loop 0 = ITensor.fromArray(shape, a)
+          | loop j = (ITensor.Array.update(a, length-j, intRead file);
+                      loop (j-1))
     in loop (length - 1)
     end
 
 fun realTensorRead file =
     let val shape = intListRead file
-	val length = Index.length shape
-	val first = realRead file
-	val a = RTensor.Array.array(length, first)
-	fun loop 0 = RTensor.fromArray(shape, a)
-	  | loop j = (RTensor.Array.update(a, length-j, realRead file);
-		      loop (j-1))
+        val length = Index.length shape
+        val first = realRead file
+        val a = RTensor.Array.array(length, first)
+        fun loop 0 = RTensor.fromArray(shape, a)
+          | loop j = (RTensor.Array.update(a, length-j, realRead file);
+                      loop (j-1))
     in loop (length - 1)
     end
 
 fun complexTensorRead file =
     let val shape = intListRead file
-	val length = Index.length shape
-	val first = complexRead file
-	val a = CTensor.Array.array(length, first)
-	fun loop j = if j = length
-		     then CTensor.fromArray(shape, a)
-		     else (CTensor.Array.update(a, j, complexRead file);
-			   loop (j+1))
+        val length = Index.length shape
+        val first = complexRead file
+        val a = CTensor.Array.array(length, first)
+        fun loop j = if j = length
+                     then CTensor.fromArray(shape, a)
+                     else (CTensor.Array.update(a, j, complexRead file);
+                           loop (j+1))
     in loop 1
     end
 
@@ -2917,55 +2917,55 @@
 
 fun test_operator new list_op list_sizes =
     let fun test_many list_op size =
-	let fun test_op (times,f) =
-	    let val a = new size
-	    in (EvalTimer.timerOn();
-		loop times (fn _ => f(a,a));
-		let val t = LargeInt.toInt(EvalTimer.timerRead()) div times
-		    val i = StringCvt.padLeft #" " 6 (Int.toString t)
-		in print i
-		end)
-	    end
-	in
-	    print (Int.toString size);
-	    print " ";
-	    List.app test_op list_op;
-	    print "\n"
-	end
+        let fun test_op (times,f) =
+            let val a = new size
+            in (EvalTimer.timerOn();
+                loop times (fn _ => f(a,a));
+                let val t = LargeInt.toInt(EvalTimer.timerRead()) div times
+                    val i = StringCvt.padLeft #" " 6 (Int.toString t)
+                in print i
+                end)
+            end
+        in
+            print (Int.toString size);
+            print " ";
+            List.app test_op list_op;
+            print "\n"
+        end
     in List.app (test_many list_op) list_sizes
     end
 
 structure Main =
    struct
       fun one() =
-	 let
-	    val _ =
-	       let val operators = [(20, RTensor.+), (20, RTensor.* ), (20, RTensor./),
-				    (4, fn (a,b) => RTensor.+* a b),
-				    (4, fn (a,b) => RTensor.*+ a b)]
-		  fun constructor size = RTensor.new([size,size],1.0)
-	       in
-		  print "Real tensors: (+, *, /, +*, *+)\n";
-		  test_operator constructor operators [100,200,300,400,500];
-		  print "\n\n"
-	       end
-	    
+         let
+            val _ =
+               let val operators = [(20, RTensor.+), (20, RTensor.* ), (20, RTensor./),
+                                    (4, fn (a,b) => RTensor.+* a b),
+                                    (4, fn (a,b) => RTensor.*+ a b)]
+                  fun constructor size = RTensor.new([size,size],1.0)
+               in
+                  print "Real tensors: (+, *, /, +*, *+)\n";
+                  test_operator constructor operators [100,200,300,400,500];
+                  print "\n\n"
+               end
+            
       val _ =
-	 let val operators = [(20, CTensor.+), (20, CTensor.* ), (20, CTensor./),
-			      (4, fn (a,b) => CTensor.+* a b),
-			      (4, fn (a,b) => CTensor.*+ a b)]
-	    fun constructor size = CTensor.new([size,size],CNumber.one)
-	 in
-	    print "Real tensors: (+, *, /, +*, *+)\n";
-	    test_operator constructor operators [100,200,300,400,500];
-	    print "\n\n"
-	 end
-	 in ()
-	 end
+         let val operators = [(20, CTensor.+), (20, CTensor.* ), (20, CTensor./),
+                              (4, fn (a,b) => CTensor.+* a b),
+                              (4, fn (a,b) => CTensor.*+ a b)]
+            fun constructor size = CTensor.new([size,size],CNumber.one)
+         in
+            print "Real tensors: (+, *, /, +*, *+)\n";
+            test_operator constructor operators [100,200,300,400,500];
+            print "\n\n"
+         end
+         in ()
+         end
 
       fun doit n =
-	 if n = 0
-	    then ()
-	 else (one ()
-	       ; doit (n - 1))
+         if n = 0
+            then ()
+         else (one ()
+               ; doit (n - 1))
    end

Modified: mlton/branches/on-20050420-cmm-branch/benchmark/tests/tsp.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/benchmark/tests/tsp.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/benchmark/tests/tsp.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -12,39 +12,39 @@
     datatype tree
       = NULL
       | ND of {
-	    left : tree, right : tree,
-	    x : real, y : real,
-	    sz : int,
-	    prev : tree ref, next : tree ref
-	  }
+            left : tree, right : tree,
+            x : real, y : real,
+            sz : int,
+            prev : tree ref, next : tree ref
+          }
 
     fun mkNode (l, r, x, y, sz) = ND{
-	    left = l, right = r, x = x, y = y, sz = sz,
-	    prev = ref NULL, next = ref NULL
-	  }
+            left = l, right = r, x = x, y = y, sz = sz,
+            prev = ref NULL, next = ref NULL
+          }
 
     fun printTree (outS, NULL) = ()
       | printTree (outS, ND{x, y, left, right, ...}) = (
-	  TextIO.output(outS, String.concat [
-	    Real.toString x, " ", Real.toString y, "\n"]);
-	  printTree (outS, left);
-	  printTree (outS, right))
+          TextIO.output(outS, String.concat [
+            Real.toString x, " ", Real.toString y, "\n"]);
+          printTree (outS, left);
+          printTree (outS, right))
 
     fun printList (outS, NULL) = ()
       | printList (outS, start as ND{next, ...}) = let
-	  fun cycle (ND{next=next', ...}) = (next = next')
-	    | cycle _ = false
-	  fun prt (NULL) = ()
-	    | prt (t as ND{x, y, next, ...}) = (
-		TextIO.output(outS, String.concat [
-		    Real.toString x, " ", Real.toString y, "\n"
-		  ]);
-		if (cycle (!next))
-		  then ()
-		  else prt (!next))
-	  in
-	    prt start
-	  end
+          fun cycle (ND{next=next', ...}) = (next = next')
+            | cycle _ = false
+          fun prt (NULL) = ()
+            | prt (t as ND{x, y, next, ...}) = (
+                TextIO.output(outS, String.concat [
+                    Real.toString x, " ", Real.toString y, "\n"
+                  ]);
+                if (cycle (!next))
+                  then ()
+                  else prt (!next))
+          in
+            prt start
+          end
 
   end;
 
@@ -64,7 +64,7 @@
     fun setPrev (T.ND{prev, ...}, x) = prev := x
     fun setNext (T.ND{next, ...}, x) = next := x
     fun link (a as T.ND{next, ...}, b as T.ND{prev, ...}) = (
-	  next := b; prev := a)
+          next := b; prev := a)
 
     fun sameNd (T.ND{next, ...}, T.ND{next=next', ...}) = (next = next')
       | sameNd (T.NULL, T.NULL) = true
@@ -72,7 +72,7 @@
 
   (* Find Euclidean distance from a to b *)
     fun distance (T.ND{x=ax, y=ay, ...}, T.ND{x=bx, y=by, ...}) =
-	  Math.sqrt(((ax-bx)*(ax-bx)+(ay-by)*(ay-by)))
+          Math.sqrt(((ax-bx)*(ax-bx)+(ay-by)*(ay-by)))
       | distance _ = raise Fail "distance"
 
   (* sling tree nodes into a list -- requires root to be tail of list, and
@@ -80,149 +80,149 @@
    *)
     fun makeList T.NULL = T.NULL
       | makeList (t as T.ND{left, right, next = t_next, ...}) = let
-	  val retVal = (case (makeList left, makeList right)
-		 of (T.NULL, T.NULL) => t
-		  | (l as T.ND{...}, T.NULL) => (setNext(left, t); l)
-		  | (T.NULL, r as T.ND{...}) => (setNext(right, t); r)
-		  | (l as T.ND{...}, r as T.ND{...}) => (
-		      setNext(right, t); setNext(left, r); l)
-		(* end case *))
-	  in
-	    t_next := T.NULL;
-	    retVal
-	  end
+          val retVal = (case (makeList left, makeList right)
+                 of (T.NULL, T.NULL) => t
+                  | (l as T.ND{...}, T.NULL) => (setNext(left, t); l)
+                  | (T.NULL, r as T.ND{...}) => (setNext(right, t); r)
+                  | (l as T.ND{...}, r as T.ND{...}) => (
+                      setNext(right, t); setNext(left, r); l)
+                (* end case *))
+          in
+            t_next := T.NULL;
+            retVal
+          end
 
   (* reverse orientation of list *)
     fun reverse T.NULL = ()
       | reverse (t as T.ND{next, prev, ...}) = let
-	  fun rev (_, T.NULL) = ()
-	    | rev (back, tmp as T.ND{prev, next, ...}) = let
-		val tmp' = !next
-		in
-		  next := back;  setPrev(back, tmp);
-		  rev (tmp, tmp')
-		end
-	  in
-	    setNext (!prev, T.NULL);
-	    prev := T.NULL;
-	    rev (t, !next)
-	  end
+          fun rev (_, T.NULL) = ()
+            | rev (back, tmp as T.ND{prev, next, ...}) = let
+                val tmp' = !next
+                in
+                  next := back;  setPrev(back, tmp);
+                  rev (tmp, tmp')
+                end
+          in
+            setNext (!prev, T.NULL);
+            prev := T.NULL;
+            rev (t, !next)
+          end
 
   (* Use closest-point heuristic from Cormen Leiserson and Rivest *)
     fun conquer (T.NULL) = T.NULL
       | conquer t = let
-	  val (cycle as T.ND{next=cycle_next, prev=cycle_prev, ...}) = makeList t
-	  fun loop (T.NULL) = ()
-	    | loop (t as T.ND{next=ref doNext, prev, ...}) =
-		let
-		fun findMinDist (min, minDist, tmp as T.ND{next, ...}) =
-		      if (sameNd(cycle, tmp))
-			then min
-			else let
-			  val test = distance(t, tmp)
-			  in
-			    if (test < minDist)
-			      then findMinDist (tmp, test, !next)
-			      else findMinDist (min, minDist, !next)
-			  end
-		val (min as T.ND{next=ref min_next, prev=ref min_prev, ...}) =
-			findMinDist (cycle, distance(t, cycle), !cycle_next)
-		val minToNext = distance(min, min_next)
-		val minToPrev = distance(min, min_prev)
-		val tToNext = distance(t, min_next)
-		val tToPrev = distance(t, min_prev)
-		in
-		  if ((tToPrev - minToPrev) < (tToNext - minToNext))
-		    then ( (* insert between min and min_prev *)
-		      link (min_prev, t);
-		      link (t, min))
-		    else (
-		      link (min, t);
-		      link (t, min_next));
-		  loop doNext
-		end
-	  val t' = !cycle_next
-	  in
-	  (* Create initial cycle *)
-	    cycle_next := cycle;  cycle_prev := cycle;
-	    loop t';
-	    cycle
-	  end
+          val (cycle as T.ND{next=cycle_next, prev=cycle_prev, ...}) = makeList t
+          fun loop (T.NULL) = ()
+            | loop (t as T.ND{next=ref doNext, prev, ...}) =
+                let
+                fun findMinDist (min, minDist, tmp as T.ND{next, ...}) =
+                      if (sameNd(cycle, tmp))
+                        then min
+                        else let
+                          val test = distance(t, tmp)
+                          in
+                            if (test < minDist)
+                              then findMinDist (tmp, test, !next)
+                              else findMinDist (min, minDist, !next)
+                          end
+                val (min as T.ND{next=ref min_next, prev=ref min_prev, ...}) =
+                        findMinDist (cycle, distance(t, cycle), !cycle_next)
+                val minToNext = distance(min, min_next)
+                val minToPrev = distance(min, min_prev)
+                val tToNext = distance(t, min_next)
+                val tToPrev = distance(t, min_prev)
+                in
+                  if ((tToPrev - minToPrev) < (tToNext - minToNext))
+                    then ( (* insert between min and min_prev *)
+                      link (min_prev, t);
+                      link (t, min))
+                    else (
+                      link (min, t);
+                      link (t, min_next));
+                  loop doNext
+                end
+          val t' = !cycle_next
+          in
+          (* Create initial cycle *)
+            cycle_next := cycle;  cycle_prev := cycle;
+            loop t';
+            cycle
+          end
 
   (* Merge two cycles as per Karp *)
     fun merge (a as T.ND{next, ...}, b, t) = let
-	  fun locateCycle (start as T.ND{next, ...}) = let
-		fun findMin (min, minDist, tmp as T.ND{next, ...}) =
-		      if (sameNd(start, tmp))
-			then (min, minDist)
-			else let val test = distance(t, tmp)
-			  in
-			    if (test < minDist)
-			      then findMin (tmp, test, !next)
-			      else findMin (min, minDist, !next)
-			  end
-		val (min as T.ND{next=ref next', prev=ref prev', ...}, minDist) =
-			findMin (start, distance(t, start), !next)
-		val minToNext = distance(min, next')
-		val minToPrev = distance(min, prev')
-		val tToNext = distance(t, next')
-		val tToPrev = distance(t, prev')
-		in
-		  if ((tToPrev - minToPrev) < (tToNext - minToNext))
-		  (* would insert between min and prev *)
-		    then (prev', tToPrev, min, minDist)
-		  (* would insert between min and next *)
-		    else (min, minDist, next', tToNext)
-		end
-	(* Compute location for first cycle *)
-	  val (p1, tToP1, n1, tToN1) = locateCycle a
-	(* compute location for second cycle *)
-	  val (p2, tToP2, n2, tToN2) = locateCycle b
-	(* Now we have 4 choices to complete:
-	 *   1:t,p1 t,p2 n1,n2
-	 *   2:t,p1 t,n2 n1,p2
-	 *   3:t,n1 t,p2 p1,n2
-	 *   4:t,n1 t,n2 p1,p2
-	 *)
-	  val n1ToN2 = distance(n1, n2)
-	  val n1ToP2 = distance(n1, p2)
-	  val p1ToN2 = distance(p1, n2)
-	  val p1ToP2 = distance(p1, p2)
-	  fun choose (testChoice, test, choice, minDist) =
-		if (test < minDist) then (testChoice, test) else (choice, minDist)
-	  val (choice, minDist) = (1, tToP1+tToP2+n1ToN2)
-	  val (choice, minDist) = choose(2, tToP1+tToN2+n1ToP2, choice, minDist)
-	  val (choice, minDist) = choose(3, tToN1+tToP2+p1ToN2, choice, minDist)
-	  val (choice, minDist) = choose(4, tToN1+tToN2+p1ToP2, choice, minDist)
-	  in
-	    case choice
-	     of 1 => (	(* 1:p1,t t,p2 n2,n1 -- reverse 2! *)
-		  reverse n2;
-		  link (p1, t);
-		  link (t, p2);
-		  link (n2, n1))
-	      | 2 => (	(* 2:p1,t t,n2 p2,n1 -- OK *)
-		  link (p1, t);
-		  link (t, n2);
-		  link (p2, n1))
-	      | 3 => (	(* 3:p2,t t,n1 p1,n2 -- OK *)
-		  link (p2, t);
-		  link (t, n1);
-		  link (p1, n2))
-	      | 4 => (	(* 4:n1,t t,n2 p2,p1 -- reverse 1! *)
-		  reverse n1;
-		  link (n1, t);
-		  link (t, n2);
-		  link (p2, p1))
-	    (* end case *);
-	    t
-	  end (* merge *)
+          fun locateCycle (start as T.ND{next, ...}) = let
+                fun findMin (min, minDist, tmp as T.ND{next, ...}) =
+                      if (sameNd(start, tmp))
+                        then (min, minDist)
+                        else let val test = distance(t, tmp)
+                          in
+                            if (test < minDist)
+                              then findMin (tmp, test, !next)
+                              else findMin (min, minDist, !next)
+                          end
+                val (min as T.ND{next=ref next', prev=ref prev', ...}, minDist) =
+                        findMin (start, distance(t, start), !next)
+                val minToNext = distance(min, next')
+                val minToPrev = distance(min, prev')
+                val tToNext = distance(t, next')
+                val tToPrev = distance(t, prev')
+                in
+                  if ((tToPrev - minToPrev) < (tToNext - minToNext))
+                  (* would insert between min and prev *)
+                    then (prev', tToPrev, min, minDist)
+                  (* would insert between min and next *)
+                    else (min, minDist, next', tToNext)
+                end
+        (* Compute location for first cycle *)
+          val (p1, tToP1, n1, tToN1) = locateCycle a
+        (* compute location for second cycle *)
+          val (p2, tToP2, n2, tToN2) = locateCycle b
+        (* Now we have 4 choices to complete:
+         *   1:t,p1 t,p2 n1,n2
+         *   2:t,p1 t,n2 n1,p2
+         *   3:t,n1 t,p2 p1,n2
+         *   4:t,n1 t,n2 p1,p2
+         *)
+          val n1ToN2 = distance(n1, n2)
+          val n1ToP2 = distance(n1, p2)
+          val p1ToN2 = distance(p1, n2)
+          val p1ToP2 = distance(p1, p2)
+          fun choose (testChoice, test, choice, minDist) =
+                if (test < minDist) then (testChoice, test) else (choice, minDist)
+          val (choice, minDist) = (1, tToP1+tToP2+n1ToN2)
+          val (choice, minDist) = choose(2, tToP1+tToN2+n1ToP2, choice, minDist)
+          val (choice, minDist) = choose(3, tToN1+tToP2+p1ToN2, choice, minDist)
+          val (choice, minDist) = choose(4, tToN1+tToN2+p1ToP2, choice, minDist)
+          in
+            case choice
+             of 1 => (  (* 1:p1,t t,p2 n2,n1 -- reverse 2! *)
+                  reverse n2;
+                  link (p1, t);
+                  link (t, p2);
+                  link (n2, n1))
+              | 2 => (  (* 2:p1,t t,n2 p2,n1 -- OK *)
+                  link (p1, t);
+                  link (t, n2);
+                  link (p2, n1))
+              | 3 => (  (* 3:p2,t t,n1 p1,n2 -- OK *)
+                  link (p2, t);
+                  link (t, n1);
+                  link (p1, n2))
+              | 4 => (  (* 4:n1,t t,n2 p2,p1 -- reverse 1! *)
+                  reverse n1;
+                  link (n1, t);
+                  link (t, n2);
+                  link (p2, p1))
+            (* end case *);
+            t
+          end (* merge *)
 
   (* Compute TSP for the tree t -- use conquer for problems <= sz * *)
     fun tsp (t as T.ND{left, right, sz=sz', ...}, sz) =
-	  if (sz' <= sz)
-	    then conquer t
-	    else merge (tsp(left, sz), tsp(right, sz), t)
+          if (sz' <= sz)
+            then conquer t
+            else merge (tsp(left, sz), tsp(right, sz), t)
       | tsp (T.NULL, _) = T.NULL
 
   end;
@@ -350,61 +350,61 @@
     datatype axis = X_AXIS | Y_AXIS
 
     val buildTree : {
-	    n : int, dir : axis,
-	    min_x : real, min_y : real, max_x : real, max_y : real
-	  } -> Tree.tree
+            n : int, dir : axis,
+            min_x : real, min_y : real, max_x : real, max_y : real
+          } -> Tree.tree
 
   end = struct
 
     structure T = Tree
 
-    val m_e	= 2.7182818284590452354
-    val m_e2	= 7.3890560989306502274
-    val m_e3	= 20.08553692318766774179
-    val m_e6	= 403.42879349273512264299
-    val m_e12	= 162754.79141900392083592475
+    val m_e     = 2.7182818284590452354
+    val m_e2    = 7.3890560989306502274
+    val m_e3    = 20.08553692318766774179
+    val m_e6    = 403.42879349273512264299
+    val m_e12   = 162754.79141900392083592475
 
     datatype axis = X_AXIS | Y_AXIS
 
   (* builds a 2D tree of n nodes in specified range with dir as primary axis *)
     fun buildTree arg = let
-	  val rand = Rand.mkRandom 0w314
-	  fun drand48 () = Rand.norm (rand ())
-	  fun median {min, max, n} = let
-	        val t = drand48(); (* in [0.0..1.0) *)
-	        val retval = if (t > 0.5)
-		      then Math.ln(1.0-(2.0*(m_e12-1.0)*(t-0.5)/m_e12))/12.0
-		      else ~(Math.ln(1.0-(2.0*(m_e12-1.0)*t/m_e12))/12.0)
-	        in
-	          min + ((retval + 1.0) * (max - min)/2.0)
-	        end
-	  fun uniform {min, max} = min + (drand48() * (max - min))
-	  fun build {n = 0, ...} = T.NULL
-	    | build {n, dir=X_AXIS, min_x, min_y, max_x, max_y} = let
-		val med = median{min=min_y, max=max_y, n=n}
-		fun mkTree (min, max) = build{
-			n=n div 2, dir=Y_AXIS, min_x=min_x, max_x=max_x,
-			min_y=min, max_y=max
-		      }
-		in
-		  T.mkNode(
-		    mkTree(min_y, med), mkTree(med, max_y),
-		    uniform{min=min_x, max=max_x}, med, n)
-		end
-	    | build {n, dir=Y_AXIS, min_x, min_y, max_x, max_y} = let
-		val med = median{min=min_x, max=max_x, n=n}
-		fun mkTree (min, max) = build{
-			n=n div 2, dir=X_AXIS, min_x=min, max_x=max,
-			min_y=min_y, max_y=max_y
-		      }
-		in
-		  T.mkNode(
-		    mkTree(min_x, med), mkTree(med, max_x),
-		    med, uniform{min=min_y, max=max_y}, n)
-		end
-	  in
-	    build arg
-	  end
+          val rand = Rand.mkRandom 0w314
+          fun drand48 () = Rand.norm (rand ())
+          fun median {min, max, n} = let
+                val t = drand48(); (* in [0.0..1.0) *)
+                val retval = if (t > 0.5)
+                      then Math.ln(1.0-(2.0*(m_e12-1.0)*(t-0.5)/m_e12))/12.0
+                      else ~(Math.ln(1.0-(2.0*(m_e12-1.0)*t/m_e12))/12.0)
+                in
+                  min + ((retval + 1.0) * (max - min)/2.0)
+                end
+          fun uniform {min, max} = min + (drand48() * (max - min))
+          fun build {n = 0, ...} = T.NULL
+            | build {n, dir=X_AXIS, min_x, min_y, max_x, max_y} = let
+                val med = median{min=min_y, max=max_y, n=n}
+                fun mkTree (min, max) = build{
+                        n=n div 2, dir=Y_AXIS, min_x=min_x, max_x=max_x,
+                        min_y=min, max_y=max
+                      }
+                in
+                  T.mkNode(
+                    mkTree(min_y, med), mkTree(med, max_y),
+                    uniform{min=min_x, max=max_x}, med, n)
+                end
+            | build {n, dir=Y_AXIS, min_x, min_y, max_x, max_y} = let
+                val med = median{min=min_x, max=max_x, n=n}
+                fun mkTree (min, max) = build{
+                        n=n div 2, dir=X_AXIS, min_x=min, max_x=max,
+                        min_y=min_y, max_y=max_y
+                      }
+                in
+                  T.mkNode(
+                    mkTree(min_x, med), mkTree(med, max_x),
+                    med, uniform{min=min_y, max=max_y}, n)
+                end
+          in
+            build arg
+          end
 
   end; (* Build *)
 
@@ -434,44 +434,44 @@
 
     fun printLength (outS, Tree.NULL) = print "(* 0 points *)\n"
       | printLength (outS, start as Tree.ND{next, x, y, ...}) = let
-	  fun cycle (Tree.ND{next=next', ...}) = (next = next')
-	    | cycle _ = false
-	  fun distance (ax, ay, bx, by) = let
-		val dx = ax-bx and dy = ay-by
-		in
-		  Math.sqrt (dx*dx + dy*dy)
-		end
-	  fun length (Tree.NULL, px, py, n, len) = (n, len+distance(px, py, x, y))
-	    | length (t as Tree.ND{x, y, next, ...}, px, py, n, len) =
-		if (cycle t)
-		  then (n, len+distance(px, py, x, y))
-		  else length(!next, x, y, n+1, len+distance(px, py, x, y))
-	  in
-	    if (cycle(!next))
-	      then TextIO.output (outS, "(* 1 point *)\n")
-	      else let
-		val (n, len) = length(!next, x, y, 1, 0.0)
-		in
-		  TextIO.output (outS, concat[
-		      "(* ", Int.toString n, "points, cycle length = ",
-		      Real.toString len, " *)\n"
-		    ])
-		end
-	  end
+          fun cycle (Tree.ND{next=next', ...}) = (next = next')
+            | cycle _ = false
+          fun distance (ax, ay, bx, by) = let
+                val dx = ax-bx and dy = ay-by
+                in
+                  Math.sqrt (dx*dx + dy*dy)
+                end
+          fun length (Tree.NULL, px, py, n, len) = (n, len+distance(px, py, x, y))
+            | length (t as Tree.ND{x, y, next, ...}, px, py, n, len) =
+                if (cycle t)
+                  then (n, len+distance(px, py, x, y))
+                  else length(!next, x, y, n+1, len+distance(px, py, x, y))
+          in
+            if (cycle(!next))
+              then TextIO.output (outS, "(* 1 point *)\n")
+              else let
+                val (n, len) = length(!next, x, y, 1, 0.0)
+                in
+                  TextIO.output (outS, concat[
+                      "(* ", Int.toString n, "points, cycle length = ",
+                      Real.toString len, " *)\n"
+                    ])
+                end
+          end
 
     fun mkTree n = BuildTree.buildTree {
-	    n=n, dir=BuildTree.X_AXIS,
-	    min_x=0.0, max_x=1.0, 
-	    min_y=0.0, max_y=1.0
-	  }
+            n=n, dir=BuildTree.X_AXIS,
+            min_x=0.0, max_x=1.0, 
+            min_y=0.0, max_y=1.0
+          }
 
     fun doit' n = TSP.tsp (mkTree n, !divideSz)
 
     fun dumpPS outS = (
-	  TextIO.output (outS, "newgraph\n");
-	  TextIO.output (outS, "newcurve pts\n");
-	  Tree.printList (outS, doit' (!problemSz));
-	  TextIO.output (outS, "linetype solid\n"))
+          TextIO.output (outS, "newgraph\n");
+          TextIO.output (outS, "newcurve pts\n");
+          Tree.printList (outS, doit' (!problemSz));
+          TextIO.output (outS, "linetype solid\n"))
 
     fun testit strm = printLength (strm, doit' (!problemSz))
 
@@ -481,11 +481,11 @@
     val doit =
        fn n =>
        let
-	  fun loop n =
-	     if n = 0
-		then ()
-	     else (doit();
-		   loop(n-1))
+          fun loop n =
+             if n = 0
+                then ()
+             else (doit();
+                   loop(n-1))
        in loop n
        end
 

Modified: mlton/branches/on-20050420-cmm-branch/benchmark/tests/tyan.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/benchmark/tests/tyan.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/benchmark/tests/tyan.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -81,13 +81,13 @@
 
     (* arr[i] := obj :: arr[i]; extend non-empty arr if necessary *)
     fun insert (obj,i,arr) = let
-	  val len = length1 arr
+          val len = length1 arr
           val res =  if i<len then (update1(arr,i,obj::sub1(arr,i)); arr)
-	     else let val arr' = array1(Int.max(i+1,len+len),[])
-		      fun copy ~1 = (update1(arr',i,[obj]); arr')
-			| copy j = (update1(arr',j,sub1(arr,j));
-				    copy(j-1))
-		      in copy(len-1) end 
+             else let val arr' = array1(Int.max(i+1,len+len),[])
+                      fun copy ~1 = (update1(arr',i,[obj]); arr')
+                        | copy j = (update1(arr',j,sub1(arr,j));
+                                    copy(j-1))
+                      in copy(len-1) end 
           in res
           end
 
@@ -95,10 +95,10 @@
     fun arrayoflists [] = arrayoflist []
       | arrayoflists ([]::ls) = arrayoflists ls
       | arrayoflists [l] = arrayoflist l
-      | arrayoflists (ls as (obj0::_)::_) = let	 
-	  val a = array1(revfold (fn (l,n) => length l + n) ls 0,obj0)
-	  fun ins (i,[]) = i | ins (i,x::l) = (update1(a,i,x); ins(i+1,l))
-	  fun insert (i,[]) = a | insert (i,l::ll) = insert(ins(i,l),ll)
+      | arrayoflists (ls as (obj0::_)::_) = let  
+          val a = array1(revfold (fn (l,n) => length l + n) ls 0,obj0)
+          fun ins (i,[]) = i | ins (i,x::l) = (update1(a,i,x); ins(i+1,l))
+          fun insert (i,[]) = a | insert (i,l::ll) = insert(ins(i,l),ll)
           in insert(0,ls) end
 *)
 
@@ -107,27 +107,27 @@
      * remains is random.  NOTE that a is modified.
      *)
     fun stripSort compare = fn a => let
-	  infix sub
+          infix sub
 
 
-	  val op sub = sub1 and update = update1
-	  fun swap (i,j) = let val ai = a sub i
-			   in update(a,i,a sub j); update(a,j,ai) end
-	  (* sort all a[k], 0<=i<=k<j<=length a *)
-	  fun s (i,j,acc) = if i=j then acc else let
-	        val pivot = a sub ((i+j) smlnj_div 2)
-		fun partition (lo,k,hi) = if k=hi then (lo,hi) else
-		      case compare (pivot,a sub k) of
-			  Less => (swap (lo,k); partition (lo+1,k+1,hi))
-			| Equal => partition (lo,k+1,hi)
-			| Greater => (swap (k,hi-1); partition (lo,k,hi-1))
-		val (lo,hi) = partition (i,i,j)
-	        in s(i,lo,pivot::s(hi,j,acc)) end
-	   val res = s(0,length1 a,[]) 
+          val op sub = sub1 and update = update1
+          fun swap (i,j) = let val ai = a sub i
+                           in update(a,i,a sub j); update(a,j,ai) end
+          (* sort all a[k], 0<=i<=k<j<=length a *)
+          fun s (i,j,acc) = if i=j then acc else let
+                val pivot = a sub ((i+j) smlnj_div 2)
+                fun partition (lo,k,hi) = if k=hi then (lo,hi) else
+                      case compare (pivot,a sub k) of
+                          Less => (swap (lo,k); partition (lo+1,k+1,hi))
+                        | Equal => partition (lo,k+1,hi)
+                        | Greater => (swap (k,hi-1); partition (lo,k,hi-1))
+                val (lo,hi) = partition (i,i,j)
+                in s(i,lo,pivot::s(hi,j,acc)) end
+           val res = s(0,length1 a,[]) 
 
           in 
-	   res
-	  end
+           res
+          end
 end
 
 structure F = struct
@@ -156,14 +156,14 @@
       | reciprocal (F n) = let
           (* consider euclid gcd alg on (a,b) starting with a=p, b=n.
            * if maintain a = a1 n + a2 p, b = b1 n + b2 p, a>b,
-	   * then when 1 = a = a1 n + a2 p, have a1 = inverse of n mod p
+           * then when 1 = a = a1 n + a2 p, have a1 = inverse of n mod p
            * note that it is not necessary to keep a2, b2 around.
            *)
- 	  fun gcd ((a,a1),(b,b1)) =
-	      if b=1 then (* by continued fraction expansion, 0<|b1|<p *)
-		 if b1<0 then F(p+b1) else F b1
-	      else let val q = a smlnj_div b
-	           in gcd((b,b1),(a-q*b,a1-q*b1)) end
+          fun gcd ((a,a1),(b,b1)) =
+              if b=1 then (* by continued fraction expansion, 0<|b1|<p *)
+                 if b1<0 then F(p+b1) else F b1
+              else let val q = a smlnj_div b
+                   in gcd((b,b1),(a-q*b,a1-q*b1)) end
           in gcd ((p,0),(n,1)) end
 (* unused code
     fun divide (n,m) = multiply (n, reciprocal m)
@@ -176,14 +176,14 @@
 
 (* unused code
     fun power(n,k) =
-	  if k<=3 then case k of
-	      0 => one
-	    | 1 => n
-	    | 2 => multiply(n,n)
-	    | 3 => multiply(n,multiply(n,n))
-	    | _ => reciprocal (power (n,~k)) (* know k<0 *)
-	  else if andb(k,1)=0 then power(multiply(n,n),rshift(k,1))
-	       else multiply(n,power(multiply(n,n),rshift(k,1)))
+          if k<=3 then case k of
+              0 => one
+            | 1 => n
+            | 2 => multiply(n,n)
+            | 3 => multiply(n,multiply(n,n))
+            | _ => reciprocal (power (n,~k)) (* know k<0 *)
+          else if andb(k,1)=0 then power(multiply(n,n),rshift(k,1))
+               else multiply(n,power(multiply(n,n),rshift(k,1)))
 *)
 
     fun isZero (F n) = n=0
@@ -191,15 +191,15 @@
     fun equal (F n,F m) = n=m
 
     fun display (F n) = if n<=p smlnj_div 2 then Int.toString n
-			else "-" ^ Int.toString (p-n)
+                        else "-" ^ Int.toString (p-n)
 *)
 end
 
 structure M = struct (* MONO *)
     local
         val andb = op &&
-	infix sub << >> andb
-(*	val op << = Bits.lshift and op >> = Bits.rshift and op andb = Bits.andb
+        infix sub << >> andb
+(*      val op << = Bits.lshift and op >> = Bits.rshift and op andb = Bits.andb
 *)
     in
 
@@ -228,64 +228,64 @@
 
     (* x^k > y^l if x>k or x=y and k>l *)
     val compare = let
-	  fun cmp ([],[]) = Util.Equal
-	    | cmp (_::_,[]) = Util.Greater
-	    | cmp ([],_::_) = Util.Less
-	    | cmp ((u::us), (v::vs)) = if u=v then cmp (us,vs)
-		                  else if u<v then Util.Less
-		                  else (* u>v *)   Util.Greater
+          fun cmp ([],[]) = Util.Equal
+            | cmp (_::_,[]) = Util.Greater
+            | cmp ([],_::_) = Util.Less
+            | cmp ((u::us), (v::vs)) = if u=v then cmp (us,vs)
+                                  else if u<v then Util.Less
+                                  else (* u>v *)   Util.Greater
           in fn (M m,M m') => cmp(m,m') end
 
     fun display (M (l : int list)) : string = 
       let
-	fun dv v = if v<26 then chr (v+ord #"a") else chr (v-26+ord #"A")
-	fun d (vv,acc) = let val v = vv>>16 and p = vv andb 65535
-			 in if p=1 then dv v::acc
-			    else 
-			      (dv v)::(String.explode (Int.toString p)) @ acc
-			 end
+        fun dv v = if v<26 then chr (v+ord #"a") else chr (v-26+ord #"A")
+        fun d (vv,acc) = let val v = vv>>16 and p = vv andb 65535
+                         in if p=1 then dv v::acc
+                            else 
+                              (dv v)::(String.explode (Int.toString p)) @ acc
+                         end
       in String.implode(fold d l []) end
 
     val multiply = let
-	  fun mul ([],m) = m
-	    | mul (m,[]) = m
-	    | mul (u::us, v::vs) = let
-	        val uu = u andb ~65536
-		in if uu = (v andb ~65536) then let
-		      val w = u + (v andb 65535)
-		      in if uu = (w andb ~65536) then w::mul(us,vs)
-			 else 
-			   (Util.illegal 
-			    (String.concat ["Mono.multiply overflow: ",
-					    display (M(u::us)),", ",
-					    display (M(v::vs))]))
-		      end
-	           else if u>v then u :: mul(us,v::vs)
-		   else (* u<v *) v :: mul(u::us,vs)
-		end
+          fun mul ([],m) = m
+            | mul (m,[]) = m
+            | mul (u::us, v::vs) = let
+                val uu = u andb ~65536
+                in if uu = (v andb ~65536) then let
+                      val w = u + (v andb 65535)
+                      in if uu = (w andb ~65536) then w::mul(us,vs)
+                         else 
+                           (Util.illegal 
+                            (String.concat ["Mono.multiply overflow: ",
+                                            display (M(u::us)),", ",
+                                            display (M(v::vs))]))
+                      end
+                   else if u>v then u :: mul(us,v::vs)
+                   else (* u<v *) v :: mul(u::us,vs)
+                end
           in fn (M m,M m') => M (mul (m,m')) end
 
     val lcm = let
-	  fun lcm ([],m) = m
-	    | lcm (m,[]) = m
-	    | lcm (u::us, v::vs) =
-	        if u>=v then if (u andb ~65536)<v then u::lcm(us,vs)
-			     			    else u::lcm(us,v::vs)
-			else if (v andb ~65536)<u then v::lcm(us,vs)
-			     			    else v::lcm(u::us,vs)
+          fun lcm ([],m) = m
+            | lcm (m,[]) = m
+            | lcm (u::us, v::vs) =
+                if u>=v then if (u andb ~65536)<v then u::lcm(us,vs)
+                                                    else u::lcm(us,v::vs)
+                        else if (v andb ~65536)<u then v::lcm(us,vs)
+                                                    else v::lcm(u::us,vs)
           in fn (M m,M m') => M (lcm (m,m')) end
     val tryDivide = let
-	  fun rev([],l) = l | rev(x::xs,l)=rev(xs,x::l)
-	  fun d (m,[],q) = SOME(M(rev(q,m)))
-	    | d ([],_::_,_) = NONE
-	    | d (u::us,v::vs,q) =
-	        if u<v then NONE
-		else if (u andb ~65536) = (v andb ~65536) then
-		    if u=v then d(us,vs,q) else d(us,vs,u-(v andb 65535)::q)
-	        else d(us,v::vs,u::q)
+          fun rev([],l) = l | rev(x::xs,l)=rev(xs,x::l)
+          fun d (m,[],q) = SOME(M(rev(q,m)))
+            | d ([],_::_,_) = NONE
+            | d (u::us,v::vs,q) =
+                if u<v then NONE
+                else if (u andb ~65536) = (v andb ~65536) then
+                    if u=v then d(us,vs,q) else d(us,vs,u-(v andb 65535)::q)
+                else d(us,v::vs,u::q)
           in fn (M m,M m') => d (m,m',[]) end
     fun divide (m,m') =
-	  case tryDivide(m,m') of SOME q => q | NONE => raise DoesntDivide
+          case tryDivide(m,m') of SOME q => q | NONE => raise DoesntDivide
 
 end end (* local, structure M *)
 
@@ -296,9 +296,9 @@
      * children listed in increasing degree order
      *)
     datatype 'a mono_trie = MT of 'a option * (int * 'a mono_trie) list
-	                    (* tag, encoded (var,pwr) and children *)
+                            (* tag, encoded (var,pwr) and children *)
     datatype 'a mono_ideal = MI of (int * 'a mono_trie) ref
-	                    (* int maxDegree = least degree > all elements *)
+                            (* int maxDegree = least degree > all elements *)
     
     fun rev ([],l) = l | rev (x::xs,l) = rev(xs,x::l)
 (* unused code
@@ -330,83 +330,83 @@
 
     exception Found
     fun search (MI(x),M.M m') = let 
-	  val (d,mt) = !x
-	  val result = ref NONE
-	  (* exception Found of M.mono * '_a *)
-	  (* s works on remaining input mono, current output mono, tag, trie *)
-	  fun s (_,m,MT(SOME a,_)) =
-	        raise(result := SOME (M.M m,a); Found)
-	    | s (m',m,MT(NONE,trie)) = s'(m',m,trie)
-	  and s'([],_,_) = NONE
-	    | s'(_,_,[]) = NONE
-	    | s'(vp'::m',m,trie as (vp,child)::children) =
-		if smallerVar(vp',vp) then s'(m',m,trie)
-		else if grabPwr vp = 0 then (s(vp'::m',m,child);
-					     s'(vp'::m',m,children))
-		else if smallerVar(vp,vp') then NONE 
-		else if vp<=vp' then (s(m',vp::m,child);
-				      s'(vp'::m',m,children))
-		else NONE
+          val (d,mt) = !x
+          val result = ref NONE
+          (* exception Found of M.mono * '_a *)
+          (* s works on remaining input mono, current output mono, tag, trie *)
+          fun s (_,m,MT(SOME a,_)) =
+                raise(result := SOME (M.M m,a); Found)
+            | s (m',m,MT(NONE,trie)) = s'(m',m,trie)
+          and s'([],_,_) = NONE
+            | s'(_,_,[]) = NONE
+            | s'(vp'::m',m,trie as (vp,child)::children) =
+                if smallerVar(vp',vp) then s'(m',m,trie)
+                else if grabPwr vp = 0 then (s(vp'::m',m,child);
+                                             s'(vp'::m',m,children))
+                else if smallerVar(vp,vp') then NONE 
+                else if vp<=vp' then (s(m',vp::m,child);
+                                      s'(vp'::m',m,children))
+                else NONE
           in s(rev(m',[]),[],mt)
              handle Found (* (m,a) => SOME(m,a) *) => !result
           end
 
    (* assume m is a new generator, i.e. not a multiple of an existing one *)
     fun insert (MI (mi),m,a) = let
-	  val (d,mt) = !mi
-	  fun i ([],MT (SOME _,_)) = Util.illegal "MONO_IDEAL.insert duplicate"
-	    | i ([],MT (NONE,children)) = MT(SOME a,children)
-	    | i (vp::m,MT(a',[])) = MT(a',[(vp,i(m,emptyTrie))])
-	    | i (vp::m,mt as MT(a',trie as (vp',_)::_)) = let
-		fun j [] = [(vp,i(m,emptyTrie))]
-		  | j ((vp',child)::children) =
-		      if vp<vp' then (vp,i(m,emptyTrie))::(vp',child)::children
-		      else if vp=vp' then (vp',i(m,child))::children
-		      else (vp',child) :: j children
-		in 
-		   if smallerVar(vp,vp') then
-		       MT(a',[(grabVar vp,MT(NONE,trie)),(vp,i(m,emptyTrie))])
-		   else if smallerVar(vp',vp) then i(grabVar vp'::vp::m,mt)
-		   else MT(a',j trie)
-	        end
-	  in mi := (Int.max(d,M.deg m),i (rev(map encode(M.explode m),[]),mt)) end
+          val (d,mt) = !mi
+          fun i ([],MT (SOME _,_)) = Util.illegal "MONO_IDEAL.insert duplicate"
+            | i ([],MT (NONE,children)) = MT(SOME a,children)
+            | i (vp::m,MT(a',[])) = MT(a',[(vp,i(m,emptyTrie))])
+            | i (vp::m,mt as MT(a',trie as (vp',_)::_)) = let
+                fun j [] = [(vp,i(m,emptyTrie))]
+                  | j ((vp',child)::children) =
+                      if vp<vp' then (vp,i(m,emptyTrie))::(vp',child)::children
+                      else if vp=vp' then (vp',i(m,child))::children
+                      else (vp',child) :: j children
+                in 
+                   if smallerVar(vp,vp') then
+                       MT(a',[(grabVar vp,MT(NONE,trie)),(vp,i(m,emptyTrie))])
+                   else if smallerVar(vp',vp) then i(grabVar vp'::vp::m,mt)
+                   else MT(a',j trie)
+                end
+          in mi := (Int.max(d,M.deg m),i (rev(map encode(M.explode m),[]),mt)) end
 
     fun mkIdeal [] = mkEmpty() 
       | mkIdeal (orig_ms : (M.mono * '_a) list)= let
-	  fun ins ((m,a),arr) = Util.insert((m,a),M.deg m,arr)
-	  val msa = arrayoflist orig_ms
-	  val ms : (M.mono * '_a) list = 
-	      Util.stripSort (fn ((m,_),(m',_)) => M.compare (m,m')) msa
-	  val buckets = revfold ins ms (array1(0,[]))
-	  val n = length1 buckets
-	  val mi = mkEmpty()
+          fun ins ((m,a),arr) = Util.insert((m,a),M.deg m,arr)
+          val msa = arrayoflist orig_ms
+          val ms : (M.mono * '_a) list = 
+              Util.stripSort (fn ((m,_),(m',_)) => M.compare (m,m')) msa
+          val buckets = revfold ins ms (array1(0,[]))
+          val n = length1 buckets
+          val mi = mkEmpty()
           fun sort i = if i>=n then mi else let
-	        fun redundant (m,_) = case search(mi,m) of NONE => false
-						         | SOME _ => true
-		fun filter ([],l) = app (fn (m,a) => insert(mi,m,a)) l
-		  | filter (x::xx,l) = if redundant x then filter(xx,l)
-				       else filter(xx,x::l)
-		in filter(sub1(buckets,i),[]);
-		   update1(buckets,i,[]);
-		   sort(i+1)
-		end
+                fun redundant (m,_) = case search(mi,m) of NONE => false
+                                                         | SOME _ => true
+                fun filter ([],l) = app (fn (m,a) => insert(mi,m,a)) l
+                  | filter (x::xx,l) = if redundant x then filter(xx,l)
+                                       else filter(xx,x::l)
+                in filter(sub1(buckets,i),[]);
+                   update1(buckets,i,[]);
+                   sort(i+1)
+                end
           in sort 0 end
 
     fun fold g (MI(x)) init = let
-	  val (_,mt) = !x
-	  fun f(acc,m,MT(NONE,children)) = f'(acc,m,children)
-	    | f(acc,m,MT(SOME a,children)) =
-	        f'(g((M.M m,a),acc),m,children)
-	  and f'(acc,m,[]) = acc
-	    | f'(acc,m,(vp,child)::children) =
-	        if grabPwr vp=0 then f'(f(acc,m,child),m,children)
-		else f'(f(acc,vp::m,child),m,children)
-	  in f(init,[],mt) end
+          val (_,mt) = !x
+          fun f(acc,m,MT(NONE,children)) = f'(acc,m,children)
+            | f(acc,m,MT(SOME a,children)) =
+                f'(g((M.M m,a),acc),m,children)
+          and f'(acc,m,[]) = acc
+            | f'(acc,m,(vp,child)::children) =
+                if grabPwr vp=0 then f'(f(acc,m,child),m,children)
+                else f'(f(acc,vp::m,child),m,children)
+          in f(init,[],mt) end
 
 (* unused code
     fun searchDeg (mi,d) =
-	  if d>maxDeg mi then []
-	  else fold (fn ((m,a),l) => if M.deg m=d then (m,a)::l else l) mi []
+          if d>maxDeg mi then []
+          else fold (fn ((m,a),l) => if M.deg m=d then (m,a)::l else l) mi []
 *)
 
 end (* structure MI *)
@@ -436,11 +436,11 @@
 structure P = struct
 
     datatype poly = P of (F.field*M.mono) list (* descending mono order *)
-(*	
+(*      
     fun show (P x) = (print "[ "; 
-		      app (fn (f, m) =>
-			   (print "("; F.show f; print ","; M.show m; print ") ")) x;
-		      print " ]")
+                      app (fn (f, m) =>
+                           (print "("; F.show f; print ","; M.show m; print ") ")) x;
+                      print " ]")
 *)
     val zero = P []
 (* unused code unless power is used
@@ -460,23 +460,23 @@
     fun plus ([],p2) = p2
       | plus (p1,[]) = p1
       | plus ((a,m)::ms,(b,n)::ns) = case M.compare(m,n) of
-	    Util.Less => (b,n) :: plus ((a,m)::ms,ns)
-	  | Util.Greater => (a,m) :: plus (ms,(b,n)::ns)
-	  | Util.Equal => let val c = F.add(a,b)
-       		             in if F.isZero c then plus(ms,ns)
-		                else (c,m)::plus(ms,ns)
-		             end
+            Util.Less => (b,n) :: plus ((a,m)::ms,ns)
+          | Util.Greater => (a,m) :: plus (ms,(b,n)::ns)
+          | Util.Equal => let val c = F.add(a,b)
+                             in if F.isZero c then plus(ms,ns)
+                                else (c,m)::plus(ms,ns)
+                             end
     fun minus ([],p2) = neg p2
       | minus (p1,[]) = p1
       | minus ((a,m)::ms,(b,n)::ns) = case M.compare(m,n) of
-	    Util.Less => (F.negate b,n) :: minus ((a,m)::ms,ns)
-	  | Util.Greater => (a,m) :: minus (ms,(b,n)::ns)
-	  | Util.Equal => let val c = F.subtract(a,b)
-       		             in if F.isZero c then minus(ms,ns)
-			        else (c,m)::minus(ms,ns)
-		             end
+            Util.Less => (F.negate b,n) :: minus ((a,m)::ms,ns)
+          | Util.Greater => (a,m) :: minus (ms,(b,n)::ns)
+          | Util.Equal => let val c = F.subtract(a,b)
+                             in if F.isZero c then minus(ms,ns)
+                                else (c,m)::minus(ms,ns)
+                             end
     fun termMult (a,m,p) =
-	  (map (fn (a',m') => (F.multiply(a,a'),M.multiply(m,m'))) p)
+          (map (fn (a',m') => (F.multiply(a,a'),M.multiply(m,m'))) p)
 in
 (* unused code
     fun negate (P p) = P (neg p)
@@ -486,10 +486,10 @@
 
 (* unused code unless power is used
     val multiply = let
-	  fun times (p1,p2) = 
-	        revfold (fn ((a,m),tot) => plus (termMult(a,m,p2),tot)) p1 []
+          fun times (p1,p2) = 
+                revfold (fn ((a,m),tot) => plus (termMult(a,m,p2),tot)) p1 []
           in fn (P p1,P p2) => if length p1 > length p2 then P(times (p2,p1))
-			       else P(times (p1,p2))
+                               else P(times (p1,p2))
           end
 *)
 
@@ -518,26 +518,26 @@
 
 (* unused code
     fun power(p,k) =
-	  if k<=3 then case k of
-	      0 => one
-	    | 1 => p
-	    | 2 => multiply(p,p)
-	    | 3 => multiply(p,multiply(p,p))
-	    | _ => Util.illegal "POLY.power with k<0"
-	  else if andb(k,1)=0 then power(multiply(p,p),rshift(k,1))
-	       else multiply(p,power(multiply(p,p),rshift(k,1)))
+          if k<=3 then case k of
+              0 => one
+            | 1 => p
+            | 2 => multiply(p,p)
+            | 3 => multiply(p,multiply(p,p))
+            | _ => Util.illegal "POLY.power with k<0"
+          else if andb(k,1)=0 then power(multiply(p,p),rshift(k,1))
+               else multiply(p,power(multiply(p,p),rshift(k,1)))
 *)
 
     fun isZero (P []) = true | isZero (P (_::_)) = false
 
 (* unused code
     val equal = let
-	  fun eq ([],[]) = true
-	    | eq (_::_,[]) = false
-	    | eq ([],_::_) = false
-	    | eq ((a,m)::p,(b,n)::q) =
-	        F.equal(a,b) andalso M.compare(m,n)=Util.Equal
-		andalso eq (p,q)
+          fun eq ([],[]) = true
+            | eq (_::_,[]) = false
+            | eq ([],_::_) = false
+            | eq ((a,m)::p,(b,n)::q) =
+                F.equal(a,b) andalso M.compare(m,n)=Util.Equal
+                andalso eq (p,q)
           in fn (P p,P q) => eq (p,q) end
 *)
 
@@ -562,59 +562,59 @@
 (* only used if r is used
     fun display (P []) = F.display F.zero
       | display (P p) = let
-	  fun dsp (a,m) = let
-	        val s = 
-		      if M.deg m = 0 then F.display a
- 		      else if F.equal(F.one,F.negate a) then "-" ^ M.display m
-		      else if F.equal(F.one,a) then M.display m
-		      else F.display a ^ M.display m
-	        in if substring(s,0,1)="-" then s else "+" ^ s end
-	  in String.concat(map dsp p) end
+          fun dsp (a,m) = let
+                val s = 
+                      if M.deg m = 0 then F.display a
+                      else if F.equal(F.one,F.negate a) then "-" ^ M.display m
+                      else if F.equal(F.one,a) then M.display m
+                      else F.display a ^ M.display m
+                in if substring(s,0,1)="-" then s else "+" ^ s end
+          in String.concat(map dsp p) end
 *)
 end
 
 structure HP = struct
-	datatype hpoly = HP of P.poly array1
-	val log = let
-	      fun log(n,l) = if n<8 then l else log((n >> 2),1+l)
-	      in fn n => log(n,0) end
-	fun mkHPoly p = let
-	      val l = log(P.numTerms p)
-	      in HP(tabulate(l+1,fn i => if i=l then p else P.zero)) end
-	fun add(p,HP ps) = let
-	      val l = log(P.numTerms p)
-	      in if l>=length1 ps then let
-		   val n = length1 ps
-		   in HP(tabulate(n+n,
-			 fn i => if i<n then sub1(ps,i)
-			         else if i=l then p else P.zero))
-		   end
-		 else let
-		   val p = P.add(p,sub1(ps,l))
-		   in if l=log(P.numTerms p) then (update1(ps,l,p); HP ps)
-		      else (update1(ps,l,P.zero); add (p,HP ps))
-		   end
-	      end
-	fun leadAndRest (HP ps) = let
-	      val n = length1 ps
-	      fun lar (m,indices,i) = if i>=n then lar'(m,indices) else let
-		    val p = sub1(ps,i)
-		    in if P.isZero p then lar(m,indices,i+1)
-		       else if null indices then lar(P.leadMono p,[i],i+1)
-			    else case M.compare(m,P.leadMono p) of
-				Util.Less => lar(P.leadMono p,[i],i+1)
-			      | Util.Equal => lar(m,i::indices,i+1)
-			      | Util.Greater => lar(m,indices,i+1)
-		    end
-	      and lar' (_,[]) = NONE
-		| lar' (m,i::is) = let
-		    fun extract i = case P.leadAndRest(sub1(ps,i)) of
-			  ((a,_),rest) => (update1(ps,i,rest); a)
-		    val a = revfold (fn (j,b) => F.add(extract j,b))
-				    is (extract i)
-		    in if F.isZero a then lar(M.one,[],0) else SOME(a,m,HP ps)
-		    end
-	      in lar(M.one,[],0) end
+        datatype hpoly = HP of P.poly array1
+        val log = let
+              fun log(n,l) = if n<8 then l else log((n >> 2),1+l)
+              in fn n => log(n,0) end
+        fun mkHPoly p = let
+              val l = log(P.numTerms p)
+              in HP(tabulate(l+1,fn i => if i=l then p else P.zero)) end
+        fun add(p,HP ps) = let
+              val l = log(P.numTerms p)
+              in if l>=length1 ps then let
+                   val n = length1 ps
+                   in HP(tabulate(n+n,
+                         fn i => if i<n then sub1(ps,i)
+                                 else if i=l then p else P.zero))
+                   end
+                 else let
+                   val p = P.add(p,sub1(ps,l))
+                   in if l=log(P.numTerms p) then (update1(ps,l,p); HP ps)
+                      else (update1(ps,l,P.zero); add (p,HP ps))
+                   end
+              end
+        fun leadAndRest (HP ps) = let
+              val n = length1 ps
+              fun lar (m,indices,i) = if i>=n then lar'(m,indices) else let
+                    val p = sub1(ps,i)
+                    in if P.isZero p then lar(m,indices,i+1)
+                       else if null indices then lar(P.leadMono p,[i],i+1)
+                            else case M.compare(m,P.leadMono p) of
+                                Util.Less => lar(P.leadMono p,[i],i+1)
+                              | Util.Equal => lar(m,i::indices,i+1)
+                              | Util.Greater => lar(m,indices,i+1)
+                    end
+              and lar' (_,[]) = NONE
+                | lar' (m,i::is) = let
+                    fun extract i = case P.leadAndRest(sub1(ps,i)) of
+                          ((a,_),rest) => (update1(ps,i,rest); a)
+                    val a = revfold (fn (j,b) => F.add(extract j,b))
+                                    is (extract i)
+                    in if F.isZero a then lar(M.one,[],0) else SOME(a,m,HP ps)
+                    end
+              in lar(M.one,[],0) end
 end
 
 structure G = struct
@@ -631,12 +631,12 @@
 
     fun reduce (f,mi) = if P.isZero f then f else let
           (* use accumulator and reverse at end? *)
-	  fun r hp = case HP.leadAndRest hp of
-	        NONE => []
-	      | (SOME(a,m,hp)) => case MI.search(mi,m) of
-		    NONE => (a,m)::(r hp)
-		  | SOME (m',p) => r (HP.add(P.termMult(F.negate a,M.divide(m,m'),!p),hp))
-	  in P.implode(r (HP.mkHPoly f)) end
+          fun r hp = case HP.leadAndRest hp of
+                NONE => []
+              | (SOME(a,m,hp)) => case MI.search(mi,m) of
+                    NONE => (a,m)::(r hp)
+                  | SOME (m',p) => r (HP.add(P.termMult(F.negate a,M.divide(m,m'),!p),hp))
+          in P.implode(r (HP.mkHPoly f)) end
 
     (* assume f<>0 *)
     fun mkMonic f = P.scalarMult(F.reciprocal(P.leadCoeff f),f)
@@ -652,114 +652,114 @@
      * 4) store list of pairs (h,g1),...,(h,gn) as vector (h,g1,...,gn)
      *)
     fun addPairs (h,mi,pairs) = let
-	  val m = P.leadMono h
-	  val d = M.deg m
-	  fun tag ((m' : M.mono,g' : P.poly ref),quots) = (inc maybePairs;
-				     (M.divide(M.lcm(m,m'),m),(m',!g'))::quots)
-	  fun insert ((mm,(m',g')),arr) = (* recall mm = m':m *)
-	        if M.compare(m',mm)=Util.Equal then (* rel. prime *)
-		    (inc primePairs; arr)
-		else (inc usedPairs;
-		      Util.insert(P.cons((F.one,m'),g'),M.deg mm+d,arr))
-	  val buckets = MI.fold insert (MI.mkIdeal (MI.fold tag mi []))
-	      			       (array1(0,[]))
-	  fun ins (~1,pairs) = pairs
-	    | ins (i,pairs) = case sub1(buckets,i) of
-	            [] => ins(i-1,pairs)
-		  | gs => ins(i-1,Util.insert(arrayoflist(h::gs),i,pairs))
-	  in ins(length1 buckets - 1,pairs) end
+          val m = P.leadMono h
+          val d = M.deg m
+          fun tag ((m' : M.mono,g' : P.poly ref),quots) = (inc maybePairs;
+                                     (M.divide(M.lcm(m,m'),m),(m',!g'))::quots)
+          fun insert ((mm,(m',g')),arr) = (* recall mm = m':m *)
+                if M.compare(m',mm)=Util.Equal then (* rel. prime *)
+                    (inc primePairs; arr)
+                else (inc usedPairs;
+                      Util.insert(P.cons((F.one,m'),g'),M.deg mm+d,arr))
+          val buckets = MI.fold insert (MI.mkIdeal (MI.fold tag mi []))
+                                       (array1(0,[]))
+          fun ins (~1,pairs) = pairs
+            | ins (i,pairs) = case sub1(buckets,i) of
+                    [] => ins(i-1,pairs)
+                  | gs => ins(i-1,Util.insert(arrayoflist(h::gs),i,pairs))
+          in ins(length1 buckets - 1,pairs) end
 
     fun grobner fs = let
-	 fun pr l = print (String.concat (l@["\n"]))
-	  val fs = revfold (fn (f,fs) => Util.insert(f,P.deg f,fs))
-	      		   fs (array1(0,[]))
-	  (* pairs at least as long as fs, so done when done w/ all pairs *)
-	  val pairs = ref(array1(length1 fs,[]))
-	  val mi = MI.mkEmpty()
-	  val newDegGens = ref []
+         fun pr l = print (String.concat (l@["\n"]))
+          val fs = revfold (fn (f,fs) => Util.insert(f,P.deg f,fs))
+                           fs (array1(0,[]))
+          (* pairs at least as long as fs, so done when done w/ all pairs *)
+          val pairs = ref(array1(length1 fs,[]))
+          val mi = MI.mkEmpty()
+          val newDegGens = ref []
           val addGen = (* add and maybe auto-reduce new monic generator h *)
-	        if not(!autoReduce) then
-		    fn h => MI.insert (mi,P.leadMono h,ref (P.rest h))
-		else fn h => let
-		    val ((_,m),rh) = P.leadAndRest h
-		    fun autoReduce f =
-			  if P.isZero f then f
-			  else let val ((a,m'),rf) = P.leadAndRest f
-			       in case M.compare(m,m') of
-				   Util.Less => P.cons((a,m'),autoReduce rf)
-				 | Util.Equal => P.subtract(rf,P.scalarMult(a,rh))
-				 | Util.Greater => f
-			       end
-		    val rrh = ref rh
-		    in
-			MI.insert (mi,P.leadMono h,rrh);
-			app (fn f => f:=autoReduce(!f)) (!newDegGens);
-			newDegGens := rrh :: !newDegGens
-		    end
-	  val tasksleft = ref 0
-	  fun feedback () = let
-	        val n = !tasksleft
-	        in 
-		    if (n && 15)=0 then print (Int.toString n) else (); 
-			print "."; 
-			TextIO.flushOut TextIO.stdOut;
-			tasksleft := n-1
-		end
+                if not(!autoReduce) then
+                    fn h => MI.insert (mi,P.leadMono h,ref (P.rest h))
+                else fn h => let
+                    val ((_,m),rh) = P.leadAndRest h
+                    fun autoReduce f =
+                          if P.isZero f then f
+                          else let val ((a,m'),rf) = P.leadAndRest f
+                               in case M.compare(m,m') of
+                                   Util.Less => P.cons((a,m'),autoReduce rf)
+                                 | Util.Equal => P.subtract(rf,P.scalarMult(a,rh))
+                                 | Util.Greater => f
+                               end
+                    val rrh = ref rh
+                    in
+                        MI.insert (mi,P.leadMono h,rrh);
+                        app (fn f => f:=autoReduce(!f)) (!newDegGens);
+                        newDegGens := rrh :: !newDegGens
+                    end
+          val tasksleft = ref 0
+          fun feedback () = let
+                val n = !tasksleft
+                in 
+                    if (n && 15)=0 then print (Int.toString n) else (); 
+                        print "."; 
+                        TextIO.flushOut TextIO.stdOut;
+                        tasksleft := n-1
+                end
 
-	  fun try h = 
-	      let
-		  val _ = feedback ()
-		  val h = reduce(h,mi)
-	      in if P.isZero h 
-		     then ()
-		 else let val h = mkMonic h
-			  val _ = (print "#"; TextIO.flushOut TextIO.stdOut)
-		      in pairs := addPairs(h,mi,!pairs);
-			  addGen h;
-			  inc newGens
-		      end
-	      end
+          fun try h = 
+              let
+                  val _ = feedback ()
+                  val h = reduce(h,mi)
+              in if P.isZero h 
+                     then ()
+                 else let val h = mkMonic h
+                          val _ = (print "#"; TextIO.flushOut TextIO.stdOut)
+                      in pairs := addPairs(h,mi,!pairs);
+                          addGen h;
+                          inc newGens
+                      end
+              end
 
-	  fun tryPairs fgs = let
-		val ((a,m),f) = P.leadAndRest (sub1(fgs,0))
-		fun tryPair i = if i=0 then () else let
-		      val ((b,n),g) = P.leadAndRest (sub1(fgs,i))
-		      val k = M.lcm(m,n)
-		      in 
-			 try (P.spair(b,M.divide(k,m),f,a,M.divide(k,n),g));
-			 tryPair (i-1)
-		      end
-		in tryPair (length1 fgs -1) end
+          fun tryPairs fgs = let
+                val ((a,m),f) = P.leadAndRest (sub1(fgs,0))
+                fun tryPair i = if i=0 then () else let
+                      val ((b,n),g) = P.leadAndRest (sub1(fgs,i))
+                      val k = M.lcm(m,n)
+                      in 
+                         try (P.spair(b,M.divide(k,m),f,a,M.divide(k,n),g));
+                         tryPair (i-1)
+                      end
+                in tryPair (length1 fgs -1) end
 
-	  fun numPairs ([],n) = n
-	    | numPairs (p::ps,n) = numPairs(ps,n-1+length1 p)
+          fun numPairs ([],n) = n
+            | numPairs (p::ps,n) = numPairs(ps,n-1+length1 p)
 
-	  fun gb d = if d>=length1(!pairs) then mi else
-	        (* note: i nullify entries to reclaim space *)
-	        (
+          fun gb d = if d>=length1(!pairs) then mi else
+                (* note: i nullify entries to reclaim space *)
+                (
 pr ["DEGREE ",Int.toString d," with ",
     Int.toString(numPairs(sub1(!pairs,d),0))," pairs ",
     if d>=length1 fs then "0" else Int.toString(length(sub1(fs,d))),
       " generators to do"];
-		 tasksleft := numPairs(sub1(!pairs,d),0);
-		 if d>=length1 fs then () 
-		 else tasksleft := !tasksleft + length (sub1(fs,d));
-		   if d>(!maxDeg) then ()
-		   else (             
-			 reset();
-			 newDegGens := [];
-			 app tryPairs (sub1(!pairs,d));
-			 update1(!pairs,d,[]);
-			 if d>=length1 fs then ()
-			 else (app try (sub1(fs,d)); update1(fs,d,[]));
-			   pr ["maybe ",Int.toString(!maybePairs)," prime ",
-			       Int.toString (!primePairs),
-			       " using ",Int.toString (!usedPairs),
-			       "; found ",Int.toString (!newGens)]
-			   );
-		 gb(d+1)
-		)
-	  in gb 0 end
+                 tasksleft := numPairs(sub1(!pairs,d),0);
+                 if d>=length1 fs then () 
+                 else tasksleft := !tasksleft + length (sub1(fs,d));
+                   if d>(!maxDeg) then ()
+                   else (             
+                         reset();
+                         newDegGens := [];
+                         app tryPairs (sub1(!pairs,d));
+                         update1(!pairs,d,[]);
+                         if d>=length1 fs then ()
+                         else (app try (sub1(fs,d)); update1(fs,d,[]));
+                           pr ["maybe ",Int.toString(!maybePairs)," prime ",
+                               Int.toString (!primePairs),
+                               " using ",Int.toString (!usedPairs),
+                               "; found ",Int.toString (!newGens)]
+                           );
+                 gb(d+1)
+                )
+          in gb 0 end
 
 local
     (* grammar:
@@ -773,58 +773,58 @@
     *)
     datatype char = Dig of int | Var of int | Sign of int
     fun char ch =
-	let val och = ord ch in
-	  if ord #"0"<=och andalso och<=ord #"9" then Dig (och - ord #"0")
-	  else if ord #"a"<=och andalso och<=ord #"z" then Var (och - ord #"a")
-	  else if ord #"A"<=och andalso och<=ord #"Z" then Var (och - ord #"A" + 26)
-	  else if och = ord #"+" then Sign 1
-	  else if och = ord #"-" then Sign ~1
-	       else Util.illegal ("bad ch in poly: " ^ (Char.toString(ch)))
+        let val och = ord ch in
+          if ord #"0"<=och andalso och<=ord #"9" then Dig (och - ord #"0")
+          else if ord #"a"<=och andalso och<=ord #"z" then Var (och - ord #"a")
+          else if ord #"A"<=och andalso och<=ord #"Z" then Var (och - ord #"A" + 26)
+          else if och = ord #"+" then Sign 1
+          else if och = ord #"-" then Sign ~1
+               else Util.illegal ("bad ch in poly: " ^ (Char.toString(ch)))
         end
 
     fun nat (n,Dig d::l) = nat(n*10+d,l) | nat (n,l) = (n,l)
     fun mono (m,Var v::Dig d::l) =
-	  let val (n,l) = nat(d,l)
-	  in mono(M.multiply(M.implode[(v,n)],m),l) end
+          let val (n,l) = nat(d,l)
+          in mono(M.multiply(M.implode[(v,n)],m),l) end
       | mono (m,Var v::l) = mono(M.multiply(M.x_i v,m),l)
       | mono (m,l) = (m,l)
 
     fun term l = let
-	  val (n,l) = case l of (Dig d::l) => nat(d,l) | _ => (1,l)
-	  val (m,l) = mono(M.one,l)
-    	  in ((F.coerceInt n,m),l) end
+          val (n,l) = case l of (Dig d::l) => nat(d,l) | _ => (1,l)
+          val (m,l) = mono(M.one,l)
+          in ((F.coerceInt n,m),l) end
     fun poly (p,[]) = p
       | poly (p,l) = let
-	  val (s,l) = case l of Sign s::l => (F.coerceInt s,l) | _ => (F.one,l)
-	  val ((a,m),l) = term l
-	  in poly(P.add(P.coerce(F.multiply(s,a),m),p),l) end
+          val (s,l) = case l of Sign s::l => (F.coerceInt s,l) | _ => (F.one,l)
+          val ((a,m),l) = term l
+          in poly(P.add(P.coerce(F.multiply(s,a),m),p),l) end
 
 in
     fun parsePoly s = poly (P.zero,map char(String.explode s))
 
 (* unused code
     fun readIdeal stream = let
-	  fun readLine () = let
-	        val s = input_line stream
-		val n = size s
-		val n = if n>0 andalso substring(s,n-1,1)="\n" then n-1 else n
-		fun r i = if i>=n then []
-			  else case substring(s,i,1) of
-			      ";" => r(i+1)
-			    | " " => r(i+1)
-			    | _ => map char (String.explode(substring(s,i,n-i)))
-		in r 0 end
-	  fun r () = if end_of_stream stream then []
-		     else poly(P.zero,readLine()) :: r()
-	  fun num() = if end_of_stream stream then Util.illegal "missing #"
-		      else case nat(0,readLine()) of
-			  (_,_::_) => Util.illegal "junk after #"
-			| (n,_) => n
-	  val _ = 1=num() orelse Util.illegal "stream doesn't start w/ `1'"
-	  val n = num()
-	  val i = r()
-	  val _ = length i = n orelse Util.illegal "wrong # poly's"
-	  in i end
+          fun readLine () = let
+                val s = input_line stream
+                val n = size s
+                val n = if n>0 andalso substring(s,n-1,1)="\n" then n-1 else n
+                fun r i = if i>=n then []
+                          else case substring(s,i,1) of
+                              ";" => r(i+1)
+                            | " " => r(i+1)
+                            | _ => map char (String.explode(substring(s,i,n-i)))
+                in r 0 end
+          fun r () = if end_of_stream stream then []
+                     else poly(P.zero,readLine()) :: r()
+          fun num() = if end_of_stream stream then Util.illegal "missing #"
+                      else case nat(0,readLine()) of
+                          (_,_::_) => Util.illegal "junk after #"
+                        | (n,_) => n
+          val _ = 1=num() orelse Util.illegal "stream doesn't start w/ `1'"
+          val n = num()
+          val i = r()
+          val _ = length i = n orelse Util.illegal "wrong # poly's"
+          in i end
 *)
 
 (* unused code
@@ -848,20 +848,20 @@
 fun r mi s = let
       val p = G.parsePoly s
       in print (P.display p); print "\n";
-	 print (P.display(G.reduce(p,mi))); print "\n"
+         print (P.display(G.reduce(p,mi))); print "\n"
       end
 *)
 
 (* unused code unless printCounts is used
 fun p6 i= let val s= Int.toString (i:int)
-	      val n= size s
+              val n= size s
           in print(substring("      ",0,6-n)); print s end
 *)
 
 (* unused code
 fun hex n = let
       fun h n = if n=0 then ""
-		else h(n smlnj_div 16) ^ substring("0123456789ABCDEF",n smlnj_mod 16,1)
+                else h(n smlnj_div 16) ^ substring("0123456789ABCDEF",n smlnj_mod 16,1)
       in if n=0 then "0" else h n end
 fun printCounts () = map (fn l => (map p6 l; print "\n")) (getCounts())
 fun totalCount () = revfold (fn (l,c) => revfold op + l c) (getCounts()) 0
@@ -901,13 +901,13 @@
     (* sort all k, 0<=i<=k<j<=length a *)
     fun s (i,j,acc) = if i=j then acc else let
         val pivot = a sub (b sub (i+random(j-i)))
-	fun partition (dup,lo,k,hi) = if k=hi then (dup,lo,hi) else
-	    (case M.compare (pivot, a sub (b sub k)) of
-		 Util.Less => (swap (lo,k); partition (dup,lo+1,k+1,hi))
-	       | Util.Equal => partition (dup+1,lo,k+1,hi)
-	       | Util.Greater => (swap (k,hi-1); partition (dup,lo,k,hi-1)))
-	val (dup,lo,hi) = partition (0,i,i,j)
-	in s(i,lo,(dup,pivot)::s(hi,j,acc)) end
+        fun partition (dup,lo,k,hi) = if k=hi then (dup,lo,hi) else
+            (case M.compare (pivot, a sub (b sub k)) of
+                 Util.Less => (swap (lo,k); partition (dup,lo+1,k+1,hi))
+               | Util.Equal => partition (dup+1,lo,k+1,hi)
+               | Util.Greater => (swap (k,hi-1); partition (dup,lo,k,hi-1)))
+        val (dup,lo,hi) = partition (0,i,i,j)
+        in s(i,lo,(dup,pivot)::s(hi,j,acc)) end
     in s(0,length1 a,[]) end
 *)
 
@@ -975,7 +975,7 @@
 
 
 (* val u5 = map G.parsePoly ["abcde-f5","a+b+c+d+e","ab+bc+cd+de+ea",
- * 			  "abc+bcd+cde+dea+eab","abcd+bcde+cdea+deab+eabc"]
+ *                        "abc+bcd+cde+dea+eab","abcd+bcde+cdea+deab+eabc"]
  * 
  * val u4 = map G.parsePoly ["abcd-e4","a+b+c+d","ab+bc+cd+da","abc+bcd+cda+dab"]
  * 
@@ -984,13 +984,13 @@
 (* fun runit () = 
  *   let
  *     val _ = (print "Enter fs, u7, u6, u5, or u4: "; 
- * 	     TextIO.flushOut TextIO.stdOut)
+ *           TextIO.flushOut TextIO.stdOut)
  *     val s = TextIO.inputN(TextIO.stdIn,2)
  *     val data = 
  *       if (s = "fs") then fs else if (s = "u7") then u7 
  *       else if (s = "u6") then u6 else if (s = "u5") then u5 
  *       else if (s = "u4") then u4 else 
- * 	(print "no such data\n"; raise (Util.Impossible "no such data"))
+ *      (print "no such data\n"; raise (Util.Impossible "no such data"))
  *   in
  *     gb data handle e => report e
  *   end
@@ -999,18 +999,18 @@
 structure Main =
    struct
       fun doit n =
-	 let
-	    val u6 =
-	       map G.parsePoly
-	       ["abcdef-g6","a+b+c+d+e+f","ab+bc+cd+de+ef+fa",
-		"abc+bcd+cde+def+efa+fab",
-		"abcd+bcde+cdef+defa+efab+fabc",
-		"abcde+bcdef+cdefa+defab+efabc+fabcd"]
-	    fun loop n =
-	       if n = 0
-		  then ()
-	       else (gb u6; loop (n - 1))
-	 in
-	    loop n
-	 end
+         let
+            val u6 =
+               map G.parsePoly
+               ["abcdef-g6","a+b+c+d+e+f","ab+bc+cd+de+ef+fa",
+                "abc+bcd+cde+def+efa+fab",
+                "abcd+bcde+cdef+defa+efab+fabc",
+                "abcde+bcdef+cdefa+defab+efabc+fabcd"]
+            fun loop n =
+               if n = 0
+                  then ()
+               else (gb u6; loop (n - 1))
+         in
+            loop n
+         end
    end

Modified: mlton/branches/on-20050420-cmm-branch/benchmark/tests/vector-concat.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/benchmark/tests/vector-concat.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/benchmark/tests/vector-concat.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -3,17 +3,17 @@
 structure Main =
    struct
       fun doit n =
-	 let
-	    val len = 20000
-	    val sum = len * (len - 1)
-	    val v = Vector.tabulate (len, fn i => i)
-	    fun loop n =
-	       if n < 0
-		  then ()
-	       else
-		  if sum = Vector.foldl (op +) 0 (Vector.concat [v, v])
-		     then loop (n - 1)
-		  else raise Fail "bug"
-	 in loop (n * 10000)
-	 end
+         let
+            val len = 20000
+            val sum = len * (len - 1)
+            val v = Vector.tabulate (len, fn i => i)
+            fun loop n =
+               if n < 0
+                  then ()
+               else
+                  if sum = Vector.foldl (op +) 0 (Vector.concat [v, v])
+                     then loop (n - 1)
+                  else raise Fail "bug"
+         in loop (n * 10000)
+         end
    end

Modified: mlton/branches/on-20050420-cmm-branch/benchmark/tests/vector-rev.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/benchmark/tests/vector-rev.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/benchmark/tests/vector-rev.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -3,24 +3,24 @@
 structure Main =
    struct
       open Vector
-	 
+         
       fun rev v =
-	 let
-	    val n = length v
-	 in
-	    tabulate (n, fn i => sub (v, n - 1 - i))
-	 end
+         let
+            val n = length v
+         in
+            tabulate (n, fn i => sub (v, n - 1 - i))
+         end
 
       fun doit n =
-	 let
-	    val v = tabulate (200000, fn i => i)
-	    fun loop n =
-	       if n < 0
-		  then ()
-	       else
-		  if 0 = sub (rev (rev v), 0)
-		     then loop (n - 1)
-		  else raise Fail "bug"
-	 in loop (n * 1000)
-	 end
+         let
+            val v = tabulate (200000, fn i => i)
+            fun loop n =
+               if n < 0
+                  then ()
+               else
+                  if 0 = sub (rev (rev v), 0)
+                     then loop (n - 1)
+                  else raise Fail "bug"
+         in loop (n * 1000)
+         end
    end

Modified: mlton/branches/on-20050420-cmm-branch/benchmark/tests/vliw.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/benchmark/tests/vliw.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/benchmark/tests/vliw.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -113,9 +113,9 @@
 
        in loop(0,nchars,0)
 (*        while !i < nchars do
-	      (n := (hashFactor * !n + ordof(str, !i)) mod tableSize;
-	       i := !i + 1);
-	  !n
+              (n := (hashFactor * !n + ordof(str, !i)) mod tableSize;
+               i := !i + 1);
+          !n
 *)
       end
 
@@ -131,7 +131,7 @@
   (* apply the stringmap a to the index string s *)
   fun map a s = 
     let fun find ((s',x)::r) = if s=s' then x else find r
-	  | find nil = raise Stringmap
+          | find nil = raise Stringmap
      in find (a sub (hash s))
     end
 
@@ -142,31 +142,31 @@
 
   (* remove all pairs mapping string s from stringmap a *)
   fun rm a s = let fun f ((b as (s',j))::r) = 
-				if s=s' then f r else b :: f r
-	              | f nil = nil
-		    val index = hash s
-		 in update(a,index, f(a sub index))
-		end
+                                if s=s' then f r else b :: f r
+                      | f nil = nil
+                    val index = hash s
+                 in update(a,index, f(a sub index))
+                end
 
   (* apply a function f to all mapping pairs in stringmap a *)
   fun app (f: string * 'a -> unit) a =
       let fun zap 0 = ()
-	    | zap n = let val m = n-1 in List.app f (a sub m); zap m end
+            | zap n = let val m = n-1 in List.app f (a sub m); zap m end
       in  zap tableSize
       end
 
   (* extract the stringmap items as a list *)
   fun extract a =
       let fun atol n =
-	  if n < Array.length a then (a sub n) :: atol (n + 1)
-	  else nil
-	  val al = atol 0
-	  fun flatten (a, b) = a @ b
-	  val fal = fold flatten al nil
-	  fun strip (s, v) = v
-	  val answer = List.map strip fal
+          if n < Array.length a then (a sub n) :: atol (n + 1)
+          else nil
+          val al = atol 0
+          fun flatten (a, b) = a @ b
+          val fal = fold flatten al nil
+          fun strip (s, v) = v
+          val answer = List.map strip fal
       in
-	  answer
+          answer
       end
 
 end  (* Stringmap *)
@@ -175,7 +175,7 @@
 
 structure StrPak :
     sig
-	val stringListString : string list -> string
+        val stringListString : string list -> string
     end = 
 
 struct
@@ -189,14 +189,14 @@
 end
 signature SortObjSig = 
     sig
-	type obj
-	val gt : obj * obj -> bool
+        type obj
+        val gt : obj * obj -> bool
     end
 
 functor Sort ( objfun : SortObjSig ) :
     sig
-	type obj
-	val sort : obj list -> obj list
+        type obj
+        val sort : obj list -> obj list
     end = 
 
 struct
@@ -204,52 +204,52 @@
 open objfun
 
 type obj = objfun.obj
-	
+        
 fun sort l =
     let fun m2 (nil, b) = b
-	  | m2 (a, nil) = a
-	  | m2 (ha::ta, hb::tb) =
-	    if gt(ha, hb) then hb::(m2(ha::ta, tb))
-	    else ha::(m2(ta, hb::tb))
-	fun ml (nil) = nil
-	  | ml (h::nil) = h
-	  | ml (h1::h2::nil) = m2(h1, h2)
-	  | ml (h1::h2::l) = ml [m2(h1, h2), (ml l)]
+          | m2 (a, nil) = a
+          | m2 (ha::ta, hb::tb) =
+            if gt(ha, hb) then hb::(m2(ha::ta, tb))
+            else ha::(m2(ta, hb::tb))
+        fun ml (nil) = nil
+          | ml (h::nil) = h
+          | ml (h1::h2::nil) = m2(h1, h2)
+          | ml (h1::h2::l) = ml [m2(h1, h2), (ml l)]
     in
-	ml (map (fn x => [x]) l)
+        ml (map (fn x => [x]) l)
     end
 
 end
 
 structure IntImp =
     struct
-	type obj = int
-	fun gt(a:obj, b:obj) = a > b
+        type obj = int
+        fun gt(a:obj, b:obj) = a > b
     end
-			   
+                           
 
 structure INTSort = Sort ( IntImp )
 
 structure Set :
     sig
-	exception SET
-	exception LISTUNION
-	type 'a set
-	val make : ''a set
-	val makeEQ : ('a * 'a -> bool) -> 'a set
-	val listToSet : ''a list -> ''a set
-	val listToSetEQ : ('a * 'a -> bool) * 'a list -> 'a set
-	val add : 'a set * 'a -> 'a set
-	val union : 'a set * 'a set -> 'a set
-	val listUnion : 'a set list -> 'a set
-	val listUnionEQ : ('a * 'a -> bool) * 'a set list -> 'a set
-	val rm : 'a set * 'a -> 'a set
-	val intersect : 'a set * 'a set -> 'a set
-	val diff : 'a set * 'a set -> 'a set
-	val member : 'a set * 'a -> bool
-	val set : 'a set -> 'a list
-	val mag : 'a set -> int
-	val empty : 'a set -> bool
+        exception SET
+        exception LISTUNION
+        type 'a set
+        val make : ''a set
+        val makeEQ : ('a * 'a -> bool) -> 'a set
+        val listToSet : ''a list -> ''a set
+        val listToSetEQ : ('a * 'a -> bool) * 'a list -> 'a set
+        val add : 'a set * 'a -> 'a set
+        val union : 'a set * 'a set -> 'a set
+        val listUnion : 'a set list -> 'a set
+        val listUnionEQ : ('a * 'a -> bool) * 'a set list -> 'a set
+        val rm : 'a set * 'a -> 'a set
+        val intersect : 'a set * 'a set -> 'a set
+        val diff : 'a set * 'a set -> 'a set
+        val member : 'a set * 'a -> bool
+        val set : 'a set -> 'a list
+        val mag : 'a set -> int
+        val empty : 'a set -> bool
     end = 
 struct
 datatype 'a set = S of ('a*'a->bool) * 'a list
@@ -272,9 +272,9 @@
 
 fun listToSetEQ (eqf, l) =
     let fun f (nil, s) = s
-	  | f (h::t, s) = f(t, add(s, h))
+          | f (h::t, s) = f(t, add(s, h))
     in
-	f(l, makeEQ eqf)
+        f(l, makeEQ eqf)
     end
 
 fun listToSet l = listToSetEQ (eqf, l)
@@ -304,7 +304,7 @@
 
 fun diff (S (eqf, nil), b) = S (eqf, nil)
   | diff (S (eqf, a::t), b) = if member(b, a) then diff(S (eqf, t), b)
-			 else S (eqf, a :: set(diff(S (eqf, t), b)))
+                         else S (eqf, a :: set(diff(S (eqf, t), b)))
 
 
 fun mag s = List.length (set s)
@@ -325,29 +325,29 @@
       INT of int
     | REAL of real
     | LABVAL of int * int
-	
+        
   datatype arithop = imul | iadd | isub | idiv 
-		  | orb | andb | xorb | rshift | lshift
-		   | fadd | fdiv | fmul | fsub
-		  | real | floor | logb
+                  | orb | andb | xorb | rshift | lshift
+                   | fadd | fdiv | fmul | fsub
+                  | real | floor | logb
 
   datatype comparison = ilt | ieq | igt | ile | ige | ine
-	              | flt | feq | fgt | fle | fge | fne 
-		      | inrange | outofrange
+                      | flt | feq | fgt | fle | fge | fne 
+                      | inrange | outofrange
   datatype opcode =
       FETCH of {immutable: bool, offset: int, ptr: reg, dst: reg}
-		(* dst := M[ptr+offset]
-	 	   if immutable then unaffected by any STORE
-		   other than through the allocptr *)
+                (* dst := M[ptr+offset]
+                   if immutable then unaffected by any STORE
+                   other than through the allocptr *)
     | STORE of {offset: int, src: reg, ptr: reg}
-		(* M[ptr+offset] := src *)
+                (* M[ptr+offset] := src *)
     | GETLAB of {lab: label, dst: reg}
     | GETREAL of {value: string, dst: reg}
     | ARITH of {oper: arithop, src1: reg, src2: reg, dst: reg}
     | ARITHI of {oper: arithop, src1: reg, src2: int, dst: reg}
     | MOVE of {src: reg, dst: reg}
     | BRANCH of {test: comparison, src1: reg, src2: reg, dst: label, 
-	         live: reg list}
+                 live: reg list}
     | JUMP of {dst: reg, live: reg list}
     | LABEL of {lab:label, live: reg list}
     | WORD of {value: int}
@@ -361,27 +361,27 @@
 
 structure AbsMachImp :
     sig
-	type reg
-	type operation
-	val oeq : operation * operation  -> bool
-	type comparison
-	val ceq : comparison * comparison -> bool
-	val write_o : operation -> reg Set.set
-	val read_o : operation -> reg Set.set
-	val write_c : comparison -> reg Set.set
-	val read_c : comparison -> reg Set.set
-	val resources_ok : operation list * comparison list -> bool
-	datatype codetypes =
-	    ASSIGNMENT of operation
-	  | LABELREF of int * operation
-	  | COMPARISON of int * operation
-	  | FLOW of int * operation
-	  | TARGET of int * operation
-	  | EXIT of operation
-	  | JUNK of operation
-	  | NERGLE
-	val classify : operation -> codetypes
-	val maxreg : AbsMach.opcode list -> int
+        type reg
+        type operation
+        val oeq : operation * operation  -> bool
+        type comparison
+        val ceq : comparison * comparison -> bool
+        val write_o : operation -> reg Set.set
+        val read_o : operation -> reg Set.set
+        val write_c : comparison -> reg Set.set
+        val read_c : comparison -> reg Set.set
+        val resources_ok : operation list * comparison list -> bool
+        datatype codetypes =
+            ASSIGNMENT of operation
+          | LABELREF of int * operation
+          | COMPARISON of int * operation
+          | FLOW of int * operation
+          | TARGET of int * operation
+          | EXIT of operation
+          | JUNK of operation
+          | NERGLE
+        val classify : operation -> codetypes
+        val maxreg : AbsMach.opcode list -> int
     end =
 struct
 
@@ -410,47 +410,47 @@
 
 fun write_o i = 
     let open Set
-	open AbsMach
-	val f =
-	    fn FETCH{dst, ...} => sr dst
-	     | STORE{ptr, ...} =>
-		   if allocptr ptr then listToSet [immutableMem, mutableMem]
-		   else listToSet [mutableMem]
-	     | GETLAB {dst, ...} => sr dst
-	     | GETREAL {dst, ...} => sr dst
-	     | ARITH {dst, ...} => sr dst
-	     | ARITHI {dst, ...} => sr dst
-	     | MOVE {dst, ...} => sr dst
-	     | JUMP _  => listToSet [flowControl]
-	     | BOGUS {writes, ...} => srl writes
-	     | _  =>  make
+        open AbsMach
+        val f =
+            fn FETCH{dst, ...} => sr dst
+             | STORE{ptr, ...} =>
+                   if allocptr ptr then listToSet [immutableMem, mutableMem]
+                   else listToSet [mutableMem]
+             | GETLAB {dst, ...} => sr dst
+             | GETREAL {dst, ...} => sr dst
+             | ARITH {dst, ...} => sr dst
+             | ARITHI {dst, ...} => sr dst
+             | MOVE {dst, ...} => sr dst
+             | JUMP _  => listToSet [flowControl]
+             | BOGUS {writes, ...} => srl writes
+             | _  =>  make
     in
-	f i
+        f i
     end
 
 fun write_c c = Set.listToSet [flowControl]
 
 val std_reg_list = [(1, ""), (2, ""), (3, ""), (4, ""), (5, "")]
-		   
+                   
 fun read i =
     let open Set
-	open AbsMach
-	val f =
-	fn FETCH {immutable, ptr, ...} =>
-	let val mem = if immutable then immutableMem else mutableMem
-	in
-	    add(sr ptr, mem)
-	end
-	 | STORE {src, ptr, ...} => srl [src, ptr]
-	 | ARITH {src1, src2, ...} => srl [src1, src2]
-	 | ARITHI {src1, ...} => sr src1
-	 | MOVE {src, ...} => sr src
-	 | BRANCH {src1, src2, ...} => srl [src1, src2]
-	 | JUMP {dst, ...} => srl (dst :: std_reg_list)
-	 | BOGUS {reads, ...} => srl reads
-	 | _ => make
+        open AbsMach
+        val f =
+        fn FETCH {immutable, ptr, ...} =>
+        let val mem = if immutable then immutableMem else mutableMem
+        in
+            add(sr ptr, mem)
+        end
+         | STORE {src, ptr, ...} => srl [src, ptr]
+         | ARITH {src1, src2, ...} => srl [src1, src2]
+         | ARITHI {src1, ...} => sr src1
+         | MOVE {src, ...} => sr src
+         | BRANCH {src1, src2, ...} => srl [src1, src2]
+         | JUMP {dst, ...} => srl (dst :: std_reg_list)
+         | BOGUS {reads, ...} => srl reads
+         | _ => make
     in
-	f i
+        f i
     end
 
 fun read_o i = read i
@@ -468,38 +468,38 @@
 
 fun maxreg li =
     let fun f (a, b) = Int.max(a, b)
-	val r =
-	    (Set.set (Set.listUnion((map write_o li) @
-				    (map read li))))
+        val r =
+            (Set.set (Set.listUnion((map write_o li) @
+                                    (map read li))))
     in
-	fold f r 0
+        fold f r 0
     end
 
 
 fun classify i =
     let open AbsMach
-	val f =
-	fn FETCH _ => ASSIGNMENT i
-	 | STORE _ => ASSIGNMENT i
-	 | GETLAB{lab, dst} => LABELREF(label lab, i)
-	 | GETREAL _  => ASSIGNMENT i
-	 | ARITH _  =>  ASSIGNMENT i
-	 | ARITHI _ =>  ASSIGNMENT i
-	 | MOVE{src, dst} =>
-	       if reg src = reg dst then NERGLE
-	       else ASSIGNMENT i
-	 | BRANCH{test,src1,src2,dst,live} =>
-	       if test = ieq andalso (reg src1) = (reg src2)
-		   then FLOW (label dst, i)
-	       else COMPARISON (label dst, i)
-	 | JUMP _ => EXIT i
-	 | LABEL {lab, ...} => TARGET(label lab, i)
-	 | WORD _ => JUNK i
-	 | LABWORD _ => JUNK i
-	 | NOP =>  JUNK i
-	 | BOGUS _ =>  ASSIGNMENT i
+        val f =
+        fn FETCH _ => ASSIGNMENT i
+         | STORE _ => ASSIGNMENT i
+         | GETLAB{lab, dst} => LABELREF(label lab, i)
+         | GETREAL _  => ASSIGNMENT i
+         | ARITH _  =>  ASSIGNMENT i
+         | ARITHI _ =>  ASSIGNMENT i
+         | MOVE{src, dst} =>
+               if reg src = reg dst then NERGLE
+               else ASSIGNMENT i
+         | BRANCH{test,src1,src2,dst,live} =>
+               if test = ieq andalso (reg src1) = (reg src2)
+                   then FLOW (label dst, i)
+               else COMPARISON (label dst, i)
+         | JUMP _ => EXIT i
+         | LABEL {lab, ...} => TARGET(label lab, i)
+         | WORD _ => JUNK i
+         | LABWORD _ => JUNK i
+         | NOP =>  JUNK i
+         | BOGUS _ =>  ASSIGNMENT i
     in
-	f i
+        f i
     end
 end
 structure ReadAbs : sig val read: instream -> AbsMach.opcode list end =
@@ -513,7 +513,7 @@
 let
     
     fun error s = (print("Error in line "^makestring i^": "^s^"\n");
-		   raise ReadError)
+                   raise ReadError)
 
 fun b(" "::rest) = b rest | b rest = rest
 
@@ -559,17 +559,17 @@
 fun int l =
   let val z = ord "0"
       fun f(n,l0 as d::l) = if d>="0" andalso d<="9"
-	                      then f(n*10+ord(d)-z, l)
-			    else (n,l0)
-	| f _ = error "in readabs.int"
+                              then f(n*10+ord(d)-z, l)
+                            else (n,l0)
+        | f _ = error "in readabs.int"
    in f(0,l)
   end
 
 fun string l =
   let fun f("/"::l) = (nil,l)
         | f(a::l) = let val (s,l') = f l
-	             in (a::s, l')
-		    end
+                     in (a::s, l')
+                    end
         | f _ = error "name not terminated by \"/\""
       val (s,l') = f l
    in (implode s, l')
@@ -578,23 +578,23 @@
   fun realc s =
     let val (sign,s) = case explode s of "~"::rest => (~1.0,rest) 
                                        | s => (1.0,s)
-	fun j(exp,d::dl,mant) = j(exp,dl,mant * 0.1 + intToReal(d))
-	  | j(0,nil,mant) = mant*sign
-	  | j(exp,nil,mant) = if exp>0 then j(exp-1,nil,mant*10.0)
-				       else j(exp+1,nil,mant*0.1)
-	fun h(esign,wholedigits,diglist,exp,nil) = 
-			  j(esign*exp+wholedigits-1,diglist,0.0)
-	  | h(es,fd,dl,exp,d::s) = h(es,fd,dl,exp*10+(ord d - ord "0"),s)
-	fun g(i,r,"E"::"~"::s)=h(~1,i,r,0,s)
-	  | g(i,r,"E"::s)=h(1,i,r,0,s)
-	  | g(i,r,d::s) = if d>="0" andalso d<="9" then
+        fun j(exp,d::dl,mant) = j(exp,dl,mant * 0.1 + intToReal(d))
+          | j(0,nil,mant) = mant*sign
+          | j(exp,nil,mant) = if exp>0 then j(exp-1,nil,mant*10.0)
+                                       else j(exp+1,nil,mant*0.1)
+        fun h(esign,wholedigits,diglist,exp,nil) = 
+                          j(esign*exp+wholedigits-1,diglist,0.0)
+          | h(es,fd,dl,exp,d::s) = h(es,fd,dl,exp*10+(ord d - ord "0"),s)
+        fun g(i,r,"E"::"~"::s)=h(~1,i,r,0,s)
+          | g(i,r,"E"::s)=h(1,i,r,0,s)
+          | g(i,r,d::s) = if d>="0" andalso d<="9" then
                             g(i, (ord d - ord "0")::r, s)
                           else h(1,i,r,0,nil)
-	  | g(i,r,nil) = h(1,i,r,0,nil)
-	fun f(i,r,"."::s)=g(i,r,s)
-	  | f(i,r,s as "E"::_)=g(i,r,s)
-	  | f(i,r,d::s) = f(i+1,(ord(d)-ord("0"))::r,s)
-	  | f _ = error "bad in readdabs"
+          | g(i,r,nil) = h(1,i,r,0,nil)
+        fun f(i,r,"."::s)=g(i,r,s)
+          | f(i,r,s as "E"::_)=g(i,r,s)
+          | f(i,r,d::s) = f(i+1,(ord(d)-ord("0"))::r,s)
+          | f _ = error "bad in readdabs"
      in f(0,nil,s)
     end handle Overflow => error ("real constant "^s^" out of range")
 
@@ -605,92 +605,92 @@
 
 fun reg l = let val (s,l) = string l
                 val l = require(["R"],l)
-		val (i,l) = int l
-	     in ((i,s),l)
-	    end
+                val (i,l) = int l
+             in ((i,s),l)
+            end
 fun lab l = let val (s,l) = string l
                 val l = require(["L"],l)
-		val (i,l) = int l
-	     in ((i,s),l)
-	    end
+                val (i,l) = int l
+             in ((i,s),l)
+            end
 
 fun live l =
  let fun f(")"::_) = nil
        | f l = let val (r,l) = reg l
-	        in r::f(b l)
-	       end
+                in r::f(b l)
+               end
   in f(b(require(["("],l)))
  end
 
 val opcode = 
  fn "F"::"E"::"T"::"C"::"H"::l =>
-	let val (imm,l) = immut(b l)
+        let val (imm,l) = immut(b l)
             val (dst,l) = reg(b l)
             val (ptr,l) = reg(b(require(["M","["],b(require([":","="],b l)))))
             val (offset,l) = int(b(require(["+"],b l)))
-	in require(["]"], b l);
-	   FETCH{immutable=imm,dst=dst,ptr=ptr,offset=offset}
+        in require(["]"], b l);
+           FETCH{immutable=imm,dst=dst,ptr=ptr,offset=offset}
         end
   | "S"::"T"::"O"::"R"::"E"::l =>
-	let val (ptr,l) = reg(b(require(["M","["],b l)))
+        let val (ptr,l) = reg(b(require(["M","["],b l)))
             val (offset,l) = int(b(require(["+"],b l)))
-	    val (src,l) = reg(b(require([":","="],b(require(["]"], b l)))))
+            val (src,l) = reg(b(require([":","="],b(require(["]"], b l)))))
          in STORE{src=src,ptr=ptr,offset=offset}
         end
   | "G"::"E"::"T"::"L"::"A"::"B"::l =>
-	let val (dst,l) = reg(b l)
+        let val (dst,l) = reg(b l)
             val (lab,l) = lab(b(require([":","="],b l)))
-	in GETLAB{dst=dst,lab=lab}
+        in GETLAB{dst=dst,lab=lab}
         end
   | "G"::"E"::"T"::"R"::"E"::"A"::"L"::l =>
-	let val (dst,l) = reg(b l)
+        let val (dst,l) = reg(b l)
             val r = realc(implode(b(require([":","="],b l))))
-	in GETREAL{dst=dst,value=Real.toString r}
+        in GETREAL{dst=dst,value=Real.toString r}
         end
   | "A"::"R"::"I"::"T"::"H"::"I"::l =>
-	let val (dst,l) = reg(b l)
+        let val (dst,l) = reg(b l)
             val (s1,l) = reg(b(require([":","="],b l)))
             val (oper,l) = aop(b l)
             val (s2,l) = int(b l)
-	in ARITHI{oper=oper,src1=s1,src2=s2,dst=dst}
+        in ARITHI{oper=oper,src1=s1,src2=s2,dst=dst}
         end
   | "A"::"R"::"I"::"T"::"H"::l =>
-	let val (dst,l) = reg(b l)
+        let val (dst,l) = reg(b l)
             val (s1,l) = reg(b(require([":","="],b l)))
             val (oper,l) = aop(b l)
             val (s2,l) = reg(b l)
-	in ARITH{oper=oper,src1=s1,src2=s2,dst=dst}
+        in ARITH{oper=oper,src1=s1,src2=s2,dst=dst}
         end
   | "M"::"O"::"V"::"E"::l =>
-	let val (dst,l) = reg(b l)
+        let val (dst,l) = reg(b l)
             val (s1,l) = reg(b(require([":","="],b l)))
-	in MOVE{src=s1,dst=dst}
+        in MOVE{src=s1,dst=dst}
         end
   | "B"::"R"::"A"::"N"::"C"::"H"::l =>
-	let val (s1,l) = reg(b(require(["I","F"],b l)))
-	    val (test,l) = com(b l)
+        let val (s1,l) = reg(b(require(["I","F"],b l)))
+            val (test,l) = com(b l)
             val (s2,l) = reg(b l)
             val (dst,l) = lab(b(require(["G","O","T","O"],b l)))
-	    val liv = live(b l)
-	in BRANCH{test=test,src1=s1,src2=s2,dst=dst,live=liv}
+            val liv = live(b l)
+        in BRANCH{test=test,src1=s1,src2=s2,dst=dst,live=liv}
         end
   | "J"::"U"::"M"::"P"::l =>
-	let val (dst,l) = reg(b l)
-	    val live = live(b l)
+        let val (dst,l) = reg(b l)
+            val live = live(b l)
          in JUMP{dst=dst,live=live}
         end
   | "L"::"A"::"B"::"E"::"L"::l =>
-	let val (lab,l) = lab(b l)
-	    val live = live(b(require([":"],l)))
+        let val (lab,l) = lab(b l)
+            val live = live(b(require([":"],l)))
          in LABEL{lab=lab,live=live}
         end
   | "W"::"O"::"R"::"D"::l =>
-	let val (i,l) = int(b l)
-	 in WORD{value=i}
+        let val (i,l) = int(b l)
+         in WORD{value=i}
         end
   | "L"::"A"::"B"::"W"::"O"::"R"::"D"::l =>
-	let val (i,l) = lab(b l)
-	 in LABWORD{lab=i}
+        let val (i,l) = lab(b l)
+         in LABWORD{lab=i}
         end
   | "N"::"O"::"P"::_ => NOP
   | _ => error "illegal opcode name"
@@ -706,8 +706,8 @@
 
 structure PrintAbs :
     sig
-	val show: outstream -> AbsMach.opcode list -> unit
-	val str: AbsMach.opcode list -> string
+        val show: outstream -> AbsMach.opcode list -> unit
+        val str: AbsMach.opcode list -> string
     end =
 struct
 
@@ -825,29 +825,29 @@
        pr "\n")
    | NOP => pr "NOP\n"
    | BOGUS{reads, writes} =>
-	 (pr "BOGUS";
-	  pr "   ( ";
-	  List.app (fn r => (reg r; pr " ")) writes;
-	  pr ") := (";
-	  List.app (fn r => (reg r; pr " ")) reads;
-	  pr ")\n")
+         (pr "BOGUS";
+          pr "   ( ";
+          List.app (fn r => (reg r; pr " ")) writes;
+          pr ") := (";
+          List.app (fn r => (reg r; pr " ")) reads;
+          pr ")\n")
   
-			 
+                         
 in (List.app p prog; !outstr)
 end
 
 fun str prog =
     let fun cat (a, b) = (xstr [a]) ^ b
     in
-	fold cat prog ""
+        fold cat prog ""
     end
 
 fun show out prog =
     let fun f nil = ()
-	  | f (h::t) = (outputc out (xstr [h]);
-			f t)
+          | f (h::t) = (outputc out (xstr [h]);
+                        f t)
     in
-	f prog
+        f prog
     end
     
 end
@@ -856,7 +856,7 @@
 structure HM = AbsMachImp
 structure BreakInst :
     sig 
-	val breaki : AbsMach.opcode list -> AbsMach.opcode list
+        val breaki : AbsMach.opcode list -> AbsMach.opcode list
     end =
 struct
 
@@ -872,65 +872,65 @@
 val new_reg_pairs:(AbsMach.reg * AbsMach.reg) list ref = ref nil
 
 fun new_reg_init li = (new_reg_val := maxreg li;
-		       new_reg_pairs := nil)
+                       new_reg_pairs := nil)
 
 fun new_reg (r:AbsMach.reg) =
     let fun f nil =
-	let val nr = (new_reg_val := !new_reg_val + 1; (!new_reg_val, rstr r))
-	in
-	    (new_reg_pairs := (r, nr) :: !new_reg_pairs;
-	     nr)
-	end
-	  | f ((a, b)::t) = if r = a then b else f t
+        let val nr = (new_reg_val := !new_reg_val + 1; (!new_reg_val, rstr r))
+        in
+            (new_reg_pairs := (r, nr) :: !new_reg_pairs;
+             nr)
+        end
+          | f ((a, b)::t) = if r = a then b else f t
     in
-	f (!new_reg_pairs)
+        f (!new_reg_pairs)
     end
 
 fun breaki l =
     let fun f i =
-	let val g =
-	    fn ARITH{oper, src1, src2, dst}  =>
-	    if reg dst = reg src1 orelse reg dst = reg src2 then
-		let val nr = new_reg(dst)
-		in
-		    [ARITH{oper=oper, src1=src2, src2=src2, dst=nr},
-		     MOVE{src=nr, dst=dst}]
-		end
-	    else [i]
-	     | ARITHI{oper, src1, src2, dst}  =>
-		   if reg dst = reg src1 then
-		       let val nr = new_reg(dst)
-		       in
-			   [ARITHI{oper=oper, src1=src1, src2=src2, dst=nr},
-			    MOVE{src=nr, dst=dst}]
-		       end
-		   else [i]
-	     | FETCH{immutable, offset, ptr, dst} =>
-		   if reg ptr = reg dst then
-		       let val nr = new_reg(dst)
-		       in
-			   [FETCH{immutable=immutable, offset=offset,
-				  ptr=ptr, dst=nr},
-			    MOVE{src=nr, dst=dst}]
-		       end
-		   else [i]
-	     | MOVE{src, dst} =>
-		   if reg src = reg dst then nil
-		   else [i]
-	     | _ => [i]
-	in
-	    g i
-	end
-	fun h (a, b) = f a @ b
-	val foo = new_reg_init l
+        let val g =
+            fn ARITH{oper, src1, src2, dst}  =>
+            if reg dst = reg src1 orelse reg dst = reg src2 then
+                let val nr = new_reg(dst)
+                in
+                    [ARITH{oper=oper, src1=src2, src2=src2, dst=nr},
+                     MOVE{src=nr, dst=dst}]
+                end
+            else [i]
+             | ARITHI{oper, src1, src2, dst}  =>
+                   if reg dst = reg src1 then
+                       let val nr = new_reg(dst)
+                       in
+                           [ARITHI{oper=oper, src1=src1, src2=src2, dst=nr},
+                            MOVE{src=nr, dst=dst}]
+                       end
+                   else [i]
+             | FETCH{immutable, offset, ptr, dst} =>
+                   if reg ptr = reg dst then
+                       let val nr = new_reg(dst)
+                       in
+                           [FETCH{immutable=immutable, offset=offset,
+                                  ptr=ptr, dst=nr},
+                            MOVE{src=nr, dst=dst}]
+                       end
+                   else [i]
+             | MOVE{src, dst} =>
+                   if reg src = reg dst then nil
+                   else [i]
+             | _ => [i]
+        in
+            g i
+        end
+        fun h (a, b) = f a @ b
+        val foo = new_reg_init l
     in
-	fold h l nil
+        fold h l nil
     end
 
 end
 structure OutFilter :
     sig 
-	val remnops : AbsMach.opcode list -> AbsMach.opcode list
+        val remnops : AbsMach.opcode list -> AbsMach.opcode list
     end =
 struct
 
@@ -938,17 +938,17 @@
 
 fun remnops ol =
     let fun f (NOP, NOP::b) = NOP::b
-	  | f (a, b) = a::b
+          | f (a, b) = a::b
     in
-	fold f ol nil
+        fold f ol nil
     end
 
 end
 structure Delay  :
     sig
-	val init: AbsMach.opcode list -> unit
-	val add_delay: AbsMach.opcode list ->  AbsMach.opcode list
-	val rm_bogus: AbsMach.opcode list -> AbsMach.opcode list
+        val init: AbsMach.opcode list -> unit
+        val add_delay: AbsMach.opcode list ->  AbsMach.opcode list
+        val rm_bogus: AbsMach.opcode list -> AbsMach.opcode list
         val is_bogus_i : AbsMach.opcode -> bool
         val is_bogus_reg : AbsMach.reg -> bool
         val idempotency : int ref
@@ -970,7 +970,7 @@
 fun is_bogus_reg (i, s) = i > !maxreg
 
 fun unbogus_reg (i, s) = if is_bogus_reg (i, s) then (i div maxdelay, s)
-			 else (i, s)
+                         else (i, s)
 
 val max_bog_reg = ref 0
 val curr_idem_reg = ref 0
@@ -980,50 +980,50 @@
      (!curr_idem_reg, "idem"))
 
 fun init il = (
-	       maxreg := AbsMachImp.maxreg il;
-	       max_bog_reg := (!maxreg + 1) *  maxdelay;
-	       curr_idem_reg := !max_bog_reg + 1
-	       )
+               maxreg := AbsMachImp.maxreg il;
+               max_bog_reg := (!maxreg + 1) *  maxdelay;
+               curr_idem_reg := !max_bog_reg + 1
+               )
 
 exception DELAY
 
 fun delay i =
     let fun opdelay oper =
-	let val f =
-	    fn imul => 5
-	     | iadd => 2
-	     | isub => 2
-	     | idiv => 12
-	     | orb => 2
-	     | andb => 2
-	     | xorb => 2
-	     | rshift => 2
-	     | lshift => 2
-	     | fadd => 2
-	     | fdiv => 12
-	     | fmul => 4
-	     | fsub => 2
-	     | real => 2
-	     | floor => 2
-	     | logb => 2
-	in
-	    f oper
-	end
-	val id =
-	    fn FETCH{immutable,offset,ptr,dst} => 2
-	     | STORE{offset,ptr,src} => 2
-	     | GETLAB{lab, dst} => 2
-	     | GETREAL{value,dst} => 2
-	     | ARITH{oper,src1,src2,dst} => opdelay oper
-	     | ARITHI{oper,src1,src2,dst} => opdelay oper
-	     | MOVE{src,dst} => 1
-	     | BRANCH{test,src1,src2,dst,live} => 5
-	     | JUMP{dst,live} => 1
-	     | LABEL{lab, live} => 0
-	     | NOP => 1
-	     | _ => raise DELAY
+        let val f =
+            fn imul => 5
+             | iadd => 2
+             | isub => 2
+             | idiv => 12
+             | orb => 2
+             | andb => 2
+             | xorb => 2
+             | rshift => 2
+             | lshift => 2
+             | fadd => 2
+             | fdiv => 12
+             | fmul => 4
+             | fsub => 2
+             | real => 2
+             | floor => 2
+             | logb => 2
+        in
+            f oper
+        end
+        val id =
+            fn FETCH{immutable,offset,ptr,dst} => 2
+             | STORE{offset,ptr,src} => 2
+             | GETLAB{lab, dst} => 2
+             | GETREAL{value,dst} => 2
+             | ARITH{oper,src1,src2,dst} => opdelay oper
+             | ARITHI{oper,src1,src2,dst} => opdelay oper
+             | MOVE{src,dst} => 1
+             | BRANCH{test,src1,src2,dst,live} => 5
+             | JUMP{dst,live} => 1
+             | LABEL{lab, live} => 0
+             | NOP => 1
+             | _ => raise DELAY
     in
-	id i
+        id i
     end
 
 fun b_idemx (0, r, w) = nil
@@ -1031,17 +1031,17 @@
   | b_idemx (n, r, w) =
     let val ir = idem_reg()
     in
-	BOGUS{reads=r @ w, writes = [ir]} :: b_idemx(n-1, r, [ir])
+        BOGUS{reads=r @ w, writes = [ir]} :: b_idemx(n-1, r, [ir])
     end
 
 fun b_idem (n, r, w) =
     let fun fil ((i, s), b) = if i = 0 then b else (i, s) :: b
-	val nr = fold fil r nil
+        val nr = fold fil r nil
     in
-	if null nr then nil
-	else b_idemx(n, nr, w)
+        if null nr then nil
+        else b_idemx(n, nr, w)
     end
-	
+        
 fun b_assx (0, r) = nil
   | b_assx (1, r) = BOGUS{reads=[bogus_reg(r, 1)], writes=[r]} :: nil
   | b_assx (n, r) =
@@ -1055,124 +1055,124 @@
   | b_brxx (1, rl) =
     let fun b r = bogus_reg(r, 1)
     in
-	BOGUS{reads=rl, writes=map b rl} :: nil
+        BOGUS{reads=rl, writes=map b rl} :: nil
     end
   | b_brxx (n, rl) =
     let fun br r = bogus_reg(r, n - 1)
-	fun bw r = bogus_reg(r, n)
+        fun bw r = bogus_reg(r, n)
     in
-	BOGUS{reads=map br rl, writes=map bw rl} :: b_brxx (n - 1, rl)
+        BOGUS{reads=map br rl, writes=map bw rl} :: b_brxx (n - 1, rl)
     end
 
 fun b_brx (n, rl) =
     let fun br r = bogus_reg(r, n-1)
     in
-	BOGUS{reads=map br rl, writes=rl} :: b_brxx(n-1, rl)
+        BOGUS{reads=map br rl, writes=rl} :: b_brxx(n-1, rl)
     end
     
 fun b_br (b, n, rl) = rev (b :: b_brx(n, rl))
 
 fun is_flow i =
     let open AbsMachImp
-	fun f (FLOW _) = true
-	  | f _ = false
+        fun f (FLOW _) = true
+          | f _ = false
     in
-	f (classify i)
+        f (classify i)
     end
     
 fun add_delay il =
     let fun idem (r, w) = b_idem (!idempotency, r, w)
-	fun g i =
-	let val d = delay i
-	    val f =
-		fn FETCH{immutable,offset,ptr,dst} =>
-		i :: (idem([ptr], [dst]) @ b_ass(d, dst))
-		 | STORE{offset,ptr,src} => [i]
-		 | GETLAB{lab, dst} => i :: b_ass(d, dst)
-		 | GETREAL{value,dst} => i :: b_ass(d, dst)
-		 | ARITH{oper,src1,src2,dst} =>
-		       i :: (idem([src1, src2], [dst]) @ b_ass(d, dst))
-		 | ARITHI{oper,src1,src2,dst} =>
-		       i :: (idem([src1], [dst]) @ b_ass(d, dst))
-		 | MOVE{src,dst} => i :: idem([src], [dst])
-		 | BRANCH{test,src1,src2,dst,live} =>
-		       if is_flow i then [i]
-		       else
-			   b_br (BRANCH{test=test,
-					src1=src1,src2=src2,dst=dst,
-					live=live},
-				 d, [src1, src2])
-		 | _  =>  [i]
-	in
-	    f i
-	end
-	fun apnd (nil, b) = b
-	  | apnd (a::t, b) = a :: apnd(t, b)
-	fun fld(a, b) = apnd(g a, b)
+        fun g i =
+        let val d = delay i
+            val f =
+                fn FETCH{immutable,offset,ptr,dst} =>
+                i :: (idem([ptr], [dst]) @ b_ass(d, dst))
+                 | STORE{offset,ptr,src} => [i]
+                 | GETLAB{lab, dst} => i :: b_ass(d, dst)
+                 | GETREAL{value,dst} => i :: b_ass(d, dst)
+                 | ARITH{oper,src1,src2,dst} =>
+                       i :: (idem([src1, src2], [dst]) @ b_ass(d, dst))
+                 | ARITHI{oper,src1,src2,dst} =>
+                       i :: (idem([src1], [dst]) @ b_ass(d, dst))
+                 | MOVE{src,dst} => i :: idem([src], [dst])
+                 | BRANCH{test,src1,src2,dst,live} =>
+                       if is_flow i then [i]
+                       else
+                           b_br (BRANCH{test=test,
+                                        src1=src1,src2=src2,dst=dst,
+                                        live=live},
+                                 d, [src1, src2])
+                 | _  =>  [i]
+        in
+            f i
+        end
+        fun apnd (nil, b) = b
+          | apnd (a::t, b) = a :: apnd(t, b)
+        fun fld(a, b) = apnd(g a, b)
     in
-	fold fld il nil
+        fold fld il nil
     end
 
 fun rm_bogus il =
     let fun g nil = nil
-	  | g (i::t) =
-	let val f =
-	    fn FETCH{immutable,offset,ptr,dst} =>
-	    FETCH{immutable=immutable, offset=offset, ptr=ptr,
-		  dst= unbogus_reg dst} ::
-	    g t
-	     | STORE{offset,ptr,src} => i :: g t
-	     | GETLAB{lab, dst} =>
-		   GETLAB{lab=lab, dst= unbogus_reg dst} :: g t
-	     | GETREAL{value,dst} =>
-		   GETREAL{value=value, dst=unbogus_reg dst} :: g t
-	     | ARITH{oper,src1,src2,dst} =>
-		   ARITH{oper=oper,src1=src1,src2=src2,dst=unbogus_reg dst} ::
-		   g t
-	     | ARITHI{oper,src1,src2,dst} =>
-		   ARITHI{oper=oper,src1=src1,src2=src2,dst=unbogus_reg dst} ::
-		   g t
-	     | MOVE{src,dst} => i :: g t
-	     | BRANCH{test,src1,src2,dst,live} =>
-		   BRANCH{test=test,
-			  src1=unbogus_reg src1,
-			  src2=unbogus_reg src2,
-			  dst=dst, live=live
-			  } :: g t
-	     | BOGUS _ => g t   
-	     | _  =>  i :: g t
-	in
-	    f i
-	end
+          | g (i::t) =
+        let val f =
+            fn FETCH{immutable,offset,ptr,dst} =>
+            FETCH{immutable=immutable, offset=offset, ptr=ptr,
+                  dst= unbogus_reg dst} ::
+            g t
+             | STORE{offset,ptr,src} => i :: g t
+             | GETLAB{lab, dst} =>
+                   GETLAB{lab=lab, dst= unbogus_reg dst} :: g t
+             | GETREAL{value,dst} =>
+                   GETREAL{value=value, dst=unbogus_reg dst} :: g t
+             | ARITH{oper,src1,src2,dst} =>
+                   ARITH{oper=oper,src1=src1,src2=src2,dst=unbogus_reg dst} ::
+                   g t
+             | ARITHI{oper,src1,src2,dst} =>
+                   ARITHI{oper=oper,src1=src1,src2=src2,dst=unbogus_reg dst} ::
+                   g t
+             | MOVE{src,dst} => i :: g t
+             | BRANCH{test,src1,src2,dst,live} =>
+                   BRANCH{test=test,
+                          src1=unbogus_reg src1,
+                          src2=unbogus_reg src2,
+                          dst=dst, live=live
+                          } :: g t
+             | BOGUS _ => g t   
+             | _  =>  i :: g t
+        in
+            f i
+        end
     in
-	g il
+        g il
     end
 end
 structure Ntypes :
     sig
-	type name
-	val init_names : unit -> unit
-	val new_name : name -> name
-	val prime_name : name -> name
-	val name_prefix_eq : (name * name) -> bool
-	type test
-	val teq : test * test -> bool
-	type reg
-	type assignment
-	val aeq : assignment * assignment -> bool
+        type name
+        val init_names : unit -> unit
+        val new_name : name -> name
+        val prime_name : name -> name
+        val name_prefix_eq : (name * name) -> bool
+        type test
+        val teq : test * test -> bool
+        type reg
+        type assignment
+        val aeq : assignment * assignment -> bool
 
-	datatype test_or_name =
-	    TEST of test
-	  | NAME of name
-	  | NEITHER
+        datatype test_or_name =
+            TEST of test
+          | NAME of name
+          | NEITHER
 
-	val toneq : test_or_name * test_or_name -> bool
+        val toneq : test_or_name * test_or_name -> bool
 
-	datatype test_or_assign =
-	    TST of test
-	  | ASS of assignment
+        datatype test_or_assign =
+            TST of test
+          | ASS of assignment
 
-	val toaeq : test_or_assign * test_or_assign -> bool
+        val toaeq : test_or_assign * test_or_assign -> bool
 
     end = 
 
@@ -1227,28 +1227,28 @@
 end
 structure Dag :
     sig
-	exception DAG
-	exception DAGnotfound
-	type dag
-	val make : dag
-	val tests_of : dag -> Ntypes.test Set.set
-	val sel_of : dag -> ((Ntypes.test * bool) -> Ntypes.test_or_name)
-	val root_of : dag -> Ntypes.test_or_name
-	val succ_of : dag -> Ntypes.name Set.set
-	val attach : Ntypes.test * dag * dag -> dag
-	val reach : dag * Ntypes.test_or_name -> dag
-	val replace_edge : dag * Ntypes.name list -> dag
-	val newdag : (Ntypes.test Set.set *
-		      ((Ntypes.test * bool) -> Ntypes.test_or_name) *
-		      Ntypes.test_or_name *
-		      Ntypes.name Set.set)
-	    -> dag
-	val dagToString : dag -> string
+        exception DAG
+        exception DAGnotfound
+        type dag
+        val make : dag
+        val tests_of : dag -> Ntypes.test Set.set
+        val sel_of : dag -> ((Ntypes.test * bool) -> Ntypes.test_or_name)
+        val root_of : dag -> Ntypes.test_or_name
+        val succ_of : dag -> Ntypes.name Set.set
+        val attach : Ntypes.test * dag * dag -> dag
+        val reach : dag * Ntypes.test_or_name -> dag
+        val replace_edge : dag * Ntypes.name list -> dag
+        val newdag : (Ntypes.test Set.set *
+                      ((Ntypes.test * bool) -> Ntypes.test_or_name) *
+                      Ntypes.test_or_name *
+                      Ntypes.name Set.set)
+            -> dag
+        val dagToString : dag -> string
     end = 
 struct
 
 open Ntypes;
-	
+        
     
 exception DAGnotfound
 exception DAG
@@ -1281,44 +1281,44 @@
 
 fun attach (t, D dt, D df) = 
     let open Set
-	val (b1, sel1, r1, h1) = dt
-	val (b2, sel2, r2, h2) = df
+        val (b1, sel1, r1, h1) = dt
+        val (b2, sel2, r2, h2) = df
     in
-	D(add(union(b1, b2), t),
-	  (fn(x, y) =>
-	   if teq(x, t) then if y then r1 else r2
-	   else sel1(x, y) handle DAGnotfound => sel2(x, y)),
-	  TEST t,
-	  union(h1,h2)
-	  )
+        D(add(union(b1, b2), t),
+          (fn(x, y) =>
+           if teq(x, t) then if y then r1 else r2
+           else sel1(x, y) handle DAGnotfound => sel2(x, y)),
+          TEST t,
+          union(h1,h2)
+          )
     end
        
 fun reach (D d, tn) =
     let open Set
-	val (b, sel, r, h) = d
-	fun f (TEST t) =
-	    if not (member(b, t)) then raise DAGnotfound
-	    else attach(t, reach(D d, sel(t, true)), reach(D d, sel(t, false)))
-	 | f (NAME n) =
-	   D(makeEQ teq, fn x => raise DAGnotfound, NAME n, listToSet [n])
-	   | f (_) = raise DAGnotfound
+        val (b, sel, r, h) = d
+        fun f (TEST t) =
+            if not (member(b, t)) then raise DAGnotfound
+            else attach(t, reach(D d, sel(t, true)), reach(D d, sel(t, false)))
+         | f (NAME n) =
+           D(makeEQ teq, fn x => raise DAGnotfound, NAME n, listToSet [n])
+           | f (_) = raise DAGnotfound
     in
-	f tn
+        f tn
     end
 
 fun replace_edge (D d, nil) = D d
   | replace_edge (D d, old::new::tl) =
     let open Set
-	val (b, sel, r, h)  = d
-	val nh = if member(h, old) then add(rm(h, old), new) else h
-	val nr = if toneq(r, NAME old) then NAME new else r
-	val nsel = fn(x, y) =>
-	    let val v = sel(x, y)
-	    in
-		if toneq(v,  NAME old) then NAME new else v
-	    end
+        val (b, sel, r, h)  = d
+        val nh = if member(h, old) then add(rm(h, old), new) else h
+        val nr = if toneq(r, NAME old) then NAME new else r
+        val nsel = fn(x, y) =>
+            let val v = sel(x, y)
+            in
+                if toneq(v,  NAME old) then NAME new else v
+            end
     in
-	D (b, nsel, nr, nh)
+        D (b, nsel, nr, nh)
     end
   | replace_edge _ = raise DAG
 
@@ -1341,56 +1341,56 @@
 
 structure Node :
     sig
-	type node
-	type program
-	val delete_debug : bool ref
-	val move_op_debug : bool ref
-	val move_test_debug : bool ref
-	val rw_debug : bool ref
-	val ntn_debug : bool ref
-	val prog_node_debug : bool ref
-	val prog_node_debug_verbose : bool ref
-	val closure_progs_debug : bool ref
-	val cpsiCheck : bool ref
-	val makeProg : unit -> program
-	val make :
-	    Ntypes.name * Ntypes.assignment Set.set *
-	    Dag.dag * Ntypes.name Set.set-> node
-	val name_of : node -> Ntypes.name
-	val assignment_of : node -> Ntypes.assignment Set.set
-	val dag_of : node -> Dag.dag
-	val succ : program * node -> Ntypes.name Set.set
-	val prednm : program * Ntypes.name -> Ntypes.name Set.set
-	val pred : program * node -> Ntypes.name Set.set
-	val succNodes : program * node -> node Set.set
-	val predNodes : program * node -> node Set.set
-	val readNode : node -> int Set.set
-	val writeNode : node -> int Set.set
-	val unreachable : program * node -> bool
-	val num_ops_node : node -> int
-	val num_tests_node : node -> int
-	val num_things_node : node -> int
-	val replace_edge_node : node * string list -> node
-	exception NAMETONODE
-	val nameToNode : program * Ntypes.name -> node
-	val nameSetToNodeSet : program * Ntypes.name Set.set -> node Set.set
-	val eqn : node * node -> bool
-	val n00 : node
-	val fin : node
-	val delete : program * node -> program
-	val move_op :
-	    program * Ntypes.assignment * node Set.set * node -> program
-	val move_test :  program * Ntypes.test * node * node -> program
-	val nodeToString : node -> string
-	val progToString : program -> string
-	val entries : program -> node list
-	val programs : program -> program list
-	val addPredInfo : program -> program
-	val closure : program * node -> program
-	val sortNodes : node list -> node list
-	val updateNode : program * node -> program
-	val addNode : program * node -> program
-	val rmNode : program * node -> program
+        type node
+        type program
+        val delete_debug : bool ref
+        val move_op_debug : bool ref
+        val move_test_debug : bool ref
+        val rw_debug : bool ref
+        val ntn_debug : bool ref
+        val prog_node_debug : bool ref
+        val prog_node_debug_verbose : bool ref
+        val closure_progs_debug : bool ref
+        val cpsiCheck : bool ref
+        val makeProg : unit -> program
+        val make :
+            Ntypes.name * Ntypes.assignment Set.set *
+            Dag.dag * Ntypes.name Set.set-> node
+        val name_of : node -> Ntypes.name
+        val assignment_of : node -> Ntypes.assignment Set.set
+        val dag_of : node -> Dag.dag
+        val succ : program * node -> Ntypes.name Set.set
+        val prednm : program * Ntypes.name -> Ntypes.name Set.set
+        val pred : program * node -> Ntypes.name Set.set
+        val succNodes : program * node -> node Set.set
+        val predNodes : program * node -> node Set.set
+        val readNode : node -> int Set.set
+        val writeNode : node -> int Set.set
+        val unreachable : program * node -> bool
+        val num_ops_node : node -> int
+        val num_tests_node : node -> int
+        val num_things_node : node -> int
+        val replace_edge_node : node * string list -> node
+        exception NAMETONODE
+        val nameToNode : program * Ntypes.name -> node
+        val nameSetToNodeSet : program * Ntypes.name Set.set -> node Set.set
+        val eqn : node * node -> bool
+        val n00 : node
+        val fin : node
+        val delete : program * node -> program
+        val move_op :
+            program * Ntypes.assignment * node Set.set * node -> program
+        val move_test :  program * Ntypes.test * node * node -> program
+        val nodeToString : node -> string
+        val progToString : program -> string
+        val entries : program -> node list
+        val programs : program -> program list
+        val addPredInfo : program -> program
+        val closure : program * node -> program
+        val sortNodes : node list -> node list
+        val updateNode : program * node -> program
+        val addNode : program * node -> program
+        val rmNode : program * node -> program
     end = 
 struct
 
@@ -1452,49 +1452,49 @@
 
 fun updateNode(P as (ns, n0, F), new_node) =
     let val answer =
-	(Stringmap.rm (ns:node Stringmap.stringmap)
-	 ((name_of new_node):string);
-	 Stringmap.add ns ((name_of new_node), new_node);
-	 if name_of new_node = name_of n0 then (ns, new_node, F)
-	 else if name_of new_node = name_of F then (ns, n0, new_node)
-	      else P)
-	val foo = p_n_debug
-	    (fn () =>
-	     ("updateNode n=" ^ nodeToString new_node ^
-	      "=>" ^
-		  (if !prog_node_debug_verbose then progToString answer
-		   else "(program)")))
+        (Stringmap.rm (ns:node Stringmap.stringmap)
+         ((name_of new_node):string);
+         Stringmap.add ns ((name_of new_node), new_node);
+         if name_of new_node = name_of n0 then (ns, new_node, F)
+         else if name_of new_node = name_of F then (ns, n0, new_node)
+              else P)
+        val foo = p_n_debug
+            (fn () =>
+             ("updateNode n=" ^ nodeToString new_node ^
+              "=>" ^
+                  (if !prog_node_debug_verbose then progToString answer
+                   else "(program)")))
     in
-	answer
+        answer
     end
 
 fun addNode(P as (ns, n0, F), new_node) =
     let val answer =
-	if Stringmap.isin ns (name_of new_node) then updateNode(P, new_node)
-	else (Stringmap.add ns ((name_of new_node), new_node);
-	      P)
-	val foo = p_n_debug
-	    (fn () =>
-	     ("addNode n=" ^ nodeToString new_node ^
-	      "=>" ^ 
-		  (if !prog_node_debug_verbose then progToString answer
-		   else "(program)")))
+        if Stringmap.isin ns (name_of new_node) then updateNode(P, new_node)
+        else (Stringmap.add ns ((name_of new_node), new_node);
+              P)
+        val foo = p_n_debug
+            (fn () =>
+             ("addNode n=" ^ nodeToString new_node ^
+              "=>" ^ 
+                  (if !prog_node_debug_verbose then progToString answer
+                   else "(program)")))
     in
-	answer
+        answer
     end
 
 
 fun rmNode(P as (ns, n0, F), node) =
     let val answer = (Stringmap.rm ns (name_of node);
-		      P)
-	val foo = p_n_debug
-	    (fn () =>
-	     ("rmNode n=" ^ nodeToString node ^
-	      "=>" ^ 
-		  (if !prog_node_debug_verbose then progToString answer
-		   else "(program)")))
+                      P)
+        val foo = p_n_debug
+            (fn () =>
+             ("rmNode n=" ^ nodeToString node ^
+              "=>" ^ 
+                  (if !prog_node_debug_verbose then progToString answer
+                   else "(program)")))
     in
-	answer
+        answer
     end
 
 
@@ -1508,8 +1508,8 @@
 fun nameToNode(P as (ns, n0, F), nm) =
     Stringmap.map ns nm
     handle Stringmap =>
-	(ntnPrint (fn () => ("nameToNode " ^ nm ^ "not found"));
-	 raise NAMETONODE)
+        (ntnPrint (fn () => ("nameToNode " ^ nm ^ "not found"));
+         raise NAMETONODE)
 
 exception NAMESETTONODESET
 fun nameSetToNodeSet(P, ns) =
@@ -1527,34 +1527,34 @@
 val cpsiCheck = ref false
 fun checkPredSuccInfo(from, P as (ns, n0, F)) =
     let val nl = Stringmap.extract ns
-	val badnode = ref n0
-	fun fail s = (print ("CPSI:" ^ s ^ " failed\nfrom " ^ from ^
-			     "\nbadnode=" ^ nodeToString (!badnode) ^
-			     "\nprogram=" ^ progToString P ^ "\n");
-		      raise CPSI)
-	fun chk (xpred, xsuccN, n) =
-	    let val foo = badnode := n
-		val s = Set.set(xsuccN(P, n))
-		    handle NAMESETTONODESET =>
-			fail "NAMESETTONODESET"
-    		fun cs x = Set.member(xpred x, name_of n)
-		fun fs (x, b) = b andalso cs x
-	    in
-		fold fs s true
-	    end
-	fun cp (x, b) = b andalso chk(pred_of, succNodes, x)
-	fun cs (x, b) = b andalso chk((succ_of o dag_of), predNodes, x)
+        val badnode = ref n0
+        fun fail s = (print ("CPSI:" ^ s ^ " failed\nfrom " ^ from ^
+                             "\nbadnode=" ^ nodeToString (!badnode) ^
+                             "\nprogram=" ^ progToString P ^ "\n");
+                      raise CPSI)
+        fun chk (xpred, xsuccN, n) =
+            let val foo = badnode := n
+                val s = Set.set(xsuccN(P, n))
+                    handle NAMESETTONODESET =>
+                        fail "NAMESETTONODESET"
+                fun cs x = Set.member(xpred x, name_of n)
+                fun fs (x, b) = b andalso cs x
+            in
+                fold fs s true
+            end
+        fun cp (x, b) = b andalso chk(pred_of, succNodes, x)
+        fun cs (x, b) = b andalso chk((succ_of o dag_of), predNodes, x)
     in
-	if not (fold cp nl true) then fail "cp"
-	else if not (fold cs nl true) then fail "cs"
-	     else ()
+        if not (fold cp nl true) then fail "cp"
+        else if not (fold cs nl true) then fail "cs"
+             else ()
     end
 fun cpsi x = if !cpsiCheck then checkPredSuccInfo x else ()
 
 
 fun empty n =
     let open Set in
-	empty (assignment_of n) andalso empty ((tests_of o dag_of) n)
+        empty (assignment_of n) andalso empty ((tests_of o dag_of) n)
     end
 
 fun unreachable(P as (ns, n0, F), n) =
@@ -1572,47 +1572,47 @@
 
 fun readNode n =
     let open Set 
-	val answer =
-	    union
-	    (listUnion (make::(map (read o ASS) ((set o assignment_of) n))),
-	     listUnion (make::(map
-			       (read o TST) ((set o tests_of o dag_of) n))))
-	val foo = read_write_debug
-	    (fn () =>
-	     ("readNode " ^ nodeToString n ^ "=>" ^
-		 stringListString (map makestring (set answer))))
+        val answer =
+            union
+            (listUnion (make::(map (read o ASS) ((set o assignment_of) n))),
+             listUnion (make::(map
+                               (read o TST) ((set o tests_of o dag_of) n))))
+        val foo = read_write_debug
+            (fn () =>
+             ("readNode " ^ nodeToString n ^ "=>" ^
+                 stringListString (map makestring (set answer))))
     in
-	answer
+        answer
     end
 
 fun writeNode n =
     let open Set 
-	val answer =
-	    union
-	    (listUnion (make::(map (write o ASS) ((set o assignment_of) n))),
-	     listUnion (make::(map
-			       (write o TST) ((set o tests_of o dag_of) n))))
-	val foo = read_write_debug
-	    (fn () =>
-	     ("writeNode " ^ nodeToString n ^ "=>" ^
-		 stringListString (map makestring (set answer))))
+        val answer =
+            union
+            (listUnion (make::(map (write o ASS) ((set o assignment_of) n))),
+             listUnion (make::(map
+                               (write o TST) ((set o tests_of o dag_of) n))))
+        val foo = read_write_debug
+            (fn () =>
+             ("writeNode " ^ nodeToString n ^ "=>" ^
+                 stringListString (map makestring (set answer))))
     in
-	answer
+        answer
     end
 
 fun no_write_conflict (ta, n) =
     let open Set in
-	empty (intersect(writeNode n, (union(read ta, write ta))))
+        empty (intersect(writeNode n, (union(read ta, write ta))))
     end
 
 fun no_read_conflict (ta, n) =
     let open Set in
-	empty (intersect (write ta, readNode n))
+        empty (intersect (write ta, readNode n))
     end
 
 fun empty n =
      let open Set in
-	 (empty o assignment_of) n andalso (empty o tests_of o dag_of) n
+         (empty o assignment_of) n andalso (empty o tests_of o dag_of) n
      end
 
 fun replace_edge_node(N (n, a, d, p), nl) = N(n, a, replace_edge(d, nl), p)
@@ -1631,35 +1631,35 @@
 exception DEAD
 fun dead(P:program, r:HM.reg, n:node, done: name Set.set) =
     let val foo =
-	dead_debug (fn () => "(P, " ^ makestring r ^ ", " ^ nodeToString n ^ ")")
-	val new_done = Set.add(done, name_of n)
-	fun nfil(a, b) = if Set.member(new_done, a) then b
-			 else a::b
-	fun drl nil = true
-	  | drl (h::t) = dead(P, r, h, new_done) andalso drl t
-	fun ntn n = nameToNode (P, n) handle NAMETONODE => raise DEAD
-	val next = fold nfil (Set.set (succ(P, n))) nil
-	val answer = (
-		      not (Set.member(readNode n, r)) andalso
-		      (Set.member(writeNode n, r)      orelse
-		       drl (map ntn next))
-		      )
-	val foo = dead_debug(fn () => "=>" ^ Bool.toString answer)
+        dead_debug (fn () => "(P, " ^ makestring r ^ ", " ^ nodeToString n ^ ")")
+        val new_done = Set.add(done, name_of n)
+        fun nfil(a, b) = if Set.member(new_done, a) then b
+                         else a::b
+        fun drl nil = true
+          | drl (h::t) = dead(P, r, h, new_done) andalso drl t
+        fun ntn n = nameToNode (P, n) handle NAMETONODE => raise DEAD
+        val next = fold nfil (Set.set (succ(P, n))) nil
+        val answer = (
+                      not (Set.member(readNode n, r)) andalso
+                      (Set.member(writeNode n, r)      orelse
+                       drl (map ntn next))
+                      )
+        val foo = dead_debug(fn () => "=>" ^ Bool.toString answer)
     in
-	answer
+        answer
     end
 
 fun deadset(P, rs, n) =
     let val foo = dead_debug (fn () => "deadset(" ^
-			      stringListString
-			      (map makestring (Set.set rs)) ^ ",\n" ^
-			      nodeToString n ^ ")")
-	fun f nil = true
-	  | f (r::t) = dead(P, r, n, Set.make) andalso f t
-	val answer = f (Set.set rs)
-	val foo = dead_debug(fn () => "deadset=>" ^ Bool.toString answer ^ "\n")
+                              stringListString
+                              (map makestring (Set.set rs)) ^ ",\n" ^
+                              nodeToString n ^ ")")
+        fun f nil = true
+          | f (r::t) = dead(P, r, n, Set.make) andalso f t
+        val answer = f (Set.set rs)
+        val foo = dead_debug(fn () => "deadset=>" ^ Bool.toString answer ^ "\n")
     in
-	answer
+        answer
     end
 
 fun del_debug (f:debug_fun) =
@@ -1671,181 +1671,181 @@
 exception DELETE_WIERDSUCC
 fun delete (P as (ns, n0, F), n) =
     let val foo = cpsi("delete enter", P)
-	val em = empty n
-	val un = unreachable(P, n)
-	fun ntn n = nameToNode(P, n) handle NAMETONODE => raise DELETE
-	val p = Set.listToSetEQ(eqn, (map ntn (Set.set (pred(P, n)))))
-	open Set
+        val em = empty n
+        val un = unreachable(P, n)
+        fun ntn n = nameToNode(P, n) handle NAMETONODE => raise DELETE
+        val p = Set.listToSetEQ(eqn, (map ntn (Set.set (pred(P, n)))))
+        open Set
 
-	val foo = del_debug
-	    (fn () =>
-	     "delete( n=" ^ (name_of n) ^ "\n" ^
-	     "em=" ^ (Bool.toString em) ^ "\n" ^
-	     "un=" ^ (Bool.toString un) ^ "\n" ^
-	     "p =" ^ (psl (map name_of (Set.set p))) ^ "\n" ^
-	     ")")
+        val foo = del_debug
+            (fn () =>
+             "delete( n=" ^ (name_of n) ^ "\n" ^
+             "em=" ^ (Bool.toString em) ^ "\n" ^
+             "un=" ^ (Bool.toString un) ^ "\n" ^
+             "p =" ^ (psl (map name_of (Set.set p))) ^ "\n" ^
+             ")")
     in
-	if (em orelse un) andalso not (eqn(n, F)) then
-	    if not un then
-		let 
-		    val foo = del_debug (fn () => "complex deletion")
-		    val s0 = Set.set (succ(P, n))
-		    val nprime = if List.length s0 = 1 then hd s0
-				 else (print (Int.toString (List.length s0));
-				       raise DELETE_WIERDSUCC)
-		    val new_nprime =
-			rmPredNode(unionPredNode(ntn nprime, pred_of n),
-				   name_of n)
-		    fun ren x =
-			replace_edge_node(x, [name_of n, name_of new_nprime])
-		    val pprime = map ren (set p)
-		    fun updt(n, p) = updateNode(p, n)
-		    val Nprime = fold updt (new_nprime :: pprime) P
+        if (em orelse un) andalso not (eqn(n, F)) then
+            if not un then
+                let 
+                    val foo = del_debug (fn () => "complex deletion")
+                    val s0 = Set.set (succ(P, n))
+                    val nprime = if List.length s0 = 1 then hd s0
+                                 else (print (Int.toString (List.length s0));
+                                       raise DELETE_WIERDSUCC)
+                    val new_nprime =
+                        rmPredNode(unionPredNode(ntn nprime, pred_of n),
+                                   name_of n)
+                    fun ren x =
+                        replace_edge_node(x, [name_of n, name_of new_nprime])
+                    val pprime = map ren (set p)
+                    fun updt(n, p) = updateNode(p, n)
+                    val Nprime = fold updt (new_nprime :: pprime) P
 
-		    val foo = del_debug (fn () => "nprime=" ^ nprime)
-		    val foo = del_debug
-			(fn () =>
-			 "pprime=" ^ (psl (map nodeToString pprime)))
-		    val answer = rmNode(Nprime, n)
-		    val foo = cpsi("delete leave cd", answer)
-		in
-		    answer
-		end
-	    else (del_debug (fn () => "simple_deletion");
-		  let val s = Set.set(nameSetToNodeSet(P, (succ(P, n))))
-		      fun updt(s, p) = updateNode(p, rmPredNode(s, name_of n))
-		      val np = rmNode(fold updt s P, n)
-		      val foo = cpsi("delete leave sd", np)
-		  in
-		      np
-		  end)
-	else (del_debug (fn () => "No deletion");
-	      P)
+                    val foo = del_debug (fn () => "nprime=" ^ nprime)
+                    val foo = del_debug
+                        (fn () =>
+                         "pprime=" ^ (psl (map nodeToString pprime)))
+                    val answer = rmNode(Nprime, n)
+                    val foo = cpsi("delete leave cd", answer)
+                in
+                    answer
+                end
+            else (del_debug (fn () => "simple_deletion");
+                  let val s = Set.set(nameSetToNodeSet(P, (succ(P, n))))
+                      fun updt(s, p) = updateNode(p, rmPredNode(s, name_of n))
+                      val np = rmNode(fold updt s P, n)
+                      val foo = cpsi("delete leave sd", np)
+                  in
+                      np
+                  end)
+        else (del_debug (fn () => "No deletion");
+              P)
     end handle Hd => raise DELETE_HD
 
 fun mop_debug (f:debug_fun) =
     if !move_op_debug then
-	(dead_set_debug := true;
-	 print ("mop:" ^ f() ^ "\n"))
+        (dead_set_debug := true;
+         print ("mop:" ^ f() ^ "\n"))
     else dead_set_debug := false
        
 
 fun can_move_op1(P as (ns, n0, F), x, move_set, m) =
     let open Set
-	val foo = mop_debug (fn () => "can_move_op")
-	val rok = HM.resources_ok(set (add(assignment_of m, x)),
-				  set ((tests_of o dag_of) m))
-	val foo = mop_debug(fn () => "1")
-	val p = diff(nameSetToNodeSet(P, succ(P, m)), move_set)
-	val foo = mop_debug(fn () => "2")
-	val l = (write o ASS) x
-	val foo = mop_debug(fn () => "3")
-	fun dlpf nil = true
-	  | dlpf (pj::t) = deadset(P, l, pj) andalso dlpf t
-	fun cond nil = true
-	  | cond (nj::t) =
-	    (not o eqn)(nj, F)          andalso
-	    (* no_read_conflict(ASS x, nj) andalso *)
-	    (* change ex model so it can run on a sequential machine *)
-	    no_read_conflict(ASS x, m) andalso
-	    no_write_conflict(ASS x, m) andalso
-	    cond t
-	val foo = mop_debug(fn () => "4")
-	val answer = rok andalso cond (set move_set) andalso dlpf (set p)
-	val foo = mop_debug (fn () => "can_move_op=>" ^ Bool.toString answer)
+        val foo = mop_debug (fn () => "can_move_op")
+        val rok = HM.resources_ok(set (add(assignment_of m, x)),
+                                  set ((tests_of o dag_of) m))
+        val foo = mop_debug(fn () => "1")
+        val p = diff(nameSetToNodeSet(P, succ(P, m)), move_set)
+        val foo = mop_debug(fn () => "2")
+        val l = (write o ASS) x
+        val foo = mop_debug(fn () => "3")
+        fun dlpf nil = true
+          | dlpf (pj::t) = deadset(P, l, pj) andalso dlpf t
+        fun cond nil = true
+          | cond (nj::t) =
+            (not o eqn)(nj, F)          andalso
+            (* no_read_conflict(ASS x, nj) andalso *)
+            (* change ex model so it can run on a sequential machine *)
+            no_read_conflict(ASS x, m) andalso
+            no_write_conflict(ASS x, m) andalso
+            cond t
+        val foo = mop_debug(fn () => "4")
+        val answer = rok andalso cond (set move_set) andalso dlpf (set p)
+        val foo = mop_debug (fn () => "can_move_op=>" ^ Bool.toString answer)
     in
-	answer
+        answer
     end
 
 fun can_move_op(P, x, move_set, m) =
     let open Set
-	val ms = set move_set
-	fun pf n = pred(P, n)
-	val ps = set(listUnion (map pf ms))
-	fun all (x, b) = b andalso can_move_op1(P, x, move_set, m)
+        val ms = set move_set
+        fun pf n = pred(P, n)
+        val ps = set(listUnion (map pf ms))
+        fun all (x, b) = b andalso can_move_op1(P, x, move_set, m)
     in
-	if List.length ps > 1 then
-	    if List.length ms > 1 then false
-	    else fold all ((set o assignment_of o hd) ms) true
-	else can_move_op1(P, x, move_set, m)
+        if List.length ps > 1 then
+            if List.length ms > 1 then false
+            else fold all ((set o assignment_of o hd) ms) true
+        else can_move_op1(P, x, move_set, m)
     end
 
 fun move_op (P as (ns, n0, F), x, move_set, m) =
     let val foo = cpsi("move_op enter", P)
-	val foo = 
-	mop_debug (fn () =>
-		   "move_op(x=" ^
-		   PrintAbs.str [x] ^
-		   "move_set\n" ^
-		   (stringListString (map nodeToString
-					    (Set.set move_set))) ^
-		   "\nm=" ^ nodeToString m ^"\n)\n")
+        val foo = 
+        mop_debug (fn () =>
+                   "move_op(x=" ^
+                   PrintAbs.str [x] ^
+                   "move_set\n" ^
+                   (stringListString (map nodeToString
+                                            (Set.set move_set))) ^
+                   "\nm=" ^ nodeToString m ^"\n)\n")
     in
     if not (can_move_op(P, x, move_set, m)) then P
     else
-	let open Set
-	    exception NOTFOUND
-	    val primed_pairs = ref nil
-	    fun pnf nm =
-		let fun f nil = 
-		    let val nn = prime_name nm
-		    in
-			(primed_pairs := (nm, nn) :: !primed_pairs;
-			 nn)
-		    end
-		      | f ((a, b)::t) = if nm = a then b else f t
-		    val answer = f (!primed_pairs)
-		    val foo = mop_debug (fn () => "pnf " ^ nm ^ "=>" ^ answer)
-		in
-		    answer
-		end
-	    val foo = mop_debug(fn () => "1")
-	    fun njp nil = nil
-	      | njp ((N(n, a, d, prd))::t) =
-		N(pnf n, rm(a, x), d, listToSet [name_of m]) :: njp t
-	    fun ojp l = map (fn x => rmPredNode(x, name_of m)) l
-	    fun replist nil = nil
-	      | replist (h::t) = h :: pnf h :: replist t
-	    val rlist = replist (map name_of (set move_set))
-	    val foo = mop_debug(fn () => "2")
-	    val mprime =
-		let val aprime = add(assignment_of m, x)
-		    val dprime = replace_edge(dag_of m, rlist)
-		in
-		    N(name_of m, aprime, dprime, pred_of m)
-		end
-	    val foo = mop_debug(fn () => "3")
-	    val nj = njp(set move_set)
-	    val foo = mop_debug(fn () =>
-				"nj=" ^
-				stringListString (map name_of nj))
-	    fun uptd(n, p) = updateNode(p, n)
-	    val np = fold uptd (mprime :: (ojp (set move_set))) P
-	    fun addnpi(n, p) =
-		let val s = set (succNodes(p, n))
-		    fun ap x = addPredNode(x, name_of n)
-		    fun updt(x, p) = updateNode(p, ap x)
-		in
-		    fold updt s p
-		end
-	    fun addn(n, p) = addnpi(n, addNode(p, n))
-	    val nnp = fold addn nj np
-	    val foo = mop_debug(fn () => "4")
-	    val answer = nnp
-	    val foo = mop_debug(fn () => "5")
-	    val foo = cpsi("move_op leave", answer)
-	in
-	    mop_debug(fn () => "6");
-	    answer
-	end
+        let open Set
+            exception NOTFOUND
+            val primed_pairs = ref nil
+            fun pnf nm =
+                let fun f nil = 
+                    let val nn = prime_name nm
+                    in
+                        (primed_pairs := (nm, nn) :: !primed_pairs;
+                         nn)
+                    end
+                      | f ((a, b)::t) = if nm = a then b else f t
+                    val answer = f (!primed_pairs)
+                    val foo = mop_debug (fn () => "pnf " ^ nm ^ "=>" ^ answer)
+                in
+                    answer
+                end
+            val foo = mop_debug(fn () => "1")
+            fun njp nil = nil
+              | njp ((N(n, a, d, prd))::t) =
+                N(pnf n, rm(a, x), d, listToSet [name_of m]) :: njp t
+            fun ojp l = map (fn x => rmPredNode(x, name_of m)) l
+            fun replist nil = nil
+              | replist (h::t) = h :: pnf h :: replist t
+            val rlist = replist (map name_of (set move_set))
+            val foo = mop_debug(fn () => "2")
+            val mprime =
+                let val aprime = add(assignment_of m, x)
+                    val dprime = replace_edge(dag_of m, rlist)
+                in
+                    N(name_of m, aprime, dprime, pred_of m)
+                end
+            val foo = mop_debug(fn () => "3")
+            val nj = njp(set move_set)
+            val foo = mop_debug(fn () =>
+                                "nj=" ^
+                                stringListString (map name_of nj))
+            fun uptd(n, p) = updateNode(p, n)
+            val np = fold uptd (mprime :: (ojp (set move_set))) P
+            fun addnpi(n, p) =
+                let val s = set (succNodes(p, n))
+                    fun ap x = addPredNode(x, name_of n)
+                    fun updt(x, p) = updateNode(p, ap x)
+                in
+                    fold updt s p
+                end
+            fun addn(n, p) = addnpi(n, addNode(p, n))
+            val nnp = fold addn nj np
+            val foo = mop_debug(fn () => "4")
+            val answer = nnp
+            val foo = mop_debug(fn () => "5")
+            val foo = cpsi("move_op leave", answer)
+        in
+            mop_debug(fn () => "6");
+            answer
+        end
     end
 
 fun updt_sel (d, nsel) =
     let val tst = tests_of d
-	val rt = root_of d
-	val s = succ_of d
+        val rt = root_of d
+        val s = succ_of d
     in
-	newdag(tst, nsel, rt, s)
+        newdag(tst, nsel, rt, s)
     end
 
 fun mt_debug (f:debug_fun) =
@@ -1854,112 +1854,112 @@
 
 fun can_move_test(P as (ns, n0, F):program, x:test, n:node, m:node) =
     let val foo = cpsi("move_test enter", P)
-	val foo = mt_debug (fn () => "can_move_test")
-	val answer =
-	    no_write_conflict(TST x, m) andalso
+        val foo = mt_debug (fn () => "can_move_test")
+        val answer =
+            no_write_conflict(TST x, m) andalso
 
-	    (* hack because sel can't distinguish xj *)
-	    not (Set.member(tests_of(dag_of m), x)) andalso
+            (* hack because sel can't distinguish xj *)
+            not (Set.member(tests_of(dag_of m), x)) andalso
 
-	    HM.resources_ok(Set.set (assignment_of m),
-			    Set.set (Set.add((tests_of o dag_of) m, x)))
-	val foo = mt_debug (fn () => "can_move_test=>" ^ Bool.toString answer)
+            HM.resources_ok(Set.set (assignment_of m),
+                            Set.set (Set.add((tests_of o dag_of) m, x)))
+        val foo = mt_debug (fn () => "can_move_test=>" ^ Bool.toString answer)
     in
-	answer
+        answer
     end
 
 fun move_test (P as (ns, n0, F):program, x:test, n:node, m:node) =
-    if not (can_move_test(P, x, n, m))	then P
+    if not (can_move_test(P, x, n, m))  then P
     else
-	let val foo =
-	    mt_debug (fn () => "move_test" ^ name_of n ^ " " ^ name_of m)
-	    open Set
-	    val d_n = dag_of n
-	    val sel_n = sel_of d_n
-	    val rt_n = root_of d_n
-	    val nt =
-		let val newname = (new_name o name_of) n ^ "tt"
-		    fun nsel (z, b) =
-			let val v = sel_n(z, b) in
-			    if toneq(v, TEST x) then sel_n(x, true)
-			    else v
-			end
-		    val nC = 
-			if TEST x = rt_n then
-			    reach(updt_sel(d_n, nsel), sel_n(x, true))
-			else
-			    reach(updt_sel(d_n, nsel), rt_n)
-		in
-		    N(newname, assignment_of n, nC, listToSet [name_of m])
-		end
-	    val foo = mt_debug (fn () => "got nt")
-	    val nf =
-		let val newname = ((new_name o name_of) n) ^ "ff"
-		    fun nsel (z, b) =
-			let val v = sel_n(z, b) in
-			    if toneq(v, TEST x) then sel_n(x, false)
-			    else v
-			end
-		    val nC =
-			if TEST x = rt_n then
-			    reach(updt_sel(d_n, nsel), sel_n(x, false))
-			else
-			    reach(updt_sel(d_n, nsel), rt_n)
-		in
-		    N(newname, assignment_of n, nC, listToSet [name_of m])
-		end
-	    val foo = mt_debug (fn () => "got nf")
-	    val d_m = dag_of m
-	    val sel_m = sel_of d_m
-	    fun nton n = NAME( name_of n)
-	    fun nsel (z, b) =
-		if teq(z, x) then if b then nton nt else nton nf
-		else
-		    let val v = sel_m(z, b) in
-			if toneq(v, NAME(name_of n)) then TEST x else v
-		    end
-	    val nb = add(tests_of d_m, x)
-	    val nh =
-		add(add(rm(succ_of d_m, name_of n), name_of nt), name_of nf)
-	    fun new_rt (NAME rt) = TEST x
-	      | new_rt t = t
-	    val nc = newdag(nb, nsel, (new_rt o root_of) d_m, nh)
-	    val new_m = N(name_of m, assignment_of m, nc, pred_of m)
-	    fun updt_t s = addPredNode(s, name_of nt)
-	    fun updt_f s = addPredNode(s, name_of nf)
-	    val upt = map updt_t (set (nameSetToNodeSet(P, succ(P, nt))))
-	    val upf = map updt_f (set (nameSetToNodeSet(P, succ(P, nf))))
-	    fun updtl(n, p) = updateNode(p, n)
-	    val np =
-		fold updtl ([rmPredNode(n, name_of m), new_m] @ upt @ upf) P
-	    val answer = np
-	    val foo = mt_debug (fn () => "mtst done")
-	    val foo = cpsi("move_test leave", answer)		
-	in
-	    answer
-	end
+        let val foo =
+            mt_debug (fn () => "move_test" ^ name_of n ^ " " ^ name_of m)
+            open Set
+            val d_n = dag_of n
+            val sel_n = sel_of d_n
+            val rt_n = root_of d_n
+            val nt =
+                let val newname = (new_name o name_of) n ^ "tt"
+                    fun nsel (z, b) =
+                        let val v = sel_n(z, b) in
+                            if toneq(v, TEST x) then sel_n(x, true)
+                            else v
+                        end
+                    val nC = 
+                        if TEST x = rt_n then
+                            reach(updt_sel(d_n, nsel), sel_n(x, true))
+                        else
+                            reach(updt_sel(d_n, nsel), rt_n)
+                in
+                    N(newname, assignment_of n, nC, listToSet [name_of m])
+                end
+            val foo = mt_debug (fn () => "got nt")
+            val nf =
+                let val newname = ((new_name o name_of) n) ^ "ff"
+                    fun nsel (z, b) =
+                        let val v = sel_n(z, b) in
+                            if toneq(v, TEST x) then sel_n(x, false)
+                            else v
+                        end
+                    val nC =
+                        if TEST x = rt_n then
+                            reach(updt_sel(d_n, nsel), sel_n(x, false))
+                        else
+                            reach(updt_sel(d_n, nsel), rt_n)
+                in
+                    N(newname, assignment_of n, nC, listToSet [name_of m])
+                end
+            val foo = mt_debug (fn () => "got nf")
+            val d_m = dag_of m
+            val sel_m = sel_of d_m
+            fun nton n = NAME( name_of n)
+            fun nsel (z, b) =
+                if teq(z, x) then if b then nton nt else nton nf
+                else
+                    let val v = sel_m(z, b) in
+                        if toneq(v, NAME(name_of n)) then TEST x else v
+                    end
+            val nb = add(tests_of d_m, x)
+            val nh =
+                add(add(rm(succ_of d_m, name_of n), name_of nt), name_of nf)
+            fun new_rt (NAME rt) = TEST x
+              | new_rt t = t
+            val nc = newdag(nb, nsel, (new_rt o root_of) d_m, nh)
+            val new_m = N(name_of m, assignment_of m, nc, pred_of m)
+            fun updt_t s = addPredNode(s, name_of nt)
+            fun updt_f s = addPredNode(s, name_of nf)
+            val upt = map updt_t (set (nameSetToNodeSet(P, succ(P, nt))))
+            val upf = map updt_f (set (nameSetToNodeSet(P, succ(P, nf))))
+            fun updtl(n, p) = updateNode(p, n)
+            val np =
+                fold updtl ([rmPredNode(n, name_of m), new_m] @ upt @ upf) P
+            val answer = np
+            val foo = mt_debug (fn () => "mtst done")
+            val foo = cpsi("move_test leave", answer)           
+        in
+            answer
+        end
 
 
 fun entries (P as (ns, n0, F)) =
     let val nl = Stringmap.extract ns
-	fun f (a, b) = if unreachable(P, a) then a::b else b
+        fun f (a, b) = if unreachable(P, a) then a::b else b
     in
-	n0 :: (fold f nl nil)
+        n0 :: (fold f nl nil)
     end
 
 fun addPredInfo(P as (ns, n0, F)) =
     let fun rmpi n = setPredNode (n, Set.make)
-	val nl = map rmpi (Stringmap.extract ns)
-	fun updt(n, p) = updateNode(p, n)
-	val np =  fold updt nl P
-	fun addpi (n, p) =
-	     let val s = Set.set (succNodes(p, n))
-		 fun api(s, p) = updateNode(p, addPredNode(s, name_of n))
-	     in
-		 fold api s p
-	     end
+        val nl = map rmpi (Stringmap.extract ns)
+        fun updt(n, p) = updateNode(p, n)
+        val np =  fold updt nl P
+        fun addpi (n, p) =
+             let val s = Set.set (succNodes(p, n))
+                 fun api(s, p) = updateNode(p, addPredNode(s, name_of n))
+             in
+                 fold api s p
+             end
     in
-	fold addpi nl np
+        fold addpi nl np
     end
 
 fun cp_debug (f:debug_fun) =
@@ -1968,60 +1968,60 @@
 
 fun closure (P as (ns, n0, F), entry) =
     let open Set
-	val foo = cp_debug
-	    (fn () =>
-	     "closure:entry=" ^ name_of entry ^ "\nprogram=" ^ progToString P)
-	val isin = Stringmap.isin
-	fun dfs(p, parent, nil) = p
-	  | dfs(p as (ns, n0, F), parent, cur::todo) =
-	    if not (isin ns (name_of cur)) then
-		let val np = dfs(addNode(p, cur), cur, set(succNodes(P, cur)))
-		in
-		    dfs(np, parent, todo)
-		end
-	    else dfs(p, parent, todo)
-	val prog:program = (Stringmap.new(), entry, F)
-	val answer = dfs(addNode(prog, entry),
-			 entry,
-			 set(succNodes(P, entry)))
-	val foo = cp_debug
-	    (fn () =>
-	     "\nclosure=>" ^ progToString answer)
+        val foo = cp_debug
+            (fn () =>
+             "closure:entry=" ^ name_of entry ^ "\nprogram=" ^ progToString P)
+        val isin = Stringmap.isin
+        fun dfs(p, parent, nil) = p
+          | dfs(p as (ns, n0, F), parent, cur::todo) =
+            if not (isin ns (name_of cur)) then
+                let val np = dfs(addNode(p, cur), cur, set(succNodes(P, cur)))
+                in
+                    dfs(np, parent, todo)
+                end
+            else dfs(p, parent, todo)
+        val prog:program = (Stringmap.new(), entry, F)
+        val answer = dfs(addNode(prog, entry),
+                         entry,
+                         set(succNodes(P, entry)))
+        val foo = cp_debug
+            (fn () =>
+             "\nclosure=>" ^ progToString answer)
     in
-	answer
+        answer
     end
 
 fun programs(P as (ns, n0, F):program) =
     let val foo = cp_debug (fn () => "programs")
-	val l = entries (addPredInfo P)
-	(* make sure preds are in closure*)
-	fun cf e = addPredInfo(closure(P, e))
-	val answer = map cf l
-	val foo = cp_debug (fn () => "programs done")
+        val l = entries (addPredInfo P)
+        (* make sure preds are in closure*)
+        fun cf e = addPredInfo(closure(P, e))
+        val answer = map cf l
+        val foo = cp_debug (fn () => "programs done")
     in
-	answer
+        answer
     end
 
 structure ns =
     struct
-	type obj = node
-	    
-	fun int l =
-	    let val z = ord "0"
-		fun f(n, nil) = n
-		  | f (n, d::l) =
-		    if d>="0" andalso d<="9" then f(n*10+ord(d)-z, l)
-		    else n
-	    in
-		f(0,l)
-	    end
+        type obj = node
+            
+        fun int l =
+            let val z = ord "0"
+                fun f(n, nil) = n
+                  | f (n, d::l) =
+                    if d>="0" andalso d<="9" then f(n*10+ord(d)-z, l)
+                    else n
+            in
+                f(0,l)
+            end
 
-	fun gt (a, b) =
-	    let val a = explode(name_of a)
-		val b = explode(name_of b)
-	    in
-		(int a) > (int b)
-	    end
+        fun gt (a, b) =
+            let val a = explode(name_of a)
+                val b = explode(name_of b)
+            in
+                (int a) > (int b)
+            end
     end
 
 structure sortN = Sort(ns)
@@ -2032,14 +2032,14 @@
 
 structure Compress :
     sig
-	val compress_debug : bool ref
-	val compress : (int * Node.program) -> Node.program
-	val move_things_node :
-	    Node.program * Ntypes.name * Ntypes.name Set.set -> Node.program
-	val do_move_tests : bool ref
-	val do_move_ops : bool ref
+        val compress_debug : bool ref
+        val compress : (int * Node.program) -> Node.program
+        val move_things_node :
+            Node.program * Ntypes.name * Ntypes.name Set.set -> Node.program
+        val do_move_tests : bool ref
+        val do_move_ops : bool ref
 
-	val dbg_p : Node.program ref
+        val dbg_p : Node.program ref
 
     end = 
 
@@ -2066,16 +2066,16 @@
 fun debug (f:debug_fun) =
     if !compress_debug then print (f() ^ "\n")
     else ()
-	
+        
 exception FILTERSUCC
 
 fun filterSucc(P, nm, fence_set) =
     let open Set
-	val s = set(succ(P, nameToNode(P, nm)))
-	    handle NAMETONODE => raise FILTERSUCC
-	fun f (nm, l) = if member(fence_set, nm) then l else nm::l
+        val s = set(succ(P, nameToNode(P, nm)))
+            handle NAMETONODE => raise FILTERSUCC
+        fun f (nm, l) = if member(fence_set, nm) then l else nm::l
     in
-	fold f s nil
+        fold f s nil
     end
 
 (*
@@ -2085,129 +2085,129 @@
 
 fun chinP (p, from) =
     let val nm = "11_100'_110tt_119'"
-	val prd = prednm(p, nm)
-	val pe = Set.empty(prd)
+        val prd = prednm(p, nm)
+        val pe = Set.empty(prd)
     in
-	if !inP then
-	    if pe then (foutP := p; error ("chinP gone -" ^ from)) else ()
-	else if pe then ()
-	     else (inP := true;
-		   print ("chinP found it -" ^ from ^ "\n");
-		   finP := p;
-		   nameToNode(p, nm);
-		   ())
+        if !inP then
+            if pe then (foutP := p; error ("chinP gone -" ^ from)) else ()
+        else if pe then ()
+             else (inP := true;
+                   print ("chinP found it -" ^ from ^ "\n");
+                   finP := p;
+                   nameToNode(p, nm);
+                   ())
     end
 *)
 
 exception MOVETHINGSNODE
 fun move_things_node(P, nm, fence_set) =
     let open Set
-	(*
+        (*
         val foo = debug
-	    (fn () =>
-	    "move_things_node(\n" ^
-	    progToString P ^ ",\n" ^
-	    nm ^ ", [" ^
-	    fold (fn (a, b) => a ^ ", " ^ b) (set fence_set) "]" ^
-	    ")")
-	    *)
-	fun ntn (p, nm) = ((* chinP (p, "ntn");*) nameToNode (p, nm))
-	    handle NAMETONODE => (dbg_p := P; raise MOVETHINGSNODE)
-	fun s_nm_list p = filterSucc(p, nm, fence_set)
-	fun nd nm = ntn(P, nm) handle MOVETHINGSNODE => error "nd  nm"
-	val au = listUnionEQ(aeq, map (assignment_of o nd) (s_nm_list P))
-	val tu = listUnionEQ(teq, map (tests_of o dag_of o nd) (s_nm_list P))
-	fun ms (p, a) =
-	    let fun f(nm, l) =
-		((*chinP (p, "ms"); *)
-		 if member(assignment_of(ntn(p, nm)), a) then nm::l
-		 else l
-		     )
-		handle MOVETHINGSNODE => (dbg_p := p; error "ms")
-	    in
-		fold f (s_nm_list p) nil
-	    end
-	fun move_a1(a, p) =
-	    let val msl = ms (p, a)
-		val ms_set = nameSetToNodeSet(p, listToSet msl)
-		fun dms(a, p) = delete(p, ntn(p, a))
-		fun mop() =
-		    let val foo = debug (fn () => "mop start " ^ nm)
-			val new_p = move_op(p, a, ms_set, ntn(p, nm))
-			    handle MOVETHINGSNODE => error "move_a move_op"
-			val foo = debug (fn () => "mop end")
-		    in
-			new_p
-		    end
-		val mpa = mop()
-		    (*
-		val foo = chinP(mpa,
-				"a_move_a amop " ^ nm ^
-				StrPak.stringListString
-				(map name_of (set ms_set)))
-		     *)
-		val answer = fold dms msl mpa
-		    (*
-		val foo = chinP(answer, "a_move_a adel")
-		     *)
-	    in
-		answer
-	    end
-	fun move_a(a, p) = if !do_move_ops then move_a1(a, p) else p
-	fun tset (p, t) =
-	    let fun f(nm, l) =
-		((*chinP (p, "tset");*)
-		 if member(tests_of(dag_of(ntn(p, nm))), t) then nm::l
-		 else l
-		     )
-		handle MOVETHINGSNODE => error "tset"
-	    in
-		fold f (s_nm_list p) nil
-	    end
-	fun move_t1(t, p) =
-	    let val ts = tset (p, t)
-		val answer =
-		    if List.length ts > 0 then
-			move_test(p, t,
-				  (ntn(p, hd ts)
-				   handle MOVETHINGSNODE => error "move_t 1"),
-				  (ntn(p, nm)
-				   handle MOVETHINGSNODE => error "move_t 2"))
+            (fn () =>
+            "move_things_node(\n" ^
+            progToString P ^ ",\n" ^
+            nm ^ ", [" ^
+            fold (fn (a, b) => a ^ ", " ^ b) (set fence_set) "]" ^
+            ")")
+            *)
+        fun ntn (p, nm) = ((* chinP (p, "ntn");*) nameToNode (p, nm))
+            handle NAMETONODE => (dbg_p := P; raise MOVETHINGSNODE)
+        fun s_nm_list p = filterSucc(p, nm, fence_set)
+        fun nd nm = ntn(P, nm) handle MOVETHINGSNODE => error "nd  nm"
+        val au = listUnionEQ(aeq, map (assignment_of o nd) (s_nm_list P))
+        val tu = listUnionEQ(teq, map (tests_of o dag_of o nd) (s_nm_list P))
+        fun ms (p, a) =
+            let fun f(nm, l) =
+                ((*chinP (p, "ms"); *)
+                 if member(assignment_of(ntn(p, nm)), a) then nm::l
+                 else l
+                     )
+                handle MOVETHINGSNODE => (dbg_p := p; error "ms")
+            in
+                fold f (s_nm_list p) nil
+            end
+        fun move_a1(a, p) =
+            let val msl = ms (p, a)
+                val ms_set = nameSetToNodeSet(p, listToSet msl)
+                fun dms(a, p) = delete(p, ntn(p, a))
+                fun mop() =
+                    let val foo = debug (fn () => "mop start " ^ nm)
+                        val new_p = move_op(p, a, ms_set, ntn(p, nm))
+                            handle MOVETHINGSNODE => error "move_a move_op"
+                        val foo = debug (fn () => "mop end")
+                    in
+                        new_p
+                    end
+                val mpa = mop()
+                    (*
+                val foo = chinP(mpa,
+                                "a_move_a amop " ^ nm ^
+                                StrPak.stringListString
+                                (map name_of (set ms_set)))
+                     *)
+                val answer = fold dms msl mpa
+                    (*
+                val foo = chinP(answer, "a_move_a adel")
+                     *)
+            in
+                answer
+            end
+        fun move_a(a, p) = if !do_move_ops then move_a1(a, p) else p
+        fun tset (p, t) =
+            let fun f(nm, l) =
+                ((*chinP (p, "tset");*)
+                 if member(tests_of(dag_of(ntn(p, nm))), t) then nm::l
+                 else l
+                     )
+                handle MOVETHINGSNODE => error "tset"
+            in
+                fold f (s_nm_list p) nil
+            end
+        fun move_t1(t, p) =
+            let val ts = tset (p, t)
+                val answer =
+                    if List.length ts > 0 then
+                        move_test(p, t,
+                                  (ntn(p, hd ts)
+                                   handle MOVETHINGSNODE => error "move_t 1"),
+                                  (ntn(p, nm)
+                                   handle MOVETHINGSNODE => error "move_t 2"))
 
-		    else p
-		(*val foo = chinP(answer, "a_move_t")*)
-	    in
-		answer
-	    end
-	fun move_t(t, p) = if !do_move_tests then move_t1(t, p) else p
+                    else p
+                (*val foo = chinP(answer, "a_move_t")*)
+            in
+                answer
+            end
+        fun move_t(t, p) = if !do_move_tests then move_t1(t, p) else p
     in
-	debug (fn () => "movethingsnode " ^ nm ^ "\n");
-	fold move_t (set tu) (fold move_a (set au) P)
+        debug (fn () => "movethingsnode " ^ nm ^ "\n");
+        fold move_t (set tu) (fold move_a (set au) P)
     end
 
 exception MOVETHINGSWINDOW
 fun move_things_window(P, w, nm, fence_set) =
     let open Set
-	(*
-	val foo = debug (fn () =>
-	                 "move_things_window(\n" ^
-			 progToString P ^ ",\n" ^
-			 (makestring w) ^ ", " ^
-			 nm ^ ", [" ^
-			 fold (fn (a, b) => a ^ ", " ^ b) (set fence_set) "]" ^
-			 ")\n")
-	    *)
-	fun ntn (P, nm) = (nameToNode (P, nm))
-	    handle NAMETONODE =>  raise MOVETHINGSWINDOW
-	val node = ntn(P, nm)
-	val things = num_things_node node
-	val s_nm_list = filterSucc(P, nm, fence_set)
-	fun nxt(nm, p) =
-	    move_things_window(p, w - things, nm, fence_set)
-	val child_p = if w > things then fold nxt s_nm_list P else P
+        (*
+        val foo = debug (fn () =>
+                         "move_things_window(\n" ^
+                         progToString P ^ ",\n" ^
+                         (makestring w) ^ ", " ^
+                         nm ^ ", [" ^
+                         fold (fn (a, b) => a ^ ", " ^ b) (set fence_set) "]" ^
+                         ")\n")
+            *)
+        fun ntn (P, nm) = (nameToNode (P, nm))
+            handle NAMETONODE =>  raise MOVETHINGSWINDOW
+        val node = ntn(P, nm)
+        val things = num_things_node node
+        val s_nm_list = filterSucc(P, nm, fence_set)
+        fun nxt(nm, p) =
+            move_things_window(p, w - things, nm, fence_set)
+        val child_p = if w > things then fold nxt s_nm_list P else P
     in
-	debug (fn () => "movethingswindow " ^ nm ^ "\n");
-	move_things_node(child_p, nm, fence_set)
+        debug (fn () => "movethingswindow " ^ nm ^ "\n");
+        move_things_node(child_p, nm, fence_set)
     end
 
 
@@ -2219,73 +2219,73 @@
 exception CPRESS5
 fun cpress(window, P, fence_set, everin_fence_set) =
     let open Set
-	fun nxt(nm, p:program) = 
-	    ((* dbg_p := p; *)
-	     move_things_window(p, window, nm, fence_set))
-	    handle MOVETHINGSWINDOW => raise CPRESS1
-	val filled = fold nxt (set fence_set) P
-	    handle CPRESS1 => raise CPRESS2
-	fun succf nm = succ(filled, nameToNode(filled, nm))
-	    handle NAMETONODE => raise CPRESS
-	val nfence_set = listUnion(make::(map succf (set fence_set)))
-	fun filt(a, l) = if member(everin_fence_set, a) then l else a::l
-	val f_fence_set = listToSet(fold filt (set nfence_set) nil)
-	val n_everin_fc =
-	    fold (fn (a, s) => add(s, a)) (set f_fence_set) everin_fence_set
+        fun nxt(nm, p:program) = 
+            ((* dbg_p := p; *)
+             move_things_window(p, window, nm, fence_set))
+            handle MOVETHINGSWINDOW => raise CPRESS1
+        val filled = fold nxt (set fence_set) P
+            handle CPRESS1 => raise CPRESS2
+        fun succf nm = succ(filled, nameToNode(filled, nm))
+            handle NAMETONODE => raise CPRESS
+        val nfence_set = listUnion(make::(map succf (set fence_set)))
+        fun filt(a, l) = if member(everin_fence_set, a) then l else a::l
+        val f_fence_set = listToSet(fold filt (set nfence_set) nil)
+        val n_everin_fc =
+            fold (fn (a, s) => add(s, a)) (set f_fence_set) everin_fence_set
     in
-	debug (fn () => "cpress: fence_set=" ^
-	       StrPak.stringListString (set fence_set) ^
-	       "\n f_fence_set =" ^ StrPak.stringListString (set f_fence_set));
-	if not (empty f_fence_set)
-	    then cpress(window, filled, f_fence_set, n_everin_fc)
-		handle CPRESS => raise CPRESS3
-		    handle CPRESS1 => raise CPRESS4
-			handle CPRESS2 => raise CPRESS5
-	else filled
+        debug (fn () => "cpress: fence_set=" ^
+               StrPak.stringListString (set fence_set) ^
+               "\n f_fence_set =" ^ StrPak.stringListString (set f_fence_set));
+        if not (empty f_fence_set)
+            then cpress(window, filled, f_fence_set, n_everin_fc)
+                handle CPRESS => raise CPRESS3
+                    handle CPRESS1 => raise CPRESS4
+                        handle CPRESS2 => raise CPRESS5
+        else filled
     end
 
 fun clean_up (P as (ns, n0, F):program) =
-    let	val foo = debug (fn () => "cleanup")
-	val clos = closure(P, n0)
-	val (ns, n0, F) = clos
-	val l = (map name_of (Stringmap.extract ns))
-	fun f (n, p) =
-	    (debug (fn () => "cleanup deleting " ^ n);
-	    delete(p, nameToNode(p, n)))
-	val answer = fold f l clos
-	val foo = debug (fn () => "exiting cleanup")
+    let val foo = debug (fn () => "cleanup")
+        val clos = closure(P, n0)
+        val (ns, n0, F) = clos
+        val l = (map name_of (Stringmap.extract ns))
+        fun f (n, p) =
+            (debug (fn () => "cleanup deleting " ^ n);
+            delete(p, nameToNode(p, n)))
+        val answer = fold f l clos
+        val foo = debug (fn () => "exiting cleanup")
     in
-	answer
+        answer
     end
     
 fun compress(window, P as (ns, n0, F)) =
     let open Set
-	val fence = n0
-	val fence_set = add(make, name_of n0)
-	val everin_fence_set = add(makeEQ(name_prefix_eq), name_of n0)
-	val uc = cpress(window, P, fence_set, everin_fence_set)
-	val cu = clean_up uc
+        val fence = n0
+        val fence_set = add(make, name_of n0)
+        val everin_fence_set = add(makeEQ(name_prefix_eq), name_of n0)
+        val uc = cpress(window, P, fence_set, everin_fence_set)
+        val cu = clean_up uc
     in
-	debug (fn () => "compress");
-	cu
+        debug (fn () => "compress");
+        cu
     end
-	
+        
 
 
 end
 structure ReadI :
     sig
-	val readI :
-	    HM.operation list -> (HM.operation list * Node.program list)
-	    
-	val writeI :
-	    (HM.operation list * Node.program list) -> HM.operation list
+        val readI :
+            HM.operation list -> (HM.operation list * Node.program list)
+            
+        val writeI :
+            (HM.operation list * Node.program list) -> HM.operation list
 
-	val progMap : Node.program -> string
+        val progMap : Node.program -> string
 
-	val read_debug : bool ref
-	val write_debug : bool ref
-	val live_debug : bool ref
+        val read_debug : bool ref
+        val write_debug : bool ref
+        val live_debug : bool ref
     end = 
 
 struct
@@ -2297,7 +2297,7 @@
 fun read_dbg f =
     if !read_debug then print ("readI.read:" ^ f() ^ "\n")
     else ()
-	
+        
 fun write_dbg f =
     if !write_debug then print ("writeI.read:" ^ f() ^ "\n")
     else ()
@@ -2309,12 +2309,12 @@
 fun btarget (nil, n) = (fn x => raise BTARGET)
   | btarget (h::t, n) =
     let open HM
-	val rf = btarget(t, n + 1)
-	fun g lbl x = if lbl = x then n else rf x
-	fun f (TARGET(lbl, inst)) = (g lbl)
-	  | f _ = rf
+        val rf = btarget(t, n + 1)
+        fun g lbl x = if lbl = x then n else rf x
+        fun f (TARGET(lbl, inst)) = (g lbl)
+          | f _ = rf
     in
-	f h
+        f h
     end
 
 
@@ -2324,146 +2324,146 @@
 
 fun buildNodes l =
     let open HM
-	open Ntypes
-	val t = btarget(l, 0)
-	fun f (nil, n) = nil
-	  | f (ci::rest, n) =
-	    let open Dag
-		open AbsMach
-		val nm = makestring n
-		val nxtnm = makestring (n + 1)
-		fun asn i = Set.listToSetEQ(aeq, i)
-		val edag = reach(Dag.make, NAME nxtnm)
-		fun tgtnm tgt = makestring (t tgt)
-		fun edagt tgt = reach(Dag.make, NAME (tgtnm tgt))
-		val finDag = reach(Dag.make, NAME (Node.name_of Node.fin))
-		fun cdag (tgt,tst)  = attach(tst, edagt tgt, edag)
-		val g =
-		    fn ASSIGNMENT i => Node.make(nm, asn [i], edag, Set.make)
-		     | NERGLE  =>  Node.make(nm, asn [], edag, Set.make)
-		     | LABELREF (tgt, i as GETLAB{lab, dst}) =>
-			   Node.make(nm,
-				     asn [GETLAB{lab=(t tgt, tgtnm tgt),
-						 dst=dst}],
-				     edag, Set.make)
-		     | COMPARISON (tgt, tst) =>
-			   Node.make(nm, asn nil, cdag(tgt, tst), Set.make)
-		     | FLOW (tgt, i) =>
-			   Node.make(nm, asn nil, edagt tgt, Set.make)
-		     | EXIT i => Node.make(nm, asn [i], finDag, Set.make)
-		     | TARGET (lbl, i) =>
-			   Node.make(nm, asn nil, edag, Set.make)
-		     | _ => raise BNODES
-	    in
-		(g ci)::Node.fin::(f (rest, n + 1))
-	    end
-	fun addn(n, p) = Node.addNode(p, n)
-	val prog = fold addn (Node.fin :: f(l, 0)) (Node.makeProg())
+        open Ntypes
+        val t = btarget(l, 0)
+        fun f (nil, n) = nil
+          | f (ci::rest, n) =
+            let open Dag
+                open AbsMach
+                val nm = makestring n
+                val nxtnm = makestring (n + 1)
+                fun asn i = Set.listToSetEQ(aeq, i)
+                val edag = reach(Dag.make, NAME nxtnm)
+                fun tgtnm tgt = makestring (t tgt)
+                fun edagt tgt = reach(Dag.make, NAME (tgtnm tgt))
+                val finDag = reach(Dag.make, NAME (Node.name_of Node.fin))
+                fun cdag (tgt,tst)  = attach(tst, edagt tgt, edag)
+                val g =
+                    fn ASSIGNMENT i => Node.make(nm, asn [i], edag, Set.make)
+                     | NERGLE  =>  Node.make(nm, asn [], edag, Set.make)
+                     | LABELREF (tgt, i as GETLAB{lab, dst}) =>
+                           Node.make(nm,
+                                     asn [GETLAB{lab=(t tgt, tgtnm tgt),
+                                                 dst=dst}],
+                                     edag, Set.make)
+                     | COMPARISON (tgt, tst) =>
+                           Node.make(nm, asn nil, cdag(tgt, tst), Set.make)
+                     | FLOW (tgt, i) =>
+                           Node.make(nm, asn nil, edagt tgt, Set.make)
+                     | EXIT i => Node.make(nm, asn [i], finDag, Set.make)
+                     | TARGET (lbl, i) =>
+                           Node.make(nm, asn nil, edag, Set.make)
+                     | _ => raise BNODES
+            in
+                (g ci)::Node.fin::(f (rest, n + 1))
+            end
+        fun addn(n, p) = Node.addNode(p, n)
+        val prog = fold addn (Node.fin :: f(l, 0)) (Node.makeProg())
     in
-	prog
+        prog
     end
-	    
+            
 exception READI
 exception READI_NTN
 fun readI ol =
     let open HM
-	fun junkfil (JUNK a, (junk, other)) = (JUNK a :: junk, other)
-	  | junkfil (x, (junk, other)) = (junk, x::other)
-	val cl = map HM.classify ol
-	val (junk, other) = fold junkfil cl (nil, nil)
-	fun ntn x = (Node.nameToNode x )
-	    handle NAMETONODE => raise READI_NTN
-	val (ns, foo, fin) = buildNodes other
-	val nn = (ns, ntn((ns, foo, fin), "0"), fin)
-	fun unjunk (JUNK i) = i
-	  | unjunk _ = raise READI
-	val progs = programs nn
-	val foo = read_dbg
-	    (fn () => ("progs =>" ^
-		       (StrPak.stringListString
-			(map Node.progToString progs))))
+        fun junkfil (JUNK a, (junk, other)) = (JUNK a :: junk, other)
+          | junkfil (x, (junk, other)) = (junk, x::other)
+        val cl = map HM.classify ol
+        val (junk, other) = fold junkfil cl (nil, nil)
+        fun ntn x = (Node.nameToNode x )
+            handle NAMETONODE => raise READI_NTN
+        val (ns, foo, fin) = buildNodes other
+        val nn = (ns, ntn((ns, foo, fin), "0"), fin)
+        fun unjunk (JUNK i) = i
+          | unjunk _ = raise READI
+        val progs = programs nn
+        val foo = read_dbg
+            (fn () => ("progs =>" ^
+                       (StrPak.stringListString
+                        (map Node.progToString progs))))
     in
-	 (map unjunk junk,  progs)
+         (map unjunk junk,  progs)
     end
 
 structure ps =
     struct
-	open Ntypes
-	type obj = Node.program
+        open Ntypes
+        type obj = Node.program
 
-	fun int l =
-	    let val z = ord "0"
-		fun f(n, nil) = n
-		  | f (n, d::l) =
-		    if d>="0" andalso d<="9" then f(n*10+ord(d)-z, l)
-		    else n
-	    in
-		f(0,l)
-	    end
+        fun int l =
+            let val z = ord "0"
+                fun f(n, nil) = n
+                  | f (n, d::l) =
+                    if d>="0" andalso d<="9" then f(n*10+ord(d)-z, l)
+                    else n
+            in
+                f(0,l)
+            end
 
         fun gt((nsa, n0a, Fa), (nsb, n0b, Fb)) =
-	    let val a = explode (Node.name_of n0a)
-		val b = explode (Node.name_of n0b)
-	    in
-		(int a) > (int b)
-	    end
+            let val a = explode (Node.name_of n0a)
+                val b = explode (Node.name_of n0b)
+            in
+                (int a) > (int b)
+            end
     end
 
 structure sortP = Sort (ps)
 
 fun live_dbg f = if !live_debug then print ("live:" ^ f() ^ "\n")
-		 else ()
+                 else ()
 
 fun build_live_tab(P as (ns, n0, F): Node.program) =
     let open Ntypes
-	open Node
-	open Set
-	fun fil (a, b) = if a < 0 orelse Delay.is_bogus_reg (a, "") then b
-			 else add(b, a)
-	fun fil_lset s = fold fil (set s) make
-	val lt:(int set) Stringmap.stringmap = Stringmap.new()
-	val finset = listToSet [0, 1, 2, 3, 4, 5]
-	fun flive f n =
-	    if Stringmap.isin lt (name_of n) then Stringmap.map lt (name_of n)
-	    else f n 
-	fun dfs cur =
-	    let fun fl n = flive dfs n
-		val nm = name_of cur
-		val gen = (fil_lset o readNode) cur
-		val kill = writeNode cur
-		val foo  = Stringmap.add lt (nm, gen)
-		val children = succNodes(P, cur)
-		val ch_live = if empty children then finset
-			     else listUnion (map fl (set children))
-		val live = union(diff(ch_live, kill), gen)
-		val foo = Stringmap.rm lt nm
-		val foo = Stringmap.add lt (nm, live)
-	    in
-		live
-	    end
+        open Node
+        open Set
+        fun fil (a, b) = if a < 0 orelse Delay.is_bogus_reg (a, "") then b
+                         else add(b, a)
+        fun fil_lset s = fold fil (set s) make
+        val lt:(int set) Stringmap.stringmap = Stringmap.new()
+        val finset = listToSet [0, 1, 2, 3, 4, 5]
+        fun flive f n =
+            if Stringmap.isin lt (name_of n) then Stringmap.map lt (name_of n)
+            else f n 
+        fun dfs cur =
+            let fun fl n = flive dfs n
+                val nm = name_of cur
+                val gen = (fil_lset o readNode) cur
+                val kill = writeNode cur
+                val foo  = Stringmap.add lt (nm, gen)
+                val children = succNodes(P, cur)
+                val ch_live = if empty children then finset
+                             else listUnion (map fl (set children))
+                val live = union(diff(ch_live, kill), gen)
+                val foo = Stringmap.rm lt nm
+                val foo = Stringmap.add lt (nm, live)
+            in
+                live
+            end
     in
-	dfs n0;
-	(fn nm => 
-	 let val ans = Stringmap.map lt nm
-	     val foo = live_dbg (fn () => nm ^ "=>" ^
-				 StrPak.stringListString
-				 (map makestring (set ans)))
-	 in
-	     ans
-	 end)
+        dfs n0;
+        (fn nm => 
+         let val ans = Stringmap.map lt nm
+             val foo = live_dbg (fn () => nm ^ "=>" ^
+                                 StrPak.stringListString
+                                 (map makestring (set ans)))
+         in
+             ans
+         end)
     end
 
 (* live is the union of live in successors *)
 fun branch_live (P, tab, nm) =
     let open Node
-	val s = Set.set (succ(P, nameToNode(P, nm)))
-	val l:int Set.set = Set.listUnion (map tab s)
-	val foo = live_dbg
-	    (fn()=>("branch_live " ^ nm ^ " s=" ^
-		    StrPak.stringListString s ^ " -> " ^
-		    StrPak.stringListString (map makestring (Set.set l))))
+        val s = Set.set (succ(P, nameToNode(P, nm)))
+        val l:int Set.set = Set.listUnion (map tab s)
+        val foo = live_dbg
+            (fn()=>("branch_live " ^ nm ^ " s=" ^
+                    StrPak.stringListString s ^ " -> " ^
+                    StrPak.stringListString (map makestring (Set.set l))))
     in
-	l
+        l
     end
 
 exception WRITEP
@@ -2472,195 +2472,195 @@
 
 fun writeP (entry_map,  lbl_fun, P as (ns, n0, F):Node.program) =
     let open Ntypes
-	open Node
-	open Set
-	open HM
-	open AbsMach
-	val foo = write_dbg(fn () => "program:" ^ progToString P)
-	fun blblmap nil = (fn x => (print ("blblmap_" ^ x); raise WRITEP))
-	  | blblmap (nm::t) =
-	    let val mp = blblmap t
-		val mylab = lbl_fun()
-	    in
-		    (fn x => if x = nm then mylab else mp x)
-	    end
-	val lblmap = blblmap(map name_of (Stringmap.extract ns))
-	val live_tab = build_live_tab P
-	fun label_list nm = map (fn r => (r, "")) (set (live_tab nm))
-	fun br_list nm =
-	    map (fn r => (r, "")) (set (branch_live(P, live_tab, nm)))
-	fun getlab (GETLAB{lab=(i,s), dst}) =
-	    GETLAB{lab=(entry_map s, "node" ^ s), dst=dst}
-	  | getlab _ = raise WRITEP1
-	fun dogetlabs (i as GETLAB _, l) = (getlab i) :: l
-	  | dogetlabs (i, l) = i :: l
-	fun ubranch (frm, nm) =
-	    BRANCH{test=ieq, src1=(0, "zero"), src2=(0, "zero"),
-		   dst=(lblmap nm, "node" ^ nm), live=br_list frm}
-	fun cbranch (BRANCH{test, src1, src2, dst, live}, frm, nm) =
-	    BRANCH{test=test, src1=src1, src2=src2,
-		   dst=(lblmap nm, "node" ^ nm), live=br_list frm}
-	  | cbranch _ = (print "cbranch"; raise Match)
-	fun label nm = LABEL{lab=(lblmap nm, "node" ^ nm), live=label_list nm}
-	fun entry_label nm =
-	    LABEL{lab=(entry_map nm, "entry"), live=label_list nm}
+        open Node
+        open Set
+        open HM
+        open AbsMach
+        val foo = write_dbg(fn () => "program:" ^ progToString P)
+        fun blblmap nil = (fn x => (print ("blblmap_" ^ x); raise WRITEP))
+          | blblmap (nm::t) =
+            let val mp = blblmap t
+                val mylab = lbl_fun()
+            in
+                    (fn x => if x = nm then mylab else mp x)
+            end
+        val lblmap = blblmap(map name_of (Stringmap.extract ns))
+        val live_tab = build_live_tab P
+        fun label_list nm = map (fn r => (r, "")) (set (live_tab nm))
+        fun br_list nm =
+            map (fn r => (r, "")) (set (branch_live(P, live_tab, nm)))
+        fun getlab (GETLAB{lab=(i,s), dst}) =
+            GETLAB{lab=(entry_map s, "node" ^ s), dst=dst}
+          | getlab _ = raise WRITEP1
+        fun dogetlabs (i as GETLAB _, l) = (getlab i) :: l
+          | dogetlabs (i, l) = i :: l
+        fun ubranch (frm, nm) =
+            BRANCH{test=ieq, src1=(0, "zero"), src2=(0, "zero"),
+                   dst=(lblmap nm, "node" ^ nm), live=br_list frm}
+        fun cbranch (BRANCH{test, src1, src2, dst, live}, frm, nm) =
+            BRANCH{test=test, src1=src1, src2=src2,
+                   dst=(lblmap nm, "node" ^ nm), live=br_list frm}
+          | cbranch _ = (print "cbranch"; raise Match)
+        fun label nm = LABEL{lab=(lblmap nm, "node" ^ nm), live=label_list nm}
+        fun entry_label nm =
+            LABEL{lab=(entry_map nm, "entry"), live=label_list nm}
 
-	fun f (done, lastnm, nm) =
-	    let val foo = write_dbg
-		    (fn () =>
-		     "f (" ^
-		     StrPak.stringListString (set done) ^ "," ^
-		     nm ^ ")")
-	    in
-	    if nm = name_of F then (write_dbg_s "fin"; (done, [NOP]))
-	    else if member(done, nm) then (write_dbg_s "already";
-					   (done, [NOP, ubranch(lastnm, nm)]))
-	    else
-		let open Dag
-		    val foo = write_dbg_s "doing"
-		    val node = nameToNode(P, nm)
-			handle NAMETONODE => raise WRITEP_NTN
-		    val needlabel = 
-			let val pd = set (pred (P, node))
-			    val foo = write_dbg
-				(fn () => ("needlabel pd=" ^
-					   StrPak.stringListString pd))
-			    fun f nil = false
-			      | f ((p::nil):Ntypes.name list) =
-				let val pn = nameToNode(P, p:Ntypes.name)
-				    val foo = write_dbg
-					(fn () => ("ndlbl: pn=" ^
-						   nodeToString pn))
-				    val d = dag_of pn
-				    val sel = sel_of d
-				    val rt = root_of d
-				    fun istst (TEST t) =
-					(write_dbg_s "ist true\n";
-					 true)
-				      | istst (NAME n) =
-					(write_dbg_s "ist false\n";
-					 false)
-				      | istst NEITHER =
-					(write_dbg_s "ist false\n";
-					 false)
-				    fun untst (TEST t) = t
-				      | untst _ = (print "needlabel1";
-						  raise Match)
-				    fun unnm (NAME nm) = nm
-				      | unnm _ = (print "needlabel2";
-						  raise Match)
-				    val foo =
-					if istst rt then
-					    write_dbg
-					    (fn () =>
-					     ("sel=" ^
-					      unnm(sel(untst rt, true)) ^
-					      "\n"))
-					    else ()
-				in
-				    istst rt andalso
-				    (sel(untst rt, true) = NAME nm)
-				end
-			      | f (a::b::c) = true
-			    val answer = f pd
-			    val foo = write_dbg
-				(fn () => ("needlabel=>" ^
-					   Bool.toString answer))
-			in
-			    answer
-			end
-		    val nodelabel = if needlabel then [label nm] else nil
-		    val nodeNOP = [NOP]
-		    val a = fold dogetlabs (set (assignment_of node)) nil
-		    val d = dag_of node
-		    val sel = sel_of d
-		    val rt = root_of d
-		    (* only works for <= 1 test *)
-		    fun dag_code NEITHER = (nil, nil)
-		      | dag_code (NAME n) = ([n], nil)
-		      | dag_code (TEST t) =
-			let fun unnm (NAME x) = x
-			      | unnm _ = (print "dag_code"; raise Match)
-			    val t_n = unnm(sel(t, true))
-			    val f_n = unnm(sel(t, false))
-			in
-			    ([f_n, t_n], [cbranch(t, nm, t_n)])
-			end
-		    val (nl, cd) = dag_code rt
-		    exception DFS_SURPRISE
-		    fun dfs (done, nil) = (write_dbg_s "dfs nil";
-					   (done, nil))
-		      | dfs (done, h::nil) = (write_dbg_s "dfs 1";
-					      f(done, nm, h))
-		      | dfs (done, h::nxt::nil) =
-			let val foo = write_dbg_s "dfs 2"
-			    val (dn1, cd1) = f(done, nm, h)
-			    val (dn2, cd2) =
-				if member(dn1, nxt) then (dn1, nil)
-				else dfs(dn1, nxt::nil)
-			    val lbl =
-				if nxt = name_of F orelse
-				    member(dn2, nxt) then [NOP]
-				else [NOP, label nxt]
-			in
-			    (dn2, cd1 @ lbl @ cd2)
-			end
-		      | dfs _ = raise DFS_SURPRISE
-		    val (dn, dcd) = dfs(add(done, nm), nl)
-		in
-		    (dn, NOP :: nodelabel @ a @ cd @ dcd)
-		end
-	    end
-	    val (done, code) = f (Set.make, "badname", name_of n0)
+        fun f (done, lastnm, nm) =
+            let val foo = write_dbg
+                    (fn () =>
+                     "f (" ^
+                     StrPak.stringListString (set done) ^ "," ^
+                     nm ^ ")")
+            in
+            if nm = name_of F then (write_dbg_s "fin"; (done, [NOP]))
+            else if member(done, nm) then (write_dbg_s "already";
+                                           (done, [NOP, ubranch(lastnm, nm)]))
+            else
+                let open Dag
+                    val foo = write_dbg_s "doing"
+                    val node = nameToNode(P, nm)
+                        handle NAMETONODE => raise WRITEP_NTN
+                    val needlabel = 
+                        let val pd = set (pred (P, node))
+                            val foo = write_dbg
+                                (fn () => ("needlabel pd=" ^
+                                           StrPak.stringListString pd))
+                            fun f nil = false
+                              | f ((p::nil):Ntypes.name list) =
+                                let val pn = nameToNode(P, p:Ntypes.name)
+                                    val foo = write_dbg
+                                        (fn () => ("ndlbl: pn=" ^
+                                                   nodeToString pn))
+                                    val d = dag_of pn
+                                    val sel = sel_of d
+                                    val rt = root_of d
+                                    fun istst (TEST t) =
+                                        (write_dbg_s "ist true\n";
+                                         true)
+                                      | istst (NAME n) =
+                                        (write_dbg_s "ist false\n";
+                                         false)
+                                      | istst NEITHER =
+                                        (write_dbg_s "ist false\n";
+                                         false)
+                                    fun untst (TEST t) = t
+                                      | untst _ = (print "needlabel1";
+                                                  raise Match)
+                                    fun unnm (NAME nm) = nm
+                                      | unnm _ = (print "needlabel2";
+                                                  raise Match)
+                                    val foo =
+                                        if istst rt then
+                                            write_dbg
+                                            (fn () =>
+                                             ("sel=" ^
+                                              unnm(sel(untst rt, true)) ^
+                                              "\n"))
+                                            else ()
+                                in
+                                    istst rt andalso
+                                    (sel(untst rt, true) = NAME nm)
+                                end
+                              | f (a::b::c) = true
+                            val answer = f pd
+                            val foo = write_dbg
+                                (fn () => ("needlabel=>" ^
+                                           Bool.toString answer))
+                        in
+                            answer
+                        end
+                    val nodelabel = if needlabel then [label nm] else nil
+                    val nodeNOP = [NOP]
+                    val a = fold dogetlabs (set (assignment_of node)) nil
+                    val d = dag_of node
+                    val sel = sel_of d
+                    val rt = root_of d
+                    (* only works for <= 1 test *)
+                    fun dag_code NEITHER = (nil, nil)
+                      | dag_code (NAME n) = ([n], nil)
+                      | dag_code (TEST t) =
+                        let fun unnm (NAME x) = x
+                              | unnm _ = (print "dag_code"; raise Match)
+                            val t_n = unnm(sel(t, true))
+                            val f_n = unnm(sel(t, false))
+                        in
+                            ([f_n, t_n], [cbranch(t, nm, t_n)])
+                        end
+                    val (nl, cd) = dag_code rt
+                    exception DFS_SURPRISE
+                    fun dfs (done, nil) = (write_dbg_s "dfs nil";
+                                           (done, nil))
+                      | dfs (done, h::nil) = (write_dbg_s "dfs 1";
+                                              f(done, nm, h))
+                      | dfs (done, h::nxt::nil) =
+                        let val foo = write_dbg_s "dfs 2"
+                            val (dn1, cd1) = f(done, nm, h)
+                            val (dn2, cd2) =
+                                if member(dn1, nxt) then (dn1, nil)
+                                else dfs(dn1, nxt::nil)
+                            val lbl =
+                                if nxt = name_of F orelse
+                                    member(dn2, nxt) then [NOP]
+                                else [NOP, label nxt]
+                        in
+                            (dn2, cd1 @ lbl @ cd2)
+                        end
+                      | dfs _ = raise DFS_SURPRISE
+                    val (dn, dcd) = dfs(add(done, nm), nl)
+                in
+                    (dn, NOP :: nodelabel @ a @ cd @ dcd)
+                end
+            end
+            val (done, code) = f (Set.make, "badname", name_of n0)
     in
-	(entry_label (name_of n0)) :: (label (name_of n0)) :: code
+        (entry_label (name_of n0)) :: (label (name_of n0)) :: code
     end
 
 exception WRITEI
 
 fun progMap(p as (ns, n0, F)) =
     let val l = Node.sortNodes (Stringmap.extract ns)
-	val outstr = ref ""
-	fun pr s = outstr := !outstr ^ s
-	fun ntn n = Node.nameToNode(p, n)
-	val n0nm = Node.name_of n0
-	val nFnm = Node.name_of F
-	fun f n =
-	    let	val s = Set.set (Node.succ(p, n))
-		val nm = Node.name_of n
-		val pre = if nm = n0nm then "->\t"
-			  else "\t"
-		val post = if nm = nFnm then "\t->\n"
-			   else "\n"
-	    in
-		pr (pre ^
-		    Node.name_of n ^ "\t->\t" ^ StrPak.stringListString s ^
-		    post)
-	    end
+        val outstr = ref ""
+        fun pr s = outstr := !outstr ^ s
+        fun ntn n = Node.nameToNode(p, n)
+        val n0nm = Node.name_of n0
+        val nFnm = Node.name_of F
+        fun f n =
+            let val s = Set.set (Node.succ(p, n))
+                val nm = Node.name_of n
+                val pre = if nm = n0nm then "->\t"
+                          else "\t"
+                val post = if nm = nFnm then "\t->\n"
+                           else "\n"
+            in
+                pr (pre ^
+                    Node.name_of n ^ "\t->\t" ^ StrPak.stringListString s ^
+                    post)
+            end
     in
-	List.app f l;
-	!outstr
+        List.app f l;
+        !outstr
     end
 
 fun writeI(j:AbsMach.opcode list, p:Node.program list) =
     let val labelid = ref 0
-	fun newlabel () = (labelid := !labelid + 1; !labelid - 1)
-	fun bentrymap nil = (fn x => (print ("bentrymap_" ^ x); raise WRITEI))
-	  | bentrymap ((ns, n0, F)::t) =
-	    let val mp = bentrymap t
-		val mylab = newlabel()
-	    in
-		(fn x => if x = Node.name_of n0 then mylab else mp x)
-	    end
-	val entry_map = bentrymap p
-	val sp = sortP.sort p
-	fun wp p = writeP (entry_map, newlabel, p)
-	fun f(a, b) = (wp a) @ b
-	val i = fold f sp nil
+        fun newlabel () = (labelid := !labelid + 1; !labelid - 1)
+        fun bentrymap nil = (fn x => (print ("bentrymap_" ^ x); raise WRITEI))
+          | bentrymap ((ns, n0, F)::t) =
+            let val mp = bentrymap t
+                val mylab = newlabel()
+            in
+                (fn x => if x = Node.name_of n0 then mylab else mp x)
+            end
+        val entry_map = bentrymap p
+        val sp = sortP.sort p
+        fun wp p = writeP (entry_map, newlabel, p)
+        fun f(a, b) = (wp a) @ b
+        val i = fold f sp nil
     in
-	i @ j
+        i @ j
     end
-	    
+            
 
 end
 
@@ -2926,11 +2926,11 @@
       exec(MOVE{src=(s,_),dst=(d,_)})=
         update((!Reg),d, (!Reg) sub s )                        |
       exec(LABEL {...})= 
-        ()						       |
+        ()                                                     |
       exec(LABWORD {...}) = 
-        ()						       |
+        ()                                                     |
       exec(WORD{...})=
-        ()						       |
+        ()                                                     |
       exec(JUMP {dst=(d,_),...})=
         execjmp((!Reg) sub d)                                  |
       exec(ARITH {oper=opn,src1=(s1,_),src2=(s2,_),dst=(d,_)})= 
@@ -2943,7 +2943,7 @@
         else ()                                                        |
       exec(NOP)= () |
       exec(BOGUS _)= raise Match
-	    
+            
       ;
 
 
@@ -3048,7 +3048,7 @@
 
       disp(JUMP{dst=(d,ds),live=lt}) = 
       "JUMP{dst=("^ims(d)^","^ds^"),live=["^lms(lt)^"]}\n"                 |
-		
+                
       disp(LABWORD{lab=(l,s)})="LABWORD{lab=("^ims(l)^","^s^")}\n"         |
 
       disp(LABEL{lab=(l,s),live=lt})=
@@ -3251,7 +3251,7 @@
                      dst=(labnum,_),...}::t,vt)=
         if compare(comp,(!Reg) sub s1,(!Reg) sub s2) 
         then (IP:= !(findjmp_place(labnum)); flag:=false; dowr(t,vt) )
-        else dowr(t,vt)	                                                  |
+        else dowr(t,vt)                                                   |
       dowr(h::t,vt)=dowr(t,vt)                                            
       ;
 
@@ -3316,7 +3316,7 @@
             in f((!sizen),codel) end;
                 
 
-(*  This part for Pipeline mode 				*)
+(*  This part for Pipeline mode                                 *)
 
 
   exception illegal_jump_within_branchdelay;
@@ -3456,16 +3456,16 @@
 
 fun read file =
     let val if1 = (open_in "simprelude.s")
-	val if2 = (open_in file)
-	val if3 = (open_in "simpostlude.s")
-	val prelude = ReadAbs.read if1
-	val prog = ReadAbs.read if2
-	val postlude = ReadAbs.read if3
+        val if2 = (open_in file)
+        val if3 = (open_in "simpostlude.s")
+        val prelude = ReadAbs.read if1
+        val prog = ReadAbs.read if2
+        val postlude = ReadAbs.read if3
     in
-	close_in if1;
-	close_in if2;
-	close_in if3;
-	prelude @ prog @ postlude
+        close_in if1;
+        close_in if2;
+        close_in if3;
+        prelude @ prog @ postlude
     end
 
 fun init file = SetEnv.init (read file)
@@ -3474,13 +3474,13 @@
 
 fun run ()=
     let open AbsMach
-	val foo = runcount := 0
-	fun updc NOP = runcount := !runcount + 1
-	  | updc _ = ()
-	open SetEnv
-	fun f () = (step(); (updc o hd o pc)(); f())
+        val foo = runcount := 0
+        fun updc NOP = runcount := !runcount + 1
+          | updc _ = ()
+        open SetEnv
+        fun f () = (step(); (updc o hd o pc)(); f())
     in
-	f()
+        f()
     end
 
 fun srun () = let open SetEnv in d_pc(); step(); srun() end;
@@ -3490,26 +3490,26 @@
 
 fun memcmp(a:AbsMach.values array, b:AbsMach.values array) = 
     let open AbsMach
-	fun cmp (INT a, INT b) = a = b
-	  | cmp (REAL a, REAL b) = realEq(a, b)
-	  | cmp (LABVAL _, LABVAL _) = true
-	  | cmp _ = false
-	fun f 0 = ~1
-	  | f n = if cmp((a sub n), (b sub n)) then f (n - 1) else n
-	val al = Array.length a
-	val bl = Array.length b
+        fun cmp (INT a, INT b) = a = b
+          | cmp (REAL a, REAL b) = realEq(a, b)
+          | cmp (LABVAL _, LABVAL _) = true
+          | cmp _ = false
+        fun f 0 = ~1
+          | f n = if cmp((a sub n), (b sub n)) then f (n - 1) else n
+        val al = Array.length a
+        val bl = Array.length b
     in
-	if al = bl then f (al - 1) else (print "size\n"; 0)
+        if al = bl then f (al - 1) else (print "size\n"; 0)
     end
 
 
 fun copyarray a =
     let val la = Array.length a
-	val na = array(la, a sub 0)
-	fun f n = if n > 0 then (update(na, n, a sub n) ; f (n - 1)) else ()
-	val foo = f (la - 1)
+        val na = array(la, a sub 0)
+        fun f n = if n > 0 then (update(na, n, a sub n) ; f (n - 1)) else ()
+        val foo = f (la - 1)
     in
-	na
+        na
     end
 
 
@@ -3520,7 +3520,7 @@
     fun vstring (INT i) = "INT " ^ makestring i
       | vstring (REAL i) = "REAL " ^ Real.toString i
       | vstring (LABVAL(i, j)) =
-	"LABVAL(" ^ makestring i ^ ", " ^ makestring j ^ ")"
+        "LABVAL(" ^ makestring i ^ ", " ^ makestring j ^ ")"
 end
 
 fun runf f = 
@@ -3528,59 +3528,59 @@
       run ();
       raise PROG_NO_END))
     handle End_of_Program => (print "eop\n";
-			      SetEnv.regc 4)
-			       
+                              SetEnv.regc 4)
+                               
     
 fun cmprog(f1, f2) =
     let open AbsMach
-	fun intof (INT i) = i
-	fun ptsat p = SetEnv.mcell (intof p)
-	val p1 = runf f1
-	(* val foo = print ("cmprog1:" ^ vstring p1 ^ "\n") *)
-	val v1 = ptsat p1 
-	val r1 = !runcount
-	val p2 = runf f2
-	(* val foo = print ("cmprog2:" ^ vstring p2 ^ "\n") *)
-	val v2 = ptsat p2
-	val r2 = !runcount
+        fun intof (INT i) = i
+        fun ptsat p = SetEnv.mcell (intof p)
+        val p1 = runf f1
+        (* val foo = print ("cmprog1:" ^ vstring p1 ^ "\n") *)
+        val v1 = ptsat p1 
+        val r1 = !runcount
+        val p2 = runf f2
+        (* val foo = print ("cmprog2:" ^ vstring p2 ^ "\n") *)
+        val v2 = ptsat p2
+        val r2 = !runcount
 
     in
-	(f1 ^ " ct " ^ makestring r1 ^ " ptr " ^ vstring p1 ^
-	  " val " ^ vstring v1 ^ 
-	 f2 ^ " ct " ^ makestring r2 ^ " ptr " ^ vstring p2 ^
-	 " val " ^ vstring v2 ^  "\n")
+        (f1 ^ " ct " ^ makestring r1 ^ " ptr " ^ vstring p1 ^
+          " val " ^ vstring v1 ^ 
+         f2 ^ " ct " ^ makestring r2 ^ " ptr " ^ vstring p2 ^
+         " val " ^ vstring v2 ^  "\n")
     end
 
 end
 
 fun time str f =
     let (* open System.Timer
-	val s = start_timer() *)
-	val v = f()
+        val s = start_timer() *)
+        val v = f()
         (*
-	val e = check_timer s
-	val foo = print (str ^ " took " ^ makestring e ^ "sec.usec\n")
+        val e = check_timer s
+        val foo = print (str ^ " took " ^ makestring e ^ "sec.usec\n")
         *)
     in
-	v
+        v
     end
 
 
 fun writeprog(file, j, p) =
     let val ot = (open_out file)
-	val prog = ReadI.writeI(j, p)
-	val filp = (Delay.rm_bogus o OutFilter.remnops) prog
-	val xxx = PrintAbs.show ot filp
+        val prog = ReadI.writeI(j, p)
+        val filp = (Delay.rm_bogus o OutFilter.remnops) prog
+        val xxx = PrintAbs.show ot filp
     in
-	close_out ot
+        close_out ot
     end;
    
 fun wp(file, prog) =
     let val ot = (open_out file)
-	val filp = Delay.rm_bogus prog
-	val xxx = PrintAbs.show ot filp
+        val filp = Delay.rm_bogus prog
+        val xxx = PrintAbs.show ot filp
     in
-	close_out ot
+        close_out ot
     end;
      
 fun dodelay i = (Delay.init i; Delay.add_delay i);
@@ -3606,7 +3606,7 @@
     
 fun ndnm nil = raise Node.NAMETONODE
 | ndnm(h::t) = (fn (nm) => Node.nameToNode(h, nm)
-		handle Node.NAMETONODE => ndnm t nm);
+                handle Node.NAMETONODE => ndnm t nm);
 
 exception ERROR;
 
@@ -3615,7 +3615,7 @@
 fun pmem nil = (err "oh well")
   | pmem ((ns, n0, f)::t) =
     fn n => if Set.member(ns, n) then (ns, n0, f)
-	    else pmem t n;
+            else pmem t n;
 
 structure Main = struct
 
@@ -3637,48 +3637,48 @@
 
 fun main(s:string list, env:string list) =
     let val idemp = ref 0
-	val ws = ref 0
-	val ifile = ref "/dev/null"
-	val ofile = ref "/dev/null"
-	val c_ofile = ref "/dev/null"
-	val gotifile = ref false
-	val gotofile = ref false
-	fun digit d =
-	if ord d >= ord "0" andalso ord d <= ord "9" then ord d - ord "0"
-	    else err ("expected digit. got " ^ d)
-	val parse =
-	fn ("-" :: "i" :: "d" :: "e" :: "m" :: d :: nil) =>
-	idemp := digit d
-	 | ("-" :: "w" :: "s" :: d :: nil) =>
-	       ws := digit d
-	 | ("-" :: t)  =>
-	       (print ("usage: comp [-ws#] [-idem#]" ^
-		       "input_file temp_file compressed_file\n");
-		print ("ws is the window size\nidem is the idempotency\n");
-		err "exiting")
-	 | s  => if !gotofile then c_ofile := implode s
-		 else if !gotifile then (gotofile := true;
-					 ofile := implode s)
-		      else (gotifile := true;
-			    ifile := implode s)
-	val foo = List.app (parse o explode) (tl s)
-	val foo = print ("compressing " ^ !ifile ^ " into (uncompressed)" ^
-			 !ofile ^
-			 " and (compressed)" ^ !c_ofile ^
-			 " with idempotency " ^ makestring (!idemp) ^
-			 " and window size " ^ makestring (!ws) ^ "\n")
+        val ws = ref 0
+        val ifile = ref "/dev/null"
+        val ofile = ref "/dev/null"
+        val c_ofile = ref "/dev/null"
+        val gotifile = ref false
+        val gotofile = ref false
+        fun digit d =
+        if ord d >= ord "0" andalso ord d <= ord "9" then ord d - ord "0"
+            else err ("expected digit. got " ^ d)
+        val parse =
+        fn ("-" :: "i" :: "d" :: "e" :: "m" :: d :: nil) =>
+        idemp := digit d
+         | ("-" :: "w" :: "s" :: d :: nil) =>
+               ws := digit d
+         | ("-" :: t)  =>
+               (print ("usage: comp [-ws#] [-idem#]" ^
+                       "input_file temp_file compressed_file\n");
+                print ("ws is the window size\nidem is the idempotency\n");
+                err "exiting")
+         | s  => if !gotofile then c_ofile := implode s
+                 else if !gotifile then (gotofile := true;
+                                         ofile := implode s)
+                      else (gotifile := true;
+                            ifile := implode s)
+        val foo = List.app (parse o explode) (tl s)
+        val foo = print ("compressing " ^ !ifile ^ " into (uncompressed)" ^
+                         !ofile ^
+                         " and (compressed)" ^ !c_ofile ^
+                         " with idempotency " ^ makestring (!idemp) ^
+                         " and window size " ^ makestring (!ws) ^ "\n")
     in
-	Delay.idempotency := !idemp;
-	doitx(!ifile, !ofile, !c_ofile, !ws)
+        Delay.idempotency := !idemp;
+        doitx(!ifile, !ofile, !c_ofile, !ws)
     end
 
 val s = OS.FileSys.getDir()
 
 fun doit() = main(["foobar", "-ws9", 
-		   s^"/DATA/ndotprod.s", 
-		   s^"/DATA/tmp.s", 
-		   s^"/DATA/cmp.s"], 
-		  nil)
+                   s^"/DATA/ndotprod.s", 
+                   s^"/DATA/tmp.s", 
+                   s^"/DATA/cmp.s"], 
+                  nil)
 fun testit _ = ()
 end 
 
@@ -3687,13 +3687,13 @@
       open Main
 
       val doit =
-	    fn n =>
-	    let
-	       fun loop n =
-		  if n = 0
-		     then ()
-		  else (doit();
-			loop(n-1))
-	    in loop n
-	    end
+            fn n =>
+            let
+               fun loop n =
+                  if n = 0
+                     then ()
+                  else (doit();
+                        loop(n-1))
+            in loop n
+            end
    end

Modified: mlton/branches/on-20050420-cmm-branch/benchmark/tests/wc-input1.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/benchmark/tests/wc-input1.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/benchmark/tests/wc-input1.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -3,33 +3,33 @@
 structure Main =
    struct
       fun doit n =
-	 let
-	    open TextIO
-	    val f = OS.FileSys.tmpName ()
-	    val out = openOut f
-	    val _ =
-	       output (out,
-		       String.implode
-		       (List.tabulate (1000000, fn i =>
-				       if i mod 10 = 0 then #"\n" else #"a")))
-	    val _ = closeOut out
-	    fun wc f =
-	       let
-		  val ins = openIn f
-		  fun loop (i: int): int =
-		     case input1 ins of
-			NONE => i
-		      | SOME c => loop (if c = #"\n" then i + 1 else i)
-		  val n = loop 0
-		  val _ = if n <> 100000 then raise Fail "bug" else ()
-		  val _ = closeIn ins
-	       in n
-	       end
-	    val rec loop =
-	       fn 0 => ()
-		| n => (wc f; loop (n - 1))
-	    val _ = loop n
-	    val _ = OS.FileSys.remove f
-	 in ()
-	 end
+         let
+            open TextIO
+            val f = OS.FileSys.tmpName ()
+            val out = openOut f
+            val _ =
+               output (out,
+                       String.implode
+                       (List.tabulate (1000000, fn i =>
+                                       if i mod 10 = 0 then #"\n" else #"a")))
+            val _ = closeOut out
+            fun wc f =
+               let
+                  val ins = openIn f
+                  fun loop (i: int): int =
+                     case input1 ins of
+                        NONE => i
+                      | SOME c => loop (if c = #"\n" then i + 1 else i)
+                  val n = loop 0
+                  val _ = if n <> 100000 then raise Fail "bug" else ()
+                  val _ = closeIn ins
+               in n
+               end
+            val rec loop =
+               fn 0 => ()
+                | n => (wc f; loop (n - 1))
+            val _ = loop n
+            val _ = OS.FileSys.remove f
+         in ()
+         end
    end

Modified: mlton/branches/on-20050420-cmm-branch/benchmark/tests/wc-scanStream.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/benchmark/tests/wc-scanStream.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/benchmark/tests/wc-scanStream.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -3,40 +3,40 @@
 structure Main =
    struct
       fun doit n =
-	 let
-	    open TextIO
-	    val f = OS.FileSys.tmpName ()
-	    val out = openOut f
-	    val _ =
-	       output (out,
-		       String.implode
-		       (List.tabulate (1000000, fn i =>
-				       if i mod 10 = 0 then #"\n" else #"a")))
-	    val _ = closeOut out
-	    fun wc f =
-	       let
-		  val ins = openIn f
-	       in TextIO.scanStream
-		  (fn reader => fn s =>
-		   let
-		      fun loop (s, ns) =
-			 case reader s of
-			    NONE => (closeIn ins
-				     ; if ns <> 100000
-					  then raise Fail "bug"
-				       else ()
-				     ; NONE)
-			  | SOME (c, s') =>
-			       loop (s', if c = #"\n" then ns + 1 else ns)
-		   in loop (s, 0)
-		   end)
-		  ins
-	       end
-	    val rec loop =
-	       fn 0 => ()
-		| n => (wc f; loop (n - 1))
-	    val _ = loop n
-	    val _ = OS.FileSys.remove f
-	 in ()
-	 end
+         let
+            open TextIO
+            val f = OS.FileSys.tmpName ()
+            val out = openOut f
+            val _ =
+               output (out,
+                       String.implode
+                       (List.tabulate (1000000, fn i =>
+                                       if i mod 10 = 0 then #"\n" else #"a")))
+            val _ = closeOut out
+            fun wc f =
+               let
+                  val ins = openIn f
+               in TextIO.scanStream
+                  (fn reader => fn s =>
+                   let
+                      fun loop (s, ns) =
+                         case reader s of
+                            NONE => (closeIn ins
+                                     ; if ns <> 100000
+                                          then raise Fail "bug"
+                                       else ()
+                                     ; NONE)
+                          | SOME (c, s') =>
+                               loop (s', if c = #"\n" then ns + 1 else ns)
+                   in loop (s, 0)
+                   end)
+                  ins
+               end
+            val rec loop =
+               fn 0 => ()
+                | n => (wc f; loop (n - 1))
+            val _ = loop n
+            val _ = OS.FileSys.remove f
+         in ()
+         end
    end

Modified: mlton/branches/on-20050420-cmm-branch/benchmark/tests/zebra.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/benchmark/tests/zebra.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/benchmark/tests/zebra.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -120,8 +120,8 @@
 val middle = SOME 3
 
 type 'a attribute = {poss: pos list,
-		     unknown: 'a list,
-		     known: (pos * 'a) list}
+                     unknown: 'a list,
+                     known: (pos * 'a) list}
 
 exception Done
 fun 'a fluidLet (r: 'a ref, x: 'a, f: unit -> 'b): 'b =
@@ -129,13 +129,13 @@
    in r := x
       ; (f () before r := old)
       handle Done => raise Done
-	   | e => (r := old; raise e)
+           | e => (r := old; raise e)
    end
 
 fun search () =
    let
       fun init (unknown: 'a list): 'a attribute ref =
-	 ref {poss = poss, unknown = unknown, known = []}
+         ref {poss = poss, unknown = unknown, known = []}
       val cigarettes = init [Blend, BlueMaster, Dunhill, PallMall, Prince]
       val colors = init [Blue, Green, Red, White, Yellow]
       val drinks = init [Beer, Coffee, Milk, Tea, Water]
@@ -143,7 +143,7 @@
       val pets = init [Bird, Cat, Dog, Horse, Zebra]
 
       fun ''a find (r: ''a attribute ref) (x: ''a): pos option =
-	 Option.map #1 (peek (#known (!r), fn (_, y) => x = y))
+         Option.map #1 (peek (#known (!r), fn (_, y) => x = y))
       val smoke = find cigarettes
       val color = find colors
       val drink = find drinks
@@ -151,83 +151,83 @@
       val pet = find pets
 
       fun display () =
-	 let
-	    fun loop (r: 'a attribute ref, toString) =
-	       (List.app (fn i =>
-			  let
-			     val x = #2 (valOf (peek (#known (!r),
-						   fn (j, _) => i = j)))
-			     val s = toString x
-			  in print s
-			     ; print (CharVector.tabulate (12 - size s,
-							 fn _ => #" "))
-			  end) poss 
-		; print "\n")
-	 in
-	    loop (cigarettes, cigaretteToString)
-	    ; loop (colors, colorToString)
-	    ; loop (drinks, drinkToString)
-	    ; loop (nationalities, nationalityToString)
-	    ; loop (pets, petToString)
-	 end
+         let
+            fun loop (r: 'a attribute ref, toString) =
+               (List.app (fn i =>
+                          let
+                             val x = #2 (valOf (peek (#known (!r),
+                                                   fn (j, _) => i = j)))
+                             val s = toString x
+                          in print s
+                             ; print (CharVector.tabulate (12 - size s,
+                                                         fn _ => #" "))
+                          end) poss 
+                ; print "\n")
+         in
+            loop (cigarettes, cigaretteToString)
+            ; loop (colors, colorToString)
+            ; loop (drinks, drinkToString)
+            ; loop (nationalities, nationalityToString)
+            ; loop (pets, petToString)
+         end
    
       fun make f =
-	 fn (SOME x, SOME y) => f (x, y)
-	  | _ => true
+         fn (SOME x, SOME y) => f (x, y)
+          | _ => true
       val same = make (op =)
       val adjacent = make (fn (x, y) => x = y - 1 orelse y = x - 1)
       val left = make (fn (x, y) => x = y - 1)
 
       val num = ref 0
       fun isConsistent (): bool =
-	 (num := !num + 1
-	  ;
-	 same (nat English, color Red)
-	 andalso same (nat Swede, pet Dog)
-	 andalso same (nat Dane, drink Tea)
-	 andalso left (color Green, color White)
-	 andalso same (color Green, drink Coffee)
-	 andalso same (smoke PallMall, pet Bird)
-	 andalso same (color Yellow, smoke Dunhill)
-	 andalso same (middle, drink Milk)
-	 andalso same (nat Norwegian, first)
-	 andalso adjacent (smoke Blend, pet Cat)
-	 andalso adjacent (pet Horse, smoke Dunhill)
-	 andalso same (drink Beer, smoke BlueMaster)
-	 andalso same (nat German, smoke Prince)
-	 andalso adjacent (nat Norwegian, color Blue)
-	 andalso adjacent (drink Water, smoke Blend)
-	  )
-	 
+         (num := !num + 1
+          ;
+         same (nat English, color Red)
+         andalso same (nat Swede, pet Dog)
+         andalso same (nat Dane, drink Tea)
+         andalso left (color Green, color White)
+         andalso same (color Green, drink Coffee)
+         andalso same (smoke PallMall, pet Bird)
+         andalso same (color Yellow, smoke Dunhill)
+         andalso same (middle, drink Milk)
+         andalso same (nat Norwegian, first)
+         andalso adjacent (smoke Blend, pet Cat)
+         andalso adjacent (pet Horse, smoke Dunhill)
+         andalso same (drink Beer, smoke BlueMaster)
+         andalso same (nat German, smoke Prince)
+         andalso adjacent (nat Norwegian, color Blue)
+         andalso adjacent (drink Water, smoke Blend)
+          )
+         
       fun tryEach (l, f) =
-	 let
-	    fun loop (l, ac) =
-	       case l of
-		  [] => ()
-		| x :: l => (f (x, l @ ac); loop (l, x :: ac))
-	 in loop (l, [])
-	 end
-	       
+         let
+            fun loop (l, ac) =
+               case l of
+                  [] => ()
+                | x :: l => (f (x, l @ ac); loop (l, x :: ac))
+         in loop (l, [])
+         end
+               
       fun try (r: 'a attribute ref,
-	      f: unit -> (('a attribute -> unit)
-			  * ( unit -> unit))) =
-	 let val {poss, unknown, known} = !r
-	 in case unknown of
-	    [] => ()
-	  | _ => 
-	       tryEach (unknown, fn (x, unknown) =>
-		       let val (each, done) = f ()
-		       in tryEach (poss, fn (p, poss) =>
-				  let val attr = {known = (p, x) :: known,
-						  unknown = unknown,
-						  poss = poss}
-				  in fluidLet
-				     (r, attr, fn () =>
-				      if isConsistent () then each attr else ())
-				  end)
-			  ; done ()
-		       end)
-	 end
+              f: unit -> (('a attribute -> unit)
+                          * ( unit -> unit))) =
+         let val {poss, unknown, known} = !r
+         in case unknown of
+            [] => ()
+          | _ => 
+               tryEach (unknown, fn (x, unknown) =>
+                       let val (each, done) = f ()
+                       in tryEach (poss, fn (p, poss) =>
+                                  let val attr = {known = (p, x) :: known,
+                                                  unknown = unknown,
+                                                  poss = poss}
+                                  in fluidLet
+                                     (r, attr, fn () =>
+                                      if isConsistent () then each attr else ())
+                                  end)
+                          ; done ()
+                       end)
+         end
 
       (* loop takes the current state and either
        *   - terminates in the same state if there is no consistent extension
@@ -236,50 +236,50 @@
       exception Inconsistent
       exception Continue of unit -> unit
       fun loop (): unit =
-	 let
-	    fun test r =
-	       try
-	       (r, fn () =>
-		let
-		   datatype 'a attrs = None | One of 'a | Many
-		   val attrs = ref None
-		   fun each a =
-		      case !attrs of
-			 None => attrs := One a
-		       | One _ => attrs := Many
-		       | Many => ()
-		   fun done () =
-		      case !attrs of
-			 None => raise Inconsistent
-		       | One a => raise (Continue (fn () => fluidLet (r, a, loop)))
-		       | Many => ()
-		in (each, done)
-		end)
-	    fun explore r =
-	       try (r, fn () =>
-		   let
-		      fun each _ = loop ()
-		      fun done () = raise Inconsistent
-		   in (each, done)
-		   end)
-	 in (test cigarettes
-	     ; test colors
-	     ; test drinks
-	     ; test nationalities
-	     ; test pets
-	     ; explore cigarettes
-	     ; explore colors
-	     ; explore drinks
-	     ; explore nationalities
-	     ; explore pets
-	     ; raise Done)
-	    handle Inconsistent => ()
-		 | Continue f => f ()
-	 end
-      val _ = 	 loop () handle Done => ()
+         let
+            fun test r =
+               try
+               (r, fn () =>
+                let
+                   datatype 'a attrs = None | One of 'a | Many
+                   val attrs = ref None
+                   fun each a =
+                      case !attrs of
+                         None => attrs := One a
+                       | One _ => attrs := Many
+                       | Many => ()
+                   fun done () =
+                      case !attrs of
+                         None => raise Inconsistent
+                       | One a => raise (Continue (fn () => fluidLet (r, a, loop)))
+                       | Many => ()
+                in (each, done)
+                end)
+            fun explore r =
+               try (r, fn () =>
+                   let
+                      fun each _ = loop ()
+                      fun done () = raise Inconsistent
+                   in (each, done)
+                   end)
+         in (test cigarettes
+             ; test colors
+             ; test drinks
+             ; test nationalities
+             ; test pets
+             ; explore cigarettes
+             ; explore colors
+             ; explore drinks
+             ; explore nationalities
+             ; explore pets
+             ; raise Done)
+            handle Inconsistent => ()
+                 | Continue f => f ()
+         end
+      val _ =    loop () handle Done => ()
       val _ = if 3342 = !num
-		 then ()
-	      else raise Fail "bug"
+                 then ()
+              else raise Fail "bug"
 (*      val _ = display () *)
    in ()
    end
@@ -287,12 +287,12 @@
 structure Main =
    struct
       fun doit n =
-	 let
-	    fun loop n =
-	       if n < 0
-		  then ()
-	       else (search ()
-		     ; loop (n - 1))
-	 in loop (n * 1000)
-	 end
+         let
+            fun loop n =
+               if n < 0
+                  then ()
+               else (search ()
+                     ; loop (n - 1))
+         in loop (n * 1000)
+         end
    end

Modified: mlton/branches/on-20050420-cmm-branch/benchmark/tests/zern.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/benchmark/tests/zern.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/benchmark/tests/zern.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -15,189 +15,189 @@
 
 structure FastRealArray2 :
     sig
-	type array
+        type array
 
-	type region
-	    = {base : array,
-	       row : int,
-	       col : int,
-	       nrows : int option,
-	       ncols : int option}
+        type region
+            = {base : array,
+               row : int,
+               col : int,
+               nrows : int option,
+               ncols : int option}
 
-	datatype traversal = RowMajor | ColMajor
+        datatype traversal = RowMajor | ColMajor
 
-	val array : int * int * real -> array
-	val fromList : real list list -> array
-	val tabulate : traversal -> (int * int * (int * int -> real)) -> array
-	val sub : array * int * int -> real
-	val update : array * int * int * real -> unit
-	val dimensions : array -> int * int
-	val size : array -> int
-	val nCols : array -> int
-	val nRows : array -> int
-	val row : array * int -> real Vector.vector
-	val column : array * int -> real Vector.vector
+        val array : int * int * real -> array
+        val fromList : real list list -> array
+        val tabulate : traversal -> (int * int * (int * int -> real)) -> array
+        val sub : array * int * int -> real
+        val update : array * int * int * real -> unit
+        val dimensions : array -> int * int
+        val size : array -> int
+        val nCols : array -> int
+        val nRows : array -> int
+        val row : array * int -> real Vector.vector
+        val column : array * int -> real Vector.vector
 
-	val copy : region * array * int * int -> unit
-	val appi : traversal -> (int * int * real -> unit) -> region -> unit
-	val app : traversal -> (real -> unit) -> array -> unit
-	val modifyi : traversal -> (int * int * real -> real) -> region -> unit
-	val modify : traversal -> (real -> real) -> array -> unit
-	val foldi : traversal -> (int*int*real*'a -> 'a) -> 'a -> region -> 'a
-	val fold : traversal -> (real * 'a -> 'a) -> 'a -> array -> 'a
+        val copy : region * array * int * int -> unit
+        val appi : traversal -> (int * int * real -> unit) -> region -> unit
+        val app : traversal -> (real -> unit) -> array -> unit
+        val modifyi : traversal -> (int * int * real -> real) -> region -> unit
+        val modify : traversal -> (real -> real) -> array -> unit
+        val foldi : traversal -> (int*int*real*'a -> 'a) -> 'a -> region -> 'a
+        val fold : traversal -> (real * 'a -> 'a) -> 'a -> array -> 'a
 
-	val rmSub : array * int -> real
-	val rmUpdate : array * int * real -> unit
+        val rmSub : array * int -> real
+        val rmUpdate : array * int * real -> unit
 
-	val unop : array * array * (real -> real) -> unit
-	val unopi : array * array * (real * int -> real) -> unit
-	val binop : array * array * array * (real * real -> real) -> unit
-	val binopi : array * array * array * (real * real * int -> real) -> unit
-	val fill : array * real -> unit
-	val fillf : array * (int -> real) -> unit
-	    
-	val transpose : array -> array
-	val extract : region -> array
+        val unop : array * array * (real -> real) -> unit
+        val unopi : array * array * (real * int -> real) -> unit
+        val binop : array * array * array * (real * real -> real) -> unit
+        val binopi : array * array * array * (real * real * int -> real) -> unit
+        val fill : array * real -> unit
+        val fillf : array * (int -> real) -> unit
+            
+        val transpose : array -> array
+        val extract : region -> array
 
         (*
-	val shift : array * int * int -> array
-	*)
+        val shift : array * int * int -> array
+        *)
     end =
   struct
 
     structure A      = (*Unsafe.*)Real64Array
 
     type rawArray    = A.array
-	
+        
     val unsafeUpdate = A.update
     val unsafeSub    = A.sub
     fun mkRawArray n = A.array (n, 0.0)
 
-	
+        
     type array = {data  : rawArray,
-		  nrows : int,
-		  ncols : int,
-		  nelts : int}
-	
+                  nrows : int,
+                  ncols : int,
+                  nelts : int}
+        
     type region = {base  : array,
-		   row   : int,
-		   col   : int,
-		   nrows : int option,
-		   ncols : int option}
+                   row   : int,
+                   col   : int,
+                   nrows : int option,
+                   ncols : int option}
 
     datatype traversal = RowMajor | ColMajor
 
-	
+        
     fun dotimes n f =
-	let (* going forward is twice as fast as backward! *)
-	    fun iter k = if k >= n then ()
-			 else (f(k); iter(k+1))
-	in
-	    iter 0
-	end
+        let (* going forward is twice as fast as backward! *)
+            fun iter k = if k >= n then ()
+                         else (f(k); iter(k+1))
+        in
+            iter 0
+        end
 
     
     fun mkArray(n,v) =
-	let
-	    val arr = mkRawArray n
-	in
-	    dotimes n (fn ix => unsafeUpdate(arr,ix,v));
-	    arr
-	end
+        let
+            val arr = mkRawArray n
+        in
+            dotimes n (fn ix => unsafeUpdate(arr,ix,v));
+            arr
+        end
 
   (* compute the index of an array element *)
     fun ltu(i,limit) = (i >= 0) andalso (i < limit)
     fun unsafeIndex ({nrows, ncols, ...} : array, i, j) = (i*ncols + j)
     fun index (arr, i, j) =
-	  if (ltu(i, #nrows arr) andalso ltu(j, #ncols arr))
-	    then unsafeIndex (arr, i, j)
-	    else raise General.Subscript
+          if (ltu(i, #nrows arr) andalso ltu(j, #ncols arr))
+            then unsafeIndex (arr, i, j)
+            else raise General.Subscript
     (* row major index checking *)
     fun rmIndex ({nelts,...}: array, ix) =
-	if ltu(ix, nelts) then ix
-	else raise General.Subscript
+        if ltu(ix, nelts) then ix
+        else raise General.Subscript
 
     val max_length = 4096 * 4096; (* arbitrary - but this is 128 MB *)
-	
+        
     fun chkSize (nrows, ncols) =
-	  if (nrows <= 0) orelse (ncols <= 0)
-	    then raise General.Size
-	    else let
-	      val n = nrows*ncols handle Overflow => raise General.Size
-	      in
-		if (max_length < n) then raise General.Size else n
-	      end
+          if (nrows <= 0) orelse (ncols <= 0)
+            then raise General.Size
+            else let
+              val n = nrows*ncols handle Overflow => raise General.Size
+              in
+                if (max_length < n) then raise General.Size else n
+              end
 
     fun array (nrows, ncols, v) =
-	let
-	    val nelts = chkSize (nrows, ncols)
-	in
-	    {data = mkArray (nelts, v),
-	     nrows = nrows, ncols = ncols, nelts = nelts}
-	end
+        let
+            val nelts = chkSize (nrows, ncols)
+        in
+            {data = mkArray (nelts, v),
+             nrows = nrows, ncols = ncols, nelts = nelts}
+        end
 
     fun fromList [] = raise General.Size
       | fromList (row1 :: rest) = let
-	  val ncols = List.length row1
-	  fun chk ([], nrows, l) = (nrows, l)
-	    | chk (row::rest, nrows, l) = let
-		fun chkRow ([], n, revCol) = (
-		      if (n <> ncols) then raise General.Size else ();
-		      List.revAppend (revCol, l))
-		  | chkRow (x::r, n, revCol) = chkRow (r, n+1, x::revCol)
-		in
-		  chk (rest, nrows+1, chkRow(row, 0, []))
-		end
-	  val (nrows, flatList) = chk (rest, 1, [])
-	  val nelts = chkSize(nrows, ncols)
-	  val arr = mkRawArray nelts
-	  fun upd(_,nil) = arr
-	    | upd(k,v::vs) = (unsafeUpdate(arr,k,v); upd(k+1,vs))
-	  in
-	    { data = upd(0,List.@(row1, flatList)),
-	      nrows = nrows,
-	      ncols = ncols,
-	      nelts = nelts }
-	  end
+          val ncols = List.length row1
+          fun chk ([], nrows, l) = (nrows, l)
+            | chk (row::rest, nrows, l) = let
+                fun chkRow ([], n, revCol) = (
+                      if (n <> ncols) then raise General.Size else ();
+                      List.revAppend (revCol, l))
+                  | chkRow (x::r, n, revCol) = chkRow (r, n+1, x::revCol)
+                in
+                  chk (rest, nrows+1, chkRow(row, 0, []))
+                end
+          val (nrows, flatList) = chk (rest, 1, [])
+          val nelts = chkSize(nrows, ncols)
+          val arr = mkRawArray nelts
+          fun upd(_,nil) = arr
+            | upd(k,v::vs) = (unsafeUpdate(arr,k,v); upd(k+1,vs))
+          in
+            { data = upd(0,List.@(row1, flatList)),
+              nrows = nrows,
+              ncols = ncols,
+              nelts = nelts }
+          end
       
     fun tabulateRM (nrows, ncols, f) =
-	let
-	    val nelts = chkSize(nrows, ncols)
-	    val arr = mkRawArray nelts
-	    fun lp1 (i, j, k) = if (i < nrows)
-				    then lp2 (i, 0, k)
-				else ()
-	    and lp2 (i, j, k) = if (j < ncols)
-				    then (
-					  unsafeUpdate(arr, k, f(i, j));
-					  lp2 (i, j+1, k+1))
-				else lp1 (i+1, 0, k)
-	in
-	    lp2 (0, 0, 0);
-	    {data = arr, nrows = nrows, ncols = ncols, nelts = nelts}
-	end
+        let
+            val nelts = chkSize(nrows, ncols)
+            val arr = mkRawArray nelts
+            fun lp1 (i, j, k) = if (i < nrows)
+                                    then lp2 (i, 0, k)
+                                else ()
+            and lp2 (i, j, k) = if (j < ncols)
+                                    then (
+                                          unsafeUpdate(arr, k, f(i, j));
+                                          lp2 (i, j+1, k+1))
+                                else lp1 (i+1, 0, k)
+        in
+            lp2 (0, 0, 0);
+            {data = arr, nrows = nrows, ncols = ncols, nelts = nelts}
+        end
 
     fun tabulateCM (nrows, ncols, f) =
-	let
-	    val nelts   = chkSize(nrows,ncols)
-	    val arr = mkRawArray nelts
-	    val delta = nelts - 1
-	    fun lp1 (i, j, k) = if (j < ncols)
-				    then lp2 (0, j, k)
-				else ()
-	    and lp2 (i, j, k) = if (i < nrows)
-				    then (
-					  unsafeUpdate(arr, k, f(i, j));
-					  lp2 (i+1, j, k+ncols))
-				else lp1 (0, j+1, k-delta)
-	in
-	    lp2 (0, 0, 0);
-	    {data = arr, nrows = nrows, ncols = ncols, nelts = nelts}
-	end
+        let
+            val nelts   = chkSize(nrows,ncols)
+            val arr = mkRawArray nelts
+            val delta = nelts - 1
+            fun lp1 (i, j, k) = if (j < ncols)
+                                    then lp2 (0, j, k)
+                                else ()
+            and lp2 (i, j, k) = if (i < nrows)
+                                    then (
+                                          unsafeUpdate(arr, k, f(i, j));
+                                          lp2 (i+1, j, k+ncols))
+                                else lp1 (0, j+1, k-delta)
+        in
+            lp2 (0, 0, 0);
+            {data = arr, nrows = nrows, ncols = ncols, nelts = nelts}
+        end
 
     fun tabulate RowMajor = tabulateRM
       | tabulate ColMajor = tabulateCM
-	
+        
     fun sub (a, i, j) = unsafeSub(#data a, index(a, i, j))
     fun update (a, i, j, v) = unsafeUpdate(#data a, index(a, i, j), v)
     fun dimensions ({nrows, ncols, ...}: array) = (nrows, ncols)
@@ -205,306 +205,306 @@
     fun nCols (arr : array) = #ncols arr
     fun nRows (arr : array) = #nrows arr
     fun row ({data, nrows, ncols, ...}: array, i) =
-	if ltu(i, nrows) then
-	    let
-		val stop = i*ncols
-		fun mkVec (j, l) =
-		    if (j < stop)
-			then Vector.fromList l
-		    else mkVec(j-1, unsafeSub(data, j)::l)
-	    in
-		if ltu(nrows, i)
-		    then raise General.Subscript
-		else mkVec (stop+ncols-1, [])
-	    end
-	else raise General.Subscript
+        if ltu(i, nrows) then
+            let
+                val stop = i*ncols
+                fun mkVec (j, l) =
+                    if (j < stop)
+                        then Vector.fromList l
+                    else mkVec(j-1, unsafeSub(data, j)::l)
+            in
+                if ltu(nrows, i)
+                    then raise General.Subscript
+                else mkVec (stop+ncols-1, [])
+            end
+        else raise General.Subscript
     fun column ({data, ncols, nelts, ...}: array, j) =
-	if ltu(j, ncols) then
-	    let
-		fun mkVec (i, l) =
-		    if (i < 0)
-			then Vector.fromList l
-		    else mkVec(i-ncols, unsafeSub(data, i)::l)
-	    in
-		if ltu(ncols, j)
-		    then raise General.Subscript
-		else mkVec ((nelts - ncols) + j, [])
-	    end
-	else raise General.Subscript
-	    
+        if ltu(j, ncols) then
+            let
+                fun mkVec (i, l) =
+                    if (i < 0)
+                        then Vector.fromList l
+                    else mkVec(i-ncols, unsafeSub(data, i)::l)
+            in
+                if ltu(ncols, j)
+                    then raise General.Subscript
+                else mkVec ((nelts - ncols) + j, [])
+            end
+        else raise General.Subscript
+            
     datatype index = DONE | INDX of {i:int, r:int, c:int}
 
     fun chkRegion {base={data, nrows, ncols, ...}: array,
-		   row, col, nrows=nr, ncols=nc}
-	= let
-	  fun chk (start, n, NONE) =
-		if ((start < 0) orelse (n < start))
-		  then raise General.Subscript
-		  else n-start
-	    | chk (start, n, SOME len) =
-		if ((start < 0) orelse (len < 0) orelse (n < start+len))
-		  then raise General.Subscript
-		  else len
-	  val nr = chk (row, nrows, nr)
-	  val nc = chk (col, ncols, nc)
-	  in
-	    {data = data, i = (row*ncols + col), r=row, c=col, nr=nr, nc=nc}
-	  end
+                   row, col, nrows=nr, ncols=nc}
+        = let
+          fun chk (start, n, NONE) =
+                if ((start < 0) orelse (n < start))
+                  then raise General.Subscript
+                  else n-start
+            | chk (start, n, SOME len) =
+                if ((start < 0) orelse (len < 0) orelse (n < start+len))
+                  then raise General.Subscript
+                  else len
+          val nr = chk (row, nrows, nr)
+          val nc = chk (col, ncols, nc)
+          in
+            {data = data, i = (row*ncols + col), r=row, c=col, nr=nr, nc=nc}
+          end
 
     fun copy (region, dst, dst_row, dst_col) =
-	  raise Fail "Array2.copy unimplemented"
+          raise Fail "Array2.copy unimplemented"
 
 
   (* this function generates a stream of indices for the given region in
    * row-major order.
    *)
     fun iterateRM arg = let
-	  val {data, i, r, c, nr, nc} = chkRegion arg
-	  val ii = ref i and ri = ref r and ci = ref c
-	  fun mkIndx (r, c) = let val i = !ii
-		in
-		  ii := i+1;
-		  INDX{i=i, c=c, r=r}
-		end
-	  fun iter () = let
-		val r = !ri and c = !ci
-		in
-		  if (c < nc)
-		    then (ci := c+1; mkIndx(r, c))
-		  else if (r+1 < nr)
-		    then (ci := 0; ri := r+1; iter())
-		    else DONE
-		end
-	  in
-	    (data, iter)
-	  end
+          val {data, i, r, c, nr, nc} = chkRegion arg
+          val ii = ref i and ri = ref r and ci = ref c
+          fun mkIndx (r, c) = let val i = !ii
+                in
+                  ii := i+1;
+                  INDX{i=i, c=c, r=r}
+                end
+          fun iter () = let
+                val r = !ri and c = !ci
+                in
+                  if (c < nc)
+                    then (ci := c+1; mkIndx(r, c))
+                  else if (r+1 < nr)
+                    then (ci := 0; ri := r+1; iter())
+                    else DONE
+                end
+          in
+            (data, iter)
+          end
 
   (* this function generates a stream of indices for the given region in
    * col-major order.
    *)
     fun iterateCM (arg as {base={ncols, ...}, ...}) = let
-	  val {data, i, r, c, nr, nc} = chkRegion arg
-	  val delta = nr * ncols - 1
-	  val ii = ref i and ri = ref r and ci = ref c
-	  fun mkIndx (r, c) = let val i = !ii
-		in
-		  ii := i+ncols;
-		  INDX{i=i, c=c, r=r}
-		end
-	  fun iter () = let
-		val r = !ri and c = !ci
-		in
-		  if (r < nr)
-		    then (ri := r+1; mkIndx(r, c))
-		  else if (c+1 < nc)
-		    then (ii := !ii-delta; ri := 0; ci := c+1; iter())
-		    else DONE
-		end
-	  in
-	    (data, iter)
-	  end
+          val {data, i, r, c, nr, nc} = chkRegion arg
+          val delta = nr * ncols - 1
+          val ii = ref i and ri = ref r and ci = ref c
+          fun mkIndx (r, c) = let val i = !ii
+                in
+                  ii := i+ncols;
+                  INDX{i=i, c=c, r=r}
+                end
+          fun iter () = let
+                val r = !ri and c = !ci
+                in
+                  if (r < nr)
+                    then (ri := r+1; mkIndx(r, c))
+                  else if (c+1 < nc)
+                    then (ii := !ii-delta; ri := 0; ci := c+1; iter())
+                    else DONE
+                end
+          in
+            (data, iter)
+          end
 
     fun appi order f region = let
-	  val (data, iter) = (case order
-		 of RowMajor => iterateRM region
-		  | ColMajor => iterateCM region
-		(* end case *))
-	  fun app () = (case iter()
-		 of DONE => ()
-		  | INDX{i, r, c} => (f(r, c, unsafeSub(data, i)); app())
-		(* end case *))
-	  in
-	    app ()
-	  end
+          val (data, iter) = (case order
+                 of RowMajor => iterateRM region
+                  | ColMajor => iterateCM region
+                (* end case *))
+          fun app () = (case iter()
+                 of DONE => ()
+                  | INDX{i, r, c} => (f(r, c, unsafeSub(data, i)); app())
+                (* end case *))
+          in
+            app ()
+          end
 
     fun appRM f ({data, nelts, ...}: array) =
-	let
-	    fun appf k =
-		if k < nelts then (f(unsafeSub(data,k));
-				   appf(k+1))
-		else ()
-	in
-	    appf 0
-	end
+        let
+            fun appf k =
+                if k < nelts then (f(unsafeSub(data,k));
+                                   appf(k+1))
+                else ()
+        in
+            appf 0
+        end
     
     fun appCM f {data, ncols, nrows, nelts} = let
-	  val delta = nelts - 1
-	  fun appf (i, k) = if (i < nrows)
-		then (f(unsafeSub(data, k)); appf(i+1, k+ncols))
-		else let
-		  val k = k-delta
-		  in
-		    if (k < ncols) then appf (0, k) else ()
-		  end
-	  in
-	    appf (0, 0)
-	  end
+          val delta = nelts - 1
+          fun appf (i, k) = if (i < nrows)
+                then (f(unsafeSub(data, k)); appf(i+1, k+ncols))
+                else let
+                  val k = k-delta
+                  in
+                    if (k < ncols) then appf (0, k) else ()
+                  end
+          in
+            appf (0, 0)
+          end
     fun app RowMajor = appRM
       | app ColMajor = appCM
 
     fun modifyi order f region = let
-	  val (data, iter) = (case order
-		 of RowMajor => iterateRM region
-		  | ColMajor => iterateCM region
-		(* end case *))
-	  fun modify () = (case iter()
-		 of DONE => ()
-		  | INDX{i, r, c} => (
-		      unsafeUpdate (data, i, f(r, c, unsafeSub(data, i)));
-		      modify())
-		(* end case *))
-	  in
-	    modify ()
-	  end
+          val (data, iter) = (case order
+                 of RowMajor => iterateRM region
+                  | ColMajor => iterateCM region
+                (* end case *))
+          fun modify () = (case iter()
+                 of DONE => ()
+                  | INDX{i, r, c} => (
+                      unsafeUpdate (data, i, f(r, c, unsafeSub(data, i)));
+                      modify())
+                (* end case *))
+          in
+            modify ()
+          end
 
     fun modifyRM f ({data, nelts, ...}: array) =
-	let
-	    fun modf k =
-		if k < nelts then (unsafeUpdate(data,k,f(unsafeSub(data,k)));
-			       modf (k+1))
-		    else ()
-	in
-	    modf 0
-	end
+        let
+            fun modf k =
+                if k < nelts then (unsafeUpdate(data,k,f(unsafeSub(data,k)));
+                               modf (k+1))
+                    else ()
+        in
+            modf 0
+        end
     
     fun modifyCM f {data, ncols, nrows, nelts} = let
-	  val delta = nelts - 1
-	  fun modf (i, k) = if (i < nrows)
-		then (unsafeUpdate(data, k, f(unsafeSub(data, k))); modf(i+1, k+ncols))
-		else let
-		  val k = k-delta
-		  in
-		    if (k < ncols) then modf (0, k) else ()
-		  end
-	  in
-	    modf (0, 0)
-	  end
+          val delta = nelts - 1
+          fun modf (i, k) = if (i < nrows)
+                then (unsafeUpdate(data, k, f(unsafeSub(data, k))); modf(i+1, k+ncols))
+                else let
+                  val k = k-delta
+                  in
+                    if (k < ncols) then modf (0, k) else ()
+                  end
+          in
+            modf (0, 0)
+          end
     fun modify RowMajor = modifyRM
       | modify ColMajor = modifyCM
 
     fun foldi order f init region = let
-	  val (data, iter) = (case order
-		 of RowMajor => iterateRM region
-		  | ColMajor => iterateCM region
-		(* end case *))
-	  fun fold accum = (case iter()
-		 of DONE => accum
-		  | INDX{i, r, c} => fold(f(r, c, unsafeSub(data, i), accum))
-		(* end case *))
-	  in
-	    fold init
-	  end
+          val (data, iter) = (case order
+                 of RowMajor => iterateRM region
+                  | ColMajor => iterateCM region
+                (* end case *))
+          fun fold accum = (case iter()
+                 of DONE => accum
+                  | INDX{i, r, c} => fold(f(r, c, unsafeSub(data, i), accum))
+                (* end case *))
+          in
+            fold init
+          end
 
     fun foldRM f init ({data, nelts, ...}: array) =
-	let
-	    fun foldf (k, accum) =
-		if k < nelts then foldf(k+1,f(unsafeSub(data,k),accum))
-		else accum
-	in
-	    foldf (0,init)
-	end
+        let
+            fun foldf (k, accum) =
+                if k < nelts then foldf(k+1,f(unsafeSub(data,k),accum))
+                else accum
+        in
+            foldf (0,init)
+        end
 
     fun foldCM f init {data, ncols, nrows, nelts} = let
-	  val delta = nelts - 1
-	  fun foldf (i, k, accum) = if (i < nrows)
-		then foldf (i+1, k+ncols, f(unsafeSub(data, k), accum))
-		else let
-		  val k = k-delta
-		  in
-		    if (k < ncols) then foldf (0, k, accum) else accum
-		  end
-	  in
-	    foldf (0, 0, init)
-	  end
+          val delta = nelts - 1
+          fun foldf (i, k, accum) = if (i < nrows)
+                then foldf (i+1, k+ncols, f(unsafeSub(data, k), accum))
+                else let
+                  val k = k-delta
+                  in
+                    if (k < ncols) then foldf (0, k, accum) else accum
+                  end
+          in
+            foldf (0, 0, init)
+          end
     fun fold RowMajor = foldRM
       | fold ColMajor = foldCM
 
 
     fun transpose {data, nrows, ncols, nelts} =
-	let
-	    val dst = mkRawArray nelts
-	    val delta = nelts - 1
-	    fun iter (k,k') =
-		if k >= nelts then {data = dst,
-				    nrows = ncols,
-				    ncols = nrows,
-				    nelts = nelts}
-		else (if k' >= nelts then iter(k,k' - delta)
-		      else (unsafeUpdate(dst,k',unsafeSub(data,k));
-			    iter(k+1,k'+nrows)))
-	in
-	    iter(0,0)
-	end
+        let
+            val dst = mkRawArray nelts
+            val delta = nelts - 1
+            fun iter (k,k') =
+                if k >= nelts then {data = dst,
+                                    nrows = ncols,
+                                    ncols = nrows,
+                                    nelts = nelts}
+                else (if k' >= nelts then iter(k,k' - delta)
+                      else (unsafeUpdate(dst,k',unsafeSub(data,k));
+                            iter(k+1,k'+nrows)))
+        in
+            iter(0,0)
+        end
 
     fun extract (region as {base,row,col,nrows,ncols}) =
-	let
-	    fun chk (start,limit,NONE) =
-		if ltu(start,limit) then limit - start
-		else raise General.Subscript
+        let
+            fun chk (start,limit,NONE) =
+                if ltu(start,limit) then limit - start
+                else raise General.Subscript
 
-	      | chk (start, limit, SOME len) =
-		if ltu(start + len - 1, limit) then len
-		else raise General.Subscript
+              | chk (start, limit, SOME len) =
+                if ltu(start + len - 1, limit) then len
+                else raise General.Subscript
 
-	    val nr = chk(row, nRows(base), nrows)
-	    val nc = chk(col, nCols(base), ncols)
-	    val n = nr * nc
-	    val dst = mkRawArray n
-	    val (data, iter) = iterateRM region
-	    fun app (k) = (case iter() of
-			      DONE => {data  = dst,
-				       nrows = nr,
-				       ncols = nc,
-				       nelts = n}
-			    | INDX{i,...} =>
-				  (unsafeUpdate(dst,k,unsafeSub(data,i));
-				   app(k+1)))
-	in
-	    app (0)
-	end
+            val nr = chk(row, nRows(base), nrows)
+            val nc = chk(col, nCols(base), ncols)
+            val n = nr * nc
+            val dst = mkRawArray n
+            val (data, iter) = iterateRM region
+            fun app (k) = (case iter() of
+                              DONE => {data  = dst,
+                                       nrows = nr,
+                                       ncols = nc,
+                                       nelts = n}
+                            | INDX{i,...} =>
+                                  (unsafeUpdate(dst,k,unsafeSub(data,i));
+                                   app(k+1)))
+        in
+            app (0)
+        end
 
     fun rmSub (arr as {data,...}: array,ix) =
-	unsafeSub(data,rmIndex(arr, ix))
+        unsafeSub(data,rmIndex(arr, ix))
 
     fun rmUpdate(arr as {data,...}: array,ix,v) =
-	unsafeUpdate(data,rmIndex(arr, ix),v)
+        unsafeUpdate(data,rmIndex(arr, ix),v)
 
     fun binop ({data=dst,nelts=nelts,...}: array,
-	       {data=src1,...}: array,
-	       {data=src2,...}: array,
-	       f) =
-	dotimes nelts
-	(fn (ix) => unsafeUpdate(dst,ix,f(unsafeSub(src1,ix),
-					  unsafeSub(src2,ix))))
+               {data=src1,...}: array,
+               {data=src2,...}: array,
+               f) =
+        dotimes nelts
+        (fn (ix) => unsafeUpdate(dst,ix,f(unsafeSub(src1,ix),
+                                          unsafeSub(src2,ix))))
 
     fun unop ({data=dst,nelts=nelts,...}: array,
-	      {data=src,...}: array,
-	       f) =
-	dotimes nelts
-	(fn (ix) => unsafeUpdate(dst,ix,f(unsafeSub(src,ix))))
+              {data=src,...}: array,
+               f) =
+        dotimes nelts
+        (fn (ix) => unsafeUpdate(dst,ix,f(unsafeSub(src,ix))))
 
     fun binopi ({data=dst,nelts=nelts,...}: array,
-		{data=src1,...}: array,
-		{data=src2,...}: array,
-		f) =
-	dotimes nelts
-	(fn ix => unsafeUpdate(dst,ix,f(unsafeSub(src1,ix),
-					unsafeSub(src2,ix),
-					ix)))
+                {data=src1,...}: array,
+                {data=src2,...}: array,
+                f) =
+        dotimes nelts
+        (fn ix => unsafeUpdate(dst,ix,f(unsafeSub(src1,ix),
+                                        unsafeSub(src2,ix),
+                                        ix)))
 
     fun unopi ({data=dst,nelts=nelts,...}: array,
-	       {data=src,...}: array,
-	       f) =
-	dotimes nelts
-	(fn ix => unsafeUpdate(dst,ix,f(unsafeSub(src,ix),ix)))
-	
+               {data=src,...}: array,
+               f) =
+        dotimes nelts
+        (fn ix => unsafeUpdate(dst,ix,f(unsafeSub(src,ix),ix)))
+        
     fun fill ({data=dst,nelts=nelts,...}: array,v) =
-	dotimes nelts
-	(fn ix => unsafeUpdate(dst,ix,v))
-	 
+        dotimes nelts
+        (fn ix => unsafeUpdate(dst,ix,v))
+         
     fun fillf ({data=dst,nelts=nelts,...}: array,f) =
-	dotimes nelts
-	(fn ix => unsafeUpdate(dst,ix,f(ix)))
+        dotimes nelts
+        (fn ix => unsafeUpdate(dst,ix,f(ix)))
 
   end
 
@@ -512,90 +512,90 @@
 (* This is 1.9 times faster than IDL!!!! *)
 structure MSpeed =
     struct
-	structure F = FastRealArray2
-	    
-	val sin = Math.sin
-	val cos = Math.cos
-	    
-	val fromInt = LargeReal.fromInt
+        structure F = FastRealArray2
+            
+        val sin = Math.sin
+        val cos = Math.cos
+            
+        val fromInt = LargeReal.fromInt
 
-	(* setup working vectors and arrays *)
-	fun collect n f =
-	    let
-		fun g 0 l = l
-		  | g n l = g (n-1) ((f n) :: l)
-	    in
-		g n nil
-	    end
+        (* setup working vectors and arrays *)
+        fun collect n f =
+            let
+                fun g 0 l = l
+                  | g n l = g (n-1) ((f n) :: l)
+            in
+                g n nil
+            end
 
-	val ncoefs = 15
-	val nx     = 128
-	val ny     = nx
-	val nel    = nx * ny
+        val ncoefs = 15
+        val nx     = 128
+        val ny     = nx
+        val nel    = nx * ny
 
-	(* generate an array from a scaled vector *)
-	fun mulsv (dst, sf, a) =
-	    F.unop(dst,a,fn(vsrc) => sf * vsrc)
+        (* generate an array from a scaled vector *)
+        fun mulsv (dst, sf, a) =
+            F.unop(dst,a,fn(vsrc) => sf * vsrc)
 
-	    
-	(* compute the complex exponential of an array *)
-	fun cisv (a, rpart, ipart) =
-	    (F.unop(rpart,a,cos);
-	     F.unop(ipart,a,sin);
-	     (rpart,ipart))
+            
+        (* compute the complex exponential of an array *)
+        fun cisv (a, rpart, ipart) =
+            (F.unop(rpart,a,cos);
+             F.unop(ipart,a,sin);
+             (rpart,ipart))
 
-	(* accumulate scaled vectors into an array *)
-	fun mpadd dst (sf, src) =
-	    F.binop(dst,dst,src,fn(vdst,vsrc) => vdst + sf * vsrc)
+        (* accumulate scaled vectors into an array *)
+        fun mpadd dst (sf, src) =
+            F.binop(dst,dst,src,fn(vdst,vsrc) => vdst + sf * vsrc)
 
-	    
-	(* compute an E-field from a set of Zernike screens *)
-	fun zern (dst, rpart, ipart, coefs, zerns) =
-	    (mulsv (dst, hd coefs, hd zerns);
-	     ListPair.app (mpadd dst) (tl coefs, tl zerns);
-	     cisv (dst, rpart, ipart))
-	    
-	(* timing tests and reporting *)
-	fun report_times(niter, nel, (start, stop)) =
-	    let
-		val secs = Time.-(stop,start)
-		val dur  = Time.toReal(secs) * 1.0E6
-		val ops_per_us = ((fromInt niter) * (fromInt nel)) / dur
-		val ns_per_op = 1000.0 / ops_per_us
-	    in
-		print(Time.toString (Time.-(stop,start)));
-		print("\n");
-		{ ops_per_us = ops_per_us, ns_per_op = ns_per_op}
-	    end
+            
+        (* compute an E-field from a set of Zernike screens *)
+        fun zern (dst, rpart, ipart, coefs, zerns) =
+            (mulsv (dst, hd coefs, hd zerns);
+             ListPair.app (mpadd dst) (tl coefs, tl zerns);
+             cisv (dst, rpart, ipart))
+            
+        (* timing tests and reporting *)
+        fun report_times(niter, nel, (start, stop)) =
+            let
+                val secs = Time.-(stop,start)
+                val dur  = Time.toReal(secs) * 1.0E6
+                val ops_per_us = ((fromInt niter) * (fromInt nel)) / dur
+                val ns_per_op = 1000.0 / ops_per_us
+            in
+                print(Time.toString (Time.-(stop,start)));
+                print("\n");
+                { ops_per_us = ops_per_us, ns_per_op = ns_per_op}
+            end
 
-	fun time_iterations f niter =
-	    let
-		fun iter 0 = Time.now()
-		  | iter n = (ignore (f()); iter (n-1))
-	    in
-		(Time.now(), iter niter)
-	    end
+        fun time_iterations f niter =
+            let
+                fun iter 0 = Time.now()
+                  | iter n = (ignore (f()); iter (n-1))
+            in
+                (Time.now(), iter niter)
+            end
 
-	fun ztest niter =
-	    report_times(niter, nel,
-			 time_iterations
-			 (fn () =>
-			  let val sum   = F.array(ny,nx, 0.0)
-			     val rpart = F.array(ny,nx, 0.0)
-			     val ipart = F.array(ny,nx, 0.0)	    	    
-			     val coefs = collect ncoefs (fn(x) => real(1 + x))
-			     val zerns =
-				collect ncoefs
-				(fn(x) => F.tabulate F.RowMajor
-				 (ny, nx, fn(r,c) => 0.01 * real(nx * r + c)))
-			     val (rpart, _) =
-				zern (sum, rpart, ipart, coefs, zerns)
-			  in if Real.abs(FastRealArray2.sub(rpart, 0, 1) - 0.219)
-				 < 0.001
-				then ()
-			     else raise Fail "compiler bug"
-			  end)
-			 niter)
+        fun ztest niter =
+            report_times(niter, nel,
+                         time_iterations
+                         (fn () =>
+                          let val sum   = F.array(ny,nx, 0.0)
+                             val rpart = F.array(ny,nx, 0.0)
+                             val ipart = F.array(ny,nx, 0.0)                
+                             val coefs = collect ncoefs (fn(x) => real(1 + x))
+                             val zerns =
+                                collect ncoefs
+                                (fn(x) => F.tabulate F.RowMajor
+                                 (ny, nx, fn(r,c) => 0.01 * real(nx * r + c)))
+                             val (rpart, _) =
+                                zern (sum, rpart, ipart, coefs, zerns)
+                          in if Real.abs(FastRealArray2.sub(rpart, 0, 1) - 0.219)
+                                 < 0.001
+                                then ()
+                             else raise Fail "compiler bug"
+                          end)
+                         niter)
 end
 
 structure Main =

Modified: mlton/branches/on-20050420-cmm-branch/bin/Makefile
===================================================================
--- mlton/branches/on-20050420-cmm-branch/bin/Makefile	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/bin/Makefile	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,11 @@
+## Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ #    Jagannathan, and Stephen Weeks.
+ # Copyright (C) 1997-2000 NEC Research Institute.
+ #
+ # MLton is released under a BSD-style license.
+ # See the file MLton-LICENSE for details.
+ ##
+
 all:
 
 .PHONY: clean

Modified: mlton/branches/on-20050420-cmm-branch/bin/add-cross
===================================================================
--- mlton/branches/on-20050420-cmm-branch/bin/add-cross	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/bin/add-cross	2006-02-16 19:34:54 UTC (rev 4361)
@@ -34,24 +34,24 @@
 # cross-compiler target will be installed.
 
 die () {
-	echo >&2 "$1"
-	exit 1
+        echo >&2 "$1"
+        exit 1
 }
 
 usage () {
-	die "usage: $name <crossTarget> <crossArch> <crossOS> <machine>"
+        die "usage: $name <crossTarget> <crossArch> <crossOS> <machine>"
 }
 
 case "$#" in
 4)
-	crossTarget="$1"
-	crossArch="$2"
-	crossOS="$3"
-	machine="$4"
-	;;
+        crossTarget="$1"
+        crossArch="$2"
+        crossOS="$3"
+        machine="$4"
+        ;;
 *)
-	usage
-	;;
+        usage
+        ;;
 esac
 
 name=`basename $0`
@@ -81,20 +81,38 @@
 
 echo 'Making runtime.' 
 ( cd $src && tar cf - bin runtime ) | 
-	ssh $machine "cd $tmp && tar xf - && cd runtime &&
-		../bin/mmake COMPILE_FAST=yes TARGET_ARCH=$crossArch TARGET_OS=$crossOS clean all"
+        ssh $machine "cd $tmp && tar xf - && cd runtime &&
+                ../bin/mmake COMPILE_FAST=yes TARGET_ARCH=$crossArch TARGET_OS=$crossOS clean all"
 ssh $machine "cd $tmp/runtime && tar cf - *.a" | 
-	( cd $lib/$crossTarget && tar xf - )
+        ( cd $lib/$crossTarget && tar xf - )
 ( cd $src &&
-	mmake TARGET=$crossTarget TARGET_ARCH=$crossArch TARGET_OS=$crossOS \
-		mlbpathmap targetmap )
+        mmake TARGET=$crossTarget TARGET_ARCH=$crossArch TARGET_OS=$crossOS \
+                mlbpathmap targetmap )
 
+case "$crossOS" in
+mingw)
+	suf='.exe'
+;;
+*)
+	suf=''
+;;
+esac
+
+case "$crossOS" in
+mingw)
+	libs='-lws2_32 -lkernel32 -lpsapi -lnetapi32'
+;;
+solaris)
+        libs='-lrt -lnsl -lsocket'
+;;
+esac
+
 exe='print-constants'
 echo "Compiling and running print-constants on $machine."
 cd $original
 $src/build/bin/mlton -build-constants true | 
-	ssh $machine "cd $tmp/runtime &&
-			cat >$exe.c && 
-			gcc -I. -o $exe $exe.c libmlton.a -lgmp"
-ssh $machine "$tmp/runtime/$exe" >"$lib/$crossTarget/constants"
+        ssh $machine "cd $tmp/runtime &&
+                        cat >$exe.c && 
+                        gcc -I. -o $exe $exe.c libmlton.a -lgmp -lm $libs"
+ssh $machine "$tmp/runtime/$exe$suf" >"$lib/$crossTarget/constants"
 ssh $machine "rm -rf $tmp"

Modified: mlton/branches/on-20050420-cmm-branch/bin/build-cross-gcc
===================================================================
--- mlton/branches/on-20050420-cmm-branch/bin/build-cross-gcc	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/bin/build-cross-gcc	2006-02-16 19:34:54 UTC (rev 4361)
@@ -23,30 +23,30 @@
 set -e
 
 die () {
-	echo >&2 "$1"
-	exit 1
+        echo >&2 "$1"
+        exit 1
 }
 
 root=`pwd`
 name=`basename $0`
 
 usage () {
-	die "usage: $name {cygwin|mingw|sun}"
+        die "usage: $name {cygwin|mingw|sun}"
 }
 
 case "$#" in
 1)
-	case "$1" in
-	cygwin|mingw|sun)
-		targetType="$1"
-	;;
-	*)
-		usage
-	;;
-	esac
+        case "$1" in
+        cygwin|mingw|sun)
+                targetType="$1"
+        ;;
+        *)
+                usage
+        ;;
+        esac
 ;;
 *)
-	usage
+        usage
 esac
 
 # You may want to change the installation prefix, which is where the
@@ -64,53 +64,53 @@
 # You may want to set the target.
 case "$targetType" in
 cygwin)
-	target='i386-pc-cygwin'
-	configureGCCFlags=''
-	makeGCCFlags=''
-	# For Cygwin, we also need the cygwin and w32api packages,
-	# which contain necessary header files and libraries.  I got
-	# them by installing cygwin in a Windows machine (using #
-	# Cygwin's setup.exe program) and then getting the bzip'ed tar
-	# files out of their Cygwin packages dir.  I had problems with
-	# cygwin-1.3.18-1, since its libcygwin.a contained a file,
-	# pseudo-reloc.o, with some strangeness that binutils didn't
-	# correctly handle.
-	cygwin='cygwin-1.3.17-1'
-	w32api='w32api-2.1-1'
+        target='i386-pc-cygwin'
+        configureGCCFlags=''
+        makeGCCFlags=''
+        # For Cygwin, we also need the cygwin and w32api packages,
+        # which contain necessary header files and libraries.  I got
+        # them by installing cygwin in a Windows machine (using #
+        # Cygwin's setup.exe program) and then getting the bzip'ed tar
+        # files out of their Cygwin packages dir.  I had problems with
+        # cygwin-1.3.18-1, since its libcygwin.a contained a file,
+        # pseudo-reloc.o, with some strangeness that binutils didn't
+        # correctly handle.
+        cygwin='cygwin-1.3.17-1'
+        w32api='w32api-2.1-1'
 ;;
 mingw)
-	target='i386-pc-mingw32'
-	# target='mingw32'
-	# These flags are from build-cross.sh from www.libsdl.org except:
-	# I added --disable-nls because of undefined references to dcgettext__
-	configureGCCFlags='--with-headers=$prefix/$target/include --with-gnu-as --with-gnu-ld --without-newlib --disable-multilib --disable-nls'
-	makeGCCFlags='LANGUAGES=c'
-	# For MinGW, we also need the mingw-runtime and w32api packages,
-	# which contain necessary header files and libraries.  I got
-	# them from www.mingw.org.
-	mingw='mingw-runtime-3.2'
-	w32api='w32api-2.4'
+        target='i386-pc-mingw32'
+        # target='mingw32'
+        # These flags are from build-cross.sh from www.libsdl.org except:
+        # I added --disable-nls because of undefined references to dcgettext__
+        configureGCCFlags='--with-headers=$prefix/$target/include --with-gnu-as --with-gnu-ld --without-newlib --disable-multilib --disable-nls'
+        makeGCCFlags='LANGUAGES=c'
+        # For MinGW, we also need the mingw-runtime and w32api packages,
+        # which contain necessary header files and libraries.  I got
+        # them from www.mingw.org.
+        mingw='mingw-runtime-3.2'
+        w32api='w32api-2.4'
 ;;
 sun)
-	target='sparc-sun-solaris'
-	configureGCCFlags=''
-	makeGCCFlags=''
-	# For sun, we assume that you have already copied the includes
-	# and libraries from a Solaris machine to the host machine.
-	if ! [ -d "$prefix/$target/include" -a -d "$prefix/$target/lib" ]; then
-		die "Must create $prefix/$target/{include,lib}."
-	fi
-	# The GCC tools expect limits.h to be in sys-include, not include.
-	( cd $prefix/$target && 
-		mkdir -p sys-include &&
-		mv include/limits.h sys-include )
+        target='sparc-sun-solaris'
+        configureGCCFlags=''
+        makeGCCFlags=''
+        # For sun, we assume that you have already copied the includes
+        # and libraries from a Solaris machine to the host machine.
+        if ! [ -d "$prefix/$target/include" -a -d "$prefix/$target/lib" ]; then
+                die "Must create $prefix/$target/{include,lib}."
+        fi
+        # The GCC tools expect limits.h to be in sys-include, not include.
+        ( cd $prefix/$target && 
+                mkdir -p sys-include &&
+                mv include/limits.h sys-include )
 ;;
 esac
 
 exists () {
-	if [ ! -r "$1" ]; then
-		die "$1 does not exist"
-	fi
+        if [ ! -r "$1" ]; then
+                die "$1 does not exist"
+        fi
 }
 
 echo 'Checking that needed files exist.'
@@ -118,30 +118,30 @@
 exists $gccTar
 case "$targetType" in
 cygwin)
-	exists $cygwin.tar
-	exists $w32api.tar
-	echo 'Copying include files and libraries needed by cross compiler.'
-	cd $root
-	mkdir -p cygwin
-	cd cygwin
-	tar x <../$cygwin.tar
-	tar x <../$w32api.tar
-	mkdir -p $prefix/$target || 
-		die "Cannot create $prefix/$target."
-	(cd usr && tar c include lib) | (cd $prefix/$target/ && tar x)
+        exists $cygwin.tar
+        exists $w32api.tar
+        echo 'Copying include files and libraries needed by cross compiler.'
+        cd $root
+        mkdir -p cygwin
+        cd cygwin
+        tar x <../$cygwin.tar
+        tar x <../$w32api.tar
+        mkdir -p $prefix/$target || 
+                die "Cannot create $prefix/$target."
+        (cd usr && tar c include lib) | (cd $prefix/$target/ && tar x)
 ;;
 mingw)
-	exists $mingw.tar
-	exists $w32api.tar
-	echo 'Copying include files and libraries needed by cross compiler.'
-	cd $root
-	mkdir -p mingw
-	cd mingw
-	tar x <../$mingw.tar
-	tar x <../$w32api.tar
-	mkdir -p $prefix/$target || 
-		die "Cannot create $prefix/$target."
-	(tar c include lib) | (cd $prefix/$target/ && tar x)
+        exists $mingw.tar
+        exists $w32api.tar
+        echo 'Copying include files and libraries needed by cross compiler.'
+        cd $root
+        mkdir -p mingw
+        cd mingw
+        tar x <../$mingw.tar
+        tar x <../$w32api.tar
+        mkdir -p $prefix/$target || 
+                die "Cannot create $prefix/$target."
+        (tar c include lib) | (cd $prefix/$target/ && tar x)
 ;;
 *)
 ;;
@@ -150,15 +150,15 @@
 echo 'Building binutils.'
 cd $root
 if [ ! -d $binutils ]; then
-	tar x <$binutils.tar
+        tar x <$binutils.tar
 fi
 mkdir -p build-binutils
 cd build-binutils
 ../$binutils/configure --prefix=$prefix --target=$target \
-	>$root/configure-binutils-log 2>&1 ||
-	die "Configure of binutils failed."
+        >$root/configure-binutils-log 2>&1 ||
+        die "Configure of binutils failed."
 make all install >$root/build-binutils-log 2>&1 ||
-	die "Build of binutils failed."
+        die "Build of binutils failed."
 
 echo 'Building gcc.'
 cd $root
@@ -166,12 +166,12 @@
 mkdir -p build-gcc
 cd build-gcc
 eval ../gcc-$gccVers/configure -v $configureGCCFlags \
-	--enable-languages=c \
-	--prefix=$prefix \
-	--target=$target \
-	>$root/configure-gcc-log 2>&1 || 
-	die "Configure of gcc failed."
+        --enable-languages=c \
+        --prefix=$prefix \
+        --target=$target \
+        >$root/configure-gcc-log 2>&1 || 
+        die "Configure of gcc failed."
 eval make $makeGCCFlags all install >$root/build-gcc-log 2>&1 || 
-	die "Build of gcc failed."
+        die "Build of gcc failed."
 
 echo 'Success.'

Deleted: mlton/branches/on-20050420-cmm-branch/bin/check-basis
===================================================================
--- mlton/branches/on-20050420-cmm-branch/bin/check-basis	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/bin/check-basis	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,365 +0,0 @@
-#!/usr/bin/env bash
-
-# This script checks MLton's basis library implementation for type errors using
-# SML/NJ.
-
-set -e 
-
-name=`basename $0`
-dir=`dirname $0`
-root=`cd $dir/.. && pwd`
-here=`pwd`
-basis="$root/basis-library/basis.sml"
-
-die () {
-	echo >&2 "$1"
-	exit 1
-}
-
-usage () {
-	die "usage: $name [{2002|1997|...} [file.sml | file.cm]]"
-}
-
-rewrite () {
-	sed 's/_build_const\(.*\);/(PRIM\1)/' |
-	sed 's/_build_const/PRIM/' |
-	sed 's/_const\(.*\);/(PRIM\1)/' |
-	sed 's/_const/PRIM/' |
-	sed 's/_prim\(.*\);/(PRIM\1)/' |
-	sed 's/_prim/PRIM/' |
-	sed 's/_import\(.*\);/(PRIM\1)/' |
-	sed 's/_import/PRIM/' |
-	sed 's/fun bigIntConstant x = x/fun bigIntConstant(x:smallInt):bigInt = raise Fail "bigIntConstant"/' |
-	sed 's/#"\([^"\]*\(\\.[^"\]*\)*\)"/#ZZZ\1ZZZ/g' |
-	sed 's/\([^\]\)"\([^"\]*\(\\.[^"\]*\)*\)"/\1(STRING_CONST "\2")/g' |
-	sed 's/#ZZZ\(\(.\)\|\(..\)\|\([^Z][^Z][^Z].*\)\)ZZZ/#"\1"/g' |
-        sed 's/(\*#line 0.0 \(.*\)\*)/(*#line 0.0 "\1"*)/'
-}
-
-function rewrite_file() {
-	f="$1"
-	if [ ! -r "$f" ]; then
-		die "error: $f is missing"
-	fi
-(
-	echo "(*#line 0.0 $f*)"
-	cat $f
-) | rewrite
-}
-
-rewrite_files () {
-	files=`cat $1 | grep -v "^#" | grep -v overload | grep -v Group`
-	for f in $files; do
-		if [ ! -r "$f" ]; then
-			die "error: $f is missing"
-		fi
-	done
-	(for f in $files; do
-		echo "(*#line 0.0 $f*)"
-	        cat $f
-	done | rewrite)
-}
-
-SML_FILE=""
-CM_FILE=""
-case "$#" in
-0)
-	LIB='2002'
-	;;
-1)
-	LIB=$1
-	;;
-2)
-	LIB=$1
-	if [ "$2" == "`basename $2 .sml`.sml" -a -r "$2" ]; then
-		SML_FILE=$2
-	elif [ "$2" == "`basename $2 .cm`.cm" -a -r "$2" ]; then
-		CM_FILE=$2
-	else usage
-        fi
-        ;;
-*)
-	usage
-	;;
-esac
-
-if [ ! -r "$root/basis-library/libs/basis-$LIB/bind" ]; then
-	echo >&2 "invalid lib: $LIB"
-	usage
-fi
-
-LIB="basis-$LIB"
-
-rm -f $basis
-cat >>$basis <<-EOF
-	val _ = SMLofNJ.Internals.GC.messages false
-        val _ = #set CM.Control.verbose false
-        val _ =
-   	   let
-	      open Control
-              open MC
-	   in
-              polyEqWarn := false
-	      ; bindNonExhaustiveWarn := true
-	      ; matchNonExhaustiveWarn := true
-	      ; matchNonExhaustiveError := true
-	      ; matchRedundantWarn := true
-	      ; matchRedundantError := false
-	   end
-        ;
-	fun PRIM (x:char vector) = raise Fail "_prim"
-	fun STRING_CONST (x:string) : char vector = raise Fail "<string constant>"
-        structure Types = struct
-          type 'a array = 'a array
-          datatype bool = datatype bool
-          type char = char
-          type exn = exn
-          type int8 = Int32.int
-          type int16 = Int32.int
-          type int32 = Int32.int
-          type int64 = IntInf.int
-          type intInf = IntInf.int
-          type int = int32
-          datatype list = datatype list
-          datatype pointer = T
-          type real32 = real
-	  type real64 = real
-          datatype ref = datatype ref
-          datatype preThread = T
-          datatype thread = T
-	  datatype 'a weak = T of 'a
-          type word8 = Word8.word
-	  type word16 = Word32.word
-          type word32 = Word32.word
-	  datatype word64 = T
-          type 'a vector = 'a vector
-          
-          datatype 'a option = T
-        end
-        signature GENERAL = sig end
-        structure General = struct end
-        signature OPTION = sig end
-        structure Option = struct end
-        signature BOOL = sig end
-        structure Bool = struct end
-        signature SML90 = sig end
-        structure SML90 = struct end
-        signature CHAR = sig end
-        structure Char = struct end
-        structure WideChar = struct end
-        signature STRING = sig end
-        structure String = struct end
-        structure WideString = struct end
-        signature SUBSTRING = sig end
-        structure Substring = struct end
-        structure WideSubstring = struct end
-        signature STRING_CVT = sig end
-        structure StringCvt = struct end
-        signature BYTE = sig end
-        structure Byte = struct end
-        signature INTEGER = sig end
-        structure Int = struct end
-        structure Int8 = struct end
-        structure Int16 = struct end
-        structure Int32 = struct end
-        structure Int64 = struct end
-        structure FixedInt = struct end
-        structure LargeInt = struct end
-        structure Position = struct end
-        signature INT_INF = sig end
-        structure IntInf = struct end
-        signature WORD = sig end
-        structure Word = struct end
-        structure Word8 = struct end
-        structure Word16 = struct end
-        structure Word32 = struct end
-        structure Word64 = struct end
-        structure LargeWord = struct end
-        structure SysWord = struct end
-        signature PACK_WORD = sig end
-        structure Pack8Big = struct end
-        structure Pack8Little = struct end
-        structure Pack16Big = struct end
-        structure Pack16Little = struct end
-        structure Pack32Big = struct end
-        structure Pack32Little = struct end
-        structure Pack64Big = struct end
-        structure Pack64Little = struct end
-        signature REAL = sig end
-        structure Real = struct end
-        structure Real32 = struct end
-        structure Real64 = struct end
-        structure Real128 = struct end
-        structure LargeReal = struct end
-        signature MATH = sig end
-        structure Math = struct end
-        signature IEEE_REAL = sig end
-        structure IEEEReal = struct end
-        signature PACK_REAL = sig end
-        structure PackRealBig = struct end
-        structure PackRealLittle = struct end
-        structure PackReal32Big = struct end
-        structure PackReal32Little = struct end
-        structure PackReal64Big = struct end
-        structure PackReal64Little = struct end
-        structure PackReal128Big = struct end
-        structure PackReal128Little = struct end
-        signature LIST = sig end
-        structure List = struct end
-        signature LIST_PAIR = sig end
-        structure ListPair = struct end
-        signature VECTOR = sig end
-        structure Vector = struct end
-        signature MONO_VECTOR = sig end
-        structure CharVector = struct end
-        structure WideCharVector = struct end
-        structure BoolVector = struct end
-        structure IntVector = struct end
-        structure RealVector = struct end
-        structure WordVector = struct end
-        structure Int8Vector = struct end
-        structure Int16Vector = struct end
-        structure Int32Vector = struct end
-        structure Int64Vector = struct end
-        structure Real32Vector = struct end
-        structure Real64Vector = struct end
-        structure Real128Vector = struct end
-        structure Word8Vector = struct end
-        structure Word16Vector = struct end
-        structure Word32Vector = struct end
-        structure Word64Vector = struct end
-        signature ARRAY = sig end
-        structure Array = struct end
-        signature MONO_ARRAY = sig end
-        structure CharArray = struct end
-        structure WideCharArray = struct end
-        structure BoolArray = struct end
-        structure IntArray = struct end
-        structure RealArray = struct end
-        structure WordArray = struct end
-        structure Int8Array = struct end
-        structure Int16Array = struct end
-        structure Int32Array = struct end
-        structure Int64Array = struct end
-        structure Real32Array = struct end
-        structure Real64Array = struct end
-        structure Real128Array = struct end
-        structure Word8Array = struct end
-        structure Word16Array = struct end
-        structure Word32Array = struct end
-        structure Word64Array = struct end
-        signature ARRAY2 = sig end
-        structure Array2 = struct end
-        signature MONO_ARRAY2 = sig end
-        structure CharArray2 = struct end
-        structure WideCharArray2 = struct end
-        structure BoolArray2 = struct end
-        structure IntArray2 = struct end
-        structure RealArray2 = struct end
-        structure WordArray2 = struct end
-        structure Int8Array2 = struct end
-        structure Int16Array2 = struct end
-        structure Int32Array2 = struct end
-        structure Int64Array2 = struct end
-        structure Real32Array2 = struct end
-        structure Real64Array2 = struct end
-        structure Real128Array2 = struct end
-        structure Word8Array2 = struct end
-        structure Word16Array2 = struct end
-        structure Word32Array2 = struct end
-        structure Word64Array2 = struct end
-        signature IO = sig end
-        structure IO = struct end
-        signature TEXT_IO = sig end
-        structure TextIO = struct end
-        signature TEXT_STREAM_IO = sig end
-        signature BIN_IO = sig end
-        structure BinIO = struct end
-        signature IMPERATIVE_IO = sig end
-        functor ImperativeIO () = struct end
-        signature STREAM_IO = sig end
-        functor StreamIO () = struct end
-        signature PRIM_IO = sig end
-        structure BinPrimIO = struct end
-        structure TextPrimIO = struct end
-        structure WideTextPrimIO = struct end
-        functor PrimIO () = struct end
-        signature OS = sig end
-        structure OS = struct end
-        signature OS_FILE_SYS = sig end
-        signature OS_IO = sig end
-        signature OS_PATH = sig end
-        signature OS_PROCESS = sig end
-        signature COMMAND_LINE = sig end
-        structure CommandLine = struct end
-        signature UNIX = sig end
-        structure Unix = struct end
-        signature DATE = sig end
-        structure Date = struct end
-        signature TIME = sig end
-        structure Time = struct end
-        signature TIMER = sig end
-        structure Timer = struct end
-        signature POSIX = sig end
-        structure Posix = struct end
-        signature POSIX_ERROR = sig end
-        signature POSIX_FILE_SYS = sig end
-        signature POSIX_FLAGS = sig end
-        signature POSIX_IO = sig end
-        signature POSIX_PROC_ENV = sig end
-        signature POSIX_PROCESS = sig end
-        signature POSIX_SIGNAL = sig end
-        signature POSIX_SYS_DB = sig end
-        signature POSIX_TTY = sig end
-        signature NET_HOST_DB = sig end
-        structure NetHostDB = struct end
-        signature NET_PROT_DB = sig end
-        structure NetProtDB = struct end
-        signature NET_SERV_DB = sig end
-        structure NetServDB = struct end
-        signature SOCKET = sig end
-        structure Socket = struct end
-        signature GENERIC_SOCK = sig end
-        structure GenericSock = struct end
-        signature INET_SOCK = sig end
-        structure INetSock = struct end
-        signature UNIX_SOCK = sig end
-        structure UnixSock = struct end
-	nonfix * / mod div ^ + - := o > < >= <= = <> :: @ before
-
-        open Types
-EOF
-cat >>$basis <<-EOF
-	local
-EOF
-cd $root/basis-library
-rewrite_files >>$basis 'libs/build'
-cat >>$basis <<-EOF
-	in
-EOF
-cd $root/basis-library
-rewrite_files >>$basis "libs/$LIB/bind"
-cat >>$basis <<-EOF
-	end
-EOF
-cd $here
-case "$SML_FILE" in
-"")
-	;;
-*)
-	rewrite_file >>$basis "$SML_FILE"
-	;;
-esac
-case "$CM_FILE" in
-"")
-	;;
-*)
-	rewrite_files >>$basis "$CM_FILE"
-	;;
-esac
-cat >>$basis <<-EOF
-	(*#line 0.0 "check-basis"*)
-	val _ = case 1 of 1 => 1
-EOF
-chmod -w $basis
-sml <$basis

Modified: mlton/branches/on-20050420-cmm-branch/bin/clean
===================================================================
--- mlton/branches/on-20050420-cmm-branch/bin/clean	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/bin/clean	2006-02-16 19:34:54 UTC (rev 4361)
@@ -8,30 +8,30 @@
 
 case `$bin/host-os` in
 cygwin|freebsd|linux)
-	grepFlags='-q'
+        grepFlags='-q'
 ;;
 sun)
-	grepFlags=''
+        grepFlags=''
 ;;
 esac
 
+ignore='.ignore'
 doit () {
-	rm -rf '.#'* .*~ *~ *.a *.o .cm core mlmon.out
-	if [ -r .cvsignore ]; then
-		for f in `cat .cvsignore`; do rm -rf $f; done
-	fi
-	for f in `ls`; do
-		if [ -d $f ]; then
-			cd $f;
-			if [ -r Makefile ] && 
-				grep $grepFlags '^clean:' Makefile ; then 
-				$bin/mmake clean
-			else
-				doit
-			fi && 
-			cd ..;
-		fi
-	done
+        rm -rf '.#'* .*~ *~ *.a *.o .cm core mlmon.out svn-commit.*
+        if [ -r $ignore ]; then
+                for f in `cat $ignore`; do rm -rf $f; done
+        fi
+        for f in `ls`; do
+                if [ -d $f ]; then
+                        cd $f
+                        if [ -r Makefile ]; then
+				$bin/mmake clean || doit
+                        else
+                                doit
+                        fi
+                        cd ..
+                fi
+        done
 }
 
 doit
@@ -39,9 +39,9 @@
 # This script removes all the junk files created when compiling with MLton's
 # various -keep flags.
 
-#/bin/rm -f *.basis *.chunks *.const *.core-ml *.dot *.flat *.flow 	\
-#	*.inline *.local-flatten *.mono *.o *.once-graph *.once-vars	\
-#	*.post-useless *.raise-to-jump *.redundant *.reg *.rep *.ssa	\
-#	*.sxml *.sxml.poly *.threshold[0-9] *.unused-args *.useless *.xml
+#/bin/rm -f *.basis *.chunks *.const *.core-ml *.dot *.flat *.flow      \
+#       *.inline *.local-flatten *.mono *.o *.once-graph *.once-vars    \
+#       *.post-useless *.raise-to-jump *.redundant *.reg *.rep *.ssa    \
+#       *.sxml *.sxml.poly *.threshold[0-9] *.unused-args *.useless *.xml
 #
 #/bin/rm -f *~ core mlmon.out

Copied: mlton/branches/on-20050420-cmm-branch/bin/grab-wiki (from rev 4358, mlton/trunk/bin/grab-wiki)

Modified: mlton/branches/on-20050420-cmm-branch/bin/host-arch
===================================================================
--- mlton/branches/on-20050420-cmm-branch/bin/host-arch	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/bin/host-arch	2006-02-16 19:34:54 UTC (rev 4361)
@@ -6,19 +6,19 @@
 bin=`cd $dir && pwd`
 
 die () {
-	echo >&2 "$1"
-	exit 1
+        echo >&2 "$1"
+        exit 1
 }
 
 usage () {
-	die "usage: $name"
+        die "usage: $name"
 }
 
 case "$#" in
 0)
 ;;
 *)
-	usage
+        usage
 ;;
 esac
 

Modified: mlton/branches/on-20050420-cmm-branch/bin/host-os
===================================================================
--- mlton/branches/on-20050420-cmm-branch/bin/host-os	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/bin/host-os	2006-02-16 19:34:54 UTC (rev 4361)
@@ -6,19 +6,19 @@
 bin=`cd $dir && pwd`
 
 die () {
-	echo >&2 "$1"
-	exit 1
+        echo >&2 "$1"
+        exit 1
 }
 
 usage () {
-	die "usage: $name"
+        die "usage: $name"
 }
 
 case "$#" in
 0)
 ;;
 *)
-	usage
+        usage
 ;;
 esac
 

Copied: mlton/branches/on-20050420-cmm-branch/bin/make-pdf-guide (from rev 4358, mlton/trunk/bin/make-pdf-guide)

Modified: mlton/branches/on-20050420-cmm-branch/bin/mlton-script
===================================================================
--- mlton/branches/on-20050420-cmm-branch/bin/mlton-script	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/bin/mlton-script	2006-02-16 19:34:54 UTC (rev 4361)
@@ -4,49 +4,58 @@
 
 set -e
 
-lib='lib unset'
+dir=`dirname $0`
+lib=`cd $dir/../lib && pwd`
+eval `$lib/platform`
 gcc='gcc'
 qcmm='qc--.opt'
-mlton="$lib/mlton-compile"
+case "$HOST_OS" in
+mingw)
+	exe='.exe'
+;;
+*)
+	exe=''
+;;
+esac
+mlton="$lib/mlton-compile$exe"
 world="$lib/world.mlton"
 nj='sml'
-eval `$lib/platform`
 # Try to use the SML/NJ .arch-n-opsys
 if .arch-n-opsys >/dev/null 2>&1; then
-	eval `.arch-n-opsys`
-	njHeap="$lib/mlton.$HEAP_SUFFIX"
-	unset ARCHNOPSYS ARCH OPSYS HEAP_SUFFIX
+        eval `.arch-n-opsys`
+        njHeap="$lib/mlton.$HEAP_SUFFIX"
+        unset `.arch-n-opsys | sed 's#=[^ ]*##g'`
 else
-	njHeap="$lib/mlton.$HOST_ARCH-$HOST_OS"
+        njHeap="$lib/mlton.$HOST_ARCH-$HOST_OS"
 fi
 
 rargs=""
 case "$1" in
 @MLton)
-	shift
-	while [ "$#" -gt 0 -a "$1" != "--" ]; do
-		rargs="$rargs $1"
-		shift
-	done
-	if [ "$#" -gt 0 -a "$1" == "--" ]; then
-		shift
-	else	
-		echo '@MLton missing --'
-		exit 1
-	fi
-	;;
+        shift
+        while [ "$#" -gt 0 -a "$1" != "--" ]; do
+                rargs="$rargs $1"
+                shift
+        done
+        if [ "$#" -gt 0 -a "$1" == "--" ]; then
+                shift
+        else    
+                echo '@MLton missing --'
+                exit 1
+        fi
+        ;;
 esac
 
 # If $mlton is executable and $world exists and is not older than
 # $njHeap (which exists), then use MLton, otherwise use SML/NJ.
 doit () {
-	if [ -x "$mlton" -a -s "$world" -a ! "$njHeap" -nt "$world" ]; then
-		exec "$mlton" @MLton load-world "$world" ram-slop 0.5 $rargs -- "$@"
-	elif [ -s "$njHeap" ]; then
-		exec "$nj" @SMLload="$njHeap" "$@"
-	fi
-	echo 'Unable to run MLton.  Check that lib is set properly.' >&2
-	exit 1
+        if [ -x "$mlton" -a -s "$world" -a ! "$njHeap" -nt "$world" ]; then
+                exec "$mlton" @MLton load-world "$world" ram-slop 0.5 $rargs -- "$@"
+        elif [ -s "$njHeap" ]; then
+                exec "$nj" @SMLload="$njHeap" "$@"
+        fi
+        echo 'Unable to run MLton.  Check that lib is set properly.' >&2
+        exit 1
 }
 
 # For align-{functions,jumps,loops}, we use -m for now instead of
@@ -59,35 +68,47 @@
 # You may need to add a line with -link-opt '-L/path/to/libgmp' so
 # that the linker can find libgmp.
 
+if [ -d '/sw/lib' ]; then
+        darwinLinkOpts='-L/sw/lib'
+fi
+
 doit "$lib" \
-	-cc "$gcc"						\
-	-cc-opt "-I$lib/include"				\
-	-cc-opt '-O1'						\
-	-cc-opt '-fno-strict-aliasing -fomit-frame-pointer -w'	\
-	-target-cc-opt solaris 					\
-		'-Wa,-xarch=v8plusa
-		-fcall-used-g5
-		-fcall-used-g7
-		-mcpu=ultrasparc'				\
-	-target-cc-opt sparc '-mv8 -m32'			\
-	-target-cc-opt x86					\
-		'-fno-strength-reduce
-		-fschedule-insns
-		-fschedule-insns2
-		-malign-functions=5
-		-malign-jumps=2
-		-malign-loops=2
-		-mcpu=pentiumpro'				\
-	-target-link-opt cygwin '-lgmp'				\
- 	-target-link-opt darwin '-lgmp'				\
-	-target-link-opt freebsd '-L/usr/local/lib/ -lgmp'	\
-	-target-link-opt linux '-lgmp'				\
-	-target-link-opt mingw 					\
-		'-lgmp -lws2_32 -lkernel32 -lpsapi -lnetapi32'	\
-	-target-link-opt netbsd					\
-		'-Wl,-R/usr/pkg/lib -L/usr/local/lib/ -lgmp'	\
-	-target-link-opt openbsd '-L/usr/local/lib/ -lgmp'	\
-	-target-link-opt solaris '-lgmp -lnsl -lsocket'		\
-	-link-opt '-lgdtoa -lm'					\
+        -cc "$gcc"                                              \
+        -cc-opt "-I$lib/include"                                \
+        -cc-opt '-O1'                                           \
+        -cc-opt '-fno-strict-aliasing -fomit-frame-pointer -w'  \
+	-mlb-path-map "$lib/mlb-path-map"			\
+        -target-as-opt amd64                                    \
+                '-m32
+                -mtune=opteron'                                 \
+        -target-cc-opt amd64                                    \
+                '-m32
+                -mtune=opteron'                                 \
+        -target-cc-opt darwin '-I/sw/include'                   \
+	-target-cc-opt freebsd '-I/usr/local/include'		\
+        -target-cc-opt solaris                                  \
+                '-Wa,-xarch=v8plusa
+                -mcpu=ultrasparc'                               \
+        -target-cc-opt sparc '-mcpu=v8 -m32'                    \
+        -target-cc-opt x86                                      \
+                '-fno-strength-reduce
+                -fschedule-insns
+                -fschedule-insns2
+                -malign-functions=5
+                -malign-jumps=2
+                -malign-loops=2'                                \
+        -target-link-opt amd64 '-m32'                           \
+        -target-link-opt cygwin '-lgmp'                         \
+        -target-link-opt darwin "$darwinLinkOpts -lgmp"         \
+        -target-link-opt freebsd '-L/usr/local/lib/ -lgmp'      \
+        -target-link-opt linux '-lgmp'                          \
+        -target-link-opt mingw                                  \
+                '-lgmp -lws2_32 -lkernel32 -lpsapi -lnetapi32'  \
+        -target-link-opt netbsd                                 \
+                '-Wl,-R/usr/pkg/lib -L/usr/local/lib/ -lgmp'    \
+        -target-link-opt openbsd '-L/usr/local/lib/ -lgmp'      \
+        -target-link-opt solaris '-lgmp -lnsl -lsocket -lrt'    \
+        -link-opt '-lgdtoa -lm'                                 \
 	-cmmc "$qcmm"						\
-	"$@"
+        -profile-exclude '<basis>'                              \
+        "$@"

Modified: mlton/branches/on-20050420-cmm-branch/bin/mmake
===================================================================
--- mlton/branches/on-20050420-cmm-branch/bin/mmake	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/bin/mmake	2006-02-16 19:34:54 UTC (rev 4361)
@@ -3,16 +3,16 @@
 set -e
 
 die () {
-	echo $1 >&2
-	exit 1
+        echo $1 >&2
+        exit 1
 }
 
 if gmake -v >/dev/null 2>&1; then
-	make='gmake'
+        make='gmake'
 elif make -v 2>&1 | grep -q GNU; then
-	make=`which make`
+        make=`which make`
 else
-	die 'Can'\''t find GNU make'
+        die 'Can'\''t find GNU make'
 fi
 
 exec $make "$@"

Copied: mlton/branches/on-20050420-cmm-branch/bin/msed (from rev 4358, mlton/trunk/bin/msed)

Copied: mlton/branches/on-20050420-cmm-branch/bin/patch-mingw (from rev 4358, mlton/trunk/bin/patch-mingw)

Modified: mlton/branches/on-20050420-cmm-branch/bin/platform
===================================================================
--- mlton/branches/on-20050420-cmm-branch/bin/platform	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/bin/platform	2006-02-16 19:34:54 UTC (rev 4361)
@@ -7,19 +7,19 @@
 bin=`cd $dir && pwd`
 
 die () {
-	echo >&2 "$1"
-	exit 1
+        echo >&2 "$1"
+        exit 1
 }
 
 usage () {
-	die "usage: $name"
+        die "usage: $name"
 }
 
 case "$#" in
 0)
 ;;
 *)
-	usage
+        usage
 ;;
 esac
 
@@ -27,31 +27,31 @@
 
 case "$uname" in
 CYGWIN*)
-	HOST_OS='cygwin'
+        HOST_OS='cygwin'
 ;;
 Darwin)
-	HOST_OS='darwin'
+        HOST_OS='darwin'
 ;;
 FreeBSD*)
-	HOST_OS='freebsd'
+        HOST_OS='freebsd'
 ;;
 Linux)
-	HOST_OS='linux'
+        HOST_OS='linux'
 ;;
 MINGW*)
-	HOST_OS='mingw'
+        HOST_OS='mingw'
 ;;
 NetBSD*)
-	HOST_OS='netbsd'
+        HOST_OS='netbsd'
 ;;
 OpenBSD*)
-	HOST_OS='openbsd'
+        HOST_OS='openbsd'
 ;;
 SunOS)
-	HOST_OS='solaris'
+        HOST_OS='solaris'
 ;;
 *)
-	die "Unknown OS $uname."
+        die "Unknown OS $uname."
 ;;
 esac
 
@@ -60,47 +60,50 @@
 case "$arch" in
 alpha*)
 # not certain about this one; no alpha access
-	HOST_ARCH=alpha
+        HOST_ARCH=alpha
 ;;
 x86_64*)
-	HOST_ARCH=amd64
+        HOST_ARCH=amd64
 ;;
+i?86_64)
+        HOST_ARCH=amd64
+;;
 arm*)
-	HOST_ARCH=arm
+        HOST_ARCH=arm
 ;;
 parisc*)
-	HOST_ARCH=hppa
+        HOST_ARCH=hppa
 ;;
 ia64*)
-	HOST_ARCH=ia64
+        HOST_ARCH=ia64
 ;;
 m68k*)
-	HOST_ARCH=m68k
+        HOST_ARCH=m68k
 ;;
 mips*)
 # big-endian and little-endian detect via headers
-	HOST_ARCH=mips
+        HOST_ARCH=mips
 ;;
 ppc*)
-	HOST_ARCH=powerpc
+        HOST_ARCH=powerpc
 ;;
 Power*)
-	HOST_ARCH=powerpc
+        HOST_ARCH=powerpc
 ;;
 s390*)
-	HOST_ARCH=s390
+        HOST_ARCH=s390
 ;;
 sparc*)
-	HOST_ARCH=sparc
+        HOST_ARCH=sparc
 ;;
 sun*)
-	HOST_ARCH=sparc
+        HOST_ARCH=sparc
 ;;
 i?86)
-	HOST_ARCH=x86
+        HOST_ARCH=x86
 ;;
 *)
-	die "Unknown arch $arch."
+        die "Unknown arch $arch."
 ;;
 esac
 

Modified: mlton/branches/on-20050420-cmm-branch/bin/regression
===================================================================
--- mlton/branches/on-20050420-cmm-branch/bin/regression	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/bin/regression	2006-02-16 19:34:54 UTC (rev 4361)
@@ -3,73 +3,76 @@
 # This script runs the regression tests in src/regression.
 # It also compiles the tests in benchmark/tests
 
-## set -e
+set -e
 
 name=`basename $0`
 
 usage () {
-	echo >&2 "usage: $name [-cross target] [-run-only target] [-short] [mlton flags ...]"
-	exit 1
+        echo >&2 "usage: $name [-cross target] [-run-only target] [-short] [mlton flags ...]"
+        exit 1
 }
 
-cross='no'
-fail='no'
-runOnly='no'
-short='no'
+cross='false'
+fail='false'
+runOnly='false'
+short='false'
 while [ "$#" -gt 0 ]; do
-	case "$1" in
-	-cross)
-		cross='yes'
-		shift
-		if [ "$#" = 0 ]; then
-			usage
-		fi
-		crossTarget="$1"
-		shift
-		;;
-	-fail)
-		fail='yes'
-		shift
-		;;
-	-run-only)
-		runOnly='yes'
-		shift
-		if [ "$#" = 0 ]; then
-			usage
-		fi
-		crossTarget="$1"
-		shift
-		;;
-	-short)
-		short='yes'
-		shift
-		;;
-	*)
-		flags="$@"
-		break
-		;;
-	esac
+        case "$1" in
+        -cross)
+                cross='true'
+                shift
+                if [ "$#" = 0 ]; then
+                        usage
+                fi
+                crossTarget="$1"
+                shift
+                ;;
+        -fail)
+                fail='true'
+                shift
+                ;;
+        -run-only)
+                runOnly='true'
+                shift
+                if [ "$#" = 0 ]; then
+                        usage
+                fi
+                crossTarget="$1"
+                shift
+                ;;
+        -short)
+                short='true'
+                shift
+                ;;
+        *)
+                flags="$@"
+                break
+                ;;
+        esac
 done
 
 dir=`dirname $0`
 src=`cd $dir/.. && pwd`
 bin="$src/build/bin"
+lib="$src/build/lib"
 mlton="$bin/mlton"
 flags="-type-check true $flags"
-if [ $cross = 'yes' ]; then
-	flags="$flags -target $crossTarget -stop g"
+if $cross; then
+        flags="$flags -target $crossTarget -stop g"
 fi
-cont='callcc.sml callcc2.sml callcc3.sml once.sml size.sml'
+cont='callcc.sml callcc2.sml callcc3.sml once.sml'
 flatArray='finalize.sml flat-array.sml flat-array.2.sml'
-intInf='conv.sml conv2.sml harmonic.sml int-inf.*.sml slow.sml slower.sml smith-normal-form.sml'
-signal='finalize.sml finalize.2.sml signals.sml signals2.sml suspend.sml weak.sml'
-thread='thread0.sml thread1.sml thread2.sml thread-switch.sml mutex.sml prodcons.sml same-fringe.sml timeout.sml'
+intInf='conv.sml conv2.sml fixed-integer.sml harmonic.sml int-inf.*.sml slow.sml slower.sml smith-normal-form.sml'
+signal='finalize.sml signals.sml signals2.sml suspend.sml weak.sml'
+thread='thread0.sml thread1.sml thread2.sml mutex.sml prodcons.sml same-fringe.sml timeout.sml'
 world='world1.sml world2.sml world3.sml world4.sml world5.sml world6.sml'
 tmp=/tmp/z.regression.$$
 PATH=$bin:$src/bin/.:$PATH
 
+eval `$lib/platform`
+
 compFail () {
-	echo "compilation of $f failed with $flags"
+        echo "compilation of $f failed with $flags"
 }
 
 $mlton -verbose 1 || echo 'no mlton present'
@@ -77,160 +80,150 @@
 
 cd $src/regression
 
-if [ "$fail" = 'yes' ]; then
-	for f in `ls fail/*.sml`; do
-		echo "testing $f"
-		( $mlton $flags -stop tc $f >/dev/null 2>&1 &&
-			echo "compilation of $f should have failed but did not" ) ||
-			true
-	done
-	exit 0
+if $fail; then
+        for f in `ls fail/*.sml`; do
+                echo "testing $f"
+                ( $mlton $flags -stop tc $f >/dev/null 2>&1 &&
+                        echo "compilation of $f should have failed but did not" ) ||
+                        true
+        done
+        exit 0
 fi
 
+forMinGW='false'
+if [ `host-os` = mingw ]; then
+	forMinGW='true'
+fi
+case $crossTarget in
+*mingw)
+	forMinGW='true'
+;;
+esac
+
 for f in `ls *.sml`; do
-	f=`basename $f .sml`
-	case `host-os` in
-	cygwin|mingw)
-		case "$f" in
-		echo|signals|socket|suspend|textio.2|thread2|world*)
-			continue
-		;;
-		esac
-	;;
+        f=`basename $f .sml`
+        case `host-os` in
+        cygwin|mingw)
+                case "$f" in
+                echo|signals|socket|suspend|textio.2|thread2|world*)
+                        continue
+                ;;
+                esac
+        ;;
+        esac
+        case `host-os` in
+        mingw)
+                case "$f" in
+                cmdline|command-line|filesys|mutex|posix-exit|prodcons|signals2|timeout|unixpath)
+                        continue
+                ;;
+                esac
+        esac
+        case "$f" in
+        serialize)
+                continue
+        ;;
 	esac
-	case `host-os` in
-	mingw)
-		case "$f" in
-		mutex|prodcons|signals2)
-			continue
-		;;
-		esac
-	esac
-	case "$f" in
-	callcc|callcc2|callcc3|once|size)
-		echo "skipping $f"
-	;;
-	finalize|finalize.2|signals|signals2|suspend|weak)
-		echo "skipping $f"
-	;;
-	thread0|thread1|thread2|thread-switch|mutex|prodcons|same-fringe|timeout)
-		echo "skipping $f"
-	;;
-	world1|world2|world3|world4|world5|world6)
-		echo "skipping $f"
-	;;
-	serialize)
-		echo "skipping $f"
-	;;
-	*)
-		echo "testing $f"
-		case "$f" in
-		exnHistory*)
-			extraFlags="-const 'Exn.keepHistory true'"
-		;;
-		*)
-			extraFlags=""
-		;;
-		esac
-		case "$runOnly" in
-		no)
-			mlb="$f.mlb"
-			echo "\$(SML_LIB)/basis/basis.mlb
-				\$(SML_LIB)/basis/mlton.mlb
-				\$(SML_LIB)/basis/sml-nj.mlb
- 				ann 
-					\"allowExport true\"
-					\"allowImport true\"
-					\"allowOverload true\"
-					\"warnMatch false\"
-				in $f.sml 
-				end" >$mlb
-			cmd="$mlton $flags $extraFlags -output $f $mlb"
-			eval $cmd
-			rm $mlb
-			if [ "$?" -ne '0' ] || 
-				[ "$cross" = 'no' -a ! -x "$f" ]; then
-				compFail $f
-			fi
-		;;
-		yes)
-			case $crossTarget in
-			*mingw)
-				libs='-lws2_32 -lkernel32 -lpsapi -lnetapi32'
-			;;
-			*solaris)
-				libs='-lnsl -lsocket'
-			;;
-			*)
-				libs=''
-			;;
-			esac
-			libs="-lmlton -lgmp $libs -lgdtoa -lm"
-			# Must use $f.[0-9].[cS], not $f.*.[cS], because the
-			# latter will include other files, e.g. for finalize,
-			# it will also include finalize.2.
-			files="$f.[0-9].[cS]"
-			if ls $f.[0-9][0-9].[cS] >/dev/null 2>&1; then 
-				files="$files $f.[0-9][0-9].[cS]"
-			fi
-			gcc -o $f -w -O1				\
-				-I "../build/lib/include"		\
-				-L"../build/lib/$crossTarget"		\
-				-L/usr/pkg/lib				\
-				-L/usr/local/lib			\
-				$files $libs
-		;;
-		esac
-		if [ ! -r $f.nonterm -a $cross = 'no' -a -x $f ]; then
-			nonZeroMsg='Nonzero exit status.'
-			case $crossTarget in
-			*mingw)
-				nonZeroMsg="$nonZeroMsg"'\r'
-			;;
-			esac
-			( ./$f || echo -e "$nonZeroMsg" ) >$tmp 2>&1 
-			if [ -r $f.ok ]; then
-				case $crossTarget in
-				*mingw)
-					compare="$f.sed.ok"
-					sed 's/$/\r/' <"$f.ok" >"$compare"
-				;;
-				*)
-					compare="$f.ok"
-				;;
-				esac
-				if ! diff $compare $tmp; then
-					echo "difference with $flags"
-				fi
-			fi
+        echo "testing $f"
+        case "$f" in
+        exnHistory*)
+                extraFlags="-const 'Exn.keepHistory true'"
+        ;;
+        *)
+                extraFlags=""
+        ;;
+        esac
+	if (! $runOnly); then
+                mlb="$f.mlb"
+                echo "\$(SML_LIB)/basis/basis.mlb
+                        \$(SML_LIB)/basis/mlton.mlb
+                        \$(SML_LIB)/basis/sml-nj.mlb
+                        ann 
+                                \"allowFFI true\"
+                                \"allowOverload true\"
+                                \"nonexhaustiveMatch ignore\"
+                                \"redundantMatch ignore\"
+                        in $f.sml 
+                        end" >$mlb
+                cmd="$mlton $flags $extraFlags -output $f $mlb"
+                eval $cmd
+                rm $mlb
+                if [ "$?" -ne '0' ] || ((! $cross) && [ ! -x "$f" ]); then
+                        compFail $f
+                fi
+	else
+                case $crossTarget in
+                *mingw)
+                        libs='-lws2_32 -lkernel32 -lpsapi -lnetapi32'
+                ;;
+                *solaris)
+                        libs='-lnsl -lsocket -lrt'
+                ;;
+                *)
+                        libs=''
+                ;;
+                esac
+                libs="-lmlton -lgmp $libs -lgdtoa -lm"
+                # Must use $f.[0-9].[cS], not $f.*.[cS], because the
+                # latter will include other files, e.g. for finalize,
+                # it will also include finalize.2.
+                files="$f.[0-9].[cS]"
+                if [ 0 -ne `ls $f.[0-9][0-9].[cS] 2>/dev/null | wc -l` ]; then 
+                        files="$files $f.[0-9][0-9].[cS]"
+                fi
+                gcc -o $f -w -O1                                \
+                        -I "../build/lib/include"               \
+                        -L"../build/lib/$crossTarget"           \
+                        -L/usr/pkg/lib                          \
+                        -L/usr/local/lib                        \
+                        $files $libs
+	fi
+        if [ ! -r $f.nonterm -a $cross = 'false' -a -x $f ]; then
+                nonZeroMsg='Nonzero exit status.'
+		if $forMinGW; then
+                       nonZeroMsg="$nonZeroMsg"'\r'
 		fi
-	;;
-	esac
+                ( ./$f || echo -e "$nonZeroMsg" ) >$tmp 2>&1 
+                if [ -r $f.ok ]; then
+                        compare="$f.$HOST_ARCH-$HOST_OS.ok"
+                        if [ ! -r $compare ]; then
+                                compare="$f.ok"
+                        fi
+			if $forMinGW; then
+                                compare="$f.sed.ok"
+                                /c/cygwin/bin/sed 's/$/\r/' <"$f.ok" >"$compare"
+			fi
+                        if ! diff $compare $tmp; then
+                                echo "difference with $flags"
+                        fi
+                fi
+        fi
 done
-if [ "$cross" = 'yes' -o "$runOnly" = 'yes' -o "$short" = 'yes' ]; then
- 	exit 0
+if $cross || $runOnly || $short; then
+        exit 0
 fi
 mmake clean >/dev/null
 cd $src/benchmark/tests
 for f in `ls *.sml`; do
-	f=`basename $f .sml`
-	tmpf=/tmp/$f.$$
-	case "$f" in
-	fxp)
-		echo "skipping $f"
-	;;
-	*)
-			echo "testing $f"
-		echo "val _ = Main.doit 0" | cat $f.sml - > $tmpf.sml
-		$mlton -output $tmpf $flags 			\
-			-default-ann 'warnMatch false'		\
-			$tmpf.sml
-		if [ $? -ne 0 ]; then
-			compFail $f
-		fi
-		rm -f $tmpf $tmpf.sml
-	;;
-	esac
+        f=`basename $f .sml`
+        tmpf=/tmp/$f.$$
+        case "$f" in
+        fxp|hamlet)
+                echo "skipping $f"
+        ;;
+        *)
+                        echo "testing $f"
+                echo "val _ = Main.doit 0" | cat $f.sml - > $tmpf.sml
+                $mlton -output $tmpf $flags                     \
+                        -default-ann 'nonexhaustiveMatch ignore'\
+                        -default-ann 'redundantMatch ignore'    \
+                        $tmpf.sml
+                if [ $? -ne 0 ]; then
+                        compFail $f
+                fi
+                rm -f $tmpf $tmpf.sml
+        ;;
+        esac
 done 
 mmake clean >/dev/null
 cd $src
@@ -239,16 +232,16 @@
     cd $src/$f
     case "$f" in
     foobar)
-	    echo "skipping $f"
+            echo "skipping $f"
     ;;
     *)
-	echo "testing $f"
-	mmake -W $f >/dev/null
-	$mlton $flags -output $tmpf $f.mlb
-	if [ $? -ne 0 ]; then
-		compFail $f
-	fi
-	rm -f $tmpf
+        echo "testing $f"
+        mmake -W $f >/dev/null
+        $mlton $flags -output $tmpf $f.mlb
+        if [ $? -ne 0 ]; then
+                compFail $f
+        fi
+        rm -f $tmpf
     ;;
     esac
 done

Copied: mlton/branches/on-20050420-cmm-branch/bin/sync-ignore (from rev 4358, mlton/trunk/bin/sync-ignore)

Modified: mlton/branches/on-20050420-cmm-branch/bin/upgrade-basis
===================================================================
--- mlton/branches/on-20050420-cmm-branch/bin/upgrade-basis	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/bin/upgrade-basis	2006-02-16 19:34:54 UTC (rev 4361)
@@ -3,23 +3,25 @@
 set -e
 
 die () {
-	echo >&2 "$1"
-	exit 1
+        echo >&2 "$1"
+        exit 1
 }
 
 bin=`dirname $0`
 name=`basename $0`
 
 usage () {
-	die "usage: $name <PATH>"
+        die "usage: $name <PATH> <ARCH> <OS>"
 }
 
 case "$#" in
-1)
-	PATH="$1"
+3)
+        PATH="$1"
+	ARCH="$2"
+	OS="$3"
 ;;
 *)
-	usage
+        usage
 ;;
 esac
 
@@ -27,16 +29,16 @@
 
 echo "val () = print \"I work\"" >$tmp
 if ! mlton $tmp 1>&2; then
-	die "Error: cannot upgrade basis because the compiler doesn't work" 
+        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="$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' '
@@ -49,7 +51,7 @@
             "" => NONE
           | s => SOME s
    end'
-	
+        
 feature 'fun f x : string option = OS.FileSys.readDir x' '
 structure OS =
    struct
@@ -70,7 +72,7 @@
       open IntInf
 
       val ~>> : int * Word.word -> int =
-	 fn _ => raise Fail "IntInf.~>>"
+         fn _ => raise Fail "IntInf.~>>"
    end'
 
 feature 'val _ = Real32.+' 'structure Real32 = Real64'
@@ -94,71 +96,71 @@
 structure LargeWord = Word'
 
 eval `$bin/platform`
-case $HOST_ARCH in
+case "$ARCH" in
 alpha)
-	arch='Alpha'
+        arch='Alpha'
 ;;
 amd64)
-	arch='AMD64'
+        arch='AMD64'
 ;;
 arm)
-	arch='ARM'
+        arch='ARM'
 ;;
 hppa)
-	arch='HPPA'
+        arch='HPPA'
 ;;
 ia64)
-	arch='IA64'
+        arch='IA64'
 ;;
 m68k)
-	arch='m68k'
+        arch='m68k'
 ;;
 mips)
-	arch='MIPS'
+        arch='MIPS'
 ;;
 powerpc)
-	arch='PowerPC'
+        arch='PowerPC'
 ;;
 s390)
-	arch='S390'
+        arch='S390'
 ;;
 sparc)
-	arch='Sparc'
+        arch='Sparc'
 ;;
 x86)
-	arch='X86'
+        arch='X86'
 ;;
 *)
-	die "strange HOST_ARCH: $HOST_ARCH"
+        die "strange HOST_ARCH: $HOST_ARCH"
 esac
 
-case $HOST_OS in
+case "$OS" in
 cygwin)
-	os='Cygwin'
+        os='Cygwin'
 ;;
 darwin)
-	os='Darwin'
+        os='Darwin'
 ;;
 freebsd)
-	os='FreeBSD'
+        os='FreeBSD'
 ;;
 linux)
-	os='Linux'
+        os='Linux'
 ;;
 mingw)
-	os='MinGW'
+        os='MinGW'
 ;;
 netbsd)
-	os='NetBSD'
+        os='NetBSD'
 ;;
 openbsd)
-	os='OpenBSD'
+        os='OpenBSD'
 ;;
 solaris)
-	os='Solaris'
+        os='Solaris'
 ;;
 *)
-	die "strange HOST_OS: $HOST_OS"
+        die "strange HOST_OS: $HOST_OS"
 ;;
 esac
 


Property changes on: mlton/branches/on-20050420-cmm-branch/bytecode
___________________________________________________________________
Name: svn:ignore
   - interpret
print-opcodes
   + interpret
print-opcodes


Deleted: mlton/branches/on-20050420-cmm-branch/bytecode/.cvsignore
===================================================================
--- mlton/branches/on-20050420-cmm-branch/bytecode/.cvsignore	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/bytecode/.cvsignore	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,2 +0,0 @@
-interpret
-print-opcodes

Copied: mlton/branches/on-20050420-cmm-branch/bytecode/.ignore (from rev 4358, mlton/trunk/bytecode/.ignore)

Modified: mlton/branches/on-20050420-cmm-branch/bytecode/Makefile
===================================================================
--- mlton/branches/on-20050420-cmm-branch/bytecode/Makefile	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/bytecode/Makefile	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,8 +1,25 @@
+## Copyright (C) 2004-2005 Henry Cejtin, Matthew Fluet, Suresh
+ #    Jagannathan, and Stephen Weeks.
+ #
+ # MLton is released under a BSD-style license.
+ # See the file MLton-LICENSE for details.
+ ##
+
+TARGET_ARCH = $(shell ../bin/host-arch)
+
 all: interpret.o interpret-gdb.o print-opcodes
 
-CC = gcc -std=c99
+CC = gcc -std=gnu99
 CFLAGS = -fomit-frame-pointer -I../runtime -I../include -Wall
 
+ifeq ($(TARGET_ARCH), amd64)
+CFLAGS += -mtune=opteron -m32 
+endif 
+
+ifeq ($(TARGET_OS), freebsd)
+CFLAGS += -I/usr/local/include
+endif
+
 interpret.o: interpret.c interpret.h opcode.h
 	$(CC) $(CFLAGS) -c -O2 interpret.c
 

Modified: mlton/branches/on-20050420-cmm-branch/bytecode/interpret.c
===================================================================
--- mlton/branches/on-20050420-cmm-branch/bytecode/interpret.c	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/bytecode/interpret.c	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,14 +1,18 @@
-#define _ISOC99_SOURCE
+/* Copyright (C) 2004-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ */
 
-#include <stdint.h>
+#include "platform.h"
 #include "interpret.h"
-#include "platform.h"
-#include "c-chunk.h"	// c-chunk.h must come before opcode.h because it
-			// redefines some opcode symbols
+#include "c-chunk.h"    // c-chunk.h must come before opcode.h because it
+                        // redefines some opcode symbols
 #include "opcode.h"
 
 enum {
-	DEBUG = FALSE,
+        DEBUG = FALSE,
 };
 
 typedef Word32 ArrayIndex;
@@ -29,11 +33,11 @@
 // Imports
 //----------------------------------------------------------------------
 
-#define regs(ty)				\
-	int ty##RegI;				\
-	extern ty global##ty[];			\
-	static ty ty##VReg[1000];		\
-	ty ty##Reg[1000]
+#define regs(ty)                                \
+        int ty##RegI;                           \
+        extern ty global##ty[];                 \
+        static ty ty##VReg[1000];               \
+        ty ty##Reg[1000]
 
 extern Pointer globalPointer[];
 extern Pointer globalPointerNonRoot[];
@@ -54,13 +58,13 @@
 
 #define R(ty, i) (ty##VReg [i])
 
-#define quotRem1(qr, size)						\
-	Word##size WordS##size##_##qr (Word##size w1, Word##size w2);
-#define quotRem2(qr)				\
-	quotRem1 (qr, 8)				\
-	quotRem1 (qr, 16)				\
-	quotRem1 (qr, 32)				\
-	quotRem1 (qr, 64)
+#define quotRem1(qr, size)                                              \
+        Word##size WordS##size##_##qr (Word##size w1, Word##size w2);
+#define quotRem2(qr)                            \
+        quotRem1 (qr, 8)                                \
+        quotRem1 (qr, 16)                               \
+        quotRem1 (qr, 32)                               \
+        quotRem1 (qr, 64)
 quotRem2 (quot)
 quotRem2 (rem)
 #undef quotRem1
@@ -68,408 +72,408 @@
 
 //----------------------------------------------------------------------
 
-#define Fetch(t, z)								\
-	do {									\
-		z = *(t*)pc;							\
-		if (DEBUG or disassemble) {					\
- 			if (#z == "label")					\
-				fprintf (stderr, " %s", offsetToLabel[z]);	\
-			else if (#z != "opc")					\
-				fprintf (stderr, " %d", (int)z);		\
-		}								\
- 		pc += sizeof (t);					\
-	} while (0)
+#define Fetch(t, z)                                                             \
+        do {                                                                    \
+                z = *(t*)pc;                                                    \
+                if (DEBUG or disassemble) {                                     \
+                        if (#z == "label")                                      \
+                                fprintf (stderr, " %s", offsetToLabel[z]);      \
+                        else if (#z != "opc")                                   \
+                                fprintf (stderr, " %d", (int)z);                \
+                }                                                               \
+                pc += sizeof (t);                                       \
+        } while (0)
 
 enum {
-	MODE_load,
-	MODE_store,
+        MODE_load,
+        MODE_store,
 };
 
 #define maybe unless (disassemble)
 
 #define StoreReg(t, z) maybe PushReg(t) = z
 
-#define loadStoreGen(mode, t, t2, z)		\
-	switch (MODE_##mode) {			\
-	case MODE_load:				\
-		StoreReg (t2, (t2)z);		\
-		break;				\
-	case MODE_store:			\
-		maybe z = (t) (PopReg (t2));	\
-		break;				\
-	}
+#define loadStoreGen(mode, t, t2, z)            \
+        switch (MODE_##mode) {                  \
+        case MODE_load:                         \
+                StoreReg (t2, (t2)z);           \
+                break;                          \
+        case MODE_store:                        \
+                maybe z = (t) (PopReg (t2));    \
+                break;                          \
+        }
 
 #define loadStore(mode, t, z)  loadStoreGen(mode, t, t, z)
 
-#define loadStoreArrayOffset(mode, ty)						\
-	case opcodeSymOfTy2 (ty, mode##ArrayOffset):				\
-	{									\
-		ArrayOffset arrayOffset;					\
-		Pointer base;							\
-		Word32 index;							\
-		Scale scale;							\
-		Fetch (ArrayOffset, arrayOffset);				\
-		Fetch (Scale, scale);						\
-		if (disassemble) goto mainLoop;					\
-		index = PopReg (Word32);					\
-		base = (Pointer) (PopReg (Word32));				\
-		loadStore (mode, ty,						\
-				*(ty*)(base + (index * scale) + arrayOffset));	\
-		goto mainLoop;							\
-	}
+#define loadStoreArrayOffset(mode, ty)                                          \
+        case opcodeSymOfTy2 (ty, mode##ArrayOffset):                            \
+        {                                                                       \
+                ArrayOffset arrayOffset;                                        \
+                Pointer base;                                                   \
+                Word32 index;                                                   \
+                Scale scale;                                                    \
+                Fetch (ArrayOffset, arrayOffset);                               \
+                Fetch (Scale, scale);                                           \
+                if (disassemble) goto mainLoop;                                 \
+                index = PopReg (Word32);                                        \
+                base = (Pointer) (PopReg (Word32));                             \
+                loadStore (mode, ty,                                            \
+                                *(ty*)(base + (index * scale) + arrayOffset));  \
+                goto mainLoop;                                                  \
+        }
 
-#define loadStoreContents(mode, ty)				\
-	case opcodeSymOfTy2 (ty, mode##Contents):		\
-		if (disassemble) goto mainLoop;			\
-	{							\
-		Pointer base = (Pointer) (PopReg (Word32));	\
-	        loadStore (mode, ty, C (ty, base));		\
-		goto mainLoop;					\
-	}
+#define loadStoreContents(mode, ty)                             \
+        case opcodeSymOfTy2 (ty, mode##Contents):               \
+                if (disassemble) goto mainLoop;                 \
+        {                                                       \
+                Pointer base = (Pointer) (PopReg (Word32));     \
+                loadStore (mode, ty, C (ty, base));             \
+                goto mainLoop;                                  \
+        }
 
-#define loadStoreFrontier(mode)					\
-	case opcodeSym (mode##Frontier):			\
-		if (disassemble) goto mainLoop;			\
-		loadStoreGen (mode, Pointer, Word32, Frontier);	\
-		goto mainLoop;
+#define loadStoreFrontier(mode)                                 \
+        case opcodeSym (mode##Frontier):                        \
+                if (disassemble) goto mainLoop;                 \
+                loadStoreGen (mode, Pointer, Word32, Frontier); \
+                goto mainLoop;
 
-#define loadGCState()					\
-	case opcodeSym (loadGCState):			\
-		if (disassemble) goto mainLoop;		\
-		StoreReg (Word32, (Word32)&gcState);	\
-		goto mainLoop;
+#define loadGCState()                                   \
+        case opcodeSym (loadGCState):                   \
+                if (disassemble) goto mainLoop;         \
+                StoreReg (Word32, (Word32)&gcState);    \
+                goto mainLoop;
 
-#define loadStoreGlobal(mode, ty, ty2)					\
-	case opcodeSymOfTy2 (ty, mode##Global):				\
-	{								\
-		GlobalIndex globalIndex;				\
-		Fetch (GlobalIndex, globalIndex);			\
-		if (disassemble) goto mainLoop;				\
-		loadStoreGen (mode, ty, ty2, G (ty, globalIndex));	\
-		goto mainLoop;						\
-	}
+#define loadStoreGlobal(mode, ty, ty2)                                  \
+        case opcodeSymOfTy2 (ty, mode##Global):                         \
+        {                                                               \
+                GlobalIndex globalIndex;                                \
+                Fetch (GlobalIndex, globalIndex);                       \
+                if (disassemble) goto mainLoop;                         \
+                loadStoreGen (mode, ty, ty2, G (ty, globalIndex));      \
+                goto mainLoop;                                          \
+        }
 
-#define loadStoreGPNR(mode)							\
-	case opcodeSym (mode##GPNR):						\
-	{									\
-		GlobalIndex globalIndex;					\
-		Fetch (GlobalIndex, globalIndex);				\
-		if (disassemble) goto mainLoop;					\
-		loadStoreGen (mode, Pointer, Word32, GPNR (globalIndex));	\
-		goto mainLoop;							\
-	}
+#define loadStoreGPNR(mode)                                                     \
+        case opcodeSym (mode##GPNR):                                            \
+        {                                                                       \
+                GlobalIndex globalIndex;                                        \
+                Fetch (GlobalIndex, globalIndex);                               \
+                if (disassemble) goto mainLoop;                                 \
+                loadStoreGen (mode, Pointer, Word32, GPNR (globalIndex));       \
+                goto mainLoop;                                                  \
+        }
 
-#define loadStoreOffset(mode, ty)					\
-	case opcodeSymOfTy2 (ty, mode##Offset):				\
-	{								\
-		Pointer base;						\
-		Offset offset;						\
-		Fetch (Offset, offset);					\
-		if (disassemble) goto mainLoop;				\
-		base = (Pointer) (PopReg (Word32));			\
-		maybe loadStore (mode, ty, O (ty, base, offset));	\
-		goto mainLoop;						\
-	}
+#define loadStoreOffset(mode, ty)                                       \
+        case opcodeSymOfTy2 (ty, mode##Offset):                         \
+        {                                                               \
+                Pointer base;                                           \
+                Offset offset;                                          \
+                Fetch (Offset, offset);                                 \
+                if (disassemble) goto mainLoop;                         \
+                base = (Pointer) (PopReg (Word32));                     \
+                maybe loadStore (mode, ty, O (ty, base, offset));       \
+                goto mainLoop;                                          \
+        }
 
-#define loadStoreRegister(mode, ty, ty2)			\
-	case opcodeSymOfTy2 (ty, mode##Register):		\
-	{							\
-		RegIndex regIndex;				\
-		Fetch (RegIndex, regIndex);			\
-		if (disassemble) goto mainLoop;			\
-		loadStoreGen (mode, ty, ty2, R (ty, regIndex));	\
-		goto mainLoop;					\
-	}
+#define loadStoreRegister(mode, ty, ty2)                        \
+        case opcodeSymOfTy2 (ty, mode##Register):               \
+        {                                                       \
+                RegIndex regIndex;                              \
+                Fetch (RegIndex, regIndex);                     \
+                if (disassemble) goto mainLoop;                 \
+                loadStoreGen (mode, ty, ty2, R (ty, regIndex)); \
+                goto mainLoop;                                  \
+        }
 
-#define loadStoreStackOffset(mode, ty)				\
-	case opcodeSymOfTy2 (ty, mode##StackOffset):		\
-	{							\
-		StackOffset stackOffset;			\
-		Fetch (StackOffset, stackOffset);		\
-		if (disassemble) goto mainLoop;			\
-		loadStore (mode, ty, S (ty, stackOffset));	\
-		goto mainLoop;					\
-	}
+#define loadStoreStackOffset(mode, ty)                          \
+        case opcodeSymOfTy2 (ty, mode##StackOffset):            \
+        {                                                       \
+                StackOffset stackOffset;                        \
+                Fetch (StackOffset, stackOffset);               \
+                if (disassemble) goto mainLoop;                 \
+                loadStore (mode, ty, S (ty, stackOffset));      \
+                goto mainLoop;                                  \
+        }
 
-#define loadStoreStackTop(mode)					\
-	case opcodeSym (mode##StackTop):			\
-		if (disassemble) goto mainLoop;			\
-		loadStoreGen (mode, Pointer, Word32, StackTop);	\
-		goto mainLoop;
+#define loadStoreStackTop(mode)                                 \
+        case opcodeSym (mode##StackTop):                        \
+                if (disassemble) goto mainLoop;                 \
+                loadStoreGen (mode, Pointer, Word32, StackTop); \
+                goto mainLoop;
 
-#define loadWord(size)					\
-	case opcodeSymOfTy (Word, size, loadWord):	\
-	{						\
-		Word##size t0;				\
-		Fetch (Word##size, t0);			\
-		if (disassemble) goto mainLoop;		\
-		loadStore (load, Word##size, t0);	\
-		goto mainLoop;				\
-	}
+#define loadWord(size)                                  \
+        case opcodeSymOfTy (Word, size, loadWord):      \
+        {                                               \
+                Word##size t0;                          \
+                Fetch (Word##size, t0);                 \
+                if (disassemble) goto mainLoop;         \
+                loadStore (load, Word##size, t0);       \
+                goto mainLoop;                          \
+        }
 
 #define opcode(ty, size, name) OPCODE_##ty##size##_##name
 
 #define coerceOp(f, t) OPCODE_##f##_to##t
 
-#define binary(ty, f)				\
-	case opcodeSym (f):			\
-		if (disassemble) goto mainLoop;	\
-	{					\
-		ty t0 = PopReg (ty);		\
-		ty t1 = PopReg (ty);		\
-		PushReg (ty) = f (t0, t1);	\
-		goto mainLoop;			\
-	}
+#define binary(ty, f)                           \
+        case opcodeSym (f):                     \
+                if (disassemble) goto mainLoop; \
+        {                                       \
+                ty t0 = PopReg (ty);            \
+                ty t1 = PopReg (ty);            \
+                PushReg (ty) = f (t0, t1);      \
+                goto mainLoop;                  \
+        }
 
 /* The bytecode interpreter relies on the fact that the overflow checking 
  * primitives implemented in c-chunk.h only set the result if the operation does
  * not overflow.  When the result overflow, the interpreter pushes a zero on
  * the stack for the result.
  */
-#define binaryCheck(ty, f)					\
-	case opcodeSym (f):					\
-		if (disassemble) goto mainLoop;			\
-	{							\
-		ty t0 = PopReg (ty);				\
-		ty t1 = PopReg (ty);				\
-		f (PushReg (ty), t0, t1, f##Overflow);		\
-		overflow = FALSE;				\
-		goto mainLoop;					\
-	f##Overflow:						\
- 		PushReg (ty) = 0; /* overflow, push 0 */	\
-		overflow = TRUE;				\
-		goto mainLoop;					\
-	}
+#define binaryCheck(ty, f)                                      \
+        case opcodeSym (f):                                     \
+                if (disassemble) goto mainLoop;                 \
+        {                                                       \
+                ty t0 = PopReg (ty);                            \
+                ty t1 = PopReg (ty);                            \
+                f (PushReg (ty), t0, t1, f##Overflow);          \
+                overflow = FALSE;                               \
+                goto mainLoop;                                  \
+        f##Overflow:                                            \
+                PushReg (ty) = 0; /* overflow, push 0 */        \
+                overflow = TRUE;                                \
+                goto mainLoop;                                  \
+        }
 
-#define unaryCheck(ty, f)					\
-	case opcodeSym (f):					\
-		if (disassemble) goto mainLoop;			\
-	{							\
-		ty t0 = PopReg (ty);				\
-		f (PushReg (ty), t0, f##Overflow);		\
-		overflow = FALSE;				\
-		goto mainLoop;					\
-	f##Overflow:						\
- 		PushReg (ty) = 0; /* overflow, push 0 */	\
-		overflow = TRUE;				\
-		goto mainLoop;					\
-	}
+#define unaryCheck(ty, f)                                       \
+        case opcodeSym (f):                                     \
+                if (disassemble) goto mainLoop;                 \
+        {                                                       \
+                ty t0 = PopReg (ty);                            \
+                f (PushReg (ty), t0, f##Overflow);              \
+                overflow = FALSE;                               \
+                goto mainLoop;                                  \
+        f##Overflow:                                            \
+                PushReg (ty) = 0; /* overflow, push 0 */        \
+                overflow = TRUE;                                \
+                goto mainLoop;                                  \
+        }
 
-#define coerce(f1, t1, f2, t2)				\
-	case coerceOp (f2, t2):				\
-		if (disassemble) goto mainLoop;		\
-	{						\
-		f1 t0 = PopReg (f1);			\
-		PushReg (t1) = f2##_to##t2 (t0);	\
-		goto mainLoop;				\
-	}
+#define coerce(f1, t1, f2, t2)                          \
+        case coerceOp (f2, t2):                         \
+                if (disassemble) goto mainLoop;         \
+        {                                               \
+                f1 t0 = PopReg (f1);                    \
+                PushReg (t1) = f2##_to##t2 (t0);        \
+                goto mainLoop;                          \
+        }
 
-#define compare(ty, f)				\
-	case opcodeSym (f):			\
-		if (disassemble) goto mainLoop;	\
-	{					\
-		ty t0 = PopReg (ty);		\
-		ty t1 = PopReg (ty);		\
-		PushReg (Word32) = f (t0, t1);	\
-		goto mainLoop;			\
-	}
+#define compare(ty, f)                          \
+        case opcodeSym (f):                     \
+                if (disassemble) goto mainLoop; \
+        {                                       \
+                ty t0 = PopReg (ty);            \
+                ty t1 = PopReg (ty);            \
+                PushReg (Word32) = f (t0, t1);  \
+                goto mainLoop;                  \
+        }
 
-#define shift(ty, f)				\
-	case opcodeSym (f):			\
-		if (disassemble) goto mainLoop;	\
-	{					\
-		ty w = PopReg (ty);		\
-		Word32 s = PopReg (Word32);	\
-		ty w2 = f (w, s);		\
-		PushReg (ty) = w2;		\
-		goto mainLoop;			\
-	}
+#define shift(ty, f)                            \
+        case opcodeSym (f):                     \
+                if (disassemble) goto mainLoop; \
+        {                                       \
+                ty w = PopReg (ty);             \
+                Word32 s = PopReg (Word32);     \
+                ty w2 = f (w, s);               \
+                PushReg (ty) = w2;              \
+                goto mainLoop;                  \
+        }
 
-#define unary(ty, f)				\
-	case opcodeSym (f):			\
-		if (disassemble) goto mainLoop;	\
-	{					\
-		ty t0 = PopReg (ty);		\
-		PushReg (ty) = f (t0);		\
-		goto mainLoop;			\
-	}
+#define unary(ty, f)                            \
+        case opcodeSym (f):                     \
+                if (disassemble) goto mainLoop; \
+        {                                       \
+                ty t0 = PopReg (ty);            \
+                PushReg (ty) = f (t0);          \
+                goto mainLoop;                  \
+        }
 
-#define Goto(l)					\
-	do {					\
-		maybe pc = code + l;		\
-		goto mainLoop;			\
-	} while (0)
+#define Goto(l)                                 \
+        do {                                    \
+                maybe pc = code + l;            \
+                goto mainLoop;                  \
+        } while (0)
 
-#define Switch(size)							\
-	case OPCODE_Switch##size:					\
-	{								\
-		Label label;						\
-		ProgramCounter lastCase;				\
-		Word##size test = 0;					\
-		Word16 numCases;					\
-									\
-		Fetch (Word16, numCases);				\
-		lastCase = pc + (4 + size/8) * numCases;		\
-		maybe test = PopReg (Word##size);			\
-		assertRegsEmpty ();					\
-		while (pc < lastCase) {					\
-			Word##size caseWord;				\
-			if (DEBUG or disassemble)			\
-				fprintf (stderr, "\n\t  ");		\
-			Fetch (Word##size, caseWord);			\
-			if (DEBUG or disassemble)			\
-				fprintf (stderr, " =>");		\
-			Fetch (Label, label);				\
-			if (not disassemble and test == caseWord)	\
-				Goto (label);				\
-		}							\
-		goto mainLoop;						\
-	}
+#define Switch(size)                                                    \
+        case OPCODE_Switch##size:                                       \
+        {                                                               \
+                Label label;                                            \
+                ProgramCounter lastCase;                                \
+                Word##size test = 0;                                    \
+                Word16 numCases;                                        \
+                                                                        \
+                Fetch (Word16, numCases);                               \
+                lastCase = pc + (4 + size/8) * numCases;                \
+                maybe test = PopReg (Word##size);                       \
+                assertRegsEmpty ();                                     \
+                while (pc < lastCase) {                                 \
+                        Word##size caseWord;                            \
+                        if (DEBUG or disassemble)                       \
+                                fprintf (stderr, "\n\t  ");             \
+                        Fetch (Word##size, caseWord);                   \
+                        if (DEBUG or disassemble)                       \
+                                fprintf (stderr, " =>");                \
+                        Fetch (Label, label);                           \
+                        if (not disassemble and test == caseWord)       \
+                                Goto (label);                           \
+                }                                                       \
+                goto mainLoop;                                          \
+        }
 
 typedef char *String;
 
-#define Cache()					\
-	do {					\
-		frontier = gcState.frontier;	\
-		stackTop = gcState.stackTop;	\
-	} while (0)
+#define Cache()                                 \
+        do {                                    \
+                frontier = gcState.frontier;    \
+                stackTop = gcState.stackTop;    \
+        } while (0)
 
-#define Flush()					\
-	do {					\
-		gcState.frontier = frontier;	\
-		gcState.stackTop = stackTop;	\
-	} while (0)
+#define Flush()                                 \
+        do {                                    \
+                gcState.frontier = frontier;    \
+                gcState.stackTop = stackTop;    \
+        } while (0)
 
 
-#define disp(ty)						\
-	for (i = 0; i < ty##RegI; ++i)				\
-		fprintf (stderr, "\n" #ty "Reg[%d] = 0x%08x",	\
-				i, (uint)(ty##Reg[i]));
+#define disp(ty)                                                \
+        for (i = 0; i < ty##RegI; ++i)                          \
+                fprintf (stderr, "\n" #ty "Reg[%d] = 0x%08x",   \
+                                i, (uint)(ty##Reg[i]));
 
 void displayRegs () {
-	int i;
+        int i;
 
-	disp (Word8);
-	disp (Word16);
-	disp (Word32);
-	disp (Word64);
-	disp (Real32);
-	disp (Real64);
+        disp (Word8);
+        disp (Word16);
+        disp (Word32);
+        disp (Word64);
+        disp (Real32);
+        disp (Real64);
 }
 
 static inline void interpret (Bytecode b, Word32 codeOffset, Bool disassemble) {
-	CallCIndex callCIndex;
-	Pointer code;
-	Pointer frontier;
-	int i;
-	String name;
-	String *offsetToLabel = NULL;
-	Opcode opc;
-	Bool overflow = FALSE;
-	ProgramCounter pc;
-	ProgramCounter pcMax;
-	StackTop stackTop;
+        CallCIndex callCIndex;
+        Pointer code;
+        Pointer frontier;
+        int i;
+        String name;
+        String *offsetToLabel = NULL;
+        Opcode opc;
+        Bool overflow = FALSE;
+        ProgramCounter pc;
+        ProgramCounter pcMax;
+        StackTop stackTop;
 
-	code = b->code;
-	pcMax = b->code + b->codeSize;
-	if (DEBUG or disassemble) {
-		ARRAY (String*, offsetToLabel, b->codeSize);
-		for (i = 0; i < b->nameOffsetsSize; ++i)
-			offsetToLabel [b->nameOffsets[i].codeOffset] =
-				b->addressNames + b->nameOffsets[i].nameOffset;
-	}
-	if (disassemble)
-		pc = code;
-	else {
-		pc = code + codeOffset;
-	}
-	Cache ();
+        code = b->code;
+        pcMax = b->code + b->codeSize;
+        if (DEBUG or disassemble) {
+                ARRAY (String*, offsetToLabel, b->codeSize);
+                for (i = 0; i < b->nameOffsetsSize; ++i)
+                        offsetToLabel [b->nameOffsets[i].codeOffset] =
+                                b->addressNames + b->nameOffsets[i].nameOffset;
+        }
+        if (disassemble)
+                pc = code;
+        else {
+                pc = code + codeOffset;
+        }
+        Cache ();
 mainLoop:
-	if (FALSE)
-		displayRegs ();
-	if (DEBUG or disassemble) {
-		if (pc == pcMax)
-			goto done;
-		name = offsetToLabel [pc - b->code];
-		unless (NULL == name)
-			fprintf (stderr, "\n%s:", name);
-		fprintf (stderr, "\n\t");
-	}
-	assert (code <= pc and pc < pcMax);
-	Fetch (Opcode, opc);
-	assert (opc < cardof (opcodeStrings));
-	if (DEBUG or disassemble)
-		fprintf (stderr, "%s", opcodeStrings[opc]);
-	switch (opc) {
-	prims ();
-	case opcodeSym (BranchIfZero):
-	{
-		Label label;
+        if (FALSE)
+                displayRegs ();
+        if (DEBUG or disassemble) {
+                if (pc == pcMax)
+                        goto done;
+                name = offsetToLabel [pc - b->code];
+                unless (NULL == name)
+                        fprintf (stderr, "\n%s:", name);
+                fprintf (stderr, "\n\t");
+        }
+        assert (code <= pc and pc < pcMax);
+        Fetch (Opcode, opc);
+        assert (opc < cardof (opcodeStrings));
+        if (DEBUG or disassemble)
+                fprintf (stderr, "%s", opcodeStrings[opc]);
+        switch (opc) {
+        prims ();
+        case opcodeSym (BranchIfZero):
+        {
+                Label label;
 
-		Fetch (Label, label);
-		if (disassemble) goto mainLoop;
-		if (0 == PopReg (Word32))
-			Goto (label);
-		goto mainLoop;
-	}
- 	case opcodeSym (CallC):
- 		Fetch (CallCIndex, callCIndex);
-		unless (disassemble) {
-			Flush ();
- 			MLton_callC (callCIndex);
-			Cache ();
-		}
-		goto mainLoop;
- 	case opcodeSym (Goto):
-	{
-		Label label;
-		Fetch (Label, label);
- 		Goto (label);
-	}
-	loadStoreGPNR(load);
-	loadStoreGPNR(store);
-	case opcodeSym (JumpOnOverflow):
-	{
-		Label label;
-		Fetch (Label, label);
-		if (overflow)
-			Goto (label);
-		goto mainLoop;
-	}
- 	case opcodeSym (ProfileLabel):
- 		die ("ProfileLabel not implemented");
- 	case opcodeSym (Raise):
-		maybe stackTop = gcState.stackBottom + gcState.exnStack;
-		// fall through to Return.
- 	case opcodeSym (Return):
-		Goto (*(Label*)(StackTop - sizeof (Label)));
-	Switch(8);
-	Switch(16);
-	Switch(32);
-	Switch(64);
- 	case opcodeSym (Thread_returnToC):
- 		maybe goto done;
-	}
-	assert (FALSE);
+                Fetch (Label, label);
+                if (disassemble) goto mainLoop;
+                if (0 == PopReg (Word32))
+                        Goto (label);
+                goto mainLoop;
+        }
+        case opcodeSym (CallC):
+                Fetch (CallCIndex, callCIndex);
+                unless (disassemble) {
+                        Flush ();
+                        MLton_callC (callCIndex);
+                        Cache ();
+                }
+                goto mainLoop;
+        case opcodeSym (Goto):
+        {
+                Label label;
+                Fetch (Label, label);
+                Goto (label);
+        }
+        loadStoreGPNR(load);
+        loadStoreGPNR(store);
+        case opcodeSym (JumpOnOverflow):
+        {
+                Label label;
+                Fetch (Label, label);
+                if (overflow)
+                        Goto (label);
+                goto mainLoop;
+        }
+        case opcodeSym (ProfileLabel):
+                die ("ProfileLabel not implemented");
+        case opcodeSym (Raise):
+                maybe stackTop = gcState.stackBottom + gcState.exnStack;
+                // fall through to Return.
+        case opcodeSym (Return):
+                Goto (*(Label*)(StackTop - sizeof (Label)));
+        Switch(8);
+        Switch(16);
+        Switch(32);
+        Switch(64);
+        case opcodeSym (Thread_returnToC):
+                maybe goto done;
+        }
+        assert (FALSE);
 done:
-	if (DEBUG or disassemble)
-		free (offsetToLabel);
-	return;
+        if (DEBUG or disassemble)
+                free (offsetToLabel);
+        return;
 }
 
 static void disassemble (Bytecode b, Word32 codeOffset) {
-	interpret (b, codeOffset, TRUE);
-	fprintf (stderr, "\n");
+        interpret (b, codeOffset, TRUE);
+        fprintf (stderr, "\n");
 }
 
 void MLton_Bytecode_interpret (Bytecode b, Word32 codeOffset) {
-	if (DEBUG) {
-		fprintf (stderr, "MLton_Bytecode_interpret (0x%08x, %u)\n",
-				(uint)b,
-				(uint)codeOffset);
-		disassemble (b, codeOffset);
-		fprintf (stderr, "interpret starting\n");
-	}
-	interpret (b, codeOffset, FALSE);
+        if (DEBUG) {
+                fprintf (stderr, "MLton_Bytecode_interpret (0x%08x, %u)\n",
+                                (uint)b,
+                                (uint)codeOffset);
+                disassemble (b, codeOffset);
+                fprintf (stderr, "interpret starting\n");
+        }
+        interpret (b, codeOffset, FALSE);
 }
 

Modified: mlton/branches/on-20050420-cmm-branch/bytecode/interpret.h
===================================================================
--- mlton/branches/on-20050420-cmm-branch/bytecode/interpret.h	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/bytecode/interpret.h	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,10 @@
+/* Copyright (C) 2004-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ */
+
 #ifndef _INTERPRET_H_
 #define _INTERPRET_H_
 
@@ -5,9 +12,9 @@
 #include "types.h"
 #include "assert.h"
 
-#define regs(ty)				\
-	extern int ty##RegI;			\
-	extern ty ty##Reg[]
+#define regs(ty)                                \
+        extern int ty##RegI;                    \
+        extern ty ty##Reg[]
 
 regs(Real32);
 regs(Real64);
@@ -18,27 +25,27 @@
 
 #undef regs
 
-#define assertRegsEmpty()			\
-	do {					\
-		assert (0 == Word8RegI);	\
-		assert (0 == Word16RegI);	\
-		assert (0 == Word32RegI);	\
-		assert (0 == Word64RegI);	\
-		assert (0 == Real32RegI);	\
-		assert (0 == Real64RegI);	\
-	} while (0)
+#define assertRegsEmpty()                       \
+        do {                                    \
+                assert (0 == Word8RegI);        \
+                assert (0 == Word16RegI);       \
+                assert (0 == Word32RegI);       \
+                assert (0 == Word64RegI);       \
+                assert (0 == Real32RegI);       \
+                assert (0 == Real64RegI);       \
+        } while (0)
 
 struct NameOffsets {
-	Word32 codeOffset;  // An offset into code.
-	Word32 nameOffset;  // An offset into addressNames.
+        Word32 codeOffset;  // An offset into code.
+        Word32 nameOffset;  // An offset into addressNames.
 };
 
 typedef struct Bytecode {
-	char *addressNames;
-	Pointer code;
-	Word32 codeSize;
-	struct NameOffsets *nameOffsets;
-	Word32 nameOffsetsSize;
+        char *addressNames;
+        Pointer code;
+        Word32 codeSize;
+        struct NameOffsets *nameOffsets;
+        Word32 nameOffsetsSize;
 } *Bytecode;
 
 #define PopReg(ty) (assert (ty##RegI > 0), ty##Reg [--ty##RegI])

Modified: mlton/branches/on-20050420-cmm-branch/bytecode/opcode.h
===================================================================
--- mlton/branches/on-20050420-cmm-branch/bytecode/opcode.h	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/bytecode/opcode.h	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,127 +1,134 @@
+/* Copyright (C) 2004-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ */
+
 #ifndef _OPCODE_H_
 #define _OPCODE_H_
 
-#define coercePrims()					\
-	coerce (Real32, Real64, Real32, Real64)		\
-	coerce (Real32, Word32, Real32, WordS32)	\
-	coerce (Real64, Real32, Real64, Real32)		\
-	coerce (Real64, Word32, Real64, WordS32)	\
-	coerce (Word16, Real32, WordS16, Real32)	\
-	coerce (Word16, Real64, WordS16, Real64)	\
-	coerce (Word16, Word32, WordS16, Word32)	\
-	coerce (Word16, Word64, WordS16, Word64)	\
-	coerce (Word32, Real32, WordS32, Real32)	\
-	coerce (Word32, Real64, WordS32, Real64)	\
-	coerce (Word32, Word64, WordS32, Word64)	\
-	coerce (Word8, Real32, WordS8, Real32)		\
-	coerce (Word8, Real64, WordS8, Real64)		\
-	coerce (Word8, Word16, WordS8, Word16)		\
-	coerce (Word8, Word32, WordS8, Word32)		\
-	coerce (Word8, Word64, WordS8, Word64)		\
-	coerce (Word16, Word32, WordU16, Word32)	\
-	coerce (Word16, Word64, WordU16, Word64)	\
-	coerce (Word16, Word8, WordU16, Word8)		\
-	coerce (Word32, Word16, WordU32, Word16)	\
-	coerce (Word32, Word64, WordU32, Word64)	\
-	coerce (Word32, Word8, WordU32, Word8)		\
-	coerce (Word64, Word16, WordU64, Word16)	\
-	coerce (Word64, Word32, WordU64, Word32)	\
-	coerce (Word64, Word8, WordU64, Word8)		\
-	coerce (Word8, Word16, WordU8, Word16)		\
-	coerce (Word8, Word32, WordU8, Word32)		\
-	coerce (Word8, Word64, WordU8, Word64)
+#define coercePrims()                                   \
+        coerce (Real32, Real64, Real32, Real64)         \
+        coerce (Real32, Word32, Real32, WordS32)        \
+        coerce (Real64, Real32, Real64, Real32)         \
+        coerce (Real64, Word32, Real64, WordS32)        \
+        coerce (Word16, Real32, WordS16, Real32)        \
+        coerce (Word16, Real64, WordS16, Real64)        \
+        coerce (Word16, Word32, WordS16, Word32)        \
+        coerce (Word16, Word64, WordS16, Word64)        \
+        coerce (Word32, Real32, WordS32, Real32)        \
+        coerce (Word32, Real64, WordS32, Real64)        \
+        coerce (Word32, Word64, WordS32, Word64)        \
+        coerce (Word8, Real32, WordS8, Real32)          \
+        coerce (Word8, Real64, WordS8, Real64)          \
+        coerce (Word8, Word16, WordS8, Word16)          \
+        coerce (Word8, Word32, WordS8, Word32)          \
+        coerce (Word8, Word64, WordS8, Word64)          \
+        coerce (Word16, Word32, WordU16, Word32)        \
+        coerce (Word16, Word64, WordU16, Word64)        \
+        coerce (Word16, Word8, WordU16, Word8)          \
+        coerce (Word32, Word16, WordU32, Word16)        \
+        coerce (Word32, Word64, WordU32, Word64)        \
+        coerce (Word32, Word8, WordU32, Word8)          \
+        coerce (Word64, Word16, WordU64, Word16)        \
+        coerce (Word64, Word32, WordU64, Word32)        \
+        coerce (Word64, Word8, WordU64, Word8)          \
+        coerce (Word8, Word16, WordU8, Word16)          \
+        coerce (Word8, Word32, WordU8, Word32)          \
+        coerce (Word8, Word64, WordU8, Word64)
 
-#define loadStorePrimsOfTy(mode, ty)		\
-	loadStoreArrayOffset (mode, ty)		\
-	loadStoreContents (mode, ty)		\
-	loadStoreGlobal (mode, ty, ty)		\
-	loadStoreOffset (mode, ty)		\
-	loadStoreRegister (mode, ty, ty)		\
-	loadStoreStackOffset (mode, ty)
+#define loadStorePrimsOfTy(mode, ty)            \
+        loadStoreArrayOffset (mode, ty)         \
+        loadStoreContents (mode, ty)            \
+        loadStoreGlobal (mode, ty, ty)          \
+        loadStoreOffset (mode, ty)              \
+        loadStoreRegister (mode, ty, ty)                \
+        loadStoreStackOffset (mode, ty)
 
-#define loadStorePrims(mode)				\
-	loadStorePrimsOfTy (mode, Real32)		\
-	loadStorePrimsOfTy (mode, Real64)		\
-	loadStorePrimsOfTy (mode, Word8)		\
-	loadStorePrimsOfTy (mode, Word16)		\
-	loadStorePrimsOfTy (mode, Word32)		\
-	loadStorePrimsOfTy (mode, Word64)		\
-	loadStoreGlobal (mode, Pointer, Word32)		\
-	loadStoreRegister (mode, Pointer, Word32)	\
-	loadStoreFrontier (mode)			\
-	loadStoreStackTop (mode)
+#define loadStorePrims(mode)                            \
+        loadStorePrimsOfTy (mode, Real32)               \
+        loadStorePrimsOfTy (mode, Real64)               \
+        loadStorePrimsOfTy (mode, Word8)                \
+        loadStorePrimsOfTy (mode, Word16)               \
+        loadStorePrimsOfTy (mode, Word32)               \
+        loadStorePrimsOfTy (mode, Word64)               \
+        loadStoreGlobal (mode, Pointer, Word32)         \
+        loadStoreRegister (mode, Pointer, Word32)       \
+        loadStoreFrontier (mode)                        \
+        loadStoreStackTop (mode)
 
-#define realPrimsOfSize(size)				\
-	binary (Real##size, Real##size##_add)		\
-	binary (Real##size, Real##size##_div)		\
-	compare (Real##size, Real##size##_equal)	\
-	compare (Real##size, Real##size##_le)		\
-	compare (Real##size, Real##size##_lt)		\
-	binary (Real##size, Real##size##_mul)		\
-	unary (Real##size, Real##size##_neg)		\
-	unary (Real##size, Real##size##_round)		\
-	binary (Real##size, Real##size##_sub)
+#define realPrimsOfSize(size)                           \
+        binary (Real##size, Real##size##_add)           \
+        binary (Real##size, Real##size##_div)           \
+        compare (Real##size, Real##size##_equal)        \
+        compare (Real##size, Real##size##_le)           \
+        compare (Real##size, Real##size##_lt)           \
+        binary (Real##size, Real##size##_mul)           \
+        unary (Real##size, Real##size##_neg)            \
+        unary (Real##size, Real##size##_round)          \
+        binary (Real##size, Real##size##_sub)
 
-#define wordPrimsOfSizeNoMul(size)			\
-	binary (Word##size, Word##size##_add)		\
-	binary (Word##size, Word##size##_andb)		\
-	compare (Word##size, Word##size##_equal)	\
-	compare (Word##size, WordS##size##_lt)		\
-	compare (Word##size, WordU##size##_lt)		\
-	shift (Word##size, Word##size##_lshift)		\
-	binary (Word##size, WordS##size##_mul)		\
-	binary (Word##size, WordU##size##_mul)		\
-	unary (Word##size, Word##size##_neg)		\
-	unary (Word##size, Word##size##_notb)		\
-	binary (Word##size, Word##size##_orb)		\
-	binary (Word##size, WordS##size##_quot)		\
-	binary (Word##size, WordU##size##_quot)		\
-	binary (Word##size, WordS##size##_rem)		\
-	binary (Word##size, WordU##size##_rem)		\
-	shift (Word##size, Word##size##_rol)		\
-	shift (Word##size, Word##size##_ror)		\
-	shift (Word##size, WordS##size##_rshift)	\
-	shift (Word##size, WordU##size##_rshift)	\
-	binary (Word##size, Word##size##_sub)		\
-	binary (Word##size, Word##size##_xorb)		\
-	binaryCheck (Word##size, WordS##size##_addCheck)	\
-	binaryCheck (Word##size, WordU##size##_addCheck)	\
-	unaryCheck (Word##size, Word##size##_negCheck)		\
-	binaryCheck (Word##size, WordS##size##_subCheck)	\
-	loadWord (size)
+#define wordPrimsOfSizeNoMul(size)                      \
+        binary (Word##size, Word##size##_add)           \
+        binary (Word##size, Word##size##_andb)          \
+        compare (Word##size, Word##size##_equal)        \
+        compare (Word##size, WordS##size##_lt)          \
+        compare (Word##size, WordU##size##_lt)          \
+        shift (Word##size, Word##size##_lshift)         \
+        binary (Word##size, WordS##size##_mul)          \
+        binary (Word##size, WordU##size##_mul)          \
+        unary (Word##size, Word##size##_neg)            \
+        unary (Word##size, Word##size##_notb)           \
+        binary (Word##size, Word##size##_orb)           \
+        binary (Word##size, WordS##size##_quot)         \
+        binary (Word##size, WordU##size##_quot)         \
+        binary (Word##size, WordS##size##_rem)          \
+        binary (Word##size, WordU##size##_rem)          \
+        shift (Word##size, Word##size##_rol)            \
+        shift (Word##size, Word##size##_ror)            \
+        shift (Word##size, WordS##size##_rshift)        \
+        shift (Word##size, WordU##size##_rshift)        \
+        binary (Word##size, Word##size##_sub)           \
+        binary (Word##size, Word##size##_xorb)          \
+        binaryCheck (Word##size, WordS##size##_addCheck)        \
+        binaryCheck (Word##size, WordU##size##_addCheck)        \
+        unaryCheck (Word##size, Word##size##_negCheck)          \
+        binaryCheck (Word##size, WordS##size##_subCheck)        \
+        loadWord (size)
 
-#define wordPrimsOfSize(size)					\
-	wordPrimsOfSizeNoMul(size)				\
-	binaryCheck (Word##size, WordS##size##_mulCheck)	\
-	binaryCheck (Word##size, WordU##size##_mulCheck)	\
+#define wordPrimsOfSize(size)                                   \
+        wordPrimsOfSizeNoMul(size)                              \
+        binaryCheck (Word##size, WordS##size##_mulCheck)        \
+        binaryCheck (Word##size, WordU##size##_mulCheck)        \
 
-#define prims()						\
-	coercePrims ()					\
-	loadGCState ()					\
-	loadStorePrims (load)				\
-	loadStorePrims (store)				\
-	realPrimsOfSize (32)				\
-	realPrimsOfSize (64)				\
-	wordPrimsOfSize (8)				\
-	wordPrimsOfSize (16)				\
-	wordPrimsOfSize (32)				\
-	wordPrimsOfSizeNoMul (64)
+#define prims()                                         \
+        coercePrims ()                                  \
+        loadGCState ()                                  \
+        loadStorePrims (load)                           \
+        loadStorePrims (store)                          \
+        realPrimsOfSize (32)                            \
+        realPrimsOfSize (64)                            \
+        wordPrimsOfSize (8)                             \
+        wordPrimsOfSize (16)                            \
+        wordPrimsOfSize (32)                            \
+        wordPrimsOfSizeNoMul (64)
 
-#define opcodes()				\
-	prims()					\
-	opcodeGen (BranchIfZero)		\
-	opcodeGen (CallC)			\
-	opcodeGen (Goto)			\
-	opcodeGen (loadGPNR)			\
-	opcodeGen (storeGPNR)			\
-	opcodeGen (JumpOnOverflow)		\
-	opcodeGen (ProfileLabel)		\
-	opcodeGen (Raise)			\
-	opcodeGen (Return)			\
-	opcodeGen (Switch8)			\
-	opcodeGen (Switch16)			\
-	opcodeGen (Switch32)			\
-	opcodeGen (Switch64)			\
+#define opcodes()                               \
+        prims()                                 \
+        opcodeGen (BranchIfZero)                \
+        opcodeGen (CallC)                       \
+        opcodeGen (Goto)                        \
+        opcodeGen (loadGPNR)                    \
+        opcodeGen (storeGPNR)                   \
+        opcodeGen (JumpOnOverflow)              \
+        opcodeGen (ProfileLabel)                \
+        opcodeGen (Raise)                       \
+        opcodeGen (Return)                      \
+        opcodeGen (Switch8)                     \
+        opcodeGen (Switch16)                    \
+        opcodeGen (Switch32)                    \
+        opcodeGen (Switch64)                    \
         opcodeGen (Thread_returnToC)
 
 #define opcodeSym(z)  OPCODE_##z
@@ -134,13 +141,13 @@
 #define binaryCheck(ty, f)  opcodeGen (f)
 #define compare(ty, f)  opcodeGen (f)
 #define loadStoreArrayOffset(mode, ty)  opcodeName2 (ty, mode##ArrayOffset)
-#define	loadStoreContents(mode, ty)  opcodeName2 (ty, mode##Contents)
+#define loadStoreContents(mode, ty)  opcodeName2 (ty, mode##Contents)
 #define loadStoreFrontier(mode) opcodeGen (mode##Frontier)
 #define loadGCState() opcodeGen (loadGCState)
-#define	loadStoreGlobal(mode, ty, ty2)  opcodeName2 (ty, mode##Global)
-#define	loadStoreOffset(mode, ty)  opcodeName2 (ty, mode##Offset)
-#define	loadStoreRegister(mode, ty, ty2)  opcodeName2 (ty, mode##Register)
-#define	loadStoreStackOffset(mode, ty)  opcodeName2 (ty, mode##StackOffset)
+#define loadStoreGlobal(mode, ty, ty2)  opcodeName2 (ty, mode##Global)
+#define loadStoreOffset(mode, ty)  opcodeName2 (ty, mode##Offset)
+#define loadStoreRegister(mode, ty, ty2)  opcodeName2 (ty, mode##Register)
+#define loadStoreStackOffset(mode, ty)  opcodeName2 (ty, mode##StackOffset)
 #define loadStoreStackTop(mode)  opcodeGen (mode##StackTop)
 #define loadWord(size)  opcodeName (Word, size, loadWord)
 #define shift(ty, f)  opcodeGen (f)
@@ -156,7 +163,7 @@
 #define opcodeGen(z)  #z,
 
 char *opcodeStrings [] = {
-	opcodes ()
+        opcodes ()
 };
 
 #undef opcodeGen
@@ -166,7 +173,7 @@
 #define opcodeGen(z) opcodeSym (z),
 
 enum {
-	opcodes ()
+        opcodes ()
 };
 
 typedef Word8 Opcode;

Modified: mlton/branches/on-20050420-cmm-branch/bytecode/print-opcodes.c
===================================================================
--- mlton/branches/on-20050420-cmm-branch/bytecode/print-opcodes.c	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/bytecode/print-opcodes.c	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,16 +1,21 @@
-#define _ISOC99_SOURCE
+/* Copyright (C) 2004-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ */
 
+#include "platform.h"
 #include <stdio.h>
-#include "platform.h"
 #include "opcode.h"
 
 int main () {
-	Opcode opc;
-	int i;
+        Opcode opc;
+        int i;
 
-	unless (cardof (opcodeStrings) < (1 << (8 * sizeof (opc))))
-		die ("too many opcodes\n");
-	for (i = 0; i < cardof (opcodeStrings); ++i)
-		fprintf (stdout, "%s\n", opcodeStrings[i]);
-	return 0;
+        unless (cardof (opcodeStrings) < (1 << (8 * sizeof (opc))))
+                die ("too many opcodes\n");
+        for (i = 0; i < cardof (opcodeStrings); ++i)
+                fprintf (stdout, "%s\n", opcodeStrings[i]);
+        return 0;
 }

Modified: mlton/branches/on-20050420-cmm-branch/doc/README
===================================================================
--- mlton/branches/on-20050420-cmm-branch/doc/README	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/doc/README	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,41 +1,58 @@
 MLton is a whole-program optimizing compiler for the Standard ML
-programming language. MLton has the following features.
+programming language.  MLton has the following features.
 
-   + Runs on a variety of platforms.
-     o X86: Linux, Cygwin/Windows, FreeBSD, and NetBSD.
-     o Sparc: Solaris.
-   + Generates standalone executables with excellent running times.
-   + Supports the full SML 97 language.
-   + A complete basis library matching the latest specification.
-   + Untagged native integers and words.
-   + Unboxed reals.
-   + Unboxed arrays
-   + Fast C FFI for calling from SML to C and from C to SML.
-   + Source-level profiling of both time and allocation.
-   + Multiple garbage collection strategies.
-   + Support for large amounts of memory (up to 4G), large arrays (up
-     to 2G elements), and large files (using 64-bit integers for file
-     positions).
-   + Fast IntInf based on the GNU multiprecision library (gmp).
-   + Libraries for C pointers, continuations, interval timers, random
-       numbers, resource limits, resource usage, signal handlers,
-       system logging, threads, and heap save and restore.
+  + Portability.  
+   MLton runs on the following platforms.
+   o HPPA: Debian.
+   o PowerPC: Debian, Mac OSX.
+   o X86: Linux, Cygwin/Windows, FreeBSD, MinGW/Windows, NetBSD, OpenBSD.
+   o Sparc: Debian, Solaris.
+  + Robustness.
+   o Supports the full SML 97 language.
+   o Follows the Definition of SML closely.
+   o Has a complete implementation of the Basis Library.
+   o Generates standalone executables.
+   o Compiles large programs (hundreds of thousands of lines).
+   o Supports large amounts of memory (up to 4G).
+   o Supports large arrays (up to 2G elements).
+   o Supports large files (using 64-bit integers for file positions).
+  + Performance.
+   o Executables with excellent running times.
+   o Untagged and unboxed native integers and words.
+   o Unboxed reals.
+   o Unboxed arrays.
+   o Multiple garbage collection strategies.
+   o Fast arbitrary-precision arithmetic based on the GnuMP.
+  + Tools.
+   o Source-level profiler for both time and allocation.
+   o Lexer generator.
+   o Parser generator.
+   o ML-NLFFIGEN.
+  + Extensions.
+   o Fast C FFI for calling from SML to C and from C to SML.
+   o ML Basis system for programming in the very large.
+   o Libraries for C pointers, continuations, interval timers, random
+      numbers, resource limits, resource usage, signal handlers,
+      system logging, threads, and heap save and restore.
 
 For more information, go to the MLton home page. 
 
-	http://www.mlton.org/
+        http://mlton.org/
 
-For general MLton discussion, send mail to MLton-user@mlton.org.  To
-send mail to the MLton developers, use MLton@mlton.org.
+There are two mailing lists available.
 
+ * MLton@mlton.org        MLton developers
+ * MLton-user@mlton.org   MLton user community 
+
 doc directory contents:
-	README			this file
-	changelog		changelog
-	cm2mlb/			a utility for producing ML Basis programs in SML/NJ
-	cmcat/			a utility for producing whole programs in SML/NJ
-	examples/		example SML programs
-	license/		license information
-	mllex.ps.gz		user guide for mllex lexer generator
-	mlyacc.ps.gz		user guide for mlyacc parser generator
-	user-guide/		html user guide
-	user-guide.ps.gz	user guide for MLton
+        README                  this file
+        changelog               changelog
+        cm2mlb/                 a utility for producing ML Basis programs in SML/NJ
+        cmcat/                  a utility for producing whole programs in SML/NJ
+        examples/               example SML programs
+	guide/			HTML MLton guide (copy of the MLton wiki)
+        license/                license information
+        mllex.ps.gz             user guide for mllex lexer generator
+	mlton-guide.pdf		PDF version of MLton guide
+        mlyacc.ps.gz            user guide for mlyacc parser generator
+

Modified: mlton/branches/on-20050420-cmm-branch/doc/changelog
===================================================================
--- mlton/branches/on-20050420-cmm-branch/doc/changelog	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/doc/changelog	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,5 +1,171 @@
-Here are the changes since version 20041109.
+Here are the changes from version 20041109 to version 20051202.
 
+Summary:
+  + New license: BSD-style instead of GPL.
+  + New platforms:
+   o hppa: Debian Linux.
+   o x86: MinGW.
+  + Compiler.
+   o improved exception history.
+   o Command-line switches.
+    * Added: -as-opt, -mlb-path-map, -target-as-opt, -target-cc-opt.
+    * Deprecated: none.
+    * Removed: -native, -sequence-unit, -warn-match, -warn-unused.
+  + Language.
+   o FFI syntax changes and extensions.
+    * Added: _symbol.
+    * Changed: _export, _import.
+    * Removed: _ffi.
+   o ML Basis annotations.
+    * Added: allowFFI, nonexhaustiveExnMatch, nonexhaustiveMatch,
+        redundantMatch, sequenceNonUnit.
+    * Deprecated: allowExport, allowImport, sequenceUnit, warnMatch.
+  + Libraries.
+   o Basis Library.
+    * Added: Int1, Word1.
+   o MLton structure.
+    * Added: Process.create, ProcEnv.setgroups, Rusage.measureGC, 
+        Socket.fdToSock Socket.Ctl.getError.
+    * Changed: MLton.Platform.Arch.
+   o Other libraries.
+    * Added: ckit library, ML-NLFFI library, SML/NJ library.
+  + Tools.
+   o updates of mllex and mlyacc from SML/NJ.
+   o added mlnlffigen.
+   o profiling supports better inclusion/exclusion of code.
+
+* 2005-11-19
+  - Updated SML/NJ Library and CKit Library from SML/NJ 110.57.
+
+* 2005-11-15
+  - Fixed a bug in MLton.ProcEnv.setgroups.
+
+* 2005-11-11
+  - Fixed a bug in the interleaving of lexing/parsing and elaborating of
+    ML Basis files, which would raise an unhandled Force exception on
+    cyclic basis references.  Thanks to John Dias for the bug report.
+
+* 2005-11-10
+  - Fixed two bugs in Time.scan.  One would raise Time on a string with a
+    large fractional component.  Thanks to Carsten Varming for the bug
+    report.  The other failed to scan strings with an explicit sign
+    followed by a decimal point.
+
+* 2005-11-03
+  - Removed MLton.GC.setRusage.
+  - Added MLton.Rusage.measureGC.
+
+* 2005-09-11
+  - Fixed bug in display of types with large numbers of type
+    variables, which could cause unhandled exception Chr.
+
+* 2005-09-08
+  - Fixed bug in type inference of flexible records that would show up
+    as "Type error: variable applied to wrong number of type args"
+
+* 2005-09-06
+  - Fixed bug in Real.signBit, which had assumed that the underlying
+    C signbit returned 0 or 1, when in fact any nonzero value is
+    allowed to indicate the signbit is set.
+
+* 2005-09-05
+  - Added -mlb-path-map switch.
+
+* 2005-08-25
+  - Fixed bug in MLton.Finalizable.touch, which was not keeping alive
+    finalizable values in all cases.
+
+* 2005-08-18
+  - Added SML/NJ Library and CKit Library from SML/NJ 110.55 to 
+    standard distribution.
+  - Fixed bug in Socket.Ctl.*, which got the endianness wrong on
+    big-endian machines.  Thanks to Wesley Terpstra for the bug report
+    and fix.
+  - Added MLton.GC.setRusage.
+  - Fixed bug in mllex, which had file positions starting at 2.  They
+    now start at zero.
+
+* 2005-08-15
+  - Fixed bug in LargeInt.scan, which should skip leading "0x" and
+    "0X".  Thanks to Wesley Terpstra for the bug report and fix.
+
+* 2005-08-06
+  - Additional revisions of FFI.
+    Deprecated _export with incomplete annotation.
+    Added _address for address of C objects.
+    Eliminated address component of _symbol.
+    Changed the type of the _symbol* expression.
+    See documentation for more detail.
+
+* 2005-08-06
+  - Annotation changes.
+    Deprecated: sequenceUnit
+    Added: sequenceNonUnit
+
+* 2005-08-03
+  - Annotation changes.
+    Deprecated: allowExport, allowImport, warnMatch
+    Added: allowFFI, nonexhaustiveExnMatch, nonexhaustiveMatch, 
+      redundantMatch
+        
+* 2005-08-01
+  - Update mllex and mlyacc with SML/NJ 110.55+ versions.  This 
+    incorporates a small number of minor bug fixes.
+
+* 2005-07-23
+  - Fixed bug in pass to flatten refs into containing data structure.
+        
+* 2005-07-23
+  - Overhaul of FFI.
+    Deprecated _import of C base types.
+    Added _symbol for address, getter, and setter of C base types.
+    See documentation for more detail.
+        
+* 2005-07-21
+  - Update mllex and mlyacc with SML/NJ 110.55 versions.  This 
+    incorporates a small number of minor bug fixes.
+        
+* 2005-07-20
+  - Fixed bug in front end that allowed unary constructors to be used
+    without an argument in patterns.
+
+* 2005-07-19
+  - Eliminated _ffi, which has been deprecated for some time.
+
+* 2005-07-14
+  - Fixed bug in runtime that caused getrusage to be called on every
+    GC, even if timing info isn't needed.
+
+* 2005-07-13
+  - Fixed bug in closure conversion tickled by making a weak pointer
+    to a closure.
+
+* 2005-07-12
+  - Changed {OS,Posix}.Process.sleep to call nanosleep() instead of
+    sleep().
+  - Added MLton.ProcEnv.setgroups.
+
+* 2005-07-11
+  - InetSock.{any,toAddr} raise SysErr if port is not in [0, 2^16).
+
+* 2005-07-02
+  - Fixed bug in Socket.recvVecFrom{,',NB,NB'}.  The type was too 
+    polymorphic and allowed the creation of a bogus sock_addr.
+
+* 2005-06-28
+  - The front end now reports errors on encountering undefined or
+    cyclicly defined MLB path variables.
+
+* 2005-05-22
+  - Fixed bug in Posix.IO.{getlk,setlk,setlkw} that caused a link-time
+    error: undefined reference to Posix_IO_FLock_typ.
+  - Improved exception history so that the first entry in the history
+    is the source position of the raise, and the rest is the call
+    stack.
+
+* 2005-05-19
+  - Improved exception history for Overflow exceptions.
+
 * 2005-04-20
   - Fixed a bug in pass to flatten refs into containing data structure.
 
@@ -30,6 +196,13 @@
 * 2005-02-26
   - Fixed an off-by-one error in mkstemp defined in mingw.c.
 
+* 2005-02-13
+  - Added mlnlffigen tool (heavily adapted from SML/NJ).
+
+* 2005-02-12
+  - Added MLNLFFI Library (heavily adapted from SML/NJ) to standard 
+    distribution.
+
 * 2005-02-04
   - Fixed a bug in OS.path.toString, which did not raise InvalidArc
     when needed.
@@ -104,7 +277,7 @@
 
 * 2004-09-22
   - Extended _import to support indirect function calls.
-	
+        
 * 2004-09-13
   - Made Date.{fromString,scan} accept a space (treated as zero) in
     the first character of the day of the month.
@@ -131,7 +304,7 @@
 * 2004-08-18
   - Changed MLton.{Thread,Signal,World} to distinguish between 
     implicitly and explicitly paused threads.
-	
+        
 * 2004-07-28
   - Added support for programming in the large using the ML Basis
     system.
@@ -168,7 +341,7 @@
 * 2004-05-17
   - Automatically restart functions in the Basis Library that correspond
     directly to interruptable system calls.
-	
+        
 * 2004-05-13
   - Added -profile count, for dynamic counts of function calls and branches.
   - Equate the types Posix.Signal.signal and Unix.signal.
@@ -186,7 +359,7 @@
 
 * 2004-04-30
   - Added MLton.Signal.{handled,restart}.
-	
+        
 * 2004-04-23
   - Added Timer.checkCPUTimes, and updated the Timer structure to
     match the latest basis spec.  Also fixed totalCPUTimer and
@@ -194,7 +367,7 @@
 
 * 2004-04-13
   - Added MLton.Signal.Mask.{getBlocked,isMember}.
-	
+        
 * 2004-04-12
   - Fix bug that mistakenly generalized variable types containing
     unknown types when matching against a signature.
@@ -507,7 +680,7 @@
 * 2003-06-25
   - Added {Int{8,16},Word8}{,Array,ArraySlice,Vector,VectorSlice,Array2}
     structures.
-	
+        
 * 2003-06-25
   - Fixed bug in IntInf.sign, which returned the wrong value for zero.
 
@@ -516,9 +689,9 @@
 
 * 2003-06-18
   - Regularization of options.
-	-diag --> -diag-pass
-	-drop-pass takes a regexp
-	
+        -diag --> -diag-pass
+        -drop-pass takes a regexp
+        
 * 2003-06-06
   - Fixed bug in OS.IO.poll that caused it to return the input event
     types polled for instead of what was actually available.
@@ -526,13 +699,13 @@
 * 2003-06-04
   - Fixed bug in known case SSA optimization that could case incorrect 
     results in compiled programs.
-	
+        
 * 2003-06-03
   - Fixed bug in SSA optimizer that could cause the error message
-	Type error: Type.equals
-	{from = char vector, to = unit vector}
-	Type error: analyze raised exception loopStatement: ...
-	unhandled exception: TypeError
+        Type error: Type.equals
+        {from = char vector, to = unit vector}
+        Type error: analyze raised exception loopStatement: ...
+        unhandled exception: TypeError
 
 * 2003-06-02
   - Fixed Real.rem to work correctly on infs and nans.
@@ -585,7 +758,7 @@
   - Fixed bug in HashType that raised "Vector.forall2" when the 
     arity of a type constructor is changed by simplifyTypes, but
     a newly constructed type has the same hash value.
-	
+        
 * 2003-05-02
   - Switched over to new layered IO implementation, which completes
     the implementation of the BinIO and TextIO modules.
@@ -594,7 +767,7 @@
   - Fixed bug that caused an assertion failure when generating a jump 
     table for a case dispatch on a non-word sized index with non-zero
     lower bound on the range.
-	
+        
 * 2003-04-24
   - Added -align {4|8}, which controls alignment of objects.  With
     -align 8, memory accesses to doubles are guaranteed to be aligned
@@ -641,21 +814,21 @@
 
 * 2003-02-11
   - Regularization of options.
-	-l --> -link
-	-L --> -lib-search
-	-o --> -output
-	-v --> -verbose
+        -l --> -link
+        -L --> -lib-search
+        -o --> -output
+        -v --> -verbose
 
 * 2003-02-10
   - Added option to mlton: -profile-combine {false|true}
 
 * 2003-02-09
   - Added options to mlprof: -graph-title, -gray, -ignore, -mlmon,
-	-tolerant.
+        -tolerant.
 
 * 2002-11 - 2003-01
   - Added source-level allocation and time profiling.  This includes
-	the new options to mlton: -profile and -profile-stack.
+        the new options to mlton: -profile and -profile-stack.
 
 * 2002-12-28
   - Added NetHostDB,NetProtDB,NetServDB structures.
@@ -668,7 +841,7 @@
 
 * 2002-12-10
   - Fixed bug in runtime that might cause the message
-	Unable to set cardMapForMutator.
+        Unable to set cardMapForMutator.
 
 * 2002-11-23
   - Added support for the latest Basis Library specification.
@@ -680,7 +853,7 @@
   - Added OS.IO.{pollIn,pollOut,pollPri,poll,isIn,isOut,isPri} values.
   - Added BinPrimIO,TextPrimIO structures.
   - Added StreamIO,ImperativeIO functors.
-	
+        
 * 2002-11-22
   - Fixed bug that caused time profiling to fail (with a segfault) when resuming
     a saved world. 
@@ -748,7 +921,7 @@
     
 * 2002-08-20
   - Fixed SSA optimizer bug that could cause the following error message
-	x_0 has no analyze var value property 
+        x_0 has no analyze var value property 
 
 * 2002-07-28
   - Added MLton.GC.{pack,unpack}.  pack shrinks the heap so that other processes
@@ -769,7 +942,7 @@
 
 * 2002-05-31
   - Fixed bug in overloading of / so that the following now type checks:
-	fun f (x, y) = x + y / y
+        fun f (x, y) = x + y / y
 
 * 2002-04-26
   - Added back max-heap runtime option.
@@ -797,9 +970,9 @@
 
 * 2002-03-27
   - Regularization of options
-	-g	-->	-degug {false|true}
-	-h n	--> 	-fixed-heap n
-	-p 	--> 	-profile {false|true}
+        -g      -->     -degug {false|true}
+        -h n    -->     -fixed-heap n
+        -p      -->     -profile {false|true}
 
 * 2002-03-22
   - Set up the stubs so that MLton can be compiled in the standard basis
@@ -927,20 +1100,20 @@
 
 * 2001-10-5
   - Fixed a bug in polymorphic layered patterns, like
-	val 'a a as b = []
+        val 'a a as b = []
     These would always fail due to the variable "a" not being handled correctly.
   - Fixed the syntax of "val rec" so that a pattern is allowed on the left-hand
     side of the =.  Thus, we used to reject, but now accept, the following.
-	val rec a as b as c = fn _ => ()
-	val rec a : unit -> unit : unit -> unit = fn () => ()
+        val rec a as b as c = fn _ => ()
+        val rec a : unit -> unit : unit -> unit = fn () => ()
     Thanks again to Andreas Rossberg's test files.  This is now tested for in
     valrec.sml.
   - Fixed dynamic semantics of "val rec" so that if "val rec" is used to
     override constructor status, then at run time, the Bind exception is raised
     as per rule 126 of the Definition.  So, for example, the following program
     type checks and compiles, but raises Bind at run time.
-	val rec NONE = fn () => ()
-	val _ = NONE ()
+        val rec NONE = fn () => ()
+        val _ = NONE ()
     Again, this is checked in valrec.sml.
   - Added '\r\n' to ml.lex so that Windows style newlines are acceptable in 
     input files.
@@ -988,15 +1161,15 @@
 
 * 2001-8-22
   - Added support for #line directives of the form
-	(*#line line.col "file"*)
+        (*#line line.col "file"*)
     These directives only affect error messages produced by the parser and 
     elaborator.   
 
 * 2001-8-17
   - Fixed bug in removeUnused optimzation that caused the following program to
     fail to compile.
-	fun f l = case l of [] => f l | _ :: l => f l
-	val _ = f [13]
+        fun f l = case l of [] => f l | _ :: l => f l
+        val _ = f [13]
 
 * 2001-8-14
   - New x86-codegen infrastructure.
@@ -1068,23 +1241,23 @@
     values in the stack across basic blocks.
   - Added production to the grammar on page 58 of the Definition that had been
     missing from MLton since day one.
-		program ::= exp ; <program>
+                program ::= exp ; <program>
     Also updated docs to reflect change.
   - Modified grammar to accept the empty program.
   - Added -type-check expert flag to turn on type checking in ILs.
 
 * 2001-7-15
   - Bug fix to the algebraic simplifier.  It had been rewriting
-		Word32.andb (w, 0wxFF) to w
+                Word32.andb (w, 0wxFF) to w
     instead of  Word32.andb (w, 0wxFFFFFFFF) to w.
 
 * 2001-7-13
   - Improved CPS shrinker so that if-tests where the then and else branch jump
     to the same label is turned into a direct jump.
   - Improved CPS shrinker (Prim.apply) to handle constructors
-	A = A --> true
- 	A = B --> false
-	A x = B y --> false
+        A = A --> true
+        A = B --> false
+        A x = B y --> false
   - Rewrote a lot of loops in the basis library to use inequalities instead of
     equality for the loop termination test so that the (forthcoming) overflow
     detection elimination will work on the loop index variable.
@@ -1162,44 +1335,44 @@
   - Fixed bug in remove-unused that caused polymorphic equality to return 
     true sometimes when constructors were never used in a pattern match.
     For example, the following (in which A and B are not used as patterns):
-	datatype t = A | B
-	datatype u = C of t
-	val _ = if C A = C B then raise Fail "bug" else ()
+        datatype t = A | B
+        datatype u = C of t
+        val _ = if C A = C B then raise Fail "bug" else ()
 
 * 2001-3-27
   - Fixed bug that caused all of the following to fail
-	{LargeWord,Word,SysWord}.{toLargeInt,toLargeIntX,fromLargeInt}
+        {LargeWord,Word,SysWord}.{toLargeInt,toLargeIntX,fromLargeInt}
     The problem was the basis library file integer/patch.sml which fixed Word32
     but not the other structures that are the same.
 
 * 2001-2-12
   - Fixed bug in match compiler that caused it to spend a lot of extra time in
-	deep patterns.  It still could be exponential however.  Hopefully this
-	will get fixed in the release after next.
-	This bug could cause very slow compile times in some cases.
-	Anyways, this fix cut the "finish infer" time of a self compile down
-	from 22 to under 4 seconds.  I.E. most of the time used to be spent due
-	to this bug.
+        deep patterns.  It still could be exponential however.  Hopefully this
+        will get fixed in the release after next.
+        This bug could cause very slow compile times in some cases.
+        Anyways, this fix cut the "finish infer" time of a self compile down
+        from 22 to under 4 seconds.  I.E. most of the time used to be spent due
+        to this bug.
 
 * 2001-2-6
   - Fixed bug in frontend that caused the wrong file and line number to be
-	reported with errors in functor bodys.
+        reported with errors in functor bodys.
 
 * 2001-1-3 - 2000-2-5
   - Changes to CoreML, XML, SXML, and CPS ILs to replace lists by vectors in
-	order to decrease space usage.
+        order to decrease space usage.
 
 * 2001-1-16
   - Fixed a bug in constant propagation where the length of vectors was not
-	propagated properly.
+        propagated properly.
 
 * 2000-12-11 - 2001-1-3
   - Major rewrite of elaborator to use a single hash table for each namespace
-	instead of a hash table for every environment.
+        instead of a hash table for every environment.
 
 * 2000-12-20
   - Fixed some bugs in the SML/NJ compatibility library,
-	src/lib/mlton-subs-in-smlnj.
+        src/lib/mlton-subs-in-smlnj.
 
 * 2000-12-8
   - More careful removal of tracing code when compiling MLton_debug=0.
@@ -1242,13 +1415,13 @@
 
 * 2000-11-15
   - Fixed a (performance) bug in constant propagation that caused the hashing
-	to be bad.
+        to be bad.
   - Improved translation to XML so that the match compiler isn't called on
-	tuple or if expressions.  This should speed up the translation and
-	make the output smaller.
+        tuple or if expressions.  This should speed up the translation and
+        make the output smaller.
   - Fixed a bug in the match compiler that caused it to not generate integer
-	case statements.  This should speed up the mlyacc benchmark and the 
-	MLton front end.
+        case statements.  This should speed up the mlyacc benchmark and the 
+        MLton front end.
 
 * 2000-11-9
   - Added IntInf_equal and IntInf_compare primitives.
@@ -1294,11 +1467,11 @@
     hand generated ones.  Took out make depend from src/Makefile.  makedepend
     was behaving really badly on RHAT 7.0.
   - Tweaked compiler to shorten width of C output lines to work around
-	bug in RHAT 7.0 cpp which silently truncates (very) long lines.
+        bug in RHAT 7.0 cpp which silently truncates (very) long lines.
   - Fixed bug in grammar that didn't allow "op" to occur in datatype and 
     exception bindings, causing the following to fail
-	datatype t = op T
-	exception op E = op Fail
+        datatype t = op T
+        exception op E = op Fail
   - Improved error messages in CM processor.  Fixed bug in CM Alias handling.
 
 * 2000-10-18
@@ -1379,8 +1552,8 @@
 
 * 2000-9-6
   - Fixed Socket_listen in mlton-lib.c so that it closes the socket if the 
-	bind, listen, or getsockname fails.  This could have caused a file
-	descriptor leak.
+        bind, listen, or getsockname fails.  This could have caused a file
+        descriptor leak.
 
 * 2000-9-5
   - Added -static commandline switch.
@@ -1445,7 +1618,7 @@
 
 * 2000-8-3
   - Fixed bug in constant folding.  
-	Word8.>> had been used to implement Word8.~>>.
+        Word8.>> had been used to implement Word8.~>>.
   - Fixed bug in allocate registers that was not forcing the size argument to
     Primitive.Array.array to be a stack slot.  This could cause problems if
     there was a thread switch in the limit check, since upon return the size
@@ -1493,7 +1666,7 @@
 
 * 2000-6-10 - 2000-7-12
   Too many changes to count: bug fixes, new basis library modules,
-	optimizer improvements.
+        optimizer improvements.
 * 2000-6-30
   Fixed bug in monomorphiser that caused programs with non-value
   carrying exception declarations in polymorphic functions to have a
@@ -1503,12 +1676,12 @@
   Finished the changes for the new Cps IL.
 * 2000-1-1
   Fixed some errors in the basis library.
-	Real.copySign
-	Posix.FileSys.fpathconf
-	Posix.IO.{lseek, getlk, setlk, setlkw}
-	Posix.ProcEnv.setpgid
-	Posix.TTY.getattr
-	System.FileSys.realPath
+        Real.copySign
+        Posix.FileSys.fpathconf
+        Posix.IO.{lseek, getlk, setlk, setlkw}
+        Posix.ProcEnv.setpgid
+        Posix.TTY.getattr
+        System.FileSys.realPath
 * 1999-12-22
   Fixed bug in src/closure-convert/abstract-value.fun that caused a
   compiler failure whenever a program had a vector where the element
@@ -1543,14 +1716,14 @@
 * 1999-11-21
   - Runtime system
     o Fixed a bug introduced by the signal code
-	(presumably on 1999-8-9) that caused a gc to *not* be performed when
-	doing a save world.  This caused the heaps created by save world to
-	be the same size as the heap -- not the live data.  This was quite
-	bad. 
+        (presumably on 1999-8-9) that caused a gc to *not* be performed when
+        doing a save world.  This caused the heaps created by save world to
+        be the same size as the heap -- not the live data.  This was quite
+        bad. 
     o Cleaned up the Makefile.  Add make depend.
     o Added max gc pause to gc-summary info.
     o Move heap translation variables that had been file statics into
-	the GC_state.
+        the GC_state.
   - Made structure Position available at toplevel.
   - Basis Library
     o Added MLton.loadWorld
@@ -1647,14 +1820,14 @@
   frequent.
 * 1999-6-27
   Fixed src/main.sml so that when compiling -p, the .c file is compiled 
-	-g and the .o is linked -p. 
+        -g and the .o is linked -p. 
   In bakend/machine.fun, added profiling comments before chunkswitches 
-	and put in an optimization to avoid printing repeated profiling
-	comments.  Also, profiling comments are only output when
-	compiling -p.
+        and put in an optimization to avoid printing repeated profiling
+        comments.  Also, profiling comments are only output when
+        compiling -p.
 * 1999-6-17
   Changed -i to -inline, -f to -flatten, -np to -no-polyvariance, 
-	-u to -unsafe.
+        -u to -unsafe.
   Added -i, -I, -l, -L flags for includes and libraries.
   Updated documentation for these options and for ffi.
 * 1999-6-16
@@ -1669,7 +1842,7 @@
      added #include <math.h>
      and deleted all of the function signatures I had copied from math.h
   Changed Real.{minNormalPos, minPos, maxFinite} so that they are
-	computed in real.sml instead of appearing as constants in the C.
+        computed in real.sml instead of appearing as constants in the C.
 * 1999-6-7
   IntInf.pow added to basis library.
 * 1999-6-4

Modified: mlton/branches/on-20050420-cmm-branch/doc/examples/Makefile
===================================================================
--- mlton/branches/on-20050420-cmm-branch/doc/examples/Makefile	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/doc/examples/Makefile	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,11 @@
+## Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ #    Jagannathan, and Stephen Weeks.
+ # Copyright (C) 1997-2000 NEC Research Institute.
+ #
+ # MLton is released under a BSD-style license.
+ # See the file MLton-LICENSE for details.
+ ##
+
 all:
 
 %: %.sml


Property changes on: mlton/branches/on-20050420-cmm-branch/doc/examples/ffi
___________________________________________________________________
Name: svn:ignore
   - export
export.h
iimport
import
import2
test_quot
test_quot.h
   + export
export.h
iimport
import
import2
test_quot
test_quot.h


Deleted: mlton/branches/on-20050420-cmm-branch/doc/examples/ffi/.cvsignore
===================================================================
--- mlton/branches/on-20050420-cmm-branch/doc/examples/ffi/.cvsignore	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/doc/examples/ffi/.cvsignore	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,7 +0,0 @@
-export
-export.h
-iimport
-import
-import2
-test_quot
-test_quot.h

Copied: mlton/branches/on-20050420-cmm-branch/doc/examples/ffi/.ignore (from rev 4358, mlton/trunk/doc/examples/ffi/.ignore)

Modified: mlton/branches/on-20050420-cmm-branch/doc/examples/ffi/Makefile
===================================================================
--- mlton/branches/on-20050420-cmm-branch/doc/examples/ffi/Makefile	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/doc/examples/ffi/Makefile	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,6 +1,14 @@
+## Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ #    Jagannathan, and Stephen Weeks.
+ # Copyright (C) 1997-2000 NEC Research Institute.
+ #
+ # MLton is released under a BSD-style license.
+ # See the file MLton-LICENSE for details.
+ ##
+
 PATH = ../../../build/bin:$(shell echo $$PATH)
 
-mlton = mlton -default-ann 'allowExport true' -default-ann 'allowImport true'
+mlton = mlton -default-ann 'allowFFI true'
 
 .PHONY: all
 all: import import2 export iimport test_quot

Modified: mlton/branches/on-20050420-cmm-branch/doc/examples/ffi/export.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/doc/examples/ffi/export.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/doc/examples/ffi/export.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,29 +1,34 @@
-val e = _export "f": int * real * char -> char;
+val e = _export "f": (int * real * char -> char) -> unit;
 val _ = e (fn (i, r, _) =>
-	   (print (concat ["i = ", Int.toString i,
-			   "  r = ", Real.toString r, "\n"])
-	    ; #"g"))
+           (print (concat ["i = ", Int.toString i,
+                           "  r = ", Real.toString r, "\n"])
+            ; #"g"))
 val g = _import "g": unit -> unit;
 val _ = g ()
 val _ = g ()
    
-val e = _export "f2": Word8.word -> word array;
+val e = _export "f2": (Word8.word -> word array) -> unit;
 val _ = e (fn w =>
-	   Array.tabulate (10, fn _ => Word.fromLargeWord (Word8.toLargeWord w)))
+           Array.tabulate (10, fn _ => Word.fromLargeWord (Word8.toLargeWord w)))
 val g2 = _import "g2": unit -> word array;
 val a = g2 ()
 val _ = print (concat ["0wx", Word.toString (Array.sub (a, 0)), "\n"])
 
-val e = _export "f3": unit -> unit;
+val e = _export "f3": (unit -> unit) -> unit;
 val _ = e (fn () => print "hello\n");
 val g3 = _import "g3": unit -> unit;
 val _ = g3 ()
 
 (* This example demonstrates mutual recursion between C and SML. *)
-val e = _export "f4": int -> unit;
+val e = _export "f4": (int -> unit) -> unit;
 val g4 = _import "g4": int -> unit;
 val _ = e (fn i => if i = 0 then () else g4 (i - 1))
 val _ = g4 13
+
+val (_, zzzSet) = _symbol "zzz" alloc: (unit -> int) * (int -> unit);
+val () = zzzSet 42
+val g5 = _import "g5": unit -> unit;
+val _ = g5 ()
    
 val _ = print "success\n"
 

Modified: mlton/branches/on-20050420-cmm-branch/doc/examples/ffi/ffi-export.c
===================================================================
--- mlton/branches/on-20050420-cmm-branch/doc/examples/ffi/ffi-export.c	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/doc/examples/ffi/ffi-export.c	2006-02-16 19:34:54 UTC (rev 4361)
@@ -2,28 +2,34 @@
 #include "export.h"
 
 void g () {
-	Char c;
+        Char c;
 
-	fprintf (stderr, "g starting\n");
-	c = f (13, 17.15, 'a');
-	fprintf (stderr, "g done  char = %c\n", c);
+        fprintf (stderr, "g starting\n");
+        c = f (13, 17.15, 'a');
+        fprintf (stderr, "g done  char = %c\n", c);
 }
 
 Pointer g2 () {
-	Pointer res;
-	fprintf (stderr, "g2 starting\n");
-	res = f2 (0xFF);
-	fprintf (stderr, "g2 done\n");
-	return res;
+        Pointer res;
+        fprintf (stderr, "g2 starting\n");
+        res = f2 (0xFF);
+        fprintf (stderr, "g2 done\n");
+        return res;
 }
 
 void g3 () {
-	fprintf (stderr, "g3 starting\n");
-	f3 ();
-	fprintf (stderr, "g3 done\n");
+        fprintf (stderr, "g3 starting\n");
+        f3 ();
+        fprintf (stderr, "g3 done\n");
 }
 
 void g4 (Int i) {
-	fprintf (stderr, "g4 (%d)\n", i);
-	f4 (i);
+        fprintf (stderr, "g4 (%d)\n", i);
+        f4 (i);
 }
+
+void g5 () {
+        fprintf (stderr, "g5 ()\n");
+        fprintf (stderr, "zzz = %i\n", zzz);
+        fprintf (stderr, "g5 done\n");
+}

Modified: mlton/branches/on-20050420-cmm-branch/doc/examples/ffi/ffi-import.c
===================================================================
--- mlton/branches/on-20050420-cmm-branch/doc/examples/ffi/ffi-import.c	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/doc/examples/ffi/ffi-import.c	2006-02-16 19:34:54 UTC (rev 4361)
@@ -6,16 +6,16 @@
 Real FFI_REAL = 3.14159;
 
 Char ffi (Pointer a1, Pointer a2, Int n) {
-	double *ds = (double*)a1;
-	int *p = (int*)a2;
-	int i;
-	double sum;
+        double *ds = (double*)a1;
+        int *p = (int*)a2;
+        int i;
+        double sum;
 
-	sum = 0.0;
-	for (i = 0; i < GC_arrayNumElements (a1); ++i) {
-		sum += ds[i];
-		ds[i] += n;
-	}
-	*p = (int)sum;
-	return 'c';
+        sum = 0.0;
+        for (i = 0; i < GC_arrayNumElements (a1); ++i) {
+                sum += ds[i];
+                ds[i] += n;
+        }
+        *p = (int)sum;
+        return 'c';
 }

Modified: mlton/branches/on-20050420-cmm-branch/doc/examples/ffi/iimport.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/doc/examples/ffi/iimport.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/doc/examples/ffi/iimport.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -19,77 +19,77 @@
       type fptr = MLton.Pointer.t
 
       val dlopen =
-	 _import "dlopen" : string * mode -> hndl;
+         _import "dlopen" : string * mode -> hndl;
       val dlerror =
-	 _import "dlerror": unit -> MLton.Pointer.t;
+         _import "dlerror": unit -> MLton.Pointer.t;
       val dlsym =
-	 _import "dlsym" : hndl * string -> fptr;
+         _import "dlsym" : hndl * string -> fptr;
       val dlclose =
-	 _import "dlclose" : hndl -> Int32.int;
+         _import "dlclose" : hndl -> Int32.int;
 
       val RTLD_LAZY = 0wx00001 (* Lazy function call binding.  *)
       val RTLD_NOW  = 0wx00002 (* Immediate function call binding.  *)
 
       val dlerror = fn () =>
-	 let
-	    val addr = dlerror ()
-	 in
-	    if addr = MLton.Pointer.null
-	       then NONE
-	       else let
-		       fun loop (index, cs) =
-			  let
-			     val w = MLton.Pointer.getWord8 (addr, index)
-			     val c = Byte.byteToChar w
-			  in
-			     if c = #"\000"
-				then SOME (implode (rev cs))
-				else loop (index + 1, c::cs)
-			  end
-		    in
-		       loop (0, [])
-		    end
-	 end
+         let
+            val addr = dlerror ()
+         in
+            if addr = MLton.Pointer.null
+               then NONE
+               else let
+                       fun loop (index, cs) =
+                          let
+                             val w = MLton.Pointer.getWord8 (addr, index)
+                             val c = Byte.byteToChar w
+                          in
+                             if c = #"\000"
+                                then SOME (implode (rev cs))
+                                else loop (index + 1, c::cs)
+                          end
+                    in
+                       loop (0, [])
+                    end
+         end
 
       val dlopen = fn (filename, mode) =>
-	 let
-	    val filename = filename ^ "\000"
-	    val hndl = dlopen (filename, mode)
-	 in
-	    if hndl = MLton.Pointer.null
-	       then raise Fail (case dlerror () of
-				   NONE => "???"
-				 | SOME s => s)
-	       else hndl
-	 end
+         let
+            val filename = filename ^ "\000"
+            val hndl = dlopen (filename, mode)
+         in
+            if hndl = MLton.Pointer.null
+               then raise Fail (case dlerror () of
+                                   NONE => "???"
+                                 | SOME s => s)
+               else hndl
+         end
 
       val dlsym = fn (hndl, symbol) =>
-	 let
-	    val symbol = symbol ^ "\000"
-	    val fptr = dlsym (hndl, symbol)
-	 in
-	    case dlerror () of
-	       NONE => fptr
-	     | SOME s => raise Fail s
-	 end
+         let
+            val symbol = symbol ^ "\000"
+            val fptr = dlsym (hndl, symbol)
+         in
+            case dlerror () of
+               NONE => fptr
+             | SOME s => raise Fail s
+         end
 
       val dlclose = fn hndl =>
-	 if MLton.Platform.OS.host = MLton.Platform.OS.Darwin
-	    then ()  (* Darwin reports the following error message if you
-		      * try to close a dynamic library.
-		      *   "dynamic libraries cannot be closed"
-		      * So, we disable dlclose on Darwin.
-		      *)
-	 else
-	    let
-	       val res = dlclose hndl
-	    in
-	       if res = 0
-		  then ()
-	       else raise Fail (case dlerror () of
-				   NONE => "???"
-				 | SOME s => s)
-	    end
+         if MLton.Platform.OS.host = MLton.Platform.OS.Darwin
+            then ()  (* Darwin reports the following error message if you
+                      * try to close a dynamic library.
+                      *   "dynamic libraries cannot be closed"
+                      * So, we disable dlclose on Darwin.
+                      *)
+         else
+            let
+               val res = dlclose hndl
+            in
+               if res = 0
+                  then ()
+               else raise Fail (case dlerror () of
+                                   NONE => "???"
+                                 | SOME s => s)
+            end
    end
 
 val dll =
@@ -97,7 +97,7 @@
       open MLton.Platform.OS
    in
       case host of
-	 Cygwin => "cygwin1.dll"
+         Cygwin => "cygwin1.dll"
        | Darwin => "libm.dylib"
        | _ => "libm.so"
    end
@@ -113,6 +113,6 @@
 end
 
 val _ = print (concat ["    Math.cos(2.0) = ", Real.toString (Math.cos 2.0), "\n",
-		       "libm.so::cos(2.0) = ", Real.toString (cos 2.0), "\n"])
+                       "libm.so::cos(2.0) = ", Real.toString (cos 2.0), "\n"])
 
 val _ = DynLink.dlclose hndl

Modified: mlton/branches/on-20050420-cmm-branch/doc/examples/ffi/import.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/doc/examples/ffi/import.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/doc/examples/ffi/import.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -4,7 +4,6 @@
 val ffi = _import "ffi": real array * int ref * int -> char;
 open Array
 
-(* val size = _const "FFI_SIZE": int; *)
 val size = 10
 val a = tabulate (size, fn i => real i)
 val r = ref 0
@@ -13,11 +12,11 @@
 (* Call the C function *)
 val c = ffi (a, r, n)
 
-val n = _import "FFI_INT": int;
+val (nGet, nSet) = _symbol "FFI_INT": (unit -> int) * (int -> unit);
 
-val _ = print (concat [Int.toString n, "\n"])
+val _ = print (concat [Int.toString (nGet ()), "\n"])
 
 val _ =
    print (if c = #"c" andalso !r = 45
-	     then "success\n"
-	  else "fail\n")
+             then "success\n"
+          else "fail\n")

Modified: mlton/branches/on-20050420-cmm-branch/doc/examples/ffi/import2.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/doc/examples/ffi/import2.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/doc/examples/ffi/import2.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,11 +1,10 @@
 (* main.sml *)
 
 (* Declare ffi to be implemented by calling the C function ffi. *)
-val ffi_addr = _import # "ffi" : MLton.Pointer.t;
+val ffi_addr = _address "ffi" : MLton.Pointer.t;
 val ffi_schema = _import * : MLton.Pointer.t -> real array * int ref * int -> char;
 open Array
 
-(* val size = _const "FFI_SIZE": int; *)
 val size = 10
 val a = tabulate (size, fn i => real i)
 val r = ref 0
@@ -16,16 +15,16 @@
 
 val _ =
    print (if c = #"c" andalso !r = 45
-	     then "success\n"
-	  else "fail\n")
+             then "success\n"
+          else "fail\n")
 
-val n = _import "FFI_INT": int;
+val n = #1 (_symbol "FFI_INT": (unit -> int) * (int -> unit);) ()
 val _ = print (concat [Int.toString n, "\n"])
-val w = _import "FFI_WORD": word;
+val w = #1 (_symbol "FFI_WORD": (unit -> word) * (word -> unit);) ()
 val _ = print (concat [Word.toString w, "\n"])
-val b = _import "FFI_BOOL": bool;
+val b = #1 (_symbol "FFI_BOOL": (unit -> bool) * (bool -> unit);) ()
 val _ = print (concat [Bool.toString b, "\n"])
-val r = _import "FFI_REAL": real;
+val r = #1 (_symbol "FFI_REAL": (unit -> real) * (real -> unit);) ()
 val _ = print (concat [Real.toString r, "\n"])
 
 signature OPAQUE =
@@ -55,24 +54,24 @@
       val toString = Real.toString
    end
 
-val n = _import "FFI_INT": OpaqueInt.t;
-val _ = print (concat [OpaqueInt.toString n, "\n"])
-val w = _import "FFI_WORD": OpaqueWord.t;
-val _ = print (concat [OpaqueWord.toString w, "\n"])
-val b = _import "FFI_BOOL": OpaqueBool.t;
-val _ = print (concat [OpaqueBool.toString b, "\n"])
-val r = _import "FFI_REAL": OpaqueReal.t;
-val _ = print (concat [OpaqueReal.toString r, "\n"])
+val (n, _) = _symbol "FFI_INT": (unit -> OpaqueInt.t) * (OpaqueInt.t -> unit);
+val _ = print (concat [OpaqueInt.toString (n ()), "\n"])
+val (w, _) = _symbol "FFI_WORD": (unit -> OpaqueWord.t) * (OpaqueWord.t -> unit);
+val _ = print (concat [OpaqueWord.toString (w ()), "\n"])
+val (b, _) = _symbol "FFI_BOOL": (unit -> OpaqueBool.t) * (OpaqueBool.t -> unit);
+val _ = print (concat [OpaqueBool.toString (b ()), "\n"])
+val (r, _) = _symbol "FFI_REAL": (unit -> OpaqueReal.t) * (OpaqueReal.t -> unit);
+val _ = print (concat [OpaqueReal.toString (r ()), "\n"])
 
-val n_addr = _import # "FFI_INT": MLton.Pointer.t;
+val n_addr = _address "FFI_INT": MLton.Pointer.t;
 val n = MLton.Pointer.getInt32 (n_addr, 0);
 val _ = print (concat [Int.toString n, "\n"])
-val w_addr = _import # "FFI_WORD": MLton.Pointer.t;
+val w_addr = _address "FFI_WORD": MLton.Pointer.t;
 val w = MLton.Pointer.getWord32 (w_addr, 0);
 val _ = print (concat [Word.toString w, "\n"])
-val b_addr = _import # "FFI_BOOL": MLton.Pointer.t;
+val b_addr = _address "FFI_BOOL": MLton.Pointer.t;
 val b = (MLton.Pointer.getInt32 (n_addr, 0)) <> 0
 val _ = print (concat [Bool.toString b, "\n"])
-val r_addr = _import # "FFI_REAL": MLton.Pointer.t;
+val r_addr = _address "FFI_REAL": MLton.Pointer.t;
 val r = MLton.Pointer.getReal64 (r_addr, 0)
 val _ = print (concat [Real.toString r, "\n"])

Modified: mlton/branches/on-20050420-cmm-branch/doc/examples/ffi/test_quot.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/doc/examples/ffi/test_quot.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/doc/examples/ffi/test_quot.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,7 +1,7 @@
 
 val c_quot = _import "c_quot": Int8.int * Int8.int -> Int8.int;
 
-val sml_quot = _export "sml_quot": Int8.int * Int8.int -> Int8.int;
+val sml_quot = _export "sml_quot": (Int8.int * Int8.int -> Int8.int) -> unit;
 val _ = sml_quot Int8.quot
 
 val call_sml_quot = _import "call_sml_quot": unit -> unit;
@@ -28,6 +28,6 @@
 
 val () = 
    print (concat [" bad_z = ", Int8.toString bad_z, "\n",
-		  "     z = ", Int8.toString z, "\n",
-		  "   c_z = ", Int8.toString c_z, "\n"])
+                  "     z = ", Int8.toString z, "\n",
+                  "   c_z = ", Int8.toString c_z, "\n"])
 val () = call_sml_quot ()


Property changes on: mlton/branches/on-20050420-cmm-branch/doc/examples/finalizable
___________________________________________________________________
Name: svn:ignore
   - cons.o
finalizable
   + cons.o
finalizable


Deleted: mlton/branches/on-20050420-cmm-branch/doc/examples/finalizable/.cvsignore
===================================================================
--- mlton/branches/on-20050420-cmm-branch/doc/examples/finalizable/.cvsignore	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/doc/examples/finalizable/.cvsignore	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,2 +0,0 @@
-cons.o
-finalizable

Copied: mlton/branches/on-20050420-cmm-branch/doc/examples/finalizable/.ignore (from rev 4358, mlton/trunk/doc/examples/finalizable/.ignore)

Modified: mlton/branches/on-20050420-cmm-branch/doc/examples/finalizable/Makefile
===================================================================
--- mlton/branches/on-20050420-cmm-branch/doc/examples/finalizable/Makefile	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/doc/examples/finalizable/Makefile	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,6 +1,13 @@
+## Copyright (C) 2003-2005 Henry Cejtin, Matthew Fluet, Suresh
+ #    Jagannathan, and Stephen Weeks.
+ #
+ # MLton is released under a BSD-style license.
+ # See the file MLton-LICENSE for details.
+ ##
+
 PATH = ../../../build/bin:$(shell echo $$PATH)
 
-mlton = mlton -default-ann 'allowImport true'
+mlton = mlton -default-ann 'allowFFI true'
 
 all:
 	$(mlton) finalizable.sml cons.c

Modified: mlton/branches/on-20050420-cmm-branch/doc/examples/finalizable/cons.c
===================================================================
--- mlton/branches/on-20050420-cmm-branch/doc/examples/finalizable/cons.c	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/doc/examples/finalizable/cons.c	2006-02-16 19:34:54 UTC (rev 4361)
@@ -3,41 +3,41 @@
 typedef unsigned int uint;
 
 typedef struct Cons {
-	struct Cons *next;
-	int value;
+        struct Cons *next;
+        int value;
 } *Cons;
 
 Cons listCons (int n, Cons c) {
-	Cons res;
+        Cons res;
 
-	res = (Cons) malloc (sizeof(*res));
-	fprintf (stderr, "0x%08x = listCons (%d)\n", (uint)res, n);
-	res->next = c;
-	res->value = n;
-	return res;
+        res = (Cons) malloc (sizeof(*res));
+        fprintf (stderr, "0x%08x = listCons (%d)\n", (uint)res, n);
+        res->next = c;
+        res->value = n;
+        return res;
 }
 
 Cons listSing (int n) {
-	Cons res;
+        Cons res;
 
-	res = (Cons) malloc (sizeof(*res));
-	fprintf (stderr, "0x%08x = listSing (%d)\n", (uint)res, n);
-	res->next = NULL;
-	res->value = n;
-	return res;
+        res = (Cons) malloc (sizeof(*res));
+        fprintf (stderr, "0x%08x = listSing (%d)\n", (uint)res, n);
+        res->next = NULL;
+        res->value = n;
+        return res;
 }
 
 void listFree (Cons p) {
-	fprintf (stderr, "listFree (0x%08x)\n", (uint)p);
-	free (p);
+        fprintf (stderr, "listFree (0x%08x)\n", (uint)p);
+        free (p);
 }
 
 int listSum (Cons c) {
-	int res;
+        int res;
 
-	fprintf (stderr, "listSum\n");
-	res = 0;
-	for (; c != NULL; c = c->next)
-		res += c->value;
-	return res;
+        fprintf (stderr, "listSum\n");
+        res = 0;
+        for (; c != NULL; c = c->next)
+                res += c->value;
+        return res;
 }

Modified: mlton/branches/on-20050420-cmm-branch/doc/examples/finalizable/finalizable.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/doc/examples/finalizable/finalizable.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/doc/examples/finalizable/finalizable.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -8,57 +8,57 @@
    end
 
 functor CList (structure F: MLTON_FINALIZABLE
-	       structure Prim:
-		  sig
-		     val cons: int * Word32.word -> Word32.word
-		     val free: Word32.word -> unit
-		     val sing: int -> Word32.word
-		     val sum: Word32.word -> int
-		  end): CLIST =
+               structure Prim:
+                  sig
+                     val cons: int * Word32.word -> Word32.word
+                     val free: Word32.word -> unit
+                     val sing: int -> Word32.word
+                     val sum: Word32.word -> int
+                  end): CLIST =
    struct
       type t = Word32.word F.t
 
       fun cons (n: int, l: t) =
-	 F.withValue
-	 (l, fn w' =>
-	  let
-	     val c = F.new (Prim.cons (n, w'))
-	     val _ = F.addFinalizer (c, Prim.free)
-	     val _ = F.finalizeBefore (c, l)
-	  in
-	     c
-	  end)
+         F.withValue
+         (l, fn w' =>
+          let
+             val c = F.new (Prim.cons (n, w'))
+             val _ = F.addFinalizer (c, Prim.free)
+             val _ = F.finalizeBefore (c, l)
+          in
+             c
+          end)
       
       fun sing n =
-	 let
-	    val c = F.new (Prim.sing n)
-	    val _ = F.addFinalizer (c, Prim.free)
-	 in
-	    c
-	 end
+         let
+            val c = F.new (Prim.sing n)
+            val _ = F.addFinalizer (c, Prim.free)
+         in
+            c
+         end
 
       fun sum c = F.withValue (c, Prim.sum)
    end
 
 functor Test (structure CList: CLIST
-	      structure MLton: sig
-				  structure GC:
-				     sig
-					val collect: unit -> unit
-				     end
-			       end) =
+              structure MLton: sig
+                                  structure GC:
+                                     sig
+                                        val collect: unit -> unit
+                                     end
+                               end) =
    struct
       fun f n =
-	 if n = 1
-	    then ()
-	 else
-	    let
-	       val a = Array.tabulate (n, fn i => i)
-	       val _ = Array.sub (a, 0) + Array.sub (a, 1)
-	    in
-	       f (n - 1)
-	    end
-	    
+         if n = 1
+            then ()
+         else
+            let
+               val a = Array.tabulate (n, fn i => i)
+               val _ = Array.sub (a, 0) + Array.sub (a, 1)
+            in
+               f (n - 1)
+            end
+            
       val l = CList.sing 2
       val l = CList.cons (2,l)
       val l = CList.cons (2,l)
@@ -69,21 +69,21 @@
       val _ = MLton.GC.collect ()
       val _ = f 100
       val _ = print (concat ["listSum(l) = ",
-			     Int.toString (CList.sum l),
-			     "\n"])
+                             Int.toString (CList.sum l),
+                             "\n"])
       val _ = MLton.GC.collect ()
       val _ = f 100
    end
 
 structure CList =
    CList (structure F = MLton.Finalizable
-	  structure Prim =
-	     struct
-		val cons = _import "listCons": int * Word32.word -> Word32.word;
-		val free = _import "listFree": Word32.word -> unit;
-		val sing = _import "listSing": int -> Word32.word;
-		val sum = _import "listSum": Word32.word -> int;
-	     end)
+          structure Prim =
+             struct
+                val cons = _import "listCons": int * Word32.word -> Word32.word;
+                val free = _import "listFree": Word32.word -> unit;
+                val sing = _import "listSing": int -> Word32.word;
+                val sum = _import "listSum": Word32.word -> int;
+             end)
 
 structure S = Test (structure CList = CList
-		    structure MLton = MLton)
+                    structure MLton = MLton)


Property changes on: mlton/branches/on-20050420-cmm-branch/doc/examples/profiling
___________________________________________________________________
Name: svn:ignore
   - *.dot
*.ps
mlmon*.out
fib-tak
list-rev
tak
   + *.dot
*.ps
mlmon*.out
fib-tak
list-rev
tak


Deleted: mlton/branches/on-20050420-cmm-branch/doc/examples/profiling/.cvsignore
===================================================================
--- mlton/branches/on-20050420-cmm-branch/doc/examples/profiling/.cvsignore	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/doc/examples/profiling/.cvsignore	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,6 +0,0 @@
-*.dot
-*.ps
-mlmon*.out
-fib-tak
-list-rev
-tak

Copied: mlton/branches/on-20050420-cmm-branch/doc/examples/profiling/.ignore (from rev 4358, mlton/trunk/doc/examples/profiling/.ignore)

Modified: mlton/branches/on-20050420-cmm-branch/doc/examples/profiling/Makefile
===================================================================
--- mlton/branches/on-20050420-cmm-branch/doc/examples/profiling/Makefile	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/doc/examples/profiling/Makefile	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,11 @@
+## Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ #    Jagannathan, and Stephen Weeks.
+ # Copyright (C) 1997-2000 NEC Research Institute.
+ #
+ # MLton is released under a BSD-style license.
+ # See the file MLton-LICENSE for details.
+ ##
+
 mlton = mlton
 mlprof = mlprof
 ALLOC_EX = list-rev

Modified: mlton/branches/on-20050420-cmm-branch/doc/examples/profiling/list-rev.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/doc/examples/profiling/list-rev.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/doc/examples/profiling/list-rev.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -2,7 +2,7 @@
    case l1 of
       [] => l2
     | x :: l1 => x :: append (l1, l2)
-	 
+         
 fun rev l =
    case l of
       [] => []

Modified: mlton/branches/on-20050420-cmm-branch/doc/examples/profiling/tak.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/doc/examples/profiling/tak.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/doc/examples/profiling/tak.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,22 +1,22 @@
 structure Tak =
    struct
       fun tak1 (x, y, z) =
-	 let
-	    fun tak2 (x, y, z) =
-	       if y >= x
-		  then z
-	       else
-		  tak1 (tak2 (x - 1, y, z),
-			tak2 (y - 1, z, x),
-			tak2 (z - 1, x, y))
-	 in
-	    if y >= x
-	       then z
-	    else
-	       tak1 (tak2 (x - 1, y, z),
-		     tak2 (y - 1, z, x),
-		     tak2 (z - 1, x, y))
-	 end
+         let
+            fun tak2 (x, y, z) =
+               if y >= x
+                  then z
+               else
+                  tak1 (tak2 (x - 1, y, z),
+                        tak2 (y - 1, z, x),
+                        tak2 (z - 1, x, y))
+         in
+            if y >= x
+               then z
+            else
+               tak1 (tak2 (x - 1, y, z),
+                     tak2 (y - 1, z, x),
+                     tak2 (z - 1, x, y))
+         end
    end
 
 val rec f =


Property changes on: mlton/branches/on-20050420-cmm-branch/doc/examples/save-world
___________________________________________________________________
Name: svn:ignore
   - save-world
world
   + save-world
world


Deleted: mlton/branches/on-20050420-cmm-branch/doc/examples/save-world/.cvsignore
===================================================================
--- mlton/branches/on-20050420-cmm-branch/doc/examples/save-world/.cvsignore	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/doc/examples/save-world/.cvsignore	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,2 +0,0 @@
-save-world 
-world 

Copied: mlton/branches/on-20050420-cmm-branch/doc/examples/save-world/.ignore (from rev 4358, mlton/trunk/doc/examples/save-world/.ignore)

Modified: mlton/branches/on-20050420-cmm-branch/doc/examples/save-world/Makefile
===================================================================
--- mlton/branches/on-20050420-cmm-branch/doc/examples/save-world/Makefile	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/doc/examples/save-world/Makefile	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,11 @@
+## Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ #    Jagannathan, and Stephen Weeks.
+ # Copyright (C) 1997-2000 NEC Research Institute.
+ #
+ # MLton is released under a BSD-style license.
+ # See the file MLton-LICENSE for details.
+ ##
+
 PATH = ../../../build/bin:$(shell echo $$PATH)
 
 mlton = mlton

Copied: mlton/branches/on-20050420-cmm-branch/doc/guide (from rev 4358, mlton/trunk/doc/guide)


Property changes on: mlton/branches/on-20050420-cmm-branch/doc/guide
___________________________________________________________________
Name: svn:ignore
   + mlton-guide.pdf



Property changes on: mlton/branches/on-20050420-cmm-branch/doc/hacker-guide
___________________________________________________________________
Name: svn:ignore
   - *~
TAGS
core
macros.aux
main
main.aux
main.bbl
main.blg
main.dvi
main.idx
main.log
main.ps
main.ps.gz
main.toc
old
structure.ps
   + *~
TAGS
core
macros.aux
main
main.aux
main.bbl
main.blg
main.dvi
main.idx
main.log
main.ps
main.ps.gz
main.toc
old
structure.ps


Deleted: mlton/branches/on-20050420-cmm-branch/doc/hacker-guide/.cvsignore
===================================================================
--- mlton/branches/on-20050420-cmm-branch/doc/hacker-guide/.cvsignore	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/doc/hacker-guide/.cvsignore	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,16 +0,0 @@
-*~
-TAGS
-core
-macros.aux
-main
-main.aux
-main.bbl
-main.blg
-main.dvi
-main.idx
-main.log
-main.ps
-main.ps.gz
-main.toc
-old
-structure.ps

Copied: mlton/branches/on-20050420-cmm-branch/doc/hacker-guide/.ignore (from rev 4358, mlton/trunk/doc/hacker-guide/.ignore)

Modified: mlton/branches/on-20050420-cmm-branch/doc/hacker-guide/Makefile
===================================================================
--- mlton/branches/on-20050420-cmm-branch/doc/hacker-guide/Makefile	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/doc/hacker-guide/Makefile	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,11 @@
+## Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ #    Jagannathan, and Stephen Weeks.
+ # Copyright (C) 1997-2000 NEC Research Institute.
+ #
+ # MLton is released under a BSD-style license.
+ # See the file MLton-LICENSE for details.
+ ##
+
 TEX_FILES = \
 	abstract.tex		\
 	basis-library.tex	\

Modified: mlton/branches/on-20050420-cmm-branch/doc/hacker-guide/abstract.tex
===================================================================
--- mlton/branches/on-20050420-cmm-branch/doc/hacker-guide/abstract.tex	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/doc/hacker-guide/abstract.tex	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,7 +1,7 @@
 This document describes how to hack {\mlton}, a
 whole-program optimizing compiler for the
 \htmladdnormallink{Standard ML}
-		  {http://cm.bell-labs.com/cm/cs/what/smlnj/sml.html}
+                  {http://cm.bell-labs.com/cm/cs/what/smlnj/sml.html}
 programming language.
 The {\mlton} homepage is \absolutelink{}.
 The document contains an overview of the source tree, a description of the


Property changes on: mlton/branches/on-20050420-cmm-branch/doc/library-guide
___________________________________________________________________
Name: svn:ignore
   - *~
TAGS
core
macros.aux
main
main.aux
main.bbl
main.blg
main.dvi
main.idx
main.log
main.ps
main.ps.gz
main.toc
old
   + *~
TAGS
core
macros.aux
main
main.aux
main.bbl
main.blg
main.dvi
main.idx
main.log
main.ps
main.ps.gz
main.toc
old


Deleted: mlton/branches/on-20050420-cmm-branch/doc/library-guide/.cvsignore
===================================================================
--- mlton/branches/on-20050420-cmm-branch/doc/library-guide/.cvsignore	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/doc/library-guide/.cvsignore	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,15 +0,0 @@
-*~
-TAGS
-core
-macros.aux
-main
-main.aux
-main.bbl
-main.blg
-main.dvi
-main.idx
-main.log
-main.ps
-main.ps.gz
-main.toc
-old

Copied: mlton/branches/on-20050420-cmm-branch/doc/library-guide/.ignore (from rev 4358, mlton/trunk/doc/library-guide/.ignore)

Modified: mlton/branches/on-20050420-cmm-branch/doc/library-guide/Makefile
===================================================================
--- mlton/branches/on-20050420-cmm-branch/doc/library-guide/Makefile	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/doc/library-guide/Makefile	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,11 @@
+## Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ #    Jagannathan, and Stephen Weeks.
+ # Copyright (C) 1997-2000 NEC Research Institute.
+ #
+ # MLton is released under a BSD-style license.
+ # See the file MLton-LICENSE for details.
+ ##
+
 TEX_FILES = \
 	abstract.tex		\
 	main.tex		\
@@ -17,7 +25,7 @@
 
 main.dvi: $(TEX_FILES) $(FIG_FILES)
 	latex main; bibtex main; latex main; latex main
-	
+
 main.ps: main.dvi
 	dvips -o main.ps main
 


Property changes on: mlton/branches/on-20050420-cmm-branch/doc/license
___________________________________________________________________
Name: svn:ignore
   + SMLNJ-LIB-LICENSE


Modified: mlton/branches/on-20050420-cmm-branch/doc/license/MLKit-LICENSE
===================================================================
--- mlton/branches/on-20050420-cmm-branch/doc/license/MLKit-LICENSE	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/doc/license/MLKit-LICENSE	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,371 +1,32 @@
-copyright
-The ML Kit with Regions, Version 3 (December 3, 1998)
+2. License and Copyright
+------------------------
 
+The ML Kit compiler is distributed under the GNU Public License. See
+the file copyright for details. The runtime system (kit/src/Runtime/)
+and libraries (kit/basislib/) is distributed nder the more liberal
+MIT License.
 
-     ------------------------------------------------------------
+======================================================================
 
-                    The ML Kit with Regions 
-	             (The ML Kit Version 3)
+The MIT License
 
-      Copyright (c) 1998 by Copenhagen and Edinburgh Universities
+Copyright (c) 2004 IT University of Copenhagen
 
-     ------------------------------------------------------------
+Permission is hereby granted, free of charge, to any person obtaining
+a copy of this software and associated documentation files (the
+"Software"), to deal in the Software without restriction, including
+without limitation the rights to use, copy, modify, merge, publish,
+distribute, sublicense, and/or sell copies of the Software, and to
+permit persons to whom the Software is furnished to do so, subject to
+the following conditions:
 
+The above copyright notice and this permission notice shall be
+included in all copies or substantial portions of the Software.
 
-    This program is free software; you can redistribute it and/or modify
-    it under the terms of the GNU General Public License as published by
-    the Free Software Foundation; either version 2 of the License, or
-    (at your option) any later version.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-    GNU General Public License for more details.
-
-    You should have received a copy of the GNU General Public License
-    along with this program; if not, write to the Free Software
-    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
-
-
-     ------------------------------------------------------------
-
-
-		    GNU GENERAL PUBLIC LICENSE
-		       Version 2, June 1991
-
- Copyright (C) 1989, 1991 Free Software Foundation, Inc.
-                          675 Mass Ave, Cambridge, MA 02139, USA
- Everyone is permitted to copy and distribute verbatim copies
- of this license document, but changing it is not allowed.
-
-			    Preamble
-
-  The licenses for most software are designed to take away your
-freedom to share and change it.  By contrast, the GNU General Public
-License is intended to guarantee your freedom to share and change free
-software--to make sure the software is free for all its users.  This
-General Public License applies to most of the Free Software
-Foundation's software and to any other program whose authors commit to
-using it.  (Some other Free Software Foundation software is covered by
-the GNU Library General Public License instead.)  You can apply it to
-your programs, too.
-
-  When we speak of free software, we are referring to freedom, not
-price.  Our General Public Licenses are designed to make sure that you
-have the freedom to distribute copies of free software (and charge for
-this service if you wish), that you receive source code or can get it
-if you want it, that you can change the software or use pieces of it
-in new free programs; and that you know you can do these things.
-
-  To protect your rights, we need to make restrictions that forbid
-anyone to deny you these rights or to ask you to surrender the rights.
-These restrictions translate to certain responsibilities for you if you
-distribute copies of the software, or if you modify it.
-
-  For example, if you distribute copies of such a program, whether
-gratis or for a fee, you must give the recipients all the rights that
-you have.  You must make sure that they, too, receive or can get the
-source code.  And you must show them these terms so they know their
-rights.
-
-  We protect your rights with two steps: (1) copyright the software, and
-(2) offer you this license which gives you legal permission to copy,
-distribute and/or modify the software.
-
-  Also, for each author's protection and ours, we want to make certain
-that everyone understands that there is no warranty for this free
-software.  If the software is modified by someone else and passed on, we
-want its recipients to know that what they have is not the original, so
-that any problems introduced by others will not reflect on the original
-authors' reputations.
-
-  Finally, any free program is threatened constantly by software
-patents.  We wish to avoid the danger that redistributors of a free
-program will individually obtain patent licenses, in effect making the
-program proprietary.  To prevent this, we have made it clear that any
-patent must be licensed for everyone's free use or not licensed at all.
-
-  The precise terms and conditions for copying, distribution and
-modification follow.
-
-		    GNU GENERAL PUBLIC LICENSE
-   TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
-
-  0. This License applies to any program or other work which contains
-a notice placed by the copyright holder saying it may be distributed
-under the terms of this General Public License.  The "Program", below,
-refers to any such program or work, and a "work based on the Program"
-means either the Program or any derivative work under copyright law:
-that is to say, a work containing the Program or a portion of it,
-either verbatim or with modifications and/or translated into another
-language.  (Hereinafter, translation is included without limitation in
-the term "modification".)  Each licensee is addressed as "you".
-
-Activities other than copying, distribution and modification are not
-covered by this License; they are outside its scope.  The act of
-running the Program is not restricted, and the output from the Program
-is covered only if its contents constitute a work based on the
-Program (independent of having been made by running the Program).
-Whether that is true depends on what the Program does.
-
-  1. You may copy and distribute verbatim copies of the Program's
-source code as you receive it, in any medium, provided that you
-conspicuously and appropriately publish on each copy an appropriate
-copyright notice and disclaimer of warranty; keep intact all the
-notices that refer to this License and to the absence of any warranty;
-and give any other recipients of the Program a copy of this License
-along with the Program.
-
-You may charge a fee for the physical act of transferring a copy, and
-you may at your option offer warranty protection in exchange for a fee.
-
-  2. You may modify your copy or copies of the Program or any portion
-of it, thus forming a work based on the Program, and copy and
-distribute such modifications or work under the terms of Section 1
-above, provided that you also meet all of these conditions:
-
-    a) You must cause the modified files to carry prominent notices
-    stating that you changed the files and the date of any change.
-
-    b) You must cause any work that you distribute or publish, that in
-    whole or in part contains or is derived from the Program or any
-    part thereof, to be licensed as a whole at no charge to all third
-    parties under the terms of this License.
-
-    c) If the modified program normally reads commands interactively
-    when run, you must cause it, when started running for such
-    interactive use in the most ordinary way, to print or display an
-    announcement including an appropriate copyright notice and a
-    notice that there is no warranty (or else, saying that you provide
-    a warranty) and that users may redistribute the program under
-    these conditions, and telling the user how to view a copy of this
-    License.  (Exception: if the Program itself is interactive but
-    does not normally print such an announcement, your work based on
-    the Program is not required to print an announcement.)
-
-These requirements apply to the modified work as a whole.  If
-identifiable sections of that work are not derived from the Program,
-and can be reasonably considered independent and separate works in
-themselves, then this License, and its terms, do not apply to those
-sections when you distribute them as separate works.  But when you
-distribute the same sections as part of a whole which is a work based
-on the Program, the distribution of the whole must be on the terms of
-this License, whose permissions for other licensees extend to the
-entire whole, and thus to each and every part regardless of who wrote it.
-
-Thus, it is not the intent of this section to claim rights or contest
-your rights to work written entirely by you; rather, the intent is to
-exercise the right to control the distribution of derivative or
-collective works based on the Program.
-
-In addition, mere aggregation of another work not based on the Program
-with the Program (or with a work based on the Program) on a volume of
-a storage or distribution medium does not bring the other work under
-the scope of this License.
-
-  3. You may copy and distribute the Program (or a work based on it,
-under Section 2) in object code or executable form under the terms of
-Sections 1 and 2 above provided that you also do one of the following:
-
-    a) Accompany it with the complete corresponding machine-readable
-    source code, which must be distributed under the terms of Sections
-    1 and 2 above on a medium customarily used for software interchange; or,
-
-    b) Accompany it with a written offer, valid for at least three
-    years, to give any third party, for a charge no more than your
-    cost of physically performing source distribution, a complete
-    machine-readable copy of the corresponding source code, to be
-    distributed under the terms of Sections 1 and 2 above on a medium
-    customarily used for software interchange; or,
-
-    c) Accompany it with the information you received as to the offer
-    to distribute corresponding source code.  (This alternative is
-    allowed only for noncommercial distribution and only if you
-    received the program in object code or executable form with such
-    an offer, in accord with Subsection b above.)
-
-The source code for a work means the preferred form of the work for
-making modifications to it.  For an executable work, complete source
-code means all the source code for all modules it contains, plus any
-associated interface definition files, plus the scripts used to
-control compilation and installation of the executable.  However, as a
-special exception, the source code distributed need not include
-anything that is normally distributed (in either source or binary
-form) with the major components (compiler, kernel, and so on) of the
-operating system on which the executable runs, unless that component
-itself accompanies the executable.
-
-If distribution of executable or object code is made by offering
-access to copy from a designated place, then offering equivalent
-access to copy the source code from the same place counts as
-distribution of the source code, even though third parties are not
-compelled to copy the source along with the object code.
-
-  4. You may not copy, modify, sublicense, or distribute the Program
-except as expressly provided under this License.  Any attempt
-otherwise to copy, modify, sublicense or distribute the Program is
-void, and will automatically terminate your rights under this License.
-However, parties who have received copies, or rights, from you under
-this License will not have their licenses terminated so long as such
-parties remain in full compliance.
-
-  5. You are not required to accept this License, since you have not
-signed it.  However, nothing else grants you permission to modify or
-distribute the Program or its derivative works.  These actions are
-prohibited by law if you do not accept this License.  Therefore, by
-modifying or distributing the Program (or any work based on the
-Program), you indicate your acceptance of this License to do so, and
-all its terms and conditions for copying, distributing or modifying
-the Program or works based on it.
-
-  6. Each time you redistribute the Program (or any work based on the
-Program), the recipient automatically receives a license from the
-original licensor to copy, distribute or modify the Program subject to
-these terms and conditions.  You may not impose any further
-restrictions on the recipients' exercise of the rights granted herein.
-You are not responsible for enforcing compliance by third parties to
-this License.
-
-  7. If, as a consequence of a court judgment or allegation of patent
-infringement or for any other reason (not limited to patent issues),
-conditions are imposed on you (whether by court order, agreement or
-otherwise) that contradict the conditions of this License, they do not
-excuse you from the conditions of this License.  If you cannot
-distribute so as to satisfy simultaneously your obligations under this
-License and any other pertinent obligations, then as a consequence you
-may not distribute the Program at all.  For example, if a patent
-license would not permit royalty-free redistribution of the Program by
-all those who receive copies directly or indirectly through you, then
-the only way you could satisfy both it and this License would be to
-refrain entirely from distribution of the Program.
-
-If any portion of this section is held invalid or unenforceable under
-any particular circumstance, the balance of the section is intended to
-apply and the section as a whole is intended to apply in other
-circumstances.
-
-It is not the purpose of this section to induce you to infringe any
-patents or other property right claims or to contest validity of any
-such claims; this section has the sole purpose of protecting the
-integrity of the free software distribution system, which is
-implemented by public license practices.  Many people have made
-generous contributions to the wide range of software distributed
-through that system in reliance on consistent application of that
-system; it is up to the author/donor to decide if he or she is willing
-to distribute software through any other system and a licensee cannot
-impose that choice.
-
-This section is intended to make thoroughly clear what is believed to
-be a consequence of the rest of this License.
-
-  8. If the distribution and/or use of the Program is restricted in
-certain countries either by patents or by copyrighted interfaces, the
-original copyright holder who places the Program under this License
-may add an explicit geographical distribution limitation excluding
-those countries, so that distribution is permitted only in or among
-countries not thus excluded.  In such case, this License incorporates
-the limitation as if written in the body of this License.
-
-  9. The Free Software Foundation may publish revised and/or new versions
-of the General Public License from time to time.  Such new versions will
-be similar in spirit to the present version, but may differ in detail to
-address new problems or concerns.
-
-Each version is given a distinguishing version number.  If the Program
-specifies a version number of this License which applies to it and "any
-later version", you have the option of following the terms and conditions
-either of that version or of any later version published by the Free
-Software Foundation.  If the Program does not specify a version number of
-this License, you may choose any version ever published by the Free Software
-Foundation.
-
-  10. If you wish to incorporate parts of the Program into other free
-programs whose distribution conditions are different, write to the author
-to ask for permission.  For software which is copyrighted by the Free
-Software Foundation, write to the Free Software Foundation; we sometimes
-make exceptions for this.  Our decision will be guided by the two goals
-of preserving the free status of all derivatives of our free software and
-of promoting the sharing and reuse of software generally.
-
-			    NO WARRANTY
-
-  11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
-FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW.  EXCEPT WHEN
-OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
-PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED
-OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
-MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.  THE ENTIRE RISK AS
-TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU.  SHOULD THE
-PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,
-REPAIR OR CORRECTION.
-
-  12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
-WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
-REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,
-INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING
-OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED
-TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY
-YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER
-PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE
-POSSIBILITY OF SUCH DAMAGES.
-
-		     END OF TERMS AND CONDITIONS
-
-	Appendix: How to Apply These Terms to Your New Programs
-
-  If you develop a new program, and you want it to be of the greatest
-possible use to the public, the best way to achieve this is to make it
-free software which everyone can redistribute and change under these terms.
-
-  To do so, attach the following notices to the program.  It is safest
-to attach them to the start of each source file to most effectively
-convey the exclusion of warranty; and each file should have at least
-the "copyright" line and a pointer to where the full notice is found.
-
-    <one line to give the program's name and a brief idea of what it does.>
-    Copyright (C) 19yy  <name of author>
-
-    This program is free software; you can redistribute it and/or modify
-    it under the terms of the GNU General Public License as published by
-    the Free Software Foundation; either version 2 of the License, or
-    (at your option) any later version.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-    GNU General Public License for more details.
-
-    You should have received a copy of the GNU General Public License
-    along with this program; if not, write to the Free Software
-    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
-
-Also add information on how to contact you by electronic and paper mail.
-
-If the program is interactive, make it output a short notice like this
-when it starts in an interactive mode:
-
-    Gnomovision version 69, Copyright (C) 19yy name of author
-    Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
-    This is free software, and you are welcome to redistribute it
-    under certain conditions; type `show c' for details.
-
-The hypothetical commands `show w' and `show c' should show the appropriate
-parts of the General Public License.  Of course, the commands you use may
-be called something other than `show w' and `show c'; they could even be
-mouse-clicks or menu items--whatever suits your program.
-
-You should also get your employer (if you work as a programmer) or your
-school, if any, to sign a "copyright disclaimer" for the program, if
-necessary.  Here is a sample; alter the names:
-
-  Yoyodyne, Inc., hereby disclaims all copyright interest in the program
-  `Gnomovision' (which makes passes at compilers) written by James Hacker.
-
-  <signature of Ty Coon>, 1 April 1989
-  Ty Coon, President of Vice
-
-This General Public License does not permit incorporating your program into
-proprietary programs.  If your program is a subroutine library, you may
-consider it more useful to permit linking proprietary applications with the
-library.  If this is what you want to do, use the GNU Library General
-Public License instead of this License.
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
+LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
+OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
+WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

Modified: mlton/branches/on-20050420-cmm-branch/doc/license/MLton-LICENSE
===================================================================
--- mlton/branches/on-20050420-cmm-branch/doc/license/MLton-LICENSE	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/doc/license/MLton-LICENSE	2006-02-16 19:34:54 UTC (rev 4361)
@@ -2,307 +2,25 @@
 the Standard ML programming language.  Send comments and questions to
 MLton@mlton.org.
 
-Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh Jagannathan,
-	and Stephen Weeks.
-Copyright (C) 1997-1999 NEC Research Institute.
+MLton COPYRIGHT NOTICE, LICENSE AND DISCLAIMER.
 
-This program is free software; you can redistribute it and/or
-modify it under the terms of the GNU General Public License
-as published by the Free Software Foundation; either version 2
-of the License, or (at your option) any later version.
+Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+   Jagannathan, and Stephen Weeks.
+Copyright (C) 1997-2000 by the NEC Research Institute
 
-This program is distributed in the hope that it will be useful,
-but WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-GNU General Public License for more details.
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose and without fee is hereby granted,
+provided that the above copyright notice appear in all copies and that
+both the copyright notice and this permission notice and warranty
+disclaimer appear in supporting documentation, and that the name of
+NEC, or any NEC entity not be used in advertising or publicity
+pertaining to distribution of the software without specific, written
+prior permission.
 
-You should have received a copy of the GNU General Public License
-along with this program; if not, write to the Free Software
-Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
-
---------------------------------------------------------------------------------
-
-GNU General Public License
-
-----------------------------------------------------------------------------
-
-Table of Contents
-
-   * GNU GENERAL PUBLIC LICENSE
-        o Preamble
-        o TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
-        o How to Apply These Terms to Your New Programs
-
-----------------------------------------------------------------------------
-
-GNU GENERAL PUBLIC LICENSE
-
-Version 2, June 1991
-
-Copyright (C) 1989, 1991 Free Software Foundation, Inc.
-59 Temple Place - Suite 330, Boston, MA  02111-1307, USA
-
-Everyone is permitted to copy and distribute verbatim copies
-of this license document, but changing it is not allowed.
-
-Preamble
-
-The licenses for most software are designed to take away your freedom to
-share and change it. By contrast, the GNU General Public License is intended
-to guarantee your freedom to share and change free software--to make sure
-the software is free for all its users. This General Public License applies
-to most of the Free Software Foundation's software and to any other program
-whose authors commit to using it. (Some other Free Software Foundation
-software is covered by the GNU Library General Public License instead.) You
-can apply it to your programs, too.
-
-When we speak of free software, we are referring to freedom, not price. Our
-General Public Licenses are designed to make sure that you have the freedom
-to distribute copies of free software (and charge for this service if you
-wish), that you receive source code or can get it if you want it, that you
-can change the software or use pieces of it in new free programs; and that
-you know you can do these things.
-
-To protect your rights, we need to make restrictions that forbid anyone to
-deny you these rights or to ask you to surrender the rights. These
-restrictions translate to certain responsibilities for you if you distribute
-copies of the software, or if you modify it.
-
-For example, if you distribute copies of such a program, whether gratis or
-for a fee, you must give the recipients all the rights that you have. You
-must make sure that they, too, receive or can get the source code. And you
-must show them these terms so they know their rights.
-
-We protect your rights with two steps: (1) copyright the software, and (2)
-offer you this license which gives you legal permission to copy, distribute
-and/or modify the software.
-
-Also, for each author's protection and ours, we want to make certain that
-everyone understands that there is no warranty for this free software. If
-the software is modified by someone else and passed on, we want its
-recipients to know that what they have is not the original, so that any
-problems introduced by others will not reflect on the original authors'
-reputations.
-
-Finally, any free program is threatened constantly by software patents. We
-wish to avoid the danger that redistributors of a free program will
-individually obtain patent licenses, in effect making the program
-proprietary. To prevent this, we have made it clear that any patent must be
-licensed for everyone's free use or not licensed at all.
-
-The precise terms and conditions for copying, distribution and modification
-follow.
-
-TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
-
-0. This License applies to any program or other work which contains a notice
-placed by the copyright holder saying it may be distributed under the terms
-of this General Public License. The "Program", below, refers to any such
-program or work, and a "work based on the Program" means either the Program
-or any derivative work under copyright law: that is to say, a work
-containing the Program or a portion of it, either verbatim or with
-modifications and/or translated into another language. (Hereinafter,
-translation is included without limitation in the term "modification".) Each
-licensee is addressed as "you".
-
-Activities other than copying, distribution and modification are not covered
-by this License; they are outside its scope. The act of running the Program
-is not restricted, and the output from the Program is covered only if its
-contents constitute a work based on the Program (independent of having been
-made by running the Program). Whether that is true depends on what the
-Program does.
-
-1. You may copy and distribute verbatim copies of the Program's source code
-as you receive it, in any medium, provided that you conspicuously and
-appropriately publish on each copy an appropriate copyright notice and
-disclaimer of warranty; keep intact all the notices that refer to this
-License and to the absence of any warranty; and give any other recipients of
-the Program a copy of this License along with the Program.
-
-You may charge a fee for the physical act of transferring a copy, and you
-may at your option offer warranty protection in exchange for a fee.
-
-2. You may modify your copy or copies of the Program or any portion of it,
-thus forming a work based on the Program, and copy and distribute such
-modifications or work under the terms of Section 1 above, provided that you
-also meet all of these conditions:
-
-   * a) You must cause the modified files to carry prominent notices stating
-     that you changed the files and the date of any change.
-
-   * b) You must cause any work that you distribute or publish, that in
-     whole or in part contains or is derived from the Program or any part
-     thereof, to be licensed as a whole at no charge to all third parties
-     under the terms of this License.
-
-   * c) If the modified program normally reads commands interactively when
-     run, you must cause it, when started running for such interactive use
-     in the most ordinary way, to print or display an announcement including
-     an appropriate copyright notice and a notice that there is no warranty
-     (or else, saying that you provide a warranty) and that users may
-     redistribute the program under these conditions, and telling the user
-     how to view a copy of this License. (Exception: if the Program itself
-     is interactive but does not normally print such an announcement, your
-     work based on the Program is not required to print an announcement.)
-
-These requirements apply to the modified work as a whole. If identifiable
-sections of that work are not derived from the Program, and can be
-reasonably considered independent and separate works in themselves, then
-this License, and its terms, do not apply to those sections when you
-distribute them as separate works. But when you distribute the same sections
-as part of a whole which is a work based on the Program, the distribution of
-the whole must be on the terms of this License, whose permissions for other
-licensees extend to the entire whole, and thus to each and every part
-regardless of who wrote it.
-
-Thus, it is not the intent of this section to claim rights or contest your
-rights to work written entirely by you; rather, the intent is to exercise
-the right to control the distribution of derivative or collective works
-based on the Program.
-
-In addition, mere aggregation of another work not based on the Program with
-the Program (or with a work based on the Program) on a volume of a storage
-or distribution medium does not bring the other work under the scope of this
-License.
-
-3. You may copy and distribute the Program (or a work based on it, under
-Section 2) in object code or executable form under the terms of Sections 1
-and 2 above provided that you also do one of the following:
-
-   * a) Accompany it with the complete corresponding machine-readable source
-     code, which must be distributed under the terms of Sections 1 and 2
-     above on a medium customarily used for software interchange; or,
-
-   * b) Accompany it with a written offer, valid for at least three years,
-     to give any third party, for a charge no more than your cost of
-     physically performing source distribution, a complete machine-readable
-     copy of the corresponding source code, to be distributed under the
-     terms of Sections 1 and 2 above on a medium customarily used for
-     software interchange; or,
-
-   * c) Accompany it with the information you received as to the offer to
-     distribute corresponding source code. (This alternative is allowed only
-     for noncommercial distribution and only if you received the program in
-     object code or executable form with such an offer, in accord with
-     Subsection b above.)
-
-The source code for a work means the preferred form of the work for making
-modifications to it. For an executable work, complete source code means all
-the source code for all modules it contains, plus any associated interface
-definition files, plus the scripts used to control compilation and
-installation of the executable. However, as a special exception, the source
-code distributed need not include anything that is normally distributed (in
-either source or binary form) with the major components (compiler, kernel,
-and so on) of the operating system on which the executable runs, unless that
-component itself accompanies the executable.
-
-If distribution of executable or object code is made by offering access to
-copy from a designated place, then offering equivalent access to copy the
-source code from the same place counts as distribution of the source code,
-even though third parties are not compelled to copy the source along with
-the object code.
-
-4. You may not copy, modify, sublicense, or distribute the Program except as
-expressly provided under this License. Any attempt otherwise to copy,
-modify, sublicense or distribute the Program is void, and will automatically
-terminate your rights under this License. However, parties who have received
-copies, or rights, from you under this License will not have their licenses
-terminated so long as such parties remain in full compliance.
-
-5. You are not required to accept this License, since you have not signed
-it. However, nothing else grants you permission to modify or distribute the
-Program or its derivative works. These actions are prohibited by law if you
-do not accept this License. Therefore, by modifying or distributing the
-Program (or any work based on the Program), you indicate your acceptance of
-this License to do so, and all its terms and conditions for copying,
-distributing or modifying the Program or works based on it.
-
-6. Each time you redistribute the Program (or any work based on the
-Program), the recipient automatically receives a license from the original
-licensor to copy, distribute or modify the Program subject to these terms
-and conditions. You may not impose any further restrictions on the
-recipients' exercise of the rights granted herein. You are not responsible
-for enforcing compliance by third parties to this License.
-
-7. If, as a consequence of a court judgment or allegation of patent
-infringement or for any other reason (not limited to patent issues),
-conditions are imposed on you (whether by court order, agreement or
-otherwise) that contradict the conditions of this License, they do not
-excuse you from the conditions of this License. If you cannot distribute so
-as to satisfy simultaneously your obligations under this License and any
-other pertinent obligations, then as a consequence you may not distribute
-the Program at all. For example, if a patent license would not permit
-royalty-free redistribution of the Program by all those who receive copies
-directly or indirectly through you, then the only way you could satisfy both
-it and this License would be to refrain entirely from distribution of the
-Program.
-
-If any portion of this section is held invalid or unenforceable under any
-particular circumstance, the balance of the section is intended to apply and
-the section as a whole is intended to apply in other circumstances.
-
-It is not the purpose of this section to induce you to infringe any patents
-or other property right claims or to contest validity of any such claims;
-this section has the sole purpose of protecting the integrity of the free
-software distribution system, which is implemented by public license
-practices. Many people have made generous contributions to the wide range of
-software distributed through that system in reliance on consistent
-application of that system; it is up to the author/donor to decide if he or
-she is willing to distribute software through any other system and a
-licensee cannot impose that choice.
-
-This section is intended to make thoroughly clear what is believed to be a
-consequence of the rest of this License.
-
-8. If the distribution and/or use of the Program is restricted in certain
-countries either by patents or by copyrighted interfaces, the original
-copyright holder who places the Program under this License may add an
-explicit geographical distribution limitation excluding those countries, so
-that distribution is permitted only in or among countries not thus excluded.
-In such case, this License incorporates the limitation as if written in the
-body of this License.
-
-9. The Free Software Foundation may publish revised and/or new versions of
-the General Public License from time to time. Such new versions will be
-similar in spirit to the present version, but may differ in detail to
-address new problems or concerns.
-
-Each version is given a distinguishing version number. If the Program
-specifies a version number of this License which applies to it and "any
-later version", you have the option of following the terms and conditions
-either of that version or of any later version published by the Free
-Software Foundation. If the Program does not specify a version number of
-this License, you may choose any version ever published by the Free Software
-Foundation.
-
-10. If you wish to incorporate parts of the Program into other free programs
-whose distribution conditions are different, write to the author to ask for
-permission. For software which is copyrighted by the Free Software
-Foundation, write to the Free Software Foundation; we sometimes make
-exceptions for this. Our decision will be guided by the two goals of
-preserving the free status of all derivatives of our free software and of
-promoting the sharing and reuse of software generally.
-
-NO WARRANTY
-
-11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR
-THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
-OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
-PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED
-OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
-MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO
-THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM
-PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR
-CORRECTION.
-
-12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
-WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
-REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,
-INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING
-OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO
-LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR
-THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER
-PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE
-POSSIBILITY OF SUCH DAMAGES.
-
-END OF TERMS AND CONDITIONS
+NEC disclaims all warranties with regard to this software, including
+all implied warranties of merchantability and fitness. In no event
+shall NEC be liable for any special, indirect or consequential damages
+or any damages whatsoever resulting from loss of use, data or profits,
+whether in an action of contract, negligence or other tortious action,
+arising out of or in connection with the use or performance of this
+software.

Modified: mlton/branches/on-20050420-cmm-branch/doc/license/README
===================================================================
--- mlton/branches/on-20050420-cmm-branch/doc/license/README	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/doc/license/README	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,16 +1,22 @@
-package		license			use
---------------  -----------		------------
-MLton		MLton-LICENSE (GPL)	
+package         license                         use
+--------------  ------------------------------  ------------
+MLton           MLton-LICENSE (BSD-style)
 
-SML/NJ		NJ-LICENSE		lexer, parser, 
-                                        precedence parser,
-					OS.IO, Posix.IO, Process, Unix
-					splay trees,
-                                        Concurrent ML Library
-                                        MLNLFFI Library, mlnlffigen
+SML/NJ          NJ-LICENSE (BSD-style)          front-end mllex specification
+                                                front-end mlyacc specification
+                                                precedence parser
+                                                CM lexer and parser
+                                                OS.IO, Posix.IO, Process, Unix
+                                                mllex
+                                                mlyacc and MLYacc Library
+                                                Concurrent ML Library
+                                                CKit Library
+                                                mlnlffigen and MLNLFFI Library
 
-ML Kit		MLKit-LICENSE (GPL)	Path, Time, Date
+SML/NJ Lib	SMLNJ-LIB-LICENSE (BSD-style) 	SML/NJ Library
 
-gdtoa		gdtoa-LICENSE		Real binary <-> decimal conversions
+ML Kit          MLKit-LICENSE (MIT)             Path, Time, Date
 
-gmp		gmp-LICENSE (LGPL)	IntInf
+gdtoa           gdtoa-LICENSE (BSD-style)       Real binary <-> decimal conversions
+
+gmp             gmp-LICENSE (LGPL)              IntInf


Property changes on: mlton/branches/on-20050420-cmm-branch/doc/mlb-formal
___________________________________________________________________
Name: svn:ignore
   - *~
*.aux
*.bbl
*.blg
*.log
*.toc
TAGS
core
mlb-formal
mlb-formal.dvi
mlb-formal.pdf
mlb-formal.ps
mlb-formal.ps.gz
   + *~
*.aux
*.bbl
*.blg
*.log
*.toc
TAGS
core
mlb-formal
mlb-formal.dvi
mlb-formal.pdf
mlb-formal.ps
mlb-formal.ps.gz


Deleted: mlton/branches/on-20050420-cmm-branch/doc/mlb-formal/.cvsignore
===================================================================
--- mlton/branches/on-20050420-cmm-branch/doc/mlb-formal/.cvsignore	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/doc/mlb-formal/.cvsignore	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,13 +0,0 @@
-*~
-*.aux
-*.bbl
-*.blg
-*.log
-*.toc
-TAGS
-core
-mlb-formal
-mlb-formal.dvi
-mlb-formal.pdf
-mlb-formal.ps
-mlb-formal.ps.gz

Copied: mlton/branches/on-20050420-cmm-branch/doc/mlb-formal/.ignore (from rev 4358, mlton/trunk/doc/mlb-formal/.ignore)

Modified: mlton/branches/on-20050420-cmm-branch/doc/mlb-formal/Makefile
===================================================================
--- mlton/branches/on-20050420-cmm-branch/doc/mlb-formal/Makefile	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/doc/mlb-formal/Makefile	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,10 @@
+## Copyright (C) 2004-2005 Henry Cejtin, Matthew Fluet, Suresh
+ #    Jagannathan, and Stephen Weeks.
+ #
+ # MLton is released under a BSD-style license.
+ # See the file MLton-LICENSE for details.
+ ##
+
 TEX_FILES = \
 	bib.bib			\
 	mlb-formal.tex

Deleted: mlton/branches/on-20050420-cmm-branch/doc/mlton.el
===================================================================
--- mlton/branches/on-20050420-cmm-branch/doc/mlton.el	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/doc/mlton.el	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,99 +0,0 @@
-;; This code defines a few functions for invoking MLton's type checker and
-;; visiting the resulting errors.  The intended use is:
-;;
-;;  1. Call mlton-set-main while visiting your main .mlb file.
-;;  2. Call mlton-compile to invoke MLton and visit the first error.
-;;  3. Repeatedly call mlton-next-error to visit each error.
-;;
-;; Calling mlton-compile waits until MLton's type checker completes before
-;; visiting the first error.  One nice thing is that mlton-parse-errors uses
-;; markers so that file edits don't interfere with locating subsequent errros.
-
-(setq mlton-command "mlton")
-(setq mlton-main-file "mlton-main-file undefined")
-(setq mlton-output-buffer "*mlton-output*")
-(setq mlton-errors nil)
-(setq mlton-error-regexp
-      "^\\(Error\\|Warning\\): \\(.+\\) \\([0-9]+\\)\\.\\([0-9]+\\).")
-
-(defun mlton-parse-errors (prefix buffer)
-  "Parse a sequence of MLton error messages in buffer.  prefix is the path
-relative to which files in the error messages should be interpreted.
-Returns a list of pairs of the form (pos . marker), where pos is a position
-in buffer at the start of the second line of an error message (i.e. after the
-file, line, and column info) and marker is at the point of the error in the
-source file."
-  (if (not (get-buffer buffer))
-      (message "No errors.")
-    (let ((errors ()))
-      (set-buffer buffer)
-      (goto-char 0)
-      (condition-case ()
-	(while t
-	  (re-search-forward mlton-error-regexp)
-	  (let* ((match (lambda (i)
-			  (buffer-substring (match-beginning i)
-					    (match-end i))))
-		 (file (funcall match 2))
-		 (file (if (file-name-absolute-p file)
-			   file
-			 (concat prefix (funcall match 2))))
-		 (line (string-to-int (funcall match 3)))
-		 (col (string-to-int (funcall match 4)))
-		 (marker (save-excursion
-			   (find-file file)
-			   (goto-line line)
-			   (forward-char (sub1 col))
-			   (set-marker (make-marker) (point)))))
-	    (beginning-of-line)
-	    (forward-line)
-	    (setq errors (cons (cons (point) marker) errors))))
-	(error))
-	(setq mlton-errors (reverse errors)))))
-
-(defun mlton-next-error ()
-  (interactive)
-  (if (or (not (get-buffer mlton-output-buffer))
-	  (null mlton-errors))
-      (message "No more errors.")
-    (let ((error (caar mlton-errors))
-	  (marker (cdar mlton-errors)))
-      (setq mlton-errors (cdr mlton-errors))
-      (set-window-start (display-buffer mlton-output-buffer) error)
-      (switch-to-buffer (marker-buffer marker))
-      (goto-char marker))))
-
-(defun mlton-set-main ()
-  (interactive)
-  (setq mlton-main-file (buffer-file-name)))
-
-(defvar sml-filename-regexp
-   "\\(\\([-a-zA-Z0-9/.]\\)+\\)\\(\\.\\)\\(\\(cm\\)\\|\\(fun\\)\\|\\(grm\\)\\|\\(lex\\)\\|\\(mlb\\)\\|\\(sig\\)\\|\\(sml\\)\\|\\(ML\\)\\)")
-
-(defun sml-save-buffers ()
-  (save-buffer-excursion
-   (let ((l (buffer-list)))
-     (while (not (null l))
-       (let* ((b (car l))
-	      (n (buffer-name b)))
-	 (if (and n (string-match sml-filename-regexp n))
-	     (progn
-	       (set-buffer b)
-	       (if (buffer-modified-p) (save-buffer)))))
-       (setq l (cdr l))))))
-
-(defun mlton-compile ()
-  (interactive)
-  (let ((buffer (current-buffer)))
-    (sml-save-buffers)
-    (if (get-buffer mlton-output-buffer)
-	(kill-buffer mlton-output-buffer))
-    (find-file mlton-main-file)
-    (shell-command (concat mlton-command
-			   " -stop tc "
-			   (file-name-nondirectory mlton-main-file))
-		   mlton-output-buffer)
-    (mlton-parse-errors (file-name-directory mlton-main-file)
-			mlton-output-buffer)
-    (switch-to-buffer buffer)
-    (mlton-next-error)))

Deleted: mlton/branches/on-20050420-cmm-branch/doc/mlton.spec
===================================================================
--- mlton/branches/on-20050420-cmm-branch/doc/mlton.spec	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/doc/mlton.spec	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,38 +0,0 @@
-Summary: An optimizing compiler for the Standard ML programming language.
-Name: mlton
-Version: MLTONVERSION
-Release:
-Copyright: GPL
-Group: Development/Languages
-Source: mlton-%{version}.tgz
-URL: http://www.mlton.org/
-Buildroot: %{_tmppath}/%{name}/mlton
-Prefix: /usr
-Requires: gmp >= 3.1.1, gmp-devel >= 3.1.1
-
-%description
-MLton is a whole-program optimizing compiler for the Standard ML programming
-language.  The MLton home page is http://www.mlton.org/.
-
-%prep
-%setup
-
-%build
-make all VERSION=%{version} 
-
-%install
-rm -rf $RPM_BUILD_ROOT
-make install DESTDIR=$RPM_BUILD_ROOT VERSION=%{version}
-
-%files
-%attr(-, root, root)		/usr/share/doc/mlton
-%attr(-, root, root)		/usr/bin/mllex
-%attr(-, root, root)		/usr/bin/mlprof
-%attr(-, root, root)		/usr/bin/mlton
-%attr(-, root, root)		/usr/bin/mlyacc
-%attr(-, root, root)		/usr/lib/mlton
-%attr(-, root, root)		/usr/man/man1/mllex.1.gz
-%attr(-, root, root)		/usr/man/man1/mlprof.1.gz
-%attr(-, root, root)		/usr/man/man1/mlton.1.gz
-%attr(-, root, root)		/usr/man/man1/mlyacc.1.gz
-


Property changes on: mlton/branches/on-20050420-cmm-branch/doc/style-guide
___________________________________________________________________
Name: svn:ignore
   - *~
TAGS
core
macros.aux
main
main.aux
main.bbl
main.blg
main.dvi
main.idx
main.log
main.ps
main.ps.gz
main.toc
old
   + *~
TAGS
core
macros.aux
main
main.aux
main.bbl
main.blg
main.dvi
main.idx
main.log
main.ps
main.ps.gz
main.toc
old


Deleted: mlton/branches/on-20050420-cmm-branch/doc/style-guide/.cvsignore
===================================================================
--- mlton/branches/on-20050420-cmm-branch/doc/style-guide/.cvsignore	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/doc/style-guide/.cvsignore	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,15 +0,0 @@
-*~
-TAGS
-core
-macros.aux
-main
-main.aux
-main.bbl
-main.blg
-main.dvi
-main.idx
-main.log
-main.ps
-main.ps.gz
-main.toc
-old

Copied: mlton/branches/on-20050420-cmm-branch/doc/style-guide/.ignore (from rev 4358, mlton/trunk/doc/style-guide/.ignore)

Modified: mlton/branches/on-20050420-cmm-branch/doc/style-guide/Makefile
===================================================================
--- mlton/branches/on-20050420-cmm-branch/doc/style-guide/Makefile	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/doc/style-guide/Makefile	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,11 @@
+## Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ #    Jagannathan, and Stephen Weeks.
+ # Copyright (C) 1997-2000 NEC Research Institute.
+ #
+ # MLton is released under a BSD-style license.
+ # See the file MLton-LICENSE for details.
+ ##
+
 TEX_FILES = \
 	abstract.tex		\
 	main.tex		\
@@ -17,7 +25,7 @@
 
 main.dvi: $(TEX_FILES) $(FIG_FILES)
 	latex main; bibtex main; latex main; latex main
-	
+
 main.ps: main.dvi
 	dvips -o main.ps main
 

Modified: mlton/branches/on-20050420-cmm-branch/doc/style-guide/main.tex
===================================================================
--- mlton/branches/on-20050420-cmm-branch/doc/style-guide/main.tex	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/doc/style-guide/main.tex	2006-02-16 19:34:54 UTC (rev 4361)
@@ -383,7 +383,7 @@
 signature EXP =
    sig
       structure Var: VAR
-	 
+         
       datatype t =
          Var of Var.t
        | Lam of Var.t * t
@@ -393,7 +393,7 @@
 signature VAL =
    sig
       structure Var: VAR
-	 
+         
       type t
 
       val var: Var.t -> t
@@ -413,7 +413,7 @@
 signature ENV =
    sig
       structure Var: VAR
-	 
+         
       type 'a t
 
       val lookup: 'a t * Var.t -> 'a

Copied: mlton/branches/on-20050420-cmm-branch/ide (from rev 4358, mlton/trunk/ide)

Modified: mlton/branches/on-20050420-cmm-branch/include/Makefile
===================================================================
--- mlton/branches/on-20050420-cmm-branch/include/Makefile	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/include/Makefile	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,11 @@
+## Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ #    Jagannathan, and Stephen Weeks.
+ # Copyright (C) 1997-2000 NEC Research Institute.
+ #
+ # MLton is released under a BSD-style license.
+ # See the file MLton-LICENSE for details.
+ ##
+
 all:
 
 .PHONY: clean

Modified: mlton/branches/on-20050420-cmm-branch/include/bytecode-main.h
===================================================================
--- mlton/branches/on-20050420-cmm-branch/include/bytecode-main.h	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/include/bytecode-main.h	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,10 @@
+/* Copyright (C) 2004-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ */
+
 #ifndef _BYTECODE_MAIN_H_
 #define _BYTECODE_MAIN_H_
 
@@ -11,39 +18,39 @@
 struct Bytecode MLton_bytecode;
 
 static Word32 returnAddressToFrameIndex (Word32 w) {
-	return *(Word32*)(MLton_bytecode.code + w - sizeof (Word32));
+        return *(Word32*)(MLton_bytecode.code + w - sizeof (Word32));
 }
 
-#define Main(al, cs, mg, mfs, mmc, pk, ps, ml)				\
-void MLton_callFromC () {						\
-	int nextFun;							\
-	GC_state s;							\
-									\
-	if (DEBUG_CODEGEN)						\
-		fprintf (stderr, "MLton_callFromC() starting\n");	\
-	s = &gcState;							\
-	s->savedThread = s->currentThread;				\
-	s->canHandle += 3;						\
-	/* Switch to the C Handler thread. */				\
-	GC_switchToThread (s, s->callFromCHandler, 0);			\
-	nextFun = *(int*)(s->stackTop - WORD_SIZE);			\
-	MLton_Bytecode_interpret (&MLton_bytecode, nextFun);		\
-	GC_switchToThread (s, s->savedThread, 0);			\
- 	s->savedThread = BOGUS_THREAD;					\
-	if (DEBUG_CODEGEN)						\
-		fprintf (stderr, "MLton_callFromC done\n");		\
-}									\
-int main (int argc, char **argv) {					\
-	int nextFun;							\
-	Initialize (al, cs, mg, mfs, mmc, pk, ps);			\
-	if (gcState.isOriginal) {					\
-		real_Init();						\
-		nextFun = ml;						\
-	} else {							\
-		/* Return to the saved world */				\
-		nextFun = *(int*)(gcState.stackTop - WORD_SIZE);	\
-	}								\
-	MLton_Bytecode_interpret (&MLton_bytecode, nextFun);		\
+#define Main(al, mg, mfs, mmc, pk, ps, ml)                              \
+void MLton_callFromC () {                                               \
+        int nextFun;                                                    \
+        GC_state s;                                                     \
+                                                                        \
+        if (DEBUG_CODEGEN)                                              \
+                fprintf (stderr, "MLton_callFromC() starting\n");       \
+        s = &gcState;                                                   \
+        s->savedThread = s->currentThread;                              \
+        s->canHandle += 3;                                              \
+        /* Switch to the C Handler thread. */                           \
+        GC_switchToThread (s, s->callFromCHandler, 0);                  \
+        nextFun = *(int*)(s->stackTop - WORD_SIZE);                     \
+        MLton_Bytecode_interpret (&MLton_bytecode, nextFun);            \
+        GC_switchToThread (s, s->savedThread, 0);                       \
+        s->savedThread = BOGUS_THREAD;                                  \
+        if (DEBUG_CODEGEN)                                              \
+                fprintf (stderr, "MLton_callFromC done\n");             \
+}                                                                       \
+int main (int argc, char **argv) {                                      \
+        int nextFun;                                                    \
+        Initialize (al, mg, mfs, mmc, pk, ps);                          \
+        if (gcState.isOriginal) {                                       \
+                real_Init();                                            \
+                nextFun = ml;                                           \
+        } else {                                                        \
+                /* Return to the saved world */                         \
+                nextFun = *(int*)(gcState.stackTop - WORD_SIZE);        \
+        }                                                               \
+        MLton_Bytecode_interpret (&MLton_bytecode, nextFun);            \
 }
 
 #endif /* #ifndef _BYTECODE_MAIN_H */

Modified: mlton/branches/on-20050420-cmm-branch/include/bytecode.h
===================================================================
--- mlton/branches/on-20050420-cmm-branch/include/bytecode.h	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/include/bytecode.h	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,2 +1,9 @@
+/* Copyright (C) 2004-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ */
+
 #include <stdint.h>
 #include "interpret.h"

Modified: mlton/branches/on-20050420-cmm-branch/include/c-chunk.h
===================================================================
--- mlton/branches/on-20050420-cmm-branch/include/c-chunk.h	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/include/c-chunk.h	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,11 @@
+/* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ */
+
 #ifndef _C_CHUNK_H_
 #define _C_CHUNK_H_
 
@@ -2,3 +10,2 @@
 #include <stdio.h>
-#include <stdint.h>
 
@@ -50,191 +57,173 @@
 
 #define IsInt(p) (0x3 & (int)(p))
 
-#define BZ(x, l)							\
-	do {								\
-		if (DEBUG_CCODEGEN)					\
-			fprintf (stderr, "%s:%d: BZ(%d, %s)\n",	\
-					__FILE__, __LINE__, (x), #l);	\
-		if (0 == (x)) goto l;					\
-	} while (0)
+#define BZ(x, l)                                                        \
+        do {                                                            \
+                if (DEBUG_CCODEGEN)                                     \
+                        fprintf (stderr, "%s:%d: BZ(%d, %s)\n", \
+                                        __FILE__, __LINE__, (x), #l);   \
+                if (0 == (x)) goto l;                                   \
+        } while (0)
 
-#define BNZ(x, l)							\
-	do {								\
-		if (DEBUG_CCODEGEN)					\
-			fprintf (stderr, "%s:%d: BNZ(%d, %s)\n",	\
-					__FILE__, __LINE__, (x), #l);	\
-		if (x) goto l;						\
-	} while (0)
+#define BNZ(x, l)                                                       \
+        do {                                                            \
+                if (DEBUG_CCODEGEN)                                     \
+                        fprintf (stderr, "%s:%d: BNZ(%d, %s)\n",        \
+                                        __FILE__, __LINE__, (x), #l);   \
+                if (x) goto l;                                          \
+        } while (0)
 
-#define FlushFrontier()				\
-	do {					\
-		FrontierMem = Frontier;		\
-	} while (0)
+#define FlushFrontier()                         \
+        do {                                    \
+                FrontierMem = Frontier;         \
+        } while (0)
 
-#define FlushStackTop()				\
-	do {					\
-		StackTopMem = StackTop;		\
-	} while (0)
+#define FlushStackTop()                         \
+        do {                                    \
+                StackTopMem = StackTop;         \
+        } while (0)
 
-#define CacheFrontier()				\
-	do {					\
-		Frontier = FrontierMem;		\
-	} while (0)
+#define CacheFrontier()                         \
+        do {                                    \
+                Frontier = FrontierMem;         \
+        } while (0)
 
-#define CacheStackTop()				\
-	do {					\
-		StackTop = StackTopMem;		\
-	} while (0)
+#define CacheStackTop()                         \
+        do {                                    \
+                StackTop = StackTopMem;         \
+        } while (0)
 
 /* ------------------------------------------------- */
 /*                       Chunk                       */
 /* ------------------------------------------------- */
 
 #if (defined (__sun__) && defined (REGISTER_FRONTIER_STACKTOP))
-#define Chunk(n)						\
-	DeclareChunk(n) {					\
-		struct cont cont;				\
-		register unsigned int frontier asm("g5");	\
-		int l_nextFun = nextFun;			\
-		register unsigned int stackTop asm("g6");
+#define Chunk(n)                                                \
+        DeclareChunk(n) {                                       \
+                struct cont cont;                               \
+                register unsigned int frontier asm("g5");       \
+                int l_nextFun = nextFun;                        \
+                register unsigned int stackTop asm("g6");
 #else
-#define Chunk(n)				\
-	DeclareChunk(n) {			\
-		struct cont cont;		\
-		Pointer frontier;		\
-		int l_nextFun = nextFun;	\
-		Pointer stackTop;
+#define Chunk(n)                                \
+        DeclareChunk(n) {                       \
+                struct cont cont;               \
+                Pointer frontier;               \
+                int l_nextFun = nextFun;        \
+                Pointer stackTop;
 #endif
 
-#define ChunkSwitch(n)							\
-		if (DEBUG_CCODEGEN)					\
-			fprintf (stderr, "%s:%d: entering chunk %d  l_nextFun = %d\n",	\
-					__FILE__, __LINE__, n, l_nextFun);	\
-		CacheFrontier();					\
-		CacheStackTop();					\
-		while (1) {						\
-		top:							\
-		switch (l_nextFun) {
+#define ChunkSwitch(n)                                                  \
+                if (DEBUG_CCODEGEN)                                     \
+                        fprintf (stderr, "%s:%d: entering chunk %d  l_nextFun = %d\n",  \
+                                        __FILE__, __LINE__, n, l_nextFun);      \
+                CacheFrontier();                                        \
+                CacheStackTop();                                        \
+                while (1) {                                             \
+                top:                                                    \
+                switch (l_nextFun) {
 
-#define EndChunk							\
-		default:						\
-			/* interchunk return */				\
-			nextFun = l_nextFun;				\
-			cont.nextChunk = (void*)nextChunks[nextFun];	\
-			leaveChunk:					\
-				FlushFrontier();			\
-				FlushStackTop();			\
-				return cont;				\
-		} /* end switch (l_nextFun) */				\
-		} /* end while (1) */					\
-	} /* end chunk */
+#define EndChunk                                                        \
+                default:                                                \
+                        /* interchunk return */                         \
+                        nextFun = l_nextFun;                            \
+                        cont.nextChunk = (void*)nextChunks[nextFun];    \
+                        leaveChunk:                                     \
+                                FlushFrontier();                        \
+                                FlushStackTop();                        \
+                                return cont;                            \
+                } /* end switch (l_nextFun) */                          \
+                } /* end while (1) */                                   \
+        } /* end chunk */
 
 /* ------------------------------------------------- */
 /*                Calling SML from C                 */
 /* ------------------------------------------------- */
 
-#define Thread_returnToC()						\
-	do {								\
-		if (DEBUG_CCODEGEN)					\
-			fprintf (stderr, "%s:%d: Thread_returnToC()\n",	\
-					__FILE__, __LINE__);		\
-		returnToC = TRUE;					\
-		return cont;						\
-	} while (0)
+#define Thread_returnToC()                                              \
+        do {                                                            \
+                if (DEBUG_CCODEGEN)                                     \
+                        fprintf (stderr, "%s:%d: Thread_returnToC()\n", \
+                                        __FILE__, __LINE__);            \
+                returnToC = TRUE;                                       \
+                return cont;                                            \
+        } while (0)
 
 /* ------------------------------------------------- */
 /*                      farJump                      */
 /* ------------------------------------------------- */
 
-#define FarJump(n, l)	 			\
-	do {					\
-		PrepFarJump(n, l); 		\
-		goto leaveChunk;		\
-	} while (0)
+#define FarJump(n, l)                           \
+        do {                                    \
+                PrepFarJump(n, l);              \
+                goto leaveChunk;                \
+        } while (0)
 
 /* ------------------------------------------------- */
 /*                       Stack                       */
 /* ------------------------------------------------- */
 
-#define Push(bytes)							\
-	do {								\
-		if (DEBUG_CCODEGEN)					\
-			fprintf (stderr, "%s:%d: Push (%d)\n",		\
-					__FILE__, __LINE__, bytes);	\
-		StackTop += (bytes);					\
-		assert (StackBottom <= StackTop);			\
-	} while (0)
+#define Push(bytes)                                                     \
+        do {                                                            \
+                if (DEBUG_CCODEGEN)                                     \
+                        fprintf (stderr, "%s:%d: Push (%d)\n",          \
+                                        __FILE__, __LINE__, bytes);     \
+                StackTop += (bytes);                                    \
+                assert (StackBottom <= StackTop);                       \
+        } while (0)
 
-#define Return()								\
-	do {									\
-		l_nextFun = *(Word*)(StackTop - sizeof(Word));			\
-		if (DEBUG_CCODEGEN)						\
-			fprintf (stderr, "%s:%d: Return()  l_nextFun = %d\n",	\
-					__FILE__, __LINE__, l_nextFun);		\
-		goto top;							\
-	} while (0)
+#define Return()                                                                \
+        do {                                                                    \
+                l_nextFun = *(Word*)(StackTop - sizeof(Word));                  \
+                if (DEBUG_CCODEGEN)                                             \
+                        fprintf (stderr, "%s:%d: Return()  l_nextFun = %d\n",   \
+                                        __FILE__, __LINE__, l_nextFun);         \
+                goto top;                                                       \
+        } while (0)
 
-#define Raise()									\
-	do {									\
-		if (DEBUG_CCODEGEN)						\
-			fprintf (stderr, "%s:%d: Raise\n",			\
-					__FILE__, __LINE__);			\
-		StackTop = StackBottom + ExnStack;				\
-		Return();							\
-	} while (0)								\
+#define Raise()                                                                 \
+        do {                                                                    \
+                if (DEBUG_CCODEGEN)                                             \
+                        fprintf (stderr, "%s:%d: Raise\n",                      \
+                                        __FILE__, __LINE__);                    \
+                StackTop = StackBottom + ExnStack;                              \
+                Return();                                                       \
+        } while (0)                                                             \
 
-#if (defined __APPLE_CC__)
-
-#define DeclareProfileLabel(l)			\
-	void l()
-
-#define ProfileLabel(l)						\
-	__asm__ __volatile__ (".globl _" #l "\n_" #l ":" : : )
-
-#else
-
-#define DeclareProfileLabel(l)					\
-	void l() __attribute__ ((alias (#l "_internal")))
-
-#define ProfileLabel(l)					\
-	__asm__ __volatile__ (#l "_internal:" : : )
-
-#endif
-
 /* ------------------------------------------------- */
 /*                       Real                        */
 /* ------------------------------------------------- */
 
-#define unaryReal(f, g)						\
-	Real64 g (Real64 x);					\
-	static inline Real64 Real64_##f (Real64 x) {		\
-		return g (x);					\
-	}							\
-	static inline Real32 Real32_##f (Real32 x) {		\
-		return (Real32)(Real64_##f ((Real64)x));	\
-	}
+#define unaryReal(f, g)                                         \
+        Real64 g (Real64 x);                                    \
+        static inline Real64 Real64_##f (Real64 x) {            \
+                return g (x);                                   \
+        }                                                       \
+        static inline Real32 Real32_##f (Real32 x) {            \
+                return (Real32)(Real64_##f ((Real64)x));        \
+        }
 unaryReal(round, rint)
 #undef unaryReal
 
-#define binaryReal(f, g)							\
-	Real64 g (Real64 x, Real64 y);						\
-	static inline Real64 Real64_Math_##f (Real64 x, Real64 y) {		\
-		return g (x, y);						\
-	}									\
-	static inline Real32 Real32_Math_##f (Real32 x, Real32 y) {		\
-		return (Real32)(Real64_Math_##f ((Real64)x, (Real64)y));	\
-	}
+#define binaryReal(f, g)                                                        \
+        Real64 g (Real64 x, Real64 y);                                          \
+        static inline Real64 Real64_Math_##f (Real64 x, Real64 y) {             \
+                return g (x, y);                                                \
+        }                                                                       \
+        static inline Real32 Real32_Math_##f (Real32 x, Real32 y) {             \
+                return (Real32)(Real64_Math_##f ((Real64)x, (Real64)y));        \
+        }
 binaryReal(atan2, atan2)
 #undef binaryReal
 
-#define unaryReal(f, g)						\
-	Real64 g (Real64 x);					\
-	static inline Real64 Real64_Math_##f (Real64 x) {	\
-		return g (x);					\
-	}							\
-	static inline Real32 Real32_Math_##f (Real32 x) {	\
-		return (Real32)(Real64_Math_##f ((Real64)x));	\
-	}
+#define unaryReal(f, g)                                         \
+        Real64 g (Real64 x);                                    \
+        static inline Real64 Real64_Math_##f (Real64 x) {       \
+                return g (x);                                   \
+        }                                                       \
+        static inline Real32 Real32_Math_##f (Real32 x) {       \
+                return (Real32)(Real64_Math_##f ((Real64)x));   \
+        }
 unaryReal(acos, acos)
 unaryReal(asin, asin)
 unaryReal(atan, atan)
@@ -249,32 +238,32 @@
 
 double ldexp (double x, int i);
 static inline Real64 Real64_ldexp (Real64 x, Int32 i) {
-	return ldexp (x, i);
+        return ldexp (x, i);
 }
 static inline Real32 Real32_ldexp (Real32 x, Int32 i) {
-	return (Real32)Real64_ldexp ((Real64)x, i);
+        return (Real32)Real64_ldexp ((Real64)x, i);
 }
 
-#define binaryReal(name, op)						\
-	static inline Real32 Real32_##name (Real32 x, Real32 y) {	\
-		return x op y;						\
-	}								\
-	static inline Real64 Real64_##name (Real64 x, Real64 y) {	\
-		return x op y;						\
-	}
+#define binaryReal(name, op)                                            \
+        static inline Real32 Real32_##name (Real32 x, Real32 y) {       \
+                return x op y;                                          \
+        }                                                               \
+        static inline Real64 Real64_##name (Real64 x, Real64 y) {       \
+                return x op y;                                          \
+        }
 binaryReal(add, +)
 binaryReal(div, /)
 binaryReal(mul, *)
 binaryReal(sub, -)
 #undef binaryReal
 
-#define binaryReal(name, op)					\
-	static inline Bool Real32_##name (Real32 x, Real32 y) {	\
-		return x op y;					\
-	}							\
-	static inline Bool Real64_##name (Real64 x, Real64 y) {	\
-		return x op y;					\
-	}
+#define binaryReal(name, op)                                    \
+        static inline Bool Real32_##name (Real32 x, Real32 y) { \
+                return x op y;                                  \
+        }                                                       \
+        static inline Bool Real64_##name (Real64 x, Real64 y) { \
+                return x op y;                                  \
+        }
 binaryReal(equal, ==)
 binaryReal(le, <=)
 binaryReal(lt, <)
@@ -288,100 +277,100 @@
 #define Real64_neg(x) (-(x))
 
 typedef volatile union {
-	Word tab[2];
-	Real64 d;
+        Word tab[2];
+        Real64 d;
 } Real64Or2Words;
 
 static inline Real64 Real64_fetch (Real64 *dp) {
- 	Real64Or2Words u;
-	Word32 *p;
+        Real64Or2Words u;
+        Word32 *p;
 
-	p = (Word32*)dp;
-	u.tab[0] = p[0];
-	u.tab[1] = p[1];
- 	return u.d;
+        p = (Word32*)dp;
+        u.tab[0] = p[0];
+        u.tab[1] = p[1];
+        return u.d;
 }
 
 static inline void Real64_move (Real64 *dst, Real64 *src) {
-	Word32 *pd;
-	Word32 *ps;
-	Word32 t;
+        Word32 *pd;
+        Word32 *ps;
+        Word32 t;
 
-	pd = (Word32*)dst;
-	ps = (Word32*)src;
-	t = ps[1];
-	pd[0] = ps[0];
-	pd[1] = t;		
+        pd = (Word32*)dst;
+        ps = (Word32*)src;
+        t = ps[1];
+        pd[0] = ps[0];
+        pd[1] = t;              
 }
 
 static inline void Real64_store (Real64 *dp, Real64 d) {
- 	Real64Or2Words u;
-	Word32 *p;
+        Real64Or2Words u;
+        Word32 *p;
 
-	p = (Word32*)dp;
-	u.d = d;
-	p[0] = u.tab[0];
-	p[1] = u.tab[1];
+        p = (Word32*)dp;
+        u.d = d;
+        p[0] = u.tab[0];
+        p[1] = u.tab[1];
 }
 
 /* ------------------------------------------------- */
 /*                        Word                       */
 /* ------------------------------------------------- */
 
-#define wordBinary(size, name, op)				\
-	static inline Word##size Word##size##_##name 		\
-			(Word##size w1, Word##size w2) {	\
-		return w1 op w2;				\
-	}
-#define wordCmp(size, name, op)							\
-	static inline Bool Word##size##_##name					\
-			(Word##size w1, Word##size w2) {			\
-		Bool res = w1 op w2;						\
-		if (DEBUG_CCODEGEN)						\
-			fprintf (stderr, "%s = 0x%08x " #op " 0x%08x\n",	\
-					res ? "true": "false",			\
-					(unsigned int)w1,			\
-					(unsigned int)w2);			\
-		return w1 op w2;						\
-	}
-#define wordShift(size, name, op)			\
-	static inline Word##size Word##size##_##name 	\
-			(Word##size w1, Word w2) {	\
-		return w1 op w2;			\
-	}
-#define wordUnary(size, name, op)					\
-	static inline Word##size Word##size##_##name (Word##size w) {	\
-		return op w;						\
-	}
-#define wordOps(size)								\
-	wordBinary (size, add, +)						\
-	wordBinary (size, andb, &)						\
-	wordBinary (S##size, mul, *)						\
-	wordBinary (U##size, mul, *)						\
-	wordBinary (size, orb, |)						\
-	wordBinary (U##size, quot, /)						\
-	wordBinary (U##size, rem, %)						\
-	wordBinary (size, sub, -)						\
-	wordBinary (size, xorb, ^)						\
-	wordCmp (size, equal, ==)						\
-	wordCmp (S##size, lt, <)						\
-	wordCmp (U##size, lt, <)						\
-	wordShift (size, lshift, <<)						\
-	wordShift (U##size, rshift, >>)						\
-	wordUnary (size, neg, -)						\
-	wordUnary (size, notb, ~)						\
-	/* WordS_rshift isn't ANSI C, because ANSI doesn't guarantee sign	\
-         * extension.  We use it anyway cause it always seems to work.		\
-	 */									\
-	static inline Word##size WordS##size##_rshift (WordS##size w, Word s) {	\
-		return w >> s;							\
-	}									\
-	static inline Word##size Word##size##_rol (Word##size w1, Word w2) {	\
-		return (w1 >> (size - w2)) | (w1 << w2);			\
-	}									\
-	static inline Word##size Word##size##_ror (Word##size w1, Word w2) {	\
-		return (w1 >> w2) | (w1 << (size - w2));			\
-	}
+#define wordBinary(size, name, op)                              \
+        static inline Word##size Word##size##_##name            \
+                        (Word##size w1, Word##size w2) {        \
+                return w1 op w2;                                \
+        }
+#define wordCmp(size, name, op)                                                 \
+        static inline Bool Word##size##_##name                                  \
+                        (Word##size w1, Word##size w2) {                        \
+                Bool res = w1 op w2;                                            \
+                if (DEBUG_CCODEGEN)                                             \
+                        fprintf (stderr, "%s = 0x%08x " #op " 0x%08x\n",        \
+                                        res ? "true": "false",                  \
+                                        (unsigned int)w1,                       \
+                                        (unsigned int)w2);                      \
+                return w1 op w2;                                                \
+        }
+#define wordShift(size, name, op)                       \
+        static inline Word##size Word##size##_##name    \
+                        (Word##size w1, Word w2) {      \
+                return w1 op w2;                        \
+        }
+#define wordUnary(size, name, op)                                       \
+        static inline Word##size Word##size##_##name (Word##size w) {   \
+                return op w;                                            \
+        }
+#define wordOps(size)                                                           \
+        wordBinary (size, add, +)                                               \
+        wordBinary (size, andb, &)                                              \
+        wordBinary (S##size, mul, *)                                            \
+        wordBinary (U##size, mul, *)                                            \
+        wordBinary (size, orb, |)                                               \
+        wordBinary (U##size, quot, /)                                           \
+        wordBinary (U##size, rem, %)                                            \
+        wordBinary (size, sub, -)                                               \
+        wordBinary (size, xorb, ^)                                              \
+        wordCmp (size, equal, ==)                                               \
+        wordCmp (S##size, lt, <)                                                \
+        wordCmp (U##size, lt, <)                                                \
+        wordShift (size, lshift, <<)                                            \
+        wordShift (U##size, rshift, >>)                                         \
+        wordUnary (size, neg, -)                                                \
+        wordUnary (size, notb, ~)                                               \
+        /* WordS_rshift isn't ANSI C, because ANSI doesn't guarantee sign       \
+         * extension.  We use it anyway cause it always seems to work.          \
+         */                                                                     \
+        static inline Word##size WordS##size##_rshift (WordS##size w, Word s) { \
+                return w >> s;                                                  \
+        }                                                                       \
+        static inline Word##size Word##size##_rol (Word##size w1, Word w2) {    \
+                return (w1 >> (size - w2)) | (w1 << w2);                        \
+        }                                                                       \
+        static inline Word##size Word##size##_ror (Word##size w1, Word w2) {    \
+                return (w1 >> w2) | (w1 << (size - w2));                        \
+        }
 wordOps(8)
 wordOps(16)
 wordOps(32)
@@ -392,10 +381,10 @@
 #undef wordShift
 #undef wordUnary
 
-#define coerce(f, t)				\
-	static inline t f##_to##t (f x) {	\
-		return (t)x;			\
-	}
+#define coerce(f, t)                            \
+        static inline t f##_to##t (f x) {       \
+                return (t)x;                    \
+        }
 coerce (Real32, Real64)
 coerce (Real32, WordS32)
 coerce (Real64, Real32)
@@ -427,7 +416,7 @@
 #undef coerce
 
 #define WordS8_max (WordS8)0x7F
-#define	WordS8_min (WordS8)0x80
+#define WordS8_min (WordS8)0x80
 #define WordS16_max (WordS16)0x7FFF
 #define WordS16_min (WordS16)0x8000
 #define WordS32_max (WordS32)0x7FFFFFFF
@@ -439,17 +428,17 @@
 #define Word32_max (Word32)0xFFFFFFFF
 #define Word64_max (Word64)0xFFFFFFFFFFFFFFFFull
 
-#define WordS_addCheckXC(size, dst, xW, cW, l)		\
-	do {						\
-		WordS##size x = xW;			\
-		WordS##size c = cW;			\
-		if (c >= 0) {				\
-			if (x > WordS##size##_max - c)	\
-				goto l;			\
-		} else if (x < WordS##size##_min - c)	\
-				goto l;			\
-		dst = x + c;				\
-	} while (0)
+#define WordS_addCheckXC(size, dst, xW, cW, l)          \
+        do {                                            \
+                WordS##size x = xW;                     \
+                WordS##size c = cW;                     \
+                dst = x + c;                            \
+                if (c >= 0) {                           \
+                        if (x > WordS##size##_max - c)  \
+                                goto l;                 \
+                } else if (x < WordS##size##_min - c)   \
+                                goto l;                 \
+        } while (0)
 #define WordS8_addCheckXC(dst, x, c, l) WordS_addCheckXC(8, dst, x, c, l)
 #define WordS16_addCheckXC(dst, x, c, l) WordS_addCheckXC(16, dst, x, c, l)
 #define WordS32_addCheckXC(dst, x, c, l) WordS_addCheckXC(32, dst, x, c, l)
@@ -465,46 +454,46 @@
 #define WordS32_addCheck WordS32_addCheckXC
 #define WordS64_addCheck WordS64_addCheckXC
 
-#define WordS_negCheck(size, dst, nW, l)	\
-	do {					\
-		WordS##size n = nW;		\
-		if (n == WordS##size##_min)	\
-			goto l;			\
-		dst = -n;			\
-	} while (0)
+#define WordS_negCheck(size, dst, nW, l)        \
+        do {                                    \
+                WordS##size n = nW;             \
+                dst = -n;                       \
+                if (n == WordS##size##_min)     \
+                        goto l;                 \
+        } while (0)
 
 #define Word8_negCheck(dst, n, l) WordS_negCheck(8, dst, n, l)
 #define Word16_negCheck(dst, n, l) WordS_negCheck(16, dst, n, l)
 #define Word32_negCheck(dst, n, l) WordS_negCheck(32, dst, n, l)
 #define Word64_negCheck(dst, n, l) WordS_negCheck(64, dst, n, l)
 
-#define WordS_subCheckCX(size, dst, cW, xW, l)		\
-	do {						\
-		WordS##size c = cW;			\
-		WordS##size x = xW;			\
- 		if (c >= 0) {				\
-			if (x < c - WordS##size##_max)	\
-				goto l;			\
-		} else if (x > c - WordS##size##_min)	\
-			goto l;				\
-		dst = c - x;				\
-	} while (0)
+#define WordS_subCheckCX(size, dst, cW, xW, l)          \
+        do {                                            \
+                WordS##size c = cW;                     \
+                WordS##size x = xW;                     \
+                dst = c - x;                            \
+                if (c >= 0) {                           \
+                        if (x < c - WordS##size##_max)  \
+                                goto l;                 \
+                } else if (x > c - WordS##size##_min)   \
+                        goto l;                         \
+        } while (0)
 #define WordS8_subCheckCX(dst, c, x, l) WordS_subCheckCX(8, dst, c, x, l)
 #define WordS16_subCheckCX(dst, c, x, l) WordS_subCheckCX(16, dst, c, x, l)
 #define WordS32_subCheckCX(dst, c, x, l) WordS_subCheckCX(32, dst, c, x, l)
 #define WordS64_subCheckCX(dst, c, x, l) WordS_subCheckCX(64, dst, c, x, l)
 
-#define WordS_subCheckXC(size, dst, xW, cW, l)		\
-	do {						\
-		WordS##size c = cW;			\
-		WordS##size x = xW;			\
-		if (c <= 0) {				\
-			if (x > WordS##size##_max + c)	\
-				goto l;			\
-		} else if (x < WordS##size##_min + c)	\
-			goto l;				\
-		dst = x - c;				\
- 	} while (0)
+#define WordS_subCheckXC(size, dst, xW, cW, l)          \
+        do {                                            \
+                WordS##size c = cW;                     \
+                WordS##size x = xW;                     \
+                if (c <= 0) {                           \
+                        if (x > WordS##size##_max + c)  \
+                                goto l;                 \
+                } else if (x < WordS##size##_min + c)   \
+                        goto l;                         \
+                dst = x - c;                            \
+        } while (0)
 #define WordS8_subCheckXC(dst, c, x, l) WordS_subCheckXC(8, dst, c, x, l)
 #define WordS16_subCheckXC(dst, c, x, l) WordS_subCheckXC(16, dst, c, x, l)
 #define WordS32_subCheckXC(dst, c, x, l) WordS_subCheckXC(32, dst, c, x, l)
@@ -515,37 +504,37 @@
 #define WordS32_subCheck WordS32_subCheckXC
 #define WordS64_subCheck WordS64_subCheckXC
 
-#define Word_addCheckXC(size, dst, x, c, l)	\
-	do {					\
-		if (x > Word##size##_max - c)	\
-			goto l;			\
-		dst = x + c;			\
-	} while (0)
-#define WordU8_addCheckXC(dst, x, c, l) Word_addCheckXC(8, dst, x, c, l)
-#define WordU16_addCheckXC(dst, x, c, l) Word_addCheckXC(16, dst, x, c, l)
-#define WordU32_addCheckXC(dst, x, c, l) Word_addCheckXC(32, dst, x, c, l)
-#define WordU64_addCheckXC(dst, x, c, l) Word_addCheckXC(64, dst, x, c, l)
-#define WordU8_addCheckCX(dst, c, x, l) Word_addCheckXC(8, dst, x, c, l)
-#define WordU16_addCheckCX(dst, c, x, l) Word_addCheckXC(16, dst, x, c, l)
-#define WordU32_addCheckCX(dst, c, x, l) Word_addCheckXC(32, dst, x, c, l)
-#define WordU64_addCheckCX(dst, c, x, l) Word_addCheckXC(64, dst, x, c, l)
+#define WordU_addCheckXC(size, dst, x, c, l)    \
+        do {                                    \
+                dst = x + c;                    \
+                if (x > Word##size##_max - c)   \
+                        goto l;                 \
+        } while (0)
+#define WordU8_addCheckXC(dst, x, c, l) WordU_addCheckXC(8, dst, x, c, l)
+#define WordU16_addCheckXC(dst, x, c, l) WordU_addCheckXC(16, dst, x, c, l)
+#define WordU32_addCheckXC(dst, x, c, l) WordU_addCheckXC(32, dst, x, c, l)
+#define WordU64_addCheckXC(dst, x, c, l) WordU_addCheckXC(64, dst, x, c, l)
+#define WordU8_addCheckCX(dst, c, x, l) WordU_addCheckXC(8, dst, x, c, l)
+#define WordU16_addCheckCX(dst, c, x, l) WordU_addCheckXC(16, dst, x, c, l)
+#define WordU32_addCheckCX(dst, c, x, l) WordU_addCheckXC(32, dst, x, c, l)
+#define WordU64_addCheckCX(dst, c, x, l) WordU_addCheckXC(64, dst, x, c, l)
 
 #define WordU8_addCheck WordU8_addCheckXC
 #define WordU16_addCheck WordU16_addCheckXC
 #define WordU32_addCheck WordU32_addCheckXC
 #define WordU64_addCheck WordU64_addCheckXC
 
-#define mulOverflow(small, large)						\
-	static inline Word##small Word##small##_##mulOverflow			\
-			(Word##small x1, Word##small x2, Bool *overflow) {	\
-		Word##large tmp;						\
-		Word##small res;						\
-										\
-		tmp = (Word##large)x1 * x2;					\
-		res = tmp;							\
-		*overflow = (tmp != res);					\
-		return res;							\
-	}
+#define mulOverflow(small, large)                                               \
+        static inline Word##small Word##small##_##mulOverflow                   \
+                        (Word##small x1, Word##small x2, Bool *overflow) {      \
+                Word##large tmp;                                                \
+                Word##small res;                                                \
+                                                                                \
+                tmp = (Word##large)x1 * x2;                                     \
+                res = tmp;                                                      \
+                *overflow = (tmp != res);                                       \
+                return res;                                                     \
+        }
 mulOverflow(S8, S16)
 mulOverflow(S16, S32)
 mulOverflow(S32, S64)
@@ -554,23 +543,23 @@
 mulOverflow(U32, U64)
 #undef mulOverflow
 
-#define check(dst, n1, n2, l, ty);						\
-	do {									\
-		Bool overflow;							\
-		ty tmp;								\
-		tmp = ty##_mulOverflow (n1, n2, &overflow);			\
-		if (DEBUG_CCODEGEN)						\
-			fprintf (stderr, "%s:%d: " #ty "_mulOverflow (%d, %d) = %d\n",	\
-					__FILE__, __LINE__, 			\
-					(int)n1, (int)n2, (int)tmp);		\
-		if (overflow) {							\
-			if (DEBUG_CCODEGEN)					\
-				fprintf (stderr, "%s:%d: overflow\n",		\
-						__FILE__, __LINE__);		\
-			goto l;							\
-		}								\
-		dst = tmp;							\
-	} while (0)
+#define check(dst, n1, n2, l, ty);                                              \
+        do {                                                                    \
+                Bool overflow;                                                  \
+                ty tmp;                                                         \
+                tmp = ty##_mulOverflow (n1, n2, &overflow);                     \
+                if (DEBUG_CCODEGEN)                                             \
+                        fprintf (stderr, "%s:%d: " #ty "_mulOverflow (%d, %d) = %d\n",  \
+                                        __FILE__, __LINE__,                     \
+                                        (int)n1, (int)n2, (int)tmp);            \
+                if (overflow) {                                                 \
+                        if (DEBUG_CCODEGEN)                                     \
+                                fprintf (stderr, "%s:%d: overflow\n",           \
+                                                __FILE__, __LINE__);            \
+                        goto l;                                                 \
+                }                                                               \
+                dst = tmp;                                                      \
+        } while (0)
 
 #define WordS8_mulCheck(dst, n1, n2, l)  check (dst, n1, n2, l, WordS8)
 #define WordS16_mulCheck(dst, n1, n2, l)  check (dst, n1, n2, l, WordS16)

Modified: mlton/branches/on-20050420-cmm-branch/include/c-common.h
===================================================================
--- mlton/branches/on-20050420-cmm-branch/include/c-common.h	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/include/c-common.h	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,11 @@
+/* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ */
+
 #ifndef _C_COMMON_H_
 #define _C_COMMON_H_
 
@@ -6,20 +14,20 @@
 #endif
 
 struct cont {
-	void *nextChunk;
+        void *nextChunk;
 };
 
 #define ChunkName(n) Chunk ## n
 
-#define DeclareChunk(n)				\
-	struct cont ChunkName(n)(void)
+#define DeclareChunk(n)                         \
+        struct cont ChunkName(n)(void)
 
 #define Chunkp(n) &(ChunkName(n))
 
-#define PrepFarJump(n, l)				\
-	do {						\
-		cont.nextChunk = (void*)ChunkName(n);	\
-		nextFun = l;				\
-	} while (0)
+#define PrepFarJump(n, l)                               \
+        do {                                            \
+                cont.nextChunk = (void*)ChunkName(n);   \
+                nextFun = l;                            \
+        } while (0)
 
 #endif /* #ifndef _C_COMMON_H_ */

Modified: mlton/branches/on-20050420-cmm-branch/include/c-main.h
===================================================================
--- mlton/branches/on-20050420-cmm-branch/include/c-main.h	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/include/c-main.h	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,11 @@
+/* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ */
+
 #ifndef _C_MAIN_H_
 #define _C_MAIN_H_
 
@@ -5,57 +13,57 @@
 #include "c-common.h"
 
 static Word32 returnAddressToFrameIndex (Word32 w) {
-	return w;
+        return w;
 }
 
-#define Main(al, cs, mg, mfs, mmc, pk, ps, mc, ml)			\
-/* Globals */								\
-int nextFun;								\
-bool returnToC;								\
-void MLton_callFromC () {						\
-	struct cont cont;						\
-	GC_state s;							\
-									\
-	if (DEBUG_CCODEGEN)						\
-		fprintf (stderr, "MLton_callFromC() starting\n");	\
-	s = &gcState;							\
-	s->savedThread = s->currentThread;				\
-	s->canHandle += 3;						\
-	/* Switch to the C Handler thread. */				\
-	GC_switchToThread (s, s->callFromCHandler, 0);			\
-	nextFun = *(int*)(s->stackTop - WORD_SIZE);			\
-	cont.nextChunk = nextChunks[nextFun];				\
-	returnToC = FALSE;						\
-	do {								\
- 		cont=(*(struct cont(*)(void))cont.nextChunk)();		\
-	} while (not returnToC);					\
-	GC_switchToThread (s, s->savedThread, 0);      			\
- 	s->savedThread = BOGUS_THREAD;					\
-	if (DEBUG_CCODEGEN)						\
-		fprintf (stderr, "MLton_callFromC done\n");		\
-}									\
-int main (int argc, char **argv) {					\
-	struct cont cont;						\
-	Initialize (al, cs, mg, mfs, mmc, pk, ps);			\
-	if (gcState.isOriginal) {					\
-		real_Init();						\
-		PrepFarJump(mc, ml);					\
-	} else {							\
-		/* Return to the saved world */				\
-		nextFun = *(int*)(gcState.stackTop - WORD_SIZE);	\
-		cont.nextChunk = nextChunks[nextFun];			\
-	}								\
-	/* Trampoline */						\
-	while (1) {							\
- 		cont=(*(struct cont(*)(void))cont.nextChunk)();		\
- 		cont=(*(struct cont(*)(void))cont.nextChunk)();		\
- 		cont=(*(struct cont(*)(void))cont.nextChunk)();		\
- 		cont=(*(struct cont(*)(void))cont.nextChunk)();		\
- 		cont=(*(struct cont(*)(void))cont.nextChunk)();		\
- 		cont=(*(struct cont(*)(void))cont.nextChunk)();		\
- 		cont=(*(struct cont(*)(void))cont.nextChunk)();		\
- 		cont=(*(struct cont(*)(void))cont.nextChunk)();		\
-	}								\
+#define Main(al, mg, mfs, mmc, pk, ps, mc, ml)                          \
+/* Globals */                                                           \
+int nextFun;                                                            \
+bool returnToC;                                                         \
+void MLton_callFromC () {                                               \
+        struct cont cont;                                               \
+        GC_state s;                                                     \
+                                                                        \
+        if (DEBUG_CCODEGEN)                                             \
+                fprintf (stderr, "MLton_callFromC() starting\n");       \
+        s = &gcState;                                                   \
+        s->savedThread = s->currentThread;                              \
+        s->canHandle += 3;                                              \
+        /* Switch to the C Handler thread. */                           \
+        GC_switchToThread (s, s->callFromCHandler, 0);                  \
+        nextFun = *(int*)(s->stackTop - WORD_SIZE);                     \
+        cont.nextChunk = nextChunks[nextFun];                           \
+        returnToC = FALSE;                                              \
+        do {                                                            \
+                cont=(*(struct cont(*)(void))cont.nextChunk)();         \
+        } while (not returnToC);                                        \
+        GC_switchToThread (s, s->savedThread, 0);                       \
+        s->savedThread = BOGUS_THREAD;                                  \
+        if (DEBUG_CCODEGEN)                                             \
+                fprintf (stderr, "MLton_callFromC done\n");             \
+}                                                                       \
+int main (int argc, char **argv) {                                      \
+        struct cont cont;                                               \
+        Initialize (al, mg, mfs, mmc, pk, ps);                          \
+        if (gcState.isOriginal) {                                       \
+                real_Init();                                            \
+                PrepFarJump(mc, ml);                                    \
+        } else {                                                        \
+                /* Return to the saved world */                         \
+                nextFun = *(int*)(gcState.stackTop - WORD_SIZE);        \
+                cont.nextChunk = nextChunks[nextFun];                   \
+        }                                                               \
+        /* Trampoline */                                                \
+        while (1) {                                                     \
+                cont=(*(struct cont(*)(void))cont.nextChunk)();         \
+                cont=(*(struct cont(*)(void))cont.nextChunk)();         \
+                cont=(*(struct cont(*)(void))cont.nextChunk)();         \
+                cont=(*(struct cont(*)(void))cont.nextChunk)();         \
+                cont=(*(struct cont(*)(void))cont.nextChunk)();         \
+                cont=(*(struct cont(*)(void))cont.nextChunk)();         \
+                cont=(*(struct cont(*)(void))cont.nextChunk)();         \
+                cont=(*(struct cont(*)(void))cont.nextChunk)();         \
+        }                                                               \
 }
 
 #endif /* #ifndef _C_MAIN_H */

Modified: mlton/branches/on-20050420-cmm-branch/include/cmm-main.h
===================================================================
--- mlton/branches/on-20050420-cmm-branch/include/cmm-main.h	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/include/cmm-main.h	2006-02-16 19:34:54 UTC (rev 4361)
@@ -9,55 +9,55 @@
 #endif
 
 static inline Word32 returnAddressToFrameIndexCutTo (Word32 w) {
-	if (DEBUG_CMMCODEGEN)
-		fprintf (stderr, "returnAddressToFrameIndex(0x%08x) starting\n", (uint)w);
-	Cmm_Cont *k = (Cmm_Cont*)w;
-	if (DEBUG_CMMCODEGEN)
-		fprintf (stderr, "\tCmm_YoungestActivation starting\n");
-	Cmm_Activation a = Cmm_YoungestActivation (k);
-	if (DEBUG_CMMCODEGEN)
-		fprintf (stderr, "\tCmm_YoungestActivation returning: ???\n");
-	if (DEBUG_CMMCODEGEN)
-		fprintf (stderr, "\tCmm_GetDescriptor starting\n");
-	Cmm_Dataptr ptr = Cmm_GetDescriptor (&a, 1);
-	if (DEBUG_CMMCODEGEN)
-		fprintf (stderr, "\tCmm_GetDescriptor returning: 0x%08x\n", ptr);
-	Word32 fi = *((Word32*)ptr);
-	if (DEBUG_CMMCODEGEN)
-		fprintf (stderr, "returnAddressToFrameIndex(0x%08x) returning: 0x%08x\n", (uint)w, fi);
-	return fi;
+        if (DEBUG_CMMCODEGEN)
+                fprintf (stderr, "returnAddressToFrameIndex(0x%08x) starting\n", (uint)w);
+        Cmm_Cont *k = (Cmm_Cont*)w;
+        if (DEBUG_CMMCODEGEN)
+                fprintf (stderr, "\tCmm_YoungestActivation starting\n");
+        Cmm_Activation a = Cmm_YoungestActivation (k);
+        if (DEBUG_CMMCODEGEN)
+                fprintf (stderr, "\tCmm_YoungestActivation returning: ???\n");
+        if (DEBUG_CMMCODEGEN)
+                fprintf (stderr, "\tCmm_GetDescriptor starting\n");
+        Cmm_Dataptr ptr = Cmm_GetDescriptor (&a, 1);
+        if (DEBUG_CMMCODEGEN)
+                fprintf (stderr, "\tCmm_GetDescriptor returning: 0x%08x\n", ptr);
+        Word32 fi = *((Word32*)ptr);
+        if (DEBUG_CMMCODEGEN)
+                fprintf (stderr, "returnAddressToFrameIndex(0x%08x) returning: 0x%08x\n", (uint)w, fi);
+        return fi;
 }
 
 static inline Word32 returnAddressToFrameIndexReturn (Word32 w) {
-	if (DEBUG_CMMCODEGEN)
-		fprintf (stderr, "returnAddressToFrameIndex(0x%08x) starting\n", (uint)w);
-	Word32 fi = w;
-	if (DEBUG_CMMCODEGEN)
-		fprintf (stderr, "returnAddressToFrameIndex(0x%08x) returning: 0x%08x\n", (uint)w, fi);
-	return fi;
+        if (DEBUG_CMMCODEGEN)
+                fprintf (stderr, "returnAddressToFrameIndex(0x%08x) starting\n", (uint)w);
+        Word32 fi = w;
+        if (DEBUG_CMMCODEGEN)
+                fprintf (stderr, "returnAddressToFrameIndex(0x%08x) returning: 0x%08x\n", (uint)w, fi);
+        return fi;
 }
 
-#define Main(al, cs, mg, mfs, mmc, pk, ps, mf, nt)			\
-static Word32 returnAddressToFrameIndex (Word32 w) {			\
-	if (nt) {      							\
-		return returnAddressToFrameIndexCutTo(w);		\
-	} else {							\
-		return returnAddressToFrameIndexReturn(w);		\
-	}								\
-}									\
-void mf ();								\
-void MLton_callFromC () {						\
-	die ("cmm-main.h: MLton_callfromC\n");				\
-}									\
-int main (int argc, char **argv) {					\
-	Initialize (al, cs, mg, mfs, mmc, pk, ps);			\
-	if (gcState.isOriginal) {					\
-		real_Init();						\
-		mf ();							\
-	} else {							\
-		die ("cmm-main.h: !gcState.isOriginal\n");		\
-	}								\
-	return 1;							\
+#define Main(al, mg, mfs, mmc, pk, ps, mf, nt)                          \
+static Word32 returnAddressToFrameIndex (Word32 w) {                    \
+        if (nt) {                                                       \
+                return returnAddressToFrameIndexCutTo(w);               \
+        } else {                                                        \
+                return returnAddressToFrameIndexReturn(w);              \
+        }                                                               \
+}                                                                       \
+void mf ();                                                             \
+void MLton_callFromC () {                                               \
+        die ("cmm-main.h: MLton_callfromC\n");                          \
+}                                                                       \
+int main (int argc, char **argv) {                                      \
+        Initialize (al, mg, mfs, mmc, pk, ps);                          \
+        if (gcState.isOriginal) {                                       \
+                real_Init();                                            \
+                mf ();                                                  \
+        } else {                                                        \
+                die ("cmm-main.h: !gcState.isOriginal\n");              \
+        }                                                               \
+        return 1;                                                       \
 }
 
 #endif /* #ifndef _C_MAIN_H */

Modified: mlton/branches/on-20050420-cmm-branch/include/main.h
===================================================================
--- mlton/branches/on-20050420-cmm-branch/include/main.h	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/include/main.h	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,11 @@
+/* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ */
+
 #ifndef _MAIN_H_
 #define _MAIN_H_
 
@@ -6,8 +14,8 @@
 /* The label must be declared as weak because gcc's optimizer may prove that
  * the code that declares the label is dead and hence eliminate the declaration.
  */
-#define DeclareProfileLabel(l)			\
-	void l() __attribute__ ((weak))
+#define DeclareProfileLabel(l)                  \
+        extern char l __attribute__ ((weak))
 
 #define BeginIntInfs static struct GC_intInfInit intInfInits[] = {
 #define IntInf(g, n) { g, n },
@@ -22,41 +30,40 @@
 
 Pointer gcStateAddress;
 
-#define Initialize(al, cs, mg, mfs, mmc, pk, ps)			\
-	gcStateAddress = &gcState;					\
-	gcState.alignment = al;						\
-	gcState.atMLtons = atMLtons;					\
-	gcState.atMLtonsSize = cardof(atMLtons);		       	\
-	gcState.cardSizeLog2 = cs;					\
-	gcState.frameLayouts = frameLayouts;				\
-	gcState.frameLayoutsSize = cardof(frameLayouts); 		\
-	gcState.frameSources = frameSources;				\
-	gcState.frameSourcesSize = cardof(frameSources);		\
-	gcState.globals = globalPointer;				\
-	gcState.globalsSize = cardof(globalPointer);			\
-	gcState.intInfInits = intInfInits;				\
-	gcState.intInfInitsSize = cardof(intInfInits);			\
-	gcState.loadGlobals = loadGlobals;				\
-	gcState.magic = mg;						\
-	gcState.maxFrameSize = mfs;					\
-	gcState.mutatorMarksCards = mmc;				\
-	gcState.objectTypes = objectTypes;				\
-	gcState.objectTypesSize = cardof(objectTypes);			\
-	gcState.profileKind = pk;					\
-	gcState.profileStack = ps;					\
-	gcState.returnAddressToFrameIndex = returnAddressToFrameIndex;	\
-	gcState.saveGlobals = saveGlobals;				\
-	gcState.sourceLabels = sourceLabels;				\
-	gcState.sourceLabelsSize = cardof(sourceLabels);		\
-	gcState.sourceNames = sourceNames;				\
-	gcState.sourceNamesSize = cardof(sourceNames);			\
-	gcState.sourceSeqs = sourceSeqs;				\
-	gcState.sourceSeqsSize = cardof(sourceSeqs);			\
-	gcState.sources = sources;					\
-	gcState.sourcesSize = cardof(sources);				\
-	gcState.vectorInits = vectorInits;				\
-	gcState.vectorInitsSize = cardof(vectorInits);			\
-	MLton_init (argc, argv, &gcState);				\
+#define Initialize(al, mg, mfs, mmc, pk, ps)                            \
+        gcStateAddress = &gcState;                                      \
+        gcState.alignment = al;                                         \
+        gcState.atMLtons = atMLtons;                                    \
+        gcState.atMLtonsSize = cardof(atMLtons);                        \
+        gcState.frameLayouts = frameLayouts;                            \
+        gcState.frameLayoutsSize = cardof(frameLayouts);                \
+        gcState.frameSources = frameSources;                            \
+        gcState.frameSourcesSize = cardof(frameSources);                \
+        gcState.globals = globalPointer;                                \
+        gcState.globalsSize = cardof(globalPointer);                    \
+        gcState.intInfInits = intInfInits;                              \
+        gcState.intInfInitsSize = cardof(intInfInits);                  \
+        gcState.loadGlobals = loadGlobals;                              \
+        gcState.magic = mg;                                             \
+        gcState.maxFrameSize = mfs;                                     \
+        gcState.mutatorMarksCards = mmc;                                \
+        gcState.objectTypes = objectTypes;                              \
+        gcState.objectTypesSize = cardof(objectTypes);                  \
+        gcState.profileKind = pk;                                       \
+        gcState.profileStack = ps;                                      \
+        gcState.returnAddressToFrameIndex = returnAddressToFrameIndex;  \
+        gcState.saveGlobals = saveGlobals;                              \
+        gcState.sourceLabels = sourceLabels;                            \
+        gcState.sourceLabelsSize = cardof(sourceLabels);                \
+        gcState.sourceNames = sourceNames;                              \
+        gcState.sourceNamesSize = cardof(sourceNames);                  \
+        gcState.sourceSeqs = sourceSeqs;                                \
+        gcState.sourceSeqsSize = cardof(sourceSeqs);                    \
+        gcState.sources = sources;                                      \
+        gcState.sourcesSize = cardof(sources);                          \
+        gcState.vectorInits = vectorInits;                              \
+        gcState.vectorInitsSize = cardof(vectorInits);                  \
+        MLton_init (argc, argv, &gcState);                              \
 
 void MLton_callFromC ();
 

Modified: mlton/branches/on-20050420-cmm-branch/include/x86-main.h
===================================================================
--- mlton/branches/on-20050420-cmm-branch/include/x86-main.h	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/include/x86-main.h	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,10 @@
+/* Copyright (C) 2000-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ */
+
 #ifndef _X86_MAIN_H_
 #define _X86_MAIN_H_
 
@@ -51,65 +58,65 @@
 #endif
 
 static Word32 returnAddressToFrameIndex (Word32 w) {
-	return *((Word32*)(w - sizeof(Word32)));
+        return *((Word32*)(w - sizeof(Word32)));
 }
 
-#define Main(al, cs, mg, mfs, mmc, pk, ps, ml, reserveEsp)		\
-void MLton_jumpToSML (pointer jump) {					\
-	Word lc_stackP;							\
-			       						\
-	if (DEBUG_X86CODEGEN)						\
-		fprintf (stderr, "MLton_jumpToSML(0x%08x) starting\n", (uint)jump); \
-	lc_stackP = c_stackP;						\
-	if (reserveEsp)							\
-		__asm__ __volatile__					\
-		("pusha\nmovl %%esp,%0\nmovl %1,%%ebp\nmovl %2,%%edi\njmp *%3\n.global "ReturnToC"\n"ReturnToC":\nmovl %0,%%esp\npopa" \
-		: "=o" (c_stackP)					\
-		: "o" (gcState.stackTop), "o" (gcState.frontier), "r" (jump) \
-		);							\
-	else								\
-		__asm__ __volatile__ 					\
-		("pusha\nmovl %%esp,%0\nmovl %1,%%ebp\nmovl %2,%%esp\njmp *%3\n.global "ReturnToC"\n"ReturnToC":\nmovl %0,%%esp\npopa" \
-		: "=o" (c_stackP)					\
-		: "o" (gcState.stackTop), "o" (gcState.frontier), "r" (jump) \
-		);							\
-	c_stackP = lc_stackP;						\
-	if (DEBUG_X86CODEGEN)						\
-		fprintf (stderr, "MLton_jumpToSML(0x%08x) done\n", (uint)jump); \
-	return;								\
-}									\
-void MLton_callFromC () {						\
-	pointer jump;							\
-	GC_state s;							\
-									\
-	if (DEBUG_X86CODEGEN)						\
-		fprintf (stderr, "MLton_callFromC() starting\n");	\
-	s = &gcState;							\
-	s->savedThread = s->currentThread;				\
-	s->canHandle += 3;						\
-	/* Return to the C Handler thread. */				\
-	GC_switchToThread (s, s->callFromCHandler, 0);			\
-	jump = *(pointer*)(s->stackTop - WORD_SIZE);			\
-	MLton_jumpToSML(jump);						\
-	GC_switchToThread (s, s->savedThread, 0);      			\
-	s->savedThread = BOGUS_THREAD;					\
-	if (DEBUG_X86CODEGEN)						\
-		fprintf (stderr, "MLton_callFromC() done\n");		\
-	return;								\
-}									\
-int main (int argc, char **argv) {					\
-	pointer jump;  							\
-	extern pointer ml;						\
-									\
-	Initialize (al, cs, mg, mfs, mmc, pk, ps);			\
-	if (gcState.isOriginal) {					\
-		real_Init();						\
-		jump = (pointer)&ml;   					\
-	} else {       							\
-		jump = *(pointer*)(gcState.stackTop - WORD_SIZE); 	\
-	}								\
-	MLton_jumpToSML(jump);						\
-	return 1;							\
+#define Main(al, mg, mfs, mmc, pk, ps, ml, reserveEsp)                  \
+void MLton_jumpToSML (pointer jump) {                                   \
+        Word lc_stackP;                                                 \
+                                                                        \
+        if (DEBUG_X86CODEGEN)                                           \
+                fprintf (stderr, "MLton_jumpToSML(0x%08x) starting\n", (uint)jump); \
+        lc_stackP = c_stackP;                                           \
+        if (reserveEsp)                                                 \
+                __asm__ __volatile__                                    \
+                ("pusha\nmovl %%esp,%0\nmovl %1,%%ebp\nmovl %2,%%edi\njmp *%3\n.global "ReturnToC"\n"ReturnToC":\nmovl %0,%%esp\npopa" \
+                : "=o" (c_stackP)                                       \
+                : "o" (gcState.stackTop), "o" (gcState.frontier), "r" (jump) \
+                );                                                      \
+        else                                                            \
+                __asm__ __volatile__                                    \
+                ("pusha\nmovl %%esp,%0\nmovl %1,%%ebp\nmovl %2,%%esp\njmp *%3\n.global "ReturnToC"\n"ReturnToC":\nmovl %0,%%esp\npopa" \
+                : "=o" (c_stackP)                                       \
+                : "o" (gcState.stackTop), "o" (gcState.frontier), "r" (jump) \
+                );                                                      \
+        c_stackP = lc_stackP;                                           \
+        if (DEBUG_X86CODEGEN)                                           \
+                fprintf (stderr, "MLton_jumpToSML(0x%08x) done\n", (uint)jump); \
+        return;                                                         \
+}                                                                       \
+void MLton_callFromC () {                                               \
+        pointer jump;                                                   \
+        GC_state s;                                                     \
+                                                                        \
+        if (DEBUG_X86CODEGEN)                                           \
+                fprintf (stderr, "MLton_callFromC() starting\n");       \
+        s = &gcState;                                                   \
+        s->savedThread = s->currentThread;                              \
+        s->canHandle += 3;                                              \
+        /* Return to the C Handler thread. */                           \
+        GC_switchToThread (s, s->callFromCHandler, 0);                  \
+        jump = *(pointer*)(s->stackTop - WORD_SIZE);                    \
+        MLton_jumpToSML(jump);                                          \
+        GC_switchToThread (s, s->savedThread, 0);                       \
+        s->savedThread = BOGUS_THREAD;                                  \
+        if (DEBUG_X86CODEGEN)                                           \
+                fprintf (stderr, "MLton_callFromC() done\n");           \
+        return;                                                         \
+}                                                                       \
+int main (int argc, char **argv) {                                      \
+        pointer jump;                                                   \
+        extern pointer ml;                                              \
+                                                                        \
+        Initialize (al, mg, mfs, mmc, pk, ps);                          \
+        if (gcState.isOriginal) {                                       \
+                real_Init();                                            \
+                jump = (pointer)&ml;                                    \
+        } else {                                                        \
+                jump = *(pointer*)(gcState.stackTop - WORD_SIZE);       \
+        }                                                               \
+        MLton_jumpToSML(jump);                                          \
+        return 1;                                                       \
 }
 
 #endif /* #ifndef _X86_MAIN_H_ */

Modified: mlton/branches/on-20050420-cmm-branch/lib/Makefile
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/Makefile	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/Makefile	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,11 @@
+## Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ #    Jagannathan, and Stephen Weeks.
+ # Copyright (C) 1997-2000 NEC Research Institute.
+ #
+ # MLton is released under a BSD-style license.
+ # See the file MLton-LICENSE for details.
+ ##
+
 all:
 
 .PHONY: clean

Modified: mlton/branches/on-20050420-cmm-branch/lib/basis-stubs/Makefile
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/basis-stubs/Makefile	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/basis-stubs/Makefile	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,10 @@
+## Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ #    Jagannathan, and Stephen Weeks.
+ # Copyright (C) 1997-2000 NEC Research Institute.
+ #
+ # MLton is released under a BSD-style license.
+ # See the file MLton-LICENSE for details.
+ ##
 
 .PHONY: clean
 clean:

Modified: mlton/branches/on-20050420-cmm-branch/lib/basis-stubs/basis-2002.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/basis-stubs/basis-2002.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/basis-stubs/basis-2002.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,10 @@
+(* Copyright (C) 2002-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 structure Basis2002 = 
    struct
       structure Array = Array
@@ -24,8 +31,6 @@
       structure Math = Math
       structure OS = OS
       structure Option = Option
-      structure Pack32Big = Pack32Big
-      structure Pack32Little = Pack32Little
       structure Position = Position
       structure Posix = Posix
       structure Real = Real

Modified: mlton/branches/on-20050420-cmm-branch/lib/basis-stubs/sources.cm
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/basis-stubs/sources.cm	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/basis-stubs/sources.cm	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,10 @@
+(* Copyright (C) 2002-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 Library
 
 structure Basis2002

Copied: mlton/branches/on-20050420-cmm-branch/lib/ckit-lib (from rev 4358, mlton/trunk/lib/ckit-lib)


Property changes on: mlton/branches/on-20050420-cmm-branch/lib/ckit-lib
___________________________________________________________________
Name: svn:ignore
   + ckit


Modified: mlton/branches/on-20050420-cmm-branch/lib/cml/cml-lib/cml-lib.mlb
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/cml/cml-lib/cml-lib.mlb	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/cml/cml-lib/cml-lib.mlb	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,20 +1,20 @@
 ann
-  "sequenceUnit true"
-  "warnMatch true"
-  "warnUnused true"
+   "sequenceNonUnit warn"
+   "nonexhaustiveMatch warn" "redundantMatch warn"
+   "warnUnused true"
 in
-local
-  $(SML_LIB)/basis/basis.mlb
-  ../core-cml/core-cml.mlb
-  multicast.sig
-  multicast.sml
-  simple-rpc.sig
-  simple-rpc.sml
-in
-  signature MULTICAST
-  structure Multicast
+   local
+      $(SML_LIB)/basis/basis.mlb
+      ../core-cml/core-cml.mlb
+      multicast.sig
+      multicast.sml
+      simple-rpc.sig
+      simple-rpc.sml
+   in
+      signature MULTICAST
+      structure Multicast
 
-  signature SIMPLE_RPC
-  structure SimpleRPC
+      signature SIMPLE_RPC
+      structure SimpleRPC
+   end
 end
-end

Modified: mlton/branches/on-20050420-cmm-branch/lib/cml/cml-lib/multicast.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/cml/cml-lib/multicast.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/cml/cml-lib/multicast.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -15,7 +15,7 @@
       type 'a mchan
       type 'a port
       type 'a event = 'a CML.event
-	  
+          
       (* create a new multicast channel *)
       val mChannel : unit -> 'a mchan
       (* create a new output port on a channel *)

Modified: mlton/branches/on-20050420-cmm-branch/lib/cml/cml-lib/multicast.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/cml/cml-lib/multicast.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/cml/cml-lib/multicast.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -20,56 +20,56 @@
       type 'a event = 'a CML.event
 
       datatype 'a request = 
-	 Message of 'a 
+         Message of 'a 
        | NewPort 
       datatype 'a mc_state = MCState of ('a * 'a mc_state SV.ivar)
       datatype 'a port =
-	 Port of (('a * 'a mc_state SV.ivar) CML.chan * 'a mc_state SV.ivar SV.mvar)
+         Port of (('a * 'a mc_state SV.ivar) CML.chan * 'a mc_state SV.ivar SV.mvar)
       datatype 'a mchan = 
-	 MChan of ('a request CML.chan * 'a port CML.chan)
+         MChan of ('a request CML.chan * 'a port CML.chan)
 
     fun mkPort cv = 
        let
-	  val outCh = CML.channel()
-	  val stateVar = SV.mVarInit cv
-	  fun tee cv = 
-	     let
-		val (MCState(v, nextCV)) = SV.iGet cv
-	     in
-		CML.send (outCh, (v, nextCV))
-		; tee nextCV
-	     end
-	  val _ = CML.spawn (fn () => tee cv)
+          val outCh = CML.channel()
+          val stateVar = SV.mVarInit cv
+          fun tee cv = 
+             let
+                val (MCState(v, nextCV)) = SV.iGet cv
+             in
+                CML.send (outCh, (v, nextCV))
+                ; tee nextCV
+             end
+          val _ = CML.spawn (fn () => tee cv)
        in
-	  Port(outCh, stateVar)
+          Port(outCh, stateVar)
        end
     
     fun mChannel () = 
        let
           val reqCh = CML.channel() 
-	  and replyCh = CML.channel()
+          and replyCh = CML.channel()
           fun server cv = 
-	     case (CML.recv reqCh) of 
-		NewPort => 
-		   (CML.send (replyCh, mkPort cv)
-		    ; server cv)
-	      | (Message m) => 
-		   let
-		      val nextCV = SV.iVar()
-		   in
-		      SV.iPut (cv, MCState(m, nextCV))
-		      ; server nextCV
-		   end
-	  val _ = CML.spawn (fn () => server (SV.iVar()))
+             case (CML.recv reqCh) of 
+                NewPort => 
+                   (CML.send (replyCh, mkPort cv)
+                    ; server cv)
+              | (Message m) => 
+                   let
+                      val nextCV = SV.iVar()
+                   in
+                      SV.iPut (cv, MCState(m, nextCV))
+                      ; server nextCV
+                   end
+          val _ = CML.spawn (fn () => server (SV.iVar()))
        in
-	  MChan(reqCh, replyCh)
+          MChan(reqCh, replyCh)
        end
 
     fun multicast (MChan(ch, _), m) = CML.send (ch, Message m)
 
     fun port (MChan(reqCh, replyCh)) = 
        (CML.send (reqCh, NewPort)
-	; CML.recv replyCh)
+        ; CML.recv replyCh)
        
     fun copy (Port(_, stateV)) = mkPort(SV.mGet stateV)
        

Modified: mlton/branches/on-20050420-cmm-branch/lib/cml/cml-lib/result.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/cml/cml-lib/result.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/cml/cml-lib/result.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -12,7 +12,7 @@
 signature RESULT = 
    sig
       type 'a result
-	 
+         
       val result : unit -> 'a result
       val put    : ('a result * 'a) -> unit
       val putExn : ('a result * exn) -> unit

Modified: mlton/branches/on-20050420-cmm-branch/lib/cml/cml-lib/result.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/cml/cml-lib/result.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/cml/cml-lib/result.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -22,7 +22,7 @@
       fun put (iv, v) = SV.iPut(iv, RES v)
       fun putExn (iv, ex) = SV.iPut(iv, EXN ex)
       fun wrap (RES v) = v
-	| wrap (EXN ex) = raise ex
+        | wrap (EXN ex) = raise ex
       fun get iv = wrap(SV.iGet iv)
       fun getEvt iv = CML.wrap(SV.iGetEvt iv, wrap)
   end

Modified: mlton/branches/on-20050420-cmm-branch/lib/cml/cml-lib/simple-rpc.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/cml/cml-lib/simple-rpc.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/cml/cml-lib/simple-rpc.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -15,18 +15,18 @@
       type 'a event = 'a CML.event
 
       val mkRPC : ('a -> 'b) -> 
-	 {call     : 'a -> 'b,
-	  entryEvt : unit event}
-	 
+         {call     : 'a -> 'b,
+          entryEvt : unit event}
+         
       val mkRPC_In : (('a * 'c) -> 'b) -> 
-	 {call     : 'a -> 'b,
-	  entryEvt : 'c -> unit event}
+         {call     : 'a -> 'b,
+          entryEvt : 'c -> unit event}
 
       val mkRPC_Out : ('a -> ('b * 'c)) -> 
-	 {call     : 'a -> 'b,
-	  entryEvt : 'c event}
+         {call     : 'a -> 'b,
+          entryEvt : 'c event}
 
       val mkRPC_InOut : (('a * 'c) -> ('b * 'd)) -> 
-	 {call     : 'a -> 'b,
-	  entryEvt : 'c -> 'd event}
+         {call     : 'a -> 'b,
+          entryEvt : 'c -> 'd event}
   end

Modified: mlton/branches/on-20050420-cmm-branch/lib/cml/cml-lib/simple-rpc.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/cml/cml-lib/simple-rpc.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/cml/cml-lib/simple-rpc.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -16,60 +16,60 @@
       type 'a event = 'a CML.event
 
       fun call reqMB arg = 
-	 let val replV = SyncVar.iVar()
-	 in
-	    Mailbox.send(reqMB, (arg, replV))
-	    ; SyncVar.iGet replV
-	 end
+         let val replV = SyncVar.iVar()
+         in
+            Mailbox.send(reqMB, (arg, replV))
+            ; SyncVar.iGet replV
+         end
 
       fun mkRPC f = 
-	 let
-	    val reqMB = Mailbox.mailbox()
-	    val entryEvt = 
-	       CML.wrap 
-	       (Mailbox.recvEvt reqMB, fn (arg, replV) => 
-		SyncVar.iPut(replV, f arg))
-	 in
-	    {call = call reqMB, entryEvt = entryEvt}
-	 end
+         let
+            val reqMB = Mailbox.mailbox()
+            val entryEvt = 
+               CML.wrap 
+               (Mailbox.recvEvt reqMB, fn (arg, replV) => 
+                SyncVar.iPut(replV, f arg))
+         in
+            {call = call reqMB, entryEvt = entryEvt}
+         end
 
       fun mkRPC_In f = 
-	 let
-	    val reqMB = Mailbox.mailbox()
-	    val reqEvt = Mailbox.recvEvt reqMB
-	    fun entryEvt state = 
-	       CML.wrap 
-	       (reqEvt, fn (arg, replV) => 
-		SyncVar.iPut(replV, f(arg, state)))
-	 in
-	    {call = call reqMB, entryEvt = entryEvt}
-	 end
+         let
+            val reqMB = Mailbox.mailbox()
+            val reqEvt = Mailbox.recvEvt reqMB
+            fun entryEvt state = 
+               CML.wrap 
+               (reqEvt, fn (arg, replV) => 
+                SyncVar.iPut(replV, f(arg, state)))
+         in
+            {call = call reqMB, entryEvt = entryEvt}
+         end
 
       fun mkRPC_Out f = 
-	 let
-	    val reqMB = Mailbox.mailbox()
-	    val reqEvt = Mailbox.recvEvt reqMB
-	    val entryEvt = 
-	       CML.wrap 
-	       (reqEvt, fn (arg, replV) => 
-		let val (res, state') = f arg
-		in SyncVar.iPut(replV, res); state'
-		end)
-	 in
-	    {call = call reqMB, entryEvt = entryEvt}
-	 end
+         let
+            val reqMB = Mailbox.mailbox()
+            val reqEvt = Mailbox.recvEvt reqMB
+            val entryEvt = 
+               CML.wrap 
+               (reqEvt, fn (arg, replV) => 
+                let val (res, state') = f arg
+                in SyncVar.iPut(replV, res); state'
+                end)
+         in
+            {call = call reqMB, entryEvt = entryEvt}
+         end
 
       fun mkRPC_InOut f = 
-	 let
-	    val reqMB = Mailbox.mailbox()
-	    val reqEvt = Mailbox.recvEvt reqMB
-	    fun entryEvt state = 
-	       CML.wrap 
-	       (reqEvt, fn (arg, replV) => 
-		let val (res, state') = f(arg, state)
-		in SyncVar.iPut(replV, res); state'
-		end)
-	 in
-	    {call = call reqMB, entryEvt = entryEvt}
-	 end
+         let
+            val reqMB = Mailbox.mailbox()
+            val reqEvt = Mailbox.recvEvt reqMB
+            fun entryEvt state = 
+               CML.wrap 
+               (reqEvt, fn (arg, replV) => 
+                let val (res, state') = f(arg, state)
+                in SyncVar.iPut(replV, res); state'
+                end)
+         in
+            {call = call reqMB, entryEvt = entryEvt}
+         end
    end

Modified: mlton/branches/on-20050420-cmm-branch/lib/cml/cml-lib/trace-cml.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/cml/cml-lib/trace-cml.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/cml/cml-lib/trace-cml.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -30,65 +30,65 @@
       | TraceToStream of TextIO.outstream
 
     val setTraceFile : trace_to -> unit
-	(* Direct the destination of trace output.  Note: TraceToStream
-	 * can only be specified as a destination if CML is running.
-	 *)
+        (* Direct the destination of trace output.  Note: TraceToStream
+         * can only be specified as a destination if CML is running.
+         *)
 
     val traceRoot : trace_module
-	(* the root module of the trace hierarchy *)
+        (* the root module of the trace hierarchy *)
 
     exception NoSuchModule
 
     val traceModule : (trace_module * string) -> trace_module
     val nameOf : trace_module -> string
-	(* return the name of the module *)
+        (* return the name of the module *)
     val moduleOf : string -> trace_module
-	(* return the module specified by the given string, or raise
-	 * NoSuchModule if none exists.
-	 *)
+        (* return the module specified by the given string, or raise
+         * NoSuchModule if none exists.
+         *)
 
     val traceOn : trace_module -> unit
-	(* turn tracing on for a module and its descendents *)
+        (* turn tracing on for a module and its descendents *)
     val traceOff : trace_module -> unit
-	(* turn tracing off for a module and its descendents *)
+        (* turn tracing off for a module and its descendents *)
     val traceOnly : trace_module -> unit
-	(* turn tracing on for a module (but not for its descendents) *)
+        (* turn tracing on for a module (but not for its descendents) *)
     val amTracing : trace_module -> bool
-	(* return true if this module is being traced *)
+        (* return true if this module is being traced *)
 
     val status : trace_module -> (trace_module * bool) list
-	(* return a list of the registered modules dominated by the given
-	 * module, and their status.
-	 *)
+        (* return a list of the registered modules dominated by the given
+         * module, and their status.
+         *)
 
     val trace : (trace_module * (unit -> string list)) -> unit
-	(* conditionally generate tracing output *)
+        (* conditionally generate tracing output *)
 
 
   (** Thread watching **)
   
     val watcher : trace_module
-	(* controls printing of thread watching messages; the module's name
-	 * is "/ThreadWatcher/"
-	 *)
+        (* controls printing of thread watching messages; the module's name
+         * is "/ThreadWatcher/"
+         *)
     val watch : (string * CML.thread_id) -> unit
-	(* watch the given thread for unexpected termination *)
+        (* watch the given thread for unexpected termination *)
     val unwatch : CML.thread_id -> unit
-	(* stop watching the named thread *)
+        (* stop watching the named thread *)
 
   (** Uncaught exception handling **)
 
     val setUncaughtFn : ((CML.thread_id * exn) -> unit) -> unit
-	(* this sets the default uncaught exception action. *)
+        (* this sets the default uncaught exception action. *)
     val setHandleFn : ((CML.thread_id * exn) -> bool) -> unit
-	(* add an additional uncaught exception action.  If the action returns
-	 * true, then no further action is taken.  This can be used to handle
-	 * application specific exceptions.
-	 *)
+        (* add an additional uncaught exception action.  If the action returns
+         * true, then no further action is taken.  This can be used to handle
+         * application specific exceptions.
+         *)
     val resetUncaughtFn : unit -> unit
-	(* this resets the default uncaught exception action to the system default,
-	 * and removes any layered actions.
-	 *)
+        (* this resets the default uncaught exception action to the system default,
+         * and removes any layered actions.
+         *)
 
   end; (* TRACE_CML *)
 

Modified: mlton/branches/on-20050420-cmm-branch/lib/cml/cml-lib/trace-cml.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/cml/cml-lib/trace-cml.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/cml/cml-lib/trace-cml.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -27,63 +27,63 @@
 
   (** Trace Modules **)
     datatype trace_module = TM of {
-	full_name : string,
-	label : string,
-	tracing : bool ref,
-	children : trace_module list ref
+        full_name : string,
+        label : string,
+        tracing : bool ref,
+        children : trace_module list ref
       }
 
     val traceRoot = TM{
-	    full_name = "/",
-	    label = "",
-	    tracing = ref false,
-	    children = ref []
-	  }
+            full_name = "/",
+            label = "",
+            tracing = ref false,
+            children = ref []
+          }
 
     fun forAll f = let
-	  fun for (tm as TM{children, ...}) = (f tm; forChildren(!children))
-	  and forChildren [] = ()
-	    | forChildren (tm::r) = (for tm; forChildren r)
-	  in
-	    for
-	  end
+          fun for (tm as TM{children, ...}) = (f tm; forChildren(!children))
+          and forChildren [] = ()
+            | forChildren (tm::r) = (for tm; forChildren r)
+          in
+            for
+          end
 
     structure SS = Substring
 
     fun findTraceModule name = let
-	  fun eq ss (TM{label, ...}) = (SS.compare(SS.all label, ss) = EQUAL)
-	  fun find ([], tm) = SOME tm
-	    | find (arc::rest, tm as TM{label, children, ...}) = let
-		val eqArc = eq arc
-		fun findChild [] = NONE
-		  | findChild (c::r) =
-		      if (eqArc c) then find(rest, c) else findChild r
-		in
-		  findChild (!children)
-		end
-	  in
-	    find (
-	      SS.tokens (fn #"/" => true | _ => false) (SS.all name),
-	      traceRoot)
-	  end
+          fun eq ss (TM{label, ...}) = (SS.compare(SS.all label, ss) = EQUAL)
+          fun find ([], tm) = SOME tm
+            | find (arc::rest, tm as TM{label, children, ...}) = let
+                val eqArc = eq arc
+                fun findChild [] = NONE
+                  | findChild (c::r) =
+                      if (eqArc c) then find(rest, c) else findChild r
+                in
+                  findChild (!children)
+                end
+          in
+            find (
+              SS.tokens (fn #"/" => true | _ => false) (SS.all name),
+              traceRoot)
+          end
 
     fun traceModule' (TM parent, name) = let
-	  fun checkChildren [] = let
-		val tm = TM{
-		        full_name = (#full_name parent ^ name),
-		        label = name,
-			tracing = ref(!(#tracing parent)),
-		        children = ref []
-		      }
-		in
-		  (#children parent) := tm :: !(#children parent);
-		  tm
-		end
-	    | checkChildren((tm as TM{label, ...})::r) =
-		if (label = name) then tm else checkChildren r
-	  in
-	    checkChildren (! (#children parent))
-	  end
+          fun checkChildren [] = let
+                val tm = TM{
+                        full_name = (#full_name parent ^ name),
+                        label = name,
+                        tracing = ref(!(#tracing parent)),
+                        children = ref []
+                      }
+                in
+                  (#children parent) := tm :: !(#children parent);
+                  tm
+                end
+            | checkChildren((tm as TM{label, ...})::r) =
+                if (label = name) then tm else checkChildren r
+          in
+            checkChildren (! (#children parent))
+          end
 
   (* return the name of the module *)
     fun nameOf (TM{full_name, ...}) = full_name
@@ -110,13 +110,13 @@
    * module, and their status.
    *)
     fun status' root = let
-	  fun list (tm as TM{tracing, children, ...}, l) =
-		listChildren (!children, (tm, !tracing)::l)
-	  and listChildren ([], l) = l
-	    | listChildren (c::r, l) = listChildren(r, list(c, l))
-	  in
-	    rev (list (root, []))
-	  end
+          fun list (tm as TM{tracing, children, ...}, l) =
+                listChildren (!children, (tm, !tracing)::l)
+          and listChildren ([], l) = l
+            | listChildren (c::r, l) = listChildren(r, list(c, l))
+          in
+            rev (list (root, []))
+          end
 
   (** Trace printing **)
     val traceDst = ref TraceToOut
@@ -129,66 +129,66 @@
  ** was TraceToFile).
  **)
     fun tracePrint s = let
-	  fun output strm = (TextIO.output(strm, s); TextIO.flushOut strm)
-	  in
-	    case !traceDst
-	     of TraceToOut => output TextIO.stdOut
-	      | TraceToErr => output TextIO.stdErr
-	      | TraceToNull => ()
-	      | (TraceToFile fname) => let
-		  val dst = let
-			val strm = TextIO.openOut fname
-			in
-			  traceCleanup := (fn () => TextIO.closeOut strm);
-			  TraceToStream strm
-			end handle _ => (
-			  Debug.sayDebug(concat[
-			      "TraceCML: unable to open \"", fname,
-			      "\", redirecting to stdout"
-			    ]);
-			  TraceToOut)
-		  in
-		    setTraceFile' dst;
-		    tracePrint s
-		  end
-	        | (TraceToStream strm) => output strm
-	    (* end case *)
-	  end
+          fun output strm = (TextIO.output(strm, s); TextIO.flushOut strm)
+          in
+            case !traceDst
+             of TraceToOut => output TextIO.stdOut
+              | TraceToErr => output TextIO.stdErr
+              | TraceToNull => ()
+              | (TraceToFile fname) => let
+                  val dst = let
+                        val strm = TextIO.openOut fname
+                        in
+                          traceCleanup := (fn () => TextIO.closeOut strm);
+                          TraceToStream strm
+                        end handle _ => (
+                          Debug.sayDebug(concat[
+                              "TraceCML: unable to open \"", fname,
+                              "\", redirecting to stdout"
+                            ]);
+                          TraceToOut)
+                  in
+                    setTraceFile' dst;
+                    tracePrint s
+                  end
+                | (TraceToStream strm) => output strm
+            (* end case *)
+          end
 
   (** Trace server **)
     val traceCh : (unit -> string list) CML.chan = CML.channel()
     val traceUpdateCh : (unit -> unit) CML.chan = CML.channel()
 
     fun traceServer () = let
-	  val evt = [
-		  CML.wrap(CML.recvEvt traceCh, fn f => tracePrint(concat(f()))),
-		  CML.wrap(CML.recvEvt traceUpdateCh, fn f => f())
-		]
-	  fun loop () = (CML.select evt; loop())
-	  in
-	    loop()
-	  end (* traceServer *)
+          val evt = [
+                  CML.wrap(CML.recvEvt traceCh, fn f => tracePrint(concat(f()))),
+                  CML.wrap(CML.recvEvt traceUpdateCh, fn f => f())
+                ]
+          fun loop () = (CML.select evt; loop())
+          in
+            loop()
+          end (* traceServer *)
 
     fun tracerStart () = (CML.spawn traceServer; ())
     fun tracerStop () = ((!traceCleanup)(); traceCleanup := (fn () => ()))
 
     val _ = (
-	  RunCML.logChannel ("TraceCML:trace", traceCh);
-	  RunCML.logChannel ("TraceCML:trace-update", traceUpdateCh);
-	  RunCML.logServer ("TraceCML:trace-server", tracerStart, tracerStop))
+          RunCML.logChannel ("TraceCML:trace", traceCh);
+          RunCML.logChannel ("TraceCML:trace-update", traceUpdateCh);
+          RunCML.logServer ("TraceCML:trace-server", tracerStart, tracerStop))
 
     local
       fun carefully f = if RunCML.isRunning()
-	    then CML.send(traceUpdateCh, f)
-	    else f()
+            then CML.send(traceUpdateCh, f)
+            else f()
       fun carefully' f = if RunCML.isRunning()
-	      then let
-	        val reply = SV.iVar()
-	        in
-	          CML.send (traceUpdateCh, fn () => (SV.iPut(reply, f())));
-		  SV.iGet reply
-	        end
-	      else f()
+              then let
+                val reply = SV.iVar()
+                in
+                  CML.send (traceUpdateCh, fn () => (SV.iPut(reply, f())));
+                  SV.iGet reply
+                end
+              else f()
     in
     fun traceModule arg = carefully' (fn () => traceModule' arg)
     fun moduleOf name = carefully' (fn () => moduleOf' name)
@@ -200,9 +200,9 @@
     end (* local *)
 
     fun trace (TM{tracing, ...}, prFn) =
-	  if (RunCML.isRunning() andalso (!tracing))
-	    then CML.send(traceCh, prFn)
-	    else ()
+          if (RunCML.isRunning() andalso (!tracing))
+            then CML.send(traceCh, prFn)
+            else ()
 
 
   (** Thread watching **)
@@ -219,75 +219,75 @@
 
   (* stop watching the named thread *)
     fun unwatch tid = let
-	  val ackV = SV.iVar()
-	  in
-	    Mailbox.send(watcherMb, UNWATCH(tid, ackV));
-	    SV.iGet ackV
-	  end
+          val ackV = SV.iVar()
+          in
+            Mailbox.send(watcherMb, UNWATCH(tid, ackV));
+            SV.iGet ackV
+          end
 
   (* watch the given thread for unexpected termination *)
     fun watch (name, tid) = let
-	  val unwatchCh = CML.channel()
-	  fun handleTermination () = (
-		trace (watcher, fn () => [
-		    "WARNING!  Watched thread ", name, CML.tidToString tid,
-		    " has died.\n"
-		  ]);
-		unwatch tid)
-	  fun watcherThread () = (
-		Mailbox.send (watcherMb, WATCH(tid, unwatchCh));
-		CML.select [
-		    CML.recvEvt unwatchCh,
-		    CML.wrap (CML.joinEvt tid, handleTermination)
-		  ])
-	  in
-	    CML.spawn (watcherThread); ()
-	  end
+          val unwatchCh = CML.channel()
+          fun handleTermination () = (
+                trace (watcher, fn () => [
+                    "WARNING!  Watched thread ", name, CML.tidToString tid,
+                    " has died.\n"
+                  ]);
+                unwatch tid)
+          fun watcherThread () = (
+                Mailbox.send (watcherMb, WATCH(tid, unwatchCh));
+                CML.select [
+                    CML.recvEvt unwatchCh,
+                    CML.wrap (CML.joinEvt tid, handleTermination)
+                  ])
+          in
+            CML.spawn (watcherThread); ()
+          end
 
     structure TidTbl = HashTableFn (
       struct
-	type hash_key = CML.thread_id
-	val hashVal = CML.hashTid
-	val sameKey = CML.sameTid
+        type hash_key = CML.thread_id
+        val hashVal = CML.hashTid
+        val sameKey = CML.sameTid
       end)
 
   (* the watcher server *)
     fun startWatcher () = let
-	  val tbl = TidTbl.mkTable (32, Fail "startWatcher")
-	  fun loop () = (case (Mailbox.recv watcherMb)
-		 of (WATCH arg) => TidTbl.insert tbl arg
-		  | (UNWATCH(tid, ack)) => (
-		    (* notify the watcher that the thread is no longer being
-		     * watched, and then acknowledge the unwatch command.
-		     *)
-		      CML.send(TidTbl.remove tbl tid, ())
-			handle _ => ();
-		    (* acknowledge that the thread has been removed *)
-		      SV.iPut(ack, ()))
-		(* end case *);
-		loop ())
-	  in
-	    CML.spawn loop; ()
-	  end
+          val tbl = TidTbl.mkTable (32, Fail "startWatcher")
+          fun loop () = (case (Mailbox.recv watcherMb)
+                 of (WATCH arg) => TidTbl.insert tbl arg
+                  | (UNWATCH(tid, ack)) => (
+                    (* notify the watcher that the thread is no longer being
+                     * watched, and then acknowledge the unwatch command.
+                     *)
+                      CML.send(TidTbl.remove tbl tid, ())
+                        handle _ => ();
+                    (* acknowledge that the thread has been removed *)
+                      SV.iPut(ack, ()))
+                (* end case *);
+                loop ())
+          in
+            CML.spawn loop; ()
+          end
 
     val _ = (
-	  RunCML.logMailbox ("TraceCML:watcherMb", watcherMb);
-	  RunCML.logServer ("TraceCML:watcher-server", startWatcher, fn () => ()))
+          RunCML.logMailbox ("TraceCML:watcherMb", watcherMb);
+          RunCML.logServer ("TraceCML:watcher-server", startWatcher, fn () => ()))
 
 
   (** Uncaught exception handling **)
 
     fun defaultHandlerFn (tid, ex) = let
-	  val raisedAt = (case (SMLofNJ.exnHistory ex)
-		 of [] => ["\n"]
-		  | l => [" raised at ", List.last l, "\n"]
-		(* end case *))
-	  in
-	    Debug.sayDebug (concat ([
-	        CML.tidToString tid, " uncaught exception ",
-	        exnName ex, " [", exnMessage ex, "]"
-	      ] @ raisedAt))
-	  end
+          val raisedAt = (case (SMLofNJ.exnHistory ex)
+                 of [] => ["\n"]
+                  | l => [" raised at ", List.last l, "\n"]
+                (* end case *))
+          in
+            Debug.sayDebug (concat ([
+                CML.tidToString tid, " uncaught exception ",
+                exnName ex, " [", exnMessage ex, "]"
+              ] @ raisedAt))
+          end
 
     val defaultHandler = ref defaultHandlerFn
     val handlers = ref ([] : ((CML.thread_id * exn) -> bool) list)
@@ -309,33 +309,33 @@
     val exnUpdateCh : (unit -> unit) CML.chan = CML.channel()
 
     fun exnServerStartup () = let
-	  val errCh = Mailbox.mailbox()
-	(* this function is installed as the default handler for threads;
-	 * it sends the thread ID and uncaught exception to the ExnServer.
-	 *)
-	  fun threadHandler exn = Mailbox.send(errCh, (CML.getTid(), exn))
-	(* invoke the hsndler actions on the uncaught exception *)
-	  fun handleExn arg = let
-		val hdlrList = !handlers and dfltHndlr = !defaultHandler
-		fun loop [] = dfltHndlr arg
-		  | loop (hdlr::r) = if (hdlr arg) then () else loop r
-		in
-		  CML.spawn (fn () => ((loop hdlrList) handle _ => (dfltHndlr arg)));
-		  ()
-		end
-	  val event = [
-		  CML.wrap (CML.recvEvt exnUpdateCh, fn f => f()),
-		  CML.wrap (Mailbox.recvEvt errCh, handleExn)
-		]
-	  fun server () = (CML.select event; server())
-	  in
-	    Thread.defaultExnHandler := threadHandler;
-	    CML.spawn server; ()
-	  end
+          val errCh = Mailbox.mailbox()
+        (* this function is installed as the default handler for threads;
+         * it sends the thread ID and uncaught exception to the ExnServer.
+         *)
+          fun threadHandler exn = Mailbox.send(errCh, (CML.getTid(), exn))
+        (* invoke the hsndler actions on the uncaught exception *)
+          fun handleExn arg = let
+                val hdlrList = !handlers and dfltHndlr = !defaultHandler
+                fun loop [] = dfltHndlr arg
+                  | loop (hdlr::r) = if (hdlr arg) then () else loop r
+                in
+                  CML.spawn (fn () => ((loop hdlrList) handle _ => (dfltHndlr arg)));
+                  ()
+                end
+          val event = [
+                  CML.wrap (CML.recvEvt exnUpdateCh, fn f => f()),
+                  CML.wrap (Mailbox.recvEvt errCh, handleExn)
+                ]
+          fun server () = (CML.select event; server())
+          in
+            Thread.defaultExnHandler := threadHandler;
+            CML.spawn server; ()
+          end
 
     val _ = (
-	  RunCML.logChannel ("TraceCML:exnUpdateCh", exnUpdateCh);
-	  RunCML.logServer ("TraceCML", exnServerStartup, fn () => ()))
+          RunCML.logChannel ("TraceCML:exnUpdateCh", exnUpdateCh);
+          RunCML.logServer ("TraceCML", exnServerStartup, fn () => ()))
 
     local
       fun carefully f = if RunCML.isRunning() then CML.send(exnUpdateCh, f) else f()

Modified: mlton/branches/on-20050420-cmm-branch/lib/cml/cml.mlb
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/cml/cml.mlb	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/cml/cml.mlb	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,6 +1,6 @@
 ann
-  "forceUsed"
+   "forceUsed"
 in
-  core-cml/core-cml.mlb
-  cml-lib/cml-lib.mlb
+   core-cml/core-cml.mlb
+   cml-lib/cml-lib.mlb
 end

Modified: mlton/branches/on-20050420-cmm-branch/lib/cml/core-cml/channel.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/cml/core-cml/channel.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/cml/core-cml/channel.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -15,12 +15,12 @@
    sig
       type 'a chan
 
-      val channel : unit -> 'a chan	 
+      val channel : unit -> 'a chan      
       val sameChannel : ('a chan * 'a chan) -> bool
 
       val send : ('a chan * 'a) -> unit
       val recv : 'a chan -> 'a
-	 
+         
       val sendEvt  : ('a chan * 'a) -> unit Event.event
       val recvEvt  : 'a chan -> 'a Event.event
 

Modified: mlton/branches/on-20050420-cmm-branch/lib/cml/core-cml/channel.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/cml/core-cml/channel.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/cml/core-cml/channel.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -22,34 +22,34 @@
    struct
       structure Assert = LocalAssert(val assert = false)
       structure Debug = LocalDebug(val debug = false)
-	 
+         
       structure Q = ImpQueue
       structure S = Scheduler
       structure E = Event
       fun debug msg = Debug.sayDebug ([S.atomicMsg, S.tidMsg], msg)
       fun debug' msg = debug (fn () => msg)
-	 
+         
       datatype trans_id = datatype TransID.trans_id
       datatype trans_id_state = datatype TransID.trans_id_state
 
 
       datatype 'a chan = 
-	 CHAN of {prio : int ref,
-		  inQ  : (trans_id * 'a S.thread) Q.t,
-		  outQ : (trans_id * 'a S.thread S.thread) Q.t}
+         CHAN of {prio : int ref,
+                  inQ  : (trans_id * 'a S.thread) Q.t,
+                  outQ : (trans_id * 'a S.thread S.thread) Q.t}
 
       (*
       fun resetChan (CHAN {prio, inQ, outQ}) = 
-	 (prio := 1
-	  ; Q.reset inQ
-	  ; Q.reset outQ)
+         (prio := 1
+          ; Q.reset inQ
+          ; Q.reset outQ)
       *)
 
       fun channel () = CHAN {prio = ref 1, inQ = Q.new (), outQ = Q.new ()}
 
       (* sameChannel : ('a chan * 'a chan) -> bool *)
       fun sameChannel (CHAN {prio = prio1, ...}, CHAN {prio = prio2, ...}) =
-	 prio1 = prio2
+         prio1 = prio2
 
 
       (* bump a priority value by one, returning the old value *)
@@ -57,303 +57,303 @@
 
       (* functions to clean channel input and output queues *)
       local
-	 fun cleaner (TXID txst, _) = 
-	    case !txst of CANCEL => true | _ => false
+         fun cleaner (TXID txst, _) = 
+            case !txst of CANCEL => true | _ => false
       in
-	 fun cleanAndChk (prio, q) : int =
-	    (Q.clean (q, cleaner)
-	     ; if Q.empty q
-		  then 0
-		  else bumpPriority prio)
-	 fun cleanAndDeque q =
-	    Q.cleanAndDeque (q, cleaner)
-	 fun enqueAndClean (q, item) =
-	    Q.enqueAndClean (q, item, cleaner)
+         fun cleanAndChk (prio, q) : int =
+            (Q.clean (q, cleaner)
+             ; if Q.empty q
+                  then 0
+                  else bumpPriority prio)
+         fun cleanAndDeque q =
+            Q.cleanAndDeque (q, cleaner)
+         fun enqueAndClean (q, item) =
+            Q.enqueAndClean (q, item, cleaner)
       end
 
       fun send (CHAN {prio, inQ, outQ}, msg) = 
-	 let
-	    val () = Assert.assertNonAtomic' "Channel.send"
-	    val () = debug' "Chennel.send(1)" (* NonAtomic *)
-	    val () = Assert.assertNonAtomic' "Channel.send(1)"
-	    val () = S.atomicBegin ()
-	    val () = debug' "Channel.send(2)" (* Atomic 1 *)
-	    val () = Assert.assertAtomic' ("Channel.send(2)", SOME 1)
-	    val () = 
-	       case cleanAndDeque inQ of 
-		  SOME (rtxid, rt) => 
-		     let
-			val () = debug' "Channel.send(3.1.1)" (* Atomic 1 *)
-			val () = Assert.assertAtomic' ("Channel.send(3.1.1)", SOME 1)
-			val () =
-			   S.readyAndSwitch
-			   (fn () =>
-			    (prio := 1
-			     ; TransID.force rtxid
-			     ; S.prepVal (rt, msg)))
-			val () = debug' "Channel.send(3.1.2)" (* NonAtomic *)
-			val () = Assert.assertNonAtomic' "Channel.send(3.1.2)"
-		     in
-			()
-		     end
-		| NONE => 
-		     let
-			val () = debug' "Channel.send(3.2.1)" (* Atomic 1 *)
-			val () = Assert.assertAtomic' ("Channel.send(3.2.1)", SOME 1)
-			val rt = 
-			   S.atomicSwitchToNext
-			   (fn st => Q.enque (outQ, (TransID.mkTxId (), st)))
-			val () = debug' "Channel.send(3.2.2)" (* Atomic 1 *)
-			val () = Assert.assertAtomic' ("Channel.send(3.2.2)", SOME 1)
-			val () = S.atomicReadyAndSwitch (fn () => S.prepVal (rt, msg))
-			val () = debug' "Chanell.send(3.2.3)" (* NonAtomic *)
-			val () = Assert.assertNonAtomic' "Channel.send(3.2.2)"
-		     in
-			()
-		     end
-	    val () = debug' "Channel.send(4)" (* NonAtomic *)
-	    val () = Assert.assertNonAtomic' "Channel.send(4)"
-	 in
-	    ()
-	 end
+         let
+            val () = Assert.assertNonAtomic' "Channel.send"
+            val () = debug' "Chennel.send(1)" (* NonAtomic *)
+            val () = Assert.assertNonAtomic' "Channel.send(1)"
+            val () = S.atomicBegin ()
+            val () = debug' "Channel.send(2)" (* Atomic 1 *)
+            val () = Assert.assertAtomic' ("Channel.send(2)", SOME 1)
+            val () = 
+               case cleanAndDeque inQ of 
+                  SOME (rtxid, rt) => 
+                     let
+                        val () = debug' "Channel.send(3.1.1)" (* Atomic 1 *)
+                        val () = Assert.assertAtomic' ("Channel.send(3.1.1)", SOME 1)
+                        val () =
+                           S.readyAndSwitch
+                           (fn () =>
+                            (prio := 1
+                             ; TransID.force rtxid
+                             ; S.prepVal (rt, msg)))
+                        val () = debug' "Channel.send(3.1.2)" (* NonAtomic *)
+                        val () = Assert.assertNonAtomic' "Channel.send(3.1.2)"
+                     in
+                        ()
+                     end
+                | NONE => 
+                     let
+                        val () = debug' "Channel.send(3.2.1)" (* Atomic 1 *)
+                        val () = Assert.assertAtomic' ("Channel.send(3.2.1)", SOME 1)
+                        val rt = 
+                           S.atomicSwitchToNext
+                           (fn st => Q.enque (outQ, (TransID.mkTxId (), st)))
+                        val () = debug' "Channel.send(3.2.2)" (* Atomic 1 *)
+                        val () = Assert.assertAtomic' ("Channel.send(3.2.2)", SOME 1)
+                        val () = S.atomicReadyAndSwitch (fn () => S.prepVal (rt, msg))
+                        val () = debug' "Chanell.send(3.2.3)" (* NonAtomic *)
+                        val () = Assert.assertNonAtomic' "Channel.send(3.2.2)"
+                     in
+                        ()
+                     end
+            val () = debug' "Channel.send(4)" (* NonAtomic *)
+            val () = Assert.assertNonAtomic' "Channel.send(4)"
+         in
+            ()
+         end
 
       fun sendEvt (CHAN {prio, inQ, outQ}, msg) =
-	 let
-	    fun doitFn () = 
-	       let
-		  val () = Assert.assertAtomic' ("Channel.sendEvt.doitFn", NONE)
-		  val (rtxid, rt) = valOf (Q.deque inQ)
-		  val () = debug' "Channel.sendEvt(3.1.1)" (* Atomic 1 *)
-		  val () = Assert.assertAtomic' ("Channel.sendEvt(3.1.1)", SOME 1)
-		  val () =
-		     S.readyAndSwitch
-		     (fn () =>
-		      (prio := 1
-		       ; TransID.force rtxid
-		       ; S.prepVal (rt, msg)))
-		  val () = debug' "Channel.sendEvt(3.1.2)" (* NonAtomic *)
-		  val () = Assert.assertNonAtomic' "Channel.sendEvt(3.1.2)"
-	       in
-		  ()
-	       end
-	    fun blockFn {transId, cleanUp, next} = 
-	       let
-		  val () = Assert.assertAtomic' ("Channel.sendEvt.blockFn", NONE)
-		  val () = debug' "Channel.sendEvt(3.2.1)" (* Atomic 1 *)
-		  val () = Assert.assertAtomic' ("Channel.sendEvt(3.2.1)", SOME 1)
-		  val rt = 
-		     S.atomicSwitch
-		     (fn st =>
-		      (enqueAndClean (outQ, (transId, st))
-		       ; next ()))
-		  val () = debug' "Channel.sendEvt(3.2.2)" (* Atomic 1 *)
-		  val () = Assert.assertAtomic' ("Channel.sendEvt(3.2.2)", SOME 1)
-		  val () = cleanUp ()
-		  val () = S.atomicReadyAndSwitch (fn () => S.prepVal (rt, msg))
-		  val () = debug' "Channel.sendEvt(3.2.3)" (* NonAtomic *)
-		  val () = Assert.assertNonAtomic' "Channel.sendEvt(3.2.2)"
-	       in
-		  ()
-	       end
-	  fun pollFn () = 
-	     let
-		val () = Assert.assertAtomic' ("Channel.sendEvt.pollFn", NONE)
-		val () = debug' "Channel.sendEvt(2)" (* Atomic 1 *)
-		val () = Assert.assertAtomic' ("Channel.sendEvt(2)", SOME 1)
-	     in
-		case cleanAndChk (prio, inQ) of
-		   0 => E.blocked blockFn
-		 | prio => E.enabled {prio = prio, doitFn = doitFn}
-	     end
-	 in
-	    E.bevt pollFn
-	 end
+         let
+            fun doitFn () = 
+               let
+                  val () = Assert.assertAtomic' ("Channel.sendEvt.doitFn", NONE)
+                  val (rtxid, rt) = valOf (Q.deque inQ)
+                  val () = debug' "Channel.sendEvt(3.1.1)" (* Atomic 1 *)
+                  val () = Assert.assertAtomic' ("Channel.sendEvt(3.1.1)", SOME 1)
+                  val () =
+                     S.readyAndSwitch
+                     (fn () =>
+                      (prio := 1
+                       ; TransID.force rtxid
+                       ; S.prepVal (rt, msg)))
+                  val () = debug' "Channel.sendEvt(3.1.2)" (* NonAtomic *)
+                  val () = Assert.assertNonAtomic' "Channel.sendEvt(3.1.2)"
+               in
+                  ()
+               end
+            fun blockFn {transId, cleanUp, next} = 
+               let
+                  val () = Assert.assertAtomic' ("Channel.sendEvt.blockFn", NONE)
+                  val () = debug' "Channel.sendEvt(3.2.1)" (* Atomic 1 *)
+                  val () = Assert.assertAtomic' ("Channel.sendEvt(3.2.1)", SOME 1)
+                  val rt = 
+                     S.atomicSwitch
+                     (fn st =>
+                      (enqueAndClean (outQ, (transId, st))
+                       ; next ()))
+                  val () = debug' "Channel.sendEvt(3.2.2)" (* Atomic 1 *)
+                  val () = Assert.assertAtomic' ("Channel.sendEvt(3.2.2)", SOME 1)
+                  val () = cleanUp ()
+                  val () = S.atomicReadyAndSwitch (fn () => S.prepVal (rt, msg))
+                  val () = debug' "Channel.sendEvt(3.2.3)" (* NonAtomic *)
+                  val () = Assert.assertNonAtomic' "Channel.sendEvt(3.2.2)"
+               in
+                  ()
+               end
+          fun pollFn () = 
+             let
+                val () = Assert.assertAtomic' ("Channel.sendEvt.pollFn", NONE)
+                val () = debug' "Channel.sendEvt(2)" (* Atomic 1 *)
+                val () = Assert.assertAtomic' ("Channel.sendEvt(2)", SOME 1)
+             in
+                case cleanAndChk (prio, inQ) of
+                   0 => E.blocked blockFn
+                 | prio => E.enabled {prio = prio, doitFn = doitFn}
+             end
+         in
+            E.bevt pollFn
+         end
       
       fun sendPoll (CHAN {prio, inQ, ...}, msg) = 
-	 let
-	    val () = Assert.assertNonAtomic' "Channel.sendPoll"
-	    val () = debug' "Channel.sendPoll(1)" (* NonAtomic *)
-	    val () = Assert.assertNonAtomic' "Channel.sendPoll(1)"
-	    val () = S.atomicBegin ()
-	    val () = debug' "Channel.sendPoll(2)" (* Atomic 1 *)
-	    val () = Assert.assertAtomic' ("Channel.sendPoll(1)", SOME 1)
-	    val b = 
-	       case cleanAndDeque inQ of 
-		  SOME (rtxid, rt) => 
-		     let
-			val () = debug' "Channel.sendPoll(3.1.1)" (* Atomic 1 *)
-			val () = Assert.assertAtomic' ("Channel.sendPoll(3.1.1)", SOME 1)
-			val () =
-			   S.readyAndSwitch
-			   (fn () =>
-			    (prio := 1
-			     ; TransID.force rtxid
-			     ; S.prepVal (rt, msg)))
-			val b = true
-			val () = debug' "Channel.sendPoll(3.1.2)" (* NonAtomic *)
-			val () = Assert.assertNonAtomic' "Channel.sendPoll(3.1.2)"
-		     in
-			b
-		     end
-		| NONE => 
-		     let
-			val () = debug' "Channel.sendPoll(3.2.1)" (* Atomic 1 *)
-			val () = Assert.assertAtomic' ("Channel.sendPoll(3.2.1)", SOME 1)
-			val b = false
-			val () = debug' "Channel.sendPoll(3.2.2)" (* Atomic 1 *)
-			val () = Assert.assertAtomic' ("Channel.sendPoll(3.2.2)", SOME 1)
-			val () = S.atomicEnd ()
-			val () = debug' "Channel.sendPoll(3.2.3)" (* NonAtomic *)
-			val () = Assert.assertNonAtomic' "Channel.sendPoll(3.2.2)"
-		     in
-			b
-		     end
-	    val () = debug' "Channel.sendPoll(4)" (* NonAtomic *)
-	    val () = Assert.assertNonAtomic' "Channel.sendPoll(4)"
-	 in
-	    b
-	 end
-	 
+         let
+            val () = Assert.assertNonAtomic' "Channel.sendPoll"
+            val () = debug' "Channel.sendPoll(1)" (* NonAtomic *)
+            val () = Assert.assertNonAtomic' "Channel.sendPoll(1)"
+            val () = S.atomicBegin ()
+            val () = debug' "Channel.sendPoll(2)" (* Atomic 1 *)
+            val () = Assert.assertAtomic' ("Channel.sendPoll(1)", SOME 1)
+            val b = 
+               case cleanAndDeque inQ of 
+                  SOME (rtxid, rt) => 
+                     let
+                        val () = debug' "Channel.sendPoll(3.1.1)" (* Atomic 1 *)
+                        val () = Assert.assertAtomic' ("Channel.sendPoll(3.1.1)", SOME 1)
+                        val () =
+                           S.readyAndSwitch
+                           (fn () =>
+                            (prio := 1
+                             ; TransID.force rtxid
+                             ; S.prepVal (rt, msg)))
+                        val b = true
+                        val () = debug' "Channel.sendPoll(3.1.2)" (* NonAtomic *)
+                        val () = Assert.assertNonAtomic' "Channel.sendPoll(3.1.2)"
+                     in
+                        b
+                     end
+                | NONE => 
+                     let
+                        val () = debug' "Channel.sendPoll(3.2.1)" (* Atomic 1 *)
+                        val () = Assert.assertAtomic' ("Channel.sendPoll(3.2.1)", SOME 1)
+                        val b = false
+                        val () = debug' "Channel.sendPoll(3.2.2)" (* Atomic 1 *)
+                        val () = Assert.assertAtomic' ("Channel.sendPoll(3.2.2)", SOME 1)
+                        val () = S.atomicEnd ()
+                        val () = debug' "Channel.sendPoll(3.2.3)" (* NonAtomic *)
+                        val () = Assert.assertNonAtomic' "Channel.sendPoll(3.2.2)"
+                     in
+                        b
+                     end
+            val () = debug' "Channel.sendPoll(4)" (* NonAtomic *)
+            val () = Assert.assertNonAtomic' "Channel.sendPoll(4)"
+         in
+            b
+         end
+         
       fun recv (CHAN {prio, inQ, outQ}) =
-	 let
-	    val () = Assert.assertNonAtomic' "Channel.recv"
-	    val () = debug' "Channel.recv(1)" (* NonAtomic *)
-	    val () = Assert.assertNonAtomic' "Channel.recv(1)"
-	    val () = S.atomicBegin ()
-	    val () = debug' "Channel.recv(2)" (* Atomic 1 *)
-	    val () = Assert.assertAtomic' ("Channel.recv(2)", SOME 1)
-	    val msg = 
-	       case cleanAndDeque outQ of
-		  SOME (stxid, st) =>	
-		     let
-			val () = debug' "Channel.recv(3.1.1)" (* Atomic 1 *)
-			val () = Assert.assertAtomic' ("Channel.recv(3.1.1)", SOME 1)
-			val msg =
-			   S.switch
-			   (fn rt =>
-			    (prio := 1
-			     ; TransID.force stxid
-			     ; S.prepVal (st, rt)))
-			val () = debug' "Channel.recv(3.1.2)" (* NonAtomic *)
-			val () = Assert.assertNonAtomic' "Channel.recv(3.1.1)"
-		     in
-			msg
-		     end
-		| NONE =>
-		     let
-			val () = debug' "Channel.recv(3.2.1)" (* Atomic 1 *)
-			val () = Assert.assertAtomic' ("Channel.recv(3.2.1)", SOME 1)
-			val msg =
-			   S.atomicSwitchToNext
-			   (fn rt => enqueAndClean (inQ, (TransID.mkTxId (), rt)))
-			val () = debug' "Channel.recv(3.2.2)" (* Atomic 1 *)
-			val () = Assert.assertAtomic' ("Channel.recv(3.2.2)", SOME 1)
-			val () = S.atomicEnd ()
-			val () = debug' "Channel.recv(3.2.3)" (* NonAtomic *)
-			val () = Assert.assertNonAtomic' "Channel.recv(3.2.3)"
-		     in
-			msg
-		     end
-	    val () = debug' "Channel.recv(4)" (* NonAtomic *)
-	    val () = Assert.assertNonAtomic' "Channel.recv(4)"
-	 in
-	    msg
-	 end
-	 
+         let
+            val () = Assert.assertNonAtomic' "Channel.recv"
+            val () = debug' "Channel.recv(1)" (* NonAtomic *)
+            val () = Assert.assertNonAtomic' "Channel.recv(1)"
+            val () = S.atomicBegin ()
+            val () = debug' "Channel.recv(2)" (* Atomic 1 *)
+            val () = Assert.assertAtomic' ("Channel.recv(2)", SOME 1)
+            val msg = 
+               case cleanAndDeque outQ of
+                  SOME (stxid, st) =>   
+                     let
+                        val () = debug' "Channel.recv(3.1.1)" (* Atomic 1 *)
+                        val () = Assert.assertAtomic' ("Channel.recv(3.1.1)", SOME 1)
+                        val msg =
+                           S.switch
+                           (fn rt =>
+                            (prio := 1
+                             ; TransID.force stxid
+                             ; S.prepVal (st, rt)))
+                        val () = debug' "Channel.recv(3.1.2)" (* NonAtomic *)
+                        val () = Assert.assertNonAtomic' "Channel.recv(3.1.1)"
+                     in
+                        msg
+                     end
+                | NONE =>
+                     let
+                        val () = debug' "Channel.recv(3.2.1)" (* Atomic 1 *)
+                        val () = Assert.assertAtomic' ("Channel.recv(3.2.1)", SOME 1)
+                        val msg =
+                           S.atomicSwitchToNext
+                           (fn rt => enqueAndClean (inQ, (TransID.mkTxId (), rt)))
+                        val () = debug' "Channel.recv(3.2.2)" (* Atomic 1 *)
+                        val () = Assert.assertAtomic' ("Channel.recv(3.2.2)", SOME 1)
+                        val () = S.atomicEnd ()
+                        val () = debug' "Channel.recv(3.2.3)" (* NonAtomic *)
+                        val () = Assert.assertNonAtomic' "Channel.recv(3.2.3)"
+                     in
+                        msg
+                     end
+            val () = debug' "Channel.recv(4)" (* NonAtomic *)
+            val () = Assert.assertNonAtomic' "Channel.recv(4)"
+         in
+            msg
+         end
+         
       fun recvEvt (CHAN {prio, inQ, outQ}) = 
-	 let
-	    fun doitFn () = 
-	       let
-		  val () = Assert.assertAtomic' ("Channel.recvEvt.doitFn", NONE)
-		  val (stxid, st) = valOf (Q.deque outQ)
-		  val () = debug' "Channel.recvEvt(3.1.1)" (* Atomic 1 *)
-		  val () = Assert.assertAtomic' ("Channel.recvEvt(3.1.1)", SOME 1)
-		  val msg =
-		     S.switch
-		     (fn rt =>
-		      (prio := 1
-		       ; TransID.force stxid
-		       ; S.prepVal (st, rt)))
-		  val () = debug' "Channel.recvEvt(3.1.2)" (* NonAtomic *)
-		  val () = Assert.assertNonAtomic' "Channel.recvEvt(3.1.1)"
-	       in
-		  msg
-	       end
-	    fun blockFn {transId, cleanUp, next} = 
-	       let
-		  val () = Assert.assertAtomic' ("Channel.recvEvt.blockFn", NONE)
-		  val () = debug' "Channel.recvEvt(3.2.1)" (* Atomic 1 *)
-		  val () = Assert.assertAtomic' ("Channel.recvEvt(3.2.1)", SOME 1)
-		  val msg =
-		     S.atomicSwitch
-		     (fn rt =>
-		      (enqueAndClean (inQ, (transId, rt))
-		       ; next ()))
-		  val () = debug' "Channel.recvEvt(3.2.2)" (* Atomic 1 *)
-		  val () = Assert.assertAtomic' ("Channel.recvEvt(3.2.2)", SOME 1)
-		  val () = cleanUp ()
-		  val () = S.atomicEnd ()
-		  val () = debug' "Channel.recvEvt(3.2.3)" (* NonAtomic *)
-		  val () = Assert.assertNonAtomic' "Channel.recvEvt(3.2.3)"
-	       in
-		  msg
-	       end
-	    fun pollFn () = 
-	       let
-		  val () = Assert.assertAtomic' ("Channel.recvEvt.pollFn", NONE)
-		  val () = debug' "Channel.recvEvt(2)" (* Atomic 1 *)
-		  val () = Assert.assertAtomic' ("Channel.recvEvt(2)", SOME 1)
-	       in
-		  case cleanAndChk (prio, outQ) of 
-		     0 => E.blocked blockFn
-		   | prio => E.enabled {prio = prio, doitFn = doitFn}
-	       end
-	 in
-	    E.bevt pollFn
-	 end
+         let
+            fun doitFn () = 
+               let
+                  val () = Assert.assertAtomic' ("Channel.recvEvt.doitFn", NONE)
+                  val (stxid, st) = valOf (Q.deque outQ)
+                  val () = debug' "Channel.recvEvt(3.1.1)" (* Atomic 1 *)
+                  val () = Assert.assertAtomic' ("Channel.recvEvt(3.1.1)", SOME 1)
+                  val msg =
+                     S.switch
+                     (fn rt =>
+                      (prio := 1
+                       ; TransID.force stxid
+                       ; S.prepVal (st, rt)))
+                  val () = debug' "Channel.recvEvt(3.1.2)" (* NonAtomic *)
+                  val () = Assert.assertNonAtomic' "Channel.recvEvt(3.1.1)"
+               in
+                  msg
+               end
+            fun blockFn {transId, cleanUp, next} = 
+               let
+                  val () = Assert.assertAtomic' ("Channel.recvEvt.blockFn", NONE)
+                  val () = debug' "Channel.recvEvt(3.2.1)" (* Atomic 1 *)
+                  val () = Assert.assertAtomic' ("Channel.recvEvt(3.2.1)", SOME 1)
+                  val msg =
+                     S.atomicSwitch
+                     (fn rt =>
+                      (enqueAndClean (inQ, (transId, rt))
+                       ; next ()))
+                  val () = debug' "Channel.recvEvt(3.2.2)" (* Atomic 1 *)
+                  val () = Assert.assertAtomic' ("Channel.recvEvt(3.2.2)", SOME 1)
+                  val () = cleanUp ()
+                  val () = S.atomicEnd ()
+                  val () = debug' "Channel.recvEvt(3.2.3)" (* NonAtomic *)
+                  val () = Assert.assertNonAtomic' "Channel.recvEvt(3.2.3)"
+               in
+                  msg
+               end
+            fun pollFn () = 
+               let
+                  val () = Assert.assertAtomic' ("Channel.recvEvt.pollFn", NONE)
+                  val () = debug' "Channel.recvEvt(2)" (* Atomic 1 *)
+                  val () = Assert.assertAtomic' ("Channel.recvEvt(2)", SOME 1)
+               in
+                  case cleanAndChk (prio, outQ) of 
+                     0 => E.blocked blockFn
+                   | prio => E.enabled {prio = prio, doitFn = doitFn}
+               end
+         in
+            E.bevt pollFn
+         end
       
       fun recvPoll (CHAN {prio, outQ, ...}) = 
-	 let
-	    val () = Assert.assertNonAtomic' "Channel.recvPoll"
-	    val () = debug' "Channel.recvPoll(1)" (* NonAtomic *)
-	    val () = Assert.assertNonAtomic' "Channel.recvPoll(1)"
-	    val () = S.atomicBegin ()
-	    val () = debug' "Channel.recvPoll(2)" (* Atomic 1 *)
-	    val () = Assert.assertAtomic' ("Channel.recvPoll(2)", SOME 1)
-	    val msg =
-	       case cleanAndDeque outQ of 
-		  SOME (stxid, st) => 
-		     let
-			val () = debug' "Channel.recvPoll(3.1.1)" (* Atomic 1 *)
-			val () = Assert.assertAtomic' ("Channel.recvPoll(3.1.1)", SOME 1)
-			val msg =
-			   S.switch
-			   (fn rt =>
-			    (prio := 1
-			     ; TransID.force stxid
-			     ; S.prepVal (st, rt)))
-			val msg = SOME msg
-			val () = debug' "Channel.recvPoll(3.1.2)" (* NonAtomic *)
-			val () = Assert.assertNonAtomic' "Channel.recvPoll(3.1.1)"
-		     in
-			msg
-		     end
-		| NONE => 
-		     let
-			val () = debug' "Channel.recv(3.2.1)" (* Atomic 1 *)
-			val () = Assert.assertAtomic' ("Channel.recv(3.2.1)", SOME 1)
-			val msg = NONE
-			val () = debug' "Channel.recvPoll(3.2.2)" (* Atomic 1 *)
-			val () = Assert.assertAtomic' ("Channel.recvPoll(3.2.2)", SOME 1)
-			val () = S.atomicEnd ()
-			val () = debug' "Channel.recvPoll(3.2.3)" (* NonAtomic *)
-			val () = Assert.assertNonAtomic' "Channel.recvPoll(3.2.3)"
-		     in
-			msg
-		     end
-	    val () = debug' "Channel.recvPoll(4)" (* NonAtomic *)
-	    val () = Assert.assertNonAtomic' "Channel.recvPoll(4)"
-	 in
-	    msg
-	 end
+         let
+            val () = Assert.assertNonAtomic' "Channel.recvPoll"
+            val () = debug' "Channel.recvPoll(1)" (* NonAtomic *)
+            val () = Assert.assertNonAtomic' "Channel.recvPoll(1)"
+            val () = S.atomicBegin ()
+            val () = debug' "Channel.recvPoll(2)" (* Atomic 1 *)
+            val () = Assert.assertAtomic' ("Channel.recvPoll(2)", SOME 1)
+            val msg =
+               case cleanAndDeque outQ of 
+                  SOME (stxid, st) => 
+                     let
+                        val () = debug' "Channel.recvPoll(3.1.1)" (* Atomic 1 *)
+                        val () = Assert.assertAtomic' ("Channel.recvPoll(3.1.1)", SOME 1)
+                        val msg =
+                           S.switch
+                           (fn rt =>
+                            (prio := 1
+                             ; TransID.force stxid
+                             ; S.prepVal (st, rt)))
+                        val msg = SOME msg
+                        val () = debug' "Channel.recvPoll(3.1.2)" (* NonAtomic *)
+                        val () = Assert.assertNonAtomic' "Channel.recvPoll(3.1.1)"
+                     in
+                        msg
+                     end
+                | NONE => 
+                     let
+                        val () = debug' "Channel.recv(3.2.1)" (* Atomic 1 *)
+                        val () = Assert.assertAtomic' ("Channel.recv(3.2.1)", SOME 1)
+                        val msg = NONE
+                        val () = debug' "Channel.recvPoll(3.2.2)" (* Atomic 1 *)
+                        val () = Assert.assertAtomic' ("Channel.recvPoll(3.2.2)", SOME 1)
+                        val () = S.atomicEnd ()
+                        val () = debug' "Channel.recvPoll(3.2.3)" (* NonAtomic *)
+                        val () = Assert.assertNonAtomic' "Channel.recvPoll(3.2.3)"
+                     in
+                        msg
+                     end
+            val () = debug' "Channel.recvPoll(4)" (* NonAtomic *)
+            val () = Assert.assertNonAtomic' "Channel.recvPoll(4)"
+         in
+            msg
+         end
    end

Modified: mlton/branches/on-20050420-cmm-branch/lib/cml/core-cml/core-cml.mlb
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/cml/core-cml/core-cml.mlb	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/cml/core-cml/core-cml.mlb	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,56 +1,56 @@
 ann 
-  "sequenceUnit true"
-  "warnMatch true"
-  "warnUnused true"
+   "sequenceNonUnit warn"
+   "nonexhaustiveMatch warn" "redundantMatch warn"
+   "warnUnused true"
 in
-local
-  $(SML_LIB)/basis/basis.mlb
-  $(SML_LIB)/basis/mlton.mlb
-  ../util/util.mlb
-  rep-types.sml
-  running.sml
-  trans-id.sig
-  trans-id.sml
-  cvar.sig
-  cvar.sml
-  thread-id.sig
-  thread-id.sml
-  scheduler-hooks.sig
-  scheduler-hooks.sml
-  scheduler.sig
-  scheduler.sml
-  event.sig
-  event.sml
-  thread.sig
-  thread.sml
-  channel.sig
-  channel.sml
-  timeout.sig
-  timeout.sml
-  version.sig
-  version.sml
-  cml.sig
-  cml.sml
+   local
+      $(SML_LIB)/basis/basis.mlb
+      $(SML_LIB)/basis/mlton.mlb
+      ../util/util.mlb
+      rep-types.sml
+      running.sml
+      trans-id.sig
+      trans-id.sml
+      cvar.sig
+      cvar.sml
+      thread-id.sig
+      thread-id.sml
+      scheduler-hooks.sig
+      scheduler-hooks.sml
+      scheduler.sig
+      scheduler.sml
+      event.sig
+      event.sml
+      thread.sig
+      thread.sml
+      channel.sig
+      channel.sml
+      timeout.sig
+      timeout.sml
+      version.sig
+      version.sml
+      cml.sig
+      cml.sml
 
-  mailbox.sig
-  mailbox.sml
-  sync-var.sig
-  sync-var.sml
+      mailbox.sig
+      mailbox.sml
+      sync-var.sig
+      sync-var.sml
 
-  run-cml.sig
-  run-cml.sml
+      run-cml.sig
+      run-cml.sml
 
-  rebind.sml
-in
-  signature CML
-  structure CML
+      rebind.sml
+   in
+      signature CML
+      structure CML
 
-  signature SYNC_VAR
-  structure SyncVar
+      signature SYNC_VAR
+      structure SyncVar
 
-  signature MAILBOX
-  structure Mailbox
+      signature MAILBOX
+      structure Mailbox
 
-  structure RunCML
+      structure RunCML
+   end
 end
-end

Modified: mlton/branches/on-20050420-cmm-branch/lib/cml/core-cml/event.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/cml/core-cml/event.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/cml/core-cml/event.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -36,8 +36,8 @@
       type 'a status
       val enabled : {prio : int, doitFn : unit -> 'a} -> 'a status
       val blocked : ({transId : TransID.trans_id,
-		      cleanUp : unit -> unit,
-		      next : unit -> Scheduler.rdy_thread} -> 'a) -> 'a status
+                      cleanUp : unit -> unit,
+                      next : unit -> Scheduler.rdy_thread} -> 'a) -> 'a status
       val bevt : (unit -> 'a status) -> 'a event
 
       val atomicCVarSet : CVar.cvar -> unit

Modified: mlton/branches/on-20050420-cmm-branch/lib/cml/core-cml/event.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/cml/core-cml/event.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/cml/core-cml/event.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -12,20 +12,20 @@
  *
  * Some important requirements on the implementation of base event values:
  *
- *  1)	The pollFn, doitFn, and blockFn are always called from inside
- *	atomic regions.
+ *  1)  The pollFn, doitFn, and blockFn are always called from inside
+ *      atomic regions.
  *
- *  2)	The pollFn returns an integer priority: this is 0 when not enabled,
- *	~1 for fixed priority, and a positive value for dynamic priority.
- *	The standard scheme is to associate a counter with the underlying
- *	synchronization object, and to increase it by one for each
- *	synchronization attempt.
+ *  2)  The pollFn returns an integer priority: this is 0 when not enabled,
+ *      ~1 for fixed priority, and a positive value for dynamic priority.
+ *      The standard scheme is to associate a counter with the underlying
+ *      synchronization object, and to increase it by one for each
+ *      synchronization attempt.
  *
  *  3)  The blockFn is responsible for exiting the atomic region; the doitFns
- *	should NOT leave the atomic region.
+ *      should NOT leave the atomic region.
  *
  *  4)  The blockFn is responsible for executing the "cleanUp" action
- *	prior to leaving the atomic region.
+ *      prior to leaving the atomic region.
  *)
 
 structure Event : EVENT_EXTRA =
@@ -53,7 +53,7 @@
       val bevt = fn pollFn => BEVT [pollFn]
 
       datatype 'a group =
-	 BASE of 'a base list
+         BASE of 'a base list
        | GRP of 'a group list
        | NACK of cvar * 'a group
 
@@ -71,353 +71,353 @@
        * we assume that this function is always executed in an atomic region.
        *)
       fun atomicCVarSet (CVAR state) : unit =
-	 let
-	    val () = Assert.assertAtomic' ("Event.atomicCVarSet", NONE)
-	    val () = debug' "atomicCVarSet" (* Atomic 1 *)
-	    val () = Assert.assertAtomic' ("Event.atomicCVarSet", SOME 1)
-	 in
-	    case !state of
-	       CVAR_unset waiting =>
-		  let
-		     fun add waiting : unit =
-			case waiting of 
-			   [] => ()
-			 | ({transId = TXID txst, cleanUp, thread}::waiting) =>
-			      (case !txst of 
-				  CANCEL => ()
-				| TRANS =>
-				     (txst := CANCEL
-				      ; cleanUp ()
-				      ; S.ready thread)
-			       ; add waiting)
-		  in
-		     state := CVAR_set 1
-		     ; add waiting
-		  end
-	     | _ => raise Fail "atomicCVarSet"
-	 end
+         let
+            val () = Assert.assertAtomic' ("Event.atomicCVarSet", NONE)
+            val () = debug' "atomicCVarSet" (* Atomic 1 *)
+            val () = Assert.assertAtomic' ("Event.atomicCVarSet", SOME 1)
+         in
+            case !state of
+               CVAR_unset waiting =>
+                  let
+                     fun add waiting : unit =
+                        case waiting of 
+                           [] => ()
+                         | ({transId = TXID txst, cleanUp: unit -> unit, thread}::waiting) =>
+                              (case !txst of 
+                                  CANCEL => ()
+                                | TRANS =>
+                                     (txst := CANCEL
+                                      ; cleanUp ()
+                                      ; S.ready thread)
+                               ; add waiting)
+                  in
+                     state := CVAR_set 1
+                     ; add waiting
+                  end
+             | _ => raise Fail "atomicCVarSet"
+         end
 
       (* the event constructor for waiting on a cvar.
        *)
       fun cvarGetEvt (CVAR state) : unit event =
-	 let
-	    fun doitFn () =
-	       let
-		  val () = Assert.assertAtomic' ("Event.cvarGetEvt.doitFn", NONE)
-		  val () = debug' "cvarGetEvt(3.1.1)" (* Atomic 1 *)
-		  val () = Assert.assertAtomic' ("Event.cvarGetEvt(3.1.1)", SOME 1)
-		  val () = state := CVAR_set 1
-		  val () = S.atomicEnd ()
-		  val () = debug' "cvarGetEvt(3.1.2)" (* NonAtomic *)
-		  val () = Assert.assertNonAtomic' "Event.cvarGetEvt(3.1.2)"
-	       in
-		  ()
-	       end
-	    fun blockFn {transId, cleanUp, next} =
-	       let
-		  val () = Assert.assertAtomic' ("Event.cvarGetEvt.blockFn", NONE)
-		  val () = debug' "cvarGetEvt(3.2.1)" (* Atomic 1 *)
-		  val () = Assert.assertAtomic' ("Event.cvarGetEvt(3.2.1)", SOME 1)
-		  val () =
-		     S.atomicSwitch
-		     (fn t =>
-		      let
-			 val item = {transId = transId,
-				     cleanUp = cleanUp,
-				     thread = S.prep t}
-			 val waiting =
-			    case !state of
-			       CVAR_unset waiting => waiting
-			     | _ => raise Fail "cvarGetEvt:blockFn"
-		      in
-			 state := CVAR_unset (item::waiting)
-			 ; next ()
-		      end)
-		  val () = debug' "cvarGetEvt(3.2.2)" (* NonAtomic *)
-		  val () = Assert.assertNonAtomic' "Event.cvarGetEvt(3.2.2)"
-	       in
-		  ()
-	       end
-	    fun pollFn () =
-	       let
-		  val () = Assert.assertAtomic' ("Event.cvarGetEvt.pollFn", NONE)
-		  val () = debug' "cvarGetEvt(2)" (* Atomic 1 *)
-		  val () = Assert.assertAtomic' ("Event.cvarGetEvt(2)", SOME 1)
-	       in
-		  case !state of
-		     CVAR_set n =>
-			(state := CVAR_set (n + 1)
-			 ; enabled {prio = n, doitFn = doitFn})
-		   | _ => blocked blockFn
-	       end
-	 in
-	    bevt pollFn
-	 end
+         let
+            fun doitFn () =
+               let
+                  val () = Assert.assertAtomic' ("Event.cvarGetEvt.doitFn", NONE)
+                  val () = debug' "cvarGetEvt(3.1.1)" (* Atomic 1 *)
+                  val () = Assert.assertAtomic' ("Event.cvarGetEvt(3.1.1)", SOME 1)
+                  val () = state := CVAR_set 1
+                  val () = S.atomicEnd ()
+                  val () = debug' "cvarGetEvt(3.1.2)" (* NonAtomic *)
+                  val () = Assert.assertNonAtomic' "Event.cvarGetEvt(3.1.2)"
+               in
+                  ()
+               end
+            fun blockFn {transId, cleanUp, next} =
+               let
+                  val () = Assert.assertAtomic' ("Event.cvarGetEvt.blockFn", NONE)
+                  val () = debug' "cvarGetEvt(3.2.1)" (* Atomic 1 *)
+                  val () = Assert.assertAtomic' ("Event.cvarGetEvt(3.2.1)", SOME 1)
+                  val () =
+                     S.atomicSwitch
+                     (fn t =>
+                      let
+                         val item = {transId = transId,
+                                     cleanUp = cleanUp,
+                                     thread = S.prep t}
+                         val waiting =
+                            case !state of
+                               CVAR_unset waiting => waiting
+                             | _ => raise Fail "cvarGetEvt:blockFn"
+                      in
+                         state := CVAR_unset (item::waiting)
+                         ; next ()
+                      end)
+                  val () = debug' "cvarGetEvt(3.2.2)" (* NonAtomic *)
+                  val () = Assert.assertNonAtomic' "Event.cvarGetEvt(3.2.2)"
+               in
+                  ()
+               end
+            fun pollFn () =
+               let
+                  val () = Assert.assertAtomic' ("Event.cvarGetEvt.pollFn", NONE)
+                  val () = debug' "cvarGetEvt(2)" (* Atomic 1 *)
+                  val () = Assert.assertAtomic' ("Event.cvarGetEvt(2)", SOME 1)
+               in
+                  case !state of
+                     CVAR_set n =>
+                        (state := CVAR_set (n + 1)
+                         ; enabled {prio = n, doitFn = doitFn})
+                   | _ => blocked blockFn
+               end
+         in
+            bevt pollFn
+         end
 
 
       (* event combinators *)
       val never : 'a event = 
-	 BEVT []
+         BEVT []
       fun alwaysEvt (v : 'a) : 'a event =
-	 let
-	    fun doitFn () =
-	       let
-		  val () = Assert.assertAtomic' ("Event.alwaysEvt.doitFn", NONE)
-		  val () = debug' "alwaysEvt(3.1)" (* Atomic 1 *)
-		  val () = Assert.assertAtomic' ("Event.alwaysEvt(3.1)", SOME 1)
-		  val () = S.atomicEnd ()
-		  val () = debug' "alwaysEvt(3.2)" (* NonAtomic *)
-		  val () = Assert.assertNonAtomic' "Event.alwaysEvt(3.2)"
-	       in
-		  v
-	       end
-	    fun pollFn () =
-	       let
-		  val () = Assert.assertAtomic' ("Event.alwaysEvt.pollFn", NONE)
-		  val () = debug' "alwaysEvt(2)" (* Atomic 1 *)
-		  val () = Assert.assertAtomic' ("Event.alwaysEvt(2)", SOME 1)
-	       in
-		  enabled {prio = ~1, doitFn = doitFn}
-	       end
-	 in
-	    bevt pollFn
-	 end
+         let
+            fun doitFn () =
+               let
+                  val () = Assert.assertAtomic' ("Event.alwaysEvt.doitFn", NONE)
+                  val () = debug' "alwaysEvt(3.1)" (* Atomic 1 *)
+                  val () = Assert.assertAtomic' ("Event.alwaysEvt(3.1)", SOME 1)
+                  val () = S.atomicEnd ()
+                  val () = debug' "alwaysEvt(3.2)" (* NonAtomic *)
+                  val () = Assert.assertNonAtomic' "Event.alwaysEvt(3.2)"
+               in
+                  v
+               end
+            fun pollFn () =
+               let
+                  val () = Assert.assertAtomic' ("Event.alwaysEvt.pollFn", NONE)
+                  val () = debug' "alwaysEvt(2)" (* Atomic 1 *)
+                  val () = Assert.assertAtomic' ("Event.alwaysEvt(2)", SOME 1)
+               in
+                  enabled {prio = ~1, doitFn = doitFn}
+               end
+         in
+            bevt pollFn
+         end
 
       fun wrap (evt : 'a event, wfn : 'a -> 'b) : 'b event =
-	 let
-	    fun wrapF f x = wfn (f x)
-	    fun wrapBaseEvt pollFn () =
-	       case pollFn () of
-		  ENABLED {prio, doitFn} => 
-		     ENABLED {prio = prio, doitFn = wrapF doitFn}
-		| BLOCKED blockFn => 
-		     BLOCKED (wrapF blockFn)
-	    fun wrap' evt =
-	       case evt of
-		  BEVT bevts => 
-		     BEVT(List.map wrapBaseEvt bevts)
-		| CHOOSE evts =>
-		     CHOOSE(List.map wrap' evts)
-		| GUARD g =>
-		     GUARD(fn () => wrap (g (), wfn))
-		| WNACK f =>
-		     WNACK(fn evt => wrap (f evt, wfn))
-	 in
-	    wrap' evt
-	 end
+         let
+            fun wrapF f x = wfn (f x)
+            fun wrapBaseEvt pollFn () =
+               case pollFn () of
+                  ENABLED {prio, doitFn} => 
+                     ENABLED {prio = prio, doitFn = wrapF doitFn}
+                | BLOCKED blockFn => 
+                     BLOCKED (wrapF blockFn)
+            fun wrap' evt =
+               case evt of
+                  BEVT bevts => 
+                     BEVT(List.map wrapBaseEvt bevts)
+                | CHOOSE evts =>
+                     CHOOSE(List.map wrap' evts)
+                | GUARD g =>
+                     GUARD(fn () => wrap (g (), wfn))
+                | WNACK f =>
+                     WNACK(fn evt => wrap (f evt, wfn))
+         in
+            wrap' evt
+         end
       fun wrapHandler (evt : 'a event, hfn : exn -> 'a) : 'a event =
-	 let
-	    fun wrapF f x = (f x) handle exn => hfn exn
-	    fun wrapBaseEvt pollFn () =
-	       case pollFn () of
-		  ENABLED {prio, doitFn} => 
-		     ENABLED {prio = prio, doitFn = wrapF doitFn}
-		| BLOCKED blockFn => 
-		     BLOCKED (wrapF blockFn)
-	    fun wrap' evt =
-	       case evt of
-		  BEVT bevts => 
-		     BEVT(List.map wrapBaseEvt bevts)
-		| CHOOSE evts =>
-		     CHOOSE(List.map wrap' evts)
-		| GUARD g =>
-		     GUARD(fn () => wrapHandler (g (), hfn))
-		| WNACK f =>
-		     WNACK(fn evt => wrapHandler (f evt, hfn))
-	 in
-	    wrap' evt
-	 end
+         let
+            fun wrapF f x = (f x) handle exn => hfn exn
+            fun wrapBaseEvt pollFn () =
+               case pollFn () of
+                  ENABLED {prio, doitFn} => 
+                     ENABLED {prio = prio, doitFn = wrapF doitFn}
+                | BLOCKED blockFn => 
+                     BLOCKED (wrapF blockFn)
+            fun wrap' evt =
+               case evt of
+                  BEVT bevts => 
+                     BEVT(List.map wrapBaseEvt bevts)
+                | CHOOSE evts =>
+                     CHOOSE(List.map wrap' evts)
+                | GUARD g =>
+                     GUARD(fn () => wrapHandler (g (), hfn))
+                | WNACK f =>
+                     WNACK(fn evt => wrapHandler (f evt, hfn))
+         in
+            wrap' evt
+         end
 
       val guard = GUARD
       val withNack = WNACK
 
       fun choose (evts : 'a event list) : 'a event =
-	 let
-	    val () = Assert.assertNonAtomic' "Event.choose"
-	    val () = debug' "choose(1)" (* NonAtomic *)
-	    val () = Assert.assertNonAtomic' "Event.choose(1)"
-	    fun gatherBEvts (evts, bevts') =
-	       case (evts, bevts') of
-		  ([], bevts') => BEVT bevts'
-	        | ((BEVT bevts)::evts, bevts') => gatherBEvts (evts, bevts @ bevts')
-		| (evts, []) => gather (evts, [])
-		| (evts, bevts') => gather (evts, [BEVT bevts'])
-	    and gather (evts, evts') =
-	       case (evts, evts') of
-		  ([], [evt']) => evt'
-		| ([], evts') => CHOOSE evts'
-		| ((CHOOSE cevts)::evts, evts') => 
-		     gather (evts, cevts @ evts')
-		| ((BEVT [])::evts, evts') =>
-		     gather (evts, evts')
-		| ((BEVT bevts)::evts, (BEVT bevts')::evts') =>
-		     gather (evts, BEVT (bevts @ bevts')::evts')
-		| (evt::evts, evts') => 
-		     gather (evts, evt::evts')
-	    val evt = gatherBEvts (List.rev evts, [])
-	 in
-	    evt
-	 end
+         let
+            val () = Assert.assertNonAtomic' "Event.choose"
+            val () = debug' "choose(1)" (* NonAtomic *)
+            val () = Assert.assertNonAtomic' "Event.choose(1)"
+            fun gatherBEvts (evts, bevts') =
+               case (evts, bevts') of
+                  ([], bevts') => BEVT bevts'
+                | ((BEVT bevts)::evts, bevts') => gatherBEvts (evts, bevts @ bevts')
+                | (evts, []) => gather (evts, [])
+                | (evts, bevts') => gather (evts, [BEVT bevts'])
+            and gather (evts, evts') =
+               case (evts, evts') of
+                  ([], [evt']) => evt'
+                | ([], evts') => CHOOSE evts'
+                | ((CHOOSE cevts)::evts, evts') => 
+                     gather (evts, cevts @ evts')
+                | ((BEVT [])::evts, evts') =>
+                     gather (evts, evts')
+                | ((BEVT bevts)::evts, (BEVT bevts')::evts') =>
+                     gather (evts, BEVT (bevts @ bevts')::evts')
+                | (evt::evts, evts') => 
+                     gather (evts, evt::evts')
+            val evt = gatherBEvts (List.rev evts, [])
+         in
+            evt
+         end
       
 
       local
-	 val cnt = ref 0
-	 fun random i =
-	    let val j = !cnt
-	    in
-	       if j = 1000000 then cnt := 0 else cnt := j + 1
-	       ; Int.rem (j, i)
-	    end
+         val cnt = ref 0
+         fun random i =
+            let val j = !cnt
+            in
+               if j = 1000000 then cnt := 0 else cnt := j + 1
+               ; Int.rem (j, i)
+            end
       in
       fun selectDoitFn (doitFns : {prio : int, doitFn : 'a} list) : 'a =
-	 let
-	    val () = Assert.assertAtomic' ("Event.selectDoitFn", NONE)
-	    val () = debug' "selectDoitFn(2)" (* Atomic 1 *)
-	    val () = Assert.assertAtomic' ("Event.selectDoitFn(2)", SOME 1)
-	 in
-	    case doitFns of
-	       [{doitFn, ...}] => doitFn
-	     | doitFns =>
-		  let
-		     fun select (doitFns, maxP,
-				 doitFnsMaxP, numMaxP,
-				 doitFnsFixed, numFixed) =
-			case doitFns of
-			   [] => (case (doitFnsMaxP, doitFnsFixed) of
-				     ([doitFn], []) => doitFn
-				   | ([], [doitFn]) => doitFn
-				   | (doitFnsMaxP, doitFnsFixed) =>
-					let
-					   val bias = 2
-					   val num = numFixed + bias * numMaxP
-					   val k = random num
-					in
-					   if k < numFixed
-					      then List.nth (doitFnsFixed, k)
-					      else List.nth (doitFnsMaxP, 
-							     Int.mod(k - numFixed, numMaxP))
-					end)
-			 | {prio, doitFn}::doitFns =>
-			      if prio = ~1
-				 then select(doitFns, maxP, 
-					     doitFnsMaxP, numMaxP,
-					     doitFn::doitFnsFixed, numFixed + 1)
-				 else if prio > maxP 
-					 then select(doitFns, prio, 
-						     [doitFn], 1,
-						     doitFnsFixed, numFixed)
-					 else if prio = maxP
-						 then select(doitFns, maxP, 
-							     doitFn::doitFnsMaxP, numMaxP + 1,
-							     doitFnsFixed, numFixed)
-						 else select(doitFns, maxP, 
-							     doitFnsMaxP, numMaxP,
-							     doitFnsFixed, numFixed)
-		  in
-		     select (doitFns, 0, [], 0, [], 0)
-		  end
-	 end
+         let
+            val () = Assert.assertAtomic' ("Event.selectDoitFn", NONE)
+            val () = debug' "selectDoitFn(2)" (* Atomic 1 *)
+            val () = Assert.assertAtomic' ("Event.selectDoitFn(2)", SOME 1)
+         in
+            case doitFns of
+               [{doitFn, ...}] => doitFn
+             | doitFns =>
+                  let
+                     fun select (doitFns, maxP,
+                                 doitFnsMaxP, numMaxP,
+                                 doitFnsFixed, numFixed) =
+                        case doitFns of
+                           [] => (case (doitFnsMaxP, doitFnsFixed) of
+                                     ([doitFn], []) => doitFn
+                                   | ([], [doitFn]) => doitFn
+                                   | (doitFnsMaxP, doitFnsFixed) =>
+                                        let
+                                           val bias = 2
+                                           val num = numFixed + bias * numMaxP
+                                           val k = random num
+                                        in
+                                           if k < numFixed
+                                              then List.nth (doitFnsFixed, k)
+                                              else List.nth (doitFnsMaxP, 
+                                                             Int.mod(k - numFixed, numMaxP))
+                                        end)
+                         | {prio, doitFn}::doitFns =>
+                              if prio = ~1
+                                 then select(doitFns, maxP, 
+                                             doitFnsMaxP, numMaxP,
+                                             doitFn::doitFnsFixed, numFixed + 1)
+                                 else if prio > maxP 
+                                         then select(doitFns, prio, 
+                                                     [doitFn], 1,
+                                                     doitFnsFixed, numFixed)
+                                         else if prio = maxP
+                                                 then select(doitFns, maxP, 
+                                                             doitFn::doitFnsMaxP, numMaxP + 1,
+                                                             doitFnsFixed, numFixed)
+                                                 else select(doitFns, maxP, 
+                                                             doitFnsMaxP, numMaxP,
+                                                             doitFnsFixed, numFixed)
+                  in
+                     select (doitFns, 0, [], 0, [], 0)
+                  end
+         end
       end
 
       fun syncOnBEvt (pollFn : 'a base) : 'a =
-	 let
-	    val () = Assert.assertNonAtomic' "Event.syncOnBEvt"	
-	    val () = debug' "syncOnBEvt(1)" (* NonAtomic *)
-	    val () = Assert.assertNonAtomic' "Event.syncOnBEvt(1)"
-	    val () = S.atomicBegin ()	
-	    val () = debug' "syncOnBEvt(2)" (* Atomic 1 *)
-	    val () = Assert.assertAtomic' ("Event.syncOnBEvt(2)", SOME 1)
-	    val x = 
-	       case pollFn () of
-		  ENABLED {doitFn, ...} => doitFn ()
-		| BLOCKED blockFn => 
-		     let val (transId, cleanUp) = TransID.mkFlg ()
-		     in blockFn {transId = transId,
-				 cleanUp = cleanUp,
-				 next = S.next}
-		     end
-	    val () = debug' "syncOnBEvt(4)" (* NonAtomic *)
-	    val () = Assert.assertNonAtomic' "Event.syncOnBEvt(4)"
-	 in
-	    x
-	 end
-		  
+         let
+            val () = Assert.assertNonAtomic' "Event.syncOnBEvt" 
+            val () = debug' "syncOnBEvt(1)" (* NonAtomic *)
+            val () = Assert.assertNonAtomic' "Event.syncOnBEvt(1)"
+            val () = S.atomicBegin ()   
+            val () = debug' "syncOnBEvt(2)" (* Atomic 1 *)
+            val () = Assert.assertAtomic' ("Event.syncOnBEvt(2)", SOME 1)
+            val x = 
+               case pollFn () of
+                  ENABLED {doitFn, ...} => doitFn ()
+                | BLOCKED blockFn => 
+                     let val (transId, cleanUp) = TransID.mkFlg ()
+                     in blockFn {transId = transId,
+                                 cleanUp = cleanUp,
+                                 next = S.next}
+                     end
+            val () = debug' "syncOnBEvt(4)" (* NonAtomic *)
+            val () = Assert.assertNonAtomic' "Event.syncOnBEvt(4)"
+         in
+            x
+         end
+                  
       (* this function handles the case of synchronizing on a list of 
        * base events (w/o any negative acknowledgements).   It also handles 
        * the case of syncrhonizing on NEVER.
        *) 
       fun syncOnBEvts (bevts : 'a base list) : 'a =
-	 let
-	    val () = Assert.assertNonAtomic' "Event.syncOnBEvts"
-	    val () = debug' "syncOnBEvts(1)" (* NonAtomic *)
-	    val () = Assert.assertNonAtomic' "Event.syncOnBEvts(1)"
-	    fun ext (bevts, blockFns) : 'a =
-	       let
-		  val () = debug' "syncOnBEvts(2).ext" (* Atomic 1 *)
-		  val () = Assert.assertAtomic' ("Event.syncOnBEvts(2).ext", SOME 1)
-	       in
-		  case bevts of
-		     [] =>
-			let
-			   val () = debug' "syncOnBEvts(2).ext([])" (* Atomic 1 *)	
-			   val () = Assert.assertAtomic' ("Event.syncOnBEvts(2).ext([])", SOME 1)
-			in
-			   S.atomicSwitch
-			   (fn (t : 'a S.thread) =>
-			    let
-			       val (transId, cleanUp) = TransID.mkFlg ()
-			       fun log blockFns : S.rdy_thread =
-				  let
-				     val () = debug' "syncOnBEvts(2).ext([]).log" (* Atomic 1 *)	
-				     val () = Assert.assertAtomic' ("Event.syncOnBEvts(2).ext([]).log", SOME 1)
-				  in
-				     case blockFns of
-					[] => S.next ()
-				      | blockFn::blockFns =>
-					   (S.prep o S.new)
-					   (fn _ => fn () =>
-					    let 
-					       val () = S.atomicBegin ()
-					       val x = blockFn {transId = transId,
-								cleanUp = cleanUp,
-								next = fn () => log blockFns}
-					    in S.switch(fn _ => S.prepVal (t, x))
-					    end)
-				  end
-			    in
-			       log blockFns
-			    end)
-			end
-		   | pollFn::bevts =>
-			(case pollFn () of
-			    ENABLED doitFn => extRdy (bevts, [doitFn])
-			  | BLOCKED blockFn => ext (bevts, blockFn::blockFns))
-	       end
-	    and extRdy (bevts, doitFns) : 'a =
-	       let
-		  val () = debug' "syncOnBEvts(2).extRdy" (* Atomic 1*)
-		  val () = Assert.assertAtomic' ("Event.syncOnBEvts(2).extRdy", SOME 1)
-	       in
-		  case bevts of
-		     [] => 
-			let val doitFn = selectDoitFn doitFns
-			in doitFn ()
-			end
-		   | pollFn::bevts =>
-			(case pollFn () of
-			    ENABLED doitFn => extRdy (bevts, doitFn::doitFns)
-			  | _ => extRdy (bevts, doitFns))
-	       end
-	    val x =
-	       case bevts of
-		  [] => S.switchToNext (fn _ => ())
-		| [bevt] => syncOnBEvt bevt
-		| bevts => (S.atomicBegin (); ext (bevts, []))
-	    val () = debug' "syncOnBEvts(4)" (* NonAtomic *)
-	    val () = Assert.assertNonAtomic' "Event.syncOnBEvts(4)"
-	 in
-	    x
-	 end
+         let
+            val () = Assert.assertNonAtomic' "Event.syncOnBEvts"
+            val () = debug' "syncOnBEvts(1)" (* NonAtomic *)
+            val () = Assert.assertNonAtomic' "Event.syncOnBEvts(1)"
+            fun ext (bevts, blockFns) : 'a =
+               let
+                  val () = debug' "syncOnBEvts(2).ext" (* Atomic 1 *)
+                  val () = Assert.assertAtomic' ("Event.syncOnBEvts(2).ext", SOME 1)
+               in
+                  case bevts of
+                     [] =>
+                        let
+                           val () = debug' "syncOnBEvts(2).ext([])" (* Atomic 1 *)      
+                           val () = Assert.assertAtomic' ("Event.syncOnBEvts(2).ext([])", SOME 1)
+                        in
+                           S.atomicSwitch
+                           (fn (t : 'a S.thread) =>
+                            let
+                               val (transId, cleanUp) = TransID.mkFlg ()
+                               fun log blockFns : S.rdy_thread =
+                                  let
+                                     val () = debug' "syncOnBEvts(2).ext([]).log" (* Atomic 1 *)        
+                                     val () = Assert.assertAtomic' ("Event.syncOnBEvts(2).ext([]).log", SOME 1)
+                                  in
+                                     case blockFns of
+                                        [] => S.next ()
+                                      | blockFn::blockFns =>
+                                           (S.prep o S.new)
+                                           (fn _ => fn () =>
+                                            let 
+                                               val () = S.atomicBegin ()
+                                               val x = blockFn {transId = transId,
+                                                                cleanUp = cleanUp,
+                                                                next = fn () => log blockFns}
+                                            in S.switch(fn _ => S.prepVal (t, x))
+                                            end)
+                                  end
+                            in
+                               log blockFns
+                            end)
+                        end
+                   | pollFn::bevts =>
+                        (case pollFn () of
+                            ENABLED doitFn => extRdy (bevts, [doitFn])
+                          | BLOCKED blockFn => ext (bevts, blockFn::blockFns))
+               end
+            and extRdy (bevts, doitFns) : 'a =
+               let
+                  val () = debug' "syncOnBEvts(2).extRdy" (* Atomic 1*)
+                  val () = Assert.assertAtomic' ("Event.syncOnBEvts(2).extRdy", SOME 1)
+               in
+                  case bevts of
+                     [] => 
+                        let val doitFn = selectDoitFn doitFns
+                        in doitFn ()
+                        end
+                   | pollFn::bevts =>
+                        (case pollFn () of
+                            ENABLED doitFn => extRdy (bevts, doitFn::doitFns)
+                          | _ => extRdy (bevts, doitFns))
+               end
+            val x =
+               case bevts of
+                  [] => S.switchToNext (fn _ => ())
+                | [bevt] => syncOnBEvt bevt
+                | bevts => (S.atomicBegin (); ext (bevts, []))
+            val () = debug' "syncOnBEvts(4)" (* NonAtomic *)
+            val () = Assert.assertNonAtomic' "Event.syncOnBEvts(4)"
+         in
+            x
+         end
 
       (* walk the event group tree, collecting the base events (with associated
        * ack flags), and a list of flag sets.  A flag set is a (cvar * ack flag list)
@@ -431,243 +431,243 @@
       type flg_set = cvar * ack_flg list
       type flg_sets = flg_set list
       fun collect (gevt : 'a group) : 'a backs * flg_sets = 
-	 let
-	    fun gatherWrapped (gevt : 'a group, backs : 'a backs, flgSets : flg_sets) :
+         let
+            fun gatherWrapped (gevt : 'a group, backs : 'a backs, flgSets : flg_sets) :
                               'a backs * flg_sets = 
-	       let
-		  fun gather (gevt : 'a group, backs : 'a backs, 
-			      ackFlgs : ack_flgs, flgSets : flg_sets) :
-		             'a backs * ack_flgs * flg_sets =
-		     case gevt of
-			BASE bevts =>
-			   let
-			      fun append (bevts, backs, ackFlgs) =
-				 case bevts of
-				    [] => (backs, ackFlgs)
-				  | bevt::bevts =>
-				       let val ackFlg = ref false
-				       in append (bevts, (bevt, ackFlg)::backs, ackFlg::ackFlgs)
-				       end
-			      val (backs', ackFlgs') = append (bevts, backs, ackFlgs)
-			   in
-			      (backs', ackFlgs', flgSets)
-			   end
-		      | GRP gevt =>
-			   let
-			      fun f (gevt', (backs', ackFlgs', flgSets')) =
-				 gather (gevt', backs', ackFlgs', flgSets')
-			   in List.foldl f (backs, ackFlgs, flgSets) gevt
-			   end
-		      | NACK (cvar, gevt) => 
-			   let
-			      val (backs', ackFlgs', flgSets') =
-				 gather (gevt, backs, [], flgSets)
-			   in
-			      (backs', ackFlgs' @ ackFlgs, (cvar, ackFlgs')::flgSets')
-			   end
-		  val (backs, _, flgSets) = gather (gevt, backs, [], flgSets)
-	       in
-		  (backs, flgSets)
-	       end
-	 in
-	    case gevt of
-	       GRP _ => 
-		  let
-		     val ackFlg = ref false
-		     fun gather (gevt : 'a group, backs : 'a backs, flgSets : flg_sets) :
-			        'a backs * flg_sets =
-			case gevt of
-			   BASE bevts => 
-			      let
-				 fun append (bevts, backs) =
-				    case bevts of
-				       [] => backs
-				     | bevt::bevts => append (bevts, (bevt, ackFlg)::backs)
-			      in 
-				 (append (bevts, backs), flgSets)
-			      end
-			 | GRP gevt =>
-			      let
-				 fun f (gevt', (backs', flgSets')) =
-				    gather(gevt', backs', flgSets')
-			      in List.foldl f (backs, flgSets) gevt
-			      end
-			 | NACK _ =>
-			      gatherWrapped (gevt, backs, flgSets)
-		  in
-		     gather (gevt, [], [])
-		  end
-	     | gevt => gatherWrapped (gevt, [], [])
-	 end
+               let
+                  fun gather (gevt : 'a group, backs : 'a backs, 
+                              ackFlgs : ack_flgs, flgSets : flg_sets) :
+                             'a backs * ack_flgs * flg_sets =
+                     case gevt of
+                        BASE bevts =>
+                           let
+                              fun append (bevts, backs, ackFlgs) =
+                                 case bevts of
+                                    [] => (backs, ackFlgs)
+                                  | bevt::bevts =>
+                                       let val ackFlg = ref false
+                                       in append (bevts, (bevt, ackFlg)::backs, ackFlg::ackFlgs)
+                                       end
+                              val (backs', ackFlgs') = append (bevts, backs, ackFlgs)
+                           in
+                              (backs', ackFlgs', flgSets)
+                           end
+                      | GRP gevt =>
+                           let
+                              fun f (gevt', (backs', ackFlgs', flgSets')) =
+                                 gather (gevt', backs', ackFlgs', flgSets')
+                           in List.foldl f (backs, ackFlgs, flgSets) gevt
+                           end
+                      | NACK (cvar, gevt) => 
+                           let
+                              val (backs', ackFlgs', flgSets') =
+                                 gather (gevt, backs, [], flgSets)
+                           in
+                              (backs', ackFlgs' @ ackFlgs, (cvar, ackFlgs')::flgSets')
+                           end
+                  val (backs, _, flgSets) = gather (gevt, backs, [], flgSets)
+               in
+                  (backs, flgSets)
+               end
+         in
+            case gevt of
+               GRP _ => 
+                  let
+                     val ackFlg = ref false
+                     fun gather (gevt : 'a group, backs : 'a backs, flgSets : flg_sets) :
+                                'a backs * flg_sets =
+                        case gevt of
+                           BASE bevts => 
+                              let
+                                 fun append (bevts, backs) =
+                                    case bevts of
+                                       [] => backs
+                                     | bevt::bevts => append (bevts, (bevt, ackFlg)::backs)
+                              in 
+                                 (append (bevts, backs), flgSets)
+                              end
+                         | GRP gevt =>
+                              let
+                                 fun f (gevt', (backs', flgSets')) =
+                                    gather(gevt', backs', flgSets')
+                              in List.foldl f (backs, flgSets) gevt
+                              end
+                         | NACK _ =>
+                              gatherWrapped (gevt, backs, flgSets)
+                  in
+                     gather (gevt, [], [])
+                  end
+             | gevt => gatherWrapped (gevt, [], [])
+         end
 
       (* this function handles the more complicated case of synchronization
        * on groups of events where negative acknowledgements are involved.
        *)
       fun syncOnGrp (gevt : 'a group) : 'a =
-	 let
-	    val () = Assert.assertNonAtomic' "Event.syncOnGrp"
-	    val () = debug' "syncOnGrp(1)" (* NonAtomic *)
-	    val () = Assert.assertNonAtomic' "Event.syncOnGrp(1)"
-	    val (backs, flgSets) = collect gevt
-	    fun chkCVars () =
-	       let
-		  val () = debug' "syncOnGrp.chkCVars" (* Atomic 1 *)
-		  val () = Assert.assertAtomic' ("Event.syncOnGrp.chkCVars", SOME 1)
-		  (* chkCVar checks the flags of a flag set.
-		   * If they are all false, then the corresponding cvar
-		   * is set to signal the negative ack.
-		   *)
-		  fun chkCVar (cvar, flgs) =
-		     if List.exists ! flgs
-			then ()
-			else atomicCVarSet cvar
-	       in
-		  List.app chkCVar flgSets
-	       end
-	    fun ext (backs, blockFns) : 'a =
-	       let
-		  val () = debug' "syncOnGrp(2).ext" (* Atomic 1 *)
-		  val () = Assert.assertAtomic' ("Event.syncOnGrp(2).ext", SOME 1)
-	       in
-		  case backs of
-		     [] =>
-			let
-			   val () = debug' "syncOnGrp(2).ext([])" (* Atomic 1 *)	
-			   val () = Assert.assertAtomic' ("Event.syncOnGrp(2).ext([])", SOME 1)
-			in
-			   S.atomicSwitch
-			   (fn (t : 'a S.thread) =>
-			    let
-			       val (transId, cleanUp) = TransID.mkFlg ()
-			       val cleanUp = fn flg => fn () =>
-				  (cleanUp ()
-				   ; flg := true
-				   ; chkCVars ())
-			       fun log blockFns : S.rdy_thread =
-				  let
-				     val () = debug' "syncOnGrp(2).ext([]).log" (* Atomic 1 *)	
-				     val () = Assert.assertAtomic' ("Event.syncOnGrp(2).ext([]).log", SOME 1)
-				  in
-				     case blockFns of
-					[] => S.next ()
-				      | (blockFn,ackFlg)::blockFns =>
-					   (S.prep o S.new)
-					   (fn _ => fn () =>
-					    let 
-					       val () = S.atomicBegin ()
-					       val x = blockFn {transId = transId,
-								cleanUp = cleanUp ackFlg,
-								next = fn () => log blockFns}
-					    in S.switch(fn _ => S.prepVal (t, x))
-					    end)
-				  end
-			    in
-			       log blockFns
-			    end)
-			end
-		   | (pollFn,ackFlg)::backs =>
-			(case pollFn () of
-			    ENABLED {prio, doitFn} => 
-			       extRdy (backs, [{prio = prio,doitFn = (doitFn, ackFlg)}])
-			  | BLOCKED blockFn => ext (backs, (blockFn,ackFlg)::blockFns))
-	       end
-	    and extRdy (backs, doitFns) : 'a =
-	       let
-		  val () = debug' "syncOnGrp.extRdy(2)" (* Atomic 1*)
-		  val () = Assert.assertAtomic' ("Event.syncOnGrp.extRdy(2)", SOME 1)
-	       in
-		  case backs of
-		     [] => let
-			      val (doitFn, flg) = selectDoitFn doitFns
-			   in
-			      flg := true
-			      ; chkCVars ()
-			      ; doitFn ()
-			   end
-		   | (pollFn,ackFlg)::backs =>
-			   (case pollFn () of
-			       ENABLED {prio, doitFn} => 
-				  extRdy (backs, {prio = prio, doitFn = (doitFn, ackFlg)}::doitFns)
-			     | _ => extRdy (backs, doitFns))
-	       end
-	    val x =
-	       case backs of
-		  [(bevt, _)] => syncOnBEvt bevt
-		| _ => (S.atomicBegin (); ext (backs, []))
-	    val () = debug' "syncOnGrp(4)" (* NonAtomic *)
-	    val () = Assert.assertNonAtomic' "Event.syncOnGrp(4)"
-	 in
-	    x
-	 end
+         let
+            val () = Assert.assertNonAtomic' "Event.syncOnGrp"
+            val () = debug' "syncOnGrp(1)" (* NonAtomic *)
+            val () = Assert.assertNonAtomic' "Event.syncOnGrp(1)"
+            val (backs, flgSets) = collect gevt
+            fun chkCVars () =
+               let
+                  val () = debug' "syncOnGrp.chkCVars" (* Atomic 1 *)
+                  val () = Assert.assertAtomic' ("Event.syncOnGrp.chkCVars", SOME 1)
+                  (* chkCVar checks the flags of a flag set.
+                   * If they are all false, then the corresponding cvar
+                   * is set to signal the negative ack.
+                   *)
+                  fun chkCVar (cvar, flgs) =
+                     if List.exists ! flgs
+                        then ()
+                        else atomicCVarSet cvar
+               in
+                  List.app chkCVar flgSets
+               end
+            fun ext (backs, blockFns) : 'a =
+               let
+                  val () = debug' "syncOnGrp(2).ext" (* Atomic 1 *)
+                  val () = Assert.assertAtomic' ("Event.syncOnGrp(2).ext", SOME 1)
+               in
+                  case backs of
+                     [] =>
+                        let
+                           val () = debug' "syncOnGrp(2).ext([])" (* Atomic 1 *)        
+                           val () = Assert.assertAtomic' ("Event.syncOnGrp(2).ext([])", SOME 1)
+                        in
+                           S.atomicSwitch
+                           (fn (t : 'a S.thread) =>
+                            let
+                               val (transId, cleanUp) = TransID.mkFlg ()
+                               val cleanUp = fn flg => fn () =>
+                                  (cleanUp ()
+                                   ; flg := true
+                                   ; chkCVars ())
+                               fun log blockFns : S.rdy_thread =
+                                  let
+                                     val () = debug' "syncOnGrp(2).ext([]).log" (* Atomic 1 *)  
+                                     val () = Assert.assertAtomic' ("Event.syncOnGrp(2).ext([]).log", SOME 1)
+                                  in
+                                     case blockFns of
+                                        [] => S.next ()
+                                      | (blockFn,ackFlg)::blockFns =>
+                                           (S.prep o S.new)
+                                           (fn _ => fn () =>
+                                            let 
+                                               val () = S.atomicBegin ()
+                                               val x = blockFn {transId = transId,
+                                                                cleanUp = cleanUp ackFlg,
+                                                                next = fn () => log blockFns}
+                                            in S.switch(fn _ => S.prepVal (t, x))
+                                            end)
+                                  end
+                            in
+                               log blockFns
+                            end)
+                        end
+                   | (pollFn,ackFlg)::backs =>
+                        (case pollFn () of
+                            ENABLED {prio, doitFn} => 
+                               extRdy (backs, [{prio = prio,doitFn = (doitFn, ackFlg)}])
+                          | BLOCKED blockFn => ext (backs, (blockFn,ackFlg)::blockFns))
+               end
+            and extRdy (backs, doitFns) : 'a =
+               let
+                  val () = debug' "syncOnGrp.extRdy(2)" (* Atomic 1*)
+                  val () = Assert.assertAtomic' ("Event.syncOnGrp.extRdy(2)", SOME 1)
+               in
+                  case backs of
+                     [] => let
+                              val (doitFn, flg) = selectDoitFn doitFns
+                           in
+                              flg := true
+                              ; chkCVars ()
+                              ; doitFn ()
+                           end
+                   | (pollFn,ackFlg)::backs =>
+                           (case pollFn () of
+                               ENABLED {prio, doitFn} => 
+                                  extRdy (backs, {prio = prio, doitFn = (doitFn, ackFlg)}::doitFns)
+                             | _ => extRdy (backs, doitFns))
+               end
+            val x =
+               case backs of
+                  [(bevt, _)] => syncOnBEvt bevt
+                | _ => (S.atomicBegin (); ext (backs, []))
+            val () = debug' "syncOnGrp(4)" (* NonAtomic *)
+            val () = Assert.assertNonAtomic' "Event.syncOnGrp(4)"
+         in
+            x
+         end
 
       local
-	 (* force the evaluation of any guards in an event collection,
-	  * returning an event group.
-	  *)
-	 fun forceBL (evts : 'a event list, bevts : 'a base list) : 'a group =
-	    case evts of
-	       [] => BASE bevts
-	     | evt::evts =>
-		  (case force evt of
-		      BASE bevts' => forceBL (evts, bevts' @ bevts)
-		    | GRP gevts => forceGL (evts, if List.null bevts then gevts else gevts @ [BASE bevts])
-		    | gevt => forceGL (evts, if List.null bevts then [gevt] else [gevt, BASE bevts]))
-	 and forceGL (evts : 'a event list, gevts : 'a group list) : 'a group =
-	    case (evts, gevts) of
-	       ([], [gevt]) => gevt
-	     | ([], gevts) => GRP gevts
-	     | (evt::evts, gevts) =>
-		  (case (force evt, gevts) of
-		      (BASE [], gevts) =>
-			 forceGL (evts, gevts)
-		    | (BASE bevts', (BASE bevts)::gevts) =>
-			 forceGL (evts, BASE (bevts' @ bevts)::gevts)
-		    | (GRP gevts', gevts) =>
-			 forceGL (evts, gevts' @ gevts)
-		    | (gevt, gevts) => 
-			 forceGL (evts, gevt::gevts))
-	 and force (evt : 'a event) : 'a group =
-	    let
-	       val gevt =
-		  case evt of
-		     BEVT bevts => BASE bevts 	
-		   | CHOOSE evts => forceBL (evts, [])
-		   | GUARD g => force (g ())
-		   | WNACK f =>
-			let val cvar = CVar.new ()
-			in NACK(cvar, force (f (cvarGetEvt cvar)))
-			end
-	    in
-	       gevt
-	    end
+         (* force the evaluation of any guards in an event collection,
+          * returning an event group.
+          *)
+         fun forceBL (evts : 'a event list, bevts : 'a base list) : 'a group =
+            case evts of
+               [] => BASE bevts
+             | evt::evts =>
+                  (case force evt of
+                      BASE bevts' => forceBL (evts, bevts' @ bevts)
+                    | GRP gevts => forceGL (evts, if List.null bevts then gevts else gevts @ [BASE bevts])
+                    | gevt => forceGL (evts, if List.null bevts then [gevt] else [gevt, BASE bevts]))
+         and forceGL (evts : 'a event list, gevts : 'a group list) : 'a group =
+            case (evts, gevts) of
+               ([], [gevt]) => gevt
+             | ([], gevts) => GRP gevts
+             | (evt::evts, gevts) =>
+                  (case (force evt, gevts) of
+                      (BASE [], gevts) =>
+                         forceGL (evts, gevts)
+                    | (BASE bevts', (BASE bevts)::gevts) =>
+                         forceGL (evts, BASE (bevts' @ bevts)::gevts)
+                    | (GRP gevts', gevts) =>
+                         forceGL (evts, gevts' @ gevts)
+                    | (gevt, gevts) => 
+                         forceGL (evts, gevt::gevts))
+         and force (evt : 'a event) : 'a group =
+            let
+               val gevt =
+                  case evt of
+                     BEVT bevts => BASE bevts   
+                   | CHOOSE evts => forceBL (evts, [])
+                   | GUARD g => force (g ())
+                   | WNACK f =>
+                        let val cvar = CVar.new ()
+                        in NACK(cvar, force (f (cvarGetEvt cvar)))
+                        end
+            in
+               gevt
+            end
       in
-	 fun sync evt =
-	    let
-	       val () = Assert.assertNonAtomic' "Event.sync"
-	       val () = debug' "sync(1)" (* NonAtomic *)
-	       val () = Assert.assertNonAtomic' "Event.sync(1)"
-	       val x = 
-		  case force evt of
-		     BASE bevts => syncOnBEvts bevts
-		   | gevt => syncOnGrp gevt
-	       val () = debug' "sync(4)" (* NonAtomic *)
-	       val () = Assert.assertNonAtomic' "Event.sync(4)"
-	    in
-	       x
-	    end
-	 fun select (evts : 'a event list) : 'a =
-	    let
-	       val () = Assert.assertNonAtomic' "Event.select"
-	       val () = debug' "select(1)" (* NonAtomic *)
-	       val () = Assert.assertNonAtomic' "Event.select(1)"
-	       val x = 
-		  case forceBL (evts, []) of
-		     BASE bevts => syncOnBEvts bevts
-		   | gevt => syncOnGrp gevt
-	       val () = debug' "select(4)" (* NonAtomic *)
-	       val () = Assert.assertNonAtomic' "Event.select(4)"
-	    in
-	       x
-	    end
+         fun sync evt =
+            let
+               val () = Assert.assertNonAtomic' "Event.sync"
+               val () = debug' "sync(1)" (* NonAtomic *)
+               val () = Assert.assertNonAtomic' "Event.sync(1)"
+               val x = 
+                  case force evt of
+                     BASE bevts => syncOnBEvts bevts
+                   | gevt => syncOnGrp gevt
+               val () = debug' "sync(4)" (* NonAtomic *)
+               val () = Assert.assertNonAtomic' "Event.sync(4)"
+            in
+               x
+            end
+         fun select (evts : 'a event list) : 'a =
+            let
+               val () = Assert.assertNonAtomic' "Event.select"
+               val () = debug' "select(1)" (* NonAtomic *)
+               val () = Assert.assertNonAtomic' "Event.select(1)"
+               val x = 
+                  case forceBL (evts, []) of
+                     BASE bevts => syncOnBEvts bevts
+                   | gevt => syncOnGrp gevt
+               val () = debug' "select(4)" (* NonAtomic *)
+               val () = Assert.assertNonAtomic' "Event.select(4)"
+            in
+               x
+            end
       end
    end

Modified: mlton/branches/on-20050420-cmm-branch/lib/cml/core-cml/mailbox.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/cml/core-cml/mailbox.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/cml/core-cml/mailbox.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -14,10 +14,10 @@
 signature MAILBOX =
    sig
       type 'a mbox
-	 
+         
       val mailbox     : unit -> 'a mbox
       val sameMailbox : ('a mbox * 'a mbox) -> bool
-	 
+         
       val send     : ('a mbox * 'a) -> unit
       val recv     : 'a mbox -> 'a
       val recvEvt  : 'a mbox -> 'a CML.event

Modified: mlton/branches/on-20050420-cmm-branch/lib/cml/core-cml/mailbox.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/cml/core-cml/mailbox.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/cml/core-cml/mailbox.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -30,7 +30,7 @@
        * never be empty (use EMPTY instead).
        *)
       datatype 'a state =
-	 EMPTY of (TransID.trans_id * 'a S.thread) Q.t
+         EMPTY of (TransID.trans_id * 'a S.thread) Q.t
        | NONEMPTY of (int * 'a Q.t)
 
       datatype 'a mbox = MB of 'a state ref
@@ -44,124 +44,124 @@
       fun sameMailbox (MB s1, MB s2) = (s1 = s2)
 
       local
-	 fun cleaner (TXID txst, _) = 
-	    case !txst of CANCEL => true | _ => false
+         fun cleaner (TXID txst, _) = 
+            case !txst of CANCEL => true | _ => false
       in
-	 fun cleanAndDeque q =
-	    Q.cleanAndDeque (q, cleaner)
+         fun cleanAndDeque q =
+            Q.cleanAndDeque (q, cleaner)
       end
 
       fun send (MB state, x) = 
-	 let
-	    val () = Assert.assertNonAtomic' "Mailbox.send"
-	    val () = debug' "Mailbox.send(1)" (* NonAtomic *)
-	    val () = Assert.assertNonAtomic' "Mailbox.send(1)"
-	    val () = S.atomicBegin ()
-	    val () = debug' "Mailbox.send(2)" (* Atomic 1 *)
-	    val () = Assert.assertAtomic' ("Mailbox.send(2)", SOME 1)
-	    val () = 
-	       case !state of 
-		  EMPTY q => 
-		     let
-			val () = debug' "Mailbox.send(3.1.1)" (* Atomic 1 *)
-			val () = Assert.assertAtomic' ("Mailbox.send(3.1.1)", SOME 1)
-		     in
-			case (cleanAndDeque q) of
-			   (NONE, _) => 
-			      (let val q = Q.new ()
-			       in state := NONEMPTY (1, Q.enque (q, x))
-			       end
-			       ; S.atomicEnd())
-			 | (SOME (transId', t'), q') =>
-			      S.readyAndSwitch
-			      (fn () =>
-			       (state := EMPTY q'
-				; TransID.force transId'
-				; S.prepVal (t', x)))
-		     end
-		| NONEMPTY (p, q) => 
-		     (* we force a context switch here to prevent 
-		      * a producer from outrunning a consumer.
-		      *)
-		     S.atomicReadyAndSwitchToNext
-		     (fn () => state := NONEMPTY (p, Q.enque (q, x)))
-	    val () = debug' "Mailbox.send(4)" (* NonAtomic *)
-	    val () = Assert.assertNonAtomic' "Channel.send(4)"
-	 in
-	    ()
-	 end
+         let
+            val () = Assert.assertNonAtomic' "Mailbox.send"
+            val () = debug' "Mailbox.send(1)" (* NonAtomic *)
+            val () = Assert.assertNonAtomic' "Mailbox.send(1)"
+            val () = S.atomicBegin ()
+            val () = debug' "Mailbox.send(2)" (* Atomic 1 *)
+            val () = Assert.assertAtomic' ("Mailbox.send(2)", SOME 1)
+            val () = 
+               case !state of 
+                  EMPTY q => 
+                     let
+                        val () = debug' "Mailbox.send(3.1.1)" (* Atomic 1 *)
+                        val () = Assert.assertAtomic' ("Mailbox.send(3.1.1)", SOME 1)
+                     in
+                        case (cleanAndDeque q) of
+                           (NONE, _) => 
+                              (let val q = Q.new ()
+                               in state := NONEMPTY (1, Q.enque (q, x))
+                               end
+                               ; S.atomicEnd())
+                         | (SOME (transId', t'), q') =>
+                              S.readyAndSwitch
+                              (fn () =>
+                               (state := EMPTY q'
+                                ; TransID.force transId'
+                                ; S.prepVal (t', x)))
+                     end
+                | NONEMPTY (p, q) => 
+                     (* we force a context switch here to prevent 
+                      * a producer from outrunning a consumer.
+                      *)
+                     S.atomicReadyAndSwitchToNext
+                     (fn () => state := NONEMPTY (p, Q.enque (q, x)))
+            val () = debug' "Mailbox.send(4)" (* NonAtomic *)
+            val () = Assert.assertNonAtomic' "Channel.send(4)"
+         in
+            ()
+         end
 
       fun getMsg (state, q) = 
-	 let
-	    val (msg, q') = 
-	       case Q.deque q of
-		  SOME (msg, q') => (msg, q')
-		| NONE => raise Fail "Mailbox:getMsg"
-	    val () = if Q.empty q'
-			then state := EMPTY (Q.new ())
-			else state := NONEMPTY (1, q')
-	    val () = S.atomicEnd ()
-	 in
-	    msg
-	 end
+         let
+            val (msg, q') = 
+               case Q.deque q of
+                  SOME (msg, q') => (msg, q')
+                | NONE => raise Fail "Mailbox:getMsg"
+            val () = if Q.empty q'
+                        then state := EMPTY (Q.new ())
+                        else state := NONEMPTY (1, q')
+            val () = S.atomicEnd ()
+         in
+            msg
+         end
 
       fun recv (MB state) = 
-	 let
-	    val () = Assert.assertNonAtomic' "Mailbox.recv"
-	    val () = debug' "Mailbox.recv(1)" (* NonAtomic *)
-	    val () = Assert.assertNonAtomic' "Mailbox.recv(1)"
-	    val () = S.atomicBegin ()
-	    val () = debug' "Mailbox.recv(2)" (* Atomic 1 *)
-	    val () = Assert.assertAtomic' ("Mailbox.recv(2)", SOME 1)
-	    val msg =
-	       case !state of 
-		  EMPTY q => 
-		     let
-			val msg = 
-			   S.atomicSwitchToNext
-			   (fn t => state := EMPTY (Q.enque (q, (TransID.mkTxId (), t))))
-		     in
-			S.atomicEnd()
-			; msg
-		     end
-		| NONEMPTY (_, q) => getMsg (state, q)
-	    val () = debug' "Mailbox.recv(4)" (* NonAtomic *)
-	    val () = Assert.assertNonAtomic' "Channel.recv(4)"
-	 in
-	    msg
-	 end
+         let
+            val () = Assert.assertNonAtomic' "Mailbox.recv"
+            val () = debug' "Mailbox.recv(1)" (* NonAtomic *)
+            val () = Assert.assertNonAtomic' "Mailbox.recv(1)"
+            val () = S.atomicBegin ()
+            val () = debug' "Mailbox.recv(2)" (* Atomic 1 *)
+            val () = Assert.assertAtomic' ("Mailbox.recv(2)", SOME 1)
+            val msg =
+               case !state of 
+                  EMPTY q => 
+                     let
+                        val msg = 
+                           S.atomicSwitchToNext
+                           (fn t => state := EMPTY (Q.enque (q, (TransID.mkTxId (), t))))
+                     in
+                        S.atomicEnd()
+                        ; msg
+                     end
+                | NONEMPTY (_, q) => getMsg (state, q)
+            val () = debug' "Mailbox.recv(4)" (* NonAtomic *)
+            val () = Assert.assertNonAtomic' "Channel.recv(4)"
+         in
+            msg
+         end
 
       fun recvEvt (MB state) = 
-	 let
-	    fun blockFn {transId, cleanUp, next} = 
-	       let
-		  val q = 
-		     case !state of
-			EMPTY q => q
-		      | _ => raise Fail "Mailbox:recvEvt:blockFn"
-		  val msg = 
-		     S.atomicSwitch
-		     (fn t => (state := EMPTY (Q.enque (q, (transId, t)))
-			       ; next ()))
-	       in
-		  cleanUp()
-		  ; S.atomicEnd()
-		  ; msg
-	       end
-	    fun pollFn () = 
-	       case !state of
-		  EMPTY _ => E.blocked blockFn
-		| NONEMPTY (prio, q) => 
-		     (state := NONEMPTY (prio + 1, q)
-		      ; E.enabled {prio = prio, 
-				   doitFn = fn () => getMsg (state, q)})
-	 in
-	    E.bevt pollFn
-	 end
+         let
+            fun blockFn {transId, cleanUp: unit -> unit, next} = 
+               let
+                  val q = 
+                     case !state of
+                        EMPTY q => q
+                      | _ => raise Fail "Mailbox:recvEvt:blockFn"
+                  val msg = 
+                     S.atomicSwitch
+                     (fn t => (state := EMPTY (Q.enque (q, (transId, t)))
+                               ; next ()))
+               in
+                  cleanUp()
+                  ; S.atomicEnd()
+                  ; msg
+               end
+            fun pollFn () = 
+               case !state of
+                  EMPTY _ => E.blocked blockFn
+                | NONEMPTY (prio, q) => 
+                     (state := NONEMPTY (prio + 1, q)
+                      ; E.enabled {prio = prio, 
+                                   doitFn = fn () => getMsg (state, q)})
+         in
+            E.bevt pollFn
+         end
 
       fun recvPoll (MB state) = 
-	 (S.atomicBegin()
-	  ; case !state of
-	       EMPTY _ => (S.atomicEnd(); NONE)
-	     | NONEMPTY (_, q) => SOME (getMsg (state, q)))
+         (S.atomicBegin()
+          ; case !state of
+               EMPTY _ => (S.atomicEnd(); NONE)
+             | NONEMPTY (_, q) => SOME (getMsg (state, q)))
   end

Modified: mlton/branches/on-20050420-cmm-branch/lib/cml/core-cml/rep-types.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/cml/core-cml/rep-types.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/cml/core-cml/rep-types.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -17,33 +17,33 @@
       (** transaction IDs -- see trans-id.sml *)
       datatype trans_id = TXID of trans_id_state ref
       and trans_id_state =
-	 CANCEL
+         CANCEL
        | TRANS
 
       (** condition variables --- see cvar.sml and events.sml *)
       datatype cvar = CVAR of cvar_state ref
       and cvar_state =
-	 CVAR_unset of {transId : trans_id,
-			cleanUp : unit -> unit,
-			thread : rdy_thread} list
+         CVAR_unset of {transId : trans_id,
+                        cleanUp : unit -> unit,
+                        thread : rdy_thread} list
        | CVAR_set of int
 
       (** thread IDs --- see thread-id.sml and threads.sml **)
       and thread_id = 
-	 TID of {
-		 (* an unique ID *)
-		 id : int,
-		 (* true, if there is a pending alert on this thread *)
-		 alert : bool ref,
-		 (* set this whenever this thread does some concurrency operation. *)
-		 done_comm : bool ref,
-		 (* root-level exception handler hook *)
-		 exnHandler : (exn -> unit) ref, 
-		 (* holds thread-local properties *)
-		 props : exn list ref,
-		 (* the cvar that becomes set when the thread dies *)
-		 dead : cvar
-		 }
+         TID of {
+                 (* an unique ID *)
+                 id : int,
+                 (* true, if there is a pending alert on this thread *)
+                 alert : bool ref,
+                 (* set this whenever this thread does some concurrency operation. *)
+                 done_comm : bool ref,
+                 (* root-level exception handler hook *)
+                 exnHandler : (exn -> unit) ref, 
+                 (* holds thread-local properties *)
+                 props : exn list ref,
+                 (* the cvar that becomes set when the thread dies *)
+                 dead : cvar
+                 }
 
       (** threads --- see scheduler.sml and threads.sml **)
       and 'a thread = THRD of thread_id * 'a MLton.Thread.t
@@ -51,13 +51,13 @@
 
       (** events --- see events.sml **)
       datatype 'a status =
-	 ENABLED of {prio : int, doitFn : unit -> 'a}
+         ENABLED of {prio : int, doitFn : unit -> 'a}
        | BLOCKED of {transId : trans_id,
-		     cleanUp : unit -> unit,
-		     next : unit -> rdy_thread} -> 'a
+                     cleanUp : unit -> unit,
+                     next : unit -> rdy_thread} -> 'a
       type 'a base = unit -> 'a status 
       datatype 'a event =
-	 BEVT of 'a base list
+         BEVT of 'a base list
        | CHOOSE of 'a event list
        | GUARD of unit -> 'a event
        | WNACK of unit event -> 'a event

Modified: mlton/branches/on-20050420-cmm-branch/lib/cml/core-cml/run-cml.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/cml/core-cml/run-cml.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/cml/core-cml/run-cml.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -24,52 +24,52 @@
 
 
       local
-	 structure Signal = MLton.Signal
-	 structure Itimer = MLton.Itimer
-	    
-	 fun getAlrmHandler () =
-	    Signal.getHandler Posix.Signal.alrm
-	 fun setAlrmHandler h =
-	    Signal.setHandler (Posix.Signal.alrm, h)
+         structure Signal = MLton.Signal
+         structure Itimer = MLton.Itimer
+            
+         fun getAlrmHandler () =
+            Signal.getHandler Posix.Signal.alrm
+         fun setAlrmHandler h =
+            Signal.setHandler (Posix.Signal.alrm, h)
 
-	 fun setItimer t =
-	    Itimer.set (Itimer.Real, {value = t, interval = t})
+         fun setItimer t =
+            Itimer.set (Itimer.Real, {value = t, interval = t})
       in
-	 fun prepareAlrmHandler tq =
-	    let
-	       val origAlrmHandler = getAlrmHandler ()
-	       val tq = 
-		  case tq of 
-		     SOME tq => tq
-		   | NONE => Time.fromMilliseconds 20
-	    in
-	       (fn alrmHandler =>
-		(setAlrmHandler (Signal.Handler.handler (S.unwrap alrmHandler))
-		 ; setItimer tq),
-		fn () =>
-		(setItimer Time.zeroTime
-		 ; setAlrmHandler origAlrmHandler))
-	    end
+         fun prepareAlrmHandler tq =
+            let
+               val origAlrmHandler = getAlrmHandler ()
+               val tq = 
+                  case tq of 
+                     SOME tq => tq
+                   | NONE => Time.fromMilliseconds 20
+            in
+               (fn alrmHandler =>
+                (setAlrmHandler (Signal.Handler.handler (S.unwrap alrmHandler))
+                 ; setItimer tq),
+                fn () =>
+                (setItimer Time.zeroTime
+                 ; setAlrmHandler origAlrmHandler))
+            end
       end
 
       fun isRunning () = !R.isRunning
 
       fun reset running =
-	 (S.reset running
-	  ; SH.reset ()
-	  ; TID.reset ()
-	  ; TO.reset ())
+         (S.reset running
+          ; SH.reset ()
+          ; TID.reset ()
+          ; TO.reset ())
 
       fun alrmHandler thrd =
-	 let 
-	    val () = Assert.assertAtomic' ("RunCML.alrmHandler", NONE)
-	    val () = debug' "alrmHandler" (* Atomic 1 *)
-	    val () = Assert.assertAtomic' ("RunCML.alrmHandler", SOME 1)
-	    val () = S.preempt thrd
-	    val () = ignore (TO.preempt ())
-	 in 
-	    S.next ()
-	 end
+         let 
+            val () = Assert.assertAtomic' ("RunCML.alrmHandler", NONE)
+            val () = debug' "alrmHandler" (* Atomic 1 *)
+            val () = Assert.assertAtomic' ("RunCML.alrmHandler", SOME 1)
+            val () = S.preempt thrd
+            val () = ignore (TO.preempt ())
+         in 
+            S.next ()
+         end
 
       (* Note that SH.pauseHook is only invoked by S.next
        * when there are no threads on the ready queue;
@@ -80,58 +80,58 @@
        * pauseHook is never run within alrmHandler.
        *)
       fun pauseHook () =
-	 let
-	    val () = Assert.assertAtomic' ("RunCML.pauseHook", NONE)
-	    val () = debug' "pauseHook" (* Atomic 1 *)
-	    val () = Assert.assertAtomic' ("RunCML.pauseHook", SOME 1)
-	    val to = TO.preempt ()
-	 in
-	    case to of
-	       NONE =>
-		  (* no waiting threads *) 
-		  S.prepFn (!SH.shutdownHook, fn () => (true, OS.Process.failure))
-	     | SOME NONE =>
-		  (* enqueued a waiting thread *)
-		  S.next ()
-	     | SOME (SOME t) => 
-		  (* a waiting thread will be ready in t time *)
-		  (if Time.toSeconds t <= 0
-		      then ()
-		      else S.doMasked (fn () => OS.Process.sleep t)
-		   ; pauseHook ())
-	 end
+         let
+            val () = Assert.assertAtomic' ("RunCML.pauseHook", NONE)
+            val () = debug' "pauseHook" (* Atomic 1 *)
+            val () = Assert.assertAtomic' ("RunCML.pauseHook", SOME 1)
+            val to = TO.preempt ()
+         in
+            case to of
+               NONE =>
+                  (* no waiting threads *) 
+                  S.prepFn (!SH.shutdownHook, fn () => (true, OS.Process.failure))
+             | SOME NONE =>
+                  (* enqueued a waiting thread *)
+                  S.next ()
+             | SOME (SOME t) => 
+                  (* a waiting thread will be ready in t time *)
+                  (if Time.toSeconds t <= 0
+                      then ()
+                      else S.doMasked (fn () => OS.Process.sleep t)
+                   ; pauseHook ())
+         end
 
       fun doit (initialProc: unit -> unit,
-		tq: Time.time option) =
-	 let
-	    val () =
-	       if isRunning ()
-		  then raise Fail "CML is running"
-		  else ()
-	    val (installAlrmHandler, restoreAlrmHandler) = prepareAlrmHandler tq
-	    val ((*cleanUp*)_, status) =
-	       S.switchToNext
-	       (fn thrd => 
-		let
-		   val () = R.isRunning := true	
-		   val () = reset true
-		   val () = SH.shutdownHook := S.prepend (thrd, fn arg => (S.atomicBegin (); arg))
-		   val () = SH.pauseHook := pauseHook
-		   val () = installAlrmHandler alrmHandler
-		   val () = ignore (Thread.spawn initialProc)
-		in
-		   ()
-		end)
-	    val () = restoreAlrmHandler ()
-	    val () = reset false
-	    val () = R.isRunning := false
-	    val () = S.atomicEnd ()
-	 in
-	    status
-	 end
+                tq: Time.time option) =
+         let
+            val () =
+               if isRunning ()
+                  then raise Fail "CML is running"
+                  else ()
+            val (installAlrmHandler, restoreAlrmHandler) = prepareAlrmHandler tq
+            val ((*cleanUp*)_, status) =
+               S.switchToNext
+               (fn thrd => 
+                let
+                   val () = R.isRunning := true 
+                   val () = reset true
+                   val () = SH.shutdownHook := S.prepend (thrd, fn arg => (S.atomicBegin (); arg))
+                   val () = SH.pauseHook := pauseHook
+                   val () = installAlrmHandler alrmHandler
+                   val () = ignore (Thread.spawn initialProc)
+                in
+                   ()
+                end)
+            val () = restoreAlrmHandler ()
+            val () = reset false
+            val () = R.isRunning := false
+            val () = S.atomicEnd ()
+         in
+            status
+         end
 
       fun shutdown status =
-	 if isRunning ()
-	    then S.switch (fn _ => S.prepVal (!SH.shutdownHook, (true, status)))
-	    else raise Fail "CML is not running"
+         if isRunning ()
+            then S.switch (fn _ => S.prepVal (!SH.shutdownHook, (true, status)))
+            else raise Fail "CML is not running"
    end

Modified: mlton/branches/on-20050420-cmm-branch/lib/cml/core-cml/scheduler-hooks.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/cml/core-cml/scheduler-hooks.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/cml/core-cml/scheduler-hooks.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -15,16 +15,16 @@
       type rdy_thread = RepTypes.rdy_thread
 
       val pauseHookDefault : unit -> rdy_thread =
-	 fn _ => raise Fail "SchedulerHooks.pauseHook"
+         fn _ => raise Fail "SchedulerHooks.pauseHook"
       val pauseHook = ref pauseHookDefault
 
       val shutdownHookDefault : (bool * OS.Process.status) thread =
-	 THRD (ThreadID.bogus "shutdownHook", MLton.Thread.new (fn _ =>
-	       raise Fail "SchedulerHooks.shutdownHook"))
+         THRD (ThreadID.bogus "shutdownHook", MLton.Thread.new (fn _ =>
+               raise Fail "SchedulerHooks.shutdownHook"))
       val shutdownHook = ref shutdownHookDefault
 
       fun reset () =
-	 (pauseHook := pauseHookDefault
-	  ; shutdownHook := shutdownHookDefault
-	  ; ())
+         (pauseHook := pauseHookDefault
+          ; shutdownHook := shutdownHookDefault
+          ; ())
    end

Modified: mlton/branches/on-20050420-cmm-branch/lib/cml/core-cml/scheduler.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/cml/core-cml/scheduler.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/cml/core-cml/scheduler.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -43,27 +43,27 @@
        *)
       val errorTid = TID.bogus "error"
       fun errorThrd () : unit thread =
-	 THRD (errorTid, T.new (fn () =>
-	       (GlobalDebug.sayDebug 
-		([fn () => "CML"], fn () => "**** Use RunCML.doit to run CML ****")
-		; raise Fail "CML not initialized")))
+         THRD (errorTid, T.new (fn () =>
+               (GlobalDebug.sayDebug 
+                ([fn () => "CML"], fn () => "**** Use RunCML.doit to run CML ****")
+                ; raise Fail "CML not initialized")))
 
       local
-	 val curTid : thread_id ref = ref dummyTid
+         val curTid : thread_id ref = ref dummyTid
       in
-	 fun getThreadId (THRD (tid, _)) = tid
-	 fun getCurThreadId () = 
-	    let
-	       val tid = !curTid
-	    in
-	       tid
-	    end
-	 fun setCurThreadId tid = 
-	    let
-	       val () = Assert.assertAtomic' ("Scheduler.setCurThreadId", NONE)
-	    in 
-	       curTid := tid
-	    end
+         fun getThreadId (THRD (tid, _)) = tid
+         fun getCurThreadId () = 
+            let
+               val tid = !curTid
+            in
+               tid
+            end
+         fun setCurThreadId tid = 
+            let
+               val () = Assert.assertAtomic' ("Scheduler.setCurThreadId", NONE)
+            in 
+               curTid := tid
+            end
       end
       fun tidMsg () = TID.tidToString (getCurThreadId ())
       fun debug msg = Debug.sayDebug ([atomicMsg, tidMsg], msg)
@@ -77,130 +77,130 @@
 
       (* enqueue a thread in the primary queue *)
       fun enque1 thrd =
-	 (Assert.assertAtomic' ("Scheduler.enque1", NONE)
-	  ; Q.enque (rdyQ1, thrd))
+         (Assert.assertAtomic' ("Scheduler.enque1", NONE)
+          ; Q.enque (rdyQ1, thrd))
       (* enqueue a thread in the secondary queue *)
       fun enque2 thrd =
-	 (Assert.assertAtomic' ("Scheduler.enque2", NONE)
-	  ; Q.enque (rdyQ2, thrd))
+         (Assert.assertAtomic' ("Scheduler.enque2", NONE)
+          ; Q.enque (rdyQ2, thrd))
       (* dequeue a thread from the primary queue *)
       fun deque1 () =
-	 (Assert.assertAtomic' ("Scheduler.deque1", NONE)
-	  ; case Q.deque rdyQ1 of
-	       NONE => deque2 ()
-	     | SOME thrd => SOME thrd)
+         (Assert.assertAtomic' ("Scheduler.deque1", NONE)
+          ; case Q.deque rdyQ1 of
+               NONE => deque2 ()
+             | SOME thrd => SOME thrd)
       (* dequeue a thread from the secondary queue *)
       and deque2 () =
-	 (Assert.assertAtomic' ("Scheduler.deque2", NONE)
-	  ; case Q.deque rdyQ2 of
-	       NONE => NONE
-	     | SOME thrd => SOME thrd)
+         (Assert.assertAtomic' ("Scheduler.deque2", NONE)
+          ; case Q.deque rdyQ2 of
+               NONE => NONE
+             | SOME thrd => SOME thrd)
       (* promote a thread from the secondary queue to the primary queue *)
       fun promote () =
-	 (Assert.assertAtomic' ("Scheduler.promote", NONE)
-	  ; case deque2 () of
-	       NONE => ()
-	     | SOME thrd => enque1 thrd)
+         (Assert.assertAtomic' ("Scheduler.promote", NONE)
+          ; case deque2 () of
+               NONE => ()
+             | SOME thrd => enque1 thrd)
 
       fun next () =
-	 let
-	    val () = Assert.assertAtomic' ("Scheduler.next", NONE)
-	    val thrd =
-	       case deque1 () of
-		  NONE => !SH.pauseHook ()
-		| SOME thrd => thrd
-	 in
-	    thrd
-	 end
+         let
+            val () = Assert.assertAtomic' ("Scheduler.next", NONE)
+            val thrd =
+               case deque1 () of
+                  NONE => !SH.pauseHook ()
+                | SOME thrd => thrd
+         in
+            thrd
+         end
       fun ready thrd = 
-	 let
-	    val () = Assert.assertAtomic' ("Scheduler.ready", NONE)
-	    val () = enque1 thrd
-	 in
-	    ()
-	 end
+         let
+            val () = Assert.assertAtomic' ("Scheduler.ready", NONE)
+            val () = enque1 thrd
+         in
+            ()
+         end
       local
-	 fun atomicSwitchAux msg f = 
-	    (Assert.assertAtomic (fn () => "Scheduler." ^ msg, NONE)
-	     ; T.atomicSwitch (fn t => 
-			       let
-				  val tid = getCurThreadId ()
-				  val () = TID.mark tid
-				  val RTHRD (tid',t') = f (THRD (tid, t))
-				  val () = setCurThreadId tid'
-			       in 
-				  t'
-			       end))
+         fun atomicSwitchAux msg f = 
+            (Assert.assertAtomic (fn () => "Scheduler." ^ msg, NONE)
+             ; T.atomicSwitch (fn t => 
+                               let
+                                  val tid = getCurThreadId ()
+                                  val () = TID.mark tid
+                                  val RTHRD (tid',t') = f (THRD (tid, t))
+                                  val () = setCurThreadId tid'
+                               in 
+                                  t'
+                               end))
       in
-	 fun atomicSwitch f =
-	    atomicSwitchAux "atomicSwitch" f
-	 fun switch f =
-	    (atomicBegin (); atomicSwitch f)
-	 fun atomicSwitchToNext f =
-	    atomicSwitchAux "atomicSwitchToNext" (fn thrd => (f thrd; next ()))
-	 fun switchToNext f =
-	    (atomicBegin (); atomicSwitchToNext f)
-	 fun atomicReadyAndSwitch f =
-	    atomicSwitchAux "atomicReadyAndSwitch" (fn thrd => (ready (prep thrd); f ()))
-	 fun readyAndSwitch f =
-	    (atomicBegin (); atomicReadyAndSwitch f)
-	 fun atomicReadyAndSwitchToNext f =
-	    atomicSwitchAux "atomicReadyAndSwitchToNext" (fn thrd => (ready (prep thrd); f (); next ()))
-	 fun readyAndSwitchToNext f =
-	    (atomicBegin (); atomicReadyAndSwitchToNext f)
+         fun atomicSwitch (f: 'a thread -> rdy_thread) =
+            atomicSwitchAux "atomicSwitch" f
+         fun switch (f: 'a thread -> rdy_thread) =
+            (atomicBegin (); atomicSwitch f)
+         fun atomicSwitchToNext (f: 'a thread -> unit) =
+            atomicSwitchAux "atomicSwitchToNext" (fn thrd => (f thrd; next ()))
+         fun switchToNext (f: 'a thread -> unit) =
+            (atomicBegin (); atomicSwitchToNext f)
+         fun atomicReadyAndSwitch (f: unit -> rdy_thread) =
+            atomicSwitchAux "atomicReadyAndSwitch" (fn thrd => (ready (prep thrd); f ()))
+         fun readyAndSwitch (f: unit -> rdy_thread) =
+            (atomicBegin (); atomicReadyAndSwitch f)
+         fun atomicReadyAndSwitchToNext (f: unit -> unit) =
+            atomicSwitchAux "atomicReadyAndSwitchToNext" (fn thrd => (ready (prep thrd); f (); next ()))
+         fun readyAndSwitchToNext (f: unit -> unit) =
+            (atomicBegin (); atomicReadyAndSwitchToNext f)
       end
 
       fun new (f : thread_id -> ('a -> unit)) : 'a thread =
-	 let
-	    val () = Assert.assertAtomic' ("Scheduler.new", NONE)
-	    val tid = TID.new ()
-	    val t = T.new (f tid)
-	 in
-	    THRD (tid, t)
-	 end
+         let
+            val () = Assert.assertAtomic' ("Scheduler.new", NONE)
+            val tid = TID.new ()
+            val t = T.new (f tid)
+         in
+            THRD (tid, t)
+         end
 
       fun prepend (thrd : 'a thread, f : 'b -> 'a) : 'b thread =
-	 let
-	    val () = Assert.assertAtomic' ("Scheduler.prepend", NONE)
-	    val THRD (tid, t) = thrd
-	    val t = T.prepend (t, f)
-	 in
-	    THRD (tid, t)
-	 end
+         let
+            val () = Assert.assertAtomic' ("Scheduler.prepend", NONE)
+            val THRD (tid, t) = thrd
+            val t = T.prepend (t, f)
+         in
+            THRD (tid, t)
+         end
 
       fun unwrap (f : rdy_thread -> rdy_thread) (t: T.Runnable.t) : T.Runnable.t =
-	 let
-	    val () = Assert.assertAtomic' ("Scheduler.unwrap", NONE)
-	    val tid = getCurThreadId ()
-	    val RTHRD (tid', t') = f (RTHRD (tid, t))
-	    val () = setCurThreadId tid'
-	 in
-	    t'
-	 end
+         let
+            val () = Assert.assertAtomic' ("Scheduler.unwrap", NONE)
+            val tid = getCurThreadId ()
+            val RTHRD (tid', t') = f (RTHRD (tid, t))
+            val () = setCurThreadId tid'
+         in
+            t'
+         end
 
 
       (* reset various pieces of state *)
       fun reset running = 
-	 (atomicBegin ()
-	  ; setCurThreadId dummyTid
-	  ; Q.reset rdyQ1; Q.reset rdyQ2
-	  ; if not running then ready (prep (errorThrd ())) else ()
-	  ; atomicEnd ())
+         (atomicBegin ()
+          ; setCurThreadId dummyTid
+          ; Q.reset rdyQ1; Q.reset rdyQ2
+          ; if not running then ready (prep (errorThrd ())) else ()
+          ; atomicEnd ())
       (* what to do at a preemption (with the current thread) *)
       fun preempt (thrd as RTHRD (tid, _)) =
-	 let
-	    val () = Assert.assertAtomic' ("Scheduler.preempt", NONE)
-	    val () = debug' "Scheduler.preempt" (* Atomic 1 *)
-	    val () = Assert.assertAtomic' ("Scheduler.preempt", SOME 1)
-	    val () =
-	       if TID.isMarked tid
-		  then (TID.unmark tid
-			; promote ()
-			; enque1 thrd)
-		  else enque2 thrd
-	 in
-	    ()
-	 end
+         let
+            val () = Assert.assertAtomic' ("Scheduler.preempt", NONE)
+            val () = debug' "Scheduler.preempt" (* Atomic 1 *)
+            val () = Assert.assertAtomic' ("Scheduler.preempt", SOME 1)
+            val () =
+               if TID.isMarked tid
+                  then (TID.unmark tid
+                        ; promote ()
+                        ; enque1 thrd)
+                  else enque2 thrd
+         in
+            ()
+         end
 
       val _ = reset false
    end

Modified: mlton/branches/on-20050420-cmm-branch/lib/cml/core-cml/sync-var.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/cml/core-cml/sync-var.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/cml/core-cml/sync-var.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -17,7 +17,7 @@
       
       type 'a ivar  (* I-structure variable *)
       type 'a mvar  (* M-structure variable *)
-	 
+         
       exception Put (* raised on put operations to full cells *)
       
       val iVar     : unit -> 'a ivar
@@ -26,7 +26,7 @@
       val iGetEvt  : 'a ivar -> 'a CML.event
       val iGetPoll : 'a ivar -> 'a option
       val sameIVar : ('a ivar * 'a ivar) -> bool
-	 
+         
       val mVar      : unit -> 'a mvar
       val mVarInit  : 'a -> 'a mvar
       val mPut      : ('a mvar * 'a) -> unit

Modified: mlton/branches/on-20050420-cmm-branch/lib/cml/core-cml/sync-var.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/cml/core-cml/sync-var.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/cml/core-cml/sync-var.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -15,21 +15,21 @@
    struct
       structure Assert = LocalAssert(val assert = false)
       structure Debug = LocalDebug(val debug = false)
-	 
+         
       structure Q = ImpQueue
       structure S = Scheduler
       structure E = Event
       fun debug msg = Debug.sayDebug ([S.atomicMsg, S.tidMsg], msg)
-	 
+         
       datatype trans_id = datatype TransID.trans_id
       datatype trans_id_state = datatype TransID.trans_id_state
 
 
       (* the underlying representation of both ivars and mvars is the same. *)
       datatype 'a cell = 
-	 CELL of {prio  : int ref,
-		  readQ : (trans_id * 'a S.thread) Q.t,
-		  value : 'a option ref}
+         CELL of {prio  : int ref,
+                  readQ : (trans_id * 'a S.thread) Q.t,
+                  value : 'a option ref}
 
       type 'a ivar = 'a cell
       type 'a mvar = 'a cell
@@ -40,20 +40,20 @@
 
       (* sameCell : ('a cell * 'a cell) -> bool *)
       fun sameCell (CELL {prio = prio1, ...}, CELL {prio = prio2, ...}) =
-	 prio1 = prio2
+         prio1 = prio2
 
       (* bump a priority value by one, returning the old value *)
       fun bumpPriority (p as ref n) = (p := n+1; n)
 
       (* functions to clean channel input and output queues *)
       local
-	 fun cleaner (TXID txst, _) = 
-	    case !txst of CANCEL => true | _ => false
+         fun cleaner (TXID txst, _) = 
+            case !txst of CANCEL => true | _ => false
       in
-	 fun cleanAndDeque q =
-	    Q.cleanAndDeque (q, cleaner)
-	 fun enqueAndClean (q, item) =
-	    Q.enqueAndClean (q, item, cleaner)
+         fun cleanAndDeque q =
+            Q.cleanAndDeque (q, cleaner)
+         fun enqueAndClean (q, item) =
+            Q.enqueAndClean (q, item, cleaner)
       end
 
       (* When a thread is resumed after being blocked on an iGet or mGet operation,
@@ -66,13 +66,13 @@
        * choice of multiple gets on the same variable.
        *)
       fun relayMsg (readQ, msg) = 
-	 case (cleanAndDeque readQ) of
-	    NONE => S.atomicEnd()
-	  | SOME (txid, t) => 
-	       S.readyAndSwitch
-	       (fn () =>
-		(TransID.force txid
-		 ; S.prepVal (t, msg)))
+         case (cleanAndDeque readQ) of
+            NONE => S.atomicEnd()
+          | SOME (txid, t) => 
+               S.readyAndSwitch
+               (fn () =>
+                (TransID.force txid
+                 ; S.prepVal (t, msg)))
 
       (** G-variables **)
       (* Generalized synchronized variables,
@@ -80,201 +80,201 @@
        *)
 
       fun gPut (name, CELL {prio, readQ, value}, x) = 
-	 let
-	    val () = Assert.assertNonAtomic (fn () => concat ["SyncVar.", name])
-	    val () = debug (fn () => concat [name, "(1)"]) (* NonAtomic *)
-	    val () = Assert.assertNonAtomic (fn () => concat ["SyncVar.", name, "(1)"])
-	    val () = S.atomicBegin()
-	    val () = debug (fn () => concat [name, "(2)"]) (* Atomic 1 *)
-	    val () = Assert.assertAtomic (fn () => concat ["SyncVar.", name, "(2)"], SOME 1)
-	    val () = 
-	       case !value of
-		  NONE => 
-		     let
-			val () = debug (fn () => concat [name, "(3.1.1)"]) (* Atomic 1 *)
-			val () = Assert.assertAtomic (fn () => concat ["SyncVar.", name, "(3.1.1)"], SOME 1)
-			val () = value := SOME x
-			val () = 
-			   case cleanAndDeque readQ of
-			      NONE => S.atomicEnd ()
-			    | SOME (rtxid, rt) =>
-				 S.readyAndSwitch
-				 (fn () =>
-				  (prio := 1
-				   ; TransID.force rtxid
-				   ; S.prepVal (rt, x)))
-			val () = debug (fn () => concat [name, "(3.1.2)"]) (* NonAtomic *)
-			val () = Assert.assertNonAtomic (fn () => concat ["SyncVar.", name, "(3.1.2)"])
-		     in
-			()
-		     end
-		| SOME _ => 
-		     let
-			val () = debug (fn () => concat [name, "(3.2.1)"]) (* Atomic 1 *)
-			val () = Assert.assertAtomic (fn () => concat ["SyncVar.", name, "(3.2.1)"], SOME 1)
-			val () = S.atomicEnd ()
-			val () = debug (fn () => concat [name, "(3.2.2)"]) (* NonAtomic *)
-			val () = Assert.assertNonAtomic (fn () => concat ["SyncVar.", name, "(3.2.2)"])
-		     in 
-			raise Put
-		     end
-	    val () = debug (fn () => concat [name, "(4)"]) (* NonAtomic *)
-	    val () = Assert.assertNonAtomic (fn () => concat ["SyncVar.", name, "(4)"])
-	 in
-	    ()
-	 end
+         let
+            val () = Assert.assertNonAtomic (fn () => concat ["SyncVar.", name])
+            val () = debug (fn () => concat [name, "(1)"]) (* NonAtomic *)
+            val () = Assert.assertNonAtomic (fn () => concat ["SyncVar.", name, "(1)"])
+            val () = S.atomicBegin()
+            val () = debug (fn () => concat [name, "(2)"]) (* Atomic 1 *)
+            val () = Assert.assertAtomic (fn () => concat ["SyncVar.", name, "(2)"], SOME 1)
+            val () = 
+               case !value of
+                  NONE => 
+                     let
+                        val () = debug (fn () => concat [name, "(3.1.1)"]) (* Atomic 1 *)
+                        val () = Assert.assertAtomic (fn () => concat ["SyncVar.", name, "(3.1.1)"], SOME 1)
+                        val () = value := SOME x
+                        val () = 
+                           case cleanAndDeque readQ of
+                              NONE => S.atomicEnd ()
+                            | SOME (rtxid, rt) =>
+                                 S.readyAndSwitch
+                                 (fn () =>
+                                  (prio := 1
+                                   ; TransID.force rtxid
+                                   ; S.prepVal (rt, x)))
+                        val () = debug (fn () => concat [name, "(3.1.2)"]) (* NonAtomic *)
+                        val () = Assert.assertNonAtomic (fn () => concat ["SyncVar.", name, "(3.1.2)"])
+                     in
+                        ()
+                     end
+                | SOME _ => 
+                     let
+                        val () = debug (fn () => concat [name, "(3.2.1)"]) (* Atomic 1 *)
+                        val () = Assert.assertAtomic (fn () => concat ["SyncVar.", name, "(3.2.1)"], SOME 1)
+                        val () = S.atomicEnd ()
+                        val () = debug (fn () => concat [name, "(3.2.2)"]) (* NonAtomic *)
+                        val () = Assert.assertNonAtomic (fn () => concat ["SyncVar.", name, "(3.2.2)"])
+                     in 
+                        raise Put
+                     end
+            val () = debug (fn () => concat [name, "(4)"]) (* NonAtomic *)
+            val () = Assert.assertNonAtomic (fn () => concat ["SyncVar.", name, "(4)"])
+         in
+            ()
+         end
 
       (* Swap the current contents of the cell with a new value;
        * it is guaranteed to be atomic.
        *)
       fun gSwap (name, doSwap, CELL {prio, readQ, value}) = 
-	 let
-	    val () = Assert.assertNonAtomic (fn () => concat ["SyncVar.", name, ""])
-	    val () = debug (fn () => concat [name, "(1)"]) (* NonAtomic *)
-	    val () = Assert.assertNonAtomic (fn () => concat ["SyncVar.", name, "(1)"])
-	    val () = S.atomicBegin()
-	    val () = debug (fn () => concat [name, "(2)"]) (* Atomic 1 *)
-	    val () = Assert.assertAtomic (fn () => concat ["SyncVar.", name, "(2)"], SOME 1)
-	    val msg =
-	       case !value of
-		  NONE => 
-		     let
-			val () = debug (fn () => concat [name, "(3.2.1)"]) (* Atomic 1 *)
-			val () = Assert.assertAtomic (fn () => concat ["SyncVar.", name, "(3.2.1)"], SOME 1)
-			val msg = 
-			   S.atomicSwitchToNext
-			   (fn rt => enqueAndClean (readQ, (TransID.mkTxId (), rt)))
-			val () = debug (fn () => concat [name, "(3.2.2)"]) (* Atomic 1 *)
-			val () = Assert.assertAtomic (fn () => concat ["SyncVar.", name, "(3.2.2)"], SOME 1)
-			val () = doSwap value
-			val () = relayMsg (readQ, msg)
-			val () = debug (fn () => concat [name, "(3.2.3)"]) (* NonAtomic *)
-			val () = Assert.assertNonAtomic (fn () => concat ["SyncVar.", name, "(3.2.3)"])
-		     in
-			msg
-		     end
-		| SOME x => 
-		     let
-			val () = debug (fn () => concat [name, "(3.2.1)"]) (* Atomic 1 *)
-			val () = Assert.assertAtomic (fn () => concat ["SyncVar.", name, "(3.2.1)"], SOME 1)
-			val () = prio := 1
-			val () = doSwap value
-			val () = S.atomicEnd ()
-			val () = debug (fn () => concat [name, "(3.2.2)"]) (* NonAtomic *)
-			val () = Assert.assertNonAtomic (fn () => concat ["SyncVar.", name, "(3.2.2)"])
-		     in
-			x
-		     end
-	    val () = debug (fn () => concat [name, "(4)"]) (* NonAtomic *)
-	    val () = Assert.assertNonAtomic (fn () => concat ["SyncVar.", name, "(4)"])
-	 in
-	    msg
-	 end
+         let
+            val () = Assert.assertNonAtomic (fn () => concat ["SyncVar.", name, ""])
+            val () = debug (fn () => concat [name, "(1)"]) (* NonAtomic *)
+            val () = Assert.assertNonAtomic (fn () => concat ["SyncVar.", name, "(1)"])
+            val () = S.atomicBegin()
+            val () = debug (fn () => concat [name, "(2)"]) (* Atomic 1 *)
+            val () = Assert.assertAtomic (fn () => concat ["SyncVar.", name, "(2)"], SOME 1)
+            val msg =
+               case !value of
+                  NONE => 
+                     let
+                        val () = debug (fn () => concat [name, "(3.2.1)"]) (* Atomic 1 *)
+                        val () = Assert.assertAtomic (fn () => concat ["SyncVar.", name, "(3.2.1)"], SOME 1)
+                        val msg = 
+                           S.atomicSwitchToNext
+                           (fn rt => enqueAndClean (readQ, (TransID.mkTxId (), rt)))
+                        val () = debug (fn () => concat [name, "(3.2.2)"]) (* Atomic 1 *)
+                        val () = Assert.assertAtomic (fn () => concat ["SyncVar.", name, "(3.2.2)"], SOME 1)
+                        val () = doSwap value
+                        val () = relayMsg (readQ, msg)
+                        val () = debug (fn () => concat [name, "(3.2.3)"]) (* NonAtomic *)
+                        val () = Assert.assertNonAtomic (fn () => concat ["SyncVar.", name, "(3.2.3)"])
+                     in
+                        msg
+                     end
+                | SOME x => 
+                     let
+                        val () = debug (fn () => concat [name, "(3.2.1)"]) (* Atomic 1 *)
+                        val () = Assert.assertAtomic (fn () => concat ["SyncVar.", name, "(3.2.1)"], SOME 1)
+                        val () = prio := 1
+                        val () = doSwap value
+                        val () = S.atomicEnd ()
+                        val () = debug (fn () => concat [name, "(3.2.2)"]) (* NonAtomic *)
+                        val () = Assert.assertNonAtomic (fn () => concat ["SyncVar.", name, "(3.2.2)"])
+                     in
+                        x
+                     end
+            val () = debug (fn () => concat [name, "(4)"]) (* NonAtomic *)
+            val () = Assert.assertNonAtomic (fn () => concat ["SyncVar.", name, "(4)"])
+         in
+            msg
+         end
 
       fun gSwapEvt (name, doSwap, CELL{prio, readQ, value}) = 
-	 let
-	    fun doitFn () =
-	       let
-		  val () = Assert.assertAtomic (fn () => concat ["SyncVar.", name, ".doitFn"], NONE)
-		  val x = valOf (!value)
-		  val () = debug (fn () => concat [name, "(3.2.1)"]) (* Atomic 1 *)
-		  val () = Assert.assertAtomic (fn () => concat ["SyncVar.", name, "(3.2.1)"], SOME 1)
-		  val () = prio := 1
-		  val () = doSwap value
-		  val () = S.atomicEnd ()
-		  val () = debug (fn () => concat [name, "(3.2.2)"]) (* NonAtomic *)
-		  val () = Assert.assertNonAtomic (fn () => concat ["SyncVar.", name, "(3.2.2)"])
-	       in
-		  x
-	       end
-	    fun blockFn {transId, cleanUp, next} = 
-	       let
-		  val () = Assert.assertAtomic (fn () => concat ["SyncVar.", name, ".blockFn"], NONE)
-		  val () = debug (fn () => concat [name, "(3.2.1)"]) (* Atomic 1 *)
-		  val () = Assert.assertAtomic (fn () => concat ["SyncVar.", name, "(3.2.1)"], SOME 1)
-		  val msg = 
-		     S.atomicSwitch
-		     (fn rt =>
-		      (enqueAndClean (readQ, (transId, rt))
-		       ; next ()))
-		  val () = debug (fn () => concat [name, "(3.2.2)"]) (* Atomic 1 *)
-		  val () = Assert.assertAtomic (fn () => concat ["SyncVar.", name, "(3.2.2)"], SOME 1)
-		  val () = cleanUp ()
-		  val () = doSwap value
-		  val () = relayMsg (readQ, msg)
-		  val () = debug (fn () => concat [name, "(3.2.3)"]) (* NonAtomic *)
-		  val () = Assert.assertNonAtomic (fn () => concat ["SyncVar.", name, "(3.2.3)"])
-	       in
-		  msg
-	       end
-	    fun pollFn () =
-	       let
-		  val () = Assert.assertAtomic (fn () => concat ["SyncVar.", name, ".pollFn"], NONE)
-		  val () = debug (fn () => concat [name, "(2)"]) (* Atomic 1 *)
-		  val () = Assert.assertAtomic (fn () => concat ["SyncVar.", name, "(2)"], SOME 1)
-	       in
-		  case !value of
-		     NONE => E.blocked blockFn
-		   | SOME _ => E.enabled {prio = bumpPriority prio,
-					  doitFn = doitFn}
-	       end
-	 in
-	    E.bevt pollFn
-	 end
+         let
+            fun doitFn () =
+               let
+                  val () = Assert.assertAtomic (fn () => concat ["SyncVar.", name, ".doitFn"], NONE)
+                  val x = valOf (!value)
+                  val () = debug (fn () => concat [name, "(3.2.1)"]) (* Atomic 1 *)
+                  val () = Assert.assertAtomic (fn () => concat ["SyncVar.", name, "(3.2.1)"], SOME 1)
+                  val () = prio := 1
+                  val () = doSwap value
+                  val () = S.atomicEnd ()
+                  val () = debug (fn () => concat [name, "(3.2.2)"]) (* NonAtomic *)
+                  val () = Assert.assertNonAtomic (fn () => concat ["SyncVar.", name, "(3.2.2)"])
+               in
+                  x
+               end
+            fun blockFn {transId, cleanUp, next} = 
+               let
+                  val () = Assert.assertAtomic (fn () => concat ["SyncVar.", name, ".blockFn"], NONE)
+                  val () = debug (fn () => concat [name, "(3.2.1)"]) (* Atomic 1 *)
+                  val () = Assert.assertAtomic (fn () => concat ["SyncVar.", name, "(3.2.1)"], SOME 1)
+                  val msg = 
+                     S.atomicSwitch
+                     (fn rt =>
+                      (enqueAndClean (readQ, (transId, rt))
+                       ; next ()))
+                  val () = debug (fn () => concat [name, "(3.2.2)"]) (* Atomic 1 *)
+                  val () = Assert.assertAtomic (fn () => concat ["SyncVar.", name, "(3.2.2)"], SOME 1)
+                  val () = cleanUp ()
+                  val () = doSwap value
+                  val () = relayMsg (readQ, msg)
+                  val () = debug (fn () => concat [name, "(3.2.3)"]) (* NonAtomic *)
+                  val () = Assert.assertNonAtomic (fn () => concat ["SyncVar.", name, "(3.2.3)"])
+               in
+                  msg
+               end
+            fun pollFn () =
+               let
+                  val () = Assert.assertAtomic (fn () => concat ["SyncVar.", name, ".pollFn"], NONE)
+                  val () = debug (fn () => concat [name, "(2)"]) (* Atomic 1 *)
+                  val () = Assert.assertAtomic (fn () => concat ["SyncVar.", name, "(2)"], SOME 1)
+               in
+                  case !value of
+                     NONE => E.blocked blockFn
+                   | SOME _ => E.enabled {prio = bumpPriority prio,
+                                          doitFn = doitFn}
+               end
+         in
+            E.bevt pollFn
+         end
 
       fun gSwapPoll (name, doSwap, CELL{prio, value, ...}) = 
-	 let
-	    val () = Assert.assertNonAtomic (fn () => concat ["SyncVar.", name, ""])
-	    val () = debug (fn () => concat [name, "(1)"]) (* NonAtomic *)
-	    val () = Assert.assertNonAtomic (fn () => concat ["SyncVar.", name, "(1)"])
-	    val () = S.atomicBegin()
-	    val () = debug (fn () => concat [name, "(2)"]) (* Atomic 1 *)
-	    val () = Assert.assertAtomic (fn () => concat ["SyncVar.", name, "(2)"], SOME 1)
-	    val msg =
-	       case !value of
-		  NONE => 
-		     let
-			val () = debug (fn () => concat [name, "(3.2.1)"]) (* Atomic 1 *)
-			val () = Assert.assertAtomic (fn () => concat ["SyncVar.", name, "(3.2.1)"], SOME 1)
-			val msg = NONE
-			val () = debug (fn () => concat [name, "(3.2.2)"]) (* Atomic 1 *)
-			val () = Assert.assertAtomic (fn () => concat ["SyncVar.", name, "(3.2.2)"], SOME 1)
-			val () = S.atomicEnd ()
-			val () = debug (fn () => concat [name, "(3.2.3)"]) (* NonAtomic *)
-			val () = Assert.assertNonAtomic (fn () => concat ["SyncVar.", name, "(3.2.3)"])
-		     in
-			msg
-		     end
-		| SOME x => 
-		     let
-			val () = debug (fn () => concat [name, "(3.2.1)"]) (* Atomic 1 *)
-			val () = Assert.assertAtomic (fn () => concat ["SyncVar.", name, "(3.2.1)"], SOME 1)
-			val () = prio := 1
-			val () = doSwap value
-			val () = S.atomicEnd ()
-			val () = debug (fn () => concat [name, "(3.2.2)"]) (* NonAtomic *)
-			val () = Assert.assertNonAtomic (fn () => concat ["SyncVar.", name, "(3.2.2)"])
-		     in
-			SOME x
-		     end
-	    val () = debug (fn () => concat [name, "(4)"]) (* NonAtomic *)
-	    val () = Assert.assertNonAtomic (fn () => concat ["SyncVar.", name, "(4)"])
-	 in
-	    msg
-	 end
+         let
+            val () = Assert.assertNonAtomic (fn () => concat ["SyncVar.", name, ""])
+            val () = debug (fn () => concat [name, "(1)"]) (* NonAtomic *)
+            val () = Assert.assertNonAtomic (fn () => concat ["SyncVar.", name, "(1)"])
+            val () = S.atomicBegin()
+            val () = debug (fn () => concat [name, "(2)"]) (* Atomic 1 *)
+            val () = Assert.assertAtomic (fn () => concat ["SyncVar.", name, "(2)"], SOME 1)
+            val msg =
+               case !value of
+                  NONE => 
+                     let
+                        val () = debug (fn () => concat [name, "(3.2.1)"]) (* Atomic 1 *)
+                        val () = Assert.assertAtomic (fn () => concat ["SyncVar.", name, "(3.2.1)"], SOME 1)
+                        val msg = NONE
+                        val () = debug (fn () => concat [name, "(3.2.2)"]) (* Atomic 1 *)
+                        val () = Assert.assertAtomic (fn () => concat ["SyncVar.", name, "(3.2.2)"], SOME 1)
+                        val () = S.atomicEnd ()
+                        val () = debug (fn () => concat [name, "(3.2.3)"]) (* NonAtomic *)
+                        val () = Assert.assertNonAtomic (fn () => concat ["SyncVar.", name, "(3.2.3)"])
+                     in
+                        msg
+                     end
+                | SOME x => 
+                     let
+                        val () = debug (fn () => concat [name, "(3.2.1)"]) (* Atomic 1 *)
+                        val () = Assert.assertAtomic (fn () => concat ["SyncVar.", name, "(3.2.1)"], SOME 1)
+                        val () = prio := 1
+                        val () = doSwap value
+                        val () = S.atomicEnd ()
+                        val () = debug (fn () => concat [name, "(3.2.2)"]) (* NonAtomic *)
+                        val () = Assert.assertNonAtomic (fn () => concat ["SyncVar.", name, "(3.2.2)"])
+                     in
+                        SOME x
+                     end
+            val () = debug (fn () => concat [name, "(4)"]) (* NonAtomic *)
+            val () = Assert.assertNonAtomic (fn () => concat ["SyncVar.", name, "(4)"])
+         in
+            msg
+         end
 
 
       (** I-variables **)
 
       val iVar = newCell
       val sameIVar = sameCell
-	 
+         
       fun iPut (cell, x) = gPut ("iPut", cell, x)
       local fun doGetSwap _ = ()
       in
-	 fun iGet cell = gSwap ("iGet", doGetSwap, cell)
-	 fun iGetEvt cell = gSwapEvt ("iGetEvt", doGetSwap, cell)
-	 fun iGetPoll cell = gSwapPoll ("iGetPoll", doGetSwap, cell)
+         fun iGet cell = gSwap ("iGet", doGetSwap, cell)
+         fun iGetEvt cell = gSwapEvt ("iGetEvt", doGetSwap, cell)
+         fun iGetPoll cell = gSwapPoll ("iGetPoll", doGetSwap, cell)
       end
 
       (** M-variables **)
@@ -286,19 +286,19 @@
       fun mPut (cell, x) = gPut ("mPut", cell, x)
       local fun doTakeSwap value = value := NONE
       in
-	 fun mTake cell = gSwap ("mTake", doTakeSwap, cell)
-	 fun mTakeEvt cell = gSwapEvt ("mTakeEvt", doTakeSwap, cell)
-	 fun mTakePoll cell = gSwapPoll ("mTakePoll", doTakeSwap, cell)
+         fun mTake cell = gSwap ("mTake", doTakeSwap, cell)
+         fun mTakeEvt cell = gSwapEvt ("mTakeEvt", doTakeSwap, cell)
+         fun mTakePoll cell = gSwapPoll ("mTakePoll", doTakeSwap, cell)
       end
       local fun doGetSwap _ = ()
       in
-	 fun mGet cell = gSwap ("mGet", doGetSwap, cell)
-	 fun mGetEvt cell = gSwapEvt ("mGetEvt", doGetSwap, cell)
-	 fun mGetPoll cell = gSwapPoll ("mGetPoll", doGetSwap, cell)
+         fun mGet cell = gSwap ("mGet", doGetSwap, cell)
+         fun mGetEvt cell = gSwapEvt ("mGetEvt", doGetSwap, cell)
+         fun mGetPoll cell = gSwapPoll ("mGetPoll", doGetSwap, cell)
       end
       local fun doSwapSwap x value = value := SOME x
       in
-	 fun mSwap (cell, x) = gSwap ("mSwap", doSwapSwap x, cell)
-	 fun mSwapEvt (cell, x) = gSwapEvt ("mSwap", doSwapSwap x, cell)
+         fun mSwap (cell, x) = gSwap ("mSwap", doSwapSwap x, cell)
+         fun mSwapEvt (cell, x) = gSwapEvt ("mSwap", doSwapSwap x, cell)
       end
    end

Modified: mlton/branches/on-20050420-cmm-branch/lib/cml/core-cml/thread-id.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/cml/core-cml/thread-id.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/cml/core-cml/thread-id.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -24,44 +24,44 @@
       fun hashTid (TID{id, ...}) = Word.fromInt id
 
       fun tidToString (TID{id, ...}) =
-	 concat["[", StringCvt.padLeft #"0" 6 (Int.toString id), "]"]
+         concat["[", StringCvt.padLeft #"0" 6 (Int.toString id), "]"]
 
       fun exnHandler (_ : exn) = ()
       val defaultExnHandler = ref exnHandler
 
       fun new' n =
-	 TID {id = n,
-	      alert = ref false,
-	      done_comm = ref false,
-	      exnHandler = ref (!defaultExnHandler),
-	      props = ref [],
-	      dead = CVar.new ()}
+         TID {id = n,
+              alert = ref false,
+              done_comm = ref false,
+              exnHandler = ref (!defaultExnHandler),
+              props = ref [],
+              dead = CVar.new ()}
 
       local
-	 val tidCounter = ref 0
+         val tidCounter = ref 0
       in
-	 fun new () =
-	    let 
-	       val _ = Assert.assertAtomic' ("ThreadID.newTid", NONE)
-	       val n = !tidCounter
-	       val _ = tidCounter := n + 1
-	    in
-	       new' n
-	    end
+         fun new () =
+            let 
+               val _ = Assert.assertAtomic' ("ThreadID.newTid", NONE)
+               val n = !tidCounter
+               val _ = tidCounter := n + 1
+            in
+               new' n
+            end
 
-	 fun reset () = tidCounter := 0
+         fun reset () = tidCounter := 0
       end
 
       fun bogus s =
-	 let val n = CharVector.foldr (fn (c, n) => 2 * n - Char.ord c) 0 s
-	 in new' n
-	 end
+         let val n = CharVector.foldr (fn (c, n) => 2 * n - Char.ord c) 0 s
+         in new' n
+         end
 
       fun mark (TID{done_comm, ...}) = 
-	 (Assert.assertAtomic' ("ThreadID.mark", NONE)
-	  ; done_comm := true)
+         (Assert.assertAtomic' ("ThreadID.mark", NONE)
+          ; done_comm := true)
       fun unmark (TID{done_comm, ...}) = 
-	 (Assert.assertAtomic' ("ThreadID.unmark", NONE)
-	  ; done_comm := false)
+         (Assert.assertAtomic' ("ThreadID.unmark", NONE)
+          ; done_comm := false)
       fun isMarked (TID{done_comm, ...}) = !done_comm
    end

Modified: mlton/branches/on-20050420-cmm-branch/lib/cml/core-cml/thread.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/cml/core-cml/thread.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/cml/core-cml/thread.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -17,22 +17,22 @@
      val spawnc : ('a -> unit) -> 'a -> thread_id
      val spawn  : (unit -> unit) -> thread_id
      val exit   : unit -> 'a
-     val yield  : unit -> unit	(* mostly for benchmarking *)
+     val yield  : unit -> unit  (* mostly for benchmarking *)
 
      val joinEvt : thread_id -> unit Event.event
 
      (* thread-local data *)
      val newThreadProp : (unit -> 'a) -> 
-	{
-	 clrFn : unit -> unit,	        (* clear's current thread's property *)
-	 getFn : unit -> 'a,		(* get current thread's property; if *)
-	                                (* the property is not defined, then *)
-	                                (* it sets it using the initialization *)
-					(* function. *)
-	 peekFn : unit -> 'a option,	(* return the property's value, if any *)
-	 setFn : 'a -> unit		(* set the property's value for the *)
-					(* current thread. *)
-	 }
+        {
+         clrFn : unit -> unit,          (* clear's current thread's property *)
+         getFn : unit -> 'a,            (* get current thread's property; if *)
+                                        (* the property is not defined, then *)
+                                        (* it sets it using the initialization *)
+                                        (* function. *)
+         peekFn : unit -> 'a option,    (* return the property's value, if any *)
+         setFn : 'a -> unit             (* set the property's value for the *)
+                                        (* current thread. *)
+         }
      val newThreadFlag : unit -> {getFn : unit -> bool, setFn : bool -> unit}
   end
 

Modified: mlton/branches/on-20050420-cmm-branch/lib/cml/core-cml/thread.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/cml/core-cml/thread.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/cml/core-cml/thread.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -21,47 +21,47 @@
       open ThreadID
 
       fun generalExit (tid', clr') =
-	 let
-	    val () = Assert.assertNonAtomic' "Thread.generalExit"
-	    val () = debug' "generalExit" (* NonAtomic *)
-	    val () = Assert.assertNonAtomic' "Thread.generalExit"
-	 in
-	    S.switchToNext
-	    (fn t =>
-	     let
-		val tid as TID {dead, props, ...} = S.getThreadId t
-		val () = Assert.assert ([], fn () => 
-					concat ["Thread.generalExit ",
-						Option.getOpt (Option.map tidToString tid', "NONE"), 
-						" <> ",
-						tidToString tid], fn () =>
-					 case tid' of NONE => true
-				          | SOME tid' => sameTid (tid', tid))
-		val () = if clr' then props := [] else ()
-		val () = Event.atomicCVarSet dead
-	     in
-		()
-	     end)
-	 end
+         let
+            val () = Assert.assertNonAtomic' "Thread.generalExit"
+            val () = debug' "generalExit" (* NonAtomic *)
+            val () = Assert.assertNonAtomic' "Thread.generalExit"
+         in
+            S.switchToNext
+            (fn t =>
+             let
+                val tid as TID {dead, props, ...} = S.getThreadId t
+                val () = Assert.assert ([], fn () => 
+                                        concat ["Thread.generalExit ",
+                                                Option.getOpt (Option.map tidToString tid', "NONE"), 
+                                                " <> ",
+                                                tidToString tid], fn () =>
+                                         case tid' of NONE => true
+                                          | SOME tid' => sameTid (tid', tid))
+                val () = if clr' then props := [] else ()
+                val () = Event.atomicCVarSet dead
+             in
+                ()
+             end)
+         end
 
       fun doHandler (TID {exnHandler, ...}, exn) =
-	 (debug (fn () => concat ["Exception: ", exnName exn, " : ", exnMessage exn])
-	  ; ((!exnHandler) exn) handle _ => ())
+         (debug (fn () => concat ["Exception: ", exnName exn, " : ", exnMessage exn])
+          ; ((!exnHandler) exn) handle _ => ())
 
       fun spawnc f x = 
-	 let
-	    val () = S.atomicBegin ()
-	    fun thread tid () = 
-	       ((f x) handle ex => doHandler (tid, ex)
-		; generalExit (SOME tid, false))
-	    val t = S.new thread
-	    val tid = S.getThreadId t
-	    val () = S.ready (S.prep t)
-	    val () = S.atomicEnd ()
-	    val () = debug (fn () => concat ["spawnc ", tidToString tid])  (* NonAtomic *)
-	 in
-	    tid
-	 end
+         let
+            val () = S.atomicBegin ()
+            fun thread tid () = 
+               ((f x) handle ex => doHandler (tid, ex)
+                ; generalExit (SOME tid, false))
+            val t = S.new thread
+            val tid = S.getThreadId t
+            val () = S.ready (S.prep t)
+            val () = S.atomicEnd ()
+            val () = debug (fn () => concat ["spawnc ", tidToString tid])  (* NonAtomic *)
+         in
+            tid
+         end
       fun spawn f = spawnc f ()
 
       fun joinEvt (TID{dead, ...}) = Event.cvarGetEvt dead
@@ -69,102 +69,102 @@
       val getTid = S.getCurThreadId
 
       fun exit () = 
-	 let
-	    val () = Assert.assertNonAtomic' "Thread.exit"
-	    val () = debug' "exit" (* NonAtomic *)
-	    val () = Assert.assertNonAtomic' "Thread.exit"
-	 in
-	    generalExit (NONE, true)
-	 end
+         let
+            val () = Assert.assertNonAtomic' "Thread.exit"
+            val () = debug' "exit" (* NonAtomic *)
+            val () = Assert.assertNonAtomic' "Thread.exit"
+         in
+            generalExit (NONE, true)
+         end
 
       fun yield () = 
-	 let
-	    val () = Assert.assertNonAtomic' "Thread.yield"
-	    val () = debug' "yield" (* NonAtomic *)
-	    val () = Assert.assertNonAtomic' "Thread.yield"
-	 in
-	    S.readyAndSwitchToNext (fn () => ())
-	 end
+         let
+            val () = Assert.assertNonAtomic' "Thread.yield"
+            val () = debug' "yield" (* NonAtomic *)
+            val () = Assert.assertNonAtomic' "Thread.yield"
+         in
+            S.readyAndSwitchToNext (fn () => ())
+         end
 
       (* thread-local data *)
       local
-	 fun mkProp () = 
-	    let
-	       exception E of 'a 
-	       fun cons (a, l) = E a :: l 
-	       fun peek [] = NONE
-		 | peek (E a :: _) = SOME a
-		 | peek (_ :: l) = peek l
-	       fun delete [] = []
-		 | delete (E _ :: r) = r
-		 | delete (x :: r) = x :: delete r
-	    in
-	       {cons = cons, 
-		peek = peek, 
-		delete = delete}
-	    end
-	 fun mkFlag () = 
-	    let
-	       exception E
-	       fun peek [] = false
-		 | peek (E :: _) = true
-		 | peek (_ :: l) = peek l
-	       fun set (l, flg) = 
-		  let
-		     fun set ([], _) = if flg then E::l else l
-		       | set (E::r, xs) = if flg then l else List.revAppend(xs, r)
-		       | set (x::r, xs) = set (r, x::xs)
-		  in
-		     set (l, [])
-		  end
-	    in
-	       {set = set, 
-		peek = peek}
-	    end
-	 fun getProps () = 
-	    let val TID {props, ...} = getTid () 
-	    in props 
-	    end
+         fun mkProp () = 
+            let
+               exception E of 'a 
+               fun cons (a, l) = E a :: l 
+               fun peek [] = NONE
+                 | peek (E a :: _) = SOME a
+                 | peek (_ :: l) = peek l
+               fun delete [] = []
+                 | delete (E _ :: r) = r
+                 | delete (x :: r) = x :: delete r
+            in
+               {cons = cons, 
+                peek = peek, 
+                delete = delete}
+            end
+         fun mkFlag () = 
+            let
+               exception E
+               fun peek [] = false
+                 | peek (E :: _) = true
+                 | peek (_ :: l) = peek l
+               fun set (l, flg) = 
+                  let
+                     fun set ([], _) = if flg then E::l else l
+                       | set (E::r, xs) = if flg then l else List.revAppend(xs, r)
+                       | set (x::r, xs) = set (r, x::xs)
+                  in
+                     set (l, [])
+                  end
+            in
+               {set = set, 
+                peek = peek}
+            end
+         fun getProps () = 
+            let val TID {props, ...} = getTid () 
+            in props 
+            end
       in
-	 fun newThreadProp (init : unit -> 'b) = 
-	    let
-	       val {peek, cons, delete} = mkProp() 
-	       fun peekFn () = peek(!(getProps()))
-	       fun getF () = 
-		  let val h = getProps()
-		  in
-		     case peek(!h) of 
-			NONE => let val b = init() 
-				in h := cons(b, !h); b 
-				end
-		      | (SOME b) => b
-		  end
-	       fun clrF () = 
-		  let val h = getProps()
-		  in h := delete(!h)
-		  end
-	       fun setFn x = 
-		  let val h = getProps()
-		  in h := cons(x, delete(!h))
-		  end
-	    in
-	       {peekFn = peekFn, 
-		getFn = getF, 
-		clrFn = clrF, 
-		setFn = setFn}
-	    end
+         fun newThreadProp (init : unit -> 'b) = 
+            let
+               val {peek, cons, delete} = mkProp() 
+               fun peekFn () = peek(!(getProps()))
+               fun getF () = 
+                  let val h = getProps()
+                  in
+                     case peek(!h) of 
+                        NONE => let val b = init() 
+                                in h := cons(b, !h); b 
+                                end
+                      | (SOME b) => b
+                  end
+               fun clrF () = 
+                  let val h = getProps()
+                  in h := delete(!h)
+                  end
+               fun setFn x = 
+                  let val h = getProps()
+                  in h := cons(x, delete(!h))
+                  end
+            in
+               {peekFn = peekFn, 
+                getFn = getF, 
+                clrFn = clrF, 
+                setFn = setFn}
+            end
 
-	 fun newThreadFlag () = 
-	    let
-	       val {peek, set} = mkFlag() 
-	       fun getF ()= peek(!(getProps()))
-	       fun setF flg = 
-		  let val h = getProps()
-		  in h := set(!h, flg)
-		  end
-	    in
-	       {getFn = getF, 
-		setFn = setF}
-	    end
+         fun newThreadFlag () = 
+            let
+               val {peek, set} = mkFlag() 
+               fun getF ()= peek(!(getProps()))
+               fun setF flg = 
+                  let val h = getProps()
+                  in h := set(!h, flg)
+                  end
+            in
+               {getFn = getF, 
+                setFn = setF}
+            end
       end
    end

Modified: mlton/branches/on-20050420-cmm-branch/lib/cml/core-cml/timeout.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/cml/core-cml/timeout.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/cml/core-cml/timeout.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -34,11 +34,11 @@
        * (this is at least as accurate as the time quantum).
        *)
       fun getTime () = 
-	 case !clock of
-	    NONE => let val t = Time.now()
-		    in clock := SOME t;  t
-		    end
-	  | SOME t => t
+         case !clock of
+            NONE => let val t = Time.now()
+                    in clock := SOME t;  t
+                    end
+          | SOME t => t
       fun preemptTime () = clock := NONE
 
       (* The queue of threads waiting for timeouts.
@@ -48,115 +48,115 @@
       type item = trans_id * (unit -> unit) * S.rdy_thread
       val timeQ : item TQ.t ref = ref (TQ.new ())
 
-      fun cleaner readied elt =
-	 let 
-	    val now = getTime ()
-	    val (TXID txst, cleanUp, t) = TQ.Elt.value elt
-	 in 
-	    case !txst of 
-	       CANCEL => true 
-	     | _ => if Time.<=(TQ.Elt.key elt, now)
-		       then (readied ()
-			     ; S.ready t
-			     ; cleanUp ()
-			     ; true)
-		       else false
-	 end
+      fun cleaner (readied: unit -> unit) elt =
+         let 
+            val now = getTime ()
+            val (TXID txst, cleanUp: unit -> unit, t) = TQ.Elt.value elt
+         in 
+            case !txst of 
+               CANCEL => true 
+             | _ => if Time.<=(TQ.Elt.key elt, now)
+                       then (readied ()
+                             ; S.ready t
+                             ; cleanUp ()
+                             ; true)
+                       else false
+         end
  
       fun timeWait (time, txid, cleanUp, t) = 
-	 (Assert.assertAtomic' ("TimeOut.timeWait", NONE)
-	  ; timeQ := TQ.enqueAndClean(!timeQ, time, (txid, cleanUp, t), cleaner (fn () => ())))
+         (Assert.assertAtomic' ("TimeOut.timeWait", NONE)
+          ; timeQ := TQ.enqueAndClean(!timeQ, time, (txid, cleanUp, t), cleaner (fn () => ())))
 
       (** NOTE: unlike for most base events, the block functions of time-out
        ** events do not have to exit the atomic region or execute the clean-up
        ** operation.  This is done when they are removed from the waiting queue.
        **)
       fun timeOutEvt time = 
-	 let
-	    fun blockFn {transId, cleanUp, next} = 
-	       let
-		  val () = Assert.assertAtomic' ("TimeOut.timeOutEvt.blockFn", NONE)
-		  val () = debug' "timeOutEvt(3.2.1)" (* Atomic 1 *)
-		  val () = Assert.assertAtomic' ("TimeOut.timeOutEvt(3.2.1)", SOME 1)
-		  val () =
-		     S.atomicSwitch
-		     (fn t =>
-		      (timeWait (Time.+(time, getTime ()), transId, cleanUp, S.prep t)
-		       ; next ()))
-		  val () = debug' "timeOutEvt(3.2.3)" (* NonAtomic *)
-		  val () = Assert.assertNonAtomic' "TimeOut.timeOutEvt(3.2.3)"
-	       in
-		  ()
-	       end
-	    fun pollFn () = 
-	       let
-		  val () = Assert.assertAtomic' ("TimeOut.timeOutEvt.pollFn", NONE)
-		  val () = debug' "timeOutEvt(2)" (* Atomic 1 *)
-		  val () = Assert.assertAtomic' ("TimeOut.timeOutEvt(2)", SOME 1)
-	       in
-		  if Time.<=(time, Time.zeroTime)
-		     then E.enabled {prio = ~1, doitFn = S.atomicEnd}
-		     else E.blocked blockFn
-	       end
-	 in
-	    E.bevt pollFn
-	 end
+         let
+            fun blockFn {transId, cleanUp, next} = 
+               let
+                  val () = Assert.assertAtomic' ("TimeOut.timeOutEvt.blockFn", NONE)
+                  val () = debug' "timeOutEvt(3.2.1)" (* Atomic 1 *)
+                  val () = Assert.assertAtomic' ("TimeOut.timeOutEvt(3.2.1)", SOME 1)
+                  val () =
+                     S.atomicSwitch
+                     (fn t =>
+                      (timeWait (Time.+(time, getTime ()), transId, cleanUp, S.prep t)
+                       ; next ()))
+                  val () = debug' "timeOutEvt(3.2.3)" (* NonAtomic *)
+                  val () = Assert.assertNonAtomic' "TimeOut.timeOutEvt(3.2.3)"
+               in
+                  ()
+               end
+            fun pollFn () = 
+               let
+                  val () = Assert.assertAtomic' ("TimeOut.timeOutEvt.pollFn", NONE)
+                  val () = debug' "timeOutEvt(2)" (* Atomic 1 *)
+                  val () = Assert.assertAtomic' ("TimeOut.timeOutEvt(2)", SOME 1)
+               in
+                  if Time.<=(time, Time.zeroTime)
+                     then E.enabled {prio = ~1, doitFn = S.atomicEnd}
+                     else E.blocked blockFn
+               end
+         in
+            E.bevt pollFn
+         end
        
       fun atTimeEvt time = 
-	 let
-	    fun blockFn {transId, cleanUp, next} = 
-	       let
-		  val () = Assert.assertAtomic' ("TimeOut.atTimeEvt.blockFn", NONE)
-		  val () = debug' "atTimeEvt(3.2.1)" (* Atomic 1 *)
-		  val () = Assert.assertAtomic' ("TimeOut.atTimeEvt(3.2.1)", SOME 1)
-		  val () =
-		     S.atomicSwitch
-		     (fn t =>
-		      (timeWait (time, transId, cleanUp, S.prep t)
-		       ; next ()))
-		  val () = debug' "atTimeEvt(3.2.3)" (* NonAtomic *)
-		  val () = Assert.assertNonAtomic' "TimeOut.atTimeEvt(3.2.3)"
-	       in
-		  ()
-	       end
-	    fun pollFn () = 
-	       let
-		  val () = Assert.assertAtomic' ("TimeOut.atTimeEvt.pollFn", NONE)
-		  val () = debug' "atTimeEvt(2)" (* Atomic 1 *)
-		  val () = Assert.assertAtomic' ("TimeOut.atTimeEvt(2)", SOME 1)
-	       in
-		  if Time.<=(time, getTime())
-		     then E.enabled {prio = ~1, doitFn = S.atomicEnd}
-		     else E.blocked blockFn
-	       end
-	 in
-	    E.bevt pollFn
-	 end
+         let
+            fun blockFn {transId, cleanUp, next} = 
+               let
+                  val () = Assert.assertAtomic' ("TimeOut.atTimeEvt.blockFn", NONE)
+                  val () = debug' "atTimeEvt(3.2.1)" (* Atomic 1 *)
+                  val () = Assert.assertAtomic' ("TimeOut.atTimeEvt(3.2.1)", SOME 1)
+                  val () =
+                     S.atomicSwitch
+                     (fn t =>
+                      (timeWait (time, transId, cleanUp, S.prep t)
+                       ; next ()))
+                  val () = debug' "atTimeEvt(3.2.3)" (* NonAtomic *)
+                  val () = Assert.assertNonAtomic' "TimeOut.atTimeEvt(3.2.3)"
+               in
+                  ()
+               end
+            fun pollFn () = 
+               let
+                  val () = Assert.assertAtomic' ("TimeOut.atTimeEvt.pollFn", NONE)
+                  val () = debug' "atTimeEvt(2)" (* Atomic 1 *)
+                  val () = Assert.assertAtomic' ("TimeOut.atTimeEvt(2)", SOME 1)
+               in
+                  if Time.<=(time, getTime())
+                     then E.enabled {prio = ~1, doitFn = S.atomicEnd}
+                     else E.blocked blockFn
+               end
+         in
+            E.bevt pollFn
+         end
 
       (* reset various pieces of state *)
       fun reset () = timeQ := TQ.new ()
 
       (* what to do at a preemption *)
       fun preempt () : Time.time option option = 
-	 let 
-	    val () = Assert.assertAtomic' ("TimeOut.preempt", NONE)
-	    val () = debug' "TimeOut.preempt" (* Atomic 1 *)
-	    val () = Assert.assertAtomic' ("TimeOut.preempt", SOME 1)
-	    val () = preemptTime ()
-	    val timeQ' = !timeQ
-	 in
-	    if TQ.empty timeQ'
-	       then NONE
-	       else let
-		       val readied = ref false
-		       val timeQ' = TQ.clean (timeQ', cleaner (fn () => readied := true))
-		       val () = timeQ := timeQ'
-		    in
-		       if !readied
-			  then SOME NONE
-			  else case TQ.peek timeQ' of
-			          NONE => NONE
-				| SOME elt => SOME(SOME(Time.-(TQ.Elt.key elt, getTime ())))
-		    end
-	 end
+         let 
+            val () = Assert.assertAtomic' ("TimeOut.preempt", NONE)
+            val () = debug' "TimeOut.preempt" (* Atomic 1 *)
+            val () = Assert.assertAtomic' ("TimeOut.preempt", SOME 1)
+            val () = preemptTime ()
+            val timeQ' = !timeQ
+         in
+            if TQ.empty timeQ'
+               then NONE
+               else let
+                       val readied = ref false
+                       val timeQ' = TQ.clean (timeQ', cleaner (fn () => readied := true))
+                       val () = timeQ := timeQ'
+                    in
+                       if !readied
+                          then SOME NONE
+                          else case TQ.peek timeQ' of
+                                  NONE => NONE
+                                | SOME elt => SOME(SOME(Time.-(TQ.Elt.key elt, getTime ())))
+                    end
+         end
    end

Modified: mlton/branches/on-20050420-cmm-branch/lib/cml/core-cml/trans-id.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/cml/core-cml/trans-id.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/cml/core-cml/trans-id.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -27,26 +27,26 @@
 
       (* create a transaction flag (ID and cleanUp). *)
       fun mkFlg () =
-	 let 
-	    val txid as TXID txst = mkTxId ()
-	    val cleanUp = fn () =>
-	       (Assert.assertAtomic' ("TransID.mkFlg.cleanUp", NONE)
-		; txst := CANCEL)
-	 in 
-	    (txid, cleanUp)
-	 end
+         let 
+            val txid as TXID txst = mkTxId ()
+            val cleanUp = fn () =>
+               (Assert.assertAtomic' ("TransID.mkFlg.cleanUp", NONE)
+                ; txst := CANCEL)
+         in 
+            (txid, cleanUp)
+         end
 
       (* given a transaction ID, mark it cancelled. *)
       fun force (TXID txst) =
-	 (Assert.assertAtomic' ("TransID.force", NONE)
-	  ; case !txst of
-	       TRANS => txst := CANCEL
-	     | CANCEL => raise Fail "TransID.force")
+         (Assert.assertAtomic' ("TransID.force", NONE)
+          ; case !txst of
+               TRANS => txst := CANCEL
+             | CANCEL => raise Fail "TransID.force")
 
       (*
       fun toString (TXID txst) =
-	 case !txst of
-	    TRANS => "TRANS"
-	  | CANCEL => "CANCEL"
+         case !txst of
+            TRANS => "TRANS"
+          | CANCEL => "CANCEL"
       *)
    end

Modified: mlton/branches/on-20050420-cmm-branch/lib/cml/core-cml/version.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/cml/core-cml/version.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/cml/core-cml/version.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -11,20 +11,20 @@
 structure Version : VERSION = 
    struct
       val version = {
-		     system = "Concurrent ML (MLton)",
-		     version_id = [1, 0, 10],
-		     date = "March, 2004"
-		     }
+                     system = "Concurrent ML (MLton)",
+                     version_id = [1, 0, 10],
+                     date = "March, 2004"
+                     }
 
       fun f ([], l) = l
-	| f ([x], l) = (Int.toString x)::l
-	| f (x::r, l) = (Int.toString x) :: "." :: f(r, l)
+        | f ([x], l) = (Int.toString x)::l
+        | f (x::r, l) = (Int.toString x) :: "." :: f(r, l)
 
       val banner = 
-	 concat (
-		 #system version :: 
-		 ", Version " ::
-		 f (#version_id version, [", ", #date version])
-		 )
+         concat (
+                 #system version :: 
+                 ", Version " ::
+                 f (#version_id version, [", ", #date version])
+                 )
    end
 

Modified: mlton/branches/on-20050420-cmm-branch/lib/cml/tests/exit.mlb
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/cml/tests/exit.mlb	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/cml/tests/exit.mlb	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,8 +1,8 @@
 local
-  $(SML_LIB)/basis/basis.mlb
-  ../cml.mlb
-  print.mlb
+   $(SML_LIB)/basis/basis.mlb
+   ../cml.mlb
+   print.mlb
 in
-  exit.sml 
-  run-main.sml
+   exit.sml 
+   run-main.sml
 end

Modified: mlton/branches/on-20050420-cmm-branch/lib/cml/tests/ping-pong.mlb
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/cml/tests/ping-pong.mlb	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/cml/tests/ping-pong.mlb	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,8 +1,8 @@
 local
-  $(SML_LIB)/basis/basis.mlb
-  ../cml.mlb
-  print.mlb
+   $(SML_LIB)/basis/basis.mlb
+   ../cml.mlb
+   print.mlb
 in
-  ping-pong.sml 
-  run-main.sml
+   ping-pong.sml 
+   run-main.sml
 end

Modified: mlton/branches/on-20050420-cmm-branch/lib/cml/tests/ping-pong.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/cml/tests/ping-pong.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/cml/tests/ping-pong.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -5,40 +5,40 @@
 
    fun pong ch =
       let
-	 fun loop () =
-	    let
-	       val () = recv ch
-	    in
-	       loop ()
-	    end
-	 val _ = spawn (fn () => loop ())
+         fun loop () =
+            let
+               val () = recv ch
+            in
+               loop ()
+            end
+         val _ = spawn (fn () => loop ())
       in
-	 ()
+         ()
       end
 
    fun ping ch n =
       let
-	 fun loop i =
-	    if i > n then RunCML.shutdown OS.Process.success
-	       else let
-		       val () = send (ch, ())
-		    in
-		       loop (i + 1)
-		    end
-	 val _ = spawn (fn () => loop 0)
+         fun loop i =
+            if i > n then RunCML.shutdown OS.Process.success
+               else let
+                       val () = send (ch, ())
+                    in
+                       loop (i + 1)
+                    end
+         val _ = spawn (fn () => loop 0)
       in
-	 ()
+         ()
       end
 
    fun doit n =
       RunCML.doit
       (fn () =>
        let
-	  val ch = channel ()
-	  val () = pong ch
-	  val () = ping ch n
+          val ch = channel ()
+          val () = pong ch
+          val () = ping ch n
        in
-	  ()
+          ()
        end,
        SOME (Time.fromMilliseconds 10))
 end

Modified: mlton/branches/on-20050420-cmm-branch/lib/cml/tests/primes-multicast.mlb
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/cml/tests/primes-multicast.mlb	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/cml/tests/primes-multicast.mlb	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,8 +1,8 @@
 local
-  $(SML_LIB)/basis/basis.mlb
-  ../cml.mlb
-  print.mlb
+   $(SML_LIB)/basis/basis.mlb
+   ../cml.mlb
+   print.mlb
 in
-  primes-multicast.sml 
-  run-main.sml
+   primes-multicast.sml 
+   run-main.sml
 end

Modified: mlton/branches/on-20050420-cmm-branch/lib/cml/tests/primes-multicast.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/cml/tests/primes-multicast.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/cml/tests/primes-multicast.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -8,95 +8,95 @@
 
    fun makeNatStream c =
       let
-	 val mch = MC.mChannel ()
-	 fun count i = (MC.multicast(mch, i)
-			; count(i+1))
-	 val _ = spawn (fn () => 
-			(print (concat ["makeNatStream: ", 
-					tidToString (getTid ()), 
-					"\n"])
-			 ; count c))
+         val mch = MC.mChannel ()
+         fun count i = (MC.multicast(mch, i)
+                        ; count(i+1))
+         val _ = spawn (fn () => 
+                        (print (concat ["makeNatStream: ", 
+                                        tidToString (getTid ()), 
+                                        "\n"])
+                         ; count c))
       in
-	 mch
+         mch
       end
    
    fun makeFilter (p, inMCh) =
       let
-	 val inP = MC.port inMCh
-	 val outMCh = MC.mChannel ()
-	 fun loop () =
-	    let
-	       val i = sync (MC.recvEvt inP)
-	    in
-	       if ((i mod p) <> 0) 
-		  then MC.multicast(outMCh, i)
-		  else ()
-	       ; loop ()
-	    end
-	 val _ = spawn loop
+         val inP = MC.port inMCh
+         val outMCh = MC.mChannel ()
+         fun loop () =
+            let
+               val i = sync (MC.recvEvt inP)
+            in
+               if ((i mod p) <> 0) 
+                  then MC.multicast(outMCh, i)
+                  else ()
+               ; loop ()
+            end
+         val _ = spawn loop
       in
-	 outMCh
+         outMCh
       end
    
    fun makePrimes () =
       let
-	 val primes = MC.mChannel ()
-	 fun head mch =
-	    let
-	       val p = MC.recv (MC.port mch)
-	    in
-	       MC.multicast(primes, p)
-	       ; head (makeFilter (p, mch))
-	    end
-	 val _ = spawn (fn () => 
-			(print (concat ["makePrimes: ", 
-					tidToString (getTid ()), 
-					"\n"])
-			 ; head (makeNatStream 2)))
+         val primes = MC.mChannel ()
+         fun head mch =
+            let
+               val p = MC.recv (MC.port mch)
+            in
+               MC.multicast(primes, p)
+               ; head (makeFilter (p, mch))
+            end
+         val _ = spawn (fn () => 
+                        (print (concat ["makePrimes: ", 
+                                        tidToString (getTid ()), 
+                                        "\n"])
+                         ; head (makeNatStream 2)))
       in
-	 primes
+         primes
       end
    
    fun makeNatPrinter mch n =
       let
-	 val p = MC.port mch
-	 fun loop i =
-	    if i > n then RunCML.shutdown OS.Process.success
-	       else let
-		       val m = MC.recv p
-		       val m' = Int.toString m
-		       fun loop' j =
-			  if j > m then ()
-			  else (print (m' ^ "\n")
-				; loop' (j + 1))
-		    in
-		       loop' m
-		       ; loop (i + 1)
-		    end
-	 val _ = spawn (fn () => 
-			(print (concat ["makeNatPrinter: ", 
-					tidToString (getTid ()), 
-					"\n"])
-			 ; loop 0))
+         val p = MC.port mch
+         fun loop i =
+            if i > n then RunCML.shutdown OS.Process.success
+               else let
+                       val m = MC.recv p
+                       val m' = Int.toString m
+                       fun loop' j =
+                          if j > m then ()
+                          else (print (m' ^ "\n")
+                                ; loop' (j + 1))
+                    in
+                       loop' m
+                       ; loop (i + 1)
+                    end
+         val _ = spawn (fn () => 
+                        (print (concat ["makeNatPrinter: ", 
+                                        tidToString (getTid ()), 
+                                        "\n"])
+                         ; loop 0))
       in
-	 ()
+         ()
       end
 
    fun doit' n =
       RunCML.doit
       (fn () =>
        let
-	  val mch = makePrimes ()
-	  val _ = makeNatPrinter mch n
+          val mch = makePrimes ()
+          val _ = makeNatPrinter mch n
        in
-	  ()
+          ()
        end,
        SOME (Time.fromMilliseconds 10))
 
    fun doit n =
       let
-	 val x = doit' n
+         val x = doit' n
       in
-	 x
+         x
       end
 end

Modified: mlton/branches/on-20050420-cmm-branch/lib/cml/tests/primes.mlb
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/cml/tests/primes.mlb	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/cml/tests/primes.mlb	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,8 +1,8 @@
 local
-  $(SML_LIB)/basis/basis.mlb
-  ../cml.mlb
-  print.mlb
+   $(SML_LIB)/basis/basis.mlb
+   ../cml.mlb
+   print.mlb
 in
-  primes.sml 
-  run-main.sml
+   primes.sml 
+   run-main.sml
 end

Modified: mlton/branches/on-20050420-cmm-branch/lib/cml/tests/primes.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/cml/tests/primes.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/cml/tests/primes.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -7,92 +7,92 @@
 
    fun makeNatStream c =
       let
-	 val ch = channel ()
-	 fun count i = (send(ch, i)
-			; count(i+1))
-	 val _ = spawn (fn () => 
-			(print (concat ["makeNatStream: ", 
-					tidToString (getTid ()), 
-					"\n"])
-			 ; count c))
+         val ch = channel ()
+         fun count i = (send(ch, i)
+                        ; count(i+1))
+         val _ = spawn (fn () => 
+                        (print (concat ["makeNatStream: ", 
+                                        tidToString (getTid ()), 
+                                        "\n"])
+                         ; count c))
       in
-	 ch
+         ch
       end
    
    fun makeFilter (p, inCh) =
       let
-	 val outCh = channel ()
-	 fun loop () =
-	    let
-	       val i = sync (recvEvt inCh)
-	    in
-	       if ((i mod p) <> 0) 
-		  then sync (sendEvt (outCh, i))
-		  else ()
-	       ; loop ()
-	    end
-	 val _ = spawn loop
+         val outCh = channel ()
+         fun loop () =
+            let
+               val i = sync (recvEvt inCh)
+            in
+               if ((i mod p) <> 0) 
+                  then sync (sendEvt (outCh, i))
+                  else ()
+               ; loop ()
+            end
+         val _ = spawn loop
       in
-	 outCh
+         outCh
       end
    
    fun makePrimes () =
       let
-	 val primes = channel ()
-	 fun head ch =
-	    let val p = recv ch
-	    in
-	       send(primes, p)
-	       ; head (makeFilter (p, ch))
-	    end
-	 val _ = spawn (fn () => 
-			(print (concat ["makePrimes: ", 
-					tidToString (getTid ()), 
-					"\n"])
-			 ; head (makeNatStream 2)))
+         val primes = channel ()
+         fun head ch =
+            let val p = recv ch
+            in
+               send(primes, p)
+               ; head (makeFilter (p, ch))
+            end
+         val _ = spawn (fn () => 
+                        (print (concat ["makePrimes: ", 
+                                        tidToString (getTid ()), 
+                                        "\n"])
+                         ; head (makeNatStream 2)))
       in
-	 primes
+         primes
       end
    
    fun makeNatPrinter ch n =
       let
-	 fun loop i =
-	    if i > n then RunCML.shutdown OS.Process.success
-	       else let
-		       val m = recv ch
-		       val m' = Int.toString m
-		       fun loop' j =
-			  if j > m then ()
-			  else (print (m' ^ "\n")
-				; loop' (j + 1))
-		    in
-		       loop' m
-		       ; loop (i + 1)
-		    end
-	 val _ = spawn (fn () => 
-			(print (concat ["makeNatPrinter: ", 
-					tidToString (getTid ()), 
-					"\n"])
-			 ; loop 0))
+         fun loop i =
+            if i > n then RunCML.shutdown OS.Process.success
+               else let
+                       val m = recv ch
+                       val m' = Int.toString m
+                       fun loop' j =
+                          if j > m then ()
+                          else (print (m' ^ "\n")
+                                ; loop' (j + 1))
+                    in
+                       loop' m
+                       ; loop (i + 1)
+                    end
+         val _ = spawn (fn () => 
+                        (print (concat ["makeNatPrinter: ", 
+                                        tidToString (getTid ()), 
+                                        "\n"])
+                         ; loop 0))
       in
-	 ()
+         ()
       end
 
    fun doit' n =
       RunCML.doit
       (fn () =>
        let
-	  val ch = makePrimes ()
-	  val _ = makeNatPrinter ch n
+          val ch = makePrimes ()
+          val _ = makeNatPrinter ch n
        in
-	  ()
+          ()
        end,
        SOME (Time.fromMilliseconds 10))
 
    fun doit n =
       let
-	 val x = doit' n
+         val x = doit' n
       in
-	 x
+         x
       end
 end

Modified: mlton/branches/on-20050420-cmm-branch/lib/cml/tests/print.mlb
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/cml/tests/print.mlb	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/cml/tests/print.mlb	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,6 +1,6 @@
 local
-  $(SML_LIB)/basis/basis.mlb
-  $(SML_LIB)/basis/mlton.mlb
+   $(SML_LIB)/basis/basis.mlb
+   $(SML_LIB)/basis/mlton.mlb
 in
-  print.sml
+   print.sml
 end

Modified: mlton/branches/on-20050420-cmm-branch/lib/cml/tests/print.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/cml/tests/print.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/cml/tests/print.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -2,8 +2,8 @@
    struct
       open TextIO
       fun print s =
-	 MLton.Thread.atomically
-	 (fn () => TextIO.print s)
+         MLton.Thread.atomically
+         (fn () => TextIO.print s)
    end
 
 val print = TextIO.print

Modified: mlton/branches/on-20050420-cmm-branch/lib/cml/tests/run-main.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/cml/tests/run-main.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/cml/tests/run-main.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -2,8 +2,8 @@
    case CommandLine.arguments () of
       [] => 100
     | s::_ => (case Int.fromString s of
-		  NONE => 100
-		| SOME n => n)
+                  NONE => 100
+                | SOME n => n)
 
 val ts = Time.now ()
 val _ = Main.doit n

Modified: mlton/branches/on-20050420-cmm-branch/lib/cml/tests/timeout.mlb
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/cml/tests/timeout.mlb	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/cml/tests/timeout.mlb	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,8 +1,8 @@
 local
-  $(SML_LIB)/basis/basis.mlb
-  ../cml.mlb
-  print.mlb
+   $(SML_LIB)/basis/basis.mlb
+   ../cml.mlb
+   print.mlb
 in
-  timeout.sml 
-  run-main.sml
+   timeout.sml 
+   run-main.sml
 end

Modified: mlton/branches/on-20050420-cmm-branch/lib/cml/tests/timeout.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/cml/tests/timeout.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/cml/tests/timeout.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -9,29 +9,29 @@
       RunCML.doit
       (fn () =>
        let
-	  fun make m () =
-	     (print (concat ["make: ", Int.toString m, " ",
-			     tidToString (getTid ()), "\n"])
-	      ; sync (timeOutEvt (Time.fromSeconds (Int.toLarge m)))
-	      ; print (concat ["finish: ", Int.toString m, " ",
-			       tidToString (getTid ()), "\n"]))
-	  fun loop m =
-	     if m <= 0
-		then ()
-		else let
-			val _ = spawn (make m)
-		     in
-			loop (m - 10)
-		     end
+          fun make m () =
+             (print (concat ["make: ", Int.toString m, " ",
+                             tidToString (getTid ()), "\n"])
+              ; sync (timeOutEvt (Time.fromSeconds (Int.toLarge m)))
+              ; print (concat ["finish: ", Int.toString m, " ",
+                               tidToString (getTid ()), "\n"]))
+          fun loop m =
+             if m <= 0
+                then ()
+                else let
+                        val _ = spawn (make m)
+                     in
+                        loop (m - 10)
+                     end
        in
-	  loop n
+          loop n
        end,
        SOME (Time.fromMilliseconds 10))
 
    fun doit n =
       let
-	 val x = doit' n
+         val x = doit' n
       in
-	 x
+         x
       end
 end

Modified: mlton/branches/on-20050420-cmm-branch/lib/cml/util/assert.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/cml/util/assert.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/cml/util/assert.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -9,35 +9,35 @@
       val assertFlg = false
       
       fun fail msg =
-	 (C.atomicBegin ();
-	  TextIO.print (concat ["ASSERT: ", msg, "\n"]);
-	  OS.Process.exit OS.Process.failure)
+         (C.atomicBegin ();
+          TextIO.print (concat ["ASSERT: ", msg, "\n"]);
+          OS.Process.exit OS.Process.failure)
 
       fun assert (msgs: (unit -> string) list, 
-		  msg: unit -> string, 
-		  f: unit -> bool): unit =
-	 if assertFlg andalso not (f () handle _ => false)
-	    then let
-		    val msgs = List.map (fn f => f ()) msgs
-		    val msg = concat [String.concatWith " " msgs, " :: ", msg ()]
-		 in
-		    fail msg
-		 end
-	    else ()
+                  msg: unit -> string, 
+                  f: unit -> bool): unit =
+         if assertFlg andalso not (f () handle _ => false)
+            then let
+                    val msgs = List.map (fn f => f ()) msgs
+                    val msg = concat [String.concatWith " " msgs, " :: ", msg ()]
+                 in
+                    fail msg
+                 end
+            else ()
       fun assert' (msg: string, f: unit -> bool): unit =
-	 assert ([], fn () => msg, f)
+         assert ([], fn () => msg, f)
 
       datatype z = datatype MLton.Thread.AtomicState.t
       fun assertAtomic (msg: unit -> string, n: int option): unit =
-	 assert ([C.atomicMsg], msg, fn () =>
-		 case MLton.Thread.atomicState () of
-		    Atomic m => (case n of NONE => true | SOME n => n = m)
-		  | NonAtomic => false)
+         assert ([C.atomicMsg], msg, fn () =>
+                 case MLton.Thread.atomicState () of
+                    Atomic m => (case n of NONE => true | SOME n => n = m)
+                  | NonAtomic => false)
       fun assertNonAtomic (msg: unit -> string): unit =
-	 assert ([C.atomicMsg], msg, fn () =>
-		 case MLton.Thread.atomicState () of
-		    Atomic _ => false
-		  | NonAtomic => true)
+         assert ([C.atomicMsg], msg, fn () =>
+                 case MLton.Thread.atomicState () of
+                    Atomic _ => false
+                  | NonAtomic => true)
       fun assertAtomic' (msg, n) = assertAtomic (fn () => msg, n)
       fun assertNonAtomic' msg = assertNonAtomic (fn () => msg)
    end

Modified: mlton/branches/on-20050420-cmm-branch/lib/cml/util/critical.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/cml/util/critical.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/cml/util/critical.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -14,15 +14,15 @@
       val atomicEnd = Thread.atomicEnd
       local datatype z = datatype Thread.AtomicState.t
       in
-	 fun atomicMsg () =
-	    case Thread.atomicState () of
-	       AtomicState.NonAtomic => "[NonAtomic]"
-	     | AtomicState.Atomic n => concat ["[ Atomic ", Int.toString n, "]"]
+         fun atomicMsg () =
+            case Thread.atomicState () of
+               AtomicState.NonAtomic => "[NonAtomic]"
+             | AtomicState.Atomic n => concat ["[ Atomic ", Int.toString n, "]"]
       end
-      fun doAtomic f = (atomicBegin (); f (); atomicEnd ())
+      fun doAtomic (f: unit -> unit) = (atomicBegin (); f (); atomicEnd ())
 
       val mask = Signal.Mask.some [Itimer.signal Itimer.Real]
       fun maskBegin () = Signal.Mask.block mask
       fun maskEnd () = Signal.Mask.unblock mask
-      fun doMasked f = (maskBegin (); f (); maskEnd ())
+      fun doMasked (f: unit -> unit) = (maskBegin (); f (); maskEnd ())
    end

Modified: mlton/branches/on-20050420-cmm-branch/lib/cml/util/debug.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/cml/util/debug.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/cml/util/debug.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -17,16 +17,16 @@
       val debugFlg = false
 
       fun sayDebug (msgs: (unit -> string) list, 
-		    msg: unit -> string) =
-	 if debugFlg
-	    then let
-		    val msgs = List.map (fn f => f ()) msgs
-		    val msg = concat [String.concatWith " " msgs, " :: ", msg ()]
-		 in
-		    C.atomicBegin ();
-		    TextIO.print (concat [msg, "\n"]);
-		    C.atomicEnd ()
-		 end
-	    else ()
+                    msg: unit -> string) =
+         if debugFlg
+            then let
+                    val msgs = List.map (fn f => f ()) msgs
+                    val msg = concat [String.concatWith " " msgs, " :: ", msg ()]
+                 in
+                    C.atomicBegin ();
+                    TextIO.print (concat [msg, "\n"]);
+                    C.atomicEnd ()
+                 end
+            else ()
       fun sayDebug' (msg: string) = sayDebug ([], fn () => msg)
    end

Modified: mlton/branches/on-20050420-cmm-branch/lib/cml/util/fun-priority-queue.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/cml/util/fun-priority-queue.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/cml/util/fun-priority-queue.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -9,67 +9,67 @@
       open S
 
       structure Elt =
-	 struct
-	    datatype 'a t = T of Key.t * 'a
-	    fun key (T (k, _)) = k
-	    fun value (T (_, v)) = v
-	 end
+         struct
+            datatype 'a t = T of Key.t * 'a
+            fun key (T (k, _)) = k
+            fun value (T (_, v)) = v
+         end
 
       datatype 'a t = T of 'a Elt.t list
 
       local
-	 fun filterPrefix (xs, p) =
-	    case xs of
-	       [] => []
-	     | y::ys => if p y
-			  then filterPrefix (ys, p)
-			  else xs
-	 fun filter (xs, p) = List.filter (not o p) xs
+         fun filterPrefix (xs, p) =
+            case xs of
+               [] => []
+             | y::ys => if p y
+                          then filterPrefix (ys, p)
+                          else xs
+         fun filter (xs, p) = List.filter (not o p) xs
       in
-	 fun cleanPrefix (T xs, p) = T (filterPrefix (xs, p))
-	 fun clean (T xs, p) = T (filter (xs, p))
+         fun cleanPrefix (T xs, p) = T (filterPrefix (xs, p))
+         fun clean (T xs, p) = T (filter (xs, p))
       end
 
       fun deque (T xs) =
-	 (case xs of
-	     [] => NONE
-	   | x::xs => SOME (x, T xs))
+         (case xs of
+             [] => NONE
+           | x::xs => SOME (x, T xs))
 
       fun cleanAndDeque (q, p) =
-	 let
-	    val q = clean (q, p)
-	 in
-	    case deque q of
-	       NONE => (NONE, q)
-	     | SOME (x, q) => (SOME x, q)
-	 end
+         let
+            val q = clean (q, p)
+         in
+            case deque q of
+               NONE => (NONE, q)
+             | SOME (x, q) => (SOME x, q)
+         end
 
       fun empty (T xs) = 
-	 (case xs of 
-	     [] => true
-	   | _ => false)
+         (case xs of 
+             [] => true
+           | _ => false)
 
       fun enque (T xs, k', v') =
-	 let
-	    val x' = Elt.T (k', v')
-	    fun loop (xs, ys) =
-	       case xs of
-		  [] => List.revAppend(ys, [x'])
-		| (z as Elt.T (k, _))::zs => 
-		     (case Key.compare (k, k') of
-			 GREATER => List.revAppend(ys, x'::xs)
-		       | _ => loop(zs, z::ys))
-	 in
-	    T (loop (xs, []))
-	 end
+         let
+            val x' = Elt.T (k', v')
+            fun loop (xs, ys) =
+               case xs of
+                  [] => List.revAppend(ys, [x'])
+                | (z as Elt.T (k, _))::zs => 
+                     (case Key.compare (k, k') of
+                         GREATER => List.revAppend(ys, x'::xs)
+                       | _ => loop(zs, z::ys))
+         in
+            T (loop (xs, []))
+         end
 
       fun enqueAndClean (q, k, v, p) =
-	 clean (enque (q, k, v), p)
+         clean (enque (q, k, v), p)
 
       fun new () = T []
 
       fun peek (T xs) =
-	 (case xs of
-	     [] => NONE
-	   | elt::_ => SOME elt)
+         (case xs of
+             [] => NONE
+           | elt::_ => SOME elt)
    end

Modified: mlton/branches/on-20050420-cmm-branch/lib/cml/util/fun-priority-queue.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/cml/util/fun-priority-queue.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/cml/util/fun-priority-queue.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -6,10 +6,10 @@
 signature FUN_PRIORITY_QUEUE_ARG =
    sig
       structure Key :
-	 sig
-	    type t
-	    val compare : t * t -> order
-	 end
+         sig
+            type t
+            val compare : t * t -> order
+         end
    end
 
 signature FUN_PRIORITY_QUEUE =
@@ -17,11 +17,11 @@
       include FUN_PRIORITY_QUEUE_ARG
 
       structure Elt:
-	 sig
-	    type 'a t
-	    val key: 'a t -> Key.t
-	    val value: 'a t -> 'a
-	 end
+         sig
+            type 'a t
+            val key: 'a t -> Key.t
+            val value: 'a t -> 'a
+         end
 
       type 'a t
 

Modified: mlton/branches/on-20050420-cmm-branch/lib/cml/util/fun-queue.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/cml/util/fun-queue.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/cml/util/fun-queue.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -8,89 +8,89 @@
       datatype 'a t = T of {front: 'a list, back: 'a list}
 
       local
-	 fun filterPrefix (xs, p) =
-	    case xs of
-	       [] => []
-	     | y::ys => if p y
-			  then filterPrefix (ys, p)
-			  else xs
-	 fun filter (xs, p) = List.filter (not o p) xs
-	 fun filterRevAcc ((xs, zs), p) =
-	    case xs of
-	       [] => zs
-	     | y::ys => if p y
-			  then filterRevAcc ((ys, zs), p)
-			  else filterRevAcc ((ys, y::zs), p)
-	 fun filterRev (xs, p) = filterRevAcc ((xs, []), p)
+         fun filterPrefix (xs, p) =
+            case xs of
+               [] => []
+             | y::ys => if p y
+                          then filterPrefix (ys, p)
+                          else xs
+         fun filter (xs, p) = List.filter (not o p) xs
+         fun filterRevAcc ((xs, zs), p) =
+            case xs of
+               [] => zs
+             | y::ys => if p y
+                          then filterRevAcc ((ys, zs), p)
+                          else filterRevAcc ((ys, y::zs), p)
+         fun filterRev (xs, p) = filterRevAcc ((xs, []), p)
       in
-	 fun cleanPrefix (T {front, back}, p) =
-	    (case filterPrefix (front, p) of
-		[] => T {front = filterPrefix (List.rev(back), p),
-			 back = []}
-	      | front' =>  T {front = front',
-			      back = back})
-	 fun clean (T {front, back}, p) =
-	    (case filter (front, p) of
-		[] => T {front = filterRev (back, p),
-			 back = []}
-	      | front' =>  T {front = front',
-			      back = filter (back, p)})
-	 fun cleanAndDeque (T {front, back}, p) =
-	    (case filter (front, p) of
-		[] => (case filterRev(back, p) of
-			  [] => (NONE,
-				 T {front = [],
-				    back = []})
-			| x::front' => (SOME x,
-					T {front = front',
-					   back = []}))
-	      | [x] => (SOME x,
-			T {front = filterRev (back, p),
-			   back = []})
-	      | x::front' => (SOME x,
-			      T {front = front',
-				 back = filter (back, p)}))
+         fun cleanPrefix (T {front, back}, p) =
+            (case filterPrefix (front, p) of
+                [] => T {front = filterPrefix (List.rev(back), p),
+                         back = []}
+              | front' =>  T {front = front',
+                              back = back})
+         fun clean (T {front, back}, p) =
+            (case filter (front, p) of
+                [] => T {front = filterRev (back, p),
+                         back = []}
+              | front' =>  T {front = front',
+                              back = filter (back, p)})
+         fun cleanAndDeque (T {front, back}, p) =
+            (case filter (front, p) of
+                [] => (case filterRev(back, p) of
+                          [] => (NONE,
+                                 T {front = [],
+                                    back = []})
+                        | x::front' => (SOME x,
+                                        T {front = front',
+                                           back = []}))
+              | [x] => (SOME x,
+                        T {front = filterRev (back, p),
+                           back = []})
+              | x::front' => (SOME x,
+                              T {front = front',
+                                 back = filter (back, p)}))
       end
 
       fun deque (T {front, back}) =
-	 (case front of
-	     [] => (case back of
-		       [] => NONE
-		     | l => let val l = List.rev l
-			    in 
-			       case l of
-				  [] => raise Fail "FunQueue.deque:impossible"
-				| x::front' => 
-				     SOME (x,
-					   T {front = front',
-					      back = []})
-			    end)
-	   | x::front' => SOME (x, T {front = front', back = back}))
-			  
+         (case front of
+             [] => (case back of
+                       [] => NONE
+                     | l => let val l = List.rev l
+                            in 
+                               case l of
+                                  [] => raise Fail "FunQueue.deque:impossible"
+                                | x::front' => 
+                                     SOME (x,
+                                           T {front = front',
+                                              back = []})
+                            end)
+           | x::front' => SOME (x, T {front = front', back = back}))
+                          
       fun empty (T {front, back}) =
-	 (case front of
-	     [] => (case back of
-		       [] => true
-		     | _ => false)
-	   | _ => false)
-	     
+         (case front of
+             [] => (case back of
+                       [] => true
+                     | _ => false)
+           | _ => false)
+             
       fun enque (T {front, back, ...}, x) = 
-	 T {front = front, back = x::back}
+         T {front = front, back = x::back}
 
       fun enqueAndClean (q, y, p) =
-	 clean (enque (q, y), p)
+         clean (enque (q, y), p)
 
       fun new () = T {front = [], back = []}
 
       fun peek (T {front, back}) =
-	 (case front of
-	     [] => (case back of
-		       [] => NONE
-		     | l => let val l = List.rev l
-			    in 
-			       case l of
-				  [] => raise Fail "FunQueue.peek:impossible"
-				| x::_ => SOME x
-			    end)
-	   | x::_ => SOME x)
+         (case front of
+             [] => (case back of
+                       [] => NONE
+                     | l => let val l = List.rev l
+                            in 
+                               case l of
+                                  [] => raise Fail "FunQueue.peek:impossible"
+                                | x::_ => SOME x
+                            end)
+           | x::_ => SOME x)
    end

Modified: mlton/branches/on-20050420-cmm-branch/lib/cml/util/imp-queue.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/cml/util/imp-queue.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/cml/util/imp-queue.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -8,103 +8,103 @@
       datatype 'a t = T of {front: 'a list ref, back: 'a list ref}
 
       local
-	 fun filterPrefix (xs, p) =
-	    case xs of
-	       [] => []
-	     | y::ys => if p y
-			  then filterPrefix (ys, p)
-			  else xs
-	 fun filter (xs, p) = List.filter (not o p) xs
-	 fun filterRevAcc ((xs, zs), p) =
-	    case xs of
-	       [] => zs
-	     | y::ys => if p y
-			  then filterRevAcc ((ys, zs), p)
-			  else filterRevAcc ((ys, y::zs), p)
-	 fun filterRev (xs, p) = filterRevAcc ((xs, []), p)
+         fun filterPrefix (xs, p) =
+            case xs of
+               [] => []
+             | y::ys => if p y
+                          then filterPrefix (ys, p)
+                          else xs
+         fun filter (xs, p) = List.filter (not o p) xs
+         fun filterRevAcc ((xs, zs), p) =
+            case xs of
+               [] => zs
+             | y::ys => if p y
+                          then filterRevAcc ((ys, zs), p)
+                          else filterRevAcc ((ys, y::zs), p)
+         fun filterRev (xs, p) = filterRevAcc ((xs, []), p)
       in
-	 fun cleanPrefix (T {front, back}, p) =
-	    (Assert.assertAtomic' ("ImpQueue.cleanPrefix", NONE)
-	     ; case filterPrefix (!front, p) of
-	          [] => (front := filterPrefix (List.rev(!back), p)
-			 ; back := [])
-		| front' =>  front := front')
-	 fun clean (T {front, back}, p) =
-	    (Assert.assertAtomic' ("ImpQueue.clean", NONE)
-	     ; case filter (!front, p) of
-	          [] => (front := filterRev (!back, p)
-			 ; back := [])
-		| front' =>  (front := front'
-			      ; back := filter (!back, p)))
-	 fun cleanAndDeque (T {front, back}, p) =
-	    (Assert.assertAtomic' ("ImpQueue.cleanAndDeque", NONE)
-	     ; case filter (!front, p) of
-	          [] => (case filterRev(!back, p) of
-			    [] => (front := []
-				   ; back := []
-				   ; NONE)
-			  | x::front' => (front := front'
-					  ; back := []
-					  ; SOME x))
-		| [x] => (front := filterRev (!back, p)
-			  ; back := []
-			  ; SOME x)
-		| x::front' => (front := front'
-				; back := filter (!back, p)
-				; SOME x))
+         fun cleanPrefix (T {front, back}, p) =
+            (Assert.assertAtomic' ("ImpQueue.cleanPrefix", NONE)
+             ; case filterPrefix (!front, p) of
+                  [] => (front := filterPrefix (List.rev(!back), p)
+                         ; back := [])
+                | front' =>  front := front')
+         fun clean (T {front, back}, p) =
+            (Assert.assertAtomic' ("ImpQueue.clean", NONE)
+             ; case filter (!front, p) of
+                  [] => (front := filterRev (!back, p)
+                         ; back := [])
+                | front' =>  (front := front'
+                              ; back := filter (!back, p)))
+         fun cleanAndDeque (T {front, back}, p) =
+            (Assert.assertAtomic' ("ImpQueue.cleanAndDeque", NONE)
+             ; case filter (!front, p) of
+                  [] => (case filterRev(!back, p) of
+                            [] => (front := []
+                                   ; back := []
+                                   ; NONE)
+                          | x::front' => (front := front'
+                                          ; back := []
+                                          ; SOME x))
+                | [x] => (front := filterRev (!back, p)
+                          ; back := []
+                          ; SOME x)
+                | x::front' => (front := front'
+                                ; back := filter (!back, p)
+                                ; SOME x))
       end
 
       fun deque (T {front, back}) =
-	 (Assert.assertAtomic' ("ImpQueue.deque", NONE)
-	  ; case !front of
-	       [] => (case !back of
-			 [] => NONE
-		       | l => let val l = List.rev l
-			      in case l of
-				    [] => raise Fail "ImpQueue.deque:impossible"
-				  | x :: front' => 
-				       (front := front'
-					; back := []
-					; SOME x)
-			      end)
-	     | x::front' => (front := front'; SOME x))
+         (Assert.assertAtomic' ("ImpQueue.deque", NONE)
+          ; case !front of
+               [] => (case !back of
+                         [] => NONE
+                       | l => let val l = List.rev l
+                              in case l of
+                                    [] => raise Fail "ImpQueue.deque:impossible"
+                                  | x :: front' => 
+                                       (front := front'
+                                        ; back := []
+                                        ; SOME x)
+                              end)
+             | x::front' => (front := front'; SOME x))
 
       fun empty (T {front, back}) =
-	 (Assert.assertAtomic' ("ImpQueue.empty", NONE)
-	  ; case !front of
-	       [] => (case !back of
-			 [] => true
-		       | _ => false)
-	     | _ => false)
-	     
+         (Assert.assertAtomic' ("ImpQueue.empty", NONE)
+          ; case !front of
+               [] => (case !back of
+                         [] => true
+                       | _ => false)
+             | _ => false)
+             
       fun enque (T {back, ...}, x) = 
-	 (Assert.assertAtomic' ("ImpQueue.enque", NONE)
-	  ; back := x::(!back))
+         (Assert.assertAtomic' ("ImpQueue.enque", NONE)
+          ; back := x::(!back))
 
       fun enqueAndClean (q, y, p) =
-	 (enque (q, y); clean (q, p))
+         (enque (q, y); clean (q, p))
 
       fun new () = T {front = ref [], back = ref []}
 
       fun peek (T {front, back}) =
-	 (Assert.assertAtomic' ("ImpQueue.peek", NONE)
-	  ; case !front of
-	       [] => (case !back of
-			 [] => NONE
-		       | l => let val l = List.rev l
-			      in case l of
-				    [] => raise Fail "ImpQueue.peek:impossible"
-				  | x::front' => 
-				       (front := x::front'
-					; back := []
-					; SOME x)
-			      end)
-	     | x::_ => SOME x)
+         (Assert.assertAtomic' ("ImpQueue.peek", NONE)
+          ; case !front of
+               [] => (case !back of
+                         [] => NONE
+                       | l => let val l = List.rev l
+                              in case l of
+                                    [] => raise Fail "ImpQueue.peek:impossible"
+                                  | x::front' => 
+                                       (front := x::front'
+                                        ; back := []
+                                        ; SOME x)
+                              end)
+             | x::_ => SOME x)
 
       fun reset (T {front, back}) =
-	 (Assert.assertAtomic' ("ImpQueue.reset", NONE)
-	  ; front := []
-	  ; back := [])
+         (Assert.assertAtomic' ("ImpQueue.reset", NONE)
+          ; front := []
+          ; back := [])
 
 (*
       val clean = fn arg => TimeIt.timeit "ImpQueue.clean" clean arg

Modified: mlton/branches/on-20050420-cmm-branch/lib/cml/util/local-assert.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/cml/util/local-assert.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/cml/util/local-assert.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -6,7 +6,7 @@
 functor LocalAssert(val assert: bool): ASSERT =
    struct
       fun make f =
-	 if assert then f else fn _ => ()
+         if assert then f else fn _ => ()
       val assert = make Assert.assert
       val assert' = make Assert.assert'
       val assertAtomic = make Assert.assertAtomic

Modified: mlton/branches/on-20050420-cmm-branch/lib/cml/util/local-debug.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/cml/util/local-debug.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/cml/util/local-debug.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -6,7 +6,7 @@
 functor LocalDebug(val debug: bool): DEBUG =
    struct
       fun make f =
-	 if debug then f else fn _ => ()
+         if debug then f else fn _ => ()
       val sayDebug' = make Debug.sayDebug'
       val sayDebug = make Debug.sayDebug
    end
\ No newline at end of file

Modified: mlton/branches/on-20050420-cmm-branch/lib/cml/util/timeit.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/cml/util/timeit.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/cml/util/timeit.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -8,23 +8,23 @@
       val timeitFlg = true
 
       fun timeit (name: string) (f: 'a -> 'b) (a: 'a) : 'b =
-	 if timeitFlg 
-	    then let
-		    val start = Time.now ()
-		    fun done () =
-		       let
-			  val finish = Time.now ()
-			  val diff = Time.-(finish, start)
-		       in
-			  Debug.sayDebug 
-			  ([], fn () =>
-			   concat [name, ": ",
-				   LargeInt.toString (Time.toMilliseconds diff),
-				   " ms"])
-		       end
-		 in
-		    (f a before done ())
-		    handle e => (done (); raise e)
-		 end
-	    else f a
+         if timeitFlg 
+            then let
+                    val start = Time.now ()
+                    fun done () =
+                       let
+                          val finish = Time.now ()
+                          val diff = Time.-(finish, start)
+                       in
+                          Debug.sayDebug 
+                          ([], fn () =>
+                           concat [name, ": ",
+                                   LargeInt.toString (Time.toMilliseconds diff),
+                                   " ms"])
+                       end
+                 in
+                    (f a before done ())
+                    handle e => (done (); raise e)
+                 end
+            else f a
    end

Modified: mlton/branches/on-20050420-cmm-branch/lib/cml/util/util.mlb
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/cml/util/util.mlb	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/cml/util/util.mlb	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,49 +1,49 @@
 ann
-  "sequenceUnit true"
-  "warnMatch true"
-  "warnUnused true" "forceUsed"
+   "sequenceNonUnit warn"
+   "nonexhaustiveMatch warn" "redundantMatch warn"
+   "warnUnused true" "forceUsed"
 in
-local
-  $(SML_LIB)/basis/basis.mlb
-  $(SML_LIB)/basis/mlton.mlb
-  critical.sig
-  critical.sml
-  assert.sig
-  assert.sml
-  local-assert.fun
-  debug.sig
-  debug.sml
-  local-debug.fun
-(*
-  timeit.sig
-  timeit.sml
-*)
-  fun-queue.sig
-  fun-queue.sml
-  imp-queue.sig
-  imp-queue.sml
-  fun-priority-queue.sig
-  fun-priority-queue.fun
-in
-  signature CRITICAL
-  structure Critical
+   local
+      $(SML_LIB)/basis/basis.mlb
+      $(SML_LIB)/basis/mlton.mlb
+      critical.sig
+      critical.sml
+      assert.sig
+      assert.sml
+      local-assert.fun
+      debug.sig
+      debug.sml
+      local-debug.fun
+      (*
+      timeit.sig
+      timeit.sml
+       *)
+      fun-queue.sig
+      fun-queue.sml
+      imp-queue.sig
+      imp-queue.sml
+      fun-priority-queue.sig
+      fun-priority-queue.fun
+   in
+      signature CRITICAL
+      structure Critical
 
-  signature ASSERT
-  structure Assert
-  functor LocalAssert
+      signature ASSERT
+      structure Assert
+      functor LocalAssert
 
-  signature DEBUG
-  structure Debug
-  functor LocalDebug
+      signature DEBUG
+      structure Debug
+      functor LocalDebug
 
-  signature FUN_QUEUE
-  structure FunQueue
+      signature FUN_QUEUE
+      structure FunQueue
 
-  signature IMP_QUEUE
-  structure ImpQueue
+      signature IMP_QUEUE
+      structure ImpQueue
 
-  signature FUN_PRIORITY_QUEUE_ARG
-  signature FUN_PRIORITY_QUEUE
-  functor FunPriorityQueue
+      signature FUN_PRIORITY_QUEUE_ARG
+      signature FUN_PRIORITY_QUEUE
+      functor FunPriorityQueue
+   end
 end
-end

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlnlffi/c.mlb
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlnlffi/c.mlb	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlnlffi/c.mlb	2006-02-16 19:34:54 UTC (rev 4361)
@@ -3,4 +3,32 @@
  *  Adapted for MLton.
  *)
 
-c.x86-unix.mlb
\ No newline at end of file
+(*
+ * A new foreign-function interface for SML.
+ *   This interface is actually an interface to C.  It is based on
+ *   an encoding of C's type system in ML.
+ *   This library is a helper library for use by automatically generated
+ *   code.  (An auxiliary tool produces this code directly from C code.)
+ *
+ *   (C) 2001, Lucent Technologies, Bell Laboratories
+ *
+ * author: Matthias Blume (blume@research.bell-labs.com)
+ *)
+local
+   internals/c-int.mlb
+in
+   structure Tag
+
+   structure MLRep
+
+   signature C
+   structure C
+   signature C_DEBUG
+   structure C_Debug
+
+   signature ZSTRING
+   structure ZString
+
+   signature DYN_LINKAGE
+   structure DynLinkage
+end

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlnlffi/c.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlnlffi/c.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlnlffi/c.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -54,8 +54,8 @@
      *     look like in practice)
      *)
     (* pointer to 'o *)
-    type 'o ptr	
-    (* light-weight alternative *)			
+    type 'o ptr 
+    (* light-weight alternative *)                      
     eqtype 'o ptr'
 
     (* 'n-sized array with 't elements *)
@@ -98,35 +98,35 @@
      * (this shouldn't be needed except when calling functions through
      * function pointers) *)
     structure Cvt : sig
-	(* ML -> C *)
-	val c_schar     : MLRep.Char.Signed.int        -> schar
-	val c_uchar     : MLRep.Char.Unsigned.word     -> uchar
-	val c_sshort    : MLRep.Short.Signed.int       -> sshort
-	val c_ushort    : MLRep.Short.Unsigned.word    -> ushort
-	val c_sint      : MLRep.Int.Signed.int         -> sint
-	val c_uint      : MLRep.Int.Unsigned.word      -> uint
-	val c_slong     : MLRep.Long.Signed.int        -> slong
-	val c_ulong     : MLRep.Long.Unsigned.word     -> ulong
-	val c_slonglong : MLRep.LongLong.Signed.int    -> slonglong
-	val c_ulonglong : MLRep.LongLong.Unsigned.word -> ulonglong
-	val c_float     : MLRep.Float.real             -> float
-	val c_double    : MLRep.Double.real            -> double
-	val i2c_enum    : MLRep.Int.Signed.int         -> 'e enum
+        (* ML -> C *)
+        val c_schar     : MLRep.Char.Signed.int        -> schar
+        val c_uchar     : MLRep.Char.Unsigned.word     -> uchar
+        val c_sshort    : MLRep.Short.Signed.int       -> sshort
+        val c_ushort    : MLRep.Short.Unsigned.word    -> ushort
+        val c_sint      : MLRep.Int.Signed.int         -> sint
+        val c_uint      : MLRep.Int.Unsigned.word      -> uint
+        val c_slong     : MLRep.Long.Signed.int        -> slong
+        val c_ulong     : MLRep.Long.Unsigned.word     -> ulong
+        val c_slonglong : MLRep.LongLong.Signed.int    -> slonglong
+        val c_ulonglong : MLRep.LongLong.Unsigned.word -> ulonglong
+        val c_float     : MLRep.Float.real             -> float
+        val c_double    : MLRep.Double.real            -> double
+        val i2c_enum    : MLRep.Int.Signed.int         -> 'e enum
 
-	(* C -> ML *)
-	val ml_schar     : schar      -> MLRep.Char.Signed.int
-	val ml_uchar     : uchar      -> MLRep.Char.Unsigned.word
-	val ml_sshort    : sshort     -> MLRep.Short.Signed.int
-	val ml_ushort    : ushort     -> MLRep.Short.Unsigned.word
-	val ml_sint      : sint       -> MLRep.Int.Signed.int
-	val ml_uint      : uint       -> MLRep.Int.Unsigned.word
-	val ml_slong     : slong      -> MLRep.Long.Signed.int
-	val ml_ulong     : ulong      -> MLRep.Long.Unsigned.word
-	val ml_slonglong : slonglong  -> MLRep.LongLong.Signed.int
-	val ml_ulonglong : ulonglong  -> MLRep.LongLong.Unsigned.word
-	val ml_float     : float      -> MLRep.Float.real
-	val ml_double    : double     -> MLRep.Double.real
-	val c2i_enum     : 'e enum    -> MLRep.Int.Signed.int
+        (* C -> ML *)
+        val ml_schar     : schar      -> MLRep.Char.Signed.int
+        val ml_uchar     : uchar      -> MLRep.Char.Unsigned.word
+        val ml_sshort    : sshort     -> MLRep.Short.Signed.int
+        val ml_ushort    : ushort     -> MLRep.Short.Unsigned.word
+        val ml_sint      : sint       -> MLRep.Int.Signed.int
+        val ml_uint      : uint       -> MLRep.Int.Unsigned.word
+        val ml_slong     : slong      -> MLRep.Long.Signed.int
+        val ml_ulong     : ulong      -> MLRep.Long.Unsigned.word
+        val ml_slonglong : slonglong  -> MLRep.LongLong.Signed.int
+        val ml_ulonglong : ulonglong  -> MLRep.LongLong.Unsigned.word
+        val ml_float     : float      -> MLRep.Float.real
+        val ml_double    : double     -> MLRep.Double.real
+        val c2i_enum     : 'e enum    -> MLRep.Int.Signed.int
     end
 
     (* type-abbreviations for a bit more convenience. *)
@@ -169,37 +169,37 @@
     eqtype 'c sbf and 'c ubf
 
     structure W : sig
-	(* conversion "witness" values *)
-	type ('from, 'to) witness
-	
-	(* A small calculus for generating new witnesses.
-	 * Since the only witness constructors that do anything real are
-	 * rw and ro, all this calculus gives you is a way of changing
-	 * "const" attributes at any level within a bigger type.
-	 *
-	 * (The calculus can express nonsensical witnesses -- which
-	 * fortunately are harmless because they can't be applied to any
-	 * values.) *)
-	val trivial : ('t, 't) witness
+        (* conversion "witness" values *)
+        type ('from, 'to) witness
+        
+        (* A small calculus for generating new witnesses.
+         * Since the only witness constructors that do anything real are
+         * rw and ro, all this calculus gives you is a way of changing
+         * "const" attributes at any level within a bigger type.
+         *
+         * (The calculus can express nonsensical witnesses -- which
+         * fortunately are harmless because they can't be applied to any
+         * values.) *)
+        val trivial : ('t, 't) witness
 
-	val pointer : ('from, 'to) witness ->
-		      ('from ptr, 'to ptr) witness
-	val object  : ('from, 'to) witness ->
-		      (('from, 'c) obj, ('to, 'c) obj) witness
-	val arr     : ('from, 'to) witness ->
-		      (('from, 'n) arr, ('to, 'n) arr) witness
+        val pointer : ('from, 'to) witness ->
+                      ('from ptr, 'to ptr) witness
+        val object  : ('from, 'to) witness ->
+                      (('from, 'c) obj, ('to, 'c) obj) witness
+        val arr     : ('from, 'to) witness ->
+                      (('from, 'n) arr, ('to, 'n) arr) witness
 
-	val ro      : ('from, 'to) witness ->
-		      (('from, 'fc) obj, ('to, ro) obj) witness
-	val rw      : ('from, 'to) witness ->
-		      (('from, 'fc) obj, ('to, 'tc) obj) witness
+        val ro      : ('from, 'to) witness ->
+                      (('from, 'fc) obj, ('to, ro) obj) witness
+        val rw      : ('from, 'to) witness ->
+                      (('from, 'fc) obj, ('to, 'tc) obj) witness
     end
 
     (* Object conversions that rely on witnesses: *)
     val convert : (('st, 'sc) obj, ('tt, 'tc) obj) W.witness ->
-		  ('st, 'sc) obj -> ('tt, 'tc) obj
+                  ('st, 'sc) obj -> ('tt, 'tc) obj
     val convert' : (('st, 'sc) obj, ('tt, 'tc) obj) W.witness ->
-		   ('st, 'sc) obj' -> ('tt, 'tc) obj'
+                   ('st, 'sc) obj' -> ('tt, 'tc) obj'
 
     (* 
      * A family of types and corresponding values representing natural numbers.
@@ -207,169 +207,169 @@
      *)
     structure Dim : sig
 
-	(* Internally, a value of type ('a, 'z) dim0 is just a number.
-	 * The trick here is to give each of these numbers a different unique
-	 * type. 'a will be a decimal encoding of the number's value in
-	 * "type digits". 'z keeps track of whether the number is zero or not. 
-	 *)
-	type ('a, 'z) dim0
+        (* Internally, a value of type ('a, 'z) dim0 is just a number.
+         * The trick here is to give each of these numbers a different unique
+         * type. 'a will be a decimal encoding of the number's value in
+         * "type digits". 'z keeps track of whether the number is zero or not. 
+         *)
+        type ('a, 'z) dim0
 
-	(* We can always get the internal number back... *)
-	val toInt : ('a, 'z) dim0 -> int
+        (* We can always get the internal number back... *)
+        val toInt : ('a, 'z) dim0 -> int
 
-	(* These two types act as "flags". They will be substituted for 'z
-	 * and remember whether the value is zero or not. *)
-	type zero
-	type nonzero
+        (* These two types act as "flags". They will be substituted for 'z
+         * and remember whether the value is zero or not. *)
+        type zero
+        type nonzero
 
-	type 'a dim = ('a, nonzero) dim0
+        type 'a dim = ('a, nonzero) dim0
 
-	(* These are the "type digits".  Type "dec" acts as a "terminator".
-	 * We chose its name so to remind us that the encoding is decimal.
-	 * If a nonzero value's decimal representation is "<Dn>...<D0>", then
-	 * its type will be "(dec dg<Dn> ... dg<D0>, nonzero) dim0", which
-	 * is the same as "dec dg<Dn> ... dg<D0> dim".  The type of the zero
-	 * value is "(dec, zero) dim0". *)
-	type dec
-	type 'a dg0 and 'a dg1 and 'a dg2 and 'a dg3 and 'a dg4
-	type 'a dg5 and 'a dg6 and 'a dg7 and 'a dg8 and 'a dg9
+        (* These are the "type digits".  Type "dec" acts as a "terminator".
+         * We chose its name so to remind us that the encoding is decimal.
+         * If a nonzero value's decimal representation is "<Dn>...<D0>", then
+         * its type will be "(dec dg<Dn> ... dg<D0>, nonzero) dim0", which
+         * is the same as "dec dg<Dn> ... dg<D0> dim".  The type of the zero
+         * value is "(dec, zero) dim0". *)
+        type dec
+        type 'a dg0 and 'a dg1 and 'a dg2 and 'a dg3 and 'a dg4
+        type 'a dg5 and 'a dg6 and 'a dg7 and 'a dg8 and 'a dg9
 
-	(* Here are the corresponding constructors for ('a, 'z) dim0 values.
-	 * The type for dg0 ensures that there will be no "leading zeros" in
-	 * any encoding.  This guarantees a 1-1 correspondence of constructable
-	 * values and their types.
-	 * To construct the value corresponding to a nonzero number whose
-	 * decimal representation is "<Dn>...<D0>", one must invoke
-	 * "dg<D0>' (... (dg<Dn>' dec')...)", i.e., the least significant
-	 * digit appears leftmost. *)
-	val dec' :            (dec, zero) dim0
-	val dg0' : 'a dim        -> 'a dg0 dim
-	val dg1' : ('a, 'z) dim0 -> 'a dg1 dim
-	val dg2' : ('a, 'z) dim0 -> 'a dg2 dim
-	val dg3' : ('a, 'z) dim0 -> 'a dg3 dim
-	val dg4' : ('a, 'z) dim0 -> 'a dg4 dim
-	val dg5' : ('a, 'z) dim0 -> 'a dg5 dim
-	val dg6' : ('a, 'z) dim0 -> 'a dg6 dim
-	val dg7' : ('a, 'z) dim0 -> 'a dg7 dim
-	val dg8' : ('a, 'z) dim0 -> 'a dg8 dim
-	val dg9' : ('a, 'z) dim0 -> 'a dg9 dim
+        (* Here are the corresponding constructors for ('a, 'z) dim0 values.
+         * The type for dg0 ensures that there will be no "leading zeros" in
+         * any encoding.  This guarantees a 1-1 correspondence of constructable
+         * values and their types.
+         * To construct the value corresponding to a nonzero number whose
+         * decimal representation is "<Dn>...<D0>", one must invoke
+         * "dg<D0>' (... (dg<Dn>' dec')...)", i.e., the least significant
+         * digit appears leftmost. *)
+        val dec' :            (dec, zero) dim0
+        val dg0' : 'a dim        -> 'a dg0 dim
+        val dg1' : ('a, 'z) dim0 -> 'a dg1 dim
+        val dg2' : ('a, 'z) dim0 -> 'a dg2 dim
+        val dg3' : ('a, 'z) dim0 -> 'a dg3 dim
+        val dg4' : ('a, 'z) dim0 -> 'a dg4 dim
+        val dg5' : ('a, 'z) dim0 -> 'a dg5 dim
+        val dg6' : ('a, 'z) dim0 -> 'a dg6 dim
+        val dg7' : ('a, 'z) dim0 -> 'a dg7 dim
+        val dg8' : ('a, 'z) dim0 -> 'a dg8 dim
+        val dg9' : ('a, 'z) dim0 -> 'a dg9 dim
 
-	(* Since having to reverse the sequence of digits seems unnatural,
-	 * here is another set of constructors for dim values.  These
-	 * constructors use continuation-passing style and themselves
-	 * have more complicated types.  But their use is easier:
-	 * To construct the value corresponding to a nonzero number whose
-	 * decimal representation is "<Dn>...<D0>", one must invoke
-	 * "dec dg<Dn> ... dg<D0> dim"; i.e., the least significant
-	 * digit appears rightmost -- just like in the usual decimal
-	 * notation for numbers that we are all familiar with.
-	 * [Moreover, for any 'a dim value we have the neat property that
-	 * it can be constructed by taking its type (expressed using "dim")
-	 * and interpreting it as an expression.  For example, the dim
-	 * value representing 312 is "dec dg3 dg1 dg2 dim" and it can
-	 * be constructed by evaluating "dec dg3 dg1 dg2 dim".] *)
-	val dec :            ((dec, zero) dim0 -> 'b) -> 'b
+        (* Since having to reverse the sequence of digits seems unnatural,
+         * here is another set of constructors for dim values.  These
+         * constructors use continuation-passing style and themselves
+         * have more complicated types.  But their use is easier:
+         * To construct the value corresponding to a nonzero number whose
+         * decimal representation is "<Dn>...<D0>", one must invoke
+         * "dec dg<Dn> ... dg<D0> dim"; i.e., the least significant
+         * digit appears rightmost -- just like in the usual decimal
+         * notation for numbers that we are all familiar with.
+         * [Moreover, for any 'a dim value we have the neat property that
+         * it can be constructed by taking its type (expressed using "dim")
+         * and interpreting it as an expression.  For example, the dim
+         * value representing 312 is "dec dg3 dg1 dg2 dim" and it can
+         * be constructed by evaluating "dec dg3 dg1 dg2 dim".] *)
+        val dec :            ((dec, zero) dim0 -> 'b) -> 'b
 
-	val dg0 : 'a dim        -> ('a dg0 dim -> 'b) -> 'b
-	val dg1 : ('a, 'z) dim0 -> ('a dg1 dim -> 'b) -> 'b
-	val dg2 : ('a, 'z) dim0 -> ('a dg2 dim -> 'b) -> 'b
-	val dg3 : ('a, 'z) dim0 -> ('a dg3 dim -> 'b) -> 'b
-	val dg4 : ('a, 'z) dim0 -> ('a dg4 dim -> 'b) -> 'b
-	val dg5 : ('a, 'z) dim0 -> ('a dg5 dim -> 'b) -> 'b
-	val dg6 : ('a, 'z) dim0 -> ('a dg6 dim -> 'b) -> 'b
-	val dg7 : ('a, 'z) dim0 -> ('a dg7 dim -> 'b) -> 'b
-	val dg8 : ('a, 'z) dim0 -> ('a dg8 dim -> 'b) -> 'b
-	val dg9 : ('a, 'z) dim0 -> ('a dg9 dim -> 'b) -> 'b
+        val dg0 : 'a dim        -> ('a dg0 dim -> 'b) -> 'b
+        val dg1 : ('a, 'z) dim0 -> ('a dg1 dim -> 'b) -> 'b
+        val dg2 : ('a, 'z) dim0 -> ('a dg2 dim -> 'b) -> 'b
+        val dg3 : ('a, 'z) dim0 -> ('a dg3 dim -> 'b) -> 'b
+        val dg4 : ('a, 'z) dim0 -> ('a dg4 dim -> 'b) -> 'b
+        val dg5 : ('a, 'z) dim0 -> ('a dg5 dim -> 'b) -> 'b
+        val dg6 : ('a, 'z) dim0 -> ('a dg6 dim -> 'b) -> 'b
+        val dg7 : ('a, 'z) dim0 -> ('a dg7 dim -> 'b) -> 'b
+        val dg8 : ('a, 'z) dim0 -> ('a dg8 dim -> 'b) -> 'b
+        val dg9 : ('a, 'z) dim0 -> ('a dg9 dim -> 'b) -> 'b
 
-	val dim : ('a, 'z) dim0 -> ('a, 'z) dim0
+        val dim : ('a, 'z) dim0 -> ('a, 'z) dim0
     end
 
     (* sub-structure for dealing with run-time type info (sizes only) *)
     structure S : sig
 
-	(* Our size info itself is statically typed!
-	 * The size info for a value stored in ('t, 'c) obj has
-	 * the following type: *)
-	type 't size
+        (* Our size info itself is statically typed!
+         * The size info for a value stored in ('t, 'c) obj has
+         * the following type: *)
+        type 't size
 
-	(* get a number out *)
-	val toWord : 't size -> word
+        (* get a number out *)
+        val toWord : 't size -> word
 
-	(* sizes for simple things *)
-	val schar     : schar size
-	val uchar     : uchar size
-	val sshort    : sshort size
-	val ushort    : ushort size
-	val sint      : sint size
-	val uint      : uint size
-	val slong     : slong size
-	val ulong     : ulong size
-	val slonglong : slonglong size
-	val ulonglong : ulonglong size
-	val float     : float size
-	val double    : double size
+        (* sizes for simple things *)
+        val schar     : schar size
+        val uchar     : uchar size
+        val sshort    : sshort size
+        val ushort    : ushort size
+        val sint      : sint size
+        val uint      : uint size
+        val slong     : slong size
+        val ulong     : ulong size
+        val slonglong : slonglong size
+        val ulonglong : ulonglong size
+        val float     : float size
+        val double    : double size
 
-	val voidptr : voidptr size
-	val ptr : 'o ptr size
-	val fptr : 'f fptr size
-	val enum : 'tag enum size
+        val voidptr : voidptr size
+        val ptr : 'o ptr size
+        val fptr : 'f fptr size
+        val enum : 'tag enum size
     end
 
     (* sub-structure for dealing with run-time type info *)
     structure T : sig
 
-	(* Our RTTI itself is statically typed!
-	 * The RTTI for a value stored in ('t, 'c) obj has
-	 * the following type: *)
-	type 't typ
+        (* Our RTTI itself is statically typed!
+         * The RTTI for a value stored in ('t, 'c) obj has
+         * the following type: *)
+        type 't typ
 
-	(* get the RTTI from an actual object *)
-	val typeof : ('t, 'c) obj -> 't typ
+        (* get the RTTI from an actual object *)
+        val typeof : ('t, 'c) obj -> 't typ
 
-	(* constructing new RTTI from existing RTTI *)
-	val pointer : 't typ -> ('t, rw) obj ptr typ
-	val target  : ('t, 'c) obj ptr typ -> 't typ
-	val arr     : 't typ * 'n Dim.dim -> ('t, 'n) arr typ
-	val elem    : ('t, 'n) arr typ -> 't typ
-	val ro      : ('t, 'c) obj ptr typ -> ('t, ro) obj ptr typ
+        (* constructing new RTTI from existing RTTI *)
+        val pointer : 't typ -> ('t, rw) obj ptr typ
+        val target  : ('t, 'c) obj ptr typ -> 't typ
+        val arr     : 't typ * 'n Dim.dim -> ('t, 'n) arr typ
+        val elem    : ('t, 'n) arr typ -> 't typ
+        val ro      : ('t, 'c) obj ptr typ -> ('t, ro) obj ptr typ
 
-	(* calculating the size of an object given its RTTI *)
-	val sizeof : 't typ -> 't S.size
+        (* calculating the size of an object given its RTTI *)
+        val sizeof : 't typ -> 't S.size
 
-	(* dimension of array type *)
-	val dim : ('t, 'n) arr typ -> 'n Dim.dim
+        (* dimension of array type *)
+        val dim : ('t, 'n) arr typ -> 'n Dim.dim
                      
-	(* RTTI for simple things *)
-	val schar     :     schar typ
-	val uchar     :     uchar typ
-	val sshort    :    sshort typ
-	val ushort    :    ushort typ
-	val sint      :      sint typ
-	val uint      :      uint typ
-	val slong     :     slong typ
-	val ulong     :     ulong typ
-	val slonglong : slonglong typ
-	val ulonglong : ulonglong typ
-	val float     :     float typ
-	val double    :    double typ
+        (* RTTI for simple things *)
+        val schar     :     schar typ
+        val uchar     :     uchar typ
+        val sshort    :    sshort typ
+        val ushort    :    ushort typ
+        val sint      :      sint typ
+        val uint      :      uint typ
+        val slong     :     slong typ
+        val ulong     :     ulong typ
+        val slonglong : slonglong typ
+        val ulonglong : ulonglong typ
+        val float     :     float typ
+        val double    :    double typ
 
-	val voidptr : voidptr typ
+        val voidptr : voidptr typ
 
-	val enum : 'tag enum typ
+        val enum : 'tag enum typ
     end
 
     (* convert from regular (heavy) to alternative (light) versions *)
     structure Light : sig
-	val obj : ('t, 'c) obj -> ('t, 'c) obj'
-	val ptr : 'o ptr -> 'o ptr'
-	val fptr : 'f fptr -> 'f fptr'
+        val obj : ('t, 'c) obj -> ('t, 'c) obj'
+        val ptr : 'o ptr -> 'o ptr'
+        val fptr : 'f fptr -> 'f fptr'
     end
 
     (* and vice versa *)
     structure Heavy : sig
-	val obj : 't T.typ -> ('t, 'c) obj' -> ('t, 'c) obj
-	val ptr : 'o ptr T.typ -> 'o ptr' -> 'o ptr
-	val fptr : 'f fptr T.typ  -> 'f fptr' -> 'f fptr
+        val obj : 't T.typ -> ('t, 'c) obj' -> ('t, 'c) obj
+        val ptr : 'o ptr T.typ -> 'o ptr' -> 'o ptr
+        val fptr : 'f fptr T.typ  -> 'f fptr' -> 'f fptr
     end
 
     (* calculate size of an object *)
@@ -378,104 +378,104 @@
     (* "fetch" methods for various types;
      * fetching does not care about constness *)
     structure Get : sig
-	(* primitive types; the results are concrete here *)
-	val schar     : 'c schar_obj      -> MLRep.Char.Signed.int
-	val uchar     : 'c uchar_obj      -> MLRep.Char.Unsigned.word
-	val sshort    : 'c sshort_obj     -> MLRep.Short.Signed.int
-	val ushort    : 'c ushort_obj     -> MLRep.Short.Unsigned.word
-	val sint      : 'c sint_obj       -> MLRep.Int.Signed.int
-	val uint      : 'c uint_obj       -> MLRep.Int.Unsigned.word
-	val slong     : 'c slong_obj      -> MLRep.Long.Signed.int
-	val ulong     : 'c ulong_obj      -> MLRep.Long.Unsigned.word
-	val slonglong : 'c slonglong_obj  -> MLRep.LongLong.Signed.int
-	val ulonglong : 'c ulonglong_obj  -> MLRep.LongLong.Unsigned.word
-	val float     : 'c float_obj      -> MLRep.Float.real
-	val double    : 'c double_obj     -> MLRep.Double.real
-	val enum      : ('e, 'c) enum_obj -> MLRep.Int.Signed.int
+        (* primitive types; the results are concrete here *)
+        val schar     : 'c schar_obj      -> MLRep.Char.Signed.int
+        val uchar     : 'c uchar_obj      -> MLRep.Char.Unsigned.word
+        val sshort    : 'c sshort_obj     -> MLRep.Short.Signed.int
+        val ushort    : 'c ushort_obj     -> MLRep.Short.Unsigned.word
+        val sint      : 'c sint_obj       -> MLRep.Int.Signed.int
+        val uint      : 'c uint_obj       -> MLRep.Int.Unsigned.word
+        val slong     : 'c slong_obj      -> MLRep.Long.Signed.int
+        val ulong     : 'c ulong_obj      -> MLRep.Long.Unsigned.word
+        val slonglong : 'c slonglong_obj  -> MLRep.LongLong.Signed.int
+        val ulonglong : 'c ulonglong_obj  -> MLRep.LongLong.Unsigned.word
+        val float     : 'c float_obj      -> MLRep.Float.real
+        val double    : 'c double_obj     -> MLRep.Double.real
+        val enum      : ('e, 'c) enum_obj -> MLRep.Int.Signed.int
 
-	(* alt *)
-	val schar'     : 'c schar_obj'      -> MLRep.Char.Signed.int
-	val uchar'     : 'c uchar_obj'      -> MLRep.Char.Unsigned.word
-	val sshort'    : 'c sshort_obj'     -> MLRep.Short.Signed.int
-	val ushort'    : 'c ushort_obj'     -> MLRep.Short.Unsigned.word
-	val sint'      : 'c sint_obj'       -> MLRep.Int.Signed.int
-	val uint'      : 'c uint_obj'       -> MLRep.Int.Unsigned.word
-	val slong'     : 'c slong_obj'      -> MLRep.Long.Signed.int
-	val ulong'     : 'c ulong_obj'      -> MLRep.Long.Unsigned.word
-	val slonglong' : 'c slonglong_obj'  -> MLRep.LongLong.Signed.int
-	val ulonglong' : 'c ulonglong_obj'  -> MLRep.LongLong.Unsigned.word
-	val float'     : 'c float_obj'      -> MLRep.Float.real
-	val double'    : 'c double_obj'     -> MLRep.Double.real
-	val enum'      : ('e, 'c) enum_obj' -> MLRep.Int.Signed.int
+        (* alt *)
+        val schar'     : 'c schar_obj'      -> MLRep.Char.Signed.int
+        val uchar'     : 'c uchar_obj'      -> MLRep.Char.Unsigned.word
+        val sshort'    : 'c sshort_obj'     -> MLRep.Short.Signed.int
+        val ushort'    : 'c ushort_obj'     -> MLRep.Short.Unsigned.word
+        val sint'      : 'c sint_obj'       -> MLRep.Int.Signed.int
+        val uint'      : 'c uint_obj'       -> MLRep.Int.Unsigned.word
+        val slong'     : 'c slong_obj'      -> MLRep.Long.Signed.int
+        val ulong'     : 'c ulong_obj'      -> MLRep.Long.Unsigned.word
+        val slonglong' : 'c slonglong_obj'  -> MLRep.LongLong.Signed.int
+        val ulonglong' : 'c ulonglong_obj'  -> MLRep.LongLong.Unsigned.word
+        val float'     : 'c float_obj'      -> MLRep.Float.real
+        val double'    : 'c double_obj'     -> MLRep.Double.real
+        val enum'      : ('e, 'c) enum_obj' -> MLRep.Int.Signed.int
 
-	(* fetching pointers; results have to be abstract *)
-	val ptr : ('o ptr, 'c) obj -> 'o ptr
-	val fptr : ('f, 'c) fptr_obj -> 'f fptr
-	val voidptr : 'c voidptr_obj -> voidptr
+        (* fetching pointers; results have to be abstract *)
+        val ptr : ('o ptr, 'c) obj -> 'o ptr
+        val fptr : ('f, 'c) fptr_obj -> 'f fptr
+        val voidptr : 'c voidptr_obj -> voidptr
 
-	(* alt *)
-	val ptr' : ('o ptr, 'c) obj' -> 'o ptr'
-	val fptr' : ('f, 'c) fptr_obj' -> 'f fptr'
-	val voidptr' : 'c voidptr_obj' -> voidptr
+        (* alt *)
+        val ptr' : ('o ptr, 'c) obj' -> 'o ptr'
+        val fptr' : ('f, 'c) fptr_obj' -> 'f fptr'
+        val voidptr' : 'c voidptr_obj' -> voidptr
 
-	(* bitfields; concrete again *)
-	val sbf : 'c sbf -> MLRep.Int.Signed.int
-	val ubf : 'c ubf -> MLRep.Int.Unsigned.word
+        (* bitfields; concrete again *)
+        val sbf : 'c sbf -> MLRep.Int.Signed.int
+        val ubf : 'c ubf -> MLRep.Int.Unsigned.word
     end
 
     (* "store" methods; these require rw objects *)
     structure Set : sig
-	(* primitive types; use concrete values *)
-	val schar     : rw schar_obj      * MLRep.Char.Signed.int        -> unit
-	val uchar     : rw uchar_obj      * MLRep.Char.Unsigned.word     -> unit
-	val sshort    : rw sshort_obj     * MLRep.Short.Signed.int       -> unit
-	val ushort    : rw ushort_obj     * MLRep.Short.Unsigned.word    -> unit
-	val sint      : rw sint_obj       * MLRep.Int.Signed.int         -> unit
-	val uint      : rw uint_obj       * MLRep.Int.Unsigned.word      -> unit
-	val slong     : rw slong_obj      * MLRep.Long.Signed.int        -> unit
-	val ulong     : rw ulong_obj      * MLRep.Long.Unsigned.word     -> unit
-	val slonglong : rw slonglong_obj  * MLRep.LongLong.Signed.int    -> unit
-	val ulonglong : rw ulonglong_obj  * MLRep.LongLong.Unsigned.word -> unit
-	val float     : rw float_obj      * MLRep.Float.real             -> unit
-	val double    : rw double_obj     * MLRep.Double.real            -> unit
-	val enum      : ('e, rw) enum_obj * MLRep.Int.Signed.int         -> unit
+        (* primitive types; use concrete values *)
+        val schar     : rw schar_obj      * MLRep.Char.Signed.int        -> unit
+        val uchar     : rw uchar_obj      * MLRep.Char.Unsigned.word     -> unit
+        val sshort    : rw sshort_obj     * MLRep.Short.Signed.int       -> unit
+        val ushort    : rw ushort_obj     * MLRep.Short.Unsigned.word    -> unit
+        val sint      : rw sint_obj       * MLRep.Int.Signed.int         -> unit
+        val uint      : rw uint_obj       * MLRep.Int.Unsigned.word      -> unit
+        val slong     : rw slong_obj      * MLRep.Long.Signed.int        -> unit
+        val ulong     : rw ulong_obj      * MLRep.Long.Unsigned.word     -> unit
+        val slonglong : rw slonglong_obj  * MLRep.LongLong.Signed.int    -> unit
+        val ulonglong : rw ulonglong_obj  * MLRep.LongLong.Unsigned.word -> unit
+        val float     : rw float_obj      * MLRep.Float.real             -> unit
+        val double    : rw double_obj     * MLRep.Double.real            -> unit
+        val enum      : ('e, rw) enum_obj * MLRep.Int.Signed.int         -> unit
 
-	(* alt *)
-	val schar'     : rw schar_obj'      * MLRep.Char.Signed.int        -> unit
-	val uchar'     : rw uchar_obj'      * MLRep.Char.Unsigned.word     -> unit
-	val sshort'    : rw sshort_obj'     * MLRep.Short.Signed.int       -> unit
-	val ushort'    : rw ushort_obj'     * MLRep.Short.Unsigned.word    -> unit
-	val sint'      : rw sint_obj'       * MLRep.Int.Signed.int         -> unit
-	val uint'      : rw uint_obj'       * MLRep.Int.Unsigned.word      -> unit
-	val slong'     : rw slong_obj'      * MLRep.Long.Signed.int        -> unit
-	val ulong'     : rw ulong_obj'      * MLRep.Long.Unsigned.word     -> unit
-	val slonglong' : rw slonglong_obj'  * MLRep.LongLong.Signed.int    -> unit
-	val ulonglong' : rw ulonglong_obj'  * MLRep.LongLong.Unsigned.word -> unit
-	val float'     : rw float_obj'      * MLRep.Float.real             -> unit
-	val double'    : rw double_obj'     * MLRep.Double.real            -> unit
-	val enum'      : ('e, rw) enum_obj' * MLRep.Int.Signed.int         -> unit
+        (* alt *)
+        val schar'     : rw schar_obj'      * MLRep.Char.Signed.int        -> unit
+        val uchar'     : rw uchar_obj'      * MLRep.Char.Unsigned.word     -> unit
+        val sshort'    : rw sshort_obj'     * MLRep.Short.Signed.int       -> unit
+        val ushort'    : rw ushort_obj'     * MLRep.Short.Unsigned.word    -> unit
+        val sint'      : rw sint_obj'       * MLRep.Int.Signed.int         -> unit
+        val uint'      : rw uint_obj'       * MLRep.Int.Unsigned.word      -> unit
+        val slong'     : rw slong_obj'      * MLRep.Long.Signed.int        -> unit
+        val ulong'     : rw ulong_obj'      * MLRep.Long.Unsigned.word     -> unit
+        val slonglong' : rw slonglong_obj'  * MLRep.LongLong.Signed.int    -> unit
+        val ulonglong' : rw ulonglong_obj'  * MLRep.LongLong.Unsigned.word -> unit
+        val float'     : rw float_obj'      * MLRep.Float.real             -> unit
+        val double'    : rw double_obj'     * MLRep.Double.real            -> unit
+        val enum'      : ('e, rw) enum_obj' * MLRep.Int.Signed.int         -> unit
 
-	(* storing pointers; abstract *)
-	val ptr : ('o ptr, rw) obj * 'o ptr -> unit
-	val fptr : ('f, rw) fptr_obj * 'f fptr -> unit
-	val voidptr : rw voidptr_obj * voidptr -> unit
+        (* storing pointers; abstract *)
+        val ptr : ('o ptr, rw) obj * 'o ptr -> unit
+        val fptr : ('f, rw) fptr_obj * 'f fptr -> unit
+        val voidptr : rw voidptr_obj * voidptr -> unit
 
-	(* alt *)
-	val ptr' : ('o ptr, rw) obj' * 'o ptr' -> unit
-	val fptr' : ('f, rw) fptr_obj' * 'f fptr' -> unit
-	val voidptr' : rw voidptr_obj' * voidptr -> unit
+        (* alt *)
+        val ptr' : ('o ptr, rw) obj' * 'o ptr' -> unit
+        val fptr' : ('f, rw) fptr_obj' * 'f fptr' -> unit
+        val voidptr' : rw voidptr_obj' * voidptr -> unit
 
-	(* When storing, voidptr is compatible with any ptr type
-	 * (just like in C).  This should eliminate most need for RTTI in
-	 * practice. *)
-	val ptr_voidptr : ('o ptr, rw) obj * voidptr -> unit
+        (* When storing, voidptr is compatible with any ptr type
+         * (just like in C).  This should eliminate most need for RTTI in
+         * practice. *)
+        val ptr_voidptr : ('o ptr, rw) obj * voidptr -> unit
 
-	(* alt *)
-	val ptr_voidptr' : ('o ptr, rw) obj' * voidptr -> unit
+        (* alt *)
+        val ptr_voidptr' : ('o ptr, rw) obj' * voidptr -> unit
 
-	(* bitfields; concrete *)
-	val sbf : rw sbf * MLRep.Int.Signed.int    -> unit
-	val ubf : rw ubf * MLRep.Int.Unsigned.word -> unit
+        (* bitfields; concrete *)
+        val sbf : rw sbf * MLRep.Int.Signed.int    -> unit
+        val ubf : rw ubf * MLRep.Int.Unsigned.word -> unit
     end
 
     (* copying the contents of arbitrary objects *)
@@ -507,124 +507,124 @@
     (* operations on (mostly) pointers *)
     structure Ptr : sig
 
-	(* going from object to pointer and vice versa *)
-	val |&| : ('t, 'c) obj -> ('t, 'c) obj ptr
-	val |*| : ('t, 'c) obj ptr -> ('t, 'c) obj
+        (* going from object to pointer and vice versa *)
+        val |&| : ('t, 'c) obj -> ('t, 'c) obj ptr
+        val |*| : ('t, 'c) obj ptr -> ('t, 'c) obj
 
-	(* alt *)
-	val |&! : ('t, 'c) obj' -> ('t, 'c) obj ptr'
-	val |*! : ('t, 'c) obj ptr' -> ('t, 'c) obj'
+        (* alt *)
+        val |&! : ('t, 'c) obj' -> ('t, 'c) obj ptr'
+        val |*! : ('t, 'c) obj ptr' -> ('t, 'c) obj'
 
-	(* comparing pointers *)
-	val compare : 'o ptr * 'o ptr -> order
+        (* comparing pointers *)
+        val compare : 'o ptr * 'o ptr -> order
 
-	(* alt *)
-	val compare' : 'o ptr' * 'o ptr' -> order
+        (* alt *)
+        val compare' : 'o ptr' * 'o ptr' -> order
 
-	(* going from pointer to void*;  this also accounts for a conceptual
-	 * subtyping relation and is safe *)
-	val inject : 'o ptr -> voidptr
+        (* going from pointer to void*;  this also accounts for a conceptual
+         * subtyping relation and is safe *)
+        val inject : 'o ptr -> voidptr
 
-	(* alt *)
-	val inject' : 'o ptr' -> voidptr
+        (* alt *)
+        val inject' : 'o ptr' -> voidptr
 
-	(* the opposite is not safe, but C makes it not only easy but also
-	 * almost necessary; we use our RTTI interface to specify the pointer
-	 * type (not the element type!) *)
-	val cast : 'o ptr T.typ -> voidptr -> 'o ptr
+        (* the opposite is not safe, but C makes it not only easy but also
+         * almost necessary; we use our RTTI interface to specify the pointer
+         * type (not the element type!) *)
+        val cast : 'o ptr T.typ -> voidptr -> 'o ptr
 
-	(* alt, needs explicit type constraint on result! *)
-	val cast' : voidptr -> 'o ptr'
+        (* alt, needs explicit type constraint on result! *)
+        val cast' : voidptr -> 'o ptr'
 
-	(* NULL as void* *)
-	val vnull : voidptr
+        (* NULL as void* *)
+        val vnull : voidptr
 
-	(* projecting vnull to given pointer type *)
-	val null : 'o ptr T.typ -> 'o ptr
+        (* projecting vnull to given pointer type *)
+        val null : 'o ptr T.typ -> 'o ptr
 
-	(* the "light" NULL pointer is simply a polymorphic constant *)
-	val null' : 'o ptr'
+        (* the "light" NULL pointer is simply a polymorphic constant *)
+        val null' : 'o ptr'
 
-	(* fptr version of NULL *)
-	val fnull : 'f fptr T.typ -> 'f fptr
+        (* fptr version of NULL *)
+        val fnull : 'f fptr T.typ -> 'f fptr
 
-	(* again, "light" version is simply a polymorphic constant *)
-	val fnull' : 'f fptr'
+        (* again, "light" version is simply a polymorphic constant *)
+        val fnull' : 'f fptr'
 
-	(* checking for NULL pointer *)
-	val isVNull : voidptr -> bool
+        (* checking for NULL pointer *)
+        val isVNull : voidptr -> bool
 
-	(* combining inject and isVNull for convenience *)
-	val isNull : 'o ptr -> bool
+        (* combining inject and isVNull for convenience *)
+        val isNull : 'o ptr -> bool
 
-	(* alt *)
-	val isNull' : 'o ptr' -> bool
+        (* alt *)
+        val isNull' : 'o ptr' -> bool
 
-	(* checking a function pointer for NULL *)
-	val isFNull : 'f fptr -> bool
+        (* checking a function pointer for NULL *)
+        val isFNull : 'f fptr -> bool
 
-	(* alt *)
-	val isFNull' : 'f fptr' -> bool
+        (* alt *)
+        val isFNull' : 'f fptr' -> bool
 
-	(* pointer arithmetic *)
-	val |+| : ('t, 'c) obj ptr * int -> ('t, 'c) obj ptr
-	val |-| : ('t, 'c) obj ptr * ('t, 'c) obj ptr -> int
+        (* pointer arithmetic *)
+        val |+| : ('t, 'c) obj ptr * int -> ('t, 'c) obj ptr
+        val |-| : ('t, 'c) obj ptr * ('t, 'c) obj ptr -> int
 
-	(* alt; needs explicit size (for element) *)
-	val |+! : 't S.size -> ('t, 'c) obj ptr' * int -> ('t, 'c) obj ptr'
-	val |-! : 't S.size -> ('t, 'c) obj ptr' * ('t, 'c) obj ptr' -> int
+        (* alt; needs explicit size (for element) *)
+        val |+! : 't S.size -> ('t, 'c) obj ptr' * int -> ('t, 'c) obj ptr'
+        val |-! : 't S.size -> ('t, 'c) obj ptr' * ('t, 'c) obj ptr' -> int
 
-	(* subscript through a pointer; this is unchecked *)
-	val sub : ('t, 'c) obj ptr * int -> ('t, 'c) obj
+        (* subscript through a pointer; this is unchecked *)
+        val sub : ('t, 'c) obj ptr * int -> ('t, 'c) obj
 
-	(* alt; needs explicit size (for element) *)
-	val sub' : 't S.size -> ('t, 'c) obj ptr' * int -> ('t, 'c) obj'
+        (* alt; needs explicit size (for element) *)
+        val sub' : 't S.size -> ('t, 'c) obj ptr' * int -> ('t, 'c) obj'
 
-	(* conversions that rely on witnesses *)
-	val convert : (('st, 'sc) obj ptr, ('tt, 'tc) obj ptr) W.witness ->
-		      ('st, 'sc) obj ptr -> ('tt, 'tc) obj ptr
-	val convert' : (('st, 'sc) obj ptr, ('tt, 'tc) obj ptr) W.witness ->
-		       ('st, 'sc) obj ptr' -> ('tt, 'tc) obj ptr'
+        (* conversions that rely on witnesses *)
+        val convert : (('st, 'sc) obj ptr, ('tt, 'tc) obj ptr) W.witness ->
+                      ('st, 'sc) obj ptr -> ('tt, 'tc) obj ptr
+        val convert' : (('st, 'sc) obj ptr, ('tt, 'tc) obj ptr) W.witness ->
+                       ('st, 'sc) obj ptr' -> ('tt, 'tc) obj ptr'
 
-	(* constness manipulation for pointers
-	 * Note: fun ro x = convert (W.pointer (W.ro W.trivial)) x
-	 *       etc. *)
-	val ro  : ('t, 'c) obj ptr   -> ('t, ro) obj ptr
-	val rw  : ('t, 'sc) obj ptr  -> ('t, 'tc) obj ptr
-	val ro' : ('t, 'c) obj ptr'  -> ('t, ro) obj ptr'
-	val rw' : ('t, 'sc) obj ptr' -> ('t, 'tc) obj ptr'
+        (* constness manipulation for pointers
+         * Note: fun ro x = convert (W.pointer (W.ro W.trivial)) x
+         *       etc. *)
+        val ro  : ('t, 'c) obj ptr   -> ('t, ro) obj ptr
+        val rw  : ('t, 'sc) obj ptr  -> ('t, 'tc) obj ptr
+        val ro' : ('t, 'c) obj ptr'  -> ('t, ro) obj ptr'
+        val rw' : ('t, 'sc) obj ptr' -> ('t, 'tc) obj ptr'
     end
 
     (* operations on (mostly) arrays *)
     structure Arr : sig
-	
-	(* array subscript;
-	 * since we have RTTI, we can actually make this safe:  we raise
-	 * General.Subscript for out-of-bounds access;
-	 * for unchecked access, go through arr_decay and ptr_sub 
-	 *)
-	val sub : (('t, 'n) arr, 'c) obj * int -> ('t, 'c) obj
+        
+        (* array subscript;
+         * since we have RTTI, we can actually make this safe:  we raise
+         * General.Subscript for out-of-bounds access;
+         * for unchecked access, go through arr_decay and ptr_sub 
+         *)
+        val sub : (('t, 'n) arr, 'c) obj * int -> ('t, 'c) obj
 
-	(* alt; needs element size and array dimension *)
-	val sub' : 't S.size * 'n Dim.dim ->
-		   (('t, 'n) arr, 'c) obj' * int -> ('t, 'c) obj'
+        (* alt; needs element size and array dimension *)
+        val sub' : 't S.size * 'n Dim.dim ->
+                   (('t, 'n) arr, 'c) obj' * int -> ('t, 'c) obj'
 
-	(* let an array object decay, yielding pointer to first element *)
-	val decay : (('t, 'n) arr, 'c) obj -> ('t, 'c) obj ptr
+        (* let an array object decay, yielding pointer to first element *)
+        val decay : (('t, 'n) arr, 'c) obj -> ('t, 'c) obj ptr
 
-	(* alt *)
-	val decay' : (('t, 'n) arr, 'c) obj' -> ('t, 'c) obj ptr'
+        (* alt *)
+        val decay' : (('t, 'n) arr, 'c) obj' -> ('t, 'c) obj ptr'
 
-	(* reconstruct an array object from the pointer to its first element *)
-	val reconstruct :
-	    ('t, 'c) obj ptr * 'n Dim.dim -> (('t, 'n) arr, 'c) obj
+        (* reconstruct an array object from the pointer to its first element *)
+        val reconstruct :
+            ('t, 'c) obj ptr * 'n Dim.dim -> (('t, 'n) arr, 'c) obj
 
-	(* alt *)
-	val reconstruct':
-	    ('t, 'c) obj ptr' * 'n Dim.dim -> (('t, 'n) arr, 'c) obj'
+        (* alt *)
+        val reconstruct':
+            ('t, 'c) obj ptr' * 'n Dim.dim -> (('t, 'n) arr, 'c) obj'
 
-	(* dimension of array object *)
-	val dim : (('t, 'n) arr, 'c) obj -> 'n Dim.dim
+        (* dimension of array object *)
+        val dim : (('t, 'n) arr, 'c) obj -> 'n Dim.dim
     end
 
     (* allocating new objects *)
@@ -659,8 +659,8 @@
 
     (* completely unsafe stuff that every C programmer just *loves* to do *)
     structure U : sig
-	val fcast : 'a fptr' -> 'b fptr'
-	val p2i : 'o ptr' -> ulong
-	val i2p : ulong -> 'o ptr'
+        val fcast : 'a fptr' -> 'b fptr'
+        val p2i : 'o ptr' -> ulong
+        val i2p : ulong -> 'o ptr'
     end
 end

Deleted: mlton/branches/on-20050420-cmm-branch/lib/mlnlffi/c.x86-linux.mlb
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlnlffi/c.x86-linux.mlb	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlnlffi/c.x86-linux.mlb	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1 +0,0 @@
-c.x86-unix.mlb
\ No newline at end of file

Deleted: mlton/branches/on-20050420-cmm-branch/lib/mlnlffi/c.x86-unix.mlb
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlnlffi/c.x86-unix.mlb	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlnlffi/c.x86-unix.mlb	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,34 +0,0 @@
-(* c.x86-unix.mlb
- * 2005 Matthew Fluet (mfluet@acm.org)
- *  Adapted for MLton.
- *)
-
-(*
- * A new foreign-function interface for SML.
- *   This interface is actually an interface to C.  It is based on
- *   an encoding of C's type system in ML.
- *   This library is a helper library for use by automatically generated
- *   code.  (An auxiliary tool produces this code directly from C code.)
- *
- *   (C) 2001, Lucent Technologies, Bell Laboratories
- *
- * author: Matthias Blume (blume@research.bell-labs.com)
- *)
-local
-  internals/c-int.x86-unix.mlb
-in
-  structure Tag
-
-  structure MLRep
-
-  signature C
-  structure C
-  signature C_DEBUG
-  structure C_Debug
-
-  signature ZSTRING
-  structure ZString
-
-  signature DYN_LINKAGE
-  structure DynLinkage
-end
\ No newline at end of file

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlnlffi/internals/c-debug.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlnlffi/internals/c-debug.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlnlffi/internals/c-debug.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -23,7 +23,7 @@
     (* ... which means that we have to re-implement some things: *)
     structure Ptr = struct
         open Ptr
-	val |*! = fn p => if isNull' p then raise NullPointer else |*! p
-	val |*| = fn p => if isNull p then raise NullPointer else |*| p
+        val |*! = fn p => if isNull' p then raise NullPointer else |*! p
+        val |*| = fn p => if isNull p then raise NullPointer else |*| p
     end
 end

Copied: mlton/branches/on-20050420-cmm-branch/lib/mlnlffi/internals/c-int.mlb (from rev 4358, mlton/trunk/lib/mlnlffi/internals/c-int.mlb)

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlnlffi/internals/c-int.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlnlffi/internals/c-int.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlnlffi/internals/c-int.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -54,27 +54,27 @@
 
     (* making normal signed bitfields *)
     val mk_rw_sbf : int * word * word -> (* offset * bits * shift *)
-		    ('s, 'c) su_obj -> 'c sbf
+                    ('s, 'c) su_obj -> 'c sbf
     val mk_ro_sbf : int * word * word -> (* offset * bits * shift *)
-		    ('s, 'c) su_obj -> ro sbf
+                    ('s, 'c) su_obj -> ro sbf
 
     (* light versions *)
     val mk_rw_sbf' : int * word * word -> (* offset * bits * shift *)
-		     ('s, 'c) su_obj' -> 'c sbf
+                     ('s, 'c) su_obj' -> 'c sbf
     val mk_ro_sbf' : int * word * word -> (* offset * bits * shift *)
-		     ('s, 'c) su_obj' -> ro sbf
+                     ('s, 'c) su_obj' -> ro sbf
 
     (* making normal unsigned bitfields *)
     val mk_rw_ubf : int * word * word -> (* offset * bits * shift *)
-		    ('s, 'c) su_obj -> 'c ubf
+                    ('s, 'c) su_obj -> 'c ubf
     val mk_ro_ubf : int * word * word -> (* offset * bits * shift *)
-		    ('s, 'c) su_obj -> ro ubf
+                    ('s, 'c) su_obj -> ro ubf
 
     (* light versions *)
     val mk_rw_ubf' : int * word * word -> (* offset * bits * shift *)
-		     ('s, 'c) su_obj' -> 'c ubf
+                     ('s, 'c) su_obj' -> 'c ubf
     val mk_ro_ubf' : int * word * word -> (* offset * bits * shift *)
-		     ('s, 'c) su_obj' -> ro ubf
+                     ('s, 'c) su_obj' -> ro ubf
 
     (* reveal address behind void*; this is used to
      * implement the function-call protocol for functions that have
@@ -87,7 +87,7 @@
     val fcast : addr -> 'f fptr'
 
     (* unsafe low-level array subscript that does not require RTTI *)
-    val unsafe_sub : int ->		(* element size *)
-		     (('t, 'n) arr, 'c) obj' * int ->
-		     ('t, 'n) obj'
+    val unsafe_sub : int ->             (* element size *)
+                     (('t, 'n) arr, 'c) obj' * int ->
+                     ('t, 'n) obj'
 end

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlnlffi/internals/c-int.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlnlffi/internals/c-int.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlnlffi/internals/c-int.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -24,49 +24,49 @@
     val null = CMemory.null
 
     local
-	datatype 'f objt =
-	    BASE of word
-	  | PTR of 'f
-	  | FPTR of addr -> 'f
-	  | ARR of { typ: 'f objt, n: word, esz: word, asz: word }
+        datatype 'f objt =
+            BASE of word
+          | PTR of 'f
+          | FPTR of addr -> 'f
+          | ARR of { typ: 'f objt, n: word, esz: word, asz: word }
 
-	(* Bitfield: b bits wide, l bits from left corner, r bits from right.
-	 * The word itself is CMemory.int_bits wide and located at address a.
-	 *
-	 *    MSB                         LSB
-	 *     V        |<---b--->|        V
-	 *    |<---l---> ......... <---r--->|
-	 *    |<----------wordsize--------->|
-	 * 
-	 *     0.......0 1.......1 0.......0    = m
-	 *     1.......1 0.......0 1.......1    = im
-	 *
-	 * l + r = lr *)
-	type cword = MLRep.Int.Unsigned.word
-	type bf = { a: addr, l: word, r: word, lr: word, m: cword, im: cword }
+        (* Bitfield: b bits wide, l bits from left corner, r bits from right.
+         * The word itself is CMemory.int_bits wide and located at address a.
+         *
+         *    MSB                         LSB
+         *     V        |<---b--->|        V
+         *    |<---l---> ......... <---r--->|
+         *    |<----------wordsize--------->|
+         * 
+         *     0.......0 1.......1 0.......0    = m
+         *     1.......1 0.......0 1.......1    = im
+         *
+         * l + r = lr *)
+        type cword = MLRep.Int.Unsigned.word
+        type bf = { a: addr, l: word, r: word, lr: word, m: cword, im: cword }
 
-	fun pair_type_addr (t: 'f objt) (a: addr) = (a, t)
-	fun strip_type (a: addr, _: 'f objt) = a
-	fun p_strip_type (a: addr, _: 'f objt) = a
-	fun strip_fun (a: addr, _: 'f) = a
-	fun addr_type_id (x: addr * 'f objt) = x
-	fun addr_id (x: addr) = x
+        fun pair_type_addr (t: 'f objt) (a: addr) = (a, t)
+        fun strip_type (a: addr, _: 'f objt) = a
+        fun p_strip_type (a: addr, _: 'f objt) = a
+        fun strip_fun (a: addr, _: 'f) = a
+        fun addr_type_id (x: addr * 'f objt) = x
+        fun addr_id (x: addr) = x
 
-	infix -- ++
-	val op -- = CMemory.--
-	val op ++ = CMemory.++
+        infix -- ++
+        val op -- = CMemory.--
+        val op ++ = CMemory.++
 
-	infix << >> ~>> && || ^^
-	val op << = MLRep.Int.Unsigned.<<
-	val op >> = MLRep.Int.Unsigned.>>
-	val op ~>> = MLRep.Int.Unsigned.~>>
-	val op && = MLRep.Int.Unsigned.andb
-	val op || = MLRep.Int.Unsigned.orb
-	val op ^^ = MLRep.Int.Unsigned.xorb
-	val ~~ = MLRep.Int.Unsigned.notb
+        infix << >> ~>> && || ^^
+        val op << = MLRep.Int.Unsigned.<<
+        val op >> = MLRep.Int.Unsigned.>>
+        val op ~>> = MLRep.Int.Unsigned.~>>
+        val op && = MLRep.Int.Unsigned.andb
+        val op || = MLRep.Int.Unsigned.orb
+        val op ^^ = MLRep.Int.Unsigned.xorb
+        val ~~ = MLRep.Int.Unsigned.notb
     in
 
-    type ('t, 'c) obj  = addr * 't objt	(* RTTI for stored value *)
+    type ('t, 'c) obj  = addr * 't objt (* RTTI for stored value *)
     type ('t, 'c) obj' = addr
     type ro = unit
     type rw = unit
@@ -139,28 +139,28 @@
     structure W = struct
         type ('from, 'to) witness = 'from -> 'to
 
-	fun convert (w : 's -> 't) (x : 's objt) : 't objt =
-	   case x of
-	      BASE b => BASE b
-	    | PTR x => PTR (w x)
-	    | FPTR f => FPTR (fn a => w (f a))
-	    | ARR {typ, n, esz, asz} =>
-		 ARR {typ = convert w typ, 
-		      n = n, esz = esz, asz = asz}
+        fun convert (w : 's -> 't) (x : 's objt) : 't objt =
+           case x of
+              BASE b => BASE b
+            | PTR x => PTR (w x)
+            | FPTR f => FPTR (fn a => w (f a))
+            | ARR {typ, n, esz, asz} =>
+                 ARR {typ = convert w typ, 
+                      n = n, esz = esz, asz = asz}
 
-	val trivial : ('t, 't) witness = 
-	   fn x => x
+        val trivial : ('t, 't) witness = 
+           fn x => x
 
         val pointer : ('from, 'to) witness -> ('from ptr, 'to ptr) witness =
-	   fn w => fn (a, t) => (a, convert w t)
-	val object : ('from, 'to) witness -> (('from, 'c) obj, ('to, 'c) obj) witness =
-	   fn w => fn (a, t) => (a, convert w t)
-	val arr : ('from, 'to) witness -> (('from, 'n) arr, ('to, 'n) arr) witness =
-	   fn w => w
-	val ro : ('from, 'to) witness -> (('from, 'fc) obj, ('to, ro) obj) witness =
-	   fn w => fn (a, t) => (a, convert w t)
-	val rw : ('from, 'to) witness -> (('from, 'fc) obj, ('to, 'tc) obj) witness =
-	   fn w => fn (a, t) => (a, convert w t)
+           fn w => fn (a, t) => (a, convert w t)
+        val object : ('from, 'to) witness -> (('from, 'c) obj, ('to, 'c) obj) witness =
+           fn w => fn (a, t) => (a, convert w t)
+        val arr : ('from, 'to) witness -> (('from, 'n) arr, ('to, 'n) arr) witness =
+           fn w => w
+        val ro : ('from, 'to) witness -> (('from, 'fc) obj, ('to, ro) obj) witness =
+           fn w => fn (a, t) => (a, convert w t)
+        val rw : ('from, 'to) witness -> (('from, 'fc) obj, ('to, 'tc) obj) witness =
+           fn w => fn (a, t) => (a, convert w t)
     end
 
     val convert : (('st, 'sc) obj, ('tt, 'tc) obj) W.witness -> 
@@ -179,146 +179,146 @@
     structure Dim = struct
 
         type ('a, 'z) dim0 = int
-	fun toInt d = d
-	fun fromInt d = d
+        fun toInt d = d
+        fun fromInt d = d
 
-	type dec = unit
-	type 'a dg0 = unit
-	type 'a dg1 = unit
-	type 'a dg2 = unit
-	type 'a dg3 = unit
-	type 'a dg4 = unit
-	type 'a dg5 = unit
-	type 'a dg6 = unit
-	type 'a dg7 = unit
-	type 'a dg8 = unit
-	type 'a dg9 = unit
+        type dec = unit
+        type 'a dg0 = unit
+        type 'a dg1 = unit
+        type 'a dg2 = unit
+        type 'a dg3 = unit
+        type 'a dg4 = unit
+        type 'a dg5 = unit
+        type 'a dg6 = unit
+        type 'a dg7 = unit
+        type 'a dg8 = unit
+        type 'a dg9 = unit
 
-	type zero = unit
-	type nonzero = unit
+        type zero = unit
+        type nonzero = unit
 
-	type 'a dim = ('a, nonzero) dim0
+        type 'a dim = ('a, nonzero) dim0
 
-	local
-	    fun dg n d = 10 * d + n
-	in
+        local
+            fun dg n d = 10 * d + n
+        in
             val dec' = 0
             val (dg0', dg1', dg2', dg3', dg4', dg5', dg6', dg7', dg8', dg9') =
-		(dg 0, dg 1, dg 2, dg 3, dg 4, dg 5, dg 6, dg 7, dg 8, dg 9)
+                (dg 0, dg 1, dg 2, dg 3, dg 4, dg 5, dg 6, dg 7, dg 8, dg 9)
 
-	    fun dec k = k dec'
-	    fun dg0 d k = k (dg0' d)
-	    fun dg1 d k = k (dg1' d)
-	    fun dg2 d k = k (dg2' d)
-	    fun dg3 d k = k (dg3' d)
-	    fun dg4 d k = k (dg4' d)
-	    fun dg5 d k = k (dg5' d)
-	    fun dg6 d k = k (dg6' d)
-	    fun dg7 d k = k (dg7' d)
-	    fun dg8 d k = k (dg8' d)
-	    fun dg9 d k = k (dg9' d)
-	    fun dim d = d
-	end
+            fun dec k = k dec'
+            fun dg0 d k = k (dg0' d)
+            fun dg1 d k = k (dg1' d)
+            fun dg2 d k = k (dg2' d)
+            fun dg3 d k = k (dg3' d)
+            fun dg4 d k = k (dg4' d)
+            fun dg5 d k = k (dg5' d)
+            fun dg6 d k = k (dg6' d)
+            fun dg7 d k = k (dg7' d)
+            fun dg8 d k = k (dg8' d)
+            fun dg9 d k = k (dg9' d)
+            fun dim d = d
+        end
     end
 
     structure S = struct
 
         type 't size = word
 
-	fun toWord (s: 't size) = s
+        fun toWord (s: 't size) = s
 
-	val schar     = CMemory.char_size
-	val uchar     = CMemory.char_size
-	val sint      = CMemory.int_size
-	val uint      = CMemory.int_size
-	val sshort    = CMemory.short_size
-	val ushort    = CMemory.short_size
-	val slong     = CMemory.long_size
-	val ulong     = CMemory.long_size
-	val slonglong = CMemory.longlong_size
-	val ulonglong = CMemory.longlong_size
-	val float     = CMemory.float_size
-	val double    = CMemory.double_size
+        val schar     = CMemory.char_size
+        val uchar     = CMemory.char_size
+        val sint      = CMemory.int_size
+        val uint      = CMemory.int_size
+        val sshort    = CMemory.short_size
+        val ushort    = CMemory.short_size
+        val slong     = CMemory.long_size
+        val ulong     = CMemory.long_size
+        val slonglong = CMemory.longlong_size
+        val ulonglong = CMemory.longlong_size
+        val float     = CMemory.float_size
+        val double    = CMemory.double_size
 
-	val voidptr = CMemory.addr_size
-	val ptr = CMemory.addr_size
-	val fptr = CMemory.addr_size
-	val enum = CMemory.int_size
+        val voidptr = CMemory.addr_size
+        val ptr = CMemory.addr_size
+        val fptr = CMemory.addr_size
+        val enum = CMemory.int_size
     end
 
     structure T = struct
 
         type 't typ = 't objt
 
-	val typeof : ('t, 'c) obj -> 't typ =
-	   fn (_, t) => t
+        val typeof : ('t, 'c) obj -> 't typ =
+           fn (_, t) => t
 
-	val sizeof : 't typ -> 't S.size =
-	   fn BASE b => b
-	    | PTR _ => S.ptr
-	    | FPTR _ => S.fptr
-	    | ARR a => #asz a
+        val sizeof : 't typ -> 't S.size =
+           fn BASE b => b
+            | PTR _ => S.ptr
+            | FPTR _ => S.fptr
+            | ARR a => #asz a
 
-	(* use private (and unsafe) extension to Dim module here... *)
-	val dim : ('t, 'n) arr typ -> 'n Dim.dim =
-	   fn ARR { n, ... } => Dim.fromInt (Word.toInt n)
-	    | _ => bug "T.dim (non-array type)"
+        (* use private (and unsafe) extension to Dim module here... *)
+        val dim : ('t, 'n) arr typ -> 'n Dim.dim =
+           fn ARR { n, ... } => Dim.fromInt (Word.toInt n)
+            | _ => bug "T.dim (non-array type)"
 
-	val pointer : 't typ -> ('t, rw) obj ptr typ =
-	   fn t => PTR (null, PTR (null, t))
-	val target : ('t, 'c) obj ptr typ -> 't typ =
-	   fn PTR (_, PTR (_, t)) => t
-	    | _ => bug "T.target (non-pointer type)"
-	val arr : 't typ * 'n Dim.dim -> ('t, 'n) arr typ =
-	   fn (t, d) =>
-	   let
-	      val n = Word.fromInt (Dim.toInt d)
-	      val s = sizeof t
-	   in
-	      ARR { typ = t, n = n, esz = s, asz = n * s }
-	   end
-	val elem : ('t, 'n) arr typ -> 't typ =
-	   fn ARR a => #typ a
-	    | _ => bug "T.elem (non-array type)"
-	val ro : ('t, 'c) obj ptr typ -> ('t, ro) obj ptr typ =
-	   fn t => t
+        val pointer : 't typ -> ('t, rw) obj ptr typ =
+           fn t => PTR (null, PTR (null, t))
+        val target : ('t, 'c) obj ptr typ -> 't typ =
+           fn PTR (_, PTR (_, t)) => t
+            | _ => bug "T.target (non-pointer type)"
+        val arr : 't typ * 'n Dim.dim -> ('t, 'n) arr typ =
+           fn (t, d) =>
+           let
+              val n = Word.fromInt (Dim.toInt d)
+              val s = sizeof t
+           in
+              ARR { typ = t, n = n, esz = s, asz = n * s }
+           end
+        val elem : ('t, 'n) arr typ -> 't typ =
+           fn ARR a => #typ a
+            | _ => bug "T.elem (non-array type)"
+        val ro : ('t, 'c) obj ptr typ -> ('t, ro) obj ptr typ =
+           fn t => t
 
-	val schar     : schar typ     = BASE S.schar
-	val uchar     : uchar typ     = BASE S.uchar
-	val sshort    : sshort typ    = BASE S.sshort
-	val ushort    : ushort typ    = BASE S.ushort
-	val sint      : sint typ      = BASE S.sint
-	val uint      : uint typ      = BASE S.uint
-	val slong     : slong typ     = BASE S.slong
-	val ulong     : ulong typ     = BASE S.ulong
-	val slonglong : slonglong typ = BASE S.slonglong
-	val ulonglong : ulonglong typ = BASE S.ulonglong
-	val float     : float typ     = BASE S.float
-	val double    : double typ    = BASE S.double
+        val schar     : schar typ     = BASE S.schar
+        val uchar     : uchar typ     = BASE S.uchar
+        val sshort    : sshort typ    = BASE S.sshort
+        val ushort    : ushort typ    = BASE S.ushort
+        val sint      : sint typ      = BASE S.sint
+        val uint      : uint typ      = BASE S.uint
+        val slong     : slong typ     = BASE S.slong
+        val ulong     : ulong typ     = BASE S.ulong
+        val slonglong : slonglong typ = BASE S.slonglong
+        val ulonglong : ulonglong typ = BASE S.ulonglong
+        val float     : float typ     = BASE S.float
+        val double    : double typ    = BASE S.double
 
-	val voidptr : voidptr typ = BASE S.voidptr
+        val voidptr : voidptr typ = BASE S.voidptr
 
-	val enum : 'tag enum typ = BASE S.sint
+        val enum : 'tag enum typ = BASE S.sint
     end
 
     structure Light = struct
         val obj : ('t, 'c) obj -> ('t, 'c) obj' =
-	   fn (a, _) => a
-	val ptr : 'o ptr -> 'o ptr' =
-	   fn (a, _) => a
-	val fptr : 'f fptr -> 'f fptr' =
-	   fn (a, _) => a
+           fn (a, _) => a
+        val ptr : 'o ptr -> 'o ptr' =
+           fn (a, _) => a
+        val fptr : 'f fptr -> 'f fptr' =
+           fn (a, _) => a
     end
 
     structure Heavy = struct
         val obj : 't T.typ -> ('t, 'c) obj' -> ('t, 'c) obj = 
-	   fn t => fn a => (a, t)
-	val ptr : 'o ptr T.typ -> 'o ptr' -> 'o ptr =
-	   fn PTR (_, t) => (fn a => (a, t))
-	    | _ => bug "Heavy.ptr (non-object-pointer-type)"
-	val fptr : 'f fptr T.typ  -> 'f fptr' -> 'f fptr =
-	   fn (FPTR mkf) => (fn a => (a, #2 (mkf a)))
-	    | _ => bug "Heavy.fptr (non-function-pointer-type)"
+           fn t => fn a => (a, t)
+        val ptr : 'o ptr T.typ -> 'o ptr' -> 'o ptr =
+           fn PTR (_, t) => (fn a => (a, t))
+            | _ => bug "Heavy.ptr (non-object-pointer-type)"
+        val fptr : 'f fptr T.typ  -> 'f fptr' -> 'f fptr =
+           fn (FPTR mkf) => (fn a => (a, #2 (mkf a)))
+            | _ => bug "Heavy.fptr (non-function-pointer-type)"
     end
 
     val sizeof : ('t, 'c) obj -> 't S.size =
@@ -327,149 +327,149 @@
     structure Cvt = struct
         (* going between abstract and concrete; these are all identities *)
         fun c_schar (c: schar) = c
-	fun c_uchar (c: uchar) = c
+        fun c_uchar (c: uchar) = c
         fun c_sshort (s: sshort) = s
-	fun c_ushort (s: ushort) = s
+        fun c_ushort (s: ushort) = s
         fun c_sint (i: sint) = i
-	fun c_uint (i: uint) = i
+        fun c_uint (i: uint) = i
         fun c_slong (l: slong) = l
-	fun c_ulong (l: ulong) = l
+        fun c_ulong (l: ulong) = l
         fun c_slonglong (ll: slonglong) = ll
-	fun c_ulonglong (ll: ulonglong) = ll
-	fun c_float (f: float) = f
-	fun c_double (d: double) = d
-	fun i2c_enum (e: 'e enum) = e
+        fun c_ulonglong (ll: ulonglong) = ll
+        fun c_float (f: float) = f
+        fun c_double (d: double) = d
+        fun i2c_enum (e: 'e enum) = e
 
-	val ml_schar = c_schar
-	val ml_uchar = c_uchar
-	val ml_sshort = c_sshort
-	val ml_ushort = c_ushort
-	val ml_sint = c_sint
-	val ml_uint = c_uint
-	val ml_slong = c_slong
-	val ml_ulong = c_ulong
-	val ml_slonglong = c_slonglong
-	val ml_ulonglong = c_ulonglong
-	val ml_float = c_float
-	val ml_double = c_double
-	val c2i_enum = i2c_enum
+        val ml_schar = c_schar
+        val ml_uchar = c_uchar
+        val ml_sshort = c_sshort
+        val ml_ushort = c_ushort
+        val ml_sint = c_sint
+        val ml_uint = c_uint
+        val ml_slong = c_slong
+        val ml_ulong = c_ulong
+        val ml_slonglong = c_slonglong
+        val ml_ulonglong = c_ulonglong
+        val ml_float = c_float
+        val ml_double = c_double
+        val c2i_enum = i2c_enum
     end
 
     structure Get = struct
         val uchar' = CMemory.load_uchar
-	val schar' = CMemory.load_schar
-	val uint' = CMemory.load_uint
-	val sint' = CMemory.load_sint
-	val ushort' = CMemory.load_ushort
-	val sshort' = CMemory.load_sshort
-	val ulong' = CMemory.load_ulong
-	val slong' = CMemory.load_slong
-	val ulonglong' = CMemory.load_ulonglong
-	val slonglong' = CMemory.load_slonglong
-	val float' = CMemory.load_float
-	val double' = CMemory.load_double
-	val enum' = CMemory.load_sint
+        val schar' = CMemory.load_schar
+        val uint' = CMemory.load_uint
+        val sint' = CMemory.load_sint
+        val ushort' = CMemory.load_ushort
+        val sshort' = CMemory.load_sshort
+        val ulong' = CMemory.load_ulong
+        val slong' = CMemory.load_slong
+        val ulonglong' = CMemory.load_ulonglong
+        val slonglong' = CMemory.load_slonglong
+        val float' = CMemory.load_float
+        val double' = CMemory.load_double
+        val enum' = CMemory.load_sint
 
-	val ptr' = CMemory.load_addr
-	val fptr' = CMemory.load_addr
-	val voidptr' = CMemory.load_addr
+        val ptr' = CMemory.load_addr
+        val fptr' = CMemory.load_addr
+        val voidptr' = CMemory.load_addr
 
-	val uchar = uchar' o strip_type
-	val schar = schar' o strip_type
-	val uint = uint' o strip_type
-	val sint = sint' o strip_type
-	val ushort = ushort' o strip_type
-	val sshort = sshort' o strip_type
-	val ulong = ulong' o strip_type
-	val slong = slong' o strip_type
-	val ulonglong = ulonglong' o strip_type
-	val slonglong = slonglong' o strip_type
-	val float = float' o strip_type
-	val double = double' o strip_type
-	val voidptr = voidptr' o strip_type
-	val enum = enum' o strip_type
+        val uchar = uchar' o strip_type
+        val schar = schar' o strip_type
+        val uint = uint' o strip_type
+        val sint = sint' o strip_type
+        val ushort = ushort' o strip_type
+        val sshort = sshort' o strip_type
+        val ulong = ulong' o strip_type
+        val slong = slong' o strip_type
+        val ulonglong = ulonglong' o strip_type
+        val slonglong = slonglong' o strip_type
+        val float = float' o strip_type
+        val double = double' o strip_type
+        val voidptr = voidptr' o strip_type
+        val enum = enum' o strip_type
 
-	val ptr : ('o ptr, 'c) obj -> 'o ptr =
-	   fn (a, PTR (_, t)) => (ptr' a, t)
-	    | _ => bug "Get.ptr (non-pointer)"
-	val fptr : ('f, 'c) fptr_obj -> 'f fptr =
-	   fn (a, FPTR mkf) => let val fa = fptr' a in (fa, #2 (mkf fa)) end
-	    | _ => bug "Get.fptr (non-function-pointer)"
+        val ptr : ('o ptr, 'c) obj -> 'o ptr =
+           fn (a, PTR (_, t)) => (ptr' a, t)
+            | _ => bug "Get.ptr (non-pointer)"
+        val fptr : ('f, 'c) fptr_obj -> 'f fptr =
+           fn (a, FPTR mkf) => let val fa = fptr' a in (fa, #2 (mkf fa)) end
+            | _ => bug "Get.fptr (non-function-pointer)"
 
-	local
-	    val u2s = MLRep.Int.Signed.fromLarge o MLRep.Int.Unsigned.toLargeIntX
-	in
-	    fun ubf ({ a, l, r, lr, m, im } : bf) =
-		(CMemory.load_uint a << l) >> lr
-	    fun sbf ({ a, l, r, lr, m, im } : bf) =
-		u2s ((CMemory.load_uint a << l) ~>> lr)
-	end
+        local
+            val u2s = MLRep.Int.Signed.fromLarge o MLRep.Int.Unsigned.toLargeIntX
+        in
+            fun ubf ({ a, l, r, lr, m, im } : bf) =
+                (CMemory.load_uint a << l) >> lr
+            fun sbf ({ a, l, r, lr, m, im } : bf) =
+                u2s ((CMemory.load_uint a << l) ~>> lr)
+        end
     end
 
     structure Set = struct
         val uchar' = CMemory.store_uchar
-	val schar' = CMemory.store_schar
-	val uint' = CMemory.store_uint
-	val sint' = CMemory.store_sint
-	val ushort' = CMemory.store_ushort
-	val sshort' = CMemory.store_sshort
-	val ulong' = CMemory.store_ulong
-	val slong' = CMemory.store_slong
-	val ulonglong' = CMemory.store_ulonglong
-	val slonglong' = CMemory.store_slonglong
-	val float' = CMemory.store_float
-	val double' = CMemory.store_double
-	val enum' = CMemory.store_sint
+        val schar' = CMemory.store_schar
+        val uint' = CMemory.store_uint
+        val sint' = CMemory.store_sint
+        val ushort' = CMemory.store_ushort
+        val sshort' = CMemory.store_sshort
+        val ulong' = CMemory.store_ulong
+        val slong' = CMemory.store_slong
+        val ulonglong' = CMemory.store_ulonglong
+        val slonglong' = CMemory.store_slonglong
+        val float' = CMemory.store_float
+        val double' = CMemory.store_double
+        val enum' = CMemory.store_sint
 
-	val ptr' = CMemory.store_addr
-	val fptr' = CMemory.store_addr
-	val voidptr' = CMemory.store_addr
+        val ptr' = CMemory.store_addr
+        val fptr' = CMemory.store_addr
+        val voidptr' = CMemory.store_addr
 
-	val ptr_voidptr' = CMemory.store_addr
+        val ptr_voidptr' = CMemory.store_addr
 
-	local
-	    infix $
-	    fun (f $ g) (x, y) = f (g x, y)
-	in
-	    val uchar = uchar' $ strip_type
-	    val schar = schar' $ strip_type
-	    val uint = uint' $ strip_type
-	    val sint = sint' $ strip_type
-	    val ushort = ushort' $ strip_type
-	    val sshort = sshort' $ strip_type
-	    val ulong = ulong' $ strip_type
-	    val slong = slong' $ strip_type
-	    val ulonglong = ulonglong' $ strip_type
-	    val slonglong = slonglong' $ strip_type
-	    val float = float' $ strip_type
-	    val double = double' $ strip_type
-	    val enum = enum' $ strip_type
+        local
+            infix $
+            fun (f $ g) (x, y) = f (g x, y)
+        in
+            val uchar = uchar' $ strip_type
+            val schar = schar' $ strip_type
+            val uint = uint' $ strip_type
+            val sint = sint' $ strip_type
+            val ushort = ushort' $ strip_type
+            val sshort = sshort' $ strip_type
+            val ulong = ulong' $ strip_type
+            val slong = slong' $ strip_type
+            val ulonglong = ulonglong' $ strip_type
+            val slonglong = slonglong' $ strip_type
+            val float = float' $ strip_type
+            val double = double' $ strip_type
+            val enum = enum' $ strip_type
 
-	    val ptr : ('o ptr, rw) obj * 'o ptr -> unit =
-	       fn (x, p) => ptr' (p_strip_type x, p_strip_type p)
-	    val voidptr = voidptr' $ strip_type
-	    val fptr : ('f, rw) fptr_obj * 'f fptr -> unit =
-	       fn (x, f) => fptr' (p_strip_type x, strip_fun f)
+            val ptr : ('o ptr, rw) obj * 'o ptr -> unit =
+               fn (x, p) => ptr' (p_strip_type x, p_strip_type p)
+            val voidptr = voidptr' $ strip_type
+            val fptr : ('f, rw) fptr_obj * 'f fptr -> unit =
+               fn (x, f) => fptr' (p_strip_type x, strip_fun f)
 
-	    val ptr_voidptr : ('o ptr, rw) obj * voidptr -> unit =
-	       fn (x, p) => ptr_voidptr' (p_strip_type x, p)
-	end
+            val ptr_voidptr : ('o ptr, rw) obj * voidptr -> unit =
+               fn (x, p) => ptr_voidptr' (p_strip_type x, p)
+        end
 
-	fun ubf ({ a, l, r, lr, m, im }, x) =
-	   CMemory.store_uint (a, (CMemory.load_uint a && im) ||
-			       ((x << r) && m))
+        fun ubf ({ a, l, r, lr, m, im }, x) =
+           CMemory.store_uint (a, (CMemory.load_uint a && im) ||
+                               ((x << r) && m))
 
-	local
-	   val s2u = MLRep.Int.Unsigned.fromLargeInt o MLRep.Int.Signed.toLarge
-	in
-	   fun sbf (f, x) = ubf (f, s2u x)
-	end
+        local
+           val s2u = MLRep.Int.Unsigned.fromLargeInt o MLRep.Int.Signed.toLarge
+        in
+           fun sbf (f, x) = ubf (f, s2u x)
+        end
     end
 
     fun copy' bytes { from, to } =
-	CMemory.bcopy { from = from, to = to, bytes = bytes }
+        CMemory.bcopy { from = from, to = to, bytes = bytes }
     fun copy { from = (from, t), to = (to, _: 'f objt) } =
-	copy' (T.sizeof t) { from = from, to = to }
+        copy' (T.sizeof t) { from = from, to = to }
 
     val ro = addr_type_id
     val rw = addr_type_id
@@ -479,107 +479,107 @@
 
     structure Ptr = struct
         val |&| : ('t, 'c) obj -> ('t, 'c) obj ptr = 
-	   fn (a, t) => (a, PTR (null, t))
-	val |*| : ('t, 'c) obj ptr -> ('t, 'c) obj = 
-	   fn (a, PTR (_, t)) => (a, t)
-	    | _ => bug "Ptr.* (non-pointer)"
+           fn (a, t) => (a, PTR (null, t))
+        val |*| : ('t, 'c) obj ptr -> ('t, 'c) obj = 
+           fn (a, PTR (_, t)) => (a, t)
+            | _ => bug "Ptr.* (non-pointer)"
 
-	val |&! : ('t, 'c) obj' -> ('t, 'c) obj ptr' = 
-	   addr_id
-	val |*! : ('t, 'c) obj ptr' -> ('t, 'c) obj' = 
-	   addr_id
+        val |&! : ('t, 'c) obj' -> ('t, 'c) obj ptr' = 
+           addr_id
+        val |*! : ('t, 'c) obj ptr' -> ('t, 'c) obj' = 
+           addr_id
 
-	fun compare (p, p') = CMemory.compare (p_strip_type p, p_strip_type p')
+        fun compare (p, p') = CMemory.compare (p_strip_type p, p_strip_type p')
 
-	val compare' = CMemory.compare
+        val compare' = CMemory.compare
 
-	val inject' = addr_id
-	val cast' = addr_id
+        val inject' = addr_id
+        val cast' = addr_id
 
-	val inject : 'o ptr -> voidptr = p_strip_type
-	val cast : 'o ptr T.typ -> voidptr -> 'o ptr =
-	   fn PTR (null, t) => (fn p => (p, t))
-	    | _ => bug "Ptr.cast (non-pointer-type)"
+        val inject : 'o ptr -> voidptr = p_strip_type
+        val cast : 'o ptr T.typ -> voidptr -> 'o ptr =
+           fn PTR (null, t) => (fn p => (p, t))
+            | _ => bug "Ptr.cast (non-pointer-type)"
 
-	val vnull : voidptr = CMemory.null
-	val null : 'o ptr T.typ -> 'o ptr =
-	   fn t => cast t vnull
-	val null' : 'o ptr' = vnull
+        val vnull : voidptr = CMemory.null
+        val null : 'o ptr T.typ -> 'o ptr =
+           fn t => cast t vnull
+        val null' : 'o ptr' = vnull
 
-	val fnull' : 'f ptr' = CMemory.null
-	val fnull : 'f fptr T.typ -> 'f fptr =
-	   fn t => Heavy.fptr t fnull'
+        val fnull' : 'f ptr' = CMemory.null
+        val fnull : 'f fptr T.typ -> 'f fptr =
+           fn t => Heavy.fptr t fnull'
 
-	val isVNull : voidptr -> bool = CMemory.isNull
-	val isNull : 'o ptr -> bool =
-	   fn p => isVNull (inject p)
-	val isNull' = CMemory.isNull
+        val isVNull : voidptr -> bool = CMemory.isNull
+        val isNull : 'o ptr -> bool =
+           fn p => isVNull (inject p)
+        val isNull' = CMemory.isNull
 
-	val isFNull : 'f fptr -> bool =
-	   fn (a,_) => CMemory.isNull a
-	val isFNull' = CMemory.isNull
+        val isFNull : 'f fptr -> bool =
+           fn (a,_) => CMemory.isNull a
+        val isFNull' = CMemory.isNull
 
-	fun |+! s (p, i) = p ++ (Word.toInt s * i)
-	fun |-! s (p, p') = (p -- p') div Word.toInt s
+        fun |+! s (p, i) = p ++ (Word.toInt s * i)
+        fun |-! s (p, p') = (p -- p') div Word.toInt s
 
-	val |+| : ('t, 'c) obj ptr * int -> ('t, 'c) obj ptr =
-	   fn ((p, t as PTR (_, t')), i) => (|+! (T.sizeof t') (p, i), t)
-	    | _ => bug "Ptr.|+| (non-pointer-type)"
-	val |-| : ('t, 'c) obj ptr * ('t, 'c) obj ptr -> int =
-	   fn ((p, t as PTR (_, t')), (p', _)) => |-! (T.sizeof t') (p, p')
-	    | _ => bug "Ptr.|-| (non-pointer-type"
+        val |+| : ('t, 'c) obj ptr * int -> ('t, 'c) obj ptr =
+           fn ((p, t as PTR (_, t')), i) => (|+! (T.sizeof t') (p, i), t)
+            | _ => bug "Ptr.|+| (non-pointer-type)"
+        val |-| : ('t, 'c) obj ptr * ('t, 'c) obj ptr -> int =
+           fn ((p, t as PTR (_, t')), (p', _)) => |-! (T.sizeof t') (p, p')
+            | _ => bug "Ptr.|-| (non-pointer-type"
 
-	val sub : ('t, 'c) obj ptr * int -> ('t, 'c) obj =
-	   fn (p, i) => |*| (|+| (p, i))
+        val sub : ('t, 'c) obj ptr * int -> ('t, 'c) obj =
+           fn (p, i) => |*| (|+| (p, i))
 
-	fun sub' t (p, i) = |*! (|+! t (p, i))
+        fun sub' t (p, i) = |*! (|+! t (p, i))
 
- 	val convert : (('st, 'sc) obj ptr, ('tt, 'tc) obj ptr) W.witness ->
-		      ('st, 'sc) obj ptr -> ('tt, 'tc) obj ptr =
-	   fn w => fn x => w x
-	val convert' : (('st, 'sc) obj ptr, ('tt, 'tc) obj ptr) W.witness ->
-		       ('st, 'sc) obj ptr' -> ('tt, 'tc) obj ptr' =
-	   fn w => fn x => x
+        val convert : (('st, 'sc) obj ptr, ('tt, 'tc) obj ptr) W.witness ->
+                      ('st, 'sc) obj ptr -> ('tt, 'tc) obj ptr =
+           fn w => fn x => w x
+        val convert' : (('st, 'sc) obj ptr, ('tt, 'tc) obj ptr) W.witness ->
+                       ('st, 'sc) obj ptr' -> ('tt, 'tc) obj ptr' =
+           fn w => fn x => x
 
-	val ro : ('t, 'c) obj ptr   -> ('t, ro) obj ptr =
-	   fn x => convert (W.pointer (W.ro W.trivial)) x
-	val rw : ('t, 'sc) obj ptr  -> ('t, 'tc) obj ptr =
-	   fn x => convert (W.pointer (W.rw W.trivial)) x
+        val ro : ('t, 'c) obj ptr   -> ('t, ro) obj ptr =
+           fn x => convert (W.pointer (W.ro W.trivial)) x
+        val rw : ('t, 'sc) obj ptr  -> ('t, 'tc) obj ptr =
+           fn x => convert (W.pointer (W.rw W.trivial)) x
 
-	val ro' : ('t, 'c) obj ptr'  -> ('t, ro) obj ptr' =
-	   addr_id
-	val rw' : ('t, 'sc) obj ptr' -> ('t, 'tc) obj ptr' = 
-	   addr_id
+        val ro' : ('t, 'c) obj ptr'  -> ('t, ro) obj ptr' =
+           addr_id
+        val rw' : ('t, 'sc) obj ptr' -> ('t, 'tc) obj ptr' = 
+           addr_id
     end
 
     structure Arr = struct
         local
-	    fun asub (a, i, n, esz) =
-		(* take advantage of wrap-around to avoid the >= 0 test... *)
-		if Word.fromInt i < n then a ++ (Word.toIntX esz * i)
-		else raise General.Subscript
-	in
-	    val sub : (('t, 'n) arr, 'c) obj * int -> ('t, 'c) obj =
-	       fn ((a, ARR { typ, n, esz, ... }), i) => (asub (a, i, n, esz), typ)
-		| _ => bug "Arr.sub (non-array)"
-	    val sub' : 't S.size * 'n Dim.dim -> 
-	                (('t, 'n) arr, 'c) obj' * int -> ('t, 'c) obj' =
-	       fn (s, d) => fn (a, i) => asub (a, i, Word.fromInt (Dim.toInt d), s)
-	end
+            fun asub (a, i, n, esz) =
+                (* take advantage of wrap-around to avoid the >= 0 test... *)
+                if Word.fromInt i < n then a ++ (Word.toIntX esz * i)
+                else raise General.Subscript
+        in
+            val sub : (('t, 'n) arr, 'c) obj * int -> ('t, 'c) obj =
+               fn ((a, ARR { typ, n, esz, ... }), i) => (asub (a, i, n, esz), typ)
+                | _ => bug "Arr.sub (non-array)"
+            val sub' : 't S.size * 'n Dim.dim -> 
+                        (('t, 'n) arr, 'c) obj' * int -> ('t, 'c) obj' =
+               fn (s, d) => fn (a, i) => asub (a, i, Word.fromInt (Dim.toInt d), s)
+        end
 
-	val decay : (('t, 'n) arr, 'c) obj -> ('t, 'c) obj ptr =
-	   fn (a, ARR { typ, ... }) => (a, PTR (null, typ))
-	    | _ => bug "Arr.decay (non-array)"
+        val decay : (('t, 'n) arr, 'c) obj -> ('t, 'c) obj ptr =
+           fn (a, ARR { typ, ... }) => (a, PTR (null, typ))
+            | _ => bug "Arr.decay (non-array)"
 
         val decay' = addr_id
 
-	val reconstruct : ('t, 'c) obj ptr * 'n Dim.dim -> (('t, 'n) arr, 'c) obj =
-	   fn ((a, PTR (_, t)), d) => (a, T.arr (t, d))
-	    | _ => bug "Arr.reconstruct (non-pointer)"
+        val reconstruct : ('t, 'c) obj ptr * 'n Dim.dim -> (('t, 'n) arr, 'c) obj =
+           fn ((a, PTR (_, t)), d) => (a, T.arr (t, d))
+            | _ => bug "Arr.reconstruct (non-pointer)"
 
-	fun reconstruct' (a: addr, d: 'n Dim.dim) = a
+        fun reconstruct' (a: addr, d: 'n Dim.dim) = a
 
-	fun dim (_: addr, t) = T.dim t
+        fun dim (_: addr, t) = T.dim t
     end
 
     fun new' s = CMemory.alloc s
@@ -603,12 +603,12 @@
 
     val call' : ('a -> 'b) fptr T.typ -> ('a -> 'b) fptr' * 'a -> 'b =
        fn (FPTR mkf) => (fn (a, x) => (#2 (mkf a)) x)
-	| _ => bug "call' (non-function-pointer-type)"
+        | _ => bug "call' (non-function-pointer-type)"
 
     structure U = struct
         fun fcast (f : 'fa fptr') : 'fb fptr' = f
-	fun p2i (a : 'o ptr') : ulong = CMemory.p2i a
-	fun i2p (a : ulong) : 'o ptr' = CMemory.i2p a
+        fun p2i (a : 'o ptr') : ulong = CMemory.p2i a
+        fun i2p (a : ulong) : 'o ptr' = CMemory.i2p a
     end
 
     (* ------------- internal stuff ------------- *)
@@ -617,35 +617,35 @@
     val mk_voidptr : addr -> voidptr = fn a => a
 
     local
-	fun mk_field (t: 'f objt, i, (a, _)) = (a ++ i, t)
+        fun mk_field (t: 'f objt, i, (a, _)) = (a ++ i, t)
     in
         val mk_rw_field : 'm T.typ * int * ('s, 'c) su_obj -> ('m, 'c) obj = mk_field
-	val mk_ro_field : 'm T.typ * int * ('s, 'c) su_obj -> ('m, ro) obj = mk_field
-	fun mk_field' (i, a) = a ++ i
+        val mk_ro_field : 'm T.typ * int * ('s, 'c) su_obj -> ('m, ro) obj = mk_field
+        fun mk_field' (i, a) = a ++ i
     end
 
     local
-	fun mk_bf' (offset, bits, shift) a = let
-	    val a = a ++ offset
-	    val l = shift
-	    val lr = CMemory.int_bits - bits
-	    val r = lr - l
-	    val m = (~~0w0 << lr) >> l
-	    val im = ~~ m
-	in
-	    { a = a, l = l, r = r, lr = lr, m = m, im = im } : bf
-	end
-	fun mk_bf acc (a, _) = mk_bf' acc a
+        fun mk_bf' (offset, bits, shift) a = let
+            val a = a ++ offset
+            val l = shift
+            val lr = CMemory.int_bits - bits
+            val r = lr - l
+            val m = (~~0w0 << lr) >> l
+            val im = ~~ m
+        in
+            { a = a, l = l, r = r, lr = lr, m = m, im = im } : bf
+        end
+        fun mk_bf acc (a, _) = mk_bf' acc a
     in
         val mk_rw_ubf = mk_bf
-	val mk_ro_ubf = mk_bf
-	val mk_rw_ubf' = mk_bf'
-	val mk_ro_ubf' = mk_bf'
+        val mk_ro_ubf = mk_bf
+        val mk_rw_ubf' = mk_bf'
+        val mk_ro_ubf' = mk_bf'
 
         val mk_rw_sbf = mk_bf
-	val mk_ro_sbf = mk_bf
-	val mk_rw_sbf' = mk_bf'
-	val mk_ro_sbf' = mk_bf'
+        val mk_ro_sbf = mk_bf
+        val mk_rw_sbf' = mk_bf'
+        val mk_ro_sbf' = mk_bf'
     end
 
     val mk_su_size : word -> 's S.size =

Deleted: mlton/branches/on-20050420-cmm-branch/lib/mlnlffi/internals/c-int.x86-unix.mlb
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlnlffi/internals/c-int.x86-unix.mlb	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlnlffi/internals/c-int.x86-unix.mlb	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,35 +0,0 @@
-local
-  $(MLTON_ROOT)/basis/basis.mlb
-
-  ../memory/memory.x86-unix.mlb
-
-  ../c.sig
-  ../c-debug.sig
-  c-int.sig
-  c-int.sml
-  c.sml
-  c-debug.sml
-
-  ../zstring.sig
-  zstring.sml
-  tag.sml
-in
-  structure Tag
-
-  structure MLRep
-  signature C
-  structure C
-  signature C_INT
-  structure C_Int
-  signature C_DEBUG
-  structure C_Debug
-
-  signature ZSTRING
-  structure ZString
-
-  signature DYN_LINKAGE
-  structure DynLinkage
-
-  signature CMEMORY
-  structure CMemory
-end

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlnlffi/internals/zstring.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlnlffi/internals/zstring.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlnlffi/internals/zstring.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -13,54 +13,54 @@
  *)
 structure ZString : ZSTRING = struct
     local
-	open C
-	fun get' p = Get.uchar' (Ptr.|*! p)
-	fun set' (p, w) = Set.uchar' (Ptr.|*! p, w)
-	fun nxt' p = Ptr.|+! S.uchar (p, 1)
+        open C
+        fun get' p = Get.uchar' (Ptr.|*! p)
+        fun set' (p, w) = Set.uchar' (Ptr.|*! p, w)
+        fun nxt' p = Ptr.|+! S.uchar (p, 1)
     in
         type 'c zstring = (uchar, 'c) obj ptr
-	type 'c zstring' = (uchar, 'c) obj ptr'
+        type 'c zstring' = (uchar, 'c) obj ptr'
 
-	fun length' p = let
-	    fun loop (n, p) = if get' p = 0w0 then n else loop (n + 1, nxt' p)
-	in
-	    loop (0, p)
-	end
-	fun length p = length' (Light.ptr p)
+        fun length' p = let
+            fun loop (n, p) = if get' p = 0w0 then n else loop (n + 1, nxt' p)
+        in
+            loop (0, p)
+        end
+        fun length p = length' (Light.ptr p)
 
-	fun toML' p = let
-	    fun loop (l, p) =
-		case get' p of
-		    0w0 => String.implode (rev l)
-		  | c => loop ((Byte.byteToChar c) :: l, nxt' p)
-	in
-	    loop ([], p)
-	end
-	fun toML p = toML' (Light.ptr p)
+        fun toML' p = let
+            fun loop (l, p) =
+                case get' p of
+                    0w0 => String.implode (rev l)
+                  | c => loop ((Byte.byteToChar c) :: l, nxt' p)
+        in
+            loop ([], p)
+        end
+        fun toML p = toML' (Light.ptr p)
 
-	fun cpML' { from, to } = let
-	    val n = String.size from
-	    fun loop (i, p) =
-		if i >= n then set' (p, 0w0)
-		else (set' (p, Byte.charToByte (String.sub (from, i)));
-		      loop (i+1, nxt' p))
-	in
-	    loop (0, to)
-	end
-	fun cpML { from, to } = cpML' { from = from, to = Light.ptr to }
+        fun cpML' { from, to } = let
+            val n = String.size from
+            fun loop (i, p) =
+                if i >= n then set' (p, 0w0)
+                else (set' (p, Byte.charToByte (String.sub (from, i)));
+                      loop (i+1, nxt' p))
+        in
+            loop (0, to)
+        end
+        fun cpML { from, to } = cpML' { from = from, to = Light.ptr to }
 
-	fun dupML' s = let
-	    val z = C.alloc' C.S.uchar (Word.fromInt (size s + 1))
-	in
-	    cpML' { from = s, to = z };
-	    Ptr.rw' z
-	end
+        fun dupML' s = let
+            val z = C.alloc' C.S.uchar (Word.fromInt (size s + 1))
+        in
+            cpML' { from = s, to = z };
+            Ptr.rw' z
+        end
 
-	fun dupML s = let
-	    val z = C.alloc C.T.uchar (Word.fromInt (size s + 1))
-	in
-	    cpML { from = s, to = z };
-	    Ptr.rw z
-	end
+        fun dupML s = let
+            val z = C.alloc C.T.uchar (Word.fromInt (size s + 1))
+        in
+            cpML { from = s, to = z };
+            Ptr.rw z
+        end
     end
 end

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlnlffi/memory/bitop-fn.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlnlffi/memory/bitop-fn.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlnlffi/memory/bitop-fn.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -52,34 +52,34 @@
     type int = I.int
 
     local
-	val to   = W.fromLargeInt o I.toLarge
-	val from = I.fromLarge o W.toLargeIntX
-	fun bop f (x, y) = from (f (to x, to y)) (* binary op *)
-	fun uop f x = from (f (to x))	         (* unary op *)
-	fun sop f (x, y) = from (f (to x, y))    (* shift-like op *)
-	fun cop f (x, y) = f (to x, to y)        (* comparison-like op *)
+        val to   = W.fromLargeInt o I.toLarge
+        val from = I.fromLarge o W.toLargeIntX
+        fun bop f (x, y) = from (f (to x, to y)) (* binary op *)
+        fun uop f x = from (f (to x))            (* unary op *)
+        fun sop f (x, y) = from (f (to x, y))    (* shift-like op *)
+        fun cop f (x, y) = f (to x, to y)        (* comparison-like op *)
     in
         val ++ = bop W.+
-	val -- = bop W.-
-	val ** = bop W.*
-	val udiv = bop W.div
-	val umod = bop W.mod
-	val andb = bop W.andb
-	val orb = bop W.orb
-	val xorb = bop W.xorb
-	val notb = uop W.notb
+        val -- = bop W.-
+        val ** = bop W.*
+        val udiv = bop W.div
+        val umod = bop W.mod
+        val andb = bop W.andb
+        val orb = bop W.orb
+        val xorb = bop W.xorb
+        val notb = uop W.notb
 
-	val umax = bop W.max
-	val umin = bop W.min
+        val umax = bop W.max
+        val umin = bop W.min
 
-	val << = sop W.<<
-	val >> = sop W.>>
-	val ~>> = sop W.~>>
+        val << = sop W.<<
+        val >> = sop W.>>
+        val ~>> = sop W.~>>
 
-	val ulg = cop W.<
-	val ule = cop W.<=
-	val ugt = cop W.>
-	val uge = cop W.>=
-	val ucompare = cop W.compare
+        val ulg = cop W.<
+        val ule = cop W.<=
+        val ugt = cop W.>
+        val uge = cop W.>=
+        val ucompare = cop W.compare
     end
 end

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlnlffi/memory/linkage-libdl.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlnlffi/memory/linkage-libdl.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlnlffi/memory/linkage-libdl.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -23,15 +23,15 @@
          | _ => NONE)
 
     local
-	type era = unit ref
-	type addr = MLton.Pointer.t
+        type era = unit ref
+        type addr = MLton.Pointer.t
 
-	(* a handle remembers an address and the era of its creation as
-	 * well as a function to re-create the address when necessary *)
-	type h = (addr * era) ref * (unit -> addr)
+        (* a handle remembers an address and the era of its creation as
+         * well as a function to re-create the address when necessary *)
+        type h = (addr * era) ref * (unit -> addr)
     in
         type lib_handle = h
-	type addr_handle = h
+        type addr_handle = h
     end
 
     type mode = Word32.word
@@ -42,114 +42,114 @@
        val RTLD_LOCAL  = 0wx00000
     in
        fun mk_mode {lazy: bool, global: bool} : mode=
-	  Word32.orb
-	  (if lazy then RTLD_LAZY else RTLD_NOW,
-	   if global then RTLD_GLOBAL else RTLD_LOCAL)
+          Word32.orb
+          (if lazy then RTLD_LAZY else RTLD_NOW,
+           if global then RTLD_GLOBAL else RTLD_LOCAL)
     end
 
     local
-	(* low-level linkage via dlopen/dlsym *)
+        (* low-level linkage via dlopen/dlsym *)
         local
-	   val dlopen =
-	      _import "dlopen": string * mode -> MLton.Pointer.t;
-	   val dlopen_null =
-	      _import "dlopen": MLton.Pointer.t * mode -> MLton.Pointer.t;
-	   val dlsym =
-	      _import "dlsym": MLton.Pointer.t * string -> MLton.Pointer.t;
-	   val dlerror =
-	      _import "dlerror": unit -> MLton.Pointer.t;
-	   val dlclose =
-	      _import "dlclose": MLton.Pointer.t -> Int32.int;
-	in
-	   (* mid-level linkage *)
-	   val dlopen = fn (filename, lazy, global) =>
-	      let
-		 val mode = mk_mode {lazy = lazy, global = global}
-	      in
-		 case filename of
-		    NONE => dlopen_null (MLton.Pointer.null, mode)
-		  | SOME filename => dlopen (filename ^ "\000", mode)
-	      end
-	   val dlsym = fn (hndl, symbol) =>
-	      dlsym (hndl, symbol ^ "\000")
-	   val dlerror = fn () =>
-	      let
-		 val addr = dlerror ()
-	      in
-		 if addr = MLton.Pointer.null
-		    then NONE
-		    else let
-			    fun loop (index, cs) =
-			       let
-				  val w = MLton.Pointer.getWord8 (addr, index)
-				  val c = Byte.byteToChar w
-			       in
-				  if c = #"\000"
-				     then SOME (implode (rev cs))
-				     else loop (index + 1, c::cs)
-			       end
-			 in
-			    loop (0, [])
-			 end
-	      end
-	   val dlclose = fn hndl =>
-	      let val _ = dlclose hndl
-	      in ()
-	      end
-	end
+           val dlopen =
+              _import "dlopen": string * mode -> MLton.Pointer.t;
+           val dlopen_null =
+              _import "dlopen": MLton.Pointer.t * mode -> MLton.Pointer.t;
+           val dlsym =
+              _import "dlsym": MLton.Pointer.t * string -> MLton.Pointer.t;
+           val dlerror =
+              _import "dlerror": unit -> MLton.Pointer.t;
+           val dlclose =
+              _import "dlclose": MLton.Pointer.t -> Int32.int;
+        in
+           (* mid-level linkage *)
+           val dlopen = fn (filename, lazy, global) =>
+              let
+                 val mode = mk_mode {lazy = lazy, global = global}
+              in
+                 case filename of
+                    NONE => dlopen_null (MLton.Pointer.null, mode)
+                  | SOME filename => dlopen (filename ^ "\000", mode)
+              end
+           val dlsym = fn (hndl, symbol) =>
+              dlsym (hndl, symbol ^ "\000")
+           val dlerror = fn () =>
+              let
+                 val addr = dlerror ()
+              in
+                 if addr = MLton.Pointer.null
+                    then NONE
+                    else let
+                            fun loop (index, cs) =
+                               let
+                                  val w = MLton.Pointer.getWord8 (addr, index)
+                                  val c = Byte.byteToChar w
+                               in
+                                  if c = #"\000"
+                                     then SOME (implode (rev cs))
+                                     else loop (index + 1, c::cs)
+                               end
+                         in
+                            loop (0, [])
+                         end
+              end
+           val dlclose = fn hndl =>
+              let val _ = dlclose hndl
+              in ()
+              end
+        end
 
-	(* label used for CleanUp *)
-	val label = "DynLinkNewEra"
+        (* label used for CleanUp *)
+        val label = "DynLinkNewEra"
 
-	(* generate a new "era" indicator *)
-	fun newEra () = ref ()
+        (* generate a new "era" indicator *)
+        fun newEra () = ref ()
 
-	(* the current era *)
-	val now = ref (newEra ())
+        (* the current era *)
+        val now = ref (newEra ())
 
-	(* make a handle, remember era of creation of its current value *)
-	fun mkHandle f = (ref (f (), !now), f)
+        (* make a handle, remember era of creation of its current value *)
+        fun mkHandle f = (ref (f (), !now), f)
 
-	(* fetch from a handle; use the stored address if it was created
-	 * in the current era, otherwise regenerate the address *)
-	fun get (r as ref (a, e), f) =
-	    if e = !now then a
-	    else let val a = f ()
-		 in r := (a, !now); a
-		 end
+        (* fetch from a handle; use the stored address if it was created
+         * in the current era, otherwise regenerate the address *)
+        fun get (r as ref (a, e), f) =
+            if e = !now then a
+            else let val a = f ()
+                 in r := (a, !now); a
+                 end
 
-	(* call a dl-function and check for errors *)
-	fun checked dlf x = let
-	    val r = dlf x
-	in
-	    case dlerror () of
-		NONE => r
-	      | SOME s => raise DynLinkError s
-	end
+        (* call a dl-function and check for errors *)
+        fun checked dlf x = let
+            val r = dlf x
+        in
+            case dlerror () of
+                NONE => r
+              | SOME s => raise DynLinkError s
+        end
 
-	(* add a cleanup handler that causes a new era to start
-	 * every time the runtime system is started anew *)
+        (* add a cleanup handler that causes a new era to start
+         * every time the runtime system is started anew *)
 (*
-	open SMLofNJ.Internals.CleanUp
-	val _ = addCleaner (label, [AtInit, AtInitFn],
-			    fn _ => now := newEra ())
+        open SMLofNJ.Internals.CleanUp
+        val _ = addCleaner (label, [AtInit, AtInitFn],
+                            fn _ => now := newEra ())
 
         val _ = Cleaner.addNew (Cleaner.atLoadWorld, fn () => now := newEra ())
 *)
     in
         val main_lib = mkHandle (fn () => checked dlopen (NONE, true, true))
 
-	fun open_lib' { name, lazy, global, dependencies } =
-	    mkHandle (fn () => (app (ignore o get) dependencies;
-				checked dlopen (SOME name, lazy, global)))
-	fun open_lib { name, lazy, global } =
-	    open_lib' { name = name, lazy = lazy, global = global,
-			dependencies = [] }
+        fun open_lib' { name, lazy, global, dependencies } =
+            mkHandle (fn () => (app (ignore o get) dependencies;
+                                checked dlopen (SOME name, lazy, global)))
+        fun open_lib { name, lazy, global } =
+            open_lib' { name = name, lazy = lazy, global = global,
+                        dependencies = [] }
 
-	fun lib_symbol (lh, s) = mkHandle (fn () => checked dlsym (get lh, s))
+        fun lib_symbol (lh, s) = mkHandle (fn () => checked dlsym (get lh, s))
 
-	val addr = get
+        val addr = get
 
-	fun close_lib lh = checked dlclose (get lh)
+        fun close_lib lh = checked dlclose (get lh)
     end
 end

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlnlffi/memory/linkage.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlnlffi/memory/linkage.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlnlffi/memory/linkage.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -18,15 +18,15 @@
 
     exception DynLinkError of string
 
-    type lib_handle		(* handle on dynamically linked library (DL) *)
-    type addr_handle		(* handle on address obtained from a DL *)
+    type lib_handle             (* handle on dynamically linked library (DL) *)
+    type addr_handle            (* handle on address obtained from a DL *)
 
-    val main_lib : lib_handle	(* the runtime system itself *)
+    val main_lib : lib_handle   (* the runtime system itself *)
 
     (* link new library and return its handle *)
     val open_lib : { name: string, lazy: bool, global: bool } -> lib_handle
     val open_lib' : { name: string, lazy: bool, global: bool,
-		      dependencies: lib_handle list } -> lib_handle
+                      dependencies: lib_handle list } -> lib_handle
 
     (* get the address handle of a symbol exported from a DL *)
     val lib_symbol : lib_handle * string -> addr_handle

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlnlffi/memory/memaccess-a4c1s2i4l4ll8f4d8.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlnlffi/memory/memaccess-a4c1s2i4l4ll8f4d8.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlnlffi/memory/memaccess-a4c1s2i4l4ll8f4d8.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -40,7 +40,7 @@
 
     local 
        fun get g addr =
-	  g (addr, 0)
+          g (addr, 0)
     in
        val load_addr = get Ptr.getPointer
        val load_uchar = get Ptr.getWord8
@@ -59,7 +59,7 @@
 
     local
        fun set s (addr, x) =
-	  s (addr, 0, x)
+          s (addr, 0, x)
     in
        val store_addr = set Ptr.setPointer
        val store_uchar = set Ptr.setWord8
@@ -80,10 +80,10 @@
 
     (* this needs to be severely optimized... *)
     fun bcopy { from: addr, to: addr, bytes: word } =
-	if bytes > 0w0 then
-	    (store_uchar (to, load_uchar from);
-	     bcopy { from = from ++ 1, to = to ++ 1, bytes = bytes - 0w1 })
-	else ()
+        if bytes > 0w0 then
+            (store_uchar (to, load_uchar from);
+             bcopy { from = from ++ 1, to = to ++ 1, bytes = bytes - 0w1 })
+        else ()
 
     (* types used in C calling convention *)
     type cc_addr = MLton.Pointer.t

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlnlffi/memory/memalloc-a4-unix.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlnlffi/memory/memalloc-a4-unix.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlnlffi/memory/memalloc-a4-unix.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -29,28 +29,28 @@
 
     fun sys_malloc (n : Word32.word) = 
         let val w_p = _import * : MLton.Pointer.t -> Word32.word -> addr;
-	    val a = w_p (DL.addr malloc_h) n
-	in if a = Ptr.null then raise OutOfMemory else a
-	end
+            val a = w_p (DL.addr malloc_h) n
+        in if a = Ptr.null then raise OutOfMemory else a
+        end
 
     fun sys_free (a : addr) = 
         let val p_u = _import * : MLton.Pointer.t -> addr -> unit;
-	in p_u (DL.addr free_h) a
-	end
+        in p_u (DL.addr free_h) a
+        end
 
 (*
     fun sys_malloc (n : Word32.word) = 
         let val w_p = _import "malloc" : Word32.word -> addr;
-	    val a = w_p n
-	in if a = Ptr.null then raise OutOfMemory else a
-	end
+            val a = w_p n
+        in if a = Ptr.null then raise OutOfMemory else a
+        end
 
     fun sys_free (a : addr) = 
         let val p_u = _import "free" : addr -> unit;
-	in p_u a
-	end
+        in p_u a
+        end
 *)
 
     fun alloc bytes = sys_malloc bytes
     fun free a = sys_free a
-end
\ No newline at end of file
+end

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlnlffi/memory/memalloc.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlnlffi/memory/memalloc.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlnlffi/memory/memalloc.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -15,8 +15,8 @@
 
     exception OutOfMemory
 
-    eqtype addr'		(* to avoid clash with addr from CMEMACCESS *)
+    eqtype addr'                (* to avoid clash with addr from CMEMACCESS *)
 
-    val alloc : word -> addr'	(* may raise OutOfMemory *)
+    val alloc : word -> addr'   (* may raise OutOfMemory *)
     val free : addr' -> unit
 end

Copied: mlton/branches/on-20050420-cmm-branch/lib/mlnlffi/memory/memory.32bit-unix.mlb (from rev 4358, mlton/trunk/lib/mlnlffi/memory/memory.32bit-unix.mlb)

Copied: mlton/branches/on-20050420-cmm-branch/lib/mlnlffi/memory/memory.mlb (from rev 4358, mlton/trunk/lib/mlnlffi/memory/memory.mlb)

Deleted: mlton/branches/on-20050420-cmm-branch/lib/mlnlffi/memory/memory.x86-linux.mlb
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlnlffi/memory/memory.x86-linux.mlb	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlnlffi/memory/memory.x86-linux.mlb	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1 +0,0 @@
-memory.x86-unix.mlb
\ No newline at end of file

Deleted: mlton/branches/on-20050420-cmm-branch/lib/mlnlffi/memory/memory.x86-unix.mlb
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlnlffi/memory/memory.x86-unix.mlb	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlnlffi/memory/memory.x86-unix.mlb	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,25 +0,0 @@
-local
-  $(MLTON_ROOT)/basis/basis.mlb
-  $(MLTON_ROOT)/basis/mlton.mlb
-
-  linkage.sig
-  ann "allowImport true" in
-    linkage-libdl.sml
-  end
-  bitop-fn.sml
-  mlrep-i8i16i32i32i64f32f64.sml
-  memaccess.sig
-  memaccess-a4c1s2i4l4ll8f4d8.sml
-  memalloc.sig
-  ann "allowImport true" in
-    memalloc-a4-unix.sml
-  end
-  memory.sig
-  memory.sml
-in
-  signature CMEMORY
-  structure CMemory
-  signature DYN_LINKAGE
-  structure DynLinkage
-  structure MLRep
-end

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlnlffi/memory/mlrep-i8i16i32i32i64f32f64.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlnlffi/memory/mlrep-i8i16i32i32i64f32f64.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlnlffi/memory/mlrep-i8i16i32i32i64f32f64.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -22,43 +22,43 @@
 structure MLRep = struct
     structure Char =
        struct
-	  structure Signed = Int8
-	  structure Unsigned = Word8
-	  (* word-style bit-operations on integers... *)
-	  structure SignedBitops = IntBitOps(structure I = Signed
-					     structure W = Unsigned)
+          structure Signed = Int8
+          structure Unsigned = Word8
+          (* word-style bit-operations on integers... *)
+          structure SignedBitops = IntBitOps(structure I = Signed
+                                             structure W = Unsigned)
        end
     structure Short =
        struct
-	  structure Signed = Int16
-	  structure Unsigned = Word16
-	  (* word-style bit-operations on integers... *)
-	  structure SignedBitops = IntBitOps(structure I = Signed
-					     structure W = Unsigned)
+          structure Signed = Int16
+          structure Unsigned = Word16
+          (* word-style bit-operations on integers... *)
+          structure SignedBitops = IntBitOps(structure I = Signed
+                                             structure W = Unsigned)
        end
     structure Int =
        struct
-	  structure Signed = Int32
-	  structure Unsigned = Word32
-	  (* word-style bit-operations on integers... *)
-	  structure SignedBitops = IntBitOps(structure I = Signed
-					     structure W = Unsigned)
+          structure Signed = Int32
+          structure Unsigned = Word32
+          (* word-style bit-operations on integers... *)
+          structure SignedBitops = IntBitOps(structure I = Signed
+                                             structure W = Unsigned)
        end  
     structure Long =
        struct
-	  structure Signed = Int32
-	  structure Unsigned = Word32
-	  (* word-style bit-operations on integers... *)
-	  structure SignedBitops = IntBitOps(structure I = Signed
-					     structure W = Unsigned)
+          structure Signed = Int32
+          structure Unsigned = Word32
+          (* word-style bit-operations on integers... *)
+          structure SignedBitops = IntBitOps(structure I = Signed
+                                             structure W = Unsigned)
        end
     structure LongLong =
        struct
-	  structure Signed = Int64
-	  structure Unsigned = Word64
-	  (* word-style bit-operations on integers... *)
-	  structure SignedBitops = IntBitOps(structure I = Signed
-					     structure W = Unsigned)
+          structure Signed = Int64
+          structure Unsigned = Word64
+          (* word-style bit-operations on integers... *)
+          structure SignedBitops = IntBitOps(structure I = Signed
+                                             structure W = Unsigned)
        end
     structure Float = Real32
     structure Double = Real64

Copied: mlton/branches/on-20050420-cmm-branch/lib/mlnlffi/memory/platform (from rev 4358, mlton/trunk/lib/mlnlffi/memory/platform)


Property changes on: mlton/branches/on-20050420-cmm-branch/lib/mlton
___________________________________________________________________
Name: svn:ignore
   - sources.sml
mlton.sml
   + sources.sml
mlton.sml


Deleted: mlton/branches/on-20050420-cmm-branch/lib/mlton/.cvsignore
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/.cvsignore	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/.cvsignore	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,2 +0,0 @@
-sources.sml
-mlton.sml

Copied: mlton/branches/on-20050420-cmm-branch/lib/mlton/.ignore (from rev 4358, mlton/trunk/lib/mlton/.ignore)

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/Makefile
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/Makefile	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/Makefile	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,11 @@
+## Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ #    Jagannathan, and Stephen Weeks.
+ # Copyright (C) 1997-2000 NEC Research Institute.
+ #
+ # MLton is released under a BSD-style license.
+ # See the file MLton-LICENSE for details.
+ ##
+
 all:
 
 .PHONY: clean

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/Makefile
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/Makefile	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/Makefile	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,5 +1,12 @@
+## Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ #    Jagannathan, and Stephen Weeks.
+ # Copyright (C) 1997-2000 NEC Research Institute.
+ #
+ # MLton is released under a BSD-style license.
+ # See the file MLton-LICENSE for details.
+ ##
+
 all:
-	
 
 .PHONY: tags
 tags:
@@ -9,4 +16,3 @@
 clean:
 	../../../bin/clean
 
-	

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/alpha-beta.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/alpha-beta.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/alpha-beta.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 functor AlphaBeta (S: ALPHA_BETA_STRUCTS): ALPHA_BETA = 
 struct
 
@@ -11,29 +12,29 @@
 
 val traceAlphaBeta =
    Trace.trace3
-   ("alphaBeta", State.layout, Value.layout, Value.layout, Value.layout)
+   ("AlphaBeta.alphaBeta", State.layout, Value.layout, Value.layout, Value.layout)
 
 fun messenger () =
    let
       val numCalls = ref 0
       val next = ref 1
       fun count f =
-	 (Int.inc numCalls
-	  ; if !numCalls = !next
-	       then
-		  let
-		     val _ = next := 2 * !next
-		     open Layout
-		  in
-		     output (seq [str (Justify.justify (Int.toString (!numCalls),
-							10,
-							Justify.Left)),
-				  str " ",
-				  f ()],
-			     Out.error)
-		     ; Out.newline Out.error
-		  end
-	    else ())
+         (Int.inc numCalls
+          ; if !numCalls = !next
+               then
+                  let
+                     val _ = next := 2 * !next
+                     open Layout
+                  in
+                     output (seq [str (Justify.justify (Int.toString (!numCalls),
+                                                        10,
+                                                        Justify.Left)),
+                                  str " ",
+                                  f ()],
+                             Out.error)
+                     ; Out.newline Out.error
+                  end
+            else ())
    in count
    end
 
@@ -41,39 +42,39 @@
    let
       val count = messenger ()
       fun alphaBeta arg : Value.t =
-	 traceAlphaBeta
-	 (fn (s: State.t, a: Value.t, b: Value.t) =>
-	  (count (fn () =>
-		  let open Layout
-		  in align [tuple [Value.layout a, Value.layout b],
-			    State.layout s]
-		  end)
-	   ; (case State.evaluate s of
-		 State.Leaf v =>
-		    if Value.<= (v, a)
-		       then a
-		    else if Value.<= (b, v)
-			    then b
-			 else v
-	       | State.NonLeaf {lower, upper} =>
-		    if Value.<= (upper, a)
-		       then a
-		    else if Value.<= (b, lower)
-			    then b
-			 else
-			    let
-			       val a' = Value.move b
-			       val b' = Value.move a
-			       (* inv: a' <= b'' <= b' *)
-			       fun loop (ss, b'') =
-				  if Value.equals (a', b'') then b''
-				  else
-				     case ss of
-					[] => b''
-				      | s :: ss =>
-					   loop (ss, alphaBeta (s, a', b''))
-			    in Value.unmove (loop (State.succ s, b'))
-			    end))) arg
+         traceAlphaBeta
+         (fn (s: State.t, a: Value.t, b: Value.t) =>
+          (count (fn () =>
+                  let open Layout
+                  in align [tuple [Value.layout a, Value.layout b],
+                            State.layout s]
+                  end)
+           ; (case State.evaluate s of
+                 State.Leaf v =>
+                    if Value.<= (v, a)
+                       then a
+                    else if Value.<= (b, v)
+                            then b
+                         else v
+               | State.NonLeaf {lower, upper} =>
+                    if Value.<= (upper, a)
+                       then a
+                    else if Value.<= (b, lower)
+                            then b
+                         else
+                            let
+                               val a' = Value.move b
+                               val b' = Value.move a
+                               (* inv: a' <= b'' <= b' *)
+                               fun loop (ss, b'') =
+                                  if Value.equals (a', b'') then b''
+                                  else
+                                     case ss of
+                                        [] => b''
+                                      | s :: ss =>
+                                           loop (ss, alphaBeta (s, a', b''))
+                            in Value.unmove (loop (State.succ s, b'))
+                            end))) arg
    in
       alphaBeta arg
    end
@@ -83,26 +84,26 @@
 structure Interval =
    struct
       datatype t = T of {lower: Value.t,
-			 upper: Value.t}
+                         upper: Value.t}
 
       fun layout (T {lower, upper}) =
-	 if Value.equals (lower, upper)
-	    then Value.layout lower
-	 else let open Layout
-	      in seq [Value.layout lower, str "-", Value.layout upper]
-	      end
-	   
+         if Value.equals (lower, upper)
+            then Value.layout lower
+         else let open Layout
+              in seq [Value.layout lower, str "-", Value.layout upper]
+              end
+           
       val make = T
 
       local
-	 fun make f (T r) = f r
+         fun make f (T r) = f r
       in
-	 val lower = make #lower
-	 val upper = make #upper
+         val lower = make #lower
+         val upper = make #upper
       end
 
       val all = T {lower = Value.smallest,
-		   upper = Value.largest}
+                   upper = Value.largest}
 
       fun above (v: Value.t): t = T {lower = v, upper = Value.largest}
 
@@ -113,24 +114,24 @@
       fun point v = T {lower = v, upper = v}
 
       fun closest (T {lower, upper}, v: Value.t): Value.t =
-	 if Value.<= (v, lower) then lower
-	 else if Value.>= (v, upper) then upper
-	      else v
+         if Value.<= (v, lower) then lower
+         else if Value.>= (v, upper) then upper
+              else v
 
       fun contains (T {lower, upper}, v: Value.t): bool =
-	 Value.<= (lower, v) andalso Value.<= (v, upper)
+         Value.<= (lower, v) andalso Value.<= (v, upper)
 
       fun move (T {lower, upper}): t =
-	 T {lower = Value.move upper,
-	   upper = Value.move lower}
+         T {lower = Value.move upper,
+           upper = Value.move lower}
 
       fun intersect (i: t, i': t): t =
-	 let val lower = Value.max (lower i, lower i')
-	    val upper = Value.min (upper i, upper i')
-	 in if Value.> (lower, upper)
-	       then Error.bug "intersect returned empty intersection"
-	    else T {lower = lower, upper = upper}
-	 end
+         let val lower = Value.max (lower i, lower i')
+            val upper = Value.min (upper i, upper i')
+         in if Value.> (lower, upper)
+               then Error.bug "AlphaBeta.Interval.intersect: empty intersection"
+            else T {lower = lower, upper = upper}
+         end
 (*      val intersect = Trace.trace2 ("intersect", layout, layout, layout) intersect *)
    end
 
@@ -141,11 +142,11 @@
  *    let val v = trace f (s, i)
  *       val v' = alphaBetaNoCache (s, Interval.lower i, Interval.upper i)
  *    in if Value.equals (v, v')
- * 	 then ()
+ *       then ()
  *       else Misc.bug (let open Layout
- * 		    in align [str "v = ", Value.layout v,
- * 			     str "v' = ", Value.layout v']
- * 		    end);
+ *                  in align [str "v = ", Value.layout v,
+ *                           str "v' = ", Value.layout v']
+ *                  end);
  *       v
  *    end
  * 
@@ -156,70 +157,70 @@
    let
       val count = messenger ()
       fun alphaBeta (s: State.t, i: Interval.t): Value.t =
-	 (count (fn () =>
-		 let open Layout
-		 in align [Interval.layout i, State.layout s]
-		 end)
-	  ; (case State.evaluate s of
-		State.Leaf v => Interval.closest (i, v)
-	      | State.NonLeaf {lower, upper} =>
-		   if Value.<= (upper, Interval.lower i)
-		      then Interval.lower i
-		   else if Value.<= (Interval.upper i, lower)
-			   then Interval.upper i
-			else
-			   let
-			      val {update, value} = Cache.peek (c, s)
-			      fun search iKnown =
-				 let
-				    val iSearch = Interval.intersect (i, iKnown)
-				    val Interval.T {lower, upper} =
-				       Interval.move iSearch
-				    (* inv: lower <= v <= upper *)
-				    fun loop (ss, v) =
-				       if Value.equals (lower, v) then v
-				       else
-					  case ss of
-					     [] => v
-					   | s :: ss =>
-						loop
-						(ss,
-						 alphaBeta
-						 (s, Interval.T {lower = lower,
-								 upper = v}))
-				    val v =
-				       Value.unmove (loop (State.succ s, upper))
-				    val Interval.T {lower, upper} = iSearch
-				    val iKnown =
-				       Interval.intersect
-				       (iKnown,
-					if Value.equals (v, upper)
-					   then Interval.above upper
-					else if Value.equals (v, lower)
-						then Interval.below lower
-					     else Interval.point v)
-				 in (*Misc.assert (fn () =>
-				     Interval.contains
-				     (iKnown,
-				     alphaBetaNoCache (s, Value.smallest,
-				     Value.largest))); *)
-				    update iKnown; v
-				 end
-			   in
-			      case value of
-				 SOME i' =>
-				    let
-				       val Interval.T {lower, upper} = i
-				       val Interval.T {lower = lower', upper = upper'} =
-					  i'
-				    in if Value.<= (upper', lower)
-					  then lower
-				       else if Value.>= (lower', upper)
-					       then upper
-					    else search i'
-				    end
-			       | NONE => search Interval.all
-			   end))
+         (count (fn () =>
+                 let open Layout
+                 in align [Interval.layout i, State.layout s]
+                 end)
+          ; (case State.evaluate s of
+                State.Leaf v => Interval.closest (i, v)
+              | State.NonLeaf {lower, upper} =>
+                   if Value.<= (upper, Interval.lower i)
+                      then Interval.lower i
+                   else if Value.<= (Interval.upper i, lower)
+                           then Interval.upper i
+                        else
+                           let
+                              val {update, value} = Cache.peek (c, s)
+                              fun search iKnown =
+                                 let
+                                    val iSearch = Interval.intersect (i, iKnown)
+                                    val Interval.T {lower, upper} =
+                                       Interval.move iSearch
+                                    (* inv: lower <= v <= upper *)
+                                    fun loop (ss, v) =
+                                       if Value.equals (lower, v) then v
+                                       else
+                                          case ss of
+                                             [] => v
+                                           | s :: ss =>
+                                                loop
+                                                (ss,
+                                                 alphaBeta
+                                                 (s, Interval.T {lower = lower,
+                                                                 upper = v}))
+                                    val v =
+                                       Value.unmove (loop (State.succ s, upper))
+                                    val Interval.T {lower, upper} = iSearch
+                                    val iKnown =
+                                       Interval.intersect
+                                       (iKnown,
+                                        if Value.equals (v, upper)
+                                           then Interval.above upper
+                                        else if Value.equals (v, lower)
+                                                then Interval.below lower
+                                             else Interval.point v)
+                                 in (*Misc.assert (fn () =>
+                                     Interval.contains
+                                     (iKnown,
+                                     alphaBetaNoCache (s, Value.smallest,
+                                     Value.largest))); *)
+                                    update iKnown; v
+                                 end
+                           in
+                              case value of
+                                 SOME i' =>
+                                    let
+                                       val Interval.T {lower, upper} = i
+                                       val Interval.T {lower = lower', upper = upper'} =
+                                          i'
+                                    in if Value.<= (upper', lower)
+                                          then lower
+                                       else if Value.>= (lower', upper)
+                                               then upper
+                                            else search i'
+                                    end
+                               | NONE => search Interval.all
+                           end))
    in alphaBeta (s, i)
    end
 

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/alpha-beta.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/alpha-beta.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/alpha-beta.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,40 +1,41 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature ALPHA_BETA_STRUCTS = 
    sig
       structure Value:
-	 sig
-	    include ORDER
+         sig
+            include ORDER
 
-	    val largest: t
-	    val smallest: t
-	    val move: t -> t
-	    val unmove: t -> t
-	 end
+            val largest: t
+            val smallest: t
+            val move: t -> t
+            val unmove: t -> t
+         end
       
       structure State:
-	 sig
-	    type t
+         sig
+            type t
 
-	    val succ: t -> t list
-	    datatype value =
-	       Leaf of Value.t
-	     | NonLeaf of {lower: Value.t, upper: Value.t}
-	    val evaluate: t -> value
-	    val layout: t -> Layout.t
-	 end
+            val succ: t -> t list
+            datatype value =
+               Leaf of Value.t
+             | NonLeaf of {lower: Value.t, upper: Value.t}
+            val evaluate: t -> value
+            val layout: t -> Layout.t
+         end
 
       structure Cache:
-	 sig
-	    type 'a t
+         sig
+            type 'a t
 
-	    val peek: 'a t * State.t -> {value: 'a option,
-					 update: 'a -> unit}
-	 end
+            val peek: 'a t * State.t -> {value: 'a option,
+                                         update: 'a -> unit}
+         end
    end
 
 signature ALPHA_BETA = 
@@ -47,17 +48,17 @@
       val alphaBeta: State.t * Value.t * Value.t -> Value.t
 
       structure Interval:
-	 sig
-	    type t
+         sig
+            type t
 
-	    val make: {lower: Value.t, upper: Value.t} -> t
-	    val all: t
-	    val point: Value.t -> t
-	    val isPoint: t -> bool
-	    val lower: t -> Value.t
-	    val upper: t -> Value.t
-	    val layout: t -> Layout.t
-	 end
+            val make: {lower: Value.t, upper: Value.t} -> t
+            val all: t
+            val point: Value.t -> t
+            val isPoint: t -> bool
+            val lower: t -> Value.t
+            val upper: t -> Value.t
+            val layout: t -> Layout.t
+         end
 
       (* Return closest value in interval to maximum value. *)
       (* May modify the cache. *)

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/append-list.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/append-list.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/append-list.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 type int = Int.t
    
 signature APPEND_LIST = 

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/append-list.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/append-list.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/append-list.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 structure AppendList: APPEND_LIST =
 struct
 
@@ -22,20 +23,20 @@
  | Vector of 'a vector (* Nonempty. *)
    
 val isEmpty = fn Empty => true | _ => false
-	 
+         
 fun append (t1, t2) =
    if isEmpty t1
       then t2
    else if isEmpty t2
-	   then t1
-	else Append (t1, t2)
+           then t1
+        else Append (t1, t2)
 
 fun appends l =
    let
       val l = List.keepAll (l, not o isEmpty)
    in
       if List.isEmpty l
-	 then Empty
+         then Empty
       else Appends l
    end
 
@@ -44,7 +45,7 @@
       val v = Vector.keepAll (v, not o isEmpty)
    in
       if Vector.isEmpty v
-	 then Empty
+         then Empty
       else AppendsV v
    end
 
@@ -75,16 +76,16 @@
 fun fold (l, b, f) =
    let
       fun loop (l, b) =
-	 case l of
-	    Append (l, l') => loop (l', loop (l, b))
-	  | Appends l => List.fold (l, b, loop)
-	  | AppendsV v => Vector.fold (v, b, loop)
-	  | Cons (x, l) => loop (l, f (x, b))
-	  | Empty => b
-	  | List l => List.fold (l, b, f)
-	  | Single x => f (x, b)
-	  | Snoc (l, x) => f (x, loop (l, b))
-	  | Vector v => Vector.fold (v, b, f)
+         case l of
+            Append (l, l') => loop (l', loop (l, b))
+          | Appends l => List.fold (l, b, loop)
+          | AppendsV v => Vector.fold (v, b, loop)
+          | Cons (x, l) => loop (l, f (x, b))
+          | Empty => b
+          | List l => List.fold (l, b, f)
+          | Single x => f (x, b)
+          | Snoc (l, x) => f (x, loop (l, b))
+          | Vector v => Vector.fold (v, b, f)
    in loop (l, b)
    end
 
@@ -95,31 +96,31 @@
 fun foldr (l, b, f) =
    let
       fun loop (l, b) =
-	 case l of
-	    Append (l, l') => loop (l, loop (l', b))
-	  | Appends l => List.foldr (l, b, loop)
-	  | AppendsV v => Vector.foldr (v, b, loop)
-	  | Cons (x, l) => f (x, loop (l, b))
-	  | Empty => b
-	  | List l => List.foldr (l, b, f)
-	  | Single x => f (x, b)
-	  | Snoc (l, x) => loop (l, f (x, b))
-	  | Vector v => Vector.foldr (v, b, f)
+         case l of
+            Append (l, l') => loop (l, loop (l', b))
+          | Appends l => List.foldr (l, b, loop)
+          | AppendsV v => Vector.foldr (v, b, loop)
+          | Cons (x, l) => f (x, loop (l, b))
+          | Empty => b
+          | List l => List.foldr (l, b, f)
+          | Single x => f (x, b)
+          | Snoc (l, x) => loop (l, f (x, b))
+          | Vector v => Vector.foldr (v, b, f)
    in loop (l, b)
    end
 
 fun map (l, f) =
    let
       val rec loop =
-	 fn Append (l, l') => Append (loop l, loop l')
-	  | Appends l => Appends (List.map (l, loop))
-	  | AppendsV v => AppendsV (Vector.map (v, loop))
-	  | Cons (x, l) => Cons (f x, loop l)
-	  | Empty => Empty
-	  | List l => List (List.map (l, f))
-	  | Single x => Single (f x)
-	  | Snoc (l, x) => Snoc (loop l, f x)
-	  | Vector v => Vector (Vector.map (v, f))
+         fn Append (l, l') => Append (loop l, loop l')
+          | Appends l => Appends (List.map (l, loop))
+          | AppendsV v => AppendsV (Vector.map (v, loop))
+          | Cons (x, l) => Cons (f x, loop l)
+          | Empty => Empty
+          | List l => List (List.map (l, f))
+          | Single x => Single (f x)
+          | Snoc (l, x) => Snoc (loop l, f x)
+          | Vector v => Vector (Vector.map (v, f))
    in loop l
    end
 

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/array.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/array.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/array.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,14 +1,15 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 functor Array (S: sig
-		     include ARRAY_STRUCTS
-		     val unsafeSub: 'a t * int -> 'a
-		     val unsafeUpdate: 'a t * int * 'a -> unit
-		  end): ARRAY =
+                     include ARRAY_STRUCTS
+                     val unsafeSub: 'a t * int -> 'a
+                     val unsafeUpdate: 'a t * int * 'a -> unit
+                  end): ARRAY =
 struct
 
 open S
@@ -39,23 +40,23 @@
 fun shuffle a = shuffleN (a, length a)
 
 fun getAndSet a = (fn i => sub (a, i),
-		   fn (i, x) => update (a, i, x))
+                   fn (i, x) => update (a, i, x))
 
 fun fromListRev l =
    case l of
       [] => new0 ()
     | x :: l =>
-	 let
-	    val n = List.length l
-	    val a = new (n + 1, x)
-	    fun loop (l, i) =
-	       case l of
-		  [] => ()
-		| x :: l => (unsafeUpdate (a, i, x)
-			     ; loop (l, i - 1))
-	    val _ = loop (l, n - 1)
-	 in a
-	 end
+         let
+            val n = List.length l
+            val a = new (n + 1, x)
+            fun loop (l, i) =
+               case l of
+                  [] => ()
+                | x :: l => (unsafeUpdate (a, i, x)
+                             ; loop (l, i - 1))
+            val _ = loop (l, n - 1)
+         in a
+         end
 
 fun toVectorMap (a, f) = Vector.tabulate (length a, fn i => f (sub (a, i)))
 

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/array.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/array.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/array.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 type int = Int.t
    
 signature ARRAY_STRUCTS =

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/array.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/array.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/array.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,16 +1,17 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 structure Array =
    Array (open Pervasive.Array
-	  type 'a t = 'a array
-	  exception New = Size
-	  val unsafeSub = Unsafe.Array.sub
-	  val unsafeUpdate = Unsafe.Array.update
-	  val unfoldi = MLton.Array.unfoldi)
+          type 'a t = 'a array
+          exception New = Size
+          val unsafeSub = Unsafe.Array.sub
+          val unsafeUpdate = Unsafe.Array.update
+          val unfoldi = MLton.Array.unfoldi)
 
 functor MonoArray (Elt: T) =
    struct

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/array2.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/array2.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/array2.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 type int = Int.t
    
 signature ARRAY2 =

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/array2.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/array2.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/array2.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 structure Array2: ARRAY2 =
 struct
 
@@ -14,16 +15,16 @@
 fun toList a =
    let
       fun loop (r, ac) =
-	 if r < 0
-	    then ac
-	 else loop (r - 1,
-		    let
-		       fun loop (c, ac) =
-			  if c < 0
-			     then ac
-			  else loop (c - 1, sub (a, r, c) :: ac)
-		    in loop (nCols a - 1, [])
-		    end :: ac)
+         if r < 0
+            then ac
+         else loop (r - 1,
+                    let
+                       fun loop (c, ac) =
+                          if c < 0
+                             then ac
+                          else loop (c - 1, sub (a, r, c) :: ac)
+                    in loop (nCols a - 1, [])
+                    end :: ac)
    in loop (nRows a - 1, [])
    end
    
@@ -35,9 +36,9 @@
 fun foralli (a, f) =
    let exception False
    in (appi RowMajor (fn (r, c, x) =>
-		      if f (r, c, x)
-			 then ()
-		      else raise False)
+                      if f (r, c, x)
+                         then ()
+                      else raise False)
        (wholeRegion a)
        ; true)
       handle False => false

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/assert.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/assert.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/assert.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,22 +1,23 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature ASSERT =
    sig
       val assert: string * (unit -> bool) -> unit
       val assertFun:
-	 string
-	 * ('a -> 'b)
-	 * ('a -> bool * ('b -> bool))
-	 -> 'a -> 'b
+         string
+         * ('a -> 'b)
+         * ('a -> bool * ('b -> bool))
+         -> 'a -> 'b
       val assertFun2:
-	 string
-	 * ('a -> 'b -> 'c)
-	 * ('a -> bool * ('b -> (bool * ('c -> bool))))
-	 -> 'a -> 'b -> 'c
+         string
+         * ('a -> 'b -> 'c)
+         * ('a -> bool * ('b -> (bool * ('c -> bool))))
+         -> 'a -> 'b -> 'c
       val debug: bool
       val fail: string -> 'a
    end

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/assert.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/assert.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/assert.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,57 +1,58 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 structure Assert: ASSERT =
    struct
-      val debug = not MLton.isMLton
+      val debug = MLton.debug orelse (not MLton.isMLton)
 
       fun fail msg = Error.bug (concat ["assertion failure: ", msg])
-	 
+         
       fun assert (msg: string, f: unit -> bool): unit =
-	 if debug andalso not (f () handle _ => false)
-	    then fail msg
-	 else ()
+         if debug andalso not (f () handle _ => false)
+            then fail msg
+         else ()
 
       fun assert' (msg, b) = assert (msg, fn () => b)
-	 
+         
       val ('a, 'b) assertFun':
-	 string
-	 * ('a -> 'b)
-	 * ('a -> bool * ('b -> bool * 'b))
-	 -> 'a -> 'b =
-	 (* Can't do what I really want because of the value restriction.
-	  * Would like to write:
-	  *   if debug then (fn ... => ...) else (fn ... => ...).
-	  *)
-	 fn (msg, f, check) =>
-	 if debug
-	    then (fn a =>
-		  let val (yes, check) = check a
-		     val _ = assert' (concat [msg, " argument"], yes)
-		     val (yes, b) = check (f a)
-		  in assert' (concat [msg, " result"], yes)
-		     ; b
-		  end)
-	 else f
+         string
+         * ('a -> 'b)
+         * ('a -> bool * ('b -> bool * 'b))
+         -> 'a -> 'b =
+         (* Can't do what I really want because of the value restriction.
+          * Would like to write:
+          *   if debug then (fn ... => ...) else (fn ... => ...).
+          *)
+         fn (msg, f, check) =>
+         if debug
+            then (fn a =>
+                  let val (yes, check) = check a
+                     val _ = assert' (concat [msg, " argument"], yes)
+                     val (yes, b) = check (f a)
+                  in assert' (concat [msg, " result"], yes)
+                     ; b
+                  end)
+         else f
 
       fun assertFun (msg,
-		    f: 'a -> 'b,
-		    check: 'a -> bool * ('b -> bool)): 'a -> 'b =
-	 assertFun' (msg, f,
-		    fn a => let val (yes, check) = check a
-			    in (yes, fn b => (check b, b))
-			    end)
+                    f: 'a -> 'b,
+                    check: 'a -> bool * ('b -> bool)): 'a -> 'b =
+         assertFun' (msg, f,
+                    fn a => let val (yes, check) = check a
+                            in (yes, fn b => (check b, b))
+                            end)
 
       fun assertFun2 (msg,
-		     f: 'a -> 'b -> 'c,
-		     check: 'a -> bool * ('b -> (bool * ('c -> bool)))) =
-	 assertFun'
-	 (msg, f,
-	  fn a => let val (yes, check) = check a
-		  in (yes,
-		      fn bc => (true, assertFun (msg, bc, check)))
-		  end)
+                     f: 'a -> 'b -> 'c,
+                     check: 'a -> bool * ('b -> (bool * ('c -> bool)))) =
+         assertFun'
+         (msg, f,
+          fn a => let val (yes, check) = check a
+                  in (yes,
+                      fn bc => (true, assertFun (msg, bc, check)))
+                  end)
    end

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/base64.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/base64.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/base64.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 (* Base64 encoding, as in RFC 1421 *)
 
 type int = Int.t
@@ -22,9 +23,9 @@
 
 val _ =
    Assert.assert
-   ("Base64", fn () =>
+   ("TestBase64", fn () =>
     List.forall(["a", "aa", "aaa", "aaaa", "aaaaa", "aaaaaa", "aaaaaaa",
-		 "a", "ab", "abc", "abcd", "abcde", "abcdef", "abcdefg",
-		 "bb:new.site"],
-		fn s => decode(encode s) = s))
+                 "a", "ab", "abc", "abcd", "abcde", "abcdef", "abcdefg",
+                 "bb:new.site"],
+                fn s => decode(encode s) = s))
 end

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/base64.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/base64.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/base64.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,153 +1,154 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 structure Base64: BASE64 =
    struct
       type int = Int.t
-	 
+         
       val chars =
-	 "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
+         "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
 
       fun word8ToChar(w: Word8.t): char =
-	 String.sub(chars, Word8.toInt w)
+         String.sub(chars, Word8.toInt w)
 
       val word8ToChar =
-	 Trace.traceAssert
-	 ("Base64.word8ToChar", Word8.layout, Char.layout,
-	  fn w => (0w0 <= w andalso w < 0w64, fn _ => true))
-	 word8ToChar
-	 
+         Trace.traceAssert
+         ("Base64.word8ToChar", Word8.layout, Char.layout,
+          fn w => (0w0 <= w andalso w < 0w64, fn _ => true))
+         word8ToChar
+         
       val charToWord8: char -> Word8.t option =
-	 Char.memoize(fn c =>
-		      Option.map(String.peeki(chars, fn (_, c') => c = c'),
-				 fn (i, _) => Word8.fromInt i))
+         Char.memoize(fn c =>
+                      Option.map(String.peeki(chars, fn (_, c') => c = c'),
+                                 fn (i, _) => Word8.fromInt i))
 
       val charToWord8 =
-	 Trace.trace("Base64.charToWord8",
-		     Char.layout, Option.layout Word8.layout)
-	 charToWord8
+         Trace.trace("Base64.charToWord8",
+                     Char.layout, Option.layout Word8.layout)
+         charToWord8
 
       val pad = #"="
-	 
+         
       fun 'a encodeGen{array: 'a,
-		       length: 'a -> int,
-		       sub: 'a * int -> Word8.t} =
-	 let
-	    val n = length array
-	    val sub = fn i => sub(array, i)
-	    val (d, m) = Int.divMod(n, 3)
-	    val (d, n') = if m = 0
-			     then (d, n)
-			  else if m = 1
-				  then (d + 1, n + 2)
-			       else (d + 1, n + 1)
-	    val sub = fn i => if i >= n then 0w0 else sub i
-	    val _ = Assert.assert("Base64.encode", fn () => n' mod 3 = 0)
-	    val numChars: int = 4 * d
-	    val chars = CharArray.array(numChars, #"\000")
-	    fun updateChar(j, c) = CharArray.update(chars, j, c)
-	    fun update(j: int, w: Word8.t) = updateChar(j, word8ToChar w)
-	    fun loop(i: int, j: int) =
-	       if i = n'
-		  then j
-	       else
-		  let val w1 = sub i
-		     val w2 = sub(i + 1)
-		     val w3 = sub(i + 2)
-		     open Word8
-		     val op + = Int.+
-		  in update(j, >>(w1, 0w2))
-		     ; update(j + 1, orb(<<(andb(w1, 0w3), 0w4),
-					 >>(w2, 0w4)))
-		     ; update(j + 2, orb(<<(andb(w2, 0wxF), 0w2),
-					 >>(w3, 0w6)))
-		     ; update(j + 3, andb(w3, 0wx3F))
-		     ; loop(i + 3, j + 4)
-		  end
-	    val j = loop(0, 0)
-	    (* insert padding *)
-	    val _ = if m = 0
-		       then ()
-		    else (updateChar(j - 1, pad)
-			  ; if m = 1
-			       then updateChar(j - 2, pad)
-			    else ())
-	 (* need to patch for leftover bits *)
-	 in String.fromCharArray chars
-	 end
+                       length: 'a -> int,
+                       sub: 'a * int -> Word8.t} =
+         let
+            val n = length array
+            val sub = fn i => sub(array, i)
+            val (d, m) = Int.divMod(n, 3)
+            val (d, n') = if m = 0
+                             then (d, n)
+                          else if m = 1
+                                  then (d + 1, n + 2)
+                               else (d + 1, n + 1)
+            val sub = fn i => if i >= n then 0w0 else sub i
+            val _ = Assert.assert("Base64.encodeGen", fn () => n' mod 3 = 0)
+            val numChars: int = 4 * d
+            val chars = CharArray.array(numChars, #"\000")
+            fun updateChar(j, c) = CharArray.update(chars, j, c)
+            fun update(j: int, w: Word8.t) = updateChar(j, word8ToChar w)
+            fun loop(i: int, j: int) =
+               if i = n'
+                  then j
+               else
+                  let val w1 = sub i
+                     val w2 = sub(i + 1)
+                     val w3 = sub(i + 2)
+                     open Word8
+                     val op + = Int.+
+                  in update(j, >>(w1, 0w2))
+                     ; update(j + 1, orb(<<(andb(w1, 0w3), 0w4),
+                                         >>(w2, 0w4)))
+                     ; update(j + 2, orb(<<(andb(w2, 0wxF), 0w2),
+                                         >>(w3, 0w6)))
+                     ; update(j + 3, andb(w3, 0wx3F))
+                     ; loop(i + 3, j + 4)
+                  end
+            val j = loop(0, 0)
+            (* insert padding *)
+            val _ = if m = 0
+                       then ()
+                    else (updateChar(j - 1, pad)
+                          ; if m = 1
+                               then updateChar(j - 2, pad)
+                            else ())
+         (* need to patch for leftover bits *)
+         in String.fromCharArray chars
+         end
 
       fun encode s = encodeGen{array = s,
-			       length = String.size,
-			       sub = Char.toWord8 o String.sub}
+                               length = String.size,
+                               sub = Char.toWord8 o String.sub}
 
       val encode =
-	 Trace.trace("Base64.encode", String.layout, String.layout) encode
+         Trace.trace("Base64.encode", String.layout, String.layout) encode
 
       fun 'a decodeGen{string: string,
-		       new: int * Word8.t -> 'a,
-		       update: 'a * int * Word8.t -> unit}: 'a =
-	 let
-	    val n = String.size string
-	    val (d, m) = Int.divMod(n, 4)
-	    val _ = Assert.assert("Base64.decode", fn () => m = 0)
-	    fun sub i = String.sub(string, i)
-	    val numPads =
-	       if pad = sub(n - 1)
-		  then if pad = sub(n - 2)
-			  then 2
-		       else 1
-	       else 0
-	    val outputLength = d * 3 - numPads
-	    val a = new(outputLength, 0w0)
-	    fun loop(i: int, j: int): unit =
-	       if i = n
-		  then ()
-	       else
-		  let
-		     val sub =
-			fn i =>
-			let val c = sub i
-			in if pad = c
-			      then 0w0
-			   else
-			      case charToWord8 c of
-				 NONE =>
-				    Error.bug (concat
-					       ["Base64.decode: strange char ",
-						Char.escapeSML c])
-			       | SOME w => w
-			end
-		     val w0 = sub i
-		     val w1 = sub(i + 1)
-		     val w2 = sub(i + 2)
-		     val w3 = sub(i + 3)
-		     val update =
-			fn (k, w) =>
-			if j + k >= outputLength
-			   then ()
-			else update(a, j + k, w)
-		     val _ =
-			let open Word8
-			in update(0, orb(<<(w0, 0w2), >>(w1, 0w4)))
-			   ; update(1, orb(<<(andb(w1, 0wxF), 0w4), >>(w2, 0w2)))
-			   ; update(2, orb(<<(andb(w2, 0w3), 0w6), w3))
-			end
-		  in loop(i + 4, j + 3)
-		  end
-	    val _ = loop(0, 0)
-	 in a
-	 end
+                       new: int * Word8.t -> 'a,
+                       update: 'a * int * Word8.t -> unit}: 'a =
+         let
+            val n = String.size string
+            val (d, m) = Int.divMod(n, 4)
+            val _ = Assert.assert("Base64.decodeGen", fn () => m = 0)
+            fun sub i = String.sub(string, i)
+            val numPads =
+               if pad = sub(n - 1)
+                  then if pad = sub(n - 2)
+                          then 2
+                       else 1
+               else 0
+            val outputLength = d * 3 - numPads
+            val a = new(outputLength, 0w0)
+            fun loop(i: int, j: int): unit =
+               if i = n
+                  then ()
+               else
+                  let
+                     val sub =
+                        fn i =>
+                        let val c = sub i
+                        in if pad = c
+                              then 0w0
+                           else
+                              case charToWord8 c of
+                                 NONE =>
+                                    Error.bug (concat
+                                               ["Base64.decodeGen: strange char ",
+                                                Char.escapeSML c])
+                               | SOME w => w
+                        end
+                     val w0 = sub i
+                     val w1 = sub(i + 1)
+                     val w2 = sub(i + 2)
+                     val w3 = sub(i + 3)
+                     val update =
+                        fn (k, w) =>
+                        if j + k >= outputLength
+                           then ()
+                        else update(a, j + k, w)
+                     val _ =
+                        let open Word8
+                        in update(0, orb(<<(w0, 0w2), >>(w1, 0w4)))
+                           ; update(1, orb(<<(andb(w1, 0wxF), 0w4), >>(w2, 0w2)))
+                           ; update(2, orb(<<(andb(w2, 0w3), 0w6), w3))
+                        end
+                  in loop(i + 4, j + 3)
+                  end
+            val _ = loop(0, 0)
+         in a
+         end
 
       fun decode s =
-	 String.fromCharArray
-	 (decodeGen
-	  {string = s,
-	   new = fn (n, w) => CharArray.array(n, Char.fromWord8 w),
-	   update = fn (a, i, w) => CharArray.update(a, i, Char.fromWord8 w)})
+         String.fromCharArray
+         (decodeGen
+          {string = s,
+           new = fn (n, w) => CharArray.array(n, Char.fromWord8 w),
+           update = fn (a, i, w) => CharArray.update(a, i, Char.fromWord8 w)})
 
       val decode =
-	 Trace.trace("Base64.decode", String.layout, String.layout) decode
+         Trace.trace("Base64.decode", String.layout, String.layout) decode
    end

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/binary-search.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/binary-search.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/binary-search.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 type int = Int.t
    
 signature BINARY_SEARCH =
@@ -32,12 +33,12 @@
    
 val _ =
    Assert.assert
-   ("BinarySearch", fn () =>
+   ("TestBinarySearch", fn () =>
     let
        val n = 17
        val a = Array.fromList (Pervasive.List.tabulate (n, fn i => i))
     in Int.forall (0, n, fn i =>
-		   SOME i = search (a, fn x => Int.compare (i, x)))
+                   SOME i = search (a, fn x => Int.compare (i, x)))
     end)
 
 end

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/binary-search.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/binary-search.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/binary-search.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 structure BinarySearch: BINARY_SEARCH =
 struct
 
@@ -11,43 +12,43 @@
 fun 'a search (a: 'a array, f: 'a -> order): int option =
    let 
       fun loop (min: int, max: int): int option =
-	 if min > max
-	    then NONE
-	 else
-	    let val mid = Int.quot (min + max, 2)
-	    in case f (Array.sub (a, mid)) of
-	       LESS => loop (min, mid - 1)
-	     | EQUAL => SOME mid
-	     | GREATER => loop (mid + 1, max)
-	    end
+         if min > max
+            then NONE
+         else
+            let val mid = Int.quot (min + max, 2)
+            in case f (Array.sub (a, mid)) of
+               LESS => loop (min, mid - 1)
+             | EQUAL => SOME mid
+             | GREATER => loop (mid + 1, max)
+            end
    in loop (0, Array.length a - 1)
    end
 
 fun 'a largest (a: 'a array, f: 'a -> bool): int option =
    let 
       fun loop(min, max, res: int option): int option =
-	 if min > max
-	    then res
-	 else
-	    let val mid = Int.quot(min + max, 2)
-	    in if f(Array.sub(a, mid))
-		  then loop(mid + 1, max, SOME mid)
-	       else loop(min, mid - 1, res)
-	    end
+         if min > max
+            then res
+         else
+            let val mid = Int.quot(min + max, 2)
+            in if f(Array.sub(a, mid))
+                  then loop(mid + 1, max, SOME mid)
+               else loop(min, mid - 1, res)
+            end
    in loop(0, Array.length a - 1, NONE)
    end
 
 fun 'a smallest(a: 'a array, f: 'a -> bool): int option =
    let 
       fun loop(min, max, res: int option): int option =
-	 if min > max
-	    then res
-	 else
-	    let val mid = Int.quot(min + max, 2)
-	    in if f(Array.sub(a, mid))
-		  then loop(min, mid - 1, SOME mid)
-	       else loop(mid + 1, max, res)
-	    end
+         if min > max
+            then res
+         else
+            let val mid = Int.quot(min + max, 2)
+            in if f(Array.sub(a, mid))
+                  then loop(min, mid - 1, SOME mid)
+               else loop(mid + 1, max, res)
+            end
    in loop(0, Array.length a - 1, NONE)
    end
 

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/bool.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/bool.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/bool.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature BOOL =
    sig
       type t

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/bool.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/bool.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/bool.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,8 +1,8 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 (*-------------------------------------------------------------------*)
 (*                               Bool                                *)

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/bounded-order.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/bounded-order.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/bounded-order.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,8 +1,8 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 (*------------------------------------------------------------------*)
 (*                           BoundedOrder                           *)
@@ -25,7 +25,7 @@
    
 val project =
    fn Inject x => x
-    | _ => Error.bug "project"
+    | _ => Error.bug "BoundedOrder.project"
     
 val compare =
    fn (Min, Min) => R.EQUAL

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/bounded-order.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/bounded-order.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/bounded-order.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature BOUNDED_ORDER =
    sig
       structure O: ORDER

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/buffer.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/buffer.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/buffer.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 type int = Int.t
 
 signature BUFFER_STRUCTS = 

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/buffer.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/buffer.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/buffer.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,16 +1,16 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 structure Buffer: BUFFER = 
 struct
 
 datatype 'a t = T of {dummy: 'a,
-		      elts: 'a array ref,
-		      length: int ref}
+                      elts: 'a array ref,
+                      length: int ref}
    
 fun new {dummy} =
    T {dummy = dummy,
@@ -33,17 +33,17 @@
       val maxLength = Array.length (!elts)
    in
       if amount <= maxLength - !length
-	 then ()
+         then ()
       else
-	 let
-	    val n = Int.max (maxLength * growFactor, !length + amount)
-	    val e = !elts
-	 in
-	    elts := Array.tabulate (n, fn i =>
-				    if i < maxLength
-				       then Array.sub (e, i)
-				    else dummy)
-	 end
+         let
+            val n = Int.max (maxLength * growFactor, !length + amount)
+            val e = !elts
+         in
+            elts := Array.tabulate (n, fn i =>
+                                    if i < maxLength
+                                       then Array.sub (e, i)
+                                    else dummy)
+         end
    end
 
 fun add (v as T {elts, length, ...}, e) =

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/char-buffer.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/char-buffer.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/char-buffer.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 type int = Int.t
 
 signature CHAR_BUFFER_STRUCTS = 

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/char-buffer.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/char-buffer.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/char-buffer.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,19 +1,20 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 structure CharBuffer: CHAR_BUFFER = 
 struct
 
 datatype t = T of {length: int ref,
-		   chars: char array ref}
+                   chars: char array ref}
 
 val initChar = #"\013"
    
 fun new () = T {length = ref 0,
-	      chars = ref (Array.array (1, initChar))}
+              chars = ref (Array.array (1, initChar))}
 
 fun length (T {length, ...}) = !length
 
@@ -24,21 +25,21 @@
 structure Int =
    struct
       open Int
-      val max = Trace.trace2 ("max", layout, layout, layout) max
+      val max = Trace.trace2 ("CharBuffer.Int.max", layout, layout, layout) max
    end
 
 fun ensureFree (T {length, chars, ...}, amount: int): unit =
    let val maxLength = Array.length (!chars)
    in if amount <= maxLength - !length
-	 then ()
+         then ()
       else
-	 let val n = Int.max (maxLength * growFactor, !length + amount)
-	    val a = !chars
-	 in chars := Array.tabulate (n, fn i =>
-				    if i < maxLength
-				       then Array.sub (a, i)
-				    else initChar)
-	 end
+         let val n = Int.max (maxLength * growFactor, !length + amount)
+            val a = !chars
+         in chars := Array.tabulate (n, fn i =>
+                                    if i < maxLength
+                                       then Array.sub (a, i)
+                                    else initChar)
+         end
    end
 
 fun addChar (v as T {length, chars, ...}, c) =
@@ -54,6 +55,6 @@
 val layout = Layout.str o toString
 
 val addChar =
-   Trace.trace2 ("addChar", layout, Char.layout, Unit.layout) addChar
+   Trace.trace2 ("CharBuffer.addChar", layout, Char.layout, Unit.layout) addChar
 
 end

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/char-pred.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/char-pred.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/char-pred.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature CHAR_FUN =
    sig
       type t = char -> 'a

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/char-pred.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/char-pred.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/char-pred.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,31 +1,31 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 fun contains s =
-	 let
-	    val a = Array.array(numChars, false)
-	    val n = String.size s
-	    fun loop i =
-	       if i >= n then ()
-	       else (Array.update(a, ord(String.sub(s, i)), true)
-		     ; loop(i + 1))
-	 in loop 0
-	    ; fn c => Array.sub(a, ord c)
-	 end
+         let
+            val a = Array.array(numChars, false)
+            val n = String.size s
+            fun loop i =
+               if i >= n then ()
+               else (Array.update(a, ord(String.sub(s, i)), true)
+                     ; loop(i + 1))
+         in loop 0
+            ; fn c => Array.sub(a, ord c)
+         end
 
       fun notContains s = not o (contains s)
 
       fun memoize (f: char -> 'a): char -> 'a =
-	 let val a = Array.tabulate(numChars, f o chr)
-	 in fn c => Array.sub(a, ord c)
-	 end
-	 
+         let val a = Array.tabulate(numChars, f o chr)
+         in fn c => Array.sub(a, ord c)
+         end
+         
       local
-	 val not = fn f => memoize(not o f)
-	 infix or andd
-	 fun f or g = memoize(fn c => f c orelse g c)
-	 fun f andd g = memoize(fn c => f c andalso g c)
+         val not = fn f => memoize(not o f)
+         infix or andd
+         fun f or g = memoize(fn c => f c orelse g c)
+         fun f andd g = memoize(fn c => f c andalso g c)

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/char.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/char.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/char.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 type int = Pervasive.Int.int
 type word8 = Pervasive.Word8.word
    
@@ -66,7 +67,7 @@
    struct
       open S
       val _ =
-	 Assert.assert
-	 ("Char", fn () =>
-	  "\\000" = escapeC #"\000")
+         Assert.assert
+         ("TestChar", fn () =>
+          "\\000" = escapeC #"\000")
    end

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/char.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/char.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/char.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 structure Char: CHAR =
    struct
       open Char0
@@ -11,7 +12,7 @@
       val layout = Layout.str o escapeSML
 
       val fromInt =
-	 Trace.trace("Char.fromInt", Layout.str o Int.toString, layout) fromInt
+         Trace.trace("Char.fromInt", Layout.str o Int.toString, layout) fromInt
 
       val isDigit = Trace.trace("Char.isDigit", layout, Bool.layout) isDigit
    end

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/char0.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/char0.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/char0.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature CHAR0 =
    sig
       type t = char

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/char0.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/char0.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/char0.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 structure Char0 =
 struct
 
@@ -38,8 +39,8 @@
 fun fromDigit (d: int): t =
    if let open Int in 0 <= d andalso d < 10 end
       then chr (d + ord #"0")
-   else Error.bug "fromDigit"
-	 
+   else Error.bug "Char0.fromDigit"
+         
 fun output (c, out) = TextIO.output (out, toString c)
 
 val numChars = ord maxChar + 1
@@ -53,10 +54,10 @@
    if #"0" <= c andalso c <= #"9"
       then ord c - ord #"0"
    else if #"a" <= c andalso c <= #"f"
-	   then ord c - ord #"a" + 10
-	else if #"A" <= c andalso c <= #"F"
-		then ord c - ord #"A" + 10
-	     else Error.bug "charToHexDigit"
+           then ord c - ord #"a" + 10
+        else if #"A" <= c andalso c <= #"F"
+                then ord c - ord #"A" + 10
+             else Error.bug "Char0.charToHexDigit"
 
 fun fromHexDigit (n: int): char = String.sub ("0123456789ABCDEF", n)
 

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/choice-pattern.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/choice-pattern.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/choice-pattern.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,10 @@
+(* Copyright (C) 2002-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 type int = Int.t
    
 signature CHOICE_PATTERN =

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/choice-pattern.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/choice-pattern.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/choice-pattern.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,10 @@
+(* Copyright (C) 2002-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 structure ChoicePattern: CHOICE_PATTERN =
 struct
 
@@ -11,7 +18,7 @@
       open Layout
    in
       case t of
-	 Concat v => seq [str "Concat ", Vector.layout layout v]
+         Concat v => seq [str "Concat ", Vector.layout layout v]
        | Choice v => seq [str "Choice ", Vector.layout layout v]
        | String s => seq [str "\"", String.layout s, str "\""]
    end
@@ -22,66 +29,66 @@
       exception Error of string
       fun error ss = raise Error (concat ss)
       datatype state =
-	 Nest of {start: int}
-	| Normal
+         Nest of {start: int}
+        | Normal
       fun loop (cur: int,
-		ac: char list,
-		prev: t list,
-		prevChoices: t list,
-		state: state): int * t =
-	 let
-	    fun accum () = String (String.fromListRev ac) :: prev
-	    fun finishChoice () =
-	       Concat (Vector.fromListRev (accum ())) :: prevChoices
-	    fun keepChar cur =
-	       loop (cur + 1, String.sub (s, cur) :: ac,
-		     prev, prevChoices, state)
-	 in
-	    if cur < n
-	       then
-		  let
-		     val c = String.sub (s, cur)
-		  in
-		     case c of
-			#"{" => let
-				   val (cur, t) =
-				      loop (cur + 1, [], [], [],
-					    Nest {start = cur})
-				in
-				   loop (cur, [], t :: accum (), prevChoices,
-					 state)
-				end
-		      | #"}" =>
-			   (case state of
-			       Nest _ =>
-				  (cur + 1,
-				   Choice (Vector.fromList (finishChoice ())))
-			     | Normal =>
-				  error ["unmatched } at position ",
-					 Int.toString cur])
-		      | #"," =>
-			   (case state of
-			       Nest _ => loop (cur + 1, [], [], finishChoice (),
-					       state)
-			     | Normal => keepChar cur)
-		      | #"\\" =>
-			   let
-			      val cur = cur + 1
-			   in
-			      if cur = n
-				 then error ["terminating backslash"]
-			      else keepChar cur
-			   end
-		      | _ => keepChar cur
-		  end
-	    else
-	       (case state of
-		   Nest {start} =>
-		      error ["unmatched { at position ",
-			     Int.toString start]
-		 | Normal =>
-		      (cur, Concat (Vector.fromListRev (accum ()))))
-	 end
+                ac: char list,
+                prev: t list,
+                prevChoices: t list,
+                state: state): int * t =
+         let
+            fun accum () = String (String.fromListRev ac) :: prev
+            fun finishChoice () =
+               Concat (Vector.fromListRev (accum ())) :: prevChoices
+            fun keepChar cur =
+               loop (cur + 1, String.sub (s, cur) :: ac,
+                     prev, prevChoices, state)
+         in
+            if cur < n
+               then
+                  let
+                     val c = String.sub (s, cur)
+                  in
+                     case c of
+                        #"{" => let
+                                   val (cur, t) =
+                                      loop (cur + 1, [], [], [],
+                                            Nest {start = cur})
+                                in
+                                   loop (cur, [], t :: accum (), prevChoices,
+                                         state)
+                                end
+                      | #"}" =>
+                           (case state of
+                               Nest _ =>
+                                  (cur + 1,
+                                   Choice (Vector.fromList (finishChoice ())))
+                             | Normal =>
+                                  error ["unmatched } at position ",
+                                         Int.toString cur])
+                      | #"," =>
+                           (case state of
+                               Nest _ => loop (cur + 1, [], [], finishChoice (),
+                                               state)
+                             | Normal => keepChar cur)
+                      | #"\\" =>
+                           let
+                              val cur = cur + 1
+                           in
+                              if cur = n
+                                 then error ["terminating backslash"]
+                              else keepChar cur
+                           end
+                      | _ => keepChar cur
+                  end
+            else
+               (case state of
+                   Nest {start} =>
+                      error ["unmatched { at position ",
+                             Int.toString start]
+                 | Normal =>
+                      (cur, Concat (Vector.fromListRev (accum ()))))
+         end
    in
       Result.Yes (#2 (loop (0, [], [], [], Normal)))
       handle Error s => Result.No s
@@ -94,9 +101,9 @@
 fun foldDown (v, a, f) =
    let
       fun loop (i, a) =
-	 if i < 0
-	    then a
-	 else loop (i - 1, f (Vector.sub (v, i), a))
+         if i < 0
+            then a
+         else loop (i - 1, f (Vector.sub (v, i), a))
    in
       loop (Vector.length v - 1, a)
    end
@@ -104,15 +111,15 @@
 fun expandTree (t: t): string list =
    case t of
       Choice v =>
-	 Vector.fold (v, [], fn (t, ac) =>
-		      expandTree t @ ac)
+         Vector.fold (v, [], fn (t, ac) =>
+                      expandTree t @ ac)
     | Concat v =>
-	 foldDown (v, [""], fn (t, ac) =>
-		   List.fold
-		   (expandTree t, [], fn (s, all) =>
-		    List.fold
-		    (ac, all, fn (s', all) =>
-		     concat [s, s'] :: all)))
+         foldDown (v, [""], fn (t, ac) =>
+                   List.fold
+                   (expandTree t, [], fn (s, all) =>
+                    List.fold
+                    (ac, all, fn (s', all) =>
+                     concat [s, s'] :: all)))
     | String s => [s]
 
 fun expand (s: string): string list Result.t =

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/circular-list.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/circular-list.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/circular-list.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 functor CircularList(S: CIRCULAR_LIST_STRUCTS): CIRCULAR_LIST =
 struct
 
@@ -37,26 +38,26 @@
 fun deleteSafe(p, d) =
    (if Elt.eqPrev(Pointer.! p, d)
        then if isSingle p then makeEmpty p
-	    else Pointer.:=(p, Elt.next d)
+            else Pointer.:=(p, Elt.next d)
     else ()
     ; Elt.unlink d)
 
 fun delete(l, d) =
    if Elt.isLinked d then deleteSafe(l, d)
-   else Error.bug "delete"
+   else Error.bug "CircularList.delete"
 
 fun foreach(p, f) =
    if Pointer.isNull p then ()
    else
       let
-	 val start = Pointer.! p
-	 fun foreach d =
-	    let val next = Elt.next d
-	    in (f d
-		; if Elt.eqPrev(start, next)
-		     then ()
-		  else foreach next)
-	    end
+         val start = Pointer.! p
+         fun foreach d =
+            let val next = Elt.next d
+            in (f d
+                ; if Elt.eqPrev(start, next)
+                     then ()
+                  else foreach next)
+            end
       in foreach start
       end
 
@@ -65,12 +66,12 @@
 fun splice(p, p') =
    if Pointer.isNull p then Pointer.copy(p, p')
    else if Pointer.isNull p' then ()
-	else let val e1 = Pointer.! p
-		 val e1' = Pointer.! p'
-		 val e2 = Elt.next e1
-		 val e2' = Elt.next e1'
-	     in Elt.link(e1, e2')
-		; Elt.link(e1', e2)
-	     end
+        else let val e1 = Pointer.! p
+                 val e1' = Pointer.! p'
+                 val e2 = Elt.next e1
+                 val e2' = Elt.next e1'
+             in Elt.link(e1, e2')
+                ; Elt.link(e1', e2)
+             end
 
 end

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/circular-list.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/circular-list.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/circular-list.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature CIRCULAR_LIST_STRUCTS =
    sig
       structure Elt: DOUBLY_LINKED
@@ -12,9 +13,9 @@
 signature CIRCULAR_LIST =
    sig
       include CIRCULAR_LIST_STRUCTS
-	 
+         
       type 'a t = 'a Elt.t Pointer.t
-	 
+         
       val delete: 'a t * 'a Elt.t -> unit
       val deleteEach: 'a t * ('a Elt.t -> unit) -> unit
       val empty: unit -> 'a t

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/clearable-promise.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/clearable-promise.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/clearable-promise.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature CLEARABLE_PROMISE =
    sig
       type 'a t

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/clearable-promise.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/clearable-promise.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/clearable-promise.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 structure ClearablePromise: CLEARABLE_PROMISE =
 struct
 

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/computation.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/computation.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/computation.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,13 +1,14 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature COMPUTATION = 
    sig
       structure Time: TIME
-	 
+         
       type t
 
       val keepAll: t * (string -> bool) -> t

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/console.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/console.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/console.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,46 +1,47 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 type int = Int.t
    
 signature CONSOLE =
    sig
       structure Background:
-	 sig
-	    datatype t =
-	       Black | Red | Green | Brown | Blue | Magenta | Cyan | Gray
-	 end
+         sig
+            datatype t =
+               Black | Red | Green | Brown | Blue | Magenta | Cyan | Gray
+         end
 
       structure Foreground:
-	 sig
-	    datatype t =
-	       DarkGray | BrightRed | BrightGreen | Yellow | BrightBlue
-	     | BrightMagenta | BrightCyan | White
-	 end
-	 
+         sig
+            datatype t =
+               DarkGray | BrightRed | BrightGreen | Yellow | BrightBlue
+             | BrightMagenta | BrightCyan | White
+         end
+         
       structure CharRendition:
-	 sig
-	    datatype t =
-	       Default (* Normal, UnderlineOff, ReverseVideoOf,f BlinkOff *)
-	     | Bold
-	     | Dim
-	     | Normal
-	     | UnderlineOn
-	     | UnderlineOff
-	     | UnderlineOnDefaultForeground
-	     | UnderlineOffDefaultForeground
-	     | BlinkOn
-	     | BlinkOff
-	     | ReverseVideoOn
-	     | ReverseVideoOff
-	     | Foreground of Foreground.t
-	     | Background of Background.t
+         sig
+            datatype t =
+               Default (* Normal, UnderlineOff, ReverseVideoOf,f BlinkOff *)
+             | Bold
+             | Dim
+             | Normal
+             | UnderlineOn
+             | UnderlineOff
+             | UnderlineOnDefaultForeground
+             | UnderlineOffDefaultForeground
+             | BlinkOn
+             | BlinkOff
+             | ReverseVideoOn
+             | ReverseVideoOff
+             | Foreground of Foreground.t
+             | Background of Background.t
 
-	    val set: t list -> string
-	 end
+            val set: t list -> string
+         end
 
       val moveToColumn: int -> string
    end

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/console.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/console.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/console.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 structure Console: CONSOLE =
 struct
 
@@ -19,7 +20,7 @@
 structure Foreground =
    struct
       datatype t =
-	 DarkGray | BrightRed | BrightGreen | Yellow | BrightBlue
+         DarkGray | BrightRed | BrightGreen | Yellow | BrightBlue
        | BrightMagenta | BrightCyan | White
    end
    
@@ -28,7 +29,7 @@
 structure CharRendition =
    struct
       datatype t =
-	 Default
+         Default
        | Bold
        | Dim
        | Normal
@@ -44,59 +45,59 @@
        | Background of Background.t
    
       fun set(l: t list): string =
-	 concat(esc
-		:: List.fold(rev l, [], fn (c, l) =>
-			     let
-				val n =
-				   case c of
-				      Default => "0"
-				    | Bold => "1"
-				    | Dim => "2"
-				    | Normal => "21"
-				    | UnderlineOn => "4"
-				    | UnderlineOff => "24"
-				    | UnderlineOnDefaultForeground => "38"
-				    | UnderlineOffDefaultForeground => "39"
-				    | BlinkOn => "5"
-				    | BlinkOff => "25"
-				    | ReverseVideoOn => "7"
-				    | ReverseVideoOff => "27"
-				    | Foreground f =>
-					 let datatype z = datatype Foreground.t
-					 in case f of
-					    DarkGray => "30"
-					  | BrightRed => "31"
-					  | BrightGreen => "32"
-					  | Yellow => "33"
-					  | BrightBlue => "34"
-					  | BrightMagenta => "35"
-					  | BrightCyan => "36"
-					  | White => "37"
-					 end
-				    | Background b =>
-					 let datatype z = datatype Background.t
-					 in case b of
-					    Black => "40"
-					  | Red => "41"
-					  | Green => "42"
-					  | Brown => "43"
-					  | Blue => "44"
-					  | Magenta => "45"
-					  | Cyan => "46"
-					  | Gray => "47"
-					 end
-			     in case l of
-				[] => [n, "m"]
-			      | _ => n :: ";" :: l
-			     end))
+         concat(esc
+                :: List.fold(rev l, [], fn (c, l) =>
+                             let
+                                val n =
+                                   case c of
+                                      Default => "0"
+                                    | Bold => "1"
+                                    | Dim => "2"
+                                    | Normal => "21"
+                                    | UnderlineOn => "4"
+                                    | UnderlineOff => "24"
+                                    | UnderlineOnDefaultForeground => "38"
+                                    | UnderlineOffDefaultForeground => "39"
+                                    | BlinkOn => "5"
+                                    | BlinkOff => "25"
+                                    | ReverseVideoOn => "7"
+                                    | ReverseVideoOff => "27"
+                                    | Foreground f =>
+                                         let datatype z = datatype Foreground.t
+                                         in case f of
+                                            DarkGray => "30"
+                                          | BrightRed => "31"
+                                          | BrightGreen => "32"
+                                          | Yellow => "33"
+                                          | BrightBlue => "34"
+                                          | BrightMagenta => "35"
+                                          | BrightCyan => "36"
+                                          | White => "37"
+                                         end
+                                    | Background b =>
+                                         let datatype z = datatype Background.t
+                                         in case b of
+                                            Black => "40"
+                                          | Red => "41"
+                                          | Green => "42"
+                                          | Brown => "43"
+                                          | Blue => "44"
+                                          | Magenta => "45"
+                                          | Cyan => "46"
+                                          | Gray => "47"
+                                         end
+                             in case l of
+                                [] => [n, "m"]
+                              | _ => n :: ";" :: l
+                             end))
    end
 
 fun moveToColumn c =
    let
       val columns =
-	 case Process.getEnv "COLUMNS" of
-	    NONE => 80
-	  | SOME c => valOf(Int.fromString c)
+         case Process.getEnv "COLUMNS" of
+            NONE => 80
+          | SOME c => valOf(Int.fromString c)
       (* 300 is kind of arbitrary, but it's what they do in
        * /etc/sysconfig/init.
        *)

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/control.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/control.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/control.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,29 +1,30 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 functor Control(): CONTROL =
 struct
 
 val defaults: (unit -> unit) list ref = ref []
 
 val settings: {name: string,
-	       value: (unit -> string)} list ref = ref []
+               value: (unit -> string)} list ref = ref []
 
 fun setDefaults() = List.foreach(!defaults, fn f => f())
 
 fun control{name, default, toString} =
    let val r = ref default
    in List.push(settings, {name = name, 
-			   value = fn () => toString(!r)})
+                           value = fn () => toString(!r)})
       ; List.push(defaults, fn () => r := default)
       ; r
    end
 
 fun all() =
    List.fold(!settings, [], fn ({name, value}, ac) =>
-	     {name = name, value = value()} :: ac)
+             {name = name, value = value()} :: ac)
 
 end

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/control.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/control.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/control.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,15 +1,16 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature CONTROL =
    sig
       val all: unit -> {name: string,
-			value: string} list
+                        value: string} list
       val control: {name: string,
-		    default: 'a,
-		    toString: 'a -> string} -> 'a ref
+                    default: 'a,
+                    toString: 'a -> string} -> 'a ref
       val setDefaults: unit -> unit
    end

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/counter.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/counter.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/counter.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,15 +1,16 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 type int = Int.t
 
 signature COUNTER =
    sig
       type t
-	 
+         
       val new: int -> t
       val next: t -> int
       val tick: t -> unit

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/counter.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/counter.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/counter.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 structure Counter: COUNTER =
 struct
 

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/date.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/date.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/date.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 type int = Pervasive.Int.int
 
 signature DATE_STRUCTS = 
@@ -15,27 +16,27 @@
       type t
 
       structure Weekday:
-	 sig
-	    datatype t = Mon | Tue | Wed | Thu | Fri | Sat | Sun
-	 end
+         sig
+            datatype t = Mon | Tue | Wed | Thu | Fri | Sat | Sun
+         end
       
       structure Month:
-	 sig
-	    datatype t =
-	       Jan | Feb | Mar | Apr | May | Jun | Jul | Aug | Sep | Oct | Nov | Dec
+         sig
+            datatype t =
+               Jan | Feb | Mar | Apr | May | Jun | Jul | Aug | Sep | Oct | Nov | Dec
 
-	    val toInt: t -> int
-	 end
+            val toInt: t -> int
+         end
       
       exception Date
       val compare: t * t -> order
       val date: {year: int,
-		 month: Month.t,
-		 day: int,
-		 hour: int,
-		 minute: int,
-		 second: int,
-		 offset: Time.t option} -> t 
+                 month: Month.t,
+                 day: int,
+                 hour: int,
+                 minute: int,
+                 second: int,
+                 offset: Time.t option} -> t 
       val day: t -> int 
       val fmt: t * string -> string 
       val fromString: string -> t option 

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/date.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/date.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/date.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 structure Date: DATE = 
 struct
 
@@ -22,18 +23,18 @@
       datatype t = datatype month
 
       val toInt: t -> int =
-	 fn Jan => 1
-	  | Feb => 2
-	  | Mar => 3
-	  | Apr => 4
-	  | May => 5
-	  | Jun => 6
-	  | Jul => 7
-	  | Aug => 8
-	  | Sep => 9
-	  | Oct => 10
-	  | Nov => 11
-	  | Dec => 12
+         fn Jan => 1
+          | Feb => 2
+          | Mar => 3
+          | Apr => 4
+          | May => 5
+          | Jun => 6
+          | Jul => 7
+          | Aug => 8
+          | Sep => 9
+          | Oct => 10
+          | Nov => 11
+          | Dec => 12
    end
 
 val now = fromTimeLocal o Time.now
@@ -43,5 +44,5 @@
 fun fmt(d, s) = Date.fmt s d
 
 fun scan(s, r) = Date.scan r s
-	 
+         
 end

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/dir.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/dir.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/dir.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,14 +1,15 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature DIR =
    sig
       type t = string
       type file = string
-	 
+         
       val cd: t -> unit
       val current: unit -> t
       val doesExist: t -> bool

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/dir.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/dir.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/dir.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 structure Dir:> DIR =
 struct
 
@@ -35,32 +36,29 @@
 fun inDir (d, th) =
    let
       val cur = current ()
+      val () = cd d
    in
-      cd d
-      ; DynamicWind.wind (th, fn () => cd cur)
+      Exn.finally (th, fn () => cd cur)
    end
 
 fun fold (d: t, a: 'a, f: string * 'a -> 'a): 'a =
    let
       val stream = FS.openDir d
       fun loop a =
-	 case FS.readDir stream of
-(*
-            "" => a
-	  | s => loop (f (s, a))
-*)
-	    NONE => a
-	  | SOME s => loop (f (s, a))
-   in DynamicWind.wind (fn () => loop a, fn () => FS.closeDir stream)
+         case FS.readDir stream of
+            NONE => a
+          | SOME s => loop (f (s, a))
+   in
+      Exn.finally (fn () => loop a, fn () => FS.closeDir stream)
    end
 
 fun ls d =
    fold (d, ([], []), fn (x, (dirs, files)) =>
-	 if FS.isLink x
-	    then (dirs, files)
-	 else if isDir x
-		 then (x :: dirs, files)
-	      else (dirs, x :: files))
+         if FS.isLink x
+            then (dirs, files)
+         else if isDir x
+                 then (x :: dirs, files)
+              else (dirs, x :: files))
    
 val lsDirs = #1 o ls
 val lsFiles = #2 o ls
@@ -71,13 +69,13 @@
       val _ = cd d
       (* loop removes everything in the current directory *)
       fun loop () =
-	 fold (".", (), fn (s, ()) =>
-	       if isDir s
-		  then (cd s
-			; loop ()
-			; cd ".."
-			; remove s)
-	       else File.remove s)
+         fold (".", (), fn (s, ()) =>
+               if isDir s
+                  then (cd s
+                        ; loop ()
+                        ; cd ".."
+                        ; remove s)
+               else File.remove s)
       val _ = loop ()
       val _ = cd old
       val _ = remove d
@@ -90,7 +88,7 @@
       val d = concat ["/tmp/dir", Random.alphaNumString 6]
       val _ = make d
    in
-      DynamicWind.wind (fn () => inDir (d, fn _ => thunk ()),
-			fn () => removeR d)
+      Exn.finally (fn () => inDir (d, fn _ => thunk ()),
+                   fn () => removeR d)
    end
 end

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/directed-graph.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/directed-graph.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/directed-graph.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,56 +1,57 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 type int = Int.t
 
 signature DIRECTED_GRAPH = 
    sig
       structure Node: 
-	 sig
-	    type 'a edge
-	    type 'a t
+         sig
+            type 'a edge
+            type 'a t
 
-	    val equals: 'a t * 'a t -> bool
-	    val hasEdge: {from: 'a t, to: 'a t} -> bool
-	    val layout: 'a t -> Layout.t
-	    val plist: 'a t -> PropertyList.t
-	    val successors: 'a t -> 'a edge list
-	 end
+            val equals: 'a t * 'a t -> bool
+            val hasEdge: {from: 'a t, to: 'a t} -> bool
+            val layout: 'a t -> Layout.t
+            val plist: 'a t -> PropertyList.t
+            val successors: 'a t -> 'a edge list
+         end
       structure Edge:
-	 sig
-	    type 'a t
+         sig
+            type 'a t
 
-	    val equals: 'a t * 'a t -> bool
-	    val layout: 'a t -> Layout.t
-	    val plist: 'a t -> PropertyList.t
-	    val to: 'a t -> 'a Node.t
-	 end
+            val equals: 'a t * 'a t -> bool
+            val layout: 'a t -> Layout.t
+            val plist: 'a t -> PropertyList.t
+            val to: 'a t -> 'a Node.t
+         end
       sharing type Node.edge = Edge.t
 
       (* depth first search *)
       structure DfsParam:
-	 sig
-	    type ('a, 'b, 'c, 'd, 'e) t =
-	       'b
-	       * ('a Node.t * 'b
-		  -> ('c
-		      * ('a Node.t * 'c -> ('d
-					    * ('a Edge.t * 'd -> 'd)
-					    * ('a Edge.t * 'd -> 'c * ('e -> 'd))
-					    * ('d -> 'e)))
-		      * ('e -> 'b)))
-	    type ('a, 'b) u = ('a, 'b, 'b, 'b, 'b) t
+         sig
+            type ('a, 'b, 'c, 'd, 'e) t =
+               'b
+               * ('a Node.t * 'b
+                  -> ('c
+                      * ('a Node.t * 'c -> ('d
+                                            * ('a Edge.t * 'd -> 'd)
+                                            * ('a Edge.t * 'd -> 'c * ('e -> 'd))
+                                            * ('d -> 'e)))
+                      * ('e -> 'b)))
+            type ('a, 'b) u = ('a, 'b, 'b, 'b, 'b) t
 
-	    val discoverFinishTimes:
-	       unit -> (('a, int) u * {discover: 'a Node.t -> int,
-				       finish: 'a Node.t -> int,
-				       destroy: unit -> unit})
-	    val finishNode: ('a Node.t -> unit) -> ('a, unit) u
-	    val startNode: ('a Node.t -> unit) -> ('a, unit) u
-	 end
+            val discoverFinishTimes:
+               unit -> (('a, int) u * {discover: 'a Node.t -> int,
+                                       finish: 'a Node.t -> int,
+                                       destroy: unit -> unit})
+            val finishNode: ('a Node.t -> unit) -> ('a, unit) u
+            val startNode: ('a Node.t -> unit) -> ('a, unit) u
+         end
 
       (* the main graph type *)
       type 'a t
@@ -58,15 +59,15 @@
 
       val addEdge: 'a t * {from: 'a Node.t, to: 'a Node.t} -> 'a Edge.t
       val coerce: 'a t -> unit t * {edge: 'a Edge.t -> unit Edge.t,
-				    node: 'a Node.t -> unit Node.t}
+                                    node: 'a Node.t -> unit Node.t}
       val dfs: 'a t * ('a, 'b, 'c, 'd, 'e) DfsParam.t -> 'b
       val dfsNodes: 'a t * 'a Node.t list * ('a, 'b, 'c, 'd, 'e) DfsParam.t -> 'b
       val dfsTree: 'a t * {root: 'a Node.t,
-			   nodeValue: 'a Node.t -> 'b} -> 'b Tree.t
+                           nodeValue: 'a Node.t -> 'b} -> 'b Tree.t
       val display:
-	 {graph: 'a t,
-	  layoutNode: 'a Node.t -> Layout.t,
-	  display: Layout.t -> unit} -> unit
+         {graph: 'a t,
+          layoutNode: 'a Node.t -> Layout.t,
+          display: Layout.t -> unit} -> unit
       (* dominators (graph, {root})
        * Returns the immediate dominator relation for the subgraph of graph
        * rooted at root.
@@ -75,12 +76,12 @@
        *  idom n = Unreachable    if n is not reachable from root
        *)
       datatype 'a idomRes =
-	 Idom of 'a Node.t
+         Idom of 'a Node.t
        | Root
        | Unreachable
       val dominators: 'a t * {root: 'a Node.t} -> {idom: 'a Node.t -> 'a idomRes}
       val dominatorTree: 'a t * {root: 'a Node.t,
-				 nodeValue: 'a Node.t -> 'b} -> 'b Tree.t
+                                 nodeValue: 'a Node.t -> 'b} -> 'b Tree.t
       val foreachDescendent: 'a t * 'a Node.t * ('a Node.t -> unit) -> unit
       val foldNodes: 'a t * 'b * ('a Node.t * 'b -> 'b) -> 'b
       val foreachEdge: 'a t * ('a Node.t * 'a Edge.t -> unit) -> unit
@@ -91,24 +92,24 @@
        * n1, ..., n_m-1 are ignored, there is an edge in g'.
        *)
       val ignoreNodes:
-	 'a t * ('a Node.t -> bool)
-	 -> 'a u t * {destroy: unit -> unit,
-		      newNode: 'a Node.t -> 'a u Node.t}
+         'a t * ('a Node.t -> bool)
+         -> 'a u t * {destroy: unit -> unit,
+                      newNode: 'a Node.t -> 'a u Node.t}
       val layoutDot:
-	 'a t * ({nodeName: 'a Node.t -> string}
-		 -> {edgeOptions: 'a Edge.t -> Dot.EdgeOption.t list,
-		     nodeOptions: 'a Node.t -> Dot.NodeOption.t list,
-		     options: Dot.GraphOption.t list,
-		     title: string})
-	 -> Layout.t
+         'a t * ({nodeName: 'a Node.t -> string}
+                 -> {edgeOptions: 'a Edge.t -> Dot.EdgeOption.t list,
+                     nodeOptions: 'a Node.t -> Dot.NodeOption.t list,
+                     options: Dot.GraphOption.t list,
+                     title: string})
+         -> Layout.t
       structure LoopForest: 
-	 sig 
-	    type 'a t
+         sig 
+            type 'a t
 
-	    val dest: 'a t -> {loops: {headers: 'a Node.t vector,
-				       child: 'a t} vector,
-			       notInLoop: 'a Node.t vector}
-	 end
+            val dest: 'a t -> {loops: {headers: 'a Node.t vector,
+                                       child: 'a t} vector,
+                               notInLoop: 'a Node.t vector}
+         end
       val loopForestSteensgaard: 'a t * {root: 'a Node.t} -> 'a LoopForest.t
       val new: unit -> 'a t
       val newNode: 'a t -> 'a Node.t
@@ -121,9 +122,9 @@
        * between classes iff there is an edge between nodes in the classes.
        *)
       val quotient:
-	 'a t * ('a Node.t vector vector)
-	 -> 'a u t * {destroy: unit -> unit,
-		      newNode: 'a Node.t -> 'a u Node.t}
+         'a t * ('a Node.t vector vector)
+         -> 'a u t * {destroy: unit -> unit,
+                      newNode: 'a Node.t -> 'a u Node.t}
       val removeDuplicateEdges: 'a t -> unit
       (* Strongly-connected components.
        * Each component is given as a list of nodes.
@@ -131,16 +132,16 @@
        *)
       val stronglyConnectedComponents: 'a t -> 'a Node.t list list
       val subgraph:
-	 'a t * ('a Node.t -> bool)
-	 -> 'a u t * {destroy: unit -> unit,
-		      newNode: 'a Node.t -> 'a u Node.t}
+         'a t * ('a Node.t -> bool)
+         -> 'a u t * {destroy: unit -> unit,
+                      newNode: 'a Node.t -> 'a u Node.t}
       (* topologicalSort g returns NONE if there is a cycle in g.
        * Otherwise, returns then nodes in g in a list such that if there is a
        * path in g from n to n', then n appears before n' in the list.
        *)
       val topologicalSort: 'a t -> 'a Node.t list option
       val transpose: 'a t -> 'a u t * {destroy: unit -> unit,
-				       newNode: 'a Node.t -> 'a u Node.t}
+                                       newNode: 'a Node.t -> 'a u Node.t}
    end
 
 
@@ -154,73 +155,73 @@
    val g = new ()
    val {get = name, set = setName, ...} =
       Property.getSetOnce (Node.plist,
-			   Property.initRaise ("name", Node.layout))
+                           Property.initRaise ("name", Node.layout))
    val node = String.memoize (fn s =>
-			      let
-				 val n = newNode g
-				 val _ = setName (n, s)
-			      in n
-			      end)
+                              let
+                                 val n = newNode g
+                                 val _ = setName (n, s)
+                              in n
+                              end)
    val _ =
       List.foreach ([("entry\nfoo", "B1"),
-		     ("B1", "B2"),
-		     ("B1", "B3"),
-		     ("B2", "exit"),
-		     ("B3", "B4"),
-		     ("B4", "B5"),
-		     ("B4", "B6"),
-		     ("B5", "exit"),
-		     ("B6", "B4")], fn (from, to) =>
-		    ignore (addEdge (g, {from = node from, to = node to})))
+                     ("B1", "B2"),
+                     ("B1", "B3"),
+                     ("B2", "exit"),
+                     ("B3", "B4"),
+                     ("B4", "B5"),
+                     ("B4", "B6"),
+                     ("B5", "exit"),
+                     ("B6", "B4")], fn (from, to) =>
+                    ignore (addEdge (g, {from = node from, to = node to})))
    val _ =
       File.withOut
       ("/tmp/z.dot", fn out =>
        let
-	  open Dot
+          open Dot
        in
-	  Layout.output (layoutDot
-			 (g, fn _ =>
-			  {title = "Muchnick",
-			   options = [],
-			   edgeOptions = fn _ => [],
-			   nodeOptions = fn n => [NodeOption.label (name n)]}),
-			 out)
-	  ; Out.newline out
+          Layout.output (layoutDot
+                         (g, fn _ =>
+                          {title = "Muchnick",
+                           options = [],
+                           edgeOptions = fn _ => [],
+                           nodeOptions = fn n => [NodeOption.label (name n)]}),
+                         out)
+          ; Out.newline out
        end)
    val {idom} = dominators (g, {root = node "entry\nfoo"})
    val g2 = new ()
    val {get = oldNode, set = setOldNode, ...} =
       Property.getSetOnce (Node.plist,
-			   Property.initRaise ("oldNode", Node.layout))
+                           Property.initRaise ("oldNode", Node.layout))
    val {get = newNode, ...} =
       Property.get (Node.plist,
-		    Property.initFun (fn n =>
-				      let
-					 val n' = newNode g2
-					 val _ = setOldNode (n', n)
-				      in n'
-				      end))
+                    Property.initFun (fn n =>
+                                      let
+                                         val n' = newNode g2
+                                         val _ = setOldNode (n', n)
+                                      in n'
+                                      end))
    val _ = foreachNode (g, fn n =>
-			case idom n of
-			   Idom n' =>
-			      ignore (addEdge (g2, {from = newNode n',
-						    to = newNode n}))
-			 | _ => ())
+                        case idom n of
+                           Idom n' =>
+                              ignore (addEdge (g2, {from = newNode n',
+                                                    to = newNode n}))
+                         | _ => ())
    val _ =
       File.withOut
       ("/tmp/z2.dot", fn out =>
        let
-	  open Dot
+          open Dot
        in
-	  Layout.output
-	  (layoutDot
-	   (g2, fn _ =>
-	    {title = "dom",
-	     options = [],
-	     edgeOptions = fn _ => [],
-	     nodeOptions = fn n => [NodeOption.label (name (oldNode n))]}),
-	   out)
-	  ; Out.newline out
+          Layout.output
+          (layoutDot
+           (g2, fn _ =>
+            {title = "dom",
+             options = [],
+             edgeOptions = fn _ => [],
+             nodeOptions = fn n => [NodeOption.label (name (oldNode n))]}),
+           out)
+          ; Out.newline out
        end)
 in
 end

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/directed-graph.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/directed-graph.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/directed-graph.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,31 +1,32 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 structure DirectedGraph:> DIRECTED_GRAPH = 
 struct
 
 structure Types =
    struct
       datatype node = Node of {successors: edge list ref,
-			       plist: PropertyList.t}
+                               plist: PropertyList.t}
       and edge = Edge of {from: node,
-			  to: node,
-			  plist: PropertyList.t}
+                          to: node,
+                          plist: PropertyList.t}
    end
 
 structure Edge =
    struct
       datatype t = datatype Types.edge
-	 
+         
       local
-	 fun make sel (Edge r) = sel r
+         fun make sel (Edge r) = sel r
       in
-	 val from = make #from
-	 val plist = make #plist
-	 val to = make #to
+         val from = make #from
+         val plist = make #plist
+         val to = make #to
       end
    end
 
@@ -33,56 +34,56 @@
    struct
       type edge = Types.edge
       datatype t = datatype Types.node
-	 
+         
       fun layout _ = Layout.str "node"
 
       fun successors (Node {successors, ...}) = !successors
       fun plist (Node {plist, ...}) = plist
 
       fun new () = Node {successors = ref [],
-			 plist = PropertyList.new ()}
+                         plist = PropertyList.new ()}
 
       fun equals (n, n') = PropertyList.equals (plist n, plist n')
 
       fun hasEdge {from, to} =
-	 List.exists (successors from, fn e => equals (to, Edge.to e))
+         List.exists (successors from, fn e => equals (to, Edge.to e))
 
       fun removeDuplicateSuccessors (Node {successors, ...}) =
-	 let
-	    val {get, rem, ...} =
-	       Property.get (plist, Property.initFun (fn _ => ref false))
-	    val es =
-	       List.fold (! successors, [], fn (e, ac) =>
-			  let
-			     val r = get (Edge.to e)
-			  in
-			     if !r
-				then ac
-			     else (r := true ; e :: ac)
-			  end)
-	    val () = List.foreach (es, rem o Edge.to)
-	    val () = successors := es
-	 in
-	    ()
-	 end
+         let
+            val {get, rem, ...} =
+               Property.get (plist, Property.initFun (fn _ => ref false))
+            val es =
+               List.fold (! successors, [], fn (e, ac) =>
+                          let
+                             val r = get (Edge.to e)
+                          in
+                             if !r
+                                then ac
+                             else (r := true ; e :: ac)
+                          end)
+            val () = List.foreach (es, rem o Edge.to)
+            val () = successors := es
+         in
+            ()
+         end
    end
 
 structure Edge =
    struct
       structure Node = Node
-	 
+         
       open Edge
 
       fun new {from, to} =
-	 Edge {from = from,
-	       to = to,
-	       plist = PropertyList.new ()}
-	 
+         Edge {from = from,
+               to = to,
+               plist = PropertyList.new ()}
+         
       fun equals (e, e') = PropertyList.equals (plist e, plist e')
 
       fun layout e =
-	 Layout.record [("from", Node.layout (from e)),
-			("to", Node.layout (to e))]
+         Layout.record [("from", Node.layout (from e)),
+                        ("to", Node.layout (to e))]
    end
 
 (*---------------------------------------------------*)
@@ -92,7 +93,7 @@
 datatype t = T of {nodes: Node.t list ref}
 
 fun coerce g = (g, {edge = fn e => e,
-		    node = fn n => n})
+                    node = fn n => n})
    
 fun nodes (T {nodes, ...}) = !nodes
 
@@ -121,34 +122,34 @@
 fun addEdge' arg = ignore (addEdge arg)
 
 fun layoutDot (T {nodes, ...},
-	       mkOptions:
-	       {nodeName: Node.t -> string}
-	       -> {edgeOptions: Edge.t -> Dot.EdgeOption.t list,
-		   nodeOptions: Node.t -> Dot.NodeOption.t list,
-		   options: Dot.GraphOption.t list,
-		   title: string}): Layout.t =
+               mkOptions:
+               {nodeName: Node.t -> string}
+               -> {edgeOptions: Edge.t -> Dot.EdgeOption.t list,
+                   nodeOptions: Node.t -> Dot.NodeOption.t list,
+                   options: Dot.GraphOption.t list,
+                   title: string}): Layout.t =
    let
       val ns = !nodes
       val c = Counter.new 0
       val {get = nodeId, rem, ...} =
-	 Property.get
-	 (Node.plist,
-	  Property.initFun
-	  (fn _ => concat ["n", Int.toString (Counter.next c)]))
+         Property.get
+         (Node.plist,
+          Property.initFun
+          (fn _ => concat ["n", Int.toString (Counter.next c)]))
       val {edgeOptions, nodeOptions, options, title} =
-	 mkOptions {nodeName = nodeId}
+         mkOptions {nodeName = nodeId}
       val nodes =
-	 List.revMap
-	 (ns, fn n as Node.Node {successors, ...} =>
-	  {name = nodeId n,
-	   options = nodeOptions n,
-	   successors = List.revMap (!successors, fn e =>
-				     {name = nodeId (Edge.to e),
-				      options = edgeOptions e})})
+         List.revMap
+         (ns, fn n as Node.Node {successors, ...} =>
+          {name = nodeId n,
+           options = nodeOptions n,
+           successors = List.revMap (!successors, fn e =>
+                                     {name = nodeId (Edge.to e),
+                                      options = edgeOptions e})})
       val res = 
-	 Dot.layout {nodes = nodes,
-		     options = options,
-		     title = title}
+         Dot.layout {nodes = nodes,
+                     options = options,
+                     title = title}
       val _ = List.foreach (ns, rem)
    in
       res
@@ -161,103 +162,103 @@
 structure DfsParam =
    struct
       type ('a, 'b, 'c, 'd, 'e) t =
-	 'b
-	 * (Node.t * 'b
-	    -> ('c
-		* (Node.t * 'c -> ('d
-				   * (Edge.t * 'd -> 'd)
-				   * (Edge.t * 'd -> 'c * ('e -> 'd))
-				   * ('d -> 'e)))
-		* ('e -> 'b)))
+         'b
+         * (Node.t * 'b
+            -> ('c
+                * (Node.t * 'c -> ('d
+                                   * (Edge.t * 'd -> 'd)
+                                   * (Edge.t * 'd -> 'c * ('e -> 'd))
+                                   * ('d -> 'e)))
+                * ('e -> 'b)))
       type ('a, 'b) u = ('a, 'b, 'b, 'b, 'b) t
 
       fun startFinishNode (a: 'a,
-			   start: Node.t * 'a -> 'a,
-			   finish: Node.t * 'a -> 'a): ('b, 'a) u =
-	 (a,
-	  fn (_, a) => (a,
-			fn (n, a) =>
-			let
-			   val a = start (n, a)
-			in
-			   (a, #2, fn (_, a) => (a, fn a => a),
-			    fn a => finish (n, a))
-			end,
-			fn a => a))
+                           start: Node.t * 'a -> 'a,
+                           finish: Node.t * 'a -> 'a): ('b, 'a) u =
+         (a,
+          fn (_, a) => (a,
+                        fn (n, a) =>
+                        let
+                           val a = start (n, a)
+                        in
+                           (a, #2, fn (_, a) => (a, fn a => a),
+                            fn a => finish (n, a))
+                        end,
+                        fn a => a))
 
       fun finishNode (f: Node.t -> unit) =
-	 startFinishNode ((), fn _ => (), f o #1)
+         startFinishNode ((), fn _ => (), f o #1)
 
       fun startNode (f: Node.t -> unit) =
-	 startFinishNode ((), f o #1, fn _ => ())
+         startFinishNode ((), f o #1, fn _ => ())
 
       fun discoverFinishTimes () =
-	 let
-	    val {get = discover, set = setDiscover,
-		 destroy = destroyDiscover, ...} =
-	       Property.destGetSetOnce
-	       (Node.plist, Property.initRaise ("discover", Node.layout))
-	    val {get = finish, set = setFinish, destroy = destroyFinish, ...} =
-	       Property.destGetSetOnce
-	       (Node.plist, Property.initRaise ("finish", Node.layout))
-	 in
-	    (startFinishNode (0: int,
-			      fn (n, t) => (setDiscover (n, t); t + 1),
-			      fn (n, t) => (setFinish (n, t); t + 1)),
-	     {destroy = fn () => (destroyDiscover (); destroyFinish ()),
-	      discover = discover,
-	      finish = finish})
-	 end
+         let
+            val {get = discover, set = setDiscover,
+                 destroy = destroyDiscover, ...} =
+               Property.destGetSetOnce
+               (Node.plist, Property.initRaise ("discover", Node.layout))
+            val {get = finish, set = setFinish, destroy = destroyFinish, ...} =
+               Property.destGetSetOnce
+               (Node.plist, Property.initRaise ("finish", Node.layout))
+         in
+            (startFinishNode (0: int,
+                              fn (n, t) => (setDiscover (n, t); t + 1),
+                              fn (n, t) => (setFinish (n, t); t + 1)),
+             {destroy = fn () => (destroyDiscover (); destroyFinish ()),
+              discover = discover,
+              finish = finish})
+         end
    end
-	 
+         
 fun dfsNodes (_: t,
-	      ns: Node.t list,
-	      (b, f): ('a, 'b, 'c, 'd, 'e) DfsParam.t) =
+              ns: Node.t list,
+              (b, f): ('a, 'b, 'c, 'd, 'e) DfsParam.t) =
    let
       type info = {hasBeenVisited: bool ref}
       val {get = nodeInfo: Node.t -> info, destroy, ...} =
-	 Property.destGetSet (Node.plist,
-			      Property.initFun (fn _ =>
-						{hasBeenVisited = ref false}))
+         Property.destGetSet (Node.plist,
+                              Property.initFun (fn _ =>
+                                                {hasBeenVisited = ref false}))
       val b =
-	 List.fold
-	 (ns, b, fn (n, b) =>
-	  let
-	     val info as {hasBeenVisited} = nodeInfo n
-	  in
-	     if !hasBeenVisited
-		then b
-	     else
-		let
-		   val (c, startNode, finishTree) = f (n, b)
-		   fun visit (n: Node.t, {hasBeenVisited}: info, c: 'c): 'e =
-		      let
-			 val _ = hasBeenVisited := true
-			 val (d, nonTreeEdge, treeEdge, finishNode) =
-			    startNode (n, c)
-		      in
-			 finishNode
-			 (List.fold
-			  (Node.successors n, d,
-			   fn (e, d) =>
-			   let
-			      val n = Edge.to e
-			      val info as {hasBeenVisited} = nodeInfo n
-			   in
-			      if !hasBeenVisited
-				 then nonTreeEdge (e, d)
-			      else
-				 let
-				    val (c, finish) = treeEdge (e, d)
-				 in
-				    finish (visit (n, info, c))
-				 end
-			   end))
-		      end
-		in
-		   finishTree (visit (n, info, c))
-		end
-	  end)
+         List.fold
+         (ns, b, fn (n, b) =>
+          let
+             val info as {hasBeenVisited} = nodeInfo n
+          in
+             if !hasBeenVisited
+                then b
+             else
+                let
+                   val (c, startNode, finishTree) = f (n, b)
+                   fun visit (n: Node.t, {hasBeenVisited}: info, c: 'c): 'e =
+                      let
+                         val _ = hasBeenVisited := true
+                         val (d, nonTreeEdge, treeEdge, finishNode) =
+                            startNode (n, c)
+                      in
+                         finishNode
+                         (List.fold
+                          (Node.successors n, d,
+                           fn (e, d) =>
+                           let
+                              val n = Edge.to e
+                              val info as {hasBeenVisited} = nodeInfo n
+                           in
+                              if !hasBeenVisited
+                                 then nonTreeEdge (e, d)
+                              else
+                                 let
+                                    val (c, finish) = treeEdge (e, d)
+                                 in
+                                    finish (visit (n, info, c))
+                                 end
+                           end))
+                      end
+                in
+                   finishTree (visit (n, info, c))
+                end
+          end)
       val _ = destroy ()
    in
       b
@@ -270,34 +271,34 @@
    (g, roots,
     ([], fn (_, trees) =>
      let
-	fun startNode (n, ()) =
-	   let
-	      fun nonTree (_, ts) = ts
-	      fun tree (_, ts) = ((), fn t => t :: ts)
-	      fun finish ts = Tree.T (nodeValue n, Vector.fromList ts)
-	   in
-	      ([], nonTree, tree, finish)
-	   end
-	fun finishTree t = t :: trees
+        fun startNode (n, ()) =
+           let
+              fun nonTree (_, ts) = ts
+              fun tree (_, ts) = ((), fn t => t :: ts)
+              fun finish ts = Tree.T (nodeValue n, Vector.fromList ts)
+           in
+              ([], nonTree, tree, finish)
+           end
+        fun finishTree t = t :: trees
      in
-	((), startNode, finishTree)
+        ((), startNode, finishTree)
      end))
 
 fun dfsTree (g, {root, nodeValue}) =
    case dfsTrees (g, [root], nodeValue) of
       [t] => t
-    | _ => Error.bug "dfsTree"
+    | _ => Error.bug "DirectedGraph.dfsTree"
 
 fun display {graph, layoutNode, display} =
    dfs (graph,
-	DfsParam.startNode
-	(fn n =>
-	 display let open Layout
-		 in seq [layoutNode n,
-			 str " ",
-			 list (List.revMap (Node.successors n,
-					    layoutNode o Edge.to))]
-		 end))
+        DfsParam.startNode
+        (fn n =>
+         display let open Layout
+                 in seq [layoutNode n,
+                         str " ",
+                         list (List.revMap (Node.successors n,
+                                            layoutNode o Edge.to))]
+                 end))
    
 fun foreachDescendent (g, n, f) =
    dfsNodes (g, [n], DfsParam.finishNode f)
@@ -306,7 +307,7 @@
    
 fun foreachEdge (g, edge) =
    foreachNode (g, fn n as Node.Node {successors, ...} =>
-		List.foreach (!successors, fn e => edge (n, e)))
+                List.foreach (!successors, fn e => edge (n, e)))
 
 (*--------------------------------------------------------*)
 (*                    Dominators                          *)
@@ -319,39 +320,39 @@
 structure NodeInfo =
    struct
       type t = {ancestor: Node.t ref,
-		bucket: Node.t list ref,
-		child: Node.t ref,
-		dfn: int ref, (* depth first number *)
-		idom: Node.t ref,
-		label: Node.t ref,
-		parent: Node.t ref,
-		preds: Node.t list ref,
-		sdno: int ref, (* semidominator dfn *)
-		size: int ref}
+                bucket: Node.t list ref,
+                child: Node.t ref,
+                dfn: int ref, (* depth first number *)
+                idom: Node.t ref,
+                label: Node.t ref,
+                parent: Node.t ref,
+                preds: Node.t list ref,
+                sdno: int ref, (* semidominator dfn *)
+                size: int ref}
    end
 
 fun validDominators (graph,
-		     {root: Node.t,
-		      idom: Node.t -> Node.t}): bool =
+                     {root: Node.t,
+                      idom: Node.t -> Node.t}): bool =
    (* Check for each edge v --> w that idom w dominates v.
     * FIXME: It should first check that idom describes a tree rooted at root.
     *)
-   DynamicWind.withEscape
+   Exn.withEscape
    (fn escape =>
     let
        fun dominates (a: Node.t, b: Node.t): bool =
-	  let
-	     fun loop b =
-		Node.equals (a, b)
-		orelse (not (Node.equals (b, root))
-			andalso loop (idom b))
-	  in loop b
-	  end
+          let
+             fun loop b =
+                Node.equals (a, b)
+                orelse (not (Node.equals (b, root))
+                        andalso loop (idom b))
+          in loop b
+          end
        val _ =
-	  foreachEdge (graph, fn (_, Edge.Edge {from, to, ...}) =>
-		       if dominates (idom to, from)
-			  then ()
-		       else escape false)
+          foreachEdge (graph, fn (_, Edge.Edge {from, to, ...}) =>
+                       if dominates (idom to, from)
+                          then ()
+                       else escape false)
     in true
     end)
 
@@ -366,32 +367,32 @@
    let
       val n0 = Node.new ()
       fun newNode (n: Node.t): NodeInfo.t =
-	 {ancestor = ref n0,
-	  bucket = ref [],
-	  child = ref n0,
-	  dfn = ref ~1,
-	  idom = ref n0,
-	  label = ref n,
-	  parent = ref n0,
-	  preds = ref [],
-	  sdno = ref ~1,
-	  size = ref 1}
+         {ancestor = ref n0,
+          bucket = ref [],
+          child = ref n0,
+          dfn = ref ~1,
+          idom = ref n0,
+          label = ref n,
+          parent = ref n0,
+          preds = ref [],
+          sdno = ref ~1,
+          size = ref 1}
       val {get = nodeInfo: Node.t -> NodeInfo.t, rem = remove, ...} =
-	 Property.get (Node.plist, Property.initFun newNode)
+         Property.get (Node.plist, Property.initFun newNode)
       local
-	 fun 'a make (sel: NodeInfo.t -> 'a ref) =
-	    (sel o nodeInfo, ! o sel o nodeInfo)
+         fun 'a make (sel: NodeInfo.t -> 'a ref) =
+            (sel o nodeInfo, ! o sel o nodeInfo)
       in
-	 val (ancestor', ancestor) = make #ancestor
-	 val (bucket', bucket) = make #bucket
-	 val (child', child) = make #child
-	 val (dfn', _) = make #dfn
-	 val (idom', idom) = make #idom
-	 val (label', label) = make #label
-	 val (parent', parent) = make #parent
-	 val (preds', preds) = make #preds
-	 val (sdno', sdno) = make #sdno
-	 val (size', size) = make #size
+         val (ancestor', ancestor) = make #ancestor
+         val (bucket', bucket) = make #bucket
+         val (child', child) = make #child
+         val (dfn', _) = make #dfn
+         val (idom', idom) = make #idom
+         val (label', label) = make #label
+         val (parent', parent) = make #parent
+         val (preds', preds) = make #preds
+         val (sdno', sdno) = make #sdno
+         val (size', size) = make #size
       end
       val _ = size' n0 := 0
       (* nodes is an array of nodes indexed by dfs number. *)
@@ -400,144 +401,144 @@
       fun ndfs i = Array.sub (nodes, i)
       val dfnCounter = ref 0
       fun dfs (v: Node.t): unit =
-	 let
-	    val i = !dfnCounter
-	    val _ = Int.inc dfnCounter
-	    val _ = dfn' v := i
-	    val _ = sdno' v := i
-	    val _ = Array.update (nodes, i, v)
-	    val _ =
-	       List.foreach
-	       (Node.successors v, fn Edge.Edge {to = w, ...} =>
-		let
-		   val _ = List.push (preds' w, v)
-		in if sdno w = ~1
-		      then (parent' w := v
-			    ; dfs w)
-		   else ()
-		end)
-	 in ()
-	 end
+         let
+            val i = !dfnCounter
+            val _ = Int.inc dfnCounter
+            val _ = dfn' v := i
+            val _ = sdno' v := i
+            val _ = Array.update (nodes, i, v)
+            val _ =
+               List.foreach
+               (Node.successors v, fn Edge.Edge {to = w, ...} =>
+                let
+                   val _ = List.push (preds' w, v)
+                in if sdno w = ~1
+                      then (parent' w := v
+                            ; dfs w)
+                   else ()
+                end)
+         in ()
+         end
       val _ = dfs root
       val numNodes = !dfnCounter
       (* compress ancestor path to node v to the node whose label has the
        * maximal (minimal?) semidominator number. 
        *)
       fun compress (v: Node.t): unit =
-	 if Node.equals (n0, ancestor (ancestor v))
-	    then ()
-	 else let
-		 val _ = compress (ancestor v)
-		 val _ =
-		    if sdno (label (ancestor v)) < sdno (label v)
-		       then label' v := label (ancestor v)
-		    else ()
-		 val _ = ancestor' v := ancestor (ancestor v)
-	      in ()
-	      end
+         if Node.equals (n0, ancestor (ancestor v))
+            then ()
+         else let
+                 val _ = compress (ancestor v)
+                 val _ =
+                    if sdno (label (ancestor v)) < sdno (label v)
+                       then label' v := label (ancestor v)
+                    else ()
+                 val _ = ancestor' v := ancestor (ancestor v)
+              in ()
+              end
       fun eval (v: Node.t): Node.t =
-	 (* Determine the ancestor of v whose semidominator has the minimal
-	  * depth-first number.
-	  *)
-	 if Node.equals (ancestor v, n0)
-	    then label v
-	 else let
-		 val _ = compress v
-	      in
-		 if sdno (label (ancestor v)) >= sdno (label v)
-		    then label v
-		 else label (ancestor v)
-	      end
+         (* Determine the ancestor of v whose semidominator has the minimal
+          * depth-first number.
+          *)
+         if Node.equals (ancestor v, n0)
+            then label v
+         else let
+                 val _ = compress v
+              in
+                 if sdno (label (ancestor v)) >= sdno (label v)
+                    then label v
+                 else label (ancestor v)
+              end
       fun link (v: Node.t, w: Node.t): unit =
-	 let
-	    fun loop s =
-	       if sdno (label w) < sdno (label (child s))
-		  then
-		     if size s + size (child (child s)) >= 2 * size (child s)
-			then (ancestor' (child s) := s
-			      ; child' s := child (child s)
-			      ; loop s)
-		     else (size' (child s) := size s
-			   ; ancestor' s := child s
-			   ; loop (child s))
-	       else s
-	    val s = loop w
-	    val _ = label' s := label w
-	    val _ = size' v := size v + size w
-	    val s =
-	       if size v < 2 * size w
-		  then
-		     let
-			val tmp = child v
-			val _ = child' v := s
-		     in tmp
-		     end
-	       else s
-	    fun loop s =
-	       if Node.equals (s, n0)
-		  then ()
-	       else (ancestor' s := v
-		     ; loop (child s))
-	    val _ = loop s
-	 in ()
-	 end
+         let
+            fun loop s =
+               if sdno (label w) < sdno (label (child s))
+                  then
+                     if size s + size (child (child s)) >= 2 * size (child s)
+                        then (ancestor' (child s) := s
+                              ; child' s := child (child s)
+                              ; loop s)
+                     else (size' (child s) := size s
+                           ; ancestor' s := child s
+                           ; loop (child s))
+               else s
+            val s = loop w
+            val _ = label' s := label w
+            val _ = size' v := size v + size w
+            val s =
+               if size v < 2 * size w
+                  then
+                     let
+                        val tmp = child v
+                        val _ = child' v := s
+                     in tmp
+                     end
+               else s
+            fun loop s =
+               if Node.equals (s, n0)
+                  then ()
+               else (ancestor' s := v
+                     ; loop (child s))
+            val _ = loop s
+         in ()
+         end
       val _ =
-	 Int.forDown
-	 (1, numNodes, fn i =>
-	  let
-	     (* Compute initial values for semidominators and store nodes with
-	      * the same semidominator in the same bucket.
-	      *)
-	     val w = ndfs i
-	     val min = List.fold (preds w, sdno w, fn (n, min) =>
-				  Int.min (min, sdno (eval n)))
-	     val _ = sdno' w := min
-	     val _ = List.push (bucket' (ndfs min), w)
-	     val _ = link (parent w, w)
-	     (* Compute immediate dominators for nodes in the bucket of w's
-	      * parent.
-	      *)
-	     val _ =
-		List.foreach
-		(bucket (parent w), fn v =>
-		 let
-		    val u = eval v
-		 in
-		    idom' v := (if sdno u < sdno v
-				   then u
-				else parent w)
-		 end)
-	     val _ = bucket' (parent w) := []
-	  in ()
-	  end)
+         Int.forDown
+         (1, numNodes, fn i =>
+          let
+             (* Compute initial values for semidominators and store nodes with
+              * the same semidominator in the same bucket.
+              *)
+             val w = ndfs i
+             val min = List.fold (preds w, sdno w, fn (n, min) =>
+                                  Int.min (min, sdno (eval n)))
+             val _ = sdno' w := min
+             val _ = List.push (bucket' (ndfs min), w)
+             val _ = link (parent w, w)
+             (* Compute immediate dominators for nodes in the bucket of w's
+              * parent.
+              *)
+             val _ =
+                List.foreach
+                (bucket (parent w), fn v =>
+                 let
+                    val u = eval v
+                 in
+                    idom' v := (if sdno u < sdno v
+                                   then u
+                                else parent w)
+                 end)
+             val _ = bucket' (parent w) := []
+          in ()
+          end)
       (* Adjust immediate dominators of nodes whose current version of the
        * immediate dominator differs from the node with the depth-first number
        * of the node's semidominator.
        *)
       val _ =
-	 Int.for
-	 (1, numNodes, fn i =>
-	  let
-	     val w = ndfs i
-	  in
-	     if Node.equals (idom w, ndfs (sdno w))
-		then ()
-	     else idom' w := idom (idom w)
-	  end)
+         Int.for
+         (1, numNodes, fn i =>
+          let
+             val w = ndfs i
+          in
+             if Node.equals (idom w, ndfs (sdno w))
+                then ()
+             else idom' w := idom (idom w)
+          end)
       val _ = idom' root := root
 (*       val _ = Assert.assert ("dominators", fn () =>
- *  			     validDominators (graph, {root = root,
- *  						      idom = idom}))
+ *                           validDominators (graph, {root = root,
+ *                                                    idom = idom}))
  *)
       val {get = idomFinal, set = setIdom, ...} =
-	 Property.getSetOnce (Node.plist, Property.initConst Unreachable)
+         Property.getSetOnce (Node.plist, Property.initConst Unreachable)
       val _ = setIdom (root, Root)
       val _ = Int.for (1, numNodes, fn i =>
-		       let
-			  val n = ndfs i
-		       in
-			  setIdom (n, Idom (idom n))
-		       end)
+                       let
+                          val n = ndfs i
+                       in
+                          setIdom (n, Idom (idom n))
+                       end)
       val _ = Int.for (0, numNodes, fn i => remove (ndfs i))
    in
       {idom = idomFinal}
@@ -547,83 +548,83 @@
    let
       val {idom} = dominators (graph, {root = root})
       val {get = nodeInfo, ...} =
-	 Property.get (Node.plist,
-		       Property.initFun (fn n => {children = ref [],
-						  value = nodeValue n}))
+         Property.get (Node.plist,
+                       Property.initFun (fn n => {children = ref [],
+                                                  value = nodeValue n}))
       val _ =
-	 List.foreach
-	 (nodes graph, fn n =>
-	  case idom n of
-	     Idom n' => List.push (#children (nodeInfo n'), n)
-	   | Root => ()
-	   | Unreachable => ())
+         List.foreach
+         (nodes graph, fn n =>
+          case idom n of
+             Idom n' => List.push (#children (nodeInfo n'), n)
+           | Root => ()
+           | Unreachable => ())
       fun treeAt (n: Node.t): 'a Tree.t =
-	 let
-	    val {children, value} = nodeInfo n
-	 in
-	    Tree.T (value, Vector.fromListMap (!children, treeAt))
-	 end
+         let
+            val {children, value} = nodeInfo n
+         in
+            Tree.T (value, Vector.fromListMap (!children, treeAt))
+         end
    in
       treeAt root
    end
 
 fun ignoreNodes (g: t, shouldIgnore: Node.t -> bool)
    : t * {destroy: unit -> unit,
-	  newNode: Node.t -> Node.t} =
+          newNode: Node.t -> Node.t} =
    let
       val g' = new ()
       val {destroy, get = newNode, ...} =
-	 Property.destGet (Node.plist,
-			   Property.initFun (fn _ => newNode g'))
+         Property.destGet (Node.plist,
+                           Property.initFun (fn _ => newNode g'))
       (* reach n is the set of non-ignored nodes that n reaches via
        * nonempty paths through ignored nodes.  It is computed by starting
        * at each node and doing a DFS that only goes through ignored nodes.
        *)
       val {get = reach: Node.t -> Node.t list, ...} =
-	 Property.get
-	 (Node.plist,
-	  Property.initFun
-	  (fn root =>
-	   let
-	      val r = ref []
-	      val {destroy, get = seen, ...} =
-		 Property.destGet (Node.plist,
-				   Property.initFun (fn _ => ref false))
-	      fun loop n =
-		 List.foreach (Node.successors n, fn e =>
-			       let
-				  val n = Edge.to e
-				  val s = seen n
-			       in
-				  if !s
-				     then ()
-				  else
-				     (s := true
-				      ; if shouldIgnore n
-					   then loop n
-					else List.push (r, n))
-			       end)
-	      val _ = loop root
-	      val _ = destroy ()
-	   in
-	      !r
-	   end))
+         Property.get
+         (Node.plist,
+          Property.initFun
+          (fn root =>
+           let
+              val r = ref []
+              val {destroy, get = seen, ...} =
+                 Property.destGet (Node.plist,
+                                   Property.initFun (fn _ => ref false))
+              fun loop n =
+                 List.foreach (Node.successors n, fn e =>
+                               let
+                                  val n = Edge.to e
+                                  val s = seen n
+                               in
+                                  if !s
+                                     then ()
+                                  else
+                                     (s := true
+                                      ; if shouldIgnore n
+                                           then loop n
+                                        else List.push (r, n))
+                               end)
+              val _ = loop root
+              val _ = destroy ()
+           in
+              !r
+           end))
       val _ =
-	 foreachNode
-	 (g, fn n =>
-	  if shouldIgnore n
-	     then ()
-	  else
-	     let
-		val from = newNode n
-	     in
-		List.foreach
-		(reach n, fn to =>
-		 addEdge' (g', {from = from, to = newNode to}))
-	     end)
+         foreachNode
+         (g, fn n =>
+          if shouldIgnore n
+             then ()
+          else
+             let
+                val from = newNode n
+             in
+                List.foreach
+                (reach n, fn to =>
+                 addEdge' (g', {from = from, to = newNode to}))
+             end)
    in
       (g', {destroy = destroy,
-	    newNode = newNode})
+            newNode = newNode})
    end
 
 (*--------------------------------------------------------*)
@@ -644,54 +645,54 @@
        * vector.
        *)
       datatype t = T of {loops: {headers: Node.t vector,
-				 child: t} vector,
-			 notInLoop: Node.t vector}
+                                 child: t} vector,
+                         notInLoop: Node.t vector}
 
       fun single n = T {loops = Vector.new0 (),
-			notInLoop = Vector.new1 n}
+                        notInLoop = Vector.new1 n}
 
       fun layoutDot (forest: t,
-		     {nodeName: Node.t -> string,
-		      options: Dot.GraphOption.t list,
-		      title: string}) =
-	 let
-	    open Dot
-	    fun label ns =
-	       NodeOption.label
-	       (Layout.toString (Vector.layout (Layout.str o nodeName) ns))
-	    val c = Counter.new 0
-	    fun newName () = concat ["n", Int.toString (Counter.next c)]
-	    val nodes = ref []
-	    fun loop (T {loops, notInLoop}) =
-	       let
-		  val n = newName ()
-		  val _ = List.push (nodes, {name = n,
-					     options = [label notInLoop,
-							NodeOption.Shape Box],
-					     successors = []})
-	       in
-		  Vector.fold
-		  (loops, [n], fn ({headers, child}, ac) =>
-		   let
-		      val n = newName ()
-		      val _ =
-			 List.push
-			 (nodes, {name = n,
-				  options = [label headers,
-					     NodeOption.Shape Ellipse],
-				  successors =
-				  List.revMap (loop child, fn n =>
-					       {name = n, options = []})})
-		   in
-		      n :: ac
-		   end)
-	       end
-	    val _ = loop forest
-	 in
-	    Dot.layout {nodes = !nodes,
-			options = options,
-			title = title}
-	 end
+                     {nodeName: Node.t -> string,
+                      options: Dot.GraphOption.t list,
+                      title: string}) =
+         let
+            open Dot
+            fun label ns =
+               NodeOption.label
+               (Layout.toString (Vector.layout (Layout.str o nodeName) ns))
+            val c = Counter.new 0
+            fun newName () = concat ["n", Int.toString (Counter.next c)]
+            val nodes = ref []
+            fun loop (T {loops, notInLoop}) =
+               let
+                  val n = newName ()
+                  val _ = List.push (nodes, {name = n,
+                                             options = [label notInLoop,
+                                                        NodeOption.Shape Box],
+                                             successors = []})
+               in
+                  Vector.fold
+                  (loops, [n], fn ({headers, child}, ac) =>
+                   let
+                      val n = newName ()
+                      val _ =
+                         List.push
+                         (nodes, {name = n,
+                                  options = [label headers,
+                                             NodeOption.Shape Ellipse],
+                                  successors =
+                                  List.revMap (loop child, fn n =>
+                                               {name = n, options = []})})
+                   in
+                      n :: ac
+                   end)
+               end
+            val _ = loop forest
+         in
+            Dot.layout {nodes = !nodes,
+                        options = options,
+                        title = title}
+         end
       val _ = layoutDot
    end
 
@@ -700,75 +701,75 @@
 fun stronglyConnectedComponents (g: t): Node.t list list =
    let
       val {get = nodeInfo: Node.t -> {dfnumber: int,
-				      isOnStack: bool ref,
-				      lowlink: int ref},
-	   set = setNodeInfo, destroy, ...} =
-	 Property.destGetSetOnce (Node.plist,
-				  Property.initRaise ("scc info", Node.layout))
+                                      isOnStack: bool ref,
+                                      lowlink: int ref},
+           set = setNodeInfo, destroy, ...} =
+         Property.destGetSetOnce (Node.plist,
+                                  Property.initRaise ("scc info", Node.layout))
       fun startNode (n, (count, stack, components)) =
-	 let
-	    val dfnumber = count
-	    val count = count + 1
-	    val lowlink = ref dfnumber
-	    val stack = n :: stack
-	    val isOnStack = ref true
-	    val v = {dfnumber = dfnumber,
-		     isOnStack = isOnStack,
-		     lowlink = lowlink}
-	    val _ = setNodeInfo (n, v)
-	    fun nonTreeEdge (e, z) =
-	       let
-		  val w = nodeInfo (Edge.to e)
-		  val _ =
-		     if #dfnumber w < #dfnumber v
-			andalso !(#isOnStack w)
-			andalso #dfnumber w < !(#lowlink v)
-			then #lowlink v := #dfnumber w
-		     else ()
-	       in
-		  z
-	       end
-	    fun treeEdge (e, z) =
-	       (z,
-		fn z =>
-		let
-		   val w = nodeInfo (Edge.to e)
-		   val _ =
-		      if !(#lowlink w) < !(#lowlink v)
-			 then #lowlink v := !(#lowlink w)
-		      else ()
-		in
-		   z
-		end)
-	    fun finishNode (count, stack, components) =
-	       if !lowlink = dfnumber
-		  then
-		     let
-			fun popTo (stack, ac) =
-			   case stack of
-			      [] => Error.bug "not on stack"
-			    | n' :: stack =>
-				 let
-				    val _ = #isOnStack (nodeInfo n') := false
-				    val ac = n' :: ac
-				 in
-				    if Node.equals (n, n')
-				       then (stack, ac)
-				    else popTo (stack, ac)
-				 end
-			val (stack, component) = popTo (stack, [])
-		     in
-			(count, stack, component :: components)
-		     end
-	       else (count, stack, components)
-	 in
-	    ((count, stack, components),
-	     nonTreeEdge,
-	     treeEdge,
-	     finishNode)
-	 end
+         let
+            val dfnumber = count
+            val count = count + 1
+            val lowlink = ref dfnumber
+            val stack = n :: stack
+            val isOnStack = ref true
+            val v = {dfnumber = dfnumber,
+                     isOnStack = isOnStack,
+                     lowlink = lowlink}
+            val _ = setNodeInfo (n, v)
+            fun nonTreeEdge (e, z) =
+               let
+                  val w = nodeInfo (Edge.to e)
+                  val _ =
+                     if #dfnumber w < #dfnumber v
+                        andalso !(#isOnStack w)
+                        andalso #dfnumber w < !(#lowlink v)
+                        then #lowlink v := #dfnumber w
+                     else ()
+               in
+                  z
+               end
+            fun treeEdge (e, z) =
+               (z,
+                fn z =>
+                let
+                   val w = nodeInfo (Edge.to e)
+                   val _ =
+                      if !(#lowlink w) < !(#lowlink v)
+                         then #lowlink v := !(#lowlink w)
+                      else ()
+                in
+                   z
+                end)
+            fun finishNode (count, stack, components) =
+               if !lowlink = dfnumber
+                  then
+                     let
+                        fun popTo (stack, ac) =
+                           case stack of
+                              [] => Error.bug "DirectedGraph.stronglyConnectedComponents.finishNode.popTo"
+                            | n' :: stack =>
+                                 let
+                                    val _ = #isOnStack (nodeInfo n') := false
+                                    val ac = n' :: ac
+                                 in
+                                    if Node.equals (n, n')
+                                       then (stack, ac)
+                                    else popTo (stack, ac)
+                                 end
+                        val (stack, component) = popTo (stack, [])
+                     in
+                        (count, stack, component :: components)
+                     end
+               else (count, stack, components)
+         in
+            ((count, stack, components),
+             nonTreeEdge,
+             treeEdge,
+             finishNode)
+         end
       val (_, _, components) =
-	 dfs (g, ((0, [], []), fn (_, z) => (z, startNode, fn z => z)))
+         dfs (g, ((0, [], []), fn (_, z) => (z, startNode, fn z => z)))
       val _ = destroy ()
    in
       components
@@ -783,33 +784,33 @@
    in
       fn g =>
       let
-	 val nodeCounter = Counter.new 0
-	 val {get = nodeIndex: Node.t -> int, destroy, ...} =
-	    Property.destGet
-	    (Node.plist,
-	     Property.initFun (fn _ => Counter.next nodeCounter))
-	 val index = Counter.next c
-	 val _ =
-	    File.withOut
-	    (concat ["graph", Int.toString index, ".dot"], fn out =>
-	     Layout.output
-	     (layoutDot (g, fn _ =>
-			 {edgeOptions = fn _ => [],
-			  nodeOptions = fn n => [Dot.NodeOption.label
-						 (Int.toString (nodeIndex n))],
-			  options = [],
-			  title = "scc graph"}),
-	      out))
-	 val ns = stronglyConnectedComponents g
-	 val _ =
-	    File.withOut
-	    (concat ["scc", Int.toString index], fn out =>
-	     Layout.outputl
-	     (List.layout (List.layout (Int.layout o nodeIndex)) ns,
-	      out))
-	 val _ = destroy ()
+         val nodeCounter = Counter.new 0
+         val {get = nodeIndex: Node.t -> int, destroy, ...} =
+            Property.destGet
+            (Node.plist,
+             Property.initFun (fn _ => Counter.next nodeCounter))
+         val index = Counter.next c
+         val _ =
+            File.withOut
+            (concat ["graph", Int.toString index, ".dot"], fn out =>
+             Layout.output
+             (layoutDot (g, fn _ =>
+                         {edgeOptions = fn _ => [],
+                          nodeOptions = fn n => [Dot.NodeOption.label
+                                                 (Int.toString (nodeIndex n))],
+                          options = [],
+                          title = "scc graph"}),
+              out))
+         val ns = stronglyConnectedComponents g
+         val _ =
+            File.withOut
+            (concat ["scc", Int.toString index], fn out =>
+             Layout.outputl
+             (List.layout (List.layout (Int.layout o nodeIndex)) ns,
+              out))
+         val _ = destroy ()
       in
-	 ns
+         ns
       end
    end
 
@@ -819,139 +820,139 @@
 fun loopForestSteensgaard (g: t, {root: Node.t}): LoopForest.t =
    let
       val {get =
-	   nodeInfo:
-	   Node.t -> {class: int ref,
-		      isHeader: bool ref,
-		      (* The corresponding node in the next subgraph. *)
-		      next: Node.t option ref,
-		      (* The corresponding node in the original graph. *)
-		      original: Node.t},
-	   set = setNodeInfo, 
-	   rem = remNodeInfo, ...} =
-	 Property.getSet
-	 (Node.plist, Property.initRaise ("loopForestSteensgaard", Node.layout))
+           nodeInfo:
+           Node.t -> {class: int ref,
+                      isHeader: bool ref,
+                      (* The corresponding node in the next subgraph. *)
+                      next: Node.t option ref,
+                      (* The corresponding node in the original graph. *)
+                      original: Node.t},
+           set = setNodeInfo, 
+           rem = remNodeInfo, ...} =
+         Property.getSet
+         (Node.plist, Property.initRaise ("loopForestSteensgaard", Node.layout))
       fun newNodeInfo (n, original) =
-	 setNodeInfo (n, {class = ref ~1,
-			  isHeader = ref false,
-			  next = ref NONE,
-			  original = original})
+         setNodeInfo (n, {class = ref ~1,
+                          isHeader = ref false,
+                          next = ref NONE,
+                          original = original})
       val _ = List.foreach (nodes g, fn n => newNodeInfo (n, n))
       (* Treat the root as though there is an external edge into it. *)
       val _ = #isHeader (nodeInfo root) := true
       (* Before calling treeFor, nodeInfo must be defined for all nodes in g. *)
       fun treeFor (g: t): LoopForest.t  =
-	 let
-	    val sccs = stronglyConnectedComponents g
-	    (* Put nodes in the same scc into the same class. *)
-	    val _ = List.foreachi 
-	            (sccs, fn (i, ns) =>
-		     List.foreach
-		     (ns, fn n =>
-		      #class (nodeInfo n) := i))
-	    (* Set nodes to be headers if they are the target of an edge whose
-	     * source is in another scc.
+         let
+            val sccs = stronglyConnectedComponents g
+            (* Put nodes in the same scc into the same class. *)
+            val _ = List.foreachi 
+                    (sccs, fn (i, ns) =>
+                     List.foreach
+                     (ns, fn n =>
+                      #class (nodeInfo n) := i))
+            (* Set nodes to be headers if they are the target of an edge whose
+             * source is in another scc.
              * This is a bit of an abuse of terminology, since it also marks
              * as headers nodes that are in their own trivial (one node) scc.
-	     *)
-	    val _ =
-	       List.foreach
-	       (nodes g, fn n =>
-		let
-		   val {class = ref class, ...} = nodeInfo n
-		   val _ =
-		      List.foreach
-		      (Node.successors n, fn e =>
-		       let
-			  val {class = ref class', isHeader, ...} =
-			     nodeInfo (Edge.to e)
-		       in
-			  if class = class'
-			     then ()
-			  else isHeader := true
-		       end)
-		in
-		   ()
-		end)
-	    (* Accumulate the subtrees. *)
-	    val loops = ref []
-	    val notInLoop = ref []
-	    val _ =
-	       List.foreach
-	       (sccs, fn ns =>
-		case ns of
-		   [n] =>
-		      let
-			 val {original, ...} = nodeInfo n
-		      in
-			 if List.exists (Node.successors n, fn e =>
-					 Node.equals (n, Edge.to e))
-			    then
-			       List.push (loops,
-					  {headers = Vector.new1 original,
-					   child = LoopForest.single original})
-			 else List.push (notInLoop, original)
-		      end
-		 | _ =>
-		      let
-			 (* Build a new subgraph of the component, sans edges
-			  * that go into headers.
-			  *)
-			 val g' = new ()
-			 val headers = ref []
-			 (* Create all the new nodes. *)
-			 val _ =
-			    List.foreach
-			    (ns, fn n =>
-			     let
-				val {next, original, ...} = nodeInfo n
-				val n' = newNode g'
-				val _ = next := SOME n'
-				val _ = newNodeInfo (n', original)
-			     in
-				()
-			     end)
-			 (* Add all the edges. *)
-			 val _ =
-			    List.foreach
-			    (ns, fn from =>
-			     let
-				val {class = ref class, isHeader, next,
-				     original, ...} = nodeInfo from
-				val from' = valOf (!next)
-				val _ =
-				   if !isHeader
-				      then List.push (headers, original)
-				   else ()
-			     in
-				List.foreach
-				(Node.successors from, fn e =>
-				 let
-				    val to = Edge.to e
-				    val {class = ref class', 
-					 isHeader = isHeader',
-					 next = next', ...} = nodeInfo to
-				 in
-				    if class = class'
-				       andalso not (!isHeader')
-				       then addEdge' (g', {from = from',
-							   to = valOf (!next')})
-				    else ()
-				 end)
-			     end)
-			 (* We're done with the old graph, so delete the
-			  * nodeInfo.
-			  *)
-			 val _ = List.foreach (ns, remNodeInfo)
-			 val headers = Vector.fromList (!headers)
-			 val child = treeFor g'
-		      in
-			 List.push (loops, {child = child,
-					    headers = headers})
-		      end)
-	 in
-	    LoopForest.T {loops = Vector.fromList (!loops),
-			  notInLoop = Vector.fromList (!notInLoop)}
-	 end
+             *)
+            val _ =
+               List.foreach
+               (nodes g, fn n =>
+                let
+                   val {class = ref class, ...} = nodeInfo n
+                   val _ =
+                      List.foreach
+                      (Node.successors n, fn e =>
+                       let
+                          val {class = ref class', isHeader, ...} =
+                             nodeInfo (Edge.to e)
+                       in
+                          if class = class'
+                             then ()
+                          else isHeader := true
+                       end)
+                in
+                   ()
+                end)
+            (* Accumulate the subtrees. *)
+            val loops = ref []
+            val notInLoop = ref []
+            val _ =
+               List.foreach
+               (sccs, fn ns =>
+                case ns of
+                   [n] =>
+                      let
+                         val {original, ...} = nodeInfo n
+                      in
+                         if List.exists (Node.successors n, fn e =>
+                                         Node.equals (n, Edge.to e))
+                            then
+                               List.push (loops,
+                                          {headers = Vector.new1 original,
+                                           child = LoopForest.single original})
+                         else List.push (notInLoop, original)
+                      end
+                 | _ =>
+                      let
+                         (* Build a new subgraph of the component, sans edges
+                          * that go into headers.
+                          *)
+                         val g' = new ()
+                         val headers = ref []
+                         (* Create all the new nodes. *)
+                         val _ =
+                            List.foreach
+                            (ns, fn n =>
+                             let
+                                val {next, original, ...} = nodeInfo n
+                                val n' = newNode g'
+                                val _ = next := SOME n'
+                                val _ = newNodeInfo (n', original)
+                             in
+                                ()
+                             end)
+                         (* Add all the edges. *)
+                         val _ =
+                            List.foreach
+                            (ns, fn from =>
+                             let
+                                val {class = ref class, isHeader, next,
+                                     original, ...} = nodeInfo from
+                                val from' = valOf (!next)
+                                val _ =
+                                   if !isHeader
+                                      then List.push (headers, original)
+                                   else ()
+                             in
+                                List.foreach
+                                (Node.successors from, fn e =>
+                                 let
+                                    val to = Edge.to e
+                                    val {class = ref class', 
+                                         isHeader = isHeader',
+                                         next = next', ...} = nodeInfo to
+                                 in
+                                    if class = class'
+                                       andalso not (!isHeader')
+                                       then addEdge' (g', {from = from',
+                                                           to = valOf (!next')})
+                                    else ()
+                                 end)
+                             end)
+                         (* We're done with the old graph, so delete the
+                          * nodeInfo.
+                          *)
+                         val _ = List.foreach (ns, remNodeInfo)
+                         val headers = Vector.fromList (!headers)
+                         val child = treeFor g'
+                      in
+                         List.push (loops, {child = child,
+                                            headers = headers})
+                      end)
+         in
+            LoopForest.T {loops = Vector.fromList (!loops),
+                          notInLoop = Vector.fromList (!notInLoop)}
+         end
    in
       treeFor g
    end
@@ -960,112 +961,112 @@
    let
       val numClasses = Vector.length vs
       val {destroy, get = nodeClass: Node.t -> int, set = setNodeClass, ...} =
-	 Property.destGetSetOnce (Node.plist,
-				  Property.initRaise ("newNode", Node.layout))
+         Property.destGetSetOnce (Node.plist,
+                                  Property.initRaise ("newNode", Node.layout))
       val g' = new ()
       val newNodes =
-	 Vector.mapi (vs, fn (i, v) =>
-		      let
-			 val n' = newNode g'
-			 val _ =
-			    Vector.foreach (v, fn n => setNodeClass (n, i))
-		      in
-			 n'
-		      end)
+         Vector.mapi (vs, fn (i, v) =>
+                      let
+                         val n' = newNode g'
+                         val _ =
+                            Vector.foreach (v, fn n => setNodeClass (n, i))
+                      in
+                         n'
+                      end)
       val successors = Array.array (numClasses, [])
       val _ =
-	 foreachNode
-	 (g, fn n =>
-	  let
-	     val class = nodeClass n
-	  in
-	     Array.update
-	     (successors, class,
-	      List.fold (Node.successors n,
-			 Array.sub (successors, class),
-			 fn (e, ac) => nodeClass (Edge.to e) :: ac))
-	  end)
+         foreachNode
+         (g, fn n =>
+          let
+             val class = nodeClass n
+          in
+             Array.update
+             (successors, class,
+              List.fold (Node.successors n,
+                         Array.sub (successors, class),
+                         fn (e, ac) => nodeClass (Edge.to e) :: ac))
+          end)
       (* Eliminate duplicates from successor lists and add the graph edges. *)
       val hasIt = Array.array (numClasses, false)
       val _ =
-	 Array.foreachi
-	 (successors, fn (i, cs) =>
-	  let
-	     val from = Vector.sub (newNodes, i)
-	     val _ =
-		List.foreach
-		(cs, fn c =>
-		 if Array.sub (hasIt, c)
-		    then ()
-		 else (Array.update (hasIt, c, true)
-		       ; addEdge' (g', {from = from,
-					to = Vector.sub (newNodes, c)})))
-	     val _ =
-		List.foreach (cs, fn c => Array.update (hasIt, c, false))
-	  in
-	     ()
-	  end)
+         Array.foreachi
+         (successors, fn (i, cs) =>
+          let
+             val from = Vector.sub (newNodes, i)
+             val _ =
+                List.foreach
+                (cs, fn c =>
+                 if Array.sub (hasIt, c)
+                    then ()
+                 else (Array.update (hasIt, c, true)
+                       ; addEdge' (g', {from = from,
+                                        to = Vector.sub (newNodes, c)})))
+             val _ =
+                List.foreach (cs, fn c => Array.update (hasIt, c, false))
+          in
+             ()
+          end)
       fun newNode n = Vector.sub (newNodes, nodeClass n)
    in
       (g', {destroy = destroy,
-	    newNode = newNode})
+            newNode = newNode})
    end
 
 fun subgraph (g: t, keep: Node.t -> bool) =
    let
       val sub = new ()
       val {get = newNode, destroy, ...} =
-	 Property.destGet (Node.plist,
-			   Property.initFun (fn _ => newNode sub))
+         Property.destGet (Node.plist,
+                           Property.initFun (fn _ => newNode sub))
       val _ = foreachNode (g, fn from =>
-			   if not (keep from)
-			      then ()
-			   else
-			      List.foreach
-			      (Node.successors from,
-			       let
-				  val from = newNode from
-			       in
-				  fn e =>
-				  let
-				     val to = Edge.to e
-				  in
-				     if keep to
-					then
-					   addEdge' (sub, {from = from,
-							   to = newNode to})
-				     else ()
-				  end
-			       end))
+                           if not (keep from)
+                              then ()
+                           else
+                              List.foreach
+                              (Node.successors from,
+                               let
+                                  val from = newNode from
+                               in
+                                  fn e =>
+                                  let
+                                     val to = Edge.to e
+                                  in
+                                     if keep to
+                                        then
+                                           addEdge' (sub, {from = from,
+                                                           to = newNode to})
+                                     else ()
+                                  end
+                               end))
    in
       (sub, {destroy = destroy,
-	     newNode = newNode})
+             newNode = newNode})
    end
 
 fun topologicalSort (g: t): Node.t list option =
    let
       exception Cycle
       val {get = amVisiting, destroy, ...} =
-	 Property.destGet (Node.plist, Property.initFun (fn _ => ref false))
+         Property.destGet (Node.plist, Property.initFun (fn _ => ref false))
       fun doit () =
-	 dfs (g,
-	      ([], fn (_, ns) =>
-	       let
-		  fun startNode (n, ns) =
-		     let
-			fun nonTree (e, ns) =
-			   if !(amVisiting (Edge.to e))
-			      then raise Cycle
-			   else ns
-			fun tree (_, ns) = (ns, fn ns => ns)
-			fun finish ns = n :: ns
-		     in
-			(ns, nonTree, tree, finish)
-		     end
-		  fun finishTree ns = ns
-	       in
-		  (ns, startNode, finishTree)
-	       end))
+         dfs (g,
+              ([], fn (_, ns) =>
+               let
+                  fun startNode (n, ns) =
+                     let
+                        fun nonTree (e, ns) =
+                           if !(amVisiting (Edge.to e))
+                              then raise Cycle
+                           else ns
+                        fun tree (_, ns) = (ns, fn ns => ns)
+                        fun finish ns = n :: ns
+                     in
+                        (ns, nonTree, tree, finish)
+                     end
+                  fun finishTree ns = ns
+               in
+                  (ns, startNode, finishTree)
+               end))
       val res = SOME (doit ()) handle Cycle => NONE
       val _ = destroy ()
    in
@@ -1076,21 +1077,21 @@
    let
       val transpose = new ()
       val {get = newNode, destroy, ...} =
-	 Property.destGet (Node.plist,
-			   Property.initFun (fn _ => newNode transpose))
+         Property.destGet (Node.plist,
+                           Property.initFun (fn _ => newNode transpose))
       val _ = foreachNode (g, fn to =>
-			   List.foreach
-			   (Node.successors to,
-			    let
-			       val to = newNode to
-			    in
-			       fn e =>
-			       addEdge' (transpose, {from = newNode (Edge.to e),
-						     to = to})
-			    end))
+                           List.foreach
+                           (Node.successors to,
+                            let
+                               val to = newNode to
+                            in
+                               fn e =>
+                               addEdge' (transpose, {from = newNode (Edge.to e),
+                                                     to = to})
+                            end))
    in
       (transpose, {destroy = destroy,
-		   newNode = newNode})
+                   newNode = newNode})
    end
 
 val transpose =
@@ -1102,38 +1103,38 @@
    in
       fn g =>
       let
-	 val nodeCounter = Counter.new 0
-	 val {get = nodeIndex: Node.t -> int, destroy, ...} =
-	    Property.destGet
-	    (Node.plist,
-	     Property.initFun (fn _ => Counter.next nodeCounter))
-	 val index = Counter.next c
-	 val _ =
-	    File.withOut
-	    (concat ["graph", Int.toString index, ".dot"], fn out =>
-	     Layout.output
-	     (layoutDot (g, fn _ =>
-			 {edgeOptions = fn _ => [],
-			  nodeOptions = fn n => [Dot.NodeOption.label
-						 (Int.toString (nodeIndex n))],
-			  options = [],
-			  title = "transpose graph"}),
-	      out))
-	 val z as (g, _) = transpose g
-	 val _ =
-	    File.withOut
-	    (concat ["transpose", Int.toString index, ".dot"], fn out =>
-	     Layout.output
-	     (layoutDot (g, fn _ =>
-			 {edgeOptions = fn _ => [],
-			  nodeOptions = fn n => [Dot.NodeOption.label
-						 (Int.toString (nodeIndex n))],
-			  options = [],
-			  title = "transpose graph"}),
-	      out))
-	 val _ = destroy ()
+         val nodeCounter = Counter.new 0
+         val {get = nodeIndex: Node.t -> int, destroy, ...} =
+            Property.destGet
+            (Node.plist,
+             Property.initFun (fn _ => Counter.next nodeCounter))
+         val index = Counter.next c
+         val _ =
+            File.withOut
+            (concat ["graph", Int.toString index, ".dot"], fn out =>
+             Layout.output
+             (layoutDot (g, fn _ =>
+                         {edgeOptions = fn _ => [],
+                          nodeOptions = fn n => [Dot.NodeOption.label
+                                                 (Int.toString (nodeIndex n))],
+                          options = [],
+                          title = "transpose graph"}),
+              out))
+         val z as (g, _) = transpose g
+         val _ =
+            File.withOut
+            (concat ["transpose", Int.toString index, ".dot"], fn out =>
+             Layout.output
+             (layoutDot (g, fn _ =>
+                         {edgeOptions = fn _ => [],
+                          nodeOptions = fn n => [Dot.NodeOption.label
+                                                 (Int.toString (nodeIndex n))],
+                          options = [],
+                          title = "transpose graph"}),
+              out))
+         val _ = destroy ()
       in
-	 z
+         z
       end
    end
 

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/directed-sub-graph.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/directed-sub-graph.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/directed-sub-graph.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 type int = Int.t
 
 signature DIRECTED_SUB_GRAPH = 
@@ -12,28 +13,28 @@
       type t
 
       structure Node: 
-	 sig
-	    type graph
-	    type edge
-	    type t
+         sig
+            type graph
+            type edge
+            type t
 
-	    val equals: t * t -> bool
-	    val hasEdge: graph * {from: t, to: t} -> bool
-	    val layout: t -> Layout.t
-	    val plist: t -> PropertyList.t
-	    val successors: graph * t -> edge list
-	 end
+            val equals: t * t -> bool
+            val hasEdge: graph * {from: t, to: t} -> bool
+            val layout: t -> Layout.t
+            val plist: t -> PropertyList.t
+            val successors: graph * t -> edge list
+         end
       structure Edge:
-	 sig
-	    type graph
-	    type node
-	    type t
+         sig
+            type graph
+            type node
+            type t
 
-	    val equals: t * t -> bool
-	    val from: graph * t -> node
-	    val plist: t -> PropertyList.t
-	    val to: graph * t -> node
-	 end
+            val equals: t * t -> bool
+            val from: graph * t -> node
+            val plist: t -> PropertyList.t
+            val to: graph * t -> node
+         end
       sharing type Node.edge = Edge.t
       sharing type Edge.node = Node.t
       sharing type Node.graph = t
@@ -41,18 +42,18 @@
 
       (* depth first search *)
       structure DfsParam:
-	 sig
-	    type t = {startNode: Node.t -> unit,
-		      finishNode: Node.t -> unit,
-		      handleTreeEdge: Edge.t -> unit,
-		      handleNonTreeEdge: Edge.t -> unit,
-		      startTree: Node.t -> unit,
-		      finishTree: Node.t -> unit,
-		      finishDfs: unit -> unit}
-	    val finishNode: (Node.t -> unit) -> t
-	    val ignore: 'a -> unit
-	    val combine: t * t -> t
-	 end
+         sig
+            type t = {startNode: Node.t -> unit,
+                      finishNode: Node.t -> unit,
+                      handleTreeEdge: Edge.t -> unit,
+                      handleNonTreeEdge: Edge.t -> unit,
+                      startTree: Node.t -> unit,
+                      finishTree: Node.t -> unit,
+                      finishDfs: unit -> unit}
+            val finishNode: (Node.t -> unit) -> t
+            val ignore: 'a -> unit
+            val combine: t * t -> t
+         end
 
       (* create a sub-graph from a graph *)
       val subGraph: t * {nodeP: Node.t -> bool, edgeP: Edge.t -> bool} -> t
@@ -62,13 +63,13 @@
       val dfs: t * DfsParam.t -> unit
       val dfsNodes: t * Node.t list * DfsParam.t -> unit
       val discoverFinishTimes: t -> {discover: Node.t -> int,
-				     finish: Node.t -> int,
-				     destroy: unit -> unit,
-				     param: DfsParam.t}
+                                     finish: Node.t -> int,
+                                     destroy: unit -> unit,
+                                     param: DfsParam.t}
       val display:
-	 {graph: t,
-	  layoutNode: Node.t -> Layout.t,
-	  display: Layout.t -> unit} -> unit
+         {graph: t,
+          layoutNode: Node.t -> Layout.t,
+          display: Layout.t -> unit} -> unit
       (* dominators {graph, root}
        * Pre: All nodes in graph must be reachable from root.
        *      This condition is checked.
@@ -85,29 +86,29 @@
 (*     val input: In.t * (In.t -> 'a)* (In.t -> 'b) -> t * 'a * (Edge.t -> 'b) *)
 (*      val isCyclic: t -> bool*)
       val layoutDot:
-	 t * {title: string,
-	      options: Dot.GraphOption.t list,
-	      edgeOptions: Edge.t -> Dot.EdgeOption.t list,
-	      nodeOptions: Node.t -> Dot.NodeOption.t list} -> Layout.t
+         t * {title: string,
+              options: Dot.GraphOption.t list,
+              edgeOptions: Edge.t -> Dot.EdgeOption.t list,
+              nodeOptions: Node.t -> Dot.NodeOption.t list} -> Layout.t
       val loopForest:
-	 {headers: (* graph *) Node.t list -> (* graph *) Node.t list,
-	  graph: t,
-	  root: (* graph *) Node.t}
-	 -> {forest: t,
-	     graphToForest: (* graph *) Node.t -> (* forest *) Node.t,
-	     headers: (* graph *) Node.t list -> (* graph *) Node.t list,
-	     isHeader: (* graph *) Node.t -> bool,
-	     loopNodes: (* forest *) Node.t -> (* graph *) Node.t list,
-	     parent: (* forest *) Node.t -> (* forest *) Node.t option}
+         {headers: (* graph *) Node.t list -> (* graph *) Node.t list,
+          graph: t,
+          root: (* graph *) Node.t}
+         -> {forest: t,
+             graphToForest: (* graph *) Node.t -> (* forest *) Node.t,
+             headers: (* graph *) Node.t list -> (* graph *) Node.t list,
+             isHeader: (* graph *) Node.t -> bool,
+             loopNodes: (* forest *) Node.t -> (* graph *) Node.t list,
+             parent: (* forest *) Node.t -> (* forest *) Node.t option}
       val loopForestSteensgaard:
-	 {graph: t,
-	  root: (* graph *) Node.t}
-	 -> {forest: t,
-	     graphToForest: (* graph *) Node.t -> (* forest *) Node.t,
-	     headers: (* graph *) Node.t list -> (* graph *) Node.t list,
-	     isHeader: (* graph *) Node.t -> bool,
-	     loopNodes: (* forest *) Node.t -> (* graph *) Node.t list,
-	     parent: (* forest *) Node.t -> (* forest *) Node.t option}
+         {graph: t,
+          root: (* graph *) Node.t}
+         -> {forest: t,
+             graphToForest: (* graph *) Node.t -> (* forest *) Node.t,
+             headers: (* graph *) Node.t list -> (* graph *) Node.t list,
+             isHeader: (* graph *) Node.t -> bool,
+             loopNodes: (* forest *) Node.t -> (* graph *) Node.t list,
+             parent: (* forest *) Node.t -> (* forest *) Node.t option}
       val new: unit -> t
       val newNode: t -> Node.t
       val nodes: t -> Node.t list
@@ -136,69 +137,69 @@
    val g = new ()
    val {get = name, set = setName, ...} =
       Property.getSetOnce (Node.plist,
-			   Property.initRaise ("name", Node.layout))
+                           Property.initRaise ("name", Node.layout))
    val node = String.memoize (fn s =>
-			      let
-				 val n = newNode g
-				 val _ = setName (n, s)
-			      in n
-			      end)
+                              let
+                                 val n = newNode g
+                                 val _ = setName (n, s)
+                              in n
+                              end)
    val _ =
       List.foreach ([("entry\nfoo", "B1"),
-		     ("B1", "B2"),
-		     ("B1", "B3"),
-		     ("B2", "exit"),
-		     ("B3", "B4"),
-		     ("B4", "B5"),
-		     ("B4", "B6"),
-		     ("B5", "exit"),
-		     ("B6", "B4")], fn (from, to) =>
-		    ignore (addEdge (g, {from = node from, to = node to})))
+                     ("B1", "B2"),
+                     ("B1", "B3"),
+                     ("B2", "exit"),
+                     ("B3", "B4"),
+                     ("B4", "B5"),
+                     ("B4", "B6"),
+                     ("B5", "exit"),
+                     ("B6", "B4")], fn (from, to) =>
+                    ignore (addEdge (g, {from = node from, to = node to})))
    val _ =
       File.withOut
       ("/tmp/z.dot", fn out =>
        let
-	  open Dot
+          open Dot
        in
-	  Layout.output (layoutDot
-			 (g,
-			  {title = "Muchnick",
-			   options = [],
-			   edgeOptions = fn _ => [],
-			   nodeOptions = fn n => [NodeOption.label (name n)]}),
-			 out)
-	  ; Out.newline out
+          Layout.output (layoutDot
+                         (g,
+                          {title = "Muchnick",
+                           options = [],
+                           edgeOptions = fn _ => [],
+                           nodeOptions = fn n => [NodeOption.label (name n)]}),
+                         out)
+          ; Out.newline out
        end)
    val {idom} = dominators (g, {root = node "entry\nfoo"})
    val g2 = new ()
    val {get = oldNode, set = setOldNode, ...} =
       Property.getSetOnce (Node.plist,
-			   Property.initRaise ("oldNode", Node.layout))
+                           Property.initRaise ("oldNode", Node.layout))
    val {get = newNode, ...} =
       Property.get (Node.plist,
-		    Property.initFun (fn n =>
-				      let
-					 val n' = newNode g2
-					 val _ = setOldNode (n', n)
-				      in n'
-				      end))
+                    Property.initFun (fn n =>
+                                      let
+                                         val n' = newNode g2
+                                         val _ = setOldNode (n', n)
+                                      in n'
+                                      end))
    val _ = foreachNode (g, fn n =>
-			ignore (addEdge (g2, {from = newNode (idom n),
-					      to = newNode n})))
+                        ignore (addEdge (g2, {from = newNode (idom n),
+                                              to = newNode n})))
    val _ =
       File.withOut
       ("/tmp/z2.dot", fn out =>
        let
-	  open Dot
+          open Dot
        in
-	  Layout.output
-	  (layoutDot
-	   (g2, {title = "dom",
-		 options = [],
-		 edgeOptions = fn _ => [],
-		 nodeOptions = fn n => [NodeOption.label (name (oldNode n))]}),
-	   out)
-	  ; Out.newline out
+          Layout.output
+          (layoutDot
+           (g2, {title = "dom",
+                 options = [],
+                 edgeOptions = fn _ => [],
+                 nodeOptions = fn n => [NodeOption.label (name (oldNode n))]}),
+           out)
+          ; Out.newline out
        end)
 in
 end

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/directed-sub-graph.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/directed-sub-graph.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/directed-sub-graph.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,22 +1,23 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 structure DirectedSubGraph: DIRECTED_SUB_GRAPH = 
 struct
 
 structure Types =
    struct
       datatype node = Node of {successors: edge list ref,
-			       plist: PropertyList.t}
+                               plist: PropertyList.t}
       and edge = Edge of {from: node,
-			  to: node,
-			  plist: PropertyList.t}
+                          to: node,
+                          plist: PropertyList.t}
       and graph = T of {nodes: node list ref,
-			nodeP: node -> bool,
-			edgeP: edge -> bool}
+                        nodeP: node -> bool,
+                        edgeP: edge -> bool}
    end
 
 structure Edge =
@@ -28,28 +29,28 @@
       fun layout _ = Layout.str "edge"
 
       local
-	 fun make sel (Edge r) = sel r
+         fun make sel (Edge r) = sel r
       in
-	 val from = make #from
-	 val plist = make #plist
-	 val to = make #to
+         val from = make #from
+         val plist = make #plist
+         val to = make #to
       end
       val from = fn (T {nodeP, edgeP, ...}, e) => 
-	 (Assert.assert("Edge.from", fn () => edgeP e)
-	  ; Assert.assert("Edge.from", fn () => nodeP (from e))
-	  ; from e)
+         (Assert.assert("DirectedSubGraph.Edge.from", fn () => edgeP e)
+          ; Assert.assert("DirectedSubGraph.Edge.from", fn () => nodeP (from e))
+          ; from e)
       val to = fn (T {nodeP, edgeP, ...}, e) => 
-	 (Assert.assert("Edge.to", fn () => edgeP e)
-	  ; Assert.assert("Edge.to", fn () => nodeP (to e))
-	  ; to e)
+         (Assert.assert("DirectedSubGraph.Edge.to", fn () => edgeP e)
+          ; Assert.assert("DirectedSubGraph.Edge.to", fn () => nodeP (to e))
+          ; to e)
 
       fun new (T {nodeP, edgeP, ...}, {from, to}) =
-	 (Assert.assert("Edge.new", fn () => nodeP from)
-	  ; Assert.assert("Edge.new", fn () => nodeP to)
-	  ; Edge {from = from,
-		  to = to,
-		  plist = PropertyList.new ()})
-	  
+         (Assert.assert("DirectedSubGraph.Edge.new", fn () => nodeP from)
+          ; Assert.assert("DirectedSubGraph.Edge.new", fn () => nodeP to)
+          ; Edge {from = from,
+                  to = to,
+                  plist = PropertyList.new ()})
+          
       fun equals (e, e') = PropertyList.equals (plist e, plist e')
    end
 
@@ -62,86 +63,86 @@
       fun layout _ = Layout.str "node"
 
       local
-	 fun make sel (Node r) = sel r
+         fun make sel (Node r) = sel r
       in
-	 val plist = make #plist
-	 val successors' = make #successors
-	 val successors = ! o successors'
+         val plist = make #plist
+         val successors' = make #successors
+         val successors = ! o successors'
       end
       val foreachSuccessor = fn (T {nodeP, edgeP, ...}, n, f) =>
-	 (Assert.assert("foreachSuccessor", fn () => nodeP n)
-	  ; List.foreach(successors n, fn e => if edgeP e then f e else ()))
+         (Assert.assert("DirectedSubGraph.Node.foreachSuccessor", fn () => nodeP n)
+          ; List.foreach(successors n, fn e => if edgeP e then f e else ()))
       val forallSuccessors = fn (T {nodeP, edgeP, ...}, n, f) =>
-	 (Assert.assert("forallSuccessors", fn () => nodeP n)
-	  ; List.forall(successors n, fn e => if edgeP e then f e else true))
+         (Assert.assert("DirectedSubGraph.Node.forallSuccessors", fn () => nodeP n)
+          ; List.forall(successors n, fn e => if edgeP e then f e else true))
       val existsSuccessor = fn (T {nodeP, edgeP, ...}, n, f) =>
-	 (Assert.assert("existsSuccessor", fn () => nodeP n)
-	  ; List.exists(successors n, fn e => if edgeP e then f e else false))
+         (Assert.assert("DirectedSubGraph.Node.existsSuccessor", fn () => nodeP n)
+          ; List.exists(successors n, fn e => if edgeP e then f e else false))
       val successors = fn (T {nodeP, edgeP, ...}, n) =>
-	 (Assert.assert("successors", fn () => nodeP n)
-	  ; List.keepAll(successors n, fn e => edgeP e))
+         (Assert.assert("DirectedSubGraph.Node.successors", fn () => nodeP n)
+          ; List.keepAll(successors n, fn e => edgeP e))
 
 
       fun new g = Node {successors = ref [],
-			plist = PropertyList.new ()}
+                        plist = PropertyList.new ()}
 
       fun equals (n, n') = PropertyList.equals (plist n, plist n')
 
       fun hasEdge (g as T {nodeP, edgeP, ...}, {from, to}) =
-	 if nodeP from andalso nodeP to
-	    then existsSuccessor (g, from, fn e =>
-				  equals (to, Edge.to (g, e)))
-	 else false
+         if nodeP from andalso nodeP to
+            then existsSuccessor (g, from, fn e =>
+                                  equals (to, Edge.to (g, e)))
+         else false
 
    (*       fun removeSuccessor (Node {successors, ...}, n) =
-    * 	 successors := List.removeFirst (!successors, fn Edge.Edge {to, ...} =>
-    * 					equals (n, to))
+    *    successors := List.removeFirst (!successors, fn Edge.Edge {to, ...} =>
+    *                                   equals (n, to))
     *)
    end
 
 structure DfsParam =
    struct
       type t = {startNode: Node.t -> unit,
-		finishNode: Node.t -> unit,
-		handleTreeEdge: Edge.t -> unit,
-		handleNonTreeEdge: Edge.t -> unit,
-		startTree: Node.t -> unit,
-		finishTree: Node.t -> unit,
-		finishDfs: unit -> unit}
-	 
+                finishNode: Node.t -> unit,
+                handleTreeEdge: Edge.t -> unit,
+                handleNonTreeEdge: Edge.t -> unit,
+                startTree: Node.t -> unit,
+                finishTree: Node.t -> unit,
+                finishDfs: unit -> unit}
+         
       fun ignore _ = ()
 
       fun finishNode f = {finishNode = f,
-			  startNode = ignore,
-			  handleTreeEdge = ignore,
-			  handleNonTreeEdge = ignore,
-			  startTree = ignore,
-			  finishTree = ignore,
-			  finishDfs = ignore}
+                          startNode = ignore,
+                          handleTreeEdge = ignore,
+                          handleNonTreeEdge = ignore,
+                          startTree = ignore,
+                          finishTree = ignore,
+                          finishDfs = ignore}
 
       fun startNode f = {finishNode = ignore,
-			 startNode = f,
-			 handleTreeEdge = ignore,
-			 handleNonTreeEdge = ignore,
-			 startTree = ignore,
-			 finishTree = ignore,
-			 finishDfs = ignore}
-	 
+                         startNode = f,
+                         handleTreeEdge = ignore,
+                         handleNonTreeEdge = ignore,
+                         startTree = ignore,
+                         finishTree = ignore,
+                         finishDfs = ignore}
+         
       fun seq f g a = (f a; g a)
-	 
+         
       fun combine ({startNode, finishNode,
-		    handleTreeEdge, handleNonTreeEdge,
-		    startTree, finishTree, finishDfs}: t,
-		   {startNode = sn, finishNode = fin,
-		    handleTreeEdge = ht, handleNonTreeEdge = hn,
-		    startTree = st, finishTree = ft, finishDfs = fd}: t): t =
-	 {startNode = seq startNode sn,
-	  finishNode = seq finishNode fin,
-	  handleTreeEdge = seq handleTreeEdge ht,
-	  handleNonTreeEdge = seq handleNonTreeEdge hn,
-	  startTree = seq startTree st,
-	  finishTree = seq finishTree ft,
-	  finishDfs = seq finishDfs fd}
+                    handleTreeEdge, handleNonTreeEdge,
+                    startTree, finishTree, finishDfs}: t,
+                   {startNode = sn, finishNode = fin,
+                    handleTreeEdge = ht, handleNonTreeEdge = hn,
+                    startTree = st, finishTree = ft, finishDfs = fd}: t): t =
+         {startNode = seq startNode sn,
+          finishNode = seq finishNode fin,
+          handleTreeEdge = seq handleTreeEdge ht,
+          handleNonTreeEdge = seq handleNonTreeEdge hn,
+          startTree = seq startTree st,
+          finishTree = seq finishTree ft,
+          finishDfs = seq finishDfs fd}
    end
 
 (*---------------------------------------------------*)
@@ -174,18 +175,18 @@
 (*--------------------------------------------------------*)
 
 fun subGraph (g as T {nodes, nodeP, edgeP, ...}, 
-	      {nodeP = nodeP', edgeP = edgeP'}) = 
+              {nodeP = nodeP', edgeP = edgeP'}) = 
    let
       val nodeP = fn n => if nodeP n then nodeP' n else false
       val edgeP = fn e => if edgeP e then edgeP' e else false
       val _ =
-	 Assert.assert
-	 ("subGraph", fn () => 
-	  List.forall(!nodes, fn n => 
-		      if nodeP n
-			 then Node.forallSuccessors(g, n, fn e =>
-						    nodeP (Edge.to (g, e)))
-		      else true))
+         Assert.assert
+         ("DirectedSubGraph.subGraph", fn () => 
+          List.forall(!nodes, fn n => 
+                      if nodeP n
+                         then Node.forallSuccessors(g, n, fn e =>
+                                                    nodeP (Edge.to (g, e)))
+                      else true))
    in 
       T {nodes = nodes, nodeP = nodeP, edgeP = edgeP}
    end
@@ -204,7 +205,7 @@
    end
 
 fun addEdge (g as T {nodeP, ...}, e as {from, to}) =
-   let val _ = Assert.assert("addEdge", fn () => nodeP from andalso nodeP to)
+   let val _ = Assert.assert("DirectedSubGraph.addEdge", fn () => nodeP from andalso nodeP to)
        val e = Edge.new (g, e)
    in
       List.push (Node.successors' from, e)
@@ -214,29 +215,29 @@
 (*fun removeEdge (_, {from, to}) = Node.removeSuccessor (from, to) *)
 
 fun layoutDot (g, {edgeOptions: Edge.t -> Dot.EdgeOption.t list,
-		   nodeOptions: Node.t -> Dot.NodeOption.t list,
-		   options,
-		   title}): Layout.t =
+                   nodeOptions: Node.t -> Dot.NodeOption.t list,
+                   options,
+                   title}): Layout.t =
    let
       val c = Counter.new 0
       val {get = nodeId, destroy, ...} =
-	 Property.destGet
-	 (Node.plist,
-	  Property.initFun
-	  (fn _ => concat ["n", Int.toString (Counter.next c)]))
+         Property.destGet
+         (Node.plist,
+          Property.initFun
+          (fn _ => concat ["n", Int.toString (Counter.next c)]))
       val nodes =
-	 List.revMap
-	 (nodes g,
-	  fn n => {name = nodeId n,
-		   options = nodeOptions n,
-		   successors = List.revMap
-		                (Node.successors (g, n), fn e =>
-				 {name = nodeId (Edge.to (g, e)),
-				  options = edgeOptions e})})
+         List.revMap
+         (nodes g,
+          fn n => {name = nodeId n,
+                   options = nodeOptions n,
+                   successors = List.revMap
+                                (Node.successors (g, n), fn e =>
+                                 {name = nodeId (Edge.to (g, e)),
+                                  options = edgeOptions e})})
       val res = 
-	 Dot.layout {nodes = nodes,
-		     options = options,
-		     title = title}
+         Dot.layout {nodes = nodes,
+                     options = options,
+                     title = title}
       val _ = destroy ()
    in
       res
@@ -247,28 +248,28 @@
 (*--------------------------------------------------------*)
 
 fun dfsNodes (g as T {nodeP, ...}, ns, 
-	      {startNode, finishNode,
-	       handleTreeEdge, handleNonTreeEdge,
-	       startTree, finishTree, finishDfs}) =
+              {startNode, finishNode,
+               handleTreeEdge, handleNonTreeEdge,
+               startTree, finishTree, finishDfs}) =
    let
       val {get = hasBeenVisited, set = setVisited, destroy, ...} =
-	 Property.destGetSet (Node.plist, Property.initConst false)
+         Property.destGetSet (Node.plist, Property.initConst false)
       fun visit n =
-	 (Assert.assert("dfsNodes", fn () => nodeP n)
-	  ; startNode n
-	  ; setVisited (n, true)
-	  ; Node.foreachSuccessor (g, n, fn e =>
-				   let val n' = Edge.to (g, e)
-				   in if hasBeenVisited n'
-					 then handleNonTreeEdge e
-				      else (visit n'; handleTreeEdge e)
-				   end)
-	  ; finishNode n)
+         (Assert.assert("DirectedSubGraph.dfsNodes", fn () => nodeP n)
+          ; startNode n
+          ; setVisited (n, true)
+          ; Node.foreachSuccessor (g, n, fn e =>
+                                   let val n' = Edge.to (g, e)
+                                   in if hasBeenVisited n'
+                                         then handleNonTreeEdge e
+                                      else (visit n'; handleTreeEdge e)
+                                   end)
+          ; finishNode n)
    in List.foreach (ns, fn n =>
-		    (Assert.assert("dfsNodes", fn () => nodeP n)
-		     ; if hasBeenVisited n
-			  then ()
-		       else (startTree n; visit n; finishTree n)))
+                    (Assert.assert("DirectedSubGraph.dfsNodes", fn () => nodeP n)
+                     ; if hasBeenVisited n
+                          then ()
+                       else (startTree n; visit n; finishTree n)))
       ; destroy ()
       ; finishDfs ()
    end
@@ -277,14 +278,14 @@
 
 fun display {graph, layoutNode, display} =
    dfs (graph,
-	DfsParam.startNode
-	(fn n =>
-	 display let open Layout
-		 in seq [layoutNode n,
-			 str " ",
-			 list (List.revMap (Node.successors (graph, n),
-					    fn e => layoutNode (Edge.to (graph, e))))]
-		 end))
+        DfsParam.startNode
+        (fn n =>
+         display let open Layout
+                 in seq [layoutNode n,
+                         str " ",
+                         list (List.revMap (Node.successors (graph, n),
+                                            fn e => layoutNode (Edge.to (graph, e))))]
+                 end))
 
 fun foreachDescendent (g, n, f) =
    dfsNodes (g, [n], DfsParam.finishNode f)
@@ -293,24 +294,24 @@
  *    let
  *       val discoverTime = Counter.new 0
  *       val {get, destroy, ...} =
- * 	 Property.newDest
- * 	 (Node.plist, Property.initFun (fn _ => {time = Counter.next discoverTime,
- * 						alive = ref true}))
+ *       Property.newDest
+ *       (Node.plist, Property.initFun (fn _ => {time = Counter.next discoverTime,
+ *                                              alive = ref true}))
  *       val ignore = DfsParam.ignore
  *    in dfs
  *       (g, {startNode = fn n => (get n; ()),
- * 	   finishNode = fn n => #alive (get n) := false,
- * 	   handleNonTreeEdge =
- * 	   fn e as Edge.Edge {from, to, ...} =>
- * 	   let val {alive, time} = get to
- * 	   in if !alive andalso time < #time (get from)
- * 		 then removeEdge (g, e)
- * 	      else ()
- * 	   end,
- * 	   handleTreeEdge = ignore,
- * 	   startTree = ignore,
- * 	   finishTree = ignore,
- * 	   finishDfs = ignore})
+ *         finishNode = fn n => #alive (get n) := false,
+ *         handleNonTreeEdge =
+ *         fn e as Edge.Edge {from, to, ...} =>
+ *         let val {alive, time} = get to
+ *         in if !alive andalso time < #time (get from)
+ *               then removeEdge (g, e)
+ *            else ()
+ *         end,
+ *         handleTreeEdge = ignore,
+ *         startTree = ignore,
+ *         finishTree = ignore,
+ *         finishDfs = ignore})
  *    end
  *)
 
@@ -321,21 +322,21 @@
 fun discoverFinishTimes g =
    let val time: int ref = ref 0
       val {get = discover, set = setDiscover, destroy = destroyDiscover, ...} =
-	 Property.destGetSetOnce (Node.plist,
-				  Property.initRaise ("discover", Node.layout))
+         Property.destGetSetOnce (Node.plist,
+                                  Property.initRaise ("discover", Node.layout))
       val {get = finish, set = setFinish, destroy = destroyFinish, ...} =
-	 Property.destGetSetOnce (Node.plist,
-				  Property.initRaise ("finish", Node.layout))
+         Property.destGetSetOnce (Node.plist,
+                                  Property.initRaise ("finish", Node.layout))
    in {destroy = fn () => (destroyDiscover (); destroyFinish ()),
        discover = discover,
        finish = finish,
        param = {startNode = fn n => (Int.inc time; setDiscover (n, !time)),
-		finishNode = fn n => (Int.inc time; setFinish (n, !time)),
-		handleTreeEdge = DfsParam.ignore,
-		handleNonTreeEdge = DfsParam.ignore,
-		startTree = DfsParam.ignore,
-		finishTree = DfsParam.ignore,
-		finishDfs = DfsParam.ignore}}
+                finishNode = fn n => (Int.inc time; setFinish (n, !time)),
+                handleTreeEdge = DfsParam.ignore,
+                handleNonTreeEdge = DfsParam.ignore,
+                startTree = DfsParam.ignore,
+                finishTree = DfsParam.ignore,
+                finishDfs = DfsParam.ignore}}
    end
 
 (*--------------------------------------------------------*)
@@ -347,28 +348,28 @@
 fun random {numNodes,numEdges} =
    let val max = maxNumEdges numNodes
    in if numNodes < 0 orelse numEdges < 0 orelse numEdges > max
-	 then Error.error "random"
+         then Error.error "random"
       else let val g = new ()
-	       val needed = ref numEdges
-	       val remaining = ref max
-	       fun maybeAddEdge (n,n') =
-		  (if Int.random (1, !remaining) <= !needed
-		      then (addEdge (g, Node.fromInt n, Node.fromInt n')
-			 ; IntRef.dec needed)
-		   else ()
-		      ; IntRef.dec remaining)
-	       val minNode = 0
-	       val maxNode = numNodes - 1
-	       fun directed n =
-		  Int.foreach (0, maxNode, fn n' =>
-			      if n = n' then () else maybeAddEdge (n,n'))
-	       fun undirected n =
-		  Int.foreach (n + 1, maxNode, fn n' => maybeAddEdge (n,n'))
-	       val addEdges = if isDirected then directed
-			      else undirected
-	   in Int.foreach (minNode, maxNode, addEdges)
-	      ; g
-	   end
+               val needed = ref numEdges
+               val remaining = ref max
+               fun maybeAddEdge (n,n') =
+                  (if Int.random (1, !remaining) <= !needed
+                      then (addEdge (g, Node.fromInt n, Node.fromInt n')
+                         ; IntRef.dec needed)
+                   else ()
+                      ; IntRef.dec remaining)
+               val minNode = 0
+               val maxNode = numNodes - 1
+               fun directed n =
+                  Int.foreach (0, maxNode, fn n' =>
+                              if n = n' then () else maybeAddEdge (n,n'))
+               fun undirected n =
+                  Int.foreach (n + 1, maxNode, fn n' => maybeAddEdge (n,n'))
+               val addEdges = if isDirected then directed
+                              else undirected
+           in Int.foreach (minNode, maxNode, addEdges)
+              ; g
+           end
    end
 *)
 (*--------------------------------------------------------*)
@@ -380,21 +381,21 @@
       nodeInfo (g, fn _ => false)
       val cycle = ref false
    in (cycle, {startNode = fn n => setActive (n, true),
-	       finishNode = fn n => setActive (n, false),
-	       handleNonTreeEdge =
-	       fn (n, e) => let val n' = Edge.otherNode (e,n)
-			   in if isActive n' then cycle := true
-			      else ()
-			   end,
-			handleTreeEdge = DfsParam.ignore,
-			startTree = DfsParam.ignore,
-			finishTree = DfsParam.ignore,
-			finishDfs = DfsParam.ignore})
+               finishNode = fn n => setActive (n, false),
+               handleNonTreeEdge =
+               fn (n, e) => let val n' = Edge.otherNode (e,n)
+                           in if isActive n' then cycle := true
+                              else ()
+                           end,
+                        handleTreeEdge = DfsParam.ignore,
+                        startTree = DfsParam.ignore,
+                        finishTree = DfsParam.ignore,
+                        finishDfs = DfsParam.ignore})
    end
 
 fun isCyclic g = let val (cycle, p) = cycleParam g
-		 in dfs (g, p); !cycle
-		 end
+                 in dfs (g, p); !cycle
+                 end
 *)
 
 (*--------------------------------------------------------*)
@@ -406,22 +407,22 @@
 fun topSortParam g =
    let
       val {get = amVisiting, set = setVisiting, destroy, ...} =
-	 Property.destGetSet (Node.plist,
-			     Property.initRaise ("visiting", Node.layout))
+         Property.destGetSet (Node.plist,
+                             Property.initRaise ("visiting", Node.layout))
       val ns = ref []
    in (ns, {startNode = fn n => amVisiting n := true,
-	    finishNode = fn n => (amVisiting n := false; List.push (ns,n)),
-	    handleNonTreeEdge = fn e => if !(amVisiting(Edge.to (g, e)))
-					   then raise TopologicalSort
-					else (),
-	    startTree = DfsParam.ignore, finishTree = DfsParam.ignore,
-	    handleTreeEdge = DfsParam.ignore,
-	    finishDfs = destroy})
+            finishNode = fn n => (amVisiting n := false; List.push (ns,n)),
+            handleNonTreeEdge = fn e => if !(amVisiting(Edge.to (g, e)))
+                                           then raise TopologicalSort
+                                        else (),
+            startTree = DfsParam.ignore, finishTree = DfsParam.ignore,
+            handleTreeEdge = DfsParam.ignore,
+            finishDfs = destroy})
    end
 
 fun topologicalSort g = let val (ns, p) = topSortParam g
-			in dfs (g, p); !ns
-			end
+                        in dfs (g, p); !ns
+                        end
 
 (*--------------------------------------------------------*)
 (*                       Transpose                        *)
@@ -430,18 +431,18 @@
 fun transposeParam g =
    let val gt = new ()
       fun handleEdge (n, e) = let val n' = Edge.otherNode (e,n)
-			    in addEdge (gt,n',n); ()
-			    end
+                            in addEdge (gt,n',n); ()
+                            end
    in (gt, {handleTreeEdge = handleEdge,
-	    handleNonTreeEdge = handleEdge,
-	    finishDfs = DfsParam.ignore,
-	    startNode = DfsParam.ignore, finishNode = DfsParam.ignore,
-	    startTree = DfsParam.ignore, finishTree = DfsParam.ignore})
+            handleNonTreeEdge = handleEdge,
+            finishDfs = DfsParam.ignore,
+            startNode = DfsParam.ignore, finishNode = DfsParam.ignore,
+            startTree = DfsParam.ignore, finishTree = DfsParam.ignore})
    end
 
 fun transpose g = let val (gt, p) = transposeParam g
-		  in dfs (g, p); gt
-		  end
+                  in dfs (g, p); gt
+                  end
   *) 
 (*--------------------------------------------------------*)
 (*             Strongly Connected Components              *)
@@ -460,12 +461,12 @@
       fun startTree _ = component := []
       fun finishTree _ = List.push (components, !component)
       val pt = {startNode = startNode,
-		   startTree = startTree,
-		   finishTree = finishTree,
-		   finishNode = DfsParam.ignore,
-		   finishDfs = DfsParam.ignore,
-		   handleTreeEdge = DfsParam.ignore,
-		   handleNonTreeEdge = DfsParam.ignore}
+                   startTree = startTree,
+                   finishTree = finishTree,
+                   finishNode = DfsParam.ignore,
+                   finishDfs = DfsParam.ignore,
+                   handleTreeEdge = DfsParam.ignore,
+                   handleNonTreeEdge = DfsParam.ignore}
    in dfs (g, P.combine (p, p'))
       ; dfsNodes (gt, !ns, pt)
       ; !components
@@ -477,54 +478,54 @@
 fun stronglyConnectedComponents g =
    let
       val {get = discover: Node.t -> int, set = setDiscover,
-	   destroy = destroyDiscover, ...} =
-	 Property.destGetSetOnce (Node.plist,
-				 Property.initRaise ("discover", Node.layout))
+           destroy = destroyDiscover, ...} =
+         Property.destGetSetOnce (Node.plist,
+                                 Property.initRaise ("discover", Node.layout))
       val {get = low: Node.t -> int ref, destroy = destroyLow, ...} =
-	 Property.destGet (Node.plist, Property.initFun (fn _ => ref ~1))
+         Property.destGet (Node.plist, Property.initFun (fn _ => ref ~1))
       val {get = isOnStack: Node.t -> bool, set = setOnStack,
-	   destroy = destroyStack, ...} =
-	 Property.destGetSet (Node.plist,
-			     Property.initRaise ("isOnStack", Node.layout))
+           destroy = destroyStack, ...} =
+         Property.destGetSet (Node.plist,
+                             Property.initRaise ("isOnStack", Node.layout))
       val stack = ref []
       val components = ref []
       val time = ref 0
       fun pop () = let val n = List.pop stack
-		   in setOnStack (n, false); n
-		   end
+                   in setOnStack (n, false); n
+                   end
       fun popTo n = let fun popTo () = let val n' = pop ()
-				       in if Node.equals (n,n') then [n]
-					  else n' :: (popTo ())
-				       end
-		    in popTo ()
-		    end
+                                       in if Node.equals (n,n') then [n]
+                                          else n' :: (popTo ())
+                                       end
+                    in popTo ()
+                    end
       fun startNode n = (Int.inc time
-			 ; setDiscover (n, !time)
-			 ; low n := !time
-			 ; setOnStack (n, true)
-			 ; List.push (stack, n))
+                         ; setDiscover (n, !time)
+                         ; low n := !time
+                         ; setOnStack (n, true)
+                         ; List.push (stack, n))
       fun finishNode n = if discover n = ! (low n)
-			     then List.push (components, popTo n)
-			 else ()
+                             then List.push (components, popTo n)
+                         else ()
       fun updateLow e =
-	 let val from = Edge.from (g, e)
-	     val to = Edge.to (g, e)
-	     val lto = low to
-	     val lfrom = low from
-	 in if !lto < !lfrom
-	       then lfrom := !lto
-	    else ()
-	 end
+         let val from = Edge.from (g, e)
+             val to = Edge.to (g, e)
+             val lto = low to
+             val lfrom = low from
+         in if !lto < !lfrom
+               then lfrom := !lto
+            else ()
+         end
       val handleTreeEdge = updateLow
       fun handleNonTreeEdge e = 
-	 if isOnStack (Edge.to (g, e))
-	    then updateLow e
-	 else ()
+         if isOnStack (Edge.to (g, e))
+            then updateLow e
+         else ()
       val p = {startNode = startNode, finishNode = finishNode,
-	       handleTreeEdge = handleTreeEdge,
-	       handleNonTreeEdge = handleNonTreeEdge,
-	       startTree = DfsParam.ignore, finishTree = DfsParam.ignore,
-	       finishDfs = DfsParam.ignore}
+               handleTreeEdge = handleTreeEdge,
+               handleNonTreeEdge = handleNonTreeEdge,
+               startTree = DfsParam.ignore, finishTree = DfsParam.ignore,
+               finishDfs = DfsParam.ignore}
    in dfs (g, p)
       ; destroyLow ()
       ; destroyStack ()
@@ -543,39 +544,39 @@
 structure NodeInfo =
    struct
       type t = {ancestor: Node.t ref,
-		bucket: Node.t list ref,
-		child: Node.t ref,
-		dfn: int ref, (* depth first number *)
-		idom: Node.t ref,
-		label: Node.t ref,
-		parent: Node.t ref,
-		preds: Node.t list ref,
-		sdno: int ref, (* semidominator dfn *)
-		size: int ref}
+                bucket: Node.t list ref,
+                child: Node.t ref,
+                dfn: int ref, (* depth first number *)
+                idom: Node.t ref,
+                label: Node.t ref,
+                parent: Node.t ref,
+                preds: Node.t list ref,
+                sdno: int ref, (* semidominator dfn *)
+                size: int ref}
    end
 
 fun validDominators (graph,
-		     {root: Node.t,
-		      idom: Node.t -> Node.t}): bool =
+                     {root: Node.t,
+                      idom: Node.t -> Node.t}): bool =
    (* Check for each edge v --> w that idom w dominates v.
     * FIXME: It should first check that idom describes a tree rooted at root.
     *)
-   DynamicWind.withEscape
+   Exn.withEscape
    (fn escape =>
     let
        fun dominates (a: Node.t, b: Node.t): bool =
-	  let
-	     fun loop b =
-		Node.equals (a, b)
-		orelse (not (Node.equals (b, root))
-			andalso loop (idom b))
-	  in loop b
-	  end
+          let
+             fun loop b =
+                Node.equals (a, b)
+                orelse (not (Node.equals (b, root))
+                        andalso loop (idom b))
+          in loop b
+          end
        val _ =
-	  foreachEdge (graph, fn (_, Edge.Edge {from, to, ...}) =>
-		       if dominates (idom to, from)
-			  then ()
-		       else escape false)
+          foreachEdge (graph, fn (_, Edge.Edge {from, to, ...}) =>
+                       if dominates (idom to, from)
+                          then ()
+                       else escape false)
     in true
     end)
 
@@ -583,32 +584,32 @@
    let
       val n0 = Node.new ()
       fun newNode (n: Node.t): NodeInfo.t =
-	 {ancestor = ref n0,
-	  bucket = ref [],
-	  child = ref n0,
-	  dfn = ref ~1,
-	  idom = ref n0,
-	  label = ref n,
-	  parent = ref n0,
-	  preds = ref [],
-	  sdno = ref ~1,
-	  size = ref 1}
+         {ancestor = ref n0,
+          bucket = ref [],
+          child = ref n0,
+          dfn = ref ~1,
+          idom = ref n0,
+          label = ref n,
+          parent = ref n0,
+          preds = ref [],
+          sdno = ref ~1,
+          size = ref 1}
       val {get = nodeInfo: Node.t -> NodeInfo.t, ...} =
-	 Property.get (Node.plist, Property.initFun newNode)
+         Property.get (Node.plist, Property.initFun newNode)
       local
-	 fun 'a make (sel: NodeInfo.t -> 'a ref) =
-	    (sel o nodeInfo, ! o sel o nodeInfo)
+         fun 'a make (sel: NodeInfo.t -> 'a ref) =
+            (sel o nodeInfo, ! o sel o nodeInfo)
       in
-	 val (ancestor', ancestor) = make #ancestor
-	 val (bucket', bucket) = make #bucket
-	 val (child', child) = make #child
-	 val (dfn', dfn) = make #dfn
-	 val (idom', idom) = make #idom
-	 val (label', label) = make #label
-	 val (parent', parent) = make #parent
-	 val (preds', preds) = make #preds
-	 val (sdno', sdno) = make #sdno
-	 val (size', size) = make #size
+         val (ancestor', ancestor) = make #ancestor
+         val (bucket', bucket) = make #bucket
+         val (child', child) = make #child
+         val (dfn', dfn) = make #dfn
+         val (idom', idom) = make #idom
+         val (label', label) = make #label
+         val (parent', parent) = make #parent
+         val (preds', preds) = make #preds
+         val (sdno', sdno) = make #sdno
+         val (size', size) = make #size
       end
       val _ = size' n0 := 0
       (* nodes is an array of nodes indexed by dfs number. *)
@@ -617,138 +618,138 @@
       fun ndfs i = Array.sub (nodes, i)
       val dfnCounter = ref 0
       fun dfs (v: Node.t): unit =
-	 let
-	    val i = !dfnCounter
-	    val _ = Int.inc dfnCounter
-	    val _ = dfn' v := i
-	    val _ = sdno' v := i
-	    val _ = Array.update (nodes, i, v)
-	    val _ =
-	       Node.foreachSuccessor 
-	       (graph, v, fn e =>
-		let
-		   val w = Edge.to (graph, e)
-		   val _ = List.push (preds' w, v)
-		in if sdno w = ~1
-		      then (parent' w := v
-			    ; dfs w)
-		   else ()
-		end)
-	 in ()
-	 end
+         let
+            val i = !dfnCounter
+            val _ = Int.inc dfnCounter
+            val _ = dfn' v := i
+            val _ = sdno' v := i
+            val _ = Array.update (nodes, i, v)
+            val _ =
+               Node.foreachSuccessor 
+               (graph, v, fn e =>
+                let
+                   val w = Edge.to (graph, e)
+                   val _ = List.push (preds' w, v)
+                in if sdno w = ~1
+                      then (parent' w := v
+                            ; dfs w)
+                   else ()
+                end)
+         in ()
+         end
       val _ = dfs root
       val _ =
-	 if !dfnCounter = numNodes
-	    then ()
-	 else Error.bug "dominators: graph is not connected"
+         if !dfnCounter = numNodes
+            then ()
+         else Error.bug "DirectedSubGraph.dominators: graph is not connected"
       (* compress ancestor path to node v to the node whose label has the
        * maximal (minimal?) semidominator number. 
        *)
       fun compress (v: Node.t): unit =
-	 if Node.equals (n0, ancestor (ancestor v))
-	    then ()
-	 else let
-		 val _ = compress (ancestor v)
-		 val _ =
-		    if sdno (label (ancestor v)) < sdno (label v)
-		       then label' v := label (ancestor v)
-		    else ()
-		 val _ = ancestor' v := ancestor (ancestor v)
-	      in ()
-	      end
+         if Node.equals (n0, ancestor (ancestor v))
+            then ()
+         else let
+                 val _ = compress (ancestor v)
+                 val _ =
+                    if sdno (label (ancestor v)) < sdno (label v)
+                       then label' v := label (ancestor v)
+                    else ()
+                 val _ = ancestor' v := ancestor (ancestor v)
+              in ()
+              end
       fun eval (v: Node.t): Node.t =
-	 (* Determine the ancestor of v whose semidominator has the minimal
-	  * depth-first number.
-	  *)
-	 if Node.equals (ancestor v, n0)
-	    then label v
-	 else let
-		 val _ = compress v
-	      in
-		 if sdno (label (ancestor v)) >= sdno (label v)
-		    then label v
-		 else label (ancestor v)
-	      end
+         (* Determine the ancestor of v whose semidominator has the minimal
+          * depth-first number.
+          *)
+         if Node.equals (ancestor v, n0)
+            then label v
+         else let
+                 val _ = compress v
+              in
+                 if sdno (label (ancestor v)) >= sdno (label v)
+                    then label v
+                 else label (ancestor v)
+              end
       fun link (v: Node.t, w: Node.t): unit =
-	 let
-	    fun loop s =
-	       if sdno (label w) < sdno (label (child s))
-		  then
-		     if size s + size (child (child s)) >= 2 * size (child s)
-			then (ancestor' (child s) := s
-			      ; child' s := child (child s)
-			      ; loop s)
-		     else (size' (child s) := size s
-			   ; ancestor' s := child s
-			   ; loop (child s))
-	       else s
-	    val s = loop w
-	    val _ = label' s := label w
-	    val _ = size' v := size v + size w
-	    val s =
-	       if size v < 2 * size w
-		  then
-		     let
-			val tmp = child v
-			val _ = child' v := s
-		     in tmp
-		     end
-	       else s
-	    fun loop s =
-	       if Node.equals (s, n0)
-		  then ()
-	       else (ancestor' s := v
-		     ; loop (child s))
-	    val _ = loop s
-	 in ()
-	 end
+         let
+            fun loop s =
+               if sdno (label w) < sdno (label (child s))
+                  then
+                     if size s + size (child (child s)) >= 2 * size (child s)
+                        then (ancestor' (child s) := s
+                              ; child' s := child (child s)
+                              ; loop s)
+                     else (size' (child s) := size s
+                           ; ancestor' s := child s
+                           ; loop (child s))
+               else s
+            val s = loop w
+            val _ = label' s := label w
+            val _ = size' v := size v + size w
+            val s =
+               if size v < 2 * size w
+                  then
+                     let
+                        val tmp = child v
+                        val _ = child' v := s
+                     in tmp
+                     end
+               else s
+            fun loop s =
+               if Node.equals (s, n0)
+                  then ()
+               else (ancestor' s := v
+                     ; loop (child s))
+            val _ = loop s
+         in ()
+         end
       val _ =
-	 Int.forDown
-	 (1, numNodes, fn i =>
-	  let
-	     (* Compute initial values for semidominators and store nodes with
-	      * the same semidominator in the same bucket.
-	      *)
-	     val w = ndfs i
-	     val min = List.fold (preds w, sdno w, fn (n, min) =>
-				  Int.min (min, sdno (eval n)))
-	     val _ = sdno' w := min
-	     val _ = List.push (bucket' (ndfs min), w)
-	     val _ = link (parent w, w)
-	     (* Compute immediate dominators for nodes in the bucket of w's
-	      * parent.
-	      *)
-	     val _ =
-		List.foreach
-		(bucket (parent w), fn v =>
-		 let
-		    val u = eval v
-		 in
-		    idom' v := (if sdno u < sdno v
-				   then u
-				else parent w)
-		 end)
-	     val _ = bucket' (parent w) := []
-	  in ()
-	  end)
+         Int.forDown
+         (1, numNodes, fn i =>
+          let
+             (* Compute initial values for semidominators and store nodes with
+              * the same semidominator in the same bucket.
+              *)
+             val w = ndfs i
+             val min = List.fold (preds w, sdno w, fn (n, min) =>
+                                  Int.min (min, sdno (eval n)))
+             val _ = sdno' w := min
+             val _ = List.push (bucket' (ndfs min), w)
+             val _ = link (parent w, w)
+             (* Compute immediate dominators for nodes in the bucket of w's
+              * parent.
+              *)
+             val _ =
+                List.foreach
+                (bucket (parent w), fn v =>
+                 let
+                    val u = eval v
+                 in
+                    idom' v := (if sdno u < sdno v
+                                   then u
+                                else parent w)
+                 end)
+             val _ = bucket' (parent w) := []
+          in ()
+          end)
       (* Adjust immediate dominators of nodes whose current version of the
        * immediate dominator differs from the node with the depth-first number
        * of the node's semidominator.
        *)
       val _ =
-	 Int.for
-	 (1, numNodes, fn i =>
-	  let
-	     val w = ndfs i
-	  in
-	     if Node.equals (idom w, ndfs (sdno w))
-		then ()
-	     else idom' w := idom (idom w)
-	  end)
+         Int.for
+         (1, numNodes, fn i =>
+          let
+             val w = ndfs i
+          in
+             if Node.equals (idom w, ndfs (sdno w))
+                then ()
+             else idom' w := idom (idom w)
+          end)
       val _ = idom' root := root
-      val _ = Assert.assert ("dominators", fn () =>
-			     validDominators (graph, {root = root,
-						      idom = idom}))
+      val _ = Assert.assert ("DirectedSubGraph.dominators", fn () =>
+                             validDominators (graph, {root = root,
+                                                      idom = idom}))
    in {idom = idom}
    end
 
@@ -756,21 +757,21 @@
    let
       val {idom} = dominators (graph, {root = root})
       val {get = nodeInfo, ...} =
-	 Property.get (Node.plist,
-		       Property.initFun (fn n => {children = ref [],
-						  value = nodeValue n}))
+         Property.get (Node.plist,
+                       Property.initFun (fn n => {children = ref [],
+                                                  value = nodeValue n}))
       val _ =
-	 foreachNode
-	 (graph, fn n => 
-	  if Node.equals (n, root)
-	     then ()
-	  else List.push (#children (nodeInfo (idom n)), n))
+         foreachNode
+         (graph, fn n => 
+          if Node.equals (n, root)
+             then ()
+          else List.push (#children (nodeInfo (idom n)), n))
       fun treeAt (n: Node.t): 'a Tree.t =
-	 let
-	    val {children, value} = nodeInfo n
-	 in
-	    Tree.T (value, Vector.fromListMap (!children, treeAt))
-	 end
+         let
+            val {children, value} = nodeInfo n
+         in
+            Tree.T (value, Vector.fromListMap (!children, treeAt))
+         end
    in
       treeAt root
    end
@@ -793,13 +794,13 @@
 structure ForestNodeInfo = 
   struct
     type t = {parent: Node.t option,
-	      loopNodes: Node.t list}
+              loopNodes: Node.t list}
   end
 
 structure SubGraphNodeInfo =
   struct
     type t = {childSubGraphNode: Node.t option ref,
-	      graphNode: Node.t}
+              graphNode: Node.t}
   end
 
 (* loopForest : {headers: (* graph *) Node.t list -> (* graph *) Node.t list,
@@ -840,31 +841,31 @@
       val addEdge = ignore o addEdge
 
       val {get = graphNodeInfo : Node.t -> GraphNodeInfo.t,
-	   set = setGraphNodeInfo, ...}
-	= Property.getSetOnce 
-	  (Node.plist, Property.initRaise ("graphNodeInfo", Node.layout))
+           set = setGraphNodeInfo, ...}
+        = Property.getSetOnce 
+          (Node.plist, Property.initRaise ("graphNodeInfo", Node.layout))
       val forestNode = #forestNode o graphNodeInfo
 
       val {get = forestNodeInfo : Node.t -> ForestNodeInfo.t,
-	   set = setForestNodeInfo, ...}
-	= Property.getSetOnce 
-	  (Node.plist, Property.initRaise ("forestNodeInfo", Node.layout))
+           set = setForestNodeInfo, ...}
+        = Property.getSetOnce 
+          (Node.plist, Property.initRaise ("forestNodeInfo", Node.layout))
       val parent = #parent o forestNodeInfo 
       val loopNodes = #loopNodes o forestNodeInfo
 
 
       val {get = nodeNesting: Node.t -> int list ref,
-	   destroy = destNodeNesting, ...}
-	= Property.destGet
-	  (Node.plist, Property.initFun (fn _ => ref []))
+           destroy = destNodeNesting, ...}
+        = Property.destGet
+          (Node.plist, Property.initFun (fn _ => ref []))
       val {get = edgeNesting: Edge.t -> int list ref,
-	   destroy = destEdgeNesting, ...}
-	= Property.destGet
-	  (Edge.plist, Property.initFun (fn _ => ref []))
+           destroy = destEdgeNesting, ...}
+        = Property.destGet
+          (Edge.plist, Property.initFun (fn _ => ref []))
 
       val {get = getIsHeader: Node.t -> bool ref, ...}
-	= Property.get
-	  (Node.plist, Property.initFun (fn _ => ref false))
+        = Property.get
+          (Node.plist, Property.initFun (fn _ => ref false))
 
 
       val F = new ()
@@ -872,90 +873,90 @@
 
       val depth = ref 0
       fun nodeP n = fn node => case !(nodeNesting node)
-				 of n'::_ => n' >= n
-				  | _ => false
+                                 of n'::_ => n' >= n
+                                  | _ => false
       fun edgeP n = fn edge => case !(edgeNesting edge)
-				 of n'::_ => n' >= n
-				  | _ => false
+                                 of n'::_ => n' >= n
+                                  | _ => false
 
 
       fun inducedGraph {graph, scc}
-	= let
-	    val depth = !depth
-	    val headers = headers scc
-	    val _ = List.foreach(headers, fn header => getIsHeader header := true)
-	  in
-	    List.foreach
-	    (scc,
-	     fn n => (List.push(nodeNesting n, depth) ;
-		      Node.foreachSuccessor
-		      (graph, n, 
-		       fn e => let
-				 val from = n
-				 val to = Edge.to (graph, e)
-			       in
-				 if List.contains(scc, to, Node.equals)
-				    andalso
-				    not (List.contains(headers, to, Node.equals))
-				   then List.push(edgeNesting e, depth)
-				   else ()
-			       end))) ;
-	    subGraph (supGraph graph, {nodeP = nodeP depth, edgeP = edgeP depth})
-	  end
+        = let
+            val depth = !depth
+            val headers = headers scc
+            val _ = List.foreach(headers, fn header => getIsHeader header := true)
+          in
+            List.foreach
+            (scc,
+             fn n => (List.push(nodeNesting n, depth) ;
+                      Node.foreachSuccessor
+                      (graph, n, 
+                       fn e => let
+                                 val from = n
+                                 val to = Edge.to (graph, e)
+                               in
+                                 if List.contains(scc, to, Node.equals)
+                                    andalso
+                                    not (List.contains(headers, to, Node.equals))
+                                   then List.push(edgeNesting e, depth)
+                                   else ()
+                               end))) ;
+            subGraph (supGraph graph, {nodeP = nodeP depth, edgeP = edgeP depth})
+          end
 
       fun nest {graph, parent}
-	= List.foreach
-	  (stronglyConnectedComponents graph,
-	   fn scc => let
-		       val n' = newNode F
-		       fun default ()
-			 = let
-			     val _ = setForestNodeInfo(n', {loopNodes = scc,
-							    parent = parent})
+        = List.foreach
+          (stronglyConnectedComponents graph,
+           fn scc => let
+                       val n' = newNode F
+                       fun default ()
+                         = let
+                             val _ = setForestNodeInfo(n', {loopNodes = scc,
+                                                            parent = parent})
 
-			     val _ = Int.inc depth
-			     val graph' = inducedGraph {graph = graph,
-							scc = scc}
-			     val _ = nest {graph = graph',
-					   parent = SOME n'}
-			     val _ = foreachNode
-			             (graph',
-				      fn n => (Node.foreachSuccessor
-					       (graph', n, 
-						fn e => ignore(List.pop(edgeNesting e)));
-					       ignore(List.pop(nodeNesting n))))
-			     val _ = Int.dec depth
-			   in
-			     ()
-			   end
+                             val _ = Int.inc depth
+                             val graph' = inducedGraph {graph = graph,
+                                                        scc = scc}
+                             val _ = nest {graph = graph',
+                                           parent = SOME n'}
+                             val _ = foreachNode
+                                     (graph',
+                                      fn n => (Node.foreachSuccessor
+                                               (graph', n, 
+                                                fn e => ignore(List.pop(edgeNesting e)));
+                                               ignore(List.pop(nodeNesting n))))
+                             val _ = Int.dec depth
+                           in
+                             ()
+                           end
 
-		       fun default' n
-			 = let
-			   in
-			      setForestNodeInfo (n', {loopNodes = [n], 
-						      parent = parent}) ;
-			      setGraphNodeInfo (n, {forestNode = n'})
-			   end
-		     in
-		       case parent
-			 of NONE => ()
-			  | SOME parent => addEdge (F, {from = parent, to = n'}) ;
-		       case scc
-			 of [n] => if Node.hasEdge (graph, {from = n, to = n})
-				     then default ()
-				     else default' n
-			  | scc => default ()
-		     end)
+                       fun default' n
+                         = let
+                           in
+                              setForestNodeInfo (n', {loopNodes = [n], 
+                                                      parent = parent}) ;
+                              setGraphNodeInfo (n, {forestNode = n'})
+                           end
+                     in
+                       case parent
+                         of NONE => ()
+                          | SOME parent => addEdge (F, {from = parent, to = n'}) ;
+                       case scc
+                         of [n] => if Node.hasEdge (graph, {from = n, to = n})
+                                     then default ()
+                                     else default' n
+                          | scc => default ()
+                     end)
 
 
       val depth = !depth
       val _ = foreachNode
-	      (graph,
-	       fn n => (List.push(nodeNesting n, depth) ;
-			Node.foreachSuccessor
-			(graph, n, fn e => List.push(edgeNesting e, depth))))
+              (graph,
+               fn n => (List.push(nodeNesting n, depth) ;
+                        Node.foreachSuccessor
+                        (graph, n, fn e => List.push(edgeNesting e, depth))))
       val graph' = subGraph (supGraph graph,
-			     {nodeP = nodeP depth, edgeP = edgeP depth})
+                             {nodeP = nodeP depth, edgeP = edgeP depth})
       val _ = nest {graph = graph', parent = NONE}
       val _ = destNodeNesting ()
       val _ = destEdgeNesting ()
@@ -974,27 +975,27 @@
       val addEdge = ignore o addEdge
 
       val {get = graphNodeInfo : Node.t -> GraphNodeInfo.t,
-	   set = setGraphNodeInfo, ...}
-	= Property.getSetOnce 
-	  (Node.plist, Property.initRaise ("graphNodeInfo", Node.layout))
+           set = setGraphNodeInfo, ...}
+        = Property.getSetOnce 
+          (Node.plist, Property.initRaise ("graphNodeInfo", Node.layout))
       val forestNode = #forestNode o graphNodeInfo
 
       val {get = getIsHeader : Node.t -> bool ref, 
-	   set = setIsHeader, ...}
-	= Property.getSetOnce
-	  (Node.plist, Property.initFun (fn _ => ref false))
+           set = setIsHeader, ...}
+        = Property.getSetOnce
+          (Node.plist, Property.initFun (fn _ => ref false))
 
       val {get = forestNodeInfo : Node.t -> ForestNodeInfo.t,
-	   set = setForestNodeInfo, ...}
-	= Property.getSetOnce 
-	  (Node.plist, Property.initRaise ("forestNodeInfo", Node.layout))
+           set = setForestNodeInfo, ...}
+        = Property.getSetOnce 
+          (Node.plist, Property.initRaise ("forestNodeInfo", Node.layout))
       val parent = #parent o forestNodeInfo 
       val loopNodes = #loopNodes o forestNodeInfo
 
       val {get = subGraphNodeInfo : Node.t -> SubGraphNodeInfo.t,
-	   set = setSubGraphNodeInfo, ...}
-	= Property.getSetOnce 
-	  (Node.plist, Property.initRaise ("subGraphNodeInfo", Node.layout))
+           set = setSubGraphNodeInfo, ...}
+        = Property.getSetOnce 
+          (Node.plist, Property.initRaise ("subGraphNodeInfo", Node.layout))
       val childSubGraphNode = #childSubGraphNode o subGraphNodeInfo
       val childSubGraphNode' = ! o childSubGraphNode
       val childSubGraphNode'' = valOf o childSubGraphNode'
@@ -1003,118 +1004,118 @@
       val F = new ()
 
       fun subGraph {graph,
-		    scc}
-	= let
-	    val scc' = List.map(scc, #graphNode o subGraphNodeInfo)
-	    val headers = headers scc'
-	    val _ = List.foreach
-	            (headers, fn header => getIsHeader header := true)
+                    scc}
+        = let
+            val scc' = List.map(scc, #graphNode o subGraphNodeInfo)
+            val headers = headers scc'
+            val _ = List.foreach
+                    (headers, fn header => getIsHeader header := true)
 
-	    val graph' = new ()
-	  in
-	    List.foreach
-	    (scc,
-	     fn n => let
-		       val n' = newNode graph'
-			 
-		       val {childSubGraphNode, graphNode, ...} 
-			 = subGraphNodeInfo n
-		     in
-		       childSubGraphNode := SOME n' ;
-		       setSubGraphNodeInfo
-		       (n', 
-			{childSubGraphNode = ref NONE,
-			 graphNode = graphNode})
-		     end) ;
-	    List.foreach
-	    (scc,
-	     fn n => Node.foreachSuccessor
-	             (graph, n, fn e =>
-		      let 
-			 val from = n
-			 val to = Edge.to (graph, e)
-		      in
-			 if List.contains
-			    (scc, to, Node.equals)
-			    andalso
-			    not (List.contains
-				 (headers, graphNode to, Node.equals))
-			    then let
-				    val from' = childSubGraphNode'' from
-				    val to' = childSubGraphNode'' to
-				 in
-				    addEdge (graph', {from = from', to = to'})
-				 end
-			 else ()
-		      end)) ;
-	    graph'
-	  end
+            val graph' = new ()
+          in
+            List.foreach
+            (scc,
+             fn n => let
+                       val n' = newNode graph'
+                         
+                       val {childSubGraphNode, graphNode, ...} 
+                         = subGraphNodeInfo n
+                     in
+                       childSubGraphNode := SOME n' ;
+                       setSubGraphNodeInfo
+                       (n', 
+                        {childSubGraphNode = ref NONE,
+                         graphNode = graphNode})
+                     end) ;
+            List.foreach
+            (scc,
+             fn n => Node.foreachSuccessor
+                     (graph, n, fn e =>
+                      let 
+                         val from = n
+                         val to = Edge.to (graph, e)
+                      in
+                         if List.contains
+                            (scc, to, Node.equals)
+                            andalso
+                            not (List.contains
+                                 (headers, graphNode to, Node.equals))
+                            then let
+                                    val from' = childSubGraphNode'' from
+                                    val to' = childSubGraphNode'' to
+                                 in
+                                    addEdge (graph', {from = from', to = to'})
+                                 end
+                         else ()
+                      end)) ;
+            graph'
+          end
 
       fun nest {graph, parent}
-	= List.foreach
-	  (stronglyConnectedComponents graph,
-	   fn scc => let
-		       val scc' = List.map(scc, graphNode)
-		       val n' = newNode F
-		       fun default ()
-			 = let
-			     val graph' = subGraph {graph = graph,
-						    scc = scc}
-			   in
-			     setForestNodeInfo(n', {loopNodes = scc',
-						    parent = parent}) ;
-			     nest {graph = graph',
-				   parent = SOME n'}
-			   end
+        = List.foreach
+          (stronglyConnectedComponents graph,
+           fn scc => let
+                       val scc' = List.map(scc, graphNode)
+                       val n' = newNode F
+                       fun default ()
+                         = let
+                             val graph' = subGraph {graph = graph,
+                                                    scc = scc}
+                           in
+                             setForestNodeInfo(n', {loopNodes = scc',
+                                                    parent = parent}) ;
+                             nest {graph = graph',
+                                   parent = SOME n'}
+                           end
 
-		       fun default' n
-			 = let
-			   in
-			      setForestNodeInfo (n', {loopNodes = [graphNode n], 
-						      parent = parent}) ;
-			      setGraphNodeInfo (graphNode n, {forestNode = n'})
-			   end
-		     in
-		       case parent
-			 of NONE => ()
-			  | SOME parent => addEdge (F, {from = parent, to = n'}) ;
-		       case scc
-			 of [n] => if Node.hasEdge (graph, {from = n, to = n})
-				     then default ()
-				     else default' n
-			  | scc => default ()
-		     end)
+                       fun default' n
+                         = let
+                           in
+                              setForestNodeInfo (n', {loopNodes = [graphNode n], 
+                                                      parent = parent}) ;
+                              setGraphNodeInfo (graphNode n, {forestNode = n'})
+                           end
+                     in
+                       case parent
+                         of NONE => ()
+                          | SOME parent => addEdge (F, {from = parent, to = n'}) ;
+                       case scc
+                         of [n] => if Node.hasEdge (graph, {from = n, to = n})
+                                     then default ()
+                                     else default' n
+                          | scc => default ()
+                     end)
 
       val graph' 
-	= let
-	    val graph' = new ()
-	    val {get = nodeInfo': Node.t -> Node.t,
-		 destroy}
-	      = Property.destGet
-	        (Node.plist,
-		 Property.initFun (fn node => let
-						val node' = newNode graph'
-					      in 
-						setSubGraphNodeInfo
-						(node', 
-						 {childSubGraphNode = ref NONE,
-						  graphNode = node}) ; 
-						node'
-					      end))
-	  in
-	    foreachEdge
-	    (graph,
-	     fn (n, e) => let
-			    val from = n
-			    val from' = nodeInfo' from
-			    val to = Edge.to (graph, e)
-			    val to' = nodeInfo' to
-			  in
-			    addEdge(graph', {from = from', to = to'})
-			  end) ;
-	    destroy () ;
-	    graph'
-	  end
+        = let
+            val graph' = new ()
+            val {get = nodeInfo': Node.t -> Node.t,
+                 destroy}
+              = Property.destGet
+                (Node.plist,
+                 Property.initFun (fn node => let
+                                                val node' = newNode graph'
+                                              in 
+                                                setSubGraphNodeInfo
+                                                (node', 
+                                                 {childSubGraphNode = ref NONE,
+                                                  graphNode = node}) ; 
+                                                node'
+                                              end))
+          in
+            foreachEdge
+            (graph,
+             fn (n, e) => let
+                            val from = n
+                            val from' = nodeInfo' from
+                            val to = Edge.to (graph, e)
+                            val to' = nodeInfo' to
+                          in
+                            addEdge(graph', {from = from', to = to'})
+                          end) ;
+            destroy () ;
+            graph'
+          end
 
       val _ = nest {graph = graph', parent = NONE}
     in
@@ -1129,49 +1130,49 @@
 fun loopForestSteensgaard {graph, root}
   = let
       fun headers X
-	= let
-	    val headers = ref []
-	  in
-	    foreachEdge
-	    (graph, fn (n, e) => let 
-				   val from = Edge.from (graph, e)
-				   val to = Edge.to (graph, e)
-				 in
-				   if List.contains(X, to, Node.equals)
-				      andalso
-				      not (List.contains(X, from, Node.equals))
-				      then List.push(headers, to)
-				   else ()
-				 end) ;
-	    List.removeDuplicates(!headers, Node.equals)
-	  end
+        = let
+            val headers = ref []
+          in
+            foreachEdge
+            (graph, fn (n, e) => let 
+                                   val from = Edge.from (graph, e)
+                                   val to = Edge.to (graph, e)
+                                 in
+                                   if List.contains(X, to, Node.equals)
+                                      andalso
+                                      not (List.contains(X, from, Node.equals))
+                                      then List.push(headers, to)
+                                   else ()
+                                 end) ;
+            List.removeDuplicates(!headers, Node.equals)
+          end
 (*
       fun headers X
-	= List.keepAll
-	  (X,
-	   fn node 
-	    => DynamicWind.withEscape
-	       (fn escape
-		 => (foreachEdge
-		     (graph,
-		      fn (n, e) => let
-				     val from = n
-				     val to = Edge.to (graph, e)
-				   in
-				     if Node.equals(node, to)
-				        andalso
-					List.contains(X, to, Node.equals)
-				        andalso
-					not (List.contains(X, from, Node.equals))
-				       then escape true
-				       else ()
-				   end);
-		     false)))
+        = List.keepAll
+          (X,
+           fn node 
+            => Exn.withEscape
+               (fn escape
+                 => (foreachEdge
+                     (graph,
+                      fn (n, e) => let
+                                     val from = n
+                                     val to = Edge.to (graph, e)
+                                   in
+                                     if Node.equals(node, to)
+                                        andalso
+                                        List.contains(X, to, Node.equals)
+                                        andalso
+                                        not (List.contains(X, from, Node.equals))
+                                       then escape true
+                                       else ()
+                                   end);
+                     false)))
 *)
     in
       loopForest {headers = headers,
-		  graph = graph,
-		  root = root}
+                  graph = graph,
+                  root = root}
     end
 
 end

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/dot-color.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/dot-color.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/dot-color.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,14 +1,15 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 structure DotColor =
    struct
       datatype t =
-	 (* (Hue, Saturation, Brightness).  All between 0 and 1. *)
-	 HSB of real * real * real
+         (* (Hue, Saturation, Brightness).  All between 0 and 1. *)
+         HSB of real * real * real
        | Aliceblue
        | Antiquewhite1 | Antiquewhite2 | Antiquewhite3 | Antiquewhite4
        | Aquamarine1 | Aquamarine2 | Aquamarine3 | Aquamarine4
@@ -157,485 +158,485 @@
 
 
       val grays =
-	 Vector.fromList
-	 [Gray0, Gray1, Gray2, Gray3, Gray4, Gray5, Gray6, Gray7, Gray8, Gray9, Gray10, Gray11, Gray12, Gray13, Gray14, Gray15, Gray16, Gray17, Gray18, Gray19, Gray20, Gray21, Gray22, Gray23, Gray24, Gray25, Gray26, Gray27, Gray28, Gray29, Gray30, Gray31, Gray32, Gray33, Gray34, Gray35, Gray36, Gray37, Gray38, Gray39, Gray40, Gray41, Gray42, Gray43, Gray44, Gray45, Gray46, Gray47, Gray48, Gray49, Gray50, Gray51, Gray52, Gray53, Gray54, Gray55, Gray56, Gray57, Gray58, Gray59, Gray60, Gray61, Gray62, Gray63, Gray64, Gray65, Gray66, Gray67, Gray68, Gray69, Gray70, Gray71, Gray72, Gray73, Gray74, Gray75, Gray76, Gray77, Gray78, Gray79, Gray80, Gray81, Gray82, Gray83, Gray84, Gray85, Gray86, Gray87, Gray88, Gray89, Gray90, Gray91, Gray92, Gray93, Gray94, Gray95, Gray96, Gray97, Gray98, Gray99, Gray100]
+         Vector.fromList
+         [Gray0, Gray1, Gray2, Gray3, Gray4, Gray5, Gray6, Gray7, Gray8, Gray9, Gray10, Gray11, Gray12, Gray13, Gray14, Gray15, Gray16, Gray17, Gray18, Gray19, Gray20, Gray21, Gray22, Gray23, Gray24, Gray25, Gray26, Gray27, Gray28, Gray29, Gray30, Gray31, Gray32, Gray33, Gray34, Gray35, Gray36, Gray37, Gray38, Gray39, Gray40, Gray41, Gray42, Gray43, Gray44, Gray45, Gray46, Gray47, Gray48, Gray49, Gray50, Gray51, Gray52, Gray53, Gray54, Gray55, Gray56, Gray57, Gray58, Gray59, Gray60, Gray61, Gray62, Gray63, Gray64, Gray65, Gray66, Gray67, Gray68, Gray69, Gray70, Gray71, Gray72, Gray73, Gray74, Gray75, Gray76, Gray77, Gray78, Gray79, Gray80, Gray81, Gray82, Gray83, Gray84, Gray85, Gray86, Gray87, Gray88, Gray89, Gray90, Gray91, Gray92, Gray93, Gray94, Gray95, Gray96, Gray97, Gray98, Gray99, Gray100]
 
       fun gray i =
-	 if 0 <= i andalso i < Vector.length grays
-	    then Vector.sub (grays, i)
-	 else Error.bug "invalid gray index"
+         if 0 <= i andalso i < Vector.length grays
+            then Vector.sub (grays, i)
+         else Error.bug "Dot.gray"
 
       fun realToString x = Real.format (x, Real.Format.fix (SOME 2))
-	 
+         
       val toString =
-	 fn HSB (h, s, b) => concat [realToString h, " ",
-				     realToString s, " ",
-				     realToString b]
-	  | Aliceblue => "Aliceblue"
-	  | Antiquewhite1 => "Antiquewhite1"
-	  | Antiquewhite2 => "Antiquewhite2"
-	  | Antiquewhite3 => "Antiquewhite3"
-	  | Antiquewhite4 => "Antiquewhite4"
-	  | Aquamarine1 => "Aquamarine1"
-	  | Aquamarine2 => "Aquamarine2"
-	  | Aquamarine3 => "Aquamarine3"
-	  | Aquamarine4 => "Aquamarine4"
-	  | Azure1 => "Azure1"
-	  | Azure2 => "Azure2"
-	  | Azure3 => "Azure3"
-	  | Azure4 => "Azure4"
-	  | Beige => "Beige"
-	  | Bisque1 => "Bisque1"
-	  | Bisque2 => "Bisque2"
-	  | Bisque3 => "Bisque3"
-	  | Bisque4 => "Bisque4"
-	  | Black => "Black"
-	  | Blanchedalmond => "Blanchedalmond"
-	  | Blue1 => "Blue1"
-	  | Blue2 => "Blue2"
-	  | Blue3 => "Blue3"
-	  | Blue4 => "Blue4"
-	  | Blueviolet => "Blueviolet"
-	  | Brown1 => "Brown1"
-	  | Brown2 => "Brown2"
-	  | Brown3 => "Brown3"
-	  | Brown4 => "Brown4"
-	  | Burlywood1 => "Burlywood1"
-	  | Burlywood2 => "Burlywood2"
-	  | Burlywood3 => "Burlywood3"
-	  | Burlywood4 => "Burlywood4"
-	  | Cadetblue1 => "Cadetblue1"
-	  | Cadetblue2 => "Cadetblue2"
-	  | Cadetblue3 => "Cadetblue3"
-	  | Cadetblue4 => "Cadetblue4"
-	  | Chartreuse1 => "Chartreuse1"
-	  | Chartreuse2 => "Chartreuse2"
-	  | Chartreuse3 => "Chartreuse3"
-	  | Chartreuse4 => "Chartreuse4"
-	  | Chocolate1 => "Chocolate1"
-	  | Chocolate2 => "Chocolate2"
-	  | Chocolate3 => "Chocolate3"
-	  | Chocolate4 => "Chocolate4"
-	  | Coral1 => "Coral1"
-	  | Coral2 => "Coral2"
-	  | Coral3 => "Coral3"
-	  | Coral4 => "Coral4"
-	  | Corn => "Corn"
-	  | Cornsilk1 => "Cornsilk1"
-	  | Cornsilk2 => "Cornsilk2"
-	  | Cornsilk3 => "Cornsilk3"
-	  | Cornsilk4 => "Cornsilk4"
-	  | Crimson => "Crimson"
-	  | Cyan1 => "Cyan1"
-	  | Cyan2 => "Cyan2"
-	  | Cyan3 => "Cyan3"
-	  | Cyan4 => "Cyan4"
-	  | Darkgoldenrod1 => "Darkgoldenrod1"
-	  | Darkgoldenrod2 => "Darkgoldenrod2"
-	  | Darkgoldenrod3 => "Darkgoldenrod3"
-	  | Darkgoldenrod4 => "Darkgoldenrod4"
-	  | Darkgreen => "Darkgreen"
-	  | Darkkhaki => "Darkkhaki"
-	  | Darkolivegreen1 => "Darkolivegreen1"
-	  | Darkolivegreen2 => "Darkolivegreen2"
-	  | Darkolivegreen3 => "Darkolivegreen3"
-	  | Darkolivegreen4 => "Darkolivegreen4"
-	  | Darkorange1 => "Darkorange1"
-	  | Darkorange2 => "Darkorange2"
-	  | Darkorange3 => "Darkorange3"
-	  | Darkorange4 => "Darkorange4"
-	  | Darkorchid1 => "Darkorchid1"
-	  | Darkorchid2 => "Darkorchid2"
-	  | Darkorchid3 => "Darkorchid3"
-	  | Darkorchid4 => "Darkorchid4"
-	  | Darksalmon => "Darksalmon"
-	  | Darkseagreen1 => "Darkseagreen1"
-	  | Darkseagreen2 => "Darkseagreen2"
-	  | Darkseagreen3 => "Darkseagreen3"
-	  | Darkseagreen4 => "Darkseagreen4"
-	  | Darkslateblue => "Darkslateblue"
-	  | Darkslategray1 => "Darkslategray1"
-	  | Darkslategray2 => "Darkslategray2"
-	  | Darkslategray3 => "Darkslategray3"
-	  | Darkslategray4 => "Darkslategray4"
-	  | Darkturquoise => "Darkturquoise"
-	  | Darkviolet => "Darkviolet"
-	  | Deeppink1 => "Deeppink1"
-	  | Deeppink2 => "Deeppink2"
-	  | Deeppink3 => "Deeppink3"
-	  | Deeppink4 => "Deeppink4"
-	  | Deepskyblue1 => "Deepskyblue1"
-	  | Deepskyblue2 => "Deepskyblue2"
-	  | Deepskyblue3 => "Deepskyblue3"
-	  | Deepskyblue4 => "Deepskyblue4"
-	  | Dimgray => "Dimgray"
-	  | Dodgerblue1 => "Dodgerblue1"
-	  | Dodgerblue2 => "Dodgerblue2"
-	  | Dodgerblue3 => "Dodgerblue3"
-	  | Dodgerblue4 => "Dodgerblue4"
-	  | Forestgreen => "Forestgreen"
-	  | Gainsboro => "Gainsboro"
-	  | Ghostwhite => "Ghostwhite"
-	  | Gold1 => "Gold1"
-	  | Gold2 => "Gold2"
-	  | Gold3 => "Gold3"
-	  | Gold4 => "Gold4"
-	  | Goldenrod1 => "Goldenrod1"
-	  | Goldenrod2 => "Goldenrod2"
-	  | Goldenrod3 => "Goldenrod3"
-	  | Goldenrod4 => "Goldenrod4"
-	  | Gray => "Gray"
-	  | Gray0 => "Gray0"
-	  | Gray1 => "Gray1"
-	  | Gray2 => "Gray2"
-	  | Gray3 => "Gray3"
-	  | Gray4 => "Gray4"
-	  | Gray5 => "Gray5"
-	  | Gray6 => "Gray6"
-	  | Gray7 => "Gray7"
-	  | Gray8 => "Gray8"
-	  | Gray9 => "Gray9"
-	  | Gray10 => "Gray10"
-	  | Gray11 => "Gray11"
-	  | Gray12 => "Gray12"
-	  | Gray13 => "Gray13"
-	  | Gray14 => "Gray14"
-	  | Gray15 => "Gray15"
-	  | Gray16 => "Gray16"
-	  | Gray17 => "Gray17"
-	  | Gray18 => "Gray18"
-	  | Gray19 => "Gray19"
-	  | Gray20 => "Gray20"
-	  | Gray21 => "Gray21"
-	  | Gray22 => "Gray22"
-	  | Gray23 => "Gray23"
-	  | Gray24 => "Gray24"
-	  | Gray25 => "Gray25"
-	  | Gray26 => "Gray26"
-	  | Gray27 => "Gray27"
-	  | Gray28 => "Gray28"
-	  | Gray29 => "Gray29"
-	  | Gray30 => "Gray30"
-	  | Gray31 => "Gray31"
-	  | Gray32 => "Gray32"
-	  | Gray33 => "Gray33"
-	  | Gray34 => "Gray34"
-	  | Gray35 => "Gray35"
-	  | Gray36 => "Gray36"
-	  | Gray37 => "Gray37"
-	  | Gray38 => "Gray38"
-	  | Gray39 => "Gray39"
-	  | Gray40 => "Gray40"
-	  | Gray41 => "Gray41"
-	  | Gray42 => "Gray42"
-	  | Gray43 => "Gray43"
-	  | Gray44 => "Gray44"
-	  | Gray45 => "Gray45"
-	  | Gray46 => "Gray46"
-	  | Gray47 => "Gray47"
-	  | Gray48 => "Gray48"
-	  | Gray49 => "Gray49"
-	  | Gray50 => "Gray50"
-	  | Gray51 => "Gray51"
-	  | Gray52 => "Gray52"
-	  | Gray53 => "Gray53"
-	  | Gray54 => "Gray54"
-	  | Gray55 => "Gray55"
-	  | Gray56 => "Gray56"
-	  | Gray57 => "Gray57"
-	  | Gray58 => "Gray58"
-	  | Gray59 => "Gray59"
-	  | Gray60 => "Gray60"
-	  | Gray61 => "Gray61"
-	  | Gray62 => "Gray62"
-	  | Gray63 => "Gray63"
-	  | Gray64 => "Gray64"
-	  | Gray65 => "Gray65"
-	  | Gray66 => "Gray66"
-	  | Gray67 => "Gray67"
-	  | Gray68 => "Gray68"
-	  | Gray69 => "Gray69"
-	  | Gray70 => "Gray70"
-	  | Gray71 => "Gray71"
-	  | Gray72 => "Gray72"
-	  | Gray73 => "Gray73"
-	  | Gray74 => "Gray74"
-	  | Gray75 => "Gray75"
-	  | Gray76 => "Gray76"
-	  | Gray77 => "Gray77"
-	  | Gray78 => "Gray78"
-	  | Gray79 => "Gray79"
-	  | Gray80 => "Gray80"
-	  | Gray81 => "Gray81"
-	  | Gray82 => "Gray82"
-	  | Gray83 => "Gray83"
-	  | Gray84 => "Gray84"
-	  | Gray85 => "Gray85"
-	  | Gray86 => "Gray86"
-	  | Gray87 => "Gray87"
-	  | Gray88 => "Gray88"
-	  | Gray89 => "Gray89"
-	  | Gray90 => "Gray90"
-	  | Gray91 => "Gray91"
-	  | Gray92 => "Gray92"
-	  | Gray93 => "Gray93"
-	  | Gray94 => "Gray94"
-	  | Gray95 => "Gray95"
-	  | Gray96 => "Gray96"
-	  | Gray97 => "Gray97"
-	  | Gray98 => "Gray98"
-	  | Gray99 => "Gray99"
-	  | Gray100 => "Gray100"
-	  | Green1 => "Green1"
-	  | Green2 => "Green2"
-	  | Green3 => "Green3"
-	  | Green4 => "Green4"
-	  | Greenyellow => "Greenyellow"
-	  | Honeydew1 => "Honeydew1"
-	  | Honeydew2 => "Honeydew2"
-	  | Honeydew3 => "Honeydew3"
-	  | Honeydew4 => "Honeydew4"
-	  | Hotpink1 => "Hotpink1"
-	  | Hotpink2 => "Hotpink2"
-	  | Hotpink3 => "Hotpink3"
-	  | Hotpink4 => "Hotpink4"
-	  | Indianred1 => "Indianred1"
-	  | Indianred2 => "Indianred2"
-	  | Indianred3 => "Indianred3"
-	  | Indianred4 => "Indianred4"
-	  | Indigo => "Indigo"
-	  | Ivory1 => "Ivory1"
-	  | Ivory2 => "Ivory2"
-	  | Ivory3 => "Ivory3"
-	  | Ivory4 => "Ivory4"
-	  | Khaki1 => "Khaki1"
-	  | Khaki2 => "Khaki2"
-	  | Khaki3 => "Khaki3"
-	  | Khaki4 => "Khaki4"
-	  | Lavender => "Lavender"
-	  | Lavenderblush1 => "Lavenderblush1"
-	  | Lavenderblush2 => "Lavenderblush2"
-	  | Lavenderblush3 => "Lavenderblush3"
-	  | Lavenderblush4 => "Lavenderblush4"
-	  | Lawngreen => "Lawngreen"
-	  | Lemonchi => "Lemonchi"
-	  | Lightblue1 => "Lightblue1"
-	  | Lightblue2 => "Lightblue2"
-	  | Lightblue3 => "Lightblue3"
-	  | Lightblue4 => "Lightblue4"
-	  | Lightcyan1 => "Lightcyan1"
-	  | Lightcyan2 => "Lightcyan2"
-	  | Lightcyan3 => "Lightcyan3"
-	  | Lightcyan4 => "Lightcyan4"
-	  | Lightgoldenrod1 => "Lightgoldenrod1"
-	  | Lightgoldenrod2 => "Lightgoldenrod2"
-	  | Lightgoldenrod3 => "Lightgoldenrod3"
-	  | Lightgoldenrod4 => "Lightgoldenrod4"
-	  | Lightgoldenrodyellow => "Lightgoldenrodyellow"
-	  | Lightgray => "Lightgray"
-	  | Lightpink1 => "Lightpink1"
-	  | Lightpink2 => "Lightpink2"
-	  | Lightpink3 => "Lightpink3"
-	  | Lightpink4 => "Lightpink4"
-	  | Lightsalmon1 => "Lightsalmon1"
-	  | Lightsalmon2 => "Lightsalmon2"
-	  | Lightsalmon3 => "Lightsalmon3"
-	  | Lightsalmon4 => "Lightsalmon4"
-	  | Lightseagreen => "Lightseagreen"
-	  | Lightskyblue1 => "Lightskyblue1"
-	  | Lightskyblue2 => "Lightskyblue2"
-	  | Lightskyblue3 => "Lightskyblue3"
-	  | Lightskyblue4 => "Lightskyblue4"
-	  | Lightslateblue1 => "Lightslateblue1"
-	  | Lightslateblue2 => "Lightslateblue2"
-	  | Lightslateblue3 => "Lightslateblue3"
-	  | Lightslateblue4 => "Lightslateblue4"
-	  | Lightslategray => "Lightslategray"
-	  | Lightyellow1 => "Lightyellow1"
-	  | Lightyellow2 => "Lightyellow2"
-	  | Lightyellow3 => "Lightyellow3"
-	  | Lightyellow4 => "Lightyellow4"
-	  | Limegreen => "Limegreen"
-	  | Linen => "Linen"
-	  | Magenta1 => "Magenta1"
-	  | Magenta2 => "Magenta2"
-	  | Magenta3 => "Magenta3"
-	  | Magenta4 => "Magenta4"
-	  | Maroon1 => "Maroon1"
-	  | Maroon2 => "Maroon2"
-	  | Maroon3 => "Maroon3"
-	  | Maroon4 => "Maroon4"
-	  | Mediumaquamarine => "Mediumaquamarine"
-	  | Mediumblue => "Mediumblue"
-	  | Mediumorchid1 => "Mediumorchid1"
-	  | Mediumorchid2 => "Mediumorchid2"
-	  | Mediumorchid3 => "Mediumorchid3"
-	  | Mediumorchid4 => "Mediumorchid4"
-	  | Mediumpurple1 => "Mediumpurple1"
-	  | Mediumpurple2 => "Mediumpurple2"
-	  | Mediumpurple3 => "Mediumpurple3"
-	  | Mediumpurple4 => "Mediumpurple4"
-	  | Mediumseagreen => "Mediumseagreen"
-	  | Mediumslateblue => "Mediumslateblue"
-	  | Mediumspringgreen => "Mediumspringgreen"
-	  | Mediumturquoise => "Mediumturquoise"
-	  | Mediumvioletred => "Mediumvioletred"
-	  | Midnightblue => "Midnightblue"
-	  | Mintcream => "Mintcream"
-	  | Mistyrose1 => "Mistyrose1"
-	  | Mistyrose2 => "Mistyrose2"
-	  | Mistyrose3 => "Mistyrose3"
-	  | Mistyrose4 => "Mistyrose4"
-	  | Moccasin => "Moccasin"
-	  | Navajowhite1 => "Navajowhite1"
-	  | Navajowhite2 => "Navajowhite2"
-	  | Navajowhite3 => "Navajowhite3"
-	  | Navajowhite4 => "Navajowhite4"
-	  | Navy => "Navy"
-	  | Navyblue => "Navyblue"
-	  | Oldlace => "Oldlace"
-	  | Olivedrab1 => "Olivedrab1"
-	  | Olivedrab2 => "Olivedrab2"
-	  | Olivedrab3 => "Olivedrab3"
-	  | Olivedrab4 => "Olivedrab4"
-	  | On1 => "On1"
-	  | On2 => "On2"
-	  | On3 => "On3"
-	  | On4 => "On4"
-	  | Oralwhite => "Oralwhite"
-	  | Orange1 => "Orange1"
-	  | Orange2 => "Orange2"
-	  | Orange3 => "Orange3"
-	  | Orange4 => "Orange4"
-	  | Orangered1 => "Orangered1"
-	  | Orangered2 => "Orangered2"
-	  | Orangered3 => "Orangered3"
-	  | Orangered4 => "Orangered4"
-	  | Orchid1 => "Orchid1"
-	  | Orchid2 => "Orchid2"
-	  | Orchid3 => "Orchid3"
-	  | Orchid4 => "Orchid4"
-	  | Owerblue => "Owerblue"
-	  | Palegoldenrod => "Palegoldenrod"
-	  | Palegreen1 => "Palegreen1"
-	  | Palegreen2 => "Palegreen2"
-	  | Palegreen3 => "Palegreen3"
-	  | Palegreen4 => "Palegreen4"
-	  | Paleturquoise1 => "Paleturquoise1"
-	  | Paleturquoise2 => "Paleturquoise2"
-	  | Paleturquoise3 => "Paleturquoise3"
-	  | Paleturquoise4 => "Paleturquoise4"
-	  | Palevioletred1 => "Palevioletred1"
-	  | Palevioletred2 => "Palevioletred2"
-	  | Palevioletred3 => "Palevioletred3"
-	  | Palevioletred4 => "Palevioletred4"
-	  | Papayawhip => "Papayawhip"
-	  | Peachpu1 => "Peachpu1"
-	  | Peachpu2 => "Peachpu2"
-	  | Peachpu3 => "Peachpu3"
-	  | Peachpu4 => "Peachpu4"
-	  | Peru => "Peru"
-	  | Pink1 => "Pink1"
-	  | Pink2 => "Pink2"
-	  | Pink3 => "Pink3"
-	  | Pink4 => "Pink4"
-	  | Plum1 => "Plum1"
-	  | Plum2 => "Plum2"
-	  | Plum3 => "Plum3"
-	  | Plum4 => "Plum4"
-	  | Powderblue => "Powderblue"
-	  | Purple1 => "Purple1"
-	  | Purple2 => "Purple2"
-	  | Purple3 => "Purple3"
-	  | Purple4 => "Purple4"
-	  | Rebrick1 => "Rebrick1"
-	  | Rebrick2 => "Rebrick2"
-	  | Rebrick3 => "Rebrick3"
-	  | Rebrick4 => "Rebrick4"
-	  | Red1 => "Red1"
-	  | Red2 => "Red2"
-	  | Red3 => "Red3"
-	  | Red4 => "Red4"
-	  | Rosybrown1 => "Rosybrown1"
-	  | Rosybrown2 => "Rosybrown2"
-	  | Rosybrown3 => "Rosybrown3"
-	  | Rosybrown4 => "Rosybrown4"
-	  | Royalblue1 => "Royalblue1"
-	  | Royalblue2 => "Royalblue2"
-	  | Royalblue3 => "Royalblue3"
-	  | Royalblue4 => "Royalblue4"
-	  | Saddlebrown => "Saddlebrown"
-	  | Salmon1 => "Salmon1"
-	  | Salmon2 => "Salmon2"
-	  | Salmon3 => "Salmon3"
-	  | Salmon4 => "Salmon4"
-	  | Sandybrown => "Sandybrown"
-	  | Seagreen1 => "Seagreen1"
-	  | Seagreen2 => "Seagreen2"
-	  | Seagreen3 => "Seagreen3"
-	  | Seagreen4 => "Seagreen4"
-	  | Seashell1 => "Seashell1"
-	  | Seashell2 => "Seashell2"
-	  | Seashell3 => "Seashell3"
-	  | Seashell4 => "Seashell4"
-	  | Sienna1 => "Sienna1"
-	  | Sienna2 => "Sienna2"
-	  | Sienna3 => "Sienna3"
-	  | Sienna4 => "Sienna4"
-	  | Skyblue1 => "Skyblue1"
-	  | Skyblue2 => "Skyblue2"
-	  | Skyblue3 => "Skyblue3"
-	  | Skyblue4 => "Skyblue4"
-	  | Slateblue1 => "Slateblue1"
-	  | Slateblue2 => "Slateblue2"
-	  | Slateblue3 => "Slateblue3"
-	  | Slateblue4 => "Slateblue4"
-	  | Slategray1 => "Slategray1"
-	  | Slategray2 => "Slategray2"
-	  | Slategray3 => "Slategray3"
-	  | Slategray4 => "Slategray4"
-	  | Snow1 => "Snow1"
-	  | Snow2 => "Snow2"
-	  | Snow3 => "Snow3"
-	  | Snow4 => "Snow4"
-	  | Springgreen1 => "Springgreen1"
-	  | Springgreen2 => "Springgreen2"
-	  | Springgreen3 => "Springgreen3"
-	  | Springgreen4 => "Springgreen4"
-	  | Steelblue1 => "Steelblue1"
-	  | Steelblue2 => "Steelblue2"
-	  | Steelblue3 => "Steelblue3"
-	  | Steelblue4 => "Steelblue4"
-	  | Tan1 => "Tan1"
-	  | Tan2 => "Tan2"
-	  | Tan3 => "Tan3"
-	  | Tan4 => "Tan4"
-	  | Thistle1 => "Thistle1"
-	  | Thistle2 => "Thistle2"
-	  | Thistle3 => "Thistle3"
-	  | Thistle4 => "Thistle4"
-	  | Tomato1 => "Tomato1"
-	  | Tomato2 => "Tomato2"
-	  | Tomato3 => "Tomato3"
-	  | Tomato4 => "Tomato4"
-	  | Turquoise1 => "Turquoise1"
-	  | Turquoise2 => "Turquoise2"
-	  | Turquoise3 => "Turquoise3"
-	  | Turquoise4 => "Turquoise4"
-	  | Violet => "Violet"
-	  | Violetred1 => "Violetred1"
-	  | Violetred2 => "Violetred2"
-	  | Violetred3 => "Violetred3"
-	  | Violetred4 => "Violetred4"
-	  | Wheat1 => "Wheat1"
-	  | Wheat2 => "Wheat2"
-	  | Wheat3 => "Wheat3"
-	  | Wheat4 => "Wheat4"
-	  | White => "White"
-	  | Whitesmoke => "Whitesmoke"
-	  | Yellow1 => "Yellow1"
-	  | Yellow2 => "Yellow2"
-	  | Yellow3 => "Yellow3"
-	  | Yellow4 => "Yellow4"
-	  | Yellowgreen => "Yellowgreen"
+         fn HSB (h, s, b) => concat [realToString h, " ",
+                                     realToString s, " ",
+                                     realToString b]
+          | Aliceblue => "Aliceblue"
+          | Antiquewhite1 => "Antiquewhite1"
+          | Antiquewhite2 => "Antiquewhite2"
+          | Antiquewhite3 => "Antiquewhite3"
+          | Antiquewhite4 => "Antiquewhite4"
+          | Aquamarine1 => "Aquamarine1"
+          | Aquamarine2 => "Aquamarine2"
+          | Aquamarine3 => "Aquamarine3"
+          | Aquamarine4 => "Aquamarine4"
+          | Azure1 => "Azure1"
+          | Azure2 => "Azure2"
+          | Azure3 => "Azure3"
+          | Azure4 => "Azure4"
+          | Beige => "Beige"
+          | Bisque1 => "Bisque1"
+          | Bisque2 => "Bisque2"
+          | Bisque3 => "Bisque3"
+          | Bisque4 => "Bisque4"
+          | Black => "Black"
+          | Blanchedalmond => "Blanchedalmond"
+          | Blue1 => "Blue1"
+          | Blue2 => "Blue2"
+          | Blue3 => "Blue3"
+          | Blue4 => "Blue4"
+          | Blueviolet => "Blueviolet"
+          | Brown1 => "Brown1"
+          | Brown2 => "Brown2"
+          | Brown3 => "Brown3"
+          | Brown4 => "Brown4"
+          | Burlywood1 => "Burlywood1"
+          | Burlywood2 => "Burlywood2"
+          | Burlywood3 => "Burlywood3"
+          | Burlywood4 => "Burlywood4"
+          | Cadetblue1 => "Cadetblue1"
+          | Cadetblue2 => "Cadetblue2"
+          | Cadetblue3 => "Cadetblue3"
+          | Cadetblue4 => "Cadetblue4"
+          | Chartreuse1 => "Chartreuse1"
+          | Chartreuse2 => "Chartreuse2"
+          | Chartreuse3 => "Chartreuse3"
+          | Chartreuse4 => "Chartreuse4"
+          | Chocolate1 => "Chocolate1"
+          | Chocolate2 => "Chocolate2"
+          | Chocolate3 => "Chocolate3"
+          | Chocolate4 => "Chocolate4"
+          | Coral1 => "Coral1"
+          | Coral2 => "Coral2"
+          | Coral3 => "Coral3"
+          | Coral4 => "Coral4"
+          | Corn => "Corn"
+          | Cornsilk1 => "Cornsilk1"
+          | Cornsilk2 => "Cornsilk2"
+          | Cornsilk3 => "Cornsilk3"
+          | Cornsilk4 => "Cornsilk4"
+          | Crimson => "Crimson"
+          | Cyan1 => "Cyan1"
+          | Cyan2 => "Cyan2"
+          | Cyan3 => "Cyan3"
+          | Cyan4 => "Cyan4"
+          | Darkgoldenrod1 => "Darkgoldenrod1"
+          | Darkgoldenrod2 => "Darkgoldenrod2"
+          | Darkgoldenrod3 => "Darkgoldenrod3"
+          | Darkgoldenrod4 => "Darkgoldenrod4"
+          | Darkgreen => "Darkgreen"
+          | Darkkhaki => "Darkkhaki"
+          | Darkolivegreen1 => "Darkolivegreen1"
+          | Darkolivegreen2 => "Darkolivegreen2"
+          | Darkolivegreen3 => "Darkolivegreen3"
+          | Darkolivegreen4 => "Darkolivegreen4"
+          | Darkorange1 => "Darkorange1"
+          | Darkorange2 => "Darkorange2"
+          | Darkorange3 => "Darkorange3"
+          | Darkorange4 => "Darkorange4"
+          | Darkorchid1 => "Darkorchid1"
+          | Darkorchid2 => "Darkorchid2"
+          | Darkorchid3 => "Darkorchid3"
+          | Darkorchid4 => "Darkorchid4"
+          | Darksalmon => "Darksalmon"
+          | Darkseagreen1 => "Darkseagreen1"
+          | Darkseagreen2 => "Darkseagreen2"
+          | Darkseagreen3 => "Darkseagreen3"
+          | Darkseagreen4 => "Darkseagreen4"
+          | Darkslateblue => "Darkslateblue"
+          | Darkslategray1 => "Darkslategray1"
+          | Darkslategray2 => "Darkslategray2"
+          | Darkslategray3 => "Darkslategray3"
+          | Darkslategray4 => "Darkslategray4"
+          | Darkturquoise => "Darkturquoise"
+          | Darkviolet => "Darkviolet"
+          | Deeppink1 => "Deeppink1"
+          | Deeppink2 => "Deeppink2"
+          | Deeppink3 => "Deeppink3"
+          | Deeppink4 => "Deeppink4"
+          | Deepskyblue1 => "Deepskyblue1"
+          | Deepskyblue2 => "Deepskyblue2"
+          | Deepskyblue3 => "Deepskyblue3"
+          | Deepskyblue4 => "Deepskyblue4"
+          | Dimgray => "Dimgray"
+          | Dodgerblue1 => "Dodgerblue1"
+          | Dodgerblue2 => "Dodgerblue2"
+          | Dodgerblue3 => "Dodgerblue3"
+          | Dodgerblue4 => "Dodgerblue4"
+          | Forestgreen => "Forestgreen"
+          | Gainsboro => "Gainsboro"
+          | Ghostwhite => "Ghostwhite"
+          | Gold1 => "Gold1"
+          | Gold2 => "Gold2"
+          | Gold3 => "Gold3"
+          | Gold4 => "Gold4"
+          | Goldenrod1 => "Goldenrod1"
+          | Goldenrod2 => "Goldenrod2"
+          | Goldenrod3 => "Goldenrod3"
+          | Goldenrod4 => "Goldenrod4"
+          | Gray => "Gray"
+          | Gray0 => "Gray0"
+          | Gray1 => "Gray1"
+          | Gray2 => "Gray2"
+          | Gray3 => "Gray3"
+          | Gray4 => "Gray4"
+          | Gray5 => "Gray5"
+          | Gray6 => "Gray6"
+          | Gray7 => "Gray7"
+          | Gray8 => "Gray8"
+          | Gray9 => "Gray9"
+          | Gray10 => "Gray10"
+          | Gray11 => "Gray11"
+          | Gray12 => "Gray12"
+          | Gray13 => "Gray13"
+          | Gray14 => "Gray14"
+          | Gray15 => "Gray15"
+          | Gray16 => "Gray16"
+          | Gray17 => "Gray17"
+          | Gray18 => "Gray18"
+          | Gray19 => "Gray19"
+          | Gray20 => "Gray20"
+          | Gray21 => "Gray21"
+          | Gray22 => "Gray22"
+          | Gray23 => "Gray23"
+          | Gray24 => "Gray24"
+          | Gray25 => "Gray25"
+          | Gray26 => "Gray26"
+          | Gray27 => "Gray27"
+          | Gray28 => "Gray28"
+          | Gray29 => "Gray29"
+          | Gray30 => "Gray30"
+          | Gray31 => "Gray31"
+          | Gray32 => "Gray32"
+          | Gray33 => "Gray33"
+          | Gray34 => "Gray34"
+          | Gray35 => "Gray35"
+          | Gray36 => "Gray36"
+          | Gray37 => "Gray37"
+          | Gray38 => "Gray38"
+          | Gray39 => "Gray39"
+          | Gray40 => "Gray40"
+          | Gray41 => "Gray41"
+          | Gray42 => "Gray42"
+          | Gray43 => "Gray43"
+          | Gray44 => "Gray44"
+          | Gray45 => "Gray45"
+          | Gray46 => "Gray46"
+          | Gray47 => "Gray47"
+          | Gray48 => "Gray48"
+          | Gray49 => "Gray49"
+          | Gray50 => "Gray50"
+          | Gray51 => "Gray51"
+          | Gray52 => "Gray52"
+          | Gray53 => "Gray53"
+          | Gray54 => "Gray54"
+          | Gray55 => "Gray55"
+          | Gray56 => "Gray56"
+          | Gray57 => "Gray57"
+          | Gray58 => "Gray58"
+          | Gray59 => "Gray59"
+          | Gray60 => "Gray60"
+          | Gray61 => "Gray61"
+          | Gray62 => "Gray62"
+          | Gray63 => "Gray63"
+          | Gray64 => "Gray64"
+          | Gray65 => "Gray65"
+          | Gray66 => "Gray66"
+          | Gray67 => "Gray67"
+          | Gray68 => "Gray68"
+          | Gray69 => "Gray69"
+          | Gray70 => "Gray70"
+          | Gray71 => "Gray71"
+          | Gray72 => "Gray72"
+          | Gray73 => "Gray73"
+          | Gray74 => "Gray74"
+          | Gray75 => "Gray75"
+          | Gray76 => "Gray76"
+          | Gray77 => "Gray77"
+          | Gray78 => "Gray78"
+          | Gray79 => "Gray79"
+          | Gray80 => "Gray80"
+          | Gray81 => "Gray81"
+          | Gray82 => "Gray82"
+          | Gray83 => "Gray83"
+          | Gray84 => "Gray84"
+          | Gray85 => "Gray85"
+          | Gray86 => "Gray86"
+          | Gray87 => "Gray87"
+          | Gray88 => "Gray88"
+          | Gray89 => "Gray89"
+          | Gray90 => "Gray90"
+          | Gray91 => "Gray91"
+          | Gray92 => "Gray92"
+          | Gray93 => "Gray93"
+          | Gray94 => "Gray94"
+          | Gray95 => "Gray95"
+          | Gray96 => "Gray96"
+          | Gray97 => "Gray97"
+          | Gray98 => "Gray98"
+          | Gray99 => "Gray99"
+          | Gray100 => "Gray100"
+          | Green1 => "Green1"
+          | Green2 => "Green2"
+          | Green3 => "Green3"
+          | Green4 => "Green4"
+          | Greenyellow => "Greenyellow"
+          | Honeydew1 => "Honeydew1"
+          | Honeydew2 => "Honeydew2"
+          | Honeydew3 => "Honeydew3"
+          | Honeydew4 => "Honeydew4"
+          | Hotpink1 => "Hotpink1"
+          | Hotpink2 => "Hotpink2"
+          | Hotpink3 => "Hotpink3"
+          | Hotpink4 => "Hotpink4"
+          | Indianred1 => "Indianred1"
+          | Indianred2 => "Indianred2"
+          | Indianred3 => "Indianred3"
+          | Indianred4 => "Indianred4"
+          | Indigo => "Indigo"
+          | Ivory1 => "Ivory1"
+          | Ivory2 => "Ivory2"
+          | Ivory3 => "Ivory3"
+          | Ivory4 => "Ivory4"
+          | Khaki1 => "Khaki1"
+          | Khaki2 => "Khaki2"
+          | Khaki3 => "Khaki3"
+          | Khaki4 => "Khaki4"
+          | Lavender => "Lavender"
+          | Lavenderblush1 => "Lavenderblush1"
+          | Lavenderblush2 => "Lavenderblush2"
+          | Lavenderblush3 => "Lavenderblush3"
+          | Lavenderblush4 => "Lavenderblush4"
+          | Lawngreen => "Lawngreen"
+          | Lemonchi => "Lemonchi"
+          | Lightblue1 => "Lightblue1"
+          | Lightblue2 => "Lightblue2"
+          | Lightblue3 => "Lightblue3"
+          | Lightblue4 => "Lightblue4"
+          | Lightcyan1 => "Lightcyan1"
+          | Lightcyan2 => "Lightcyan2"
+          | Lightcyan3 => "Lightcyan3"
+          | Lightcyan4 => "Lightcyan4"
+          | Lightgoldenrod1 => "Lightgoldenrod1"
+          | Lightgoldenrod2 => "Lightgoldenrod2"
+          | Lightgoldenrod3 => "Lightgoldenrod3"
+          | Lightgoldenrod4 => "Lightgoldenrod4"
+          | Lightgoldenrodyellow => "Lightgoldenrodyellow"
+          | Lightgray => "Lightgray"
+          | Lightpink1 => "Lightpink1"
+          | Lightpink2 => "Lightpink2"
+          | Lightpink3 => "Lightpink3"
+          | Lightpink4 => "Lightpink4"
+          | Lightsalmon1 => "Lightsalmon1"
+          | Lightsalmon2 => "Lightsalmon2"
+          | Lightsalmon3 => "Lightsalmon3"
+          | Lightsalmon4 => "Lightsalmon4"
+          | Lightseagreen => "Lightseagreen"
+          | Lightskyblue1 => "Lightskyblue1"
+          | Lightskyblue2 => "Lightskyblue2"
+          | Lightskyblue3 => "Lightskyblue3"
+          | Lightskyblue4 => "Lightskyblue4"
+          | Lightslateblue1 => "Lightslateblue1"
+          | Lightslateblue2 => "Lightslateblue2"
+          | Lightslateblue3 => "Lightslateblue3"
+          | Lightslateblue4 => "Lightslateblue4"
+          | Lightslategray => "Lightslategray"
+          | Lightyellow1 => "Lightyellow1"
+          | Lightyellow2 => "Lightyellow2"
+          | Lightyellow3 => "Lightyellow3"
+          | Lightyellow4 => "Lightyellow4"
+          | Limegreen => "Limegreen"
+          | Linen => "Linen"
+          | Magenta1 => "Magenta1"
+          | Magenta2 => "Magenta2"
+          | Magenta3 => "Magenta3"
+          | Magenta4 => "Magenta4"
+          | Maroon1 => "Maroon1"
+          | Maroon2 => "Maroon2"
+          | Maroon3 => "Maroon3"
+          | Maroon4 => "Maroon4"
+          | Mediumaquamarine => "Mediumaquamarine"
+          | Mediumblue => "Mediumblue"
+          | Mediumorchid1 => "Mediumorchid1"
+          | Mediumorchid2 => "Mediumorchid2"
+          | Mediumorchid3 => "Mediumorchid3"
+          | Mediumorchid4 => "Mediumorchid4"
+          | Mediumpurple1 => "Mediumpurple1"
+          | Mediumpurple2 => "Mediumpurple2"
+          | Mediumpurple3 => "Mediumpurple3"
+          | Mediumpurple4 => "Mediumpurple4"
+          | Mediumseagreen => "Mediumseagreen"
+          | Mediumslateblue => "Mediumslateblue"
+          | Mediumspringgreen => "Mediumspringgreen"
+          | Mediumturquoise => "Mediumturquoise"
+          | Mediumvioletred => "Mediumvioletred"
+          | Midnightblue => "Midnightblue"
+          | Mintcream => "Mintcream"
+          | Mistyrose1 => "Mistyrose1"
+          | Mistyrose2 => "Mistyrose2"
+          | Mistyrose3 => "Mistyrose3"
+          | Mistyrose4 => "Mistyrose4"
+          | Moccasin => "Moccasin"
+          | Navajowhite1 => "Navajowhite1"
+          | Navajowhite2 => "Navajowhite2"
+          | Navajowhite3 => "Navajowhite3"
+          | Navajowhite4 => "Navajowhite4"
+          | Navy => "Navy"
+          | Navyblue => "Navyblue"
+          | Oldlace => "Oldlace"
+          | Olivedrab1 => "Olivedrab1"
+          | Olivedrab2 => "Olivedrab2"
+          | Olivedrab3 => "Olivedrab3"
+          | Olivedrab4 => "Olivedrab4"
+          | On1 => "On1"
+          | On2 => "On2"
+          | On3 => "On3"
+          | On4 => "On4"
+          | Oralwhite => "Oralwhite"
+          | Orange1 => "Orange1"
+          | Orange2 => "Orange2"
+          | Orange3 => "Orange3"
+          | Orange4 => "Orange4"
+          | Orangered1 => "Orangered1"
+          | Orangered2 => "Orangered2"
+          | Orangered3 => "Orangered3"
+          | Orangered4 => "Orangered4"
+          | Orchid1 => "Orchid1"
+          | Orchid2 => "Orchid2"
+          | Orchid3 => "Orchid3"
+          | Orchid4 => "Orchid4"
+          | Owerblue => "Owerblue"
+          | Palegoldenrod => "Palegoldenrod"
+          | Palegreen1 => "Palegreen1"
+          | Palegreen2 => "Palegreen2"
+          | Palegreen3 => "Palegreen3"
+          | Palegreen4 => "Palegreen4"
+          | Paleturquoise1 => "Paleturquoise1"
+          | Paleturquoise2 => "Paleturquoise2"
+          | Paleturquoise3 => "Paleturquoise3"
+          | Paleturquoise4 => "Paleturquoise4"
+          | Palevioletred1 => "Palevioletred1"
+          | Palevioletred2 => "Palevioletred2"
+          | Palevioletred3 => "Palevioletred3"
+          | Palevioletred4 => "Palevioletred4"
+          | Papayawhip => "Papayawhip"
+          | Peachpu1 => "Peachpu1"
+          | Peachpu2 => "Peachpu2"
+          | Peachpu3 => "Peachpu3"
+          | Peachpu4 => "Peachpu4"
+          | Peru => "Peru"
+          | Pink1 => "Pink1"
+          | Pink2 => "Pink2"
+          | Pink3 => "Pink3"
+          | Pink4 => "Pink4"
+          | Plum1 => "Plum1"
+          | Plum2 => "Plum2"
+          | Plum3 => "Plum3"
+          | Plum4 => "Plum4"
+          | Powderblue => "Powderblue"
+          | Purple1 => "Purple1"
+          | Purple2 => "Purple2"
+          | Purple3 => "Purple3"
+          | Purple4 => "Purple4"
+          | Rebrick1 => "Rebrick1"
+          | Rebrick2 => "Rebrick2"
+          | Rebrick3 => "Rebrick3"
+          | Rebrick4 => "Rebrick4"
+          | Red1 => "Red1"
+          | Red2 => "Red2"
+          | Red3 => "Red3"
+          | Red4 => "Red4"
+          | Rosybrown1 => "Rosybrown1"
+          | Rosybrown2 => "Rosybrown2"
+          | Rosybrown3 => "Rosybrown3"
+          | Rosybrown4 => "Rosybrown4"
+          | Royalblue1 => "Royalblue1"
+          | Royalblue2 => "Royalblue2"
+          | Royalblue3 => "Royalblue3"
+          | Royalblue4 => "Royalblue4"
+          | Saddlebrown => "Saddlebrown"
+          | Salmon1 => "Salmon1"
+          | Salmon2 => "Salmon2"
+          | Salmon3 => "Salmon3"
+          | Salmon4 => "Salmon4"
+          | Sandybrown => "Sandybrown"
+          | Seagreen1 => "Seagreen1"
+          | Seagreen2 => "Seagreen2"
+          | Seagreen3 => "Seagreen3"
+          | Seagreen4 => "Seagreen4"
+          | Seashell1 => "Seashell1"
+          | Seashell2 => "Seashell2"
+          | Seashell3 => "Seashell3"
+          | Seashell4 => "Seashell4"
+          | Sienna1 => "Sienna1"
+          | Sienna2 => "Sienna2"
+          | Sienna3 => "Sienna3"
+          | Sienna4 => "Sienna4"
+          | Skyblue1 => "Skyblue1"
+          | Skyblue2 => "Skyblue2"
+          | Skyblue3 => "Skyblue3"
+          | Skyblue4 => "Skyblue4"
+          | Slateblue1 => "Slateblue1"
+          | Slateblue2 => "Slateblue2"
+          | Slateblue3 => "Slateblue3"
+          | Slateblue4 => "Slateblue4"
+          | Slategray1 => "Slategray1"
+          | Slategray2 => "Slategray2"
+          | Slategray3 => "Slategray3"
+          | Slategray4 => "Slategray4"
+          | Snow1 => "Snow1"
+          | Snow2 => "Snow2"
+          | Snow3 => "Snow3"
+          | Snow4 => "Snow4"
+          | Springgreen1 => "Springgreen1"
+          | Springgreen2 => "Springgreen2"
+          | Springgreen3 => "Springgreen3"
+          | Springgreen4 => "Springgreen4"
+          | Steelblue1 => "Steelblue1"
+          | Steelblue2 => "Steelblue2"
+          | Steelblue3 => "Steelblue3"
+          | Steelblue4 => "Steelblue4"
+          | Tan1 => "Tan1"
+          | Tan2 => "Tan2"
+          | Tan3 => "Tan3"
+          | Tan4 => "Tan4"
+          | Thistle1 => "Thistle1"
+          | Thistle2 => "Thistle2"
+          | Thistle3 => "Thistle3"
+          | Thistle4 => "Thistle4"
+          | Tomato1 => "Tomato1"
+          | Tomato2 => "Tomato2"
+          | Tomato3 => "Tomato3"
+          | Tomato4 => "Tomato4"
+          | Turquoise1 => "Turquoise1"
+          | Turquoise2 => "Turquoise2"
+          | Turquoise3 => "Turquoise3"
+          | Turquoise4 => "Turquoise4"
+          | Violet => "Violet"
+          | Violetred1 => "Violetred1"
+          | Violetred2 => "Violetred2"
+          | Violetred3 => "Violetred3"
+          | Violetred4 => "Violetred4"
+          | Wheat1 => "Wheat1"
+          | Wheat2 => "Wheat2"
+          | Wheat3 => "Wheat3"
+          | Wheat4 => "Wheat4"
+          | White => "White"
+          | Whitesmoke => "Whitesmoke"
+          | Yellow1 => "Yellow1"
+          | Yellow2 => "Yellow2"
+          | Yellow3 => "Yellow3"
+          | Yellow4 => "Yellow4"
+          | Yellowgreen => "Yellowgreen"
    end

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/dot.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/dot.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/dot.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,125 +1,126 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 type int = Int.t
    
 signature DOT =
    sig
       datatype color = datatype DotColor.t
       datatype direction =
-	 Backward
+         Backward
        | Both
        | Forward
        | None
       datatype fontFamily =
-	 Courier
+         Courier
        | Helvetica
        | Symbol
        | Times
       datatype fontWeight =
-	 Bold
+         Bold
        | Italic
        | Roman
       type fontName = fontFamily * fontWeight
       datatype justify =
-	 Center
+         Center
        | Left
        | Right
       datatype orientation =
-	 Landscape
+         Landscape
        | Portrait
       datatype polygonOption =
-	 Distortion of real (* -1.0 <= r <= 1.0 *)
+         Distortion of real (* -1.0 <= r <= 1.0 *)
        | Orientation of int (* 0 <= i <= 360.  Clockwise rotation from
-			     * X axis in degrees.
-			     *)
+                             * X axis in degrees.
+                             *)
        | Peripheries of int
        | Skew of real (* -1.0 <= r <= 1.0 *)
       datatype rank = Max | Min | Same
       datatype rankDir =
-	 LeftToRight
+         LeftToRight
        | TopToBottom
       datatype ratio =
-	 Auto
+         Auto
        | Compress
        | Fill
        | WidthOverHeight of real
       datatype shape =
-	 Box
+         Box
        | Circle
        | Diamond
        | Ellipse
        | Plaintext
        | Polygon of {sides: int,
-		     options: polygonOption list}
+                     options: polygonOption list}
       datatype style =
-	 BoldStyle
+         BoldStyle
        | Dashed
        | Dotted
        | Filled
        | Invisible
        | Solid
       structure EdgeOption:
-	 sig
-	    datatype t =
-	       Color of color
-	     | Decorate of bool (* connect edge label to edge *)
-	     | Dir of direction
-	     | FontColor of color
-	     | FontName of fontName
-	     | FontSize of int (* points *)
-	     | Label of (string * justify) list
-	     | Minlen of int
-	     | Style of style
-	     | Weight of int
+         sig
+            datatype t =
+               Color of color
+             | Decorate of bool (* connect edge label to edge *)
+             | Dir of direction
+             | FontColor of color
+             | FontName of fontName
+             | FontSize of int (* points *)
+             | Label of (string * justify) list
+             | Minlen of int
+             | Style of style
+             | Weight of int
 
-	    val label: string -> t (* label s = Label (s, Center) *)
-	 end
+            val label: string -> t (* label s = Label (s, Center) *)
+         end
       structure NodeOption:
-	 sig
-	    datatype t =
-	       Color of color
-	     | FontColor of color
-	     | FontName of fontName
-	     | FontSize of int (* points *)
-	     | Height of real (* inches *)
-	     | Label of (string * justify) list
-	     | Shape of shape
-	     | Width of real (* inches *)
+         sig
+            datatype t =
+               Color of color
+             | FontColor of color
+             | FontName of fontName
+             | FontSize of int (* points *)
+             | Height of real (* inches *)
+             | Label of (string * justify) list
+             | Shape of shape
+             | Width of real (* inches *)
 
-	    val label: string -> t (* label s = Label (s, Center) *)
-	 end
+            val label: string -> t (* label s = Label (s, Center) *)
+         end
       structure GraphOption:
-	 sig
-	    datatype t =
-	       Center of bool
-	     | Color of color (* *)
-	     | Concentrate of bool
-	     | FontColor of color
-	     | FontName of fontName
-	     | FontSize of int (* points *)
-	     | Label of string
-	     | Margin of real * real (* inches *)
-	     | Mclimit of real (* mincross iterations multiplier *)
-	     | NodeSep of real (* inches *)
-	     | Nslimit of int (* network simplex limit *)
-	     | Orientation of orientation
-	     | Page of {height: real, width: real} (* inches *)
-	     | Rank of rank * {nodeName: string} list
-	     | RankDir of rankDir
-	     | RankSep of real (* inches *)
-	     | Ratio of ratio
-	     | Size of {height: real, width: real} (* inches *)
-	 end
+         sig
+            datatype t =
+               Center of bool
+             | Color of color (* *)
+             | Concentrate of bool
+             | FontColor of color
+             | FontName of fontName
+             | FontSize of int (* points *)
+             | Label of string
+             | Margin of real * real (* inches *)
+             | Mclimit of real (* mincross iterations multiplier *)
+             | NodeSep of real (* inches *)
+             | Nslimit of int (* network simplex limit *)
+             | Orientation of orientation
+             | Page of {height: real, width: real} (* inches *)
+             | Rank of rank * {nodeName: string} list
+             | RankDir of rankDir
+             | RankSep of real (* inches *)
+             | Ratio of ratio
+             | Size of {height: real, width: real} (* inches *)
+         end
 
       val layout: {nodes: {name: string,
-			   options: NodeOption.t list,
-			   successors: {name: string,
-					options: EdgeOption.t list} list
-			   } list,
-		   options: GraphOption.t list,
-		   title: string} -> Layout.t
+                           options: NodeOption.t list,
+                           successors: {name: string,
+                                        options: EdgeOption.t list} list
+                           } list,
+                   options: GraphOption.t list,
+                   title: string} -> Layout.t
    end

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/dot.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/dot.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/dot.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 structure Dot: DOT =
 struct
 
@@ -12,14 +13,14 @@
    (s, fn c =>
     if Char.isPrint c
        then (case c of
-		#"\"" => "\\\""
+                #"\"" => "\\\""
  | #"\\" => "\\\\\\\\"
  | _ => Char.toString c)
     else
        case c of
-	  #"\n" => "\\\\\\\\n"
-	| #"\t" => "\\\\\\\\t"
-	| c => concat ["\\\\\\\\", Int.format (Char.ord c, StringCvt.OCT)])
+          #"\n" => "\\\\\\\\n"
+        | #"\t" => "\\\\\\\\t"
+        | c => concat ["\\\\\\\\", Int.format (Char.ord c, StringCvt.OCT)])
 
 val dquote = "\""
 fun quote s = concat [dquote, s, dquote]
@@ -58,7 +59,7 @@
     | Helvetica => "Helvetica"
     | Symbol => "Symbol"
     | Times => "Times"
-	 
+         
 datatype fontWeight =
    Bold
     | Italic
@@ -68,7 +69,7 @@
    fn Bold => "Bold"
     | Italic => "Italic"
     | Roman => "Roman"
-	 
+         
 type fontName = fontFamily * fontWeight
    
 fun fontNameToString (f, w) =
@@ -91,7 +92,7 @@
 val orientationToString =
    fn Landscape => "landscape"
     | Portrait => "portrait"
-	 
+         
 datatype polygonOption =
    Distortion of real
     | Orientation of int
@@ -100,10 +101,10 @@
 
 fun polygonOptionToString opt =
    lab (case opt of
-	   Distortion r => ("distortion", realToString r)
-	 | Orientation i => ("orientation", intToString i)
-	 | Peripheries p => ("peripheries", intToString p)
-	 | Skew s => ("skew", realToString s))
+           Distortion r => ("distortion", realToString r)
+         | Orientation i => ("orientation", intToString i)
+         | Peripheries p => ("peripheries", intToString p)
+         | Skew s => ("skew", realToString s))
 
 datatype rank = Max | Min | Same
 
@@ -139,7 +140,7 @@
     | Ellipse
     | Plaintext
     | Polygon of {sides: int,
-		  options: polygonOption list}
+                  options: polygonOption list}
 
 val shapeToString =
    fn Box => "box"
@@ -148,15 +149,15 @@
     | Ellipse => "ellipse"
     | Plaintext => "plaintext"
     | Polygon {sides, options} =>
-	 concat
-	 ["polygon, ",
-	  lab ("sides", intToString sides),
-	  case options of
-	     [] => ""
-	   | _ => concat [", ",
-			  optionsToString (options,
-					   polygonOptionToString,
-					   ",")]]
+         concat
+         ["polygon, ",
+          lab ("sides", intToString sides),
+          case options of
+             [] => ""
+           | _ => concat [", ",
+                          optionsToString (options,
+                                           polygonOptionToString,
+                                           ",")]]
 
 datatype style =
    BoldStyle
@@ -176,12 +177,12 @@
 
 fun labelToString (l: (string * justify) list): string =
    concat (List.concatMap (l, fn (s, j) =>
-			   [escapeString s, justifyToString j]))
+                           [escapeString s, justifyToString j]))
    
 structure EdgeOption =
    struct
       datatype t =
-	 Color of color
+         Color of color
        | Decorate of bool (* connect edge label to edge *)
        | Dir of direction
        | FontColor of color
@@ -195,23 +196,23 @@
       fun label s = Label [(s, Center)]
 
       fun toString opt =
-	 lab (case opt of
-		 Color c => ("color", Color.toString c)
-	       | Decorate d => ("decorate", boolToString d)
-	       | Dir d => ("dir", directionToString d)
-	       | FontColor c => ("fontcolor", Color.toString c)
-	       | FontName n => ("fontname", fontNameToString n)
-	       | FontSize s => ("fontsize", intToString s)
-	       | Label l => ("label", labelToString l)
-	       | Minlen n => ("minlen", intToString n)
-	       | Style s => ("style", styleToString s)
-	       | Weight n => ("weight", intToString n))
+         lab (case opt of
+                 Color c => ("color", Color.toString c)
+               | Decorate d => ("decorate", boolToString d)
+               | Dir d => ("dir", directionToString d)
+               | FontColor c => ("fontcolor", Color.toString c)
+               | FontName n => ("fontname", fontNameToString n)
+               | FontSize s => ("fontsize", intToString s)
+               | Label l => ("label", labelToString l)
+               | Minlen n => ("minlen", intToString n)
+               | Style s => ("style", styleToString s)
+               | Weight n => ("weight", intToString n))
    end
 
 structure NodeOption =
    struct
       datatype t =
-	 Color of color
+         Color of color
        | FontColor of color
        | FontName of fontName
        | FontSize of int (* points *)
@@ -223,21 +224,21 @@
       fun label s = Label [(s, Center)]
 
       fun toString opt =
-	 lab (case opt of
-		 Color c => ("color", Color.toString c)
-	       | FontColor c => ("fontcolor", Color.toString c)
-	       | FontName n => ("fontname", fontNameToString n)
-	       | FontSize s => ("fontsize", intToString s)
-	       | Height r => ("height", realToString r)
-	       | Label l => ("label", labelToString l)
-	       | Shape s => ("shape", shapeToString s)
-	       | Width r => ("width", realToString r))
+         lab (case opt of
+                 Color c => ("color", Color.toString c)
+               | FontColor c => ("fontcolor", Color.toString c)
+               | FontName n => ("fontname", fontNameToString n)
+               | FontSize s => ("fontsize", intToString s)
+               | Height r => ("height", realToString r)
+               | Label l => ("label", labelToString l)
+               | Shape s => ("shape", shapeToString s)
+               | Width r => ("width", realToString r))
    end
 
 structure GraphOption =
    struct
       datatype t =
-	 Center of bool
+         Center of bool
        | Color of color (* *)
        | Concentrate of bool
        | FontColor of color
@@ -257,33 +258,33 @@
        | Size of {height: real, width: real} (* inches *)
 
       fun toString opt =
-	 case opt of
-	    Center x => lab ("center", boolToString x)
-	  | Color x => lab ("color", Color.toString x)
-	  | Concentrate x => lab ("concentrate", boolToString x)
-	  | FontColor x => lab ("fontcolor", Color.toString x)
-	  | FontName x => lab ("fontname", fontNameToString x)
-	  | FontSize x => lab ("fontsize", intToString x)
-	  | Label x => lab ("label", escapeString x)
-	  | Margin x => lab ("margin", real2ToString x)
-	  | Mclimit x => lab ("mclimit", realToString x)
-	  | NodeSep x => lab ("nodesep", realToString x)
-	  | Nslimit n => lab ("nslimit", intToString n)
-	  | Orientation x => lab ("orientation", orientationToString x)
-	  | Page {height, width} =>
-	       lab ("page", real2ToString (width, height))
-	  | RankDir x => lab ("rankdir", rankDirToString x)
-	  | Rank (r, ns) =>
-	       concat ["{ ",
-		       lab ("rank ", rankToString r),
-		       "; ",
-		       concat (List.revMap (ns, fn {nodeName} =>
-					    concat [nodeName, " "])),
-		       "}"]
-	  | RankSep x => lab ("ranksep", realToString x)
-	  | Ratio x => lab ("ratio", ratioToString x)
-	  | Size {height, width} =>
-	       lab ("size", real2ToString (width, height))
+         case opt of
+            Center x => lab ("center", boolToString x)
+          | Color x => lab ("color", Color.toString x)
+          | Concentrate x => lab ("concentrate", boolToString x)
+          | FontColor x => lab ("fontcolor", Color.toString x)
+          | FontName x => lab ("fontname", fontNameToString x)
+          | FontSize x => lab ("fontsize", intToString x)
+          | Label x => lab ("label", escapeString x)
+          | Margin x => lab ("margin", real2ToString x)
+          | Mclimit x => lab ("mclimit", realToString x)
+          | NodeSep x => lab ("nodesep", realToString x)
+          | Nslimit n => lab ("nslimit", intToString n)
+          | Orientation x => lab ("orientation", orientationToString x)
+          | Page {height, width} =>
+               lab ("page", real2ToString (width, height))
+          | RankDir x => lab ("rankdir", rankDirToString x)
+          | Rank (r, ns) =>
+               concat ["{ ",
+                       lab ("rank ", rankToString r),
+                       "; ",
+                       concat (List.revMap (ns, fn {nodeName} =>
+                                            concat [nodeName, " "])),
+                       "}"]
+          | RankSep x => lab ("ranksep", realToString x)
+          | Ratio x => lab ("ratio", ratioToString x)
+          | Size {height, width} =>
+               lab ("size", real2ToString (width, height))
    end
 
 fun layout {options, nodes, title: string} =
@@ -293,19 +294,19 @@
       align
       [str (concat ["digraph \"", title, "\" {"]),
        layoutOptions (GraphOption.Label title :: options,
-		      GraphOption.toString, ";"),
+                      GraphOption.toString, ";"),
        align (List.revMap
-	      (nodes, fn {name = from, options, successors} =>
-	       align
-	       [seq [str from,
-		     str " [",
-		     layoutOptions (options, NodeOption.toString, ","),
-		     str "]"],
-		align (List.revMap
-		       (successors, fn {name = to, options} =>
-			seq [str (concat [from, " -> ", to, " ["]),
-			     layoutOptions (options, EdgeOption.toString, ","),
-			     str "]"]))])),
+              (nodes, fn {name = from, options, successors} =>
+               align
+               [seq [str from,
+                     str " [",
+                     layoutOptions (options, NodeOption.toString, ","),
+                     str "]"],
+                align (List.revMap
+                       (successors, fn {name = to, options} =>
+                        seq [str (concat [from, " -> ", to, " ["]),
+                             layoutOptions (options, EdgeOption.toString, ","),
+                             str "]"]))])),
        str "}"]
    end
 

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/doubly-linked.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/doubly-linked.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/doubly-linked.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 functor DoublyLinked(S: DOUBLY_LINKED_STRUCTS): DOUBLY_LINKED = 
 struct
 

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/doubly-linked.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/doubly-linked.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/doubly-linked.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature DOUBLY_LINKED_STRUCTS =
    sig
       type 'a t

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/dynamic-wind.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/dynamic-wind.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/dynamic-wind.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature DYNAMIC_WIND =
    sig
       (* wind(f, g) returns f(), and computes g() when f finishes or raises *)

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/dynamic-wind.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/dynamic-wind.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/dynamic-wind.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,24 +1,14 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 structure DynamicWind: DYNAMIC_WIND =
 struct
 
-fun wind (thunk, cleanup) =
-   let val a = thunk ()
-   in cleanup (); a
-   end handle exn => (cleanup (); raise exn)
+yes
 
-fun windFail (f: unit -> 'a, g: unit -> unit): 'a =
-   f () handle ex => (g (); raise ex)
-
-fun 'a withEscape (f: ('a -> 'b) -> 'a): 'a =
-   let exception E of 'a
-   in f (fn x => raise E x) handle E x => x
-   end
-
 end
 

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/engine.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/engine.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/engine.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 type int = Int.t
    
 signature ENGINE =
@@ -11,14 +12,14 @@
       type 'a t
 
       datatype 'a res =
-	 Done of 'a
+         Done of 'a
        | Raise of exn
        | TimeOut of 'a t
 
       val new: (unit -> 'a) -> 'a t
       val repeat: {thunk: unit -> 'a,
-		   limit: Time.t,
-		   tries: int} -> 'a option
+                   limit: Time.t,
+                   tries: int} -> 'a option
       val run: 'a t * Time.t -> 'a res
       val timeLimit: Time.t * (unit -> 'a) -> 'a option
    end

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/engine.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/engine.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/engine.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,14 +1,15 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 structure Engine: ENGINE =
 struct
 
 datatype 'a t = T of {return: 'a res Thread.t option ref,
-		      thread: Thread.Runnable.t}
+                      thread: Thread.Runnable.t}
 and 'a res =
    Done of 'a
  | Raise of exn
@@ -20,22 +21,22 @@
 fun done (return): unit =
    (return := NONE
     ; Itimer.set (which, {value = Time.zero,
-			  interval = Time.zero})
+                          interval = Time.zero})
     ; Signal.setHandler (signal, Signal.Handler.default))
 
 fun new (f: unit -> 'a): 'a t =
    let
       val return = ref NONE
       val thread =
-	 Thread.new
-	 (fn () =>
-	  let
-	     val res = Done (f ()) handle e => Raise e
-	     val ret = valOf (!return)
-	     val _ = done return
-	  in
-	     Thread.switch (fn _ => Thread.prepare (ret, res))
-	  end)
+         Thread.new
+         (fn () =>
+          let
+             val res = Done (f ()) handle e => Raise e
+             val ret = valOf (!return)
+             val _ = done return
+          in
+             Thread.switch (fn _ => Thread.prepare (ret, res))
+          end)
       val thread = Thread.prepare (thread, ())
    in
       T {return = return, thread = thread}
@@ -47,14 +48,14 @@
     let
        val _ = return := SOME cur
        fun handler (me: Thread.Runnable.t): Thread.Runnable.t =
-	  Thread.prepare
-	  (Thread.prepend (cur, fn () => (done return
-					  ; TimeOut (T {return = return,
-							thread = me}))),
-	   ())
+          Thread.prepare
+          (Thread.prepend (cur, fn () => (done return
+                                          ; TimeOut (T {return = return,
+                                                        thread = me}))),
+           ())
        val _ = Signal.setHandler (signal, Signal.Handler.handler handler)
        val _ = Itimer.set (which, {value = time,
-				   interval = Time.zero})
+                                   interval = Time.zero})
     in
        thread
     end)
@@ -68,11 +69,11 @@
 fun repeat {thunk, limit, tries} =
    let
       fun loop (n: int) =
-	 if n <= 0
-	    then NONE
-	 else (case timeLimit (limit, thunk) of
-		  NONE => loop (n - 1)
-		| SOME a => SOME a)
+         if n <= 0
+            then NONE
+         else (case timeLimit (limit, thunk) of
+                  NONE => loop (n - 1)
+                | SOME a => SOME a)
    in loop tries
    end
 

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/env.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/env.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/env.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 functor Env (S: ENV_STRUCTS): ENV =
 struct
 
@@ -52,8 +53,8 @@
 fun lookup (env, d) = case peek (env, d) of
    SOME r => r
  | NONE => (Layout.output (Domain.layout d, Out.error) ;
-	    Out.newline Out.error ;
-	    Error.bug "lookup")
+            Out.newline Out.error ;
+            Error.bug "Env.lookup")
 
 fun restrict (env, ds) = new (ds, fn d => lookup (env, d))
 
@@ -61,7 +62,7 @@
    case (ds, rs) of
       ([], []) => env
     | (d :: ds, r :: rs) => multiExtend (extend (env, d, r), ds, rs)
-    | _ => Error.bug "multiExtend"
+    | _ => Error.bug "Env.multiExtend"
 
 fun foreach (e, f) = List.foreach (toList e, f o #2)
 fun foreachi (e, f) = List.foreach (toList e, f)
@@ -72,23 +73,23 @@
 fun equals rangeEqual (e1, e2) =
    size e1 = size e2
    andalso foralli (e1, fn (d, r) =>
-		   case peek (e2, d) of
-		      NONE => false
-		    | SOME r' => rangeEqual (r, r'))
+                   case peek (e2, d) of
+                      NONE => false
+                    | SOME r' => rangeEqual (r, r'))
    
 fun layout layoutR (T ps) =
    let open Layout
    in seq [str "[",
-	  align (List.map (ps, fn (d, r) =>
-			 seq [Domain.layout d, str " -> ", layoutR r])),
-	  str"]"]
+          align (List.map (ps, fn (d, r) =>
+                         seq [Domain.layout d, str " -> ", layoutR r])),
+          str"]"]
    end
 
 fun maybeLayout (name, layoutR) env =
    if isEmpty env then Layout.empty
    else let open Layout
-	in seq [str name, str " = ", layout layoutR env]
-	end
+        in seq [str name, str " = ", layout layoutR env]
+        end
 
 end
 

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/env.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/env.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/env.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 type int = Int.t
    
 signature ENV_STRUCTS =

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/error.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/error.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/error.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature ERROR =
     sig
        val bug: string -> 'a

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/error.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/error.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/error.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 structure Error: ERROR =
 struct
    
@@ -11,9 +12,9 @@
 
 fun reraise (exn, msg) =
    bug (concat [msg, "::",
-		case exn of
-		   Fail msg => msg
-		 | _ => "?"])
+                case exn of
+                   Fail msg => msg
+                 | _ => "?"])
 
 fun unimplemented msg = raise Fail (concat ["unimplemented: ", msg])
 

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/escape.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/escape.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/escape.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature ESCAPE =
    sig
       type 'a t

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/escape.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/escape.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/escape.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 structure Escape: ESCAPE =
 struct
 

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/euclidean-ring.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/euclidean-ring.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/euclidean-ring.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 functor EuclideanRing(S: EUCLIDEAN_RING_STRUCTS)
    :> EUCLIDEAN_RING where type t = S.t = 
 struct
@@ -14,13 +15,13 @@
    
 val divMod =
    Trace.traceAssert
-   ("divMod",
+   ("EuclideanRing.divMod",
     Layout.tuple2(layout, layout),
     Layout.tuple2(layout, layout),
     fn (p, q) => (not(equals(q, zero)),
-		  fn (d, m) => (equals(p, q * d + m)
-				andalso (equals(m, zero)
-					 orelse IntInf.<(metric m, metric q)))))
+                  fn (d, m) => (equals(p, q * d + m)
+                                andalso (equals(m, zero)
+                                         orelse IntInf.<(metric m, metric q)))))
    divMod
 
 fun p div q = #1(divMod(p, q))
@@ -30,29 +31,29 @@
 fun divides(d: t, x: t): bool = equals(x mod d, zero)
 
 val divides =
-   Trace.trace("divides", Layout.tuple2(layout, layout), Bool.layout) divides
+   Trace.trace("EuclideanRing.divides", Layout.tuple2(layout, layout), Bool.layout) divides
 
 (* Taken from page 812 of CLR. *)
 fun extendedEuclidTerm(a: t, b: t, done: t * t -> bool, trace): t * t * t =
    let
       fun loop(a, b) =
-	 if done(a, b)
-	    then (a, one, zero)
-	 else let val (d, m) = divMod(a, b)
-		  val (d', x', y') = loop(b, m)
-	      in (d', y', x' - d * y')
-	      end
+         if done(a, b)
+            then (a, one, zero)
+         else let val (d, m) = divMod(a, b)
+                  val (d', x', y') = loop(b, m)
+              in (d', y', x' - d * y')
+              end
    in trace loop(a, b)
    end
 
 fun makeTraceExtendedEuclid f =
    Trace.traceAssert
-   ("extendedEuclid",
+   ("EuclideanRing.extendedEuclid",
     Layout.tuple2(layout, layout),
     Layout.tuple3(layout, layout, layout),
     fn (a, b) => (not(isZero a) andalso not(isZero b),
-		  fn (d, x, y) => (f(d, x, y)
-				   andalso equals(d, a * x + b * y))))
+                  fn (d, x, y) => (f(d, x, y)
+                                   andalso equals(d, a * x + b * y))))
 
 local
    val trace =
@@ -67,29 +68,29 @@
     *)
    fun extendedEuclid(u0: t, u1: t): t * t * t =
       let
-	 val rec loop =
-	    fn (r as {m11, m12, m21, m22, u, v, nEven}) =>
-	    (Assert.assert("extendedEuclid", fn () =>
-			   equals(u0, m11 * u + m12 * v)
-			   andalso equals(u1, m21 * u + m22 * v)
-			   andalso equals(if nEven then one else negOne,
-					  m11 * m22 - m12 * m21))
-	     ; if isZero v
-		  then r
-	       else 
-		  let val (q, r) = divMod(u, v)
-		  in loop{m11 = q * m11 + m12,
-			  m12 = m11,
-			  m21 = q * m21 + m22,
-			  m22 = m21,
-			  u = v,
-			  v = r,
-			  nEven = not nEven}
-		  end)
-	 val {m12, m22, u, nEven, ...} =
-	    loop{m11 = one, m12 = zero, m21 = zero, m22 = one,
-		 u = u0, v = u1, nEven = true}
-	 val (a, b) = if nEven then (m22, ~m12) else (~m22, m12)
+         val rec loop =
+            fn (r as {m11, m12, m21, m22, u, v, nEven}) =>
+            (Assert.assert("EuclideanRing.extendedEuclid", fn () =>
+                           equals(u0, m11 * u + m12 * v)
+                           andalso equals(u1, m21 * u + m22 * v)
+                           andalso equals(if nEven then one else negOne,
+                                          m11 * m22 - m12 * m21))
+             ; if isZero v
+                  then r
+               else 
+                  let val (q, r) = divMod(u, v)
+                  in loop{m11 = q * m11 + m12,
+                          m12 = m11,
+                          m21 = q * m21 + m22,
+                          m22 = m21,
+                          u = v,
+                          v = r,
+                          nEven = not nEven}
+                  end)
+         val {m12, m22, u, nEven, ...} =
+            loop{m11 = one, m12 = zero, m21 = zero, m22 = one,
+                 u = u0, v = u1, nEven = true}
+         val (a, b) = if nEven then (m22, ~m12) else (~m22, m12)
       in (u, a, b)
       end
 
@@ -115,13 +116,13 @@
 val primes: t Stream.t =
    let
       fun loop(s: t Stream.t) =
-	 Stream.delay
-	 (fn () => 
-	  let val (p, s) = valOf(Stream.force s)
-	     val _ = lastPrime := p
-	  in Stream.cons
-	     (p, loop(Stream.keep(s, fn x => not(divides(p, x)))))
-	  end)
+         Stream.delay
+         (fn () => 
+          let val (p, s) = valOf(Stream.force s)
+             val _ = lastPrime := p
+          in Stream.cons
+             (p, loop(Stream.keep(s, fn x => not(divides(p, x)))))
+          end)
    in loop monics
    end
 
@@ -137,49 +138,49 @@
 fun factor(n: t): factors =
    let
       fun loop(n: t, primes: t Stream.t, factors: factors) =
-	 if equals(n, one)
-	    then factors
-	 else let val (p, primes) = valOf(Stream.force primes)
-		  val (n, k) =
-		     let
-			fun loop(n, k) =
-			   let val (q, r) = divMod(n, p)
-			   in if isZero r
-				 then loop(q, Int.+(k, 1))
-			      else (n, k)
-			   end
-		     in loop(n, 0)
-		     end
-	      in loop(n, primes,
-		      if k = 0
-			 then factors
-		      else (p, k) :: factors)
-	      end
+         if equals(n, one)
+            then factors
+         else let val (p, primes) = valOf(Stream.force primes)
+                  val (n, k) =
+                     let
+                        fun loop(n, k) =
+                           let val (q, r) = divMod(n, p)
+                           in if isZero r
+                                 then loop(q, Int.+(k, 1))
+                              else (n, k)
+                           end
+                     in loop(n, 0)
+                     end
+              in loop(n, primes,
+                      if k = 0
+                         then factors
+                      else (p, k) :: factors)
+              end
    in loop(n, primes, [])
    end
 
 val factor =
    Trace.traceAssert
-   ("factor", layout, List.layout (Layout.tuple2(layout, Int.layout)),
+   ("EuclideanRing.factor", layout, List.layout (Layout.tuple2(layout, Int.layout)),
     fn n => (not(isZero n), fn factors =>
-	     equals(n, List.fold(factors, one, fn ((p, k), prod) =>
-				 prod * pow (p, k)))))
+             equals(n, List.fold(factors, one, fn ((p, k), prod) =>
+                                 prod * pow (p, k)))))
    factor
 
 fun existsPrimeOfSmallerMetric(m: IntInf.int, f: t -> bool): bool =
    let
       fun loop primes =
-	 let val (p, primes) = valOf(Stream.force primes)
-	 in IntInf.<(metric p, m)
-	    andalso (f p orelse loop primes)
-	 end
+         let val (p, primes) = valOf(Stream.force primes)
+         in IntInf.<(metric p, m)
+            andalso (f p orelse loop primes)
+         end
    in loop primes
    end
 
 fun isPrime(r: t): bool =
    let val r = unitEquivalent r
    in existsPrimeOfSmallerMetric(IntInf.+ (metric r, 1),
-				 fn p => equals(r, p))
+                                 fn p => equals(r, p))
    end
 
 fun isComposite(r: t): bool =

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/euclidean-ring.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/euclidean-ring.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/euclidean-ring.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature EUCLIDEAN_RING_STRUCTS =
    sig
       include RING_WITH_IDENTITY
@@ -26,7 +27,7 @@
 signature EUCLIDEAN_RING =
    sig
       include EUCLIDEAN_RING_STRUCTS
-	 
+         
       val div: t * t -> t
       val divides: t * t -> bool
       val extendedEuclid: t * t -> t * t * t

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/exn.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/exn.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/exn.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature EXN =
    sig
       type t = exn
@@ -12,7 +13,8 @@
       exception Match
       exception Overflow
       exception Subscript
-      
+
+      val finally: (unit -> 'a) * (unit -> unit) -> 'a
       val history: t -> string list
       val name: t -> string
       val layout: t -> Layout.t
@@ -23,5 +25,6 @@
        * evaluate k v in the context of the handler.  See "Exceptional Syntax"
        * by Benton and Kennedy. 
        *)
-      val try: (unit -> 'a) * ('a -> 'b) * (exn -> 'b) -> 'b
+      val try: (unit -> 'a) * ('a -> 'b) * (t -> 'b) -> 'b
+      val withEscape: (('a -> 'b) -> 'a) -> 'a
    end

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/exn.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/exn.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/exn.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,49 +1,27 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 structure Exn:> EXN =
 struct
 
-type t = exn
-
-val history = MLton.Exn.history
+open Exn0
    
-val name = General.exnName
-
-exception Bind = Bind
-exception Match = Match
-exception Overflow = Overflow
-exception Subscript = Subscript
-   
 fun layout e =
    let
       open Layout
    in
       case e of
-	 OS.SysErr (s, _) => str s
+         OS.SysErr (s, _) => str s
        | Fail s => str s
        | IO.Io {cause, function, name, ...} =>
-	    seq [str (concat [function, " ", name, ": "]), layout cause]
+            seq [str (concat [function, " ", name, ": "]), layout cause]
        | _ => seq [str "unhandled exception: ", str (exnName e)]
    end
 
 val toString = Layout.toString o layout
 
-local
-   (* would like to make the declaration of z in a let inside the try function,
-    * with 'a as a free type variable.  But SML/NJ doesn't allow it.
-    *)
-   datatype 'a z = Ok of 'a | Raise of exn
-in
-   val try: (unit -> 'a) * ('a -> 'b) * (exn -> 'b) -> 'b =
-      fn (t, k, h) =>
-      case Ok (t ()) handle e => Raise e of
-	 Ok x => k x
-       | Raise e => h e
 end
-
-end

Copied: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/exn0.sml (from rev 4358, mlton/trunk/lib/mlton/basic/exn0.sml)

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/export.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/export.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/export.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature EXPORT =
    sig
       val exportFn: File.t * (string * string list -> OS.Process.status) -> unit

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/export.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/export.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/export.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 structure Export: EXPORT =
 struct
    
@@ -11,9 +12,9 @@
 
 fun exportFn(file, command) =
    NJ.exportFn(File.toString file,
-	       fn arg => ((command arg)
-			  handle exn => (print ("Unhandled exception: "
-						^ exnName exn ^ "\n") ;
-					 raise exn)))
+               fn arg => ((command arg)
+                          handle exn => (print ("Unhandled exception: "
+                                                ^ exnName exn ^ "\n") ;
+                                         raise exn)))
    
 end

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/field.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/field.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/field.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 functor Field(F: FIELD_STRUCTS): FIELD =
 struct
 

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/field.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/field.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/field.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature FIELD_STRUCTS =
    sig
       include RING

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/file-desc.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/file-desc.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/file-desc.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature FILE_DESC =
    sig
       type t = Posix.FileSys.file_desc

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/file-desc.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/file-desc.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/file-desc.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 structure FileDesc: FILE_DESC =
    struct
       open Posix.IO Posix.FileSys
@@ -11,19 +12,19 @@
       type t = file_desc
 
       val layout = Word.layout o fdToWord
-	 
+         
       fun move {from, to} =
-	 if from <> to
-	    then (dup2 {old = from, new = to}
-		  ; close from)
-	 else ()
+         if from <> to
+            then (dup2 {old = from, new = to}
+                  ; close from)
+         else ()
 
       fun fluidLet (d1, d2, f) =
-	 let
-	    val copy = dup d1
-	    val _ = dup2 {old = d2, new = d1}
-	 in
-	    DynamicWind.wind (f, fn () => move {from = copy, to = d1})
-	 end
+         let
+            val copy = dup d1
+            val _ = dup2 {old = d2, new = d1}
+         in
+            Exn.finally (f, fn () => move {from = copy, to = d1})
+         end
    end
    

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/file.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/file.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/file.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature FILE =
    sig
       type t = string
@@ -50,5 +51,5 @@
       val withTemp: (t -> 'a) -> 'a
       val withTempOut: (Out.t -> unit) * (t -> 'a) -> 'a
       val withTempOut':
-	 {prefix: string, suffix: string} * (Out.t -> unit) * (t -> 'a) -> 'a
+         {prefix: string, suffix: string} * (Out.t -> unit) * (t -> 'a) -> 'a
    end

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/file.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/file.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/file.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 structure File:> FILE =
 struct
 
@@ -25,7 +26,7 @@
    let
       val stream = openn file
    in
-      DynamicWind.wind (fn () => p stream, fn () => close stream)
+      Exn.finally (fn () => p stream, fn () => close stream)
    end 
 
 fun withOut (f, p) = withh (f, p, Out.openOut, Out.close)
@@ -49,8 +50,8 @@
 fun remove f =
    if doesExist f
       then (FS.remove f
-	    handle e => Error.bug (concat ["remove ", f, ": ",
-					   Layout.toString (Exn.layout e)]))
+            handle e => Error.bug (concat ["File.remove: ", f, ": ",
+                                           Layout.toString (Exn.layout e)]))
    else ()
 
 local
@@ -65,8 +66,8 @@
 fun sameContents (f1, f2) =
    size f1 = size f2
    andalso withIn (f1, fn in1 =>
-		   withIn (f2, fn in2 =>
-			   In.sameContents (in1, in2)))
+                   withIn (f2, fn in2 =>
+                           In.sameContents (in1, in2)))
 
 fun output (file, out) = Out.output (out, file)
    
@@ -84,7 +85,7 @@
    
 fun concat (sources, dest) =
    withOut (dest, fn out =>
-	   List.foreach (sources, fn f => outputContents (f, out)))
+           List.foreach (sources, fn f => outputContents (f, out)))
 
 val temp = MLton.TextIO.mkstemps
 
@@ -100,18 +101,18 @@
    let
       val name = tempName {prefix = "/tmp/file", suffix = ""}
    in
-      DynamicWind.wind (fn () => f name, fn () => remove name)
+      Exn.finally (fn () => f name, fn () => remove name)
    end
    
-fun withTempOut' (z, f, g) =
+fun withTempOut' (z, f: Out.t -> unit, g) =
    let
       val (name, out) = temp z
    in
-      DynamicWind.wind (fn () =>
-			(DynamicWind.wind (fn () => f out,
-					   fn () => Out.close out)
-			 ; g name),
-			fn () => remove name)
+      Exn.finally (fn () =>
+                   (Exn.finally (fn () => f out,
+                                 fn () => Out.close out)
+                    ; g name),
+                   fn () => remove name)
    end
 
 fun withTempOut (f, g) =
@@ -125,7 +126,7 @@
 
 fun withStringIn (s, fin) =
    withOutIn (fn out => Out.output (out, s),
-	      fin)
+              fin)
 
 fun create f = withOut (f, fn _ => ())
 

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/fixed-point.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/fixed-point.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/fixed-point.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,14 +1,15 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature FIXED_POINT = 
    sig
       val fix: {start: 'a,
-		step: 'a -> 'a,
-		equals: 'a * 'a -> bool} -> 'a
+                step: 'a -> 'a,
+                equals: 'a * 'a -> bool} -> 'a
 
       val fix': ((unit -> unit) -> unit) -> unit
    end

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/fixed-point.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/fixed-point.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/fixed-point.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,32 +1,33 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 structure FixedPoint: FIXED_POINT =
 struct
 
 fun fix{start, step, equals} =
    let
       fun loop s =
-	 let val s' = step s
-	 in if equals(s, s')
-	       then s
-	    else loop s'
-	 end
+         let val s' = step s
+         in if equals(s, s')
+               then s
+            else loop s'
+         end
    in loop start
    end
 
-fun fix' f =
+fun fix' (f: (unit -> unit) -> unit) =
    let
       fun loop() =
-	 let val changed = ref false
-	 in f(fn () => changed := true);
-	    if !changed
-	       then loop()
-	    else ()
-	 end
+         let val changed = ref false
+         in f(fn () => changed := true);
+            if !changed
+               then loop()
+            else ()
+         end
    in loop()
    end
 

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/fold.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/fold.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/fold.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 functor Fold (S: FOLD_STRUCTS): FOLD = 
 struct
 
@@ -21,7 +22,7 @@
 
 fun last l =
    case fold (l, NONE, SOME o #1) of
-      NONE => Error.bug "last"
+      NONE => Error.bug "Fold.last"
     | SOME x => x
    
 fun length l = fold (l, 0: int, fn (_, n) => n + 1)
@@ -34,9 +35,9 @@
 
 fun revKeepAllMap (l, f) =
    fold (l, [], fn (x, ac) =>
-	 case f x of
-	    NONE => ac
-	  | SOME y => y :: ac)
+         case f x of
+            NONE => ac
+          | SOME y => y :: ac)
 
 fun keepAllMap z = rev (revKeepAllMap z)
 

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/fold.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/fold.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/fold.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 type int = Pervasive.Int.int
       
 signature FOLD_STRUCTS = 

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/format.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/format.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/format.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 type int = Int.t
    
 signature FORMAT =
@@ -27,7 +28,7 @@
 
 val _ =
    Assert.assert
-   ("format", fn () => 
+   ("TestFormat", fn () => 
     "abc" = format (lit "abc")
     andalso "abc" = format string "abc"
     andalso "abc" = format (lit "a" o lit "b" o lit "c")

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/format.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/format.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/format.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 (*
  * This is based on
  *   Functional Unparsing
@@ -24,7 +25,7 @@
 val eol: ('a, 'a) t = fn z => lit "\n" z
 
 (* val concat =
- *    Trace.trace ("concat", List.layout String.layout, String.layout) concat
+ *    Trace.trace ("Format.concat", List.layout String.layout, String.layout) concat
  *)
    
 val format: (string, 'a) t -> 'a = fn f => f (concat o rev, [])
@@ -35,13 +36,13 @@
    fn f => fn (k, ss) =>
    fn [] => k ("[]" :: ss)
     | x :: xs =>
-	 let
-	    fun loop xs ss =
-	       case xs of
-		  [] => k ("]" :: ss)
-		| x :: xs => f (loop xs, ", " :: ss) x
-	 in f (loop xs, "[" :: ss) x
-	 end
+         let
+            fun loop xs ss =
+               case xs of
+                  [] => k ("]" :: ss)
+                | x :: xs => f (loop xs, ", " :: ss) x
+         in f (loop xs, "[" :: ss) x
+         end
 
 val op o: ('a, 'b) t * ('c, 'a) t -> ('c, 'b) t =
    fn (f, g) => fn (k, ss) => f (fn ss => g (k, ss), ss)

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/function.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/function.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/function.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature FUNCTION =
    sig
       val curry: ('a * 'b -> 'c) -> ('a -> 'b -> 'c)

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/function.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/function.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/function.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 structure Function: FUNCTION =
 struct
 

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/hash-set.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/hash-set.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/hash-set.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 type int = Int.t
 type word = Word.t
 
@@ -22,7 +23,7 @@
        * NOTE: f must not modify the hash set during its evaluation.
        *)
       val insertIfNew:
-	 'a t * word * ('a -> bool) * (unit -> 'a) * ('a -> unit) -> 'a
+         'a t * word * ('a -> bool) * (unit -> 'a) * ('a -> unit) -> 'a
       val layout: ('a -> Layout.t) -> 'a t -> Layout.t
       (* lookupOrInsert (s, h, p, f)  looks in the set s for an entry with hash h
        * satisfying predicate p.  If the entry is there, it is returned.
@@ -36,7 +37,7 @@
        * creates a table that can handle size elements without resizing.
        *)
       val newOfSize: {hash: 'a -> word,
-		      size: int} -> 'a t
+                      size: int} -> 'a t
       val peek: 'a t * word * ('a -> bool) -> 'a option
       (* remove an entry.  Error if it's not there. *)
       val remove: 'a t * word * ('a -> bool) -> unit
@@ -54,6 +55,6 @@
 
 open S
 
-val _ = Assert.assert("HashSet", fn () => true)
+val _ = Assert.assert("TestHashSet", fn () => true)
 
 end

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/hash-set.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/hash-set.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/hash-set.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,36 +1,37 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 structure HashSet: HASH_SET =
 struct
 
 datatype 'a t =
    T of {buckets: 'a list array ref,
-	 hash: 'a -> word,
-	 mask: word ref,
-	 numItems: int ref}
+         hash: 'a -> word,
+         mask: word ref,
+         numItems: int ref}
    
 fun 'a newWithBuckets {hash, numBuckets: int}: 'a t =
    let
       val mask: word = Word.fromInt numBuckets - 0w1
    in
       T {buckets = ref (Array.new (numBuckets, [])),
-	 hash = hash,
-	 numItems = ref 0,
-	 mask = ref mask}
+         hash = hash,
+         numItems = ref 0,
+         mask = ref mask}
    end
 
 val initialSize: int = Int.pow (2, 6)
 
 fun new {hash} = newWithBuckets {hash = hash,
-				 numBuckets = initialSize}
+                                 numBuckets = initialSize}
 
 fun newOfSize {hash, size} =
    newWithBuckets {hash = hash,
-		   numBuckets = 4 * Int.roundUpToPowerOfTwo size}
+                   numBuckets = 4 * Int.roundUpToPowerOfTwo size}
 
 fun size (T {numItems, ...}) = !numItems
 
@@ -45,10 +46,10 @@
    in align
       [seq [str "numPeeks = ", Int.layout (!numPeeks)],
        seq [str "average position in bucket = ",
-	    str let open Real
-		in format (fromInt (!numLinks) / fromInt (!numPeeks),
-			   Format.fix (SOME 3))
-		end]]
+            str let open Real
+                in format (fromInt (!numLinks) / fromInt (!numPeeks),
+                           Format.fix (SOME 3))
+                end]]
    end
 
 fun stats' (T {buckets, numItems, ...}) =
@@ -58,60 +59,60 @@
        val numb' = numb - 1
        val avg = let open Real in (fromInt numi / fromInt numb) end
        val (min,max,total)
-	 = Array.fold
-	   (!buckets,
-	    (Int.maxInt, Int.minInt, 0.0),
-	    fn (l,(min,max,total)) 
-	     => let
-		  val n = List.length l
-		  val d = (Real.fromInt n) - avg
-		in
-		  (Int.min(min,n),
-		   Int.max(max,n),
-		   total + d * d)
-		end)
+         = Array.fold
+           (!buckets,
+            (Int.maxInt, Int.minInt, 0.0),
+            fn (l,(min,max,total)) 
+             => let
+                  val n = List.length l
+                  val d = (Real.fromInt n) - avg
+                in
+                  (Int.min(min,n),
+                   Int.max(max,n),
+                   total + d * d)
+                end)
        val stdd = let open Real in Math.sqrt(total / (fromInt numb')) end
        val rfmt = fn r => Real.format (r, Real.Format.fix (SOME 3))
    in align
       [seq [str "numItems = ", Int.layout numi],
        seq [str "numBuckets = ", Int.layout numb],
        seq [str "avg = ", str (rfmt avg),
-	    str " stdd = ", str (rfmt stdd),
-	    str " min = ", Int.layout min, 
-	    str " max = ", Int.layout max]]
+            str " stdd = ", str (rfmt stdd),
+            str " min = ", Int.layout min, 
+            str " max = ", Int.layout max]]
    end
 
 fun resize (T {buckets, hash, mask, ...}, size: int, newMask: word): unit =
    let
       val newBuckets = Array.new (size, [])
    in Array.foreach (!buckets, fn r =>
-		     List.foreach (r, fn a =>
-				   let val j = index (hash a, newMask)
-				   in Array.update
-				      (newBuckets, j,
-				       a :: Array.sub (newBuckets, j))
-				   end))
+                     List.foreach (r, fn a =>
+                                   let val j = index (hash a, newMask)
+                                   in Array.update
+                                      (newBuckets, j,
+                                       a :: Array.sub (newBuckets, j))
+                                   end))
       ; buckets := newBuckets
       ; mask := newMask
    end
-   	       
+               
 fun maybeGrow (s as T {buckets, mask, numItems, ...}): unit =
    let
       val n = Array.length (!buckets)
    in if !numItems * 4 > n
-	 then resize (s,
-		      n * 2,
-		      (* The new mask depends on growFactor being 2. *)
-		      Word.orb (0w1, Word.<< (!mask, 0w1)))
+         then resize (s,
+                      n * 2,
+                      (* The new mask depends on growFactor being 2. *)
+                      Word.orb (0w1, Word.<< (!mask, 0w1)))
       else ()
    end
 
 fun removeAll (T {buckets, numItems, ...}, p) =
    Array.modify (!buckets, fn elts =>
-		 List.fold (elts, [], fn (a, ac) =>
-			    if p a
-			       then (Int.dec numItems; ac)
-			    else a :: ac))
+                 List.fold (elts, [], fn (a, ac) =>
+                            if p a
+                               then (Int.dec numItems; ac)
+                            else a :: ac))
 
 fun remove (T {buckets, mask, numItems, ...}, w, p) =
    let
@@ -139,22 +140,23 @@
  *    let
  *       val j = index (hash a, !mask)
  *       val _ =
- * 	 Array.update (buckets, j,
- * 		       a :: (List.remove (Array.sub (buckets, j),
- * 					  fn a' => equals (a, a'))))
+ *       Array.update (buckets, j,
+ *                     a :: (List.remove (Array.sub (buckets, j),
+ *                                        fn a' => equals (a, a'))))
  *    in ()
  *    end
  *)
 
-fun insertIfNew (table as T {buckets, numItems, ...}, w, p, f, g) =
+fun insertIfNew (table as T {buckets, numItems, ...}, w, p, f, 
+                 g: 'a -> unit) =
    let
       fun no (j, b) =
-	 let val a = f ()
-	    val _ = Int.inc numItems
-	    val _ = Array.update (!buckets, j, a :: b)
-	    val _ = maybeGrow table
-	 in a
-	 end
+         let val a = f ()
+            val _ = Int.inc numItems
+            val _ = Array.update (!buckets, j, a :: b)
+            val _ = maybeGrow table
+         in a
+         end
       fun yes x = (g x; x)
    in peekGen (table, w, p, no, yes)
    end
@@ -167,8 +169,8 @@
 
 local
    structure F = Fold (type 'a t = 'a t
-		       type 'a elt = 'a
-		       val fold = fold)
+                       type 'a elt = 'a
+                       val fold = fold)
    open F
 in
    val foreach = foreach
@@ -185,10 +187,10 @@
    let
       val s = new {hash = hash}
       val () =
-	 List.foreach (l, fn a =>
-		       ignore (lookupOrInsert (s, hash a,
-					       fn b => equals (a, b),
-					       fn _ => a)))
+         List.foreach (l, fn a =>
+                       ignore (lookupOrInsert (s, hash a,
+                                               fn b => equals (a, b),
+                                               fn _ => a)))
    in
       s
    end

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/hash-table.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/hash-table.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/hash-table.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,18 +1,18 @@
-(* This code is not working -- it is not even in sources.cm *)
-
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
+(* This code is not working -- it is not even in sources.cm *)
 type int = Int.t
 type word = Word.t
    
 signature HASH_TABLE =
    sig
       type ('a, 'b) t
-	 
+         
       val fold: ('a, 'b) t * 'c * ('b * 'c -> 'c) -> 'c
       val foldi: ('a, 'b) t * 'c * ('a * 'b * 'c -> 'c) -> 'c
       val forall: ('a, 'b) t * ('b -> bool) -> bool
@@ -30,7 +30,7 @@
       val map: ('a, 'b) t * ('b -> 'c) -> ('a, 'c) t
       val mapi: ('a, 'b) t * ('a * 'b -> 'c) -> ('a, 'c) t
       val new: {equals: 'a * 'a -> bool,
-		hash: 'a -> word} -> ('a, 'b) t
+                hash: 'a -> word} -> ('a, 'b) t
       val peek: ('a, 'b) t * 'a -> 'b option
       val size: ('a, 'b) t -> int
       val stats: unit -> Layout.t
@@ -44,29 +44,29 @@
 
 val _ =
    Assert.assert
-   ("HashTable", fn () => 
+   ("TestHashTable", fn () => 
     let val t = new Int.equals
        val n = 10
        val hash = Word.fromInt
        val _ =
-	  Int.for(0, n, fn i =>
-		  (lookupOrInsert(t, hash i, i, fn () => i * 2)
-		   ; ()))
+          Int.for(0, n, fn i =>
+                  (lookupOrInsert(t, hash i, i, fn () => i * 2)
+                   ; ()))
        val sum = Int.fold(0, n, 0, op +)
     in
        let val r = ref 0
        in foreach (t, fn j => r := !r + j)
-	  ; 2 * sum = !r
+          ; 2 * sum = !r
        end
     andalso Int.forall(0, n, fn i => Option.isSome(peek(t, hash i, i)))
     andalso foralli(t, fn (i, j) => j = 2 * i)
     andalso n = List.length(listItems t)
     andalso n = List.length(listItemsi t)
     andalso let val t' = map(t, fn j => j div 2)
-	    in n = size t'
-	       andalso foralli(t', fn (i, j) => i = j)
-	    end
-	 andalso n = size t
+            in n = size t'
+               andalso foralli(t', fn (i, j) => i = j)
+            end
+         andalso n = size t
     end)
    
 end

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/hash-table.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/hash-table.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/hash-table.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,11 +1,11 @@
-(* This code is not working -- it is not even in sources.cm *)
-
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
+(* This code is not working -- it is not even in sources.cm *)
 structure HashTable: HASH_TABLE =
 struct
 
@@ -15,7 +15,7 @@
 
 fun ('a, 'b) new {equals, hash}: ('a, 'b) t =
    Set.new {equals = fn ((a, _), (a', _)) => equals (a, a')
-	    hash = hash o #1}
+            hash = hash o #1}
 
 local
    open Set
@@ -33,13 +33,13 @@
    let
       val j = index (w, !mask)
       val _ =
-	 Array.update
-	 (buckets, j,
-	  (w, a, b)
-	  :: List.fold (Array.sub (buckets, j), [], fn (z as (w', a', _), ac) =>
-			if Word.equals (w, w') andalso equals (a, a')
-			   then ac
-			else z :: ac))
+         Array.update
+         (buckets, j,
+          (w, a, b)
+          :: List.fold (Array.sub (buckets, j), [], fn (z as (w', a', _), ac) =>
+                        if Word.equals (w, w') andalso equals (a, a')
+                           then ac
+                        else z :: ac))
    in ()
    end
 
@@ -48,12 +48,12 @@
 fun lookupGen (table as T {buckets, numItems, ...}, w, i, x, yes) =
    let
       fun no (j, b) =
-	 let val x = x ()
-	    val _ = Int.inc numItems
-	    val _ = Array.update (!buckets, j, (w, i, x) :: b)
-	    val _ = maybeGrow table
-	 in x
-	 end
+         let val x = x ()
+            val _ = Int.inc numItems
+            val _ = Array.update (!buckets, j, (w, i, x) :: b)
+            val _ = maybeGrow table
+         in x
+         end
    in peekGen (table, w, i, no, yes)
    end
 
@@ -65,7 +65,7 @@
    
 fun foldi(T{buckets, ...}, b, f) =
    Array.fold(!buckets, b, fn (r, b) =>
-	      List.fold(r, b, fn ((_, i, x), b) => f(i, x, b)))
+              List.fold(r, b, fn ((_, i, x), b) => f(i, x, b)))
 
 fun listItemsi t = foldi(t, [], fn (i, x, l) => (i, x) :: l)
 
@@ -96,8 +96,8 @@
       mask = ref (!mask),
       equals = equals,
       buckets = ref (Array.map (!buckets, fn r =>
-				List.revMap (r, fn (w, i, x) =>
-					     (w, i, f (i, x)))))}
+                                List.revMap (r, fn (w, i, x) =>
+                                             (w, i, f (i, x)))))}
 
 fun map (t, f) = mapi (t, f o #2)
 

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/het-container.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/het-container.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/het-container.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,19 +1,20 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 functor ExnHetContainer():> HET_CONTAINER =
    struct
       type t = exn
 
       fun 'a new() =
-	 let exception E of 'a
-	 in {make = E,
-	     pred = fn E _ => true | _ => false,
-	     peek = fn E x => SOME x | _ => NONE}
-	 end
+         let exception E of 'a
+         in {make = E,
+             pred = fn E _ => true | _ => false,
+             peek = fn E x => SOME x | _ => NONE}
+         end
    end
 
 functor RefHetContainer():> HET_CONTAINER =
@@ -21,14 +22,14 @@
       type t = unit ref * (unit -> unit)
 
       fun 'a new() =
-	 let
-	    val id = ref()
-	    val r: 'a option ref = ref NONE
-	    fun make v = (id, fn () => r := SOME v)
-	    fun peek(id', f) =
-	       if id = id' then (f(); !r before r := NONE)
-	       else NONE
-	    fun pred(id', _) = id = id'
-	 in {make = make, pred = pred, peek = peek}
-	 end
+         let
+            val id = ref()
+            val r: 'a option ref = ref NONE
+            fun make v = (id, fn () => r := SOME v)
+            fun peek ((id', f): t) =
+               if id = id' then (f(); !r before r := NONE)
+               else NONE
+            fun pred(id', _) = id = id'
+         in {make = make, pred = pred, peek = peek}
+         end
    end

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/het-container.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/het-container.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/het-container.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,14 +1,15 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature HET_CONTAINER =
    sig
       type t
 
       val new: unit -> {make: 'a -> t,
-			pred: t -> bool,
-			peek: t -> 'a option}
+                        pred: t -> bool,
+                        peek: t -> 'a option}
    end

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/html.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/html.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/html.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,45 +1,46 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 type int = Int.t
    
 signature HTML = 
    sig
       structure Align:
-	 sig
-	    datatype t = Left | Center | Right
-	 end
+         sig
+            datatype t = Left | Center | Right
+         end
       structure Element:
-	 sig
-	    type t
+         sig
+            type t
 
-	    datatype tableOption =
-	       Border of int
-	     | CellPadding of int
-	     | CellSpacing of int
+            datatype tableOption =
+               Border of int
+             | CellPadding of int
+             | CellSpacing of int
 
-	    val a: Url.t * t -> t
-	    val br: t
-	    val img: {src: Url.t} -> t
-	    val layout: t -> Layout.t
-	    val pre: t -> t
-	    val seq: t list -> t
-	    val str: string -> t
-	    val tt: t -> t
-	    val table: tableOption list * t list list -> t
-	 end
+            val a: Url.t * t -> t
+            val br: t
+            val img: {src: Url.t} -> t
+            val layout: t -> Layout.t
+            val pre: t -> t
+            val seq: t list -> t
+            val str: string -> t
+            val tt: t -> t
+            val table: tableOption list * t list list -> t
+         end
       structure Option:
-	 sig
-	    datatype t =
-	       Redirect of {seconds: int,
-			    uri: Url.t}
-	     | Title of string
-	 end
+         sig
+            datatype t =
+               Redirect of {seconds: int,
+                            uri: Url.t}
+             | Title of string
+         end
 
       datatype t = T of {options: Option.t list,
-			 body: Element.t}
+                         body: Element.t}
       val layout: t -> Layout.t
    end

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/html.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/html.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/html.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,22 +1,23 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 structure Html:> HTML = 
 struct
 
 fun tag (name: string,
-	attributes: (string * string) list,
-	body: Layout.t) =
+        attributes: (string * string) list,
+        body: Layout.t) =
    let open Layout
    in seq [str "<", str name, 
-	   seq (List.map (attributes, fn (name, value) =>
-			  str (concat [" ", name, " = ", value]))),
-	   str ">",
-	   body,
-	   str (concat ["</", name, ">"])]
+           seq (List.map (attributes, fn (name, value) =>
+                          str (concat [" ", name, " = ", value]))),
+           str ">",
+           body,
+           str (concat ["</", name, ">"])]
    end
 
 structure Align =
@@ -24,10 +25,10 @@
       datatype t = Left | Center | Right
 
       fun toString a =
-	 case a of
-	    Left => "left"
-	  | Center => "center"
-	  | Right => "right"
+         case a of
+            Left => "left"
+          | Center => "center"
+          | Right => "right"
 
       fun attribute a = ("align", toString a)
    end
@@ -35,12 +36,12 @@
 structure Element =
    struct
       datatype tableOption =
-	 Border of int
+         Border of int
        | CellPadding of int
        | CellSpacing of int
 
       datatype t =
-	 A of Url.t * t
+         A of Url.t * t
        | Br
        | H1 of Align.t * t
        | Img of {src: Url.t}
@@ -64,61 +65,61 @@
 
       fun layoutAe ((a, e), s) = tag (s, [Align.attribute a], layout e) 
       and layout e =
-	 let open Layout
-	 in case e of
-	    A (u, e) => tag ("A", [("href", Url.toString u)], layout e)
-	  | Br => align [empty, tag ("BR", [], empty)]
-	  | H1 ae => layoutAe (ae, "H1")
-	  | Img {src, ...} => tag ("IMAGE", [("src", Url.toString src)], empty)
-	  | P ae => layoutAe (ae, "P")
-	  | Pre t => tag ("PRE", [], layout t)
-	  | Seq es => seq (List.map (es, layout))
-	  | String s => str s
-	  | Table (options, rows) =>
-	       tag ("TABLE",
-		   List.map (options,
-			    fn Border n => ("BORDER", Int.toString n)
-			     | CellPadding n => ("CELLPADDING", Int.toString n)
-			     | CellSpacing n => ("CELLSPACING", Int.toString n)),
-		   seq (List.map (rows, fn cols =>
-				tag ("TR", [],
-				    seq (List.map (cols, fn c =>
-						 tag ("TH", [], layout c)))))))
-	  | Tt t => tag ("TT", [], layout t)
-	 end
+         let open Layout
+         in case e of
+            A (u, e) => tag ("A", [("href", Url.toString u)], layout e)
+          | Br => align [empty, tag ("BR", [], empty)]
+          | H1 ae => layoutAe (ae, "H1")
+          | Img {src, ...} => tag ("IMAGE", [("src", Url.toString src)], empty)
+          | P ae => layoutAe (ae, "P")
+          | Pre t => tag ("PRE", [], layout t)
+          | Seq es => seq (List.map (es, layout))
+          | String s => str s
+          | Table (options, rows) =>
+               tag ("TABLE",
+                   List.map (options,
+                            fn Border n => ("BORDER", Int.toString n)
+                             | CellPadding n => ("CELLPADDING", Int.toString n)
+                             | CellSpacing n => ("CELLSPACING", Int.toString n)),
+                   seq (List.map (rows, fn cols =>
+                                tag ("TR", [],
+                                    seq (List.map (cols, fn c =>
+                                                 tag ("TH", [], layout c)))))))
+          | Tt t => tag ("TT", [], layout t)
+         end
    end
 
 structure Option =
    struct
       datatype t =
-	 Redirect of {seconds: int,
-		      uri: Url.t}
+         Redirect of {seconds: int,
+                      uri: Url.t}
        | Title of string
 
       fun layout (opt: t): Layout.t =
-	 case opt of
-	    Redirect {seconds, uri} =>
-	       tag ("META", [("HTTP-EQUIV", "Refresh"),
-			    ("Content",
-			     concat [String.dquote,
-				    Int.toString seconds,
-				    "; URL=", Url.toString uri,
-				    String.dquote])],
-		   Layout.empty)
-	  | Title s => tag ("TITLE", [], Layout.str s)
+         case opt of
+            Redirect {seconds, uri} =>
+               tag ("META", [("HTTP-EQUIV", "Refresh"),
+                            ("Content",
+                             concat [String.dquote,
+                                    Int.toString seconds,
+                                    "; URL=", Url.toString uri,
+                                    String.dquote])],
+                   Layout.empty)
+          | Title s => tag ("TITLE", [], Layout.str s)
    end
 
 datatype t =
    T of {options: Option.t list,
-	 body: Element.t}
+         body: Element.t}
   
 fun layout (T {options, body}) =
    let open Layout
    in align
       [str "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 3.2//EN\">",
        tag ("HTML", [],
-	   align [tag ("HEAD", [], align (List.map (options, Option.layout))),
-		 tag ("BODY", [], Element.layout (body))])]
+           align [tag ("HEAD", [], align (List.map (options, Option.layout))),
+                 tag ("BODY", [], Element.layout (body))])]
    end
 
 end

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/http.mlb
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/http.mlb	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/http.mlb	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,10 @@
+(* Copyright (C) 2004-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 local
    $(SML_LIB)/basis/basis.mlb
    $(SML_LIB)/basis/mlton.mlb
@@ -21,4 +28,3 @@
    structure Http
    structure Url
 end
-     

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/http.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/http.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/http.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,208 +1,209 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 (* Based on RFC 2616. *)
-
 type int = Int.t
 
 signature HTTP =
    sig
       structure Method:
-	 sig
-	    datatype t =
-	       Connect
-	     | Delete
-	     | Get
-	     | Head
-	     | Options
-	     | Post
-	     | Put
-	     | Trace
-	     | Extension of string
-	 end
+         sig
+            datatype t =
+               Connect
+             | Delete
+             | Get
+             | Head
+             | Options
+             | Post
+             | Put
+             | Trace
+             | Extension of string
+         end
       
       structure RequestUrl:
-	 sig
-	    datatype t =
-	       Star
-	     | Url of Url.t
-	     | Path of {path: Url.Path.t,
-			query: string option}
-	     | Authority of string
+         sig
+            datatype t =
+               Star
+             | Url of Url.t
+             | Path of {path: Url.Path.t,
+                        query: string option}
+             | Authority of string
 
-	    val toString: t -> string
-	 end
+            val toString: t -> string
+         end
       
       structure Version:
-	 sig
-	    datatype t = T of {major: int,
-			       minor: int}
+         sig
+            datatype t = T of {major: int,
+                               minor: int}
 
-	    val v10: t
-	    val v11: t
-	 end
+            val v10: t
+            val v11: t
+         end
 
       structure Header:
-	 sig
-	    datatype t =
-	       Accept of string
-	     | AcceptCharset of string
-	     | AcceptEncoding of string
-	     | AcceptLanguage of string
-	     | AcceptRanges of string
-	     | Age of string
-	     | Allow of string
-	     | Authorization of string
-	     | CacheControl of string
-	     | Connection of string
-	     | ContentEncoding of string
-	     | ContentLanguage of string
-	     | ContentLength of int
-	     | ContentLocation of string
-	     | ContentMD5 of string
-	     | ContentRange of string
-	     | ContentType of string
-	     | Cookie of string
-	     | Date of string
-	     | ETag of string
-	     | Expect of string
-	     | Expires of string
-	     | Extension of {name: string, value: string}
-	     | From of string
-	     | Host of string
-	     | IfMatch of string
-	     | LastModified of string
-	     | Location of string
-	     | Pragma of string
-	     | ProxyAuthenticate of string
-	     | ProxyConnection of string
-	     | Referer of string
-	     | RetryAfter of string
-	     | Server of string
-	     | SetCookie of string
-	     | Trailer of string
-	     | TransferEncoding of string
-	     | Upgrade of string
-	     | UserAgent of string
-	     | Vary of string
-	     | Via of string
-	     | WWWAuthenticate of string
-	     | Warning of string
+         sig
+            datatype t =
+               Accept of string
+             | AcceptCharset of string
+             | AcceptEncoding of string
+             | AcceptLanguage of string
+             | AcceptRanges of string
+             | Age of string
+             | Allow of string
+             | Authorization of string
+             | CacheControl of string
+             | Connection of string
+             | ContentEncoding of string
+             | ContentLanguage of string
+             | ContentLength of int
+             | ContentLocation of string
+             | ContentMD5 of string
+             | ContentRange of string
+             | ContentType of string
+             | Cookie of string
+             | Date of string
+             | ETag of string
+             | Expect of string
+             | Expires of string
+             | Extension of {name: string, value: string}
+             | From of string
+             | Host of string
+             | IfMatch of string
+             | LastModified of string
+             | Location of string
+             | Pragma of string
+             | ProxyAuthenticate of string
+             | ProxyConnection of string
+             | Referer of string
+             | RetryAfter of string
+             | Server of string
+             | SetCookie of string
+             | Trailer of string
+             | TransferEncoding of string
+             | Upgrade of string
+             | UserAgent of string
+             | Vary of string
+             | Via of string
+             | WWWAuthenticate of string
+             | Warning of string
 
-	    val fromString: string -> t list Result.t
-	    val input: In.t -> t list Result.t
-	    val toString: t -> string
-	 end
+            val fromString: string -> t list Result.t
+            val input: In.t -> t list Result.t
+            val toString: t -> string
+         end
 
       structure Request:
-	 sig
-	    datatype t = T of {method: Method.t,
-			       url: RequestUrl.t,
-			       version: Version.t,
-			       headers: Header.t list}
+         sig
+            datatype t = T of {method: Method.t,
+                               url: RequestUrl.t,
+                               version: Version.t,
+                               headers: Header.t list}
 
-	    val input: In.t -> t Result.t
-	    val layout: t -> Layout.t
-	    val output: t * Out.t -> unit
-	    val regexp: unit -> Regexp.Compiled.t
-	    val requestLine: string -> {method: Method.t,
-					url: RequestUrl.t,
-					version: Version.t} option
-	    val toString: t -> string
-	 end
+            val input: In.t -> t Result.t
+            val layout: t -> Layout.t
+            val output: t * Out.t -> unit
+            val regexp: unit -> Regexp.Compiled.t
+            val requestLine: string -> {method: Method.t,
+                                        url: RequestUrl.t,
+                                        version: Version.t} option
+            val toString: t -> string
+         end
 
       structure Status:
-	 sig
-	    datatype t =
-	       Accepted
-	     | BadGateway
-	     | BadRequest
-	     | Conflict
-	     | Continue
-	     | Created
-	     | ExpectationFailed
-	     | Extension of string
-	     | Forbidden
-	     | Found
-	     | GatewayTimeout
-	     | Gone
-	     | HTTPVersionNotSupported
-	     | InternalServerError
-	     | LengthRequired
-	     | MethodNotAllowed
-	     | MovedPermanently
-	     | MultipleChoices
-	     | NoContent
-	     | NonAuthoritativeInformation
-	     | NotAcceptable
-	     | NotFound
-	     | NotImplemented
-	     | NotModified
-	     | OK
-	     | PartialContent
-	     | PaymentRequired
-	     | PreconditionFailed
-	     | ProxyAuthenticationRequired
-	     | RequestEntityTooLarge
-	     | RequestTimeout
-	     | RequestUriTooLarge
-	     | RequestedRangeNotSatisfiable
-	     | ResetContent
-	     | SeeOther
-	     | ServiceUnavailable
-	     | SwitchingProtocols
-	     | TemporaryRedirect
-	     | Unauthorized
-	     | UnsupportedMediaType
-	     | UseProxy
+         sig
+            datatype t =
+               Accepted
+             | BadGateway
+             | BadRequest
+             | Conflict
+             | Continue
+             | Created
+             | ExpectationFailed
+             | Extension of string
+             | Forbidden
+             | Found
+             | GatewayTimeout
+             | Gone
+             | HTTPVersionNotSupported
+             | InternalServerError
+             | LengthRequired
+             | MethodNotAllowed
+             | MovedPermanently
+             | MultipleChoices
+             | NoContent
+             | NonAuthoritativeInformation
+             | NotAcceptable
+             | NotFound
+             | NotImplemented
+             | NotModified
+             | OK
+             | PartialContent
+             | PaymentRequired
+             | PreconditionFailed
+             | ProxyAuthenticationRequired
+             | RequestEntityTooLarge
+             | RequestTimeout
+             | RequestUriTooLarge
+             | RequestedRangeNotSatisfiable
+             | ResetContent
+             | SeeOther
+             | ServiceUnavailable
+             | SwitchingProtocols
+             | TemporaryRedirect
+             | Unauthorized
+             | UnsupportedMediaType
+             | UseProxy
 
-	    val fromString: string -> t (* string is a code, eg "502" *)
-	    val reason: t -> string
-	 end
+            val code: t -> string
+            val fromString: string -> t (* string is a code, eg "502" *)
+            val reason: t -> string
+         end
 
       structure Response:
-	 sig
-	    datatype t = T of {headers: Header.t list,
-			       status: Status.t,
-			       version: Version.t}
+         sig
+            datatype t = T of {headers: Header.t list,
+                               status: Status.t,
+                               version: Version.t}
 
-	    val input: In.t -> t Result.t
-	    val layout: t -> Layout.t
-	    val output: t * Out.t -> unit
-	    val regexp: unit -> Regexp.Compiled.t
-	    val toString: t -> string
-	 end
+            val input: In.t -> t Result.t
+            val layout: t -> Layout.t
+            val output: t * Out.t -> unit
+            val regexp: unit -> Regexp.Compiled.t
+            val toString: t -> string
+         end
       
       structure Post:
          sig
-	    structure Encoding:
-	       sig
-		  datatype t = Url | Multipart
-	       end
+            structure Encoding:
+               sig
+                  datatype t = Url | Multipart
+               end
 
-	    structure Value:
-	       sig
-		  type t
+            structure Value:
+               sig
+                  type t
 
-		  val file: File.t -> t
-		  val string: string -> t
-	       end
-		       
-	    datatype t =
-	       T of {encoding: Encoding.t,
-		     fields: {name: string,
-			      value: Value.t} list}
+                  val file: File.t -> t
+                  val string: string -> t
+               end
+                       
+            datatype t =
+               T of {encoding: Encoding.t,
+                     fields: {name: string,
+                              value: Value.t} list}
          end
 
       val fetch:
-	 {head: bool,
-	  headers: Header.t list,
-	  post: Post.t option,
-	  proxy: {host: string, port: int} option,
-	  url: Url.t} -> In.t
+         {head: bool,
+          headers: Header.t list,
+          post: Post.t option,
+          proxy: {host: string, port: int} option,
+          url: Url.t} -> In.t
    end
 
 
@@ -213,25 +214,25 @@
    
 val _ = 
    Assert.assert
-   ("Http", fn () =>
+   ("TestHttp", fn () =>
     Regexp.Compiled.matchesAll (Request.regexp (),
-				"CONNECT trading.etrade.com:443 HTTP/1.0\r\n")
+                                "CONNECT trading.etrade.com:443 HTTP/1.0\r\n")
     andalso
     isSome (Request.requestLine "GET http://Norma140.emp3.com/ HTTP/1.0\n")
     andalso
     let
        val s =
-	  "Date: Wed, 08 Mar 2000 09:26:18 GMT\r\n\
-	   \Server: Apache/1.3.6 (Unix)  (Red Hat/Linux)\r\n\
-	   \Last-Modified: Thu, 02 Mar 2000 22:55:44 GMT\r\n\
-	   \ETag: \"23a07c-2ae-38bef170\"\r\n\
-	   \Accept-Ranges: bytes\r\n\
-	   \Content-Length: 686\r\n\
-	   \Connection: close\r\n\
-	   \Content-Type: text/html\r\n"
+          "Date: Wed, 08 Mar 2000 09:26:18 GMT\r\n\
+           \Server: Apache/1.3.6 (Unix)  (Red Hat/Linux)\r\n\
+           \Last-Modified: Thu, 02 Mar 2000 22:55:44 GMT\r\n\
+           \ETag: \"23a07c-2ae-38bef170\"\r\n\
+           \Accept-Ranges: bytes\r\n\
+           \Content-Length: 686\r\n\
+           \Connection: close\r\n\
+           \Content-Type: text/html\r\n"
        val zzz = "GET http://www.nytimes.com/auth/chk_login?is_continue=true&URI=http%3A%2F%2Fwww.nytimes.com%2Flibrary%2Ftech%2Fyr%2Fmo%2Fbiztech%2Farticles%2F17blue.html&Tag=&site=&banner=&sweeps=&USERID=cypherpunk&PASSWORD=cypherpunk&SAVEOPTION=YES HTTP/1.0\r\n"
        val s =
-	  "Referer: http://www.nytimes.com/auth/chk_login?is_continue=true&URI=http%3A%2F%2Fwww.nytimes.com%2Flibrary%2Ftech%2Fyr%2Fmo%2Fbiztech%2Farticles%2F17blue.html&Tag=&site=&banner=&sweeps=&USERID=hqbovik&PASSWORD=hqbovik&SAVEOPTION=YES\r\nUser-Agent: Mozilla/4.7 [en]\r\nHost: www.nytimes.com\r\nAccept: image/gif, image/x-xbitmap, image/jpeg, image/pjpeg, image/png, */*\r\nAccept-Encoding: gzip\r\nAccept-Language: en\r\nAccept-Charset: iso-8859-1,*,utf-8\r\nCookie: RMID=c603a30338b9ce60; NYT-S=0UtWyAdJ/Hc94BS7pHO0q4Pek6E1oJ.FMxFTIduykzwDgubECS6cqpWk.Duqut/D9GDBO6lz6cXYs0; PW=\161%.69,.)03\223; ID=\161%.69,.)03\223; RDB=C80200D6EF0000555301001E2719270101000000000002\r\n"
+          "Referer: http://www.nytimes.com/auth/chk_login?is_continue=true&URI=http%3A%2F%2Fwww.nytimes.com%2Flibrary%2Ftech%2Fyr%2Fmo%2Fbiztech%2Farticles%2F17blue.html&Tag=&site=&banner=&sweeps=&USERID=hqbovik&PASSWORD=hqbovik&SAVEOPTION=YES\r\nUser-Agent: Mozilla/4.7 [en]\r\nHost: www.nytimes.com\r\nAccept: image/gif, image/x-xbitmap, image/jpeg, image/pjpeg, image/png, */*\r\nAccept-Encoding: gzip\r\nAccept-Language: en\r\nAccept-Charset: iso-8859-1,*,utf-8\r\nCookie: RMID=c603a30338b9ce60; NYT-S=0UtWyAdJ/Hc94BS7pHO0q4Pek6E1oJ.FMxFTIduykzwDgubECS6cqpWk.Duqut/D9GDBO6lz6cXYs0; PW=\161%.69,.)03\223; ID=\161%.69,.)03\223; RDB=C80200D6EF0000555301001E2719270101000000000002\r\n"
 
        val s = "Cookie: PW=\161%.69\r\n"
     in Result.isYes (Header.fromString s)

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/http.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/http.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/http.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,8 +1,8 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 structure Http: HTTP =
@@ -23,7 +23,7 @@
       val SP = char #" "
       val HT = char #"\t"
       val CRLF = string "\r\n"
-      (* #"\n" is not in the spec for CRLF, but Netscape generates it. *)	 
+      (* #"\n" is not in the spec for CRLF, but Netscape generates it. *)        
       val CRLF = or [CRLF, char #"\n"]
       val LWS = seq [optional CRLF, oneOrMore (or [SP, HT])]
       val TEXT = isNotChar Char.isCntrl
@@ -31,58 +31,58 @@
       val separatorChars = "()<>@,;:\\\"/ []?= {} \t"
       val separators = oneOf separatorChars
       val token =
-	 oneOrMore (isChar
-		    (Char.memoize
-		     (fn c =>
-		      Char.isAscii c
-		      andalso not (Char.isCntrl c)
-		      andalso not (String.contains (separatorChars, c)))))
+         oneOrMore (isChar
+                    (Char.memoize
+                     (fn c =>
+                      Char.isAscii c
+                      andalso not (Char.isCntrl c)
+                      andalso not (String.contains (separatorChars, c)))))
       val dquote = char Char.dquote
       val qdtext = isChar (fn c =>
-			  not (Char.isCntrl c)
-			  andalso not (c = Char.dquote))
+                          not (Char.isCntrl c)
+                          andalso not (c = Char.dquote))
       val quotedpair = seq [char #"\\", CHAR]
       val quotedstring =
-	 seq [dquote, star (or [qdtext, quotedpair]), dquote]
+         seq [dquote, star (or [qdtext, quotedpair]), dquote]
       val ctext =
-	 isChar (fn c =>
-		not (Char.isCntrl c)
-		andalso not (c = #"(")
-		andalso not (c = #")"))
-      (* 	 val comment =
-       * 	    seq [char #"(",
-       * 		star (or [ctext, quoted-pair, comment]),
-       * 		char #")"]
+         isChar (fn c =>
+                not (Char.isCntrl c)
+                andalso not (c = #"(")
+                andalso not (c = #")"))
+      (*         val comment =
+       *            seq [char #"(",
+       *                star (or [ctext, quoted-pair, comment]),
+       *                char #")"]
        *)
       val major' = Save.new ()
       val minor' = Save.new ()
       val version =
-	 seq [string "HTTP/",
-	      save (oneOrMore DIGIT, major'),
-	      char #".",
-	      save (oneOrMore DIGIT, minor')]
+         seq [string "HTTP/",
+              save (oneOrMore DIGIT, major'),
+              char #".",
+              save (oneOrMore DIGIT, minor')]
       val fieldname' = Save.new ()
      val fieldname =
-	(* fieldname should just be token, but the stupid Microsoft server
-	 * includes spaces in its "Content Location" field, so we need to accept
-	 * more. The easies thing is just to take anything but a ":".
-	 *)
-	(* save (token, fieldname') *)
-	save (star (notChar #":"), fieldname')
+        (* fieldname should just be token, but the stupid Microsoft server
+         * includes spaces in its "Content Location" field, so we need to accept
+         * more. The easies thing is just to take anything but a ":".
+         *)
+        (* save (token, fieldname') *)
+        save (star (notChar #":"), fieldname')
       val fieldcontent =
-	 (* fieldcontent should just be TEXT, but nytimes stores control
-	  * characters in cookies, and thus, need to allow more.
-	  *)
-	 (*TEXT *)
-	 isChar (fn c => c >= #" ")
+         (* fieldcontent should just be TEXT, but nytimes stores control
+          * characters in cookies, and thus, need to allow more.
+          *)
+         (*TEXT *)
+         isChar (fn c => c >= #" ")
       val fieldvalue' = Save.new ()
       val fieldvalue = star (or [fieldcontent, LWS])
       val messageheader =
-	 Promise.lazy
-	 (fn () =>
-	  compileDFA (seq [fieldname, char #":",
-			   save (optional fieldvalue, fieldvalue'),
-			   CRLF]))
+         Promise.lazy
+         (fn () =>
+          compileDFA (seq [fieldname, char #":",
+                           save (optional fieldvalue, fieldvalue'),
+                           CRLF]))
       val method' = Save.new ()
       val method = save (token, method')
       val star' = Save.new ()
@@ -91,33 +91,33 @@
       val authority' = Save.new ()
       val query' = Save.new ()
       val requestUrl =
-	 let open Url.Regexp
-	 in or [save (char #"*", star'),
-		save (absoluteUrl, absoluteUrl'),
-		seq [save (absPath, absPath'),
-		     optional (seq [char #"?", save (query, query')])],
-		save (authority, authority')]
-	 end
+         let open Url.Regexp
+         in or [save (char #"*", star'),
+                save (absoluteUrl, absoluteUrl'),
+                seq [save (absPath, absPath'),
+                     optional (seq [char #"?", save (query, query')])],
+                save (authority, authority')]
+         end
       val requestLine =
-	 Promise.lazy
-	 (fn () =>
-	  compileDFA (seq [method, SP, requestUrl, SP, version, CRLF]))
+         Promise.lazy
+         (fn () =>
+          compileDFA (seq [method, SP, requestUrl, SP, version, CRLF]))
       val contentLength =
-	 Promise.lazy (fn () => compileDFA (oneOrMore DIGIT))
+         Promise.lazy (fn () => compileDFA (oneOrMore DIGIT))
       val status' = Save.new ()
       val status = save (seq [DIGIT, DIGIT, DIGIT], status')
       val reason =
-	 star (isChar (fn c =>
-		     Char.isPrint c andalso c <> #"\r" andalso c <> #"\n"))
+         star (isChar (fn c =>
+                     Char.isPrint c andalso c <> #"\r" andalso c <> #"\n"))
       val responseLine =
-	 Promise.lazy
-	 (fn () => compileDFA (seq [version, SP, status, SP, reason, CRLF]))
+         Promise.lazy
+         (fn () => compileDFA (seq [version, SP, status, SP, reason, CRLF]))
    end
 
 structure Method =
    struct
       datatype t =
-	 Connect
+         Connect
        | Delete
        | Extension of string
        | Get
@@ -128,24 +128,24 @@
        | Trace
 
       val map =
-	 [(Connect, "CONNECT"),
-	  (Delete, "DELETE"),
-	  (Get, "GET"),
-	  (Head, "HEAD"),
-	  (Options, "OPTIONS"),
-	  (Post, "POST"),
-	  (Put, "PUT"),
-	  (Trace, "TRACE")]
+         [(Connect, "CONNECT"),
+          (Delete, "DELETE"),
+          (Get, "GET"),
+          (Head, "HEAD"),
+          (Options, "OPTIONS"),
+          (Post, "POST"),
+          (Put, "PUT"),
+          (Trace, "TRACE")]
 
       fun fromString s =
-	 case List.peek (map, fn (_, s') => s = s') of
-	    NONE => Extension s
-	  | SOME (h, _) => h
+         case List.peek (map, fn (_, s') => s = s') of
+            NONE => Extension s
+          | SOME (h, _) => h
 
       fun toString h =
-	 case h of
-	    Extension s => s
-	  | _ => #2 (valOf (List.peek (map, fn (h', _) => h = h')))
+         case h of
+            Extension s => s
+          | _ => #2 (valOf (List.peek (map, fn (h', _) => h = h')))
 
       val layout = Layout.str o toString
    end
@@ -153,13 +153,13 @@
 structure Version =
    struct
       datatype t = T of {major: int,
-			 minor: int}
+                         minor: int}
 
       fun toString (T {major, minor}) =
-	 concat ["HTTP/",
-		Int.toString major,
-		".",
-		Int.toString minor]
+         concat ["HTTP/",
+                Int.toString major,
+                ".",
+                Int.toString minor]
 
       val layout = Layout.str o toString
 
@@ -167,36 +167,36 @@
       val v11 = T {major = 1, minor = 1}
 
       fun extract m =
-	 T (let
-	      open Regexp
-	      fun int s = valOf (Int.fromString (Substring.toString
-						 (Match.lookup (m, s))))
-	   in {minor = int minor',
-	       major = int major'}
-	   end)
+         T (let
+              open Regexp
+              fun int s = valOf (Int.fromString (Substring.toString
+                                                 (Match.lookup (m, s))))
+           in {minor = int minor',
+               major = int major'}
+           end)
    end
 
 structure RequestUrl =
    struct
       structure Path = Url.Path
       datatype t =
-	 Star
+         Star
        | Url of Url.t
        | Path of {path: Path.t,
-		  query: string option}
+                  query: string option}
        | Authority of string
 
       val toString =
-	 fn Star => "*"
-	  | Url url => Url.toString url
-	  | Path {path, query} =>
-	       concat [Path.toString path,
-		      case query of
-			 NONE => ""
-		       | SOME q => concat ["?", if !Url.escapeQuery
-						  then Url.escape q
-					       else q]]
-	  | Authority s => s
+         fn Star => "*"
+          | Url url => Url.toString url
+          | Path {path, query} =>
+               concat [Path.toString path,
+                      case query of
+                         NONE => ""
+                       | SOME q => concat ["?", if !Url.escapeQuery
+                                                  then Url.escape q
+                                               else q]]
+          | Authority s => s
 
       val layout = Layout.str o toString
    end
@@ -206,7 +206,7 @@
 structure Header =
    struct
       datatype t =
-	 Accept of string
+         Accept of string
        | AcceptCharset of string
        | AcceptEncoding of string
        | AcceptLanguage of string
@@ -251,249 +251,249 @@
        | Warning of string
 
       val toString =
-	 fn Accept s => concat ["Accept: ", s]
-	  | AcceptCharset s => concat ["Accept-Charset: ", s]
-	  | AcceptEncoding s => concat ["Accept-Encoding: ", s]
-	  | AcceptLanguage s => concat ["Accept-Language: ", s]
-	  | AcceptRanges s => concat ["Accept-Ranges: ", s]
-	  | Age s => concat ["Age: ", s]
-	  | Allow s => concat ["Allow: ", s]
-	  | Authorization s => concat ["Authorization: Basic ", Base64.encode s]
-	  | CacheControl s => concat ["Cache-Control: ", s]
-	  | Connection s => concat ["Connection: ", s]
-	  | ContentEncoding s => concat ["Content-Encoding: ", s]
-	  | ContentLanguage s => concat ["Content-Language: ", s]
-	  | ContentLength s => concat ["Content-Length: ", Int.toString s]
-	  | ContentLocation s => concat ["Content-Location: ", s]
-	  | ContentMD5 s => concat ["Content-MD5: ", s]
-	  | ContentRange s => concat ["Content-Range: ", s]
-	  | ContentType s => concat ["Content-Type: ", s]
-	  | Cookie s => concat ["Cookie: ", s]
-	  | Date s => concat ["Date: ", s]
-	  | ETag s => concat ["Etag: ", s]
-	  | Expect s => concat ["Expect: ", s]
-	  | Expires s => concat ["Expires: ", s]
-	  | Extension {name, value} => concat [name, ": ", value]
-	  | From s => concat ["From: ", s]
-	  | Host s => concat ["Host: ", s]
-	  | IfMatch s => concat ["If-Match: ", s]
-	  | LastModified s => concat ["Last-Modified: ", s]
-	  | Location s => concat ["Location: ", s]
-	  | Pragma s => concat ["Pragma: ", s]
-	  | ProxyAuthenticate s => concat ["Proxy-Authenticate: ", s]
-	  | ProxyConnection s => concat ["Proxy-Connection: ", s]
-	  | Referer s => concat ["Referer: ", s]
-	  | RetryAfter s => concat ["Retry-After: ", s]
-	  | Server s => concat ["Server: ", s]
-	  | SetCookie s => concat ["Set-Cookie: ", s]
-	  | Trailer s => concat ["Trailer: ", s]
-	  | TransferEncoding s => concat ["Transfer-Encoding: ", s]
-	  | Upgrade s => concat ["Upgrade: ", s]
-	  | UserAgent s => concat ["User-Agent: ", s]
-	  | Vary s => concat ["Vary: ", s]
-	  | Via s => concat ["Via: ", s]
-	  | WWWAuthenticate s => concat ["WWW-Authenticate: ", s]
-	  | Warning s => concat ["Warning: ", s]
+         fn Accept s => concat ["Accept: ", s]
+          | AcceptCharset s => concat ["Accept-Charset: ", s]
+          | AcceptEncoding s => concat ["Accept-Encoding: ", s]
+          | AcceptLanguage s => concat ["Accept-Language: ", s]
+          | AcceptRanges s => concat ["Accept-Ranges: ", s]
+          | Age s => concat ["Age: ", s]
+          | Allow s => concat ["Allow: ", s]
+          | Authorization s => concat ["Authorization: Basic ", Base64.encode s]
+          | CacheControl s => concat ["Cache-Control: ", s]
+          | Connection s => concat ["Connection: ", s]
+          | ContentEncoding s => concat ["Content-Encoding: ", s]
+          | ContentLanguage s => concat ["Content-Language: ", s]
+          | ContentLength s => concat ["Content-Length: ", Int.toString s]
+          | ContentLocation s => concat ["Content-Location: ", s]
+          | ContentMD5 s => concat ["Content-MD5: ", s]
+          | ContentRange s => concat ["Content-Range: ", s]
+          | ContentType s => concat ["Content-Type: ", s]
+          | Cookie s => concat ["Cookie: ", s]
+          | Date s => concat ["Date: ", s]
+          | ETag s => concat ["Etag: ", s]
+          | Expect s => concat ["Expect: ", s]
+          | Expires s => concat ["Expires: ", s]
+          | Extension {name, value} => concat [name, ": ", value]
+          | From s => concat ["From: ", s]
+          | Host s => concat ["Host: ", s]
+          | IfMatch s => concat ["If-Match: ", s]
+          | LastModified s => concat ["Last-Modified: ", s]
+          | Location s => concat ["Location: ", s]
+          | Pragma s => concat ["Pragma: ", s]
+          | ProxyAuthenticate s => concat ["Proxy-Authenticate: ", s]
+          | ProxyConnection s => concat ["Proxy-Connection: ", s]
+          | Referer s => concat ["Referer: ", s]
+          | RetryAfter s => concat ["Retry-After: ", s]
+          | Server s => concat ["Server: ", s]
+          | SetCookie s => concat ["Set-Cookie: ", s]
+          | Trailer s => concat ["Trailer: ", s]
+          | TransferEncoding s => concat ["Transfer-Encoding: ", s]
+          | Upgrade s => concat ["Upgrade: ", s]
+          | UserAgent s => concat ["User-Agent: ", s]
+          | Vary s => concat ["Vary: ", s]
+          | Via s => concat ["Via: ", s]
+          | WWWAuthenticate s => concat ["WWW-Authenticate: ", s]
+          | Warning s => concat ["Warning: ", s]
 
       val layout = Layout.str o toString
 
       fun toStrings (hs: t list): string list =
-	 List.concatMap (hs, fn h => [toString h, "\r\n"])
+         List.concatMap (hs, fn h => [toString h, "\r\n"])
 
       val cons: string -> string -> t option =
-	 String.memoizeList
-	 (fn s => fn s' => SOME (Extension {name = s, value = s'}),
-	  [("accept", SOME o Accept),
-	   ("accept-charset", SOME o AcceptCharset),
-	   ("accept-encoding", SOME o AcceptEncoding),
-	   ("accept-language", SOME o AcceptLanguage),
-	   ("accept-ranges", SOME o AcceptRanges),
-	   ("age", SOME o Age),
-	   ("allow", SOME o Allow),
-	   ("authorization",
-	    let
-	       open Regexp
-	       val enc = Save.new ()
-	       val reg = compileNFA (seq [string "Basic ", save (anys, enc)])
-	    in
-	       fn s =>
-	       let
-	       in Option.map
-		  (Compiled.matchAll (reg, s), fn m =>
-		   Authorization
-		   (Base64.decode (Match.lookupString (m, enc))))
-	       end
-	    end),
-	   ("cache-control", SOME o CacheControl),
-	   ("connection", SOME o Connection),
-	   ("content-encoding", SOME o ContentEncoding),
-	   ("content-language", SOME o ContentLanguage),
-	   ("content-length",
-	    fn (s: string) =>
-	    let open Regexp
-	    in if Regexp.Compiled.matchesAll (contentLength (), s)
-		  then Option.map (Int.fromString s, ContentLength)
-	       else NONE
-	    end),
-	   ("content-location", SOME o ContentLocation),
-	   ("content-md5", SOME o ContentMD5),
-	   ("content-range", SOME o ContentRange),
-	   ("content-type", SOME o ContentType),
-	   ("cookie", SOME o Cookie),
-	   ("date", SOME o Date),
-	   ("etag", SOME o ETag),
-	   ("expect", SOME o Expect),
-	   ("expires", SOME o Expires),
-	   ("from", SOME o From),
-	   ("host", SOME o Host),
-	   ("if-match", SOME o IfMatch),
-	   ("last-modified", SOME o LastModified),
-	   ("location", SOME o Location),
-	   ("pragma", SOME o Pragma),
-	   ("proxy-authenticate", SOME o ProxyAuthenticate),
-	   ("proxy-connection", SOME o ProxyConnection),
-	   ("referer", SOME o Referer),
-	   ("retry-after", SOME o RetryAfter),
-	   ("server", SOME o Server),
-	   ("set-cookie", SOME o Server),
-	   ("trailer", SOME o Trailer),
-	   ("transfer-encoding", SOME o TransferEncoding),
-	   ("upgrade", SOME o Upgrade),
-	   ("user-agent", SOME o UserAgent),
-	   ("vary", SOME o Vary),
-	   ("via", SOME o Via),
-	   ("www-authenticate", SOME o WWWAuthenticate),
-	   ("warning", SOME o Warning)])
-	  
+         String.memoizeList
+         (fn s => fn s' => SOME (Extension {name = s, value = s'}),
+          [("accept", SOME o Accept),
+           ("accept-charset", SOME o AcceptCharset),
+           ("accept-encoding", SOME o AcceptEncoding),
+           ("accept-language", SOME o AcceptLanguage),
+           ("accept-ranges", SOME o AcceptRanges),
+           ("age", SOME o Age),
+           ("allow", SOME o Allow),
+           ("authorization",
+            let
+               open Regexp
+               val enc = Save.new ()
+               val reg = compileNFA (seq [string "Basic ", save (anys, enc)])
+            in
+               fn s =>
+               let
+               in Option.map
+                  (Compiled.matchAll (reg, s), fn m =>
+                   Authorization
+                   (Base64.decode (Match.lookupString (m, enc))))
+               end
+            end),
+           ("cache-control", SOME o CacheControl),
+           ("connection", SOME o Connection),
+           ("content-encoding", SOME o ContentEncoding),
+           ("content-language", SOME o ContentLanguage),
+           ("content-length",
+            fn (s: string) =>
+            let open Regexp
+            in if Regexp.Compiled.matchesAll (contentLength (), s)
+                  then Option.map (Int.fromString s, ContentLength)
+               else NONE
+            end),
+           ("content-location", SOME o ContentLocation),
+           ("content-md5", SOME o ContentMD5),
+           ("content-range", SOME o ContentRange),
+           ("content-type", SOME o ContentType),
+           ("cookie", SOME o Cookie),
+           ("date", SOME o Date),
+           ("etag", SOME o ETag),
+           ("expect", SOME o Expect),
+           ("expires", SOME o Expires),
+           ("from", SOME o From),
+           ("host", SOME o Host),
+           ("if-match", SOME o IfMatch),
+           ("last-modified", SOME o LastModified),
+           ("location", SOME o Location),
+           ("pragma", SOME o Pragma),
+           ("proxy-authenticate", SOME o ProxyAuthenticate),
+           ("proxy-connection", SOME o ProxyConnection),
+           ("referer", SOME o Referer),
+           ("retry-after", SOME o RetryAfter),
+           ("server", SOME o Server),
+           ("set-cookie", SOME o Server),
+           ("trailer", SOME o Trailer),
+           ("transfer-encoding", SOME o TransferEncoding),
+           ("upgrade", SOME o Upgrade),
+           ("user-agent", SOME o UserAgent),
+           ("vary", SOME o Vary),
+           ("via", SOME o Via),
+           ("www-authenticate", SOME o WWWAuthenticate),
+           ("warning", SOME o Warning)])
+          
       fun fromString (s: string): t list Result.t =
-	 let
-	    val no = Result.No (concat ["invalid header: ", s])
-	    val n = String.size s
-	    fun loop (i: int, ac: t list) =
-	       if i = n
-		  then Result.Yes (rev ac)
-	       else let open Regexp
-		    in case Compiled.matchLong (messageheader (), s, i) of
-		       NONE => no
-		     | SOME m => 
-			  let
-			     val {lookup, ...} = Match.stringFuns m
-			     val fieldname = String.toLower (lookup fieldname')
-			     val fieldvalue =
-				String.dropl (lookup fieldvalue', Char.isSpace)
-			  in case cons fieldname fieldvalue of
-			     NONE => no
-			   | SOME header =>
-				loop (i + Match.length m, header :: ac)
-			  end
-		    end
-	 in loop (0, [])
-	 end
+         let
+            val no = Result.No (concat ["invalid header: ", s])
+            val n = String.size s
+            fun loop (i: int, ac: t list) =
+               if i = n
+                  then Result.Yes (rev ac)
+               else let open Regexp
+                    in case Compiled.matchLong (messageheader (), s, i) of
+                       NONE => no
+                     | SOME m => 
+                          let
+                             val {lookup, ...} = Match.stringFuns m
+                             val fieldname = String.toLower (lookup fieldname')
+                             val fieldvalue =
+                                String.dropl (lookup fieldvalue', Char.isSpace)
+                          in case cons fieldname fieldvalue of
+                             NONE => no
+                           | SOME header =>
+                                loop (i + Match.length m, header :: ac)
+                          end
+                    end
+         in loop (0, [])
+         end
 
       val fromString =
-	 Trace.trace ("Header.fromString",
-		      String.layout,
-		      Result.layout (List.layout layout))
-	 fromString
+         Trace.trace ("Http.Header.fromString",
+                      String.layout,
+                      Result.layout (List.layout layout))
+         fromString
 
       fun input (ins: In.t): t list Result.t =
-	 let
-	    fun loop (headers: string list): string list =
-	       case In.inputLine ins of
-		  NONE => headers
-		| SOME l => 
-		     if l = "\r\n"
-			then headers
-		     else loop (l :: headers)
-	 in
-	    fromString (concat (rev (loop [])))
-	 end
+         let
+            fun loop (headers: string list): string list =
+               case In.inputLine ins of
+                  NONE => headers
+                | SOME l => 
+                     if l = "\r\n"
+                        then headers
+                     else loop (l :: headers)
+         in
+            fromString (concat (rev (loop [])))
+         end
    end
 
 structure Request =
    struct
       datatype t = T of {method: Method.t,
-			 url: RequestUrl.t,
-			 version: Version.t,
-			 headers: Header.t list}
+                         url: RequestUrl.t,
+                         version: Version.t,
+                         headers: Header.t list}
 
       val regexp = Regexp.requestLine
-	 
+         
       fun toString (T {method, url, version, headers}) =
-	 concat ([Method.toString method,
-		 " ",
-		 RequestUrl.toString url,
-		 " ",
-		 Version.toString version,
-		 "\r\n"]
-		@ Header.toStrings headers
-		@ ["\r\n"])
+         concat ([Method.toString method,
+                 " ",
+                 RequestUrl.toString url,
+                 " ",
+                 Version.toString version,
+                 "\r\n"]
+                @ Header.toStrings headers
+                @ ["\r\n"])
 
       val layout = Layout.str o toString
 
       fun output (r, out) = Out.output (out, toString r)
  
       fun requestLine (s: string) =
-	 let
-	    open Regexp
-	 in Option.map
-	    (Compiled.matchAll (requestLine (), s), fn m =>
-	     let
-		val {peek, lookup, exists, ...} = Match.stringFuns m
-		val method = Method.fromString (lookup method')
-		open RequestUrl
-		val url =
-		   if exists star'
-		      then Star
-		   else if exists absoluteUrl'
-			   then Url (Url.getMatch m)
-			else
-			   (case peek authority' of
-			       NONE =>
-				  Path {path = Url.Regexp.getAbsPath m,
-				       query = Url.Regexp.peekQuery m}
-			     | SOME s => Authority s)
-		val version = Version.extract m
-	     in {method = method,
-		 url = url,
-		 version = version}
-	     end)
-	 end
+         let
+            open Regexp
+         in Option.map
+            (Compiled.matchAll (requestLine (), s), fn m =>
+             let
+                val {peek, lookup, exists, ...} = Match.stringFuns m
+                val method = Method.fromString (lookup method')
+                open RequestUrl
+                val url =
+                   if exists star'
+                      then Star
+                   else if exists absoluteUrl'
+                           then Url (Url.getMatch m)
+                        else
+                           (case peek authority' of
+                               NONE =>
+                                  Path {path = Url.Regexp.getAbsPath m,
+                                       query = Url.Regexp.peekQuery m}
+                             | SOME s => Authority s)
+                val version = Version.extract m
+             in {method = method,
+                 url = url,
+                 version = version}
+             end)
+         end
 
       val requestLine =
-	 Trace.trace ("requestLine",
-		      String.layout,
-		      Option.layout (fn {method, url, version} =>
-				     Layout.record
-				     [("method", Method.layout method),
-				      ("url", RequestUrl.layout url),
-				      ("version", Version.layout version)]))
-	 requestLine
+         Trace.trace ("Http.Request.requestLine",
+                      String.layout,
+                      Option.layout (fn {method, url, version} =>
+                                     Layout.record
+                                     [("method", Method.layout method),
+                                      ("url", RequestUrl.layout url),
+                                      ("version", Version.layout version)]))
+         requestLine
 
       val requestIsValid = Option.isSome o requestLine
-	 
+         
       fun input (ins: In.t): t Result.t =
-	 case In.inputLine ins of
-	    NONE => Result.No ""
-	  | SOME l =>
-	       case requestLine l of
-		  NONE => Result.No l
-		| SOME {method, url, version} =>
-		     Result.map
-		     (Header.input ins, fn hs =>
-		      T {method = method,
-			 url = url,
-			 version = version,
-			 headers = hs})
+         case In.inputLine ins of
+            NONE => Result.No ""
+          | SOME l =>
+               case requestLine l of
+                  NONE => Result.No l
+                | SOME {method, url, version} =>
+                     Result.map
+                     (Header.input ins, fn hs =>
+                      T {method = method,
+                         url = url,
+                         version = version,
+                         headers = hs})
 
       val input =
-	 Trace.trace ("Request.input", In.layout, Result.layout layout) input
+         Trace.trace ("Http.Request.input", In.layout, Result.layout layout) input
    end
 
 structure Rope =
    struct
       datatype t =
-	 Appends of t list
+         Appends of t list
        | File of File.t
        | String of string
 
@@ -504,117 +504,117 @@
       val empty = String ""
 
       fun sizePlus (r: t, ac: int): int =
-	 case r of
-	    Appends rs => List.fold (rs, ac, sizePlus)
-	  | File f => ac + Int64.toInt (File.size f)
-	  | String s => ac + String.size s
+         case r of
+            Appends rs => List.fold (rs, ac, sizePlus)
+          | File f => ac + Int64.toInt (File.size f)
+          | String s => ac + String.size s
 
       fun size (r: t): int = sizePlus (r, 0)
-	       
+               
       fun toStrings (r: t, ac: string list): string list =
-	 case r of
-	    Appends rs => List.fold (rev rs, ac, toStrings)
-	  | File f => File.contents f :: ac
-	  | String s => s :: ac
+         case r of
+            Appends rs => List.fold (rev rs, ac, toStrings)
+          | File f => File.contents f :: ac
+          | String s => s :: ac
 
       fun toString (r: t): string = concat (toStrings (r, []))
 
       fun output (r: t, out: Out.t): unit =
-	 let
-	    fun loop (r: t): unit =
-	       case r of
-		  Appends rs => List.foreach (rs, loop)
-		| File f => File.outputContents (f, out)
-		| String s => Out.output (out, s)
-	 in
-	    loop r
-	 end
+         let
+            fun loop (r: t): unit =
+               case r of
+                  Appends rs => List.foreach (rs, loop)
+                | File f => File.outputContents (f, out)
+                | String s => Out.output (out, s)
+         in
+            loop r
+         end
    end
       
 structure Post =
    struct
       structure Encoding =
-	 struct
-	    datatype t = Url | Multipart
-	 end
+         struct
+            datatype t = Url | Multipart
+         end
 
       structure Value =
-	 struct
-	    datatype t =
-	       File of File.t
-	     | String of string
+         struct
+            datatype t =
+               File of File.t
+             | String of string
 
-	    val file = File
-	    val string = String
+            val file = File
+            val string = String
 
-	    fun toString (v: t): string =
-	       case v of
-		  File f => File.contents f
-		| String s => s
+            fun toString (v: t): string =
+               case v of
+                  File f => File.contents f
+                | String s => s
 
-	    fun toRope (v: t): Rope.t =
-	       case v of
-		  File f => Rope.file f
-		| String s => Rope.string s
-	 end
+            fun toRope (v: t): Rope.t =
+               case v of
+                  File f => Rope.file f
+                | String s => Rope.string s
+         end
 
       datatype t =
-	 T of {encoding: Encoding.t,
-	       fields: {name: string,
-			value: Value.t} list}
+         T of {encoding: Encoding.t,
+               fields: {name: string,
+                        value: Value.t} list}
 
       fun dquote s = concat ["\"", s, "\""]
 
       fun encode (T {encoding, fields}): {contentType: string} * Rope.t =
-	 case encoding of
-	    Encoding.Url =>
-	       ({contentType = "application/x-www-form-urlencoded"},
-		List.fold
-		(rev fields, Rope.empty, fn ({name, value}, r) =>
-		 let
-		    val value =
-		       String.translate
-		       (Value.toString value, fn c =>
-			if Char.isAlphaNum c
-			   then Char.toString c
-			else
-			   (case c of
-			       #" " => "+"
-			     | #"\n" => "%0D%0A"
-			     | _ => Url.Char.escapeHex c))
-		 in
-		    Rope.appends [Rope.string (concat [name, "="]),
-				  Rope.string value,
-				  Rope.string "&",
-				  r]
-		 end))
-	  | Encoding.Multipart =>
-	       let
-		  val boundary =
-		     String.tabulate
-		     (56, fn i =>
-		      if i < 28 then #"-" else Random.charFrom "0123456789")
-	       in
-		  ({contentType = concat ["multipart/form-data; boundary=",
-					  boundary]},
-		   List.foldr
-		   (fields, Rope.string (concat ["--", boundary, "--"]),
-		    fn ({name, value}, rope) =>
-		    let
-		       val extra =
-			  case value of
-			     Value.File f => concat ["; filename=", dquote f]
-			   | Value.String _ => ""
-		    in
-		       Rope.appends
-		       [Rope.string
-			(concat
-			 ["--", boundary, "\r\n",
-			  "Content-Disposition: form-data; name=", dquote name,
-			  extra, "\r\n\r\n"]),
-			Value.toRope value, Rope.string "\r\n", rope]
-		    end))
-	     end
+         case encoding of
+            Encoding.Url =>
+               ({contentType = "application/x-www-form-urlencoded"},
+                List.fold
+                (rev fields, Rope.empty, fn ({name, value}, r) =>
+                 let
+                    val value =
+                       String.translate
+                       (Value.toString value, fn c =>
+                        if Char.isAlphaNum c
+                           then Char.toString c
+                        else
+                           (case c of
+                               #" " => "+"
+                             | #"\n" => "%0D%0A"
+                             | _ => Url.Char.escapeHex c))
+                 in
+                    Rope.appends [Rope.string (concat [name, "="]),
+                                  Rope.string value,
+                                  Rope.string "&",
+                                  r]
+                 end))
+          | Encoding.Multipart =>
+               let
+                  val boundary =
+                     String.tabulate
+                     (56, fn i =>
+                      if i < 28 then #"-" else Random.charFrom "0123456789")
+               in
+                  ({contentType = concat ["multipart/form-data; boundary=",
+                                          boundary]},
+                   List.foldr
+                   (fields, Rope.string (concat ["--", boundary, "--"]),
+                    fn ({name, value}, rope) =>
+                    let
+                       val extra =
+                          case value of
+                             Value.File f => concat ["; filename=", dquote f]
+                           | Value.String _ => ""
+                    in
+                       Rope.appends
+                       [Rope.string
+                        (concat
+                         ["--", boundary, "\r\n",
+                          "Content-Disposition: form-data; name=", dquote name,
+                          extra, "\r\n\r\n"]),
+                        Value.toRope value, Rope.string "\r\n", rope]
+                    end))
+             end
    end
 
 (* ------------------------------------------------- *)
@@ -624,74 +624,74 @@
 structure Path = Url.Path
 
 fun fetch {head: bool,
-	   headers: Header.t list,
-	   post: Post.t option,
-	   proxy: {host: string, port: int} option,
-	   url: Url.t}: In.t =
+           headers: Header.t list,
+           post: Post.t option,
+           proxy: {host: string, port: int} option,
+           url: Url.t}: In.t =
    let
       open Url
    in
       case url of
-	 Url.T {authority = SOME {user, host, port},
-		fragment, path, query,
-		scheme = SOME Scheme.Http} =>
-	 let
-	    val headers = Header.Host host :: headers
-	    val (method, headers, postit) =
-	       case post of
-		  NONE =>
-		     (if head then Method.Head else Method.Get,
-			 headers,
-			 fn _ => ())
-		| SOME post =>
-		     let
-			datatype z = datatype Post.Encoding.t
-			val ({contentType}, rope) = Post.encode post
-			val headers =
-			   headers
-			   @ [Header.ContentType contentType,
-			      Header.ContentLength (Rope.size rope)]
-		     in
-			(Method.Post, headers,
-			 fn out => (Rope.output (rope, out)
-				    ; Out.output (out, "\r\n")))
-		     end
-	    val (scheme, authority) =
-	       if Option.isSome proxy
-		  then (SOME Scheme.Http,
-			SOME {user = NONE,
-			      host = host,
-			      port = port})
-	       else (NONE, NONE)
-	    val url =
-	       Url.T {scheme = scheme,
-		      authority = authority,
-		      path = path,
-		      query = query,
-		      fragment = NONE}
-	    val headers =
-	       case user of
-		  NONE => headers
-		| SOME user => Header.Authorization user :: headers
-	    val request =
-	       Request.T {method = method,
-			  url = RequestUrl.Url url,
-			  version = Version.v10,
-			  headers = headers}
-	    val (ins, out) =
-	       Net.connect (case proxy of
-			       NONE => {host = host,
-					port = (case port of
-						   NONE => 80
-						 | SOME p => p)}
-			     | SOME hp => hp)
-	    val print = Out.outputc out
-	    val () = Request.output (request, out)
+         Url.T {authority = SOME {user, host, port},
+                fragment, path, query,
+                scheme = SOME Scheme.Http} =>
+         let
+            val headers = Header.Host host :: headers
+            val (method, headers, postit) =
+               case post of
+                  NONE =>
+                     (if head then Method.Head else Method.Get,
+                         headers,
+                         fn _ => ())
+                | SOME post =>
+                     let
+                        datatype z = datatype Post.Encoding.t
+                        val ({contentType}, rope) = Post.encode post
+                        val headers =
+                           headers
+                           @ [Header.ContentType contentType,
+                              Header.ContentLength (Rope.size rope)]
+                     in
+                        (Method.Post, headers,
+                         fn out => (Rope.output (rope, out)
+                                    ; Out.output (out, "\r\n")))
+                     end
+            val (scheme, authority) =
+               if Option.isSome proxy
+                  then (SOME Scheme.Http,
+                        SOME {user = NONE,
+                              host = host,
+                              port = port})
+               else (NONE, NONE)
+            val url =
+               Url.T {scheme = scheme,
+                      authority = authority,
+                      path = path,
+                      query = query,
+                      fragment = NONE}
+            val headers =
+               case user of
+                  NONE => headers
+                | SOME user => Header.Authorization user :: headers
+            val request =
+               Request.T {method = method,
+                          url = RequestUrl.Url url,
+                          version = Version.v10,
+                          headers = headers}
+            val (ins, out) =
+               Net.connect (case proxy of
+                               NONE => {host = host,
+                                        port = (case port of
+                                                   NONE => 80
+                                                 | SOME p => p)}
+                             | SOME hp => hp)
+            val print = Out.outputc out
+            val () = Request.output (request, out)
             val () = postit out
-	    val () = Out.close out
-	 in ins
-	 end
-	      | _ => Error.bug (concat ["can't fetch Url: ", Url.toString url])
+            val () = Out.close out
+         in ins
+         end
+              | _ => Error.bug (concat ["Htt.fetch: ", Url.toString url])
    end
 
 val fetch =
@@ -705,7 +705,7 @@
 structure Status =
    struct
       datatype t =
-	 Accepted
+         Accepted
        | BadGateway
        | BadRequest
        | Conflict
@@ -748,68 +748,68 @@
        | UseProxy
 
       val all =
-	 [(Continue, "100", "Continue"),
-	  (SwitchingProtocols, "101", "Switching Protocols"),
-	  (OK, "200", "OK"),
-	  (Created, "201", "Created"),
-	  (Accepted, "202", "Accepted"),
-	  (NonAuthoritativeInformation, "203", "Non-Authoritative Information"),
-	  (NoContent, "204", "No Content"),
-	  (ResetContent, "205", "Reset Content"),
-	  (PartialContent, "206", "Partial Content"),
-	  (MultipleChoices, "300", "Multiple Choices"),
-	  (MovedPermanently, "301", "Moved Permanently"),
-	  (Found, "302", "Found"),
-	  (SeeOther, "303", "See Other"),
-	  (NotModified, "304", "Not Modified"),
-	  (UseProxy, "305", "Use Proxy"),
-	  (TemporaryRedirect, "307", "Temporary Redirect"),
-	  (BadRequest, "400", "Bad Request"),
-	  (Unauthorized, "401", "Unauthorized"),
-	  (PaymentRequired, "402", "Payment Required"),
-	  (Forbidden, "403", "Forbidden"),
-	  (NotFound, "404", "Not Found"),
-	  (MethodNotAllowed, "405", "Method Not Allowed"),
-	  (NotAcceptable, "406", "Not Acceptable"),
-	  (ProxyAuthenticationRequired, "407", "Proxy Authentication Required"),
-	  (RequestTimeout, "408", "Request Time-out"),
-	  (Conflict, "409", "Conflict"),
-	  (Gone, "410", "Gone"),
-	  (LengthRequired, "411", "Length Required"),
-	  (PreconditionFailed, "412", "Precondition Failed"),
-	  (RequestEntityTooLarge, "413", "Request Entity Too Large"),
-	  (RequestUriTooLarge, "414", "Request-URI Too Large"),
-	  (UnsupportedMediaType, "415", "Unsupported Media Type"),
-	  (RequestedRangeNotSatisfiable, "416",
-	   "Requested range not satisfiable"),
-	  (ExpectationFailed, "417", "Expectation Failed"),
-	  (InternalServerError, "500", "Internal Server Error"),
-	  (NotImplemented, "501", "Not Implemented"),
-	  (BadGateway, "502", "Bad Gateway"),
-	  (ServiceUnavailable, "503", "Service Unavailable"),
-	  (GatewayTimeout, "504", "Gateway Time-out"),
-	  (HTTPVersionNotSupported, "505", "HTTP Version not supported")]
+         [(Continue, "100", "Continue"),
+          (SwitchingProtocols, "101", "Switching Protocols"),
+          (OK, "200", "OK"),
+          (Created, "201", "Created"),
+          (Accepted, "202", "Accepted"),
+          (NonAuthoritativeInformation, "203", "Non-Authoritative Information"),
+          (NoContent, "204", "No Content"),
+          (ResetContent, "205", "Reset Content"),
+          (PartialContent, "206", "Partial Content"),
+          (MultipleChoices, "300", "Multiple Choices"),
+          (MovedPermanently, "301", "Moved Permanently"),
+          (Found, "302", "Found"),
+          (SeeOther, "303", "See Other"),
+          (NotModified, "304", "Not Modified"),
+          (UseProxy, "305", "Use Proxy"),
+          (TemporaryRedirect, "307", "Temporary Redirect"),
+          (BadRequest, "400", "Bad Request"),
+          (Unauthorized, "401", "Unauthorized"),
+          (PaymentRequired, "402", "Payment Required"),
+          (Forbidden, "403", "Forbidden"),
+          (NotFound, "404", "Not Found"),
+          (MethodNotAllowed, "405", "Method Not Allowed"),
+          (NotAcceptable, "406", "Not Acceptable"),
+          (ProxyAuthenticationRequired, "407", "Proxy Authentication Required"),
+          (RequestTimeout, "408", "Request Time-out"),
+          (Conflict, "409", "Conflict"),
+          (Gone, "410", "Gone"),
+          (LengthRequired, "411", "Length Required"),
+          (PreconditionFailed, "412", "Precondition Failed"),
+          (RequestEntityTooLarge, "413", "Request Entity Too Large"),
+          (RequestUriTooLarge, "414", "Request-URI Too Large"),
+          (UnsupportedMediaType, "415", "Unsupported Media Type"),
+          (RequestedRangeNotSatisfiable, "416",
+           "Requested range not satisfiable"),
+          (ExpectationFailed, "417", "Expectation Failed"),
+          (InternalServerError, "500", "Internal Server Error"),
+          (NotImplemented, "501", "Not Implemented"),
+          (BadGateway, "502", "Bad Gateway"),
+          (ServiceUnavailable, "503", "Service Unavailable"),
+          (GatewayTimeout, "504", "Gateway Time-out"),
+          (HTTPVersionNotSupported, "505", "HTTP Version not supported")]
 
       val all =
-	 List.revMap (all, fn (status, code, reason) =>
-		      {status = status,
-		       code = code,
-		       reason = reason})
+         List.revMap (all, fn (status, code, reason) =>
+                      {status = status,
+                       code = code,
+                       reason = reason})
 
       fun fromString s =
-	 case List.peek (all, fn {code, ...} => s = code) of
-	    NONE => Extension s
-	  | SOME {status, ...} => status
+         case List.peek (all, fn {code, ...} => s = code) of
+            NONE => Extension s
+          | SOME {status, ...} => status
 
       local
-	 fun make (ext, sel) (s: t) =
-	    case s of
-	       Extension c => ext c
-	     | _ => sel (valOf (List.peek (all, fn {status, ...} => s = status)))
+         fun make (ext, sel) (s: t) =
+            case s of
+               Extension c => ext c
+             | _ => sel (valOf (List.peek (all, fn {status, ...} => s = status)))
       in
-	 val code = make (fn c => c, #code)
-	 val reason = make (fn _ => "Extension Status Code - No Reason",
-			    #reason)
+         val code = make (fn c => c, #code)
+         val reason = make (fn _ => "Extension Status Code - No Reason",
+                            #reason)
       end
    end
 
@@ -820,43 +820,43 @@
 structure Response =
    struct
       datatype t = T of {version: Version.t,
-			 status: Status.t,
-			 headers: Header.t list}
+                         status: Status.t,
+                         headers: Header.t list}
 
       val regexp = Regexp.responseLine
 
       fun toString (T {version, status, headers}) =
-	 concat ([Version.toString version, " ",
-		  Status.code status, " ",
-		  Status.reason status, "\r\n"]
-		 @ Header.toStrings headers
-		 @ ["\r\n"])
+         concat ([Version.toString version, " ",
+                  Status.code status, " ",
+                  Status.reason status, "\r\n"]
+                 @ Header.toStrings headers
+                 @ ["\r\n"])
 
       val layout = Layout.str o toString
 
       fun output (r, out) = Out.output (out, toString r)
-	 
+         
       fun input (ins: In.t): t Result.t =
-	 case In.inputLine ins of
-	    NONE => Result.No ""
-	  | SOME l => 
-	       let 
-		  open Regexp
-	       in
-		  case Compiled.matchAll (responseLine (), l) of
-		     NONE => Result.No l
-		   | SOME m => 
-			let
-			   val {lookup, ...} = Match.stringFuns m
-			   val version = Version.extract m
-			   val status = Status.fromString (lookup status')
-			in
-			   Result.map (Header.input ins, fn hs =>
-				       T {version = version,
-					  status = status,
-					  headers = hs})
-			end
-	       end
+         case In.inputLine ins of
+            NONE => Result.No ""
+          | SOME l => 
+               let 
+                  open Regexp
+               in
+                  case Compiled.matchAll (responseLine (), l) of
+                     NONE => Result.No l
+                   | SOME m => 
+                        let
+                           val {lookup, ...} = Match.stringFuns m
+                           val version = Version.extract m
+                           val status = Status.fromString (lookup status')
+                        in
+                           Result.map (Header.input ins, fn hs =>
+                                       T {version = version,
+                                          status = status,
+                                          headers = hs})
+                        end
+               end
    end
 
 end

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/init-script.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/init-script.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/init-script.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,14 +1,15 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature INIT_SCRIPT =
    sig
       val startStop: {name: string,
-		      action: string,
-		      log: File.t,
-		      thunk: unit -> unit,
-		      usage: string -> unit} -> unit
+                      action: string,
+                      log: File.t,
+                      thunk: unit -> unit,
+                      usage: string -> unit} -> unit
    end

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/init-script.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/init-script.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/init-script.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 structure InitScript: INIT_SCRIPT =
 struct
 
@@ -15,14 +16,14 @@
    open Console open Foreground CharRendition
    fun make (settings, msg) =
       let
-	 val color = concat [moveToColumn 60, "[  ", set settings, msg,
-			    set [Default], "  ]\n"]
-	 val normal = concat [" [ ", msg, " ]\n"]
+         val color = concat [moveToColumn 60, "[  ", set settings, msg,
+                            set [Default], "  ]\n"]
+         val normal = concat [" [ ", msg, " ]\n"]
       in fn () =>
-	 print (case Process.getEnv "TERM" of
-		  SOME "linux" => color
-		| SOME "xterm" => color
-		| _ => normal)
+         print (case Process.getEnv "TERM" of
+                  SOME "linux" => color
+                | SOME "xterm" => color
+                | _ => normal)
       end
 in
    val succeed = make ([Bold, Foreground BrightGreen], "OK")
@@ -38,50 +39,50 @@
    let
       val me = Pid.current ()
       fun getProc () =
-	 List.peek (Process.ps (), fn {name = n, pid, ...} =>
-		    n = name andalso not (Pid.equals (me, pid)))
+         List.peek (Process.ps (), fn {name = n, pid, ...} =>
+                    n = name andalso not (Pid.equals (me, pid)))
       val isRunning = isSome o getProc
       fun start () =
-	 if isRunning ()
-	    then print (concat [name, " is already running\n"])
-	 else
-	    wrap
-	    (fn () =>
-	     let
-		val _ = print (concat ["Starting ", name, ":"])
-		val _ = Out.close Out.error
-		val _ = Out.set (Out.error, Out.openAppend log)
-		val _ =
-		   Process.doubleFork
-		   (fn () =>
-		    let
-		       val _ = In.close In.standard
-		       val _ = Out.close Out.standard
-		       val _ = Posix.ProcEnv.setpgid {pid = NONE, pgid = NONE}
-		       val _ =
-			  Signal.setHandler
-			  (Posix.Signal.term, Signal.Handler.handler (fn _ =>
-			   Thread.new
-			   (fn () =>
-			    (messageStr "received Signal.term -- exiting"
-			     ; Process.succeed ()))))
-		    in
-		       thunk ()
-		    end)
-	     in ()
-	     end)
+         if isRunning ()
+            then print (concat [name, " is already running\n"])
+         else
+            wrap
+            (fn () =>
+             let
+                val _ = print (concat ["Starting ", name, ":"])
+                val _ = Out.close Out.error
+                val _ = Out.set (Out.error, Out.openAppend log)
+                val _ =
+                   Process.doubleFork
+                   (fn () =>
+                    let
+                       val _ = In.close In.standard
+                       val _ = Out.close Out.standard
+                       val _ = Posix.ProcEnv.setpgid {pid = NONE, pgid = NONE}
+                       val _ =
+                          Signal.setHandler
+                          (Posix.Signal.term, Signal.Handler.handler (fn _ =>
+                           Thread.new
+                           (fn () =>
+                            (messageStr "received Signal.term -- exiting"
+                             ; Process.succeed ()))))
+                    in
+                       thunk ()
+                    end)
+             in ()
+             end)
       fun status () =
-	 print (concat [name,
-			if isRunning ()
-			   then " is running\n"
-			else " is not running\n"])
+         print (concat [name,
+                        if isRunning ()
+                           then " is running\n"
+                        else " is not running\n"])
       fun stop () =
-	 case getProc () of
-	    NONE => print (concat [name, " is not running\n"])
-	  | SOME {pgrp, ...} => 
-	       wrap (fn () =>
-		     (print (concat ["Shutting down ", name, ":"])
-		      ; Process.signalGroup (pgrp, Posix.Signal.term)))
+         case getProc () of
+            NONE => print (concat [name, " is not running\n"])
+          | SOME {pgrp, ...} => 
+               wrap (fn () =>
+                     (print (concat ["Shutting down ", name, ":"])
+                      ; Process.signalGroup (pgrp, Posix.Signal.term)))
    in case action of
       "start" => start ()
     | "status" => status ()

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/insertion-sort.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/insertion-sort.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/insertion-sort.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 type int = Int.t
 
 signature INSERTION_SORT =

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/insertion-sort.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/insertion-sort.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/insertion-sort.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 structure InsertionSort: INSERTION_SORT =
 struct
 
@@ -14,42 +15,42 @@
    let
       fun x i = sub (a, i)
       val _ =
-	 Int.for
-	 (1, Array.length a, fn i =>
-	  let
-	     val _ =
-		if true
-		   then ()
-		else
-		   Assert.assert ("insertionSort1", fn () =>
-				  Array.isSortedRange (a, 0, i, op <=))
-	     val t = x i
-	     fun sift (j: int) =
-		(if true
-		    then ()
-		 else
-		    Assert.assert
-		    ("insertionSort2", fn () =>
-		     Array.isSortedRange (a, 0, j, op <=)
-		     andalso Array.isSortedRange (a, j + 1, i + 1, op <=)
-		     andalso Int.forall (j + 1, i + 1, fn k => t <= x k))
-		 ; if j > 0
-		      then
-			 let
-			    val j' = j - 1
-			    val z = x j'
-			 in
-			    if z <= t
-			       then j
-			    else (update (a, j, z)
-				  ; sift j')
-			 end
-		   else j)
-	     val _ = update (a, sift i, t)
-	  in ()
-	  end)
+         Int.for
+         (1, Array.length a, fn i =>
+          let
+             val _ =
+                if true
+                   then ()
+                else
+                   Assert.assert ("InsertionSort.sort: 1", fn () =>
+                                  Array.isSortedRange (a, 0, i, op <=))
+             val t = x i
+             fun sift (j: int) =
+                (if true
+                    then ()
+                 else
+                    Assert.assert
+                    ("InsertionSort.sort: 2", fn () =>
+                     Array.isSortedRange (a, 0, j, op <=)
+                     andalso Array.isSortedRange (a, j + 1, i + 1, op <=)
+                     andalso Int.forall (j + 1, i + 1, fn k => t <= x k))
+                 ; if j > 0
+                      then
+                         let
+                            val j' = j - 1
+                            val z = x j'
+                         in
+                            if z <= t
+                               then j
+                            else (update (a, j, z)
+                                  ; sift j')
+                         end
+                   else j)
+             val _ = update (a, sift i, t)
+          in ()
+          end)
       val _ =
-	 Assert.assert ("insertionSort3", fn () => isSorted (a, op <=))
+         Assert.assert ("InsertionSort.sort: 3", fn () => isSorted (a, op <=))
    in
       ()
    end

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/instream.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/instream.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/instream.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 type int = Pervasive.Int.int
    
 signature INSTREAM =
@@ -32,7 +33,7 @@
       val layout: t -> Layout.t
       (* Each line includes the newline. *)
       val lines: t -> string list
-      val openIn: string -> t	 
+      val openIn: string -> t    
       val openString: string -> t
       val outputAll: t * Out.t -> unit
       val peekChar: t -> char option

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/instream.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/instream.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/instream.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 structure Instream: INSTREAM =
 struct
 
@@ -12,27 +13,27 @@
 structure String = ZString
 
 val input =
-   Trace.trace ("In.input", layout, String.layout) input
-	       
+   Trace.trace ("Instream.input", layout, String.layout) input
+               
 fun outputAll (ins: t, out: Out.t): unit =
    let
       fun loop () =
          case input ins of
-	    "" => ()
-	  | s => (Out.output (out, s); loop ())
+            "" => ()
+          | s => (Out.output (out, s); loop ())
    in
       loop ()
    end
 
 val inputLine =
-   Trace.trace ("In.inputLine", layout, Option.layout String.layout) inputLine
+   Trace.trace ("Instream.inputLine", layout, Option.layout String.layout) inputLine
 
 fun 'a withClose (ins: t, f: t -> 'a): 'a =
-   DynamicWind.wind (fn () => f ins, fn () => close ins)
+   Exn.finally (fn () => f ins, fn () => close ins)
 
 fun 'a withIn (f: string, g: t -> 'a): 'a =
    withClose (openIn f handle IO.Io _ =>
-	      Error.bug (concat ["cannot open ", f]), g)
+              Error.bug (concat ["Instream.withIn: cannot open ", f]), g)
 
 fun withNull f = withIn ("/dev/zero", f)
 

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/instream0.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/instream0.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/instream0.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 structure Instream0 =
 struct
 
@@ -23,9 +24,9 @@
 fun foldChars (ins, a, f) =
    let
       fun loop a =
-	 case inputLine ins of
-	    NONE => a
-	  | SOME l => loop (String.fold (l, a, f))
+         case inputLine ins of
+            NONE => a
+          | SOME l => loop (String.fold (l, a, f))
    in
       loop a
    end
@@ -33,9 +34,9 @@
 fun foldLines (ins, ac, f) =
    let
       fun loop ac =
-	 case inputLine ins of
-	    NONE => ac
-	  | SOME l => loop (f (l, ac))
+         case inputLine ins of
+            NONE => ac
+          | SOME l => loop (f (l, ac))
    in loop ac
    end
 
@@ -46,22 +47,22 @@
       val maxListLength = 1000
       fun finish chars = String.rev (String.implode chars)
       fun loop (n, chars, strings) =
-	 case peekChar i of
-	    NONE => (chars, strings)
-	  | SOME c =>
-	       if p c
-		  then (chars, strings)
-	       else
-		  let
-		     val chars = c :: chars
-		     val _ = inputChar i
-		  in
-		     if n > 0
-			then loop (n - 1, chars, strings)
-		     else loop (maxListLength,
-				[],
-				finish chars :: strings)
-		  end
+         case peekChar i of
+            NONE => (chars, strings)
+          | SOME c =>
+               if p c
+                  then (chars, strings)
+               else
+                  let
+                     val chars = c :: chars
+                     val _ = inputChar i
+                  in
+                     if n > 0
+                        then loop (n - 1, chars, strings)
+                     else loop (maxListLength,
+                                [],
+                                finish chars :: strings)
+                  end
       val (chars, strings) = loop (maxListLength, [], [])
    in
       concat (rev (finish chars :: strings))
@@ -70,10 +71,10 @@
 fun sameContents (in1, in2) =
    let
       fun loop () =
-	 case (input1 in1, input1 in2) of
-	    (NONE, NONE) => true
-	  | (SOME c1, SOME c2) => Char.equals (c1, c2) andalso loop ()
-	  | _ => false
+         case (input1 in1, input1 in2) of
+            (NONE, NONE) => true
+          | (SOME c1, SOME c2) => Char.equals (c1, c2) andalso loop ()
+          | _ => false
    in loop ()
    end
 

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/int-inf.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/int-inf.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/int-inf.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 type int = Int.t
 type word = Word.t
    

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/int-inf.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/int-inf.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/int-inf.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,35 +1,36 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 structure IntInf: INTEGER = Integer (open Pervasive.IntInf
-				     fun toIntInf x = x)
+                                     fun toIntInf x = x)
 
 structure IntInf: INT_INF =
    struct
       open IntInf 
 
       val hash = String.hash o toString
-	 
+         
       local
-	 open Pervasive.IntInf
+         open Pervasive.IntInf
       in
-	 val andb = andb
-	 val log2 = log2
-	 val notb = notb
-	 val orb = orb
-	 val xorb = xorb
-	 val op ~>> = ~>>
-	 val op << = <<
+         val andb = andb
+         val log2 = log2
+         val notb = notb
+         val orb = orb
+         val xorb = xorb
+         val op ~>> = ~>>
+         val op << = <<
       end
 
       structure M = MaxPow2ThatDivides (open IntInf
-					val andb = andb
-					val orb = orb
-					val << = <<
-					val >> = ~>>)
+                                        val andb = andb
+                                        val orb = orb
+                                        val << = <<
+                                        val >> = ~>>)
       open M
    end
 

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/int.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/int.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/int.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,15 +1,16 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 structure Int:
    sig
       include INTEGER
 
       type int
-	 
+         
       val maxInt: t
       val minInt: t
       val roundDownToPowerOfTwo: t -> t
@@ -19,22 +20,22 @@
    struct
       structure Int = Pervasive.Int
       structure I = Integer(open Int
-			    fun divMod(a, b) = (a div b, a mod b)
-			    fun quotRem(a, b) = (quot(a, b), rem(a, b))
-			    val toIntInf = Pervasive.IntInf.fromInt)
+                            fun divMod(a, b) = (a div b, a mod b)
+                            fun quotRem(a, b) = (quot(a, b), rem(a, b))
+                            val toIntInf = Pervasive.IntInf.fromInt)
       open I
 
       fun roundDownToPowerOfTwo (i: t): t =
-	 Word.toInt (Word.roundDownToPowerOfTwo (Word.fromInt i))
+         Word.toInt (Word.roundDownToPowerOfTwo (Word.fromInt i))
 
       fun roundUpToPowerOfTwo (i: t): t =
-	 let
-	    val i' = roundDownToPowerOfTwo i
-	 in
-	    if i = i'
-	       then i
-	    else i' * 2
-	 end
+         let
+            val i' = roundDownToPowerOfTwo i
+         in
+            if i = i'
+               then i
+            else i' * 2
+         end
 
       type int = t
       val maxInt = valOf Int.maxInt

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/integer.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/integer.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/integer.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 functor Integer (S: INTEGER_STRUCTS): INTEGER =
 struct
 
@@ -14,36 +15,36 @@
 structure Int =
    struct
       open S
-	 
+         
       type t = int
-	 
+         
       val zero = fromInt 0
-	 
+         
       val layout = Layout.str o toString
-	     
+             
       val equals = op =
    end
 
 structure R =
    OrderedRing (structure R = 
-		  RingWithIdentity (structure R = Ring (Int)
-				   open R S
-				   val one = fromInt 1)
-	       open R S
-	       val {compare, ...} =
-		  Relation.lessEqual {< = op <, equals = equals})
+                  RingWithIdentity (structure R = Ring (Int)
+                                   open R S
+                                   val one = fromInt 1)
+               open R S
+               val {compare, ...} =
+                  Relation.lessEqual {< = op <, equals = equals})
 open R S
 
 exception Input
 fun input i = (In.ignoreSpaces i
-	       ; (case fromString (In.inputToSpace i) of
-		     NONE => raise Input
-		   | SOME n => n))
+               ; (case fromString (In.inputToSpace i) of
+                     NONE => raise Input
+                   | SOME n => n))
 
 structure I = EuclideanRing (open R S
-			    val metric = toIntInf o abs
-			    val monics = Stream.infinite (two, fn n => n + one)
-			    val unitEquivalent = abs)
+                            val metric = toIntInf o abs
+                            val monics = Stream.infinite (two, fn n => n + one)
+                            val unitEquivalent = abs)
 open I
 
 fun isEven n = isZero (n mod two)
@@ -53,17 +54,17 @@
 fun toCommaString n =
    let
       fun loop (chars, accum) =
-	 let
-	    fun done () = implode (rev chars @ accum)
-	 in
-	    case chars of
-	       x1 :: x2 :: x3 :: chars =>
-		  (case chars of
-		      [] => done ()
-		    | [#"~"] => done ()
-		    | _ => loop (chars, #"," :: x3 :: x2 :: x1 :: accum))
-	     | _ => done ()
-	 end
+         let
+            fun done () = implode (rev chars @ accum)
+         in
+            case chars of
+               x1 :: x2 :: x3 :: chars =>
+                  (case chars of
+                      [] => done ()
+                    | [#"~"] => done ()
+                    | _ => loop (chars, #"," :: x3 :: x2 :: x1 :: accum))
+             | _ => done ()
+         end
    in loop (rev (explode (toString n)), [])
    end
 
@@ -78,9 +79,9 @@
 fun largest (i, f) =
    let
       fun loop (n: t) =
-	 if f n
-	    then n
-	 else loop (sub1 n)
+         if f n
+            then n
+         else loop (sub1 n)
    in
       loop i
    end
@@ -88,48 +89,48 @@
 fun smallest (i, f) =
    let
       fun loop (n: t) =
-	 if f n
-	    then n
-	 else loop (add1 n)
+         if f n
+            then n
+         else loop (add1 n)
    in loop i
    end
 
 fun least (start: t, stop: t, f: int -> bool): int option =
    let
       fun loop (i: t) =
-	 if i >= stop
-	    then NONE
-	 else if f i
-		 then SOME i
-	      else loop (i + one)
+         if i >= stop
+            then NONE
+         else if f i
+                 then SOME i
+              else loop (i + one)
    in loop start
    end
 
 fun 'a fold (start: t, stop: t, a: 'a, f: int * 'a -> 'a): 'a =
    let
-      val _ = Assert.assert ("fold", fn () => start <= stop + one)
+      val _ = Assert.assert ("Integer.fold", fn () => start <= stop + one)
       fun loop (i: t, a: 'a): 'a =
-	 if i >= stop
-	    then a
-	 else loop (i + one, f (i, a))
+         if i >= stop
+            then a
+         else loop (i + one, f (i, a))
    in loop (start, a)
    end
 
 fun forall (start: t, stop: t, f: int -> bool): bool =
-   DynamicWind.withEscape
+   Exn.withEscape
    (fn escape => (fold (start, stop, (), fn (i, ()) =>
-		       if f i then () else escape false)
-		  ; true))
+                       if f i then () else escape false)
+                  ; true))
 
 fun exists (start, stop, f) = not (forall (start, stop, not o f))
 
 fun 'a foldDown (start: t, stop: t, a: 'a, f: int * 'a -> 'a): 'a =
    let
-      val _ = Assert.assert ("foldDown", fn () => start <= stop + one)
+      val _ = Assert.assert ("Integer.foldDown", fn () => start <= stop + one)
       fun loop (i: t, a: 'a) =
-	 if i < start
-	    then a
-	 else loop (sub1 i, f (i, a))
+         if i < start
+            then a
+         else loop (sub1 i, f (i, a))
    in loop (sub1 stop, a)
    end
 
@@ -145,5 +146,5 @@
 fun scan (radix, reader) = Int.scan radix reader
 
 fun format (i, r) = fmt r i
-	    
+            
 end

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/integer.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/integer.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/integer.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature INTEGER_STRUCTS =
    sig
       eqtype int
@@ -34,8 +35,8 @@
       val rem: int * int -> int
       val sameSign: int * int -> bool 
       val scan: StringCvt.radix
-	 -> (char, 'a) StringCvt.reader
-	 -> (int, 'a) StringCvt.reader
+         -> (char, 'a) StringCvt.reader
+         -> (int, 'a) StringCvt.reader
       val sign: int -> Pervasive.Int.int 
       val toInt: int -> Pervasive.Int.int 
       val toIntInf: int -> Pervasive.IntInf.int
@@ -81,7 +82,7 @@
       val quotRem: t * t -> t * t
       val rem: t * t -> t
       val scan: (StringCvt.radix * (char, 'a) StringCvt.reader)
-	 -> (t, 'a) StringCvt.reader
+         -> (t, 'a) StringCvt.reader
       (* smallest (i, f) is the smallest j >= i such that f j *)
       val smallest: t * (t -> bool) -> t
       (* val sum: {from: t, to: t, term: t -> t} -> t *)

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/intermediate-computation.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/intermediate-computation.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/intermediate-computation.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature INTERMEDIATE_COMPUTATION_STRUCTS =
    sig
    end

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/intermediate-computation.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/intermediate-computation.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/intermediate-computation.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 structure IntermediateComputation: INTERMEDIATE_COMPUTATION = 
 struct
 
@@ -13,215 +14,215 @@
 structure Result =
    struct
       datatype t =
-	 Raise
+         Raise
        | Return of unit -> Layout.t
 
       local open Layout
       in
-	 fun layout r =
-	    case r of
-	       Raise => str "raise"
-	     | Return f => f()
+         fun layout r =
+            case r of
+               Raise => str "raise"
+             | Return f => f()
       end
    end
 
 structure Computation =
    struct
       structure Time = Time
-	 
+         
       datatype t = T of callResult list
       withtype callResult = {name: string,
-			     layoutArg: unit -> Layout.t,
-			     time: Time.t option,
-			     body: t,
-			     result: Result.t}
+                             layoutArg: unit -> Layout.t,
+                             time: Time.t option,
+                             body: t,
+                             result: Result.t}
 
       structure CR =
-	 struct
-	    open Layout
+         struct
+            open Layout
 
-	    type t = callResult
+            type t = callResult
 
-	    fun layoutName({name, ...}:t) = str(name ^ " ")
-	       
-	    fun layoutCall(cr as {layoutArg, ...}:t) =
-	       seq[layoutName cr, layoutArg()]
+            fun layoutName({name, ...}:t) = str(name ^ " ")
+               
+            fun layoutCall(cr as {layoutArg, ...}:t) =
+               seq[layoutName cr, layoutArg()]
 
-	    val darrow = str "==> "
-	       
-	    fun layoutDarrow _ = darrow
-	       
-	    fun layoutTime({time, ...}:t) =
-	       case time of
-		  SOME t => Time.layout t
-		| NONE => empty
-		     
-	    fun layoutReturn({result, ...}:t) =
-	       seq[darrow, Result.layout result]
-	 end
+            val darrow = str "==> "
+               
+            fun layoutDarrow _ = darrow
+               
+            fun layoutTime({time, ...}:t) =
+               case time of
+                  SOME t => Time.layout t
+                | NONE => empty
+                     
+            fun layoutReturn({result, ...}:t) =
+               seq[darrow, Result.layout result]
+         end
 
       fun time(T crs) = List.fold(crs, Time.zero, fn ({time, ...}, t) =>
-				  case time of
-				     NONE => t
-				   | SOME t' => Time.+(t, t'))
+                                  case time of
+                                     NONE => t
+                                   | SOME t' => Time.+(t, t'))
 
       fun keepAll(c, pred) =
-	 let
-	    fun keepAll(T crs) =
-	       T(List.foldr(crs, [],
-			    fn ({name, body, layoutArg, time, result}, crs) =>
-			    let val body as T crs' = keepAll body
-			    in if pred name
-				  then {name = name, body = body,
-					layoutArg = layoutArg, time = time,
-					result = result} :: crs
-			       else crs' @ crs
-			    end))
-	 in keepAll c
-	 end
+         let
+            fun keepAll(T crs) =
+               T(List.foldr(crs, [],
+                            fn ({name, body, layoutArg, time, result}, crs) =>
+                            let val body as T crs' = keepAll body
+                            in if pred name
+                                  then {name = name, body = body,
+                                        layoutArg = layoutArg, time = time,
+                                        result = result} :: crs
+                               else crs' @ crs
+                            end))
+         in keepAll c
+         end
 
       fun makeOutputs(pre, post, filter) out =
-	 let val indentation = ref 0
-	    val space = 3
-	    fun left() = indentation := !indentation - space
-	    fun right() = indentation := !indentation + space
-	    fun print l = (Layout.output(Layout.indent(l, !indentation), out)
-			   ; Out.newline out)
-	    fun output(T crs) = List.foreach(crs, outputCr)
-	    and outputCr(cr as {body, ...}) =
-	       let val printCr = filter cr
-	       in if printCr
-		     then (print(pre cr); right())
-		  else ()
-		     ; output body
-		     ; if printCr then (left(); print(post cr)) else ()
-	       end
-	 in (output, outputCr)
-	 end
+         let val indentation = ref 0
+            val space = 3
+            fun left() = indentation := !indentation - space
+            fun right() = indentation := !indentation + space
+            fun print l = (Layout.output(Layout.indent(l, !indentation), out)
+                           ; Out.newline out)
+            fun output(T crs) = List.foreach(crs, outputCr)
+            and outputCr(cr as {body, ...}) =
+               let val printCr = filter cr
+               in if printCr
+                     then (print(pre cr); right())
+                  else ()
+                     ; output body
+                     ; if printCr then (left(); print(post cr)) else ()
+               end
+         in (output, outputCr)
+         end
       
       val makeOutput =
-	 makeOutputs(CR.layoutCall, CR.layoutReturn, fn _ => true)
+         makeOutputs(CR.layoutCall, CR.layoutReturn, fn _ => true)
       fun output(c, out) = #1(makeOutput out) c
       fun outputCr(cr, out) = #2(makeOutput out) cr
 
       val makeOutputCalls =
-	 makeOutputs(CR.layoutName, CR.layoutDarrow, fn _ => true)
+         makeOutputs(CR.layoutName, CR.layoutDarrow, fn _ => true)
       fun outputCalls(c, out) = #1(makeOutputCalls out) c
       fun outputCrCalls(cr, out) = #2(makeOutputCalls out) cr
 
       fun outputTimes(c, out) =
-	 #1(makeOutputs(CR.layoutName, CR.layoutTime,
-			fn {time, ...} =>
-			case time of
-			   NONE => false
-			 | SOME _ => true) out) c
+         #1(makeOutputs(CR.layoutName, CR.layoutTime,
+                        fn {time, ...} =>
+                        case time of
+                           NONE => false
+                         | SOME _ => true) out) c
 
       local
-	 val out = Out.error
-	 val print = Out.outputc out
+         val out = Out.error
+         val print = Out.outputc out
 
-	 structure Int =
-	    struct
-	       open Int
+         structure Int =
+            struct
+               open Int
 
-	       exception Input
-	       fun input i = (In.ignoreSpaces i
-			      ; (case fromString(In.inputToSpace i) of
-				    NONE => raise Input
-				  | SOME n => n))
+               exception Input
+               fun input i = (In.ignoreSpaces i
+                              ; (case fromString(In.inputToSpace i) of
+                                    NONE => raise Input
+                                  | SOME n => n))
 
-	       fun inputBetween{ins, error, min, max} =
-		  let
-		     fun loop() =
-			let fun continue() = (error() ; loop())
-			in let val n = input ins
-			   in if min <= n andalso n <= max
-				 then n
-			      else continue()
-			   end handle Input => continue()
-			end
-		  in loop()
-		  end
+               fun inputBetween{ins, error: unit -> unit, min, max} =
+                  let
+                     fun loop() =
+                        let fun continue() = (error() ; loop())
+                        in let val n = input ins
+                           in if min <= n andalso n <= max
+                                 then n
+                              else continue()
+                           end handle Input => continue()
+                        end
+                  in loop()
+                  end
 
-	       val layout = Layout.str o toString
-	    end
+               val layout = Layout.str o toString
+            end
 
-	 fun inputBetween(min, max) =
-	   Int.inputBetween{ins = In.standard,
-			    error = fn () => Out.output(out, "? "),
-			    min = min, max = max}
+         fun inputBetween(min, max) =
+           Int.inputBetween{ins = In.standard,
+                            error = fn () => Out.output(out, "? "),
+                            min = min, max = max}
 
-	 fun choose (choices: (string * 'a) list): 'a =
-	    let
-	       val n =
-		  List.fold(choices, 0, fn ((name, _),n) =>
-			    (Layout.output(Int.layout n, out)
-			     ; print(concat[". ", name, "\n"])
-			     ; n+1))
-	       val _ = Out.output(out, "? ")
-	       val m = inputBetween(0,n-1)
-	    in #2(List.nth(choices, m))
-	    end
+         fun choose (choices: (string * 'a) list): 'a =
+            let
+               val n =
+                  List.fold(choices, 0, fn ((name, _),n) =>
+                            (Layout.output(Int.layout n, out)
+                             ; print(concat[". ", name, "\n"])
+                             ; n+1))
+               val _ = Out.output(out, "? ")
+               val m = inputBetween(0,n-1)
+            in #2(List.nth(choices, m))
+            end
 
-	 fun chooseThunk cs = choose cs ()
+         fun chooseThunk cs = choose cs ()
 
-	 exception Quit
-	 exception Back
-	 
-	 val standardChoices = [("quit", fn () => raise Quit),
-				("back", fn () => raise Back)]
-	 
-	 fun inspect(c as T crs) =
-	    case crs of
-	       [cr] => inspectCr cr
-	     | _ =>
-		  let
-		     fun loop() =
-			(chooseThunk
-			 (standardChoices
-			  @ [("skip raises", fn () =>
-			      (skipRaises c; raise Back)),
-			     ("output", fn () => output(c, out)),
-			     ("output calls",
-			      fn () => outputCalls(c, out))]
-			  @ choices c)
-			 ; loop())
-		  in loop() handle Back => ()
-		  end
-	 and choices(T crs) =
-	    List.map(crs, fn cr as {name, ...} =>
-		     ("  " ^ name, fn () => inspectCr cr))
-	 and inspectCr(cr as {name, layoutArg, body, result, time = _}) =
-	    (print(concat["Call to ", name, "\n"])
-	     ; let
-		  fun loop() =
-		     (chooseThunk
-		      (standardChoices
-		       @ [("skip raises", fn () =>
-			   (skipRaisesCr cr; raise Back)),
-			  ("output", fn () =>
-			   outputCr(cr, out)),
-			  ("output calls", fn () =>
-			   outputCrCalls(cr, out)),
-			  ("argument", fn () =>
-			   (Layout.output(layoutArg(), out)
-			    ; Out.newline out)),
-			  ("result", fn () =>
-			   (Layout.output(Result.layout result, out)
-			    ; Out.newline out))]
-		       @ choices body)
-		      ; loop())
-	       in loop() handle Back => ()
-	       end)
-	 and skipRaises(c as T crs) =
-	    case crs of
-	       [] => ()
-	     | _ => (skipRaisesCr(List.last crs)
-		     ; inspect c)
-	 and skipRaisesCr(cr as {result, body, ...}) =
-	    (case result of
-		Result.Raise => skipRaises body
-	      | Result.Return _ => ()
+         exception Quit
+         exception Back
+         
+         val standardChoices = [("quit", fn () => raise Quit),
+                                ("back", fn () => raise Back)]
+         
+         fun inspect(c as T crs) =
+            case crs of
+               [cr] => inspectCr cr
+             | _ =>
+                  let
+                     fun loop() =
+                        (chooseThunk
+                         (standardChoices
+                          @ [("skip raises", fn () =>
+                              (skipRaises c; raise Back)),
+                             ("output", fn () => output(c, out)),
+                             ("output calls",
+                              fn () => outputCalls(c, out))]
+                          @ choices c)
+                         ; loop())
+                  in loop() handle Back => ()
+                  end
+         and choices(T crs) =
+            List.map(crs, fn cr as {name, ...} =>
+                     ("  " ^ name, fn () => inspectCr cr))
+         and inspectCr(cr as {name, layoutArg, body, result, time = _}) =
+            (print(concat["Call to ", name, "\n"])
+             ; let
+                  fun loop() =
+                     (chooseThunk
+                      (standardChoices
+                       @ [("skip raises", fn () =>
+                           (skipRaisesCr cr; raise Back)),
+                          ("output", fn () =>
+                           outputCr(cr, out)),
+                          ("output calls", fn () =>
+                           outputCrCalls(cr, out)),
+                          ("argument", fn () =>
+                           (Layout.output(layoutArg(), out)
+                            ; Out.newline out)),
+                          ("result", fn () =>
+                           (Layout.output(Result.layout result, out)
+                            ; Out.newline out))]
+                       @ choices body)
+                      ; loop())
+               in loop() handle Back => ()
+               end)
+         and skipRaises(c as T crs) =
+            case crs of
+               [] => ()
+             | _ => (skipRaisesCr(List.last crs)
+                     ; inspect c)
+         and skipRaisesCr(cr as {result, body, ...}) =
+            (case result of
+                Result.Raise => skipRaises body
+              | Result.Return _ => ()
              ; inspectCr cr)
       in val inspect = fn c => inspect c handle Quit => ()
       end      
@@ -234,27 +235,27 @@
 
 datatype t =
    T of {calls: {name: string,
-		  layoutArg: unit -> Layout.t,
-		  prev: Computation.callResult list} list ref,
-	 after: Computation.callResult list ref}
+                  layoutArg: unit -> Layout.t,
+                  prev: Computation.callResult list} list ref,
+         after: Computation.callResult list ref}
 
 fun empty() = T{calls = ref [],
-		after = ref []}
+                after = ref []}
 
 fun atTopLevel(T{calls, ...}) = List.isEmpty(!calls)
-	    
+            
 fun call(T{calls, after},name, layoutArg) =
    (List.push(calls, {name = name, layoutArg = layoutArg, prev = !after})
     ; after := [])
    
 fun return(T{calls, after}, result, time) =
    case !calls of
-      [] => Error.bug "return without a call"
+      [] => Error.bug "IntermediateComputation.return: without a call"
     | {name, layoutArg, prev} :: cs =>
-	 (calls := cs
-	  ; after := {name = name, layoutArg = layoutArg,
-		      result = result, time = time,
-		      body = Computation.T(List.rev(!after))} :: prev)
+         (calls := cs
+          ; after := {name = name, layoutArg = layoutArg,
+                      result = result, time = time,
+                      body = Computation.T(List.rev(!after))} :: prev)
 
 fun raisee(c, t) = return(c, Result.Raise, t)
 val return = fn (c, r, t) => return(c, Result.Return r, t)
@@ -262,9 +263,9 @@
 fun finish(c as T{calls, after}) =
    let
       fun loop() =
-	 case !calls of
-	    [] => Computation.T(List.rev(!after))
-	  | _ => (raisee(c, NONE); loop())
+         case !calls of
+            [] => Computation.T(List.rev(!after))
+          | _ => (raisee(c, NONE); loop())
    in loop()
    end
 

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/iterate.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/iterate.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/iterate.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature ITERATE =
    sig
       val iterate: 'a * ('a -> bool) * ('a -> 'a) -> 'a

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/iterate.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/iterate.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/iterate.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,8 +1,8 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 (*-------------------------------------------------------------------*)
 (*                              Iterate                              *)

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/itimer.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/itimer.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/itimer.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,7 +1,8 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 structure Itimer = MLton.Itimer

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/justify.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/justify.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/justify.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,22 +1,23 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 type int = Int.t
    
 signature JUSTIFY =
    sig
       datatype t =
-	 Left
+         Left
        | Center
        | Right
 
       val justify: string * int * t -> string
       val outputTable: string list list * Out.t -> unit
       val table: {columnHeads: string list option,
-		  justs: t list,
-		  rows: string list list} -> string list list
+                  justs: t list,
+                  rows: string list list} -> string list list
       val tableOfColumns: (t * string list) list -> string list list
    end

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/justify.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/justify.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/justify.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 structure Justify: JUSTIFY =
 struct
 
@@ -26,57 +27,57 @@
     
 fun justify (s, width, just) =
     let val numchars = S.size s
-	val numspaces = width - numchars
+        val numspaces = width - numchars
     in S.concat
        (case just of
-	   Left => [s, spaces numspaces]
-	 | Center => let val numLeft = numspaces div 2
-			 val numRight = numspaces - numLeft
-		     in [spaces numLeft, s, spaces numRight]
-		     end
-	 | Right => [spaces numspaces, s])
+           Left => [s, spaces numspaces]
+         | Center => let val numLeft = numspaces div 2
+                         val numRight = numspaces - numLeft
+                     in [spaces numLeft, s, spaces numRight]
+                     end
+         | Right => [spaces numspaces, s])
     end
 
 fun table {columnHeads: string list option,
-	   justs: t list,
-	   rows: string list list} =
+           justs: t list,
+           rows: string list list} =
    let
       val headsAndRows =
-	 case columnHeads of
-	    NONE => rows
-	  | SOME h => h :: rows
+         case columnHeads of
+            NONE => rows
+          | SOME h => h :: rows
       val maxs =
-	 List.fold (headsAndRows,
-		    List.revMap (justs, fn _ => 0),
-		    fn (row, ms) =>
-		    List.map2 (row, ms, fn (s, m) => Int.max (m, String.size s)))
+         List.fold (headsAndRows,
+                    List.revMap (justs, fn _ => 0),
+                    fn (row, ms) =>
+                    List.map2 (row, ms, fn (s, m) => Int.max (m, String.size s)))
       val rows =
-	 List.map (rows, fn row => List.map3 (row, maxs, justs, justify))
+         List.map (rows, fn row => List.map3 (row, maxs, justs, justify))
       val rows =
-	 case columnHeads of
-	    NONE => rows
-	  | SOME heads =>
-	       let
-		  val heads = List.map2 (heads, maxs, fn (s, i) =>
-					 justify (s, i, Center))
-		  val dashes = List.map (maxs, fn i => String.make (i, #"-"))
-	       in
-		  heads :: dashes :: rows
-	       end
+         case columnHeads of
+            NONE => rows
+          | SOME heads =>
+               let
+                  val heads = List.map2 (heads, maxs, fn (s, i) =>
+                                         justify (s, i, Center))
+                  val dashes = List.map (maxs, fn i => String.make (i, #"-"))
+               in
+                  heads :: dashes :: rows
+               end
    in
       rows
    end
 
 val table =
-   Trace.trace ("table",
-		fn {columnHeads, justs, rows} =>
-		Layout.record [("columnHeads",
-				Option.layout (List.layout String.layout)
-				columnHeads),
-			       ("justs", List.layout layout justs),
-			       ("rows",
-				List.layout (List.layout String.layout) rows)],
-		List.layout (List.layout String.layout))
+   Trace.trace ("Justify.table",
+                fn {columnHeads, justs, rows} =>
+                Layout.record [("columnHeads",
+                                Option.layout (List.layout String.layout)
+                                columnHeads),
+                               ("justs", List.layout layout justs),
+                               ("rows",
+                                List.layout (List.layout String.layout) rows)],
+                List.layout (List.layout String.layout))
    table
 
 fun tableOfColumns (columns: (t * string list) list) =
@@ -84,14 +85,14 @@
       val justs = List.map (columns, #1)
       val columns = List.map (columns, #2)
       fun loop (columns: string list list, ac: string list list) =
-	 if List.isEmpty (hd columns)
-	    then rev ac
-	 else loop (List.map (columns, tl), List.map (columns, hd) :: ac)
+         if List.isEmpty (hd columns)
+            then rev ac
+         else loop (List.map (columns, tl), List.map (columns, hd) :: ac)
       val rows = loop (columns, [])
    in
       table {columnHeads = NONE,
-	     justs = justs,
-	     rows = rows}
+             justs = justs,
+             rows = rows}
    end
 
 fun outputTable (t, out) =
@@ -99,12 +100,12 @@
       val print = Out.outputc out
    in
       List.foreach (t, fn ss =>
-		    (case ss of
-			[] => ()
-		      | s :: ss =>
-			   (print s
-			    ; List.foreach (ss, fn s => (print " "; print s)))
-			   ; print "\n"))
+                    (case ss of
+                        [] => ()
+                      | s :: ss =>
+                           (print s
+                            ; List.foreach (ss, fn s => (print " "; print s)))
+                           ; print "\n"))
    end
 
 end

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/large-word.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/large-word.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/large-word.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,10 @@
+(* Copyright (C) 2003-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 structure LargeWord: WORD =
    struct
       open Pervasive.LargeWord

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/layout.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/layout.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/layout.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,15 +1,16 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature LAYOUT =
    sig
       type int = Pervasive.Int.int
-	 
+         
       type t
-	 
+         
       (* layout the objects on separate lines*)
       val align: t list -> t
       val alignPrefix: t list * string -> t
@@ -54,8 +55,8 @@
       val tuple2: ('a -> t) * ('b -> t) -> 'a * 'b -> t
       val tuple3: ('a -> t) * ('b -> t) * ('c -> t) -> 'a * 'b * 'c -> t
       val tuple4: ('a -> t) * ('b -> t) * ('c -> t) * ('d -> t)
-	 -> 'a * 'b * 'c * 'd -> t
+         -> 'a * 'b * 'c * 'd -> t
       val tuple5: ('a -> t) * ('b -> t) * ('c -> t) * ('d -> t) * ('e -> t)
-	 -> ('a * 'b * 'c * 'd * 'e) -> t
+         -> ('a * 'b * 'c * 'd * 'e) -> t
       val vector: t vector -> t
    end

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/layout.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/layout.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/layout.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 structure Layout: LAYOUT =
 struct
 
@@ -19,7 +20,7 @@
 structure String = String0
 
 datatype t = T of {length: int,
-		   tree: tree}
+                   tree: tree}
 and tree =
    Empty
   | String of string
@@ -51,18 +52,18 @@
 local
    fun make force ts =
       let
-	 fun loop ts =
-	    case ts of
-	       [] => (ts, 0)
-	     | t :: ts =>
-		  let val (ts, n) = loop ts
-		  in case length t of
-		     0 => (ts, n)
-		   | n' => (t :: ts, n + n' + 1)
-		  end
-	 val (ts, len) = loop ts
+         fun loop ts =
+            case ts of
+               [] => (ts, 0)
+             | t :: ts =>
+                  let val (ts, n) = loop ts
+                  in case length t of
+                     0 => (ts, n)
+                   | n' => (t :: ts, n + n' + 1)
+                  end
+         val (ts, len) = loop ts
       in case len of
-	 0 => empty
+         0 => empty
        | _ => T {length = len - 1, tree = Align {force = force, rows = ts}}
       end
 in
@@ -76,114 +77,114 @@
 
 fun blanks (n: int): string =
    concat [String.make (n div tabSize, #"\t"),
-	   String.make (n mod tabSize, #" ")]
+           String.make (n mod tabSize, #" ")]
 
 fun outputTree (t, out) =
    let val print = Out.outputc out
       fun loop (T {tree, length}) =
-	 (print "(length "
-	  ; print (Int.toString length)
-	  ; print ")"
-	  ; (case tree of
-		Empty => print "Empty"
-	      | String s => (print "(String "; print s; print ")")
-	      | Sequence ts => loops ("Sequence", ts)
-	      | Align {rows, ...} => loops ("Align", rows)
-	      | Indent (t, n) => (print "(Indent "
-				  ; print (Int.toString n)
-				  ; print " "
-				  ; loop t
-				  ; print ")")))
+         (print "(length "
+          ; print (Int.toString length)
+          ; print ")"
+          ; (case tree of
+                Empty => print "Empty"
+              | String s => (print "(String "; print s; print ")")
+              | Sequence ts => loops ("Sequence", ts)
+              | Align {rows, ...} => loops ("Align", rows)
+              | Indent (t, n) => (print "(Indent "
+                                  ; print (Int.toString n)
+                                  ; print " "
+                                  ; loop t
+                                  ; print ")")))
       and loops (s, ts) = (print "("
-			   ; print s
-			   ; app (fn t => (print " " ; loop t)) ts
-			   ; print ")")
+                           ; print s
+                           ; app (fn t => (print " " ; loop t)) ts
+                           ; print ")")
    in loop t
    end
 
 fun toString t =
    let
       fun loop (T {tree, ...}, accum) =
-	 case tree of
-	    Empty => accum
-	  | String s => s :: accum
-	  | Sequence ts => fold (ts, accum, loop)
-	  | Align {rows, ...} =>
-	       (case rows of
-		   [] => accum
-		 | t :: ts =>
-		      fold (ts, loop (t, accum), fn (t, ac) =>
-			    loop (t, " " :: ac)))
-	  | Indent (t, _) => loop (t, accum)
+         case tree of
+            Empty => accum
+          | String s => s :: accum
+          | Sequence ts => fold (ts, accum, loop)
+          | Align {rows, ...} =>
+               (case rows of
+                   [] => accum
+                 | t :: ts =>
+                      fold (ts, loop (t, accum), fn (t, ac) =>
+                            loop (t, " " :: ac)))
+          | Indent (t, _) => loop (t, accum)
    in
       String.concat (rev (loop (t, [])))
    end
 
 fun print {tree: t,
-	   print: string -> unit,
-	   lineWidth: int} =
+           print: string -> unit,
+           lineWidth: int} =
    let
       (*val _ = outputTree (t, out)*)
       fun newline () = print "\n"
 
       fun outputCompact (t, {at, printAt = _}) =
-	 let
-	    fun loop (T {tree, ...}) =
-	       case tree of
-		  Empty => ()
-		| String s => print s
-		| Sequence ts => app loop ts
-		| Indent (t, _) => loop t
-		| Align {rows, ...} =>
-		     case rows of
-			[] => ()
-		      | t :: ts => (loop t
-				    ; app (fn t => (print " "; loop t)) ts)
-	    val at = at + length t
-	 in loop t
-	    ; {at = at, printAt = at}
-	 end
+         let
+            fun loop (T {tree, ...}) =
+               case tree of
+                  Empty => ()
+                | String s => print s
+                | Sequence ts => app loop ts
+                | Indent (t, _) => loop t
+                | Align {rows, ...} =>
+                     case rows of
+                        [] => ()
+                      | t :: ts => (loop t
+                                    ; app (fn t => (print " "; loop t)) ts)
+            val at = at + length t
+         in loop t
+            ; {at = at, printAt = at}
+         end
 
       fun loop (t as T {length, tree}, state as {at, printAt}) =
-	 let
-	    fun prePrint () =
-	       if at >= printAt
-		  then () (* can't back up *)
-	       else print (blanks (printAt - at))
-	 in (*Out.print (concat ["at ", Int.toString at,
-	     * "  printAt ", Int.toString printAt,
+         let
+            fun prePrint () =
+               if at >= printAt
+                  then () (* can't back up *)
+               else print (blanks (printAt - at))
+         in (*Out.print (concat ["at ", Int.toString at,
+             * "  printAt ", Int.toString printAt,
              * "\n"]);
-	     *)
-	    (*outputTree (t, Out.error)*)
-	    case tree of
-	       Empty => state
-	     | Indent (t, n) => loop (t, {at = at, printAt = printAt + n})
-	     | Sequence ts => fold (ts, state, loop)
-	     | String s =>
-		  (prePrint ()
-		   ; print s
-		   ; let val at = printAt + length
-		     in {at = at, printAt = at}
-		     end)
-	     | Align {force, rows} =>
-		  if not force andalso printAt + length <= lineWidth
-		     then (prePrint ()
-			   ; outputCompact (t, state))
-		  else (case rows of
-			   [] => state
-			 | t :: ts =>
-			      fold
-			      (ts, loop (t, state), fn (t, _) =>
-			       (newline ()
-				; loop (t, {at = 0, printAt = printAt}))))
-	 end
+             *)
+            (*outputTree (t, Out.error)*)
+            case tree of
+               Empty => state
+             | Indent (t, n) => loop (t, {at = at, printAt = printAt + n})
+             | Sequence ts => fold (ts, state, loop)
+             | String s =>
+                  (prePrint ()
+                   ; print s
+                   ; let val at = printAt + length
+                     in {at = at, printAt = at}
+                     end)
+             | Align {force, rows} =>
+                  if not force andalso printAt + length <= lineWidth
+                     then (prePrint ()
+                           ; outputCompact (t, state))
+                  else (case rows of
+                           [] => state
+                         | t :: ts =>
+                              fold
+                              (ts, loop (t, state), fn (t, _) =>
+                               (newline ()
+                                ; loop (t, {at = 0, printAt = printAt}))))
+         end
    in ignore (loop (tree, {at = 0, printAt = 0}))
    end
 
 fun outputWidth (t, width, out) =
    print {tree = t,
-	  lineWidth = width,
-	  print = Out.outputc out}
+          lineWidth = width,
+          print = Out.outputc out}
 
 local
    val defaultWidth: int = 80
@@ -203,11 +204,11 @@
    case ts of
       [] => []
     | t :: ts => t :: (let val s = str s
-			   fun loop [] = []
-			     | loop (t :: ts) = s :: t:: (loop ts)
-		       in loop ts
-		       end)
-	 
+                           fun loop [] = []
+                             | loop (t :: ts) = s :: t:: (loop ts)
+                       in loop ts
+                       end)
+         
 fun separateLeft (ts, s) =
    case ts of
       [] => []
@@ -216,18 +217,18 @@
 
 fun separateRight (ts, s) =
    rev (let val ts = rev ts
-	in case ts of
-	   [] => []
-	 | [_] => ts
-	 | t :: ts => t :: (map (fn t => seq [t, str s]) ts)
-	end)
+        in case ts of
+           [] => []
+         | [_] => ts
+         | t :: ts => t :: (map (fn t => seq [t, str s]) ts)
+        end)
 
 fun alignPrefix (ts, prefix) =
    case ts of
       [] => empty
     | t :: ts =>
-	 mayAlign [t, indent (mayAlign (map (fn t => seq [str prefix, t]) ts),
-			      ~ (String.size prefix))]
+         mayAlign [t, indent (mayAlign (map (fn t => seq [str prefix, t]) ts),
+                              ~ (String.size prefix))]
 
 local
    fun sequence (start, finish, sep) ts =

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/lines.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/lines.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/lines.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 type int = Int.t
 
 signature LINES =

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/lines.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/lines.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/lines.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 structure Lines: LINES =
 struct
 
@@ -11,48 +12,48 @@
    let
       val _ = Assert.assert("Lines.startStop", fn () => start <= stop)
       fun loop i =
-	 if i > stop
-	    then ()
-	 else (case In.inputLine ins of
-		  NONE => ()
-		| SOME l => 
-		     (if i >= start
-			 then Out.output(out, l)
-		      else ();
-		      loop(i + 1)))
+         if i > stop
+            then ()
+         else (case In.inputLine ins of
+                  NONE => ()
+                | SOME l => 
+                     (if i >= start
+                         then Out.output(out, l)
+                      else ();
+                      loop(i + 1)))
    in loop 0
    end
 
 fun dropLast (ins, out, {start: int, last: int}): unit =
    let
       val _ = Assert.assert ("Lines.dropLast", fn () =>
-			     start >= 0 andalso last >= 0)
+                             start >= 0 andalso last >= 0)
       fun line () = In.inputLine ins
       val _ = Int.for (0, start, fn _ => ignore (line ()))
    in
       if last = 0
-	 then In.outputAll (ins, out)
+         then In.outputAll (ins, out)
       else
-	 let
-	    val q =
-	       Int.fold (0, last, Queue.empty (), fn (_, q) =>
-			 Queue.enque (q,
-				      case line () of
-					 NONE => ""
-				       | SOME l => l))
-	    fun loop (q: string Queue.t) =
-	       case line () of
-		  NONE => ()
-		| SOME l =>
-		     let
-			val q = Queue.enque (q, l)
-			val (q, l') = valOf (Queue.deque q)
-			val _ = Out.output (out, l')
-		    in
-		       loop q
-		    end
-	 in loop q
-	 end
+         let
+            val q =
+               Int.fold (0, last, Queue.empty (), fn (_, q) =>
+                         Queue.enque (q,
+                                      case line () of
+                                         NONE => ""
+                                       | SOME l => l))
+            fun loop (q: string Queue.t) =
+               case line () of
+                  NONE => ()
+                | SOME l =>
+                     let
+                        val q = Queue.enque (q, l)
+                        val (q, l') = valOf (Queue.deque q)
+                        val _ = Out.output (out, l')
+                    in
+                       loop q
+                    end
+         in loop q
+         end
    end
 
 

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/linked-list.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/linked-list.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/linked-list.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 type int = Int.t
 
 signature LINKED_LIST =
@@ -32,26 +33,26 @@
    
 val _ = 
    Assert.assert
-   ("LinkedList", fn () =>
+   ("TestLinkedList", fn () =>
     List.forall ([[],
-		  [1],
-		  [1, 2],
-		  [1, 2, 3]],
-		 fn l =>
-		 l = toList (fromList l)
-		 andalso rev l = toList (let
-					    val l' = fromList l
-					    val _ = reverse l'
-					 in
-					    l'
-					 end)
-		 andalso
-		 let
-		    val l' = fromList l
-		    val l'' = fromList l
-		    val _ = splice (l', l'')
-		 in
-		    l @ l = toList l'
-		 end))
+                  [1],
+                  [1, 2],
+                  [1, 2, 3]],
+                 fn l =>
+                 l = toList (fromList l)
+                 andalso rev l = toList (let
+                                            val l' = fromList l
+                                            val _ = reverse l'
+                                         in
+                                            l'
+                                         end)
+                 andalso
+                 let
+                    val l' = fromList l
+                    val l'' = fromList l
+                    val _ = splice (l', l'')
+                 in
+                    l @ l = toList l'
+                 end))
 
 end

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/linked-list.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/linked-list.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/linked-list.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,43 +1,44 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 structure LinkedList: LINKED_LIST =
 struct
 
 structure Node =
    struct
       datatype 'a t = T of {elt: 'a,
-			    next: 'a t option ref}
+                            next: 'a t option ref}
 
       fun new elt = T {elt = elt,
-		       next = ref NONE}
-	 
+                       next = ref NONE}
+         
       fun cons (elt, next) = T {elt = elt,
-				next = ref (SOME next)}
+                                next = ref (SOME next)}
 
       fun clearNext (T {next, ...}) = next := NONE
       fun setNext (T {next, ...}, n) = next := SOME n
 
       fun fold (n, ac, f) =
-	 let
-	    fun loop (T {elt, next}, ac) =
-	       let
-		  val ac = f (elt, ac)
-	       in
-		  case !next of
-		     NONE => ac
-		   | SOME n => loop (n, ac)
-	       end
-	 in
-	    loop (n, ac)
-	 end
+         let
+            fun loop (T {elt, next}, ac) =
+               let
+                  val ac = f (elt, ac)
+               in
+                  case !next of
+                     NONE => ac
+                   | SOME n => loop (n, ac)
+               end
+         in
+            loop (n, ac)
+         end
    end
 
 datatype 'a t = T of {first: 'a Node.t option ref,
-		      last: 'a Node.t option ref}
+                      last: 'a Node.t option ref}
 
 fun invariant (T {first, last}) =
    case (!first, !last) of
@@ -55,7 +56,7 @@
 fun layout layoutX l = List.layout layoutX (toList l)
 
 fun empty () = T {first = ref NONE,
-		  last = ref NONE}
+                  last = ref NONE}
 
 fun splice (T {first = f, last = l}, T {first = f', last = l'}): unit =
    case (!l, !f') of
@@ -63,25 +64,25 @@
     | (NONE, _) => (f := !f'; l := !l')
     | (_, NONE) => ()
     | (SOME ln, SOME f'n) =>
-	 (Node.setNext (ln, f'n)
-	  ; l := !l')
+         (Node.setNext (ln, f'n)
+          ; l := !l')
 
 val ('a, 'b) unfoldr: 'a * ('a -> ('b * 'a) option) -> 'b t =
    fn (a, f) =>
    case f a of
       NONE => empty ()
     | SOME (b, a) =>
-	 let
-	    val last = Node.new b
-	    fun loop (a: 'a, n: 'b Node.t): 'b Node.t =
-	       case f a of
-		  NONE => n
-		| SOME (b, a) => loop (a, Node.cons (b, n))
-	    val first = loop (a, last)
-	 in
-	    T {first = ref (SOME first),
-	       last = ref (SOME last)}
-	 end
+         let
+            val last = Node.new b
+            fun loop (a: 'a, n: 'b Node.t): 'b Node.t =
+               case f a of
+                  NONE => n
+                | SOME (b, a) => loop (a, Node.cons (b, n))
+            val first = loop (a, last)
+         in
+            T {first = ref (SOME first),
+               last = ref (SOME last)}
+         end
 
 val unfoldri: int * 'a * (int * 'a -> 'b * 'a) -> 'b t =
    fn (n, a, f) =>
@@ -89,36 +90,36 @@
       then Error.bug "LinkedList.unfoldri"
    else
       unfoldr ((n - 1, a), fn (i, a) =>
-	       if i < 0
-		  then NONE
-	       else let
-		       val (b, a) = f (i, a)
-		    in
-		       SOME (b, (i - 1, a))
-		    end)
+               if i < 0
+                  then NONE
+               else let
+                       val (b, a) = f (i, a)
+                    in
+                       SOME (b, (i - 1, a))
+                    end)
 
 val ('a, 'b) unfold: 'a * ('a -> ('b * 'a) option) -> 'b t =
    fn (a, f) =>
    case f a of
       NONE => empty ()
     | SOME (b, a) =>
-	 let
-	    val first = Node.new b
-	    fun loop (a: 'a, n: 'b Node.t): 'b Node.t =
-	       case f a of
-		  NONE => n
-		| SOME (b, a) => 
-		     let
-			val n' = Node.new b
-			val _ = Node.setNext (n, n')
-		     in
-			loop (a, n')
-		     end
-	    val last = loop (a, first)
-	 in
-	    T {first = ref (SOME first),
-	       last = ref (SOME last)}
-	 end
+         let
+            val first = Node.new b
+            fun loop (a: 'a, n: 'b Node.t): 'b Node.t =
+               case f a of
+                  NONE => n
+                | SOME (b, a) => 
+                     let
+                        val n' = Node.new b
+                        val _ = Node.setNext (n, n')
+                     in
+                        loop (a, n')
+                     end
+            val last = loop (a, first)
+         in
+            T {first = ref (SOME first),
+               last = ref (SOME last)}
+         end
 
 val unfoldi: int * 'a * (int * 'a -> 'b * 'a) -> 'b t =
    fn (n, a, f) =>
@@ -126,13 +127,13 @@
       then Error.bug "LinkedList.unfoldi"
    else
       unfold ((0, a), fn (i, a) =>
-	      if i >= n
-		 then NONE
-	      else let
-		      val (b, a') = f (i, a)
-		   in
-		      SOME (b, (i + 1, a'))
-		   end)
+              if i >= n
+                 then NONE
+              else let
+                      val (b, a') = f (i, a)
+                   in
+                      SOME (b, (i + 1, a'))
+                   end)
 
 fun reverse (ll as T {first, last}) =
    (if invariant ll
@@ -142,32 +143,32 @@
    case !first of
       NONE => ()
     | SOME (n as Node.T {next, ...}) =>
-	 case !next of
-	    NONE => ()
-	  | SOME n' =>
-	       let
-		  val _ = Node.clearNext n
-		  fun loop (n, n' as Node.T {next, ...}) =
-		     let
-			val no = !next
-			val _ = next := SOME n
-		     in
-			case no of
-			   NONE => ()
-			 | SOME n'' => loop (n', n'')
-		     end
-		  val _ = loop (n, n')
-		  val _ = Ref.swap (first, last)
-	       in
-		  ()
-	       end
-	    ; if invariant ll
+         case !next of
+            NONE => ()
+          | SOME n' =>
+               let
+                  val _ = Node.clearNext n
+                  fun loop (n, n' as Node.T {next, ...}) =
+                     let
+                        val no = !next
+                        val _ = next := SOME n
+                     in
+                        case no of
+                           NONE => ()
+                         | SOME n'' => loop (n', n'')
+                     end
+                  val _ = loop (n, n')
+                  val _ = Ref.swap (first, last)
+               in
+                  ()
+               end
+            ; if invariant ll
        then ()
     else Out.output (Out.error, "reverse 2\n"))
 
 fun fromList l =
    unfold (l,
-	   fn [] => NONE
-	    | x :: l => SOME (x, l))
+           fn [] => NONE
+            | x :: l => SOME (x, l))
 
 end

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/list.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/list.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/list.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 type int = Pervasive.Int.int
 
 signature LIST =
@@ -82,16 +83,16 @@
       val nth: 'a t * int -> 'a
       val nthTail: 'a t * int -> 'a t
 (*       val ordered :
- * 	 {< : 'a * 'a -> bool}
- * 	 -> {insert: 'a t * 'a -> 'a t,
- * 	     insertionSort: 'a t  -> 'a t,
- * 	     median: 'a t -> 'a,
- * 	     orderStatistic: 'a t * int -> 'a,
- * 	     partition: 'a t * 'a -> 'a t * 'a t,
- * 	     max: 'a t -> 'a,
- * 	     min: 'a t -> 'a,
- * 	     largest: 'a t * int -> 'a t,
- * 	     smallest: 'a t * int -> 'a t}
+ *       {< : 'a * 'a -> bool}
+ *       -> {insert: 'a t * 'a -> 'a t,
+ *           insertionSort: 'a t  -> 'a t,
+ *           median: 'a t -> 'a,
+ *           orderStatistic: 'a t * int -> 'a,
+ *           partition: 'a t * 'a -> 'a t * 'a t,
+ *           max: 'a t -> 'a,
+ *           min: 'a t -> 'a,
+ *           largest: 'a t * int -> 'a t,
+ *           smallest: 'a t * int -> 'a t}
  *)
       (* partition ([1, 2, 3, 4], isOdd) = {no = [4, 2], yes = [3, 1]} *)
       val partition: 'a t * ('a -> bool) -> {no: 'a t, yes: 'a t}
@@ -127,29 +128,30 @@
       val revRemoveAll: 'a t * ('a -> bool) -> 'a t
       val separate: 'a t * 'a -> 'a t
       val set: {equals: 'a * 'a -> bool,
-		layout: 'a -> Layout.t}
-	 -> {empty: 'a t,
-	     singleton: 'a -> 'a t,
-	     size: 'a t -> int,
-	     equals: 'a t * 'a t -> bool,
-	     <= : 'a t * 'a t -> bool,
-	     >= : 'a t * 'a t -> bool,
-	     < : 'a t * 'a t -> bool,
-	     > : 'a t * 'a t -> bool,
-	     + : 'a t * 'a t -> 'a t,
-	     - : 'a t * 'a t -> 'a t,
-	     intersect: 'a t * 'a t -> 'a t,
-	     unions: 'a t t -> 'a t,
-	     add: 'a t * 'a -> 'a t,
-	     remove: 'a t * 'a -> 'a t,
-	     contains: 'a t * 'a -> bool,
-	     areDisjoint: 'a t * 'a t -> bool,
-	     subset: 'a t * ('a -> bool) -> 'a t,
-	     subsetSize: 'a t * ('a -> bool) -> int,
-	     replace: 'a t * ('a -> 'a option) -> 'a t,
-	     map: 'a t * ('a -> 'a) -> 'a t,
-	     layout: 'a t -> Layout.t}
+                layout: 'a -> Layout.t}
+         -> {empty: 'a t,
+             singleton: 'a -> 'a t,
+             size: 'a t -> int,
+             equals: 'a t * 'a t -> bool,
+             <= : 'a t * 'a t -> bool,
+             >= : 'a t * 'a t -> bool,
+             < : 'a t * 'a t -> bool,
+             > : 'a t * 'a t -> bool,
+             + : 'a t * 'a t -> 'a t,
+             - : 'a t * 'a t -> 'a t,
+             intersect: 'a t * 'a t -> 'a t,
+             unions: 'a t t -> 'a t,
+             add: 'a t * 'a -> 'a t,
+             remove: 'a t * 'a -> 'a t,
+             contains: 'a t * 'a -> bool,
+             areDisjoint: 'a t * 'a t -> bool,
+             subset: 'a t * ('a -> bool) -> 'a t,
+             subsetSize: 'a t * ('a -> bool) -> int,
+             replace: 'a t * ('a -> 'a option) -> 'a t,
+             map: 'a t * ('a -> 'a) -> 'a t,
+             layout: 'a t -> Layout.t}
 (*      val splitAtMost: 'a t * int -> ('a t * 'a t) option *)
+      val splitAt: 'a t * int -> 'a t * 'a t
       val splitLast: 'a t -> 'a t * 'a
       val splitPrefix: 'a t * ('a -> bool) -> 'a t * 'a t
 (*      val suffixes: 'a t -> 'a t t *)
@@ -179,7 +181,7 @@
    
 val _ =
    Assert.assert
-   ("List", fn () =>
+   ("TestList", fn () =>
     SOME true = peekMap ([1, 2, 3], fn x => if x = 2 then SOME true else NONE)
     andalso ([2], [3]) = removeCommonPrefix ([1, 2], [1, 3], op =)
     andalso [2, 4, 6] = keepAll ([1, 2, 3, 4, 5, 6], fn x => 0 = x mod 2))

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/list.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/list.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/list.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,8 +1,8 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 structure List: LIST =
@@ -16,16 +16,16 @@
       type 'a t = 'a list
 
       fun fold (l, b, f) =
-	 let
-	    fun loop (l, b) =
-	       case l of
-		  [] => b
-		| x :: l => loop (l, f (x, b))
-	 in loop (l, b)
-	 end
+         let
+            fun loop (l, b) =
+               case l of
+                  [] => b
+                | x :: l => loop (l, f (x, b))
+         in loop (l, b)
+         end
    end
 structure F = Fold (open F
-		    type 'a elt = 'a)
+                    type 'a elt = 'a)
 open F
 
 fun dropPrefix (l: 'a t, n: int): 'a t =
@@ -33,32 +33,32 @@
       then l
    else
       case l of
-	 [] => Error.bug "dropPrefix"
+         [] => Error.bug "List.dropPrefix"
        | _ :: l => dropPrefix (l, n - 1)
-	 
+         
 fun dropSuffix (l, n: int) = rev (dropPrefix (rev l, n))
    
 fun nth (l, i: int) =
    let
       fun loop (l, i) =
-	 case l of
-	    [] => Error.bug "List.nth"
-	  | x :: l =>
-	       if i = 0
-		  then x
-	       else loop (l, i - 1)
+         case l of
+            [] => Error.bug "List.nth"
+          | x :: l =>
+               if i = 0
+                  then x
+               else loop (l, i - 1)
    in
       if i < 0
-	 then Error.bug "List.nth"
+         then Error.bug "List.nth"
       else loop (l, i)
    end
 
 fun exists (l, f) =
    let
       fun loop l =
-	 case l of
-	    [] => false
-	  | x :: l => f x orelse loop l
+         case l of
+            [] => false
+          | x :: l => f x orelse loop l
    in
       loop l
    end
@@ -67,13 +67,13 @@
    case l of
       [] => Error.bug "List.first"
     | x :: _ => x
-	 
+         
 fun forall (l, f) =
    let
       fun loop l =
-	 case l of
-	    [] => true
-	  | x :: l => f x andalso loop l
+         case l of
+            [] => true
+          | x :: l => f x andalso loop l
    in
       loop l
    end
@@ -81,9 +81,9 @@
 fun foralli (l, f) =
    let
       fun loop (l, i: int) =
-	 case l of
-	    [] => true
-	  | x :: l => f (i, x) andalso loop (l, i + 1)
+         case l of
+            [] => true
+          | x :: l => f (i, x) andalso loop (l, i + 1)
    in
       loop (l, 0)
    end
@@ -91,21 +91,21 @@
 fun fold2 (l1, l2, b, f) =
    let
       fun loop (l1, l2, b) =
-	 case (l1,       l2)       of
-  	      ([],       [])       => b
-	    | (x1 :: l1, x2 :: l2) => loop (l1, l2, f (x1, x2, b))
-	    | _                    => Error.bug "fold2"
+         case (l1,       l2)       of
+              ([],       [])       => b
+            | (x1 :: l1, x2 :: l2) => loop (l1, l2, f (x1, x2, b))
+            | _                    => Error.bug "fold2"
    in loop (l1, l2, b)
    end
 
 fun fold3 (l1, l2, l3, b, f) =
    let
       fun loop (l1, l2, l3, b) =
-	 case (l1,       l2,       l3)       of
-  	      ([],       [],       [])       => b
-	    | (x1 :: l1, x2 :: l2, x3 :: l3) =>
-		 loop (l1, l2, l3, f (x1, x2, x3, b))
-	    | _                    => Error.bug "fold3"
+         case (l1,       l2,       l3)       of
+              ([],       [],       [])       => b
+            | (x1 :: l1, x2 :: l2, x3 :: l3) =>
+                 loop (l1, l2, l3, f (x1, x2, x3, b))
+            | _                    => Error.bug "fold3"
    in loop (l1, l2, l3, b)
    end
 
@@ -114,13 +114,13 @@
 fun index (l, f) =
    let
       fun loop (l, i: int) =
-	 case l of
-	    [] => NONE
-	  | x :: l => if f x then SOME i else loop (l, i + 1)
+         case l of
+            [] => NONE
+          | x :: l => if f x then SOME i else loop (l, i + 1)
    in
       loop (l, 0)
    end
-	    
+            
 fun isEmpty l =
    case l of
       [] => true
@@ -129,9 +129,9 @@
 fun peek (l, f) =
    let
       fun loop l =
-	 case l of
-	    [] => NONE
-	  | x :: l => if f x then SOME x else loop l
+         case l of
+            [] => NONE
+          | x :: l => if f x then SOME x else loop l
    in
       loop l
    end
@@ -139,9 +139,9 @@
 fun peeki (l, f) =
    let
       fun loop (l, i: int) =
-	 case l of
-	    [] => NONE
-	  | x :: l => if f (i, x) then SOME (i, x) else loop (l, i + 1)
+         case l of
+            [] => NONE
+          | x :: l => if f (i, x) then SOME (i, x) else loop (l, i + 1)
    in
       loop (l, 0)
    end
@@ -149,12 +149,12 @@
 fun peekMap (l, f) =
    let
       fun loop l =
-	 case l of
-	    [] => NONE
-	  | x :: l =>
-	       (case f x of
-		   NONE => loop l
-		 | SOME x => SOME x)
+         case l of
+            [] => NONE
+          | x :: l =>
+               (case f x of
+                   NONE => loop l
+                 | SOME x => SOME x)
    in
       loop l
    end
@@ -182,10 +182,10 @@
 local
    fun make (l1, l2, f, unequal) =
       let
-	 val rec loop =
-	    fn ([],     [])         => true
-	     | (x1 :: l1, x2 :: l2) => f (x1, x2) andalso loop (l1, l2)
-	     | _                    => unequal ()
+         val rec loop =
+            fn ([],     [])         => true
+             | (x1 :: l1, x2 :: l2) => f (x1, x2) andalso loop (l1, l2)
+             | _                    => unequal ()
       in loop (l1, l2)
       end
 in
@@ -198,24 +198,24 @@
 fun compare (l, l', comp) =
    let
       val rec compare =
-	 fn ([],     [])       => EQUAL
-	  | (_,      [])       => GREATER
-	  | ([],     _)        => LESS
-	  | (x :: l, x' :: l') => (case comp (x, x') of
-				      EQUAL => compare (l, l')
-				    | r => r)
+         fn ([],     [])       => EQUAL
+          | (_,      [])       => GREATER
+          | ([],     _)        => LESS
+          | (x :: l, x' :: l') => (case comp (x, x') of
+                                      EQUAL => compare (l, l')
+                                    | r => r)
    in compare (l, l')
    end
 
 fun allButLast l =
    case rev l of
       _ :: l => rev l
-    | _ => Error.bug "allButLast"
+    | _ => Error.bug "List.allButLast"
 
 fun zip (l1, l2) = foldr2 (l1, l2, [], fn (x1, x2, l) => (x1, x2) :: l)
 
 fun unzip l = foldr (l, ([], []), fn ((x1, x2), (l1, l2)) =>
-		    (x1 :: l1, x2 :: l2))
+                    (x1 :: l1, x2 :: l2))
 
 fun concatRev l = fold (l, [], append)
 
@@ -229,17 +229,17 @@
       then Error.bug "List.unfoldri"
    else
       let
-	 fun loop (i, a, bs) =
-	    if i < 0
-	       then bs
-	    else
-	       let
-		  val (b, a') = f (i, a)
-	       in
-		  loop (i - 1, a', b :: bs)
-	       end
+         fun loop (i, a, bs) =
+            if i < 0
+               then bs
+            else
+               let
+                  val (b, a') = f (i, a)
+               in
+                  loop (i - 1, a', b :: bs)
+               end
       in
-	 loop (n - 1, a, [])
+         loop (n - 1, a, [])
       end
 
 val ('a, 'b) unfoldi: int * 'a * (int * 'a -> 'b * 'a) -> 'b list =
@@ -248,25 +248,25 @@
       then Error.bug "List.unfoldi"
    else
       let
-	 fun loop (i, a, bs) =
-	    if i >= n
-	       then rev bs
-	    else
-	       let
-		  val (b, a') = f (i, a)
-	       in
-		  loop (i + 1, a', b :: bs)
-	       end
+         fun loop (i, a, bs) =
+            if i >= n
+               then rev bs
+            else
+               let
+                  val (b, a') = f (i, a)
+               in
+                  loop (i + 1, a', b :: bs)
+               end
       in
-	 loop (0, a, [])
+         loop (0, a, [])
       end
 
 fun unfoldr (a, f) =
    let
       fun loop (a, bs) =
-	 case f a of
-	    NONE => bs
-	  | SOME (b, a') => loop (a', b :: bs)
+         case f a of
+            NONE => bs
+          | SOME (b, a') => loop (a', b :: bs)
    in
       loop (a, [])
    end
@@ -284,7 +284,7 @@
 
 fun pop r =
    case !r of
-      [] => Error.bug "pop"
+      [] => Error.bug "List.pop"
     | x :: l => (r := l; x)
    
 fun push (r, x) = r := x :: !r
@@ -292,114 +292,114 @@
 fun remFst (l, f, notFound) =
    let
       fun loop (l, ac) =
-	 case l of
-	    [] => notFound ()
-	  | x :: l =>
-	       if f x
-		  then appendRev (ac, l)
-	       else loop (l, x :: ac)
+         case l of
+            [] => notFound ()
+          | x :: l =>
+               if f x
+                  then appendRev (ac, l)
+               else loop (l, x :: ac)
    in loop (l, [])
    end
 
-fun removeFirst (l, f) = remFst (l, f, fn () => Error.bug "removeFirst")
+fun removeFirst (l, f) = remFst (l, f, fn () => Error.bug "List.removeFirst")
 
 fun remove (l, f) = remFst (l, f, fn () => l)
 
 fun nthTail (l, n: int) =
    let
       fun loop (l, i) =
-	 if i <= 0
-	    then l
-	 else (case l of
-		  [] => Error.bug "nthTail"
-		| _ :: l => loop (l, i - 1))
+         if i <= 0
+            then l
+         else (case l of
+                  [] => Error.bug "List.nthTail"
+                | _ :: l => loop (l, i - 1))
    in loop (l, n)
    end
 
 fun firstN (l, n: int) =
    let
       fun loop (l, i, ac) =
-	 if i <= 0
-	    then rev ac
-	 else (case l of
-		  [] => Error.bug "firstN"
-		| x :: l => loop (l, i - 1, x :: ac))
+         if i <= 0
+            then rev ac
+         else (case l of
+                  [] => Error.bug "List.firstN"
+                | x :: l => loop (l, i - 1, x :: ac))
    in loop (l, n, [])
    end
 
 fun 'a ordered {<= : 'a * 'a -> bool} =
    let
       fun insert (l, x) =
-	 let
-	    fun loop (l, ac) =
-	       case l of
-		  [] => appendRev (ac, [x])
-		| x' :: l' =>
-		     if x <= x'
-			then appendRev (ac, x :: l)
-		     else loop (l', x' :: ac)
-	 in loop (l, [])
-	 end
+         let
+            fun loop (l, ac) =
+               case l of
+                  [] => appendRev (ac, [x])
+                | x' :: l' =>
+                     if x <= x'
+                        then appendRev (ac, x :: l)
+                     else loop (l', x' :: ac)
+         in loop (l, [])
+         end
 
       fun insertionSort l = fold (l, [], fn (x, ac) => insert (ac, x))
 
       fun partition (ns, x) =
-	 fold (ns, ([], []),
-	      fn (y, (left, right)) =>
-	      if x <= y then (left, cons (y, right))
-	      else (cons (y, left), right))
+         fold (ns, ([], []),
+              fn (y, (left, right)) =>
+              if x <= y then (left, cons (y, right))
+              else (cons (y, left), right))
     
       local  
-	 val columnSize: int = 5
-	 val sort = insertionSort
-	 fun breakIntoColumns ns =
-	    if Int.< (length ns, columnSize)
-	       then cons (ns, [])
-	    else cons (firstN (ns, columnSize),
-		      breakIntoColumns (nthTail (ns, columnSize)))
+         val columnSize: int = 5
+         val sort = insertionSort
+         fun breakIntoColumns ns =
+            if Int.< (length ns, columnSize)
+               then cons (ns, [])
+            else cons (firstN (ns, columnSize),
+                      breakIntoColumns (nthTail (ns, columnSize)))
       in
-	 fun median ns = orderStatistic (ns, Int.quot (length ns, 2))
-	 and orderStatistic (ns, i) =
-	    if Int.< (length ns, columnSize)
-	       then nth (sort ns, i)
-	    else let
-		    val medianOfMedians =
-		       median (map (breakIntoColumns ns, columnMedian))
-		    val (left, right) = partition (ns, medianOfMedians)
-		    val numLeft = length left
-		 in if Int.< (i, numLeft)
-		       then orderStatistic (left, i)
-		    else orderStatistic (right, i - numLeft)
-		 end
-	 and columnMedian ns =
-	    nth (sort ns, Int.quot (length ns, 2))
+         fun median ns = orderStatistic (ns, Int.quot (length ns, 2))
+         and orderStatistic (ns, i) =
+            if Int.< (length ns, columnSize)
+               then nth (sort ns, i)
+            else let
+                    val medianOfMedians =
+                       median (map (breakIntoColumns ns, columnMedian))
+                    val (left, right) = partition (ns, medianOfMedians)
+                    val numLeft = length left
+                 in if Int.< (i, numLeft)
+                       then orderStatistic (left, i)
+                    else orderStatistic (right, i - numLeft)
+                 end
+         and columnMedian ns =
+            nth (sort ns, Int.quot (length ns, 2))
       end    
 
       fun choose (op <) (s, n) =
-	 let fun insert (x, s) =
-	    let
-	       fun insert (m, s) =
-		  if m >= n
-		     then []
-		  else (case s of
-			   [] => [x]
-			 | y :: s => if x < y then x :: s
-				     else y :: insert (m + 1, s))
-	    in insert (0, s)
-	    end
-	 in firstN (fold (s, [], insert),n)
-	 end
+         let fun insert (x, s) =
+            let
+               fun insert (m, s) =
+                  if m >= n
+                     then []
+                  else (case s of
+                           [] => [x]
+                         | y :: s => if x < y then x :: s
+                                     else y :: insert (m + 1, s))
+            in insert (0, s)
+            end
+         in firstN (fold (s, [], insert),n)
+         end
       
       val smallest = choose (op <)
       val largest = choose (op >)
     
       fun getFirst (l, extreme, name) =
-	 case extreme (l, 1) of
-	    x :: _ => x
-	  | _ => Error.bug name
+         case extreme (l, 1) of
+            x :: _ => x
+          | _ => Error.bug name
 
-      fun min l = getFirst (l, smallest, "min")
-      fun max l = getFirst (l, largest, "max")
+      fun min l = getFirst (l, smallest, "List.ordered.min")
+      fun max l = getFirst (l, largest, "List.ordered.max")
 
    in {insert = insert,
        insertionSort = insertionSort,
@@ -416,15 +416,15 @@
 
 fun splitLast l =
    case rev l of
-      [] => Error.bug "splitLast"
+      [] => Error.bug "List.splitLast"
     | x :: l => (rev l, x)
 
 fun power l =
    case l of
       [] => [[]]
     | x :: l => let val rest = power l
-		in rest @ map (rest, fn s => x :: s)
-		end
+                in rest @ map (rest, fn s => x :: s)
+                end
 
 fun equalsAsSet (l1, l2, equals) =
    let fun subset (l, l') = forall (l, fn x => exists (l', fn x' => equals (x, x')))
@@ -432,7 +432,7 @@
    end
 
 fun 'a set {equals: 'a * 'a -> bool,
-	    layout: 'a -> Layout.t} =
+            layout: 'a -> Layout.t} =
    let
       val equal = equals
       fun equalTo x x' = equal (x, x')
@@ -447,30 +447,30 @@
       fun areDisjoint (s, s') = forall (s, fn x => not (contains (s', x)))
 (*      val subset = keepAll *)
       fun subset (s: 'a t, p) =
-	 fold (s, [], fn (x, s'') => if p x then x::s'' else s'')
+         fold (s, [], fn (x, s'') => if p x then x::s'' else s'')
       fun subsetSize (s: 'a t, p) =
-	 fold (s, 0: int, fn (x, n) => if p x then n + 1 else n)
+         fold (s, 0: int, fn (x, n) => if p x then n + 1 else n)
       fun s - s' = subset (s, fn x => not (contains (s', x)))
 (*      fun s + s' = append (s - s', s') *)
       fun s + s' =
-	 fold (s, s', fn (x, s'') => if not (contains (s', x)) then x::s'' else s'')
+         fold (s, s', fn (x, s'') => if not (contains (s', x)) then x::s'' else s'')
       fun intersect (s, s') = subset (s, fn x => contains (s', x))
       fun unions ss = fold (ss, [], op +)
       val size: 'a t -> int = length
-	 
+         
       val layout = fn vs =>
-	 let open Layout
-	 in seq [str "{",
-		align (separateRight (map (vs, layout), ", ")),
-		str "}"]
-	 end
+         let open Layout
+         in seq [str "{",
+                align (separateRight (map (vs, layout), ", ")),
+                str "}"]
+         end
 
       val remove = fn (s, x) => remove (s, equalTo x)
    
       fun replace (s: 'a t, f): 'a t =
-	 fold (s, [], fn (x, s) => (case f x of
-					NONE => s
-				      | SOME y => add (s, y)))
+         fold (s, [], fn (x, s) => (case f x of
+                                        NONE => s
+                                      | SOME y => add (s, y)))
       fun map (s: 'a t, f) = replace (s, fn x => SOME (f x))
 
    in {empty = [],
@@ -499,16 +499,16 @@
 fun subsets (s, n) =
    let
       fun subs (s, size, n, elts, accum) =
-	 if n <= 0
-	    then cons (elts, accum)
-	 else (case s of
-		  x :: xs =>
-		     if size <= n
-			then cons (cons (x, append (xs, elts)), accum)
-		     else subs (xs, size - 1, n - 1,
-				cons (x, elts),
-				subs (xs, size - 1, n, elts , accum))
-		| _ => Error.bug "subsets")
+         if n <= 0
+            then cons (elts, accum)
+         else (case s of
+                  x :: xs =>
+                     if size <= n
+                        then cons (cons (x, append (xs, elts)), accum)
+                     else subs (xs, size - 1, n - 1,
+                                cons (x, elts),
+                                subs (xs, size - 1, n, elts , accum))
+                | _ => Error.bug "List.subsets")
    in subs (s, length s, n, [], [])
    end
 
@@ -518,54 +518,54 @@
    case ts of
       [] => []
     | t :: ts => t :: (let 
-			   val rec loop =
-			      fn [] => []
-			       | t :: ts => s :: t:: (loop ts)
-		       in loop ts
-		       end)
+                           val rec loop =
+                              fn [] => []
+                               | t :: ts => s :: t:: (loop ts)
+                       in loop ts
+                       end)
 
 fun cross l =
    case l of
       [] => [[]]
     | x :: l =>
-	 let val rest = cross l
-	 in concatMap (x, fn x => map (rest, fn t => x :: t))
-	 end
+         let val rest = cross l
+         in concatMap (x, fn x => map (rest, fn t => x :: t))
+         end
 
 fun removeDuplicates (l, equals) =
    fold (l, [], fn (x, ac) =>
-	 if contains (ac, x, equals)
-	    then ac
-	 else x :: ac)
+         if contains (ac, x, equals)
+            then ac
+         else x :: ac)
 
 fun removeCommonPrefix (l1, l2, equals) =
    let
       fun loop (arg as (l1, l2)) =
-	 case (l1, l2) of
-	    (_, []) => arg
-	  | ([], _) => arg
-	  | (x1 :: l1, x2 :: l2) =>
-	       if equals (x1, x2)
-		  then loop (l1, l2)
-	       else arg
+         case (l1, l2) of
+            (_, []) => arg
+          | ([], _) => arg
+          | (x1 :: l1, x2 :: l2) =>
+               if equals (x1, x2)
+                  then loop (l1, l2)
+               else arg
    in loop (l1, l2)
    end
 
 fun removePrefix (l, p) =
    let
       fun loop l =
-	 case l of
-	    [] => []
-	  | x :: l' => if p x then loop l' else l
+         case l of
+            [] => []
+          | x :: l' => if p x then loop l' else l
    in loop l
    end
 
 fun isPrefix (l, l', f) =
    let
       val rec loop =
-	 fn ([], _) => true
-	  | (_, []) => false
-	  | (x :: l, x' :: l') => f (x, x') andalso loop (l, l')
+         fn ([], _) => true
+          | (_, []) => false
+          | (x :: l, x' :: l') => f (x, x') andalso loop (l, l')
    in loop (l, l')
    end
 
@@ -574,15 +574,29 @@
 fun toString xToString l =
    Layout.toString (layout (Layout.str o xToString) l)
 
+val splitAt: 'a t * int -> 'a t * 'a t =
+   fn (l, i) =>
+   let
+      fun loop (i, ac, l) =
+         if i = 0
+            then (rev ac, l)
+            else
+               case l of
+                  [] => Error.bug "List.splitAt"
+                | x :: l => loop (i - 1, x :: ac, l)
+   in
+      loop (i, [], l)
+   end
+
 fun splitPrefix (l, p) =
    let
       fun loop (l, ac) =
-	 case l of
-	    [] => (rev ac, [])
-	  | x :: l' =>
-	       if p x
-		  then loop (l', x :: ac)
-	       else (rev ac, l)
+         case l of
+            [] => (rev ac, [])
+          | x :: l' =>
+               if p x
+                  then loop (l', x :: ac)
+               else (rev ac, l)
    in loop (l, [])
    end
 
@@ -598,10 +612,10 @@
    (l, [], fn (x, ecs) =>
     let
       fun loop ([], ecs') = [x]::ecs'
-	| loop (ec::ecs, ecs') =
-	 if p (x, hd ec)
-	    then fold (ecs, (x::ec)::ecs', op ::)
-	 else loop (ecs, ec::ecs')
+        | loop (ec::ecs, ecs') =
+         if p (x, hd ec)
+            then fold (ecs, (x::ec)::ecs', op ::)
+         else loop (ecs, ec::ecs')
     in
        loop (ecs, [])
     end)

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/mark.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/mark.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/mark.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 type int = Int.t
    
 signature MARK =

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/mark.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/mark.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/mark.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,15 +1,16 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 structure Mark: MARK =
 struct
 
 datatype t =
    T of {string: string,
-	 pos: int}
+         pos: int}
 
 fun pos (T {pos, ...}) = pos
 
@@ -37,7 +38,7 @@
       else T {string = string, pos = pos}
    end
 fun backwardChar m = backwardChars (m, 1)
-val backwardChar = Trace.trace ("backwardChar", layout, layout) backwardChar
+val backwardChar = Trace.trace ("Mark.backwardChar", layout, layout) backwardChar
 
 exception ForwardChars
 fun forwardChars (T {string, pos},n) =
@@ -46,7 +47,7 @@
       else T {string = string, pos = pos}
    end
 fun forwardChar m = forwardChars (m, 1)
-val forwardChar = Trace.trace ("forwardChar", layout, layout) forwardChar
+val forwardChar = Trace.trace ("Mark.forwardChar", layout, layout) forwardChar
 
 fun charAt (T {string, pos}) = String.sub (string, pos)
    
@@ -55,8 +56,8 @@
 local
    fun searchChar move (m, c) =
       let
-	 fun loop m =
-	    if lookingAtChar (m, c) then m else loop (move m)
+         fun loop m =
+            if lookingAtChar (m, c) then m else loop (move m)
       in loop m
       end
 in 
@@ -77,15 +78,15 @@
 local
    fun moveLines move =
       let
-	 fun moves (m as T {string, pos}, n: int) =
-	 let
-	    val c = whatColumn m
-	    fun loop (m, n) =
-	       if n <= 0 then forwardChars (m, Int.min (c, numColumns m))
-	       else loop (move m, n - 1)
-	 in loop (bol m, n)
-	 end
-	  fun move m = moves (m, 1)
+         fun moves (m as T {string, pos}, n: int) =
+         let
+            val c = whatColumn m
+            fun loop (m, n) =
+               if n <= 0 then forwardChars (m, Int.min (c, numColumns m))
+               else loop (move m, n - 1)
+         in loop (bol m, n)
+         end
+          fun move m = moves (m, 1)
       in (move, moves)
       end
 in
@@ -98,24 +99,24 @@
       val len = String.size string
       val len' = String.size string'
       fun loop (pos, pos') =
-	 pos < len
-	 andalso (pos' >= len'
-		  orelse (Char.equals (String.sub (string, pos),
-				       String.sub (string', pos'))
-			  andalso loop (pos + 1, pos' + 1)))
+         pos < len
+         andalso (pos' >= len'
+                  orelse (Char.equals (String.sub (string, pos),
+                                       String.sub (string', pos'))
+                          andalso loop (pos + 1, pos' + 1)))
    in loop (pos, 0)
    end
 val lookingAtString =
-   Trace.trace2 ("lookingAtString", layout, String.layout, Bool.layout)
+   Trace.trace2 ("Mark.lookingAtString", layout, String.layout, Bool.layout)
    lookingAtString
 
 exception Search
 fun makeSearch move (m, s) =
    let
       fun search m =
-	 if lookingAtString (m, s)
-	    then forwardChars (m, String.size s)
-	 else (search (move m) handle _ => raise Search)
+         if lookingAtString (m, s)
+            then forwardChars (m, String.size s)
+         else (search (move m) handle _ => raise Search)
    in search m
    end
 
@@ -124,7 +125,7 @@
 
 fun skip p =
    let fun skip m = if p (charAt m) then skip (forwardChar m)
-		    else m
+                    else m
    in skip
    end
 
@@ -150,7 +151,7 @@
 exception Real
 val real = num (Real.fromString, Real)
 
-val real = Trace.trace ("real", layout, Layout.tuple2 (layout, Real.layout)) real
+val real = Trace.trace ("Mark.real", layout, Layout.tuple2 (layout, Real.layout)) real
 
 val op < = fn (m, m') => pos m < pos m'
 

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/max-pow-2-that-divides.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/max-pow-2-that-divides.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/max-pow-2-that-divides.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,66 +1,66 @@
-(* Copyright (C) 2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 2004-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 type word = Pervasive.Word.word
    
 functor MaxPow2ThatDivides (type t
 
-			    val << : t * word -> t
-			    val >> : t * word -> t
-			    val <= : t * t -> bool
-			    val andb: t * t -> t
-			    val equals: t * t -> bool
-			    val one: t
-			    val orb: t * t -> t
-			    val zero: t):
+                            val << : t * word -> t
+                            val >> : t * word -> t
+                            val <= : t * t -> bool
+                            val andb: t * t -> t
+                            val equals: t * t -> bool
+                            val one: t
+                            val orb: t * t -> t
+                            val zero: t):
    sig
       val maxPow2ThatDivides: t -> word
    end =
    struct
       structure Word = Pervasive.Word
-	 
+         
       val maxPow2ThatDivides: t -> word =
-	 fn i =>
-	 let
-	    (* b is the number of zero bits we are trying to peel from the
-	     *   bottom of i.
-	     * m = 2^b - 1.  m is a mask for the bits we are trying to peel.
-	     * 0 < a <= m.
-	     * ac is the number of bits that we have already peeled off.
-	     *)
-	    fun down (b: word, m: t, i: t, ac: word): word =
-	       let
-		  val b = Word.>> (b, 0w1)
-	       in
-		  if b = 0w0
-		     then ac
-		  else
-		     let
-			val m = >> (m, b)
-			val a = andb (i, m)
-			val (i, ac) =
-			   if equals (a, zero)
-			      then (>> (i, b), ac + b)
-			   else (a, ac)
-		     in
-			down (b, m, i, ac)
-		     end
-	       end
-	    fun up (b: word, m: t): word =
-	       let
-		  val a = andb (i, m)
-	       in
-		  if equals (a, zero)
-		     then up (Word.<< (b, 0w1), orb (m, << (m, b)))
-		  else down (b, m, a, 0w0)
-	       end
-	 in
-	    if i <= zero
-	       then raise Fail "maxPow2ThatDivides"
-	    else up (0w1, one)
-	 end
+         fn i =>
+         let
+            (* b is the number of zero bits we are trying to peel from the
+             *   bottom of i.
+             * m = 2^b - 1.  m is a mask for the bits we are trying to peel.
+             * 0 < a <= m.
+             * ac is the number of bits that we have already peeled off.
+             *)
+            fun down (b: word, m: t, i: t, ac: word): word =
+               let
+                  val b = Word.>> (b, 0w1)
+               in
+                  if b = 0w0
+                     then ac
+                  else
+                     let
+                        val m = >> (m, b)
+                        val a = andb (i, m)
+                        val (i, ac) =
+                           if equals (a, zero)
+                              then (>> (i, b), ac + b)
+                           else (a, ac)
+                     in
+                        down (b, m, i, ac)
+                     end
+               end
+            fun up (b: word, m: t): word =
+               let
+                  val a = andb (i, m)
+               in
+                  if equals (a, zero)
+                     then up (Word.<< (b, 0w1), orb (m, << (m, b)))
+                  else down (b, m, a, 0w0)
+               end
+         in
+            if i <= zero
+               then Error.bug "MaxPow2ThatDivides.maxPow2ThatDivides: i <= 0"
+            else up (0w1, one)
+         end
    end

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/merge-sort.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/merge-sort.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/merge-sort.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,22 +1,23 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 type int = Int.t
    
 signature MERGE_SORT =
    sig
       type 'a t
-	 
+         
       (* The comparison function ('a * 'a -> bool) for any of these should
        * always be the <= funtion, not just <.
        * This is necessary to handle duplicate elements.
        *)
       val make: ('a * 'a -> bool) -> {isSorted: 'a t -> bool,
-				      merge: 'a t * 'a t -> 'a t,
-				      sort: 'a t -> 'a t}
+                                      merge: 'a t * 'a t -> 'a t,
+                                      sort: 'a t -> 'a t}
       val isSorted: 'a t * ('a * 'a -> bool) -> 'a t
       val merge: 'a t * 'a t * ('a * 'a -> bool) -> 'a t
       val sort: 'a t * ('a * 'a -> bool) -> 'a t
@@ -29,20 +30,20 @@
 
 val _ =
    Assert.assert
-   ("MergeSort", fn () =>
+   ("TestMergeSort", fn () =>
     let
        fun check (l: int list): bool =
-	  List.insertionSort (l, op <=) = toList (sort (fromList l, op <=))
+          List.insertionSort (l, op <=) = toList (sort (fromList l, op <=))
     in
        List.forall
        ([[],
-	 [1],
-	 [1,2],
-	 [1,2,3],
-	 [2,1,3],
-	 [1,2,3,4,5],
-	 [3,5,6,7,8,1,2,3,6,4]],
-	check)
+         [1],
+         [1,2],
+         [1,2,3],
+         [2,1,3],
+         [1,2,3,4,5],
+         [3,5,6,7,8,1,2,3,6,4]],
+        check)
     end)
     
 end

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/merge-sort.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/merge-sort.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/merge-sort.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,17 +1,17 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 functor MergeSort (S:
-		   sig
-		      type 'a t
-		      val make: ('a * 'a -> bool) -> {isSorted: 'a t -> bool,
-						      merge: 'a t * 'a t -> 'a t,
-						      sort: 'a t -> 'a t}
-		   end): MERGE_SORT =
+                   sig
+                      type 'a t
+                      val make: ('a * 'a -> bool) -> {isSorted: 'a t -> bool,
+                                                      merge: 'a t * 'a t -> 'a t,
+                                                      sort: 'a t -> 'a t}
+                   end): MERGE_SORT =
    struct
       open S
 
@@ -27,56 +27,56 @@
     (* This is a variant of mergesort that runs in O (n log n) time. *)
     fun make (op <= : 'a * 'a -> bool) =
        let
-	  fun assert f = Assert.assert ("sort", f)
-	  fun isSorted l =
-	     case l of
-		[] => true
-	      | x :: l =>
-		   let
-		      fun loop (x, l) =
-			 case l of
-			    [] => true
-			  | x' :: l => x <= x' andalso loop (x', l)
-		   in loop (x, l)
-		   end
-	  fun merge (l1, l2) =
-	     (assert (fn () => isSorted l1 andalso isSorted l2)
-	      ; (case (l1, l2) of
-		    ([], _) => l2
-		  | (_, []) => l1
-		  | (x1 :: l1', x2 :: l2') =>
-		       if x1 <= x2
-			  then x1 :: merge (l1', l2)
-		       else x2 :: merge (l1, l2')))
-	  fun sort l =
-	     let
-		val numBuckets = 25
-		val _ = assert (fn () => length l < Int.pow (2, numBuckets) - 1)
-		val a: 'a list array = Array.new (numBuckets, [])
-		fun invariant () =
-		   assert (fn () => Array.foralli (a, fn (i, l) =>
-						   case l of
-						      [] => true
-						    | _ => (length l = Int.pow (2, i)
-							    andalso isSorted l)))
-		fun mergeIn (i: int, l: 'a list): unit =
-		   (assert (fn () => length l = Int.pow (2, i))
-		    ; (case Array.sub (a, i) of
-			  [] => Array.update (a, i, l)
-			| l' => (Array.update (a, i, [])
-				 ; mergeIn (i + 1, merge (l, l')))))
-		val _ = List.foreach (l, fn x => mergeIn (0, [x]))
-		val l = Array.fold (a, [], fn (l, l') =>
-				    case l of
-				       [] => l'
-				     | _ => merge (l, l'))
-		val _ = assert (fn () => isSorted l)
-	     in l
-	     end
+          fun assert f = Assert.assert ("MergeSort.assert", f)
+          fun isSorted l =
+             case l of
+                [] => true
+              | x :: l =>
+                   let
+                      fun loop (x, l) =
+                         case l of
+                            [] => true
+                          | x' :: l => x <= x' andalso loop (x', l)
+                   in loop (x, l)
+                   end
+          fun merge (l1, l2) =
+             (assert (fn () => isSorted l1 andalso isSorted l2)
+              ; (case (l1, l2) of
+                    ([], _) => l2
+                  | (_, []) => l1
+                  | (x1 :: l1', x2 :: l2') =>
+                       if x1 <= x2
+                          then x1 :: merge (l1', l2)
+                       else x2 :: merge (l1, l2')))
+          fun sort l =
+             let
+                val numBuckets = 25
+                val _ = assert (fn () => length l < Int.pow (2, numBuckets) - 1)
+                val a: 'a list array = Array.new (numBuckets, [])
+                fun invariant () =
+                   assert (fn () => Array.foralli (a, fn (i, l) =>
+                                                   case l of
+                                                      [] => true
+                                                    | _ => (length l = Int.pow (2, i)
+                                                            andalso isSorted l)))
+                fun mergeIn (i: int, l: 'a list): unit =
+                   (assert (fn () => length l = Int.pow (2, i))
+                    ; (case Array.sub (a, i) of
+                          [] => Array.update (a, i, l)
+                        | l' => (Array.update (a, i, [])
+                                 ; mergeIn (i + 1, merge (l, l')))))
+                val _ = List.foreach (l, fn x => mergeIn (0, [x]))
+                val l = Array.fold (a, [], fn (l, l') =>
+                                    case l of
+                                       [] => l'
+                                     | _ => merge (l, l'))
+                val _ = assert (fn () => isSorted l)
+             in l
+             end
        in
-	  {isSorted = isSorted,
-	   merge = merge,
-	   sort = sort}
+          {isSorted = isSorted,
+           merge = merge,
+           sort = sort}
        end)
 
 structure MergeSortVector: MERGE_SORT =
@@ -85,85 +85,85 @@
 
     fun make (op <=) =
        let
-	  fun isSorted v = Vector.isSorted (v, op <=)
-	  fun merge (v, v') =
-	     let
-		val _ = Assert.assert ("MergeSortVector pre", fn () =>
-				       isSorted (v, op <=)
-				       andalso isSorted (v', op <=))
-		val n = length v
-		val n' = length v'
-		val r = ref 0
-		val r' = ref 0
-		fun next _ =
-		   let
-		      val i = !r
-		      val i' = !r'
-		   (* 0 <= i <= n andalso 0 <= i' <= n' *)
-		   in
-		      if i = n
-			 then
-			    let
-			       val res = sub (v', i')
-			       val _ = Int.inc r'
-			    in res
-			    end
-		      else if i' = n'
-			      then 
-				 let
-				    val res = sub (v, i)
-				    val _ = Int.inc r
-				 in res
-				 end
-			   else
-			      let
-				 val a = sub (v, i)
-				 val a' = sub (v', i')
-			      in
-				 if a <= a'
-				    then (Int.inc r; a)
-				 else (Int.inc r'; a')
-			      end
-		   end
-		val v = tabulate (n + n', fn _ => next ())
-		val _ = Assert.assert ("Vector.merge post", fn () =>
-				       isSorted (v, op <=))
-	     in
-		v
-	     end
+          fun isSorted v = Vector.isSorted (v, op <=)
+          fun merge (v, v') =
+             let
+                val _ = Assert.assert ("MergeSortVector.merge: pre", fn () =>
+                                       isSorted (v, op <=)
+                                       andalso isSorted (v', op <=))
+                val n = length v
+                val n' = length v'
+                val r = ref 0
+                val r' = ref 0
+                fun next _ =
+                   let
+                      val i = !r
+                      val i' = !r'
+                   (* 0 <= i <= n andalso 0 <= i' <= n' *)
+                   in
+                      if i = n
+                         then
+                            let
+                               val res = sub (v', i')
+                               val _ = Int.inc r'
+                            in res
+                            end
+                      else if i' = n'
+                              then 
+                                 let
+                                    val res = sub (v, i)
+                                    val _ = Int.inc r
+                                 in res
+                                 end
+                           else
+                              let
+                                 val a = sub (v, i)
+                                 val a' = sub (v', i')
+                              in
+                                 if a <= a'
+                                    then (Int.inc r; a)
+                                 else (Int.inc r'; a')
+                              end
+                   end
+                val v = tabulate (n + n', fn _ => next ())
+                val _ = Assert.assert ("MergeSortVector.merge: post", fn () =>
+                                       isSorted (v, op <=))
+             in
+                v
+             end
 
-	  fun sort v =
-	     let
-		fun loop v =
-		   if isSorted (v, op <=)
-		      then v
-		   else
-		      let
-			 val n = length v
-			 val m = n div 2
-			 val m' = n - m
-			 fun get (m, start) =
-			    loop
-			    (tabulate (m, 
-				       let val r = ref start
-				       in fn _ =>
-					  let
-					     val i = !r
-					     val res = sub (v, i)
-					     val _ = r := 2 + i
-					  in res
-					  end
-				       end))
-		      in merge (get (m', 0), get (m, 1), op <=)
-		      end
-		val v = loop v
-		val _ = Assert.assert ("Vector.sort", fn () =>
-				       isSorted (v, op <=))
-	     in
-		v
-	     end
+          fun sort v =
+             let
+                fun loop v =
+                   if isSorted (v, op <=)
+                      then v
+                   else
+                      let
+                         val n = length v
+                         val m = n div 2
+                         val m' = n - m
+                         fun get (m, start) =
+                            loop
+                            (tabulate (m, 
+                                       let val r = ref start
+                                       in fn _ =>
+                                          let
+                                             val i = !r
+                                             val res = sub (v, i)
+                                             val _ = r := 2 + i
+                                          in res
+                                          end
+                                       end))
+                      in merge (get (m', 0), get (m, 1), op <=)
+                      end
+                val v = loop v
+                val _ = Assert.assert ("MergeSortVector.sort", fn () =>
+                                       isSorted (v, op <=))
+             in
+                v
+             end
        in
-	  {isSorted = isSorted,
-	   merge = merge,
-	   sort = sort}
+          {isSorted = isSorted,
+           merge = merge,
+           sort = sort}
        end)

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/mono-container.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/mono-container.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/mono-container.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 type int = Int.t
    
 signature MONO_CONTAINER =

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/mono-list.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/mono-list.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/mono-list.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 functor MonoList(X: T): T =
 struct
 
@@ -12,5 +13,5 @@
 fun equals(l, l') = List.equals(l, l', X.equals)
 
 val layout = List.layout X.layout
-			     
+                             
 end

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/mono-option.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/mono-option.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/mono-option.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 functor MonoOption (X: T): T =
 struct
 

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/mono-vector.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/mono-vector.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/mono-vector.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 functor MonoVector (Elt: T) =
    struct
       open Vector

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/my-dirs.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/my-dirs.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/my-dirs.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,19 +1,20 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature MY_DIRS =
    sig
       val dirs: unit -> {home: Dir.t,
-			  sml: Dir.t,
-			  smlnj: Dir.t,
-			  bin: Dir.t,
-			  binFiles: Dir.t,
-			  heap: Dir.t,
-			  src: Dir.t,
-			  compiler: Dir.t}
+                          sml: Dir.t,
+                          smlnj: Dir.t,
+                          bin: Dir.t,
+                          binFiles: Dir.t,
+                          heap: Dir.t,
+                          src: Dir.t,
+                          compiler: Dir.t}
       val exportFn: string * (string * string list -> int) -> unit
       val exportML: string -> bool
    end

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/my-dirs.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/my-dirs.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/my-dirs.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,30 +1,31 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 structure MyDirs: MY_DIRS =
    struct
       open Dir
-	 
+         
       fun dirs() =
-	 let
-	    val home = fromString "/home/sweeks/"
-	    val sml = relative(home, "sml")
-	    val smlnj = relative(home, "sml/sml-nj-root")
-	    val bin = relative(smlnj, "bin")
-	    val binFiles = relative(smlnj, "bin.x86-unix")
-	    val heap = relative(bin, ".heap")
-	    val src = relative(smlnj, "src")
-	    val compiler = relative(src, "sml-nj")
-	 in {home = home, sml = sml, smlnj = smlnj, bin = bin,
-	     binFiles = binFiles, heap = heap, src = src, compiler = compiler}
-	 end
+         let
+            val home = fromString "/home/sweeks/"
+            val sml = relative(home, "sml")
+            val smlnj = relative(home, "sml/sml-nj-root")
+            val bin = relative(smlnj, "bin")
+            val binFiles = relative(smlnj, "bin.x86-unix")
+            val heap = relative(bin, ".heap")
+            val src = relative(smlnj, "src")
+            val compiler = relative(src, "sml-nj")
+         in {home = home, sml = sml, smlnj = smlnj, bin = bin,
+             binFiles = binFiles, heap = heap, src = src, compiler = compiler}
+         end
       
       fun exportFn(name, f) =
-	 SMLofNJ.exportFn(File.toString(File.relative(#heap(dirs()),name)),
-			  f)
+         SMLofNJ.exportFn(File.toString(File.relative(#heap(dirs()),name)),
+                          f)
       fun exportML name =
-	 SMLofNJ.exportML(File.toString(File.relative(#heap(dirs()),name)))
+         SMLofNJ.exportML(File.toString(File.relative(#heap(dirs()),name)))
    end

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/net.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/net.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/net.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 type int = Int.t
 
 signature NET =

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/net.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/net.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/net.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 structure Net: NET =
 struct
 
@@ -20,18 +21,18 @@
       (fn () =>
        In.withNull
        (fn ins =>
-	Out.withNull
-	(fn out =>
-	 Process.call ("ping", ["-U", "-q", "-c",
-				Int.toString numTries, machine])
-	 (ins, out))))
+        Out.withNull
+        (fn out =>
+         Process.call ("ping", ["-U", "-q", "-c",
+                                Int.toString numTries, machine])
+         (ins, out))))
 end
 
 local
    val z = Posix.ProcEnv.uname ()
    fun lookup s =
       case List.peek (z, fn (s', _) => s = s') of
-	 NONE => Process.fail (concat [s, " unknown"])
+         NONE => Process.fail (concat [s, " unknown"])
        | SOME (_, s) => s
 in
    val fullHostname = lookup "nodename"
@@ -41,7 +42,7 @@
 
 fun ethernetIsUp (): bool =
    String.hasSubstring (Process.collect (Process.call ("ifconfig", [])),
-			{substring = "eth0"})
+                        {substring = "eth0"})
 
 val message = Trace.Immediate.messageStr
 
@@ -52,39 +53,39 @@
       val _ = message (concat ["connect ", host, ":", Int.toString port])
       fun con () = Socket.connect (host, port)
       val io =
-	 case !repeat of
-	    NONE => (SOME (con ()) handle _ => NONE)
-	  | SOME {limit, tries} =>
-	       Engine.repeat {thunk = con, tries = tries, limit = limit}
+         case !repeat of
+            NONE => (SOME (con ()) handle _ => NONE)
+          | SOME {limit, tries} =>
+               Engine.repeat {thunk = con, tries = tries, limit = limit}
    in case io of
       SOME io => io
     | NONE => Process.fail (concat ["unable to connect to ",
-				  host, ":", Int.toString port])
+                                  host, ":", Int.toString port])
    end
 
 fun server (p: port, c: In.t * Out.t -> unit): unit =
    let
       val socket =
-	 Process.try (fn () => Socket.listenAt p,
-		     concat ["server unable to bind port ", Int.toString p])
+         Process.try (fn () => Socket.listenAt p,
+                     concat ["server unable to bind port ", Int.toString p])
       val _ = message (concat ["server listening on ", Int.toString p])
       fun loop () =
-	 let
-	    val (a, port, ins, out) =
-	       Process.try (fn () => Socket.accept socket, "accept failed")
-	    val name =
-	       case Socket.Host.getByAddress a of
-		  NONE => Word.toString a
-		| SOME {name, ...} => name
-	    val _ =
-	       Process.doubleFork
-	       (fn () => (message (concat ["accept from ",
-					   name, ":", Int.toString port])
-			  ; c (ins, out)))
-	    val _ = In.close ins
-	    val _ = Out.close out
-	 in loop ()
-	 end
+         let
+            val (a, port, ins, out) =
+               Process.try (fn () => Socket.accept socket, "accept failed")
+            val name =
+               case Socket.Host.getByAddress a of
+                  NONE => Word.toString a
+                | SOME {name, ...} => name
+            val _ =
+               Process.doubleFork
+               (fn () => (message (concat ["accept from ",
+                                           name, ":", Int.toString port])
+                          ; c (ins, out)))
+            val _ = In.close ins
+            val _ = Out.close out
+         in loop ()
+         end
    in Process.watch loop
    end
    

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/number.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/number.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/number.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,16 +1,16 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 (*-------------------------------------------------------------------*)
 (*                              Number                               *)
 (*-------------------------------------------------------------------*)
 
 functor Number(structure I : INTEGER
-	       structure R : REAL
-	       val intToReal : I.t -> R.t) : NUMBER =
+               structure R : REAL
+               val intToReal : I.t -> R.t) : NUMBER =
 struct
 
 structure I = I
@@ -25,7 +25,7 @@
 val intToRat = R.fromInt
 
 fun ratToReal p = F./(intToReal(R.numerator p),
-		      intToReal(R.denominator p))
+                      intToReal(R.denominator p))
 
 fun toReal(Int m) = intToReal m
   | toReal(Rat p) = ratToReal p
@@ -63,8 +63,8 @@
    val (op ~) = close(unary,I.~,R.~,F.~)
    val (op * ) = close(binary,I.*,R.*,F.* )
    val inverse = unary(Rat o R.inverse o intToRat,
-		       Rat o R.inverse,
-		       Real o F.inverse)
+                       Rat o R.inverse,
+                       Real o F.inverse)
 
    val compare = binary(I.compare,R.compare,F.compare)
    val op < = binary(I.<, R.<, F.<)
@@ -139,15 +139,15 @@
    if isZero z' then one
    else case (z,z') of
       (Int m,Int n) => if I.isPositive n
-			  then Int(I.^(m,n))
-		       else Rat(R.inverse
-				(intToRat(I.^(m,I.~ n))))
+                          then Int(I.^(m,n))
+                       else Rat(R.inverse
+                                (intToRat(I.^(m,I.~ n))))
     | (Int m,_) => Real(F.^(intToReal m,toReal z'))
     | _ => Real(F.^(toReal z,toReal z'))
 
 fun random(Int m,Int n) = Int(I.random(m,n))
   | random(z,z') = Real(F.random(toReal z,toReal z'))
-				    
+                                    
 val toReal = F.toReal o toReal
 val fromReal = Real o F.fromReal
 val toInt = unaryIntOnly I.toInt
@@ -166,6 +166,6 @@
 
 (*
 structure Number = Number(structure I = BigInteger
-			  structure R = FloatReal
-			  val intToReal = I.toReal)
+                          structure R = FloatReal
+                          val intToReal = I.toReal)
 *)

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/number.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/number.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/number.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature NUMBER =
    sig
       include INTEGER
@@ -17,7 +18,7 @@
       val log2 : t -> t
 
       val fromReal : real -> t
-	 
+         
       (* Rational Specific *)
       val numerator : t -> I.t
       val denominator : t -> I.t

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/option.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/option.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/option.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,17 +1,20 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature OPTION =
    sig
       type 'a t = 'a option
 
       val app: 'a t * ('a -> unit) -> unit
       val equals: 'a t * 'a t * ('a * 'a -> bool) -> bool
+      val exists: 'a t * ('a -> bool) -> bool
       val fold: 'a t * 'b * ('a * 'b -> 'b) -> 'b
       val forall: 'a t * ('a -> bool) -> bool
+      val foreach: 'a t * ('a -> unit) -> unit
       val isNone: 'a t -> bool
       val isSome: 'a t -> bool
       val layout: ('a -> Layout.t) -> 'a t -> Layout.t

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/option.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/option.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/option.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 structure Option: OPTION =
 struct
 
@@ -16,16 +17,23 @@
       NONE => b
     | SOME x => f (x, b)
 
+fun exists (z, f) =
+   case z of
+      NONE => false
+    | SOME x => f x
+
 fun forall (z, f) =
    case z of
       NONE => true
     | SOME x => f x
-	 
-fun app (opt, f) =
+         
+fun foreach (opt, f) =
    case opt of
       NONE => ()
     | SOME x => f x
 
+val app = foreach
+
 fun map (opt, f) =
    case opt of
       NONE => NONE
@@ -52,7 +60,7 @@
       open Layout
    in
       case opt of
-	 NONE => str "None"
+         NONE => str "None"
        | SOME x => seq [str "Some ", layoutX x]
    end
 

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/order.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/order.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/order.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature ORDER =
    sig
       include ORDER0

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/order0.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/order0.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/order0.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature ORDER0 =
    sig
       type t

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/ordered-field.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/ordered-field.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/ordered-field.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,8 +1,8 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 (*-------------------------------------------------------------------*)
 (*                           OrderedField                            *)

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/ordered-field.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/ordered-field.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/ordered-field.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature ORDERED_FIELD_STRUCTS =
    sig
       include ORDERED_RING

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/ordered-ring.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/ordered-ring.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/ordered-ring.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 functor OrderedRing(S: ORDERED_RING_STRUCTS):> ORDERED_RING where type t = S.t =
 struct
 
@@ -19,7 +20,7 @@
 
 fun foldl(from, to, b, f) =
    let fun fold(n, a) = if n > to then a
-		       else fold(add1 n, f(a,n))
+                       else fold(add1 n, f(a,n))
    in fold(from, b)
    end
 

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/ordered-ring.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/ordered-ring.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/ordered-ring.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature ORDERED_RING_STRUCTS =
    sig
       include RING_WITH_IDENTITY

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/outstream.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/outstream.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/outstream.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,13 +1,14 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature OUTSTREAM =
    sig
       type t
-	 
+         
       val close: t -> unit
       val error: t
       val fluidLet: t * t * (unit -> 'a) -> 'a

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/outstream.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/outstream.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/outstream.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 structure Outstream: OUTSTREAM =
 struct
 

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/outstream0.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/outstream0.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/outstream0.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 structure Outstream0 =
 struct
 
@@ -32,20 +33,22 @@
    TextIO.setOutstream (o1, TextIO.getOutstream o2)
    
 fun fluidLet (s1, s2, thunk) =
-   let val old = TextIO.getOutstream s1
-   in set (s1, s2)
-      ; DynamicWind.wind (thunk, fn () => TextIO.setOutstream (s1, old))
+   let
+      val old = TextIO.getOutstream s1
+      val () = set (s1, s2)
+   in
+      Exn0.finally (thunk, fn () => TextIO.setOutstream (s1, old))
    end
 
 fun withClose (out: t, f: t -> 'a): 'a =
-   DynamicWind.wind (fn () => f out, fn () => close out)
+   Exn0.finally (fn () => f out, fn () => close out)
 
 local
    fun 'a withh (f, p: t -> 'a, openn): 'a =
       let
-	 val out = openn f handle IO.Io _ => Error.bug ("cannot open " ^ f)
+         val out = openn f handle IO.Io _ => Error.bug ("OutStream0.withh: cannot open " ^ f)
       in
-	 withClose (out, p)
+         withClose (out, p)
       end
 in
    fun 'a withOut (f, p: t -> 'a): 'a = withh (f, p, openOut)

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/pair.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/pair.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/pair.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,15 +1,15 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 (*-------------------------------------------------------------------*)
 (*                               Pair                                *)
 (*-------------------------------------------------------------------*)
 
 functor Pair(structure X: T
-	     structure Y: T): PAIR =
+             structure Y: T): PAIR =
 struct
 
 structure X = X 

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/pair.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/pair.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/pair.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature PAIR =
    sig
       structure X: T

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/parse.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/parse.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/parse.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 functor Parse (S: PARSE_STRUCTS): PARSE = 
 struct
 

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/parse.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/parse.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/parse.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature PARSE_STRUCTS = 
    sig
       structure Sexp: SEXP

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/pid.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/pid.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/pid.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,13 +1,14 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature PID =
    sig
       type t
-	 
+         
       val current: unit -> t
       val equals: t * t -> bool
       val fromString: string -> t option

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/pid.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/pid.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/pid.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,17 +1,18 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 structure Pid: PID =
    struct
       local open Posix.Process
       in
-	 type t = pid
-	 val toString = SysWord.fmt StringCvt.DEC o pidToWord
-	 fun fromString s =
-	    Option.map(Pervasive.Int.fromString s, wordToPid o SysWord.fromInt)
+         type t = pid
+         val toString = SysWord.fmt StringCvt.DEC o pidToWord
+         fun fromString s =
+            Option.map(Pervasive.Int.fromString s, wordToPid o SysWord.fromInt)
       end
 
 
@@ -19,8 +20,8 @@
 
       local open Posix.ProcEnv
       in
-	 val current = getpid
-	 val parent = getppid
+         val current = getpid
+         val parent = getppid
       end
 
       val equals = op =

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/pointer.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/pointer.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/pointer.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature POINTER =
    sig
       type 'a t

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/pointer.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/pointer.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/pointer.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 structure Pointer: POINTER =
 struct
    

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/popt.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/popt.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/popt.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,9 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 type int = Int.t
@@ -16,18 +16,18 @@
       datatype t =
          (* one arg: a boolean (true, false), after a space *)
          Bool of bool -> unit
-	 (* one arg: an integer, after a space *)
+         (* one arg: an integer, after a space *)
        | Digit of int -> unit
-	 (* one arg: an integer followed by tional k or m. *)
+         (* one arg: an integer followed by tional k or m. *)
        | Int of int -> unit
-	 (* one arg: a single digit, no space. *)
+         (* one arg: a single digit, no space. *)
        | Mem of int -> unit
-	 (* no args *)
+         (* no args *)
        | None of unit -> unit
        | Real of real -> unit
-	 (* Any string immediately follows the switch. *)
+         (* Any string immediately follows the switch. *)
        | String of string -> unit
-	 (* one arg: any string *)
+         (* one arg: any string *)
        | SpaceString of string -> unit
        | SpaceString2 of string * string -> unit
 
@@ -38,7 +38,7 @@
       val trueRef: bool ref -> t
 
       val trace: string * t
-	 
+         
       (* Parse the switches, applying the first matching t to each switch,
        * and return any remaining args.
        * Returns NONE if it encounters an error.
@@ -49,21 +49,21 @@
        * then parse will call f() and return "bar".
        *)
       val parse:
-	 {
-	  switches: string list,
-	  opts: (string * t) list
-	 }
-	 -> string list Result.t
+         {
+          switches: string list,
+          opts: (string * t) list
+         }
+         -> string list Result.t
 
       datatype optionStyle = Normal | Expert
       val makeUsage: {mainUsage: string,
-		      makeOptions: ({usage: string -> unit}
-				    -> {style: optionStyle,
-					name: string,
-					arg: string,
-					desc: string,
-					opt: t} list),
-		      showExpert: unit -> bool
-		      } -> {parse: string list -> string list Result.t,
-			    usage: string -> unit}
+                      makeOptions: ({usage: string -> unit}
+                                    -> {style: optionStyle,
+                                        name: string,
+                                        arg: string,
+                                        desc: string,
+                                        opt: t} list),
+                      showExpert: unit -> bool
+                      } -> {parse: string list -> string list Result.t,
+                            usage: string -> unit}
    end

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/popt.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/popt.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/popt.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 type int = Int.t
 
 structure Popt: POPT =
@@ -35,117 +36,118 @@
 fun stringRef (r: string ref): t = String (fn s => r := s)
 
 val trace = ("trace", SpaceString (fn s =>
-				   let open Trace.Immediate
-				      val _ = debug := Out Out.error
-				   in case s of
-				      "*" => always ()
-				    | _ => (flagged ()
-					    ; on (String.split (s, #",")))
-				   end))
+                                   let
+                                      open Trace.Immediate
+                                      val _ = debug := Out Out.error
+                                   in case s of
+                                      "*" => always ()
+                                    | _ => (flagged ()
+                                            ; on (String.split (s, #",")))
+                                   end))
 
 fun memString (s: string): int option =
    let
       val n = String.size s
       fun loop (i, ac) =
-	 if i >= n
-	    then SOME ac
-	 else
-	    let val c = String.sub (s, i)
-	       fun done n = SOME (n * ac)
-	    in case c of
-	       #"m" => done 1048576
-	     | #"k" => done 1024
-	     | _ =>
-		  case Char.digitToInt c of
-		     NONE => NONE
-		   | SOME c => loop (i + 1, ac * 10 + c)
-	    end
+         if i >= n
+            then SOME ac
+         else
+            let val c = String.sub (s, i)
+               fun done n = SOME (n * ac)
+            in case c of
+               #"m" => done 1048576
+             | #"k" => done 1024
+             | _ =>
+                  case Char.digitToInt c of
+                     NONE => NONE
+                   | SOME c => loop (i + 1, ac * 10 + c)
+            end
    in loop (0, 0)
    end
 
 (* Parse the command line opts and return any remaining args. *)
 fun parse {switches: string list,
-	   opts: (string * t) list}: string list Result.t =
+           opts: (string * t) list}: string list Result.t =
    let
       exception Error of string
       val rec loop =
-	 fn [] => []
-	  | switch :: switches =>
-	       let
-		  fun error s = raise (Error s)
-	       in
-		  case String.sub (switch, 0) of
-		     #"-" =>
-		     let val switch = String.dropPrefix (switch, 1)
-		     in case List.peek (opts, fn (switch', _) =>
-					switch = switch') of
-			NONE =>
-			   let
-			      (* Handle the switches where there is no space
-			       * separating the argument.
-			       *)
-			      val rec loop' =
-				 fn [] => error (concat ["unknown switch: -",
-							 switch])
-				  | (switch', arg) :: opts =>
-				       let
-					  fun doit f =
-					     if String.hasPrefix
-						(switch, {prefix = switch'})
-						then f (String.dropPrefix
-							(switch, String.size switch'))
-					     else loop' opts
-				       in case arg of
-					  Digit f =>
-					     doit (fn s =>
-						   let
-						      val error =
-							 fn () =>
-							 error (concat ["invalid digit ", s, " used with -", switch])
-						   in
-						      if size s = 1
-							 then (case Char.digitToInt
-								  (String.sub (s, 0)) of
-								  NONE => error ()
-								| SOME i => f i)
-						      else error ()
-						   end)
-					| String f => doit f
-					| _ => loop' opts
-				       end
-			   in loop' opts
-			      ; loop switches
-			   end
-		      | SOME (_, arg) =>
-			   let
-			      fun next (f, get, msg) =
-				 case switches of
-				    [] =>
-				       error (concat ["-", switch, " requires an argument"])
-				  | switch' :: switches =>
-				       case get switch' of
-					  NONE => error (concat ["-", switch, " requires ", msg])
-					| SOME n => (f n; loop switches)
-			   in
-			      case arg of
-				 Bool f => next (f, Bool.fromString, "a boolean")
-			       | Digit _ =>
-				    error (concat ["-", switch, " requires a digit"])
-			       | Int f => next (f, Int.fromString, "an integer")
-			       | Mem f => next (f, memString, "a memory amount")
-			       | None f => (f (); loop switches)
-			       | Real f => next (f, Real.fromString, "a real")
-			       | SpaceString f => next (f, SOME, "")
-			       | SpaceString2 f =>
-				    (case switches of
-					s1 :: s2 :: switches =>
-					   (f (s1, s2); loop switches)
-				      | _ => error (concat ["-", switch, " requires two arguments"]))
-			       | String f => (f ""; loop switches)
-			   end
-		     end
-		   | _ => switch :: switches
-	       end
+         fn [] => []
+          | switch :: switches =>
+               let
+                  fun error s = raise (Error s)
+               in
+                  case String.sub (switch, 0) of
+                     #"-" =>
+                     let val switch = String.dropPrefix (switch, 1)
+                     in case List.peek (opts, fn (switch', _) =>
+                                        switch = switch') of
+                        NONE =>
+                           let
+                              (* Handle the switches where there is no space
+                               * separating the argument.
+                               *)
+                              val rec loop' =
+                                 fn [] => error (concat ["unknown switch: -",
+                                                         switch])
+                                  | (switch', arg) :: opts =>
+                                       let
+                                          fun doit f =
+                                             if String.hasPrefix
+                                                (switch, {prefix = switch'})
+                                                then f (String.dropPrefix
+                                                        (switch, String.size switch'))
+                                             else loop' opts
+                                       in case arg of
+                                          Digit f =>
+                                             doit (fn s =>
+                                                   let
+                                                      val error =
+                                                         fn () =>
+                                                         error (concat ["invalid digit ", s, " used with -", switch])
+                                                   in
+                                                      if size s = 1
+                                                         then (case Char.digitToInt
+                                                                  (String.sub (s, 0)) of
+                                                                  NONE => error ()
+                                                                | SOME i => f i)
+                                                      else error ()
+                                                   end)
+                                        | String f => doit f
+                                        | _ => loop' opts
+                                       end
+                           in loop' opts
+                              ; loop switches
+                           end
+                      | SOME (_, arg) =>
+                           let
+                              fun next (f: 'a -> unit, get, msg) =
+                                 case switches of
+                                    [] =>
+                                       error (concat ["-", switch, " requires an argument"])
+                                  | switch' :: switches =>
+                                       case get switch' of
+                                          NONE => error (concat ["-", switch, " requires ", msg])
+                                        | SOME n => (f n; loop switches)
+                           in
+                              case arg of
+                                 Bool f => next (f, Bool.fromString, "a boolean")
+                               | Digit _ =>
+                                    error (concat ["-", switch, " requires a digit"])
+                               | Int f => next (f, Int.fromString, "an integer")
+                               | Mem f => next (f, memString, "a memory amount")
+                               | None f => (f (); loop switches)
+                               | Real f => next (f, Real.fromString, "a real")
+                               | SpaceString f => next (f, SOME, "")
+                               | SpaceString2 f =>
+                                    (case switches of
+                                        s1 :: s2 :: switches =>
+                                           (f (s1, s2); loop switches)
+                                      | _ => error (concat ["-", switch, " requires two arguments"]))
+                               | String f => (f ""; loop switches)
+                           end
+                     end
+                   | _ => switch :: switches
+               end
    in
       Result.Yes (loop switches) handle Error s => Result.No s
    end
@@ -158,43 +160,43 @@
       fun usage (s: string): unit = valOf (!usageRef) s
       fun options () = makeOptions {usage = usage}
       val _ =
-	 usageRef :=
-	 SOME
-	 (fn s =>
-	  let
-	     val out = Out.error
-	     fun message s = Out.outputl (out, s)
-	     val opts =
-		List.fold
-		(rev (options ()), [],
-		 fn ({arg, desc, opt = _, name, style}, rest) =>
-		 if style = Normal orelse showExpert ()
-		    then [concat ["    -", name, arg, " "], desc] :: rest
-		 else rest)
-	     val table =
-		let
-		   open Justify
-		in
-		   table {columnHeads = NONE,
-			  justs = [Left, Left],
-			  rows = opts}
-		end
-	  in
-	     message s
-	     ; message (concat ["usage: ", mainUsage])
-	     ; List.foreach (table, fn ss =>
-			     message (String.removeTrailing
-				      (concat ss, Char.isSpace)))
-	     ; let open OS.Process
-	       in if MLton.isMLton
-		     then exit failure
-		  else raise Fail "error"
-	       end
-	  end)
+         usageRef :=
+         SOME
+         (fn s =>
+          let
+             val out = Out.error
+             fun message s = Out.outputl (out, s)
+             val opts =
+                List.fold
+                (rev (options ()), [],
+                 fn ({arg, desc, opt = _, name, style}, rest) =>
+                 if style = Normal orelse showExpert ()
+                    then [concat ["    -", name, arg, " "], desc] :: rest
+                 else rest)
+             val table =
+                let
+                   open Justify
+                in
+                   table {columnHeads = NONE,
+                          justs = [Left, Left],
+                          rows = opts}
+                end
+          in
+             message s
+             ; message (concat ["usage: ", mainUsage])
+             ; List.foreach (table, fn ss =>
+                             message (String.removeTrailing
+                                      (concat ss, Char.isSpace)))
+             ; let open OS.Process
+               in if MLton.isMLton
+                     then exit failure
+                  else Error.bug "Popt.makeUsage"
+               end
+          end)
       val parse =
-	 fn switches =>
-	 parse {opts = List.map (options (), fn {name, opt, ...} => (name, opt)),
-		switches = switches}
+         fn switches =>
+         parse {opts = List.map (options (), fn {name, opt, ...} => (name, opt)),
+                switches = switches}
    in
       {parse = parse,
        usage = usage}

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/port.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/port.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/port.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 type int = Int.t
    
 signature PORT =

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/port.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/port.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/port.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 structure Port: PORT =
 struct
 

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/postscript.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/postscript.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/postscript.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 type int = Int.t
    
 signature POSTSCRIPT =

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/postscript.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/postscript.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/postscript.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 structure Postscript: POSTSCRIPT =
 struct
 
@@ -14,13 +15,13 @@
       open Char
 
       fun escapePostscript c =
-	 if isPrint c
-	    then (case c of
-		     #"\\" => "\\\\"
-		   | #"(" => "\\("
-		   | #")" => "\\)"
-		   | _ => toString c)
-	 else escapeC c
+         if isPrint c
+            then (case c of
+                     #"\\" => "\\\\"
+                   | #"(" => "\\("
+                   | #")" => "\\)"
+                   | _ => toString c)
+         else escapeC c
    end
 
 structure String =
@@ -343,23 +344,23 @@
 fun programString(os: t list): string =
    let
       fun loop(os: t list,
-	       lineLen: int,
-	       line: string list,
-	       lines: string list): string =
-	 let
-	    fun newLine() = concat("\n" :: rev line) :: lines
-	 in case os of
-	    [] => concat(rev(newLine()))
-	  | oper :: os =>
-	       let
-		  val oper = toString oper
-		  val m = String.size oper
-		  val lineLen = m + 1 + lineLen
-	       in if lineLen > 80
-		     then loop(os, m + 1, [" ", oper], newLine())
-		  else loop(os, lineLen, " " :: oper :: line, lines)
-	       end
-	 end
+               lineLen: int,
+               line: string list,
+               lines: string list): string =
+         let
+            fun newLine() = concat("\n" :: rev line) :: lines
+         in case os of
+            [] => concat(rev(newLine()))
+          | oper :: os =>
+               let
+                  val oper = toString oper
+                  val m = String.size oper
+                  val lineLen = m + 1 + lineLen
+               in if lineLen > 80
+                     then loop(os, m + 1, [" ", oper], newLine())
+                  else loop(os, lineLen, " " :: oper :: line, lines)
+               end
+         end
    in loop(os, 0, [], ["%!PS\n"])
    end
 
@@ -378,10 +379,10 @@
    pageHeight - margin - dateHeight - userHeight * (1.0 + userRatio) / 2.0
    
 fun makeHeader{
-	       host: string,
-	       job: string,
-	       user: string
-	       }: string =
+               host: string,
+               job: string,
+               user: string
+               }: string =
    let val now = Date.now()
       val time = string(concat["Time: ", Date.fmt(now, "%I:%M:%S %p")])
    in programString

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/power.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/power.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/power.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,24 +1,25 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 structure Types =
    struct
       type ('a, 'b) power =
-	 {layout: 'a -> Layout.t,
-	  one: 'a,
-	  times: 'a * 'a -> 'a}
-	 -> 'a * 'b
-	 -> 'a	 
+         {layout: 'a -> Layout.t,
+          one: 'a,
+          times: 'a * 'a -> 'a}
+         -> 'a * 'b
+         -> 'a   
 
       type ('a, 'b) simultaneous =
-	 {layout: 'a -> Layout.t,
-	  one: 'a,
-	  times: 'a * 'a -> 'a}
-	 -> ('a * 'b) list
-	 -> 'a
+         {layout: 'a -> Layout.t,
+          one: 'a,
+          times: 'a * 'a -> 'a}
+         -> ('a * 'b) list
+         -> 'a
    end
 
 structure Power:
@@ -35,18 +36,18 @@
 structure Int = Pervasive.Int
 structure Array = Pervasive.Array
 
-fun for(a: Int.int, b: Int.int, f) =
+fun for(a: Int.int, b: Int.int, f: Int.int -> unit) =
    let fun loop i = if i >= b then () else (f i; loop(i + 1))
    in loop a
    end
-	 
+         
 type 'a exponent =  {isZero: 'a -> bool,
-		     divMod: 'a * 'a -> 'a * 'a,
-		     two: 'a}
+                     divMod: 'a * 'a -> 'a * 'a,
+                     two: 'a}
 
 type 'a base = {one: 'a,
-		times: 'a * 'a -> 'a,
-		layout: 'a -> Layout.t}
+                times: 'a * 'a -> 'a,
+                layout: 'a -> Layout.t}
    
 fun ('a, 'b) make
    ({isZero, divMod, two}: 'a exponent)
@@ -55,84 +56,84 @@
       val op * = times
       (* Repeated squaring. *)
       fun power(b: 'b, n: 'a): 'b =
-	 let
-	    (* The loop has been carefully unrolled once to avoid overflow when
-	     * 'a is a fixed size integer.
-	     *)
-	    fun loop(c, b, n) =
-	       (* c * b^2n = b0^n0 *)
-	       if isZero n then c else next(c, b * b, n)
-	    and next(c, b, n) =
-	       (* c * b^n = b0^n0 *)
-	       let val (d, m) = divMod(n, two)
-	       in loop(if isZero m then c else c * b, b, d)
-	       end
-	 in if isZero n
-	       then one
-	    else next(one, b, n)
-	 end
+         let
+            (* The loop has been carefully unrolled once to avoid overflow when
+             * 'a is a fixed size integer.
+             *)
+            fun loop(c, b, n) =
+               (* c * b^2n = b0^n0 *)
+               if isZero n then c else next(c, b * b, n)
+            and next(c, b, n) =
+               (* c * b^n = b0^n0 *)
+               let val (d, m) = divMod(n, two)
+               in loop(if isZero m then c else c * b, b, d)
+               end
+         in if isZero n
+               then one
+            else next(one, b, n)
+         end
       (* Based on page 618 of Handbook of Applied Cryptography. *)
       fun simultaneous(ges: ('b * 'a) list): 'b =
-	 let
-	    fun twoPowerWord i : Word.t = Word.<<(0w1, Word.fromInt i)
-	    val twoPower = Word.toInt o twoPowerWord
-	    fun doit ges =
-	       let
-		  val n = List.length ges
-		  val tableSize = twoPower n
-		  val table = Array.array(tableSize, one)
-		  val _ =
-		     List.foreachi
-		     (ges, fn (i, (g, _)) =>
-		      let val min = twoPower i
-		      in for(min, twoPower(i + 1), fn i =>
-			     Array.update(table, i,
-					  g * Array.sub(table, i - min)))
-		      end)
-		  fun loop(ews: ('a * Word.t) list, Gs: 'b list): 'b list =
-		     case ews of
-			[] => Gs
-		      | _ =>
-			   let
-			      val (ews, w) =
-				 List.fold
-				 (ews, ([], 0w0: Word.t),
-				  fn ((e, w'), (ews, w)) =>
-				  let
-				     val (e, m) = divMod(e, two)
-				     val ews =
-					if isZero e then ews else (e, w') :: ews
-				     val w =
-					if isZero m then w else Word.orb(w', w)
-				  in (ews, w)
-				  end)
-			   in loop(ews, Array.sub(table, Word.toInt w) :: Gs)
-			   end
-		  val ews = List.mapi (ges, fn (i, (_, e)) =>
-				       (e, twoPowerWord i))
-		  val Gs = loop (ews, [])
-	       in List.fold (Gs, one, fn (G, A) => A * A * G)
-	       end
-	    val window = 9
-	    fun split l =
-	       let
-		  fun loop(l, n, ac) =
-		     if n <= 0
-			then (rev ac, l)
-		     else (case l of
-			      [] => (rev ac, [])
-			    | x :: l => loop(l, n - 1, x :: ac))
-	       in loop(l, window, [])
-	       end
-	    fun loop(ges: ('b * 'a) list, ac: 'b): 'b =
-	       case ges of
-		  [] => ac
-		| [(g, e)] => ac * power(g, e)
-		| _ => let val (ges, rest) = split ges
-		       in loop(rest, ac * doit ges)
-		       end
-	 in loop(ges, one)
-	 end
+         let
+            fun twoPowerWord i : Word.t = Word.<<(0w1, Word.fromInt i)
+            val twoPower = Word.toInt o twoPowerWord
+            fun doit ges =
+               let
+                  val n = List.length ges
+                  val tableSize = twoPower n
+                  val table = Array.array(tableSize, one)
+                  val _ =
+                     List.foreachi
+                     (ges, fn (i, (g, _)) =>
+                      let val min = twoPower i
+                      in for(min, twoPower(i + 1), fn i =>
+                             Array.update(table, i,
+                                          g * Array.sub(table, i - min)))
+                      end)
+                  fun loop(ews: ('a * Word.t) list, Gs: 'b list): 'b list =
+                     case ews of
+                        [] => Gs
+                      | _ =>
+                           let
+                              val (ews, w) =
+                                 List.fold
+                                 (ews, ([], 0w0: Word.t),
+                                  fn ((e, w'), (ews, w)) =>
+                                  let
+                                     val (e, m) = divMod(e, two)
+                                     val ews =
+                                        if isZero e then ews else (e, w') :: ews
+                                     val w =
+                                        if isZero m then w else Word.orb(w', w)
+                                  in (ews, w)
+                                  end)
+                           in loop(ews, Array.sub(table, Word.toInt w) :: Gs)
+                           end
+                  val ews = List.mapi (ges, fn (i, (_, e)) =>
+                                       (e, twoPowerWord i))
+                  val Gs = loop (ews, [])
+               in List.fold (Gs, one, fn (G, A) => A * A * G)
+               end
+            val window = 9
+            fun split l =
+               let
+                  fun loop(l, n, ac) =
+                     if n <= 0
+                        then (rev ac, l)
+                     else (case l of
+                              [] => (rev ac, [])
+                            | x :: l => loop(l, n - 1, x :: ac))
+               in loop(l, window, [])
+               end
+            fun loop(ges: ('b * 'a) list, ac: 'b): 'b =
+               case ges of
+                  [] => ac
+                | [(g, e)] => ac * power(g, e)
+                | _ => let val (ges, rest) = split ges
+                       in loop(rest, ac * doit ges)
+                       end
+         in loop(ges, one)
+         end
    in {power = power, simultaneous = simultaneous}
    end
 

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/process.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/process.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/process.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,22 +1,23 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 type int = Int.t
    
 signature PROCESS =
    sig
       structure Command:
-	 sig
-	    type t = In.t * Out.t -> unit
-	 end
+         sig
+            type t = In.t * Out.t -> unit
+         end
 
       structure Status:
-	 sig
-	    type t
-	 end
+         sig
+            type t
+         end
 
       (* Execute a program in a subprocess and wait for it to finish.
        * call (file, args) (i, o) searches PATH for an executable named file,
@@ -89,17 +90,17 @@
       val watch: (unit -> unit) -> unit
 
       structure State:
-	 sig
-	    datatype t = DiskSleep | Running | Sleeping | Traced | Zombie
+         sig
+            datatype t = DiskSleep | Running | Sleeping | Traced | Zombie
 
-	    val toString: t -> string
-	 end
+            val toString: t -> string
+         end
 
       val ps: unit -> {name: string,
-		       pgrp: Pid.t,
-		       pid: Pid.t,
-		       ppid: Pid.t,
-		       state: State.t} list
+                       pgrp: Pid.t,
+                       pid: Pid.t,
+                       ppid: Pid.t,
+                       state: State.t} list
 
    end
 

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/process.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/process.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/process.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 structure Process: PROCESS =
 struct
 
@@ -18,10 +19,10 @@
       val status = OS.Process.system s
    in
       if status = OS.Process.success
-	 then ()
+         then ()
       else if status = OS.Process.failure
-	      then raise Fail (concat ["command failed: ", s])
-	   else raise Fail "strange return"
+              then Error.bug (concat ["Process.system: command failed: ", s])
+           else Error.bug (concat ["Process.system: strange return: ", s])
    end
 
 structure Command =
@@ -42,13 +43,13 @@
       type t = exit_status
 
       fun toString (s: t): string =
-	 case s of
-	    W_EXITED => "exited"
-	  | W_EXITSTATUS w => concat ["exit status ", Word8.toString w]
-	  | W_SIGNALED s => concat ["signal ",
-				    SysWord.toString (Posix.Signal.toWord s)]
-	  | W_STOPPED s => concat ["stop signal ",
-				   SysWord.toString (Posix.Signal.toWord s)]
+         case s of
+            W_EXITED => "exited"
+          | W_EXITSTATUS w => concat ["exit status ", Word8.toString w]
+          | W_SIGNALED s => concat ["signal ",
+                                    SysWord.toString (Posix.Signal.toWord s)]
+          | W_STOPPED s => concat ["stop signal ",
+                                   SysWord.toString (Posix.Signal.toWord s)]
 
       val layout = Layout.str o toString
    end
@@ -68,14 +69,14 @@
 (* This song and dance is so that succeed can have the right type, unit -> 'a,
  * instead of unit -> unit.
  *)
-val succeed: unit -> 'a = fn () => (succeed (); raise Fail "can't get here")
+val succeed: unit -> 'a = fn () => (succeed (); Error.bug "Process.succeed")
 
 fun fork (c: unit -> unit): Pid.t =
    case Posix.Process.fork () of
       NONE => (Trace.Immediate.inChildProcess ()
-	       ; let open OS.Process
-		 in exit ((c (); success) handle _ => failure)
-		 end)
+               ; let open OS.Process
+                 in exit ((c (); success) handle _ => failure)
+                 end)
     | SOME pid => pid
 
 val fork = Trace.trace ("Process.fork", Command.layout, Pid.layout) fork
@@ -88,8 +89,8 @@
    let
       val {infd, outfd} = FileDesc.pipe ()
       val pid = fork (fn () =>
-		      (FileDesc.close infd
-		       ; c (MLton.TextIO.newOut (outfd, pname))))
+                      (FileDesc.close infd
+                       ; c (MLton.TextIO.newOut (outfd, pname))))
       val _ = FileDesc.close outfd
    in
       (pid, MLton.TextIO.newIn (infd, pname))
@@ -99,8 +100,8 @@
    let
       val {infd, outfd} = FileDesc.pipe ()
       val pid = fork (fn () =>
-		      (FileDesc.close outfd
-		       ; c (MLton.TextIO.newIn (infd, pname))))
+                      (FileDesc.close outfd
+                       ; c (MLton.TextIO.newIn (infd, pname))))
       val _ = FileDesc.close infd
    in
       (pid, MLton.TextIO.newOut (outfd, pname))
@@ -111,9 +112,9 @@
       val {infd = in1, outfd = out1} = FileDesc.pipe ()
       val {infd = in2, outfd = out2} = FileDesc.pipe ()
       val pid = fork (fn () =>
-		      (closes [in1, out2]
-		       ; c (MLton.TextIO.newIn (in2, pname),
-			    MLton.TextIO.newOut (out1, pname))))
+                      (closes [in1, out2]
+                       ; c (MLton.TextIO.newIn (in2, pname),
+                            MLton.TextIO.newOut (out1, pname))))
       val _ = closes [in2, out1]
    in (pid,
        MLton.TextIO.newIn (in1, pname),
@@ -123,14 +124,14 @@
 fun wait (p: Pid.t): unit =
    let val (p', s) = Posix.Process.waitpid (Posix.Process.W_CHILD p, [])
    in if p <> p'
-	 then raise Fail (concat ["wait expected pid ",
-				  Pid.toString p,
-				  " but got pid ",
-				  Pid.toString p'])
+         then Error.bug (concat ["Process.wait: expected pid ",
+                                  Pid.toString p,
+                                  " but got pid ",
+                                  Pid.toString p'])
       else ()
-	 ; (case s of
-	       PosixStatus.W_EXITED => ()
-	     | _ => raise Fail (concat [PosixStatus.toString s]))
+         ; (case s of
+               PosixStatus.W_EXITED => ()
+             | _ => raise Fail (concat [PosixStatus.toString s]))
    end
 
 val wait = Trace.trace ("Process.wait", Pid.layout, Unit.layout) wait
@@ -145,50 +146,50 @@
    struct
       open Posix
       structure Process =
-	 struct
-	    open Process
+         struct
+            open Process
 
-	    val wait =
-	       Trace.trace ("Posix.Process.wait", Unit.layout,
-			   Layout.tuple2 (Pid.layout, PosixStatus.layout))
-	       wait
-	 end
+            val wait =
+               Trace.trace ("Process.Posix.Process.wait", Unit.layout,
+                           Layout.tuple2 (Pid.layout, PosixStatus.layout))
+               wait
+         end
    end
 
 fun waits (pids: Pid.t list): unit =
    case pids of
       [] => ()
     | _ =>
-	 let
-	    val (pid, status) = Posix.Process.wait ()
-	    val pids =
-	       case status of
-		  Posix.Process.W_EXITED =>
-		     List.keepAll (pids, fn p => p <> pid)
-		| _ => raise Fail (concat ["child ",
-					   Pid.toString pid,
-					   " failed with ",
-					   PosixStatus.toString status])
-	 in waits pids
-	 end
+         let
+            val (pid, status) = Posix.Process.wait ()
+            val pids =
+               case status of
+                  Posix.Process.W_EXITED =>
+                     List.keepAll (pids, fn p => p <> pid)
+                | _ => Error.bug (concat ["Process.waits: child ",
+                                          Pid.toString pid,
+                                          " failed with ",
+                                          PosixStatus.toString status])
+         in waits pids
+         end
 
 fun pipe (cs: command list, ins: In.t, out: Out.t): unit =
    let
       fun loop (cs: command list,
-	       ins: In.t,
-	       maybeClose,
-	       pids: Pid.t list): unit =
-	 case cs of
-	    [] => ()
-	  | [c] => let val pid = fork (fn () => c (ins, out))
-		       val _ = maybeClose ()
-		   in waits (pid :: pids)
-		   end
-	  | c :: cs =>
-	       let val (pid, ins) = forkIn (fn out => c (ins, out))
-		  val _ = maybeClose ()
-	       in loop (cs, ins, fn _ => In.close ins, pid :: pids)
-	       end
+               ins: In.t,
+               maybeClose,
+               pids: Pid.t list): unit =
+         case cs of
+            [] => ()
+          | [c] => let val pid = fork (fn () => c (ins, out))
+                       val _ = maybeClose ()
+                   in waits (pid :: pids)
+                   end
+          | c :: cs =>
+               let val (pid, ins) = forkIn (fn out => c (ins, out))
+                  val _ = maybeClose ()
+               in loop (cs, ins, fn _ => In.close ins, pid :: pids)
+               end
    in loop (cs, ins, fn _ => (), [])
    end
 
@@ -199,23 +200,23 @@
       open FileDesc
    in
       if MLton.isMLton
-	 then (move {from = MLton.TextIO.inFd ins,
-		     to = stdin}
-	       ; move {from = MLton.TextIO.outFd out,
-		       to = stdout}
-	       ; move {from = MLton.TextIO.outFd Out.error,
-		       to = stderr})
+         then (move {from = MLton.TextIO.inFd ins,
+                     to = stdin}
+               ; move {from = MLton.TextIO.outFd out,
+                       to = stdout}
+               ; move {from = MLton.TextIO.outFd Out.error,
+                       to = stderr})
       else ()
       ; (Posix.Process.execp (c, c :: a)
-	 handle _ => (Out.output (Out.error,
-				  (concat ("unable to exec "
-					   :: List.separate (c :: a, " "))))
-		      ; OS.Process.exit OS.Process.failure))
+         handle _ => (Out.output (Out.error,
+                                  (concat ("unable to exec "
+                                           :: List.separate (c :: a, " "))))
+                      ; OS.Process.exit OS.Process.failure))
    end
 
 val exec =
    Trace.trace4 ("Process.exec", String.layout, List.layout String.layout,
-		 In.layout, Out.layout, Unit.layout)
+                 In.layout, Out.layout, Unit.layout)
    exec
 
 fun call (c, a) (ins, out) = run (fn () => exec (c, a, ins, out))
@@ -233,19 +234,19 @@
    Trace.trace ("Process.doesSucceed", Function.layout, Bool.layout)
    doesSucceed
 
-fun makeCommandLine commandLine args =
+fun makeCommandLine (commandLine: string list -> unit) args =
    ((commandLine args; OS.Process.success)
     handle e =>
        let
-	  val out = Out.error
-	  open Layout
+          val out = Out.error
+          open Layout
        in
-	  output (Exn.layout e, out)
-	  ; List.foreach (Exn.history e, fn s =>
-			  (Out.output (out, "\n\t")
-			   ; Out.output (out, s)))
-	  ; Out.newline out
-	  ; OS.Process.failure
+          output (Exn.layout e, out)
+          ; List.foreach (Exn.history e, fn s =>
+                          (Out.output (out, "\n\t")
+                           ; Out.output (out, s)))
+          ; Out.newline out
+          ; OS.Process.failure
        end)
 
 fun makeMain z (): unit =
@@ -260,9 +261,9 @@
    fun su (name: string): unit =
       let val p = getpwnam name
       in setgid (Passwd.gid p)
-	 ; setuid (Passwd.uid p)
+         ; setuid (Passwd.uid p)
       end
-   val su = Trace.trace ("su", String.layout, Unit.layout) su
+   val su = Trace.trace ("Process.su", String.layout, Unit.layout) su
    fun userName () = Passwd.name (getpwuid (getuid ()))
 end
 
@@ -272,7 +273,7 @@
    val z = Posix.ProcEnv.uname ()
    fun lookup s =
       case List.peek (z, fn (s', _) => s = s') of
-	 NONE => fail (concat [s, " unknown"])
+         NONE => fail (concat [s, " unknown"])
        | SOME (_, s) => s
 in
    fun hostName () = lookup "nodename"
@@ -282,7 +283,7 @@
 
 fun glob (s: string): string list =
    String.tokens (collect (call ("bash", ["-c", "ls " ^ s])),
-		 fn c => c = #"\n")
+                 fn c => c = #"\n")
 
 fun usage {usage: string, msg: string}: 'a =
    fail (concat [msg, "\n", "Usage: ", commandName (), " ", usage])
@@ -292,9 +293,9 @@
 fun watch (f: unit -> unit) =
    let
       fun loop () =
-	 wait (fork f)
-	 handle _ => (messageStr "watcher noticed child failure"
-		      ; loop ())
+         wait (fork f)
+         handle _ => (messageStr "watcher noticed child failure"
+                      ; loop ())
    in loop ()
    end
 
@@ -314,11 +315,11 @@
 in
    fun try (f: unit -> 'a, msg: string): 'a =
       let
-	 fun loop (delay: Time.t): 'a =
-	    if Time.> (delay, maxDelay)
-	       then fail msg
-	    else (f () handle _ => (ignore (sleep delay)
-				   ; loop (Time.+ (delay, delay))))
+         fun loop (delay: Time.t): 'a =
+            if Time.> (delay, maxDelay)
+               then fail msg
+            else (f () handle _ => (ignore (sleep delay)
+                                   ; loop (Time.+ (delay, delay))))
       in loop delay
       end
 end
@@ -328,20 +329,20 @@
       datatype t = DiskSleep | Running | Sleeping | Traced | Zombie
 
       fun fromString s =
-	 case s of
-	    "D" => SOME DiskSleep
-	  | "R" => SOME Running
-	  | "S" => SOME Sleeping
-	  | "T" => SOME Traced
-	  | "Z" => SOME Zombie
-	  | _ => NONE
+         case s of
+            "D" => SOME DiskSleep
+          | "R" => SOME Running
+          | "S" => SOME Sleeping
+          | "T" => SOME Traced
+          | "Z" => SOME Zombie
+          | _ => NONE
 
       val toString =
-	 fn DiskSleep => "DiskSleep"
-	  | Running => "Running"
-	  | Sleeping => "Sleeping"
-	  | Traced => "Traced"
-	  | Zombie => "Zombie"
+         fn DiskSleep => "DiskSleep"
+          | Running => "Running"
+          | Sleeping => "Sleeping"
+          | Traced => "Traced"
+          | Zombie => "Zombie"
 
       val layout = Layout.str o toString
    end
@@ -354,34 +355,35 @@
     List.fold
     (Dir.lsDirs ".", [], fn (d, ac) =>
      case Pid.fromString d of
-	NONE => ac
+        NONE => ac
       | SOME pid =>
-	   case String.tokens (hd (File.lines ("/proc"/d/"stat")),
-			       Char.isSpace) of
-	      _ :: name :: state :: ppid :: pgrp :: _ =>
-		 {(* drop the ( ) around the name *)
-		  name = String.substring (name, 1, String.size name - 2),
-		  pgrp = valOf (Pid.fromString pgrp),
-		  pid = pid,
-		  ppid = valOf (Pid.fromString ppid),
-		  state = valOf (State.fromString state)
-		  } :: ac
-	    | _ => fail "ps"))
+           case String.tokens (hd (File.lines ("/proc"/d/"stat")),
+                               Char.isSpace) of
+              _ :: name :: state :: ppid :: pgrp :: _ =>
+                 {(* drop the ( ) around the name *)
+                  name = String.substring (name, 1, String.size name - 2),
+                  pgrp = valOf (Pid.fromString pgrp),
+                  pid = pid,
+                  ppid = valOf (Pid.fromString ppid),
+                  state = valOf (State.fromString state)
+                  } :: ac
+            | _ => fail "ps"))
 
 val ps =
    Trace.trace
-   ("ps", Unit.layout,
+   ("Process.ps", Unit.layout,
     List.layout (fn {name, pid, state, ...} =>
-		 Layout.record [("pid", Pid.layout pid),
-				("name", String.layout name),
-				("state", State.layout state)]))
+                 Layout.record [("pid", Pid.layout pid),
+                                ("name", String.layout name),
+                                ("state", State.layout state)]))
    ps
 
 fun callWithIn (name, args, f: In.t -> 'a) =
    let
       val (pid, ins) =
-	 forkIn (fn out => In.withNull (fn ins => call (name, args) (ins, out)))
-   in DynamicWind.wind
+         forkIn (fn out => In.withNull (fn ins => call (name, args) (ins, out)))
+   in
+      Exn.finally
       (fn () => In.withClose (ins, f),
        fn () => wait pid)
    end
@@ -389,16 +391,17 @@
 fun callWithOut (name, args, f: Out.t -> 'a) =
    let
       val (pid, out) =
-	 forkOut
-	 (fn ins => Out.withNull (fn out => call (name, args) (ins, out)))
-   in DynamicWind.wind
+         forkOut
+         (fn ins => Out.withNull (fn out => call (name, args) (ins, out)))
+   in
+      Exn.finally
       (fn () => Out.withClose (out, f),
        fn () => wait pid)
    end
 
 (*
- * text	   data	    bss	    dec	    hex	filename
- * 3272995	 818052	  24120	4115167	 3ecadf	mlton
+ * text    data     bss     dec     hex filename
+ * 3272995       818052   24120 4115167  3ecadf mlton
  *)
 fun size (f: File.t): {text: int, data: int, bss: int}  =
    let
@@ -407,22 +410,22 @@
       File.withTemp
       (fn sizeRes =>
        let
-	  val _ = OS.Process.system (concat ["size ", f, ">", sizeRes])
+          val _ = OS.Process.system (concat ["size ", f, ">", sizeRes])
        in
-	  File.withIn
-	  (sizeRes, fn ins =>
-	   case In.lines ins of
-	      [_, nums] =>
-		 (case String.tokens (nums, Char.isSpace) of
-		     text :: data :: bss :: _ =>
-			(case (Int.fromString text,
-			       Int.fromString data,
-			       Int.fromString bss) of
-			    (SOME text, SOME data, SOME bss) =>
-			       {text = text, data = data, bss = bss}
-			  | _ => fail ())
-		   | _ => fail ())
-	    | _ => fail ())
+          File.withIn
+          (sizeRes, fn ins =>
+           case In.lines ins of
+              [_, nums] =>
+                 (case String.tokens (nums, Char.isSpace) of
+                     text :: data :: bss :: _ =>
+                        (case (Int.fromString text,
+                               Int.fromString data,
+                               Int.fromString bss) of
+                            (SOME text, SOME data, SOME bss) =>
+                               {text = text, data = data, bss = bss}
+                          | _ => fail ())
+                   | _ => fail ())
+            | _ => fail ())
        end)
    end
 

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/promise.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/promise.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/promise.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,13 +1,14 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature PROMISE =
    sig
       type 'a t
-	 
+         
       exception Force
 
       val delay: (unit -> 'a) -> 'a t

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/promise.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/promise.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/promise.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 structure Promise: PROMISE =
 struct
 
@@ -35,13 +36,13 @@
    case !r of
       Evaluated x => x
     | Unevaluated th =>
-	 (let
-	     val _ = r := Evaluating
-	     val x = th ()
-	     val _ = r := Evaluated x
-	  in
-	     x
-	  end handle exn => (r := Unevaluated th; raise exn))
+         (let
+             val _ = r := Evaluating
+             val x = th ()
+             val _ = r := Evaluated x
+          in
+             x
+          end handle exn => (r := Unevaluated th; raise exn))
     | Evaluating => raise Force
 
 fun lazy th =

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/property-list.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/property-list.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/property-list.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 functor PropertyList (H: HET_CONTAINER):> PROPERTY_LIST =
 struct
 
@@ -27,38 +28,38 @@
       [seq [str "numPeeks = ", Int.layout (!numPeeks)],
        seq [str "maxLength = ", Int.layout (!maxLength)],
        seq [str "average position in property list = ",
-	    str let open Real
-		in format (fromInt (!numLinks) / fromInt (!numPeeks),
-			   Format.fix (SOME 3))
-		end]]
+            str let open Real
+                in format (fromInt (!numLinks) / fromInt (!numPeeks),
+                           Format.fix (SOME 3))
+                end]]
    end
 
 fun 'a newProperty () =
    let
       val {make, pred, peek = peekH} = H.new ()
       fun peek (T hs) =
-	 let
-	    fun loop (l, n) =
-	       let
-		  fun update () =
-		     ((numLinks := n + !numLinks
-		       handle Overflow => Error.bug "property list numLinks overflow")
-		      ; if n > !maxLength
-			   then maxLength := n
-			else ())
-	       in case l of
-		  [] => (update (); NONE)
-		| e :: l =>
-		     case peekH e of
-			r as SOME _ => (update (); r)
-		      | NONE => loop (l, n + 1)
-	       end
-	    val _ =
-	       numPeeks := 1 + !numPeeks
-	       handle Overflow => Error.bug "propery list numPeeks overflow"
-	 in
-	    loop (!hs, 0)
-	 end
+         let
+            fun loop (l, n) =
+               let
+                  fun update () =
+                     ((numLinks := n + !numLinks
+                       handle Overflow => Error.bug "PropertyList: numLinks overflow")
+                      ; if n > !maxLength
+                           then maxLength := n
+                        else ())
+               in case l of
+                  [] => (update (); NONE)
+                | e :: l =>
+                     case peekH e of
+                        r as SOME _ => (update (); r)
+                      | NONE => loop (l, n + 1)
+               end
+            val _ =
+               numPeeks := 1 + !numPeeks
+               handle Overflow => Error.bug "PropertyList: numPeeks overflow"
+         in
+            loop (!hs, 0)
+         end
 
       fun add (T hs, v: 'a): unit = hs := make v :: !hs
 

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/property-list.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/property-list.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/property-list.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 type int = Int.t
 
 signature PROPERTY_LIST = 
@@ -19,17 +20,17 @@
       val new: unit -> t
       (* create a new property *)
       val newProperty:
-	 unit -> {
+         unit -> {
                   (* See if a property is in a property list.
-		   * NONE if it isn't.
-		   *)
-		  peek: t -> 'a option,
-		  (* Add the value of the property -- must not already exist. *)
-		  add: t * 'a -> unit,
-		  (* Remove a property from a property list.
-		   * Noop if the property isn't there.
-		   *)
-		  remove: t -> unit
-		  }
+                   * NONE if it isn't.
+                   *)
+                  peek: t -> 'a option,
+                  (* Add the value of the property -- must not already exist. *)
+                  add: t * 'a -> unit,
+                  (* Remove a property from a property list.
+                   * Noop if the property isn't there.
+                   *)
+                  remove: t -> unit
+                  }
       val stats: unit -> Layout.t
    end

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/property.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/property.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/property.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 functor Property (Plist: PROPERTY_LIST):> PROPERTY where type Plist.t = Plist.t =
 struct
 
@@ -28,28 +29,28 @@
      end))
    
 fun ('sym, 'val) nondestructable (plist: 'sym -> Plist.t,
-				  init: ('sym, 'val) init) =
+                                  init: ('sym, 'val) init) =
    let
       val {add, peek, remove, ...} = Plist.newProperty ()
       fun get (s: 'sym) =
-	 let
-	    val p = plist s
-	 in
-	    case peek p of
-	    NONE => (case init of
-			Const c => c
-		      | Fun f =>
-			   let val v = f (s, get)
-			   in add (p, v); v
-			   end)
-	  | SOME v => v
-	 end
+         let
+            val p = plist s
+         in
+            case peek p of
+            NONE => (case init of
+                        Const c => c
+                      | Fun f =>
+                           let val v = f (s, get)
+                           in add (p, v); v
+                           end)
+          | SOME v => v
+         end
       fun set (s: 'sym, none: unit -> 'val, some: 'val -> unit): unit =
-	 let val p = plist s
-	 in case peek p of
-	    NONE => add (p, none ())
-	  | SOME v => some v
-	 end
+         let val p = plist s
+         in case peek p of
+            NONE => add (p, none ())
+          | SOME v => some v
+         end
    in {get = get, rem = remove o plist, remove = remove, set = set}
    end
 
@@ -58,26 +59,26 @@
       val plists = ref []
       fun add s = List.push (plists, plist s)
       val {get, remove, set, ...} =
-	 nondestructable (plist,
-			  case init of
-			     Const _ => init
-			   | Fun f => Fun (fn z as (s, _) => (add s; f z)))
+         nondestructable (plist,
+                          case init of
+                             Const _ => init
+                           | Fun f => Fun (fn z as (s, _) => (add s; f z)))
       val set: 'sym * (unit -> 'val) * ('val -> unit) -> unit =
-	 fn (s, none, some) => set (s, fn () => (add s; none ()), some)
+         fn (s, none, some) => set (s, fn () => (add s; none ()), some)
       fun destroy () =
-	 (List.foreach (!plists, remove)
-	  ; plists := [])
+         (List.foreach (!plists, remove)
+          ; plists := [])
    in {destroy = destroy, get = get, set = set}
    end
 
 fun setToSetOnce set (s, v) =
-   set (s, fn _ => v, fn _ => Error.bug "setOnce: set used twice")
+   set (s, fn _ => v, fn _ => Error.bug "Property.setOnce: set used twice")
 
 fun destGetSetOnce z =
    let val {destroy, get, set} = destructable z
    in {destroy = destroy, get = get, set = setToSetOnce set}
    end
-			   
+                           
 fun destGet z =
    let val {destroy, get, ...} = destGetSetOnce z
    in {destroy = destroy, get = get}

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/property.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/property.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/property.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature PROPERTY =
    sig
       structure Plist: PROPERTY_LIST
@@ -14,54 +15,54 @@
       val initFun: ('sym -> 'val) -> ('sym, 'val) init
       val initRaise: string * ('sym -> Layout.t) -> ('sym, 'val) init
       val initRec: ('sym * ('sym -> 'val) -> 'val) -> ('sym, 'val) init
-	 
+         
       val destGet:
-	 ('sym -> Plist.t) * ('sym, 'val) init
-	 -> {
-	     destroy: unit -> unit,
-	     get: 'sym -> 'val
-	    }
+         ('sym -> Plist.t) * ('sym, 'val) init
+         -> {
+             destroy: unit -> unit,
+             get: 'sym -> 'val
+            }
 
       val destGetSet:
-	 ('sym -> Plist.t) * ('sym, 'val) init
-	 -> {
-	     destroy: unit -> unit,
-	     get: 'sym -> 'val,
-	     set: 'sym * 'val -> unit
-	    }
+         ('sym -> Plist.t) * ('sym, 'val) init
+         -> {
+             destroy: unit -> unit,
+             get: 'sym -> 'val,
+             set: 'sym * 'val -> unit
+            }
 
       val destGetSetOnce:
-	 ('sym -> Plist.t) * ('sym, 'val) init
-	 -> {
-	     get: 'sym -> 'val,
-	     set: 'sym * 'val -> unit,
-	     destroy: unit -> unit
-	    }
+         ('sym -> Plist.t) * ('sym, 'val) init
+         -> {
+             get: 'sym -> 'val,
+             set: 'sym * 'val -> unit,
+             destroy: unit -> unit
+            }
 
       (* For all of the rem functions, it is OK if the property isn't there. *)
 
       val get:
-	 ('sym -> Plist.t) * ('sym, 'val) init
-	 -> {
-	     get: 'sym -> 'val,
-	     rem: 'sym -> unit
-	     }
+         ('sym -> Plist.t) * ('sym, 'val) init
+         -> {
+             get: 'sym -> 'val,
+             rem: 'sym -> unit
+             }
 
       val getSet:
-	 ('sym -> Plist.t) * ('sym, 'val) init
-	 -> {
-	     get: 'sym -> 'val,
-	     rem: 'sym -> unit,
-	     set: 'sym * 'val -> unit
-	    }
+         ('sym -> Plist.t) * ('sym, 'val) init
+         -> {
+             get: 'sym -> 'val,
+             rem: 'sym -> unit,
+             set: 'sym * 'val -> unit
+            }
 
       (* Property can only be set or initialized once. *)
       val getSetOnce:
-	 ('sym -> Plist.t) * ('sym, 'val) init
-	 -> {
-	     get: 'sym -> 'val,
-	     rem: 'sym -> unit,
-	     set: 'sym * 'val -> unit
-	    }
+         ('sym -> Plist.t) * ('sym, 'val) init
+         -> {
+             get: 'sym -> 'val,
+             rem: 'sym -> unit,
+             set: 'sym * 'val -> unit
+            }
 
    end

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/ps.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/ps.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/ps.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,19 +1,20 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature PS =
    sig
       structure State =
-	 struct
-	    datatype t =
-	       Running | Sleeping
-	 end
+         struct
+            datatype t =
+               Running | Sleeping
+         end
 
       val ps: unit -> {pid: Pid.t,
-		       commandName: string,
-		       args: string list,
-		       state: State.t} list
+                       commandName: string,
+                       args: string list,
+                       state: State.t} list
    end

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/ps.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/ps.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/ps.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 structure Ps: PS =
 struct
 

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/queue.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/queue.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/queue.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature QUEUE =
    sig
       type 'a t

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/quick-sort.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/quick-sort.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/quick-sort.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature QUICK_SORT =
    sig
       (* The comparison function ('a * 'a -> bool) for should be the <= funtion,
@@ -11,7 +12,7 @@
        * This is necessary to handle duplicate elements.
        *)
       (* sortArray mutates the array it is passed and returns the same array *)
-      val sortArray: 'a array * ('a * 'a -> bool) -> 'a array
+      val sortArray: 'a array * ('a * 'a -> bool) -> unit
       val sortList: 'a list * ('a * 'a -> bool) -> 'a list
       val sortVector: 'a vector * ('a * 'a -> bool) -> 'a vector
    end

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/quick-sort.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/quick-sort.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/quick-sort.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 structure QuickSort: QUICK_SORT =
 struct
 
@@ -20,81 +21,88 @@
  * Then, it does an insertion sort over the whole array to fix up the unsorted
  * segments.
  *)
-fun 'a sortArray (a: 'a array, op <= : 'a * 'a -> bool): 'a array =
+fun 'a sortArray (a: 'a array, op <= : 'a * 'a -> bool): unit =
    if 0 = Array.length a
-      then a
+      then ()
    else
       let
-	 fun x i = sub (a, i)
-	 fun swap (i, j) =
-	    let
-	       val t = x i
-	       val () = update (a, i, x j)
-	       val () = update (a, j, t)
-	    in
-	       ()
-	    end
-	 val cutoff = 20
-	 fun qsort (l: int, u: int): unit =
-	    if Int.<= (u - l, cutoff)
-	       then ()
-	    else
-	       let
-		  val _ = swap (l, randInt (l, u))
-		  val t = x l
-		  (* Partition based on page 115. *)
-		  fun loop (i, j) =
-		     let
-			fun loopUp i =
-			   let
-			      val i = i + 1
-			   in
-			      (* The sentinel guarantees that x i is OK. *)
-			      if t <= x i
-				 then i
-			      else loopUp i
-			   end
-			val i = loopUp i
-			fun loopDown j =
-			   let
-			      val j = j - 1
-			   in
-			      if x j <= t
-				 then j
-			      else loopDown j
-			   end
-			val j = loopDown j
-		     in
-			if j < i
-			   then (i, j)
-			else (swap (i, j); loop (i, j))
-		     end
-		  val (i, j) = loop (l, u + 1)
-		  val () = swap (l, j)
-		  val () = qsort (l, j - 1)
-		  val () = qsort (i, u)
-	       in
-		  ()
-	       end
-	 (* Put a maximal element at the end to use as a sentinel. *)
-	 val (m, _) =
-	    Array.foldi
-	    (a, (0, Array.sub (a, 0)), fn (i, xi, (m, xm)) =>
-	     if xi <= xm
-		then (m, xm)
-	     else (i, xi))
-	 val last = length a - 1
-	 val () = swap (m, last)
-	 val _ = qsort (0, last - 1)
-	 val _ = InsertionSort.sort (a, op <=)
+         fun x i = sub (a, i)
+         fun swap (i, j) =
+            let
+               val t = x i
+               val () = update (a, i, x j)
+               val () = update (a, j, t)
+            in
+               ()
+            end
+         val cutoff = 20
+         fun qsort (l: int, u: int): unit =
+            if Int.<= (u - l, cutoff)
+               then ()
+            else
+               let
+                  val () = swap (l, randInt (l, u))
+                  val t = x l
+                  (* Partition based on page 115. *)
+                  fun loop (i, j) =
+                     let
+                        fun loopUp i =
+                           let
+                              val i = i + 1
+                           in
+                              (* The sentinel guarantees that x i is OK. *)
+                              if t <= x i
+                                 then i
+                              else loopUp i
+                           end
+                        val i = loopUp i
+                        fun loopDown j =
+                           let
+                              val j = j - 1
+                           in
+                              if x j <= t
+                                 then j
+                              else loopDown j
+                           end
+                        val j = loopDown j
+                     in
+                        if j < i
+                           then (i, j)
+                        else (swap (i, j); loop (i, j))
+                     end
+                  val (i, j) = loop (l, u + 1)
+                  val () = swap (l, j)
+                  val () = qsort (l, j - 1)
+                  val () = qsort (i, u)
+               in
+                  ()
+               end
+         (* Put a maximal element at the end to use as a sentinel. *)
+         val (m, _) =
+            Array.foldi
+            (a, (0, Array.sub (a, 0)), fn (i, xi, (m, xm)) =>
+             if xi <= xm
+                then (m, xm)
+             else (i, xi))
+         val last = length a - 1
+         val () = swap (m, last)
+         val () = qsort (0, last - 1)
+         val () = InsertionSort.sort (a, op <=)
       in
-	 a
+         ()
       end
 
-fun sortList (l, f) =
-   Array.toList (sortArray (Array.fromList l, f))
-
-fun sortVector (v, f) =
-   Array.toVector (sortArray (Array.fromVector v, f))
+local
+   fun make (from, to) (l, f) =
+      let
+         val a = from l
+         val () = sortArray (a, f)
+      in
+         to a
+      end
+in
+   val sortList = fn z => make (Array.fromList, Array.toList) z
+   val sortVector = fn z => make (Array.fromVector, Array.toVector) z
+end
    
 end

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/random.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/random.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/random.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,8 +1,8 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 type int = Int.t

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/random.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/random.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/random.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,8 +1,8 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 structure Random: RANDOM =
@@ -27,13 +27,13 @@
 in
    fun bool () =
       let
-	 val i = !ri
-	 val b = 0w1 = Word.andb (0wx1, Word.>> (!rw, Word.fromInt i))
-	 val _ =
-	    if i = max
-	       then (rw := word ()
-		     ; ri := 0)
-	    else ri := 1 + i
+         val i = !ri
+         val b = 0w1 = Word.andb (0wx1, Word.>> (!rw, Word.fromInt i))
+         val _ =
+            if i = max
+               then (rw := word ()
+                     ; ri := 0)
+            else ri := 1 + i
       in b
       end
 end
@@ -66,20 +66,20 @@
 in
    fun wordLessThan (w: word): word =
       if w = 0w0
-	 then Error.bug "Random.word"
+         then Error.bug "Random.wordLessThan"
       else
-	 let
-	    val () =
-	       if w - 0w1 <= !max
-		  then ()
-	       else (r := MLton.Random.rand ()
-		     ; max := 0wxFFFFFFFF)
-	    val w' = !r
-	    val () = r := Word.div (w', w)
-	    val () = max := Word.div (!max, w)
-	 in
-	    Word.mod (w', w)
-	 end
+         let
+            val () =
+               if w - 0w1 <= !max
+                  then ()
+               else (r := MLton.Random.rand ()
+                     ; max := 0wxFFFFFFFF)
+            val w' = !r
+            val () = r := Word.div (w', w)
+            val () = max := Word.div (!max, w)
+         in
+            Word.mod (w', w)
+         end
 end
 
 fun natLessThan (n: int): int =
@@ -93,15 +93,15 @@
 fun nRandom {list, length, n} =
    let
       fun loop (need: int, length: int, xs: 'a list, ac: 'a list): 'a list =
-	 (Assert.assert ("Random.nRandom", fn () => need <= length)
-	  ; if need <= 0
-	       then ac
-	    else (case xs of
-		     [] => Error.bug "nRandom"
-		   | x :: xs =>
-			if natLessThan length < need
-			   then loop (need - 1, length - 1, xs, x :: ac)
-			else loop (need, length - 1, xs, ac)))
+         (Assert.assert ("Random.nRandom", fn () => need <= length)
+          ; if need <= 0
+               then ac
+            else (case xs of
+                     [] => Error.bug "nRandom"
+                   | x :: xs =>
+                        if natLessThan length < need
+                           then loop (need - 1, length - 1, xs, x :: ac)
+                        else loop (need, length - 1, xs, ac)))
    in loop (n, length, list, [])
    end
 
@@ -109,9 +109,9 @@
    Assert.assertFun
    ("nRandom", nRandom,
     fn {list, length, n} => (length = List.length list
-			     andalso 0 <= n
-			     andalso n <= length,
-			     fn l => n = List.length l))
+                             andalso 0 <= n
+                             andalso n <= length,
+                             fn l => n = List.length l))
    x
 
 fun list l =
@@ -119,7 +119,7 @@
       val n = List.length l
    in
       if n = 0
-	 then NONE
+         then NONE
       else SOME (List.nth (l, natLessThan n))
    end
 

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/rational.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/rational.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/rational.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,8 +1,8 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 (*-------------------------------------------------------------------*)
 (*                             Rational                              *)
@@ -15,65 +15,65 @@
    struct
       structure I = I
       open I
-	 
+         
       datatype t = T of I.t * I.t
       (* always use smallest nonnegative denominator *)
-	 
+         
       fun numerator(T(n,_)) = n
       fun denominator(T(_,n)) = n
-	 
+         
       fun fromInt n = T(n,I.one)
-	 
+         
       (*fun intTo = ITo o I.intTo*)
       (*val toInt = I.toInt o toI*)
-	 
+         
       fun isInt q = denominator q = one
-	 
+         
       exception ToInt
       fun toInt q = if isInt q then numerator q
-		    else raise ToInt
-		       
+                    else raise ToInt
+                       
       fun toReal(T(p,q)) = I.toReal p / I.toReal q
-	 
+         
       val zero = fromInt I.zero
       val one = fromInt I.one
-	 
+         
       fun scale(T(p,q),T(p',q')) =
-	 let val l = I.lcm(q,q')
-	 in (p * (l div q'),
-	     p' * (l div q),
-	     l)
-	 end
+         let val l = I.lcm(q,q')
+         in (p * (l div q'),
+             p' * (l div q),
+             l)
+         end
       
       val (op +) = fn (x,y) =>
-	 let val (p,p',l) = scale(x,y)
-	 in T(p + p',l)
-	 end
+         let val (p,p',l) = scale(x,y)
+         in T(p + p',l)
+         end
       
       fun inverse(T(p,q)) = if I.isNegative p then T(I.~ q,I.~ p)
-			    else T(q,p)
-	    
+                            else T(q,p)
+            
       val (op ~) = fn T(m,n) => T(~m,n)
-	 
+         
       fun reduce(p,q) =
-	 let val g = I.gcd(p,q)
-	 in (p div g, q div g)
-	 end
+         let val g = I.gcd(p,q)
+         in (p div g, q div g)
+         end
       
       fun make(p,q) = T(reduce(p,q))
-	 
+         
       fun intIntTo(m,n) = make(I.fromInt m,I.fromInt n)
-	 
+         
       fun (T(p,q)) * (T(p',q')) =
-	 let val (p,q') = reduce(p,q')
-	    val (p',q) = reduce(p',q)
-	 in T(I.*(p,p'),I.*(q,q'))
-	 end
+         let val (p,q') = reduce(p,q')
+            val (p',q) = reduce(p',q)
+         in T(I.*(p,p'),I.*(q,q'))
+         end
       
       fun compare(x,y) =
-	 let val (p,q,_) = scale(x,y)
-	 in I.compare(p,q)
-	 end
+         let val (p,q,_) = scale(x,y)
+         in I.compare(p,q)
+         end
 
       val {<,<=,>,>=,equal,min,max} = Relation.compare compare
       val op = = equal
@@ -91,12 +91,12 @@
        *)
       exception Input
       fun input _ = raise Input
-	 
+         
       fun output(p,out) =
-	 if isInt p then I.output(toInt p,out)
-	 else (I.output(numerator p,out) ;
-	       Out.output(out,"/") ;
-	       I.output(denominator p,out))
+         if isInt p then I.output(toInt p,out)
+         else (I.output(numerator p,out) ;
+               Out.output(out,"/") ;
+               I.output(denominator p,out))
    end
 
 structure R = OrderedField(F)

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/rational.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/rational.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/rational.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature RATIONAL =
    sig
       include ORDERED_FIELD
@@ -18,10 +19,10 @@
       val toInt : t -> I.t
       val numerator : t -> I.t
       val denominator : t -> I.t
-	 
+         
 (*      val toInt : t -> int
       val intTo : int -> t
       val intIntTo : int * int -> t
-	 *)
+         *)
       val toReal : t -> real
    end

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/rdb.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/rdb.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/rdb.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,40 +1,41 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 type int = Int.t
    
 (* Relational Data Base *)
 signature RDB =
    sig
       structure Value:
-	 sig
-	    type t
+         sig
+            type t
 
-	    val bool: bool -> t
-	    val compare: t * t -> Relation.t
-	    val int: int -> t
-	    val real: real -> t
-	    val string: string -> t
-	    val toString: t -> string
-	 end
+            val bool: bool -> t
+            val compare: t * t -> Relation.t
+            val int: int -> t
+            val real: real -> t
+            val string: string -> t
+            val toString: t -> string
+         end
       structure Domain:
-	 sig
-	    type t
+         sig
+            type t
 
-	    val bool: t
-	    val int: t
-	    val real: t
-	    val string: t
-	 end
+            val bool: t
+            val int: t
+            val real: t
+            val string: t
+         end
       structure Attribute:
-	 sig
-	    type t
+         sig
+            type t
 
-	    val new: string -> t
-	 end
+            val new: string -> t
+         end
 
       type t
 
@@ -43,12 +44,12 @@
       val degree: t -> int
       val new: {heading: (Attribute.t * Domain.t) list} -> t
       val printTable: {rdb: t,
-		       row: Attribute.t,
-		       col: Attribute.t,
-		       entry: Attribute.t,
-		       out: Out.t} -> unit
+                       row: Attribute.t,
+                       col: Attribute.t,
+                       entry: Attribute.t,
+                       out: Out.t} -> unit
       val printTable': {rdb: t,
-			cols: Attribute.t list,
-			sortBy: Attribute.t,
-			out: Out.t} -> unit
+                        cols: Attribute.t list,
+                        sortBy: Attribute.t,
+                        out: Out.t} -> unit
    end

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/rdb.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/rdb.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/rdb.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 structure RDB: RDB =
 struct
 
@@ -15,15 +16,15 @@
 structure Domain =
    struct
       datatype t = T of {compare : Rep.t * Rep.t -> Relation.t,
-			 contains: Rep.t -> bool,
-			 just: Justify.t,
-			 toString: Rep.t -> string}
+                         contains: Rep.t -> bool,
+                         just: Justify.t,
+                         toString: Rep.t -> string}
    end
 
 structure Value =
    struct
       datatype t = T of {domain: Domain.t,
-			 rep: Rep.t}
+                         rep: Rep.t}
    end
       
 structure Domain =
@@ -31,42 +32,43 @@
       open Domain
 
       fun contains (T {contains, ...}, Value.T {rep = r, ...}) = contains r
-	 
+         
       fun new {compare: 'a * 'a -> Relation.t,
-	       just: Justify.t,
-	       toString: 'a -> string}: t * ('a -> Value.t) =
-	 let
-	    exception E of 'a
-	    val contains = fn E _ => true | _ => false
-	    val toString = fn E x => toString x | _ => Error.bug "toString"
-	    val compare =
-	       fn (E x, E y) => compare (x, y)
-		| _ => Error.bug "Value.<="
-	    val d = T {compare = compare,
-		      contains = contains,
-		      just = just,
-		      toString = toString}
-	    fun make (a: 'a): Value.t = Value.T {domain = d, rep = E a}
-	 in (d, make)
-	 end
+               just: Justify.t,
+               toString: 'a -> string}: t * ('a -> Value.t) =
+         let
+            exception E of 'a
+            val contains = fn E _ => true | _ => false
+            val toString = fn E x => toString x 
+                            | _ => Error.bug "RDB.Domain.new.toString"
+            val compare =
+               fn (E x, E y) => compare (x, y)
+                | _ => Error.bug "RDB.Domain.new.compare"
+            val d = T {compare = compare,
+                      contains = contains,
+                      just = just,
+                      toString = toString}
+            fun make (a: 'a): Value.t = Value.T {domain = d, rep = E a}
+         in (d, make)
+         end
 
       val (bool, boolV) = new {compare = Bool.compare,
-			       just = Justify.Left,
-			       toString = Bool.toString}
+                               just = Justify.Left,
+                               toString = Bool.toString}
 
       val (int, intV) = new {compare =  Int.compare,
-			     just = Justify.Right,
-			     toString = Int.toString}
+                             just = Justify.Right,
+                             toString = Int.toString}
 
       val (real, realV) = new {compare = Real.compare,
-			       just = Justify.Right,
-			       toString =
-			       fn r => Real.format (r, Real.Format.fix (SOME 1))}
-(*			       Real.toString *)
+                               just = Justify.Right,
+                               toString =
+                               fn r => Real.format (r, Real.Format.fix (SOME 1))}
+(*                             Real.toString *)
 
       val (string, stringV) = new {compare = String.compare,
-				   just = Justify.Left,
-				   toString = String.toString}
+                                   just = Justify.Left,
+                                   toString = String.toString}
    end
 
 structure Value =
@@ -75,25 +77,25 @@
 
       local open Domain
       in
-	 val bool = boolV
-	 val int = intV
-	 val real = realV
-	 val string = stringV
+         val bool = boolV
+         val int = intV
+         val real = realV
+         val string = stringV
       end
 
       local
-	 fun unary f (T {domain = Domain.T d, rep = r, ...}) = f d r
+         fun unary f (T {domain = Domain.T d, rep = r, ...}) = f d r
       in
-	 val toString = unary #toString
+         val toString = unary #toString
       end
 
       fun justification (T {domain = Domain.T {just, ...}, ...}) = just
    
       local
-	 fun binary f (T {domain = Domain.T d, rep = r, ...}, T {rep = r', ...}) =
-	    f d (r, r')
+         fun binary f (T {domain = Domain.T d, rep = r, ...}, T {rep = r', ...}) =
+            f d (r, r')
       in
-	 val compare = binary #compare
+         val compare = binary #compare
       end
 
       val {<, <=, equals, >=, >, ...} = Relation.compare compare
@@ -109,42 +111,42 @@
 structure Heading =
    struct
       datatype t = T of (Attribute.t * Domain.t) list
-	 
+         
       fun degree (T l) = List.length l
 
       fun info (T l, a) =
-	 case List.peeki (l, fn (_, (a', _)) => Attribute.equals (a, a')) of
-	    NONE => Error.bug "info"
-	  | SOME (i, (_, d)) => (i, d)
+         case List.peeki (l, fn (_, (a', _)) => Attribute.equals (a, a')) of
+            NONE => Error.bug "RDB.Heading.info"
+          | SOME (i, (_, d)) => (i, d)
 
       val position = #1 o info
    end
 
 datatype t = T of {heading: Heading.t,
-		   body: Value.t list list ref}
+                   body: Value.t list list ref}
    
 fun add (T {heading = Heading.T attrs, body, ...}, r) =
    List.push
    (body,
     List.fold (rev attrs, [], fn ((a, d), ac) =>
-	      case List.peek (r, fn (a', _) => Attribute.equals (a, a')) of
-		 NONE => Error.bug "addRecord"
-	       | SOME (_, v) =>
-		    if Domain.contains (d, v)
-		       then v :: ac
-		    else Error.bug "addRecord"))
+              case List.peek (r, fn (a', _) => Attribute.equals (a, a')) of
+                 NONE => Error.bug "RDB.add"
+               | SOME (_, v) =>
+                    if Domain.contains (d, v)
+                       then v :: ac
+                    else Error.bug "RDB.add"))
    
 fun cardinality (T {body, ...}) = List.length (!body)
 
 fun degree (T {heading, ...}) = Heading.degree heading
    
 fun new {heading} = T {heading = Heading.T heading,
-		     body = ref []}
+                     body = ref []}
 
 fun project (T {heading, body, ...}, a: Attribute.t): Value.t list =
    let val n = Heading.position (heading, a)
    in List.fold (!body, [], fn (vs, ac) =>
-		List.insert (vs, List.nth (vs, n), Value.<=))
+                List.insert (vs, List.nth (vs, n), Value.<=))
    end
 
 fun outputTable (t, out) =
@@ -152,13 +154,13 @@
       val print = Out.outputc out
    in
       List.foreach (t, fn ss =>
-		   (case ss of
-		       [] => ()
-		     | s :: ss =>
-			  (print s
-			   ; List.foreach (ss, fn s =>
-					  (print " "; print s)))
-			  ; print "\n"))
+                   (case ss of
+                       [] => ()
+                     | s :: ss =>
+                          (print s
+                           ; List.foreach (ss, fn s =>
+                                          (print " "; print s)))
+                          ; print "\n"))
    end
 
 fun printTable {rdb as T {body, heading, ...}, row, col, entry, out}: unit =
@@ -171,58 +173,58 @@
       val nc = Heading.position (heading, col)
       val ne = Heading.position (heading, entry)
       val table =
-	 ("" :: List.map (cols, Value.toString)) ::
-	 let
-	    val cols = rev cols
-	 in List.fold
-	    (rev rows, [], fn (r, ac) =>
-	     let
-		val row =
-		   List.fold
-		   (cols, [], fn (c, ac) =>
-		    let
-		       val e =
-			  case (List.peek
-				(body, fn t =>
-				 Value.equals (r, List.nth (t, nr))
-				 andalso Value.equals (c, List.nth (t, nc))))
-			     of
-				NONE => default
-			      | SOME t => Value.toString (List.nth (t, ne))
-		    in e :: ac
-		    end)
-	     in (Value.toString r :: row) :: ac
-	     end)
-	 end
+         ("" :: List.map (cols, Value.toString)) ::
+         let
+            val cols = rev cols
+         in List.fold
+            (rev rows, [], fn (r, ac) =>
+             let
+                val row =
+                   List.fold
+                   (cols, [], fn (c, ac) =>
+                    let
+                       val e =
+                          case (List.peek
+                                (body, fn t =>
+                                 Value.equals (r, List.nth (t, nr))
+                                 andalso Value.equals (c, List.nth (t, nc))))
+                             of
+                                NONE => default
+                              | SOME t => Value.toString (List.nth (t, ne))
+                    in e :: ac
+                    end)
+             in (Value.toString r :: row) :: ac
+             end)
+         end
       val justs =
-	 (Value.justification (hd rows)
-	  :: List.map (cols, Value.justification))
+         (Value.justification (hd rows)
+          :: List.map (cols, Value.justification))
       val t = Justify.table {columnHeads = NONE, justs = justs, rows = table}
    in outputTable (t, out)
    end
 
 fun printTable' {rdb as T {body, heading = Heading.T ads, ...},
-		cols, sortBy, out}: unit =
+                cols, sortBy, out}: unit =
    let
       val is = List.revMap (cols, fn a =>
-			   valOf (List.index (ads, fn (a', _) =>
-					    Attribute.equals (a, a'))))
+                           valOf (List.index (ads, fn (a', _) =>
+                                            Attribute.equals (a, a'))))
       val rows =
-	 List.revMap (!body, fn r =>
-		     let val a = Array.fromList r
-		     in List.revMap (is, fn i => Array.sub (a, i))
-		     end)
+         List.revMap (!body, fn r =>
+                     let val a = Array.fromList r
+                     in List.revMap (is, fn i => Array.sub (a, i))
+                     end)
       val justs = List.map (hd rows, Value.justification)
       val i = valOf (List.index (cols, fn a => Attribute.equals (a, sortBy)))
       val rows =
-	 QuickSort.sortList (rows, fn (r, r') =>
-			     Value.<= (List.nth (r, i), List.nth (r', i)))
+         QuickSort.sortList (rows, fn (r, r') =>
+                             Value.<= (List.nth (r, i), List.nth (r', i)))
       val rows =
-	 List.map (cols, Attribute.toString)
-	 :: List.map (rows, fn r => List.map (r, Value.toString))
+         List.map (cols, Attribute.toString)
+         :: List.map (rows, fn r => List.map (r, Value.toString))
       val t = Justify.table {columnHeads = NONE,
-			     justs = justs,
-			     rows = rows}
+                             justs = justs,
+                             rows = rows}
    in outputTable (t, out)
    end
 

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/reader.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/reader.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/reader.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature READER =
    sig
       type ('a, 's) t = 's -> ('a * 's) option
@@ -12,17 +13,17 @@
       val char: (char, 'a) t * char -> (unit, 'a) t
       val firstN: ('a, 's) t * Int.t -> ('a list, 's) t 
       val readFromString:
-	 ((char, Int.t) t -> ('a, Int.t) t) * string -> 'a option
+         ((char, Int.t) t -> ('a, Int.t) t) * string -> 'a option
       val map: ('a, 's) t * ('a -> 'b) -> ('b, 's) t
       val mapFail: ('a, 's) t * ('a -> 'b option) -> ('b, 's) t
       val or: ('a, 's) t list -> ('a, 's) t
       val seq2: ('a, 's) t * ('b, 's) t -> ('a * 'b, 's) t
       val seq3: ('a, 's) t * ('b, 's) t * ('c, 's) t -> ('a * 'b * 'c, 's) t
       val seq4:
-	 ('a, 's) t * ('b, 's) t * ('c, 's) t * ('d, 's) t
-	 -> ('a * 'b * 'c * 'd, 's) t
+         ('a, 's) t * ('b, 's) t * ('c, 's) t * ('d, 's) t
+         -> ('a * 'b * 'c * 'd, 's) t
       val seq5:
-	 ('a, 's) t * ('b, 's) t * ('c, 's) t * ('d, 's)t * ('e,'s) t
-	 -> ('a * 'b * 'c * 'd * 'e, 's) t
+         ('a, 's) t * ('b, 's) t * ('c, 's) t * ('d, 's)t * ('e,'s) t
+         -> ('a * 'b * 'c * 'd * 'e, 's) t
       val stringOfLength: (char, 'a) t * Int.t -> (string, 'a) t
    end

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/reader.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/reader.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/reader.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 structure Reader: READER =
 struct
 
@@ -17,31 +18,31 @@
 fun or rs s =
    let
       val rec loop =
-	 fn [] => NONE
-	  | r :: rs =>
-	       case r s of
-		  NONE => loop rs
-		| z => z
+         fn [] => NONE
+          | r :: rs =>
+               case r s of
+                  NONE => loop rs
+                | z => z
    in loop rs
    end
 
 fun all r s =
    let
       fun loop(s, ac) =
-	 case r s of
-	    NONE => SOME(rev ac, s)
-	  | SOME(x, s) => loop(s, x :: ac)
+         case r s of
+            NONE => SOME(rev ac, s)
+          | SOME(x, s) => loop(s, x :: ac)
    in loop(s, [])
    end
    
 fun firstN(r, n: Int.t) s =
    let
       fun loop(n, s, ac) =
-	 if n <= 0
-	    then SOME(rev ac, s)
-	 else (case r s of
-		  NONE => NONE
-		| SOME(x, s) => loop(n - 1, s, x :: ac))
+         if n <= 0
+            then SOME(rev ac, s)
+         else (case r s of
+                  NONE => NONE
+                | SOME(x, s) => loop(n - 1, s, x :: ac))
    in loop(n, s, [])
    end
    
@@ -56,65 +57,65 @@
    case r1 s of
       NONE => NONE
     | SOME(x1, s) =>
-	 case r2 s of
-	    NONE => NONE
-	  | SOME(x2, s) => SOME((x1, x2), s)
+         case r2 s of
+            NONE => NONE
+          | SOME(x2, s) => SOME((x1, x2), s)
 
 
 fun seq3(r1, r2, r3) s =
    case r1 s of
       NONE => NONE
     | SOME(x1, s) =>
-	 case r2 s of
-	    NONE => NONE
-	  | SOME(x2, s) =>
-	       case r3 s of
-		  NONE => NONE
-		| SOME(x3, s) => SOME((x1, x2, x3), s)
+         case r2 s of
+            NONE => NONE
+          | SOME(x2, s) =>
+               case r3 s of
+                  NONE => NONE
+                | SOME(x3, s) => SOME((x1, x2, x3), s)
 
 fun seq4(r1, r2, r3, r4) s =
    case seq3(r1, r2, r3) s of
       NONE => NONE
     | SOME((x1, x2, x3), s) =>
-	 case r4 s of
-	    NONE => NONE
-	  | SOME(x4, s) => SOME((x1, x2, x3, x4), s)
+         case r4 s of
+            NONE => NONE
+          | SOME(x4, s) => SOME((x1, x2, x3, x4), s)
 
 fun seq5(r1, r2, r3, r4, r5) s =
    case seq4(r1, r2, r3, r4) s of
       NONE => NONE
     | SOME((x1, x2, x3, x4), s) =>
-	 case r5 s of
-	    NONE => NONE
-	  | SOME(x5, s) => SOME((x1, x2, x3, x4, x5), s)
+         case r5 s of
+            NONE => NONE
+          | SOME(x5, s) => SOME((x1, x2, x3, x4, x5), s)
 
 fun stringOfLength(r, i: Int.t) s =
    let
       fun loop(i, s, cs) =
-	 if i <= 0
-	    then SOME(implode(rev cs), s)
-	 else (case r s of
-		  NONE => NONE
-		| SOME(c, s) => loop(i - 1, s, c :: cs))
+         if i <= 0
+            then SOME(implode(rev cs), s)
+         else (case r s of
+                  NONE => NONE
+                | SOME(c, s) => loop(i - 1, s, c :: cs))
    in loop(i, s, [])
    end
 
-val info = Trace.info "readFromString"
+val info = Trace.info "Reader.readFromString"
 
 fun readFromString(rm, s) =
    let val n: Int.t = String.size s
       fun reader(i: Int.t) =
-	 if i < n
-	    then SOME(String.sub(s, i), i + 1)
-	 else NONE
+         if i < n
+            then SOME(String.sub(s, i), i + 1)
+         else NONE
       val reader =
-	 Trace.traceInfo
-	 (info,
-	  Int.layout,
-	  fn NONE => Layout.str "NONE"
-	   | SOME(c, _) => Char.layout c,
+         Trace.traceInfo
+         (info,
+          Int.layout,
+          fn NONE => Layout.str "NONE"
+           | SOME(c, _) => Char.layout c,
           fn _ => (true, fn _ => true))
-	  reader
+          reader
    in case rm reader (0: Int.t) of
       NONE => NONE
     | SOME(a, i) => if i = n then SOME a else NONE

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/real.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/real.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/real.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,22 +1,23 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 type int = Int.t
    
 signature REAL =
    sig
       structure Format:
-	 sig
-	    type t
+         sig
+            type t
 
-	    val exact: t
-	    val fix: int option -> t
-	    val gen: int option -> t
-	    val sci: int option -> t
-	 end
+            val exact: t
+            val fix: int option -> t
+            val gen: int option -> t
+            val sci: int option -> t
+         end
 
       type t
       exception Input
@@ -36,6 +37,16 @@
       val atan: t -> t
       val ceiling: t -> int
       val choose: t * t -> t
+      structure Class:
+         sig
+             datatype t =
+                INF
+              | NAN
+              | NORMAL
+              | SUBNORMAL
+              | ZERO
+         end
+      val class: t -> Class.t
       val compare: t * t -> Relation.t
       val cos: t -> t
       val dec: t ref -> unit
@@ -62,8 +73,13 @@
       val pi: t
       val pow: t * t -> t
       val prod: t list -> t
+      val realCeil: t -> t
+      val realFloor: t -> t
       val realMod: t -> t
       val realPower: t * t -> t
+      val realRound: t -> t
+      val realTrunc: t -> t
+      val rem: t * t -> t
       val round: t -> int
       val signBit: t -> bool
       val sin: t -> t

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/real.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/real.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/real.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,15 +1,15 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 functor Real (Real: sig
-		       include PERVASIVE_REAL
-		       val one: real
-		       val zero: real
-		    end): REAL =
+                       include PERVASIVE_REAL
+                       val one: real
+                       val zero: real
+                    end): REAL =
 struct
 
 type real = Real.real
@@ -18,18 +18,18 @@
 
 structure R = 
    OrderedRing (structure R = 
-		   RingWithIdentity (structure R =
-					Ring (type t = real
-					      open Real
-					      val layout = Layout.str o toString
-					      val equals = Real.==)
-				     open R Real)
-		open R Real
-		val {compare, ...} =
-		   Relation.lessEqual {< = op <, equals = equals})
+                   RingWithIdentity (structure R =
+                                        Ring (type t = real
+                                              open Real
+                                              val layout = Layout.str o toString
+                                              val equals = Real.==)
+                                     open R Real)
+                open R Real
+                val {compare, ...} =
+                   Relation.lessEqual {< = op <, equals = equals})
 
 structure F = OrderedField (open R Real
-			    fun inverse x = one / x)
+                            fun inverse x = one / x)
 open F Real
 open Math
 
@@ -65,8 +65,8 @@
       val k = max (k, n - k)
    in
       prodFromTo {from = add1 k,
-		  term = fn i => i,
-		  to = n}
+                  term = fn i => i,
+                  to = n}
       / factorial (n - k)
    end
 
@@ -80,13 +80,18 @@
 
 val ceiling = ceil
 
+structure Class =
+   struct
+      datatype t = datatype IEEEReal.float_class
+   end
+
 end
 
 structure Real64 = Real (open Real64
-			 val one: real = 1.0
-			 val zero: real = 0.0)
+                         val one: real = 1.0
+                         val zero: real = 0.0)
 structure Real = Real64
 structure Real32 = Real (open Real32
-			 val one: real = 1.0
-			 val zero: real = 0.0)
-			    
+                         val one: real = 1.0
+                         val zero: real = 0.0)
+                            

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/ref.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/ref.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/ref.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature REF =
    sig
       type 'a t
@@ -15,11 +16,11 @@
       val fluidLet: 'a t * 'a * (unit -> 'b) -> 'b
       val getAndSet: ('a -> 'b ref) -> ('a -> 'b) * ('a * 'b -> unit)
       val getSet: ('a -> Layout.t) -> {get: unit -> 'a,
-					set: 'a -> unit,
-					clear: unit -> unit,
-					layout: unit -> Layout.t,
-					output: Out.t -> unit,
-					print: unit -> unit}
+                                        set: 'a -> unit,
+                                        clear: unit -> unit,
+                                        layout: unit -> Layout.t,
+                                        output: Out.t -> unit,
+                                        print: unit -> unit}
       val layout: ('a -> Layout.t) -> 'a t -> Layout.t
       val memoize: 'a option t * (unit -> 'a) -> 'a
       val swap: 'a t * 'a t -> unit

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/ref.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/ref.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/ref.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 structure Ref: REF =
 struct
 
@@ -16,23 +17,25 @@
 fun equals (r: 'a t, r') = r = r'
    
 fun swap (r, r') = let val v = !r
-		  in r := !r'; r' := v
-		  end
+                  in r := !r'; r' := v
+                  end
 
 fun getAndSet sel = (! o sel, fn (x, v) => sel x := v)
 
 fun ('a, 'b) fluidLet (r: 'a t, x: 'a, th: unit -> 'b): 'b =
-   let val old = !r
-   in r := x
-      ; DynamicWind.wind (th, fn () => r := old)
+   let
+      val old = !r
+      val () = r := x
+   in
+      Exn.finally (th, fn () => r := old)
    end
 
 fun getSet layout = 
    let val r = ref NONE
       fun get () =
-	 case !r of
-	    NONE => Error.bug "not available"
-	  | SOME v => v
+         case !r of
+            NONE => Error.bug "Ref.getSet.get: not available"
+          | SOME v => v
       fun set v = r := SOME v
       fun clear () = r := NONE
       val layout = fn () => layout (get ())
@@ -51,12 +54,12 @@
 fun memoize (r: 'a option ref, f: unit -> 'a): 'a =
    case !r of
       NONE =>
-	 let
-	    val a = f ()
-	    val () = r := SOME a
-	 in
-	    a
-	 end
+         let
+            val a = f ()
+            val () = r := SOME a
+         in
+            a
+         end
     | SOME a => a
    
 end

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/regexp.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/regexp.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/regexp.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 type int = Int.t
    
 signature REGEXP_STRUCTS = 
@@ -15,60 +16,60 @@
       include REGEXP_STRUCTS
 
       structure Save:
-	 sig
-	    type t
+         sig
+            type t
 
-	    val new: unit -> t
-	 end
+            val new: unit -> t
+         end
 
       structure Match:
-	 sig
-	    type t
+         sig
+            type t
 
-	    val all: t -> Substring.t
-	    val startLength: t -> {start: int, length: int}
-	    val exists: t * Save.t -> bool
-	    val funs: t -> {exists: Save.t -> bool,
-			    lookup: Save.t -> Substring.t,
-			    peek: Save.t -> Substring.t option}
-	    val length: t -> int
-	    val lookup: t * Save.t -> Substring.t
-	    val lookupString: t * Save.t -> String.t
-	    val peek: t * Save.t -> Substring.t option
-	    val peekString: t * Save.t -> String.t option
-	    val stringFuns: t -> {exists: Save.t -> bool,
-				  lookup: Save.t -> String.t,
-				  peek: Save.t -> String.t option}
-	 end
+            val all: t -> Substring.t
+            val startLength: t -> {start: int, length: int}
+            val exists: t * Save.t -> bool
+            val funs: t -> {exists: Save.t -> bool,
+                            lookup: Save.t -> Substring.t,
+                            peek: Save.t -> Substring.t option}
+            val length: t -> int
+            val lookup: t * Save.t -> Substring.t
+            val lookupString: t * Save.t -> String.t
+            val peek: t * Save.t -> Substring.t option
+            val peekString: t * Save.t -> String.t option
+            val stringFuns: t -> {exists: Save.t -> bool,
+                                  lookup: Save.t -> String.t,
+                                  peek: Save.t -> String.t option}
+         end
 
       structure Compiled:
-	 sig
-	    type t
+         sig
+            type t
 
-	    (* Find the first substring of s starting at or after index i that
-	     * matches r.  Return the first character and the character just
-	     * past the end of the substring.
-	     *)
-	    val findShort: t * string * int -> Match.t option
-	    val findLong: t * string * int -> Match.t option
-	    val foreachMatchShort: t * string * (Match.t -> unit) -> unit
-	    val layout: t -> Layout.t
-	    val layoutDot: t -> Layout.t
-	    val layoutDotToFile: t * File.t -> unit
-	    (* match (r, s, i)
-	     * Return the (shortest or longest) substring of s starting at index
-	     * i that matches r. 
-	     * The substring is represented by the index of the character just
-	     * past its end.
-	     * Return NONE if there is NO match.
-	     * All of the saves in the match will be set.
-	     *)
-	    val matchAll: t * string -> Match.t option
-	    val matchLong: t * string * int -> Match.t option
-	    val matchShort: t * string * int -> Match.t option
-	    val matchesAll: t * string -> bool
-	    val matchesPrefix: t * string -> bool
-	 end
+            (* Find the first substring of s starting at or after index i that
+             * matches r.  Return the first character and the character just
+             * past the end of the substring.
+             *)
+            val findShort: t * string * int -> Match.t option
+            val findLong: t * string * int -> Match.t option
+            val foreachMatchShort: t * string * (Match.t -> unit) -> unit
+            val layout: t -> Layout.t
+            val layoutDot: t -> Layout.t
+            val layoutDotToFile: t * File.t -> unit
+            (* match (r, s, i)
+             * Return the (shortest or longest) substring of s starting at index
+             * i that matches r. 
+             * The substring is represented by the index of the character just
+             * past its end.
+             * Return NONE if there is NO match.
+             * All of the saves in the match will be set.
+             *)
+            val matchAll: t * string -> Match.t option
+            val matchLong: t * string * int -> Match.t option
+            val matchShort: t * string * int -> Match.t option
+            val matchesAll: t * string -> bool
+            val matchesPrefix: t * string -> bool
+         end
 
       type t
 
@@ -119,53 +120,53 @@
 
 val _ =
    Assert.assert
-   ("Regexp.save", fn () =>
+   ("TestRegexp.save", fn () =>
     let
        val s = Save.new ()
     in
        List.forall
        ([(save (seq [], s), "", ""),
-	 (save (star (oneOf "a"), s), "", ""),
-	 (seq [save (seq [], s), seq []], "", ""),
-	 (seq [oneOf "a", save (seq [], s)], "a", "")],
-	fn (r, s1, s2) =>
-	let
-	   val c = compile r
-	in
-	   case matchAll (c, s1) of
-	      NONE => false
-	    | SOME m => Match.lookupString (m, s) = s2
-	end)
+         (save (star (oneOf "a"), s), "", ""),
+         (seq [save (seq [], s), seq []], "", ""),
+         (seq [oneOf "a", save (seq [], s)], "a", "")],
+        fn (r, s1, s2) =>
+        let
+           val c = compile r
+        in
+           case matchAll (c, s1) of
+              NONE => false
+            | SOME m => Match.lookupString (m, s) = s2
+        end)
     end)
 
 val _ =
    Assert.assert
-   ("Regexp.doesMatchAll", fn () =>
+   ("TestRegexp.doesMatchAll", fn () =>
     List.forall ([(any, "a"),
-		  (anys, "abc")], 
-		 fn (r, s) => matchesAll (compile r, s)))
+                  (anys, "abc")], 
+                 fn (r, s) => matchesAll (compile r, s)))
 val tests =
    List.map ([
-	      ("\\a", "a"),
-	      ("^$", ""),
-	      ("abc", "abc"),
-	      (".", "a"),
-	      ("^foo$", "foo"),
-	      ("^...$", "foo"),
-	      ("^.*$", "foo"),
-	      ("^.*foo@bar\\.com$", "foo@bar.com"),
-	      ("(abc)","abc"),
-	      ("\\(abc\\)","(abc)"),
-	      ("(abc){2,4}$", "abcabc"),
-	      ("(abc){2,4}$", "abcabcabc"),
-	      ("(abc){2,4}$", "abcabcabcabc")
-	      ],
-	     fn (r, s) =>
-	     let
-		val opt = SOME (String.size s)
-	     in
-		(#1 (valOf (fromString r)), s, opt, opt)
-	     end)
+              ("\\a", "a"),
+              ("^$", ""),
+              ("abc", "abc"),
+              (".", "a"),
+              ("^foo$", "foo"),
+              ("^...$", "foo"),
+              ("^.*$", "foo"),
+              ("^.*foo@bar\\.com$", "foo@bar.com"),
+              ("(abc)","abc"),
+              ("\\(abc\\)","(abc)"),
+              ("(abc){2,4}$", "abcabc"),
+              ("(abc){2,4}$", "abcabcabc"),
+              ("(abc){2,4}$", "abcabcabcabc")
+              ],
+             fn (r, s) =>
+             let
+                val opt = SOME (String.size s)
+             in
+                (#1 (valOf (fromString r)), s, opt, opt)
+             end)
    @
    [
     (#1 (valOf (fromString "a")), "a", SOME 1, SOME 1),
@@ -189,7 +190,7 @@
     (seq [string "ab", null], "abc", SOME 2, SOME 2),
     (or [string "a", string "ab", string "abc"], "abc", SOME 1, SOME 3),
     (seq [or [string "ab", null],
-	 or [string "abcde", string "cd"]], "abcde",
+         or [string "abcde", string "cd"]], "abcde",
      SOME 4, SOME 5),
     (star (or [null, char #"a"]), "aaa", SOME 0, SOME 3),
     (star (string "ab"), "ababab", SOME 0, SOME 6),
@@ -198,52 +199,52 @@
     end,
     let val r = Save.new ()
     in (seq [string "a", save (string "bc", r), string "d"],
-	"abcd", SOME 4, SOME 4)
+        "abcd", SOME 4, SOME 4)
     end,
     let val s1 = Save.new ()
        val s2 = Save.new ()
     in (seq [save (string "a", s1),
-	    save (string "b", s2)],
-	"ab", SOME 2, SOME 2)
+            save (string "b", s2)],
+        "ab", SOME 2, SOME 2)
     end,
  let val s1 = Save.new ()
     val s2 = Save.new ()
  in (seq [save (string "a", s1),
-	  string "b",
-	  save (string "c", s2),
-	  string "d"],
+          string "b",
+          save (string "c", s2),
+          string "d"],
      "abcd",
      SOME 4, SOME 4)
  end,
 let val s1 = Save.new ()
 in (seq [string "a",
-	save (string "b", s1),
-	string "c"],
+        save (string "b", s1),
+        string "c"],
     "abc",
     SOME 3, SOME 3)
 end,
 let val s1 = Save.new ()
 in (seq [string "abc",
-	save (string "d", s1),
-	string "e"],
+        save (string "d", s1),
+        string "e"],
     "abcde",
     SOME 5, SOME 5)
 end,
 let val s1 = Save.new ()
    val s2 = Save.new ()
 in (seq [string "abc",
-	save (string "d", s1),
-	string "e",
-	save (string "f", s2)],
+        save (string "d", s1),
+        string "e",
+        save (string "f", s2)],
     "abcdef",
     SOME 6, SOME 6)
 end,
 let val s1 = Save.new ()
    val s2 = Save.new ()
 in (seq [string "abc",
-	save (string "d", s1),
-	string "e",
-	save (string "fgh", s2)],
+        save (string "d", s1),
+        string "e",
+        save (string "fgh", s2)],
     "abcdefgh",
     SOME 8, SOME 8)
 end
@@ -251,17 +252,17 @@
 
 val _ =
    Assert.assert
-   ("Regexp.match", fn () =>
+   ("Test.Regexp.match", fn () =>
     List.forall (tests,
-		 fn (r, s: string, i1, i2) =>
-		 let
-		    val r = compile r
-		    val _ = Compiled.layoutDotToFile (r, "/tmp/z.dot")
-		    fun doit m = Option.map (m (r, s, 0), Match.length)
-		 in
-		    i1 = doit matchShort
-		    andalso i2 = doit matchLong
-		 end))
+                 fn (r, s: string, i1, i2) =>
+                 let
+                    val r = compile r
+                    val _ = Compiled.layoutDotToFile (r, "/tmp/z.dot")
+                    fun doit m = Option.map (m (r, s, 0), Match.length)
+                 in
+                    i1 = doit matchShort
+                    andalso i2 = doit matchLong
+                 end))
 
 val tests =
    [(string "abc", "123abc", SOME (3: int, 6: int)),
@@ -276,10 +277,10 @@
     List.forall
     (tests, fn (r, s, opt) =>
      opt = (Option.map
-	    (findShort (compile r, s, 0), fn m =>
-	     let val (_, {start, length}) = Substring.base (Match.all m)
-	     in (start, start + length)
-	     end))))
+            (findShort (compile r, s, 0), fn m =>
+             let val (_, {start, length}) = Substring.base (Match.all m)
+             in (start, start + length)
+             end))))
 
 val _ =
    Assert.assert
@@ -287,12 +288,12 @@
     List.forall
     ([(SOME (2, 4), (string "cd", "abcdef", 0)),
       (SOME (2, 4), (seq [char #"c", star (isNotChar Char.isSpace)],
-		     "abcd fg", 0))],
+                     "abcd fg", 0))],
      fn (res, (r, s, i)) =>
      res =
      Option.map (findLong (compile r, s, i), fn m =>
-		 let val (_, {start, length}) = Substring.base (Match.all m)
-		 in (start, start + length)
-		 end)))
+                 let val (_, {start, length}) = Substring.base (Match.all m)
+                 in (start, start + length)
+                 end)))
    
 end

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/regexp.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/regexp.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/regexp.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 (* Many of the algorithms in this module are based on
  * Compilers: Principles, Techniques, and Tools by Aho, Sethi, and Ullman,
  * which I will refer to in comments as the Dragon Book.
@@ -13,8 +14,8 @@
 
    fun ++ (r: int ref): int =
       let
-	 val n = 1 + !r
-	 val _ = r := n
+         val n = 1 + !r
+         val _ = r := n
       in n
       end
 
@@ -22,146 +23,146 @@
 
    local
       val validCharsString =
-	 "\n\t@abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789 ()[]<>!?-&#;'/=\"$.\\"
-   in	 
+         "\n\t@abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789 ()[]<>!?-&#;'/=\"$.\\"
+   in    
       val validChars =
-	 Vector.tabulate (numChars, fn i =>
-			  String.contains (validCharsString, Char.fromInt i))
+         Vector.tabulate (numChars, fn i =>
+                          String.contains (validCharsString, Char.fromInt i))
 
       fun edgeLabel (cs: char list): string =
-	 let
-	    val chars = implode cs
-	    val n = String.size chars
-	    val numValidChars = String.size validCharsString
-	 in
-	    if n = numChars
-	       then "."
-	    else
-	       (if n >= Int.quot (numValidChars, 2)
-		   then (* Character complement. *)
-		      concat ["[^",
-			      String.alphabetize
-			      (String.keepAll
-			       (validCharsString, fn c =>
-				not (String.contains
-				     (chars, c)))),
-			      "]"]
-		else if (1 = String.size chars
-			 andalso not (String.contains
-				      (". ", String.sub (chars, 0))))
-			then chars
-		     else concat ["[", chars, "]"])
-	 end
+         let
+            val chars = implode cs
+            val n = String.size chars
+            val numValidChars = String.size validCharsString
+         in
+            if n = numChars
+               then "."
+            else
+               (if n >= Int.quot (numValidChars, 2)
+                   then (* Character complement. *)
+                      concat ["[^",
+                              String.alphabetize
+                              (String.keepAll
+                               (validCharsString, fn c =>
+                                not (String.contains
+                                     (chars, c)))),
+                              "]"]
+                else if (1 = String.size chars
+                         andalso not (String.contains
+                                      (". ", String.sub (chars, 0))))
+                        then chars
+                     else concat ["[", chars, "]"])
+         end
       val edgeLabel =
-	 Trace.trace ("edgeLabel", List.layout Char.layout, String.layout)
-	 edgeLabel
+         Trace.trace ("Regexp.edgeLabel", List.layout Char.layout, String.layout)
+         edgeLabel
    end
 
    structure Save =
       struct
-	 datatype t = T of {index: int ref}
+         datatype t = T of {index: int ref}
 
-	 fun layout (T {index, ...}) =
-	    let
-	       open Layout
-	    in
-	       seq [str "Save ", Int.layout (!index)]
-	    end
-	 
-	 fun new () = T {index = ref ~1}
-	    
-	 fun equals (T {index = i, ...}, T {index = i', ...}) = i = i'
+         fun layout (T {index, ...}) =
+            let
+               open Layout
+            in
+               seq [str "Save ", Int.layout (!index)]
+            end
+         
+         fun new () = T {index = ref ~1}
+            
+         fun equals (T {index = i, ...}, T {index = i', ...}) = i = i'
 
-	 fun assign (T {index, ...}, i) = index := i
+         fun assign (T {index, ...}, i) = index := i
 
-	 fun index (T {index, ...}) = !index
+         fun index (T {index, ...}) = !index
 
-	 val index = Trace.trace ("Save.index", layout, Int.layout) index
+         val index = Trace.trace ("Regexp.Save.index", layout, Int.layout) index
       end
    
    structure Regexp =
       struct
-	 datatype t =
-	    AnchorFinish
-	  | AnchorStart
-	  | CharSet of char -> bool
-	  | Or of t list
-	  | Seq of t list
-	  | Save of t * Save.t
-	  | Star of t
-	       
-	 fun layout (r: t): Layout.t =
-	    let
-	       open Layout
-	    in
-	       case r of
-		  AnchorFinish => str "AnchorFinish"
-		| AnchorStart => str "AnchorStart"
-		| CharSet f =>
-		     seq [str "[",
-			  str (edgeLabel (Int.foldDown
-					  (0, numChars, [], fn (i, ac) =>
-					   let
-					      val c = Char.fromInt i
-					   in
-					      if f c
-						 then c :: ac
-					      else ac
-					   end))),
-			  str "]"]
-		| Or rs => seq [str "Or ", List.layout layout rs]
-		| Seq rs => seq [str "Seq ", List.layout layout rs]
-		| Save (r, s) => seq [str "Save ",
-				      Layout.tuple [layout r, Save.layout s]]
-		| Star r => seq [str "Star ", layout r]
-	    end
+         datatype t =
+            AnchorFinish
+          | AnchorStart
+          | CharSet of char -> bool
+          | Or of t list
+          | Seq of t list
+          | Save of t * Save.t
+          | Star of t
+               
+         fun layout (r: t): Layout.t =
+            let
+               open Layout
+            in
+               case r of
+                  AnchorFinish => str "AnchorFinish"
+                | AnchorStart => str "AnchorStart"
+                | CharSet f =>
+                     seq [str "[",
+                          str (edgeLabel (Int.foldDown
+                                          (0, numChars, [], fn (i, ac) =>
+                                           let
+                                              val c = Char.fromInt i
+                                           in
+                                              if f c
+                                                 then c :: ac
+                                              else ac
+                                           end))),
+                          str "]"]
+                | Or rs => seq [str "Or ", List.layout layout rs]
+                | Seq rs => seq [str "Seq ", List.layout layout rs]
+                | Save (r, s) => seq [str "Save ",
+                                      Layout.tuple [layout r, Save.layout s]]
+                | Star r => seq [str "Star ", layout r]
+            end
 
-	 val toString = Layout.toString o layout
+         val toString = Layout.toString o layout
       end
 
    structure Stack:
       sig
-	 type 'a t
+         type 'a t
 
-	 val clear: 'a t -> unit
-	 val foreach: 'a t * ('a -> unit) -> unit
-	 val new: int * 'a -> 'a t
-	 val peekMap: 'a t * ('a ->'b option) -> 'b option
-	 val push: 'a t * 'a -> unit
+         val clear: 'a t -> unit
+         val foreach: 'a t * ('a -> unit) -> unit
+         val new: int * 'a -> 'a t
+         val peekMap: 'a t * ('a ->'b option) -> 'b option
+         val push: 'a t * 'a -> unit
       end =
       struct
-	 datatype 'a t = T of {elts: 'a array,
-			       size: int ref}
+         datatype 'a t = T of {elts: 'a array,
+                               size: int ref}
 
-	 fun new (size: int, dummy: 'a): 'a t =
-	    T {elts = Array.new (size, dummy),
-	       size = ref 0}
+         fun new (size: int, dummy: 'a): 'a t =
+            T {elts = Array.new (size, dummy),
+               size = ref 0}
 
-	 fun push (T {elts, size}, x) =
-	    let
-	       val n = !size
-	       val _ = Array.update (elts, n, x)
-	       val _ = size := n + 1
-	    in ()
-	    end
+         fun push (T {elts, size}, x) =
+            let
+               val n = !size
+               val _ = Array.update (elts, n, x)
+               val _ = size := n + 1
+            in ()
+            end
 
-	 fun clear (T {size, ...}) = size := 0
+         fun clear (T {size, ...}) = size := 0
 
-	 fun foreach (T {elts, size, ...}, f) =
-	    Int.for (0, !size, fn i => f (Array.sub (elts, i)))
+         fun foreach (T {elts, size, ...}, f) =
+            Int.for (0, !size, fn i => f (Array.sub (elts, i)))
 
-	 fun peekMap (T {elts, size, ...}, f) =
-	    let
-	       val n = !size
-	       fun loop i =
-		  if i = n
-		     then NONE
-		  else (case f (Array.sub (elts, i)) of
-			   NONE => loop (i + 1)
-			 | SOME z => SOME z)
-	    in
-	       loop 0
-	    end
+         fun peekMap (T {elts, size, ...}, f) =
+            let
+               val n = !size
+               fun loop i =
+                  if i = n
+                     then NONE
+                  else (case f (Array.sub (elts, i)) of
+                           NONE => loop (i + 1)
+                         | SOME z => SOME z)
+            in
+               loop 0
+            end
       end
 
    (* NFA state. *)
@@ -170,1490 +171,1491 @@
     *)
    structure State =
       struct
-	 type t = int
+         type t = int
 
-	 val layout = Int.layout
+         val layout = Int.layout
       end
 
    structure MatchAction =
       struct
-	 datatype t =
-	    Finish of Save.t
-	  | Start of Save.t
+         datatype t =
+            Finish of Save.t
+          | Start of Save.t
 
-	 val equals =
-	    fn (Finish s, Finish s') => Save.equals (s, s')
-	     | (Start s, Start s') => Save.equals (s, s')
-	     | _ => false
-		  
-	 fun layout a =
-	    let
-	       open Layout
-	    in
-	       case a of
-		  Finish s => seq [str "Finish ", Save.layout s]
-		| Start s => seq [str "Start ", Save.layout s]
-	    end
+         val equals =
+            fn (Finish s, Finish s') => Save.equals (s, s')
+             | (Start s, Start s') => Save.equals (s, s')
+             | _ => false
+                  
+         fun layout a =
+            let
+               open Layout
+            in
+               case a of
+                  Finish s => seq [str "Finish ", Save.layout s]
+                | Start s => seq [str "Start ", Save.layout s]
+            end
       end
    
    structure Match =
       struct
-	 datatype t = T of {all: Substring.t,
-			    matches: (Save.t * Substring.t) array}
+         datatype t = T of {all: Substring.t,
+                            matches: (Save.t * Substring.t) array}
 
-	 fun all (T {all, ...}) = all
+         fun all (T {all, ...}) = all
 
-	 val startLength = #2 o Substring.base o all
+         val startLength = #2 o Substring.base o all
 
-	 val endOf = Substring.endOf o all
+         val endOf = Substring.endOf o all
 
-	 val length = Substring.length o all
+         val length = Substring.length o all
 
-	 fun layout (T {all, matches}) =
-	    let open Layout
-	    in tuple [Substring.layout all,
-		      Array.layout (Layout.tuple2
-				    (Save.layout, Substring.layout)) matches]
-	    end
+         fun layout (T {all, matches}) =
+            let open Layout
+            in tuple [Substring.layout all,
+                      Array.layout (Layout.tuple2
+                                    (Save.layout, Substring.layout)) matches]
+            end
 
-	 fun funs (T {matches, ...}) =
-	    let	 
-	       fun peek (s: Save.t): Substring.t option =
-		  Option.map (Array.peek (matches, fn (s', _) =>
-					  Save.equals (s, s')),
-			      #2)
-	    in {exists = Option.isSome o peek,
-		lookup = valOf o peek,
-		peek = peek}
-	    end
+         fun funs (T {matches, ...}) =
+            let  
+               fun peek (s: Save.t): Substring.t option =
+                  Option.map (Array.peek (matches, fn (s', _) =>
+                                          Save.equals (s, s')),
+                              #2)
+            in {exists = Option.isSome o peek,
+                lookup = valOf o peek,
+                peek = peek}
+            end
 
-	 fun stringFuns m =
-	    let
-	       val {peek, lookup, exists} = funs m
-	    in
-	       {exists = exists,
-		lookup = Substring.toString o lookup,
-		peek = fn s => Option.map (peek s, Substring.toString)}
-	    end
+         fun stringFuns m =
+            let
+               val {peek, lookup, exists} = funs m
+            in
+               {exists = exists,
+                lookup = Substring.toString o lookup,
+                peek = fn s => Option.map (peek s, Substring.toString)}
+            end
 
-	 local
-	    fun make sel (m, s) = sel (funs m) s
-	 in
-	    val peek = make #peek
-	    val lookup = make #lookup
-	    val exists = make #exists
-	 end
+         local
+            fun make sel (m, s) = sel (funs m) s
+         in
+            val peek = make #peek
+            val lookup = make #lookup
+            val exists = make #exists
+         end
 
-	 fun peekString (m, s) = Option.map (peek (m, s), Substring.toString)
-	 val lookupString = Substring.toString o lookup
+         fun peekString (m, s) = Option.map (peek (m, s), Substring.toString)
+         val lookupString = Substring.toString o lookup
       end
 
    structure Actions =
       struct
-	 datatype t = T of (int * MatchAction.t vector) list
+         datatype t = T of (int * MatchAction.t vector) list
 
-	 fun layout (T l) =
-	    List.layout (Layout.tuple2 (Int.layout,
-					Vector.layout MatchAction.layout))
-	    l
+         fun layout (T l) =
+            List.layout (Layout.tuple2 (Int.layout,
+                                        Vector.layout MatchAction.layout))
+            l
 
-	 val empty = T []
-	    
-	 fun add (a as T l, i, v: MatchAction.t vector) =
-		  if Vector.isEmpty v
-		     then a
-		  else T ((i, v) :: l)
+         val empty = T []
+            
+         fun add (a as T l, i, v: MatchAction.t vector) =
+                  if Vector.isEmpty v
+                     then a
+                  else T ((i, v) :: l)
       end
 
    structure NFA =
       struct
-	 structure State = State
-	 (* State i is final iff isSome (Array.sub (final, i)).
-	  * Characters are grouped into equivalence classes, represented by
-	  * integers in [0, numCharClasses).
-	  * The equivalence class of c is Array.sub (charClass, Char.toInt c).
-	  * The dimensions of next is numStates x numCharClasses.
-	  * The outgoing states from state i on input char c are given by
-	  * Array2.sub (next, i, Array.sub (charClass, Char.to Int c)).
-	  * seen, stack1, and stack2 are used in the two stack simulation of
-	  * the NFA (see fun match).  We preallocate them as part of the NFA
-	  * so they don't have to be allocated on each call to match.
-	  *)
-	 datatype t =
-	    T of {anchorStarts: (State.t * MatchAction.t vector) vector,
-		  charClass: int array, (* of length numChars *)
-		  final: {actions: MatchAction.t vector,
-			  requireFinish: bool} option array,
-		  next: (State.t * MatchAction.t vector) array Array2.t,
-		  saves: Save.t vector,
-		  seen: bool array,
-		  stack1: (State.t * Actions.t) Stack.t,
-		  stack2: (State.t * Actions.t) Stack.t,
-		  start: State.t}
+         structure State = State
+         (* State i is final iff isSome (Array.sub (final, i)).
+          * Characters are grouped into equivalence classes, represented by
+          * integers in [0, numCharClasses).
+          * The equivalence class of c is Array.sub (charClass, Char.toInt c).
+          * The dimensions of next is numStates x numCharClasses.
+          * The outgoing states from state i on input char c are given by
+          * Array2.sub (next, i, Array.sub (charClass, Char.to Int c)).
+          * seen, stack1, and stack2 are used in the two stack simulation of
+          * the NFA (see fun match).  We preallocate them as part of the NFA
+          * so they don't have to be allocated on each call to match.
+          *)
+         datatype t =
+            T of {anchorStarts: (State.t * MatchAction.t vector) vector,
+                  charClass: int array, (* of length numChars *)
+                  final: {actions: MatchAction.t vector,
+                          requireFinish: bool} option array,
+                  next: (State.t * MatchAction.t vector) array Array2.t,
+                  saves: Save.t vector,
+                  seen: bool array,
+                  stack1: (State.t * Actions.t) Stack.t,
+                  stack2: (State.t * Actions.t) Stack.t,
+                  start: State.t}
       end
    
    (* Non-deterministic Finite Automaton. *)
    structure NFA:
       sig
-	 structure State:
-	    sig
-	       type t = int
-		  
-	       val layout: t -> Layout.t
-	    end
-	 
-	 datatype t = datatype NFA.t
-	    
-	 val fromRegexp: Regexp.t -> t
-	 val layoutDot: t * string (* title *) -> Layout.t
-	 val match: {nfa: t,
-		     short: bool,
-		     string: string,
-		     startPos: int} -> (int * Actions.t) option
-	 val numCharClasses: t -> int
-	 val numStates: t -> int
-	 val saves: t -> Save.t vector
+         structure State:
+            sig
+               type t = int
+                  
+               val layout: t -> Layout.t
+            end
+         
+         datatype t = datatype NFA.t
+            
+         val fromRegexp: Regexp.t -> t
+         val layoutDot: t * string (* title *) -> Layout.t
+         val match: {nfa: t,
+                     short: bool,
+                     string: string,
+                     startPos: int} -> (int * Actions.t) option
+         val numCharClasses: t -> int
+         val numStates: t -> int
+         val saves: t -> Save.t vector
       end =
       struct
-	 open NFA
+         open NFA
 
-	 fun numStates (T {next, ...}) = Array2.nRows next
-	 fun numCharClasses (T {next, ...}) = Array2.nCols next
-	 fun saves (T {saves, ...}) = saves
+         fun numStates (T {next, ...}) = Array2.nRows next
+         fun numCharClasses (T {next, ...}) = Array2.nCols next
+         fun saves (T {saves, ...}) = saves
 
-	 (* Simulating an NFA with two stacks and a bit vector, as in Algorithm
-	  * 3.4 (page 126) of the Dragon Book.
-	  *)
-	 fun match {nfa as T {anchorStarts, charClass, final,
-			      next, stack1, stack2, start, ...},
-		    short,
-		    string = s,
-		    startPos}: (int * Actions.t) option =
-	    let
-	       val numStates = numStates nfa
-	       val n = String.size s
-	       val seen = Array.array (numStates, false)
-	       fun loop (current, nextStates, i: int,
-			 last: (int * Actions.t) option)
-		  : (int * Actions.t) option =
-		  let
-		     val last = 
-			case (Stack.peekMap
-			      (current, fn (s, a) =>
-			       case Array.sub (final, s) of
-				  NONE => NONE
-				| SOME {actions, requireFinish} =>
-				     if requireFinish andalso i < n
-					then NONE
-				     else SOME (i, Actions.add (a, i, actions)))) of
-			   NONE => last
-			 | s => s
-		  in
-		     if numStates = 0
-			orelse i = n
-			orelse (short andalso isSome last)
-			then (Stack.clear current
-			      ; last)
-		     else
-			let
-			   val _ = Array.modify (seen, fn _ => false)
-			   val c = Array.sub (charClass,
-					      Char.toInt (String.sub (s, i)))
-			   val _ =
-			      Stack.foreach
-			      (current, fn (s, a) =>
-			       Array.foreach
-			       (Array2.sub (next, s, c), 
-				fn (s', v) =>
-				if Array.sub (seen, s')
-				   then ()
-				else (Array.update (seen, s', true)
-				      ; (Stack.push
-					 (nextStates,
-					  (s', Actions.add (a, i, v)))))))
-			   val _ = Stack.clear current
-			in loop (nextStates, current, i + 1, last)
-			end
-		  end
-	       val _ = Stack.push (stack1, (start, Actions.empty))
-	       val _ =
-		  if startPos = 0
-		     then (Vector.foreach
-			   (anchorStarts, fn (s, v) =>
-			    Stack.push
-			    (stack1,
-			     (s, Actions.add (Actions.empty, startPos, v)))))
-		  else ()
-	    in
-	       loop (stack1, stack2, startPos, NONE)
-	    end
+         (* Simulating an NFA with two stacks and a bit vector, as in Algorithm
+          * 3.4 (page 126) of the Dragon Book.
+          *)
+         fun match {nfa as T {anchorStarts, charClass, final,
+                              next, stack1, stack2, start, ...},
+                    short,
+                    string = s,
+                    startPos}: (int * Actions.t) option =
+            let
+               val numStates = numStates nfa
+               val n = String.size s
+               val seen = Array.array (numStates, false)
+               fun loop (current, nextStates, i: int,
+                         last: (int * Actions.t) option)
+                  : (int * Actions.t) option =
+                  let
+                     val last = 
+                        case (Stack.peekMap
+                              (current, fn (s, a) =>
+                               case Array.sub (final, s) of
+                                  NONE => NONE
+                                | SOME {actions, requireFinish} =>
+                                     if requireFinish andalso i < n
+                                        then NONE
+                                     else SOME (i, Actions.add (a, i, actions)))) of
+                           NONE => last
+                         | s => s
+                  in
+                     if numStates = 0
+                        orelse i = n
+                        orelse (short andalso isSome last)
+                        then (Stack.clear current
+                              ; last)
+                     else
+                        let
+                           val _ = Array.modify (seen, fn _ => false)
+                           val c = Array.sub (charClass,
+                                              Char.toInt (String.sub (s, i)))
+                           val _ =
+                              Stack.foreach
+                              (current, fn (s, a) =>
+                               Array.foreach
+                               (Array2.sub (next, s, c), 
+                                fn (s', v) =>
+                                if Array.sub (seen, s')
+                                   then ()
+                                else (Array.update (seen, s', true)
+                                      ; (Stack.push
+                                         (nextStates,
+                                          (s', Actions.add (a, i, v)))))))
+                           val _ = Stack.clear current
+                        in loop (nextStates, current, i + 1, last)
+                        end
+                  end
+               val _ = Stack.push (stack1, (start, Actions.empty))
+               val _ =
+                  if startPos = 0
+                     then (Vector.foreach
+                           (anchorStarts, fn (s, v) =>
+                            Stack.push
+                            (stack1,
+                             (s, Actions.add (Actions.empty, startPos, v)))))
+                  else ()
+            in
+               loop (stack1, stack2, startPos, NONE)
+            end
 
-	 (* This conversion from a regular expression to an NFA is based on
-	  * Section 3.9 (pages 134 -- 140) of the Dragon Book.
-	  *
-	  * It creates one NFA state for each CharSet (called a "position") that
-	  * is in the regexp.  There is also one extra state for the start state.
-	  * It adds edges as in rules 1 and 2 (page 138) for the followpos
-	  * function.
-	  *)
-	 fun fromRegexp (r: Regexp.t): t =
-	    let
-	       fun loop (r, ac as (saves, numPos)) =
-		  let
-		     open Regexp
-		  in
-		     case r of
-			AnchorFinish => (saves, numPos + 1)
-		      | AnchorStart => (saves, numPos + 1)
-		      | CharSet _ => (saves, numPos + 1)
-		      | Or rs => List.fold (rs, ac, loop)
-		      | Save (r, s) => loop (r, (s :: saves, numPos))
-		      | Seq rs => List.fold (rs, ac, loop)
-		      | Star r => loop (r, ac)
-		  end
-	       val (saves, numPos) = loop (r, ([], 0))
-	       val saves = Vector.fromList saves
-	       val numStates = numPos + 1
-	       val start = numPos
-	       val posCounter = ref ~1
-	       val follow: MatchAction.t vector option Array2.t =
-		  Array2.new (numStates, numStates, NONE)
-	       val posChars = Array2.tabulate (numPos, numChars, fn _ => false)
-	       local
-		  (* Sets of positions represented as vectors of length numPos.
-		   *)
-		  datatype t = T of MatchAction.t vector option vector 
-	       in
-		  type set = t
-		  fun lookup (T v, s) = Vector.sub (v, s)
-		  val empty: t = T (Vector.new (numPos, NONE))
-		  fun addActions (T v, a) =
-		     T (Vector.map
-			(v, fn opt =>
-			 Option.map (opt, fn a' => Vector.concat [a, a'])))
-		  fun addAction (s, a) = addActions (s, Vector.new1 a)
-		  fun union (T v, T v'): t =
-		     T (Vector.tabulate
-			(numPos, fn i =>
-			 case (Vector.sub (v, i), Vector.sub (v', i)) of
-			    (NONE, a) => a
-			  | (a, NONE) => a
-			  | _ => Error.bug "regexp.sml: union"))
-		  fun singleton (i: int): t =
-		     T (Vector.tabulate (numPos, fn j =>
-					 if i = j
-					    then SOME (Vector.new0 ())
-					 else NONE))
-		  fun foreach (T v, f) =
-		     Vector.foreachi (v, fn (i, opt) =>
-				      case opt of
-					 NONE => ()
-				       | SOME a => f (i, a))
-	       end
-	       fun connect (v, v') =
-		  foreach
-		  (v, fn (s, a) =>
-		   foreach
-		   (v', fn (s', a') =>
-		    Array2.update (follow, s, s',
-				   SOME (Vector.concat [a, a']))))
-	       val anchorFinishes = ref []
-	       val anchorStarts = ref []
-	       fun anchor r =
-		  let
-		     val i = ++ posCounter
-		     val _ = List.push (r, i)
-		     val first = singleton i
-		  in
-		     {first = first,
-		      last = first,
-		      nullable = NONE}
-		  end
-	       (* The following loop fills in follow and posChars.
-		* first set of positions that
-		* nullable is SOME v iff the regexp is nullable, where v is the
-		* sequence of actions to perform if the expression is null.
-		*)
-	       fun loop (r: Regexp.t): {first: set,
-					last: set,
-					nullable: MatchAction.t vector option} =
-		  case r of
-		     Regexp.AnchorFinish => anchor anchorFinishes
-		   | Regexp.AnchorStart => anchor anchorStarts
-		   | Regexp.CharSet f =>
-			let
-			   val i = ++ posCounter
-			   val _ =
-			      Int.for
-			      (0, numChars, fn c =>
-			       if f (Char.chr c)
-				  then Array2.update (posChars, i, c, true)
-			       else ())
-			   val first = singleton i
-			in {first = first,
-			    last = first,
-			    nullable = NONE}
-			end
-		   | Regexp.Or rs =>
-			List.fold
-			(rs, {first = empty,
-			      last = empty,
-			      nullable = NONE},
-			 fn (r, {first = f, last = l, nullable = n}) =>
-			 let
-			    val {first = f', last = l', nullable = n'} =
-			       loop r
-			 in
-			    {first = union (f, f'),
-			     last = union (l, l'),
-			     nullable = if isSome n then n else n'}
-			 end)
-		   | Regexp.Save (r, s) =>
-			let
-			   val {first = f, last = l, nullable = n} = loop r
-			   val start = MatchAction.Start s
-			   val finish = MatchAction.Finish s
-			in
-			   {first = addAction (f, start),
-			    last = addAction (l, finish),
-			    nullable = Option.map (n, fn v =>
-						   Vector.concat
-						   [Vector.new1 start,
-						    v,
-						    Vector.new1 finish])}
-			end
-		   | Regexp.Seq rs =>
-			List.fold
-			(rs, {first = empty,
-			      last = empty,
-			      nullable = SOME (Vector.new0 ())},
-			 fn (r, {first = f, last = l, nullable = n}) =>
-			 let
-			    val {first = f', last = l', nullable = n'} =
-			       loop r
-			    val _ = connect (l, f')
-			    val first =
-			       case n of
-				  NONE => f
-				| SOME v => union (f, addActions (f', v))
-			    val last =
-			       case n' of
-				  NONE => l'
-				| SOME v => union (l', addActions (l, v))
-			 in
-			    {first = first, 
-			     last = last,
-			     nullable = (case (n, n') of
-					    (SOME v, SOME v') =>
-					       SOME (Vector.concat [v, v'])
-					  | _ => NONE)}
-			 end)
-		   | Regexp.Star r =>
-			let
-			   val {first = f, last = l, ...} = loop r
-			   val _ = connect (l, f)
-			in
-			   {first = f, last = l,
-			    nullable = SOME (Vector.new0 ())}
-			end
-	       val {first, last, nullable} = loop r
-	       local
-		  fun extract (anchors, positions) =
-		     Vector.keepAllMap
-		     (Vector.fromListMap
-		      (!anchors, fn s =>
-		       Option.map (lookup (positions, s), fn v => (s, v))),
-		      fn x => x)
-	       in
-		  (* Any anchor starts in first should be anchor starts. *)
-		  val anchorStarts = extract (anchorStarts, first)
-		  (* Any anchor finishes in last should be anchor finishes *)
-		  val anchorFinishes = extract (anchorFinishes, last)
-	       end
-	       (* The positions in first are reachable from the start state. *)
-	       val _ = foreach (first, fn (i, a) =>
-				Array2.update (follow, start, i, SOME a))
-	       val final = Array.array (numStates, NONE)
-	       (* The positions that are followed by an anchorFinish are final,
-		* with requireFinish = true.
-		*)
-	       val _ =
-		  Vector.foreach
-		  (anchorFinishes, fn (j, _) =>
-		   Int.for
-		   (0, numStates, fn i =>
-		    case Array2.sub (follow, i, j) of
-		       NONE => ()
-		     | SOME a => 
-			  Array.update (final, i, SOME {actions = a,
-							requireFinish = true})))
-	       (* The positions in last are all final. *)
-	       val _ =
-		  foreach (last, fn (i, a) =>
-			   Array.update (final, i, SOME {actions = a,
-							 requireFinish = false}))
-	       (* The start state is final iff the whole regexp is nullable. *)
-	       val _ =
-		  case nullable of
-		     NONE => ()
-		   | SOME v =>
-			Array.update (final, start,
-				      SOME {actions = v,
-					    requireFinish = false})
-	       (* Compute the transition table, "next". *)
-	       val tmp: MatchAction.t vector option Array.t =
-		  Array.new (numStates, NONE)
-	       val next =
-		  Array2.tabulate
-		  (numStates, numChars, fn (i, c) =>
-		   let
-		      val _ =
-			 Int.for
-			 (0, numPos, fn j =>
-			  case Array2.sub (follow, i, j) of
-			     NONE => ()
-			   | SOME a => 
-				if Array2.sub (posChars, j, c)
-				   then Array.update (tmp, j, SOME a)
-				else ())
-		      val res =
-			 Array.keepAllMapi (tmp, fn (i, opt) =>
-					    Option.map (opt, fn v => (i, v)))
-		      val _ = Int.for (0, numStates, fn j =>
-				       Array.update (tmp, j, NONE))
-		   in
-		      res
-		   end)
-	       (* Two characters are equivalent if all states treat them the
-		* same.
-		*)
-	       fun charEquiv (c: int, c': int) =
-		  Int.forall
-		  (0, numStates, fn i =>
-		   Array.equals
-		   (Array2.sub (next, i, c),
-		    Array2.sub (next, i, c'),
-		    fn ((j, v), (j', v')) =>
-		    j = j' andalso Vector.equals (v, v', MatchAction.equals)))
-	       (* Compute charClass. *)
-	       val repCounter = ref ~1
-	       val reps = ref [] (* representative of each char class *)
-	       val charClass = Array.new (numChars, ~1)
-	       val _ = 
-		  Int.for (0, numChars, fn c =>
-			   let
-			      val rep = 
-				 case List.peek (!reps, fn {char, ...} =>
-						 charEquiv (c, char)) of
-				    NONE =>
-				       let
-					  val rep = ++ repCounter
-				       in List.push (reps, {char = c, rep = rep})
-					  ; rep
-				       end
-				  | SOME {rep, ...} => rep
-			   in Array.update (charClass, c, rep)
-			   end)
-	       val numClasses = 1 + !repCounter
-	       (* Compute "next" for the charClasses. *)
-	       val next' =
-		  Array2.new (numStates, numClasses, Array.fromList [])
-	       val _ =
-		  List.foreach
-		  (!reps, fn {char, rep} =>
-		   Int.for (0, numStates, fn state =>
-			    Array2.update (next', state, rep,
-					   Array2.sub (next, state, char))))
-	    in
-	       T {anchorStarts = anchorStarts,
-		  charClass = charClass,
-		  final = final,
-		  next = next',
-		  saves = saves,
-		  seen = Array.new (numStates, false),
-		  stack1 = Stack.new (numStates, (~1, Actions.empty)),
-		  stack2 = Stack.new (numStates, (~1, Actions.empty)),
-		  start = start}
-	    end
-	 
-	 structure Graph = DirectedGraph
-	 fun layoutDot (T {anchorStarts, charClass, final, next, start, ...},
-			title: string): Layout.t =
-	    let
-	       val numStates = Array2.nRows next
-	       open Dot
-	       val g = Graph.new ()
-	       val nodes = Vector.tabulate (numStates, fn _ => Graph.newNode g)
-	       fun node i = Vector.sub (nodes, i)
-	       val {get = nodeOptions, ...} =
-		  Property.get (Graph.Node.plist,
-				Property.initFun
-				(fn _ => let open NodeOption
-					 in ref []
-					 end))
-	       val {get = edgeOptions, ...} =
-		  Property.get (Graph.Edge.plist,
-				Property.initFun
-				(fn _ => let open EdgeOption
-					 in ref []
-					 end))
-	       fun addNodeOption (i, opts) =
-		  let val r = nodeOptions (node i)
-		  in r := opts @ !r
-		  end
-	       val _ = addNodeOption (start, [NodeOption.label "start"])
-	       val _ =
-		  Int.for
-		  (0, numStates, fn src =>
-		   let
-		      val shape = 
-			 case (isSome (Array.sub (final, src)),
-			       Vector.exists (anchorStarts, fn (s, _) =>
-					      s = src)) of
-			    (false, false) => Ellipse
-			  | (true, false) => Box
-			  | (false, true) => Diamond
-			  | (true, true) => Polygon {sides = 5, options = []}
-		      val _ =
-			 addNodeOption (src, let open NodeOption
-					     in [Shape shape]
-					     end)
-		      val dsts = Array.new (numStates, [])
-		      val _ = 
-			 Int.forDown
-			 (0, numChars, fn c =>
-			  if Vector.sub (validChars, c)
-			     then
-				let
-				   val char = Char.fromInt c
-				   val class = Array.sub (charClass, c)
-				in Array.foreach
-				   (Array2.sub (next, src, class), fn (dst, _) =>
-				    (Array.update (dsts, dst,
-						   char :: Array.sub (dsts, dst))))
-				end
-			  else ())
-		   in
-		      Array.foreachi
-		      (dsts, fn (dst, cs) =>
-		       case cs of
-			  [] => ()
-			| _ =>
-			     let
-				val edge = Graph.addEdge (g, {from = node src,
-							      to = node dst})
-			     in List.push (edgeOptions edge,
-					   EdgeOption.label (edgeLabel cs))
-			     end)
-		   end)
-	    in
-	       Graph.layoutDot (g, fn {nodeName} => 
-				{title = title,
-				 options = 
-				 let open GraphOption
-				 in [
-				     RankDir LeftToRight,
-				     Rank (Min, [{nodeName = nodeName (node start)}])
-				     ]
-				 end,
-				 edgeOptions = ! o edgeOptions,
-				 nodeOptions = ! o nodeOptions})
-	    end
+         (* This conversion from a regular expression to an NFA is based on
+          * Section 3.9 (pages 134 -- 140) of the Dragon Book.
+          *
+          * It creates one NFA state for each CharSet (called a "position") that
+          * is in the regexp.  There is also one extra state for the start state.
+          * It adds edges as in rules 1 and 2 (page 138) for the followpos
+          * function.
+          *)
+         fun fromRegexp (r: Regexp.t): t =
+            let
+               fun loop (r, ac as (saves, numPos)) =
+                  let
+                     open Regexp
+                  in
+                     case r of
+                        AnchorFinish => (saves, numPos + 1)
+                      | AnchorStart => (saves, numPos + 1)
+                      | CharSet _ => (saves, numPos + 1)
+                      | Or rs => List.fold (rs, ac, loop)
+                      | Save (r, s) => loop (r, (s :: saves, numPos))
+                      | Seq rs => List.fold (rs, ac, loop)
+                      | Star r => loop (r, ac)
+                  end
+               val (saves, numPos) = loop (r, ([], 0))
+               val saves = Vector.fromList saves
+               val numStates = numPos + 1
+               val start = numPos
+               val posCounter = ref ~1
+               val follow: MatchAction.t vector option Array2.t =
+                  Array2.new (numStates, numStates, NONE)
+               val posChars = Array2.tabulate (numPos, numChars, fn _ => false)
+               local
+                  (* Sets of positions represented as vectors of length numPos.
+                   *)
+                  datatype t = T of MatchAction.t vector option vector 
+               in
+                  type set = t
+                  fun lookup (T v, s) = Vector.sub (v, s)
+                  val empty: t = T (Vector.new (numPos, NONE))
+                  fun addActions (T v, a) =
+                     T (Vector.map
+                        (v, fn opt =>
+                         Option.map (opt, fn a' => Vector.concat [a, a'])))
+                  fun addAction (s, a) = addActions (s, Vector.new1 a)
+                  fun union (T v, T v'): t =
+                     T (Vector.tabulate
+                        (numPos, fn i =>
+                         case (Vector.sub (v, i), Vector.sub (v', i)) of
+                            (NONE, a) => a
+                          | (a, NONE) => a
+                          | _ => Error.bug "Regexp.NFA.fromRegexp.union"))
+                  fun singleton (i: int): t =
+                     T (Vector.tabulate (numPos, fn j =>
+                                         if i = j
+                                            then SOME (Vector.new0 ())
+                                         else NONE))
+                  fun foreach (T v, f) =
+                     Vector.foreachi (v, fn (i, opt) =>
+                                      case opt of
+                                         NONE => ()
+                                       | SOME a => f (i, a))
+               end
+               fun connect (v, v') =
+                  foreach
+                  (v, fn (s, a) =>
+                   foreach
+                   (v', fn (s', a') =>
+                    Array2.update (follow, s, s',
+                                   SOME (Vector.concat [a, a']))))
+               val anchorFinishes = ref []
+               val anchorStarts = ref []
+               fun anchor r =
+                  let
+                     val i = ++ posCounter
+                     val _ = List.push (r, i)
+                     val first = singleton i
+                  in
+                     {first = first,
+                      last = first,
+                      nullable = NONE}
+                  end
+               (* The following loop fills in follow and posChars.
+                * first set of positions that
+                * nullable is SOME v iff the regexp is nullable, where v is the
+                * sequence of actions to perform if the expression is null.
+                *)
+               fun loop (r: Regexp.t): {first: set,
+                                        last: set,
+                                        nullable: MatchAction.t vector option} =
+                  case r of
+                     Regexp.AnchorFinish => anchor anchorFinishes
+                   | Regexp.AnchorStart => anchor anchorStarts
+                   | Regexp.CharSet f =>
+                        let
+                           val i = ++ posCounter
+                           val _ =
+                              Int.for
+                              (0, numChars, fn c =>
+                               if f (Char.chr c)
+                                  then Array2.update (posChars, i, c, true)
+                               else ())
+                           val first = singleton i
+                        in {first = first,
+                            last = first,
+                            nullable = NONE}
+                        end
+                   | Regexp.Or rs =>
+                        List.fold
+                        (rs, {first = empty,
+                              last = empty,
+                              nullable = NONE},
+                         fn (r, {first = f, last = l, nullable = n}) =>
+                         let
+                            val {first = f', last = l', nullable = n'} =
+                               loop r
+                         in
+                            {first = union (f, f'),
+                             last = union (l, l'),
+                             nullable = if isSome n then n else n'}
+                         end)
+                   | Regexp.Save (r, s) =>
+                        let
+                           val {first = f, last = l, nullable = n} = loop r
+                           val start = MatchAction.Start s
+                           val finish = MatchAction.Finish s
+                        in
+                           {first = addAction (f, start),
+                            last = addAction (l, finish),
+                            nullable = Option.map (n, fn v =>
+                                                   Vector.concat
+                                                   [Vector.new1 start,
+                                                    v,
+                                                    Vector.new1 finish])}
+                        end
+                   | Regexp.Seq rs =>
+                        List.fold
+                        (rs, {first = empty,
+                              last = empty,
+                              nullable = SOME (Vector.new0 ())},
+                         fn (r, {first = f, last = l, nullable = n}) =>
+                         let
+                            val {first = f', last = l', nullable = n'} =
+                               loop r
+                            val _ = connect (l, f')
+                            val first =
+                               case n of
+                                  NONE => f
+                                | SOME v => union (f, addActions (f', v))
+                            val last =
+                               case n' of
+                                  NONE => l'
+                                | SOME v => union (l', addActions (l, v))
+                         in
+                            {first = first, 
+                             last = last,
+                             nullable = (case (n, n') of
+                                            (SOME v, SOME v') =>
+                                               SOME (Vector.concat [v, v'])
+                                          | _ => NONE)}
+                         end)
+                   | Regexp.Star r =>
+                        let
+                           val {first = f, last = l, ...} = loop r
+                           val _ = connect (l, f)
+                        in
+                           {first = f, last = l,
+                            nullable = SOME (Vector.new0 ())}
+                        end
+               val {first, last, nullable} = loop r
+               local
+                  fun extract (anchors, positions) =
+                     Vector.keepAllMap
+                     (Vector.fromListMap
+                      (!anchors, fn s =>
+                       Option.map (lookup (positions, s), fn v => (s, v))),
+                      fn x => x)
+               in
+                  (* Any anchor starts in first should be anchor starts. *)
+                  val anchorStarts = extract (anchorStarts, first)
+                  (* Any anchor finishes in last should be anchor finishes *)
+                  val anchorFinishes = extract (anchorFinishes, last)
+               end
+               (* The positions in first are reachable from the start state. *)
+               val _ = foreach (first, fn (i, a) =>
+                                Array2.update (follow, start, i, SOME a))
+               val final = Array.array (numStates, NONE)
+               (* The positions that are followed by an anchorFinish are final,
+                * with requireFinish = true.
+                *)
+               val _ =
+                  Vector.foreach
+                  (anchorFinishes, fn (j, _) =>
+                   Int.for
+                   (0, numStates, fn i =>
+                    case Array2.sub (follow, i, j) of
+                       NONE => ()
+                     | SOME a => 
+                          Array.update (final, i, SOME {actions = a,
+                                                        requireFinish = true})))
+               (* The positions in last are all final. *)
+               val _ =
+                  foreach (last, fn (i, a) =>
+                           Array.update (final, i, SOME {actions = a,
+                                                         requireFinish = false}))
+               (* The start state is final iff the whole regexp is nullable. *)
+               val _ =
+                  case nullable of
+                     NONE => ()
+                   | SOME v =>
+                        Array.update (final, start,
+                                      SOME {actions = v,
+                                            requireFinish = false})
+               (* Compute the transition table, "next". *)
+               val tmp: MatchAction.t vector option Array.t =
+                  Array.new (numStates, NONE)
+               val next =
+                  Array2.tabulate
+                  (numStates, numChars, fn (i, c) =>
+                   let
+                      val _ =
+                         Int.for
+                         (0, numPos, fn j =>
+                          case Array2.sub (follow, i, j) of
+                             NONE => ()
+                           | SOME a => 
+                                if Array2.sub (posChars, j, c)
+                                   then Array.update (tmp, j, SOME a)
+                                else ())
+                      val res =
+                         Array.keepAllMapi (tmp, fn (i, opt) =>
+                                            Option.map (opt, fn v => (i, v)))
+                      val _ = Int.for (0, numStates, fn j =>
+                                       Array.update (tmp, j, NONE))
+                   in
+                      res
+                   end)
+               (* Two characters are equivalent if all states treat them the
+                * same.
+                *)
+               fun charEquiv (c: int, c': int) =
+                  Int.forall
+                  (0, numStates, fn i =>
+                   Array.equals
+                   (Array2.sub (next, i, c),
+                    Array2.sub (next, i, c'),
+                    fn ((j, v), (j', v')) =>
+                    j = j' andalso Vector.equals (v, v', MatchAction.equals)))
+               (* Compute charClass. *)
+               val repCounter = ref ~1
+               val reps = ref [] (* representative of each char class *)
+               val charClass = Array.new (numChars, ~1)
+               val _ = 
+                  Int.for (0, numChars, fn c =>
+                           let
+                              val rep = 
+                                 case List.peek (!reps, fn {char, ...} =>
+                                                 charEquiv (c, char)) of
+                                    NONE =>
+                                       let
+                                          val rep = ++ repCounter
+                                       in List.push (reps, {char = c, rep = rep})
+                                          ; rep
+                                       end
+                                  | SOME {rep, ...} => rep
+                           in Array.update (charClass, c, rep)
+                           end)
+               val numClasses = 1 + !repCounter
+               (* Compute "next" for the charClasses. *)
+               val next' =
+                  Array2.new (numStates, numClasses, Array.fromList [])
+               val _ =
+                  List.foreach
+                  (!reps, fn {char, rep} =>
+                   Int.for (0, numStates, fn state =>
+                            Array2.update (next', state, rep,
+                                           Array2.sub (next, state, char))))
+            in
+               T {anchorStarts = anchorStarts,
+                  charClass = charClass,
+                  final = final,
+                  next = next',
+                  saves = saves,
+                  seen = Array.new (numStates, false),
+                  stack1 = Stack.new (numStates, (~1, Actions.empty)),
+                  stack2 = Stack.new (numStates, (~1, Actions.empty)),
+                  start = start}
+            end
+         
+         structure Graph = DirectedGraph
+         fun layoutDot (T {anchorStarts, charClass, final, next, start, ...},
+                        title: string): Layout.t =
+            let
+               val numStates = Array2.nRows next
+               open Dot
+               val g = Graph.new ()
+               val nodes = Vector.tabulate (numStates, fn _ => Graph.newNode g)
+               fun node i = Vector.sub (nodes, i)
+               val {get = nodeOptions, ...} =
+                  Property.get (Graph.Node.plist,
+                                Property.initFun
+                                (fn _ => let open NodeOption
+                                         in ref []
+                                         end))
+               val {get = edgeOptions, ...} =
+                  Property.get (Graph.Edge.plist,
+                                Property.initFun
+                                (fn _ => let open EdgeOption
+                                         in ref []
+                                         end))
+               fun addNodeOption (i, opts) =
+                  let val r = nodeOptions (node i)
+                  in r := opts @ !r
+                  end
+               val _ = addNodeOption (start, [NodeOption.label "start"])
+               val _ =
+                  Int.for
+                  (0, numStates, fn src =>
+                   let
+                      val shape = 
+                         case (isSome (Array.sub (final, src)),
+                               Vector.exists (anchorStarts, fn (s, _) =>
+                                              s = src)) of
+                            (false, false) => Ellipse
+                          | (true, false) => Box
+                          | (false, true) => Diamond
+                          | (true, true) => Polygon {sides = 5, options = []}
+                      val _ =
+                         addNodeOption (src, let open NodeOption
+                                             in [Shape shape]
+                                             end)
+                      val dsts = Array.new (numStates, [])
+                      val _ = 
+                         Int.forDown
+                         (0, numChars, fn c =>
+                          if Vector.sub (validChars, c)
+                             then
+                                let
+                                   val char = Char.fromInt c
+                                   val class = Array.sub (charClass, c)
+                                in Array.foreach
+                                   (Array2.sub (next, src, class), fn (dst, _) =>
+                                    (Array.update (dsts, dst,
+                                                   char :: Array.sub (dsts, dst))))
+                                end
+                          else ())
+                   in
+                      Array.foreachi
+                      (dsts, fn (dst, cs) =>
+                       case cs of
+                          [] => ()
+                        | _ =>
+                             let
+                                val edge = Graph.addEdge (g, {from = node src,
+                                                              to = node dst})
+                             in List.push (edgeOptions edge,
+                                           EdgeOption.label (edgeLabel cs))
+                             end)
+                   end)
+            in
+               Graph.layoutDot (g, fn {nodeName} => 
+                                {title = title,
+                                 options = 
+                                 let open GraphOption
+                                 in [
+                                     RankDir LeftToRight,
+                                     Rank (Min, [{nodeName = nodeName (node start)}])
+                                     ]
+                                 end,
+                                 edgeOptions = ! o edgeOptions,
+                                 nodeOptions = ! o nodeOptions})
+            end
       end
 
    structure DFA:
       sig
-	 type t
+         type t
 
-	 val fromNFA: NFA.t -> t
-	 val layoutDot: {dfa: t,
-			 showDead: bool,
-			 title: string} -> Layout.t
-	 val match: {dfa: t,
-		     short: bool,
-		     string: string,
-		     startPos: int,
-		     anchorStart: bool} -> (int * Actions.t) option
-	 val minimize: t -> t
-	 val saves: t -> Save.t vector
+         val fromNFA: NFA.t -> t
+         val layoutDot: {dfa: t,
+                         showDead: bool,
+                         title: string} -> Layout.t
+         val match: {dfa: t,
+                     short: bool,
+                     string: string,
+                     startPos: int,
+                     anchorStart: bool} -> (int * Actions.t) option
+         val minimize: t -> t
+         val saves: t -> Save.t vector
       end =
       struct
-	 (* The states in a DFA are indexed from 0 to n-1, where n is the number
-	  * of states.
-	  *)
-	 structure State =
-	    struct
-	       type t = int
+         (* The states in a DFA are indexed from 0 to n-1, where n is the number
+          * of states.
+          *)
+         structure State =
+            struct
+               type t = int
 
-	       val layout = Int.layout
-	    end
+               val layout = Int.layout
+            end
 
-	 type slot = int
+         type slot = int
 
-	 structure EdgeAction =
-	    struct
-	       datatype t =
-		  Add of {from: slot,
-			  to: slot,
-			  actions: MatchAction.t vector}
-		| Init of {to: slot,
-			   actions: MatchAction.t vector}
+         structure EdgeAction =
+            struct
+               datatype t =
+                  Add of {from: slot,
+                          to: slot,
+                          actions: MatchAction.t vector}
+                | Init of {to: slot,
+                           actions: MatchAction.t vector}
 
-	       val equals =
-		  fn (Add {from = f, to = t, actions = a},
-		      Add {from = f', to = t', actions = a'}) =>
-		     f = f' andalso t = t'
-		     andalso Vector.equals (a, a', MatchAction.equals)
-		   | (Init {to = t, actions = a},
-		      Init {to = t', actions = a'}) =>
-		     t = t' andalso Vector.equals (a, a', MatchAction.equals)
-		   | _ => false
+               val equals =
+                  fn (Add {from = f, to = t, actions = a},
+                      Add {from = f', to = t', actions = a'}) =>
+                     f = f' andalso t = t'
+                     andalso Vector.equals (a, a', MatchAction.equals)
+                   | (Init {to = t, actions = a},
+                      Init {to = t', actions = a'}) =>
+                     t = t' andalso Vector.equals (a, a', MatchAction.equals)
+                   | _ => false
 
-	       val toString =
-		  fn Add {from, to, actions} =>
-		        concat ["(",
-				Int.toString from, ", ",
-				Int.toString to, ", ",
-				Layout.toString
-				(Vector.layout MatchAction.layout actions),
-				")"]
-		   | Init {to, actions} =>
-			concat ["(",
-				Int.toString to, ", ",
-				Layout.toString
-				(Vector.layout MatchAction.layout actions),
-				")"]
+               val toString =
+                  fn Add {from, to, actions} =>
+                        concat ["(",
+                                Int.toString from, ", ",
+                                Int.toString to, ", ",
+                                Layout.toString
+                                (Vector.layout MatchAction.layout actions),
+                                ")"]
+                   | Init {to, actions} =>
+                        concat ["(",
+                                Int.toString to, ", ",
+                                Layout.toString
+                                (Vector.layout MatchAction.layout actions),
+                                ")"]
 
-	       val layout =
-		  let open Layout
-		  in
-		     fn Add {from, to, actions} =>
-		           Layout.record
-			   [("from", Int.layout from),
-			    ("to", Int.layout to),
-			    ("actions",
-			     Vector.layout MatchAction.layout actions)]
-		      | Init {actions, to} =>
-			   Layout.record
-			   [("to", Int.layout to),
-			    ("actions",
-			     Vector.layout MatchAction.layout actions)]
-		  end
-	    end
-	 
-	 (* State i is final iff Array.sub (final, i).
-	  * Characters are grouped into equivalence classes, represented by
-	  * integers in [0, numCharClasses).
-	  * The equivalence class of c is Array.sub (charClass, Char.toInt c).
-	  * The dimensions of next are numStates x numCharClasses
-	  * The outgoing state from state i on input char c is
-	  *   Array2.sub (next, i, Array.sub (charClass, Char.toInt c)).
-	  * actions1 and actions2 are used only during matching.  They
-	  * represent the actions associated with each NFA state.  They are of
-	  * the same length as the number of states in the NFA.
-	  *)
-	 datatype t =
-	    T of {anchorStart: State.t,
-		  anchorStartStack: MatchAction.t vector vector,
-		  charClass: int array, (* of length numChars *)
-		  dead: bool array,
-		  final: {actions: MatchAction.t vector,
-			  requireFinish: bool,
-			  slot: int} option array,
-		  next: (State.t * EdgeAction.t vector) Array2.t,
-		  saves: Save.t vector,
-		  stack1: Actions.t array, (* of size maxNumNFAStates *)
-		  stack2: Actions.t array, (* of size maxNumNFAStates *)
-		  start: State.t,
-		  startStack: MatchAction.t vector vector}
+               val layout =
+                  let open Layout
+                  in
+                     fn Add {from, to, actions} =>
+                           Layout.record
+                           [("from", Int.layout from),
+                            ("to", Int.layout to),
+                            ("actions",
+                             Vector.layout MatchAction.layout actions)]
+                      | Init {actions, to} =>
+                           Layout.record
+                           [("to", Int.layout to),
+                            ("actions",
+                             Vector.layout MatchAction.layout actions)]
+                  end
+            end
+         
+         (* State i is final iff Array.sub (final, i).
+          * Characters are grouped into equivalence classes, represented by
+          * integers in [0, numCharClasses).
+          * The equivalence class of c is Array.sub (charClass, Char.toInt c).
+          * The dimensions of next are numStates x numCharClasses
+          * The outgoing state from state i on input char c is
+          *   Array2.sub (next, i, Array.sub (charClass, Char.toInt c)).
+          * actions1 and actions2 are used only during matching.  They
+          * represent the actions associated with each NFA state.  They are of
+          * the same length as the number of states in the NFA.
+          *)
+         datatype t =
+            T of {anchorStart: State.t,
+                  anchorStartStack: MatchAction.t vector vector,
+                  charClass: int array, (* of length numChars *)
+                  dead: bool array,
+                  final: {actions: MatchAction.t vector,
+                          requireFinish: bool,
+                          slot: int} option array,
+                  next: (State.t * EdgeAction.t vector) Array2.t,
+                  saves: Save.t vector,
+                  stack1: Actions.t array, (* of size maxNumNFAStates *)
+                  stack2: Actions.t array, (* of size maxNumNFAStates *)
+                  start: State.t,
+                  startStack: MatchAction.t vector vector}
 
-	 fun numStates (T {next, ...}): int = Array2.nRows next
-	 fun saves (T {saves, ...}) = saves
+         fun numStates (T {next, ...}): int = Array2.nRows next
+         fun saves (T {saves, ...}) = saves
 
-	 fun dead (numStates, numCharClasses, final, next) =
-	    Array.tabulate
-	    (numStates, fn i =>
-	     not (isSome (Array.sub (final, i)))
-	     andalso Int.forall (0, numCharClasses, fn c =>
-				 let val (j, v) = Array2.sub (next, i, c)
-				 in i = j andalso Vector.isEmpty v
-				 end))
+         fun dead (numStates, numCharClasses, final, next) =
+            Array.tabulate
+            (numStates, fn i =>
+             not (isSome (Array.sub (final, i)))
+             andalso Int.forall (0, numCharClasses, fn c =>
+                                 let val (j, v) = Array2.sub (next, i, c)
+                                 in i = j andalso Vector.isEmpty v
+                                 end))
 
-	 (* To build a DFA from an NFA, I use the usual "subset construction",
-	  * as in algorithm 3.2 (page 118) of the Dragon Book.
-	  *
-	  * It associates each (reachable) set of states in the NFA with a single
-	  * state in the DFA.
-	  *)
-	 fun fromNFA (nfa as NFA.T {anchorStarts, charClass,
-				    final, next, saves, start, ...}) =
-	    let
-	       val numNFAStates = NFA.numStates nfa
-	       val numCharClasses = NFA.numCharClasses nfa
-	       (* Determine the NFA states that have save info.
-		*)
-	       val nfaStateSave = Array.array (numNFAStates, false)
-	       fun visit (s: NFA.State.t): unit =
-		  if Array.sub (nfaStateSave, s)
-		     then ()
-		  else (Array.update (nfaStateSave, s, true)
-			; Int.for (0, numCharClasses, fn c =>
-				   Array.foreach
-				   (Array2.sub (next, s, c), fn (s', _) =>
-				    visit s')))
-	       val _ =
-		  Vector.foreach
-		  (anchorStarts, fn (s, v) =>
-		   if Vector.isEmpty v
-		      then ()
-		   else visit s)
-	       val _ =
-		  Int.for (0, numNFAStates, fn s =>
-			   if Array.sub (nfaStateSave, s)
-			      then ()
-			   else
-			      Int.for (0, numCharClasses, fn c =>
-				       Array.foreach
-				       (Array2.sub (next, s, c), fn (s', v) =>
-					if Vector.isEmpty v
-					   then ()
-					else visit s')))
-	       (* Sets of states are represented as arrays, sorted in increasing
-		* order of state index.
-		*)
-	       type states = NFA.State.t array
-	       val counter = ref ~1
-	       type work =
-		  {states: states,
-		   state: int,
-		   out: (State.t * EdgeAction.t vector) vector option ref}
-	       val cache: work list ref = ref []
-	       val todo: work list ref = ref []
-	       val maxNumStates: int ref = ref 0
-	       fun statesToState (ss: states): State.t =
-		  let
-		     val n = Array.length ss
-		     val _ = if n > !maxNumStates
-				then maxNumStates := n
-			     else ()
-		  in
-		     case List.peek (!cache, fn {states, ...} =>
-				     Array.equals (ss, states, op =)) of
-			NONE =>
-			   let
-			      val state = ++ counter
-			      val work = {out = ref NONE,
-					  state = state,
-					  states = ss}
-			      val _ = List.push (cache, work)
-			      val _ = List.push (todo, work)
-			   in
-			      state
-			   end
-		      | SOME {state, ...} => state
-		  end
-	       val statesToState =
-		  Trace.trace ("statesToState", Array.layout NFA.State.layout,
-			       State.layout)
-		  statesToState
-	       local
-		  val seen = Array.array (NFA.numStates nfa, NONE)
-	       in
-		  fun computeOut states =
-		     Vector.tabulate
-		     (numCharClasses, fn c =>
-		      let
-			 val _ = Array.modify (seen, fn _ => NONE)
-			 val _ = 
-			    Array.foreachi
-			    (states, fn (fromSlot: slot,
-					 fromState: NFA.State.t) =>
-			     Array.foreach
-			     (Array2.sub (next, fromState, c),
-			      fn (toState: NFA.State.t, v) =>
-			      case Array.sub (seen, toState) of
-				 NONE =>
-				    Array.update
-				    (seen, toState,
-				     SOME {fromSlot = fromSlot,
-					   fromState = fromState,
-					   toState = toState,
-					   actions = v})
-			       | SOME _ => ()))
-			 val toStates = Array.keepAllMap (seen, fn opt => opt)
-			 val edgeActions = ref []
-			 val toStates = 
-			    Array.mapi
-			    (toStates, fn (toSlot: slot,
-					   {fromSlot, fromState, toState,
-					    actions}) =>
-			     (if Array.sub (nfaStateSave, toState)
-				 then
-				    List.push
-				    (edgeActions,
-				     if Array.sub (nfaStateSave, fromState)
-					then
-					   EdgeAction.Add
-					   {from = fromSlot,
-					    to = toSlot,
-					    actions = actions}
-				     else (EdgeAction.Init
-					   {to = toSlot,
-					    actions = actions}))
-			      else ()
-			      ; toState))
-		      in (statesToState toStates,
-			  Vector.fromList (!edgeActions))
-		      end)
-	       end
-	       fun loop () =
-		  case !todo of
-		     [] => ()
-		   | {states, out, ...} :: rest =>
-			(todo := rest
-			 ; out := SOME (computeOut states)
-			 ; loop ())
-	       (* These calls to statesToState initialize the worklist. *)
-	       val start' = statesToState (Array.fromList [start])
-	       val startStack = Vector.new1 (Vector.new0 ())
-	       val anchorStartStates =
-		  Array.fromList
-		  (List.insert
-		   (Vector.toListMap (anchorStarts, #1), start, op <=))
-	       val anchorStart' = statesToState anchorStartStates
-	       val anchorStartStack =
-		  Vector.tabulate
-		  (Array.length anchorStartStates,
-		   fn i =>
-		   let
-		      val s = Array.sub (anchorStartStates, i)
-		   in
-		      case Vector.peek (anchorStarts, fn (s', _) => s = s') of
-			 NONE => Vector.new0 ()
-		       | SOME (_, v) => v
-		   end)
-	       val _ = loop ()
-	       (* The worklist is empty.  Compute the transition table. *)
-	       val numStates = 1 + !counter
-	       val next' = Array2.new (numStates, numCharClasses,
-				       (~1, Vector.new0 ()))
-	       val final' = Array.new (numStates, NONE)
-	       val _ =
-		  List.foreach
-		  (!cache, fn {states, state = i, out, ...}: work =>
-		   let
-		      val _ =
-			 Vector.foreachi
-			 (valOf (! out), fn (c, j) =>
-			  Array2.update (next', i, c, j))
-		      val _ =
-			 case Array.sub (final', i) of
-			    SOME {requireFinish = false, ...} => ()
-			  | _ =>
-			       case Array.peekMapi (states, fn s =>
-						    Array.sub (final, s)) of
-				  NONE => ()
-				| SOME (slot, {actions, requireFinish}) =>
-				     Array.update
-				     (final', i,
-				      SOME {actions = actions,
-					    requireFinish = requireFinish,
-					    slot = slot})
-		   in
-		      ()
-		   end)
-	       fun newStack () = Array.new (!maxNumStates, Actions.empty)
-	    in T {anchorStart = anchorStart',
-		  anchorStartStack = anchorStartStack,
-		  charClass = charClass,
-		  dead = dead (numStates, numCharClasses, final', next'),
-		  final = final',
-		  next = next',
-		  saves = saves,
-		  stack1 = newStack (),
-		  stack2 = newStack (),
-		  start = start',
-		  startStack = startStack}
-	    end
+         (* To build a DFA from an NFA, I use the usual "subset construction",
+          * as in algorithm 3.2 (page 118) of the Dragon Book.
+          *
+          * It associates each (reachable) set of states in the NFA with a single
+          * state in the DFA.
+          *)
+         fun fromNFA (nfa as NFA.T {anchorStarts, charClass,
+                                    final, next, saves, start, ...}) =
+            let
+               val numNFAStates = NFA.numStates nfa
+               val numCharClasses = NFA.numCharClasses nfa
+               (* Determine the NFA states that have save info.
+                *)
+               val nfaStateSave = Array.array (numNFAStates, false)
+               fun visit (s: NFA.State.t): unit =
+                  if Array.sub (nfaStateSave, s)
+                     then ()
+                  else (Array.update (nfaStateSave, s, true)
+                        ; Int.for (0, numCharClasses, fn c =>
+                                   Array.foreach
+                                   (Array2.sub (next, s, c), fn (s', _) =>
+                                    visit s')))
+               val _ =
+                  Vector.foreach
+                  (anchorStarts, fn (s, v) =>
+                   if Vector.isEmpty v
+                      then ()
+                   else visit s)
+               val _ =
+                  Int.for (0, numNFAStates, fn s =>
+                           if Array.sub (nfaStateSave, s)
+                              then ()
+                           else
+                              Int.for (0, numCharClasses, fn c =>
+                                       Array.foreach
+                                       (Array2.sub (next, s, c), fn (s', v) =>
+                                        if Vector.isEmpty v
+                                           then ()
+                                        else visit s')))
+               (* Sets of states are represented as arrays, sorted in increasing
+                * order of state index.
+                *)
+               type states = NFA.State.t array
+               val counter = ref ~1
+               type work =
+                  {states: states,
+                   state: int,
+                   out: (State.t * EdgeAction.t vector) vector option ref}
+               val cache: work list ref = ref []
+               val todo: work list ref = ref []
+               val maxNumStates: int ref = ref 0
+               fun statesToState (ss: states): State.t =
+                  let
+                     val n = Array.length ss
+                     val _ = if n > !maxNumStates
+                                then maxNumStates := n
+                             else ()
+                  in
+                     case List.peek (!cache, fn {states, ...} =>
+                                     Array.equals (ss, states, op =)) of
+                        NONE =>
+                           let
+                              val state = ++ counter
+                              val work = {out = ref NONE,
+                                          state = state,
+                                          states = ss}
+                              val _ = List.push (cache, work)
+                              val _ = List.push (todo, work)
+                           in
+                              state
+                           end
+                      | SOME {state, ...} => state
+                  end
+               val statesToState =
+                  Trace.trace ("Regexp.DFA.fromNFA.statesToState", 
+                               Array.layout NFA.State.layout,
+                               State.layout)
+                  statesToState
+               local
+                  val seen = Array.array (NFA.numStates nfa, NONE)
+               in
+                  fun computeOut states =
+                     Vector.tabulate
+                     (numCharClasses, fn c =>
+                      let
+                         val _ = Array.modify (seen, fn _ => NONE)
+                         val _ = 
+                            Array.foreachi
+                            (states, fn (fromSlot: slot,
+                                         fromState: NFA.State.t) =>
+                             Array.foreach
+                             (Array2.sub (next, fromState, c),
+                              fn (toState: NFA.State.t, v) =>
+                              case Array.sub (seen, toState) of
+                                 NONE =>
+                                    Array.update
+                                    (seen, toState,
+                                     SOME {fromSlot = fromSlot,
+                                           fromState = fromState,
+                                           toState = toState,
+                                           actions = v})
+                               | SOME _ => ()))
+                         val toStates = Array.keepAllMap (seen, fn opt => opt)
+                         val edgeActions = ref []
+                         val toStates = 
+                            Array.mapi
+                            (toStates, fn (toSlot: slot,
+                                           {fromSlot, fromState, toState,
+                                            actions}) =>
+                             (if Array.sub (nfaStateSave, toState)
+                                 then
+                                    List.push
+                                    (edgeActions,
+                                     if Array.sub (nfaStateSave, fromState)
+                                        then
+                                           EdgeAction.Add
+                                           {from = fromSlot,
+                                            to = toSlot,
+                                            actions = actions}
+                                     else (EdgeAction.Init
+                                           {to = toSlot,
+                                            actions = actions}))
+                              else ()
+                              ; toState))
+                      in (statesToState toStates,
+                          Vector.fromList (!edgeActions))
+                      end)
+               end
+               fun loop () =
+                  case !todo of
+                     [] => ()
+                   | {states, out, ...} :: rest =>
+                        (todo := rest
+                         ; out := SOME (computeOut states)
+                         ; loop ())
+               (* These calls to statesToState initialize the worklist. *)
+               val start' = statesToState (Array.fromList [start])
+               val startStack = Vector.new1 (Vector.new0 ())
+               val anchorStartStates =
+                  Array.fromList
+                  (List.insert
+                   (Vector.toListMap (anchorStarts, #1), start, op <=))
+               val anchorStart' = statesToState anchorStartStates
+               val anchorStartStack =
+                  Vector.tabulate
+                  (Array.length anchorStartStates,
+                   fn i =>
+                   let
+                      val s = Array.sub (anchorStartStates, i)
+                   in
+                      case Vector.peek (anchorStarts, fn (s', _) => s = s') of
+                         NONE => Vector.new0 ()
+                       | SOME (_, v) => v
+                   end)
+               val _ = loop ()
+               (* The worklist is empty.  Compute the transition table. *)
+               val numStates = 1 + !counter
+               val next' = Array2.new (numStates, numCharClasses,
+                                       (~1, Vector.new0 ()))
+               val final' = Array.new (numStates, NONE)
+               val _ =
+                  List.foreach
+                  (!cache, fn {states, state = i, out, ...}: work =>
+                   let
+                      val _ =
+                         Vector.foreachi
+                         (valOf (! out), fn (c, j) =>
+                          Array2.update (next', i, c, j))
+                      val _ =
+                         case Array.sub (final', i) of
+                            SOME {requireFinish = false, ...} => ()
+                          | _ =>
+                               case Array.peekMapi (states, fn s =>
+                                                    Array.sub (final, s)) of
+                                  NONE => ()
+                                | SOME (slot, {actions, requireFinish}) =>
+                                     Array.update
+                                     (final', i,
+                                      SOME {actions = actions,
+                                            requireFinish = requireFinish,
+                                            slot = slot})
+                   in
+                      ()
+                   end)
+               fun newStack () = Array.new (!maxNumStates, Actions.empty)
+            in T {anchorStart = anchorStart',
+                  anchorStartStack = anchorStartStack,
+                  charClass = charClass,
+                  dead = dead (numStates, numCharClasses, final', next'),
+                  final = final',
+                  next = next',
+                  saves = saves,
+                  stack1 = newStack (),
+                  stack2 = newStack (),
+                  start = start',
+                  startStack = startStack}
+            end
 
-	 (*
-	  * match could be sped up some by doing the match in two passes.
-	  * The first pass just determines if the match will succeed.
-	  * The second pass computes all the edge actions.
-	  *)
-	 fun match {dfa = T {anchorStart = ancSt, anchorStartStack,
-			      charClass, dead, final, next, stack1, stack2,
-			      start, startStack, ...},
-		    short: bool,
-		    string = s,
-		    startPos: int,
-		    anchorStart: bool}: (int * Actions.t) option =
-	    let
-	       val n = String.size s
-	       fun loop (i: int,
-			 state: int,
-			 stack1, stack2,
-			 last: (int * Actions.t) option)
-		  : (int * Actions.t) option =
-		  let
-		     val last =
-			case Array.sub (final, state) of
-			   NONE => last
-			 | SOME {actions, requireFinish, slot} =>
-			      if requireFinish andalso i < n
-				 then NONE
-			      else
-				 SOME (i, Actions.add (Array.sub (stack1, slot),
-						       i, actions))
-		  in
-		     if Array.sub (dead, state)
-			orelse i = n
-			orelse (short andalso isSome last)
-			then last
-		     else
-			let
-			   val (state, edgeActions) =
-			      Array2.sub (next, state,
-					  Array.sub
-					  (charClass,
-					   Char.toInt (String.sub (s, i))))
-			   val _ =
-			      Vector.foreach
-			      (edgeActions,
-			       fn EdgeAction.Add {from, to, actions} =>
-			             Array.update
-				     (stack2, to,
-				      Actions.add (Array.sub (stack1, from),
-						   i, actions))
-				| EdgeAction.Init {to, actions} =>
-				     Array.update
-				     (stack2, to,
-				      Actions.add (Actions.empty, i, actions)))
-			in
-			   loop (i + 1, state, stack2, stack1, last)
-			end
-		  end
-	       val (state, initStack) =
-		  if anchorStart
-		     then (ancSt, anchorStartStack)
-		  else (start, startStack)
-	       val _ = 
-		  Vector.foreachi
-		  (initStack, fn (slot, v) =>
-		   Array.update (stack1, slot,
-				 Actions.add (Actions.empty, startPos, v)))
-	       val res = loop (startPos, state, stack1, stack2, NONE)
-	    in
-	       res
-	    end
+         (*
+          * match could be sped up some by doing the match in two passes.
+          * The first pass just determines if the match will succeed.
+          * The second pass computes all the edge actions.
+          *)
+         fun match {dfa = T {anchorStart = ancSt, anchorStartStack,
+                              charClass, dead, final, next, stack1, stack2,
+                              start, startStack, ...},
+                    short: bool,
+                    string = s,
+                    startPos: int,
+                    anchorStart: bool}: (int * Actions.t) option =
+            let
+               val n = String.size s
+               fun loop (i: int,
+                         state: int,
+                         stack1, stack2,
+                         last: (int * Actions.t) option)
+                  : (int * Actions.t) option =
+                  let
+                     val last =
+                        case Array.sub (final, state) of
+                           NONE => last
+                         | SOME {actions, requireFinish, slot} =>
+                              if requireFinish andalso i < n
+                                 then NONE
+                              else
+                                 SOME (i, Actions.add (Array.sub (stack1, slot),
+                                                       i, actions))
+                  in
+                     if Array.sub (dead, state)
+                        orelse i = n
+                        orelse (short andalso isSome last)
+                        then last
+                     else
+                        let
+                           val (state, edgeActions) =
+                              Array2.sub (next, state,
+                                          Array.sub
+                                          (charClass,
+                                           Char.toInt (String.sub (s, i))))
+                           val _ =
+                              Vector.foreach
+                              (edgeActions,
+                               fn EdgeAction.Add {from, to, actions} =>
+                                     Array.update
+                                     (stack2, to,
+                                      Actions.add (Array.sub (stack1, from),
+                                                   i, actions))
+                                | EdgeAction.Init {to, actions} =>
+                                     Array.update
+                                     (stack2, to,
+                                      Actions.add (Actions.empty, i, actions)))
+                        in
+                           loop (i + 1, state, stack2, stack1, last)
+                        end
+                  end
+               val (state, initStack) =
+                  if anchorStart
+                     then (ancSt, anchorStartStack)
+                  else (start, startStack)
+               val _ = 
+                  Vector.foreachi
+                  (initStack, fn (slot, v) =>
+                   Array.update (stack1, slot,
+                                 Actions.add (Actions.empty, startPos, v)))
+               val res = loop (startPos, state, stack1, stack2, NONE)
+            in
+               res
+            end
 
-	 val match =
-	    Trace.trace ("DFA.match",
-			 fn {string, startPos, ...} =>
-			 Layout.tuple [String.layout string,
-				       Int.layout startPos],
-			 Option.layout (Layout.tuple2
-					(Int.layout, Actions.layout)))
-	    match
+         val match =
+            Trace.trace ("Regexp.DFA.match",
+                         fn {string, startPos, ...} =>
+                         Layout.tuple [String.layout string,
+                                       Int.layout startPos],
+                         Option.layout (Layout.tuple2
+                                        (Int.layout, Actions.layout)))
+            match
 
-	 structure Graph = DirectedGraph
-	 structure Env = Env (structure Domain = MonoVector (EdgeAction))
-	 fun layoutDot {dfa as T {anchorStart, charClass, dead, final,
-				  next, start, ...},
-			title: string,
-			showDead: bool}: Layout.t =
-	    let
-	       val numStates = numStates dfa
-	       open Dot
-	       val g = Graph.new ()
-	       val nodes = Vector.tabulate (numStates, fn _ => Graph.newNode g)
-	       fun node i = Vector.sub (nodes, i)
-	       val {get = nodeOptions, ...} =
-		  Property.get (Graph.Node.plist,
-				Property.initFun
-				(fn _ => let open NodeOption
-					 in ref []
-					 end))
-	       val {get = edgeOptions, ...} =
-		  Property.get (Graph.Edge.plist,
-				Property.initFun
-				(fn _ => let open EdgeOption
-					 in ref []
-					 end))
-	       fun addNodeOption (i, opts) =
-		  let val r = nodeOptions (node i)
-		  in r := opts @ !r
-		  end
-	       val _ = addNodeOption (start, [NodeOption.label "start"])
-	       val _ =
-		  Int.for
-		  (0, numStates, fn src =>
-		   let
-		      val shape = 
-			 case (isSome (Array.sub (final, src)),
-			       src = anchorStart) of
-			    (false, false) => Ellipse
-			  | (true, false) => Box
-			  | (false, true) => Diamond
-			  | (true, true) => Polygon {sides = 5, options = []}
-		      val _ =
-			 addNodeOption (src, let open NodeOption
-					     in [Shape shape]
-					     end)
-		      val dsts = Array.new (numStates, Env.empty ())
-		      val _ = 
-			 Int.forDown
-			 (0, numChars, fn c =>
-			  if Vector.sub (validChars, c)
-			     then
-				let
-				   val (dst, v) =
-				      Array2.sub (next, src,
-						  Array.sub (charClass, c))
-				   val e = Array.sub (dsts, dst)
-				   val c = Char.fromInt c
-				   val cs =
-				      case Env.peek (e, v) of
-					 NONE => [c]
-				       | SOME cs => c :: cs
-				in Array.update
-				   (dsts, dst, Env.extend (e, v, cs))
-				end
-			  else ())
-		      val src = node src
-		   in
-		      Array.foreachi
-		      (dsts, fn (dst, e) =>
-		       if not showDead andalso Array.sub (dead, dst)
-			  then ()
-		       else
-			  Env.foreachi
-			  (e, fn (v, cs) =>
-			   let
-			      val edge = Graph.addEdge (g, {from = src,
-							    to = node dst})
-			      val label =
-				 concat [edgeLabel cs,
-					 " -- ",
-					 Layout.toString 
-					 (Vector.layout (Layout.str o
-							 EdgeAction.toString)
-					  v)]
-			   in List.push (edgeOptions edge,
-					 EdgeOption.label label)
-			   end))
-		   end)
-	    in
-	       Graph.layoutDot (g, fn {nodeName} => 
-				{title = title,
-				 options = 
-				 let open GraphOption
-				 in [
-				     RankDir LeftToRight,
-				     Rank (Min, [{nodeName = nodeName (node start)}])
-				     ]
-				 end,
-				 edgeOptions = ! o edgeOptions,
-				 nodeOptions = ! o nodeOptions})
-	    end
+         structure Graph = DirectedGraph
+         structure Env = Env (structure Domain = MonoVector (EdgeAction))
+         fun layoutDot {dfa as T {anchorStart, charClass, dead, final,
+                                  next, start, ...},
+                        title: string,
+                        showDead: bool}: Layout.t =
+            let
+               val numStates = numStates dfa
+               open Dot
+               val g = Graph.new ()
+               val nodes = Vector.tabulate (numStates, fn _ => Graph.newNode g)
+               fun node i = Vector.sub (nodes, i)
+               val {get = nodeOptions, ...} =
+                  Property.get (Graph.Node.plist,
+                                Property.initFun
+                                (fn _ => let open NodeOption
+                                         in ref []
+                                         end))
+               val {get = edgeOptions, ...} =
+                  Property.get (Graph.Edge.plist,
+                                Property.initFun
+                                (fn _ => let open EdgeOption
+                                         in ref []
+                                         end))
+               fun addNodeOption (i, opts) =
+                  let val r = nodeOptions (node i)
+                  in r := opts @ !r
+                  end
+               val _ = addNodeOption (start, [NodeOption.label "start"])
+               val _ =
+                  Int.for
+                  (0, numStates, fn src =>
+                   let
+                      val shape = 
+                         case (isSome (Array.sub (final, src)),
+                               src = anchorStart) of
+                            (false, false) => Ellipse
+                          | (true, false) => Box
+                          | (false, true) => Diamond
+                          | (true, true) => Polygon {sides = 5, options = []}
+                      val _ =
+                         addNodeOption (src, let open NodeOption
+                                             in [Shape shape]
+                                             end)
+                      val dsts = Array.new (numStates, Env.empty ())
+                      val _ = 
+                         Int.forDown
+                         (0, numChars, fn c =>
+                          if Vector.sub (validChars, c)
+                             then
+                                let
+                                   val (dst, v) =
+                                      Array2.sub (next, src,
+                                                  Array.sub (charClass, c))
+                                   val e = Array.sub (dsts, dst)
+                                   val c = Char.fromInt c
+                                   val cs =
+                                      case Env.peek (e, v) of
+                                         NONE => [c]
+                                       | SOME cs => c :: cs
+                                in Array.update
+                                   (dsts, dst, Env.extend (e, v, cs))
+                                end
+                          else ())
+                      val src = node src
+                   in
+                      Array.foreachi
+                      (dsts, fn (dst, e) =>
+                       if not showDead andalso Array.sub (dead, dst)
+                          then ()
+                       else
+                          Env.foreachi
+                          (e, fn (v, cs) =>
+                           let
+                              val edge = Graph.addEdge (g, {from = src,
+                                                            to = node dst})
+                              val label =
+                                 concat [edgeLabel cs,
+                                         " -- ",
+                                         Layout.toString 
+                                         (Vector.layout (Layout.str o
+                                                         EdgeAction.toString)
+                                          v)]
+                           in List.push (edgeOptions edge,
+                                         EdgeOption.label label)
+                           end))
+                   end)
+            in
+               Graph.layoutDot (g, fn {nodeName} => 
+                                {title = title,
+                                 options = 
+                                 let open GraphOption
+                                 in [
+                                     RankDir LeftToRight,
+                                     Rank (Min, [{nodeName = nodeName (node start)}])
+                                     ]
+                                 end,
+                                 edgeOptions = ! o edgeOptions,
+                                 nodeOptions = ! o nodeOptions})
+            end
 
-	 fun minimize d = d
-	 (* This DFA minimization algorithm is based on algorithm 3.6 (page 142)
-	  * of the Dragon Book.
-	  *
-	  * It maintains an array, r, that stores for each state s the
-	  * representative of the class to which s belongs.
-	  * It repeatedly refines an equivalence relation, represented by a list
-	  * of classes, where each class is a list of states.
-	  *)
-(* 	 fun minimize (dfa as T {anchorStart, charClass, final,
- * 				 start, next, ...}): t =
- * 	    let
- * 	       val numStates = numStates dfa
- * 	       val numCharClasses = numCharClasses dfa
- * 	       type class = int list
- * 	       type classes = class list
- * 	       val repCounter = ref ~1
- * 	       val change = ref false
- * 	       fun newRep () = (change := true; ++ repCounter)
- * 	       val finRep = newRep ()
- * 	       val nonfinRep = newRep ()
- * 	       val r = Array.tabulate (numStates, fn i =>
- * 				       if Array.sub (final, i)
- * 					  then finRep
- * 				       else nonfinRep)
- * 	       fun rep s = Array.sub (r, s)
- * 	       fun trans (s, c) = rep (Array2.sub (next, s, c))
- * 	       fun refine (class: class, ac: classes): classes =
- * 		  let
- * 		     val r =
- * 			List.fold
- * 			(class, [], fn (state, classes) =>
- * 			 let
- * 			    fun loop (classes, ac) =
- * 			       case classes of
- * 				  [] =>
- * 				     (case ac of
- * 					 [] => [{class = [state],
- * 						 old = state}]
- * 				       | _ => 
- * 					    let
- * 					       val s = newRep ()
- * 					       val _ = Array.update (r, state, s)
- * 					    in {class = [state],
- * 						old = state} :: ac
- * 					    end)
- * 				| (z as {class, old}) :: classes =>
- * 				     if Int.forall
- * 					(0, numCharClasses, fn c =>
- * 					 trans (old, c) = trans (state, c))
- * 					then
- * 					   (Array.update (r, state, rep old)
- * 					    ; {class = state :: class,
- * 					       old = old} :: (List.appendRev
- * 							      (classes, ac)))
- * 				     else loop (classes, z :: ac)
- * 			 in loop (classes, [])
- * 			 end)
- * 		  in List.fold (r, ac, fn ({class, ...}, ac) =>
- * 				case class of
- * 				   [_] => ac
- * 				 | _ => class :: ac)
- * 		  end
- * 	       val refine =
- * 		  Trace.trace ("refine",
- * 			       (List.layout Int.layout o #1),
- * 			       Layout.ignore)
- * 		  refine
- * 	       fun refineAll (classes: classes): unit =
- * 		  case classes of
- * 		     [] => ()
- * 		   | _ =>
- * 			let
- * 			   val _ = change := false
- * 			   val classes =
- * 			      List.fold (classes, [], fn (class, ac) =>
- * 					 case class of
- * 					    [_] => ac
- * 					  | _ => refine (class, ac))
- * 			in if !change
- * 			      then refineAll classes
- * 			   else ()
- * 			end
- * 	       val (fin, nonfin) =
- * 		  Int.fold (0, numStates, ([], []), fn (i, (f, n)) =>
- * 			    if Array.sub (final, i)
- * 			       then (i :: f, n)
- * 			    else (f, i :: n))
- * 	       val _ = refineAll [fin, nonfin]
- * 	       val numStates' = 1 + !repCounter
- * 	       (* Compute reachable states. *)
- * 	       val reached = Array.new (numStates', false)
- * 	       fun visit (s: int (* an old state *)): unit =
- * 		  let
- * 		     val s' = rep s
- * 		  in
- * 		     if Array.sub (reached, s')
- * 			then ()
- * 		     else (Array.update (reached, s', true)
- * 			   ; Int.for (0, numCharClasses, fn c =>
- * 				      visit (Array2.sub (next, s, c))))
- * 		  end
- * 	       val _ = visit start
- * 	       val _ = visit anchorStart
- * 	       (* Compute new representatives. *)
- * 	       val c = ref ~1
- * 	       val newR = Array.tabulate (numStates', fn s =>
- * 					  if Array.sub (reached, s)
- * 					     then ++ c
- * 					  else ~1)
- * 	       val numStates' = 1 + !c
- * 	       val _ = Array.modify (r, fn s => Array.sub (newR, s))
- * 	       val next' = Array2.new (numStates', numCharClasses, ~1)
- * 	       val _ =
- * 		  Array2.foreachi
- * 		  (next, fn (s, c, s') =>
- * 		   Array2.update (next', rep s, c, rep s'))
- * 	       val final' = Array.array (numStates', false)
- * 	       val _ =
- * 		  Array.foreachi
- * 		  (final, fn (i, b) =>
- * 		   if b then Array.update (final', rep i, true) else ())
- * 	    in T {anchorStart = rep anchorStart,
- * 		  charClass = charClass,
- * 		  dead = dead (numStates', numCharClasses, final', next'),
- * 		  final = final',
- * 		  start = rep start,
- * 		  next = next'}
- * 	    end
+         fun minimize d = d
+         (* This DFA minimization algorithm is based on algorithm 3.6 (page 142)
+          * of the Dragon Book.
+          *
+          * It maintains an array, r, that stores for each state s the
+          * representative of the class to which s belongs.
+          * It repeatedly refines an equivalence relation, represented by a list
+          * of classes, where each class is a list of states.
+          *)
+(*       fun minimize (dfa as T {anchorStart, charClass, final,
+ *                               start, next, ...}): t =
+ *          let
+ *             val numStates = numStates dfa
+ *             val numCharClasses = numCharClasses dfa
+ *             type class = int list
+ *             type classes = class list
+ *             val repCounter = ref ~1
+ *             val change = ref false
+ *             fun newRep () = (change := true; ++ repCounter)
+ *             val finRep = newRep ()
+ *             val nonfinRep = newRep ()
+ *             val r = Array.tabulate (numStates, fn i =>
+ *                                     if Array.sub (final, i)
+ *                                        then finRep
+ *                                     else nonfinRep)
+ *             fun rep s = Array.sub (r, s)
+ *             fun trans (s, c) = rep (Array2.sub (next, s, c))
+ *             fun refine (class: class, ac: classes): classes =
+ *                let
+ *                   val r =
+ *                      List.fold
+ *                      (class, [], fn (state, classes) =>
+ *                       let
+ *                          fun loop (classes, ac) =
+ *                             case classes of
+ *                                [] =>
+ *                                   (case ac of
+ *                                       [] => [{class = [state],
+ *                                               old = state}]
+ *                                     | _ => 
+ *                                          let
+ *                                             val s = newRep ()
+ *                                             val _ = Array.update (r, state, s)
+ *                                          in {class = [state],
+ *                                              old = state} :: ac
+ *                                          end)
+ *                              | (z as {class, old}) :: classes =>
+ *                                   if Int.forall
+ *                                      (0, numCharClasses, fn c =>
+ *                                       trans (old, c) = trans (state, c))
+ *                                      then
+ *                                         (Array.update (r, state, rep old)
+ *                                          ; {class = state :: class,
+ *                                             old = old} :: (List.appendRev
+ *                                                            (classes, ac)))
+ *                                   else loop (classes, z :: ac)
+ *                       in loop (classes, [])
+ *                       end)
+ *                in List.fold (r, ac, fn ({class, ...}, ac) =>
+ *                              case class of
+ *                                 [_] => ac
+ *                               | _ => class :: ac)
+ *                end
+ *             val refine =
+ *                Trace.trace ("refine",
+ *                             (List.layout Int.layout o #1),
+ *                             Layout.ignore)
+ *                refine
+ *             fun refineAll (classes: classes): unit =
+ *                case classes of
+ *                   [] => ()
+ *                 | _ =>
+ *                      let
+ *                         val _ = change := false
+ *                         val classes =
+ *                            List.fold (classes, [], fn (class, ac) =>
+ *                                       case class of
+ *                                          [_] => ac
+ *                                        | _ => refine (class, ac))
+ *                      in if !change
+ *                            then refineAll classes
+ *                         else ()
+ *                      end
+ *             val (fin, nonfin) =
+ *                Int.fold (0, numStates, ([], []), fn (i, (f, n)) =>
+ *                          if Array.sub (final, i)
+ *                             then (i :: f, n)
+ *                          else (f, i :: n))
+ *             val _ = refineAll [fin, nonfin]
+ *             val numStates' = 1 + !repCounter
+ *             (* Compute reachable states. *)
+ *             val reached = Array.new (numStates', false)
+ *             fun visit (s: int (* an old state *)): unit =
+ *                let
+ *                   val s' = rep s
+ *                in
+ *                   if Array.sub (reached, s')
+ *                      then ()
+ *                   else (Array.update (reached, s', true)
+ *                         ; Int.for (0, numCharClasses, fn c =>
+ *                                    visit (Array2.sub (next, s, c))))
+ *                end
+ *             val _ = visit start
+ *             val _ = visit anchorStart
+ *             (* Compute new representatives. *)
+ *             val c = ref ~1
+ *             val newR = Array.tabulate (numStates', fn s =>
+ *                                        if Array.sub (reached, s)
+ *                                           then ++ c
+ *                                        else ~1)
+ *             val numStates' = 1 + !c
+ *             val _ = Array.modify (r, fn s => Array.sub (newR, s))
+ *             val next' = Array2.new (numStates', numCharClasses, ~1)
+ *             val _ =
+ *                Array2.foreachi
+ *                (next, fn (s, c, s') =>
+ *                 Array2.update (next', rep s, c, rep s'))
+ *             val final' = Array.array (numStates', false)
+ *             val _ =
+ *                Array.foreachi
+ *                (final, fn (i, b) =>
+ *                 if b then Array.update (final', rep i, true) else ())
+ *          in T {anchorStart = rep anchorStart,
+ *                charClass = charClass,
+ *                dead = dead (numStates', numCharClasses, final', next'),
+ *                final = final',
+ *                start = rep start,
+ *                next = next'}
+ *          end
  *)
       end
 in
    structure Regexp: REGEXP =
       struct
-	 structure Save = Save
-	 structure Match = Match
-	    
-	 open Regexp
+         structure Save = Save
+         structure Match = Match
+            
+         open Regexp
 
-	 val anchorFinish = AnchorFinish
-	 val anchorStart = AnchorStart
-	 val isChar = CharSet
-	 fun isNotChar f = isChar (not o f)
-	 fun char c = isChar (fn c' => c = c')
-	 fun notChar c = isChar (fn c' => c <> c')
-	 val or = Or
-	 val save = Save
-	 val seq = Seq
-	 val star = Star
-	 val zeroOrMore = star
+         val anchorFinish = AnchorFinish
+         val anchorStart = AnchorStart
+         val isChar = CharSet
+         fun isNotChar f = isChar (not o f)
+         fun char c = isChar (fn c' => c = c')
+         fun notChar c = isChar (fn c' => c <> c')
+         val or = Or
+         val save = Save
+         val seq = Seq
+         val star = Star
+         val zeroOrMore = star
 
-	 val dquote = char #"\""
+         val dquote = char #"\""
 
-	 val any = isChar (fn _ => true)
-	 val anys = star any
-	 val ascii = isChar (fn c => ord c <= 127)
-	 val asciis = star ascii
+         val any = isChar (fn _ => true)
+         val anys = star any
+         val ascii = isChar (fn c => ord c <= 127)
+         val asciis = star ascii
 
-	 val none = isChar (fn _ => false)
-	 fun oneOf s = isChar (fn c => String.contains (s, c))
-	 fun notOneOf s = isNotChar (fn c => String.contains (s, c))
-	 val digit = isChar Char.isDigit
-	 val digits = star digit
-	 val nonDigit = isNotChar Char.isDigit
-	 val space = isChar Char.isSpace
-	 val spaces = star space
+         val none = isChar (fn _ => false)
+         fun oneOf s = isChar (fn c => String.contains (s, c))
+         fun notOneOf s = isNotChar (fn c => String.contains (s, c))
+         val digit = isChar Char.isDigit
+         val digits = star digit
+         val nonDigit = isNotChar Char.isDigit
+         val space = isChar Char.isSpace
+         val spaces = star space
 
-	 fun string (s: string): t =
-	    seq (Int.foldDown (0, String.size s, [], fn (i, ac) =>
-			       char (String.sub (s, i)) :: ac))
+         fun string (s: string): t =
+            seq (Int.foldDown (0, String.size s, [], fn (i, ac) =>
+                               char (String.sub (s, i)) :: ac))
 
-	 fun stringIgnoreCase (s: string): t =
-	    seq (Int.foldDown
-		 (0, String.size s, [], fn (i, ac) =>
-		  let
-		     val c = Char.toLower (String.sub (s, i))
-		  in
-		     isChar (fn c' => c = Char.toLower c')
-		  end :: ac))
+         fun stringIgnoreCase (s: string): t =
+            seq (Int.foldDown
+                 (0, String.size s, [], fn (i, ac) =>
+                  let
+                     val c = Char.toLower (String.sub (s, i))
+                  in
+                     isChar (fn c' => c = Char.toLower c')
+                  end :: ac))
 
-	 val null = seq [] (* Language containing the empty string only. *)
-	 fun oneOrMore r = seq [r, star r]
-	 fun optional r = or [null, r]
-	 fun repeat (r, n: int) = seq (List.tabulate (n, fn _ => r))
-	 fun lower (r, n: int) = seq [repeat (r, n), star r]
-	 fun upper (r, n: int) =
-	    if n <= 0
-	       then null
-	    else or [null, seq [r, upper (r, n - 1)]]
-	 fun range (r, n: int, m: int) =
-	    seq [repeat (r, n), upper (r, m - n)]
-	    
-	 structure Compiled =
-	    struct
-	       datatype machine =
-		  DFA of DFA.t
-		| NFA of NFA.t
+         val null = seq [] (* Language containing the empty string only. *)
+         fun oneOrMore r = seq [r, star r]
+         fun optional r = or [null, r]
+         fun repeat (r, n: int) = seq (List.tabulate (n, fn _ => r))
+         fun lower (r, n: int) = seq [repeat (r, n), star r]
+         fun upper (r, n: int) =
+            if n <= 0
+               then null
+            else or [null, seq [r, upper (r, n - 1)]]
+         fun range (r, n: int, m: int) =
+            seq [repeat (r, n), upper (r, m - n)]
+            
+         structure Compiled =
+            struct
+               datatype machine =
+                  DFA of DFA.t
+                | NFA of NFA.t
 
-	       datatype t = T of {regexp: Regexp.t,
-				  machine: machine}
+               datatype t = T of {regexp: Regexp.t,
+                                  machine: machine}
 
-	       fun layoutDot (T {machine, ...}) =
-		  case machine of
-		     DFA m => DFA.layoutDot {dfa = m, showDead = false,
-					     title = "dfa"}
-		   | NFA m => NFA.layoutDot (m, "nfa")
+               fun layoutDot (T {machine, ...}) =
+                  case machine of
+                     DFA m => DFA.layoutDot {dfa = m, showDead = false,
+                                             title = "dfa"}
+                   | NFA m => NFA.layoutDot (m, "nfa")
 
-	       fun layoutDotToFile (c: t, f: File.t) =
-		  File.withOut (f, fn out => Layout.output (layoutDot c, out))
+               fun layoutDotToFile (c: t, f: File.t) =
+                  File.withOut (f, fn out => Layout.output (layoutDot c, out))
 
-	       fun layout (T {regexp, ...}) =
-		  let
-		     open Layout
-		  in
-		     Regexp.layout regexp
+               fun layout (T {regexp, ...}) =
+                  let
+                     open Layout
+                  in
+                     Regexp.layout regexp
 (*
-		     align [case machine of
-			       DFA dfa => DFA.layout dfa
-			     | NFA nfa => NFA.layout nfa
-			    (* str "implementing", Regexp.layout regexp *)
-				  ]
+                     align [case machine of
+                               DFA dfa => DFA.layout dfa
+                             | NFA nfa => NFA.layout nfa
+                            (* str "implementing", Regexp.layout regexp *)
+                                  ]
 *)
-		  end
+                  end
 
-	       fun match {compiled = T {machine, ...},
-			  short, startPos, string} =
-		  let
-		     val anchorStart = startPos = 0
-		     val (saves, opt) =
-			case machine of
-			   DFA dfa =>
-			      (DFA.saves dfa,
-			       DFA.match {anchorStart = anchorStart,
-					  dfa = dfa,
-					  short = short,
-					  string = string,
-					  startPos = startPos})
-					  
-			 | NFA nfa =>
-			      (NFA.saves nfa,
-			       NFA.match {nfa = nfa,
-					  short = short,
-					  string = string,
-					  startPos = startPos})
-		     exception No
-		  in
-		     Option.map
-		     (opt, fn (stop, Actions.T actions) =>
-		      let
-			 val _ = Vector.foreachi (saves, fn (i, s) =>
-						  Save.assign (s, i))
-			 val n = Vector.length saves
-			 val starts = Array.array (n, ~1)
-			 val matches = Array.array (n, NONE)
-			 val _ =
-			    List.foreach
-			    (rev actions, fn (i, v) =>
-			     Vector.foreach
-			     (v, fn ma =>
-			      case ma of
-				 MatchAction.Finish s =>
-				    let
-				       val index = Save.index s
-				       val start = Array.sub (starts, index)
-				    in
-				       Array.update
-				       (matches, index,
-					SOME (Substring.substring
-					      (string, {start = start,
-							length = i - start})))
-				    end
-			       | MatchAction.Start s =>
-				    Array.update (starts, Save.index s, i)))
-			 val matches =
-			    Array.keepAllMapi
-			    (matches, fn (i, sso) =>
-			     case sso of
-				NONE => NONE
-			      | SOME ss => SOME (Vector.sub (saves, i), ss))
-			 val all =
-			    Substring.substring
-			    (string, {start = startPos,
-				      length = stop - startPos})
-		      in
-			 Match.T {all = all,
-				  matches = matches}
-		      end) handle No => NONE
-		  end
+               fun match {compiled = T {machine, ...},
+                          short, startPos, string} =
+                  let
+                     val anchorStart = startPos = 0
+                     val (saves, opt) =
+                        case machine of
+                           DFA dfa =>
+                              (DFA.saves dfa,
+                               DFA.match {anchorStart = anchorStart,
+                                          dfa = dfa,
+                                          short = short,
+                                          string = string,
+                                          startPos = startPos})
+                                          
+                         | NFA nfa =>
+                              (NFA.saves nfa,
+                               NFA.match {nfa = nfa,
+                                          short = short,
+                                          string = string,
+                                          startPos = startPos})
+                     exception No
+                  in
+                     Option.map
+                     (opt, fn (stop, Actions.T actions) =>
+                      let
+                         val _ = Vector.foreachi (saves, fn (i, s) =>
+                                                  Save.assign (s, i))
+                         val n = Vector.length saves
+                         val starts = Array.array (n, ~1)
+                         val matches = Array.array (n, NONE)
+                         val _ =
+                            List.foreach
+                            (rev actions, fn (i, v) =>
+                             Vector.foreach
+                             (v, fn ma =>
+                              case ma of
+                                 MatchAction.Finish s =>
+                                    let
+                                       val index = Save.index s
+                                       val start = Array.sub (starts, index)
+                                    in
+                                       Array.update
+                                       (matches, index,
+                                        SOME (Substring.substring
+                                              (string, {start = start,
+                                                        length = i - start})))
+                                    end
+                               | MatchAction.Start s =>
+                                    Array.update (starts, Save.index s, i)))
+                         val matches =
+                            Array.keepAllMapi
+                            (matches, fn (i, sso) =>
+                             case sso of
+                                NONE => NONE
+                              | SOME ss => SOME (Vector.sub (saves, i), ss))
+                         val all =
+                            Substring.substring
+                            (string, {start = startPos,
+                                      length = stop - startPos})
+                      in
+                         Match.T {all = all,
+                                  matches = matches}
+                      end) handle No => NONE
+                  end
 
-	       val match =
-		  Trace.trace
-		  ("Regexp.match",
-		   fn {compiled, short, startPos, string} =>
-		   Layout.record
-		   [("short", Bool.layout short),
-		    ("startPos", Int.layout startPos),
-		    ("string", String.layout string),
-		    ("compiled", layout compiled)],
-		   Option.layout Match.layout)
-		  match
+               val match =
+                  Trace.trace
+                  ("Regexp.Compiled.match",
+                   fn {compiled, short, startPos, string} =>
+                   Layout.record
+                   [("short", Bool.layout short),
+                    ("startPos", Int.layout startPos),
+                    ("string", String.layout string),
+                    ("compiled", layout compiled)],
+                   Option.layout Match.layout)
+                  match
 
-	       fun matchLong (c, s, i) =
-		  match {compiled = c,
-			 short = false,
-			 startPos = i,
-			 string = s}
+               fun matchLong (c, s, i) =
+                  match {compiled = c,
+                         short = false,
+                         startPos = i,
+                         string = s}
 
-	       fun matchShort (c, s, i) =
-		  match {compiled = c,
-			 short = true,
-			 startPos = i,
-			 string = s}
+               fun matchShort (c, s, i) =
+                  match {compiled = c,
+                         short = true,
+                         startPos = i,
+                         string = s}
 
-	       fun matchAll (r, s) =
-		  case matchLong (r, s, 0) of
-		     NONE => NONE
-		   | SOME m => if String.size s = Substring.length (Match.all m)
-				  then SOME m
-			       else NONE
+               fun matchAll (r, s) =
+                  case matchLong (r, s, 0) of
+                     NONE => NONE
+                   | SOME m => if String.size s = Substring.length (Match.all m)
+                                  then SOME m
+                               else NONE
 
-	       val matchesAll = isSome o matchAll
+               val matchesAll = isSome o matchAll
 
-	       fun matchPrefix (r, s) = matchShort (r, s, 0)
+               fun matchPrefix (r, s) = matchShort (r, s, 0)
 
-	       val matchesPrefix = isSome o matchPrefix
+               val matchesPrefix = isSome o matchPrefix
 
-	       fun find (c: t, s: string, startPos, short: bool) =
-		  let
-		     val n = String.size s
-		     fun loop (i: int) =
-			if i >= n
-			   then NONE
-			else
-			   case match {compiled = c,
-				       short = short,
-				       startPos = i,
-				       string = s} of
-			      NONE => loop (i + 1)
-			    | SOME m => SOME m
-		  in loop startPos
-		  end
+               fun find (c: t, s: string, startPos, short: bool) =
+                  let
+                     val n = String.size s
+                     fun loop (i: int) =
+                        if i >= n
+                           then NONE
+                        else
+                           case match {compiled = c,
+                                       short = short,
+                                       startPos = i,
+                                       string = s} of
+                              NONE => loop (i + 1)
+                            | SOME m => SOME m
+                  in loop startPos
+                  end
 
-	       fun findLong (c, s, i) = find (c, s, i, false)
-	       fun findShort (c, s, i) = find (c, s, i, true)
+               fun findLong (c, s, i) = find (c, s, i, false)
+               fun findShort (c, s, i) = find (c, s, i, true)
 
-	       fun foreachMatchShort (c, s, f) =
-		  let
-		     fun loop i =
-			case findShort (c, s, i) of
-			   NONE => ()
-			 | SOME m => (f m; loop (Match.endOf m))
-		  in
-		     loop 0
-		  end
-	    end
+               fun foreachMatchShort (c, s, f: Match.t -> unit) =
+                  let
+                     fun loop i =
+                        case findShort (c, s, i) of
+                           NONE => ()
+                         | SOME m => (f m; loop (Match.endOf m))
+                  in
+                     loop 0
+                  end
+            end
 
-	 fun compileDFA r =
-	    let
-	       val nfa = NFA.fromRegexp r
-	    in
-	       Compiled.T
-	       {regexp = r,
-		machine = Compiled.DFA (DFA.minimize (DFA.fromNFA nfa))}
-	    end
+         fun compileDFA r =
+            let
+               val nfa = NFA.fromRegexp r
+            in
+               Compiled.T
+               {regexp = r,
+                machine = Compiled.DFA (DFA.minimize (DFA.fromNFA nfa))}
+            end
 
-	 val compileDFA =
-	    Trace.trace ("Regexp.compileDFA", layout, Compiled.layout) compileDFA
+         val compileDFA =
+            Trace.trace ("Regexp.compileDFA", layout, Compiled.layout) compileDFA
 
-	 fun compileNFA r =
-	    Compiled.T
-	    {regexp = r,
-	     machine = Compiled.NFA (NFA.fromRegexp r)}
+         fun compileNFA r =
+            Compiled.T
+            {regexp = r,
+             machine = Compiled.NFA (NFA.fromRegexp r)}
 
-	 val compileNFA =
-	    Trace.trace ("Regexp.compileNFA", layout, Compiled.layout) compileNFA
+         val compileNFA =
+            Trace.trace ("Regexp.compileNFA", layout, Compiled.layout) compileNFA
 
          (* POSIX 1003.2 regular expressions 
-	  *  caveats: does not support back references '\N'
-	  *           does not support unmatched ')'
-	  *           does not support '[=' style coallating elements
-	  *           does not support coallating elements as range endpoints
-	  * 
-	  * grammar:
-	  *    S ::= Re
+          *  caveats: does not support back references '\N'
+          *           does not support unmatched ')'
+          *           does not support '[=' style coallating elements
+          *           does not support coallating elements as range endpoints
+          * 
+          * grammar:
+          *    S ::= Re
           *   Re ::= Br Re0
-	  *  Re0 ::= e | '|' Br Re0
-	  *   Br ::= P Br0
-	  *  Br0 ::= e | P Br0
-	  *    P ::= A P0
-	  *   P0 ::= e | '*' | '+' | '?' | Bnd
-	  *  Bnd ::= '{' N Bnd0 '}'
+          *  Re0 ::= e | '|' Br Re0
+          *   Br ::= P Br0
+          *  Br0 ::= e | P Br0
+          *    P ::= A P0
+          *   P0 ::= e | '*' | '+' | '?' | Bnd
+          *  Bnd ::= '{' N Bnd0 '}'
           * Bnd0 ::= e | ',' Bnd1
           * Bnd1 ::= e | N
           *    A ::= '(' Re ')'
           *        | '()'
           *        | '[' Be ']'
-	  *        | '.'
+          *        | '.'
           *        | '^'
           *        | '$'
           *        | '\' C
@@ -1672,318 +1674,318 @@
           *   Cl ::= 'alnum' | ... | 'xdigit'
           *)
          local
-	    exception X of string
-	    type res = t * Save.t vector
+            exception X of string
+            type res = t * Save.t vector
 
-	    fun S (s: char list) : res =
-	       Re (s, fn (s, re, saves) =>
-		   case s of
-		      [] => (re, saves)
-		    | _ => raise (X "S"))
-	    and Re (s: char list,
-		    k: char list * t * Save.t vector -> res) =
-	       Br (s, fn (s, re, saves) => 
-		   Re0 (s, [re], [saves], k))
-	    and Re0 (s: char list, res: t list, savess: Save.t vector list,
-		     k: char list * t * Save.t vector -> res) =
-	       let
-		  fun finish s =
-		     k (s, or (List.rev res), Vector.concat (List.rev savess))
-	       in
-		  case s of
-		     [] => finish s
-		   | #")"::_ => finish s
-		   | #"|"::s => Br (s, fn (s, re, saves) =>
-				    Re0 (s, re::res, saves::savess, k))
-		   | _ => raise (X "Re0")
-	       end
-	    and Br (s: char list,
-		    k: char list * t * Save.t vector -> res) =
-	       P (s, fn (s, re, saves) => 
-		  Br0 (s, [re], [saves], k))
-	    and Br0 (s: char list, res: t list, savess: Save.t vector list,
-		     k: char list * t * Save.t vector -> res) = 
-	       let
-		  fun finish s =
-		     k (s, seq (List.rev res), Vector.concat (List.rev savess))
-	       in
-		  case s of
-		     [] => finish s
-		   | #")"::_ => finish s
-		   | #"|"::_ => finish s
-		   | _ => P (s, fn (s, re, saves) => 
-			     Br0 (s, re::res, saves::savess, k))
-	       end
-	    and P (s: char list,
-		   k: char list * t * Save.t vector -> res) =
-	       A (s, fn (s, re, saves) => P0 (s, re, saves, [], [], k))
-	    and P0 (s: char list, 
-		    re: t, saves: Save.t vector,
-		    res: t list, savess: Save.t vector list,
-		    k: char list * t * Save.t vector -> res) =
-	       let
-		  fun finish (s, re) =
-		     k (s, seq (List.rev (re::res)), 
-			Vector.concat (List.rev (saves::savess)))
-		  fun default () =
-		     let
-		        val res = re::res
-			val savess = saves::savess
-		     in
-		        A (s, fn (s, re, saves) =>
-			   P0 (s, re, saves, res, savess, k))
-		     end
-	       in
-		  case s of 
-		     [] => finish (s, re)
-		   | #")"::_ => finish (s, re)
-		   | #"|"::_ => finish (s, re)
-		   | #"*"::s => finish (s, star re)
-		   | #"+"::s => finish (s, oneOrMore re)
-		   | #"?"::s => finish (s, optional re)
-		   | #"{"::(c::s) => if Char.isDigit c
-		                        then Bnd (c::s, fn (s, f) =>
-						  finish (s, f re))
-				     else default ()
-		   | _ => default ()
-	       end
-	    and Bnd (s: char list,
-		     k: char list * (t -> t) -> res) =
-	       N (s, fn (s, n) =>
-		  Bnd0 (s, n, fn (s, f) =>
-			case s of 
-			   #"}"::s => k (s, f)
-			 | _ => raise (X "Bnd")))
-	    and Bnd0 (s: char list, n: int,
-		      k: char list * (t -> t) -> res) =
-	       let
-		  fun finish (s, f) = k (s, f)
-	       in
-		  case s of
-		     #"}"::_ => finish (s, fn re => repeat (re, n))
-		   | #","::s => Bnd1 (s, n, k)
-		   | _ => raise (X "Bnd0")
-	       end
-	    and Bnd1 (s: char list, n: int, 
-		      k: char list * (t -> t) -> res) =
-	       let
-		  fun finish (s, f) = k (s, f)
-	       in
-		  case s of 
-		     #"}"::_ => finish (s, fn re => lower (re, n))
-		   | _ => N (s, fn (s, m) =>
-			     if m < n
-			        then raise (X "Bnd1")
-			     else finish (s, fn re => range (re, n, m)))
-	       end
-	    and N (s: char list,
-		   k: char list * int -> res) =
-	       let
-	       in
-		  case s of
-		     d::s' => (case Char.digitToInt d of
-				  SOME d => N1 (s', d, k)
-				| NONE => raise (X "N"))
-		     | _ => raise (X "N")
-	       end
-	    and N1 (s: char list, n: int,
-		    k: char list * int -> res) =
-	       let
-		  fun finish s =
-		     k (s, n)
-	       in
-		  case s of
-		     [] => finish s
-		   | d::s' => (case Char.digitToInt d of
-				  SOME d => N1 (s', n * 10 + d, k)
-				| NONE => finish s)
-	       end
-	    and A (s: char list,
-		   k: char list * t * Save.t vector -> res) =
-	       let
-		  fun finish (s, re, saves) =
-		     k (s, re, saves)
-		  fun finishR (s, re) =
-		     finish (s, re, Vector.new0 ())
-		  fun finishN s =
-		     finishR (s, null)
-		  fun finishC (s, c) =
-		     finishR (s, char c)
-	       in
-		  case s of 
-		     #"("::(#")"::s) => finishN s
-		   | #"("::s => let
-				   val save' = Save.new ()
-				in
-				   Re (s, fn (s, re, saves) =>
-				       case s of
-					  #")"::s => k (s, save (re, save'),
-							Vector.concat
-							[Vector.new1 save', saves])
-					| _ => raise (X "A"))
-				end
-		   | #"["::s => let
-				in
-				   Be (s, fn (s, re) => 
-				       case s of
-					  #"]"::s => finishR (s, re)
-				        | _ => raise (X "A"))
-				end
-		   | #"."::s => finishR (s, any)
-		   | #"^"::s => finishR (s, anchorStart)
-		   | #"$"::s => finishR (s, anchorFinish)
-		   | #"\\"::(c::s) => finishC (s, c)
-		   | c::s => if String.contains (")|*+?{", c)
-				then raise (X "A")
-			     else finishC (s, c)
-		   | _ => raise (X "A")
-	       end
-	    and Be (s: char list,
-	            k: char list * t -> res) =
-	       Be0 (s, k)
-	    and Be0 (s: char list,
-		     k: char list * t -> res) =
-	       let
-	       in
-		  case s of
-		     #"^"::s => Be1 (s, true, k)
-		   | _ => Be1 (s, false, k)
-	       end
-	    and Be1 (s: char list, inv: bool,
-		     k: char list * t -> res) =
-	       let
-	       in
-		  case s of 
-		     #"]"::s => Be2 (s, inv, [#"]"], k)
-		   | _ => Be2 (s, inv, [], k)
-	       end
-	    and Be2 (s: char list, inv: bool, cs: char list,
-		     k: char list * t -> res) =
-	       let
-	       in
-		  case s of 
-		     #"-"::s => Be3 (s, inv, #"-"::cs, [], [], k)
-		   | _ => Be3 (s, inv, cs, [], [], k)
-	       end
-	    and Be3 (s: char list, inv: bool,
-		     cs: char list, cps: (char -> bool) list, ces: string list,
-		     k: char list * t -> res) =
-	       let
-		 fun finish (s: char list,
-			     cs: char list,
-			     cps: (char -> bool) list,
-			     ces: string list) =
-		    let
-		       fun finish' re = k (s, re)
-		       val s = implode cs
-		       val cp = fn c => List.exists (cps, fn cp => cp c)
-		    in
-		       if inv
-		          then
-			     (case ces of
-				 [] =>
-				    finish'
-				    (isNotChar
-				     (fn c =>
-				      cp c orelse String.contains (s, c)))
-			       | _ => Error.bug "Regexp.fromString can't handle collating elements in negated bracket expressions")
-		       else finish' (List.fold
-				     (ces, or [isChar cp,
-					       oneOf s],
-				      fn (ce, re) =>
-				      or [string ce, re]))
-		    end
-	       in
-		  case s of
-		     #"]"::_ => finish (s, cs, cps, ces)
-		   | #"-"::s => (case s of
-				    #"]"::_ => finish (s, #"-"::cs, cps, ces)
-				  | _ => raise (X "Be3"))
-		   | c1::(#"-"::(c2::s)) => 
-		        let
-			   val r1 = Char.ord c1
-			   val r2 = Char.ord c2
-			   val cp = fn c =>
-			            let val r = Char.ord c
-				    in r1 <= r andalso r <= r2
-				    end
-			in 
-			   Be3 (s, inv, cs, cp::cps, ces, k)
-			end
-		   | #"["::(#"."::s) =>
-			Ce (s, [], fn (s, ce) =>
-			    case s of
-			       #"."::(#"]"::s) => Be3 (s, inv, cs, cps, ce::ces, k)
-			     | _ => raise (X "Be3"))
-		   | #"["::(#":"::s) =>
-			Cl (s, fn (s, cp) =>
-			    case s of
-			       #":"::(#"]"::s) => Be3 (s, inv, cs, cp::cps, ces, k)
-			     | _ => raise (X "Be3"))
-		   | c::s => Be3 (s, inv, c::cs, cps, ces, k)
-		   | _ => raise (X "Be3")
-	       end
-	    and Ce (s: char list, ce: char list,
-		    k: char list * string -> res) =
-	       let
-		 fun finish s =
-		    k (s, implode (List.rev ce))
-	       in
-		 case s of
-		    #"."::_ => finish s
-		  | c::s => Ce (s, c::ce, k)
-		  | _ => raise (X "Ce")
-	       end
-	    and Cl (s: char list,
-		    k: char list * (char -> bool) -> res) =
-	       let
-	       in
-		 case s of
-		    #"a"::(#"l"::(#"n"::(#"u"::(#"m"::s)))) => 
-		       k (s, Char.isAlphaNum)
-		  | #"a"::(#"l"::(#"p"::(#"h"::(#"a"::s)))) => 
-		       k (s, Char.isAlpha)
-		  | #"b"::(#"l"::(#"a"::(#"n"::(#"k"::_)))) => 
-		       raise (X "Cl:blank")
-		  | #"c"::(#"n"::(#"t"::(#"r"::(#"l"::s)))) => 
-		       k (s, Char.isCntrl)
-		  | #"d"::(#"i"::(#"g"::(#"i"::(#"t"::s)))) => 
-		       k (s, Char.isDigit)
-		  | #"g"::(#"r"::(#"a"::(#"p"::(#"h"::s)))) => 
-		       k (s, Char.isGraph)
-		  | #"l"::(#"o"::(#"w"::(#"e"::(#"r"::s)))) => 
-		       k (s, Char.isLower)
-		  | #"p"::(#"r"::(#"i"::(#"n"::(#"t"::s)))) => 
-		       k (s, Char.isPrint)
-		  | #"p"::(#"u"::(#"n"::(#"c"::(#"t"::_)))) => 
-		       raise (X "Cl:punct")
-		  | #"s"::(#"p"::(#"a"::(#"c"::(#"e"::s)))) => 
-		       k (s, Char.isSpace)
-		  | #"u"::(#"p"::(#"p"::(#"e"::(#"r"::s)))) => 
-		       k (s, Char.isUpper)
-		  | #"x"::(#"d"::(#"i"::(#"g"::(#"i"::(#"t"::s))))) => 
-		       k (s, Char.isHexDigit)
-		  | _ => raise (X "Cl")
-	       end
-	 in
-	    val fromString: string -> (t * Save.t vector) option =
-	       fn s => (SOME (S (explode s))) handle X _ => NONE
-	    val fromString =
-	       Trace.trace ("Regexp.fromString",
-			    String.layout,
-			    Option.layout (layout o #1))
-	       fromString
-	 end
+            fun S (s: char list) : res =
+               Re (s, fn (s, re, saves) =>
+                   case s of
+                      [] => (re, saves)
+                    | _ => raise (X "S"))
+            and Re (s: char list,
+                    k: char list * t * Save.t vector -> res) =
+               Br (s, fn (s, re, saves) => 
+                   Re0 (s, [re], [saves], k))
+            and Re0 (s: char list, res: t list, savess: Save.t vector list,
+                     k: char list * t * Save.t vector -> res) =
+               let
+                  fun finish s =
+                     k (s, or (List.rev res), Vector.concat (List.rev savess))
+               in
+                  case s of
+                     [] => finish s
+                   | #")"::_ => finish s
+                   | #"|"::s => Br (s, fn (s, re, saves) =>
+                                    Re0 (s, re::res, saves::savess, k))
+                   | _ => raise (X "Re0")
+               end
+            and Br (s: char list,
+                    k: char list * t * Save.t vector -> res) =
+               P (s, fn (s, re, saves) => 
+                  Br0 (s, [re], [saves], k))
+            and Br0 (s: char list, res: t list, savess: Save.t vector list,
+                     k: char list * t * Save.t vector -> res) = 
+               let
+                  fun finish s =
+                     k (s, seq (List.rev res), Vector.concat (List.rev savess))
+               in
+                  case s of
+                     [] => finish s
+                   | #")"::_ => finish s
+                   | #"|"::_ => finish s
+                   | _ => P (s, fn (s, re, saves) => 
+                             Br0 (s, re::res, saves::savess, k))
+               end
+            and P (s: char list,
+                   k: char list * t * Save.t vector -> res) =
+               A (s, fn (s, re, saves) => P0 (s, re, saves, [], [], k))
+            and P0 (s: char list, 
+                    re: t, saves: Save.t vector,
+                    res: t list, savess: Save.t vector list,
+                    k: char list * t * Save.t vector -> res) =
+               let
+                  fun finish (s, re) =
+                     k (s, seq (List.rev (re::res)), 
+                        Vector.concat (List.rev (saves::savess)))
+                  fun default () =
+                     let
+                        val res = re::res
+                        val savess = saves::savess
+                     in
+                        A (s, fn (s, re, saves) =>
+                           P0 (s, re, saves, res, savess, k))
+                     end
+               in
+                  case s of 
+                     [] => finish (s, re)
+                   | #")"::_ => finish (s, re)
+                   | #"|"::_ => finish (s, re)
+                   | #"*"::s => finish (s, star re)
+                   | #"+"::s => finish (s, oneOrMore re)
+                   | #"?"::s => finish (s, optional re)
+                   | #"{"::(c::s) => if Char.isDigit c
+                                        then Bnd (c::s, fn (s, f) =>
+                                                  finish (s, f re))
+                                     else default ()
+                   | _ => default ()
+               end
+            and Bnd (s: char list,
+                     k: char list * (t -> t) -> res) =
+               N (s, fn (s, n) =>
+                  Bnd0 (s, n, fn (s, f) =>
+                        case s of 
+                           #"}"::s => k (s, f)
+                         | _ => raise (X "Bnd")))
+            and Bnd0 (s: char list, n: int,
+                      k: char list * (t -> t) -> res) =
+               let
+                  fun finish (s, f) = k (s, f)
+               in
+                  case s of
+                     #"}"::_ => finish (s, fn re => repeat (re, n))
+                   | #","::s => Bnd1 (s, n, k)
+                   | _ => raise (X "Bnd0")
+               end
+            and Bnd1 (s: char list, n: int, 
+                      k: char list * (t -> t) -> res) =
+               let
+                  fun finish (s, f) = k (s, f)
+               in
+                  case s of 
+                     #"}"::_ => finish (s, fn re => lower (re, n))
+                   | _ => N (s, fn (s, m) =>
+                             if m < n
+                                then raise (X "Bnd1")
+                             else finish (s, fn re => range (re, n, m)))
+               end
+            and N (s: char list,
+                   k: char list * int -> res) =
+               let
+               in
+                  case s of
+                     d::s' => (case Char.digitToInt d of
+                                  SOME d => N1 (s', d, k)
+                                | NONE => raise (X "N"))
+                     | _ => raise (X "N")
+               end
+            and N1 (s: char list, n: int,
+                    k: char list * int -> res) =
+               let
+                  fun finish s =
+                     k (s, n)
+               in
+                  case s of
+                     [] => finish s
+                   | d::s' => (case Char.digitToInt d of
+                                  SOME d => N1 (s', n * 10 + d, k)
+                                | NONE => finish s)
+               end
+            and A (s: char list,
+                   k: char list * t * Save.t vector -> res) =
+               let
+                  fun finish (s, re, saves) =
+                     k (s, re, saves)
+                  fun finishR (s, re) =
+                     finish (s, re, Vector.new0 ())
+                  fun finishN s =
+                     finishR (s, null)
+                  fun finishC (s, c) =
+                     finishR (s, char c)
+               in
+                  case s of 
+                     #"("::(#")"::s) => finishN s
+                   | #"("::s => let
+                                   val save' = Save.new ()
+                                in
+                                   Re (s, fn (s, re, saves) =>
+                                       case s of
+                                          #")"::s => k (s, save (re, save'),
+                                                        Vector.concat
+                                                        [Vector.new1 save', saves])
+                                        | _ => raise (X "A"))
+                                end
+                   | #"["::s => let
+                                in
+                                   Be (s, fn (s, re) => 
+                                       case s of
+                                          #"]"::s => finishR (s, re)
+                                        | _ => raise (X "A"))
+                                end
+                   | #"."::s => finishR (s, any)
+                   | #"^"::s => finishR (s, anchorStart)
+                   | #"$"::s => finishR (s, anchorFinish)
+                   | #"\\"::(c::s) => finishC (s, c)
+                   | c::s => if String.contains (")|*+?{", c)
+                                then raise (X "A")
+                             else finishC (s, c)
+                   | _ => raise (X "A")
+               end
+            and Be (s: char list,
+                    k: char list * t -> res) =
+               Be0 (s, k)
+            and Be0 (s: char list,
+                     k: char list * t -> res) =
+               let
+               in
+                  case s of
+                     #"^"::s => Be1 (s, true, k)
+                   | _ => Be1 (s, false, k)
+               end
+            and Be1 (s: char list, inv: bool,
+                     k: char list * t -> res) =
+               let
+               in
+                  case s of 
+                     #"]"::s => Be2 (s, inv, [#"]"], k)
+                   | _ => Be2 (s, inv, [], k)
+               end
+            and Be2 (s: char list, inv: bool, cs: char list,
+                     k: char list * t -> res) =
+               let
+               in
+                  case s of 
+                     #"-"::s => Be3 (s, inv, #"-"::cs, [], [], k)
+                   | _ => Be3 (s, inv, cs, [], [], k)
+               end
+            and Be3 (s: char list, inv: bool,
+                     cs: char list, cps: (char -> bool) list, ces: string list,
+                     k: char list * t -> res) =
+               let
+                 fun finish (s: char list,
+                             cs: char list,
+                             cps: (char -> bool) list,
+                             ces: string list) =
+                    let
+                       fun finish' re = k (s, re)
+                       val s = implode cs
+                       val cp = fn c => List.exists (cps, fn cp => cp c)
+                    in
+                       if inv
+                          then
+                             (case ces of
+                                 [] =>
+                                    finish'
+                                    (isNotChar
+                                     (fn c =>
+                                      cp c orelse String.contains (s, c)))
+                               | _ => Error.bug "Regexp.fromString: can't handle collating elements in negated bracket expressions")
+                       else finish' (List.fold
+                                     (ces, or [isChar cp,
+                                               oneOf s],
+                                      fn (ce, re) =>
+                                      or [string ce, re]))
+                    end
+               in
+                  case s of
+                     #"]"::_ => finish (s, cs, cps, ces)
+                   | #"-"::s => (case s of
+                                    #"]"::_ => finish (s, #"-"::cs, cps, ces)
+                                  | _ => raise (X "Be3"))
+                   | c1::(#"-"::(c2::s)) => 
+                        let
+                           val r1 = Char.ord c1
+                           val r2 = Char.ord c2
+                           val cp = fn c =>
+                                    let val r = Char.ord c
+                                    in r1 <= r andalso r <= r2
+                                    end
+                        in 
+                           Be3 (s, inv, cs, cp::cps, ces, k)
+                        end
+                   | #"["::(#"."::s) =>
+                        Ce (s, [], fn (s, ce) =>
+                            case s of
+                               #"."::(#"]"::s) => Be3 (s, inv, cs, cps, ce::ces, k)
+                             | _ => raise (X "Be3"))
+                   | #"["::(#":"::s) =>
+                        Cl (s, fn (s, cp) =>
+                            case s of
+                               #":"::(#"]"::s) => Be3 (s, inv, cs, cp::cps, ces, k)
+                             | _ => raise (X "Be3"))
+                   | c::s => Be3 (s, inv, c::cs, cps, ces, k)
+                   | _ => raise (X "Be3")
+               end
+            and Ce (s: char list, ce: char list,
+                    k: char list * string -> res) =
+               let
+                 fun finish s =
+                    k (s, implode (List.rev ce))
+               in
+                 case s of
+                    #"."::_ => finish s
+                  | c::s => Ce (s, c::ce, k)
+                  | _ => raise (X "Ce")
+               end
+            and Cl (s: char list,
+                    k: char list * (char -> bool) -> res) =
+               let
+               in
+                 case s of
+                    #"a"::(#"l"::(#"n"::(#"u"::(#"m"::s)))) => 
+                       k (s, Char.isAlphaNum)
+                  | #"a"::(#"l"::(#"p"::(#"h"::(#"a"::s)))) => 
+                       k (s, Char.isAlpha)
+                  | #"b"::(#"l"::(#"a"::(#"n"::(#"k"::_)))) => 
+                       raise (X "Cl:blank")
+                  | #"c"::(#"n"::(#"t"::(#"r"::(#"l"::s)))) => 
+                       k (s, Char.isCntrl)
+                  | #"d"::(#"i"::(#"g"::(#"i"::(#"t"::s)))) => 
+                       k (s, Char.isDigit)
+                  | #"g"::(#"r"::(#"a"::(#"p"::(#"h"::s)))) => 
+                       k (s, Char.isGraph)
+                  | #"l"::(#"o"::(#"w"::(#"e"::(#"r"::s)))) => 
+                       k (s, Char.isLower)
+                  | #"p"::(#"r"::(#"i"::(#"n"::(#"t"::s)))) => 
+                       k (s, Char.isPrint)
+                  | #"p"::(#"u"::(#"n"::(#"c"::(#"t"::_)))) => 
+                       raise (X "Cl:punct")
+                  | #"s"::(#"p"::(#"a"::(#"c"::(#"e"::s)))) => 
+                       k (s, Char.isSpace)
+                  | #"u"::(#"p"::(#"p"::(#"e"::(#"r"::s)))) => 
+                       k (s, Char.isUpper)
+                  | #"x"::(#"d"::(#"i"::(#"g"::(#"i"::(#"t"::s))))) => 
+                       k (s, Char.isHexDigit)
+                  | _ => raise (X "Cl")
+               end
+         in
+            val fromString: string -> (t * Save.t vector) option =
+               fn s => (SOME (S (explode s))) handle X _ => NONE
+            val fromString =
+               Trace.trace ("Regexp.fromString",
+                            String.layout,
+                            Option.layout (layout o #1))
+               fromString
+         end
       end
 
 (*    local
  *       val _ =
- * 	 let open Trace.Immediate
- * 	 in
- * 	    flagged()
- * 	    ; debug := Out Out.error
- * 	    ; on []
- * 	 end
+ *       let open Trace.Immediate
+ *       in
+ *          flagged()
+ *          ; debug := Out Out.error
+ *          ; on []
+ *       end
  *       open Regexp
  *       val a = char #"a"
  *       val b = char #"b"
@@ -1997,43 +1999,43 @@
  *       val r = or [a, b]
  *       val r = seq [a, b, c, d]
  *       val r = or [seq [a, b, c],
- * 		  seq [a, b, d]]
+ *                seq [a, b, d]]
  *       val r =
- * 	 seq [star (or [a, b]),
- * 	      a, b, b]
+ *       seq [star (or [a, b]),
+ *            a, b, b]
  *       val d = digit
  *       val eol = char #"#"
  *       val space = oneOf " \t"
  *       val r =
- * 	 seq [or [anchorStart, notOneOf "0123456789("],
- * 	      or [seq [char #"(", d, d, d, char #")"],
- * 		  seq [d, d, d]],
- * 	      char #" ",
- * 	      d, d, d,
- * 	      oneOf " -",
- * 	      d, d, d, d,
- * 	      or [eol, nonDigit]]
+ *       seq [or [anchorStart, notOneOf "0123456789("],
+ *            or [seq [char #"(", d, d, d, char #")"],
+ *                seq [d, d, d]],
+ *            char #" ",
+ *            d, d, d,
+ *            oneOf " -",
+ *            d, d, d, d,
+ *            or [eol, nonDigit]]
  * 
  *       fun doit (name, lay) =
- * 	 let
- * 	    val dot = concat ["/tmp/", name, ".dot"]
- * 	    val ps = concat ["/tmp/", name, ".ps"]
- * 	    val _ = File.withOut (dot, fn out => Layout.output (lay, out))
- * 	    val _ = OS.Process.system (concat ["dot ", dot, " >", ps])
- * 	 in ()
- * 	 end
+ *       let
+ *          val dot = concat ["/tmp/", name, ".dot"]
+ *          val ps = concat ["/tmp/", name, ".ps"]
+ *          val _ = File.withOut (dot, fn out => Layout.output (lay, out))
+ *          val _ = OS.Process.system (concat ["dot ", dot, " >", ps])
+ *       in ()
+ *       end
  *       val nfa = NFA.fromRegexp r
  *       val _ = doit ("nfa", NFA.layoutDot (nfa, "nfa"))
  *       val _ = Out.output (Out.error,
- * 			  concat ["numCharClasses = ",
- * 				  Int.toString (NFA.numCharClasses nfa),
- * 				  "\n"])
+ *                        concat ["numCharClasses = ",
+ *                                Int.toString (NFA.numCharClasses nfa),
+ *                                "\n"])
  *       val dfa = DFA.fromNFA nfa
  *       val _ = doit ("dfa",
- * 		    DFA.layoutDot {dfa = dfa, title = "dfa", showDead = false})
+ *                  DFA.layoutDot {dfa = dfa, title = "dfa", showDead = false})
  *       val min = DFA.minimize dfa
  *       val _ = doit ("min",
- * 		    DFA.layoutDot {dfa = min, title = "min", showDead = false})
+ *                  DFA.layoutDot {dfa = min, title = "min", showDead = false})
  *    in
  *    end
  *)
@@ -2042,11 +2044,11 @@
 (* local
  *    val _ =
  *       let
- * 	 open Trace.Immediate
+ *       open Trace.Immediate
  *       in
- * 	 debug := Out Out.error
- * 	 ; flagged()
- * 	 ; on ["Regexp.match"]
+ *       debug := Out Out.error
+ *       ; flagged()
+ *       ; on ["Regexp.match"]
  *       end
  *    structure Z = TestRegexp (Regexp)
  * in

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/relation.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/relation.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/relation.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,30 +1,31 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature RELATION =
    sig
       datatype t = datatype order (* from the pervasive environment *)
 
       val compare: ('a * 'a -> t)
-	 -> {equals: 'a * 'a -> bool,
-	     < : 'a * 'a -> bool,
-	     > : 'a * 'a -> bool,
-	     >= : 'a * 'a -> bool,
-	     <= : 'a * 'a -> bool,
-	     min: 'a * 'a -> 'a,
-	     max: 'a * 'a -> 'a}
+         -> {equals: 'a * 'a -> bool,
+             < : 'a * 'a -> bool,
+             > : 'a * 'a -> bool,
+             >= : 'a * 'a -> bool,
+             <= : 'a * 'a -> bool,
+             min: 'a * 'a -> 'a,
+             max: 'a * 'a -> 'a}
       val equals: t * t -> bool
       val layout: t -> Layout.t
       val lexico: t * (unit -> t) -> t
       val lessEqual: {< : 'a * 'a -> bool,
-		       equals: 'a * 'a -> bool}
-	 -> {> : 'a * 'a -> bool,
-	     >= : 'a * 'a -> bool,
-	     <= : 'a * 'a -> bool,
-	     min: 'a * 'a -> 'a,
-	     max: 'a * 'a -> 'a,
-	     compare: 'a * 'a -> t}
+                       equals: 'a * 'a -> bool}
+         -> {> : 'a * 'a -> bool,
+             >= : 'a * 'a -> bool,
+             <= : 'a * 'a -> bool,
+             min: 'a * 'a -> 'a,
+             max: 'a * 'a -> 'a,
+             compare: 'a * 'a -> t}
    end

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/relation.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/relation.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/relation.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 structure Relation: RELATION =
 struct
 

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/relation0.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/relation0.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/relation0.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 structure Relation0 =
 struct
 
@@ -22,8 +23,8 @@
       fun a <= b = a < b orelse equals (a, b)
       fun a >= b = b < a orelse equals (b, a)
       fun compare (a, b) = if a < b then LESS
-			 else if equals (a, b) then EQUAL
-			      else GREATER
+                         else if equals (a, b) then EQUAL
+                              else GREATER
       fun min (x, y) = if x < y then x else y
       fun max (x, y) = if x < y then y else x
    in {> = op >, <= = op <=, >= = op >=,
@@ -32,28 +33,28 @@
 
 fun compare c =
    let fun equals (x, y) = (case c (x, y) of
-			     EQUAL => true
-			   | _ => false)
+                             EQUAL => true
+                           | _ => false)
       fun x < y = (case c (x, y) of
-		      LESS => true
-		    | _ => false)
+                      LESS => true
+                    | _ => false)
       fun x <= y = (case c (x, y) of
-			LESS => true
-		      | EQUAL => true
-		      | _ => false)
+                        LESS => true
+                      | EQUAL => true
+                      | _ => false)
       fun x > y = (case c (x, y) of
-		      GREATER => true
-		    | _ => false)
+                      GREATER => true
+                    | _ => false)
       fun x >= y = (case c (x, y) of
-		       GREATER => true
-		     | EQUAL => true
-		     | _ => false)
+                       GREATER => true
+                     | EQUAL => true
+                     | _ => false)
       fun max (x, y) = (case c (x, y) of
-			 GREATER => x
-		       | _ => y)
+                         GREATER => x
+                       | _ => y)
       fun min (x, y) = (case c (x, y) of
-			 GREATER => y
-		       | _ => x)
+                         GREATER => y
+                       | _ => x)
    in {equals = equals,
        < = op <, > = op >, <= = op <=, >= = op >=,
        min = min, max = max}

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/resizable-array.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/resizable-array.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/resizable-array.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 functor ResizableArray (): RESIZABLE_ARRAY =
 struct
 
@@ -12,20 +13,20 @@
 structure A' =
    struct
       datatype 'a t = T of {array: 'a option Array.t ref,
-			    length: int ref}
+                            length: int ref}
 
       fun getArray (T {array, ...}) = !array
       fun lengthRef (T {length, ...}) = length
       fun length a = ! (lengthRef a)
       val shape = length
-	 
+         
       fun maxLength a = Array.length (getArray a)
       fun minLength a = Int.quot (maxLength a, 4)
    
       fun invariant a =
-	 maxLength a >= 1
-	 andalso minLength a <= length a
-	 andalso length a <= maxLength a
+         maxLength a >= 1
+         andalso minLength a <= length a
+         andalso length a <= maxLength a
    
       fun incLength a = Int.inc (lengthRef a)
       fun decLength a = Int.dec (lengthRef a)
@@ -34,55 +35,55 @@
       exception New = Array.New
 
       fun empty () =
-	 T {array = ref (Array.new (1, NONE)),
-	   length = ref 0}
-	 
+         T {array = ref (Array.new (1, NONE)),
+           length = ref 0}
+         
       fun new (s, x) =
-	 if s = 0 then empty ()
-	 else T {array = ref (Array.new (1, SOME x)),
-		length = ref s}
+         if s = 0 then empty ()
+         else T {array = ref (Array.new (1, SOME x)),
+                length = ref s}
       val array = new
-	    
+            
       fun tabulate (s, f) =
-	 if s = 0 then empty ()
-	 else T {array = ref (Array.tabulate (s, fn i => SOME (f i))),
-		length = ref s}
-	    
+         if s = 0 then empty ()
+         else T {array = ref (Array.tabulate (s, fn i => SOME (f i))),
+                length = ref s}
+            
       fun subSafe (a, i) =
-	 case Array.sub (getArray a, i) of
-	    SOME x => x
-	  | NONE => Error.bug "subSafe"
-		 
+         case Array.sub (getArray a, i) of
+            SOME x => x
+          | NONE => Error.bug "ResizableArray.subSafe"
+                 
       fun sub (a, i) =
-	 if i < length a then subSafe (a, i)
-	 else Error.bug "sub"
-	    
+         if i < length a then subSafe (a, i)
+         else Error.bug "ResizableArray.sub"
+            
       fun updateSafe (a, i, x) =
-	 Array.update (getArray a, i, SOME x)
+         Array.update (getArray a, i, SOME x)
    
       fun update (a, i, x) =
-	 if i < length a then updateSafe (a, i, x)
-	 else Error.bug "update"
+         if i < length a then updateSafe (a, i, x)
+         else Error.bug "ResizableArray.update"
 
       fun fromList l =
-	 let val a = Array.fromList (List.map (l, SOME))
-	 in T {array = ref a,
-	      length = ref (Array.length a)}
-	 end
+         let val a = Array.fromList (List.map (l, SOME))
+         in T {array = ref a,
+              length = ref (Array.length a)}
+         end
    end
 
 structure A'' =
    Array (open A'
-	  val unsafeSub = sub
-	  val unsafeUpdate = update
-	  val unfoldi: int * 'a * (int * 'a -> 'b * 'a) -> 'b t =
-	     fn (n, ac, f) =>
-	     T {array = ref (Array.unfoldi (n, ac, fn (i, a) =>
-					    let
-					       val (b, a') = f (i, a)
-					    in (SOME b, a')
-					    end)),
-		length = ref n})
+          val unsafeSub = sub
+          val unsafeUpdate = update
+          val unfoldi: int * 'a * (int * 'a -> 'b * 'a) -> 'b t =
+             fn (n, ac, f) =>
+             T {array = ref (Array.unfoldi (n, ac, fn (i, a) =>
+                                            let
+                                               val (b, a') = f (i, a)
+                                            in (SOME b, a')
+                                            end)),
+                length = ref n})
 
 open A' A''
 
@@ -93,11 +94,11 @@
 
 fun grow (a as T {array, ...}) =
    array := Array.tabulate (maxLength a * 2,
-		       fn i => subOption (a, i))
+                       fn i => subOption (a, i))
 
 fun shrink (a as T {array, ...}) =
    array := Array.tabulate (maxLength a div 2,
-		       fn i => subOption (a, i))
+                       fn i => subOption (a, i))
 
 fun addToEnd (a, x) =
    (if length a = maxLength a then grow a else ()
@@ -106,12 +107,12 @@
        
 fun deleteLast a =
    if length a = 0
-      then Error.bug "deleteLast"
+      then Error.bug "ResizableArray.deleteLast"
    else let val x = subSafe (a, maxIndex a)
-	in (if length a = minLength a then shrink a else ()
-	    ; decLength a
-	    ; x)
-	end
+        in (if length a = minLength a then shrink a else ()
+            ; decLength a
+            ; x)
+        end
 
 end
 

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/resizable-array.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/resizable-array.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/resizable-array.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 type int = Int.t
    
 signature RESIZABLE_ARRAY =

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/result.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/result.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/result.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,13 +1,14 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature RESULT =
    sig
       datatype 'a t =
-	 No of string
+         No of string
        | Yes of 'a
 
       val isNo: 'a t -> bool

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/result.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/result.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/result.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 structure Result:> RESULT =
 struct
 

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/ring-with-identity.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/ring-with-identity.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/ring-with-identity.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 functor RingWithIdentity (S: RING_WITH_IDENTITY_STRUCTS)
    :> RING_WITH_IDENTITY where type t = S.t = 
 struct
@@ -21,28 +22,28 @@
 local
    fun 'a
       make {zero: 'a, < : 'a * 'a -> bool, ~ : 'a -> 'a,
-	    power: {one: t,
-		    layout: t -> Layout.t,
-		    times: t * t -> t
-		    } -> (t * 'a) -> t}
+            power: {one: t,
+                    layout: t -> Layout.t,
+                    times: t * t -> t
+                    } -> (t * 'a) -> t}
       (i: 'a) : t =
       let
-	 val (i, fix) =
-	    if i < zero
-	       then (~ i, S.~)
-	    else (i, fn x => x)
+         val (i, fix) =
+            if i < zero
+               then (~ i, S.~)
+            else (i, fn x => x)
       val i = power{one = S.zero, layout = layout, times = op +} (one, i)
       in fix i
       end
 in
    val fromInt = make{zero = 0,
-		      < = op <,
-		      ~ = Pervasive.Int.~,
-		      power = Power.power}
+                      < = op <,
+                      ~ = Pervasive.Int.~,
+                      power = Power.power}
    val fromIntInf = make{zero = 0,
-			 < = IntInf.<,
-			 ~ = IntInf.~,
-			 power = Power.powerInf}
+                         < = IntInf.<,
+                         ~ = IntInf.~,
+                         power = Power.powerInf}
 end
 
 (* val fromIntInf =
@@ -67,20 +68,20 @@
 
 val pows =
    Trace.traceAssert
-   ("pows",
+   ("RingWithIdentity.pows",
     List.layout (Layout.tuple2 (layout, Layout.str o Pervasive.Int.toString)),
     layout,
     fn l => (true, fn r => equals (r, List.fold (l, one, fn ((b, e), ac) =>
-						 ac * pow (b, e)))))
+                                                 ac * pow (b, e)))))
    pows
 
 val powsInf =
    Trace.traceAssert
-   ("powsInf",
+   ("RingWithIdentity.powsInf",
     List.layout (Layout.tuple2 (layout, Layout.str o Pervasive.IntInf.toString)),
     layout,
     fn l => (true, fn r => equals (r, List.fold (l, one, fn ((b, e), ac) =>
-						 ac * powInf (b, e)))))
+                                                 ac * powInf (b, e)))))
    powsInf
 
 end

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/ring-with-identity.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/ring-with-identity.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/ring-with-identity.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,13 +1,14 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature RING_WITH_IDENTITY_STRUCTS = 
    sig
       include RING
-	 
+         
       val one: t
    end
 

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/ring.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/ring.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/ring.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 functor Ring(S: RING_STRUCTS):> RING where type t = S.t = 
 struct
 

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/ring.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/ring.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/ring.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature RING_STRUCTS =
    sig
       type t
@@ -19,7 +20,7 @@
 signature RING =
    sig
       include RING_STRUCTS
-	 
+         
       val - : t * t -> t
       val double: t -> t
       val isZero: t -> bool

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/sexp.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/sexp.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/sexp.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature SEXP_STRUCTS = 
    sig
    end
@@ -13,12 +14,12 @@
       include SEXP_STRUCTS
       
       datatype t =
-	 Atom of string
+         Atom of string
        | List of t list
        | String of string
 
       datatype parseResult =
-	 Eof
+         Eof
        | Error of string
        | Sexp of t
 

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/sexp.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/sexp.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/sexp.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 structure Sexp: SEXP = 
 struct
 
@@ -17,16 +18,16 @@
       open Layout
    in
       case sexp of
-	 Atom s => str s
+         Atom s => str s
        | List sexps => paren (align (List.map (sexps, layout)))
        | String s =>
-	    str (concat ["\"",
-			 String.translate (s, fn c =>
-					   case c of
-					      #"\"" => "\"\""
-		                            | #"\\" => "\\\\"
-					    | _ => String.fromChar c),
-			 "\""])
+            str (concat ["\"",
+                         String.translate (s, fn c =>
+                                           case c of
+                                              #"\"" => "\"\""
+                                            | #"\\" => "\\\\"
+                                            | _ => String.fromChar c),
+                         "\""])
    end
 
 val toString = Layout.toString o layout
@@ -37,101 +38,101 @@
  | Sexp of t
 
 fun parse (peekChar: unit -> char option,
-	   getChar: unit -> char option): parseResult =
+           getChar: unit -> char option): parseResult =
    let
       exception Err of string
       fun error s = raise (Err s)
       fun atom (cs: char list): t =
-	 let
-	    fun done () = Atom (String.fromListRev cs)
-	 in
-	    case peekChar () of
-	       NONE => done ()
-	     | SOME c =>
-		  if Char.isSpace c
-		     orelse c = #"(" orelse c = #")" orelse c = #"\""
-			 orelse c = #";"
-		     then done ()
-		  else
-		     case getChar () of
-			NONE => done ()
-		      | SOME c => atom (c :: cs)
-	 end
+         let
+            fun done () = Atom (String.fromListRev cs)
+         in
+            case peekChar () of
+               NONE => done ()
+             | SOME c =>
+                  if Char.isSpace c
+                     orelse c = #"(" orelse c = #")" orelse c = #"\""
+                         orelse c = #";"
+                     then done ()
+                  else
+                     case getChar () of
+                        NONE => done ()
+                      | SOME c => atom (c :: cs)
+         end
       fun string (cs: char list): t =
-	 case getChar () of
-	    NONE => error "eof in middle of string"
-	  | SOME c =>
-	       (case c of
-		   #"\"" => String (String.fromListRev cs)
-		 | #"\\" => (case getChar () of
-				NONE => error "eof in middle of string"
-			      | SOME c => string (c :: cs))
-	         | _ => string (c :: cs))
+         case getChar () of
+            NONE => error "eof in middle of string"
+          | SOME c =>
+               (case c of
+                   #"\"" => String (String.fromListRev cs)
+                 | #"\\" => (case getChar () of
+                                NONE => error "eof in middle of string"
+                              | SOME c => string (c :: cs))
+                 | _ => string (c :: cs))
       fun ignoreLine (): bool =
-	 case getChar () of
-	    NONE => false
-	  | SOME c => c = #"\n" orelse ignoreLine ()
+         case getChar () of
+            NONE => false
+          | SOME c => c = #"\n" orelse ignoreLine ()
       fun sexp (): t option =
-	 case getChar () of
-	    NONE => NONE
-	  | SOME c => sexpChar c
+         case getChar () of
+            NONE => NONE
+          | SOME c => sexpChar c
       and sexpChar (c: char): t option =
-	 case c of
-	    #"(" => SOME (List (finishList []))
-	  | #")" => error "unmatched )"
-	  | #"\"" => SOME (string [])
-	  | #";" => if ignoreLine ()
-		       then sexp ()
-		    else NONE
-	  | _ => if Char.isSpace c
-		    then sexp ()
-		 else SOME (atom [c])
+         case c of
+            #"(" => SOME (List (finishList []))
+          | #")" => error "unmatched )"
+          | #"\"" => SOME (string [])
+          | #";" => if ignoreLine ()
+                       then sexp ()
+                    else NONE
+          | _ => if Char.isSpace c
+                    then sexp ()
+                 else SOME (atom [c])
       and finishList (elts: t list): t list =
-	 case getChar () of
-	    NONE => error "unmatched ("
-	  | SOME c =>
-	       (case c of
-		   #")" => rev elts
-		 | #";" =>
-		      if ignoreLine ()
-			 then finishList elts
-		      else error "unmatched ("
-		 | _ =>
-		      if Char.isSpace c
-			 then finishList elts
-		      else 
-			 case sexpChar c of
-			    NONE => error "unmatched ("
-			  | SOME s => finishList (s :: elts))
+         case getChar () of
+            NONE => error "unmatched ("
+          | SOME c =>
+               (case c of
+                   #")" => rev elts
+                 | #";" =>
+                      if ignoreLine ()
+                         then finishList elts
+                      else error "unmatched ("
+                 | _ =>
+                      if Char.isSpace c
+                         then finishList elts
+                      else 
+                         case sexpChar c of
+                            NONE => error "unmatched ("
+                          | SOME s => finishList (s :: elts))
    in
       (case sexp () of
-	  NONE => Eof
-	| SOME s => Sexp s) handle Err s => Error s
+          NONE => Eof
+        | SOME s => Sexp s) handle Err s => Error s
    end
 
 fun input ins =
    parse (fn () => In.peekChar ins,
-	  fn () => In.inputChar ins)
+          fn () => In.inputChar ins)
 
 fun fromString s =
    let
       val n = String.size s
       val r = ref 0
       fun peekChar () =
-	 let
-	    val i = !r
-	 in
-	    if i = n
-	       then NONE
-	    else SOME (String.sub (s, i))
-	 end
+         let
+            val i = !r
+         in
+            if i = n
+               then NONE
+            else SOME (String.sub (s, i))
+         end
       fun getChar () =
-	 let
-	    val res = peekChar ()
-	    val _ = if isSome res then r := 1 + !r else ()
-	 in
-	    res
-	 end
+         let
+            val res = peekChar ()
+            val _ = if isSome res then r := 1 + !r else ()
+         in
+            res
+         end
    in
       parse (peekChar, getChar)
    end

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/signal.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/signal.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/signal.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature SIGNAL =
    sig
       include MLTON_SIGNAL

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/signal.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/signal.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/signal.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 structure Signal =
 struct
 

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/sources.cm
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/sources.cm	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/sources.cm	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,11 @@
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 Library
 
 signature ARRAY
@@ -44,7 +52,6 @@
 structure DirectedSubGraph
 structure Dot
 structure DotColor
-structure DynamicWind
 structure Engine
 structure Error
 structure Escape
@@ -157,10 +164,9 @@
 #endif
 
 ../pervasive/sources.cm
-dynamic-wind.sig
-dynamic-wind.sml
 error.sig
 error.sml
+exn0.sml
 outstream0.sml
 layout.sig
 relation0.sml

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/sources.mlb
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/sources.mlb	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/sources.mlb	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,298 +1,303 @@
+(* Copyright (C) 2004-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 ann  
-   "sequenceUnit true"
-   "warnMatch true"
+   "sequenceNonUnit warn"
+   "nonexhaustiveMatch warn" "redundantMatch warn"
    "warnUnused false" "forceUsed"
 in
-local
-    $(SML_LIB)/basis/basis.mlb
-    $(SML_LIB)/basis/mlton.mlb
-    $(SML_LIB)/basis/sml-nj.mlb
-    $(SML_LIB)/basis/unsafe.mlb
-    ../pervasive/sources.mlb
-    dynamic-wind.sig
-    dynamic-wind.sml
-    error.sig
-    error.sml
-    outstream0.sml
-    layout.sig
-    relation0.sml
-    char0.sml
-    string0.sml
-    layout.sml
-    substring.sig
-    assert.sig
-    assert.sml
-    list.sig
-    fold.sig
-    fold.fun
-    list.sml
-    word.sig
-    word8.sml
-    word32.sig
-    max-pow-2-that-divides.fun
-    word.sml
-    string1.sml
-    substring.sml
-    outstream.sig
-    outstream.sml
-    relation.sig
-    relation.sml
-    order0.sig
-    order.sig
-    time.sig
-    time.sml
-    instream.sig
-    char.sig
-    computation.sig
-    trace.sig
-    exn.sig
-    exn.sml
-    date.sig
-    date.sml
-    pid.sig
-    option.sig
-    option.sml
-    pid.sml
-    intermediate-computation.sig
-    instream0.sml
-    intermediate-computation.sml
-    string-map.sig
-    string-map.sml
-    t.sig
-    unit.sig
-    unit.sml
-    trace.sml
-    bool.sig
-    bool.sml
-    char.sml
-    string.sig
-    stream.sig
-    promise.sig
-    promise.sml
-    stream.sml
-    ring.sig
-    ring-with-identity.sig
-    euclidean-ring.sig
-    integer.sig
-    euclidean-ring.fun
-    ring.fun
-    ordered-ring.sig
-    ordered-ring.fun
-    power.sml
-    ring-with-identity.fun
-    integer.fun
-    int.sml
-    real.sig
-    field.sig
-    field.fun
-    ordered-field.sig
-    ordered-field.fun
-    real.sml
-    random.sig
-    random.sml
-    vector.sig
-    vector.fun
-    vector.sml
-    array.sig
-    array.fun
-    array.sml
-    binary-search.sig
-    binary-search.sml
-    hash-set.sig
-    hash-set.sml
-    string.sml
-    instream.sml
-    file.sig
-    file.sml
-    signal.sml
-    process.sig
-    dir.sig
-    dir.sml
-    function.sig
-    function.sml
-    file-desc.sig
-    file-desc.sml
-    process.sml
-    append-list.sig
-    append-list.sml
-    property-list.sig
-    ref.sig
-    ref.sml
-    het-container.sig
-    property-list.fun
-    het-container.fun
-    property.sig
-    property.fun
-    dot-color.sml
-    dot.sig
-    dot.sml
-    tree.sig
-    counter.sig
-    counter.sml
-    tree.sml
-    int-inf.sig
-    int-inf.sml
-    control.sig
-    control.fun
-    queue.sig
-    two-list-queue.sml
-    array2.sig
-    array2.sml
-    env.sig
-    env.fun
-    unique-id.sig
-    unique-id.fun
-    clearable-promise.sig
-    clearable-promise.sml
-    justify.sig
-    justify.sml
-    directed-graph.sig
-    directed-graph.sml
-    large-word.sml
-    quick-sort.sig
-    insertion-sort.sig
-    insertion-sort.sml
-    quick-sort.sml
-    unique-set.sig
-    unique-set.fun
-    fixed-point.sig
-    fixed-point.sml
-    mono-vector.fun
-    result.sig
-    result.sml
-    regexp.sig
-    regexp.sml
-    popt.sig
-    popt.sml
-    sexp.sig
-    sexp.sml
-    choice-pattern.sig
-    choice-pattern.sml
-    escape.sig
-    escape.sml
-    buffer.sig
-    buffer.sml
-    base64.sig
-    base64.sml
-in
-    signature ARRAY
-    signature ENV
-    signature ERROR
-    signature EUCLIDEAN_RING
-    signature INTEGER
-    signature INT_INF
-    signature LIST
-    signature OPTION
-    signature ORDER
-    signature ORDERED_RING
-    signature PROMISE
-    signature REAL
-    signature RING
-    signature RING_WITH_IDENTITY
-    signature STRING
-    signature T
-    signature UNIQUE_ID
+   local
+      $(SML_LIB)/basis/basis.mlb
+      $(SML_LIB)/basis/mlton.mlb
+      $(SML_LIB)/basis/sml-nj.mlb
+      $(SML_LIB)/basis/unsafe.mlb
+      ../pervasive/sources.mlb
+      error.sig
+      error.sml
+      exn0.sml
+      outstream0.sml
+      layout.sig
+      relation0.sml
+      char0.sml
+      string0.sml
+      layout.sml
+      substring.sig
+      assert.sig
+      assert.sml
+      list.sig
+      fold.sig
+      fold.fun
+      list.sml
+      word.sig
+      word8.sml
+      word32.sig
+      max-pow-2-that-divides.fun
+      word.sml
+      string1.sml
+      substring.sml
+      outstream.sig
+      outstream.sml
+      relation.sig
+      relation.sml
+      order0.sig
+      order.sig
+      time.sig
+      time.sml
+      instream.sig
+      char.sig
+      computation.sig
+      trace.sig
+      exn.sig
+      exn.sml
+      date.sig
+      date.sml
+      pid.sig
+      option.sig
+      option.sml
+      pid.sml
+      intermediate-computation.sig
+      instream0.sml
+      intermediate-computation.sml
+      string-map.sig
+      string-map.sml
+      t.sig
+      unit.sig
+      unit.sml
+      trace.sml
+      bool.sig
+      bool.sml
+      char.sml
+      string.sig
+      stream.sig
+      promise.sig
+      promise.sml
+      stream.sml
+      ring.sig
+      ring-with-identity.sig
+      euclidean-ring.sig
+      integer.sig
+      euclidean-ring.fun
+      ring.fun
+      ordered-ring.sig
+      ordered-ring.fun
+      power.sml
+      ring-with-identity.fun
+      integer.fun
+      int.sml
+      real.sig
+      field.sig
+      field.fun
+      ordered-field.sig
+      ordered-field.fun
+      real.sml
+      random.sig
+      random.sml
+      vector.sig
+      vector.fun
+      vector.sml
+      array.sig
+      array.fun
+      array.sml
+      binary-search.sig
+      binary-search.sml
+      hash-set.sig
+      hash-set.sml
+      string.sml
+      instream.sml
+      file.sig
+      file.sml
+      signal.sml
+      process.sig
+      dir.sig
+      dir.sml
+      function.sig
+      function.sml
+      file-desc.sig
+      file-desc.sml
+      process.sml
+      append-list.sig
+      append-list.sml
+      property-list.sig
+      ref.sig
+      ref.sml
+      het-container.sig
+      property-list.fun
+      het-container.fun
+      property.sig
+      property.fun
+      dot-color.sml
+      dot.sig
+      dot.sml
+      tree.sig
+      counter.sig
+      counter.sml
+      tree.sml
+      int-inf.sig
+      int-inf.sml
+      control.sig
+      control.fun
+      queue.sig
+      two-list-queue.sml
+      array2.sig
+      array2.sml
+      env.sig
+      env.fun
+      unique-id.sig
+      unique-id.fun
+      clearable-promise.sig
+      clearable-promise.sml
+      justify.sig
+      justify.sml
+      directed-graph.sig
+      directed-graph.sml
+      large-word.sml
+      quick-sort.sig
+      insertion-sort.sig
+      insertion-sort.sml
+      quick-sort.sml
+      unique-set.sig
+      unique-set.fun
+      fixed-point.sig
+      fixed-point.sml
+      mono-vector.fun
+      result.sig
+      result.sml
+      regexp.sig
+      regexp.sml
+      popt.sig
+      popt.sml
+      sexp.sig
+      sexp.sml
+      choice-pattern.sig
+      choice-pattern.sml
+      escape.sig
+      escape.sml
+      buffer.sig
+      buffer.sml
+      base64.sig
+      base64.sml
+   in
+      signature ARRAY
+      signature ENV
+      signature ERROR
+      signature EUCLIDEAN_RING
+      signature INTEGER
+      signature INT_INF
+      signature LIST
+      signature OPTION
+      signature ORDER
+      signature ORDERED_RING
+      signature PROMISE
+      signature REAL
+      signature RING
+      signature RING_WITH_IDENTITY
+      signature STRING
+      signature T
+      signature UNIQUE_ID
 
-    structure AppendList
-    structure Array
-    structure Array2
-    structure Assert
-    structure Base64
-    structure BinarySearch
-    structure Bool
-    structure Buffer
-    structure Char
-    structure CharArray
-    structure CharVector
-    structure ChoicePattern
-    structure ClearablePromise
-    structure CommandLine
-    structure Computation
-    structure Counter
-    structure Date
-    structure Dir
-    structure DirectedGraph
-    structure Dot
-    structure DotColor
-    structure DynamicWind
-    structure Error
-    structure Escape
-    structure Exn
-    structure File
-    structure FileDesc
-    structure FixedPoint
-    structure Function
-    structure HashSet
-(*    structure Http *)
-    structure In
-    structure Int
-    structure Int32
-    structure IntInf
-    structure InsertionSort
-    structure Justify
-    structure LargeInt
-    structure LargeWord
-    structure Layout
-    structure List
-    structure List
-    structure MLton
-    (* structure MergeSortList *)
-    (* structure MergeSortVector *)
-    structure OS
-    structure Option
-    structure Out
-    structure Pervasive
-    structure Pid
-    structure Popt
-    structure Position
-    structure Power
-    structure Process
-    structure Promise
-    structure Property
-    structure PropertyList
-    structure Queue
-    structure QuickSort
-    structure Random
-    structure Real
-    structure RealVector
-    structure Real32
-    structure Real64
-    structure Ref
-    structure Regexp
-    structure Relation
-    structure Result
-    structure SMLofNJ
-    structure Sexp
-    structure Signal
-    structure Stream
-    structure String
-    structure StringCvt
-    structure Substring
-    structure SysWord
-    structure Time
-    structure Trace
-    structure Tree
-    structure TwoListQueue
-    structure Unit
-    structure Vector
-    structure Word
-    structure Word32
-    structure Word8
-    structure Word8Array
-    structure Word8Vector
+      structure AppendList
+      structure Array
+      structure Array2
+      structure Assert
+      structure Base64
+      structure BinarySearch
+      structure Bool
+      structure Buffer
+      structure Char
+      structure CharArray
+      structure CharVector
+      structure ChoicePattern
+      structure ClearablePromise
+      structure CommandLine
+      structure Computation
+      structure Counter
+      structure Date
+      structure Dir
+      structure DirectedGraph
+      structure Dot
+      structure DotColor
+      structure Error
+      structure Escape
+      structure Exn
+      structure File
+      structure FileDesc
+      structure FixedPoint
+      structure Function
+      structure HashSet
+      (*    structure Http *)
+      structure In
+      structure Int
+      structure Int32
+      structure IntInf
+      structure InsertionSort
+      structure Justify
+      structure LargeInt
+      structure LargeWord
+      structure Layout
+      structure List
+      structure List
+      structure MLton
+      (* structure MergeSortList *)
+      (* structure MergeSortVector *)
+      structure OS
+      structure Option
+      structure Out
+      structure Pervasive
+      structure Pid
+      structure Popt
+      structure Position
+      structure Power
+      structure Process
+      structure Promise
+      structure Property
+      structure PropertyList
+      structure Queue
+      structure QuickSort
+      structure Random
+      structure Real
+      structure RealVector
+      structure Real32
+      structure Real64
+      structure Ref
+      structure Regexp
+      structure Relation
+      structure Result
+      structure SMLofNJ
+      structure Sexp
+      structure Signal
+      structure Stream
+      structure String
+      structure StringCvt
+      structure Substring
+      structure SysWord
+      structure Time
+      structure Trace
+      structure Tree
+      structure TwoListQueue
+      structure Unit
+      structure Vector
+      structure Word
+      structure Word32
+      structure Word8
+      structure Word8Array
+      structure Word8Vector
 
-    functor Control
-    functor Env
-    functor EuclideanRing
-    functor IntUniqueId
-    functor MonoArray
-    functor MonoVector
-    functor OrderedField
-    functor PolyEnv
-    functor Ring
-    functor RingWithIdentity
-    functor Tree
-    functor UniqueId
-    functor UniqueSet
+      functor Control
+      functor Env
+      functor EuclideanRing
+      functor IntUniqueId
+      functor MonoArray
+      functor MonoVector
+      functor OrderedField
+      functor PolyEnv
+      functor Ring
+      functor RingWithIdentity
+      functor Tree
+      functor UniqueId
+      functor UniqueSet
+   end
 end
-end

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/stream.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/stream.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/stream.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 type int = Pervasive.Int.int
    
 signature STREAM_STRUCTS = 

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/stream.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/stream.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/stream.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 structure Stream: STREAM = 
 struct
 
@@ -23,30 +24,30 @@
 fun 'a append (s: 'a t, s': 'a t): 'a t =
    let
       fun loop (s) =
-	 delay (fn () =>
-	       case force s of
-		  NONE => s'
-		| SOME (x, s') => cons (x, loop s'))
+         delay (fn () =>
+               case force s of
+                  NONE => s'
+                | SOME (x, s') => cons (x, loop s'))
    in loop s
    end
 
 fun map (s, f) =
    let
       fun loop s =
-	 delay (fn () =>
-	       case force s of
-		  NONE => empty ()
-		| SOME (x, s) => cons (f x, loop s))
+         delay (fn () =>
+               case force s of
+                  NONE => empty ()
+                | SOME (x, s) => cons (f x, loop s))
    in loop s
    end
       
 fun appendMap (s, f) =
    let
       fun loop (s) =
-	 delay (fn () =>
-	       case force s of
-		  NONE => empty ()
-		| SOME (x, s) => append (f x, loop s))
+         delay (fn () =>
+               case force s of
+                  NONE => empty ()
+                | SOME (x, s) => append (f x, loop s))
    in loop s
    end
 
@@ -58,40 +59,40 @@
 fun last (s) =
    let
       fun loop (z, s) =
-	 case force s of
-	    NONE => z
-	  | SOME (x, s) => loop (SOME x, s)
+         case force s of
+            NONE => z
+          | SOME (x, s) => loop (SOME x, s)
    in loop (NONE, s)
    end
 
 fun isEmpty (s) =
    case force (s) of
       NONE => true
-    | SOME _ => false	 
+    | SOME _ => false    
 
 fun layout f s = List.layout f (toList s)
 
 fun keep (s, p) =
    let
       fun loop s =
-	 delay
-	 (fn () =>
-	  case force s of
-	     NONE => empty ()
-	   | SOME (x, s) => if p x
-			      then cons (x, loop s)
-			   else loop s)
+         delay
+         (fn () =>
+          case force s of
+             NONE => empty ()
+           | SOME (x, s) => if p x
+                              then cons (x, loop s)
+                           else loop s)
    in loop s
    end
 
 fun firstN (s, n: int) =
    let
       fun loop (n, s, ac) =
-	 if n <= 0
-	    then rev ac
-	 else (case force s of
-		  NONE => Error.bug "firstN"
-		| SOME (x, s) => loop (n - 1, s, x :: ac))
+         if n <= 0
+            then rev ac
+         else (case force s of
+                  NONE => Error.bug "Stream.firstN"
+                | SOME (x, s) => loop (n - 1, s, x :: ac))
    in loop (n, s, [])
    end
 

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/string-map.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/string-map.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/string-map.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature STRING_MAP = 
    sig
       type 'a t

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/string-map.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/string-map.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/string-map.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,15 +1,16 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 structure StringMap: STRING_MAP = 
 struct
 
 datatype 'a t = T of {map: {name: string,
-			    value: 'a} list ref,
-		      default: unit -> 'a}
+                            value: 'a} list ref,
+                      default: unit -> 'a}
 
 fun new default = T{map = ref [], default = default}
 
@@ -18,17 +19,17 @@
 fun lookup (T {map, default}, name) =
    case List.peek (!map, fn {name = name', ...} => name = name') of
       NONE => let
-		 val value = default ()
-	      in List.push (map, {name = name, value = value})
-		 ; value
-	      end
+                 val value = default ()
+              in List.push (map, {name = name, value = value})
+                 ; value
+              end
     | SOME {value, ...} => value
 
 fun domain (T {map, ...}) = List.revMap (!map, fn {name, ...} => name)
 
 fun keepAll (T{map, ...}, pred) = 
    List.keepAllMap (!map, fn {name, value} =>
-		    if pred value then SOME name else NONE)
+                    if pred value then SOME name else NONE)
 
 fun foreach (T{map, ...}, f) =
    List.foreach (!map, fn {value, ...} => f value)

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/string.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/string.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/string.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 type int = Pervasive.Int.int
    
 signature STRING =
@@ -114,7 +115,7 @@
 
 val _ =
    Assert.assert
-   ("String", fn () =>
+   ("TestString", fn () =>
     dropl("abc", fn c => c = #"a") = "bc"
     andalso "\\000" = escapeC "\000"
     andalso "abc" = removeTrailing ("abc  ", Char.isSpace)

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/string.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/string.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/string.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 type word = Word.t
 
 structure String: STRING =
@@ -13,74 +14,74 @@
       fun existsi (s, f) = Int.exists (0, size s, fn i => f (i, sub (s, i)))
 
       fun keepAll (s: t, f: char -> bool): t =
-	 implode (List.rev
-		  (fold (s, [], fn (c, ac) => if f c then c :: ac else ac)))
-	 
+         implode (List.rev
+                  (fold (s, [], fn (c, ac) => if f c then c :: ac else ac)))
+         
       fun memoizeList (init: string -> 'a, l: (t * 'a) list): t -> 'a =
-	 let
-	    val set: (word * t * 'a) HashSet.t = HashSet.new {hash = #1}
-	    fun lookupOrInsert (s, f) =
-	       let
-		  val hash = hash s
-	       in HashSet.lookupOrInsert
-		  (set, hash,
-		   fn (hash', s', _) => hash = hash' andalso s = s',
-		   fn () => (hash, s, f ()))
-	       end
-	    val _ =
-	       List.foreach (l, fn (s, a) =>
-			     ignore (lookupOrInsert (s, fn () => a)))
-	 in
-	    fn s => #3 (lookupOrInsert (s, fn () => init s))
-	 end
+         let
+            val set: (word * t * 'a) HashSet.t = HashSet.new {hash = #1}
+            fun lookupOrInsert (s, f) =
+               let
+                  val hash = hash s
+               in HashSet.lookupOrInsert
+                  (set, hash,
+                   fn (hash', s', _) => hash = hash' andalso s = s',
+                   fn () => (hash, s, f ()))
+               end
+            val _ =
+               List.foreach (l, fn (s, a) =>
+                             ignore (lookupOrInsert (s, fn () => a)))
+         in
+            fn s => #3 (lookupOrInsert (s, fn () => init s))
+         end
 
       fun memoize init = memoizeList (init, [])
 
       fun posToLineCol (s: string): int -> {line: int, col: int} =
-	 let
-	    open Int
-	    val lineStarts =
-	       Array.fromList
-	       (List.rev (foldi (s, [0], fn (i, c, is) =>
-				 if c = #"\n"
-				    then (i + 1) :: is
-				 else is)))
-	    fun find (pos: int) =
-	       let
-		  val line =
-		     valOf (BinarySearch.largest (lineStarts, fn x => x <= pos))
-	       (* The 1+'s are to make stuff one based *)
-	       in {line = 1 + line,
-		   col = 1 + pos - Array.sub (lineStarts, line)}
-	       end
-	 in find
-	 end
+         let
+            open Int
+            val lineStarts =
+               Array.fromList
+               (List.rev (foldi (s, [0], fn (i, c, is) =>
+                                 if c = #"\n"
+                                    then (i + 1) :: is
+                                 else is)))
+            fun find (pos: int) =
+               let
+                  val line =
+                     valOf (BinarySearch.largest (lineStarts, fn x => x <= pos))
+               (* The 1+'s are to make stuff one based *)
+               in {line = 1 + line,
+                   col = 1 + pos - Array.sub (lineStarts, line)}
+               end
+         in find
+         end
 
       fun substituteFirst (s, {substring, replacement}) =
-	 case findSubstring (s, {substring = substring}) of
-	    NONE => s
-	  | SOME i =>
-	       let
-		  val n = length substring
-		  val prefix = Substring.substring (s, {start = 0, length = i})
-		  val suffix = Substring.extract (s, i + n, NONE)
-	       in
-		  Substring.concat [prefix, Substring.full replacement, suffix]
-	       end
+         case findSubstring (s, {substring = substring}) of
+            NONE => s
+          | SOME i =>
+               let
+                  val n = length substring
+                  val prefix = Substring.substring (s, {start = 0, length = i})
+                  val suffix = Substring.extract (s, i + n, NONE)
+               in
+                  Substring.concat [prefix, Substring.full replacement, suffix]
+               end
       fun substituteAll (s, {substring, replacement}) =
-	 case findSubstring (s, {substring = substring}) of
-	    NONE => s
-	  | SOME i =>
-	       let
-		  val ls = length s
-		  val lss = length substring
-		  val prefix = dropSuffix (s, ls - i)
-		  val suffix = substituteAll (dropPrefix (s, i + lss),
-					      {substring = substring, 
-					       replacement = replacement})
-	       in
-		  concat [prefix, replacement, suffix]
-	       end
+         case findSubstring (s, {substring = substring}) of
+            NONE => s
+          | SOME i =>
+               let
+                  val ls = length s
+                  val lss = length substring
+                  val prefix = dropSuffix (s, ls - i)
+                  val suffix = substituteAll (dropPrefix (s, i + lss),
+                                              {substring = substring, 
+                                               replacement = replacement})
+               in
+                  concat [prefix, replacement, suffix]
+               end
    end
 
 structure ZString = String (* CM bug ?? -- see instream.sml *)

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/string0.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/string0.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/string0.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 structure String0 =
 struct
 
@@ -49,7 +50,7 @@
 
 fun append (x, y) = x ^ y
 
-fun toChar s = if length s = 1 then sub (s, 0) else Error.bug "toChar"
+fun toChar s = if length s = 1 then sub (s, 0) else Error.bug "String0.toChar"
 
 val fromChar = str
 
@@ -76,7 +77,7 @@
 
 fun suffix (s, len) =
    substring1 (s, {start = length s - len,
-		  length = len})
+                  length = len})
    
 fun dropPrefix (s,n) =
    substring1 (s, {start=n, length = length s - n})
@@ -94,11 +95,11 @@
 fun removeTrailing (s: t, p: char -> bool): t =
    let
       fun loop (i: int) =
-	 if i < 0
-	    then i
-	 else if p (sub (s, i))
-		 then loop (i - 1)
-	      else i
+         if i < 0
+            then i
+         else if p (sub (s, i))
+                 then loop (i - 1)
+              else i
    in substring (s, 0, 1 + (loop (size s - 1)))
    end
 
@@ -107,8 +108,8 @@
       val n = length string
       val n' = length suffix
       fun loop (i: int, j: int): bool =
-	 i >= n orelse (Char.equals (sub (string, i), sub (suffix, j))
-			andalso loop (i + 1, j + 1))
+         i >= n orelse (Char.equals (sub (string, i), sub (suffix, j))
+                        andalso loop (i + 1, j + 1))
    in n' <= n andalso loop (n - n', 0)
    end
 
@@ -117,21 +118,21 @@
       val n = length substring
       val maxIndex = length string - n
       fun loopString i =
-	 if i > maxIndex
-	    then NONE
-	 else
-	    let
-	       val start = i
-	       fun loopSubstring (i, j) =
-		  if j >= n
-		     then SOME start
-		  else
-		     if Char.equals (sub (string, i), sub (substring, j))
-			then loopSubstring (i + 1, j + 1)
-		     else loopString (i + 1)
-	    in
-	       loopSubstring (i, 0)
-	    end
+         if i > maxIndex
+            then NONE
+         else
+            let
+               val start = i
+               fun loopSubstring (i, j) =
+                  if j >= n
+                     then SOME start
+                  else
+                     if Char.equals (sub (string, i), sub (substring, j))
+                        then loopSubstring (i + 1, j + 1)
+                     else loopString (i + 1)
+            in
+               loopSubstring (i, 0)
+            end
    in
       loopString 0
    end
@@ -141,15 +142,15 @@
 fun baseName (x, y) =
    if hasSuffix (x, {suffix = y})
       then dropSuffix (x, size y)
-   else Error.bug "baseName"
+   else Error.bug "String0.baseName"
 
 fun fold (s, b, f) =
    let
       val n = size s
       fun loop (i, b) =
-	 if i >= n
-	    then b
-	 else loop (i + 1, f (sub (s, i), b))
+         if i >= n
+            then b
+         else loop (i + 1, f (sub (s, i), b))
    in loop (0, b)
    end
 
@@ -164,9 +165,9 @@
    let
       val n = size s
       fun loop i =
-	 if PInt.< (i, 0) orelse c <> sub (s, i)
-	    then i
-	 else loop (i - 1)
+         if PInt.< (i, 0) orelse c <> sub (s, i)
+            then i
+         else loop (i - 1)
    in dropSuffix (s, n - 1 - loop (n - 1))
    end
 
@@ -178,18 +179,18 @@
 fun sort (l, f) =
    let
       fun loop l =
-	 case l of
-	    [] => []
-	  | x :: l =>
-	       let
-		  fun loop' l =
-		     case l of
-			[] => [x]
-		      | x' :: l => if f (x, x')
-				      then x :: x' :: l
-				   else x' :: loop' l
-	       in loop' (loop l)
-	       end
+         case l of
+            [] => []
+          | x :: l =>
+               let
+                  fun loop' l =
+                     case l of
+                        [] => [x]
+                      | x' :: l => if f (x, x')
+                                      then x :: x' :: l
+                                   else x' :: loop' l
+               in loop' (loop l)
+               end
    in loop l
    end
    

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/string1.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/string1.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/string1.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,31 +1,32 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 structure String1 =
 struct
 
 open String0
-	 
+         
 structure F = Fold (type 'a t = string
-		    type 'a elt = char
-		    val fold = fold)
+                    type 'a elt = char
+                    val fold = fold)
 open F
 
 type t = string
 
 val last = String0.last
-	 
-val layout = Layout.str o escapeSML
+         
+val layout = Layout.str
 
 fun forall (s, f) =
    let
       val n = length s
       fun loop i =
-	 i = n
-	 orelse (f (sub (s, i)) andalso loop (i + 1))
+         i = n
+         orelse (f (sub (s, i)) andalso loop (i + 1))
    in
       loop 0
    end
@@ -40,15 +41,15 @@
    let
       val n = length v
       fun loop i =
-	 if i = n
-	    then NONE
-	 else let
-		 val x = sub (v, i)
-	      in
-		 if f x
-		    then SOME x
-		 else loop (i + 1)
-	      end
+         if i = n
+            then NONE
+         else let
+                 val x = sub (v, i)
+              in
+                 if f x
+                    then SOME x
+                 else loop (i + 1)
+              end
    in
       loop 0
    end
@@ -57,15 +58,15 @@
    let
       val n = length v
       fun loop i =
-	 if i = n
-	    then NONE
-	 else let
-		 val x = sub (v, i)
-	      in
-		 if f (i, x)
-		    then SOME (i, x)
-		 else loop (i + 1)
-	      end
+         if i = n
+            then NONE
+         else let
+                 val x = sub (v, i)
+              in
+                 if f (i, x)
+                    then SOME (i, x)
+                 else loop (i + 1)
+              end
    in
       loop 0
    end
@@ -79,27 +80,27 @@
    let
       val n = size s
       fun loop (i: int) =
-	 if PInt.>= (i, n)
-	    then s
-	 else
-	    if Char.isSpace (sub (s, i))
-	       then loop (i + 1)
-	    else
-	       let
-		  fun loop (j: int) =
-		     let
-			val c = sub (s, j)
-		     in
-			if PInt.<= (j, i)
-			   then fromChar c
-			else
-			   if Char.isSpace c
-			      then loop (j - 1)
-			   else extract (s, i, SOME (j - i + 1))
-		     end
-	       in
-		  loop (n - 1)
-	       end
+         if PInt.>= (i, n)
+            then s
+         else
+            if Char.isSpace (sub (s, i))
+               then loop (i + 1)
+            else
+               let
+                  fun loop (j: int) =
+                     let
+                        val c = sub (s, j)
+                     in
+                        if PInt.<= (j, i)
+                           then fromChar c
+                        else
+                           if Char.isSpace c
+                              then loop (j - 1)
+                           else extract (s, i, SOME (j - i + 1))
+                     end
+               in
+                  loop (n - 1)
+               end
    in loop 0
    end
 

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/substring.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/substring.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/substring.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 type int = Pervasive.Int.int
    
 signature SUBSTRING =

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/substring.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/substring.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/substring.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 structure Substring: SUBSTRING =
    struct
       open Pervasive.Substring
@@ -13,21 +14,21 @@
       val length = size
 
       val substring =
-	 fn (s, {start, length}) => substring (s, start, length)
+         fn (s, {start, length}) => substring (s, start, length)
 
       val base =
-	 fn ss => let val (s, start, length) = base ss
-		  in (s, {start = start, length = length})
-		  end
+         fn ss => let val (s, start, length) = base ss
+                  in (s, {start = start, length = length})
+                  end
 
       val toString = string
-	 
+         
       val layout = String1.layout o toString
 
       fun endOf ss =
-	 let
-	    val (_, {start, length}) = base ss
-	 in
-	    start + length
-	 end
+         let
+            val (_, {start, length}) = base ss
+         in
+            start + length
+         end
    end

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/sum.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/sum.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/sum.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 functor Sum(S: SUM_STRUCTS): SUM =
 struct
 
@@ -15,11 +16,11 @@
 
 val outX =
    fn X x => x
-    | _ => Error.bug "outX"
+    | _ => Error.bug "Sum.outX"
 
 val outY =
    fn Y y => y
-    | _ => Error.bug "outY"
+    | _ => Error.bug "Sum.outY"
 
 val map =
    fn (X x, f, _) => f x

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/sum.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/sum.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/sum.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature SUM_STRUCTS =
    sig
       structure X: T
@@ -13,9 +14,9 @@
 signature SUM =
    sig
       include SUM_STRUCTS
-	 
+         
       datatype t =
-	 X of X.t
+         X of X.t
        | Y of Y.t
 
       val equals: t * t -> bool

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/t.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/t.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/t.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,13 +1,14 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature T =
    sig
       type t
-	 
+         
       val equals: t * t -> bool
       val layout: t -> Layout.t
    end

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/tab.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/tab.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/tab.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,15 +1,16 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 type int = Int.t
 
 signature TAB =
    sig
       val make: Out.t * string -> {reset: unit -> unit,
-				    right: unit -> unit,
-				    left: unit -> unit,
-				    indent: unit -> unit}
+                                    right: unit -> unit,
+                                    left: unit -> unit,
+                                    indent: unit -> unit}
    end

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/tab.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/tab.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/tab.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 structure Tab: TAB =
 struct
 
@@ -13,14 +14,14 @@
 fun make(out, tab) =
    let
       fun makeTabs size =
-	 Array.tabulate(size,
-		    let val prev = ref ""
-		    in fn _ =>
-		       (let val cur = !prev
-			in (prev := tab ^ cur ;
-			    cur)
-			end)
-		    end)
+         Array.tabulate(size,
+                    let val prev = ref ""
+                    in fn _ =>
+                       (let val cur = !prev
+                        in (prev := tab ^ cur ;
+                            cur)
+                        end)
+                    end)
 
       val tabs = ref(makeTabs initialSize)
 
@@ -33,24 +34,24 @@
       fun maybeResize() = if !index = size() then resize() else ()
 
       fun reset() = index := 0
-	 
+         
       fun indent() = Out.output(out, Array.sub(!tabs, !index))
 
       fun right() = (index := !index + 1 ;
-		     maybeResize())
+                     maybeResize())
 
       fun left() = if !index = 0 then Error.bug "Tab.left"
-		   else index := !index - 1
-		      
+                   else index := !index - 1
+                      
       fun output x =
-	 (indent() ;
-	  Out.output(out, x) ;
-	  Out.output(out, "\n"))
-	 
+         (indent() ;
+          Out.output(out, x) ;
+          Out.output(out, "\n"))
+         
    in {reset = reset,
        indent = indent,
        left = left,
        right = right}
    end
-				    
+                                    
 end

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/test.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/test.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/test.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,22 +1,23 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 structure Z =
    struct
       val _ =
-	 let open Trace.Immediate
-	 in debug := Out Out.error
-	    ; flagged()
-	    ; ["concat"]
-	    ; ["Uri.fromString", "Uri.resolve", "Uri.relativize",
-	       "Authority.equals"]
-	    ; ["Uri.fromString", "Uri.resolve", "Uri.toString",
-		  "Uri.relativize", "Uri.checkResolve"]
-	    ; ["Regexp.match"]
-	 end
+         let open Trace.Immediate
+         in debug := Out Out.error
+            ; flagged()
+            ; ["concat"]
+            ; ["Uri.fromString", "Uri.resolve", "Uri.relativize",
+               "Authority.equals"]
+            ; ["Uri.fromString", "Uri.resolve", "Uri.toString",
+                  "Uri.relativize", "Uri.checkResolve"]
+            ; ["Regexp.match"]
+         end
    end
 structure Z = TestBase64 (Base64)
 structure Z = TestBinarySearch (BinarySearch)

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/thread.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/thread.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/thread.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature THREAD =
    sig
       include MLTON_THREAD

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/thread.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/thread.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/thread.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 structure Thread: THREAD =
 struct
 
@@ -14,19 +15,19 @@
       val paused: 'a option t option ref = ref NONE
       val gen: unit t option ref = ref NONE
       fun return (a: 'a option): unit =
-	 switch (fn t' =>
-		 let
-		    val _ = gen := SOME t'
-		    val t = valOf (!paused)
-		    val _ = paused := NONE
-		 in
-		    prepare (t, a)
-		 end)
+         switch (fn t' =>
+                 let
+                    val _ = gen := SOME t'
+                    val t = valOf (!paused)
+                    val _ = paused := NONE
+                 in
+                    prepare (t, a)
+                 end)
       val _ =
-	 gen := SOME (new (fn () => (f (return o SOME)
-				     ; return NONE)))
+         gen := SOME (new (fn () => (f (return o SOME)
+                                     ; return NONE)))
    in fn () => switch (fn t => (paused := SOME t
-				; prepare (valOf (!gen), ())))
+                                ; prepare (valOf (!gen), ())))
    end
 
 end

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/time.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/time.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/time.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature TIME = 
    sig
       exception Time
@@ -13,17 +14,17 @@
       include ORDER
 
       type times =
-	  {
-	    self:     {utime: t, (* user time of process *)
-		       stime: t  (* system time of process *)
-		       },
-	    children: {utime: t, (* user time of terminated child processes *)
-		       stime: t  (* system time of terminated child processes *)
-		       },
-	    gc:       {utime: t, (* user time of gc *)
-		       stime: t  (* system time of gc *)
-		       }
-	   }
+          {
+            self:     {utime: t, (* user time of process *)
+                       stime: t  (* system time of process *)
+                       },
+            children: {utime: t, (* user time of terminated child processes *)
+                       stime: t  (* system time of terminated child processes *)
+                       },
+            gc:       {utime: t, (* user time of gc *)
+                       stime: t  (* system time of gc *)
+                       }
+           }
 
       val + : t * t -> t
       val - : t * t -> t

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/time.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/time.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/time.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 structure Time: TIME = 
 struct
 

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/trace.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/trace.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/trace.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,16 +1,17 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature TRACE_CONTROL = 
    sig
       (* controls what tracing info is gathered *)
       val always: unit -> unit      (* always gather info *)
       val flagged: unit -> unit     (* only on flagged functions *)
       val never: unit -> unit       (* never gather info *)
-	 
+         
       (* value of newly created flag *)
       val default: bool ref
 
@@ -30,35 +31,35 @@
 signature TRACE =
    sig
       structure Immediate:
-	 sig
-	    include TRACE_CONTROL
+         sig
+            include TRACE_CONTROL
 
-	    datatype debug =
-	       None
-	     | Terminal
-	     | Out of Out.t
+            datatype debug =
+               None
+             | Terminal
+             | Out of Out.t
 
-	    (*
-	     * If !debug = Terminal, debugging messages are printed to /dev/tty.
-	     * If !debug = Out os, then messages will be sent to os.
-	     * If !debug = None, then messages will be ignored.
-	     *)
-	    val debug: debug ref
-	    val message: Layout.t -> unit
-	    val messageStr: string -> unit
-	    (* inChildProcess is called by Process so that trace will know if it
-	     * is in a child, and therefore it will prefix all messages with the
-	     * pid of the current process.
-	     *)
-	    val inChildProcess: unit -> unit
-	    (* !showTime = true iff messages are preceded by the current time *)
-	    val showTime: bool ref
-	 end
+            (*
+             * If !debug = Terminal, debugging messages are printed to /dev/tty.
+             * If !debug = Out os, then messages will be sent to os.
+             * If !debug = None, then messages will be ignored.
+             *)
+            val debug: debug ref
+            val message: Layout.t -> unit
+            val messageStr: string -> unit
+            (* inChildProcess is called by Process so that trace will know if it
+             * is in a child, and therefore it will prefix all messages with the
+             * pid of the current process.
+             *)
+            val inChildProcess: unit -> unit
+            (* !showTime = true iff messages are preceded by the current time *)
+            val showTime: bool ref
+         end
       structure Delayed:
-	 sig
-	    include TRACE_CONTROL
-	    val keepAll: bool ref
-	 end
+         sig
+            include TRACE_CONTROL
+            val keepAll: bool ref
+         end
       structure Time: TRACE_CONTROL
 
       val never: unit -> unit
@@ -67,7 +68,7 @@
       val traceable: unit -> string list
       val outputTraceable: unit -> unit
       val reset: unit -> unit
-	 
+         
       (*---------- Delayed Feedback ----------*)
       structure Computation: COMPUTATION
 
@@ -96,101 +97,101 @@
       val info: string -> info
 
       val traceInfo:
-	 info
-	 * ('a -> Layout.t)
-	 * ('b -> Layout.t)
-	 * ('a -> bool * ('b -> bool))
-	 -> ('a -> 'b)
-	 -> ('a -> 'b)
+         info
+         * ('a -> Layout.t)
+         * ('b -> Layout.t)
+         * ('a -> bool * ('b -> bool))
+         -> ('a -> 'b)
+         -> ('a -> 'b)
 
       val traceInfo':
-	 info
-	 * ('a -> Layout.t)
-	 * ('b -> Layout.t)
-	 -> ('a -> 'b)
-	 -> ('a -> 'b)
+         info
+         * ('a -> Layout.t)
+         * ('b -> Layout.t)
+         -> ('a -> 'b)
+         -> ('a -> 'b)
 
 (*       type ('a, 'b) check = ('a -> Layout.t) * ('a -> bool * 'b)
  * 
  *       type ('a, 'b) z =
- * 	 'a -> ((unit -> Layout.t)
- * 		* (unit -> bool)
- * 		* 'a
- * 		* 'b)
- * 	 
+ *       'a -> ((unit -> Layout.t)
+ *              * (unit -> bool)
+ *              * 'a
+ *              * 'b)
+ *       
  *       val traceInfo:
- * 	 info
- * 	 * ('a, ('b, unit) check) check
- * 	 -> ('a -> 'b)
- * 	 -> 'a
- * 	 -> 'b
+ *       info
+ *       * ('a, ('b, unit) check) check
+ *       -> ('a -> 'b)
+ *       -> 'a
+ *       -> 'b
  *)
 
       val assertTrue: 'a -> (bool * ('b -> bool))
 
       val traceAssert:
-	 string
-	 * ('a -> Layout.t)
-	 * ('b -> Layout.t)
-	 * ('a -> bool * ('b -> bool))
-	 -> ('a -> 'b)
-	 -> ('a -> 'b)
+         string
+         * ('a -> Layout.t)
+         * ('b -> Layout.t)
+         * ('a -> bool * ('b -> bool))
+         -> ('a -> 'b)
+         -> ('a -> 'b)
 
       val trace:
-	 string
-	 * ('a -> Layout.t)
-	 * ('b -> Layout.t)
-	 -> ('a -> 'b)
-	 -> ('a -> 'b)
-	 
+         string
+         * ('a -> Layout.t)
+         * ('b -> Layout.t)
+         -> ('a -> 'b)
+         -> ('a -> 'b)
+         
       val trace0:
-	 string
-	 * ('a -> Layout.t)
-	 -> (unit -> 'a)
-	 -> (unit -> 'a)
+         string
+         * ('a -> Layout.t)
+         -> (unit -> 'a)
+         -> (unit -> 'a)
 
       val trace2:
-	 string
-	 * ('a -> Layout.t)
-	 * ('b -> Layout.t)
-	 * ('c -> Layout.t)
-	 -> ('a * 'b -> 'c)
-	 -> ('a * 'b -> 'c)
+         string
+         * ('a -> Layout.t)
+         * ('b -> Layout.t)
+         * ('c -> Layout.t)
+         -> ('a * 'b -> 'c)
+         -> ('a * 'b -> 'c)
 
       val trace3:
-	 string
-	 * ('a -> Layout.t)
-	 * ('b -> Layout.t)
-	 * ('c -> Layout.t)
-	 * ('d -> Layout.t)
-	 -> ('a * 'b * 'c -> 'd)
-	 -> ('a * 'b * 'c -> 'd)
+         string
+         * ('a -> Layout.t)
+         * ('b -> Layout.t)
+         * ('c -> Layout.t)
+         * ('d -> Layout.t)
+         -> ('a * 'b * 'c -> 'd)
+         -> ('a * 'b * 'c -> 'd)
 
       val trace4:
-	 string
-	 * ('a -> Layout.t)
-	 * ('b -> Layout.t)
-	 * ('c -> Layout.t)
-	 * ('d -> Layout.t)
-	 * ('e -> Layout.t)
-	 -> ('a * 'b * 'c * 'd -> 'e)
-	 -> ('a * 'b * 'c * 'd -> 'e)
+         string
+         * ('a -> Layout.t)
+         * ('b -> Layout.t)
+         * ('c -> Layout.t)
+         * ('d -> Layout.t)
+         * ('e -> Layout.t)
+         -> ('a * 'b * 'c * 'd -> 'e)
+         -> ('a * 'b * 'c * 'd -> 'e)
 
       val trace5:
-	 string
-	 * ('a -> Layout.t)
-	 * ('b -> Layout.t)
-	 * ('c -> Layout.t)
-	 * ('d -> Layout.t)
-	 * ('e -> Layout.t)
-	 * ('f -> Layout.t)
-	 -> ('a * 'b * 'c * 'd * 'e -> 'f)
-	 -> ('a * 'b * 'c * 'd * 'e -> 'f)
+         string
+         * ('a -> Layout.t)
+         * ('b -> Layout.t)
+         * ('c -> Layout.t)
+         * ('d -> Layout.t)
+         * ('e -> Layout.t)
+         * ('f -> Layout.t)
+         -> ('a * 'b * 'c * 'd * 'e -> 'f)
+         -> ('a * 'b * 'c * 'd * 'e -> 'f)
 
       val traceRec:
-	 string
-	 * ('a -> Layout.t)
-	 * ('b -> Layout.t)
-	 -> (('a -> 'b) -> ('a -> 'b))
-	 -> 'a -> 'b 
+         string
+         * ('a -> Layout.t)
+         * ('b -> Layout.t)
+         -> (('a -> 'b) -> ('a -> 'b))
+         -> 'a -> 'b 
    end

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/trace.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/trace.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/trace.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,16 +1,17 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 functor TraceControl (structure StringMap: STRING_MAP
-		      datatype status = Always | Flagged | Never
-		      type flags
-		      val map: flags StringMap.t
-		      val getFlag: flags -> bool ref
-		      val default: bool ref
-		      val status: status) =
+                      datatype status = Always | Flagged | Never
+                      type flags
+                      val map: flags StringMap.t
+                      val getFlag: flags -> bool ref
+                      val default: bool ref
+                      val status: status) =
 struct
 
 val status = ref status
@@ -64,70 +65,70 @@
 val timeDefault = ref false
 
 type flags = {immediate: bool ref,
-	      delayed: bool ref,
-	      time: bool ref}
+              delayed: bool ref,
+              time: bool ref}
    
 val map = StringMap.new (fn () => {immediate = ref (!immediateDefault),
-				   delayed = ref (!delayedDefault),
-				   time = ref (!timeDefault)})
+                                   delayed = ref (!delayedDefault),
+                                   time = ref (!timeDefault)})
    
 fun traceable () = StringMap.domain map
 
 fun outputTraceable () =
    Layout.output (List.layout Layout.str (traceable ()),
-		 Out.standard)
+                 Out.standard)
 
 datatype status = Always | Flagged | Never
 
 structure Immediate =
    TraceControl (type flags = flags
-		 val map = map
-		 structure StringMap = StringMap
-		 datatype status = datatype status
-		 fun getFlag ({immediate, ...}: flags) = immediate
-		 val default = immediateDefault
-		 val status = Never)
+                 val map = map
+                 structure StringMap = StringMap
+                 datatype status = datatype status
+                 fun getFlag ({immediate, ...}: flags) = immediate
+                 val default = immediateDefault
+                 val status = Never)
 structure Delayed =
    struct
       structure C = 
-	 TraceControl (type flags = flags
-		      val map = map
-		      structure StringMap = StringMap
-		      datatype status = datatype status
-		      fun getFlag ({delayed, ...}: flags) = delayed
-		      val default = delayedDefault
-		      val status = Never)
+         TraceControl (type flags = flags
+                      val map = map
+                      structure StringMap = StringMap
+                      datatype status = datatype status
+                      fun getFlag ({delayed, ...}: flags) = delayed
+                      val default = delayedDefault
+                      val status = Never)
       open C
-	 
+         
       val keepAll = ref true
    end
 
 structure Time =
    TraceControl (type flags = flags
-		val map = map
-		structure StringMap = StringMap
-		datatype status = datatype status
-		fun getFlag ({time, ...}: flags) = time
-		val default = timeDefault
-		val status = Never)
+                val map = map
+                structure StringMap = StringMap
+                datatype status = datatype status
+                fun getFlag ({time, ...}: flags) = time
+                val default = timeDefault
+                val status = Never)
 
 fun never () = (Immediate.never ()
-	       ; Delayed.never ()
-	       ; Time.never ())
+               ; Delayed.never ()
+               ; Time.never ())
 
 fun always () = (Immediate.always ()
-		; Delayed.always ()
-		; Time.always ())
+                ; Delayed.always ()
+                ; Time.always ())
 
 fun flagged () = (Immediate.flagged ()
-		 ; Delayed.flagged ()
-		 ; Time.flagged ())
+                 ; Delayed.flagged ()
+                 ; Time.flagged ())
    
 fun reset () =
    StringMap.foreach (map, fn {immediate, delayed, time} =>
-		      (immediate := false
-		       ; delayed := false
-		       ; time := false))
+                      (immediate := false
+                       ; delayed := false
+                       ; time := false))
 
 (*---------------------------------------------------*)
 (*                 Delayed Feedback                  *)
@@ -149,41 +150,41 @@
 fun finishedComputation () =
    case !currentComputation of
       Working ic => let val c = IC.finish ic
-		    in currentComputation := Finished c
-		       ; c
-		    end
+                    in currentComputation := Finished c
+                       ; c
+                    end
     | Finished c => c
 val computation = finishedComputation
 
 fun history () = Computation.output (finishedComputation (),
-				   Out.error)
+                                   Out.error)
 fun calls () = Computation.outputCalls (finishedComputation (),
-				      Out.error)
+                                      Out.error)
 fun times () = Computation.outputTimes (finishedComputation (),
-				      Out.error)
+                                      Out.error)
 fun inspect () = Computation.inspect (finishedComputation ())
 
 fun ic () =
    case !currentComputation of
       Finished _ => let val ic = emptyIc ()
-		    in currentComputation := Working ic
-		       ; ic
-		    end
+                    in currentComputation := Working ic
+                       ; ic
+                    end
     | Working ic => ic
 
 fun delayedCall (name, layoutArg, layoutAns) =
    {call = fn () =>
     let val comp = ic ()
        val comp = if !Delayed.keepAll orelse not (IC.atTopLevel comp)
-		     then comp
-		  else (clear (); ic ())
+                     then comp
+                  else (clear (); ic ())
     in IC.call (comp, name, layoutArg)
     end,
     raisee = fn (t, _) => IC.raisee (ic (), t),
     return = fn (ans, t) => IC.return (ic (),
-				     fn () => layoutAns ans,
-				     t)}
-	 
+                                     fn () => layoutAns ans,
+                                     t)}
+         
 (*---------------------------------------------------*)
 (*                Immediate Feedback                 *)
 (*---------------------------------------------------*)
@@ -193,7 +194,7 @@
       open Immediate
 
       datatype debug =
-	 None
+         None
        | Terminal
        | Out of Out.t
     
@@ -210,70 +211,70 @@
       fun inChildProcess () = (inChild := true; indentation := 0)
 
       fun message (l: Layout.t): unit =
-	 case !debug of
-	    None => ()
-	  | _ => 
-	       let
-		  val (out, done) =
-		     case !debug of
-			Terminal => (Out.openOut "/dev/tty", Out.close)
-		      | Out out => (out, Out.flush)
-		      | _ => raise Fail "message"
-		  open Layout
-	       in output (seq [if !inChild
-				then seq [Pid.layout (Pid.current ()), str ": "]
-			     else empty,
-			     if !showTime
-				then str (Date.fmt
-					  (Date.now (), "%b %d %H:%M:%S "))
-			     else empty,
-		             indent (l, !indentation)],
-			 out)
-		  ; Out.newline out
-		  ; done out
-	       end
-	 
+         case !debug of
+            None => ()
+          | _ => 
+               let
+                  val (out, done) =
+                     case !debug of
+                        Terminal => (Out.openOut "/dev/tty", Out.close)
+                      | Out out => (out, Out.flush)
+                      | _ => Error.bug "Trace.message"
+                  open Layout
+               in output (seq [if !inChild
+                                then seq [Pid.layout (Pid.current ()), str ": "]
+                             else empty,
+                             if !showTime
+                                then str (Date.fmt
+                                          (Date.now (), "%b %d %H:%M:%S "))
+                             else empty,
+                             indent (l, !indentation)],
+                         out)
+                  ; Out.newline out
+                  ; done out
+               end
+         
       fun finish (t, res) =
-	 (left ()
-	  ; message (let open Layout
-		    in case t of
-		       NONE => seq [str "==> ", res]
-		     | SOME t =>
-			  align [seq [str "==> time = ", Timer.layout t],
-				res]
-		    end))
+         (left ()
+          ; message (let open Layout
+                    in case t of
+                       NONE => seq [str "==> ", res]
+                     | SOME t =>
+                          align [seq [str "==> time = ", Timer.layout t],
+                                res]
+                    end))
 
       fun call (name, outArg, layoutAns) =
-	 let
-	    open Layout
-	    fun call () = (message (seq [str name, str " ==> ",
-					 outArg ()
-					 handle e =>
-					    seq [str "layout argument error: ",
-						 Exn.layout e]])
-			   ; right ())
-	    fun raisee (t, e) = finish (t, seq [str "raise: ", Exn.layout e])
-	    fun return (ans, t) =
-	       finish (t,
-		       layoutAns ans
-		       handle e => seq [str "layout answer error: ",
-					Exn.layout e])
-	 in {call = call,
-	     raisee = raisee,
-	     return = return}
-	 end
+         let
+            open Layout
+            fun call () = (message (seq [str name, str " ==> ",
+                                         outArg ()
+                                         handle e =>
+                                            seq [str "layout argument error: ",
+                                                 Exn.layout e]])
+                           ; right ())
+            fun raisee (t, e) = finish (t, seq [str "raise: ", Exn.layout e])
+            fun return (ans, t) =
+               finish (t,
+                       layoutAns ans
+                       handle e => seq [str "layout answer error: ",
+                                        Exn.layout e])
+         in {call = call,
+             raisee = raisee,
+             return = return}
+         end
 
       val message =
-	 fn l =>
-	 (left ()
-	  ; indentation := 1 + !indentation
-	  ; message l
-	  ; indentation := !indentation - 1
-	  ; right ())
-	 
+         fn l =>
+         (left ()
+          ; indentation := 1 + !indentation
+          ; message l
+          ; indentation := !indentation - 1
+          ; right ())
+         
       val messageStr = message o Layout.str
    end
-	 
+         
 (*---------------------------------------------------*)
 (*                  Instrumentation                  *)
 (*---------------------------------------------------*)
@@ -281,8 +282,8 @@
 type info = {name: string, flags: flags}
 
 val bogusInfo = {name = "bogus", flags = {delayed = ref false,
-					  immediate = ref false,
-					  time = ref false}}
+                                          immediate = ref false,
+                                          time = ref false}}
 
 val shouldTrace = Assert.debug
    
@@ -292,58 +293,58 @@
    else bogusInfo
 
 fun traceInfo ({name, flags = {immediate, delayed, time}},
-	       layoutArg, layoutAns, check) f a =
+               layoutArg, layoutAns, check) f a =
    if not shouldTrace
       then f a
    else 
       let
-	 val immediate = Immediate.isOn immediate
-	 val delayed = Delayed.isOn delayed
-	 val time = Time.isOn time
+         val immediate = Immediate.isOn immediate
+         val delayed = Delayed.isOn delayed
+         val time = Time.isOn time
       in
-	 if not (immediate orelse delayed orelse time orelse Assert.debug)
-	    then f a
-	 else let val outArg = fn () => layoutArg a
-		  val noCall = {call = fn _ => (),
-				raisee = fn _ => (),
-				return = fn _ => ()}
-		  val immed = if immediate
-				 then Immediate.call (name, outArg, layoutAns)
-			      else noCall
-		  val delay = if delayed
-				 then delayedCall (name, outArg, layoutAns)
-			      else noCall
-		  val _ = (#call delay ()
-			   ; #call immed ())
-		  val check =
-		     if Assert.debug
-			then let val (b, check) = check a
-				 val _ = Assert.assert (concat [name, " argument"],
-						       fn () => b)
-			     in check
-			     end
-		     else fn _ => true
-		  val startTime = if time then SOME (Timer.times ()) else NONE
-		  fun getTime () =
-		     case startTime of
-			NONE => NONE
-		      | SOME {self = {utime = u, stime = s}, ...} =>
-			   SOME (let val {self = {utime = u', stime = s'},
-					  ...} = Timer.times ()
-				in Timer.+ (Timer.- (u', u),
-					    Timer.- (s', s))
-				end)
-		  val ans = f a handle exn => let val t = getTime ()
-					      in #raisee delay (t, exn)
-						 ; #raisee immed (t, exn)
-						 ; raise exn
-					      end
-		  val t = getTime ()
-	      in #return delay (ans, t)
-		 ; #return immed (ans, t)
-		 ; Assert.assert (concat [name, " result"], fn () => check ans)
-		 ; ans
-	      end
+         if not (immediate orelse delayed orelse time orelse Assert.debug)
+            then f a
+         else let val outArg = fn () => layoutArg a
+                  val noCall = {call = fn _ => (),
+                                raisee = fn _ => (),
+                                return = fn _ => ()}
+                  val immed = if immediate
+                                 then Immediate.call (name, outArg, layoutAns)
+                              else noCall
+                  val delay = if delayed
+                                 then delayedCall (name, outArg, layoutAns)
+                              else noCall
+                  val _ = (#call delay ()
+                           ; #call immed ())
+                  val check =
+                     if Assert.debug
+                        then let val (b, check) = check a
+                                 val _ = Assert.assert (concat [name, " argument"],
+                                                       fn () => b)
+                             in check
+                             end
+                     else fn _ => true
+                  val startTime = if time then SOME (Timer.times ()) else NONE
+                  fun getTime () =
+                     case startTime of
+                        NONE => NONE
+                      | SOME {self = {utime = u, stime = s}, ...} =>
+                           SOME (let val {self = {utime = u', stime = s'},
+                                          ...} = Timer.times ()
+                                in Timer.+ (Timer.- (u', u),
+                                            Timer.- (s', s))
+                                end)
+                  val ans = f a handle exn => let val t = getTime ()
+                                              in #raisee delay (t, exn)
+                                                 ; #raisee immed (t, exn)
+                                                 ; raise exn
+                                              end
+                  val t = getTime ()
+              in #return delay (ans, t)
+                 ; #return immed (ans, t)
+                 ; Assert.assert (concat [name, " result"], fn () => check ans)
+                 ; ans
+              end
       end
 
 fun assertTrue _ = (true, fn _ => true)
@@ -356,7 +357,7 @@
    
 fun trace (name, layoutArg, layoutAns) =
    traceAssert (name, layoutArg, layoutAns, assertTrue)
-	       
+               
 fun ignore _ = Layout.empty
    
 fun traceCall s = trace (s, ignore, ignore)
@@ -364,13 +365,13 @@
 fun traceRec info =
    let val trace = trace info
    in fn f => let fun fix f a = trace (f (fix f)) a
-	      in fix f
-	      end
+              in fix f
+              end
    end
 
 fun trace0 (name, layoutAns) =
    trace (name, Unit.layout, layoutAns)
-	 
+         
 fun trace2 (name, layout1, layout2, layoutAns) =
    trace (name, Layout.tuple2 (layout1, layout2), layoutAns)
 

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/tree.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/tree.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/tree.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,27 +1,27 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 signature TREE_STRUCTS =
    sig
       structure Seq:
-	 sig
-	    type 'a t
+         sig
+            type 'a t
 
-	    val fold: 'a t * 'b * ('a * 'b -> 'b) -> 'b
-	    val foreach: 'a t * ('a -> unit) -> unit
-	    val layout: 'a t * ('a -> Layout.t) -> Layout.t
-	    val map: 'a t * ('a -> 'b) -> 'b t
-	 end
+            val fold: 'a t * 'b * ('a * 'b -> 'b) -> 'b
+            val foreach: 'a t * ('a -> unit) -> unit
+            val layout: 'a t * ('a -> Layout.t) -> Layout.t
+            val map: 'a t * ('a -> 'b) -> 'b t
+         end
    end
 
 signature TREE =
    sig
       include TREE_STRUCTS
-	 
+         
       datatype 'a t = T of 'a * 'a t Seq.t
 
       val children: 'a t -> 'a t Seq.t
@@ -31,10 +31,10 @@
       val foreachPost: 'a t * ('a -> unit) -> unit (* postorder traversal *)
       val layout: 'a t * ('a -> Layout.t) -> Layout.t
       val layoutDot:
-	 'a t * {nodeOptions: 'a -> Dot.NodeOption.t list,
-		 options: Dot.GraphOption.t list,
-		 title: string}
-	 -> Layout.t
+         'a t * {nodeOptions: 'a -> Dot.NodeOption.t list,
+                 options: Dot.GraphOption.t list,
+                 title: string}
+         -> Layout.t
       val map: 'a t * ('a -> 'b) -> 'b t
       val traverse: 'a t * ('a -> unit -> unit) -> unit
    end

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/tree.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/tree.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/tree.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 functor Tree (S: TREE_STRUCTS): TREE =
 struct
 
@@ -22,52 +23,52 @@
 fun traverse (t, f) =
    let
       fun loop (T (a, v)) =
-	 let
-	    val g = f a
-	    val _ = Seq.foreach (v, loop)
-	    val _ = g ()
-	 in
-	    ()
-	 end
+         let
+            val g = f a
+            val _ = Seq.foreach (v, loop)
+            val _ = g ()
+         in
+            ()
+         end
    in
       loop t
    end
 
-fun foreachPre (t, f) = traverse (t, fn a => (f a; fn () => ()))
+fun foreachPre (t, f: 'a -> unit) = traverse (t, fn a => (f a; fn () => ()))
 fun foreachPost (t, f) = traverse (t, fn a => fn () => f a)
 
 fun 'a layoutDot (t: 'a t, {nodeOptions: 'a -> Dot.NodeOption.t list,
-			    options,
-			    title}) =
+                            options,
+                            title}) =
    let
       val c = Counter.new 0
       fun next () = concat ["n", Int.toString (Counter.next c)]
       val nodes = ref []
       fun loop (T (v, cs)) =
-	 let
-	    val name = next ()
-	    val () =
-	       List.push
-	       (nodes, {name = name,
-			options = nodeOptions v,
-			successors = rev (Seq.fold (cs, [], fn (t, ac) =>
-						    {name = loop t,
-						     options = []} :: ac))})
-	 in
-	    name
-	 end
+         let
+            val name = next ()
+            val () =
+               List.push
+               (nodes, {name = name,
+                        options = nodeOptions v,
+                        successors = rev (Seq.fold (cs, [], fn (t, ac) =>
+                                                    {name = loop t,
+                                                     options = []} :: ac))})
+         in
+            name
+         end
       val _ = loop t
    in
       Dot.layout {nodes = !nodes,
-		  options = options,
-		  title = title}
+                  options = options,
+                  title = title}
    end
 
 fun layout (t, lay) =
    let
       open Layout
       fun loop (T (x, ts)) =
-	 paren (seq [lay x, str ", ", Seq.layout (ts, loop)])
+         paren (seq [lay x, str ", ", Seq.layout (ts, loop)])
    in
       loop t
    end
@@ -77,8 +78,8 @@
 end
 
 structure Tree = Tree (structure Seq =
-			  struct
-			     open Vector
+                          struct
+                             open Vector
 
-			     fun layout (v, l) = Vector.layout l v
-			  end)
+                             fun layout (v, l) = Vector.layout l v
+                          end)

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/two-list-queue-mutable.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/two-list-queue-mutable.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/two-list-queue-mutable.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 structure MutableQueue:
    sig
       type 'a t
@@ -24,12 +25,12 @@
             [] => (case !back of
                       [] => NONE
                     | l => let
-			      val _ = back := []
-			      val l = rev l
+                              val _ = back := []
+                              val l = rev l
                            in
-			      case l of
-				 [] => raise Fail "deque"
-			       | x :: l => (front := l; SOME x)
+                              case l of
+                                 [] => raise Fail "MutableQueue.deque"
+                               | x :: l => (front := l; SOME x)
                            end)
           | x :: l => (front := l; SOME x) 
    end

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/two-list-queue.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/two-list-queue.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/two-list-queue.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,8 +1,8 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 structure TwoListQueue:> QUEUE =
@@ -21,11 +21,11 @@
 fun deque (T (l, r)) =
    let
       val (l, r) = (case l of
-		       [] => (rev r, [])
-		     | _ =>  (l, r))
+                       [] => (rev r, [])
+                     | _ =>  (l, r))
    in
       case l of
-	 [] => NONE
+         [] => NONE
        | x :: l => SOME (T (l, r), x)
    end
 

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/unicode.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/unicode.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/unicode.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 structure Unicode =
 struct
 

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/unimplemented.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/unimplemented.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/unimplemented.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 structure Unimplemented =
    struct
       val op equals = fn _ => Error.unimplemented "equals"

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/unique-id.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/unique-id.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/unique-id.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 functor UniqueId():> UNIQUE_ID =
    struct
       type t = unit ref
@@ -22,7 +23,7 @@
       open Unit
 
       fun new() = ()
-	 
+         
       fun toString _ = ""
    end
 

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/unique-id.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/unique-id.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/unique-id.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature UNIQUE_ID =
    sig
       type t

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/unique-set.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/unique-set.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/unique-set.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,13 +1,14 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 structure UniqueSetRep =
    struct
       datatype 'a t = T of {elements: 'a list,
-			    plist: PropertyList.t}
+                            plist: PropertyList.t}
 
    end
 
@@ -16,108 +17,109 @@
 
 open S
 
-val _ = Assert.assert ("UniqueSet", fn () => cacheSize >= 1 andalso bits >= 1)
+val _ = Assert.assert ("UniqueSet: cacheSize, bits", fn () => 
+                       cacheSize >= 1 andalso bits >= 1)
 
 type elements = Element.t list
    
 structure Tree: sig
-		   structure Set:
-		      sig
-			 type t
+                   structure Set:
+                      sig
+                         type t
 
-			 val equals: t * t -> bool
-			 val toList: t -> elements
-			 val plist: t -> PropertyList.t
-		      end
-		   
-		   type t
-		      
-		   val new: unit -> t
-		   val insert: t * elements -> Set.t
-		   val size: t -> int
-		end =
+                         val equals: t * t -> bool
+                         val toList: t -> elements
+                         val plist: t -> PropertyList.t
+                      end
+                   
+                   type t
+                      
+                   val new: unit -> t
+                   val insert: t * elements -> Set.t
+                   val size: t -> int
+                end =
    struct
       structure Set  =
-	 struct
-	    open UniqueSetRep
-	    type t = Element.t t
-	       
-	    fun new elements = T {elements = elements,
-				  plist = PropertyList.new()}
+         struct
+            open UniqueSetRep
+            type t = Element.t t
+               
+            fun new elements = T {elements = elements,
+                                  plist = PropertyList.new()}
 
-	    fun elements (T {elements, ...}) = elements
-	    fun plist (T {plist, ...}) = plist
+            fun elements (T {elements, ...}) = elements
+            fun plist (T {plist, ...}) = plist
 
-	    val toList = elements
+            val toList = elements
 
-	    fun equals (s, s') = PropertyList.equals (plist s, plist s')
-	 end
+            fun equals (s, s') = PropertyList.equals (plist s, plist s')
+         end
 
       datatype node =
-	 Node of {element: Element.t,
-		  isIn: t,
-		  isNotIn: t}
+         Node of {element: Element.t,
+                  isIn: t,
+                  isNotIn: t}
        | Leaf of Set.t
       withtype t = node option ref
 
       fun new(): t = ref NONE
 
       fun size(t: t): int =
-	 case !t of
-	    NONE => 0
-	  | SOME(Leaf _) => 1
-	  | SOME(Node{isIn, isNotIn, ...}) => size isIn + size isNotIn
-	 
+         case !t of
+            NONE => 0
+          | SOME(Leaf _) => 1
+          | SOME(Node{isIn, isNotIn, ...}) => size isIn + size isNotIn
+         
       fun contains(es, e) = List.exists(es, fn e' => Element.equals(e, e'))
-	 
+         
       fun insert(tree, elements) =
-	 let
-	    fun loop tree =
-	       case !tree of
-		  NONE => let val s = Set.new elements
-			  in tree := SOME(Leaf s); s
-			  end
-		| SOME(Node{element, isIn, isNotIn}) =>
-		  if contains(elements, element)
-		     then loop isIn
-		  else loop isNotIn
-		| SOME(Leaf s') =>
-		     let
-			fun loop arg =
-			   case arg of
-			      ([], []) => s' (* same set *)
-			    | ([], x' :: _) =>
-				 let val s = Set.new elements
-				 in tree :=
-				    SOME(Node{element = x',
-					      isIn = ref(SOME(Leaf s')),
-					      isNotIn = ref(SOME(Leaf s))})
-				    ; s
-				 end
-			    | (x :: xs, xs') =>
-				 let
-				    fun loop2(xs', accum) =
-				       case xs' of
-					  [] =>
-					     let val s = Set.new elements
-					     in tree :=
-						SOME(Node{element = x,
-							  isIn = ref(SOME(Leaf s)),
-							  isNotIn =
-							  ref(SOME(Leaf s'))})
-						; s
-					     end
-					| x' :: xs' =>
-					     if Element.equals(x, x')
-						then loop(xs, accum @ xs')
-					     else loop2(xs', x' :: accum)
-				 in loop2(xs', [])
-				 end
-		     in loop(elements, Set.elements s')
-		     end
-	 in loop tree
-	 end
-		     
+         let
+            fun loop tree =
+               case !tree of
+                  NONE => let val s = Set.new elements
+                          in tree := SOME(Leaf s); s
+                          end
+                | SOME(Node{element, isIn, isNotIn}) =>
+                  if contains(elements, element)
+                     then loop isIn
+                  else loop isNotIn
+                | SOME(Leaf s') =>
+                     let
+                        fun loop arg =
+                           case arg of
+                              ([], []) => s' (* same set *)
+                            | ([], x' :: _) =>
+                                 let val s = Set.new elements
+                                 in tree :=
+                                    SOME(Node{element = x',
+                                              isIn = ref(SOME(Leaf s')),
+                                              isNotIn = ref(SOME(Leaf s))})
+                                    ; s
+                                 end
+                            | (x :: xs, xs') =>
+                                 let
+                                    fun loop2(xs', accum) =
+                                       case xs' of
+                                          [] =>
+                                             let val s = Set.new elements
+                                             in tree :=
+                                                SOME(Node{element = x,
+                                                          isIn = ref(SOME(Leaf s)),
+                                                          isNotIn =
+                                                          ref(SOME(Leaf s'))})
+                                                ; s
+                                             end
+                                        | x' :: xs' =>
+                                             if Element.equals(x, x')
+                                                then loop(xs, accum @ xs')
+                                             else loop2(xs', x' :: accum)
+                                 in loop2(xs', [])
+                                 end
+                     in loop(elements, Set.elements s')
+                     end
+         in loop tree
+         end
+                     
    end
 
 open Tree.Set
@@ -141,9 +143,9 @@
    
 fun fromList l =
    let val l = List.fold(l, [], fn (x, l) =>
-			 if List.exists(l, fn x' => Element.equals(x, x'))
-			    then l
-			 else x :: l)
+                         if List.exists(l, fn x' => Element.equals(x, x'))
+                            then l
+                         else x :: l)
    in intern(l, hash l)
    end
 
@@ -166,47 +168,47 @@
     ; Int.for(0, tableSize, fn i => Array.update(table, i, Tree.new())))
 
 (*      Int.foreach(0, maxIndex, fn i =>
-		  let val n = Tree.size(Vector.sub(table, i))
-		  in if n > 0
-			then Control.message(seq[Int.layout i,
-						 str " -> ",
-						 Int.layout n])
-		     else ()
-		  end)*)
+                  let val n = Tree.size(Vector.sub(table, i))
+                  in if n > 0
+                        then Control.message(seq[Int.layout i,
+                                                 str " -> ",
+                                                 Int.layout n])
+                     else ()
+                  end)*)
 
 local
    fun binary (oper: elements * elements -> elements) =
       let
-	 val cache = Array.new(cacheSize, NONE)
+         val cache = Array.new(cacheSize, NONE)
       in
-	 fn (s: t, s': t) =>
-	 let
-	    fun loop i =
-	       if i >= cacheSize
-		  then
-		     let
-			val s'' = fromList(oper(toList s, toList s'))
-			val () = Int.inc cacheMisses
-			val () =
-			   Array.update (cache,
-					 Random.natLessThan cacheSize,
-					 SOME (s, s', s''))
-		     in
-			s''
-		     end
-	       else case Array.sub(cache, i) of
-		  NONE => loop(i + 1)
-		| SOME(s1, s1', s'') =>
-		     if equals(s, s1) andalso equals(s', s1')
-			then (Int.inc cacheHits; s'')
-		     else loop(i + 1)
-	 in loop 0
-	 end
+         fn (s: t, s': t) =>
+         let
+            fun loop i =
+               if i >= cacheSize
+                  then
+                     let
+                        val s'' = fromList(oper(toList s, toList s'))
+                        val () = Int.inc cacheMisses
+                        val () =
+                           Array.update (cache,
+                                         Random.natLessThan cacheSize,
+                                         SOME (s, s', s''))
+                     in
+                        s''
+                     end
+               else case Array.sub(cache, i) of
+                  NONE => loop(i + 1)
+                | SOME(s1, s1', s'') =>
+                     if equals(s, s1) andalso equals(s', s1')
+                        then (Int.inc cacheHits; s'')
+                     else loop(i + 1)
+         in loop 0
+         end
       end
 
    val {+, -, intersect, layout, ...} =
       List.set{equals = Element.equals,
-	       layout = Element.layout}
+               layout = Element.layout}
 in
    val op + = binary op +
    val op - = binary op -

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/unique-set.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/unique-set.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/unique-set.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,18 +1,19 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 type int = Int.t
    
 signature UNIQUE_SET_STRUCTS = 
    sig
       structure Element:
-	 sig
-	    include T
-	    val hash: t -> Word.t
-	 end
+         sig
+            include T
+            val hash: t -> Word.t
+         end
 
       (* How many binary operations to cache. *)
       val cacheSize: int
@@ -24,9 +25,9 @@
 signature UNIQUE_SET =
    sig
       include UNIQUE_SET_STRUCTS
-	 
+         
       type t
-	       
+               
       val + : t * t -> t
       val - : t * t -> t
       val empty: t

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/unit.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/unit.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/unit.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,7 +1,8 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature UNIT = T where type t = unit

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/unit.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/unit.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/unit.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 structure Unit: UNIT =
 struct
 

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/url.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/url.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/url.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 (*
  * URLs, as described in RFC 2396.
  *
@@ -15,55 +16,55 @@
 signature URL =
    sig
       structure Char:
-	 sig
-	    type t = Char.t
+         sig
+            type t = Char.t
 
-	    val escapeHex: t -> string
-	 end
+            val escapeHex: t -> string
+         end
       
       structure Scheme:
-	 sig
-	    datatype t =
-	       File
-	     | Ftp
-	     | Gopher
-	     | Http
-	     | Https
-	     | Telnet
-	 end
+         sig
+            datatype t =
+               File
+             | Ftp
+             | Gopher
+             | Http
+             | Https
+             | Telnet
+         end
 
       structure Authority:
-	 sig
-	    type t = {host: string,
-		      port: int option,
-		      user: string option}
+         sig
+            type t = {host: string,
+                      port: int option,
+                      user: string option}
 
-	    val equals: t * t -> bool
-	 end
+            val equals: t * t -> bool
+         end
      
       structure Path:
-	 sig
-	    type t = {isAbsolute: bool,
-		      path: string list,
-		      file: string}
+         sig
+            type t = {isAbsolute: bool,
+                      path: string list,
+                      file: string}
 
-	    val file: t -> string
-	    val layout: t -> Layout.t
-	    val root: t
-	    val toString: t -> string
-	 end
+            val file: t -> string
+            val layout: t -> Layout.t
+            val root: t
+            val toString: t -> string
+         end
 
       datatype t =
-	 T of {authority: Authority.t option,
-	       fragment: string option,
-	       path: Path.t option,
-	       query: string option,
-	       scheme: Scheme.t option} (* NONE in relative urls *)
+         T of {authority: Authority.t option,
+               fragment: string option,
+               path: Path.t option,
+               query: string option,
+               scheme: Scheme.t option} (* NONE in relative urls *)
        | JavaScript of string
        | MailTo of string
        | News of string
        | Opaque of {scheme: string,
-		    rest: string}
+                    rest: string}
 
       val addQuery: t * string -> t
       val canonicalize: t -> t
@@ -88,17 +89,17 @@
       val unescape: string -> string (* Remove %XX escapes from string. *) 
 
       structure Regexp:
-	 sig
-	    type t = Regexp.t
+         sig
+            type t = Regexp.t
 
-	    val absoluteUrl: t
-	    val absPath: t
-	    val authority: t
-	    val query: t
+            val absoluteUrl: t
+            val absPath: t
+            val authority: t
+            val query: t
 
-	    val getAbsPath: Regexp.Match.t -> Path.t
-	    val peekQuery: Regexp.Match.t -> string option
-	 end
+            val getAbsPath: Regexp.Match.t -> Path.t
+            val peekQuery: Regexp.Match.t -> string option
+         end
    end
 
 functor TestUrl (S: URL): sig end =
@@ -108,61 +109,61 @@
 
 val _ =
    Assert.assert
-   ("Url.resolve", fn () =>
+   ("TestUrl.resolve", fn () =>
     (* Examples from RFC 2396, Appendix C. *)
     let
        val base = valOf (fromString "http://a/b/c/d;p?q")
        val examples =
-	  [("g", "http://a/b/c/g"),
-	   ("./g", "http://a/b/c/g"),
-	   ("g/", "http://a/b/c/g/"),
-	   ("/g", "http://a/g"),
-	   ("?y", "http://a/b/c/?y"),
-	   ("g?y", "http://a/b/c/g?y"),
-	   ("#s", "http://a/b/c/d;p?q#s"),
-	   ("g#s", "http://a/b/c/g#s"),
-	   ("g?y#s", "http://a/b/c/g?y#s"),
-	   (";x", "http://a/b/c/;x"),
-	   ("g;x", "http://a/b/c/g;x"),
-	   ("g;x?y#s", "http://a/b/c/g;x?y#s"),
-	   (".", "http://a/b/c/"),
-	   ("./", "http://a/b/c/"),
-	   ("..", "http://a/b/"),
-	   ("../", "http://a/b/"),
-	   ("../g", "http://a/b/g"),
-	   ("../..", "http://a/"),
-	   ("../../", "http://a/"),
-	   ("../../g", "http://a/g")]
+          [("g", "http://a/b/c/g"),
+           ("./g", "http://a/b/c/g"),
+           ("g/", "http://a/b/c/g/"),
+           ("/g", "http://a/g"),
+           ("?y", "http://a/b/c/?y"),
+           ("g?y", "http://a/b/c/g?y"),
+           ("#s", "http://a/b/c/d;p?q#s"),
+           ("g#s", "http://a/b/c/g#s"),
+           ("g?y#s", "http://a/b/c/g?y#s"),
+           (";x", "http://a/b/c/;x"),
+           ("g;x", "http://a/b/c/g;x"),
+           ("g;x?y#s", "http://a/b/c/g;x?y#s"),
+           (".", "http://a/b/c/"),
+           ("./", "http://a/b/c/"),
+           ("..", "http://a/b/"),
+           ("../", "http://a/b/"),
+           ("../g", "http://a/b/g"),
+           ("../..", "http://a/"),
+           ("../../", "http://a/"),
+           ("../../g", "http://a/g")]
        fun checkResolve (rel, abs) =
-	  abs = toString (resolve {base = base,
-				   relative = valOf (fromString rel)})
+          abs = toString (resolve {base = base,
+                                   relative = valOf (fromString rel)})
        val checkResolve =
-	  Trace.trace2
-	  ("Url.checkResolve", String.layout, String.layout, Bool.layout)
-	  checkResolve
+          Trace.trace2
+          ("TestUrl.checkResolve", String.layout, String.layout, Bool.layout)
+          checkResolve
     in List.forall ([("g:h", "g:h"), ("//g", "http://g")],
-		    checkResolve)
+                    checkResolve)
        andalso
        List.forall
        (examples, fn (rel, abs) =>
-	checkResolve (rel, abs) andalso
-	checkResolve (toString
-		      (valOf
-		       (relativize {base = base,
-				    relative = valOf (fromString abs)})),
-		      abs))
+        checkResolve (rel, abs) andalso
+        checkResolve (toString
+                      (valOf
+                       (relativize {base = base,
+                                    relative = valOf (fromString abs)})),
+                      abs))
     end)
 
 val _ =
    Assert.assert
-   ("Url", fn () =>
+   ("TestUrl", fn () =>
     fromString "mailto:sweeks@sweeks.com" = SOME (MailTo "sweeks@sweeks.com")
     andalso isSome
-	    (fromString "http://sports.latimes.com/RealMedia/ads/adstream_lx.ads/sports.latimes.com/stats/oth/oth/oth/columnists.html/21801/Top/NextCardGW002/u40_card_dreamer_V3.gif/63306138643531333339663061393230")
+            (fromString "http://sports.latimes.com/RealMedia/ads/adstream_lx.ads/sports.latimes.com/stats/oth/oth/oth/columnists.html/21801/Top/NextCardGW002/u40_card_dreamer_V3.gif/63306138643531333339663061393230")
     andalso isSome (fromString
-	   "http://dps1.travelocity.com:80/airpprice.ctl?previous_page=airpdisp&mixed_gt=N&tkt_status=N&option_num=1&seg_for_sell=1%26SJC%26San%20Jose,%20CA%2620001123%260750%26AA%26American%20Airlines%262456%26L%260%26McDonnell%20Douglas%20SP80%20Jet%26DFW%26Dallas%2fFt%20Worth,%20TX%261313%2620001123%26Thursday%26%26%26S80%26Y|1%26DFW%26Dallas%2fFt%20Worth,%20TX%2620001123%261433%26AA%26American%20Airlines%263741%26L%260%26Embraer%20ERJ-145%20Jet%26OKC%26Oklahoma%20City,%20OK%261529%2620001123%26Thursday%26%26%26ER4%26Y%3a1%26DFW%26Dallas%2fFt%20Worth,%20TX%2620001126%260918%26AA%26American%20Airlines%262451%26V%260%26McDonnell%20Douglas%20SP80%20Jet%26SJC%26San%20Jose,%20CA%261057%2620001126%26Sunday%26%26%26S80%26Y&hold_flag=N&SEQ=97122479938121310102000&LANG=EN&last_pgd_page=airpdisp.pgd")
+           "http://dps1.travelocity.com:80/airpprice.ctl?previous_page=airpdisp&mixed_gt=N&tkt_status=N&option_num=1&seg_for_sell=1%26SJC%26San%20Jose,%20CA%2620001123%260750%26AA%26American%20Airlines%262456%26L%260%26McDonnell%20Douglas%20SP80%20Jet%26DFW%26Dallas%2fFt%20Worth,%20TX%261313%2620001123%26Thursday%26%26%26S80%26Y|1%26DFW%26Dallas%2fFt%20Worth,%20TX%2620001123%261433%26AA%26American%20Airlines%263741%26L%260%26Embraer%20ERJ-145%20Jet%26OKC%26Oklahoma%20City,%20OK%261529%2620001123%26Thursday%26%26%26ER4%26Y%3a1%26DFW%26Dallas%2fFt%20Worth,%20TX%2620001126%260918%26AA%26American%20Airlines%262451%26V%260%26McDonnell%20Douglas%20SP80%20Jet%26SJC%26San%20Jose,%20CA%261057%2620001126%26Sunday%26%26%26S80%26Y&hold_flag=N&SEQ=97122479938121310102000&LANG=EN&last_pgd_page=airpdisp.pgd")
     andalso isSome (fromString
-		   "large-int.html#SIG:INT_INF.\\|@LT\\|\\|@LT\\|:VAL:SPEC")
+                   "large-int.html#SIG:INT_INF.\\|@LT\\|\\|@LT\\|:VAL:SPEC")
     andalso
     List.forall
     ([("http://Norma140.emp3.com/cgibin/optin/remove.pl",
@@ -212,7 +213,7 @@
       ("http://ad.doubleclick.net/adj/N674.briefing.com/B22024;abr=!ie;sz=125x125;ord= [timestamp]?",
        SOME Scheme.Http, NONE, "ad.doubleclick.net", NONE,
        SOME (true, ["adj", "N674.briefing.com"],
-	    "B22024;abr=!ie;sz=125x125;ord= [timestamp]"),
+            "B22024;abr=!ie;sz=125x125;ord= [timestamp]"),
        SOME "",
        NONE),
       ("http://tac.eecs.umich.edu/cgi-bin/botuser/ViewAccount?VIEW=INFO&VIEWALL= [bad label VIEWALL]",
@@ -229,12 +230,12 @@
     fn (s, scheme, user, host, port, path, query, fragment) =>
     valOf (fromString s)
     = T {scheme = scheme,
-	authority = SOME {user = user,
-			 host = host,
-			 port = port},
-	path = Option.map (path, fn (i, p, f) => {isAbsolute = i,
-						 path = p, file = f}),
-	query = query,
-	fragment = fragment}))
+        authority = SOME {user = user,
+                         host = host,
+                         port = port},
+        path = Option.map (path, fn (i, p, f) => {isAbsolute = i,
+                                                 path = p, file = f}),
+        query = query,
+        fragment = fragment}))
 
 end

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/url.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/url.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/url.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,8 +1,8 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 structure Url: URL =
@@ -17,21 +17,21 @@
       val radix: int = 16
 
       fun fromHexChars (hi: t, lo: t) =
-	 chr (toHexDigit hi * radix + toHexDigit lo)
+         chr (toHexDigit hi * radix + toHexDigit lo)
 
       fun toHexChars (c: t): t * t =
-	 let
-	    val (hi, lo) = Int.divMod (ord c, radix)
-	 in
-	    (fromHexDigit hi, fromHexDigit lo)
-	 end
+         let
+            val (hi, lo) = Int.divMod (ord c, radix)
+         in
+            (fromHexDigit hi, fromHexDigit lo)
+         end
 
       fun escapeHex (c: t): string =
-	 let
-	    val (hi, lo) = toHexChars c
-	 in
-	    implode [#"%", hi, lo]
-	 end
+         let
+            val (hi, lo) = toHexChars c
+         in
+            implode [#"%", hi, lo]
+         end
 
    end
 
@@ -40,22 +40,22 @@
       fun sub i = String.sub (s, i)
       val n = String.size s
       fun loop (i, cs) =
-	 if i >= n
-	    then implode (rev cs)
-	 else let val c = sub i
-	      in if c = #"%"
-		    then loop (i + 3,
-			      Char.fromHexChars (sub (i + 1), sub (i + 2)) :: cs)
-		 else loop (i + 1, c :: cs)
-	      end
+         if i >= n
+            then implode (rev cs)
+         else let val c = sub i
+              in if c = #"%"
+                    then loop (i + 3,
+                              Char.fromHexChars (sub (i + 1), sub (i + 2)) :: cs)
+                 else loop (i + 1, c :: cs)
+              end
    in loop (0, [])
    end   
 
 val shouldEscape: char -> bool =
    Char.memoize (fn c => 
-		not (Char.isGraph c)
-		orelse c = Char.dquote
-		orelse String.contains ("?<>#% {}|\\^ []`", c))
+                not (Char.isGraph c)
+                orelse c = Char.dquote
+                orelse String.contains ("?<>#% {}|\\^ []`", c))
 
 val shouldEscape =
    Trace.trace ("Url.shouldEscape", Char.layout, Bool.layout) shouldEscape
@@ -70,7 +70,7 @@
 structure Scheme =
    struct
       datatype t =
-	 File
+         File
        | Ftp
        | Gopher
        | Http
@@ -78,20 +78,20 @@
        | Telnet
 
       val map =
-	 [("file", File),
-	  ("ftp", Ftp),
-	  ("gopher", Gopher),
-	  ("http", Http),
-	  ("https", Https),
-	  ("telnet", Telnet)]
-	 
+         [("file", File),
+          ("ftp", Ftp),
+          ("gopher", Gopher),
+          ("http", Http),
+          ("https", Https),
+          ("telnet", Telnet)]
+         
       val fromString =
-	 String.memoizeList (fn _ => Error.bug "Scheme.fromString", map)
+         String.memoizeList (fn _ => Error.bug "Url.Scheme.fromString", map)
 
       val equals = op =
-	 
+         
       fun toString s =
-	 #1 (valOf (List.peek (map, fn (_, s') => equals (s, s'))))
+         #1 (valOf (List.peek (map, fn (_, s') => equals (s, s'))))
 
       val layout = Layout.str o toString
    end
@@ -99,27 +99,27 @@
 structure Authority =
    struct
       type t = {user: string option,
-		host: string,
-		port: int option}
+                host: string,
+                port: int option}
 
       fun layout ({user, host, port}: t) =
-	 Layout.record [("user", Option.layout String.layout user),
-			("host", String.layout host),
-			("port", Option.layout Int.layout port)]
+         Layout.record [("user", Option.layout String.layout user),
+                        ("host", String.layout host),
+                        ("port", Option.layout Int.layout port)]
 
       fun canonicalize {user, host, port} =
-	 {user = Option.map (user, String.toLower),
-	  host = String.toLower host,
-	  port = port}
-	 
+         {user = Option.map (user, String.toLower),
+          host = String.toLower host,
+          port = port}
+         
       fun equals ({user = u, host = h, port = p}: t,
-		 {user = u', host = h', port = p'}: t): bool =
-	 Option.equals (u, u', String.equals)
-	 andalso String.toLower h = String.toLower h'
-	 andalso Option.equals (p, p', Port.equals)
+                 {user = u', host = h', port = p'}: t): bool =
+         Option.equals (u, u', String.equals)
+         andalso String.toLower h = String.toLower h'
+         andalso Option.equals (p, p', Port.equals)
 
       val equals =
-	 Trace.trace2 ("Authority.equals", layout, layout, Bool.layout) equals
+         Trace.trace2 ("Url.Authority.equals", layout, layout, Bool.layout) equals
    end
 
 (* The numbers in comments are rule numbers from Section 5.2 of RFC 2396. *)
@@ -129,80 +129,80 @@
 fun canonicalizePath (p1: string list, p2: string list, f: string) =
    let 
       fun loop (r, ac) =
-	 case r of
-	    [] =>
-	       (case f of
-		   "." => (rev ac, "") (* 6d *)
-		 | ".." => (case ac of
-			       [] => ([], "..")
-			     | ".." :: _ => (rev ac, "..")
-			     | _ :: ac => (rev ac, "")) (* 6f *)
-		 | _ => (rev ac, f))
-	  | "" :: r => loop (r, ac)
-	  | "." :: r => loop (r, ac) (* 6c *)
-	  | ".." :: r => loop (r,
-			      case ac of
-				 [] => [".."]
-			       | ".." :: _ => ".." :: ac
-			       | _ :: ac => ac) (* 6e *)
-	  | s :: r => loop (r, s :: ac)
+         case r of
+            [] =>
+               (case f of
+                   "." => (rev ac, "") (* 6d *)
+                 | ".." => (case ac of
+                               [] => ([], "..")
+                             | ".." :: _ => (rev ac, "..")
+                             | _ :: ac => (rev ac, "")) (* 6f *)
+                 | _ => (rev ac, f))
+          | "" :: r => loop (r, ac)
+          | "." :: r => loop (r, ac) (* 6c *)
+          | ".." :: r => loop (r,
+                              case ac of
+                                 [] => [".."]
+                               | ".." :: _ => ".." :: ac
+                               | _ :: ac => ac) (* 6e *)
+          | s :: r => loop (r, s :: ac)
    in loop (p2, rev p1)
    end
 
 structure Path =
    struct
       type t = {file: string,
-		isAbsolute: bool,
-		path: string list}
+                isAbsolute: bool,
+                path: string list}
 
       local
-	 fun make f (p: t) = f p
+         fun make f (p: t) = f p
       in
-	 val file = make #file
-	 val isAbsolute = make #isAbsolute
-	 val path = make #path
+         val file = make #file
+         val isAbsolute = make #isAbsolute
+         val path = make #path
       end
-	    
+            
       val root = {isAbsolute = true,
-		  path = [],
-		  file = ""}
+                  path = [],
+                  file = ""}
 
       fun canonicalize {isAbsolute = i, path = p, file = f} =
-	 let val (p, f) = canonicalizePath ([], p, f)
-	 in {isAbsolute = i, path = p, file = f}
-	 end
+         let val (p, f) = canonicalizePath ([], p, f)
+         in {isAbsolute = i, path = p, file = f}
+         end
 
       fun toString ({isAbsolute, path, file}) =
-	 concat [if isAbsolute then "/" else "",
-		 escape (concat (List.separate (path @ [file], "/")))]
+         concat [if isAbsolute then "/" else "",
+                 escape (concat (List.separate (path @ [file], "/")))]
 
       val layout = Layout.str o toString
    end
 
 datatype t =
    T of {authority: Authority.t option,
-	 fragment: string option,
-	 path: Path.t option,
-	 query: string option,
-	 scheme: Scheme.t option} (* NONE in relative urls *)
+         fragment: string option,
+         path: Path.t option,
+         query: string option,
+         scheme: Scheme.t option} (* NONE in relative urls *)
   | JavaScript of string
   | MailTo of string
   | News of string
   | Opaque of {scheme: string,
-	       rest: string}
+               rest: string}
     
 fun addQuery (u: t, q) =
    case u of
       T {authority, fragment, path, query, scheme}=>
-	 if isSome query
-	    then Error.bug "addQuery"
-	 else
-	    T {authority = authority,
-	       fragment = fragment,
-	       path = path,
-	       query = SOME q,
-	       scheme = scheme}
-    | _ => Error.bug "addQuery"
+         if isSome query
+            then Error.bug "Url.addQuery"
+         else
+            T {authority = authority,
+               fragment = fragment,
+               path = path,
+               query = SOME q,
+               scheme = scheme}
+    | _ => Error.bug "Url.addQuery"
    
 fun host (u: t): string =
    case u of
@@ -222,17 +222,17 @@
 fun toString url =
    case url of
       T {scheme, authority, path, query, fragment} =>
-	 concat [mo (scheme, fn s => concat [Scheme.toString s, ":"]),
-		 mo (authority, fn {user, host, port} => 
-		    concat ["//",
-			   mo (user, fn u => concat [escape u, "@"]),
-			   host,
-			   mo (port, fn p => concat [":", Int.toString p])]),
-		 mo (path, Path.toString),
-		 mo (query, fn q => concat ["?", if !escapeQuery then escape q
-					       else q]),
-		 mo (fragment, fn f => concat ["#", escape f])
-		 ]
+         concat [mo (scheme, fn s => concat [Scheme.toString s, ":"]),
+                 mo (authority, fn {user, host, port} => 
+                    concat ["//",
+                           mo (user, fn u => concat [escape u, "@"]),
+                           host,
+                           mo (port, fn p => concat [":", Int.toString p])]),
+                 mo (path, Path.toString),
+                 mo (query, fn q => concat ["?", if !escapeQuery then escape q
+                                               else q]),
+                 mo (fragment, fn f => concat ["#", escape f])
+                 ]
     | JavaScript s => concat ["javascript:", escape s]
     | MailTo email => concat ["mailto:", escape email]
     | News group => concat ["news:", escape group]
@@ -246,10 +246,10 @@
 val layout =
    fn T {scheme, authority, path, query, fragment} =>
         Layout.record [("scheme", Option.layout Scheme.layout scheme),
-		       ("authority", Option.layout Authority.layout authority),
-		       ("path", Option.layout Path.layout path),
-		       ("query", Option.layout String.layout query),
-		       ("fragment", Option.layout String.layout fragment)]
+                       ("authority", Option.layout Authority.layout authority),
+                       ("path", Option.layout Path.layout path),
+                       ("query", Option.layout String.layout query),
+                       ("fragment", Option.layout String.layout fragment)]
     | u => layout u
 
 val equals = op =
@@ -284,54 +284,54 @@
  *)
 (*      val query = save (star urlc, query') *)
       val query = save (star (isChar (fn c => Char.isPrint c
-				      andalso c <> #"#")),
-			query')
+                                      andalso c <> #"#")),
+                        query')
       val port' = Save.new ()
       val port = save (star digit, port')
       val IPv4address = seq [oneOrMore digit, char #".",
-			     oneOrMore digit, char #".",
-			     oneOrMore digit, char #".",
-			     oneOrMore digit]
+                             oneOrMore digit, char #".",
+                             oneOrMore digit, char #".",
+                             oneOrMore digit]
       val toplabel = or [alpha,
-			 seq [alpha, star (or [alphanum, char #"-"]), alphanum]]
+                         seq [alpha, star (or [alphanum, char #"-"]), alphanum]]
       val domainlabel = or [alphanum,
-			   seq [alphanum,
-			       star (or [alphanum, char #"-"]),
-			       alphanum]]
+                           seq [alphanum,
+                               star (or [alphanum, char #"-"]),
+                               alphanum]]
       val hostname = seq [star (seq [domainlabel, char #"."]),
-			  toplabel,
-			  optional (char #".")]
+                          toplabel,
+                          optional (char #".")]
       val host' = Save.new ()
       val host = save (or [hostname, IPv4address], host')
       val hostport = seq [host, optional (seq [char #":", port])]
       val userinfo' = Save.new ()
       val userinfo =
-	 save (star (or [unreserved, escaped, oneOf ";:&=+$"]), userinfo')
+         save (star (or [unreserved, escaped, oneOf ";:&=+$"]), userinfo')
       val server = optional (seq [optional (seq [userinfo, char #"@"]),
-				  hostport])
+                                  hostport])
       val regName' = Save.new ()
       val regName =
-	 save (oneOrMore (or [unreserved,
-			      escaped,
-			      oneOf "$,;:@&=+"]),
-	       regName')
+         save (oneOrMore (or [unreserved,
+                              escaped,
+                              oneOf "$,;:@&=+"]),
+               regName')
       val authority = or [server, regName]
       val scheme' = Save.new ()
       val scheme =
-	 save (seq [alpha, star (or [alpha, digit, oneOf "+-."])], scheme')
+         save (seq [alpha, star (or [alpha, digit, oneOf "+-."])], scheme')
       val relSegment' = Save.new ()
       val relSegment =
-	 save (oneOrMore (or [unreserved, escaped, oneOf ";@&=+$,"]),
-	       relSegment')
+         save (oneOrMore (or [unreserved, escaped, oneOf ";@&=+$,"]),
+               relSegment')
       (* val pchar = or [unreserved, escaped, oneOf ":@&=+$,", wrong] *)
       (* val param = star pchar *)
       (* val segment = seq [star pchar, star (seq [char #";", param])] *)
       (* val pathSegments = seq [segment, star (seq [char #"/", segment])] *)
       val pathSegments' = Save.new ()
       val pathSegments =
-	 save (star (isChar (fn c => (Char.isPrint c andalso
-				      not (String.contains ("?#", c))))),
-	       pathSegments')
+         save (star (isChar (fn c => (Char.isPrint c andalso
+                                      not (String.contains ("?#", c))))),
+               pathSegments')
       val absPath = seq [char #"/", pathSegments]
       val relPath = seq [relSegment, optional absPath]
       val netPath = seq [string "//", authority, optional absPath]
@@ -339,96 +339,96 @@
       val opaquePart' = Save.new ()
       val opaquePart = save (seq [urlcNoSlash, star urlc], opaquePart')
       val hierPart = seq [or [netPath, absPath],
-			  optional (seq [char #"?", query])]
+                          optional (seq [char #"?", query])]
       (* netPath occurs before absPath in the following regexp because
        * you want urls like //foo.com/z to be a netPath with host foo.com and 
        * not as an absPath.  Fortunately, the regexp library returns the
        * first matching choice in an or.
        *)
       val relativeUrl =
-	 seq [or [netPath, absPath, relPath,
-		  null (* null added for empty urls -- these are
-			* not in RFC 2396 as far as I can tell, but
-			* some of their examples use them.
-			*)
-		  ],
-	      optional (seq [char #"?", query])]
+         seq [or [netPath, absPath, relPath,
+                  null (* null added for empty urls -- these are
+                        * not in RFC 2396 as far as I can tell, but
+                        * some of their examples use them.
+                        *)
+                  ],
+              optional (seq [char #"?", query])]
       val absoluteUrl = seq [scheme, char #":", or [hierPart, opaquePart]]
       val url = seq [optional (or [absoluteUrl, relativeUrl]),
-		     optional (seq [char #"#", fragment])]
+                     optional (seq [char #"#", fragment])]
       val url = Promise.lazy (fn () => compileDFA url)
 
       fun peekQuery (m: Match.t): string option =
-	 Option.map (Match.peek (m, query'), fn ss =>
-		     let
-			val s = Substring.toString ss
-		     in
-			if !escapeQuery
-			   then unescape s
-			else s
-		     end)
-	 
+         Option.map (Match.peek (m, query'), fn ss =>
+                     let
+                        val s = Substring.toString ss
+                     in
+                        if !escapeQuery
+                           then unescape s
+                        else s
+                     end)
+         
       fun getAbsPath (m: Match.t): Path.t =
-	 case Match.peek (m, pathSegments') of
-	    NONE => Error.bug "getAbsPath"
-	  | SOME ss =>
-	       let
-		  val s = Substring.toString ss
-		  val (p, f) =
-		     List.splitLast
-		     (String.fields (unescape s, fn c => c = #"/"))
-	       in {isAbsolute = true, path = p, file = f}
-	       end
+         case Match.peek (m, pathSegments') of
+            NONE => Error.bug "Url.Regexp.getAbsPath"
+          | SOME ss =>
+               let
+                  val s = Substring.toString ss
+                  val (p, f) =
+                     List.splitLast
+                     (String.fields (unescape s, fn c => c = #"/"))
+               in {isAbsolute = true, path = p, file = f}
+               end
    end
 
 fun getMatch (m: Regexp.Match.t): t =
    let open Regexp
       val {peek, lookup, exists, ...} = Match.stringFuns m
    in if exists opaquePart'
-	 then
-	    let
-	       val scheme = String.toLower (lookup scheme')
-	       val rest = unescape (lookup opaquePart')
-	    in case scheme of
-	       "javascript" => JavaScript rest
-	     | "mailto" => MailTo rest
-	     | "news" => News rest
-	     | _ => Opaque {scheme = scheme, rest = rest}
-	    end
+         then
+            let
+               val scheme = String.toLower (lookup scheme')
+               val rest = unescape (lookup opaquePart')
+            in case scheme of
+               "javascript" => JavaScript rest
+             | "mailto" => MailTo rest
+             | "news" => News rest
+             | _ => Opaque {scheme = scheme, rest = rest}
+            end
       else
-	 let
-	    val authority =
-	       if exists host'
-		  then
-		     SOME {user = Option.map (peek userinfo', unescape),
-			   host = lookup host',
-			   port = Option.map (peek port',
-					      valOf o Int.fromString)}
-	       else NONE
-	    fun split ss = String.fields (unescape ss, fn c => c = #"/")
-	    val path =
-	       case (Option.map (peek relSegment', unescape),
-		     Option.map (peek pathSegments', split)) of
-		  (NONE, NONE) => NONE
-		| (SOME file, NONE) => SOME {isAbsolute = false,
-					     path = [],
-					     file = file}
-		| (NONE, SOME ss) =>
-		     let val (p, f) = List.splitLast ss
-		     in SOME {isAbsolute = true,
-			      path = p, file = f}
-		     end
-		| (SOME s, SOME ss) =>
-		     let val (p, f) = List.splitLast ss
-		     in SOME {isAbsolute = false,
-			      path = s :: p, file = f}
-		     end
-	 in T {scheme = Option.map (peek scheme', Scheme.fromString),
-	       authority = authority,
-	       path = path,
-	       query = peekQuery m,
-	       fragment = Option.map (peek fragment', unescape)}
-	 end
+         let
+            val authority =
+               if exists host'
+                  then
+                     SOME {user = Option.map (peek userinfo', unescape),
+                           host = lookup host',
+                           port = Option.map (peek port',
+                                              valOf o Int.fromString)}
+               else NONE
+            fun split ss = String.fields (unescape ss, fn c => c = #"/")
+            val path =
+               case (Option.map (peek relSegment', unescape),
+                     Option.map (peek pathSegments', split)) of
+                  (NONE, NONE) => NONE
+                | (SOME file, NONE) => SOME {isAbsolute = false,
+                                             path = [],
+                                             file = file}
+                | (NONE, SOME ss) =>
+                     let val (p, f) = List.splitLast ss
+                     in SOME {isAbsolute = true,
+                              path = p, file = f}
+                     end
+                | (SOME s, SOME ss) =>
+                     let val (p, f) = List.splitLast ss
+                     in SOME {isAbsolute = false,
+                              path = s :: p, file = f}
+                     end
+         in T {scheme = Option.map (peek scheme', Scheme.fromString),
+               authority = authority,
+               path = path,
+               query = peekQuery m,
+               fragment = Option.map (peek fragment', unescape)}
+         end
    end
 
 fun fromString (urlString: string): t option =
@@ -451,41 +451,41 @@
    case (b, r) of
       (T {scheme = SOME s, authority = SOME a, path = p, ...},
        T {scheme = SOME s', authority = SOME a', path = p', query = q',
-	  fragment = f'}) =>
+          fragment = f'}) =>
       if Scheme.equals (s, s')
-	 andalso Authority.equals (a, a')
-	 then let
-		 fun some (p, f) =
-		    let
-		       val (p, f) =
-			  case (p, f) of
-			     ([], "") => ([], ".")
-			   | _ => (p, f)
-		    in SOME {isAbsolute = false, path = p, file = f}
-		    end
-		 val p': Path.t option =
-		    case (p, p') of
-		       (NONE, NONE) => NONE
-		     | (NONE, SOME {path, file, ...}) => some (path, file)
-		     | (SOME {path, ...}, NONE) =>
-			  some (List.map (path, fn _ => ".."), "")
-		     | (SOME {path = p, ...}, SOME {path = p', file, ...}) =>
-			  let
-			     val (p, p') =
-				List.removeCommonPrefix (p, p', String.equals)
+         andalso Authority.equals (a, a')
+         then let
+                 fun some (p, f) =
+                    let
+                       val (p, f) =
+                          case (p, f) of
+                             ([], "") => ([], ".")
+                           | _ => (p, f)
+                    in SOME {isAbsolute = false, path = p, file = f}
+                    end
+                 val p': Path.t option =
+                    case (p, p') of
+                       (NONE, NONE) => NONE
+                     | (NONE, SOME {path, file, ...}) => some (path, file)
+                     | (SOME {path, ...}, NONE) =>
+                          some (List.map (path, fn _ => ".."), "")
+                     | (SOME {path = p, ...}, SOME {path = p', file, ...}) =>
+                          let
+                             val (p, p') =
+                                List.removeCommonPrefix (p, p', String.equals)
 
-			  in some (List.map (p, fn _ => "..") @ p', file)
-			  end
-	      in SOME (T {scheme = NONE, authority = NONE, path = p', query = q',
-			  fragment = f'})
-	      end
+                          in some (List.map (p, fn _ => "..") @ p', file)
+                          end
+              in SOME (T {scheme = NONE, authority = NONE, path = p', query = q',
+                          fragment = f'})
+              end
       else NONE
-			| _ => NONE
+                        | _ => NONE
    
 val relativize =
    Trace.trace ("Url.relativize",
-	       fn {base = b, relative = r} => Layout.tuple [layout b, layout r],
-	       Option.layout layout)
+               fn {base = b, relative = r} => Layout.tuple [layout b, layout r],
+               Option.layout layout)
    relativize
 
 (* ------------------------------------------------- *)
@@ -499,28 +499,28 @@
     | (T {scheme = s, authority = a, path = p, query = q, ...},
        T {authority = a', path = p', query = q', fragment = f', ...}) =>
       let
-	 val (a, p, q) =
-	    case (a', p', q') of
-	       (SOME _, _, _) => (a', p', q') (* 4 *)
-	     | (_, NONE, NONE) => (a, p, q) (* 2 *)
-	     | (_, NONE, SOME _) => (* 6 *)
-		  let
-		     val p =
-			Option.map (p, fn {isAbsolute, path, file} =>
-				   {isAbsolute = isAbsolute,
-				    path = path,
-				    file = ""})
-		  in (a, p, q')
-		  end
-	     | (_, SOME {isAbsolute = true, ...}, _) => (a, p', q') (* 5 *)
-	     | (_, SOME {isAbsolute = false, path = p', file = f'}, _) => (* 6 *)
-		  let
-		     val (p', f') =
-			case p of
-			   NONE => (p', f')
-			 | SOME {path, ...} => canonicalizePath (path, p', f')
-		  in (a, SOME {isAbsolute = true, path = p', file = f'}, q')
-		  end
+         val (a, p, q) =
+            case (a', p', q') of
+               (SOME _, _, _) => (a', p', q') (* 4 *)
+             | (_, NONE, NONE) => (a, p, q) (* 2 *)
+             | (_, NONE, SOME _) => (* 6 *)
+                  let
+                     val p =
+                        Option.map (p, fn {isAbsolute, path, file} =>
+                                   {isAbsolute = isAbsolute,
+                                    path = path,
+                                    file = ""})
+                  in (a, p, q')
+                  end
+             | (_, SOME {isAbsolute = true, ...}, _) => (a, p', q') (* 5 *)
+             | (_, SOME {isAbsolute = false, path = p', file = f'}, _) => (* 6 *)
+                  let
+                     val (p', f') =
+                        case p of
+                           NONE => (p', f')
+                         | SOME {path, ...} => canonicalizePath (path, p', f')
+                  in (a, SOME {isAbsolute = true, path = p', file = f'}, q')
+                  end
       in T {scheme = s, authority = a, path = p, query = q, fragment = f'}
       end
      | _ => relative
@@ -539,11 +539,11 @@
 fun canonicalize (u: t): t =
    case u of
       T {scheme, authority, path, query, fragment} =>
-	 T {scheme = scheme,
-	   authority = Option.map (authority, Authority.canonicalize),
-	   path = Option.map (path, Path.canonicalize),
-	   query = query,
-	   fragment = fragment}
+         T {scheme = scheme,
+           authority = Option.map (authority, Authority.canonicalize),
+           path = Option.map (path, Path.canonicalize),
+           query = query,
+           fragment = fragment}
     | _ => u
 
 

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/vector.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/vector.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/vector.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,13 +1,14 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 functor Vector (S: sig
-		      include VECTOR_STRUCTS
-		      val unsafeSub: 'a t * int -> 'a
-		   end): VECTOR =
+                      include VECTOR_STRUCTS
+                      val unsafeSub: 'a t * int -> 'a
+                   end): VECTOR =
 struct
 
 open S
@@ -30,22 +31,22 @@
    let
       val n = length v
       fun loop (i, b) =
-	 if i >= n
-	    then g b
-	 else
-	    case f (i, unsafeSub (v, i), b) of
-	       Continue b => loop (i + 1, b)
-	     | Done c => c
+         if i >= n
+            then g b
+         else
+            case f (i, unsafeSub (v, i), b) of
+               Continue b => loop (i + 1, b)
+             | Done c => c
    in
       if 0 <= start andalso start <= n
-	 then loop (start, b)
+         then loop (start, b)
       else Error.bug "Vector.fold'"
    end
 
 fun foldFrom (v, start, b, f) =
    fold' (v, start, b,
-	  fn (_, a, b) => Continue (f (a, b)),
-	  fn b => b)
+          fn (_, a, b) => Continue (f (a, b)),
+          fn b => b)
 
 fun fold (a, b, f) = foldFrom (a, 0, b, f)
 
@@ -65,21 +66,21 @@
 
 fun existsR (v, start, stop, f) =
    fold' (v, start, (),
-	  fn (i, a, ()) => if i = stop
-			      then Done false
-			   else if f a
-				   then Done true
-				else Continue (),
-	  fn _ => false)
+          fn (i, a, ()) => if i = stop
+                              then Done false
+                           else if f a
+                                   then Done true
+                                else Continue (),
+          fn _ => false)
 
 fun foldi (v, b, f) = fold' (v, 0, b, Continue o f, fn b => b)
 
 fun loopi (v, f, g) =
    fold' (v, 0, (),
-	  fn (i, a, ()) => (case f (i, a) of
-			       NONE => Continue ()
-			     | SOME b => Done b),
-	  g)
+          fn (i, a, ()) => (case f (i, a) of
+                               NONE => Continue ()
+                             | SOME b => Done b),
+          g)
 
 fun loop (v, f, g) = loopi (v, f o #2, g)
 
@@ -87,31 +88,31 @@
    let
       val n = length v
       fun loop i =
-	 if i = n
-	    then NONE
-	 else
-	    (case f (sub (v, i)) of
-		NONE => loop (i + 1)
-	      | SOME b => SOME (i, b))
+         if i = n
+            then NONE
+         else
+            (case f (sub (v, i)) of
+                NONE => loop (i + 1)
+              | SOME b => SOME (i, b))
    in
       loop 0
    end
 
 fun peekMap (v, f) =
    loop (v,
-	 fn a => (case f a of
-		     NONE => NONE
-		   | z => SOME z),
-	 fn () => NONE)
+         fn a => (case f a of
+                     NONE => NONE
+                   | z => SOME z),
+         fn () => NONE)
 
 fun fromListMap (l, f) =
    let
       val r = ref l
    in
       tabulate (List.length l, fn _ =>
-		case !r of
-		   [] => Error.bug "Vector.fromListMap"
-		 | x :: l => (r := l; f x))
+                case !r of
+                   [] => Error.bug "Vector.fromListMap"
+                 | x :: l => (r := l; f x))
    end
 
 fun fromList l = fromListMap (l, fn x => x)
@@ -121,13 +122,13 @@
       val n = length a
       val n' = length a'
       fun loop (i, b) =
-	 if i < 0
-	    then b
-	 else loop (i - 1, f (unsafeSub (a, i), unsafeSub (a', i), b))
+         if i < 0
+            then b
+         else loop (i - 1, f (unsafeSub (a, i), unsafeSub (a', i), b))
    in
       if n = n'
-	 then loop (n - 1, b)
-      else raise Fail "Vector.foldr2"
+         then loop (n - 1, b)
+      else Error.bug "Vector.foldr2"
    end
    
 fun foldi2From (a, a', start, b, f) =
@@ -135,13 +136,13 @@
       val n = length a
       val n' = length a'
       fun loop (i, b) =
-	 if i >= n
-	    then b
-	 else loop (i + 1, f (i, unsafeSub (a, i), unsafeSub (a', i), b))
+         if i >= n
+            then b
+         else loop (i + 1, f (i, unsafeSub (a, i), unsafeSub (a', i), b))
    in
       if n = n' andalso 0 <= start andalso start <= n 
-	 then loop (start, b)
-      else Error.bug "Vector.fold2"
+         then loop (start, b)
+      else Error.bug "Vector.foldi2From"
    end
 
 fun foldi2 (a, a', b, f) = foldi2From (a, a', 0, b, f)
@@ -158,31 +159,31 @@
       val n' = length a'
       val n'' = length a''
       fun loop (i, b) =
-	 if i >= n
-	    then b
-	 else loop (i + 1, f (unsafeSub (a, i),
-			      unsafeSub (a', i),
-			      unsafeSub (a'', i),
-			      b))
+         if i >= n
+            then b
+         else loop (i + 1, f (unsafeSub (a, i),
+                              unsafeSub (a', i),
+                              unsafeSub (a'', i),
+                              b))
    in
       if n = n' andalso n = n'' andalso 0 <= start andalso start <= n
-	 then loop (start, b)
-      else Error.bug "Vector.fold3"
+         then loop (start, b)
+      else Error.bug "Vector.fold3From"
    end
 
 fun fold3 (a, a', a'', b, f) = fold3From (a, a', a'', 0, b, f)
 
-fun foreachR (v, start, stop, f) =
+fun foreachR (v, start, stop, f: 'a -> unit) =
    if 0 <= start andalso start <= stop andalso stop <= length v
       then
-	 let
-	    fun step (i, a, ()) =
-	       if i >= stop
-		  then Done ()
-	       else (f a; Continue ())
-	 in
-	    fold' (v, start, (), step, fn () => ())
-	 end
+         let
+            fun step (i, a, ()) =
+               if i >= stop
+                  then Done ()
+               else (f a; Continue ())
+         in
+            fold' (v, start, (), step, fn () => ())
+         end
    else Error.bug "Vector.foreachR"
 
 fun foreach2 (a, a', f) =
@@ -192,27 +193,27 @@
    let
       val n = length v
       fun loop i =
-	 i = n
-	 orelse (f (sub (v, i), sub (v', i))
-		 andalso loop (i + 1))
+         i = n
+         orelse (f (sub (v, i), sub (v', i))
+                 andalso loop (i + 1))
    in
       if n = length v'
-	 then loop 0
+         then loop 0
       else Error.bug "Vector.forall2"
    end
 
-fun foreach3 (v1, v2, v3, f) =
+fun foreach3 (v1, v2, v3, f: 'a * 'b * 'c -> unit) =
    let
       val n = length v1
       val _ =
-	 if n = length v2 andalso n = length v3
-	    then ()
-	 else Error.bug "Vector.foreach3"
+         if n = length v2 andalso n = length v3
+            then ()
+         else Error.bug "Vector.foreach3"
       fun loop i =
-	 if i = n
-	    then ()
-	 else (f (sub (v1, i), sub (v2, i), sub (v3, i))
-	       ; loop (i + 1))
+         if i = n
+            then ()
+         else (f (sub (v1, i), sub (v2, i), sub (v3, i))
+               ; loop (i + 1))
    in
       loop 0
    end
@@ -225,15 +226,15 @@
    let
       val n = length v
       fun loop i =
-	 if i = n
-	    then NONE
-	 else let
-		 val x = sub (v, i)
-	      in
-		 if f (i, x)
-		    then SOME (i, x)
-		 else loop (i + 1)
-	      end
+         if i = n
+            then NONE
+         else let
+                 val x = sub (v, i)
+              in
+                 if f (i, x)
+                    then SOME (i, x)
+                 else loop (i + 1)
+              end
    in
       loop 0
    end
@@ -277,31 +278,31 @@
 
 fun new1 x = tabulate (1, fn _ => x)
 
-fun new2 (x0, x1) = tabulate (2, fn 0 => x0 | 1 => x1 | _ => raise Fail "new2")
+fun new2 (x0, x1) = tabulate (2, fn 0 => x0 | 1 => x1 | _ => Error.bug "Vector.new2")
 
 fun new3 (x0, x1, x2) =
    tabulate (3,
-	     fn 0 => x0
-	      | 1 => x1
-	      | 2 => x2
-	      | _ => raise Fail "new3")
+             fn 0 => x0
+              | 1 => x1
+              | 2 => x2
+              | _ => Error.bug "Vector.new3")
 
 fun new4 (x0, x1, x2, x3) =
    tabulate (4,
-	     fn 0 => x0
-	      | 1 => x1
-	      | 2 => x2
-	      | 3 => x3
-	      | _ => raise Fail "new4")
+             fn 0 => x0
+              | 1 => x1
+              | 2 => x2
+              | 3 => x3
+              | _ => Error.bug "Vector.new4")
 
 fun new5 (x0, x1, x2, x3, x4) =
    tabulate (5,
-	     fn 0 => x0
-	      | 1 => x1
-	      | 2 => x2
-	      | 3 => x3
-	      | 4 => x4
-	      | _ => raise Fail "new5")
+             fn 0 => x0
+              | 1 => x1
+              | 2 => x2
+              | 3 => x3
+              | 4 => x4
+              | _ => Error.bug "Vector.new5")
 
 fun unzip (a: ('a * 'b) t) = (map (a, #1), map (a, #2))
 
@@ -321,11 +322,11 @@
    let
       val r = ref b
       val v = map (v, fn x =>
-		   let
-		      val (c, b) = f (x, !r)
-		      val _ = r := b
-		   in c
-		   end)
+                   let
+                      val (c, b) = f (x, !r)
+                      val _ = r := b
+                   in c
+                   end)
    in (v, !r)
    end
 
@@ -334,8 +335,8 @@
       val n = length v
    in
       if n = length v'
-	 then tabulate (n, fn i => f (i, unsafeSub (v, i), unsafeSub (v', i)))
-      else Error.bug "Vector.map2"
+         then tabulate (n, fn i => f (i, unsafeSub (v, i), unsafeSub (v', i)))
+      else Error.bug "Vector.map2i"
    end
 
 fun map2 (v, v', f) = map2i (v, v', fn (_, x, x') => f (x, x'))
@@ -344,23 +345,23 @@
    let
       val r = ref b
       val v =
-	 map2 (v, v', fn (x, x') =>
-	       let
-		  val (y, b) = f (x, x', !r)
-		  val _ = r := b
-	       in y
-	       end)
+         map2 (v, v', fn (x, x') =>
+               let
+                  val (y, b) = f (x, x', !r)
+                  val _ = r := b
+               in y
+               end)
    in (v, !r)
    end
-		    
+                    
 fun map3 (v1, v2, v3, f) =
    let
       val n = length v1
    in
       if n = length v2 andalso n = length v3
-	 then tabulate (n, fn i => f (unsafeSub (v1, i),
-				      unsafeSub (v2, i),
-				      unsafeSub (v3, i)))
+         then tabulate (n, fn i => f (unsafeSub (v1, i),
+                                      unsafeSub (v2, i),
+                                      unsafeSub (v3, i)))
       else Error.bug "Vector.map3"
    end
 
@@ -369,18 +370,18 @@
 local
    fun doit (f, mapi) =
       let
-	 val n = ref 0
-	 val b = mapi (fn x =>
-		       let
-			  val b = f x
-			  val _ = if isSome b then n := 1 + !n else ()
-		       in b
-		       end)
-	 val r = ref 0
-	 fun loop (i: int) =
-	    case unsafeSub (b, i) of
-	       NONE => loop (i + 1)
-	     | SOME b => (r := i + 1; b)
+         val n = ref 0
+         val b = mapi (fn x =>
+                       let
+                          val b = f x
+                          val _ = if isSome b then n := 1 + !n else ()
+                       in b
+                       end)
+         val r = ref 0
+         fun loop (i: int) =
+            case unsafeSub (b, i) of
+               NONE => loop (i + 1)
+             | SOME b => (r := i + 1; b)
       in tabulate (!n, fn _ => loop (!r))
       end
 in
@@ -404,15 +405,15 @@
       Relation.lexico
       (Int.compare (n, n'), fn () =>
        let
-	  fun loop i =
-	     if i = n
-		then EQUAL
-	     else 
-		Relation.lexico
-		(comp (unsafeSub (v, i), unsafeSub (v', i)), fn () =>
-		 loop (i + 1))
+          fun loop i =
+             if i = n
+                then EQUAL
+             else 
+                Relation.lexico
+                (comp (unsafeSub (v, i), unsafeSub (v', i)), fn () =>
+                 loop (i + 1))
        in
-	  loop 0
+          loop 0
        end)
    end
 
@@ -423,7 +424,7 @@
       val n = length v
    in
       if n = 0
-	 then Error.bug "Vector.last"
+         then Error.bug "Vector.last"
       else unsafeSub (v, n - 1)
    end
 
@@ -432,18 +433,18 @@
       val a = Pervasive.Array.array (n, NONE)
       val r = ref 0
       val _ =
-	 f (fn x =>
-	    let
-	       val i = !r
-	    in
-	       if i >= n
-		  then Error.bug "Vector.tabulator: too many elements"
-	       else (Pervasive.Array.update (a, i, SOME x)
-		     ; r := i + 1)
-	    end)
+         f (fn x =>
+            let
+               val i = !r
+            in
+               if i >= n
+                  then Error.bug "Vector.tabulator: too many elements"
+               else (Pervasive.Array.update (a, i, SOME x)
+                     ; r := i + 1)
+            end)
    in
       if !r < n
-	 then Error.bug "Vector.tabulator: not enough elements"
+         then Error.bug "Vector.tabulator: not enough elements"
       else tabulate (n, fn i => valOf (Pervasive.Array.sub (a, i)))
    end
 
@@ -451,38 +452,38 @@
    case vs of
       [] => new0 ()
     | v :: vs' => 
-	 let
-	    val n = List.fold (vs, 0, fn (v, s) => s + length v)
-	 in
-	    unfold (n, (0, v, vs'),
-		    let
-		       fun loop (i, v, vs) =
-			  if i < length v
-			     then (sub (v, i), (i + 1, v, vs))
-			  else
-			     case vs of
-				[] => Error.bug "concat"
-			      | v :: vs => loop (0, v, vs)
-		    in loop
-		    end)
-	 end
+         let
+            val n = List.fold (vs, 0, fn (v, s) => s + length v)
+         in
+            unfold (n, (0, v, vs'),
+                    let
+                       fun loop (i, v, vs) =
+                          if i < length v
+                             then (sub (v, i), (i + 1, v, vs))
+                          else
+                             case vs of
+                                [] => Error.bug "Vector.concat"
+                              | v :: vs => loop (0, v, vs)
+                    in loop
+                    end)
+         end
 
 fun concatV vs =
    if 0 = length vs
       then new0 ()
    else
       let
-	 val n = fold (vs, 0, fn (v, s) => s + length v)
-	 fun state i = (i, sub (vs, i), 0)
+         val n = fold (vs, 0, fn (v, s) => s + length v)
+         fun state i = (i, sub (vs, i), 0)
       in
-	 unfold (n, state 0,
-		 let
-		    fun loop (i, v, j) =
-		       if j < length v
-			  then (sub (v, j), (i, v, j + 1))
-		       else loop (state (i + 1))
-		 in loop
-		 end)
+         unfold (n, state 0,
+                 let
+                    fun loop (i, v, j) =
+                       if j < length v
+                          then (sub (v, j), (i, v, j + 1))
+                       else loop (state (i + 1))
+                 in loop
+                 end)
    end
 
 fun splitLast v =
@@ -490,28 +491,28 @@
       val n = length v
    in
       if n <= 0
-	 then Error.bug "splitLast"
+         then Error.bug "Vector.splitLast"
       else (tabulate (n - 1, fn i => unsafeSub (v, i)),
-	    unsafeSub (v, n - 1))
+            unsafeSub (v, n - 1))
    end
 
 fun isSortedRange (v: 'a t,
-		   start: int,
-		   stop: int,
-		   le : 'a * 'a -> bool): bool =
+                   start: int,
+                   stop: int,
+                   le : 'a * 'a -> bool): bool =
    (Assert.assert
-    ("isSortedRange", fn () =>
+    ("Vector.isSortedRange", fn () =>
      0 <= start andalso start <= stop andalso stop <= length v)
     ; start = stop
       orelse
       let
-	 fun loop (i, prev) =
-	    i >= stop
-	    orelse let val cur = sub (v, i)
-		   in
-		      le (prev, cur)
-		      andalso loop (i + 1, cur)
-		   end
+         fun loop (i, prev) =
+            i >= stop
+            orelse let val cur = sub (v, i)
+                   in
+                      le (prev, cur)
+                      andalso loop (i + 1, cur)
+                   end
       in loop (start + 1, sub (v, start))
       end)
 
@@ -519,8 +520,8 @@
 
 fun indexi (v, f) =
    fold' (v, 0, (),
-	  fn (i, a, _) => if f (i, a) then Done (SOME i) else Continue (),
-	  fn _ => NONE)
+          fn (i, a, _) => if f (i, a) then Done (SOME i) else Continue (),
+          fn _ => NONE)
 
 fun index (v, f) = indexi (v, f o #2)
 
@@ -528,7 +529,7 @@
    keepAllMapi (a, fn (i, b) => if b then SOME i else NONE)
 
 val indices =
-   Trace.trace ("indices", layout Bool.layout, layout Int.layout)
+   Trace.trace ("Vector.indices", layout Bool.layout, layout Int.layout)
    indices
 
 fun isSubsequence (va, vb, f) =
@@ -536,17 +537,17 @@
       val na = length va
       val nb = length vb
       fun loop (ia, ib) =
-	 ia >= na
-	 orelse let
-		   val a = sub (va, ia)
-		   fun loop' ib =
-		      ib < nb
-		      andalso if f (a, sub (vb, ib))
-				 then loop (ia + 1, ib + 1)
-			      else loop' (ib + 1)
-		in
-		   loop' ib
-		end
+         ia >= na
+         orelse let
+                   val a = sub (va, ia)
+                   fun loop' ib =
+                      ib < nb
+                      andalso if f (a, sub (vb, ib))
+                                 then loop (ia + 1, ib + 1)
+                              else loop' (ib + 1)
+                in
+                   loop' ib
+                end
    in
       loop (0, 0)
    end
@@ -555,10 +556,10 @@
    let
       val seen = ref false
       val v = keepAll (v, fn a =>
-		       not (f a)
-		       orelse (!seen)
-		       orelse (seen := true
-			       ; false))
+                       not (f a)
+                       orelse (!seen)
+                       orelse (seen := true
+                               ; false))
       val _ = if !seen then () else Error.bug "Vector.removeFirst"
    in
       v
@@ -568,19 +569,19 @@
    let
      val n = ref 0
      val v' = mapi (v, fn (i, x) =>
-		    let
-		      val b = f (i, x)
-		      val _ = if b then n := 1 + !n else ()
-		    in
-		      (x,b)
-		    end)
+                    let
+                      val b = f (i, x)
+                      val _ = if b then n := 1 + !n else ()
+                    in
+                      (x,b)
+                    end)
      val n = !n
      val r = ref 0
      fun loop b (i:int) =
        case unsafeSub (v', i) of
-	 (x, b') => if b = b' 
-		      then (r := i + 1; x)
-		      else loop b (i + 1)
+         (x, b') => if b = b' 
+                      then (r := i + 1; x)
+                      else loop b (i + 1)
      val yes = tabulate (n, fn _ => loop true (!r))
      val _ = r := 0
      val no = tabulate (length v - n, fn _ => loop false (!r))
@@ -594,9 +595,9 @@
 
 fun removeDuplicates (v, equals) =
    keepAllMapi (v, fn (i, x) =>
-		if i > 0 andalso equals (x, sub (v, i - 1))
-		   then NONE
-		else SOME x)
+                if i > 0 andalso equals (x, sub (v, i - 1))
+                   then NONE
+                else SOME x)
 
 fun randomElement v = sub (v, Random.natLessThan (length v))
 

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/vector.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/vector.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/vector.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 type int = Int.t
    
 signature VECTOR_STRUCTS =
@@ -33,10 +34,10 @@
       val existsR: 'a t * int * int * ('a -> bool) -> bool
       val fold2: 'a t * 'b t * 'c * ('a * 'b * 'c -> 'c) -> 'c
       val fold3From:
-	 'a t * 'b t * 'c t * int * 'd * ('a * 'b * 'c * 'd -> 'd) -> 'd
+         'a t * 'b t * 'c t * int * 'd * ('a * 'b * 'c * 'd -> 'd) -> 'd
       val fold3: 'a t * 'b t * 'c t * 'd * ('a * 'b * 'c * 'd -> 'd) -> 'd
       datatype ('a, 'b) continue =
-	 Continue of 'a
+         Continue of 'a
        | Done of 'b
       (* fold' (v, i, b, f, g)
        * folds over v starting at index i with state b, applying f to each
@@ -45,8 +46,8 @@
        * state.
        *)
       val fold':
-	 'a t * int * 'b * (int * 'a * 'b -> ('b, 'c) continue) * ('b -> 'c)
-	 -> 'c
+         'a t * int * 'b * (int * 'a * 'b -> ('b, 'c) continue) * ('b -> 'c)
+         -> 'c
       val fold: 'a t * 'b * ('a * 'b -> 'b) -> 'b
       val foldFrom: 'a t * int * 'b * ('a * 'b -> 'b) -> 'b
       val foldi: 'a t * 'b * (int * 'a * 'b -> 'b) -> 'b
@@ -130,20 +131,20 @@
 
 val _ =
    Assert.assert
-   ("Vector", fn () =>
+   ("TestVector", fn () =>
     let
        fun check ls =
-	  List.concat ls = toList (concat (List.map (ls, fromList)))
-	  andalso List.concat ls = toList (concatV (fromListMap (ls, fromList)))
+          List.concat ls = toList (concat (List.map (ls, fromList)))
+          andalso List.concat ls = toList (concatV (fromListMap (ls, fromList)))
     in
        List.forall
        ([[],
-	 [[]],
-	 [[], [1]],
-	 [[1], []],
-	 [[1], [], [2]],
-	 [[1, 2], [3, 4]]],
-	check)
+         [[]],
+         [[], [1]],
+         [[1], []],
+         [[1], [], [2]],
+         [[1, 2], [3, 4]]],
+        check)
     end)
 
 end

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/vector.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/vector.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/vector.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,31 +1,32 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 structure Vector =
    let
       structure V = Vector (local
-			       open Pervasive.Vector
-			    in
-			       type 'a t = 'a vector
-			       exception New = Size
-			       val length = length
-			       val sub = sub
-			       val unfoldi = MLton.Vector.unfoldi
-			       val unsafeSub = Unsafe.Vector.sub
-			    end)
+                               open Pervasive.Vector
+                            in
+                               type 'a t = 'a vector
+                               exception New = Size
+                               val length = length
+                               val sub = sub
+                               val unfoldi = MLton.Vector.unfoldi
+                               val unsafeSub = Unsafe.Vector.sub
+                            end)
    in
       struct
-	 open V
+         open V
 
-	 type 'a vector = 'a t
+         type 'a vector = 'a t
 
-	 (* The built-in concat is faster in MLton because it can use
-	  * Vector.fromArray.
-	  * See src/basis-library/arrays-and-vectors/sequence.fun.
-	  *)
-	 val concat = Pervasive.Vector.concat
+         (* The built-in concat is faster in MLton because it can use
+          * Vector.fromArray.
+          * See src/basis-library/arrays-and-vectors/sequence.fun.
+          *)
+         val concat = Pervasive.Vector.concat
       end
    end

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/word.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/word.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/word.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 type int = Pervasive.Int.int
 type word = Pervasive.Word.word
    

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/word.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/word.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/word.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 structure Word: WORD32 =
    struct
       structure Int = Pervasive.Int
@@ -15,21 +16,21 @@
       val equals: t * t -> bool = op =
  
       fun fromWord8s (f: int -> Word8.t): t =
-	 let
-	    fun w (i, shift) =
-	       Pervasive.Word.<< (Word8.toWord (f i), shift)
-	 in orb (orb (w (0, 0w0), w (1, 0w8)),
-		 orb (w (2, 0w16), w (3, 0w24)))
-	 end
+         let
+            fun w (i, shift) =
+               Pervasive.Word.<< (Word8.toWord (f i), shift)
+         in orb (orb (w (0, 0w0), w (1, 0w8)),
+                 orb (w (2, 0w16), w (3, 0w24)))
+         end
 
       local
-	 val wordSize = fromInt wordSize
+         val wordSize = fromInt wordSize
       in
-	 fun rotateLeft (w: t, n: t) =
-	    let val l = n mod wordSize
-	       val r = wordSize - l
-	    in orb (<< (w, l), >> (w, r))
-	    end
+         fun rotateLeft (w: t, n: t) =
+            let val l = n mod wordSize
+               val r = wordSize - l
+            in orb (<< (w, l), >> (w, r))
+            end
       end
 
       val fromWord = fn x => x
@@ -44,47 +45,47 @@
       val toWord8 = Word8.fromWord
 
       fun log2 (w: t): t =
-	 if w = 0w0
-	    then Error.bug "Word.log2 0"
-	 else
-	    let
-	       fun loop (n, s, ac): word =
-		  if n = 0w1
-		     then ac
-		  else
-		     let
-			val (n, ac) =
-			   if n >= << (0w1, s)
-			      then (>> (n, s), ac + s)
-			   else (n, ac)
-		     in
-			loop (n, >> (s, 0w1), ac)
-		     end
-	    in
-	       loop (w, 0w16, 0w0)
-	    end
+         if w = 0w0
+            then Error.bug "Word.log2: 0"
+         else
+            let
+               fun loop (n, s, ac): word =
+                  if n = 0w1
+                     then ac
+                  else
+                     let
+                        val (n, ac) =
+                           if n >= << (0w1, s)
+                              then (>> (n, s), ac + s)
+                           else (n, ac)
+                     in
+                        loop (n, >> (s, 0w1), ac)
+                     end
+            in
+               loop (w, 0w16, 0w0)
+            end
 
       fun roundDownToPowerOfTwo (w: t) = << (0w1, log2 w)
 
       fun roundUpToPowerOfTwo w =
-	 let
-	    val w' = roundDownToPowerOfTwo w
-	 in
-	    if w = w'
-	       then w
-	    else w' * 0w2
-	 end
+         let
+            val w' = roundDownToPowerOfTwo w
+         in
+            if w = w'
+               then w
+            else w' * 0w2
+         end
 
       structure M = MaxPow2ThatDivides (open Word
-					type t = word
-					val equals = op =
-					val one: t = 0w1
-					val zero: t = 0w0)
+                                        type t = word
+                                        val equals = op =
+                                        val one: t = 0w1
+                                        val zero: t = 0w0)
       open M
 
       fun addCheck (w, w') =
-	 if w <= ~ 0w1 - w'
-	    then w + w'
-	 else raise Overflow
+         if w <= ~ 0w1 - w'
+            then w + w'
+         else raise Overflow
    end
 

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/word32.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/word32.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/word32.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 type int = Pervasive.Int.int
 type word = Pervasive.Word.word
 
@@ -32,7 +33,7 @@
 
 val _ =
    Assert.assert
-   ("Word", fn () =>
+   ("TestWord32", fn () =>
     List.forall
     ([(4, 0wxabcdabcd, 0wxbcdabcda),
       (8, 0wxabcdabcd, 0wxcdabcdab),

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/word8.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/word8.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/word8.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,8 +1,8 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 (* Use fromLargeWord instead of fromLarge so we can compile this code
@@ -13,25 +13,25 @@
       type t = W.word
 
       local
-	 structure LargeWord = Pervasive.LargeWord
-	 structure Word = Pervasive.Word
-	 structure Word8 = Pervasive.Word8
+         structure LargeWord = Pervasive.LargeWord
+         structure Word = Pervasive.Word
+         structure Word8 = Pervasive.Word8
       in
-	 fun format (w, f) = W.fmt f w
-	 val fromChar = W.fromLargeWord o Word8.toLargeWord o Byte.charToByte
-	 val fromIntInf = W.fromLargeInt
-	 val fromLarge = W.fromLargeWord o LargeWord.toLargeWord
-	 val fromWord = W.fromLargeWord o Word.toLargeWord
-	 val layout = Layout.str o W.toString
-	 fun nthBitIsSet (w: t, n: int): bool =
-	    W.fromInt 1 = W.andb (W.fromInt 1, W.>> (w, Word.fromInt n))
-	 val toChar = Byte.byteToChar o Word8.fromLargeWord o W.toLargeWord
-	 val toIntInf = W.toLargeInt
-	 val toIntInfX = W.toLargeIntX
-	 val toLarge = LargeWord.fromLargeWord o W.toLargeWord
-	 val toLargeX = LargeWord.fromLargeWord o W.toLargeWordX
-	 val toWord = Word.fromLargeWord o W.toLargeWord
-	 val toWordX = Word.fromLargeWord o W.toLargeWordX
+         fun format (w, f) = W.fmt f w
+         val fromChar = W.fromLargeWord o Word8.toLargeWord o Byte.charToByte
+         val fromIntInf = W.fromLargeInt
+         val fromLarge = W.fromLargeWord o LargeWord.toLargeWord
+         val fromWord = W.fromLargeWord o Word.toLargeWord
+         val layout = Layout.str o W.toString
+         fun nthBitIsSet (w: t, n: int): bool =
+            W.fromInt 1 = W.andb (W.fromInt 1, W.>> (w, Word.fromInt n))
+         val toChar = Byte.byteToChar o Word8.fromLargeWord o W.toLargeWord
+         val toIntInf = W.toLargeInt
+         val toIntInfX = W.toLargeIntX
+         val toLarge = LargeWord.fromLargeWord o W.toLargeWord
+         val toLargeX = LargeWord.fromLargeWord o W.toLargeWordX
+         val toWord = Word.fromLargeWord o W.toLargeWord
+         val toWordX = Word.fromLargeWord o W.toLargeWordX
       end
    end
 
@@ -50,10 +50,10 @@
       val equals: t * t -> bool = op =
 
       fun vectorToString v =
-	 CharVector.tabulate (Pervasive.Vector.length v, fn i =>
-			      toChar (Pervasive.Vector.sub (v, i)))
+         CharVector.tabulate (Pervasive.Vector.length v, fn i =>
+                              toChar (Pervasive.Vector.sub (v, i)))
 
       fun stringToVector s =
-	 Pervasive.Vector.tabulate (Pervasive.String.size s, fn i =>
-				    fromChar (Pervasive.String.sub (s, i)))
+         Pervasive.Vector.tabulate (Pervasive.String.size s, fn i =>
+                                    fromChar (Pervasive.String.sub (s, i)))
    end

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/directed-graph/classify-edges.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/directed-graph/classify-edges.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/directed-graph/classify-edges.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,8 +1,8 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 (*--------------------------------------------------------*)
@@ -10,18 +10,18 @@
 (*--------------------------------------------------------*)
 
 fun classifyEdges g {discover: Node.t -> int,
-		     finish: Node.t -> int} =
+                     finish: Node.t -> int} =
    let val cs = {tree = ref [], cross = ref [], back = ref [], forward = ref []}
       fun classify e = let val n = E.tail e
-			   val n' = E.head e
-		       in if discover n' > discover n then #forward cs
-			  else if finish n' = ~1 then #back cs
-			       else #cross cs
-		       end
+                           val n' = E.head e
+                       in if discover n' > discover n then #forward cs
+                          else if finish n' = ~1 then #back cs
+                               else #cross cs
+                       end
    in (cs, P.T{handleTreeEdge = LU.push (#tree cs),
-	       handleNonTreeEdge = fn e => LU.push (classify e) e,
-	       startNode = P.ignore, finishNode = P.ignore,
-	       startTree = P.ignore, finishTree = P.ignore,
-	       finishDfs = P.ignore})
+               handleNonTreeEdge = fn e => LU.push (classify e) e,
+               startNode = P.ignore, finishNode = P.ignore,
+               startTree = P.ignore, finishTree = P.ignore,
+               finishDfs = P.ignore})
    end
 

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/directed-graph/classify-edges.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/directed-graph/classify-edges.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/directed-graph/classify-edges.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,14 +1,14 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
       val classifyEdges: Graph.t -> {discover: Graph.Node.t -> int,
-				      finish: Graph.Node.t -> int}
-	 -> {tree: Graph.Edge.t list ref,
-	     forward: Graph.Edge.t list ref,
-	     back: Graph.Edge.t list ref,
-	     cross: Graph.Edge.t list ref}
-	 * Param.t
+                                      finish: Graph.Node.t -> int}
+         -> {tree: Graph.Edge.t list ref,
+             forward: Graph.Edge.t list ref,
+             back: Graph.Edge.t list ref,
+             cross: Graph.Edge.t list ref}
+         * Param.t

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/directed-graph/dijkstra.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/directed-graph/dijkstra.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/directed-graph/dijkstra.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 functor Dijkstra (S : SHORTEST_PATH_STRUCTS): SHORTEST_PATH =
 struct
 
@@ -15,27 +16,27 @@
 fun shortestPath {graph, weight, source} =
    let
       val {get: Node.t -> Node.t Heap.Elt.t option, set, destroy} =
-	 Property.destGetSetOnce (Node.plist, Property.initConst NONE)
+         Property.destGetSetOnce (Node.plist, Property.initConst NONE)
       val elt = valOf o get
       fun distanceOption n = Option.map (get n, Elt.key)
       val distance = valOf o distanceOption 
       val fringe: Node.t Heap.t = Heap.empty ()
       fun addToFringe (n: Node.t, d: Weight.t): unit =
-	 set (n, SOME (Heap.insert (fringe, d, n)))
+         set (n, SOME (Heap.insert (fringe, d, n)))
       fun relax (n: Node.t, e: Edge.t): unit =
-	 let val n' = Edge.to e
-	    val d = Weight.+ (distance n, weight e)
-	 in case distanceOption n' of
-	    NONE => addToFringe (n', d)
-	  | SOME d' => if Weight.< (d, d')
-			   then Heap.decreaseKey (fringe, elt n', d)
-		       else ()
-	 end
+         let val n' = Edge.to e
+            val d = Weight.+ (distance n, weight e)
+         in case distanceOption n' of
+            NONE => addToFringe (n', d)
+          | SOME d' => if Weight.< (d, d')
+                           then Heap.decreaseKey (fringe, elt n', d)
+                       else ()
+         end
    in addToFringe (source, Weight.zero)
       ; while not (Heap.isEmpty fringe)
         do let val n = Heap.deleteMin fringe
-	   in List.foreach (Node.successors n, fn e => relax (n, e))
-	   end
+           in List.foreach (Node.successors n, fn e => relax (n, e))
+           end
       ; distanceOption
    end
 

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/directed-graph/shortest-path-check.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/directed-graph/shortest-path-check.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/directed-graph/shortest-path-check.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 functor ShortestPathCheck (S: SHORTEST_PATH_CHECK_STRUCTS): SHORTEST_PATH_CHECK =
 struct
 
@@ -12,85 +13,85 @@
 structure Answer =
    struct      
       datatype t =
-	 Shortest
+         Shortest
        | SourceNonZero
        | PredecessorReachable of Node.t * Edge.t
        | Relaxable of Node.t * Edge.t
        | NoPath of Node.t
-	 
+         
       fun layout (a, layoutNode) =
-	 let open Layout
-	 in case a of
-	    Shortest =>
-	       str "The distances are correct shortest path distances."
-	  | SourceNonZero => str "The distance to the source must be zero."
-	  | PredecessorReachable (n, e) =>
-	       let val n = Node.layout n
-		  val n' = Node.layout (Edge.to e)
-	       in align
-		  [str "The distances are contradictory.",
-		   seq [str "1. There is an edge from ", n, str " to ", n'],
-		   seq [str "2. ", n, str " has a finite distancEdge."],
-		   seq [str "3. ", n', str " has an infinite distancEdge."]]
-	       end
-	  | NoPath n =>
-	       seq [str "There is not a valid predecessor path from ",
-		   layoutNode n, str " to the sourcEdge."]
-	  | Relaxable (n, e) =>
-	       let val n = layoutNode n
-		  val n' = layoutNode (Edge.to e)
-	       in align
-		  [str "The distances are not shortest path distances.",
-		   seq [str "The edge from ", n, str " to ", n',
-		       str " can be relaxed."]]
-	       end
-	 end
+         let open Layout
+         in case a of
+            Shortest =>
+               str "The distances are correct shortest path distances."
+          | SourceNonZero => str "The distance to the source must be zero."
+          | PredecessorReachable (n, e) =>
+               let val n = Node.layout n
+                  val n' = Node.layout (Edge.to e)
+               in align
+                  [str "The distances are contradictory.",
+                   seq [str "1. There is an edge from ", n, str " to ", n'],
+                   seq [str "2. ", n, str " has a finite distancEdge."],
+                   seq [str "3. ", n', str " has an infinite distancEdge."]]
+               end
+          | NoPath n =>
+               seq [str "There is not a valid predecessor path from ",
+                   layoutNode n, str " to the sourcEdge."]
+          | Relaxable (n, e) =>
+               let val n = layoutNode n
+                  val n' = layoutNode (Edge.to e)
+               in align
+                  [str "The distances are not shortest path distances.",
+                   seq [str "The edge from ", n, str " to ", n',
+                       str " can be relaxed."]]
+               end
+         end
    end
 
 structure Set = DisjointSet
-	 
+         
 fun check {graph, source, weight, distance} =
    case distance source of
       NONE => Answer.SourceNonZero
     | SOME d => 
-	  if not (Weight.equals (Weight.zero, d))
-	     then Answer.SourceNonZero
-	  else
-	     let
-		exception Answer of Answer.t
-		val {get = set, destroy, ...} =
-		   Property.destGet (Node.plist,
-				     Property.initFun (fn _ => Set.singleton ()))
-		fun union (n, n') = Set.union (set n, set n')
-		fun checkRelax (n, e) =
-		   let val n' = Edge.to e
-		   in case distance n of
-		      NONE => () 
-		    | SOME d =>
-			 case distance n' of
-			    NONE =>
-			       raise Answer (Answer.PredecessorReachable (n, e))
-			  | SOME d' =>
-			       let val d'' = Weight.+ (d, weight e)
-			       in if Weight.< (d'', d')
-				     then raise Answer (Answer.Relaxable (n, e))
-				  else if Weight.equals (d', d'')
-					  then union (n, n')
-				       else ()
-			       end
-		   end
-		val _ = foreachEdge (graph, checkRelax)
-		val sourceSet = set source
-		fun canReachSource n =
-		   let val equiv = Set.equals (set n, sourceSet)
-		   in case distance n of
-		      NONE => ()
-		    | SOME _ => if equiv
-				   then ()
-				else raise Answer (Answer.NoPath n)
-		   end
-	     in (foreachNode (graph, canReachSource)
-		 ; Answer.Shortest) handle Answer a => a
-	     end
+          if not (Weight.equals (Weight.zero, d))
+             then Answer.SourceNonZero
+          else
+             let
+                exception Answer of Answer.t
+                val {get = set, destroy, ...} =
+                   Property.destGet (Node.plist,
+                                     Property.initFun (fn _ => Set.singleton ()))
+                fun union (n, n') = Set.union (set n, set n')
+                fun checkRelax (n, e) =
+                   let val n' = Edge.to e
+                   in case distance n of
+                      NONE => () 
+                    | SOME d =>
+                         case distance n' of
+                            NONE =>
+                               raise Answer (Answer.PredecessorReachable (n, e))
+                          | SOME d' =>
+                               let val d'' = Weight.+ (d, weight e)
+                               in if Weight.< (d'', d')
+                                     then raise Answer (Answer.Relaxable (n, e))
+                                  else if Weight.equals (d', d'')
+                                          then union (n, n')
+                                       else ()
+                               end
+                   end
+                val _ = foreachEdge (graph, checkRelax)
+                val sourceSet = set source
+                fun canReachSource n =
+                   let val equiv = Set.equals (set n, sourceSet)
+                   in case distance n of
+                      NONE => ()
+                    | SOME _ => if equiv
+                                   then ()
+                                else raise Answer (Answer.NoPath n)
+                   end
+             in (foreachNode (graph, canReachSource)
+                 ; Answer.Shortest) handle Answer a => a
+             end
 
 end

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/directed-graph/shortest-path-check.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/directed-graph/shortest-path-check.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/directed-graph/shortest-path-check.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature SHORTEST_PATH_CHECK_STRUCTS =
    sig
       include DIRECTED_GRAPH
@@ -15,20 +16,20 @@
       include SHORTEST_PATH_CHECK_STRUCTS
 
       structure Answer:
-	 sig
-	    datatype t =
-	       Shortest
-	     | SourceNonZero
-	     | PredecessorReachable of Node.t * Edge.t
-	     | Relaxable of Node.t * Edge.t
-	     | NoPath of Node.t
-	       
-	    val layout: t * (Node.t -> Layout.t) -> Layout.t
-	 end
-	 
+         sig
+            datatype t =
+               Shortest
+             | SourceNonZero
+             | PredecessorReachable of Node.t * Edge.t
+             | Relaxable of Node.t * Edge.t
+             | NoPath of Node.t
+               
+            val layout: t * (Node.t -> Layout.t) -> Layout.t
+         end
+         
       val check: {graph: t,
-		  source: Node.t,
-		  weight: Edge.t -> Weight.t,
-		  distance: Node.t -> Weight.t option}
-	 -> Answer.t
+                  source: Node.t,
+                  weight: Edge.t -> Weight.t,
+                  distance: Node.t -> Weight.t option}
+         -> Answer.t
    end

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/directed-graph/shortest-path.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/directed-graph/shortest-path.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/directed-graph/shortest-path.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature SHORTEST_PATH_STRUCTS =
    sig
       include DIRECTED_GRAPH
@@ -13,9 +14,9 @@
 signature SHORTEST_PATH =
    sig
       include SHORTEST_PATH_STRUCTS
-	 
+         
       val shortestPath: {graph: t,
-			 weight: Edge.t -> Weight.t,
-			 source: Node.t}
-	 -> Node.t -> Weight.t option
+                         weight: Edge.t -> Weight.t,
+                         source: Node.t}
+         -> Node.t -> Weight.t option
    end

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/directed-graph/sources.cm
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/directed-graph/sources.cm	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/directed-graph/sources.cm	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,11 @@
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 Library
 
 functor Dijkstra

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/directed-graph/test.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/directed-graph/test.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/directed-graph/test.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,8 +1,9 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 structure Z = TestDirectedGraph (DirectedGraph)
 structure Z = struct end

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/directed-graph/weight.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/directed-graph/weight.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/directed-graph/weight.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature WEIGHT = 
    sig
       include BOUNDED_ORDER

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/env/array-finite-function.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/env/array-finite-function.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/env/array-finite-function.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,31 +1,32 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 functor ArrayFiniteFunction(): ARRAY_FINITE_FUNCTION = 
 struct
 
 structure Domain =
    struct
       type 'a t =
-	 {size: int, fromInt: int -> 'a, toInt: 'a -> int}
+         {size: int, fromInt: int -> 'a, toInt: 'a -> int}
 
       fun pair({size, fromInt, toInt}: 'a1 t,
-	       {size=size', fromInt=fromInt', toInt=toInt'}: 'a2 t,
-	       inj: 'a1 -> 'a,
-	       inj': 'a2 -> 'a,
-	       out: 'a * ('a1 -> int) * ('a2 -> int) -> int) =
-	 {size = size + size',
-	  toInt = fn d => out(d, toInt, fn d' => size + toInt' d'),
-	  fromInt = fn n => if n < size then inj(fromInt n)
-			    else inj'(fromInt'(n - size))}
+               {size=size', fromInt=fromInt', toInt=toInt'}: 'a2 t,
+               inj: 'a1 -> 'a,
+               inj': 'a2 -> 'a,
+               out: 'a * ('a1 -> int) * ('a2 -> int) -> int) =
+         {size = size + size',
+          toInt = fn d => out(d, toInt, fn d' => size + toInt' d'),
+          fromInt = fn n => if n < size then inj(fromInt n)
+                            else inj'(fromInt'(n - size))}
    end
    
 datatype ('a, 'b) t =
    T of {domain: 'a Domain.t,
-	 array: 'b Array.t}
+         array: 'b Array.t}
 
 fun empty(domain: 'a Domain.t) =
    T{domain = domain,

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/env/array-finite-function.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/env/array-finite-function.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/env/array-finite-function.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,24 +1,25 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature ARRAY_FINITE_FUNCTION =
    sig
       include FINITE_FUNCTION
 
       structure Domain :
-	 sig
-	    type 'a t = {size: int,
-			 fromInt: int -> 'a,
-			 toInt: 'a -> int}
+         sig
+            type 'a t = {size: int,
+                         fromInt: int -> 'a,
+                         toInt: 'a -> int}
 
-	    val pair: 'a1 t * 'a2 t
-	       * ('a1 -> 'a) * ('a2 -> 'a)
-	       * (('a * ('a1 -> int) * ('a2 -> int)) -> int)
-	       -> 'a t
-	 end
+            val pair: 'a1 t * 'a2 t
+               * ('a1 -> 'a) * ('a2 -> 'a)
+               * (('a * ('a1 -> int) * ('a2 -> int)) -> int)
+               -> 'a t
+         end
 
       val empty: 'a Domain.t -> ('a, 'b option) t
       val new: 'a Domain.t * 'b -> ('a, 'b) t

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/env/basic-env-to-env.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/env/basic-env-to-env.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/env/basic-env-to-env.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 functor BasicEnvToEnv(S: BASIC_MONO_ENV): MONO_ENV =
 struct
 
@@ -14,9 +15,9 @@
 fun layout e =
    let open Layout
    in seq[str "[",
-	  align(List.map(toList e, fn (d, r) =>
-			 seq[Domain.layout d, str " -> ", Range.layout r])),
-	  str"]"]
+          align(List.map(toList e, fn (d, r) =>
+                         seq[Domain.layout d, str " -> ", Range.layout r])),
+          str"]"]
    end
 
 val size = List.length o toList
@@ -38,7 +39,7 @@
 
 fun plus es = List.fold(es, empty, fn (e, accum) => accum + e)
 
-val plus = Trace.trace("plus", List.layout layout, layout) plus
+val plus = Trace.trace("BasicEnvToEnv.plus", List.layout layout, layout) plus
 
 fun remove(env, d) =
    fromList(List.remove(toList env, fn (d', _) => Domain.equals(d, d')))
@@ -46,8 +47,8 @@
 fun lookup(env, d) = case peek(env, d) of
    SOME r => r
  | NONE => (Layout.output(Domain.layout d, Out.error) ;
-	    Out.newline Out.error ;
-	    Error.bug "lookup")
+            Out.newline Out.error ;
+            Error.bug "BasicEnvToEnv.lookup")
 
 fun restrict(env, ds) = new(ds, fn d => lookup(env, d))
 
@@ -55,7 +56,7 @@
    case (ds, rs) of
       ([], []) => env
     | (d :: ds, r :: rs) => multiExtend(extend(env, d, r), ds, rs)
-    | _ => Error.bug "multiExtend"
+    | _ => Error.bug "BasicEnvToEnv.multiExtend"
 
 fun fold(e, b, f) = List.fold(toList e, b, fn ((_, r), b) => f(r, b))
 fun foldi(e, b, f) = List.fold(toList e, b, fn ((d, r), b) => f(d, r, b))
@@ -69,8 +70,8 @@
    fn (e1, e2) =>
    size e1 = size e2
    andalso foralli(e1, fn (d, r) =>
-		   case peek(e2, d) of
-		      NONE => false
-		    | SOME r' => Range.equals(r, r'))
+                   case peek(e2, d) of
+                      NONE => false
+                    | SOME r' => Range.equals(r, r'))
    
 end

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/env/cache.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/env/cache.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/env/cache.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 functor Cache(Domain: T): CACHE =
 struct
 

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/env/cache.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/env/cache.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/env/cache.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,13 +1,14 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature CACHE =
    sig
       structure Domain: T
-	 
+         
       type 'a t
       val new: unit -> 'a t
       val peek: 'a t * Domain.t -> 'a option

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/env/finite-function.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/env/finite-function.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/env/finite-function.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,8 +1,8 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 (*-------------------------------------------------------------------*)
 (*                                Env                                *)
@@ -33,8 +33,8 @@
 
 fun lookup ed = case peek ed of
    SOME r => r
- | NONE => Error.error "lookup"
-			 
+ | NONE => Error.error "Env.lookup"
+                         
 fun dom(T l) = L.map(l, #1)
 
 fun range(T l) = L.map(l, #2)
@@ -49,26 +49,26 @@
    
 fun multiExtend(env, [], []) = env
   | multiExtend(env, d :: ds, r :: rs) = multiExtend(extend(env, d, r), ds, rs)
-  | multiExtend _ = Error.error "multiExtend"
+  | multiExtend _ = Error.error "Env.multiExtend"
 
 fun merge(e as T p, e' as T p', f) =
    let val leftAndBoth = L.map(p, fn (d, r) =>
-			       case peek(e', d) of
-				  NONE => (d, r)
-				| SOME r' => (d, f(r, r')))
+                               case peek(e', d) of
+                                  NONE => (d, r)
+                                | SOME r' => (d, f(r, r')))
       val right = L.keepAll(p',
-			    fn (d, _) =>
-			    case peek(e, d) of
-			       NONE => true
-			     | SOME _ => false)
+                            fn (d, _) =>
+                            case peek(e, d) of
+                               NONE => true
+                             | SOME _ => false)
    in T(leftAndBoth @ right)
    end
 
 fun output(T ps, outputR, out) =
    let val print = Out.outputc out
       fun outputDR((d, r), out) = (D.output(d, out) ;
-				  print "->" ;
-				  outputR(r, out))
+                                  print "->" ;
+                                  outputR(r, out))
    in (print "[" ;
        L.output(ps, ", ", outputDR, out) ;
        print "]")

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/env/finite-function.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/env/finite-function.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/env/finite-function.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,15 +1,16 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 type int = Int.t
    
 signature FINITE_FUNCTION = 
    sig
       type ('a, 'b) t
-	 
+         
       val foreach: ('a, 'b) t * ('a * 'b -> unit) -> unit
       val lookup: ('a, 'b) t * 'a -> 'b
       val size: ('a, 'b) t -> int

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/env/mono-env.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/env/mono-env.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/env/mono-env.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,13 +1,14 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 functor MakeMonoEnv(S: sig
-			   structure Env: ENV
-			   structure Range: T
-			end): MONO_ENV =
+                           structure Env: ENV
+                           structure Range: T
+                        end): MONO_ENV =
 struct
 
 open S
@@ -27,7 +28,7 @@
 
 functor MonoEnv(S: MONO_ENV_STRUCTS): MONO_ENV =
    MakeMonoEnv(structure Env = Env(S)
-	       structure Range = S.Range)
+               structure Range = S.Range)
 *)
 
 functor MonoEnv(S: MONO_ENV_STRUCTS): MONO_ENV =
@@ -49,5 +50,5 @@
     case List.peek(l, equalTo d) of
        NONE => NONE
      | SOME (_, r) => SOME r
-	  )
+          )
 

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/env/mono-env.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/env/mono-env.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/env/mono-env.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 type int = Int.t
    
 signature MONO_ENV_STRUCTS =
@@ -15,7 +16,7 @@
 signature BASIC_MONO_ENV =
    sig
       include MONO_ENV_STRUCTS
-	 
+         
       type t
       val extend: t * Domain.t * Range.t -> t
       val fromList: (Domain.t * Range.t) list -> t

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/env/move-to-front.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/env/move-to-front.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/env/move-to-front.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 functor MoveToFrontEnv(S: MONO_ENV_STRUCTS): MONO_ENV =
 BasicEnvToEnv
 (open S
@@ -16,21 +17,21 @@
 
  fun extend(T(ref drs), d, r) =
     T(ref((d, r) ::
-	  (* poor man's profiling *)
-	  let fun f() = List.remove(drs, fn (d', _) => Domain.equals(d, d'))
-	  in (*f() ;*) f()
-	  end))
+          (* poor man's profiling *)
+          let fun f() = List.remove(drs, fn (d', _) => Domain.equals(d, d'))
+          in (*f() ;*) f()
+          end))
 
  fun peek(T reff, d) =
     let
        fun loop(drs, accum) =
-	  case drs of
-	     (d', r) :: drs =>
-		if Domain.equals(d, d')
-		   then (reff := (d, r) :: List.appendRev(accum, drs)
-			 ; SOME r)
-		else loop(drs, (d', r) :: accum)
-	   | [] => NONE
+          case drs of
+             (d', r) :: drs =>
+                if Domain.equals(d, d')
+                   then (reff := (d, r) :: List.appendRev(accum, drs)
+                         ; SOME r)
+                else loop(drs, (d', r) :: accum)
+           | [] => NONE
        (* poor man's profiling *)
        fun f() = loop(!reff, [])
     in (*f() ;*) f()

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/env/poly-cache-ref.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/env/poly-cache-ref.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/env/poly-cache-ref.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,14 +1,15 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 functor PolyCache(): POLY_CACHE =
 struct
 
 datatype ('a, 'b) t = T of {equal: ('a * 'a) -> bool,
-			   elts: ('a * 'b ref) list ref}
+                           elts: ('a * 'b ref) list ref}
 
 fun fromList 
    
@@ -39,8 +40,8 @@
 fun getOrAdd(c, x, th) =
    case peek(c, x) of
       NONE => let val y = th()
-	      in addNew(c, x, y) ; y
-	      end
+              in addNew(c, x, y) ; y
+              end
     | SOME y => y
 
 fun eq(T{elts=r, ...}, T{elts=r', ...}) = r = r'

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/env/poly-cache.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/env/poly-cache.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/env/poly-cache.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,14 +1,15 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 functor PolyCache(): POLY_CACHE =
 struct
 
 datatype ('a, 'b) t = T of {equal: ('a * 'a) -> bool,
-			   elts: ('a * 'b) list ref}
+                           elts: ('a * 'b) list ref}
 
 fun fromList{equal, elements} = T{equal = equal, elts = ref elements}
    
@@ -33,8 +34,8 @@
 fun getOrAdd(c, x, th) =
    case peek(c, x) of
       NONE => let val y = th()
-	      in addNew(c, x, y) ; y
-	      end
+              in addNew(c, x, y) ; y
+              end
     | SOME y => y
 
 fun eq(T{elts=r, ...}, T{elts=r', ...}) = r = r'

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/env/poly-cache.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/env/poly-cache.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/env/poly-cache.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature POLY_CACHE =
    sig
       include FINITE_FUNCTION

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/env/sources.cm
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/env/sources.cm	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/env/sources.cm	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,11 @@
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 Library
 
 signature ENV
@@ -10,11 +18,10 @@
 functor MakeMonoEnv
 functor MonoEnv
 functor MoveToFrontEnv
-functor SplayMonoEnv
+(* functor SplayMonoEnv *)
 
 is
 
-../../smlnj/sources.cm
 ../basic/sources.cm
 
 mono-env.sig
@@ -27,7 +34,7 @@
 #if (defined (SMLNJ_VERSION))
 
 move-to-front.fun
-splay-env.fun
+(* splay-env.fun *)
 cache.sig
 cache.fun
 

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/env/sources.mlb
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/env/sources.mlb	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/env/sources.mlb	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,27 +1,33 @@
+(* Copyright (C) 2004-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 ann  
-   "sequenceUnit true"
-   "warnMatch true"
+   "sequenceNonUnit warn"
+   "nonexhaustiveMatch warn" "redundantMatch warn"
    "warnUnused false" "forceUsed"
 in
-local
-    $(SML_LIB)/basis/basis.mlb
-    ../../smlnj/sources.mlb
-    ../basic/sources.mlb
+   local
+      $(SML_LIB)/basis/basis.mlb
+      ../basic/sources.mlb
 
-    mono-env.sig
-    basic-env-to-env.fun
-    mono-env.fun
-    finite-function.sig
-    poly-cache.sig
-    poly-cache.fun
-in
-    signature ENV
-    signature MONO_ENV
-    signature POLY_CACHE
+      mono-env.sig
+      basic-env-to-env.fun
+      mono-env.fun
+      finite-function.sig
+      poly-cache.sig
+      poly-cache.fun
+   in
+      signature ENV
+      signature MONO_ENV
+      signature POLY_CACHE
 
-    structure PolyCache
+      structure PolyCache
 
-    functor MakeMonoEnv
-    functor MonoEnv
+      functor MakeMonoEnv
+      functor MonoEnv
+   end
 end
-end

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/env/splay-env.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/env/splay-env.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/env/splay-env.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature ORDER_ENV_STRUCTS =
    sig
       structure Domain: ORDER
@@ -16,11 +17,11 @@
 (open S
 
  structure E = SplayMapFn(type ord_key = Domain.t
-			  val compare = Domain.compare)
+                          val compare = Domain.compare)
     
  type t = Range.t E.map
  fun extend(env, d, r) = E.insert(env, d, r)
  fun fromList l = List.fold(l, E.empty, fn ((d, r), env) =>
-			    extend(env, d, r))
+                            extend(env, d, r))
  val toList = E.listItemsi
  val peek = E.find)

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/heap/binary.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/heap/binary.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/heap/binary.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 functor BinaryHeap (Key: BOUNDED_ORDER): HEAP =
 struct
 
@@ -16,11 +17,11 @@
 structure Element =
    struct
       datatype 'a t = T of {key: Key.t ref,
-			    value: 'a,
-			    index: int ref}
+                            value: 'a,
+                            index: int ref}
       fun new(k, v, i) = T{key = ref k,
-			   value = v,
-			   index = ref i}
+                           value = v,
+                           index = ref i}
       fun key(T{key, ...}) = !key
       fun setKey(T{key, ...}, k) = key := k
       fun value (T{value, ...}) = value
@@ -39,8 +40,8 @@
    
 fun fixIndex(a, i) = Elt.setIndex(Array.sub(a, i), i)
 fun swap(a, i, j) = (Array.swap(a, i, j)
-		     ; fixIndex(a, i)
-		     ; fixIndex(a, j))
+                     ; fixIndex(a, i)
+                     ; fixIndex(a, j))
    
 fun isEmpty (T a) = Array.length a = 0
    
@@ -52,36 +53,36 @@
 
 fun siftUp(a, i) =
    let fun siftUp i = if i = 0 then ()
-		      else let val p = parent i
-			   in if Key.<(key(a, i), key(a, p))
-				 then (swap(a, i, p); siftUp p)
-			      else ()
-			   end
+                      else let val p = parent i
+                           in if Key.<(key(a, i), key(a, p))
+                                 then (swap(a, i, p); siftUp p)
+                              else ()
+                           end
    in siftUp i
    end
-	
+        
 fun siftDown(a, i) =
    let
       fun siftDown i =
-	 let val l = left i
-	    val r = right i
-	 in case keyOption(a, l) of
-	    NONE => ()
-	  | SOME kl =>
-	       let val min = (case keyOption(a, r) of
-				 NONE => l
-			       | SOME kr => if Key.<(kl, kr)
-						then l else r)
-	       in if Key.<(key(a, i), key(a, min)) then ()
-		  else (swap(a, i, min); siftDown min)
-	       end
-	 end
+         let val l = left i
+            val r = right i
+         in case keyOption(a, l) of
+            NONE => ()
+          | SOME kl =>
+               let val min = (case keyOption(a, r) of
+                                 NONE => l
+                               | SOME kr => if Key.<(kl, kr)
+                                                then l else r)
+               in if Key.<(key(a, i), key(a, min)) then ()
+                  else (swap(a, i, min); siftDown min)
+               end
+         end
    in siftDown i
    end
       
 fun new es =
    let val a = Array.fromList (List.mapi (es, fn (i, (k, v)) =>
-					  Elt.new (k, v, i)))
+                                          Elt.new (k, v, i)))
       val start = (Array.length a) div 2
    in Int.forDown (start, 0, fn i => siftDown (a, i))
       ; T a
@@ -106,13 +107,13 @@
 fun deleteMin (h as (T a)) =
    if isEmpty h then Error.bug "deleteMin"
    else Elt.value (if Array.length a = 1
-		    then Array.deleteLast a
-		 else let val min = Array.sub(a, 0)
-		      in Array.update(a, 0, Array.deleteLast a)
-			 ; fixIndex(a, 0)
-			 ; siftDown(a, 0)
-			 ; min
-		      end)
+                    then Array.deleteLast a
+                 else let val min = Array.sub(a, 0)
+                      in Array.update(a, 0, Array.deleteLast a)
+                         ; fixIndex(a, 0)
+                         ; siftDown(a, 0)
+                         ; min
+                      end)
  
 fun decreaseKey(T a, e, k) =
    if Key.<(Elt.key e, k) then Error.bug "decreaseKey"

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/heap/binomial.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/heap/binomial.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/heap/binomial.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 functor EagerBinomialHeap(S: HEAP_STRUCTS): HEAP =
 struct
 

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/heap/fibonacci.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/heap/fibonacci.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/heap/fibonacci.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 functor FibonacciHeap(S: HEAP_STRUCTS): HEAP =
 struct
 

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/heap/forest.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/heap/forest.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/heap/forest.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 (* Forest of heap ordered trees.
  * Can be specialized to eager or lazy binomial heaps, fibonacci heaps.
  *)
@@ -18,22 +19,22 @@
    (* Can't make child a circular list, because the elements aren't defined yet.
     *)
    datatype 'a t = T of {value: 'a Pointer.t,
-			 mark: bool ref,
-			 parent: 'a t Pointer.t,
-			 next: 'a t Pointer.t,
-			 prev: 'a t Pointer.t,
-			 child: 'a t Pointer.t,
-			 numChildren: int ref}
+                         mark: bool ref,
+                         parent: 'a t Pointer.t,
+                         next: 'a t Pointer.t,
+                         prev: 'a t Pointer.t,
+                         child: 'a t Pointer.t,
+                         numChildren: int ref}
 
    fun destruct(T{prev, value, next, ...}) = (prev, Pointer.! value, next)
 
    fun make p = T{value = p,
-		  mark = ref false,
-		  parent = Pointer.null(),
-		  next = Pointer.null(),
-		  prev = Pointer.null(),
-		  child = Pointer.null(),
-		  numChildren = ref 0}
+                  mark = ref false,
+                  parent = Pointer.null(),
+                  next = Pointer.null(),
+                  prev = Pointer.null(),
+                  child = Pointer.null(),
+                  numChildren = ref 0}
 
    fun new v = make(Pointer.new v)
 
@@ -70,14 +71,14 @@
       fun setKey(e, k) = Pointer.:=(valuePtr e, (k, value e))
 
       fun siftUp e =
-	 if hasParent e
-	    then let val p = parent e
-		 in if Key.<(key e, key p)
-		       then (Pointer.swap(valuePtr e, valuePtr p) ;
-			     siftUp p)
-		    else ()
-		 end
-	 else ()
+         if hasParent e
+            then let val p = parent e
+                 in if Key.<(key e, key p)
+                       then (Pointer.swap(valuePtr e, valuePtr p) ;
+                             siftUp p)
+                    else ()
+                 end
+         else ()
    end
 
 (*--------------------------------------------------------*)
@@ -85,8 +86,8 @@
 (*--------------------------------------------------------*)
 
 datatype 'a t = T of {size: int ref,
-		      roots: (Key.t * 'a) CircList.t,
-		      min: 'a Elt.t Pointer.t}
+                      roots: (Key.t * 'a) CircList.t,
+                      min: 'a Elt.t Pointer.t}
 
 fun sizeRef (T{size, ...}) = size
 fun size h = !(sizeRef h)
@@ -95,7 +96,7 @@
 fun decSize h = Int.inc(sizeRef h)
 
 fun roots (T{roots, ...}) = roots
-						       
+                                                       
 fun min(T{min, ...}) = Pointer.! min
 
 fun clearMin(T{min, ...}) = Pointer.clear min
@@ -108,16 +109,16 @@
 fun addRoot(h, e) =
    (CircList.insert(roots h, e)
     ; updateMin(h, e))
-		 
+                 
 fun isEmpty h = size h = 0
 
 local
     fun linkPC(parent, child) =
-	(Elt.incNumChildren parent
-	 ; CircList.insert(Elt.child parent, child)
-	 ; Elt.setParent(Elt.parent child, parent)
-	 ; Elt.unMark child
-	 ; parent)
+        (Elt.incNumChildren parent
+         ; CircList.insert(Elt.child parent, child)
+         ; Elt.setParent(Elt.parent child, parent)
+         ; Elt.unMark child
+         ; parent)
 in fun link(e, e') =
     (* pre: numChildren e = numChildren e' *)
    if Key.<(Elt.key e, Elt.key e')
@@ -126,12 +127,12 @@
 end
 
 fun unlink e = let val p = Elt.parent e
-	       in Elt.decNumChildren p
-		  ; CircList.delete(Elt.child p, e)
-		  ; Elt.clearParent e
-		  ; Elt.unMark e
-	       end
-				
+               in Elt.decNumChildren p
+                  ; CircList.delete(Elt.child p, e)
+                  ; Elt.clearParent e
+                  ; Elt.unMark e
+               end
+                                
 local
    structure I = Int
    local open Real
@@ -143,16 +144,16 @@
       (clearMin h ;
        if size h = 0 then ()
        else let val a = Array.new(maxNumChildren h + 1, NONE)
-		fun insertIntoA e =
-		    let val n = Elt.numChildren e
-		    in case Array.sub(a,n) of
-			NONE => Array.update(a,n, SOME e)
-		      | SOME e' => (Array.update(a,n, NONE)
-				    ; insertIntoA(link(e, e')))
-		    end
-	    in CircList.deleteEach(roots h, insertIntoA)
-	       ; Array.foreach(a, fn NONE => () | SOME e => addRoot(h, e))
-	    end)
+                fun insertIntoA e =
+                    let val n = Elt.numChildren e
+                    in case Array.sub(a,n) of
+                        NONE => Array.update(a,n, SOME e)
+                      | SOME e' => (Array.update(a,n, NONE)
+                                    ; insertIntoA(link(e, e')))
+                    end
+            in CircList.deleteEach(roots h, insertIntoA)
+               ; Array.foreach(a, fn NONE => () | SOME e => addRoot(h, e))
+            end)
 end
 
 (*--------------------------------------------------------*)
@@ -160,8 +161,8 @@
 (*--------------------------------------------------------*)
 
 fun empty() = T{size = ref 0,
-		roots = CircList.empty(),
-		min = Pointer.null()}
+                roots = CircList.empty(),
+                min = Pointer.null()}
 
 fun insertLazy(h, k, v) =
    let val e = Elt.new(k, v)
@@ -180,8 +181,8 @@
    end
 
 fun newEager kvs = let val h = newLazy kvs
-		   in (consolidate h ; h)
-		   end
+                   in (consolidate h ; h)
+                   end
 
 (*--------------------------------------------------------*)
 (*                       DeleteMin                        *)
@@ -209,17 +210,17 @@
    if Elt.hasParent e
       andalso Key.<(k, Elt.key(Elt.parent e))
       then let val rs = roots h
-	       fun cut e = if Elt.hasParent e
-			      then let val p = Elt.parent e
-				   in unlink e
-				      ; CircList.insert(rs, e)
-				      ; if Elt.isMarked p
-					   then cut p
-					else Elt.mark p
-				   end
-			   else ()
-	   in cut e
-	   end
+               fun cut e = if Elt.hasParent e
+                              then let val p = Elt.parent e
+                                   in unlink e
+                                      ; CircList.insert(rs, e)
+                                      ; if Elt.isMarked p
+                                           then cut p
+                                        else Elt.mark p
+                                   end
+                           else ()
+           in cut e
+           end
    else ()
       
 fun decreaseKey(h, e, k) =
@@ -279,30 +280,30 @@
    fun sizeInHeap h = sizeInTrees (roots h)
    fun findMin h =
       let val min = ref NONE
-	 fun updateMin e = (case !min of
-			       NONE => min := SOME e
-			     | SOME e' => if Key.<(Elt.key e, Elt.key e')
-					     then min := SOME e
-					  else ())
+         fun updateMin e = (case !min of
+                               NONE => min := SOME e
+                             | SOME e' => if Key.<(Elt.key e, Elt.key e')
+                                             then min := SOME e
+                                          else ())
       in (CircList.foreach (roots h) updateMin ;
-	  case !min of
-	     SOME e => e
-	   | NONE => bug "findMin") 
+          case !min of
+             SOME e => e
+           | NONE => bug "findMin") 
       end
    fun isTreeWellFormed e =
       let fun isChildWellFormed e' = (Elt.equals(e, Elt.parent e')
-				      andalso Key.<=(Elt.key e, Elt.key e')
-				      andalso isTreeWellFormed e')
-	 val cs = CircList.T (Elt.children e)
+                                      andalso Key.<=(Elt.key e, Elt.key e')
+                                      andalso isTreeWellFormed e')
+         val cs = CircList.T (Elt.children e)
       in Elt.numChildren e = CircList.length cs
-	 andalso CircList.forall cs isChildWellFormed
+         andalso CircList.forall cs isChildWellFormed
       end
 in
    fun isFibonacciHeap h =
       CircList.forall (roots h) isTreeWellFormed
       andalso size h = sizeInHeap h
       andalso (isEmpty h
-	       orelse Key.equals(Elt.key (min h), Elt.key (findMin h)))
+               orelse Key.equals(Elt.key (min h), Elt.key (findMin h)))
 end
 *)
 end

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/heap/forest.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/heap/forest.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/heap/forest.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 type int = Int.t
    
 signature FOREST_HEAP_STRUCTS =
@@ -14,13 +15,13 @@
 signature FOREST_HEAP =
    sig
       include FOREST_HEAP_STRUCTS
-	 
+         
       structure Elt:
-	 sig
-	    type 'a t
-	    val key: 'a t -> Key.t
-	    val value: 'a t -> 'a
-	 end
+         sig
+            type 'a t
+            val key: 'a t -> Key.t
+            val value: 'a t -> 'a
+         end
       
       type 'a t
 

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/heap/heap.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/heap/heap.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/heap/heap.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 type int = Int.t
    
 signature HEAP_STRUCTS =
@@ -14,14 +15,14 @@
 signature HEAP =
    sig
       include HEAP_STRUCTS
-	 
+         
       structure Elt:
-	 sig
-	    type 'a t
+         sig
+            type 'a t
 
-	    val key: 'a t -> Key.t
-	    val value: 'a t -> 'a
-	 end
+            val key: 'a t -> Key.t
+            val value: 'a t -> 'a
+         end
       
       type 'a t
 

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/heap/sources.cm
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/heap/sources.cm	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/heap/sources.cm	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,11 @@
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 Library
 
 functor BinaryHeap

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/heap/test.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/heap/test.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/heap/test.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,22 +1,23 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 local
    structure H = BinaryHeap(structure O = Int
-			    open Int
-			    fun inject x = x
-			    fun project x = x
-			    val largest = Int.maxInt
-			    val smallest = Int.minInt)
+                            open Int
+                            fun inject x = x
+                            fun project x = x
+                            val largest = Int.maxInt
+                            val smallest = Int.minInt)
    open H
    val h = new[(1, "1"), (2, "2"), (3, "3")]
    val _ =
       while not(isEmpty h) do
-	 (print(deleteMin h)
-	  ; print "\n")
+         (print(deleteMin h)
+          ; print "\n")
 in
 end
 
@@ -39,7 +40,7 @@
 val _ = i 3 ;
    
 val h = new (ListUtil.reverse (ListUtil.map (ListUtil.fromTo 1 10)
-			       (fn x => (x, x)))) ;
+                               (fn x => (x, x)))) ;
 
 val _ = p h ;
 
@@ -64,8 +65,8 @@
 min h ;
 
 ListUtil.foreach (ListUtil.fromTo 1 10) (fn i =>
-					 (insert h (11 * i) (11 * i) ;
-					  ())) ;
+                                         (insert h (11 * i) (11 * i) ;
+                                          ())) ;
 
 min h ;
 

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/pervasive/pervasive.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/pervasive/pervasive.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/pervasive/pervasive.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature PERVASIVE_REAL = REAL
 signature PERVASIVE_WORD = WORD
 structure Pervasive =
@@ -63,7 +64,7 @@
       datatype option = datatype option
       datatype order = datatype General.order
       datatype list = datatype list
-	 
+         
       val ! = General.! 
       val op := = General.:= 
       val op @ = List.@ 

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/pervasive/sources.cm
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/pervasive/sources.cm	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/pervasive/sources.cm	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,11 @@
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 Library
 
 signature PERVASIVE_REAL

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/pervasive/sources.mlb
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/pervasive/sources.mlb	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/pervasive/sources.mlb	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,8 +1,15 @@
+(* Copyright (C) 2004-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 local
-    $(SML_LIB)/basis/basis.mlb
-    pervasive.sml
+   $(SML_LIB)/basis/basis.mlb
+   pervasive.sml
 in
-    signature PERVASIVE_REAL
-    signature PERVASIVE_WORD
-    structure Pervasive
+   signature PERVASIVE_REAL
+   signature PERVASIVE_WORD
+   structure Pervasive
 end

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/queue/append-reverse.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/queue/append-reverse.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/queue/append-reverse.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,8 +1,8 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 (*-------------------------------------------------------------------*)
 (*                           AppendReverse                           *)
@@ -48,18 +48,18 @@
 fun empty() = List(L.empty())
    
 fun destruct(List l) = (case L.destruct l of
-			   NONE => NONE
-			 | SOME(x, l) => SOME(x, List l))
+                           NONE => NONE
+                         | SOME(x, l) => SOME(x, List l))
   | destruct(Cons(x, r)) = (force r ; SOME(x, !r))
   | destruct _ = error "destruct"
 and force r = (case !r of
-		  Rot lra => r := rot lra
-		| _ => ())
-and rot(l, r, a) = 			   
+                  Rot lra => r := rot lra
+                | _ => ())
+and rot(l, r, a) =                         
    (case (destruct l, L.destruct r) of
        (NONE, SOME(x, _)) => List(L.cons(x, a))
      | (SOME(x, l), SOME(x', r)) =>
-	  Cons(x, ref(Rot(l, r, L.cons(x', a))))
+          Cons(x, ref(Rot(l, r, L.cons(x', a))))
      | _ => error "rot")
        
 fun appendReverse(l, r) = rot(l, r, L.empty())
@@ -76,16 +76,16 @@
    let val print = Out.outputc out
       fun outputList l = L.output(l, sep, outElt, out)
       fun output(List l) = outputList l
-	| output(Rot(l, r, a)) = (print "Rot(" ;
-				output l ;
-				print ", [" ;
-				outputList r ;
-				print "], " ;
-				outputList a ;
-				print ")")
-	| output(Cons(x, ref r)) = (outElt(x, out) ;
-				   print sep ;
-				   output r)
+        | output(Rot(l, r, a)) = (print "Rot(" ;
+                                output l ;
+                                print ", [" ;
+                                outputList r ;
+                                print "], " ;
+                                outputList a ;
+                                print ")")
+        | output(Cons(x, ref r)) = (outElt(x, out) ;
+                                   print sep ;
+                                   output r)
    in output r
    end
 

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/queue/append-reverse.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/queue/append-reverse.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/queue/append-reverse.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,15 +1,16 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature APPEND_REVERSE =
    sig
       structure L: LIST
       structure I: INTEGER
       sharing L.I = I
-	 
+         
       type 'a t
       val empty: unit -> 'a t
       val isEmpty: 'a t -> bool

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/queue/basic-persistent.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/queue/basic-persistent.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/queue/basic-persistent.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature BASIC_PERSISTENT_QUEUE =
    sig
       type 'a t

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/queue/bounded-ephemeral.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/queue/bounded-ephemeral.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/queue/bounded-ephemeral.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature BOUNDED_EPHEMERAL_QUEUE =
    sig
       include EPHEMERAL_QUEUE

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/queue/circular.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/queue/circular.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/queue/circular.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,8 +1,8 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 (*-------------------------------------------------------------------*)
 (*                           CircularQueue                           *)
@@ -16,9 +16,9 @@
 open I
    
 datatype 'a t = T of {size: I.t ref,
-		      elts: 'a option A.t,
-		      front: I.t ref,
-		      back: I.t ref}
+                      elts: 'a option A.t,
+                      front: I.t ref,
+                      back: I.t ref}
 
 fun sizeRef(T{size=s, ...}) = s
 fun incSize(T{size=s, ...}) = s := add1(!s)
@@ -31,18 +31,18 @@
 fun maxSize d = A.size(elts d)
    
 fun empty maxSize = T{size = ref zero,
-		      elts = A.new(maxSize, NONE),
-		      front = ref zero,
-		      back = ref zero}
+                      elts = A.new(maxSize, NONE),
+                      front = ref zero,
+                      back = ref zero}
 
 fun isEmpty d = isZero(size d)
 
 fun isFull d = size d = maxSize d
 
 fun inc(q, r) = let val r = r q
-	      in r := add1(!r) mod maxSize q
-	      end
-	   
+              in r := add1(!r) mod maxSize q
+              end
+           
 fun incFront q = inc(q, frontRef)
 fun incBack q = inc(q, backRef)
 
@@ -50,18 +50,18 @@
 fun enque(q as T{size, elts, front, back}, x) =
    if isFull q then raise Enque
    else (if isEmpty q then (front := zero ; back := zero)
-	 else (incBack q ;
-	       incSize q ;
-	       A.update(elts, !back, SOME x)))
+         else (incBack q ;
+               incSize q ;
+               A.update(elts, !back, SOME x)))
 
 exception Deque
 fun deque(q as T{size, elts, front, ...}) =
    if isEmpty q then raise Deque
    else case A.sub(elts, !front) of
-	   NONE => raise Deque
-	 | SOME x => (incFront q ;
-		      decSize q ;
-		      x)
+           NONE => raise Deque
+         | SOME x => (incFront q ;
+                      decSize q ;
+                      x)
 
 end
 

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/queue/early.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/queue/early.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/queue/early.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,8 +1,8 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 (*-------------------------------------------------------------------*)
 (*                            EarlyQueue                             *)

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/queue/ephemeral.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/queue/ephemeral.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/queue/ephemeral.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,8 +1,8 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 (*-------------------------------------------------------------------*)
 (*                          Queue Ephemeral                          *)
@@ -16,26 +16,26 @@
 structure L = MutableList
 
 datatype 'a t = T of {head: 'a L.t ref,
-		      tail: 'a L.t ref}
+                      tail: 'a L.t ref}
    
 fun destruct(q as T{head, tail}) =
    case L.destruct(!head) of
       NONE => NONE
     | SOME(x, _) =>
-	 (if L.eqTail(!head, !tail)
-	     then (head := L.empty() ; tail := L.empty())
-	  else head := L.tail(!head) ;
-	     SOME(x, q))
+         (if L.eqTail(!head, !tail)
+             then (head := L.empty() ; tail := L.empty())
+          else head := L.tail(!head) ;
+             SOME(x, q))
    
 fun empty() = T{head = ref(L.empty()), tail = ref(L.empty())}
-	 
+         
 fun isEmpty(T{head, ...}) = L.isEmpty(!head)
    
 fun enque(q as T{head, tail}, x) =
     (let val cell = L.cons(x, L.empty())
      in (if isEmpty q then head := cell
-	 else L.setTail(!tail, cell) ;
-	 tail := cell)
+         else L.setTail(!tail, cell) ;
+         tail := cell)
      end ;
      q)
 

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/queue/ephemeral.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/queue/ephemeral.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/queue/ephemeral.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature EPHEMERAL_QUEUE =
    sig
       type 'a t

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/queue/explicit-append-reverse.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/queue/explicit-append-reverse.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/queue/explicit-append-reverse.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 functor ExplicitAppendReverse(): APPEND_REVERSE =
 struct
 
@@ -19,18 +20,18 @@
 
 exception Destruct and Rotate
 fun destruct(List l) = (case L.destruct l of
-			   NONE => NONE
-			 | SOME(x, l) => SOME(x, List l))
+                           NONE => NONE
+                         | SOME(x, l) => SOME(x, List l))
   | destruct(Cons(x, r)) = (force r ; SOME(x, !r))
   | destruct _ = raise Destruct
 and force r = (case !r of
-		  Rotated lra => r := rotate lra
-		| _ => ())
-and rotate(l, r, a) = 			   
+                  Rotated lra => r := rotate lra
+                | _ => ())
+and rotate(l, r, a) =                      
    (case (destruct l, L.destruct r) of
        (NONE, SOME(x, _)) => List(L.cons(x, a))
      | (SOME(x, l), SOME(x', r)) =>
-	  Cons(x, ref(Rotated(l, r, L.cons(x', a))))
+          Cons(x, ref(Rotated(l, r, L.cons(x', a))))
      | _ => raise Rotate)
        
 fun appendReverse(l, r) = rotate(l, r, L.empty())
@@ -47,16 +48,16 @@
    let val print = Out.outputc out
       fun outputList l = L.output(sep, outElt)(l, out)
       fun output(List l) = outputList l
-	| output(Rotated(l, r, a)) = (print "Rotated(" ;
-				    output l ;
-				    print ", [" ;
-				    outputList r ;
-				    print "], " ;
-				    outputList a ;
-				    print ")")
-	| output(Cons(x, ref r)) = (outElt(x, out) ;
-				   print sep ;
-				   output r)
+        | output(Rotated(l, r, a)) = (print "Rotated(" ;
+                                    output l ;
+                                    print ", [" ;
+                                    outputList r ;
+                                    print "], " ;
+                                    outputList a ;
+                                    print ")")
+        | output(Cons(x, ref r)) = (outElt(x, out) ;
+                                   print sep ;
+                                   output r)
    in output r
    end
 

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/queue/incremental-append-reverse.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/queue/incremental-append-reverse.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/queue/incremental-append-reverse.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 functor IncrementalAppendReverse(): APPEND_REVERSE =
 struct
 

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/queue/incremental.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/queue/incremental.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/queue/incremental.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,8 +1,8 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 (*-------------------------------------------------------------------*)
 (*                         IncrementalQueue                          *)
@@ -30,12 +30,12 @@
 fun queue(l, l', r) =
    if AR.length l >= L.length r then T(l, l', r)
    else let val l = AR.appendReverse(l, r)
-	in T(l, l, L.empty())
-	end
+        in T(l, l, L.empty())
+        end
 
 fun empty() = let val l = AR.empty()
-	      in T(l, l, L.empty())
-	      end
+              in T(l, l, L.empty())
+              end
    
 fun isEmpty(T(l, _, _)) = AR.isEmpty l
 

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/queue/lazy-append-reverse.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/queue/lazy-append-reverse.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/queue/lazy-append-reverse.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 functor LazyAppendReverse(): APPEND_REVERSE =
 struct
    

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/queue/linked-list.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/queue/linked-list.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/queue/linked-list.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,8 +1,8 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 (*-------------------------------------------------------------------*)
 (*                          QueueLinkedList                          *)
@@ -16,7 +16,7 @@
 structure L = MutableList
 
 datatype 'a t = T of {head: 'a L.t ref,
-		      tail: 'a L.t ref}
+                      tail: 'a L.t ref}
 
 fun empty() = T{head = ref(L.empty()), tail = ref(L.empty())}
 
@@ -33,8 +33,8 @@
    case L.destruct(!head) of
       NONE => error "deque"
     | SOME(x, _) => (if L.eq(!head, !tail)
-		       then (head := L.empty() ; tail := L.empty())
-		    else head := L.tail(!head) ;
-		    x)
+                       then (head := L.empty() ; tail := L.empty())
+                    else head := L.tail(!head) ;
+                    x)
 
 end

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/queue/list.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/queue/list.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/queue/list.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,8 +1,8 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 (*-------------------------------------------------------------------*)
 (*                             ListQueue                             *)
@@ -23,7 +23,7 @@
 fun empty () = T(L.empty())
    
 fun isEmpty(T l) = L.isEmpty l
-	 
+         
 fun enque(T l, x) = T(L.append(l, L.single x))
    
 end

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/queue/persistent.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/queue/persistent.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/queue/persistent.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,8 +1,8 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 (*-------------------------------------------------------------------*)
 (*                          PersistentQueue                          *)

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/queue/persistent.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/queue/persistent.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/queue/persistent.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature PERSISTENT_QUEUE =
    sig
       include BASIC_PERSISTENT_QUEUE

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/queue/queue.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/queue/queue.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/queue/queue.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,16 +1,17 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 functor Queue(Q: BASIC_QUEUE): QUEUE =
 struct
 
 val {error, ...} = Error.errors("queue", "queue")
    
 structure Q' = Sequence(structure I = Integer
-			structure S = Q)
+                        structure S = Q)
    
 open Q Q'
 

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/queue/singly-linked.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/queue/singly-linked.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/queue/singly-linked.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,8 +1,8 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 (*-------------------------------------------------------------------*)
 (*                           SinglyLinked                            *)
@@ -15,7 +15,7 @@
 structure E = SimpleSinglyLinkedElement
 
 datatype 'a t = T of {head: 'a E.t P.t,
-		      tail: 'a E.t P.t}
+                      tail: 'a E.t P.t}
 
 fun empty() = T{head = P.null(), tail = P.null()}
 

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/queue/sources.cm
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/queue/sources.cm	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/queue/sources.cm	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,11 @@
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 Library
 
 structure SinglyLinkedQueue

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/queue/test.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/queue/test.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/queue/test.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,18 +1,19 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 structure Q = QueueLogarithmicExplicit();
 fun p q = Q.output(q, ", ", Int.output, Out.standard);
 let val q = ref(Q.empty())
 in Iterate.for(1, 20, fn n =>
-	       (p(!q) ;
-		Out.newline Out.standard ;
-		q := Q.enqueue(!q,n)))
+               (p(!q) ;
+                Out.newline Out.standard ;
+                q := Q.enqueue(!q,n)))
 end
-	       
+               
 
 structure Q = QueuePersistentTwoList
 
@@ -46,6 +47,6 @@
    val numOps = 1000
 in
    val _ = (Ephemeral.test numOps ;
-	    PersistentTwoList.test numOps ;
-	    OrderOne.test numOps)
+            PersistentTwoList.test numOps ;
+            OrderOne.test numOps)
 end

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/queue/two-list.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/queue/two-list.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/queue/two-list.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,8 +1,8 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 (*-------------------------------------------------------------------*)
 (*                           TwoListQueue                            *)
@@ -17,8 +17,8 @@
    
 fun destruct(T(l, r)) =
    let val (l, r) = if L.isEmpty l
-		      then (L.reverse r, L.empty())
-		   else (l, r)
+                      then (L.reverse r, L.empty())
+                   else (l, r)
    in case L.destruct l of
       NONE => NONE
     | SOME(x, l) => SOME(x, T(l, r))

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/queue/unbounded-ephemeral.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/queue/unbounded-ephemeral.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/queue/unbounded-ephemeral.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature UNBOUNDED_EPHEMERAL_QUEUE =
    sig
       include EPHEMERAL_QUEUE

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/set/bit-vector-set.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/set/bit-vector-set.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/set/bit-vector-set.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,32 +1,33 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 type int = Int.t
 type word = Word.t
 
 functor BitVectorSet (Element : sig 
-		                  include T
-		   	          val fromInt: int -> t
-			          val size: int
-			          val toInt: t -> int
-			        end) : SET =
+                                  include T
+                                  val fromInt: int -> t
+                                  val size: int
+                                  val toInt: t -> int
+                                end) : SET =
 struct
    structure Element = Element
 
    structure Bin :> sig 
-		      eqtype t 
-		      val binSize: int 
-		      val difference : t * t -> t
-		      val empty : t
-		      val equals : t * t -> bool
-		      val fold : t * 'a * (int * 'a -> 'a) -> 'a
-		      val intersect : t * t -> t
-		      val singleton : int -> t
-		      val union : t * t -> t
-		    end = 
+                      eqtype t 
+                      val binSize: int 
+                      val difference : t * t -> t
+                      val empty : t
+                      val equals : t * t -> bool
+                      val fold : t * 'a * (int * 'a -> 'a) -> 'a
+                      val intersect : t * t -> t
+                      val singleton : int -> t
+                      val union : t * t -> t
+                    end = 
    struct 
      open Word
      val binSize = wordSize
@@ -39,19 +40,19 @@
      val union = fn (b1, b2) => orb (b1, b2)
      fun fold (w, a, f)
        = let
-	   fun loop (w, a, i) 
-	     = if Int.< (i, wordSize)
-		 then let
-			val a = if andb (w, 0wx1) <> 0wx0
-				  then f (i, a)
-				  else a
-		      in
-			loop (>>(w, 0wx1), a, Int.+ (i, 1))
-		      end
-		 else a
-	 in
-	   loop (w, a, 0)
-	 end
+           fun loop (w, a, i) 
+             = if Int.< (i, wordSize)
+                 then let
+                        val a = if andb (w, 0wx1) <> 0wx0
+                                  then f (i, a)
+                                  else a
+                      in
+                        loop (>>(w, 0wx1), a, Int.+ (i, 1))
+                      end
+                 else a
+         in
+           loop (w, a, 0)
+         end
    end
    type bin = Bin.t
    type t = bin vector 
@@ -72,8 +73,8 @@
 
    val eltToPos = intToPos o Element.toInt
    fun eltToPosBin x = let val pos as (index, slot) = eltToPos x
-		       in (pos, slotToBin slot)
-		       end
+                       in (pos, slotToBin slot)
+                       end
    val posToElt = Element.fromInt o posToInt
 
    val maxPos as (maxIndex,maxSlot) = intToPos (Element.size - 1)
@@ -81,26 +82,26 @@
    val empty : t = Vector.new (maxIndex + 1, Bin.empty)
    fun isEmpty (v : t) = Vector.forall (v, fn b => b = Bin.empty)
    fun singleton x = let val ((index,_), bin) = eltToPosBin x
-		     in Vector.tabulate (maxIndex + 1, fn i =>
-					 if i = index
-					   then bin
-					   else Bin.empty)
-		     end
+                     in Vector.tabulate (maxIndex + 1, fn i =>
+                                         if i = index
+                                           then bin
+                                           else Bin.empty)
+                     end
    fun contains (v, x) = let val ((index,_), bin) = eltToPosBin x
-			 in Bin.intersect (bin, Vector.sub (v, index)) <> Bin.empty
-			 end
+                         in Bin.intersect (bin, Vector.sub (v, index)) <> Bin.empty
+                         end
    fun add (v, x) = let val ((index, _), bin) = eltToPosBin x
-		    in Vector.mapi (v, fn (i, b) =>
-				    if i = index
-				      then Bin.union (bin, b)
-				      else b)
-		    end
+                    in Vector.mapi (v, fn (i, b) =>
+                                    if i = index
+                                      then Bin.union (bin, b)
+                                      else b)
+                    end
    fun remove (v, x) = let val ((index, _), bin) = eltToPosBin x
-		       in Vector.mapi (v, fn (i, b) =>
-				       if i = index
-					 then Bin.difference (b, bin)
-					 else b)
-		       end
+                       in Vector.mapi (v, fn (i, b) =>
+                                       if i = index
+                                         then Bin.difference (b, bin)
+                                         else b)
+                       end
    fun difference (v1, v2) 
      = Vector.map2 (v1, v2, fn (b1, b2) => Bin.difference (b1, b2))
    fun intersect (v1, v2) 
@@ -110,51 +111,51 @@
    fun unions ss = List.fold (ss, empty, union)
    fun equals (v1, v2) = Vector.equals (v1, v2, Bin.equals)
    fun isSubsetEq (v1, v2)
-     = DynamicWind.withEscape
+     = Exn.withEscape
        (fn escape =>
-	Vector.fold2
-	(v1, v2, true, fn (b1, b2, a) =>
-	 if Bin.difference (b1, b2) = Bin.empty
-	   then a
-	   else escape false))
+        Vector.fold2
+        (v1, v2, true, fn (b1, b2, a) =>
+         if Bin.difference (b1, b2) = Bin.empty
+           then a
+           else escape false))
    fun isSubset (s1, s2) = isSubsetEq (s1, s2) andalso not (equals (s1, s2))
    fun isSupersetEq (s1, s2) = isSubsetEq (s2, s1)
    fun isSuperset (s1, s2) = isSubset (s2, s1)
 
    fun areDisjoint (v1, v2)
-     = DynamicWind.withEscape
+     = Exn.withEscape
        (fn escape =>
-	Vector.fold2
-	(v1, v2, true, fn (b1, b2, a) =>
-	 if Bin.intersect(b1, b2) = Bin.empty
-	   then a
-	   else escape false))
+        Vector.fold2
+        (v1, v2, true, fn (b1, b2, a) =>
+         if Bin.intersect(b1, b2) = Bin.empty
+           then a
+           else escape false))
 
 
    fun fold (v, a, f) 
      = Vector.foldi
        (v, a, fn (i, b, a) =>
-	let
-	  val check = if i < maxIndex
-			then fn s => true
-			else fn s => s < maxSlot
-	in
-	  Bin.fold (b, a, fn (s, a) => if check s
-					 then f (posToElt (i, s), a)
-					 else a)
-	end)
+        let
+          val check = if i < maxIndex
+                        then fn s => true
+                        else fn s => s < maxSlot
+        in
+          Bin.fold (b, a, fn (s, a) => if check s
+                                         then f (posToElt (i, s), a)
+                                         else a)
+        end)
    fun foreach (s, f) = fold (s, (), fn (x, ()) => f x)
    fun peekGen (s, no, f)
-     = DynamicWind.withEscape
+     = Exn.withEscape
        (fn escape =>
-	(foreach (s, fn x => 
-		  case f x 
-		    of NONE => ()
-		     | SOME yes => escape yes)
-	 ; no ()))
+        (foreach (s, fn x => 
+                  case f x 
+                    of NONE => ()
+                     | SOME yes => escape yes)
+         ; no ()))
    fun exists (s, p) = peekGen (s, 
-				fn () => false, 
-				fn x => if p x then SOME true else NONE)
+                                fn () => false, 
+                                fn x => if p x then SOME true else NONE)
    fun forall (s, p) = not (exists (s, not o p))
 
    fun subsetSize (s, p)
@@ -162,14 +163,14 @@
    fun size s = subsetSize (s, fn _ => true)
 
    fun replace (s, f) = fold(s, empty, fn (x, s) =>
-			     case f x
-			       of NONE => s
-				| SOME x' => add (s, x'))
+                             case f x
+                               of NONE => s
+                                | SOME x' => add (s, x'))
    fun map (s, f) = replace (s, fn x => SOME (f x))
    fun subset (s, p) = replace (s, fn x => if p x then SOME x else NONE)
    fun partition (s, p) = let val yes = subset (s, p)
-			  in {yes = yes, no = difference (s, yes)}
-			  end
+                          in {yes = yes, no = difference (s, yes)}
+                          end
 
    fun fromList l = List.fold (l, empty, fn (x, s) => add (s, x))
    fun toList s = fold (s, nil, op ::)

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/set/disjoint-collection.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/set/disjoint-collection.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/set/disjoint-collection.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,8 +1,8 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 (*-------------------------------------------------------------------*)
 (*                        Disjoint Collection                        *)
@@ -26,21 +26,21 @@
    end =
    struct
       datatype 'a t = T of {value: 'a,
-			    elt: 'a t S.t D.t option ref}
+                            elt: 'a t S.t D.t option ref}
 
       fun value(T{value, ...}) = value
-	 
+         
       fun elt(T{elt=ref(SOME d), ...}) = d
-	| elt _ = Error.error "Value.elt"
+        | elt _ = Error.error "DisjointCollection.Value.elt"
 
       fun set v = D.value(elt v)
 
       fun new v = let val r = ref NONE
-		      val v = T{value = v, elt = r}
-		      val d = D.new(S.singleton v)
-		  in (r := SOME d ;
-		      v)
-		  end
+                      val v = T{value = v, elt = r}
+                      val d = D.new(S.singleton v)
+                  in (r := SOME d ;
+                      v)
+                  end
       fun copy(T{elt, ...}, v) = T{value = v, elt = elt}
    end
 structure V = Value
@@ -67,7 +67,7 @@
 (* ------------------------------------------------- *)
 
 datatype 'a t = T of {sets: 'a S.t CL.t,
-		      numSets: int ref}
+                      numSets: int ref}
 
 fun sets (T{sets, ...}) = sets
 fun numSetsRef (T{numSets, ...}) = numSets
@@ -76,7 +76,7 @@
 fun decNumSets c = numSetsRef c := numSets c - 1
 
 fun empty() = T{sets = CL.empty(),
-		numSets = ref 0}
+                numSets = ref 0}
    
 fun addSingleton(c, v) =
    let val v = V.new v
@@ -84,10 +84,10 @@
        CL.insert(sets c, V.elt v) ;
        V.set v)
    end
-		    
+                    
 fun new vs = let val c = empty()
-	     in (c, List.map(vs, fn v => addSingleton(c, v)))
-	     end
+             in (c, List.map(vs, fn v => addSingleton(c, v)))
+             end
 
 fun randomSet(T{sets, ...}) = D.value(CL.first sets)
 
@@ -100,9 +100,9 @@
        val d' = S.elt r'
     in if S.equals(r, r') then ()
        else (decNumSets c ;
-	     S.union(r, r') ;
-	     CL.delete(sets c,
-		       if S.isRepresentative r then d' else d))
+             S.union(r, r') ;
+             CL.delete(sets c,
+                       if S.isRepresentative r then d' else d))
     end
 
 end

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/set/disjoint-collection.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/set/disjoint-collection.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/set/disjoint-collection.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,31 +1,32 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature DISJOINT_COLLECTION =
    sig
       structure S :
-	 sig
-	    type 'a t
+         sig
+            type 'a t
 
-	    val value: 'a t -> 'a
-	    val setValue: 'a t * 'a -> unit
-	    val equals: 'a t * 'a t -> bool
-	 end
-	 
+            val value: 'a t -> 'a
+            val setValue: 'a t * 'a -> unit
+            val equals: 'a t * 'a t -> bool
+         end
+         
       type 'a t
 
       val empty: unit -> 'a t
       val new: 'a list -> 'a t * 'a S.t list
-	 
+         
       val addSingleton: 'a t * 'a -> 'a S.t
 
       val numSets: 'a t -> int
-	 
+         
       val randomSet: 'a t -> 'a S.t
       val random: 'a t -> 'a
-	 
+         
       val union: 'a t * 'a S.t * 'a S.t -> unit
    end

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/set/disjoint-max.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/set/disjoint-max.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/set/disjoint-max.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 (* Taken from
  * Applications of Path Compression on Balanced Trees
  * Robert Endre Tarjan
@@ -18,29 +19,29 @@
 structure O = O
     
 datatype t = T of {label: O.t ref,
-		   info: info ref}
+                   info: info ref}
 and info =
    Parent of t
   | Root of {size: int ref,
-	     child: t option ref}
+             child: t option ref}
     
 fun parent (T{info = ref (Parent p), ...}) = p
-  | parent _ = Error.bug "parent"
+  | parent _ = Error.bug "DisjointMax.parent"
 fun setParent(T{info, ...}, p) = info := Parent p
 fun labelRef (T{label, ...}) = label
 val (label, setLabel) = Ref.getAndSet labelRef
 fun sizeRef (T{info = ref(Root{size, ...}), ...}) = size
-  | sizeRef _ = Error.bug "sizeRef"
+  | sizeRef _ = Error.bug "DisjointMax.sizeRef"
 val (size, setSize) = Ref.getAndSet sizeRef
 fun childRef (T{info = ref(Root{child, ...}), ...}) = child
-  | childRef _ = Error.bug "childRef"
+  | childRef _ = Error.bug "DisjointMax.childRef"
 val (childOption, setChildOption) = Ref.getAndSet childRef
 val child = Option.projector childOption
 fun setChild(r, c) = setChildOption(r, SOME c)
    
 fun subsize r = size r - (case childOption r of
-			     NONE => 0
-			   | SOME r' => size r')
+                             NONE => 0
+                           | SOME r' => size r')
 
 fun hasParent (T{info = ref (Parent _), ...}) = true
   | hasParent _ = false
@@ -49,58 +50,58 @@
   | isRoot _ = false
 
 fun singleton l = T{label = ref l,
-		    info = ref (Root{size = ref 0, child = ref NONE})}
+                    info = ref (Root{size = ref 0, child = ref NONE})}
 
 fun update(r, l) =
-   if not(isRoot r) then Error.error "update"
+   if not(isRoot r) then Error.error "DisjointMax.update"
    else if O.<=(l, label r) then ()
    else let
-	   fun link r =
-	      case childOption r of
-		 NONE => r
-	       | SOME r' =>
-		     if O.<=(l, label r') then r
-		     else if subsize r >= subsize r'
-			      then (setChildOption(r, childOption r') ;
-				    setParent(r', r) ;
-				    link r)
-			  else (setSize(r', size r) ;
-				setParent(r, r') ;
-				link r')
-	in (setLabel(r, l) ;
-	    case childOption r of
-	       NONE => ()
-	     | SOME r' => if O.<=(l, label r') then ()
-			  else let val r' = link r'
-			       in (setChild(r, r') ;
-				   setLabel(r', l))
-			       end)
-	end
-	   
+           fun link r =
+              case childOption r of
+                 NONE => r
+               | SOME r' =>
+                     if O.<=(l, label r') then r
+                     else if subsize r >= subsize r'
+                              then (setChildOption(r, childOption r') ;
+                                    setParent(r', r) ;
+                                    link r)
+                          else (setSize(r', size r) ;
+                                setParent(r, r') ;
+                                link r')
+        in (setLabel(r, l) ;
+            case childOption r of
+               NONE => ()
+             | SOME r' => if O.<=(l, label r') then ()
+                          else let val r' = link r'
+                               in (setChild(r, r') ;
+                                   setLabel(r', l))
+                               end)
+        end
+           
 fun link(r, r') =
-   if not (isRoot r andalso isRoot r') then Error.error "link"
+   if not (isRoot r andalso isRoot r') then Error.error "DisjointMax.link"
    else let val s = size r
-	    val s' = size r'
-	    fun move NONE = ()
-	      | move (SOME r') = let val r'' = childOption r'
-				 in (setParent(r', r) ; move r'')
-				 end
-	in (update(r', label r) ;
-	    setSize(r, s + s') ;
-	    if s < s' then move (childOption r) else move (SOME r'))
-	end
+            val s' = size r'
+            fun move NONE = ()
+              | move (SOME r') = let val r'' = childOption r'
+                                 in (setParent(r', r) ; move r'')
+                                 end
+        in (update(r', label r) ;
+            setSize(r, s + s') ;
+            if s < s' then move (childOption r) else move (SOME r'))
+        end
 
 fun compress s = (* Pre: hasParent s *)
    let val p = parent s
    in if hasParent p
       then (compress p ;
-	    setLabel(s, O.max(label s, label p)) ;
-	    setParent(s, parent p))
+            setLabel(s, O.max(label s, label p)) ;
+            setParent(s, parent p))
       else ()
    end
 
 fun eval s = if isRoot s then label s
-	     else (compress s ;
-		   O.max(label s, label (parent s)))
+             else (compress s ;
+                   O.max(label s, label (parent s)))
 
 end

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/set/disjoint-max.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/set/disjoint-max.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/set/disjoint-max.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature DISJOINT_MAX =
    sig
       structure O: ORDER
@@ -14,6 +15,6 @@
 
       val link: t * t -> unit  (* must link roots *)
       (* Make second tree a child of first tree *)
-	 
+         
       val update: t * O.t -> unit (* must update a root *)
    end

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/set/disjoint.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/set/disjoint.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/set/disjoint.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,8 +1,8 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 functor DisjointSet ():> DISJOINT_SET =
@@ -19,28 +19,28 @@
 
 val rank =
    fn T (ref (Root {rank, ...})) => rank
-    | _ => Error.bug "rank"
+    | _ => Error.bug "DisjointSet.rank"
 
 val setRank =
    fn (T (r as ref (Root {value, ...})), rank) =>
         r := Root {value = value, rank = rank}
-    | _ => Error.bug "setRootValue"
+    | _ => Error.bug "DisjointSet.setRootValue"
 
 fun incrementRank r = setRank (r, rank r + 1)
    
 val parent =
    fn T (ref (Parent p)) => p
-    | _ => Error.bug "parent"    
+    | _ => Error.bug "DisjointSet.parent"    
 
 fun setParent (T r, p) = r := Parent p
 
 val rootValue =
    fn T (ref (Root {value, ...})) => value
-    | _ => Error.bug "rootValue"
+    | _ => Error.bug "DisjointSet.rootValue"
 
 val setRootValue =
    fn (T (r as ref (Root {rank, ...})), v) => r := Root {value = v, rank = rank}
-    | _ => Error.bug "setRootValue"
+    | _ => Error.bug "DisjointSet.setRootValue"
     
 fun equal (T r, T r') = r = r'
    
@@ -49,13 +49,13 @@
     | _ => false
     
 val isRepresentative = isRoot
-			
+                        
 fun root s = if isRoot s then s
-	     else let val r = root (parent s)
-		  in setParent (s, r)
-		     ; r
-		  end
-	       
+             else let val r = root (parent s)
+                  in setParent (s, r)
+                     ; r
+                  end
+               
 val representative = root
 
 fun ! s = rootValue (root s)
@@ -69,20 +69,20 @@
       val r' = root s'
    in if equal (r, r') then ()
       else let val n = rank r
-	       val n' = rank r'
-	   in if n < n' then setParent (r, r')
-	      else (setParent (r', r)
-		    ; if Int.equals (n, n') then incrementRank r else ())
-	   end
+               val n' = rank r'
+           in if n < n' then setParent (r, r')
+              else (setParent (r', r)
+                    ; if Int.equals (n, n') then incrementRank r else ())
+           end
    end
 
 fun canUnion (s, s', f) =
    equals (s, s')
    orelse (case f (! s, ! s') of
-	      NONE => false
-	    | SOME v => (union (s, s')
-			 ; s := v
-			 ; true))
+              NONE => false
+            | SOME v => (union (s, s')
+                         ; s := v
+                         ; true))
 
 end
 

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/set/disjoint.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/set/disjoint.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/set/disjoint.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,13 +1,14 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature DISJOINT_SET =
    sig
       type 'a t
-	 
+         
       (* Each set is associated with a single value, like a ref cell. *)
       val := : 'a t * 'a -> unit
       val ! : 'a t -> 'a

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/set/hashed-unique-set.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/set/hashed-unique-set.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/set/hashed-unique-set.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,15 +1,16 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 type int = Int.t
 type word = Word.t
 
 functor HashedUniqueSet(structure Set : SET
-			structure Element : sig include T val hash : t -> word end
-			sharing type Set.Element.t = Element.t) : SET =
+                        structure Element : sig include T val hash : t -> word end
+                        sharing type Set.Element.t = Element.t) : SET =
 struct
 
 structure Set = Set
@@ -20,19 +21,19 @@
   = Word.toInt (Word.andb (w, mask))
 
 datatype t = T of {buckets: Set.t vector,
-		   mask: word} ref
+                   mask: word} ref
 
 fun stats' {buckets, mask}
   = Vector.fold
     (buckets,
      (0, Int.maxInt, Int.minInt),
      fn (s', (size, min, max)) => let 
-				    val n = Set.size s'
-				  in
-				    (size + n,
-				     Int.min(min, n),
-				     Int.max(max, n))
-				  end)
+                                    val n = Set.size s'
+                                  in
+                                    (size + n,
+                                     Int.min(min, n),
+                                     Int.max(max, n))
+                                  end)
 fun stats s 
   = let
       val T (ref {buckets, mask}) = s
@@ -49,26 +50,26 @@
       val n = Vector.length buckets
 
       val buckets
-	= Vector.unfoldi
-	  (2 * n,
-	   ([], false),
-	   fn (i, (l, b))
-	    => if b
-		 then case l
-			of h::t => (h, (t, b))
-			 | _ => Error.bug "HashedUniqueSet::grow"
-		 else if i = n
-			then case List.rev l
-			       of h::t => (h, (t, true))
-				| _ => Error.bug "HashedUniqueSet::grow"
-			else let
-			       val {yes, no}
-				 = Set.partition
-				   (Vector.sub(buckets, i),
-				    fn x => Word.andb(high, hash x) = 0wx0)
-			     in
-			       (yes, (no::l, b))
-			     end)
+        = Vector.unfoldi
+          (2 * n,
+           ([], false),
+           fn (i, (l, b))
+            => if b
+                 then case l
+                        of h::t => (h, (t, b))
+                         | _ => Error.bug "HashedUniqueSet.grow"
+                 else if i = n
+                        then case List.rev l
+                               of h::t => (h, (t, true))
+                                | _ => Error.bug "HashedUniqueSet.grow"
+                        else let
+                               val {yes, no}
+                                 = Set.partition
+                                   (Vector.sub(buckets, i),
+                                    fn x => Word.andb(high, hash x) = 0wx0)
+                             in
+                               (yes, (no::l, b))
+                             end)
     in
       {buckets = buckets, mask = mask}
     end
@@ -80,15 +81,15 @@
       val n = (Vector.length buckets) div 2
 
       val buckets
-	= Vector.unfoldi
-	  (n,
-	   (),
-	   fn (i, _) => let
-			  val s1 = Vector.sub(buckets, i)
-			  val s2 = Vector.sub(buckets, i + n)
-			in
-			  (Set.+(s1, s2), ())
-			end)
+        = Vector.unfoldi
+          (n,
+           (),
+           fn (i, _) => let
+                          val s1 = Vector.sub(buckets, i)
+                          val s2 = Vector.sub(buckets, i + n)
+                        in
+                          (Set.+(s1, s2), ())
+                        end)
     in
       {buckets = buckets, mask = mask}
     end
@@ -99,21 +100,21 @@
       val n = Vector.length buckets
     in
       if max > n
-	then T (ref (grow {buckets = buckets, mask = mask}))
+        then T (ref (grow {buckets = buckets, mask = mask}))
       else if max < n div 2 andalso n > 2
-	then T (ref (shrink {buckets = buckets, mask = mask}))
+        then T (ref (shrink {buckets = buckets, mask = mask}))
       else T (ref {buckets = buckets, mask = mask})
     end
       
 fun coerce (s1 as T (s1' as ref (s1'' as {buckets = buckets1, mask = mask1})),
-	    s2 as T (s2' as ref (s2'' as {buckets = buckets2, mask = mask2})))
+            s2 as T (s2' as ref (s2'' as {buckets = buckets2, mask = mask2})))
   = if mask1 = mask2
       then ()
       else if mask1 < mask2
-	     then (s1' := grow s1'';
-		   coerce (s1, s2))
-	     else (s2' := grow s2'';
-		   coerce (s1, s2))
+             then (s1' := grow s1'';
+                   coerce (s1, s2))
+             else (s2' := grow s2'';
+                   coerce (s1, s2))
 
 
 val empty 
@@ -122,18 +123,18 @@
       val buckets = Vector.new2 (Set.empty, Set.empty)
     in 
       T (ref {buckets = buckets,
-	      mask = mask})
+              mask = mask})
     end
 fun singleton x
   = let
       val mask = 0wx1
       val buckets
-	= if Word.andb(mask, hash x) = 0wx0
-	    then Vector.new2 (Set.singleton x, Set.empty)
-	    else Vector.new2 (Set.empty, Set.singleton x)
+        = if Word.andb(mask, hash x) = 0wx0
+            then Vector.new2 (Set.singleton x, Set.empty)
+            else Vector.new2 (Set.empty, Set.singleton x)
     in
       T (ref {buckets = buckets,
-	      mask = mask})
+              mask = mask})
     end
 
 
@@ -163,14 +164,14 @@
       val T (ref {buckets, mask}) = s
 
       val buckets
-	= Vector.unfoldi
-	  (Vector.length buckets,
-	   (),
-	   fn (i, _) => let
-			  val s' = Vector.sub(buckets, i)
-			in
-			  (sb s', ())
-			end)
+        = Vector.unfoldi
+          (Vector.length buckets,
+           (),
+           fn (i, _) => let
+                          val s' = Vector.sub(buckets, i)
+                        in
+                          (sb s', ())
+                        end)
     in
       T' {buckets = buckets, mask = mask}
     end
@@ -181,15 +182,15 @@
       val T (ref {buckets = buckets2, mask}) = s2
 
       val buckets
-	= Vector.unfoldi
-	  (Vector.length buckets1,
-	   (),
-	   fn (i, _) => let
-			  val s1' = Vector.sub(buckets1, i)
-			  val s2' = Vector.sub(buckets2, i)
-			in
-			  (sb(s1', s2'), ())
-			end)
+        = Vector.unfoldi
+          (Vector.length buckets1,
+           (),
+           fn (i, _) => let
+                          val s1' = Vector.sub(buckets1, i)
+                          val s2' = Vector.sub(buckets2, i)
+                        in
+                          (sb(s1', s2'), ())
+                        end)
     in
       T' {buckets = buckets, mask = mask}
     end
@@ -214,75 +215,75 @@
   = if contains(s, x)
       then s
       else let
-	     val T (ref {buckets, mask}) = s
-	     val ix = index(hash x, mask)
-	     val buckets
-	       = Vector.unfoldi
-	         (Vector.length buckets,
-		  (),
-		  fn (i, _) 
-		   => let
-			val s' = Vector.sub(buckets, i)
-		      in
-			if i = ix
-			  then (Set.add(s', x), ())
-			  else (s', ())
-		      end)
-	   in 
-	     T' {buckets = buckets,
-		 mask = mask}
-	   end
+             val T (ref {buckets, mask}) = s
+             val ix = index(hash x, mask)
+             val buckets
+               = Vector.unfoldi
+                 (Vector.length buckets,
+                  (),
+                  fn (i, _) 
+                   => let
+                        val s' = Vector.sub(buckets, i)
+                      in
+                        if i = ix
+                          then (Set.add(s', x), ())
+                          else (s', ())
+                      end)
+           in 
+             T' {buckets = buckets,
+                 mask = mask}
+           end
 fun remove (s, x)
   = if not (contains(s, x))
       then s
       else let
-	     val T (ref {buckets, mask}) = s
-	     val ix = index(hash x, mask)
-	     val buckets
-	       = Vector.unfoldi
-	         (Vector.length buckets,
-		  (),
-		  fn (i, _) 
-		   => let
-			val s' = Vector.sub(buckets, i)
-		      in
-			if i = ix
-			  then (Set.remove(s', x), ())
-			  else (s', ())
-		      end)
-	   in 
-	     T' {buckets = buckets,
-		 mask = mask}
-	   end
+             val T (ref {buckets, mask}) = s
+             val ix = index(hash x, mask)
+             val buckets
+               = Vector.unfoldi
+                 (Vector.length buckets,
+                  (),
+                  fn (i, _) 
+                   => let
+                        val s' = Vector.sub(buckets, i)
+                      in
+                        if i = ix
+                          then (Set.remove(s', x), ())
+                          else (s', ())
+                      end)
+           in 
+             T' {buckets = buckets,
+                 mask = mask}
+           end
 fun partition (s, p)
   = let
       val T (ref {buckets, mask}) = s 
       val n = Vector.length buckets
       val {yes, no}
-	= Vector.fold
-	  (buckets,
-	   {yes = [], no = []},
-	   fn (s', {yes, no})
-	    => let
-		 val {yes = yes', no = no'} = Set.partition (s', p)
-	       in
-		 {yes = yes'::yes,
-		  no = no'::no}
-	       end)
+        = Vector.fold
+          (buckets,
+           {yes = [], no = []},
+           fn (s', {yes, no})
+            => let
+                 val {yes = yes', no = no'} = Set.partition (s', p)
+               in
+                 {yes = yes'::yes,
+                  no = no'::no}
+               end)
       val yes 
-	= Vector.unfoldi
-	  (n,
-	   List.rev yes,
-	   fn (_, l) => case l
-			  of h::t => (h, t)
-			   | _ => Error.bug "HashedUniqueSet::partition")
+        = Vector.unfoldi
+          (n,
+           List.rev yes,
+           fn (_, l) => case l
+                          of h::t => (h, t)
+                           | _ => Error.bug "HashedUniqueSet.partition.yes")
       val no
-	= Vector.unfoldi
-	  (n,
-	   List.rev no,
-	   fn (_, l) => case l
-			  of h::t => (h, t)
-			   | _ => Error.bug "HashedUniqueSet::partition")
+        = Vector.unfoldi
+          (n,
+           List.rev no,
+           fn (_, l) => case l
+                          of h::t => (h, t)
+                           | _ => Error.bug "HashedUniqueSet.partition.no")
     in
       {yes = T' {buckets = yes, mask = mask},
        no = T' {buckets = no, mask = mask}}
@@ -304,8 +305,8 @@
 fun map (s, f) = fold(s, empty, fn (x, s) => add(s, f x))
 fun replace (s, f)
   = fold(s, empty, fn (x, s) => case f x
-				  of NONE => s
-				   | SOME x' => add(s, x'))
+                                  of NONE => s
+                                   | SOME x' => add(s, x'))
 fun subsetSize (s, p) 
   = fold(s, 0: int, fn (x, n) => if p x then n + 1 else n)
 fun size s = subsetSize(s, fn _ => true)
@@ -313,8 +314,8 @@
 
 fun layout s = List.layout Element.layout (toList s)
 
-fun power s = Error.bug "HashedUniqueSet::power"
-fun subsets (s, n) = Error.bug "HashedUniqueSet: subsets"
+fun power s = Error.bug "HashedUniqueSet.power"
+fun subsets (s, n) = Error.bug "HashedUniqueSet.subsets"
 
 fun isEmpty s = size s = 0
 fun isSubsetEq (s1, s2) = size (difference (s1, s2)) = 0

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/set/object-oriented.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/set/object-oriented.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/set/object-oriented.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 functor Set () =
 struct
    
@@ -12,7 +13,7 @@
 datatype 'a t =
    Empty
  | NonEmpty of {elts: 'a list,
-		equal: ('a * 'a -> bool)}
+                equal: ('a * 'a -> bool)}
    
 val empty = Empty
 

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/set/ordered-unique-set.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/set/ordered-unique-set.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/set/ordered-unique-set.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 functor OrderedUniqueSet(Element : ORDER): SET = 
 struct
 
@@ -12,39 +13,39 @@
 type int = Int.t
 
 datatype t = T of {elements: Element.t list,
-		   length: int}
+                   length: int}
 
 fun T' _ s
   = let
 (*
       val _ 
-	= Assert.assert
-	  ("OrderedUniqueSet, " ^ f,
-	   fn () => let
-		      val rec check
-			= fn h1::(t as h2::_)
-			   => if Element.compare(h1, h2) = LESS
-				then check t
-				else (print (concat
-					     [Layout.toString (Element.layout h1),
-					      ", ",
-					      Layout.toString (Element.layout h2),
-					      "\n",
-					      Layout.toString (Relation.layout (Element.compare(h1, h2))),
-					      "\n",
-					      Layout.toString (Relation.layout (Element.compare(h2, h1))),
-					      "\n"
-					      ]);
-				      false)
-			   | _ => true
-		    in 
-		      (List.length elements = length)
-		      andalso
-		      check elements
-		    end)
+        = Assert.assert
+          ("OrderedUniqueSet, " ^ f,
+           fn () => let
+                      val rec check
+                        = fn h1::(t as h2::_)
+                           => if Element.compare(h1, h2) = LESS
+                                then check t
+                                else (print (concat
+                                             [Layout.toString (Element.layout h1),
+                                              ", ",
+                                              Layout.toString (Element.layout h2),
+                                              "\n",
+                                              Layout.toString (Relation.layout (Element.compare(h1, h2))),
+                                              "\n",
+                                              Layout.toString (Relation.layout (Element.compare(h2, h1))),
+                                              "\n"
+                                              ]);
+                                      false)
+                           | _ => true
+                    in 
+                      (List.length elements = length)
+                      andalso
+                      check elements
+                    end)
           handle exn => (print (Layout.toString (List.layout Element.layout elements));
-			 print "\n";
-			 raise exn)
+                         print "\n";
+                         raise exn)
 *)
     in
       T s
@@ -57,12 +58,12 @@
 fun contains (T {elements = xs, ...}, x)
   = let
       val rec contains' 
-	= fn [] => false
+        = fn [] => false
            | h::t => if Element.<(h, x)
-		       then contains' t
-		     else if Element.>(h,x)
-			    then false
-		     else true
+                       then contains' t
+                     else if Element.>(h,x)
+                            then false
+                     else true
     in
       contains' xs
     end
@@ -70,37 +71,37 @@
 fun add (s as T s', x)
   = let
       val rec add'
-	= fn ({elements = [], ...},
-	      {elements = xsacc, length = nacc})
-	   => {elements = List.appendRev(xsacc, [x]), length = nacc + 1}
-	   | ({elements = xs as h::t, length = n},
-	      {elements = xsacc, length = nacc})
-	   => if Element.<(h,x)
-		then add' ({elements = t, length = n - 1},
-			   {elements = h::xsacc, length = 1 + nacc})
-	      else if Element.>(h,x)
-		then {elements = List.appendRev(xsacc, x::xs),
-		      length = nacc + 1 + n}
-	      else {elements = List.appendRev(xsacc, xs),
-		    length = nacc + n}
+        = fn ({elements = [], ...},
+              {elements = xsacc, length = nacc})
+           => {elements = List.appendRev(xsacc, [x]), length = nacc + 1}
+           | ({elements = xs as h::t, length = n},
+              {elements = xsacc, length = nacc})
+           => if Element.<(h,x)
+                then add' ({elements = t, length = n - 1},
+                           {elements = h::xsacc, length = 1 + nacc})
+              else if Element.>(h,x)
+                then {elements = List.appendRev(xsacc, x::xs),
+                      length = nacc + 1 + n}
+              else {elements = List.appendRev(xsacc, xs),
+                    length = nacc + n}
     in
       if contains(s, x)
-	then s
-	else T' "add" (add' (s', empty'))
+        then s
+        else T' "add" (add' (s', empty'))
     end
 
 fun areDisjoint (T {elements = xs1, ...}, T {elements = xs2, ...})
   = let
       val rec areDisjoint'
-	= fn ([], _) => true
-	   | (_, []) => true
-	   | (xs1 as h1::t1, 
-	      xs2 as h2::t2)
-	   => if Element.<(h1, h2)
-		then areDisjoint'(t1, xs2)
-	      else if Element.>(h1, h2)
-		then areDisjoint'(xs1, t2)
-	      else false
+        = fn ([], _) => true
+           | (_, []) => true
+           | (xs1 as h1::t1, 
+              xs2 as h2::t2)
+           => if Element.<(h1, h2)
+                then areDisjoint'(t1, xs2)
+              else if Element.>(h1, h2)
+                then areDisjoint'(xs1, t2)
+              else false
     in
       areDisjoint' (xs1, xs2)
     end
@@ -108,42 +109,42 @@
 fun difference (T s1', T s2')
   = let
       val rec difference'
-	= fn ({elements = [], ...},
-	      _,
-	      {elements = xsacc, length = nacc})
-	   => {elements = List.rev xsacc, length = nacc}
-	   | ({elements = xs1, length = n1},
-	      {elements = [], ...},
-	      {elements = xsacc, length = nacc})
-	   => {elements = List.appendRev(xsacc, xs1), length = nacc + n1}
-	   | (s1 as {elements = h1::t1, length = n1},
-	      s2 as {elements = h2::t2, length = n2},
-	      sacc as {elements = xsacc, length = nacc})
-	   => if Element.<(h1,h2)
-		then difference' ({elements = t1, length = n1 - 1},
-				  s2,
-				  {elements = h1::xsacc, length = 1 + nacc})
-	      else if Element.>(h1,h2)
-		then difference' (s1,
-				  {elements = t2, length = n2 - 1},
-				  sacc)
-	      else difference' ({elements = t1, length = n1 - 1},
-				{elements = t2, length = n2 - 1},
-				sacc)
+        = fn ({elements = [], ...},
+              _,
+              {elements = xsacc, length = nacc})
+           => {elements = List.rev xsacc, length = nacc}
+           | ({elements = xs1, length = n1},
+              {elements = [], ...},
+              {elements = xsacc, length = nacc})
+           => {elements = List.appendRev(xsacc, xs1), length = nacc + n1}
+           | (s1 as {elements = h1::t1, length = n1},
+              s2 as {elements = h2::t2, length = n2},
+              sacc as {elements = xsacc, length = nacc})
+           => if Element.<(h1,h2)
+                then difference' ({elements = t1, length = n1 - 1},
+                                  s2,
+                                  {elements = h1::xsacc, length = 1 + nacc})
+              else if Element.>(h1,h2)
+                then difference' (s1,
+                                  {elements = t2, length = n2 - 1},
+                                  sacc)
+              else difference' ({elements = t1, length = n1 - 1},
+                                {elements = t2, length = n2 - 1},
+                                sacc)
     in
       T' "difference" (difference' (s1', s2', empty'))
     end
 
 fun equals (T {elements = xs1, length = n1},
-	    T {elements = xs2, length = n2})
+            T {elements = xs2, length = n2})
   = let
       val rec equals' 
-	= fn ([], []) => true
-	   | ([], _) => false
-	   | (_, []) => false
-	   | (h1::t1, h2::t2) => Element.equals(h1, h2)
-	                         andalso
-				 equals'(t1, t2)
+        = fn ([], []) => true
+           | ([], _) => false
+           | (_, []) => false
+           | (h1::t1, h2::t2) => Element.equals(h1, h2)
+                                 andalso
+                                 equals'(t1, t2)
     in
       n1 = n2 
       andalso
@@ -162,28 +163,28 @@
 fun intersect (T s1', T s2')
   = let
       val rec intersect'
-	= fn ({elements = [], ...},
-	      _,
-	      {elements = xsacc, length = nacc})
-	   => {elements = List.rev xsacc, length = nacc}
-	   | (_,
-	      {elements = [], ...},
-	      {elements = xsacc, length = nacc})
-	   => {elements = List.rev xsacc, length = nacc}
-	   | (s1 as {elements = h1::t1, length = n1},
-	      s2 as {elements = h2::t2, length = n2},
-	      sacc as {elements = xsacc, length = nacc})
-	   => if Element.<(h1,h2)
-		then intersect' ({elements = t1, length = n1 - 1},
-				 s2,
-				 sacc)
-	      else if Element.>(h1,h2)
-		then intersect' (s1,
-				 {elements = t2, length = n2 - 1},
-				 sacc)
-	      else intersect' ({elements = t1, length = n1 - 1},
-			       {elements = t2, length = n2 - 1},
-			       {elements = h1::xsacc, length = 1 + nacc})
+        = fn ({elements = [], ...},
+              _,
+              {elements = xsacc, length = nacc})
+           => {elements = List.rev xsacc, length = nacc}
+           | (_,
+              {elements = [], ...},
+              {elements = xsacc, length = nacc})
+           => {elements = List.rev xsacc, length = nacc}
+           | (s1 as {elements = h1::t1, length = n1},
+              s2 as {elements = h2::t2, length = n2},
+              sacc as {elements = xsacc, length = nacc})
+           => if Element.<(h1,h2)
+                then intersect' ({elements = t1, length = n1 - 1},
+                                 s2,
+                                 sacc)
+              else if Element.>(h1,h2)
+                then intersect' (s1,
+                                 {elements = t2, length = n2 - 1},
+                                 sacc)
+              else intersect' ({elements = t1, length = n1 - 1},
+                               {elements = t2, length = n2 - 1},
+                               {elements = h1::xsacc, length = 1 + nacc})
     in
       T' "intersect" (intersect' (s1', s2', empty'))
     end
@@ -194,18 +195,18 @@
 fun partition (T {elements = xs, ...}, p)
   = let
       val {yes = {elements = yxs, length = yn},
-	   no = {elements = nxs, length = nn}}
-	= List.fold(xs, 
-		    {yes = empty',
-		     no = empty'},
-		    fn (x, 
-			{yes as {elements = yxs, length = yn},
-			 no as {elements = nxs, length = nn}})
-		     => if p x
-			  then {yes = {elements = x::yxs, length = yn + 1},
-				no = no}
-			  else {yes = yes,
-				no = {elements = x::nxs, length = nn + 1}})
+           no = {elements = nxs, length = nn}}
+        = List.fold(xs, 
+                    {yes = empty',
+                     no = empty'},
+                    fn (x, 
+                        {yes as {elements = yxs, length = yn},
+                         no as {elements = nxs, length = nn}})
+                     => if p x
+                          then {yes = {elements = x::yxs, length = yn + 1},
+                                no = no}
+                          else {yes = yes,
+                                no = {elements = x::nxs, length = nn + 1}})
     in
       {yes = T' "partition" {elements = List.rev yxs, length = yn},
        no = T' "partition" {elements = List.rev nxs, length = nn}}
@@ -214,16 +215,16 @@
 fun power (T {elements = xs, ...})
   = let
       val rec power'
-	= fn [] => [empty]
-	   | h::t => let
-		       val rest = power' t
-		     in
-		       List.fold
-		       (rest,
-			rest,
-			fn (T {elements = xs, length = n}, rest) 
-			 => (T' "power" {elements = h::xs, length = 1 + n})::rest)
-		     end
+        = fn [] => [empty]
+           | h::t => let
+                       val rest = power' t
+                     in
+                       List.fold
+                       (rest,
+                        rest,
+                        fn (T {elements = xs, length = n}, rest) 
+                         => (T' "power" {elements = h::xs, length = 1 + n})::rest)
+                     end
     in
       power' xs
     end
@@ -231,41 +232,41 @@
 fun remove (T s', x)
   = let
       val rec remove' 
-	= fn ({elements = [], ...},
-	      {elements = xsacc, length = nacc})
-	   => {elements = List.appendRev(xsacc, [x]), length = nacc + 1}
-	   | ({elements = xs as h::t, length = n},
-	      {elements = xsacc, length = nacc})
-	   => if Element.<(h, x)
-		then remove' ({elements = t, length = n - 1},
-			      {elements = h::xsacc, length = 1 + nacc})
-	      else if Element.>(h, x)
-		then {elements = List.appendRev(xsacc, xs),
-		      length = nacc + n}
-	      else {elements = List.appendRev(xsacc, t),
-		    length = nacc + n - 1}
+        = fn ({elements = [], ...},
+              {elements = xsacc, length = nacc})
+           => {elements = List.appendRev(xsacc, [x]), length = nacc + 1}
+           | ({elements = xs as h::t, length = n},
+              {elements = xsacc, length = nacc})
+           => if Element.<(h, x)
+                then remove' ({elements = t, length = n - 1},
+                              {elements = h::xsacc, length = 1 + nacc})
+              else if Element.>(h, x)
+                then {elements = List.appendRev(xsacc, xs),
+                      length = nacc + n}
+              else {elements = List.appendRev(xsacc, t),
+                    length = nacc + n - 1}
     in
       T' "remove" (remove' (s', empty'))
     end
 
 fun replace (T {elements = xs, ...}, f)
   = List.fold(xs, 
-	      empty, 
-	      fn (x, s) => (case f x
-			      of NONE => s
-			       | SOME x' => add(s, x')))
+              empty, 
+              fn (x, s) => (case f x
+                              of NONE => s
+                               | SOME x' => add(s, x')))
 
 fun size (T {length = n, ...}) = n
 
 fun subset (T {elements = xs, ...}, p)
   = let
       val {elements = xs, length = n}
-	= List.fold(xs, 
-		    empty',
-		    fn (x, s as {elements = xs, length = n})
-		     => if p x
-			  then {elements = x::xs, length = n + 1}
-			  else s)
+        = List.fold(xs, 
+                    empty',
+                    fn (x, s as {elements = xs, length = n})
+                     => if p x
+                          then {elements = x::xs, length = n + 1}
+                          else s)
     in
       T' "subset" {elements = List.rev xs, length = n}
     end
@@ -274,36 +275,36 @@
 
 fun subsetSize (T {elements = xs, ...}, p)
   = List.fold(xs, 0: int, fn (x, n) => if p x then n + 1 else n)
-			     
+                             
 fun toList (T {elements = xs, ...}) = xs
 
 fun union (T s1', T s2')
   = let
       val rec union' 
-	= fn ({elements = [], ...},
-	      {elements = xs2, length = n2},
-	      {elements = xsacc, length = nacc})
-	   => {elements = List.appendRev(xsacc, xs2),
-	       length = nacc + n2}
+        = fn ({elements = [], ...},
+              {elements = xs2, length = n2},
+              {elements = xsacc, length = nacc})
+           => {elements = List.appendRev(xsacc, xs2),
+               length = nacc + n2}
            | ({elements = xs1, length = n1},
-	      {elements = [], ...},
-	      {elements = xsacc, length = nacc})
-	   => {elements = List.appendRev(xsacc, xs1),
-	       length = nacc + n1}
-	   | (s1 as {elements = h1::t1, length = n1},
-	      s2 as {elements = h2::t2, length = n2},
-	      {elements = xsacc, length = nacc})
-	   => if Element.<(h1,h2)
-		then union' ({elements = t1, length = n1 - 1},
-			     s2,
-			     {elements = h1::xsacc, length = 1 + nacc})
-	      else if Element.>(h1,h2)
-		then union' (s1,
-			     {elements = t2, length = n2 - 1},
-			     {elements = h2::xsacc, length = 1 + nacc})
-	      else union' ({elements = t1, length = n1 - 1},
-			   {elements = t2, length = n2 - 1},
-			   {elements = h1::xsacc, length = 1 + nacc})
+              {elements = [], ...},
+              {elements = xsacc, length = nacc})
+           => {elements = List.appendRev(xsacc, xs1),
+               length = nacc + n1}
+           | (s1 as {elements = h1::t1, length = n1},
+              s2 as {elements = h2::t2, length = n2},
+              {elements = xsacc, length = nacc})
+           => if Element.<(h1,h2)
+                then union' ({elements = t1, length = n1 - 1},
+                             s2,
+                             {elements = h1::xsacc, length = 1 + nacc})
+              else if Element.>(h1,h2)
+                then union' (s1,
+                             {elements = t2, length = n2 - 1},
+                             {elements = h2::xsacc, length = 1 + nacc})
+              else union' ({elements = t1, length = n1 - 1},
+                           {elements = t2, length = n2 - 1},
+                           {elements = h1::xsacc, length = 1 + nacc})
     in
       T' "union" (union' (s1', s2', empty'))
     end

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/set/poly-set.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/set/poly-set.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/set/poly-set.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature POLY_SET =
    sig
       structure I: INTEGER
@@ -11,7 +12,7 @@
       type 'a t
 
       val empty: {equal: 'a * 'a -> bool,
-		   output: 'a * Out.t -> unit} -> 'a t
+                   output: 'a * Out.t -> unit} -> 'a t
 
       val size: 'a t -> I.t
       val foreach: 'a t * ('a -> unit) -> unit
@@ -32,7 +33,7 @@
 
       val add: 'a t * 'a -> 'a t
       val remove: 'a t * 'a -> 'a t
-	 
+         
       val contains: 'a t * 'a -> bool
       val isEmpty: 'a t -> bool
 

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/set/poly-unordered.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/set/poly-unordered.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/set/poly-unordered.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 functor PolyUnorderedSet(): POLY_SET =
 struct
    
@@ -11,7 +12,7 @@
 structure L = List
 
 type 'a info = {equal: 'a * 'a -> bool,
-		output: 'a * Out.t -> unit}
+                output: 'a * Out.t -> unit}
 
 datatype 'a t = T of 'a List.t * 'a info
 
@@ -50,8 +51,8 @@
 fun s1 - s2 = subset(s1, fn x => not(contains(s2, x)))
 
 fun s1 + (s2 as T(x2s, _)) = let val T(x1s, info) = s1 - s2
-			    in T(L.append(x1s, x2s), info)
-			    end
+                            in T(L.append(x1s, x2s), info)
+                            end
 
 (*fun union ss = L.foldl(ss, empty, op +)*)
 

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/set/poly-unordered2.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/set/poly-unordered2.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/set/poly-unordered2.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,27 +1,28 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 functor Set() :
    sig
       type 'a t
-	 
+         
       val make: {equal: 'a * 'a -> bool,
-		  output: 'a * Out.t -> unit} ->
-	 {empty: 'a t,
-	  isEmpty: 'a t -> bool,
-	  forall: 'a t * ('a -> bool) -> bool,
-	  equal: 'a t * 'a t -> bool,
-	  ...}
+                  output: 'a * Out.t -> unit} ->
+         {empty: 'a t,
+          isEmpty: 'a t -> bool,
+          forall: 'a t * ('a -> bool) -> bool,
+          equal: 'a t * 'a t -> bool,
+          ...}
    end
 
 fun make{equal, output} =
    let
       val empty = []
       fun isEmpty [] = true
-	| isEmpty _ = false
+        | isEmpty _ = false
       val forall = List.forall
    in {empty = empty,
        isEmpty = isEmpty,

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/set/set.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/set/set.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/set/set.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 type int = Int.t
    
 signature SET_STRUCTS =

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/set/sources.cm
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/set/sources.cm	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/set/sources.cm	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,11 @@
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 Library
 
 signature SET

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/set/sources.mlb
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/set/sources.mlb	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/set/sources.mlb	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,22 +1,29 @@
+(* Copyright (C) 2004-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 ann  
-   "sequenceUnit true"
-   "warnMatch true"
+   "sequenceNonUnit warn"
+   "nonexhaustiveMatch warn" "redundantMatch warn"
    "warnUnused false" "forceUsed"
 in
-local
-    $(SML_LIB)/basis/basis.mlb
-    ../basic/sources.mlb
+   local
+      $(SML_LIB)/basis/basis.mlb
+      ../basic/sources.mlb
 
-    disjoint.sig
-    disjoint.fun
-    set.sig
-    unordered.fun
-    ordered-unique-set.fun
-in
-    signature SET
+      disjoint.sig
+      disjoint.fun
+      set.sig
+      unordered.fun
+      ordered-unique-set.fun
+   in
+      signature SET
 
-    structure DisjointSet
-    functor OrderedUniqueSet
-    functor UnorderedSet
+      structure DisjointSet
+      functor OrderedUniqueSet
+      functor UnorderedSet
+   end
 end
-end

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/set/test.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/set/test.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/set/test.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 structure S = UnorderedUniverse(Integer)
    
 

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/set/type.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/set/type.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/set/type.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,8 +1,8 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 (*-------------------------------------------------------------------*)
 (*                               Type                                *)
@@ -36,16 +36,16 @@
 
 structure Set =
     struct
-	type t = set
-	val combine = combineSet
-	val areCompatible = combineToCompat combine
+        type t = set
+        val combine = combineSet
+        val areCompatible = combineToCompat combine
     end
 
 structure Elt =
     struct
-	type t = elt
-	val combine = combineElt
-	val areCompatible = combineToCompat combine
+        type t = elt
+        val combine = combineElt
+        val areCompatible = combineToCompat combine
     end
 
 fun combineSetElt(EmptySet, t) = Set t

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/set/type.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/set/type.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/set/type.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,35 +1,36 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature TYPE =
     sig
-	datatype set =
-	    EmptySet
-	  | Set of elt
-	and elt = 
-	    Base
-	  | Pair of elt * elt
-	  | EltSet of set
+        datatype set =
+            EmptySet
+          | Set of elt
+        and elt = 
+            Base
+          | Pair of elt * elt
+          | EltSet of set
 
-	exception Incompatible
-	
-	structure Set :
-	    sig
-		type t sharing type t = set
-		val combine: t * t -> t
-		val areCompatible: t * t -> bool
-	    end
+        exception Incompatible
+        
+        structure Set :
+            sig
+                type t sharing type t = set
+                val combine: t * t -> t
+                val areCompatible: t * t -> bool
+            end
 
-	structure Elt :
-	    sig
-		type t sharing type t = elt
+        structure Elt :
+            sig
+                type t sharing type t = elt
                 val combine: t * t -> t
-		val areCompatible: t * t -> bool
-	    end
-	
-	val combineSetElt: set * elt -> set
-	val areCompatibleSetElt: set * elt -> bool
+                val areCompatible: t * t -> bool
+            end
+        
+        val combineSetElt: set * elt -> set
+        val areCompatibleSetElt: set * elt -> bool
     end

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/set/universe-equal.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/set/universe-equal.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/set/universe-equal.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,8 +1,8 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 (*-------------------------------------------------------------------*)
 (*                             SetEqual                              *)
@@ -22,43 +22,43 @@
    struct
       datatype set = T of t list
       and t =
-	 Error.of Base.t
-	| Pair of t * t
-	| Set of set
-	 
+         Error.of Base.t
+        | Pair of t * t
+        | Set of set
+         
       fun toError.Base b) = b
-	| toError._ = error "Elt.toBase"
+        | toError._ = error "Elt.toBase"
       fun toPair(Pair p) = p
-	| toPair _ = error "Elt.toPair"
+        | toPair _ = error "Elt.toPair"
       fun toSet(Set s) = s
-	| toSet _ = error "Elt.toSet"
+        | toSet _ = error "Elt.toSet"
 
       fun equalSet(s, s') = isSubset(s, s') andalso isSubset(s', s)
       and isSubset(s, s') = forall(s, fn x => contains(s', x))
       and contains(T xs, x) = L.exists(xs, fn x' => equalElt(x, x'))
       and equalElt(Error.b, Base b') = B.equals(b, b')
-	| equalElt(Pair(x, y), Pair(x', y')) =
-	  equalElt(x, x') andalso equalElt(y, y')
-	| equalElt(Set s, Set s') = equalSet(s, s')
-	| equalElt _ = false
-	  
+        | equalElt(Pair(x, y), Pair(x', y')) =
+          equalElt(x, x') andalso equalElt(y, y')
+        | equalElt(Set s, Set s') = equalSet(s, s')
+        | equalElt _ = false
+          
       fun outputSet(T xs, out) =
-	 let val print = O.outputc out
-	 in (print "{" ;
-	     L.output(xs, ", ", outputElt, out) ;
-	     print "}")
-	 end
+         let val print = O.outputc out
+         in (print "{" ;
+             L.output(xs, ", ", outputElt, out) ;
+             print "}")
+         end
       and outputElt(Error.b, out) = Base.output(b, out)
-	| outputElt(Pair(x, y), out) =
-	  let val print = O.outputc out
-	  in (print "(" ;
-	      outputElt(x, out) ;
-	      print ", " ;
-	      outputElt(y, out) ;
-	      print ")")
-	  end
-	| outputElt(Set s, out) = outputSet(s, out)
-	  
+        | outputElt(Pair(x, y), out) =
+          let val print = O.outputc out
+          in (print "(" ;
+              outputElt(x, out) ;
+              print ", " ;
+              outputElt(y, out) ;
+              print ")")
+          end
+        | outputElt(Set s, out) = outputSet(s, out)
+          
       val equals = equalElt
       val output = outputElt
    end
@@ -72,46 +72,46 @@
 fun cross(sx, sy) =
     let val ys = toList sy
     in listTo(L.foldl
-	      (toList sx, [],
-	       fn (ps, x) => L.mapAppend(ys, fn y => Pair(x, y), ps)))
+              (toList sx, [],
+               fn (ps, x) => L.mapAppend(ys, fn y => Pair(x, y), ps)))
     end
 
 fun project1 s = replace(s,
-			 fn Pair(x, _) => SOME x
-			  | _ => error "project1")
+                         fn Pair(x, _) => SOME x
+                          | _ => error "project1")
 fun project2 s = replace(s,
-			 fn Pair(_, y) => SOME y
-			  | _ => error "project2")
+                         fn Pair(_, y) => SOME y
+                          | _ => error "project2")
     
 fun update (c, x, y) =
     let fun update[] = [Pair(x, y)]
-	  | update((Pair(x', y')) :: ps) =
-	    if Elt.equals(x, x') then (Pair(x, y)) :: ps
-	    else (Pair(x', y')) :: (update ps)
-	  | update _ = error "update"
+          | update((Pair(x', y')) :: ps) =
+            if Elt.equals(x, x') then (Pair(x, y)) :: ps
+            else (Pair(x', y')) :: (update ps)
+          | update _ = error "update"
     in listTo(update(toList c))
     end
 
 fun updateSet(c, c') =
     L.foldl(toList c', c,
-	    fn (c, Pair(x, y)) => update(c, x, y)
-	     | _ => error "updateSet")
+            fn (c, Pair(x, y)) => update(c, x, y)
+             | _ => error "updateSet")
 
 fun lookup (c, x) =
     let fun lookup [] = NONE
-	  | lookup (Pair(x', y) :: ps) =
-	    if Elt.equals(x, x') then SOME y else lookup ps
-	  | lookup _ = error "lookup"
+          | lookup (Pair(x', y) :: ps) =
+            if Elt.equals(x, x') then SOME y else lookup ps
+          | lookup _ = error "lookup"
     in lookup(toList c)
     end
 
 fun Union s = L.foldl(toList s, empty,
-		      fn (s', Set s) => union(s, s')
-		       | _ => error "Union")
+                      fn (s', Set s) => union(s, s')
+                       | _ => error "Union")
 val Union = Trace.trace("Union", outputSet, outputSet) Union
 (*
 fun Cross s = listTo(L.map(L.cross(L.map(toList s,
-					 toList o Elt.toSet)),
-			    Set o listTo))
+                                         toList o Elt.toSet)),
+                            Set o listTo))
 *)
 end

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/set/universe-type-check.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/set/universe-type-check.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/set/universe-type-check.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,8 +1,8 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 (*-------------------------------------------------------------------*)
 (*                             SetCheck                              *)
@@ -19,68 +19,68 @@
    
 fun typeOf s =
     L.foldl(toList s,
-	    T.EmptySet,
-	    fn (t, x: E.t) =>
-	    T.Set.combine(t, T.Set(typeOfElt x)))
+            T.EmptySet,
+            fn (t, x: E.t) =>
+            T.Set.combine(t, T.Set(typeOfElt x)))
 and typeOfElt(Base _) = T.Base
   | typeOfElt(Pair(x, y)) = T.Pair(typeOfElt x, typeOfElt y)
   | typeOfElt(Set s) = T.EltSet(typeOf s)
 
 fun setElt (name, f) (s, x) = 
    (Error.assert[(T.areCompatibleSetElt(typeOf s, typeOfElt x),
-		 name ^ ": incompatible set and element")] ;
+                 name ^ ": incompatible set and element")] ;
     f(s, x))
 
-val add = setElt("add", add)
-val remove = setElt("remove", remove)
-val contains = setElt("contains", contains)
+val add = setElt("UniverseTypeCheck.add", add)
+val remove = setElt("UniverseTypeCheck.remove", remove)
+val contains = setElt("UniverseTypeCheck.contains", contains)
 
 fun setSet (name, f) (s, s') =
     (Error.assert[(T.Set.areCompatible(typeOf s, typeOf s'),
-		  name ^ "incompatible sets")] ;
+                  name ^ "incompatible sets")] ;
      f(s, s'))
 
-val op - = setSet("difference", op -)
-val op + = setSet("union", op +)
-val intersect = setSet("intersect", intersect)
-val equals = setSet("=", op =)
-val op <= = setSet("<=", op <=)
-val op >= = setSet(">=", op >=)
-val op < = setSet("<", op <)
-val op > = setSet(">", op >)
+val op - = setSet("UniverseTypeCheck.difference", op -)
+val op + = setSet("UniverseTypeCheck.union", op +)
+val intersect = setSet("UniverseTypeCheck.intersect", intersect)
+val equals = setSet("UniverseTypeCheck.equals", op =)
+val op <= = setSet("UniverseTypeCheck.<=", op <=)
+val op >= = setSet("UniverseTypeCheck.>=", op >=)
+val op < = setSet("UniverseTypeCheck.<", op <)
+val op > = setSet("UniverseTypeCheck.>", op >)
 
 fun isReasonable s = (typeOf s ;
-		      true)
+                      true)
     handle T.Incompatible => false
-	
+        
 fun returnSet (name, f) a =
     let val s = f a
     in (Error.assert[(isReasonable s, name ^ ": invalid set")] ;
-	s)
+        s)
     end
     
-val replace = returnSet("replace", replace)
-val map = returnSet("map", map)
-val fromList = returnSet("fromList", fromList)
+val replace = returnSet("UniverseTypeCheck.replace", replace)
+val map = returnSet("UniverseTypeCheck.map", map)
+val fromList = returnSet("UniverseTypeCheck.fromList", fromList)
 
 fun lookup(s, x) =
     (case typeOf s of
-	 T.EmptySet => NONE
+         T.EmptySet => NONE
        | T.Set(T.Pair(x', _)) =>
-	     (T.Elt.combine(x', typeOfElt x) ;
-	      U.lookup(s, x))
-       | _ => Error.error "lookup")
-	 handle T.Incompatible => Error.error "lookup"
+             (T.Elt.combine(x', typeOfElt x) ;
+              U.lookup(s, x))
+       | _ => Error.error "UniverseTypeCheck.lookup")
+         handle T.Incompatible => Error.error "UniverseTypeCheck.lookup"
 
 fun update(s, x, y) =
     case typeOf s of
-	T.EmptySet => U.update(s, x, y)
+        T.EmptySet => U.update(s, x, y)
       | T.Set t =>
-	   (Error.assert[(T.Elt.areCompatible
-			 (t, T.Pair(typeOfElt x, typeOfElt y)),
-			 "update: incompatible pairs")] ;
-	    U.update(s, x, y))
-	   
-val updateSet = setSet("updateSet", updateSet)
+           (Error.assert[(T.Elt.areCompatible
+                         (t, T.Pair(typeOfElt x, typeOfElt y)),
+                         "update: incompatible pairs")] ;
+            U.update(s, x, y))
+           
+val updateSet = setSet("UniverseTypeCheck.updateSet", updateSet)
 
 end

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/set/universe.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/set/universe.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/set/universe.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature UNIVERSE =
    sig
       include SET
@@ -11,7 +12,7 @@
       structure B: T
 
       datatype elt =
-	 Base of B.t
+         Base of B.t
        | Pair of elt * elt
        | Set of t
       sharing type elt = E.t
@@ -23,10 +24,10 @@
       val cross: t * t -> t
       val project1: t -> t
       val project2: t -> t
-	 
+         
       val Union: t -> t
-   (*	val Cross: t -> t *)
-	 
+   (*   val Cross: t -> t *)
+         
       val lookup: t * E.t -> E.t option
       val update: t * E.t * E.t -> t
       val updateSet: t * t -> t

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/set/unordered-universe.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/set/unordered-universe.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/set/unordered-universe.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,8 +1,8 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 (*-------------------------------------------------------------------*)
 (*                             SetEqual                              *)
@@ -18,34 +18,34 @@
 structure Rep =
    struct
       datatype elt =
-	 Base of B.t
+         Base of B.t
        | Pair of elt * elt
        | Set of elt ListSet.t
 
       type t = elt
 
       fun makeEqual equalSet =
-	 let fun equalElt(Base b, Base b') = B.equals(b, b')
-	       | equalElt(Pair(x, y), Pair(x', y')) =
-		 equalElt(x, x') andalso equalElt(y, y')
-	       | equalElt(Set s, Set s') = equalSet(s, s')
-	       | equalElt _ = false
-	 in equalElt
-	 end
+         let fun equalElt(Base b, Base b') = B.equals(b, b')
+               | equalElt(Pair(x, y), Pair(x', y')) =
+                 equalElt(x, x') andalso equalElt(y, y')
+               | equalElt(Set s, Set s') = equalSet(s, s')
+               | equalElt _ = false
+         in equalElt
+         end
 
       fun makeOutput outputSet =
-	 let fun outputElt(Base b, out) = B.output(b, out)
-	       | outputElt(Pair(x, y), out) =
-		 let val print = O.outputc out
-		 in (print "(" ;
-		     outputElt(x, out) ;
-		     print ", " ;
-		     outputElt(y, out) ;
-		     print ")")
-		 end
-	       | outputElt(Set s, out) = outputSet(s, out)
-	 in outputElt
-	 end
+         let fun outputElt(Base b, out) = B.output(b, out)
+               | outputElt(Pair(x, y), out) =
+                 let val print = O.outputc out
+                 in (print "(" ;
+                     outputElt(x, out) ;
+                     print ", " ;
+                     outputElt(y, out) ;
+                     print ")")
+                 end
+               | outputElt(Set s, out) = outputSet(s, out)
+         in outputElt
+         end
    end
 
 structure S = UnorderedSetMain(Rep)
@@ -53,55 +53,55 @@
 open Rep S
 
 fun toBase(Base b) = b
-  | toBase _ = Error.error "toBase"
+  | toBase _ = Error.error "UnorderedUniverse.toBase"
 fun toPair(Pair p) = p
-  | toPair _ = Error.error "toPair"
+  | toPair _ = Error.error "UnorderedUniverse.toPair"
 fun toSet(Set s) = s
-  | toSet _ = Error.error "toSet"
+  | toSet _ = Error.error "UnorderedUniverse.toSet"
 
 fun cross(sx, sy) =
     let val ys = toList sy
     in fromList(L.foldl
-		(toList sx, [],
-		 fn (ps, x) => L.mapAppend(ys, fn y => Pair(x, y), ps)))
+                (toList sx, [],
+                 fn (ps, x) => L.mapAppend(ys, fn y => Pair(x, y), ps)))
     end
 
 fun project1 s = replace(s,
-			 fn Pair(x, _) => SOME x
-			  | _ => Error.error "project1")
+                         fn Pair(x, _) => SOME x
+                          | _ => Error.error "UnorderedUniverse.project1")
 fun project2 s = replace(s,
-			 fn Pair(_, y) => SOME y
-			  | _ => Error.error "project2")
+                         fn Pair(_, y) => SOME y
+                          | _ => Error.error "UnorderedUniverse.project2")
     
 fun update (c, x, y) =
     let fun update[] = [Pair(x, y)]
-	  | update((Pair(x', y')) :: ps) =
-	    if E.equals(x, x') then (Pair(x, y)) :: ps
-	    else (Pair(x', y')) :: (update ps)
-	  | update _ = Error.error "update"
+          | update((Pair(x', y')) :: ps) =
+            if E.equals(x, x') then (Pair(x, y)) :: ps
+            else (Pair(x', y')) :: (update ps)
+          | update _ = Error.error "UnorderedUniverse.update"
     in fromList(update(toList c))
     end
 
 fun updateSet(c, c') =
     L.foldl(toList c', c,
-	    fn (c, Pair(x, y)) => update(c, x, y)
-	     | _ => Error.error "updateSet")
+            fn (c, Pair(x, y)) => update(c, x, y)
+             | _ => Error.error "UnorderedUniverse.updateSet")
 
 fun lookup (c, x) =
     let fun lookup [] = NONE
-	  | lookup (Pair(x', y) :: ps) =
-	    if E.equals(x, x') then SOME y else lookup ps
-	  | lookup _ = Error.error "lookup"
+          | lookup (Pair(x', y) :: ps) =
+            if E.equals(x, x') then SOME y else lookup ps
+          | lookup _ = Error.error "UnorderedUniverse.lookup"
     in lookup(toList c)
     end
 
 fun Union s = L.foldl(toList s, empty,
-		      fn (s', Set s) => s + s'
-		       | _ => Error.error "Union")
-val Union = Trace.trace("Union", output, output) Union
+                      fn (s', Set s) => s + s'
+                       | _ => Error.error "UnorderedUniverse.Union")
+val Union = Trace.trace("UnorderedUniverse.Union", output, output) Union
 (*
 fun Cross s = listTo(L.map(L.cross(L.map(toList s,
-					 toList o Elt.toSet)),
-			    Set o listTo))
+                                         toList o Elt.toSet)),
+                            Set o listTo))
 *)
 end

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/set/unordered.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/set/unordered.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/set/unordered.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 functor UnorderedSet (Element: T):> SET where type Element.t = Element.t =
 struct
 
@@ -17,7 +18,7 @@
      add, remove, contains, areDisjoint, subset, subsetSize,
      map, replace, layout} =
    List.set{equals = Element.equals,
-	    layout = Element.layout}
+            layout = Element.layout}
 
 val partition = List.partition
 val power = List.power

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/sources.cm
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/sources.cm	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/sources.cm	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,13 @@
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 Library
 
-(* from sml-nj-lib *)
-functor SplayMapFn
-(* end from sml-nj-lib *)
-   
 (* from mlyacc-lib *)
 signature LR_TABLE
 signature TOKEN
@@ -68,7 +72,6 @@
 structure DisjointSet
 structure DotColor
 structure Dot
-structure DynamicWind
 structure Engine
 structure Error
 structure Escape
@@ -178,7 +181,7 @@
 functor PolyEnv
 functor Ring
 functor RingWithIdentity
-functor SplayMonoEnv
+(*functor SplayMonoEnv*)
 functor Sum
 functor Tree
 functor UniqueId
@@ -188,7 +191,6 @@
 is
 
 ../mlyacc/sources.cm
-../smlnj/sources.cm
 basic/sources.cm
 set/sources.cm
 env/sources.cm

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton/sources.mlb
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton/sources.mlb	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton/sources.mlb	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,139 +1,145 @@
+(* Copyright (C) 2004-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 ann "forceUsed" in
-local
-    basic/sources.mlb
-    set/sources.mlb
-    env/sources.mlb
-in
-    signature ARRAY
-    signature ENV
-    signature ERROR
-    signature EUCLIDEAN_RING
-    signature INTEGER
-    signature INT_INF
-    signature LIST
-    (*signature MONO_CONTAINER *)
-    signature MONO_ENV
-    signature OPTION
-    signature ORDER
-    signature ORDERED_RING
-    signature POLY_CACHE
-    signature PROMISE
-    signature REAL
-    signature RING
-    signature RING_WITH_IDENTITY
-    signature SET
-    signature STRING
-    signature T
-    signature UNIQUE_ID
+   local
+      basic/sources.mlb
+      set/sources.mlb
+      env/sources.mlb
+   in
+      signature ARRAY
+      signature ENV
+      signature ERROR
+      signature EUCLIDEAN_RING
+      signature INTEGER
+      signature INT_INF
+      signature LIST
+      (*signature MONO_CONTAINER *)
+      signature MONO_ENV
+      signature OPTION
+      signature ORDER
+      signature ORDERED_RING
+      signature POLY_CACHE
+      signature PROMISE
+      signature REAL
+      signature RING
+      signature RING_WITH_IDENTITY
+      signature SET
+      signature STRING
+      signature T
+      signature UNIQUE_ID
 
-    structure AppendList
-    structure Array
-    structure Array2
-    structure Assert
-    structure Base64
-    structure BinarySearch
-    structure Bool
-    structure Buffer
-    structure Char
-    structure CharArray
-    structure CharVector
-    structure ChoicePattern
-    structure ClearablePromise
-    structure CommandLine
-    structure Computation
-    structure Counter
-    structure Date
-    structure Dir
-    structure DirectedGraph
-    structure DisjointSet
-    structure DotColor
-    structure Dot
-    structure DynamicWind
-    structure Error
-    structure Escape
-    structure Exn
-    structure File
-    structure FileDesc
-    structure FixedPoint
-    structure Function
-    structure HashSet
-(*    structure Http *)
-    structure In
-    structure Int
-    structure Int32
-    structure IntInf
-    structure InsertionSort
-    structure Justify
-    structure LargeInt
-    structure LargeWord
-    structure Layout
-    structure List
-    (* structure MergeSortList *)
-    (* structure MergeSortVector *)
-    structure MLton
-    structure Option
-    structure OS
-    structure Out
-    structure Pervasive
-    structure Pid
-    structure PolyCache
-    structure Popt
-    structure Position
-    structure Power
-    structure Process
-    structure Promise
-    structure Property
-    structure PropertyList
-    structure Queue
-    structure QuickSort
-    structure Random
-    structure Real
-    structure RealVector
-    structure Real32
-    structure Real64
-    structure Ref
-    structure Regexp
-    structure Relation
-    structure Result
-    structure Sexp
-    structure Signal
-    structure SMLofNJ
-    structure Stream
-    structure String
-    structure StringCvt
-    structure Substring
-    structure SysWord
-    structure Time
-    structure Trace
-    structure Tree
-    structure TwoListQueue
-    structure Unit
-    structure Vector
-    structure Word
-    structure Word8
-    structure Word8Array
-    structure Word8Vector
-    structure Word32
+      structure AppendList
+      structure Array
+      structure Array2
+      structure Assert
+      structure Base64
+      structure BinarySearch
+      structure Bool
+      structure Buffer
+      structure Char
+      structure CharArray
+      structure CharVector
+      structure ChoicePattern
+      structure ClearablePromise
+      structure CommandLine
+      structure Computation
+      structure Counter
+      structure Date
+      structure Dir
+      structure DirectedGraph
+      structure DisjointSet
+      structure DotColor
+      structure Dot
+      structure Error
+      structure Escape
+      structure Exn
+      structure File
+      structure FileDesc
+      structure FixedPoint
+      structure Function
+      structure HashSet
+      (*    structure Http *)
+      structure In
+      structure Int
+      structure Int32
+      structure IntInf
+      structure InsertionSort
+      structure Justify
+      structure LargeInt
+      structure LargeWord
+      structure Layout
+      structure List
+      (* structure MergeSortList *)
+      (* structure MergeSortVector *)
+      structure MLton
+      structure Option
+      structure OS
+      structure Out
+      structure Pervasive
+      structure Pid
+      structure PolyCache
+      structure Popt
+      structure Position
+      structure Power
+      structure Process
+      structure Promise
+      structure Property
+      structure PropertyList
+      structure Queue
+      structure QuickSort
+      structure Random
+      structure Real
+      structure RealVector
+      structure Real32
+      structure Real64
+      structure Ref
+      structure Regexp
+      structure Relation
+      structure Result
+      structure Sexp
+      structure Signal
+      structure SMLofNJ
+      structure Stream
+      structure String
+      structure StringCvt
+      structure Substring
+      structure SysWord
+      structure Time
+      structure Trace
+      structure Tree
+      structure TwoListQueue
+      structure Unit
+      structure Vector
+      structure Word
+      structure Word8
+      structure Word8Array
+      structure Word8Vector
+      structure Word32
 
-    (* functor BinaryHeap *)
-    functor Control
-    functor Env
-    functor EuclideanRing
-    functor IntUniqueId
-    functor MakeMonoEnv
-    functor MonoArray
-    functor MonoEnv
-    functor MonoVector
-    functor OrderedField
-    functor OrderedUniqueSet
-    functor PolyEnv
-    functor Ring
-    functor RingWithIdentity
-    functor Tree
-    functor UniqueId
-    functor UniqueSet
-    functor UnorderedSet
-    
-    $(SML_LIB)/basis/pervasive.mlb
+      (* functor BinaryHeap *)
+      functor Control
+      functor Env
+      functor EuclideanRing
+      functor IntUniqueId
+      functor MakeMonoEnv
+      functor MonoArray
+      functor MonoEnv
+      functor MonoVector
+      functor OrderedField
+      functor OrderedUniqueSet
+      functor PolyEnv
+      functor Ring
+      functor RingWithIdentity
+      functor Tree
+      functor UniqueId
+      functor UniqueSet
+      functor UnorderedSet
+      
+      $(SML_LIB)/basis/pervasive.mlb
+   end
 end
-end

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/Makefile
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/Makefile	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/Makefile	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,11 @@
+## Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ #    Jagannathan, and Stephen Weeks.
+ # Copyright (C) 1997-2000 NEC Research Institute.
+ #
+ # MLton is released under a BSD-style license.
+ # See the file MLton-LICENSE for details.
+ ##
+
 all: links
 
 .PHONY: links

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/array.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/array.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/array.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,10 @@
+(* Copyright (C) 2002-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 type int = Int.int
    
 signature MLTON_ARRAY =

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/bin-io.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/bin-io.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/bin-io.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,10 @@
+(* Copyright (C) 2002-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 signature MLTON_BIN_IO =
    MLTON_IO
    where type instream = BinIO.instream

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/bin-io.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/bin-io.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/bin-io.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,10 @@
+(* Copyright (C) 2003-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 structure BinIO =
    struct
       type instream = unit
@@ -3,3 +10,3 @@
       type outstream = unit
    end
-	 
+         

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/call-stack.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/call-stack.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/call-stack.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,10 @@
+(* Copyright (C) 2004-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 signature MLTON_CALL_STACK =
    sig
       type t

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/cont.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/cont.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/cont.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,10 @@
+(* Copyright (C) 2002-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 signature MLTON_CONT =
    sig
       type 'a t

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/exn.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/exn.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/exn.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,10 @@
+(* Copyright (C) 2002-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 signature MLTON_EXN =
    sig
       val addExnMessager: (exn -> string option) -> unit

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/finalizable.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/finalizable.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/finalizable.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,10 @@
+(* Copyright (C) 2003-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 signature MLTON_FINALIZABLE =
    sig
       type 'a t

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/gc.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/gc.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/gc.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,11 @@
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 signature MLTON_GC =
    sig
       val collect: unit -> unit

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/int-inf.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/int-inf.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/int-inf.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,10 @@
+(* Copyright (C) 2002-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 type int = Int.int
 type word = Word.word
    
@@ -9,7 +16,7 @@
       val gcd: t * t -> t
       val isSmall: t -> bool
       datatype rep =
-	 Big of word vector
+         Big of word vector
        | Small of int
       val rep: t -> rep
    end

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/io.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/io.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/io.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,10 @@
+(* Copyright (C) 2002-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 signature MLTON_IO_ARG =
    sig
       type instream
@@ -2,3 +9,3 @@
       type outstream
-	 
+         
       val inFd: instream -> Posix.IO.file_desc

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/itimer.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/itimer.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/itimer.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,7 +1,15 @@
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 signature MLTON_ITIMER =
    sig
       datatype t =
-	 Prof
+         Prof
        | Real
        | Virtual
 

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/mlton.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/mlton.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/mlton.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,14 +1,15 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 signature MLTON =
    sig
 (*      val cleanAtExit: unit -> unit *)
+      val debug: bool
 (*      val deserialize: Word8Vector.vector -> 'a *)
       (* Pointer equality.  The usual caveats about lack of a well-defined
        * semantics.

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/mlton.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/mlton.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/mlton.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,25 +1,25 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 functor IO (S : sig
-		   type instream
-		   type outstream
-		   val openOut: string -> outstream
-		end) =
+                   type instream
+                   type outstream
+                   val openOut: string -> outstream
+                end) =
    struct
       open S
 
       fun inFd _ = raise Fail "inFd"
       fun mkstemps {prefix, suffix} =
-	 let
-	    val name = concat [prefix, Random.alphaNumString 6, suffix]
-	 in (name, openOut name)
-	 end
+         let
+            val name = concat [prefix, Random.alphaNumString 6, suffix]
+         in (name, openOut name)
+         end
       fun mkstemp s = mkstemps {prefix = s, suffix = ""}
       fun newIn _ = raise Fail "newIn"
       fun newOut _ = raise Fail "newOut"
@@ -34,10 +34,11 @@
    struct
       type int = Int.int
       type word = Word.word
-	 
+         
       type pointer = Word32.word
-	 
+         
       val cleanAtExit = fn _ => raise Fail "cleanAtExit"
+      val debug = false
       val deserialize = fn _ => raise Fail "deserialize"
       val eq = fn _ => false
       val errno = fn _ => raise Fail "errno"
@@ -52,134 +53,134 @@
       val size = fn _ => ~1: int
 
       structure Array =
-	 struct
-	    open Array
+         struct
+            open Array
 
-	    fun unfoldi (n, a, f) =
-	       let
-		  val r = ref a
-	       in
-		  tabulate (n, fn i =>
-			    let
-			       val (b, a') = f (i, !r)
-			       val _ = r := a'
-			    in
-			       b
-			    end)
-	       end
-	 end
+            fun unfoldi (n, a, f) =
+               let
+                  val r = ref a
+               in
+                  tabulate (n, fn i =>
+                            let
+                               val (b, a') = f (i, !r)
+                               val _ = r := a'
+                            in
+                               b
+                            end)
+               end
+         end
       
       structure BinIO =
-	 struct
-	    type instream = unit
-	    type outstream = unit
+         struct
+            type instream = unit
+            type outstream = unit
 
-	    fun inFd _ = raise Fail "inFd"
-	    fun mkstemps _ = raise Fail "mkstemps"
-	    fun mkstemp _ = raise Fail "mkstemp"
-	    fun newIn _ = raise Fail "newIn"
-	    fun newOut _ = raise Fail "newOut"
-	    fun outFd _ = raise Fail "outFd"
-	    fun setIn _ = raise Fail "setIn"
-	 end
+            fun inFd _ = raise Fail "inFd"
+            fun mkstemps _ = raise Fail "mkstemps"
+            fun mkstemp _ = raise Fail "mkstemp"
+            fun newIn _ = raise Fail "newIn"
+            fun newOut _ = raise Fail "newOut"
+            fun outFd _ = raise Fail "outFd"
+            fun setIn _ = raise Fail "setIn"
+         end
 
       structure CallStack =
-	 struct
-	    type t = unit
+         struct
+            type t = unit
 
-	    val keep = false
-	    fun current () = ()
-	    fun toStrings () = []
-	 end
+            val keep = false
+            fun current () = ()
+            fun toStrings () = []
+         end
 
       structure Cont =
-	 struct
-	    type 'a t = unit
+         struct
+            type 'a t = unit
 
-	    val callcc = fn _ => raise Fail "Cont.callcc"
-	    val prepend = fn _ => raise Fail "Cont.prepend"
-	    val throw = fn _ => raise Fail "Cont.throw"
-	    val throw' = fn _ => raise Fail "Cont.throw'"
-	 end
+            val callcc = fn _ => raise Fail "Cont.callcc"
+            val prepend = fn _ => raise Fail "Cont.prepend"
+            val throw = fn _ => raise Fail "Cont.throw"
+            val throw' = fn _ => raise Fail "Cont.throw'"
+         end
 
       structure Exn =
-	 struct
-	    val history = fn _ => []
+         struct
+            val history = fn _ => []
 
-	    val addExnMessager = fn _ => raise Fail "Exn.addExnMessager"
-	    val topLevelHandler = fn _ => raise Fail "Exn.topLevelHandler"
-	 end
+            val addExnMessager = fn _ => raise Fail "Exn.addExnMessager"
+            val topLevelHandler = fn _ => raise Fail "Exn.topLevelHandler"
+         end
 
       structure FFI =
-	 struct
-	    val handleCallFromC = fn _ => raise Fail "FFI.handleCallFromC"
-	 end
+         struct
+            val handleCallFromC = fn _ => raise Fail "FFI.handleCallFromC"
+         end
 
       structure Finalizable =
-	 struct
-	    type 'a t = 'a
+         struct
+            type 'a t = 'a
 
-	    fun addFinalizer _ = ()
-	    fun finalizeBefore _ = ()
-	    fun new x = x
-	    fun touch _ = ()
-	    fun withValue (x, f) = f x
-	 end
+            fun addFinalizer _ = ()
+            fun finalizeBefore _ = ()
+            fun new x = x
+            fun touch _ = ()
+            fun withValue (x, f) = f x
+         end
       
       structure GC =
-	 struct
-	    fun collect _ = ()
-	    val pack = MLton.GC.pack
-	    fun setMessages _ = ()
-	    fun setSummary _ = ()
-	    fun time _ = Time.zeroTime
-	    fun unpack _ = ()
-	 end
+         struct
+            fun collect _ = ()
+            val pack = MLton.GC.pack
+            fun setMessages _ = ()
+            fun setSummary _ = ()
+            fun time _ = Time.zeroTime
+            fun unpack _ = ()
+         end
 
       structure IntInf =
-	 struct
-	    open IntInf
-	       
-	    type t = IntInf.int
+         struct
+            open IntInf
+               
+            type t = IntInf.int
 
-	    datatype rep =
-	       Big of Word.word Vector.vector
-	     | Small of Int.int
+            datatype rep =
+               Big of Word.word Vector.vector
+             | Small of Int.int
 
-	    val areSmall =
-	       fn _ => raise Fail "MLton.IntInf.areSmall unimplemented"
-	    val gcd = fn _ => raise Fail "MLton.IntInf.gcd unimplemented"
-	    val isSmall = fn _ => raise Fail "MLton.IntInf.isSmall unimplemented"
-	    val rep = fn _ => raise Fail "MLton.IntInf.rep unimplemented"
-	    val size = fn _ => raise Fail "MLton.IntInf.size unimplemented"
-	 end
+            val areSmall =
+               fn _ => raise Fail "MLton.IntInf.areSmall unimplemented"
+            val gcd = fn _ => raise Fail "MLton.IntInf.gcd unimplemented"
+            val isSmall = fn _ => raise Fail "MLton.IntInf.isSmall unimplemented"
+            val rep = fn _ => raise Fail "MLton.IntInf.rep unimplemented"
+            val size = fn _ => raise Fail "MLton.IntInf.size unimplemented"
+         end
 
       structure Itimer =
-	 struct
-	    datatype t = Prof | Real | Virtual
+         struct
+            datatype t = Prof | Real | Virtual
 
-	    fun signal _ = Posix.Signal.alrm
-	    fun set _ = raise Fail "Itimer.set"
-	 end
+            fun signal _ = Posix.Signal.alrm
+            fun set _ = raise Fail "Itimer.set"
+         end
 
       structure Platform =
-	 struct
-	    fun peek (l, f) = List.find f l
-	    fun omap (opt, f) = Option.map f opt
+         struct
+            fun peek (l, f) = List.find f l
+            fun omap (opt, f) = Option.map f opt
 
-	    structure String =
-	       struct
-		  open String
+            structure String =
+               struct
+                  open String
 
-		  val toLower = translate (str o Char.toLower)
-	       end
-	 
-	    structure Arch =
-	       struct
+                  val toLower = translate (str o Char.toLower)
+               end
+         
+            structure Arch =
+               struct
                   datatype t = Alpha | AMD64 | ARM | HPPA | IA64 | m68k |
                                MIPS | PowerPC | S390 | Sparc | X86
 
-		  val host: t = X86
+                  val host: t = X86
 
                   val all = [(Alpha, "Alpha"),
                              (AMD64, "AMD64"),
@@ -193,94 +194,95 @@
                              (Sparc, "Sparc"), 
                              (X86, "X86")]
 
-		  fun fromString s =
-		     let
-			val s = String.toLower s
-		     in
-			omap (peek (all, fn (_, s') => s = String.toLower s'),
-			      #1)
-		     end
+                  fun fromString s =
+                     let
+                        val s = String.toLower s
+                     in
+                        omap (peek (all, fn (_, s') => s = String.toLower s'),
+                              #1)
+                     end
 
-		  fun toString a = #2 (valOf (peek (all, fn (a', _) => a = a')))
-	       end
+                  fun toString a = #2 (valOf (peek (all, fn (a', _) => a = a')))
+               end
 
-	    structure OS =
-	       struct
-		  datatype t =
-		     Cygwin
-		   | Darwin
-		   | FreeBSD
-		   | Linux
-		   | MinGW
-		   | NetBSD
-		   | OpenBSD
-		   | Solaris
+            structure OS =
+               struct
+                  datatype t =
+                     Cygwin
+                   | Darwin
+                   | FreeBSD
+                   | Linux
+                   | MinGW
+                   | NetBSD
+                   | OpenBSD
+                   | Solaris
 
-		  val host: t = Linux
+                  val host: t = Linux
 
-		  val all = [(Cygwin, "Cygwin"),
-			     (Darwin, "Darwin"),
-			     (FreeBSD, "FreeBSD"),
-			     (Linux, "Linux"),
-			     (MinGW, "MinGW"),
-			     (NetBSD, "NetBSD"),
-			     (OpenBSD, "OpenBSD"),
-			     (Solaris, "Solaris")]
-	       
-		  fun fromString s =
-		     let
-			val s = String.toLower s
-		     in
-			omap (peek (all, fn (_, s') => s = String.toLower s'),
-			      #1)
-		     end
+                  val all = [(Cygwin, "Cygwin"),
+                             (Darwin, "Darwin"),
+                             (FreeBSD, "FreeBSD"),
+                             (Linux, "Linux"),
+                             (MinGW, "MinGW"),
+                             (NetBSD, "NetBSD"),
+                             (OpenBSD, "OpenBSD"),
+                             (Solaris, "Solaris")]
+               
+                  fun fromString s =
+                     let
+                        val s = String.toLower s
+                     in
+                        omap (peek (all, fn (_, s') => s = String.toLower s'),
+                              #1)
+                     end
 
-		  fun toString a = #2 (valOf (peek (all, fn (a', _) => a = a')))
-	       end
-	 end
+                  fun toString a = #2 (valOf (peek (all, fn (a', _) => a = a')))
+               end
+         end
 
       structure Pointer =
-	 struct
-	    type t = unit
-	       
-	    val add = fn _ => raise Fail "Pointer.add"
-	    val compare = fn _ => raise Fail "Pointer.compare"
-	    val diff = fn _ => raise Fail "Pointer.diff"
-	    val free = fn _ => raise Fail "Pointer.free"
-	    val getInt8 = fn _ => raise Fail "Pointer.getInt8"
-	    val getInt16 = fn _ => raise Fail "Pointer.getInt16"
-	    val getInt32 = fn _ => raise Fail "Pointer.getInt32"
-	    val getInt64 = fn _ => raise Fail "Pointer.getInt64"
-	    val getPointer = fn _ => raise Fail "Pointer.getPointer"
-	    val getReal32 = fn _ => raise Fail "Pointer.getReal32"
-	    val getReal64 = fn _ => raise Fail "Pointer.getReal64"
-	    val getWord8 = fn _ => raise Fail "Pointer.getWord8"
-	    val getWord16 = fn _ => raise Fail "Pointer.getWord16"
-	    val getWord32 = fn _ => raise Fail "Pointer.getWord32"
-	    val getWord64 = fn _ => raise Fail "Pointer.getWord64"
-	    val isNull = fn _ => raise Fail "Pointer.isNull"
-	    val null = ()
-	    val setInt8 = fn _ => raise Fail "Pointer.setInt8"
-	    val setInt16 = fn _ => raise Fail "Pointer.setInt16"
-	    val setInt32 = fn _ => raise Fail "Pointer.setInt32"
-	    val setInt64 = fn _ => raise Fail "Pointer.setInt64"
-	    val setPointer = fn _ => raise Fail "Pointer.setPointer"
-	    val setReal32 = fn _ => raise Fail "Pointer.setReal32"
-	    val setReal64 = fn _ => raise Fail "Pointer.setReal64"
-	    val setWord8 = fn _ => raise Fail "Pointer.setWord8"
-	    val setWord16 = fn _ => raise Fail "Pointer.setWord16"
-	    val setWord32 = fn _ => raise Fail "Pointer.setWord32"
-	    val setWord64 = fn _ => raise Fail "Pointer.setWord64"
-	    val sub = fn _ => raise Fail "Pointer.sub"
-	 end
+         struct
+            type t = unit
+               
+            val add = fn _ => raise Fail "Pointer.add"
+            val compare = fn _ => raise Fail "Pointer.compare"
+            val diff = fn _ => raise Fail "Pointer.diff"
+            val free = fn _ => raise Fail "Pointer.free"
+            val getInt8 = fn _ => raise Fail "Pointer.getInt8"
+            val getInt16 = fn _ => raise Fail "Pointer.getInt16"
+            val getInt32 = fn _ => raise Fail "Pointer.getInt32"
+            val getInt64 = fn _ => raise Fail "Pointer.getInt64"
+            val getPointer = fn _ => raise Fail "Pointer.getPointer"
+            val getReal32 = fn _ => raise Fail "Pointer.getReal32"
+            val getReal64 = fn _ => raise Fail "Pointer.getReal64"
+            val getWord8 = fn _ => raise Fail "Pointer.getWord8"
+            val getWord16 = fn _ => raise Fail "Pointer.getWord16"
+            val getWord32 = fn _ => raise Fail "Pointer.getWord32"
+            val getWord64 = fn _ => raise Fail "Pointer.getWord64"
+            val isNull = fn _ => raise Fail "Pointer.isNull"
+            val null = ()
+            val setInt8 = fn _ => raise Fail "Pointer.setInt8"
+            val setInt16 = fn _ => raise Fail "Pointer.setInt16"
+            val setInt32 = fn _ => raise Fail "Pointer.setInt32"
+            val setInt64 = fn _ => raise Fail "Pointer.setInt64"
+            val setPointer = fn _ => raise Fail "Pointer.setPointer"
+            val setReal32 = fn _ => raise Fail "Pointer.setReal32"
+            val setReal64 = fn _ => raise Fail "Pointer.setReal64"
+            val setWord8 = fn _ => raise Fail "Pointer.setWord8"
+            val setWord16 = fn _ => raise Fail "Pointer.setWord16"
+            val setWord32 = fn _ => raise Fail "Pointer.setWord32"
+            val setWord64 = fn _ => raise Fail "Pointer.setWord64"
+            val sub = fn _ => raise Fail "Pointer.sub"
+         end
 
       structure ProcEnv =
-	 struct
-	    fun setenv _ = raise Fail "setenv"
-	 end
+         struct
+            fun setenv _ = raise Fail "setenv"
+            fun setgroups _ = raise Fail "setgroups"
+         end
 
       structure Process =
-	 struct
+         struct
             type ('stdin, 'stdout, 'stderr) t = unit
             type input = unit
             type output = unit
@@ -292,29 +294,29 @@
             exception DoublyRedirected
             
             structure Child =
-	       struct
-		  type ('use, 'dir) t = unit
+               struct
+                  type ('use, 'dir) t = unit
 
-		  val binIn = fn _ => raise Fail "Child.binIn"
-		  val binOut = fn _ => raise Fail "Child.binOut"
-		  val fd = fn _ => raise Fail "Child.fd"
-		  val remember = fn _ => raise Fail "Child.remember"
-		  val textIn = fn _ => raise Fail "Child.textIn"
-		  val textOut = fn _ => raise Fail "Child.textOut"
-	       end
+                  val binIn = fn _ => raise Fail "Child.binIn"
+                  val binOut = fn _ => raise Fail "Child.binOut"
+                  val fd = fn _ => raise Fail "Child.fd"
+                  val remember = fn _ => raise Fail "Child.remember"
+                  val textIn = fn _ => raise Fail "Child.textIn"
+                  val textOut = fn _ => raise Fail "Child.textOut"
+               end
             
             structure Param =
-	       struct
-		  type ('use, 'dir) t = unit
+               struct
+                  type ('use, 'dir) t = unit
 
-		  val child = fn _ => raise Fail "Param.child"
-		  val fd = fn _ => raise Fail "Param.fd"
-		  val file = fn _ => raise Fail "Param.file"
-		  val forget = fn _ => raise Fail "Param.forget"
-		  val null = ()
-		  val pipe = ()
-		  val self = ()
-	       end
+                  val child = fn _ => raise Fail "Param.child"
+                  val fd = fn _ => raise Fail "Param.fd"
+                  val file = fn _ => raise Fail "Param.file"
+                  val forget = fn _ => raise Fail "Param.forget"
+                  val null = ()
+                  val pipe = ()
+                  val self = ()
+               end
             
             val create = fn _ => raise Fail "Process.create"
             val getStderr = fn _ => raise Fail "Process.getStderr"
@@ -323,330 +325,338 @@
             val kill = fn _ => raise Fail "Process.kill"
             val reap = fn _ => raise Fail "Process.reap"
 
-	    type pid = Posix.Process.pid
+            type pid = Posix.Process.pid
 
-	    val atExit = OS.Process.atExit
-	       
-	    fun exit n =
-	       let
-		  open OS.Process
-	       in
-		  exit (if n = 0 then success else failure)
-	       end
-	       
-	    fun spawne {path, args, env} =
-	       case Posix.Process.fork () of
-		  NONE => Posix.Process.exece (path, args, env)
-		| SOME pid => pid
+            val atExit = OS.Process.atExit
+               
+            fun exit n =
+               let
+                  open OS.Process
+               in
+                  exit (if n = 0 then success else failure)
+               end
+               
+            fun spawne {path, args, env} =
+               case Posix.Process.fork () of
+                  NONE => Posix.Process.exece (path, args, env)
+                | SOME pid => pid
 
-	    fun spawn {path, args} =
-	       spawne {path = path, args = args, env = Posix.ProcEnv.environ ()}
+            fun spawn {path, args} =
+               spawne {path = path, args = args, env = Posix.ProcEnv.environ ()}
 
-	    fun spawnp {file, args} =
-	       case Posix.Process.fork () of
-		  NONE => Posix.Process.execp (file, args)
-		| SOME pid => pid
-	 end
+            fun spawnp {file, args} =
+               case Posix.Process.fork () of
+                  NONE => Posix.Process.execp (file, args)
+                | SOME pid => pid
+         end
       
       structure Profile =
-	 struct
-	    val profile = false
+         struct
+            val profile = false
 
-	    structure Data =
-	       struct
-		  type t = unit
+            structure Data =
+               struct
+                  type t = unit
 
-		  val equals = fn _ => raise Fail "Profile.Data.equals"
-		  val free = fn _ => raise Fail "Profile.Data.free"
-		  val malloc = fn _ => raise Fail "Profile.Data.malloc"
-		  val write = fn _ => raise Fail "Profile.Data.write"
-	       end
-	    val isOn = false
-	    val withData = fn _ => raise Fail "Profile.withData"
-	 end
+                  val equals = fn _ => raise Fail "Profile.Data.equals"
+                  val free = fn _ => raise Fail "Profile.Data.free"
+                  val malloc = fn _ => raise Fail "Profile.Data.malloc"
+                  val write = fn _ => raise Fail "Profile.Data.write"
+               end
+            val isOn = false
+            val withData = fn _ => raise Fail "Profile.withData"
+         end
       
       structure Ptrace =
-	 struct
-	    type pid = Posix.Process.pid
-	    fun attach _ = raise Fail "attach"
-	    fun cont _ = raise Fail "cont"
-	    fun detach _ = raise Fail "detach"
-	    fun kill _ = raise Fail "kill"
-	    fun peekText _ = raise Fail "peekText"
-	    fun singleStep _ = raise Fail "singleStep"
-	    fun sysCall _ = raise Fail "sysCall"
-	 end
+         struct
+            type pid = Posix.Process.pid
+            fun attach _ = raise Fail "attach"
+            fun cont _ = raise Fail "cont"
+            fun detach _ = raise Fail "detach"
+            fun kill _ = raise Fail "kill"
+            fun peekText _ = raise Fail "peekText"
+            fun singleStep _ = raise Fail "singleStep"
+            fun sysCall _ = raise Fail "sysCall"
+         end
 
       structure Random = Random
 
       structure Rlimit =
-	 struct
-	    type rlim = Word.word
+         struct
+            type rlim = Word.word
 
-	    val infinity: rlim = 0w0
+            val infinity: rlim = 0w0
 
-	    type t = int
-	       
-	    val cpuTime: t = 0
-	    val coreFileSize: t = 0
-	    val dataSize: t = 0
-	    val fileSize: t = 0
-	    val lockedInMemorySize: t = 0
-	    val numFiles: t = 0
-	    val numProcesses: t = 0
-	    val residentSetSize: t = 0
-	    val stackSize: t = 0
-	    val virtualMemorySize: t = 0
+            type t = int
+               
+            val cpuTime: t = 0
+            val coreFileSize: t = 0
+            val dataSize: t = 0
+            val fileSize: t = 0
+            val lockedInMemorySize: t = 0
+            val numFiles: t = 0
+            val numProcesses: t = 0
+            val residentSetSize: t = 0
+            val stackSize: t = 0
+            val virtualMemorySize: t = 0
 
-	    fun get _ = raise Fail "Rlimit.get"
-	    fun set _ = raise Fail "Rlimit.set"
-	 end
+            fun get _ = raise Fail "Rlimit.get"
+            fun set _ = raise Fail "Rlimit.set"
+         end
       
       structure Rusage =
          struct
-	   type t = {stime: Time.time, utime: Time.time}
+           type t = {stime: Time.time, utime: Time.time}
 
-	   (* Fake it with Posix.ProcEnv.times *)
-	   fun rusage () =
-	      let
-		 val zero = {utime = Time.zeroTime, stime = Time.zeroTime}
-	      in
-		 let
-		    val {utime, stime, cutime, cstime, ...} =
-		       Posix.ProcEnv.times ()
-		 in
-		    {self = {utime = utime, stime = stime},
-		     children = {utime = cutime, stime = cstime},
-		     gc = zero}
-		 end handle Time => {children = zero, gc = zero, self = zero}
-		 (* The handle Time is there because of a bug in SML/NJ that
-		  * causes a Time exception to be raised on machines with a
-		  * large uptime (enough that the number of clock ticks is
-		  * >= 2^31).
-		  *)
-	      end
-	 end
+           fun measureGC _ = ()
 
+           (* Fake it with Posix.ProcEnv.times *)
+           fun rusage () =
+              let
+                 val zero = {utime = Time.zeroTime, stime = Time.zeroTime}
+              in
+                 let
+                    val {utime, stime, cutime, cstime, ...} =
+                       Posix.ProcEnv.times ()
+                 in
+                    {self = {utime = utime, stime = stime},
+                     children = {utime = cutime, stime = cstime},
+                     gc = zero}
+                 end handle Time => {children = zero, gc = zero, self = zero}
+                 (* The handle Time is there because of a bug in SML/NJ that
+                  * causes a Time exception to be raised on machines with a
+                  * large uptime (enough that the number of clock ticks is
+                  * >= 2^31).
+                  *)
+              end
+         end
+
       structure Signal =
-	 struct
-	    open Posix.Signal
+         struct
+            open Posix.Signal
 
-	    type t = signal
+            type t = signal
 
-	    val prof = alrm
-	    val vtalrm = alrm
+            val prof = alrm
+            val vtalrm = alrm
 
-	    structure Handler =
-	       struct
-		  type t = unit
+            structure Handler =
+               struct
+                  type t = unit
 
-		  val default = ()
-		  val handler = fn _ => ()
-		  val ignore = ()
-		  val isDefault = fn _ => raise Fail "isDefault"
-		  val isIgnore = fn _ => raise Fail "isIgnore"
-		  fun simple _ = ()
-	       end
+                  val default = ()
+                  val handler = fn _ => ()
+                  val ignore = ()
+                  val isDefault = fn _ => raise Fail "isDefault"
+                  val isIgnore = fn _ => raise Fail "isIgnore"
+                  fun simple _ = ()
+               end
 
-	    structure Mask =
-	       struct
-		  type t = unit
+            structure Mask =
+               struct
+                  type t = unit
 
-		  val all = ()
-		  fun allBut _ = ()
-		  fun block _ = raise Fail "block"
-		  fun getBlocked _ = ()
-		  fun isMember _ = raise Fail "isMember"
-		  val none = ()
-		  fun setBlocked _ = raise Fail "setBlocked"
-		  fun some _ = ()
-		  fun unblock _ = raise Fail "unblock"
-	       end
+                  val all = ()
+                  fun allBut _ = ()
+                  fun block _ = raise Fail "block"
+                  fun getBlocked _ = ()
+                  fun isMember _ = raise Fail "isMember"
+                  val none = ()
+                  fun setBlocked _ = raise Fail "setBlocked"
+                  fun some _ = ()
+                  fun unblock _ = raise Fail "unblock"
+               end
 
-	    fun getHandler _ = raise Fail "getHandler"
-	    fun handled _ = raise Fail "handled"
-	    val restart = ref true
-	    fun setHandler _ = raise Fail "setHandler"
-	    fun suspend _ = raise Fail "suspend"
-	 end
+            fun getHandler _ = raise Fail "getHandler"
+            fun handled _ = raise Fail "handled"
+            val restart = ref true
+            fun setHandler _ = raise Fail "setHandler"
+            fun suspend _ = raise Fail "suspend"
+         end
 
       structure Socket =
-	 struct
-	    structure Address =
-	       struct
-		  type t = word
-	       end
+         struct
+            structure Address =
+               struct
+                  type t = word
+               end
 
-	    structure Host =
-	       struct
-		  type t = {name: string}
+            structure Ctl =
+               struct
+                  fun getERROR _ = NONE
+               end
 
-		  fun getByAddress _ = raise Fail "Socket.Host.getByAddress"
-		  fun getByName _ = raise Fail "Socket.Host.getByName"
-	       end
+            structure Host =
+               struct
+                  type t = {name: string}
 
-	    structure Port =
-	       struct
-		  type t = int
-	       end
+                  fun getByAddress _ = raise Fail "Socket.Host.getByAddress"
+                  fun getByName _ = raise Fail "Socket.Host.getByName"
+               end
 
-	    type t = unit
-	       
-	    fun accept _ = raise Fail "Socket.accept"
-	    fun connect _ = raise Fail "Socket.connect"
-	    fun listen _ = raise Fail "Socket.listen"
-	    fun listenAt _ = raise Fail "Socket.listenAt"
-	    fun shutdownRead _ = raise Fail "Socket.shutdownWrite"
-	    fun shutdownWrite _ = raise Fail "Socket.shutdownWrite"
-	 end
+            structure Port =
+               struct
+                  type t = int
+               end
 
+            type t = unit
+               
+            fun accept _ = raise Fail "Socket.accept"
+            fun connect _ = raise Fail "Socket.connect"
+            fun fdToSock _ = raise Fail "Socket.fdToSock"
+            fun listen _ = raise Fail "Socket.listen"
+            fun listenAt _ = raise Fail "Socket.listenAt"
+            fun shutdownRead _ = raise Fail "Socket.shutdownWrite"
+            fun shutdownWrite _ = raise Fail "Socket.shutdownWrite"
+         end
+
       (* From Tom 7 <twm@andrew.cmu.edu>. *)
       (* Implementation of Syslog which doesn't log anything. *)
     
       structure Syslog =
-	 struct
+         struct
 
-	    type openflag = unit
-	       
-	    val CONS = ()
-	    val NDELAY = ()
-	    val PERROR = ()
-	    val PID = ()
+            type openflag = unit
+               
+            val CONS = ()
+            val NDELAY = ()
+            val PERROR = ()
+            val PID = ()
 
-	    type facility = unit
+            type facility = unit
 
-	    val AUTHPRIV = ()
-	    val CRON = ()
-	    val DAEMON = ()
-	    val KERN = ()
-	    val LOCAL0 = ()
-	    val LOCAL1 = ()
-	    val LOCAL2 = ()
-	    val LOCAL3 = ()
-	    val LOCAL4 = ()
-	    val LOCAL5 = ()
-	    val LOCAL6 = ()
-	    val LOCAL7 = ()
-	    val LPR = ()
-	    val MAIL = ()
-	    val NEWS = ()
-	    val SYSLOG = ()
-	    val USER = ()
-	    val UUCP = ()
+            val AUTHPRIV = ()
+            val CRON = ()
+            val DAEMON = ()
+            val KERN = ()
+            val LOCAL0 = ()
+            val LOCAL1 = ()
+            val LOCAL2 = ()
+            val LOCAL3 = ()
+            val LOCAL4 = ()
+            val LOCAL5 = ()
+            val LOCAL6 = ()
+            val LOCAL7 = ()
+            val LPR = ()
+            val MAIL = ()
+            val NEWS = ()
+            val SYSLOG = ()
+            val USER = ()
+            val UUCP = ()
 
-	    type loglevel = unit
+            type loglevel = unit
 
-	    val EMERG = ()
-	    val ALERT = ()
-	    val CRIT = ()
-	    val ERR = ()
-	    val WARNING = ()
-	    val NOTICE = ()
-	    val INFO = ()
-	    val DEBUG = ()
+            val EMERG = ()
+            val ALERT = ()
+            val CRIT = ()
+            val ERR = ()
+            val WARNING = ()
+            val NOTICE = ()
+            val INFO = ()
+            val DEBUG = ()
 
-	    val closelog = fn _ => raise Fail "Syslog.closelog"
-	    val log = fn _ => raise Fail "Syslog.log"
-	    val openlog = fn _ => raise Fail "Syslog.openlog"
-	 end
+            val closelog = fn _ => raise Fail "Syslog.closelog"
+            val log = fn _ => raise Fail "Syslog.log"
+            val openlog = fn _ => raise Fail "Syslog.openlog"
+         end
 
       structure TextIO = IO (TextIO)
 
       structure Thread = MLtonThread
 
       structure Vector =
-	 struct
-	    open Vector
+         struct
+            open Vector
 
-	    fun unfoldi (n, a, f) =
-	       let
-		  val r = ref a
-	       in
-		  tabulate (n, fn i =>
-			    let
-			       val (b, a') = f (i, !r)
-			       val _ = r := a'
-			    in
-			       b
-			    end)
-	       end
-	 end
+            fun unfoldi (n, a, f) =
+               let
+                  val r = ref a
+               in
+                  tabulate (n, fn i =>
+                            let
+                               val (b, a') = f (i, !r)
+                               val _ = r := a'
+                            in
+                               b
+                            end)
+               end
+         end
 
       structure Weak =
-	 struct
-	    type 'a t = 'a
+         struct
+            type 'a t = 'a
 
-	    val get = SOME
-	    fun new x = x
-	 end
+            val get = SOME
+            fun new x = x
+         end
 
       structure World =
-	 struct
-	    datatype status = Original | Clone
+         struct
+            datatype status = Original | Clone
 
-	    fun load _ = raise Fail "World.load"
-	    fun save _ = raise Fail "World.save"
-	    fun saveThread _ = raise Fail "World.saveThread"
-	 end
+            fun load _ = raise Fail "World.load"
+            fun save _ = raise Fail "World.save"
+            fun saveThread _ = raise Fail "World.saveThread"
+         end
 
       structure Word =
-	 struct
-	    open Word
+         struct
+            open Word
 
-	    type t = word
+            type t = word
 
-	    fun rol (w, w') =
-	       let
-		  val w' = w' mod (fromInt wordSize)
-	       in
-		  orb (>> (w, fromInt wordSize - w'),
-		       << (w, w'))
-	       end
-	    fun ror (w, w') =
-	       let
-		  val w' = w' mod (fromInt wordSize)
-	       in
-		  orb (>> (w, w'),
-		       << (w, fromInt wordSize - w'))
-	       end
-	    local
-	       val max =    Word.toLargeInt 0wxFFFFFFFF
-	       val maxInt = Word.toLargeInt 0wx7FFFFFFF
-	       fun make (f: IntInf.int * IntInf.int -> IntInf.int)
-		  (w: word, w': word): word =
-		  let
-		     val res = f (Word.toLargeInt w, Word.toLargeInt w')
-		  in
-		     if IntInf.> (res, max)
-			then raise Overflow
-		     else Word.fromLargeInt res
-		  end
-	    in
-	       val addCheck = make IntInf.+
-	       val mulCheck = make IntInf.*
-	    end
-	 end
+            fun rol (w, w') =
+               let
+                  val w' = w' mod (fromInt wordSize)
+               in
+                  orb (>> (w, fromInt wordSize - w'),
+                       << (w, w'))
+               end
+            fun ror (w, w') =
+               let
+                  val w' = w' mod (fromInt wordSize)
+               in
+                  orb (>> (w, w'),
+                       << (w, fromInt wordSize - w'))
+               end
+            local
+               val max =    Word.toLargeInt 0wxFFFFFFFF
+               val maxInt = Word.toLargeInt 0wx7FFFFFFF
+               fun make (f: IntInf.int * IntInf.int -> IntInf.int)
+                  (w: word, w': word): word =
+                  let
+                     val res = f (Word.toLargeInt w, Word.toLargeInt w')
+                  in
+                     if IntInf.> (res, max)
+                        then raise Overflow
+                     else Word.fromLargeInt res
+                  end
+            in
+               val addCheck = make IntInf.+
+               val mulCheck = make IntInf.*
+            end
+         end
       
       structure Word8 =
-	 struct
-	    open Word8
+         struct
+            open Word8
 
-	    type t = word
+            type t = word
 
-	    val _ = >> : word * Word.word -> word
-	    fun rol (w: word, w': Word.word): word =
-	       let
-		  val w' = Word.mod (w', Word.fromInt wordSize)
-	       in
-		  orb (>> (w, Word.- (Word.fromInt wordSize, w')),
-		       << (w, w'))
-	       end
-	    fun ror (w, w') =
-	       let
-		  val w' = Word.mod (w', Word.fromInt wordSize)
-	       in
-		  orb (>> (w, w'),
-		       << (w, Word.- (Word.fromInt wordSize, w')))
-	       end
-	 end
+            val _ = >> : word * Word.word -> word
+            fun rol (w: word, w': Word.word): word =
+               let
+                  val w' = Word.mod (w', Word.fromInt wordSize)
+               in
+                  orb (>> (w, Word.- (Word.fromInt wordSize, w')),
+                       << (w, w'))
+               end
+            fun ror (w, w') =
+               let
+                  val w' = Word.mod (w', Word.fromInt wordSize)
+               in
+                  orb (>> (w, w'),
+                       << (w, Word.- (Word.fromInt wordSize, w')))
+               end
+         end
    end

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/platform.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/platform.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/platform.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,29 +1,36 @@
+(* Copyright (C) 2003-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 signature MLTON_PLATFORM =
    sig
       structure Arch:
-	 sig
+         sig
             datatype t = Alpha | AMD64 | ARM | HPPA | IA64 | m68k |
                          MIPS | PowerPC | S390 | Sparc | X86
 
-	    val fromString: string -> t option
-	    val host: t
-	    val toString: t -> string
-	 end
-	 
+            val fromString: string -> t option
+            val host: t
+            val toString: t -> string
+         end
+         
       structure OS:
-	 sig
-	    datatype t =
-	       Cygwin
-	     | Darwin
-	     | FreeBSD
-	     | Linux
-	     | MinGW
-	     | NetBSD
-	     | OpenBSD
-	     | Solaris
+         sig
+            datatype t =
+               Cygwin
+             | Darwin
+             | FreeBSD
+             | Linux
+             | MinGW
+             | NetBSD
+             | OpenBSD
+             | Solaris
 
-	    val fromString: string -> t option
-	    val host: t
-	    val toString: t -> string
-	 end
+            val fromString: string -> t option
+            val host: t
+            val toString: t -> string
+         end
    end

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/pointer.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/pointer.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/pointer.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,10 @@
+(* Copyright (C) 2003-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 signature MLTON_POINTER =
    sig
       eqtype t

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/proc-env.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/proc-env.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/proc-env.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,10 @@
+(* Copyright (C) 2002-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 signature MLTON_PROC_ENV =
    sig
       val setenv: {name: string, value: string} -> unit

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/process.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/process.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/process.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,10 @@
+(* Copyright (C) 2002-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 signature MLTON_PROCESS =
    sig
       type pid
@@ -50,13 +57,13 @@
         end
       
       val create:
-	 {args: string list, 
-	  env: string list option, 
-	  path: string, 
-	  stderr: ('stderr, output) Param.t,
-	  stdin: ('stdin, input) Param.t,
-	  stdout: ('stdout, output) Param.t}
-	 -> ('stdin, 'stdout, 'stderr) t
+         {args: string list, 
+          env: string list option, 
+          path: string, 
+          stderr: ('stderr, output) Param.t,
+          stdin: ('stdin, input) Param.t,
+          stdout: ('stdout, output) Param.t}
+         -> ('stdin, 'stdout, 'stderr) t
       val getStderr: ('stdin, 'stdout, 'stderr) t -> ('stderr, input) Child.t
       val getStdin:  ('stdin, 'stdout, 'stderr) t -> ('stdin, output) Child.t
       val getStdout: ('stdin, 'stdout, 'stderr) t -> ('stdout, input) Child.t

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/profile.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/profile.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/profile.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,14 +1,21 @@
+(* Copyright (C) 2002-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 signature MLTON_PROFILE =
    sig
       structure Data:
-	 sig
-	    type t
+         sig
+            type t
 
-	    val equals: t * t -> bool
-	    val free: t -> unit
-	    val malloc: unit -> t
-	    val write: t * string -> unit
-	 end
+            val equals: t * t -> bool
+            val free: t -> unit
+            val malloc: unit -> t
+            val write: t * string -> unit
+         end
 
       val isOn: bool (* a compile-time constant *)
       val withData: Data.t * (unit -> 'a) -> 'a

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/ptrace.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/ptrace.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/ptrace.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,10 @@
+(* Copyright (C) 2002-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 signature MLTON_PTRACE =
    sig
       type pid

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/random.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/random.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/random.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,11 @@
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 type int = Int.int
 type word = Word.word
    
@@ -5,20 +13,20 @@
    sig
       (* Return a random alphanumeric character. *)
       val alphaNumChar: unit -> char
-	 
+         
       (* Return a string of random alphanumeric characters of specified
        * length.
        *)
       val alphaNumString: int -> string
-	 
+         
       (* Get the next pseudrandom. *)
       val rand: unit -> word
-	 
+         
       (* Use /dev/random to get a word.  Useful as an arg to srand.
        * Return NONE if /dev/random can't be read.
        *)
       val seed: unit -> word option
-	 
+         
       (* Set the seed used by rand. *)
       val srand: word -> unit
 

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/random.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/random.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/random.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,10 @@
+(* Copyright (C) 2002-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 structure Random: MLTON_RANDOM = 
    struct
       fun seed _ = SOME (0w13: Word32.word)
@@ -3,59 +10,59 @@
       fun useed _ = SOME (0w13: Word32.word)
       local
-	 val seed: word ref = ref 0w13
+         val seed: word ref = ref 0w13
       in
-	 (* From page 284 of Numerical Recipes in C. *)
-	 fun rand (): word =
-	    let
-	       val res = 0w1664525 * !seed + 0w1013904223
-	       val _ = seed := res
-	    in
-	       res
-	    end
+         (* From page 284 of Numerical Recipes in C. *)
+         fun rand (): word =
+            let
+               val res = 0w1664525 * !seed + 0w1013904223
+               val _ = seed := res
+            in
+               res
+            end
 
-	 fun srand (w: word): unit = seed := w
+         fun srand (w: word): unit = seed := w
       end
    
       structure String =
-	 struct
-	    open String
-			
-	    val tabulate = CharVector.tabulate
-	 end
+         struct
+            open String
+                        
+            val tabulate = CharVector.tabulate
+         end
 
       local
-	 val chars =
-	    "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"
-	 val numChars = String.size chars
-	 val refresh =
-	    let
-	       val numChars = IntInf.fromInt numChars
-	       fun loop (i: IntInf.int, c: int): int =
-		  if IntInf.< (i, numChars)
-		     then c
-		  else loop (IntInf.div (i, numChars), c + 1)
-	    in
-	       loop (IntInf.pow (2, Word.wordSize), 0)
-	    end
-	 val r: word ref = ref 0w0
-	 val count: int ref = ref refresh
-	 val numChars = Word.fromInt numChars
+         val chars =
+            "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"
+         val numChars = String.size chars
+         val refresh =
+            let
+               val numChars = IntInf.fromInt numChars
+               fun loop (i: IntInf.int, c: int): int =
+                  if IntInf.< (i, numChars)
+                     then c
+                  else loop (IntInf.div (i, numChars), c + 1)
+            in
+               loop (IntInf.pow (2, Word.wordSize), 0)
+            end
+         val r: word ref = ref 0w0
+         val count: int ref = ref refresh
+         val numChars = Word.fromInt numChars
       in
-	 fun alphaNumChar (): char =
-	    let
-	       val n = !count
-	       val _ = if n = refresh
-			  then (r := rand ()
-				; count := 1)
-		       else (count := n + 1)
-	       val w = !r
-	       val c = String.sub (chars, Word.toInt (Word.mod (w, numChars)))
-	       val _ = r := Word.div (w, numChars)
-	    in
-	       c
-	    end
+         fun alphaNumChar (): char =
+            let
+               val n = !count
+               val _ = if n = refresh
+                          then (r := rand ()
+                                ; count := 1)
+                       else (count := n + 1)
+               val w = !r
+               val c = String.sub (chars, Word.toInt (Word.mod (w, numChars)))
+               val _ = r := Word.div (w, numChars)
+            in
+               c
+            end
       end
 
       fun alphaNumString (length: int): string =
-	 String.tabulate (length, fn _ => alphaNumChar ())
+         String.tabulate (length, fn _ => alphaNumChar ())
    end

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/real.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/real.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/real.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,16 @@
+(* Copyright (C) 2002-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 structure Real =
    struct
       open Real
-	 
+         
       val fromLargeInt: IntInf.int -> real =
-	 fn _ => raise Fail "Real.fromLargeInt"
+         fn _ => raise Fail "Real.fromLargeInt"
       val toLargeInt: IEEEReal.rounding_mode -> real -> IntInf.int =
-	 fn _ => fn _ => raise Fail "Real.toLargeInt"
+         fn _ => fn _ => raise Fail "Real.toLargeInt"
    end

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/rlimit.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/rlimit.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/rlimit.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,11 @@
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 type word = Word.word
    
 signature MLTON_RLIMIT =
@@ -3,9 +11,9 @@
    sig
       type rlim = word
-	       
+               
       val infinity: rlim
 
       type t
-	       
+               
       val coreFileSize: t        (* CORE    max core file size *)
       val cpuTime: t             (* CPU     CPU time in seconds *)

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/rusage.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/rusage.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/rusage.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,19 @@
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 signature MLTON_RUSAGE =
    sig
       type t = {utime: Time.time, (* user time *)
-		stime: Time.time  (* system time *)
-		}
-	 
+                stime: Time.time  (* system time *)
+                }
+         
+      val measureGC: bool -> unit
       val rusage: unit -> {children: t,
-			   gc: t,
-			   self: t}
+                           gc: t,
+                           self: t}
    end

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/signal.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/signal.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/signal.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,11 @@
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 signature MLTON_SIGNAL =
    sig
       type t
@@ -4,31 +12,31 @@
       type signal = t
 
       structure Handler:
-	 sig
-	    type t
+         sig
+            type t
 
-	    val default: t
-	    val handler: (MLtonThread.Runnable.t -> MLtonThread.Runnable.t) -> t
-	    val ignore: t
-	    val isDefault: t -> bool
-	    val isIgnore: t -> bool
-	    val simple: (unit -> unit) -> t
-	 end
+            val default: t
+            val handler: (MLtonThread.Runnable.t -> MLtonThread.Runnable.t) -> t
+            val ignore: t
+            val isDefault: t -> bool
+            val isIgnore: t -> bool
+            val simple: (unit -> unit) -> t
+         end
 
       structure Mask:
-	 sig
-	    type t
-	       
-	    val all: t
-	    val allBut: signal list -> t
-	    val block: t -> unit
-	    val getBlocked: unit -> t
-	    val isMember: t * signal -> bool
-	    val none: t
-	    val setBlocked: t -> unit
-	    val some: signal list -> t
-	    val unblock: t -> unit
-	 end
+         sig
+            type t
+               
+            val all: t
+            val allBut: signal list -> t
+            val block: t -> unit
+            val getBlocked: unit -> t
+            val isMember: t * signal -> bool
+            val none: t
+            val setBlocked: t -> unit
+            val some: signal list -> t
+            val unblock: t -> unit
+         end
 
       val getHandler: t -> Handler.t
       val handled: unit -> Mask.t

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/socket.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/socket.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/socket.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,11 @@
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 type int = Int.int
 type word = Word.word
 
@@ -4,22 +12,29 @@
 signature MLTON_SOCKET =
    sig
       structure Address:
-	 sig
-	    type t = word
-	 end
+         sig
+            type t = word
+         end
 
+      structure Ctl:
+         sig
+            val getERROR:
+               ('af, 'sock_type) Socket.sock
+               -> (string * Posix.Error.syserror option) option
+         end
+
       structure Host:
-	 sig
-	    type t = {name: string}
+         sig
+            type t = {name: string}
 
-	    val getByAddress: Address.t -> t option
-	    val getByName: string -> t option
-	 end
+            val getByAddress: Address.t -> t option
+            val getByName: string -> t option
+         end
 
       structure Port:
-	 sig
-	    type t = int
-	 end
+         sig
+            type t = int
+         end
 
       type t
 
@@ -29,4 +44,6 @@
       val listenAt: Port.t -> t
       val shutdownRead: TextIO.instream -> unit
       val shutdownWrite: TextIO.outstream -> unit
+
+      val fdToSock: Posix.FileSys.file_desc -> ('af, 'sock_type) Socket.sock
    end

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/sources.cm
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/sources.cm	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/sources.cm	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,10 @@
+(* Copyright (C) 2002-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 Library
 
 signature MLTON_THREAD
@@ -32,8 +39,6 @@
 structure MLton
 structure OS
 structure Option
-structure Pack32Big
-structure Pack32Little
 structure Position
 structure Posix
 structure Real

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/syslog.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/syslog.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/syslog.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,11 @@
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 (* From Tom 7 <twm@andrew.cmu.edu>. *)
 (* A rather complete interface to the syslog facilities. 
  *
@@ -9,7 +17,7 @@
 signature MLTON_SYSLOG =
    sig
       type openflag
-	 
+         
       val CONS     : openflag
       val NDELAY   : openflag
       val PERROR   : openflag

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/text-io.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/text-io.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/text-io.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,10 @@
+(* Copyright (C) 2002-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 signature MLTON_TEXT_IO =
    MLTON_IO
    where type instream = TextIO.instream

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/thread.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/thread.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/thread.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,8 +1,8 @@
-(* Copyright (C) 2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 2004-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 type int = Int.int
@@ -10,18 +10,18 @@
 signature MLTON_THREAD =
    sig
       structure AtomicState :
-	 sig
-	    datatype t = NonAtomic | Atomic of int
-	 end
+         sig
+            datatype t = NonAtomic | Atomic of int
+         end
       val atomicBegin: unit -> unit
       val atomicEnd: unit -> unit
       val atomically: (unit -> 'a) -> 'a
       val atomicState: unit -> AtomicState.t
 
       structure Runnable :
-	 sig
-	    type t
-	 end
+         sig
+            type t
+         end
 
       type 'a t
 

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/thread.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/thread.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/thread.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,10 @@
+(* Copyright (C) 2002-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 type int = Int.int
 
 structure MLtonThread =
@@ -3,7 +10,7 @@
    struct
       structure AtomicState =
-	 struct
-	    datatype t = NonAtomic | Atomic of int
-	 end
+         struct
+            datatype t = NonAtomic | Atomic of int
+         end
       val atomicBegin = fn _ => raise Fail "Thread.atomicBegin"
       val atomicEnd = fn _ => raise Fail "Thread.atomicEnd"
@@ -14,9 +21,9 @@
       type 'a t = unit
 
       structure Runnable =
-	 struct
-	    type t = unit
-	 end
+         struct
+            type t = unit
+         end
 
       val atomicSwitch = fn _ => raise Fail "Thread.atomicSwitch"
       val new = fn _ => raise Fail "Thread.new"

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/vector.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/vector.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/vector.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,10 @@
+(* Copyright (C) 2002-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 type int = Int.int
 
 signature MLTON_VECTOR =

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/weak.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/weak.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/weak.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,10 @@
+(* Copyright (C) 2003-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 signature MLTON_WEAK =
    sig
       type 'a t

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/word.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/word.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/word.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,11 @@
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 type word = Word.word
    
 signature MLTON_WORD =
@@ -3,5 +11,5 @@
    sig
       type t
-	 
+         
       val rol: t * word -> t
       val ror: t * word -> t

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/world.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/world.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/world.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,10 @@
+(* Copyright (C) 2002-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 signature MLTON_WORLD =
    sig
       val load: string -> 'a

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs-in-smlnj/Makefile
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs-in-smlnj/Makefile	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs-in-smlnj/Makefile	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,11 @@
+## Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ #    Jagannathan, and Stephen Weeks.
+ # Copyright (C) 1997-2000 NEC Research Institute.
+ #
+ # MLton is released under a BSD-style license.
+ # See the file MLton-LICENSE for details.
+ ##
+
 .PHONY: clean
 clean:
 	../../bin/clean

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs-in-smlnj/array.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs-in-smlnj/array.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs-in-smlnj/array.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,11 @@
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 functor Array
    (Array:
     sig
@@ -33,19 +41,19 @@
       fun sub (a, i: Int.int) = Array.sub (a, toInt i)
       fun convertSlice (a, i, io) = (a, toInt i, toIntOpt io)
       local
-	 fun doit (f, {src, dst, di}) =
-	    f {di = toInt di, dst = dst, src = src}
+         fun doit (f, {src, dst, di}) =
+            f {di = toInt di, dst = dst, src = src}
       in
-	 fun copy (f, a) = doit (Array.copy, a)
-	 fun copyVec (f, a) = doit (Array.copyVec, a)
+         fun copy (f, a) = doit (Array.copy, a)
+         fun copyVec (f, a) = doit (Array.copyVec, a)
       end
       fun appi f a = Array.appi (fn (i, x) => f (fromInt i, x)) a
       local
-	 fun make fold f b a =
-	    fold (fn (i, a, b) => f (fromInt i, a, b)) b a
+         fun make fold f b a =
+            fold (fn (i, a, b) => f (fromInt i, a, b)) b a
       in
-	 fun foldli z = make Array.foldli z
-	 fun foldri z = make Array.foldri z
+         fun foldli z = make Array.foldli z
+         fun foldri z = make Array.foldri z
       end
       fun modifyi f a = Array.modifyi (fn (i, x) => f (fromInt i, x)) a
    end
@@ -53,38 +61,38 @@
 structure Array =
    let 
       structure A = Array (open Array
-			   type 'a elem = 'a)
+                           type 'a elem = 'a)
    in struct open Array A end
    end
 
 functor MonoArray (A: MONO_ARRAY) =
    let
       structure A' = Array (open A
-			   type 'a array = array
-			   type 'a vector = vector
-			   type 'a elem = elem
-			   (* The following rebindings are because of an
-			    * SML/NJ bug.
-			    *)
-			   val app = app
-			   val appi = appi
-			   val array = array
-			   val copy = copy
-			   val copyVec = copyVec
-			   val fromList = fromList
-			   val length = length
-			   val modify = modify
-			   val modifyi = modifyi
-			   val sub = sub
-			   val tabulate = tabulate
-			   val update = update)
+                           type 'a array = array
+                           type 'a vector = vector
+                           type 'a elem = elem
+                           (* The following rebindings are because of an
+                            * SML/NJ bug.
+                            *)
+                           val app = app
+                           val appi = appi
+                           val array = array
+                           val copy = copy
+                           val copyVec = copyVec
+                           val fromList = fromList
+                           val length = length
+                           val modify = modify
+                           val modifyi = modifyi
+                           val sub = sub
+                           val tabulate = tabulate
+                           val update = update)
    in struct
-	 open A A'
-	 local open A
-	 in type array = array
-	    type vector = vector
-	    type elem = elem
-	 end
+         open A A'
+         local open A
+         in type array = array
+            type vector = vector
+            type elem = elem
+         end
       end
    end
 

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs-in-smlnj/array2.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs-in-smlnj/array2.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs-in-smlnj/array2.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,11 @@
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 functor Array2
    (Array2:
     sig
@@ -4,39 +12,39 @@
        eqtype 'a array
        type 'a elem
        type 'a region = {base: 'a array,
-			 row: Int31.int,
-			 col: Int31.int,
-			 nrows: Int31.int option,
-			 ncols: Int31.int option}
+                         row: Int31.int,
+                         col: Int31.int,
+                         nrows: Int31.int option,
+                         ncols: Int31.int option}
 
        datatype traversal = RowMajor | ColMajor
 
        val app: traversal -> ('a -> unit) -> 'a array -> unit 
        val appi:
-	  traversal
-	  -> (Int31.int * Int31.int * 'a -> unit) -> 'a region -> unit 
+          traversal
+          -> (Int31.int * Int31.int * 'a -> unit) -> 'a region -> unit 
        val array: Int31.int * Int31.int * 'a -> 'a array 
        val column: ('a array * Int31.int) -> 'a vector 
        val copy:
-	  {src: 'a region, dst: 'a array, dst_row: Int31.int, dst_col: Int31.int}
-	  -> unit
+          {src: 'a region, dst: 'a array, dst_row: Int31.int, dst_col: Int31.int}
+          -> unit
        val dimensions: 'a array -> (Int31.int * Int31.int) 
        val fold: traversal -> ('a * 'b -> 'b) -> 'b -> 'a array -> 'b
        val foldi:
-	  traversal
-	  -> (Int31.int * Int31.int * 'a * 'b -> 'b) -> 'b -> 'a region -> 'b 
+          traversal
+          -> (Int31.int * Int31.int * 'a * 'b -> 'b) -> 'b -> 'a region -> 'b 
        val fromList: 'a list list -> 'a array 
        val modify: traversal -> ('a -> 'a) -> 'a array -> unit 
        val modifyi:
-	  traversal
-	  -> (Int31.int * Int31.int * 'a -> 'a) -> 'a region -> unit 
+          traversal
+          -> (Int31.int * Int31.int * 'a -> 'a) -> 'a region -> unit 
        val nCols: 'a array -> Int31.int 
        val nRows: 'a array -> Int31.int 
        val row: ('a array * Int31.int) -> 'a vector 
        val sub: 'a array * Int31.int * Int31.int -> 'a 
        val tabulate:
-	  traversal
-	  -> (Int31.int * Int31.int * (Int31.int * Int31.int -> 'a)) -> 'a array 
+          traversal
+          -> (Int31.int * Int31.int * (Int31.int * Int31.int -> 'a)) -> 'a array 
        val update: 'a array * Int31.int * Int31.int * 'a -> unit 
     end) =
    struct
@@ -44,52 +52,52 @@
 
       type int = Int32.int
       type 'a region = {base: 'a array,
-			row: int,
-			col: int,
-			nrows: int option,
-			ncols: int option}
+                        row: int,
+                        col: int,
+                        nrows: int option,
+                        ncols: int option}
 
       fun toRegion{base, row, col, nrows, ncols}: 'a Array2.region =
-	 {base = base,
-	  row = toInt row,
-	  col = toInt col,
-	  nrows = toIntOpt nrows,
-	  ncols = toIntOpt ncols}
+         {base = base,
+          row = toInt row,
+          col = toInt col,
+          nrows = toIntOpt nrows,
+          ncols = toIntOpt ncols}
 
       val array = fn (r, c, x) => array(toInt r, toInt c, x)
       val tabulate =
-	 fn t => fn (r, c, f) =>
-	 tabulate t (toInt r, toInt c, fn (r, c) => f(fromInt r, fromInt c))
+         fn t => fn (r, c, f) =>
+         tabulate t (toInt r, toInt c, fn (r, c) => f(fromInt r, fromInt c))
       val sub = fn (a, r, c) => sub(a, toInt r, toInt c)
       val update = fn (a, r, c, x) => update(a, toInt r, toInt c, x)
       val dimensions = fn a => let val (r, c) = dimensions a
-			       in (fromInt r, fromInt c)
-			       end
+                               in (fromInt r, fromInt c)
+                               end
       val nCols = fn a => fromInt(nCols a)
       val nRows = fn a => fromInt(nRows a)
       val row = fn (a, r) => row(a, toInt r)
       val column = fn (a, c) => column(a, toInt c)
       val copy =
-	 fn {src, dst, dst_row, dst_col} =>
-	 copy{src = toRegion src,
-	      dst = dst,
-	      dst_row = toInt dst_row,
-	      dst_col = toInt dst_col}
+         fn {src, dst, dst_row, dst_col} =>
+         copy{src = toRegion src,
+              dst = dst,
+              dst_row = toInt dst_row,
+              dst_col = toInt dst_col}
       val appi =
-	 fn t => fn f => fn r =>
-	 appi t (fn (r, c, x) => f(fromInt r, fromInt c, x)) (toRegion r)
+         fn t => fn f => fn r =>
+         appi t (fn (r, c, x) => f(fromInt r, fromInt c, x)) (toRegion r)
       val modifyi =
-	 fn t => fn f => fn r =>
-	 modifyi t (fn (r, c, x) => f(fromInt r, fromInt c, x)) (toRegion r)
+         fn t => fn f => fn r =>
+         modifyi t (fn (r, c, x) => f(fromInt r, fromInt c, x)) (toRegion r)
       val foldi =
-	 fn t => fn f => fn b => fn r =>
-	 foldi t (fn (r, c, x, y) => f(fromInt r, fromInt c, x, y))
-	 b (toRegion r)
+         fn t => fn f => fn b => fn r =>
+         foldi t (fn (r, c, x, y) => f(fromInt r, fromInt c, x, y))
+         b (toRegion r)
    end
 
 structure Array2 =
    let 
       structure A = Array2(open Array2
-			   type 'a elem = 'a)
+                           type 'a elem = 'a)
    in struct open Array2 A end
    end

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs-in-smlnj/bin-io.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs-in-smlnj/bin-io.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs-in-smlnj/bin-io.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,10 @@
+(* Copyright (C) 2002-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 structure BinIO =
    struct
       open OpenInt32 BinIO

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs-in-smlnj/char.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs-in-smlnj/char.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs-in-smlnj/char.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,11 @@
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 structure Char =
    struct
       open Char
@@ -2,6 +10,6 @@
       open OpenInt32
-	 
+         
       val toCString =
-	 fn #"\000" => "\\000"
-	  | c => toCString c
+         fn #"\000" => "\\000"
+          | c => toCString c
       val isCntrl = fn c => isCntrl c orelse c >= #"\127"

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs-in-smlnj/date.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs-in-smlnj/date.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs-in-smlnj/date.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,11 @@
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 structure Date =
    struct
       open Date OpenInt32
@@ -3,12 +11,12 @@
 
       val date =
-	 fn {year, month, day, hour, minute, second, offset} =>
-	 date{year = toInt year,
-	      month = month,
-	      day = toInt day,
-	      hour = toInt hour,
-	      minute = toInt minute,
-	      second = toInt second,
-	      offset = offset}
+         fn {year, month, day, hour, minute, second, offset} =>
+         date{year = toInt year,
+              month = month,
+              day = toInt day,
+              hour = toInt hour,
+              minute = toInt minute,
+              second = toInt second,
+              offset = offset}
       val year = fromInt o year
       val day = fromInt o day
@@ -20,5 +28,5 @@
       val fromString: string -> date option = fn _ => raise Fail "fromString"
       val localOffset: unit -> Time.time = fn _ => raise Fail "localOffset"
       val scan: (char, 'a) StringCvt.reader -> 'a -> (date * 'a) option =
-	 fn _ => raise Fail "scan"
+         fn _ => raise Fail "scan"
    end

Copied: mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs-in-smlnj/ieee-real.sml (from rev 4358, mlton/trunk/lib/mlton-stubs-in-smlnj/ieee-real.sml)

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs-in-smlnj/import.cm
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs-in-smlnj/import.cm	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs-in-smlnj/import.cm	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,11 @@
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 Library
 
 signature PERVASIVE_WORD

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs-in-smlnj/int-inf.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs-in-smlnj/int-inf.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs-in-smlnj/int-inf.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,11 @@
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 signature INT_INF =
    sig
       eqtype int
@@ -30,9 +38,9 @@
       val rem: int * int -> int
       val sameSign: int * int -> bool
       val scan:
-	 StringCvt.radix
-	 -> (char, 'a) StringCvt.reader
-	 -> (int, 'a) StringCvt.reader
+         StringCvt.radix
+         -> (char, 'a) StringCvt.reader
+         -> (int, 'a) StringCvt.reader
       val sign: int -> Pervasive.Int32.int
       val toInt: int -> Pervasive.Int32.int
       val toLarge: int -> Pervasive.IntInf.int
@@ -58,29 +66,29 @@
       fun pow (a, b) = Pervasive.IntInf.pow (a, Pervasive.Int32.toInt b)
 
       local
-	fun pow2 w = 
-	  if w = 0wx0
-	    then 1
-	  else
-	     let
-		val p = pow2 (Pervasive.Word32.>> (w, 0wx1))
-		val pp = p * p
-	     in
-		if 0wx1 = Pervasive.Word32.andb (0wx1, w)
-		  then 2 * pp
-		else pp
-	     end
+        fun pow2 w = 
+          if w = 0wx0
+            then 1
+          else
+             let
+                val p = pow2 (Pervasive.Word32.>> (w, 0wx1))
+                val pp = p * p
+             in
+                if 0wx1 = Pervasive.Word32.andb (0wx1, w)
+                  then 2 * pp
+                else pp
+             end
       in
-	val << = fn (a, b) => a * (pow2 b)
-	val ~>> = fn (a, b) => a div (pow2 b)
+        val << = fn (a, b) => a * (pow2 b)
+        val ~>> = fn (a, b) => a div (pow2 b)
       end
 
       local
-	 (* Bug in SML/NJ -- they use lower instead of upper case. *)
-	 val toUpper = Pervasive.String.translate (Char.toString o Char.toUpper)
+         (* Bug in SML/NJ -- they use lower instead of upper case. *)
+         val toUpper = Pervasive.String.translate (Char.toString o Char.toUpper)
       in
-	 fun fmt r i = toUpper (Pervasive.IntInf.fmt r i)
-	 val toString = toUpper o Pervasive.IntInf.toString
+         fun fmt r i = toUpper (Pervasive.IntInf.fmt r i)
+         val toString = toUpper o Pervasive.IntInf.toString
       end
    end
 

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs-in-smlnj/int.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs-in-smlnj/int.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs-in-smlnj/int.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,11 @@
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 structure PreInt =
    struct
       open Pervasive.Int32
@@ -6,23 +14,23 @@
       val sign = fromInt o sign
 
       local
-	 fun id x = x
+         fun id x = x
       in
-	 val toInt = id
-	 val fromInt = id
+         val toInt = id
+         val fromInt = id
       end
 
 (*       val 'a scan = fn radix =>
- * 	 let
- * 	    val scan: (char, 'a) StringCvt.reader
- * 	       -> (Int31.int, 'a) StringCvt.reader = scan radix
- * 	 in fn reader: (char, 'a) StringCvt.reader =>
- * 	    let val scan: (Int31.int, 'a) StringCvt.reader = scan reader
- * 	    in fn s: 'a =>
- * 	       case scan s of
- * 		  NONE => NONE
- * 		| SOME(n: Int31.int, s) => SOME(OpenInt32.fromInt n, s)
- * 	    end
- * 	 end
+ *       let
+ *          val scan: (char, 'a) StringCvt.reader
+ *             -> (Int31.int, 'a) StringCvt.reader = scan radix
+ *       in fn reader: (char, 'a) StringCvt.reader =>
+ *          let val scan: (Int31.int, 'a) StringCvt.reader = scan reader
+ *          in fn s: 'a =>
+ *             case scan s of
+ *                NONE => NONE
+ *              | SOME(n: Int31.int, s) => SOME(OpenInt32.fromInt n, s)
+ *          end
+ *       end
  *)
    end

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs-in-smlnj/list.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs-in-smlnj/list.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs-in-smlnj/list.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,11 @@
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 structure List =
    struct
       open List OpenInt32
@@ -4,11 +12,11 @@
 
       val length = fn z => fromInt(length z)
       local
-	 fun make f (l, n) = f (l, toInt n)
+         fun make f (l, n) = f (l, toInt n)
       in
-	 val nth = fn z => make List.nth z
-	 val take = fn z => make List.take z
-	 val drop = fn z => make List.drop z
+         val nth = fn z => make List.nth z
+         val take = fn z => make List.take z
+         val drop = fn z => make List.drop z
       end
       fun tabulate(n, f) = List.tabulate(toInt n, f o fromInt)
    end

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs-in-smlnj/mlton.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs-in-smlnj/mlton.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs-in-smlnj/mlton.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,7 +1,14 @@
+(* Copyright (C) 2004-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 structure MLton =
    struct
       structure GC =
-	 struct
-	    fun pack _ = ()
-	 end
+         struct
+            fun pack _ = ()
+         end
    end

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs-in-smlnj/open-int32.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs-in-smlnj/open-int32.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs-in-smlnj/open-int32.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,11 @@
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 structure OpenInt32 =
    struct
       val toInt = Pervasive.Int32.toInt
@@ -3,5 +11,5 @@
       val fromInt = Pervasive.Int32.fromInt
       val toIntOpt =
-	 fn NONE => NONE
-	  | SOME i => SOME (toInt i)
+         fn NONE => NONE
+          | SOME i => SOME (toInt i)
    end

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs-in-smlnj/os.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs-in-smlnj/os.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs-in-smlnj/os.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,11 @@
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 structure OS =
    struct
       open Pervasive.OS
@@ -3,9 +11,9 @@
 
       structure FileSys =
-	 struct
-	    open FileSys
-	       
-	    val fileSize = Pervasive.Int32.fromInt o fileSize
-	    val hash = Pervasive.Word32.fromLargeWord o Pervasive.Word.toLargeWord o hash
-	 end
+         struct
+            open FileSys
+               
+            val fileSize = Pervasive.Int32.fromInt o fileSize
+            val hash = Pervasive.Word32.fromLargeWord o Pervasive.Word.toLargeWord o hash
+         end
    end

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs-in-smlnj/other.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs-in-smlnj/other.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs-in-smlnj/other.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,11 @@
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 structure Bool = Bool
 structure Byte = Byte
 structure CommandLine = CommandLine
@@ -2,3 +10,2 @@
 structure General = General
-structure IEEEReal = IEEEReal
 structure IO = IO
@@ -8,8 +15,6 @@
 structure ListPair = ListPair
 structure Math = Math
 structure Option = Option
-structure Pack32Big = Pack32Big
-structure Pack32Little = Pack32Little
 structure SML90 = SML90
 structure SMLofNJ = SMLofNJ
 structure Unix = Unix

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs-in-smlnj/pervasive.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs-in-smlnj/pervasive.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs-in-smlnj/pervasive.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,11 @@
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 signature PERVASIVE_WORD = WORD
 structure Pervasive =
    struct
@@ -24,8 +32,6 @@
       structure Math = Math
       structure Option = Option
       structure OS = OS
-      structure Pack32Big = Pack32Big
-      structure Pack32Little = Pack32Little
       structure Position = Position
       structure Posix = Posix
       structure Real = Real

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs-in-smlnj/posix.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs-in-smlnj/posix.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs-in-smlnj/posix.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,10 @@
+(* Copyright (C) 2003-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 structure Posix =
    struct
       open Posix
@@ -3,16 +10,16 @@
 
       structure ProcEnv =
-	 struct
-	    open ProcEnv
+         struct
+            open ProcEnv
 
-	    (* SML/NJ times is broken.  So it's probably best to ignore what
-	     * it says and return zero.
-	     *)
-	    fun times () =
-	       {cstime = Time.zeroTime,
-		cutime = Time.zeroTime,
-		elapsed = Time.zeroTime,
-		stime = Time.zeroTime,
-		utime = Time.zeroTime}
-	 end
+            (* SML/NJ times is broken.  So it's probably best to ignore what
+             * it says and return zero.
+             *)
+            fun times () =
+               {cstime = Time.zeroTime,
+                cutime = Time.zeroTime,
+                elapsed = Time.zeroTime,
+                stime = Time.zeroTime,
+                utime = Time.zeroTime}
+         end
    end

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs-in-smlnj/real.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs-in-smlnj/real.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs-in-smlnj/real.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,11 @@
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 type int = Int32.int
    
 signature REAL =
@@ -77,82 +85,95 @@
       datatype z = datatype IEEEReal.float_class
       datatype z = datatype IEEEReal.rounding_mode
 
+      local
+         structure P = Pervasive.IEEEReal
+      in
+         val class =
+            fn r =>
+            case Pervasive.Real.class r of
+               P.NAN _ => NAN
+             | P.INF => INF
+             | P.ZERO => ZERO
+             | P.NORMAL => NORMAL
+             | P.SUBNORMAL => SUBNORMAL
+      end
+
       fun fmt f =
-	 Pervasive.Real.fmt
-	 (let
-	     datatype z = datatype StringCvt.realfmt
-	     val toIntOpt = OpenInt32.toIntOpt
-	  in
-	     case f of
-		EXACT => Pervasive.StringCvt.GEN NONE
-	      | FIX io => Pervasive.StringCvt.FIX (toIntOpt io)
-	      | GEN io => Pervasive.StringCvt.GEN (toIntOpt io)
-	      | SCI io => Pervasive.StringCvt.SCI (toIntOpt io)
-	 end)
-	 
+         Pervasive.Real.fmt
+         (let
+             datatype z = datatype StringCvt.realfmt
+             val toIntOpt = OpenInt32.toIntOpt
+          in
+             case f of
+                EXACT => Pervasive.StringCvt.GEN NONE
+              | FIX io => Pervasive.StringCvt.FIX (toIntOpt io)
+              | GEN io => Pervasive.StringCvt.GEN (toIntOpt io)
+              | SCI io => Pervasive.StringCvt.SCI (toIntOpt io)
+         end)
+         
       fun fromLargeInt i =
-	 valOf (Real.fromString (LargeInt.toString i))
+         valOf (Real.fromString (LargeInt.toString i))
 
       fun realRound x =
-	 let
-	    val x1 = realFloor x
-	    val x2 = realCeil x
-	 in
-	    if abs (x - x1) < abs (x - x2)
-	       then x1
-	    else x2
-	 end
+         let
+            val x1 = realFloor x
+            val x2 = realCeil x
+         in
+            if abs (x - x1) < abs (x - x2)
+               then x1
+            else x2
+         end
 
       val toLargeInt: IEEEReal.rounding_mode -> real -> LargeInt.int =
-	 fn mode => fn x =>
-	 case class x of
-	    INF => raise Overflow
-	  | NAN _ => raise Domain
-	  | ZERO => 0
-	  | _ =>
-	       let
-		  val x =
-		     case mode of
-			TO_NEAREST => realRound x
-		      | TO_NEGINF => realFloor x
-		      | TO_POSINF => realCeil x
-		      | TO_ZERO => realTrunc x
-	       in
-		  valOf (LargeInt.fromString (fmt (StringCvt.FIX (SOME 0)) x))
-	       end
+         fn mode => fn x =>
+         case class x of
+            INF => raise Overflow
+          | NAN => raise Domain
+          | ZERO => 0
+          | _ =>
+               let
+                  val x =
+                     case mode of
+                        TO_NEAREST => realRound x
+                      | TO_NEGINF => realFloor x
+                      | TO_POSINF => realCeil x
+                      | TO_ZERO => realTrunc x
+               in
+                  valOf (LargeInt.fromString (fmt (StringCvt.FIX (SOME 0)) x))
+               end
 
       open OpenInt32
 
       local
-	 fun make m r = Pervasive.Int32.fromLarge (toLargeInt m r)
-	 datatype z = datatype IEEEReal.rounding_mode
+         fun make m r = Pervasive.Int32.fromLarge (toLargeInt m r)
+         datatype z = datatype IEEEReal.rounding_mode
       in
-	 val floor = make TO_NEGINF
-	 val ceil = make TO_POSINF
-	 val round = make TO_NEAREST
-	 val trunc = make TO_ZERO
+         val floor = make TO_NEGINF
+         val ceil = make TO_POSINF
+         val round = make TO_NEAREST
+         val trunc = make TO_ZERO
       end
 
       val radix = fromInt radix
       val precision = fromInt precision
       val sign = fromInt o sign
       fun toManExp x =
-	 let
-	    val {man, exp} = Real.toManExp x
-	 in
-	    {man = man, exp = fromInt exp}
-	 end
+         let
+            val {man, exp} = Real.toManExp x
+         in
+            {man = man, exp = fromInt exp}
+         end
       fun fromManExp {man, exp} =
-	 Real.fromManExp {man = man, exp = toInt exp}
+         Real.fromManExp {man = man, exp = toInt exp}
       fun toInt m x = Pervasive.Int32.fromLarge (toLargeInt m x)
       val fromInt = fromLargeInt o Pervasive.Int32.toLarge
 
       val fromDecimal = SOME o fromDecimal
 
       fun fromString s =
-	 case SOME (Pervasive.Real.fromString s) handle Overflow => NONE of
-	    NONE => SOME 0.0
-	  | SOME ro => ro
+         case SOME (Pervasive.Real.fromString s) handle Overflow => NONE of
+            NONE => SOME 0.0
+          | SOME ro => ro
    end
 
 structure Real32 = Real

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs-in-smlnj/sources.cm
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs-in-smlnj/sources.cm	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs-in-smlnj/sources.cm	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,11 @@
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 Library
 
 signature INT_INF
@@ -33,8 +41,6 @@
 structure MLton
 structure OS
 structure Option
-structure Pack32Big
-structure Pack32Little
 structure Position
 structure Posix
 structure Real
@@ -45,6 +51,7 @@
 structure RealVector
 structure SML90
 structure SMLofNJ
+structure Socket
 structure String
 structure StringCvt
 structure Substring
@@ -74,6 +81,7 @@
 bin-io.sml
 char.sml
 date.sml
+ieee-real.sml
 int-inf.sml
 int.sml
 list.sml

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs-in-smlnj/string-cvt.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs-in-smlnj/string-cvt.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs-in-smlnj/string-cvt.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,11 @@
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 structure StringCvt =
    struct
       open StringCvt
@@ -5,7 +13,7 @@
       open OpenInt32
 
       datatype realfmt =
-	 EXACT
+         EXACT
        | FIX of Pervasive.Int32.int option 
        | GEN of Pervasive.Int32.int option 
        | SCI of Pervasive.Int32.int option 

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs-in-smlnj/string.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs-in-smlnj/string.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs-in-smlnj/string.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,11 @@
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 structure String =
    struct
       open String

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs-in-smlnj/substring.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs-in-smlnj/substring.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs-in-smlnj/substring.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,11 @@
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 structure Substring =
    struct
       open OpenInt32 Substring
@@ -2,14 +10,12 @@
 
-      val full = all
-	 
       fun base ss =
-	 let val (s, i, j) = Substring.base ss
-	 in (s, fromInt i, fromInt j)
-	 end
+         let val (s, i, j) = Substring.base ss
+         in (s, fromInt i, fromInt j)
+         end
 
       fun extract(s, i, io) =
-	 Substring.extract(s, toInt i, toIntOpt io)
+         Substring.extract(s, toInt i, toIntOpt io)
 
       fun substring(s, i, j) =
-	 Substring.substring(s, toInt i, toInt j)
+         Substring.substring(s, toInt i, toInt j)
 
@@ -19,7 +25,7 @@
       val trimr = trimr o toInt
 
       fun slice(s, i, io) =
-	 Substring.slice(s, toInt i, toIntOpt io)
+         Substring.slice(s, toInt i, toIntOpt io)
 
       fun sub(ss, i) = Substring.sub(ss, toInt i)
 

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs-in-smlnj/text-io.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs-in-smlnj/text-io.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs-in-smlnj/text-io.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,11 @@
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 structure TextIO =
    struct
       open OpenInt32 TextIO

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs-in-smlnj/time.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs-in-smlnj/time.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs-in-smlnj/time.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,11 @@
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 structure Time =
    struct
       open Time

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs-in-smlnj/unsafe.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs-in-smlnj/unsafe.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs-in-smlnj/unsafe.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,11 @@
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 functor ConvertMonoArray (A: UNSAFE_MONO_ARRAY) =
    struct
       open A
@@ -9,10 +17,10 @@
    end
 
 functor ConvertMonoVector (V: sig
-			       type vector
-			       type elem
-			       val sub: vector * Int31.int -> elem
-			      end) =
+                               type vector
+                               type elem
+                               val sub: vector * Int31.int -> elem
+                              end) =
    struct
       open V
 
@@ -25,20 +33,20 @@
       open Unsafe
 
       structure Array =
-	 struct
-	    open Array
+         struct
+            open Array
 
-	    val create = fn (i, x) => create (toInt i, x)
-	    val sub = fn (a, i) => sub (a, toInt i)
-	    val update = fn (a, i, x) => update (a, toInt i, x)
-	 end
+            val create = fn (i, x) => create (toInt i, x)
+            val sub = fn (a, i) => sub (a, toInt i)
+            val update = fn (a, i, x) => update (a, toInt i, x)
+         end
 
       structure Vector =
-	 struct
-	    open Vector
+         struct
+            open Vector
 
-	    val sub = fn (a, i) => sub (a, toInt i)
-	 end
+            val sub = fn (a, i) => sub (a, toInt i)
+         end
 
       structure CharVector = ConvertMonoVector (CharVector)
       structure Word8Vector = ConvertMonoVector (Word8Vector)

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs-in-smlnj/vector.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs-in-smlnj/vector.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs-in-smlnj/vector.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,17 +1,25 @@
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 functor Vector
    (V: sig
-	  type 'a vector
-	  type 'a elem
-	  val maxLen: Int31.int 
-	  val tabulate: Int31.int * (Int31.int -> 'a elem) -> 'a vector 
-	  val length: 'a vector -> Int31.int 
-	  val sub: ('a vector * Int31.int) -> 'a elem
-	  val mapi: ((Int31.int * 'a elem) -> 'b elem) -> 'a vector -> 'b vector 
-	  val appi: ((Int31.int * 'a elem) -> unit) -> 'a vector -> unit 
-	  val foldli:
-	     ((Int31.int * 'a elem * 'b) -> 'b) -> 'b -> 'a vector -> 'b 
-	  val foldri:
-	     ((Int31.int * 'a elem * 'b) -> 'b) -> 'b -> 'a vector -> 'b 
+          type 'a vector
+          type 'a elem
+          val maxLen: Int31.int 
+          val tabulate: Int31.int * (Int31.int -> 'a elem) -> 'a vector 
+          val length: 'a vector -> Int31.int 
+          val sub: ('a vector * Int31.int) -> 'a elem
+          val mapi: ((Int31.int * 'a elem) -> 'b elem) -> 'a vector -> 'b vector 
+          val appi: ((Int31.int * 'a elem) -> unit) -> 'a vector -> unit 
+          val foldli:
+             ((Int31.int * 'a elem * 'b) -> 'b) -> 'b -> 'a vector -> 'b 
+          val foldri:
+             ((Int31.int * 'a elem * 'b) -> 'b) -> 'b -> 'a vector -> 'b 
        end) =
    struct
       open V OpenInt32
@@ -22,42 +30,42 @@
       fun sub (v, i) = V.sub (v, toInt i)
       fun convertSlice (v: 'a vector, i, io) = (v, toInt i, toIntOpt io)
       local
-	 fun make f g v = f (fn (i, e) => g (fromInt i, e)) v
+         fun make f g v = f (fn (i, e) => g (fromInt i, e)) v
       in
-	 val mapi = fn z => make mapi z
-	 val appi = fn z => make appi z
+         val mapi = fn z => make mapi z
+         val appi = fn z => make appi z
       end
       local
-	 fun make fold f a v =
-	    fold (fn (i, e, a) => f (fromInt i, e, a)) a v
+         fun make fold f a v =
+            fold (fn (i, e, a) => f (fromInt i, e, a)) a v
       in
-	 val foldli = fn z => make foldli z
-	 val foldri = fn z => make foldri z
+         val foldli = fn z => make foldli z
+         val foldri = fn z => make foldri z
       end
    end
 
 structure Vector =
    let
       structure V = Vector (open Pervasive.Vector
-			    type 'a elem = 'a)
+                            type 'a elem = 'a)
    in struct open Vector V end
    end
 
 functor MonoVector (V: MONO_VECTOR) =
    struct
       structure V' = Vector (open V
-			     type 'a vector = vector
-			     type 'a elem = elem
-			     (* These rebindings are because of an SML/NJ bug. *)
-			     val appi = appi
-			     val length = length
-			     val mapi = mapi
-			     val sub = sub
-			     val tabulate = tabulate)
+                             type 'a vector = vector
+                             type 'a elem = elem
+                             (* These rebindings are because of an SML/NJ bug. *)
+                             val appi = appi
+                             val length = length
+                             val mapi = mapi
+                             val sub = sub
+                             val tabulate = tabulate)
       open V V'
       local open V
       in type vector = vector
-	 type elem = elem
+         type elem = elem
       end
    end
 

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs-in-smlnj/word.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs-in-smlnj/word.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs-in-smlnj/word.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,11 @@
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 structure LargeWord: WORD = Word32
    
 signature WORD =
@@ -3,5 +11,5 @@
    sig
       eqtype word
-	 
+         
       val * : word * word -> word 
       val + : word * word -> word 
@@ -30,9 +38,9 @@
       val notb: word -> word 
       val orb: word * word -> word 
       val scan:
-	 StringCvt.radix
-	 -> (char, 'a) StringCvt.reader
-	 -> (word, 'a) StringCvt.reader
+         StringCvt.radix
+         -> (char, 'a) StringCvt.reader
+         -> (word, 'a) StringCvt.reader
       val toInt: word -> Int32.int 
       val toIntX: word -> Int32.int 
       val toLarge: word -> LargeWord.word
@@ -49,40 +57,40 @@
 functor FixWord (W: PERVASIVE_WORD): WORD =
    struct
       local
-	 open W
+         open W
       in
-	 type word = word
-	 val op * = op *
-	 val op + = op +
-	 val op - = op -
-	 val op < = op <
-	 val op <= = op <=
-	 val op > = op >
-	 val op >= = op >=
-	 val ~ = ~
-	 val andb = andb
-	 val compare = compare
-	 val op div = op div
-	 val fromString = fromString
-	 val max = max
-	 val min = min
-	 val op mod = op mod
-	 val notb = notb
-	 val orb = orb
-	 val scan = scan
-	 val xorb = xorb
+         type word = word
+         val op * = op *
+         val op + = op +
+         val op - = op -
+         val op < = op <
+         val op <= = op <=
+         val op > = op >
+         val op >= = op >=
+         val ~ = ~
+         val andb = andb
+         val compare = compare
+         val op div = op div
+         val fromString = fromString
+         val max = max
+         val min = min
+         val op mod = op mod
+         val notb = notb
+         val orb = orb
+         val scan = scan
+         val xorb = xorb
       end
    
       val wordSize = Pervasive.Int32.fromInt W.wordSize
-	 
+         
       local
-	 fun fix (f: word * Word31.word -> word)
-	    (w: word, w': Word32.word): word =
-	    f (w, Word31.fromLargeWord w')
+         fun fix (f: word * Word31.word -> word)
+            (w: word, w': Word32.word): word =
+            f (w, Word31.fromLargeWord w')
       in
-	 val << = fix W.<<
-	 val >> = fix W.>>
-	 val ~>> = fix W.~>>
+         val << = fix W.<<
+         val >> = fix W.>>
+         val ~>> = fix W.~>>
       end
       val fromInt = W.fromLargeInt o Pervasive.Int32.toLarge
       val fromLarge = W.fromLargeWord o LargeWord.toLargeWord
@@ -97,11 +105,11 @@
       val toLargeWordX = LargeWord.fromLargeWord o W.toLargeWordX
       val toLargeX = toLargeWordX
       local
-	 (* Bug in SML/NJ -- they use lower instead of upper case. *)
-	 val toUpper = Pervasive.String.translate (Char.toString o Char.toUpper)
+         (* Bug in SML/NJ -- they use lower instead of upper case. *)
+         val toUpper = Pervasive.String.translate (Char.toString o Char.toUpper)
       in
-	 fun fmt r i = toUpper (W.fmt r i)
-	 val toString = toUpper o W.toString
+         fun fmt r i = toUpper (W.fmt r i)
+         val toString = toUpper o W.toString
       end
 
       fun ~ (w: word) = fromInt 0 - w

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlyacc/base.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlyacc/base.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlyacc/base.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,6 @@
+(* Modified by mfluet@acm.org on 2005-8-01.
+ * Update with SML/NJ 110.55+.
+ *)
 (* Modified by sweeks@acm.org on 2000-8-24.
  * Ported to MLton.
  *)
@@ -2,14 +5,5 @@
 type int = Int.int
-   
-(* ML-Yacc Parser Generator (c) 1989 Andrew W. Appel, David R. Tarditi 
- *
- * $Log: base.sig,v $
- * Revision 1.1.1.1  1997/01/14 01:38:04  george
- *   Version 109.24
- *
- * Revision 1.1.1.1  1996/01/31  16:01:42  george
- * Version 109
- * 
- *)
 
+(* ML-Yacc Parser Generator (c) 1989 Andrew W. Appel, David R. Tarditi *)
+
 (* base.sig: Base signature file for SML-Yacc.  This file contains signatures
@@ -37,29 +31,29 @@
 signature LR_TABLE =
     sig
         datatype ('a,'b) pairlist = EMPTY | PAIR of 'a * 'b * ('a,'b) pairlist
-	datatype state = STATE of int
-	datatype term = T of int
-	datatype nonterm = NT of int
-	datatype action = SHIFT of state
-			| REDUCE of int
-			| ACCEPT
-			| ERROR
-	type table
-	
-	val numStates : table -> int
-	val numRules : table -> int
-	val describeActions : table -> state ->
-				(term,action) pairlist * action
-	val describeGoto : table -> state -> (nonterm,state) pairlist
-	val action : table -> state * term -> action
-	val goto : table -> state * nonterm -> state
-	val initialState : table -> state
-	exception Goto of state * nonterm
+        datatype state = STATE of int
+        datatype term = T of int
+        datatype nonterm = NT of int
+        datatype action = SHIFT of state
+                        | REDUCE of int
+                        | ACCEPT
+                        | ERROR
+        type table
+        
+        val numStates : table -> int
+        val numRules : table -> int
+        val describeActions : table -> state ->
+                                (term,action) pairlist * action
+        val describeGoto : table -> state -> (nonterm,state) pairlist
+        val action : table -> state * term -> action
+        val goto : table -> state * nonterm -> state
+        val initialState : table -> state
+        exception Goto of state * nonterm
 
-	val mkLrTable : {actions : ((term,action) pairlist * action) array,
-			 gotos : (nonterm,state) pairlist array,
-			 numStates : int, numRules : int,
-			 initialState : state} -> table
+        val mkLrTable : {actions : ((term,action) pairlist * action) array,
+                         gotos : (nonterm,state) pairlist array,
+                         numStates : int, numRules : int,
+                         initialState : state} -> table
     end
 
 (* TOKEN: signature revealing the internal structure of a token. This signature
@@ -76,14 +70,14 @@
    type 'a token which functions to construct tokens would create.  A
    constructor function for a integer token might be
 
-	  INT: int * 'a * 'a -> 'a token.
+          INT: int * 'a * 'a -> 'a token.
  
    This is not possible because we need to have tokens with the representation
    given below for the polymorphic parser.
 
    Thus our constructur functions for tokens have the form:
 
-	  INT: int * 'a * 'a -> (svalue,'a) token
+          INT: int * 'a * 'a -> (svalue,'a) token
 
    This in turn has had an impact on the signature that lexers for SML-Yacc
    must match and the types that a user must declare in the user declarations
@@ -92,46 +86,46 @@
 
 signature TOKEN =
     sig
-	structure LrTable : LR_TABLE
+        structure LrTable : LR_TABLE
         datatype ('a,'b) token = TOKEN of LrTable.term * ('a * 'b * 'b)
-	val sameToken : ('a,'b) token * ('a,'b) token -> bool
+        val sameToken : ('a,'b) token * ('a,'b) token -> bool
     end
 
 (* LR_PARSER: signature for a polymorphic LR parser *)
 
 signature LR_PARSER =
     sig
-	structure Stream: STREAM
-	structure LrTable : LR_TABLE
-	structure Token : TOKEN
+        structure Stream: STREAM
+        structure LrTable : LR_TABLE
+        structure Token : TOKEN
 
-	sharing LrTable = Token.LrTable
+        sharing LrTable = Token.LrTable
 
-	exception ParseError
+        exception ParseError
 
-	val parse : {table : LrTable.table,
-		     lexer : ('_b,'_c) Token.token Stream.stream,
-		     arg: 'arg,
-		     saction : int *
-			       '_c *
-				(LrTable.state * ('_b * '_c * '_c)) list * 
-				'arg ->
-				     LrTable.nonterm *
-				     ('_b * '_c * '_c) *
-				     ((LrTable.state *('_b * '_c * '_c)) list),
-		     void : '_b,
-		     ec : { is_keyword : LrTable.term -> bool,
-			    noShift : LrTable.term -> bool,
-			    preferred_change : (LrTable.term list * LrTable.term list) list,
-			    errtermvalue : LrTable.term -> '_b,
-			    showTerminal : LrTable.term -> string,
-			    terms: LrTable.term list,
-			    error : string * '_c * '_c -> unit
-			   },
-		     lookahead : int  (* max amount of lookahead used in *)
-				      (* error correction *)
-			} -> '_b *
-			     (('_b,'_c) Token.token Stream.stream)
+        val parse : {table : LrTable.table,
+                     lexer : ('_b,'_c) Token.token Stream.stream,
+                     arg: 'arg,
+                     saction : int *
+                               '_c *
+                                (LrTable.state * ('_b * '_c * '_c)) list * 
+                                'arg ->
+                                     LrTable.nonterm *
+                                     ('_b * '_c * '_c) *
+                                     ((LrTable.state *('_b * '_c * '_c)) list),
+                     void : '_b,
+                     ec : { is_keyword : LrTable.term -> bool,
+                            noShift : LrTable.term -> bool,
+                            preferred_change : (LrTable.term list * LrTable.term list) list,
+                            errtermvalue : LrTable.term -> '_b,
+                            showTerminal : LrTable.term -> string,
+                            terms: LrTable.term list,
+                            error : string * '_c * '_c -> unit
+                           },
+                     lookahead : int  (* max amount of lookahead used in *)
+                                      (* error correction *)
+                        } -> '_b *
+                             (('_b,'_c) Token.token Stream.stream)
     end
 
 (* LEXER: a signature that most lexers produced for use with SML-Yacc's
@@ -148,12 +142,12 @@
 signature LEXER =
    sig
        structure UserDeclarations :
-	   sig
-	        type ('a,'b) token
-		type pos
-		type svalue
-	   end
-	val makeLexer : (int -> string) -> unit -> 
+           sig
+                type ('a,'b) token
+                type pos
+                type svalue
+           end
+        val makeLexer : (int -> string) -> unit -> 
          (UserDeclarations.svalue,UserDeclarations.pos) UserDeclarations.token
    end
 
@@ -164,13 +158,13 @@
 signature ARG_LEXER =
    sig
        structure UserDeclarations :
-	   sig
-	        type ('a,'b) token
-		type pos
-		type svalue
-		type arg
-	   end
-	val makeLexer : (int -> string) -> UserDeclarations.arg -> unit -> 
+           sig
+                type ('a,'b) token
+                type pos
+                type svalue
+                type arg
+           end
+        val makeLexer : (int -> string) -> UserDeclarations.arg -> unit -> 
          (UserDeclarations.svalue,UserDeclarations.pos) UserDeclarations.token
    end
 
@@ -187,57 +181,57 @@
    sig
         (* the type of line numbers *)
 
-	type pos
+        type pos
 
-	(* the type of semantic values *)
+        (* the type of semantic values *)
 
-	type svalue
+        type svalue
 
          (* the type of the user-supplied argument to the parser *)
- 	type arg
+        type arg
  
-	(* the intended type of the result of the parser.  This value is
-	   produced by applying extract from the structure Actions to the
-	   final semantic value resultiing from a parse.
-	 *)
+        (* the intended type of the result of the parser.  This value is
+           produced by applying extract from the structure Actions to the
+           final semantic value resultiing from a parse.
+         *)
 
-	type result
+        type result
 
-	structure LrTable : LR_TABLE
-	structure Token : TOKEN
-	sharing Token.LrTable = LrTable
+        structure LrTable : LR_TABLE
+        structure Token : TOKEN
+        sharing Token.LrTable = LrTable
 
-	(* structure Actions contains the functions which mantain the
-	   semantic values stack in the parser.  Void is used to provide
-	   a default value for the semantic stack.
-	 *)
+        (* structure Actions contains the functions which mantain the
+           semantic values stack in the parser.  Void is used to provide
+           a default value for the semantic stack.
+         *)
 
-	structure Actions : 
-	  sig
-	      val actions : int * pos *
-		   (LrTable.state * (svalue * pos * pos)) list * arg->
-		         LrTable.nonterm * (svalue * pos * pos) *
-			 ((LrTable.state *(svalue * pos * pos)) list)
-	      val void : svalue
-	      val extract : svalue -> result
-	  end
+        structure Actions : 
+          sig
+              val actions : int * pos *
+                   (LrTable.state * (svalue * pos * pos)) list * arg->
+                         LrTable.nonterm * (svalue * pos * pos) *
+                         ((LrTable.state *(svalue * pos * pos)) list)
+              val void : svalue
+              val extract : svalue -> result
+          end
 
-	(* structure EC contains information used to improve error
-	   recovery in an error-correcting parser *)
+        (* structure EC contains information used to improve error
+           recovery in an error-correcting parser *)
 
-	structure EC :
-	   sig
-	     val is_keyword : LrTable.term -> bool
-	     val noShift : LrTable.term -> bool
- 	     val preferred_change : (LrTable.term list * LrTable.term list) list
-	     val errtermvalue : LrTable.term -> svalue
-	     val showTerminal : LrTable.term -> string
-	     val terms: LrTable.term list
-	   end
+        structure EC :
+           sig
+             val is_keyword : LrTable.term -> bool
+             val noShift : LrTable.term -> bool
+             val preferred_change : (LrTable.term list * LrTable.term list) list
+             val errtermvalue : LrTable.term -> svalue
+             val showTerminal : LrTable.term -> string
+             val terms: LrTable.term list
+           end
 
-	(* table is the LR table for the parser *)
+        (* table is the LR table for the parser *)
 
-	val table : LrTable.table
+        val table : LrTable.table
     end
 
 (* signature PARSER is the signature that most user parsers created by 
@@ -247,42 +241,42 @@
 signature PARSER =
     sig
         structure Token : TOKEN
-	structure Stream : STREAM
-	exception ParseError
+        structure Stream : STREAM
+        exception ParseError
 
-	(* type pos is the type of line numbers *)
+        (* type pos is the type of line numbers *)
 
-	type pos
+        type pos
 
-	(* type result is the type of the result from the parser *)
+        (* type result is the type of the result from the parser *)
 
-	type result
+        type result
 
          (* the type of the user-supplied argument to the parser *)
- 	type arg
-	
-	(* type svalue is the type of semantic values for the semantic value
-	   stack
-	 *)
+        type arg
+        
+        (* type svalue is the type of semantic values for the semantic value
+           stack
+         *)
 
-	type svalue
+        type svalue
 
-	(* val makeLexer is used to create a stream of tokens for the parser *)
+        (* val makeLexer is used to create a stream of tokens for the parser *)
 
-	val makeLexer : (int -> string) ->
-			 (svalue,pos) Token.token Stream.stream
+        val makeLexer : (int -> string) ->
+                         (svalue,pos) Token.token Stream.stream
 
-	(* val parse takes a stream of tokens and a function to print
-	   errors and returns a value of type result and a stream containing
-	   the unused tokens
-	 *)
+        (* val parse takes a stream of tokens and a function to print
+           errors and returns a value of type result and a stream containing
+           the unused tokens
+         *)
 
-	val parse : int * ((svalue,pos) Token.token Stream.stream) *
-		    (string * pos * pos -> unit) * arg ->
-				result * (svalue,pos) Token.token Stream.stream
+        val parse : int * ((svalue,pos) Token.token Stream.stream) *
+                    (string * pos * pos -> unit) * arg ->
+                                result * (svalue,pos) Token.token Stream.stream
 
-	val sameToken : (svalue,pos) Token.token * (svalue,pos) Token.token ->
-				bool
+        val sameToken : (svalue,pos) Token.token * (svalue,pos) Token.token ->
+                                bool
      end
 
 (* signature ARG_PARSER is the signature that will be matched by parsers whose
@@ -292,22 +286,22 @@
 signature ARG_PARSER = 
     sig
         structure Token : TOKEN
-	structure Stream : STREAM
-	exception ParseError
+        structure Stream : STREAM
+        exception ParseError
 
-	type arg
-	type lexarg
-	type pos
-	type result
-	type svalue
+        type arg
+        type lexarg
+        type pos
+        type result
+        type svalue
 
-	val makeLexer : (int -> string) -> lexarg ->
-			 (svalue,pos) Token.token Stream.stream
-	val parse : int * ((svalue,pos) Token.token Stream.stream) *
-		    (string * pos * pos -> unit) * arg ->
-				result * (svalue,pos) Token.token Stream.stream
+        val makeLexer : (int -> string) -> lexarg ->
+                         (svalue,pos) Token.token Stream.stream
+        val parse : int * ((svalue,pos) Token.token Stream.stream) *
+                    (string * pos * pos -> unit) * arg ->
+                                result * (svalue,pos) Token.token Stream.stream
 
-	val sameToken : (svalue,pos) Token.token * (svalue,pos) Token.token ->
-				bool
+        val sameToken : (svalue,pos) Token.token * (svalue,pos) Token.token ->
+                                bool
      end
 

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlyacc/join.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlyacc/join.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlyacc/join.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,13 +1,4 @@
-(* ML-Yacc Parser Generator (c) 1989 Andrew W. Appel, David R. Tarditi 
- *
- * $Log: join.sml,v $
- * Revision 1.1.1.1  1997/01/14 01:38:04  george
- *   Version 109.24
- *
- * Revision 1.1.1.1  1996/01/31  16:01:42  george
- * Version 109
- * 
- *)
+(* ML-Yacc Parser Generator (c) 1989 Andrew W. Appel, David R. Tarditi *)
 
 (* functor Join creates a user parser by putting together a Lexer structure,
    an LrValues structure, and a polymorphic parser structure.  Note that
@@ -17,14 +8,14 @@
 *)
 
 functor Join(structure Lex : LEXER
-	     structure ParserData: PARSER_DATA
-	     structure LrParser : LR_PARSER
-	     sharing ParserData.LrTable = LrParser.LrTable
-	     sharing ParserData.Token = LrParser.Token
-	     sharing type Lex.UserDeclarations.svalue = ParserData.svalue
-	     sharing type Lex.UserDeclarations.pos = ParserData.pos
-	     sharing type Lex.UserDeclarations.token = ParserData.Token.token)
-		 : PARSER =
+             structure ParserData: PARSER_DATA
+             structure LrParser : LR_PARSER
+             sharing ParserData.LrTable = LrParser.LrTable
+             sharing ParserData.Token = LrParser.Token
+             sharing type Lex.UserDeclarations.svalue = ParserData.svalue
+             sharing type Lex.UserDeclarations.pos = ParserData.pos
+             sharing type Lex.UserDeclarations.token = ParserData.Token.token)
+                 : PARSER =
 struct
     structure Token = ParserData.Token
     structure Stream = LrParser.Stream
@@ -37,20 +28,20 @@
     type svalue = ParserData.svalue
     val makeLexer = LrParser.Stream.streamify o Lex.makeLexer
     val parse = fn (lookahead,lexer,error,arg) =>
-	(fn (a,b) => (ParserData.Actions.extract a,b))
+        (fn (a,b) => (ParserData.Actions.extract a,b))
      (LrParser.parse {table = ParserData.table,
-	        lexer=lexer,
-		lookahead=lookahead,
-		saction = ParserData.Actions.actions,
-		arg=arg,
-		void= ParserData.Actions.void,
-	        ec = {is_keyword = ParserData.EC.is_keyword,
-		      noShift = ParserData.EC.noShift,
-		      preferred_change = ParserData.EC.preferred_change,
-		      errtermvalue = ParserData.EC.errtermvalue,
-		      error=error,
-		      showTerminal = ParserData.EC.showTerminal,
-		      terms = ParserData.EC.terms}}
+                lexer=lexer,
+                lookahead=lookahead,
+                saction = ParserData.Actions.actions,
+                arg=arg,
+                void= ParserData.Actions.void,
+                ec = {is_keyword = ParserData.EC.is_keyword,
+                      noShift = ParserData.EC.noShift,
+                      preferred_change = ParserData.EC.preferred_change,
+                      errtermvalue = ParserData.EC.errtermvalue,
+                      error=error,
+                      showTerminal = ParserData.EC.showTerminal,
+                      terms = ParserData.EC.terms}}
       )
      val sameToken = Token.sameToken
 end
@@ -61,14 +52,14 @@
  *)
 
 functor JoinWithArg(structure Lex : ARG_LEXER
-	     structure ParserData: PARSER_DATA
-	     structure LrParser : LR_PARSER
-	     sharing ParserData.LrTable = LrParser.LrTable
-	     sharing ParserData.Token = LrParser.Token
-	     sharing type Lex.UserDeclarations.svalue = ParserData.svalue
-	     sharing type Lex.UserDeclarations.pos = ParserData.pos
-	     sharing type Lex.UserDeclarations.token = ParserData.Token.token)
-		 : ARG_PARSER  =
+             structure ParserData: PARSER_DATA
+             structure LrParser : LR_PARSER
+             sharing ParserData.LrTable = LrParser.LrTable
+             sharing ParserData.Token = LrParser.Token
+             sharing type Lex.UserDeclarations.svalue = ParserData.svalue
+             sharing type Lex.UserDeclarations.pos = ParserData.pos
+             sharing type Lex.UserDeclarations.token = ParserData.Token.token)
+                 : ARG_PARSER  =
 struct
     structure Token = ParserData.Token
     structure Stream = LrParser.Stream
@@ -82,22 +73,22 @@
     type svalue = ParserData.svalue
 
     val makeLexer = fn s => fn arg =>
-		 LrParser.Stream.streamify (Lex.makeLexer s arg)
+                 LrParser.Stream.streamify (Lex.makeLexer s arg)
     val parse = fn (lookahead,lexer,error,arg) =>
-	(fn (a,b) => (ParserData.Actions.extract a,b))
+        (fn (a,b) => (ParserData.Actions.extract a,b))
      (LrParser.parse {table = ParserData.table,
-	        lexer=lexer,
-		lookahead=lookahead,
-		saction = ParserData.Actions.actions,
-		arg=arg,
-		void= ParserData.Actions.void,
-	        ec = {is_keyword = ParserData.EC.is_keyword,
-		      noShift = ParserData.EC.noShift,
-		      preferred_change = ParserData.EC.preferred_change,
-		      errtermvalue = ParserData.EC.errtermvalue,
-		      error=error,
-		      showTerminal = ParserData.EC.showTerminal,
-		      terms = ParserData.EC.terms}}
+                lexer=lexer,
+                lookahead=lookahead,
+                saction = ParserData.Actions.actions,
+                arg=arg,
+                void= ParserData.Actions.void,
+                ec = {is_keyword = ParserData.EC.is_keyword,
+                      noShift = ParserData.EC.noShift,
+                      preferred_change = ParserData.EC.preferred_change,
+                      errtermvalue = ParserData.EC.errtermvalue,
+                      error=error,
+                      showTerminal = ParserData.EC.showTerminal,
+                      terms = ParserData.EC.terms}}
       )
     val sameToken = Token.sameToken
 end;

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlyacc/lrtable.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlyacc/lrtable.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlyacc/lrtable.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,6 @@
+(* Modified by mfluet@acm.org on 2005-8-01.
+ * Update with SML/NJ 110.55+.
+ *)
 (* Modified by sweeks@acm.org on 2000-8-24.
  * Ported to MLton.
  *)
@@ -2,70 +5,60 @@
 type int = Int.int
-   
-(* ML-Yacc Parser Generator (c) 1989 Andrew W. Appel, David R. Tarditi 
- *
- * $Log: lrtable.sml,v $
- * Revision 1.1.1.1  1997/01/14 01:38:04  george
- *   Version 109.24
- *
- * Revision 1.1.1.1  1996/01/31  16:01:42  george
- * Version 109
- * 
- *)
 
+(* ML-Yacc Parser Generator (c) 1989 Andrew W. Appel, David R. Tarditi *)
 structure LrTable : LR_TABLE = 
     struct
-	open Array List
-	infix 9 sub
-	datatype ('a,'b) pairlist = EMPTY
-				  | PAIR of 'a * 'b * ('a,'b) pairlist
-	datatype term = T of int
-	datatype nonterm = NT of int
-	datatype state = STATE of int
-	datatype action = SHIFT of state
-			| REDUCE of int (* rulenum from grammar *)
-			| ACCEPT
-			| ERROR
-	exception Goto of state * nonterm
-	type table = {states: int, rules : int,initialState: state,
-		      action: ((term,action) pairlist * action) array,
-		      goto :  (nonterm,state) pairlist array}
-	val numStates = fn ({states,...} : table) => states
-	val numRules = fn ({rules,...} : table) => rules
-	val describeActions =
-	   fn ({action,...} : table) => 
-	           fn (STATE s) => action sub s
-	val describeGoto =
-	   fn ({goto,...} : table) =>
-	           fn (STATE s) => goto sub s
-	fun findTerm (T term,row,default) =
-	    let fun find (PAIR (T key,data,r)) =
-		       if key < term then find r
-		       else if key=term then data
-		       else default
-		   | find EMPTY = default
-	    in find row
-	    end
-	fun findNonterm (NT nt,row) =
-	    let fun find (PAIR (NT key,data,r)) =
-		       if key < nt then find r
-		       else if key=nt then SOME data
-		       else NONE
-		   | find EMPTY = NONE
-	    in find row
-	    end
-	val action = fn ({action,...} : table) =>
-		fn (STATE state,term) =>
-		  let val (row,default) = action sub state
-		  in findTerm(term,row,default)
-		  end
-	val goto = fn ({goto,...} : table) =>
-			fn (a as (STATE state,nonterm)) =>
-			  case findNonterm(nonterm,goto sub state)
-			  of SOME state => state
-			   | NONE => raise (Goto a)
-	val initialState = fn ({initialState,...} : table) => initialState
-	val mkLrTable = fn {actions,gotos,initialState,numStates,numRules} =>
-	     ({action=actions,goto=gotos,
-	       states=numStates,
-	       rules=numRules,
+        open Array List
+        infix 9 sub
+        datatype ('a,'b) pairlist = EMPTY
+                                  | PAIR of 'a * 'b * ('a,'b) pairlist
+        datatype term = T of int
+        datatype nonterm = NT of int
+        datatype state = STATE of int
+        datatype action = SHIFT of state
+                        | REDUCE of int (* rulenum from grammar *)
+                        | ACCEPT
+                        | ERROR
+        exception Goto of state * nonterm
+        type table = {states: int, rules : int,initialState: state,
+                      action: ((term,action) pairlist * action) array,
+                      goto :  (nonterm,state) pairlist array}
+        val numStates = fn ({states,...} : table) => states
+        val numRules = fn ({rules,...} : table) => rules
+        val describeActions =
+           fn ({action,...} : table) => 
+                   fn (STATE s) => action sub s
+        val describeGoto =
+           fn ({goto,...} : table) =>
+                   fn (STATE s) => goto sub s
+        fun findTerm (T term,row,default) =
+            let fun find (PAIR (T key,data,r)) =
+                       if key < term then find r
+                       else if key=term then data
+                       else default
+                   | find EMPTY = default
+            in find row
+            end
+        fun findNonterm (NT nt,row) =
+            let fun find (PAIR (NT key,data,r)) =
+                       if key < nt then find r
+                       else if key=nt then SOME data
+                       else NONE
+                   | find EMPTY = NONE
+            in find row
+            end
+        val action = fn ({action,...} : table) =>
+                fn (STATE state,term) =>
+                  let val (row,default) = action sub state
+                  in findTerm(term,row,default)
+                  end
+        val goto = fn ({goto,...} : table) =>
+                        fn (a as (STATE state,nonterm)) =>
+                          case findNonterm(nonterm,goto sub state)
+                          of SOME state => state
+                           | NONE => raise (Goto a)
+        val initialState = fn ({initialState,...} : table) => initialState
+        val mkLrTable = fn {actions,gotos,initialState,numStates,numRules} =>
+             ({action=actions,goto=gotos,
+               states=numStates,
+               rules=numRules,
                initialState=initialState} : table)

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlyacc/mlyacc-lib.mlb
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlyacc/mlyacc-lib.mlb	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlyacc/mlyacc-lib.mlb	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,29 +1,36 @@
+(* Copyright (C) 2004-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 ann
-  "sequenceUnit true"
-  "warnMatch true"
-  "warnUnused true" "forceUsed"
+   "sequenceNonUnit warn"
+   "nonexhaustiveMatch warn" "redundantMatch warn"
+   "warnUnused false" "forceUsed"
 in
-local
-    $(SML_LIB)/basis/basis.mlb
-    base.sig
-    join.sml
-    lrtable.sml
-    stream.sml
-    parser2.sml  (* error correcting version *)
-in
-    signature STREAM
-    signature LR_TABLE
-    signature TOKEN
-    signature LR_PARSER
-    signature LEXER
-    signature ARG_LEXER
-    signature PARSER_DATA
-    signature PARSER
-    signature ARG_PARSER
-    functor Join
-    functor JoinWithArg
-    structure LrTable
-    structure Stream
-    structure LrParser
+   local
+      $(SML_LIB)/basis/basis.mlb
+      base.sig
+      join.sml
+      lrtable.sml
+      stream.sml
+      parser2.sml  (* error correcting version *)
+   in
+      signature STREAM
+      signature LR_TABLE
+      signature TOKEN
+      signature LR_PARSER
+      signature LEXER
+      signature ARG_LEXER
+      signature PARSER_DATA
+      signature PARSER
+      signature ARG_PARSER
+      functor Join
+      functor JoinWithArg
+      structure LrTable
+      structure Stream
+      structure LrParser
+   end
 end
-end

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlyacc/parser1.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlyacc/parser1.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlyacc/parser1.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,22 +1,10 @@
-(* ML-Yacc Parser Generator (c) 1989 Andrew W. Appel, David R. Tarditi 
- *
- * $Log: parser1.sml,v $
- * Revision 1.2  1997/09/10 18:34:22  jhr
- *   Changed "abstraction" to ":>".
- *
-# Revision 1.1.1.1  1997/01/14  01:38:04  george
-#   Version 109.24
-#
- * Revision 1.1.1.1  1996/01/31  16:01:42  george
- * Version 109
- * 
- *)
+(* ML-Yacc Parser Generator (c) 1989 Andrew W. Appel, David R. Tarditi *)
 
 (* drt (12/15/89) -- the functor should be used during development work,
    but it is wastes space in the release version.
    
 functor ParserGen(structure LrTable : LR_TABLE
-		  structure Stream : STREAM) : LR_PARSER =
+                  structure Stream : STREAM) : LR_PARSER =
 *)
 
 structure LrParser :> LR_PARSER =
@@ -26,11 +14,11 @@
      structure LrTable = LrTable
      structure Stream = Stream
      structure Token : TOKEN =
-	struct
-	    structure LrTable = LrTable
-	    datatype ('a,'b) token = TOKEN of LrTable.term * ('a * 'b * 'b)
-	    val sameToken = fn (TOKEN (t,_),TOKEN(t',_)) => t=t'
-	end
+        struct
+            structure LrTable = LrTable
+            datatype ('a,'b) token = TOKEN of LrTable.term * ('a * 'b * 'b)
+            val sameToken = fn (TOKEN (t,_),TOKEN(t',_)) => t=t'
+        end
      
 
      open LrTable 
@@ -54,21 +42,21 @@
             | nil => ()
 
       val parse = fn {arg : 'a,
-		      table : LrTable.table,
-		      lexer : ('_b,'_c) token Stream.stream,
-		      saction : int * '_c * ('_b,'_c) stack * 'a ->
-				nonterm * ('_b * '_c * '_c) * ('_b,'_c) stack,
-		      void : '_b,
-		      ec = {is_keyword,preferred_change,
-			    errtermvalue,showTerminal,
-			    error,terms,noShift},
-		      lookahead} =>
+                      table : LrTable.table,
+                      lexer : ('_b,'_c) token Stream.stream,
+                      saction : int * '_c * ('_b,'_c) stack * 'a ->
+                                nonterm * ('_b * '_c * '_c) * ('_b,'_c) stack,
+                      void : '_b,
+                      ec = {is_keyword,preferred_change,
+                            errtermvalue,showTerminal,
+                            error,terms,noShift},
+                      lookahead} =>
  let fun prAction(stack as (state, _) :: _, 
-		  next as (TOKEN (term,_),_), action) =
+                  next as (TOKEN (term,_),_), action) =
              (println "Parse: state stack:";
               printStack(stack, 0);
               print("       state="
-                         ^ showState state	
+                         ^ showState state      
                          ^ " next="
                          ^ showTerminal term
                          ^ " action="
@@ -77,7 +65,7 @@
                 of SHIFT s => println ("SHIFT " ^ showState s)
                  | REDUCE i => println ("REDUCE " ^ (makestring i))
                  | ERROR => println "ERROR"
-		 | ACCEPT => println "ACCEPT";
+                 | ACCEPT => println "ACCEPT";
               action)
         | prAction (_,_,action) = action
 
@@ -85,32 +73,26 @@
       val goto = LrTable.goto table
 
       fun parseStep(next as (TOKEN (terminal, value as (_,leftPos,_)),lexer) :
-			('_b,'_c) token * ('_b,'_c) token Stream.stream,
-		    stack as (state,_) :: _ : ('_b ,'_c) stack) =
+                        ('_b,'_c) token * ('_b,'_c) token Stream.stream,
+                    stack as (state,_) :: _ : ('_b ,'_c) stack) =
          case (if DEBUG then prAction(stack, next,action(state, terminal))
                else action(state, terminal))
               of SHIFT s => parseStep(Stream.get lexer, (s,value) :: stack)
                | REDUCE i =>
-		    let val (nonterm,value,stack as (state,_) :: _ ) =
-					 saction(i,leftPos,stack,arg)
-		    in parseStep(next,(goto(state,nonterm),value)::stack)
-		    end
+                    let val (nonterm,value,stack as (state,_) :: _ ) =
+                                         saction(i,leftPos,stack,arg)
+                    in parseStep(next,(goto(state,nonterm),value)::stack)
+                    end
                | ERROR => let val (_,leftPos,rightPos) = value
-		          in error("syntax error\n",leftPos,rightPos);
-			     raise ParseError
-			  end
-  	       | ACCEPT => let val (_,(topvalue,_,_)) :: _ = stack
-			       val (token,restLexer) = next
-			   in (topvalue,Stream.cons(token,lexer))
-			   end
+                          in error("syntax error\n",leftPos,rightPos);
+                             raise ParseError
+                          end
+               | ACCEPT => let val (_,(topvalue,_,_)) :: _ = stack
+                               val (token,restLexer) = next
+                           in (topvalue,Stream.cons(token,lexer))
+                           end
       val next as (TOKEN (terminal,(_,leftPos,_)),_) = Stream.get lexer
    in parseStep(next,[(initialState table,(void,leftPos,leftPos))])
    end
 end;
 
-(* drt (12/15/89) -- this needs to be used only when the parsing engine
-  (the code above) is functorized.  
-
-structure LrParser = ParserGen(structure LrTable = LrTable
-			     structure Stream = Stream);
-*)

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlyacc/parser2.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlyacc/parser2.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlyacc/parser2.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,33 +1,21 @@
-(* ML-Yacc Parser Generator (c) 1989 Andrew W. Appel, David R. Tarditi 
- *
- * $Log: parser2.sml,v $
- * Revision 1.2  1997/08/26 19:18:54  jhr
- *   Replaced used of "abstraction" with ":>".
- *
-# Revision 1.1.1.1  1997/01/14  01:38:04  george
-#   Version 109.24
-#
- * Revision 1.3  1996/10/03  03:36:58  jhr
- * Qualified identifiers that are no-longer top-level (quot, rem, min, max).
- *
- * Revision 1.2  1996/02/26  15:02:29  george
- *    print no longer overloaded.
- *    use of makestring has been removed and replaced with Int.toString ..
- *    use of IO replaced with TextIO
- *
- * Revision 1.1.1.1  1996/01/31  16:01:42  george
- * Version 109
- * 
+(* Modified by mfluet@acm.org on 2005-8-01.
+ * Update with SML/NJ 110.55+.
  *)
+(* Modified by sweeks@acm.org on 2000-8-24.
+ * Ported to MLton.
+ *)
+type int = Int.int
 
+(* ML-Yacc Parser Generator (c) 1989 Andrew W. Appel, David R. Tarditi *)
+
 (* parser.sml:  This is a parser driver for LR tables with an error-recovery
    routine added to it.  The routine used is described in detail in this
    article:
 
-	'A Practical Method for LR and LL Syntactic Error Diagnosis and
-	 Recovery', by M. Burke and G. Fisher, ACM Transactions on
-	 Programming Langauges and Systems, Vol. 9, No. 2, April 1987,
-	 pp. 164-197.
+        'A Practical Method for LR and LL Syntactic Error Diagnosis and
+         Recovery', by M. Burke and G. Fisher, ACM Transactions on
+         Programming Langauges and Systems, Vol. 9, No. 2, April 1987,
+         pp. 164-197.
 
     This program is an implementation is the partial, deferred method discussed
     in the article.  The algorithm and data structures used in the program
@@ -43,60 +31,60 @@
 
     Data Structures:
     ----------------
-	
-	* The parser:
+        
+        * The parser:
 
-	   The state stack has the type
+           The state stack has the type
 
-		 (state * (semantic value * line # * line #)) list
+                 (state * (semantic value * line # * line #)) list
 
-	   The parser keeps a queue of (state stack * lexer pair).  A lexer pair
-	 consists of a terminal * value pair and a lexer.  This allows the 
-	 parser to reconstruct the states for terminals to the left of a
-	 syntax error, and attempt to make error corrections there.
+           The parser keeps a queue of (state stack * lexer pair).  A lexer pair
+         consists of a terminal * value pair and a lexer.  This allows the 
+         parser to reconstruct the states for terminals to the left of a
+         syntax error, and attempt to make error corrections there.
 
-	   The queue consists of a pair of lists (x,y).  New additions to
-	 the queue are cons'ed onto y.  The first element of x is the top
-	 of the queue.  If x is nil, then y is reversed and used
-	 in place of x.
+           The queue consists of a pair of lists (x,y).  New additions to
+         the queue are cons'ed onto y.  The first element of x is the top
+         of the queue.  If x is nil, then y is reversed and used
+         in place of x.
 
     Algorithm:
     ----------
 
-	* The steady-state parser:  
+        * The steady-state parser:  
 
-	    This parser keeps the length of the queue of state stacks at
-	a steady state by always removing an element from the front when
-	another element is placed on the end.
+            This parser keeps the length of the queue of state stacks at
+        a steady state by always removing an element from the front when
+        another element is placed on the end.
 
-	    It has these arguments:
+            It has these arguments:
 
-	   stack: current stack
-	   queue: value of the queue
-	   lexPair ((terminal,value),lex stream)
+           stack: current stack
+           queue: value of the queue
+           lexPair ((terminal,value),lex stream)
 
-	When SHIFT is encountered, the state to shift to and the value are
-	are pushed onto the state stack.  The state stack and lexPair are
-	placed on the queue.  The front element of the queue is removed.
+        When SHIFT is encountered, the state to shift to and the value are
+        are pushed onto the state stack.  The state stack and lexPair are
+        placed on the queue.  The front element of the queue is removed.
 
-	When REDUCTION is encountered, the rule is applied to the current
-	stack to yield a triple (nonterm,value,new stack).  A new
-	stack is formed by adding (goto(top state of stack,nonterm),value)
-	to the stack.
+        When REDUCTION is encountered, the rule is applied to the current
+        stack to yield a triple (nonterm,value,new stack).  A new
+        stack is formed by adding (goto(top state of stack,nonterm),value)
+        to the stack.
 
-	When ACCEPT is encountered, the top value from the stack and the
-	lexer are returned.
+        When ACCEPT is encountered, the top value from the stack and the
+        lexer are returned.
 
-	When an ERROR is encountered, fixError is called.  FixError
-	takes the arguments to the parser, fixes the error if possible and
+        When an ERROR is encountered, fixError is called.  FixError
+        takes the arguments to the parser, fixes the error if possible and
         returns a new set of arguments.
 
-	* The distance-parser:
+        * The distance-parser:
 
-	This parser includes an additional argument distance.  It pushes
-	elements on the queue until it has parsed distance tokens, or an
-	ACCEPT or ERROR occurs.  It returns a stack, lexer, the number of
-	tokens left unparsed, a queue, and an action option.
+        This parser includes an additional argument distance.  It pushes
+        elements on the queue until it has parsed distance tokens, or an
+        ACCEPT or ERROR occurs.  It returns a stack, lexer, the number of
+        tokens left unparsed, a queue, and an action option.
 *)
 
 signature FIFO = 
@@ -111,7 +99,7 @@
    it wastes space in the release version.
 
 functor ParserGen(structure LrTable : LR_TABLE
-		  structure Stream : STREAM) : LR_PARSER =
+                  structure Stream : STREAM) : LR_PARSER =
 *)
 
 structure LrParser :> LR_PARSER =
@@ -119,11 +107,13 @@
       structure LrTable = LrTable
       structure Stream = Stream
 
+      fun eqT (LrTable.T i, LrTable.T i') = i = i'
+
       structure Token : TOKEN =
-	struct
-	    structure LrTable = LrTable
-	    datatype ('a,'b) token = TOKEN of LrTable.term * ('a * 'b * 'b)
-	    val sameToken = fn (TOKEN(t,_),TOKEN(t',_)) => t=t'
+        struct
+            structure LrTable = LrTable
+            datatype ('a,'b) token = TOKEN of LrTable.term * ('a * 'b * 'b)
+            val sameToken = fn (TOKEN(t,_),TOKEN(t',_)) => eqT (t,t')
         end
 
       open LrTable
@@ -136,13 +126,13 @@
 
       structure Fifo :> FIFO =
         struct
-	  type 'a queue = ('a list * 'a list)
-	  val empty = (nil,nil)
-	  exception Empty
-	  fun get(a::x, y) = (a, (x,y))
-	    | get(nil, nil) = raise Empty
-	    | get(nil, y) = get(rev y, nil)
- 	  fun put(a,(x,y)) = (x,a::y)
+          type 'a queue = ('a list * 'a list)
+          val empty = (nil,nil)
+          exception Empty
+          fun get(a::x, y) = (a, (x,y))
+            | get(nil, nil) = raise Empty
+            | get(nil, y) = get(rev y, nil)
+          fun put(a,(x,y)) = (x,a::y)
         end
 
       type ('a,'b) elem = (state * ('a * 'b * 'b))
@@ -150,29 +140,29 @@
       type ('a,'b) lexv = ('a,'b) token
       type ('a,'b) lexpair = ('a,'b) lexv * (('a,'b) lexv Stream.stream)
       type ('a,'b) distanceParse =
-		 ('a,'b) lexpair *
-		 ('a,'b) stack * 
-		 (('a,'b) stack * ('a,'b) lexpair) Fifo.queue *
-		 int ->
-		   ('a,'b) lexpair *
-		   ('a,'b) stack * 
-		   (('a,'b) stack * ('a,'b) lexpair) Fifo.queue *
-		   int *
-		   action option
+                 ('a,'b) lexpair *
+                 ('a,'b) stack * 
+                 (('a,'b) stack * ('a,'b) lexpair) Fifo.queue *
+                 int ->
+                   ('a,'b) lexpair *
+                   ('a,'b) stack * 
+                   (('a,'b) stack * ('a,'b) lexpair) Fifo.queue *
+                   int *
+                   action option
 
       type ('a,'b) ecRecord =
-	 {is_keyword : term -> bool,
+         {is_keyword : term -> bool,
           preferred_change : (term list * term list) list,
-	  error : string * 'b * 'b -> unit,
-	  errtermvalue : term -> 'a,
-	  terms : term list,
-	  showTerminal : term -> string,
-	  noShift : term -> bool}
+          error : string * 'b * 'b -> unit,
+          errtermvalue : term -> 'a,
+          terms : term list,
+          showTerminal : term -> string,
+          noShift : term -> bool}
 
       local 
-	 val print = fn s => TextIO.output(TextIO.stdOut,s)
-	 val println = fn s => (print s; print "\n")
-	 val showState = fn (STATE s) => "STATE " ^ (Int.toString s)
+         val print = fn s => TextIO.output(TextIO.stdOut,s)
+         val println = fn s => (print s; print "\n")
+         val showState = fn (STATE s) => "STATE " ^ (Int.toString s)
       in
         fun printStack(stack: ('a,'b) stack, n: int) =
          case stack
@@ -183,11 +173,11 @@
             | nil => ()
                 
         fun prAction showTerminal
-		 (stack as (state,_) :: _, (TOKEN (term,_), _), action) =
+                 (stack as (state,_) :: _, next as (TOKEN (term,_),_), action) =
              (println "Parse: state stack:";
               printStack(stack, 0);
               print("       state="
-                         ^ showState state	
+                         ^ showState state      
                          ^ " next="
                          ^ showTerminal term
                          ^ " action="
@@ -196,196 +186,206 @@
                 of SHIFT state => println ("SHIFT " ^ (showState state))
                  | REDUCE i => println ("REDUCE " ^ (Int.toString i))
                  | ERROR => println "ERROR"
-		 | ACCEPT => println "ACCEPT")
-        | prAction _ _ = ()
+                 | ACCEPT => println "ACCEPT")
+        | prAction _ (_,_,action) = ()
      end
 
     (* ssParse: parser which maintains the queue of (state * lexvalues) in a
-	steady-state.  It takes a table, showTerminal function, saction
-	function, and fixError function.  It parses until an ACCEPT is
-	encountered, or an exception is raised.  When an error is encountered,
-	fixError is called with the arguments of parseStep (lexv,stack,and
-	queue).  It returns the lexv, and a new stack and queue adjusted so
-	that the lexv can be parsed *)
-	
+        steady-state.  It takes a table, showTerminal function, saction
+        function, and fixError function.  It parses until an ACCEPT is
+        encountered, or an exception is raised.  When an error is encountered,
+        fixError is called with the arguments of parseStep (lexv,stack,and
+        queue).  It returns the lexv, and a new stack and queue adjusted so
+        that the lexv can be parsed *)
+        
     val ssParse =
       fn (table,showTerminal,saction,fixError,arg) =>
-	let val prAction = prAction showTerminal
-	    val action = LrTable.action table
-	    val goto = LrTable.goto table
-	    fun parseStep(args as
-			 (lexPair as (TOKEN (terminal, value as (_,leftPos,_)),
-				      lexer
-				      ),
-			  stack as (state,_) :: _,
-			  queue)) =
-	      let val nextAction = action (state,terminal)
-	          val _ = if DEBUG1 then prAction(stack,lexPair,nextAction)
-			  else ()
-	      in case nextAction
-		 of SHIFT s =>
-		  let val newStack = (s,value) :: stack
-		      val newLexPair = Stream.get lexer
-		      val (_,newQueue) =Fifo.get(Fifo.put((newStack,newLexPair),
-							    queue))
-		  in parseStep(newLexPair,(s,value)::stack,newQueue)
-		  end
-		 | REDUCE i =>
-		     (case saction(i,leftPos,stack,arg)
-		      of (nonterm,value,stack as (state,_) :: _) =>
-		          parseStep(lexPair,(goto(state,nonterm),value)::stack,
-				    queue)
-		       | _ => raise (ParseImpossible 197))
-		 | ERROR => parseStep(fixError args)
-		 | ACCEPT => 
-			(case stack
-			 of (_,(topvalue,_,_)) :: _ =>
-				let val (token,restLexer) = lexPair
-				in (topvalue,Stream.cons(token,restLexer))
-				end
-			  | _ => raise (ParseImpossible 202))
-	      end
-	    | parseStep _ = raise (ParseImpossible 204)
-	in parseStep
-	end
+        let val prAction = prAction showTerminal
+            val action = LrTable.action table
+            val goto = LrTable.goto table
+            fun parseStep(args as
+                         (lexPair as (TOKEN (terminal, value as (_,leftPos,_)),
+                                      lexer
+                                      ),
+                          stack as (state,_) :: _,
+                          queue)) =
+              let val nextAction = action (state,terminal)
+                  val _ = if DEBUG1 then prAction(stack,lexPair,nextAction)
+                          else ()
+              in case nextAction
+                 of SHIFT s =>
+                  let val newStack = (s,value) :: stack
+                      val newLexPair = Stream.get lexer
+                      val (_,newQueue) =Fifo.get(Fifo.put((newStack,newLexPair),
+                                                            queue))
+                  in parseStep(newLexPair,(s,value)::stack,newQueue)
+                  end
+                 | REDUCE i =>
+                     (case saction(i,leftPos,stack,arg)
+                      of (nonterm,value,stack as (state,_) :: _) =>
+                          parseStep(lexPair,(goto(state,nonterm),value)::stack,
+                                    queue)
+                       | _ => raise (ParseImpossible 197))
+                 | ERROR => parseStep(fixError args)
+                 | ACCEPT => 
+                        (case stack
+                         of (_,(topvalue,_,_)) :: _ =>
+                                let val (token,restLexer) = lexPair
+                                in (topvalue,Stream.cons(token,restLexer))
+                                end
+                          | _ => raise (ParseImpossible 202))
+              end
+            | parseStep _ = raise (ParseImpossible 204)
+        in parseStep
+        end
 
     (*  distanceParse: parse until n tokens are shifted, or accept or
-	error are encountered.  Takes a table, showTerminal function, and
-	semantic action function.  Returns a parser which takes a lexPair
-	(lex result * lexer), a state stack, a queue, and a distance
-	(must be > 0) to parse.  The parser returns a new lex-value, a stack
-	with the nth token shifted on top, a queue, a distance, and action
-	option. *)
+        error are encountered.  Takes a table, showTerminal function, and
+        semantic action function.  Returns a parser which takes a lexPair
+        (lex result * lexer), a state stack, a queue, and a distance
+        (must be > 0) to parse.  The parser returns a new lex-value, a stack
+        with the nth token shifted on top, a queue, a distance, and action
+        option. *)
 
     val distanceParse =
       fn (table,showTerminal,saction,arg) =>
-	let val prAction = prAction showTerminal
-	    val action = LrTable.action table
-	    val goto = LrTable.goto table
-	    fun parseStep(lexPair,stack,queue,0) = (lexPair,stack,queue,0,NONE)
-	      | parseStep(lexPair as (TOKEN (terminal, value as (_,leftPos,_)),
-				      lexer
-				     ),
-			  stack as (state,_) :: _,
-			  queue,distance) =
-	      let val nextAction = action(state,terminal)
-	          val _ = if DEBUG1 then prAction(stack,lexPair,nextAction)
-			  else ()
-	      in case nextAction
-		 of SHIFT s =>
-		  let val newStack = (s,value) :: stack
-		      val newLexPair = Stream.get lexer
-		  in parseStep(newLexPair,(s,value)::stack,
-			       Fifo.put((newStack,newLexPair),queue),distance-1)
-		  end
-		 | REDUCE i =>
-		    (case saction(i,leftPos,stack,arg)
-		      of (nonterm,value,stack as (state,_) :: _) =>
-		         parseStep(lexPair,(goto(state,nonterm),value)::stack,
-				 queue,distance)
-		      | _ => raise (ParseImpossible 240))
-		 | ERROR => (lexPair,stack,queue,distance,SOME nextAction)
-		 | ACCEPT => (lexPair,stack,queue,distance,SOME nextAction)
-	      end
-	   | parseStep _ = raise (ParseImpossible 242)
-	in parseStep : ('_a,'_b) distanceParse 
-	end
+        let val prAction = prAction showTerminal
+            val action = LrTable.action table
+            val goto = LrTable.goto table
+            fun parseStep(lexPair,stack,queue,0) = (lexPair,stack,queue,0,NONE)
+              | parseStep(lexPair as (TOKEN (terminal, value as (_,leftPos,_)),
+                                      lexer
+                                     ),
+                          stack as (state,_) :: _,
+                          queue,distance) =
+              let val nextAction = action(state,terminal)
+                  val _ = if DEBUG1 then prAction(stack,lexPair,nextAction)
+                          else ()
+              in case nextAction
+                 of SHIFT s =>
+                  let val newStack = (s,value) :: stack
+                      val newLexPair = Stream.get lexer
+                  in parseStep(newLexPair,(s,value)::stack,
+                               Fifo.put((newStack,newLexPair),queue),distance-1)
+                  end
+                 | REDUCE i =>
+                    (case saction(i,leftPos,stack,arg)
+                      of (nonterm,value,stack as (state,_) :: _) =>
+                         parseStep(lexPair,(goto(state,nonterm),value)::stack,
+                                 queue,distance)
+                      | _ => raise (ParseImpossible 240))
+                 | ERROR => (lexPair,stack,queue,distance,SOME nextAction)
+                 | ACCEPT => (lexPair,stack,queue,distance,SOME nextAction)
+              end
+           | parseStep _ = raise (ParseImpossible 242)
+        in parseStep : ('_a,'_b) distanceParse 
+        end
 
 (* mkFixError: function to create fixError function which adjusts parser state
    so that parse may continue in the presence of an error *)
 
 fun mkFixError({is_keyword,terms,errtermvalue,
-	      preferred_change,noShift,
-	      showTerminal,error,...} : ('_a,'_b) ecRecord,
-	     distanceParse : ('_a,'_b) distanceParse,
-	     minAdvance,maxAdvance) 
+              preferred_change,noShift,
+              showTerminal,error,...} : ('_a,'_b) ecRecord,
+             distanceParse : ('_a,'_b) distanceParse,
+             minAdvance,maxAdvance) 
 
-            ((TOKEN (term, (_, leftPos, _)), _), _, queue) =
+            (lexv as (TOKEN (term,value as (_,leftPos,_)),_),stack,queue) =
     let val _ = if DEBUG2 then
-			error("syntax error found at " ^ (showTerminal term),
-			      leftPos,leftPos)
-		else ()
+                        error("syntax error found at " ^ (showTerminal term),
+                              leftPos,leftPos)
+                else ()
 
         fun tokAt(t,p) = TOKEN(t,(errtermvalue t,p,p))
 
-	val minDelta = 3
+        val minDelta = 3
 
-	(* pull all the state * lexv elements from the queue *)
+        (* pull all the state * lexv elements from the queue *)
 
-	val stateList = 
-	   let fun f q = let val (elem,newQueue) = Fifo.get q
-			 in elem :: (f newQueue)
-			 end handle Fifo.Empty => nil
-	   in f queue
-	   end
+        val stateList = 
+           let fun f q = let val (elem,newQueue) = Fifo.get q
+                         in elem :: (f newQueue)
+                         end handle Fifo.Empty => nil
+           in f queue
+           end
 
-	(* now number elements of stateList, giving distance from
-	   error token *)
+        (* now number elements of stateList, giving distance from
+           error token *)
 
-	val (_, numStateList) =
-	      List.foldr (fn (a,(num,r)) => (num+1,(a,num)::r)) (0, []) stateList
+        val (_, numStateList) =
+              List.foldr (fn (a,(num,r)) => (num+1,(a,num)::r)) (0, []) stateList
 
-	(* Represent the set of potential changes as a linked list.
+        (* Represent the set of potential changes as a linked list.
 
-	   Values of datatype Change hold information about a potential change.
+           Values of datatype Change hold information about a potential change.
 
-	   oper = oper to be applied
-	   pos = the # of the element in stateList that would be altered.
-	   distance = the number of tokens beyond the error token which the
-	     change allows us to parse.
-	   new = new terminal * value pair at that point
-	   orig = original terminal * value pair at the point being changed.
-	 *)
+           oper = oper to be applied
+           pos = the # of the element in stateList that would be altered.
+           distance = the number of tokens beyond the error token which the
+             change allows us to parse.
+           new = new terminal * value pair at that point
+           orig = original terminal * value pair at the point being changed.
+         *)
 
-	datatype ('a,'b) change = CHANGE of
-	   {pos : int, distance : int, leftPos: 'b, rightPos: 'b,
-	    new : ('a,'b) lexv list, orig : ('a,'b) lexv list}
+        datatype ('a,'b) change = CHANGE of
+           {pos : int, distance : int, leftPos: 'b, rightPos: 'b,
+            new : ('a,'b) lexv list, orig : ('a,'b) lexv list}
 
 
          val showTerms = concat o map (fn TOKEN(t,_) => " " ^ showTerminal t)
 
+         val printChange = fn c =>
+          let val CHANGE {distance,new,orig,pos,...} = c
+          in (print ("{distance= " ^ (Int.toString distance));
+              print (",orig ="); print(showTerms orig);
+              print (",new ="); print(showTerms new);
+              print (",pos= " ^ (Int.toString pos));
+              print "}\n")
+          end
+
+        val printChangeList = app printChange
+
 (* parse: given a lexPair, a stack, and the distance from the error
    token, return the distance past the error token that we are able to parse.*)
 
-	fun parse (lexPair,stack,queuePos : int) =
-	    case distanceParse(lexPair,stack,Fifo.empty,queuePos+maxAdvance+1)
+        fun parse (lexPair,stack,queuePos : int) =
+            case distanceParse(lexPair,stack,Fifo.empty,queuePos+maxAdvance+1)
              of (_,_,_,distance,SOME ACCEPT) => 
-		        if maxAdvance-distance-1 >= 0 
-			    then maxAdvance 
-			    else maxAdvance-distance-1
-	      | (_,_,_,distance,_) => maxAdvance - distance - 1
+                        if maxAdvance-distance-1 >= 0 
+                            then maxAdvance 
+                            else maxAdvance-distance-1
+              | (_,_,_,distance,_) => maxAdvance - distance - 1
 
 (* catList: concatenate results of scanning list *)
 
-	fun catList l f = List.foldr (fn(a,r)=> f a @ r) [] l
+        fun catList l f = List.foldr (fn(a,r)=> f a @ r) [] l
 
         fun keywordsDelta new = if List.exists (fn(TOKEN(t,_))=>is_keyword t) new
-	               then minDelta else 0
+                       then minDelta else 0
 
-        fun tryChange{lex,stack,pos,leftPos,rightPos,orig,new} =
-	     let val lex' = List.foldr (fn (t',p)=>(t',Stream.cons p)) lex new
-		 val distance = parse(lex',stack,
-				      pos + List.length new - List.length orig)
-	      in if distance >= minAdvance + keywordsDelta new 
-		   then [CHANGE{pos=pos,leftPos=leftPos,rightPos=rightPos,
-				distance=distance,orig=orig,new=new}] 
-		   else []
-	     end
+        fun tryChange{lex,stack,pos:int,leftPos,rightPos,orig,new} =
+             let val lex' = List.foldr (fn (t',p)=>(t',Stream.cons p)) lex new
+                 val distance = parse(lex',stack,pos+List.length new-List.length orig)
+              in if distance >= minAdvance + keywordsDelta new 
+                   then [CHANGE{pos=pos,leftPos=leftPos,rightPos=rightPos,
+                                distance=distance,orig=orig,new=new}] 
+                   else []
+             end
 
 
 (* tryDelete: Try to delete n terminals.
               Return single-element [success] or nil.
-	      Do not delete unshiftable terminals. *)
+              Do not delete unshiftable terminals. *)
 
 
-    fun tryDelete n ((stack, lexPair as (TOKEN (_, (_, l, r)), _)), qPos) =
-	let fun del(0,accum,left,right,lexPair) =
-	          tryChange{lex=lexPair,stack=stack,
-			    pos=qPos,leftPos=left,rightPos=right,
-			    orig=rev accum, new=[]}
-	      | del(n,accum,left,_,(tok as TOKEN(term,(_,_,r)),lexer)) =
-		   if noShift term then []
-		   else del(n-1,tok::accum,left,r,Stream.get lexer)
+    fun tryDelete n ((stack,lexPair as (TOKEN(term,(_,l,r)),_)),qPos) =
+        let fun del(0,accum,left,right,lexPair) =
+                  tryChange{lex=lexPair,stack=stack,
+                            pos=qPos,leftPos=left,rightPos=right,
+                            orig=rev accum, new=[]}
+              | del(n,accum,left,right,(tok as TOKEN(term,(_,_,r)),lexer)) =
+                   if noShift term then []
+                   else del(n-1,tok::accum,left,r,Stream.get lexer)
          in del(n,[],l,r,lexPair)
         end
 
@@ -393,163 +393,158 @@
        return a list of the successes  *)
 
         fun tryInsert((stack,lexPair as (TOKEN(_,(_,l,_)),_)),queuePos) =
-	       catList terms (fn t =>
-		 tryChange{lex=lexPair,stack=stack,
-			   pos=queuePos,orig=[],new=[tokAt(t,l)],
-			   leftPos=l,rightPos=l})
-			      
+               catList terms (fn t =>
+                 tryChange{lex=lexPair,stack=stack,
+                           pos=queuePos,orig=[],new=[tokAt(t,l)],
+                           leftPos=l,rightPos=l})
+                              
 (* trySubst: try to substitute tokens for the current terminal;
        return a list of the successes  *)
 
-        fun trySubst ((stack, (orig as TOKEN (term,(_,l,r)),lexer)),
-		      queuePos) =
-	      if noShift term then []
-	      else
-		  catList terms (fn t =>
-		      tryChange{lex=Stream.get lexer,stack=stack,
-				pos=queuePos,
-				leftPos=l,rightPos=r,orig=[orig],
-				new=[tokAt(t,r)]})
+        fun trySubst ((stack,lexPair as (orig as TOKEN (term,(_,l,r)),lexer)),
+                      queuePos) =
+              if noShift term then []
+              else
+                  catList terms (fn t =>
+                      tryChange{lex=Stream.get lexer,stack=stack,
+                                pos=queuePos,
+                                leftPos=l,rightPos=r,orig=[orig],
+                                new=[tokAt(t,r)]})
 
      (* do_delete(toks,lexPair) tries to delete tokens "toks" from "lexPair".
          If it succeeds, returns SOME(toks',l,r,lp), where
-	     toks' is the actual tokens (with positions and values) deleted,
-	     (l,r) are the (leftmost,rightmost) position of toks', 
-	     lp is what remains of the stream after deletion 
+             toks' is the actual tokens (with positions and values) deleted,
+             (l,r) are the (leftmost,rightmost) position of toks', 
+             lp is what remains of the stream after deletion 
      *)
         fun do_delete(nil,lp as (TOKEN(_,(_,l,_)),_)) = SOME(nil,l,l,lp)
           | do_delete([t],(tok as TOKEN(t',(_,l,r)),lp')) =
-	       if t=t'
-		   then SOME([tok],l,r,Stream.get lp')
+               if eqT (t, t')
+                   then SOME([tok],l,r,Stream.get lp')
                    else NONE
-          | do_delete(t::rest,(tok as TOKEN(t',(_,l,_)),lp')) =
-	       if t=t'
-		   then case do_delete(rest,Stream.get lp')
-                         of SOME(deleted,_,r',lp'') =>
-			       SOME(tok::deleted,l,r',lp'')
-			  | NONE => NONE
-		   else NONE
-			     
+          | do_delete(t::rest,(tok as TOKEN(t',(_,l,r)),lp')) =
+               if eqT (t,t')
+                   then case do_delete(rest,Stream.get lp')
+                         of SOME(deleted,l',r',lp'') =>
+                               SOME(tok::deleted,l,r',lp'')
+                          | NONE => NONE
+                   else NONE
+                             
         fun tryPreferred((stack,lexPair),queuePos) =
-	    catList preferred_change (fn (delete,insert) =>
-	       if List.exists noShift delete then [] (* should give warning at
-						 parser-generation time *)
+            catList preferred_change (fn (delete,insert) =>
+               if List.exists noShift delete then [] (* should give warning at
+                                                 parser-generation time *)
                else case do_delete(delete,lexPair)
                      of SOME(deleted,l,r,lp) => 
-			    tryChange{lex=lp,stack=stack,pos=queuePos,
-				      leftPos=l,rightPos=r,orig=deleted,
-				      new=map (fn t=>(tokAt(t,r))) insert}
-		      | NONE => [])
+                            tryChange{lex=lp,stack=stack,pos=queuePos,
+                                      leftPos=l,rightPos=r,orig=deleted,
+                                      new=map (fn t=>(tokAt(t,r))) insert}
+                      | NONE => [])
 
-	val changes = catList numStateList tryPreferred @
-	                catList numStateList tryInsert @
-			  catList numStateList trySubst @
-			    catList numStateList (tryDelete 1) @
-			      catList numStateList (tryDelete 2) @
-			        catList numStateList (tryDelete 3)
+        val changes = catList numStateList tryPreferred @
+                        catList numStateList tryInsert @
+                          catList numStateList trySubst @
+                            catList numStateList (tryDelete 1) @
+                              catList numStateList (tryDelete 2) @
+                                catList numStateList (tryDelete 3)
 
-	val findMaxDist = fn l => 
-	  foldr (fn (CHANGE {distance,...},high) => Int.max(distance,high)) 0 l
+        val findMaxDist = fn l => 
+          foldr (fn (CHANGE {distance,...},high) => Int.max(distance,high)) 0 l
 
 (* maxDist: max distance past error taken that we could parse *)
 
-	val maxDist = findMaxDist changes
+        val maxDist = findMaxDist changes
 
 (* remove changes which did not parse maxDist tokens past the error token *)
 
         val changes = catList changes 
-	      (fn(c as CHANGE{distance,...}) => 
-		  if distance=maxDist then [c] else [])
+              (fn(c as CHANGE{distance,...}) => 
+                  if distance=maxDist then [c] else [])
 
       in case changes 
-	  of (l as change :: _) =>
-	      let fun print_msg (CHANGE {new,orig,leftPos,rightPos,...}) =
-		  let val s = 
-		      case (orig,new)
-			  of (_::_,[]) => "deleting " ^ (showTerms orig)
-	                   | ([],_::_) => "inserting " ^ (showTerms new)
-			   | _ => "replacing " ^ (showTerms orig) ^
-				 " with " ^ (showTerms new)
-		  in error ("syntax error: " ^ s,leftPos,rightPos)
-		  end
-		   
-		  val _ = 
-		      (if length l > 1 andalso DEBUG2 then
-			   (print "multiple fixes possible; could fix it by:\n";
-			    app print_msg l;
-			    print "chosen correction:\n")
-		       else ();
-		       print_msg change)
+          of (l as change :: _) =>
+              let fun print_msg (CHANGE {new,orig,leftPos,rightPos,...}) =
+                  let val s = 
+                      case (orig,new)
+                          of (_::_,[]) => "deleting " ^ (showTerms orig)
+                           | ([],_::_) => "inserting " ^ (showTerms new)
+                           | _ => "replacing " ^ (showTerms orig) ^
+                                 " with " ^ (showTerms new)
+                  in error ("syntax error: " ^ s,leftPos,rightPos)
+                  end
+                   
+                  val _ = 
+                      (if length l > 1 andalso DEBUG2 then
+                           (print "multiple fixes possible; could fix it by:\n";
+                            app print_msg l;
+                            print "chosen correction:\n")
+                       else ();
+                       print_msg change)
 
-		  (* findNth: find nth queue entry from the error
-		   entry.  Returns the Nth queue entry and the  portion of
-		   the queue from the beginning to the nth-1 entry.  The
-		   error entry is at the end of the queue.
+                  (* findNth: find nth queue entry from the error
+                   entry.  Returns the Nth queue entry and the  portion of
+                   the queue from the beginning to the nth-1 entry.  The
+                   error entry is at the end of the queue.
 
-		   Examples:
+                   Examples:
 
-		   queue = a b c d e
-		   findNth 0 = (e,a b c d)
-		   findNth 1 =  (d,a b c)
-		   *)
+                   queue = a b c d e
+                   findNth 0 = (e,a b c d)
+                   findNth 1 =  (d,a b c)
+                   *)
 
-		  val findNth = fn n =>
-		      let fun f (h::t,0) = (h,rev t)
-			    | f (_::t,n) = f(t,n-1)
-			    | f (nil,_) = let exception FindNth
-					  in raise FindNth
-					  end
-		      in f (rev stateList,n)
-		      end
-		
-		  val CHANGE {pos,orig,new,...} = change
-		  val (last,queueFront) = findNth pos
-		  val (stack,lexPair) = last
+                  val findNth = fn n =>
+                      let fun f (h::t,0) = (h,rev t)
+                            | f (h::t,n) = f(t,n-1)
+                            | f (nil,_) = let exception FindNth
+                                          in raise FindNth
+                                          end
+                      in f (rev stateList,n)
+                      end
+                
+                  val CHANGE {pos,orig,new,...} = change
+                  val (last,queueFront) = findNth pos
+                  val (stack,lexPair) = last
 
-		  val lp1 = foldl(fn (_,(_,r)) => Stream.get r) lexPair orig
-		  val lp2 = foldr(fn(t,r)=>(t,Stream.cons r)) lp1 new
+                  val lp1 = foldl(fn (_,(_,r)) => Stream.get r) lexPair orig
+                  val lp2 = foldr(fn(t,r)=>(t,Stream.cons r)) lp1 new
 
-		  val restQueue = 
-		      Fifo.put((stack,lp2),
-			       foldl Fifo.put Fifo.empty queueFront)
+                  val restQueue = 
+                      Fifo.put((stack,lp2),
+                               foldl Fifo.put Fifo.empty queueFront)
 
-		  val (lexPair,stack,queue,_,_) =
-		      distanceParse(lp2,stack,restQueue,pos)
+                  val (lexPair,stack,queue,_,_) =
+                      distanceParse(lp2,stack,restQueue,pos)
 
-	      in (lexPair,stack,queue)
-	      end
-	| nil => (error("syntax error found at " ^ (showTerminal term),
-			leftPos,leftPos); raise ParseError)
+              in (lexPair,stack,queue)
+              end
+        | nil => (error("syntax error found at " ^ (showTerminal term),
+                        leftPos,leftPos); raise ParseError)
     end
 
    val parse = fn {arg,table,lexer,saction,void,lookahead,
-		   ec=ec as {showTerminal,...} : ('_a,'_b) ecRecord} =>
-	let val distance = 15   (* defer distance tokens *)
-	    val minAdvance = 1  (* must parse at least 1 token past error *)
-	    val maxAdvance = Int.max(lookahead,0)(* max distance for parse check *)
-	    val lexPair = Stream.get lexer
-	    val (TOKEN (_,(_,leftPos,_)),_) = lexPair
-	    val startStack = [(initialState table,(void,leftPos,leftPos))]
-	    val startQueue = Fifo.put((startStack,lexPair),Fifo.empty)
-	    val distanceParse = distanceParse(table,showTerminal,saction,arg)
-	    val fixError = mkFixError(ec,distanceParse,minAdvance,maxAdvance)
-	    val ssParse = ssParse(table,showTerminal,saction,fixError,arg)
-	    fun loop (lexPair,stack,queue,_,SOME ACCEPT) =
-		   ssParse(lexPair,stack,queue)
-	      | loop (lexPair,stack,queue,0,_) = ssParse(lexPair,stack,queue)
-	      | loop (lexPair,stack,queue,distance,SOME ERROR) =
-		 let val (lexPair,stack,queue) = fixError(lexPair,stack,queue)
-		 in loop (distanceParse(lexPair,stack,queue,distance))
-		 end
-	      | loop _ = let exception ParseInternal
-			 in raise ParseInternal
-			 end
-	in loop (distanceParse(lexPair,startStack,startQueue,distance))
-	end
+                   ec=ec as {showTerminal,...} : ('_a,'_b) ecRecord} =>
+        let val distance = 15   (* defer distance tokens *)
+            val minAdvance = 1  (* must parse at least 1 token past error *)
+            val maxAdvance = Int.max(lookahead,0)(* max distance for parse check *)
+            val lexPair = Stream.get lexer
+            val (TOKEN (_,(_,leftPos,_)),_) = lexPair
+            val startStack = [(initialState table,(void,leftPos,leftPos))]
+            val startQueue = Fifo.put((startStack,lexPair),Fifo.empty)
+            val distanceParse = distanceParse(table,showTerminal,saction,arg)
+            val fixError = mkFixError(ec,distanceParse,minAdvance,maxAdvance)
+            val ssParse = ssParse(table,showTerminal,saction,fixError,arg)
+            fun loop (lexPair,stack,queue,_,SOME ACCEPT) =
+                   ssParse(lexPair,stack,queue)
+              | loop (lexPair,stack,queue,0,_) = ssParse(lexPair,stack,queue)
+              | loop (lexPair,stack,queue,distance,SOME ERROR) =
+                 let val (lexPair,stack,queue) = fixError(lexPair,stack,queue)
+                 in loop (distanceParse(lexPair,stack,queue,distance))
+                 end
+              | loop _ = let exception ParseInternal
+                         in raise ParseInternal
+                         end
+        in loop (distanceParse(lexPair,startStack,startQueue,distance))
+        end
  end;
 
-(* drt (12/15/89) -- needed only when the code above is functorized
-
-structure LrParser = ParserGen(structure LrTable=LrTable
-			     structure Stream=Stream);
-*)

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlyacc/sources.cm
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlyacc/sources.cm	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlyacc/sources.cm	2006-02-16 19:34:54 UTC (rev 4361)
@@ -30,4 +30,4 @@
 join.sml
 lrtable.sml
 stream.sml
-parser2.sml	(* error correcting version *)
+parser2.sml     (* error correcting version *)

Modified: mlton/branches/on-20050420-cmm-branch/lib/mlyacc/stream.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/mlyacc/stream.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/mlyacc/stream.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,16 +1,4 @@
-(* ML-Yacc Parser Generator (c) 1989 Andrew W. Appel, David R. Tarditi 
- *
- * $Log: stream.sml,v $
- * Revision 1.2  1997/08/26 19:18:55  jhr
- *   Replaced used of "abstraction" with ":>".
- *
-# Revision 1.1.1.1  1997/01/14  01:38:04  george
-#   Version 109.24
-#
- * Revision 1.1.1.1  1996/01/31  16:01:43  george
- * Version 109
- * 
- *)
+(* ML-Yacc Parser Generator (c) 1989 Andrew W. Appel, David R. Tarditi *)
 
 (* Stream: a structure implementing a lazy stream.  The signature STREAM
    is found in base.sig *)
@@ -23,7 +11,7 @@
 
    fun get(ref(EVAL t)) = t
      | get(s as ref(UNEVAL f)) = 
-	    let val t = (f(), ref(UNEVAL f)) in s := EVAL t; t end
+            let val t = (f(), ref(UNEVAL f)) in s := EVAL t; t end
 
    fun streamify f = ref(UNEVAL f)
    fun cons(a,s) = ref(EVAL(a,s))


Property changes on: mlton/branches/on-20050420-cmm-branch/lib/opengl
___________________________________________________________________
Name: svn:ignore
   - GLUT_h.h
GLU_h.h
GL_h.h
atom
bits
blender
hello
menus
molehill
points
shortest
solar
spin_cube
triangle
   + GLUT_h.h
GLU_h.h
GL_h.h
atom
bits
blender
hello
menus
molehill
points
shortest
solar
spin_cube
triangle


Deleted: mlton/branches/on-20050420-cmm-branch/lib/opengl/.cvsignore
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/opengl/.cvsignore	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/opengl/.cvsignore	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,14 +0,0 @@
-GLUT_h.h
-GLU_h.h
-GL_h.h
-atom
-bits
-blender
-hello
-menus
-molehill
-points
-shortest
-solar
-spin_cube
-triangle

Copied: mlton/branches/on-20050420-cmm-branch/lib/opengl/.ignore (from rev 4358, mlton/trunk/lib/opengl/.ignore)

Modified: mlton/branches/on-20050420-cmm-branch/lib/opengl/GLUT.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/opengl/GLUT.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/opengl/GLUT.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -251,7 +251,7 @@
         val GLUT_GAME_MODE_REFRESH_RATE : GL.GLenum
         val GLUT_GAME_MODE_DISPLAY_CHANGED : GL.GLenum
 
-	val glutGetModifiers : unit -> GL.GLenum;
+        val glutGetModifiers : unit -> GL.GLenum;
 
         val glutCreateMenu : (int -> unit) -> int
         val glutDestroyMenu : int -> unit
@@ -279,8 +279,8 @@
         val glutInitWindowPosition : int -> int -> unit
         val glutInitWindowSize : int -> int -> unit
         val glutCreateWindow: string -> int;
-	val glutCreateSubWindow: int -> int -> int -> int -> int -> int;
-	val glutDestroyWindow: int -> unit;
+        val glutCreateSubWindow: int -> int -> int -> int -> int -> int;
+        val glutDestroyWindow: int -> unit;
         val glutMainLoop: unit -> unit;
         val glutBitmapCharacter : glutfont -> char -> unit
         val glutPostRedisplay : unit -> unit

Modified: mlton/branches/on-20050420-cmm-branch/lib/opengl/GLUT.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/opengl/GLUT.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/opengl/GLUT.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -243,35 +243,35 @@
 
 
             (* Create Menu callback *)
-            val gCreateMenuFA = _export "glutCreateMenuArgument": int -> unit;
+            val gCreateMenuFA = _export "glutCreateMenuArgument": (int -> unit) -> unit;
             val callGCreateMenuF = _import "callGlutCreateMenu": unit -> int;
 
             (* Display function callback *)
-            val gDisplayFA = _export "glutDisplayFuncArgument": unit -> unit;
+            val gDisplayFA = _export "glutDisplayFuncArgument": (unit -> unit) -> unit;
             val callGDisplayF = _import "callGlutDisplayFunc": unit -> unit;
 
             (* Idle function callback *)
-            val gIdleFA = _export "glutIdleFuncArgument": unit -> unit;
+            val gIdleFA = _export "glutIdleFuncArgument": (unit -> unit) -> unit;
             val callGIdleF = _import "callGlutIdleFunc": unit -> unit;
 
             (* Reshape function callback *)
-            val gReshapeFA = _export "glutReshapeFuncArgument": int * int -> unit;
+            val gReshapeFA = _export "glutReshapeFuncArgument": (int * int -> unit) -> unit;
             val callGReshapeF = _import "callGlutReshapeFunc": unit -> unit;
 
             (* Keyboard function callback *)
-            val gKbdFA = _export "glutKeyboardFuncArgument": char * int * int -> unit;
+            val gKbdFA = _export "glutKeyboardFuncArgument": (char * int * int -> unit) -> unit;
             val callGKbdF = _import "callGlutKeyboardFunc": unit -> unit;
 
             (* Mouse function callback *)
-            val gMouseFA = _export "glutMouseFuncArgument": GLenum * GLenum * int * int -> unit;
+            val gMouseFA = _export "glutMouseFuncArgument": (GLenum * GLenum * int * int -> unit) -> unit;
             val callGMouseF = _import "callGlutMouseFunc": unit -> unit;
 
             (* Special function callback *)
-            val gSpecFA = _export "glutSpecialFuncArgument": int * int * int -> unit;
+            val gSpecFA = _export "glutSpecialFuncArgument": (int * int * int -> unit) -> unit;
             val callGSpecF = _import "callGlutSpecialFunc": unit -> unit;
 
             (* Visibility function callback *)
-            val gVisibilityFA = _export "glutVisibilityFuncArgument": Word32.word -> unit;
+            val gVisibilityFA = _export "glutVisibilityFuncArgument": (Word32.word -> unit) -> unit;
             val callGVisibilityF = _import "callGlutVisibilityFunc": unit -> unit;
 
 
@@ -319,7 +319,7 @@
             fun glutVisibilityFunc (vis: Word32.word -> unit) = ( gVisibilityFA vis; callGVisibilityF ())
 
             val c_glutGetModifiers = _import "glutGetModifiers" stdcall: unit -> GL.GLenum;
-	    fun glutGetModifiers () = c_glutGetModifiers () :  GL.GLenum;
+            fun glutGetModifiers () = c_glutGetModifiers () :  GL.GLenum;
 
             val c_glutDestroyMenu = _import "glutDestroyMenu" stdcall: int -> unit;
             fun glutDestroyMenu (a:int) = c_glutDestroyMenu (a): unit;
@@ -369,10 +369,10 @@
 
             val glutCreateWindow = _import "glutCreateWindow" stdcall: string -> int;
 
-	    val c_glutCreateSubWindow = _import "glutCreateSubWindow" stdcall: int * int * int * int * int -> int;
-	    fun glutCreateSubWindow (a:int) (b:int) (c:int) (d:int) (e:int) = c_glutCreateSubWindow (a, b, c, d, e) :int
+            val c_glutCreateSubWindow = _import "glutCreateSubWindow" stdcall: int * int * int * int * int -> int;
+            fun glutCreateSubWindow (a:int) (b:int) (c:int) (d:int) (e:int) = c_glutCreateSubWindow (a, b, c, d, e) :int
 
-	    val glutDestroyWindow = _import "glutDestroyWindow" stdcall: int -> unit;
+            val glutDestroyWindow = _import "glutDestroyWindow" stdcall: int -> unit;
 
             val glutMainLoop = _import "glutMainLoop" stdcall: unit -> unit;
 

Modified: mlton/branches/on-20050420-cmm-branch/lib/opengl/GLUT_c.c
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/opengl/GLUT_c.c	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/opengl/GLUT_c.c	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,6 +1,5 @@
 /* Glut-export.c */
-#include <GL/gl.h>
-#include <GL/glut.h>
+#include "platform.h"
 #include "GLUT_h.h"
 
 int callGlutCreateMenu ()
@@ -60,7 +59,7 @@
 {
   return ((Pointer) GLUT_STROKE_MONO_ROMAN);
 }
-	    
+            
 Pointer mlton_glut_bitmap_9_by_15(void)
 {
   return ((Pointer) GLUT_BITMAP_9_BY_15);

Modified: mlton/branches/on-20050420-cmm-branch/lib/opengl/GLU_c.c
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/opengl/GLU_c.c	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/opengl/GLU_c.c	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,5 +1,5 @@
 /* GLU-export.c */
-#include <GL/glu.h>
+#include "platform.h"
 #include "GLU_h.h"
 
 

Modified: mlton/branches/on-20050420-cmm-branch/lib/opengl/GL_c.c
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/opengl/GL_c.c	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/opengl/GL_c.c	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,5 +1,5 @@
 /* Gl-export.c */
-#include <GL/gl.h>
+#include "platform.h"
 #include "GL_h.h"
 
 

Modified: mlton/branches/on-20050420-cmm-branch/lib/opengl/Makefile
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/opengl/Makefile	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/opengl/Makefile	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,8 +1,8 @@
 mlton = mlton
 MLTON_FLAGS = \
-	-default-ann 'allowExport true' \
-	-default-ann 'allowImport true' \
+	-default-ann 'allowFFI true' \
 	-target-link-opt cygwin '-L/lib/w32api -lglut32 -lglu32 -lopengl32' \
+        -target-link-opt darwin '-framework GLUT -framework OpenGL -framework Foundation' \
 	-target-link-opt linux '-lglut -lGLU -lGL'
 
 GL_OBJS  = GL_c.o GLUT_c.o

Modified: mlton/branches/on-20050420-cmm-branch/lib/opengl/atom.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/opengl/atom.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/opengl/atom.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -11,45 +11,45 @@
 
 fun changeSize ((width : int), (height : int)) : unit = 
     let 
-	val nRange    = ref 100.0
-	val h =
-	    Real.fromInt (if height = 0 then 
-			      1
-			  else 
-			      height)
-	val w = Real.fromInt (width)
+        val nRange    = ref 100.0
+        val h =
+            Real.fromInt (if height = 0 then 
+                              1
+                          else 
+                              height)
+        val w = Real.fromInt (width)
     in 
-	glViewport 0 0 (Real.trunc w) (Real.trunc h);
-	glMatrixMode GL_PROJECTION;
-	glLoadIdentity();
+        glViewport 0 0 (Real.trunc w) (Real.trunc h);
+        glMatrixMode GL_PROJECTION;
+        glLoadIdentity();
 
-	if w <= h then
-	     glOrtho (~(!nRange)) 
-	             (!nRange) 
-		     (~(!nRange) * h / w)
-		     (!nRange * h / w)
-		     (~(!nRange))
-		     (!nRange)
-	else
-	     glOrtho (~(!nRange) * w / h)
-		     (!nRange * w / h) 
-		     (~(!nRange)) 
-		     (!nRange) 
-		     (~(!nRange))
-		     (!nRange);
-	     glMatrixMode(GL_MODELVIEW);
-	     glLoadIdentity()
+        if w <= h then
+             glOrtho (~(!nRange)) 
+                     (!nRange) 
+                     (~(!nRange) * h / w)
+                     (!nRange * h / w)
+                     (~(!nRange))
+                     (!nRange)
+        else
+             glOrtho (~(!nRange) * w / h)
+                     (!nRange * w / h) 
+                     (~(!nRange)) 
+                     (!nRange) 
+                     (~(!nRange))
+                     (!nRange);
+             glMatrixMode(GL_MODELVIEW);
+             glLoadIdentity()
     end
 
 fun initialise () =
     (
-     glutInit;
+     glutInit();
      glutInitDisplayMode (GLUT_DOUBLE + GLUT_RGBA);
      glutInitWindowPosition 100 100;
      glutInitWindowSize 250 250;
      glutCreateWindow "Atom";
      glEnable GL_DEPTH_TEST;
-     glFrontFace GL_CCW;	
+     glFrontFace GL_CCW;        
      glEnable GL_CULL_FACE;
      glEnable GL_LIGHTING;
      glLightModelfv GL_LIGHT_MODEL_AMBIENT whiteLight;
@@ -63,63 +63,63 @@
 
 fun renderScene () =
     (
-	glClear (GL_COLOR_BUFFER_BIT + GL_DEPTH_BUFFER_BIT);
-	glMatrixMode GL_MODELVIEW;
-	glLoadIdentity();
-	glTranslatef 0.0 0.0 ~100.0;
-	glColor3d 1.0 0.0 0.0;
-	glutSolidSphere 10.0 20 20;
-	glColor3d 1.0 1.0 0.0 ;
+        glClear (GL_COLOR_BUFFER_BIT + GL_DEPTH_BUFFER_BIT);
+        glMatrixMode GL_MODELVIEW;
+        glLoadIdentity();
+        glTranslatef 0.0 0.0 ~100.0;
+        glColor3d 1.0 0.0 0.0;
+        glutSolidSphere 10.0 20 20;
+        glColor3d 1.0 1.0 0.0 ;
 
-	glPushMatrix();
-	glRotatef (!fElect1) 0.0 1.0 0.0;
-	glTranslatef 90.0 0.0 0.0;
-	glutSolidSphere 6.0 20 20;
-	glPopMatrix();
+        glPushMatrix();
+        glRotatef (!fElect1) 0.0 1.0 0.0;
+        glTranslatef 90.0 0.0 0.0;
+        glutSolidSphere 6.0 20 20;
+        glPopMatrix();
 
-	glPushMatrix();
-	glRotatef 45.0 0.0 0.0 1.0;
-	glRotatef (!fElect1) 0.0 1.0 0.0;
-	glTranslatef ~70.0 0.0 0.0;
-	glutSolidSphere 6.0 20 20;
-	glPopMatrix();
-	
-	glPushMatrix();
-	glRotatef 315.0 0.0 0.0 1.0;
-	glRotatef (!fElect1) 0.0 1.0 0.0;
-	glTranslatef 0.0 0.0 60.0;
-	glutSolidSphere 6.0 20 20;
-	glPopMatrix();
+        glPushMatrix();
+        glRotatef 45.0 0.0 0.0 1.0;
+        glRotatef (!fElect1) 0.0 1.0 0.0;
+        glTranslatef ~70.0 0.0 0.0;
+        glutSolidSphere 6.0 20 20;
+        glPopMatrix();
+        
+        glPushMatrix();
+        glRotatef 315.0 0.0 0.0 1.0;
+        glRotatef (!fElect1) 0.0 1.0 0.0;
+        glTranslatef 0.0 0.0 60.0;
+        glutSolidSphere 6.0 20 20;
+        glPopMatrix();
 
-	fElect1 := !fElect1 + 10.0;
-	if (!fElect1 > 360.0) then
-	    fElect1 := 0.0
-	else
-	    ();
-	glFlush();
-	glutSwapBuffers()
+        fElect1 := !fElect1 + 10.0;
+        if (!fElect1 > 360.0) then
+            fElect1 := 0.0
+        else
+            ();
+        glFlush();
+        glutSwapBuffers()
     )
 
 fun limitXRot() : unit =
     (
      if !xRot > 356.0 then
-	 xRot := 0.0
+         xRot := 0.0
      else
-	  if !xRot < ~1.0 then
-	      xRot := 355.0
-	  else
-	      ()
+          if !xRot < ~1.0 then
+              xRot := 355.0
+          else
+              ()
      )
 
 fun limitYRot() : unit =
     (
      if !yRot > 356.0 then
-	 yRot := 0.0
+         yRot := 0.0
      else
-	  if !yRot < ~1.0 then
-	      yRot := 355.0
-	  else
-	      ()
+          if !yRot < ~1.0 then
+              yRot := 355.0
+          else
+              ()
      )
 
 fun main () = 

Modified: mlton/branches/on-20050420-cmm-branch/lib/opengl/bits.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/opengl/bits.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/opengl/bits.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -11,71 +11,71 @@
      (
       (*print ("randrange: n = " ^ (Real.toString(n)) ^ "; r1 = " ^ (Word.toString (r1)) ^ "\n");*)
       let val r = Real.toInt IEEEReal.TO_NEAREST 
-			     ((Real.fromLargeInt (Word.toLargeInt r1)) * n / 4294976295.0)
+                             ((Real.fromLargeInt (Word.toLargeInt r1)) * n / 4294976295.0)
       in 
-	  (
-	   (*print ("randrand: n = " ^ (Int.toString(in1)) ^ "; r = " ^ (Int.toString (r)) ^ "\n");*)
-	   r
-	   )
+          (
+           (*print ("randrand: n = " ^ (Int.toString(in1)) ^ "; r = " ^ (Int.toString (r)) ^ "\n");*)
+           r
+           )
       end
-	  )
+          )
  end
 )
 fun redraw w h =
     let 
-	val smiley = [
-		      0wx03, 0wxc0, 0wx0, 0wx0, (*       ****       *)
-		      0wx0f, 0wxf0, 0wx0, 0wx0, (*     ********     *)
-		      0wx1e, 0wx78, 0wx0, 0wx0, (*    ****  ****    *)
-		      0wx39, 0wx9c, 0wx0, 0wx0, (*   ***  **  ***   *)
-		      0wx77, 0wxee, 0wx0, 0wx0, (*  *** ****** ***  *)
-		      0wx6f, 0wxf6, 0wx0, 0wx0, (*  ** ******** **  *)
-		      0wxff, 0wxff, 0wx0, 0wx0, (* **************** *)
-		      0wxff, 0wxff, 0wx0, 0wx0, (* **************** *)
-		      0wxff, 0wxff, 0wx0, 0wx0, (* **************** *)
-		      0wxff, 0wxff, 0wx0, 0wx0, (* **************** *)
-		      0wx73, 0wxce, 0wx0, 0wx0, (*  ***  ****  ***  *)
-		      0wx73, 0wxce, 0wx0, 0wx0, (*  ***  ****  ***  *)
-		      0wx3f, 0wxfc, 0wx0, 0wx0, (*   ************   *)
-		      0wx1f, 0wxf8, 0wx0, 0wx0, (*    **********    *)
-		      0wx0f, 0wxf0, 0wx0, 0wx0, (*     ********     *)
-		      0wx03, 0wxc0, 0wx0, 0wx0  (*       ****       *)
-		      ]
-	fun doSome 0 w h = ()
-	  | doSome n w h =
-	    let
-		val ranx = randrange (w-1)
-		val rany = randrange (h-1)
-		val r = Real32.fromInt ( randrange 255 ) / 255.0
-		val g = Real32.fromInt ( randrange 255 ) / 255.0
-		val b = Real32.fromInt ( randrange 255 ) / 255.0
-	    in  
-		glColor3f r g b;
-		glRasterPos2i ranx rany;
-		glBitmap 16 16 8.0 8.0 0.0 0.0 
-		         (Word8Vector.fromList smiley);
-	        doSome (n-1) w h
-	    end
+        val smiley = [
+                      0wx03, 0wxc0, 0wx0, 0wx0, (*       ****       *)
+                      0wx0f, 0wxf0, 0wx0, 0wx0, (*     ********     *)
+                      0wx1e, 0wx78, 0wx0, 0wx0, (*    ****  ****    *)
+                      0wx39, 0wx9c, 0wx0, 0wx0, (*   ***  **  ***   *)
+                      0wx77, 0wxee, 0wx0, 0wx0, (*  *** ****** ***  *)
+                      0wx6f, 0wxf6, 0wx0, 0wx0, (*  ** ******** **  *)
+                      0wxff, 0wxff, 0wx0, 0wx0, (* **************** *)
+                      0wxff, 0wxff, 0wx0, 0wx0, (* **************** *)
+                      0wxff, 0wxff, 0wx0, 0wx0, (* **************** *)
+                      0wxff, 0wxff, 0wx0, 0wx0, (* **************** *)
+                      0wx73, 0wxce, 0wx0, 0wx0, (*  ***  ****  ***  *)
+                      0wx73, 0wxce, 0wx0, 0wx0, (*  ***  ****  ***  *)
+                      0wx3f, 0wxfc, 0wx0, 0wx0, (*   ************   *)
+                      0wx1f, 0wxf8, 0wx0, 0wx0, (*    **********    *)
+                      0wx0f, 0wxf0, 0wx0, 0wx0, (*     ********     *)
+                      0wx03, 0wxc0, 0wx0, 0wx0  (*       ****       *)
+                      ]
+        fun doSome 0 w h = ()
+          | doSome n w h =
+            let
+                val ranx = randrange (w-1)
+                val rany = randrange (h-1)
+                val r = Real32.fromInt ( randrange 255 ) / 255.0
+                val g = Real32.fromInt ( randrange 255 ) / 255.0
+                val b = Real32.fromInt ( randrange 255 ) / 255.0
+            in  
+                glColor3f r g b;
+                glRasterPos2i ranx rany;
+                glBitmap 16 16 8.0 8.0 0.0 0.0 
+                         (Word8Vector.fromList smiley);
+                doSome (n-1) w h
+            end
     in
-	glViewport 0 0 w h;
-	glClearColor 0.0 0.0 0.0 1.0;
-	glClear GL_COLOR_BUFFER_BIT;
-	glMatrixMode GL_PROJECTION;
-	glLoadIdentity();
-	glOrtho 0.0 
+        glViewport 0 0 w h;
+        glClearColor 0.0 0.0 0.0 1.0;
+        glClear GL_COLOR_BUFFER_BIT;
+        glMatrixMode GL_PROJECTION;
+        glLoadIdentity();
+        glOrtho 0.0 
                 ((Real.fromInt w) - 1.0) 
                 0.0 
                 ((Real.fromInt h) - 1.0) 
                 ~1.0 
                 1.0;
 
-	(*
-	 * This bitmap is aligned to 4-byte boundaries...
-	 *)
+        (*
+         * This bitmap is aligned to 4-byte boundaries...
+         *)
 
-	glPixelTransferi GL_UNPACK_ALIGNMENT 4;
-	doSome 200 w h;
-	glFinish()
+        glPixelTransferi GL_UNPACK_ALIGNMENT 4;
+        doSome 200 w h;
+        glFinish()
     end
 
 fun display () =
@@ -94,30 +94,30 @@
 
 fun mouseLMB (state : Word.word) : unit = 
     if (state = GLUT_DOWN) then
-	(
-	 )
+        (
+         )
     else 
-	()
+        ()
 
 fun mouseRMB (state : Word.word) : unit = 
     if state = GLUT_DOWN then
-	(
-	 )
+        (
+         )
     else
-	()
+        ()
 
 fun mouse ((button:GLenum), (state:GLenum), (x:int), (y:int)):unit =
     if button = GLUT_LEFT_BUTTON then
-	mouseLMB state
+        mouseLMB state
     else
-	if button = GLUT_MIDDLE_BUTTON orelse button = GLUT_RIGHT_BUTTON then
-	    mouseRMB state
-	else
-	    ()
+        if button = GLUT_MIDDLE_BUTTON orelse button = GLUT_RIGHT_BUTTON then
+            mouseRMB state
+        else
+            ()
 
 fun keyboard ((key:char), (x:int), (y:int)) =
     case key 
-	of #"\u001b" => (OS.Process.exit OS.Process.success) 
+        of #"\u001b" => (OS.Process.exit OS.Process.success) 
       | _ => print (Char.toString key)
 
 

Modified: mlton/branches/on-20050420-cmm-branch/lib/opengl/blender.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/opengl/blender.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/opengl/blender.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -28,56 +28,56 @@
 fun display () :unit =
     (
      let 
-	 val a = (Real32.fromLarge IEEEReal.TO_NEAREST (Math.cos ( !s ) / 2.0 + 0.5))
-	 val b = (Real32.fromLarge IEEEReal.TO_NEAREST (0.5 - Math.cos ( !s * 0.95 ) / 2.0))
+         val a = (Real32.fromLarge IEEEReal.TO_NEAREST (Math.cos ( !s ) / 2.0 + 0.5))
+         val b = (Real32.fromLarge IEEEReal.TO_NEAREST (0.5 - Math.cos ( !s * 0.95 ) / 2.0))
      in
-	 glClear ( GL_COLOR_BUFFER_BIT + GL_DEPTH_BUFFER_BIT );
-	 glEnable GL_LIGHT1;
-	 glDisable GL_LIGHT2;
-	 glMaterialfv GL_FRONT GL_AMBIENT (Array.fromList (amb@[a]));
-	 glMaterialfv GL_FRONT GL_DIFFUSE (Array.fromList (dif@[a]));
+         glClear ( GL_COLOR_BUFFER_BIT + GL_DEPTH_BUFFER_BIT );
+         glEnable GL_LIGHT1;
+         glDisable GL_LIGHT2;
+         glMaterialfv GL_FRONT GL_AMBIENT (Array.fromList (amb@[a]));
+         glMaterialfv GL_FRONT GL_DIFFUSE (Array.fromList (dif@[a]));
 
-	 glPushMatrix ();
-	 glTranslatef (~0.3) (~0.3) 0.0;
-	 glRotatef (!angle1) 1.0 5.0 0.0;
-	 glCallList 1;        (* render ico display list *)
-	 glPopMatrix();
+         glPushMatrix ();
+         glTranslatef (~0.3) (~0.3) 0.0;
+         glRotatef (!angle1) 1.0 5.0 0.0;
+         glCallList 1;        (* render ico display list *)
+         glPopMatrix();
 
-	 glClear GL_DEPTH_BUFFER_BIT;
-	 glEnable GL_LIGHT2 ;
-	 glDisable GL_LIGHT1 ;
-	 glMaterialfv GL_FRONT GL_AMBIENT (Array.fromList (amb@[b]));
-	 glMaterialfv GL_FRONT GL_DIFFUSE (Array.fromList (dif@[b]));
+         glClear GL_DEPTH_BUFFER_BIT;
+         glEnable GL_LIGHT2 ;
+         glDisable GL_LIGHT1 ;
+         glMaterialfv GL_FRONT GL_AMBIENT (Array.fromList (amb@[b]));
+         glMaterialfv GL_FRONT GL_DIFFUSE (Array.fromList (dif@[b]));
 
-	 glPushMatrix();
-	 glTranslatef 0.3 0.3 0.0;
-	 glRotatef (!angle2) 1.0 0.0 5.0;
-	 glCallList 1;        (* render ico display list *)
-	 glPopMatrix();
+         glPushMatrix();
+         glTranslatef 0.3 0.3 0.0;
+         glRotatef (!angle2) 1.0 0.0 5.0;
+         glCallList 1;        (* render ico display list *)
+         glPopMatrix();
 
-	 glPushAttrib GL_ENABLE_BIT;
-	 glDisable GL_DEPTH_TEST;
-	 glDisable GL_LIGHTING;
-	 glMatrixMode GL_PROJECTION;
-	 glPushMatrix();
-	 glLoadIdentity();
-	 gluOrtho2D 0.0 1500.0 0.0 1500.0;
-	 glMatrixMode GL_MODELVIEW;
-	 glPushMatrix();
-	 glLoadIdentity();
-	 (* Rotate text slightly to help show jaggies. *)
-	 glRotatef 4.0 0.0 0.0 1.0;
-	 output 200.0 225.0 "This is antialiased.";
-	 glDisable GL_LINE_SMOOTH;
-	 glDisable GL_BLEND;
-	 output 160.0 100.0 "This text is not.";
-	 glPopMatrix ();
-	 glMatrixMode GL_PROJECTION;
-	 glPopMatrix();
-	 glPopAttrib();
-	 glMatrixMode GL_MODELVIEW;
+         glPushAttrib GL_ENABLE_BIT;
+         glDisable GL_DEPTH_TEST;
+         glDisable GL_LIGHTING;
+         glMatrixMode GL_PROJECTION;
+         glPushMatrix();
+         glLoadIdentity();
+         gluOrtho2D 0.0 1500.0 0.0 1500.0;
+         glMatrixMode GL_MODELVIEW;
+         glPushMatrix();
+         glLoadIdentity();
+         (* Rotate text slightly to help show jaggies. *)
+         glRotatef 4.0 0.0 0.0 1.0;
+         output 200.0 225.0 "This is antialiased.";
+         glDisable GL_LINE_SMOOTH;
+         glDisable GL_BLEND;
+         output 160.0 100.0 "This text is not.";
+         glPopMatrix ();
+         glMatrixMode GL_PROJECTION;
+         glPopMatrix();
+         glPopAttrib();
+         glMatrixMode GL_MODELVIEW;
 
-	 glutSwapBuffers()
+         glutSwapBuffers()
      end
 )
 
@@ -129,13 +129,13 @@
 
   glMatrixMode GL_PROJECTION;
   gluPerspective (* field of view in degree *) 40.0
-		 (* aspect ratio *) 1.0
-		 (* Z near *) 1.0
-		 (* Z far *) 10.0;
+                 (* aspect ratio *) 1.0
+                 (* Z near *) 1.0
+                 (* Z far *) 10.0;
   glMatrixMode GL_MODELVIEW;
   gluLookAt 0.0 0.0 5.0  (* eye is at (0,0,5) *)
-	    0.0 0.0 0.0      (* center is at (0,0,0) *)
-	    0.0 1.0 0.0;      (* up is in positive Y direction *)
+            0.0 0.0 0.0      (* center is at (0,0,0) *)
+            0.0 1.0 0.0;      (* up is in positive Y direction *)
   glTranslatef 0.0 0.6 (~1.0);
 
   glutMainLoop()

Modified: mlton/branches/on-20050420-cmm-branch/lib/opengl/hello.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/opengl/hello.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/opengl/hello.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -4,55 +4,55 @@
 
 fun bmstring (x : GLdouble) (y : GLdouble) (f : char -> unit) (s : string) =
     let 
-	val chars = String.explode s;
+        val chars = String.explode s;
     in
-	glColor3d 1.0 1.0 1.0;
-	glRasterPos2d x y;
-	(*glutBitmapCharacter GLUT_BITMAP_HELVETICA_10 65*)
-	map f chars
+        glColor3d 1.0 1.0 1.0;
+        glRasterPos2d x y;
+        (*glutBitmapCharacter GLUT_BITMAP_HELVETICA_10 65*)
+        map f chars
     end
 
 fun ststring (x : GLdouble) (y : GLdouble) (f : char -> unit) (s : string) =
     let 
-	val chars = String.explode s;
+        val chars = String.explode s;
     in
-	glColor3d 1.0 0.0 0.0;
-	glPushMatrix();
-	glTranslated x y 0.0;
-	map f chars;
-	glPopMatrix()
+        glColor3d 1.0 0.0 0.0;
+        glPushMatrix();
+        glTranslated x y 0.0;
+        map f chars;
+        glPopMatrix()
     end
 
 fun hello (x : GLdouble) (y : GLdouble) =
      let
-	 val f1 = 
-	     glutBitmapCharacter GLUT_BITMAP_HELVETICA_10
-	 val f2 = 
-	     glutBitmapCharacter GLUT_BITMAP_HELVETICA_12
-	 val f3 = 
-	     glutBitmapCharacter GLUT_BITMAP_HELVETICA_18
-	 val f4 = 
-	     glutBitmapCharacter GLUT_BITMAP_9_BY_15
-	 val f5 = 
-	     glutBitmapCharacter GLUT_BITMAP_8_BY_13
-	 val f6 = 
-	     glutBitmapCharacter GLUT_BITMAP_TIMES_ROMAN_10
-	 val f7 = 
-	     glutBitmapCharacter GLUT_BITMAP_TIMES_ROMAN_24
-	 val f8 = 
-	     glutStrokeCharacter GLUT_STROKE_ROMAN
-	 val f9 = 
-	     glutStrokeCharacter GLUT_STROKE_MONO_ROMAN
+         val f1 = 
+             glutBitmapCharacter GLUT_BITMAP_HELVETICA_10
+         val f2 = 
+             glutBitmapCharacter GLUT_BITMAP_HELVETICA_12
+         val f3 = 
+             glutBitmapCharacter GLUT_BITMAP_HELVETICA_18
+         val f4 = 
+             glutBitmapCharacter GLUT_BITMAP_9_BY_15
+         val f5 = 
+             glutBitmapCharacter GLUT_BITMAP_8_BY_13
+         val f6 = 
+             glutBitmapCharacter GLUT_BITMAP_TIMES_ROMAN_10
+         val f7 = 
+             glutBitmapCharacter GLUT_BITMAP_TIMES_ROMAN_24
+         val f8 = 
+             glutStrokeCharacter GLUT_STROKE_ROMAN
+         val f9 = 
+             glutStrokeCharacter GLUT_STROKE_MONO_ROMAN
      in
-	 bmstring x y f1 "Hello";
-	 bmstring (x-20.0) y f2 "Mike";
-	 bmstring (x-20.0) (y-30.0) f3 "Hello1";
-	 bmstring x (y-20.0) f4 "Mike1";
-	 bmstring (x-40.0) (y+10.0) f5 "Hello2";
-	 bmstring (x-40.0) (y-40.0) f6 "Mike2";
-	 bmstring (x-20.0) (y+20.0) f7 "Hello3";
-	 ststring (x-50.0) (y-50.0) f8 "Mike3";
-	 ststring (x-40.0) (y+40.0) f9 "Hello4"
+         bmstring x y f1 "Hello";
+         bmstring (x-20.0) y f2 "Mike";
+         bmstring (x-20.0) (y-30.0) f3 "Hello1";
+         bmstring x (y-20.0) f4 "Mike1";
+         bmstring (x-40.0) (y+10.0) f5 "Hello2";
+         bmstring (x-40.0) (y-40.0) f6 "Mike2";
+         bmstring (x-20.0) (y+20.0) f7 "Hello3";
+         ststring (x-50.0) (y-50.0) f8 "Mike3";
+         ststring (x-40.0) (y+40.0) f9 "Hello4"
      end
 
 fun display () =
@@ -64,21 +64,21 @@
 
 fun main () =
 ( 
-	 glutInit;
-	 glutInitDisplayMode (GLUT_SINGLE + GLUT_RGB);
-	 glutInitWindowSize 200 200;
-	 glutCreateWindow "Font Test";
-	 glMatrixMode (GL_PROJECTION);
-	 glLoadIdentity();
-	 gluOrtho2D (~50.0) 50.0 (~50.0) 50.0;
-	 glBlendFunc GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA;
-	 glEnable GL_BLEND;
-	 glEnable GL_LINE_SMOOTH;
-	 glLineWidth 2.0;
-	 glClearColor 0.0 0.0 0.0 1.0;
-	 glutDisplayFunc display;
-	 print("Click the close icon to close the window.");
-	 glutMainLoop()
+         glutInit();
+         glutInitDisplayMode (GLUT_SINGLE + GLUT_RGB);
+         glutInitWindowSize 200 200;
+         glutCreateWindow "Font Test";
+         glMatrixMode (GL_PROJECTION);
+         glLoadIdentity();
+         gluOrtho2D (~50.0) 50.0 (~50.0) 50.0;
+         glBlendFunc GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA;
+         glEnable GL_BLEND;
+         glEnable GL_LINE_SMOOTH;
+         glLineWidth 2.0;
+         glClearColor 0.0 0.0 0.0 1.0;
+         glutDisplayFunc display;
+         print("Click the close icon to close the window.");
+         glutMainLoop()
 )
 
 val _ = main();

Modified: mlton/branches/on-20050420-cmm-branch/lib/opengl/menus.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/opengl/menus.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/opengl/menus.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -15,125 +15,125 @@
 
 fun gokey (key : char) (x : int) (y : int) =
      let 
-	 val mods = glutGetModifiers()
-	 val altactive = Word.andb(mods, GLUT_ACTIVE_ALT)
+         val mods = glutGetModifiers()
+         val altactive = Word.andb(mods, GLUT_ACTIVE_ALT)
      in
-	 print("key = " ^ Char.toString(key) ^ "  mods = 0x" ^
-	       (Word.fmt StringCvt.HEX mods) ^ "\n");
-	 if GLUT_ACTIVE_ALT = altactive then
-	     case key of
-	     #"1" =>
-		 (
-		  print "Change to sub menu 1\n";
-		  glutChangeToSubMenu 1 "sub 1" (!submenu)
-		  )
-	   | #"2" =>
-		 (
-		  print "Change to sub menu 2\n";
-		  glutChangeToSubMenu 2 "sub 2" (!submenu)
-		  )
-	   | #"3" =>
-		 (
-		  print "Change to sub menu 3\n";
-		  glutChangeToSubMenu 3 "sub 3" (!submenu)
-		  )
-	   | #"4" =>
-		 (
-		  print "Change to sub menu 4\n";
-		  glutChangeToSubMenu 4 "sub 4" (!submenu)
-		  )
-	   | #"5" =>
-		 (
-		  print "Change to sub menu 5\n";
-		  glutChangeToSubMenu 5 "sub 5" (!submenu)
-		  )
-	   | _ =>
-		 (
-		  raise Fail "gokey 1"
-		      )
-	 else 
-	     case key of
-	     #"1" =>
-		 (
-		  print "Change to menu entry 1\n";
-		  glutChangeToMenuEntry 1 "entry 1" 1
-		  )
-	   | #"2" =>
-		 (
-		  print "Change to menu entry 2\n";
-		  glutChangeToMenuEntry 2 "entry 2" 2
-		  )
-	   | #"3" =>
-		 (
-		  print "Change to menu entry 3\n";
-		  glutChangeToMenuEntry 3 "entry 3" 3
-		  )
-	   | #"4" =>
-		 (
-		  print "Change to menu entry 4\n";
-		  glutChangeToMenuEntry 4 "entry 4" 4
-		  )
-	   | #"5" =>
-		 (
-		  print "Change to menu entry 5\n";
-		  glutChangeToMenuEntry 5 "entry 5" 5
-		  )
-	   | #"a" =>
-		 (
-		  print ("Adding menu entry " ^ (Int.toString (!item)) ^ "\n");
-		  glutAddMenuEntry ("added entry" ^ (Int.toString (!item))) (!item);
-		  item := !item + 1
-		  )
-	   | #"A" =>
-		 (
-		  print ("Adding menu entry " ^ (Int.toString (!item)) ^ "\n");
-		  glutAddMenuEntry ("added entry" ^ (Int.toString (!item))) (!item);
-		  item := !item + 1
-		  )
-	   | #"s" =>
-		 (
-		  print ("Adding submenu " ^ (Int.toString (!item)) ^ "\n");
-		  glutAddMenuEntry ("added submenu " ^ (Int.toString (!item)))
-		                   (!submenu);
-		  item := !item + 1
-		  )
-	   | #"S" =>
-		 (
-		  print ("Adding submenu " ^ (Int.toString (!item)) ^ "\n");
-		  glutAddMenuEntry ("added submenu " ^ 
-				    (Int.toString (!item)))
-		                   (!submenu);
-		  item := !item + 1
-		  )
-	   | #"q" =>
-		 (
-		  print "Remove 1\n";
-		  glutRemoveMenuItem 1
-		  )
-	   | #"w" =>
-		 (
-		  print "Remove 2\n";
-		  glutRemoveMenuItem 2
-		  )
-	   | #"e" =>
-		 (
-		  print "Remove 3\n";
-		  glutRemoveMenuItem 3
-		  )
-	   | #"r" =>
-		 (
-		  print "Remove 4\n";
-		  glutRemoveMenuItem 4
-		  )
-	   | #"t" =>
-		 (
-		  print "Remove 5\n";
-		  glutRemoveMenuItem 5
-		  )
-	   | _ =>
-		 (
-		  raise Fail "gokey 2"
-		      )
+         print("key = " ^ Char.toString(key) ^ "  mods = 0x" ^
+               (Word.fmt StringCvt.HEX mods) ^ "\n");
+         if GLUT_ACTIVE_ALT = altactive then
+             case key of
+             #"1" =>
+                 (
+                  print "Change to sub menu 1\n";
+                  glutChangeToSubMenu 1 "sub 1" (!submenu)
+                  )
+           | #"2" =>
+                 (
+                  print "Change to sub menu 2\n";
+                  glutChangeToSubMenu 2 "sub 2" (!submenu)
+                  )
+           | #"3" =>
+                 (
+                  print "Change to sub menu 3\n";
+                  glutChangeToSubMenu 3 "sub 3" (!submenu)
+                  )
+           | #"4" =>
+                 (
+                  print "Change to sub menu 4\n";
+                  glutChangeToSubMenu 4 "sub 4" (!submenu)
+                  )
+           | #"5" =>
+                 (
+                  print "Change to sub menu 5\n";
+                  glutChangeToSubMenu 5 "sub 5" (!submenu)
+                  )
+           | _ =>
+                 (
+                  raise Fail "gokey 1"
+                      )
+         else 
+             case key of
+             #"1" =>
+                 (
+                  print "Change to menu entry 1\n";
+                  glutChangeToMenuEntry 1 "entry 1" 1
+                  )
+           | #"2" =>
+                 (
+                  print "Change to menu entry 2\n";
+                  glutChangeToMenuEntry 2 "entry 2" 2
+                  )
+           | #"3" =>
+                 (
+                  print "Change to menu entry 3\n";
+                  glutChangeToMenuEntry 3 "entry 3" 3
+                  )
+           | #"4" =>
+                 (
+                  print "Change to menu entry 4\n";
+                  glutChangeToMenuEntry 4 "entry 4" 4
+                  )
+           | #"5" =>
+                 (
+                  print "Change to menu entry 5\n";
+                  glutChangeToMenuEntry 5 "entry 5" 5
+                  )
+           | #"a" =>
+                 (
+                  print ("Adding menu entry " ^ (Int.toString (!item)) ^ "\n");
+                  glutAddMenuEntry ("added entry" ^ (Int.toString (!item))) (!item);
+                  item := !item + 1
+                  )
+           | #"A" =>
+                 (
+                  print ("Adding menu entry " ^ (Int.toString (!item)) ^ "\n");
+                  glutAddMenuEntry ("added entry" ^ (Int.toString (!item))) (!item);
+                  item := !item + 1
+                  )
+           | #"s" =>
+                 (
+                  print ("Adding submenu " ^ (Int.toString (!item)) ^ "\n");
+                  glutAddMenuEntry ("added submenu " ^ (Int.toString (!item)))
+                                   (!submenu);
+                  item := !item + 1
+                  )
+           | #"S" =>
+                 (
+                  print ("Adding submenu " ^ (Int.toString (!item)) ^ "\n");
+                  glutAddMenuEntry ("added submenu " ^ 
+                                    (Int.toString (!item)))
+                                   (!submenu);
+                  item := !item + 1
+                  )
+           | #"q" =>
+                 (
+                  print "Remove 1\n";
+                  glutRemoveMenuItem 1
+                  )
+           | #"w" =>
+                 (
+                  print "Remove 2\n";
+                  glutRemoveMenuItem 2
+                  )
+           | #"e" =>
+                 (
+                  print "Remove 3\n";
+                  glutRemoveMenuItem 3
+                  )
+           | #"r" =>
+                 (
+                  print "Remove 4\n";
+                  glutRemoveMenuItem 4
+                  )
+           | #"t" =>
+                 (
+                  print "Remove 5\n";
+                  glutRemoveMenuItem 5
+                  )
+           | _ =>
+                 (
+                  raise Fail "gokey 2"
+                      )
      end
 
 

Modified: mlton/branches/on-20050420-cmm-branch/lib/opengl/molehill.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/opengl/molehill.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/opengl/molehill.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -31,7 +31,7 @@
     if w = 0 then ( 2.0 * (Real32.fromInt u) ) else
     if w = 1 then ( 2.0 * (Real32.fromInt v) ) else
     if ( u = 1 orelse u = 2 ) andalso ( v = 1 orelse v = 2 ) then
-	6.0
+        6.0
     else 0.0
 )
     
@@ -40,8 +40,8 @@
     if w = 0 then ( 2.0 * ((Real32.fromInt u) - 3.0 )) else
     if w = 1 then ( 2.0 * ((Real32.fromInt v) - 3.0 )) else
     if ( u = 1 orelse u = 2 ) andalso ( v = 1 orelse v = 2 ) then
-	if u = 1 andalso v = 1 then 15.0
-	else (~2.0)
+        if u = 1 andalso v = 1 then 15.0
+        else (~2.0)
     else 0.0
 )
     
@@ -50,8 +50,8 @@
     if w = 0 then ( 2.0 * ((Real32.fromInt u) - 3.0 )) else
     if w = 1 then ( 2.0 * (Real32.fromInt v) ) else
     if ( u = 1 orelse u = 2 ) andalso ( v = 1 orelse v = 2 ) then
-	if u = 1 andalso v = 2 then 11.0
-	else 2.0
+        if u = 1 andalso v = 2 then 11.0
+        else 2.0
     else 0.0
 )
     
@@ -60,8 +60,8 @@
     if w = 0 then ( 2.0 * (Real32.fromInt u) ) else
     if w = 1 then ( 2.0 * ((Real32.fromInt v) - 3.0) ) else
     if ( u = 1 orelse u = 2 orelse u = 3 ) andalso ( v = 1 orelse v = 2 ) then
-	if v = 1 then (~2.0)
-	else 5.0
+        if v = 1 then (~2.0)
+        else 5.0
     else 0.0
 )
 
@@ -70,8 +70,8 @@
  glMaterialfv GL_FRONT GL_DIFFUSE diffuse;
  gluBeginSurface nurb;
  gluNurbsSurface nurb 8 knots 8 knots
-		 (4 * 3) 3 controlpts
-		 4 4 GL_MAP2_VERTEX_3;
+                 (4 * 3) 3 controlpts
+                 4 4 GL_MAP2_VERTEX_3;
  gluEndSurface nurb
 )
 

Copied: mlton/branches/on-20050420-cmm-branch/lib/opengl/platform.h (from rev 4358, mlton/trunk/lib/opengl/platform.h)

Modified: mlton/branches/on-20050420-cmm-branch/lib/opengl/points.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/opengl/points.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/opengl/points.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -8,84 +8,85 @@
 
 fun changeSize ((width : int), (height : int)) : unit = 
     let 
-	val nRange    = ref 100.0
-	val h =
-	    if height = 0 then 
-		1
-	    else 
-		height
-	val w = width
+        val nRange    = ref 100.0
+        val h =
+            if height = 0 then 
+                1
+            else 
+                height
+        val w = width
     in 
-	glViewport 0 0 w h;
-	glMatrixMode GL_PROJECTION;
-	glLoadIdentity();
+        glViewport 0 0 w h;
+        glMatrixMode GL_PROJECTION;
+        glLoadIdentity();
 
-	if w <= h then
-	     glOrtho (~(!nRange)) 
-	             (!nRange) 
-		     (~(!nRange) * Real.fromInt h / Real.fromInt w)
-		     (!nRange * Real.fromInt h / Real.fromInt w) 
-		     (~(!nRange))
-		     (!nRange)
-	else
-	     glOrtho (~(!nRange) * Real.fromInt w / Real.fromInt h)
-	             (!nRange * Real.fromInt w / Real.fromInt h)
-		     (~(!nRange)) 
-		     (!nRange) 
-		     (~(!nRange))
-		     (!nRange);
-	glMatrixMode GL_MODELVIEW;
-	glLoadIdentity()
+        if w <= h then
+             glOrtho (~(!nRange)) 
+                     (!nRange) 
+                     (~(!nRange) * Real.fromInt h / Real.fromInt w)
+                     (!nRange * Real.fromInt h / Real.fromInt w) 
+                     (~(!nRange))
+                     (!nRange)
+        else
+             glOrtho (~(!nRange) * Real.fromInt w / Real.fromInt h)
+                     (!nRange * Real.fromInt w / Real.fromInt h)
+                     (~(!nRange)) 
+                     (!nRange) 
+                     (~(!nRange))
+                     (!nRange);
+        glMatrixMode GL_MODELVIEW;
+        glLoadIdentity()
     end
 
 fun renderScene () : unit =
     let
-	local
-	    fun doPoint angle z =
-		(
-		 glVertex3d (50.0 * (Math.sin angle)) 
-		            (50.0 * (Math.cos angle)) 
-			    z;
-		 z + 0.02
-		 )
-	in
-	    fun spiral angle z =
-		if angle <= (6.0 * GL_PI) then
-		    spiral (angle + 0.02) (doPoint angle z)
-		else 
-		    ()
-	end
+        local
+            fun doPoint angle z =
+                (
+                 glVertex3d (50.0 * (Math.sin angle)) 
+                            (50.0 * (Math.cos angle)) 
+                            z;
+                 z + 0.02
+                 )
+        in
+            fun spiral angle z =
+                if angle <= (6.0 * GL_PI) then
+                    spiral (angle + 0.02) (doPoint angle z)
+                else 
+                    ()
+        end
     in
-	glClear(GL_COLOR_BUFFER_BIT);
-	glPushMatrix();
-	glRotated (!xRot) 1.0 0.0 0.0;
-	glRotated (!yRot) 0.0 1.0 0.0;
+        glClear(GL_COLOR_BUFFER_BIT);
+        glPushMatrix();
+        glRotated (!xRot) 1.0 0.0 0.0;
+        glRotated (!yRot) 0.0 1.0 0.0;
 
-	if !xRot >= 356.0 then
-	    xRot := 0.0
-	else
-	    xRot := (!xRot) + 5.0;
-	if !yRot >= 356.0 then
-	    yRot := 0.0
-	else
-	    yRot := (!yRot) + 5.0;
+        if !xRot >= 356.0 then
+            xRot := 0.0
+        else
+            xRot := (!xRot) + 5.0;
+        if !yRot >= 356.0 then
+            yRot := 0.0
+        else
+            yRot := (!yRot) + 5.0;
 
-	glBegin GL_POINTS ;
-	spiral 0.0 ~50.0;
-	glEnd();
-	glPopMatrix();
-	glFlush();
-	glutSwapBuffers()
+        glBegin GL_POINTS ;
+        spiral 0.0 ~50.0;
+        glEnd();
+        glPopMatrix();
+        glFlush();
+        glutSwapBuffers()
     end
 
 fun idleFunction () : unit =
     (
      renderScene()
      )
-	 
+         
 
 fun main () = 
     (
+     glutInit();
      glutInitDisplayMode (GLUT_DOUBLE + GLUT_RGBA);
      glutInitWindowSize 400 400;
      glutCreateWindow "Animating rectangle";
@@ -101,4 +102,4 @@
 val _ = main();
 
 
-    
\ No newline at end of file
+    

Modified: mlton/branches/on-20050420-cmm-branch/lib/opengl/shortest.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/opengl/shortest.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/opengl/shortest.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -9,11 +9,11 @@
 
 fun main () = 
 (
-	 glutInit;
-	 glutCreateWindow "Short Test";
-	 glutDisplayFunc display;
-	 print("Click the close icon to close the window.");
-	 glutMainLoop()
+         glutInit();
+         glutCreateWindow "Short Test";
+         glutDisplayFunc display;
+         print("Click the close icon to close the window.");
+         glutMainLoop()
 )
 
 val _ = main();

Modified: mlton/branches/on-20050420-cmm-branch/lib/opengl/solar.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/opengl/solar.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/opengl/solar.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -10,31 +10,31 @@
 
 fun changeSize ((width : int), (height : int)) : unit = 
     let 
-	val nRange = ref 100.0
-	val h =
-	    Real32.fromInt (if height = 0 then 
-			      1
-			  else 
-			      height)
-	val w = Real32.fromInt width
-	val fAspect = Real32./ (w,h) 
+        val nRange = ref 100.0
+        val h =
+            Real32.fromInt (if height = 0 then 
+                              1
+                          else 
+                              height)
+        val w = Real32.fromInt width
+        val fAspect = Real32./ (w,h) 
     in 
-	glViewport 0 0 (Real32.trunc w) (Real32.trunc h);
-	glMatrixMode GL_PROJECTION;
-	glLoadIdentity();
-	gluPerspective 45.0 (Real32.toLarge fAspect) 1.0 425.0;
-	glMatrixMode GL_MODELVIEW;
-	glLoadIdentity()
+        glViewport 0 0 (Real32.trunc w) (Real32.trunc h);
+        glMatrixMode GL_PROJECTION;
+        glLoadIdentity();
+        gluPerspective 45.0 (Real32.toLarge fAspect) 1.0 425.0;
+        glMatrixMode GL_MODELVIEW;
+        glLoadIdentity()
     end
 
 fun initialise () =
     (
-     glutInit;
+     glutInit();
      glutInitDisplayMode (GLUT_DOUBLE + GLUT_RGB);
      glutInitWindowSize 200 200;
      glutCreateWindow "Solar";
      glEnable GL_DEPTH_TEST;
-     glFrontFace GL_CCW;	
+     glFrontFace GL_CCW;        
      glEnable GL_CULL_FACE;
      glEnable GL_LIGHTING;
      glLightModelfv GL_LIGHT_MODEL_AMBIENT whiteLight;
@@ -48,36 +48,36 @@
 
 fun renderScene () =
     (
-	glClear (GL_COLOR_BUFFER_BIT + GL_DEPTH_BUFFER_BIT);
-	glMatrixMode GL_MODELVIEW;
-	glPushMatrix();
-	glLightfv GL_LIGHT0 GL_POSITION lightPos;
-	glTranslatef 0.0 0.0 ~300.0;
-	glColor3f 1.0 1.0 0.0;
-	glutSolidSphere 15.0 50 50;
-	glLightfv GL_LIGHT0 GL_POSITION lightPos;
-	glRotatef (!fEarthRot) 0.0 1.0 0.0;
-	glColor3f 0.0 0.0 1.0;
-	glTranslatef 105.0 0.0 0.0;
-	glutSolidSphere 15.0 50 50;
-	glColor3f 0.8 0.8 0.8;
-	glRotatef(!fMoonRot) 0.0 1.0 0.0;
-	glTranslatef 30.0 0.0 0.0;
+        glClear (GL_COLOR_BUFFER_BIT + GL_DEPTH_BUFFER_BIT);
+        glMatrixMode GL_MODELVIEW;
+        glPushMatrix();
+        glLightfv GL_LIGHT0 GL_POSITION lightPos;
+        glTranslatef 0.0 0.0 ~300.0;
+        glColor3f 1.0 1.0 0.0;
+        glutSolidSphere 15.0 50 50;
+        glLightfv GL_LIGHT0 GL_POSITION lightPos;
+        glRotatef (!fEarthRot) 0.0 1.0 0.0;
+        glColor3f 0.0 0.0 1.0;
+        glTranslatef 105.0 0.0 0.0;
+        glutSolidSphere 15.0 50 50;
+        glColor3f 0.8 0.8 0.8;
+        glRotatef(!fMoonRot) 0.0 1.0 0.0;
+        glTranslatef 30.0 0.0 0.0;
 
-	fMoonRot := !fMoonRot + 15.0;
-	if (!fMoonRot > 360.0) then
-	    fMoonRot := 0.0
-	else
-	    ();
-	glutSolidSphere 6.0 20 20;
-	glPopMatrix();
-	fEarthRot := !fEarthRot + 5.0;
-	if (!fEarthRot > 360.0) then
-	    fEarthRot := 0.0
-	else
-	    ();
-	glFlush();
-	glutSwapBuffers()
+        fMoonRot := !fMoonRot + 15.0;
+        if (!fMoonRot > 360.0) then
+            fMoonRot := 0.0
+        else
+            ();
+        glutSolidSphere 6.0 20 20;
+        glPopMatrix();
+        fEarthRot := !fEarthRot + 5.0;
+        if (!fEarthRot > 360.0) then
+            fEarthRot := 0.0
+        else
+            ();
+        glFlush();
+        glutSwapBuffers()
     )
 
 fun main () = 

Modified: mlton/branches/on-20050420-cmm-branch/lib/opengl/spin_cube.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/opengl/spin_cube.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/opengl/spin_cube.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -10,39 +10,39 @@
 
 fun changeSize ((width : int), (height : int)) : unit = 
     let 
-	val nRange    = ref 2.0
-	val h =
-	    Real.fromInt (if height = 0 then 
-			      1
-			  else 
-			      height)
-	val w = Real.fromInt (width)
+        val nRange    = ref 2.0
+        val h =
+            Real.fromInt (if height = 0 then 
+                              1
+                          else 
+                              height)
+        val w = Real.fromInt (width)
     in 
-	glViewport 0 0 (Real.trunc w) (Real.trunc h);
-	glMatrixMode(GL_PROJECTION);
-	glLoadIdentity();
+        glViewport 0 0 (Real.trunc w) (Real.trunc h);
+        glMatrixMode(GL_PROJECTION);
+        glLoadIdentity();
 
-	if w <= h then
-	    glOrtho (~(!nRange)) 
-	            (!nRange) 
-		    (~(!nRange) * h / w)
-		    (!nRange * h / w) 
-		    (~(!nRange))
-		    (!nRange)
-	else
-	    glOrtho (~(!nRange) * w / h)
-	            (!nRange * w / h) 
-		    (~(!nRange))
-		    (!nRange) 
-		    (~(!nRange))
-		    (!nRange);
+        if w <= h then
+            glOrtho (~(!nRange)) 
+                    (!nRange) 
+                    (~(!nRange) * h / w)
+                    (!nRange * h / w) 
+                    (~(!nRange))
+                    (!nRange)
+        else
+            glOrtho (~(!nRange) * w / h)
+                    (!nRange * w / h) 
+                    (~(!nRange))
+                    (!nRange) 
+                    (~(!nRange))
+                    (!nRange);
         glMatrixMode GL_MODELVIEW;
-	glLoadIdentity()
+        glLoadIdentity()
     end
 
 fun initialise () =
     (
-     glutInit;
+     glutInit();
      glutInitDisplayMode (GLUT_DOUBLE+GLUT_RGB);
      glutInitWindowSize 400 400;
      glutCreateWindow "Spinning Cube";
@@ -61,56 +61,56 @@
 fun DrawPrim (_,[]) = glFlush ()
   | DrawPrim (obj,l) =
     let
-	fun draw_vertices [] = ()
-	  | draw_vertices ((x,y,z)::t) =
-		    ((glVertex3f x y z); draw_vertices t)
-	  
-	fun draw_all [] = ()
-	  | draw_all ((RGB(r,g,b), v)::t) =
-	    ((glColor3f r g b) ; draw_vertices(v);
-	     draw_all t)
+        fun draw_vertices [] = ()
+          | draw_vertices ((x,y,z)::t) =
+                    ((glVertex3f x y z); draw_vertices t)
+          
+        fun draw_all [] = ()
+          | draw_all ((RGB(r,g,b), v)::t) =
+            ((glColor3f r g b) ; draw_vertices(v);
+             draw_all t)
     in
-	(glBegin(obj);
-	 draw_all l;
-	 glEnd();
-	 glFlush())
+        (glBegin(obj);
+         draw_all l;
+         glEnd();
+         glFlush())
     end
 
 fun loop () : unit = 
   (
    glClear(GL_COLOR_BUFFER_BIT + GL_DEPTH_BUFFER_BIT);
    DrawPrim (GL_QUADS,
-	     [
-	      (RGB(0.9, 1.0, 0.0),
-	       [(~1.0, 1.0, 1.0), (1.0,1.0,1.0)]),
-	      (RGB(0.0,0.7,0.1),
-	       [(1.0,~1.0,1.0),(~1.0,~1.0,1.0)]),
-	      
-	      (RGB(0.9,1.0,0.0),
-	       [(~1.0,1.0,1.0), (~1.0,1.0,~1.0)]),
-	       (RGB(0.2,0.2,1.0),
-	       [(~1.0,~1.0,~1.0), (~1.0,~1.0,1.0)]),
-	      
-	      (RGB(0.2,0.2,1.0),
-	       [(~1.0,1.0,~1.0), (1.0,1.0,~1.0)]),
-	      (RGB(0.7,0.0,0.1),
-	       [(1.0,~1.0,~1.0), (~1.0,~1.0,~1.0)]),
-	      
-	      (RGB(0.2,0.2,1.0),
-	       [(1.0,1.0,1.0), (1.0,1.0,~1.0)]),
-	       (RGB(0.7,0.0,0.1),
-	       [(1.0,~1.0,~1.0), (1.0,~1.0,1.0)]),
-	      
-	      (RGB(0.9,1.0,0.0),
-	       [(~1.0,1.0,1.0), (1.0,1.0,1.0)]),
-	      (RGB(0.2,0.2,1.0),
-	       [(1.0,1.0,~1.0), (~1.0,1.0,~1.0)]),
-	      
-	      (RGB(0.0,0.7,0.1),
-	       [(~1.0,~1.0,1.0), (1.0,~1.0,1.0)]),
-	      (RGB(0.7,0.0,0.1),
-	       [(1.0,~1.0,~1.0), (~1.0,~1.0,~1.0)])
-	      ]);
+             [
+              (RGB(0.9, 1.0, 0.0),
+               [(~1.0, 1.0, 1.0), (1.0,1.0,1.0)]),
+              (RGB(0.0,0.7,0.1),
+               [(1.0,~1.0,1.0),(~1.0,~1.0,1.0)]),
+              
+              (RGB(0.9,1.0,0.0),
+               [(~1.0,1.0,1.0), (~1.0,1.0,~1.0)]),
+               (RGB(0.2,0.2,1.0),
+               [(~1.0,~1.0,~1.0), (~1.0,~1.0,1.0)]),
+              
+              (RGB(0.2,0.2,1.0),
+               [(~1.0,1.0,~1.0), (1.0,1.0,~1.0)]),
+              (RGB(0.7,0.0,0.1),
+               [(1.0,~1.0,~1.0), (~1.0,~1.0,~1.0)]),
+              
+              (RGB(0.2,0.2,1.0),
+               [(1.0,1.0,1.0), (1.0,1.0,~1.0)]),
+               (RGB(0.7,0.0,0.1),
+               [(1.0,~1.0,~1.0), (1.0,~1.0,1.0)]),
+              
+              (RGB(0.9,1.0,0.0),
+               [(~1.0,1.0,1.0), (1.0,1.0,1.0)]),
+              (RGB(0.2,0.2,1.0),
+               [(1.0,1.0,~1.0), (~1.0,1.0,~1.0)]),
+              
+              (RGB(0.0,0.7,0.1),
+               [(~1.0,~1.0,1.0), (1.0,~1.0,1.0)]),
+              (RGB(0.7,0.0,0.1),
+               [(1.0,~1.0,~1.0), (~1.0,~1.0,~1.0)])
+              ]);
    
    glRotated 5.0 1.0 0.6 (~0.5);
    glutSwapBuffers()

Modified: mlton/branches/on-20050420-cmm-branch/lib/opengl/triangle.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/opengl/triangle.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/lib/opengl/triangle.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -11,38 +11,39 @@
 
 fun changeSize ((width : int), (height : int)) : unit = 
     let 
-	val nRange    = ref 100.0
-	val h =
-	    Real.fromInt (if height = 0 then 
-			      1
-			  else 
-			      height)
-	val w = Real.fromInt (width)
+        val nRange    = ref 100.0
+        val h =
+            Real.fromInt (if height = 0 then 
+                              1
+                          else 
+                              height)
+        val w = Real.fromInt (width)
     in 
-	glViewport 0 0 (Real.trunc w) (Real.trunc h);
-	glMatrixMode(GL_PROJECTION);
-	glLoadIdentity();
+        glViewport 0 0 (Real.trunc w) (Real.trunc h);
+        glMatrixMode(GL_PROJECTION);
+        glLoadIdentity();
 
-	if w <= h then
-	    glOrtho (~(!nRange)) 
-	            (!nRange) 
-		    (~(!nRange) * h / w)
-		    (!nRange * h / w) 
-		    (~(!nRange))
-		    (!nRange)
-	else
-	    glOrtho (~(!nRange) * w / h)
-	            (!nRange * w / h) 
-		    (~(!nRange))
-		    (!nRange) 
-		    (~(!nRange))
-		    (!nRange);
+        if w <= h then
+            glOrtho (~(!nRange)) 
+                    (!nRange) 
+                    (~(!nRange) * h / w)
+                    (!nRange * h / w) 
+                    (~(!nRange))
+                    (!nRange)
+        else
+            glOrtho (~(!nRange) * w / h)
+                    (!nRange * w / h) 
+                    (~(!nRange))
+                    (!nRange) 
+                    (~(!nRange))
+                    (!nRange);
         glMatrixMode GL_MODELVIEW;
-	glLoadIdentity()
+        glLoadIdentity()
     end
 
 fun initialise () =
     (
+     glutInit ();
      glutInitDisplayMode(GLUT_DOUBLE + GLUT_RGBA);
      glutInitWindowPosition 100 100;
      glutInitWindowSize 250 250;
@@ -55,76 +56,76 @@
 
 fun renderScene () =
     let
-	local
-	    fun doPart angle bPivot =
-		(
-		 if bPivot then
-		     glColor3d 0.0 1.0 0.0
-		 else
-		     glColor3d 1.0 0.0 0.0;
-		 glVertex2d (50.0 * Math.sin angle) (50.0 * Math.cos angle);
-		 not bPivot
-		 )
-	in
-	    fun fan angle bPivot =
-		if angle > (2.0 * GL_PI) then
-		    ()
-		else 
-		    fan (angle + GL_PI/8.0) (doPart angle bPivot)
-	end
+        local
+            fun doPart angle bPivot =
+                (
+                 if bPivot then
+                     glColor3d 0.0 1.0 0.0
+                 else
+                     glColor3d 1.0 0.0 0.0;
+                 glVertex2d (50.0 * Math.sin angle) (50.0 * Math.cos angle);
+                 not bPivot
+                 )
+        in
+            fun fan angle bPivot =
+                if angle > (2.0 * GL_PI) then
+                    ()
+                else 
+                    fan (angle + GL_PI/8.0) (doPart angle bPivot)
+        end
     in
-	glClear(GL_COLOR_BUFFER_BIT + GL_DEPTH_BUFFER_BIT);
-	if !bCull then
-	    glEnable(GL_CULL_FACE)
-	else
-	    glDisable(GL_CULL_FACE);
+        glClear(GL_COLOR_BUFFER_BIT + GL_DEPTH_BUFFER_BIT);
+        if !bCull then
+            glEnable(GL_CULL_FACE)
+        else
+            glDisable(GL_CULL_FACE);
 
-	if !bDepth then
-	    glEnable(GL_DEPTH_TEST)
-	else
-	    glDisable(GL_DEPTH_TEST);
+        if !bDepth then
+            glEnable(GL_DEPTH_TEST)
+        else
+            glDisable(GL_DEPTH_TEST);
 
         if !bOutline then
-	    glPolygonMode GL_BACK GL_LINE
-	else
-	    glPolygonMode GL_BACK GL_FILL;
+            glPolygonMode GL_BACK GL_LINE
+        else
+            glPolygonMode GL_BACK GL_FILL;
 
-	glPushMatrix();
-	glRotated (!xRot) 1.0 0.0 0.0;
-	glRotated (!yRot) 0.0 1.0 0.0;
-	glBegin GL_TRIANGLE_FAN;
-	glVertex3d 0.0 0.0 75.0;
-	fan 0.0 false;
-	glEnd();
-	glBegin GL_TRIANGLE_FAN;
-	glVertex2d 0.0 0.0;
-	fan 0.0 false;
-	glEnd();
-	glPopMatrix();
-	glFlush();
-	glutSwapBuffers()
+        glPushMatrix();
+        glRotated (!xRot) 1.0 0.0 0.0;
+        glRotated (!yRot) 0.0 1.0 0.0;
+        glBegin GL_TRIANGLE_FAN;
+        glVertex3d 0.0 0.0 75.0;
+        fan 0.0 false;
+        glEnd();
+        glBegin GL_TRIANGLE_FAN;
+        glVertex2d 0.0 0.0;
+        fan 0.0 false;
+        glEnd();
+        glPopMatrix();
+        glFlush();
+        glutSwapBuffers()
     end
 
 fun limitXRot() : unit =
     (
      if !xRot > 356.0 then
-	 xRot := 0.0
+         xRot := 0.0
      else
-	  if !xRot < ~1.0 then
-	      xRot := 355.0
-	  else
-	      ()
+          if !xRot < ~1.0 then
+              xRot := 355.0
+          else
+              ()
      )
 
 fun limitYRot() : unit =
     (
      if !yRot > 356.0 then
-	 yRot := 0.0
+         yRot := 0.0
      else
-	  if !yRot < ~1.0 then
-	      yRot := 355.0
-	  else
-	      ()
+          if !yRot < ~1.0 then
+              yRot := 355.0
+          else
+              ()
      )
 
 fun cKeyCallback() : unit =
@@ -147,7 +148,7 @@
 
 fun keyCallback ((c:char), (x:int), (y:int)) : unit =
     case c of
-	#"c" => ( cKeyCallback() )
+        #"c" => ( cKeyCallback() )
       | #"o" => ( oKeyCallback() )
       | #"d" => ( dKeyCallback() )
       | _    => ()
@@ -185,7 +186,7 @@
     else if c = Word.toInt GLUT_KEY_F2 then ( oKeyCallback() )
     else if c = Word.toInt GLUT_KEY_F3 then ( dKeyCallback() )
     else ()
-	  
+          
 fun main () = 
     (
      initialise();
@@ -201,4 +202,4 @@
 val _ = main();
 
 
-    
\ No newline at end of file
+    

Copied: mlton/branches/on-20050420-cmm-branch/lib/smlnj-lib (from rev 4358, mlton/trunk/lib/smlnj-lib)


Property changes on: mlton/branches/on-20050420-cmm-branch/lib/smlnj-lib
___________________________________________________________________
Name: svn:ignore
   + smlnj-lib



Property changes on: mlton/branches/on-20050420-cmm-branch/man
___________________________________________________________________
Name: svn:ignore
   - *.pdf
*.ps
   + *.pdf
*.ps


Deleted: mlton/branches/on-20050420-cmm-branch/man/.cvsignore
===================================================================
--- mlton/branches/on-20050420-cmm-branch/man/.cvsignore	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/man/.cvsignore	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,2 +0,0 @@
-*.pdf
-*.ps

Copied: mlton/branches/on-20050420-cmm-branch/man/.ignore (from rev 4358, mlton/trunk/man/.ignore)

Modified: mlton/branches/on-20050420-cmm-branch/man/Makefile
===================================================================
--- mlton/branches/on-20050420-cmm-branch/man/Makefile	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/man/Makefile	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,11 @@
+## Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ #    Jagannathan, and Stephen Weeks.
+ # Copyright (C) 1997-2000 NEC Research Institute.
+ #
+ # MLton is released under a BSD-style license.
+ # See the file MLton-LICENSE for details.
+ ##
+
 all:
 
 .PHONY: ps

Copied: mlton/branches/on-20050420-cmm-branch/man/mlnlffigen.1 (from rev 4358, mlton/trunk/man/mlnlffigen.1)

Modified: mlton/branches/on-20050420-cmm-branch/man/mlprof.1
===================================================================
--- mlton/branches/on-20050420-cmm-branch/man/mlprof.1	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/man/mlprof.1	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,4 +1,4 @@
-.TH mlprof 1 "February 27, 2004"
+.TH mlprof 1 "December 1, 2005"
 .SH NAME
 \fBmlprof\fP \- display profiling information for a MLton-compiled executable
 .SH SYNOPSIS
@@ -62,4 +62,4 @@
 Print a warning about broken \fBmlmon.out\fP files, but do not exit.
 .SH "SEE ALSO"
 .BR mlton (1)
-and the \fBMLton User Guide\fP.
+and the \fBMLton Guide\fP.

Modified: mlton/branches/on-20050420-cmm-branch/man/mlton.1
===================================================================
--- mlton/branches/on-20050420-cmm-branch/man/mlton.1	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/man/mlton.1	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,60 +1,64 @@
-.TH mlton 1 "November 9, 2004"
+.TH mlton 1 "December 1, 2005"
 .SH NAME
 \fBmlton\fP \- whole-program compiler for the Standard ML (SML) programming
 language
 .SH SYNOPSIS
 \fBmlton\fP \fI[option ...] file\fB.\fP{\fBc\fP|\fBcm\fP|\fBmlb\fP|\fBo\fP|\fBsml\fP} 
-[file\fB.\fP{\fBc\fP|\fBS\fP|\fBo\fP} ...]\fR
+[file\fB.\fP{\fBc\fP|\fBo\fP|\fBs\fP|\fBS\fP} ...]\fR
 .SH DESCRIPTION
 .PP
 \fBMLton\fP is run from the command line with a collection of options
 followed by a file name and a list of files to compile, assemble, and
-link.  The simplest case is to run \fBmlton foo.sml\fP, which
-will produce an executable \fBfoo\fP.  Since \fBMLton\fP does not
-support separate compilation, the program must be the entire program
-you wish to compile.  However, the program may refer to signatures and
-structures defined in the SML Basis Library.
+link with.  The simplest case is to run \fBmlton foo.sml\fP, where
+\fBfoo.sml\fP contains a valid SML program, in which case MLton
+compiles the program to produce an executable \fBfoo\fP.  Since
+\fBMLton\fP does not support separate compilation, the program must be
+the entire program you wish to compile.  However, the program may
+refer to signatures and structures defined in the Basis Library.
 
 Larger programs, spanning many files, may be compiled with the ML
-Basis system (MLBs).  In this case, \fBmlton foo.mlb\fP will compile
+Basis system.  In this case, \fBmlton foo.mlb\fP will compile
 the complete SML program described by the basis \fBfoo.mlb\fP, which
 may specify both SML files and additional bases.  See the \fBMLton
-User Guide\fP for details.
+Guide\fP for details.
 
 \fBMLton\fP also supports a limited subset of SML/NJ Compilation
 Manager (CM) files.  For example, \fBmlton foo.cm\fP will compile the
 complete SML program consisting of the concatenation of all the SML
 files referred to (either directly or indirectly) by \fBfoo.cm\fP.
 
-\fBMLton\fP's options allow you to control the name of the output
+\fBMLton\fP's compile-time options control the name of the output
 file, the verbosity of compile-time messages, and whether or not
-certain optimizations are performed.  They also allow you to specify
-which intermediate files are saved and to stop the compilation process
+certain optimizations are performed.  They also can specify
+which intermediate files are saved and can stop the compilation process
 early, at some intermediate pass, in which case compilation can be
-resumed by passing the resulting files to \fBMLton\fP.  \fBMLton\fP
+resumed by passing the generated files to \fBMLton\fP.  \fBMLton\fP
 uses the input file suffix to determine the type of input program.
-The possibilities are \fB.c\fP, \fB.cm\fR, \fB.o\fR, and \fB.sml\fR.
+The possibilities are \fB.c\fP, \fB.cm\fP, \fB.mlb\fP, \fB.o\fP, and \fB.sml\fP.
 
 With no arguments, \fBMLton\fP prints the version number and exits.
-For a usage message, run \fBMLton\fP with an invalid switch, e.g.,
-\fBmlton -\fP.  In the explanation below and in the usage message,
-for flags that take a boolean argument
-(\fI{\fBtrue\fI|\fBfalse\fI}\fR), the first value listed is the
+For a usage message, run \fBMLton\fP with an invalid switch, e.g.
+\fBmlton -z\fP.  In the explanation below and in the usage message,
+for flags that take a number of choices
+(e.g. \fI{\fBtrue\fP|\fBfalse\fP}\fR), the first value listed is the
 default. 
 
 .SH Compile-time options
 .TP
-\fB-align \fI{\fB4\fP|\fB8\fP}\fP
+\fB-align \fI{\fB4\fP|\fB8\fP}\fP\fR
 Aligns object sizes and doubles in memory by the specified alignment.
-On x86, the default is \fB4\fP and on Sparc the default is
-\fB8\fP.
+The default varies depending on architecture.
 
 .TP
-\fB-cc-opt \fIoption\fP\fP
-Pass the option to \fBgcc\fP when compiling C code.
+\fB-as-opt \fIoption\fP\fR
+Pass \fIoption\fP to \fBgcc\fP when assembling.
 
 .TP
-\fB-codegen \fI{\fBnative\fI|\fBbytecode|\fBc\fI}\fR
+\fB-cc-opt \fIoption\fP\fR
+Pass \fIoption\fP to \fBgcc\fP when compiling C code.
+
+.TP
+\fB-codegen \fI{\fBnative\fP|\fBbytecode\fP|\fBc\fP}\fP\fR
 Generate native code, byte code, or C code.  With \fB-codegen
 native\fP, \fBMLton\fP typically compiles more quickly and generates
 better code.
@@ -64,60 +68,62 @@
 Set the value of a compile-time constant.  Here is a list of available
 constants, their default values, and what they control.
 
-\fBExn.keepHistory \fI{\fBfalse\fP|\fBtrue\fP}\fR
+\fBExn.keepHistory \fI{\fBfalse\fP|\fBtrue\fP}\fP\fR
 .in +.5i
-Enable \fBExn.history\fP.  There is a performance cost to setting this
+Enable \fBMLton.Exn.history\fP.  There is a performance cost to setting this
 to \fBtrue\fP, both in memory usage of exceptions and in run time,
 because of additional work that must be performed at each exception
 construction, raise, and handle.
 .in -.5i
 
 .TP
-\fB-default-ann \fIann\fR
-Specify the default annotation values for \fBmlb\fP files.  For
+\fB-default-ann \fIann\fP\fR
+Specify default ML Basis annotations.  For
 example, \fB-default-ann 'warnUnused true'\fP 
 causes unused variable warnings to be enabled by default.
-Defaults may be overridden by an annotation in an \fBmlb\fP file.
+Defaults may be overridden by an annotation in an ML Basis file.
 
 .TP
-\fB-disable-ann \fIann\fR
-Ignore the specified annotation in every \fBmlb\fP file.  For example,
-to see \fIall\fP match and unused warnings, use \fB-disable-ann
-'warnMatch' -disable-ann 'warnUnused' -disable-ann 'forceUsed'
--default-ann 'warnUnused true'\fP.
+\fB-disable-ann \fIann\fP\fR
+Ignore the specified ML Basis annotation in every ML Basis File. For example,
+to see \fIall\fP match and unused warnings, compile with 
+\fB-default-ann 'warnUnused true'\fP, 
+\fB-disable-ann forceUsed\fP,
+\fB-disable-ann nonexhaustiveMatch\fP,
+\fB-disable-ann redundantMatch\fP,
+and \fB-disable-ann warnUnused\fP.
 
 .TP
-\fB-export-header \fIfile\fR
+\fB-export-header \fIfile\fP\fR
 Write to \fIfile\fP C prototypes for all of the functions exported
-from SML to C.  This flag is useful for programs that use
-\fB_export\fP expressions.
+from SML to C.
 
 .TP
-\fB-ieee-fp \fI{\fBfalse\fP|\fBtrue\fP}\fR
-Cause the code generator to be pedantic about following the IEEE
+\fB-ieee-fp \fI{\fBfalse\fP|\fBtrue\fP}\fP\fR
+Cause the native code generator to be pedantic about following the IEEE
 floating point standard.  By default, it is not, because of the
-performance cost.  This has no effect with \fB-codegen c\fP.
+performance cost.  This only has an effect with \fB-codegen native\fP.
 
 .TP
-\fB-inline \fIn\fR
+\fB-inline \fIn\fP\fR
 Set the inlining threshold used in the optimizer.  The threshold is an
 approximate measure of code size of a procedure.  The default is 320.
 
 .TP
-\fB-keep \fI{\fBg\fP|\fBo\fP|\fBsml\fP}\fR
+\fB-keep \fI{\fBg\fP|\fBo\fP|\fBsml\fP}\fP\fR
 Save intermediate files.  If no \fB-keep\fP argument is given, then
 only the output file is saved.
 .in +.5i
-\fBg\fP    generated \fB.S\fP and \fB.c\fP files passed to gcc
+\fBg\fP    generated \fB.S\fP and \fB.c\fP files passed to gcc and the assembler
 .br
-\fBo\fP    object (\fB.o\fR) files
+\fBo\fP    object (\fB.o\fP) files
 .br
 \fBsml\fP  SML file
 .in -.5i
 
 .TP
-\fB-link-opt \fIopt\fR
-Pass the option to \fBgcc\fP when linking.  You can use this to
+\fB-link-opt \fIoption\fP\fR
+Pass \fIoption\fP to \fBgcc\fP when linking.  You can use this to
 specify library search paths, e.g. \fB-link-opt -Lpath\fP, and
 libraries to link with, e.g. \fB-link-opt -lfoo\fP, or even both at
 the same time, e.g. \fB-link-opt '-Lpath -lfoo'\fP.  If you wish to
@@ -125,56 +131,80 @@
 syntax, e.g., \fB-link-opt '-Wl,--export-dynamic'\fP.
 
 .TP
-\fB-output \fIfile\fR
+\fB-mlb-path-map \fIfile\fP\fR
+Use \fIfile\fP as an ML Basis path map to define additional MLB path variables.
+Multiple uses of \fB-mlb-path-map\fP are allowed, with variable
+definitions in later path maps taking precendence over earlier ones.
+
+.TP
+\fB-output \fIfile\fP\fR
 Specify the name of the final output file.
 The default name is the input file name with its suffix removed and an
 appropriate, possibly empty, suffix added.
 
 .TP
-\fB-profile \fI{\fBno\fP|\fBalloc\fP|\fBcount\fP|\fBtime\fP}\fR
-Produce an executable that will gather profiling information.  When
+\fB-profile \fI{\fBno\fP|\fBalloc\fP|\fBcount\fP|\fBtime\fP}\fP\fR
+Produce an executable that gathers profiling data.  When
 such an executable is run, it will produce an \fBmlmon.out\fP file.
 The man page on \fBmlprof\fP describes how to extract information from
 this file.
 
 .TP
-\fB-profile-branch \fI{\fBfalse\fP|\fBtrue\fP}\fR
-If true, the profiler will separately count the time spent (or bytes
-allocated) in each branch of a function definition, \fBcase\fP
+\fB-profile-branch \fI{\fBfalse\fP|\fBtrue\fP}\fP\fR
+If true, the profiler will separately gather profiling data
+for each branch of a function definition, \fBcase\fP
 expression, and \fBif\fP expression.
 
 .TP
-\fB-profile-stack \fI{\fBfalse\fP|\fBtrue\fP}\fR
-If true, the profiler will count the time spent (or bytes allocated)
-while a function is on the stack.
+\fB-profile-stack \fI{\fBfalse\fP|\fBtrue\fP}\fP\fR
+If true, the profiler will gather profiling data for all
+functions on the stack, not just the currently executing function.
 
 .TP
-\fB-runtime \fIarg\fP\fP
+\fB-runtime \fIarg\fP\fR
 Pass argument to the runtime system via \fB@MLton\fP.  The argument
 will be processed before other \fB@MLton\fP command line switches.
 Multiple uses of \fB-runtime\fP are allowed, and will pass all the
 arguments in order.  If the same runtime switch occurs more than once,
-then the last setting will dominate, except for \fBno-load-world\fP.
+then the last setting will take effect.  There is no need to supply the
+leading \fB@MLton\fP or the trailing \fB--\fP; these will be 
+supplied automatically.
 
+An argument to \fB-runtime\fP may contain spaces, which will cause the
+argument to be treated as a sequence of words by the runtime.  For
+example, the command line:
+.in +.5i
+\fBmlton -runtime 'ram-slop 0.4' foo.sml\fP
+.in -.5i
+will cause foo to run as if it had been called like
+.in +.5i
+\fBfoo @MLton ram-slop 0.4 --\fP
+.in -.5i
+
+An executable created with \fB-runtime stop\fP doesn't proces any
+\fB@MLton\fP arguments.  This is useful to create an executable,
+e.g. \fBecho\fP, that must treat \fB@MLton\fP like any other
+command-line argument.
+
 .TP
-\fB-show-basis \fIfile\fR
+\fB-show-basis \fIfile\fP\fR
 Pretty print to \fIfile\fP the basis defined by the input program.
 
 .TP
-\fB-show-def-use \fIfile\fR
+\fB-show-def-use \fIfile\fP\fR
 Output def-use information to \fIfile\fP.  Each identifier that is
 defined appears on a line, follwed on subequent lines by the position
 of each use.
 
 .TP
-\fB-stop \fI{\fBf\fP|\fBg\fP|\fBo\fP|\fBsml\fP|\fBtc\fP}\fR
-Specify pass to stop at.
+\fB-stop \fI{\fBf\fP|\fBg\fP|\fBo\fP|\fBsml\fP|\fBtc\fP}\fP\fR
+Specify when to stop.
 .in +.5i
 \fBf\fP    list of files on stdout (only makes sense when input is \fBfoo.cm\fP or \fBfoo.mlb\fP)
 .br
 \fBg\fP    generated \fB.S\fP and \fB.c\fP files
 .br
-\fBo\fP    object file (\fI*\fB.o\fR).
+\fBo\fP    object (\fB.o\fP) files
 .br
 \fBsml\fP  SML file (only makes sense when input is \fBfoo.cm\fP or \fBfoo.mlb\fP)
 .br
@@ -185,100 +215,132 @@
 or \fB.o\fP files.
 
 .TP
-\fB-target \fI{\fBself\fP|\fI...}\fR
+\fB-target \fI{\fBself\fP|...}\fP\fR
 Generate an executable that runs on the specified platform.  The
 default is \fBself\fP, which means to compile for the machine that
 \fBMLton\fP is running on.  To use any other target, you must first
-install a cross compiler.  See the \fBMLton User Guide\fP for
+install a cross compiler.  See the \fBMLton Guide\fP for
 details.
 
 .TP
-\fB-target-link-opt \fIos\fP \fIopt\fR
-Like \fB-link-opt\fP, this passes \fIopt\fP to the linker, except it
-only passes \fIopt\fP when the target operating system is \fIos\fP.
-Valid values for \fIos\fP are:
-\fBcygwin\fP,
-\fBdarwin\fP,
-\fBfreebsd\fP,
-\fBlinux\fP,
-\fBmingw\fP,
-\fBnetbsd\fP,
-\fBopenbsd\fP,
-and \fBsolaris\fP.
+\fB-target-as-opt \fItarget\fP \fIoption\fP\fR
+Like \fB-as-opt\fP, this passes \fIoption\fP to \fBgcc\fP when assembling,
+except it only passes \fIoption\fP when the target architecture or
+operating system is \fItarget\fP.
+Valid values for \fItarget\fP are:
+\fBhppa\fP, \fBpowerpc\fP, \fBsparc\fP, \fBx86\fP,
+\fBcygwin\fP, \fBdarwin\fP, \fBfreebsd\fP, \fBlinux\fP,
+\fBmingw\fP, \fBnetbsd\fP, \fBopenbsd\fP, \fBsolaris\fP.
 
 .TP
-\fB-verbose\fP \fI{\fB0\fP|\fB1\fP|\fB2\fP|\fB3\fP}\fP
-Be verbose about what passes are running.  The default is 0.
+\fB-target-cc-opt \fItarget\fP \fIoption\fP\fR
+Like \fB-cc-opt\fP, this passes \fIoption\fP to \fBgcc\fP when compiling
+C code, except it only passes \fIoption\fP when the target architecture
+or operating system is \fItarget\fP.  Valid values for \fItarget\fR
+are as for \fB-target-as-opt\fP.
+
+.TP
+\fB-target-link-opt \fItarget\fP \fIoption\fP\fR
+Like \fB-link-opt\fP, this passes \fIoption\fP to \fBgcc\fP when linking,
+except it only passes \fIoption\fP when the target architecture or
+operating system is \fItarget\fP.
+Valid values for \fItarget\fP are as for \fB-target-as-opt\fP.
+
+.TP
+\fB-verbose \fI{\fB0\fP|\fB1\fP|\fB2\fP|\fB3\fP}\fP\fR
+How verbose to be about what passes are running.  The default is 0.
 .in +.5i
 \fB0\fP  silent
 .br
 \fB1\fP  calls to compiler, assembler, and linker
 .br
-\fB2\fP  1 + intermediate compiler passes
+\fB2\fP  1, plus intermediate compiler passes
 .br
-\fB3\fP  2 + some data structure sizes
+\fB3\fP  2, plus some data structure sizes
 .in -.5i
 
-.TP
-\fB-warn-match \fI{\fBtrue\fP|\fBfalse\fP}\fR
-Report nonexhaustive and redundant matches.
+.SH Runtime system options
+Executables produced by \fBMLton\fP take command line arguments that control
+the runtime system.  These arguments are optional, and occur before
+the executable's usual arguments.  To use these options, the first
+argument to the executable must be \fB@MLton\fP.  The optional
+arguments then follow, must be terminated by \fB--\fP, and are
+followed by any arguments to the program.  The optional arguments are
+\fInot\fP made available to the SML program via
+\fBCommandLine.arguments\fP.  For example, a valid call to
+\fBhello-world\fP is:
+.in +.5i
+\fBhello-world @MLton gc-summary fixed-heap 10k -- a b c\fP
+.in -.5i
+In the above example, 
+\fBCommandLine.arguments () = ["a", "b", "c"]\fP.
 
-.TP
-\fB-warn-unused \fI{\fBfalse\fP|\fBtrue\fP}\fR
-Report unused identifiers.
+It is allowed to have a sequence of \fB@MLton\fP arguments, as in:
+.in +.5i
+\fBhello-world @MLton gc-summary -- @MLton fixed-heap 10k -- a b c\fP
+.in -.5i
 
-.SH Runtime system options
-To control the runtime system, executables produced by \fBMLton\fP take
-several optional command line arguments before their usual arguments.
-To use these options, the first argument to the executable must be
-\fB@MLton\fP.  The optional arguments then follow, must be terminated
-by \fB--\fP, and are followed by any arguments to the program.
-The optional arguments are \fInot\fP made available to the SML
-program via \fBCommandLine.arguments\fP.
+Run-time options can also control \fBMLton\fP, as in
+.in +.5i
+\fBmlton @MLton fixed-heap 0.5g -- foo.sml\fP
+.in -.5i
+
 .TP
-\fBfixed-heap \fIx{\fBk\fP|\fBm\fP|\fBg\fP}\fR
+\fBfixed-heap \fIx{\fBk\fP|\fBK\fP|\fBm\fP|\fBM\fP|\fBg\fP|\fBG\fP}\fP\fR
 Use a fixed size heap of size \fIx\fP, where \fIx\fP is a real number
 and the trailing letter indicates its units.
 .in +.5i
 \fBk\fP or \fBK\fP    1024
 .br
-\fPm\fP or \fBM\fP    1,048,576
+\fPm\fP or \fBM\fP   1,048,576
 .br
 \fBg\fP or \fBG\fP    1,073,741,824
 .in -.5i
-Upper case \fBK\fP, \fBM\fP, or \fBG\fP can also be used.
 A value of \fB0\fP means to use almost all the RAM present on the machine.
+
+The heap size used by \fBfixed-heap\fP includes all memory
+allocated by SML code, including memory for the stack (or stacks,
+if there are multiple threads).  It does not, however, include any
+memory used for code itself or memory used by C globals, the C
+stack, or malloc.
+
 .TP
 \fBgc-messages\fP
 Print a message at the start and end of every garbage collection.
+
 .TP
 \fBgc-summary\fP
 Print a summary of garbage collection statistics upon program
 termination.
+
 .TP
-\fBload-world \fIworld\fR
-Restart the computation with the file \fIworld\fP, which must have
+\fBload-world \fIworld\fP\fR
+Restart the computation with the file specified by \fIworld\fP, which must have
 been created by a call to \fBMLton.World.save\fP by the same
 executable.
+
 .TP
-\fBmax-heap \fIx{\fBk\fP|\fBm\fP|\fBg\fP}\fR
+\fBmax-heap \fIx{\fBk\fP|\fBK\fP|\fBm\fP|\fBM\fP|\fBg\fP|\fBG\fP}\fP\fR
 Run the computation with an automatically resized heap that is never
 larger than \fIx\fP, where \fIx\fP is a real number and the trailing
-letter indicates the units as with \fBfixed-heap\fP.
+letter indicates the units as with \fBfixed-heap\fP.  The
+heap size for \fBmax-heap\fP is accounted for as with
+\fBfixed-heap\fP.
 
-option.
 .TP
 \fB-no-load-world\fP
 Disable \fBload-world\fP.  This can be used as an argument to the
 compiler via \fB-runtime no-load-world\fP to create executables that
 will not load a world.  This may be useful to ensure that set-uid
 executables do not load some strange world.
+
 .TP
-\fBram-slop \fIx\fR
+\fBram-slop \fIx\fP\fR
 Multiply \fBx\fP by the amount of RAM on the machine to obtain what
 the runtime views as the amount of RAM it can use.  Typically \fBx\fP
 is less than 1, and is used to account for space used by other
 programs running on the same machine.
+
 .TP
 \fBstop\fP
 Causes the runtime to stop processing \fB@MLton\fP arguments once the
@@ -286,6 +348,11 @@
 compiler via \fB-runtime stop\fP to create executables that don't
 process any \fB@MLton\fP arguments.
 
+.SH DIAGNOSTICS
+MLton's type error messages are not in a form suitable for processing
+by Emacs.  For details on how to fix this, see
+http://mlton.org/Emacs.
+
 .SH "SEE ALSO"
-.BR mlprof (1)
-and the \fBMLton User Guide\fP.
+.BR mlprof (1) 
+and the \fBMLton Guide\fP.


Property changes on: mlton/branches/on-20050420-cmm-branch/mllex
___________________________________________________________________
Name: svn:ignore
   - *.call-graph.dot
*.ssa
html
lexgen.aux
lexgen.dvi
lexgen.log
lexgen.toc
mllex
mllex.pdf
mllex.ps
mllex.sml
   + *.call-graph.dot
*.ssa
html
lexgen.aux
lexgen.dvi
lexgen.log
lexgen.toc
mllex
mllex.pdf
mllex.ps
mllex.sml


Deleted: mlton/branches/on-20050420-cmm-branch/mllex/.cvsignore
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mllex/.cvsignore	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mllex/.cvsignore	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,11 +0,0 @@
-*.call-graph.dot
-*.ssa
-html
-lexgen.aux
-lexgen.dvi
-lexgen.log
-lexgen.toc
-mllex
-mllex.pdf
-mllex.ps
-mllex.sml

Copied: mlton/branches/on-20050420-cmm-branch/mllex/.ignore (from rev 4358, mlton/trunk/mllex/.ignore)

Copied: mlton/branches/on-20050420-cmm-branch/mllex/INSTALL (from rev 4358, mlton/trunk/mllex/INSTALL)

Modified: mlton/branches/on-20050420-cmm-branch/mllex/Makefile
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mllex/Makefile	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mllex/Makefile	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,11 @@
+## Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ #    Jagannathan, and Stephen Weeks.
+ # Copyright (C) 1997-2000 NEC Research Institute.
+ #
+ # MLton is released under a BSD-style license.
+ # See the file MLton-LICENSE for details.
+ ##
+
 SRC = $(shell cd .. && pwd)
 BUILD = $(SRC)/build
 BIN = $(BUILD)/bin
@@ -13,7 +21,6 @@
 $(NAME): $(NAME).mlb $(shell PATH=$(BIN):$$PATH && $(MLTON) -stop f $(NAME).mlb)
 	@echo 'Compiling $(NAME)'
 	$(MLTON) $(FLAGS) $(NAME).mlb
-	size $(NAME)
 
 $(NAME).sml: $(NAME).cm $(shell $(MLTON) -stop f $(NAME).cm)
 	mlton -stop sml $(NAME).cm

Modified: mlton/branches/on-20050420-cmm-branch/mllex/README
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mllex/README	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mllex/README	2006-02-16 19:34:54 UTC (rev 4361)
@@ -11,9 +11,12 @@
 
 Files of interest:
 
-lexgen.doc		- User's manual for ML-Lex
-lexgen.sml		- ML version of Lex
-export-lex.sml          - to be loaded by Standard ML of New Jersey users
-                          after loading lexgen.sml to create a stand-alone
-                          version of ML-Lex that takes the specification
-                          file name as a command line argument.
+lexgen.doc              - User's manual for ML-Lex
+lexgen.sml              - ML version of Lex
+export-lex.sml          - implements an exportable (via SMLofNJ.exportFn)
+                          toplevel driver for ML-Lex;  the resulting
+                          stand-alone program takes the specification
+                          file name as a command line argument
+ml-lex.cm               - CM description file for ML-Lex
+build                   - script that invokes ../../bin/ml-build in order
+                          to construct the stand-alone version of ML-Lex

Modified: mlton/branches/on-20050420-cmm-branch/mllex/README.MLton
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mllex/README.MLton	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mllex/README.MLton	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,4 +1,11 @@
 This is a modified version of the ml-lex directory that comes with SML/NJ
+110.55.  I made a few changes so that the sources are compilable with MLton.
+
+mfluet@acm.org  2005-7-21.
+
+*****
+
+This is a modified version of the ml-lex directory that comes with SML/NJ
 110.9.1.  I made a few changes so that the sources are compilable with MLton.
 
 sweeks@acm.org  2000-8-22.

Modified: mlton/branches/on-20050420-cmm-branch/mllex/call-main.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mllex/call-main.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mllex/call-main.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1 +1,9 @@
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 val _ = Main.main()

Copied: mlton/branches/on-20050420-cmm-branch/mllex/export-lex.sml (from rev 4358, mlton/trunk/mllex/export-lex.sml)

Modified: mlton/branches/on-20050420-cmm-branch/mllex/lexgen.doc
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mllex/lexgen.doc	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mllex/lexgen.doc	2006-02-16 19:34:54 UTC (rev 4361)
@@ -132,77 +132,77 @@
 order of decreasing precedence (from the most tightly-binding operators
 to the most weakly-binding):
 
-	An individual character stands for itself, except for the
-	reserved characters  ? * + | ( ) ^ $ / ; . = < > [ { " \
+        An individual character stands for itself, except for the
+        reserved characters  ? * + | ( ) ^ $ / ; . = < > [ { " \
 
-	A backslash followed by one of the reserved characters stands
-	for that character.
+        A backslash followed by one of the reserved characters stands
+        for that character.
 
-	A set of characters enclosed in square brackets [ ] stands
-	for any one of those characters.  Inside the brackets, only
-	the symbols  \ - ^ are reserved.  An initial up-arrow ^ stands
-	for the complement of the characters listed, e.g. [^abc]
-	stands any character except a, b, or c.  The hyphen - denotes
-	a range of characters, e.g. [a-z] stands for any lower-case
-	alphabetic character, and [0-9a-fA-F] stands for any hexadecimal
-	digit.  To include ^ literally in a bracketed set, put it anywhere
-	but first; to include - literally in a set, put it first or last.
+        A set of characters enclosed in square brackets [ ] stands
+        for any one of those characters.  Inside the brackets, only
+        the symbols  \ - ^ are reserved.  An initial up-arrow ^ stands
+        for the complement of the characters listed, e.g. [^abc]
+        stands any character except a, b, or c.  The hyphen - denotes
+        a range of characters, e.g. [a-z] stands for any lower-case
+        alphabetic character, and [0-9a-fA-F] stands for any hexadecimal
+        digit.  To include ^ literally in a bracketed set, put it anywhere
+        but first; to include - literally in a set, put it first or last.
 
-	The dot . character stands for any character except newline,
-	i.e. the same as [^\n]	
+        The dot . character stands for any character except newline,
+        i.e. the same as [^\n]  
 
-	The following special escape sequences are available, inside
-	or outside of square-brackets:
-	        \b      - backspace
-	        \n      - newline
-	        \t      - tab
-		\h	- stands for all characters with codes >127,
-			          when 7-bit characters are used.
-	        \ddd    - where ddd is a 3 digit decimal escape.
+        The following special escape sequences are available, inside
+        or outside of square-brackets:
+                \b      - backspace
+                \n      - newline
+                \t      - tab
+                \h      - stands for all characters with codes >127,
+                                  when 7-bit characters are used.
+                \ddd    - where ddd is a 3 digit decimal escape.
 
-	A sequence of characters will stand for itself (reserved
+        A sequence of characters will stand for itself (reserved
         characters will be taken literally) if it is enclosed in
-	double quotes " ".
+        double quotes " ".
 
-	A named regular expression (defined in the "definitions"
-	section) may be referred to by enclosing its name in
-	braces { }.
+        A named regular expression (defined in the "definitions"
+        section) may be referred to by enclosing its name in
+        braces { }.
 
-	Any regular expression may be enclosed in parentheses ( )
-	for syntactic (but, as usual, not semantic) effect.
+        Any regular expression may be enclosed in parentheses ( )
+        for syntactic (but, as usual, not semantic) effect.
 
-	The postfix operator * stands for Kleene closure:
-	zero or more repetitions of the preceding expression.
+        The postfix operator * stands for Kleene closure:
+        zero or more repetitions of the preceding expression.
 
-	The postfix operator + stands for one or more repetitions
-	of the preceding expression.
+        The postfix operator + stands for one or more repetitions
+        of the preceding expression.
 
-	The postfix operator ? stands for zero or one occurrence of
-	the preceding expression.
+        The postfix operator ? stands for zero or one occurrence of
+        the preceding expression.
 
-	A postfix repetition range {n1,n2} where n1 and n2 are small
-	integers stands for any number of repetitions between n1 and n2
-	of the preceding expression.  The notation {n1} stands for
-	exactly n1 repetitions.
+        A postfix repetition range {n1,n2} where n1 and n2 are small
+        integers stands for any number of repetitions between n1 and n2
+        of the preceding expression.  The notation {n1} stands for
+        exactly n1 repetitions.
 
-	Concatenation of expressions denotes concatenation of strings.
-	The expression e1 e2 stands for any string that results from
-	the concatenation of one string that matches e1 with another
-	string that matches e2.
+        Concatenation of expressions denotes concatenation of strings.
+        The expression e1 e2 stands for any string that results from
+        the concatenation of one string that matches e1 with another
+        string that matches e2.
 
-	The infix operator | stands for alternation.  The expression
-	e1 | e2  stands for anything that either e1 or e2 stands for.
+        The infix operator | stands for alternation.  The expression
+        e1 | e2  stands for anything that either e1 or e2 stands for.
     
-	The infix operator / denotes lookahead.  Lookahead is not
+        The infix operator / denotes lookahead.  Lookahead is not
         implemented and cannot be used, because there is a bug
         in the algorithm for generating lexers with lookahead.  If
         it could be used, the expression e1 / e2 would match any string
         that e1 stands for, but only when that string is followed by a
         string that matches e2.
 
-	When the up-arrow ^ occurs at the beginning of an expression,
-	that expression will only match strings that occur at the
-	beginning of a line (right after a newline character).
+        When the up-arrow ^ occurs at the beginning of an expression,
+        that expression will only match strings that occur at the
+        beginning of a line (right after a newline character).
 
         The dollar sign $ is not implemented, since it is an abbreviation
         for lookahead involving the newline character (that is, it
@@ -210,19 +210,19 @@
         sign $ occurred at the end of an expression, that expression
         would only match strings that occur at the end of a line
         (right before a newline character).
-	
+        
 Here are some examples of regular expressions, and descriptions of the
 set of strings they denote:
 
         0 | 1 | 2 | 3           A single digit between 0 and 3
-	[0123]			A single digit between 0 and 3
+        [0123]                  A single digit between 0 and 3
         0123                    The string "0123"
         0*                      All strings of 0 or more 0's
         00*                     All strings of 1  or more 0's
-	0+                      All strings of 1  or more 0's
-	[0-9]{3}		Any three-digit decimal number.
-	\\[ntb]			The strings "\n" "\t" "\b"
-	(00)*			Any string with an even number of 0's.
+        0+                      All strings of 1  or more 0's
+        [0-9]{3}                Any three-digit decimal number.
+        \\[ntb]                 The strings "\n" "\t" "\b"
+        (00)*                   Any string with an even number of 0's.
 
 IV. ML-Lex syntax summary
 
@@ -260,11 +260,11 @@
                           as input.
         %structure {identifier} - name the structure in the output program
                           {identifier} instead of Mlex
-	%header 	- use code following it to create header for lexer
-			  structure
+        %header         - use code following it to create header for lexer
+                          structure
         %arg            - extra (curried) formal parameter argument to be
-			  passed to the lex functions, and to be passed
-			  to the eof function in place of ()
+                          passed to the lex functions, and to be passed
+                          to the eof function in place of ()
         These functions are discussed below, under values available to
         actions.
 
@@ -318,16 +318,16 @@
         value           %command        description
         -----           --------        -----------
         REJECT          %reject         REJECT() causes the current
-					rule to be "rejected."
-					The lexer behaves as if the
-					current rule had not matched;
-					another rule that matches this
-					string, or that matches the longest
-					possible prefix of this string,
-					is used instead.
+                                        rule to be "rejected."
+                                        The lexer behaves as if the
+                                        current rule had not matched;
+                                        another rule that matches this
+                                        string, or that matches the longest
+                                        possible prefix of this string,
+                                        is used instead.
                                 
-	yypos				Current character position from
-					beginning of file.
+        yypos                           Current character position from
+                                        beginning of file.
 
         yylineno        %count          Current line number
         
@@ -374,11 +374,11 @@
     let val input_line = fn f =>
           let fun loop result =
              let val c = input (f,1)
-	         val result = c :: result
+                 val result = c :: result
              in if String.size c = 0 orelse c = "\n" then
-	  	   String.implode (rev result)
-	         else loop result
-	     end
+                   String.implode (rev result)
+                 else loop result
+             end
           in loop nil
           end
      in Mlex.makeLexer (fn n => input_line std_in)
@@ -476,11 +476,11 @@
       val input_line = fn f =>
           let fun loop result =
              let val c = input (f,1)
-	         val result = c :: result
+                 val result = c :: result
              in if String.size c = 0 orelse c = "\n" then
-	  	   String.implode (rev result)
-	         else loop result
-	     end
+                   String.implode (rev result)
+                 else loop result
+             end
           in loop nil
           end
       val lexer = makeLexer (fn n => input_line strm)

Modified: mlton/branches/on-20050420-cmm-branch/mllex/lexgen.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mllex/lexgen.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mllex/lexgen.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,6 +1,10 @@
+(* Modified by mfluet@acm.org on 2005-8-01.
+ * Update with SML/NJ 110.55+.
+ *)
 (* Modified by sweeks@acm.org on 2000-8-24.
  * Ported to MLton.
  *)
+
 (*  Lexical analyzer generator for Standard ML.
         Version 1.7.0, June 1998
 
@@ -14,45 +18,41 @@
 see the COPYRIGHT NOTICE for details and restrictions.
 
     Changes:
-	07/25/89 (drt): added %header declaration, code to place
-		user declarations at same level as makeLexer, etc.
-		This is needed for the parser generator.
-	  /10/89 (appel): added %arg declaration (see lexgen.doc).
-	  /04/90 (drt): fixed following bug: couldn't use the lexer after an
-		error occurred -- NextTok and inquote weren't being reset
-	10/22/91 (drt): disabled use of lookahead
-	10/23/92 (drt): disabled use of $ operator (which involves lookahead),
-		added handlers for dictionary lookup routine
-	11/02/92 (drt): changed handler for exception Reject in generated lexer
-		to Internal.Reject
+        07/25/89 (drt): added %header declaration, code to place
+                user declarations at same level as makeLexer, etc.
+                This is needed for the parser generator.
+          /10/89 (appel): added %arg declaration (see lexgen.doc).
+          /04/90 (drt): fixed following bug: couldn't use the lexer after an
+                error occurred -- NextTok and inquote weren't being reset
+        10/22/91 (drt): disabled use of lookahead
+        10/23/92 (drt): disabled use of $ operator (which involves lookahead),
+                added handlers for dictionary lookup routine
+        11/02/92 (drt): changed handler for exception Reject in generated lexer
+                to Internal.Reject
         02/01/94 (appel): Moved the exception handler for Reject in such
-		a way as to allow tail-recursion (improves performance
-		wonderfully!).
-	02/01/94 (appel): Fixed a bug in parsing of state names.
-	05/19/94 (Mikael Pettersson, mpe@ida.liu.se):
-		Transition tables are usually represented as strings, but
-		when the range is too large, int vectors constructed by
-		code like "Vector.vector[1,2,3,...]" are used instead.
-		The problem with this isn't that the vector itself takes
-		a lot of space, but that the code generated by SML/NJ to
-		construct the intermediate list at run-time is *HUGE*. My
-		fix is to encode an int vector as a string literal (using
-		two bytes per int) and emit code to decode the string to
-		a vector at run-time. SML/NJ compiles string literals into
-		substrings in the code, so this uses much less space.
-	06/02/94 (jhr): Modified export-lex.sml to conform to new installation
-		scheme.  Also removed tab characters from string literals.
-	10/05/94 (jhr): Changed generator to produce code that uses the new
-		basis style strings and characters.
-	10/06/94 (jhr) Modified code to compile under new basis style strings
-		and characters.
-	02/08/95 (jhr) Modified to use new List module interface.
-	05/18/95 (jhr) changed Vector.vector to Vector.fromList
-*
- * $Log: lexgen.sml,v $
- * Revision 1.1.1.1  1998/04/08 18:40:10  george
- * Version 110.5
- *
+                a way as to allow tail-recursion (improves performance
+                wonderfully!).
+        02/01/94 (appel): Fixed a bug in parsing of state names.
+        05/19/94 (Mikael Pettersson, mpe@ida.liu.se):
+                Transition tables are usually represented as strings, but
+                when the range is too large, int vectors constructed by
+                code like "Vector.vector[1,2,3,...]" are used instead.
+                The problem with this isn't that the vector itself takes
+                a lot of space, but that the code generated by SML/NJ to
+                construct the intermediate list at run-time is *HUGE*. My
+                fix is to encode an int vector as a string literal (using
+                two bytes per int) and emit code to decode the string to
+                a vector at run-time. SML/NJ compiles string literals into
+                substrings in the code, so this uses much less space.
+        06/02/94 (jhr): Modified export-lex.sml to conform to new installation
+                scheme.  Also removed tab characters from string literals.
+        10/05/94 (jhr): Changed generator to produce code that uses the new
+                basis style strings and characters.
+        10/06/94 (jhr) Modified code to compile under new basis style strings
+                and characters.
+        02/08/95 (jhr) Modified to use new List module interface.
+        05/18/95 (jhr) changed Vector.vector to Vector.fromList
+ 
  * Revision 1.9  1998/01/06 19:23:53  appel
  *   added %posarg feature to permit position-within-file to be passed
  *   as a parameter to makeLexer
@@ -75,17 +75,10 @@
 # Revision 1.3  1997/10/04  03:52:13  dbm
 #   Fix to remove output file if ml-lex fails.
 #
-# Revision 1.2  1997/05/06  01:12:38  george
-# *** empty log message ***
-#
- * Revision 1.2  1996/02/26  15:02:27  george
- *    print no longer overloaded.
- *    use of makestring has been removed and replaced with Int.toString ..
- *    use of IO replaced with TextIO
- *
- * Revision 1.1.1.1  1996/01/31  16:01:15  george
- * Version 109
- * 
+        10/17/02 (jhr) changed bad character error message to properly
+                print the bad character.
+        10/17/02 (jhr) fixed skipws to use Char.isSpace test.
+        07/27/05 (jhr) add \r as a recognized escape sequence.
  *)
 
 (* Subject: lookahead in sml-lex
@@ -148,15 +141,15 @@
 *)
 
 functor RedBlack(B : sig type key
-			 val > : key*key->bool
-		     end):
-	    sig type tree
-		type key
-		val empty : tree
-		val insert : key * tree -> tree
-		val lookup : key * tree -> key
-	 	exception notfound of key
-	    end =
+                         val > : key*key->bool
+                     end):
+            sig type tree
+                type key
+                val empty : tree
+                val insert : key * tree -> tree
+                val lookup : key * tree -> key
+                exception notfound of key
+            end =
 struct
  open B
  datatype color = RED | BLACK
@@ -166,43 +159,43 @@
  fun insert (key,t) =
   let fun f empty = tree(key,RED,empty,empty)
         | f (tree(k,BLACK,l,r)) =
-	    if key>k
-	    then case f r
-		 of r as tree(rk,RED, rl as tree(rlk,RED,rll,rlr),rr) =>
-			(case l
-			 of tree(lk,RED,ll,lr) =>
-				tree(k,RED,tree(lk,BLACK,ll,lr),
-					   tree(rk,BLACK,rl,rr))
-			  | _ => tree(rlk,BLACK,tree(k,RED,l,rll),
-						tree(rk,RED,rlr,rr)))
-		  | r as tree(rk,RED,rl, rr as tree(rrk,RED,rrl,rrr)) =>
-			(case l
-			 of tree(lk,RED,ll,lr) =>
-				tree(k,RED,tree(lk,BLACK,ll,lr),
-					   tree(rk,BLACK,rl,rr))
-			  | _ => tree(rk,BLACK,tree(k,RED,l,rl),rr))
-	          | r => tree(k,BLACK,l,r)
-	    else if k>key
-	    then case f l
-	         of l as tree(lk,RED,ll, lr as tree(lrk,RED,lrl,lrr)) =>
-			(case r
-			 of tree(rk,RED,rl,rr) =>
-				tree(k,RED,tree(lk,BLACK,ll,lr),
-					   tree(rk,BLACK,rl,rr))
-			  | _ => tree(lrk,BLACK,tree(lk,RED,ll,lrl),
-						tree(k,RED,lrr,r)))
-		  | l as tree(lk,RED, ll as tree(llk,RED,lll,llr), lr) =>
-			(case r
-			 of tree(rk,RED,rl,rr) =>
-				tree(k,RED,tree(lk,BLACK,ll,lr),
-					   tree(rk,BLACK,rl,rr))
-			  | _ => tree(lk,BLACK,ll,tree(k,RED,lr,r)))
-	          | l => tree(k,BLACK,l,r)
-	    else tree(key,BLACK,l,r)
+            if key>k
+            then case f r
+                 of r as tree(rk,RED, rl as tree(rlk,RED,rll,rlr),rr) =>
+                        (case l
+                         of tree(lk,RED,ll,lr) =>
+                                tree(k,RED,tree(lk,BLACK,ll,lr),
+                                           tree(rk,BLACK,rl,rr))
+                          | _ => tree(rlk,BLACK,tree(k,RED,l,rll),
+                                                tree(rk,RED,rlr,rr)))
+                  | r as tree(rk,RED,rl, rr as tree(rrk,RED,rrl,rrr)) =>
+                        (case l
+                         of tree(lk,RED,ll,lr) =>
+                                tree(k,RED,tree(lk,BLACK,ll,lr),
+                                           tree(rk,BLACK,rl,rr))
+                          | _ => tree(rk,BLACK,tree(k,RED,l,rl),rr))
+                  | r => tree(k,BLACK,l,r)
+            else if k>key
+            then case f l
+                 of l as tree(lk,RED,ll, lr as tree(lrk,RED,lrl,lrr)) =>
+                        (case r
+                         of tree(rk,RED,rl,rr) =>
+                                tree(k,RED,tree(lk,BLACK,ll,lr),
+                                           tree(rk,BLACK,rl,rr))
+                          | _ => tree(lrk,BLACK,tree(lk,RED,ll,lrl),
+                                                tree(k,RED,lrr,r)))
+                  | l as tree(lk,RED, ll as tree(llk,RED,lll,llr), lr) =>
+                        (case r
+                         of tree(rk,RED,rl,rr) =>
+                                tree(k,RED,tree(lk,BLACK,ll,lr),
+                                           tree(rk,BLACK,rl,rr))
+                          | _ => tree(lk,BLACK,ll,tree(k,RED,lr,r)))
+                  | l => tree(k,BLACK,l,r)
+            else tree(key,BLACK,l,r)
         | f (tree(k,RED,l,r)) =
-	    if key>k then tree(k,RED,l, f r)
-	    else if k>key then tree(k,RED, f l, r)
-	    else tree(key,RED,l,r)
+            if key>k then tree(k,RED,l, f r)
+            else if k>key then tree(k,RED, f l, r)
+            else tree(key,RED,l,r)
    in case f t
       of tree(k,RED, l as tree(_,RED,_,_), r) => tree(k,BLACK,l,r)
        | tree(k,RED, l, r as tree(_,RED,_,_)) => tree(k,BLACK,l,r)
@@ -212,10 +205,10 @@
 
  fun lookup (key,t) =
   let fun look empty = raise (notfound key)
-	| look (tree(k,_,l,r)) =
-		if k>key then look l
-		else if key>k then look r
-		else k
+        | look (tree(k,_,l,r)) =
+                if k>key then look l
+                else if key>k then look r
+                else k
    in look t
   end
 
@@ -232,19 +225,19 @@
    infix 9 sub
 
    datatype token = CHARS of bool array | QMARK | STAR | PLUS | BAR
-	  | LP | RP | CARAT | DOLLAR | SLASH | STATE of string list
-	  | REPS of int * int | ID of string | ACTION of string
-	  | BOF | EOF | ASSIGN | SEMI | ARROW | LEXMARK | LEXSTATES 
-	  | COUNT | REJECT | FULLCHARSET | STRUCT | HEADER | ARG | POSARG
-	
+          | LP | RP | CARAT | DOLLAR | SLASH | STATE of string list
+          | REPS of int * int | ID of string | ACTION of string
+          | BOF | EOF | ASSIGN | SEMI | ARROW | LEXMARK | LEXSTATES 
+          | COUNT | REJECT | FULLCHARSET | STRUCT | HEADER | ARG | POSARG
+        
    datatype exp = EPS | CLASS of bool array * int | CLOSURE of exp
-		| ALT of exp * exp | CAT of exp * exp | TRAIL of int
-		| END of int
+                | ALT of exp * exp | CAT of exp * exp | TRAIL of int
+                | END of int
 
    (* flags describing input Lex spec. - unnecessary code is omitted *)
    (* if possible *)
 
-   val CharFormat = ref false;	
+   val CharFormat = ref false;  
    val UsesTrailingContext = ref false;
    val UsesPrevNewLine = ref false;
    
@@ -269,12 +262,12 @@
    val StrDecl = ref false
 
    val ResetFlags = fn () => (CountNewLines := false; HaveReject := false;
-			      PosArg := false;
-			      UsesTrailingContext := false;
-			       CharSetSize := 129; StrName := "Mlex";
-				HeaderCode := ""; HeaderDecl:= false;
-				ArgCode := NONE; 
-				StrDecl := false)
+                              PosArg := false;
+                              UsesTrailingContext := false;
+                               CharSetSize := 129; StrName := "Mlex";
+                                HeaderCode := ""; HeaderDecl:= false;
+                                ArgCode := NONE; 
+                                StrDecl := false)
 
    val LexOut = ref(TextIO.stdOut)
    fun say x = TextIO.output(!LexOut, x)
@@ -282,51 +275,51 @@
 (* Union: merge two sorted lists of integers *)
 
 fun union(a,b) = let val rec merge = fn
-	  (nil,nil,z) => z
-	| (nil,el::more,z) => merge(nil,more,el::z)
-	| (el::more,nil,z) => merge(more,nil,el::z)
-	| (x::morex,y::morey,z) => if (x:int)=(y:int)
-		then merge(morex,morey,x::z)
-		else if x>y then merge(morex,y::morey,x::z)
-		else merge(x::morex,morey,y::z)
-	in merge(rev a,rev b,nil)
+          (nil,nil,z) => z
+        | (nil,el::more,z) => merge(nil,more,el::z)
+        | (el::more,nil,z) => merge(more,nil,el::z)
+        | (x::morex,y::morey,z) => if (x:int)=(y:int)
+                then merge(morex,morey,x::z)
+                else if x>y then merge(morex,y::morey,x::z)
+                else merge(x::morex,morey,y::z)
+        in merge(rev a,rev b,nil)
 end
 
 (* Nullable: compute if a important expression parse tree node is nullable *)
 
 val rec nullable = fn
-	  EPS => true
-	| CLASS(_) => false
-	| CLOSURE(_) => true
-	| ALT(n1,n2) => nullable(n1) orelse nullable(n2)
-	| CAT(n1,n2) => nullable(n1) andalso nullable(n2)
-	| TRAIL(_) => true
-	| END(_) => false
+          EPS => true
+        | CLASS(_) => false
+        | CLOSURE(_) => true
+        | ALT(n1,n2) => nullable(n1) orelse nullable(n2)
+        | CAT(n1,n2) => nullable(n1) andalso nullable(n2)
+        | TRAIL(_) => true
+        | END(_) => false
 
 (* FIRSTPOS: firstpos function for parse tree expressions *)
 
 and firstpos = fn
-	  EPS => nil
-	| CLASS(_,i) => [i]
-	| CLOSURE(n) => firstpos(n)
-	| ALT(n1,n2) => union(firstpos(n1),firstpos(n2))
-	| CAT(n1,n2) => if nullable(n1) then union(firstpos(n1),firstpos(n2))
-		else firstpos(n1)
-	| TRAIL(i) => [i]
-	| END(i) => [i]
+          EPS => nil
+        | CLASS(_,i) => [i]
+        | CLOSURE(n) => firstpos(n)
+        | ALT(n1,n2) => union(firstpos(n1),firstpos(n2))
+        | CAT(n1,n2) => if nullable(n1) then union(firstpos(n1),firstpos(n2))
+                else firstpos(n1)
+        | TRAIL(i) => [i]
+        | END(i) => [i]
 
 (* LASTPOS: Lastpos function for parse tree expressions *)
 
 and lastpos = fn
-	  EPS => nil
-	| CLASS(_,i) => [i]
-	| CLOSURE(n) => lastpos(n)
-	| ALT(n1,n2) => union(lastpos(n1),lastpos(n2))
-	| CAT(n1,n2) => if nullable(n2) then union(lastpos(n1),lastpos(n2))
-		else lastpos(n2)
-	| TRAIL(i) => [i]
-	| END(i) => [i]
-	;
+          EPS => nil
+        | CLASS(_,i) => [i]
+        | CLOSURE(n) => lastpos(n)
+        | ALT(n1,n2) => union(lastpos(n1),lastpos(n2))
+        | CAT(n1,n2) => if nullable(n2) then union(lastpos(n1),lastpos(n2))
+                else lastpos(n2)
+        | TRAIL(i) => [i]
+        | END(i) => [i]
+        ;
 
 (* ++: Increment an integer reference *)
 
@@ -334,36 +327,36 @@
 
 structure dict =
     struct
-	type 'a relation = 'a * 'a -> bool
+        type 'a relation = 'a * 'a -> bool
         abstype ('b,'a) dictionary = DATA of { Table : ('b * 'a) list,
-				          Leq : 'b * 'b -> bool }
-	with
-    	    exception LOOKUP
-	    fun create Leqfunc = DATA { Table = nil, Leq = Leqfunc }
-	    fun lookup (DATA { Table = entrylist, Leq = leq }) key =
-		let fun search [] = raise LOOKUP
-		      | search((k,item)::entries) =
-			if leq(key,k)
-			then if leq(k,key) then item else raise LOOKUP
-			else search entries
-		in search entrylist
-	        end
-	     fun enter (DATA { Table = entrylist, Leq = leq })
-		(newentry as (key : 'b,item :'a)) : ('b,'a) dictionary =
-		   let val gt = fn a => fn b => not (leq(a,b))
-		       val eq = fn k => fn k' => (leq(k,k')) andalso (leq(k',k))
-		       fun update nil = [ newentry ]
-			 | update ((entry as (k,_))::entries) =
-			      if (eq  key k) then newentry::entries
-			      else if gt k key then newentry::(entry::entries)
-			      else entry::(update entries)
-		   in DATA { Table = update entrylist, Leq = leq }
-	           end
-	     fun listofdict (DATA { Table = entrylist,Leq = leq}) =
-		let fun f (nil,r) = rev r
-		      | f (a::b,r) = f (b,a::r)
-	   	in f(entrylist,nil)
-		end
+                                          Leq : 'b * 'b -> bool }
+        with
+            exception LOOKUP
+            fun create Leqfunc = DATA { Table = nil, Leq = Leqfunc }
+            fun lookup (DATA { Table = entrylist, Leq = leq }) key =
+                let fun search [] = raise LOOKUP
+                      | search((k,item)::entries) =
+                        if leq(key,k)
+                        then if leq(k,key) then item else raise LOOKUP
+                        else search entries
+                in search entrylist
+                end
+             fun enter (DATA { Table = entrylist, Leq = leq })
+                (newentry as (key : 'b,item :'a)) : ('b,'a) dictionary =
+                   let val gt = fn a => fn b => not (leq(a,b))
+                       val eq = fn k => fn k' => (leq(k,k')) andalso (leq(k',k))
+                       fun update nil = [ newentry ]
+                         | update ((entry as (k,_))::entries) =
+                              if (eq  key k) then newentry::entries
+                              else if gt k key then newentry::(entry::entries)
+                              else entry::(update entries)
+                   in DATA { Table = update entrylist, Leq = leq }
+                   end
+             fun listofdict (DATA { Table = entrylist,Leq = leq}) =
+                let fun f (nil,r) = rev r
+                      | f (a::b,r) = f (b,a::r)
+                in f(entrylist,nil)
+                end
       end
 end
 
@@ -374,43 +367,43 @@
 val LineNum: int ref = ref 1;
 
 abstype ibuf =
-	BUF of TextIO.instream * {b : string ref, p : int ref}
+        BUF of TextIO.instream * {b : string ref, p : int ref}
 with
-	fun make_ibuf(s) = BUF (s, {b=ref"", p = ref 0})
-	fun close_ibuf (BUF (s,_)) = TextIO.closeIn(s)
-	exception eof
-	fun getch (a as (BUF(s,{b,p}))) = 
-		 if (!p = (size (!b)))
-		   then (b := TextIO.inputN(s, 1024);
-			 p := 0;
-			 if (size (!b))=0
-			    then raise eof 
-			    else getch a)
-		   else (let val ch = String.sub(!b,!p)
-			 in (if ch = #"\n"
-				 then LineNum := !LineNum + 1
-				 else ();
-			     p := !p + 1;
-			     ch)
-			 end)
-	fun ungetch(BUF(s,{b,p})) = (
-	   p := !p - 1;
-	   if String.sub(!b,!p) = #"\n"
-	      then LineNum := !LineNum - 1
-	      else ())
+        fun make_ibuf(s) = BUF (s, {b=ref"", p = ref 0})
+        fun close_ibuf (BUF (s,_)) = TextIO.closeIn(s)
+        exception eof
+        fun getch (a as (BUF(s,{b,p}))) = 
+                 if (!p = (size (!b)))
+                   then (b := TextIO.inputN(s, 1024);
+                         p := 0;
+                         if (size (!b))=0
+                            then raise eof 
+                            else getch a)
+                   else (let val ch = String.sub(!b,!p)
+                         in (if ch = #"\n"
+                                 then LineNum := !LineNum + 1
+                                 else ();
+                             p := !p + 1;
+                             ch)
+                         end)
+        fun ungetch(BUF(s,{b,p})) = (
+           p := !p - 1;
+           if String.sub(!b,!p) = #"\n"
+              then LineNum := !LineNum - 1
+              else ())
 end;
 
 exception Error
 
 fun prErr x = (
       TextIO.output (TextIO.stdErr, String.concat [
-	  "ml-lex: error, line ", (Int.toString (!LineNum)), ": ", x, "\n"
-	]);
+          "ml-lex: error, line ", (Int.toString (!LineNum)), ": ", x, "\n"
+        ]);
       raise Error)
 fun prSynErr x = (
       TextIO.output (TextIO.stdErr, String.concat [
-	  "ml-lex: syntax error, line ", (Int.toString (!LineNum)), ": ", x, "\n"
-	]);
+          "ml-lex: syntax error, line ", (Int.toString (!LineNum)), ": ", x, "\n"
+        ]);
       raise Error)
 
 exception SyntaxError; (* error in user's input file *)
@@ -424,299 +417,321 @@
 
 fun AdvanceTok () : unit = let
       fun isLetter c =
-	    ((c >= #"a") andalso (c <= #"z")) orelse
-	    ((c >= #"A") andalso (c <= #"Z"))
+            ((c >= #"a") andalso (c <= #"z")) orelse
+            ((c >= #"A") andalso (c <= #"Z"))
       fun isDigit c = (c >= #"0") andalso (c <= #"9")
     (* check for valid (non-leading) identifier character (added by JHR) *)
       fun isIdentChr c =
-	    ((isLetter c) orelse (isDigit c) orelse (c = #"_") orelse (c = #"'"))
+            ((isLetter c) orelse (isDigit c) orelse (c = #"_") orelse (c = #"'"))
       fun atoi s = let
-	    fun num (c::r, n) = if isDigit c
-		  then num (r, 10*n + (Char.ord c - Char.ord #"0"))
-		  else n
-	      | num ([], n) = n
-	    in
-	      num (explode s, 0)
-	    end
+            fun num (c::r, n) = if isDigit c
+                  then num (r, 10*n + (Char.ord c - Char.ord #"0"))
+                  else n
+              | num ([], n) = n
+            in
+              num (explode s, 0)
+            end
 
-      fun skipws () = (case nextch()
-	     of #" " => skipws()
-	      | #"\t" => skipws() 
-	      | #"\n" => skipws()
-	      | x => x
-	    (* end case *))
-		
+      fun skipws () = let val ch = nextch()
+            in
+              if Char.isSpace ch
+                then skipws()
+                else ch
+            end
+                
       and nextch () = getch(!LexBuf) 
 
       and escaped () = (case nextch()
-	     of #"b" => #"\008"
-	      | #"n" => #"\n"
-	      | #"t" => #"\t"
-	      | #"h" => #"\128"
-	      | x => let
-		  fun err t = prErr("illegal ascii escape '"^(implode(rev t))^"'")
-		  fun cvt c = (Char.ord c - Char.ord #"0")
-		  fun f (n: int, c, t) = if c=3
-			then if n >= (!CharSetSize)
-			  then err t
-			  else Char.chr n
-		        else let val ch=nextch()
-			  in
-			    if isDigit ch
-			      then f(n*10+(cvt ch), c+1, ch::t)
-		  	      else err t
-			  end
-		  in
-		    if isDigit x then f(cvt x, 1, [x]) else x
-		  end
-	    (* end case *))
-	
+             of #"b" => #"\008"
+              | #"n" => #"\n"
+              | #"r" => #"\r"
+              | #"t" => #"\t"
+              | #"h" => #"\128"
+              | x => let
+                  fun err t = prErr("illegal ascii escape '"^(implode(rev t))^"'")
+                  fun cvt c = (Char.ord c - Char.ord #"0")
+                  fun f (n: int, c, t) = if c=3
+                        then if n >= (!CharSetSize)
+                          then err t
+                          else Char.chr n
+                        else let val ch=nextch()
+                          in
+                            if isDigit ch
+                              then f(n*10+(cvt ch), c+1, ch::t)
+                              else err t
+                          end
+                  in
+                    if isDigit x then f(cvt x, 1, [x]) else x
+                  end
+            (* end case *))
+        
       and onechar x = let val c = array(!CharSetSize, false)
-	      in
-		update(c, Char.ord(x), true); CHARS(c)
-	      end
-		
+              in
+                update(c, Char.ord(x), true); CHARS(c)
+              end
+                
       in case !LexState of 0 => let val makeTok = fn () =>
-		case skipws()
-			(* Lex % operators *)
-		 of #"%" => (case nextch() of 
-		  	  #"%" => LEXMARK
-			| a => let fun f s =
-				    let val a = nextch()
-				    in if isLetter a then f(a::s)
-					else (ungetch(!LexBuf);
-					      implode(rev s))
-				    end
-			        in case f [a]
-				 of "reject" => REJECT
-				  | "count"  => COUNT
-				  | "full"   => FULLCHARSET
-				  | "s"      => LEXSTATES
-				  | "S"      => LEXSTATES
-				  | "structure" => STRUCT
-				  | "header" => HEADER
-				  | "arg"    => ARG
-				  | "posarg" => POSARG
-			          | _ => prErr "unknown % operator "
-			       end
-			     )
-			(* semicolon (for end of LEXSTATES) *)
-		| #";" => SEMI
-			(* anything else *)
-		| ch => if isLetter(ch) then
-			 let fun getID matched =
-			     let val x = nextch()
+                case skipws()
+                        (* Lex % operators *)
+                 of #"%" => (case nextch() of 
+                          #"%" => LEXMARK
+                        | a => let fun f s =
+                                    let val a = nextch()
+                                    in if isLetter a then f(a::s)
+                                        else (ungetch(!LexBuf);
+                                              implode(rev s))
+                                    end
+                                in case f [a]
+                                 of "reject" => REJECT
+                                  | "count"  => COUNT
+                                  | "full"   => FULLCHARSET
+                                  | "s"      => LEXSTATES
+                                  | "S"      => LEXSTATES
+                                  | "structure" => STRUCT
+                                  | "header" => HEADER
+                                  | "arg"    => ARG
+                                  | "posarg" => POSARG
+                                  | _ => prErr "unknown % operator "
+                               end
+                             )
+                        (* semicolon (for end of LEXSTATES) *)
+                | #";" => SEMI
+                        (* anything else *)
+                | ch => if isLetter(ch) then
+                         let fun getID matched =
+                             let val x = nextch()
 (**** fix by JHR
-			     in if isLetter(x) orelse isDigit(x) orelse
+                             in if isLetter(x) orelse isDigit(x) orelse
                                    x = "_" orelse x = "'"
 ****)
-			     in if (isIdentChr x)
-				 then getID (x::matched)
-				 else (ungetch(!LexBuf); implode(rev matched))
-			     end
-			in ID(getID [ch])
-			end
-		      else (prSynErr ("bad character: " ^ String.str ch))
-	in NextTok := makeTok()
-	end
-	| 1 => let val rec makeTok = fn () =>
-		if !inquote then case nextch() of
-			(* inside quoted string *)
-		  #"\\" => onechar(escaped())
-		| #"\"" => (inquote := false; makeTok())
-		| #"\n" => (prSynErr "end-of-line inside quoted string";
-			    inquote := false; makeTok())
-		| x => onechar(x)
-		else case skipws() of
-			(* single character operators *)
-		  #"?" => QMARK
-		| #"*" => STAR
-		| #"+" => PLUS
-		| #"|" => BAR
-		| #"(" => LP
-		| #")" => RP
-		| #"^" => CARAT
-		| #"$" => DOLLAR
-		| #"/" => SLASH
-		| #";" => SEMI
-		| #"." => let val c = array(!CharSetSize,true) in
-				update(c,10,false); CHARS(c)
-			end
-			(* assign and arrow *)
-		| #"=" => let val c = nextch() in
-			if c = #">" then ARROW else (ungetch(!LexBuf); ASSIGN)
-		end
-			(* character set *)
-		| #"[" => let val rec classch = fn () => let val x = skipws()
-				in if x = #"\\" then escaped() else x
-				end;
-			val first = classch();
-			val flag = (first <> #"^");
-			val c = array(!CharSetSize,not flag);
-			fun add NONE = ()
-			  | add (SOME x) = update(c, Char.ord(x), flag)
-			and range (x, y) = if x>y
-			      then (prErr "bad char. range")
-			      else let
-				val i = ref(Char.ord(x)) and j = Char.ord(y)
-				in while !i<=j do (
-				  add (SOME(Char.chr(!i)));
-				  i := !i + 1)
-				end
-			and getClass last = (case classch()
-			     of #"]" => (add(last); c)
-			      | #"-" => (case last
-				   of NONE => getClass(SOME #"-")
-				    | (SOME last') => let val x = classch()
-					in
-					  if x = #"]"
-					    then (add(last); add(SOME #"-"); c)
-					    else (range(last',x); getClass(NONE))
-					end
-				  (* end case *))
-			      | x => (add(last); getClass(SOME x))
-			    (* end case *))
-		in CHARS(getClass(if first = #"^" then NONE else SOME first))
-		end
-			(* Start States specification *)
-		| #"<" => let val rec get_state = fn (prev,matched) =>
-			case nextch() of
-			  #">" => matched::prev
-			| #"," => get_state(matched::prev,"")
-			| x => if isIdentChr(x)
-				then get_state(prev,matched ^ String.str x)
-				else (prSynErr "bad start state list")
-		in STATE(get_state(nil,""))
-		end
-			(* {id} or repititions *)
-		| #"{" => let val ch = nextch() in if isLetter(ch) then
-			let fun getID matched = (case nextch()
-			  of #"}" => matched
-			   | x => if (isIdentChr x) then
-				getID(matched ^ String.str x)
-				else (prErr "invalid char. class name")
-			 (* end case *))
-			in ID(getID(String.str ch))
-			end
-			else if isDigit(ch) then
-			 let fun get_r (matched, r1) = (case nextch()
-				 of #"}" => let val n = atoi(matched) in
-					if r1 = ~1 then (n,n) else (r1,n)
-					end
-				  | #"," => if r1 = ~1 then get_r("",atoi(matched))
-				       else (prErr "invalid repetitions spec.")
-				  | x => if isDigit(x)
-				    then get_r(matched ^ String.str x,r1)
-			            else (prErr "invalid char in repetitions spec")
-				(* end case *))
-			 in REPS(get_r(String.str ch,~1))
-			 end
-			else (prErr "bad repetitions spec")
-		end
-			(* Lex % operators *)
-		| #"\\" => onechar(escaped())
-			(* start quoted string *)
-		| #"\"" => (inquote := true; makeTok())
-			(* anything else *)
-		| ch => onechar(ch)
-	in NextTok := makeTok()
-	end
-	| 2 => NextTok :=
-	     (case skipws()
-		 of #"(" => let
-			fun GetAct (lpct,x) = (case getch(!LexBuf)
-			       of #"(" => GetAct (lpct+1, #"("::x)
-				| #")" => if lpct = 0 then (implode (rev x))
-					 	      else GetAct(lpct-1, #")"::x)
-				| y => GetAct(lpct,y::x)
-			      (* end case *))
-			in ACTION (GetAct (0,nil))
-			end
-		 | #";" => SEMI
-		 | c => (prSynErr ("invalid character " ^ String.str c)))
-	| _ => raise LexError
+                             in if (isIdentChr x)
+                                 then getID (x::matched)
+                                 else (ungetch(!LexBuf); implode(rev matched))
+                             end
+                        in ID(getID [ch])
+                        end
+                      else prSynErr (String.concat[
+                          "bad character: \"", Char.toString ch, "\""
+                        ])
+        in NextTok := makeTok()
+        end
+        | 1 => let val rec makeTok = fn () =>
+                if !inquote then case nextch() of
+                        (* inside quoted string *)
+                  #"\\" => onechar(escaped())
+                | #"\"" => (inquote := false; makeTok())
+                | #"\n" => (prSynErr "end-of-line inside quoted string";
+                            inquote := false; makeTok())
+                | x => onechar(x)
+                else case skipws() of
+                        (* single character operators *)
+                  #"?" => QMARK
+                | #"*" => STAR
+                | #"+" => PLUS
+                | #"|" => BAR
+                | #"(" => LP
+                | #")" => RP
+                | #"^" => CARAT
+                | #"$" => DOLLAR
+                | #"/" => SLASH
+                | #";" => SEMI
+                | #"." => let val c = array(!CharSetSize,true) in
+                                update(c,10,false); CHARS(c)
+                        end
+                        (* assign and arrow *)
+                | #"=" => let val c = nextch() in
+                        if c = #">" then ARROW else (ungetch(!LexBuf); ASSIGN)
+                end
+                        (* character set *)
+                | #"[" => let val rec classch = fn () => let val x = skipws()
+                                in if x = #"\\" then escaped() else x
+                                end;
+                        val first = classch();
+                        val flag = (first <> #"^");
+                        val c = array(!CharSetSize,not flag);
+                        fun add NONE = ()
+                          | add (SOME x) = update(c, Char.ord(x), flag)
+                        and range (x, y) = if x>y
+                              then (prErr "bad char. range")
+                              else let
+                                val i = ref(Char.ord(x)) and j = Char.ord(y)
+                                in while !i<=j do (
+                                  add (SOME(Char.chr(!i)));
+                                  i := !i + 1)
+                                end
+                        and getClass last = (case classch()
+                             of #"]" => (add(last); c)
+                              | #"-" => (case last
+                                   of NONE => getClass(SOME #"-")
+                                    | (SOME last') => let val x = classch()
+                                        in
+                                          if x = #"]"
+                                            then (add(last); add(SOME #"-"); c)
+                                            else (range(last',x); getClass(NONE))
+                                        end
+                                  (* end case *))
+                              | x => (add(last); getClass(SOME x))
+                            (* end case *))
+                in CHARS(getClass(if first = #"^" then NONE else SOME first))
+                end
+                        (* Start States specification *)
+                | #"<" => let val rec get_state = fn (prev,matched) =>
+                        case nextch() of
+                          #">" => matched::prev
+                        | #"," => get_state(matched::prev,"")
+                        | x => if isIdentChr(x)
+                                then get_state(prev,matched ^ String.str x)
+                                else (prSynErr "bad start state list")
+                in STATE(get_state(nil,""))
+                end
+                        (* {id} or repititions *)
+                | #"{" => let val ch = nextch() in if isLetter(ch) then
+                        let fun getID matched = (case nextch()
+                          of #"}" => matched
+                           | x => if (isIdentChr x) then
+                                getID(matched ^ String.str x)
+                                else (prErr "invalid char. class name")
+                         (* end case *))
+                        in ID(getID(String.str ch))
+                        end
+                        else if isDigit(ch) then
+                         let fun get_r (matched, r1) = (case nextch()
+                                 of #"}" => let val n = atoi(matched) in
+                                        if r1 = ~1 then (n,n) else (r1,n)
+                                        end
+                                  | #"," => if r1 = ~1 then get_r("",atoi(matched))
+                                       else (prErr "invalid repetitions spec.")
+                                  | x => if isDigit(x)
+                                    then get_r(matched ^ String.str x,r1)
+                                    else (prErr "invalid char in repetitions spec")
+                                (* end case *))
+                         in REPS(get_r(String.str ch,~1))
+                         end
+                        else (prErr "bad repetitions spec")
+                end
+                        (* Lex % operators *)
+                | #"\\" => onechar(escaped())
+                        (* start quoted string *)
+                | #"\"" => (inquote := true; makeTok())
+                        (* anything else *)
+                | ch => onechar(ch)
+        in NextTok := makeTok()
+        end
+        | 2 => NextTok :=
+               (case skipws() of
+                  #"(" =>
+                  let
+                    fun loop_to_end (backslash, x) =
+                      let
+                        val c    = getch (! LexBuf)
+                        val notb = not backslash
+                        val nstr = c :: x
+                      in
+                        case c of
+                          #"\"" => if notb then nstr
+                                   else loop_to_end (false, nstr)
+                        | _ => loop_to_end (c = #"\\" andalso notb, nstr)
+                      end
+                    fun GetAct (lpct, x) =
+                      let
+                        val c    = getch (! LexBuf)
+                        val nstr = c :: x
+                      in
+                        case c of
+                          #"\"" => GetAct (lpct, loop_to_end (false, nstr))
+                        | #"(" => GetAct (lpct + 1, nstr)
+                        | #")" => if lpct = 0 then implode (rev x)
+                                  else GetAct(lpct - 1, nstr)
+                        | _ => GetAct(lpct, nstr)
+                      end
+                  in
+                    ACTION (GetAct (0,nil))
+                  end
+                | #";" => SEMI
+                | c => (prSynErr ("invalid character " ^ String.str c)))
+        | _ => raise LexError
 end
 handle eof => NextTok := EOF ;
 
 fun GetTok (_:unit) : token = 
-	let val t = !NextTok in AdvanceTok(); t
-	end;
+        let val t = !NextTok in AdvanceTok(); t
+        end;
 val SymTab = ref (create String.<=) : (string,exp) dictionary ref
 
 fun GetExp () : exp =
 
-	let val rec optional = fn e => ALT(EPS,e)
+        let val rec optional = fn e => ALT(EPS,e)
 
-	    and lookup' = fn name =>
-		lookup(!SymTab) name 
-		handle LOOKUP => prErr ("bad regular expression name: "^
-					    name)
+            and lookup' = fn name =>
+                lookup(!SymTab) name 
+                handle LOOKUP => prErr ("bad regular expression name: "^
+                                            name)
 
-	and newline = fn () => let val c = array(!CharSetSize,false) in
-		update(c,10,true); c
-		end
-	
-	and endline = fn e => trail(e,CLASS(newline(),0))
-	
-	and trail = fn (e1,e2) => CAT(CAT(e1,TRAIL(0)),e2)
-	
-	and closure1 = fn e => CAT(e,CLOSURE(e))
-	
-	and repeat = fn (min,max,e) => let val rec rep = fn
-		  (0,0) => EPS
-		| (0,1) => ALT(e,EPS)
-		| (0,i) => CAT(rep(0,1),rep(0,i-1))
-		| (i,j) => CAT(e,rep(i-1,j-1))
-	in rep(min,max)
-	end
-	
-	and exp0 = fn () => case GetTok() of
-		  CHARS(c) => exp1(CLASS(c,0))
-		| LP => let val e = exp0() in
-		 if !NextTok = RP then
-		  (AdvanceTok(); exp1(e))
-		 else (prSynErr "missing '('") end
-		| ID(name) => exp1(lookup' name)
-		| _ => raise SyntaxError
-		
-	and exp1 = fn (e) => case !NextTok of
-		  SEMI => e
-		| ARROW => e
-		| EOF => e
-		| LP => exp2(e,exp0())
-		| RP => e
-		| t => (AdvanceTok(); case t of
-			  QMARK => exp1(optional(e))
-			| STAR => exp1(CLOSURE(e))
-			| PLUS => exp1(closure1(e))
-			| CHARS(c) => exp2(e,CLASS(c,0))
-			| BAR => ALT(e,exp0())
-			| DOLLAR => (UsesTrailingContext := true; endline(e))
-			| SLASH => (UsesTrailingContext := true;
-				    trail(e,exp0()))
-			| REPS(i,j) => exp1(repeat(i,j,e))
-			| ID(name) => exp2(e,lookup' name)
-			| _ => raise SyntaxError)
-			
-	and exp2 = fn (e1,e2) => case !NextTok of
-		  SEMI => CAT(e1,e2)
-		| ARROW => CAT(e1,e2)
-		| EOF => CAT(e1,e2)
-		| LP => exp2(CAT(e1,e2),exp0())
-		| RP => CAT(e1,e2)
-		| t => (AdvanceTok(); case t of
-		  	  QMARK => exp1(CAT(e1,optional(e2)))
-			| STAR => exp1(CAT(e1,CLOSURE(e2)))
-			| PLUS => exp1(CAT(e1,closure1(e2)))
-			| CHARS(c) => exp2(CAT(e1,e2),CLASS(c,0))
-			| BAR => ALT(CAT(e1,e2),exp0())
-			| DOLLAR => (UsesTrailingContext := true;
-				     endline(CAT(e1,e2)))
-			| SLASH => (UsesTrailingContext := true;
-				    trail(CAT(e1,e2),exp0()))
-			| REPS(i,j) => exp1(CAT(e1,repeat(i,j,e2)))
-			| ID(name) => exp2(CAT(e1,e2),lookup' name)
-			| _ => raise SyntaxError)
+        and newline = fn () => let val c = array(!CharSetSize,false) in
+                update(c,10,true); c
+                end
+        
+        and endline = fn e => trail(e,CLASS(newline(),0))
+        
+        and trail = fn (e1,e2) => CAT(CAT(e1,TRAIL(0)),e2)
+        
+        and closure1 = fn e => CAT(e,CLOSURE(e))
+        
+        and repeat = fn (min,max,e) => let val rec rep = fn
+                  (0,0) => EPS
+                | (0,1) => ALT(e,EPS)
+                | (0,i) => CAT(rep(0,1),rep(0,i-1))
+                | (i,j) => CAT(e,rep(i-1,j-1))
+        in rep(min,max)
+        end
+        
+        and exp0 = fn () => case GetTok() of
+                  CHARS(c) => exp1(CLASS(c,0))
+                | LP => let val e = exp0() in
+                 if !NextTok = RP then
+                  (AdvanceTok(); exp1(e))
+                 else (prSynErr "missing '('") end
+                | ID(name) => exp1(lookup' name)
+                | _ => raise SyntaxError
+                
+        and exp1 = fn (e) => case !NextTok of
+                  SEMI => e
+                | ARROW => e
+                | EOF => e
+                | LP => exp2(e,exp0())
+                | RP => e
+                | t => (AdvanceTok(); case t of
+                          QMARK => exp1(optional(e))
+                        | STAR => exp1(CLOSURE(e))
+                        | PLUS => exp1(closure1(e))
+                        | CHARS(c) => exp2(e,CLASS(c,0))
+                        | BAR => ALT(e,exp0())
+                        | DOLLAR => (UsesTrailingContext := true; endline(e))
+                        | SLASH => (UsesTrailingContext := true;
+                                    trail(e,exp0()))
+                        | REPS(i,j) => exp1(repeat(i,j,e))
+                        | ID(name) => exp2(e,lookup' name)
+                        | _ => raise SyntaxError)
+                        
+        and exp2 = fn (e1,e2) => case !NextTok of
+                  SEMI => CAT(e1,e2)
+                | ARROW => CAT(e1,e2)
+                | EOF => CAT(e1,e2)
+                | LP => exp2(CAT(e1,e2),exp0())
+                | RP => CAT(e1,e2)
+                | t => (AdvanceTok(); case t of
+                          QMARK => exp1(CAT(e1,optional(e2)))
+                        | STAR => exp1(CAT(e1,CLOSURE(e2)))
+                        | PLUS => exp1(CAT(e1,closure1(e2)))
+                        | CHARS(c) => exp2(CAT(e1,e2),CLASS(c,0))
+                        | BAR => ALT(CAT(e1,e2),exp0())
+                        | DOLLAR => (UsesTrailingContext := true;
+                                     endline(CAT(e1,e2)))
+                        | SLASH => (UsesTrailingContext := true;
+                                    trail(CAT(e1,e2),exp0()))
+                        | REPS(i,j) => exp1(CAT(e1,repeat(i,j,e2)))
+                        | ID(name) => exp2(CAT(e1,e2),lookup' name)
+                        | _ => raise SyntaxError)
 in exp0()
 end;
 val StateTab = ref(create(String.<=)) : (string,int) dictionary ref 
@@ -726,127 +741,127 @@
 fun GetStates () : int list =
 
    let fun add nil sl = sl
-  	  | add (x::y) sl = add y (union ([lookup (!StateTab)(x)
-					   handle LOOKUP =>
-					      prErr ("bad state name: "^x)
-					  ],sl))
+          | add (x::y) sl = add y (union ([lookup (!StateTab)(x)
+                                           handle LOOKUP =>
+                                              prErr ("bad state name: "^x)
+                                          ],sl))
 
-	fun addall i sl = 
-	    if i <= !StateNum then addall (i+2) (union ([i],sl))
-	    else sl
+        fun addall i sl = 
+            if i <= !StateNum then addall (i+2) (union ([i],sl))
+            else sl
 
-	fun incall (x::y) = (x+1)::incall y
-	  | incall nil = nil
+        fun incall (x::y) = (x+1)::incall y
+          | incall nil = nil
 
-	fun addincs nil = nil
-  	  | addincs (x::y) = x::(x+1)::addincs y
+        fun addincs nil = nil
+          | addincs (x::y) = x::(x+1)::addincs y
 
-	val state_list =
-	   case !NextTok of 
-	     STATE s => (AdvanceTok(); LexState := 1; add s nil)
-	     | _ => addall 1 nil
-		
+        val state_list =
+           case !NextTok of 
+             STATE s => (AdvanceTok(); LexState := 1; add s nil)
+             | _ => addall 1 nil
+                
       in case !NextTok
-	   of CARAT => (LexState := 1; AdvanceTok(); UsesPrevNewLine := true;
-			incall state_list)
-	    | _ => addincs state_list
+           of CARAT => (LexState := 1; AdvanceTok(); UsesPrevNewLine := true;
+                        incall state_list)
+            | _ => addincs state_list
       end
 
 val LeafNum: int ref = ref ~1;
 
 fun renum(e : exp) : exp =
-	let val rec label = fn
-	  EPS => EPS
-	| CLASS(x,_) => CLASS(x,++LeafNum)
-	| CLOSURE(e) => CLOSURE(label(e))
-	| ALT(e1,e2) => ALT(label(e1),label(e2))
-	| CAT(e1,e2) => CAT(label(e1),label(e2))
-	| TRAIL(i) => TRAIL(++LeafNum)
-	| END(i) => END(++LeafNum)
+        let val rec label = fn
+          EPS => EPS
+        | CLASS(x,_) => CLASS(x,++LeafNum)
+        | CLOSURE(e) => CLOSURE(label(e))
+        | ALT(e1,e2) => ALT(label(e1),label(e2))
+        | CAT(e1,e2) => CAT(label(e1),label(e2))
+        | TRAIL(i) => TRAIL(++LeafNum)
+        | END(i) => END(++LeafNum)
 in label(e)
 end;
 
 exception ParseError;
 
 fun parse() : (string * (int list * exp) list * ((string,string) dictionary)) =
-	let val Accept = ref (create String.<=) : (string,string) dictionary ref
-	val rec ParseRtns = fn l => case getch(!LexBuf) of
-		  #"%" => let val c = getch(!LexBuf) in
-		    	   if c = #"%" then (implode (rev l))
-			   else ParseRtns(c :: #"%" :: l)
-			end
-		| c => ParseRtns(c::l)
-	and ParseDefs = fn () =>
-		(LexState:=0; AdvanceTok(); case !NextTok of
-		  LEXMARK => ()
-		| LEXSTATES =>
-		   let fun f () = (case !NextTok of (ID i) =>
-				    (StateTab := enter(!StateTab)(i,++StateNum);
-				     ++StateNum; AdvanceTok(); f())
-					| _ => ())
-		   in AdvanceTok(); f ();
-		      if !NextTok=SEMI then ParseDefs() else 
-			(prSynErr "expected ';'")
-		   end
-		| ID x => (LexState:=1; AdvanceTok(); if GetTok() = ASSIGN
-			  then (SymTab := enter(!SymTab)(x,GetExp());
-			       if !NextTok = SEMI then ParseDefs()
-			       else (prSynErr "expected ';'"))
-			else raise SyntaxError)
-		| REJECT => (HaveReject := true; ParseDefs())
-		| COUNT => (CountNewLines := true; ParseDefs())
-		| FULLCHARSET => (CharSetSize := 256; ParseDefs())
-		| HEADER => (LexState := 2; AdvanceTok();
-			     case GetTok()
-			     of ACTION s => 
-				if (!StrDecl) then
-				   (prErr "cannot have both %structure and %header \
-				    \declarations")
-				else if (!HeaderDecl) then
-				   (prErr "duplicate %header declarations")
-				else 
-				    (HeaderCode := s; LexState := 0;
-				     HeaderDecl := true; ParseDefs())
-				| _ => raise SyntaxError)
-	        | POSARG => (PosArg := true; ParseDefs())
+        let val Accept = ref (create String.<=) : (string,string) dictionary ref
+        val rec ParseRtns = fn l => case getch(!LexBuf) of
+                  #"%" => let val c = getch(!LexBuf) in
+                           if c = #"%" then (implode (rev l))
+                           else ParseRtns(c :: #"%" :: l)
+                        end
+                | c => ParseRtns(c::l)
+        and ParseDefs = fn () =>
+                (LexState:=0; AdvanceTok(); case !NextTok of
+                  LEXMARK => ()
+                | LEXSTATES =>
+                   let fun f () = (case !NextTok of (ID i) =>
+                                    (StateTab := enter(!StateTab)(i,++StateNum);
+                                     ++StateNum; AdvanceTok(); f())
+                                        | _ => ())
+                   in AdvanceTok(); f ();
+                      if !NextTok=SEMI then ParseDefs() else 
+                        (prSynErr "expected ';'")
+                   end
+                | ID x => (LexState:=1; AdvanceTok(); if GetTok() = ASSIGN
+                          then (SymTab := enter(!SymTab)(x,GetExp());
+                               if !NextTok = SEMI then ParseDefs()
+                               else (prSynErr "expected ';'"))
+                        else raise SyntaxError)
+                | REJECT => (HaveReject := true; ParseDefs())
+                | COUNT => (CountNewLines := true; ParseDefs())
+                | FULLCHARSET => (CharSetSize := 256; ParseDefs())
+                | HEADER => (LexState := 2; AdvanceTok();
+                             case GetTok()
+                             of ACTION s => 
+                                if (!StrDecl) then
+                                   (prErr "cannot have both %structure and %header \
+                                    \declarations")
+                                else if (!HeaderDecl) then
+                                   (prErr "duplicate %header declarations")
+                                else 
+                                    (HeaderCode := s; LexState := 0;
+                                     HeaderDecl := true; ParseDefs())
+                                | _ => raise SyntaxError)
+                | POSARG => (PosArg := true; ParseDefs())
                 | ARG => (LexState := 2; AdvanceTok();
-			     case GetTok()
-			     of ACTION s => 
-				(case !ArgCode
-				   of SOME _ => prErr "duplicate %arg declarations"
-				    | NONE => ArgCode := SOME s;
-				 LexState := 0;
-				 ParseDefs())
-				| _ => raise SyntaxError)
-		| STRUCT => (AdvanceTok();
-			    case !NextTok of
-			       (ID i) =>
-			        if (!HeaderDecl) then
-				   (prErr "cannot have both %structure and %header \
-				    \declarations")
-				else if (!StrDecl) then
-				   (prErr "duplicate %structure declarations")
-				else (StrName := i; StrDecl := true)
-			         | _  => (prErr "expected ID");
-				ParseDefs())
-		| _ => raise SyntaxError)
-	and ParseRules =
-		fn rules => (LexState:=1; AdvanceTok(); case !NextTok of
-		  EOF => rules
-		| _ =>
-		 let val s = GetStates()
-		     val e = renum(CAT(GetExp(),END(0)))
-		 in
-		 if !NextTok = ARROW then 
-		   (LexState:=2; AdvanceTok();
-		    case GetTok() of ACTION(act) =>
-		      if !NextTok=SEMI then
-		        (Accept:=enter(!Accept) (Int.toString (!LeafNum),act);
-		         ParseRules((s,e)::rules))
-		      else (prSynErr "expected ';'")
-		    | _ => raise SyntaxError)
-		  else (prSynErr "expected '=>'")
-		end)
+                             case GetTok()
+                             of ACTION s => 
+                                (case !ArgCode
+                                   of SOME _ => prErr "duplicate %arg declarations"
+                                    | NONE => ArgCode := SOME s;
+                                 LexState := 0;
+                                 ParseDefs())
+                                | _ => raise SyntaxError)
+                | STRUCT => (AdvanceTok();
+                            case !NextTok of
+                               (ID i) =>
+                                if (!HeaderDecl) then
+                                   (prErr "cannot have both %structure and %header \
+                                    \declarations")
+                                else if (!StrDecl) then
+                                   (prErr "duplicate %structure declarations")
+                                else (StrName := i; StrDecl := true)
+                                 | _  => (prErr "expected ID");
+                                ParseDefs())
+                | _ => raise SyntaxError)
+        and ParseRules =
+                fn rules => (LexState:=1; AdvanceTok(); case !NextTok of
+                  EOF => rules
+                | _ =>
+                 let val s = GetStates()
+                     val e = renum(CAT(GetExp(),END(0)))
+                 in
+                 if !NextTok = ARROW then 
+                   (LexState:=2; AdvanceTok();
+                    case GetTok() of ACTION(act) =>
+                      if !NextTok=SEMI then
+                        (Accept:=enter(!Accept) (Int.toString (!LeafNum),act);
+                         ParseRules((s,e)::rules))
+                      else (prSynErr "expected ';'")
+                    | _ => raise SyntaxError)
+                  else (prSynErr "expected '=>'")
+                end)
 in let val usercode = ParseRtns nil
    in (ParseDefs(); (usercode,ParseRules(nil),!Accept))
    end
@@ -854,132 +869,132 @@
 
 fun makebegin () : unit =
    let fun make nil = ()
-	 | make ((x,n:int)::y)=(say "val "; say x; say " = " ;
-				say "STARTSTATE ";
-				say (Int.toString n); say ";\n"; make y)
+         | make ((x,n:int)::y)=(say "val "; say x; say " = " ;
+                                say "STARTSTATE ";
+                                say (Int.toString n); say ";\n"; make y)
    in say "\n(* start state definitions *)\n\n"; make(listofdict(!StateTab))
    end
                        
 structure L = 
-	struct
-	  nonfix >
-	  type key = int list * string
-	  fun > ((key,item:string),(key',item')) =
-	    let fun f ((a:int)::a') (b::b') = if Int.> (a,b) then true
-					   else if a=b then f a' b'
-					   else false
-		  | f _ _ = false
-	    in f key key'
-	    end
-	end
+        struct
+          nonfix >
+          type key = int list * string
+          fun > ((key,item:string),(key',item')) =
+            let fun f ((a:int)::a') (b::b') = if Int.> (a,b) then true
+                                           else if a=b then f a' b'
+                                           else false
+                  | f _ _ = false
+            in f key key'
+            end
+        end
 
 structure RB = RedBlack(L)
 
 fun maketable (fins:(int * (int list)) list,
-	     tcs :(int * (int list)) list,
-	     tcpairs: (int * int) list,
-	     trans : (int*(int list)) list) : unit =
+             tcs :(int * (int list)) list,
+             tcpairs: (int * int) list,
+             trans : (int*(int list)) list) : unit =
 
 (* Fins = (state #, list of final leaves for the state) list
    tcs = (state #, list of trailing context leaves which begin in this state)
-	 list
+         list
    tcpairs = (trailing context leaf, end leaf) list
    trans = (state #,list of transitions for state) list *)
 
    let datatype elem = N of int | T of int | D of int
        val count = ref 0
        val _ = (if length(trans)<256 then CharFormat := true
-		 else CharFormat := false;
-		 if !UsesTrailingContext then
-    		     (say "\ndatatype yyfinstate = N of int | \
-			   \ T of int | D of int\n")
-		 else say "\ndatatype yyfinstate = N of int";
-		 say "\ntype statedata = {fin : yyfinstate list, trans: ";
-		 case !CharFormat of
-		       true => say "string}"
-		     | false => say "int Vector.vector}";
-	         say "\n(* transition & final state table *)\nval tab = let\n";
-		 case !CharFormat of
-		       true => ()
-		     | false =>
-		       (say "fun decode s k =\n";
-			say "  let val k' = k + k\n";
-			say "      val hi = Char.ord(String.sub(s, k'))\n";
-			say "      val lo = Char.ord(String.sub(s, k' + 1))\n";
-			say "  in hi * 256 + lo end\n"))
+                 else CharFormat := false;
+                 if !UsesTrailingContext then
+                     (say "\ndatatype yyfinstate = N of int | \
+                           \ T of int | D of int\n")
+                 else say "\ndatatype yyfinstate = N of int";
+                 say "\ntype statedata = {fin : yyfinstate list, trans: ";
+                 case !CharFormat of
+                       true => say "string}"
+                     | false => say "int Vector.vector}";
+                 say "\n(* transition & final state table *)\nval tab = let\n";
+                 case !CharFormat of
+                       true => ()
+                     | false =>
+                       (say "fun decode s k =\n";
+                        say "  let val k' = k + k\n";
+                        say "      val hi = Char.ord(String.sub(s, k'))\n";
+                        say "      val lo = Char.ord(String.sub(s, k' + 1))\n";
+                        say "  in hi * 256 + lo end\n"))
 
       val newfins =
-	let fun IsEndLeaf t =
-	     let fun f ((l,e)::r) = if (e=t) then true else f r
-		   | f nil = false in f tcpairs end
+        let fun IsEndLeaf t =
+             let fun f ((l,e)::r) = if (e=t) then true else f r
+                   | f nil = false in f tcpairs end
 
-	 fun GetEndLeaf t = 
-	   let fun f ((tl,el)::r) = if (tl=t) then el else f r
-		 | f [] = raise Fail "GetEndLeaf"
+         fun GetEndLeaf t =
+           let fun f ((tl,el)::r) = if (tl=t) then el else f r
+                 | f _ = raise Match
            in f tcpairs
-	   end
-	 fun GetTrConLeaves s =
-	   let fun f ((s',l)::r) = if (s = s') then l else f r
-	         | f nil = nil
-	   in f tcs
-	   end
-	 fun sort_leaves s =
-	   let fun insert (x:int) (a::b) =
-		 if (x <= a) then x::(a::b)
-		 else a::(insert x b)
-		 | insert x nil = [x]
-	   in List.foldr (fn (x,r) => insert x r) [] s
-	   end
-	 fun conv a = if (IsEndLeaf a) then (D a) else (N a)
-	 fun merge (a::a',b::b') =
-	   if (a <= b) then (conv a)::merge(a',b::b')
-	   else (T b)::(merge(a::a',b'))
-	   | merge (a::a',nil) = (conv a)::(merge (a',nil))
-	   | merge (nil,b::b') = (T b)::(merge (b',nil))
-	   | merge (nil,nil) = nil
+           end
+         fun GetTrConLeaves s =
+           let fun f ((s',l)::r) = if (s = s') then l else f r
+                 | f nil = nil
+           in f tcs
+           end
+         fun sort_leaves s =
+           let fun insert (x:int) (a::b) =
+                 if (x <= a) then x::(a::b)
+                 else a::(insert x b)
+                 | insert x nil = [x]
+           in List.foldr (fn (x,r) => insert x r) [] s
+           end
+         fun conv a = if (IsEndLeaf a) then (D a) else (N a)
+         fun merge (a::a',b::b') =
+           if (a <= b) then (conv a)::merge(a',b::b')
+           else (T b)::(merge(a::a',b'))
+           | merge (a::a',nil) = (conv a)::(merge (a',nil))
+           | merge (nil,b::b') = (T b)::(merge (b',nil))
+           | merge (nil,nil) = nil
 
-	in map (fn (x,l) =>
-	  rev (merge (l,
-		sort_leaves (map (fn x => GetEndLeaf x) (GetTrConLeaves x)))))
-		    fins
-	end
+        in map (fn (x,l) =>
+          rev (merge (l,
+                sort_leaves (map (fn x => GetEndLeaf x) (GetTrConLeaves x)))))
+                    fins
+        end
 
-	val rs =
-	 let open RB
-	     fun makeItems x =
-	       let fun emit8(x, pos) =
-		     let val s = StringCvt.padLeft #"0" 3 (Int.toString x)
-		     in
-		       case pos
-			 of 16	=> (say "\\\n\\\\"; say s; 1)
-			  | _	=> (say "\\"; say s; pos+1)
-		     end
-		   fun emit16(x, pos) =
-		     let val hi8 = x div 256
-			 val lo8 = x - hi8 * 256	(* x rem 256 *)
-		     in
-		       emit8(lo8, emit8(hi8, pos))
-		     end
-		   fun MakeString([], _, _) = ()
-		     | MakeString(x::xs, emitter, pos) =
-			MakeString(xs, emitter, emitter(x, pos))
-	        in case !CharFormat of
-		    true => (say " \n\""; MakeString(x,emit8,0); say "\"\n")
-		  | false => (say (Int.toString(length x));
-		     say ", \n\""; MakeString(x,emit16,0); say "\"\n")
-	        end
+        val rs =
+         let open RB
+             fun makeItems x =
+               let fun emit8(x, pos) =
+                     let val s = StringCvt.padLeft #"0" 3 (Int.toString x)
+                     in
+                       case pos
+                         of 16  => (say "\\\n\\\\"; say s; 1)
+                          | _   => (say "\\"; say s; pos+1)
+                     end
+                   fun emit16(x, pos) =
+                     let val hi8 = x div 256
+                         val lo8 = x - hi8 * 256        (* x rem 256 *)
+                     in
+                       emit8(lo8, emit8(hi8, pos))
+                     end
+                   fun MakeString([], _, _) = ()
+                     | MakeString(x::xs, emitter, pos) =
+                        MakeString(xs, emitter, emitter(x, pos))
+                in case !CharFormat of
+                    true => (say " \n\""; MakeString(x,emit8,0); say "\"\n")
+                  | false => (say (Int.toString(length x));
+                     say ", \n\""; MakeString(x,emit16,0); say "\"\n")
+                end
 
-	    fun makeEntry(nil,rs,t) = rev rs
-	      | makeEntry(((l:int,x)::y),rs,t) =
-	          let val name = (Int.toString l)
-		  in let val (r,n) = lookup ((x,name),t)
-		      in makeEntry(y,(n::rs),t)
-		      end handle notfound _ => 
+            fun makeEntry(nil,rs,t) = rev rs
+              | makeEntry(((l:int,x)::y),rs,t) =
+                  let val name = (Int.toString l)
+                  in let val (r,n) = lookup ((x,name),t)
+                      in makeEntry(y,(n::rs),t)
+                      end handle notfound _ => 
                         (count := !count+1;
                           say " ("; say name; say ",";
-		          makeItems x; say "),\n";
-		         makeEntry(y,(name::rs),(insert ((x,name),t))))
-	   	  end
+                          makeItems x; say "),\n";
+                         makeEntry(y,(name::rs),(insert ((x,name),t))))
+                  end
 
             val _ = say "val s = [ \n" 
             val res =  makeEntry(trans,nil,empty)
@@ -995,39 +1010,68 @@
             val _ = say "  | look ([], i) = raise LexHackingError\n"
 
         val _ = say "fun g {fin=x, trans=i} = {fin=x, trans=look(s,i)} \n"
- 	 in res
-	end
+         in res
+        end
 
-	fun makeTable(nil,nil) = ()
-	  | makeTable(a::a',b::b') =
-	     let fun makeItems nil = ()
-		   | makeItems (hd::tl) =
-		     let val (t,n) =
-			 case hd of
-			   (N i) => ("(N ",i)
-			 | (T i) => ("(T ",i)
-			 | (D i) => ("(D ",i)
-		     in (say t; say (Int.toString n); say ")";
-			 if null tl
-			 then ()
-			 else (say ","; makeItems tl))
-		     end
-	      in (say "{fin = ["; makeItems b;
-		  say "], trans = "; say a; say "}";
-		  if null a'
-		  then ()
-		  else (say ",\n"; makeTable(a',b')))
-	      end
-	  | makeTable _ = raise Fail "makeTable"
+        fun makeTable args = let
+            fun makeOne (a, b) = let
+                fun item (N i) = ("N", i)
+                  | item (T i) = ("T", i)
+                  | item (D i) = ("D", i)
+                fun makeItem x = let
+                    val (t, n) = item x
+                in
+                    app say ["(", t, " ", Int.toString n, ")"]
+                end
+                fun makeItems [] = ()
+                  | makeItems [x] = makeItem x
+                  | makeItems (hd :: tl) =
+                    (makeItem hd; say ","; makeItems tl)
+            in
+                say "{fin = [";
+                makeItems b;
+                app say ["], trans = ", a, "}"]
+            end
+            fun mt ([], []) = ()
+              | mt ([a], [b]) = makeOne (a, b)
+              | mt (a :: a', b :: b') =
+                (makeOne (a, b); say ",\n"; mt (a', b'))
+              | mt _ = raise Match
+        in
+            mt args
+        end
+                        
+(*
+        fun makeTable(nil,nil) = ()
+          | makeTable(a::a',b::b') =
+             let fun makeItems nil = ()
+                   | makeItems (hd::tl) =
+                     let val (t,n) =
+                         case hd of
+                           (N i) => ("(N ",i)
+                         | (T i) => ("(T ",i)
+                         | (D i) => ("(D ",i)
+                     in (say t; say (Int.toString n); say ")";
+                         if null tl
+                         then ()
+                         else (say ","; makeItems tl))
+                     end
+              in (say "{fin = ["; makeItems b;
+                  say "], trans = "; say a; say "}";
+                  if null a'
+                  then ()
+                  else (say ",\n"; makeTable(a',b')))
+              end
+*)
 
-	fun msg x = TextIO.output(TextIO.stdOut, x)
+        fun msg x = TextIO.output(TextIO.stdOut, x)
 
   in (say "in Vector.fromList(map g \n["; makeTable(rs,newfins); 
       say "])\nend\n";
     msg ("\nNumber of states = " ^ (Int.toString (length trans)));
     msg ("\nNumber of distinct rows = " ^ (Int.toString (!count)));
     msg ("\nApprox. memory size of trans. table = " ^
-	  (Int.toString (!count*(!CharSetSize)*(if !CharFormat then 1 else 8))));
+          (Int.toString (!count*(!CharSetSize)*(if !CharFormat then 1 else 8))));
     msg " bytes\n")
 end
 
@@ -1037,9 +1081,9 @@
 
 fun makeaccept ends =
     let fun startline f = if f then say "  " else say "| "
-	 fun make(nil,f) = (startline f; say "_ => raise Internal.LexerError\n")
-	  | make((x,a)::y,f) = (startline f; say x; say " => ";
-				if Substring.size(#2 (Substring.position "yytext" (Substring.full a))) = 0
+         fun make(nil,f) = (startline f; say "_ => raise Internal.LexerError\n")
+          | make((x,a)::y,f) = (startline f; say x; say " => ";
+                                if Substring.size(#2 (Substring.position "yytext" (Substring.full a))) = 0
  then
                                      (say "("; say a; say ")")
                                 else (say "let val yytext=yymktext() in ";
@@ -1047,35 +1091,35 @@
                                 say "\n"; make(y,false))
     in make (listofdict(ends),true)
     end
-			
+                        
 fun leafdata(e:(int list * exp) list) =
-	let val fp = array(!LeafNum + 1,nil)
-	and leaf = array(!LeafNum + 1,EPS)
-	and tcpairs = ref nil
-	and trailmark = ref ~1;
-	val rec add = fn
-		  (nil,x) => ()
-		| (hd::tl,x) => (update(fp,hd,union(fp sub hd,x));
-			add(tl,x))
-	and moredata = fn
-		  CLOSURE(e1) =>
-			(moredata(e1); add(lastpos(e1),firstpos(e1)))
-		| ALT(e1,e2) => (moredata(e1); moredata(e2))
-		| CAT(e1,e2) => (moredata(e1); moredata(e2);
-			add(lastpos(e1),firstpos(e2)))
-		| CLASS(x,i) => update(leaf,i,CLASS(x,i))
-		| TRAIL(i) => (update(leaf,i,TRAIL(i)); if !trailmark = ~1
-			then trailmark := i else ())
-		| END(i) => (update(leaf,i,END(i)); if !trailmark <> ~1
-			then (tcpairs := (!trailmark,i)::(!tcpairs);
-			trailmark := ~1) else ())
-		| _ => ()
-	and makedata = fn
-		  nil => ()
-		| (_,x)::tl => (moredata(x);makedata(tl))
-	in trailmark := ~1; makedata(e); (fp,leaf,!tcpairs)
-	end;
-	
+        let val fp = array(!LeafNum + 1,nil)
+        and leaf = array(!LeafNum + 1,EPS)
+        and tcpairs = ref nil
+        and trailmark = ref ~1;
+        val rec add = fn
+                  (nil,x) => ()
+                | (hd::tl,x) => (update(fp,hd,union(fp sub hd,x));
+                        add(tl,x))
+        and moredata = fn
+                  CLOSURE(e1) =>
+                        (moredata(e1); add(lastpos(e1),firstpos(e1)))
+                | ALT(e1,e2) => (moredata(e1); moredata(e2))
+                | CAT(e1,e2) => (moredata(e1); moredata(e2);
+                        add(lastpos(e1),firstpos(e2)))
+                | CLASS(x,i) => update(leaf,i,CLASS(x,i))
+                | TRAIL(i) => (update(leaf,i,TRAIL(i)); if !trailmark = ~1
+                        then trailmark := i else ())
+                | END(i) => (update(leaf,i,END(i)); if !trailmark <> ~1
+                        then (tcpairs := (!trailmark,i)::(!tcpairs);
+                        trailmark := ~1) else ())
+                | _ => ()
+        and makedata = fn
+                  nil => ()
+                | (_,x)::tl => (moredata(x);makedata(tl))
+        in trailmark := ~1; makedata(e); (fp,leaf,!tcpairs)
+        end;
+        
 fun makedfa(rules) =
 let val StateTab = ref (create(String.<=)) : (string,int) dictionary ref
     val fintab = ref (create(Int.<=)) : (int,(int list)) dictionary ref
@@ -1084,89 +1128,89 @@
     val (fp, leaf, tcpairs) = leafdata(rules);
 
 fun visit (state,statenum) =
-	let val transitions = gettrans(state) in
-	   fintab := enter(!fintab)(statenum,getfin(state));
-	   tctab := enter(!tctab)(statenum,gettc(state));
-	   transtab := enter(!transtab)(statenum,transitions)
-	end
-	
+        let val transitions = gettrans(state) in
+           fintab := enter(!fintab)(statenum,getfin(state));
+           tctab := enter(!tctab)(statenum,gettc(state));
+           transtab := enter(!transtab)(statenum,transitions)
+        end
+        
 and visitstarts (states) =
-	let fun vs nil i = ()
-	      | vs (hd::tl) i = (visit (hd,i); vs tl (i+1))
-	in vs states 0
-	end
-	
+        let fun vs nil i = ()
+              | vs (hd::tl) i = (visit (hd,i); vs tl (i+1))
+        in vs states 0
+        end
+        
 and hashstate(s: int list) =
-	let val rec hs =
-	        fn (nil,z) => z
-		 | ((x:int)::y,z) => hs(y,z ^ " " ^ (Int.toString x))
-	in hs(s,"")
-	end
-	
+        let val rec hs =
+                fn (nil,z) => z
+                 | ((x:int)::y,z) => hs(y,z ^ " " ^ (Int.toString x))
+        in hs(s,"")
+        end
+        
 and find(s) = lookup(!StateTab)(hashstate(s))
 
 and add(s,n) = StateTab := enter(!StateTab)(hashstate(s),n)
 
 and getstate (state) =
-	find(state)
-	handle LOOKUP => let val n = ++StateNum in
-		add(state,n); visit(state,n); n
-		end
-		
+        find(state)
+        handle LOOKUP => let val n = ++StateNum in
+                add(state,n); visit(state,n); n
+                end
+                
 and getfin state =
-	let fun f nil fins = fins
-	      | f (hd::tl) fins =
-	         case (leaf sub hd) 
-	            of END _ => f tl (hd::fins)
-	             | _ => f tl fins
-	in f state nil
-	end
+        let fun f nil fins = fins
+              | f (hd::tl) fins =
+                 case (leaf sub hd) 
+                    of END _ => f tl (hd::fins)
+                     | _ => f tl fins
+        in f state nil
+        end
 
 and gettc state =
-	let fun f nil fins = fins
-	      | f (hd::tl) fins =
-	         case (leaf sub hd) 
-	            of TRAIL _ => f tl (hd::fins)
-	             | _ => f tl fins
-	in f state nil
-	end
+        let fun f nil fins = fins
+              | f (hd::tl) fins =
+                 case (leaf sub hd) 
+                    of TRAIL _ => f tl (hd::fins)
+                     | _ => f tl fins
+        in f state nil
+        end
 
 and gettrans (state) =
       let fun loop c tlist =
-	 let fun cktrans nil r = r
-	       | cktrans (hd::tl) r =
-		  case (leaf sub hd) of
-	           CLASS(i,_)=>
-			(if (i sub c) then cktrans tl (union(r,fp sub hd))
-		         else cktrans tl r handle Subscript => 
-						cktrans tl r
-			)
-		   | _ => cktrans tl r
-	 in if c >= 0 then
-	      let val v=cktrans state nil
-	      in loop (c-1) (if v=nil then 0::tlist else (getstate v)::tlist)
-	      end
-	    else tlist
-	 end
+         let fun cktrans nil r = r
+               | cktrans (hd::tl) r =
+                  case (leaf sub hd) of
+                   CLASS(i,_)=>
+                        (if (i sub c) then cktrans tl (union(r,fp sub hd))
+                         else cktrans tl r handle Subscript => 
+                                                cktrans tl r
+                        )
+                   | _ => cktrans tl r
+         in if c >= 0 then
+              let val v=cktrans state nil
+              in loop (c-1) (if v=nil then 0::tlist else (getstate v)::tlist)
+              end
+            else tlist
+         end
      in loop ((!CharSetSize) - 1) nil
      end
-	
+        
 and startstates() =
-	let val startarray = array(!StateNum + 1, nil);
+        let val startarray = array(!StateNum + 1, nil);
             fun listofarray(a,n) =
-  		let fun f i l = if i >= 0 then  f (i-1) ((a sub i)::l) else l
- 		in f (n-1) nil end
-	val rec makess = fn
-		  nil => ()
-		| (startlist,e)::tl => (fix(startlist,firstpos(e));makess(tl))
-	and fix = fn
-		  (nil,_) => ()
-		| (s::tl,firsts) => (update(startarray,s,
-			union(firsts,startarray sub s));
-			fix(tl,firsts))
-	in makess(rules);listofarray(startarray, !StateNum + 1)
-	end
-	
+                let fun f i l = if i >= 0 then  f (i-1) ((a sub i)::l) else l
+                in f (n-1) nil end
+        val rec makess = fn
+                  nil => ()
+                | (startlist,e)::tl => (fix(startlist,firstpos(e));makess(tl))
+        and fix = fn
+                  (nil,_) => ()
+                | (s::tl,firsts) => (update(startarray,s,
+                        union(firsts,startarray sub s));
+                        fix(tl,firsts))
+        in makess(rules);listofarray(startarray, !StateNum + 1)
+        end
+        
 in visitstarts(startstates());
 (listofdict(!fintab),listofdict(!transtab),listofdict(!tctab),tcpairs)
 end
@@ -1189,157 +1233,157 @@
 \                          end\n\
 \"
 
-fun lexGen infile =
+fun lexGen(infile) =
     let val outfile = infile ^ ".sml"
       fun PrintLexer (ends) =
     let val sayln = fn x => (say x; say "\n")
      in case !ArgCode 
-	 of NONE => (sayln "fun lex () : Internal.result =";
-		     sayln "let fun continue() = lex() in")
-	  | SOME s => (say "fun lex "; say "(yyarg as ("; say s; sayln ")) =";
-		       sayln "let fun continue() : Internal.result = ");
-	 say "  let fun scan (s,AcceptingLeaves : Internal.yyfinstate";
-	 sayln " list list,l,i0: int) =";
-	 if !UsesTrailingContext
-	     then say "\tlet fun action (i: int,nil,rs)"
-	     else say "\tlet fun action (i: int,nil)";
-	 sayln " = raise LexError";
-	 if !UsesTrailingContext
-	     then sayln "\t| action (i,nil::l,rs) = action(i-1,l,rs)"
-	     else sayln "\t| action (i,nil::l) = action (i-1,l)";
-	 if !UsesTrailingContext
-	     then sayln "\t| action (i,(node::acts)::l,rs) ="
-	     else sayln "\t| action (i,(node::acts)::l) =";
-	 sayln "\t\tcase node of";
-	 sayln "\t\t    Internal.N yyk => ";
-	 sayln "\t\t\t(let fun yymktext() = String.substring(!yyb,i0,i-i0)\n\
-	       \\t\t\t     val yypos: int = i0+ !yygone";
-	 if !CountNewLines 
-	    then (sayln "\t\t\tval _ = yylineno := CharVector.foldl";
-	  	  sayln "\t\t\t\t(fn (_,#\"\\n\", n) => n+1 | (_,_, n) => n) (!yylineno) (!yyb,i0,SOME(i-i0))")
-	    else ();
-	 if !HaveReject
-	     then (say "\t\t\tfun REJECT() = action(i,acts::l";
-		   if !UsesTrailingContext
-		       then sayln ",rs)" else sayln ")")
-	     else ();	 
-	 sayln "\t\t\topen UserDeclarations Internal.StartStates";
-	 sayln " in (yybufpos := i; case yyk of ";
-	 sayln "";
-	 sayln "\t\t\t(* Application actions *)\n";
-	 makeaccept(ends);
-	 say "\n\t\t) end ";
-	 say ")\n\n";
-	 if (!UsesTrailingContext) then say skel_mid2 else ();
-	 sayln "\tval {fin,trans} = Vector.sub (Internal.tab, s)";
-	 sayln "\tval NewAcceptingLeaves = fin::AcceptingLeaves";
-	 sayln "\tin if l = !yybl then";
-	 sayln "\t     if trans = #trans(Vector.sub(Internal.tab,0))";
-	 sayln "\t       then action(l,NewAcceptingLeaves";
-	 if !UsesTrailingContext then say ",nil" else ();
+         of NONE => (sayln "fun lex () : Internal.result =";
+                     sayln "let fun continue() = lex() in")
+          | SOME s => (say "fun lex "; say "(yyarg as ("; say s; sayln ")) =";
+                       sayln "let fun continue() : Internal.result = ");
+         say "  let fun scan (s,AcceptingLeaves : Internal.yyfinstate";
+         sayln " list list,l,i0: int) =";
+         if !UsesTrailingContext
+             then say "\tlet fun action (i: int,nil,rs)"
+             else say "\tlet fun action (i: int,nil)";
+         sayln " = raise LexError";
+         if !UsesTrailingContext
+             then sayln "\t| action (i,nil::l,rs) = action(i-1,l,rs)"
+             else sayln "\t| action (i,nil::l) = action (i-1,l)";
+         if !UsesTrailingContext
+             then sayln "\t| action (i,(node::acts)::l,rs) ="
+             else sayln "\t| action (i,(node::acts)::l) =";
+         sayln "\t\tcase node of";
+         sayln "\t\t    Internal.N yyk => ";
+         sayln "\t\t\t(let fun yymktext() = String.substring(!yyb,i0,i-i0)\n\
+               \\t\t\t     val yypos: int = i0+ !yygone";
+         if !CountNewLines 
+            then (sayln "\t\t\tval _ = yylineno := CharVectorSlice.foldli";
+                  sayln "\t\t\t\t(fn (_,#\"\\n\", n) => n+1 | (_,_, n) => n) (!yylineno) (CharVectorSlice.slice (!yyb,i0,SOME(i-i0)))")
+            else ();
+         if !HaveReject
+             then (say "\t\t\tfun REJECT() = action(i,acts::l";
+                   if !UsesTrailingContext
+                       then sayln ",rs)" else sayln ")")
+             else ();    
+         sayln "\t\t\topen UserDeclarations Internal.StartStates";
+         sayln " in (yybufpos := i; case yyk of ";
+         sayln "";
+         sayln "\t\t\t(* Application actions *)\n";
+         makeaccept(ends);
+         say "\n\t\t) end ";
+         say ")\n\n";
+         if (!UsesTrailingContext) then say skel_mid2 else ();
+         sayln "\tval {fin,trans} = Vector.sub (Internal.tab, s)";
+         sayln "\tval NewAcceptingLeaves = fin::AcceptingLeaves";
+         sayln "\tin if l = !yybl then";
+         sayln "\t     if trans = #trans(Vector.sub(Internal.tab,0))";
+         sayln "\t       then action(l,NewAcceptingLeaves";
+         if !UsesTrailingContext then say ",nil" else ();
          say ") else";
-	 sayln "\t    let val newchars= if !yydone then \"\" else yyinput 1024";
-	 sayln "\t    in if (String.size newchars)=0";
-	 sayln "\t\t  then (yydone := true;";
-	 say "\t\t        if (l=i0) then UserDeclarations.eof ";
-	 sayln (case !ArgCode of NONE => "()" | SOME _ => "yyarg");
-	 say   "\t\t                  else action(l,NewAcceptingLeaves";
-	 if !UsesTrailingContext then
-	    sayln ",nil))" else sayln "))";
-	 sayln "\t\t  else (if i0=l then yyb := newchars";
-	 sayln "\t\t     else yyb := String.substring(!yyb,i0,l-i0)^newchars;";
-	 sayln "\t\t     yygone := !yygone+i0;";
-	 sayln "\t\t     yybl := String.size (!yyb);";
-	 sayln "\t\t     scan (s,AcceptingLeaves,l-i0,0))";
-	 sayln "\t    end";
-	 sayln "\t  else let val NewChar = Char.ord (CharVector.sub (!yyb,l))";
+         sayln "\t    let val newchars= if !yydone then \"\" else yyinput 1024";
+         sayln "\t    in if (String.size newchars)=0";
+         sayln "\t\t  then (yydone := true;";
+         say "\t\t        if (l=i0) then UserDeclarations.eof ";
+         sayln (case !ArgCode of NONE => "()" | SOME _ => "yyarg");
+         say   "\t\t                  else action(l,NewAcceptingLeaves";
+         if !UsesTrailingContext then
+            sayln ",nil))" else sayln "))";
+         sayln "\t\t  else (if i0=l then yyb := newchars";
+         sayln "\t\t     else yyb := String.substring(!yyb,i0,l-i0)^newchars;";
+         sayln "\t\t     yygone := !yygone+i0;";
+         sayln "\t\t     yybl := String.size (!yyb);";
+         sayln "\t\t     scan (s,AcceptingLeaves,l-i0,0))";
+         sayln "\t    end";
+         sayln "\t  else let val NewChar = Char.ord (CharVector.sub (!yyb,l))";
          if !CharSetSize=129
            then sayln "\t\tval NewChar = if NewChar<128 then NewChar else 128" 
            else ();
-	 say "\t\tval NewState = ";
-	 sayln (if !CharFormat 
+         say "\t\tval NewState = ";
+         sayln (if !CharFormat 
                 then "Char.ord (CharVector.sub (trans,NewChar))"
                 else "Vector.sub (trans, NewChar)");
-	 say "\t\tin if NewState=0 then action(l,NewAcceptingLeaves";
-	 if !UsesTrailingContext then sayln ",nil)" else sayln ")";
-	 sayln "\t\telse scan(NewState,NewAcceptingLeaves,l+1,i0)";
-	 sayln "\tend";
-	 sayln "\tend";
-	 if !UsesPrevNewLine then () else sayln "(*";
-	 sayln "\tval start= if String.substring(!yyb,!yybufpos-1,1)=\"\\n\"";
-	 sayln "then !yybegin+1 else !yybegin";
-	 if !UsesPrevNewLine then () else sayln "*)";
-	 say "\tin scan(";
-	 if !UsesPrevNewLine then say "start" 
-	 else say "!yybegin (* start *)";
-	 sayln ",nil,!yybufpos,!yybufpos)";
-	 sayln "    end";
-	 sayln (case !ArgCode of NONE => "end" | SOME _ => "in continue end");
-	 sayln "  in lex";
-	 sayln "  end";
-	 sayln "end"
-	end
+         say "\t\tin if NewState=0 then action(l,NewAcceptingLeaves";
+         if !UsesTrailingContext then sayln ",nil)" else sayln ")";
+         sayln "\t\telse scan(NewState,NewAcceptingLeaves,l+1,i0)";
+         sayln "\tend";
+         sayln "\tend";
+         if !UsesPrevNewLine then () else sayln "(*";
+         sayln "\tval start= if String.substring(!yyb,!yybufpos-1,1)=\"\\n\"";
+         sayln "then !yybegin+1 else !yybegin";
+         if !UsesPrevNewLine then () else sayln "*)";
+         say "\tin scan(";
+         if !UsesPrevNewLine then say "start" 
+         else say "!yybegin (* start *)";
+         sayln ",nil,!yybufpos,!yybufpos)";
+         sayln "    end";
+         sayln (case !ArgCode of NONE => "end" | SOME _ => "in continue end");
+         sayln "  in lex";
+         sayln "  end";
+         sayln "end"
+        end
 
     in (UsesPrevNewLine := false;
-	ResetFlags();
+        ResetFlags();
         LexBuf := make_ibuf(TextIO.openIn infile);
         NextTok := BOF;
         inquote := false;
-	LexOut := TextIO.openOut(outfile);
-	StateNum := 2;
-	LineNum := 1;
-	StateTab := enter(create(String.<=))("INITIAL",1);
-	LeafNum := ~1;
-	let
-	   val (user_code,rules,ends) =
-	       parse() handle x =>
-               	  (close_ibuf(!LexBuf);
-		   TextIO.closeOut(!LexOut);
-		   OS.FileSys.remove outfile;
-		   raise x)
-	   val (fins,trans,tctab,tcpairs) = makedfa(rules)
-	   val _ = if !UsesTrailingContext then
-	              (close_ibuf(!LexBuf);
-		       TextIO.closeOut(!LexOut);
-		       OS.FileSys.remove outfile;
-		       prErr "lookahead is unimplemented")
-		   else ()
-	in
-	   say "type int = Int.int\n";
-	  if (!HeaderDecl)
-	      then say (!HeaderCode)
-	      else say ("structure " ^ (!StrName));
-	  say "=\n";
-	  say skel_hd;
-	  say user_code;
-	  say "end (* end of user routines *)\n";
-	  say "exception LexError (* raised if illegal leaf ";
-	  say "action tried *)\n";
-	  say "structure Internal =\n\tstruct\n";
-	  maketable(fins,tctab,tcpairs,trans);
-	  say "structure StartStates =\n\tstruct\n";
-	  say "\tdatatype yystartstate = STARTSTATE of int\n";
-	  makebegin();
-	  say "\nend\n";
-	  say "type result = UserDeclarations.lexresult\n";
-	  say "\texception LexerError (* raised if illegal leaf ";
-	  say "action tried *)\n";
-	  say "end\n\n";
-	  say "type int = Int.int\n";
-	  say (if (!PosArg) then "fun makeLexer (yyinput: int -> string,yygone0:int) =\nlet\n"
-		else "fun makeLexer (yyinput: int -> string) =\nlet\tval yygone0:int=1\n");
-	  if !CountNewLines then say "\tval yylineno: int ref = ref 0\n\n" else ();
-	  say "\tval yyb = ref \"\\n\" \t\t(* buffer *)\n\
-	  \\tval yybl: int ref = ref 1\t\t(*buffer length *)\n\
-	  \\tval yybufpos: int ref = ref 1\t\t(* location of next character to use *)\n\
-	  \\tval yygone: int ref = ref yygone0\t(* position in file of beginning of buffer *)\n\
-	  \\tval yydone = ref false\t\t(* eof found yet? *)\n\
-	  \\tval yybegin: int ref = ref 1\t\t(*Current 'start state' for lexer *)\n\
-  	  \\n\tval YYBEGIN = fn (Internal.StartStates.STARTSTATE x) =>\n\
-	  \\t\t yybegin := x\n\n";
-	  PrintLexer(ends);
-	  close_ibuf(!LexBuf);
-	   TextIO.closeOut(!LexOut)
-	 end)
+        LexOut := TextIO.openOut(outfile);
+        StateNum := 2;
+        LineNum := 1;
+        StateTab := enter(create(String.<=))("INITIAL",1);
+        LeafNum := ~1;
+        let
+           val (user_code,rules,ends) =
+               parse() handle x =>
+                  (close_ibuf(!LexBuf);
+                   TextIO.closeOut(!LexOut);
+                   OS.FileSys.remove outfile;
+                   raise x)
+           val (fins,trans,tctab,tcpairs) = makedfa(rules)
+           val _ = if !UsesTrailingContext then
+                      (close_ibuf(!LexBuf);
+                       TextIO.closeOut(!LexOut);
+                       OS.FileSys.remove outfile;
+                       prErr "lookahead is unimplemented")
+                   else ()
+        in
+           say "type int = Int.int\n";
+          if (!HeaderDecl)
+              then say (!HeaderCode)
+              else say ("structure " ^ (!StrName));
+          say "=\n";
+          say skel_hd;
+          say user_code;
+          say "end (* end of user routines *)\n";
+          say "exception LexError (* raised if illegal leaf ";
+          say "action tried *)\n";
+          say "structure Internal =\n\tstruct\n";
+          maketable(fins,tctab,tcpairs,trans);
+          say "structure StartStates =\n\tstruct\n";
+          say "\tdatatype yystartstate = STARTSTATE of int\n";
+          makebegin();
+          say "\nend\n";
+          say "type result = UserDeclarations.lexresult\n";
+          say "\texception LexerError (* raised if illegal leaf ";
+          say "action tried *)\n";
+          say "end\n\n";
+          say "type int = Int.int\n";
+          say (if (!PosArg) then "fun makeLexer (yyinput: int -> string,yygone0:int) =\nlet\n"
+                else "fun makeLexer (yyinput: int -> string) =\nlet\tval yygone0:int= ~1\n");
+          if !CountNewLines then say "\tval yylineno: int ref = ref 0\n\n" else ();
+          say "\tval yyb = ref \"\\n\" \t\t(* buffer *)\n\
+          \\tval yybl: int ref = ref 1\t\t(*buffer length *)\n\
+          \\tval yybufpos: int ref = ref 1\t\t(* location of next character to use *)\n\
+          \\tval yygone: int ref = ref yygone0\t(* position in file of beginning of buffer *)\n\
+          \\tval yydone = ref false\t\t(* eof found yet? *)\n\
+          \\tval yybegin: int ref = ref 1\t\t(*Current 'start state' for lexer *)\n\
+          \\n\tval YYBEGIN = fn (Internal.StartStates.STARTSTATE x) =>\n\
+          \\t\t yybegin := x\n\n";
+          PrintLexer(ends);
+          close_ibuf(!LexBuf);
+           TextIO.closeOut(!LexOut)
+         end)
     end
 end

Modified: mlton/branches/on-20050420-cmm-branch/mllex/lexgen.tex
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mllex/lexgen.tex	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mllex/lexgen.tex	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,10 @@
 \documentstyle{article}
 \title{        A lexical analyzer generator for Standard ML.\\
-			       Version 1.6.0, October 1994
+                               Version 1.6.0, October 1994
       }
 \author{                    Andrew W. Appel$^1$\\
-	                    James S. Mattson\\
-        	            David R. Tarditi$^2$\\
+                            James S. Mattson\\
+                            David R. Tarditi$^2$\\
 \\              
 \small
 $^1$Department of Computer Science, Princeton University \\
@@ -153,100 +153,100 @@
 to the most weakly binding):
 
 \begin{itemize}
-\item	An individual character stands for itself, except for the
-	reserved characters  \verb@? * + | ( ) ^ $ / ; . = < > [ { " \@
+\item   An individual character stands for itself, except for the
+        reserved characters  \verb@? * + | ( ) ^ $ / ; . = < > [ { " \@
 
-\item[\\]	A backslash followed by one of the reserved characters stands
-	for that character.
+\item[\\]       A backslash followed by one of the reserved characters stands
+        for that character.
 
-\item	A set of characters enclosed in square brackets [ ] stands
-	for any one of those characters.  Inside the brackets, only
-	the symbols  \verb|\ - ^| are reserved.  An initial up-arrow 
-	\verb|^| stands
-	for the complement of the characters listed, e.g. \verb|[^abc]|
-	stands any character except a, b, or c.  The hyphen - denotes
-	a range of characters, e.g. \verb|[a-z]| stands for any lower-case
-	alphabetic character, and \verb|[0-9a-fA-F]| stands for any hexadecimal
-	digit.  To include \verb|^| literally in a bracketed set, put it anywhere
-	but first; to include \verb|-| literally in a set, put it first or last.
+\item   A set of characters enclosed in square brackets [ ] stands
+        for any one of those characters.  Inside the brackets, only
+        the symbols  \verb|\ - ^| are reserved.  An initial up-arrow 
+        \verb|^| stands
+        for the complement of the characters listed, e.g. \verb|[^abc]|
+        stands any character except a, b, or c.  The hyphen - denotes
+        a range of characters, e.g. \verb|[a-z]| stands for any lower-case
+        alphabetic character, and \verb|[0-9a-fA-F]| stands for any hexadecimal
+        digit.  To include \verb|^| literally in a bracketed set, put it anywhere
+        but first; to include \verb|-| literally in a set, put it first or last.
 
-\item[\verb|.|]	The dot \verb|.| character stands for any character except newline,
-	i.e. the same as \verb|[^\n]|
+\item[\verb|.|] The dot \verb|.| character stands for any character except newline,
+        i.e. the same as \verb|[^\n]|
 
-\item	The following special escape sequences are available, inside
-	or outside of square-brackets:
+\item   The following special escape sequences are available, inside
+        or outside of square-brackets:
 
-	\begin{tabular}{ll}
-	\verb|\b|& backspace\\
-	\verb|\n|& newline\\
-	\verb|\t|& tab\\
-	\verb|\h|& stands for all characters with codes $>127$,\\
-	  	    &~~~~      when 7-bit characters are used.\\
-	\verb|\ddd|& where \verb|ddd| is a 3 digit decimal escape.\\
+        \begin{tabular}{ll}
+        \verb|\b|& backspace\\
+        \verb|\n|& newline\\
+        \verb|\t|& tab\\
+        \verb|\h|& stands for all characters with codes $>127$,\\
+                    &~~~~      when 7-bit characters are used.\\
+        \verb|\ddd|& where \verb|ddd| is a 3 digit decimal escape.\\
 
-	\end{tabular}
+        \end{tabular}
 
-\item[\verb|"|]	A sequence of characters will stand for itself (reserved
+\item[\verb|"|] A sequence of characters will stand for itself (reserved
         characters will be taken literally) if it is enclosed in
-	double quotes \verb|" "|.
+        double quotes \verb|" "|.
 
-\item[\{\}]	A named regular expression (defined in the ``definitions"
-	section) may be referred to by enclosing its name in
-	braces \verb|{ }|.
+\item[\{\}]     A named regular expression (defined in the ``definitions"
+        section) may be referred to by enclosing its name in
+        braces \verb|{ }|.
 
 \item[()] Any regular expression may be enclosed in parentheses \verb|( )|
-	for syntactic (but, as usual, not semantic) effect.
+        for syntactic (but, as usual, not semantic) effect.
 
-\item[\verb|*|]	The postfix operator \verb|*| stands for Kleene closure:
-	zero or more repetitions of the preceding expression.
+\item[\verb|*|] The postfix operator \verb|*| stands for Kleene closure:
+        zero or more repetitions of the preceding expression.
 
-\item[\verb|+|]	The postfix operator \verb|+| stands for one or more repetitions
-	of the preceding expression.
+\item[\verb|+|] The postfix operator \verb|+| stands for one or more repetitions
+        of the preceding expression.
 
-\item[\verb|?|]	The postfix operator \verb|?| stands for zero or one occurrence of
-	the preceding expression.
+\item[\verb|?|] The postfix operator \verb|?| stands for zero or one occurrence of
+        the preceding expression.
 
-\item	A postfix repetition range $\{n_1,n_2\}$ where $n_1$ and $n_2$ are small
-	integers stands for any number of repetitions between $n_1$ and $n_2$
-	of the preceding expression.  The notation $\{n_1\}$ stands for
-	exactly $n_1$ repetitions.
+\item   A postfix repetition range $\{n_1,n_2\}$ where $n_1$ and $n_2$ are small
+        integers stands for any number of repetitions between $n_1$ and $n_2$
+        of the preceding expression.  The notation $\{n_1\}$ stands for
+        exactly $n_1$ repetitions.
 
-\item	Concatenation of expressions denotes concatenation of strings.
-	The expression $e_1 e_2$ stands for any string that results from
-	the concatenation of one string that matches $e_1$ with another
-	string that matches $e_2$.
+\item   Concatenation of expressions denotes concatenation of strings.
+        The expression $e_1 e_2$ stands for any string that results from
+        the concatenation of one string that matches $e_1$ with another
+        string that matches $e_2$.
 
-\item\verb-|-	The infix operator \verb-|- stands for alternation.  The expression
-	$e_1$~\verb"|"~$e_2$  stands for anything that either $e_1$ or $e_2$ stands for.
+\item\verb-|-   The infix operator \verb-|- stands for alternation.  The expression
+        $e_1$~\verb"|"~$e_2$  stands for anything that either $e_1$ or $e_2$ stands for.
     
-\item[\verb|/|]	The infix operator \verb|/| denotes lookahead.  Lookahead is not
+\item[\verb|/|] The infix operator \verb|/| denotes lookahead.  Lookahead is not
         implemented and cannot be used, because there is a bug
         in the algorithm for generating lexers with lookahead.  If
         it could be used, the expression $e_1 / e_2$ would match any string
         that $e_1$ stands for, but only when that string is followed by a
         string that matches $e_2$.
 
-\item	When the up-arrow \verb|^| occurs at the beginning of an expression,
-	that expression will only match strings that occur at the
-	beginning of a line (right after a newline character).
+\item   When the up-arrow \verb|^| occurs at the beginning of an expression,
+        that expression will only match strings that occur at the
+        beginning of a line (right after a newline character).
 
 \item[\$]   The dollar sign of C Lex \$ is not implemented, since it is an abbreviation
         for lookahead involving the newline character (that is, it
         is an abbreviation for \verb|/\n|).
 \end{itemize}
-	
+        
 Here are some examples of regular expressions, and descriptions of the
 set of strings they denote:
 
 \begin{tabular}{ll}
 \verb~0 | 1 | 2 | 3~&           A single digit between 0 and 3\\
-\verb|[0123]|&			A single digit between 0 and 3\\
+\verb|[0123]|&                  A single digit between 0 and 3\\
 \verb|0123|&                    The string ``0123"\\
 \verb|0*|&                      All strings of 0 or more 0's\\
 \verb|00*|&                     All strings of 1  or more 0's\\
 \verb|0+|&                      All strings of 1  or more 0's\\
-\verb|[0-9]{3}|&		Any three-digit decimal number.\\
-\verb|\\[ntb]|&			A newline, tab, or backspace.\\
+\verb|[0-9]{3}|&                Any three-digit decimal number.\\
+\verb|\\[ntb]|&                 A newline, tab, or backspace.\\
 \verb|(00)*|& Any string with an even number of 0's.
 \end{tabular}
 
@@ -290,11 +290,11 @@
                           as input.
 \item[\tt \%structure \{identifier\}]  name the structure in the output program
                           {identifier} instead of Mlex
-\item[\tt \%header] 	use code following it to create header for lexer
-			  structure
+\item[\tt \%header]     use code following it to create header for lexer
+                          structure
 \item[\tt \%arg]       extra (curried) formal parameter argument to be
-			  passed to the lex functions, and to be passed
-			  to the eof function in place of ()
+                          passed to the lex functions, and to be passed
+                          to the eof function in place of ()
 \end{description}
         These functions are discussed in section~\ref{avail}.
 
@@ -355,13 +355,13 @@
 {\bf Value}&{\bf \% command}&{\bf description}\\
 \hline
 {\tt REJECT} &{\tt\%reject}&\parbox[t]{2.6in}{{\tt REJECT()} causes the current
-					rule to be ``rejected.''
-					The lexer behaves as if the
-					current rule had not matched;
-					another rule that matches this
-					string, or that matches the longest
-					possible prefix of this string,
-					is used instead.} \\
+                                        rule to be ``rejected.''
+                                        The lexer behaves as if the
+                                        current rule had not matched;
+                                        another rule that matches this
+                                        string, or that matches the longest
+                                        possible prefix of this string,
+                                        is used instead.} \\
 {\tt yypos} & & \parbox[t]{2.6in}{The position of the first character
 of {\tt yytext}, relative to the beginning of the file.}\\
 {\tt yylineno } & {\tt \%count} &         Current line number\\
@@ -437,11 +437,11 @@
     let val input_line = fn f =>
           let fun loop result =
              let val c = input (f,1)
-	         val result = c :: result
+                 val result = c :: result
              in if String.size c = 0 orelse c = "\n" then
-	  	   String.implode (rev result)
-	         else loop result
-	     end
+                   String.implode (rev result)
+                 else loop result
+             end
           in loop nil
           end
      in Mlex.makeLexer (fn n => input_line std_in)
@@ -547,11 +547,11 @@
       val input_line = fn f =>
           let fun loop result =
              let val c = input (f,1)
-	         val result = c :: result
+                 val result = c :: result
              in if String.size c = 0 orelse c = "\n" then
-	  	   String.implode (rev result)
-	         else loop result
-	     end
+                   String.implode (rev result)
+                 else loop result
+             end
           in loop nil
           end
       val lexer = makeLexer (fn n => input_line strm)

Modified: mlton/branches/on-20050420-cmm-branch/mllex/main.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mllex/main.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mllex/main.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,11 @@
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 structure Main =
 struct
 
@@ -3,15 +11,15 @@
 fun usage s =
    Process.usage {usage = "file.lex ...",
-		  msg = s}
+                  msg = s}
 
 fun main args =
    let
       val rest =
-	 let open Popt
-	 in parse {switches = args, opts = []}
-	 end
+         let open Popt
+         in parse {switches = args, opts = []}
+         end
    in
       case rest of
-	 Result.No msg => usage msg
+         Result.No msg => usage msg
        | Result.Yes [] => usage "no files"
        | Result.Yes files => List.foreach (files, LexGen.lexGen)

Modified: mlton/branches/on-20050420-cmm-branch/mllex/mlex_int.doc
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mllex/mlex_int.doc	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mllex/mlex_int.doc	2006-02-16 19:34:54 UTC (rev 4361)
@@ -14,15 +14,15 @@
    The field yyfin has type yyfinstate list.  yyfinstate consists of the
 following three constructors:
 
-	* N of int - indicates normal end leaf.
-	* D of int - dummy end leaf - for indicating when an end state for
-	  a trailing context regular expression has been reached.  These are
-	  stored and propagated backwards when action is executed.
-	* T of int - indicates an actual end leaf for a trailing context reg.
-	  expression, which should be executed only if D i was encountered
-	  after this end leaf while scanning forward.  The dummy end leaf is
-	  removed from the backward propagating list after this node is
-	  encountered.
+        * N of int - indicates normal end leaf.
+        * D of int - dummy end leaf - for indicating when an end state for
+          a trailing context regular expression has been reached.  These are
+          stored and propagated backwards when action is executed.
+        * T of int - indicates an actual end leaf for a trailing context reg.
+          expression, which should be executed only if D i was encountered
+          after this end leaf while scanning forward.  The dummy end leaf is
+          removed from the backward propagating list after this node is
+          encountered.
 
     
      The function scan inside the function lex operates as a transition
@@ -32,52 +32,52 @@
 
        Scan operates as follows:
 
-	 Input: * s - current state
-		* AcceptingLeaves - list of accepting leave lists.  Each state
-		  has a list of accepting leaves associated with it.  This list
-		  may be nil if the state is not a final state.
-		* l - position of the next character in the buffer b to read
-		* i0 - starting position in the buffer.
+         Input: * s - current state
+                * AcceptingLeaves - list of accepting leave lists.  Each state
+                  has a list of accepting leaves associated with it.  This list
+                  may be nil if the state is not a final state.
+                * l - position of the next character in the buffer b to read
+                * i0 - starting position in the buffer.
 
-	Output: If no match is found, it raises the exception LexError. 
-		Otherwise, it returns a value of type lexresult.
+        Output: If no match is found, it raises the exception LexError. 
+                Otherwise, it returns a value of type lexresult.
 
-	It operates as a transtion function:
-	     It (1) adds the list of accepting leaves for the current state to
-	            the list of accepting leave lists
-		(2) tries to make a transition on the current input character
-		    to the next state.  If it can't make a transition, it 
-		    executes the action function.
-			(a) - if it is past the end of the buffer, it 
-				(1) checks if it as at end eof.  If it is then:
-				 	It checks to see if it has made any
-					transitions since it was first called -
-					(l>i0 when this is true.)  If it hasn't
-					this implies that scan was called at
-					the end of file.  It thus executes
-					eof function declared by the user.
-				        Otherwise it must execute action w/
-					the current accepting state list.
-				(2) otherwise it reads a block of up to 1024
-				    characters, and appends this block to the
-				    useful suffix of characters left in the
-				    buffer (those character which have been
-				    scanned in this call to lex()).  The buffer
-				    operation should be altered if one intends
-				    to process reg. expressions whose lexemes'
-				    length will be >> 1024.  For most normal
-				    applications, the buffer update operation
-				    will be fine.
+        It operates as a transtion function:
+             It (1) adds the list of accepting leaves for the current state to
+                    the list of accepting leave lists
+                (2) tries to make a transition on the current input character
+                    to the next state.  If it can't make a transition, it 
+                    executes the action function.
+                        (a) - if it is past the end of the buffer, it 
+                                (1) checks if it as at end eof.  If it is then:
+                                        It checks to see if it has made any
+                                        transitions since it was first called -
+                                        (l>i0 when this is true.)  If it hasn't
+                                        this implies that scan was called at
+                                        the end of file.  It thus executes
+                                        eof function declared by the user.
+                                        Otherwise it must execute action w/
+                                        the current accepting state list.
+                                (2) otherwise it reads a block of up to 1024
+                                    characters, and appends this block to the
+                                    useful suffix of characters left in the
+                                    buffer (those character which have been
+                                    scanned in this call to lex()).  The buffer
+                                    operation should be altered if one intends
+                                    to process reg. expressions whose lexemes'
+                                    length will be >> 1024.  For most normal
+                                    applications, the buffer update operation
+                                    will be fine.
 
-			  	    This buffer update operation requires
-				    O(n^2/1024) char. copies for lexemes > 1024
-				    characters in length, and O(n) char. copies 
-				    for lexemes <= 1024 characters in length.
-				    It can be made O(n) using linked list
-				    buffers & a Byte.array of size n (not the
-				     ^operator!) for concatenating the buffers
-				    to return a value for yytext when a lexeme
-				    is longer than the typical buffer length.
+                                    This buffer update operation requires
+                                    O(n^2/1024) char. copies for lexemes > 1024
+                                    characters in length, and O(n) char. copies 
+                                    for lexemes <= 1024 characters in length.
+                                    It can be made O(n) using linked list
+                                    buffers & a Byte.array of size n (not the
+                                     ^operator!) for concatenating the buffers
+                                    to return a value for yytext when a lexeme
+                                    is longer than the typical buffer length.
 
-			(3) If the transition is to a dead state (0 is used
-			    for the dead state), action is executed instead.
+                        (3) If the transition is to a dead state (0 is used
+                            for the dead state), action is executed instead.

Modified: mlton/branches/on-20050420-cmm-branch/mllex/mllex.cm
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mllex/mllex.cm	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mllex/mllex.cm	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,11 @@
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 Group is
 
 sources.cm

Modified: mlton/branches/on-20050420-cmm-branch/mllex/mllex.mlb
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mllex/mllex.mlb	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mllex/mllex.mlb	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,5 +1,12 @@
+(* Copyright (C) 2004-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 local
-  sources.mlb
+   sources.mlb
 in
-  call-main.sml
+   call-main.sml
 end

Modified: mlton/branches/on-20050420-cmm-branch/mllex/sources.cm
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mllex/sources.cm	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mllex/sources.cm	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,11 @@
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 Group is
 
 ../lib/mlton/sources.cm

Modified: mlton/branches/on-20050420-cmm-branch/mllex/sources.mlb
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mllex/sources.mlb	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mllex/sources.mlb	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,15 +1,22 @@
+(* Copyright (C) 2004-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 local
-  local 
-    $(SML_LIB)/basis/basis.mlb
-    lexgen.sml
-  in
-    structure LexGen
-  end
-  local
-    ../lib/mlton/sources.mlb
-  in
-    main.sml
-  end
+   local 
+      $(SML_LIB)/basis/basis.mlb
+      lexgen.sml
+   in
+      structure LexGen
+   end
+   local
+      ../lib/mlton/sources.mlb
+   in
+      main.sml
+   end
 in
-  structure Main
+   structure Main
 end


Property changes on: mlton/branches/on-20050420-cmm-branch/mlnlffigen
___________________________________________________________________
Name: svn:ignore
   - *.call-graph.dot
*.ssa
mlnlffigen
   + *.call-graph.dot
*.ssa
mlnlffigen


Deleted: mlton/branches/on-20050420-cmm-branch/mlnlffigen/.cvsignore
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlnlffigen/.cvsignore	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlnlffigen/.cvsignore	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +0,0 @@
-*.call-graph.dot
-*.ssa
-mlnlffigen

Copied: mlton/branches/on-20050420-cmm-branch/mlnlffigen/.ignore (from rev 4358, mlton/trunk/mlnlffigen/.ignore)

Modified: mlton/branches/on-20050420-cmm-branch/mlnlffigen/Makefile
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlnlffigen/Makefile	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlnlffigen/Makefile	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,10 @@
+## Copyright (C) 2005-2005 Henry Cejtin, Matthew Fluet, Suresh
+ #    Jagannathan, and Stephen Weeks.
+ #
+ # MLton is released under a BSD-style license.
+ # See the file MLton-LICENSE for details.
+ ##
+
 SRC = $(shell cd .. && pwd)
 BUILD = $(SRC)/build
 BIN = $(BUILD)/bin
@@ -4,7 +11,7 @@
 LIB = $(BUILD)/lib
 MLTON = mlton
 TARGET = self
-FLAGS = -target $(TARGET) -default-ann 'sequenceUnit true'
+FLAGS = -target $(TARGET) -default-ann 'sequenceNonUnit warn'
 NAME = mlnlffigen
 PATH = $(BIN):$(shell echo $$PATH)
 
@@ -13,7 +20,6 @@
 $(NAME): $(NAME).mlb $(shell PATH=$(BIN):$$PATH && $(MLTON) -stop f $(NAME).mlb)
 	@echo 'Compiling $(NAME)'
 	$(MLTON) $(FLAGS) $(NAME).mlb
-	size $(NAME)
 
 .PHONY: clean
 clean:

Modified: mlton/branches/on-20050420-cmm-branch/mlnlffigen/README
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlnlffigen/README	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlnlffigen/README	2006-02-16 19:34:54 UTC (rev 4361)
@@ -302,7 +302,7 @@
   |CF = foo.cm
   |
   |$(D)/$(CF): $(FILES)
-  |	ml-nlffigen -include $(HF) -libhandle $(H) -dir $(D) -cmfile $(CF) $^
+  |     ml-nlffigen -include $(HF) -libhandle $(H) -dir $(D) -cmfile $(CF) $^
   +----------------------------------------------------------
 
    Suppose the above file is stored as "foo.make".  Running
@@ -394,11 +394,11 @@
 
   +-------------------------------------------------------------
   |library
-  |	library(FFI/foo.cm)
+  |     library(FFI/foo.cm)
   |is
-  |	$/basis.cm
-  |	$/c.cm
-  |	FFI/foo.cm : make (-f foo.make)
+  |     $/basis.cm
+  |     $/c.cm
+  |     FFI/foo.cm : make (-f foo.make)
   +-------------------------------------------------------------
 
    Now, saying
@@ -417,12 +417,12 @@
 
   +-------------------------------------------------------------
   |library
-  |	structure Foo_a
-  |	structure Foo_b
+  |     structure Foo_a
+  |     structure Foo_b
   |is
-  |	$/basis.cm
-  |	$/c.cm
-  |	FFI/foo.cm : make (-f foo.make)
-  |	wrapper-foo-a.sml
-  |	wrapper-foo-b.sml
+  |     $/basis.cm
+  |     $/c.cm
+  |     FFI/foo.cm : make (-f foo.make)
+  |     wrapper-foo-a.sml
+  |     wrapper-foo-b.sml
   +-------------------------------------------------------------

Modified: mlton/branches/on-20050420-cmm-branch/mlnlffigen/ast-to-spec.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlnlffigen/ast-to-spec.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlnlffigen/ast-to-spec.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -29,485 +29,485 @@
     fun warn m = TextIO.output (TextIO.stdErr, "AstToSpec: warning: " ^ m)
 
     fun build { bundle, sizes: Sizes.sizes, collect_enums,
-		cfiles, match, allSU, eshift, gensym_suffix } =
+                cfiles, match, allSU, eshift, gensym_suffix } =
     let
 
-	val curLoc = ref "?"
+        val curLoc = ref "?"
 
-	fun warnLoc m = warn (concat [!curLoc, ": ", m])
+        fun warnLoc m = warn (concat [!curLoc, ": ", m])
 
-	val { ast, tidtab, errorCount, warningCount,
-	      auxiliaryInfo = { aidtab, implicits, env } } = bundle
+        val { ast, tidtab, errorCount, warningCount,
+              auxiliaryInfo = { aidtab, implicits, env } } = bundle
 
-	fun realFunctionDefComing sy = let
-	    fun isTheDef (A.DECL (A.FunctionDef (id, _, _), _, _)) =
-		Symbol.equal (#name id, sy)
-	      | isTheDef _ = false
-	in
-	    List.exists isTheDef ast
-	end
+        fun realFunctionDefComing sy = let
+            fun isTheDef (A.DECL (A.FunctionDef (id, _, _), _, _)) =
+                Symbol.equal (#name id, sy)
+              | isTheDef _ = false
+        in
+            List.exists isTheDef ast
+        end
 
-	val srcOf = SourceMap.locToString
+        val srcOf = SourceMap.locToString
 
-	fun isThisFile SourceMap.UNKNOWN = false
-	  | isThisFile (SourceMap.LOC { srcFile, ... }) =
-	    List.exists (fn f => f = srcFile) cfiles orelse
-	    match srcFile
+        fun isThisFile SourceMap.UNKNOWN = false
+          | isThisFile (SourceMap.LOC { srcFile, ... }) =
+            List.exists (fn f => f = srcFile) cfiles orelse
+            match srcFile
 
-	fun includedSU (tag, loc) = (allSU orelse isThisFile loc)
-	fun includedEnum (tag, loc) = isThisFile loc
+        fun includedSU (tag, loc) = (allSU orelse isThisFile loc)
+        fun includedEnum (tag, loc) = isThisFile loc
 
-	fun includedTy (n, loc) = isThisFile loc
+        fun includedTy (n, loc) = isThisFile loc
 
-	fun isFunction t = TypeUtil.isFunction tidtab t
-	fun getFunction t = TypeUtil.getFunction tidtab t
-	fun getCoreType t = TypeUtil.getCoreType tidtab t
+        fun isFunction t = TypeUtil.isFunction tidtab t
+        fun getFunction t = TypeUtil.getFunction tidtab t
+        fun getCoreType t = TypeUtil.getCoreType tidtab t
 
-	fun constness t =
-	    if TypeUtil.isConst tidtab t then Spec.RO
-	    else case getCoreType t of
-		     A.Array (_, t) => constness t
-		   | _ => Spec.RW
+        fun constness t =
+            if TypeUtil.isConst tidtab t then Spec.RO
+            else case getCoreType t of
+                     A.Array (_, t) => constness t
+                   | _ => Spec.RW
 
-	val sizerec = { sizes = sizes, err = err, warn = warn, bug = bug }
+        val sizerec = { sizes = sizes, err = err, warn = warn, bug = bug }
 
-	fun sizeOf t = #bytes (Sizeof.byteSizeOf sizerec tidtab t)
+        fun sizeOf t = #bytes (Sizeof.byteSizeOf sizerec tidtab t)
 
-	val bytebits = #bits (#char sizes)
-	val intbits = #bits (#int sizes)
-	val intalign = #align (#int sizes)
+        val bytebits = #bits (#char sizes)
+        val intbits = #bits (#int sizes)
+        val intalign = #align (#int sizes)
 
-	fun getField (m, l) = Sizeof.getField sizerec (m, l)
+        fun getField (m, l) = Sizeof.getField sizerec (m, l)
 
-	fun fieldOffsets t =
-	    case Sizeof.fieldOffsets sizerec tidtab t of
-		NONE => bug "no field offsets"
-	      | SOME l => l
+        fun fieldOffsets t =
+            case Sizeof.fieldOffsets sizerec tidtab t of
+                NONE => bug "no field offsets"
+              | SOME l => l
 
-	val structs = ref []
-	val unions = ref []
-	val gtys = ref SM.empty
-	val gvars = ref SM.empty
-	val gfuns = ref SM.empty
-	val named_enums = ref SM.empty
-	val anon_enums = ref SM.empty
+        val structs = ref []
+        val unions = ref []
+        val gtys = ref SM.empty
+        val gvars = ref SM.empty
+        val gfuns = ref SM.empty
+        val named_enums = ref SM.empty
+        val anon_enums = ref SM.empty
 
-	val seen_structs = ref SS.empty
-	val seen_unions = ref SS.empty
+        val seen_structs = ref SS.empty
+        val seen_unions = ref SS.empty
 
-	val nexttag = ref 0
-	val tags = Tidtab.uidtab () : (string * bool) Tidtab.uidtab
+        val nexttag = ref 0
+        val tags = Tidtab.uidtab () : (string * bool) Tidtab.uidtab
 
-	fun mk_context_td tdname =
-	    let val next = ref 0
-	    in
-		CONTEXT
-		    { gensym =
-		      fn () => let
-			     val n = !next
-			 in
-			     next := n + 1;
-			     concat ["'",
-				     if n = 0 then "" else Int.toString n,
-				     tdname]
-			 end,
-		      anon = false }
-	    end
+        fun mk_context_td tdname =
+            let val next = ref 0
+            in
+                CONTEXT
+                    { gensym =
+                      fn () => let
+                             val n = !next
+                         in
+                             next := n + 1;
+                             concat ["'",
+                                     if n = 0 then "" else Int.toString n,
+                                     tdname]
+                         end,
+                      anon = false }
+            end
 
-	fun mk_context_su (parent_tag, anon) =
-	    let val next = ref 0
-	    in
-		CONTEXT { gensym =
-			  fn () => let
-				 val n = !next
-			     in
-				 next := n + 1;
-				 concat [parent_tag, "'", Int.toString n]
-			     end,
-			  anon = anon }
-	    end
+        fun mk_context_su (parent_tag, anon) =
+            let val next = ref 0
+            in
+                CONTEXT { gensym =
+                          fn () => let
+                                 val n = !next
+                             in
+                                 next := n + 1;
+                                 concat [parent_tag, "'", Int.toString n]
+                             end,
+                          anon = anon }
+            end
 
-	val tl_context =
-	    let val next = ref 0
-	    in
-		CONTEXT { gensym =
-			  fn () => let
-				 val n = !next
-			     in
-				 next := n + 1;
-				 Int.toString n
-			     end,
-			  anon = true }
-	    end
+        val tl_context =
+            let val next = ref 0
+            in
+                CONTEXT { gensym =
+                          fn () => let
+                                 val n = !next
+                             in
+                                 next := n + 1;
+                                 Int.toString n
+                             end,
+                          anon = true }
+            end
 
-	fun tagname (SOME t, _, _) = (t, false)
-	  | tagname (NONE, CONTEXT { gensym, anon }, tid) =
-	    (case Tidtab.find (tags, tid) of
-		 SOME ta => ta
-	       | NONE => let
-		     val t = gensym ()
-		 in
-		     Tidtab.insert (tags, tid, (t, anon));
-		     (t, anon)
-		 end)
+        fun tagname (SOME t, _, _) = (t, false)
+          | tagname (NONE, CONTEXT { gensym, anon }, tid) =
+            (case Tidtab.find (tags, tid) of
+                 SOME ta => ta
+               | NONE => let
+                     val t = gensym ()
+                 in
+                     Tidtab.insert (tags, tid, (t, anon));
+                     (t, anon)
+                 end)
 
-	fun reported_tagname (t, false) = t
-	  | reported_tagname (t, true) = t ^ gensym_suffix
+        fun reported_tagname (t, false) = t
+          | reported_tagname (t, true) = t ^ gensym_suffix
 
-	fun valty C A.Void = raise VoidType
-	  | valty C A.Ellipses = raise Ellipsis
-	  | valty C (A.Qual (q, t)) = valty C t
-	  | valty C (A.Numeric (_, _, A.SIGNED, A.CHAR, _)) = Spec.BASIC Spec.SCHAR
-	  | valty C (A.Numeric (_, _, A.UNSIGNED, A.CHAR, _)) = Spec.BASIC Spec.UCHAR
-	  | valty C (A.Numeric (_, _, A.SIGNED, A.SHORT, _)) = Spec.BASIC Spec.SSHORT
-	  | valty C (A.Numeric (_, _, A.UNSIGNED, A.SHORT, _)) = Spec.BASIC Spec.USHORT
-	  | valty C (A.Numeric (_, _, A.SIGNED, A.INT, _)) = Spec.BASIC Spec.SINT
-	  | valty C (A.Numeric (_, _, A.UNSIGNED, A.INT, _)) = Spec.BASIC Spec.UINT
-	  | valty C (A.Numeric (_, _, A.SIGNED, A.LONG, _)) = Spec.BASIC Spec.SLONG
-	  | valty C (A.Numeric (_, _, A.UNSIGNED, A.LONG, _)) = Spec.BASIC Spec.ULONG
-	  | valty C (A.Numeric (_, _, A.SIGNED, A.LONGLONG, _)) = 
-	      Spec.BASIC Spec.SLONGLONG
-	  | valty C (A.Numeric (_, _, A.UNSIGNED, A.LONGLONG, _)) = 
-	      Spec.BASIC Spec.ULONGLONG
-	  | valty C (A.Numeric (_, _, _, A.FLOAT, _)) = Spec.BASIC Spec.FLOAT
-	  | valty C (A.Numeric (_, _, _, A.DOUBLE, _)) = Spec.BASIC Spec.DOUBLE
-	  | valty C (A.Numeric (_, _, _, A.LONGDOUBLE, _)) = 
-	      Spec.UNIMPLEMENTED "long double"
-	  | valty C (A.Array (NONE, t)) = valty C (A.Pointer t)
-	  | valty C (A.Array (SOME (n, _), t)) =
-	    let val d = Int.fromLarge n
-	    in
-		if d < 0 then err "negative dimension"
-		else Spec.ARR { t = valty C t, d = d, esz = sizeOf t }
-	    end
-	  | valty C (A.Pointer t) =
-	    (case getCoreType t of
-		 A.Void => Spec.VOIDPTR
-	       | A.Function f => fptrty C f
-	       | _ => Spec.PTR (cobj C t))
-	  | valty C (A.Function f) = fptrty C f
-	  | valty C (A.StructRef tid) = typeref (tid, Spec.STRUCT, C)
-	  | valty C (A.UnionRef tid) = typeref (tid, Spec.UNION, C)
-	  | valty C (A.EnumRef tid) = typeref (tid, fn t => Spec.ENUM (t, false), C)
-	  | valty C (A.TypeRef tid) =
-	    typeref (tid, fn _ => bug "missing typedef info", C)
-	  | valty C A.Error = err "Error type"
+        fun valty C A.Void = raise VoidType
+          | valty C A.Ellipses = raise Ellipsis
+          | valty C (A.Qual (q, t)) = valty C t
+          | valty C (A.Numeric (_, _, A.SIGNED, A.CHAR, _)) = Spec.BASIC Spec.SCHAR
+          | valty C (A.Numeric (_, _, A.UNSIGNED, A.CHAR, _)) = Spec.BASIC Spec.UCHAR
+          | valty C (A.Numeric (_, _, A.SIGNED, A.SHORT, _)) = Spec.BASIC Spec.SSHORT
+          | valty C (A.Numeric (_, _, A.UNSIGNED, A.SHORT, _)) = Spec.BASIC Spec.USHORT
+          | valty C (A.Numeric (_, _, A.SIGNED, A.INT, _)) = Spec.BASIC Spec.SINT
+          | valty C (A.Numeric (_, _, A.UNSIGNED, A.INT, _)) = Spec.BASIC Spec.UINT
+          | valty C (A.Numeric (_, _, A.SIGNED, A.LONG, _)) = Spec.BASIC Spec.SLONG
+          | valty C (A.Numeric (_, _, A.UNSIGNED, A.LONG, _)) = Spec.BASIC Spec.ULONG
+          | valty C (A.Numeric (_, _, A.SIGNED, A.LONGLONG, _)) = 
+              Spec.BASIC Spec.SLONGLONG
+          | valty C (A.Numeric (_, _, A.UNSIGNED, A.LONGLONG, _)) = 
+              Spec.BASIC Spec.ULONGLONG
+          | valty C (A.Numeric (_, _, _, A.FLOAT, _)) = Spec.BASIC Spec.FLOAT
+          | valty C (A.Numeric (_, _, _, A.DOUBLE, _)) = Spec.BASIC Spec.DOUBLE
+          | valty C (A.Numeric (_, _, _, A.LONGDOUBLE, _)) = 
+              Spec.UNIMPLEMENTED "long double"
+          | valty C (A.Array (NONE, t)) = valty C (A.Pointer t)
+          | valty C (A.Array (SOME (n, _), t)) =
+            let val d = Int.fromLarge n
+            in
+                if d < 0 then err "negative dimension"
+                else Spec.ARR { t = valty C t, d = d, esz = sizeOf t }
+            end
+          | valty C (A.Pointer t) =
+            (case getCoreType t of
+                 A.Void => Spec.VOIDPTR
+               | A.Function f => fptrty C f
+               | _ => Spec.PTR (cobj C t))
+          | valty C (A.Function f) = fptrty C f
+          | valty C (A.StructRef tid) = typeref (tid, Spec.STRUCT, C)
+          | valty C (A.UnionRef tid) = typeref (tid, Spec.UNION, C)
+          | valty C (A.EnumRef tid) = typeref (tid, fn t => Spec.ENUM (t, false), C)
+          | valty C (A.TypeRef tid) =
+            typeref (tid, fn _ => bug "missing typedef info", C)
+          | valty C A.Error = err "Error type"
 
-	and valty_nonvoid C t = valty C t
-	    handle VoidType => err "void variable type"
+        and valty_nonvoid C t = valty C t
+            handle VoidType => err "void variable type"
 
-	and typeref (tid, otherwise, C) =
-	    case Tidtab.find (tidtab, tid) of
-		NONE => bug "tid not bound in tidtab"
-	      | SOME { name = SOME n, ntype = NONE, ... } => otherwise n
-	      | SOME { name = NONE, ntype = NONE, ... } =>
-		bug "both name and ntype missing in tidtab binding"
-	      | SOME { name, ntype = SOME nct, location, ... } =>
-		(case nct of
-		     B.Struct (tid, members) =>
-		     structty (tid, name, C, members, location)
-		   | B.Union (tid, members) =>
-		     unionty (tid, name, C, members, location)
-		   | B.Enum (tid, edefs) =>
-		     enumty (tid, name, C, edefs, location)
-		   | B.Typedef (_, t) => let
-			 val n =
-			     case name of
-				 NONE => bug "missing name in typedef"
-			       | SOME n => n
-			 val C' = mk_context_td n
-			 val res = valty C' t
-			 fun sameName { src, name, spec } = name = n
-		     in
-			 if includedTy (n, location) andalso
-			    not (SM.inDomain (!gtys, n)) then
-			     gtys := SM.insert (!gtys, n,
-						{ src = srcOf location,
-						  name = n, spec = res })
-			 else ();
-			 res
-		     end)
+        and typeref (tid, otherwise, C) =
+            case Tidtab.find (tidtab, tid) of
+                NONE => bug "tid not bound in tidtab"
+              | SOME { name = SOME n, ntype = NONE, ... } => otherwise n
+              | SOME { name = NONE, ntype = NONE, ... } =>
+                bug "both name and ntype missing in tidtab binding"
+              | SOME { name, ntype = SOME nct, location, ... } =>
+                (case nct of
+                     B.Struct (tid, members) =>
+                     structty (tid, name, C, members, location)
+                   | B.Union (tid, members) =>
+                     unionty (tid, name, C, members, location)
+                   | B.Enum (tid, edefs) =>
+                     enumty (tid, name, C, edefs, location)
+                   | B.Typedef (_, t) => let
+                         val n =
+                             case name of
+                                 NONE => bug "missing name in typedef"
+                               | SOME n => n
+                         val C' = mk_context_td n
+                         val res = valty C' t
+                         fun sameName { src, name, spec } = name = n
+                     in
+                         if includedTy (n, location) andalso
+                            not (SM.inDomain (!gtys, n)) then
+                             gtys := SM.insert (!gtys, n,
+                                                { src = srcOf location,
+                                                  name = n, spec = res })
+                         else ();
+                         res
+                     end)
 
-	and enumty (tid, name, C, edefs, location) = let
-	    val (tag_stem, anon) = tagname (name, C, tid)
-	    val tag = reported_tagname (tag_stem, anon)
-	    fun one ({ name, uid, location, ctype, kind }, i) =
-		{ name = Symbol.name name, spec = i }
-	    val enums = if anon then anon_enums else named_enums
-	in
-	    enums := SM.insert (!enums, tag,
-				{ src = srcOf location,
-				  tag = tag,
-				  anon = anon,
-				  descr = tag,
-				  exclude = not (includedEnum (tag, location)),
-				  spec = map one edefs });
-	    Spec.ENUM (tag, anon)
-	end
+        and enumty (tid, name, C, edefs, location) = let
+            val (tag_stem, anon) = tagname (name, C, tid)
+            val tag = reported_tagname (tag_stem, anon)
+            fun one ({ name, uid, location, ctype, kind }, i) =
+                { name = Symbol.name name, spec = i }
+            val enums = if anon then anon_enums else named_enums
+        in
+            enums := SM.insert (!enums, tag,
+                                { src = srcOf location,
+                                  tag = tag,
+                                  anon = anon,
+                                  descr = tag,
+                                  exclude = not (includedEnum (tag, location)),
+                                  spec = map one edefs });
+            Spec.ENUM (tag, anon)
+        end
 
-	and structty (tid, name, C, members, location) = let
-	    val (tag_stem, anon) = tagname (name, C, tid)
-	    val tag = reported_tagname (tag_stem, anon)
-	    val ty = Spec.STRUCT tag
-	    val C' = mk_context_su (tag_stem, anon)
-	in
-	    if SS.member (!seen_structs, tag) then ()
-	    else let
-		    val _ = seen_structs := SS.add (!seen_structs, tag)
+        and structty (tid, name, C, members, location) = let
+            val (tag_stem, anon) = tagname (name, C, tid)
+            val tag = reported_tagname (tag_stem, anon)
+            val ty = Spec.STRUCT tag
+            val C' = mk_context_su (tag_stem, anon)
+        in
+            if SS.member (!seen_structs, tag) then ()
+            else let
+                    val _ = seen_structs := SS.add (!seen_structs, tag)
 
-		    val fol = fieldOffsets (A.StructRef tid)
-		    val ssize = sizeOf (A.StructRef tid)
+                    val fol = fieldOffsets (A.StructRef tid)
+                    val ssize = sizeOf (A.StructRef tid)
 
-		    fun bfspec (offset, bits, shift, (c, t)) = let
-			val offset = offset
-			val bits = Word.fromLargeInt bits
-			val shift = eshift (shift, intbits, bits)
-			val r = { offset = offset,
-				  constness = c,
-				  bits = bits,
-				  shift = shift }
-		    in
-			case t of
-			    Spec.BASIC Spec.UINT => Spec.UBF r
-			  | Spec.BASIC Spec.SINT => Spec.SBF r
-			  | _ => err "non-int bitfield"
-		    end
+                    fun bfspec (offset, bits, shift, (c, t)) = let
+                        val offset = offset
+                        val bits = Word.fromLargeInt bits
+                        val shift = eshift (shift, intbits, bits)
+                        val r = { offset = offset,
+                                  constness = c,
+                                  bits = bits,
+                                  shift = shift }
+                    in
+                        case t of
+                            Spec.BASIC Spec.UINT => Spec.UBF r
+                          | Spec.BASIC Spec.SINT => Spec.SBF r
+                          | _ => err "non-int bitfield"
+                    end
 
-		    fun synthetic (synth, (_, false), _) = ([], synth)
-		      | synthetic (synth, (endp, true), startp) =
-			if endp = startp then ([], synth)
-			else ([{ name = Int.toString synth,
-				 spec = Spec.OFIELD
-					{ offset = endp,
-					  spec = (Spec.RW,
-						  Spec.ARR { t = Spec.BASIC Spec.UCHAR,
-							     d = startp - endp,
-							     esz = 1 }),
-					  synthetic = true } }],
-			      synth+1)
+                    fun synthetic (synth, (_, false), _) = ([], synth)
+                      | synthetic (synth, (endp, true), startp) =
+                        if endp = startp then ([], synth)
+                        else ([{ name = Int.toString synth,
+                                 spec = Spec.OFIELD
+                                        { offset = endp,
+                                          spec = (Spec.RW,
+                                                  Spec.ARR { t = Spec.BASIC Spec.UCHAR,
+                                                             d = startp - endp,
+                                                             esz = 1 }),
+                                          synthetic = true } }],
+                              synth+1)
 
-		    fun build ([], synth, gap) =
-			#1 (synthetic (synth, gap, ssize))
-		      | build ((t, SOME m, NONE) :: rest, synth, gap) =
-			let val bitoff = #bitOffset (getField (m, fol))
-			    val bytoff = bitoff div bytebits
-			    val (filler, synth) =
-				synthetic (synth, gap, bytoff)
-			    val endp = bytoff + sizeOf t
-			in
-			    if bitoff mod bytebits <> 0 then
-				bug "non-bitfield not on byte boundary"
-			    else
-				filler @
-				{ name = Symbol.name (#name m),
-				  spec = Spec.OFIELD
-					     { offset = bytoff,
-					       spec = cobj C' t,
-					       synthetic = false } } ::
-				build (rest, synth, (endp, false))
-			end
-		      | build ((t, SOME m, SOME b) :: rest, synth, gap) =
-			let val bitoff = #bitOffset (getField (m, fol))
-			    val bytoff =
-				(intalign * (bitoff div intalign))
-				div bytebits
-			    val gap = (#1 gap, true)
-			in
-			    { name = Symbol.name (#name m),
-			      spec = bfspec (bytoff, b,
-					     bitoff mod intalign,
-					     cobj C' t) } ::
-			    build (rest, synth, gap)
-			end
-		      | build ((t, NONE, SOME _) :: rest, synth, gap) =
-			build (rest, synth, (#1 gap, true))
-		      | build ((_, NONE, NONE) :: _, _, _) =
-			bug "unnamed struct member (not bitfield)"
+                    fun build ([], synth, gap) =
+                        #1 (synthetic (synth, gap, ssize))
+                      | build ((t, SOME m, NONE) :: rest, synth, gap) =
+                        let val bitoff = #bitOffset (getField (m, fol))
+                            val bytoff = bitoff div bytebits
+                            val (filler, synth) =
+                                synthetic (synth, gap, bytoff)
+                            val endp = bytoff + sizeOf t
+                        in
+                            if bitoff mod bytebits <> 0 then
+                                bug "non-bitfield not on byte boundary"
+                            else
+                                filler @
+                                { name = Symbol.name (#name m),
+                                  spec = Spec.OFIELD
+                                             { offset = bytoff,
+                                               spec = cobj C' t,
+                                               synthetic = false } } ::
+                                build (rest, synth, (endp, false))
+                        end
+                      | build ((t, SOME m, SOME b) :: rest, synth, gap) =
+                        let val bitoff = #bitOffset (getField (m, fol))
+                            val bytoff =
+                                (intalign * (bitoff div intalign))
+                                div bytebits
+                            val gap = (#1 gap, true)
+                        in
+                            { name = Symbol.name (#name m),
+                              spec = bfspec (bytoff, b,
+                                             bitoff mod intalign,
+                                             cobj C' t) } ::
+                            build (rest, synth, gap)
+                        end
+                      | build ((t, NONE, SOME _) :: rest, synth, gap) =
+                        build (rest, synth, (#1 gap, true))
+                      | build ((_, NONE, NONE) :: _, _, _) =
+                        bug "unnamed struct member (not bitfield)"
 
-		    val fields = build (members, 0, (0, false))
-		in
-		    structs := { src = srcOf location,
-				 tag = tag, 
-				 anon = anon,
-				 size = Word.fromInt ssize,
-				 exclude = not (includedSU (tag, location)),
-				 fields = fields } :: !structs
-		end;
-	    ty
-	end
+                    val fields = build (members, 0, (0, false))
+                in
+                    structs := { src = srcOf location,
+                                 tag = tag, 
+                                 anon = anon,
+                                 size = Word.fromInt ssize,
+                                 exclude = not (includedSU (tag, location)),
+                                 fields = fields } :: !structs
+                end;
+            ty
+        end
 
-	and unionty (tid, name, C, members, location) = let
-	    val (tag_stem, anon) = tagname (name, C, tid)
-	    val tag = reported_tagname (tag_stem, anon)     
-	    val C' = mk_context_su (tag_stem, anon)
-	    val ty = Spec.UNION tag
-	    val lsz = ref 0
-	    fun mkField (t, m: A.member) = let
-		val sz = sizeOf t
-	    in
-		{ name = Symbol.name (#name m),
-		  spec = Spec.OFIELD { offset = 0,
-				       spec = cobj C' t,
-				       synthetic = false } }
-	    end
-	in
-	    if SS.member (!seen_unions, tag) then ()
-	    else let
-		    val _ = seen_unions := SS.add (!seen_unions, tag)
-		    val all = map mkField members
-		in
-		    unions := { src = srcOf location,
-				tag = tag,
-				anon = anon,
-				size = Word.fromInt (sizeOf (A.UnionRef tid)),
-				exclude = not (includedSU (tag, location)),
-				all = all } :: !unions
-		end;
-	    ty
-	end
+        and unionty (tid, name, C, members, location) = let
+            val (tag_stem, anon) = tagname (name, C, tid)
+            val tag = reported_tagname (tag_stem, anon)     
+            val C' = mk_context_su (tag_stem, anon)
+            val ty = Spec.UNION tag
+            val lsz = ref 0
+            fun mkField (t, m: A.member) = let
+                val sz = sizeOf t
+            in
+                { name = Symbol.name (#name m),
+                  spec = Spec.OFIELD { offset = 0,
+                                       spec = cobj C' t,
+                                       synthetic = false } }
+            end
+        in
+            if SS.member (!seen_unions, tag) then ()
+            else let
+                    val _ = seen_unions := SS.add (!seen_unions, tag)
+                    val all = map mkField members
+                in
+                    unions := { src = srcOf location,
+                                tag = tag,
+                                anon = anon,
+                                size = Word.fromInt (sizeOf (A.UnionRef tid)),
+                                exclude = not (includedSU (tag, location)),
+                                all = all } :: !unions
+                end;
+            ty
+        end
 
-	and cobj C t = (constness t, valty_nonvoid C t)
+        and cobj C t = (constness t, valty_nonvoid C t)
 
-	and fptrty C f = Spec.FPTR (cft C f)
+        and fptrty C f = Spec.FPTR (cft C f)
 
-	and cft C (res, args) =
-	    { res = case getCoreType res of
-			A.Void => NONE
-		      | _ => SOME (valty_nonvoid C res),
-	      args = case args of
-			 [(arg, _)] => (case getCoreType arg of
-				       A.Void => []
-				     | _ => [valty_nonvoid C arg])
-		       | _ => let fun build [] = []
-				    | build [(x, _)] =
-				      ([valty_nonvoid C x]
-				       handle Ellipsis =>
-					      (warnLoc
-						   ("varargs not supported; \
-						    \ignoring the ellipsis\n");
-						   []))
-				    | build ((x, _) :: xs) =
-				      valty_nonvoid C x :: build xs
-			      in
-				  build args
-			      end }
+        and cft C (res, args) =
+            { res = case getCoreType res of
+                        A.Void => NONE
+                      | _ => SOME (valty_nonvoid C res),
+              args = case args of
+                         [(arg, _)] => (case getCoreType arg of
+                                       A.Void => []
+                                     | _ => [valty_nonvoid C arg])
+                       | _ => let fun build [] = []
+                                    | build [(x, _)] =
+                                      ([valty_nonvoid C x]
+                                       handle Ellipsis =>
+                                              (warnLoc
+                                                   ("varargs not supported; \
+                                                    \ignoring the ellipsis\n");
+                                                   []))
+                                    | build ((x, _) :: xs) =
+                                      valty_nonvoid C x :: build xs
+                              in
+                                  build args
+                              end }
 
-	fun ft_argnames (res, args) =
-	    let val optids = map (fn (_, optid) => optid) args
-	    in
-		if List.exists (not o isSome) optids then NONE
-		else SOME (map valOf optids)
-	    end
+        fun ft_argnames (res, args) =
+            let val optids = map (fn (_, optid) => optid) args
+            in
+                if List.exists (not o isSome) optids then NONE
+                else SOME (map valOf optids)
+            end
 
-	fun functionName (f: A.id, ailo: A.id list option) = let
-	    val n = Symbol.name (#name f)
-	    val anlo = Option.map (map (Symbol.name o #name)) ailo
-	in
-	    if n = "_init" orelse n = "_fini" orelse
-	       SM.inDomain (!gfuns, n) then ()
-	    else let
-		     fun doit () =
-		     (case getFunction (#ctype f) of
-			  SOME fs =>
-			  gfuns := SM.insert (!gfuns, n,
-					      { src = !curLoc,
-						name = n,
-						spec = cft tl_context fs,
-						argnames = anlo })
-			| NONE => bug "function without function type")
-		 in
-		 case #stClass f of
-		     A.EXTERN => doit ()
-		   | A.DEFAULT => doit ()
-		   | A.AUTO => ()
-		   | A.REGISTER => ()
-		   | A.STATIC => ()
-		 end
-	end
+        fun functionName (f: A.id, ailo: A.id list option) = let
+            val n = Symbol.name (#name f)
+            val anlo = Option.map (map (Symbol.name o #name)) ailo
+        in
+            if n = "_init" orelse n = "_fini" orelse
+               SM.inDomain (!gfuns, n) then ()
+            else let
+                     fun doit () =
+                     (case getFunction (#ctype f) of
+                          SOME fs =>
+                          gfuns := SM.insert (!gfuns, n,
+                                              { src = !curLoc,
+                                                name = n,
+                                                spec = cft tl_context fs,
+                                                argnames = anlo })
+                        | NONE => bug "function without function type")
+                 in
+                 case #stClass f of
+                     A.EXTERN => doit ()
+                   | A.DEFAULT => doit ()
+                   | A.AUTO => ()
+                   | A.REGISTER => ()
+                   | A.STATIC => ()
+                 end
+        end
 
-	fun varDecl (v: A.id) = let
+        fun varDecl (v: A.id) = let
             fun doit () =
-		(case getFunction (#ctype v) of
-		     SOME fs => if realFunctionDefComing (#name v) then ()
-				else functionName (v, ft_argnames fs)
-		   | NONE =>
-		     let val n = Symbol.name (#name v)
-		     in
-			 if SM.inDomain (!gvars, n) then ()
-			 else gvars := SM.insert
-					   (!gvars, n,
-					    { src = !curLoc, name = n,
-					      spec = cobj tl_context
-							  (#ctype v) })
-		     end)
-	in
-	    case #stClass v of
-	        A.EXTERN => doit ()
-	      | A.DEFAULT => doit ()
-	      | A.AUTO => ()
-	      | A.REGISTER => ()
-	      | A.STATIC => ()
-	end
+                (case getFunction (#ctype v) of
+                     SOME fs => if realFunctionDefComing (#name v) then ()
+                                else functionName (v, ft_argnames fs)
+                   | NONE =>
+                     let val n = Symbol.name (#name v)
+                     in
+                         if SM.inDomain (!gvars, n) then ()
+                         else gvars := SM.insert
+                                           (!gvars, n,
+                                            { src = !curLoc, name = n,
+                                              spec = cobj tl_context
+                                                          (#ctype v) })
+                     end)
+        in
+            case #stClass v of
+                A.EXTERN => doit ()
+              | A.DEFAULT => doit ()
+              | A.AUTO => ()
+              | A.REGISTER => ()
+              | A.STATIC => ()
+        end
 
-	fun dotid tid =
-	    (* Spec.SINT is an arbitrary choice; the value gets
-	     * ignored anyway *)
-	    (ignore (typeref (tid, fn _ => Spec.BASIC Spec.SINT, tl_context))
-	     handle VoidType => ())	(* ignore type aliases for void *)
+        fun dotid tid =
+            (* Spec.SINT is an arbitrary choice; the value gets
+             * ignored anyway *)
+            (ignore (typeref (tid, fn _ => Spec.BASIC Spec.SINT, tl_context))
+             handle VoidType => ())     (* ignore type aliases for void *)
 
-	fun declaration (A.TypeDecl { tid, ... }) = dotid tid
-	  | declaration (A.VarDecl (v, _)) = varDecl v
+        fun declaration (A.TypeDecl { tid, ... }) = dotid tid
+          | declaration (A.VarDecl (v, _)) = varDecl v
 
-	fun coreExternalDecl (A.ExternalDecl d) = declaration d
-	  | coreExternalDecl (A.FunctionDef (f, argids, _)) =
-	    functionName (f, SOME argids)
-	  | coreExternalDecl (A.ExternalDeclExt _) = ()
+        fun coreExternalDecl (A.ExternalDecl d) = declaration d
+          | coreExternalDecl (A.FunctionDef (f, argids, _)) =
+            functionName (f, SOME argids)
+          | coreExternalDecl (A.ExternalDeclExt _) = ()
 
-	fun externalDecl (A.DECL (d, _, l)) =
-	    if isThisFile l then (curLoc := SourceMap.locToString l;
-				  coreExternalDecl d)
-	    else ()
+        fun externalDecl (A.DECL (d, _, l)) =
+            if isThisFile l then (curLoc := SourceMap.locToString l;
+                                  coreExternalDecl d)
+            else ()
 
-	fun doast l = app externalDecl l
+        fun doast l = app externalDecl l
 
-	fun gen_enums () = let
-	    val ael = SM.listItems (!anon_enums)
-	    val nel = SM.listItems (!named_enums)
-	    infix $
-	    fun x $ [] = [x]
-	      | x $ y = x :: ", " :: y
-	    fun onev (v as { name, spec }, m) =
-		if SM.inDomain (m, name) then raise Duplicate name
-		else SM.insert (m, name, v)
-	    fun onee ({ src, tag, anon, spec, descr, exclude }, (m, sl)) =
-		(foldl onev m spec, src $ sl)
-	in
-	    if collect_enums then
-		let val (m, sl) = foldl onee (SM.empty, []) ael
-		in
-		    if SM.isEmpty m then nel
-		    else { src = concat (rev sl),
-			   tag = "'",
-			   anon = false,
-			   descr = "collected from unnamed enumerations",
-			   exclude = false,
-			   spec = SM.listItems m }
-			 :: nel
-		end handle Duplicate name =>
-			   (warn (concat ["constant ", name,
-					  " defined more than once;\
-					  \ disabling `-collect'\n"]);
-			    ael @ nel)
-	    else ael @ nel
-	end
+        fun gen_enums () = let
+            val ael = SM.listItems (!anon_enums)
+            val nel = SM.listItems (!named_enums)
+            infix $
+            fun x $ [] = [x]
+              | x $ y = x :: ", " :: y
+            fun onev (v as { name, spec }, m) =
+                if SM.inDomain (m, name) then raise Duplicate name
+                else SM.insert (m, name, v)
+            fun onee ({ src, tag, anon, spec, descr, exclude }, (m, sl)) =
+                (foldl onev m spec, src $ sl)
+        in
+            if collect_enums then
+                let val (m, sl) = foldl onee (SM.empty, []) ael
+                in
+                    if SM.isEmpty m then nel
+                    else { src = concat (rev sl),
+                           tag = "'",
+                           anon = false,
+                           descr = "collected from unnamed enumerations",
+                           exclude = false,
+                           spec = SM.listItems m }
+                         :: nel
+                end handle Duplicate name =>
+                           (warn (concat ["constant ", name,
+                                          " defined more than once;\
+                                          \ disabling `-collect'\n"]);
+                            ael @ nel)
+            else ael @ nel
+        end
     in
-	doast ast;
-	app (dotid o #1) (Tidtab.listItemsi tidtab);
-	{ structs = !structs,
-	  unions = !unions,
-	  gtys = SM.listItems (!gtys),
-	  gvars = SM.listItems (!gvars),
-	  gfuns = SM.listItems (!gfuns),
-	  enums = gen_enums () } : Spec.spec
+        doast ast;
+        app (dotid o #1) (Tidtab.listItemsi tidtab);
+        { structs = !structs,
+          unions = !unions,
+          gtys = SM.listItems (!gtys),
+          gvars = SM.listItems (!gvars),
+          gfuns = SM.listItems (!gfuns),
+          enums = gen_enums () } : Spec.spec
     end
 end

Modified: mlton/branches/on-20050420-cmm-branch/mlnlffigen/call-main.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlnlffigen/call-main.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlnlffigen/call-main.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,8 +1,9 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 val _ = Main.main()

Modified: mlton/branches/on-20050420-cmm-branch/mlnlffigen/control.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlnlffigen/control.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlnlffigen/control.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
 (* Copyright (C) 2005-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature CONTROL =
    sig
       (* set all flags to their default values *)
@@ -31,9 +32,9 @@
       val libhandle : string ref
 
       structure Linkage :
-	 sig
-	    datatype t = Dynamic | Static
-	 end
+         sig
+            datatype t = Dynamic | Static
+         end
       val linkage : Linkage.t ref
 
       val match : (string -> bool) ref
@@ -45,14 +46,14 @@
       val prefix : string ref
 
       structure Target :
-	 sig
-	    type t
-	    val fromString : string -> t option
-	    val make: t -> {name: string, sizes: Sizes.sizes,
-			    endianShift: Endian.shift} option
-	 end
+         sig
+            type t
+            val fromString : string -> t option
+            val make: t -> {name: string, sizes: Sizes.sizes,
+                            endianShift: Endian.shift} option
+         end
       val target: {name: string, sizes: Sizes.sizes,
-		   endianShift: Endian.shift} option ref
+                   endianShift: Endian.shift} option ref
 
       val weight: {heavy: bool, light: bool} ref
 

Modified: mlton/branches/on-20050420-cmm-branch/mlnlffigen/control.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlnlffigen/control.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlnlffigen/control.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 2004-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 2004-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 structure Control: CONTROL =
 struct
 
@@ -11,68 +12,68 @@
 open C
 
 val debug = control {name = "debug",
-		     default = false,
-		     toString = Bool.toString}
+                     default = false,
+                     toString = Bool.toString}
 
 val allSU = control {name = "allSU",
-		     default = false,
-		     toString = Bool.toString}
+                     default = false,
+                     toString = Bool.toString}
 
 val collect_enums = control {name = "collect_enums",
-			     default = true,
-			     toString = Bool.toString}
+                             default = true,
+                             toString = Bool.toString}
 
 val cppopts = control {name = "cppopts",
-		       default = [],
-		       toString = List.toString (fn s => s)}
+                       default = [],
+                       toString = List.toString (fn s => s)}
 
 val dir = control {name = "dir",
-		   default = "NLFFI-Generated",
-		   toString = fn s => s}
+                   default = "NLFFI-Generated",
+                   toString = fn s => s}
 
 val enum_cons = control {name = "enum_cons",
-			 default = false,
-			 toString = Bool.toString}
+                         default = false,
+                         toString = Bool.toString}
 
 val extramembers = control {name = "extramembers",
-			    default = [],
-			    toString = List.toString (fn s => s)}
+                            default = [],
+                            toString = List.toString (fn s => s)}
 
 val gensym = control {name = "gensym",
-		      default = "",
-		      toString = fn s => s}
+                      default = "",
+                      toString = fn s => s}
 
 val libhandle = control {name = "libhandle",
-			 default = "Library.libh",
-			 toString = fn s => s}
+                         default = "Library.libh",
+                         toString = fn s => s}
 
 structure Linkage =
    struct
       datatype t = Dynamic | Static
 
       val toString =
-	 fn Dynamic => "dynamic"
-	  | Static => "static"
+         fn Dynamic => "dynamic"
+          | Static => "static"
    end
 val linkage = control {name = "linkage",
-		       default = Linkage.Dynamic,
-		       toString = Linkage.toString}
+                       default = Linkage.Dynamic,
+                       toString = Linkage.toString}
 
 val match = control {name = "match",
-		     default = fn _ => false,
-		     toString = fn _ => "<fn>"}
+                     default = fn _ => false,
+                     toString = fn _ => "<fn>"}
 
 val mlbfile = control {name = "mlbfile",
-		       default = "nlffi-generated.mlb",
-		       toString = fn s => s}
+                       default = "nlffi-generated.mlb",
+                       toString = fn s => s}
 
 val namedargs = control {name = "namedargs",
-			 default = false,
-			 toString = Bool.toString}
+                         default = false,
+                         toString = Bool.toString}
 
 val prefix = control {name = "prefix",
-		      default = "",
-		      toString = fn s => s}
+                      default = "",
+                      toString = fn s => s}
 
 structure Target =
    struct
@@ -84,41 +85,41 @@
       val host = T {arch = Arch.host, os = OS.host}
 
       fun toString (T {arch, os}) =
-	 concat [Arch.toString arch, "-", OS.toString os]
+         concat [Arch.toString arch, "-", OS.toString os]
 
       fun fromString s =
-	 case String.split (s, #"-") of
-	    [arch, os] =>
-	       (case (Arch.fromString arch, OS.fromString os) of
-		   (SOME arch, SOME os) =>
-		      SOME (T {arch = arch, os = os})
-		 | _ => NONE)
-	  | _ => NONE
+         case String.split (s, #"-") of
+            [arch, os] =>
+               (case (Arch.fromString arch, OS.fromString os) of
+                   (SOME arch, SOME os) =>
+                      SOME (T {arch = arch, os = os})
+                 | _ => NONE)
+          | _ => NONE
 
       fun make (t as T {arch, os}) =
-	 case (arch, os) of
-	    (Sparc, _) => SOME {name = toString t, sizes = SizesSparc.sizes,
-				endianShift = EndianBig.shift}
-	  | (PowerPC, _) => SOME {name = toString t, sizes = SizesPPC.sizes,
-				  endianShift = EndianLittle.shift}
-	  | (X86, _) => SOME {name = toString t, sizes = SizesX86.sizes,
-			      endianShift = EndianLittle.shift}
-	  | _ => NONE
+         case (arch, os) of
+            (Sparc, _) => SOME {name = toString t, sizes = SizesSparc.sizes,
+                                endianShift = EndianBig.shift}
+          | (PowerPC, _) => SOME {name = toString t, sizes = SizesPPC.sizes,
+                                  endianShift = EndianLittle.shift}
+          | (X86, _) => SOME {name = toString t, sizes = SizesX86.sizes,
+                              endianShift = EndianLittle.shift}
+          | _ => NONE
    end
 
 val target = control {name = "target",
-		      default = Target.make Target.host,
-		      toString = Option.toString (fn {name, ...} => name)}
+                      default = Target.make Target.host,
+                      toString = Option.toString (fn {name, ...} => name)}
 
 val weight = control {name = "weight",
-		      default = {heavy = true, light = true},
-		      toString = fn {heavy, light} =>
-		      concat ["{heavy = ", Bool.toString heavy, 
-			      ", light = ", Bool.toString light, "}"]}
+                      default = {heavy = true, light = true},
+                      toString = fn {heavy, light} =>
+                      concat ["{heavy = ", Bool.toString heavy, 
+                              ", light = ", Bool.toString light, "}"]}
 
 val width = control {name = "width",
-		     default = 75,
-		     toString = Int.toString}
+                     default = 75,
+                     toString = Int.toString}
 
 val defaults = setDefaults
 val _ = defaults ()

Modified: mlton/branches/on-20050420-cmm-branch/mlnlffigen/cpif-dev.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlnlffigen/cpif-dev.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlnlffigen/cpif-dev.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -22,9 +22,9 @@
 end = struct
 
     datatype device =
-	DEV of { filename: string,
-		 buffer : string list ref,
-		 wid : int }
+        DEV of { filename: string,
+                 buffer : string list ref,
+                 wid : int }
 
     (* no style support *)
     type style = unit
@@ -39,20 +39,20 @@
     (* Calculate the final output and compare it with the current
      * contents of the file.  If they do not coincide, write the file. *)
     fun closeOut (DEV { buffer = ref l, filename, ... }) = let
-	val s = concat (rev l)
-	fun write () = let
-	    val f = TextIO.openOut filename
-	in
-	    TextIO.output (f, s);
-	    TextIO.closeOut f
-	end
+        val s = concat (rev l)
+        fun write () = let
+            val f = TextIO.openOut filename
+        in
+            TextIO.output (f, s);
+            TextIO.closeOut f
+        end
     in
-	let val f = TextIO.openIn filename
-	    val s' = TextIO.inputAll f
-	in
-	    TextIO.closeIn f;
-	    if s = s' then () else write ()
-	end handle _ => write ()
+        let val f = TextIO.openIn filename
+            val s' = TextIO.inputAll f
+        in
+            TextIO.closeIn f;
+            if s = s' then () else write ()
+        end handle _ => write ()
     end
 
     (* maximum printing depth (in terms of boxes) *)

Modified: mlton/branches/on-20050420-cmm-branch/mlnlffigen/gen.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlnlffigen/gen.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlnlffigen/gen.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,11 +1,11 @@
 (* gen.sml
  * 2005 Matthew Fluet (mfluet@acm.org)
  *  Adapted for MLton.
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 2005-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
  *)
 
@@ -90,8 +90,8 @@
    val gensym_suffix =
       if gensym = "" then "" else "_" ^ gensym
    val {name = targetName, 
-	sizes = targetSizes, 
-	endianShift = targetEndianShift} = target
+        sizes = targetSizes, 
+        endianShift = targetEndianShift} = target
    val targetName = String.toLower targetName
    val {heavy = doheavy, light = dolight} = weight
 
@@ -106,121 +106,121 @@
       val version = "0.9.1"
       val author = "Matthias Blume"
       val email = "blume@tti-c.org"
-	 
+         
       val modifications = [{author = "Matthew Fluet",
-			    email = "mfluet@acm.org",
-			    note = "Adapted for MLton."}]
-	 
+                            email = "mfluet@acm.org",
+                            note = "Adapted for MLton."}]
+         
       val credits =
-	 concat 
-	 (["(* [by ", author, "'s ", 
-	   program, " (version ", version, ") for ", targetName, "] *)"] @
-	  (map (fn {author, email, note} =>
-		concat ["\n(* [modified by ", author, 
-			" (", email, ") <", note, ">] *)"]))
-	  modifications)
+         concat 
+         (["(* [by ", author, "'s ", 
+           program, " (version ", version, ") for ", targetName, "] *)"] @
+          (map (fn {author, email, note} =>
+                concat ["\n(* [modified by ", author, 
+                        " (", email, ") <", note, ">] *)"]))
+          modifications)
       val commentsto = 
-	 concat ["(* Send comments and suggestions to ", email, ". Thanks! *)"]
+         concat ["(* Send comments and suggestions to ", email, ". Thanks! *)"]
       val dontedit = "(* This file has been generated automatically. DO NOT EDIT! *)"
    in
       fun openPP (f, src) =
-	 let
+         let
             val device = CPIFDev.openOut (f, width)
-	    val stream = PP.openStream device
-	       
-	    fun nl () = PP.newline stream
-	    fun str s = PP.string stream s
-	    fun sp () = PP.space stream 1
-	    fun nsp () = PP.nbSpace stream 1
-	    fun Box a = PP.openBox stream (PP.Abs a)
-	    fun HBox () = PP.openHBox stream
-	    fun HVBox x = PP.openHVBox stream x
-	    fun HOVBox a = PP.openHOVBox stream (PP.Abs a)
-	    fun VBox a = PP.openVBox stream (PP.Abs a)
-	    fun endBox () = PP.closeBox stream
-	    fun ppty t = P.ppType stream t
-	    fun ppExp e = P.ppExp stream e
-	    fun ppFun x = P.ppFun stream x
-	    fun line s = (nl (); str s)
-	    fun pr_vdef (v, e) =
-	       (nl (); HOVBox 4
-		; str "val"; nsp (); str v; nsp (); str "=" ; sp (); ppExp e
-		; endBox ())
-	    fun pr_fdef (f, args, res) = (nl (); ppFun (f, args, res))
-	    fun pr_decl (keyword, connector) (v, t) =
-	       (nl (); HOVBox 4
-		; str keyword; nsp (); str v; nsp (); str connector; sp (); ppty t
-		; endBox ())
-	    val pr_tdef = pr_decl ("type", "=")
-	    val pr_vdecl = pr_decl ("val", ":")
-	    fun closePP () = (PP.closeStream stream; CPIFDev.closeOut device)
-	 in
-	    str dontedit;
-	    case src of
-	       NONE => ()
-	     | SOME s =>
-		  (nl (); str (concat ["(* [from code at ", s, "] *)"]));
-	    line credits;
-	    line commentsto;
-	    nl ();
-	    {stream = stream,
-	     line = line, nl = nl, str = str, sp = sp, nsp = nsp, 
-	     Box = Box, endBox = endBox,
-	     HVBox = HVBox, HBox = HBox, HOVBox = HOVBox, VBox = VBox, 
-	     ppty = ppty, ppExp = ppExp, ppFun = ppFun, 
-	     pr_vdef = pr_vdef, pr_fdef = pr_fdef, 
-	     pr_tdef = pr_tdef, pr_vdecl = pr_vdecl,
-	     closePP = closePP}
-	 end
+            val stream = PP.openStream device
+               
+            fun nl () = PP.newline stream
+            fun str s = PP.string stream s
+            fun sp () = PP.space stream 1
+            fun nsp () = PP.nbSpace stream 1
+            fun Box a = PP.openBox stream (PP.Abs a)
+            fun HBox () = PP.openHBox stream
+            fun HVBox x = PP.openHVBox stream x
+            fun HOVBox a = PP.openHOVBox stream (PP.Abs a)
+            fun VBox a = PP.openVBox stream (PP.Abs a)
+            fun endBox () = PP.closeBox stream
+            fun ppty t = P.ppType stream t
+            fun ppExp e = P.ppExp stream e
+            fun ppFun x = P.ppFun stream x
+            fun line s = (nl (); str s)
+            fun pr_vdef (v, e) =
+               (nl (); HOVBox 4
+                ; str "val"; nsp (); str v; nsp (); str "=" ; sp (); ppExp e
+                ; endBox ())
+            fun pr_fdef (f, args, res) = (nl (); ppFun (f, args, res))
+            fun pr_decl (keyword, connector) (v, t) =
+               (nl (); HOVBox 4
+                ; str keyword; nsp (); str v; nsp (); str connector; sp (); ppty t
+                ; endBox ())
+            val pr_tdef = pr_decl ("type", "=")
+            val pr_vdecl = pr_decl ("val", ":")
+            fun closePP () = (PP.closeStream stream; CPIFDev.closeOut device)
+         in
+            str dontedit;
+            case src of
+               NONE => ()
+             | SOME s =>
+                  (nl (); str (concat ["(* [from code at ", s, "] *)"]));
+            line credits;
+            line commentsto;
+            nl ();
+            {stream = stream,
+             line = line, nl = nl, str = str, sp = sp, nsp = nsp, 
+             Box = Box, endBox = endBox,
+             HVBox = HVBox, HBox = HBox, HOVBox = HOVBox, VBox = VBox, 
+             ppty = ppty, ppExp = ppExp, ppFun = ppFun, 
+             pr_vdef = pr_vdef, pr_fdef = pr_fdef, 
+             pr_tdef = pr_tdef, pr_vdecl = pr_vdecl,
+             closePP = closePP}
+         end
    end
 
    local
       val cpp_tmpl =
-	 Option.fold 
-	 (Process.getEnv "FFIGEN_CPP", 
-	  "gcc -E -U__GNUC__ %o %s > %t",
-	  fn (cpp_tmpl,_) => cpp_tmpl)
+         Option.fold 
+         (Process.getEnv "FFIGEN_CPP", 
+          "gcc -E -U__GNUC__ %o %s > %t",
+          fn (cpp_tmpl,_) => cpp_tmpl)
       val cpp_tmpl =
-	 String.substituteFirst
-	 (cpp_tmpl, 
-	  {substring = "%o", 
-	   replacement = String.concatWith (List.rev (!Control.cppopts), " ")})
+         String.substituteFirst
+         (cpp_tmpl, 
+          {substring = "%o", 
+           replacement = String.concatWith (List.rev (!Control.cppopts), " ")})
 
       fun mkidlsource (cfile,ifile) =
-	 let
-	    val cpp =
-	       List.fold
-	       ([{substring = "%s", replacement = cfile},
-		 {substring = "%t", replacement = ifile}], 
-		cpp_tmpl,
-		fn (s, subst) => String.substituteFirst (subst, s))
-	 in
-	    Process.system cpp
-	 end
+         let
+            val cpp =
+               List.fold
+               ([{substring = "%s", replacement = cfile},
+                 {substring = "%t", replacement = ifile}], 
+                cpp_tmpl,
+                fn (s, subst) => String.substituteFirst (subst, s))
+         in
+            Process.system cpp
+         end
 
       fun getSpec (cfile, s) =
-	 File.withTemp
-	 (fn ifile =>
-	  let
-	     val () = mkidlsource (cfile, ifile)
-	     val astbundle =
-		ParseToAst.fileToAst'
-		Out.error
-		(targetSizes, State.INITIAL)
-		ifile
-	     val s' =
-		AstToSpec.build
-		{bundle = astbundle,
-		 sizes = targetSizes,
-		 collect_enums = collect_enums,
-		 cfiles = cfiles,
-		 match = match,
-		 allSU = allSU,
-		 eshift = targetEndianShift,
-		 gensym_suffix = gensym_suffix}
-	  in
-	     S.join (s', s)
-	  end)
+         File.withTemp
+         (fn ifile =>
+          let
+             val () = mkidlsource (cfile, ifile)
+             val astbundle =
+                ParseToAst.fileToAst'
+                Out.error
+                (targetSizes, State.INITIAL)
+                ifile
+             val s' =
+                AstToSpec.build
+                {bundle = astbundle,
+                 sizes = targetSizes,
+                 collect_enums = collect_enums,
+                 cfiles = cfiles,
+                 match = match,
+                 allSU = allSU,
+                 eshift = targetEndianShift,
+                 gensym_suffix = gensym_suffix}
+          in
+             S.join (s', s)
+          end)
    in
       val spec = List.fold (cfiles, S.empty, getSpec)
    end
@@ -228,141 +228,141 @@
 
    val (structs, unions, enums) = 
       let
-	 val structs = 
-	    List.fold (structs, SM.empty, fn (s, m) => SM.insert (m, #tag s, s))
-	 val unions = 
-	    List.fold (unions, SM.empty, fn (s, m) => SM.insert (m, #tag s, s))
-	 val enums = 
-	    List.fold (enums, SM.empty, fn (s, m) => SM.insert (m, #tag s, s))
+         val structs = 
+            List.fold (structs, SM.empty, fn (s, m) => SM.insert (m, #tag s, s))
+         val unions = 
+            List.fold (unions, SM.empty, fn (s, m) => SM.insert (m, #tag s, s))
+         val enums = 
+            List.fold (enums, SM.empty, fn (s, m) => SM.insert (m, #tag s, s))
 
-	 val sdone = ref SS.empty
-	 val udone = ref SS.empty
-	 val edone = ref SS.empty
-	 val smap = ref SM.empty
-	 val umap = ref SM.empty
-	 val emap = ref SM.empty
-	 val ty_queue = ref []
-	 fun ty_sched ty = List.push (ty_queue, ty)
-	 fun fs_sched (S.OFIELD { spec = (_, ty), ... }) = ty_sched ty
-	   | fs_sched _ = ()
-	 fun f_sched { name, spec } = fs_sched spec
+         val sdone = ref SS.empty
+         val udone = ref SS.empty
+         val edone = ref SS.empty
+         val smap = ref SM.empty
+         val umap = ref SM.empty
+         val emap = ref SM.empty
+         val ty_queue = ref []
+         fun ty_sched ty = List.push (ty_queue, ty)
+         fun fs_sched (S.OFIELD { spec = (_, ty), ... }) = ty_sched ty
+           | fs_sched _ = ()
+         fun f_sched { name, spec } = fs_sched spec
 
-	 fun xenter (xdone, xall, xmap, xfields) t =
-	    if SS.member (!xdone, t) then ()
-	       else (xdone := SS.add (!xdone, t);
-		     case $? (xall, t) of
-			SOME x => (xmap := SM.insert (!xmap, t, x);
-				   app f_sched (xfields x))
-		      | NONE => ())
+         fun xenter (xdone, xall, xmap, xfields) t =
+            if SS.member (!xdone, t) then ()
+               else (xdone := SS.add (!xdone, t);
+                     case $? (xall, t) of
+                        SOME x => (xmap := SM.insert (!xmap, t, x);
+                                   app f_sched (xfields x))
+                      | NONE => ())
 
-	 val senter = xenter (sdone, structs, smap, #fields)
-	 val uenter = xenter (udone, unions, umap, #all)
-	 val eenter = xenter (edone, enums, emap, fn _ => [])
-	    
-	 fun sinclude (s: S.s) = if #exclude s then () else senter (#tag s)
-	 fun uinclude (u: S.u) = if #exclude u then () else uenter (#tag u)
-	 fun einclude (e: S.enum) = if #exclude e then () else eenter (#tag e)
-	    
-	 fun gty {src, name, spec} = ty_sched spec
-	 fun gvar {src, name, spec = (_, t)} = ty_sched t
-	 fun gfun {src, name, spec, argnames} = ty_sched (S.FPTR spec)
-	 fun loop tys =
-	    let
-	       fun do_ty ty =
-		  case ty of
-		     S.BASIC _ => ()
-		   | S.STRUCT t => senter t
-		   | S.UNION t => uenter t
-		   | S.ENUM (t, anon) =>
-			if collect_enums andalso anon 
-			   then eenter "'"
-			   else eenter t
-		   | S.VOIDPTR => ()
-		   | S.FPTR {args, res} =>
-			(List.foreach (args, do_ty); Option.app (res, do_ty))
-		   | S.PTR (_, S.STRUCT t) => ()
-		   | S.PTR (_, S.UNION t) => ()
-		   | S.PTR (_, t) => do_ty t
-		   | S.ARR {t, ... } => do_ty t
-		   | S.UNIMPLEMENTED _ => ()
-	       fun ty_loop tys =
-		  case tys of 
-		     [] => nextround ()
-		   | ty :: tys => (do_ty ty; ty_loop tys)
-	    in
-	       case tys of
-		  [] => ()
-		| _ => (ty_queue := []; ty_loop tys)
-	    end
-	 and nextround () = loop (!ty_queue)
+         val senter = xenter (sdone, structs, smap, #fields)
+         val uenter = xenter (udone, unions, umap, #all)
+         val eenter = xenter (edone, enums, emap, fn _ => [])
+            
+         fun sinclude (s: S.s) = if #exclude s then () else senter (#tag s)
+         fun uinclude (u: S.u) = if #exclude u then () else uenter (#tag u)
+         fun einclude (e: S.enum) = if #exclude e then () else eenter (#tag e)
+            
+         fun gty {src, name, spec} = ty_sched spec
+         fun gvar {src, name, spec = (_, t)} = ty_sched t
+         fun gfun {src, name, spec, argnames} = ty_sched (S.FPTR spec)
+         fun loop tys =
+            let
+               fun do_ty ty =
+                  case ty of
+                     S.BASIC _ => ()
+                   | S.STRUCT t => senter t
+                   | S.UNION t => uenter t
+                   | S.ENUM (t, anon) =>
+                        if collect_enums andalso anon 
+                           then eenter "'"
+                           else eenter t
+                   | S.VOIDPTR => ()
+                   | S.FPTR {args, res} =>
+                        (List.foreach (args, do_ty); Option.app (res, do_ty))
+                   | S.PTR (_, S.STRUCT t) => ()
+                   | S.PTR (_, S.UNION t) => ()
+                   | S.PTR (_, t) => do_ty t
+                   | S.ARR {t, ... } => do_ty t
+                   | S.UNIMPLEMENTED _ => ()
+               fun ty_loop tys =
+                  case tys of 
+                     [] => nextround ()
+                   | ty :: tys => (do_ty ty; ty_loop tys)
+            in
+               case tys of
+                  [] => ()
+                | _ => (ty_queue := []; ty_loop tys)
+            end
+         and nextround () = loop (!ty_queue)
       in
-	 SM.app sinclude structs;
-	 SM.app uinclude unions;
-	 SM.app einclude enums;
-	 app gty gtys;
-	 app gvar gvars;
-	 app gfun gfuns;
-	 nextround ();
-	 (!smap, !umap, !emap)
+         SM.app sinclude structs;
+         SM.app uinclude unions;
+         SM.app einclude enums;
+         app gty gtys;
+         app gvar gvars;
+         app gfun gfuns;
+         nextround ();
+         (!smap, !umap, !emap)
       end
    val (fptr_types,incomplete_structs, incomplete_unions, incomplete_enums) = 
       let
-	 fun taginsert (t, ss) =
-	    if SS.member (ss, t) then ss else SS.add (ss, t)
-	 fun sinsert (t, (f, s, u, e)) =
-	    (f, taginsert (t, s), u, e)
-	 fun uinsert (t, (f, s, u, e)) =
-	    (f, s, taginsert (t, u), e)
-	 fun einsert (t, (f, s, u, e)) =
-	    (f, s, u, taginsert (t, e))
-	 fun maybe_insert (t, ss, acc, insert) =
-	    case $? (ss, t) of
-	       SOME _ => acc
-	     | NONE => insert (t, acc)
+         fun taginsert (t, ss) =
+            if SS.member (ss, t) then ss else SS.add (ss, t)
+         fun sinsert (t, (f, s, u, e)) =
+            (f, taginsert (t, s), u, e)
+         fun uinsert (t, (f, s, u, e)) =
+            (f, s, taginsert (t, u), e)
+         fun einsert (t, (f, s, u, e)) =
+            (f, s, u, taginsert (t, e))
+         fun maybe_insert (t, ss, acc, insert) =
+            case $? (ss, t) of
+               SOME _ => acc
+             | NONE => insert (t, acc)
 
-	 fun do_ty (ty, acc) =
-	    case ty of 
-	       S.BASIC _ => acc
-	     | S.STRUCT t => maybe_insert (t, structs, acc, sinsert)
-	     | S.UNION t => maybe_insert (t, unions, acc, uinsert)
-	     | S.ENUM (t, anon) =>
-		  if collect_enums andalso anon
-		     then acc
-		     else maybe_insert (t, enums, acc, einsert)
-	     | S.VOIDPTR => acc
-	     | S.FPTR (cft as {args, res}) =>
-		  let
-		     val acc as (f, s, u, e) =
-			Option.fold (res, List.fold (args, acc, do_ty), do_ty)
-		     val cfth = hash_cft cft
-		     val i = IM.numItems f
-		  in
-		     if IM.inDomain (f, cfth)
-			then acc
-			else (IM.insert (f, cfth, (cft, i)), s, u, e)
-		  end
-	     | S.PTR (_, ty) => do_ty (ty, acc)
-	     | S.ARR {t = ty, ...} => do_ty (ty, acc)
-	     | S.UNIMPLEMENTED _ => acc
+         fun do_ty (ty, acc) =
+            case ty of 
+               S.BASIC _ => acc
+             | S.STRUCT t => maybe_insert (t, structs, acc, sinsert)
+             | S.UNION t => maybe_insert (t, unions, acc, uinsert)
+             | S.ENUM (t, anon) =>
+                  if collect_enums andalso anon
+                     then acc
+                     else maybe_insert (t, enums, acc, einsert)
+             | S.VOIDPTR => acc
+             | S.FPTR (cft as {args, res}) =>
+                  let
+                     val acc as (f, s, u, e) =
+                        Option.fold (res, List.fold (args, acc, do_ty), do_ty)
+                     val cfth = hash_cft cft
+                     val i = IM.numItems f
+                  in
+                     if IM.inDomain (f, cfth)
+                        then acc
+                        else (IM.insert (f, cfth, (cft, i)), s, u, e)
+                  end
+             | S.PTR (_, ty) => do_ty (ty, acc)
+             | S.ARR {t = ty, ...} => do_ty (ty, acc)
+             | S.UNIMPLEMENTED _ => acc
 
-	    fun fs (S.OFIELD {spec = (_, ty), ...}, acc) = do_ty (ty, acc)
-	      | fs (_, acc) = acc
-	    fun f ({name, spec}, acc) = fs (spec, acc)
-	    fun s ({src, tag, size, anon, fields, exclude}, acc) =
-	       List.fold (fields, acc, f)
-	    fun u ({src, tag, size, anon, all, exclude}, acc) =
-	       List.fold (all, acc, f)
+            fun fs (S.OFIELD {spec = (_, ty), ...}, acc) = do_ty (ty, acc)
+              | fs (_, acc) = acc
+            fun f ({name, spec}, acc) = fs (spec, acc)
+            fun s ({src, tag, size, anon, fields, exclude}, acc) =
+               List.fold (fields, acc, f)
+            fun u ({src, tag, size, anon, all, exclude}, acc) =
+               List.fold (all, acc, f)
 
-	    fun gvar ({src, name, spec = (_, ty)}, acc) = do_ty (ty, acc)
-	    fun gfun ({src, name, spec, argnames}, acc) = do_ty (S.FPTR spec, acc)
-	    fun gty ({src, name, spec}, acc) = do_ty (spec, acc)
+            fun gvar ({src, name, spec = (_, ty)}, acc) = do_ty (ty, acc)
+            fun gfun ({src, name, spec, argnames}, acc) = do_ty (S.FPTR spec, acc)
+            fun gty ({src, name, spec}, acc) = do_ty (spec, acc)
 
-	    fun lfold (l, f, b) = List.fold (l, b, f)
-	    fun mfold (m, f, b) = SM.foldl f b m
-	in
-	   lfold (gvars, gvar,
-	   lfold (gfuns, gfun, 
-	   lfold (gtys, gty,
+            fun lfold (l, f, b) = List.fold (l, b, f)
+            fun mfold (m, f, b) = SM.foldl f b m
+        in
+           lfold (gvars, gvar,
+           lfold (gfuns, gfun, 
+           lfold (gtys, gty,
            mfold (structs, s,
            mfold (unions, u,
            (IM.empty, SS.empty, SS.empty, SS.empty))))))
@@ -401,35 +401,35 @@
    local
       val dir_exists = ref false
       val checkDir = fn () =>
-	 if !dir_exists 
-	    then ()
-	    else (dir_exists := true;
-		  if OS.FileSys.isDir dir handle _ => false 
-		     then ()
-		     else OS.FileSys.mkDir dir)
+         if !dir_exists 
+            then ()
+            else (dir_exists := true;
+                  if OS.FileSys.isDir dir handle _ => false 
+                     then ()
+                     else OS.FileSys.mkDir dir)
    in
       fun smlFileAndExport (file,export,do_export) = 
-	 let
-	    (* we don't want apostrophes in file names -> turn them into minuses *)
-	    val file = Vector.map (file, fn #"'" => #"-" | c => c)
-	    val file = OS.Path.joinBaseExt {base = file, ext = SOME "sml"}
-	    val result = OS.Path.joinDirFile {dir = dir, file = file}
-	 in
-	    checkDir ()
-	    ; List.push (pending, export)
-	    ; (result, fn () => (List.push (files, file)
-				 ; if do_export
-				      then List.push (exports, export)
-				      else ()
-				 ; ignore (List.pop pending)))
-	 end
+         let
+            (* we don't want apostrophes in file names -> turn them into minuses *)
+            val file = Vector.map (file, fn #"'" => #"-" | c => c)
+            val file = OS.Path.joinBaseExt {base = file, ext = SOME "sml"}
+            val result = OS.Path.joinDirFile {dir = dir, file = file}
+         in
+            checkDir ()
+            ; List.push (pending, export)
+            ; (result, fn () => (List.push (files, file)
+                                 ; if do_export
+                                      then List.push (exports, export)
+                                      else ()
+                                 ; ignore (List.pop pending)))
+         end
       fun descrFile file =
-	 let
-	    val result = OS.Path.joinDirFile {dir = dir, file = file}
-	 in
-	    checkDir ()
-	    ; result
-	 end
+         let
+            val result = OS.Path.joinDirFile {dir = dir, file = file}
+         in
+            checkDir ()
+            ; result
+         end
    end
 
    fun rwro_str S.RW = "rw"
@@ -440,24 +440,24 @@
       
    fun dim_ty 0 = Type "dec"
      | dim_ty n = Con ("dg" ^ Int.toString (n mod 10),
-		       [dim_ty (n div 10)])
+                       [dim_ty (n div 10)])
    val dim_ty = fn n =>
       if n < 0 
-	 then raise Fail "negative dimension"
-	 else dim_ty n
+         then raise Fail "negative dimension"
+         else dim_ty n
 
    fun dim_val n = 
       let
-	 fun build 0 = EVar "dec"
-	   | build n = EApp (build (n div 10),
-			     EVar ("dg" ^ Int.toString (n mod 10)))
+         fun build 0 = EVar "dec"
+           | build n = EApp (build (n div 10),
+                             EVar ("dg" ^ Int.toString (n mod 10)))
       in
-	 EApp (build n, EVar "dim")
+         EApp (build n, EVar "dim")
       end
 
    fun stem basic_t =
       case basic_t of
-	 S.SCHAR => "schar"
+         S.SCHAR => "schar"
        | S.UCHAR => "uchar"
        | S.SSHORT => "sshort"
        | S.USHORT => "ushort"
@@ -473,7 +473,7 @@
    val bytebits = #bits (#char targetSizes)
    fun sizeof_basic basic_t =
       case basic_t of
-	 S.SCHAR => #bits (#char targetSizes)
+         S.SCHAR => #bits (#char targetSizes)
        | S.UCHAR => #bits (#char targetSizes)
        | S.SSHORT => #bits (#short targetSizes)
        | S.USHORT => #bits (#short targetSizes)
@@ -487,15 +487,15 @@
        | S.DOUBLE => #bits (#double targetSizes)
    and sizeof t =
       case t of
-	 S.BASIC basic_t => Word.fromInt ((sizeof_basic basic_t) div bytebits)
+         S.BASIC basic_t => Word.fromInt ((sizeof_basic basic_t) div bytebits)
        | S.STRUCT t =>
-	    (case $? (structs, t) of
-		SOME {size, ...} =>  size
-	      | NONE => err ["incomplete struct argument: struct ", t])
+            (case $? (structs, t) of
+                SOME {size, ...} =>  size
+              | NONE => err ["incomplete struct argument: struct ", t])
        | S.UNION t =>
-	    (case $? (unions, t) of
-		SOME {size, ...} => size
-	      | NONE => err ["incomplete union argument: union ", t])
+            (case $? (unions, t) of
+                SOME {size, ...} => size
+              | NONE => err ["incomplete union argument: union ", t])
        | S.ENUM _ => Word.fromInt ((#bits (#int targetSizes)) div bytebits)
        | S.VOIDPTR => Word.fromInt ((#bits (#pointer targetSizes)) div bytebits)
        | S.FPTR _ => Word.fromInt ((#bits (#pointer targetSizes)) div bytebits)
@@ -507,19 +507,19 @@
       HashSet.new {hash = fn (structname, _) => String.hash structname}
    fun fillGenStructTable (app, coll, pr_promise) =
       app (coll, fn elem =>
-	   let val (structname, promise) = pr_promise elem
-	   in
-	      (ignore o HashSet.lookupOrInsert)
-	      (genStructTable, String.hash structname,
-	       fn (s,_) => String.equals (structname, s),
-	       fn () => (structname, promise))
-	   end)
+           let val (structname, promise) = pr_promise elem
+           in
+              (ignore o HashSet.lookupOrInsert)
+              (genStructTable, String.hash structname,
+               fn (s,_) => String.equals (structname, s),
+               fn () => (structname, promise))
+           end)
    fun fillGenStructTable' (app, coll, pr_promise) =
       fillGenStructTable (fn (c, f) => app f c, coll, pr_promise)
    fun forceGenStruct structname =
       case HashSet.peek (genStructTable, String.hash structname,
-			 fn (s,_) => String.equals (structname, s)) of
-	 SOME (_,promise) => (Promise.force promise; structname)
+                         fn (s,_) => String.equals (structname, s)) of
+         SOME (_,promise) => (Promise.force promise; structname)
        | NONE => err ["missing structure: ", structname]
 
    fun SUEtag K tag = 
@@ -540,43 +540,43 @@
 
    fun witness_fptr_type_p prime {args, res} =
       let
-	 fun top_type ty =
-	    case ty of
-	       S.STRUCT t => Suobj'ro (Stag t)
-	     | S.UNION t => Suobj'ro (Utag t)
-	     | ty => witness_type' ty
-	 val (res_t, extra_arg_t) =
-	    case res of
-	       NONE => (Unit, [])
-	     | SOME (S.STRUCT t) =>
-		  let val ot = Suobj'rw "'" (Stag t)
-		  in (ot, [ot])
-		  end
-	     | SOME (S.UNION t) =>
-		  let val ot = Suobj'rw "'" (Utag t)
-		  in (ot, [ot])
-		  end
-	     | SOME ty => (top_type ty, [])
-	 val arg_tl = extra_arg_t @ (List.map (args, top_type))
-	 val dom_t = Tuple arg_tl
-	 val fct_t = Arrow (dom_t, res_t)
+         fun top_type ty =
+            case ty of
+               S.STRUCT t => Suobj'ro (Stag t)
+             | S.UNION t => Suobj'ro (Utag t)
+             | ty => witness_type' ty
+         val (res_t, extra_arg_t) =
+            case res of
+               NONE => (Unit, [])
+             | SOME (S.STRUCT t) =>
+                  let val ot = Suobj'rw "'" (Stag t)
+                  in (ot, [ot])
+                  end
+             | SOME (S.UNION t) =>
+                  let val ot = Suobj'rw "'" (Utag t)
+                  in (ot, [ot])
+                  end
+             | SOME ty => (top_type ty, [])
+         val arg_tl = extra_arg_t @ (List.map (args, top_type))
+         val dom_t = Tuple arg_tl
+         val fct_t = Arrow (dom_t, res_t)
       in
-	 Con ("fptr" ^ prime, [fct_t])
+         Con ("fptr" ^ prime, [fct_t])
       end
    and witness_type_p prime ty =
       (case ty of
-	  S.BASIC basic_t => Type (stem basic_t)
-	| S.STRUCT t => Con ("su", [Stag t])
-	| S.UNION t => Con ("su", [Utag t])
-	| S.ENUM t => Con ("enum", [Etag t])
-	| S.VOIDPTR => Type "voidptr"
-	| S.FPTR spec => witness_fptr_type_p prime spec
-	| S.PTR (c, ty) =>
-	     Con ("ptr" ^ prime,
-		  [Con ("obj", [witness_type ty, rwro_type c])])
-	| S.ARR {t = ty, d, ...} =>
-	     Con ("arr", [witness_type ty, dim_ty d])
-	| S.UNIMPLEMENTED what => unimp what)
+          S.BASIC basic_t => Type (stem basic_t)
+        | S.STRUCT t => Con ("su", [Stag t])
+        | S.UNION t => Con ("su", [Utag t])
+        | S.ENUM t => Con ("enum", [Etag t])
+        | S.VOIDPTR => Type "voidptr"
+        | S.FPTR spec => witness_fptr_type_p prime spec
+        | S.PTR (c, ty) =>
+             Con ("ptr" ^ prime,
+                  [Con ("obj", [witness_type ty, rwro_type c])])
+        | S.ARR {t = ty, d, ...} =>
+             Con ("arr", [witness_type ty, dim_ty d])
+        | S.UNIMPLEMENTED what => unimp what)
    and witness_type ty =
       witness_type_p "" ty
    and witness_type' ty =
@@ -584,46 +584,46 @@
 
    fun topfunc_type prime ({args, res}, argnames) =
       let
-	 fun top_type ty =
-	    case ty of
-	       S.BASIC S.SCHAR => Type "MLRep.Char.Signed.int"
-	     | S.BASIC S.UCHAR => Type "MLRep.Char.Unsigned.word"
-	     | S.BASIC S.SSHORT => Type "MLRep.Short.Signed.int"
-	     | S.BASIC S.USHORT => Type "MLRep.Short.Unsigned.word"
-	     | S.BASIC S.SINT => Type "MLRep.Int.Signed.int"
-	     | S.BASIC S.UINT => Type "MLRep.Int.Unsigned.word"
-	     | S.BASIC S.SLONG => Type "MLRep.Long.Signed.int"
-	     | S.BASIC S.ULONG => Type "MLRep.Long.Unsigned.word"
-	     | S.BASIC S.SLONGLONG => Type "MLRep.LongLong.Signed.int"
-	     | S.BASIC S.ULONGLONG => Type "MLRep.LongLong.Unsigned.word"
-	     | S.BASIC S.FLOAT => Type "MLRep.Float.real"
-	     | S.BASIC S.DOUBLE => Type "MLRep.Double.real"
-	     | S.STRUCT t => Con ("su_obj" ^ prime, [Stag t, Type "'c"])
-	     | S.UNION t => Con ("su_obj" ^ prime, [Utag t, Type "'c"])
-	     | S.ENUM _ => Type "MLRep.Int.Signed.int"
-	     | ty => witness_type_p prime ty
-	 val (res_t, extra_arg_t, extra_argname) =
-	    case res of
-	       NONE => (Unit, [], [])
-	     | SOME (S.STRUCT t) => 
-		  let val ot = Suobj'rw prime (Stag t)
-		  in (ot, [ot], [writeto])
-		  end
-	     | SOME (S.UNION t) => 
-		  let val ot = Suobj'rw prime (Utag t)
-		  in (ot, [ot], [writeto])
-		  end
-	     | SOME ty => (top_type ty, [], [])
-	 val arg_tl = List.map (args, top_type)
-	 val arg_t =
-	    case (namedargs, argnames) of
-	       (true, SOME nl) =>
-		  (Record o List.zip)
-		  (extra_argname @ nl,
-		   extra_arg_t @ arg_tl)
-	     | _ => Tuple (extra_arg_t @ arg_tl)
+         fun top_type ty =
+            case ty of
+               S.BASIC S.SCHAR => Type "MLRep.Char.Signed.int"
+             | S.BASIC S.UCHAR => Type "MLRep.Char.Unsigned.word"
+             | S.BASIC S.SSHORT => Type "MLRep.Short.Signed.int"
+             | S.BASIC S.USHORT => Type "MLRep.Short.Unsigned.word"
+             | S.BASIC S.SINT => Type "MLRep.Int.Signed.int"
+             | S.BASIC S.UINT => Type "MLRep.Int.Unsigned.word"
+             | S.BASIC S.SLONG => Type "MLRep.Long.Signed.int"
+             | S.BASIC S.ULONG => Type "MLRep.Long.Unsigned.word"
+             | S.BASIC S.SLONGLONG => Type "MLRep.LongLong.Signed.int"
+             | S.BASIC S.ULONGLONG => Type "MLRep.LongLong.Unsigned.word"
+             | S.BASIC S.FLOAT => Type "MLRep.Float.real"
+             | S.BASIC S.DOUBLE => Type "MLRep.Double.real"
+             | S.STRUCT t => Con ("su_obj" ^ prime, [Stag t, Type "'c"])
+             | S.UNION t => Con ("su_obj" ^ prime, [Utag t, Type "'c"])
+             | S.ENUM _ => Type "MLRep.Int.Signed.int"
+             | ty => witness_type_p prime ty
+         val (res_t, extra_arg_t, extra_argname) =
+            case res of
+               NONE => (Unit, [], [])
+             | SOME (S.STRUCT t) => 
+                  let val ot = Suobj'rw prime (Stag t)
+                  in (ot, [ot], [writeto])
+                  end
+             | SOME (S.UNION t) => 
+                  let val ot = Suobj'rw prime (Utag t)
+                  in (ot, [ot], [writeto])
+                  end
+             | SOME ty => (top_type ty, [], [])
+         val arg_tl = List.map (args, top_type)
+         val arg_t =
+            case (namedargs, argnames) of
+               (true, SOME nl) =>
+                  (Record o List.zip)
+                  (extra_argname @ nl,
+                   extra_arg_t @ arg_tl)
+             | _ => Tuple (extra_arg_t @ arg_tl)
       in
-	 Arrow (arg_t, res_t)
+         Arrow (arg_t, res_t)
       end
 
    fun rtti_type ty =
@@ -633,497 +633,497 @@
       fun simple v = EVar ("T." ^ v)
    in
       fun rtti_val ty =
-	 case ty of 
-	    S.BASIC basic_t => simple (stem basic_t)
-	  | S.STRUCT t =>
-	       if s_inc t then raise Incomplete else Styp t
-	  | S.UNION t =>
-	       if u_inc t then raise Incomplete else Utyp t
-	  | S.ENUM t =>
-	       EConstr (EVar "T.enum", Con ("T.typ", [Con ("enum", [Etag t])]))
-	  | S.VOIDPTR => simple "voidptr"
-	  | S.FPTR cft => 
-	       let
-		  val cfth = hash_cft cft
-	       in
-		  case %? (fptr_types, cfth) of
-		     SOME (_, i) => EVar (fptr_rtti_qid i)
-		   | NONE => raise Fail "fptr type missing"
-	       end
-	  | S.PTR (S.RW, ty) =>
-	       EApp (EVar "T.pointer", rtti_val ty)
-	  | S.PTR (S.RO, ty) =>
-	       EApp (EVar "T.ro", EApp (EVar "T.pointer", rtti_val ty))
-	  | S.ARR {t = ty, d, ...} =>
-	       EApp (EVar "T.arr", ETuple [rtti_val ty, dim_val d])
-	  | S.UNIMPLEMENTED what => raise Incomplete
+         case ty of 
+            S.BASIC basic_t => simple (stem basic_t)
+          | S.STRUCT t =>
+               if s_inc t then raise Incomplete else Styp t
+          | S.UNION t =>
+               if u_inc t then raise Incomplete else Utyp t
+          | S.ENUM t =>
+               EConstr (EVar "T.enum", Con ("T.typ", [Con ("enum", [Etag t])]))
+          | S.VOIDPTR => simple "voidptr"
+          | S.FPTR cft => 
+               let
+                  val cfth = hash_cft cft
+               in
+                  case %? (fptr_types, cfth) of
+                     SOME (_, i) => EVar (fptr_rtti_qid i)
+                   | NONE => raise Fail "fptr type missing"
+               end
+          | S.PTR (S.RW, ty) =>
+               EApp (EVar "T.pointer", rtti_val ty)
+          | S.PTR (S.RO, ty) =>
+               EApp (EVar "T.ro", EApp (EVar "T.pointer", rtti_val ty))
+          | S.ARR {t = ty, d, ...} =>
+               EApp (EVar "T.arr", ETuple [rtti_val ty, dim_val d])
+          | S.UNIMPLEMENTED what => raise Incomplete
    end
 
    fun fptr_mkcall spec =
       let 
-	 val h = hash_cft spec
+         val h = hash_cft spec
       in
-	 case %? (fptr_types, h) of
-	    SOME (_, i) => fptr_mkcall_qid i
-	  | NONE => raise Fail "missing fptr_type (mkcall)"
+         case %? (fptr_types, h) of
+            SOME (_, i) => fptr_mkcall_qid i
+          | NONE => raise Fail "missing fptr_type (mkcall)"
       end
 
    fun pr_gvar_promise x =
       let
-	 val {src, name, spec = (c, t)} = x
-	 val gstruct = Gstruct name
-	 val gstruct_export = "structure " ^ gstruct
+         val {src, name, spec = (c, t)} = x
+         val gstruct = Gstruct name
+         val gstruct_export = "structure " ^ gstruct
       in
-	 (gstruct,
-	  Promise.delay
-	  (fn () =>
-	   let
-	      val (file, done) = 
-		 smlFileAndExport ("g-" ^ name, gstruct_export, true)
-	      val {closePP, str, nl, Box, VBox, endBox,
-		   pr_fdef, pr_vdef, pr_tdef, ...} =
-		 openPP (file, SOME src)
-	      fun doit () =
-		 let
-		    val () = pr_tdef ("t", witness_type t)
-		    val incomplete =
-		       (pr_vdef ("typ",
-				 EConstr (rtti_val t,
-					  Con ("T.typ", [Type "t"])))
-			; false)
-		       handle Incomplee => true
-		    val obj' =
-		       EConstr (EApp (EVar "mk_obj'", EApp (EVar "h", EUnit)),
-				Con ("obj'", [Type "t", rwro_type c]))
-		    val dolight = dolight orelse incomplete
-		 in
-		    if dolight then pr_fdef ("obj'", [EUnit], obj') else ();
-		    if doheavy andalso not incomplete
-		       then pr_fdef ("obj", [EUnit],
-				     EApp (EApp (EVar "Heavy.obj", EVar "typ"),
-					   if dolight
-					      then EApp (EVar "obj'", EUnit)
-					      else obj'))
-		       else ()
-		 end
-	   in
-	      str "local";
-	      VBox 4;
-	      nl (); str "open C.Dim C_Int";
-	      case linkage of
-		 Control.Linkage.Dynamic =>
-		    pr_vdef ("h", EApp (EVar libhandle, EString name))
-	       | Control.Linkage.Static =>
-		    pr_fdef ("h", [EUnit],
-			     EPrim ("_import # \"" ^ name ^ "\"",
-				    Type "CMemory.addr"));
-	      endBox ();
-	      nl (); str "in";
-	      VBox 4;
-	      nl (); str (gstruct_export ^ " = struct");
-	      Box 4;
-	      doit ();
-	      endBox ();
-	      nl (); str "end";
-	      endBox ();
-	      nl (); str "end"; nl ();
-	      closePP ();
-	      done ()
-	   end))
+         (gstruct,
+          Promise.delay
+          (fn () =>
+           let
+              val (file, done) = 
+                 smlFileAndExport ("g-" ^ name, gstruct_export, true)
+              val {closePP, str, nl, Box, VBox, endBox,
+                   pr_fdef, pr_vdef, pr_tdef, ...} =
+                 openPP (file, SOME src)
+              fun doit () =
+                 let
+                    val () = pr_tdef ("t", witness_type t)
+                    val incomplete =
+                       (pr_vdef ("typ",
+                                 EConstr (rtti_val t,
+                                          Con ("T.typ", [Type "t"])))
+                        ; false)
+                       handle Incomplee => true
+                    val obj' =
+                       EConstr (EApp (EVar "mk_obj'", EApp (EVar "h", EUnit)),
+                                Con ("obj'", [Type "t", rwro_type c]))
+                    val dolight = dolight orelse incomplete
+                 in
+                    if dolight then pr_fdef ("obj'", [EUnit], obj') else ();
+                    if doheavy andalso not incomplete
+                       then pr_fdef ("obj", [EUnit],
+                                     EApp (EApp (EVar "Heavy.obj", EVar "typ"),
+                                           if dolight
+                                              then EApp (EVar "obj'", EUnit)
+                                              else obj'))
+                       else ()
+                 end
+           in
+              str "local";
+              VBox 4;
+              nl (); str "open C.Dim C_Int";
+              case linkage of
+                 Control.Linkage.Dynamic =>
+                    pr_vdef ("h", EApp (EVar libhandle, EString name))
+               | Control.Linkage.Static =>
+                    pr_fdef ("h", [EUnit],
+                             EPrim ("_address \"" ^ name ^ "\"",
+                                    Type "CMemory.addr"));
+              endBox ();
+              nl (); str "in";
+              VBox 4;
+              nl (); str (gstruct_export ^ " = struct");
+              Box 4;
+              doit ();
+              endBox ();
+              nl (); str "end";
+              endBox ();
+              nl (); str "end"; nl ();
+              closePP ();
+              done ()
+           end))
       end
    val () = fillGenStructTable (List.foreach, gvars, pr_gvar_promise)
 
    fun pr_gfun_promise x =
       let
-	 val {src, name, spec as {args, res}, argnames} = x
-	 val fstruct = Fstruct name
-	 val fstruct_export = "structure " ^ fstruct
+         val {src, name, spec as {args, res}, argnames} = x
+         val fstruct = Fstruct name
+         val fstruct_export = "structure " ^ fstruct
       in
-	 (fstruct,
-	  Promise.delay
-	  (fn () =>
-	   let
-	      val (file, done) = 
-		 smlFileAndExport ("f-" ^ name, fstruct_export, true)
-	      val {closePP, str, nl, Box, VBox, endBox,
-		   pr_fdef, pr_vdef, pr_vdecl, ...} =
-		 openPP (file, SOME src)
-	      fun doit is_light =
-		 let
-		    val ml_vars =
-		       List.mapi
-		       (args, fn (i, _) => 
-			EVar ("x" ^ Int.toString (i + 1)))
-		    fun app0 (what, e) = 
-		       if is_light then e else EApp (EVar what, e)
-		    fun light (what, e) = app0 ("Light." ^ what, e)
-		    fun heavy (what, t, e) =
-		       if is_light 
-			  then e
-			  else EApp (EApp (EVar ("Heavy." ^ what), rtti_val t), e)
-		    fun oneArg (e, t) =
-		       case t of
-			  S.BASIC basic_t => 
-			     EApp (EVar ("Cvt.c_" ^ stem basic_t), e)
-			| S.STRUCT _ => EApp (EVar "ro'", light ("obj", e))
-			| S.UNION _ => EApp (EVar "ro'", light ("obj", e))
-			| S.ENUM _ => EApp (EVar "Cvt.i2c_enum", e)
-			| S.PTR _ => light ("ptr", e)
-			| S.FPTR _ => light ("fptr", e)
-			| S.VOIDPTR => e
-			| S.UNIMPLEMENTED what => unimp_arg what
-			| S.ARR _ => raise Fail "array argument type"
-		    val c_exps = List.map2 (ml_vars, args, oneArg)
-		    val (ml_vars, c_exps, extra_argname) =
-		       let
-			  fun do_su () =
-			     let val x0 = EVar "x0"
-			     in
-				(x0 :: ml_vars,
-				 light ("obj", x0) :: c_exps,
-				 [writeto])
-			     end
-		       in
-			  case res of
-			     SOME (S.STRUCT _) => do_su ()
-			   | SOME (S.UNION _) => do_su ()
-			   | _ => (ml_vars, c_exps, [])
-		       end
-		    val call = EApp (EVar "call",
-				     ETuple [EApp (EVar "fptr", EUnit),
-					     ETuple c_exps])
-		    val ml_res =
-		       case res of
-			  NONE => call
-			| SOME t =>
-			     (case t of
-				 S.BASIC basic_t => 
-				    EApp (EVar ("Cvt.ml_" ^ stem basic_t), call)
-			       | S.STRUCT _ => heavy ("obj", t, call)
-			       | S.UNION _ => heavy ("obj", t, call)
-			       | S.ENUM _ => EApp (EVar "Cvt.c2i_enum", call)
-			       | S.PTR _ => heavy ("ptr", t, call)
-			       | S.FPTR _ => heavy ("fptr", t, call)
-			       | S.VOIDPTR => call
-			       | S.UNIMPLEMENTED what => unimp_res what
-			       | S.ARR _ => raise Fail "array result type")
-		 in
-		    fn () =>
-		    pr_fdef (if is_light then "f'" else "f", [ETuple ml_vars], ml_res)
-		 end
-	      fun do_fsig is_light =
-		 let val prime = if is_light then "'" else ""
-		 in pr_vdecl ("f" ^ prime, topfunc_type prime (spec, argnames))
-		 end
-	      val (do_f_heavy, incomplete) =
-		 (if doheavy then doit false else (fn () => ()), false)
-		 handle Incomplete => (fn () => (), true)
-	      val do_f_light =
-		 if dolight orelse incomplete then doit true else (fn () => ())
-	   in
-	      str "local";
-	      VBox 4;
-	      nl (); str "open C.Dim C_Int";
-	      case linkage of
-		 Control.Linkage.Dynamic =>
-		    pr_vdef ("h", EApp (EVar libhandle, EString name))
-	       | Control.Linkage.Static =>
-		    pr_fdef ("h", [EUnit],
-			     EPrim ("_import # \"" ^ name ^ "\"",
-				    Type "CMemory.addr"));
-	      endBox ();
-	      nl (); str "in";
-	      VBox 4;
-	      nl (); str (fstruct_export ^ " : sig");
-	      Box 4;
-	      pr_vdecl ("typ", rtti_type (S.FPTR spec));
-	      pr_vdecl ("fptr", Arrow (Unit, witness_type (S.FPTR spec)));
-	      if doheavy andalso not incomplete then do_fsig false else ();
-	      if dolight orelse incomplete then do_fsig true else ();
-	      endBox ();
-	      nl (); str "end = struct";
-	      Box 4;
-	      pr_vdef ("typ", rtti_val (S.FPTR spec));
-	      pr_fdef ("fptr",
-		       [EUnit],
-		       EApp (EVar "mk_fptr",
-			     ETuple [EVar (fptr_mkcall spec),
-				     EApp (EVar "h", EUnit)]));
-	      do_f_heavy ();
-	      do_f_light ();
-	      endBox ();
-	      nl (); str "end";
-	      endBox ();
-	      nl (); str "end"; nl ();
-	      closePP ();
-	      done ()
-	   end))
+         (fstruct,
+          Promise.delay
+          (fn () =>
+           let
+              val (file, done) = 
+                 smlFileAndExport ("f-" ^ name, fstruct_export, true)
+              val {closePP, str, nl, Box, VBox, endBox,
+                   pr_fdef, pr_vdef, pr_vdecl, ...} =
+                 openPP (file, SOME src)
+              fun doit is_light =
+                 let
+                    val ml_vars =
+                       List.mapi
+                       (args, fn (i, _) => 
+                        EVar ("x" ^ Int.toString (i + 1)))
+                    fun app0 (what, e) = 
+                       if is_light then e else EApp (EVar what, e)
+                    fun light (what, e) = app0 ("Light." ^ what, e)
+                    fun heavy (what, t, e) =
+                       if is_light 
+                          then e
+                          else EApp (EApp (EVar ("Heavy." ^ what), rtti_val t), e)
+                    fun oneArg (e, t) =
+                       case t of
+                          S.BASIC basic_t => 
+                             EApp (EVar ("Cvt.c_" ^ stem basic_t), e)
+                        | S.STRUCT _ => EApp (EVar "ro'", light ("obj", e))
+                        | S.UNION _ => EApp (EVar "ro'", light ("obj", e))
+                        | S.ENUM _ => EApp (EVar "Cvt.i2c_enum", e)
+                        | S.PTR _ => light ("ptr", e)
+                        | S.FPTR _ => light ("fptr", e)
+                        | S.VOIDPTR => e
+                        | S.UNIMPLEMENTED what => unimp_arg what
+                        | S.ARR _ => raise Fail "array argument type"
+                    val c_exps = List.map2 (ml_vars, args, oneArg)
+                    val (ml_vars, c_exps, extra_argname) =
+                       let
+                          fun do_su () =
+                             let val x0 = EVar "x0"
+                             in
+                                (x0 :: ml_vars,
+                                 light ("obj", x0) :: c_exps,
+                                 [writeto])
+                             end
+                       in
+                          case res of
+                             SOME (S.STRUCT _) => do_su ()
+                           | SOME (S.UNION _) => do_su ()
+                           | _ => (ml_vars, c_exps, [])
+                       end
+                    val call = EApp (EVar "call",
+                                     ETuple [EApp (EVar "fptr", EUnit),
+                                             ETuple c_exps])
+                    val ml_res =
+                       case res of
+                          NONE => call
+                        | SOME t =>
+                             (case t of
+                                 S.BASIC basic_t => 
+                                    EApp (EVar ("Cvt.ml_" ^ stem basic_t), call)
+                               | S.STRUCT _ => heavy ("obj", t, call)
+                               | S.UNION _ => heavy ("obj", t, call)
+                               | S.ENUM _ => EApp (EVar "Cvt.c2i_enum", call)
+                               | S.PTR _ => heavy ("ptr", t, call)
+                               | S.FPTR _ => heavy ("fptr", t, call)
+                               | S.VOIDPTR => call
+                               | S.UNIMPLEMENTED what => unimp_res what
+                               | S.ARR _ => raise Fail "array result type")
+                 in
+                    fn () =>
+                    pr_fdef (if is_light then "f'" else "f", [ETuple ml_vars], ml_res)
+                 end
+              fun do_fsig is_light =
+                 let val prime = if is_light then "'" else ""
+                 in pr_vdecl ("f" ^ prime, topfunc_type prime (spec, argnames))
+                 end
+              val (do_f_heavy, incomplete) =
+                 (if doheavy then doit false else (fn () => ()), false)
+                 handle Incomplete => (fn () => (), true)
+              val do_f_light =
+                 if dolight orelse incomplete then doit true else (fn () => ())
+           in
+              str "local";
+              VBox 4;
+              nl (); str "open C.Dim C_Int";
+              case linkage of
+                 Control.Linkage.Dynamic =>
+                    pr_vdef ("h", EApp (EVar libhandle, EString name))
+               | Control.Linkage.Static =>
+                    pr_fdef ("h", [EUnit],
+                             EPrim ("_address \"" ^ name ^ "\"",
+                                    Type "CMemory.addr"));
+              endBox ();
+              nl (); str "in";
+              VBox 4;
+              nl (); str (fstruct_export ^ " : sig");
+              Box 4;
+              pr_vdecl ("typ", rtti_type (S.FPTR spec));
+              pr_vdecl ("fptr", Arrow (Unit, witness_type (S.FPTR spec)));
+              if doheavy andalso not incomplete then do_fsig false else ();
+              if dolight orelse incomplete then do_fsig true else ();
+              endBox ();
+              nl (); str "end = struct";
+              Box 4;
+              pr_vdef ("typ", rtti_val (S.FPTR spec));
+              pr_fdef ("fptr",
+                       [EUnit],
+                       EApp (EVar "mk_fptr",
+                             ETuple [EVar (fptr_mkcall spec),
+                                     EApp (EVar "h", EUnit)]));
+              do_f_heavy ();
+              do_f_light ();
+              endBox ();
+              nl (); str "end";
+              endBox ();
+              nl (); str "end"; nl ();
+              closePP ();
+              done ()
+           end))
       end
    val () = fillGenStructTable (List.foreach, gfuns, pr_gfun_promise)
 
    val get_callop = 
       let
-	 val ncallops = ref 0
-	 val callops = ref IM.empty
-	 fun callop_sid i = "Callop_" ^ Int.toString i
-	 fun callop_qid i = callop_sid i ^ ".callop"
-	 fun get (ml_args_t, ml_res_t) = 
-	    let
-	       val e_proto_hash = hash_mltype (Arrow (ml_args_t, ml_res_t))
-	    in
-	       case %? (!callops, e_proto_hash) of
-		  SOME i => callop_qid i
-		| NONE => 
-		     let
-			val i = !ncallops
-			val sn = callop_sid i
-			val sn_export = "structure " ^ sn
-			val (file, done) = 
-			   smlFileAndExport
-			   ("callop-" ^ Int.toString i, sn_export, false)
-			val {closePP, str, nl, Box, VBox, endBox,
-			     pr_fdef, pr_vdef, pr_tdef, ...} =
-			   openPP (file, NONE)
-		     in
-			ncallops := i + 1;
-			callops := IM.insert (!callops, e_proto_hash, i);
-			str (sn_export ^ " = struct");
-			Box 4;
-			pr_vdef ("callop",
-				 EPrim ("_import *",
-					Arrow (Type "CMemory.addr",
-					       Arrow (ml_args_t,
-						      ml_res_t))));
-			endBox ();
-			nl (); str "end"; nl (); 
-			closePP (); 
-			done ();
-			callop_qid i
-		     end
-	    end
+         val ncallops = ref 0
+         val callops = ref IM.empty
+         fun callop_sid i = "Callop_" ^ Int.toString i
+         fun callop_qid i = callop_sid i ^ ".callop"
+         fun get (ml_args_t, ml_res_t) = 
+            let
+               val e_proto_hash = hash_mltype (Arrow (ml_args_t, ml_res_t))
+            in
+               case %? (!callops, e_proto_hash) of
+                  SOME i => callop_qid i
+                | NONE => 
+                     let
+                        val i = !ncallops
+                        val sn = callop_sid i
+                        val sn_export = "structure " ^ sn
+                        val (file, done) = 
+                           smlFileAndExport
+                           ("callop-" ^ Int.toString i, sn_export, false)
+                        val {closePP, str, nl, Box, VBox, endBox,
+                             pr_fdef, pr_vdef, pr_tdef, ...} =
+                           openPP (file, NONE)
+                     in
+                        ncallops := i + 1;
+                        callops := IM.insert (!callops, e_proto_hash, i);
+                        str (sn_export ^ " = struct");
+                        Box 4;
+                        pr_vdef ("callop",
+                                 EPrim ("_import *",
+                                        Arrow (Type "CMemory.addr",
+                                               Arrow (ml_args_t,
+                                                      ml_res_t))));
+                        endBox ();
+                        nl (); str "end"; nl (); 
+                        closePP (); 
+                        done ();
+                        callop_qid i
+                     end
+            end
       in
-	 get
+         get
       end
 
    fun pr_fptr_rtti_promise x =
       let
-	 val ({args, res}, i) = x
-	 val fstruct = fptr_rtti_struct_id i
-	 val fstruct_export = "structure " ^ fstruct
+         val ({args, res}, i) = x
+         val fstruct = fptr_rtti_struct_id i
+         val fstruct_export = "structure " ^ fstruct
       in
-	 (fstruct,
-	  Promise.delay
-	  (fn () =>
-	   let
-	      val (file, done) = 
-		 smlFileAndExport ("fptr-rtti-" ^ (Int.toString i), fstruct_export, false)
-	      val {closePP, str, nl, Box, VBox, endBox,
-		   pr_fdef, pr_vdef, pr_tdef, ...} =
-		 openPP (file, NONE)
+         (fstruct,
+          Promise.delay
+          (fn () =>
+           let
+              val (file, done) = 
+                 smlFileAndExport ("fptr-rtti-" ^ (Int.toString i), fstruct_export, false)
+              val {closePP, str, nl, Box, VBox, endBox,
+                   pr_fdef, pr_vdef, pr_tdef, ...} =
+                 openPP (file, NONE)
 
-	      fun mlty ty =
-		 case ty of
-		    S.BASIC basic_t => Type ("CMemory.cc_" ^ stem basic_t)
-		  | S.STRUCT _ => Type "CMemory.cc_addr"
-		  | S.UNION _ => Type "CMemory.cc_addr"
-		  | S.ENUM _ => Type "CMemory.cc_sint"
-		  | S.VOIDPTR => Type "CMemory.cc_addr"
-		  | S.FPTR _ => Type "CMemory.cc_addr"
-		  | S.PTR _ => Type "CMemory.cc_addr"
-		  | S.ARR _ => raise Fail "unexpected type"
-		  | S.UNIMPLEMENTED what => unimp what
-	      fun wrap (e, n) =
-		 EApp (EVar ("CMemory.wrap_" ^ n),
-		       EApp (EVar ("Cvt.ml_" ^ n), e))
-	      fun fldwrap (e, n, alt) =
-		 EApp (EVar ("CMemory.wrap_" ^ n),
-		       EApp (EVar ("Get." ^ n ^ alt), e))
-	      fun vwrap e = 
-		 EApp (EVar "CMemory.wrap_addr",
-		       EApp (EVar "reveal", e))
-	      fun fwrap e = 
-		 EApp (EVar "CMemory.wrap_addr",
-		       EApp (EVar "freveal", e))
-	      fun pwrap e = 
-		 EApp (EVar "CMemory.wrap_addr",
-		       EApp (EVar "reveal",
-			     EApp (EVar "Ptr.inject'", e)))
-	      fun fldvwrap (e, alt) = 
-		 EApp (EVar "CMemory.wrap_addr",
-		       EApp (EVar "reveal", 
-			     EApp (EVar ("Get.voidptr" ^ alt), e)))
-	      fun fldfwrap (e, alt) = 
-		 EApp (EVar "CMemory.wrap_addr",
-		       EApp (EVar "freveal", 
-			     if alt = "'"
-				then EApp (EVar "Get.fptr'", e)
-				else EApp (EVar "Light.fptr",
-					   EApp (EVar "Get.fptr", e))))
-	      fun fldpwrap (e, alt) =
-		 EApp (EVar "CMemory.wrap_addr",
-		       EApp (EVar "reveal",
-			     EApp (EVar ("Ptr.inject" ^ alt),
-				   EApp (EVar ("Get.ptr" ^ alt), e))))
-	      fun suwrap e = 
-		 pwrap (EApp (EVar "Ptr.|&!", e))
-	      fun ewrap e = 
-		 EApp (EVar "CMemory.wrap_sint",
-		       EApp (EVar "Cvt.c2i_enum", e))
-	      fun fldewrap (e, alt) = 
-		 EApp (EVar "CMemory.wrap_sint",
-		       EApp (EVar ("Get.enum" ^ alt), e))
+              fun mlty ty =
+                 case ty of
+                    S.BASIC basic_t => Type ("CMemory.cc_" ^ stem basic_t)
+                  | S.STRUCT _ => Type "CMemory.cc_addr"
+                  | S.UNION _ => Type "CMemory.cc_addr"
+                  | S.ENUM _ => Type "CMemory.cc_sint"
+                  | S.VOIDPTR => Type "CMemory.cc_addr"
+                  | S.FPTR _ => Type "CMemory.cc_addr"
+                  | S.PTR _ => Type "CMemory.cc_addr"
+                  | S.ARR _ => raise Fail "unexpected type"
+                  | S.UNIMPLEMENTED what => unimp what
+              fun wrap (e, n) =
+                 EApp (EVar ("CMemory.wrap_" ^ n),
+                       EApp (EVar ("Cvt.ml_" ^ n), e))
+              fun fldwrap (e, n, alt) =
+                 EApp (EVar ("CMemory.wrap_" ^ n),
+                       EApp (EVar ("Get." ^ n ^ alt), e))
+              fun vwrap e = 
+                 EApp (EVar "CMemory.wrap_addr",
+                       EApp (EVar "reveal", e))
+              fun fwrap e = 
+                 EApp (EVar "CMemory.wrap_addr",
+                       EApp (EVar "freveal", e))
+              fun pwrap e = 
+                 EApp (EVar "CMemory.wrap_addr",
+                       EApp (EVar "reveal",
+                             EApp (EVar "Ptr.inject'", e)))
+              fun fldvwrap (e, alt) = 
+                 EApp (EVar "CMemory.wrap_addr",
+                       EApp (EVar "reveal", 
+                             EApp (EVar ("Get.voidptr" ^ alt), e)))
+              fun fldfwrap (e, alt) = 
+                 EApp (EVar "CMemory.wrap_addr",
+                       EApp (EVar "freveal", 
+                             if alt = "'"
+                                then EApp (EVar "Get.fptr'", e)
+                                else EApp (EVar "Light.fptr",
+                                           EApp (EVar "Get.fptr", e))))
+              fun fldpwrap (e, alt) =
+                 EApp (EVar "CMemory.wrap_addr",
+                       EApp (EVar "reveal",
+                             EApp (EVar ("Ptr.inject" ^ alt),
+                                   EApp (EVar ("Get.ptr" ^ alt), e))))
+              fun suwrap e = 
+                 pwrap (EApp (EVar "Ptr.|&!", e))
+              fun ewrap e = 
+                 EApp (EVar "CMemory.wrap_sint",
+                       EApp (EVar "Cvt.c2i_enum", e))
+              fun fldewrap (e, alt) = 
+                 EApp (EVar "CMemory.wrap_sint",
+                       EApp (EVar ("Get.enum" ^ alt), e))
 
-	      val (ml_res_t,
-		   extra_arg_v, extra_arg_e, extra_ml_arg_t,
-		   res_wrap) =
-		 case res of
-		    NONE => 
-		       (Unit, [], [], [], fn r => r)
-		  | SOME (S.STRUCT _) =>
-		       (Unit,
-			[EVar "x0"],
-			[suwrap (EVar "x0")],
-			[Type "CMemory.cc_addr"],
-			fn r => ESeq (r, EVar "x0"))
-		  | SOME (S.UNION _) =>
-		       (Unit,
-			[EVar "x0"],
-			[suwrap (EVar "x0")],
-			[Type "CMemory.cc_addr"],
-			fn r => ESeq (r, EVar "x0"))
-		  | SOME t => 
-		       let
-			  fun unwrap n r =
-			     EApp (EVar ("Cvt.c_" ^ n),
-				   EApp (EVar ("CMemory.unwrap_" ^ n), r))
-			  fun punwrap cast r =
-			     EApp (EVar cast,
-				   EApp (EVar "CMemory.unwrap_addr", r))
-			  fun eunwrap r =
-			     EApp (EVar "Cvt.i2c_enum",
-				   EApp (EVar "CMemory.unwrap_sint", r))
-			  val res_wrap =
-			     case t of
-				S.BASIC basic_t => unwrap (stem basic_t)
-			      | S.STRUCT _ =>
-				   raise Fail "unexpected result type"
-			      | S.UNION _ =>
-				   raise Fail "unexpected result type"
-			      | S.ENUM _ => eunwrap
-			      | S.VOIDPTR => punwrap "vcast"
-			      | S.FPTR _ => punwrap "fcast"
-			      | S.PTR _ => punwrap "pcast"
-			      | S.ARR _ =>
-				   raise Fail "unexpected result type"
-			      | S.UNIMPLEMENTED what => unimp_res what
-		       in
-			  (mlty t, [], [], [], res_wrap)
-		       end
+              val (ml_res_t,
+                   extra_arg_v, extra_arg_e, extra_ml_arg_t,
+                   res_wrap) =
+                 case res of
+                    NONE => 
+                       (Unit, [], [], [], fn r => r)
+                  | SOME (S.STRUCT _) =>
+                       (Unit,
+                        [EVar "x0"],
+                        [suwrap (EVar "x0")],
+                        [Type "CMemory.cc_addr"],
+                        fn r => ESeq (r, EVar "x0"))
+                  | SOME (S.UNION _) =>
+                       (Unit,
+                        [EVar "x0"],
+                        [suwrap (EVar "x0")],
+                        [Type "CMemory.cc_addr"],
+                        fn r => ESeq (r, EVar "x0"))
+                  | SOME t => 
+                       let
+                          fun unwrap n r =
+                             EApp (EVar ("Cvt.c_" ^ n),
+                                   EApp (EVar ("CMemory.unwrap_" ^ n), r))
+                          fun punwrap cast r =
+                             EApp (EVar cast,
+                                   EApp (EVar "CMemory.unwrap_addr", r))
+                          fun eunwrap r =
+                             EApp (EVar "Cvt.i2c_enum",
+                                   EApp (EVar "CMemory.unwrap_sint", r))
+                          val res_wrap =
+                             case t of
+                                S.BASIC basic_t => unwrap (stem basic_t)
+                              | S.STRUCT _ =>
+                                   raise Fail "unexpected result type"
+                              | S.UNION _ =>
+                                   raise Fail "unexpected result type"
+                              | S.ENUM _ => eunwrap
+                              | S.VOIDPTR => punwrap "vcast"
+                              | S.FPTR _ => punwrap "fcast"
+                              | S.PTR _ => punwrap "pcast"
+                              | S.ARR _ =>
+                                   raise Fail "unexpected result type"
+                              | S.UNIMPLEMENTED what => unimp_res what
+                       in
+                          (mlty t, [], [], [], res_wrap)
+                       end
 
-	      fun doarg (h, p) =
-		 let
-		    fun sel e = ([mlty h], [e], [])
-		 in
-		    case h of
-		       S.BASIC basic_t => sel (wrap (p, stem basic_t))
-		     | S.STRUCT t => (* sel (suwrap p) *)
-			  raise Fail "unexpected struct argument"
-		     | S.UNION t => (* sel (suwrap p) *)
-			  raise Fail "unexpected union argument"
-		     | S.ENUM _ => sel (ewrap p)
-		     | S.VOIDPTR => sel (vwrap p)
-		     | S.FPTR _ => sel (fwrap p)
-		     | S.PTR _ => sel (pwrap p)
-		     | S.ARR _ => raise Fail "unexpected array argument"
-		     | S.UNIMPLEMENTED what => unimp_arg what
-		 end
-	      and arglist ([], _) = ([], [], [])
-		| arglist (h :: tl, i) = 
-		 let
-		    val p = EVar ("x" ^ Int.toString i)
-		    val (ta, ea, bnds) = arglist (tl, i + 1)
-		    val (ta', ea', bnds') = doarg (h, p)
-		 in
-		    (ta' @ ta, ea' @ ea, bnds' @ bnds)
-		 end
-		    
-	      val (ml_args_tl, args_el, bnds) = arglist (args, 1)
-		 
-	      val ml_args_t = Tuple (extra_ml_arg_t @ ml_args_tl)
-		 
-	      val arg_vl =
-		 List.mapi 
-		 (args, fn (i, _) =>
-		  EVar ("x" ^ Int.toString (i + 1)))
-		 
-	      val arg_e = ETuple (extra_arg_e @ args_el)
-	      val callop_n = get_callop (ml_args_t, ml_res_t)
-	   in
-	      str "local";
-	      VBox 4;
-	      nl (); str "open C.Dim C_Int";
-	      endBox ();
-	      nl (); str "in";
-	      VBox 4;
-	      nl (); str (fstruct_export ^ " = struct");
-	      Box 4;
-	      pr_fdef ("mkcall",
-		       [EVar "a", ETuple (extra_arg_v @ arg_vl)],
-		       res_wrap (ELet (bnds,
-				       EApp (EApp (EVar callop_n,
-						   EVar "a"),
-					     arg_e))));
-	      pr_vdef ("typ",
-		       EConstr (EApp (EVar "mk_fptr_typ", EVar "mkcall"),
-				rtti_type (S.FPTR {args = args, res = res})));
-	      endBox ();
-	      nl (); str "end";
-	      endBox ();
-	      nl (); str "end"; nl ();
-	      closePP ();
-	      done ()
-	   end))
+              fun doarg (h, p) =
+                 let
+                    fun sel e = ([mlty h], [e], [])
+                 in
+                    case h of
+                       S.BASIC basic_t => sel (wrap (p, stem basic_t))
+                     | S.STRUCT t => (* sel (suwrap p) *)
+                          raise Fail "struct argument not (yet) supported"
+                     | S.UNION t => (* sel (suwrap p) *)
+                          raise Fail "union argument not (yet) supported"
+                     | S.ENUM _ => sel (ewrap p)
+                     | S.VOIDPTR => sel (vwrap p)
+                     | S.FPTR _ => sel (fwrap p)
+                     | S.PTR _ => sel (pwrap p)
+                     | S.ARR _ => raise Fail "unexpected array argument"
+                     | S.UNIMPLEMENTED what => unimp_arg what
+                 end
+              and arglist ([], _) = ([], [], [])
+                | arglist (h :: tl, i) = 
+                 let
+                    val p = EVar ("x" ^ Int.toString i)
+                    val (ta, ea, bnds) = arglist (tl, i + 1)
+                    val (ta', ea', bnds') = doarg (h, p)
+                 in
+                    (ta' @ ta, ea' @ ea, bnds' @ bnds)
+                 end
+                    
+              val (ml_args_tl, args_el, bnds) = arglist (args, 1)
+                 
+              val ml_args_t = Tuple (extra_ml_arg_t @ ml_args_tl)
+                 
+              val arg_vl =
+                 List.mapi 
+                 (args, fn (i, _) =>
+                  EVar ("x" ^ Int.toString (i + 1)))
+                 
+              val arg_e = ETuple (extra_arg_e @ args_el)
+              val callop_n = get_callop (ml_args_t, ml_res_t)
+           in
+              str "local";
+              VBox 4;
+              nl (); str "open C.Dim C_Int";
+              endBox ();
+              nl (); str "in";
+              VBox 4;
+              nl (); str (fstruct_export ^ " = struct");
+              Box 4;
+              pr_fdef ("mkcall",
+                       [EVar "a", ETuple (extra_arg_v @ arg_vl)],
+                       res_wrap (ELet (bnds,
+                                       EApp (EApp (EVar callop_n,
+                                                   EVar "a"),
+                                             arg_e))));
+              pr_vdef ("typ",
+                       EConstr (EApp (EVar "mk_fptr_typ", EVar "mkcall"),
+                                rtti_type (S.FPTR {args = args, res = res})));
+              endBox ();
+              nl (); str "end";
+              endBox ();
+              nl (); str "end"; nl ();
+              closePP ();
+              done ()
+           end))
       end
    val () = fillGenStructTable' (IM.app, fptr_types, pr_fptr_rtti_promise)
 
    fun pr_gty_promise x =
       let
-	 val {src, name, spec} = x
-	 val tstruct = Tstruct name
-	 val tstruct_export = "structure " ^ tstruct
+         val {src, name, spec} = x
+         val tstruct = Tstruct name
+         val tstruct_export = "structure " ^ tstruct
       in
-	 (tstruct,
-	  Promise.delay
-	  (fn () =>
-	   let
-	      val (file, done) = 
-		 smlFileAndExport ("t-" ^ name, tstruct_export, true)
-	      val {closePP, str, nl, Box, VBox, endBox,
-		   pr_vdef, pr_tdef, ...} =
-		 openPP (file, SOME src)
-	      val rtti_val_opt =
-		 (SOME (rtti_val spec))
-		 handle Incomplete => NONE
-	   in
-	      str "local";
-	      VBox 4;
-	      nl (); str "open C.Dim C_Int";
-	      endBox ();
-	      nl (); str "in";
-	      VBox 4;
-	      nl (); str (tstruct_export ^ " = struct");
-	      Box 4;
-	      pr_tdef ("t", witness_type spec);
-	      Option.app 
-	      (rtti_val_opt, fn rtti_val =>
-	       pr_vdef ("typ", EConstr (rtti_val, Con ("T.typ", [Type "t"]))));
-	      endBox ();
-	      nl (); str "end";
-	      endBox ();
-	      nl (); str "end"; nl ();
-	      closePP ();
-	      done ()
-	   end))
+         (tstruct,
+          Promise.delay
+          (fn () =>
+           let
+              val (file, done) = 
+                 smlFileAndExport ("t-" ^ name, tstruct_export, true)
+              val {closePP, str, nl, Box, VBox, endBox,
+                   pr_vdef, pr_tdef, ...} =
+                 openPP (file, SOME src)
+              val rtti_val_opt =
+                 (SOME (rtti_val spec))
+                 handle Incomplete => NONE
+           in
+              str "local";
+              VBox 4;
+              nl (); str "open C.Dim C_Int";
+              endBox ();
+              nl (); str "in";
+              VBox 4;
+              nl (); str (tstruct_export ^ " = struct");
+              Box 4;
+              pr_tdef ("t", witness_type spec);
+              Option.app 
+              (rtti_val_opt, fn rtti_val =>
+               pr_vdef ("typ", EConstr (rtti_val, Con ("T.typ", [Type "t"]))));
+              endBox ();
+              nl (); str "end";
+              endBox ();
+              nl (); str "end"; nl ();
+              closePP ();
+              done ()
+           end))
       end
    val () = fillGenStructTable (List.foreach, gtys, pr_gty_promise)
 
@@ -1134,76 +1134,76 @@
 
    fun pr_suet_promise x =
       let
-	 val (src, tag, anon, tinfo, k, K) = x
-	 val suetstruct = SUETstruct K tag
-	 val suetstruct_export = "structure " ^ suetstruct
+         val (src, tag, anon, tinfo, k, K) = x
+         val suetstruct = SUETstruct K tag
+         val suetstruct_export = "structure " ^ suetstruct
       in
-	 (suetstruct,
-	  Promise.delay
-	  (fn () =>
-	   let
-	      val (file, done) = 
-		 smlFileAndExport (k ^ "t-" ^ tag, suetstruct_export, tinfo = T_INC)
-	      val {closePP, str, nl, Box, VBox, endBox,
-		   pr_vdef, pr_tdef, ...} =
-		 openPP (file, src)
-	      val (utildef, tag_t) =
-		 if anon 
-		    then
-		       ("structure X :> sig type t end \
-			\= struct type t = unit end",
-			Type "X.t")
-		    else 
-		       ("open Tag",
-			Vector.foldr
-			(tag, Type k, fn (c, tag_t) =>
-			 Con ("t_" ^ String.fromChar c, [tag_t])))
-	      fun do_susize size =
-		 let in
-		    pr_vdef ("size",
-			     EConstr (EApp (EVar "mk_su_size", EWord size),
-				      Con ("S.size", [Con ("su", [Type "tag"])])));
-		    pr_vdef ("typ",
-			     EApp (EVar "mk_su_typ", EVar "size"))
-		 end
-	   in
-	      str "local";
-	      VBox 4;
-	      nl (); str "open C.Dim C_Int";
-	      nl (); str (concat ["structure ", SUEstruct K tag, " = struct"]);
-	      Box 4;
-	      nl (); str "local";
-	      VBox 4;
-	      nl (); str utildef;
-	      endBox ();
-	      nl (); str "in";
-	      VBox 4;
-	      pr_tdef ("tag", tag_t);
-	      endBox ();
-	      nl (); str "end";
-	      case tinfo of
-		 T_INC => ()
-	       | T_SU size => do_susize size
-	       | T_E => ();
-	      endBox ();
-	      nl (); str "end";
+         (suetstruct,
+          Promise.delay
+          (fn () =>
+           let
+              val (file, done) = 
+                 smlFileAndExport (k ^ "t-" ^ tag, suetstruct_export, tinfo = T_INC)
+              val {closePP, str, nl, Box, VBox, endBox,
+                   pr_vdef, pr_tdef, ...} =
+                 openPP (file, src)
+              val (utildef, tag_t) =
+                 if anon 
+                    then
+                       ("structure X :> sig type t end \
+                        \= struct type t = unit end",
+                        Type "X.t")
+                    else 
+                       ("open Tag",
+                        Vector.foldr
+                        (tag, Type k, fn (c, tag_t) =>
+                         Con ("t_" ^ String.fromChar c, [tag_t])))
+              fun do_susize size =
+                 let in
+                    pr_vdef ("size",
+                             EConstr (EApp (EVar "mk_su_size", EWord size),
+                                      Con ("S.size", [Con ("su", [Type "tag"])])));
+                    pr_vdef ("typ",
+                             EApp (EVar "mk_su_typ", EVar "size"))
+                 end
+           in
+              str "local";
+              VBox 4;
+              nl (); str "open C.Dim C_Int";
+              nl (); str (concat ["structure ", SUEstruct K tag, " = struct"]);
+              Box 4;
+              nl (); str "local";
+              VBox 4;
+              nl (); str utildef;
               endBox ();
-	      nl (); str "in";
-	      VBox 4;
-	      nl (); str (concat [suetstruct_export, " = ", SUEstruct K tag]);
-	      endBox ();
-	      nl (); str "end"; nl ();
-	      closePP ();
-	      done ()
-	   end))
+              nl (); str "in";
+              VBox 4;
+              pr_tdef ("tag", tag_t);
+              endBox ();
+              nl (); str "end";
+              case tinfo of
+                 T_INC => ()
+               | T_SU size => do_susize size
+               | T_E => ();
+              endBox ();
+              nl (); str "end";
+              endBox ();
+              nl (); str "in";
+              VBox 4;
+              nl (); str (concat [suetstruct_export, " = ", SUEstruct K tag]);
+              endBox ();
+              nl (); str "end"; nl ();
+              closePP ();
+              done ()
+           end))
       end
    local
       fun pr_st_promise {src, tag, anon, size, fields, exclude} =
-	 pr_suet_promise (SOME src, tag, anon, T_SU size, "s", "S")
+         pr_suet_promise (SOME src, tag, anon, T_SU size, "s", "S")
       fun pr_ut_promise {src, tag, anon, size, all, exclude} =
-	 pr_suet_promise (SOME src, tag, anon, T_SU size, "u", "U")
+         pr_suet_promise (SOME src, tag, anon, T_SU size, "u", "U")
       fun pr_et_promise {src, tag, anon, descr, spec, exclude} =
-	 pr_suet_promise (SOME src, tag, anon, T_E, "e", "E")
+         pr_suet_promise (SOME src, tag, anon, T_E, "e", "E")
    in
       val () = fillGenStructTable' (SM.app, structs, pr_st_promise)
       val () = fillGenStructTable' (SM.app, unions, pr_ut_promise)
@@ -1211,7 +1211,7 @@
    end
    local
       fun pr_i_suet_promise (tag, k, K) = 
-	 pr_suet_promise (NONE, tag, false, T_INC, k, K)
+         pr_suet_promise (NONE, tag, false, T_INC, k, K)
       fun pr_i_st_promise tag = pr_i_suet_promise (tag, "s", "S")
       fun pr_i_ut_promise tag = pr_i_suet_promise (tag, "u", "U")
       fun pr_i_et_promise tag = pr_i_suet_promise (tag, "e", "E")
@@ -1223,121 +1223,121 @@
 
    fun pr_su_promise x =
       let
-	 val (src, tag, fields, k, K) = x
-	 val sustruct = SUEstruct K tag
-	 val sustruct_export = "structure " ^ sustruct
+         val (src, tag, fields, k, K) = x
+         val sustruct = SUEstruct K tag
+         val sustruct_export = "structure " ^ sustruct
       in
-	 (sustruct,
-	  Promise.delay
-	  (fn () =>
-	   let
-	      val (file, done) = 
-		 smlFileAndExport (k ^ "-" ^ tag, sustruct_export, true)
-	      val {closePP, str, nl, Box, VBox, endBox,
-		   pr_fdef, pr_vdef, pr_tdef, ...} =
-		 openPP (file, SOME src)
-	      fun pr_field_type {name, spec} =
-		 case spec of
-		    S.OFIELD {spec = (c, ty), synthetic = false, offset} =>
-		       pr_tdef (fieldtype_id name, 
-				witness_type ty)
-		  | _ => ()
-	      fun pr_field_rtti {name, spec} =
-		 case spec of
-		    S.OFIELD {spec = (c, ty), synthetic = false, offset} =>
-		       pr_vdef (fieldrtti_id name,
-				EConstr (rtti_val ty,
-					 Con ("T.typ", [Type (fieldtype_id name)])))
-		  | _ => ()
-	      fun arg_x prime =
-		 EConstr (EVar "x",
-			  Con ("su_obj" ^ prime,
-			       [Type "tag", Type "'c"]))
-	      fun pr_bf_acc (name, prime, sign,
-			     {offset, constness, bits, shift}) =
-		 let
-		    val maker =
-		       concat ["mk_", rwro_str constness, "_", sign, "bf", prime]
-		 in
-		    pr_fdef (field_id (name, prime),
-			     [arg_x prime],
-			     EApp (EApp (EVar maker,
-					 ETuple [EInt offset,
-						 EWord bits,
-						 EWord shift]),
-				   EVar "x"))
-		 end
-	      fun pr_field_acc' {name, spec} =
-		 case spec of
-		    S.OFIELD {spec = (c, ty), synthetic, offset} =>
-		       if synthetic
-			  then ()
-			  else pr_fdef (field_id (name, "'"),
-					[arg_x "'"],
-					EConstr (EApp (EVar "mk_field'",
-						       ETuple [EInt offset,
-							       EVar "x"]),
-						 Con ("obj'",
-						      [Type (fieldtype_id name),
-						       rwro_c_type c])))
-		  | S.SBF bf =>
-		       pr_bf_acc (name, "'", "s", bf)
-		  | S.UBF bf =>
-		       pr_bf_acc (name, "'", "u", bf)
-	      fun pr_field_acc {name, spec} =
-		 case spec of
-		    S.OFIELD {spec = (c, ty), synthetic, offset} =>
-		       if synthetic
-			  then ()
-			  else let
-				  val maker =
-				     concat ["mk_", rwro_str c, "_field"]
-			       in
-				  pr_fdef (field_id (name, ""),
-					   [arg_x ""],
-					   EApp (EVar maker,
-						 ETuple [EVar (fieldrtti_id name),
-							 EInt offset,
-							 EVar "x"]))
-			       end
-		  | S.SBF bf =>
-		       pr_bf_acc (name, "", "s", bf)
-		  | S.UBF bf =>
-		       pr_bf_acc (name, "", "u", bf)
-	      fun pr_one_field f = 
-		 let
-		    val _ = pr_field_type f
-		    val incomplete = 
-		       (pr_field_rtti f; false) 
-		       handle Incomplete => true
-		 in
-		    if dolight orelse incomplete then pr_field_acc' f else ();
-		    if doheavy andalso not incomplete then pr_field_acc f else ()
-		 end
-	   in
-	      str "local";
-	      VBox 4;
-	      nl (); str "open C.Dim C_Int";
-	      endBox ();
-	      nl (); str "in";
-	      VBox 4;
-	      nl (); str (sustruct_export ^ " = struct");
-	      Box 4;
-	      nl (); str ("open " ^ (forceGenStruct (SUETstruct K tag)));
-	      List.foreach (fields, pr_one_field);
-	      endBox ();
-	      nl (); str "end";
-	      endBox ();
-	      nl (); str "end"; nl ();
-	      closePP ();
-	      done ()
-	   end))
+         (sustruct,
+          Promise.delay
+          (fn () =>
+           let
+              val (file, done) = 
+                 smlFileAndExport (k ^ "-" ^ tag, sustruct_export, true)
+              val {closePP, str, nl, Box, VBox, endBox,
+                   pr_fdef, pr_vdef, pr_tdef, ...} =
+                 openPP (file, SOME src)
+              fun pr_field_type {name, spec} =
+                 case spec of
+                    S.OFIELD {spec = (c, ty), synthetic = false, offset} =>
+                       pr_tdef (fieldtype_id name, 
+                                witness_type ty)
+                  | _ => ()
+              fun pr_field_rtti {name, spec} =
+                 case spec of
+                    S.OFIELD {spec = (c, ty), synthetic = false, offset} =>
+                       pr_vdef (fieldrtti_id name,
+                                EConstr (rtti_val ty,
+                                         Con ("T.typ", [Type (fieldtype_id name)])))
+                  | _ => ()
+              fun arg_x prime =
+                 EConstr (EVar "x",
+                          Con ("su_obj" ^ prime,
+                               [Type "tag", Type "'c"]))
+              fun pr_bf_acc (name, prime, sign,
+                             {offset, constness, bits, shift}) =
+                 let
+                    val maker =
+                       concat ["mk_", rwro_str constness, "_", sign, "bf", prime]
+                 in
+                    pr_fdef (field_id (name, prime),
+                             [arg_x prime],
+                             EApp (EApp (EVar maker,
+                                         ETuple [EInt offset,
+                                                 EWord bits,
+                                                 EWord shift]),
+                                   EVar "x"))
+                 end
+              fun pr_field_acc' {name, spec} =
+                 case spec of
+                    S.OFIELD {spec = (c, ty), synthetic, offset} =>
+                       if synthetic
+                          then ()
+                          else pr_fdef (field_id (name, "'"),
+                                        [arg_x "'"],
+                                        EConstr (EApp (EVar "mk_field'",
+                                                       ETuple [EInt offset,
+                                                               EVar "x"]),
+                                                 Con ("obj'",
+                                                      [Type (fieldtype_id name),
+                                                       rwro_c_type c])))
+                  | S.SBF bf =>
+                       pr_bf_acc (name, "'", "s", bf)
+                  | S.UBF bf =>
+                       pr_bf_acc (name, "'", "u", bf)
+              fun pr_field_acc {name, spec} =
+                 case spec of
+                    S.OFIELD {spec = (c, ty), synthetic, offset} =>
+                       if synthetic
+                          then ()
+                          else let
+                                  val maker =
+                                     concat ["mk_", rwro_str c, "_field"]
+                               in
+                                  pr_fdef (field_id (name, ""),
+                                           [arg_x ""],
+                                           EApp (EVar maker,
+                                                 ETuple [EVar (fieldrtti_id name),
+                                                         EInt offset,
+                                                         EVar "x"]))
+                               end
+                  | S.SBF bf =>
+                       pr_bf_acc (name, "", "s", bf)
+                  | S.UBF bf =>
+                       pr_bf_acc (name, "", "u", bf)
+              fun pr_one_field f = 
+                 let
+                    val _ = pr_field_type f
+                    val incomplete = 
+                       (pr_field_rtti f; false) 
+                       handle Incomplete => true
+                 in
+                    if dolight orelse incomplete then pr_field_acc' f else ();
+                    if doheavy andalso not incomplete then pr_field_acc f else ()
+                 end
+           in
+              str "local";
+              VBox 4;
+              nl (); str "open C.Dim C_Int";
+              endBox ();
+              nl (); str "in";
+              VBox 4;
+              nl (); str (sustruct_export ^ " = struct");
+              Box 4;
+              nl (); str ("open " ^ (forceGenStruct (SUETstruct K tag)));
+              List.foreach (fields, pr_one_field);
+              endBox ();
+              nl (); str "end";
+              endBox ();
+              nl (); str "end"; nl ();
+              closePP ();
+              done ()
+           end))
       end
    local
       fun pr_s_promise { src, tag, anon, size, fields, exclude } =
-	 pr_su_promise (src, tag, fields, "s", "S")
+         pr_su_promise (src, tag, fields, "s", "S")
       fun pr_u_promise { src, tag, anon, size, all, exclude } =
-	 pr_su_promise (src, tag, all, "u", "U")
+         pr_su_promise (src, tag, all, "u", "U")
    in
       val () = fillGenStructTable' (SM.app, structs, pr_s_promise)
       val () = fillGenStructTable' (SM.app, unions, pr_u_promise)
@@ -1345,153 +1345,153 @@
 
    fun pr_e_promise x =
       let
-	 val {src, tag, anon, descr, spec, exclude} = x
-	 val estruct = Estruct' (tag, anon)
-	 val estruct_export = "structure " ^ estruct
+         val {src, tag, anon, descr, spec, exclude} = x
+         val estruct = Estruct' (tag, anon)
+         val estruct_export = "structure " ^ estruct
       in
-	 (estruct,
-	  Promise.delay
-	  (fn () =>
-	   let
-	      val (file, done) = 
-		 smlFileAndExport ("e-" ^ tag, estruct_export, true)
-	      val {closePP, str, line, nl, sp, Box, VBox, endBox,
-		   pr_fdef, pr_vdef, pr_tdef, ...} =
-		 openPP (file, SOME src)
-	      fun no_duplicate_values () = 
-		 let
-		    fun loop (l, s) =
-		       case l of
-			  [] => true
-			| {name, spec} :: l =>
-			     if LIS.member (s, spec) 
-				then (warn (concat ["enum ", descr,
-						    " has duplicate values;\
-						    \ using sing,\
-						    \ not generating constructors\n"]);
-				      false)
-				else loop (l, LIS.add (s, spec))
-		 in
-		    loop (spec, LIS.empty)
-		 end
-	      val dodt = enum_cons andalso no_duplicate_values ()
-	      fun dt_mlrep () = 
-		 let
-		    fun pcl () = 
-		       let
-			  fun loop (c, l) =
-			     case l of
-				[] => ()
-			      | {name, spec} :: l =>
-				   (str (c ^ enum_id name); nextround l)
-			  and nextround [] = ()
-			    | nextround l = (sp (); loop ("| ", l))
-		       in
-			  Box 2; nl ();
-			  loop ("  ", spec);
-			  endBox ()
-		       end
-		    fun pfl (fname, arg, res, fini) = 
-		       let
-			  fun loop (pfx, l) =
-			     case l of 
-				[] => ()
-			      | v :: l =>
-				   (line (concat [pfx, " ", arg v, " => ", res v]);
-				      loop ("  |", l))
-		       in
-			  line (concat ["fun ", fname, " x ="]);
-			  Box 4;
-			  line ("case x of");
-			  loop ("   ", spec);
-			  fini ();
-			  endBox ()
-		       end
-		    fun cstr {name, spec} = enum_id name
-		    fun vstr {name, spec} =
-		       LargeInt.toString spec ^ " : MLRep.Int.Signed.int"
-		 in
-		    line "datatype mlrep =";
-		    pcl ();
-		    pfl ("m2i", cstr, vstr, fn () => ());
-		    pfl ("i2m", vstr, cstr,
-			 fn () => line "  | _ => raise General.Domain")
-		 end
-	      fun int_mlrep () = 
-		 let
-		    fun v {name, spec} =
-		       pr_vdef (enum_id name, EConstr (ELInt spec, Type "mlrep"))
-		    val mlx = EConstr (EVar "x", Type "mlrep")
-		    val ty = Type "MLRep.Int.Signed.int"
-		    val ix = EConstr (EVar "x", ty)
-		 in
-		    pr_tdef ("mlrep", ty);
-		    List.foreach (spec, v);
-		    pr_fdef ("m2i", [mlx], ix);
-		    pr_fdef ("i2m", [ix], mlx)
-		 end
-	      fun getset p = 
-		 let
-		    fun constr c = Con ("enum_obj" ^ p, [Type "tag", Type c])
-		 in
-		    pr_fdef ("get" ^ p,
-			     [EConstr (EVar "x", constr "'c")],
-			     EApp (EVar "i2m",
-				   EApp (EVar ("Get.enum" ^ p), EVar "x")));
-		    pr_fdef ("set" ^ p,
-			     [ETuple [EConstr (EVar "x", constr "rw"), EVar "v"]],
-			     EApp (EVar ("Set.enum" ^ p),
-				   ETuple [EVar "x", EApp (EVar "m2i", EVar "v")]))
-		 end
-	   in
-	      str "local";
-	      VBox 4;
-	      nl (); str "open C.Dim C_Int";
-	      endBox ();
-	      nl (); str "in";
-	      VBox 4;
-	      nl (); str (estruct_export ^ " = struct");
-	      Box 4;
-	      nl (); str ("open " ^ (forceGenStruct (SUETstruct "E" tag)));
-	      if dodt then dt_mlrep () else int_mlrep ();
+         (estruct,
+          Promise.delay
+          (fn () =>
+           let
+              val (file, done) = 
+                 smlFileAndExport ("e-" ^ tag, estruct_export, true)
+              val {closePP, str, line, nl, sp, Box, VBox, endBox,
+                   pr_fdef, pr_vdef, pr_tdef, ...} =
+                 openPP (file, SOME src)
+              fun no_duplicate_values () = 
+                 let
+                    fun loop (l, s) =
+                       case l of
+                          [] => true
+                        | {name, spec} :: l =>
+                             if LIS.member (s, spec) 
+                                then (warn (concat ["enum ", descr,
+                                                    " has duplicate values;\
+                                                    \ using sing,\
+                                                    \ not generating constructors\n"]);
+                                      false)
+                                else loop (l, LIS.add (s, spec))
+                 in
+                    loop (spec, LIS.empty)
+                 end
+              val dodt = enum_cons andalso no_duplicate_values ()
+              fun dt_mlrep () = 
+                 let
+                    fun pcl () = 
+                       let
+                          fun loop (c, l) =
+                             case l of
+                                [] => ()
+                              | {name, spec} :: l =>
+                                   (str (c ^ enum_id name); nextround l)
+                          and nextround [] = ()
+                            | nextround l = (sp (); loop ("| ", l))
+                       in
+                          Box 2; nl ();
+                          loop ("  ", spec);
+                          endBox ()
+                       end
+                    fun pfl (fname, arg, res, fini: unit -> unit) = 
+                       let
+                          fun loop (pfx, l) =
+                             case l of 
+                                [] => ()
+                              | v :: l =>
+                                   (line (concat [pfx, " ", arg v, " => ", res v]);
+                                      loop ("  |", l))
+                       in
+                          line (concat ["fun ", fname, " x ="]);
+                          Box 4;
+                          line ("case x of");
+                          loop ("   ", spec);
+                          fini ();
+                          endBox ()
+                       end
+                    fun cstr {name, spec} = enum_id name
+                    fun vstr {name, spec} =
+                       LargeInt.toString spec ^ " : MLRep.Int.Signed.int"
+                 in
+                    line "datatype mlrep =";
+                    pcl ();
+                    pfl ("m2i", cstr, vstr, fn () => ());
+                    pfl ("i2m", vstr, cstr,
+                         fn () => line "  | _ => raise General.Domain")
+                 end
+              fun int_mlrep () = 
+                 let
+                    fun v {name, spec} =
+                       pr_vdef (enum_id name, EConstr (ELInt spec, Type "mlrep"))
+                    val mlx = EConstr (EVar "x", Type "mlrep")
+                    val ty = Type "MLRep.Int.Signed.int"
+                    val ix = EConstr (EVar "x", ty)
+                 in
+                    pr_tdef ("mlrep", ty);
+                    List.foreach (spec, v);
+                    pr_fdef ("m2i", [mlx], ix);
+                    pr_fdef ("i2m", [ix], mlx)
+                 end
+              fun getset p = 
+                 let
+                    fun constr c = Con ("enum_obj" ^ p, [Type "tag", Type c])
+                 in
+                    pr_fdef ("get" ^ p,
+                             [EConstr (EVar "x", constr "'c")],
+                             EApp (EVar "i2m",
+                                   EApp (EVar ("Get.enum" ^ p), EVar "x")));
+                    pr_fdef ("set" ^ p,
+                             [ETuple [EConstr (EVar "x", constr "rw"), EVar "v"]],
+                             EApp (EVar ("Set.enum" ^ p),
+                                   ETuple [EVar "x", EApp (EVar "m2i", EVar "v")]))
+                 end
+           in
+              str "local";
+              VBox 4;
+              nl (); str "open C.Dim C_Int";
+              endBox ();
+              nl (); str "in";
+              VBox 4;
+              nl (); str (estruct_export ^ " = struct");
+              Box 4;
+              nl (); str ("open " ^ (forceGenStruct (SUETstruct "E" tag)));
+              if dodt then dt_mlrep () else int_mlrep ();
 
-	      endBox ();
-	      nl (); str "end";
-	      endBox ();
-	      nl (); str "end"; nl ();
-	      closePP ();
-	      done ()
-	   end))
+              endBox ();
+              nl (); str "end";
+              endBox ();
+              nl (); str "end"; nl ();
+              closePP ();
+              done ()
+           end))
       end
    val () = fillGenStructTable' (SM.app, enums, pr_e_promise)
 
    fun do_mlbfile () = 
       let
-	 val file = descrFile mlbfile
-	 val () = File.remove file
-	 val {closePP, line, str, nl, VBox, endBox, ... } =
-	    openPP (file, NONE)
+         val file = descrFile mlbfile
+         val () = File.remove file
+         val {closePP, line, str, nl, VBox, endBox, ... } =
+            openPP (file, NONE)
       in
-	 line "local ann \"allowImport true\" in";
-	 VBox 4;
-	 app line ["$(SML_LIB)/basis/basis.mlb",
-		   "$(SML_LIB)/mlnlffi-lib/internals/c-int."^targetName^".mlb"];
-	 app line (rev extramembers);
-	 app line (rev (!files));
-	 endBox ();
-	 nl (); str "end in";
-	 VBox 4;
-	 app line (rev (!exports));
-	 endBox ();
-	 nl (); str "end"; nl ();
-	 closePP ()
+         line "local ann \"allowFFI true\" in";
+         VBox 4;
+         app line ["$(SML_LIB)/basis/basis.mlb",
+                   "$(SML_LIB)/mlnlffi-lib/internals/c-int.mlb"];
+         app line (rev extramembers);
+         app line (rev (!files));
+         endBox ();
+         nl (); str "end in";
+         VBox 4;
+         app line (rev (!exports));
+         endBox ();
+         nl (); str "end"; nl ();
+         closePP ()
       end
 in
    (HashSet.foreach (genStructTable, fn (_, promise) => Promise.force promise)
     ; do_mlbfile ())
    handle Promise.Force =>
       warn ("cyclic dependency: " ^
-	    (String.concatWith (!pending, " ")))
+            (String.concatWith (!pending, " ")))
 end
 
 end

Modified: mlton/branches/on-20050420-cmm-branch/mlnlffigen/hash.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlnlffigen/hash.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlnlffigen/hash.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -38,61 +38,61 @@
       | conConId S.RO = 1
 
     fun look (next, find, insert) tab k =
-	case find (!tab, k) of
-	    SOME i => i
-	  | NONE => let
-		val i = !next
-	    in
-		next := i + 1;
-		tab := insert (!tab, k, i);
-		i
-	    end
+        case find (!tab, k) of
+            SOME i => i
+          | NONE => let
+                val i = !next
+            in
+                next := i + 1;
+                tab := insert (!tab, k, i);
+                i
+            end
 
     fun mkFHasher () = let
-	val stab = ref SM.empty
-	val utab = ref SM.empty
-	val etab = ref SM.empty
-	val ltab = ref LM.empty
+        val stab = ref SM.empty
+        val utab = ref SM.empty
+        val etab = ref SM.empty
+        val ltab = ref LM.empty
 
-	val next = ref 13
+        val next = ref 13
 
-	val tlook = look (next, SM.find, SM.insert)
-	val llook = look (next, LM.find, LM.insert) ltab
+        val tlook = look (next, SM.find, SM.insert)
+        val llook = look (next, LM.find, LM.insert) ltab
 
-	fun hash (S.STRUCT t) = tlook stab t
-	  | hash (S.UNION t) = tlook utab t
-	  | hash (S.ENUM (t, _)) = tlook etab t
-	  | hash (S.FPTR x) = cfthash x
-	  | hash (S.PTR (c, ty)) = llook [1, conConId c, hash ty]
-	  | hash (S.ARR { t, d, esz }) = llook [2, hash t, d, esz]
-	  | hash (S.BASIC ty) = tyConId ty
-	  | hash (S.VOIDPTR) = 12
-	  | hash _ = raise Fail "hash"
+        fun hash (S.STRUCT t) = tlook stab t
+          | hash (S.UNION t) = tlook utab t
+          | hash (S.ENUM (t, _)) = tlook etab t
+          | hash (S.FPTR x) = cfthash x
+          | hash (S.PTR (c, ty)) = llook [1, conConId c, hash ty]
+          | hash (S.ARR { t, d, esz }) = llook [2, hash t, d, esz]
+          | hash (S.BASIC ty) = tyConId ty
+          | hash (S.VOIDPTR) = 12
+          | hash _ = raise Fail "hash"
 
-	and cfthash { args, res } = llook (0 :: opthash res :: map hash args)
+        and cfthash { args, res } = llook (0 :: opthash res :: map hash args)
 
-	and opthash NONE = 0
-	  | opthash (SOME ty) = 1 + hash ty
+        and opthash NONE = 0
+          | opthash (SOME ty) = 1 + hash ty
     in
-	cfthash
+        cfthash
     end
 
     fun mkTHasher () = let
-	val stab = ref SM.empty
-	val ltab = ref LM.empty
+        val stab = ref SM.empty
+        val ltab = ref LM.empty
 
-	val next = ref 0
+        val next = ref 0
 
-	val slook = look (next, SM.find, SM.insert) stab
-	val llook = look (next, LM.find, LM.insert) ltab
+        val slook = look (next, SM.find, SM.insert) stab
+        val llook = look (next, LM.find, LM.insert) ltab
 
-	fun hash (PP.ARROW (t, t')) = llook [0, hash t, hash t']
-	  | hash (PP.TUPLE tl) = llook (1 :: map hash tl)
-	  | hash (PP.CON (c, tl)) = llook (2 :: slook c :: map hash tl)
-	  | hash (PP.RECORD pl) = llook (3 :: map phash pl)
+        fun hash (PP.ARROW (t, t')) = llook [0, hash t, hash t']
+          | hash (PP.TUPLE tl) = llook (1 :: map hash tl)
+          | hash (PP.CON (c, tl)) = llook (2 :: slook c :: map hash tl)
+          | hash (PP.RECORD pl) = llook (3 :: map phash pl)
 
-	and phash (n, t) = llook [4, slook n, hash t]
+        and phash (n, t) = llook [4, slook n, hash t]
     in
-	hash
+        hash
     end
 end

Modified: mlton/branches/on-20050420-cmm-branch/mlnlffigen/main.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlnlffigen/main.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlnlffigen/main.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,15 +1,16 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 2005-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 structure Main : sig val main : unit -> unit end =
 struct
 
 structure RE =
    RegExpFn (structure P = AwkSyntax
-	     structure E = DfaEngine)
+             structure E = DfaEngine)
 
 fun makeOptions {usage} =
    let
@@ -17,97 +18,97 @@
    in
       List.map
       ([(Expert, "debug", " {false|true}", "",
-	 boolRef debug),
-	(Normal, "allSU", " {false|true}", 
-	 "generate ML definitions for all #include-d struct and union definitions",
-	 boolRef allSU),
-	(Normal, "collect", " {true|false}", 
-	 "collect enum constants from unnamed enumerateions",
-	 boolRef collect_enums),
-	(Normal, "cppopt", " <opt>",
-	 "pass option to preprocessor",
-	 SpaceString (fn s => List.push (cppopts, s))),
-	(Normal, "dir", " <dir>", 
-	 "output directory for generated files",
-	 SpaceString (fn s => dir := s)),
-	(Normal, "enum-constructors", " {false|true}",
-	 "when possible, make the ML representation type of enumerations a datatype",
-	 boolRef enum_cons),
-	(Normal, "gensym", " <string>", 
-	 "suffix for \"gensym-ed\" generated ML structure names",
-	 SpaceString (fn s => gensym := s)),
-	(Normal, "heavy", "",
-	 "suppress 'light' versions of function wrappers and field accessors",
-	 None (fn () => weight := {heavy = true, light = false})),
-	(Normal, "include", " <file>",
-	 "include file in the generated .mlb file",
-	 SpaceString (fn s => List.push (extramembers, s))),
-	(Normal, "libhandle", " <longid>",
-	 "Use the <longid> to refer to the handle to the shared library",
-	 SpaceString (fn s => libhandle := s)),
-	(Normal, "light", "",
-	 "suppress 'heavy' versions of function wrappers and field accessors",
-	 None (fn () => weight := {heavy = false, light = true})),
-	(Normal, "linkage", " {dynamic|static}", 
-	 "how to link C objects",
-	 SpaceString (fn s =>
-		      if s = "dynamic" 
-			 then linkage := Linkage.Dynamic
-		      else if s = "static"
-			 then linkage := Linkage.Static
-		      else usage (concat ["invalid -linkage arg: ", s]))),
-	(Normal, "match", " <re>", 
-	 "generate ML definitions for #include-d definitions matching <re>",
-	 SpaceString (fn re => 
-		      let 
-			 val regexp = 
-			    SOME (RE.compileString re)
-			    handle RegExpSyntax.CannotParse => NONE
-				 | RegExpSyntax.CannotCompile => NONE
-		      in
-			 case regexp of
-			    SOME regexp =>
-			       let
-				  val scanFn = RE.prefix regexp
-				  fun matchFn s =
-				     let
-					val n = String.length s
-					fun getc i =
-					   if (i < n) 
-					      then SOME (String.sub (s, i), i + 1)
-					      else NONE
-				     in
-					case scanFn getc 0 of
-					   NONE => false
-					 | SOME (x, k) => k = n
-				     end
-			       in
-				  match := matchFn
-			       end
-			  | NONE => usage (concat ["invalid -match arg: ", re])
-		      end)),
-	(Normal, "mlbfile", " <file>", 
-	 "name of the generated .mlb file",
-	 SpaceString (fn s => mlbfile := s)),
-	(Normal, "namedargs", " {false|true}",
-	 "generate function wrappers with named arguments",
-	 boolRef namedargs),
-	(Normal, "prefix", " <string>", 
-	 "prefix for generated ML structure names",
-	 SpaceString (fn s => prefix := s)),
-	(Normal, "target", " <arch>-<os>", 
-	 "platform that executable will run on",
-	 SpaceString (fn s => 
-		      (case Target.fromString s of
-			  NONE => 
-			     usage (concat ["invalid -target arg: ", s])
-			| SOME t => 
-			     (case Target.make t of
-				 NONE => usage (concat ["unsupported -target arg: ", s])
-			       | SOME z => target := SOME z)))),
-	(Normal, "width", " 75", 
-	 "output line width for pretty-printing",
-	 intRef width)],
+         boolRef debug),
+        (Normal, "allSU", " {false|true}", 
+         "generate ML definitions for all #include-d struct and union definitions",
+         boolRef allSU),
+        (Normal, "collect", " {true|false}", 
+         "collect enum constants from unnamed enumerateions",
+         boolRef collect_enums),
+        (Normal, "cppopt", " <opt>",
+         "pass option to preprocessor",
+         SpaceString (fn s => List.push (cppopts, s))),
+        (Normal, "dir", " <dir>", 
+         "output directory for generated files",
+         SpaceString (fn s => dir := s)),
+        (Normal, "enum-constructors", " {false|true}",
+         "when possible, make the ML representation type of enumerations a datatype",
+         boolRef enum_cons),
+        (Normal, "gensym", " <string>", 
+         "suffix for \"gensym-ed\" generated ML structure names",
+         SpaceString (fn s => gensym := s)),
+        (Normal, "heavy", "",
+         "suppress 'light' versions of function wrappers and field accessors",
+         None (fn () => weight := {heavy = true, light = false})),
+        (Normal, "include", " <file>",
+         "include file in the generated .mlb file",
+         SpaceString (fn s => List.push (extramembers, s))),
+        (Normal, "libhandle", " <longid>",
+         "Use the <longid> to refer to the handle to the shared library",
+         SpaceString (fn s => libhandle := s)),
+        (Normal, "light", "",
+         "suppress 'heavy' versions of function wrappers and field accessors",
+         None (fn () => weight := {heavy = false, light = true})),
+        (Normal, "linkage", " {dynamic|static}", 
+         "how to link C objects",
+         SpaceString (fn s =>
+                      if s = "dynamic" 
+                         then linkage := Linkage.Dynamic
+                      else if s = "static"
+                         then linkage := Linkage.Static
+                      else usage (concat ["invalid -linkage arg: ", s]))),
+        (Normal, "match", " <re>", 
+         "generate ML definitions for #include-d definitions matching <re>",
+         SpaceString (fn re => 
+                      let 
+                         val regexp = 
+                            SOME (RE.compileString re)
+                            handle RegExpSyntax.CannotParse => NONE
+                                 | RegExpSyntax.CannotCompile => NONE
+                      in
+                         case regexp of
+                            SOME regexp =>
+                               let
+                                  val scanFn = RE.prefix regexp
+                                  fun matchFn s =
+                                     let
+                                        val n = String.length s
+                                        fun getc i =
+                                           if (i < n) 
+                                              then SOME (String.sub (s, i), i + 1)
+                                              else NONE
+                                     in
+                                        case scanFn getc 0 of
+                                           NONE => false
+                                         | SOME (x, k) => k = n
+                                     end
+                               in
+                                  match := matchFn
+                               end
+                          | NONE => usage (concat ["invalid -match arg: ", re])
+                      end)),
+        (Normal, "mlbfile", " <file>", 
+         "name of the generated .mlb file",
+         SpaceString (fn s => mlbfile := s)),
+        (Normal, "namedargs", " {false|true}",
+         "generate function wrappers with named arguments",
+         boolRef namedargs),
+        (Normal, "prefix", " <string>", 
+         "prefix for generated ML structure names",
+         SpaceString (fn s => prefix := s)),
+        (Normal, "target", " <arch>-<os>", 
+         "platform that executable will run on",
+         SpaceString (fn s => 
+                      (case Target.fromString s of
+                          NONE => 
+                             usage (concat ["invalid -target arg: ", s])
+                        | SOME t => 
+                             (case Target.make t of
+                                 NONE => usage (concat ["unsupported -target arg: ", s])
+                               | SOME z => target := SOME z)))),
+        (Normal, "width", " 75", 
+         "output line width for pretty-printing",
+         intRef width)],
        fn (style, name, arg, desc, opt) =>
        {arg = arg, desc = desc, name = name, opt = opt, style = style})
    end
@@ -115,8 +116,8 @@
 val mainUsage = "mlnlffigen [option ...] C-file ..."
 val {parse, usage} =
    Popt.makeUsage {mainUsage = mainUsage,
-		   makeOptions = makeOptions,
-		   showExpert = fn () => !Control.debug}
+                   makeOptions = makeOptions,
+                   showExpert = fn () => !Control.debug}
 
 val die = Process.fail
    
@@ -124,13 +125,13 @@
    let
       val rest = parse args
       val () = if Option.isNone (!Control.target)
-		  then usage "no -target specified"
-		  else ()
+                  then usage "no -target specified"
+                  else ()
     in
        case rest of
-	  Result.No msg => usage msg
-	| Result.Yes [] => usage "no C-file(s)"
-	| Result.Yes cfiles => Gen.gen {cfiles = cfiles}
+          Result.No msg => usage msg
+        | Result.Yes [] => usage "no C-file(s)"
+        | Result.Yes cfiles => Gen.gen {cfiles = cfiles}
    end
 
 val main = Process.makeMain commandLine

Modified: mlton/branches/on-20050420-cmm-branch/mlnlffigen/mlnlffigen.mlb
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlnlffigen/mlnlffigen.mlb	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlnlffigen/mlnlffigen.mlb	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,5 +1,12 @@
+(* Copyright (C) 2005-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 local
-  sources.mlb
+   sources.mlb
 in
-  call-main.sml
+   call-main.sml
 end

Modified: mlton/branches/on-20050420-cmm-branch/mlnlffigen/pp.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlnlffigen/pp.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlnlffigen/pp.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -14,10 +14,10 @@
 structure PrettyPrint = struct
 
     structure PP = PPStreamFn (structure Token = StringToken
-			       structure Device = CPIFDev)
+                               structure Device = CPIFDev)
 
     datatype mltype =
-	ARROW of mltype * mltype
+        ARROW of mltype * mltype
       | TUPLE of mltype list
       | CON of string * mltype list
       | RECORD of (string * mltype) list
@@ -34,139 +34,139 @@
       | simplify (TUPLE [t]) = simplify t
       | simplify (CON (k, tl)) = 
         let
-	   fun doDefault () = CON (k, map simplify tl)
-	   fun doObj obj =
-	       case tl of
-		  [CON (k, tl), c] =>
-		     if List.exists (fn k' => k = k')
-			["schar","uchar","sshort","ushort",
-			 "sint","uint","slong","ulong",
-			 "slonglong","ulonglong","float","double",
-			 "voidptr"]
-			then CON (concat [k, "_", obj], [simplify c])
-		     else if k = "fptr"
-			then case tl of 
-			        [f] => CON ("fptr_" ^ obj, [simplify f, simplify c])
-			      | _ => doDefault ()
-		     else if k = "su"
-			 then case tl of
-			        [su] => CON ("su_" ^ obj, [simplify su, simplify c])
-			      | _ => doDefault ()
-		     else doDefault ()
-		| _ => doDefault ()
-	   fun doDim d =
-	       if d = "dim"
-		  then case tl of
-		          [n, CON (k', [])] => 
-			     if k' = "Dim.nonzero" orelse k' = "nonzero"
-				then CON ("dim", [simplify n])
-				else doDefault ()
-			| _ => doDefault ()
-	       else if d = "dec"
-		  then case tl of 
-		          [] => CON ("dec", [])
-			| _ => doDefault ()
-	       else if List.exists (fn d' => d = d')
-		       ["dg0","dg1","dg2","dg3","dg4",
-			"dg5","dg6","dg7","dg8","dg9"]
-		  then case tl of
-		          [n] => CON (d, [simplify n])
-			| _ => doDefault ()
-	       else doDefault ()
-	in
-	   if k = "obj" orelse k = "obj'"
-	      then doObj k
-	   else if String.isPrefix "Dim." k
-	      then doDim (String.extract(k,4,NONE))
-	   else doDefault ()
-	end
+           fun doDefault () = CON (k, map simplify tl)
+           fun doObj obj =
+               case tl of
+                  [CON (k, tl), c] =>
+                     if List.exists (fn k' => k = k')
+                        ["schar","uchar","sshort","ushort",
+                         "sint","uint","slong","ulong",
+                         "slonglong","ulonglong","float","double",
+                         "voidptr"]
+                        then CON (concat [k, "_", obj], [simplify c])
+                     else if k = "fptr"
+                        then case tl of 
+                                [f] => CON ("fptr_" ^ obj, [simplify f, simplify c])
+                              | _ => doDefault ()
+                     else if k = "su"
+                         then case tl of
+                                [su] => CON ("su_" ^ obj, [simplify su, simplify c])
+                              | _ => doDefault ()
+                     else doDefault ()
+                | _ => doDefault ()
+           fun doDim d =
+               if d = "dim"
+                  then case tl of
+                          [n, CON (k', [])] => 
+                             if k' = "Dim.nonzero" orelse k' = "nonzero"
+                                then CON ("dim", [simplify n])
+                                else doDefault ()
+                        | _ => doDefault ()
+               else if d = "dec"
+                  then case tl of 
+                          [] => CON ("dec", [])
+                        | _ => doDefault ()
+               else if List.exists (fn d' => d = d')
+                       ["dg0","dg1","dg2","dg3","dg4",
+                        "dg5","dg6","dg7","dg8","dg9"]
+                  then case tl of
+                          [n] => CON (d, [simplify n])
+                        | _ => doDefault ()
+               else doDefault ()
+        in
+           if k = "obj" orelse k = "obj'"
+              then doObj k
+           else if String.isPrefix "Dim." k
+              then doDim (String.extract(k,4,NONE))
+           else doDefault ()
+        end
       | simplify (ARROW (t1, t2)) = ARROW (simplify t1, simplify t2)
       | simplify (TUPLE tl) = TUPLE (map simplify tl)
       | simplify (RECORD ml) = RECORD (map (fn (n, t) => (n, simplify t)) ml)
 
     fun ppType0 s (t as ARROW _, c) =
-	let fun loop (ARROW (x, y)) =
-		(ppType0 s (x, C_ARROW); PP.string s " ->"; PP.space s 1;
-		 loop y)
-	      | loop t = ppType0 s (t, C_ARROW)
-	    val paren = not (c = C_COMMA)
-	    val indent = if paren then 5 else 4
-	in
-	    PP.openHOVBox s (PP.Rel indent);
-	    if paren then PP.string s "(" else ();
-	    loop t;
-	    if paren then PP.string s ")" else ();
-	    PP.closeBox s
-	end
+        let fun loop (ARROW (x, y)) =
+                (ppType0 s (x, C_ARROW); PP.string s " ->"; PP.space s 1;
+                 loop y)
+              | loop t = ppType0 s (t, C_ARROW)
+            val paren = not (c = C_COMMA)
+            val indent = if paren then 5 else 4
+        in
+            PP.openHOVBox s (PP.Rel indent);
+            if paren then PP.string s "(" else ();
+            loop t;
+            if paren then PP.string s ")" else ();
+            PP.closeBox s
+        end
       | ppType0 s (TUPLE [], _) = PP.string s "unit"
       | ppType0 s (TUPLE [t], c) = ppType0 s (t, c)
       | ppType0 s (TUPLE tl, c) = let
-	    fun loop [] = ()	(* cannot happen *)
-	      | loop [t] = ppType0 s (t, C_STAR)
-	      | loop (h :: tl) = (ppType0 s (h, C_STAR);
-				  PP.string s " *";
-				  PP.space s 1;
-				  loop tl)
-	    val paren =
-		case c of (C_STAR) => true
-	                | (C_CON) => true
-			| (C_ARROW) => false
-			| (C_COMMA) => false
-	    val indent = if paren then 1 else 0
-	in
-	    PP.openHVBox s (PP.Rel indent);
-	    if paren then PP.string s "(" else ();
-	    loop tl;
-	    if paren then PP.string s ")" else ();
-	    PP.closeBox s
-	end
+            fun loop [] = ()    (* cannot happen *)
+              | loop [t] = ppType0 s (t, C_STAR)
+              | loop (h :: tl) = (ppType0 s (h, C_STAR);
+                                  PP.string s " *";
+                                  PP.space s 1;
+                                  loop tl)
+            val paren =
+                case c of (C_STAR) => true
+                        | (C_CON) => true
+                        | (C_ARROW) => false
+                        | (C_COMMA) => false
+            val indent = if paren then 1 else 0
+        in
+            PP.openHVBox s (PP.Rel indent);
+            if paren then PP.string s "(" else ();
+            loop tl;
+            if paren then PP.string s ")" else ();
+            PP.closeBox s
+        end
       | ppType0 s (RECORD [], _) = PP.string s "{}"
       | ppType0 s (RECORD tl, _) = let
-	    fun loop [] = ()		(* cannot happen *)
-	      | loop [(n, t)] = (PP.string s (n ^ " : ");
-				 ppType0 s (t, C_COMMA))
-	      | loop ((n, t) :: tl) = (PP.string s (n ^ " : ");
-				       ppType0 s (t, C_COMMA);
-				       PP.string s ",";
-				       PP.space s 1;
-				       loop tl)
-	in
-	    PP.openHVBox s (PP.Rel 2);
-	    PP.string s "{ ";
-	    loop tl;
-	    PP.string s " }";
-	    PP.closeBox s
-	end
+            fun loop [] = ()            (* cannot happen *)
+              | loop [(n, t)] = (PP.string s (n ^ " : ");
+                                 ppType0 s (t, C_COMMA))
+              | loop ((n, t) :: tl) = (PP.string s (n ^ " : ");
+                                       ppType0 s (t, C_COMMA);
+                                       PP.string s ",";
+                                       PP.space s 1;
+                                       loop tl)
+        in
+            PP.openHVBox s (PP.Rel 2);
+            PP.string s "{ ";
+            loop tl;
+            PP.string s " }";
+            PP.closeBox s
+        end
       | ppType0 s (CON (k, []), _) = PP.string s k
       | ppType0 s (CON (k, [t]), _) =
-	(PP.openHBox s;
-	 ppType0 s (t, C_CON);
-	 PP.space s 1;
-	 PP.string s k;
-	 PP.closeBox s)
+        (PP.openHBox s;
+         ppType0 s (t, C_CON);
+         PP.space s 1;
+         PP.string s k;
+         PP.closeBox s)
       | ppType0 s (CON (k, tl), _) = let
-	    fun loop [] = ()	(* cannot happen *)
-	      | loop [t] = ppType0 s (t, C_COMMA)
-	      | loop (h :: tl) =
-		(ppType0 s (h, C_COMMA); PP.string s ","; PP.space s 1; loop tl)
-	in
-	    PP.openHBox s;
-	    PP.openHVBox s (PP.Rel 1);
-	    PP.string s "(";
-	    loop tl;
-	    PP.string s ")";
-	    PP.closeBox s;
-	    PP.space s 1;
-	    PP.string s k;
-	    PP.closeBox s
-	end
+            fun loop [] = ()    (* cannot happen *)
+              | loop [t] = ppType0 s (t, C_COMMA)
+              | loop (h :: tl) =
+                (ppType0 s (h, C_COMMA); PP.string s ","; PP.space s 1; loop tl)
+        in
+            PP.openHBox s;
+            PP.openHVBox s (PP.Rel 1);
+            PP.string s "(";
+            loop tl;
+            PP.string s ")";
+            PP.closeBox s;
+            PP.space s 1;
+            PP.string s k;
+            PP.closeBox s
+        end
 
     (* start with comma context *)
     fun ppType s t = ppType0 s (simplify t, C_COMMA)
     fun ppType' s (t, c) = ppType0 s (simplify t, c)
 
     datatype mlexp =
-	ETUPLE of mlexp list
+        ETUPLE of mlexp list
       | ERECORD of (string * mlexp) list
       | EVAR of string
       | EAPP of mlexp * mlexp
@@ -180,137 +180,137 @@
     fun ppExp0 s (ETUPLE [], _) = PP.string s "()"
       | ppExp0 s (ETUPLE [x], c) = ppExp0 s (x, c)
       | ppExp0 s (ETUPLE xl, _) = let
-	    fun loop [] = ()
-	      | loop [x] = ppExp0 s (x, EC_COMMA)
-	      | loop (x :: xl) =
-		(ppExp0 s (x, EC_COMMA); PP.string s ","; PP.space s 1;
-		 loop xl)
-	in
-	    PP.openHVBox s (PP.Rel 1);
-	    PP.string s "(";
-	    loop xl;
-	    PP.string s ")";
-	    PP.closeBox s
-	end
+            fun loop [] = ()
+              | loop [x] = ppExp0 s (x, EC_COMMA)
+              | loop (x :: xl) =
+                (ppExp0 s (x, EC_COMMA); PP.string s ","; PP.space s 1;
+                 loop xl)
+        in
+            PP.openHVBox s (PP.Rel 1);
+            PP.string s "(";
+            loop xl;
+            PP.string s ")";
+            PP.closeBox s
+        end
       | ppExp0 s (ERECORD [], _) = PP.string s "{}"
       | ppExp0 s (ERECORD xl, _) = let
-	    fun loop [] = ()
-	      | loop [(n, x)] = (PP.string s (n ^ " =");
-				 PP.space s 1;
-				 ppExp0 s (x, EC_COMMA))
-	      | loop ((n, x) :: xl) = (PP.string s (n ^ " =");
-				       PP.space s 1;
-				       ppExp0 s (x, EC_COMMA);
-				       PP.string s ",";
-				       PP.space s 1;
-				       loop xl)
-	in
-	    PP.openHVBox s (PP.Rel 2);
-	    PP.string s "{ ";
-	    loop xl;
-	    PP.string s " }";
-	    PP.closeBox s
-	end
+            fun loop [] = ()
+              | loop [(n, x)] = (PP.string s (n ^ " =");
+                                 PP.space s 1;
+                                 ppExp0 s (x, EC_COMMA))
+              | loop ((n, x) :: xl) = (PP.string s (n ^ " =");
+                                       PP.space s 1;
+                                       ppExp0 s (x, EC_COMMA);
+                                       PP.string s ",";
+                                       PP.space s 1;
+                                       loop xl)
+        in
+            PP.openHVBox s (PP.Rel 2);
+            PP.string s "{ ";
+            loop xl;
+            PP.string s " }";
+            PP.closeBox s
+        end
       | ppExp0 s (EVAR v, _) = PP.string s v
       | ppExp0 s (EAPP (x, y), c) = let
-	    fun loop (EAPP (x, y)) =
-		(loop x; ppExp0 s (y, EC_APP); PP.space s 1)
-	      | loop x = (ppExp0 s (x, EC_APP);
-			  PP.space s 1;
-			  PP.openHOVBox s (PP.Rel 0))
-	    val paren = c = EC_APP
-	in
-	    PP.openHOVBox s (PP.Abs 4);
-	    if paren then PP.string s "(" else ();
-	    loop x;
-	    ppExp0 s (y, EC_APP);
-	    if paren then PP.string s ")" else ();
-	    PP.closeBox s;
-	    PP.closeBox s
-	end
+            fun loop (EAPP (x, y)) =
+                (loop x; ppExp0 s (y, EC_APP); PP.space s 1)
+              | loop x = (ppExp0 s (x, EC_APP);
+                          PP.space s 1;
+                          PP.openHOVBox s (PP.Rel 0))
+            val paren = c = EC_APP
+        in
+            PP.openHOVBox s (PP.Abs 4);
+            if paren then PP.string s "(" else ();
+            loop x;
+            ppExp0 s (y, EC_APP);
+            if paren then PP.string s ")" else ();
+            PP.closeBox s;
+            PP.closeBox s
+        end
       | ppExp0 s (ECONSTR (x, t), c) = let
-	    val paren = c = EC_APP
-	    val indent = if paren then 5 else 4
-	    val tc = if paren then C_CON else C_COMMA
-	in
-	    PP.openHOVBox s (PP.Rel indent);
-	    if paren then PP.string s "(" else ();
-	    ppExp0 s (x, c);
-	    PP.nbSpace s 1;
-	    PP.string s ":";
-	    PP.space s 1;
-	    ppType' s (t, tc);
-	    if paren then PP.string s ")" else  ();
-	    PP.closeBox s
-	end
+            val paren = c = EC_APP
+            val indent = if paren then 5 else 4
+            val tc = if paren then C_CON else C_COMMA
+        in
+            PP.openHOVBox s (PP.Rel indent);
+            if paren then PP.string s "(" else ();
+            ppExp0 s (x, c);
+            PP.nbSpace s 1;
+            PP.string s ":";
+            PP.space s 1;
+            ppType' s (t, tc);
+            if paren then PP.string s ")" else  ();
+            PP.closeBox s
+        end
       | ppExp0 s (ESEQ (x, y), c) = let
-	in
-	    PP.string s "(";
-	    PP.openHVBox s (PP.Rel 0);
-	    ppExp0 s (x, EC_COMMA);
-	    PP.string s ";";
-	    PP.space s 1;
-	    ppExp0 s (y, EC_COMMA);
-	    PP.string s ")";
-	    PP.closeBox s
-	end
+        in
+            PP.string s "(";
+            PP.openHVBox s (PP.Rel 0);
+            ppExp0 s (x, EC_COMMA);
+            PP.string s ";";
+            PP.space s 1;
+            ppExp0 s (y, EC_COMMA);
+            PP.string s ")";
+            PP.closeBox s
+        end
       | ppExp0 s (EPRIM (p, t), c) = let
-	    val paren = c = EC_APP
-	    val indent = if paren then 5 else 4
-	    val tc = if paren then C_CON else C_COMMA
-	in
-	    PP.openHOVBox s (PP.Rel indent);
-	    if paren then PP.string s "(" else ();
-	    PP.string s p;
-	    PP.nbSpace s 1;
-	    PP.string s ":";
-	    PP.space s 1;
-	    ppType' s (t, tc);
-	    PP.string s ";";
-	    if paren then PP.string s ")" else  ();
-	    PP.closeBox s
-	end
+            val paren = c = EC_APP
+            val indent = if paren then 5 else 4
+            val tc = if paren then C_CON else C_COMMA
+        in
+            PP.openHOVBox s (PP.Rel indent);
+            if paren then PP.string s "(" else ();
+            PP.string s p;
+            PP.nbSpace s 1;
+            PP.string s ":";
+            PP.space s 1;
+            ppType' s (t, tc);
+            PP.string s ";";
+            if paren then PP.string s ")" else  ();
+            PP.closeBox s
+        end
      | ppExp0 s (ELET ([], e), c) = ppExp0 s (e, c)
      | ppExp0 s (ELET (bnds, e), c) = let
-	   fun loop [] = ()
-	     | loop ((v, e) :: bnds) = (PP.newline s;
-					PP.openHOVBox s (PP.Abs 4);
-					PP.string s "val";
-					PP.nbSpace s 1;
-					PP.string s v;
-					PP.nbSpace s 1;
-					PP.string s "=";
-					PP.space s 1;
-					ppExp0 s (e, EC_COMMA);
-					PP.closeBox s;
-					loop bnds)
+           fun loop [] = ()
+             | loop ((v, e) :: bnds) = (PP.newline s;
+                                        PP.openHOVBox s (PP.Abs 4);
+                                        PP.string s "val";
+                                        PP.nbSpace s 1;
+                                        PP.string s v;
+                                        PP.nbSpace s 1;
+                                        PP.string s "=";
+                                        PP.space s 1;
+                                        ppExp0 s (e, EC_COMMA);
+                                        PP.closeBox s;
+                                        loop bnds)
        in
-	   PP.string s "let";
-	   PP.openVBox s (PP.Abs 4);
-	   loop bnds;
-	   PP.closeBox s;
-	   PP.newline s;
-	   PP.string s "in";
-	   PP.openVBox s (PP.Abs 4);
-	   PP.newline s;
-	   ppExp0 s (e, EC_COMMA);
-	   PP.closeBox s;
-	   PP.newline s;
-	   PP.string s "end"
+           PP.string s "let";
+           PP.openVBox s (PP.Abs 4);
+           loop bnds;
+           PP.closeBox s;
+           PP.newline s;
+           PP.string s "in";
+           PP.openVBox s (PP.Abs 4);
+           PP.newline s;
+           ppExp0 s (e, EC_COMMA);
+           PP.closeBox s;
+           PP.newline s;
+           PP.string s "end"
        end
 
     fun ppExp s x = ppExp0 s (x, EC_COMMA)
     fun ppExp' s x = ppExp0 s (x, EC_APP)
 
     fun ppFun s (name, args, body) =
-	(PP.openHOVBox s (PP.Rel 4);
-	 PP.string s ("fun " ^ name);
-	 PP.nbSpace s 1;
-	 app (fn a => (ppExp' s a; PP.space s 1)) args;
-	 PP.string s "=";
-	 PP.nbSpace s 1;
-	 PP.openBox s (PP.Rel 0);
-	 ppExp s body;
-	 PP.closeBox s;
-	 PP.closeBox s)
+        (PP.openHOVBox s (PP.Rel 4);
+         PP.string s ("fun " ^ name);
+         PP.nbSpace s 1;
+         app (fn a => (ppExp' s a; PP.space s 1)) args;
+         PP.string s "=";
+         PP.nbSpace s 1;
+         PP.openBox s (PP.Rel 0);
+         ppExp s body;
+         PP.closeBox s;
+         PP.closeBox s)
 end

Modified: mlton/branches/on-20050420-cmm-branch/mlnlffigen/sizes.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlnlffigen/sizes.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlnlffigen/sizes.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,17 +1,17 @@
 structure Sizes =
    struct
       type t =
-	  {char: {bits: int, align: int},
-	  short: {bits: int, align: int},
-	  int: {bits: int, align: int},
-	  long: {bits: int, align: int},
-	  longlong: {bits: int, align: int},
-	  float: {bits: int, align: int},
-	  double: {bits: int, align: int},
-	  longdouble: {bits: int, align: int},
-	  pointer: {bits: int, align: int},
-	  min_struct: {bits: int, align: int},
-	  min_union: {bits: int, align: int},
-	  onlyPackBitFields: bool,
-	  ignoreUnnamedBitFieldAlignment: bool}
+          {char: {bits: int, align: int},
+          short: {bits: int, align: int},
+          int: {bits: int, align: int},
+          long: {bits: int, align: int},
+          longlong: {bits: int, align: int},
+          float: {bits: int, align: int},
+          double: {bits: int, align: int},
+          longdouble: {bits: int, align: int},
+          pointer: {bits: int, align: int},
+          min_struct: {bits: int, align: int},
+          min_union: {bits: int, align: int},
+          onlyPackBitFields: bool,
+          ignoreUnnamedBitFieldAlignment: bool}
    end
\ No newline at end of file

Modified: mlton/branches/on-20050420-cmm-branch/mlnlffigen/sources.mlb
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlnlffigen/sources.mlb	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlnlffigen/sources.mlb	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,52 +1,59 @@
+(* Copyright (C) 2005-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 local
-  basis basis_lib = bas $(SML_LIB)/basis/basis.mlb end
-  basis mlton_lib = bas ../lib/mlton/sources.mlb end
-  basis smlnj_lib = bas $(SMLNJ_LIB)/Util/smlnj-lib.mlb end
-  basis pp_lib = bas $(SMLNJ_LIB)/PP/pp-lib.mlb end
-  basis regexp_lib = bas $(SMLNJ_LIB)/RegExp/regexp-lib.mlb end
-  basis ckit_lib = bas $(CKIT_LIB)/ckit-lib.mlb end
+   basis basis_lib = bas $(SML_LIB)/basis/basis.mlb end
+   basis mlton_lib = bas ../lib/mlton/sources.mlb end
+   basis smlnj_lib = bas $(SML_LIB)/smlnj-lib/Util/smlnj-lib.mlb end
+   basis pp_lib = bas $(SML_LIB)/smlnj-lib/PP/pp-lib.mlb end
+   basis regexp_lib = bas $(SML_LIB)/smlnj-lib/RegExp/regexp-lib.mlb end
+   basis ckit_lib = bas $(SML_LIB)/ckit-lib/src/ckit-lib.mlb end
 
-  local open basis_lib in
-    endian.sml
-    endian-big.sml
-    endian-little.sml
-    sizes-ppc.sml
-    sizes-sparc.sml
-    sizes-x86.sml
-  end
-  local open basis_lib pp_lib in
-    cpif-dev.sml
-    pp.sml
-  end
-  local open mlton_lib ckit_lib in
-    control.sig
-    control.sml
-  end
-  local open basis_lib in
-    spec.sml
-  end 
-  local 
-    open basis_lib smlnj_lib 
-    sets-and-maps.sml
-  in
-    structure IntListMap
-    structure IntMap = IntRedBlackMap
-    structure LargeIntSet
-    structure StringMap
-    structure StringSet
-  end
-  local open basis_lib ckit_lib in
-    ast-to-spec.sml
-    hash.sml
-  end
-  local open mlton_lib ckit_lib in
-    gen.sml
-  end
-  
-  local open mlton_lib regexp_lib in
-    main.sml
-  end
+   local open basis_lib in
+      endian.sml
+      endian-big.sml
+      endian-little.sml
+      sizes-ppc.sml
+      sizes-sparc.sml
+      sizes-x86.sml
+   end
+   local open basis_lib pp_lib in
+      cpif-dev.sml
+      pp.sml
+   end
+   local open mlton_lib ckit_lib in
+      control.sig
+      control.sml
+   end
+   local open basis_lib in
+      spec.sml
+   end 
+   local 
+      open basis_lib smlnj_lib 
+      sets-and-maps.sml
+   in
+      structure IntListMap
+      structure IntMap = IntRedBlackMap
+      structure LargeIntSet
+      structure StringMap
+      structure StringSet
+   end
+   local open basis_lib ckit_lib in
+      ast-to-spec.sml
+      hash.sml
+   end
+   local open mlton_lib ckit_lib in
+      gen.sml
+   end
+   
+   local open mlton_lib regexp_lib in
+      main.sml
+   end
 in
-  structure Main
+   structure Main
 end
 

Modified: mlton/branches/on-20050420-cmm-branch/mlnlffigen/spec.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlnlffigen/spec.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlnlffigen/spec.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -17,7 +17,7 @@
     type tag = string
 
     datatype basic_ctype =
-	SCHAR | UCHAR 
+        SCHAR | UCHAR 
       | SSHORT | USHORT 
       | SINT | UINT 
       | SLONG | ULONG
@@ -40,75 +40,75 @@
     and cobj = constness * ctype
 
     datatype fieldspec =
-	OFIELD of { offset: int, spec: cobj, synthetic: bool }
+        OFIELD of { offset: int, spec: cobj, synthetic: bool }
       | SBF of { offset: int, constness: constness, bits: word, shift: word }
       | UBF of { offset: int, constness: constness, bits: word, shift: word }
 
     type field = { name: string, spec: fieldspec }
 
     type s =
-	 { src: string,
-	   tag: tag, 
-	   anon: bool, 
-	   size: word, 
-	   fields: field list,
-	   exclude: bool }
+         { src: string,
+           tag: tag, 
+           anon: bool, 
+           size: word, 
+           fields: field list,
+           exclude: bool }
     type u =
-	 { src: string,
-	   tag: tag, 
-	   anon: bool, 
-	   size: word, 
-	   all: field list,
-	   exclude: bool }
+         { src: string,
+           tag: tag, 
+           anon: bool, 
+           size: word, 
+           all: field list,
+           exclude: bool }
 
     type gty = { src: string, name: string, spec: ctype }
 
     type gvar = { src: string, name: string, spec: cobj }
 
     type gfun = { src: string,
-		  name: string, 
-		  spec: cft, 
-		  argnames: string list option }
+                  name: string, 
+                  spec: cft, 
+                  argnames: string list option }
 
     type enumval = { name: string, spec: LargeInt.int }
 
     type enum = { src: string,
-		  tag: tag, 
-		  anon: bool, 
-		  descr: string, 
-		  spec: enumval list,
-		  exclude: bool }
+                  tag: tag, 
+                  anon: bool, 
+                  descr: string, 
+                  spec: enumval list,
+                  exclude: bool }
 
     type spec = { structs: s list,
-		  unions: u list,
-		  gtys: gty list,
-		  gvars: gvar list,
-		  gfuns: gfun list,
-		  enums: enum list }
+                  unions: u list,
+                  gtys: gty list,
+                  gvars: gvar list,
+                  gfuns: gfun list,
+                  enums: enum list }
 
     fun join (x: spec, y: spec) = let
-	fun uniq sel = let
-	    fun loop ([], a) = rev a
-	      | loop (h :: t, a) =
-		loop (t, if List.exists
-				(fn x => (sel x : string) = sel h) a then a
-			 else h :: a)
-	in
-	    loop
-	end
+        fun uniq sel = let
+            fun loop ([], a) = rev a
+              | loop (h :: t, a) =
+                loop (t, if List.exists
+                                (fn x => (sel x : string) = sel h) a then a
+                         else h :: a)
+        in
+            loop
+        end
     in
-	{ structs = uniq #tag (#structs x, #structs y),
-	  unions = uniq #tag (#unions x, #unions y),
-	  gtys = uniq #name (#gtys x, #gtys y),
-	  gvars = uniq #name (#gvars x, #gvars y),
-	  gfuns = uniq #name (#gfuns x, #gfuns y),
-	  enums = uniq #tag (#enums x, #enums y) } : spec
+        { structs = uniq #tag (#structs x, #structs y),
+          unions = uniq #tag (#unions x, #unions y),
+          gtys = uniq #name (#gtys x, #gtys y),
+          gvars = uniq #name (#gvars x, #gvars y),
+          gfuns = uniq #name (#gfuns x, #gfuns y),
+          enums = uniq #tag (#enums x, #enums y) } : spec
     end
 
     val empty : spec = { structs = [], 
-			 unions = [], 
-			 gtys = [], 
-			 gvars = [],
-			 gfuns = [], 
-			 enums = [] }
+                         unions = [], 
+                         gtys = [], 
+                         gvars = [],
+                         gfuns = [], 
+                         enums = [] }
 end


Property changes on: mlton/branches/on-20050420-cmm-branch/mlprof
___________________________________________________________________
Name: svn:ignore
   - *.call-graph.dot
*.ssa
mlprof
mlprof.sml
   + *.call-graph.dot
*.ssa
mlprof
mlprof.sml


Deleted: mlton/branches/on-20050420-cmm-branch/mlprof/.cvsignore
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlprof/.cvsignore	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlprof/.cvsignore	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,4 +0,0 @@
-*.call-graph.dot
-*.ssa
-mlprof
-mlprof.sml

Copied: mlton/branches/on-20050420-cmm-branch/mlprof/.ignore (from rev 4358, mlton/trunk/mlprof/.ignore)

Modified: mlton/branches/on-20050420-cmm-branch/mlprof/Makefile
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlprof/Makefile	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlprof/Makefile	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,11 @@
+## Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ #    Jagannathan, and Stephen Weeks.
+ # Copyright (C) 1997-2000 NEC Research Institute.
+ #
+ # MLton is released under a BSD-style license.
+ # See the file MLton-LICENSE for details.
+ ##
+
 SRC = $(shell cd .. && pwd)
 BUILD = $(SRC)/build
 BIN = $(BUILD)/bin
@@ -4,7 +12,7 @@
 LIB = $(BUILD)/lib
 MLTON = mlton
 TARGET = self
-FLAGS = -target $(TARGET) -default-ann 'sequenceUnit true' -default-ann 'warnUnused true'
+FLAGS = -target $(TARGET) -default-ann 'sequenceNonUnit warn' -default-ann 'warnUnused true'
 NAME = mlprof
 PATH = $(BIN):$(shell echo $$PATH)
 
@@ -13,7 +21,6 @@
 $(NAME): $(NAME).mlb $(shell PATH=$(BIN):$$PATH && $(MLTON) -stop f $(NAME).mlb)
 	@echo 'Compiling $(NAME)'
 	$(MLTON) $(FLAGS) $(NAME).mlb
-	size $(NAME)
 
 $(NAME).sml: $(NAME).cm $(shell $(MLTON) -stop f $(NAME).cm)
 	mlton -stop sml $(NAME).cm

Modified: mlton/branches/on-20050420-cmm-branch/mlprof/call-main.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlprof/call-main.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlprof/call-main.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,8 +1,9 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 val _ = Main.main()

Modified: mlton/branches/on-20050420-cmm-branch/mlprof/main.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlprof/main.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlprof/main.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 structure Main : sig val main : unit -> unit end =
 struct
 
@@ -26,50 +27,50 @@
 structure Source =
    struct
       datatype t =
-	 NamePos of {name: string,
-		     pos: string}
+         NamePos of {name: string,
+                     pos: string}
        | Simple of string
 
       fun toString n =
-	 case n of
-	    NamePos {name, pos} => concat [name, "  ", pos]
-	  | Simple s => s
+         case n of
+            NamePos {name, pos} => concat [name, "  ", pos]
+          | Simple s => s
 
       fun toStringMaybeLine n =
-	 case n of
-	    NamePos {name, pos} =>
-	       if !showLine
-		  then concat [name, "  ", pos]
-	       else name
-	  | Simple s => s
+         case n of
+            NamePos {name, pos} =>
+               if !showLine
+                  then concat [name, "  ", pos]
+               else name
+          | Simple s => s
 
       val layout = Layout.str o toString
 
       fun fromString s =
-	 case String.tokens (s, fn c => Char.equals (c, #"\t")) of
-	    [s] => Simple s
-	  | [name, pos] =>
-	       let
-		  val name =
-		     if !longName
-			then name
-		     else
-			List.last
-			(String.tokens (name, fn c => Char.equals (c, #".")))
-	       in
-		  NamePos {name = name, pos = pos}
-	       end
-	  | _ => Error.bug "strange source"
+         case String.tokens (s, fn c => Char.equals (c, #"\t")) of
+            [s] => Simple s
+          | [name, pos] =>
+               let
+                  val name =
+                     if !longName
+                        then name
+                     else
+                        List.last
+                        (String.tokens (name, fn c => Char.equals (c, #".")))
+               in
+                  NamePos {name = name, pos = pos}
+               end
+          | _ => Error.bug "strange source"
 
       fun toDotLabel s =
-	 case s of
-	    NamePos {name, pos} =>
-	       if !showLine
-		  then [(name, Dot.Center),
-			(pos, Dot.Center)]
-	       else [(name, Dot.Center)]
-	  | Simple s =>
-	       [(s, Dot.Center)]
+         case s of
+            NamePos {name, pos} =>
+               if !showLine
+                  then [(name, Dot.Center),
+                        (pos, Dot.Center)]
+               else [(name, Dot.Center)]
+          | Simple s =>
+               [(s, Dot.Center)]
    end
 
 structure Graph = DirectedGraph
@@ -89,107 +90,107 @@
 structure AFile =
    struct
       datatype t = T of {callGraph: unit Graph.t,
-			 magic: word,
-			 master: {isSplit: bool,
-				  source: Source.t} vector,
-			 name: string,
-			 split: {masterIndex: int,
-				 node: unit Node.t} vector}
+                         magic: word,
+                         master: {isSplit: bool,
+                                  source: Source.t} vector,
+                         name: string,
+                         split: {masterIndex: int,
+                                 node: unit Node.t} vector}
 
       fun layout (T {magic, name, master, ...}) =
-	 Layout.record
-	 [("name", String.layout name),
-	  ("magic", Word.layout magic),
-	  ("master",
-	   Vector.layout (fn {isSplit, source} =>
-			  Layout.record [("isSplit", Bool.layout isSplit),
-					 ("source", Source.layout source)])
-	   master)]
+         Layout.record
+         [("name", String.layout name),
+          ("magic", Word.layout magic),
+          ("master",
+           Vector.layout (fn {isSplit, source} =>
+                          Layout.record [("isSplit", Bool.layout isSplit),
+                                         ("source", Source.layout source)])
+           master)]
 
       fun new {afile: File.t}: t =
-	 if not (File.doesExist afile)
-	    then Error.bug "does not exist"
-	 else if not (File.canRun afile)
-	    then Error.bug "can not run"
-	 else
-	    Process.callWithIn
-	    (OS.Path.mkAbsolute {path = afile,
-				 relativeTo = OS.FileSys.getDir ()},
-	     ["@MLton", "show-prof"],
-	     fn ins =>
-	     let
-		fun line () =
-		   case In.inputLine ins of
-		      NONE => Error.bug "unexpected end of show-prof data"
-		    | SOME l => l
-		val magic = valOf (Word.fromString (line ()))
-		fun vector (f: string -> 'a): 'a vector =
-		   Vector.tabulate (valOf (Int.fromString (line ())),
-				    fn _ => f (line ()))
-		val rc = Regexp.compileNFA (!splitReg)
-		val master =
-		   vector
-		   (fn s =>
-		    let
-		       val source = Source.fromString (String.dropSuffix (s, 1))
-		       val isSplit =
-			  Regexp.Compiled.matchesPrefix
-			  (rc, Source.toString source)
-		    in
-		       {isSplit = isSplit,
-			source = source}
-		    end)
-		val _ =
-		   if 0 = Vector.length master
-		      then
-			 Error.bug "doesn't appear to be compiled for profiling"
-		   else ()
-		val sources =
-		   vector
-		   (fn s =>
-		    case String.tokens (s, Char.isSpace) of
-		       [masterIndex, successorsIndex] =>
-			  {masterIndex = valOf (Int.fromString masterIndex),
-			   successorsIndex = valOf (Int.fromString
-						    successorsIndex)}
-		     | _ => Error.bug "AFile.new")
-		val sourceSeqs =
-		   vector
-		   (fn s =>
-		    Vector.fromListMap
-		    (String.tokens (s, Char.isSpace), fn s =>
-		     valOf (Int.fromString s)))
-		val graph = Graph.new ()
-		val split =
-		   Vector.map
-		   (sources, fn {masterIndex, ...} =>
-		    let
-		       val n = Graph.newNode graph
-		    in
-		       {masterIndex = masterIndex,
-			node = n}
-		    end)
-		val _ =
-		   Vector.foreach2
-		   (sources, split,
-		    fn ({successorsIndex, ...}, {node = from, ...}) =>
-		    Vector.foreach
-		    (Vector.sub (sourceSeqs, successorsIndex),
-		     fn to =>
-		     (ignore o Graph.addEdge)
-		     (graph, {from = from,
-			      to = #node (Vector.sub (split, to))})))
-		val _ =
-		   case In.inputLine ins of
-		      NONE => ()
-		    | SOME _ => Error.bug "expected end of file"
-	     in
-		T {callGraph = graph,
-		   magic = magic,
-		   master = master,
-		   name = afile,
-		   split = split}
-	     end)
+         if not (File.doesExist afile)
+            then Error.bug "does not exist"
+         else if not (File.canRun afile)
+            then Error.bug "can not run"
+         else
+            Process.callWithIn
+            (OS.Path.mkAbsolute {path = afile,
+                                 relativeTo = OS.FileSys.getDir ()},
+             ["@MLton", "show-prof"],
+             fn ins =>
+             let
+                fun line () =
+                   case In.inputLine ins of
+                      NONE => Error.bug "unexpected end of show-prof data"
+                    | SOME l => l
+                val magic = valOf (Word.fromString (line ()))
+                fun vector (f: string -> 'a): 'a vector =
+                   Vector.tabulate (valOf (Int.fromString (line ())),
+                                    fn _ => f (line ()))
+                val rc = Regexp.compileNFA (!splitReg)
+                val master =
+                   vector
+                   (fn s =>
+                    let
+                       val source = Source.fromString (String.dropSuffix (s, 1))
+                       val isSplit =
+                          Regexp.Compiled.matchesPrefix
+                          (rc, Source.toString source)
+                    in
+                       {isSplit = isSplit,
+                        source = source}
+                    end)
+                val _ =
+                   if 0 = Vector.length master
+                      then
+                         Error.bug "doesn't appear to be compiled for profiling"
+                   else ()
+                val sources =
+                   vector
+                   (fn s =>
+                    case String.tokens (s, Char.isSpace) of
+                       [masterIndex, successorsIndex] =>
+                          {masterIndex = valOf (Int.fromString masterIndex),
+                           successorsIndex = valOf (Int.fromString
+                                                    successorsIndex)}
+                     | _ => Error.bug "AFile.new")
+                val sourceSeqs =
+                   vector
+                   (fn s =>
+                    Vector.fromListMap
+                    (String.tokens (s, Char.isSpace), fn s =>
+                     valOf (Int.fromString s)))
+                val graph = Graph.new ()
+                val split =
+                   Vector.map
+                   (sources, fn {masterIndex, ...} =>
+                    let
+                       val n = Graph.newNode graph
+                    in
+                       {masterIndex = masterIndex,
+                        node = n}
+                    end)
+                val _ =
+                   Vector.foreach2
+                   (sources, split,
+                    fn ({successorsIndex, ...}, {node = from, ...}) =>
+                    Vector.foreach
+                    (Vector.sub (sourceSeqs, successorsIndex),
+                     fn to =>
+                     (ignore o Graph.addEdge)
+                     (graph, {from = from,
+                              to = #node (Vector.sub (split, to))})))
+                val _ =
+                   case In.inputLine ins of
+                      NONE => ()
+                    | SOME _ => Error.bug "expected end of file"
+             in
+                T {callGraph = graph,
+                   magic = magic,
+                   master = master,
+                   name = afile,
+                   split = split}
+             end)
    end
 
 structure Kind =
@@ -197,22 +198,22 @@
       datatype t = Alloc | Count | Empty | Time
 
       val toString =
-	 fn Alloc => "Alloc"
-	  | Count => "Count"
-	  | Empty => "Empty"
-	  | Time => "Time"
+         fn Alloc => "Alloc"
+          | Count => "Count"
+          | Empty => "Empty"
+          | Time => "Time"
 
       val layout = Layout.str o toString
 
       val merge: t * t -> t =
-	 fn (k, k') =>
-	 case (k, k') of
-	    (Alloc, Alloc) => Alloc
-	  | (Count, Count) => Count
-	  | (_, Empty) => k
-	  | (Empty, _) => k'
-	  | (Time, Time) => Time
-	  | _ => Error.bug "Kind.merge"
+         fn (k, k') =>
+         case (k, k') of
+            (Alloc, Alloc) => Alloc
+          | (Count, Count) => Count
+          | (_, Empty) => k
+          | (Empty, _) => k'
+          | (Time, Time) => Time
+          | _ => Error.bug "Kind.merge"
    end
 
 structure Style =
@@ -227,196 +228,196 @@
 structure Counts =
    struct
       datatype t =
-	 Current of {master: IntInf.t vector,
-		     split: IntInf.t vector}
+         Current of {master: IntInf.t vector,
+                     split: IntInf.t vector}
        | Empty
        | Stack of {master: {current: IntInf.t,
-			    stack: IntInf.t,
-			    stackGC: IntInf.t} vector,
-		   split: {current: IntInf.t,
-			   stack: IntInf.t,
-			   stackGC: IntInf.t} vector}
+                            stack: IntInf.t,
+                            stackGC: IntInf.t} vector,
+                   split: {current: IntInf.t,
+                           stack: IntInf.t,
+                           stackGC: IntInf.t} vector}
 
       val layout =
-	 fn Current {master, split} =>
-	      Layout.record [("master", Vector.layout IntInf.layout master),
-			     ("split", Vector.layout IntInf.layout split)]
-	  | Empty => Layout.str "empty"
-	  | Stack {master, split} =>
-	       let
-		  fun lay v =
-		     Vector.layout
-		     (fn {current, stack, stackGC} =>
-		      Layout.record [("current", IntInf.layout current),
-				     ("stack", IntInf.layout stack),
-				     ("stackGC", IntInf.layout stackGC)])
-		     v
-	       in
-		  Layout.record [("master", lay master),
-				 ("split", lay split)]
-	       end
+         fn Current {master, split} =>
+              Layout.record [("master", Vector.layout IntInf.layout master),
+                             ("split", Vector.layout IntInf.layout split)]
+          | Empty => Layout.str "empty"
+          | Stack {master, split} =>
+               let
+                  fun lay v =
+                     Vector.layout
+                     (fn {current, stack, stackGC} =>
+                      Layout.record [("current", IntInf.layout current),
+                                     ("stack", IntInf.layout stack),
+                                     ("stackGC", IntInf.layout stackGC)])
+                     v
+               in
+                  Layout.record [("master", lay master),
+                                 ("split", lay split)]
+               end
 
       fun merge (c: t, c': t): t =
-	 case (c, c') of
-	    (Current {master = m, split = s},
-	     Current {master = m', split = s'}) =>
-	       let
-		  fun merge (v, v') = Vector.map2 (v, v', op +)
-	       in
-		  Current {master = merge (m, m'),
-			   split = merge (s, s')}
-	       end
-	  | (Empty, _) => c'
-	  | (_, Empty) => c
-	  | (Stack {master = m, split = s}, Stack {master = m', split = s'}) =>
-	       let
-		  fun merge (v, v') =
-		     Vector.map2
-		     (v, v', fn ({current = c, stack = s, stackGC = g},
-				 {current = c', stack = s', stackGC = g'}) =>
-		      {current = c + c',
-		       stack = s + s',
-		       stackGC = g + g'})
-	       in
-		  Stack {master = merge (m, m'),
-			 split = merge (s, s')}
-	       end
-	  | _ =>
-	       Error.bug
-	       "cannot merge -profile-stack false with -profile-stack true"
+         case (c, c') of
+            (Current {master = m, split = s},
+             Current {master = m', split = s'}) =>
+               let
+                  fun merge (v, v') = Vector.map2 (v, v', op +)
+               in
+                  Current {master = merge (m, m'),
+                           split = merge (s, s')}
+               end
+          | (Empty, _) => c'
+          | (_, Empty) => c
+          | (Stack {master = m, split = s}, Stack {master = m', split = s'}) =>
+               let
+                  fun merge (v, v') =
+                     Vector.map2
+                     (v, v', fn ({current = c, stack = s, stackGC = g},
+                                 {current = c', stack = s', stackGC = g'}) =>
+                      {current = c + c',
+                       stack = s + s',
+                       stackGC = g + g'})
+               in
+                  Stack {master = merge (m, m'),
+                         split = merge (s, s')}
+               end
+          | _ =>
+               Error.bug
+               "cannot merge -profile-stack false with -profile-stack true"
    end
 
 structure ProfFile =
    struct
       datatype t = T of {counts: Counts.t,
-			 kind: Kind.t,
-			 magic: word,
-			 total: IntInf.t,
-			 totalGC: IntInf.t}
+                         kind: Kind.t,
+                         magic: word,
+                         total: IntInf.t,
+                         totalGC: IntInf.t}
 
       fun empty (AFile.T {magic, ...}) =
-	 T {counts = Counts.Empty,
-	    kind = Kind.Empty,
-	    magic = magic,
-	    total = 0,
-	    totalGC = 0}
+         T {counts = Counts.Empty,
+            kind = Kind.Empty,
+            magic = magic,
+            total = 0,
+            totalGC = 0}
 
       fun layout (T {counts, kind, magic, total, totalGC}) =
-	 Layout.record [("kind", Kind.layout kind),
-			("magic", Word.layout magic),
-			("total", IntInf.layout total),
-			("totalGC", IntInf.layout totalGC),
-			("counts", Counts.layout counts)]
+         Layout.record [("kind", Kind.layout kind),
+                        ("magic", Word.layout magic),
+                        ("total", IntInf.layout total),
+                        ("totalGC", IntInf.layout totalGC),
+                        ("counts", Counts.layout counts)]
 
       fun new {mlmonfile: File.t}: t =
-	 File.withIn
-	 (mlmonfile, fn ins =>
-	  let
-	     fun line () =
-		case In.inputLine ins of
-		   NONE => Error.bug "unexpected end of mlmon file"
-		 | SOME s => String.dropSuffix (s, 1)
-	     val _ =
-		if "MLton prof" = line ()
-		   then ()
-		else Error.bug "bad header"
-	     val kind =
-		case line () of
-		   "alloc" => Kind.Alloc
-		 | "count" => Kind.Count
-		 | "time" => Kind.Time
-		 | _ => Error.bug "invalid profile kind"
-	     val style =
-		case line () of
-		   "current" => Style.Current
-		 | "stack" => Style.Stack
-		 | _ => Error.bug "invalid profile style"
-	     val magic =
-		case Word.fromString (line ()) of
-		   NONE => Error.bug "invalid magic"
-		 | SOME w => w
-	     fun s2i s =
-		case IntInf.fromString s of
-		   NONE => Error.bug "invalid count"
-		 | SOME i => i
-	     val (total, totalGC) =
-		case String.tokens (line (), Char.isSpace) of
-		   [total, totalGC] => (s2i total, s2i totalGC)
-		 | _ => Error.bug "invalid totals"
-	     fun getCounts (f: string -> 'a): {master: 'a vector,
-					       split: 'a vector} =
-		let
-		   fun vector () =
-		      Vector.tabulate (valOf (Int.fromString (line ())),
-				       fn _ => f (line ()))
-		   val split = vector ()
-		   val master = vector ()
-		in
-		   {master = master, split = split}
-		end
-	     val counts =
-		case style of
-		   Style.Current => Counts.Current (getCounts s2i)
-		 | Style.Stack =>
-		      Counts.Stack
-		      (getCounts
-		       (fn s =>
-			case String.tokens (s, Char.isSpace) of
-			   [c, s, sGC] =>
-			      {current = s2i c,
-			       stack = s2i s,
-			       stackGC = s2i sGC}
-			 | _ =>
-			      Error.bug
-			      (concat ["strange line: ",
-				       String.dropSuffix (s, 1)])))
-	  in
-	     T {counts = counts,
-		kind = kind,
-		magic = magic,
-		total = total,
-		totalGC = totalGC}
-	  end)
+         File.withIn
+         (mlmonfile, fn ins =>
+          let
+             fun line () =
+                case In.inputLine ins of
+                   NONE => Error.bug "unexpected end of mlmon file"
+                 | SOME s => String.dropSuffix (s, 1)
+             val _ =
+                if "MLton prof" = line ()
+                   then ()
+                else Error.bug "bad header"
+             val kind =
+                case line () of
+                   "alloc" => Kind.Alloc
+                 | "count" => Kind.Count
+                 | "time" => Kind.Time
+                 | _ => Error.bug "invalid profile kind"
+             val style =
+                case line () of
+                   "current" => Style.Current
+                 | "stack" => Style.Stack
+                 | _ => Error.bug "invalid profile style"
+             val magic =
+                case Word.fromString (line ()) of
+                   NONE => Error.bug "invalid magic"
+                 | SOME w => w
+             fun s2i s =
+                case IntInf.fromString s of
+                   NONE => Error.bug "invalid count"
+                 | SOME i => i
+             val (total, totalGC) =
+                case String.tokens (line (), Char.isSpace) of
+                   [total, totalGC] => (s2i total, s2i totalGC)
+                 | _ => Error.bug "invalid totals"
+             fun getCounts (f: string -> 'a): {master: 'a vector,
+                                               split: 'a vector} =
+                let
+                   fun vector () =
+                      Vector.tabulate (valOf (Int.fromString (line ())),
+                                       fn _ => f (line ()))
+                   val split = vector ()
+                   val master = vector ()
+                in
+                   {master = master, split = split}
+                end
+             val counts =
+                case style of
+                   Style.Current => Counts.Current (getCounts s2i)
+                 | Style.Stack =>
+                      Counts.Stack
+                      (getCounts
+                       (fn s =>
+                        case String.tokens (s, Char.isSpace) of
+                           [c, s, sGC] =>
+                              {current = s2i c,
+                               stack = s2i s,
+                               stackGC = s2i sGC}
+                         | _ =>
+                              Error.bug
+                              (concat ["strange line: ",
+                                       String.dropSuffix (s, 1)])))
+          in
+             T {counts = counts,
+                kind = kind,
+                magic = magic,
+                total = total,
+                totalGC = totalGC}
+          end)
    
       fun merge (T {counts = c, kind = k, magic = m, total = t, totalGC = g},
-		 T {counts = c', kind = k', magic = m', total = t',
-		    totalGC = g'}): t =
-	 if m <> m'
-	    then Error.bug "wrong magic number"
-	 else
-	    T {counts = Counts.merge (c, c'),
-	       kind = Kind.merge (k, k'),
-	       magic = m,
-	       total = t + t',
-	       totalGC = g + g'}
+                 T {counts = c', kind = k', magic = m', total = t',
+                    totalGC = g'}): t =
+         if m <> m'
+            then Error.bug "wrong magic number"
+         else
+            T {counts = Counts.merge (c, c'),
+               kind = Kind.merge (k, k'),
+               magic = m,
+               total = t + t',
+               totalGC = g + g'}
    end
 
 structure Atomic =
    struct
       datatype t =
-	 Name of string * Regexp.Compiled.t
+         Name of string * Regexp.Compiled.t
        | Thresh of real
        | ThreshGC of real
        | ThreshStack of real
 
       val toSexp: t -> Sexp.t =
-	 fn a =>
-	 let
-	    datatype z = datatype Sexp.t
-	 in
-	    case a of
-	       Name (s, _) => String s
-	     | Thresh x => List [Atom "thresh", Atom (Real.toString x)]
-	     | ThreshGC x => List [Atom "thresh-gc", Atom (Real.toString x)]
-	     | ThreshStack x =>
-		  List [Atom "thresh-stack", Atom (Real.toString x)]
-	 end
+         fn a =>
+         let
+            datatype z = datatype Sexp.t
+         in
+            case a of
+               Name (s, _) => String s
+             | Thresh x => List [Atom "thresh", Atom (Real.toString x)]
+             | ThreshGC x => List [Atom "thresh-gc", Atom (Real.toString x)]
+             | ThreshStack x =>
+                  List [Atom "thresh-stack", Atom (Real.toString x)]
+         end
    end
 
 structure NodePred =
    struct
       datatype t =
-	 All
+         All
        | And of t vector
        | Atomic of Atomic.t
        | Not of t
@@ -427,195 +428,195 @@
        | Succ of t
 
       val rec toSexp: t -> Sexp.t =
-	 fn p =>
-	 let
-	    datatype z = datatype Sexp.t
-	    fun nAry (name, ps) =
-	       List (Atom name :: Vector.toListMap (ps, toSexp))
-	    fun unary (name, p) =
-	       List [Atom name, toSexp p]
-	 in
-	    case p of
-	       All => Sexp.Atom "all"
-	     | And ps => nAry ("and", ps)
-	     | Atomic a => Atomic.toSexp a
-	     | Not p => unary ("not", p)
-	     | Or ps => nAry ("or", ps)
-	     | PathFrom p => unary ("from", p)
-	     | PathTo p => unary ("to", p)
-	     | Pred p => unary ("pred", p)
-	     | Succ p => unary ("succ", p)
-	 end
+         fn p =>
+         let
+            datatype z = datatype Sexp.t
+            fun nAry (name, ps) =
+               List (Atom name :: Vector.toListMap (ps, toSexp))
+            fun unary (name, p) =
+               List [Atom name, toSexp p]
+         in
+            case p of
+               All => Sexp.Atom "all"
+             | And ps => nAry ("and", ps)
+             | Atomic a => Atomic.toSexp a
+             | Not p => unary ("not", p)
+             | Or ps => nAry ("or", ps)
+             | PathFrom p => unary ("from", p)
+             | PathTo p => unary ("to", p)
+             | Pred p => unary ("pred", p)
+             | Succ p => unary ("succ", p)
+         end
 
       (* val layout = Sexp.layout o toSexp *)
 
       val fromString: string -> t =
-	 fn s =>
-	 case Sexp.fromString s of
-	    Sexp.Eof => Error.bug "empty"
-	  | Sexp.Error s => Error.bug s
-	  | Sexp.Sexp s =>
-	       let
-		  fun parse (s: Sexp.t): t =
-		     let
-			fun err () = Error.bug (Sexp.toString s)
-		     in			   
-			case s of
-			   Sexp.Atom s =>
-			      (case s of
-				  "all" => All
-				| _ => err ())
-			 | Sexp.List ss =>
-			      (case ss of
-				  [] => err ()
-				| s :: ss =>
-				     let
-					fun nAry f =
-					   f (Vector.fromListMap (ss, parse))
-					fun unary f =
-					   case ss of
-					      [s] => f (parse s)
-					    | _ => err ()
-					fun thresh f =
-					   case ss of
-					      [Sexp.Atom x] =>
-						 (case Real.fromString x of
-						     NONE => err ()
-						   | SOME x =>
-							if 0.0 <= x
-							   andalso x <= 100.0
-							   then Atomic (f x)
-							else err ())
-					    | _ => err ()
-					datatype z = datatype Atomic.t
-				     in
-					case s of
-					   Sexp.Atom s =>
-					      (case s of
-						  "and" => nAry And
-						| "from" => unary PathFrom
-						| "not" => unary Not
-						| "or" => nAry Or
-						| "pred" => unary Pred
-						| "succ" => unary Succ
-						| "thresh" => thresh Thresh
-						| "thresh-gc" => thresh ThreshGC
-						| "thresh-stack" =>
-						     thresh ThreshStack
-						| "to" => unary PathTo
-						| _ => err ())
-					 | _ => err ()
-				     end)
-			 | Sexp.String s =>
-			      (case Regexp.fromString s of
-				  NONE => err ()
-				| SOME (r, _) =>
-				     Atomic
-				     (Atomic.Name (s, Regexp.compileNFA r)))
-		     end
-	       in
-		  parse s
-	       end
+         fn s =>
+         case Sexp.fromString s of
+            Sexp.Eof => Error.bug "empty"
+          | Sexp.Error s => Error.bug s
+          | Sexp.Sexp s =>
+               let
+                  fun parse (s: Sexp.t): t =
+                     let
+                        fun err () = Error.bug (Sexp.toString s)
+                     in                    
+                        case s of
+                           Sexp.Atom s =>
+                              (case s of
+                                  "all" => All
+                                | _ => err ())
+                         | Sexp.List ss =>
+                              (case ss of
+                                  [] => err ()
+                                | s :: ss =>
+                                     let
+                                        fun nAry f =
+                                           f (Vector.fromListMap (ss, parse))
+                                        fun unary f =
+                                           case ss of
+                                              [s] => f (parse s)
+                                            | _ => err ()
+                                        fun thresh f =
+                                           case ss of
+                                              [Sexp.Atom x] =>
+                                                 (case Real.fromString x of
+                                                     NONE => err ()
+                                                   | SOME x =>
+                                                        if 0.0 <= x
+                                                           andalso x <= 100.0
+                                                           then Atomic (f x)
+                                                        else err ())
+                                            | _ => err ()
+                                        datatype z = datatype Atomic.t
+                                     in
+                                        case s of
+                                           Sexp.Atom s =>
+                                              (case s of
+                                                  "and" => nAry And
+                                                | "from" => unary PathFrom
+                                                | "not" => unary Not
+                                                | "or" => nAry Or
+                                                | "pred" => unary Pred
+                                                | "succ" => unary Succ
+                                                | "thresh" => thresh Thresh
+                                                | "thresh-gc" => thresh ThreshGC
+                                                | "thresh-stack" =>
+                                                     thresh ThreshStack
+                                                | "to" => unary PathTo
+                                                | _ => err ())
+                                         | _ => err ()
+                                     end)
+                         | Sexp.String s =>
+                              (case Regexp.fromString s of
+                                  NONE => err ()
+                                | SOME (r, _) =>
+                                     Atomic
+                                     (Atomic.Name (s, Regexp.compileNFA r)))
+                     end
+               in
+                  parse s
+               end
 
       fun nodes (p: t, g: 'a Graph.t,
-		 atomic: 'a Node.t * Atomic.t -> bool): 'a Node.t vector =
-	 let
-	    val {get = nodeIndex: 'a Node.t -> int,
-		 set = setNodeIndex, ...} =
-	       Property.getSet (Node.plist,
-				Property.initRaise ("index", Node.layout))
-	    val nodes = Vector.fromList (Graph.nodes g)
-	    val numNodes = Vector.length nodes
-	    val _ = Vector.foreachi (nodes, fn (i, n) => setNodeIndex (n, i))
-	    val transpose =
-	       Promise.lazy
-	       (fn () =>
-		let
-		   val {get = nodeIndex': 'a Graph.u Node.t -> int,
-			set = setNodeIndex, ...} =
-		      Property.getSet (Node.plist,
-				       Property.initRaise ("index", Node.layout))
-		   val (transpose, {newNode, ...}) = Graph.transpose g
-		   val _ =
-		      Graph.foreachNode
-		      (g, fn n => setNodeIndex (newNode n, nodeIndex n))
-		in
-		   (transpose, newNode, nodeIndex')
-		end)
-	    fun vectorToNodes (v: bool vector): 'a Node.t vector =
-	       Vector.keepAllMapi
-	       (v, fn (i, b) =>
-		if b
-		   then SOME (Vector.sub (nodes, i))
-		else NONE)
-	    val all = Promise.lazy (fn () =>
-				    Vector.tabulate (numNodes, fn _ => true))
-	    val none = Promise.lazy (fn () =>
-				     Vector.tabulate (numNodes, fn _ => false))
-	    fun path (v: bool vector,
-		      (g: 'b Graph.t,
-		       getNode: 'a Node.t -> 'b Node.t,
-		       nodeIndex: 'b Node.t -> int)): bool vector =
-	       let
-		  val roots = vectorToNodes v
-		  val a = Array.array (numNodes, false)
-		  val _ =
-		     Graph.dfsNodes
-		     (g,
-		      Vector.toListMap (roots, getNode),
-		      Graph.DfsParam.startNode (fn n =>
-						Array.update
-						(a, nodeIndex n, true)))
-	       in
-		  Vector.fromArray a
-	       end
-	    fun loop (p: t): bool vector =
-	       case p of
-		  All => all ()
-		| And ps =>
-		     Vector.fold (ps, all (), fn (p, v) =>
-				  Vector.map2 (v, loop p, fn (b, b') =>
-					       b andalso b'))
-		| Atomic a => Vector.map (nodes, fn n => atomic (n, a))
-		| Not p => Vector.map (loop p, not)
-		| Or ps =>
-		     Vector.fold (ps, none (), fn (p, v) =>
-				  Vector.map2 (v, loop p, fn (b, b') =>
-					       b orelse b'))
-		| PathFrom p => path (loop p, (g, fn n => n, nodeIndex))
-		| PathTo p => path (loop p, transpose ())
-		| Pred p =>
-		     let
-			val ns = vectorToNodes (loop p)
-			val {destroy, get, set, ...}  =
-			   Property.destGetSetOnce
-			   (Node.plist, Property.initConst false)
-			val _ = Vector.foreach (ns, fn n => set (n, true))
-			val v =
-			   Vector.map
-			   (nodes, fn n =>
-			    get n orelse
-			    List.exists (Node.successors n, get o Edge.to))
-			val _ = destroy ()
-		     in
-			v
-		     end
-		| Succ p =>
-		     let
-			val a = Array.array (numNodes, false)
-			fun yes n = Array.update (a, nodeIndex n, true)
-			val _ =
-			   Vector.foreach
-			   (vectorToNodes (loop p), fn n =>
-			    (yes n
-			     ; List.foreach (Node.successors n, yes o Edge.to)))
-		     in
-			Vector.fromArray a
-		     end
-	    val v = loop p
-	 in
-	    vectorToNodes v
-	 end
+                 atomic: 'a Node.t * Atomic.t -> bool): 'a Node.t vector =
+         let
+            val {get = nodeIndex: 'a Node.t -> int,
+                 set = setNodeIndex, ...} =
+               Property.getSet (Node.plist,
+                                Property.initRaise ("index", Node.layout))
+            val nodes = Vector.fromList (Graph.nodes g)
+            val numNodes = Vector.length nodes
+            val _ = Vector.foreachi (nodes, fn (i, n) => setNodeIndex (n, i))
+            val transpose =
+               Promise.lazy
+               (fn () =>
+                let
+                   val {get = nodeIndex': 'a Graph.u Node.t -> int,
+                        set = setNodeIndex, ...} =
+                      Property.getSet (Node.plist,
+                                       Property.initRaise ("index", Node.layout))
+                   val (transpose, {newNode, ...}) = Graph.transpose g
+                   val _ =
+                      Graph.foreachNode
+                      (g, fn n => setNodeIndex (newNode n, nodeIndex n))
+                in
+                   (transpose, newNode, nodeIndex')
+                end)
+            fun vectorToNodes (v: bool vector): 'a Node.t vector =
+               Vector.keepAllMapi
+               (v, fn (i, b) =>
+                if b
+                   then SOME (Vector.sub (nodes, i))
+                else NONE)
+            val all = Promise.lazy (fn () =>
+                                    Vector.tabulate (numNodes, fn _ => true))
+            val none = Promise.lazy (fn () =>
+                                     Vector.tabulate (numNodes, fn _ => false))
+            fun path (v: bool vector,
+                      (g: 'b Graph.t,
+                       getNode: 'a Node.t -> 'b Node.t,
+                       nodeIndex: 'b Node.t -> int)): bool vector =
+               let
+                  val roots = vectorToNodes v
+                  val a = Array.array (numNodes, false)
+                  val _ =
+                     Graph.dfsNodes
+                     (g,
+                      Vector.toListMap (roots, getNode),
+                      Graph.DfsParam.startNode (fn n =>
+                                                Array.update
+                                                (a, nodeIndex n, true)))
+               in
+                  Vector.fromArray a
+               end
+            fun loop (p: t): bool vector =
+               case p of
+                  All => all ()
+                | And ps =>
+                     Vector.fold (ps, all (), fn (p, v) =>
+                                  Vector.map2 (v, loop p, fn (b, b') =>
+                                               b andalso b'))
+                | Atomic a => Vector.map (nodes, fn n => atomic (n, a))
+                | Not p => Vector.map (loop p, not)
+                | Or ps =>
+                     Vector.fold (ps, none (), fn (p, v) =>
+                                  Vector.map2 (v, loop p, fn (b, b') =>
+                                               b orelse b'))
+                | PathFrom p => path (loop p, (g, fn n => n, nodeIndex))
+                | PathTo p => path (loop p, transpose ())
+                | Pred p =>
+                     let
+                        val ns = vectorToNodes (loop p)
+                        val {destroy, get, set, ...}  =
+                           Property.destGetSetOnce
+                           (Node.plist, Property.initConst false)
+                        val _ = Vector.foreach (ns, fn n => set (n, true))
+                        val v =
+                           Vector.map
+                           (nodes, fn n =>
+                            get n orelse
+                            List.exists (Node.successors n, get o Edge.to))
+                        val _ = destroy ()
+                     in
+                        v
+                     end
+                | Succ p =>
+                     let
+                        val a = Array.array (numNodes, false)
+                        fun yes n = Array.update (a, nodeIndex n, true)
+                        val _ =
+                           Vector.foreach
+                           (vectorToNodes (loop p), fn n =>
+                            (yes n
+                             ; List.foreach (Node.successors n, yes o Edge.to)))
+                     in
+                        Vector.fromArray a
+                     end
+            val v = loop p
+         in
+            vectorToNodes v
+         end
    end
    
 val keep: NodePred.t ref = ref NodePred.All
@@ -623,340 +624,340 @@
 val ticksPerSecond = 100.0
 
 fun display (AFile.T {callGraph, master, name = aname, split, ...},
-	     ProfFile.T {counts, kind, total, totalGC, ...}): unit =
+             ProfFile.T {counts, kind, total, totalGC, ...}): unit =
    let
       val {get = nodeInfo: (unit Node.t
-			    -> {index: int,
-				keep: bool ref,
-				mayKeep: (Atomic.t -> bool) ref}),
-	   set = setNodeInfo, ...} =
-	 Property.getSetOnce (Node.plist,
-			      Property.initRaise ("info", Node.layout))
+                            -> {index: int,
+                                keep: bool ref,
+                                mayKeep: (Atomic.t -> bool) ref}),
+           set = setNodeInfo, ...} =
+         Property.getSetOnce (Node.plist,
+                              Property.initRaise ("info", Node.layout))
       val _ =
-	 Vector.foreachi (split, fn (i, {node, ...}) =>
-			  setNodeInfo (node,
-				       {index = i,
-					keep = ref false,
-					mayKeep = ref (fn _ => false)}))
+         Vector.foreachi (split, fn (i, {node, ...}) =>
+                          setNodeInfo (node,
+                                       {index = i,
+                                        keep = ref false,
+                                        mayKeep = ref (fn _ => false)}))
       val profileStack =
-	 case counts of
-	    Counts.Current _ => false
-	  | Counts.Empty => false
-	  | Counts.Stack _ => true
+         case counts of
+            Counts.Current _ => false
+          | Counts.Empty => false
+          | Counts.Stack _ => true
       val totalReal = Real.fromIntInf (total + totalGC)
       val per: IntInf.t -> real =
-	 if Real.equals (0.0, totalReal)
-	    then fn _ => 0.0
-	 else
-	    fn ticks => 100.0 * Real.fromIntInf ticks / totalReal
+         if Real.equals (0.0, totalReal)
+            then fn _ => 0.0
+         else
+            fn ticks => 100.0 * Real.fromIntInf ticks / totalReal
       fun doit ({master = masterCount: 'a vector,
-		 split = splitCount: 'a vector},
-		f: 'a -> {current: IntInf.t,
-			  stack: IntInf.t,
-			  stackGC: IntInf.t}) =
-	 let
-	    val _ =
-	       Vector.foreachi
-	       (split, fn (i, {masterIndex, node, ...}) =>
-		let
-		   val {mayKeep, ...} = nodeInfo node
-		   val {isSplit, source, ...} = Vector.sub (master, masterIndex)
-		   val name = Source.toString source
-		in
-		   mayKeep :=
-		   (fn a =>
-		    let
-		       fun thresh (x: real, sel) =
-			  let
-			     val (v, i) =
-				if isSplit
-				   then (splitCount, i)
-				else (masterCount, masterIndex)
-			  in
-			     per (sel (f (Vector.sub (v, i)))) >= x
-			  end
-		       datatype z = datatype Atomic.t
-		    in
-		       case a of
-			  Name (_, rc) =>
-			     Regexp.Compiled.matchesPrefix (rc, name)
-			| Thresh x => thresh (x, #current)
-			| ThreshGC x => thresh (x, #stackGC)
-			| ThreshStack x => thresh (x, #stack)
-		    end)
-		end)
-	    fun row (ticks: IntInf.t): string list =
-	       (concat [Real.format (per ticks, Real.Format.fix (SOME 1)), "%"])
-	       :: (if !raw
-		      then
-			 [concat
-			  (case kind of
-			      Kind.Alloc =>
-				 ["(", IntInf.toCommaString ticks, ")"]
-			    | Kind.Count =>
-				 ["(", IntInf.toCommaString ticks, ")"]
-			    | Kind.Empty => []
-			    | Kind.Time =>
-				 ["(",
-				  Real.format
-				  (Real.fromIntInf ticks / ticksPerSecond,
-				   Real.Format.fix (SOME 2)),
-				  "s)"])]
-		   else [])
-	    fun info (source: Source.t, a: 'a) =
-	       let
-		  val {current, stack, stackGC} = f a
-		  val row =
-		     row current
-		     @ (if profileStack
-			   then row stack @ row stackGC
-			else [])
-		  val pc = per current
-		  val isNonZero = current > 0 orelse stack > 0 orelse stackGC > 0
-		  val tableInfo = 
-		     if isNonZero orelse (kind = Kind.Count
-					  andalso (case source of
-						      Source.NamePos _ => true
-						    | _ => false))
-			then SOME {per = pc,
-				   row = Source.toStringMaybeLine source :: row}
-		     else NONE
-		  val nodeOptions =
-		     [Dot.NodeOption.Shape Dot.Box,
-		      Dot.NodeOption.Label
-		      (Source.toDotLabel source
-		       @ (if isNonZero
-			     then [(concat (List.separate (row, " ")),
-				    Dot.Center)]
-			  else [])),
-		      Dot.NodeOption.Color
-		      (if !gray
-			  then DotColor.gray (100 - Real.round (per stack))
-		       else DotColor.Black)]
-	       in
-		  {nodeOptions = nodeOptions,
-		   tableInfo = tableInfo}
-	       end
-	    val masterOptions =
-	       Vector.map2
-	       (master, masterCount, fn ({source, ...}, a) =>
-		info (source, a))
-	    val splitOptions =
-	       Vector.map2
-	       (split, splitCount, fn ({masterIndex, ...}, a) =>
-		info (#source (Vector.sub (master, masterIndex)), a))
-	 in
-	    (masterOptions, splitOptions)
-	 end
+                 split = splitCount: 'a vector},
+                f: 'a -> {current: IntInf.t,
+                          stack: IntInf.t,
+                          stackGC: IntInf.t}) =
+         let
+            val _ =
+               Vector.foreachi
+               (split, fn (i, {masterIndex, node, ...}) =>
+                let
+                   val {mayKeep, ...} = nodeInfo node
+                   val {isSplit, source, ...} = Vector.sub (master, masterIndex)
+                   val name = Source.toString source
+                in
+                   mayKeep :=
+                   (fn a =>
+                    let
+                       fun thresh (x: real, sel) =
+                          let
+                             val (v, i) =
+                                if isSplit
+                                   then (splitCount, i)
+                                else (masterCount, masterIndex)
+                          in
+                             per (sel (f (Vector.sub (v, i)))) >= x
+                          end
+                       datatype z = datatype Atomic.t
+                    in
+                       case a of
+                          Name (_, rc) =>
+                             Regexp.Compiled.matchesPrefix (rc, name)
+                        | Thresh x => thresh (x, #current)
+                        | ThreshGC x => thresh (x, #stackGC)
+                        | ThreshStack x => thresh (x, #stack)
+                    end)
+                end)
+            fun row (ticks: IntInf.t): string list =
+               (concat [Real.format (per ticks, Real.Format.fix (SOME 1)), "%"])
+               :: (if !raw
+                      then
+                         [concat
+                          (case kind of
+                              Kind.Alloc =>
+                                 ["(", IntInf.toCommaString ticks, ")"]
+                            | Kind.Count =>
+                                 ["(", IntInf.toCommaString ticks, ")"]
+                            | Kind.Empty => []
+                            | Kind.Time =>
+                                 ["(",
+                                  Real.format
+                                  (Real.fromIntInf ticks / ticksPerSecond,
+                                   Real.Format.fix (SOME 2)),
+                                  "s)"])]
+                   else [])
+            fun info (source: Source.t, a: 'a) =
+               let
+                  val {current, stack, stackGC} = f a
+                  val row =
+                     row current
+                     @ (if profileStack
+                           then row stack @ row stackGC
+                        else [])
+                  val pc = per current
+                  val isNonZero = current > 0 orelse stack > 0 orelse stackGC > 0
+                  val tableInfo = 
+                     if isNonZero orelse (kind = Kind.Count
+                                          andalso (case source of
+                                                      Source.NamePos _ => true
+                                                    | _ => false))
+                        then SOME {per = pc,
+                                   row = Source.toStringMaybeLine source :: row}
+                     else NONE
+                  val nodeOptions =
+                     [Dot.NodeOption.Shape Dot.Box,
+                      Dot.NodeOption.Label
+                      (Source.toDotLabel source
+                       @ (if isNonZero
+                             then [(concat (List.separate (row, " ")),
+                                    Dot.Center)]
+                          else [])),
+                      Dot.NodeOption.Color
+                      (if !gray
+                          then DotColor.gray (100 - Real.round (per stack))
+                       else DotColor.Black)]
+               in
+                  {nodeOptions = nodeOptions,
+                   tableInfo = tableInfo}
+               end
+            val masterOptions =
+               Vector.map2
+               (master, masterCount, fn ({source, ...}, a) =>
+                info (source, a))
+            val splitOptions =
+               Vector.map2
+               (split, splitCount, fn ({masterIndex, ...}, a) =>
+                info (#source (Vector.sub (master, masterIndex)), a))
+         in
+            (masterOptions, splitOptions)
+         end
       val (masterInfo, splitInfo) =
-	 case counts of
-	    Counts.Current ms =>
-	       doit (ms, fn z => {current = z,
-				  stack = 0,
-				  stackGC = 0})
-	  | Counts.Empty =>
-	       doit ({master = Vector.new (Vector.length master, ()),
-		      split = Vector.new (Vector.length split, ())},
-		     fn () => {current = 0,
-			       stack = 0,
-			       stackGC = 0})
-	  | Counts.Stack ms =>
-	       doit (ms, fn z => z)
+         case counts of
+            Counts.Current ms =>
+               doit (ms, fn z => {current = z,
+                                  stack = 0,
+                                  stackGC = 0})
+          | Counts.Empty =>
+               doit ({master = Vector.new (Vector.length master, ()),
+                      split = Vector.new (Vector.length split, ())},
+                     fn () => {current = 0,
+                               stack = 0,
+                               stackGC = 0})
+          | Counts.Stack ms =>
+               doit (ms, fn z => z)
       val keep = !keep
       val keepNodes =
-	 NodePred.nodes
-	 (keep, callGraph, fn (n, a) => (! (#mayKeep (nodeInfo n))) a)
+         NodePred.nodes
+         (keep, callGraph, fn (n, a) => (! (#mayKeep (nodeInfo n))) a)
       val _ = Vector.foreach (keepNodes, fn n =>
-			      #keep (nodeInfo n) := true)
+                              #keep (nodeInfo n) := true)
       (* keep a master node if it is not split and some copy of it is kept. *)
       val keepMaster = Array.new (Vector.length master, false)
       val _ =
-	 Vector.foreach
-	 (split, fn {masterIndex, node, ...} =>
-	  let
-	     val {keep, ...} = nodeInfo node
-	     val {isSplit, ...} = Vector.sub (master, masterIndex)
-	  in
-	     if !keep andalso not isSplit
-		then Array.update (keepMaster, masterIndex, true)
-	     else ()
-	  end)
+         Vector.foreach
+         (split, fn {masterIndex, node, ...} =>
+          let
+             val {keep, ...} = nodeInfo node
+             val {isSplit, ...} = Vector.sub (master, masterIndex)
+          in
+             if !keep andalso not isSplit
+                then Array.update (keepMaster, masterIndex, true)
+             else ()
+          end)
       datatype keep = T
       val keepGraph: keep Graph.t = Graph.new ()
       val {get = nodeOptions: keep Node.t -> NodeOption.t list,
-	   set = setNodeOptions, ...} =
-	 Property.getSetOnce (Node.plist,
-			      Property.initRaise ("options", Node.layout))
+           set = setNodeOptions, ...} =
+         Property.getSetOnce (Node.plist,
+                              Property.initRaise ("options", Node.layout))
       val tableInfos = ref []
       fun newNode {nodeOptions: NodeOption.t list,
-		   tableInfo} =
-	 let
-	    val _ = Option.app (tableInfo, fn z => List.push (tableInfos, z))
-	    val n = Graph.newNode keepGraph
-	    val _ = setNodeOptions (n, nodeOptions)
-	 in
-	    n
-	 end
+                   tableInfo} =
+         let
+            val _ = Option.app (tableInfo, fn z => List.push (tableInfos, z))
+            val n = Graph.newNode keepGraph
+            val _ = setNodeOptions (n, nodeOptions)
+         in
+            n
+         end
       val masterNodes =
-	 Vector.tabulate
-	 (Vector.length master, fn i =>
-	  if Array.sub (keepMaster, i)
-	     then SOME (newNode (Vector.sub (masterInfo, i)))
-	  else NONE)
+         Vector.tabulate
+         (Vector.length master, fn i =>
+          if Array.sub (keepMaster, i)
+             then SOME (newNode (Vector.sub (masterInfo, i)))
+          else NONE)
       val splitNodes =
-	 Vector.mapi
-	 (split, fn (i, {masterIndex, node, ...}) =>
-	  let
-	     val {keep, ...} = nodeInfo node
-	     val {isSplit, ...} = Vector.sub (master, masterIndex)
-	  in
-	     if isSplit
-		then
-		   if !keep
-		      then SOME (newNode (Vector.sub (splitInfo, i)))
-		   else NONE
-	     else Vector.sub (masterNodes, masterIndex)
-	  end)
+         Vector.mapi
+         (split, fn (i, {masterIndex, node, ...}) =>
+          let
+             val {keep, ...} = nodeInfo node
+             val {isSplit, ...} = Vector.sub (master, masterIndex)
+          in
+             if isSplit
+                then
+                   if !keep
+                      then SOME (newNode (Vector.sub (splitInfo, i)))
+                   else NONE
+             else Vector.sub (masterNodes, masterIndex)
+          end)
       val _ =
-	 Graph.foreachEdge
-	 (callGraph, fn (from, e) =>
-	  let
-	     val to = Edge.to e
-	     fun f n = Vector.sub (splitNodes, #index (nodeInfo n))
-	  in
-	     case (f from, f to) of
-		(SOME from, SOME to) =>
-		   (ignore o Graph.addEdge) 
-		   (keepGraph, {from = from, to = to})
-	      | _ => ()
-	  end)
+         Graph.foreachEdge
+         (callGraph, fn (from, e) =>
+          let
+             val to = Edge.to e
+             fun f n = Vector.sub (splitNodes, #index (nodeInfo n))
+          in
+             case (f from, f to) of
+                (SOME from, SOME to) =>
+                   (ignore o Graph.addEdge) 
+                   (keepGraph, {from = from, to = to})
+              | _ => ()
+          end)
       val {get = edgeOptions: keep Edge.t -> EdgeOption.t list ref, ...} =
-	 Property.get (Edge.plist, Property.initFun (fn _ => ref []))
+         Property.get (Edge.plist, Property.initFun (fn _ => ref []))
       (* Add a dashed edge from A to B if there is path from A to B of length
        * >= 2 going through only ignored nodes.
        *)
       fun newNode (n: unit Node.t): keep Node.t option =
-	 Vector.sub (splitNodes, #index (nodeInfo n))
+         Vector.sub (splitNodes, #index (nodeInfo n))
       fun reach (root: unit Node.t, f: keep Node.t -> unit): unit =
-	 let
-	    val {get = isKept: keep Node.t -> bool ref, ...} =
-	       Property.get (Node.plist, Property.initFun (fn _ => ref false))
-	    val {get = isSeen: unit Node.t -> bool ref, ...} =
-	       Property.get (Node.plist, Property.initFun (fn _ => ref false))
-	    fun loop n =
-	       List.foreach
-	       (Node.successors n, fn e =>
-		let
-		   val n = Edge.to e
-		   val s = isSeen n
-		in
-		   if !s
-		      then ()
-		   else
-		      let
-			 val _ = s := true
-		      in
-			 case newNode n of
-			    NONE => loop n
-			  | SOME keepN => 
-			       let
-				  val r = isKept keepN
-			       in
-				  if !r
-				     then ()
-				  else (r := true; f keepN)
-			       end
-		      end
-		end)
-	    val _ =
-	       List.foreach (Node.successors root, fn e =>
-			     let
-				val n = Edge.to e
-			     in
-				if Option.isNone (newNode n)
-				   then loop n
-				else ()
-			     end)
-	 in
-	    ()
-	 end
+         let
+            val {get = isKept: keep Node.t -> bool ref, ...} =
+               Property.get (Node.plist, Property.initFun (fn _ => ref false))
+            val {get = isSeen: unit Node.t -> bool ref, ...} =
+               Property.get (Node.plist, Property.initFun (fn _ => ref false))
+            fun loop n =
+               List.foreach
+               (Node.successors n, fn e =>
+                let
+                   val n = Edge.to e
+                   val s = isSeen n
+                in
+                   if !s
+                      then ()
+                   else
+                      let
+                         val _ = s := true
+                      in
+                         case newNode n of
+                            NONE => loop n
+                          | SOME keepN => 
+                               let
+                                  val r = isKept keepN
+                               in
+                                  if !r
+                                     then ()
+                                  else (r := true; f keepN)
+                               end
+                      end
+                end)
+            val _ =
+               List.foreach (Node.successors root, fn e =>
+                             let
+                                val n = Edge.to e
+                             in
+                                if Option.isNone (newNode n)
+                                   then loop n
+                                else ()
+                             end)
+         in
+            ()
+         end
       val _ =
-	 Vector.foreach2
-	 (split, splitNodes, fn ({node = from, ...}, z) =>
-	  Option.app
-	  (z, fn from' =>
-	   (reach (from, fn to =>
-		   let
-		      val e = Graph.addEdge (keepGraph, {from = from', to = to})
-		      val _ = List.push (edgeOptions e,
-					 EdgeOption.Style Dot.Dashed)
-		   in
-		      ()
-		   end))))
+         Vector.foreach2
+         (split, splitNodes, fn ({node = from, ...}, z) =>
+          Option.app
+          (z, fn from' =>
+           (reach (from, fn to =>
+                   let
+                      val e = Graph.addEdge (keepGraph, {from = from', to = to})
+                      val _ = List.push (edgeOptions e,
+                                         EdgeOption.Style Dot.Dashed)
+                   in
+                      ()
+                   end))))
       val _ = Graph.removeDuplicateEdges keepGraph
       val title =
-	 case !title of
-	    NONE => concat [aname, " call-stack graph"]
-	  | SOME s => s
+         case !title of
+            NONE => concat [aname, " call-stack graph"]
+          | SOME s => s
       val _ =
-	 Option.app
-	 (!callGraphFile, fn f =>
-	  File.withOut
-	  (f, fn out =>
-	   Layout.output
-	   (Graph.layoutDot (keepGraph,
-			     fn _ => {edgeOptions = ! o edgeOptions,
-				      nodeOptions = nodeOptions,
-				      options = [],
-				      title = title}),
-	    out)))
+         Option.app
+         (!callGraphFile, fn f =>
+          File.withOut
+          (f, fn out =>
+           Layout.output
+           (Graph.layoutDot (keepGraph,
+                             fn _ => {edgeOptions = ! o edgeOptions,
+                                      nodeOptions = nodeOptions,
+                                      options = [],
+                                      title = title}),
+            out)))
       (* Display the table. *)
       val tableRows =
-	 QuickSort.sortVector
-	 (Vector.fromList (!tableInfos), fn (z, z') => #per z >= #per z')
+         QuickSort.sortVector
+         (Vector.fromList (!tableInfos), fn (z, z') => #per z >= #per z')
       val _ = 
-	 print
-	 (concat
-	  (case kind of
-	      Kind.Alloc =>
-		 [IntInf.toCommaString total, " bytes allocated (",
-		  IntInf.toCommaString totalGC, " bytes by GC)\n"]
-	    | Kind.Count =>
-		 [IntInf.toCommaString total, " ticks\n"]
-	    | Kind.Empty => []
-	    | Kind.Time =>
-		 let
-		    fun t2s i = 
-		       Real.format (Real.fromIntInf i / ticksPerSecond, 
-				    Real.Format.fix (SOME 2))
-		 in
-		    [t2s total, " seconds of CPU time (",
-		     t2s totalGC, " seconds GC)\n"]
-		 end))
+         print
+         (concat
+          (case kind of
+              Kind.Alloc =>
+                 [IntInf.toCommaString total, " bytes allocated (",
+                  IntInf.toCommaString totalGC, " bytes by GC)\n"]
+            | Kind.Count =>
+                 [IntInf.toCommaString total, " ticks\n"]
+            | Kind.Empty => []
+            | Kind.Time =>
+                 let
+                    fun t2s i = 
+                       Real.format (Real.fromIntInf i / ticksPerSecond, 
+                                    Real.Format.fix (SOME 2))
+                 in
+                    [t2s total, " seconds of CPU time (",
+                     t2s totalGC, " seconds GC)\n"]
+                 end))
       val columnHeads =
-	 "function"
-	 :: let
-	       val pers =
-		  if profileStack
-		     then ["cur", "stack", "GC"]
-		  else ["cur"]
-	    in
-	       if !raw
-		  then List.concatMap (pers, fn p => [p, "raw"])
-	       else pers
-	    end
+         "function"
+         :: let
+               val pers =
+                  if profileStack
+                     then ["cur", "stack", "GC"]
+                  else ["cur"]
+            in
+               if !raw
+                  then List.concatMap (pers, fn p => [p, "raw"])
+               else pers
+            end
       val cols =
-	 (if profileStack then 3 else 1) * (if !raw then 2 else 1)
+         (if profileStack then 3 else 1) * (if !raw then 2 else 1)
       val _ =
-	 let
-	    open Justify
-	 in
-	    outputTable
-	    (table {columnHeads = SOME columnHeads,
-		    justs = Left :: List.duplicate (cols, fn () => Right),
-		    rows = Vector.toListMap (tableRows, #row)},
-	     Out.standard)
-	 end
+         let
+            open Justify
+         in
+            outputTable
+            (table {columnHeads = SOME columnHeads,
+                    justs = Left :: List.duplicate (cols, fn () => Right),
+                    rows = Vector.toListMap (tableRows, #row)},
+             Out.standard)
+         end
    in
       ()
    end
@@ -967,39 +968,39 @@
    in
       List.map
       ([(Normal, "call-graph", " <file>", "write call graph to dot file",
-	 SpaceString (fn s => callGraphFile := SOME s)),
-	(Normal, "graph-title", " <string>", "set call-graph title",
-	 SpaceString (fn s => title := SOME s)),
-	(Normal, "gray", " {false|true}", "gray nodes according to stack %",
-	 boolRef gray),
-	(Normal, "keep", " <exp>", "which functions to display",
-	 SpaceString (fn s =>
-		      keep := NodePred.fromString s
-		      handle e => usage (concat ["invalid -keep arg: ",
-						 Exn.toString e]))),
-	(Expert, "long-name", " {true|false}",
-	 " show long names of functions",
-	 boolRef longName),
-	(Normal, "mlmon", " <file>", "process mlmon files listed in <file>",
-	 SpaceString (fn s =>
-		      mlmonFiles :=
-		      List.concat [String.tokens (File.contents s, Char.isSpace),
-				   !mlmonFiles])),
-	(Normal, "raw", " {false|true}", "show raw counts",
-	 boolRef raw),
-	(Normal, "show-line", " {false|true}", "show line numbers",
-	 boolRef showLine),
-	(Normal, "split", " <regexp>", "split matching functions",
-	 SpaceString (fn s =>
-		      case Regexp.fromString s of
-			 NONE => usage (concat ["invalid -split regexp: ", s])
-		       | SOME (r, _) => splitReg := Regexp.or [r, !splitReg])),
-	(Normal, "thresh", " [0.0,100.0]", "-keep (thresh x)",
-	 Real (fn x => if x < 0.0 orelse x > 100.0
-			 then usage "invalid -thresh"
-		      else keep := NodePred.Atomic (Atomic.Thresh x))),
-	(Normal, "tolerant", " {false|true}", "ignore broken mlmon files",
-	 boolRef tolerant)],
+         SpaceString (fn s => callGraphFile := SOME s)),
+        (Normal, "graph-title", " <string>", "set call-graph title",
+         SpaceString (fn s => title := SOME s)),
+        (Normal, "gray", " {false|true}", "gray nodes according to stack %",
+         boolRef gray),
+        (Normal, "keep", " <exp>", "which functions to display",
+         SpaceString (fn s =>
+                      keep := NodePred.fromString s
+                      handle e => usage (concat ["invalid -keep arg: ",
+                                                 Exn.toString e]))),
+        (Expert, "long-name", " {true|false}",
+         " show long names of functions",
+         boolRef longName),
+        (Normal, "mlmon", " <file>", "process mlmon files listed in <file>",
+         SpaceString (fn s =>
+                      mlmonFiles :=
+                      List.concat [String.tokens (File.contents s, Char.isSpace),
+                                   !mlmonFiles])),
+        (Normal, "raw", " {false|true}", "show raw counts",
+         boolRef raw),
+        (Normal, "show-line", " {false|true}", "show line numbers",
+         boolRef showLine),
+        (Normal, "split", " <regexp>", "split matching functions",
+         SpaceString (fn s =>
+                      case Regexp.fromString s of
+                         NONE => usage (concat ["invalid -split regexp: ", s])
+                       | SOME (r, _) => splitReg := Regexp.or [r, !splitReg])),
+        (Normal, "thresh", " [0.0,100.0]", "-keep (thresh x)",
+         Real (fn x => if x < 0.0 orelse x > 100.0
+                         then usage "invalid -thresh"
+                      else keep := NodePred.Atomic (Atomic.Thresh x))),
+        (Normal, "tolerant", " {false|true}", "ignore broken mlmon files",
+         boolRef tolerant)],
        fn (style, name, arg, desc, opt) =>
        {arg = arg, desc = desc, name = name, opt = opt, style = style})
    end
@@ -1007,8 +1008,8 @@
 val mainUsage = "mlprof [option ...] a.out [mlmon.out ...]"
 val {parse, usage} =
    Popt.makeUsage {mainUsage = mainUsage,
-		   makeOptions = makeOptions,
-		   showExpert = fn () => false}
+                   makeOptions = makeOptions,
+                   showExpert = fn () => false}
 
 val die = Process.fail
    
@@ -1017,50 +1018,50 @@
       val rest = parse args
     in
        case rest of
-	  Result.No msg => usage msg
-	| Result.Yes (afile :: files) =>
-	     let
-		val mlmonFiles = files @ !mlmonFiles 
-		val aInfo =
-		   AFile.new {afile = afile}
-		   handle e => die (concat ["Error in ", afile, ": ",
-					    Exn.toString e])
-		val _ =
-		   if debug
-		      then
-			 (print "AFile:\n"
-			  ; Layout.outputl (AFile.layout aInfo, Out.standard))
-		   else ()
-		val profFile =
-		   List.fold
-		   (mlmonFiles, ProfFile.empty aInfo,
-		    fn (mlmonfile, profFile) =>
-		    ProfFile.merge
-		    (profFile, ProfFile.new {mlmonfile = mlmonfile})
-		    handle e =>
-		       let
-			  val msg =
-			     concat ["error in ", mlmonfile, ": ",
-				     Exn.toString e]
-		       in
-			  if !tolerant
-			     then
-				(Out.outputl (Out.error, msg)
-				 ; profFile)
-			  else die msg
-		       end)
-		val _ =
-		   if debug
-		      then
-			 (print "ProfFile:\n"
-			  ; Layout.outputl (ProfFile.layout profFile,
-					    Out.standard))
-		   else ()
-		val _ = display (aInfo, profFile)
-	     in
-		()
-	     end
-	| Result.Yes _ => usage "wrong number of args"
+          Result.No msg => usage msg
+        | Result.Yes (afile :: files) =>
+             let
+                val mlmonFiles = files @ !mlmonFiles 
+                val aInfo =
+                   AFile.new {afile = afile}
+                   handle e => die (concat ["Error in ", afile, ": ",
+                                            Exn.toString e])
+                val _ =
+                   if debug
+                      then
+                         (print "AFile:\n"
+                          ; Layout.outputl (AFile.layout aInfo, Out.standard))
+                   else ()
+                val profFile =
+                   List.fold
+                   (mlmonFiles, ProfFile.empty aInfo,
+                    fn (mlmonfile, profFile) =>
+                    ProfFile.merge
+                    (profFile, ProfFile.new {mlmonfile = mlmonfile})
+                    handle e =>
+                       let
+                          val msg =
+                             concat ["error in ", mlmonfile, ": ",
+                                     Exn.toString e]
+                       in
+                          if !tolerant
+                             then
+                                (Out.outputl (Out.error, msg)
+                                 ; profFile)
+                          else die msg
+                       end)
+                val _ =
+                   if debug
+                      then
+                         (print "ProfFile:\n"
+                          ; Layout.outputl (ProfFile.layout profFile,
+                                            Out.standard))
+                   else ()
+                val _ = display (aInfo, profFile)
+             in
+                ()
+             end
+        | Result.Yes _ => usage "wrong number of args"
    end
 
 val main = Process.makeMain commandLine

Modified: mlton/branches/on-20050420-cmm-branch/mlprof/mlprof.cm
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlprof/mlprof.cm	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlprof/mlprof.cm	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,8 +1,8 @@
-(* Copyright (C) 2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 2004-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 Group is

Modified: mlton/branches/on-20050420-cmm-branch/mlprof/mlprof.mlb
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlprof/mlprof.mlb	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlprof/mlprof.mlb	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,5 +1,12 @@
+(* Copyright (C) 2004-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 local
-  sources.mlb
+   sources.mlb
 in
-  call-main.sml
+   call-main.sml
 end

Modified: mlton/branches/on-20050420-cmm-branch/mlprof/sources.cm
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlprof/sources.cm	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlprof/sources.cm	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,9 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 Group

Modified: mlton/branches/on-20050420-cmm-branch/mlprof/sources.mlb
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlprof/sources.mlb	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlprof/sources.mlb	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,7 +1,14 @@
+(* Copyright (C) 2004-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 local
-  ../lib/mlton/sources.mlb
-  main.sml
+   ../lib/mlton/sources.mlb
+   main.sml
 in
-  structure Main
+   structure Main
 end
 


Property changes on: mlton/branches/on-20050420-cmm-branch/mlton
___________________________________________________________________
Name: svn:ignore
   - mlton-compile
mlton.sml
upgrade-basis.sml
   + mlton-compile
mlton.sml
upgrade-basis.sml


Deleted: mlton/branches/on-20050420-cmm-branch/mlton/.cvsignore
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/.cvsignore	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/.cvsignore	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +0,0 @@
-mlton-compile
-mlton.sml
-upgrade-basis.sml

Copied: mlton/branches/on-20050420-cmm-branch/mlton/.ignore (from rev 4358, mlton/trunk/mlton/.ignore)

Modified: mlton/branches/on-20050420-cmm-branch/mlton/Makefile
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/Makefile	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/Makefile	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,6 +1,16 @@
+## Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ #    Jagannathan, and Stephen Weeks.
+ # Copyright (C) 1997-2000 NEC Research Institute.
+ #
+ # MLton is released under a BSD-style license.
+ # See the file MLton-LICENSE for details.
+ ##
+
 SRC = $(shell cd .. && pwd)
 BUILD = $(SRC)/build
 BIN = $(BUILD)/bin
+HOST_ARCH = $(shell $(SRC)/bin/host-arch)
+HOST_OS = $(shell $(SRC)/bin/host-os)
 LIB = $(BUILD)/lib
 MLTON = mlton
 TARGET = self
@@ -13,18 +23,24 @@
 ifeq (self, $(shell if [ -x $(BIN)/mlton ]; then echo self; fi))
   # We're compiling MLton with itself, so don't use any stubs.
   FILE = mlton.mlb
-  FLAGS += -default-ann 'sequenceUnit true'
+  FLAGS += -default-ann 'sequenceNonUnit warn'
+  FLAGS += -default-ann 'warnUnused true'
 else
-ifeq (cygwin, $(shell $(SRC)/bin/host-os))
+ifeq (cygwin, $(HOST_OS))
   # The stubs don't work on Cygwin, since they define spawn in terms of
   # fork, and fork doesn't work on Cygwin.  So, make without the stubs.
   FILE = mlton.cm
 else
+ifeq (mingw, $(HOST_OS))
+  # Ditto for MinGW.
+  FILE = mlton.cm
+else
   # We're compiling MLton with an older version of itself, so use the stubs for
   # the MLton structure.
   FILE = mlton-stubs.cm
 endif
 endif
+endif
 
 ifeq (new,$(shell PATH=$(BIN):$$PATH; mlton -target self >/dev/null 2>&1 && echo new))
   FLAGS += -target $(TARGET)
@@ -52,20 +68,25 @@
 .PHONY: all
 all: $(AOUT)
 
-front-end/ml.lex.sml front-end/ml.grm.sig front-end/ml.grm.sml front-end/mlb.lex.sml front-end/mlb.grm.sig front-end/mlb.grm.sml:
-	$(MAKE) -C front-end
+front-end/ml.lex.sml: front-end/ml.lex
+	$(MAKE) -C front-end ml.lex.sml
+front-end/ml.grm.sig front-end/ml.grm.sml: front-end/ml.grm
+	$(MAKE) -C front-end ml.grm.sig ml.grm.sml
+front-end/mlb.lex.sml: front-end/mlb.lex
+	$(MAKE) -C front-end mlb.lex.sml
+front-end/mlb.grm.sig front-end/mlb.grm.sml: front-end/mlb.grm
+	$(MAKE) -C front-end mlb.grm.sig mlb.grm.sml
 
 $(AOUT): $(SOURCES)
 	rm -f $(UP)
 	$(MAKE) $(UP)
 	@echo 'Compiling mlton (takes a while)'
 	mlton $(FLAGS) $(FILE)
-	size $(AOUT)
 
 #! Pass $(PATH) to upgrade-basis because it is run via #!/usr/bin/env
 # bash, which resets the path.
 $(UP):
-	$(SRC)/bin/upgrade-basis "$(PATH)" >$(UP)
+	$(SRC)/bin/upgrade-basis "$(PATH)" "$(HOST_ARCH)" "$(HOST_OS)" >$(UP)
 
 mlton.sml: $(SOURCES)
 	rm -f mlton.sml && mlton -stop sml mlton.cm && chmod -w mlton.sml
@@ -81,22 +102,14 @@
 # Manager (CM) installed.  You may need to replace the following with
 # 'sml-cm'.
 #
-SMLNJ_VERSION = 110.4[59]
 SML	= sml
 
-.PHONY: check-nj-version
-check-nj-version:
-	if ! echo | $(SML) | grep -q $(SMLNJ_VERSION); then	\
-		echo You must use SML/NJ $(SMLNJ_VERSION);	\
-	fi
-
 .PHONY: def-use
 def-use:
 	mlton -stop tc -show-def-use /tmp/z.def-use $(FILE)
 
 .PHONY: nj-mlton
 nj-mlton: $(SOURCES)
-	$(MAKE) check-nj-version
 	(									\
 		echo 'SMLofNJ.Internals.GC.messages false;';			\
 		echo '#set CM.Control.verbose false;';				\
@@ -108,7 +121,6 @@
 
 .PHONY: nj-mlton-dual
 nj-mlton-dual: $(SOURCES)
-	$(MAKE) check-nj-version
 	(									\
 		echo 'SMLofNJ.Internals.GC.messages false;';			\
 		echo '#set CM.Control.verbose false;';				\
@@ -122,7 +134,6 @@
 
 .PHONY: nj-mlton-quad
 nj-mlton-quad: $(SOURCES)
-	$(MAKE) check-nj-version
 	(									\
 		echo 'SMLofNJ.Internals.GC.messages false;';			\
 		echo '#set CM.Control.verbose false;';				\
@@ -138,7 +149,6 @@
 
 .PHONY: nj-whole
 nj-whole: $(SOURCES)
-	$(MAKE) check-nj-version
 	(									\
 		echo 'SMLofNJ.Internals.GC.messages false;';			\
 		echo '#set CM.Control.verbose false;';				\
@@ -157,4 +167,5 @@
 
 .PHONY: warn
 warn:
-	mlton -stop tc -default-ann 'warnUnused true' $(FILE)
+	mlton -stop tc -default-ann 'warnUnused true' $(FILE) \
+		>/tmp/z.warn 2>&1

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ast/admits-equality.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ast/admits-equality.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ast/admits-equality.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,10 @@
+(* Copyright (C) 2003-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 functor AdmitsEquality (S: ADMITS_EQUALITY_STRUCTS): ADMITS_EQUALITY = 
 struct
 

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ast/admits-equality.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ast/admits-equality.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ast/admits-equality.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,10 @@
+(* Copyright (C) 2003-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 signature ADMITS_EQUALITY_STRUCTS = 
    sig
    end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ast/ast-atoms.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ast/ast-atoms.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ast/ast-atoms.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 functor AstAtoms (S: AST_ATOMS_STRUCTS): AST_ATOMS = 
 struct
 
@@ -27,15 +28,15 @@
       open Id
 
       structure P =
-	 PrimTycons (structure AdmitsEquality = AdmitsEquality
-		     structure CharSize = CharSize
-		     structure IntSize = IntSize
-		     structure Kind = Kind
-		     structure RealSize = RealSize
-		     structure WordSize = WordSize
-		     open Id
-		     fun fromString s =
-			Id.fromSymbol (Symbol.fromString s, Region.bogus))
+         PrimTycons (structure AdmitsEquality = AdmitsEquality
+                     structure CharSize = CharSize
+                     structure IntSize = IntSize
+                     structure Kind = Kind
+                     structure RealSize = RealSize
+                     structure WordSize = WordSize
+                     open Id
+                     fun fromString s =
+                        Id.fromSymbol (Symbol.fromString s, Region.bogus))
       open P
    end
 
@@ -47,27 +48,27 @@
       open Id
 
       structure P =
-	 PrimCons (open Id
-		   fun fromString s = fromSymbol (Symbol.fromString s,
-						  Region.bogus))
+         PrimCons (open Id
+                   fun fromString s = fromSymbol (Symbol.fromString s,
+                                                  Region.bogus))
 
       open P
 
       val it = fromSymbol (Symbol.itt, Region.bogus)
 
       fun ensure oper c =
-	 if List.exists ([cons, falsee, it, nill, reff, truee],
-			 fn c' => equals (c, c'))
-	    then 
-	       let
-		  open Layout
-	       in
-		  Control.error (region c,
-				 seq [str (concat ["can not ", oper, " "]),
-				      layout c],
-				 empty)
-	       end
-	 else ()
+         if List.exists ([cons, falsee, it, nill, reff, truee],
+                         fn c' => equals (c, c'))
+            then 
+               let
+                  open Layout
+               in
+                  Control.error (region c,
+                                 seq [str (concat ["can not ", oper, " "]),
+                                      layout c],
+                                 empty)
+               end
+         else ()
 
       val ensureRedefine = ensure "redefine"
 
@@ -83,16 +84,16 @@
    struct
       structure I = AstId (structure Symbol = Symbol)
       open I
-	 
+         
       fun fromCon c = fromSymbol (Con.toSymbol c, Con.region c)
       fun fromVar x = fromSymbol (Var.toSymbol x, Var.region x)
       local
-	 fun make f v = f (toSymbol v, region v)
+         fun make f v = f (toSymbol v, region v)
       in
-	 val toCon = make Con.fromSymbol
-	 val toVar = make Var.fromSymbol
-	 val toFctid = make Fctid.fromSymbol
-	 val toStrid = make Strid.fromSymbol
+         val toCon = make Con.fromSymbol
+         val toVar = make Var.fromSymbol
+         val toFctid = make Fctid.fromSymbol
+         val toStrid = make Strid.fromSymbol
       end
       val bind = fromCon Con.bind
       val cons = fromCon Con.cons
@@ -106,9 +107,9 @@
 structure Longtycon =
    struct
       structure T = Longid (structure Id = Tycon
-			    structure Strid = Strid
-			    structure Symbol = Symbol)
-			    
+                            structure Strid = Strid
+                            structure Symbol = Symbol)
+                            
       open T
 
       val arrow = short Tycon.arrow
@@ -117,46 +118,46 @@
    end
 
 structure Longvar = Longid (structure Id = Var
-			    structure Strid = Strid
-			    structure Symbol = Symbol)
-			   
+                            structure Strid = Strid
+                            structure Symbol = Symbol)
+                           
 structure Longcon =
    struct
       structure L = Longid (structure Id = Con
-			    structure Strid = Strid
-			    structure Symbol = Symbol)
-			   
+                            structure Strid = Strid
+                            structure Symbol = Symbol)
+                           
       open L
    end
 
 structure Longstrid = Longid (structure Id = Strid
-			      structure Strid = Strid
-			      structure Symbol = Symbol)
-			     
+                              structure Strid = Strid
+                              structure Symbol = Symbol)
+                             
 
 structure Longvid =
    struct
       structure L = Longid (structure Id = Vid
-			    structure Strid = Strid
-			    structure Symbol = Symbol)
-			   
+                            structure Strid = Strid
+                            structure Symbol = Symbol)
+                           
       open L
       fun fromLongcon (c: Longcon.t): t =
-	 let
-	    val (strids, id) = Longcon.split c
-	 in
-	    makeRegion (T {strids = strids, id = Vid.fromCon id},
-			Longcon.region c)
-	 end
+         let
+            val (strids, id) = Longcon.split c
+         in
+            makeRegion (T {strids = strids, id = Vid.fromCon id},
+                        Longcon.region c)
+         end
       local
-	 fun to (make,node, conv) x =
-	    let val (T {strids, id}, region) = dest x
-	    in make (node {strids = strids, id =  conv id}, region)
-	    end
+         fun to (make,node, conv) x =
+            let val (T {strids, id}, region) = dest x
+            in make (node {strids = strids, id =  conv id}, region)
+            end
       in
-	 val toLongvar = to (Longvar.makeRegion, Longvar.T, Vid.toVar)
-	 val toLongcon = to (Longcon.makeRegion, Longcon.T, Vid.toCon)
-	 val toLongstrid = to (Longstrid.makeRegion, Longstrid.T, Vid.toStrid)
+         val toLongvar = to (Longvar.makeRegion, Longvar.T, Vid.toVar)
+         val toLongcon = to (Longcon.makeRegion, Longcon.T, Vid.toCon)
+         val toLongstrid = to (Longstrid.makeRegion, Longstrid.T, Vid.toStrid)
       end
 
       val bind = short Vid.bind
@@ -171,49 +172,49 @@
 open Layout
 
 fun reportDuplicates (v: 'a vector,
-		      {equals: 'a * 'a -> bool,
-		       layout: 'a -> Layout.t,
-		       name: string,
-		       region: 'a -> Region.t,
-		       term: unit -> Layout.t}) =
+                      {equals: 'a * 'a -> bool,
+                       layout: 'a -> Layout.t,
+                       name: string,
+                       region: 'a -> Region.t,
+                       term: unit -> Layout.t}) =
    Vector.foreachi
    (v, fn (i, a) =>
     let
        fun loop i' =
-	  if i = i'
-	     then ()
-	  else
-	     if not (equals (a, Vector.sub (v, i')))
-		then loop (i' + 1)
-	     else
-		let
-		   open Layout
-		in
-		   Control.error
-		   (region a,
-		    seq [str (concat ["duplicate ", name, ": "]), layout a],
-		    seq [str "in: ", term ()])
-		end
+          if i = i'
+             then ()
+          else
+             if not (equals (a, Vector.sub (v, i')))
+                then loop (i' + 1)
+             else
+                let
+                   open Layout
+                in
+                   Control.error
+                   (region a,
+                    seq [str (concat ["duplicate ", name, ": "]), layout a],
+                    seq [str "in: ", term ()])
+                end
     in
        loop 0
     end)
 
 fun reportDuplicateFields (v: (Field.t * 'a) vector,
-			   {region: Region.t,
-			    term: unit -> Layout.t}): unit =
+                           {region: Region.t,
+                            term: unit -> Layout.t}): unit =
    reportDuplicates (v,
-		     {equals = fn ((f, _), (f', _)) => Field.equals (f, f'),
-		      layout = Field.layout o #1,
-		      name = "label",
-		      region = fn _ => region,
-		      term = term})
+                     {equals = fn ((f, _), (f', _)) => Field.equals (f, f'),
+                      layout = Field.layout o #1,
+                      name = "label",
+                      region = fn _ => region,
+                      term = term})
 
 structure Type =
    struct
       structure Record = SortedRecord
       open Wrap
       datatype node =
-	 Con of Longtycon.t * t vector
+         Con of Longtycon.t * t vector
        | Record of node Wrap.t Record.t (* kit barfs on t Record.t *)
        | Var of Tyvar.t
       withtype t = node Wrap.t
@@ -227,81 +228,81 @@
       val unit = tuple (Vector.new0 ())
 
       fun con (c: Tycon.t, ts: t vector): t =
-	 if Tycon.equals (c, Tycon.tuple)
-	    then tuple ts
-	 else make (Con (Longtycon.short c, ts))
+         if Tycon.equals (c, Tycon.tuple)
+            then tuple ts
+         else make (Con (Longtycon.short c, ts))
 
       fun arrow (t1, t2) = con (Tycon.arrow, Vector.new2 (t1, t2))
 
       val exn = con (Tycon.exn, Vector.new0 ())
 
       fun layoutApp (tycon, args: 'a vector, layoutArg) =
-	 case Vector.length args of
-	    0 => tycon
-	  | 1 => seq [layoutArg (Vector.sub (args, 0)), str " ", tycon]
-	  | _ => seq [Vector.layout layoutArg args, str " ", tycon]
-	       
+         case Vector.length args of
+            0 => tycon
+          | 1 => seq [layoutArg (Vector.sub (args, 0)), str " ", tycon]
+          | _ => seq [Vector.layout layoutArg args, str " ", tycon]
+               
       fun layout ty =
-	 case node ty of
-	    Var v => Tyvar.layout v
-	  | Con (c, tys) =>
-	       if Longtycon.equals (c, Longtycon.arrow)
-		  then if 2 = Vector.length tys
-			  then
-			     paren (mayAlign
-				    [layout (Vector.sub (tys, 0)),
-				     seq [str "-> ",
-					  layout (Vector.sub (tys, 1))]])
-		       else Error.bug "non-binary -> tyc"
-	       else layoutApp (Longtycon.layout c, tys, layout)
-	  | Record r => Record.layout {record = r,
-				       separator = ":", extra = "",
-				       layoutElt = layout,
-				       layoutTuple = layoutTupleTy}
+         case node ty of
+            Var v => Tyvar.layout v
+          | Con (c, tys) =>
+               if Longtycon.equals (c, Longtycon.arrow)
+                  then if 2 = Vector.length tys
+                          then
+                             paren (mayAlign
+                                    [layout (Vector.sub (tys, 0)),
+                                     seq [str "-> ",
+                                          layout (Vector.sub (tys, 1))]])
+                       else Error.bug "AstAtoms.Type.layout: non-binary -> tyc"
+               else layoutApp (Longtycon.layout c, tys, layout)
+          | Record r => Record.layout {record = r,
+                                       separator = ":", extra = "",
+                                       layoutElt = layout,
+                                       layoutTuple = layoutTupleTy}
       and layoutTupleTy tys =
-	 case Vector.length tys of
-	    0 => str "unit"
-	  | 1 => layout (Vector.sub (tys, 0))
-	  | _ => paren (mayAlign (separateLeft (Vector.toListMap (tys, layout),
-						"* ")))
-	       
+         case Vector.length tys of
+            0 => str "unit"
+          | 1 => layout (Vector.sub (tys, 0))
+          | _ => paren (mayAlign (separateLeft (Vector.toListMap (tys, layout),
+                                                "* ")))
+               
       fun layoutOption ty =
-	 case ty of
-	    NONE => empty
-	  | SOME ty => seq [str " of ", layout ty]
+         case ty of
+            NONE => empty
+          | SOME ty => seq [str " of ", layout ty]
 
       fun checkSyntax (t: t): unit =
-	 case node t of
-	    Con (_, ts) => Vector.foreach (ts, checkSyntax)
-	  | Record r =>
-	       (reportDuplicateFields (Record.toVector r,
-				       {region = region t,
-					term = fn () => layout t})
-		; Record.foreach (r, checkSyntax))
-	  | Var _ => ()
+         case node t of
+            Con (_, ts) => Vector.foreach (ts, checkSyntax)
+          | Record r =>
+               (reportDuplicateFields (Record.toVector r,
+                                       {region = region t,
+                                        term = fn () => layout t})
+                ; Record.foreach (r, checkSyntax))
+          | Var _ => ()
    end
 
 fun bind (x, y) = mayAlign [seq [x, str " ="], y]
 
 fun 'a layoutAnds (prefix: string,
-		   xs: 'a vector, 
-		   layoutX: Layout.t * 'a -> Layout.t): Layout.t =
+                   xs: 'a vector, 
+                   layoutX: Layout.t * 'a -> Layout.t): Layout.t =
    case Vector.toList xs of
       [] => empty
     | x :: xs => align (layoutX (str (concat [prefix, " "]), x)
-			:: List.map (xs, fn x => layoutX (str "and ", x)))
+                        :: List.map (xs, fn x => layoutX (str "and ", x)))
 
 datatype bindStyle = OneLine | Split of int
 
 fun 'a layoutBind (bind: string,
-		   layout: 'a -> bindStyle * Layout.t * Layout.t)
+                   layout: 'a -> bindStyle * Layout.t * Layout.t)
    (prefix: Layout.t, x: 'a): Layout.t =
    let
       val (style, lhs, rhs) = layout x
       val lhs = seq [prefix, lhs, str " " , str bind]
    in
       case style of
-	 OneLine => seq [lhs, str " ", rhs]
+         OneLine => seq [lhs, str " ", rhs]
        | Split indentation => align [lhs, indent (rhs, indentation)]
    end
 
@@ -315,42 +316,42 @@
 structure TypBind =
    struct
       datatype node =
-	 T of {tycon: Tycon.t,
-	       def: Type.t,
-	       tyvars: Tyvar.t vector} vector
+         T of {tycon: Tycon.t,
+               def: Type.t,
+               tyvars: Tyvar.t vector} vector
       open Wrap
       type t = node Wrap.t
       type node' = node
       type obj = t
 
       fun layout t =
-	 let
-	    val T ds = node t
-	 in
-	    layoutAndsBind
-	    ("type", "=", ds, fn {tycon, def, tyvars} =>
-	     (OneLine,
-	      Type.layoutApp (Tycon.layout tycon,
-			      tyvars,
-			      Tyvar.layout),
-	      Type.layout def))
-	 end
+         let
+            val T ds = node t
+         in
+            layoutAndsBind
+            ("type", "=", ds, fn {tycon, def, tyvars} =>
+             (OneLine,
+              Type.layoutApp (Tycon.layout tycon,
+                              tyvars,
+                              Tyvar.layout),
+              Type.layout def))
+         end
       
       val empty = makeRegion (T (Vector.new0 ()), Region.bogus)
 
       fun checkSyntax (b: t): unit =
-	 let
-	    val T v = node b
-	    val () = Vector.foreach (v, fn {def, ...} => Type.checkSyntax def)
-	 in
-	    reportDuplicates
-	    (v, {equals = (fn ({tycon = t, ...}, {tycon = t', ...}) =>
-			   Tycon.equals (t, t')),
-		 layout = Tycon.layout o #tycon,
-		 name = "type definition",
-		 region = Tycon.region o #tycon,
-		 term = fn () => layout b})
-	 end
+         let
+            val T v = node b
+            val () = Vector.foreach (v, fn {def, ...} => Type.checkSyntax def)
+         in
+            reportDuplicates
+            (v, {equals = (fn ({tycon = t, ...}, {tycon = t', ...}) =>
+                           Tycon.equals (t, t')),
+                 layout = Tycon.layout o #tycon,
+                 name = "type definition",
+                 region = Tycon.region o #tycon,
+                 term = fn () => layout b})
+         end
    end
 
 (*---------------------------------------------------*)
@@ -360,94 +361,94 @@
 structure DatBind =
    struct
       datatype node =
-	 T of {datatypes: {cons: (Con.t * Type.t option) vector,
-			   tycon: Tycon.t,
-			   tyvars: Tyvar.t vector} vector,
-	       withtypes: TypBind.t}
+         T of {datatypes: {cons: (Con.t * Type.t option) vector,
+                           tycon: Tycon.t,
+                           tyvars: Tyvar.t vector} vector,
+               withtypes: TypBind.t}
 
       open Wrap
       type t = node Wrap.t
       type node' = node
       type obj = t
-	 
+         
       fun layout (prefix, d) =
-	 let
-	    val T {datatypes, withtypes} = node d
-	 in
-	    align
-	    [layoutAndsBind
-	     (prefix, "=", datatypes, fn {tyvars, tycon, cons} =>
-	      (OneLine,
-	       Type.layoutApp (Tycon.layout tycon, tyvars, Tyvar.layout),
-	       alignPrefix (Vector.toListMap (cons, fn (c, to) =>
-					      seq [Con.layout c,
-						   Type.layoutOption to]),
-			   "| "))),
-	     case TypBind.node withtypes of
-		TypBind.T v =>
-		   if 0 = Vector.length v
-		      then empty
-		   else seq [str "with", TypBind.layout withtypes]]
-	 end
+         let
+            val T {datatypes, withtypes} = node d
+         in
+            align
+            [layoutAndsBind
+             (prefix, "=", datatypes, fn {tyvars, tycon, cons} =>
+              (OneLine,
+               Type.layoutApp (Tycon.layout tycon, tyvars, Tyvar.layout),
+               alignPrefix (Vector.toListMap (cons, fn (c, to) =>
+                                              seq [Con.layout c,
+                                                   Type.layoutOption to]),
+                           "| "))),
+             case TypBind.node withtypes of
+                TypBind.T v =>
+                   if 0 = Vector.length v
+                      then empty
+                   else seq [str "with", TypBind.layout withtypes]]
+         end
 
       fun checkSyntax (b: t): unit =
-	 let
-	    val T {datatypes, withtypes} = node b
-	    val () =
-	       Vector.foreach
-	       (datatypes, fn {cons, ...} =>
-		Vector.foreach (cons, fn (c, to) =>
-				(Con.ensureRedefine c
-				 ; Option.app (to, Type.checkSyntax))))
-	    fun term () = layout ("datatype", b)
-	    val () =
-	       reportDuplicates
-	       (Vector.concatV (Vector.map (datatypes, #cons)),
-		{equals = fn ((c, _), (c', _)) => Con.equals (c, c'),
-		 layout = Con.layout o #1,
-		 name = "constructor",
-		 region = Con.region o #1,
-		 term = term})
-	    val () =
-	       reportDuplicates
-	       (Vector.concat [Vector.map (datatypes, #tycon),
-			       let
-				  val TypBind.T v = TypBind.node withtypes
-			       in
-				  Vector.map (v, #tycon)
-			       end],
-		{equals = Tycon.equals,
-		 layout = Tycon.layout,
-		 name = "type definition",
-		 region = Tycon.region,
-		 term = term})
-	 in
-	    ()
-	 end
+         let
+            val T {datatypes, withtypes} = node b
+            val () =
+               Vector.foreach
+               (datatypes, fn {cons, ...} =>
+                Vector.foreach (cons, fn (c, to) =>
+                                (Con.ensureRedefine c
+                                 ; Option.app (to, Type.checkSyntax))))
+            fun term () = layout ("datatype", b)
+            val () =
+               reportDuplicates
+               (Vector.concatV (Vector.map (datatypes, #cons)),
+                {equals = fn ((c, _), (c', _)) => Con.equals (c, c'),
+                 layout = Con.layout o #1,
+                 name = "constructor",
+                 region = Con.region o #1,
+                 term = term})
+            val () =
+               reportDuplicates
+               (Vector.concat [Vector.map (datatypes, #tycon),
+                               let
+                                  val TypBind.T v = TypBind.node withtypes
+                               in
+                                  Vector.map (v, #tycon)
+                               end],
+                {equals = Tycon.equals,
+                 layout = Tycon.layout,
+                 name = "type definition",
+                 region = Tycon.region,
+                 term = term})
+         in
+            ()
+         end
    end
 
 structure DatatypeRhs =
    struct
       datatype node =
-	 DatBind of DatBind.t
+         DatBind of DatBind.t
        | Repl of {lhs: Tycon.t, rhs: Longtycon.t}
 
       open Wrap
       type t = node Wrap.t
       type node' = node
       type obj = t
-	 
+         
       fun layout d =
-	 case node d of
-	    DatBind d => DatBind.layout ("datatype", d)
-	  | Repl {lhs, rhs} =>
-	       seq [str "datatype ", Tycon.layout lhs,
-		   str " = datatype ", Longtycon.layout rhs]
+         case node d of
+            DatBind d => DatBind.layout ("datatype", d)
+          | Repl {lhs, rhs} =>
+               seq [str "datatype ", Tycon.layout lhs,
+                   str " = datatype ", Longtycon.layout rhs]
 
       fun checkSyntax (rhs: t): unit =
-	 case node rhs of
-	    DatBind b => DatBind.checkSyntax b
-	  | Repl _ => ()
+         case node rhs of
+            DatBind b => DatBind.checkSyntax b
+          | Repl _ => ()
    end
 
 (*---------------------------------------------------*)
@@ -457,7 +458,7 @@
 structure ModIdBind =
    struct
       datatype node =
-	 Fct of {lhs: Fctid.t, rhs: Fctid.t} vector
+         Fct of {lhs: Fctid.t, rhs: Fctid.t} vector
        | Sig of {lhs: Sigid.t, rhs: Sigid.t} vector
        | Str of {lhs: Strid.t, rhs: Strid.t} vector
 
@@ -467,43 +468,43 @@
       type obj = t
 
       fun layout d =
-	 let
-	    fun doit (prefix, l, bds) =
-	       layoutAndsBind
-	       (prefix, "=", bds, fn {lhs, rhs} => (OneLine, l lhs, l rhs))
-	 in
-	    case node d of
-	       Fct bds => doit ("functor", Fctid.layout, bds)
-	     | Sig bds => doit ("signature", Sigid.layout, bds)
-	     | Str bds => doit ("structure", Strid.layout, bds)
-	 end
+         let
+            fun doit (prefix, l, bds) =
+               layoutAndsBind
+               (prefix, "=", bds, fn {lhs, rhs} => (OneLine, l lhs, l rhs))
+         in
+            case node d of
+               Fct bds => doit ("functor", Fctid.layout, bds)
+             | Sig bds => doit ("signature", Sigid.layout, bds)
+             | Str bds => doit ("structure", Strid.layout, bds)
+         end
 
       fun checkSyntax d =
-	 let
-	    fun doit (bds : {lhs: 'a, rhs: 'a} Vector.t, 
-		      {equalsId, layoutId, regionId, name}) =
-	       reportDuplicates
-	       (bds, {equals = (fn ({lhs = id, ...}, {lhs = id', ...}) =>
-				equalsId (id, id')),
-		      layout = layoutId o #lhs,
-		      name = concat [name, " definition"],
-		      region = regionId o #lhs,
-		      term = fn () => layout d})
-	 in
-	    case node d of
-	       Fct bds => doit (bds, {equalsId = Fctid.equals, 
-				      layoutId = Fctid.layout,
-				      regionId = Fctid.region, 
-				      name = "functor"})
-	     | Sig bds => doit (bds, {equalsId = Sigid.equals, 
-				      layoutId = Sigid.layout,
-				      regionId = Sigid.region, 
-				      name = "signature"})
-	     | Str bds => doit (bds, {equalsId = Strid.equals, 
-				      layoutId = Strid.layout,
-				      regionId = Strid.region, 
-				      name = "structure"})
-	 end
+         let
+            fun doit (bds : {lhs: 'a, rhs: 'a} Vector.t, 
+                      {equalsId, layoutId, regionId, name}) =
+               reportDuplicates
+               (bds, {equals = (fn ({lhs = id, ...}, {lhs = id', ...}) =>
+                                equalsId (id, id')),
+                      layout = layoutId o #lhs,
+                      name = concat [name, " definition"],
+                      region = regionId o #lhs,
+                      term = fn () => layout d})
+         in
+            case node d of
+               Fct bds => doit (bds, {equalsId = Fctid.equals, 
+                                      layoutId = Fctid.layout,
+                                      regionId = Fctid.region, 
+                                      name = "functor"})
+             | Sig bds => doit (bds, {equalsId = Sigid.equals, 
+                                      layoutId = Sigid.layout,
+                                      regionId = Sigid.region, 
+                                      name = "signature"})
+             | Str bds => doit (bds, {equalsId = Strid.equals, 
+                                      layoutId = Strid.layout,
+                                      regionId = Strid.region, 
+                                      name = "structure"})
+         end
    end
 
 end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ast/ast-atoms.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ast/ast-atoms.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ast/ast-atoms.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,9 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 type int = Int.t
@@ -25,22 +25,22 @@
       structure Const: AST_CONST
 
       structure Tycon:
-	 sig
-	    include AST_ID
-	    include PRIM_TYCONS sharing type tycon = t
-	 end
+         sig
+            include AST_ID
+            include PRIM_TYCONS sharing type tycon = t
+         end
     
       structure Var: AST_ID
 
       structure Con:
-	 sig
-	    include AST_ID
-	    include PRIM_CONS
-	    sharing type con = t
+         sig
+            include AST_ID
+            include PRIM_CONS
+            sharing type con = t
 
             val ensureRedefine: t -> unit
             val ensureSpecify: t -> unit
-	 end
+         end
 
       structure Basid: AST_ID
       structure Sigid: AST_ID
@@ -48,144 +48,144 @@
       structure Fctid: AST_ID
 
       structure Vid:
-	 sig
-	    include AST_ID
+         sig
+            include AST_ID
 
-	    (* conversions to and from variables and constructors *)
+            (* conversions to and from variables and constructors *)
             val fromVar: Var.t -> t
-	    val fromCon: Con.t -> t
-	    val toVar: t -> Var.t
-	    val toCon: t -> Con.t
-	    val toFctid: t -> Fctid.t
-	 end
+            val fromCon: Con.t -> t
+            val toVar: t -> Var.t
+            val toCon: t -> Con.t
+            val toFctid: t -> Fctid.t
+         end
 
       structure Longtycon:
-	 sig
-	    include LONGID
+         sig
+            include LONGID
             val arrow: t
-	    val exn: t
-	 end sharing Longtycon.Id = Tycon
+            val exn: t
+         end sharing Longtycon.Id = Tycon
 
       structure Longvar: LONGID sharing Longvar.Id = Var
       structure Longcon: LONGID sharing Longcon.Id = Con
       structure Longstrid: LONGID sharing Longstrid.Id = Strid
       structure Longvid:
-	 sig
-	    include LONGID
+         sig
+            include LONGID
 
-	    val bind: t
-	    val cons: t
-	    val falsee: t
-	    val match: t
-	    val nill: t
-	    val reff: t
-	    val truee: t
+            val bind: t
+            val cons: t
+            val falsee: t
+            val match: t
+            val nill: t
+            val reff: t
+            val truee: t
 
-	    val fromLongcon: Longcon.t -> t
-	    val toLongvar: t -> Longvar.t
-	    val toLongcon: t -> Longcon.t
-	    val toLongstrid: t -> Longstrid.t
-	 end sharing Longvid.Id = Vid
+            val fromLongcon: Longcon.t -> t
+            val toLongvar: t -> Longvar.t
+            val toLongcon: t -> Longcon.t
+            val toLongstrid: t -> Longstrid.t
+         end sharing Longvid.Id = Vid
 
       sharing Strid = Longtycon.Strid = Longvar.Strid = Longcon.Strid
-	 = Longvid.Strid = Longstrid.Strid
+         = Longvid.Strid = Longstrid.Strid
 
       sharing Symbol = Basid.Symbol = Con.Symbol = Fctid.Symbol = Longcon.Symbol
-	 = Longstrid.Symbol = Longtycon.Symbol = Longvar.Symbol = Longvid.Symbol
-	 = Sigid.Symbol = Strid.Symbol = Tycon.Symbol = Vid.Symbol = Var.Symbol
+         = Longstrid.Symbol = Longtycon.Symbol = Longvar.Symbol = Longvid.Symbol
+         = Sigid.Symbol = Strid.Symbol = Tycon.Symbol = Vid.Symbol = Var.Symbol
 
       structure Type:
-	 sig
-	    type t
-	    datatype node =
-	       Con of Longtycon.t * t vector
-	     | Record of t SortedRecord.t
-	     | Var of Tyvar.t
+         sig
+            type t
+            datatype node =
+               Con of Longtycon.t * t vector
+             | Record of t SortedRecord.t
+             | Var of Tyvar.t
 
-	    include WRAPPED sharing type node' = node
-			    sharing type obj = t
+            include WRAPPED sharing type node' = node
+                            sharing type obj = t
 
-	    val arrow: t * t -> t
-	    val checkSyntax: t -> unit
-	    val con: Tycon.t * t vector -> t
-	    val exn:  t
-	    val layout: t -> Layout.t
-	    val layoutApp: Layout.t * 'a vector * ('a -> Layout.t) -> Layout.t
-	    val layoutOption: t option -> Layout.t
-	    val record: t SortedRecord.t -> t
-	    val tuple: t vector -> t
-	    val unit: t
-	    val var: Tyvar.t -> t
-	 end
+            val arrow: t * t -> t
+            val checkSyntax: t -> unit
+            val con: Tycon.t * t vector -> t
+            val exn:  t
+            val layout: t -> Layout.t
+            val layoutApp: Layout.t * 'a vector * ('a -> Layout.t) -> Layout.t
+            val layoutOption: t option -> Layout.t
+            val record: t SortedRecord.t -> t
+            val tuple: t vector -> t
+            val unit: t
+            val var: Tyvar.t -> t
+         end
       structure TypBind:
-	 sig
-	    type t
-	    datatype node = T of {def: Type.t,
-				  tycon: Tycon.t,
-				  tyvars: Tyvar.t vector} vector
-	    include WRAPPED sharing type node' = node
-			    sharing type obj = t
+         sig
+            type t
+            datatype node = T of {def: Type.t,
+                                  tycon: Tycon.t,
+                                  tyvars: Tyvar.t vector} vector
+            include WRAPPED sharing type node' = node
+                            sharing type obj = t
 
             val checkSyntax: t -> unit
             val empty: t
-	    val layout: t -> Layout.t
-	 end
+            val layout: t -> Layout.t
+         end
       structure DatBind:
-	 sig
-	    type t
-	    datatype node =
-	       T of {datatypes: {cons: (Con.t * Type.t option) vector,
-				 tycon: Tycon.t,
-				 tyvars: Tyvar.t vector} vector,
-		     withtypes: TypBind.t}
-	    include WRAPPED sharing type node' = node
-			    sharing type obj = t
+         sig
+            type t
+            datatype node =
+               T of {datatypes: {cons: (Con.t * Type.t option) vector,
+                                 tycon: Tycon.t,
+                                 tyvars: Tyvar.t vector} vector,
+                     withtypes: TypBind.t}
+            include WRAPPED sharing type node' = node
+                            sharing type obj = t
 
             val checkSyntax: t -> unit
-	    val layout: string * t -> Layout.t
-	 end
+            val layout: string * t -> Layout.t
+         end
       structure DatatypeRhs:
-	 sig
-	    type t
-	    datatype node =
-	       DatBind of DatBind.t
-	     | Repl of {lhs: Tycon.t, rhs: Longtycon.t}
-	    include WRAPPED sharing type node' = node
-			    sharing type obj = t
+         sig
+            type t
+            datatype node =
+               DatBind of DatBind.t
+             | Repl of {lhs: Tycon.t, rhs: Longtycon.t}
+            include WRAPPED sharing type node' = node
+                            sharing type obj = t
 
             val checkSyntax: t -> unit
             val layout: t -> Layout.t
-	 end
+         end
       structure ModIdBind:
-	 sig
-	    type t
-	    datatype node = 
-	       Fct of {lhs: Fctid.t, rhs: Fctid.t} vector
-	     | Sig of {lhs: Sigid.t, rhs: Sigid.t} vector
-	     | Str of {lhs: Strid.t, rhs: Strid.t} vector
-	    include WRAPPED sharing type node' = node
-			    sharing type obj = t
+         sig
+            type t
+            datatype node = 
+               Fct of {lhs: Fctid.t, rhs: Fctid.t} vector
+             | Sig of {lhs: Sigid.t, rhs: Sigid.t} vector
+             | Str of {lhs: Strid.t, rhs: Strid.t} vector
+            include WRAPPED sharing type node' = node
+                            sharing type obj = t
 
-	    val checkSyntax: t -> unit
-	    val layout: t -> Layout.t
-	 end
+            val checkSyntax: t -> unit
+            val layout: t -> Layout.t
+         end
 
       val bind: Layout.t * Layout.t -> Layout.t
       val layoutAnds: (string * 'a vector * (Layout.t * 'a -> Layout.t)
-		       -> Layout.t)
+                       -> Layout.t)
       datatype bindStyle =
-	 OneLine
+         OneLine
        | Split of int
       val layoutAndsBind:
-	 string * string * 'a vector * ('a -> bindStyle * Layout.t * Layout.t)
-	 -> Layout.t
+         string * string * 'a vector * ('a -> bindStyle * Layout.t * Layout.t)
+         -> Layout.t
       val reportDuplicates:
-	 'a vector * {equals: 'a * 'a -> bool,
-		      layout: 'a -> Layout.t,
-		      name: string,
-		      region: 'a -> Region.t,
-		      term: unit -> Layout.t} -> unit
+         'a vector * {equals: 'a * 'a -> bool,
+                      layout: 'a -> Layout.t,
+                      name: string,
+                      region: 'a -> Region.t,
+                      term: unit -> Layout.t} -> unit
       val reportDuplicateFields:
-	 (Record.Field.t * 'a) vector * {region: Region.t,
-					 term: unit -> Layout.t} -> unit
+         (Record.Field.t * 'a) vector * {region: Region.t,
+                                         term: unit -> Layout.t} -> unit
    end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ast/ast-const.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ast/ast-const.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ast/ast-const.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,9 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 functor AstConst (S: AST_CONST_STRUCTS): AST_CONST =
@@ -22,26 +22,26 @@
 type node' = node
 type obj = t
 
-val equals = fn _ => Error.unimplemented "Ast.Const.equals"
+val equals = fn _ => Error.unimplemented "AstConst.equals"
 
 fun ordToString (c: IntInf.t): string =
       let
-	 fun loop (n: int, c: IntInf.t, ac: char list) =
-	    if n = 0
-	       then implode ac
-	    else
-	       let
-		  val (q, r) = IntInf.quotRem (c, 0x10)
-	       in
-		  loop (n - 1, q, Char.fromHexDigit (Int.fromIntInf r) :: ac)
-	       end
-	 fun doit (n, esc) = concat ["\\", esc, loop (n, c, [])]
+         fun loop (n: int, c: IntInf.t, ac: char list) =
+            if n = 0
+               then implode ac
+            else
+               let
+                  val (q, r) = IntInf.quotRem (c, 0x10)
+               in
+                  loop (n - 1, q, Char.fromHexDigit (Int.fromIntInf r) :: ac)
+               end
+         fun doit (n, esc) = concat ["\\", esc, loop (n, c, [])]
       in
-	 if c <= 0xFF
-	    then Char.escapeSML (Char.fromInt (Int.fromIntInf c))
-	 else if c <= 0xFFFF
+         if c <= 0xFF
+            then Char.escapeSML (Char.fromInt (Int.fromIntInf c))
+         else if c <= 0xFFFF
             then doit (4, "u")
-	 else doit (8, "U")
+         else doit (8, "U")
       end
 
 local
@@ -49,12 +49,12 @@
 in
    fun layout c =
       case node c of
-	 Bool b => if b then str "true" else str "false"
+         Bool b => if b then str "true" else str "false"
        | Char c => str (concat ["#\"", ordToString c, "\""])
        | Int s => str (IntInf.toString s)
        | Real l => String.layout l
        | String s =>
-	    str (concat ["\"", concat (Vector.toListMap (s, ordToString)), "\""])
+            str (concat ["\"", concat (Vector.toListMap (s, ordToString)), "\""])
        | Word w => str (concat ["0wx", IntInf.format (w, StringCvt.HEX)])
 end
 

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ast/ast-const.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ast/ast-const.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ast/ast-const.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,9 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 signature AST_CONST_STRUCTS =
@@ -16,7 +16,7 @@
 
       type t
       datatype node =
-	 Bool of bool
+         Bool of bool
        | Char of IntInf.t
        | Int of IntInf.t
        | Real of string

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ast/ast-core.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ast/ast-core.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ast/ast-core.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 functor AstCore (S: AST_CORE_STRUCTS): AST_CORE = 
 struct
 
@@ -18,23 +19,23 @@
 structure Fixity =
    struct
       datatype t =
-	 Infix of int option
+         Infix of int option
        | Infixr of int option
        | Nonfix
 
       val bogus = Nonfix
 
       val isInfix =
-	 fn Nonfix => false
-	  | _ => true
-	  
+         fn Nonfix => false
+          | _ => true
+          
       val toString =
-	 fn Infix NONE => "infix"
-	  | Infix (SOME n) => "infix " ^ Int.toString n
-	  | Infixr NONE => "infixr"
-	  | Infixr (SOME n) => "infixr " ^ Int.toString n
-	  | Nonfix => "nonfix"
-	       
+         fn Infix NONE => "infix"
+          | Infix (SOME n) => "infix " ^ Int.toString n
+          | Infixr NONE => "infixr"
+          | Infixr (SOME n) => "infixr " ^ Int.toString n
+          | Nonfix => "nonfix"
+               
       val layout = Layout.str o toString
    end
 
@@ -43,10 +44,10 @@
       datatype t = Op | None
 
       val layout =
-	 fn Op => str "op "
-	  | None => empty
+         fn Op => str "op "
+          | None => empty
    end
-	 
+         
 fun layoutConstraint (t, ty) =
    mayAlign [seq [t, str ":"], Type.layout ty]
    
@@ -57,11 +58,11 @@
 
 fun layoutLongvid x =
    str (let val s = Longvid.toString x
-	in if s = "*" then " * "
-	   else if String.hasSuffix (s, {suffix = "*"})
-		   then s ^ " "
-		else s
-	end)
+        in if s = "*" then " * "
+           else if String.hasSuffix (s, {suffix = "*"})
+                   then s ^ " "
+                else s
+        end)
 
 structure Vector =
    struct
@@ -78,32 +79,32 @@
    struct
       open Wrap
       datatype node =
-	 App of Longcon.t * t
+         App of Longcon.t * t
        | Const of Const.t
        | Constraint of t * Type.t
        | FlatApp of t vector
        | Layered of {fixop: Fixop.t,
-		     var: Var.t,
-		     constraint: Type.t option,
-		     pat: t}
+                     var: Var.t,
+                     constraint: Type.t option,
+                     pat: t}
        | List of t vector
        | Record of {flexible: bool,
-		    items: (Record.Field.t * item) vector}
+                    items: (Record.Field.t * item) vector}
        | Tuple of t vector
        | Var of {fixop: Fixop.t, name: Longvid.t}
        | Wild
       and item =
-	 Field of t
-	| Vid of Vid.t * Type.t option * t option 
+         Field of t
+        | Vid of Vid.t * Type.t option * t option 
       withtype t = node Wrap.t
       type node' = node
       type obj = t
 
       structure Item =
-	 struct
-	    type pat = t
-	    datatype t = datatype item
-	 end
+         struct
+            type pat = t
+            datatype t = datatype item
+         end
 
       fun make n = makeRegion (n, Region.bogus)
 
@@ -118,195 +119,221 @@
       val var = longvid o Longvid.short o Vid.fromVar
 
       fun con c =
-	 if Con.equals (c, Con.nill) then emptyList
-	 else longvid (Longvid.short (Vid.fromCon c))
-		     
+         if Con.equals (c, Con.nill) then emptyList
+         else longvid (Longvid.short (Vid.fromCon c))
+                     
       fun app (c, p) =
-	 let
-	    val default = make (App (Longcon.short c, p))
-	 in
-	    if Con.equals (c, Con.cons)
-	       then
-		  case node p of
-		     Tuple ps =>
-			if 2 = Vector.length ps
-			   then
-			      let
-				 val p0 = Vector.sub (ps, 0)
-				 val p1 = Vector.sub (ps, 1)
-			      in
-				 case node p1 of
-				    List ps => make (List (Vector.cons (p0, ps)))
-				  | _ => default
-			      end
-			else default
-		   | _ => default
-	    else default
-	 end
+         let
+            val default = make (App (Longcon.short c, p))
+         in
+            if Con.equals (c, Con.cons)
+               then
+                  case node p of
+                     Tuple ps =>
+                        if 2 = Vector.length ps
+                           then
+                              let
+                                 val p0 = Vector.sub (ps, 0)
+                                 val p1 = Vector.sub (ps, 1)
+                              in
+                                 case node p1 of
+                                    List ps => make (List (Vector.cons (p0, ps)))
+                                  | _ => default
+                              end
+                        else default
+                   | _ => default
+            else default
+         end
       
       fun tuple ps =
-	 if 1 = Vector.length ps
-	    then Vector.sub (ps, 0)
-	 else make (Tuple ps)
+         if 1 = Vector.length ps
+            then Vector.sub (ps, 0)
+         else make (Tuple ps)
 
       fun layout (p, isDelimited) =
-	 let
-	    fun delimit t = if isDelimited then t else paren t
-	 in
-	    case node p of
-	       App (c, p) => delimit (mayAlign [Longcon.layout c,
-						layoutF p])
-	     | Const c => Const.layout c
-	     | Constraint (p, t) => delimit (layoutConstraint (layoutF p, t))
-	     | FlatApp ps => delimit (layoutFlatApp ps)
-	     | Layered {fixop, var, constraint, pat} =>
-		  delimit
-		  (mayAlign [maybeConstrain
-			     (seq [Fixop.layout fixop, Var.layout var],
-			      constraint),
-			     seq [str "as ", layoutT pat]])
-	     | List ps => list (Vector.toListMap (ps, layoutT))
-	     | Record {items, flexible} =>
-		  seq [str "{",
-		       mayAlign (separateRight
-				 (Vector.toListMap (items, layoutItem), ",")),
-		       if flexible
-			  then str (if Vector.isEmpty items
-				       then "..."
-				    else ", ...")
-		       else empty,
-		       str "}"]
-	     | Tuple ps => Vector.layout layoutT ps
-	     | Var {name, fixop} => seq [Fixop.layout fixop, layoutLongvid name]
-	     | Wild => str "_"
-	 end
+         let
+            fun delimit t = if isDelimited then t else paren t
+         in
+            case node p of
+               App (c, p) => delimit (mayAlign [Longcon.layout c,
+                                                layoutF p])
+             | Const c => Const.layout c
+             | Constraint (p, t) => delimit (layoutConstraint (layoutF p, t))
+             | FlatApp ps => delimit (layoutFlatApp ps)
+             | Layered {fixop, var, constraint, pat} =>
+                  delimit
+                  (mayAlign [maybeConstrain
+                             (seq [Fixop.layout fixop, Var.layout var],
+                              constraint),
+                             seq [str "as ", layoutT pat]])
+             | List ps => list (Vector.toListMap (ps, layoutT))
+             | Record {items, flexible} =>
+                  seq [str "{",
+                       mayAlign (separateRight
+                                 (Vector.toListMap (items, layoutItem), ",")),
+                       if flexible
+                          then str (if Vector.isEmpty items
+                                       then "..."
+                                    else ", ...")
+                       else empty,
+                       str "}"]
+             | Tuple ps => Vector.layout layoutT ps
+             | Var {name, fixop} => seq [Fixop.layout fixop, layoutLongvid name]
+             | Wild => str "_"
+         end
       and layoutF p = layout (p, false)
       and layoutT p = layout (p, true)
       and layoutFlatApp ps = seq (separate (Vector.toListMap (ps, layoutF), " "))
       and layoutItem (f, i) =
-	 seq [Field.layout f,
-	      case i of
-		 Field p => seq [str " = ", layoutT p]
-	       | Vid (_, tyo, po) =>
-		    seq [case tyo of
-			    NONE => empty
-			  | SOME ty => seq [str ": ", Type.layout ty],
+         seq [Field.layout f,
+              case i of
+                 Field p => seq [str " = ", layoutT p]
+               | Vid (_, tyo, po) =>
+                    seq [case tyo of
+                            NONE => empty
+                          | SOME ty => seq [str ": ", Type.layout ty],
                          case po of
-			    NONE => empty
-			  | SOME p => seq [str " as ", layoutT p]]]
+                            NONE => empty
+                          | SOME p => seq [str " as ", layoutT p]]]
 
       val layoutDelimit = layoutF
       val layout = layoutT
 
       fun checkSyntax (p: t): unit =
-	 let
-	    val c = checkSyntax
-	 in
-	    case node p of
-	       App (_, p) => c p
-	     | Const _ => ()
-	     | Constraint (p, t) => (c p; Type.checkSyntax t)
-	     | FlatApp ps => Vector.foreach (ps, c)
-	     | Layered {constraint, pat, ...} =>
-		  (c pat; Option.app (constraint, Type.checkSyntax))
-	     | List ps => Vector.foreach (ps, c)
-	     | Record {items, ...} =>
-		  (Vector.foreach (items, fn (_, i) =>
-				   case i of
-				      Item.Field p => c p
-				    | Item.Vid (_, to, po) =>
-					 (Option.app (to, Type.checkSyntax)
-					  ; Option.app (po, c)))
-		   ; reportDuplicateFields (items,
-					    {region = region p,
-					     term = fn () => layout p}))
-	     | Tuple ps => Vector.foreach (ps, c)
-	     | Var _ => ()
-	     | Wild => ()
-	 end
+         let
+            val c = checkSyntax
+         in
+            case node p of
+               App (_, p) => c p
+             | Const _ => ()
+             | Constraint (p, t) => (c p; Type.checkSyntax t)
+             | FlatApp ps => Vector.foreach (ps, c)
+             | Layered {constraint, pat, ...} =>
+                  (c pat; Option.app (constraint, Type.checkSyntax))
+             | List ps => Vector.foreach (ps, c)
+             | Record {items, ...} =>
+                  (Vector.foreach (items, fn (_, i) =>
+                                   case i of
+                                      Item.Field p => c p
+                                    | Item.Vid (_, to, po) =>
+                                         (Option.app (to, Type.checkSyntax)
+                                          ; Option.app (po, c)))
+                   ; reportDuplicateFields (items,
+                                            {region = region p,
+                                             term = fn () => layout p}))
+             | Tuple ps => Vector.foreach (ps, c)
+             | Var _ => ()
+             | Wild => ()
+         end
    end
 
 structure Eb =
    struct
       structure Rhs =
-	 struct
-	    open Wrap
-	    datatype node =
-	       Def of Longcon.t
-	     | Gen of Type.t option
-	    type t = node Wrap.t
-	    type node' = node
-	    type obj = t
-	 
-	    fun layout rhs =
-	       case node rhs of
-		  Def c => seq [str " = ", Longcon.layout c]
-		| Gen to => Type.layoutOption to
+         struct
+            open Wrap
+            datatype node =
+               Def of Longcon.t
+             | Gen of Type.t option
+            type t = node Wrap.t
+            type node' = node
+            type obj = t
+         
+            fun layout rhs =
+               case node rhs of
+                  Def c => seq [str " = ", Longcon.layout c]
+                | Gen to => Type.layoutOption to
 
-	    fun checkSyntax (e: t): unit =
-	       case node e of
-		  Def _ => ()
-		| Gen to => Option.app (to, Type.checkSyntax)
-	 end
+            fun checkSyntax (e: t): unit =
+               case node e of
+                  Def _ => ()
+                | Gen to => Option.app (to, Type.checkSyntax)
+         end
       
       type t = Con.t * Rhs.t
 
       fun layout (exn, rhs) =
-	 seq [Con.layout exn, Rhs.layout rhs]
+         seq [Con.layout exn, Rhs.layout rhs]
    end
 
 structure EbRhs = Eb.Rhs
 
 structure PrimKind =
    struct
-      structure Attribute =
-	 struct
-	    datatype t = Cdecl | Stdcall
+      structure ImportExportAttribute =
+         struct
+            datatype t = Cdecl | Stdcall
 
-	    val toString: t -> string =
-	       fn Cdecl => "cdecl"
-		| Stdcall => "stdcall"
+            val toString: t -> string =
+               fn Cdecl => "cdecl"
+                | Stdcall => "stdcall"
 
-	    val layout = Layout.str o toString
-	 end
+            val layout = Layout.str o toString
+         end
 
+      structure SymbolAttribute =
+         struct
+            datatype t = Alloc
+
+            val toString: t -> string =
+               fn Alloc => "alloc"
+
+            val layout = Layout.str o toString
+         end
+      
       datatype t =
-	 BuildConst of {name: string}
-       | CommandLineConst of {name: string, value: Const.t}
-       | Const of {name: string}
-       | Export of {attributes: Attribute.t list, name: string}
-       | IImport of {attributes: Attribute.t list}
-       | Import of {attributes: Attribute.t list, name: string}
-       | Symbol of {name: string}
-       | Prim of {name: string}
+         Address of {name: string,
+                     ty: Type.t}
+       | BuildConst of {name: string, 
+                        ty: Type.t}
+       | CommandLineConst of {name: string, 
+                              ty: Type.t,
+                              value: Const.t}
+       | Const of {name: string, 
+                   ty: Type.t}
+       | Export of {attributes: ImportExportAttribute.t list, 
+                    name: string,
+                    ty: Type.t}
+       | IImport of {attributes: ImportExportAttribute.t list,
+                     ty: Type.t}
+       | Import of {attributes: ImportExportAttribute.t list, 
+                    name: string,
+                    ty: Type.t}
+       | ISymbol of {ty: Type.t}
+       | Prim of {name: string, 
+                  ty: Type.t}
+       | Symbol of {attributes: SymbolAttribute.t list, 
+                    name: string,
+                    ty: Type.t}
 
       fun name pk =
-	 case pk of
-	    BuildConst {name, ...} => name
-	  | CommandLineConst {name, ...} => name
-	  | Const {name, ...} => name
-	  | Export {name, ...} => name
-	  | IImport {...} => "<iimport>"
-	  | Import {name, ...} => name
-	  | Symbol {name, ...} => name
-	  | Prim {name, ...} => name
-
+         case pk of
+            Address {name, ...} => name
+          | BuildConst {name, ...} => name
+          | CommandLineConst {name, ...} => name
+          | Const {name, ...} => name
+          | Export {name, ...} => name
+          | IImport {...} => "<iimport>"
+          | Import {name, ...} => name
+          | ISymbol {...} => "<isymbol>"
+          | Prim {name, ...} => name
+          | Symbol {name, ...} => name
    end
 
 structure Priority =
    struct
       datatype t = T of int option
       val op <= = fn (T x, T y) =>
-	 case (x, y) of
-	    (NONE, NONE) => true
-	  | (NONE, _) => true
-	  | (_, NONE) => false
-	  | (SOME x, SOME y) => Int.<= (x, y)
+         case (x, y) of
+            (NONE, NONE) => true
+          | (NONE, _) => true
+          | (_, NONE) => false
+          | (SOME x, SOME y) => Int.<= (x, y)
       val default = T NONE
       fun layout (T x) =
-	 case x of
-	    NONE => Layout.empty
-	  | SOME x => Int.layout x
+         case x of
+            NONE => Layout.empty
+          | SOME x => Int.layout x
    end
 
 datatype expNode =
@@ -328,18 +355,17 @@
   | Andalso of exp * exp
   | Orelse of exp * exp
   | While of {test: exp, expr: exp}
-  | Prim of {kind: PrimKind.t,
-	     ty: Type.t}
+  | Prim of PrimKind.t
 and decNode =
    Abstype of {body: dec,
-	       datBind: DatBind.t}
+               datBind: DatBind.t}
   | Datatype of DatatypeRhs.t
   | Exception of Eb.t vector
   | Fix of {fixity: Fixity.t,
-	    ops: Vid.t vector}
+            ops: Vid.t vector}
   | Fun of Tyvar.t vector * {body: exp,
-			     pats: Pat.t vector,
-			     resultType: Type.t option} vector vector
+                             pats: Pat.t vector,
+                             resultType: Type.t option} vector vector
   | Local of dec * dec
   | Open of Longstrid.t vector
   | Overload of Priority.t * Var.t * 
@@ -348,10 +374,10 @@
   | SeqDec of dec vector
   | Type of TypBind.t
   | Val of {tyvars: Tyvar.t vector,
-	    vbs: {exp: exp,
-		  pat: Pat.t} vector,
-	    rvbs: {match: match,
-		   pat: Pat.t} vector}
+            vbs: {exp: exp,
+                  pat: Pat.t} vector,
+            rvbs: {match: match,
+                   pat: Pat.t} vector}
 and matchNode = T of (Pat.t * exp) vector
 withtype
     dec = decNode Wrap.t
@@ -371,14 +397,14 @@
 
 fun layoutAndsTyvars (prefix, (tyvars, xs), layoutX) =
    layoutAnds (prefix,
-	       Vector.fromList
-	       (case Vector.toListMap (xs, layoutX) of
-		   [] => []
-		 | x :: xs =>
-		      (if Vector.isEmpty tyvars
-			  then x
-		       else seq [Tyvar.layouts tyvars, str " ", x]) :: xs),
-	      fn (prefix, x) => seq [prefix, x])
+               Vector.fromList
+               (case Vector.toListMap (xs, layoutX) of
+                   [] => []
+                 | x :: xs =>
+                      (if Vector.isEmpty tyvars
+                          then x
+                       else seq [Tyvar.layouts tyvars, str " ", x]) :: xs),
+              fn (prefix, x) => seq [prefix, x])
 
 fun expNodeName e =
    case node e of
@@ -403,9 +429,9 @@
     | While _ => "While"
 
 val traceLayoutExp =
-   Trace.traceInfo' (Trace.info "layoutExp",
-		     fn (e, _: bool) => Layout.str (expNodeName e),
-		     Layout.ignore: Layout.t -> Layout.t)
+   Trace.traceInfo' (Trace.info "AstCore.layoutExp",
+                     fn (e, _: bool) => Layout.str (expNodeName e),
+                     Layout.ignore: Layout.t -> Layout.t)
    
 fun layoutExp arg =
    traceLayoutExp
@@ -414,54 +440,54 @@
       fun delimit t = if isDelimited then t else paren t
    in
       case node e of
-	 Andalso (e, e') =>
-	    delimit (mayAlign [layoutExpF e,
-			       seq [str "andalso ", layoutExpF e']])
+         Andalso (e, e') =>
+            delimit (mayAlign [layoutExpF e,
+                               seq [str "andalso ", layoutExpF e']])
        | App (function, argument) =>
-	    delimit (mayAlign [layoutExpF function, layoutExpF argument])
+            delimit (mayAlign [layoutExpF function, layoutExpF argument])
        | Case (expr, match) =>
-	    delimit (align [seq [str "case ", layoutExpT expr,
-				 str " of"],
-			    indent (layoutMatch match, 2)])
+            delimit (align [seq [str "case ", layoutExpT expr,
+                                 str " of"],
+                            indent (layoutMatch match, 2)])
        | Const c => Const.layout c
        | Constraint (expr, constraint) =>
-	    delimit (layoutConstraint (layoutExpF expr, constraint))
+            delimit (layoutConstraint (layoutExpF expr, constraint))
        | FlatApp es =>
-	    delimit (seq (separate (Vector.toListMap (es, layoutExpF), " ")))
+            delimit (seq (separate (Vector.toListMap (es, layoutExpF), " ")))
        | Fn m => delimit (seq [str "fn ", layoutMatch m])
        | Handle (try, match) =>
-	    delimit (align [layoutExpF try,
-			    seq [str "handle ", layoutMatch match]])
+            delimit (align [layoutExpF try,
+                            seq [str "handle ", layoutMatch match]])
        | If (test, thenCase, elseCase) =>
-	    delimit (mayAlign [seq [str "if ", layoutExpT test],
-			       seq [str "then ", layoutExpT thenCase],
-			       seq [str "else ", layoutExpT elseCase]])
+            delimit (mayAlign [seq [str "if ", layoutExpT test],
+                               seq [str "then ", layoutExpT thenCase],
+                               seq [str "else ", layoutExpT elseCase]])
        | Let (dec, expr) => Pretty.lett (layoutDec dec, layoutExpT expr)
        | List es => list (Vector.toListMap (es, layoutExpT))
        | Orelse (e, e') =>
-	    delimit (mayAlign [layoutExpF e,
-			       seq [str "orelse ", layoutExpF e']])
-       | Prim {kind, ...} => str (PrimKind.name kind)
+            delimit (mayAlign [layoutExpF e,
+                               seq [str "orelse ", layoutExpF e']])
+       | Prim kind => str (PrimKind.name kind)
        | Raise exn => delimit (seq [str "raise ", layoutExpF exn])
        | Record r =>
-	    let
-	       fun layoutTuple es =
-		  if 1 = Vector.length es
-		     then layoutExp (Vector.sub (es, 0), isDelimited)
-		  else tuple (layoutExpsT es)
-	    in
-	       Record.layout {record = r,
-			      separator = " = ",
-			      extra = "",
-			      layoutTuple = layoutTuple,
-			      layoutElt = layoutExpT}
-	    end
+            let
+               fun layoutTuple es =
+                  if 1 = Vector.length es
+                     then layoutExp (Vector.sub (es, 0), isDelimited)
+                  else tuple (layoutExpsT es)
+            in
+               Record.layout {record = r,
+                              separator = " = ",
+                              extra = "",
+                              layoutTuple = layoutTuple,
+                              layoutElt = layoutExpT}
+            end
        | Selector f => seq [str "#", Field.layout f]
        | Seq es => paren (align (separateRight (layoutExpsT es, " ;")))
        | Var {name, fixop} => seq [Fixop.layout fixop, layoutLongvid name]
        | While {test, expr} =>
-	    delimit (align [seq [str "while ", layoutExpT test],
-			    seq [str "do ", layoutExpT expr]])
+            delimit (align [seq [str "while ", layoutExpT test],
+                            seq [str "do ", layoutExpT expr]])
    end) arg
 and layoutExpsT es = Vector.toListMap (es, layoutExpT)
 and layoutExpT e = layoutExp (e, true)
@@ -476,36 +502,36 @@
    
 and layoutRule (pat, exp) =
    mayAlign [seq [Pat.layoutF pat, str " =>"],
-	     layoutExpF exp]
+             layoutExpF exp]
       
 and layoutDec d =
    case node d of
       Abstype {datBind, body} =>
-	 align [DatBind.layout ("abstype", datBind),
-		seq [str "with ", layoutDec body],
-		str "end"]
+         align [DatBind.layout ("abstype", datBind),
+                seq [str "with ", layoutDec body],
+                str "end"]
     | Datatype rhs => DatatypeRhs.layout rhs
     | Exception ebs =>
-	 layoutAnds ("exception", ebs,
-		     fn (prefix, eb) => seq [prefix, Eb.layout eb])
+         layoutAnds ("exception", ebs,
+                     fn (prefix, eb) => seq [prefix, Eb.layout eb])
     | Fix {fixity, ops} =>
-	 seq [Fixity.layout fixity, str " ",
-	      seq (separate (Vector.toListMap (ops, Vid.layout), " "))]
+         seq [Fixity.layout fixity, str " ",
+              seq (separate (Vector.toListMap (ops, Vid.layout), " "))]
     | Fun fbs => layoutAndsTyvars ("fun", fbs, layoutFb)
     | Local (d, d') => Pretty.locall (layoutDec d, layoutDec d')
     | Open ss => seq [str "open ",
-		      seq (separate (Vector.toListMap (ss, Longstrid.layout),
-				     " "))]
+                      seq (separate (Vector.toListMap (ss, Longstrid.layout),
+                                     " "))]
     | Overload (p, x, _, t, xs) =>
-	 seq [str "_overload ", Priority.layout p, str " ",
-	      align [layoutConstraint (Var.layout x, t),
-		     layoutAnds ("as", xs, fn (prefix, x) =>
-				 seq [prefix, Longvar.layout x])]]
+         seq [str "_overload ", Priority.layout p, str " ",
+              align [layoutConstraint (Var.layout x, t),
+                     layoutAnds ("as", xs, fn (prefix, x) =>
+                                 seq [prefix, Longvar.layout x])]]
     | SeqDec ds => align (Vector.toListMap (ds, layoutDec))
     | Type typBind => TypBind.layout typBind
     | Val {tyvars, vbs, rvbs} =>
-	 align [layoutAndsTyvars ("val", (tyvars, vbs), layoutVb),
-		layoutAndsTyvars ("val rec", (tyvars, rvbs), layoutRvb)]
+         align [layoutAndsTyvars ("val", (tyvars, vbs), layoutVb),
+                layoutAndsTyvars ("val rec", (tyvars, rvbs), layoutRvb)]
 
 and layoutVb {pat, exp} =
    bind (Pat.layoutT pat, layoutExpT exp)
@@ -518,17 +544,17 @@
    
 and layoutClause ({pats, resultType, body}) =
    mayAlign [seq [maybeConstrain (Pat.layoutFlatApp pats,
-			    resultType),
-	     str " ="],
-	 layoutExpF body] (* this has to be layoutExpF in case body
-			   is a case expression *)
+                            resultType),
+             str " ="],
+         layoutExpF body] (* this has to be layoutExpF in case body
+                           is a case expression *)
 
 fun checkSyntaxExp (e: exp): unit =
    let
       val c = checkSyntaxExp
    in
       case node e of
-	 Andalso (e1, e2) => (c e1; c e2)
+         Andalso (e1, e2) => (c e1; c e2)
        | App (e1, e2) => (c e1; c e2)
        | Case (e, m) => (c e; checkSyntaxMatch m)
        | Const _ => ()
@@ -543,10 +569,10 @@
        | Prim _ => ()
        | Raise e => c e
        | Record r =>
-	    (Record.foreach (r, c)
-	     ; reportDuplicateFields (Record.toVector r,
-				      {region = region e,
-				       term = fn () => layoutExp (e, true)}))
+            (Record.foreach (r, c)
+             ; reportDuplicateFields (Record.toVector r,
+                                      {region = region e,
+                                       term = fn () => layoutExp (e, true)}))
        | Selector _ => ()
        | Seq es => Vector.foreach (es, c)
        | Var _ => ()
@@ -563,38 +589,38 @@
 and checkSyntaxDec (d: dec): unit =
    case node d of
       Abstype {datBind, body} =>
-	 (DatBind.checkSyntax datBind
-	  ; checkSyntaxDec body)
+         (DatBind.checkSyntax datBind
+          ; checkSyntaxDec body)
     | Datatype rhs => DatatypeRhs.checkSyntax rhs
     | Exception v =>
-	 (Vector.foreach (v, fn (_, ebrhs) => EbRhs.checkSyntax ebrhs)
-	  ; (reportDuplicates
-	     (v, {equals = fn ((c, _), (c', _)) => Con.equals (c, c'),
-		  layout = Con.layout o #1,
-		  name = "exception declaration",
-		  region = Con.region o #1,
-		  term = fn () => layoutDec d})))
+         (Vector.foreach (v, fn (_, ebrhs) => EbRhs.checkSyntax ebrhs)
+          ; (reportDuplicates
+             (v, {equals = fn ((c, _), (c', _)) => Con.equals (c, c'),
+                  layout = Con.layout o #1,
+                  name = "exception declaration",
+                  region = Con.region o #1,
+                  term = fn () => layoutDec d})))
     | Fix _ => () (* The Definition allows, e.g., "infix + +". *)
     | Fun (_, fs) =>
-	 Vector.foreach (fs, fn clauses =>
-			 Vector.foreach
-			 (clauses, fn {body, pats, resultType} =>
-			  (checkSyntaxExp body
-			   ; Vector.foreach (pats, Pat.checkSyntax)
-			   ; Option.app (resultType, Type.checkSyntax))))
+         Vector.foreach (fs, fn clauses =>
+                         Vector.foreach
+                         (clauses, fn {body, pats, resultType} =>
+                          (checkSyntaxExp body
+                           ; Vector.foreach (pats, Pat.checkSyntax)
+                           ; Option.app (resultType, Type.checkSyntax))))
     | Local (d, d') => (checkSyntaxDec d; checkSyntaxDec d')
     | Open _ => ()
     | Overload (_, _, _, ty, _) => Type.checkSyntax ty
     | SeqDec v => Vector.foreach (v, checkSyntaxDec)
     | Type b => TypBind.checkSyntax b
     | Val {rvbs, vbs, ...} =>
-	 (Vector.foreach (rvbs, fn {match, pat} =>
-			  (checkSyntaxMatch match
-			   ; Pat.checkSyntax pat))
-	  ; Vector.foreach (vbs, fn {exp, pat} =>
-			    (checkSyntaxExp exp
-			     ; Pat.checkSyntax pat)))
-	  
+         (Vector.foreach (rvbs, fn {match, pat} =>
+                          (checkSyntaxMatch match
+                           ; Pat.checkSyntax pat))
+          ; Vector.foreach (vbs, fn {exp, pat} =>
+                            (checkSyntaxExp exp
+                             ; Pat.checkSyntax pat)))
+          
 structure Match =
    struct
       open Match
@@ -617,42 +643,42 @@
       fun constraint (e, t) = makeRegion (Constraint (e, t), region e)
 
       fun fnn rs =
-	 let
-	    val r =
-	       if 0 = Vector.length rs
-		  then Region.bogus
-	       else Region.append (Pat.region (#1 (Vector.sub (rs, 0))),
-				   region (#2 (Vector.last rs)))
-	 in
-	    makeRegion (Fn (Match.makeRegion (Match.T rs, r)), r)
-	 end
+         let
+            val r =
+               if 0 = Vector.length rs
+                  then Region.bogus
+               else Region.append (Pat.region (#1 (Vector.sub (rs, 0))),
+                                   region (#2 (Vector.last rs)))
+         in
+            makeRegion (Fn (Match.makeRegion (Match.T rs, r)), r)
+         end
 
       fun longvid name =
-	 makeRegion (Var {name = name, fixop = Fixop.None},
-		     Longvid.region name)
-	 
+         makeRegion (Var {name = name, fixop = Fixop.None},
+                     Longvid.region name)
+         
       val var = longvid o Longvid.short o Vid.fromVar
 
       fun app (e1: t, e2: t): t =
-	 makeRegion (App (e1, e2),
-		     Region.append (region e1, region e2))
-	 
+         makeRegion (App (e1, e2),
+                     Region.append (region e1, region e2))
+         
       fun lett (ds: dec vector, e: t, r: Region.t): t =
-	 makeRegion (Let (makeRegion (SeqDec ds, r), e), r)
+         makeRegion (Let (makeRegion (SeqDec ds, r), e), r)
 
       fun tuple (es: t vector): t =
-	 if 1 = Vector.length es
-	    then Vector.sub (es, 0)
-	 else
-	    let
-	       val r =
-		  if 0 = Vector.length es
-		     then Region.bogus
-		  else Region.append (region (Vector.sub (es, 0)),
-				      region (Vector.last es))
-	    in
-	       makeRegion (Record (Record.tuple es), r)
-	    end
+         if 1 = Vector.length es
+            then Vector.sub (es, 0)
+         else
+            let
+               val r =
+                  if 0 = Vector.length es
+                     then Region.bogus
+                  else Region.append (region (Vector.sub (es, 0)),
+                                      region (Vector.last es))
+            in
+               makeRegion (Record (Record.tuple es), r)
+            end
 
       val unit: t = tuple (Vector.new0 ())
 
@@ -668,38 +694,38 @@
       type obj = t
 
       val checkSyntax = checkSyntaxDec
-	 
+         
       fun make n = makeRegion (n, Region.bogus)
-	 
+         
       val openn = make o Open
 
       fun exceptionn (exn: Con.t, to: Type.t option): t =
-	 make (Exception (Vector.new1 (exn, make (Eb.Rhs.Gen to))))
+         make (Exception (Vector.new1 (exn, make (Eb.Rhs.Gen to))))
 
       fun datatypee datatypes: t =
-	 make
-	 (Datatype
-	  (DatatypeRhs.makeRegion
-	   (DatatypeRhs.DatBind
-	    (DatBind.makeRegion (DatBind.T {withtypes = TypBind.empty,
-					    datatypes = datatypes},
-				 Region.bogus)),
-	    Region.bogus)))
+         make
+         (Datatype
+          (DatatypeRhs.makeRegion
+           (DatatypeRhs.DatBind
+            (DatBind.makeRegion (DatBind.T {withtypes = TypBind.empty,
+                                            datatypes = datatypes},
+                                 Region.bogus)),
+            Region.bogus)))
 
       val seq = make o SeqDec
-	 
+         
       val empty = seq (Vector.new0 ())
 
       fun vall (tyvars, var, exp): t =
-	 make (Val {tyvars = tyvars,
-		    vbs = Vector.new1 {exp = exp, pat = Pat.var var},
-		    rvbs = Vector.new0 ()})
+         make (Val {tyvars = tyvars,
+                    vbs = Vector.new1 {exp = exp, pat = Pat.var var},
+                    rvbs = Vector.new0 ()})
 
       local
-	 val it = Var.fromSymbol (Symbol.fromString "it", Region.bogus)
+         val it = Var.fromSymbol (Symbol.fromString "it", Region.bogus)
       in
-	 fun fromExp (e: Exp.t): t =
-	    vall (Vector.new0 (), it, e)
+         fun fromExp (e: Exp.t): t =
+            vall (Vector.new0 (), it, e)
       end
    
       val layout = layoutDec

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ast/ast-core.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ast/ast-core.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ast/ast-core.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 type int = Int.t
    
 signature AST_CORE_STRUCTS = 
@@ -17,204 +18,225 @@
       include AST_CORE_STRUCTS
       
       structure Fixity:
-	 sig
-	    datatype t =
-	       Infix of int option
-	     | Infixr of int option
-	     | Nonfix
+         sig
+            datatype t =
+               Infix of int option
+             | Infixr of int option
+             | Nonfix
 
-	    val bogus: t
-	    val isInfix: t -> bool
-	    val layout: t -> Layout.t
-	 end
-	 
+            val bogus: t
+            val isInfix: t -> bool
+            val layout: t -> Layout.t
+         end
+         
       structure Fixop:
-	 sig
-	    datatype t = Op | None
-	 end
+         sig
+            datatype t = Op | None
+         end
 
       structure Pat:
-	 sig
-	    type t
-	       
-	    structure Item:
-	       sig
-		  type pat
-		  datatype t =
-		     Field of pat
-		   | Vid of Vid.t * Type.t option * pat option 
-		     (* vid <:ty> <as pat> *)
-	       end
-	    sharing type Item.pat = t
+         sig
+            type t
+               
+            structure Item:
+               sig
+                  type pat
+                  datatype t =
+                     Field of pat
+                   | Vid of Vid.t * Type.t option * pat option 
+                     (* vid <:ty> <as pat> *)
+               end
+            sharing type Item.pat = t
 
-	    datatype node =
-	       App of Longcon.t * t
-	     | Const of Const.t
-	     | Constraint of t * Type.t
-	     | FlatApp of t vector
-	     | Layered of {constraint: Type.t option,
-			   fixop: Fixop.t,
-			   pat: t,
-			   var: Var.t}
-	     | List of t vector
-	     | Record of {flexible: bool,
-			  items: (Record.Field.t * Item.t) vector}
-	     | Tuple of t vector
-	     | Var of {fixop: Fixop.t,
-		       name: Longvid.t}
-	     | Wild
-	       
-	    include WRAPPED sharing type node' = node
-			    sharing type obj = t
+            datatype node =
+               App of Longcon.t * t
+             | Const of Const.t
+             | Constraint of t * Type.t
+             | FlatApp of t vector
+             | Layered of {constraint: Type.t option,
+                           fixop: Fixop.t,
+                           pat: t,
+                           var: Var.t}
+             | List of t vector
+             | Record of {flexible: bool,
+                          items: (Record.Field.t * Item.t) vector}
+             | Tuple of t vector
+             | Var of {fixop: Fixop.t,
+                       name: Longvid.t}
+             | Wild
+               
+            include WRAPPED sharing type node' = node
+                            sharing type obj = t
 
-	    val app: Con.t * t -> t
-	    val con: Con.t -> t
-	    val const: Const.t -> t
-	    val constraint: t * Type.t -> t
-	    val layered: {fixop: Fixop.t,
-			  var: Var.t,
-			  constraint: Type.t option,
-			  pat: t} -> t
-	    val layout: t -> Layout.t
-	    val layoutDelimit: t -> Layout.t
-	    val longvid: Longvid.t -> t
-	    val tuple: t vector -> t
-	    val var: Var.t -> t
-	    val wild: t
-	 end
+            val app: Con.t * t -> t
+            val con: Con.t -> t
+            val const: Const.t -> t
+            val constraint: t * Type.t -> t
+            val layered: {fixop: Fixop.t,
+                          var: Var.t,
+                          constraint: Type.t option,
+                          pat: t} -> t
+            val layout: t -> Layout.t
+            val layoutDelimit: t -> Layout.t
+            val longvid: Longvid.t -> t
+            val tuple: t vector -> t
+            val var: Var.t -> t
+            val wild: t
+         end
 
       structure PrimKind:
-	 sig
-	    structure Attribute:
-	       sig
-		  datatype t = Cdecl | Stdcall
-		     
-		  val layout: t -> Layout.t
-	       end
-	    
-	    datatype t =
-	       BuildConst of {name: string}
-	     | CommandLineConst of {name: string, value: Const.t}
-	     | Const of {name: string}
-	     | Export of {attributes: Attribute.t list, name: string}
-	     | IImport of {attributes: Attribute.t list}
-	     | Import of {attributes: Attribute.t list, name: string}
-	     | Symbol of {name: string}
-	     | Prim of {name: string}
-	 end
+         sig
+            structure ImportExportAttribute:
+               sig
+                  datatype t = Cdecl | Stdcall
+                     
+                  val layout: t -> Layout.t
+               end
+            
+            structure SymbolAttribute:
+               sig
+                  datatype t = Alloc
+                     
+                  val layout: t -> Layout.t
+               end
+            
+            datatype t =
+               Address of {name: string,
+                           ty: Type.t}
+             | BuildConst of {name: string, 
+                              ty: Type.t}
+             | CommandLineConst of {name: string, 
+                                    ty: Type.t,
+                                    value: Const.t}
+             | Const of {name: string, 
+                         ty: Type.t}
+             | Export of {attributes: ImportExportAttribute.t list, 
+                          name: string,
+                          ty: Type.t}
+             | IImport of {attributes: ImportExportAttribute.t list,
+                           ty: Type.t}
+             | Import of {attributes: ImportExportAttribute.t list, 
+                          name: string,
+                          ty: Type.t}
+             | ISymbol of {ty: Type.t}
+             | Prim of {name: string, 
+                        ty: Type.t}
+             | Symbol of {attributes: SymbolAttribute.t list, 
+                          name: string,
+                          ty: Type.t}
+         end
 
       structure Priority:
-	 sig
-	    datatype t = T of int option
-	    val <= : t * t -> bool
-	    val default: t
-	    val layout: t -> Layout.t
-	 end
+         sig
+            datatype t = T of int option
+            val <= : t * t -> bool
+            val default: t
+            val layout: t -> Layout.t
+         end
 
       structure Exp:
-	 sig
-	    type dec
-	    type match
-	    type t
-	    datatype node =
-	       Andalso of t * t
-	     | App of t * t
-	     | Case of t * match
-	     | Const of Const.t
-	     | Constraint of t * Type.t
-	     | FlatApp of t vector
-	     | Fn of match
-	     | Handle of t * match
-	     | If of t * t * t
-	     | Let of dec * t
-	     | List of t vector
-	     | Orelse of t * t
-	     | Prim of {kind: PrimKind.t,
-			ty: Type.t}
-	     | Raise of t
-	     | Record of t Record.t
-	     | Selector of Record.Field.t
-	     | Seq of t vector
-	     | Var of {fixop: Fixop.t,
-		       name: Longvid.t}
-	     | While of {expr: t,
-			 test: t}
+         sig
+            type dec
+            type match
+            type t
+            datatype node =
+               Andalso of t * t
+             | App of t * t
+             | Case of t * match
+             | Const of Const.t
+             | Constraint of t * Type.t
+             | FlatApp of t vector
+             | Fn of match
+             | Handle of t * match
+             | If of t * t * t
+             | Let of dec * t
+             | List of t vector
+             | Orelse of t * t
+             | Prim of PrimKind.t
+             | Raise of t
+             | Record of t Record.t
+             | Selector of Record.Field.t
+             | Seq of t vector
+             | Var of {fixop: Fixop.t,
+                       name: Longvid.t}
+             | While of {expr: t,
+                         test: t}
 
-	    include WRAPPED sharing type node' = node
-			    sharing type obj = t
-	       
-	    val app: t * t -> t
-	    val const: Const.t -> t
-	    val constraint: t * Type.t -> t
-	    val fnn: (Pat.t * t) vector -> t
+            include WRAPPED sharing type node' = node
+                            sharing type obj = t
+               
+            val app: t * t -> t
+            val const: Const.t -> t
+            val constraint: t * Type.t -> t
+            val fnn: (Pat.t * t) vector -> t
             val layout: t -> Layout.t
-	    val lett: dec vector * t * Region.t -> t
-	    val longvid: Longvid.t -> t
-	    val tuple: t vector -> t
-	    val unit: t
-	    val var: Var.t -> t
-	 end
+            val lett: dec vector * t * Region.t -> t
+            val longvid: Longvid.t -> t
+            val tuple: t vector -> t
+            val unit: t
+            val var: Var.t -> t
+         end
 
       structure Match:
-	 sig
-	    type t
-	    datatype node = T of (Pat.t * Exp.t) vector
-	    include WRAPPED
-	    sharing type node' = node
+         sig
+            type t
+            datatype node = T of (Pat.t * Exp.t) vector
+            include WRAPPED
+            sharing type node' = node
             sharing type obj = t
 
             val layout: t -> Layout.t
-	 end where type t = Exp.match
+         end where type t = Exp.match
       
       structure EbRhs:
-	 sig
-	    type t
-	    datatype node =
-	       Def of Longcon.t
-	     | Gen of Type.t option
-	    include WRAPPED sharing type node' = node
-			    sharing type obj = t
-	 end
+         sig
+            type t
+            datatype node =
+               Def of Longcon.t
+             | Gen of Type.t option
+            include WRAPPED sharing type node' = node
+                            sharing type obj = t
+         end
 
       structure Dec:
-	 sig
-	    type t
-	    datatype node =
-	       Abstype of {datBind: DatBind.t,
-			   body: t}
-	     | Datatype of DatatypeRhs.t
-	     | Exception of (Con.t * EbRhs.t) vector
-	     | Fix of {fixity: Fixity.t,
-		       ops: Vid.t vector}
-	     | Fun of Tyvar.t vector * {body: Exp.t,
-					pats: Pat.t vector,
-					resultType: Type.t option} vector vector
-	     | Local of t * t
-	     | Open of Longstrid.t vector
-	     | Overload of Priority.t *
-	                   Var.t * 
-			   Tyvar.t vector * Type.t * 
-			   Longvar.t vector
-	     | SeqDec of t vector
-	     | Type of TypBind.t
-	     | Val of {rvbs: {match: Match.t,
-			      pat: Pat.t} vector,
-		       tyvars: Tyvar.t vector,
-		       vbs: {exp: Exp.t,
-			     pat: Pat.t} vector}
-	    include WRAPPED sharing type node' = node
-			    sharing type obj = t
+         sig
+            type t
+            datatype node =
+               Abstype of {datBind: DatBind.t,
+                           body: t}
+             | Datatype of DatatypeRhs.t
+             | Exception of (Con.t * EbRhs.t) vector
+             | Fix of {fixity: Fixity.t,
+                       ops: Vid.t vector}
+             | Fun of Tyvar.t vector * {body: Exp.t,
+                                        pats: Pat.t vector,
+                                        resultType: Type.t option} vector vector
+             | Local of t * t
+             | Open of Longstrid.t vector
+             | Overload of Priority.t *
+                           Var.t * 
+                           Tyvar.t vector * Type.t * 
+                           Longvar.t vector
+             | SeqDec of t vector
+             | Type of TypBind.t
+             | Val of {rvbs: {match: Match.t,
+                              pat: Pat.t} vector,
+                       tyvars: Tyvar.t vector,
+                       vbs: {exp: Exp.t,
+                             pat: Pat.t} vector}
+            include WRAPPED sharing type node' = node
+                            sharing type obj = t
 
             val checkSyntax: t -> unit
             val datatypee: {tyvars: Tyvar.t vector,
-			    tycon: Tycon.t,
-			    cons: (Con.t * Type.t option) vector} vector -> t
+                            tycon: Tycon.t,
+                            cons: (Con.t * Type.t option) vector} vector -> t
             val empty: t
-	    val exceptionn: Con.t * Type.t option -> t
-	    val fromExp: Exp.t -> t
-	    val layout: t -> Layout.t
-	    val openn: Longstrid.t vector -> t
-	    val vall: Tyvar.t vector * Var.t * Exp.t -> t
-	 end
+            val exceptionn: Con.t * Type.t option -> t
+            val fromExp: Exp.t -> t
+            val layout: t -> Layout.t
+            val openn: Longstrid.t vector -> t
+            val vall: Tyvar.t vector * Var.t * Exp.t -> t
+         end
       sharing type Dec.t = Exp.dec
    end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ast/ast-id.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ast/ast-id.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ast/ast-id.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,17 +1,18 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 functor AstId (S: AST_ID_STRUCTS): AST_ID =
 struct
 
 open S
 
 datatype t = T of {name: Symbol.t,
-		   region: Region.t}
+                   region: Region.t}
 
 type obj = t
 type node' = Symbol.t
@@ -27,7 +28,7 @@
 val toSymbol = name
 
 fun makeRegion (s, r) = T {name = s,
-			   region = r}
+                           region = r}
 
 val fromSymbol = makeRegion
 

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ast/ast-id.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ast/ast-id.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ast/ast-id.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature AST_ID_STRUCTS =
    sig
       structure Symbol: SYMBOL

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ast/ast-mlbs.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ast/ast-mlbs.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ast/ast-mlbs.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 functor AstMLBs (S: AST_MLBS_STRUCTS): AST_MLBS = 
 struct
 
@@ -47,22 +48,22 @@
 and layoutBasdec dec =
    case node dec of
       Ann (anns,_, dec) =>
-	 align [str "ann", 
-		indent (seq [str String.dquote, str anns, str String.dquote], 3),
-		str "in", 
-		indent (layoutBasdec dec, 3), 
-		str "end"]
+         align [str "ann", 
+                indent (seq [str String.dquote, str anns, str String.dquote], 3),
+                str "in", 
+                indent (layoutBasdec dec, 3), 
+                str "end"]
     | Basis basbnds =>
-	 layoutAndsBind
-	 ("basis", "=", basbnds, fn {name, def} =>
-	  (case node def of Var _ => OneLine | _ => Split 3,
-	   Basid.layout name, layoutBasexp def))
+         layoutAndsBind
+         ("basis", "=", basbnds, fn {name, def} =>
+          (case node def of Var _ => OneLine | _ => Split 3,
+           Basid.layout name, layoutBasexp def))
     | Defs def => ModIdBind.layout def
     | Local (dec1, dec2) => Pretty.locall (layoutBasdec dec1, layoutBasdec dec2) 
     | MLB ({fileUse, ...}, _) => File.layout fileUse
     | Open bs => seq [str "open ",
-		      seq (separate (Vector.toListMap (bs, Basid.layout),
-				     " "))] 
+                      seq (separate (Vector.toListMap (bs, Basid.layout),
+                                     " "))] 
     | Prim => str "_prim"
     | Prog ({fileUse, ...}, _) => File.layout fileUse
     | Seq decs => align (layoutBasdecs decs)
@@ -72,23 +73,23 @@
    case node e of
       Bas dec => checkSyntaxBasdec dec
     | Let (dec, exp) => (checkSyntaxBasdec dec
-			 ; checkSyntaxBasexp exp)
+                         ; checkSyntaxBasexp exp)
     | Var _ => ()
 and checkSyntaxBasdec (d: basdec): unit =
    case node d of
       Ann (_, _, dec) => checkSyntaxBasdec dec
     | Basis basbnds =>
-	 reportDuplicates
-	 (basbnds, {equals = (fn ({name = id, ...}, {name = id', ...}) =>
-			      Basid.equals (id, id')),
-		    layout = Basid.layout o #name,
-		    name = "basis definition",
-		    region = Basid.region o #name,
-		    term = fn () => layoutBasdec d})
+         reportDuplicates
+         (basbnds, {equals = (fn ({name = id, ...}, {name = id', ...}) =>
+                              Basid.equals (id, id')),
+                    layout = Basid.layout o #name,
+                    name = "basis definition",
+                    region = Basid.region o #name,
+                    term = fn () => layoutBasdec d})
     | Defs def => ModIdBind.checkSyntax def
     | Local (dec1, dec2) => 
-	 (checkSyntaxBasdec dec1
-	  ; checkSyntaxBasdec dec2)
+         (checkSyntaxBasdec dec1
+          ; checkSyntaxBasdec dec2)
     | MLB _ => ()
     | Open _ => ()
     | Prim => ()
@@ -98,48 +99,49 @@
 fun sourceFiles (d: basdec): File.t vector =
    let
       val sourceFiles : File.t Buffer.t =
-	 Buffer.new {dummy = "<dummy>"}
+         Buffer.new {dummy = "<dummy>"}
       val psi : File.t -> bool ref =
-	 String.memoize (fn _ => ref false)
+         String.memoize (fn _ => ref false)
 
       fun sourceFilesBasexp (e: basexp): unit =
-	 case node e of
-	    Bas dec => sourceFilesBasdec dec
-	  | Let (dec, exp) => (sourceFilesBasdec dec
-			       ; sourceFilesBasexp exp)
-	  | Var _ => ()
+         case node e of
+            Bas dec => sourceFilesBasdec dec
+          | Let (dec, exp) => (sourceFilesBasdec dec
+                               ; sourceFilesBasexp exp)
+          | Var _ => ()
       and sourceFilesBasdec (d: basdec): unit =
-	 case node d of
-	    Ann (_, _, dec) => sourceFilesBasdec dec
-	  | Basis basbnds =>
-	       Vector.foreach
-	       (basbnds, fn {def, ...} =>
-		sourceFilesBasexp def)
-	  | Defs _ => ()
-	  | Local (dec1, dec2) => (sourceFilesBasdec dec1
-				   ; sourceFilesBasdec dec2)
-	  | MLB ({fileAbs, ...}, dec) =>
-	       let
-		  val b = psi fileAbs
-	       in
-		  if !b
-		     then ()
-		     else let
-			     val () = b := true
-			  in
-			     sourceFilesBasdec (Promise.force dec)
-			  end
-	       end
-	  | Open _ => ()
-	  | Prim => ()
-	  | Prog ({fileUse, ...}, _) => Buffer.add (sourceFiles, fileUse)
-	  | Seq decs => List.foreach (decs, sourceFilesBasdec)
+         case node d of
+            Ann (_, _, dec) => sourceFilesBasdec dec
+          | Basis basbnds =>
+               Vector.foreach
+               (basbnds, fn {def, ...} =>
+                sourceFilesBasexp def)
+          | Defs _ => ()
+          | Local (dec1, dec2) => (sourceFilesBasdec dec1
+                                   ; sourceFilesBasdec dec2)
+          | MLB ({fileAbs, ...}, dec) =>
+               let
+                  val b = psi fileAbs
+               in
+                  if !b
+                     then ()
+                     else let
+                             val () = b := true
+                          in
+                             sourceFilesBasdec (Promise.force dec)
+                          end
+               end
+          | Open _ => ()
+          | Prim => ()
+          | Prog ({fileUse, ...}, _) => Buffer.add (sourceFiles, fileUse)
+          | Seq decs => List.foreach (decs, sourceFilesBasdec)
       val () = sourceFilesBasdec d
    in
       Buffer.toVector sourceFiles
    end
 val sourceFiles =
-   Trace.trace ("Ast.Basdec.sourceFiles", Layout.ignore, Vector.layout File.layout)
+   Trace.trace 
+   ("AstMLBs.sourceFiles", Layout.ignore, Vector.layout File.layout)
    sourceFiles
 
 

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ast/ast-mlbs.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ast/ast-mlbs.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ast/ast-mlbs.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature AST_MLBS_STRUCTS =
    sig
       include AST_ATOMS_STRUCTS
@@ -15,57 +16,57 @@
       include AST_PROGRAMS
 
       structure Basexp:
-	 sig
-	    type basdec
+         sig
+            type basdec
 
-	    type t
-	    datatype node =
-	       Bas of basdec
-	     | Let of basdec * t
-	     | Var of Basid.t
-	       
-	    include WRAPPED sharing type node' = node
-	                    sharing type obj = t
+            type t
+            datatype node =
+               Bas of basdec
+             | Let of basdec * t
+             | Var of Basid.t
+               
+            include WRAPPED sharing type node' = node
+                            sharing type obj = t
 
-	    val bas: basdec -> t
-	    val lett: basdec * t -> t
-	    val var: Basid.t -> t
+            val bas: basdec -> t
+            val lett: basdec * t -> t
+            val var: Basid.t -> t
 
-	    val checkSyntax: t -> unit
-	    val layout: t -> Layout.t
-	 end
+            val checkSyntax: t -> unit
+            val layout: t -> Layout.t
+         end
 
       structure Basdec:
-	 sig
-	    type t
-	    datatype node =
-	       Ann of string * Region.t * t
-	     | Basis of {name: Basid.t, def: Basexp.t} vector
-	     | Defs of ModIdBind.t
-	     | Local of t * t
-	     | MLB of {fileAbs: File.t, fileUse: File.t} * t Promise.t
-	     | Open of Basid.t vector
-	     | Prim
-	     | Prog of {fileAbs: File.t, fileUse: File.t} * Program.t Promise.t
-	     | Seq of t list
+         sig
+            type t
+            datatype node =
+               Ann of string * Region.t * t
+             | Basis of {name: Basid.t, def: Basexp.t} vector
+             | Defs of ModIdBind.t
+             | Local of t * t
+             | MLB of {fileAbs: File.t, fileUse: File.t} * t Promise.t
+             | Open of Basid.t vector
+             | Prim
+             | Prog of {fileAbs: File.t, fileUse: File.t} * Program.t Promise.t
+             | Seq of t list
 
-	    include WRAPPED sharing type node' = node
-	                    sharing type obj = t
+            include WRAPPED sharing type node' = node
+                            sharing type obj = t
 
-	    val ann: string * Region.t * t -> t
-	    val basis: {name: Basid.t, def: Basexp.t} vector -> t
-	    val defs: ModIdBind.t -> t
-	    val empty: t
-	    val locall: t * t -> t
-	    val mlb: {fileAbs: File.t, fileUse: File.t} * t Promise.t -> t
-	    val openn: Basid.t vector -> t
-	    val prim: t
-	    val prog: {fileAbs: File.t, fileUse: File.t} * Program.t Promise.t -> t
-	    val seq: t list -> t
+            val ann: string * Region.t * t -> t
+            val basis: {name: Basid.t, def: Basexp.t} vector -> t
+            val defs: ModIdBind.t -> t
+            val empty: t
+            val locall: t * t -> t
+            val mlb: {fileAbs: File.t, fileUse: File.t} * t Promise.t -> t
+            val openn: Basid.t vector -> t
+            val prim: t
+            val prog: {fileAbs: File.t, fileUse: File.t} * Program.t Promise.t -> t
+            val seq: t list -> t
 
-	    val checkSyntax: t -> unit
-	    val layout: t -> Layout.t
-	    val sourceFiles: t -> File.t vector
-	 end
+            val checkSyntax: t -> unit
+            val layout: t -> Layout.t
+            val sourceFiles: t -> File.t vector
+         end
       sharing type Basdec.t = Basexp.basdec
    end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ast/ast-modules.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ast/ast-modules.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ast/ast-modules.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 functor AstModules (S: AST_MODULES_STRUCTS): AST_MODULES = 
 struct
 
@@ -22,30 +23,30 @@
    struct
       open Wrap
       datatype node =
-	 Type of Longtycon.t list
+         Type of Longtycon.t list
        | Structure of Longstrid.t list
       type t = node Wrap.t
       type node' = node
       type obj = t
 
       fun layout eq =
-	 case node eq of
-	    Type longtycons =>
-	       seq (str "sharing type "
-		    :: separate (List.map (longtycons, Longtycon.layout), " = "))
-	  | Structure longstrids =>
-	       seq (str "sharing "
-		    :: separate (List.map (longstrids, Longstrid.layout), " = "))
+         case node eq of
+            Type longtycons =>
+               seq (str "sharing type "
+                    :: separate (List.map (longtycons, Longtycon.layout), " = "))
+          | Structure longstrids =>
+               seq (str "sharing "
+                    :: separate (List.map (longstrids, Longstrid.layout), " = "))
    end
 
 type typedescs = {tyvars: Tyvar.t vector,
-		  tycon: Tycon.t} vector
+                  tycon: Tycon.t} vector
 
 datatype sigexpNode =
    Var of Sigid.t
  | Where of sigexp * {tyvars: Tyvar.t vector,
-		      longtycon: Longtycon.t,
-		      ty: Type.t} vector
+                      longtycon: Longtycon.t,
+                      ty: Type.t} vector
  | Spec of spec
 and sigConst =
    None
@@ -60,7 +61,7 @@
   | IncludeSigids of Sigid.t vector
   | Seq of spec * spec
   | Sharing of {equations: Equation.t vector,
-		spec: spec}
+                spec: spec}
   | Structure of (Strid.t * sigexp) vector
   | Type of typedescs
   | TypeDefs of TypBind.t
@@ -70,42 +71,42 @@
 
 fun layoutTypedescs (prefix, typedescs) =
    layoutAnds (prefix, typedescs, fn (prefix, {tyvars, tycon}) =>
-	       seq [prefix,
-		    Type.layoutApp (Tycon.layout tycon, tyvars, Tyvar.layout)])
+               seq [prefix,
+                    Type.layoutApp (Tycon.layout tycon, tyvars, Tyvar.layout)])
 
 fun layoutTypedefs (prefix, typBind) =
    let
       val TypBind.T ds = TypBind.node typBind
    in
       layoutAnds (prefix, ds, fn (prefix, {def, tycon, tyvars}) =>
-		  seq [prefix,
-		       Type.layoutApp (Tycon.layout tycon, tyvars, Tyvar.layout),
-		       str " = ", Type.layout def])
+                  seq [prefix,
+                       Type.layoutApp (Tycon.layout tycon, tyvars, Tyvar.layout),
+                       str " = ", Type.layout def])
    end
 
 fun layoutSigexp (e: sigexp): Layout.t =
    case node e of
       Var s => Sigid.layout s
     | Where (e, ws) =>
-	 let
-	    val e = layoutSigexp e
-	 in
-	    if 0 = Vector.length ws
-	       then e
-	    else
-	       seq [e, 
-		    layoutAndsBind
-		    (" where", "=", ws, fn {tyvars, longtycon, ty} =>
-		     (OneLine,
-		      seq [str "type ",
-			   Type.layoutApp
-			   (Longtycon.layout longtycon, tyvars,
-			    Tyvar.layout)],
-		      Type.layout ty))]
-	 end
+         let
+            val e = layoutSigexp e
+         in
+            if 0 = Vector.length ws
+               then e
+            else
+               seq [e, 
+                    layoutAndsBind
+                    (" where", "=", ws, fn {tyvars, longtycon, ty} =>
+                     (OneLine,
+                      seq [str "type ",
+                           Type.layoutApp
+                           (Longtycon.layout longtycon, tyvars,
+                            Tyvar.layout)],
+                      Type.layout ty))]
+         end
     | Spec s => align [str "sig",
-		       indent (layoutSpec s, 3),
-		       str "end"]
+                       indent (layoutSpec s, 3),
+                       str "end"]
 
 and layoutSigConst sigConst =
    case sigConst of
@@ -119,98 +120,98 @@
     | Empty => empty
     | Eqtype typedescs => layoutTypedescs ("eqtype", typedescs)
     | Exception sts =>
-	 layoutAnds
-	 ("exception", sts, fn (prefix, (c, to)) => seq [prefix,
-							 Con.layout c,
-							 Type.layoutOption to])
+         layoutAnds
+         ("exception", sts, fn (prefix, (c, to)) => seq [prefix,
+                                                         Con.layout c,
+                                                         Type.layoutOption to])
     | IncludeSigexp s => seq [str "include ", layoutSigexp s]
     | IncludeSigids sigids =>
-	 seq (str "include "
-	      :: separate (Vector.toListMap (sigids, Sigid.layout), " "))
+         seq (str "include "
+              :: separate (Vector.toListMap (sigids, Sigid.layout), " "))
     | Seq (s, s') => align [layoutSpec s, layoutSpec s']
     | Sharing {spec, equations} =>
-	 align [layoutSpec spec,
-		align (Vector.toListMap (equations, Equation.layout))]
+         align [layoutSpec spec,
+                align (Vector.toListMap (equations, Equation.layout))]
     | Structure l =>
-	 layoutAndsBind ("structure", ":", l, fn (strid, sigexp) =>
-			 (case node sigexp of
-			     Var _ => OneLine
-			   | _ => Split 3,
-				Strid.layout strid,
-				layoutSigexp sigexp))
+         layoutAndsBind ("structure", ":", l, fn (strid, sigexp) =>
+                         (case node sigexp of
+                             Var _ => OneLine
+                           | _ => Split 3,
+                                Strid.layout strid,
+                                layoutSigexp sigexp))
     | Type typedescs => layoutTypedescs ("type", typedescs)
     | TypeDefs typedefs => layoutTypedefs ("type", typedefs)
     | Val sts =>
-	 layoutAndsBind
-	 ("val", ":", sts, fn (x, t) => (OneLine, Var.layout x, Type.layout t))
+         layoutAndsBind
+         ("val", ":", sts, fn (x, t) => (OneLine, Var.layout x, Type.layout t))
 
 fun checkSyntaxSigexp (e: sigexp): unit =
    case node e of
       Spec s => checkSyntaxSpec s
     | Var _ => ()
     | Where (e, v) =>
-	 (checkSyntaxSigexp e
-	  ; Vector.foreach (v, fn {ty, ...} => Type.checkSyntax ty))
-	  
+         (checkSyntaxSigexp e
+          ; Vector.foreach (v, fn {ty, ...} => Type.checkSyntax ty))
+          
 and checkSyntaxSigConst (s: sigConst): unit =
    case s of
       None => ()
     | Opaque e => checkSyntaxSigexp e
     | Transparent e => checkSyntaxSigexp e
-	 
+         
 and checkSyntaxSpec (s: spec): unit =
    let
       fun term () = layoutSpec s
    in
       case node s of
-	 Datatype d => DatatypeRhs.checkSyntax d
+         Datatype d => DatatypeRhs.checkSyntax d
        | Eqtype v =>
-	    reportDuplicates
-	    (v, {equals = (fn ({tycon = c, ...}, {tycon = c', ...}) =>
-			   Tycon.equals (c, c')),
-		 layout = Tycon.layout o #tycon,
-		 name = "type",
-		 region = Tycon.region o #tycon,
-		 term = term})
+            reportDuplicates
+            (v, {equals = (fn ({tycon = c, ...}, {tycon = c', ...}) =>
+                           Tycon.equals (c, c')),
+                 layout = Tycon.layout o #tycon,
+                 name = "type",
+                 region = Tycon.region o #tycon,
+                 term = term})
        | Empty => ()
        | Exception v =>
-	    (Vector.foreach (v, fn (_, to) =>
-			     Option.app (to, Type.checkSyntax))
-	     ; (reportDuplicates
-		(v, {equals = fn ((c, _), (c', _)) => Con.equals (c, c'),
-		     layout = Con.layout o #1,
-		     name = "exception",
-		     region = Con.region o #1,
-		     term = term})))
+            (Vector.foreach (v, fn (_, to) =>
+                             Option.app (to, Type.checkSyntax))
+             ; (reportDuplicates
+                (v, {equals = fn ((c, _), (c', _)) => Con.equals (c, c'),
+                     layout = Con.layout o #1,
+                     name = "exception",
+                     region = Con.region o #1,
+                     term = term})))
        | IncludeSigexp e => checkSyntaxSigexp e
        | IncludeSigids _ => ()
        | Seq (s, s') => (checkSyntaxSpec s; checkSyntaxSpec s')
        | Sharing {spec, ...} => checkSyntaxSpec spec
        | Structure v =>
-	    (Vector.foreach (v, checkSyntaxSigexp o #2)
-	     ; (reportDuplicates
-		(v, {equals = fn ((s, _), (s', _)) => Strid.equals (s, s'),
-		     layout = Strid.layout o #1,
-		     name = "structure specification",
-		     region = Strid.region o #1,
-		     term = term})))
+            (Vector.foreach (v, checkSyntaxSigexp o #2)
+             ; (reportDuplicates
+                (v, {equals = fn ((s, _), (s', _)) => Strid.equals (s, s'),
+                     layout = Strid.layout o #1,
+                     name = "structure specification",
+                     region = Strid.region o #1,
+                     term = term})))
        | Type v =>
-	    reportDuplicates
-	    (v, {equals = (fn ({tycon = c, ...}, {tycon = c', ...}) =>
-			   Tycon.equals (c, c')),
-		 layout = Tycon.layout o #tycon,
-		 name = "type specification",
-		 region = Tycon.region o #tycon,
-		 term = term})
+            reportDuplicates
+            (v, {equals = (fn ({tycon = c, ...}, {tycon = c', ...}) =>
+                           Tycon.equals (c, c')),
+                 layout = Tycon.layout o #tycon,
+                 name = "type specification",
+                 region = Tycon.region o #tycon,
+                 term = term})
        | TypeDefs b => TypBind.checkSyntax b
        | Val v =>
-	    (Vector.foreach (v, fn (_, t) => Type.checkSyntax t)
-	     ; (reportDuplicates
-		(v, {equals = fn ((x, _), (x', _)) => Var.equals (x, x'),
-		     layout = Var.layout o #1,
-		     name = "value specification",
-		     region = Var.region o #1,
-		     term = term})))
+            (Vector.foreach (v, fn (_, t) => Type.checkSyntax t)
+             ; (reportDuplicates
+                (v, {equals = fn ((x, _), (x', _)) => Var.equals (x, x'),
+                     layout = Var.layout o #1,
+                     name = "value specification",
+                     region = Var.region o #1,
+                     term = term})))
    end
 
 structure Sigexp =
@@ -223,17 +224,17 @@
       type obj = t
 
       val checkSyntax = checkSyntaxSigexp
-	 
+         
       fun wheree (sigexp: t, wherespecs, region): t =
-	 if 0 = Vector.length wherespecs
-	    then sigexp
-	 else makeRegion (Where (sigexp, wherespecs), region)
+         if 0 = Vector.length wherespecs
+            then sigexp
+         else makeRegion (Where (sigexp, wherespecs), region)
 
       fun make n = makeRegion (n, Region.bogus)
-	 
+         
       val spec = make o Spec
       val var = make o Var
-	 
+         
       val layout = layoutSigexp
    end
 
@@ -266,8 +267,8 @@
   | Local of strdec * strdec
   | Seq of strdec list
   | Structure of {constraint: SigConst.t,
-		  def: strexp,
-		  name: Strid.t} vector
+                  def: strexp,
+                  name: Strid.t} vector
 
 and strexpNode =
    App of Fctid.t * strexp
@@ -284,13 +285,13 @@
     | Local (d, d') => Pretty.locall (layoutStrdec d, layoutStrdec d')
     | Seq ds => align (layoutStrdecs ds)
     | Structure strbs =>
-	 layoutAndsBind ("structure", "=", strbs,
-			 fn {name, def, constraint} =>
-			 (case node def of
-			     Var _ => OneLine
-			   | _ => Split 3,
-				seq [Strid.layout name, SigConst.layout constraint],
-				layoutStrexp def))
+         layoutAndsBind ("structure", "=", strbs,
+                         fn {name, def, constraint} =>
+                         (case node def of
+                             Var _ => OneLine
+                           | _ => Split 3,
+                                seq [Strid.layout name, SigConst.layout constraint],
+                                layoutStrexp def))
 
 and layoutStrdecs ds = layouts (ds, layoutStrdec)
    
@@ -300,8 +301,8 @@
     | Constrained (e, c) => mayAlign [layoutStrexp e, SigConst.layout c]
     | Let (dec, strexp) => Pretty.lett (layoutStrdec dec, layoutStrexp strexp)
     | Struct d => align [str "struct",
-			 indent (layoutStrdec d, 3),
-			 str "end"]
+                         indent (layoutStrdec d, 3),
+                         str "end"]
     | Var s => Longstrid.layout s
 
 fun checkSyntaxStrdec (d: strdec): unit =
@@ -310,26 +311,26 @@
     | Local (d, d') => (checkSyntaxStrdec d; checkSyntaxStrdec d')
     | Seq ds => List.foreach (ds, checkSyntaxStrdec)
     | Structure v =>
-	 (Vector.foreach (v, fn {constraint, def, ...} =>
-			  (SigConst.checkSyntax constraint
-			   ; checkSyntaxStrexp def))
-	  ; (reportDuplicates
-	     (v, {equals = (fn ({name = n, ...}, {name = n', ...}) =>
-			    Strid.equals (n, n')),
-		  layout = Strid.layout o #name,
-		  name = "structure definition",
-		  region = Strid.region o #name,
-		  term = fn () => layoutStrdec d})))
+         (Vector.foreach (v, fn {constraint, def, ...} =>
+                          (SigConst.checkSyntax constraint
+                           ; checkSyntaxStrexp def))
+          ; (reportDuplicates
+             (v, {equals = (fn ({name = n, ...}, {name = n', ...}) =>
+                            Strid.equals (n, n')),
+                  layout = Strid.layout o #name,
+                  name = "structure definition",
+                  region = Strid.region o #name,
+                  term = fn () => layoutStrdec d})))
 and checkSyntaxStrexp (e: strexp): unit =
    case node e of
       App (_, e) => checkSyntaxStrexp e
     | Constrained (e, c) => (checkSyntaxStrexp e
-			     ; SigConst.checkSyntax c)
+                             ; SigConst.checkSyntax c)
     | Let (d, e) => (checkSyntaxStrdec d
-		     ; checkSyntaxStrexp e)
+                     ; checkSyntaxStrexp e)
     | Struct d => checkSyntaxStrdec d
     | Var _ => ()
-	 
+         
 structure Strexp =
    struct
       open Wrap
@@ -371,120 +372,120 @@
 
       val fromExp = core o Dec.fromExp
 
-      val trace = Trace.trace ("coalesce", layout, layout)
+      val trace = Trace.trace ("AstModules.Strdec.coalesce", layout, layout)
       fun coalesce (d: t): t =
-	 trace
-	 (fn d =>
-	 case node d of
-	    Core _ => d
-	  | Local (d1, d2) =>
-	       let
-		  val d1 = coalesce d1
-		  val d2 = coalesce d2
-		  val node = 
-		     case (node d1, node d2) of
-			(Core d1', Core d2') =>
-			   Core (Dec.makeRegion
-				 (Dec.Local (d1', d2'),
-				  Region.append (region d1, region d2)))
-		      | _ => Local (d1, d2)
-	       in
-		  makeRegion (node, region d)
-	       end
-	  | Seq ds =>
-	       let
-		  fun finish (ds: Dec.t list, ac: t list): t list =
-		     case ds of
-			[] => ac
-		      | _ =>
-			   let
-			      val d =
-				 makeRegion (Core (Dec.makeRegion
-						   (Dec.SeqDec (Vector.fromListRev ds),
-						    Region.bogus)),
-					     Region.bogus)
-			   in
-			      d :: ac
-			   end
-		  fun loop (ds, cores, ac) =
-		     case ds of
-			[] => finish (cores, ac)
-		      | d :: ds =>
-			   let
-			      val d = coalesce d
-			   in
-			      case node d of
-				 Core d => loop (ds, d :: cores, ac)
-			       | Seq ds' => loop (ds' @ ds, cores, ac)
-			       | _ => loop (ds, [], d :: finish (cores, ac))
-			   end
-		  val r = region d
-	       in
-		  case loop (ds, [], []) of
-		     [] => makeRegion (Core (Dec.makeRegion
-					     (Dec.SeqDec (Vector.new0 ()), r)),
-				       r)
-		   | [d] => d
-		   | ds => makeRegion (Seq (rev ds), r)
-	       end
-	  | Structure _ => d) d
+         trace
+         (fn d =>
+         case node d of
+            Core _ => d
+          | Local (d1, d2) =>
+               let
+                  val d1 = coalesce d1
+                  val d2 = coalesce d2
+                  val node = 
+                     case (node d1, node d2) of
+                        (Core d1', Core d2') =>
+                           Core (Dec.makeRegion
+                                 (Dec.Local (d1', d2'),
+                                  Region.append (region d1, region d2)))
+                      | _ => Local (d1, d2)
+               in
+                  makeRegion (node, region d)
+               end
+          | Seq ds =>
+               let
+                  fun finish (ds: Dec.t list, ac: t list): t list =
+                     case ds of
+                        [] => ac
+                      | _ =>
+                           let
+                              val d =
+                                 makeRegion (Core (Dec.makeRegion
+                                                   (Dec.SeqDec (Vector.fromListRev ds),
+                                                    Region.bogus)),
+                                             Region.bogus)
+                           in
+                              d :: ac
+                           end
+                  fun loop (ds, cores, ac) =
+                     case ds of
+                        [] => finish (cores, ac)
+                      | d :: ds =>
+                           let
+                              val d = coalesce d
+                           in
+                              case node d of
+                                 Core d => loop (ds, d :: cores, ac)
+                               | Seq ds' => loop (ds' @ ds, cores, ac)
+                               | _ => loop (ds, [], d :: finish (cores, ac))
+                           end
+                  val r = region d
+               in
+                  case loop (ds, [], []) of
+                     [] => makeRegion (Core (Dec.makeRegion
+                                             (Dec.SeqDec (Vector.new0 ()), r)),
+                                       r)
+                   | [d] => d
+                   | ds => makeRegion (Seq (rev ds), r)
+               end
+          | Structure _ => d) d
    end
 
 structure FctArg =
    struct
       open Wrap
       datatype node =
-	 Structure of Strid.t * Sigexp.t
+         Structure of Strid.t * Sigexp.t
        | Spec of Spec.t
       type t = node Wrap.t
       type node' = node
       type obj = t
 
       fun layout a =
-	 case node a of
-	    Structure (strid, sigexp) =>
-	       seq [Strid.layout strid, str ": ", Sigexp.layout sigexp]
-	  | Spec spec => Spec.layout spec
+         case node a of
+            Structure (strid, sigexp) =>
+               seq [Strid.layout strid, str ": ", Sigexp.layout sigexp]
+          | Spec spec => Spec.layout spec
 
       fun checkSyntax (fa: t): unit =
-	 case node fa of
-	    Structure (_, e) => Sigexp.checkSyntax e
-	  | Spec s => Spec.checkSyntax s
+         case node fa of
+            Structure (_, e) => Sigexp.checkSyntax e
+          | Spec s => Spec.checkSyntax s
    end
 
 structure Topdec =
    struct
       open Wrap
       datatype node =
-	 Functor of {arg: FctArg.t,
-		     body: Strexp.t,
-		     name: Fctid.t,
-		     result: SigConst.t} vector
+         Functor of {arg: FctArg.t,
+                     body: Strexp.t,
+                     name: Fctid.t,
+                     result: SigConst.t} vector
        | Signature of (Sigid.t * Sigexp.t) vector
        | Strdec of Strdec.t
       type t = node Wrap.t
       type node' = node
       type obj = t
-	 
+         
       fun layout d =
-	 case node d of
-	    Functor fctbs =>
-	       layoutAndsBind ("functor", "=", fctbs,
-			       fn {name, arg, result, body} =>
-			       (Split 0,
-				seq [Fctid.layout name, str " ",
-				     paren (FctArg.layout arg),
-				     layoutSigConst result],
-				layoutStrexp body))
-	  | Signature sigbs =>
-	       layoutAndsBind ("signature", "=", sigbs,
-			       fn (name, def) =>
-			       (case Sigexp.node def of
-				   Sigexp.Var _ => OneLine
-				 | _ => Split 3,
-				      Sigid.layout name,
-				      Sigexp.layout def))
-	  | Strdec d => Strdec.layout d
+         case node d of
+            Functor fctbs =>
+               layoutAndsBind ("functor", "=", fctbs,
+                               fn {name, arg, result, body} =>
+                               (Split 0,
+                                seq [Fctid.layout name, str " ",
+                                     paren (FctArg.layout arg),
+                                     layoutSigConst result],
+                                layoutStrexp body))
+          | Signature sigbs =>
+               layoutAndsBind ("signature", "=", sigbs,
+                               fn (name, def) =>
+                               (case Sigexp.node def of
+                                   Sigexp.Var _ => OneLine
+                                 | _ => Split 3,
+                                      Sigid.layout name,
+                                      Sigexp.layout def))
+          | Strdec d => Strdec.layout d
 
 
       fun make n = makeRegion (n, Region.bogus)
@@ -494,30 +495,30 @@
       val strdec = make o Strdec
 
       fun checkSyntax (d: t): unit =
-	 case node d of
-	    Functor v =>
-	       (Vector.foreach
-		(v, fn {arg, body, result, ...} =>
-		 (FctArg.checkSyntax arg
-		  ; Strexp.checkSyntax body
-		  ; SigConst.checkSyntax result))
-		; (reportDuplicates
-		   (v, {equals = (fn ({name = n, ...}, {name = n', ...}) =>
-				  Fctid.equals (n, n')),
-			layout = Fctid.layout o #name,
-			name = "functor definition",
-			region = Fctid.region o #name,
-			term = fn () => layout d})))
-	  | Signature bs =>
-	       (Vector.foreach (bs, Sigexp.checkSyntax o #2)
-		; (reportDuplicates
-		   (bs,
-		    {equals = fn ((s, _), (s', _)) => Sigid.equals (s, s'),
-		     layout = Sigid.layout o #1,
-		     name = "signature definition",
-		     region = Sigid.region o #1,
-		     term = fn () => layout d})))
-	  | Strdec d => Strdec.checkSyntax d
+         case node d of
+            Functor v =>
+               (Vector.foreach
+                (v, fn {arg, body, result, ...} =>
+                 (FctArg.checkSyntax arg
+                  ; Strexp.checkSyntax body
+                  ; SigConst.checkSyntax result))
+                ; (reportDuplicates
+                   (v, {equals = (fn ({name = n, ...}, {name = n', ...}) =>
+                                  Fctid.equals (n, n')),
+                        layout = Fctid.layout o #name,
+                        name = "functor definition",
+                        region = Fctid.region o #name,
+                        term = fn () => layout d})))
+          | Signature bs =>
+               (Vector.foreach (bs, Sigexp.checkSyntax o #2)
+                ; (reportDuplicates
+                   (bs,
+                    {equals = fn ((s, _), (s', _)) => Sigid.equals (s, s'),
+                     layout = Sigid.layout o #1,
+                     name = "signature definition",
+                     region = Sigid.region o #1,
+                     term = fn () => layout d})))
+          | Strdec d => Strdec.checkSyntax d
    end
 
 end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ast/ast-modules.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ast/ast-modules.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ast/ast-modules.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature AST_MODULES_STRUCTS =
    sig
       include AST_ATOMS_STRUCTS
@@ -15,156 +16,156 @@
       include AST_CORE
 
       structure Sigexp:
-	 sig
-	    type spec
+         sig
+            type spec
 
-	    type t
-	    datatype node =
-	       Spec of spec
-	     | Var of Sigid.t
+            type t
+            datatype node =
+               Spec of spec
+             | Var of Sigid.t
              | Where of t * {longtycon: Longtycon.t,
-			     ty: Type.t,
-			     tyvars: Tyvar.t vector} vector
+                             ty: Type.t,
+                             tyvars: Tyvar.t vector} vector
 
-	    include WRAPPED sharing type node' = node
-			    sharing type obj = t
+            include WRAPPED sharing type node' = node
+                            sharing type obj = t
 
             val var: Sigid.t -> t
-	    val wheree: t * {tyvars: Tyvar.t vector,
-			     longtycon: Longtycon.t,
-			     ty: Type.t} vector * Region.t -> t
-	    val spec: spec -> t
+            val wheree: t * {tyvars: Tyvar.t vector,
+                             longtycon: Longtycon.t,
+                             ty: Type.t} vector * Region.t -> t
+            val spec: spec -> t
 
-	    val layout: t -> Layout.t
-	 end
+            val layout: t -> Layout.t
+         end
 
       structure SigConst:
-	 sig
-	    datatype t =
-	       None
-	     | Opaque of Sigexp.t
-	     | Transparent of Sigexp.t
-	 end
+         sig
+            datatype t =
+               None
+             | Opaque of Sigexp.t
+             | Transparent of Sigexp.t
+         end
 
       structure Equation:
-	 sig
-	    type t
-	    datatype node =
-	       Structure of Longstrid.t list
-	     | Type of Longtycon.t list
-	    include WRAPPED sharing type node' = node
-			    sharing type obj = t
-	 end
+         sig
+            type t
+            datatype node =
+               Structure of Longstrid.t list
+             | Type of Longtycon.t list
+            include WRAPPED sharing type node' = node
+                            sharing type obj = t
+         end
 
       structure Spec:
-	 sig
-	    type t
-	    datatype node =
-	       Datatype of DatatypeRhs.t
-	     | Eqtype of {tycon: Tycon.t,
-			  tyvars: Tyvar.t vector} vector
-	     | Empty
-	     | Exception of (Con.t * Type.t option) vector
-	     | IncludeSigexp of Sigexp.t
-	     | IncludeSigids of Sigid.t vector
-	     | Seq of t * t
-	     | Sharing of {equations: Equation.t vector,
-			   spec: t}
-	     | Structure of (Strid.t * Sigexp.t) vector
-	     | Type of {tycon: Tycon.t,
-			tyvars: Tyvar.t vector} vector
-	     | TypeDefs of TypBind.t
-	     | Val of (Var.t * Type.t) vector
+         sig
+            type t
+            datatype node =
+               Datatype of DatatypeRhs.t
+             | Eqtype of {tycon: Tycon.t,
+                          tyvars: Tyvar.t vector} vector
+             | Empty
+             | Exception of (Con.t * Type.t option) vector
+             | IncludeSigexp of Sigexp.t
+             | IncludeSigids of Sigid.t vector
+             | Seq of t * t
+             | Sharing of {equations: Equation.t vector,
+                           spec: t}
+             | Structure of (Strid.t * Sigexp.t) vector
+             | Type of {tycon: Tycon.t,
+                        tyvars: Tyvar.t vector} vector
+             | TypeDefs of TypBind.t
+             | Val of (Var.t * Type.t) vector
 
-	    include WRAPPED sharing type node' = node
-			    sharing type obj = t
+            include WRAPPED sharing type node' = node
+                            sharing type obj = t
 
-	    val layout: t -> Layout.t
-	 end
+            val layout: t -> Layout.t
+         end
       sharing type Spec.t = Sigexp.spec
 
       structure Strexp:
-	 sig
-	    type strdec
+         sig
+            type strdec
 
-	    type t
-	    datatype node =
-	       App of Fctid.t * t
+            type t
+            datatype node =
+               App of Fctid.t * t
              | Constrained of t * SigConst.t
-	     | Let of strdec * t
-	     | Struct of strdec
-	     | Var of Longstrid.t
+             | Let of strdec * t
+             | Struct of strdec
+             | Var of Longstrid.t
 
-	    include WRAPPED sharing type node' = node
-			    sharing type obj = t
+            include WRAPPED sharing type node' = node
+                            sharing type obj = t
 
             val var: Longstrid.t -> t
-	    val structt: strdec -> t
-	    val constrained: t * SigConst.t -> t
-	    val app: Fctid.t * t -> t
-	    val lett: strdec * t -> t
-	       
-	    val layout: t -> Layout.t
-	 end
+            val structt: strdec -> t
+            val constrained: t * SigConst.t -> t
+            val app: Fctid.t * t -> t
+            val lett: strdec * t -> t
+               
+            val layout: t -> Layout.t
+         end
 
       structure Strdec:
-	 sig
-	    type t
-	    datatype node =
-	       Core of Dec.t
-	     | Local of t * t
-	     | Seq of t list
-	     | Structure of {constraint: SigConst.t,
-			     def: Strexp.t,
-			     name: Strid.t} vector
+         sig
+            type t
+            datatype node =
+               Core of Dec.t
+             | Local of t * t
+             | Seq of t list
+             | Structure of {constraint: SigConst.t,
+                             def: Strexp.t,
+                             name: Strid.t} vector
 
-	    include WRAPPED sharing type node' = node
-			    sharing type obj = t
+            include WRAPPED sharing type node' = node
+                            sharing type obj = t
 
             val coalesce: t -> t
             val core: Dec.t -> t
-	    val layout: t -> Layout.t
-	    val locall: t * t -> t
-	    val openn: Longstrid.t vector -> t
-	    val seq: t list -> t
+            val layout: t -> Layout.t
+            val locall: t * t -> t
+            val openn: Longstrid.t vector -> t
+            val seq: t list -> t
             val structuree: {name: Strid.t,
-			     def: Strexp.t,
-			     constraint: SigConst.t} vector -> t
-	 end
+                             def: Strexp.t,
+                             constraint: SigConst.t} vector -> t
+         end
       sharing type Strdec.t = Strexp.strdec
 
       structure FctArg:
-	 sig
-	    type t
-	    datatype node =
-	       Structure of Strid.t * Sigexp.t
-	     | Spec of Spec.t
-	    include WRAPPED sharing type node' = node
-			    sharing type obj = t
-	 end
+         sig
+            type t
+            datatype node =
+               Structure of Strid.t * Sigexp.t
+             | Spec of Spec.t
+            include WRAPPED sharing type node' = node
+                            sharing type obj = t
+         end
       
       structure Topdec:
-	 sig
-	    type t
-	    datatype node =
-	       Functor of {arg: FctArg.t,
-			   body: Strexp.t,
-			   name: Fctid.t,
-			   result: SigConst.t} vector
-	     | Signature of (Sigid.t * Sigexp.t) vector
-	     | Strdec of Strdec.t
+         sig
+            type t
+            datatype node =
+               Functor of {arg: FctArg.t,
+                           body: Strexp.t,
+                           name: Fctid.t,
+                           result: SigConst.t} vector
+             | Signature of (Sigid.t * Sigexp.t) vector
+             | Strdec of Strdec.t
 
-	    include WRAPPED sharing type node' = node
-			    sharing type obj = t
+            include WRAPPED sharing type node' = node
+                            sharing type obj = t
 
-	    val checkSyntax: t -> unit
+            val checkSyntax: t -> unit
             val fromExp: Exp.t -> t
-	    val functorr: {name: Fctid.t,
-			   arg: FctArg.t,
-			   result: SigConst.t,
-			   body: Strexp.t} vector -> t
-	    val layout: t -> Layout.t
-	    val signaturee: (Sigid.t * Sigexp.t) vector -> t
+            val functorr: {name: Fctid.t,
+                           arg: FctArg.t,
+                           result: SigConst.t,
+                           body: Strexp.t} vector -> t
+            val layout: t -> Layout.t
+            val signaturee: (Sigid.t * Sigexp.t) vector -> t
             val strdec: Strdec.t -> t
-	 end
+         end
    end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ast/ast-programs.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ast/ast-programs.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ast/ast-programs.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 functor AstPrograms (S: AST_PROGRAMS_STRUCTS): AST_PROGRAMS = 
 struct
 
@@ -23,130 +24,130 @@
       fun append (T ds1, T ds2) = T (ds1 @ ds2)
 
       fun layout (T dss) =
-	 Layout.align (List.map (dss, fn ds =>
-				 Layout.paren 
-				 (Layout.align (List.map (ds, Topdec.layout)))))
+         Layout.align (List.map (dss, fn ds =>
+                                 Layout.paren 
+                                 (Layout.align (List.map (ds, Topdec.layout)))))
 
       fun checkSyntax (T dss) =
-	 List.foreach (dss, fn ds => List.foreach (ds, Topdec.checkSyntax))
+         List.foreach (dss, fn ds => List.foreach (ds, Topdec.checkSyntax))
 
       fun coalesce (T dss): t =
-	 let
-	    fun finish (sds, ac) =
-	       case sds of
-		  [] => ac
-		| _ =>
-		     let
-			val t =
-			   Topdec.makeRegion
-			   (Topdec.Strdec (Strdec.makeRegion
-					   (Strdec.Seq (rev sds), Region.bogus)),
-			    Region.bogus)
-		     in
-			t :: ac
-		     end
-	    fun loop (ds, sds, ac) =
-	       case ds of
-		  [] => finish (sds, ac)
-		| d :: ds =>
-		     case Topdec.node d of
-			Topdec.Strdec d => loop (ds, d :: sds, ac)
-		      | _ => loop (ds, [], d :: finish (sds, ac))
-	 in
-	    T (List.map (dss, fn ds => rev (loop (ds, [], []))))
-	 end
+         let
+            fun finish (sds, ac) =
+               case sds of
+                  [] => ac
+                | _ =>
+                     let
+                        val t =
+                           Topdec.makeRegion
+                           (Topdec.Strdec (Strdec.makeRegion
+                                           (Strdec.Seq (rev sds), Region.bogus)),
+                            Region.bogus)
+                     in
+                        t :: ac
+                     end
+            fun loop (ds, sds, ac) =
+               case ds of
+                  [] => finish (sds, ac)
+                | d :: ds =>
+                     case Topdec.node d of
+                        Topdec.Strdec d => loop (ds, d :: sds, ac)
+                      | _ => loop (ds, [], d :: finish (sds, ac))
+         in
+            T (List.map (dss, fn ds => rev (loop (ds, [], []))))
+         end
 
       val coalesce =
-	 Trace.trace ("Ast.Program.coalesce", layout, layout) coalesce
+         Trace.trace ("AstPrograms.Program.coalesce", layout, layout) coalesce
 
       fun size (T dss): int =
-	 let
-	    val n = ref 0
-	    fun inc () = n := 1 + !n
-	    fun dec (d: Dec.t): unit =
-	       let
-		  datatype z = datatype Dec.node
-	       in
-		  case Dec.node d of
-		     Abstype {body, ...} => dec body
-		   | Exception cs => Vector.foreach (cs, fn _ => inc ())
-		   | Fun (_, ds) =>
-			Vector.foreach (ds, fn clauses =>
-					Vector.foreach (clauses, exp o #body))
-		   | Local (d, d') => (dec d; dec d')
-		   | SeqDec ds => Vector.foreach (ds, dec)
-		   | Val {vbs, rvbs, ...} =>
-			(Vector.foreach (vbs, exp o #exp)
-			 ; Vector.foreach (rvbs, match o #match))
-		   | _ => ()
-	       end
-	    and exp (e: Exp.t): unit =
-	       let
-		  val _ = inc ()
-		  datatype z = datatype Exp.node
-	       in
-		  case Exp.node e of
-		     Andalso (e1, e2) => (exp e1; exp e2)
-		   | App (e, e') => (exp e; exp e')
-		   | Case (e, m) => (exp e; match m)
-		   | Constraint (e, _) => exp e
-		   | FlatApp es => exps es
-		   | Fn m => match m
-		   | Handle (e, m) => (exp e; match m)
-		   | If (e1, e2, e3) => (exp e1; exp e2; exp e3)
-		   | Let (d, e) => (dec d; exp e)
-		   | List es => Vector.foreach (es, exp)
-		   | Orelse (e1, e2) => (exp e1; exp e2)
-		   | Raise exn => exp exn
-		   | Record r => Record.foreach (r, exp)
-		   | Seq es => exps es
-		   | While {test, expr} => (exp test; exp expr)
-		   | _ => ()
-	       end
-	    and exps es = Vector.foreach (es, exp)
-	    and match m =
-	       let
-		  val Match.T rules = Match.node m
-	       in
-		  Vector.foreach (rules, exp o #2)
-	       end
-	    fun strdec d =
-	       let
-		  datatype z = datatype Strdec.node
-	       in
-		  case Strdec.node d of
-		     Core d => dec d
-		   | Local (d, d') => (strdec d; strdec d')
-		   | Seq ds => List.foreach (ds, strdec)
-		   | Structure ds =>
-			Vector.foreach (ds, fn {def, ...} => strexp def)
-	       end
-	    and strexp e =
-	       let
-		  datatype z = datatype Strexp.node
-	       in
-		  case Strexp.node e of
-		     Struct d => strdec d
-		   | Constrained (e, _) => strexp e
-		   | App (_, e) => strexp e
-		   | Let (d, e) => (strdec d; strexp e)
-		   | _ => ()
-	       end
+         let
+            val n = ref 0
+            fun inc () = n := 1 + !n
+            fun dec (d: Dec.t): unit =
+               let
+                  datatype z = datatype Dec.node
+               in
+                  case Dec.node d of
+                     Abstype {body, ...} => dec body
+                   | Exception cs => Vector.foreach (cs, fn _ => inc ())
+                   | Fun (_, ds) =>
+                        Vector.foreach (ds, fn clauses =>
+                                        Vector.foreach (clauses, exp o #body))
+                   | Local (d, d') => (dec d; dec d')
+                   | SeqDec ds => Vector.foreach (ds, dec)
+                   | Val {vbs, rvbs, ...} =>
+                        (Vector.foreach (vbs, exp o #exp)
+                         ; Vector.foreach (rvbs, match o #match))
+                   | _ => ()
+               end
+            and exp (e: Exp.t): unit =
+               let
+                  val _ = inc ()
+                  datatype z = datatype Exp.node
+               in
+                  case Exp.node e of
+                     Andalso (e1, e2) => (exp e1; exp e2)
+                   | App (e, e') => (exp e; exp e')
+                   | Case (e, m) => (exp e; match m)
+                   | Constraint (e, _) => exp e
+                   | FlatApp es => exps es
+                   | Fn m => match m
+                   | Handle (e, m) => (exp e; match m)
+                   | If (e1, e2, e3) => (exp e1; exp e2; exp e3)
+                   | Let (d, e) => (dec d; exp e)
+                   | List es => Vector.foreach (es, exp)
+                   | Orelse (e1, e2) => (exp e1; exp e2)
+                   | Raise exn => exp exn
+                   | Record r => Record.foreach (r, exp)
+                   | Seq es => exps es
+                   | While {test, expr} => (exp test; exp expr)
+                   | _ => ()
+               end
+            and exps es = Vector.foreach (es, exp)
+            and match m =
+               let
+                  val Match.T rules = Match.node m
+               in
+                  Vector.foreach (rules, exp o #2)
+               end
+            fun strdec d =
+               let
+                  datatype z = datatype Strdec.node
+               in
+                  case Strdec.node d of
+                     Core d => dec d
+                   | Local (d, d') => (strdec d; strdec d')
+                   | Seq ds => List.foreach (ds, strdec)
+                   | Structure ds =>
+                        Vector.foreach (ds, fn {def, ...} => strexp def)
+               end
+            and strexp e =
+               let
+                  datatype z = datatype Strexp.node
+               in
+                  case Strexp.node e of
+                     Struct d => strdec d
+                   | Constrained (e, _) => strexp e
+                   | App (_, e) => strexp e
+                   | Let (d, e) => (strdec d; strexp e)
+                   | _ => ()
+               end
 
-	    fun topdec d =
-	       let
-		  datatype z = datatype Topdec.node
-	       in
-		  case Topdec.node d of
-		     Functor ds =>
-			Vector.foreach (ds, fn {body, ...} => strexp body)
-		   | Strdec d => strdec d
-		   | _ => ()
-	       end
-	    val _ = List.foreach (dss, fn ds => List.foreach (ds, topdec))
-	 in
-	    !n
-	 end
+            fun topdec d =
+               let
+                  datatype z = datatype Topdec.node
+               in
+                  case Topdec.node d of
+                     Functor ds =>
+                        Vector.foreach (ds, fn {body, ...} => strexp body)
+                   | Strdec d => strdec d
+                   | _ => ()
+               end
+            val _ = List.foreach (dss, fn ds => List.foreach (ds, topdec))
+         in
+            !n
+         end
    end
 
 end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ast/ast-programs.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ast/ast-programs.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ast/ast-programs.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature AST_PROGRAMS_STRUCTS =
    sig
       include AST_ATOMS_STRUCTS
@@ -15,14 +16,14 @@
       include AST_MODULES
 
       structure Program:
-	 sig
-	    datatype t = T of Topdec.t list list
+         sig
+            datatype t = T of Topdec.t list list
 
-	    val append: t * t -> t
-	    val checkSyntax: t -> unit
-	    val coalesce: t -> t
-	    val empty: t
-	    val size: t -> int
-	    val layout: t -> Layout.t
-	 end
+            val append: t * t -> t
+            val checkSyntax: t -> unit
+            val coalesce: t -> t
+            val empty: t
+            val size: t -> int
+            val layout: t -> Layout.t
+         end
    end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ast/ast.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ast/ast.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ast/ast.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 functor Ast (S: AST_STRUCTS): AST = 
 struct
 

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ast/ast.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ast/ast.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ast/ast.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature AST_STRUCTS =
    sig
       include AST_ATOMS_STRUCTS

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ast/char-size.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ast/char-size.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ast/char-size.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,8 +1,8 @@
-(* Copyright (C) 2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 2004-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 functor CharSize (S: CHAR_SIZE_STRUCTS): CHAR_SIZE = 
@@ -14,8 +14,6 @@
 
 val all = [C1, C2, C4]
 
-val stub = fn _ => raise Fail "CharSize"
-
 fun bits s =
    Bits.fromInt
    (case s of

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ast/char-size.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ast/char-size.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ast/char-size.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,8 +1,8 @@
-(* Copyright (C) 2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 2004-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 signature CHAR_SIZE_STRUCTS = 

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ast/field.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ast/field.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ast/field.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 functor Field (S: FIELD_STRUCTS): FIELD = 
 struct
 
@@ -22,9 +23,9 @@
 val toString =
    fn Int n => Int.toString (n + 1)
     | Symbol s => Symbol.toString s
-	 
+         
 val layout = Layout.str o toString
-	 
+         
 val op <= =
    fn (Int n, Int n') => Int.<= (n, n')
     | (Symbol s, Symbol s') => Symbol.<= (s, s')

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ast/field.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ast/field.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ast/field.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,9 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 type int = Int.t
@@ -18,7 +18,7 @@
       include FIELD_STRUCTS
       
       datatype t =
-	 Int of int
+         Int of int
        | Symbol of Symbol.t
 
       val <= : t * t -> bool (* ordering used for sorting *)

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ast/int-size.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ast/int-size.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ast/int-size.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,8 +1,8 @@
-(* Copyright (C) 2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 2004-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 functor IntSize (S: INT_SIZE_STRUCTS): INT_SIZE =
@@ -29,20 +29,20 @@
    Vector.toList
    (Vector.keepAllMap
     (Vector.tabulate (65, fn i => if isValidSize i
-				     then SOME (Bits.fromInt i)
-				  else NONE),
+                                     then SOME (Bits.fromInt i)
+                                  else NONE),
      fn i => i))
 
 fun make i = T {bits = i}
 
 val allVector = Vector.tabulate (65, fn i =>
-				  if isValidSize i
-				     then SOME (make (Bits.fromInt i))
-				  else NONE)
+                                  if isValidSize i
+                                     then SOME (make (Bits.fromInt i))
+                                  else NONE)
 
 fun I (b: Bits.t): t =
    case Vector.sub (allVector, Bits.toInt b) handle Subscript => NONE of
-      NONE => Error.bug (concat ["strange int size: ", Bits.toString b])
+      NONE => Error.bug (concat ["IntSize.I: strange int size: ", Bits.toString b])
     | SOME s => s
 
 val all = List.map (sizes, I)
@@ -63,15 +63,15 @@
    let
       val bits = Bits.toInt (bits s)
       val bits =
-	 if bits <= 8
-	    then 8
-	 else if bits <= 16
-		 then 16
-	      else if bits <= 32
-		      then 32
-		   else if bits = 64
-			   then 64
-			else Error.bug "IntSize.roundUpToPrim"
+         if bits <= 8
+            then 8
+         else if bits <= 16
+                 then 16
+              else if bits <= 32
+                      then 32
+                   else if bits = 64
+                           then 64
+                        else Error.bug "IntSize.roundUpToPrim"
    in
       I (Bits.fromInt bits)
    end
@@ -84,9 +84,9 @@
 
 val primOpt =
    memoize (fn T {bits, ...} =>
-	    List.peekMap ([(8, I8), (16, I16), (32, I32), (64, I64)],
-			  fn (b, p) =>
-			  if b = Bits.toInt bits then SOME p else NONE))
+            List.peekMap ([(8, I8), (16, I16), (32, I32), (64, I64)],
+                          fn (b, p) =>
+                          if b = Bits.toInt bits then SOME p else NONE))
 
 fun prim s =
    case primOpt s of

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ast/int-size.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ast/int-size.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ast/int-size.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,8 +1,8 @@
-(* Copyright (C) 2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 2004-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 type int = Int.t
@@ -14,7 +14,7 @@
 signature INT_SIZE =
    sig
       include INT_SIZE_STRUCTS
-	 
+         
       type t
 
       val all: t list

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ast/longid.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ast/longid.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ast/longid.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,17 +1,18 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 functor Longid (S: LONGID_STRUCTS): LONGID =
 struct
 
 open S
 
 datatype node = T of {strids: Strid.t list,
-		      id: Id.t}
+                      id: Id.t}
    
 type node' = node
 structure Wrap = Region.Wrap
@@ -31,7 +32,7 @@
       val (T {strids, id}, region) = dest id
    in
       makeRegion (T {strids = strid :: strids, id = id},
-		 region)
+                 region)
    end
 
 fun prepends (id, strids') =
@@ -39,7 +40,7 @@
       val (T {strids, id}, region) = dest id
    in
       makeRegion (T {strids = strids' @ strids, id = id},
-		 region)
+                 region)
    end
 
 fun isLong id =
@@ -67,9 +68,9 @@
    
 fun long (strids, id) =
    makeRegion (T {strids = strids, id = id},
-	       case strids of
-		  [] => Id.region id
-		| s :: _ => Region.append (Strid.region s, Id.region id))
+               case strids of
+                  [] => Id.region id
+                | s :: _ => Region.append (Strid.region s, Id.region id))
 
 fun short id = long ([], id)
 
@@ -79,10 +80,10 @@
       open Layout
    in
       seq [case strids of
-	      [] => empty
-	    | _ => seq [seq (separate (List.map (strids, Strid.layout), ".")),
-			str "."],
-	   Id.layout id]
+              [] => empty
+            | _ => seq [seq (separate (List.map (strids, Strid.layout), ".")),
+                        str "."],
+           Id.layout id]
    end
 
 val toString = Layout.toString o layout
@@ -92,9 +93,9 @@
       val (strids, id) = List.splitLast ss
    in
       makeRegion (T {strids = List.map (strids, fn s =>
-					Strid.fromSymbol (s, region)),
-		     id = Id.fromSymbol (id, region)},
-		  region)
+                                        Strid.fromSymbol (s, region)),
+                     id = Id.fromSymbol (id, region)},
+                  region)
    end
 
 val bogus = short Id.bogus

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ast/longid.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ast/longid.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ast/longid.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature LONGID_STRUCTS =
    sig
       structure Id: AST_ID
@@ -19,10 +20,10 @@
       include T
 
       datatype node = T of {strids: Strid.t list,
-			    id: Id.t}
+                            id: Id.t}
 
       include WRAPPED sharing type node' = node
-		      sharing type obj = t
+                      sharing type obj = t
 
       val bogus: t
       val fromSymbols: Symbol.t list * Region.t -> t

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ast/prim-cons.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ast/prim-cons.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ast/prim-cons.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,17 +1,18 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 functor PrimCons (S: PRIM_CONS_STRUCTS): PRIM_CONS =
 struct
 
 open S
 
 type con = t
-	 
+         
 val cons = fromString "::"
 val falsee = fromString "false"
 val nill = fromString "nil"

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ast/prim-cons.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ast/prim-cons.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ast/prim-cons.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature PRIM_CONS_STRUCTS =
    sig
       type t

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ast/prim-tycons.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ast/prim-tycons.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ast/prim-tycons.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,9 @@
 (* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 functor PrimTycons (S: PRIM_TYCONS_STRUCTS): PRIM_TYCONS =
@@ -31,56 +31,59 @@
 datatype z = datatype Kind.t
 datatype z = datatype AdmitsEquality.t
 
+val isBool = fn c => equals (c, bool)
+val isExn = fn c => equals (c, exn)
+
 local
    fun 'a make (prefix: string,
-		all: 'a list,
-		bits: 'a -> Bits.t,
-		default: 'a,
-		equalsA: 'a * 'a -> bool,
-		memo: ('a -> t) -> ('a -> t),
-		admitsEquality: AdmitsEquality.t) =
+                all: 'a list,
+                bits: 'a -> Bits.t,
+                default: 'a,
+                equalsA: 'a * 'a -> bool,
+                memo: ('a -> t) -> ('a -> t),
+                admitsEquality: AdmitsEquality.t) =
       let
-	 val all =
-	    Vector.fromListMap
-	    (all, fn s =>
-	     (fromString (concat [prefix, Bits.toString (bits s)]), s))
-	 val fromSize =
-	    memo
-	    (fn s =>
-	     case Vector.peek (all, fn (_, s') => equalsA (s, s')) of
-		NONE => Error.bug "missing size"
-	      | SOME (tycon, _) => tycon)
-	 fun is t = Vector.exists (all, fn (t', _) => equals (t, t'))
-	 val prims =
-	    Vector.toListMap (all, fn (tycon, _) =>
-			      (tycon, Arity 0, admitsEquality))
+         val all =
+            Vector.fromListMap
+            (all, fn s =>
+             (fromString (concat [prefix, Bits.toString (bits s)]), s))
+         val fromSize =
+            memo
+            (fn s =>
+             case Vector.peek (all, fn (_, s') => equalsA (s, s')) of
+                NONE => Error.bug "PrimTycons.make"
+              | SOME (tycon, _) => tycon)
+         fun is t = Vector.exists (all, fn (t', _) => equals (t, t'))
+         val prims =
+            Vector.toListMap (all, fn (tycon, _) =>
+                              (tycon, Arity 0, admitsEquality))
       in
-	 (fromSize default, fromSize, all, is, prims)
+         (fromSize default, fromSize, all, is, prims)
       end
 in
-   val (defaultChar, char, chars, isCharX, primChars) =
+   val (defaultChar, char, _, isCharX, primChars) =
       let
-	 open CharSize
+         open CharSize
       in
-	 make ("char", all, bits, default, equals, memoize, Sometimes)
+         make ("char", all, bits, default, equals, memoize, Sometimes)
       end
    val (defaultInt, int, ints, isIntX, primInts) =
       let
-	 open IntSize
+         open IntSize
       in
-	 make ("int", all, bits, default, equals, memoize, Sometimes)
+         make ("int", all, bits, default, equals, memoize, Sometimes)
       end
    val (defaultReal, real, reals, isRealX, primReals) =
       let
-	 open RealSize
+         open RealSize
       in
-	 make ("real", all, bits, default, equals, memoize, Never)
+         make ("real", all, bits, default, equals, memoize, Never)
       end
    val (defaultWord, word, words, isWordX, primWords) =
       let
-	 open WordSize
+         open WordSize
       in
-	 make ("word", all, bits, default, equals, memoize, Sometimes)
+         make ("word", all, bits, default, equals, memoize, Sometimes)
       end
 end
 
@@ -102,49 +105,49 @@
    @ primChars @ primInts @ primReals @ primWords
 
 fun layoutApp (c: t,
-	       args: (Layout.t * {isChar: bool, needsParen: bool}) vector) =
+               args: (Layout.t * {isChar: bool, needsParen: bool}) vector) =
    let
       local
-	 open Layout
+         open Layout
       in
-	 val mayAlign = mayAlign
-	 val seq = seq
-	 val str = str
+         val mayAlign = mayAlign
+         val seq = seq
+         val str = str
       end
       fun maybe (l, {isChar = _, needsParen}) =
-	 if needsParen
-	    then Layout.paren l
-	 else l
+         if needsParen
+            then Layout.paren l
+         else l
       fun normal () =
-	 let
-	    val ({isChar}, lay) =
-	       case Vector.length args of
-		  0 => ({isChar = equals (c, defaultChar)}, layout c)
-		| 1 => ({isChar = false},
-			seq [maybe (Vector.sub (args, 0)), str " ", layout c])
-		| _ => ({isChar = false},
-			seq [Layout.tuple (Vector.toListMap (args, maybe)),
-			     str " ", layout c])
-	 in
-	    (lay, {isChar = isChar, needsParen = false})
-	 end
+         let
+            val ({isChar}, lay) =
+               case Vector.length args of
+                  0 => ({isChar = equals (c, defaultChar)}, layout c)
+                | 1 => ({isChar = false},
+                        seq [maybe (Vector.sub (args, 0)), str " ", layout c])
+                | _ => ({isChar = false},
+                        seq [Layout.tuple (Vector.toListMap (args, maybe)),
+                             str " ", layout c])
+         in
+            (lay, {isChar = isChar, needsParen = false})
+         end
    in
       if equals (c, arrow)
-	 then (mayAlign [maybe (Vector.sub (args, 0)),
-			 seq [str "-> ", maybe (Vector.sub (args, 1))]],
-	       {isChar = false, needsParen = true})
+         then (mayAlign [maybe (Vector.sub (args, 0)),
+                         seq [str "-> ", maybe (Vector.sub (args, 1))]],
+               {isChar = false, needsParen = true})
       else if equals (c, tuple)
          then if 0 = Vector.length args
-		 then (str "unit", {isChar = false, needsParen = false})
-	      else (mayAlign (Layout.separateLeft
-			      (Vector.toListMap (args, maybe), "* ")),
-		    {isChar = false, needsParen = true})
+                 then (str "unit", {isChar = false, needsParen = false})
+              else (mayAlign (Layout.separateLeft
+                              (Vector.toListMap (args, maybe), "* ")),
+                    {isChar = false, needsParen = true})
       else if equals (c, vector)
          then if #isChar (#2 (Vector.sub (args, 0)))
-		 then (str "string", {isChar = false, needsParen = false})
-	      else normal ()
+                 then (str "string", {isChar = false, needsParen = false})
+              else normal ()
       else normal ()
    end
 
 end
-	  
+          

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ast/prim-tycons.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ast/prim-tycons.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ast/prim-tycons.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,9 @@
 (* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 signature PRIM_TYCONS_SUBSTRUCTS =
@@ -45,13 +45,15 @@
       val int: IntSize.t -> tycon
       val ints: (tycon * IntSize.t) vector
       val intInf: tycon
+      val isBool: tycon -> bool
       val isCharX: tycon -> bool
+      val isExn: tycon -> bool
       val isIntX: tycon -> bool
       val isRealX: tycon -> bool
       val isWordX: tycon -> bool
       val layoutApp:
-	 tycon * (Layout.t * {isChar: bool, needsParen: bool}) vector
-	 -> Layout.t * {isChar: bool, needsParen: bool}
+         tycon * (Layout.t * {isChar: bool, needsParen: bool}) vector
+         -> Layout.t * {isChar: bool, needsParen: bool}
       val list: tycon
       val pointer: tycon
       val prims: (tycon * Kind.t * AdmitsEquality.t) list

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ast/real-size.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ast/real-size.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ast/real-size.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,8 +1,8 @@
-(* Copyright (C) 2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 2004-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 functor RealSize (S: REAL_SIZE_STRUCTS): REAL_SIZE = 

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ast/real-size.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ast/real-size.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ast/real-size.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,8 +1,8 @@
-(* Copyright (C) 2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 2004-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 signature REAL_SIZE_STRUCTS = 

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ast/record.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ast/record.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ast/record.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 (* empty tuple is also a record *)
 
 functor Record (S: RECORD_STRUCTS): RECORD = 
@@ -26,7 +27,7 @@
    case r of
       Tuple v => Vector.mapi (v, fn (i, x) => (Field.Int i, x))
     | Record r => r
-	 
+         
 fun detupleOpt (r: 'a t): 'a vector option =
    case r of
       Tuple t => SOME t
@@ -38,15 +39,15 @@
 fun fromVector v =
    let
       fun isTuple v : bool =
-	 Vector.foralli
-	 (v, fn (i, (f, _)) =>
-	  case f of
-	     Field.Int i' => Int.equals (i, i')
-	   | _ => false)
+         Vector.foralli
+         (v, fn (i, (f, _)) =>
+          case f of
+             Field.Int i' => Int.equals (i, i')
+           | _ => false)
       val v = if isSorted then sort v else v
    in
       if isTuple v
-	 then Tuple (Vector.map (v, #2))
+         then Tuple (Vector.map (v, #2))
       else Record v
    end
 
@@ -54,27 +55,27 @@
    case (r, r') of
       (Tuple v, Tuple v') => Vector.equals (v, v', eq)
     | (Record fs, Record fs') =>
-	 Vector.equals
-	 (fs, sort fs', fn ((f, v), (f', v')) =>
-	  Field.equals (f, f') andalso eq (v, v'))
+         Vector.equals
+         (fs, sort fs', fn ((f, v), (f', v')) =>
+          Field.equals (f, f') andalso eq (v, v'))
     | _ => false
 
 val peek: 'a t * Field.t -> 'a option =
    fn (r, f) =>
    case r of
       Record r =>
-	 (case Vector.peek (r, fn (f', _) => Field.equals (f, f')) of
-	     NONE => NONE
-	   | SOME (_, x) => SOME x)
+         (case Vector.peek (r, fn (f', _) => Field.equals (f, f')) of
+             NONE => NONE
+           | SOME (_, x) => SOME x)
     | Tuple t =>
-	 if Vector.isEmpty t
-	    then NONE
-	 else (case f of
-		  Field.Int i =>
-		     if 0 <= i andalso i < Vector.length t
-			then SOME (Vector.sub (t, i))
-		     else NONE
-		| Field.Symbol _ => NONE)
+         if Vector.isEmpty t
+            then NONE
+         else (case f of
+                  Field.Int i =>
+                     if 0 <= i andalso i < Vector.length t
+                        then SOME (Vector.sub (t, i))
+                     else NONE
+                | Field.Symbol _ => NONE)
 
 fun range r =
    case r of
@@ -94,7 +95,7 @@
     | Record r => Vector.fold (r, b, fn ((i, x), b) => f (i, x, b))
 
 fun fold (r, b, f) = foldi (r, b, fn (_, a, b) => f (a, b))
-	  
+          
 fun map (r: 'a t, f: 'a -> 'b): 'b t =
    case r of
       Tuple xs => Tuple (Vector.map (xs, f))
@@ -108,37 +109,37 @@
 fun change (r: 'a t, f: 'a vector -> 'b vector * 'c): 'b t * 'c =
    case r of
       Tuple xs => let val (ys, c) = f xs
-		  in (Tuple ys, c)
-		  end
+                  in (Tuple ys, c)
+                  end
     | Record r => let val (fs, xs) = Vector.unzip r
-		      val (ys, c) = f xs
-		  in (Record (Vector.zip (fs, ys)), c)
-		  end
+                      val (ys, c) = f xs
+                  in (Record (Vector.zip (fs, ys)), c)
+                  end
 
 fun zip z = fromVector (Vector.zip z)
 
 fun unzip r =
    case r of
       Tuple v => (Vector.tabulate (Vector.length v, Field.Int),
-		  v)
+                  v)
     | Record r => Vector.unzip r
 
 fun layout {record, layoutTuple, separator, extra, layoutElt} =
    case (record, extra) of
       (Tuple xs, "") => layoutTuple xs
     | _ =>
-	 let
-	    val r = toVector record
-	    open Layout
-	 in seq [str "{",
-		 mayAlign (separateRight (Vector.toListMap
-					  (r, fn (f, x) =>
-					   seq [Field.layout f,
-						str separator,
-						layoutElt x]),
-					  ",")),
-		 str extra,
-		 str "}"]
-	 end
+         let
+            val r = toVector record
+            open Layout
+         in seq [str "{",
+                 mayAlign (separateRight (Vector.toListMap
+                                          (r, fn (f, x) =>
+                                           seq [Field.layout f,
+                                                str separator,
+                                                layoutElt x]),
+                                          ",")),
+                 str extra,
+                 str "}"]
+         end
 
 end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ast/record.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ast/record.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ast/record.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature RECORD_STRUCTS = 
    sig
       val isSorted: bool
@@ -14,7 +15,7 @@
 signature RECORD = 
    sig
       include RECORD_STRUCTS
-	 
+         
       type 'a t
 
       (* Create a record with the same fields but a new range.
@@ -32,10 +33,10 @@
       val fromVector: (Field.t * 'a) vector -> 'a t
       val isTuple: 'a t -> bool
       val layout: {record: 'a t,
-		   separator: string,
-		   extra: string,
-		   layoutTuple: 'a vector -> Layout.t,
-		   layoutElt: 'a -> Layout.t} -> Layout.t
+                   separator: string,
+                   extra: string,
+                   layoutTuple: 'a vector -> Layout.t,
+                   layoutElt: 'a -> Layout.t} -> Layout.t
       val map: 'a t * ('a -> 'b) -> 'b t
       val peek: 'a t * Field.t -> 'a option
       (* range {1 = a, 2 = b, 3 = c} returns [a, b, c] *)

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ast/sources.cm
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ast/sources.cm	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ast/sources.cm	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 Group
 
 signature ADMITS_EQUALITY

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ast/sources.mlb
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ast/sources.mlb	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ast/sources.mlb	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,81 +1,79 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 local
-    ../../lib/mlton/sources.mlb
-    ../control/sources.mlb
+   ../../lib/mlton/sources.mlb
+   ../control/sources.mlb
 
-    admits-equality.sig
-    admits-equality.fun
-    wrapped.sig
-    ast-const.sig
-    ast-const.fun
-    symbol.sig
-    symbol.fun
-    ast-id.sig
-    ast-id.fun
-    field.sig
-    field.fun
-    char-size.sig
-    char-size.fun
-    int-size.sig
-    int-size.fun
-    longid.sig
-    longid.fun
-    prim-cons.sig
-    prim-cons.fun
-    real-size.sig
-    real-size.fun
-    word-size.sig
-    word-size.fun
-    tycon-kind.sig
-    tycon-kind.fun
-    prim-tycons.sig
-    prim-tycons.fun
-    record.sig
-    record.fun
-    tyvar.sig
-    tyvar.fun
-    ast-atoms.sig
-    ast-atoms.fun
-    ast-core.sig
-    ast-core.fun
-    ast-modules.sig
-    ast-modules.fun
-    ast-programs.sig
-    ast-programs.fun
-    ast-mlbs.sig
-    ast-mlbs.fun
-    ast.sig
-    ast.fun
+   admits-equality.sig
+   admits-equality.fun
+   wrapped.sig
+   ast-const.sig
+   ast-const.fun
+   symbol.sig
+   symbol.fun
+   ast-id.sig
+   ast-id.fun
+   field.sig
+   field.fun
+   char-size.sig
+   char-size.fun
+   int-size.sig
+   int-size.fun
+   longid.sig
+   longid.fun
+   prim-cons.sig
+   prim-cons.fun
+   real-size.sig
+   real-size.fun
+   word-size.sig
+   word-size.fun
+   tycon-kind.sig
+   tycon-kind.fun
+   prim-tycons.sig
+   prim-tycons.fun
+   record.sig
+   record.fun
+   tyvar.sig
+   tyvar.fun
+   ast-atoms.sig
+   ast-atoms.fun
+   ast-core.sig
+   ast-core.fun
+   ast-modules.sig
+   ast-modules.fun
+   ast-programs.sig
+   ast-programs.fun
+   ast-mlbs.sig
+   ast-mlbs.fun
+   ast.sig
+   ast.fun
 in
-    signature ADMITS_EQUALITY
-    signature AST
-    signature CHAR_SIZE
-    signature FIELD
-    signature INT_SIZE
-    signature LONGID
-    signature PRIM_CONS
-    signature PRIM_TYCONS
-    signature REAL_SIZE
-    signature RECORD
-    signature SYMBOL
-    signature TYCON_KIND
-    signature TYVAR
-    signature WORD_SIZE
-    signature WRAPPED
+   signature ADMITS_EQUALITY
+   signature AST
+   signature CHAR_SIZE
+   signature FIELD
+   signature INT_SIZE
+   signature PRIM_CONS
+   signature PRIM_TYCONS
+   signature REAL_SIZE
+   signature RECORD
+   signature TYCON_KIND
+   signature TYVAR
+   signature WORD_SIZE
 
-    functor AdmitsEquality
-    functor Ast
-    functor Field
-    functor PrimCons
-    functor PrimTycons
-    functor Record
-    functor Symbol
-    functor TyconKind
-    functor Tyvar
+   functor AdmitsEquality
+   functor Ast
+   functor Field
+   functor PrimCons
+   functor PrimTycons
+   functor Record
+   functor Symbol
+   functor TyconKind
+   functor Tyvar
 end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ast/symbol.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ast/symbol.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ast/symbol.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,10 @@
+(* Copyright (C) 2004-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 functor Symbol (S: SYMBOL_STRUCTS): SYMBOL = 
 struct
 
@@ -4,8 +11,8 @@
 open S
 
 datatype t = T of {hash: word,
-		   name: string,
-		   plist: PropertyList.t}
+                   name: string,
+                   plist: PropertyList.t}
 
 local
    fun make f (T r) = f r
@@ -24,8 +31,8 @@
       HashSet.lookupOrInsert
       (table, hash, fn T {name, ...} => s = name,
        fn () => T {hash = hash,
-		   name = s,
-		   plist = PropertyList.new ()})
+                   name = s,
+                   plist = PropertyList.new ()})
    end
 
 fun foreach f = HashSet.foreach (table, f)

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ast/symbol.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ast/symbol.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ast/symbol.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,10 @@
+(* Copyright (C) 2004-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 type word = Word.t
    
 signature SYMBOL_STRUCTS = 

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ast/tycon-kind.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ast/tycon-kind.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ast/tycon-kind.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,10 @@
+(* Copyright (C) 2003-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 functor TyconKind (S: TYCON_KIND_STRUCTS): TYCON_KIND = 
 struct
 
@@ -16,7 +23,7 @@
     | (Nary, Nary) => true
     | _ => false
 
-val equals = Trace.trace2 ("Kind.equals", layout, layout, Bool.layout) equals
-	 
+val equals = Trace.trace2 ("TyconKind.equals", layout, layout, Bool.layout) equals
+         
 end
 

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ast/tycon-kind.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ast/tycon-kind.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ast/tycon-kind.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,10 @@
+(* Copyright (C) 2003-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 type int = Int.t
 
 signature TYCON_KIND_STRUCTS = 
@@ -9,7 +16,7 @@
       include TYCON_KIND_STRUCTS
       
       datatype t =
-	 Arity of int
+         Arity of int
        | Nary
 
       val equals: t * t -> bool

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ast/tyvar.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ast/tyvar.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ast/tyvar.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 functor Tyvar (S: TYVAR_STRUCTS): TYVAR = 
 struct
 
@@ -13,9 +14,9 @@
 structure Wrap = Region.Wrap
 open Wrap
 type node' = {name: string,
-	      equality: bool,
-	      hash: Word.t,
-	      plist: PropertyList.t}
+              equality: bool,
+              hash: Word.t,
+              plist: PropertyList.t}
 type t = node' Wrap.t
 type obj = t
 
@@ -41,42 +42,42 @@
    
 fun newRegion ({name, equality}, region) =
    makeRegion ({name = name,
-		equality = equality,
-		hash = Random.word (),
-		plist = PropertyList.new ()},
-	       region)
+                equality = equality,
+                hash = Random.word (),
+                plist = PropertyList.new ()},
+               region)
 
 fun new f = newRegion (f, Region.bogus)
 
 fun newLike a = newRegion ({equality = isEquality a,
-			    name = name a},
-			   region a)
+                            name = name a},
+                           region a)
 
 fun newString (s, {left, right}) =
    newRegion (if String.size s > 1
-		 andalso Char.equals (#"'", String.sub (s, 1))
-		 then {name = String.dropPrefix (s, 2),
-		       equality = true}
-	      else {name = String.dropPrefix (s, 1),
-		    equality = false},
-	      Region.make {left = left, right = right})
+                 andalso Char.equals (#"'", String.sub (s, 1))
+                 then {name = String.dropPrefix (s, 2),
+                       equality = true}
+              else {name = String.dropPrefix (s, 1),
+                    equality = false},
+              Region.make {left = left, right = right})
 
 (*val make = Trace.trace2 ("Tyvar.make", String.layout, Bool.layout,
- *			layout) make
+ *                      layout) make
  *)
 
 local val c = Counter.new 0
 in fun reset () = Counter.reset (c, 0)
    fun newNoname {equality} =
       new {name = "a_" ^ Int.toString (Counter.next c),
-	   equality = equality}
+           equality = equality}
 end
 
 local open Layout
 in
    fun layouts ts =
       case Vector.length ts of
-	 0 => empty
+         0 => empty
        | 1 => layout (Vector.sub (ts, 0))
        | _ => Vector.layout layout ts
 end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ast/tyvar.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ast/tyvar.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ast/tyvar.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature TYVAR_STRUCTS = 
    sig
    end
@@ -29,7 +30,7 @@
        * newString "''a" creates an equality type variable named a
        *)
       val newString: string * {left: SourcePos.t,
-			       right: SourcePos.t} -> t
+                               right: SourcePos.t} -> t
       val plist: t -> PropertyList.t
       (* reset the counter for new type variables *)
       val reset: unit -> unit 

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ast/word-size.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ast/word-size.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ast/word-size.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,8 +1,8 @@
-(* Copyright (C) 2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 2004-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 functor WordSize (S: WORD_SIZE_STRUCTS): WORD_SIZE =
@@ -25,7 +25,7 @@
 fun fromBits (b: Bits.t): t =
    if Bits.>= (b, Bits.zero)
       then T b
-   else Error.bug (concat ["strange word size: ", Bits.toString b])
+   else Error.bug (concat ["WordSize.fromBits: strange word size: ", Bits.toString b])
 
 fun isValidSize (i: int) =
    (1 <= i andalso i <= 32) orelse i = 64
@@ -35,9 +35,9 @@
 val byte = fromBits (Bits.fromInt 8)
 
 val allVector = Vector.tabulate (65, fn i =>
-				  if isValidSize i
-				     then SOME (fromBits (Bits.fromInt i))
-				  else NONE)
+                                  if isValidSize i
+                                     then SOME (fromBits (Bits.fromInt i))
+                                  else NONE)
 
 val all: t list = Vector.toList (Vector.keepAllMap (allVector, fn so => so))
 
@@ -59,15 +59,15 @@
    let
       val bits = Bits.toInt (bits s)
       val bits =
-	 if bits <= 8
-	    then 8
-	 else if bits <= 16
-		 then 16
-	      else if bits <= 32
-		      then 32
-		   else if bits = 64
-			   then 64
-			else Error.bug "WordSize.roundUpToPrim"
+         if bits <= 8
+            then 8
+         else if bits <= 16
+                 then 16
+              else if bits <= 32
+                      then 32
+                   else if bits = 64
+                           then 64
+                        else Error.bug "WordSize.roundUpToPrim"
    in
       fromBits (Bits.fromInt bits)
    end
@@ -79,11 +79,11 @@
 fun range (s, {signed}) =
    if signed
       then
-	 let
-	    val pow = IntInf.pow (2, Bits.toInt (bits s) - 1)
-	 in
-	    (~ pow, pow - 1)
-	 end
+         let
+            val pow = IntInf.pow (2, Bits.toInt (bits s) - 1)
+         in
+            (~ pow, pow - 1)
+         end
    else (0, cardinality s - 1)
 
 val min = #1 o range
@@ -103,7 +103,7 @@
       val b = Bits.toInt (bits s)
    in
       List.peekMap ([(8, W8), (16, W16), (32, W32), (64, W64)],
-		    fn (b', p) => if b = b' then SOME p else NONE)
+                    fn (b', p) => if b = b' then SOME p else NONE)
    end
 
 fun prim s =

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ast/word-size.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ast/word-size.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ast/word-size.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,8 +1,8 @@
-(* Copyright (C) 2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 2004-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 type int = Int.t

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ast/wrapped.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ast/wrapped.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ast/wrapped.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature WRAPPED =
    sig
       type node'

Modified: mlton/branches/on-20050420-cmm-branch/mlton/atoms/atoms.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/atoms/atoms.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/atoms/atoms.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,9 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 functor Atoms (S: ATOMS_STRUCTS): ATOMS =
@@ -18,38 +18,38 @@
       structure ProfileExp = ProfileExp (structure SourceInfo = SourceInfo)
       structure Var = Var ()
       structure Tycon = Tycon (structure CharSize = CharSize
-			       structure IntSize = IntSize
-			       structure RealSize = RealSize
-			       structure WordSize = WordSize)
+                               structure IntSize = IntSize
+                               structure RealSize = RealSize
+                               structure WordSize = WordSize)
       structure Con = Con ()
       structure CType = CType (structure RealSize = RealSize
-			       structure WordSize = WordSize)
+                               structure WordSize = WordSize)
       structure RealX = RealX (structure RealSize = RealSize)
       structure WordX = WordX (structure WordSize = WordSize)
       structure WordXVector = WordXVector (structure WordSize = WordSize
-					   structure WordX = WordX)
+                                           structure WordX = WordX)
       structure Func =
-	 struct
-	    open Var
-	    fun newNoname () = newString "F"
-	 end
+         struct
+            open Var
+            fun newNoname () = newString "F"
+         end
       structure Label =
-	 struct
-	    open Func
-	    fun newNoname () = newString "L"
-	 end
+         struct
+            open Func
+            fun newNoname () = newString "L"
+         end
       structure Const = Const (structure RealX = RealX
-			       structure WordX = WordX
-			       structure WordXVector = WordXVector)
+                               structure WordX = WordX
+                               structure WordXVector = WordXVector)
       structure CFunction = CFunction (structure CType = CType)
       structure Prim = Prim (structure CFunction = CFunction
-			     structure CType = CType
-			     structure Con = Con
-			     structure Const = Const
-			     structure RealSize = RealSize
-			     structure WordSize = WordSize)
+                             structure CType = CType
+                             structure Con = Con
+                             structure Const = Const
+                             structure RealSize = RealSize
+                             structure WordSize = WordSize)
       structure Ffi = Ffi (structure CFunction = CFunction
-			   structure CType = CType)
+                           structure CType = CType)
       structure Tyvars = UnorderedSet (Tyvar)
       structure Vars = UnorderedSet (Var)
       structure Cons = UnorderedSet (Con)

Modified: mlton/branches/on-20050420-cmm-branch/mlton/atoms/atoms.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/atoms/atoms.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/atoms/atoms.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature ATOMS_STRUCTS =
    sig
       structure Field: FIELD
@@ -50,11 +51,11 @@
       sharing Const = Prim.Const
       sharing IntSize = Tycon.IntSize
       sharing RealSize = CType.RealSize = Prim.RealSize = RealX.RealSize
-	 = Tycon.RealSize
+         = Tycon.RealSize
       sharing RealX = Const.RealX
       sharing SourceInfo = ProfileExp.SourceInfo
       sharing WordSize = CType.WordSize = Prim.WordSize = Tycon.WordSize
-	 = WordX.WordSize
+         = WordX.WordSize
       sharing WordX = Const.WordX = WordXVector.WordX
       sharing WordXVector = Const.WordXVector
    end
@@ -62,7 +63,7 @@
 signature ATOMS =
    sig
       structure Atoms: ATOMS'
-	 
+         
       include ATOMS'
 
       (* For each structure, like CFunction, I would like to write two sharing

Modified: mlton/branches/on-20050420-cmm-branch/mlton/atoms/c-function.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/atoms/c-function.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/atoms/c-function.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,10 @@
+(* Copyright (C) 2003-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 functor CFunction (S: C_FUNCTION_STRUCTS): C_FUNCTION = 
 struct
 
@@ -6,12 +13,12 @@
 structure Convention =
    struct
       datatype t =
-	 Cdecl
+         Cdecl
        | Stdcall
 
       val toString =
-	 fn Cdecl => "cdecl"
-	  | Stdcall => "stdcall"
+         fn Cdecl => "cdecl"
+          | Stdcall => "stdcall"
 
       val layout = Layout.str o toString
    end
@@ -19,39 +26,39 @@
 structure Target =
    struct
       datatype t =
-	 Direct of string
+         Direct of string
        | Indirect
 
       val toString =
-	 fn Direct name => name
-	  | Indirect => "<*>"
+         fn Direct name => name
+          | Indirect => "<*>"
 
       val layout = Layout.str o toString
 
       val equals =
-	 fn (Direct name, Direct name') => name = name'
-	  | (Indirect, Indirect) => true
-	  | _ => false
+         fn (Direct name, Direct name') => name = name'
+          | (Indirect, Indirect) => true
+          | _ => false
    end
 datatype z = datatype Target.t
 
 datatype 'a t = T of {args: 'a vector,
-		      bytesNeeded: int option,
-		      convention: Convention.t,
-		      ensuresBytesFree: bool,
-		      mayGC: bool,
-		      maySwitchThreads: bool,
-		      modifiesFrontier: bool,
-		      prototype: CType.t vector * CType.t option,
-		      readsStackTop: bool,
-		      return: 'a,
-		      target: Target.t,
-		      writesStackTop: bool}
+                      bytesNeeded: int option,
+                      convention: Convention.t,
+                      ensuresBytesFree: bool,
+                      mayGC: bool,
+                      maySwitchThreads: bool,
+                      modifiesFrontier: bool,
+                      prototype: CType.t vector * CType.t option,
+                      readsStackTop: bool,
+                      return: 'a,
+                      target: Target.t,
+                      writesStackTop: bool}
    
 fun layout (T {args, bytesNeeded, convention, ensuresBytesFree, mayGC,
-	       maySwitchThreads, modifiesFrontier, prototype, readsStackTop,
-	       return, target, writesStackTop, ...},
-	    layoutType) =
+               maySwitchThreads, modifiesFrontier, prototype, readsStackTop,
+               return, target, writesStackTop, ...},
+            layoutType) =
    Layout.record
    [("args", Vector.layout layoutType args),
     ("bytesNeeded", Option.layout Int.layout bytesNeeded),
@@ -61,9 +68,9 @@
     ("maySwitchThreads", Bool.layout maySwitchThreads),
     ("modifiesFrontier", Bool.layout modifiesFrontier),
     ("prototype", (fn (args,ret) => 
-		   Layout.record
-		   [("args", Vector.layout CType.layout args),
-		    ("res", Option.layout CType.layout ret)]) prototype),
+                   Layout.record
+                   [("args", Vector.layout CType.layout args),
+                    ("res", Option.layout CType.layout ret)]) prototype),
     ("readsStackTop", Bool.layout readsStackTop),
     ("return", layoutType return),
     ("target", Target.layout target),
@@ -89,9 +96,9 @@
 fun equals (f, f') = Target.equals (target f, target f')
 
 fun map (T {args, bytesNeeded, convention, ensuresBytesFree, mayGC,
-	    maySwitchThreads, modifiesFrontier, prototype, readsStackTop, 
-	    return, target, writesStackTop},
-	 f) =
+            maySwitchThreads, modifiesFrontier, prototype, readsStackTop, 
+            return, target, writesStackTop},
+         f) =
    T {args = Vector.map (args, f),
       bytesNeeded = bytesNeeded,
       convention = convention,
@@ -106,18 +113,18 @@
       writesStackTop = writesStackTop}
    
 fun isOk (T {ensuresBytesFree, mayGC, maySwitchThreads, modifiesFrontier,
-	     readsStackTop, return, writesStackTop, ...},
-	  {isUnit}): bool =
+             readsStackTop, return, writesStackTop, ...},
+          {isUnit}): bool =
    (if maySwitchThreads
        then mayGC andalso isUnit return
     else true)
    andalso (if ensuresBytesFree orelse maySwitchThreads
-	       then mayGC
-	    else true)
+               then mayGC
+            else true)
    andalso (if mayGC
-	       then (modifiesFrontier
-		     andalso readsStackTop andalso writesStackTop)
-	    else true)
+               then (modifiesFrontier
+                     andalso readsStackTop andalso writesStackTop)
+            else true)
    andalso (not writesStackTop orelse readsStackTop )
 
 fun vanilla {args, name, prototype, return} =
@@ -137,46 +144,46 @@
 fun cPrototype (T {convention, prototype = (args, return), target, ...}) =
    let
       val attributes =
-	 if convention <> Convention.Cdecl
-	    then concat [" __attribute__ ((",
-			 Convention.toString convention,
-			 ")) "]
-	 else " "
+         if convention <> Convention.Cdecl
+            then concat [" __attribute__ ((",
+                         Convention.toString convention,
+                         ")) "]
+         else " "
       val name = 
-	 case target of
-	    Direct name => name
-	  | Indirect => Error.bug "prototype of Indirect"
+         case target of
+            Direct name => name
+          | Indirect => Error.bug "CFunction.cPrototype: Indirect"
       val c = Counter.new 0
       fun arg t =
-	 concat [CType.toString t, " x", Int.toString (Counter.next c)]
+         concat [CType.toString t, " x", Int.toString (Counter.next c)]
       val return =
-	 case return of
-	    NONE => "void"
-	  | SOME t => CType.toString t
+         case return of
+            NONE => "void"
+          | SOME t => CType.toString t
    in
       concat [return, attributes, name,
-	      " (",
-	      concat (List.separate (Vector.toListMap (args, arg), ", ")),
-	      ")"]
+              " (",
+              concat (List.separate (Vector.toListMap (args, arg), ", ")),
+              ")"]
    end
 
 fun cPointerType (T {convention, prototype = (args, return), ...}) =
    let
       val attributes =
-	 if convention <> Convention.Cdecl
-	    then concat [" __attribute__ ((",
-			 Convention.toString convention,
-			 ")) "]
-	 else " "
+         if convention <> Convention.Cdecl
+            then concat [" __attribute__ ((",
+                         Convention.toString convention,
+                         ")) "]
+         else " "
       fun arg t = CType.toString t
       val return =
-	 case return of
-	    NONE => "void"
-	  | SOME t => CType.toString t
+         case return of
+            NONE => "void"
+          | SOME t => CType.toString t
    in
       concat
       ["(", return, attributes, 
-       "(*)(", 	     
+       "(*)(",       
        concat (List.separate (Vector.toListMap (args, arg), ", ")),
        "))"]
    end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/atoms/c-function.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/atoms/c-function.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/atoms/c-function.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,8 +1,8 @@
-(* Copyright (C) 2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 2004-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 type int = Int.t
@@ -17,44 +17,44 @@
       include C_FUNCTION_STRUCTS
 
       structure Convention:
-	 sig
-	    datatype t = Cdecl | Stdcall
+         sig
+            datatype t = Cdecl | Stdcall
 
-	    val layout: t -> Layout.t
-	    val toString: t -> string
-	 end
+            val layout: t -> Layout.t
+            val toString: t -> string
+         end
 
       structure Target:
-	 sig
-	    datatype t = Direct of string | Indirect
+         sig
+            datatype t = Direct of string | Indirect
 
-	    val layout: t -> Layout.t
-	    val toString: t -> string
-	 end
+            val layout: t -> Layout.t
+            val toString: t -> string
+         end
 
       datatype 'a t = T of {args: 'a vector,
-			    (* bytesNeeded = SOME i means that the i'th
-			     * argument to the function is a word that
-			     * specifies the number of bytes that must be
-			     * free in order for the C function to succeed.
-			     * Limit check insertion is responsible for
-			     * making sure that the bytesNeeded is available.
-			     *)
-			    bytesNeeded: int option,
-			    convention: Convention.t,
-			    ensuresBytesFree: bool,
-			    mayGC: bool,
-			    maySwitchThreads: bool,
-			    modifiesFrontier: bool,
-			    prototype: CType.t vector * CType.t option,
-			    readsStackTop: bool,
-			    return: 'a,
-			    (* target = Indirect means that the 0'th
-			     * argument to the function is a word
-			     * that specifies the target.
-			     *)
-			    target: Target.t,
-			    writesStackTop: bool}
+                            (* bytesNeeded = SOME i means that the i'th
+                             * argument to the function is a word that
+                             * specifies the number of bytes that must be
+                             * free in order for the C function to succeed.
+                             * Limit check insertion is responsible for
+                             * making sure that the bytesNeeded is available.
+                             *)
+                            bytesNeeded: int option,
+                            convention: Convention.t,
+                            ensuresBytesFree: bool,
+                            mayGC: bool,
+                            maySwitchThreads: bool,
+                            modifiesFrontier: bool,
+                            prototype: CType.t vector * CType.t option,
+                            readsStackTop: bool,
+                            return: 'a,
+                            (* target = Indirect means that the 0'th
+                             * argument to the function is a word
+                             * that specifies the target.
+                             *)
+                            target: Target.t,
+                            writesStackTop: bool}
 
       val args: 'a t -> 'a vector
       val bytesNeeded: 'a t -> int option
@@ -75,7 +75,7 @@
       val target: 'a t -> Target.t
       val writesStackTop: 'a t -> bool
       val vanilla: {args: 'a vector,
-		    name: string,
-		    prototype: CType.t vector * CType.t option,
-		    return: 'a} -> 'a t
+                    name: string,
+                    prototype: CType.t vector * CType.t option,
+                    return: 'a} -> 'a t
    end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/atoms/c-type.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/atoms/c-type.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/atoms/c-type.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,8 +1,8 @@
-(* Copyright (C) 2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 2004-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 functor CType (S: C_TYPE_STRUCTS): C_TYPE = 
@@ -24,9 +24,9 @@
  | Word64
 
 val all = [Int8, Int16, Int32, Int64,
-	   Pointer,
-	   Real32, Real64,
-	   Word8, Word16, Word32, Word64]
+           Pointer,
+           Real32, Real64,
+           Word8, Word16, Word32, Word64]
 
 val bool = Int32
 

Modified: mlton/branches/on-20050420-cmm-branch/mlton/atoms/c-type.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/atoms/c-type.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/atoms/c-type.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,8 +1,8 @@
-(* Copyright (C) 2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 2004-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 signature C_TYPE_STRUCTS = 
@@ -16,7 +16,7 @@
       include C_TYPE_STRUCTS
 
       datatype t =
-	 Int8
+         Int8
        | Int16
        | Int32
        | Int64

Modified: mlton/branches/on-20050420-cmm-branch/mlton/atoms/cases.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/atoms/cases.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/atoms/cases.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 functor Cases (S: CASES_STRUCTS): CASES =
 struct
 

Modified: mlton/branches/on-20050420-cmm-branch/mlton/atoms/cases.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/atoms/cases.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/atoms/cases.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 type int = Int.t
 
 signature CASES_STRUCTS = 
@@ -21,7 +22,7 @@
       include CASES_STRUCTS
       
       datatype 'a t =
-	 Char of (char * 'a) vector
+         Char of (char * 'a) vector
        | Con of (con * 'a) vector
        | Int of (IntInf.t * 'a) vector
        | Word of (word * 'a) vector

Modified: mlton/branches/on-20050420-cmm-branch/mlton/atoms/con-.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/atoms/con-.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/atoms/con-.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 functor Con (S: CON_STRUCTS): CON = 
 struct
 
@@ -24,10 +25,10 @@
    in
       align
       (List.map (all, fn c =>
-		 seq [layout c, str " size is ",
-		      Int.layout (MLton.size c),
-		      str " plist length is ",
-		      Int.layout (PropertyList.length (plist c))]))
+                 seq [layout c, str " size is ",
+                      Int.layout (MLton.size c),
+                      str " plist length is ",
+                      Int.layout (PropertyList.length (plist c))]))
    end
    
 fun fromBool b = if b then truee else falsee

Modified: mlton/branches/on-20050420-cmm-branch/mlton/atoms/con-.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/atoms/con-.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/atoms/con-.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature CON_STRUCTS = 
    sig
    end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/atoms/const-type.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/atoms/const-type.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/atoms/const-type.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,14 +1,16 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 functor ConstType (S: CONST_TYPE_STRUCTS): CONST_TYPE =
 struct
 
+open S
+
 datatype t = Bool | Real | String | Word
 
 val toString =
@@ -16,5 +18,5 @@
     | Real => "Real"
     | String => "String"
     | Word => "Word"
-	 
+         
 end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/atoms/const-type.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/atoms/const-type.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/atoms/const-type.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,9 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 signature CONST_TYPE_STRUCTS =
@@ -13,7 +13,7 @@
 signature CONST_TYPE =
    sig
       include CONST_TYPE_STRUCTS
-	 
+         
       datatype t = Bool | Real | String | Word
 
       val toString: t -> string

Modified: mlton/branches/on-20050420-cmm-branch/mlton/atoms/const.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/atoms/const.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/atoms/const.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,9 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 functor Const (S: CONST_STRUCTS): CONST = 
@@ -21,17 +21,17 @@
       val maxSmall: IntInf.t = 0x3FFFFFFF
 
       fun isSmall (i: IntInf.t): bool =
-	 minSmall <= i andalso i <= maxSmall
+         minSmall <= i andalso i <= maxSmall
 
       fun toWord (i: IntInf.t): word option =
-	 if isSmall i
-	    then SOME (Word.orb (0w1,
-				 Word.<< (Word.fromInt (IntInf.toInt i),
-					  0w1)))
-	 else NONE
+         if isSmall i
+            then SOME (Word.orb (0w1,
+                                 Word.<< (Word.fromInt (IntInf.toInt i),
+                                          0w1)))
+         else NONE
 
       fun fromWord (w: word): IntInf.t =
-	 IntInf.fromInt (Word.toIntX (Word.~>> (w, 0w1)))
+         IntInf.fromInt (Word.toIntX (Word.~>> (w, 0w1)))
    end
 
 datatype t =
@@ -57,7 +57,7 @@
        | Real r => RealX.layout r
        | Word w => WordX.layout w
        | WordVector v => wrap ("\"", "\"", WordXVector.toString v)
-end	 
+end      
 
 val toString = Layout.toString o layout
 
@@ -79,6 +79,6 @@
 val equals = Trace.trace2 ("Const.equals", layout, layout, Bool.layout) equals
 
 val lookup: ({default: string option, name: string} * ConstType.t -> t) ref =
-   ref (fn _ => Error.bug "Const.lookup not set")
+   ref (fn _ => Error.bug "Const.lookup: not set")
 
 end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/atoms/const.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/atoms/const.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/atoms/const.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 type word = Word.t
    
 signature CONST_STRUCTS = 
@@ -21,14 +22,14 @@
       structure ConstType: CONST_TYPE
 
       structure SmallIntInf:
-	 sig
-	    val fromWord: word -> IntInf.t
-	    val isSmall: IntInf.t -> bool
-	    val toWord: IntInf.t -> word option
-	 end
+         sig
+            val fromWord: word -> IntInf.t
+            val isSmall: IntInf.t -> bool
+            val toWord: IntInf.t -> word option
+         end
 
       datatype t =
-	 IntInf of IntInf.t
+         IntInf of IntInf.t
        | Real of RealX.t
        | Word of WordX.t
        | WordVector of WordXVector.t
@@ -41,7 +42,7 @@
        * _command_line_const.  It is set in main/compile.fun.
        *)
       val lookup: ({default: string option,
-		    name: string} * ConstType.t -> t) ref
+                    name: string} * ConstType.t -> t) ref
       val real: RealX.t -> t
       val string: string -> t
       val toString: t -> string

Modified: mlton/branches/on-20050420-cmm-branch/mlton/atoms/ffi.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/atoms/ffi.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/atoms/ffi.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,8 +1,8 @@
-(* Copyright (C) 2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 2004-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 functor Ffi (S: FFI_STRUCTS): FFI = 
@@ -13,10 +13,12 @@
 structure Convention = CFunction.Convention
 
 val exports: {args: CType.t vector,
-	      convention: Convention.t,
-	      id: int,
-	      name: string,
-	      res: CType.t option} list ref = ref []
+              convention: Convention.t,
+              id: int,
+              name: string,
+              res: CType.t option} list ref = ref []
+val symbols: {name: string,
+              ty: CType.t} list ref = ref []
 
 fun numExports () = List.length (!exports)
 
@@ -25,15 +27,17 @@
 in
    fun addExport {args, convention, name, res} =
       let
-	 val id = Counter.next exportCounter
-	 val _ = List.push (exports, {args = args,
-				      convention = convention,
-				      id = id,
-				      name = name,
-				      res = res})
+         val id = Counter.next exportCounter
+         val _ = List.push (exports, {args = args,
+                                      convention = convention,
+                                      id = id,
+                                      name = name,
+                                      res = res})
       in
-	 id
+         id
       end
+   fun addSymbol {name, ty} = 
+      ignore (List.push (symbols, {name=name, ty=ty}))
 end
 
 val headers: string list ref = ref []
@@ -42,83 +46,91 @@
    let
       val maxMap = CType.memo (fn _ => ref ~1)
       fun bump (t, i) =
-	 let
-	    val r = maxMap t
-	 in
-	    r := Int.max (!r, i)
-	 end
+         let
+            val r = maxMap t
+         in
+            r := Int.max (!r, i)
+         end
       val _ =
-	 List.foreach
-	 (!exports, fn {args, res, ...} =>
-	  let
-	     val map = CType.memo (fn _ => Counter.new 0)
-	  in
-	     Vector.foreach (args, fn t => bump (t, Counter.next (map t)))
-	     ; Option.app (res, fn t => bump (t, 0))
-	  end)
+         List.foreach
+         (!exports, fn {args, res, ...} =>
+          let
+             val map = CType.memo (fn _ => Counter.new 0)
+          in
+             Vector.foreach (args, fn t => bump (t, Counter.next (map t)))
+             ; Option.app (res, fn t => bump (t, 0))
+          end)
       (* Declare the arrays and functions used for parameter passing. *)
       val _ =
-	 List.foreach
-	 (CType.all, fn t =>
-	  let
-	     val n = !(maxMap t)
-	  in
-	     if n >= 0
-		then
-		   let
-		      val size = Int.toString (1 + n)
-		      val t = CType.toString t
-		      val array = concat ["MLton_FFI_", t, "_array"]
-		   in
-		      print (concat [t, " ", array, "[", size, "];\n",
-				     t, " *MLton_FFI_", t, " = &", array, ";\n"])
-		   end
-	     else ()
-	  end)
+         List.foreach
+         (CType.all, fn t =>
+          let
+             val n = !(maxMap t)
+          in
+             if n >= 0
+                then
+                   let
+                      val size = Int.toString (1 + n)
+                      val t = CType.toString t
+                      val array = concat ["MLton_FFI_", t, "_array"]
+                   in
+                      print (concat [t, " ", array, "[", size, "];\n",
+                                     t, " *MLton_FFI_", t, " = &", array, ";\n"])
+                   end
+             else ()
+          end)
       val _ = print "Int MLton_FFI_op;\n"
    in
       List.foreach
+      (!symbols, fn {name, ty} =>
+       let
+          val decl = CType.toString ty ^ " " ^ name;
+       in
+         List.push (headers, "extern " ^ decl);
+         print (decl ^ ";\n")
+       end);
+      List.foreach
       (!exports, fn {args, convention, id, name, res} =>
        let
-	  val varCounter = Counter.new 0
-	  val map = CType.memo (fn _ => Counter.new 0)
-	  val args =
-	     Vector.map
-	     (args, fn t =>
-	      let
-		 val index = Counter.next (map t)
-		 val x = concat ["x", Int.toString (Counter.next varCounter)]
-		 val t = CType.toString t
-	      in
-		 (x,
-		  concat [t, " ", x],
-		  concat ["\tMLton_FFI_", t, "_array[", Int.toString index,
-			  "] = ", x, ";\n"])
-	      end)
-	  val header =
-	     concat [case res of
-			NONE => "void"
-		      | SOME t => CType.toString t,
-	             if convention <> Convention.Cdecl
-			then concat [" __attribute__ ((",
-				     Convention.toString convention,
-				     ")) "]
-		     else " ",
-		     name, " (",
-		     concat (List.separate (Vector.toListMap (args, #2), ", ")),
-		     ")"]
-	  val _ = List.push (headers, header)
+          val varCounter = Counter.new 0
+          val map = CType.memo (fn _ => Counter.new 0)
+          val args =
+             Vector.map
+             (args, fn t =>
+              let
+                 val index = Counter.next (map t)
+                 val x = concat ["x", Int.toString (Counter.next varCounter)]
+                 val t = CType.toString t
+              in
+                 (x,
+                  concat [t, " ", x],
+                  concat ["\tMLton_FFI_", t, "_array[", Int.toString index,
+                          "] = ", x, ";\n"])
+              end)
+          val header =
+             concat [case res of
+                        NONE => "void"
+                      | SOME t => CType.toString t,
+                     if convention <> Convention.Cdecl
+                        then concat [" __attribute__ ((",
+                                     Convention.toString convention,
+                                     ")) "]
+                     else " ",
+                     name, " (",
+                     concat (List.separate (Vector.toListMap (args, #2), ", ")),
+                     ")"]
+          val _ = List.push (headers, header)
        in
-	  print (concat [header, " {\n"])
-	  ; print (concat ["\tMLton_FFI_op = ", Int.toString id, ";\n"])
-	  ; Vector.foreach (args, fn (_, _, set) => print set)
-	  ; print ("\tMLton_callFromC ();\n")
-	  ; (case res of
-		NONE => ()
-	      | SOME t =>
-		   print (concat
-			  ["\treturn MLton_FFI_", CType.toString t, "_array[0];\n"]))
-	  ; print "}\n"
+          print (concat [header, " {\n"])
+          ; print (concat ["\tMLton_FFI_op = ", Int.toString id, ";\n"])
+          ; Vector.foreach (args, fn (_, _, set) => print set)
+          ; print ("\tMLton_callFromC ();\n")
+          ; (case res of
+                NONE => ()
+              | SOME t =>
+                   print (concat
+                          ["\treturn MLton_FFI_", CType.toString t, "_array[0];\n"]))
+          ; print "}\n"
        end)
    end
 

Modified: mlton/branches/on-20050420-cmm-branch/mlton/atoms/ffi.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/atoms/ffi.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/atoms/ffi.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,8 +1,8 @@
-(* Copyright (C) 2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 2004-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 type int = Int.t
@@ -18,9 +18,11 @@
       include FFI_STRUCTS
 
       val addExport: {args: CType.t vector,
-		      convention: CFunction.Convention.t,
-		      name: string,
-		      res: CType.t option} -> int
+                      convention: CFunction.Convention.t,
+                      name: string,
+                      res: CType.t option} -> int
+      val addSymbol: {ty: CType.t,
+                      name: string} -> unit
       val declareExports: {print: string -> unit} -> unit
       val declareHeaders: {print: string -> unit} -> unit
       val numExports: unit -> int

Modified: mlton/branches/on-20050420-cmm-branch/mlton/atoms/func.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/atoms/func.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/atoms/func.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1 +1,8 @@
+(* Copyright (C) 2004-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 signature FUNC = ID

Modified: mlton/branches/on-20050420-cmm-branch/mlton/atoms/generic-scheme.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/atoms/generic-scheme.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/atoms/generic-scheme.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 functor GenericScheme (S: GENERIC_SCHEME_STRUCTS): GENERIC_SCHEME =
 struct
 
@@ -14,7 +15,7 @@
 type tyvar = Tyvar.t
    
 datatype t = T of {tyvars: Tyvar.t vector,
-		   ty: Type.t}
+                   ty: Type.t}
 
 local
    fun make f (T r) = f r
@@ -25,36 +26,36 @@
 
 fun fromType t = T {tyvars = Vector.new0 (), ty = t}
 
-val equals = fn _ => Error.unimplemented "Scheme.equals"
+val equals = fn _ => Error.unimplemented "GenericScheme.equals"
 
 fun layout (T {tyvars, ty}) =
    let open Layout
       val ty = Type.layout ty
    in
       if 0 = Vector.length tyvars
-	 then ty
+         then ty
       else
-	 align [seq [str "Forall ",
-		     Vector.layout Tyvar.layout tyvars,
-		     str "."],
-		ty]
+         align [seq [str "Forall ",
+                     Vector.layout Tyvar.layout tyvars,
+                     str "."],
+                ty]
    end
 
 fun apply (T {tyvars, ty}, args) =
    if Vector.isEmpty tyvars andalso Vector.isEmpty args
       then ty (* Must special case this, since don't want to substitute
-	       * in monotypes.
-	       *)
+               * in monotypes.
+               *)
    else Type.substitute (ty, Vector.zip (tyvars, args))
 
 fun makeGen (numTyvars, equality, makeType): t =
    let
       val tyvars =
-	 Vector.tabulate (numTyvars, fn _ =>
-			  Tyvar.newNoname {equality = equality})
+         Vector.tabulate (numTyvars, fn _ =>
+                          Tyvar.newNoname {equality = equality})
       val tys = Vector.map (tyvars, Type.var)
    in T {tyvars = tyvars,
-	 ty = makeType (fn i => Vector.sub (tys, i))}
+         ty = makeType (fn i => Vector.sub (tys, i))}
    end
 
 val make0 = fromType

Modified: mlton/branches/on-20050420-cmm-branch/mlton/atoms/generic-scheme.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/atoms/generic-scheme.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/atoms/generic-scheme.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,19 +1,20 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature GENERIC_SCHEME_STRUCTS = 
    sig
       structure Tyvar: TYVAR
       structure Type: sig
-			  type t
-			  val var: Tyvar.t -> t
-			  val substitute: t * (Tyvar.t * t) vector -> t
-			  val layout: t -> Layout.t
-		       end
+                          type t
+                          val var: Tyvar.t -> t
+                          val substitute: t * (Tyvar.t * t) vector -> t
+                          val layout: t -> Layout.t
+                       end
    end
 
 signature GENERIC_SCHEME = 
@@ -22,7 +23,7 @@
       type ty
 
       datatype t = T of {tyvars: tyvar vector,
-			 ty: ty}
+                         ty: ty}
 
       val apply: t * ty vector -> ty
       val equals: t * t -> bool

Modified: mlton/branches/on-20050420-cmm-branch/mlton/atoms/hash-type.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/atoms/hash-type.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/atoms/hash-type.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,9 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 functor HashType (S: HASH_TYPE_STRUCTS): HASH_TYPE = 
@@ -14,125 +14,125 @@
 structure Type =
    struct
       datatype t =
-	 T of {
-	       hash: Word.t,
-	       plist: PropertyList.t,
-	       tree: tree
-	       }
+         T of {
+               hash: Word.t,
+               plist: PropertyList.t,
+               tree: tree
+               }
       and tree =
-	 Var of Tyvar.t
-	| Con of Tycon.t * t vector
+         Var of Tyvar.t
+        | Con of Tycon.t * t vector
 
       local
-	 fun make f (T r) = f r
+         fun make f (T r) = f r
       in
-	 val hash = make #hash
-	 val plist = make #plist
-	 val tree = make #tree
+         val hash = make #hash
+         val plist = make #plist
+         val tree = make #tree
       end
 
       local
-	 open Layout
+         open Layout
       in
-	 val rec layoutTree =
-	    fn Var a => Tyvar.layout a
-	     | Con (c, ts) =>
-		  seq [Tycon.layout c,
-		       Vector.layout (layoutTree o tree) ts]
+         val rec layoutTree =
+            fn Var a => Tyvar.layout a
+             | Con (c, ts) =>
+                  seq [Tycon.layout c,
+                       Vector.layout (layoutTree o tree) ts]
       end
 
       structure Dest =
-	 struct
-	    datatype dest = datatype tree
-	    val dest = tree
-	 end
+         struct
+            datatype dest = datatype tree
+            val dest = tree
+         end
       open Dest
 
       fun deConOpt t =
-	 case dest t of
-	    Con x => SOME x
-	  | _ => NONE
+         case dest t of
+            Con x => SOME x
+          | _ => NONE
 
       fun makeHom {con, var} =
-	 let
-	    val {get, destroy, ...} =
-	       Property.destGet
-	       (plist,
-		Property.initRec
-		(fn (t, get) =>
-		 case dest t of
-		    Var a => var (t, a)
-		  | Con (c, ts) => con (t, c, Vector.map (ts, get))))
-	 in {hom = get, destroy = destroy}
-	 end
+         let
+            val {get, destroy, ...} =
+               Property.destGet
+               (plist,
+                Property.initRec
+                (fn (t, get) =>
+                 case dest t of
+                    Var a => var (t, a)
+                  | Con (c, ts) => con (t, c, Vector.map (ts, get))))
+         in {hom = get, destroy = destroy}
+         end
 
       fun hom {ty, var, con} =
-	 let
-	    val {hom, destroy} = makeHom {var = var o #2,
-					  con = fn (_, c, xs) => con (c, xs)}
-	    val res = hom ty
-	    val _ = destroy ()
-	 in res
-	 end
+         let
+            val {hom, destroy} = makeHom {var = var o #2,
+                                          con = fn (_, c, xs) => con (c, xs)}
+            val res = hom ty
+            val _ = destroy ()
+         in res
+         end
 
       fun makeMonoHom {con} =
-	 makeHom {var = fn _ => Error.bug "makeMonoHom saw type variable",
-		  con = con}
+         makeHom {var = fn _ => Error.bug "HashType.Type.makeMonoHom: type variable",
+                  con = con}
 
       fun equals (t, t'): bool = PropertyList.equals (plist t, plist t')
-		      
+                      
       fun layout (ty: t): Layout.t =
-	 #1 (hom {con = Tycon.layoutApp,
-		  ty = ty,
-		  var = fn a => (Tyvar.layout a, {isChar = false,
-						  needsParen = false})})
+         #1 (hom {con = Tycon.layoutApp,
+                  ty = ty,
+                  var = fn a => (Tyvar.layout a, {isChar = false,
+                                                  needsParen = false})})
 
       val toString = Layout.toString o layout
-	 
+         
       local
-	 val same: tree * tree -> bool =
-	    fn (Var a, Var a') => Tyvar.equals (a, a')
-	     | (Con (c, ts), Con (c', ts')) =>
-		  Tycon.equals (c, c')
-		  andalso Vector.equals (ts, ts', equals)
-	     | _ => false
-	 val same =
-	    Trace.trace2 ("Type.same", layoutTree, layoutTree, Bool.layout)
-	    same
-	 val table: t HashSet.t = HashSet.new {hash = hash}
+         val same: tree * tree -> bool =
+            fn (Var a, Var a') => Tyvar.equals (a, a')
+             | (Con (c, ts), Con (c', ts')) =>
+                  Tycon.equals (c, c')
+                  andalso Vector.equals (ts, ts', equals)
+             | _ => false
+         val same =
+            Trace.trace2 ("HashType.Type.same", layoutTree, layoutTree, Bool.layout)
+            same
+         val table: t HashSet.t = HashSet.new {hash = hash}
       in
-	 fun lookup (hash, tr) =
-	    HashSet.lookupOrInsert (table, hash,
-				    fn t => same (tr, tree t),
-				    fn () => T {hash = hash,
-						plist = PropertyList.new (),
-						tree = tr})
+         fun lookup (hash, tr) =
+            HashSet.lookupOrInsert (table, hash,
+                                    fn t => same (tr, tree t),
+                                    fn () => T {hash = hash,
+                                                plist = PropertyList.new (),
+                                                tree = tr})
 
-	 fun stats () =
-	    let open Layout
-	    in align [seq [str "num distinct types = ",
-			   Int.layout (HashSet.size table)],
-		      Control.sizeMessage ("hash table", table)]
-	    end
+         fun stats () =
+            let open Layout
+            in align [seq [str "num distinct types = ",
+                           Int.layout (HashSet.size table)],
+                      Control.sizeMessage ("hash table", table)]
+            end
       end
 
       fun var a = lookup (Tyvar.hash a, Var a)
 
       local
-	 val generator: Word.t = 0wx5555
+         val generator: Word.t = 0wx5555
       in
-	 fun con (c, ts) =
-	    lookup (Vector.fold (ts, Tycon.hash c, fn (t, w) =>
-				 Word.xorb (w * generator, hash t)),
-		    Con (c, ts))
-	 val con = Trace.trace2 ("Type.con",
-				 Tycon.layout,
-				 Vector.layout layout,
-				 layout) con
+         fun con (c, ts) =
+            lookup (Vector.fold (ts, Tycon.hash c, fn (t, w) =>
+                                 Word.xorb (w * generator, hash t)),
+                    Con (c, ts))
+         val con = Trace.trace2 ("HashType.Type.con",
+                                 Tycon.layout,
+                                 Vector.layout layout,
+                                 layout) con
       end
    end
 structure Ops = TypeOps (structure Tycon = Tycon
-			 open Type)
+                         open Type)
 open Type Ops
 
 val string = word8Vector
@@ -142,7 +142,7 @@
       datatype z = datatype Const.t
    in
       case c of
-	 IntInf _ => intInf
+         IntInf _ => intInf
        | Real r => real (RealX.size r)
        | Word w => word (WordX.size w)
        | WordVector v => vector (word (WordXVector.elementSize v))
@@ -156,30 +156,30 @@
 fun substitute (ty, v) =
    if Vector.isEmpty v
       then ty (* This optimization is important so that monotypes
-	       * are not substituted inside of.
-	       *)
+               * are not substituted inside of.
+               *)
    else 
       hom {ty = ty,
-	   var = fn a => (case Vector.peek (v, fn (a', _) =>
-					    Tyvar.equals (a, a')) of
-			     NONE => var a
-			   | SOME (_, ty) => ty),
-	   con = con}
+           var = fn a => (case Vector.peek (v, fn (a', _) =>
+                                            Tyvar.equals (a, a')) of
+                             NONE => var a
+                           | SOME (_, ty) => ty),
+           con = con}
 
 (* val substitute =
- *    Trace.trace2 ("substitute", layout,
- * 		List.layout (Layout.tuple2 (Tyvar.layout, Type.layout)),
- * 		layout) substitute		
+ *    Trace.trace2 ("HashType.substitute", layout,
+ *              List.layout (Layout.tuple2 (Tyvar.layout, Type.layout)),
+ *              layout) substitute              
  *)
 
 (* fun equalss (ts: t list): t option =
  *    case ts of
  *       t :: ts =>
- * 	 let fun loop [] = SOME t
- * 	       | loop (t' :: ts) = if equals (t, t') then loop ts else NONE
- * 	 in loop ts
- * 	 end
- *     | [] => Error.bug "equals"
+ *       let fun loop [] = SOME t
+ *             | loop (t' :: ts) = if equals (t, t') then loop ts else NONE
+ *       in loop ts
+ *       end
+ *     | [] => Error.bug "HashType.equals"
  *)
 
 local
@@ -197,41 +197,41 @@
 fun tycon t =
    case dest t of
       Con (c, _) => c
-    | _ => Error.bug "Type.tycon saw type variable"
+    | _ => Error.bug "HashType.tycon: type variable"
 
 fun containsTycon (ty, tycon) =
    hom {ty = ty,
-	var = fn _ => false,
-	con = fn (tycon', bs) => (Tycon.equals (tycon, tycon')
-				  orelse Vector.exists (bs, fn b => b))}
+        var = fn _ => false,
+        con = fn (tycon', bs) => (Tycon.equals (tycon, tycon')
+                                  orelse Vector.exists (bs, fn b => b))}
 
 fun checkPrimApp {args, prim, result, targs}: bool =
    let
       datatype z = datatype Prim.Name.t
       fun done (args', result') =
-	 Vector.equals (args, Vector.fromList args', equals)
-	 andalso equals (result, result')
+         Vector.equals (args, Vector.fromList args', equals)
+         andalso equals (result, result')
       fun targ i = Vector.sub (targs, i)
       fun oneTarg f =
-	 1 = Vector.length targs
-	 andalso done (f (targ 0))
+         1 = Vector.length targs
+         andalso done (f (targ 0))
       local
-	 fun make f s = let val t = f s in done ([t], t) end
+         fun make f s = let val t = f s in done ([t], t) end
       in
-	 val realUnary = make real
-	 val wordUnary = make word
+         val realUnary = make real
+         val wordUnary = make word
       end
       local
-	 fun make f s = let val t = f s in done ([t, t], t) end
+         fun make f s = let val t = f s in done ([t, t], t) end
       in
-	 val realBinary = make real
-	 val wordBinary = make word
+         val realBinary = make real
+         val wordBinary = make word
       end
       local
-	 fun make f s = let val t = f s in done ([t, t], bool) end
+         fun make f s = let val t = f s in done ([t, t], bool) end
       in
-	 val realCompare = make real
-	 val wordCompare = make word
+         val realCompare = make real
+         val wordCompare = make word
       end
       fun intInfBinary () = done ([intInf, intInf, defaultWord], intInf)
       fun intInfShift () = done ([intInf, defaultWord, defaultWord], intInf)
@@ -243,7 +243,7 @@
       fun wordShift s = done ([word s, defaultWord], word s)
    in
       case Prim.name prim of
-	 Array_array => oneTarg (fn targ => ([defaultWord], array targ))
+         Array_array => oneTarg (fn targ => ([defaultWord], array targ))
        | Array_array0Const => oneTarg (fn targ => ([], array targ))
        | Array_length => oneTarg (fn t => ([array t], defaultWord))
        | Array_sub => oneTarg (fn t => ([array t, defaultWord], t))
@@ -336,7 +336,7 @@
        | Weak_new => oneTarg (fn t => ([t], weak t))
        | Word8Array_subWord => done ([word8Array, defaultWord], defaultWord)
        | Word8Array_updateWord =>
-	    done ([word8Array, defaultWord, defaultWord], unit)
+            done ([word8Array, defaultWord, defaultWord], unit)
        | Word8Vector_subWord => done ([word8Vector, defaultWord], defaultWord)
        | WordVector_toIntInf => done ([wordVector], intInf)
        | Word_add s => wordBinary s
@@ -363,8 +363,8 @@
        | Word_toWord (s, s', _) => done ([word s], word s')
        | Word_xorb s => wordBinary s
        | World_save => done ([defaultWord], unit)
-       | _ => Error.bug (concat ["Type.checkPrimApp got strange prim: ",
-				 Prim.toString prim])
+       | _ => Error.bug (concat ["HashType.checkPrimApp: strange prim: ",
+                                 Prim.toString prim])
    end
 
 end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/atoms/hash-type.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/atoms/hash-type.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/atoms/hash-type.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature HASH_TYPE_STRUCTS = 
    sig
       include ATOMS
@@ -20,17 +21,17 @@
       sharing type wordSize = WordSize.t
 
       structure Dest:
-	 sig
-	    datatype dest =
-	       Con of Tycon.t * t vector
-	     | Var of Tyvar.t
-	    val dest: t -> dest
-	 end
+         sig
+            datatype dest =
+               Con of Tycon.t * t vector
+             | Var of Tyvar.t
+            val dest: t -> dest
+         end
 
       val checkPrimApp: {args: t vector,
-			 prim: t Prim.t,
-			 result: t,
-			 targs: t vector} -> bool
+                         prim: t Prim.t,
+                         result: t,
+                         targs: t vector} -> bool
       val containsTycon: t * Tycon.t -> bool
       (* O(1) time *)
       val equals: t * t -> bool
@@ -38,19 +39,19 @@
       val error: string * Layout.t -> 'a
       val hash: t -> Word.t
       val hom: {ty: t,
-		var: Tyvar.t -> 'a,
-		con: Tycon.t * 'a vector -> 'a} -> 'a
+                var: Tyvar.t -> 'a,
+                con: Tycon.t * 'a vector -> 'a} -> 'a
       val isUnit: t -> bool
       val layout: t -> Layout.t
       val makeHom:
-	 {var: t * Tyvar.t -> 'a,
-	  con: t * Tycon.t * 'a vector -> 'a}
-	 -> {hom: t -> 'a,
-	     destroy: unit -> unit}
+         {var: t * Tyvar.t -> 'a,
+          con: t * Tycon.t * 'a vector -> 'a}
+         -> {hom: t -> 'a,
+             destroy: unit -> unit}
       val makeMonoHom:
-	 {con: t * Tycon.t * 'a vector -> 'a}
-	 -> {hom: t -> 'a,
-	     destroy: unit -> unit}
+         {con: t * Tycon.t * 'a vector -> 'a}
+         -> {hom: t -> 'a,
+             destroy: unit -> unit}
       val ofConst: Const.t -> t
       val plist: t -> PropertyList.t
       val stats: unit -> Layout.t

Modified: mlton/branches/on-20050420-cmm-branch/mlton/atoms/id.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/atoms/id.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/atoms/id.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,9 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 structure UniqueString:
@@ -12,22 +12,22 @@
    end =
    struct
       val set: {counter: Counter.t,
-		hash: word,
-		original: string} HashSet.t =
-	 HashSet.new {hash = #hash}
+                hash: word,
+                original: string} HashSet.t =
+         HashSet.new {hash = #hash}
 
       fun unique (s: string): string =
-	 let
-	    val hash = String.hash s
-	    val {counter, ...} =
-	       HashSet.lookupOrInsert
-	       (set, hash, fn {original, ...} => s = original,
-		fn () => {counter = Counter.new 0,
-			  hash = hash,
-			  original = s})
-	 in
-	    concat [s, "_", Int.toString (Counter.next counter)]
-	 end
+         let
+            val hash = String.hash s
+            val {counter, ...} =
+               HashSet.lookupOrInsert
+               (set, hash, fn {original, ...} => s = original,
+                fn () => {counter = Counter.new 0,
+                          hash = hash,
+                          original = s})
+         in
+            concat [s, "_", Int.toString (Counter.next counter)]
+         end
    end
 
 functor Id (S: ID_STRUCTS): ID =
@@ -38,9 +38,9 @@
 structure Plist = PropertyList
 
 datatype t = T of {hash: word,
-		   originalName: string,
-		   printName: string option ref,
-		   plist: Plist.t}
+                   originalName: string,
+                   printName: string option ref,
+                   plist: Plist.t}
 
 local
    fun make f (T r) = f r
@@ -66,42 +66,42 @@
 fun toString (T {originalName, printName, ...}) =
    case !printName of
       NONE =>
-	 let
-	    val s =
-	       if not (!printNameAlphaNumeric)
-		  orelse isAlphaNum originalName
-		  then originalName
-	       else
-		  String.translate
-		  (originalName,
-		   fn #"!" => "Bang"
-		    | #"#" => "Hash"
-		    | #"$" => "Dollar"
-		    | #"%" => "Percent"
-		    | #"&" => "Ampersand"
-		    | #"'" => "P"
-		    | #"*" => "Star"
-		    | #"+" => "Plus"
-		    | #"-" => "Minus"
-		    | #"." => "D"
-		    | #"/" => "Divide"
-		    | #":" => "Colon"
-		    | #"<" => "Lt"
-		    | #"=" => "Eq"
-		    | #">" => "Gt"
-		    | #"?" => "Ques"
-		    | #"@" => "At"
-		    | #"\\" => "Slash"
-		    | #"^" => "Caret"
-		    | #"`" => "Quote"
-		    | #"|" => "Pipe"
-		    | #"~" => "Tilde"
-		    | c => str c)
-	    val s = UniqueString.unique s
-	    val _ = printName := SOME s
-	 in
-	    s
-	 end
+         let
+            val s =
+               if not (!printNameAlphaNumeric)
+                  orelse isAlphaNum originalName
+                  then originalName
+               else
+                  String.translate
+                  (originalName,
+                   fn #"!" => "Bang"
+                    | #"#" => "Hash"
+                    | #"$" => "Dollar"
+                    | #"%" => "Percent"
+                    | #"&" => "Ampersand"
+                    | #"'" => "P"
+                    | #"*" => "Star"
+                    | #"+" => "Plus"
+                    | #"-" => "Minus"
+                    | #"." => "D"
+                    | #"/" => "Divide"
+                    | #":" => "Colon"
+                    | #"<" => "Lt"
+                    | #"=" => "Eq"
+                    | #">" => "Gt"
+                    | #"?" => "Ques"
+                    | #"@" => "At"
+                    | #"\\" => "Slash"
+                    | #"^" => "Caret"
+                    | #"`" => "Quote"
+                    | #"|" => "Pipe"
+                    | #"~" => "Tilde"
+                    | c => str c)
+            val s = UniqueString.unique s
+            val _ = printName := SOME s
+         in
+            s
+         end
     | SOME s => s
 
 val layout = String.layout o toString
@@ -111,9 +111,9 @@
 local
    fun make (originalName, printName) =
       T {hash = Random.word (),
-	 originalName = originalName,
-	 printName = ref printName,
-	 plist = Plist.new ()}
+         originalName = originalName,
+         printName = ref printName,
+         plist = Plist.new ()}
 in
    fun fromString s = make (s, SOME s)
    fun newString s = make (s, NONE)

Modified: mlton/branches/on-20050420-cmm-branch/mlton/atoms/id.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/atoms/id.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/atoms/id.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 type word = Word.t
 
 signature ID_STRUCTS =

Deleted: mlton/branches/on-20050420-cmm-branch/mlton/atoms/int-x.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/atoms/int-x.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/atoms/int-x.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,108 +0,0 @@
-functor IntX (S: INT_X_STRUCTS): INT_X = 
-struct
-
-open S
-
-datatype t = T of {int: IntInf.t,
-		   size: IntSize.t}
-   
-local
-   fun make f (T r) = f r
-in
-   val int = make #int
-   val size = make #size
-end
-
-fun equals (T {int = i, size = s, ...}, 
-	    T {int = i', size = s', ...}) = 
-   i = i' andalso IntSize.equals (s, s')
-
-fun toString (T {int = i, ...}) = IntInf.toString i
-
-val layout = Layout.str o toString
-
-fun format (T {int = i, ...}, r) = IntInf.format (i, r)
-
-fun make (i: IntInf.t, s: IntSize.t): t =
-   if IntSize.isInRange (s, i)
-      then T {int = i,
-	      size = s}
-   else raise Overflow
-
-fun defaultInt (i: int): t = make (IntInf.fromInt i, IntSize.default)
-
-val toIntInf = int
-
-val toInt = IntInf.toInt o toIntInf
-
-val toChar = Char.fromInt o toInt
-
-val hash = IntInf.hash o toIntInf
-
-local
-   val make: (IntInf.t * IntInf.t -> IntInf.t) -> t * t -> t =
-      fn f => fn (i, i') => make (f (int i, int i'), size i)
-in
-   val op + = make IntInf.+
-   val op - = make IntInf.-
-   val op * = make IntInf.*
-   val quot = make IntInf.quot
-   val rem = make IntInf.rem
-end
-
-fun ~ i = make (IntInf.~ (int i), size i)
-
-local
-   fun is i i' = int i' = IntInf.fromInt i
-in
-   val isNegOne = is ~1
-   val isOne = is 1
-   val isZero = is 0
-end
-
-local
-   fun is f i = int i = f (size i)
-in
-   val isMax = is IntSize.max
-   val isMin = is IntSize.min
-end
-
-fun one s = make (1, s)
-   
-fun zero s = make (0, s)
-
-fun max s = make (IntSize.max s, s)
-
-fun min s = make (IntSize.min s, s)
-
-
-local
-   val make: (IntInf.t * Word.t -> IntInf.t) -> t * IntInf.t -> t =
-      fn f => fn (i, shift) =>
-      let
-	 val s = size i
-      in
-	 if shift >= Bits.toIntInf (IntSize.bits s)
-	    then zero s
-	 else make (f (int i, Word.fromIntInf shift), s)
-      end
-in
-   val << = make IntInf.<<
-   val ~>> = make IntInf.~>>
-end
-
-local
-   fun make (f: IntInf.t * IntInf.t -> 'a): t * t -> 'a =
-      fn (i, i') =>
-      if IntSize.equals (size i, size i')
-	 then f (int i, int i')
-      else Error.bug "IntX binary failure"
-in
-   val op < = make IntInf.<
-   val op <= = make IntInf.<=
-   val op > = make IntInf.>
-   val op >= = make IntInf.>=
-   val compare = make IntInf.compare
-end
-
-end

Deleted: mlton/branches/on-20050420-cmm-branch/mlton/atoms/int-x.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/atoms/int-x.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/atoms/int-x.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,50 +0,0 @@
-type int = Int.t
-type word = Word.t
-   
-signature INT_X_STRUCTS = 
-   sig
-      structure IntSize: INT_SIZE
-   end
-
-signature INT_X = 
-   sig
-      include INT_X_STRUCTS
-	 
-      (* Ints of all IntSize.t sizes. *)
-      type t
-
-      val + : t * t -> t 
-      val - : t * t -> t 
-      val * : t * t -> t
-      val ~ : t -> t
-      val > : t * t -> bool 
-      val < : t * t -> bool 
-      val >= : t * t -> bool 
-      val <= : t * t -> bool
-      val << : t * IntInf.t -> t
-      val ~>> : t * IntInf.t -> t
-      val compare: t * t -> Relation.t
-      val defaultInt: int -> t
-      val equals: t * t -> bool
-      val format: t * StringCvt.radix -> string
-      val hash: t -> word
-      val isMax: t -> bool
-      val isMin: t -> bool
-      val isNegOne: t -> bool
-      val isOne: t -> bool
-      val isZero: t -> bool
-      val layout: t -> Layout.t
-      val make: IntInf.t * IntSize.t -> t
-      val max: IntSize.t -> t
-      val min: IntSize.t -> t
-      val one: IntSize.t -> t
-      val quot: t * t -> t
-      val rem: t * t -> t
-      val size: t -> IntSize.t
-      val toChar: t -> char
-      val toInt: t -> int
-      val toIntInf: t -> IntInf.t
-      val toString: t -> string
-      val zero: IntSize.t -> t
-   end
-

Modified: mlton/branches/on-20050420-cmm-branch/mlton/atoms/label.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/atoms/label.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/atoms/label.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1 +1,8 @@
+(* Copyright (C) 2004-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 signature LABEL = ID

Modified: mlton/branches/on-20050420-cmm-branch/mlton/atoms/prim.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/atoms/prim.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/atoms/prim.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,10 @@
 
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 (*
@@ -28,7 +28,7 @@
 structure Kind =
    struct
       datatype t =
-	 DependsOnState
+         DependsOnState
        | Functional
        | Moveable
        | SideEffect
@@ -120,7 +120,7 @@
  | Real_mul of RealSize.t (* codegen *)
  | Real_muladd of RealSize.t (* codegen *)
  | Real_mulsub of RealSize.t (* codegen *)
- | Real_neg of RealSize.t	  (* codegen *)
+ | Real_neg of RealSize.t         (* codegen *)
  | Real_qequal of RealSize.t (* codegen *)
  | Real_round of RealSize.t (* codegen *)
  | Real_sub of RealSize.t (* codegen *)
@@ -186,22 +186,22 @@
 fun toString (n: 'a t): string =
    let
       fun real (s: RealSize.t, str: string): string =
-	 concat ["Real", RealSize.toString s, "_", str]
+         concat ["Real", RealSize.toString s, "_", str]
       fun sign {signed} = if signed then "WordS" else "WordU"
       fun word (s: WordSize.t, str: string): string =
-	 concat ["Word", WordSize.toString s, "_", str]
+         concat ["Word", WordSize.toString s, "_", str]
       fun wordS (s: WordSize.t, sg, str: string): string =
-	 concat [sign sg, WordSize.toString s, "_", str]
+         concat [sign sg, WordSize.toString s, "_", str]
       val realC = ("Real", RealSize.toString)
       val wordC = ("Word", WordSize.toString)
       fun wordCS sg = (sign sg, WordSize.toString)
       fun coerce ((n, sizeToString), (n', sizeToString'), s, s'): string =
-	 concat [n, sizeToString s, "_to", n', sizeToString' s']
+         concat [n, sizeToString s, "_to", n', sizeToString' s']
       fun pointerGet (ty, s) = concat ["Pointer_get", ty, s]
       fun pointerSet (ty, s) = concat ["Pointer_set", ty, s]
    in
       case n of
-	 Array_array => "Array_array"
+         Array_array => "Array_array"
        | Array_array0Const => "Array_array0Const"
        | Array_length => "Array_length"
        | Array_sub => "Array_sub"
@@ -404,11 +404,11 @@
     | (Real_round s, Real_round s') => RealSize.equals (s, s')
     | (Real_sub s, Real_sub s') => RealSize.equals (s, s')
     | (Real_toReal (s1, s2), Real_toReal (s1', s2')) =>
-	 RealSize.equals (s1, s1') andalso RealSize.equals (s2, s2')
+         RealSize.equals (s1, s1') andalso RealSize.equals (s2, s2')
     | (Real_toWord (s1, s2, sg), Real_toWord (s1', s2', sg')) =>
-	 RealSize.equals (s1, s1')
-	 andalso WordSize.equals (s2, s2')
-	 andalso sg = sg'
+         RealSize.equals (s1, s1')
+         andalso WordSize.equals (s2, s2')
+         andalso sg = sg'
     | (Ref_assign, Ref_assign) => true
     | (Ref_deref, Ref_deref) => true
     | (Ref_ref, Ref_ref) => true
@@ -429,40 +429,40 @@
     | (Weak_new, Weak_new) => true
     | (Word_add s, Word_add s') => WordSize.equals (s, s')
     | (Word_addCheck (s, sg), Word_addCheck (s', sg')) =>
-	 WordSize.equals (s, s') andalso sg = sg'
+         WordSize.equals (s, s') andalso sg = sg'
     | (Word_andb s, Word_andb s') => WordSize.equals (s, s')
     | (Word_equal s, Word_equal s') => WordSize.equals (s, s')
     | (Word_lshift s, Word_lshift s') => WordSize.equals (s, s')
     | (Word_lt (s, sg), Word_lt (s', sg')) =>
-	 WordSize.equals (s, s') andalso sg = sg'
+         WordSize.equals (s, s') andalso sg = sg'
     | (Word_mul (s, sg), Word_mul (s', sg')) =>
-	 WordSize.equals (s, s') andalso sg = sg'
+         WordSize.equals (s, s') andalso sg = sg'
     | (Word_mulCheck (s, sg), Word_mulCheck (s', sg')) =>
-	 WordSize.equals (s, s') andalso sg = sg'
+         WordSize.equals (s, s') andalso sg = sg'
     | (Word_neg s, Word_neg s') => WordSize.equals (s, s')
     | (Word_negCheck s, Word_negCheck s') => WordSize.equals (s, s')
     | (Word_notb s, Word_notb s') => WordSize.equals (s, s')
     | (Word_orb s, Word_orb s') => WordSize.equals (s, s')
     | (Word_quot (s, sg), Word_quot (s', sg')) =>
-	 WordSize.equals (s, s') andalso sg = sg'
+         WordSize.equals (s, s') andalso sg = sg'
     | (Word_rem (s, sg), Word_rem (s', sg')) =>
-	 WordSize.equals (s, s') andalso sg = sg'
+         WordSize.equals (s, s') andalso sg = sg'
     | (Word_rol s, Word_rol s') => WordSize.equals (s, s')
     | (Word_ror s, Word_ror s') => WordSize.equals (s, s')
     | (Word_rshift (s, sg), Word_rshift (s', sg')) =>
-	 WordSize.equals (s, s') andalso sg = sg'
+         WordSize.equals (s, s') andalso sg = sg'
     | (Word_sub s, Word_sub s') => WordSize.equals (s, s')
     | (Word_subCheck (s, sg), Word_subCheck (s', sg')) =>
-	 WordSize.equals (s, s') andalso sg = sg'
+         WordSize.equals (s, s') andalso sg = sg'
     | (Word_toIntInf, Word_toIntInf) => true
     | (Word_toReal (s1, s2, sg), Word_toReal (s1', s2', sg')) =>
-	 WordSize.equals (s1, s1')
-	 andalso RealSize.equals (s2, s2')
-	 andalso sg = sg'
+         WordSize.equals (s1, s1')
+         andalso RealSize.equals (s2, s2')
+         andalso sg = sg'
     | (Word_toWord (s1, s2, sg), Word_toWord (s1', s2', sg')) =>
-	 WordSize.equals (s1, s1')
-	 andalso WordSize.equals (s2, s2')
-	 andalso sg = sg'
+         WordSize.equals (s1, s1')
+         andalso WordSize.equals (s2, s2')
+         andalso sg = sg'
     | (Word_xorb s, Word_xorb s') => WordSize.equals (s, s')
     | (WordVector_toIntInf, WordVector_toIntInf) => true
     | (Word8Array_subWord, Word8Array_subWord) => true
@@ -620,7 +620,7 @@
    let datatype z = datatype CType.t
    in
       case ctype of
-	 Int8 => Pointer_getWord (WordSize.fromBits (Bits.fromInt 8))
+         Int8 => Pointer_getWord (WordSize.fromBits (Bits.fromInt 8))
        | Int16 => Pointer_getWord (WordSize.fromBits (Bits.fromInt 16))
        | Int32 => Pointer_getWord (WordSize.fromBits (Bits.fromInt 32))
        | Int64 => Pointer_getWord (WordSize.fromBits (Bits.fromInt 64))
@@ -632,6 +632,22 @@
        | Word32 => Pointer_getWord (WordSize.fromBits (Bits.fromInt 32))
        | Word64 => Pointer_getWord (WordSize.fromBits (Bits.fromInt 64))
    end
+fun pointerSet ctype =
+   let datatype z = datatype CType.t
+   in
+      case ctype of
+         Int8 => Pointer_setWord (WordSize.fromBits (Bits.fromInt 8))
+       | Int16 => Pointer_setWord (WordSize.fromBits (Bits.fromInt 16))
+       | Int32 => Pointer_setWord (WordSize.fromBits (Bits.fromInt 32))
+       | Int64 => Pointer_setWord (WordSize.fromBits (Bits.fromInt 64))
+       | Pointer => Pointer_setPointer
+       | Real32 => Pointer_setReal RealSize.R32
+       | Real64 => Pointer_setReal RealSize.R64
+       | Word8 => Pointer_setWord (WordSize.fromBits (Bits.fromInt 8))
+       | Word16 => Pointer_setWord (WordSize.fromBits (Bits.fromInt 16))
+       | Word32 => Pointer_setWord (WordSize.fromBits (Bits.fromInt 32))
+       | Word64 => Pointer_setWord (WordSize.fromBits (Bits.fromInt 64))
+   end
 
 val reff = Ref_ref
 val serialize = MLton_serialize
@@ -687,7 +703,7 @@
       datatype z = datatype Kind.t
    in
       case p of
-	 Array_array => Moveable
+         Array_array => Moveable
        | Array_array0Const => Moveable
        | Array_length => Functional
        | Array_sub => DependsOnState
@@ -846,17 +862,17 @@
 
    fun wordSigns (s: WordSize.t, signed: bool) =
       let
-	 val sg = {signed = signed}
+         val sg = {signed = signed}
       in
-	 List.map ([Word_addCheck,
-		    Word_lt,
-		    Word_mul,
-		    Word_mulCheck,
-		    Word_quot,
-		    Word_rem,
-		    Word_rshift,
-		    Word_subCheck],
-		   fn p => p (s, sg))
+         List.map ([Word_addCheck,
+                    Word_lt,
+                    Word_mul,
+                    Word_mulCheck,
+                    Word_quot,
+                    Word_rem,
+                    Word_rshift,
+                    Word_subCheck],
+                   fn p => p (s, sg))
       end
 
    fun words (s: WordSize.t) =
@@ -945,80 +961,78 @@
        Word8Vector_toString,
        World_save]
       @ List.concat [List.concatMap (RealSize.all, reals),
-		     List.concatMap (WordSize.prims, words)]
+                     List.concatMap (WordSize.prims, words)]
       @ let
-	   val real = RealSize.all
-	   val word = WordSize.all
-	   fun coerces (name, sizes, sizes', ac) =
-	      List.fold
-	      ([false, true], ac, fn (signed, ac) =>
-	       List.fold
-	       (sizes, ac, fn (s, ac) =>
-		List.fold (sizes', ac, fn (s', ac) =>
-			   name (s, s', {signed = signed}) :: ac)))
-	in
-	   coerces (Real_toWord, real, word,
-		    coerces (Word_toReal, word, real,
-			     coerces (Word_toWord, word, word,
-				      List.fold
-				      (real, [], fn (s, ac) =>
-				       List.fold
-				       (real, ac, fn (s', ac) =>
-					Real_toReal (s, s') :: ac)))))
-	end
+           val real = RealSize.all
+           val word = WordSize.all
+           fun coerces (name, sizes, sizes', ac) =
+              List.fold
+              ([false, true], ac, fn (signed, ac) =>
+               List.fold
+               (sizes, ac, fn (s, ac) =>
+                List.fold (sizes', ac, fn (s', ac) =>
+                           name (s, s', {signed = signed}) :: ac)))
+        in
+           coerces (Real_toWord, real, word,
+                    coerces (Word_toReal, word, real,
+                             coerces (Word_toWord, word, word,
+                                      List.fold
+                                      (real, [], fn (s, ac) =>
+                                       List.fold
+                                       (real, ac, fn (s', ac) =>
+                                        Real_toReal (s, s') :: ac)))))
+        end
      @ let
-	  fun doit (all, get, set) =
-	     List.concatMap (all, fn s => [get s, set s])
+          fun doit (all, get, set) =
+             List.concatMap (all, fn s => [get s, set s])
        in
-	  List.concat [doit (RealSize.all, Pointer_getReal, Pointer_setReal),
-		       doit (WordSize.prims, Pointer_getWord, Pointer_setWord)]
+          List.concat [doit (RealSize.all, Pointer_getReal, Pointer_setReal),
+                       doit (WordSize.prims, Pointer_getWord, Pointer_setWord)]
        end
 end
 
 local
    val table: {hash: word,
-	       prim: unit t,
-	       string: string} HashSet.t =
+               prim: unit t,
+               string: string} HashSet.t =
       HashSet.new {hash = #hash}
    val () =
       List.foreach (all, fn prim =>
-		    let
-		       val string = toString prim
-		       val hash = String.hash string
-		       val _ =
-			  HashSet.lookupOrInsert (table, hash,
-						  fn _ => false,
-						  fn () => {hash = hash,
-							    prim = prim,
-							    string = string})
-		    in
-		       ()
-		    end)
+                    let
+                       val string = toString prim
+                       val hash = String.hash string
+                       val _ =
+                          HashSet.lookupOrInsert (table, hash,
+                                                  fn _ => false,
+                                                  fn () => {hash = hash,
+                                                            prim = prim,
+                                                            string = string})
+                    in
+                       ()
+                    end)
 in
-   val fromString: string -> 'a t =
+   val fromString: string -> 'a t option =
       fn name =>
-      cast
-      (#prim
-       (HashSet.lookupOrInsert
-	(table, String.hash name,
-	 fn {string, ...} => name = string,
-	 fn () => Error.bug (concat ["unknown primitive: ", name]))))
+      Option.map
+      (HashSet.peek
+       (table, String.hash name, fn {string, ...} => name = string),
+       fn {prim, ...} => cast prim)
 end
 
 fun ('a, 'b) extractTargs (prim: 'b t,
-			   {args: 'a vector,
-			    deArray: 'a -> 'a,
-			    deArrow: 'a -> 'a * 'a,
-			    deVector: 'a -> 'a,
-			    deWeak: 'a -> 'a,
-			    result: 'a}) =
+                           {args: 'a vector,
+                            deArray: 'a -> 'a,
+                            deArrow: 'a -> 'a * 'a,
+                            deVector: 'a -> 'a,
+                            deWeak: 'a -> 'a,
+                            result: 'a}) =
    let
       val one = Vector.new1
       fun arg i = Vector.sub (args, i)
       datatype z = datatype t
    in
       case prim of
-	 Array_array => one (deArray result)
+         Array_array => one (deArray result)
        | Array_array0Const => one (deArray result)
        | Array_sub => one (deArray (arg 0))
        | Array_toVector => one (deArray (arg 0))
@@ -1050,23 +1064,23 @@
 
 val extractTargs =
    fn z =>
-   Trace.trace ("extractTargs", layout o #1, Layout.ignore) extractTargs z
+   Trace.trace ("Prim.extractTargs", layout o #1, Layout.ignore) extractTargs z
 
 structure SmallIntInf = Const.SmallIntInf
 
 structure ApplyArg =
    struct
       datatype 'a t =
-	 Con of {con: Con.t, hasArg: bool}
+         Con of {con: Con.t, hasArg: bool}
        | Const of Const.t
        | Var of 'a
 
       fun layout layoutX =
-	 fn Con {con, hasArg} =>
-	      Layout.record [("con", Con.layout con),
-			     ("hasArg", Bool.layout hasArg)]
-	  | Const c => Const.layout c
-	  | Var x => layoutX x
+         fn Con {con, hasArg} =>
+              Layout.record [("con", Con.layout con),
+                             ("hasArg", Bool.layout hasArg)]
+          | Const c => Const.layout c
+          | Var x => layoutX x
    end
 
 structure ApplyResult =
@@ -1074,7 +1088,7 @@
       type 'a prim = 'a t
 
       datatype ('a, 'b) t =
-	 Apply of 'a prim * 'b list
+         Apply of 'a prim * 'b list
        | Bool of bool
        | Const of Const.t
        | Overflow
@@ -1087,17 +1101,17 @@
       val layoutPrim = layout
 
       fun layout layoutX ar =
-	 let
-	    open Layout
-	 in
-	    case ar of
-	       Apply (p, args) => seq [layoutPrim p, List.layout layoutX args]
-	     | Bool b => Bool.layout b
-	     | Const c => Const.layout c
-	     | Overflow => str "Overflow"
-	     | Unknown => str "Unknown"
-	     | Var x => layoutX x
-	 end
+         let
+            open Layout
+         in
+            case ar of
+               Apply (p, args) => seq [layoutPrim p, List.layout layoutX args]
+             | Bool b => Bool.layout b
+             | Const c => Const.layout c
+             | Overflow => str "Overflow"
+             | Unknown => str "Unknown"
+             | Var x => layoutX x
+         end
    end
 
 (*
@@ -1128,8 +1142,8 @@
  *)
    
 fun ('a, 'b) apply (p: 'a t,
-		    args: 'b ApplyArg.t list,
-		    varEquals: 'b * 'b -> bool): ('a, 'b) ApplyResult.t =
+                    args: 'b ApplyArg.t list,
+                    varEquals: 'b * 'b -> bool): ('a, 'b) ApplyResult.t =
    let
       datatype z = datatype t
       datatype z = datatype Const.t
@@ -1137,390 +1151,389 @@
       val intInf = ApplyResult.Const o Const.intInf
       val intInfConst = intInf o IntInf.fromInt
       fun word (w: WordX.t): ('a, 'b) ApplyResult.t =
-	 ApplyResult.Const (Const.word w)
-      val t = ApplyResult.truee
+         ApplyResult.Const (Const.word w)
       val f = ApplyResult.falsee
       fun iio (f, c1, c2) = intInf (f (c1, c2))
       fun wordS (f: WordX.t * WordX.t * {signed: bool} -> WordX.t,
-		 (_: WordSize.t, sg),
-		 w: WordX.t,
-		 w': WordX.t) =
-	 word (f (w, w', sg))
+                 (_: WordSize.t, sg),
+                 w: WordX.t,
+                 w': WordX.t) =
+         word (f (w, w', sg))
       fun wordCmp (f: WordX.t * WordX.t * {signed: bool} -> bool,
-		   (_: WordSize.t, sg),
-		   w: WordX.t,
-		   w': WordX.t) =
-	 bool (f (w, w', sg))
+                   (_: WordSize.t, sg),
+                   w: WordX.t,
+                   w': WordX.t) =
+         bool (f (w, w', sg))
       fun wordOrOverflow (s, sg, w) =
-	 if WordSize.isInRange (s, w, sg)
-	    then word (WordX.fromIntInf (w, s))
-	 else ApplyResult.Overflow
+         if WordSize.isInRange (s, w, sg)
+            then word (WordX.fromIntInf (w, s))
+         else ApplyResult.Overflow
       fun wcheck (f: IntInf.t * IntInf.t -> IntInf.t,
-		  (s: WordSize.t, sg as {signed}),
-		  w: WordX.t,
-		  w': WordX.t) =
-	 let
-	    val conv = if signed then WordX.toIntInfX else WordX.toIntInf
-	 in
-	    wordOrOverflow (s, sg, f (conv w, conv w'))
-	 end
+                  (s: WordSize.t, sg as {signed}),
+                  w: WordX.t,
+                  w': WordX.t) =
+         let
+            val conv = if signed then WordX.toIntInfX else WordX.toIntInf
+         in
+            wordOrOverflow (s, sg, f (conv w, conv w'))
+         end
       val eq =
- 	 fn (Word w1, Word w2) => bool (WordX.equals (w1, w2))
- 	  | _ => ApplyResult.Unknown
+         fn (Word w1, Word w2) => bool (WordX.equals (w1, w2))
+          | _ => ApplyResult.Unknown
       val equal =
-	 fn (Word w1, Word w2) => bool (WordX.equals (w1, w2))
-	  | (WordVector v1, WordVector v2) => bool (WordXVector.equals (v1, v2))
-	  | _ => ApplyResult.Unknown
+         fn (Word w1, Word w2) => bool (WordX.equals (w1, w2))
+          | (WordVector v1, WordVector v2) => bool (WordXVector.equals (v1, v2))
+          | _ => ApplyResult.Unknown
       fun allConsts (cs: Const.t list) =
-	 (case (p, cs) of
-	     (IntInf_compare, [IntInf i1, IntInf i2]) =>
-		let
-		   val i =
-		      case IntInf.compare (i1, i2) of
-			 Relation.LESS => ~1
-		       | Relation.EQUAL => 0
-		       | Relation.GREATER => 1
-		in
-		   word (WordX.fromIntInf (i, WordSize.default))
-		end
-	   | (IntInf_equal, [IntInf i1, IntInf i2]) => bool (i1 = i2)
-	   | (IntInf_toWord, [IntInf i]) =>
-		(case SmallIntInf.toWord i of
-		    NONE => ApplyResult.Unknown
-		  | SOME w => word (WordX.fromIntInf (Word.toIntInf w,
-						      WordSize.default)))
-	   | (MLton_eq, [c1, c2]) => eq (c1, c2)
-	   | (MLton_equal, [c1, c2]) => equal (c1, c2)
-	   | (Word_add _, [Word w1, Word w2]) => word (WordX.add (w1, w2))
-	   | (Word_addCheck s, [Word w1, Word w2]) => wcheck (op +, s, w1, w2)
-	   | (Word_andb _, [Word w1, Word w2]) => word (WordX.andb (w1, w2))
+         (case (p, cs) of
+             (IntInf_compare, [IntInf i1, IntInf i2]) =>
+                let
+                   val i =
+                      case IntInf.compare (i1, i2) of
+                         Relation.LESS => ~1
+                       | Relation.EQUAL => 0
+                       | Relation.GREATER => 1
+                in
+                   word (WordX.fromIntInf (i, WordSize.default))
+                end
+           | (IntInf_equal, [IntInf i1, IntInf i2]) => bool (i1 = i2)
+           | (IntInf_toWord, [IntInf i]) =>
+                (case SmallIntInf.toWord i of
+                    NONE => ApplyResult.Unknown
+                  | SOME w => word (WordX.fromIntInf (Word.toIntInf w,
+                                                      WordSize.default)))
+           | (MLton_eq, [c1, c2]) => eq (c1, c2)
+           | (MLton_equal, [c1, c2]) => equal (c1, c2)
+           | (Word_add _, [Word w1, Word w2]) => word (WordX.add (w1, w2))
+           | (Word_addCheck s, [Word w1, Word w2]) => wcheck (op +, s, w1, w2)
+           | (Word_andb _, [Word w1, Word w2]) => word (WordX.andb (w1, w2))
            | (Word_equal _, [Word w1, Word w2]) => bool (WordX.equals (w1, w2))
-	   | (Word_lshift _, [Word w1, Word w2]) => word (WordX.lshift (w1, w2))
-	   | (Word_lt s, [Word w1, Word w2]) => wordCmp (WordX.lt, s, w1, w2)
-	   | (Word_mul s, [Word w1, Word w2]) => wordS (WordX.mul, s, w1, w2)
-	   | (Word_mulCheck s, [Word w1, Word w2]) => wcheck (op *, s, w1, w2)
-	   | (Word_neg _, [Word w]) => word (WordX.neg w)
-	   | (Word_negCheck s, [Word w]) =>
-		wordOrOverflow (s, {signed = true}, ~ (WordX.toIntInfX w))
-	   | (Word_notb _, [Word w]) => word (WordX.notb w)
-	   | (Word_orb _, [Word w1, Word w2]) => word (WordX.orb (w1, w2))
-	   | (Word_quot s, [Word w1, Word w2]) =>
-		if WordX.isZero w2
-		   then ApplyResult.Unknown
-		else wordS (WordX.quot, s, w1, w2)
-	   | (Word_rem s, [Word w1, Word w2]) =>
-		if WordX.isZero w2
-		   then ApplyResult.Unknown
-		else wordS (WordX.rem, s, w1, w2)
-	   | (Word_rol _, [Word w1, Word w2]) => word (WordX.rol (w1, w2))
-	   | (Word_ror _, [Word w1, Word w2]) => word (WordX.ror (w1, w2))
-	   | (Word_rshift s, [Word w1, Word w2]) =>
-		wordS (WordX.rshift, s, w1, w2)
-	   | (Word_sub _, [Word w1, Word w2]) => word (WordX.sub (w1, w2))
-	   | (Word_subCheck s, [Word w1, Word w2]) => wcheck (op -, s, w1, w2)
-	   | (Word_toIntInf, [Word w]) =>
-		intInf (SmallIntInf.fromWord
-			(Word.fromIntInf (WordX.toIntInf w)))
-	   | (Word_toWord (_, s, {signed}), [Word w]) =>
-		word (if signed then WordX.resizeX (w, s)
-		      else WordX.resize (w, s))
-	   | (Word_xorb _, [Word w1, Word w2]) => word (WordX.xorb (w1, w2))
-	   | _ => ApplyResult.Unknown)
-	     handle Chr => ApplyResult.Unknown
-		  | Div => ApplyResult.Unknown
-		  | Exn.Overflow => ApplyResult.Overflow
-		  | Subscript => ApplyResult.Unknown
+           | (Word_lshift _, [Word w1, Word w2]) => word (WordX.lshift (w1, w2))
+           | (Word_lt s, [Word w1, Word w2]) => wordCmp (WordX.lt, s, w1, w2)
+           | (Word_mul s, [Word w1, Word w2]) => wordS (WordX.mul, s, w1, w2)
+           | (Word_mulCheck s, [Word w1, Word w2]) => wcheck (op *, s, w1, w2)
+           | (Word_neg _, [Word w]) => word (WordX.neg w)
+           | (Word_negCheck s, [Word w]) =>
+                wordOrOverflow (s, {signed = true}, ~ (WordX.toIntInfX w))
+           | (Word_notb _, [Word w]) => word (WordX.notb w)
+           | (Word_orb _, [Word w1, Word w2]) => word (WordX.orb (w1, w2))
+           | (Word_quot s, [Word w1, Word w2]) =>
+                if WordX.isZero w2
+                   then ApplyResult.Unknown
+                else wordS (WordX.quot, s, w1, w2)
+           | (Word_rem s, [Word w1, Word w2]) =>
+                if WordX.isZero w2
+                   then ApplyResult.Unknown
+                else wordS (WordX.rem, s, w1, w2)
+           | (Word_rol _, [Word w1, Word w2]) => word (WordX.rol (w1, w2))
+           | (Word_ror _, [Word w1, Word w2]) => word (WordX.ror (w1, w2))
+           | (Word_rshift s, [Word w1, Word w2]) =>
+                wordS (WordX.rshift, s, w1, w2)
+           | (Word_sub _, [Word w1, Word w2]) => word (WordX.sub (w1, w2))
+           | (Word_subCheck s, [Word w1, Word w2]) => wcheck (op -, s, w1, w2)
+           | (Word_toIntInf, [Word w]) =>
+                intInf (SmallIntInf.fromWord
+                        (Word.fromIntInf (WordX.toIntInf w)))
+           | (Word_toWord (_, s, {signed}), [Word w]) =>
+                word (if signed then WordX.resizeX (w, s)
+                      else WordX.resize (w, s))
+           | (Word_xorb _, [Word w1, Word w2]) => word (WordX.xorb (w1, w2))
+           | _ => ApplyResult.Unknown)
+             handle Chr => ApplyResult.Unknown
+                  | Div => ApplyResult.Unknown
+                  | Exn.Overflow => ApplyResult.Overflow
+                  | Subscript => ApplyResult.Unknown
       fun someVars () =
-	 let
-	    datatype z = datatype ApplyResult.t
-	    fun varIntInf (x, i: IntInf.t, space, inOrder) =
-	       let
-		  fun neg () = Apply (intInfNeg, [x, space])
-		  fun notb () = Apply (intInfNotb, [x, space])
-		  val i = IntInf.toInt i
-	       in
-		  case p of
-		     IntInf_add => if i = 0 then Var x else Unknown
-		   | IntInf_andb => if i = 0
-				       then intInfConst 0
-				    else if i = ~1
-				       then Var x
-				    else Unknown
-		   | IntInf_gcd => if (i = ~1 orelse i = 1)
-				      then intInfConst 1
-				   else Unknown
-		   | IntInf_mul =>
-			(case i of
-			    0 => intInfConst 0
-			  | 1 => Var x
-			  | ~1 => neg ()
-			  | _ => Unknown)
-		   | IntInf_orb => if i = 0
-				      then Var x
-				   else if i = ~1
-				      then intInfConst ~1
-				   else Unknown
-		   | IntInf_quot => if inOrder
-				       then (case i of
-						1 => Var x
-					      | ~1 => neg ()
-					      | _ => Unknown)
-				    else Unknown
-		   | IntInf_rem => if inOrder andalso (i = ~1 orelse i = 1)
-				      then intInfConst 0
-				   else Unknown
-		   | IntInf_sub => if i = 0
-				      then if inOrder
-					      then Var x
-					   else neg ()
-				   else Unknown
-		   | IntInf_xorb => if i = 0
-				       then Var x
-				    else if i = ~1
-				       then notb ()
-				    else Unknown
-		   | _ => Unknown
-	       end handle Exn.Overflow => Unknown
-	    fun varWord (x, w, inOrder) =
-	       let
-		  val zero = word o WordX.zero
-		  fun add () = if WordX.isZero w then Var x else Unknown
-		  fun mul ((s, {signed}), neg) =
-		     if WordX.isZero w
-			then word w
-		     else if WordX.isOne w
-			     then Var x
-			  else if signed andalso WordX.isNegOne w
-				  then Apply (neg s, [x])
-			       else Unknown
-		  fun sub (s, neg) =
-		     if WordX.isZero w
-			then if inOrder
-				then Var x
-			     else Apply (neg s, [x])
-		     else Unknown
-		  fun ro () =
-		     if inOrder
-			then
-			   let
-			      val s = WordX.size w
-			   in
-			      if WordX.isZero
-				 (WordX.rem
-				  (w,
-				   WordX.fromIntInf
-				   (IntInf.fromInt
-				    (Bits.toInt (WordSize.bits s)),
-				    s),
-				   {signed = false}))
-				 then Var x
-			      else Unknown
-			   end
-		     else
-			if WordX.isZero w orelse WordX.isAllOnes w
-			   then word w
-			else Unknown
-		  fun shift s =
-		     if inOrder
-			then if WordX.isZero w
-				then Var x
-			     else if (WordX.ge
-				      (w,
-				       WordX.fromIntInf (Bits.toIntInf
-							 (WordSize.bits s),
-							 WordSize.default),
-				       {signed = false}))
-				     then zero s
-				  else Unknown
-		     else if WordX.isZero w
-			     then zero s
-			  else Unknown
-	       in
-		  case p of
-		     Word_add _ => add ()
-		   | Word_addCheck _ => add ()
-		   | Word_andb s =>
-			if WordX.isZero w
-			   then zero s
-			else if WordX.isAllOnes w
-				then Var x
-			     else Unknown
-		   | Word_lshift s => shift s
-		   | Word_lt (_, sg) =>
-			if inOrder
-			   then if WordX.isMin (w, sg) then f else Unknown
-			else if WordX.isMax (w, sg) then f else Unknown
-		   | Word_mul s => mul (s, wordNeg)
-		   | Word_mulCheck s => mul (s, wordNegCheck)
-		   | Word_orb _ =>
-			if WordX.isZero w
-			   then Var x
-			else if WordX.isAllOnes w
-				then word w
-			     else Unknown
-		   | Word_quot (s, {signed}) =>
-			if inOrder
-			   then
-			      if WordX.isOne w
-				 then Var x
-			      else if signed andalso WordX.isNegOne w
-				      then Apply (wordNeg s, [x])
-				   else Unknown
-			else Unknown
-		   | Word_rem (s, {signed}) =>
-			if inOrder
-			   andalso (WordX.isOne w
-				    orelse signed andalso WordX.isNegOne w)
-			   then zero s
-			else Unknown
-		   | Word_rol _ => ro ()
-		   | Word_ror _ => ro ()
-		   | Word_rshift (s, {signed}) =>
-			if signed
-			   then
-			      if WordX.isZero w
-				 then if inOrder then Var x else zero s
-			      else if WordX.isAllOnes w andalso not inOrder
-				      then word w
-				   else Unknown
-			else
-			   shift s
-		   | Word_sub s => sub (s, wordNeg)
-		   | Word_subCheck s => sub (s, wordNegCheck o #1)
-		   | Word_xorb s =>
-			if WordX.isZero w
-			   then Var x
-			else if WordX.isAllOnes w
-				then Apply (wordNotb s, [x])
-			     else Unknown
-		   | _ => Unknown
-	       end
-	    datatype z = datatype ApplyArg.t
-	 in
-	    case (p, args) of
-	       (IntInf_toString, [Const (IntInf i), Const (Word base), _]) =>
-		  let
-		     val base =
-			case WordX.toInt base of
-			   2 => StringCvt.BIN
-			 | 8 => StringCvt.OCT 
-			 | 10 => StringCvt.DEC
-			 | 16 => StringCvt.HEX
-			 | _ => Error.bug "strange base for IntInf_toString"
-		  in
-		     ApplyResult.Const (Const.string (IntInf.format (i, base)))
-		  end
-	     | (_, [Con {con = c, hasArg = h}, Con {con = c', ...}]) =>
-		  if (case p of
-			 MLton_eq => true
-		       | MLton_equal => true
-		       | _ => false)
-		     then if Con.equals (c, c')
-			     then if h
-				     then Unknown
-				  else bool true
-			  else bool false
-		  else Unknown
-	     | (_, [Var x, Const (Word i)]) => varWord (x, i, true)
-	     | (_, [Const (Word i), Var x]) => varWord (x, i, false)
-	     | (_, [Const (IntInf i1), Const (IntInf i2), _]) =>
-		  (case p of
-		      IntInf_add => iio (IntInf.+, i1, i2)
-		    | IntInf_andb => iio (IntInf.andb, i1, i2)
-		    | IntInf_gcd => iio (IntInf.gcd, i1, i2)
-		    | IntInf_mul => iio (IntInf.*, i1, i2)
-		    | IntInf_orb => iio (IntInf.orb, i1, i2)
-		    | IntInf_quot => iio (IntInf.quot, i1, i2)
-		    | IntInf_rem => iio (IntInf.rem, i1, i2)
-		    | IntInf_sub => iio (IntInf.-, i1, i2)
-		    | IntInf_xorb => iio (IntInf.xorb, i1, i2)
-		    | _ => Unknown)
-	     | (_, [Const (IntInf i1), Const (Word w2), _]) =>
-		  (case p of
-		      IntInf_arshift =>
-			 intInf (IntInf.~>>
-				 (i1, Word.fromIntInf (WordX.toIntInf w2)))
-		    | IntInf_lshift =>
-			 intInf (IntInf.<<
-				 (i1, Word.fromIntInf (WordX.toIntInf w2)))
-		    | _ => Unknown)
-	     | (_, [Const (IntInf i1), _]) =>
-		  (case p of
-		      IntInf_neg => intInf (IntInf.~ i1)
-		    | IntInf_notb => intInf (IntInf.notb i1)
-		    | _ => Unknown)
-	     | (_, [Var x, Const (IntInf i), Var space]) =>
-		  varIntInf (x, i, space, true)
-	     | (_, [Const (IntInf i), Var x, Var space]) =>
-		  varIntInf (x, i, space, false)
-	     | (_, [Var x, Const (Word w), _]) =>
-		  if WordX.isZero w
-		     then
-			let
-			   datatype z = datatype ApplyResult.t
-			in
-			   case p of
-			      IntInf_arshift => Var x
-			    | IntInf_lshift => Var x
-			    | _ => Unknown
-			end
-		  else Unknown
+         let
+            datatype z = datatype ApplyResult.t
+            fun varIntInf (x, i: IntInf.t, space, inOrder) =
+               let
+                  fun neg () = Apply (intInfNeg, [x, space])
+                  fun notb () = Apply (intInfNotb, [x, space])
+                  val i = IntInf.toInt i
+               in
+                  case p of
+                     IntInf_add => if i = 0 then Var x else Unknown
+                   | IntInf_andb => if i = 0
+                                       then intInfConst 0
+                                    else if i = ~1
+                                       then Var x
+                                    else Unknown
+                   | IntInf_gcd => if (i = ~1 orelse i = 1)
+                                      then intInfConst 1
+                                   else Unknown
+                   | IntInf_mul =>
+                        (case i of
+                            0 => intInfConst 0
+                          | 1 => Var x
+                          | ~1 => neg ()
+                          | _ => Unknown)
+                   | IntInf_orb => if i = 0
+                                      then Var x
+                                   else if i = ~1
+                                      then intInfConst ~1
+                                   else Unknown
+                   | IntInf_quot => if inOrder
+                                       then (case i of
+                                                1 => Var x
+                                              | ~1 => neg ()
+                                              | _ => Unknown)
+                                    else Unknown
+                   | IntInf_rem => if inOrder andalso (i = ~1 orelse i = 1)
+                                      then intInfConst 0
+                                   else Unknown
+                   | IntInf_sub => if i = 0
+                                      then if inOrder
+                                              then Var x
+                                           else neg ()
+                                   else Unknown
+                   | IntInf_xorb => if i = 0
+                                       then Var x
+                                    else if i = ~1
+                                       then notb ()
+                                    else Unknown
+                   | _ => Unknown
+               end handle Exn.Overflow => Unknown
+            fun varWord (x, w, inOrder) =
+               let
+                  val zero = word o WordX.zero
+                  fun add () = if WordX.isZero w then Var x else Unknown
+                  fun mul ((s, {signed}), neg) =
+                     if WordX.isZero w
+                        then word w
+                     else if WordX.isOne w
+                             then Var x
+                          else if signed andalso WordX.isNegOne w
+                                  then Apply (neg s, [x])
+                               else Unknown
+                  fun sub (s, neg) =
+                     if WordX.isZero w
+                        then if inOrder
+                                then Var x
+                             else Apply (neg s, [x])
+                     else Unknown
+                  fun ro () =
+                     if inOrder
+                        then
+                           let
+                              val s = WordX.size w
+                           in
+                              if WordX.isZero
+                                 (WordX.rem
+                                  (w,
+                                   WordX.fromIntInf
+                                   (IntInf.fromInt
+                                    (Bits.toInt (WordSize.bits s)),
+                                    s),
+                                   {signed = false}))
+                                 then Var x
+                              else Unknown
+                           end
+                     else
+                        if WordX.isZero w orelse WordX.isAllOnes w
+                           then word w
+                        else Unknown
+                  fun shift s =
+                     if inOrder
+                        then if WordX.isZero w
+                                then Var x
+                             else if (WordX.ge
+                                      (w,
+                                       WordX.fromIntInf (Bits.toIntInf
+                                                         (WordSize.bits s),
+                                                         WordSize.default),
+                                       {signed = false}))
+                                     then zero s
+                                  else Unknown
+                     else if WordX.isZero w
+                             then zero s
+                          else Unknown
+               in
+                  case p of
+                     Word_add _ => add ()
+                   | Word_addCheck _ => add ()
+                   | Word_andb s =>
+                        if WordX.isZero w
+                           then zero s
+                        else if WordX.isAllOnes w
+                                then Var x
+                             else Unknown
+                   | Word_lshift s => shift s
+                   | Word_lt (_, sg) =>
+                        if inOrder
+                           then if WordX.isMin (w, sg) then f else Unknown
+                        else if WordX.isMax (w, sg) then f else Unknown
+                   | Word_mul s => mul (s, wordNeg)
+                   | Word_mulCheck s => mul (s, wordNegCheck)
+                   | Word_orb _ =>
+                        if WordX.isZero w
+                           then Var x
+                        else if WordX.isAllOnes w
+                                then word w
+                             else Unknown
+                   | Word_quot (s, {signed}) =>
+                        if inOrder
+                           then
+                              if WordX.isOne w
+                                 then Var x
+                              else if signed andalso WordX.isNegOne w
+                                      then Apply (wordNeg s, [x])
+                                   else Unknown
+                        else Unknown
+                   | Word_rem (s, {signed}) =>
+                        if inOrder
+                           andalso (WordX.isOne w
+                                    orelse signed andalso WordX.isNegOne w)
+                           then zero s
+                        else Unknown
+                   | Word_rol _ => ro ()
+                   | Word_ror _ => ro ()
+                   | Word_rshift (s, {signed}) =>
+                        if signed
+                           then
+                              if WordX.isZero w
+                                 then if inOrder then Var x else zero s
+                              else if WordX.isAllOnes w andalso not inOrder
+                                      then word w
+                                   else Unknown
+                        else
+                           shift s
+                   | Word_sub s => sub (s, wordNeg)
+                   | Word_subCheck s => sub (s, wordNegCheck o #1)
+                   | Word_xorb s =>
+                        if WordX.isZero w
+                           then Var x
+                        else if WordX.isAllOnes w
+                                then Apply (wordNotb s, [x])
+                             else Unknown
+                   | _ => Unknown
+               end
+            datatype z = datatype ApplyArg.t
+         in
+            case (p, args) of
+               (IntInf_toString, [Const (IntInf i), Const (Word base), _]) =>
+                  let
+                     val base =
+                        case WordX.toInt base of
+                           2 => StringCvt.BIN
+                         | 8 => StringCvt.OCT 
+                         | 10 => StringCvt.DEC
+                         | 16 => StringCvt.HEX
+                         | _ => Error.bug "Prim.apply: strange base for IntInf_toString"
+                  in
+                     ApplyResult.Const (Const.string (IntInf.format (i, base)))
+                  end
+             | (_, [Con {con = c, hasArg = h}, Con {con = c', ...}]) =>
+                  if (case p of
+                         MLton_eq => true
+                       | MLton_equal => true
+                       | _ => false)
+                     then if Con.equals (c, c')
+                             then if h
+                                     then Unknown
+                                  else bool true
+                          else bool false
+                  else Unknown
+             | (_, [Var x, Const (Word i)]) => varWord (x, i, true)
+             | (_, [Const (Word i), Var x]) => varWord (x, i, false)
+             | (_, [Const (IntInf i1), Const (IntInf i2), _]) =>
+                  (case p of
+                      IntInf_add => iio (IntInf.+, i1, i2)
+                    | IntInf_andb => iio (IntInf.andb, i1, i2)
+                    | IntInf_gcd => iio (IntInf.gcd, i1, i2)
+                    | IntInf_mul => iio (IntInf.*, i1, i2)
+                    | IntInf_orb => iio (IntInf.orb, i1, i2)
+                    | IntInf_quot => iio (IntInf.quot, i1, i2)
+                    | IntInf_rem => iio (IntInf.rem, i1, i2)
+                    | IntInf_sub => iio (IntInf.-, i1, i2)
+                    | IntInf_xorb => iio (IntInf.xorb, i1, i2)
+                    | _ => Unknown)
+             | (_, [Const (IntInf i1), Const (Word w2), _]) =>
+                  (case p of
+                      IntInf_arshift =>
+                         intInf (IntInf.~>>
+                                 (i1, Word.fromIntInf (WordX.toIntInf w2)))
+                    | IntInf_lshift =>
+                         intInf (IntInf.<<
+                                 (i1, Word.fromIntInf (WordX.toIntInf w2)))
+                    | _ => Unknown)
+             | (_, [Const (IntInf i1), _]) =>
+                  (case p of
+                      IntInf_neg => intInf (IntInf.~ i1)
+                    | IntInf_notb => intInf (IntInf.notb i1)
+                    | _ => Unknown)
+             | (_, [Var x, Const (IntInf i), Var space]) =>
+                  varIntInf (x, i, space, true)
+             | (_, [Const (IntInf i), Var x, Var space]) =>
+                  varIntInf (x, i, space, false)
+             | (_, [Var x, Const (Word w), _]) =>
+                  if WordX.isZero w
+                     then
+                        let
+                           datatype z = datatype ApplyResult.t
+                        in
+                           case p of
+                              IntInf_arshift => Var x
+                            | IntInf_lshift => Var x
+                            | _ => Unknown
+                        end
+                  else Unknown
              | (_, [Var x, Var y, _]) =>
-		  if varEquals (x, y)
-		     then let datatype z = datatype ApplyResult.t
-			  in
-			     case p of
-			        IntInf_andb => Var x
-			      | IntInf_orb => Var x
-			      | IntInf_quot => intInfConst 1
-			      | IntInf_rem => intInfConst 0
-			      | IntInf_sub => intInfConst 0
-			      | IntInf_xorb => intInfConst 0
-			      | _ => Unknown
-			  end
-		  else Unknown
-	     | (_, [Var x, Var y]) =>
-		  if varEquals (x, y)
-		     then let
-			     val t = ApplyResult.truee
-			     val f = ApplyResult.falsee
-			     datatype z = datatype ApplyResult.t
-			  in
-			     case p of
-				IntInf_compare =>
-				   word (WordX.zero WordSize.default)
-			      | IntInf_equal => t
-			      | MLton_eq => t
-			      | MLton_equal => t
-			      | Real_lt _ => f
-			      | Real_le _ => t
-			      | Real_equal _ => t
-			      | Real_qequal _ => t
-			      | Word_andb _ => Var x
+                  if varEquals (x, y)
+                     then let datatype z = datatype ApplyResult.t
+                          in
+                             case p of
+                                IntInf_andb => Var x
+                              | IntInf_orb => Var x
+                              | IntInf_quot => intInfConst 1
+                              | IntInf_rem => intInfConst 0
+                              | IntInf_sub => intInfConst 0
+                              | IntInf_xorb => intInfConst 0
+                              | _ => Unknown
+                          end
+                  else Unknown
+             | (_, [Var x, Var y]) =>
+                  if varEquals (x, y)
+                     then let
+                             val t = ApplyResult.truee
+                             val f = ApplyResult.falsee
+                             datatype z = datatype ApplyResult.t
+                          in
+                             case p of
+                                IntInf_compare =>
+                                   word (WordX.zero WordSize.default)
+                              | IntInf_equal => t
+                              | MLton_eq => t
+                              | MLton_equal => t
+                              | Real_lt _ => f
+                              | Real_le _ => t
+                              | Real_equal _ => t
+                              | Real_qequal _ => t
+                              | Word_andb _ => Var x
                               | Word_equal _ => t
-			      | Word_lt _ => f
-			      | Word_orb _ => Var x
-			      | Word_quot (s, _) => word (WordX.one s)
-			      | Word_rem (s, _) => word (WordX.zero s)
-			      | Word_sub s => word (WordX.zero s)
-			      | Word_xorb s => word (WordX.zero s)
-			      | _ => Unknown
-			  end
-		  else Unknown
+                              | Word_lt _ => f
+                              | Word_orb _ => Var x
+                              | Word_quot (s, _) => word (WordX.one s)
+                              | Word_rem (s, _) => word (WordX.zero s)
+                              | Word_sub s => word (WordX.zero s)
+                              | Word_xorb s => word (WordX.zero s)
+                              | _ => Unknown
+                          end
+                  else Unknown
              | _ => Unknown
-	 end
+         end
    in
       if List.forall (args, fn ApplyArg.Const _ => true | _ => false)
-	 then
-	    allConsts
-	    (List.map
-	     (args, fn ApplyArg.Const c => c | _ => Error.bug "Prim.apply"))
+         then
+            allConsts
+            (List.map
+             (args, fn ApplyArg.Const c => c | _ => Error.bug "Prim.apply"))
       else someVars ()
    end
 
 fun ('a, 'b) layoutApp (p: 'a t,
-			args: 'b vector,
-			layoutArg: 'b -> Layout.t): Layout.t =
+                        args: 'b vector,
+                        layoutArg: 'b -> Layout.t): Layout.t =
    let
       fun arg i = layoutArg (Vector.sub (args, i))
       open Layout
@@ -1528,7 +1541,7 @@
       fun two name = seq [arg 0, str " ", str name, str " ", arg 1]
    in
       case p of
-	 IntInf_equal => two "="
+         IntInf_equal => two "="
        | MLton_eq => two "="
        | Real_Math_acos _ => one "acos"
        | Real_Math_asin _ => one "asin"

Modified: mlton/branches/on-20050420-cmm-branch/mlton/atoms/prim.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/atoms/prim.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/atoms/prim.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature PRIM_STRUCTS = 
    sig
       structure CFunction: C_FUNCTION
@@ -22,182 +23,182 @@
       include PRIM_STRUCTS
 
       structure Name:
-	 sig
-	    datatype 'a t =
-	       Array_array (* backend *)
-	     | Array_array0Const (* constant propagation *)
-	     | Array_length (* ssa to rssa *)
-	     | Array_sub (* ssa to ssa2 *)
-	     | Array_toVector (* backend *)
-	     | Array_update (* ssa to ssa2 *)
-	     | Exn_extra (* implement exceptions *)
-	     | Exn_name (* implement exceptions *)
-	     | Exn_setExtendExtra (* implement exceptions *)
-	     | Exn_setInitExtra (* implement exceptions *)
-	     | FFI of 'a CFunction.t (* ssa to rssa *)
-	     | FFI_Symbol of {name: string} (* codegen *)
-	     | GC_collect (* ssa to rssa *)
-	     | IntInf_add (* ssa to rssa *)
-	     | IntInf_andb (* ssa to rssa *)
-	     | IntInf_arshift (* ssa to rssa *)
-	     | IntInf_compare (* ssa to rssa *)
-	     | IntInf_equal (* ssa to rssa *)
-	     | IntInf_gcd (* ssa to rssa *)
-	     | IntInf_lshift (* ssa to rssa *)
-	     | IntInf_mul (* ssa to rssa *)
-	     | IntInf_neg (* ssa to rssa *)
-	     | IntInf_notb (* ssa to rssa *)
-	     | IntInf_orb (* ssa to rssa *)
-	     | IntInf_quot (* ssa to rssa *)
-	     | IntInf_rem (* ssa to rssa *)
-	     | IntInf_sub (* ssa to rssa *)
-	     | IntInf_toString (* ssa to rssa *)
-	     | IntInf_toVector (* ssa to rssa *)
-	     | IntInf_toWord (* ssa to rssa *)
-	     | IntInf_xorb (* ssa to rssa *)
-	     | MLton_bogus (* ssa to rssa *)
-	     (* of type unit -> 'a.
-	      * Makes a bogus value of any type.
-	      *)
-	     | MLton_bug (* ssa to rssa *)
-	     | MLton_deserialize (* unused *)
-	     | MLton_eq (* codegen *)
-	     | MLton_equal (* polymorphic equality *)
-	     | MLton_halt (* ssa to rssa *)
-	     (* MLton_handlesSignals and MLton_installSignalHandler work together
-	      * to inform the optimizer and basis library whether or not the
-	      * program uses signal handlers.
-	      *
-	      * MLton_installSignalHandler is called by MLton.Signal.setHandler,
-	      * and is effectively a noop, but is left in the program until the
-	      * end of the backend, so that the optimizer can test whether or
-	      * not the program installs signal handlers.
-	      *
-	      * MLton_handlesSignals is translated by closure conversion into
-	      * a boolean, and is true iff MLton_installsSignalHandler is called.
-	      *)
-	     | MLton_handlesSignals (* closure conversion *)
-	     | MLton_installSignalHandler (* backend *)
-	     | MLton_serialize (* unused *)
-	     | MLton_share
-	     | MLton_size (* ssa to rssa *)
-	     | MLton_touch (* backend *)
-	     | Pointer_getPointer (* ssa to rssa *)
-	     | Pointer_getReal of RealSize.t (* ssa to rssa *)
-	     | Pointer_getWord of WordSize.t (* ssa to rssa *)
-	     | Pointer_setPointer (* ssa to rssa *)
-	     | Pointer_setReal of RealSize.t (* ssa to rssa *)
-	     | Pointer_setWord of WordSize.t (* ssa to rssa *)
-	     | Real_Math_acos of RealSize.t (* codegen *)
-	     | Real_Math_asin of RealSize.t (* codegen *)
-	     | Real_Math_atan of RealSize.t (* codegen *)
-	     | Real_Math_atan2 of RealSize.t (* codegen *)
-	     | Real_Math_cos of RealSize.t (* codegen *)
-	     | Real_Math_exp of RealSize.t (* codegen *)
-	     | Real_Math_ln of RealSize.t (* codegen *)
-	     | Real_Math_log10 of RealSize.t  (* codegen *)
-	     | Real_Math_sin of RealSize.t (* codegen *)
-	     | Real_Math_sqrt of RealSize.t (* codegen *)
-	     | Real_Math_tan of RealSize.t (* codegen *)
-	     | Real_abs of RealSize.t (* codegen *)
-	     | Real_add of RealSize.t (* codegen *)
-	     | Real_div of RealSize.t (* codegen *)
-	     | Real_equal of RealSize.t (* codegen *)
-	     | Real_ldexp of RealSize.t (* codegen *)
-	     | Real_le of RealSize.t (* codegen *)
-	     | Real_lt of RealSize.t (* codegen *)
-	     | Real_mul of RealSize.t (* codegen *)
-	     | Real_muladd of RealSize.t (* codegen *)
-	     | Real_mulsub of RealSize.t (* codegen *)
-	     | Real_neg of RealSize.t	  (* codegen *)
-	     | Real_qequal of RealSize.t (* codegen *)
-	     | Real_round of RealSize.t (* codegen *)
-	     | Real_sub of RealSize.t (* codegen *)
-	     | Real_toWord of RealSize.t * WordSize.t * {signed: bool} (* codegen *)
-	     | Real_toReal of RealSize.t * RealSize.t (* codegen *)
-	     | Ref_assign (* ssa to ssa2 *)
-	     | Ref_deref (* ssa to ssa2 *)
-	     | Ref_ref (* ssa to ssa2 *)
-	     | String_toWord8Vector (* defunctorize *)
-	     | Thread_atomicBegin (* backend *)
-	     | Thread_atomicEnd (* backend *)
-	     | Thread_canHandle (* backend *)
-	     | Thread_copy (* ssa to rssa *)
-	     | Thread_copyCurrent (* ssa to rssa *)
-	     | Thread_returnToC (* codegen *)
-	     (* switchTo has to be a _prim because we have to know that it
-	      * enters the runtime -- because everything must be saved
-	      * on the stack.
-	      *)
-	     | Thread_switchTo (* ssa to rssa *)
-	     | TopLevel_setHandler (* implement exceptions *)
-	     | TopLevel_setSuffix (* implement suffix *)
-	     | Vector_length (* ssa to ssa2 *)
-	     | Vector_sub (* ssa to ssa2 *)
-	     | Weak_canGet (* ssa to rssa *)
-	     | Weak_get (* ssa to rssa *)
-	     | Weak_new (* ssa to rssa *)
-	     | Word_add of WordSize.t (* codegen *)
-	     | Word_addCheck of WordSize.t * {signed: bool} (* codegen *)
-	     | Word_andb of WordSize.t (* codegen *)
-	     | Word_equal of WordSize.t (* codegen *)
-	     | Word_lshift of WordSize.t (* codegen *)
-	     | Word_lt of WordSize.t * {signed: bool} (* codegen *)
-	     | Word_mul of WordSize.t * {signed: bool} (* codegen *)
-	     | Word_mulCheck of WordSize.t * {signed: bool} (* codegen *)
-	     | Word_neg of WordSize.t (* codegen *)
-	     | Word_negCheck of WordSize.t (* codegen *)
-	     | Word_notb of WordSize.t (* codegen *)
-	     | Word_orb of WordSize.t (* codegen *)
-	     | Word_quot of WordSize.t * {signed: bool} (* codegen *)
-	     | Word_rem of WordSize.t * {signed: bool} (* codegen *)
-	     | Word_rol of WordSize.t (* codegen *)
-	     | Word_ror of WordSize.t (* codegen *)
-	     | Word_rshift of WordSize.t * {signed: bool} (* codegen *)
-	     | Word_sub of WordSize.t (* codegen *)
-	     | Word_subCheck of WordSize.t* {signed: bool} (* codegen *)
-	     | Word_toIntInf (* ssa to rssa *)
-	     | Word_toReal of WordSize.t * RealSize.t * {signed: bool} (* codegen *)
-	     | Word_toWord of WordSize.t * WordSize.t * {signed: bool} (* codegen *)
-	     | Word_xorb of WordSize.t (* codegen *)
-	     | WordVector_toIntInf (* ssa to rssa *)
-	     | Word8Array_subWord (* ssa to rssa *)
-	     | Word8Array_updateWord (* ssa to rssa *)
-	     | Word8Vector_subWord (* ssa to rssa *)
-	     | Word8Vector_toString (* defunctorize *)
-	     | World_save (* ssa to rssa *)
+         sig
+            datatype 'a t =
+               Array_array (* backend *)
+             | Array_array0Const (* constant propagation *)
+             | Array_length (* ssa to rssa *)
+             | Array_sub (* ssa to ssa2 *)
+             | Array_toVector (* backend *)
+             | Array_update (* ssa to ssa2 *)
+             | Exn_extra (* implement exceptions *)
+             | Exn_name (* implement exceptions *)
+             | Exn_setExtendExtra (* implement exceptions *)
+             | Exn_setInitExtra (* implement exceptions *)
+             | FFI of 'a CFunction.t (* ssa to rssa *)
+             | FFI_Symbol of {name: string} (* codegen *)
+             | GC_collect (* ssa to rssa *)
+             | IntInf_add (* ssa to rssa *)
+             | IntInf_andb (* ssa to rssa *)
+             | IntInf_arshift (* ssa to rssa *)
+             | IntInf_compare (* ssa to rssa *)
+             | IntInf_equal (* ssa to rssa *)
+             | IntInf_gcd (* ssa to rssa *)
+             | IntInf_lshift (* ssa to rssa *)
+             | IntInf_mul (* ssa to rssa *)
+             | IntInf_neg (* ssa to rssa *)
+             | IntInf_notb (* ssa to rssa *)
+             | IntInf_orb (* ssa to rssa *)
+             | IntInf_quot (* ssa to rssa *)
+             | IntInf_rem (* ssa to rssa *)
+             | IntInf_sub (* ssa to rssa *)
+             | IntInf_toString (* ssa to rssa *)
+             | IntInf_toVector (* ssa to rssa *)
+             | IntInf_toWord (* ssa to rssa *)
+             | IntInf_xorb (* ssa to rssa *)
+             | MLton_bogus (* ssa to rssa *)
+             (* of type unit -> 'a.
+              * Makes a bogus value of any type.
+              *)
+             | MLton_bug (* ssa to rssa *)
+             | MLton_deserialize (* unused *)
+             | MLton_eq (* codegen *)
+             | MLton_equal (* polymorphic equality *)
+             | MLton_halt (* ssa to rssa *)
+             (* MLton_handlesSignals and MLton_installSignalHandler work together
+              * to inform the optimizer and basis library whether or not the
+              * program uses signal handlers.
+              *
+              * MLton_installSignalHandler is called by MLton.Signal.setHandler,
+              * and is effectively a noop, but is left in the program until the
+              * end of the backend, so that the optimizer can test whether or
+              * not the program installs signal handlers.
+              *
+              * MLton_handlesSignals is translated by closure conversion into
+              * a boolean, and is true iff MLton_installsSignalHandler is called.
+              *)
+             | MLton_handlesSignals (* closure conversion *)
+             | MLton_installSignalHandler (* backend *)
+             | MLton_serialize (* unused *)
+             | MLton_share
+             | MLton_size (* ssa to rssa *)
+             | MLton_touch (* backend *)
+             | Pointer_getPointer (* ssa to rssa *)
+             | Pointer_getReal of RealSize.t (* ssa to rssa *)
+             | Pointer_getWord of WordSize.t (* ssa to rssa *)
+             | Pointer_setPointer (* ssa to rssa *)
+             | Pointer_setReal of RealSize.t (* ssa to rssa *)
+             | Pointer_setWord of WordSize.t (* ssa to rssa *)
+             | Real_Math_acos of RealSize.t (* codegen *)
+             | Real_Math_asin of RealSize.t (* codegen *)
+             | Real_Math_atan of RealSize.t (* codegen *)
+             | Real_Math_atan2 of RealSize.t (* codegen *)
+             | Real_Math_cos of RealSize.t (* codegen *)
+             | Real_Math_exp of RealSize.t (* codegen *)
+             | Real_Math_ln of RealSize.t (* codegen *)
+             | Real_Math_log10 of RealSize.t  (* codegen *)
+             | Real_Math_sin of RealSize.t (* codegen *)
+             | Real_Math_sqrt of RealSize.t (* codegen *)
+             | Real_Math_tan of RealSize.t (* codegen *)
+             | Real_abs of RealSize.t (* codegen *)
+             | Real_add of RealSize.t (* codegen *)
+             | Real_div of RealSize.t (* codegen *)
+             | Real_equal of RealSize.t (* codegen *)
+             | Real_ldexp of RealSize.t (* codegen *)
+             | Real_le of RealSize.t (* codegen *)
+             | Real_lt of RealSize.t (* codegen *)
+             | Real_mul of RealSize.t (* codegen *)
+             | Real_muladd of RealSize.t (* codegen *)
+             | Real_mulsub of RealSize.t (* codegen *)
+             | Real_neg of RealSize.t     (* codegen *)
+             | Real_qequal of RealSize.t (* codegen *)
+             | Real_round of RealSize.t (* codegen *)
+             | Real_sub of RealSize.t (* codegen *)
+             | Real_toWord of RealSize.t * WordSize.t * {signed: bool} (* codegen *)
+             | Real_toReal of RealSize.t * RealSize.t (* codegen *)
+             | Ref_assign (* ssa to ssa2 *)
+             | Ref_deref (* ssa to ssa2 *)
+             | Ref_ref (* ssa to ssa2 *)
+             | String_toWord8Vector (* defunctorize *)
+             | Thread_atomicBegin (* backend *)
+             | Thread_atomicEnd (* backend *)
+             | Thread_canHandle (* backend *)
+             | Thread_copy (* ssa to rssa *)
+             | Thread_copyCurrent (* ssa to rssa *)
+             | Thread_returnToC (* codegen *)
+             (* switchTo has to be a _prim because we have to know that it
+              * enters the runtime -- because everything must be saved
+              * on the stack.
+              *)
+             | Thread_switchTo (* ssa to rssa *)
+             | TopLevel_setHandler (* implement exceptions *)
+             | TopLevel_setSuffix (* implement suffix *)
+             | Vector_length (* ssa to ssa2 *)
+             | Vector_sub (* ssa to ssa2 *)
+             | Weak_canGet (* ssa to rssa *)
+             | Weak_get (* ssa to rssa *)
+             | Weak_new (* ssa to rssa *)
+             | Word_add of WordSize.t (* codegen *)
+             | Word_addCheck of WordSize.t * {signed: bool} (* codegen *)
+             | Word_andb of WordSize.t (* codegen *)
+             | Word_equal of WordSize.t (* codegen *)
+             | Word_lshift of WordSize.t (* codegen *)
+             | Word_lt of WordSize.t * {signed: bool} (* codegen *)
+             | Word_mul of WordSize.t * {signed: bool} (* codegen *)
+             | Word_mulCheck of WordSize.t * {signed: bool} (* codegen *)
+             | Word_neg of WordSize.t (* codegen *)
+             | Word_negCheck of WordSize.t (* codegen *)
+             | Word_notb of WordSize.t (* codegen *)
+             | Word_orb of WordSize.t (* codegen *)
+             | Word_quot of WordSize.t * {signed: bool} (* codegen *)
+             | Word_rem of WordSize.t * {signed: bool} (* codegen *)
+             | Word_rol of WordSize.t (* codegen *)
+             | Word_ror of WordSize.t (* codegen *)
+             | Word_rshift of WordSize.t * {signed: bool} (* codegen *)
+             | Word_sub of WordSize.t (* codegen *)
+             | Word_subCheck of WordSize.t* {signed: bool} (* codegen *)
+             | Word_toIntInf (* ssa to rssa *)
+             | Word_toReal of WordSize.t * RealSize.t * {signed: bool} (* codegen *)
+             | Word_toWord of WordSize.t * WordSize.t * {signed: bool} (* codegen *)
+             | Word_xorb of WordSize.t (* codegen *)
+             | WordVector_toIntInf (* ssa to rssa *)
+             | Word8Array_subWord (* ssa to rssa *)
+             | Word8Array_updateWord (* ssa to rssa *)
+             | Word8Vector_subWord (* ssa to rssa *)
+             | Word8Vector_toString (* defunctorize *)
+             | World_save (* ssa to rssa *)
 
-	    val layout: 'a t -> Layout.t
-	    val toString: 'a t -> string
-	 end
+            val layout: 'a t -> Layout.t
+            val toString: 'a t -> string
+         end
 
       structure ApplyArg:
-	 sig
-	    datatype 'a t =
-	       Con of {con: Con.t, hasArg: bool}
-	     | Const of Const.t
-	     | Var of 'a
+         sig
+            datatype 'a t =
+               Con of {con: Con.t, hasArg: bool}
+             | Const of Const.t
+             | Var of 'a
 
-	    val layout: ('a -> Layout.t) -> 'a t -> Layout.t
-	 end
+            val layout: ('a -> Layout.t) -> 'a t -> Layout.t
+         end
       structure ApplyResult:
-	 sig
-	    type 'a prim
-	    datatype ('a, 'b) t =
-	       Apply of 'a prim * 'b list
-	     | Bool of bool
-	     | Const of Const.t
-	     | Overflow
-	     | Unknown
-	     | Var of 'b
+         sig
+            type 'a prim
+            datatype ('a, 'b) t =
+               Apply of 'a prim * 'b list
+             | Bool of bool
+             | Const of Const.t
+             | Overflow
+             | Unknown
+             | Var of 'b
 
-	    val layout: ('b -> Layout.t) -> ('a, 'b) t -> Layout.t
-	 end
+            val layout: ('b -> Layout.t) -> ('a, 'b) t -> Layout.t
+         end
       
       type 'a t
       sharing type t = ApplyResult.prim
       val apply:
-	 'a t * 'b ApplyArg.t list * ('b * 'b -> bool) -> ('a, 'b) ApplyResult.t
+         'a t * 'b ApplyArg.t list * ('b * 'b -> bool) -> ('a, 'b) ApplyResult.t
       val array: 'a t
       val arrayLength: 'a t
       val assign: 'a t
@@ -209,14 +210,14 @@
       val equal: 'a t (* polymorphic equality *)
       val equals: 'a t * 'a t -> bool
       val extractTargs: 'a t * {args: 'b vector,
-				deArray: 'b -> 'b,
-				deArrow: 'b -> 'b * 'b,
-				deVector: 'b -> 'b,
-				deWeak: 'b -> 'b,
-				result: 'b} -> 'b vector
+                                deArray: 'b -> 'b,
+                                deArrow: 'b -> 'b * 'b,
+                                deVector: 'b -> 'b,
+                                deWeak: 'b -> 'b,
+                                result: 'b} -> 'b vector
       val ffi: 'a CFunction.t -> 'a t
       val ffiSymbol: {name: string} -> 'a t
-      val fromString: string -> 'a t
+      val fromString: string -> 'a t option
       val gcCollect: 'a t
       val intInfEqual: 'a t
       val isCommutative: 'a t -> bool
@@ -239,6 +240,7 @@
        *)
       val maySideEffect: 'a t -> bool
       val pointerGet: CType.t -> 'a t
+      val pointerSet: CType.t -> 'a t
       val name: 'a t -> 'a Name.t
       val reff: 'a t
       val serialize: 'a t

Modified: mlton/branches/on-20050420-cmm-branch/mlton/atoms/profile-exp.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/atoms/profile-exp.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/atoms/profile-exp.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,8 +1,8 @@
-(* Copyright (C) 2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 2004-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 functor ProfileExp (S: PROFILE_EXP_STRUCTS): PROFILE_EXP =

Modified: mlton/branches/on-20050420-cmm-branch/mlton/atoms/profile-exp.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/atoms/profile-exp.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/atoms/profile-exp.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,8 +1,8 @@
-(* Copyright (C) 2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 2004-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 type word = Word.t
@@ -17,7 +17,7 @@
       include PROFILE_EXP_STRUCTS
 
       datatype t =
-	 Enter of SourceInfo.t
+         Enter of SourceInfo.t
        | Leave of SourceInfo.t
 
       val equals: t * t -> bool

Modified: mlton/branches/on-20050420-cmm-branch/mlton/atoms/profile-label.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/atoms/profile-label.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/atoms/profile-label.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,10 @@
+(* Copyright (C) 2004-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 functor ProfileLabel (S: PROFILE_LABEL_STRUCTS): PROFILE_LABEL =
    struct
       open S
@@ -3,24 +10,24 @@
 
       type int = Int.t
-	 
+         
       datatype t = T of {plist: PropertyList.t,
-			 uniq: int}
+                         uniq: int}
 
       local
-	 fun make f (T r) = f r
+         fun make f (T r) = f r
       in
-	 val plist = make #plist
-	 val uniq = make #uniq
+         val plist = make #plist
+         val uniq = make #uniq
       end
 
       local
-	 val c = Counter.new 0
+         val c = Counter.new 0
       in
-	 fun new () = T {plist = PropertyList.new (),
-			 uniq = Counter.next c}
+         fun new () = T {plist = PropertyList.new (),
+                         uniq = Counter.next c}
       end
 
       fun toString (T {uniq, ...}) =
-	 concat ["MLtonProfile", Int.toString uniq]
+         concat ["MLtonProfile", Int.toString uniq]
 
       val layout = Layout.str o toString

Modified: mlton/branches/on-20050420-cmm-branch/mlton/atoms/profile-label.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/atoms/profile-label.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/atoms/profile-label.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,10 @@
+(* Copyright (C) 2004-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 signature PROFILE_LABEL_STRUCTS =
    sig
    end
@@ -5,7 +12,7 @@
 signature PROFILE_LABEL =
    sig
       type t
-	
+        
       val clear: t -> unit
       val equals: t * t -> bool
       val layout: t -> Layout.t

Modified: mlton/branches/on-20050420-cmm-branch/mlton/atoms/real-x.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/atoms/real-x.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/atoms/real-x.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 2004-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 functor RealX (S: REAL_X_STRUCTS): REAL_X = 
 struct
 
@@ -24,19 +25,19 @@
    case r of
       Real32 _ => R32
     | Real64 _ => R64
-	 
+         
 fun make (r: string, s: RealSize.t): t option =
    let
       fun doit (fromString, isFinite, con): t option =
-	 case fromString r of
-	    NONE => Error.bug "unexpected real constant"
-	  | SOME r =>
-	       if isFinite r
-		  then SOME (con r)
-	       else NONE
+         case fromString r of
+            NONE => Error.bug "RealX.make: unexpected real constant"
+          | SOME r =>
+               if isFinite r
+                  then SOME (con r)
+               else NONE
    in
       case s of
-	 R32 => doit (Real32.fromString, Real32.isFinite, Real32)
+         R32 => doit (Real32.fromString, Real32.isFinite, Real32)
        | R64 => doit (Real64.fromString, Real64.isFinite, Real64)
    end
 
@@ -47,17 +48,17 @@
 fun equals (r, r') =
    case (r, r') of
       (Real32 r, Real32 r') =>
-	 let
-	    open Real32
-	 in
-	    equals (r, r') andalso signBit r = signBit r'
-	 end
+         let
+            open Real32
+         in
+            equals (r, r') andalso signBit r = signBit r'
+         end
     | (Real64 r, Real64 r') =>
-	 let
-	    open Real64
-	 in
-	    equals (r, r') andalso signBit r = signBit r'
-	 end
+         let
+            open Real64
+         in
+            equals (r, r') andalso signBit r = signBit r'
+         end
     | _ => false
 
 fun toString r =

Modified: mlton/branches/on-20050420-cmm-branch/mlton/atoms/real-x.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/atoms/real-x.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/atoms/real-x.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,8 +1,8 @@
-(* Copyright (C) 2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 2004-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 type word = Word.t

Modified: mlton/branches/on-20050420-cmm-branch/mlton/atoms/source-info.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/atoms/source-info.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/atoms/source-info.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,10 @@
+(* Copyright (C) 2003-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 functor SourceInfo (S: SOURCE_INFO_STRUCTS): SOURCE_INFO =
 struct
 
@@ -6,53 +13,53 @@
 structure Pos =
    struct
       datatype t =
-	 Known of SourcePos.t
+         Known of SourcePos.t
        | Unknown
 
       fun toString p =
-	 case p of
-	    Known p =>
-	       if !Control.profile = Control.ProfileCallStack
-		  then SourcePos.toString p
-	       else concat [SourcePos.file p, ": ",
-			    Int.toString (SourcePos.line p)]
-	  | Unknown => "<unknown>"
+         case p of
+            Known p =>
+               if !Control.profile = Control.ProfileCallStack
+                  then SourcePos.toString p
+               else concat [SourcePos.file p, ": ",
+                            Int.toString (SourcePos.line p)]
+          | Unknown => "<unknown>"
 
       fun fromRegion r =
-	 case Region.left r of
-	    NONE => Unknown
-	  | SOME p => Known p
+         case Region.left r of
+            NONE => Unknown
+          | SOME p => Known p
 
-      fun isBasis p =
-	 case p of
-	    Known p => SourcePos.isBasis p
-	  | Unknown => false
+      fun file p =
+         case p of
+            Known p => SOME (SourcePos.file p)
+          | Unknown => NONE
    end
 
 datatype info =
    Anonymous of Pos.t
  | C of string
  | Function of {name: string list,
-		pos: Pos.t}
+                pos: Pos.t}
 
 datatype t = T of {hash: word,
-		   info: info,
-		   plist: PropertyList.t}
+                   info: info,
+                   plist: PropertyList.t}
 
 local
    val r: t list ref = ref []
 in
    fun new info =
       let
-	 val res = T {hash = Random.word (),
-		      info = info,
-		      plist = PropertyList.new ()}
-	 val () =
-	    if !Control.profile = Control.ProfileCount
-	       then List.push (r, res)
-	    else ()
+         val res = T {hash = Random.word (),
+                      info = info,
+                      plist = PropertyList.new ()}
+         val () =
+            if !Control.profile = Control.ProfileCount
+               then List.push (r, res)
+            else ()
       in
-	 res
+         res
       end
    fun all () = !r
 end
@@ -69,34 +76,34 @@
 
 local
    val set: {hash: word,
-	     name: string,
-	     sourceInfo: t} HashSet.t =
+             name: string,
+             sourceInfo: t} HashSet.t =
       HashSet.new {hash = #hash}
 in   
    fun fromC (name: string) =
       let
-	 val hash = String.hash name
+         val hash = String.hash name
       in
-	 #sourceInfo
-	 (HashSet.lookupOrInsert
-	  (set, hash, fn {hash = h, ...} => hash = h,
-	   fn () => {hash = hash,
-		     name = name,
-		     sourceInfo = new (C name)}))
+         #sourceInfo
+         (HashSet.lookupOrInsert
+          (set, hash, fn {hash = h, ...} => hash = h,
+           fn () => {hash = hash,
+                     name = name,
+                     sourceInfo = new (C name)}))
       end
 end
 
 fun function {name, region} =
    new (Function {name = name,
-		  pos = Pos.fromRegion region})
+                  pos = Pos.fromRegion region})
 
 fun toString' (si, sep) =
    case info si of
-      Anonymous p => Pos.toString p
+      Anonymous pos => Pos.toString pos
     | C s => concat ["<", s, ">"]
     | Function {name, pos} =>
-	 concat [concat (List.separate (List.rev name, ".")),
-		 sep, Pos.toString pos]
+         concat [concat (List.separate (List.rev name, ".")),
+                 sep, Pos.toString pos]
 
 fun toString si = toString' (si, " ")
    
@@ -107,16 +114,13 @@
 
 val equals =
    Trace.trace2 ("SourceInfo.equals", layout, layout, Bool.layout) equals
-   
-fun isBasis (s: t): bool =
+
+fun file (s: t): File.t option =
    case info s of
-      Anonymous p => Pos.isBasis p
-    | C _ => false
-    | Function {pos, ...} => Pos.isBasis pos
+      Anonymous pos => Pos.file pos
+    | C _ => NONE
+    | Function {pos, ...} => Pos.file pos
 
-val isBasis =
-   Trace.trace ("SourceInfo.isBasis", layout, Bool.layout) isBasis
-
 fun isC (s: t): bool =
    case info s of
       C _ => true

Modified: mlton/branches/on-20050420-cmm-branch/mlton/atoms/source-info.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/atoms/source-info.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/atoms/source-info.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,10 @@
+(* Copyright (C) 2003-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 type word = Word.t
    
 signature SOURCE_INFO_STRUCTS =
@@ -7,19 +14,19 @@
 signature SOURCE_INFO =
    sig
       include SOURCE_INFO_STRUCTS
-	 
+         
       type t
 
       val all: unit -> t list
       val anonymous: Region.t -> t
       val equals: t * t -> bool
+      val file: t -> File.t option
       val gc: t
       val gcArrayAllocate: t
       val hash: t -> word
       val fromC: string -> t
       val function: {name: string list,
-		     region: Region.t} -> t
-      val isBasis: t -> bool
+                     region: Region.t} -> t
       val isC: t -> bool
       val layout: t -> Layout.t
       val main: t

Modified: mlton/branches/on-20050420-cmm-branch/mlton/atoms/sources.cm
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/atoms/sources.cm	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/atoms/sources.cm	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 Group
 
 signature AST

Modified: mlton/branches/on-20050420-cmm-branch/mlton/atoms/sources.mlb
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/atoms/sources.mlb	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/atoms/sources.mlb	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,90 +1,84 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 local
-    ../../lib/mlton/sources.mlb
-    ../ast/sources.mlb
-    ../control/sources.mlb
+   ../../lib/mlton/sources.mlb
+   ../ast/sources.mlb
+   ../control/sources.mlb
 
-    id.sig
-    id.fun
-    (* Windows doesn't like files named con, so use con- instead. *)
-    con-.sig
-    con-.fun
-    real-x.sig
-    real-x.fun
-    word-x.sig
-    word-x.fun
-    word-x-vector.sig
-    word-x-vector.fun
-    c-type.sig
-    c-type.fun
-    label.sig
-    c-function.sig
-    c-function.fun
-    const-type.sig
-    const-type.fun
-    const.sig
-    const.fun
-    prim.sig
-    prim.fun
-    ffi.sig
-    ffi.fun
-    func.sig
-    generic-scheme.sig
-    generic-scheme.fun
-    profile-label.sig
-    profile-label.fun
-    source-info.sig
-    source-info.fun
-    profile-exp.sig
-    profile-exp.fun
-    tycon.sig
-    tycon.fun
-    type-ops.sig
-    type-ops.fun
-    use-name.fun
-    var.sig
-    var.fun
-    atoms.sig
-    atoms.fun
-    hash-type.sig
-    hash-type.fun
+   id.sig
+   id.fun
+   (* Windows doesn't like files named con, so use con- instead. *)
+   con-.sig
+   con-.fun
+   real-x.sig
+   real-x.fun
+   word-x.sig
+   word-x.fun
+   word-x-vector.sig
+   word-x-vector.fun
+   c-type.sig
+   c-type.fun
+   label.sig
+   c-function.sig
+   c-function.fun
+   const-type.sig
+   const-type.fun
+   const.sig
+   const.fun
+   prim.sig
+   prim.fun
+   ffi.sig
+   ffi.fun
+   func.sig
+   generic-scheme.sig
+   generic-scheme.fun
+   profile-label.sig
+   profile-label.fun
+   source-info.sig
+   source-info.fun
+   profile-exp.sig
+   profile-exp.fun
+   tycon.sig
+   tycon.fun
+   type-ops.sig
+   type-ops.fun
+   use-name.fun
+   var.sig
+   var.fun
+   atoms.sig
+   atoms.fun
+   hash-type.sig
+   hash-type.fun
 in
-    signature AST
-    signature ATOMS
-    signature ID
-    signature C_FUNCTION
-    signature C_TYPE
-    signature CON
-    signature CONST
-    signature CONST_TYPE
-    signature FFI
-    signature GENERIC_SCHEME
-    signature ID
-    signature HASH_TYPE
-    signature LABEL
-    signature PRIM
-    signature PROFILE_EXP
-    signature PROFILE_LABEL
-    signature REAL_X
-    signature RECORD
-    signature SOURCE_INFO
-    signature TYCON
-    signature TYPE_OPS
-    signature TYVAR
-    signature VAR
-    signature WORD_X
-    signature WORD_X_VECTOR
+   signature AST
+   signature ATOMS
+   signature ID
+   signature C_FUNCTION
+   signature C_TYPE
+   signature CONST
+   signature CONST_TYPE
+   signature FFI
+   signature ID
+   signature HASH_TYPE
+   signature LABEL
+   signature PRIM
+   signature PROFILE_LABEL
+   signature RECORD
+   signature TYCON
+   signature TYPE_OPS
+   signature WORD_X
+   signature WORD_X_VECTOR
 
-    functor Atoms
-    functor Id
-    functor GenericScheme
-    functor HashType
-    functor TypeOps
-    functor UseName
+   functor Atoms
+   functor Id
+   functor GenericScheme
+   functor HashType
+   functor TypeOps
+   functor UseName
 end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/atoms/tycon.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/atoms/tycon.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/atoms/tycon.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,9 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 functor Tycon (S: TYCON_STRUCTS): TYCON = 
@@ -18,12 +18,12 @@
 structure Kind = TyconKind ()
    
 structure P = PrimTycons (structure AdmitsEquality = AdmitsEquality
-			  structure CharSize = CharSize
-			  structure IntSize = IntSize
-			  structure Kind = Kind
-			  structure RealSize = RealSize
-			  structure WordSize = WordSize
-			  open Id)
+                          structure CharSize = CharSize
+                          structure IntSize = IntSize
+                          structure Kind = Kind
+                          structure RealSize = RealSize
+                          structure WordSize = WordSize
+                          open Id)
 open P
 
 val setPrintName =
@@ -36,10 +36,10 @@
    in
       align
       (List.map (prims, fn (c, _, _) =>
-		 seq [layout c, str " size is ",
-		      Int.layout (MLton.size c),
-		      str " plist length is ",
-		      Int.layout (PropertyList.length (plist c))]))
+                 seq [layout c, str " size is ",
+                      Int.layout (MLton.size c),
+                      str " plist length is ",
+                      Int.layout (PropertyList.length (plist c))]))
    end
 
 end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/atoms/tycon.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/atoms/tycon.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/atoms/tycon.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature TYCON_STRUCTS = 
    sig
       structure CharSize: CHAR_SIZE
@@ -16,7 +17,7 @@
 signature TYCON =
    sig
       include ID
-      include PRIM_TYCONS	 
+      include PRIM_TYCONS        
       sharing type t = tycon
 
       val stats: unit -> Layout.t

Modified: mlton/branches/on-20050420-cmm-branch/mlton/atoms/type-ops.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/atoms/type-ops.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/atoms/type-ops.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 functor TypeOps (S: TYPE_OPS_STRUCTS): TYPE_OPS =
 struct
 
@@ -54,13 +55,14 @@
    val arrow = binary Tycon.arrow
 end
 
-val arrow = Trace.trace ("arrow", Layout.tuple2 (layout, layout), layout) arrow
+val arrow = 
+   Trace.trace ("TypeOps.arrow", Layout.tuple2 (layout, layout), layout) arrow
 
 fun deUnaryOpt tycon t =
    case deConOpt t of
       SOME (c, ts) => if Tycon.equals (c, tycon)
-			 then SOME (Vector.sub (ts, 0))
-		      else NONE
+                         then SOME (Vector.sub (ts, 0))
+                      else NONE
     | _ => NONE
 
 val deArrayOpt = deUnaryOpt Tycon.array
@@ -70,7 +72,7 @@
 fun deUnary tycon t =
    case deUnaryOpt tycon t of
       SOME t => t
-    | NONE => Error.bug "deUnary"
+    | NONE => Error.bug "TypeOps.deUnary"
 
 val deArray = deUnary Tycon.array
 val deRef = deUnary Tycon.reff
@@ -94,7 +96,7 @@
 fun deTuple t =
    case deTupleOpt t of
       SOME t => t
-    | NONE => Error.bug "detuple"
+    | NONE => Error.bug "TypeOps.deTuple"
 
 fun nth (t, n) = Vector.sub (deTuple t, n)
 
@@ -103,39 +105,41 @@
 fun deTycon t =
    case deConOpt t of
       SOME (c, _) => c
-    | NONE => Error.bug "detycon"
+    | NONE => Error.bug "TypeOps.deTycon"
 
 fun deConConstOpt t =
    Option.map
    (deConOpt t, fn (c, ts) =>
     (c, Vector.map (ts, fn t =>
-		    case deConOpt t of
-		       SOME (c, _) => c
-		     | NONE => Error.bug "deConConstOpt")))
+                    case deConOpt t of
+                       SOME (c, _) => c
+                     | NONE => Error.bug "TypeOps.deConConstOpt")))
 
 fun deConConst t =
    case deConOpt t of
-      NONE => Error.bug "deConConst"
+      NONE => Error.bug "TypeOps.deConConst"
     | SOME (c, ts) => (c, Vector.map (ts, fn t =>
-				      case deConOpt t of
-					 NONE => Error.bug "deConConst"
-				       | SOME (c, _) => c))
+                                      case deConOpt t of
+                                         NONE => Error.bug "TypeOps.deConConst"
+                                       | SOME (c, _) => c))
 
 
 fun deArrowOpt t =
    case deConOpt t of
       SOME (c, ts) => if Tycon.equals (c, Tycon.arrow)
-			       then SOME (Vector.sub (ts, 0), Vector.sub (ts, 1))
-			    else NONE
+                               then SOME (Vector.sub (ts, 0), Vector.sub (ts, 1))
+                            else NONE
     | _ => NONE
 
 fun deArrow t =
    case deArrowOpt t of
       SOME x => x
-    | NONE => Error.bug "Type.deArrow"
+    | NONE => Error.bug "TypeOps.deArrow"
 
 val dearrow =
-   Trace.trace ("deArrow", layout, Layout.tuple2 (layout, layout)) deArrow
+   Trace.trace 
+   ("TypeOps.deArrow", layout, Layout.tuple2 (layout, layout)) 
+   deArrow
 
 val arg = #1 o dearrow
 val result = #2 o dearrow

Modified: mlton/branches/on-20050420-cmm-branch/mlton/atoms/type-ops.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/atoms/type-ops.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/atoms/type-ops.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,9 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 type int = Int.t

Modified: mlton/branches/on-20050420-cmm-branch/mlton/atoms/unary-tycon.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/atoms/unary-tycon.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/atoms/unary-tycon.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 functor UnaryTycon(S: UNARY_TYCON_STRUCTS): UNARY_TYCON = 
 struct
 
@@ -16,12 +17,12 @@
    fn Ref => Tycon.reff
     | Array => Tycon.array
     | Vector => Tycon.vector
-	 
+         
 val toString =
    fn Ref => "Ref"
     | Array => "Array"
     | Vector => "Vector"
-	 
+         
 val equals: t * t -> bool = op =
    
 val layout = Layout.str o toString

Modified: mlton/branches/on-20050420-cmm-branch/mlton/atoms/unary-tycon.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/atoms/unary-tycon.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/atoms/unary-tycon.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature UNARY_TYCON_STRUCTS = 
    sig
       structure Tycon: TYCON

Modified: mlton/branches/on-20050420-cmm-branch/mlton/atoms/use-name.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/atoms/use-name.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/atoms/use-name.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,14 +1,15 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 functor UseName(S: sig
-		       include T
-		       val sameName: t * t -> bool
-		    end): T =
+                       include T
+                       val sameName: t * t -> bool
+                    end): T =
    struct
       open S
       val equals = sameName

Modified: mlton/branches/on-20050420-cmm-branch/mlton/atoms/var.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/atoms/var.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/atoms/var.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 functor Var (S: VAR_STRUCTS): VAR = 
 struct
 

Modified: mlton/branches/on-20050420-cmm-branch/mlton/atoms/var.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/atoms/var.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/atoms/var.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature VAR_STRUCTS =
    sig
    end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/atoms/word-x-vector.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/atoms/word-x-vector.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/atoms/word-x-vector.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,8 +1,8 @@
-(* Copyright (C) 2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 2004-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 functor WordXVector (S: WORD_X_VECTOR_STRUCTS): WORD_X_VECTOR = 
@@ -11,7 +11,7 @@
 open S
 
 datatype t = T of {elementSize: WordSize.t,
-		   elements: WordX.t vector}
+                   elements: WordX.t vector}
 
 local
    fun make f (T r) = f r
@@ -27,20 +27,20 @@
       implode
       (rev
        (Vector.fold (elements, [], fn (w, ac) =>
-		     let
-			fun loop (i, w, ac) =
-			   if i = 0
-			      then ac
-			   else
-			      let
-				 val (q, r) = IntInf.quotRem (w, 0x100)
-			      in
-				 loop (i - 8, q,
-				       Char.fromInt (IntInf.toInt r) :: ac)
-			      end
-		     in
-			loop (n, WordX.toIntInf w, ac)
-		     end)))
+                     let
+                        fun loop (i, w, ac) =
+                           if i = 0
+                              then ac
+                           else
+                              let
+                                 val (q, r) = IntInf.quotRem (w, 0x100)
+                              in
+                                 loop (i - 8, q,
+                                       Char.fromInt (IntInf.toInt r) :: ac)
+                              end
+                     in
+                        loop (n, WordX.toIntInf w, ac)
+                     end)))
    end
    
 val layout = Layout.str o toString
@@ -52,8 +52,8 @@
 fun fromString s =
    T {elementSize = WordSize.byte,
       elements = Vector.tabulate (String.size s, fn i =>
-				  WordX.fromChar (String.sub (s, i)))}
-				  
+                                  WordX.fromChar (String.sub (s, i)))}
+                                  
 fun length v = Vector.length (elements v)
 
 fun sub (v, i) = Vector.sub (elements v, i)

Modified: mlton/branches/on-20050420-cmm-branch/mlton/atoms/word-x-vector.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/atoms/word-x-vector.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/atoms/word-x-vector.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,8 +1,8 @@
-(* Copyright (C) 2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 2004-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 signature WORD_X_VECTOR_STRUCTS = 

Modified: mlton/branches/on-20050420-cmm-branch/mlton/atoms/word-x.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/atoms/word-x.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/atoms/word-x.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,8 +1,8 @@
-(* Copyright (C) 2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 2004-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 functor WordX (S: WORD_X_STRUCTS): WORD_X = 
@@ -18,12 +18,12 @@
 
 local
    datatype t = T of {size: WordSize.t,
-		      value: IntInf.t}
+                      value: IntInf.t}
 in
    type t = t
    fun make (i: IntInf.t, s: WordSize.t) =
       T {size = s,
-	 value = i mod modulus s}
+         value = i mod modulus s}
    fun dest (T r) = r
 end
 
@@ -42,7 +42,7 @@
       val m = modulus (size w)
    in
       if v >= m div 2
-	 then v - m
+         then v - m
       else v
    end
 
@@ -58,12 +58,12 @@
    val make: (IntInf.t * Word.t -> IntInf.t) -> t * t -> t =
       fn f => fn (w, w') =>
       let
-	 val s = size w
-	 val v' = value w'
+         val s = size w
+         val v' = value w'
       in
-	 if v' >= Bits.toIntInf (WordSize.bits s)
-	    then zero s
-	 else make (f (value w, Word.fromIntInf v'), s)
+         if v' >= Bits.toIntInf (WordSize.bits s)
+            then zero s
+         else make (f (value w, Word.fromIntInf v'), s)
       end
 in
    val lshift = make IntInf.<<
@@ -121,8 +121,8 @@
       val s = size w
       val b = WordSize.bits s
       val shift = if shift > Bits.toIntInf b
-		     then Bits.toWord b
-		  else Word.fromIntInf shift
+                     then Bits.toWord b
+                  else Word.fromIntInf shift
    in
       make (IntInf.~>> (toIntInfX w, shift), s)
    end
@@ -157,8 +157,8 @@
 
 fun splice {hi, lo} =
    fromIntInf (value lo
-	       + IntInf.<< (value hi, Bits.toWord (WordSize.bits (size lo))),
-	       WordSize.+ (size hi, size lo))
+               + IntInf.<< (value hi, Bits.toWord (WordSize.bits (size lo))),
+               WordSize.+ (size hi, size lo))
    
 fun split (w, {lo}) =
    let
@@ -173,44 +173,44 @@
    1 = IntInf.rem (IntInf.~>> (value w, Word.fromInt i), 2)
 
 local
-   val make: (IntInf.t * IntInf.t -> IntInf.t) -> t * t -> t =
-      fn f => fn (w, w') =>
+   val make: ((IntInf.t * IntInf.t -> IntInf.t) * string) -> t * t -> t =
+      fn (f,name) => fn (w, w') =>
       if WordSize.equals (size w, size w')
-	 then make (f (value w, value w'), size w)
-      else raise Fail "WordX binary"
+         then make (f (value w, value w'), size w)
+      else Error.bug (concat ["WordX.", name])
 in
-   val add = make IntInf.+
-   val sub = make IntInf.-
-   val andb = make IntInf.andb
-   val orb = make IntInf.orb
-   val xorb = make IntInf.xorb
+   val add = make (IntInf.+, "add")
+   val sub = make (IntInf.-, "sub")
+   val andb = make (IntInf.andb, "andb")
+   val orb = make (IntInf.orb, "orb")
+   val xorb = make (IntInf.xorb, "xorb")
 end
 
 fun neg w = make (~ (toIntInfX w), size w)
 
 local
-   val make: (IntInf.t * IntInf.t -> IntInf.t) -> t * t * {signed: bool}-> t =
-      fn f => fn (w, w', s) =>
+   val make: ((IntInf.t * IntInf.t -> IntInf.t) * string) -> t * t * {signed: bool}-> t =
+      fn (f,name) => fn (w, w', s) =>
       if WordSize.equals (size w, size w')
-	 then make (f (toIntInfSg (w, s), toIntInfSg (w', s)), size w)
-      else raise Fail "WordX binary"
+         then make (f (toIntInfSg (w, s), toIntInfSg (w', s)), size w)
+      else Error.bug (concat ["WordX.", name])
 in
-   val mul = make IntInf.*
-   val quot = make IntInf.quot
-   val rem = make IntInf.rem
+   val mul = make (IntInf.*, "mul")
+   val quot = make (IntInf.quot, "quot")
+   val rem = make (IntInf.rem, "rem")
 end
 
 local
-   val make: (IntInf.t * IntInf.t -> 'a) -> t * t * {signed: bool} -> 'a =
-      fn f => fn (w, w', sg) =>
+   val make: ((IntInf.t * IntInf.t -> 'a) * string) -> t * t * {signed: bool} -> 'a =
+      fn (f,name) => fn (w, w', sg) =>
       if WordSize.equals (size w, size w')
-	 then f (toIntInfSg (w, sg), toIntInfSg (w', sg))
-      else Error.bug "WordX compare"
+         then f (toIntInfSg (w, sg), toIntInfSg (w', sg))
+      else Error.bug (concat ["WordX.", name])
 in
-   val lt = make IntInf.<
-   val le = make IntInf.<=
-   val gt = make IntInf.>
-   val ge = make IntInf.>=
+   val lt = make (IntInf.<, "lt")
+   val le = make (IntInf.<=, "le")
+   val gt = make (IntInf.>, "gt")
+   val ge = make (IntInf.>=, "ge")
 end
 
 fun layoutSg {signed} = Layout.record [("signed", Bool.layout signed)]

Modified: mlton/branches/on-20050420-cmm-branch/mlton/atoms/word-x.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/atoms/word-x.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/atoms/word-x.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,8 +1,8 @@
-(* Copyright (C) 2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 2004-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 type int = Int.t
@@ -15,7 +15,7 @@
 signature WORD_X = 
    sig
       include WORD_X_STRUCTS
-	 
+         
       (* Words of all WordSize.t sizes. *)
       type t
 

Modified: mlton/branches/on-20050420-cmm-branch/mlton/backend/allocate-registers.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/backend/allocate-registers.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/backend/allocate-registers.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 functor AllocateRegisters (S: ALLOCATE_REGISTERS_STRUCTS): ALLOCATE_REGISTERS = 
 struct
 
@@ -59,213 +60,218 @@
    struct
        structure Stack =
        struct
-	  (* Keep a list of allocated slots sorted in increasing order of offset.
-	   *)
-	  datatype t = T of {offset: Bytes.t, size: Bytes.t} list
+          (* Keep a list of allocated slots sorted in increasing order of offset.
+           *)
+          datatype t = T of {offset: Bytes.t, size: Bytes.t} list
 
-	  fun layout (T alloc) =
-	     List.layout (fn {offset, size} =>
-			  Layout.record [("offset", Bytes.layout offset),
-					 ("size", Bytes.layout size)])
-	                 alloc
-	 
-	  fun size (T alloc) =
-	     case alloc of
-	        [] => Bytes.zero
-	      | _ => let
-		        val {offset, size} = List.last alloc
-		     in
-		        Bytes.+ (offset, size)
-		     end
+          fun layout (T alloc) =
+             List.layout (fn {offset, size} =>
+                          Layout.record [("offset", Bytes.layout offset),
+                                         ("size", Bytes.layout size)])
+                         alloc
+         
+          fun size (T alloc) =
+             case alloc of
+                [] => Bytes.zero
+              | _ => let
+                        val {offset, size} = List.last alloc
+                     in
+                        Bytes.+ (offset, size)
+                     end
 
-	  fun new (alloc): t =
-	     T (Array.toList
-		(QuickSort.sortArray
-		 (Array.fromListMap (alloc, fn StackOffset.T {offset, ty} =>
-				     {offset = offset,
-				      size = Type.bytes ty}),
-		  fn (r, r') => Bytes.<= (#offset r, #offset r'))))
+          fun new (alloc): t =
+             let
+                val a =
+                   Array.fromListMap (alloc, fn StackOffset.T {offset, ty} =>
+                                      {offset = offset,
+                                       size = Type.bytes ty})
+                val () =
+                   QuickSort.sortArray
+                   (a, fn (r, r') => Bytes.<= (#offset r, #offset r'))
 
-	  fun get (T alloc, ty) =
-	     let
-	        val slotSize = Type.bytes ty
-	     in
-	        case alloc of
-		   [] => (T [{offset = Bytes.zero, size = slotSize}],
-			  {offset = Bytes.zero})
-		 | a :: alloc =>
-		      let
-			 fun loop (alloc, a as {offset, size}, ac) =
-			    let
-			       val prevEnd = Bytes.+ (offset, size)
-			       val begin = Type.align (ty, prevEnd)
-			       fun coalesce () =
-				  if Bytes.equals (prevEnd, begin)
-				     then ({offset = offset,
-					    size = Bytes.+ (size, slotSize)},
-					   ac)
-				  else ({offset = begin, size = slotSize},
-					{offset = offset, size = size} :: ac)
-			    in
-			      case alloc of
-				 [] =>
-				    let
-				       val (a, ac) = coalesce ()
-				    in
-				       (T (rev (a :: ac)), {offset = begin})
-				    end
-			        | (a' as {offset, size}) :: alloc =>
-				    if Bytes.> (Bytes.+ (begin, slotSize),
-						offset)
-				       then loop (alloc, a', a :: ac)
-				    else
-				       let
-					  val (a'' as {offset = o', size = s'}, ac) = 
-					     coalesce ()
-					  val alloc =
-					     List.appendRev
-					     (ac,
-					      if Bytes.equals (Bytes.+ (o', s'),
-							       offset)
-						 then {offset = o',
-						       size = Bytes.+ (size, s')}
-						      :: alloc
-					      else a'' :: a' :: alloc)
-				       in
-					  (T alloc, {offset = begin})
-				       end
-			    end
-		      in
-			 loop (alloc, a, [])
-		      end
-	     end
+             in
+                T (Array.toList a)
+             end
 
+          fun get (T alloc, ty) =
+             let
+                val slotSize = Type.bytes ty
+             in
+                case alloc of
+                   [] => (T [{offset = Bytes.zero, size = slotSize}],
+                          {offset = Bytes.zero})
+                 | a :: alloc =>
+                      let
+                         fun loop (alloc, a as {offset, size}, ac) =
+                            let
+                               val prevEnd = Bytes.+ (offset, size)
+                               val begin = Type.align (ty, prevEnd)
+                               fun coalesce () =
+                                  if Bytes.equals (prevEnd, begin)
+                                     then ({offset = offset,
+                                            size = Bytes.+ (size, slotSize)},
+                                           ac)
+                                  else ({offset = begin, size = slotSize},
+                                        {offset = offset, size = size} :: ac)
+                            in
+                              case alloc of
+                                 [] =>
+                                    let
+                                       val (a, ac) = coalesce ()
+                                    in
+                                       (T (rev (a :: ac)), {offset = begin})
+                                    end
+                                | (a' as {offset, size}) :: alloc =>
+                                    if Bytes.> (Bytes.+ (begin, slotSize),
+                                                offset)
+                                       then loop (alloc, a', a :: ac)
+                                    else
+                                       let
+                                          val (a'' as {offset = o', size = s'}, ac) = 
+                                             coalesce ()
+                                          val alloc =
+                                             List.appendRev
+                                             (ac,
+                                              if Bytes.equals (Bytes.+ (o', s'),
+                                                               offset)
+                                                 then {offset = o',
+                                                       size = Bytes.+ (size, s')}
+                                                      :: alloc
+                                              else a'' :: a' :: alloc)
+                                       in
+                                          (T alloc, {offset = begin})
+                                       end
+                            end
+                      in
+                         loop (alloc, a, [])
+                      end
+             end
+
        end
        structure Registers =
        struct
-	  (* A register allocation keeps track of the registers that have
-	   * already been allocated, for each runtime type.  The reason that
-	   * we associate them with runtime types rather than Rssa types is
-	   * that the register indices that the codegens use are based on
-	   * runtime types.
-	   *)
-	  datatype t = T of CType.t -> {alloc: Register.t list,
-					next: int} ref
+          (* A register allocation keeps track of the registers that have
+           * already been allocated, for each runtime type.  The reason that
+           * we associate them with runtime types rather than Rssa types is
+           * that the register indices that the codegens use are based on
+           * runtime types.
+           *)
+          datatype t = T of CType.t -> {alloc: Register.t list,
+                                        next: int} ref
 
-	  fun layout (T f) =
-	     List.layout
-	     (fn t =>
-	      let
-		 val {alloc, next} = ! (f t)
-	      in
-		 Layout.record [("ty", CType.layout t),
-				("next", Int.layout next),
-				("alloc", List.layout Register.layout alloc)]
-	      end)
-	     CType.all
+          fun layout (T f) =
+             List.layout
+             (fn t =>
+              let
+                 val {alloc, next} = ! (f t)
+              in
+                 Layout.record [("ty", CType.layout t),
+                                ("next", Int.layout next),
+                                ("alloc", List.layout Register.layout alloc)]
+              end)
+             CType.all
 
-	  fun compress {next, alloc} =
-	     let
-		fun loop (next, alloc) =
-		   let
-		      fun done () = {alloc = alloc,
-				     next = next}
-		   in
-		      case alloc of
-			 [] => done ()
-		       | r :: alloc =>
-			    if next = Register.index r
-			       then loop (next + 1, alloc)
-			    else done ()
-		   end
-	     in
-		loop (next, alloc)
-	     end
-	     
-	  fun new (rs: Register.t list): t =
-	     let
-		fun sameType (r, r') =
-		   CType.equals
-		   (Type.toCType (Register.ty r),
-		    Type.toCType (Register.ty r'))
-	        val rss = List.equivalence (rs, sameType)
-	     in
-		T (CType.memo
-		   (fn t =>
-		    case List.peek (rss, fn rs =>
-				    case rs of
-				       [] => false
-				     | r :: _ => 
-					  CType.equals
-					  (t, Type.toCType (Register.ty r))) of
-		       NONE => ref {alloc = [], next = 0}
-		     | SOME rs =>
-			  ref
-			  (compress
-			   {next = 0,
-			    alloc =
-			    Array.toList
-			    (QuickSort.sortArray
-			     (Array.fromList rs, fn (r, r') =>
-			      Register.index r <= Register.index r'))})))
-	     end
+          fun compress {next, alloc} =
+             let
+                fun loop (next, alloc) =
+                   let
+                      fun done () = {alloc = alloc,
+                                     next = next}
+                   in
+                      case alloc of
+                         [] => done ()
+                       | r :: alloc =>
+                            if next = Register.index r
+                               then loop (next + 1, alloc)
+                            else done ()
+                   end
+             in
+                loop (next, alloc)
+             end
+             
+          fun new (rs: Register.t list): t =
+             let
+                fun sameType (r, r') =
+                   CType.equals
+                   (Type.toCType (Register.ty r),
+                    Type.toCType (Register.ty r'))
+                val rss = List.equivalence (rs, sameType)
+             in
+                T (CType.memo
+                   (fn t =>
+                    case List.peek (rss, fn rs =>
+                                    case rs of
+                                       [] => false
+                                     | r :: _ => 
+                                          CType.equals
+                                          (t, Type.toCType (Register.ty r))) of
+                       NONE => ref {alloc = [], next = 0}
+                     | SOME rs =>
+                          ref
+                          (compress
+                           {next = 0,
+                            alloc =
+                            QuickSort.sortList
+                            (rs, fn (r, r') =>
+                             Register.index r <= Register.index r')})))
+             end
 
-	  fun get (T f, ty: Type.t) =
-	     let
-		val t = Type.toCType ty
-		val r = f t
-		val {alloc, next} = !r
-		val reg = Register.new (ty, SOME next)
-		val _ =
-		   r := compress {alloc = alloc,
-				  next = next + 1}
-	     in
-		reg
-	     end
+          fun get (T f, ty: Type.t) =
+             let
+                val t = Type.toCType ty
+                val r = f t
+                val {alloc, next} = !r
+                val reg = Register.new (ty, SOME next)
+                val _ =
+                   r := compress {alloc = alloc,
+                                  next = next + 1}
+             in
+                reg
+             end
        end
     
        datatype t = T of {registers: Registers.t,
-			  stack: Stack.t ref}
+                          stack: Stack.t ref}
 
        local
-	  fun make s (T x) = s x
+          fun make s (T x) = s x
        in
-	  val stack = ! o (make #stack)
-	  val stackSize = Stack.size o stack
+          val stack = ! o (make #stack)
+          val stackSize = Stack.size o stack
        end
     
        fun layout (T {registers, stack}) =
-	  Layout.record
-	  [("stack", Stack.layout (!stack)),
-	   ("registers", Registers.layout registers)]
+          Layout.record
+          [("stack", Stack.layout (!stack)),
+           ("registers", Registers.layout registers)]
 
        fun getStack (T {stack, ...}, ty) =
-	  let
-	     val (s, offset) = Stack.get (!stack, ty)
-	     val _ = stack := s
-	  in
-	     offset
-	  end
+          let
+             val (s, offset) = Stack.get (!stack, ty)
+             val _ = stack := s
+          in
+             offset
+          end
        
        fun getRegister (T {registers, ...}, ty) =
-	  Registers.get (registers, ty)
+          Registers.get (registers, ty)
 
        fun new (stack, registers) = 
-	  T {registers = Registers.new registers,
-	     stack = ref (Stack.new stack)}
+          T {registers = Registers.new registers,
+             stack = ref (Stack.new stack)}
    end
 
 structure Info =
    struct
       type t = {live: Operand.t vector,
-		liveNoFormals: Operand.t vector,
-		size: Bytes.t}
+                liveNoFormals: Operand.t vector,
+                size: Bytes.t}
 
       fun layout ({live, liveNoFormals, size, ...}: t) =
-	 Layout.record
-	 [("live", Vector.layout Operand.layout live),
-	  ("liveNoFormals", Vector.layout Operand.layout liveNoFormals),
-	  ("size", Bytes.layout size)]
+         Layout.record
+         [("live", Vector.layout Operand.layout live),
+          ("liveNoFormals", Vector.layout Operand.layout liveNoFormals),
+          ("size", Bytes.layout size)]
    end
 
 (* ------------------------------------------------- *)
@@ -273,34 +279,34 @@
 (* ------------------------------------------------- *)
 
 fun allocate {argOperands,
-	      function = f: Rssa.Function.t,
-	      varInfo: Var.t -> {operand: Machine.Operand.t option ref option,
-				 ty: Type.t}} =
+              function = f: Rssa.Function.t,
+              varInfo: Var.t -> {operand: Machine.Operand.t option ref option,
+                                 ty: Type.t}} =
    let
       fun diagnostics f =
-	 Control.diagnostics
-	 (fn display =>
-	  let
-	     open Layout
-	     fun diagVar (x: Var.t): unit =
-		display (seq
-			 [Var.layout x, str " ",
-			  Option.layout
-			  (fn r => Option.layout Operand.layout (!r))
-			  (#operand (varInfo x))])
-	     fun diagStatement (s: R.Statement.t): unit =
-		R.Statement.foreachDef (s, diagVar o #1)
-	  in
-	     f (display, diagVar, diagStatement)
-	  end)
+         Control.diagnostics
+         (fn display =>
+          let
+             open Layout
+             fun diagVar (x: Var.t): unit =
+                display (seq
+                         [Var.layout x, str " ",
+                          Option.layout
+                          (fn r => Option.layout Operand.layout (!r))
+                          (#operand (varInfo x))])
+             fun diagStatement (s: R.Statement.t): unit =
+                R.Statement.foreachDef (s, diagVar o #1)
+          in
+             f (display, diagVar, diagStatement)
+          end)
       val _ =
-	 Control.diagnostic (fn () =>
-			     let open Layout
-			     in seq [str "Function allocs for ",
-				     Func.layout (Function.name f)]
-			     end)
+         Control.diagnostic (fn () =>
+                             let open Layout
+                             in seq [str "Function allocs for ",
+                                     Func.layout (Function.name f)]
+                             end)
       val {labelLive, remLabelLive} =
-	 Live.live (f, {shouldConsider = isSome o #operand o varInfo})
+         Live.live (f, {shouldConsider = isSome o #operand o varInfo})
       val {args, blocks, name, ...} = Function.dest f
       (*
        * Decide which variables will live in stack slots and which
@@ -314,235 +320,237 @@
        *)
       datatype place = Stack | Register
       val {get = place: Var.t -> place ref, rem = removePlace, ...} =
-	 Property.get (Var.plist, Property.initFun (fn _ => ref Register))
+         Property.get (Var.plist, Property.initFun (fn _ => ref Register))
       (* !hasHandler = true iff handlers are installed in this function. *)
       val hasHandler: bool ref = ref false
       fun forceStack (x: Var.t): unit = place x := Stack
       val _ = Vector.foreach (args, forceStack o #1)
       val _ =
-	 Vector.foreach
-	 (blocks,
-	  fn R.Block.T {args, kind, label, statements, ...} =>
-	  let
-	     val {beginNoFormals, ...} = labelLive label
-	     val _ =
-		case Kind.frameStyle kind of
-		   Kind.None => ()
-		 | Kind.OffsetsAndSize =>
-		      Vector.foreach (beginNoFormals, forceStack)
-		 | Kind.SizeOnly => ()
-	     val _ =
-		case kind of
-		   Kind.Cont _ => Vector.foreach (args, forceStack o #1)
-		 | _ => ()
-	     val _ =
-		if not (!hasHandler)
-		   andalso (Vector.exists
-			    (statements, fn s =>
-			     let
-				datatype z = datatype R.Statement.t
-			     in
-				case s of
-				   SetHandler _ => true
-				 | SetExnStackLocal => true
-				 | SetExnStackSlot => true
-				 | SetSlotExnStack => true
-				 | _ => false
-			     end))
-		   then hasHandler := true
-		else ()
-	  in
-	     ()
-	  end)
+         Vector.foreach
+         (blocks,
+          fn R.Block.T {args, kind, label, statements, ...} =>
+          let
+             val {beginNoFormals, ...} = labelLive label
+             val _ =
+                case Kind.frameStyle kind of
+                   Kind.None => ()
+                 | Kind.OffsetsAndSize =>
+                      Vector.foreach (beginNoFormals, forceStack)
+                 | Kind.SizeOnly => ()
+             val _ =
+                case kind of
+                   Kind.Cont _ => Vector.foreach (args, forceStack o #1)
+                 | _ => ()
+             val _ =
+                if not (!hasHandler)
+                   andalso (Vector.exists
+                            (statements, fn s =>
+                             let
+                                datatype z = datatype R.Statement.t
+                             in
+                                case s of
+                                   SetHandler _ => true
+                                 | SetExnStackLocal => true
+                                 | SetExnStackSlot => true
+                                 | SetSlotExnStack => true
+                                 | _ => false
+                             end))
+                   then hasHandler := true
+                else ()
+          in
+             ()
+          end)
       fun allocateVar (x: Var.t, a: Allocation.t): unit = 
-	 let
-	    val {operand, ty} = varInfo x
-	 in
-	    if isSome operand
-	       then let
-		       val oper =
-			  case ! (place x) of
-			     Stack =>
-				let
-				   val {offset} = Allocation.getStack (a, ty)
-				in
-				   Operand.StackOffset
-				   (StackOffset.T {offset = offset, ty = ty})
-				end
-			   | Register =>
-				Operand.Register
-				(Allocation.getRegister (a, ty))
-		       val () = removePlace x
-		       val _ = 
-			  case operand of
-			     NONE => ()
-			   | SOME r => r := SOME oper
-		    in
-		       ()
-		    end
-	    else ()
-	 end
+         let
+            val {operand, ty} = varInfo x
+         in
+            if isSome operand
+               then let
+                       val oper =
+                          case ! (place x) of
+                             Stack =>
+                                let
+                                   val {offset} = Allocation.getStack (a, ty)
+                                in
+                                   Operand.StackOffset
+                                   (StackOffset.T {offset = offset, ty = ty})
+                                end
+                           | Register =>
+                                Operand.Register
+                                (Allocation.getRegister (a, ty))
+                       val () = removePlace x
+                       val _ = 
+                          case operand of
+                             NONE => ()
+                           | SOME r => r := SOME oper
+                    in
+                       ()
+                    end
+            else ()
+         end
       val allocateVar =
-	 Trace.trace2
-	 ("Allocate.allocateVar", Var.layout, Allocation.layout, Unit.layout)
-	 allocateVar
+         Trace.trace2
+         ("AllocateRegisters.allocateVar", Var.layout, Allocation.layout, Unit.layout)
+         allocateVar
       (* Create the initial stack and set the stack slots for the formals. *)
       val stack =
-	 Allocation.Stack.new
-	 (Vector.foldr2
-	  (args, argOperands, [],
-	   fn ((x, t), z, ac) =>
-	   case z of
-	      Operand.StackOffset (StackOffset.T {offset, ...}) =>
-		 (valOf (#operand (varInfo x)) := SOME z
-		  ; StackOffset.T {offset = offset, ty = t} :: ac)
-	    | _ => Error.bug "strange argOperand"))
+         Allocation.Stack.new
+         (Vector.foldr2
+          (args, argOperands, [],
+           fn ((x, t), z, ac) =>
+           case z of
+              Operand.StackOffset (StackOffset.T {offset, ...}) =>
+                 (valOf (#operand (varInfo x)) := SOME z
+                  ; StackOffset.T {offset = offset, ty = t} :: ac)
+            | _ => Error.bug "AllocateRegisters.allocate: strange argOperand"))
       (* Allocate slots for the link and handler, if necessary. *)
       val handlerLinkOffset =
-	 if !hasHandler
-	    then
-	       let
-		  val (stack, {offset = handler, ...}) =
-		     Allocation.Stack.get (stack, Type.defaultWord)
-		  val (_, {offset = link, ...}) = 
-		     Allocation.Stack.get (stack, Type.exnStack)
-	       in
-		  SOME {handler = handler, link = link}
-	       end
-	 else NONE
+         if !hasHandler
+            then
+               let
+                  val (stack, {offset = handler, ...}) =
+                     Allocation.Stack.get (stack, Type.defaultWord)
+                  val (_, {offset = link, ...}) = 
+                     Allocation.Stack.get (stack, Type.exnStack)
+               in
+                  SOME {handler = handler, link = link}
+               end
+         else NONE
       fun getOperands (xs: Var.t vector): Operand.t vector =
-	 Vector.map (xs, fn x => valOf (! (valOf (#operand (varInfo x)))))
+         Vector.map (xs, fn x => valOf (! (valOf (#operand (varInfo x)))))
       val getOperands =
-	 Trace.trace ("Allocate.getOperands",
-		      Vector.layout Var.layout,
-		      Vector.layout Operand.layout)
-	 getOperands
+         Trace.trace 
+         ("AllocateRegisters.getOperands",
+          Vector.layout Var.layout, Vector.layout Operand.layout)
+         getOperands
       val {get = labelInfo: R.Label.t -> Info.t, set = setLabelInfo, ...} =
-	 Property.getSetOnce (R.Label.plist,
-			      Property.initRaise ("labelInfo", R.Label.layout))
+         Property.getSetOnce (R.Label.plist,
+                              Property.initRaise ("labelInfo", R.Label.layout))
       val setLabelInfo =
-	 Trace.trace2
-	 ("Allocate.setLabelInfo", R.Label.layout, Info.layout, Unit.layout)
-	 setLabelInfo
+         Trace.trace2
+         ("AllocateRegisters.setLabelInfo", 
+          R.Label.layout, Info.layout, Unit.layout)
+         setLabelInfo
       (* Do a DFS of the control-flow graph. *)
       val () =
-	 Function.dfs
-	 (f, fn R.Block.T {args, label, kind, statements, transfer, ...} =>
-	  let
-	     val {begin, beginNoFormals, handler = handlerLive,
-		  link = linkLive} = labelLive label
-	     val () = remLabelLive label
-	     fun addHS (ops: Operand.t vector): Operand.t vector =
-		case handlerLinkOffset of
-		   NONE => ops
-		 | SOME {handler, link} =>
-		      let
-			 val extra = []
-			 val extra =
-			    case handlerLive of
-			       NONE => extra
-			     | SOME h => 
-				  Operand.stackOffset {offset = handler,
-						       ty = Type.label h}
-				  :: extra
-			 val extra =
-			    if linkLive
-			       then
-				  Operand.stackOffset {offset = link,
-						       ty = Type.exnStack}
-				  :: extra
-			    else extra
-		      in
-			 Vector.concat [Vector.fromList extra, ops]
-		      end
-	     val liveNoFormals = getOperands beginNoFormals
-	     val (stackInit, registersInit) =
-	        Vector.fold
-		(liveNoFormals, ([],[]), fn (oper, (stack, registers)) =>
-		 case oper of
-		    Operand.StackOffset s => (s::stack, registers)
-		  | Operand.Register r => (stack, r::registers)
-		  | _ => (stack, registers))
-	     val stackInit =
-		case handlerLinkOffset of
-		   NONE => stackInit
-		 | SOME {handler, link} =>
-		      StackOffset.T {offset = handler, ty = Type.defaultWord} (* should be label *)
-		      :: StackOffset.T {offset = link, ty = Type.exnStack}
-		      :: stackInit
-	     val a = Allocation.new (stackInit, registersInit)
-	     val size =
-		case kind of
-		   Kind.Handler =>
-		      (case handlerLinkOffset of
-			  NONE => Error.bug "Handler with no handler offset"
-			| SOME {handler, ...} =>
-			     Bytes.+ (Runtime.labelSize, handler))
-		 | _ =>
-		      let
-			 val size =
-			    Bytes.+
-			    (Runtime.labelSize,
-			     Bytes.wordAlign (Allocation.stackSize a))
-		      in
-			 case !Control.align of
-			    Control.Align4 => size
-			  | Control.Align8 =>
-			       Bytes.align (size, {alignment = Bytes.fromInt 8})
-		      end
-	     val _ =
-		if Bytes.isWordAligned size
-		   then ()
-		else Error.bug (concat ["bad size ",
-					Bytes.toString size,
-					" in ", Label.toString label])
-	     val _ = Vector.foreach (args, fn (x, _) => allocateVar (x, a))
-	     (* Must compute live after allocateVar'ing the args, since that
-	      * sets the operands for the args.
-	      *)
-	     val live = getOperands begin
-	     fun one (var, _) = allocateVar (var, a)
-	     val _ =
-		Vector.foreach (statements, fn statement =>
-				R.Statement.foreachDef (statement, one))
-	     val _ = R.Transfer.foreachDef (transfer, one)
-	     val _ =
-		setLabelInfo (label, {live = addHS live,
-				      liveNoFormals = addHS liveNoFormals,
-				      size = size})
-	  in
-	     fn () => ()
-	  end)
+         Function.dfs
+         (f, fn R.Block.T {args, label, kind, statements, transfer, ...} =>
+          let
+             val {begin, beginNoFormals, handler = handlerLive,
+                  link = linkLive} = labelLive label
+             val () = remLabelLive label
+             fun addHS (ops: Operand.t vector): Operand.t vector =
+                case handlerLinkOffset of
+                   NONE => ops
+                 | SOME {handler, link} =>
+                      let
+                         val extra = []
+                         val extra =
+                            case handlerLive of
+                               NONE => extra
+                             | SOME h => 
+                                  Operand.stackOffset {offset = handler,
+                                                       ty = Type.label h}
+                                  :: extra
+                         val extra =
+                            if linkLive
+                               then
+                                  Operand.stackOffset {offset = link,
+                                                       ty = Type.exnStack}
+                                  :: extra
+                            else extra
+                      in
+                         Vector.concat [Vector.fromList extra, ops]
+                      end
+             val liveNoFormals = getOperands beginNoFormals
+             val (stackInit, registersInit) =
+                Vector.fold
+                (liveNoFormals, ([],[]), fn (oper, (stack, registers)) =>
+                 case oper of
+                    Operand.StackOffset s => (s::stack, registers)
+                  | Operand.Register r => (stack, r::registers)
+                  | _ => (stack, registers))
+             val stackInit =
+                case handlerLinkOffset of
+                   NONE => stackInit
+                 | SOME {handler, link} =>
+                      StackOffset.T {offset = handler, ty = Type.defaultWord} (* should be label *)
+                      :: StackOffset.T {offset = link, ty = Type.exnStack}
+                      :: stackInit
+             val a = Allocation.new (stackInit, registersInit)
+             val size =
+                case kind of
+                   Kind.Handler =>
+                      (case handlerLinkOffset of
+                          NONE => Error.bug "AllocateRegisters.allocate: Handler with no handler offset"
+                        | SOME {handler, ...} =>
+                             Bytes.+ (Runtime.labelSize, handler))
+                 | _ =>
+                      let
+                         val size =
+                            Bytes.+
+                            (Runtime.labelSize,
+                             Bytes.wordAlign (Allocation.stackSize a))
+                      in
+                         case !Control.align of
+                            Control.Align4 => size
+                          | Control.Align8 =>
+                               Bytes.align (size, {alignment = Bytes.fromInt 8})
+                      end
+             val _ =
+                if Bytes.isWordAligned size
+                   then ()
+                else Error.bug (concat ["AllocateRegisters.allocate: ",
+                                        "bad size ",
+                                        Bytes.toString size,
+                                        " in ", Label.toString label])
+             val _ = Vector.foreach (args, fn (x, _) => allocateVar (x, a))
+             (* Must compute live after allocateVar'ing the args, since that
+              * sets the operands for the args.
+              *)
+             val live = getOperands begin
+             fun one (var, _) = allocateVar (var, a)
+             val _ =
+                Vector.foreach (statements, fn statement =>
+                                R.Statement.foreachDef (statement, one))
+             val _ = R.Transfer.foreachDef (transfer, one)
+             val _ =
+                setLabelInfo (label, {live = addHS live,
+                                      liveNoFormals = addHS liveNoFormals,
+                                      size = size})
+          in
+             fn () => ()
+          end)
       val () =
-	 diagnostics
-	 (fn (display, diagVar, diagStatement) =>
-	  let
-	     open Layout
-	     val _ =
-		display (seq [str "function ", Func.layout name,
-			      str " handlerLinkOffset ",
-			      Option.layout
-			      (fn {handler, link} =>
-			       record [("handler", Bytes.layout handler),
-				       ("link", Bytes.layout link)])
-			      handlerLinkOffset])
-	     val _ = Vector.foreach (args, diagVar o #1)
-	     val _ =
-		Vector.foreach
-		(blocks, fn R.Block.T {label, args, statements, ...} =>
-		 let
-		    val {live, ...} = labelInfo label
-		    val () = display (R.Label.layout label)
-		    val () =
-		       display
-		       (seq [str "live: ", Vector.layout Operand.layout live])
-		    val () = Vector.foreach (args, diagVar o #1)
-		    val () = Vector.foreach (statements, diagStatement)
-		 in
-		    ()
-		 end)
-	  in ()
-	  end)
+         diagnostics
+         (fn (display, diagVar, diagStatement) =>
+          let
+             open Layout
+             val _ =
+                display (seq [str "function ", Func.layout name,
+                              str " handlerLinkOffset ",
+                              Option.layout
+                              (fn {handler, link} =>
+                               record [("handler", Bytes.layout handler),
+                                       ("link", Bytes.layout link)])
+                              handlerLinkOffset])
+             val _ = Vector.foreach (args, diagVar o #1)
+             val _ =
+                Vector.foreach
+                (blocks, fn R.Block.T {label, args, statements, ...} =>
+                 let
+                    val {live, ...} = labelInfo label
+                    val () = display (R.Label.layout label)
+                    val () =
+                       display
+                       (seq [str "live: ", Vector.layout Operand.layout live])
+                    val () = Vector.foreach (args, diagVar o #1)
+                    val () = Vector.foreach (statements, diagStatement)
+                 in
+                    ()
+                 end)
+          in ()
+          end)
    in
       {handlerLinkOffset = handlerLinkOffset,
        labelInfo = labelInfo}
@@ -550,7 +558,7 @@
 
 val allocate = 
    Trace.trace
-   ("Allocate.allocate",
+   ("AllocateRegisters.allocate",
     fn {function, ...} => Func.layout (Function.name function),
     Layout.ignore)
    allocate

Modified: mlton/branches/on-20050420-cmm-branch/mlton/backend/allocate-registers.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/backend/allocate-registers.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/backend/allocate-registers.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 type int = Int.t
    
 signature ALLOCATE_REGISTERS_STRUCTS = 
@@ -20,29 +21,29 @@
       include ALLOCATE_REGISTERS_STRUCTS
 
       val allocate:
-	 {argOperands: Machine.Operand.t vector,
-	  function: Rssa.Function.t,
-	  varInfo: Rssa.Var.t -> {
-				  (* If (isSome operand) then a stack slot or
-				   * register needs to be allocated for the
-				   * variable.
-				   *)
-				  operand: Machine.Operand.t option ref option,
-				  ty: Machine.Type.t
-				  }
-	  }
-	 -> {(* If handlers are used, handlerLinkOffset gives the stack offsets
-	      * where the handler and link (old exnStack) should be stored.
-	      *)
-	     handlerLinkOffset: {handler: Bytes.t,
-				 link: Bytes.t} option,
-	     labelInfo:
-	     Rssa.Label.t -> {(* Live operands at the beginning of the block. *)
-			      live: Machine.Operand.t vector,
-			      (* Live operands at the beginning of the block, 
-			       * excepting its formals.
-			       *)
-			      liveNoFormals: Machine.Operand.t vector,
-			      (* Size of frame including return address. *)
-			      size: Bytes.t}}
+         {argOperands: Machine.Operand.t vector,
+          function: Rssa.Function.t,
+          varInfo: Rssa.Var.t -> {
+                                  (* If (isSome operand) then a stack slot or
+                                   * register needs to be allocated for the
+                                   * variable.
+                                   *)
+                                  operand: Machine.Operand.t option ref option,
+                                  ty: Machine.Type.t
+                                  }
+          }
+         -> {(* If handlers are used, handlerLinkOffset gives the stack offsets
+              * where the handler and link (old exnStack) should be stored.
+              *)
+             handlerLinkOffset: {handler: Bytes.t,
+                                 link: Bytes.t} option,
+             labelInfo:
+             Rssa.Label.t -> {(* Live operands at the beginning of the block. *)
+                              live: Machine.Operand.t vector,
+                              (* Live operands at the beginning of the block, 
+                               * excepting its formals.
+                               *)
+                              liveNoFormals: Machine.Operand.t vector,
+                              (* Size of frame including return address. *)
+                              size: Bytes.t}}
    end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/backend/backend.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/backend/backend.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/backend/backend.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 functor Backend (S: BACKEND_STRUCTS): BACKEND =
 struct
 
@@ -47,16 +48,16 @@
 end 
 
 structure AllocateRegisters = AllocateRegisters (structure Machine = Machine
-						 structure Rssa = Rssa)
+                                                 structure Rssa = Rssa)
 structure Chunkify = Chunkify (Rssa)
 structure ImplementHandlers = ImplementHandlers (structure Rssa = Rssa)
 structure LimitCheck = LimitCheck (structure Rssa = Rssa)
 structure ParallelMove = ParallelMove ()
 structure Profile = Profile (structure Machine = Machine
-			     structure Rssa = Rssa)
+                             structure Rssa = Rssa)
 structure SignalCheck = SignalCheck(structure Rssa = Rssa)
 structure SsaToRssa = SsaToRssa (structure Rssa = Rssa
-				 structure Ssa = Ssa)
+                                 structure Ssa = Ssa)
 
 nonfix ^
 fun ^ r = valOf (!r)
@@ -64,938 +65,953 @@
 structure VarOperand =
    struct
       datatype t =
-	 Allocate of {operand: M.Operand.t option ref}
+         Allocate of {operand: M.Operand.t option ref}
        | Const of M.Operand.t
 
       fun layout i =
-	 let
-	    open Layout
-	 in
-	    case i of
-	       Allocate {operand, ...} =>
-		  seq [str "Allocate ",
-		       record [("operand",
-				Option.layout M.Operand.layout (!operand))]]
-	     | Const oper => seq [str "Const ", M.Operand.layout oper]
-	 end
+         let
+            open Layout
+         in
+            case i of
+               Allocate {operand, ...} =>
+                  seq [str "Allocate ",
+                       record [("operand",
+                                Option.layout M.Operand.layout (!operand))]]
+             | Const oper => seq [str "Const ", M.Operand.layout oper]
+         end
 
       val operand: t -> M.Operand.t =
-	 fn Allocate {operand, ...} => ^operand
-	  | Const oper => oper
+         fn Allocate {operand, ...} => ^operand
+          | Const oper => oper
    end
 
 structure IntSet = UniqueSet (val cacheSize: int = 1
-			      val bits: int = 14
-			      structure Element =
-				 struct
-				    open Int
-				    fun hash n = Word.fromInt n
-				 end)
+                              val bits: int = 14
+                              structure Element =
+                                 struct
+                                    open Int
+                                    fun hash n = Word.fromInt n
+                                 end)
 
 structure Chunk =
    struct
       datatype t = T of {blocks: M.Block.t list ref,
-			 chunkLabel: M.ChunkLabel.t}
+                         chunkLabel: M.ChunkLabel.t}
 
       fun label (T {chunkLabel, ...}) = chunkLabel
-	 
+         
       fun new (): t =
-	 T {blocks = ref [],
-	    chunkLabel = M.ChunkLabel.newNoname ()}
-	 
+         T {blocks = ref [],
+            chunkLabel = M.ChunkLabel.newNoname ()}
+         
       fun newBlock (T {blocks, ...}, z) =
-	 List.push (blocks, M.Block.T z)
+         List.push (blocks, M.Block.T z)
    end
 
 val traceGenBlock =
    Trace.trace ("Backend.genBlock",
-		Label.layout o R.Block.label,
-		Unit.layout)
+                Label.layout o R.Block.label,
+                Unit.layout)
 
 fun eliminateDeadCode (f: R.Function.t): R.Function.t =
    let
       val {args, blocks, name, returns, raises, start} = R.Function.dest f
       val {get, rem, set, ...} =
-	 Property.getSetOnce (Label.plist, Property.initConst false)
+         Property.getSetOnce (Label.plist, Property.initConst false)
       val get = Trace.trace ("Backend.labelIsReachable",
-			     Label.layout,
-			     Bool.layout) get
+                             Label.layout,
+                             Bool.layout) get
       val _ =
-	 R.Function.dfs (f, fn R.Block.T {label, ...} =>
-			 (set (label, true)
-			  ; fn () => ()))
+         R.Function.dfs (f, fn R.Block.T {label, ...} =>
+                         (set (label, true)
+                          ; fn () => ()))
       val blocks =
-	 Vector.keepAll (blocks, fn R.Block.T {label, ...} =>
-			 let
-			    val res = get label
-			    val () = rem label
-			 in
-			    res
-			 end)
+         Vector.keepAll (blocks, fn R.Block.T {label, ...} =>
+                         let
+                            val res = get label
+                            val () = rem label
+                         in
+                            res
+                         end)
    in
       R.Function.new {args = args,
-		      blocks = blocks,
-		      name = name,
-		      returns = returns,
-		      raises = raises,
-		      start = start}
+                      blocks = blocks,
+                      name = name,
+                      returns = returns,
+                      raises = raises,
+                      start = start}
    end
 
 fun toMachine (program: Ssa.Program.t, codegen) =
    let
       fun pass (name, doit, program) =
-	 Control.passTypeCheck {display = Control.Layouts Rssa.Program.layouts,
-				name = name,
-				style = Control.No,
-				suffix = "rssa",
-				thunk = fn () => doit program,
-				typeCheck = R.Program.typeCheck}
-      val program = pass ("ToRssa", SsaToRssa.convert, (program, codegen))
+         Control.passTypeCheck {display = Control.Layouts Rssa.Program.layouts,
+                                name = name,
+                                style = Control.No,
+                                suffix = "rssa",
+                                thunk = fn () => doit program,
+                                typeCheck = R.Program.typeCheck}
+      fun maybePass (name, doit, program) =
+         if List.exists (!Control.dropPasses, fn re =>
+                         Regexp.Compiled.matchesAll (re, name))
+            then program
+         else pass (name, doit, program)
+      val program = pass ("toRssa", SsaToRssa.convert, (program, codegen))
       fun rssaSimplify program = 
-	 let
-	    val program = pass ("rssaShrink1", Rssa.Program.shrink, program)
-	    val program = pass ("insertLimitChecks", LimitCheck.insert, program)
-	    val program = pass ("insertSignalChecks", SignalCheck.insert, program)
-	    val program = pass ("implementHandlers", ImplementHandlers.doit, program)
-	    val program = pass ("rssaShrink2", Rssa.Program.shrink, program)
-	    val () = R.Program.checkHandlers program
-	    val (program, makeProfileInfo) =
-	       Control.passTypeCheck
-	       {display = Control.Layouts (fn ((program, _), output) =>
-					   Rssa.Program.layouts (program, output)),
-		name = "implementProfiling",
-		style = Control.No,
-		suffix = "rssa",
-		thunk = fn () => Profile.profile program,
-		typeCheck = R.Program.typeCheck o #1}
-	 in
-	    (program, makeProfileInfo)
-	 end
+         let
+            val program = 
+               maybePass ("rssaShrink1", Rssa.Program.shrink, program)
+            val program = pass ("insertLimitChecks", LimitCheck.insert, program)
+            val program = pass ("insertSignalChecks", SignalCheck.insert, program)
+            val program = pass ("implementHandlers", ImplementHandlers.doit, program)
+            val program = 
+               maybePass ("rssaShrink2", Rssa.Program.shrink, program)
+            val () = R.Program.checkHandlers program
+            val (program, makeProfileInfo) =
+               Control.passTypeCheck
+               {display = Control.Layouts (fn ((program, _), output) =>
+                                           Rssa.Program.layouts (program, output)),
+                name = "implementProfiling",
+                style = Control.No,
+                suffix = "rssa",
+                thunk = fn () => Profile.profile program,
+                typeCheck = R.Program.typeCheck o #1}
+         in
+            (program, makeProfileInfo)
+         end
       val (program, makeProfileInfo) =
-	 Control.passTypeCheck
-	 {display = Control.Layouts (fn ((program, _), output) =>
-				     Rssa.Program.layouts (program, output)),
-	  name = "rssaSimplify",
-	  style = Control.No,
-	  suffix = "rssa",
-	  thunk = fn () => rssaSimplify program,
-	  typeCheck = R.Program.typeCheck o #1}
+         Control.passTypeCheck
+         {display = Control.Layouts (fn ((program, _), output) =>
+                                     Rssa.Program.layouts (program, output)),
+          name = "rssaSimplify",
+          style = Control.No,
+          suffix = "rssa",
+          thunk = fn () => rssaSimplify program,
+          typeCheck = R.Program.typeCheck o #1}
       val _ =
-	 let
-	    open Control
-	 in
-	    if !keepRSSA
-	       then saveToFile ({suffix = "rssa"},
-				No,
-				program,
-				Layouts Rssa.Program.layouts)
-	    else ()
-	 end
+         let
+            open Control
+         in
+            if !keepRSSA
+               then saveToFile ({suffix = "rssa"},
+                                No,
+                                program,
+                                Layouts Rssa.Program.layouts)
+            else ()
+         end
       val program =
-	 Control.pass
-	 {name = "toMachine",
-	  suffix = "machine",
-	  style = Control.No,
-	  thunk = fn () =>
+         Control.pass
+         {name = "toMachine",
+          suffix = "machine",
+          style = Control.No,
+          thunk = fn () =>
 let
       val R.Program.T {functions, handlesSignals, main, objectTypes} = program
       (* Chunk information *)
       val {get = labelChunk, set = setLabelChunk, ...} =
-	 Property.getSetOnce (Label.plist,
-			      Property.initRaise ("labelChunk", Label.layout))
+         Property.getSetOnce (Label.plist,
+                              Property.initRaise ("labelChunk", Label.layout))
       val {get = funcChunk: Func.t -> Chunk.t, set = setFuncChunk, ...} =
-	 Property.getSetOnce (Func.plist,
-			      Property.initRaise ("funcChunk", Func.layout))
+         Property.getSetOnce (Func.plist,
+                              Property.initRaise ("funcChunk", Func.layout))
       val chunks = ref []
       fun newChunk () =
-	 let
-	    val c = Chunk.new ()
-	    val _ = List.push (chunks, c)
-	 in
-	    c
-	 end
+         let
+            val c = Chunk.new ()
+            val _ = List.push (chunks, c)
+         in
+            c
+         end
       val handlers = ref []
       (* Set funcChunk and labelChunk. *)
       val _ =
-	 Vector.foreach
-	 (Chunkify.chunkify program, fn {funcs, labels} =>
-	  let 
-	     val c = newChunk ()
-	     val _ = Vector.foreach (funcs, fn f => setFuncChunk (f, c))
-	     val _ = Vector.foreach (labels, fn l => setLabelChunk (l, c))
-	  in
-	     ()
-	  end)
+         Vector.foreach
+         (Chunkify.chunkify program, fn {funcs, labels} =>
+          let 
+             val c = newChunk ()
+             val _ = Vector.foreach (funcs, fn f => setFuncChunk (f, c))
+             val _ = Vector.foreach (labels, fn l => setLabelChunk (l, c))
+          in
+             ()
+          end)
       (* FrameInfo. *)
       local
-	 val frameLabels = ref []
-	 val frameLayouts = ref []
-	 val frameLayoutsCounter = Counter.new 0
-	 val _ = IntSet.reset ()
-	 val table = HashSet.new {hash = Word.fromInt o #frameOffsetsIndex}
-	 val frameOffsets: Bytes.t vector list ref = ref []
-	 val frameOffsetsCounter = Counter.new 0
-	 val {get = frameOffsetsIndex: IntSet.t -> int, ...} =
-	    Property.get
-	    (IntSet.plist,
-	     Property.initFun
-	     (fn offsets =>
-	      let
-		 val _ = List.push (frameOffsets,
-				    QuickSort.sortVector
-				    (Vector.fromListMap
-				     (IntSet.toList offsets, Bytes.fromInt),
-				     Bytes.<=))
-	      in
-		 Counter.next frameOffsetsCounter
-	      end))
+         val frameLabels = ref []
+         val frameLayouts = ref []
+         val frameLayoutsCounter = Counter.new 0
+         val _ = IntSet.reset ()
+         val table = HashSet.new {hash = Word.fromInt o #frameOffsetsIndex}
+         val frameOffsets: Bytes.t vector list ref = ref []
+         val frameOffsetsCounter = Counter.new 0
+         val {get = frameOffsetsIndex: IntSet.t -> int, ...} =
+            Property.get
+            (IntSet.plist,
+             Property.initFun
+             (fn offsets =>
+              let
+                 val _ = List.push (frameOffsets,
+                                    QuickSort.sortVector
+                                    (Vector.fromListMap
+                                     (IntSet.toList offsets, Bytes.fromInt),
+                                     Bytes.<=))
+              in
+                 Counter.next frameOffsetsCounter
+              end))
       in
-	 fun allFrameInfo () =
-	    let
-	       (* Reverse lists because the index is from back of list. *)
-	       val frameLabels = Vector.fromListRev (!frameLabels)
-	       val frameLayouts = Vector.fromListRev (!frameLayouts)
-	       val frameOffsets = Vector.fromListRev (!frameOffsets)
-	    in
-	       (frameLabels, frameLayouts, frameOffsets)
-	    end
-	 fun getFrameLayoutsIndex {isC: bool,
-				   label: Label.t,
-				   offsets: Bytes.t list,
-				   size: Bytes.t}: int =
-	    let
-	       val foi =
-		  frameOffsetsIndex (IntSet.fromList
-				     (List.map (offsets, Bytes.toInt)))
-	       fun new () =
-		  let
-		     val _ =
-			List.push (frameLayouts,
-				   {frameOffsetsIndex = foi,
-				    isC = isC,
-				    size = size})
-		     val _ = List.push (frameLabels, label)
-		  in
-		     Counter.next frameLayoutsCounter
-		  end
-	    in
-	       (* We need to give each frame its own layout index in two cases.
-		* 1. If we are using the C codegen, in which case we want the
-		*    indices in a chunk to be consecutive integers so that gcc
-		*    will use a jump table.
-		* 2. If we are profiling, we want every frame to have a
-		*    different index so that it can have its own profiling info.
-		*    This will be created by the call to makeProfileInfo at the
-		*    end of the backend.
-		*)
-	       if !Control.codegen = Control.CCodegen
-		  orelse !Control.profile <> Control.ProfileNone
-		  then new ()
-	       else
-	       #frameLayoutsIndex
-	       (HashSet.lookupOrInsert
-		(table, Word.fromInt foi,
-		 fn {frameOffsetsIndex = foi', isC = isC', size = s', ...} =>
-		 foi = foi'
-		 andalso isC = isC'
-		 andalso Bytes.equals (size, s'),
-		 fn () => {frameLayoutsIndex = new (),
-			   frameOffsetsIndex = foi,
-			   isC = isC,
-			   size = size}))
-	    end
+         fun allFrameInfo () =
+            let
+               (* Reverse lists because the index is from back of list. *)
+               val frameLabels = Vector.fromListRev (!frameLabels)
+               val frameLayouts = Vector.fromListRev (!frameLayouts)
+               val frameOffsets = Vector.fromListRev (!frameOffsets)
+            in
+               (frameLabels, frameLayouts, frameOffsets)
+            end
+         fun getFrameLayoutsIndex {isC: bool,
+                                   label: Label.t,
+                                   offsets: Bytes.t list,
+                                   size: Bytes.t}: int =
+            let
+               val foi =
+                  frameOffsetsIndex (IntSet.fromList
+                                     (List.map (offsets, Bytes.toInt)))
+               fun new () =
+                  let
+                     val _ =
+                        List.push (frameLayouts,
+                                   {frameOffsetsIndex = foi,
+                                    isC = isC,
+                                    size = size})
+                     val _ = List.push (frameLabels, label)
+                  in
+                     Counter.next frameLayoutsCounter
+                  end
+            in
+               (* We need to give each frame its own layout index in two cases.
+                * 1. If we are using the C codegen, in which case we want the
+                *    indices in a chunk to be consecutive integers so that gcc
+                *    will use a jump table.
+                * 2. If we are profiling, we want every frame to have a
+                *    different index so that it can have its own profiling info.
+                *    This will be created by the call to makeProfileInfo at the
+                *    end of the backend.
+                *)
+               if !Control.codegen = Control.CCodegen
+                  orelse !Control.profile <> Control.ProfileNone
+                  then new ()
+               else
+               #frameLayoutsIndex
+               (HashSet.lookupOrInsert
+                (table, Word.fromInt foi,
+                 fn {frameOffsetsIndex = foi', isC = isC', size = s', ...} =>
+                 foi = foi'
+                 andalso isC = isC'
+                 andalso Bytes.equals (size, s'),
+                 fn () => {frameLayoutsIndex = new (),
+                           frameOffsetsIndex = foi,
+                           isC = isC,
+                           size = size}))
+            end
       end
       val {get = frameInfo: Label.t -> M.FrameInfo.t option,
-	   set = setFrameInfo, ...} = 
-	 Property.getSetOnce (Label.plist,
-			      Property.initConst NONE)
+           set = setFrameInfo, ...} = 
+         Property.getSetOnce (Label.plist,
+                              Property.initConst NONE)
       val setFrameInfo =
-	 Trace.trace2 ("Backend.setFrameInfo",
-		       Label.layout, Option.layout M.FrameInfo.layout,
-		       Unit.layout)
-	 setFrameInfo
+         Trace.trace2 ("Backend.setFrameInfo",
+                       Label.layout, Option.layout M.FrameInfo.layout,
+                       Unit.layout)
+         setFrameInfo
       (* The global raise operands. *)
       local
-	 val table: (Type.t vector * M.Live.t vector) list ref = ref []
+         val table: (Type.t vector * M.Live.t vector) list ref = ref []
       in
-	 fun raiseOperands (ts: Type.t vector): M.Live.t vector =
-	    case List.peek (!table, fn (ts', _) =>
-			    Vector.equals (ts, ts', Type.equals)) of
-	       NONE =>
-		  let
-		     val gs =
-			Vector.map (ts, fn ty =>
-				    M.Live.Global
-				    (Global.new {isRoot = false,
-						 ty = ty}))
-		     val _ = List.push (table, (ts, gs))
-		  in
-		     gs
-		  end
-	     | SOME (_, gs) => gs
+         fun raiseOperands (ts: Type.t vector): M.Live.t vector =
+            case List.peek (!table, fn (ts', _) =>
+                            Vector.equals (ts, ts', Type.equals)) of
+               NONE =>
+                  let
+                     val gs =
+                        Vector.map (ts, fn ty =>
+                                    M.Live.Global
+                                    (Global.new {isRoot = false,
+                                                 ty = ty}))
+                     val _ = List.push (table, (ts, gs))
+                  in
+                     gs
+                  end
+             | SOME (_, gs) => gs
       end
       val {get = varInfo: Var.t -> {operand: VarOperand.t,
-				    ty: Type.t},
-	   set = setVarInfo, ...} =
-	 Property.getSetOnce (Var.plist,
-			      Property.initRaise ("Backend.info", Var.layout))
+                                    ty: Type.t},
+           set = setVarInfo, ...} =
+         Property.getSetOnce (Var.plist,
+                              Property.initRaise ("Backend.info", Var.layout))
       val setVarInfo =
-	 Trace.trace2 ("Backend.setVarInfo",
-		       Var.layout, VarOperand.layout o #operand, Unit.layout)
-	 setVarInfo
+         Trace.trace2 ("Backend.setVarInfo",
+                       Var.layout, VarOperand.layout o #operand, Unit.layout)
+         setVarInfo
       val varInfo =
-	 Trace.trace ("Backend.varInfo",
-		      Var.layout,
-		      fn {operand, ...} =>
-		      Layout.record [("operand", VarOperand.layout operand)])
-	 varInfo
+         Trace.trace ("Backend.varInfo",
+                      Var.layout,
+                      fn {operand, ...} =>
+                      Layout.record [("operand", VarOperand.layout operand)])
+         varInfo
       val varOperand: Var.t -> M.Operand.t =
-	 VarOperand.operand o #operand o varInfo
+         VarOperand.operand o #operand o varInfo
       (* Hash tables for uniquifying globals. *)
       local
-	 fun ('a, 'b) make (equals: 'a * 'a -> bool,
-			    info: 'a -> string * Type.t * 'b) =
-	    let
-	       val set: {a: 'a,
-			 global: M.Global.t,
-			 hash: word,
-			 value: 'b} HashSet.t = HashSet.new {hash = #hash}
-	       fun get (a: 'a): M.Operand.t =
-		  let
-		     val (string, ty, value) = info a
-		     val hash = String.hash string
-		  in
-		     M.Operand.Global
-		     (#global
-		      (HashSet.lookupOrInsert
-		       (set, hash,
-			fn {a = a', ...} => equals (a, a'),
-			fn () => {a = a,
-				  hash = hash,
-				  global = M.Global.new {isRoot = true,
-							 ty = ty},
-				  value =  value})))
-		  end
-	       fun all () =
-		  HashSet.fold
-		  (set, [], fn ({global, value, ...}, ac) =>
-		   (global, value) :: ac)
-	    in
-	       (all, get)
-	    end
+         fun ('a, 'b) make (equals: 'a * 'a -> bool,
+                            info: 'a -> string * Type.t * 'b) =
+            let
+               val set: {a: 'a,
+                         global: M.Global.t,
+                         hash: word,
+                         value: 'b} HashSet.t = HashSet.new {hash = #hash}
+               fun get (a: 'a): M.Operand.t =
+                  let
+                     val (string, ty, value) = info a
+                     val hash = String.hash string
+                  in
+                     M.Operand.Global
+                     (#global
+                      (HashSet.lookupOrInsert
+                       (set, hash,
+                        fn {a = a', ...} => equals (a, a'),
+                        fn () => {a = a,
+                                  hash = hash,
+                                  global = M.Global.new {isRoot = true,
+                                                         ty = ty},
+                                  value =  value})))
+                  end
+               fun all () =
+                  HashSet.fold
+                  (set, [], fn ({global, value, ...}, ac) =>
+                   (global, value) :: ac)
+            in
+               (all, get)
+            end
       in
-	 val (allIntInfs, globalIntInf) =
-	    make (IntInf.equals,
-		  fn i => let
-			     val s = IntInf.toString i
-			  in
-			     (s, Type.intInf, s)
-			  end)
-	 val (allReals, globalReal) =
-	    make (RealX.equals,
-		  fn r => (RealX.toString r,
-			   Type.real (RealX.size r),
-			   r))
-	 val (allVectors, globalVector) =
-	    make (WordXVector.equals,
-		  fn v => (WordXVector.toString v,
-			   Type.ofWordVector v,
-			   v))
+         val (allIntInfs, globalIntInf) =
+            make (IntInf.equals,
+                  fn i => let
+                             val s = IntInf.toString i
+                          in
+                             (s, Type.intInf, s)
+                          end)
+         val (allReals, globalReal) =
+            make (RealX.equals,
+                  fn r => (RealX.toString r,
+                           Type.real (RealX.size r),
+                           r))
+         val (allVectors, globalVector) =
+            make (WordXVector.equals,
+                  fn v => (WordXVector.toString v,
+                           Type.ofWordVector v,
+                           v))
       end
       fun realOp (r: RealX.t): M.Operand.t =
-	 if !Control.codegen = Control.CCodegen
-	    then M.Operand.Real r
-	 else globalReal r
+         if !Control.codegen = Control.CCodegen
+            then M.Operand.Real r
+         else globalReal r
       fun bogusOp (t: Type.t): M.Operand.t =
-	 case Type.deReal t of
-	    NONE => M.Operand.Word (WordX.fromIntInf
-				    (0, WordSize.fromBits (Type.width t)))
-	  | SOME s => realOp (RealX.zero s)
+         case Type.deReal t of
+            NONE => M.Operand.Word (WordX.fromIntInf
+                                    (0, WordSize.fromBits (Type.width t)))
+          | SOME s => realOp (RealX.zero s)
       fun constOperand (c: Const.t): M.Operand.t =
-	 let
-	    datatype z = datatype Const.t
-	 in
-	    case c of
-	       IntInf i =>
-		  (case Const.SmallIntInf.toWord i of
-		      NONE => globalIntInf i
-		    | SOME w =>
-			 M.Operand.Word (WordX.fromIntInf
-					 (Word.toIntInf w, WordSize.default)))
-	     | Real r => realOp r
-	     | Word w => M.Operand.Word w
-	     | WordVector v => globalVector v
-	 end
+         let
+            datatype z = datatype Const.t
+         in
+            case c of
+               IntInf i =>
+                  (case Const.SmallIntInf.toWord i of
+                      NONE => globalIntInf i
+                    | SOME w =>
+                         M.Operand.Word (WordX.fromIntInf
+                                         (Word.toIntInf w, WordSize.default)))
+             | Real r => realOp r
+             | Word w => M.Operand.Word w
+             | WordVector v => globalVector v
+         end
       fun parallelMove {chunk = _,
-			dsts: M.Operand.t vector,
-			srcs: M.Operand.t vector}: M.Statement.t vector =
-	 let
-	    val moves =
-	       Vector.fold2 (srcs, dsts, [],
-			     fn (src, dst, ac) => {src = src, dst = dst} :: ac)
-	    fun temp r =
-	       M.Operand.Register (Register.new (M.Operand.ty r, NONE))
-	 in
-	    Vector.fromList
-	    (ParallelMove.move {
-				equals = M.Operand.equals,
-				move = M.Statement.move,
-				moves = moves,
-				interfere = M.Operand.interfere,
-				temp = temp
-				})
-	 end
+                        dsts: M.Operand.t vector,
+                        srcs: M.Operand.t vector}: M.Statement.t vector =
+         let
+            val moves =
+               Vector.fold2 (srcs, dsts, [],
+                             fn (src, dst, ac) => {src = src, dst = dst} :: ac)
+            fun temp r =
+               M.Operand.Register (Register.new (M.Operand.ty r, NONE))
+         in
+            Vector.fromList
+            (ParallelMove.move {
+                                equals = M.Operand.equals,
+                                move = M.Statement.move,
+                                moves = moves,
+                                interfere = M.Operand.interfere,
+                                temp = temp
+                                })
+         end
       fun runtimeOp (field: GCField.t, ty: Type.t): M.Operand.t =
-	 case field of
-	    GCField.Frontier => M.Operand.Frontier
-	  | GCField.StackTop => M.Operand.StackTop
-	  | _ => 
-	       M.Operand.Offset {base = M.Operand.GCState,
-				 offset = GCField.offset field,
-				 ty = ty}
+         case field of
+            GCField.Frontier => M.Operand.Frontier
+          | GCField.StackTop => M.Operand.StackTop
+          | _ => 
+               M.Operand.Offset {base = M.Operand.GCState,
+                                 offset = GCField.offset field,
+                                 ty = ty}
       val exnStackOp = runtimeOp (GCField.ExnStack, Type.exnStack)
       val stackBottomOp = runtimeOp (GCField.StackBottom, Type.defaultWord)
       val stackTopOp = runtimeOp (GCField.StackTop, Type.defaultWord)
       fun translateOperand (oper: R.Operand.t): M.Operand.t =
-	 let
-	    datatype z = datatype R.Operand.t
-	 in
-	    case oper of
-	       ArrayOffset {base, index, offset, scale, ty} =>
-		  M.Operand.ArrayOffset {base = translateOperand base,
-					 index = translateOperand index,
-					 offset = offset,
-					 scale = scale,
-					 ty = ty}
-	     | Cast (z, t) => M.Operand.Cast (translateOperand z, t)
-	     | Const c => constOperand c
-	     | EnsuresBytesFree =>
-		  Error.bug "backend translateOperand saw EnsuresBytesFree"
-	     | File => M.Operand.File
-	     | GCState => M.Operand.GCState
-	     | Line => M.Operand.Line
-	     | Offset {base, offset, ty} =>
-		  let
-		     val base = translateOperand base
-		  in
-		     if M.Operand.isLocation base
-			then M.Operand.Offset {base = base,
-					       offset = offset,
-					       ty = ty}
-		     else bogusOp ty
-		  end
-	     | PointerTycon pt =>
-		  M.Operand.Word
-		  (WordX.fromIntInf
-		   (Word.toIntInf (Runtime.typeIndexToHeader
-				   (PointerTycon.index pt)),
-		    WordSize.default))
-	     | Runtime f =>
-		  runtimeOp (f, R.Operand.ty oper)
-	     | Var {var, ...} => varOperand var
-	 end
+         let
+            datatype z = datatype R.Operand.t
+         in
+            case oper of
+               ArrayOffset {base, index, offset, scale, ty} =>
+                  M.Operand.ArrayOffset {base = translateOperand base,
+                                         index = translateOperand index,
+                                         offset = offset,
+                                         scale = scale,
+                                         ty = ty}
+             | Cast (z, t) => M.Operand.Cast (translateOperand z, t)
+             | Const c => constOperand c
+             | EnsuresBytesFree =>
+                  Error.bug "Backend.translateOperand: EnsuresBytesFree"
+             | File => M.Operand.File
+             | GCState => M.Operand.GCState
+             | Line => M.Operand.Line
+             | Offset {base, offset, ty} =>
+                  let
+                     val base = translateOperand base
+                  in
+                     if M.Operand.isLocation base
+                        then M.Operand.Offset {base = base,
+                                               offset = offset,
+                                               ty = ty}
+                     else bogusOp ty
+                  end
+             | PointerTycon pt =>
+                  M.Operand.Word
+                  (WordX.fromIntInf
+                   (Word.toIntInf (Runtime.typeIndexToHeader
+                                   (PointerTycon.index pt)),
+                    WordSize.default))
+             | Runtime f =>
+                  runtimeOp (f, R.Operand.ty oper)
+             | Var {var, ...} => varOperand var
+         end
       fun translateOperands ops = Vector.map (ops, translateOperand)
       fun genStatement (s: R.Statement.t,
-			handlerLinkOffset: {handler: Bytes.t,
-					    link: Bytes.t} option)
-	 : M.Statement.t vector =
-	 let
-	    fun handlerOffset () = #handler (valOf handlerLinkOffset)
-	    fun linkOffset () = #link (valOf handlerLinkOffset)
-	    datatype z = datatype R.Statement.t
-	 in
-	    case s of
+                        handlerLinkOffset: {handler: Bytes.t,
+                                            link: Bytes.t} option)
+         : M.Statement.t vector =
+         let
+            fun handlerOffset () = #handler (valOf handlerLinkOffset)
+            fun linkOffset () = #link (valOf handlerLinkOffset)
+            datatype z = datatype R.Statement.t
+         in
+            case s of
                Bind {dst = (var, _), isMutable, src} =>
-		  if isMutable
-		     orelse (case #operand (varInfo var) of
-				VarOperand.Const _ => false
-			      | _ => true)
-		     then (Vector.new1
-			   (M.Statement.move {dst = varOperand var,
-					      src = translateOperand src}))
-		  else Vector.new0 ()
-	     | Move {dst, src} =>
-		  Vector.new1
-		  (M.Statement.move {dst = translateOperand dst,
-				     src = translateOperand src})
-	     | Object {dst, header, size} =>
-		  M.Statement.object {dst = varOperand (#1 dst),
-				      header = header,
-				      size = size}
-	     | PrimApp {dst, prim, args} =>
-		  Vector.new1
-		  (M.Statement.PrimApp
-		   {args = translateOperands args,
-		    dst = Option.map (dst, varOperand o #1),
-		    prim = prim})
-	     | ProfileLabel s => Vector.new1 (M.Statement.ProfileLabel s)
-	     | SetExnStackLocal =>
-		  (* ExnStack = stackTop + (offset + WORD_SIZE) - StackBottom; *)
-		  let
-		     val tmp =
-			M.Operand.Register
-			(Register.new (Type.defaultWord, NONE))
-		  in
-		     Vector.new2
-		     (M.Statement.PrimApp
-		      {args = (Vector.new2
-			       (stackTopOp,
-				M.Operand.Word
-				(WordX.fromIntInf
-				 (Int.toIntInf
-				  (Bytes.toInt
-				   (Bytes.+ (handlerOffset (), Bytes.inWord))),
-				  WordSize.default)))),
-		       dst = SOME tmp,
-		       prim = Prim.wordAdd WordSize.default},
-		      M.Statement.PrimApp
-		      {args = Vector.new2 (tmp, stackBottomOp),
-		       dst = SOME exnStackOp,
-		       prim = Prim.wordSub WordSize.default})
-		  end
-	     | SetExnStackSlot =>
-		  (* ExnStack = *(uint* )(stackTop + offset);	*)
-		  Vector.new1
-		  (M.Statement.move
-		   {dst = exnStackOp,
-		    src = M.Operand.stackOffset {offset = linkOffset (),
-						 ty = Type.exnStack}})
-	     | SetHandler h =>
-		  Vector.new1
-		  (M.Statement.move
-		   {dst = M.Operand.stackOffset {offset = handlerOffset (),
-						 ty = Type.label h},
-		    src = M.Operand.Label h})
-	     | SetSlotExnStack =>
-		  (* *(uint* )(stackTop + offset) = ExnStack; *)
-		  Vector.new1
-		  (M.Statement.move
-		   {dst = M.Operand.stackOffset {offset = linkOffset (),
-						 ty = Type.exnStack},
-		    src = exnStackOp})
-	     | _ => Error.bug (concat
-			       ["backend saw strange statement: ",
-				R.Statement.toString s])
-	 end
+                  if isMutable
+                     orelse (case #operand (varInfo var) of
+                                VarOperand.Const _ => false
+                              | _ => true)
+                     then (Vector.new1
+                           (M.Statement.move {dst = varOperand var,
+                                              src = translateOperand src}))
+                  else Vector.new0 ()
+             | Move {dst, src} =>
+                  Vector.new1
+                  (M.Statement.move {dst = translateOperand dst,
+                                     src = translateOperand src})
+             | Object {dst, header, size} =>
+                  M.Statement.object {dst = varOperand (#1 dst),
+                                      header = header,
+                                      size = size}
+             | PrimApp {dst, prim, args} =>
+                  let
+                     datatype z = datatype Prim.Name.t
+                  in
+                     case Prim.name prim of
+                        MLton_touch => Vector.new0 ()
+                      | _ => 
+                           Vector.new1
+                           (M.Statement.PrimApp
+                            {args = translateOperands args,
+                             dst = Option.map (dst, varOperand o #1),
+                             prim = prim})
+                  end
+             | ProfileLabel s => Vector.new1 (M.Statement.ProfileLabel s)
+             | SetExnStackLocal =>
+                  (* ExnStack = stackTop + (offset + WORD_SIZE) - StackBottom; *)
+                  let
+                     val tmp =
+                        M.Operand.Register
+                        (Register.new (Type.defaultWord, NONE))
+                  in
+                     Vector.new2
+                     (M.Statement.PrimApp
+                      {args = (Vector.new2
+                               (stackTopOp,
+                                M.Operand.Word
+                                (WordX.fromIntInf
+                                 (Int.toIntInf
+                                  (Bytes.toInt
+                                   (Bytes.+ (handlerOffset (), Bytes.inWord))),
+                                  WordSize.default)))),
+                       dst = SOME tmp,
+                       prim = Prim.wordAdd WordSize.default},
+                      M.Statement.PrimApp
+                      {args = Vector.new2 (tmp, stackBottomOp),
+                       dst = SOME exnStackOp,
+                       prim = Prim.wordSub WordSize.default})
+                  end
+             | SetExnStackSlot =>
+                  (* ExnStack = *(uint* )(stackTop + offset);   *)
+                  Vector.new1
+                  (M.Statement.move
+                   {dst = exnStackOp,
+                    src = M.Operand.stackOffset {offset = linkOffset (),
+                                                 ty = Type.exnStack}})
+             | SetHandler h =>
+                  Vector.new1
+                  (M.Statement.move
+                   {dst = M.Operand.stackOffset {offset = handlerOffset (),
+                                                 ty = Type.label h},
+                    src = M.Operand.Label h})
+             | SetSlotExnStack =>
+                  (* *(uint* )(stackTop + offset) = ExnStack; *)
+                  Vector.new1
+                  (M.Statement.move
+                   {dst = M.Operand.stackOffset {offset = linkOffset (),
+                                                 ty = Type.exnStack},
+                    src = exnStackOp})
+             | _ => Error.bug (concat
+                               ["Backend.genStatement: strange statement: ",
+                                R.Statement.toString s])
+         end
       val genStatement =
-	 Trace.trace ("Backend.genStatement",
-		      R.Statement.layout o #1, Vector.layout M.Statement.layout)
-	 genStatement
+         Trace.trace ("Backend.genStatement",
+                      R.Statement.layout o #1, Vector.layout M.Statement.layout)
+         genStatement
       val bugTransfer =
-	 M.Transfer.CCall
-	 {args = (Vector.new1
-		  (globalVector
-		   (WordXVector.fromString
-		    "backend thought control shouldn't reach here"))),
-	  frameInfo = NONE,
-	  func = Type.BuiltInCFunction.bug,
-	  return = NONE}
+         M.Transfer.CCall
+         {args = (Vector.new1
+                  (globalVector
+                   (WordXVector.fromString
+                    "backend thought control shouldn't reach here"))),
+          frameInfo = NONE,
+          func = Type.BuiltInCFunction.bug,
+          return = NONE}
       val {get = labelInfo: Label.t -> {args: (Var.t * Type.t) vector},
-	   set = setLabelInfo, ...} =
-	 Property.getSetOnce
-	 (Label.plist, Property.initRaise ("labelInfo", Label.layout))
+           set = setLabelInfo, ...} =
+         Property.getSetOnce
+         (Label.plist, Property.initRaise ("labelInfo", Label.layout))
       val setLabelInfo =
-	 Trace.trace2 ("Backend.setLabelInfo",
-		       Label.layout, Layout.ignore, Unit.layout)
-	 setLabelInfo
+         Trace.trace2 ("Backend.setLabelInfo",
+                       Label.layout, Layout.ignore, Unit.layout)
+         setLabelInfo
       fun callReturnOperands (xs: 'a vector,
-			      ty: 'a -> Type.t,
-			      shift: Bytes.t): StackOffset.t vector =
-	 #1 (Vector.mapAndFold
-	     (xs, Bytes.zero,
-	      fn (x, offset) =>
-	      let
-		 val ty = ty x
-		 val offset = Type.align (ty, offset)
-	      in
-		 (StackOffset.T {offset = Bytes.+ (shift, offset), ty = ty},
-		  Bytes.+ (offset, Type.bytes ty))
-	      end))
+                              ty: 'a -> Type.t,
+                              shift: Bytes.t): StackOffset.t vector =
+         #1 (Vector.mapAndFold
+             (xs, Bytes.zero,
+              fn (x, offset) =>
+              let
+                 val ty = ty x
+                 val offset = Type.align (ty, offset)
+              in
+                 (StackOffset.T {offset = Bytes.+ (shift, offset), ty = ty},
+                  Bytes.+ (offset, Type.bytes ty))
+              end))
       val operandLive: M.Operand.t -> M.Live.t =
-	 valOf o M.Live.fromOperand
+         valOf o M.Live.fromOperand
       val operandsLive: M.Operand.t vector -> M.Live.t vector =
-	 fn ops => Vector.map (ops, operandLive)
+         fn ops => Vector.map (ops, operandLive)
       fun genFunc (f: Function.t, isMain: bool): unit =
-	 let
-	    val f = eliminateDeadCode f
-	    val {args, blocks, name, raises, returns, start, ...} =
-	       Function.dest f
-	    val raises = Option.map (raises, fn ts => raiseOperands ts)
-	    val returns =
-	       Option.map (returns, fn ts =>
-			   callReturnOperands (ts, fn t => t, Bytes.zero))
-	    val chunk = funcChunk name
-	    fun labelArgOperands (l: R.Label.t): M.Operand.t vector =
-	       Vector.map (#args (labelInfo l), varOperand o #1)
-	    fun newVarInfo (x, ty: Type.t) =
-	       let
-		  val operand =
-		     if isMain
-			then VarOperand.Const (M.Operand.Global
-					       (M.Global.new {isRoot = true,
-							      ty = ty}))
-		     else VarOperand.Allocate {operand = ref NONE}
-	       in
-		  setVarInfo (x, {operand = operand,
-				  ty = ty})
-	       end
-	    fun newVarInfos xts = Vector.foreach (xts, newVarInfo)
-	    (* Set the constant operands, labelInfo, and varInfo. *)
-	    val _ = newVarInfos args
-	    val _ =
-	       Rssa.Function.dfs
-	       (f, fn R.Block.T {args, label, statements, transfer, ...} =>
-		let
-		   val _ = setLabelInfo (label, {args = args})
-		   val _ = newVarInfos args
-		   val _ =
-		      Vector.foreach
-		      (statements, fn s =>
-		       let
-			  fun normal () = R.Statement.foreachDef (s, newVarInfo)
-		       in
-			  case s of
-			     R.Statement.Bind {dst = (var, _), isMutable, src} =>
-				if isMutable
-				   then normal ()
-				else
-				   let
-				      fun set (z: M.Operand.t,
-					       casts: Type.t list) =
-					 let
-					    val z =
-					       List.fold
-					       (casts, z, fn (t, z) =>
-						M.Operand.Cast (z, t))
-					 in
-					    setVarInfo
-					    (var, {operand = VarOperand.Const z,
-						   ty = M.Operand.ty z})
-					 end
-				      fun loop (z: R.Operand.t, casts) =
-					 case z of
-					    R.Operand.Cast (z, t) =>
-					       loop (z, t :: casts)
-					  | R.Operand.Const c =>
-					       set (constOperand c, casts)
-					  | R.Operand.Var {var = var', ...} =>
-					       (case #operand (varInfo var') of
-						   VarOperand.Const z =>
-						      set (z, casts)
-						 | VarOperand.Allocate _ =>
-						      normal ())
-					  | _ => normal ()
-				   in
-				      loop (src, [])
-				   end
-			   | _ => normal ()
-		       end)
-		   val _ = R.Transfer.foreachDef (transfer, newVarInfo)
-		in
-		   fn () => ()
-		end)
-	    (* Allocate stack slots. *)
-	    local
-	       val varInfo =
-		  fn x =>
-		  let
-		     val {operand, ty, ...} = varInfo x
-		  in
-		     {operand = (case operand of
-				    VarOperand.Allocate {operand, ...} =>
-				       SOME operand
-				  | _ => NONE),
-		      ty = ty}
-		  end
-	    in
-	       val {handlerLinkOffset, labelInfo = labelRegInfo, ...} =
-		  let
-		     val argOperands =
-			Vector.map
-			(callReturnOperands (args, #2, Bytes.zero),
-			 M.Operand.StackOffset)
-		  in
-		     AllocateRegisters.allocate {argOperands = argOperands,
-						 function = f,
-						 varInfo = varInfo}
-		  end
-	    end
-	    (* Set the frameInfo for blocks in this function. *)
-	    val _ =
-	       Vector.foreach
-	       (blocks, fn R.Block.T {kind, label, ...} =>
-		let
-		   fun doit (useOffsets: bool): unit =
-		      let
-			 val {liveNoFormals, size, ...} = labelRegInfo label
-			 val offsets =
-			    if useOffsets
-			       then
-				  Vector.fold
-				  (liveNoFormals, [], fn (oper, ac) =>
-				   case oper of
-				      M.Operand.StackOffset (StackOffset.T {offset, ty}) =>
-					 if Type.isPointer ty
-					    then offset :: ac
-					 else ac
-				    | _ => ac)
-			    else
-			       []
-			 val isC =
-			    case kind of
-			       R.Kind.CReturn _ => true
-			     | _ => false
-			 val frameLayoutsIndex =
-			    getFrameLayoutsIndex {isC = isC,
-						  label = label,
-						  offsets = offsets,
-						  size = size}
-		      in
-			 setFrameInfo
-			 (label,
-			  SOME (M.FrameInfo.T
-				{frameLayoutsIndex = frameLayoutsIndex}))
-		      end
-		in
-		   case R.Kind.frameStyle kind of
-		      R.Kind.None => ()
-		    | R.Kind.OffsetsAndSize => doit true
-		    | R.Kind.SizeOnly => doit false
-		end)
-	    (* ------------------------------------------------- *)
-	    (*                    genTransfer                    *)
-	    (* ------------------------------------------------- *)
-	    fun genTransfer (t: R.Transfer.t, chunk: Chunk.t)
-	       : M.Statement.t vector * M.Transfer.t =
-	       let
-		  fun simple t = (Vector.new0 (), t)
-	       in
-		  case t of
-		     R.Transfer.Arith {args, dst, overflow, prim, success,
-				       ...} =>
-			simple
-			(M.Transfer.Arith {args = translateOperands args,
-					   dst = varOperand dst,
-					   overflow = overflow,
-					   prim = prim,
-					   success = success})
-		   | R.Transfer.CCall {args, func, return} =>
-			simple (M.Transfer.CCall
-				{args = translateOperands args,
-				 frameInfo = (case return of
-						 NONE => NONE
-					       | SOME l => frameInfo l),
-				 func = func,
-				 return = return})
-		   | R.Transfer.Call {func, args, return} =>
-			let
-			   datatype z = datatype R.Return.t
-			   val (contLive, frameSize, return) =
-			      case return of
-				 Dead => (Vector.new0 (), Bytes.zero, NONE)
-			       | Tail => (Vector.new0 (), Bytes.zero, NONE)
-			       | NonTail {cont, handler} =>
-				    let
-				       val {liveNoFormals, size, ...} =
-					  labelRegInfo cont
-				       datatype z = datatype R.Handler.t
-				       val handler =
-					  case handler of
-					     Caller => NONE
-					   | Dead => NONE
-					   | Handle h => SOME h
-				    in
-				       (liveNoFormals,
-					size, 
-					SOME {return = cont,
-					      handler = handler,
-					      size = size})
-				    end
-			   val dsts =
-			      callReturnOperands
-			      (args, R.Operand.ty, frameSize)
-			   val setupArgs =
-			      parallelMove
-			      {chunk = chunk,
-			       dsts = Vector.map (dsts, M.Operand.StackOffset),
-			       srcs = translateOperands args}
-			   val live =
-			      Vector.concat [operandsLive contLive,
-					     Vector.map (dsts, Live.StackOffset)]
-			   val transfer =
-			      M.Transfer.Call {label = funcToLabel func,
-					       live = live,
-					       return = return}
-			in
-			   (setupArgs, transfer)
-			end
-		   | R.Transfer.Goto {dst, args} =>
-			(parallelMove {srcs = translateOperands args,
-				       dsts = labelArgOperands dst,
-				       chunk = labelChunk dst},
-			 M.Transfer.Goto dst)
-		   | R.Transfer.Raise srcs =>
-			(M.Statement.moves {dsts = Vector.map (valOf raises,
-							       Live.toOperand),
-					    srcs = translateOperands srcs},
-			 M.Transfer.Raise)
-		   | R.Transfer.Return xs =>
-			(parallelMove {chunk = chunk,
-				       dsts = Vector.map (valOf returns,
-							  M.Operand.StackOffset),
-				       srcs = translateOperands xs},
-			 M.Transfer.Return)
-		   | R.Transfer.Switch switch =>
-			let
-			   val R.Switch.T {cases, default, size, test} =
-			      switch
-			in
-			   simple
-			   (case (Vector.length cases, default) of
-			       (0, NONE) => bugTransfer
-			     | (1, NONE) =>
-				  M.Transfer.Goto (#2 (Vector.sub (cases, 0)))
-			     | (0, SOME dst) => M.Transfer.Goto dst
-			     | _ =>
-				  M.Transfer.Switch
-				  (M.Switch.T
-				   {cases = cases,
-				    default = default,
-				    size = size,
-				    test = translateOperand test}))
-			end
-	       end
-	    val genTransfer =
-	       Trace.trace ("Backend.genTransfer",
-			    R.Transfer.layout o #1,
-			    Layout.tuple2 (Vector.layout M.Statement.layout,
-					   M.Transfer.layout))
-	       genTransfer
-	    fun genBlock (R.Block.T {args, kind, label, statements, transfer,
-				     ...}) : unit =
-	       let
-		  val _ =
-		     if Label.equals (label, start)
-			then let
-				val live = #live (labelRegInfo start)
-				val returns =
-				   Option.map
-				   (returns, fn returns =>
-				    Vector.map (returns, Live.StackOffset))
-			     in
-				Chunk.newBlock
-				(chunk, 
-				 {label = funcToLabel name,
-				  kind = M.Kind.Func,
-				  live = operandsLive live,
-				  raises = raises,
-				  returns = returns,
-				  statements = Vector.new0 (),
-				  transfer = M.Transfer.Goto start})
-			     end
-		     else ()
-		  val {live, liveNoFormals, size, ...} = labelRegInfo label
-		  val chunk = labelChunk label
-		  val statements =
-		     Vector.concatV
-		     (Vector.map (statements, fn s =>
-				  genStatement (s, handlerLinkOffset)))
-		  val (preTransfer, transfer) = genTransfer (transfer, chunk)	
-		  val (kind, live, pre) =
-		     case kind of
-			R.Kind.Cont _ =>
-			   let
-			      val srcs = callReturnOperands (args, #2, size)
-			   in
-			      (M.Kind.Cont {args = Vector.map (srcs,
-							       Live.StackOffset),
-					    frameInfo = valOf (frameInfo label)},
-			       liveNoFormals,
-			       parallelMove
-			       {chunk = chunk,
-				dsts = Vector.map (args, varOperand o #1),
-				srcs = Vector.map (srcs, M.Operand.StackOffset)})
-			   end
-		      | R.Kind.CReturn {func, ...} =>
-			   let
-			      val dst =
-				 case Vector.length args of
-				    0 => NONE
-				  | 1 => SOME (operandLive
-					       (varOperand
-						(#1 (Vector.sub (args, 0)))))
-				  | _ => Error.bug "strange CReturn"
-			   in
-			      (M.Kind.CReturn {dst = dst,
-					       frameInfo = frameInfo label,
-					       func = func},
-			       liveNoFormals,
-			       Vector.new0 ())
-			   end
-		      | R.Kind.Handler =>
-			   let
-			      val _ =
-				 List.push
-				 (handlers, {chunkLabel = Chunk.label chunk,
-					     label = label})
-			      val dsts = Vector.map (args, varOperand o #1)
-			      val handles =
-				 raiseOperands (Vector.map (dsts, M.Operand.ty))
-			   in
-			      (M.Kind.Handler
-			       {frameInfo = valOf (frameInfo label),
-				handles = handles},
-			       liveNoFormals,
-			       M.Statement.moves
-			       {dsts = dsts,
-				srcs = Vector.map (handles, Live.toOperand)})
-			   end
-		      | R.Kind.Jump => (M.Kind.Jump, live, Vector.new0 ())
-		  val (first, statements) =
-		     if !Control.profile = Control.ProfileTime
-			then
-			   case (if 0 = Vector.length statements
-				    then NONE
-				 else (case Vector.sub (statements, 0) of
-					  s as M.Statement.ProfileLabel _ =>
-					     SOME s
-					| _ => NONE)) of
-			      NONE =>
-				 Error.bug
-				 (concat ["missing ProfileLabel in ",
-					  Label.toString label])
-			    | SOME s =>
-				 (Vector.new1 s,
-				  Vector.dropPrefix (statements, 1))
-		     else (Vector.new0 (), statements)
-		  val statements =
-		     Vector.concat [first, pre, statements, preTransfer]
-		  val returns =
-		     Option.map (returns, fn returns =>
-				 Vector.map (returns, Live.StackOffset))
-	       in
-		  Chunk.newBlock (chunk,
-				  {kind = kind,
-				   label = label,
-				   live = operandsLive live,
-				   raises = raises,
-				   returns = returns,
-				   statements = statements,
-				   transfer = transfer})
-	       end
-	    val genBlock = traceGenBlock genBlock
-	    val _ = Vector.foreach (blocks, genBlock)
-	    val _ =
-	       if isMain
-		  then ()
-	       else Vector.foreach (blocks, R.Block.clear)
-	 in
-	    ()
-	 end
+         let
+            val f = eliminateDeadCode f
+            val {args, blocks, name, raises, returns, start, ...} =
+               Function.dest f
+            val raises = Option.map (raises, fn ts => raiseOperands ts)
+            val returns =
+               Option.map (returns, fn ts =>
+                           callReturnOperands (ts, fn t => t, Bytes.zero))
+            val chunk = funcChunk name
+            fun labelArgOperands (l: R.Label.t): M.Operand.t vector =
+               Vector.map (#args (labelInfo l), varOperand o #1)
+            fun newVarInfo (x, ty: Type.t) =
+               let
+                  val operand =
+                     if isMain
+                        then VarOperand.Const (M.Operand.Global
+                                               (M.Global.new {isRoot = true,
+                                                              ty = ty}))
+                     else VarOperand.Allocate {operand = ref NONE}
+               in
+                  setVarInfo (x, {operand = operand,
+                                  ty = ty})
+               end
+            fun newVarInfos xts = Vector.foreach (xts, newVarInfo)
+            (* Set the constant operands, labelInfo, and varInfo. *)
+            val _ = newVarInfos args
+            val _ =
+               Rssa.Function.dfs
+               (f, fn R.Block.T {args, label, statements, transfer, ...} =>
+                let
+                   val _ = setLabelInfo (label, {args = args})
+                   val _ = newVarInfos args
+                   val _ =
+                      Vector.foreach
+                      (statements, fn s =>
+                       let
+                          fun normal () = R.Statement.foreachDef (s, newVarInfo)
+                       in
+                          case s of
+                             R.Statement.Bind {dst = (var, _), isMutable, src} =>
+                                if isMutable
+                                   then normal ()
+                                else
+                                   let
+                                      fun set (z: M.Operand.t,
+                                               casts: Type.t list) =
+                                         let
+                                            val z =
+                                               List.fold
+                                               (casts, z, fn (t, z) =>
+                                                M.Operand.Cast (z, t))
+                                         in
+                                            setVarInfo
+                                            (var, {operand = VarOperand.Const z,
+                                                   ty = M.Operand.ty z})
+                                         end
+                                      fun loop (z: R.Operand.t, casts) =
+                                         case z of
+                                            R.Operand.Cast (z, t) =>
+                                               loop (z, t :: casts)
+                                          | R.Operand.Const c =>
+                                               set (constOperand c, casts)
+                                          | R.Operand.Var {var = var', ...} =>
+                                               (case #operand (varInfo var') of
+                                                   VarOperand.Const z =>
+                                                      set (z, casts)
+                                                 | VarOperand.Allocate _ =>
+                                                      normal ())
+                                          | _ => normal ()
+                                   in
+                                      loop (src, [])
+                                   end
+                           | _ => normal ()
+                       end)
+                   val _ = R.Transfer.foreachDef (transfer, newVarInfo)
+                in
+                   fn () => ()
+                end)
+            (* Allocate stack slots. *)
+            local
+               val varInfo =
+                  fn x =>
+                  let
+                     val {operand, ty, ...} = varInfo x
+                  in
+                     {operand = (case operand of
+                                    VarOperand.Allocate {operand, ...} =>
+                                       SOME operand
+                                  | _ => NONE),
+                      ty = ty}
+                  end
+            in
+               val {handlerLinkOffset, labelInfo = labelRegInfo, ...} =
+                  let
+                     val argOperands =
+                        Vector.map
+                        (callReturnOperands (args, #2, Bytes.zero),
+                         M.Operand.StackOffset)
+                  in
+                     AllocateRegisters.allocate {argOperands = argOperands,
+                                                 function = f,
+                                                 varInfo = varInfo}
+                  end
+            end
+            (* Set the frameInfo for blocks in this function. *)
+            val _ =
+               Vector.foreach
+               (blocks, fn R.Block.T {kind, label, ...} =>
+                let
+                   fun doit (useOffsets: bool): unit =
+                      let
+                         val {liveNoFormals, size, ...} = labelRegInfo label
+                         val offsets =
+                            if useOffsets
+                               then
+                                  Vector.fold
+                                  (liveNoFormals, [], fn (oper, ac) =>
+                                   case oper of
+                                      M.Operand.StackOffset (StackOffset.T {offset, ty}) =>
+                                         if Type.isPointer ty
+                                            then offset :: ac
+                                         else ac
+                                    | _ => ac)
+                            else
+                               []
+                         val isC =
+                            case kind of
+                               R.Kind.CReturn _ => true
+                             | _ => false
+                         val frameLayoutsIndex =
+                            getFrameLayoutsIndex {isC = isC,
+                                                  label = label,
+                                                  offsets = offsets,
+                                                  size = size}
+                      in
+                         setFrameInfo
+                         (label,
+                          SOME (M.FrameInfo.T
+                                {frameLayoutsIndex = frameLayoutsIndex}))
+                      end
+                in
+                   case R.Kind.frameStyle kind of
+                      R.Kind.None => ()
+                    | R.Kind.OffsetsAndSize => doit true
+                    | R.Kind.SizeOnly => doit false
+                end)
+            (* ------------------------------------------------- *)
+            (*                    genTransfer                    *)
+            (* ------------------------------------------------- *)
+            fun genTransfer (t: R.Transfer.t, chunk: Chunk.t)
+               : M.Statement.t vector * M.Transfer.t =
+               let
+                  fun simple t = (Vector.new0 (), t)
+               in
+                  case t of
+                     R.Transfer.Arith {args, dst, overflow, prim, success,
+                                       ...} =>
+                        simple
+                        (M.Transfer.Arith {args = translateOperands args,
+                                           dst = varOperand dst,
+                                           overflow = overflow,
+                                           prim = prim,
+                                           success = success})
+                   | R.Transfer.CCall {args, func, return} =>
+                        simple (M.Transfer.CCall
+                                {args = translateOperands args,
+                                 frameInfo = (case return of
+                                                 NONE => NONE
+                                               | SOME l => frameInfo l),
+                                 func = func,
+                                 return = return})
+                   | R.Transfer.Call {func, args, return} =>
+                        let
+                           datatype z = datatype R.Return.t
+                           val (contLive, frameSize, return) =
+                              case return of
+                                 Dead => (Vector.new0 (), Bytes.zero, NONE)
+                               | Tail => (Vector.new0 (), Bytes.zero, NONE)
+                               | NonTail {cont, handler} =>
+                                    let
+                                       val {liveNoFormals, size, ...} =
+                                          labelRegInfo cont
+                                       datatype z = datatype R.Handler.t
+                                       val handler =
+                                          case handler of
+                                             Caller => NONE
+                                           | Dead => NONE
+                                           | Handle h => SOME h
+                                    in
+                                       (liveNoFormals,
+                                        size, 
+                                        SOME {return = cont,
+                                              handler = handler,
+                                              size = size})
+                                    end
+                           val dsts =
+                              callReturnOperands
+                              (args, R.Operand.ty, frameSize)
+                           val setupArgs =
+                              parallelMove
+                              {chunk = chunk,
+                               dsts = Vector.map (dsts, M.Operand.StackOffset),
+                               srcs = translateOperands args}
+                           val live =
+                              Vector.concat [operandsLive contLive,
+                                             Vector.map (dsts, Live.StackOffset)]
+                           val transfer =
+                              M.Transfer.Call {label = funcToLabel func,
+                                               live = live,
+                                               return = return}
+                        in
+                           (setupArgs, transfer)
+                        end
+                   | R.Transfer.Goto {dst, args} =>
+                        (parallelMove {srcs = translateOperands args,
+                                       dsts = labelArgOperands dst,
+                                       chunk = labelChunk dst},
+                         M.Transfer.Goto dst)
+                   | R.Transfer.Raise srcs =>
+                        (M.Statement.moves {dsts = Vector.map (valOf raises,
+                                                               Live.toOperand),
+                                            srcs = translateOperands srcs},
+                         M.Transfer.Raise)
+                   | R.Transfer.Return xs =>
+                        (parallelMove {chunk = chunk,
+                                       dsts = Vector.map (valOf returns,
+                                                          M.Operand.StackOffset),
+                                       srcs = translateOperands xs},
+                         M.Transfer.Return)
+                   | R.Transfer.Switch switch =>
+                        let
+                           val R.Switch.T {cases, default, size, test} =
+                              switch
+                        in
+                           simple
+                           (case (Vector.length cases, default) of
+                               (0, NONE) => bugTransfer
+                             | (1, NONE) =>
+                                  M.Transfer.Goto (#2 (Vector.sub (cases, 0)))
+                             | (0, SOME dst) => M.Transfer.Goto dst
+                             | _ =>
+                                  M.Transfer.Switch
+                                  (M.Switch.T
+                                   {cases = cases,
+                                    default = default,
+                                    size = size,
+                                    test = translateOperand test}))
+                        end
+               end
+            val genTransfer =
+               Trace.trace ("Backend.genTransfer",
+                            R.Transfer.layout o #1,
+                            Layout.tuple2 (Vector.layout M.Statement.layout,
+                                           M.Transfer.layout))
+               genTransfer
+            fun genBlock (R.Block.T {args, kind, label, statements, transfer,
+                                     ...}) : unit =
+               let
+                  val _ =
+                     if Label.equals (label, start)
+                        then let
+                                val live = #live (labelRegInfo start)
+                                val returns =
+                                   Option.map
+                                   (returns, fn returns =>
+                                    Vector.map (returns, Live.StackOffset))
+                             in
+                                Chunk.newBlock
+                                (chunk, 
+                                 {label = funcToLabel name,
+                                  kind = M.Kind.Func,
+                                  live = operandsLive live,
+                                  raises = raises,
+                                  returns = returns,
+                                  statements = Vector.new0 (),
+                                  transfer = M.Transfer.Goto start})
+                             end
+                     else ()
+                  val {live, liveNoFormals, size, ...} = labelRegInfo label
+                  val chunk = labelChunk label
+                  val statements =
+                     Vector.concatV
+                     (Vector.map (statements, fn s =>
+                                  genStatement (s, handlerLinkOffset)))
+                  val (preTransfer, transfer) = genTransfer (transfer, chunk)   
+                  val (kind, live, pre) =
+                     case kind of
+                        R.Kind.Cont _ =>
+                           let
+                              val srcs = callReturnOperands (args, #2, size)
+                           in
+                              (M.Kind.Cont {args = Vector.map (srcs,
+                                                               Live.StackOffset),
+                                            frameInfo = valOf (frameInfo label)},
+                               liveNoFormals,
+                               parallelMove
+                               {chunk = chunk,
+                                dsts = Vector.map (args, varOperand o #1),
+                                srcs = Vector.map (srcs, M.Operand.StackOffset)})
+                           end
+                      | R.Kind.CReturn {func, ...} =>
+                           let
+                              val dst =
+                                 case Vector.length args of
+                                    0 => NONE
+                                  | 1 => SOME (operandLive
+                                               (varOperand
+                                                (#1 (Vector.sub (args, 0)))))
+                                  | _ => Error.bug "Backend.genBlock: CReturn"
+                           in
+                              (M.Kind.CReturn {dst = dst,
+                                               frameInfo = frameInfo label,
+                                               func = func},
+                               liveNoFormals,
+                               Vector.new0 ())
+                           end
+                      | R.Kind.Handler =>
+                           let
+                              val _ =
+                                 List.push
+                                 (handlers, {chunkLabel = Chunk.label chunk,
+                                             label = label})
+                              val dsts = Vector.map (args, varOperand o #1)
+                              val handles =
+                                 raiseOperands (Vector.map (dsts, M.Operand.ty))
+                           in
+                              (M.Kind.Handler
+                               {frameInfo = valOf (frameInfo label),
+                                handles = handles},
+                               liveNoFormals,
+                               M.Statement.moves
+                               {dsts = dsts,
+                                srcs = Vector.map (handles, Live.toOperand)})
+                           end
+                      | R.Kind.Jump => (M.Kind.Jump, live, Vector.new0 ())
+                  val (first, statements) =
+                     if !Control.profile = Control.ProfileTimeLabel
+                        then
+                           case (if 0 = Vector.length statements
+                                    then NONE
+                                 else (case Vector.sub (statements, 0) of
+                                          s as M.Statement.ProfileLabel _ =>
+                                             SOME s
+                                        | _ => NONE)) of
+                              NONE =>
+                                 Error.bug
+                                 (concat ["Backend.genBlock: ",
+                                          "missing ProfileLabel in ",
+                                          Label.toString label])
+                            | SOME s =>
+                                 (Vector.new1 s,
+                                  Vector.dropPrefix (statements, 1))
+                     else (Vector.new0 (), statements)
+                  val statements =
+                     Vector.concat [first, pre, statements, preTransfer]
+                  val returns =
+                     Option.map (returns, fn returns =>
+                                 Vector.map (returns, Live.StackOffset))
+               in
+                  Chunk.newBlock (chunk,
+                                  {kind = kind,
+                                   label = label,
+                                   live = operandsLive live,
+                                   raises = raises,
+                                   returns = returns,
+                                   statements = statements,
+                                   transfer = transfer})
+               end
+            val genBlock = traceGenBlock genBlock
+            val _ = Vector.foreach (blocks, genBlock)
+            val _ =
+               if isMain
+                  then ()
+               else Vector.foreach (blocks, R.Block.clear)
+         in
+            ()
+         end
       val genFunc =
-	 Trace.trace2 ("Backend.genFunc",
-		       Func.layout o Function.name, Bool.layout, Unit.layout)
-	 genFunc
+         Trace.trace2 ("Backend.genFunc",
+                       Func.layout o Function.name, Bool.layout, Unit.layout)
+         genFunc
       (* Generate the main function first.
        * Need to do this in order to set globals.
        *)
@@ -1003,91 +1019,91 @@
       val _ = List.foreach (functions, fn f => genFunc (f, false))
       val chunks = !chunks
       fun chunkToMachine (Chunk.T {chunkLabel, blocks}) =
-	 let
-	    val blocks = Vector.fromList (!blocks)
-	    val regMax = CType.memo (fn _ => ref ~1)
-	    val regsNeedingIndex =
-	       Vector.fold
-	       (blocks, [], fn (b, ac) =>
-		M.Block.foldDefs
-		(b, ac, fn (z, ac) =>
-		 case z of
-		    M.Operand.Register r =>
-		       (case Register.indexOpt r of
-			   NONE => r :: ac
-			 | SOME i =>
-			      let
-				 val z = regMax (Type.toCType (Register.ty r))
-				 val _ =
-				    if i > !z
-				       then z := i
-				    else ()
-			      in
-				 ac
-			      end)
-		  | _ => ac))
-	    val _ =
-	       List.foreach
-	       (regsNeedingIndex, fn r =>
-		let
-		   val z = regMax (Type.toCType (Register.ty r))
-		   val i = 1 + !z
-		   val _ = z := i
-		   val _ = Register.setIndex (r, i)
-		in
-		   ()
-		end)
-	 in
-	    Machine.Chunk.T {chunkLabel = chunkLabel,
-			     blocks = blocks,
-			     regMax = ! o regMax}
-	 end
+         let
+            val blocks = Vector.fromList (!blocks)
+            val regMax = CType.memo (fn _ => ref ~1)
+            val regsNeedingIndex =
+               Vector.fold
+               (blocks, [], fn (b, ac) =>
+                M.Block.foldDefs
+                (b, ac, fn (z, ac) =>
+                 case z of
+                    M.Operand.Register r =>
+                       (case Register.indexOpt r of
+                           NONE => r :: ac
+                         | SOME i =>
+                              let
+                                 val z = regMax (Type.toCType (Register.ty r))
+                                 val _ =
+                                    if i > !z
+                                       then z := i
+                                    else ()
+                              in
+                                 ac
+                              end)
+                  | _ => ac))
+            val _ =
+               List.foreach
+               (regsNeedingIndex, fn r =>
+                let
+                   val z = regMax (Type.toCType (Register.ty r))
+                   val i = 1 + !z
+                   val _ = z := i
+                   val _ = Register.setIndex (r, i)
+                in
+                   ()
+                end)
+         in
+            Machine.Chunk.T {chunkLabel = chunkLabel,
+                             blocks = blocks,
+                             regMax = ! o regMax}
+         end
       val mainName = R.Function.name main
       val main = {chunkLabel = Chunk.label (funcChunk mainName),
-		  label = funcToLabel mainName}
+                  label = funcToLabel mainName}
       val chunks = List.revMap (chunks, chunkToMachine)
       (* The clear is necessary because properties have been attached to Funcs
        * and Labels, and they appear as labels in the resulting program.
        *)
       val _ = List.foreach (chunks, fn M.Chunk.T {blocks, ...} =>
-			    Vector.foreach (blocks, Label.clear o M.Block.label))
+                            Vector.foreach (blocks, Label.clear o M.Block.label))
       val (frameLabels, frameLayouts, frameOffsets) = allFrameInfo ()
       val maxFrameSize: Bytes.t =
-	 List.fold
-	 (chunks, Bytes.zero, fn (M.Chunk.T {blocks, ...}, max) =>
-	  Vector.fold
-	  (blocks, max, fn (M.Block.T {kind, statements, transfer, ...}, max) =>
-	   let
-	      fun doOperand (z: M.Operand.t, max: Bytes.t): Bytes.t =
-		 let
-		    datatype z = datatype M.Operand.t
-		 in
-		    case z of
-		       ArrayOffset {base, index, ...} =>
-			  doOperand (base, doOperand (index, max))
-		     | Cast (z, _) => doOperand (z, max)
-		     | Contents {oper, ...} => doOperand (oper, max)
-		     | Offset {base, ...} => doOperand (base, max)
-		     | StackOffset (StackOffset.T {offset, ty}) =>
-			  Bytes.max (Bytes.+ (offset, Type.bytes ty), max)
-		     | _ => max
-		 end
-	      val max =
-		 case M.Kind.frameInfoOpt kind of
-		    NONE => max
-		  | SOME (M.FrameInfo.T {frameLayoutsIndex, ...}) =>
-		       Bytes.max
-		       (max,
-			#size (Vector.sub (frameLayouts, frameLayoutsIndex)))
-	      val max =
-		 Vector.fold
-		 (statements, max, fn (s, max) =>
-		  M.Statement.foldOperands (s, max, doOperand))
-	      val max =
-		 M.Transfer.foldOperands (transfer, max, doOperand)
-	   in
-	      max
-	   end))
+         List.fold
+         (chunks, Bytes.zero, fn (M.Chunk.T {blocks, ...}, max) =>
+          Vector.fold
+          (blocks, max, fn (M.Block.T {kind, statements, transfer, ...}, max) =>
+           let
+              fun doOperand (z: M.Operand.t, max: Bytes.t): Bytes.t =
+                 let
+                    datatype z = datatype M.Operand.t
+                 in
+                    case z of
+                       ArrayOffset {base, index, ...} =>
+                          doOperand (base, doOperand (index, max))
+                     | Cast (z, _) => doOperand (z, max)
+                     | Contents {oper, ...} => doOperand (oper, max)
+                     | Offset {base, ...} => doOperand (base, max)
+                     | StackOffset (StackOffset.T {offset, ty}) =>
+                          Bytes.max (Bytes.+ (offset, Type.bytes ty), max)
+                     | _ => max
+                 end
+              val max =
+                 case M.Kind.frameInfoOpt kind of
+                    NONE => max
+                  | SOME (M.FrameInfo.T {frameLayoutsIndex, ...}) =>
+                       Bytes.max
+                       (max,
+                        #size (Vector.sub (frameLayouts, frameLayoutsIndex)))
+              val max =
+                 Vector.fold
+                 (statements, max, fn (s, max) =>
+                  M.Statement.foldOperands (s, max, doOperand))
+              val max =
+                 M.Transfer.foldOperands (transfer, max, doOperand)
+           in
+              max
+           end))
       val maxFrameSize = Bytes.wordAlign maxFrameSize
       val profileInfo = makeProfileInfo {frames = frameLabels}
 in

Modified: mlton/branches/on-20050420-cmm-branch/mlton/backend/backend.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/backend/backend.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/backend/backend.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 type int = Int.t
 type word = Word.t
    
@@ -22,7 +23,7 @@
       include BACKEND_STRUCTS
       
       val toMachine:
-	 Ssa.Program.t
-	 * {codegenImplementsPrim: Machine.Type.t Machine.Prim.t -> bool}
-	 -> Machine.Program.t
+         Ssa.Program.t
+         * {codegenImplementsPrim: Machine.Type.t Machine.Prim.t -> bool}
+         -> Machine.Program.t
    end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/backend/chunkify.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/backend/chunkify.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/backend/chunkify.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 functor Chunkify (S: CHUNKIFY_STRUCTS): CHUNKIFY = 
 struct
 
@@ -19,7 +20,7 @@
        val {name, blocks, ...} = Function.dest f
     in
        {funcs = Vector.new1 name,
-	labels = Vector.map (blocks, Block.label)}
+        labels = Vector.map (blocks, Block.label)}
     end)
    
 (* A simple chunkifier that puts all code in the same chunk.
@@ -31,23 +32,23 @@
       Vector.new1
       {funcs = Vector.fromListMap (functions, Function.name),
        labels = Vector.concatV (Vector.fromListMap
-				(functions, fn f =>
-				 Vector.map (Function.blocks f, Block.label)))}
+                                (functions, fn f =>
+                                 Vector.map (Function.blocks f, Block.label)))}
    end
 
 fun blockSize (Block.T {statements, transfer, ...}): int =
    let
       val transferSize =
-	 case transfer of
-	    Switch (Switch.T {cases, ...}) => 1 + Vector.length cases
-	  | _ => 1
+         case transfer of
+            Switch (Switch.T {cases, ...}) => 1 + Vector.length cases
+          | _ => 1
       val statementsSize =
-	 if !Control.profile = Control.ProfileNone
-	    then Vector.length statements
-	 else Vector.fold (statements, 0, fn (s, ac) =>
-			   case s of
-			      Statement.ProfileLabel _ => ac
-			    | _ => 1 + ac)
+         if !Control.profile = Control.ProfileNone
+            then Vector.length statements
+         else Vector.fold (statements, 0, fn (s, ac) =>
+                           case s of
+                              Statement.ProfileLabel _ => ac
+                            | _ => 1 + ac)
    in
       statementsSize + transferSize
    end
@@ -57,46 +58,46 @@
    let
       val functions = main :: functions
       val {get: Func.t -> {returnsTo: Label.t list ref,
-			   tailCalls: Func.t list ref},
-	   rem, ...} =
-	 Property.get (Func.plist,
-		       Property.initFun (fn _ =>
-					 {returnsTo = ref [],
-					  tailCalls = ref []}))
+                           tailCalls: Func.t list ref},
+           rem, ...} =
+         Property.get (Func.plist,
+                       Property.initFun (fn _ =>
+                                         {returnsTo = ref [],
+                                          tailCalls = ref []}))
       fun returnTo (f: Func.t, j: Label.t): unit =
-	 let
-	    val {returnsTo, tailCalls} = get f
-	 in
-	    if List.exists (!returnsTo, fn j' => Label.equals (j, j'))
-	       then ()
-	    else (List.push (returnsTo, j)
-		  ; List.foreach (!tailCalls, fn f => returnTo (f, j)))
-	 end
+         let
+            val {returnsTo, tailCalls} = get f
+         in
+            if List.exists (!returnsTo, fn j' => Label.equals (j, j'))
+               then ()
+            else (List.push (returnsTo, j)
+                  ; List.foreach (!tailCalls, fn f => returnTo (f, j)))
+         end
       fun tailCall (from: Func.t, to: Func.t): unit =
-	 let
-	    val {returnsTo, tailCalls} = get from
-	 in
-	    if List.exists (!tailCalls, fn f => Func.equals (to, f))
-	       then ()
-	    else (List.push (tailCalls, to)
-		  ; List.foreach (!returnsTo, fn j => returnTo (to, j)))
-	 end
+         let
+            val {returnsTo, tailCalls} = get from
+         in
+            if List.exists (!tailCalls, fn f => Func.equals (to, f))
+               then ()
+            else (List.push (tailCalls, to)
+                  ; List.foreach (!returnsTo, fn j => returnTo (to, j)))
+         end
       val _ =
-	 List.foreach
-	 (functions, fn f =>
-	  let
-	     val {name, blocks, ...} = Function.dest f
-	  in
-	     Vector.foreach
-	     (blocks, fn Block.T {transfer, ...} =>
-	      case transfer of
-		 Call {func, return, ...} => (case return of
-						 Return.NonTail {cont, ...} =>
-						    returnTo (func, cont)
-					       | _ => tailCall (name, func))
+         List.foreach
+         (functions, fn f =>
+          let
+             val {name, blocks, ...} = Function.dest f
+          in
+             Vector.foreach
+             (blocks, fn Block.T {transfer, ...} =>
+              case transfer of
+                 Call {func, return, ...} => (case return of
+                                                 Return.NonTail {cont, ...} =>
+                                                    returnTo (func, cont)
+                                               | _ => tailCall (name, func))
 
-	       | _ => ())
-	  end)
+               | _ => ())
+          end)
    in
       {rem = rem,
        returnsTo = ! o #returnsTo o get}
@@ -109,127 +110,127 @@
       val functions = main :: functions
       val graph = Graph.new ()
       val {get = funcClass: Func.t -> Class.t, set = setFuncClass,
-	   rem = remFuncClass, ...} =
-	 Property.getSetOnce (Func.plist,
-			      Property.initRaise ("class", Func.layout))
+           rem = remFuncClass, ...} =
+         Property.getSetOnce (Func.plist,
+                              Property.initRaise ("class", Func.layout))
       val {get = labelClass: Label.t -> Class.t, set = setLabelClass,
-	   rem = remLabelClass, ...} =
-	 Property.getSetOnce (Label.plist,
-			      Property.initRaise ("class", Label.layout))
+           rem = remLabelClass, ...} =
+         Property.getSetOnce (Label.plist,
+                              Property.initRaise ("class", Label.layout))
       (* Build the initial partition.
        * Ensure that all Ssa labels that jump to one another are in the same
        * equivalence class.
        *)
       val _ =
-	 List.foreach
-	 (functions, fn f =>
-	  let
-	     val {name, blocks, start, ...} = Function.dest f
-	     val _ =
-		Vector.foreach
-		(blocks, fn b as Block.T {label, ...} =>
-		 setLabelClass (label,
-				Graph.newClass (graph, {size = blockSize b})))
-	     val _ = setFuncClass (name, labelClass start)
-	     val _ =
-		Vector.foreach
-		(blocks, fn Block.T {label, transfer, ...} =>
-		 let
-		    val c = labelClass label
-		    fun same (j: Label.t): unit =
-		       Graph.== (graph, c, labelClass j)
-		 in
-		    case transfer of
-		       Arith {overflow, success, ...} =>
-			  (same overflow; same success)
-		     | CCall {return, ...} => Option.app (return, same)
-		     | Goto {dst, ...} => same dst
-		     | Switch s => Switch.foreachLabel (s, same)
-		     | _ => ()
-		 end)
-	  in
-	     ()
-	  end)
+         List.foreach
+         (functions, fn f =>
+          let
+             val {name, blocks, start, ...} = Function.dest f
+             val _ =
+                Vector.foreach
+                (blocks, fn b as Block.T {label, ...} =>
+                 setLabelClass (label,
+                                Graph.newClass (graph, {size = blockSize b})))
+             val _ = setFuncClass (name, labelClass start)
+             val _ =
+                Vector.foreach
+                (blocks, fn Block.T {label, transfer, ...} =>
+                 let
+                    val c = labelClass label
+                    fun same (j: Label.t): unit =
+                       Graph.== (graph, c, labelClass j)
+                 in
+                    case transfer of
+                       Arith {overflow, success, ...} =>
+                          (same overflow; same success)
+                     | CCall {return, ...} => Option.app (return, same)
+                     | Goto {dst, ...} => same dst
+                     | Switch s => Switch.foreachLabel (s, same)
+                     | _ => ()
+                 end)
+          in
+             ()
+          end)
       val {returnsTo, rem = remReturnsTo} = returnsTo program
       (* Add edges, and then coalesce the graph. *)
       val _ =
-	 List.foreach
-	 (functions, fn f =>
-	  let
-	     val {name, blocks, ...} = Function.dest f
-	     val returnsTo = List.revMap (returnsTo name, labelClass)
-	     val _ =
-		Vector.foreach
-		(blocks, fn Block.T {label, transfer, ...} =>
-		 case transfer of
-		    Call {func, ...} =>
-		       Graph.addEdge (graph, labelClass label,
-				      funcClass func)
-		  | Return _ =>
-		       let
-			  val from = labelClass label
-		       in
-			  List.foreach
-			  (returnsTo, fn c =>
-			   Graph.addEdge (graph, from, c))
-		       end
-		  | _ => ())
-	  in
-	      ()
-	  end)
+         List.foreach
+         (functions, fn f =>
+          let
+             val {name, blocks, ...} = Function.dest f
+             val returnsTo = List.revMap (returnsTo name, labelClass)
+             val _ =
+                Vector.foreach
+                (blocks, fn Block.T {label, transfer, ...} =>
+                 case transfer of
+                    Call {func, ...} =>
+                       Graph.addEdge (graph, labelClass label,
+                                      funcClass func)
+                  | Return _ =>
+                       let
+                          val from = labelClass label
+                       in
+                          List.foreach
+                          (returnsTo, fn c =>
+                           Graph.addEdge (graph, from, c))
+                       end
+                  | _ => ())
+          in
+              ()
+          end)
       val _ =
-	 if limit = 0
-	    then ()
-	 else Graph.coarsen (graph, {maxClassSize = limit})
+         if limit = 0
+            then ()
+         else Graph.coarsen (graph, {maxClassSize = limit})
       type chunk = {funcs: Func.t list ref,
-		    labels: Label.t list ref}
+                    labels: Label.t list ref}
       val chunks: chunk list ref = ref []
       val {get = classChunk: Class.t -> chunk, ...} =
-	 Property.get
-	 (Class.plist,
-	  Property.initFun (fn _ =>
-			    let
-			       val c = {funcs = ref [],
-					labels = ref []}
-			       val _ = List.push (chunks, c)
-			    in
-			       c
-			    end))
+         Property.get
+         (Class.plist,
+          Property.initFun (fn _ =>
+                            let
+                               val c = {funcs = ref [],
+                                        labels = ref []}
+                               val _ = List.push (chunks, c)
+                            in
+                               c
+                            end))
       val _ =
-	 let
-	    fun 'a new (l: 'a,
-			get: 'a -> Class.t,
-			sel: chunk -> 'a list ref): unit =
-	       List.push (sel (classChunk (get l)), l)
-	    val _ =
-	       List.foreach
-	       (functions, fn f =>
-		let
-		   val {name, blocks, ...} = Function.dest f
-		   val _ = new (name, funcClass, #funcs)
-		   val _ =
-		      Vector.foreach
-		      (blocks, fn Block.T {label, ...} =>
-		       new (label, labelClass, #labels))
-		in ()
-		end)
-	 in ()
-	 end
+         let
+            fun 'a new (l: 'a,
+                        get: 'a -> Class.t,
+                        sel: chunk -> 'a list ref): unit =
+               List.push (sel (classChunk (get l)), l)
+            val _ =
+               List.foreach
+               (functions, fn f =>
+                let
+                   val {name, blocks, ...} = Function.dest f
+                   val _ = new (name, funcClass, #funcs)
+                   val _ =
+                      Vector.foreach
+                      (blocks, fn Block.T {label, ...} =>
+                       new (label, labelClass, #labels))
+                in ()
+                end)
+         in ()
+         end
       val _ =
-	 List.foreach
-	 (functions, fn f =>
-	  let
-	     val {blocks, name, ...} = Function.dest f
-	     val _ = remFuncClass name
-	     val _ = remReturnsTo name
-	     val _ = Vector.foreach (blocks, remLabelClass o Block.label)
-	  in
-	     ()
-	  end)
+         List.foreach
+         (functions, fn f =>
+          let
+             val {blocks, name, ...} = Function.dest f
+             val _ = remFuncClass name
+             val _ = remReturnsTo name
+             val _ = Vector.foreach (blocks, remLabelClass o Block.label)
+          in
+             ()
+          end)
    in 
       Vector.fromListMap (!chunks, fn {funcs, labels} =>
-			  {funcs = Vector.fromList (!funcs),
-			   labels = Vector.fromList (!labels)})
+                          {funcs = Vector.fromList (!funcs),
+                           labels = Vector.fromList (!labels)})
    end
 
 fun chunkify p =
@@ -243,20 +244,20 @@
    let
       val chunks = chunkify p
       val _ = 
-	 Control.diagnostics
-	 (fn display =>
-	  let
-	     open Layout
-	     val _ = display (str "Chunkification:")
-	     val _ =
-		Vector.foreach
-		(chunks, fn {funcs, labels} =>
-		 display
-		 (record ([("funcs", Vector.layout Func.layout funcs),
-			   ("jumps", Vector.layout Label.layout labels)])))
-	  in
-	     ()
-	  end)
+         Control.diagnostics
+         (fn display =>
+          let
+             open Layout
+             val _ = display (str "Chunkification:")
+             val _ =
+                Vector.foreach
+                (chunks, fn {funcs, labels} =>
+                 display
+                 (record ([("funcs", Vector.layout Func.layout funcs),
+                           ("jumps", Vector.layout Label.layout labels)])))
+          in
+             ()
+          end)
    in
       chunks
    end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/backend/chunkify.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/backend/chunkify.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/backend/chunkify.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 type int = Int.t
 
 signature CHUNKIFY_STRUCTS = 
@@ -22,7 +23,7 @@
        * All conts and handlers are assumed to be return points.
        *)
       val chunkify: Program.t -> {
-				  funcs: Func.t vector,
-				  labels: Label.t vector
-				  } vector
+                                  funcs: Func.t vector,
+                                  labels: Label.t vector
+                                  } vector
    end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/backend/equivalence-graph.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/backend/equivalence-graph.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/backend/equivalence-graph.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 functor EquivalenceGraph (S: EQUIVALENCE_GRAPH_STRUCTS): EQUIVALENCE_GRAPH = 
 struct
 
@@ -16,39 +17,39 @@
 structure Class =
    struct
       datatype t = T of {plist: Plist.t,
-			 size: int ref} Set.t
+                         size: int ref} Set.t
 
       local
-	 fun make sel (T s) = sel (Set.! s)
+         fun make sel (T s) = sel (Set.! s)
       in
-	 val plist = make #plist
-	 val size = make (! o #size)
+         val plist = make #plist
+         val size = make (! o #size)
       end
 
       fun setSize (T s, n) = #size (Set.! s) := n
 
       fun new (size: int): t =
-	 T (Set.singleton {plist = Plist.new (),
-			   size = ref size})
+         T (Set.singleton {plist = Plist.new (),
+                           size = ref size})
 
       fun == (c as T s, T s') =
-	 if Set.equals (s, s')
-	    then ()
-	 else
-	    let
-	       val {size = ref n, ...} = Set.! s
-	       val {size = ref n', ...} = Set.! s'
-	    in
-	       Set.union (s, s')
-	       ; setSize (c, n + n')
-	    end
+         if Set.equals (s, s')
+            then ()
+         else
+            let
+               val {size = ref n, ...} = Set.! s
+               val {size = ref n', ...} = Set.! s'
+            in
+               Set.union (s, s')
+               ; setSize (c, n + n')
+            end
    end
 
 datatype t = T of {classes: Class.t list ref,
-		   edges: (Class.t * Class.t) list ref}
+                   edges: (Class.t * Class.t) list ref}
 
 fun new () = T {classes = ref [],
-		edges = ref []}
+                edges = ref []}
 
 fun newClass (T {classes, ...}, {size}) =
    let
@@ -67,46 +68,46 @@
    let
       (* Combine classes with an edge between them where possible. *)
       val _ =
-	 List.foreach (!edges, fn (c, c') =>
-		       if Class.size c + Class.size c' <= maxClassSize
-			  then Class.== (c, c')
-		       else ())
+         List.foreach (!edges, fn (c, c') =>
+                       if Class.size c + Class.size c' <= maxClassSize
+                          then Class.== (c, c')
+                       else ())
       (* Get a list of all classes without duplicates. *)
       val {get, ...} =
-	 Property.get (Class.plist, Property.initFun (fn _ => ref false))
+         Property.get (Class.plist, Property.initFun (fn _ => ref false))
       val classes =
-	 List.fold
-	 (!classes, [], fn (class, ac) =>
-	  let
-	     val r = get class
-	  in
-	     if !r
-		then ac
-	     else (r := true
-		   ; class :: ac)
-	  end)
+         List.fold
+         (!classes, [], fn (class, ac) =>
+          let
+             val r = get class
+          in
+             if !r
+                then ac
+             else (r := true
+                   ; class :: ac)
+          end)
       (* Sort classes in decreasing order of size. *)
       val classes =
-	 QuickSort.sortList (classes, fn (c, c') =>
-			     Class.size c >= Class.size c')
+         QuickSort.sortList (classes, fn (c, c') =>
+                             Class.size c >= Class.size c')
       (* Combine classes where possible. *)
       fun loop (cs: Class.t list): unit =
-	 case cs of
-	    [] => ()
-	  | c :: cs =>
-	       loop
-	       (rev
-		(List.fold
-		 (cs, [], fn (c', ac) =>
-		  if Class.size c  + Class.size c' <= maxClassSize
-		     then (Class.== (c, c')
-			   ; ac)
-		  else c' :: ac)))
+         case cs of
+            [] => ()
+          | c :: cs =>
+               loop
+               (rev
+                (List.fold
+                 (cs, [], fn (c', ac) =>
+                  if Class.size c  + Class.size c' <= maxClassSize
+                     then (Class.== (c, c')
+                           ; ac)
+                  else c' :: ac)))
       val _ = loop classes
    in
       ()
    end
-	 
+         
 end
 
 structure EquivalenceGraph = EquivalenceGraph ()

Modified: mlton/branches/on-20050420-cmm-branch/mlton/backend/equivalence-graph.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/backend/equivalence-graph.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/backend/equivalence-graph.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 type int = Int.t
    
 signature EQUIVALENCE_GRAPH_STRUCTS = 
@@ -24,12 +25,12 @@
       include EQUIVALENCE_GRAPH_STRUCTS
       
       structure Class:
-	 sig
-	    (* The type of equivalence classes. *)
-	    type t
+         sig
+            (* The type of equivalence classes. *)
+            type t
 
-	    val plist: t -> PropertyList.t
-	 end
+            val plist: t -> PropertyList.t
+         end
 
       (* The type of equivalence graphs. *)
       type t

Modified: mlton/branches/on-20050420-cmm-branch/mlton/backend/err.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/backend/err.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/backend/err.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,41 +1,42 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 structure Err =
    struct
       datatype t = T of {inner: t option,
-			 name: string,
-			 obj: Layout.t}
+                         name: string,
+                         obj: Layout.t}
 
       fun layout (T {inner, name, obj}): Layout.t =
-	 let
-	    open Layout
-	 in
-	    align [case inner of
-		      NONE => empty
-		    | SOME e => layout e,
-	           seq [str (concat ["invalid ", name, ": "]), obj]]
-	 end
+         let
+            open Layout
+         in
+            align [case inner of
+                      NONE => empty
+                    | SOME e => layout e,
+                   seq [str (concat ["invalid ", name, ": "]), obj]]
+         end
 
       exception E of t
     
       fun check' (name: string,
-		  ok: unit -> 'a option,
-		  layout: unit -> Layout.t): 'a =
-	 case ok () handle E e => raise E (T {inner = SOME e,
-					      name = name,
-					      obj = layout ()}) of
-	    NONE => raise E (T {inner = NONE,
-				name = name,
-				obj = layout ()})
-	  | SOME a => a
-	       
+                  ok: unit -> 'a option,
+                  layout: unit -> Layout.t): 'a =
+         case ok () handle E e => raise E (T {inner = SOME e,
+                                              name = name,
+                                              obj = layout ()}) of
+            NONE => raise E (T {inner = NONE,
+                                name = name,
+                                obj = layout ()})
+          | SOME a => a
+               
       fun boolToUnitOpt b = if b then SOME () else NONE
 
       fun check (name, ok, layout) =
-	 check' (name, boolToUnitOpt o ok, layout)
+         check' (name, boolToUnitOpt o ok, layout)
    end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/backend/implement-handlers.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/backend/implement-handlers.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/backend/implement-handlers.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 functor ImplementHandlers (S: IMPLEMENT_HANDLERS_STRUCTS): IMPLEMENT_HANDLERS = 
 struct
 
@@ -18,18 +19,18 @@
       open Function
 
       fun hasHandler (f: t): bool =
-	 let
-	    val {blocks, ...} = dest f
-	 in
-	    Vector.exists
-	    (blocks, fn Block.T {transfer, ...} =>
-	     case transfer of
-		Transfer.Call
-		{return = (Return.NonTail
-			   {handler = Handler.Handle _, ...}), ...} =>
-		   true
+         let
+            val {blocks, ...} = dest f
+         in
+            Vector.exists
+            (blocks, fn Block.T {transfer, ...} =>
+             case transfer of
+                Transfer.Call
+                {return = (Return.NonTail
+                           {handler = Handler.Handle _, ...}), ...} =>
+                   true
               | _ => false)
-	 end
+         end
    end
 
 structure HandlerLat = FlatLattice (structure Point = Label)
@@ -37,24 +38,24 @@
 structure ExnStack =
    struct
       local
-	 structure ZPoint =
-	    struct
-	       datatype t = Local | Slot
-	       
-	       val equals: t * t -> bool = op =
-	       
-	       val toString =
-		  fn Local => "Local"
-		   | Slot => "Slot"
+         structure ZPoint =
+            struct
+               datatype t = Local | Slot
+               
+               val equals: t * t -> bool = op =
+               
+               val toString =
+                  fn Local => "Local"
+                   | Slot => "Slot"
 
-	       val layout = Layout.str o toString
-	    end
-	 structure L = FlatLattice (structure Point = ZPoint)
+               val layout = Layout.str o toString
+            end
+         structure L = FlatLattice (structure Point = ZPoint)
       in
-	 open L
-	 structure Point = ZPoint
-	 val locall = point Point.Local
-	 val slot = point Point.Slot
+         open L
+         structure Point = ZPoint
+         val locall = point Point.Local
+         val slot = point Point.Slot
       end
    end
 
@@ -65,216 +66,153 @@
    let
       val debug = false
       val {args, blocks, name, raises, returns, start} =
-	 Function.dest f
+         Function.dest f
       val {get = labelInfo: Label.t -> {global: ExnStack.t,
-					handler: HandlerLat.t},
-	   rem, ...} =
-	 Property.get (Label.plist,
-		       Property.initFun (fn _ =>
-					 {global = ExnStack.new (),
-					  handler = HandlerLat.new ()}))
+                                        handler: HandlerLat.t},
+           rem, ...} =
+         Property.get (Label.plist,
+                       Property.initFun (fn _ =>
+                                         {global = ExnStack.new (),
+                                          handler = HandlerLat.new ()}))
       val _ =
-	 Vector.foreach
-	 (blocks, fn Block.T {label, transfer, ...} =>
-	  let
-	     val {global, handler} = labelInfo label
-	     val _ =
-		if Label.equals (label, start)
-		   then let
-			   val _ = ExnStack.<= (ExnStack.slot, global)
-			   val _ = HandlerLat.forceTop handler
-			in
-			   ()
-			end
-		else ()
-	     fun goto' {global = g, handler = h}: unit =
-		let
-		   val _ = ExnStack.<= (global, g)
-		   val _ = HandlerLat.<= (handler, h)
-		in
-		   ()
-		end
-	     val goto = goto' o labelInfo
-	  in
-	     case transfer of
-		Call {return, ...} =>
-		   (case return of
-		       Return.Dead => ()
-		     | Return.NonTail {cont, handler = h} =>
-			  let
-			     val li as {global = g', handler = h'} =
-				labelInfo cont
-			  in
-			     case h of
-				Handler.Caller =>
-				   let
-				      val _ = ExnStack.<= (ExnStack.slot, g')
-				      val _ = HandlerLat.<= (handler, h')
-				   in
-				      ()
-				   end
-			      | Handler.Dead => goto' li
-			      | Handler.Handle l =>
-				   let
-				      fun doit {global = g'', handler = h''} =
-					 let
-					    val _ = ExnStack.<= (ExnStack.locall, g'')
-					    val _ = HandlerLat.<= (HandlerLat.point l, h'')
-					 in
-					    ()
-					 end
-				   in
-				      doit (labelInfo l)
-				      ; doit li
-				   end
-			  end
-		     | Return.Tail => ())
-	      | _ => Transfer.foreachLabel (transfer, goto)
-	  end)
+         Vector.foreach
+         (blocks, fn Block.T {label, transfer, ...} =>
+          let
+             val {global, handler} = labelInfo label
+             val _ =
+                if Label.equals (label, start)
+                   then let
+                           val _ = ExnStack.<= (ExnStack.slot, global)
+                           val _ = HandlerLat.forceTop handler
+                        in
+                           ()
+                        end
+                else ()
+             fun goto' {global = g, handler = h}: unit =
+                let
+                   val _ = ExnStack.<= (global, g)
+                   val _ = HandlerLat.<= (handler, h)
+                in
+                   ()
+                end
+             val goto = goto' o labelInfo
+          in
+             case transfer of
+                Call {return, ...} =>
+                   (case return of
+                       Return.Dead => ()
+                     | Return.NonTail {cont, handler = h} =>
+                          let
+                             val li as {global = g', handler = h'} =
+                                labelInfo cont
+                          in
+                             case h of
+                                Handler.Caller =>
+                                   let
+                                      val _ = ExnStack.<= (ExnStack.slot, g')
+                                      val _ = HandlerLat.<= (handler, h')
+                                   in
+                                      ()
+                                   end
+                              | Handler.Dead => goto' li
+                              | Handler.Handle l =>
+                                   let
+                                      fun doit {global = g'', handler = h''} =
+                                         let
+                                            val _ = ExnStack.<= (ExnStack.locall, g'')
+                                            val _ = HandlerLat.<= (HandlerLat.point l, h'')
+                                         in
+                                            ()
+                                         end
+                                   in
+                                      doit (labelInfo l)
+                                      ; doit li
+                                   end
+                          end
+                     | Return.Tail => ())
+              | _ => Transfer.foreachLabel (transfer, goto)
+          end)
       val _ =
-	 if debug
-	    then
-	       Layout.outputl
-	       (Vector.layout
-		(fn Block.T {label, ...} =>
-		 let
-		    val {global, handler} = labelInfo label
-		 in
-		    Layout.record [("label", Label.layout label),
-				   ("global", ExnStack.layout global),
-				   ("handler", HandlerLat.layout handler)]
-		 end)
-		blocks,
-		Out.error)
-	 else ()
+         if debug
+            then
+               Layout.outputl
+               (Vector.layout
+                (fn Block.T {label, ...} =>
+                 let
+                    val {global, handler} = labelInfo label
+                 in
+                    Layout.record [("label", Label.layout label),
+                                   ("global", ExnStack.layout global),
+                                   ("handler", HandlerLat.layout handler)]
+                 end)
+                blocks,
+                Out.error)
+         else ()
       val blocks =
-	 Vector.map
-	 (blocks,
-	  fn Block.T {args, kind, label, statements, transfer} =>
-	  let
-	     val {global, handler} = labelInfo label
-	     fun setExnStackSlot () =
-		if ExnStack.isPointEq (global, ExnStack.Point.Slot)
-		   then Vector.new0 ()
-		else Vector.new1 SetExnStackSlot
-	     fun setExnStackLocal () =
-		if ExnStack.isPointEq (global, ExnStack.Point.Local)
-		   then Vector.new0 ()
-		else Vector.new1 SetExnStackLocal
-	     fun setHandler (l: Label.t) =
-		if HandlerLat.isPointEq (handler, l)
-		   then Vector.new0 ()
-		else Vector.new1 (SetHandler l)
-	     val post =
-		case transfer of
-		   Call {return, ...} =>
-		      (case return of
-			  Return.Dead => Vector.new0 ()
-			| Return.NonTail {handler, ...} =>
-			     (case handler of
-				 Handler.Caller => setExnStackSlot ()
-			       | Handler.Dead => Vector.new0 ()
-			       | Handler.Handle l =>
-				    Vector.concat
-				    [setHandler l, setExnStackLocal ()])
-			| Return.Tail => setExnStackSlot ())
-		 | Raise _ => setExnStackSlot ()
-		 | Return _ => setExnStackSlot ()
-		 | _ => Vector.new0 ()
-	     val statements = Vector.concat [statements, post]
-	  in
-	     Block.T {args = args,
-		      kind = kind,
-		      label = label,
-		      statements = statements,
-		      transfer = transfer}
-	  end)
+         Vector.map
+         (blocks,
+          fn Block.T {args, kind, label, statements, transfer} =>
+          let
+             val {global, handler} = labelInfo label
+             fun setExnStackSlot () =
+                if ExnStack.isPointEq (global, ExnStack.Point.Slot)
+                   then Vector.new0 ()
+                else Vector.new1 SetExnStackSlot
+             fun setExnStackLocal () =
+                if ExnStack.isPointEq (global, ExnStack.Point.Local)
+                   then Vector.new0 ()
+                else Vector.new1 SetExnStackLocal
+             fun setHandler (l: Label.t) =
+                if HandlerLat.isPointEq (handler, l)
+                   then Vector.new0 ()
+                else Vector.new1 (SetHandler l)
+             val post =
+                case transfer of
+                   Call {return, ...} =>
+                      (case return of
+                          Return.Dead => Vector.new0 ()
+                        | Return.NonTail {handler, ...} =>
+                             (case handler of
+                                 Handler.Caller => setExnStackSlot ()
+                               | Handler.Dead => Vector.new0 ()
+                               | Handler.Handle l =>
+                                    Vector.concat
+                                    [setHandler l, setExnStackLocal ()])
+                        | Return.Tail => setExnStackSlot ())
+                 | Raise _ => setExnStackSlot ()
+                 | Return _ => setExnStackSlot ()
+                 | _ => Vector.new0 ()
+             val statements = Vector.concat [statements, post]
+          in
+             Block.T {args = args,
+                      kind = kind,
+                      label = label,
+                      statements = statements,
+                      transfer = transfer}
+          end)
       val newStart = Label.newNoname ()
       val startBlock =
-	 Block.T {args = Vector.new0 (),
-		  kind = Kind.Jump,
-		  label = newStart,
-		  statements = Vector.new1 SetSlotExnStack,
-		  transfer = Goto {args = Vector.new0 (),
-				   dst = start}}
+         Block.T {args = Vector.new0 (),
+                  kind = Kind.Jump,
+                  label = newStart,
+                  statements = Vector.new1 SetSlotExnStack,
+                  transfer = Goto {args = Vector.new0 (),
+                                   dst = start}}
       val blocks = Vector.concat [blocks, Vector.new1 startBlock]
       val () = Vector.foreach (blocks, rem o Block.label)
    in
       Function.new {args = args,
-		    blocks = blocks,
-		    name = name,
-		    raises = raises,
-		    returns = returns,
-		    start = newStart}
+                    blocks = blocks,
+                    name = name,
+                    raises = raises,
+                    returns = returns,
+                    start = newStart}
    end
 
-fun simple (f: Function.t): Function.t =
-   if not (Function.hasHandler f)
-      then f
-   else
-   let
-      val {args, blocks, name, raises, returns, start} =
-	 Function.dest f
-      val blocks =
-	 Vector.map
-	 (blocks,
-	  fn Block.T {args, kind, label, statements, transfer} =>
-	  let
-	     val post =
-		case transfer of
-		   Call {return, ...} =>
-		      (case return of
-			  Return.Dead => Vector.new0 ()
-			| Return.NonTail {handler, ...} =>
-			     (case handler of
-				 Handler.Caller =>
-				    Vector.new1 SetExnStackSlot
-			       | Handler.Dead => Vector.new0 ()
-			       | Handler.Handle l =>
-				    Vector.new2 (SetHandler l,
-						 SetExnStackLocal))
-			| Return.Tail =>
-			     Vector.new1 SetExnStackSlot)
-		 | Raise _ => Vector.new1 SetExnStackSlot
-		 | Return _ => Vector.new1 SetExnStackSlot
-		 | _ => Vector.new0 ()
-	     val statements = Vector.concat [statements, post]
-	  in
-	     Block.T {args = args,
-		      kind = kind,
-		      label = label,
-		      statements = statements,
-		      transfer = transfer}
-	  end)
-      val newStart = Label.newNoname ()
-      val startBlock =
-	 Block.T {args = Vector.new0 (),
-		  kind = Kind.Jump,
-		  label = newStart,
-		  statements = Vector.new1 SetSlotExnStack,
-		  transfer = Goto {args = Vector.new0 (),
-				   dst = start}}
-      val blocks = Vector.concat [blocks, Vector.new1 startBlock]
-   in
-      Function.new {args = args,
-		    blocks = blocks,
-		    name = name,
-		    raises = raises,
-		    returns = returns,
-		    start = newStart}
-   end
-
 fun doit (Program.T {functions, handlesSignals, main, objectTypes}) =
-   let
-      val implementFunction =
-	 case !Control.handlers of
-	    Control.Flow => flow
-	  | Control.Simple => simple
-   in
-      Program.T {functions = List.revMap (functions, implementFunction),
-		 handlesSignals = handlesSignals,
-		 main = implementFunction main,
-		 objectTypes = objectTypes}
-   end
+   Program.T {functions = List.revMap (functions, flow),
+              handlesSignals = handlesSignals,
+              main = flow main,
+              objectTypes = objectTypes}
 
 end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/backend/implement-handlers.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/backend/implement-handlers.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/backend/implement-handlers.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature IMPLEMENT_HANDLERS_STRUCTS = 
    sig
       structure Rssa: RSSA

Modified: mlton/branches/on-20050420-cmm-branch/mlton/backend/limit-check.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/backend/limit-check.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/backend/limit-check.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,21 +1,22 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 (*
  * The goal of limit check insertion is to ensure that
- * 	1. At any allocation of b bytes, frontier + b <= base + heapSize
- * 	2. At entry to each function, stackTop <= stackLimit
+ *      1. At any allocation of b bytes, frontier + b <= base + heapSize
+ *      2. At entry to each function, stackTop <= stackLimit
  * 
  * It assumes that runtime provides several operands to help with this.
- * 	Frontier
- * 	Limit
- * 	LimitPlusSlop
- * 	StackLimit
- * 	StackTop
+ *      Frontier
+ *      Limit
+ *      LimitPlusSlop
+ *      StackLimit
+ *      StackTop
  * 
  * There are three different kinds of checks inserted, depending on the
  * amount being allocated and whether or not the program uses signal
@@ -23,11 +24,11 @@
  * 
  * 1. If b <= LIMIT_SLOP, then continue (don't GC) if
  * 
- * 	frontier <= limit
+ *      frontier <= limit
  * 
  *    The reason this works is that if frontier <= limit and b <=
  *    LIMIT_SLOP, then 
- * 	frontier + b <= limit + LIMIT_SLOP 
+ *      frontier + b <= limit + LIMIT_SLOP 
  *                       = limitPlusSlop
  *                       = base + heapSize
  *    This works even if the program uses signal handlers, which set
@@ -36,11 +37,11 @@
  * 2. If b > LIMIT_SLOP and if the program doesn't use signal handlers,
  *    then continue (don't GC) if
  * 
- * 	b <= limitPlusSlop - frontier
+ *      b <= limitPlusSlop - frontier
  * 
  *    The reason this works is that the condition is equivalent to
- * 	
- * 	b + frontier <= limitPlusSlop = base + heapSize
+ *      
+ *      b + frontier <= limitPlusSlop = base + heapSize
  * 
  *    We write the condition the way we do instead of the more obvious way
  *    because "b + frontier" may overflow, while limitPlusSlop - frontier
@@ -49,8 +50,8 @@
  * 3. If b > LIMIT_SLOP and if the program uses signal handlers, then
  *    continue (don't GC) if
  * 
- * 	limit > 0
- * 	and b <= limitPlusSlop - frontier
+ *      limit > 0
+ *      and b <= limitPlusSlop - frontier
  * 
  *    This is like case (2), except that because the program uses signal
  *    handlers, the runtime may have set limit to zero to indicate that a
@@ -66,6 +67,26 @@
 open S
 open Rssa
 
+structure LimitCheck =
+   struct
+      datatype t = 
+         PerBlock
+       | ExtBasicBlocks
+       | LoopHeaders of {fullCFG: bool,
+                         loopExits: bool}
+   end
+
+structure Control =
+   struct
+      open Control
+
+      datatype limitCheck = datatype LimitCheck.t
+
+      val limitCheck =
+         ref (LoopHeaders {fullCFG = false,
+                           loopExits = true})
+   end
+   
 datatype z = datatype Transfer.t
    
 structure CFunction =
@@ -78,9 +99,9 @@
       open Statement
 
       fun bytesAllocated (s: t): Bytes.t =
-	 case s of
-	    Object {size, ...} => Words.toBytes size
-	  | _ => Bytes.zero
+         case s of
+            Object {size, ...} => Words.toBytes size
+          | _ => Bytes.zero
    end
 
 structure Transfer =
@@ -88,34 +109,34 @@
       open Transfer
 
       datatype bytesAllocated =
-	 Big of Operand.t
+         Big of Operand.t
        | Small of Bytes.t
-	 
+         
       fun bytesAllocated (t: t): bytesAllocated =
-	 case t of
-	    CCall {args, func, ...} =>
-	       (case CFunction.bytesNeeded func of
-		   NONE => Small Bytes.zero
-		 | SOME i =>
-		      let
-			 val z = Vector.sub (args, i)
-		      in
-			 case z of
-			    Operand.Const c =>
-			       (case c of
-				   Const.Word w =>
-				      let
-					 val w = WordX.toIntInf w
-				      in
-					 (* 512 is small and arbitrary *)
-					 if w <= 512 
-					    then Small (Bytes.fromIntInf w)
-					 else Big z
-				      end
-				 | _ => Error.bug "strange numBytes")
-			  | _ => Big z
-		      end)
-	  | _ => Small Bytes.zero
+         case t of
+            CCall {args, func, ...} =>
+               (case CFunction.bytesNeeded func of
+                   NONE => Small Bytes.zero
+                 | SOME i =>
+                      let
+                         val z = Vector.sub (args, i)
+                      in
+                         case z of
+                            Operand.Const c =>
+                               (case c of
+                                   Const.Word w =>
+                                      let
+                                         val w = WordX.toIntInf w
+                                      in
+                                         (* 512 is small and arbitrary *)
+                                         if w <= 512 
+                                            then Small (Bytes.fromIntInf w)
+                                         else Big z
+                                      end
+                                 | _ => Error.bug "LimitCheck.Transfer.bytesAllocated: strange numBytes")
+                          | _ => Big z
+                      end)
+          | _ => Small Bytes.zero
    end
 
 structure Block =
@@ -123,353 +144,353 @@
       open Block
 
       fun objectBytesAllocated (T {statements, transfer, ...}): Bytes.t =
-	 Bytes.+
-	 (Vector.fold (statements, Bytes.zero, fn (s, ac) =>
-		       Bytes.+ (ac, Statement.bytesAllocated s)),
-	  case Transfer.bytesAllocated transfer of
-	     Transfer.Big _ => Bytes.zero
-	   | Transfer.Small b => b)
+         Bytes.+
+         (Vector.fold (statements, Bytes.zero, fn (s, ac) =>
+                       Bytes.+ (ac, Statement.bytesAllocated s)),
+          case Transfer.bytesAllocated transfer of
+             Transfer.Big _ => Bytes.zero
+           | Transfer.Small b => b)
    end
 
 val extraGlobals: Var.t list ref = ref []
    
 fun insertFunction (f: Function.t,
-		    handlesSignals: bool,
-		    blockCheckAmount: {blockIndex: int} -> Bytes.t,
-		    ensureFree: Label.t -> Bytes.t) =
+                    handlesSignals: bool,
+                    blockCheckAmount: {blockIndex: int} -> Bytes.t,
+                    ensureFree: Label.t -> Bytes.t) =
    let
       val {args, blocks, name, raises, returns, start} = Function.dest f
       val lessThan = Prim.wordLt (WordSize.default, {signed = false})
       val newBlocks = ref []
       local
-	 val r: Label.t option ref = ref NONE
+         val r: Label.t option ref = ref NONE
       in
-	 fun allocTooLarge () =
-	    case !r of
-	       SOME l => l
-	     | NONE =>
-		  let
-		     val l = Label.newNoname ()
-		     val _ = r := SOME l
-		     val cfunc =
-			CFunction.T {args = Vector.new0 (),
-				     bytesNeeded = NONE,
-				     convention = CFunction.Convention.Cdecl,
-				     ensuresBytesFree = false,
-				     mayGC = false,
-				     maySwitchThreads = false,
-				     modifiesFrontier = false,
-				     prototype = (Vector.new0 (), NONE),
-				     readsStackTop = false,
-				     return = Type.unit,
-				     target = CFunction.Target.Direct "MLton_allocTooLarge",
-				     writesStackTop = false}
-		     val _ =
-			newBlocks :=
-			Block.T {args = Vector.new0 (),
-				 kind = Kind.Jump,
-				 label = l,
-				 statements = Vector.new0 (),
-				 transfer =
-				 Transfer.CCall {args = Vector.new0 (),
-						 func = cfunc,
-						 return = NONE}}
-			:: !newBlocks
-		  in
-		     l
-		  end
+         fun allocTooLarge () =
+            case !r of
+               SOME l => l
+             | NONE =>
+                  let
+                     val l = Label.newNoname ()
+                     val _ = r := SOME l
+                     val cfunc =
+                        CFunction.T {args = Vector.new0 (),
+                                     bytesNeeded = NONE,
+                                     convention = CFunction.Convention.Cdecl,
+                                     ensuresBytesFree = false,
+                                     mayGC = false,
+                                     maySwitchThreads = false,
+                                     modifiesFrontier = false,
+                                     prototype = (Vector.new0 (), NONE),
+                                     readsStackTop = false,
+                                     return = Type.unit,
+                                     target = CFunction.Target.Direct "MLton_allocTooLarge",
+                                     writesStackTop = false}
+                     val _ =
+                        newBlocks :=
+                        Block.T {args = Vector.new0 (),
+                                 kind = Kind.Jump,
+                                 label = l,
+                                 statements = Vector.new0 (),
+                                 transfer =
+                                 Transfer.CCall {args = Vector.new0 (),
+                                                 func = cfunc,
+                                                 return = NONE}}
+                        :: !newBlocks
+                  in
+                     l
+                  end
       end
       val _ =
-	 Vector.foreachi
-	 (blocks, fn (i, Block.T {args, kind, label, statements, transfer}) =>
-	  let
-	     val transfer = 
-		case transfer of
-		   Transfer.CCall {args, func, return} =>
-		      (if CFunction.ensuresBytesFree func
-			  then 
-			     Transfer.CCall
-			     {args = (Vector.map
-				      (args, fn z =>
-				       case z of
-					  Operand.EnsuresBytesFree =>
-					     Operand.word
-					     (WordX.fromIntInf
-					      (Bytes.toIntInf
-					       (ensureFree (valOf return)),
-					       WordSize.default))
-					| _ => z)),
-			      func = func,
-			      return = return}
-		       else transfer)
-		 | _ => transfer
-	     val stack = Label.equals (start, label)
-	     fun insert (amount: Operand.t (* of type word *)) =
-		let
-		   val collect = Label.newNoname ()
-		   val collectReturn = Label.newNoname ()
-		   val dontCollect = Label.newNoname ()
-		   val (dontCollect', collectReturnStatements, force) =
-		      case !Control.gcCheck of
-			 Control.First =>
-			    let
-			       val global = Var.newNoname ()
-			       val _ = List.push (extraGlobals, global)
-			       val global =
-				  Operand.Var {var = global,
-					       ty = Type.bool}
-			       val dontCollect' = Label.newNoname ()
-			       val _ =
-				  List.push
-				  (newBlocks,
-				   Block.T
-				   {args = Vector.new0 (),
-				    kind = Kind.Jump,
-				    label = dontCollect',
-				    statements = Vector.new0 (),
-				    transfer =
-				    Transfer.ifBool
-				    (global, {falsee = dontCollect,
-					      truee = collect})})
-			    in
-			       (dontCollect',
-				Vector.new1
-				(Statement.Move {dst = global,
-						 src = Operand.bool false}),
-				global)
-			    end
-		       | Control.Limit =>
-			    (dontCollect, Vector.new0 (), Operand.bool false)
-		       | Control.Every =>
-			    (collect, Vector.new0 (), Operand.bool true)
-		   val func = CFunction.gc {maySwitchThreads = handlesSignals}
-		   val _ = 
-		      newBlocks :=
-		      Block.T {args = Vector.new0 (),
-			       kind = Kind.Jump,
-			       label = collect,
-			       statements = Vector.new0 (),
-			       transfer = (Transfer.CCall
-					   {args = Vector.new5 (Operand.GCState,
-								amount,
-								force,
-								Operand.File,
-								Operand.Line),
-					    func = func,
-					    return = SOME collectReturn})}
-		      :: (Block.T
-			  {args = Vector.new0 (),
-			   kind = Kind.CReturn {func = func},
-			   label = collectReturn,
-			   statements = collectReturnStatements,
-			   transfer = Transfer.Goto {dst = dontCollect,
-						     args = Vector.new0 ()}})
-		      :: Block.T {args = Vector.new0 (),
-				  kind = Kind.Jump,
-				  label = dontCollect,
-				  statements = statements,
-				  transfer = transfer}
-		      :: !newBlocks
-		in
-		   {collect = collect,
-		    dontCollect = dontCollect'}
-		end
-	     fun newBlock (isFirst, statements, transfer) =
-		let
-		   val (args, kind, label) =
-		      if isFirst
-			 then (args, kind, label)
-		      else (Vector.new0 (), Kind.Jump, Label.newNoname ())
-		   val _ =
-		      List.push
-		      (newBlocks,
-		       Block.T {args = args,
-				kind = kind,
-				label = label,
-				statements = statements,
-				transfer = transfer})
-		in
-		   label
-		end
-	     fun primApp (prim, op1, op2, {collect, dontCollect}) =
-		let
-		   val res = Var.newNoname ()
-		   val s =
-		      Statement.PrimApp {args = Vector.new2 (op1, op2),
-					 dst = SOME (res, Type.bool),
-					 prim = prim}
-		   val transfer =
-		      Transfer.ifBool
-		      (Operand.Var {var = res, ty = Type.bool},
-		       {falsee = dontCollect,
-			truee = collect})
-		in
-		   (Vector.new1 s, transfer)
-		end
-	     datatype z = datatype Runtime.GCField.t
-	     fun stackCheck (maybeFirst, z): Label.t =
-		let
-		   val (statements, transfer) =
-		      primApp (lessThan,
-			       Operand.Runtime StackLimit,
-			       Operand.Runtime StackTop,
-			       z)
-		in
-		   newBlock (maybeFirst, statements, transfer)
-		end
-	     fun maybeStack (): unit =
-		if stack
-		   then ignore (stackCheck
-				(true,
-				 insert (Operand.word
-					 (WordX.zero WordSize.default))))
-		else
-		   (* No limit check, just keep the block around. *)
-		   List.push (newBlocks,
-			      Block.T {args = args,
-				       kind = kind,
-				       label = label,
-				       statements = statements,
-				       transfer = transfer})
-	     fun frontierCheck (isFirst,
-				prim, op1, op2,
-				z as {collect, dontCollect = _}): Label.t =
-		let
-		   val (statements, transfer) = primApp (prim, op1, op2, z)
-		   val l = newBlock (isFirst andalso not stack,
-				     statements, transfer)
-		in
-		   if stack
-		      then stackCheck (isFirst, {collect = collect,
-						 dontCollect = l})
-		   else l
-		end
-	     fun heapCheck (isFirst: bool,
-			    amount: Operand.t (* of type word *)): Label.t =
-		let
-		   val z as {collect, ...} = insert amount
-		   val res = Var.newNoname ()
-		   val s =
-		      (* Can't do Limit - Frontier, because don't know that
-		       * Frontier < Limit.
-		       *)
-		      Statement.PrimApp
-		      {args = Vector.new2 (Operand.Runtime LimitPlusSlop,
-					   Operand.Runtime Frontier),
-		       dst = SOME (res, Type.defaultWord),
-		       prim = Prim.wordSub WordSize.default}
-		   val (statements, transfer) =
-		      primApp (lessThan,
-			       Operand.Var {var = res, ty = Type.defaultWord},
-			       amount,
-			       z)
-		   val statements = Vector.concat [Vector.new1 s, statements]
-		in
-		   if handlesSignals
-		      then
-			 frontierCheck (isFirst,
-					Prim.wordEqual WordSize.default,
-					Operand.Runtime Limit,
-					Operand.word (WordX.zero
-						      WordSize.default),
-					{collect = collect,
-					 dontCollect = newBlock (false,
-								 statements,
-								 transfer)})
-		   else if stack
-			   then
-			      stackCheck
-			      (isFirst,
-			       {collect = collect,
-				dontCollect =
-				newBlock (false, statements, transfer)})
-			else newBlock (isFirst, statements, transfer)
-		end
-	     fun heapCheckNonZero (bytes: Bytes.t): unit =
-		ignore
-		(if Bytes.<= (bytes, Runtime.limitSlop)
-		    then frontierCheck (true,
-					lessThan,
-					Operand.Runtime Limit,
-					Operand.Runtime Frontier,
-					insert (Operand.word
-						(WordX.zero WordSize.default)))
-		 else heapCheck (true,
-				 Operand.word (WordX.fromIntInf
-					       (Bytes.toIntInf bytes,
-						WordSize.default))))
-	     fun smallAllocation (): unit =
-		let
-		   val b = blockCheckAmount {blockIndex = i}
-		in
-		   if Bytes.isZero b
-		      then maybeStack ()
-		   else heapCheckNonZero b
-		end
-	     fun bigAllocation (bytesNeeded: Operand.t): unit =
-		let
-		   val extraBytes =
-		      Bytes.+ (Runtime.arrayHeaderSize,
-			       blockCheckAmount {blockIndex = i})
-		in
-		   case bytesNeeded of
-		      Operand.Const c =>
-			 (case c of
-			     Const.Word w =>
-				heapCheckNonZero
-				(Bytes.fromWord
-				 (Word.addCheck
-				  (Word.fromIntInf (WordX.toIntInf w),
-				   Bytes.toWord extraBytes))
-				 handle Overflow => Runtime.allocTooLarge)
-			   | _ => Error.bug "strange primitive bytes needed")
-		    | _ =>
-			 let
-			    val bytes = Var.newNoname ()
-			    val _ =
-			       newBlock
-			       (true,
-				Vector.new0 (),
-				Transfer.Arith
-				{args = Vector.new2 (Operand.word
-						     (WordX.fromIntInf
-						      (Word.toIntInf
-						       (Bytes.toWord extraBytes),
-						       WordSize.default)),
-						     bytesNeeded),
-				 dst = bytes,
-				 overflow = allocTooLarge (),
-				 prim = Prim.wordAddCheck (WordSize.default,
-							   {signed = false}),
-				 success = (heapCheck
-					    (false, 
-					     Operand.Var
-					     {var = bytes,
-					      ty = Type.defaultWord})),
-				 ty = Type.defaultWord})
-			 in
-			    ()
-			 end
-		end
-	  in
-	     case Transfer.bytesAllocated transfer of
-		Transfer.Big z => bigAllocation z
-	      | Transfer.Small _ => smallAllocation ()
-	  end)
+         Vector.foreachi
+         (blocks, fn (i, Block.T {args, kind, label, statements, transfer}) =>
+          let
+             val transfer = 
+                case transfer of
+                   Transfer.CCall {args, func, return} =>
+                      (if CFunction.ensuresBytesFree func
+                          then 
+                             Transfer.CCall
+                             {args = (Vector.map
+                                      (args, fn z =>
+                                       case z of
+                                          Operand.EnsuresBytesFree =>
+                                             Operand.word
+                                             (WordX.fromIntInf
+                                              (Bytes.toIntInf
+                                               (ensureFree (valOf return)),
+                                               WordSize.default))
+                                        | _ => z)),
+                              func = func,
+                              return = return}
+                       else transfer)
+                 | _ => transfer
+             val stack = Label.equals (start, label)
+             fun insert (amount: Operand.t (* of type word *)) =
+                let
+                   val collect = Label.newNoname ()
+                   val collectReturn = Label.newNoname ()
+                   val dontCollect = Label.newNoname ()
+                   val (dontCollect', collectReturnStatements, force) =
+                      case !Control.gcCheck of
+                         Control.First =>
+                            let
+                               val global = Var.newNoname ()
+                               val _ = List.push (extraGlobals, global)
+                               val global =
+                                  Operand.Var {var = global,
+                                               ty = Type.bool}
+                               val dontCollect' = Label.newNoname ()
+                               val _ =
+                                  List.push
+                                  (newBlocks,
+                                   Block.T
+                                   {args = Vector.new0 (),
+                                    kind = Kind.Jump,
+                                    label = dontCollect',
+                                    statements = Vector.new0 (),
+                                    transfer =
+                                    Transfer.ifBool
+                                    (global, {falsee = dontCollect,
+                                              truee = collect})})
+                            in
+                               (dontCollect',
+                                Vector.new1
+                                (Statement.Move {dst = global,
+                                                 src = Operand.bool false}),
+                                global)
+                            end
+                       | Control.Limit =>
+                            (dontCollect, Vector.new0 (), Operand.bool false)
+                       | Control.Every =>
+                            (collect, Vector.new0 (), Operand.bool true)
+                   val func = CFunction.gc {maySwitchThreads = handlesSignals}
+                   val _ = 
+                      newBlocks :=
+                      Block.T {args = Vector.new0 (),
+                               kind = Kind.Jump,
+                               label = collect,
+                               statements = Vector.new0 (),
+                               transfer = (Transfer.CCall
+                                           {args = Vector.new5 (Operand.GCState,
+                                                                amount,
+                                                                force,
+                                                                Operand.File,
+                                                                Operand.Line),
+                                            func = func,
+                                            return = SOME collectReturn})}
+                      :: (Block.T
+                          {args = Vector.new0 (),
+                           kind = Kind.CReturn {func = func},
+                           label = collectReturn,
+                           statements = collectReturnStatements,
+                           transfer = Transfer.Goto {dst = dontCollect,
+                                                     args = Vector.new0 ()}})
+                      :: Block.T {args = Vector.new0 (),
+                                  kind = Kind.Jump,
+                                  label = dontCollect,
+                                  statements = statements,
+                                  transfer = transfer}
+                      :: !newBlocks
+                in
+                   {collect = collect,
+                    dontCollect = dontCollect'}
+                end
+             fun newBlock (isFirst, statements, transfer) =
+                let
+                   val (args, kind, label) =
+                      if isFirst
+                         then (args, kind, label)
+                      else (Vector.new0 (), Kind.Jump, Label.newNoname ())
+                   val _ =
+                      List.push
+                      (newBlocks,
+                       Block.T {args = args,
+                                kind = kind,
+                                label = label,
+                                statements = statements,
+                                transfer = transfer})
+                in
+                   label
+                end
+             fun primApp (prim, op1, op2, {collect, dontCollect}) =
+                let
+                   val res = Var.newNoname ()
+                   val s =
+                      Statement.PrimApp {args = Vector.new2 (op1, op2),
+                                         dst = SOME (res, Type.bool),
+                                         prim = prim}
+                   val transfer =
+                      Transfer.ifBool
+                      (Operand.Var {var = res, ty = Type.bool},
+                       {falsee = dontCollect,
+                        truee = collect})
+                in
+                   (Vector.new1 s, transfer)
+                end
+             datatype z = datatype Runtime.GCField.t
+             fun stackCheck (maybeFirst, z): Label.t =
+                let
+                   val (statements, transfer) =
+                      primApp (lessThan,
+                               Operand.Runtime StackLimit,
+                               Operand.Runtime StackTop,
+                               z)
+                in
+                   newBlock (maybeFirst, statements, transfer)
+                end
+             fun maybeStack (): unit =
+                if stack
+                   then ignore (stackCheck
+                                (true,
+                                 insert (Operand.word
+                                         (WordX.zero WordSize.default))))
+                else
+                   (* No limit check, just keep the block around. *)
+                   List.push (newBlocks,
+                              Block.T {args = args,
+                                       kind = kind,
+                                       label = label,
+                                       statements = statements,
+                                       transfer = transfer})
+             fun frontierCheck (isFirst,
+                                prim, op1, op2,
+                                z as {collect, dontCollect = _}): Label.t =
+                let
+                   val (statements, transfer) = primApp (prim, op1, op2, z)
+                   val l = newBlock (isFirst andalso not stack,
+                                     statements, transfer)
+                in
+                   if stack
+                      then stackCheck (isFirst, {collect = collect,
+                                                 dontCollect = l})
+                   else l
+                end
+             fun heapCheck (isFirst: bool,
+                            amount: Operand.t (* of type word *)): Label.t =
+                let
+                   val z as {collect, ...} = insert amount
+                   val res = Var.newNoname ()
+                   val s =
+                      (* Can't do Limit - Frontier, because don't know that
+                       * Frontier < Limit.
+                       *)
+                      Statement.PrimApp
+                      {args = Vector.new2 (Operand.Runtime LimitPlusSlop,
+                                           Operand.Runtime Frontier),
+                       dst = SOME (res, Type.defaultWord),
+                       prim = Prim.wordSub WordSize.default}
+                   val (statements, transfer) =
+                      primApp (lessThan,
+                               Operand.Var {var = res, ty = Type.defaultWord},
+                               amount,
+                               z)
+                   val statements = Vector.concat [Vector.new1 s, statements]
+                in
+                   if handlesSignals
+                      then
+                         frontierCheck (isFirst,
+                                        Prim.wordEqual WordSize.default,
+                                        Operand.Runtime Limit,
+                                        Operand.word (WordX.zero
+                                                      WordSize.default),
+                                        {collect = collect,
+                                         dontCollect = newBlock (false,
+                                                                 statements,
+                                                                 transfer)})
+                   else if stack
+                           then
+                              stackCheck
+                              (isFirst,
+                               {collect = collect,
+                                dontCollect =
+                                newBlock (false, statements, transfer)})
+                        else newBlock (isFirst, statements, transfer)
+                end
+             fun heapCheckNonZero (bytes: Bytes.t): unit =
+                ignore
+                (if Bytes.<= (bytes, Runtime.limitSlop)
+                    then frontierCheck (true,
+                                        lessThan,
+                                        Operand.Runtime Limit,
+                                        Operand.Runtime Frontier,
+                                        insert (Operand.word
+                                                (WordX.zero WordSize.default)))
+                 else heapCheck (true,
+                                 Operand.word (WordX.fromIntInf
+                                               (Bytes.toIntInf bytes,
+                                                WordSize.default))))
+             fun smallAllocation (): unit =
+                let
+                   val b = blockCheckAmount {blockIndex = i}
+                in
+                   if Bytes.isZero b
+                      then maybeStack ()
+                   else heapCheckNonZero b
+                end
+             fun bigAllocation (bytesNeeded: Operand.t): unit =
+                let
+                   val extraBytes =
+                      Bytes.+ (Runtime.arrayHeaderSize,
+                               blockCheckAmount {blockIndex = i})
+                in
+                   case bytesNeeded of
+                      Operand.Const c =>
+                         (case c of
+                             Const.Word w =>
+                                heapCheckNonZero
+                                (Bytes.fromWord
+                                 (Word.addCheck
+                                  (Word.fromIntInf (WordX.toIntInf w),
+                                   Bytes.toWord extraBytes))
+                                 handle Overflow => Runtime.allocTooLarge)
+                           | _ => Error.bug "LimitCheck.bigAllocation: strange primitive bytes needed")
+                    | _ =>
+                         let
+                            val bytes = Var.newNoname ()
+                            val _ =
+                               newBlock
+                               (true,
+                                Vector.new0 (),
+                                Transfer.Arith
+                                {args = Vector.new2 (Operand.word
+                                                     (WordX.fromIntInf
+                                                      (Word.toIntInf
+                                                       (Bytes.toWord extraBytes),
+                                                       WordSize.default)),
+                                                     bytesNeeded),
+                                 dst = bytes,
+                                 overflow = allocTooLarge (),
+                                 prim = Prim.wordAddCheck (WordSize.default,
+                                                           {signed = false}),
+                                 success = (heapCheck
+                                            (false, 
+                                             Operand.Var
+                                             {var = bytes,
+                                              ty = Type.defaultWord})),
+                                 ty = Type.defaultWord})
+                         in
+                            ()
+                         end
+                end
+          in
+             case Transfer.bytesAllocated transfer of
+                Transfer.Big z => bigAllocation z
+              | Transfer.Small _ => smallAllocation ()
+          end)
    in
       Function.new {args = args,
-		    blocks = Vector.fromList (!newBlocks),
-		    name = name,
-		    raises = raises,
-		    returns = returns,
-		    start = start}
+                    blocks = Vector.fromList (!newBlocks),
+                    name = name,
+                    raises = raises,
+                    returns = returns,
+                    start = start}
    end
 
 fun insertPerBlock (f: Function.t, handlesSignals) =
    let
       val {blocks, ...} = Function.dest f
       fun blockCheckAmount {blockIndex} =
-	 Block.objectBytesAllocated (Vector.sub (blocks, blockIndex))
+         Block.objectBytesAllocated (Vector.sub (blocks, blockIndex))
    in
       insertFunction (f, handlesSignals, blockCheckAmount, fn _ => Bytes.zero)
    end
@@ -479,44 +500,44 @@
 structure Edge = Graph.Edge
 structure Forest = Graph.LoopForest
 
-val traceMaxPath = Trace.trace ("maxPath", Int.layout, Bytes.layout)
+val traceMaxPath = Trace.trace ("LimitCheck.maxPath", Int.layout, Bytes.layout)
 
 fun isolateBigTransfers (f: Function.t): Function.t =
    let
       val {args, blocks, name, raises, returns, start} = Function.dest f
       val newBlocks = ref []
       val () =
-	 Vector.foreach
-	 (blocks,
-	  fn block as Block.T {args, kind, label, statements, transfer} =>
-	  case Transfer.bytesAllocated transfer of
-	     Transfer.Big _ =>
-		let
-		   val l = Label.newNoname ()
-		in
-		   List.push (newBlocks,
-			      Block.T {args = args,
-				       kind = kind,
-				       label = label,
-				       statements = statements,
-				       transfer = Goto {args = Vector.new0 (),
-							dst = l}})
-		   ; List.push (newBlocks,
-				Block.T {args = Vector.new0 (),
-					 kind = Kind.Jump,
-					 label = l,
-					 statements = Vector.new0 (),
-					 transfer = transfer})
-		end
-	   | Transfer.Small _ => List.push (newBlocks, block))
+         Vector.foreach
+         (blocks,
+          fn block as Block.T {args, kind, label, statements, transfer} =>
+          case Transfer.bytesAllocated transfer of
+             Transfer.Big _ =>
+                let
+                   val l = Label.newNoname ()
+                in
+                   List.push (newBlocks,
+                              Block.T {args = args,
+                                       kind = kind,
+                                       label = label,
+                                       statements = statements,
+                                       transfer = Goto {args = Vector.new0 (),
+                                                        dst = l}})
+                   ; List.push (newBlocks,
+                                Block.T {args = Vector.new0 (),
+                                         kind = Kind.Jump,
+                                         label = l,
+                                         statements = Vector.new0 (),
+                                         transfer = transfer})
+                end
+           | Transfer.Small _ => List.push (newBlocks, block))
       val blocks = Vector.fromListRev (!newBlocks)
    in
       Function.new {args = args,
-		    blocks = blocks,
-		    name = name,
-		    raises = raises,
-		    returns = returns,
-		    start = start}
+                    blocks = blocks,
+                    name = name,
+                    raises = raises,
+                    returns = returns,
+                    start = start}
    end
    
 fun insertCoalesce (f: Function.t, handlesSignals) =
@@ -525,27 +546,27 @@
       val {blocks, start, ...} = Function.dest f
       val n = Vector.length blocks
       val {get = labelIndex, set = setLabelIndex, ...} =
-	 Property.getSetOnce
-	 (Label.plist,
-	  Property.initRaise ("LimitCheck.labelIndex", Label.layout))
+         Property.getSetOnce
+         (Label.plist,
+          Property.initRaise ("LimitCheck.labelIndex", Label.layout))
       val {get = nodeIndex, set = setNodeIndex, ...} =
-	 Property.getSetOnce
-	 (Node.plist, Property.initRaise ("LimitCheck.nodeIndex", Node.layout))
+         Property.getSetOnce
+         (Node.plist, Property.initRaise ("LimitCheck.nodeIndex", Node.layout))
       val _ =
-	 Vector.foreachi
-	 (blocks, fn (i, Block.T {label, ...}) =>
-	  setLabelIndex (label, i))
+         Vector.foreachi
+         (blocks, fn (i, Block.T {label, ...}) =>
+          setLabelIndex (label, i))
       (* Build the graph. *)
       val g = Graph.new ()
       val nodes = 
-	 Vector.tabulate
-	 (n, fn i => 
-	  let
-	     val n = Graph.newNode g
-	     val _ = setNodeIndex (n, i)
-	  in 
-	     n
-	  end)
+         Vector.tabulate
+         (n, fn i => 
+          let
+             val n = Graph.newNode g
+             val _ = setNodeIndex (n, i)
+          in 
+             n
+          end)
       fun indexNode i = Vector.sub (nodes, i)
       val labelNode = indexNode o labelIndex
       val root = Graph.newNode g
@@ -557,179 +578,179 @@
        *   D = set of decycling nodes
        *)
       val mayHaveCheck =
-	 Array.tabulate
-	 (n, fn i =>
-	  let
-	     val Block.T {kind, transfer, ...} = Vector.sub (blocks, i)
-	     datatype z = datatype Kind.t
-	     val isBigAlloc =
-		case Transfer.bytesAllocated transfer of
-		   Transfer.Big _ => true
-		 | Transfer.Small _ => false
-	     val b =
-		case kind of
-		   Cont _ => true
-		 | CReturn {func, ...} =>
-		      CFunction.mayGC func
-		      andalso not (CFunction.ensuresBytesFree func)
-		 | Handler => true
-		 | Jump =>
-		      (case transfer of
-			  Transfer.CCall {args, func, ...} =>
-			     (case CFunction.bytesNeeded func of
-				 NONE => true
-			       | SOME i => 
-				    (case Vector.sub (args, i) of
-					Operand.Const _ => false
-				      | _ => true))
-			| _ => false)
-	  in
-	     b orelse isBigAlloc
-	  end)
+         Array.tabulate
+         (n, fn i =>
+          let
+             val Block.T {kind, transfer, ...} = Vector.sub (blocks, i)
+             datatype z = datatype Kind.t
+             val isBigAlloc =
+                case Transfer.bytesAllocated transfer of
+                   Transfer.Big _ => true
+                 | Transfer.Small _ => false
+             val b =
+                case kind of
+                   Cont _ => true
+                 | CReturn {func, ...} =>
+                      CFunction.mayGC func
+                      andalso not (CFunction.ensuresBytesFree func)
+                 | Handler => true
+                 | Jump =>
+                      (case transfer of
+                          Transfer.CCall {args, func, ...} =>
+                             (case CFunction.bytesNeeded func of
+                                 NONE => true
+                               | SOME i => 
+                                    (case Vector.sub (args, i) of
+                                        Operand.Const _ => false
+                                      | _ => true))
+                        | _ => false)
+          in
+             b orelse isBigAlloc
+          end)
       val _ = Array.update (mayHaveCheck, labelIndex start, true)
       (* Build cfg. *)
       val _ = Graph.addEdge (g, {from = root, to = labelNode start})
       datatype z = datatype Control.limitCheck
       val fullCFG = 
-	 case !Control.limitCheck of
-	    ExtBasicBlocks => true
-	  | LoopHeaders {fullCFG, ...} => fullCFG
-	  | _ => Error.bug "LimitCheck.insertCoalesce: fullCFG"
+         case !Control.limitCheck of
+            ExtBasicBlocks => true
+          | LoopHeaders {fullCFG, ...} => fullCFG
+          | _ => Error.bug "LimitCheck.insertCoalesce: fullCFG"
       val _ =
-	 Vector.foreachi
-	 (blocks, fn (i, Block.T {transfer, ...}) =>
-	  let
-	     val from = indexNode i
-	  in
-	     Transfer.foreachLabel
-	     (transfer, fn l =>
-	      let
-		 val i' = labelIndex l
-		 val to = indexNode i'
-		 fun addEdge from =
-		    (ignore o Graph.addEdge) 
-		    (g, {from = from, to = to})
-	      in
-		 if fullCFG
-		    then addEdge from
-		 else if Array.sub (mayHaveCheck, i')
-		         then addEdge root
-		      else addEdge from
-	      end)
-	  end)
+         Vector.foreachi
+         (blocks, fn (i, Block.T {transfer, ...}) =>
+          let
+             val from = indexNode i
+          in
+             Transfer.foreachLabel
+             (transfer, fn l =>
+              let
+                 val i' = labelIndex l
+                 val to = indexNode i'
+                 fun addEdge from =
+                    (ignore o Graph.addEdge) 
+                    (g, {from = from, to = to})
+              in
+                 if fullCFG
+                    then addEdge from
+                 else if Array.sub (mayHaveCheck, i')
+                         then addEdge root
+                      else addEdge from
+              end)
+          end)
       val objectBytesAllocated = Vector.map (blocks, Block.objectBytesAllocated)
       fun insertCoalesceExtBasicBlocks () =
-	 let
-	    val preds = Array.new (n, 0)
-	    fun incPred i =
-	       Array.update (preds, i, 1 + (Array.sub (preds, i)))
-	    val _ = 
-	       Vector.foreach
-	       (nodes, fn node => 
-		List.foreach
-		(Node.successors node, 
-		 incPred o nodeIndex o Edge.to))
-	    val _ =
-	       Array.foreachi
-	       (preds, fn (i, n) =>
-		if n > 1 then Array.update (mayHaveCheck, i, true) else ())
-	 in
-	   ()
-	 end
+         let
+            val preds = Array.new (n, 0)
+            fun incPred i =
+               Array.update (preds, i, 1 + (Array.sub (preds, i)))
+            val _ = 
+               Vector.foreach
+               (nodes, fn node => 
+                List.foreach
+                (Node.successors node, 
+                 incPred o nodeIndex o Edge.to))
+            val _ =
+               Array.foreachi
+               (preds, fn (i, n) =>
+                if n > 1 then Array.update (mayHaveCheck, i, true) else ())
+         in
+           ()
+         end
       fun insertCoalesceLoopHeaders loopExits =
-	 let
-	    (* Set equivalence classes, where two nodes are equivalent if they
-	     * are in the same loop in the loop forest.
-	     * Also mark loop headers as mayHaveCheck.
-	     *)
-	    val classes = Array.array (n, ~1)
-	    fun indexClass i = Array.sub (classes, i)
-	    val c = Counter.new 0
-	    fun setClass (f: unit Forest.t) =
-	       let
-		  val {loops, notInLoop} = Forest.dest f
-		  val class = Counter.next c
-		  val _ =
-		     Vector.foreach
-		     (notInLoop, fn n =>
-		      if Node.equals (n, root)
-			 then ()
-		      else Array.update (classes, nodeIndex n, class))
-		  val _ =
-		     Vector.foreach
-		     (loops, fn {headers, child} =>
-		      (Vector.foreach
-		       (headers, fn n =>
-			Array.update (mayHaveCheck, nodeIndex n, true))
-		       ; setClass child))
-	       in
-		  ()
-	       end
-	    val _ = setClass (Graph.loopForestSteensgaard (g, {root = root}))
-	    val numClasses = Counter.value c
-	    datatype z = datatype Control.limitCheck
-	    val _ =
-	       if loopExits
-		  then let
-			  (* Determine which classes allocate. *)
-			  val classDoesAllocate =
-			     Array.array (numClasses, false)
-			  val _ =
-			     List.foreach
-			     (Graph.nodes g, fn n =>
-			      if Node.equals (n, root)
-				 then ()
-			      else
-			      let
-				 val i = nodeIndex n
-			      in
-				 if (Bytes.<
-				     (Bytes.zero,
-				      Vector.sub (objectBytesAllocated, i)))
-				    then Array.update (classDoesAllocate, 
-						       indexClass i, 
-						       true)
-				 else ()
-			      end)
-			  (* Mark nodes that are post-exits of non-allocating 
-			   * loops as mayHaveCheck.
-			   *)
-			  val _ =
-			     List.foreach
-			     (Graph.nodes g, fn n =>
-			      if Node.equals (n, root)
-				 then ()
-			      else 
-			      let
-				 val i = nodeIndex n
-				 val c = indexClass i
-			      in
-				if Array.sub (classDoesAllocate, c)
-				   then ()
-				else List.foreach 
-				     (Node.successors n, fn e =>
-				      let
-					 val i' = nodeIndex (Edge.to e)
-				      in
-					 if c <> indexClass i'
-					    then Array.update 
-					         (mayHaveCheck, i', true)
-					 else ()
-				      end)
-			      end)      
-		       in
-			 ()
-		       end
-	       else ()
-	 in
-	    ()
-	 end
+         let
+            (* Set equivalence classes, where two nodes are equivalent if they
+             * are in the same loop in the loop forest.
+             * Also mark loop headers as mayHaveCheck.
+             *)
+            val classes = Array.array (n, ~1)
+            fun indexClass i = Array.sub (classes, i)
+            val c = Counter.new 0
+            fun setClass (f: unit Forest.t) =
+               let
+                  val {loops, notInLoop} = Forest.dest f
+                  val class = Counter.next c
+                  val _ =
+                     Vector.foreach
+                     (notInLoop, fn n =>
+                      if Node.equals (n, root)
+                         then ()
+                      else Array.update (classes, nodeIndex n, class))
+                  val _ =
+                     Vector.foreach
+                     (loops, fn {headers, child} =>
+                      (Vector.foreach
+                       (headers, fn n =>
+                        Array.update (mayHaveCheck, nodeIndex n, true))
+                       ; setClass child))
+               in
+                  ()
+               end
+            val _ = setClass (Graph.loopForestSteensgaard (g, {root = root}))
+            val numClasses = Counter.value c
+            datatype z = datatype Control.limitCheck
+            val _ =
+               if loopExits
+                  then let
+                          (* Determine which classes allocate. *)
+                          val classDoesAllocate =
+                             Array.array (numClasses, false)
+                          val _ =
+                             List.foreach
+                             (Graph.nodes g, fn n =>
+                              if Node.equals (n, root)
+                                 then ()
+                              else
+                              let
+                                 val i = nodeIndex n
+                              in
+                                 if (Bytes.<
+                                     (Bytes.zero,
+                                      Vector.sub (objectBytesAllocated, i)))
+                                    then Array.update (classDoesAllocate, 
+                                                       indexClass i, 
+                                                       true)
+                                 else ()
+                              end)
+                          (* Mark nodes that are post-exits of non-allocating 
+                           * loops as mayHaveCheck.
+                           *)
+                          val _ =
+                             List.foreach
+                             (Graph.nodes g, fn n =>
+                              if Node.equals (n, root)
+                                 then ()
+                              else 
+                              let
+                                 val i = nodeIndex n
+                                 val c = indexClass i
+                              in
+                                if Array.sub (classDoesAllocate, c)
+                                   then ()
+                                else List.foreach 
+                                     (Node.successors n, fn e =>
+                                      let
+                                         val i' = nodeIndex (Edge.to e)
+                                      in
+                                         if c <> indexClass i'
+                                            then Array.update 
+                                                 (mayHaveCheck, i', true)
+                                         else ()
+                                      end)
+                              end)      
+                       in
+                         ()
+                       end
+               else ()
+         in
+            ()
+         end
       datatype z = datatype Control.limitCheck
       val _ = 
-	 case !Control.limitCheck of
-	    ExtBasicBlocks => insertCoalesceExtBasicBlocks ()
-	  | LoopHeaders {loopExits, ...} => insertCoalesceLoopHeaders loopExits
-	  | _ => Error.bug "LimitCheck.insertCoalesce"
+         case !Control.limitCheck of
+            ExtBasicBlocks => insertCoalesceExtBasicBlocks ()
+          | LoopHeaders {loopExits, ...} => insertCoalesceLoopHeaders loopExits
+          | _ => Error.bug "LimitCheck.insertCoalesce"
       (* If we remove edges into nodes that are mayHaveCheck, we have an
        * acyclic graph.
        * So, we can compute a function, maxPath, inductively that for each node
@@ -737,49 +758,49 @@
        * through nodes that are not mayHaveCheck.
        *)
       local
-	 val a = Array.array (n, NONE)
+         val a = Array.array (n, NONE)
       in
-	 fun maxPath arg : Bytes.t =  (* i is a node index *)
-	    traceMaxPath
-	    (fn (i: int) =>
-	    case Array.sub (a, i) of
-	       SOME x => x
-	     | NONE =>
-		  let
-		     val x = Vector.sub (objectBytesAllocated, i)
-		     val max =
-			List.fold
-			(Node.successors (indexNode i), Bytes.zero,
-			 fn (e, max) =>
-			 let
-			    val i' = nodeIndex (Edge.to e)
-			 in
-			    if Array.sub (mayHaveCheck, i')
-			       then max
-			    else Bytes.max (max, maxPath i')
-			 end)
-		     val x = Bytes.+ (x, max)
-		     val _ = Array.update (a, i, SOME x)
-		  in
-		     x
-		  end
-	       ) arg
+         fun maxPath arg : Bytes.t =  (* i is a node index *)
+            traceMaxPath
+            (fn (i: int) =>
+            case Array.sub (a, i) of
+               SOME x => x
+             | NONE =>
+                  let
+                     val x = Vector.sub (objectBytesAllocated, i)
+                     val max =
+                        List.fold
+                        (Node.successors (indexNode i), Bytes.zero,
+                         fn (e, max) =>
+                         let
+                            val i' = nodeIndex (Edge.to e)
+                         in
+                            if Array.sub (mayHaveCheck, i')
+                               then max
+                            else Bytes.max (max, maxPath i')
+                         end)
+                     val x = Bytes.+ (x, max)
+                     val _ = Array.update (a, i, SOME x)
+                  in
+                     x
+                  end
+               ) arg
       end
       fun blockCheckAmount {blockIndex} =
-	 if Array.sub (mayHaveCheck, blockIndex)
-	    then maxPath blockIndex
-	 else Bytes.zero
+         if Array.sub (mayHaveCheck, blockIndex)
+            then maxPath blockIndex
+         else Bytes.zero
       val f = insertFunction (f, handlesSignals, blockCheckAmount,
-			      maxPath o labelIndex)
+                              maxPath o labelIndex)
       val _ =
-	 Control.diagnostics
-	 (fn display =>
-	  Vector.foreach
-	  (blocks, fn Block.T {label, ...} =>
-	   display (let open Layout
-		    in seq [Label.layout label, str " ",
-			    Bytes.layout (maxPath (labelIndex label))]
-		    end)))
+         Control.diagnostics
+         (fn display =>
+          Vector.foreach
+          (blocks, fn Block.T {label, ...} =>
+           display (let open Layout
+                    in seq [Label.layout label, str " ",
+                            Bytes.layout (maxPath (labelIndex label))]
+                    end)))
       val _ = Function.clear f
    in
       f
@@ -790,38 +811,38 @@
       val _ = Control.diagnostic (fn () => Layout.str "Limit Check maxPaths")
       datatype z = datatype Control.limitCheck
       fun insert f =
-	 case !Control.limitCheck of
-	    PerBlock => insertPerBlock (f, handlesSignals)
-	  | _ => insertCoalesce (f, handlesSignals)
+         case !Control.limitCheck of
+            PerBlock => insertPerBlock (f, handlesSignals)
+          | _ => insertCoalesce (f, handlesSignals)
       val functions = List.revMap (functions, insert)
       val {args, blocks, name, raises, returns, start} =
-	 Function.dest (insert main)
+         Function.dest (insert main)
       val newStart = Label.newNoname ()
       val block =
-	 Block.T {args = Vector.new0 (),
-		  kind = Kind.Jump,
-		  label = newStart,
-		  statements = (Vector.fromListMap
-				(!extraGlobals, fn x =>
-				 Statement.Bind
-				 {dst = (x, Type.bool),
-				  isMutable = true,
-				  src = Operand.cast (Operand.bool true,
-						      Type.bool)})),
-		  transfer = Transfer.Goto {args = Vector.new0 (),
-					    dst = start}}
+         Block.T {args = Vector.new0 (),
+                  kind = Kind.Jump,
+                  label = newStart,
+                  statements = (Vector.fromListMap
+                                (!extraGlobals, fn x =>
+                                 Statement.Bind
+                                 {dst = (x, Type.bool),
+                                  isMutable = true,
+                                  src = Operand.cast (Operand.bool true,
+                                                      Type.bool)})),
+                  transfer = Transfer.Goto {args = Vector.new0 (),
+                                            dst = start}}
       val blocks = Vector.concat [Vector.new1 block, blocks]
       val main = Function.new {args = args,
-			       blocks = blocks,
-			       name = name,
-			       raises = raises,
-			       returns = returns,
-			       start = newStart}
+                               blocks = blocks,
+                               name = name,
+                               raises = raises,
+                               returns = returns,
+                               start = newStart}
    in
       Program.T {functions = functions,
-		 handlesSignals = handlesSignals,
-		 main = main,
-		 objectTypes = objectTypes}
+                 handlesSignals = handlesSignals,
+                 main = main,
+                 objectTypes = objectTypes}
    end
 
 end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/backend/limit-check.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/backend/limit-check.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/backend/limit-check.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 type int = Int.t
    
 signature LIMIT_CHECK_STRUCTS = 

Modified: mlton/branches/on-20050420-cmm-branch/mlton/backend/live.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/backend/live.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/backend/live.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *
+
  * This pass is based on the liveness algorithm described in section 4.13,
  * page 132, of Morgan's "Building an Optimizing Compiler".  BTW, the Dragon
  * book and Muchnick's book provided no help at all on speeding up liveness.
@@ -38,217 +39,220 @@
 structure LiveInfo =
    struct
       datatype t = T of {live: Var.t Buffer.t,
-			 liveHS: {handler: Label.t option ref,
-				  link: unit option ref},
-			 name: string,
-			 preds: t list ref}
+                         liveHS: {handler: Label.t option ref,
+                                  link: unit option ref},
+                         name: string,
+                         preds: t list ref}
 
       fun layout (T {name, ...}) = Layout.str name
 
       fun new (name: string) =
-	 T {live = Buffer.new {dummy = Var.bogus},
-	    liveHS = {handler = ref NONE,
-		      link = ref NONE},
-	    name = name,
-	    preds = ref []}
+         T {live = Buffer.new {dummy = Var.bogus},
+            liveHS = {handler = ref NONE,
+                      link = ref NONE},
+            name = name,
+            preds = ref []}
 
       fun live (T {live, ...}) = Buffer.toVector live
-	 
+         
       fun liveHS (T {liveHS = {handler, link}, ...}) =
-	 {handler = !handler,
-	  link = isSome (!link)}
+         {handler = !handler,
+          link = isSome (!link)}
 
       fun equals (T {preds = r, ...}, T {preds = r', ...}) = r = r'
 
       fun addEdge (b, T {preds, ...}) =
-	 if List.exists (!preds, fn b' => equals (b, b'))
-	    then ()
-	 else List.push (preds, b)
+         if List.exists (!preds, fn b' => equals (b, b'))
+            then ()
+         else List.push (preds, b)
 
       val addEdge =
-	 Trace.trace2 ("Live.addEdge", layout, layout, Unit.layout) addEdge
+         Trace.trace2 
+         ("Live.LiveInfo.addEdge", layout, layout, Unit.layout) 
+         addEdge
    end
 
-val traceConsider = Trace.trace ("Live.consider", LiveInfo.layout, Bool.layout)
+val traceConsider = 
+   Trace.trace ("Live.consider", LiveInfo.layout, Bool.layout)
 
 fun live (function, {shouldConsider: Var.t -> bool}) =
    let
       val shouldConsider =
-	 Trace.trace ("Live.shouldConsider", Var.layout, Bool.layout)
-	 shouldConsider
+         Trace.trace ("Live.shouldConsider", Var.layout, Bool.layout)
+         shouldConsider
       val {args, blocks, ...} = Function.dest function
       val _ =
-	 Control.diagnostic
-	 (fn () =>
-	  let
-	     val numVars = ref 0
-	     fun loopVar (x, _) =
-		if shouldConsider x
-		   then Int.inc numVars
-		else ()
-	     fun loopFormals v = Vector.foreach (v, loopVar)
-	     val () =
-		Vector.foreach
-		(blocks, fn Block.T {args, statements, transfer, ...} =>
-		 (loopFormals args
-		  ; Vector.foreach (statements, fn s =>
-				    Statement.foreachDef (s, loopVar))
-		  ; Transfer.foreachDef (transfer, loopVar)))
-	     open Layout
-	  in
-	     align [seq [str "Live info for ",
-			 Func.layout (Function.name function)],
-		    seq [str "  num blocks ", Int.layout (Vector.length blocks)],
-		    seq [str "  num vars ", Int.layout (!numVars)]]
-	  end)
+         Control.diagnostic
+         (fn () =>
+          let
+             val numVars = ref 0
+             fun loopVar (x, _) =
+                if shouldConsider x
+                   then Int.inc numVars
+                else ()
+             fun loopFormals v = Vector.foreach (v, loopVar)
+             val () =
+                Vector.foreach
+                (blocks, fn Block.T {args, statements, transfer, ...} =>
+                 (loopFormals args
+                  ; Vector.foreach (statements, fn s =>
+                                    Statement.foreachDef (s, loopVar))
+                  ; Transfer.foreachDef (transfer, loopVar)))
+             open Layout
+          in
+             align [seq [str "Live info for ",
+                         Func.layout (Function.name function)],
+                    seq [str "  num blocks ", Int.layout (Vector.length blocks)],
+                    seq [str "  num vars ", Int.layout (!numVars)]]
+          end)
       val {get = labelInfo: Label.t -> {argInfo: LiveInfo.t,
-					block: Block.t,
-					bodyInfo: LiveInfo.t},
-	   rem = removeLabelInfo,
-	   set = setLabelInfo, ...} =
-	 Property.getSetOnce (Label.plist,
-			      Property.initRaise ("live info", Label.layout))
+                                        block: Block.t,
+                                        bodyInfo: LiveInfo.t},
+           rem = removeLabelInfo,
+           set = setLabelInfo, ...} =
+         Property.getSetOnce (Label.plist,
+                              Property.initRaise ("live info", Label.layout))
       val {get = varInfo: Var.t -> {defined: LiveInfo.t option ref,
-				    used: LiveInfo.t list ref},
-	   rem = removeVarInfo, ...} =
-	 Property.get (Var.plist,
-		       Property.initFun (fn _ => {defined = ref NONE,
-						  used = ref []}))
+                                    used: LiveInfo.t list ref},
+           rem = removeVarInfo, ...} =
+         Property.get (Var.plist,
+                       Property.initFun (fn _ => {defined = ref NONE,
+                                                  used = ref []}))
       datatype 'a defuse = Def of LiveInfo.t | Use of 'a * LiveInfo.t
       val handlerCodeDefUses: Label.t defuse list ref = ref []
       val handlerLinkDefUses: unit defuse list ref = ref []
       val allVars: Var.t list ref = ref []
       fun setDefined (x: Var.t, defined): unit =
-	 if shouldConsider x
-	    then (List.push (allVars, x)
-		  ; #defined (varInfo x) := SOME defined)
-	 else ()
+         if shouldConsider x
+            then (List.push (allVars, x)
+                  ; #defined (varInfo x) := SOME defined)
+         else ()
       val setDefined =
-	 Trace.trace2 ("Live.setDefined",
-		       Var.layout, LiveInfo.layout, Unit.layout)
-	 setDefined
+         Trace.trace2 ("Live.setDefined",
+                       Var.layout, LiveInfo.layout, Unit.layout)
+         setDefined
       (* Set the labelInfo for each block. *)
       val _ =
-	 Vector.foreach
-	 (blocks, fn block as Block.T {args, label, ...} =>
-	  let
-	     val name = Label.toString label
-	     val (argInfo, bodyInfo) =
-	        case Vector.length args of
-		   0 => let val b = LiveInfo.new (name ^ "a")
-			in (b, b)
-			end
-		 | _ => let val b = LiveInfo.new (name ^ "b")
-			    val b' = LiveInfo.new (name ^ "c")
-			    val _ = LiveInfo.addEdge (b, b')
-			in (b, b')
-			end
-	  in
-	     setLabelInfo (label, {argInfo = argInfo,
-				   block = block,
-				   bodyInfo = bodyInfo})
-	  end)
+         Vector.foreach
+         (blocks, fn block as Block.T {args, label, ...} =>
+          let
+             val name = Label.toString label
+             val (argInfo, bodyInfo) =
+                case Vector.length args of
+                   0 => let val b = LiveInfo.new (name ^ "a")
+                        in (b, b)
+                        end
+                 | _ => let val b = LiveInfo.new (name ^ "b")
+                            val b' = LiveInfo.new (name ^ "c")
+                            val _ = LiveInfo.addEdge (b, b')
+                        in (b, b')
+                        end
+          in
+             setLabelInfo (label, {argInfo = argInfo,
+                                   block = block,
+                                   bodyInfo = bodyInfo})
+          end)
       (* Add the control-flow edges and set the defines and uses for each
        * variable.
        *)
       val head = LiveInfo.new "main"
       val _ = Vector.foreach (args, fn (x, _) => setDefined (x, head))
       val _ =
-	 Vector.foreach
-	 (blocks,
-	  fn Block.T {args, kind, label, statements, transfer, ...} =>
-	  let
-	    val {argInfo, bodyInfo = b, ...} = labelInfo label
-	    val _ = Vector.foreach (args, fn (x, _) => setDefined (x, argInfo))
-	    fun goto l = LiveInfo.addEdge (b, #argInfo (labelInfo l))
-	    (* Make sure that a cont's live vars includes variables live in its
-	     * handler.
-	     *)
-	    val _ =
-	       case kind of
-		  Kind.Cont {handler, ...} =>
-		     Handler.foreachLabel (handler, goto)
-		| _ => ()
-	    fun define (x: Var.t): unit = setDefined (x, b)
-	    fun use (x: Var.t): unit =
-	       if shouldConsider x
-		  then
-		     let val {used, ...} = varInfo x
-		     in
-			if (case !used of
-			       [] => false
-			     | b' :: _ => LiveInfo.equals (b, b'))
-			   then ()
-			else List.push (used, b)
-		     end
-	       else ()
-	    val use = Trace.trace ("Live.use", Var.layout, Unit.layout) use
-	    val _ =
-	       Vector.foreach
-	       (statements, fn s =>
-		let
-		   val _ = Statement.foreachDefUse (s, {def = define o #1,
-							use = use})
-		   val _ =
-		      case s of
-			 SetExnStackSlot =>
-			    List.push (handlerLinkDefUses, Use ((), b))
-		       | SetHandler _ =>
-			    List.push (handlerCodeDefUses, Def b)
-		       | SetSlotExnStack =>
-			    List.push (handlerLinkDefUses, Def b)
-		       | _ => ()
-		in
-		   ()
-		end)
-	    fun label l =
-	       let
-		  val {block = Block.T {kind, ...}, ...} = labelInfo l
-	       in
-		  case kind of
-		     Kind.Handler =>
-			List.push (handlerCodeDefUses, Use (l, b))
-		   | _ => goto l
-	       end
-	    val _ =
-	       Transfer.foreachDefLabelUse (transfer, {def = define o #1,
-						       label = label,
-						       use = use})
-	  in ()
-	  end)
+         Vector.foreach
+         (blocks,
+          fn Block.T {args, kind, label, statements, transfer, ...} =>
+          let
+            val {argInfo, bodyInfo = b, ...} = labelInfo label
+            val _ = Vector.foreach (args, fn (x, _) => setDefined (x, argInfo))
+            fun goto l = LiveInfo.addEdge (b, #argInfo (labelInfo l))
+            (* Make sure that a cont's live vars includes variables live in its
+             * handler.
+             *)
+            val _ =
+               case kind of
+                  Kind.Cont {handler, ...} =>
+                     Handler.foreachLabel (handler, goto)
+                | _ => ()
+            fun define (x: Var.t): unit = setDefined (x, b)
+            fun use (x: Var.t): unit =
+               if shouldConsider x
+                  then
+                     let val {used, ...} = varInfo x
+                     in
+                        if (case !used of
+                               [] => false
+                             | b' :: _ => LiveInfo.equals (b, b'))
+                           then ()
+                        else List.push (used, b)
+                     end
+               else ()
+            val use = Trace.trace ("Live.use", Var.layout, Unit.layout) use
+            val _ =
+               Vector.foreach
+               (statements, fn s =>
+                let
+                   val _ = Statement.foreachDefUse (s, {def = define o #1,
+                                                        use = use})
+                   val _ =
+                      case s of
+                         SetExnStackSlot =>
+                            List.push (handlerLinkDefUses, Use ((), b))
+                       | SetHandler _ =>
+                            List.push (handlerCodeDefUses, Def b)
+                       | SetSlotExnStack =>
+                            List.push (handlerLinkDefUses, Def b)
+                       | _ => ()
+                in
+                   ()
+                end)
+            fun label l =
+               let
+                  val {block = Block.T {kind, ...}, ...} = labelInfo l
+               in
+                  case kind of
+                     Kind.Handler =>
+                        List.push (handlerCodeDefUses, Use (l, b))
+                   | _ => goto l
+               end
+            val _ =
+               Transfer.foreachDefLabelUse (transfer, {def = define o #1,
+                                                       label = label,
+                                                       use = use})
+          in ()
+          end)
       (* Back-propagate every variable from uses to define point. *)
       fun processVar (x: Var.t): unit =
-	 if not (shouldConsider x)
-	    then ()
-	 else
-	    let
-	       val {defined, used, ...} = varInfo x
-	       val defined = valOf (!defined)
-	       val todo: LiveInfo.t list ref = ref []
-	       fun consider (b as LiveInfo.T {live, ...}) =
-		  if LiveInfo.equals (b, defined)
-		     orelse (case Buffer.last live of
-				NONE => false
-			      | SOME x' => Var.equals (x, x'))
-		     then false
-		  else (Buffer.add (live, x)
-			; List.push (todo, b)
-			; true)
-	       val consider = traceConsider consider
-	       val consider = ignore o consider
-	       val _ = List.foreach (!used, consider)
-	       fun loop () =
-		  case !todo of
-		     [] => ()
-		   | LiveInfo.T {preds, ...} :: bs =>
-			(todo := bs
-			 ; List.foreach (!preds, consider)
-			 ; loop ())
-	       val _ = loop ()
-	    in ()
-	    end
+         if not (shouldConsider x)
+            then ()
+         else
+            let
+               val {defined, used, ...} = varInfo x
+               val defined = valOf (!defined)
+               val todo: LiveInfo.t list ref = ref []
+               fun consider (b as LiveInfo.T {live, ...}) =
+                  if LiveInfo.equals (b, defined)
+                     orelse (case Buffer.last live of
+                                NONE => false
+                              | SOME x' => Var.equals (x, x'))
+                     then false
+                  else (Buffer.add (live, x)
+                        ; List.push (todo, b)
+                        ; true)
+               val consider = traceConsider consider
+               val consider = ignore o consider
+               val _ = List.foreach (!used, consider)
+               fun loop () =
+                  case !todo of
+                     [] => ()
+                   | LiveInfo.T {preds, ...} :: bs =>
+                        (todo := bs
+                         ; List.foreach (!preds, consider)
+                         ; loop ())
+               val _ = loop ()
+            in ()
+            end
       val processVar =
-	 Trace.trace ("Live.processVar", Var.layout, Unit.layout) processVar
+         Trace.trace ("Live.processVar", Var.layout, Unit.layout) processVar
       val _ = List.foreach (!allVars, processVar)
       val _ = Function.foreachVar (function, fn (x, _) => removeVarInfo x)
       (* handler code and link slots are harder; in particular, they don't
@@ -258,95 +262,95 @@
        * come after a def in the same block
        *)
       fun handlerLink (defuse: 'a defuse list ref,
-		       sel: {handler: Label.t option ref,
-			     link: unit option ref} -> 'a option ref) =
-	 let
-	    val todo: ('a * LiveInfo.t) list ref = ref []
-	    (* The foldr is important because the statements in each block were
-	     * visited in order, meaning that the earlier statements appear
-	     * later in !defuse.  Hence, with the foldr, the defs and uses are
-	     * visited in order for each block.
-	     *)
-	    val defs =
-	       List.foldr
-	       (!defuse, [], fn (du, defs) =>
-		case du of
-		   Def b => b::defs
-		 | Use (a, b as LiveInfo.T {liveHS, ...}) =>
-		      let
-			 val _ =
-			    if
-			       (* Since we are visiting all of the statements
-				* in the block together, in order, we are
-				* guaranteed that if there is a prior definition
-				* then it will be first on defs.
-				*)
-			       (case defs of 
-				   [] => false
-				 | b' :: _ => LiveInfo.equals (b, b'))
-			       then ()
-			    else (sel liveHS := SOME a
-				  ; List.push (todo, (a, b)))
-		      in
-			 defs
-		      end)
-	    fun consider (b as LiveInfo.T {liveHS, ...}, a: 'a) =
-	       if List.exists (defs, fn b' => LiveInfo.equals (b, b'))
-		  orelse isSome (!(sel liveHS))
-		  then ()
-	       else (sel liveHS := SOME a
-		     ; List.push (todo, (a, b)))
-	    fun loop () =
-	       case !todo of
-		  [] => ()
-		| (a, LiveInfo.T {preds, ...}) :: bs =>
-		     (todo := bs
-		      ; List.foreach (!preds, fn b => consider (b, a))
-		      ; loop ())
-	    val _ = loop ()
-	 in
-	    ()
-	 end
+                       sel: {handler: Label.t option ref,
+                             link: unit option ref} -> 'a option ref) =
+         let
+            val todo: ('a * LiveInfo.t) list ref = ref []
+            (* The foldr is important because the statements in each block were
+             * visited in order, meaning that the earlier statements appear
+             * later in !defuse.  Hence, with the foldr, the defs and uses are
+             * visited in order for each block.
+             *)
+            val defs =
+               List.foldr
+               (!defuse, [], fn (du, defs) =>
+                case du of
+                   Def b => b::defs
+                 | Use (a, b as LiveInfo.T {liveHS, ...}) =>
+                      let
+                         val _ =
+                            if
+                               (* Since we are visiting all of the statements
+                                * in the block together, in order, we are
+                                * guaranteed that if there is a prior definition
+                                * then it will be first on defs.
+                                *)
+                               (case defs of 
+                                   [] => false
+                                 | b' :: _ => LiveInfo.equals (b, b'))
+                               then ()
+                            else (sel liveHS := SOME a
+                                  ; List.push (todo, (a, b)))
+                      in
+                         defs
+                      end)
+            fun consider (b as LiveInfo.T {liveHS, ...}, a: 'a) =
+               if List.exists (defs, fn b' => LiveInfo.equals (b, b'))
+                  orelse isSome (!(sel liveHS))
+                  then ()
+               else (sel liveHS := SOME a
+                     ; List.push (todo, (a, b)))
+            fun loop () =
+               case !todo of
+                  [] => ()
+                | (a, LiveInfo.T {preds, ...}) :: bs =>
+                     (todo := bs
+                      ; List.foreach (!preds, fn b => consider (b, a))
+                      ; loop ())
+            val _ = loop ()
+         in
+            ()
+         end
       val _ = handlerLink (handlerCodeDefUses, #handler)
       val _ = handlerLink (handlerLinkDefUses, #link)
       val {get = labelLive, rem = remLabelLive, ...} =
-	 Property.get
-	 (Label.plist,
-	  Property.initFun
-	  (fn l =>
-	   let
-	      val {bodyInfo, argInfo, ...} = labelInfo l
-	      val () = removeLabelInfo l
-	      val {handler, link} = LiveInfo.liveHS bodyInfo
-	   in
-	      {begin = LiveInfo.live bodyInfo,
-	       beginNoFormals = LiveInfo.live argInfo,
-	       handler = handler,
-	       link = link}
-	   end))
+         Property.get
+         (Label.plist,
+          Property.initFun
+          (fn l =>
+           let
+              val {bodyInfo, argInfo, ...} = labelInfo l
+              val () = removeLabelInfo l
+              val {handler, link} = LiveInfo.liveHS bodyInfo
+           in
+              {begin = LiveInfo.live bodyInfo,
+               beginNoFormals = LiveInfo.live argInfo,
+               handler = handler,
+               link = link}
+           end))
       val () = Vector.foreach (blocks, fn b =>
-			       ignore (labelLive (Block.label b)))
+                               ignore (labelLive (Block.label b)))
       val _ =
-	 Control.diagnostics
-	 (fn display =>
-	  let open Layout
-	  in
-	     Vector.foreach
-	     (blocks, fn b =>
-	      let
-		 val l = Block.label b		 
-		 val {begin, beginNoFormals, handler, link} = labelLive l
-	      in
-		 display
-		 (seq [Label.layout l,
-		       str " ",
-		       record [("begin", Vector.layout Var.layout begin),
-			       ("beginNoFormals",
-				Vector.layout Var.layout beginNoFormals),
-			       ("handler", Option.layout Label.layout handler),
-			       ("link", Bool.layout link)]])
-	      end)
-	  end)
+         Control.diagnostics
+         (fn display =>
+          let open Layout
+          in
+             Vector.foreach
+             (blocks, fn b =>
+              let
+                 val l = Block.label b           
+                 val {begin, beginNoFormals, handler, link} = labelLive l
+              in
+                 display
+                 (seq [Label.layout l,
+                       str " ",
+                       record [("begin", Vector.layout Var.layout begin),
+                               ("beginNoFormals",
+                                Vector.layout Var.layout beginNoFormals),
+                               ("handler", Option.layout Label.layout handler),
+                               ("link", Bool.layout link)]])
+              end)
+          end)
    in 
       {labelLive = labelLive,
        remLabelLive = remLabelLive}
@@ -354,7 +358,7 @@
 
 val live =
    Trace.trace2 ("Live.live", Func.layout o Function.name, Layout.ignore,
-		 Layout.ignore)
+                 Layout.ignore)
    live
 
 end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/backend/live.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/backend/live.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/backend/live.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature LIVE_STRUCTS = 
    sig
       include RSSA
@@ -15,14 +16,14 @@
       include LIVE_STRUCTS
 
       val live:
-	 Function.t * {shouldConsider: Var.t -> bool}
-	 -> {labelLive:
-	     Label.t -> {(* live at beginning of block. *)
-			begin: Var.t vector,
-			(* live at the beginning of a block, except formals. *)
-			beginNoFormals: Var.t vector,
-			(* live handler slots at beginning of block. *)
-			handler: Label.t option,
-			link: bool},
-	     remLabelLive: Label.t -> unit}
+         Function.t * {shouldConsider: Var.t -> bool}
+         -> {labelLive:
+             Label.t -> {(* live at beginning of block. *)
+                        begin: Var.t vector,
+                        (* live at the beginning of a block, except formals. *)
+                        beginNoFormals: Var.t vector,
+                        (* live handler slots at beginning of block. *)
+                        handler: Label.t option,
+                        link: bool},
+             remLabelLive: Label.t -> unit}
    end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/backend/machine.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/backend/machine.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/backend/machine.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,9 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 functor Machine (S: MACHINE_STRUCTS): MACHINE =
@@ -15,16 +15,16 @@
 structure Runtime = Runtime ()
 structure Scale = Scale ()
 structure RepType = RepType (structure CFunction = CFunction
-			     structure CType = CType
-			     structure Label = Label
-			     structure PointerTycon = PointerTycon
-			     structure Prim = Prim
-			     structure RealSize = RealSize
-			     structure Runtime = Runtime
-			     structure Scale = Scale
-			     structure WordSize = WordSize
-			     structure WordX = WordX
-			     structure WordXVector = WordXVector)
+                             structure CType = CType
+                             structure Label = Label
+                             structure PointerTycon = PointerTycon
+                             structure Prim = Prim
+                             structure RealSize = RealSize
+                             structure Runtime = Runtime
+                             structure Scale = Scale
+                             structure WordSize = WordSize
+                             structure WordX = WordX
+                             structure WordXVector = WordXVector)
 structure ObjectType = RepType.ObjectType
 
 structure Type = RepType
@@ -34,86 +34,88 @@
 structure Register =
    struct
       datatype t = T of {index: int option ref,
-			 ty: Type.t}
+                         ty: Type.t}
 
       local
-	 fun make f (T r) = f r
+         fun make f (T r) = f r
       in
-	 val indexOpt = ! o (make #index)
-	 val ty = make #ty
+         val indexOpt = ! o (make #index)
+         val ty = make #ty
       end
 
       fun layout (T {index, ty, ...}) =
-	 let
-	    open Layout
-	 in
-	    seq [str (concat ["R", Type.name ty]),
-		 paren (case !index of
-			   NONE => str "NONE"
-			 | SOME i => Int.layout i),
-		 str ": ",
-		 Type.layout ty]
-	 end
+         let
+            open Layout
+         in
+            seq [str (concat ["R", Type.name ty]),
+                 paren (case !index of
+                           NONE => str "NONE"
+                         | SOME i => Int.layout i),
+                 str ": ",
+                 Type.layout ty]
+         end
 
       val toString = Layout.toString o layout
 
       fun index (r as T {index, ...}) =
-	 case !index of
-	    NONE =>
-	       Error.bug (concat ["register ", toString r, " missing index"])
-	  | SOME i => i
+         case !index of
+            NONE =>
+               Error.bug (concat ["Machine.Register: register ", 
+                                  toString r, " missing index"])
+          | SOME i => i
 
       fun setIndex (r as T {index, ...}, i) =
-	 case !index of
-	    NONE => index := SOME i
-	  | SOME _ =>
-	       Error.bug (concat ["register ", toString r, " index already set"])
+         case !index of
+            NONE => index := SOME i
+          | SOME _ =>
+               Error.bug (concat ["Machine.Register: register ", 
+                                  toString r, " index already set"])
 
       fun new (ty, i) = T {index = ref i,
-			   ty = ty}
+                           ty = ty}
 
       fun equals (r, r') =
-	 (case (indexOpt r, indexOpt r') of
-	     (SOME i, SOME i') => i = i'
-	   | _ => false)
-	 andalso CType.equals (Type.toCType (ty r), Type.toCType (ty r'))
+         (case (indexOpt r, indexOpt r') of
+             (SOME i, SOME i') => i = i'
+           | _ => false)
+         andalso CType.equals (Type.toCType (ty r), Type.toCType (ty r'))
 
       val equals =
-	 Trace.trace2 ("Register.equals", layout, layout, Bool.layout) equals
+         Trace.trace2 ("Machine.Register.equals", layout, layout, Bool.layout) equals
 
       val isSubtype: t * t -> bool =
-	 fn (T {index = i, ty = t}, T {index = i', ty = t'}) =>
-	 (case (!i, !i') of
-	     (SOME i, SOME i') => i = i'
-	   | _ => false)
-	 andalso Type.isSubtype (t, t')
-	 andalso CType.equals (Type.toCType t, Type.toCType t')
+         fn (T {index = i, ty = t}, T {index = i', ty = t'}) =>
+         (case (!i, !i') of
+             (SOME i, SOME i') => i = i'
+           | _ => false)
+         andalso Type.isSubtype (t, t')
+         andalso CType.equals (Type.toCType t, Type.toCType t')
    end
 
 structure Global =
    struct
       datatype t = T of {index: int,
-			 isRoot: bool,
-			 ty: Type.t}
+                         isRoot: bool,
+                         ty: Type.t}
 
       fun layout (T {index, isRoot, ty, ...}) =
-	 let
-	    open Layout
-	 in
-	    seq [str "glob ",
-		 record [("index", Int.layout index),
-			 ("isRoot", Bool.layout isRoot),
-			 ("ty", Type.layout ty)]]
-	 end
+         let
+            open Layout
+         in
+            seq [str "glob ",
+                 record [("index", Int.layout index),
+                         ("isRoot", Bool.layout isRoot),
+                         ("ty", Type.layout ty)]]
+         end
       
       val toString = Layout.toString o layout
 
       local
-	 fun make f (T r) = f r
+         fun make f (T r) = f r
       in
-	 val index = make #index
-	 val isRoot = make #isRoot
-	 val ty = make #ty
+         val index = make #index
+         val isRoot = make #isRoot
+         val ty = make #ty
       end
 
       val nonRootCounter = Counter.new 0
@@ -121,90 +123,90 @@
 
       val memo = CType.memo (fn _ => Counter.new 0)
       fun numberOfType t = Counter.value (memo t)
-	 
+         
       fun new {isRoot, ty} =
-	 let
-	    val isRoot = isRoot orelse not (Type.isPointer ty)
-	    val counter =
-	       if isRoot
-		  then memo (Type.toCType ty)
-	       else nonRootCounter
-	    val g = T {index = Counter.next counter,
-		       isRoot = isRoot,
-		       ty = ty}
-	 in
-	    g
-	 end
+         let
+            val isRoot = isRoot orelse not (Type.isPointer ty)
+            val counter =
+               if isRoot
+                  then memo (Type.toCType ty)
+               else nonRootCounter
+            val g = T {index = Counter.next counter,
+                       isRoot = isRoot,
+                       ty = ty}
+         in
+            g
+         end
 
       fun equals (T {index = i, isRoot = r, ty},
-		  T {index = i', isRoot = r', ty = ty'}) =
-	 i = i'
-	 andalso r = r'
-	 andalso Type.equals (ty, ty')
+                  T {index = i', isRoot = r', ty = ty'}) =
+         i = i'
+         andalso r = r'
+         andalso Type.equals (ty, ty')
 
       val isSubtype: t * t -> bool =
-	 fn (T {index = i, isRoot = r, ty},
-	     T {index = i', isRoot = r', ty = ty'}) =>
-	 i = i'
-	 andalso r = r'
-	 andalso Type.isSubtype (ty, ty')
-	 andalso CType.equals (Type.toCType ty, Type.toCType ty')
+         fn (T {index = i, isRoot = r, ty},
+             T {index = i', isRoot = r', ty = ty'}) =>
+         i = i'
+         andalso r = r'
+         andalso Type.isSubtype (ty, ty')
+         andalso CType.equals (Type.toCType ty, Type.toCType ty')
    end
 
 structure StackOffset =
    struct
       datatype t = T of {offset: Bytes.t,
-			 ty: Type.t}
+                         ty: Type.t}
 
       local
-	 fun make f (T r) = f r
+         fun make f (T r) = f r
       in
-	 val offset = make #offset
-	 val ty = make #ty
+         val offset = make #offset
+         val ty = make #ty
       end
 
       fun layout (T {offset, ty}): Layout.t =
-	 let
-	    open Layout
-	 in
-	    seq [str (concat ["S", Type.name ty]),
-		 paren (Bytes.layout offset),
-		 str ": ", Type.layout ty]
-	 end
+         let
+            open Layout
+         in
+            seq [str (concat ["S", Type.name ty]),
+                 paren (Bytes.layout offset),
+                 str ": ", Type.layout ty]
+         end
 
       val equals: t * t -> bool =
-	 fn (T {offset = b, ty}, T {offset = b', ty = ty'}) =>
-	 Bytes.equals (b, b') andalso Type.equals (ty, ty')
+         fn (T {offset = b, ty}, T {offset = b', ty = ty'}) =>
+         Bytes.equals (b, b') andalso Type.equals (ty, ty')
 
       val isSubtype: t * t -> bool =
-	 fn (T {offset = b, ty = t}, T {offset = b', ty = t'}) =>
-	 Bytes.equals (b, b') andalso Type.isSubtype (t, t')
+         fn (T {offset = b, ty = t}, T {offset = b', ty = t'}) =>
+         Bytes.equals (b, b') andalso Type.isSubtype (t, t')
 
       val interfere: t * t -> bool =
-	 fn (T {offset = b, ty = ty}, T {offset = b', ty = ty'}) =>
-	 let 
-	    val max = Bytes.+ (b, Type.bytes ty)
-	    val max' = Bytes.+ (b', Type.bytes ty')
-	 in
-	    Bytes.> (max, b') andalso Bytes.> (max', b)
-	 end
+         fn (T {offset = b, ty = ty}, T {offset = b', ty = ty'}) =>
+         let 
+            val max = Bytes.+ (b, Type.bytes ty)
+            val max' = Bytes.+ (b', Type.bytes ty')
+         in
+            Bytes.> (max, b') andalso Bytes.> (max', b)
+         end
 
       fun shift (T {offset, ty}, size): t =
-	 T {offset = Bytes.- (offset, size),
-	    ty = ty}
+         T {offset = Bytes.- (offset, size),
+            ty = ty}
    end
 
 structure Operand =
    struct
       datatype t =
-	 ArrayOffset of {base: t,
-			 index: t,
-			 offset: Bytes.t,
-			 scale: Scale.t,
-			 ty: Type.t}
+         ArrayOffset of {base: t,
+                         index: t,
+                         offset: Bytes.t,
+                         scale: Scale.t,
+                         ty: Type.t}
        | Cast of t * Type.t
        | Contents of {oper: t,
-		      ty: Type.t}
+                      ty: Type.t}
        | File
        | Frontier
        | GCState
@@ -212,8 +214,8 @@
        | Label of Label.t
        | Line
        | Offset of {base: t,
-		    offset: Bytes.t,
-		    ty: Type.t}
+                    offset: Bytes.t,
+                    ty: Type.t}
        | Register of Register.t
        | Real of RealX.t
        | StackOffset of StackOffset.t
@@ -222,202 +224,202 @@
 
     val ty =
        fn ArrayOffset {ty, ...} => ty
-	| Cast (_, ty) => ty
-	| Contents {ty, ...} => ty
-	| File => Type.cPointer ()
-	| Frontier => Type.defaultWord
-	| GCState => Type.gcState
-	| Global g => Global.ty g
-	| Label l => Type.label l
-	| Line => Type.defaultWord
-	| Offset {ty, ...} => ty
-	| Real r => Type.real (RealX.size r)
-	| Register r => Register.ty r
-	| StackOffset s => StackOffset.ty s
-	| StackTop => Type.defaultWord
-	| Word w => Type.constant w
+        | Cast (_, ty) => ty
+        | Contents {ty, ...} => ty
+        | File => Type.cPointer ()
+        | Frontier => Type.defaultWord
+        | GCState => Type.gcState
+        | Global g => Global.ty g
+        | Label l => Type.label l
+        | Line => Type.defaultWord
+        | Offset {ty, ...} => ty
+        | Real r => Type.real (RealX.size r)
+        | Register r => Register.ty r
+        | StackOffset s => StackOffset.ty s
+        | StackTop => Type.defaultWord
+        | Word w => Type.constant w
 
     fun layout (z: t): Layout.t =
-	 let
-	    open Layout 
-	    fun constrain (ty: Type.t): Layout.t =
-	       if !Control.showTypes
-		  then seq [str ": ", Type.layout ty]
-	       else empty
-	 in
-	    case z of
-	       ArrayOffset {base, index, offset, scale, ty} =>
-		  seq [str (concat ["X", Type.name ty, " "]),
-		       tuple [layout base, layout index, Scale.layout scale,
-			      Bytes.layout offset],
-		       constrain ty]
-	     | Cast (z, ty) =>
-		  seq [str "Cast ", tuple [layout z, Type.layout ty]]
-	     | Contents {oper, ty} =>
-		  seq [str (concat ["C", Type.name ty, " "]),
-		       paren (layout oper)]
-	     | File => str "<File>"
-	     | Frontier => str "<Frontier>"
-	     | GCState => str "<GCState>"
-	     | Global g => Global.layout g
-	     | Label l => Label.layout l
-	     | Line => str "<Line>"
-	     | Offset {base, offset, ty} =>
-		  seq [str (concat ["O", Type.name ty, " "]),
-		       tuple [layout base, Bytes.layout offset],
-		       constrain ty]
-	     | Real r => RealX.layout r
-	     | Register r => Register.layout r
-	     | StackOffset so => StackOffset.layout so
-	     | StackTop => str "<StackTop>"
-	     | Word w => WordX.layout w
-	 end
+         let
+            open Layout 
+            fun constrain (ty: Type.t): Layout.t =
+               if !Control.showTypes
+                  then seq [str ": ", Type.layout ty]
+               else empty
+         in
+            case z of
+               ArrayOffset {base, index, offset, scale, ty} =>
+                  seq [str (concat ["X", Type.name ty, " "]),
+                       tuple [layout base, layout index, Scale.layout scale,
+                              Bytes.layout offset],
+                       constrain ty]
+             | Cast (z, ty) =>
+                  seq [str "Cast ", tuple [layout z, Type.layout ty]]
+             | Contents {oper, ty} =>
+                  seq [str (concat ["C", Type.name ty, " "]),
+                       paren (layout oper)]
+             | File => str "<File>"
+             | Frontier => str "<Frontier>"
+             | GCState => str "<GCState>"
+             | Global g => Global.layout g
+             | Label l => Label.layout l
+             | Line => str "<Line>"
+             | Offset {base, offset, ty} =>
+                  seq [str (concat ["O", Type.name ty, " "]),
+                       tuple [layout base, Bytes.layout offset],
+                       constrain ty]
+             | Real r => RealX.layout r
+             | Register r => Register.layout r
+             | StackOffset so => StackOffset.layout so
+             | StackTop => str "<StackTop>"
+             | Word w => WordX.layout w
+         end
 
     val toString = Layout.toString o layout
-			      
+                              
     val rec equals =
-	 fn (ArrayOffset {base = b, index = i, ...},
-	     ArrayOffset {base = b', index = i', ...}) =>
-	        equals (b, b') andalso equals (i, i') 
-	   | (Cast (z, t), Cast (z', t')) =>
-		Type.equals (t, t') andalso equals (z, z')
-	   | (Contents {oper = z, ...}, Contents {oper = z', ...}) =>
-		equals (z, z')
-	   | (File, File) => true
-	   | (GCState, GCState) => true
-	   | (Global g, Global g') => Global.equals (g, g')
-	   | (Label l, Label l') => Label.equals (l, l')
-	   | (Line, Line) => true
-	   | (Offset {base = b, offset = i, ...},
-	      Offset {base = b', offset = i', ...}) =>
-	        equals (b, b') andalso Bytes.equals (i, i')
-	   | (Real r, Real r') => RealX.equals (r, r')
-	   | (Register r, Register r') => Register.equals (r, r')
-	   | (StackOffset so, StackOffset so') => StackOffset.equals (so, so')
-	   | (Word w, Word w') => WordX.equals (w, w')
-	   | _ => false
+         fn (ArrayOffset {base = b, index = i, ...},
+             ArrayOffset {base = b', index = i', ...}) =>
+                equals (b, b') andalso equals (i, i') 
+           | (Cast (z, t), Cast (z', t')) =>
+                Type.equals (t, t') andalso equals (z, z')
+           | (Contents {oper = z, ...}, Contents {oper = z', ...}) =>
+                equals (z, z')
+           | (File, File) => true
+           | (GCState, GCState) => true
+           | (Global g, Global g') => Global.equals (g, g')
+           | (Label l, Label l') => Label.equals (l, l')
+           | (Line, Line) => true
+           | (Offset {base = b, offset = i, ...},
+              Offset {base = b', offset = i', ...}) =>
+                equals (b, b') andalso Bytes.equals (i, i')
+           | (Real r, Real r') => RealX.equals (r, r')
+           | (Register r, Register r') => Register.equals (r, r')
+           | (StackOffset so, StackOffset so') => StackOffset.equals (so, so')
+           | (Word w, Word w') => WordX.equals (w, w')
+           | _ => false
 
       val stackOffset = StackOffset o StackOffset.T
     
       fun interfere (write: t, read: t): bool =
-	 let
-	    fun inter read = interfere (write, read)
-	 in
-	    case (read, write) 
-	       of (ArrayOffset {base, index, ...}, _) => 
-		  inter base orelse inter index
-	     | (Contents {oper, ...}, _) => inter oper
-	     | (Global g, Global g') => Global.equals (g, g')
-	     | (Offset {base, ...}, _) => inter base
-	     | (Register r, Register r') => Register.equals (r, r')
-	     | (StackOffset so, StackOffset so') =>
-		  StackOffset.interfere (so, so')
-	     | _ => false
-	 end
+         let
+            fun inter read = interfere (write, read)
+         in
+            case (read, write) 
+               of (ArrayOffset {base, index, ...}, _) => 
+                  inter base orelse inter index
+             | (Contents {oper, ...}, _) => inter oper
+             | (Global g, Global g') => Global.equals (g, g')
+             | (Offset {base, ...}, _) => inter base
+             | (Register r, Register r') => Register.equals (r, r')
+             | (StackOffset so, StackOffset so') =>
+                  StackOffset.interfere (so, so')
+             | _ => false
+         end
 
       val rec isLocation =
-	 fn ArrayOffset _ => true
-	  | Cast (z, _) => isLocation z
-	  | Contents _ => true
-	  | GCState => true
-	  | Global _ => true
-	  | Offset _ => true
-	  | Register _ => true
-	  | StackOffset _ => true
-	  | _ => false
+         fn ArrayOffset _ => true
+          | Cast (z, _) => isLocation z
+          | Contents _ => true
+          | GCState => true
+          | Global _ => true
+          | Offset _ => true
+          | Register _ => true
+          | StackOffset _ => true
+          | _ => false
    end
 
 structure Switch = Switch (open Atoms
-			   structure Type = Type
-			   structure Use = Operand)
+                           structure Type = Type
+                           structure Use = Operand)
 
 structure Statement =
    struct
       datatype t =
-	 Move of {dst: Operand.t,
-		  src: Operand.t}
+         Move of {dst: Operand.t,
+                  src: Operand.t}
        | Noop
        | PrimApp of {args: Operand.t vector,
-		     dst: Operand.t option,
-		     prim: Type.t Prim.t}
+                     dst: Operand.t option,
+                     prim: Type.t Prim.t}
        | ProfileLabel of ProfileLabel.t
 
       val layout =
-	 let
-	    open Layout
-	 in
-	    fn Move {dst, src} =>
-		  mayAlign [Operand.layout dst,
-			    seq [str " = ", Operand.layout src]]
-	     | Noop => str "Noop"
-	     | PrimApp {args, dst, prim, ...} =>
-		  let
-		     val rest =
-			seq [Prim.layout prim, str " ",
-			     Vector.layout Operand.layout args]
-		  in
-		     case dst of
-			NONE => rest
-		      | SOME z =>
-			   mayAlign [Operand.layout z,
-				     seq [str " = ", rest]]
-		  end
-	     | ProfileLabel l =>
-		  seq [str "ProfileLabel ", ProfileLabel.layout l]
-	 end
+         let
+            open Layout
+         in
+            fn Move {dst, src} =>
+                  mayAlign [Operand.layout dst,
+                            seq [str " = ", Operand.layout src]]
+             | Noop => str "Noop"
+             | PrimApp {args, dst, prim, ...} =>
+                  let
+                     val rest =
+                        seq [Prim.layout prim, str " ",
+                             Vector.layout Operand.layout args]
+                  in
+                     case dst of
+                        NONE => rest
+                      | SOME z =>
+                           mayAlign [Operand.layout z,
+                                     seq [str " = ", rest]]
+                  end
+             | ProfileLabel l =>
+                  seq [str "ProfileLabel ", ProfileLabel.layout l]
+         end
  
       fun move (arg as {dst, src}) =
-	 if Operand.equals (dst, src)
-	    then Noop
-	 else Move arg
+         if Operand.equals (dst, src)
+            then Noop
+         else Move arg
 
       val move =
-	 Trace.trace ("Statement.move",
-		      fn {dst, src} =>
-		      Layout.record [("dst", Operand.layout dst),
-				     ("src", Operand.layout src)],
-		      layout)
-	 move
-	 
+         Trace.trace ("Machine.Statement.move",
+                      fn {dst, src} =>
+                      Layout.record [("dst", Operand.layout dst),
+                                     ("src", Operand.layout src)],
+                      layout)
+         move
+         
       fun moves {srcs, dsts} =
-	 Vector.fromListRev
-	 (Vector.fold2 (srcs, dsts, [], fn (src, dst, ac)  =>
-			move {src = src, dst = dst} :: ac))
+         Vector.fromListRev
+         (Vector.fold2 (srcs, dsts, [], fn (src, dst, ac)  =>
+                        move {src = src, dst = dst} :: ac))
 
       fun object {dst, header, size} =
-	 let
-	    datatype z = datatype Operand.t
-	    fun bytes (b: Bytes.t): Operand.t =
-	       Word (WordX.fromIntInf (Bytes.toIntInf b, WordSize.default))
-	 in
-	    Vector.new3
-	    (Move {dst = Contents {oper = Frontier,
-				   ty = Type.defaultWord},
-		   src = Word (WordX.fromIntInf (Word.toIntInf header,
-						 WordSize.default))},
-	     PrimApp {args = Vector.new2 (Frontier,
-					  bytes Runtime.normalHeaderSize),
-		      dst = SOME dst,
-		      prim = Prim.wordAdd WordSize.default},
-	     PrimApp {args = Vector.new2 (Frontier, bytes (Words.toBytes size)),
-		      dst = SOME Frontier,
-		      prim = Prim.wordAdd WordSize.default})
-	 end
+         let
+            datatype z = datatype Operand.t
+            fun bytes (b: Bytes.t): Operand.t =
+               Word (WordX.fromIntInf (Bytes.toIntInf b, WordSize.default))
+         in
+            Vector.new3
+            (Move {dst = Contents {oper = Frontier,
+                                   ty = Type.defaultWord},
+                   src = Word (WordX.fromIntInf (Word.toIntInf header,
+                                                 WordSize.default))},
+             PrimApp {args = Vector.new2 (Frontier,
+                                          bytes Runtime.normalHeaderSize),
+                      dst = SOME dst,
+                      prim = Prim.wordAdd WordSize.default},
+             PrimApp {args = Vector.new2 (Frontier, bytes (Words.toBytes size)),
+                      dst = SOME Frontier,
+                      prim = Prim.wordAdd WordSize.default})
+         end
 
       fun foldOperands (s, ac, f) =
-	 case s of
-	    Move {dst, src} => f (dst, f (src, ac))
-	  | PrimApp {args, dst, ...} =>
-	       Vector.fold (args, Option.fold (dst, ac, f), f)
-	  | _ => ac
+         case s of
+            Move {dst, src} => f (dst, f (src, ac))
+          | PrimApp {args, dst, ...} =>
+               Vector.fold (args, Option.fold (dst, ac, f), f)
+          | _ => ac
 
       fun foldDefs (s, a, f) =
-	 case s of
-	    Move {dst, ...} => f (dst, a)
-	  | PrimApp {dst, ...} => (case dst of
-				      NONE => a
-				    | SOME z => f (z, a))
-	  | _ => a
+         case s of
+            Move {dst, ...} => f (dst, a)
+          | PrimApp {dst, ...} => (case dst of
+                                      NONE => a
+                                    | SOME z => f (z, a))
+          | _ => a
    end
 
 structure FrameInfo =
@@ -425,1091 +427,1094 @@
       datatype t = T of {frameLayoutsIndex: int}
 
       fun layout (T {frameLayoutsIndex, ...}) =
-	 Layout.record [("frameLayoutsIndex", Int.layout frameLayoutsIndex)]
+         Layout.record [("frameLayoutsIndex", Int.layout frameLayoutsIndex)]
 
       fun equals (T {frameLayoutsIndex = i}, T {frameLayoutsIndex = i'}) =
-	 i = i'
+         i = i'
    end
 
 structure Live =
    struct
       datatype t =
-	 Global of Global.t
+         Global of Global.t
        | Register of Register.t
        | StackOffset of StackOffset.t
 
       val layout: t -> Layout.t =
-	 fn Global g => Global.layout g
-	  | Register r => Register.layout r
-	  | StackOffset s => StackOffset.layout s
+         fn Global g => Global.layout g
+          | Register r => Register.layout r
+          | StackOffset s => StackOffset.layout s
 
       val equals: t * t -> bool =
-	 fn (Global g, Global g') => Global.equals (g, g')
-	  | (Register r, Register r') => Register.equals (r, r')
-	  | (StackOffset s, StackOffset s') => StackOffset.equals (s, s')
-	  | _ => false
+         fn (Global g, Global g') => Global.equals (g, g')
+          | (Register r, Register r') => Register.equals (r, r')
+          | (StackOffset s, StackOffset s') => StackOffset.equals (s, s')
+          | _ => false
 
       val ty =
-	 fn Global g => Global.ty g
-	  | Register r => Register.ty r
-	  | StackOffset s => StackOffset.ty s
+         fn Global g => Global.ty g
+          | Register r => Register.ty r
+          | StackOffset s => StackOffset.ty s
 
       val isSubtype: t * t -> bool =
-	 fn (Global g, Global g') => Global.isSubtype (g, g')
-	  | (Register r, Register r') => Register.isSubtype (r, r')
-	  | (StackOffset s, StackOffset s') => StackOffset.isSubtype (s, s')
-	  | _ => false
+         fn (Global g, Global g') => Global.isSubtype (g, g')
+          | (Register r, Register r') => Register.isSubtype (r, r')
+          | (StackOffset s, StackOffset s') => StackOffset.isSubtype (s, s')
+          | _ => false
 
       val interfere: t * t -> bool =
-	 fn (l, l') =>
-	 equals (l, l')
-	 orelse (case (l, l') of
-		    (StackOffset s, StackOffset s') =>
-		       StackOffset.interfere (s, s')
-		  | _ => false)
+         fn (l, l') =>
+         equals (l, l')
+         orelse (case (l, l') of
+                    (StackOffset s, StackOffset s') =>
+                       StackOffset.interfere (s, s')
+                  | _ => false)
 
       val fromOperand: Operand.t -> t option =
-	 fn Operand.Global g => SOME (Global g)
-	  | Operand.Register r => SOME (Register r)
-	  | Operand.StackOffset s => SOME (StackOffset s)
-	  | _ => NONE
+         fn Operand.Global g => SOME (Global g)
+          | Operand.Register r => SOME (Register r)
+          | Operand.StackOffset s => SOME (StackOffset s)
+          | _ => NONE
 
       val toOperand: t -> Operand.t =
-	 fn Global g => Operand.Global g
-	  | Register r => Operand.Register r
-	  | StackOffset s => Operand.StackOffset s
+         fn Global g => Operand.Global g
+          | Register r => Operand.Register r
+          | StackOffset s => Operand.StackOffset s
    end
 
 structure Transfer =
    struct
       datatype t =
-	 Arith of {args: Operand.t vector,
-		   dst: Operand.t,
-		   overflow: Label.t,
-		   prim: Type.t Prim.t,
-		   success: Label.t}
+         Arith of {args: Operand.t vector,
+                   dst: Operand.t,
+                   overflow: Label.t,
+                   prim: Type.t Prim.t,
+                   success: Label.t}
        | CCall of {args: Operand.t vector,
-		   frameInfo: FrameInfo.t option,
-		   func: Type.t CFunction.t,
-		   return: Label.t option}
+                   frameInfo: FrameInfo.t option,
+                   func: Type.t CFunction.t,
+                   return: Label.t option}
        | Call of {label: Label.t,
-		  live: Live.t vector,
-		  return: {return: Label.t,
-			   handler: Label.t option,
-			   size: Bytes.t} option}
+                  live: Live.t vector,
+                  return: {return: Label.t,
+                           handler: Label.t option,
+                           size: Bytes.t} option}
        | Goto of Label.t
        | Raise
        | Return
        | Switch of Switch.t
 
       fun layout t =
-	 let
-	    open Layout
-	 in
-	    case t of
-	       Arith {prim, args, dst, overflow, success, ...} =>
-		  seq [str "Arith ",
-		       record [("prim", Prim.layout prim),
-			       ("args", Vector.layout Operand.layout args),
-			       ("dst", Operand.layout dst),
-			       ("overflow", Label.layout overflow),
-			       ("success", Label.layout success)]]
-	     | CCall {args, frameInfo, func, return} =>
-		  seq [str "CCall ",
-		       record
-		       [("args", Vector.layout Operand.layout args),
-			("frameInfo", Option.layout FrameInfo.layout frameInfo),
-			("func", CFunction.layout (func, Type.layout)),
-			("return", Option.layout Label.layout return)]]
-	     | Call {label, live, return} => 
-		  seq [str "Call ", 
-		       record [("label", Label.layout label),
-			       ("live", Vector.layout Live.layout live),
-			       ("return", Option.layout 
-				(fn {return, handler, size} =>
-				 record [("return", Label.layout return),
-					 ("handler",
-					  Option.layout Label.layout handler),
-					 ("size", Bytes.layout size)])
-				return)]]
-	     | Goto l => seq [str "Goto ", Label.layout l]
-	     | Raise => str "Raise"
-	     | Return => str "Return "
-	     | Switch s => Switch.layout s
-	 end
+         let
+            open Layout
+         in
+            case t of
+               Arith {prim, args, dst, overflow, success, ...} =>
+                  seq [str "Arith ",
+                       record [("prim", Prim.layout prim),
+                               ("args", Vector.layout Operand.layout args),
+                               ("dst", Operand.layout dst),
+                               ("overflow", Label.layout overflow),
+                               ("success", Label.layout success)]]
+             | CCall {args, frameInfo, func, return} =>
+                  seq [str "CCall ",
+                       record
+                       [("args", Vector.layout Operand.layout args),
+                        ("frameInfo", Option.layout FrameInfo.layout frameInfo),
+                        ("func", CFunction.layout (func, Type.layout)),
+                        ("return", Option.layout Label.layout return)]]
+             | Call {label, live, return} => 
+                  seq [str "Call ", 
+                       record [("label", Label.layout label),
+                               ("live", Vector.layout Live.layout live),
+                               ("return", Option.layout 
+                                (fn {return, handler, size} =>
+                                 record [("return", Label.layout return),
+                                         ("handler",
+                                          Option.layout Label.layout handler),
+                                         ("size", Bytes.layout size)])
+                                return)]]
+             | Goto l => seq [str "Goto ", Label.layout l]
+             | Raise => str "Raise"
+             | Return => str "Return "
+             | Switch s => Switch.layout s
+         end
 
        fun foldOperands (t, ac, f) =
- 	 case t of
- 	    Arith {args, dst, ...} => Vector.fold (args, f (dst, ac), f)
- 	  | CCall {args, ...} => Vector.fold (args, ac, f)
- 	  | Switch s =>
-	       Switch.foldLabelUse
-	       (s, ac, {label = fn (_, a) => a,
-			use = f})
- 	  | _ => ac
+         case t of
+            Arith {args, dst, ...} => Vector.fold (args, f (dst, ac), f)
+          | CCall {args, ...} => Vector.fold (args, ac, f)
+          | Switch s =>
+               Switch.foldLabelUse
+               (s, ac, {label = fn (_, a) => a,
+                        use = f})
+          | _ => ac
 
        fun foldDefs (t, a, f) =
-	 case t of
-	    Arith {dst, ...} => f (dst, a)
-	  | _ => a
+         case t of
+            Arith {dst, ...} => f (dst, a)
+          | _ => a
    end
 
 structure Kind =
    struct
       datatype t =
-	 Cont of {args: Live.t vector,
-		  frameInfo: FrameInfo.t}
+         Cont of {args: Live.t vector,
+                  frameInfo: FrameInfo.t}
        | CReturn of {dst: Live.t option,
-		     frameInfo: FrameInfo.t option,
-		     func: Type.t CFunction.t}
+                     frameInfo: FrameInfo.t option,
+                     func: Type.t CFunction.t}
        | Func
        | Handler of {frameInfo: FrameInfo.t,
-		     handles: Live.t vector}
+                     handles: Live.t vector}
        | Jump
 
       fun layout k =
-	 let
-	    open Layout
-	 in
-	    case k of
-	       Cont {args, frameInfo} =>
-		  seq [str "Cont ",
-		       record [("args", Vector.layout Live.layout args),
-			       ("frameInfo", FrameInfo.layout frameInfo)]]
-	     | CReturn {dst, frameInfo, func} =>
-		  seq [str "CReturn ",
-		       record
-		       [("dst", Option.layout Live.layout dst),
-			("frameInfo", Option.layout FrameInfo.layout frameInfo),
-			("func", CFunction.layout (func, Type.layout))]]
-	     | Func => str "Func"
-	     | Handler {frameInfo, handles} =>
-		  seq [str "Handler ",
-		       record [("frameInfo", FrameInfo.layout frameInfo),
-			       ("handles",
-				Vector.layout Live.layout handles)]]
-	     | Jump => str "Jump"
-	 end
+         let
+            open Layout
+         in
+            case k of
+               Cont {args, frameInfo} =>
+                  seq [str "Cont ",
+                       record [("args", Vector.layout Live.layout args),
+                               ("frameInfo", FrameInfo.layout frameInfo)]]
+             | CReturn {dst, frameInfo, func} =>
+                  seq [str "CReturn ",
+                       record
+                       [("dst", Option.layout Live.layout dst),
+                        ("frameInfo", Option.layout FrameInfo.layout frameInfo),
+                        ("func", CFunction.layout (func, Type.layout))]]
+             | Func => str "Func"
+             | Handler {frameInfo, handles} =>
+                  seq [str "Handler ",
+                       record [("frameInfo", FrameInfo.layout frameInfo),
+                               ("handles",
+                                Vector.layout Live.layout handles)]]
+             | Jump => str "Jump"
+         end
 
       val frameInfoOpt =
-	 fn Cont {frameInfo, ...} => SOME frameInfo
-	  | CReturn {frameInfo, ...} => frameInfo
-	  | Handler {frameInfo, ...} => SOME frameInfo
-	  | _ => NONE
+         fn Cont {frameInfo, ...} => SOME frameInfo
+          | CReturn {frameInfo, ...} => frameInfo
+          | Handler {frameInfo, ...} => SOME frameInfo
+          | _ => NONE
    end
 
 structure Block =
    struct
       datatype t = T of {kind: Kind.t,
-			 label: Label.t,
-			 live: Live.t vector,
-			 raises: Live.t vector option,
-			 returns: Live.t vector option,
-			 statements: Statement.t vector,
-			 transfer: Transfer.t}
+                         label: Label.t,
+                         live: Live.t vector,
+                         raises: Live.t vector option,
+                         returns: Live.t vector option,
+                         statements: Statement.t vector,
+                         transfer: Transfer.t}
 
       fun clear (T {label, ...}) = Label.clear label
 
       local
-	 fun make g (T r) = g r
+         fun make g (T r) = g r
       in
-	 val kind = make #kind
-	 val label = make #label
+         val kind = make #kind
+         val label = make #label
       end
 
       fun layout (T {kind, label, live, raises, returns, statements, transfer}) =
-	 let
-	    open Layout
-	 in
-	    align [seq [Label.layout label, 
-			str ": ",
-			record [("kind", Kind.layout kind),
-				("live", Vector.layout Live.layout live),
-				("raises",
-				 Option.layout (Vector.layout Live.layout)
-				 raises),
-				("returns",
-				 Option.layout (Vector.layout Live.layout)
-				 returns)]],
-		   indent (align
-			   [align (Vector.toListMap
-				   (statements, Statement.layout)),
-			    Transfer.layout transfer],
-			   4)]
-	 end
+         let
+            open Layout
+         in
+            align [seq [Label.layout label, 
+                        str ": ",
+                        record [("kind", Kind.layout kind),
+                                ("live", Vector.layout Live.layout live),
+                                ("raises",
+                                 Option.layout (Vector.layout Live.layout)
+                                 raises),
+                                ("returns",
+                                 Option.layout (Vector.layout Live.layout)
+                                 returns)]],
+                   indent (align
+                           [align (Vector.toListMap
+                                   (statements, Statement.layout)),
+                            Transfer.layout transfer],
+                           4)]
+         end
 
       fun layouts (block, output' : Layout.t -> unit) = output' (layout block)
 
       fun foldDefs (T {kind, statements, transfer, ...}, a, f) =
-	 let
-	    val a =
-	       case kind of
-		  Kind.CReturn {dst, ...} =>
-		     (case dst of
-			 NONE => a
-		       | SOME z => f (Live.toOperand z, a))
-		| _ => a
-	    val a =
-	       Vector.fold (statements, a, fn (s, a) =>
-			    Statement.foldDefs (s, a, f))
-	    val a = Transfer.foldDefs (transfer, a, f)
-	 in
-	    a
-	 end
+         let
+            val a =
+               case kind of
+                  Kind.CReturn {dst, ...} =>
+                     (case dst of
+                         NONE => a
+                       | SOME z => f (Live.toOperand z, a))
+                | _ => a
+            val a =
+               Vector.fold (statements, a, fn (s, a) =>
+                            Statement.foldDefs (s, a, f))
+            val a = Transfer.foldDefs (transfer, a, f)
+         in
+            a
+         end
    end
 
 structure Chunk =
    struct
       datatype t = T of {blocks: Block.t vector,
-			 chunkLabel: ChunkLabel.t,
-			 regMax: CType.t -> int}
+                         chunkLabel: ChunkLabel.t,
+                         regMax: CType.t -> int}
 
       fun layouts (T {blocks, ...}, output : Layout.t -> unit) =
-	 Vector.foreach (blocks, fn block => Block.layouts (block, output))
+         Vector.foreach (blocks, fn block => Block.layouts (block, output))
 
       fun clear (T {blocks, ...}) =
-	 Vector.foreach (blocks, Block.clear)
+         Vector.foreach (blocks, Block.clear)
    end
 
 structure ProfileInfo =
    struct
       datatype t =
-	 T of {frameSources: int vector,
-	       labels: {label: ProfileLabel.t,
-			sourceSeqsIndex: int} vector,
-	       names: string vector,
-	       sourceSeqs: int vector vector,
-	       sources: {nameIndex: int,
-			 successorsIndex: int} vector}
+         T of {frameSources: int vector,
+               labels: {label: ProfileLabel.t,
+                        sourceSeqsIndex: int} vector,
+               names: string vector,
+               sourceSeqs: int vector vector,
+               sources: {nameIndex: int,
+                         successorsIndex: int} vector}
 
       val empty = T {frameSources = Vector.new0 (),
-		     labels = Vector.new0 (),
-		     names = Vector.new0 (),
-		     sourceSeqs = Vector.new0 (),
-		     sources = Vector.new0 ()}
+                     labels = Vector.new0 (),
+                     names = Vector.new0 (),
+                     sourceSeqs = Vector.new0 (),
+                     sources = Vector.new0 ()}
 
       fun clear (T {labels, ...}) =
-	 Vector.foreach (labels, ProfileLabel.clear o #label)
+         Vector.foreach (labels, ProfileLabel.clear o #label)
 
       fun layout (T {frameSources, labels, names, sourceSeqs, sources}) =
-	 Layout.record
-	 [("frameSources", Vector.layout Int.layout frameSources),
-	  ("labels",
-	   Vector.layout (fn {label, sourceSeqsIndex} =>
-			  Layout.record
-			  [("label", ProfileLabel.layout label),
-			   ("sourceSeqsIndex",
-			    Int.layout sourceSeqsIndex)])
-	   labels),
-	  ("names", Vector.layout String.layout names),
-	  ("sourceSeqs", Vector.layout (Vector.layout Int.layout) sourceSeqs),
-	  ("sources",
-	   Vector.layout (fn {nameIndex, successorsIndex} =>
-			  Layout.record [("nameIndex", Int.layout nameIndex),
-					 ("successorsIndex",
-					  Int.layout successorsIndex)])
-	   sources)]
+         Layout.record
+         [("frameSources", Vector.layout Int.layout frameSources),
+          ("labels",
+           Vector.layout (fn {label, sourceSeqsIndex} =>
+                          Layout.record
+                          [("label", ProfileLabel.layout label),
+                           ("sourceSeqsIndex",
+                            Int.layout sourceSeqsIndex)])
+           labels),
+          ("names", Vector.layout String.layout names),
+          ("sourceSeqs", Vector.layout (Vector.layout Int.layout) sourceSeqs),
+          ("sources",
+           Vector.layout (fn {nameIndex, successorsIndex} =>
+                          Layout.record [("nameIndex", Int.layout nameIndex),
+                                         ("successorsIndex",
+                                          Int.layout successorsIndex)])
+           sources)]
 
       fun layouts (pi, output) = output (layout pi)
 
       fun isOK (T {frameSources, labels, names, sourceSeqs, sources}): bool =
-	 let
-	    val namesLength = Vector.length names
-	    val sourceSeqsLength = Vector.length sourceSeqs
-	    val sourcesLength = Vector.length sources
-	 in
-	    !Control.profile = Control.ProfileNone
-	    orelse
-	    (Vector.forall (frameSources, fn i =>
-			    0 <= i andalso i < sourceSeqsLength)
-	     andalso (Vector.forall
-		      (labels, fn {sourceSeqsIndex = i, ...} =>
-		       0 <= i andalso i < sourceSeqsLength))
-	     andalso (Vector.forall
-		      (sourceSeqs, fn v =>
-		       Vector.forall
-		       (v, fn i => 0 <= i andalso i < sourcesLength)))
-	     andalso (Vector.forall
-		      (sources, fn {nameIndex, successorsIndex} =>
-		       0 <= nameIndex
-		       andalso nameIndex < namesLength
-		       andalso 0 <= successorsIndex
-		       andalso successorsIndex < sourceSeqsLength)))
-	 end
+         let
+            val namesLength = Vector.length names
+            val sourceSeqsLength = Vector.length sourceSeqs
+            val sourcesLength = Vector.length sources
+         in
+            !Control.profile = Control.ProfileNone
+            orelse
+            (Vector.forall (frameSources, fn i =>
+                            0 <= i andalso i < sourceSeqsLength)
+             andalso (Vector.forall
+                      (labels, fn {sourceSeqsIndex = i, ...} =>
+                       0 <= i andalso i < sourceSeqsLength))
+             andalso (Vector.forall
+                      (sourceSeqs, fn v =>
+                       Vector.forall
+                       (v, fn i => 0 <= i andalso i < sourcesLength)))
+             andalso (Vector.forall
+                      (sources, fn {nameIndex, successorsIndex} =>
+                       0 <= nameIndex
+                       andalso nameIndex < namesLength
+                       andalso 0 <= successorsIndex
+                       andalso successorsIndex < sourceSeqsLength)))
+         end
 
        fun modify (T {frameSources, labels, names, sourceSeqs, sources})
-	  : {newProfileLabel: ProfileLabel.t -> ProfileLabel.t,
-	     delProfileLabel: ProfileLabel.t -> unit,
-	     getProfileInfo: unit -> t} =
-	  let
-	     val {get: ProfileLabel.t -> int, set, ...} =
-	        Property.getSet
-		(ProfileLabel.plist, 
-		 Property.initRaise ("ProfileInfo.extend", ProfileLabel.layout))
-	     val _ =
-	        Vector.foreach
-		(labels, fn {label, sourceSeqsIndex} =>
-		 set (label, sourceSeqsIndex))
-	     val new = ref []
-	     fun newProfileLabel l =
-	       let
-		  val i = get l
-		  val l' = ProfileLabel.new ()
-		  val _ = set (l', i)
-		  val _ = List.push (new, {label = l', sourceSeqsIndex = i})
-	       in
-		  l'
-	       end
-	     fun delProfileLabel l = set (l, ~1)
-	     fun getProfileInfo () =
-	        let
-		   val labels = Vector.concat
-		                [labels, Vector.fromList (!new)]
-		   val labels = Vector.keepAll
-		                (labels, fn {label, ...} =>
-				 get label <> ~1)
-		   val pi = T {frameSources = frameSources,
-			       labels = Vector.concat
-			                [labels, Vector.fromList (!new)],
-			       names = names,
-			       sourceSeqs = sourceSeqs,
-			       sources = sources}
-		in
-		  Assert.assert ("newProfileInfo", fn () => isOK pi);
-		  pi
-		end
-	  in
-	     {newProfileLabel = newProfileLabel,
-	      delProfileLabel = delProfileLabel,
-	      getProfileInfo = getProfileInfo}
-	  end
+          : {newProfileLabel: ProfileLabel.t -> ProfileLabel.t,
+             delProfileLabel: ProfileLabel.t -> unit,
+             getProfileInfo: unit -> t} =
+          let
+             val {get: ProfileLabel.t -> int, set, ...} =
+                Property.getSet
+                (ProfileLabel.plist, 
+                 Property.initRaise ("ProfileInfo.extend", ProfileLabel.layout))
+             val _ =
+                Vector.foreach
+                (labels, fn {label, sourceSeqsIndex} =>
+                 set (label, sourceSeqsIndex))
+             val new = ref []
+             fun newProfileLabel l =
+               let
+                  val i = get l
+                  val l' = ProfileLabel.new ()
+                  val _ = set (l', i)
+                  val _ = List.push (new, {label = l', sourceSeqsIndex = i})
+               in
+                  l'
+               end
+             fun delProfileLabel l = set (l, ~1)
+             fun getProfileInfo () =
+                let
+                   val labels = Vector.concat
+                                [labels, Vector.fromList (!new)]
+                   val labels = Vector.keepAll
+                                (labels, fn {label, ...} =>
+                                 get label <> ~1)
+                   val pi = T {frameSources = frameSources,
+                               labels = Vector.concat
+                                        [labels, Vector.fromList (!new)],
+                               names = names,
+                               sourceSeqs = sourceSeqs,
+                               sources = sources}
+                in
+                  Assert.assert ("Machine.getProfileInfo", fn () => isOK pi);
+                  pi
+                end
+          in
+             {newProfileLabel = newProfileLabel,
+              delProfileLabel = delProfileLabel,
+              getProfileInfo = getProfileInfo}
+          end
    end
 
 structure Program =
    struct
       datatype t = T of {chunks: Chunk.t list,
-			 frameLayouts: {frameOffsetsIndex: int,
-					isC: bool,
-					size: Bytes.t} vector,
-			 frameOffsets: Bytes.t vector vector,
-			 handlesSignals: bool,
-			 intInfs: (Global.t * string) list,
-			 main: {chunkLabel: ChunkLabel.t,
-				label: Label.t},
-			 maxFrameSize: Bytes.t,
-			 objectTypes: ObjectType.t vector,
-			 profileInfo: ProfileInfo.t option,
-			 reals: (Global.t * RealX.t) list,
-			 vectors: (Global.t * WordXVector.t) list}
+                         frameLayouts: {frameOffsetsIndex: int,
+                                        isC: bool,
+                                        size: Bytes.t} vector,
+                         frameOffsets: Bytes.t vector vector,
+                         handlesSignals: bool,
+                         intInfs: (Global.t * string) list,
+                         main: {chunkLabel: ChunkLabel.t,
+                                label: Label.t},
+                         maxFrameSize: Bytes.t,
+                         objectTypes: ObjectType.t vector,
+                         profileInfo: ProfileInfo.t option,
+                         reals: (Global.t * RealX.t) list,
+                         vectors: (Global.t * WordXVector.t) list}
 
       fun clear (T {chunks, profileInfo, ...}) =
-	 (List.foreach (chunks, Chunk.clear)
-	  ; Option.app (profileInfo, ProfileInfo.clear))
+         (List.foreach (chunks, Chunk.clear)
+          ; Option.app (profileInfo, ProfileInfo.clear))
 
       fun frameSize (T {frameLayouts, ...},
-		     FrameInfo.T {frameLayoutsIndex, ...}) =
-	 #size (Vector.sub (frameLayouts, frameLayoutsIndex))
+                     FrameInfo.T {frameLayoutsIndex, ...}) =
+         #size (Vector.sub (frameLayouts, frameLayoutsIndex))
 
       fun layouts (T {chunks, frameLayouts, frameOffsets, handlesSignals,
-		      main = {label, ...},
-		      maxFrameSize, objectTypes, profileInfo, ...},
-		   output': Layout.t -> unit) =
-	 let
-	    open Layout
-	    val output = output'
-	 in
-	    output (record
-		    [("handlesSignals", Bool.layout handlesSignals),
-		     ("main", Label.layout label),
-		     ("maxFrameSize", Bytes.layout maxFrameSize),
-		     ("frameOffsets",
-		      Vector.layout (Vector.layout Bytes.layout) frameOffsets),
-		     ("frameLayouts",
-		      Vector.layout (fn {frameOffsetsIndex, isC, size} =>
-				     record [("frameOffsetsIndex",
-					      Int.layout frameOffsetsIndex),
-					     ("isC", Bool.layout isC),
-					     ("size", Bytes.layout size)])
-		      frameLayouts)])
-	    ; Option.app (profileInfo, fn pi =>
-			  (output (str "\nProfileInfo:")
-			   ; ProfileInfo.layouts (pi, output)))
-	    ; output (str "\nObjectTypes:")
-	    ; Vector.foreachi (objectTypes, fn (i, ty) =>
-			       output (seq [str "pt_", Int.layout i,
-					    str " = ", ObjectType.layout ty]))
-	    ; output (str "\n")
+                      main = {label, ...},
+                      maxFrameSize, objectTypes, profileInfo, ...},
+                   output': Layout.t -> unit) =
+         let
+            open Layout
+            val output = output'
+         in
+            output (record
+                    [("handlesSignals", Bool.layout handlesSignals),
+                     ("main", Label.layout label),
+                     ("maxFrameSize", Bytes.layout maxFrameSize),
+                     ("frameOffsets",
+                      Vector.layout (Vector.layout Bytes.layout) frameOffsets),
+                     ("frameLayouts",
+                      Vector.layout (fn {frameOffsetsIndex, isC, size} =>
+                                     record [("frameOffsetsIndex",
+                                              Int.layout frameOffsetsIndex),
+                                             ("isC", Bool.layout isC),
+                                             ("size", Bytes.layout size)])
+                      frameLayouts)])
+            ; Option.app (profileInfo, fn pi =>
+                          (output (str "\nProfileInfo:")
+                           ; ProfileInfo.layouts (pi, output)))
+            ; output (str "\nObjectTypes:")
+            ; Vector.foreachi (objectTypes, fn (i, ty) =>
+                               output (seq [str "pt_", Int.layout i,
+                                            str " = ", ObjectType.layout ty]))
+            ; output (str "\n")
             ; List.foreach (chunks, fn chunk => Chunk.layouts (chunk, output))
-	 end
+         end
 
       structure Alloc =
-	 struct
-	    datatype t = T of Live.t list
+         struct
+            datatype t = T of Live.t list
 
-	    fun layout (T ds) = List.layout Live.layout ds
+            fun layout (T ds) = List.layout Live.layout ds
 
-	    fun forall (T ds, f) = List.forall (ds, f o Live.toOperand)
+            fun forall (T ds, f) = List.forall (ds, f o Live.toOperand)
 
-	    fun defineLive (T ls, l) = T (l :: ls)
-	       
-	    fun define (T ds, z) =
-	       case Live.fromOperand z of
-		  NONE => T ds
-		| SOME d => T (d :: ds)
+            fun defineLive (T ls, l) = T (l :: ls)
+               
+            fun define (T ds, z) =
+               case Live.fromOperand z of
+                  NONE => T ds
+                | SOME d => T (d :: ds)
 
-	    val new: Live.t list -> t = T
+            val new: Live.t list -> t = T
 
-	    fun doesDefine (T ls, l': Live.t): bool =
-	       let
-		  val oper' = Live.toOperand l'
-	       in
-		  case List.peek (ls, fn l =>
-				  Operand.interfere (Live.toOperand l, oper')) of
-		     NONE => false
-		   | SOME l => Live.isSubtype (l, l')
-	       end
+            fun doesDefine (T ls, l': Live.t): bool =
+               let
+                  val oper' = Live.toOperand l'
+               in
+                  case List.peek (ls, fn l =>
+                                  Operand.interfere (Live.toOperand l, oper')) of
+                     NONE => false
+                   | SOME l => Live.isSubtype (l, l')
+               end
 
-	    val doesDefine =
-	       Trace.trace2 ("Alloc.doesDefine", layout, Live.layout,
-			     Bool.layout)
-	       doesDefine
-	 end
+            val doesDefine =
+               Trace.trace2 
+               ("Machine.Program.Alloc.doesDefine", 
+                layout, Live.layout, Bool.layout)
+               doesDefine
+         end
 
       fun typeCheck (program as
-		     T {chunks, frameLayouts, frameOffsets, intInfs,
-			maxFrameSize, objectTypes, profileInfo, reals,
-			vectors, ...}) =
-	 let
-	    val _ =
-	       if !Control.profile = Control.ProfileTime
-		  then
-		     List.foreach
-		     (chunks, fn Chunk.T {blocks, ...} =>
-		      Vector.foreach
-		      (blocks, fn Block.T {kind, label, statements, ...} =>
-		       if (case kind of
-			      Kind.Func => true
-			    | _ => false)
-			  orelse (0 < Vector.length statements
-				  andalso (case Vector.sub (statements, 0) of
-					      Statement.ProfileLabel _ => true
-					    | _ => false))
-			  then ()
-		       else print (concat ["missing profile info: ",
-					   Label.toString label, "\n"])))
-	       else ()
-	    val profileLabelIsOk =
-	       case profileInfo of
-		  NONE =>
-		     if !Control.profile = Control.ProfileNone
-			then fn _ => false
-		     else Error.bug "profileInfo = NONE"
-		| SOME (ProfileInfo.T {frameSources,
-				       labels = profileLabels, ...}) =>
-		     if !Control.profile = Control.ProfileNone
-			orelse (Vector.length frameSources
-				<> Vector.length frameLayouts)
-			then Error.bug "profileInfo = SOME"
-		     else
-			let
-			   val {get = profileLabelCount, ...} =
-			      Property.get
-			      (ProfileLabel.plist,
-			       Property.initFun (fn _ => ref 0))
-			   val _ =
-			      Vector.foreach
-			      (profileLabels, fn {label, ...} =>
-			       let
-				  val r = profileLabelCount label
-			       in
-				  if 0 = !r
-				     then r := 1
-				  else Error.bug "duplicate profile label"
-			       end)
-			in
-			   fn l =>
-			   let
-			      val r = profileLabelCount l
-			   in
-			      if 1 = !r 
-				 then (r := 2; true)
-			      else false
-			   end
-			end
-	    fun getFrameInfo (FrameInfo.T {frameLayoutsIndex, ...}) =
-	       Vector.sub (frameLayouts, frameLayoutsIndex)
-	    val _ =
-	       Vector.foreach
-	       (frameLayouts, fn {frameOffsetsIndex, size, ...} =>
-		Err.check
-		("frameLayouts",
-		 fn () => (0 <= frameOffsetsIndex
-			   andalso frameOffsetsIndex < Vector.length frameOffsets
-			   andalso Bytes.<= (size, maxFrameSize)
-			   andalso Bytes.<= (size, Runtime.maxFrameSize)
-			   andalso Bytes.isWordAligned size),
-		 fn () => Layout.record [("frameOffsetsIndex",
-					  Int.layout frameOffsetsIndex),
-					 ("size", Bytes.layout size)]))
-	    val _ =
-	       Vector.foreach
-	       (objectTypes, fn ty =>
-		Err.check ("objectType",
-			   fn () => ObjectType.isOk ty,
-			   fn () => ObjectType.layout ty))
-	    fun tyconTy (pt: PointerTycon.t): ObjectType.t =
-	       Vector.sub (objectTypes, PointerTycon.index pt)
-	    open Layout
-	    fun globals (name, gs, isOk, layout) =
-	       List.foreach
-	       (gs, fn (g, s) =>
-		let
-		   val ty = Global.ty g
-		in
-		   Err.check
-		   (concat ["global ", name],
-		    fn () => isOk (ty, s),
-		    fn () => seq [layout s, str ": ", Type.layout ty])
-		end)
-	    val _ =
-	       globals ("real", reals,
-			fn (t, r) => Type.equals (t, Type.real (RealX.size r)),
-			RealX.layout)
-	    val _ =
-	       globals ("intInf", intInfs,
-			fn (t, _) => Type.isSubtype (t, Type.intInf),
-			String.layout)
-	    val _ =
-	       globals ("vector", vectors,
-			fn (t, v) =>
-			Type.equals (t, Type.ofWordVector v),
-			WordXVector.layout)
-	    (* Check for no duplicate labels. *)
-	    local
-	       val {get, ...} =
-		  Property.get (Label.plist,
-				Property.initFun (fn _ => ref false))
-	    in
-	       val _ =
-		  List.foreach
-		  (chunks, fn Chunk.T {blocks, ...} =>
-		   Vector.foreach
-		   (blocks, fn Block.T {label, ...} =>
-		    let
-		       val r = get label
-		    in
-		       if !r
-			  then Error.bug "duplicate label"
-		       else r := true
-		    end))
-	    end
-	    val {get = labelBlock: Label.t -> Block.t,
-		 set = setLabelBlock, ...} =
-	       Property.getSetOnce (Label.plist,
-				    Property.initRaise ("block", Label.layout))
-	    val _ =
-	       List.foreach
-	       (chunks, fn Chunk.T {blocks, ...} =>
-		Vector.foreach
-		(blocks, fn b as Block.T {label, ...} =>
-		 setLabelBlock (label, b)))
-	    fun checkOperand (x: Operand.t, alloc: Alloc.t): unit =
-	       let
-		  datatype z = datatype Operand.t
-		  fun ok () =
-		     case x of
-			ArrayOffset {base, index, offset, scale, ty} =>
-			   (checkOperand (base, alloc)
-			    ; checkOperand (index, alloc)
-			    ; (Operand.isLocation base
-			       andalso
-			       (Type.arrayOffsetIsOk {base = Operand.ty base,
-						      index = Operand.ty index,
-						      offset = offset,
-						      pointerTy = tyconTy,
-						      result = ty,
-						      scale = scale})))
-		      | Cast (z, t) =>
-			   (checkOperand (z, alloc)
-			    ; (Type.castIsOk
-			       {from = Operand.ty z,
-				to = t,
-				tyconTy = tyconTy}))
-		      | Contents {oper, ...} =>
-			   (checkOperand (oper, alloc)
-			    ; Type.isCPointer (Operand.ty oper))
-		      | File => true
-		      | Frontier => true
-		      | GCState => true
-		      | Global _ =>
-			   (* We don't check that globals are defined because
-			    * they aren't captured by liveness info.  It would
-			    * be nice to fix this.
-			    *)
-			   true
-		      | Label l => 
-			   (let val _ = labelBlock l
-			    in true
-			    end handle _ => false)
-		      | Line => true
-		      | Offset {base, offset, ty} =>
-			   (checkOperand (base, alloc)
-			    ; (Operand.isLocation base
-			       andalso
-			       (case base of
-				  Operand.GCState => true
-				| _ => 
-				     Type.offsetIsOk {base = Operand.ty base,
-						      offset = offset,
-						      pointerTy = tyconTy,
-						      result = ty})))
-		      | Real _ => true
-		      | Register r => Alloc.doesDefine (alloc, Live.Register r)
-		      | StackOffset (so as StackOffset.T {offset, ty, ...}) =>
-			   Bytes.<= (Bytes.+ (offset, Type.bytes ty),
-				     maxFrameSize)
-			   andalso Alloc.doesDefine (alloc, Live.StackOffset so)
-			   andalso (case Type.deLabel ty of
-				       NONE => true
-				     | SOME l =>
-					  let
-					     val Block.T {kind, ...} =
-						labelBlock l
-					     fun doit fi =
-						let
-						   val {size, ...} =
-						      getFrameInfo fi
-						in
-						   Bytes.equals
-						   (size,
-						    Bytes.+ (offset,
-							     Runtime.labelSize))
-						end
-					  in
-					     case kind of
-						Kind.Cont {frameInfo, ...} =>
-						   doit frameInfo
-					      | Kind.CReturn {frameInfo, ...} =>
-						   (case frameInfo of
-						       NONE => true
-						     | SOME fi => doit fi)
-					      | Kind.Func => true
-					      | Kind.Handler {frameInfo, ...} =>
-						   doit frameInfo
-					      | Kind.Jump => true
-					  end)
-		      | StackTop => true
-		      | Word _ => true
-	       in
-		  Err.check ("operand", ok, fn () => Operand.layout x)
-	       end
-	    fun checkOperands (v, a) =
-	       Vector.foreach (v, fn z => checkOperand (z, a))
-	    fun check' (x, name, isOk, layout) =
-	       Err.check (name, fn () => isOk x, fn () => layout x)
-	    val labelKind = Block.kind o labelBlock
-	    fun checkKind (k: Kind.t, alloc: Alloc.t): Alloc.t option =
-	       let
-		  datatype z = datatype Kind.t
-		  exception No
-		  fun frame (FrameInfo.T {frameLayoutsIndex},
-			     useSlots: bool,
-			     isC: bool): bool =
-		     let
-			val {frameOffsetsIndex, isC = isC', ...} =
-			   Vector.sub (frameLayouts, frameLayoutsIndex)
-			   handle Subscript => raise No
-		     in
-			isC = isC'
-			andalso
-			(not useSlots
-			 orelse
-			 let
-			    val Alloc.T zs = alloc
-			    val liveOffsets =
-			       List.fold
-			       (zs, [], fn (z, liveOffsets) =>
-				case z of
-				   Live.StackOffset (StackOffset.T {offset, ty}) =>
-				      if Type.isPointer ty
-					 then offset :: liveOffsets
-				      else liveOffsets
-				 | _ => raise No)
-			    val liveOffsets =
-			       Vector.fromArray
-			       (QuickSort.sortArray
-				(Array.fromList liveOffsets, Bytes.<=))
-			    val liveOffsets' =
-			       Vector.sub (frameOffsets, frameOffsetsIndex)
-			       handle Subscript => raise No
-			 in
-			    Vector.equals (liveOffsets, liveOffsets',
-					   Bytes.equals)
-			 end)
-		     end handle No => false
-		  fun slotsAreInFrame (fi: FrameInfo.t): bool =
-		     let
-			val {size, ...} = getFrameInfo fi
-		     in
-			Alloc.forall
-			(alloc, fn z =>
-			 case z of
-			    Operand.StackOffset (StackOffset.T {offset, ty}) =>
-			       Bytes.<= (Bytes.+ (offset, Type.bytes ty), size)
-			  | _ => false)
-		     end
-	       in
-		  case k of
-		     Cont {args, frameInfo} =>
-			if frame (frameInfo, true, false)
-			   andalso slotsAreInFrame frameInfo
-			   then SOME (Vector.fold
-				      (args, alloc, fn (z, alloc) =>
-				       Alloc.defineLive (alloc, z)))
-			else NONE
-		   | CReturn {dst, frameInfo, func, ...} =>
-			let
-			   val ok =
-			      (case dst of
-				  NONE => true
-				| SOME z =>
-				     Type.isSubtype (CFunction.return func,
-						     Live.ty z))
+                     T {chunks, frameLayouts, frameOffsets, intInfs,
+                        maxFrameSize, objectTypes, profileInfo, reals,
+                        vectors, ...}) =
+         let
+            val _ =
+               if !Control.profile = Control.ProfileTimeLabel
+                  then
+                     List.foreach
+                     (chunks, fn Chunk.T {blocks, ...} =>
+                      Vector.foreach
+                      (blocks, fn Block.T {kind, label, statements, ...} =>
+                       if (case kind of
+                              Kind.Func => true
+                            | _ => false)
+                          orelse (0 < Vector.length statements
+                                  andalso (case Vector.sub (statements, 0) of
+                                              Statement.ProfileLabel _ => true
+                                            | _ => false))
+                          then ()
+                       else print (concat ["missing profile info: ",
+                                           Label.toString label, "\n"])))
+               else ()
+            val profileLabelIsOk =
+               case profileInfo of
+                  NONE =>
+                     if !Control.profile = Control.ProfileNone
+                        then fn _ => false
+                     else Error.bug 
+                          "Machine.Program.typeCheck.profileLabelIsOk: profileInfo = NONE"
+                | SOME (ProfileInfo.T {frameSources,
+                                       labels = profileLabels, ...}) =>
+                     if !Control.profile = Control.ProfileNone
+                        orelse (Vector.length frameSources
+                                <> Vector.length frameLayouts)
+                        then Error.bug 
+                             "Machine.Program.typeCheck.profileLabelIsOk: profileInfo = SOME"
+                     else
+                        let
+                           val {get = profileLabelCount, ...} =
+                              Property.get
+                              (ProfileLabel.plist,
+                               Property.initFun (fn _ => ref 0))
+                           val _ =
+                              Vector.foreach
+                              (profileLabels, fn {label, ...} =>
+                               let
+                                  val r = profileLabelCount label
+                               in
+                                  if 0 = !r
+                                     then r := 1
+                                  else Error.bug 
+                                       "Machine.Program.typeCheck.profileLabelIsOk: duplicate profile label"
+                               end)
+                        in
+                           fn l =>
+                           let
+                              val r = profileLabelCount l
+                           in
+                              if 1 = !r 
+                                 then (r := 2; true)
+                              else false
+                           end
+                        end
+            fun getFrameInfo (FrameInfo.T {frameLayoutsIndex, ...}) =
+               Vector.sub (frameLayouts, frameLayoutsIndex)
+            val _ =
+               Vector.foreach
+               (frameLayouts, fn {frameOffsetsIndex, size, ...} =>
+                Err.check
+                ("frameLayouts",
+                 fn () => (0 <= frameOffsetsIndex
+                           andalso frameOffsetsIndex < Vector.length frameOffsets
+                           andalso Bytes.<= (size, maxFrameSize)
+                           andalso Bytes.<= (size, Runtime.maxFrameSize)
+                           andalso Bytes.isWordAligned size),
+                 fn () => Layout.record [("frameOffsetsIndex",
+                                          Int.layout frameOffsetsIndex),
+                                         ("size", Bytes.layout size)]))
+            val _ =
+               Vector.foreach
+               (objectTypes, fn ty =>
+                Err.check ("objectType",
+                           fn () => ObjectType.isOk ty,
+                           fn () => ObjectType.layout ty))
+            fun tyconTy (pt: PointerTycon.t): ObjectType.t =
+               Vector.sub (objectTypes, PointerTycon.index pt)
+            open Layout
+            fun globals (name, gs, isOk, layout) =
+               List.foreach
+               (gs, fn (g, s) =>
+                let
+                   val ty = Global.ty g
+                in
+                   Err.check
+                   (concat ["global ", name],
+                    fn () => isOk (ty, s),
+                    fn () => seq [layout s, str ": ", Type.layout ty])
+                end)
+            val _ =
+               globals ("real", reals,
+                        fn (t, r) => Type.equals (t, Type.real (RealX.size r)),
+                        RealX.layout)
+            val _ =
+               globals ("intInf", intInfs,
+                        fn (t, _) => Type.isSubtype (t, Type.intInf),
+                        String.layout)
+            val _ =
+               globals ("vector", vectors,
+                        fn (t, v) =>
+                        Type.equals (t, Type.ofWordVector v),
+                        WordXVector.layout)
+            (* Check for no duplicate labels. *)
+            local
+               val {get, ...} =
+                  Property.get (Label.plist,
+                                Property.initFun (fn _ => ref false))
+            in
+               val _ =
+                  List.foreach
+                  (chunks, fn Chunk.T {blocks, ...} =>
+                   Vector.foreach
+                   (blocks, fn Block.T {label, ...} =>
+                    let
+                       val r = get label
+                    in
+                       if !r
+                          then Error.bug "Machine.Program.typeCheck: duplicate label"
+                       else r := true
+                    end))
+            end
+            val {get = labelBlock: Label.t -> Block.t,
+                 set = setLabelBlock, ...} =
+               Property.getSetOnce (Label.plist,
+                                    Property.initRaise ("block", Label.layout))
+            val _ =
+               List.foreach
+               (chunks, fn Chunk.T {blocks, ...} =>
+                Vector.foreach
+                (blocks, fn b as Block.T {label, ...} =>
+                 setLabelBlock (label, b)))
+            fun checkOperand (x: Operand.t, alloc: Alloc.t): unit =
+               let
+                  datatype z = datatype Operand.t
+                  fun ok () =
+                     case x of
+                        ArrayOffset {base, index, offset, scale, ty} =>
+                           (checkOperand (base, alloc)
+                            ; checkOperand (index, alloc)
+                            ; (Operand.isLocation base
+                               andalso
+                               (Type.arrayOffsetIsOk {base = Operand.ty base,
+                                                      index = Operand.ty index,
+                                                      offset = offset,
+                                                      pointerTy = tyconTy,
+                                                      result = ty,
+                                                      scale = scale})))
+                      | Cast (z, t) =>
+                           (checkOperand (z, alloc)
+                            ; (Type.castIsOk
+                               {from = Operand.ty z,
+                                to = t,
+                                tyconTy = tyconTy}))
+                      | Contents {oper, ...} =>
+                           (checkOperand (oper, alloc)
+                            ; Type.isCPointer (Operand.ty oper))
+                      | File => true
+                      | Frontier => true
+                      | GCState => true
+                      | Global _ =>
+                           (* We don't check that globals are defined because
+                            * they aren't captured by liveness info.  It would
+                            * be nice to fix this.
+                            *)
+                           true
+                      | Label l => 
+                           (let val _ = labelBlock l
+                            in true
+                            end handle _ => false)
+                      | Line => true
+                      | Offset {base, offset, ty} =>
+                           (checkOperand (base, alloc)
+                            ; (Operand.isLocation base
+                               andalso
+                               (case base of
+                                  Operand.GCState => true
+                                | _ => 
+                                     Type.offsetIsOk {base = Operand.ty base,
+                                                      offset = offset,
+                                                      pointerTy = tyconTy,
+                                                      result = ty})))
+                      | Real _ => true
+                      | Register r => Alloc.doesDefine (alloc, Live.Register r)
+                      | StackOffset (so as StackOffset.T {offset, ty, ...}) =>
+                           Bytes.<= (Bytes.+ (offset, Type.bytes ty),
+                                     maxFrameSize)
+                           andalso Alloc.doesDefine (alloc, Live.StackOffset so)
+                           andalso (case Type.deLabel ty of
+                                       NONE => true
+                                     | SOME l =>
+                                          let
+                                             val Block.T {kind, ...} =
+                                                labelBlock l
+                                             fun doit fi =
+                                                let
+                                                   val {size, ...} =
+                                                      getFrameInfo fi
+                                                in
+                                                   Bytes.equals
+                                                   (size,
+                                                    Bytes.+ (offset,
+                                                             Runtime.labelSize))
+                                                end
+                                          in
+                                             case kind of
+                                                Kind.Cont {frameInfo, ...} =>
+                                                   doit frameInfo
+                                              | Kind.CReturn {frameInfo, ...} =>
+                                                   (case frameInfo of
+                                                       NONE => true
+                                                     | SOME fi => doit fi)
+                                              | Kind.Func => true
+                                              | Kind.Handler {frameInfo, ...} =>
+                                                   doit frameInfo
+                                              | Kind.Jump => true
+                                          end)
+                      | StackTop => true
+                      | Word _ => true
+               in
+                  Err.check ("operand", ok, fn () => Operand.layout x)
+               end
+            fun checkOperands (v, a) =
+               Vector.foreach (v, fn z => checkOperand (z, a))
+            fun check' (x, name, isOk, layout) =
+               Err.check (name, fn () => isOk x, fn () => layout x)
+            val labelKind = Block.kind o labelBlock
+            fun checkKind (k: Kind.t, alloc: Alloc.t): Alloc.t option =
+               let
+                  datatype z = datatype Kind.t
+                  exception No
+                  fun frame (FrameInfo.T {frameLayoutsIndex},
+                             useSlots: bool,
+                             isC: bool): bool =
+                     let
+                        val {frameOffsetsIndex, isC = isC', ...} =
+                           Vector.sub (frameLayouts, frameLayoutsIndex)
+                           handle Subscript => raise No
+                     in
+                        isC = isC'
+                        andalso
+                        (not useSlots
+                         orelse
+                         let
+                            val Alloc.T zs = alloc
+                            val liveOffsets =
+                               List.fold
+                               (zs, [], fn (z, liveOffsets) =>
+                                case z of
+                                   Live.StackOffset (StackOffset.T {offset, ty}) =>
+                                      if Type.isPointer ty
+                                         then offset :: liveOffsets
+                                      else liveOffsets
+                                 | _ => raise No)
+                            val liveOffsets = Array.fromList liveOffsets
+                            val () = QuickSort.sortArray (liveOffsets, Bytes.<=)
+                            val liveOffsets = Vector.fromArray liveOffsets
+                            val liveOffsets' =
+                               Vector.sub (frameOffsets, frameOffsetsIndex)
+                               handle Subscript => raise No
+                         in
+                            Vector.equals (liveOffsets, liveOffsets',
+                                           Bytes.equals)
+                         end)
+                     end handle No => false
+                  fun slotsAreInFrame (fi: FrameInfo.t): bool =
+                     let
+                        val {size, ...} = getFrameInfo fi
+                     in
+                        Alloc.forall
+                        (alloc, fn z =>
+                         case z of
+                            Operand.StackOffset (StackOffset.T {offset, ty}) =>
+                               Bytes.<= (Bytes.+ (offset, Type.bytes ty), size)
+                          | _ => false)
+                     end
+               in
+                  case k of
+                     Cont {args, frameInfo} =>
+                        if frame (frameInfo, true, false)
+                           andalso slotsAreInFrame frameInfo
+                           then SOME (Vector.fold
+                                      (args, alloc, fn (z, alloc) =>
+                                       Alloc.defineLive (alloc, z)))
+                        else NONE
+                   | CReturn {dst, frameInfo, func, ...} =>
+                        let
+                           val ok =
+                              (case dst of
+                                  NONE => true
+                                | SOME z =>
+                                     Type.isSubtype (CFunction.return func,
+                                                     Live.ty z))
                               andalso
-			      (if CFunction.mayGC func
-				  then (case frameInfo of
-					   NONE => false
-					 | SOME fi =>
-					      (frame (fi, true, true)
-					       andalso slotsAreInFrame fi))
-			       else if !Control.profile = Control.ProfileNone
-				       then true
-				    else (case frameInfo of
-					     NONE => false
-					   | SOME fi => frame (fi, false, true)))
-			in
-			   if ok
-			      then SOME (case dst of
-					    NONE => alloc
-					  | SOME z => Alloc.defineLive (alloc, z))
-			   else NONE
-			end
-		   | Func => SOME alloc
-		   | Handler {frameInfo, ...} =>
-			if frame (frameInfo, false, false)
-			   then SOME alloc
-			else NONE
-		   | Jump => SOME alloc
-	       end
-	    fun checkStatement (s: Statement.t, alloc: Alloc.t)
-	       : Alloc.t option =
-	       let
-		  datatype z = datatype Statement.t
-	       in
-		  case s of
-		     Move {dst, src} =>
-			let
-			   val _ = checkOperand (src, alloc)
-			   val alloc = Alloc.define (alloc, dst)
-			   val _ = checkOperand (dst, alloc)
-			in
-			   if Type.isSubtype (Operand.ty src, Operand.ty dst)
-			      andalso Operand.isLocation dst
-			      then SOME alloc
-			   else NONE
-			end
-		   | Noop => SOME alloc
-		   | PrimApp {args, dst, ...} =>
-			let
-			   val _ = checkOperands (args, alloc)
-			in
-			   case dst of
-			      NONE => SOME alloc
-			    | SOME z =>
-				 let
-				    val alloc = Alloc.define (alloc, z)
-				    val _ = checkOperand (z, alloc)
-				 in
-				    SOME alloc
-				 end
-			end
-		   | ProfileLabel l =>
-			if profileLabelIsOk l
-			   then SOME alloc
-			else NONE
-	       end
-	    fun liveIsOk (live: Live.t vector,
-			  a: Alloc.t): bool =
-	       Vector.forall (live, fn z => Alloc.doesDefine (a, z))
-	    fun liveSubset (live: Live.t vector,
-			    live': Live.t vector): bool =
-	       Vector.forall
-	       (live, fn z => Vector.exists (live', fn z' =>
-					     Live.equals (z, z')))
-	    fun goto (Block.T {live,
-			       raises = raises',
-			       returns = returns', ...},
-		      raises: Live.t vector option,
-		      returns: Live.t vector option,
-		      alloc: Alloc.t): bool =
-	       liveIsOk (live, alloc)
-	       andalso
-	       (case (raises, raises') of
-		   (_, NONE) => true
-		 | (SOME gs, SOME gs') =>
-		      Vector.equals (gs', gs, Live.isSubtype)
-		 | _ => false)
-		   andalso
-		   (case (returns, returns') of
-		       (_, NONE) => true
-		     | (SOME os, SOME os') =>
-			  Vector.equals (os', os, Live.isSubtype)
-		     | _ => false)
-	    fun checkCont (cont: Label.t, size: Bytes.t, alloc: Alloc.t) =
-	       let
-		  val Block.T {kind, live, ...} = labelBlock cont
-	       in
-		  if Vector.forall (live, fn z => Alloc.doesDefine (alloc, z))
-		     then
-			(case kind of
-			    Kind.Cont {args, frameInfo, ...} =>
-			       (if Bytes.equals (size,
-						 #size (getFrameInfo frameInfo))
-				   then
-				      SOME
-				      (live,
-				       SOME
-				       (Vector.map
-					(args, fn z =>
-					 case z of
-					    Live.StackOffset s =>
-					       Live.StackOffset
-					       (StackOffset.shift (s, size))
-					  | _ => z)))
-				else NONE)
-			  | _ => NONE)
-		  else NONE
-	       end
-	    fun callIsOk {alloc: Alloc.t,
-			  dst: Label.t,
-			  live: Live.t vector,
-			  raises: Live.t vector option,
-			  return,
-			  returns: Live.t vector option} =
-	       let
-		  val {raises, returns, size} =
-		     case return of
-			NONE =>
-			   {raises = raises,
-			    returns = returns,
-			    size = Bytes.zero}
-		      | SOME {handler, return, size} =>
-			   let
-			      val (contLive, returns) =
-				 Err.check'
-				 ("cont",
-				  fn () => checkCont (return, size, alloc),
-				  fn () => Label.layout return)
-			      fun checkHandler () =
-				 case handler of
-				    NONE => SOME raises
-				  | SOME h =>
-				       let
-					  val Block.T {kind, live, ...} =
-					     labelBlock h
-				       in
-					  if liveSubset (live, contLive)
-					     then
-						(case kind of
-						    Kind.Handler {handles, ...} =>
-						       SOME (SOME handles)
-						  | _ => NONE)
-					  else NONE
-				       end
-			      val raises =
-				 Err.check'
-				 ("handler", checkHandler,
-				  fn () => Option.layout Label.layout handler)
-			   in
-			      {raises = raises,
-			       returns = returns,
-			       size = size}
-			   end
-		  val b = labelBlock dst
-		  val alloc =
-		     Alloc.T
-		     (Vector.fold
-		      (live, [], fn (z, ac) =>
-		       case z of
-			  Live.StackOffset (StackOffset.T {offset, ty}) =>
-			     if Bytes.< (offset, size)
-				then ac
-			     else (Live.StackOffset
-				   (StackOffset.T
-				    {offset = Bytes.- (offset, size),
-				     ty = ty})) :: ac
-			| _ => ac))
-	       in
-		  goto (b, raises, returns, alloc)
-	       end
-	    fun transferOk
-	       (t: Transfer.t,
-		raises: Live.t vector option,
-		returns: Live.t vector option,
-		alloc: Alloc.t): bool =
-	       let
-		  fun jump (l: Label.t, a: Alloc.t) =
-		     let
-			val b as Block.T {kind, ...} = labelBlock l
-		     in
-			(case kind of
-			    Kind.Jump => true
-			  | _ => false)
-			    andalso goto (b, raises, returns, a)
-		     end
-		  datatype z = datatype Transfer.t
-	       in
-		  case t of
-		     Arith {args, dst, overflow, prim, success, ...} =>
-			let
-			   val _ = checkOperands (args, alloc)
-			   val alloc = Alloc.define (alloc, dst)
-			   val _ = checkOperand (dst, alloc)
-			in
-			   Prim.mayOverflow prim
-			   andalso jump (overflow, alloc)
-			   andalso jump (success, alloc)
-			   andalso
-			   Type.checkPrimApp
-			   {args = Vector.map (args, Operand.ty),
-			    prim = prim,
-			    result = SOME (Operand.ty dst)}
-			end
-		   | CCall {args, frameInfo = fi, func, return} =>
-			let
-			   val _ = checkOperands (args, alloc)
-			in
-			   CFunction.isOk (func, {isUnit = Type.isUnit})
-			   andalso
-			   Vector.equals (args, CFunction.args func,
-					  fn (z, t) =>
-					  Type.isSubtype (Operand.ty z, t))
-			   andalso
-			   case return of
-			      NONE => true
-			    | SOME l =>
-				 let 
-				    val Block.T {live, ...} = labelBlock l
-				 in
-				    liveIsOk (live, alloc)
-				    andalso
-				    case labelKind l of
-				       Kind.CReturn
-				       {frameInfo = fi', func = f, ...} => 
-					  CFunction.equals (func, f)
-					  andalso (Option.equals
-						   (fi, fi', FrameInfo.equals))
-				     | _ => false
-				 end
-			end
-		   | Call {label, live, return} =>
-			Vector.forall
-			(live, fn z => Alloc.doesDefine (alloc, z))
-			andalso
-			callIsOk {alloc = alloc,
-				  dst = label,
-				  live = live,
-				  raises = raises,
-				  return = return,
-				  returns = returns}
-		      | Goto l => jump (l, alloc)
-		      | Raise =>
-			   (case raises of
-			       NONE => false
-			     | SOME zs =>
-				  Vector.forall
-				  (zs, fn z => Alloc.doesDefine (alloc, z)))
-		      | Return =>
-			   (case returns of
-			       NONE => false
-			     | SOME zs =>
-				  Vector.forall
-				  (zs, fn z => Alloc.doesDefine (alloc, z)))
-		      | Switch s =>
-			   Switch.isOk
-			   (s, {checkUse = fn z => checkOperand (z, alloc),
-				labelIsOk = fn l => jump (l, alloc)})
-	       end
-	    val transferOk =
-	       Trace.trace
-	       ("transferOk",
-		fn (t, _, _, a) =>
-		Layout.tuple [Transfer.layout t, Alloc.layout a],
-		Bool.layout)
-	       transferOk
-	    fun blockOk (Block.T {kind, live, raises, returns, statements,
-				  transfer, ...}): bool =
-	       let
-		  val live = Vector.toList live
-		  val _ =
-		     Err.check
-		     ("live",
-		      fn () =>
-		      let
-			 fun loop zs =
-			    case zs of
-			       [] => true
-			     | z :: zs =>
-				  List.forall
-				  (zs, fn z' =>
-				   not (Live.interfere (z, z')))
-		      in
-			 loop live
-		      end,
-		      fn () => List.layout Live.layout live)
-		  val alloc = Alloc.new live
-		  val alloc =
-		     Err.check'
-		     ("kind",
-		      fn () => checkKind (kind, alloc),
-		      fn () => Kind.layout kind)
-		  val alloc =
-		     Vector.fold
-		     (statements, alloc, fn (s, alloc) =>
-		      Err.check'
-		      ("statement",
-		       fn () => checkStatement (s, alloc),
-		       fn () => Statement.layout s))
-		  val _ =
-		     Err.check
-		     ("transfer",
-		      fn () => transferOk (transfer, raises, returns, alloc),
-		      fn () => Transfer.layout transfer)
-	       in
-		  true
-	       end
-	    val _ =
-	       List.foreach
-	       (chunks,
-		fn Chunk.T {blocks, ...} =>
-		let
-		in
-		   Vector.foreach
-		   (blocks, fn b =>
-		    check' (b, "block", blockOk, Block.layout))
-		end)
-	    val _ = clear program
-	 in
-	    ()
-	 end handle Err.E e => (Layout.outputl (Err.layout e, Out.error)
-				; Error.bug "Machine type error")
+                              (if CFunction.mayGC func
+                                  then (case frameInfo of
+                                           NONE => false
+                                         | SOME fi =>
+                                              (frame (fi, true, true)
+                                               andalso slotsAreInFrame fi))
+                               else if !Control.profile = Control.ProfileNone
+                                       then true
+                                    else (case frameInfo of
+                                             NONE => false
+                                           | SOME fi => frame (fi, false, true)))
+                        in
+                           if ok
+                              then SOME (case dst of
+                                            NONE => alloc
+                                          | SOME z => Alloc.defineLive (alloc, z))
+                           else NONE
+                        end
+                   | Func => SOME alloc
+                   | Handler {frameInfo, ...} =>
+                        if frame (frameInfo, false, false)
+                           then SOME alloc
+                        else NONE
+                   | Jump => SOME alloc
+               end
+            fun checkStatement (s: Statement.t, alloc: Alloc.t)
+               : Alloc.t option =
+               let
+                  datatype z = datatype Statement.t
+               in
+                  case s of
+                     Move {dst, src} =>
+                        let
+                           val _ = checkOperand (src, alloc)
+                           val alloc = Alloc.define (alloc, dst)
+                           val _ = checkOperand (dst, alloc)
+                        in
+                           if Type.isSubtype (Operand.ty src, Operand.ty dst)
+                              andalso Operand.isLocation dst
+                              then SOME alloc
+                           else NONE
+                        end
+                   | Noop => SOME alloc
+                   | PrimApp {args, dst, ...} =>
+                        let
+                           val _ = checkOperands (args, alloc)
+                        in
+                           case dst of
+                              NONE => SOME alloc
+                            | SOME z =>
+                                 let
+                                    val alloc = Alloc.define (alloc, z)
+                                    val _ = checkOperand (z, alloc)
+                                 in
+                                    SOME alloc
+                                 end
+                        end
+                   | ProfileLabel l =>
+                        if profileLabelIsOk l
+                           then SOME alloc
+                        else NONE
+               end
+            fun liveIsOk (live: Live.t vector,
+                          a: Alloc.t): bool =
+               Vector.forall (live, fn z => Alloc.doesDefine (a, z))
+            fun liveSubset (live: Live.t vector,
+                            live': Live.t vector): bool =
+               Vector.forall
+               (live, fn z => Vector.exists (live', fn z' =>
+                                             Live.equals (z, z')))
+            fun goto (Block.T {live,
+                               raises = raises',
+                               returns = returns', ...},
+                      raises: Live.t vector option,
+                      returns: Live.t vector option,
+                      alloc: Alloc.t): bool =
+               liveIsOk (live, alloc)
+               andalso
+               (case (raises, raises') of
+                   (_, NONE) => true
+                 | (SOME gs, SOME gs') =>
+                      Vector.equals (gs', gs, Live.isSubtype)
+                 | _ => false)
+                   andalso
+                   (case (returns, returns') of
+                       (_, NONE) => true
+                     | (SOME os, SOME os') =>
+                          Vector.equals (os', os, Live.isSubtype)
+                     | _ => false)
+            fun checkCont (cont: Label.t, size: Bytes.t, alloc: Alloc.t) =
+               let
+                  val Block.T {kind, live, ...} = labelBlock cont
+               in
+                  if Vector.forall (live, fn z => Alloc.doesDefine (alloc, z))
+                     then
+                        (case kind of
+                            Kind.Cont {args, frameInfo, ...} =>
+                               (if Bytes.equals (size,
+                                                 #size (getFrameInfo frameInfo))
+                                   then
+                                      SOME
+                                      (live,
+                                       SOME
+                                       (Vector.map
+                                        (args, fn z =>
+                                         case z of
+                                            Live.StackOffset s =>
+                                               Live.StackOffset
+                                               (StackOffset.shift (s, size))
+                                          | _ => z)))
+                                else NONE)
+                          | _ => NONE)
+                  else NONE
+               end
+            fun callIsOk {alloc: Alloc.t,
+                          dst: Label.t,
+                          live: Live.t vector,
+                          raises: Live.t vector option,
+                          return,
+                          returns: Live.t vector option} =
+               let
+                  val {raises, returns, size} =
+                     case return of
+                        NONE =>
+                           {raises = raises,
+                            returns = returns,
+                            size = Bytes.zero}
+                      | SOME {handler, return, size} =>
+                           let
+                              val (contLive, returns) =
+                                 Err.check'
+                                 ("cont",
+                                  fn () => checkCont (return, size, alloc),
+                                  fn () => Label.layout return)
+                              fun checkHandler () =
+                                 case handler of
+                                    NONE => SOME raises
+                                  | SOME h =>
+                                       let
+                                          val Block.T {kind, live, ...} =
+                                             labelBlock h
+                                       in
+                                          if liveSubset (live, contLive)
+                                             then
+                                                (case kind of
+                                                    Kind.Handler {handles, ...} =>
+                                                       SOME (SOME handles)
+                                                  | _ => NONE)
+                                          else NONE
+                                       end
+                              val raises =
+                                 Err.check'
+                                 ("handler", checkHandler,
+                                  fn () => Option.layout Label.layout handler)
+                           in
+                              {raises = raises,
+                               returns = returns,
+                               size = size}
+                           end
+                  val b = labelBlock dst
+                  val alloc =
+                     Alloc.T
+                     (Vector.fold
+                      (live, [], fn (z, ac) =>
+                       case z of
+                          Live.StackOffset (StackOffset.T {offset, ty}) =>
+                             if Bytes.< (offset, size)
+                                then ac
+                             else (Live.StackOffset
+                                   (StackOffset.T
+                                    {offset = Bytes.- (offset, size),
+                                     ty = ty})) :: ac
+                        | _ => ac))
+               in
+                  goto (b, raises, returns, alloc)
+               end
+            fun transferOk
+               (t: Transfer.t,
+                raises: Live.t vector option,
+                returns: Live.t vector option,
+                alloc: Alloc.t): bool =
+               let
+                  fun jump (l: Label.t, a: Alloc.t) =
+                     let
+                        val b as Block.T {kind, ...} = labelBlock l
+                     in
+                        (case kind of
+                            Kind.Jump => true
+                          | _ => false)
+                            andalso goto (b, raises, returns, a)
+                     end
+                  datatype z = datatype Transfer.t
+               in
+                  case t of
+                     Arith {args, dst, overflow, prim, success, ...} =>
+                        let
+                           val _ = checkOperands (args, alloc)
+                           val alloc = Alloc.define (alloc, dst)
+                           val _ = checkOperand (dst, alloc)
+                        in
+                           Prim.mayOverflow prim
+                           andalso jump (overflow, alloc)
+                           andalso jump (success, alloc)
+                           andalso
+                           Type.checkPrimApp
+                           {args = Vector.map (args, Operand.ty),
+                            prim = prim,
+                            result = SOME (Operand.ty dst)}
+                        end
+                   | CCall {args, frameInfo = fi, func, return} =>
+                        let
+                           val _ = checkOperands (args, alloc)
+                        in
+                           CFunction.isOk (func, {isUnit = Type.isUnit})
+                           andalso
+                           Vector.equals (args, CFunction.args func,
+                                          fn (z, t) =>
+                                          Type.isSubtype (Operand.ty z, t))
+                           andalso
+                           case return of
+                              NONE => true
+                            | SOME l =>
+                                 let 
+                                    val Block.T {live, ...} = labelBlock l
+                                 in
+                                    liveIsOk (live, alloc)
+                                    andalso
+                                    case labelKind l of
+                                       Kind.CReturn
+                                       {frameInfo = fi', func = f, ...} => 
+                                          CFunction.equals (func, f)
+                                          andalso (Option.equals
+                                                   (fi, fi', FrameInfo.equals))
+                                     | _ => false
+                                 end
+                        end
+                   | Call {label, live, return} =>
+                        Vector.forall
+                        (live, fn z => Alloc.doesDefine (alloc, z))
+                        andalso
+                        callIsOk {alloc = alloc,
+                                  dst = label,
+                                  live = live,
+                                  raises = raises,
+                                  return = return,
+                                  returns = returns}
+                      | Goto l => jump (l, alloc)
+                      | Raise =>
+                           (case raises of
+                               NONE => false
+                             | SOME zs =>
+                                  Vector.forall
+                                  (zs, fn z => Alloc.doesDefine (alloc, z)))
+                      | Return =>
+                           (case returns of
+                               NONE => false
+                             | SOME zs =>
+                                  Vector.forall
+                                  (zs, fn z => Alloc.doesDefine (alloc, z)))
+                      | Switch s =>
+                           Switch.isOk
+                           (s, {checkUse = fn z => checkOperand (z, alloc),
+                                labelIsOk = fn l => jump (l, alloc)})
+               end
+            val transferOk =
+               Trace.trace
+               ("Machine.Program.typeCheck.transferOk",
+                fn (t, _, _, a) =>
+                Layout.tuple [Transfer.layout t, Alloc.layout a],
+                Bool.layout)
+               transferOk
+            fun blockOk (Block.T {kind, live, raises, returns, statements,
+                                  transfer, ...}): bool =
+               let
+                  val live = Vector.toList live
+                  val _ =
+                     Err.check
+                     ("live",
+                      fn () =>
+                      let
+                         fun loop zs =
+                            case zs of
+                               [] => true
+                             | z :: zs =>
+                                  List.forall
+                                  (zs, fn z' =>
+                                   not (Live.interfere (z, z')))
+                      in
+                         loop live
+                      end,
+                      fn () => List.layout Live.layout live)
+                  val alloc = Alloc.new live
+                  val alloc =
+                     Err.check'
+                     ("kind",
+                      fn () => checkKind (kind, alloc),
+                      fn () => Kind.layout kind)
+                  val alloc =
+                     Vector.fold
+                     (statements, alloc, fn (s, alloc) =>
+                      Err.check'
+                      ("statement",
+                       fn () => checkStatement (s, alloc),
+                       fn () => Statement.layout s))
+                  val _ =
+                     Err.check
+                     ("transfer",
+                      fn () => transferOk (transfer, raises, returns, alloc),
+                      fn () => Transfer.layout transfer)
+               in
+                  true
+               end
+            val _ =
+               List.foreach
+               (chunks,
+                fn Chunk.T {blocks, ...} =>
+                let
+                in
+                   Vector.foreach
+                   (blocks, fn b =>
+                    check' (b, "block", blockOk, Block.layout))
+                end)
+            val _ = clear program
+         in
+            ()
+         end handle Err.E e => (Layout.outputl (Err.layout e, Out.error)
+                                ; Error.bug "Machine.typeCheck")
 
       fun clearLabelNames (T {chunks, ...}): unit =
-	 List.foreach
-	 (chunks, fn Chunk.T {blocks, ...} =>
-	  Vector.foreach
-	  (blocks, fn Block.T {label, ...} =>
-	   Label.clearPrintName label))
+         List.foreach
+         (chunks, fn Chunk.T {blocks, ...} =>
+          Vector.foreach
+          (blocks, fn Block.T {label, ...} =>
+           Label.clearPrintName label))
    end
 
 end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/backend/machine.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/backend/machine.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/backend/machine.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 type int = Int.t
 type word = Word.t
    
@@ -32,253 +33,253 @@
       structure ChunkLabel: ID
 
       structure Register:
-	 sig
-	    type t
+         sig
+            type t
 
-	    val equals: t * t -> bool
-	    val index: t -> int
-	    val indexOpt: t -> int option
-	    val layout: t -> Layout.t
-	    val new: Type.t * int option -> t
-	    val setIndex: t * int -> unit
-	    val toString: t -> string
-	    val ty: t -> Type.t
-	 end
+            val equals: t * t -> bool
+            val index: t -> int
+            val indexOpt: t -> int option
+            val layout: t -> Layout.t
+            val new: Type.t * int option -> t
+            val setIndex: t * int -> unit
+            val toString: t -> string
+            val ty: t -> Type.t
+         end
 
       structure Global:
-	 sig
-	    type t
+         sig
+            type t
 
-	    val equals: t * t -> bool
-	    val index: t -> int
-	    val isRoot: t -> bool
-	    val layout: t -> Layout.t
-	    val new: {isRoot: bool, ty: Type.t} -> t
-	    val numberOfNonRoot: unit -> int
-	    val numberOfType: CType.t -> int
-	    val toString: t -> string
-	    val ty: t -> Type.t
-	 end
+            val equals: t * t -> bool
+            val index: t -> int
+            val isRoot: t -> bool
+            val layout: t -> Layout.t
+            val new: {isRoot: bool, ty: Type.t} -> t
+            val numberOfNonRoot: unit -> int
+            val numberOfType: CType.t -> int
+            val toString: t -> string
+            val ty: t -> Type.t
+         end
 
       structure StackOffset:
-	 sig
-	    datatype t = T of {offset: Bytes.t,
-			       ty: Type.t}
+         sig
+            datatype t = T of {offset: Bytes.t,
+                               ty: Type.t}
 
-	    val offset: t -> Bytes.t
-	    val ty: t -> Type.t
-	 end
+            val offset: t -> Bytes.t
+            val ty: t -> Type.t
+         end
 
       structure Scale: SCALE
       sharing Scale = Type.Scale
-	 
+         
       structure Operand:
-	 sig
-	    datatype t =
-	       ArrayOffset of {base: t,
-			       index: t,
-			       offset: Bytes.t,
-			       scale: Scale.t,
-			       ty: Type.t}
-	     | Cast of t * Type.t
-	     | Contents of {oper: t,
-			    ty: Type.t}
-	     | File (* expanded by codegen into string constant *)
-	     | Frontier
-	     | GCState
-	     | Global of Global.t
-	     | Label of Label.t
-	     | Line (* expand by codegen into int constant *)
-	     | Offset of {base: t,
-			  offset: Bytes.t,
-			  ty: Type.t}
-	     | Real of RealX.t
-	     | Register of Register.t
-	     | StackOffset of StackOffset.t
-	     | StackTop
-	     | Word of WordX.t
+         sig
+            datatype t =
+               ArrayOffset of {base: t,
+                               index: t,
+                               offset: Bytes.t,
+                               scale: Scale.t,
+                               ty: Type.t}
+             | Cast of t * Type.t
+             | Contents of {oper: t,
+                            ty: Type.t}
+             | File (* expanded by codegen into string constant *)
+             | Frontier
+             | GCState
+             | Global of Global.t
+             | Label of Label.t
+             | Line (* expand by codegen into int constant *)
+             | Offset of {base: t,
+                          offset: Bytes.t,
+                          ty: Type.t}
+             | Real of RealX.t
+             | Register of Register.t
+             | StackOffset of StackOffset.t
+             | StackTop
+             | Word of WordX.t
 
-	    val equals: t * t -> bool
-	    val interfere: t * t -> bool
-	    val isLocation: t -> bool
-	    val layout: t -> Layout.t
-	    val stackOffset: {offset: Bytes.t, ty: Type.t} -> t
-	    val toString: t -> string
-	    val ty: t -> Type.t
-	 end
+            val equals: t * t -> bool
+            val interfere: t * t -> bool
+            val isLocation: t -> bool
+            val layout: t -> Layout.t
+            val stackOffset: {offset: Bytes.t, ty: Type.t} -> t
+            val toString: t -> string
+            val ty: t -> Type.t
+         end
       sharing Operand = Switch.Use
 
       structure Live:
-	 sig
-	    datatype t =
-	       Global of Global.t
-	     | Register of Register.t
-	     | StackOffset of StackOffset.t
+         sig
+            datatype t =
+               Global of Global.t
+             | Register of Register.t
+             | StackOffset of StackOffset.t
 
-	    val equals: t * t -> bool
-	    val fromOperand: Operand.t -> t option
-	    val layout: t -> Layout.t
-	    val toOperand: t -> Operand.t
-	    val ty: t -> Type.t
-	 end
+            val equals: t * t -> bool
+            val fromOperand: Operand.t -> t option
+            val layout: t -> Layout.t
+            val toOperand: t -> Operand.t
+            val ty: t -> Type.t
+         end
 
       structure Statement:
-	 sig
-	    datatype t =
-	     (* When registers or offsets appear in operands, there is an
-	      * implicit contents of.
-	      * When they appear as locations, there is not.
-	      *)
-	       Move of {dst: Operand.t,
-			src: Operand.t}
-	     | Noop
-	     | PrimApp of {args: Operand.t vector,
-			   dst: Operand.t option,
-			   prim: Type.t Prim.t}
-	     | ProfileLabel of ProfileLabel.t
+         sig
+            datatype t =
+             (* When registers or offsets appear in operands, there is an
+              * implicit contents of.
+              * When they appear as locations, there is not.
+              *)
+               Move of {dst: Operand.t,
+                        src: Operand.t}
+             | Noop
+             | PrimApp of {args: Operand.t vector,
+                           dst: Operand.t option,
+                           prim: Type.t Prim.t}
+             | ProfileLabel of ProfileLabel.t
 
-	    val foldOperands: t * 'a * (Operand.t * 'a -> 'a) -> 'a
-	    val layout: t -> Layout.t
-	    val move: {dst: Operand.t, src: Operand.t} -> t
-	    (* Error if dsts and srcs aren't of same length. *)
-	    val moves: {dsts: Operand.t vector,
-			srcs: Operand.t vector} -> t vector
-	    val object: {dst: Operand.t, header: word, size: Words.t} -> t vector
-	 end
+            val foldOperands: t * 'a * (Operand.t * 'a -> 'a) -> 'a
+            val layout: t -> Layout.t
+            val move: {dst: Operand.t, src: Operand.t} -> t
+            (* Error if dsts and srcs aren't of same length. *)
+            val moves: {dsts: Operand.t vector,
+                        srcs: Operand.t vector} -> t vector
+            val object: {dst: Operand.t, header: word, size: Words.t} -> t vector
+         end
 
       structure FrameInfo:
-	 sig
-	    datatype t = T of {frameLayoutsIndex: int}
+         sig
+            datatype t = T of {frameLayoutsIndex: int}
 
-	    val equals: t * t -> bool
-	    val layout: t -> Layout.t
-	 end
+            val equals: t * t -> bool
+            val layout: t -> Layout.t
+         end
 
       structure Transfer:
-	 sig
-	    datatype t =
-	       (* In an arith transfer, dst is modified whether or not the
-		* prim succeeds.
-		*)
-	       Arith of {args: Operand.t vector,
-			 dst: Operand.t,
-			 overflow: Label.t,
-			 prim: Type.t Prim.t,
-			 success: Label.t}
-	     | CCall of {args: Operand.t vector,
-			 frameInfo: FrameInfo.t option,
-			 func: Type.t CFunction.t,
-			 (* return is NONE iff the func doesn't return.
-			  * Else, return must be SOME l, where l is of CReturn
-			  * kind with a matching func.
-			  *)
-			 return: Label.t option}
-	     | Call of {label: Label.t, (* label must be a Func *)
-			live: Live.t vector,
-			return: {return: Label.t,
-				 handler: Label.t option,
-				 size: Bytes.t} option}
-	     | Goto of Label.t (* label must be a Jump *)
-	     | Raise
-	     | Return
-	     | Switch of Switch.t
+         sig
+            datatype t =
+               (* In an arith transfer, dst is modified whether or not the
+                * prim succeeds.
+                *)
+               Arith of {args: Operand.t vector,
+                         dst: Operand.t,
+                         overflow: Label.t,
+                         prim: Type.t Prim.t,
+                         success: Label.t}
+             | CCall of {args: Operand.t vector,
+                         frameInfo: FrameInfo.t option,
+                         func: Type.t CFunction.t,
+                         (* return is NONE iff the func doesn't return.
+                          * Else, return must be SOME l, where l is of CReturn
+                          * kind with a matching func.
+                          *)
+                         return: Label.t option}
+             | Call of {label: Label.t, (* label must be a Func *)
+                        live: Live.t vector,
+                        return: {return: Label.t,
+                                 handler: Label.t option,
+                                 size: Bytes.t} option}
+             | Goto of Label.t (* label must be a Jump *)
+             | Raise
+             | Return
+             | Switch of Switch.t
 
-	    val foldOperands: t * 'a * (Operand.t * 'a -> 'a) -> 'a
-	    val layout: t -> Layout.t
-	 end
+            val foldOperands: t * 'a * (Operand.t * 'a -> 'a) -> 'a
+            val layout: t -> Layout.t
+         end
       
       structure Kind:
-	 sig
-	    datatype t =
-	       Cont of {args: Live.t vector,
-			frameInfo: FrameInfo.t}
-	     | CReturn of {dst: Live.t option,
-			   frameInfo: FrameInfo.t option,
-			   func: Type.t CFunction.t}
-	     | Func
-	     | Handler of {frameInfo: FrameInfo.t,
-			   handles: Live.t vector}
-	     | Jump
+         sig
+            datatype t =
+               Cont of {args: Live.t vector,
+                        frameInfo: FrameInfo.t}
+             | CReturn of {dst: Live.t option,
+                           frameInfo: FrameInfo.t option,
+                           func: Type.t CFunction.t}
+             | Func
+             | Handler of {frameInfo: FrameInfo.t,
+                           handles: Live.t vector}
+             | Jump
 
-	    val frameInfoOpt: t -> FrameInfo.t option
-	 end
+            val frameInfoOpt: t -> FrameInfo.t option
+         end
       
       structure Block:
-	 sig
-	    datatype t =
-	       T of {kind: Kind.t,
-		     label: Label.t,
-		     (* Live registers and stack offsets at start of block. *)
-		     live: Live.t vector,
-		     raises: Live.t vector option,
-		     returns: Live.t vector option,
-		     statements: Statement.t vector,
-		     transfer: Transfer.t}
+         sig
+            datatype t =
+               T of {kind: Kind.t,
+                     label: Label.t,
+                     (* Live registers and stack offsets at start of block. *)
+                     live: Live.t vector,
+                     raises: Live.t vector option,
+                     returns: Live.t vector option,
+                     statements: Statement.t vector,
+                     transfer: Transfer.t}
 
-	    val foldDefs: t * 'a * (Operand.t * 'a -> 'a) -> 'a
-	    val label: t -> Label.t
-	 end
+            val foldDefs: t * 'a * (Operand.t * 'a -> 'a) -> 'a
+            val label: t -> Label.t
+         end
 
       structure Chunk:
-	 sig
-	    datatype t =
-	       T of {blocks: Block.t vector,
-		     chunkLabel: ChunkLabel.t,
-		     (* Register.index r
-		      *    <= regMax (Type.toCType (Register.ty r))
-		      * for all registers in the chunk.
-		      *)
-		     regMax: CType.t -> int}
-	 end
+         sig
+            datatype t =
+               T of {blocks: Block.t vector,
+                     chunkLabel: ChunkLabel.t,
+                     (* Register.index r
+                      *    <= regMax (Type.toCType (Register.ty r))
+                      * for all registers in the chunk.
+                      *)
+                     regMax: CType.t -> int}
+         end
 
       structure ProfileInfo:
-	 sig
-	    datatype t =
-	       T of {(* For each frame, gives the index into sourceSeqs of the
-		      * source functions corresponding to the frame.
-		      *)
-	             frameSources: int vector,
-		     labels: {label: ProfileLabel.t,
-			      sourceSeqsIndex: int} vector,
-		     names: string vector,
-		     (* Each sourceSeq describes a sequence of source functions,
-		      * each given as an index into the source vector.
-		      *)
-		     sourceSeqs: int vector vector,
-		     sources: {nameIndex: int,
-			       successorsIndex: int} vector}
+         sig
+            datatype t =
+               T of {(* For each frame, gives the index into sourceSeqs of the
+                      * source functions corresponding to the frame.
+                      *)
+                     frameSources: int vector,
+                     labels: {label: ProfileLabel.t,
+                              sourceSeqsIndex: int} vector,
+                     names: string vector,
+                     (* Each sourceSeq describes a sequence of source functions,
+                      * each given as an index into the source vector.
+                      *)
+                     sourceSeqs: int vector vector,
+                     sources: {nameIndex: int,
+                               successorsIndex: int} vector}
 
-	    val empty: t
-	    val modify: t -> {newProfileLabel: ProfileLabel.t -> ProfileLabel.t,
-			      delProfileLabel: ProfileLabel.t -> unit,
-			      getProfileInfo: unit -> t}
-	 end
+            val empty: t
+            val modify: t -> {newProfileLabel: ProfileLabel.t -> ProfileLabel.t,
+                              delProfileLabel: ProfileLabel.t -> unit,
+                              getProfileInfo: unit -> t}
+         end
 
       structure Program:
-	 sig
-	    datatype t =
-	       T of {chunks: Chunk.t list,
-		     frameLayouts: {frameOffsetsIndex: int,
-				    isC: bool,
-				    size: Bytes.t} vector,
-		     (* Each vector in frame Offsets specifies the offsets
-		      * of live pointers in a stack frame.  A vector is referred
-		      * to by index as the offsetsIndex in frameLayouts.
-		      *)
-		     frameOffsets: Bytes.t vector vector,
-		     handlesSignals: bool,
-		     intInfs: (Global.t * string) list,
-		     main: {chunkLabel: ChunkLabel.t,
-			    label: Label.t},
-		     maxFrameSize: Bytes.t,
-		     objectTypes: Type.ObjectType.t vector,
-		     profileInfo: ProfileInfo.t option,
-		     reals: (Global.t * RealX.t) list,
-		     vectors: (Global.t * WordXVector.t) list}
+         sig
+            datatype t =
+               T of {chunks: Chunk.t list,
+                     frameLayouts: {frameOffsetsIndex: int,
+                                    isC: bool,
+                                    size: Bytes.t} vector,
+                     (* Each vector in frame Offsets specifies the offsets
+                      * of live pointers in a stack frame.  A vector is referred
+                      * to by index as the offsetsIndex in frameLayouts.
+                      *)
+                     frameOffsets: Bytes.t vector vector,
+                     handlesSignals: bool,
+                     intInfs: (Global.t * string) list,
+                     main: {chunkLabel: ChunkLabel.t,
+                            label: Label.t},
+                     maxFrameSize: Bytes.t,
+                     objectTypes: Type.ObjectType.t vector,
+                     profileInfo: ProfileInfo.t option,
+                     reals: (Global.t * RealX.t) list,
+                     vectors: (Global.t * WordXVector.t) list}
 
-	    val frameSize: t * FrameInfo.t -> Bytes.t
-	    val clearLabelNames: t -> unit
-	    val layouts: t * (Layout.t -> unit) -> unit
-	    val typeCheck: t -> unit
-	 end
+            val frameSize: t * FrameInfo.t -> Bytes.t
+            val clearLabelNames: t -> unit
+            val layouts: t * (Layout.t -> unit) -> unit
+            val typeCheck: t -> unit
+         end
    end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/backend/object-type.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/backend/object-type.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/backend/object-type.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,10 @@
+(* Copyright (C) 2004-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 signature OBJECT_TYPE =
    sig
       structure PointerTycon: POINTER_TYCON
@@ -2,13 +9,13 @@
       structure Runtime: RUNTIME
-	 
+         
       type ty
       datatype t =
-	 Array of {elt: ty,
-		   hasIdentity: bool}
+         Array of {elt: ty,
+                   hasIdentity: bool}
        | Normal of {hasIdentity: bool,
-		    ty: ty}
+                    ty: ty}
        | Stack
        | Weak of ty (* in Weak t, must have Type.isPointer t *)
        | WeakGone
-	 
+         
       val basic: (PointerTycon.t * t) vector

Modified: mlton/branches/on-20050420-cmm-branch/mlton/backend/packed-representation.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/backend/packed-representation.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/backend/packed-representation.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 (* Has a special case to make sure that true is represented as 1
  * and false is represented as 0.
  *)
@@ -55,98 +56,103 @@
       open Type
 
       fun padToPrim (t: t): t =
-	 let
-	    val b = Bits.toInt (width t)
-	    fun check (b', continue) =
-	       if b < b'
-		  then seq (Vector.new2 (t, zero (Bits.fromInt (b' - b))))
-	       else if b = b'
-		       then t
-		    else continue ()
-	 in
-	    if 0 = b
-	       then t
-	    else
-	       check (8, fn () =>
-		      check (16, fn () =>
-			     check (32, fn () =>
-				    if b = 64
-				       then t
-				    else Error.bug (concat ["Type.padToPrim ",
-							    Int.toString b]))))
-	 end
+         let
+            val b = Bits.toInt (width t)
+            fun check (b', continue) =
+               if b < b'
+                  then seq (Vector.new2 (t, zero (Bits.fromInt (b' - b))))
+               else if b = b'
+                       then t
+                    else continue ()
+         in
+            if 0 = b
+               then t
+            else
+               check (8, fn () =>
+                      check (16, fn () =>
+                             check (32, fn () =>
+                                    if b = 64
+                                       then t
+                                    else Error.bug 
+                                         (concat ["PackedRepresentation.Type.padToPrim ",
+                                                  Int.toString b]))))
+         end
 
       fun padToWidth (t: t, b: Bits.t): t =
-	 if Bits.< (b, width t)
-	    then Error.bug "Type.padToWidth"
-	 else seq (Vector.new2 (t, zero (Bits.- (b, width t))))
+         if Bits.< (b, width t)
+            then Error.bug "PackedRepresentation.Type.padToWidth"
+         else seq (Vector.new2 (t, zero (Bits.- (b, width t))))
 
       val padToWidth =
-	 Trace.trace2 ("Type.padToWidth", layout, Bits.layout, layout) padToWidth
+         Trace.trace2 
+         ("PackedRepresentation.Type.padToWidth", layout, Bits.layout, layout) 
+         padToWidth
    end
 
 structure Rep =
    struct
       datatype rep =
-	 NonPointer
+         NonPointer
        | Pointer of {endsIn00: bool}
 
       datatype t = T of {rep: rep,
-			 ty: Type.t}
+                         ty: Type.t}
 
       fun layout (T {rep, ty}) =
-	 let
-	    open Layout
-	 in
-	    record [("rep",
-		     case rep of
-			NonPointer => str "NonPointer"
-		      | Pointer {endsIn00} =>
-			   seq [str "Pointer ",
-				record [("endsIn00", Bool.layout endsIn00)]]),
-		    ("ty", Type.layout ty)]
-	 end
+         let
+            open Layout
+         in
+            record [("rep",
+                     case rep of
+                        NonPointer => str "NonPointer"
+                      | Pointer {endsIn00} =>
+                           seq [str "Pointer ",
+                                record [("endsIn00", Bool.layout endsIn00)]]),
+                    ("ty", Type.layout ty)]
+         end
 
       local
-	 fun make f (T r) = f r
+         fun make f (T r) = f r
       in
-	 val ty = make #ty
+         val ty = make #ty
       end
 
       fun equals (r, r') = Type.equals (ty r, ty r')
 
       val equals =
-	 Trace.trace2 ("Rep.equals", layout, layout, Bool.layout) equals
+         Trace.trace2 
+         ("PackedRepresentation.Rep.equals", layout, layout, Bool.layout) 
+         equals
 
       fun nonPointer ty = T {rep = NonPointer,
-			     ty = ty}
+                             ty = ty}
 
       val bool = nonPointer Type.bool
-	 
+         
       val width = Type.width o ty
 
       val unit = T {rep = NonPointer,
-		    ty = Type.unit}
+                    ty = Type.unit}
 
       fun isPointer (T {rep, ...}) =
-	 case rep of
-	    Pointer _ => true
-	  | _ => false
+         case rep of
+            Pointer _ => true
+          | _ => false
 
       fun isPointerEndingIn00 (T {rep, ...}) =
-	 case rep of
-	    Pointer {endsIn00} => endsIn00
-	  | _ => false
+         case rep of
+            Pointer {endsIn00} => endsIn00
+          | _ => false
 
       fun padToWidth (r as T {rep, ty}, width: Bits.t) =
-	 if Bits.equals (Type.width ty, width)
-	    then r
-	 else
-	    case rep of
-	       NonPointer =>
-		  T {rep = NonPointer,
-		     ty = Type.padToWidth (ty, width)}
-	     | Pointer _ => Error.bug "Rep.padToWidth"
+         if Bits.equals (Type.width ty, width)
+            then r
+         else
+            case rep of
+               NonPointer =>
+                  T {rep = NonPointer,
+                     ty = Type.padToWidth (ty, width)}
+             | Pointer _ => Error.bug "PackedRepresentation.Rep.padToWidth"
    end
 
 structure Statement =
@@ -154,23 +160,23 @@
       open Statement
 
       local
-	 fun make (doType, prim) (z1: Operand.t, z2: Operand.t) =
-	    let
-	       val t1 = Operand.ty z1
-	       val tmp = Var.newNoname ()
-	       val tmpTy = doType (t1, Operand.ty z2)
-	    in
-	       (PrimApp {args = Vector.new2 (z1, z2),
-			 dst = SOME (tmp, tmpTy),
-			 prim = prim (WordSize.fromBits (Type.width t1))},
-		Var {ty = tmpTy, var = tmp})
-	    end
+         fun make (doType, prim) (z1: Operand.t, z2: Operand.t) =
+            let
+               val t1 = Operand.ty z1
+               val tmp = Var.newNoname ()
+               val tmpTy = doType (t1, Operand.ty z2)
+            in
+               (PrimApp {args = Vector.new2 (z1, z2),
+                         dst = SOME (tmp, tmpTy),
+                         prim = prim (WordSize.fromBits (Type.width t1))},
+                Var {ty = tmpTy, var = tmp})
+            end
       in
-	 val andb = make (valOf o Type.andb, Prim.wordAndb)
-	 val lshift = make (Type.lshift, Prim.wordLshift)
-	 val orb = make (valOf o Type.orb, Prim.wordOrb)
-	 val rshift = make (Type.rshift, fn s =>
-			    Prim.wordRshift (s, {signed = false}))
+         val andb = make (valOf o Type.andb, Prim.wordAndb)
+         val lshift = make (Type.lshift, Prim.wordLshift)
+         val orb = make (valOf o Type.orb, Prim.wordOrb)
+         val rshift = make (Type.rshift, fn s =>
+                            Prim.wordRshift (s, {signed = false}))
       end
    end
 
@@ -184,116 +190,118 @@
        * width of the rep.
        *)
       datatype t = T of {components: {index: int,
-				      rep: Rep.t} vector,
-			 rep: Rep.t}
+                                      rep: Rep.t} vector,
+                         rep: Rep.t}
 
       fun layout (T {components, rep}) =
-	 let
-	    open Layout
-	 in
-	    record [("components",
-		     Vector.layout (fn {index, rep} =>
-				    record [("index", Int.layout index),
-					    ("rep", Rep.layout rep)])
-		     components),
-		    ("rep", Rep.layout rep)]
-	 end
-	 
+         let
+            open Layout
+         in
+            record [("components",
+                     Vector.layout (fn {index, rep} =>
+                                    record [("index", Int.layout index),
+                                            ("rep", Rep.layout rep)])
+                     components),
+                    ("rep", Rep.layout rep)]
+         end
+         
       local
-	 fun make f (T r) = f r
+         fun make f (T r) = f r
       in
-	 val rep = make #rep
+         val rep = make #rep
       end
 
       val unit = T {components = Vector.new0 (),
-		    rep = Rep.unit}
+                    rep = Rep.unit}
 
       fun equals (wr, wr') = Rep.equals (rep wr, rep wr')
-	 
+         
       fun make {components, rep} =
-	 if Bits.<= (Rep.width rep, Bits.inWord)
-	    andalso Bits.<= (Vector.fold (components, Bits.zero,
-					  fn ({rep, ...}, ac) =>
-					  Bits.+ (ac, Rep.width rep)),
-			     Rep.width rep)
-	    then T {components = components,
-		    rep = rep}
-	 else Error.bug "WordRep.make"
+         if Bits.<= (Rep.width rep, Bits.inWord)
+            andalso Bits.<= (Vector.fold (components, Bits.zero,
+                                          fn ({rep, ...}, ac) =>
+                                          Bits.+ (ac, Rep.width rep)),
+                             Rep.width rep)
+            then T {components = components,
+                    rep = rep}
+         else Error.bug "PackedRepresentation.WordRep.make"
 
       fun padToWidth (T {components, rep}, b: Bits.t): t =
-	 make {components = components,
-	       rep = Rep.padToWidth (rep, b)}
+         make {components = components,
+               rep = Rep.padToWidth (rep, b)}
  
       fun tuple (T {components, ...},
-		 {dst = (dstVar, dstTy): Var.t * Type.t,
-		  src: {index: int} -> Operand.t}): Statement.t list =
-	 let
-	    val bits = Type.width dstTy
-	    val wordSize = WordSize.fromBits bits
-	    val z =
-	       Vector.fold
-	       (components, NONE, fn ({index, rep, ...}, z) =>
-		let
-		   val (src, ss) = Statement.resize (src {index = index}, bits)
-		in
-		   case z of
-		      NONE => SOME (src, Rep.width rep, [rev ss])
-		    | SOME (ac, shift, statements) =>
-			 let
-			    val (s1, tmp) =
-			       Statement.lshift
-			       (src,
-				Operand.word
-				(WordX.fromIntInf (Bits.toIntInf shift,
-						   WordSize.default)))
-			    val (s2, ac) = Statement.orb (tmp, ac)
-			 in
-			    SOME (ac, Bits.+ (shift, Rep.width rep),
-				  ([s2, s1] @ rev ss) :: statements)
-			 end
-		end)
-	    val (src, statements) =
-	       case z of
-		  NONE => (Operand.word (WordX.zero wordSize), [])
-		| SOME (src, _, ss) => (src, ss)
-	    val statements =
-	       [Bind {dst = (dstVar, dstTy),
-		      isMutable = false,
-		      src = src}]
-	       :: statements
-	 in
-	    List.fold (statements, [], fn (ss, ac) => List.fold (ss, ac, op ::))
-	 end
+                 {dst = (dstVar, dstTy): Var.t * Type.t,
+                  src: {index: int} -> Operand.t}): Statement.t list =
+         let
+            val bits = Type.width dstTy
+            val wordSize = WordSize.fromBits bits
+            val z =
+               Vector.fold
+               (components, NONE, fn ({index, rep, ...}, z) =>
+                let
+                   val (src, ss) = Statement.resize (src {index = index}, bits)
+                in
+                   case z of
+                      NONE => SOME (src, Rep.width rep, [rev ss])
+                    | SOME (ac, shift, statements) =>
+                         let
+                            val (s1, tmp) =
+                               Statement.lshift
+                               (src,
+                                Operand.word
+                                (WordX.fromIntInf (Bits.toIntInf shift,
+                                                   WordSize.default)))
+                            val (s2, ac) = Statement.orb (tmp, ac)
+                         in
+                            SOME (ac, Bits.+ (shift, Rep.width rep),
+                                  ([s2, s1] @ rev ss) :: statements)
+                         end
+                end)
+            val (src, statements) =
+               case z of
+                  NONE => (Operand.word (WordX.zero wordSize), [])
+                | SOME (src, _, ss) => (src, ss)
+            val statements =
+               [Bind {dst = (dstVar, dstTy),
+                      isMutable = false,
+                      src = src}]
+               :: statements
+         in
+            List.fold (statements, [], fn (ss, ac) => List.fold (ss, ac, op ::))
+         end
 
       val tuple =
-	 Trace.trace ("WordRep.tuple", layout o #1, List.layout Statement.layout)
-	 tuple
+         Trace.trace 
+         ("PackedRepresentation.WordRep.tuple", 
+          layout o #1, List.layout Statement.layout)
+         tuple
    end
 
 structure Component =
    struct
       datatype t =
-	 Direct of {index: int,
-		    rep: Rep.t}
+         Direct of {index: int,
+                    rep: Rep.t}
        | Word of WordRep.t
 
       fun layout c =
-	 let
-	    open Layout
-	 in
-	    case c of
-	       Direct {index, rep} =>
-		  seq [str "Direct ",
-		       record [("index", Int.layout index),
-			       ("rep", Rep.layout rep)]]
-	     | Word wr =>
-		  seq [str "Word ", WordRep.layout wr]
-	 end
+         let
+            open Layout
+         in
+            case c of
+               Direct {index, rep} =>
+                  seq [str "Direct ",
+                       record [("index", Int.layout index),
+                               ("rep", Rep.layout rep)]]
+             | Word wr =>
+                  seq [str "Word ", WordRep.layout wr]
+         end
 
       val rep: t -> Rep.t =
-	 fn Direct {rep, ...} => rep
-	  | Word wr => WordRep.rep wr
-	       
+         fn Direct {rep, ...} => rep
+          | Word wr => WordRep.rep wr
+               
       val ty = Rep.ty o rep
 
       val width = Type.width o ty
@@ -301,160 +309,163 @@
       val unit = Word WordRep.unit
 
       val equals: t * t -> bool =
-	 fn z =>
-	 case z of
-	    (Direct {rep = r, ...}, Direct {rep = r', ...}) => Rep.equals (r, r')
-	  | (Word wr, Word wr') => WordRep.equals (wr, wr')
-	  | _ => false
+         fn z =>
+         case z of
+            (Direct {rep = r, ...}, Direct {rep = r', ...}) => Rep.equals (r, r')
+          | (Word wr, Word wr') => WordRep.equals (wr, wr')
+          | _ => false
 
       fun padToWidth (c: t, b: Bits.t): t =
-	 case c of
-	    Direct {index, rep} =>
-	       Direct {index = index,
-		       rep = Rep.padToWidth (rep, b)}
-	  | Word r => Word (WordRep.padToWidth (r, b))
+         case c of
+            Direct {index, rep} =>
+               Direct {index = index,
+                       rep = Rep.padToWidth (rep, b)}
+          | Word r => Word (WordRep.padToWidth (r, b))
 
       fun maybePadToWidth (c, b) =
-	 if Bits.< (b, width c) then c else padToWidth (c, b)
+         if Bits.< (b, width c) then c else padToWidth (c, b)
 
       fun padToPrim (c: t): t =
-	 let
-	    val t = ty c
-	    val t' = Type.padToPrim t
-	 in
-	    if Type.equals (t, t')
-	       then c
-	    else padToWidth (c, Type.width t')
-	 end
+         let
+            val t = ty c
+            val t' = Type.padToPrim t
+         in
+            if Type.equals (t, t')
+               then c
+            else padToWidth (c, Type.width t')
+         end
 
       fun tuple (c: t, {dst: Var.t * Type.t,
-			src: {index: int} -> Operand.t})
-	 : Statement.t list =
-	 case c of
-	    Direct {index, ...} =>
-	       let
-		  val (src, ss) = Statement.resize (src {index = index},
-						    Type.width (#2 dst))
-	       in
-		  ss @ [Bind {dst = dst,
-			      isMutable = false,
-			      src = src}]
-	       end
-	  | Word wr => WordRep.tuple (wr, {dst = dst, src = src})
+                        src: {index: int} -> Operand.t})
+         : Statement.t list =
+         case c of
+            Direct {index, ...} =>
+               let
+                  val (src, ss) = Statement.resize (src {index = index},
+                                                    Type.width (#2 dst))
+               in
+                  ss @ [Bind {dst = dst,
+                              isMutable = false,
+                              src = src}]
+               end
+          | Word wr => WordRep.tuple (wr, {dst = dst, src = src})
 
       val tuple =
-	 Trace.trace2 ("Component.tuple",
-		       layout,
-		       fn {dst = (dst, _), ...} => Var.layout dst,
-		       List.layout Statement.layout)
-	 tuple
+         Trace.trace2 
+         ("PackedRepresentation.Component.tuple",
+          layout, 
+          fn {dst = (dst, _), ...} => Var.layout dst, 
+          List.layout Statement.layout)
+         tuple
    end
 
 structure Unpack =
    struct
       datatype t = T of {shift: Bits.t,
-			 ty: Type.t}
+                         ty: Type.t}
 
       fun layout (T {shift, ty}) =
-	 let
-	    open Layout
-	 in
-	    record [("shift", Bits.layout shift),
-		    ("ty", Type.layout ty)]
-	 end
-	 
+         let
+            open Layout
+         in
+            record [("shift", Bits.layout shift),
+                    ("ty", Type.layout ty)]
+         end
+         
       val lshift: t * Bits.t -> t =
-	 fn (T {shift, ty}, b) =>
-	 T {shift = Bits.+ (shift, b),
-	    ty = ty}
+         fn (T {shift, ty}, b) =>
+         T {shift = Bits.+ (shift, b),
+            ty = ty}
 
       fun select (T {shift, ty},
-		  {dst = (dst, dstTy),
-		   src: Operand.t}): Statement.t list =
-	 let
-	    val (src, ss1) =
-	       if Bits.isZero shift
-		  then (src, [])
-	       else
-		  let
-		     val (s, tmp) =
-			Statement.rshift
-			(src,
-			 Operand.word (WordX.fromIntInf (Bits.toIntInf shift,
-							 WordSize.default)))
-		  in
-		     (tmp, [s])
-		  end
-	    val w = Type.width ty
-	    val s = WordSize.fromBits w
-	    val w' = Type.width dstTy
-	    val s' = WordSize.fromBits w'
-	    val (src, ss2) = Statement.resize (src, w')
-	    val (src, ss3) = 
-	       if Bits.equals (w, w')
-(* 		  orelse Type.isZero (Type.dropPrefix (Operand.ty src,
- * 						       WordSize.bits s))
+                  {dst = (dst, dstTy),
+                   src: Operand.t}): Statement.t list =
+         let
+            val (src, ss1) =
+               if Bits.isZero shift
+                  then (src, [])
+               else
+                  let
+                     val (s, tmp) =
+                        Statement.rshift
+                        (src,
+                         Operand.word (WordX.fromIntInf (Bits.toIntInf shift,
+                                                         WordSize.default)))
+                  in
+                     (tmp, [s])
+                  end
+            val w = Type.width ty
+            val s = WordSize.fromBits w
+            val w' = Type.width dstTy
+            val s' = WordSize.fromBits w'
+            val (src, ss2) = Statement.resize (src, w')
+            val (src, ss3) = 
+               if Bits.equals (w, w')
+(*                orelse Type.isZero (Type.dropPrefix (Operand.ty src,
+ *                                                     WordSize.bits s))
  *)
-		  then (src, [])
-	       else
-		  let
-		     val (s, src) =
-			Statement.andb
-			(src,
-			 Operand.word (WordX.resize
-				       (WordX.max (s, {signed = false}), s')))
-					    
-		  in
-		     (src, [s])
-		  end
-	 in
-	    ss1 @ ss2 @ ss3 @ [Bind {dst = (dst, dstTy),
-				     isMutable = false,
-				     src = src}]
-	 end
+                  then (src, [])
+               else
+                  let
+                     val (s, src) =
+                        Statement.andb
+                        (src,
+                         Operand.word (WordX.resize
+                                       (WordX.max (s, {signed = false}), s')))
+                                            
+                  in
+                     (src, [s])
+                  end
+         in
+            ss1 @ ss2 @ ss3 @ [Bind {dst = (dst, dstTy),
+                                     isMutable = false,
+                                     src = src}]
+         end
 
       val select =
-	 Trace.trace2 ("Unpack.select", layout,
-		       fn {dst = (dst, _), src} =>
-		       Layout.record [("dst", Var.layout dst),
-				      ("src", Operand.layout src)],
-		       List.layout Statement.layout)
-	 select
+         Trace.trace2 
+         ("PackedRepresentation.Unpack.select", 
+          layout,
+          fn {dst = (dst, _), src} => 
+          Layout.record [("dst", Var.layout dst),
+                         ("src", Operand.layout src)],
+          List.layout Statement.layout)
+         select
 
       fun update (T {shift, ty},
-		  {chunk: Operand.t,
-		   component: Operand.t}): Operand.t * Statement.t list =
-	 let
-	    val shift =
-	       WordX.fromIntInf (Bits.toIntInf shift, WordSize.default)
-	    val chunkWidth = Type.width (Operand.ty chunk)
-	    val mask =
-	       Operand.word
-	       (WordX.notb
-		(WordX.lshift
-		 (WordX.resize (WordX.allOnes (WordSize.fromBits
-					       (Type.width ty)),
-				WordSize.fromBits chunkWidth),
-		  shift)))
-	    val (s1, chunk) = Statement.andb (chunk, mask)
-	    val (component, s2) = Statement.resize (component, chunkWidth)
-	    val (s3, component) =
-	       Statement.lshift (component, Operand.word shift)
-	    val (s4, result) = Statement.orb (chunk, component)
-	 in
-	    (result, [s1] @ s2 @ [s3, s4])
-	 end
+                  {chunk: Operand.t,
+                   component: Operand.t}): Operand.t * Statement.t list =
+         let
+            val shift =
+               WordX.fromIntInf (Bits.toIntInf shift, WordSize.default)
+            val chunkWidth = Type.width (Operand.ty chunk)
+            val mask =
+               Operand.word
+               (WordX.notb
+                (WordX.lshift
+                 (WordX.resize (WordX.allOnes (WordSize.fromBits
+                                               (Type.width ty)),
+                                WordSize.fromBits chunkWidth),
+                  shift)))
+            val (s1, chunk) = Statement.andb (chunk, mask)
+            val (component, s2) = Statement.resize (component, chunkWidth)
+            val (s3, component) =
+               Statement.lshift (component, Operand.word shift)
+            val (s4, result) = Statement.orb (chunk, component)
+         in
+            (result, [s1] @ s2 @ [s3, s4])
+         end
 
       val update =
-	 Trace.trace2
-	 ("Unpack.update",
-	  layout,
-	  fn {chunk, component} =>
-	  Layout.record [("chunk", Operand.layout chunk),
-			 ("component", Operand.layout component)],
-	  Layout.tuple2 (Operand.layout,
-			 List.layout Statement.layout))
-	 update
+         Trace.trace2
+         ("PackedRepresentation.Unpack.update",
+          layout,
+          fn {chunk, component} =>
+          Layout.record [("chunk", Operand.layout chunk),
+                         ("component", Operand.layout component)],
+          Layout.tuple2 (Operand.layout,
+                         List.layout Statement.layout))
+         update
    end
 
 structure Base =
@@ -462,468 +473,472 @@
       open Base
 
       fun toOperand {base: Operand.t t,
-		     eltWidth: Bytes.t option,
-		     offset: Bytes.t,
-		     ty: Type.t}: Operand.t * Statement.t list =
-	 case base of
-	    Object base =>
-	       (Offset {base = base,
-			offset = offset,
-			ty = ty},
-		[])
-	  | VectorSub {index, vector} =>
-	       let
-		  val eltWidth =
-		     case eltWidth of
-			NONE => Error.bug "Base.toOperand missing eltWidth"
-		      | SOME w => w
-	       in
-		  case Scale.fromInt (Bytes.toInt eltWidth) of
-		     NONE =>
-			let
-			   val size = WordSize.default
-			   val wty = Type.word (WordSize.bits size)
-			   (* vector + (width * index) + offset *)
-			   val prod = Var.newNoname ()
-			   val s1 =
-			      PrimApp {args = (Vector.new2
-					       (index,
-						Operand.word
-						(WordX.fromIntInf
-						 (Bytes.toIntInf eltWidth,
-						  size)))),
-				       dst = SOME (prod, wty),
-				       prim = Prim.wordMul (size,
-							    {signed = false})}
-			   val eltBase = Var.newNoname ()
-			   val s2 =
-			      PrimApp {args = (Vector.new2
-					       (vector,
-						Operand.Var {ty = wty,
-							     var = prod})),
-				       dst = SOME (eltBase, wty),
-				       prim = Prim.wordAdd size}
-			in
-			   (Offset {base = Operand.Var {ty = wty,
-							var = eltBase},
-				    offset = offset,
-				    ty = ty},
-			    [s1, s2])
-			end
-		   | SOME s =>
-			(ArrayOffset {base = vector,
-				      index = index,
-				      offset = offset,
-				      scale = s,
-				      ty = ty},
-			 [])
-	       end
+                     eltWidth: Bytes.t option,
+                     offset: Bytes.t,
+                     ty: Type.t}: Operand.t * Statement.t list =
+         case base of
+            Object base =>
+               (Offset {base = base,
+                        offset = offset,
+                        ty = ty},
+                [])
+          | VectorSub {index, vector} =>
+               let
+                  val eltWidth =
+                     case eltWidth of
+                        NONE => Error.bug "PackedRepresentation.Base.toOperand: eltWidth"
+                      | SOME w => w
+               in
+                  case Scale.fromInt (Bytes.toInt eltWidth) of
+                     NONE =>
+                        let
+                           val size = WordSize.default
+                           val wty = Type.word (WordSize.bits size)
+                           (* vector + (width * index) + offset *)
+                           val prod = Var.newNoname ()
+                           val s1 =
+                              PrimApp {args = (Vector.new2
+                                               (index,
+                                                Operand.word
+                                                (WordX.fromIntInf
+                                                 (Bytes.toIntInf eltWidth,
+                                                  size)))),
+                                       dst = SOME (prod, wty),
+                                       prim = Prim.wordMul (size,
+                                                            {signed = false})}
+                           val eltBase = Var.newNoname ()
+                           val s2 =
+                              PrimApp {args = (Vector.new2
+                                               (vector,
+                                                Operand.Var {ty = wty,
+                                                             var = prod})),
+                                       dst = SOME (eltBase, wty),
+                                       prim = Prim.wordAdd size}
+                        in
+                           (Offset {base = Operand.Var {ty = wty,
+                                                        var = eltBase},
+                                    offset = offset,
+                                    ty = ty},
+                            [s1, s2])
+                        end
+                   | SOME s =>
+                        (ArrayOffset {base = vector,
+                                      index = index,
+                                      offset = offset,
+                                      scale = s,
+                                      ty = ty},
+                         [])
+               end
    end
 
 structure Select =
    struct
       datatype t =
-	 None
+         None
        | Direct of {ty: Type.t}
        | Indirect of {offset: Bytes.t,
-		      ty: Type.t}
+                      ty: Type.t}
        | IndirectUnpack of {offset: Words.t,
-			    rest: Unpack.t,
-			    ty: Type.t}
+                            rest: Unpack.t,
+                            ty: Type.t}
        | Unpack of Unpack.t
 
       fun layout s =
-	 let
-	    open Layout
-	 in
-	    case s of
-	       None => str "None"
-	     | Direct {ty} => seq [str "Direct ",
-				   record [("ty", Type.layout ty)]]
-	     | Indirect {offset, ty} =>
-		  seq [str "Indirect ",
-		       record [("offset", Bytes.layout offset),
-			       ("ty", Type.layout ty)]]
-	     | IndirectUnpack {offset, rest, ty} =>
-		  seq [str "IndirectUnpack ",
-		       record [("offset", Words.layout offset),
-			       ("rest", Unpack.layout rest),
-			       ("ty", Type.layout ty)]]
-	     | Unpack u => seq [str "Unpack ", Unpack.layout u]
-	 end
+         let
+            open Layout
+         in
+            case s of
+               None => str "None"
+             | Direct {ty} => seq [str "Direct ",
+                                   record [("ty", Type.layout ty)]]
+             | Indirect {offset, ty} =>
+                  seq [str "Indirect ",
+                       record [("offset", Bytes.layout offset),
+                               ("ty", Type.layout ty)]]
+             | IndirectUnpack {offset, rest, ty} =>
+                  seq [str "IndirectUnpack ",
+                       record [("offset", Words.layout offset),
+                               ("rest", Unpack.layout rest),
+                               ("ty", Type.layout ty)]]
+             | Unpack u => seq [str "Unpack ", Unpack.layout u]
+         end
 
       val lshift: t * Bits.t -> t =
-	 fn (s, b) =>
-	 case s of
-	    None => None
-	  | Direct {ty} => Unpack (Unpack.T {shift = b, ty = ty})
-	  | Unpack u => Unpack (Unpack.lshift (u, b))
-	  | _ => Error.bug "Select.lshift"
+         fn (s, b) =>
+         case s of
+            None => None
+          | Direct {ty} => Unpack (Unpack.T {shift = b, ty = ty})
+          | Unpack u => Unpack (Unpack.lshift (u, b))
+          | _ => Error.bug "PackedRepresentation.Select.lshift"
 
       fun select (s: t, {base: Operand.t Base.t,
-			 dst: Var.t * Type.t,
-			 eltWidth: Bytes.t option}): Statement.t list =
-	 let
-	    fun move (src, ss) =
-	       let
-		  val (dst, dstTy) = dst
-		  val (src, ss') = Statement.resize (src, Type.width dstTy)
-	       in
-		  ss @ ss' @ [Bind {dst = (dst, dstTy),
-				    isMutable = false,
-				    src = src}]
-	       end
-	 in
-	    case s of
-	       None => []
-	     | Direct _ => move (Base.object base, [])
-	     | Indirect {offset, ty} =>
-		  move (Base.toOperand {base = base,
-					eltWidth = eltWidth,
-					offset = offset,
-					ty = ty})
-	     | IndirectUnpack {offset, rest, ty} =>
-		  let
-		     val tmpVar = Var.newNoname ()
-		     val tmpOp = Var {ty = ty, var = tmpVar}
-		     val (src, ss) =
-			Base.toOperand {base = base,
-					eltWidth = eltWidth,
-					offset = Words.toBytes offset,
-					ty = ty}
-		  in
-		     ss @ (Bind {dst = (tmpVar, ty),
-				 isMutable = false,
-				 src = src}
-			   :: Unpack.select (rest, {dst = dst, src = tmpOp}))
-		  end
-	     | Unpack u =>
-		  Unpack.select (u, {dst = dst, src = Base.object base})
-	 end
+                         dst: Var.t * Type.t,
+                         eltWidth: Bytes.t option}): Statement.t list =
+         let
+            fun move (src, ss) =
+               let
+                  val (dst, dstTy) = dst
+                  val (src, ss') = Statement.resize (src, Type.width dstTy)
+               in
+                  ss @ ss' @ [Bind {dst = (dst, dstTy),
+                                    isMutable = false,
+                                    src = src}]
+               end
+         in
+            case s of
+               None => []
+             | Direct _ => move (Base.object base, [])
+             | Indirect {offset, ty} =>
+                  move (Base.toOperand {base = base,
+                                        eltWidth = eltWidth,
+                                        offset = offset,
+                                        ty = ty})
+             | IndirectUnpack {offset, rest, ty} =>
+                  let
+                     val tmpVar = Var.newNoname ()
+                     val tmpOp = Var {ty = ty, var = tmpVar}
+                     val (src, ss) =
+                        Base.toOperand {base = base,
+                                        eltWidth = eltWidth,
+                                        offset = Words.toBytes offset,
+                                        ty = ty}
+                  in
+                     ss @ (Bind {dst = (tmpVar, ty),
+                                 isMutable = false,
+                                 src = src}
+                           :: Unpack.select (rest, {dst = dst, src = tmpOp}))
+                  end
+             | Unpack u =>
+                  Unpack.select (u, {dst = dst, src = Base.object base})
+         end
 
       val select =
-	 Trace.trace ("Select.select", layout o #1, List.layout Statement.layout)
-	 select
+         Trace.trace 
+         ("PackedRepresentation.Select.select", 
+          layout o #1, List.layout Statement.layout)
+         select
 
       fun update (s: t, {base: Operand.t Base.t,
-			 eltWidth: Bytes.t option,
-			 value: Operand.t}): Statement.t list =
-	 case s of
-	    Indirect {offset, ty} =>
-	       let
-		  val (dst, ss) =
-		     Base.toOperand {base = base,
-				     eltWidth = eltWidth,
-				     offset = offset,
-				     ty = ty}
-	       in
-		  ss @ [Move {dst = dst, src = value}]
-	       end
-	  | IndirectUnpack {offset, rest, ty} =>
-	       let
-		  val (chunk, ss) =
-		     Base.toOperand {base = base,
-				     eltWidth = eltWidth,
-				     offset = Words.toBytes offset,
-				     ty = ty}
-		  val (newChunk, ss') = 
-		     Unpack.update (rest, {chunk = chunk,
-					   component = value})
-	       in
-		  ss @ ss' @ [Move {dst = chunk, src = newChunk}]
-	       end
-	  | _ => Error.bug "Select.update of non indirect"
+                         eltWidth: Bytes.t option,
+                         value: Operand.t}): Statement.t list =
+         case s of
+            Indirect {offset, ty} =>
+               let
+                  val (dst, ss) =
+                     Base.toOperand {base = base,
+                                     eltWidth = eltWidth,
+                                     offset = offset,
+                                     ty = ty}
+               in
+                  ss @ [Move {dst = dst, src = value}]
+               end
+          | IndirectUnpack {offset, rest, ty} =>
+               let
+                  val (chunk, ss) =
+                     Base.toOperand {base = base,
+                                     eltWidth = eltWidth,
+                                     offset = Words.toBytes offset,
+                                     ty = ty}
+                  val (newChunk, ss') = 
+                     Unpack.update (rest, {chunk = chunk,
+                                           component = value})
+               in
+                  ss @ ss' @ [Move {dst = chunk, src = newChunk}]
+               end
+          | _ => Error.bug "PackedRepresentation.Select.update: non-indirect"
 
       val update =
-	 Trace.trace ("Select.update", layout o #1, List.layout Statement.layout)
-	 update
+         Trace.trace 
+         ("PackedRepresentation.Select.update", 
+          layout o #1, List.layout Statement.layout)
+         update
    end
 
 structure Selects =
    struct
       datatype t = T of {orig: S.Type.t,
-			 select: Select.t} vector
+                         select: Select.t} vector
 
       fun layout (T v) = Vector.layout (Select.layout o #select) v
 
       val empty = T (Vector.new0 ())
 
       fun map (T v, f) =
-	 T (Vector.map (v, fn {orig, select} =>
-			{orig = orig,
-			 select = f select}))
+         T (Vector.map (v, fn {orig, select} =>
+                        {orig = orig,
+                         select = f select}))
 
       fun select (T v, {base: Operand.t Base.t,
-			dst: Var.t * Type.t,
-			eltWidth: Bytes.t option,
-			offset: int}): Statement.t list =
-	 Select.select (#select (Vector.sub (v, offset)),
-			{base = base, eltWidth = eltWidth, dst = dst})
+                        dst: Var.t * Type.t,
+                        eltWidth: Bytes.t option,
+                        offset: int}): Statement.t list =
+         Select.select (#select (Vector.sub (v, offset)),
+                        {base = base, eltWidth = eltWidth, dst = dst})
 
       fun update (T v, {base, eltWidth, offset, value}) =
-	 Select.update (#select (Vector.sub (v, offset)),
-			{base = base, eltWidth = eltWidth, value = value})
+         Select.update (#select (Vector.sub (v, offset)),
+                        {base = base, eltWidth = eltWidth, value = value})
 
       fun lshift (T v, b: Bits.t) =
-	 T (Vector.map (v, fn {orig, select} =>
-			{orig = orig,
-			 select = Select.lshift (select, b)}))
+         T (Vector.map (v, fn {orig, select} =>
+                        {orig = orig,
+                         select = Select.lshift (select, b)}))
    end
 
 structure PointerRep =
    struct
       datatype t = T of {components: {component: Component.t,
-				      offset: Words.t} vector,
-			 componentsTy: Type.t,
-			 selects: Selects.t,
-			 ty: Type.t,
-			 tycon: PointerTycon.t}
+                                      offset: Words.t} vector,
+                         componentsTy: Type.t,
+                         selects: Selects.t,
+                         ty: Type.t,
+                         tycon: PointerTycon.t}
 
       fun layout (T {components, componentsTy, selects, ty, tycon}) =
-	 let
-	    open Layout
-	 in
-	    record
-	    [("components",
-	      Vector.layout (fn {component, offset} =>
-			     record [("component", Component.layout component),
-				     ("offset", Words.layout offset)])
-	      components),
-	     ("componentsTy", Type.layout componentsTy),
-	     ("selects", Selects.layout selects),
-	     ("ty", Type.layout ty),
-	     ("tycon", PointerTycon.layout tycon)]
-	 end
+         let
+            open Layout
+         in
+            record
+            [("components",
+              Vector.layout (fn {component, offset} =>
+                             record [("component", Component.layout component),
+                                     ("offset", Words.layout offset)])
+              components),
+             ("componentsTy", Type.layout componentsTy),
+             ("selects", Selects.layout selects),
+             ("ty", Type.layout ty),
+             ("tycon", PointerTycon.layout tycon)]
+         end
 
       local
-	 fun make f (T r) = f r
+         fun make f (T r) = f r
       in
-	 val componentsTy = make #componentsTy
-	 val ty = make #ty
-	 val tycon = make #tycon
+         val componentsTy = make #componentsTy
+         val ty = make #ty
+         val tycon = make #tycon
       end
 
       fun equals (T {tycon = c, ...}, T {tycon = c', ...}) =
-	 PointerTycon.equals (c, c')
+         PointerTycon.equals (c, c')
 
       fun rep (T {ty, ...}) =
-	 Rep.T {rep = Rep.Pointer {endsIn00 = true},
-		ty = ty}
+         Rep.T {rep = Rep.Pointer {endsIn00 = true},
+                ty = ty}
 
       fun make {components, isVector, selects, tycon} =
-	 let
-	    val width =
-	       Vector.fold
-	       (components, Bytes.zero, fn ({component = c, ...}, ac) =>
-		Bytes.+ (ac, Type.bytes (Component.ty c)))
-	    fun align8 (b: Bytes.t): Bytes.t =
-	       Bytes.align (b, {alignment = Bytes.fromInt 8})
-	    fun isAligned8 (b: Bytes.t): bool = Bytes.equals (b, align8 b)
-	    val isAligned: bool =
-	       !Control.align = Control.Align4
-	       orelse
-	       if isVector
-		  then
-		     if (Vector.exists
-			 (components, fn {component = c, ...} =>
-			  case Type.deReal (Component.ty c) of
-			     NONE => false
-			   | SOME s => RealSize.equals (s, RealSize.R64)))
-			then isAligned8 width
-		     else true
-	       else isAligned8 (Bytes.+ (width, Runtime.normalHeaderSize))
-	    val (components, selects) =
-	       if isAligned
-		  then (components, selects)
-	       else
-		  (* Need to insert a pad word before the first pointer. *)
-		  let
-		     val {no = nonPointers, yes = pointers} =
-			Vector.partition
-			(components, fn {component = c, ...} =>
-			 Rep.isPointer (Component.rep c))
-		     val padOffset =
-			if 0 = Vector.length pointers
-			   then Bytes.toWords width
-			else #offset (Vector.sub (pointers, 0))
-		     val pad =			      
-			{component = Component.padToWidth (Component.unit,
-							   Bits.inWord),
-			 offset = padOffset}
-		     val pointers =
-			Vector.map (pointers, fn {component = c, offset} =>
-				    {component = c,
-				     offset = Words.+ (offset, Words.one)})
-		     val components = 
-			Vector.concat [nonPointers, Vector.new1 pad, pointers]
-		     val selects =
-			Selects.map
-			(selects, fn s =>
-			 case s of
-			    Select.Indirect {offset, ty} =>
-			       if Bytes.>= (offset, Words.toBytes padOffset)
-				  then
-				     Select.Indirect
-				     {offset = Bytes.+ (offset, Bytes.inWord),
-				      ty = ty}
-			       else s
-			  | _ => s)
-		  in
-		     (components, selects)
-		  end
-	    val componentsTy =
-	       Type.seq (Vector.map (components, Component.ty o #component))
-	    (* If there are no components, then add a pad word. *)
-	    val componentsTy =
-	       if Bits.isZero (Type.width componentsTy)
-		  then Type.zero Bits.inWord
-	       else componentsTy
-	 in
-	    T {components = components,
-	       componentsTy = componentsTy,
-	       selects = selects,
-	       ty = Type.pointer tycon,
-	       tycon = tycon}
-	 end
+         let
+            val width =
+               Vector.fold
+               (components, Bytes.zero, fn ({component = c, ...}, ac) =>
+                Bytes.+ (ac, Type.bytes (Component.ty c)))
+            fun align8 (b: Bytes.t): Bytes.t =
+               Bytes.align (b, {alignment = Bytes.fromInt 8})
+            fun isAligned8 (b: Bytes.t): bool = Bytes.equals (b, align8 b)
+            val isAligned: bool =
+               !Control.align = Control.Align4
+               orelse
+               if isVector
+                  then
+                     if (Vector.exists
+                         (components, fn {component = c, ...} =>
+                          case Type.deReal (Component.ty c) of
+                             NONE => false
+                           | SOME s => RealSize.equals (s, RealSize.R64)))
+                        then isAligned8 width
+                     else true
+               else isAligned8 (Bytes.+ (width, Runtime.normalHeaderSize))
+            val (components, selects) =
+               if isAligned
+                  then (components, selects)
+               else
+                  (* Need to insert a pad word before the first pointer. *)
+                  let
+                     val {no = nonPointers, yes = pointers} =
+                        Vector.partition
+                        (components, fn {component = c, ...} =>
+                         Rep.isPointer (Component.rep c))
+                     val padOffset =
+                        if 0 = Vector.length pointers
+                           then Bytes.toWords width
+                        else #offset (Vector.sub (pointers, 0))
+                     val pad =                        
+                        {component = Component.padToWidth (Component.unit,
+                                                           Bits.inWord),
+                         offset = padOffset}
+                     val pointers =
+                        Vector.map (pointers, fn {component = c, offset} =>
+                                    {component = c,
+                                     offset = Words.+ (offset, Words.one)})
+                     val components = 
+                        Vector.concat [nonPointers, Vector.new1 pad, pointers]
+                     val selects =
+                        Selects.map
+                        (selects, fn s =>
+                         case s of
+                            Select.Indirect {offset, ty} =>
+                               if Bytes.>= (offset, Words.toBytes padOffset)
+                                  then
+                                     Select.Indirect
+                                     {offset = Bytes.+ (offset, Bytes.inWord),
+                                      ty = ty}
+                               else s
+                          | _ => s)
+                  in
+                     (components, selects)
+                  end
+            val componentsTy =
+               Type.seq (Vector.map (components, Component.ty o #component))
+            (* If there are no components, then add a pad word. *)
+            val componentsTy =
+               if Bits.isZero (Type.width componentsTy)
+                  then Type.zero Bits.inWord
+               else componentsTy
+         in
+            T {components = components,
+               componentsTy = componentsTy,
+               selects = selects,
+               ty = Type.pointer tycon,
+               tycon = tycon}
+         end
 
       val make =
-	 let
-	    open Layout
-	 in
-	    Trace.trace
-	    ("PointerRep.make",
-	     fn {components, isVector, selects, tycon} =>
-	     record
-	     [("components",
-	       Vector.layout (fn {component, offset} =>
-			      record [("component", Component.layout component),
-				      ("offset", Words.layout offset)])
-	       components),
-	      ("isVector", Bool.layout isVector),
-	      ("selects", Selects.layout selects),
-	      ("tycon", PointerTycon.layout tycon)],
-	     layout)
-	 end
-	 make
+         let
+            open Layout
+         in
+            Trace.trace
+            ("PackedRepresentation.PointerRep.make",
+             fn {components, isVector, selects, tycon} =>
+             record
+             [("components",
+               Vector.layout (fn {component, offset} =>
+                              record [("component", Component.layout component),
+                                      ("offset", Words.layout offset)])
+               components),
+              ("isVector", Bool.layout isVector),
+              ("selects", Selects.layout selects),
+              ("tycon", PointerTycon.layout tycon)],
+             layout)
+         end
+         make
 
       fun box (component: Component.t, pt: PointerTycon.t, selects: Selects.t) =
-	 let
-	    val selects =
-	       Selects.map
-	       (selects, fn s =>
-		let
-		   datatype z = datatype Select.t
-		in
-		   case s of
-		      None => None
-		    | Direct {ty} => Indirect {offset = Bytes.zero, ty = ty}
-		    | Unpack u =>
-			 IndirectUnpack {offset = Words.zero,
-					 rest = u,
-					 ty = Component.ty component}
-		    | _ => Error.bug "PointerRep.box cannot lift selects"
-		end)
-	 in
-	    make {components = Vector.new1 {component = component,
-					    offset = Words.zero},
-		  isVector = false,
-		  selects = selects,
-		  tycon = pt}
-	 end
+         let
+            val selects =
+               Selects.map
+               (selects, fn s =>
+                let
+                   datatype z = datatype Select.t
+                in
+                   case s of
+                      None => None
+                    | Direct {ty} => Indirect {offset = Bytes.zero, ty = ty}
+                    | Unpack u =>
+                         IndirectUnpack {offset = Words.zero,
+                                         rest = u,
+                                         ty = Component.ty component}
+                    | _ => Error.bug "PackedRepresentation.PointerRep.box: cannot lift selects"
+                end)
+         in
+            make {components = Vector.new1 {component = component,
+                                            offset = Words.zero},
+                  isVector = false,
+                  selects = selects,
+                  tycon = pt}
+         end
       
       fun tuple (T {components, componentsTy, ty, tycon, ...},
-		 {dst = dst: Var.t,
-		  src: {index: int} -> Operand.t}) =
-	 let
-	    val object = Var {ty = ty, var = dst}
-	    val stores =
-	       Vector.foldr
-	       (components, [], fn ({component, offset}, ac) =>
-		let
-		   val tmpVar = Var.newNoname ()
-		   val tmpTy = Component.ty component
-		in
-		   Component.tuple (component,
-				    {dst = (tmpVar, tmpTy), src = src})
-		   @ (Move {dst = Offset {base = object,
-					  offset = Words.toBytes offset,
-					  ty = tmpTy},
-			    src = Var {ty = tmpTy, var = tmpVar}}
-		      :: ac)
-		end)
-	 in
-	    Object {dst = (dst, ty),
-		    header = (Runtime.typeIndexToHeader
-			      (PointerTycon.index tycon)),
-		    size = Bytes.toWords (Bytes.+ (Type.bytes componentsTy,
-						   Runtime.normalHeaderSize))}
-	    :: stores
-	 end
+                 {dst = dst: Var.t,
+                  src: {index: int} -> Operand.t}) =
+         let
+            val object = Var {ty = ty, var = dst}
+            val stores =
+               Vector.foldr
+               (components, [], fn ({component, offset}, ac) =>
+                let
+                   val tmpVar = Var.newNoname ()
+                   val tmpTy = Component.ty component
+                in
+                   Component.tuple (component,
+                                    {dst = (tmpVar, tmpTy), src = src})
+                   @ (Move {dst = Offset {base = object,
+                                          offset = Words.toBytes offset,
+                                          ty = tmpTy},
+                            src = Var {ty = tmpTy, var = tmpVar}}
+                      :: ac)
+                end)
+         in
+            Object {dst = (dst, ty),
+                    header = (Runtime.typeIndexToHeader
+                              (PointerTycon.index tycon)),
+                    size = Bytes.toWords (Bytes.+ (Type.bytes componentsTy,
+                                                   Runtime.normalHeaderSize))}
+            :: stores
+         end
 
       val tuple =
-	 Trace.trace2 ("PointerRep.tuple", layout, Var.layout o #dst,
-		       List.layout Statement.layout)
-	 tuple
+         Trace.trace2 
+         ("PackedRepresentation.PointerRep.tuple", 
+          layout, Var.layout o #dst, List.layout Statement.layout)
+         tuple
    end
 
 structure TupleRep =
    struct
       datatype t =
-	 Direct of {component: Component.t,
-		    selects: Selects.t}
+         Direct of {component: Component.t,
+                    selects: Selects.t}
        | Indirect of PointerRep.t
 
       fun layout tr =
-	 let
-	    open Layout
-	 in
-	    case tr of
-	       Direct {component, selects} =>
-		  seq [str "Direct ",
-		       record [("component", Component.layout component),
-			       ("selects", Selects.layout selects)]]
-	     | Indirect pr =>
-		  seq [str "Indirect ", PointerRep.layout pr]
-	 end
+         let
+            open Layout
+         in
+            case tr of
+               Direct {component, selects} =>
+                  seq [str "Direct ",
+                       record [("component", Component.layout component),
+                               ("selects", Selects.layout selects)]]
+             | Indirect pr =>
+                  seq [str "Indirect ", PointerRep.layout pr]
+         end
 
       val unit = Direct {component = Component.unit,
-			 selects = Selects.empty}
+                         selects = Selects.empty}
 
       val equals: t * t -> bool =
-	 fn z =>
-	 case z of
-	    (Direct {component = c, ...}, Direct {component = c', ...}) =>
-	       Component.equals (c, c')
-	  | (Indirect pr, Indirect pr') => PointerRep.equals (pr, pr')
-	  | _ => false
+         fn z =>
+         case z of
+            (Direct {component = c, ...}, Direct {component = c', ...}) =>
+               Component.equals (c, c')
+          | (Indirect pr, Indirect pr') => PointerRep.equals (pr, pr')
+          | _ => false
 
       fun rep (tr: t): Rep.t =
-	 case tr of
-	    Direct {component, ...} => Component.rep component
-	  | Indirect p => PointerRep.rep p
+         case tr of
+            Direct {component, ...} => Component.rep component
+          | Indirect p => PointerRep.rep p
 
       val ty = Rep.ty o rep
-	 
+         
       fun selects (tr: t): Selects.t =
-	 case tr of
-	    Direct {selects, ...} => selects
-	  | Indirect (PointerRep.T {selects, ...}) => selects
+         case tr of
+            Direct {selects, ...} => selects
+          | Indirect (PointerRep.T {selects, ...}) => selects
 
       fun tuple (tr: t,
-		 {dst: Var.t * Type.t,
-		  src: {index: int} -> Operand.t}): Statement.t list =
-	 case tr of
-	    Direct {component = c, ...} =>
-	       Component.tuple (c, {dst = dst, src = src})
-	  | Indirect pr =>
-	       PointerRep.tuple (pr, {dst = #1 dst, src = src})
+                 {dst: Var.t * Type.t,
+                  src: {index: int} -> Operand.t}): Statement.t list =
+         case tr of
+            Direct {component = c, ...} =>
+               Component.tuple (c, {dst = dst, src = src})
+          | Indirect pr =>
+               PointerRep.tuple (pr, {dst = #1 dst, src = src})
  
       val tuple =
-	 Trace.trace2 ("TupleRep.tuple",
-		       layout,
-		       Var.layout o #1 o #dst,
-		       List.layout Statement.layout)
-	 tuple
+         Trace.trace2 
+         ("PackedRepresentation.TupleRep.tuple",
+          layout, Var.layout o #1 o #dst, List.layout Statement.layout)
+         tuple
 
       (* TupleRep.make decides how to layout a sequence of types in an object,
        * or in the case of a vector, in a vector element.
@@ -937,367 +952,350 @@
        * are any pointers, they go at the end of the object.
        *)
       fun make (pointerTycon: PointerTycon.t,
-		rs: {isMutable: bool,
-		     rep: Rep.t,
-		     ty: S.Type.t} vector,
-		{forceBox: bool,
-		 isVector: bool}): t =
-	 let
-	    val pointers = ref []
-	    val doubleWords = ref []
-	    val words = ref []
-	    val a = Array.array (Bits.toInt Bits.inWord, [])
-	    val () =
-	       Vector.foreachi
-	       (rs, fn (i, {rep = r as Rep.T {rep, ty}, ...}) =>
-		let
-		   fun direct l =
-		      List.push
-		      (l, {component = Component.Direct {index = i, rep = r},
-			   index = i})
-		in
-		   case rep of
-		      Rep.NonPointer =>
-			 let
-			    val b = Bits.toInt (Type.width ty)
-			 in
-			    case b of
-			       32 => direct words
-			     | 64 => direct doubleWords
-			     | _ =>
-				  Array.update
-				  (a, b,
-				   {index = i, rep = r} :: Array.sub (a, b))
-			 end
-		    | Rep.Pointer _ => direct pointers
-		end)
-	    val selects = Array.array (Vector.length rs,
-				       (Select.None, Select.None))
-	    fun simple (l, width: Words.t, offset: Words.t, components) =
-	       List.fold
-	       (l, (offset, components),
-		fn ({component, index}, (offset, ac)) =>
-		(Words.+ (offset, width),
-		 let
-		    val ty = Component.ty component
-		    val () =
-		       Array.update
-		       (selects, index,
-			(Select.Direct {ty = ty},
-			 Select.Indirect {offset = Words.toBytes offset,
-					  ty = ty}))
-		 in
-		    {component = component,
-		     offset = offset,
-		     setSelects = fn _ => ()} :: ac
-		 end))
-	    val offset = Words.zero
-	    val components = []
-	    val (offset, components) =
-	       simple (!doubleWords, Words.fromInt 2, offset, components)
-	    val (offset, components) =
-	       simple (!words, Words.one, offset, components)
-	    (* j is the maximum index <= remainingWidth at which an element of a
-	     * may be nonempty.
-	     *)
-	    fun wordComponents (j: int,
-				remainingWidth: Bits.t,
-				components) =
-	       if 0 = j
-		  then (remainingWidth, Vector.fromList components)
-	       else
-		  let
-		     val elts = Array.sub (a, j)
-		  in
-		     case elts of
-			[] => wordComponents (j - 1, remainingWidth, components)
-		      | {index, rep} :: elts =>
-			   let
-			      val () = Array.update (a, j, elts)
-			      val remainingWidth =
-				 Bits.- (remainingWidth, Rep.width rep)
-			   in
-			      wordComponents
-			      (Bits.toInt remainingWidth,
-			       remainingWidth,
-			       {index = index, rep = rep} :: components)
-			   end
-		  end
-	    (* max is the maximum index at which an element of a may be nonempty.
-	     *)
-	    fun makeWords (max: int, offset: Words.t, ac) =
-	       if 0 = max
-		  then (offset, ac)
-	       else
-		  if List.isEmpty (Array.sub (a, max))
-		     then makeWords (max - 1, offset, ac)
-		  else
-		     let
-			val (_, components) =
-			   wordComponents (max, Bits.inWord, [])
-			val componentTy =
-			   Type.seq (Vector.map (components, Rep.ty o #rep))
-			fun setSelects (padToPrim: bool): unit =
-			   let
-			      val paddedComponentTy =
-				 if padToPrim
-				    then Type.padToPrim componentTy
-				 else Type.padToWidth (componentTy, Bits.inWord)
-			      fun getByteOffset (shift: Bytes.t): Bytes.t =
-				 Bytes.+
-				 (Words.toBytes offset,
-				  if not (Control.targetIsBigEndian ())
-				     then shift
-				  else
-				     Bytes.fromInt
-				     (Bytes.toInt (Type.bytes paddedComponentTy)
-				      - 1 - Bytes.toInt shift))
-			   in
-			      ignore
-			      (Vector.fold
-			       (components, Bits.zero,
-				fn ({index, rep}, shift) =>
-				let
-				   val repTy = Rep.ty rep
-				   val unpack = Unpack.T {shift = shift,
-							  ty = repTy}
-				   val iu =
-				      if (Bits.isByteAligned shift
-					  andalso (Bits.equals
-						   (Type.width repTy,
-						    Bits.inByte)))
-					 then
-					    Select.Indirect
-					    {offset = (getByteOffset
-						       (Bits.toBytes shift)),
-					     ty = repTy}
-				      else (Select.IndirectUnpack
-					    {offset = offset,
-					     rest = unpack,
-					     ty = paddedComponentTy})
-				   val () =
-				      Array.update (selects, index,
-						    (Select.Unpack unpack, iu))
-				in
-				   Bits.+ (shift, Rep.width rep)
-				end))
-			   end
-			val component =
-			   Component.Word
-			   (WordRep.T {components = components,
-				       rep = Rep.T {rep = Rep.NonPointer,
-						    ty = componentTy}})
-			val ac = {component = component,
-				  offset = offset,
-				  setSelects = setSelects} :: ac
-		     in
-			makeWords (max, Words.+ (offset, Words.one), ac)
-		     end
-	    val (offset, components) =
-	       makeWords (Bits.toInt Bits.inWord - 1, offset, components)
-	    val (_, components) =
-	       simple (!pointers, Words.inPointer, offset, components)
-	    val components = Vector.fromListRev components
-	    val padToPrim = isVector andalso 1 = Vector.length components
-	    val () =
-	       Vector.foreach
-	       (components, fn {setSelects, ...} => setSelects padToPrim)
-	    fun getSelects s =
-	       Selects.T (Vector.tabulate
-			  (Array.length selects, fn i =>
-			   {orig = #ty (Vector.sub (rs, i)),
-			    select = s (Array.sub (selects, i))}))
-	    fun box () =
-	       let
-		  val components =
-		     Vector.map
-		     (components, fn {component = c, offset, ...} =>
-		      let
-			 val c =
-			    if padToPrim
-			       then Component.padToPrim c
-			    else Component.maybePadToWidth (c, Bits.inWord)
-		      in
-			 {component = c,
-			  offset = offset}
-		      end)
-	       in
-		  Indirect (PointerRep.make {components = components,
-					     isVector = isVector,
-					     selects = getSelects #2,
-					     tycon = pointerTycon})
-	       end
-	 in
-	    if forceBox orelse Vector.exists (rs, #isMutable)
-	       then box ()
-	    else
-	       case Vector.length components of
-		  0 => unit
-		| 1 =>
-		     Direct {component = #component (Vector.sub (components, 0)),
-			     selects = getSelects #1}
-		| _ => box ()
-	 end
+                rs: {isMutable: bool,
+                     rep: Rep.t,
+                     ty: S.Type.t} vector,
+                {forceBox: bool,
+                 isVector: bool}): t =
+         let
+            val pointers = ref []
+            val doubleWords = ref []
+            val words = ref []
+            val a = Array.array (Bits.toInt Bits.inWord, [])
+            val () =
+               Vector.foreachi
+               (rs, fn (i, {rep = r as Rep.T {rep, ty}, ...}) =>
+                let
+                   fun direct l =
+                      List.push
+                      (l, {component = Component.Direct {index = i, rep = r},
+                           index = i})
+                in
+                   case rep of
+                      Rep.NonPointer =>
+                         let
+                            val b = Bits.toInt (Type.width ty)
+                         in
+                            case b of
+                               32 => direct words
+                             | 64 => direct doubleWords
+                             | _ =>
+                                  Array.update
+                                  (a, b,
+                                   {index = i, rep = r} :: Array.sub (a, b))
+                         end
+                    | Rep.Pointer _ => direct pointers
+                end)
+            val selects = Array.array (Vector.length rs,
+                                       (Select.None, Select.None))
+            fun simple (l, width: Words.t, offset: Words.t, components) =
+               List.fold
+               (l, (offset, components),
+                fn ({component, index}, (offset, ac)) =>
+                (Words.+ (offset, width),
+                 let
+                    val ty = Component.ty component
+                    val () =
+                       Array.update
+                       (selects, index,
+                        (Select.Direct {ty = ty},
+                         Select.Indirect {offset = Words.toBytes offset,
+                                          ty = ty}))
+                 in
+                    {component = component,
+                     offset = offset,
+                     setSelects = fn _ => ()} :: ac
+                 end))
+            val offset = Words.zero
+            val components = []
+            val (offset, components) =
+               simple (!doubleWords, Words.fromInt 2, offset, components)
+            val (offset, components) =
+               simple (!words, Words.one, offset, components)
+            (* j is the maximum index <= remainingWidth at which an element of a
+             * may be nonempty.
+             *)
+            fun wordComponents (j: int,
+                                remainingWidth: Bits.t,
+                                components) =
+               if 0 = j
+                  then (remainingWidth, Vector.fromList components)
+               else
+                  let
+                     val elts = Array.sub (a, j)
+                  in
+                     case elts of
+                        [] => wordComponents (j - 1, remainingWidth, components)
+                      | {index, rep} :: elts =>
+                           let
+                              val () = Array.update (a, j, elts)
+                              val remainingWidth =
+                                 Bits.- (remainingWidth, Rep.width rep)
+                           in
+                              wordComponents
+                              (Bits.toInt remainingWidth,
+                               remainingWidth,
+                               {index = index, rep = rep} :: components)
+                           end
+                  end
+            (* max is the maximum index at which an element of a may be nonempty.
+             *)
+            fun makeWords (max: int, offset: Words.t, ac) =
+               if 0 = max
+                  then (offset, ac)
+               else
+                  if List.isEmpty (Array.sub (a, max))
+                     then makeWords (max - 1, offset, ac)
+                  else
+                     let
+                        val (_, components) =
+                           wordComponents (max, Bits.inWord, [])
+                        val componentTy =
+                           Type.seq (Vector.map (components, Rep.ty o #rep))
+                        fun setSelects (padToPrim: bool): unit =
+                           let
+                              val paddedComponentTy =
+                                 if padToPrim
+                                    then Type.padToPrim componentTy
+                                 else Type.padToWidth (componentTy, Bits.inWord)
+                              fun getByteOffset (shift: Bytes.t): Bytes.t =
+                                 Bytes.+
+                                 (Words.toBytes offset,
+                                  if not (Control.targetIsBigEndian ())
+                                     then shift
+                                  else
+                                     Bytes.fromInt
+                                     (Bytes.toInt (Type.bytes paddedComponentTy)
+                                      - 1 - Bytes.toInt shift))
+                           in
+                              ignore
+                              (Vector.fold
+                               (components, Bits.zero,
+                                fn ({index, rep}, shift) =>
+                                let
+                                   val repTy = Rep.ty rep
+                                   val unpack = Unpack.T {shift = shift,
+                                                          ty = repTy}
+                                   val iu =
+                                      if (Bits.isByteAligned shift
+                                          andalso (Bits.equals
+                                                   (Type.width repTy,
+                                                    Bits.inByte)))
+                                         then
+                                            Select.Indirect
+                                            {offset = (getByteOffset
+                                                       (Bits.toBytes shift)),
+                                             ty = repTy}
+                                      else (Select.IndirectUnpack
+                                            {offset = offset,
+                                             rest = unpack,
+                                             ty = paddedComponentTy})
+                                   val () =
+                                      Array.update (selects, index,
+                                                    (Select.Unpack unpack, iu))
+                                in
+                                   Bits.+ (shift, Rep.width rep)
+                                end))
+                           end
+                        val component =
+                           Component.Word
+                           (WordRep.T {components = components,
+                                       rep = Rep.T {rep = Rep.NonPointer,
+                                                    ty = componentTy}})
+                        val ac = {component = component,
+                                  offset = offset,
+                                  setSelects = setSelects} :: ac
+                     in
+                        makeWords (max, Words.+ (offset, Words.one), ac)
+                     end
+            val (offset, components) =
+               makeWords (Bits.toInt Bits.inWord - 1, offset, components)
+            val (_, components) =
+               simple (!pointers, Words.inPointer, offset, components)
+            val components = Vector.fromListRev components
+            val padToPrim = isVector andalso 1 = Vector.length components
+            val () =
+               Vector.foreach
+               (components, fn {setSelects, ...} => setSelects padToPrim)
+            fun getSelects s =
+               Selects.T (Vector.tabulate
+                          (Array.length selects, fn i =>
+                           {orig = #ty (Vector.sub (rs, i)),
+                            select = s (Array.sub (selects, i))}))
+            fun box () =
+               let
+                  val components =
+                     Vector.map
+                     (components, fn {component = c, offset, ...} =>
+                      let
+                         val c =
+                            if padToPrim
+                               then Component.padToPrim c
+                            else Component.maybePadToWidth (c, Bits.inWord)
+                      in
+                         {component = c,
+                          offset = offset}
+                      end)
+               in
+                  Indirect (PointerRep.make {components = components,
+                                             isVector = isVector,
+                                             selects = getSelects #2,
+                                             tycon = pointerTycon})
+               end
+         in
+            if forceBox orelse Vector.exists (rs, #isMutable)
+               then box ()
+            else
+               case Vector.length components of
+                  0 => unit
+                | 1 =>
+                     Direct {component = #component (Vector.sub (components, 0)),
+                             selects = getSelects #1}
+                | _ => box ()
+         end
 
       val make =
-	 Trace.trace3
-	 ("TupleRep.make",
-	  PointerTycon.layout,
-	  Vector.layout (fn {isMutable, rep, ty} =>
-			 Layout.record [("isMutable", Bool.layout isMutable),
-					("rep", Rep.layout rep),
-					("ty", S.Type.layout ty)]),
-	  fn {forceBox, isVector} =>
-	  Layout.record [("forceBox", Bool.layout forceBox),
-			 ("isVector", Bool.layout isVector)],
+         Trace.trace3
+         ("PackedRepresentation.TupleRep.make",
+          PointerTycon.layout,
+          Vector.layout (fn {isMutable, rep, ty} =>
+                         Layout.record [("isMutable", Bool.layout isMutable),
+                                        ("rep", Rep.layout rep),
+                                        ("ty", S.Type.layout ty)]),
+          fn {forceBox, isVector} =>
+          Layout.record [("forceBox", Bool.layout forceBox),
+                         ("isVector", Bool.layout isVector)],
 
-	  layout)
-	 make
+          layout)
+         make
    end
 
-structure List =
-   struct
-      open List
-
-      val splitAt: 'a t * int -> 'a t * 'a t =
-	 fn (l, i) =>
-	 let
-	    fun loop (i, ac, l) =
-	       if i = 0
-		  then (rev ac, l)
-	       else
-		  case l of
-		     [] => Error.bug "List.splitAt"
-		   | x :: l => loop (i - 1, x :: ac, l)
-	 in
-	    loop (i, [], l)
-	 end
-   end
-
 fun tagShift (tagBits: Bits.t): Operand.t =
    Operand.word (WordX.fromIntInf (Bits.toIntInf tagBits, WordSize.default))
 
 structure ConRep =
    struct
       datatype t =
-	 ShiftAndTag of {component: Component.t,
-			 selects: Selects.t,
-			 tag: WordX.t,
-			 ty: Type.t (* alread padded to prim *)}
+         ShiftAndTag of {component: Component.t,
+                         selects: Selects.t,
+                         tag: WordX.t,
+                         ty: Type.t (* alread padded to prim *)}
        | Tag of {tag: WordX.t,
-		 ty: Type.t}
+                 ty: Type.t}
        | Tuple of TupleRep.t
 
       val layout =
-	 let
-	    open Layout
-	 in
-	    fn ShiftAndTag {component, selects, tag, ty} =>
-		  seq [str "ShiftAndTag ",
-		       record [("component", Component.layout component),
-			       ("selects", Selects.layout selects),
-			       ("tag", WordX.layout tag),
-			       ("ty", Type.layout ty)]]
-	     | Tag {tag, ...} => seq [str "Tag ", WordX.layout tag]
-	     | Tuple tr => TupleRep.layout tr
-	 end
+         let
+            open Layout
+         in
+            fn ShiftAndTag {component, selects, tag, ty} =>
+                  seq [str "ShiftAndTag ",
+                       record [("component", Component.layout component),
+                               ("selects", Selects.layout selects),
+                               ("tag", WordX.layout tag),
+                               ("ty", Type.layout ty)]]
+             | Tag {tag, ...} => seq [str "Tag ", WordX.layout tag]
+             | Tuple tr => TupleRep.layout tr
+         end
 
       val equals: t * t -> bool =
-	 fn (ShiftAndTag {component = c1, tag = t1, ...},
-	     ShiftAndTag {component = c2, tag = t2, ...}) =>
-	      Component.equals (c1, c2) andalso WordX.equals (t1, t2)
-	  | (Tag {tag = t1, ty = ty1}, Tag {tag = t2, ty = ty2}) =>
-	       WordX.equals (t1, t2) andalso Type.equals (ty1, ty2)
-	  | (Tuple tr1, Tuple tr2) => TupleRep.equals (tr1, tr2)
-	  | _ => false
+         fn (ShiftAndTag {component = c1, tag = t1, ...},
+             ShiftAndTag {component = c2, tag = t2, ...}) =>
+              Component.equals (c1, c2) andalso WordX.equals (t1, t2)
+          | (Tag {tag = t1, ty = ty1}, Tag {tag = t2, ty = ty2}) =>
+               WordX.equals (t1, t2) andalso Type.equals (ty1, ty2)
+          | (Tuple tr1, Tuple tr2) => TupleRep.equals (tr1, tr2)
+          | _ => false
 
       val rep: t -> Rep.t =
-	 fn ShiftAndTag {ty, ...} => Rep.nonPointer ty
-	  | Tag {ty, ...} => Rep.nonPointer ty
-	  | Tuple tr => TupleRep.rep tr
+         fn ShiftAndTag {ty, ...} => Rep.nonPointer ty
+          | Tag {ty, ...} => Rep.nonPointer ty
+          | Tuple tr => TupleRep.rep tr
 
       val box = Tuple o TupleRep.Indirect
 
       local
-	 fun make i = 
-	    let
-	       val tag = WordX.fromIntInf (i, WordSize.default)
-	    in
-	       Tag {tag = tag, ty = Type.constant tag}
-	    end
+         fun make i = 
+            let
+               val tag = WordX.fromIntInf (i, WordSize.default)
+            in
+               Tag {tag = tag, ty = Type.constant tag}
+            end
       in
-	 val falsee = make 0
-	 val truee = make 1
+         val falsee = make 0
+         val truee = make 1
       end
 
       val unit = Tuple TupleRep.unit
-	       
+               
       fun conApp (r: t, {dst: Var.t * Type.t,
-			 src: {index: int} -> Operand.t}): Statement.t list =
-	 case r of
-	    ShiftAndTag {component, tag, ...} =>
-	       let
-		  val (dstVar, dstTy) = dst
-		  val shift = tagShift (WordSize.bits (WordX.size tag))
-		  val tmpVar = Var.newNoname ()
-		  val tmpTy =
-		     Type.padToWidth (Component.ty component, Type.width dstTy)
-		  val tmp = Var {ty = tmpTy, var = tmpVar}
-		  val component =
-		     Component.tuple (component, {dst = (tmpVar, tmpTy),
-						  src = src})
+                         src: {index: int} -> Operand.t}): Statement.t list =
+         case r of
+            ShiftAndTag {component, tag, ...} =>
+               let
+                  val (dstVar, dstTy) = dst
+                  val shift = tagShift (WordSize.bits (WordX.size tag))
+                  val tmpVar = Var.newNoname ()
+                  val tmpTy =
+                     Type.padToWidth (Component.ty component, Type.width dstTy)
+                  val tmp = Var {ty = tmpTy, var = tmpVar}
+                  val component =
+                     Component.tuple (component, {dst = (tmpVar, tmpTy),
+                                                  src = src})
 
-		  val (s1, tmp) = Statement.lshift (tmp, shift)
-		  val (s2, tmp) =
-		     Statement.orb
-		     (tmp,
-		      Operand.word
-		      (WordX.resize
-		       (tag, WordSize.fromBits (Type.width (Operand.ty tmp)))))
-		  val s3 = Bind {dst = (dstVar, dstTy),
-				 isMutable = false,
-				 src = tmp}
-	       in
-		  component @ [s1, s2, s3]
-	       end
-	  | Tag {tag, ...} =>
-	       let
-		  val (dstVar, dstTy) = dst
-	       in
-		  [Bind {dst = (dstVar, dstTy),
-			 isMutable = false,
-			 src = (Operand.word
-				(WordX.resize
-				 (tag, WordSize.fromBits (Type.width dstTy))))}]
-	       end
-	  | Tuple tr => TupleRep.tuple (tr, {dst = dst, src = src})
+                  val (s1, tmp) = Statement.lshift (tmp, shift)
+                  val (s2, tmp) =
+                     Statement.orb
+                     (tmp,
+                      Operand.word
+                      (WordX.resize
+                       (tag, WordSize.fromBits (Type.width (Operand.ty tmp)))))
+                  val s3 = Bind {dst = (dstVar, dstTy),
+                                 isMutable = false,
+                                 src = tmp}
+               in
+                  component @ [s1, s2, s3]
+               end
+          | Tag {tag, ...} =>
+               let
+                  val (dstVar, dstTy) = dst
+               in
+                  [Bind {dst = (dstVar, dstTy),
+                         isMutable = false,
+                         src = (Operand.word
+                                (WordX.resize
+                                 (tag, WordSize.fromBits (Type.width dstTy))))}]
+               end
+          | Tuple tr => TupleRep.tuple (tr, {dst = dst, src = src})
 
       val conApp =
-	 Trace.trace ("ConRep.conApp", layout o #1, List.layout Statement.layout)
-	 conApp
+         Trace.trace 
+         ("PackedRepresentation.ConRep.conApp", 
+          layout o #1, List.layout Statement.layout)
+         conApp
    end
 
 structure Block =
    struct
       open Block
-	 
+         
       val extra: t list ref = ref []
 
       fun getExtra () = !extra before extra := []
 
       fun new {statements: Statement.t vector,
-	       transfer: Transfer.t}: Label.t =
-	 let
-	    val l = Label.newNoname ()
-	    val _ = List.push (extra,
-			       Block.T {args = Vector.new0 (),
-					kind = Kind.Jump,
-					label = l,
-					statements = statements,
-					transfer = transfer})
-	 in
-	    l
-	 end
+               transfer: Transfer.t}: Label.t =
+         let
+            val l = Label.newNoname ()
+            val _ = List.push (extra,
+                               Block.T {args = Vector.new0 (),
+                                        kind = Kind.Jump,
+                                        label = l,
+                                        statements = statements,
+                                        transfer = transfer})
+         in
+            l
+         end
    end
 
 structure Cases =
@@ -1305,830 +1303,841 @@
       type t = {con: Con.t, dst: Label.t, dstHasArg: bool} vector
 
       fun layout (v: t): Layout.t =
-	 Vector.layout
-	 (fn {con, dst, dstHasArg} =>
-	  Layout.record [("con", Con.layout con),
-			 ("dst", Label.layout dst),
-			 ("dstHasArg", Bool.layout dstHasArg)])
-	 v
+         Vector.layout
+         (fn {con, dst, dstHasArg} =>
+          Layout.record [("con", Con.layout con),
+                         ("dst", Label.layout dst),
+                         ("dstHasArg", Bool.layout dstHasArg)])
+         v
    end
 
 structure Pointers =
    struct
       (* 1 < Vector.length variants *)
       datatype t = T of {headerTy: unit -> Type.t,
-			 rep: Rep.t,
-			 variants: {con: Con.t,
-				    pointer: PointerRep.t} vector}
+                         rep: Rep.t,
+                         variants: {con: Con.t,
+                                    pointer: PointerRep.t} vector}
 
       fun layout (T {rep, variants, ...}) =
-	 let
-	    open Layout
-	 in
-	    record [("rep", Rep.layout rep),
-		    ("variants",
-		     Vector.layout
-		     (fn {con, pointer} =>
-		      record [("con", Con.layout con),
-			      ("pointer", PointerRep.layout pointer)])
-		     variants)]
-	 end
+         let
+            open Layout
+         in
+            record [("rep", Rep.layout rep),
+                    ("variants",
+                     Vector.layout
+                     (fn {con, pointer} =>
+                      record [("con", Con.layout con),
+                              ("pointer", PointerRep.layout pointer)])
+                     variants)]
+         end
 
       local
-	 fun make f (T r) = f r
+         fun make f (T r) = f r
       in
-	 val rep = make #rep
+         val rep = make #rep
       end
 
       val ty = Rep.ty o rep
 
       fun make {rep, variants}: t =
-	 let
-	    (* headerTy must be delayed since the pointer tycon indices have not
-	     * yet been determined.
-	     *)
-	    val headerTy =
-	       Promise.lazy 
-	       (fn () =>
-		Type.sum (Vector.map
-			  (variants, fn {pointer, ...} =>
-			   Type.pointerHeader (PointerRep.tycon pointer))))
-	 in
-	    T {headerTy = headerTy,
-	       rep = rep,
-	       variants = variants}
-	 end
+         let
+            (* headerTy must be delayed since the pointer tycon indices have not
+             * yet been determined.
+             *)
+            val headerTy =
+               Promise.lazy 
+               (fn () =>
+                Type.sum (Vector.map
+                          (variants, fn {pointer, ...} =>
+                           Type.pointerHeader (PointerRep.tycon pointer))))
+         in
+            T {headerTy = headerTy,
+               rep = rep,
+               variants = variants}
+         end
 
       fun genCase (T {headerTy, variants, ...},
-		   {cases: Cases.t,
-		    conRep: Con.t -> ConRep.t,
-		    default: Label.t option,
-		    test: Operand.t})
-	 : Statement.t list * Transfer.t =
-	 let
-	    val wordSize = WordSize.pointer ()
-	    val cases =
-	       Vector.keepAllMap
-	       (cases, fn {con, dst, dstHasArg} =>
-		case conRep con of
-		   ConRep.Tuple (TupleRep.Indirect
-				 (PointerRep.T {ty, tycon, ...})) =>
-		      SOME (WordX.fromIntInf (Int.toIntInf
-					      (PointerTycon.index tycon),
-					      wordSize),
-			    Block.new
-			    {statements = Vector.new0 (),
-			     transfer =
-			     Goto {args = if dstHasArg
-					     then (Vector.new1
-						   (Operand.cast (test, ty)))
-					  else Vector.new0 (),
-				   dst = dst}})
-		 | _ => NONE)
-	    val default =
-	       if Vector.length variants = Vector.length cases
-		  then NONE
-	       else default
-	    val cases =
-	       QuickSort.sortVector (cases, fn ((w, _), (w', _)) =>
-				     WordX.le (w, w', {signed = false}))
-	    val headerTy = headerTy ()
-	    val (s, tag) =
-	       Statement.rshift (Offset {base = test,
-					 offset = Runtime.headerOffset,
-					 ty = headerTy},
-				 Operand.word (WordX.one wordSize))
-	 in
-	    ([s], Switch (Switch.T {cases = cases,
-				    default = default,
-				    size = wordSize,
-				    test = tag}))
-	 end
+                   {cases: Cases.t,
+                    conRep: Con.t -> ConRep.t,
+                    default: Label.t option,
+                    test: Operand.t})
+         : Statement.t list * Transfer.t =
+         let
+            val wordSize = WordSize.pointer ()
+            val cases =
+               Vector.keepAllMap
+               (cases, fn {con, dst, dstHasArg} =>
+                case conRep con of
+                   ConRep.Tuple (TupleRep.Indirect
+                                 (PointerRep.T {ty, tycon, ...})) =>
+                      SOME (WordX.fromIntInf (Int.toIntInf
+                                              (PointerTycon.index tycon),
+                                              wordSize),
+                            Block.new
+                            {statements = Vector.new0 (),
+                             transfer =
+                             Goto {args = if dstHasArg
+                                             then (Vector.new1
+                                                   (Operand.cast (test, ty)))
+                                          else Vector.new0 (),
+                                   dst = dst}})
+                 | _ => NONE)
+            val default =
+               if Vector.length variants = Vector.length cases
+                  then NONE
+               else default
+            val cases =
+               QuickSort.sortVector (cases, fn ((w, _), (w', _)) =>
+                                     WordX.le (w, w', {signed = false}))
+            val headerTy = headerTy ()
+            val (s, tag) =
+               Statement.rshift (Offset {base = test,
+                                         offset = Runtime.headerOffset,
+                                         ty = headerTy},
+                                 Operand.word (WordX.one wordSize))
+         in
+            ([s], Switch (Switch.T {cases = cases,
+                                    default = default,
+                                    size = wordSize,
+                                    test = tag}))
+         end
    end
 
 structure Small =
    struct
       datatype t = T of {isEnum: bool,
-			 rep: Rep.t,
-			 tagBits: Bits.t,
-			 variants: Con.t vector}
+                         rep: Rep.t,
+                         tagBits: Bits.t,
+                         variants: Con.t vector}
 
       fun layout (T {isEnum, rep, tagBits, variants}) =
-	 let
-	    open Layout
-	 in
-	    record [("isEnum", Bool.layout isEnum),
-		    ("rep", Rep.layout rep),
-		    ("tagBits", Bits.layout tagBits),
-		    ("variants", Vector.layout Con.layout variants)]
-	 end
+         let
+            open Layout
+         in
+            record [("isEnum", Bool.layout isEnum),
+                    ("rep", Rep.layout rep),
+                    ("tagBits", Bits.layout tagBits),
+                    ("variants", Vector.layout Con.layout variants)]
+         end
 
       local
-	 fun make f (T r) = f r
+         fun make f (T r) = f r
       in
-	 val rep = make #rep
+         val rep = make #rep
       end
 
       val bool =
-	 T {isEnum = true,
-	    rep = Rep.bool,
-	    tagBits = Bits.fromInt 1,
-	    variants = Vector.new2 (Con.falsee, Con.truee)}
+         T {isEnum = true,
+            rep = Rep.bool,
+            tagBits = Bits.fromInt 1,
+            variants = Vector.new2 (Con.falsee, Con.truee)}
 
       fun genCase (T {isEnum, tagBits, variants, ...},
-		   {cases: Cases.t,
-		    conRep: Con.t -> ConRep.t,
-		    isPointer: bool,
-		    notSmall: Label.t option,
-		    smallDefault: Label.t option,
-		    test: Operand.t})
-	 : Statement.t list * Transfer.t =
-	 let
-	    val testBits = Type.width (Operand.ty test)
-	    val wordSize = WordSize.fromBits testBits
-	    val cases =
-	       Vector.keepAllMap
-	       (cases, fn {con, dst, dstHasArg} =>
-		case conRep con of
-		   ConRep.ShiftAndTag {tag, ty, ...} =>
-		      let
-			 val test =
-			    Operand.cast (test, Type.padToWidth (ty, testBits))
-			 val (test, ss) = Statement.resize (test, Type.width ty)
-			 val transfer =
-			    Goto {args = if dstHasArg
-					    then Vector.new1 test
-					 else Vector.new0 (),
-				  dst = dst}
-		      in
-			 SOME (WordX.resize (tag, wordSize),
-			       Block.new {statements = Vector.fromList ss,
-					  transfer = transfer})
-		      end
-		 | ConRep.Tag {tag, ...} =>
-		      SOME (WordX.resize (tag, wordSize), dst)
-		 | _ => NONE)
-	    val cases = QuickSort.sortVector (cases, fn ((w, _), (w', _)) =>
-					      WordX.le (w, w', {signed = false}))
-	    val (tagOp, ss) =
-	       if isEnum
-		  then (test, [])
-	       else
-		  let
-		     val (s, tag) =
-			Statement.andb
-			(test,
-			 Operand.word (WordX.resize
-				       (WordX.max (WordSize.fromBits tagBits,
-						   {signed = false}),
-					wordSize)))
-		  in
-		     (tag, [s])
-		  end
-	    val tagOp =
-	       if isPointer
-		  then Operand.cast (tagOp, Type.word (WordSize.bits wordSize))
-	       else tagOp
-	    val default =
-	       if Vector.length variants = Vector.length cases
-		  then notSmall
-	       else
-		  case (notSmall, smallDefault) of
-		     (NONE, _) => smallDefault
-		   | (_, NONE) => notSmall
-		   | (SOME notSmall, SOME smallDefault) =>
-			let
-			   val (s, test) =
-			      Statement.andb
-			      (Operand.cast (test, Type.word testBits),
-			       Operand.word (WordX.fromIntInf (3, wordSize)))
-			   val t =
-			      Switch
-			      (Switch.T
-			       {cases = Vector.new1 (WordX.zero wordSize,
-						     notSmall),
-				default = SOME smallDefault,
-				size = wordSize,
-				test = test})
-			in
-			   SOME (Block.new {statements = Vector.new1 s,
-					    transfer = t})
-			end
-	    val transfer =
-	       Switch (Switch.T {cases = cases,
-				 default = default,
-				 size = wordSize,
-				 test = tagOp})
-	 in
-	    (ss, transfer)
-	 end
+                   {cases: Cases.t,
+                    conRep: Con.t -> ConRep.t,
+                    isPointer: bool,
+                    notSmall: Label.t option,
+                    smallDefault: Label.t option,
+                    test: Operand.t})
+         : Statement.t list * Transfer.t =
+         let
+            val testBits = Type.width (Operand.ty test)
+            val wordSize = WordSize.fromBits testBits
+            val cases =
+               Vector.keepAllMap
+               (cases, fn {con, dst, dstHasArg} =>
+                case conRep con of
+                   ConRep.ShiftAndTag {tag, ty, ...} =>
+                      let
+                         val test =
+                            Operand.cast (test, Type.padToWidth (ty, testBits))
+                         val (test, ss) = Statement.resize (test, Type.width ty)
+                         val transfer =
+                            Goto {args = if dstHasArg
+                                            then Vector.new1 test
+                                         else Vector.new0 (),
+                                  dst = dst}
+                      in
+                         SOME (WordX.resize (tag, wordSize),
+                               Block.new {statements = Vector.fromList ss,
+                                          transfer = transfer})
+                      end
+                 | ConRep.Tag {tag, ...} =>
+                      let
+                         val transfer =
+                            Goto {args = if dstHasArg
+                                            then Vector.new1 test
+                                            else Vector.new0 (),
+                                  dst = dst}
+                      in
+                         SOME (WordX.resize (tag, wordSize), 
+                               Block.new {statements = Vector.new0 (),
+                                          transfer = transfer})
+                      end
+                 | _ => NONE)
+            val cases = QuickSort.sortVector (cases, fn ((w, _), (w', _)) =>
+                                              WordX.le (w, w', {signed = false}))
+            val (tagOp, ss) =
+               if isEnum
+                  then (test, [])
+               else
+                  let
+                     val (s, tag) =
+                        Statement.andb
+                        (test,
+                         Operand.word (WordX.resize
+                                       (WordX.max (WordSize.fromBits tagBits,
+                                                   {signed = false}),
+                                        wordSize)))
+                  in
+                     (tag, [s])
+                  end
+            val tagOp =
+               if isPointer
+                  then Operand.cast (tagOp, Type.word (WordSize.bits wordSize))
+               else tagOp
+            val default =
+               if Vector.length variants = Vector.length cases
+                  then notSmall
+               else
+                  case (notSmall, smallDefault) of
+                     (NONE, _) => smallDefault
+                   | (_, NONE) => notSmall
+                   | (SOME notSmall, SOME smallDefault) =>
+                        let
+                           val (s, test) =
+                              Statement.andb
+                              (Operand.cast (test, Type.word testBits),
+                               Operand.word (WordX.fromIntInf (3, wordSize)))
+                           val t =
+                              Switch
+                              (Switch.T
+                               {cases = Vector.new1 (WordX.zero wordSize,
+                                                     notSmall),
+                                default = SOME smallDefault,
+                                size = wordSize,
+                                test = test})
+                        in
+                           SOME (Block.new {statements = Vector.new1 s,
+                                            transfer = t})
+                        end
+            val transfer =
+               Switch (Switch.T {cases = cases,
+                                 default = default,
+                                 size = wordSize,
+                                 test = tagOp})
+         in
+            (ss, transfer)
+         end
 
       val genCase =
-	 Trace.trace
-	 ("Small.genCase",
-	  fn (s, {test, ...}) =>
-	  Layout.tuple [layout s,
-			Layout.record [("test", Operand.layout test)]],
-	  Layout.tuple2 (List.layout Statement.layout, Transfer.layout))
-	 genCase
+         Trace.trace
+         ("PackedRepresentation.Small.genCase",
+          fn (s, {test, ...}) =>
+          Layout.tuple [layout s,
+                        Layout.record [("test", Operand.layout test)]],
+          Layout.tuple2 (List.layout Statement.layout, Transfer.layout))
+         genCase
    end
 
 structure TyconRep =
    struct
       datatype t =
-	 One of {con: Con.t,
-		 tupleRep: TupleRep.t}
+         One of {con: Con.t,
+                 tupleRep: TupleRep.t}
        | Pointers of Pointers.t
        | Small of Small.t
        | SmallAndBox of {box: {con: Con.t,
-			       pointer: PointerRep.t},
-			 rep: Rep.t,
-			 small: Small.t}
+                               pointer: PointerRep.t},
+                         rep: Rep.t,
+                         small: Small.t}
        | SmallAndPointer of {pointer: {component: Component.t,
-				       con: Con.t},
-			     rep: Rep.t,
-			     small: Small.t}
+                                       con: Con.t},
+                             rep: Rep.t,
+                             small: Small.t}
        | SmallAndPointers of {pointers: Pointers.t,
-			      rep: Rep.t,
-			      small: Small.t}
+                              rep: Rep.t,
+                              small: Small.t}
        | Unit
 
       fun layout (r: t): Layout.t =
-	 let
-	    open Layout
-	 in
-	    case r of
-	       One {con, tupleRep} =>
-		  seq [str "One ",
-		       record [("con", Con.layout con),
-			       ("tupleRep", TupleRep.layout tupleRep)]]
-	     | Pointers ps =>
-		  seq [str "Pointers ", Pointers.layout ps]
-	     | Small s =>
-		  seq [str "Small ", Small.layout s]
-	     | SmallAndBox {box = {con, pointer}, rep, small} =>
-		  seq [str "SmallAndBox ",
-		       record [("box",
-				record [("con", Con.layout con),
-					("pointer", PointerRep.layout pointer)]),
-			       ("rep", Rep.layout rep),
-			       ("small", Small.layout small)]]
-	     | SmallAndPointer {pointer = {component, con}, rep, small} =>
-		  seq [str "SmallAndPointer ",
-		       record
-		       [("pointer",
-			 record [("component", Component.layout component),
-				 ("con", Con.layout con)]),
-			("rep", Rep.layout rep),
-			("small", Small.layout small)]]
-	     | SmallAndPointers {pointers, rep, small} =>
-		  seq [str "SmallAndPointers ",
-		       record [("pointers", Pointers.layout pointers),
-			       ("rep", Rep.layout rep),
-			       ("small", Small.layout small)]]
-	     | Unit => str "Unit"
-	 end
+         let
+            open Layout
+         in
+            case r of
+               One {con, tupleRep} =>
+                  seq [str "One ",
+                       record [("con", Con.layout con),
+                               ("tupleRep", TupleRep.layout tupleRep)]]
+             | Pointers ps =>
+                  seq [str "Pointers ", Pointers.layout ps]
+             | Small s =>
+                  seq [str "Small ", Small.layout s]
+             | SmallAndBox {box = {con, pointer}, rep, small} =>
+                  seq [str "SmallAndBox ",
+                       record [("box",
+                                record [("con", Con.layout con),
+                                        ("pointer", PointerRep.layout pointer)]),
+                               ("rep", Rep.layout rep),
+                               ("small", Small.layout small)]]
+             | SmallAndPointer {pointer = {component, con}, rep, small} =>
+                  seq [str "SmallAndPointer ",
+                       record
+                       [("pointer",
+                         record [("component", Component.layout component),
+                                 ("con", Con.layout con)]),
+                        ("rep", Rep.layout rep),
+                        ("small", Small.layout small)]]
+             | SmallAndPointers {pointers, rep, small} =>
+                  seq [str "SmallAndPointers ",
+                       record [("pointers", Pointers.layout pointers),
+                               ("rep", Rep.layout rep),
+                               ("small", Small.layout small)]]
+             | Unit => str "Unit"
+         end
 
       val bool = Small Small.bool
 
       val unit = Unit
 
       val rep: t -> Rep.t =
-	 fn One {tupleRep, ...} => TupleRep.rep tupleRep
-	  | Pointers p => Pointers.rep p
-	  | Small s => Small.rep s
-	  | SmallAndBox {rep, ...} => rep
-	  | SmallAndPointer {rep, ...} => rep
-	  | SmallAndPointers {rep, ...} => rep
-	  | Unit => Rep.unit
+         fn One {tupleRep, ...} => TupleRep.rep tupleRep
+          | Pointers p => Pointers.rep p
+          | Small s => Small.rep s
+          | SmallAndBox {rep, ...} => rep
+          | SmallAndPointer {rep, ...} => rep
+          | SmallAndPointers {rep, ...} => rep
+          | Unit => Rep.unit
 
       fun equals (r, r') = Rep.equals (rep r, rep r')
 
       val wordBits = Bits.toInt Bits.inWord
-	 
+         
       local
-	 val aWithout = Array.tabulate (wordBits + 1, fn i => IntInf.pow (2, i))
-	 (* If there is a pointer, then multiply the number of tags by 3/4 to
-	  * remove all the tags that have 00 as their low bits.
-	  *)
-	 val aWith = Array.tabulate (wordBits + 1, fn i =>
-				     (Array.sub (aWithout, i) * 3) div 4)
+         val aWithout = Array.tabulate (wordBits + 1, fn i => IntInf.pow (2, i))
+         (* If there is a pointer, then multiply the number of tags by 3/4 to
+          * remove all the tags that have 00 as their low bits.
+          *)
+         val aWith = Array.tabulate (wordBits + 1, fn i =>
+                                     (Array.sub (aWithout, i) * 3) div 4)
       in
-	 fun numTagsAvailable {tagBits: int, withPointer: bool} =
-	    let
-	       val a = if withPointer then aWith else aWithout
-	    in
-	       Array.sub (a, tagBits)
-	    end
+         fun numTagsAvailable {tagBits: int, withPointer: bool} =
+            let
+               val a = if withPointer then aWith else aWithout
+            in
+               Array.sub (a, tagBits)
+            end
 
-	 val numTagsAvailable =
-	    Trace.trace
-	    ("numTagsAvailable",
-	     fn {tagBits, withPointer} =>
-	     Layout.record [("tagBits", Int.layout tagBits),
-			    ("withPointer", Bool.layout withPointer)],
-	     IntInf.layout)
-	    numTagsAvailable
+         val numTagsAvailable =
+            Trace.trace
+            ("PackedRepresentation.TyconRep.numTagsAvailable",
+             fn {tagBits, withPointer} =>
+             Layout.record [("tagBits", Int.layout tagBits),
+                            ("withPointer", Bool.layout withPointer)],
+             IntInf.layout)
+            numTagsAvailable
 
-	 fun tagBitsNeeded {numVariants: int, withPointer: bool}: Bits.t =
-	    let
-	       val numVariants = Int.toIntInf numVariants
-	       val a = if withPointer then aWith else aWithout
-	    in
-	       case (BinarySearch.smallest
-		     (a, fn numTags => numVariants <= numTags)) of
-		  NONE => Error.bug "tagBitsNeeded"
-		| SOME i => Bits.fromInt i
-	    end
-	 
-	 val tagBitsNeeded =
-	    Trace.trace ("tagBitsNeeded",
-			 fn {numVariants, withPointer} =>
-			 Layout.record [("numVariants", Int.layout numVariants),
-					("withPointer", Bool.layout withPointer)],
-			 Bits.layout)
-	    tagBitsNeeded
+         fun tagBitsNeeded {numVariants: int, withPointer: bool}: Bits.t =
+            let
+               val numVariants = Int.toIntInf numVariants
+               val a = if withPointer then aWith else aWithout
+            in
+               case (BinarySearch.smallest
+                     (a, fn numTags => numVariants <= numTags)) of
+                  NONE => Error.bug "PackedRepresentation.TyconRep.tagBitsNeeded"
+                | SOME i => Bits.fromInt i
+            end
+         
+         val tagBitsNeeded =
+            Trace.trace 
+            ("PackedRepresentation.TyconRep.tagBitsNeeded",
+             fn {numVariants, withPointer} =>
+             Layout.record [("numVariants", Int.layout numVariants),
+                            ("withPointer", Bool.layout withPointer)],
+             Bits.layout)
+            tagBitsNeeded
       end
 
       fun make (variants: {args: {isMutable: bool,
-				  rep: Rep.t,
-				  ty: S.Type.t} vector,
-			   con: Con.t,
-			   pointerTycon: PointerTycon.t} vector)
-	 : t * {con: Con.t, rep: ConRep.t} vector =
-	 if 0 = Vector.length variants
-	    then (Unit, Vector.new0 ())
-	 else if 1 = Vector.length variants
-	    then
-	       let
-		  val {args, con, pointerTycon} = Vector.sub (variants, 0)
-		  val tupleRep =
-		     TupleRep.make (pointerTycon, args,
-				    {forceBox = false,
-				     isVector = false})
-		  val conRep = ConRep.Tuple tupleRep
-	       in
-		  (One {con = con, tupleRep = tupleRep},
-		   Vector.new1 {con = con, rep = conRep})
-	       end
-	 else if (2 = Vector.length variants
-		  andalso let
-			     val c = #con (Vector.sub (variants, 0))
-			  in
-			     Con.equals (c, Con.falsee)
-			     orelse Con.equals (c, Con.truee)
-			  end)
-	    then (bool, Vector.new2 ({con = Con.falsee, rep = ConRep.falsee},
-				     {con = Con.truee, rep = ConRep.truee}))
-	 else
-	 let
-	    val numSmall = ref 0
-	    val small = Array.array (wordBits, [])
-	    val big = ref []
-	    val () =
-	       Vector.foreach
-	       (variants, fn {args, con, pointerTycon} =>
-		let
-		   val tr =
-		      TupleRep.make (pointerTycon, args,
-				     {forceBox = false,
-				      isVector = false})
-		   fun makeBig () =
-		      List.push (big,
-				 {con = con,
-				  pointerTycon = pointerTycon,
-				  tupleRep = tr})
-		   val Rep.T {rep, ty} = TupleRep.rep tr
-		in
-		   case rep of
-		      Rep.NonPointer =>
-			 let
-			    val i = Bits.toInt (Type.width ty)
-			 in
-			    if i >= wordBits
-			       then makeBig ()
-		            else
-			       let
-				  val {component, selects} =
-				     case tr of
-					TupleRep.Direct z => z
-				      | TupleRep.Indirect _ =>
-					   Error.bug "small Indirect"
-				  val () = Int.inc numSmall
-				  val () =
-				     Array.update
-				     (small, i,
-				      {component = component,
-				       con = con,
-				       pointerTycon = pointerTycon,
-				       selects = selects}
-				      :: Array.sub (small, i))
-			       in
-				  ()
-			       end
-			 end
-		    | Rep.Pointer _ => makeBig ()
-		end)
-	    val big = !big
-	    val numSmall = !numSmall
-	    fun noLargerThan (i, ac) =
-	       if i < 0
-		  then ac
-	       else noLargerThan (i - 1,
-				  List.fold (Array.sub (small, i), ac, op ::))
-	    (* Box as few things as possible so that the number of tags available
-	     * is >= the number of unboxed variants.
-	     *)
-	    fun loop (maxSmallWidth: int,
-		      forced,
-		      withPointer: bool,
-		      numSmall: IntInf.t) =
-	       if 0 = numSmall
-		  then (maxSmallWidth, forced, [])
-	       else
-		  let
-		     val vs = Array.sub (small, maxSmallWidth)
-		  in
-		     if List.isEmpty vs
-			then loop (maxSmallWidth - 1, forced,
-				   withPointer, numSmall)
-		     else
-			let
-			   val numTags =
-			      numTagsAvailable
-			      {tagBits = wordBits - maxSmallWidth,
-			       withPointer = withPointer}
-			in
-			   if numSmall <= numTags
-			      then
-				 (* There are enough tag bits available. *)
-				 (maxSmallWidth,
-				  forced,
-				  noLargerThan (maxSmallWidth - 1, vs))
-			   else
-			      let
-				 val z = Int.toIntInf (List.length vs)
-				 val remaining = numSmall - z
-			      in
-				 if remaining <= numTags
-				    then
-				       let
-					  val (front, back) =
-					     List.splitAt
-					     (vs,
-					      IntInf.toInt
-					      (numSmall - numTags))
-				       in
-					  (maxSmallWidth,
-					   List.append (front, forced),
-					   noLargerThan (maxSmallWidth - 1,
-							 back))
-				       end
-				 else loop (maxSmallWidth - 1,
-					    vs @ forced,
-					    true,
-					    remaining)
-			      end
-			end
-		  end
-	    val (maxSmallWidth, forced, small) =
-	       loop (wordBits - 1, [],
-		     not (List.isEmpty big),
-		     Int.toIntInf numSmall)
-	    val maxSmallWidth = Bits.fromInt maxSmallWidth
-	    val withPointer = not (List.isEmpty big andalso List.isEmpty forced)
-	    (* ShiftAndTag all the small. *)
-	    val (small: Small.t option, smallReps) =
-	       let
-		  val numSmall = List.length small
-	       in
-		  if 0 = numSmall
-		     then (NONE, Vector.new0 ())
-		  else
-		     let
-			val tagBits =
-			   tagBitsNeeded {numVariants = numSmall,
-					  withPointer = withPointer}
-			val r = ref 0w0
-			fun getTag (): IntInf.t =
-			   let
-			      val w = !r
-			      val w =
-				 if withPointer andalso
-				    0w0 = Word.andb (w, 0w3)
-				    then w + 0w1
-				 else w
-			      val () = r := w + 0w1
-			   in
-			      Word.toIntInf w
-			   end
-			val small =
-			   Vector.fromListMap
-			   (small, fn {component, con, selects, ...} =>
-			    let
-			       val tag =
-				  WordX.fromIntInf (getTag (),
-						    WordSize.fromBits tagBits)
-			       val isUnit = Type.isUnit (Component.ty component)
-			       val component =
-				  Component.padToWidth (component,
-							maxSmallWidth)
-			       val selects = Selects.lshift (selects, tagBits)
-			       val ty =
-				  Type.seq
-				  (Vector.new2 (Type.constant tag,
-						Component.ty component))
-			       val ty =
-				  if withPointer
-				     then Type.resize (ty, Bits.inPointer)
-				  else Type.padToPrim ty
-			    in
-			       {component = component,
-				con = con,
-				isUnit = isUnit,
-				selects = selects,
-				tag = tag,
-				ty = ty}
-			    end)
-			val ty = Type.sum (Vector.map (small, #ty))
-			val rep = Rep.T {rep = Rep.NonPointer, ty = ty}
-			val reps =
-			   Vector.map
-			   (small, fn {component, con, isUnit, selects, tag, ty,
-				       ...} =>
-			    {con = con,
-			     rep = if isUnit
-				      then ConRep.Tag {tag = tag, ty = ty}
-				   else (ConRep.ShiftAndTag
-					 {component = component,
-					  selects = selects,
-					  tag = tag,
-					  ty = ty})})
-			val isEnum =
-			   Vector.forall
-			   (reps, fn {rep, ...} =>
-			    case rep of
-			       ConRep.Tag _ => true
-			     | _ => false)
-		     in
-			(SOME (Small.T {isEnum = isEnum,
-					rep = rep,
-					tagBits = tagBits,
-					variants = Vector.map (reps, #con)}),
-			 reps)
-		     end
-	       end
-	    fun makeSmallPointer {component, con, pointerTycon, selects} =
-	       {con = con,
-		pointer = (PointerRep.box
-			   (Component.padToWidth (component, Bits.inWord),
-			    pointerTycon, selects))}
-	    fun makeBigPointer {con, pointerTycon, tupleRep} =
-	       let
-		  val pr =
-		     case tupleRep of
-			TupleRep.Direct {component, selects} =>
-			   PointerRep.box (component, pointerTycon, selects)
-		      | TupleRep.Indirect p => p
-	       in
-		  {con = con, pointer = pr}
-	       end
-	    fun sumWithSmall (r: Rep.t): Rep.t =
-	       Rep.T {rep = Rep.Pointer {endsIn00 = false},
-		      ty = Type.sum (Vector.new2
-				     (Rep.ty r,
-				      Rep.ty (Small.rep (valOf small))))}
-	    fun box () =
-	       let
-		  val pointers =
-		     Vector.concat
-		     [Vector.fromListMap (forced, makeSmallPointer),
-		      Vector.fromListMap (big, makeBigPointer)]
-		  val sumRep =
-		     if 1 = Vector.length pointers
-			then
-			   let
-			      val pointer = Vector.sub (pointers, 0)
-			      val small = valOf small
-			      val rep =
-				 sumWithSmall (PointerRep.rep (#pointer pointer))
-			   in
-			      SmallAndBox {box = pointer,
-					   rep = rep,
-					   small = small}
-			   end
-		     else
-			let
-			   val ty =
-			      Type.sum
-			      (Vector.map (pointers, PointerRep.ty o #pointer))
-			   val ps =
-			      Pointers.make
-			      {rep = Rep.T {rep = Rep.Pointer {endsIn00 = true},
-					    ty = ty},
-			       variants = pointers}
-			in
-			   case small of
-			      NONE => Pointers ps
-			    | SOME small =>
-				 SmallAndPointers
-				 {pointers = ps,
-				  rep = sumWithSmall (Pointers.rep ps),
-				  small = small}
-			end
-	       in
-		  (sumRep,
-		   Vector.map (pointers, fn {con, pointer} =>
-			       {con = con,
-				rep = ConRep.box pointer}))
-	       end
-	    val (sumRep, pointerReps) =
-	       case (forced, big) of
-		  ([], []) => (Small (valOf small), Vector.new0 ())
-		| ([], [{con, tupleRep, ...}]) =>
-		     (* If there is only one big and it is a pointer that
-		      * ends in 00, then there is no need to box it.
-		      *)
-		     (case tupleRep of
-			 TupleRep.Direct {component, ...} =>
-			    let
-			       val rep = TupleRep.rep tupleRep
-			    in
-			       if Rep.isPointerEndingIn00 rep
-				  then
-				     let
-					val small = valOf small
-				     in
-					(SmallAndPointer
-					 {pointer = {component = component,
-						     con = con},
-					  rep = sumWithSmall rep,
-					  small = small},
-					 Vector.new1
-					 {con = con,
-					  rep = ConRep.Tuple tupleRep})
-				     end
-			       else box ()
-			    end
-		       | _ => box ())
-		| _ => box ()
-	 in
-	    (sumRep, Vector.concat [smallReps, pointerReps])
-	 end
+                                  rep: Rep.t,
+                                  ty: S.Type.t} vector,
+                           con: Con.t,
+                           pointerTycon: PointerTycon.t} vector)
+         : t * {con: Con.t, rep: ConRep.t} vector =
+         if 0 = Vector.length variants
+            then (Unit, Vector.new0 ())
+         else if 1 = Vector.length variants
+            then
+               let
+                  val {args, con, pointerTycon} = Vector.sub (variants, 0)
+                  val tupleRep =
+                     TupleRep.make (pointerTycon, args,
+                                    {forceBox = false,
+                                     isVector = false})
+                  val conRep = ConRep.Tuple tupleRep
+               in
+                  (One {con = con, tupleRep = tupleRep},
+                   Vector.new1 {con = con, rep = conRep})
+               end
+         else if (2 = Vector.length variants
+                  andalso let
+                             val c = #con (Vector.sub (variants, 0))
+                          in
+                             Con.equals (c, Con.falsee)
+                             orelse Con.equals (c, Con.truee)
+                          end)
+            then (bool, Vector.new2 ({con = Con.falsee, rep = ConRep.falsee},
+                                     {con = Con.truee, rep = ConRep.truee}))
+         else
+         let
+            val numSmall = ref 0
+            val small = Array.array (wordBits, [])
+            val big = ref []
+            val () =
+               Vector.foreach
+               (variants, fn {args, con, pointerTycon} =>
+                let
+                   val tr =
+                      TupleRep.make (pointerTycon, args,
+                                     {forceBox = false,
+                                      isVector = false})
+                   fun makeBig () =
+                      List.push (big,
+                                 {con = con,
+                                  pointerTycon = pointerTycon,
+                                  tupleRep = tr})
+                   val Rep.T {rep, ty} = TupleRep.rep tr
+                in
+                   case rep of
+                      Rep.NonPointer =>
+                         let
+                            val i = Bits.toInt (Type.width ty)
+                         in
+                            if i >= wordBits
+                               then makeBig ()
+                            else
+                               let
+                                  val {component, selects} =
+                                     case tr of
+                                        TupleRep.Direct z => z
+                                      | TupleRep.Indirect _ =>
+                                           Error.bug "PackedRepresentation.TyconRep.make: small Indirect"
+                                  val () = Int.inc numSmall
+                                  val () =
+                                     Array.update
+                                     (small, i,
+                                      {component = component,
+                                       con = con,
+                                       pointerTycon = pointerTycon,
+                                       selects = selects}
+                                      :: Array.sub (small, i))
+                               in
+                                  ()
+                               end
+                         end
+                    | Rep.Pointer _ => makeBig ()
+                end)
+            val big = !big
+            val numSmall = !numSmall
+            fun noLargerThan (i, ac) =
+               if i < 0
+                  then ac
+               else noLargerThan (i - 1,
+                                  List.fold (Array.sub (small, i), ac, op ::))
+            (* Box as few things as possible so that the number of tags available
+             * is >= the number of unboxed variants.
+             *)
+            fun loop (maxSmallWidth: int,
+                      forced,
+                      withPointer: bool,
+                      numSmall: IntInf.t) =
+               if 0 = numSmall
+                  then (maxSmallWidth, forced, [])
+               else
+                  let
+                     val vs = Array.sub (small, maxSmallWidth)
+                  in
+                     if List.isEmpty vs
+                        then loop (maxSmallWidth - 1, forced,
+                                   withPointer, numSmall)
+                     else
+                        let
+                           val numTags =
+                              numTagsAvailable
+                              {tagBits = wordBits - maxSmallWidth,
+                               withPointer = withPointer}
+                        in
+                           if numSmall <= numTags
+                              then
+                                 (* There are enough tag bits available. *)
+                                 (maxSmallWidth,
+                                  forced,
+                                  noLargerThan (maxSmallWidth - 1, vs))
+                           else
+                              let
+                                 val z = Int.toIntInf (List.length vs)
+                                 val remaining = numSmall - z
+                              in
+                                 if remaining <= numTags
+                                    then
+                                       let
+                                          val (front, back) =
+                                             List.splitAt
+                                             (vs,
+                                              IntInf.toInt
+                                              (numSmall - numTags))
+                                       in
+                                          (maxSmallWidth,
+                                           List.append (front, forced),
+                                           noLargerThan (maxSmallWidth - 1,
+                                                         back))
+                                       end
+                                 else loop (maxSmallWidth - 1,
+                                            vs @ forced,
+                                            true,
+                                            remaining)
+                              end
+                        end
+                  end
+            val (maxSmallWidth, forced, small) =
+               loop (wordBits - 1, [],
+                     not (List.isEmpty big),
+                     Int.toIntInf numSmall)
+            val maxSmallWidth = Bits.fromInt maxSmallWidth
+            val withPointer = not (List.isEmpty big andalso List.isEmpty forced)
+            (* ShiftAndTag all the small. *)
+            val (small: Small.t option, smallReps) =
+               let
+                  val numSmall = List.length small
+               in
+                  if 0 = numSmall
+                     then (NONE, Vector.new0 ())
+                  else
+                     let
+                        val tagBits =
+                           tagBitsNeeded {numVariants = numSmall,
+                                          withPointer = withPointer}
+                        val r = ref 0w0
+                        fun getTag (): IntInf.t =
+                           let
+                              val w = !r
+                              val w =
+                                 if withPointer andalso
+                                    0w0 = Word.andb (w, 0w3)
+                                    then w + 0w1
+                                 else w
+                              val () = r := w + 0w1
+                           in
+                              Word.toIntInf w
+                           end
+                        val small =
+                           Vector.fromListMap
+                           (small, fn {component, con, selects, ...} =>
+                            let
+                               val tag =
+                                  WordX.fromIntInf (getTag (),
+                                                    WordSize.fromBits tagBits)
+                               val isUnit = Type.isUnit (Component.ty component)
+                               val component =
+                                  Component.padToWidth (component,
+                                                        maxSmallWidth)
+                               val selects = Selects.lshift (selects, tagBits)
+                               val ty =
+                                  Type.seq
+                                  (Vector.new2 (Type.constant tag,
+                                                Component.ty component))
+                               val ty =
+                                  if withPointer
+                                     then Type.resize (ty, Bits.inPointer)
+                                  else Type.padToPrim ty
+                            in
+                               {component = component,
+                                con = con,
+                                isUnit = isUnit,
+                                selects = selects,
+                                tag = tag,
+                                ty = ty}
+                            end)
+                        val ty = Type.sum (Vector.map (small, #ty))
+                        val rep = Rep.T {rep = Rep.NonPointer, ty = ty}
+                        val reps =
+                           Vector.map
+                           (small, fn {component, con, isUnit, selects, tag, ty,
+                                       ...} =>
+                            {con = con,
+                             rep = if isUnit
+                                      then ConRep.Tag {tag = tag, ty = ty}
+                                   else (ConRep.ShiftAndTag
+                                         {component = component,
+                                          selects = selects,
+                                          tag = tag,
+                                          ty = ty})})
+                        val isEnum =
+                           Vector.forall
+                           (reps, fn {rep, ...} =>
+                            case rep of
+                               ConRep.Tag _ => true
+                             | _ => false)
+                     in
+                        (SOME (Small.T {isEnum = isEnum,
+                                        rep = rep,
+                                        tagBits = tagBits,
+                                        variants = Vector.map (reps, #con)}),
+                         reps)
+                     end
+               end
+            fun makeSmallPointer {component, con, pointerTycon, selects} =
+               {con = con,
+                pointer = (PointerRep.box
+                           (Component.padToWidth (component, Bits.inWord),
+                            pointerTycon, selects))}
+            fun makeBigPointer {con, pointerTycon, tupleRep} =
+               let
+                  val pr =
+                     case tupleRep of
+                        TupleRep.Direct {component, selects} =>
+                           PointerRep.box (component, pointerTycon, selects)
+                      | TupleRep.Indirect p => p
+               in
+                  {con = con, pointer = pr}
+               end
+            fun sumWithSmall (r: Rep.t): Rep.t =
+               Rep.T {rep = Rep.Pointer {endsIn00 = false},
+                      ty = Type.sum (Vector.new2
+                                     (Rep.ty r,
+                                      Rep.ty (Small.rep (valOf small))))}
+            fun box () =
+               let
+                  val pointers =
+                     Vector.concat
+                     [Vector.fromListMap (forced, makeSmallPointer),
+                      Vector.fromListMap (big, makeBigPointer)]
+                  val sumRep =
+                     if 1 = Vector.length pointers
+                        then
+                           let
+                              val pointer = Vector.sub (pointers, 0)
+                              val small = valOf small
+                              val rep =
+                                 sumWithSmall (PointerRep.rep (#pointer pointer))
+                           in
+                              SmallAndBox {box = pointer,
+                                           rep = rep,
+                                           small = small}
+                           end
+                     else
+                        let
+                           val ty =
+                              Type.sum
+                              (Vector.map (pointers, PointerRep.ty o #pointer))
+                           val ps =
+                              Pointers.make
+                              {rep = Rep.T {rep = Rep.Pointer {endsIn00 = true},
+                                            ty = ty},
+                               variants = pointers}
+                        in
+                           case small of
+                              NONE => Pointers ps
+                            | SOME small =>
+                                 SmallAndPointers
+                                 {pointers = ps,
+                                  rep = sumWithSmall (Pointers.rep ps),
+                                  small = small}
+                        end
+               in
+                  (sumRep,
+                   Vector.map (pointers, fn {con, pointer} =>
+                               {con = con,
+                                rep = ConRep.box pointer}))
+               end
+            val (sumRep, pointerReps) =
+               case (forced, big) of
+                  ([], []) => (Small (valOf small), Vector.new0 ())
+                | ([], [{con, tupleRep, ...}]) =>
+                     (* If there is only one big and it is a pointer that
+                      * ends in 00, then there is no need to box it.
+                      *)
+                     (case tupleRep of
+                         TupleRep.Direct {component, ...} =>
+                            let
+                               val rep = TupleRep.rep tupleRep
+                            in
+                               if Rep.isPointerEndingIn00 rep
+                                  then
+                                     let
+                                        val small = valOf small
+                                     in
+                                        (SmallAndPointer
+                                         {pointer = {component = component,
+                                                     con = con},
+                                          rep = sumWithSmall rep,
+                                          small = small},
+                                         Vector.new1
+                                         {con = con,
+                                          rep = ConRep.Tuple tupleRep})
+                                     end
+                               else box ()
+                            end
+                       | _ => box ())
+                | _ => box ()
+         in
+            (sumRep, Vector.concat [smallReps, pointerReps])
+         end
 
       val make =
-	 Trace.trace
-	 ("TyconRep.make",
-	  Vector.layout
-	  (fn {args, con, ...} =>
-	   Layout.record [("args", Vector.layout (Rep.layout o #rep) args),
-			  ("con", Con.layout con)]),
-	  Layout.tuple2 (layout,
-			 Vector.layout
-			 (fn {con, rep} =>
-			  Layout.record [("con", Con.layout con),
-					 ("rep", ConRep.layout rep)])))
-	 make
+         Trace.trace
+         ("PackedRepresentation.TyconRep.make",
+          Vector.layout
+          (fn {args, con, ...} =>
+           Layout.record [("args", Vector.layout (Rep.layout o #rep) args),
+                          ("con", Con.layout con)]),
+          Layout.tuple2 (layout,
+                         Vector.layout
+                         (fn {con, rep} =>
+                          Layout.record [("con", Con.layout con),
+                                         ("rep", ConRep.layout rep)])))
+         make
 
       fun genCase (r: t,
-		   {cases: Cases.t,
-		    conRep: Con.t -> ConRep.t,
-		    default: Label.t option,
-		    test: unit -> Operand.t})
-	 : Statement.t list * Transfer.t * Block.t list =
-	 let
-	    val (statements, transfer) =
-	       case r of
-		  One {con, ...} =>
-		     (case (Vector.length cases, default) of
-			 (1, _) =>
-			    (* Use _ instead of NONE for the default becuase
-			     * there may be an unreachable default case.
-			     *)
-			    let
-			       val {con = c, dst, dstHasArg} =
-				  Vector.sub (cases, 0)
-			    in
-			       if not (Con.equals (c, con))
-				  then Error.bug "genCase One"
-			       else
-				  ([],
-				   Goto {args = (if dstHasArg
-						    then Vector.new1 (test ())
-						 else Vector.new0 ()),
-					 dst = dst})
-			    end
-		       | (0, SOME l) =>
-			    ([], Goto {dst = l, args = Vector.new0 ()})
-		       | _ => Error.bug "prim datatype with more than one case")
-		| Pointers ps =>
-		     Pointers.genCase (ps, {cases = cases,
-					    conRep = conRep,
-					    default = default,
-					    test = test ()})
-		| Small s =>
-		     Small.genCase (s, {cases = cases,
-					conRep = conRep,
-					isPointer = false,
-					notSmall = NONE,
-					smallDefault = default,
-					test = test ()})
-		| SmallAndBox {box = {con, pointer}, small, ...} =>
-		     let
-			val notSmall =
-			   case Vector.peek (cases, fn {con = c, ...} =>
-					     Con.equals (c, con)) of
-			      NONE => default
-			    | SOME {dst, dstHasArg, ...} =>
-				 let
-				    val test =
-				       Operand.cast (test (),
-						     PointerRep.ty pointer)
-				 in
-				    SOME
-				    (Block.new
-				     {statements = Vector.new0 (),
-				      transfer =
-				      Goto {args = (if dstHasArg
-						       then Vector.new1 test
-						    else Vector.new0 ()),
-					    dst = dst}})
-				 end
-		     in
-			Small.genCase (small, {cases = cases,
-					       conRep = conRep,
-					       isPointer = true,
-					       notSmall = notSmall,
-					       smallDefault = default,
-					       test = test ()})
-		     end
-		| SmallAndPointer {pointer = {component, con}, small, ...} =>
-		     let
-			val notSmall =
-			   case Vector.peek (cases, fn {con = c, ...} =>
-					     Con.equals (c, con)) of
-			      NONE => default
-			    | SOME {dst, dstHasArg, ...} =>
-				 let
-				    val args =
-				       if dstHasArg
-					  then (Vector.new1
-						(Operand.cast
-						 (test (),
-						  Component.ty component)))
-				       else Vector.new0 ()
-				 in
-				    SOME (Block.new
-					  {statements = Vector.new0 (),
-					   transfer = Goto {args = args,
-							    dst = dst}})
-				 end
-		     in
-			Small.genCase (small, {cases = cases,
-					       conRep = conRep,
-					       isPointer = true,
-					       notSmall = notSmall,
-					       smallDefault = default,
-					       test = test ()})
-		     end
-		| SmallAndPointers {pointers, small, ...} =>
-		     let
-			val test = test ()
-			val (ss, t) =
-			   Pointers.genCase
-			   (pointers, {cases = cases,
-				       conRep = conRep,
-				       default = default,
-				       test = (Operand.cast
-					       (test, Pointers.ty pointers))})
-			val pointer =
-			   Block.new {statements = Vector.fromList ss,
-				      transfer = t}
-		     in
-			Small.genCase (small, {cases = cases,
-					       conRep = conRep,
-					       isPointer = true,
-					       notSmall = SOME pointer,
-					       smallDefault = default,
-					       test = test})
-		     end
-		| Unit => Error.bug "TyconRep.genCase Unit"
-	 in
-	    (statements, transfer, Block.getExtra ())
-	 end
+                   {cases: Cases.t,
+                    conRep: Con.t -> ConRep.t,
+                    default: Label.t option,
+                    test: unit -> Operand.t})
+         : Statement.t list * Transfer.t * Block.t list =
+         let
+            val (statements, transfer) =
+               case r of
+                  One {con, ...} =>
+                     (case (Vector.length cases, default) of
+                         (1, _) =>
+                            (* Use _ instead of NONE for the default becuase
+                             * there may be an unreachable default case.
+                             *)
+                            let
+                               val {con = c, dst, dstHasArg} =
+                                  Vector.sub (cases, 0)
+                            in
+                               if not (Con.equals (c, con))
+                                  then Error.bug "PackedRepresentation.genCase: One"
+                               else
+                                  ([],
+                                   Goto {args = (if dstHasArg
+                                                    then Vector.new1 (test ())
+                                                 else Vector.new0 ()),
+                                         dst = dst})
+                            end
+                       | (0, SOME l) =>
+                            ([], Goto {dst = l, args = Vector.new0 ()})
+                       | _ => Error.bug "PackedRepresentation.genCase: One,prim datatype with more than one case")
+                | Pointers ps =>
+                     Pointers.genCase (ps, {cases = cases,
+                                            conRep = conRep,
+                                            default = default,
+                                            test = test ()})
+                | Small s =>
+                     Small.genCase (s, {cases = cases,
+                                        conRep = conRep,
+                                        isPointer = false,
+                                        notSmall = NONE,
+                                        smallDefault = default,
+                                        test = test ()})
+                | SmallAndBox {box = {con, pointer}, small, ...} =>
+                     let
+                        val notSmall =
+                           case Vector.peek (cases, fn {con = c, ...} =>
+                                             Con.equals (c, con)) of
+                              NONE => default
+                            | SOME {dst, dstHasArg, ...} =>
+                                 let
+                                    val test =
+                                       Operand.cast (test (),
+                                                     PointerRep.ty pointer)
+                                 in
+                                    SOME
+                                    (Block.new
+                                     {statements = Vector.new0 (),
+                                      transfer =
+                                      Goto {args = (if dstHasArg
+                                                       then Vector.new1 test
+                                                    else Vector.new0 ()),
+                                            dst = dst}})
+                                 end
+                     in
+                        Small.genCase (small, {cases = cases,
+                                               conRep = conRep,
+                                               isPointer = true,
+                                               notSmall = notSmall,
+                                               smallDefault = default,
+                                               test = test ()})
+                     end
+                | SmallAndPointer {pointer = {component, con}, small, ...} =>
+                     let
+                        val notSmall =
+                           case Vector.peek (cases, fn {con = c, ...} =>
+                                             Con.equals (c, con)) of
+                              NONE => default
+                            | SOME {dst, dstHasArg, ...} =>
+                                 let
+                                    val args =
+                                       if dstHasArg
+                                          then (Vector.new1
+                                                (Operand.cast
+                                                 (test (),
+                                                  Component.ty component)))
+                                       else Vector.new0 ()
+                                 in
+                                    SOME (Block.new
+                                          {statements = Vector.new0 (),
+                                           transfer = Goto {args = args,
+                                                            dst = dst}})
+                                 end
+                     in
+                        Small.genCase (small, {cases = cases,
+                                               conRep = conRep,
+                                               isPointer = true,
+                                               notSmall = notSmall,
+                                               smallDefault = default,
+                                               test = test ()})
+                     end
+                | SmallAndPointers {pointers, small, ...} =>
+                     let
+                        val test = test ()
+                        val (ss, t) =
+                           Pointers.genCase
+                           (pointers, {cases = cases,
+                                       conRep = conRep,
+                                       default = default,
+                                       test = (Operand.cast
+                                               (test, Pointers.ty pointers))})
+                        val pointer =
+                           Block.new {statements = Vector.fromList ss,
+                                      transfer = t}
+                     in
+                        Small.genCase (small, {cases = cases,
+                                               conRep = conRep,
+                                               isPointer = true,
+                                               notSmall = SOME pointer,
+                                               smallDefault = default,
+                                               test = test})
+                     end
+                | Unit => Error.bug "PackedRepresentation.TyconRep.genCase: Unit"
+         in
+            (statements, transfer, Block.getExtra ())
+         end
 
       val genCase =
-	 Trace.trace
-	 ("TyconRep.genCase",
-	  fn (r, {cases, default, ...}) =>
-	  Layout.tuple [layout r,
-			Layout.record
-			[("cases", Cases.layout cases),
-			 ("default", Option.layout Label.layout default)]],
-	  Layout.tuple3 (List.layout Statement.layout,
-			 Transfer.layout,
-			 List.layout Block.layout))
-	 genCase
+         Trace.trace
+         ("PackedRepresentation.TyconRep.genCase",
+          fn (r, {cases, default, ...}) =>
+          Layout.tuple [layout r,
+                        Layout.record
+                        [("cases", Cases.layout cases),
+                         ("default", Option.layout Label.layout default)]],
+          Layout.tuple3 (List.layout Statement.layout,
+                         Transfer.layout,
+                         List.layout Block.layout))
+         genCase
    end
 
 structure Value:
@@ -2141,74 +2150,74 @@
       val get: 'a t -> 'a
       val layout: ('a -> Layout.t) -> 'a t -> Layout.t
       val new: {compute: unit -> 'a,
-		equals: 'a * 'a -> bool,
-		init: 'a} -> 'a t
+                equals: 'a * 'a -> bool,
+                init: 'a} -> 'a t
    end =
    struct
       structure Dep =
-	 struct
-	    datatype t = T of {affects: t list ref,
-			       compute: unit -> {change: bool},
-			       needToCompute: bool ref}
+         struct
+            datatype t = T of {affects: t list ref,
+                               compute: unit -> {change: bool},
+                               needToCompute: bool ref}
 
-	    (* A list of all ts such that !needToCompute = true. *)
-	    val todo: t list ref = ref []
+            (* A list of all ts such that !needToCompute = true. *)
+            val todo: t list ref = ref []
 
-	    fun recompute (me as T {needToCompute, ...}) =
-	       if !needToCompute
-		  then ()
-	       else (List.push (todo, me)
-		     ; needToCompute := true)
+            fun recompute (me as T {needToCompute, ...}) =
+               if !needToCompute
+                  then ()
+               else (List.push (todo, me)
+                     ; needToCompute := true)
 
-	    fun fixedPoint () =
-	       case !todo of
-		  [] => ()
-		| T {affects, compute, needToCompute, ...} :: l =>
-		     let
-			val () = todo := l
-			val () = needToCompute := false
-			val {change} = compute ()
-			val () =
-			   if change
-			      then List.foreach (!affects, recompute)
-			   else ()
-		     in
-			fixedPoint ()
-		     end
+            fun fixedPoint () =
+               case !todo of
+                  [] => ()
+                | T {affects, compute, needToCompute, ...} :: l =>
+                     let
+                        val () = todo := l
+                        val () = needToCompute := false
+                        val {change} = compute ()
+                        val () =
+                           if change
+                              then List.foreach (!affects, recompute)
+                           else ()
+                     in
+                        fixedPoint ()
+                     end
   
-	    fun affect (T {affects, ...}, z) = List.push (affects, z)
-	       
-	    fun new {compute: unit -> 'a,
-		     equals: 'a * 'a -> bool,
-		     init: 'a}: t * 'a ref =
-	       let
-		  val r: 'a ref = ref init
-		  val affects = ref []
-		  val compute =
-		     fn () =>
-		     let
-			val old = !r
-			val new = compute ()
-			val () = r := new
-		     in
-			{change = not (equals (old, new))}
-		     end
-		  val me = T {affects = affects,
-			      compute = compute,
-			      needToCompute = ref false}
-		  val () = recompute me
-	       in
-		  (me, r)
-	       end
-	 end
+            fun affect (T {affects, ...}, z) = List.push (affects, z)
+               
+            fun new {compute: unit -> 'a,
+                     equals: 'a * 'a -> bool,
+                     init: 'a}: t * 'a ref =
+               let
+                  val r: 'a ref = ref init
+                  val affects = ref []
+                  val compute =
+                     fn () =>
+                     let
+                        val old = !r
+                        val new = compute ()
+                        val () = r := new
+                     in
+                        {change = not (equals (old, new))}
+                     end
+                  val me = T {affects = affects,
+                              compute = compute,
+                              needToCompute = ref false}
+                  val () = recompute me
+               in
+                  (me, r)
+               end
+         end
 
       datatype 'a t =
-	 Constant of 'a
+         Constant of 'a
        | Variable of Dep.t * 'a ref
 
       val get =
-	 fn Constant a => a
-	  | Variable (_, r) => !r
+         fn Constant a => a
+          | Variable (_, r) => !r
 
       fun layout l v = l (get v)
 
@@ -2217,9 +2226,9 @@
       fun new z = Variable (Dep.new z)
 
       val affect =
-	 fn (Variable (d, _), Variable (d', _)) => Dep.affect (d, d')
-	  | (Constant _, _) => ()
-	  | (_, Constant _) => Error.bug "cannot affect constant"
+         fn (Variable (d, _), Variable (d', _)) => Dep.affect (d, d')
+          | (Constant _, _) => ()
+          | (_, Constant _) => Error.bug "PackedRepresentation.Value.affect: Constant"
 
       val fixedPoint = Dep.fixedPoint
    end
@@ -2227,406 +2236,414 @@
 fun compute (program as Ssa.Program.T {datatypes, ...}) =
    let
       type tyconRepAndCons =
-	 (TyconRep.t * {con: Con.t, rep: ConRep.t} vector) Value.t
+         (TyconRep.t * {con: Con.t, rep: ConRep.t} vector) Value.t
       val {get = conInfo: Con.t -> {rep: ConRep.t ref,
-				    tyconRep: tyconRepAndCons},
-	   set = setConInfo, ...} =
-	 Property.getSetOnce (Con.plist, Property.initRaise ("info", Con.layout))
+                                    tyconRep: tyconRepAndCons},
+           set = setConInfo, ...} =
+         Property.getSetOnce (Con.plist, Property.initRaise ("info", Con.layout))
       val {get = tupleRep: S.Type.t -> TupleRep.t Value.t,
-	   set = setTupleRep, ...} =
-	 Property.getSetOnce (S.Type.plist,
-			      Property.initRaise ("tupleRep", S.Type.layout))
+           set = setTupleRep, ...} =
+         Property.getSetOnce (S.Type.plist,
+                              Property.initRaise ("tupleRep", S.Type.layout))
       val setTupleRep =
-	 Trace.trace ("setTupleRep", S.Type.layout o #1, Layout.ignore)
-	 setTupleRep
+         Trace.trace 
+         ("PackedRepresentation.setTupleRep", 
+          S.Type.layout o #1, Layout.ignore)
+         setTupleRep
       fun vectorRep (t: S.Type.t): TupleRep.t = Value.get (tupleRep t)
       fun setVectorRep (t: S.Type.t, tr: TupleRep.t): unit =
-	 setTupleRep (t, Value.new {compute = fn () => tr,
-				    equals = TupleRep.equals,
-				    init = tr})
+         setTupleRep (t, Value.new {compute = fn () => tr,
+                                    equals = TupleRep.equals,
+                                    init = tr})
       val setVectorRep =
-	 Trace.trace2 ("setVectorRep",
-		       S.Type.layout, TupleRep.layout, Unit.layout)
-	 setVectorRep
+         Trace.trace2 
+         ("PackedRepresentation.setVectorRep",
+          S.Type.layout, TupleRep.layout, Unit.layout)
+         setVectorRep
       val {get = tyconRep: Tycon.t -> tyconRepAndCons, set = setTyconRep, ...} =
-	 Property.getSetOnce (Tycon.plist,
-			      Property.initRaise ("tyconRep", Tycon.layout))
+         Property.getSetOnce (Tycon.plist,
+                              Property.initRaise ("tyconRep", Tycon.layout))
       (* Initialize the datatypes. *)
-      val typeRepRef = ref (fn _ => raise Fail "typeRepRef not set")
+      val typeRepRef = ref (fn _ => Error.bug "PackedRepresentation.typeRep")
       fun typeRep t = !typeRepRef t
       val datatypes =
-	 Vector.map
-	 (datatypes, fn S.Datatype.T {cons, tycon} =>
-	  let
-	     val cons =
-		Vector.map
-		(cons, fn {args, con} =>
-		 {args = args,
-		  con = con,
-		  pointerTycon = PointerTycon.new ()})
-	     fun compute () =
-		let
-		   val (tr, cons) =
-		      TyconRep.make
-		      (Vector.map
-		       (cons, fn {args, con, pointerTycon} =>
-			{args = Vector.map (Prod.dest args,
-					    fn {elt, isMutable} =>
-					    {isMutable = isMutable,
-					     rep = Value.get (typeRep elt),
-					     ty = elt}),
-			 con = con,
-			 pointerTycon = pointerTycon}))
-		   val () =
-		      Vector.foreach
-		      (cons, fn {con, rep} => #rep (conInfo con) := rep)
-		in
-		   (tr, cons)
-		end
-	     fun equals ((r, v), (r', v')) =
-		TyconRep.equals (r, r')
-		andalso Vector.equals (v, v', fn ({con = c, rep = r},
-						  {con = c', rep = r'}) =>
-				       Con.equals (c, c')
-				       andalso ConRep.equals (r, r'))
-	     val rep =
-		Value.new {compute = compute,
-			   equals = equals,
-			   init = (TyconRep.unit, Vector.new0 ())}
-	     val () = setTyconRep (tycon, rep)
-	     val () = Vector.foreach (cons, fn {con, ...} =>
-				      setConInfo (con, {rep = ref ConRep.unit,
-							tyconRep = rep}))
-	  in
-	     {cons = cons,
-	      rep = rep,
-	      tycon = tycon}
-	  end)
+         Vector.map
+         (datatypes, fn S.Datatype.T {cons, tycon} =>
+          let
+             val cons =
+                Vector.map
+                (cons, fn {args, con} =>
+                 {args = args,
+                  con = con,
+                  pointerTycon = PointerTycon.new ()})
+             fun compute () =
+                let
+                   val (tr, cons) =
+                      TyconRep.make
+                      (Vector.map
+                       (cons, fn {args, con, pointerTycon} =>
+                        {args = Vector.map (Prod.dest args,
+                                            fn {elt, isMutable} =>
+                                            {isMutable = isMutable,
+                                             rep = Value.get (typeRep elt),
+                                             ty = elt}),
+                         con = con,
+                         pointerTycon = pointerTycon}))
+                   val () =
+                      Vector.foreach
+                      (cons, fn {con, rep} => #rep (conInfo con) := rep)
+                in
+                   (tr, cons)
+                end
+             fun equals ((r, v), (r', v')) =
+                TyconRep.equals (r, r')
+                andalso Vector.equals (v, v', fn ({con = c, rep = r},
+                                                  {con = c', rep = r'}) =>
+                                       Con.equals (c, c')
+                                       andalso ConRep.equals (r, r'))
+             val rep =
+                Value.new {compute = compute,
+                           equals = equals,
+                           init = (TyconRep.unit, Vector.new0 ())}
+             val () = setTyconRep (tycon, rep)
+             val () = Vector.foreach (cons, fn {con, ...} =>
+                                      setConInfo (con, {rep = ref ConRep.unit,
+                                                        tyconRep = rep}))
+          in
+             {cons = cons,
+              rep = rep,
+              tycon = tycon}
+          end)
       val delayedObjectTypes
-	 : (unit -> (PointerTycon.t * ObjectType.t) option) list ref =
-	 ref []
+         : (unit -> (PointerTycon.t * ObjectType.t) option) list ref =
+         ref []
       val {get = typeRep: S.Type.t -> Rep.t Value.t, ...} =
-	 Property.get
-	 (S.Type.plist,
-	  Property.initRec
-	  (fn (t, typeRep: S.Type.t -> Rep.t Value.t) =>
-	   let
-	      val constant = Value.constant
-	      val nonPointer = constant o Rep.nonPointer
-	      datatype z = datatype S.Type.dest
-	   in
-	      case S.Type.dest t of
-		 Datatype tycon =>
-		    let
-		       val r = tyconRep tycon
-		       fun compute () = TyconRep.rep (#1 (Value.get r))
-		       val r' = Value.new {compute = compute,
-					   equals = Rep.equals,
-					   init = Rep.unit}
-		       val () = Value.affect (r, r')
-		    in
-		       r'
-		    end
-	       | IntInf =>
-		    constant (Rep.T {rep = Rep.Pointer {endsIn00 = false},
-				     ty = Type.intInf})
-	       | Object {args, con} =>
-		    (case con of
-			ObjectCon.Con con =>
-			   let
-			      val {rep, tyconRep} = conInfo con
-			      fun compute () = ConRep.rep (!rep)
-			      val r = Value.new {compute = compute,
-						 equals = Rep.equals,
-						 init = Rep.unit}
-			      val () = Value.affect (tyconRep, r)
-			   in
-			      r
-			   end
-		      | ObjectCon.Tuple =>
-			   let
-			      val pt = PointerTycon.new ()
-			      val rs =
-				 Vector.map (Prod.dest args, typeRep o #elt)
-			      fun compute () =
-				 TupleRep.make
-				 (pt,
-				  Vector.map2 (rs, Prod.dest args,
-					       fn (r, {elt, isMutable}) =>
-					       {isMutable = isMutable,
-						rep = Value.get r,
-						ty = elt}),
-				  {forceBox = false, isVector = false})
-			      val tr =
-				 Value.new {compute = compute,
-					    equals = TupleRep.equals,
-					    init = TupleRep.unit}
-			      val () = Vector.foreach (rs, fn r =>
-						       Value.affect (r, tr))
-			      val hasIdentity = Prod.isMutable args
-			      val () =
-				 List.push
-				 (delayedObjectTypes, fn () =>
-				  case Value.get tr of
-				     TupleRep.Indirect pr =>
-					SOME
-					(pt, (ObjectType.Normal
-					      {hasIdentity = hasIdentity,
-					       ty = PointerRep.componentsTy pr}))
-				   | _ => NONE)
-			      val () = setTupleRep (t, tr)
-			      fun compute () = TupleRep.rep (Value.get tr)
-			      val r = Value.new {compute = compute,
-						 equals = Rep.equals,
-						 init = Rep.unit}
-			      val () = Value.affect (tr, r)
-			   in
-			      r
-			   end
-		      | ObjectCon.Vector => 
-			   let
-			      val hasIdentity = Prod.isMutable args
-			      val args = Prod.dest args
-			      fun tupleRep pt =
-				 let
-				    val tr =
-				       TupleRep.make
-				       (pt,
-					Vector.map
-					(args, fn {elt, isMutable} =>
-					 {isMutable = isMutable,
-					  rep = Value.get (typeRep elt),
-					  ty = elt}),
-					{forceBox = true,
-					 isVector = true})
-				    val () = setVectorRep (t, tr)
-				 in
-				    tr
-				 end
-			      fun now pt = (ignore (tupleRep pt); pt)
-			      fun delay () =
-				 let
-				    val pt = PointerTycon.new ()
-				    val () =
-				       List.push
-				       (delayedObjectTypes, fn () =>
-					let
-					   (* Delay computing tupleRep until the
-					    * delayedObjectTypes are computed
-					    * because the vector component types
-					    * may not be known yet.
-					    *)
-					   val tr = tupleRep pt
-					   val ty =
-					      case tr of
-						 TupleRep.Direct _ =>
-						    TupleRep.ty tr
-					       | TupleRep.Indirect pr =>
-						    PointerRep.componentsTy pr
-					   val elt =
-					      if Type.isUnit ty
-						 then Type.zero Bits.inByte
-					      else ty
-					in
-					   SOME (pt,
-						 ObjectType.Array
-						 {elt = elt,
-						  hasIdentity = hasIdentity})
-					end)
-				 in
-				    pt
-				 end
-			      val pt =
-				 if 1 <> Vector.length args
-				    then delay ()
-				 else  
-				    let
-				       val {elt, isMutable, ...} =
-					  Vector.sub (args, 0)
-				    in
-				       if isMutable
-					  then delay ()
-				       else
-					  (case S.Type.dest elt of
-					      S.Type.Word s =>
-						 let
-						    val n =
-						       Bits.toInt
-						       (WordSize.bits s)
-						 in
-						    if n = 8
-						       orelse n = 16
-						       orelse n = 32
-						       then
-							  now
-							  (PointerTycon.wordVector
-							   (Bits.fromInt n))
-						    else delay ()
-						 end
-					    | _ => delay ())
-				    end
-			   in
-			      constant
-			      (Rep.T {rep = Rep.Pointer {endsIn00 = true},
-				      ty = Type.pointer pt})
-			   end)
-	       | Real s => nonPointer (Type.real s)
-	       | Thread =>
-		    constant (Rep.T {rep = Rep.Pointer {endsIn00 = true},
-				     ty = Type.thread})
-	       | Weak t =>
-		    let
-		       val pt = PointerTycon.new ()
-		       val rep =
-			  Rep.T {rep = Rep.Pointer {endsIn00 = true},
-				 ty = Type.pointer pt}
-		       val r = typeRep t
-		       fun compute () =
-			  if Rep.isPointer (Value.get r)
-			     then rep
-			  else Rep.unit
-		       val r' = Value.new {compute = compute,
-					   equals = Rep.equals,
-					   init = Rep.unit}
-		       val () = Value.affect (r, r')
-		       val () =
-			  List.push
-			  (delayedObjectTypes, fn () =>
-			   let
-			      val r = Value.get r
-			   in
-			      if Rep.isPointer r
-				 then SOME (pt, ObjectType.Weak (Rep.ty r))
-			      else NONE
-			   end)
-		    in
-		       r'
-		    end
-	     | Word s => nonPointer (Type.word (WordSize.bits s))
-	   end))
+         Property.get
+         (S.Type.plist,
+          Property.initRec
+          (fn (t, typeRep: S.Type.t -> Rep.t Value.t) =>
+           let
+              val constant = Value.constant
+              val nonPointer = constant o Rep.nonPointer
+              datatype z = datatype S.Type.dest
+           in
+              case S.Type.dest t of
+                 Datatype tycon =>
+                    let
+                       val r = tyconRep tycon
+                       fun compute () = TyconRep.rep (#1 (Value.get r))
+                       val r' = Value.new {compute = compute,
+                                           equals = Rep.equals,
+                                           init = Rep.unit}
+                       val () = Value.affect (r, r')
+                    in
+                       r'
+                    end
+               | IntInf =>
+                    constant (Rep.T {rep = Rep.Pointer {endsIn00 = false},
+                                     ty = Type.intInf})
+               | Object {args, con} =>
+                    (case con of
+                        ObjectCon.Con con =>
+                           let
+                              val {rep, tyconRep} = conInfo con
+                              fun compute () = ConRep.rep (!rep)
+                              val r = Value.new {compute = compute,
+                                                 equals = Rep.equals,
+                                                 init = Rep.unit}
+                              val () = Value.affect (tyconRep, r)
+                           in
+                              r
+                           end
+                      | ObjectCon.Tuple =>
+                           let
+                              val pt = PointerTycon.new ()
+                              val rs =
+                                 Vector.map (Prod.dest args, typeRep o #elt)
+                              fun compute () =
+                                 TupleRep.make
+                                 (pt,
+                                  Vector.map2 (rs, Prod.dest args,
+                                               fn (r, {elt, isMutable}) =>
+                                               {isMutable = isMutable,
+                                                rep = Value.get r,
+                                                ty = elt}),
+                                  {forceBox = false, isVector = false})
+                              val tr =
+                                 Value.new {compute = compute,
+                                            equals = TupleRep.equals,
+                                            init = TupleRep.unit}
+                              val () = Vector.foreach (rs, fn r =>
+                                                       Value.affect (r, tr))
+                              val hasIdentity = Prod.isMutable args
+                              val () =
+                                 List.push
+                                 (delayedObjectTypes, fn () =>
+                                  case Value.get tr of
+                                     TupleRep.Indirect pr =>
+                                        SOME
+                                        (pt, (ObjectType.Normal
+                                              {hasIdentity = hasIdentity,
+                                               ty = PointerRep.componentsTy pr}))
+                                   | _ => NONE)
+                              val () = setTupleRep (t, tr)
+                              fun compute () = TupleRep.rep (Value.get tr)
+                              val r = Value.new {compute = compute,
+                                                 equals = Rep.equals,
+                                                 init = Rep.unit}
+                              val () = Value.affect (tr, r)
+                           in
+                              r
+                           end
+                      | ObjectCon.Vector => 
+                           let
+                              val hasIdentity = Prod.isMutable args
+                              val args = Prod.dest args
+                              fun tupleRep pt =
+                                 let
+                                    val tr =
+                                       TupleRep.make
+                                       (pt,
+                                        Vector.map
+                                        (args, fn {elt, isMutable} =>
+                                         {isMutable = isMutable,
+                                          rep = Value.get (typeRep elt),
+                                          ty = elt}),
+                                        {forceBox = true,
+                                         isVector = true})
+                                    val () = setVectorRep (t, tr)
+                                 in
+                                    tr
+                                 end
+                              fun now pt = (ignore (tupleRep pt); pt)
+                              fun delay () =
+                                 let
+                                    val pt = PointerTycon.new ()
+                                    val () =
+                                       List.push
+                                       (delayedObjectTypes, fn () =>
+                                        let
+                                           (* Delay computing tupleRep until the
+                                            * delayedObjectTypes are computed
+                                            * because the vector component types
+                                            * may not be known yet.
+                                            *)
+                                           val tr = tupleRep pt
+                                           val ty =
+                                              case tr of
+                                                 TupleRep.Direct _ =>
+                                                    TupleRep.ty tr
+                                               | TupleRep.Indirect pr =>
+                                                    PointerRep.componentsTy pr
+                                           val elt =
+                                              if Type.isUnit ty
+                                                 then Type.zero Bits.inByte
+                                              else ty
+                                        in
+                                           SOME (pt,
+                                                 ObjectType.Array
+                                                 {elt = elt,
+                                                  hasIdentity = hasIdentity})
+                                        end)
+                                 in
+                                    pt
+                                 end
+                              val pt =
+                                 if 1 <> Vector.length args
+                                    then delay ()
+                                 else  
+                                    let
+                                       val {elt, isMutable, ...} =
+                                          Vector.sub (args, 0)
+                                    in
+                                       if isMutable
+                                          then delay ()
+                                       else
+                                          (case S.Type.dest elt of
+                                              S.Type.Word s =>
+                                                 let
+                                                    val n =
+                                                       Bits.toInt
+                                                       (WordSize.bits s)
+                                                 in
+                                                    if n = 8
+                                                       orelse n = 16
+                                                       orelse n = 32
+                                                       then
+                                                          now
+                                                          (PointerTycon.wordVector
+                                                           (Bits.fromInt n))
+                                                    else delay ()
+                                                 end
+                                            | _ => delay ())
+                                    end
+                           in
+                              constant
+                              (Rep.T {rep = Rep.Pointer {endsIn00 = true},
+                                      ty = Type.pointer pt})
+                           end)
+               | Real s => nonPointer (Type.real s)
+               | Thread =>
+                    constant (Rep.T {rep = Rep.Pointer {endsIn00 = true},
+                                     ty = Type.thread})
+               | Weak t =>
+                    let
+                       val pt = PointerTycon.new ()
+                       val rep =
+                          Rep.T {rep = Rep.Pointer {endsIn00 = true},
+                                 ty = Type.pointer pt}
+                       val r = typeRep t
+                       fun compute () =
+                          if Rep.isPointer (Value.get r)
+                             then rep
+                          else Rep.unit
+                       val r' = Value.new {compute = compute,
+                                           equals = Rep.equals,
+                                           init = Rep.unit}
+                       val () = Value.affect (r, r')
+                       val () =
+                          List.push
+                          (delayedObjectTypes, fn () =>
+                           let
+                              val r = Value.get r
+                           in
+                              if Rep.isPointer r
+                                 then SOME (pt, ObjectType.Weak (Rep.ty r))
+                              else NONE
+                           end)
+                    in
+                       r'
+                    end
+             | Word s => nonPointer (Type.word (WordSize.bits s))
+           end))
       val () = typeRepRef := typeRep
       val _ = typeRep (S.Type.vector1 (S.Type.word WordSize.byte))
       (* Establish dependence between constructor argument type representations
        * and tycon representations.
        *)
       val () =
-	 Vector.foreach
-	 (datatypes, fn {cons, rep, ...} =>
-	  Vector.foreach
-	  (cons, fn {args, ...} =>
-	   Vector.foreach (Prod.dest args, fn {elt, ...} =>
-			   Value.affect (typeRep elt, rep))))
+         Vector.foreach
+         (datatypes, fn {cons, rep, ...} =>
+          Vector.foreach
+          (cons, fn {args, ...} =>
+           Vector.foreach (Prod.dest args, fn {elt, ...} =>
+                           Value.affect (typeRep elt, rep))))
       val typeRep =
-	 Trace.trace ("typeRep", S.Type.layout, Value.layout Rep.layout)
-	 typeRep
+         Trace.trace 
+         ("PackedRepresentation.typeRep", 
+          S.Type.layout, Value.layout Rep.layout)
+         typeRep
       val () = S.Program.foreachVar (program, fn (_, t) => ignore (typeRep t))
       val () = Value.fixedPoint ()
       val conRep = ! o #rep o conInfo
       val tyconRep = #1 o Value.get o tyconRep
       val objectTypes =
-	 Vector.fold
-	 (datatypes, [], fn ({cons, ...}, ac) =>
-	  Vector.fold
-	  (cons, ac, fn ({args, con, pointerTycon, ...}, ac) =>
-	   case conRep con of
-	      ConRep.Tuple (TupleRep.Indirect pr) =>
-		 (pointerTycon,
-		  ObjectType.Normal {hasIdentity = Prod.isMutable args,
-				     ty = PointerRep.componentsTy pr}) :: ac
-	    | _ => ac))
+         Vector.fold
+         (datatypes, [], fn ({cons, ...}, ac) =>
+          Vector.fold
+          (cons, ac, fn ({args, con, pointerTycon, ...}, ac) =>
+           case conRep con of
+              ConRep.Tuple (TupleRep.Indirect pr) =>
+                 (pointerTycon,
+                  ObjectType.Normal {hasIdentity = Prod.isMutable args,
+                                     ty = PointerRep.componentsTy pr}) :: ac
+            | _ => ac))
       val objectTypes = ref objectTypes
       val () =
-	 List.foreach (!delayedObjectTypes, fn f =>
-		       Option.app (f (), fn z => List.push (objectTypes, z)))
+         List.foreach (!delayedObjectTypes, fn f =>
+                       Option.app (f (), fn z => List.push (objectTypes, z)))
       val objectTypes = Vector.fromList (!objectTypes)
       fun diagnostic () =
-	 Control.diagnostics
-	 (fn display =>
-	  (display (Layout.str "Representations:")
-	   ; (Vector.foreach
-	      (datatypes, fn {cons, tycon, ...} =>
-	       let
-		  open Layout
-	       in
-		  display (seq [Tycon.layout tycon,
-				str " ", TyconRep.layout (tyconRep tycon)])
-		  ; display (indent
-			     (Vector.layout
-			      (fn {con, ...} =>
-			       record [("con", Con.layout con),
-				       ("rep", ConRep.layout (conRep con))])
-			      cons,
-			      2))
-	       end))))
+         Control.diagnostics
+         (fn display =>
+          (display (Layout.str "Representations:")
+           ; (Vector.foreach
+              (datatypes, fn {cons, tycon, ...} =>
+               let
+                  open Layout
+               in
+                  display (seq [Tycon.layout tycon,
+                                str " ", TyconRep.layout (tyconRep tycon)])
+                  ; display (indent
+                             (Vector.layout
+                              (fn {con, ...} =>
+                               record [("con", Con.layout con),
+                                       ("rep", ConRep.layout (conRep con))])
+                              cons,
+                              2))
+               end))))
       fun toRtype (t: S.Type.t): Type.t option =
-	 let
-	    val ty = Rep.ty (Value.get (typeRep t))
-	 in
-	    if Type.isUnit ty
-	       then NONE
-	    else SOME (Type.padToPrim ty)
-	 end
+         let
+            val ty = Rep.ty (Value.get (typeRep t))
+         in
+            if Type.isUnit ty
+               then NONE
+            else SOME (Type.padToPrim ty)
+         end
       fun makeSrc (v, oper) {index} = oper (Vector.sub (v, index))
       fun genCase {cases, default, test, tycon} =
-	 TyconRep.genCase (tyconRep tycon,
-			   {cases = cases,
-			    conRep = conRep,
-			    default = default,
-			    test = test})
+         TyconRep.genCase (tyconRep tycon,
+                           {cases = cases,
+                            conRep = conRep,
+                            default = default,
+                            test = test})
       val tupleRep = Value.get o tupleRep
       val tupleRep =
-	 Trace.trace ("tupleRep", S.Type.layout, TupleRep.layout) tupleRep
+         Trace.trace 
+         ("PackedRepresentation.tupleRep", 
+          S.Type.layout, TupleRep.layout) 
+         tupleRep
       fun object {args, con, dst, objectTy, oper} =
-	 let
-	    val src = makeSrc (args, oper)
-	 in
-	    case con of
-	       NONE => TupleRep.tuple (tupleRep objectTy, {dst = dst, src = src})
-	     | SOME con => ConRep.conApp (conRep con, {dst = dst, src = src})
-	 end
+         let
+            val src = makeSrc (args, oper)
+         in
+            case con of
+               NONE => TupleRep.tuple (tupleRep objectTy, {dst = dst, src = src})
+             | SOME con => ConRep.conApp (conRep con, {dst = dst, src = src})
+         end
       fun getSelects (con, objectTy) =
-	 let
-	    datatype z = datatype ObjectCon.t
-	 in
-	    case con of
-	       Con con =>
-		  (case conRep con of
-		      ConRep.ShiftAndTag {selects, ...} => (selects, NONE)
-		    | ConRep.Tuple tr => (TupleRep.selects tr, NONE)
-		    | _ => Error.bug "can't get con selects")
-	     | Tuple => (TupleRep.selects (tupleRep objectTy), NONE)
-	     | Vector =>
-		  case vectorRep objectTy of
-		     tr as TupleRep.Indirect pr =>
-			(TupleRep.selects tr,
-			 SOME (Type.bytes (PointerRep.componentsTy pr)))
-		   | _ => Error.bug "Vector not Indirect"
-	 end
+         let
+            datatype z = datatype ObjectCon.t
+         in
+            case con of
+               Con con =>
+                  (case conRep con of
+                      ConRep.ShiftAndTag {selects, ...} => (selects, NONE)
+                    | ConRep.Tuple tr => (TupleRep.selects tr, NONE)
+                    | _ => Error.bug "PackedRepresentation.getSelects: Con,non-select")
+             | Tuple => (TupleRep.selects (tupleRep objectTy), NONE)
+             | Vector =>
+                  case vectorRep objectTy of
+                     tr as TupleRep.Indirect pr =>
+                        (TupleRep.selects tr,
+                         SOME (Type.bytes (PointerRep.componentsTy pr)))
+                   | _ => Error.bug "PackedRepresentation.getSelects: Vector,non-Indirect"
+         end
       fun select {base, baseTy, dst, offset} =
-	 case S.Type.dest baseTy of
-	    S.Type.Object {con, ...} =>
-	       let
-		  val (ss, eltWidth) = getSelects (con, baseTy)
-	       in
-		  Selects.select
-		  (ss, {base = base,
-			eltWidth = eltWidth,
-			dst = dst,
-			offset = offset})
-	       end
-	  | _ => Error.bug "select of non object"
+         case S.Type.dest baseTy of
+            S.Type.Object {con, ...} =>
+               let
+                  val (ss, eltWidth) = getSelects (con, baseTy)
+               in
+                  Selects.select
+                  (ss, {base = base,
+                        eltWidth = eltWidth,
+                        dst = dst,
+                        offset = offset})
+               end
+          | _ => Error.bug "PackedRepresentation.select: non-object"
       fun update {base, baseTy, offset, value} =
-	 case S.Type.dest baseTy of
-	    S.Type.Object {con, ...} =>
-	       let
-		  val (ss, eltWidth) = getSelects (con, baseTy)
-	       in
-		  Selects.update (ss, {base = base,
-				       eltWidth = eltWidth,
-				       offset = offset,
-				       value = value})
-	       end
-	  | _ => Error.bug "update of non object"
+         case S.Type.dest baseTy of
+            S.Type.Object {con, ...} =>
+               let
+                  val (ss, eltWidth) = getSelects (con, baseTy)
+               in
+                  Selects.update (ss, {base = base,
+                                       eltWidth = eltWidth,
+                                       offset = offset,
+                                       value = value})
+               end
+          | _ => Error.bug "PackedRepresentation.update: non-object"
    in
       {diagnostic = diagnostic,
        genCase = genCase,

Modified: mlton/branches/on-20050420-cmm-branch/mlton/backend/parallel-move.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/backend/parallel-move.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/backend/parallel-move.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 functor ParallelMove (S: PARALLEL_MOVE_STRUCTS): PARALLEL_MOVE = 
 struct
 
@@ -14,46 +15,46 @@
    : 'statement list =
    let
       val mvs =
-	 List.fold (moves, [], fn (mv as {src, dst}, mvs) =>
-		   if equals (src, dst)
-		      then mvs
-		   else mv :: mvs)
+         List.fold (moves, [], fn (mv as {src, dst}, mvs) =>
+                   if equals (src, dst)
+                      then mvs
+                   else mv :: mvs)
       fun loopTop (mvs, moves) = loop (mvs, [], moves, false)
       and loop (mvs, hard, moves, changed) =
-	 case mvs of
-	    [] =>
-	       (case hard of
-		   [] => List.rev moves
-		 | {src, dst} :: hard' => 
-		      if changed
-			 then loopTop (hard, moves)
-		      else
-			 let
-			    val (hard, moves) =
-			       List.fold
-			       (hard', ([], moves),
-				fn (mv as {src = s, dst = d}, (hard, moves)) =>
-				if interfere (dst, s)
-				   then let val temp = temp s
-					in ({src = temp, dst = d} :: hard,
-					    move {dst = temp, src = s}
-					    :: moves)
-					end
-				else (mv :: hard, moves))
-			    val moves = move {src = src, dst = dst} :: moves
-			 in loopTop (hard, moves)
-			 end)
-	  | (mv as {src, dst}) :: mvs =>
-	       let
-		  fun isHard l =
-		     List.exists (l, fn {src, dst = _} =>
-				 interfere (dst, src))
-	       in if isHard mvs orelse isHard hard
-		     then loop (mvs, mv :: hard, moves, changed)
-		  else loop (mvs, hard,
-			    move {src = src, dst = dst} :: moves,
-			    true)
-	       end
+         case mvs of
+            [] =>
+               (case hard of
+                   [] => List.rev moves
+                 | {src, dst} :: hard' => 
+                      if changed
+                         then loopTop (hard, moves)
+                      else
+                         let
+                            val (hard, moves) =
+                               List.fold
+                               (hard', ([], moves),
+                                fn (mv as {src = s, dst = d}, (hard, moves)) =>
+                                if interfere (dst, s)
+                                   then let val temp = temp s
+                                        in ({src = temp, dst = d} :: hard,
+                                            move {dst = temp, src = s}
+                                            :: moves)
+                                        end
+                                else (mv :: hard, moves))
+                            val moves = move {src = src, dst = dst} :: moves
+                         in loopTop (hard, moves)
+                         end)
+          | (mv as {src, dst}) :: mvs =>
+               let
+                  fun isHard l =
+                     List.exists (l, fn {src, dst = _} =>
+                                 interfere (dst, src))
+               in if isHard mvs orelse isHard hard
+                     then loop (mvs, mv :: hard, moves, changed)
+                  else loop (mvs, hard,
+                            move {src = src, dst = dst} :: moves,
+                            true)
+               end
    in loopTop (mvs, [])
    end
 

Modified: mlton/branches/on-20050420-cmm-branch/mlton/backend/parallel-move.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/backend/parallel-move.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/backend/parallel-move.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature PARALLEL_MOVE_STRUCTS = 
    sig
    end
@@ -17,16 +18,16 @@
        * Hence, has to be careful to use temps.
        *)
       val move:
-	 {
-	  (* Are two registers the same. *)
-	  equals: 'register * 'register -> bool,
-	  (* How to create a move statement. *)
-	  move: {src: 'register, dst: 'register} -> 'statement,
-	  (* The moves to occur. *)
-	  moves: {src: 'register, dst: 'register} list,
-	  (* Would writing the write invalidate the read? *)
-	  interfere: 'register * 'register -> bool,
-	  (* Return a new temporary register like input register. *)
-	  temp: 'register -> 'register
-	 } -> 'statement list
+         {
+          (* Are two registers the same. *)
+          equals: 'register * 'register -> bool,
+          (* How to create a move statement. *)
+          move: {src: 'register, dst: 'register} -> 'statement,
+          (* The moves to occur. *)
+          moves: {src: 'register, dst: 'register} list,
+          (* Would writing the write invalidate the read? *)
+          interfere: 'register * 'register -> bool,
+          (* Return a new temporary register like input register. *)
+          temp: 'register -> 'register
+         } -> 'statement list
    end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/backend/pointer-tycon.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/backend/pointer-tycon.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/backend/pointer-tycon.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,8 +1,8 @@
-(* Copyright (C) 2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 2004-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 functor PointerTycon (S: POINTER_TYCON_STRUCTS): POINTER_TYCON =
@@ -52,7 +52,7 @@
 in
    fun wordVector (b: Bits.t): t =
       case Bits.toInt b of
-	 8 => word8Vector
+         8 => word8Vector
        | 16 => word16Vector
        | 32 => word32Vector
        | _ => Error.bug "PointerTycon.wordVector"

Modified: mlton/branches/on-20050420-cmm-branch/mlton/backend/pointer-tycon.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/backend/pointer-tycon.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/backend/pointer-tycon.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,8 +1,8 @@
-(* Copyright (C) 2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 2004-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 type int = Int.t
@@ -14,7 +14,7 @@
 signature POINTER_TYCON =
    sig
       include POINTER_TYCON_STRUCTS
-	 
+         
       type t
 
       val <= : t * t -> bool

Modified: mlton/branches/on-20050420-cmm-branch/mlton/backend/profile.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/backend/profile.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/backend/profile.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,10 @@
+(* Copyright (C) 2002-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 functor Profile (S: PROFILE_STRUCTS): PROFILE = 
 struct
 
@@ -9,40 +16,40 @@
       open CFunction
 
       local
-	 open Type
+         open Type
       in
-	 val gcState = gcState
-	 val Word32 = word (Bits.fromInt 32)
-	 val unit = unit
+         val gcState = gcState
+         val Word32 = word (Bits.fromInt 32)
+         val unit = unit
       end
 
       local
-	 fun make {args, name, prototype} =
-	    T {args = args,
-	       bytesNeeded = NONE,
-	       convention = Convention.Cdecl,
-	       ensuresBytesFree = false,
-	       mayGC = false,
-	       maySwitchThreads = false,
-	       modifiesFrontier = false,
-	       prototype = (prototype, NONE),
-	       readsStackTop = true,
-	       return = unit,
-	       target = Target.Direct name,
-	       writesStackTop = false}
+         fun make {args, name, prototype} =
+            T {args = args,
+               bytesNeeded = NONE,
+               convention = Convention.Cdecl,
+               ensuresBytesFree = false,
+               mayGC = false,
+               maySwitchThreads = false,
+               modifiesFrontier = false,
+               prototype = (prototype, NONE),
+               readsStackTop = true,
+               return = unit,
+               target = Target.Direct name,
+               writesStackTop = false}
       in
-	 val profileEnter =
-	    make {args = Vector.new1 gcState,
-		  name = "GC_profileEnter",
-		  prototype = Vector.new1 CType.Pointer}
-	 val profileInc =
-	    make {args = Vector.new2 (gcState, Word32),
-		  name = "GC_profileInc",
-		  prototype = Vector.new2 (CType.Pointer, CType.Word32)}
-	 val profileLeave =
-	    make {args = Vector.new1 gcState,
-		  name = "GC_profileLeave",
-		  prototype = Vector.new1 CType.Pointer}
+         val profileEnter =
+            make {args = Vector.new1 gcState,
+                  name = "GC_profileEnter",
+                  prototype = Vector.new1 CType.Pointer}
+         val profileInc =
+            make {args = Vector.new2 (gcState, Word32),
+                  name = "GC_profileInc",
+                  prototype = Vector.new2 (CType.Pointer, CType.Word32)}
+         val profileLeave =
+            make {args = Vector.new1 gcState,
+                  name = "GC_profileLeave",
+                  prototype = Vector.new1 CType.Pointer}
       end
    end
 
@@ -51,84 +58,84 @@
 structure InfoNode =
    struct
       datatype t = T of {info: SourceInfo.t,
-			 nameIndex: int,
-			 sourcesIndex: int,
-			 successors: t list ref}
+                         nameIndex: int,
+                         sourcesIndex: int,
+                         successors: t list ref}
 
       local
-	 fun make f (T r) = f r
+         fun make f (T r) = f r
       in
-	 val info = make #info
-	 val sourcesIndex = make #sourcesIndex
+         val info = make #info
+         val sourcesIndex = make #sourcesIndex
       end
 
       fun layout (T {info, ...}) =
-	 Layout.record [("info", SourceInfo.layout info)]
+         Layout.record [("info", SourceInfo.layout info)]
 
       fun equals (n: t, n': t): bool = SourceInfo.equals (info n, info n')
 
       fun call {from = T {successors, ...},
-		to as T {info = i', ...}} =
-	 if let
-	       open SourceInfo
-	    in
-	       equals (i', gc)
-	       orelse equals (i', main)
-	       orelse equals (i', unknown)
-	    end orelse List.exists (!successors, fn n => equals (n, to))
-	    then ()
-	 else List.push (successors, to)
+                to as T {info = i', ...}} =
+         if let
+               open SourceInfo
+            in
+               equals (i', gc)
+               orelse equals (i', main)
+               orelse equals (i', unknown)
+            end orelse List.exists (!successors, fn n => equals (n, to))
+            then ()
+         else List.push (successors, to)
 
       val call =
-	 Trace.trace ("InfoNode.call",
-		      fn {from, to} =>
-		      Layout.record [("from", layout from),
-				     ("to", layout to)],
-		      Unit.layout)
-	 call
+         Trace.trace ("Profile.InfoNode.call",
+                      fn {from, to} =>
+                      Layout.record [("from", layout from),
+                                     ("to", layout to)],
+                      Unit.layout)
+         call
    end
 
 structure FuncInfo =
    struct
       datatype t = T of {callers: InfoNode.t list ref,
-			 enters: InfoNode.t list ref,
-			 seen: bool ref,
-			 tailCalls: t list ref}
+                         enters: InfoNode.t list ref,
+                         seen: bool ref,
+                         tailCalls: t list ref}
 
       fun new () = T {callers = ref [],
-		      enters = ref [],
-		      seen = ref false,
-		      tailCalls = ref []}
+                      enters = ref [],
+                      seen = ref false,
+                      tailCalls = ref []}
    end
 
 structure Push =
    struct
       datatype t =
-	 Enter of InfoNode.t
+         Enter of InfoNode.t
        | Skip of SourceInfo.t
 
       fun layout z =
-	 let
-	    open Layout
-	 in
-	    case z of
-	       Enter n => seq [str "Enter ", InfoNode.layout n]
-	     | Skip i => seq [str "Skip ", SourceInfo.layout i]
-	 end
+         let
+            open Layout
+         in
+            case z of
+               Enter n => seq [str "Enter ", InfoNode.layout n]
+             | Skip i => seq [str "Skip ", SourceInfo.layout i]
+         end
 
       fun toSources (ps: t list): int list =
-	 List.fold (rev ps, [], fn (p, ac) =>
-		    case p of
-		       Enter (InfoNode.T {sourcesIndex, ...}) =>
-			  sourcesIndex :: ac
-		     | Skip _ => ac)
+         List.fold (rev ps, [], fn (p, ac) =>
+                    case p of
+                       Enter (InfoNode.T {sourcesIndex, ...}) =>
+                          sourcesIndex :: ac
+                     | Skip _ => ac)
    end
 
 val traceEnter =
    Trace.trace2 ("Profile.enter",
-		 List.layout Push.layout,
-		 SourceInfo.layout,
-		 Layout.tuple2 (List.layout Push.layout, Bool.layout))
+                 List.layout Push.layout,
+                 SourceInfo.layout,
+                 Layout.tuple2 (List.layout Push.layout, Bool.layout))
 
 fun profile program =
    if !Control.profile = Control.ProfileNone
@@ -140,735 +147,796 @@
       datatype z = datatype Control.profile
       val profile = !Control.profile
       val profileStack: bool = !Control.profileStack
+      val needProfileLabels: bool =
+         profile = ProfileTimeLabel orelse profile = ProfileLabel
+      val needCodeCoverage: bool =
+         needProfileLabels orelse (profile = ProfileTimeField)
       val frameProfileIndices: (Label.t * int) list ref = ref []
       val infoNodes: InfoNode.t list ref = ref []
       val nameCounter = Counter.new 0
       val names: string list ref = ref []
       local
-	 val sourceCounter = Counter.new 0
-	 val sep =
-	    if profile = ProfileCallStack orelse profile = ProfileMark
-	       then " "
-	    else "\t"
-	 val {get = nameIndex, ...} =
-	    Property.get (SourceInfo.plist,
-			  Property.initFun
-			  (fn si =>
-			   (List.push (names, SourceInfo.toString' (si, sep))
-			    ; Counter.next nameCounter)))
-      in	 
-	 fun sourceInfoNode (si: SourceInfo.t) =
-	    let
-	       val infoNode =
-		  InfoNode.T {info = si,
-			      nameIndex = nameIndex si,
-			      sourcesIndex = Counter.next sourceCounter,
-			      successors = ref []}
-	       val _ = List.push (infoNodes, infoNode)
-	    in
-	       infoNode
-	    end
+         val sourceCounter = Counter.new 0
+         val sep =
+            if profile = ProfileCallStack
+               then " "
+            else "\t"
+         val {get = nameIndex, ...} =
+            Property.get (SourceInfo.plist,
+                          Property.initFun
+                          (fn si =>
+                           (List.push (names, SourceInfo.toString' (si, sep))
+                            ; Counter.next nameCounter)))
+      in         
+         fun sourceInfoNode (si: SourceInfo.t) =
+            let
+               val infoNode =
+                  InfoNode.T {info = si,
+                              nameIndex = nameIndex si,
+                              sourcesIndex = Counter.next sourceCounter,
+                              successors = ref []}
+               val _ = List.push (infoNodes, infoNode)
+            in
+               infoNode
+            end
       end
       fun firstEnter (ps: Push.t list): InfoNode.t option =
-	 List.peekMap (ps, fn p =>
-		       case p of
-			  Push.Enter n => SOME n
-			| _ => NONE)
+         List.peekMap (ps, fn p =>
+                       case p of
+                          Push.Enter n => SOME n
+                        | _ => NONE)
       (* unknown must be 0, which == SOURCES_INDEX_UNKNOWN from gc.h *)
       val unknownInfoNode = sourceInfoNode SourceInfo.unknown
       (* gc must be 1 which == SOURCES_INDEX_GC from gc.h *)
       val gcInfoNode = sourceInfoNode SourceInfo.gc
       val mainInfoNode = sourceInfoNode SourceInfo.main
+      fun wantedSource (si: SourceInfo.t): bool =
+         if SourceInfo.isC si
+            then List.length (!Control.profileC) > 0
+            else (case SourceInfo.file si of
+                     NONE => true
+                   | SOME file =>
+                        List.foldr
+                        (!Control.profileInclExcl, true, 
+                         fn ((re, keep), b) =>
+                         if Regexp.Compiled.matchesAll (re, file)
+                            then keep
+                            else b))
+      val wantedSource =
+         Trace.trace ("Profile.wantedSource", SourceInfo.layout, Bool.layout)
+         wantedSource
+      fun wantedCSource (si: SourceInfo.t): bool =
+         wantedSource si
+         andalso
+         if SourceInfo.isC si
+            then false
+            else (case SourceInfo.file si of
+                     NONE => false
+                   | SOME file => 
+                        List.foldr
+                        (!Control.profileC, false,
+                         fn (re, b) =>
+                         if Regexp.Compiled.matchesAll (re, file)
+                            then true
+                            else b))
+      val wantedCSource =
+         Trace.trace ("Profile.wantedCSource", SourceInfo.layout, Bool.layout)
+         wantedCSource
       fun keepSource (si: SourceInfo.t): bool =
-	 !Control.profileBasis
-	 orelse profile <> ProfileCount
-	 orelse not (SourceInfo.isBasis si orelse SourceInfo.isC si)
+         profile <> ProfileCount
+         orelse wantedSource si
+      val keepSource =
+         Trace.trace ("Profile.keepSource", SourceInfo.layout, Bool.layout)
+         keepSource
       (* With -profile count, we want to get zero counts for all functions,
        * whether or not they made it into the final executable.
        *)
       val () =
-	 case profile of
-	    ProfileCount =>
-	       List.foreach (SourceInfo.all (), fn si =>
-			     if keepSource si
-				then ignore (sourceInfoNode si)
-			     else ())
-	  | _ => ()
+         case profile of
+            ProfileCount =>
+               List.foreach (SourceInfo.all (), fn si =>
+                             if wantedSource si
+                                then ignore (sourceInfoNode si)
+                             else ())
+          | _ => ()
       val sourceInfoNode =
-	 fn si =>
-	 let
-	    open SourceInfo
-	 in
-	    if equals (si, unknown)
-	       then unknownInfoNode
-	    else if equals (si, gc)
-		    then gcInfoNode
-		 else if equals (si, main)
-			 then mainInfoNode
-		      else sourceInfoNode si
-	 end
+         fn si =>
+         let
+            open SourceInfo
+         in
+            if equals (si, unknown)
+               then unknownInfoNode
+            else if equals (si, gc)
+               then gcInfoNode
+            else if equals (si, main)
+               then mainInfoNode
+            else sourceInfoNode si
+         end
       val sourceInfoNode =
-	 Trace.trace ("sourceInfoNode", SourceInfo.layout, InfoNode.layout)
-	 sourceInfoNode
+         Trace.trace ("Profile.sourceInfoNode", SourceInfo.layout, InfoNode.layout)
+         sourceInfoNode
       local
-	 val table: {hash: word,
-		     index: int,
-		     sourceSeq: int vector} HashSet.t =
-	    HashSet.new {hash = #hash}
-	 val c = Counter.new 0
-	 val sourceSeqs: int vector list ref = ref []
+         val table: {hash: word,
+                     index: int,
+                     sourceSeq: int vector} HashSet.t =
+            HashSet.new {hash = #hash}
+         val c = Counter.new 0
+         val sourceSeqs: int vector list ref = ref []
       in
-	 fun sourceSeqIndex (s: sourceSeq): int =
-	    let
-	       val s = Vector.fromListRev s
-	       val hash =
-		  Vector.fold (s, 0w0, fn (i, w) =>
-			       w * 0w31 + Word.fromInt i)
-	    in
-	       #index
-	       (HashSet.lookupOrInsert
-		(table, hash,
-		 fn {sourceSeq = s', ...} => s = s',
-		 fn () => let
-			     val _ = List.push (sourceSeqs, s)
-			  in
-			     {hash = hash,
-			      index = Counter.next c,
-			      sourceSeq = s}
-			  end))
-	    end
-	 fun makeSourceSeqs () = Vector.fromListRev (!sourceSeqs)
+         fun sourceSeqIndex (s: sourceSeq): int =
+            let
+               val s = Vector.fromListRev s
+               val hash =
+                  Vector.fold (s, 0w0, fn (i, w) =>
+                               w * 0w31 + Word.fromInt i)
+            in
+               #index
+               (HashSet.lookupOrInsert
+                (table, hash,
+                 fn {sourceSeq = s', ...} => s = s',
+                 fn () => let
+                             val _ = List.push (sourceSeqs, s)
+                          in
+                             {hash = hash,
+                              index = Counter.next c,
+                              sourceSeq = s}
+                          end))
+            end
+         fun makeSourceSeqs () = Vector.fromListRev (!sourceSeqs)
       end
       (* Ensure that [SourceInfo.unknown] is index 0. *)
       val _ = sourceSeqIndex [InfoNode.sourcesIndex unknownInfoNode]
       (* Ensure that [SourceInfo.gc] is index 1. *)
       val _ = sourceSeqIndex [InfoNode.sourcesIndex gcInfoNode]
       fun addFrameProfileIndex (label: Label.t,
-				index: int): unit =
-	 List.push (frameProfileIndices, (label, index))
+                                index: int): unit =
+         List.push (frameProfileIndices, (label, index))
       fun addFrameProfilePushes (label: Label.t,
-				 pushes: Push.t list): unit =
-	 addFrameProfileIndex (label,
-			       sourceSeqIndex (Push.toSources pushes))
+                                 pushes: Push.t list): unit =
+         addFrameProfileIndex (label,
+                               sourceSeqIndex (Push.toSources pushes))
       val {get = labelInfo: Label.t -> {block: Block.t,
-					visited1: bool ref,
-					visited2: bool ref},
-	   set = setLabelInfo, ...} =
-	 Property.getSetOnce
-	 (Label.plist, Property.initRaise ("info", Label.layout))
+                                        visited1: bool ref,
+                                        visited2: bool ref},
+           set = setLabelInfo, ...} =
+         Property.getSetOnce
+         (Label.plist, Property.initRaise ("info", Label.layout))
       val labels = ref []
-      fun profileLabelIndex (sourceSeqsIndex: int): Statement.t =
-	 let
-	    val l = ProfileLabel.new ()
-	    val _ = List.push (labels, {label = l,
-					sourceSeqsIndex = sourceSeqsIndex})
-	 in
-	    Statement.ProfileLabel l
-	 end
-      fun profileLabel (sourceSeq: int list): Statement.t =
-	 profileLabelIndex (sourceSeqIndex sourceSeq)
+      fun profileLabelFromIndex (sourceSeqsIndex: int): Statement.t =
+         let
+            val l = ProfileLabel.new ()
+            val _ = List.push (labels, {label = l,
+                                        sourceSeqsIndex = sourceSeqsIndex})
+         in
+            Statement.ProfileLabel l
+         end
+      fun setCurSourceSeqsIndexFromIndex (sourceSeqsIndex: int): Statement.t =
+         let
+            val curSourceSeqsIndex = 
+               Operand.Runtime Runtime.GCField.CurSourceSeqsIndex
+         in
+            Statement.Move
+            {dst = curSourceSeqsIndex,
+             src = Operand.word (WordX.fromIntInf 
+                                 (IntInf.fromInt sourceSeqsIndex,
+                                  WordSize.default))}
+         end
+      fun codeCoverageStatementFromIndex (sourceSeqsIndex: int): Statement.t =
+         if needProfileLabels
+            then profileLabelFromIndex sourceSeqsIndex
+         else if profile = ProfileTimeField
+            then setCurSourceSeqsIndexFromIndex sourceSeqsIndex
+         else Error.bug "Profile.codeCoverageStatement"
+      fun codeCoverageStatement (sourceSeq: int list): Statement.t =
+         codeCoverageStatementFromIndex (sourceSeqIndex sourceSeq)
       local
-	 val {get: Func.t -> FuncInfo.t, ...} =
-	    Property.get (Func.plist, Property.initFun (fn _ => FuncInfo.new ()))
+         val {get: Func.t -> FuncInfo.t, ...} =
+            Property.get (Func.plist, Property.initFun (fn _ => FuncInfo.new ()))
       in
-	 val funcInfo = get
-	 fun addFuncEdges () =
-	    (* Don't need to add edges for main because no one calls it. *)
-	    List.foreach
-	    (functions, fn f =>
-	     let
-		val allSeen: bool ref list ref = ref []
-		val func = Function.name f
-		val fi as FuncInfo.T {callers, ...} = get func
-		(* Add edges from all the callers to the enters in f and all
-		 * functions that f tail calls.
-		 *)
-		fun call (FuncInfo.T {enters, seen, tailCalls, ...}): unit =
-		   if !seen
-		      then ()
-		   else
-		      let
-			 val _ = seen := true
-			 val _ = List.push (allSeen, seen)
-			 val _ = 
-			    List.foreach
-			    (!callers, fn from =>
-			     List.foreach
-			     (!enters, fn to =>
-			      InfoNode.call {from = from, to = to}))
-		      in
-			 List.foreach (!tailCalls, call)
-		      end
-		val _ = call fi
-		val _ = List.foreach (!allSeen, fn r => r := false)
-	     in
-		()
-	     end)
+         val funcInfo = get
+         fun addFuncEdges () =
+            (* Don't need to add edges for main because no one calls it. *)
+            List.foreach
+            (functions, fn f =>
+             let
+                val allSeen: bool ref list ref = ref []
+                val func = Function.name f
+                val fi as FuncInfo.T {callers, ...} = get func
+                (* Add edges from all the callers to the enters in f and all
+                 * functions that f tail calls.
+                 *)
+                fun call (FuncInfo.T {enters, seen, tailCalls, ...}): unit =
+                   if !seen
+                      then ()
+                   else
+                      let
+                         val _ = seen := true
+                         val _ = List.push (allSeen, seen)
+                         val _ = 
+                            List.foreach
+                            (!callers, fn from =>
+                             List.foreach
+                             (!enters, fn to =>
+                              InfoNode.call {from = from, to = to}))
+                      in
+                         List.foreach (!tailCalls, call)
+                      end
+                val _ = call fi
+                val _ = List.foreach (!allSeen, fn r => r := false)
+             in
+                ()
+             end)
       end
       fun doFunction (f: Function.t): Function.t =
-	 let
-	    val {args, blocks, name, raises, returns, start} = Function.dest f
-	    val _ =
-	       if not debug
-		  then ()
-	       else print (concat ["doFunction ", Func.toString name, "\n"])
-	    val FuncInfo.T {enters, tailCalls, ...} = funcInfo name
-	    fun enter (ps: Push.t list, si: SourceInfo.t): Push.t list * bool =
-	       let
-		  val node = Promise.lazy (fn () => sourceInfoNode si)
-		  fun yes () = (Push.Enter (node ()) :: ps, true)
-		  fun no () = (Push.Skip si :: ps, false)
-	       in
-		  if SourceInfo.equals (si, SourceInfo.unknown)
-		     then no ()
-		  else
-		     case firstEnter ps of
-			NONE =>
-			   if keepSource si
-			      then (List.push (enters, node ())
-				    ; yes ())
-			   else no ()
-		      | SOME (node' as InfoNode.T {info = si', ...}) =>
-			   if keepSource si andalso
-			      let
-				 open SourceInfo
-			      in
-				 (!Control.profileBasis)
-				 orelse (equals (si', unknown))
-				 orelse
-				 (not
-				  (equals (si, gcArrayAllocate)
-				   orelse isBasis si
-				   orelse (isC si
-					   andalso (isBasis si'
-						    orelse equals (si', main)))))
-			      end
-			      then (InfoNode.call {from = node', to = node ()}
-				    ; yes ())
-			   else no ()
-	       end
-	    val enter = traceEnter enter
-	    val _ =
-	       Vector.foreach
-	       (blocks, fn block as Block.T {label, ...} =>
-		setLabelInfo (label, {block = block,
-				      visited1 = ref false,
-				      visited2 = ref false}))
-	    (* Find the first Enter statement and (conceptually) move it to the
-	     * front of the function.
-	     *)
-	    local
-	       exception Yes of Label.t * Statement.t
-	       fun goto l =
-		  let
-		     val {block, visited1, ...} = labelInfo l
-		  in
-		     if !visited1
-			then ()
-		     else
-			let
-			   val () = visited1 := true
-			   val Block.T {statements, transfer, ...} = block
-			   val () =
-			      Vector.foreach
-			      (statements, fn s =>
-			       case s of
-				  Statement.Profile (ProfileExp.Enter _) =>
-				     raise Yes (l, s)
-				| _ => ())
-			   val () = Transfer.foreachLabel (transfer, goto)
-			in
-			   ()
-			end
-		  end
-	    in
-	       val first = (goto start; NONE) handle Yes z => SOME z
-	    end
-	    val blocks = ref []
-	    datatype z = datatype Statement.t
-	    datatype z = datatype ProfileExp.t
-	    fun backward {args,
-			  kind,
-			  label,
-			  leaves,
-			  sourceSeq: int list,
-			  statements: Statement.t list,
-			  transfer: Transfer.t}: unit =
-	       let
-		  val (_, npl, sourceSeq, statements) =
-		     List.fold
-		     (statements,
-		      (leaves, true, sourceSeq, []),
-		      fn (s, (leaves, npl, sourceSeq, ss)) =>
-		      case s of
-			 Object _ => (leaves, true, sourceSeq, s :: ss)
-		       | Profile ps =>
-			    let
-			       val (npl, ss) =
-				  if profile = ProfileTime 
-				     orelse profile = ProfileMark
-				     then
-					if npl
-					   andalso not (List.isEmpty sourceSeq)
-					   then (false,
-						 profileLabel sourceSeq :: ss)
-					else (true, ss)
-				  else (false, ss)
-			       val (leaves, sourceSeq) = 
-				  case ps of
-				     Enter _ =>
-					(case sourceSeq of
-					    [] => Error.bug "unmatched Enter"
-					  | _ :: sis => (leaves, sis))
-				   | Leave _ =>
-					(case leaves of
-					    [] => Error.bug "missing Leave"
-					  | infoNode :: leaves =>
-					       (leaves,
-						InfoNode.sourcesIndex infoNode
-						:: sourceSeq))
-			    in
-			       (leaves, npl, sourceSeq, ss)
-			    end
-		       | _ => (leaves, true, sourceSeq, s :: ss))
-		  val statements =
-		     if (profile = ProfileTime orelse profile = ProfileMark)
-			andalso npl
-			then profileLabel sourceSeq :: statements
-		     else statements
-		  val {args, kind, label} =
-		     if profileStack andalso (case kind of
-						 Kind.Cont _ => true
-					       | Kind.Handler => true
-					       | _ => false)
-			then
-			   let
-			      val func = CFunction.profileLeave
-			      val newLabel = Label.newNoname ()
-			      val _ =
-				 addFrameProfileIndex
-				 (newLabel, sourceSeqIndex sourceSeq)
-			      val statements =
-				 if profile = ProfileTime 
-				    orelse profile = ProfileMark
-				    then (Vector.new1
-					  (profileLabelIndex
-					   (sourceSeqIndex sourceSeq)))
-				 else Vector.new0 ()
-			      val _ =
-				 List.push
-				 (blocks,
-				  Block.T
-				  {args = args,
-				   kind = kind,
-				   label = label,
-				   statements = statements,
-				   transfer = 
-				   Transfer.CCall
-				   {args = Vector.new1 Operand.GCState,
-				    func = func,
-				    return = SOME newLabel}})
-			   in
-			      {args = Vector.new0 (),
-			       kind = Kind.CReturn {func = func},
-			       label = newLabel}
-			   end
-		     else
-			{args = args,
-			 kind = kind,
-			 label = label}
-	       in		       
-		  List.push (blocks,
-			     Block.T {args = args,
-				      kind = kind,
-				      label = label,
-				      statements = Vector.fromList statements,
-				      transfer = transfer})
-	       end
-	    val backward =
-	       Trace.trace
-	       ("Profile.backward",
-		fn {leaves, statements, sourceSeq, ...} =>
-		let
-		   open Layout
-		in
-		   record [("leaves", List.layout InfoNode.layout leaves),
-			   ("sourceSeq", List.layout Int.layout sourceSeq),
-			   ("statements",
-			    List.layout Statement.layout statements)]
-		end,
-		Unit.layout)
-	       backward
-	    fun profileEnter (pushes: Push.t list,
-			      transfer: Transfer.t): Transfer.t =
-	       let
-		  val func = CFunction.profileEnter
-		  val newLabel = Label.newNoname ()
-		  val index = sourceSeqIndex (Push.toSources pushes)
-		  val _ = addFrameProfileIndex (newLabel, index)
-		  val statements =
-		     if profile = ProfileTime orelse profile = ProfileMark
-			then Vector.new1 (profileLabelIndex index)
-		     else Vector.new0 ()
-		  val _ =
-		     List.push
-		     (blocks,
-		      Block.T {args = Vector.new0 (),
-			       kind = Kind.CReturn {func = func},
-			       label = newLabel,
-			       statements = statements,
-			       transfer = transfer})
-	       in
-		  Transfer.CCall {args = Vector.new1 Operand.GCState,
-				  func = func,
-				  return = SOME newLabel}
-	       end
-	    fun goto (l: Label.t, pushes: Push.t list): unit =
-	       let
-		  val _ =
-		     if not debug
-			then ()
-		     else
-		     let
-			open Layout
-		     in
-			outputl (seq [str "goto (",
-				      Label.layout l,
-				      str ", ",
-				      List.layout Push.layout pushes,
-				      str ")"],
-				 Out.error)
-		     end
-		  val {block, visited2, ...} = labelInfo l
-	       in
-		  if !visited2
-		     then ()
-		  else
-		     let
-			val _ = visited2 := true
-			val Block.T {args, kind, label, statements, transfer,
-				     ...} = block
-			val statements =
-			   case first of
-			      NONE => statements
-			    | SOME (firstLabel, firstEnter) =>
-				 if Label.equals (label, firstLabel)
-				    then
-				       Vector.removeFirst
-				       (statements, fn s =>
-					case s of
-					   Profile (Enter _) => true
-					 | _ => false)
-				 else if Label.equals (label, start)
-					 then
-					    Vector.concat
-					    [Vector.new1 firstEnter,
-					     statements]
-				      else statements
-			val _ =
-			   let
-			      fun add pushes =
-				 addFrameProfilePushes (label, pushes)
-			      datatype z = datatype Kind.t
-			   in
-			      case kind of
-				 Cont _ => add pushes
-			       | CReturn {func, ...} =>
-				    let
-				       datatype z = datatype CFunction.Target.t
-				       val target = CFunction.target func
-				       fun doit si =
-					  add (#1 (enter (pushes, si)))
-				    in
-				       case target of
-					  Direct "GC_gc" => doit SourceInfo.gc
-					| Direct "GC_arrayAllocate" =>
-					     doit SourceInfo.gcArrayAllocate
-					| Direct "MLton_bug" => add pushes
-					| Direct name => doit (SourceInfo.fromC name)
-					| Indirect => doit (SourceInfo.fromC "<indirect>")
-				    end
-			       | Handler => add pushes
-			       | Jump => ()
-			   end
-			fun maybeSplit {args,
-					bytesAllocated: Bytes.t,
-					kind,
-					label,
-					leaves,
-					pushes: Push.t list,
-					shouldSplit: bool,
-					statements} =
-			   if not shouldSplit
-			      then {args = args,
-				    bytesAllocated = Bytes.zero,
-				    kind = kind,
-				    label = label,
-				    leaves = leaves,
-				    statements = statements}
-			   else
-			      let
-				 val newLabel = Label.newNoname ()
-				 val _ =
-				    addFrameProfilePushes (newLabel, pushes)
-				 val func = CFunction.profileInc
-				 val bytesAllocated =
-				    case profile of
-				       ProfileAlloc => Bytes.toInt bytesAllocated
-				     | ProfileCount => 1
-				     | _ => Error.bug "imposible"
-				 val transfer =
-				    Transfer.CCall
-				    {args = (Vector.new2
-					     (Operand.GCState,
-					      Operand.word
-					      (WordX.fromIntInf
-					       (IntInf.fromInt bytesAllocated,
-						WordSize.default)))),
-				     func = func,
-				     return = SOME newLabel}
-				 val sourceSeq = Push.toSources pushes
-				 val _ =
-				    backward {args = args,
-					      kind = kind,
-					      label = label,
-					      leaves = leaves,
-					      sourceSeq = sourceSeq,
-					      statements = statements,
-					      transfer = transfer}
-			      in
-				 {args = Vector.new0 (),
-				  bytesAllocated = Bytes.zero,
-				  kind = Kind.CReturn {func = func},
-				  label = newLabel,
-				  leaves = [],
-				  statements = []}
-			      end
-			val {args, bytesAllocated, kind, label, leaves, pushes,
-			     statements} =
-			   Vector.fold
-			   (statements,
-			    {args = args,
-			     bytesAllocated = Bytes.zero,
-			     kind = kind,
-			     label = label,
-			     leaves = [],
-			     pushes = pushes,
-			     statements = []},
-			    fn (s, {args, bytesAllocated, kind, label,
-				    leaves,
-				    pushes: Push.t list,
-				    statements}) =>
-			    (if not debug
-				then ()
-			     else
-				let
-				   open Layout
-				in
-				   outputl
-				   (seq [List.layout Push.layout pushes,
-					 str " ",
-					 Statement.layout s],
-				    Out.error)
-				end
-			     ;
-			    case s of
-			       Object {size, ...} =>
-				  {args = args,
-				   bytesAllocated = Bytes.+ (bytesAllocated,
-							     Words.toBytes size),
-				   kind = kind,
-				   label = label,
-				   leaves = leaves,
-				   pushes = pushes,
-				   statements = s :: statements}
-			     | Profile ps =>
-				  let
-				     val shouldSplit =
-					profile = ProfileAlloc
-					andalso Bytes.> (bytesAllocated,
-							 Bytes.zero)
-				     val {args, bytesAllocated, kind, label,
-					  leaves, statements} =
-					maybeSplit
-					{args = args,
-					 bytesAllocated = bytesAllocated,
-					 kind = kind,
-					 label = label,
-					 leaves = leaves,
-					 pushes = pushes,
-					 shouldSplit = shouldSplit,
-					 statements = statements}
-				     datatype z = datatype ProfileExp.t
-				     val (pushes, keep, leaves) =
-					case ps of
-					   Enter si =>
-					      let
-						 val (pushes, keep) =
-						    enter (pushes, si)
-					      in
-						 (pushes, keep, leaves)
-					      end
-					 | Leave si =>
-					      (case pushes of
-						  [] =>
-						     Error.bug "unmatched Leave"
-						| p :: pushes =>
-						     let
-							val (keep, si', leaves) =
-							   case p of
-							      Push.Enter
-							      (infoNode as
-							       InfoNode.T
-							       {info, ...}) =>
-								 (true, info,
-								  infoNode :: leaves)
-							    | Push.Skip si' =>
-								 (false, si',
-								  leaves)
-						     in
-							if SourceInfo.equals (si, si')
-							   then (pushes,
-								 keep,
-								 leaves)
-							else Error.bug "mismatched Leave"
-						     end)
-				     val shouldSplit =
-					profile = ProfileCount
-					andalso (case ps of
-						    Enter _ => keep
-						  | _ => false)
-				     val {args, bytesAllocated, kind, label,
-					  leaves, statements} =
-					maybeSplit
-					{args = args,
-					 bytesAllocated = bytesAllocated,
-					 kind = kind,
-					 label = label,
-					 leaves = leaves,
-					 pushes = pushes,
-					 shouldSplit = shouldSplit,
-					 statements = statements}
-				     val statements =
-					if keep
-					   then s :: statements
-					else statements
-				  in
-				     {args = args,
-				      bytesAllocated = bytesAllocated,
-				      kind = kind,
-				      label = label,
-				      leaves = leaves,
-				      pushes = pushes,
-				      statements = statements}
-				  end
-			     | _ =>
-				  {args = args,
-				   bytesAllocated = bytesAllocated,
-				   kind = kind,
-				   label = label,
-				   leaves = leaves,
-				   pushes = pushes,
-				   statements = s :: statements})
-			    )
-			val shouldSplit =
-			   profile = ProfileAlloc
-			   andalso Bytes.> (bytesAllocated, Bytes.zero)
-			val {args, kind, label, leaves, statements, ...} =
-			   maybeSplit {args = args,
-				       bytesAllocated = bytesAllocated,
-				       kind = kind,
-				       label = label,
-				       leaves = leaves,
-				       pushes = pushes,
-				       shouldSplit = shouldSplit,
-				       statements = statements}
-			val _ =
-			   Transfer.foreachLabel
-			   (transfer, fn l => goto (l, pushes))
-			val transfer =
-			   case transfer of
-			      Transfer.Call {func, return, ...} =>
-				 let
-				    val fi as FuncInfo.T {callers, ...} =
-				       funcInfo func
-				 in
-				    case return of
-				       Return.NonTail _ =>
-					  let
-					     val _ =
-						case firstEnter pushes of
-						   NONE =>
-						      List.push (tailCalls, fi)
-						 | SOME n => 
-						      List.push (callers, n)
-					  in
-					     if profileStack
-						then profileEnter (pushes,
-								   transfer)
-					     else transfer
-					  end
-				     | _ =>
-					  (List.push (tailCalls, fi)
-					   ; transfer)
-				 end
-			    | _ => transfer
-		     in
-			backward {args = args,
-				  kind = kind,
-				  label = label,
-				  leaves = leaves,
-				  sourceSeq = Push.toSources pushes,
-				  statements = statements,
-				  transfer = transfer}
-		     end
-	       end
-	    val _ = goto (start, [])
-	    val blocks = Vector.fromList (!blocks)
-	 in
-	    Function.new {args = args,
-			  blocks = blocks,
-			  name = name,
-			  raises = raises,
-			  returns = returns,
-			  start = start}
-	 end
+         let
+            val {args, blocks, name, raises, returns, start} = Function.dest f
+            val _ =
+               if not debug
+                  then ()
+               else print (concat ["doFunction ", Func.toString name, "\n"])
+            val FuncInfo.T {enters, tailCalls, ...} = funcInfo name
+            fun enter (ps: Push.t list, si: SourceInfo.t): Push.t list * bool =
+               let
+                  val node = Promise.lazy (fn () => sourceInfoNode si)
+                  fun yes () = (Push.Enter (node ()) :: ps, true)
+                  fun no () = (Push.Skip si :: ps, false)
+               in
+                  if SourceInfo.equals (si, SourceInfo.unknown)
+                     then no ()
+                  else
+                     case firstEnter ps of
+                        NONE =>
+                           if keepSource si
+                              then (List.push (enters, node ())
+                                    ; yes ())
+                           else no ()
+                      | SOME (node' as InfoNode.T {info = si', ...}) =>
+                           (* 
+                            * si  : callee
+                            * si' : caller
+                            *)
+                           if keepSource si
+                              andalso
+                              let
+                                 open SourceInfo
+                              in
+                                 equals (si', unknown)
+                                 orelse
+                                 (wantedSource si
+                                  andalso
+                                  not (equals (si, gcArrayAllocate))
+                                  andalso
+                                  (not (isC si)
+                                   orelse
+                                   (wantedCSource si'
+                                    andalso not (equals (si', main)))))
+                              end 
+                              then (InfoNode.call {from = node', to = node ()}
+                                    ; yes ())
+                           else no ()
+               end
+            val enter = traceEnter enter
+            val _ =
+               Vector.foreach
+               (blocks, fn block as Block.T {label, ...} =>
+                setLabelInfo (label, {block = block,
+                                      visited1 = ref false,
+                                      visited2 = ref false}))
+            (* Find the first Enter statement and (conceptually) move it to the
+             * front of the function.
+             *)
+            local
+               exception Yes of Label.t * Statement.t
+               fun goto l =
+                  let
+                     val {block, visited1, ...} = labelInfo l
+                  in
+                     if !visited1
+                        then ()
+                     else
+                        let
+                           val () = visited1 := true
+                           val Block.T {statements, transfer, ...} = block
+                           val () =
+                              Vector.foreach
+                              (statements, fn s =>
+                               case s of
+                                  Statement.Profile (ProfileExp.Enter _) =>
+                                     raise Yes (l, s)
+                                | _ => ())
+                           val () = Transfer.foreachLabel (transfer, goto)
+                        in
+                           ()
+                        end
+                  end
+            in
+               val first = (goto start; NONE) handle Yes z => SOME z
+            end
+            val blocks = ref []
+            datatype z = datatype Statement.t
+            datatype z = datatype ProfileExp.t
+            fun backward {args,
+                          kind,
+                          label,
+                          leaves,
+                          sourceSeq: int list,
+                          statements: Statement.t list,
+                          transfer: Transfer.t}: unit =
+               let
+                  val (_, ncc, sourceSeq, statements) =
+                     List.fold
+                     (statements,
+                      (leaves, true, sourceSeq, []),
+                      fn (s, (leaves, ncc, sourceSeq, ss)) =>
+                      case s of
+                         Object _ => (leaves, true, sourceSeq, s :: ss)
+                       | Profile ps =>
+                            let
+                               val (ncc, ss) =
+                                  if needCodeCoverage
+                                     then
+                                        if ncc
+                                           andalso not (List.isEmpty sourceSeq)
+                                           then (false,
+                                                 codeCoverageStatement sourceSeq :: ss)
+                                        else (true, ss)
+                                  else (false, ss)
+                               val (leaves, sourceSeq) = 
+                                  case ps of
+                                     Enter _ =>
+                                        (case sourceSeq of
+                                            [] => Error.bug 
+                                                  "Profile.backward: unmatched Enter"
+                                          | _ :: sis => (leaves, sis))
+                                   | Leave _ =>
+                                        (case leaves of
+                                            [] => Error.bug 
+                                                  "Profile.backward: missing Leave"
+                                          | infoNode :: leaves =>
+                                               (leaves,
+                                                InfoNode.sourcesIndex infoNode
+                                                :: sourceSeq))
+                            in
+                               (leaves, ncc, sourceSeq, ss)
+                            end
+                       | _ => (leaves, true, sourceSeq, s :: ss))
+                  val statements =
+                     if needCodeCoverage
+                        andalso ncc
+                        then codeCoverageStatement sourceSeq :: statements
+                     else statements
+                  val {args, kind, label} =
+                     if profileStack andalso (case kind of
+                                                 Kind.Cont _ => true
+                                               | Kind.Handler => true
+                                               | _ => false)
+                        then
+                           let
+                              val func = CFunction.profileLeave
+                              val newLabel = Label.newNoname ()
+                              val _ =
+                                 addFrameProfileIndex
+                                 (newLabel, sourceSeqIndex sourceSeq)
+                              val statements =
+                                 if needCodeCoverage
+                                    then (Vector.new1
+                                          (codeCoverageStatement sourceSeq))
+                                 else Vector.new0 ()
+                              val _ =
+                                 List.push
+                                 (blocks,
+                                  Block.T
+                                  {args = args,
+                                   kind = kind,
+                                   label = label,
+                                   statements = statements,
+                                   transfer = 
+                                   Transfer.CCall
+                                   {args = Vector.new1 Operand.GCState,
+                                    func = func,
+                                    return = SOME newLabel}})
+                           in
+                              {args = Vector.new0 (),
+                               kind = Kind.CReturn {func = func},
+                               label = newLabel}
+                           end
+                     else
+                        {args = args,
+                         kind = kind,
+                         label = label}
+               in                      
+                  List.push (blocks,
+                             Block.T {args = args,
+                                      kind = kind,
+                                      label = label,
+                                      statements = Vector.fromList statements,
+                                      transfer = transfer})
+               end
+            val backward =
+               Trace.trace
+               ("Profile.backward",
+                fn {leaves, statements, sourceSeq, ...} =>
+                let
+                   open Layout
+                in
+                   record [("leaves", List.layout InfoNode.layout leaves),
+                           ("sourceSeq", List.layout Int.layout sourceSeq),
+                           ("statements",
+                            List.layout Statement.layout statements)]
+                end,
+                Unit.layout)
+               backward
+            fun profileEnter (pushes: Push.t list,
+                              transfer: Transfer.t): Transfer.t =
+               let
+                  val func = CFunction.profileEnter
+                  val newLabel = Label.newNoname ()
+                  val index = sourceSeqIndex (Push.toSources pushes)
+                  val _ = addFrameProfileIndex (newLabel, index)
+                  val statements =
+                     if needCodeCoverage
+                        then Vector.new1 (codeCoverageStatementFromIndex index)
+                     else Vector.new0 ()
+                  val _ =
+                     List.push
+                     (blocks,
+                      Block.T {args = Vector.new0 (),
+                               kind = Kind.CReturn {func = func},
+                               label = newLabel,
+                               statements = statements,
+                               transfer = transfer})
+               in
+                  Transfer.CCall {args = Vector.new1 Operand.GCState,
+                                  func = func,
+                                  return = SOME newLabel}
+               end
+            fun goto (l: Label.t, pushes: Push.t list): unit =
+               let
+                  val _ =
+                     if not debug
+                        then ()
+                     else
+                     let
+                        open Layout
+                     in
+                        outputl (seq [str "goto (",
+                                      Label.layout l,
+                                      str ", ",
+                                      List.layout Push.layout pushes,
+                                      str ")"],
+                                 Out.error)
+                     end
+                  val {block, visited2, ...} = labelInfo l
+               in
+                  if !visited2
+                     then ()
+                  else
+                     let
+                        val _ = visited2 := true
+                        val Block.T {args, kind, label, statements, transfer,
+                                     ...} = block
+                        val statements =
+                           case first of
+                              NONE => statements
+                            | SOME (firstLabel, firstEnter) =>
+                                 if Label.equals (label, firstLabel)
+                                    then
+                                       Vector.removeFirst
+                                       (statements, fn s =>
+                                        case s of
+                                           Profile (Enter _) => true
+                                         | _ => false)
+                                 else if Label.equals (label, start)
+                                         then
+                                            Vector.concat
+                                            [Vector.new1 firstEnter,
+                                             statements]
+                                      else statements
+                        val _ =
+                           let
+                              fun add pushes =
+                                 addFrameProfilePushes (label, pushes)
+                              datatype z = datatype Kind.t
+                           in
+                              case kind of
+                                 Cont _ => add pushes
+                               | CReturn {func, ...} =>
+                                    let
+                                       datatype z = datatype CFunction.Target.t
+                                       val target = CFunction.target func
+                                       fun doit si =
+                                          add (#1 (enter (pushes, si)))
+                                    in
+                                       case target of
+                                          Direct "GC_gc" => doit SourceInfo.gc
+                                        | Direct "GC_arrayAllocate" =>
+                                             doit SourceInfo.gcArrayAllocate
+                                        | Direct "MLton_bug" => add pushes
+                                        | Direct name => doit (SourceInfo.fromC name)
+                                        | Indirect => doit (SourceInfo.fromC "<indirect>")
+                                    end
+                               | Handler => add pushes
+                               | Jump => ()
+                           end
+                        fun maybeSplit {args,
+                                        bytesAllocated: Bytes.t,
+                                        kind,
+                                        label,
+                                        leaves,
+                                        pushes: Push.t list,
+                                        shouldSplit: bool,
+                                        statements} =
+                           if not shouldSplit
+                              then {args = args,
+                                    bytesAllocated = Bytes.zero,
+                                    kind = kind,
+                                    label = label,
+                                    leaves = leaves,
+                                    statements = statements}
+                           else
+                              let
+                                 val newLabel = Label.newNoname ()
+                                 val _ =
+                                    addFrameProfilePushes (newLabel, pushes)
+                                 val func = CFunction.profileInc
+                                 val amount =
+                                    case profile of
+                                       ProfileAlloc => Bytes.toInt bytesAllocated
+                                     | ProfileCount => 1
+                                     | _ => Error.bug "Profile.maybeSplit: amount"
+                                 val transfer =
+                                    Transfer.CCall
+                                    {args = (Vector.new2
+                                             (Operand.GCState,
+                                              Operand.word
+                                              (WordX.fromIntInf
+                                               (IntInf.fromInt amount,
+                                                WordSize.default)))),
+                                     func = func,
+                                     return = SOME newLabel}
+                                 val sourceSeq = Push.toSources pushes
+                                 val _ =
+                                    backward {args = args,
+                                              kind = kind,
+                                              label = label,
+                                              leaves = leaves,
+                                              sourceSeq = sourceSeq,
+                                              statements = statements,
+                                              transfer = transfer}
+                              in
+                                 {args = Vector.new0 (),
+                                  bytesAllocated = Bytes.zero,
+                                  kind = Kind.CReturn {func = func},
+                                  label = newLabel,
+                                  leaves = [],
+                                  statements = []}
+                              end
+                        val {args, bytesAllocated, kind, label, leaves, pushes,
+                             statements} =
+                           Vector.fold
+                           (statements,
+                            {args = args,
+                             bytesAllocated = Bytes.zero,
+                             kind = kind,
+                             label = label,
+                             leaves = [],
+                             pushes = pushes,
+                             statements = []},
+                            fn (s, {args, bytesAllocated, kind, label,
+                                    leaves,
+                                    pushes: Push.t list,
+                                    statements}) =>
+                            (if not debug
+                                then ()
+                             else
+                                let
+                                   open Layout
+                                in
+                                   outputl
+                                   (seq [List.layout Push.layout pushes,
+                                         str " ",
+                                         Statement.layout s],
+                                    Out.error)
+                                end
+                             ;
+                            case s of
+                               Object {size, ...} =>
+                                  {args = args,
+                                   bytesAllocated = Bytes.+ (bytesAllocated,
+                                                             Words.toBytes size),
+                                   kind = kind,
+                                   label = label,
+                                   leaves = leaves,
+                                   pushes = pushes,
+                                   statements = s :: statements}
+                             | Profile ps =>
+                                  let
+                                     val shouldSplit =
+                                        profile = ProfileAlloc
+                                        andalso Bytes.> (bytesAllocated,
+                                                         Bytes.zero)
+                                     val {args, bytesAllocated, kind, label,
+                                          leaves, statements} =
+                                        maybeSplit
+                                        {args = args,
+                                         bytesAllocated = bytesAllocated,
+                                         kind = kind,
+                                         label = label,
+                                         leaves = leaves,
+                                         pushes = pushes,
+                                         shouldSplit = shouldSplit,
+                                         statements = statements}
+                                     datatype z = datatype ProfileExp.t
+                                     val (pushes, keep, leaves) =
+                                        case ps of
+                                           Enter si =>
+                                              let
+                                                 val (pushes, keep) =
+                                                    enter (pushes, si)
+                                              in
+                                                 (pushes, keep, leaves)
+                                              end
+                                         | Leave si =>
+                                              (case pushes of
+                                                  [] => Error.bug 
+                                                        "Profile.goto: unmatched Leave"
+                                                | p :: pushes =>
+                                                     let
+                                                        val (keep, si', leaves) =
+                                                           case p of
+                                                              Push.Enter
+                                                              (infoNode as
+                                                               InfoNode.T
+                                                               {info, ...}) =>
+                                                                 (true, info,
+                                                                  infoNode :: leaves)
+                                                            | Push.Skip si' =>
+                                                                 (false, si',
+                                                                  leaves)
+                                                     in
+                                                        if SourceInfo.equals (si, si')
+                                                           then (pushes,
+                                                                 keep,
+                                                                 leaves)
+                                                        else Error.bug 
+                                                             "Profile.goto: mismatched Leave"
+                                                     end)
+                                     val shouldSplit =
+                                        profile = ProfileCount
+                                        andalso (case ps of
+                                                    Enter _ => keep
+                                                  | _ => false)
+                                     val {args, bytesAllocated, kind, label,
+                                          leaves, statements} =
+                                        maybeSplit
+                                        {args = args,
+                                         bytesAllocated = bytesAllocated,
+                                         kind = kind,
+                                         label = label,
+                                         leaves = leaves,
+                                         pushes = pushes,
+                                         shouldSplit = shouldSplit,
+                                         statements = statements}
+                                     val statements =
+                                        if keep
+                                           then s :: statements
+                                        else statements
+                                  in
+                                     {args = args,
+                                      bytesAllocated = bytesAllocated,
+                                      kind = kind,
+                                      label = label,
+                                      leaves = leaves,
+                                      pushes = pushes,
+                                      statements = statements}
+                                  end
+                             | _ =>
+                                  {args = args,
+                                   bytesAllocated = bytesAllocated,
+                                   kind = kind,
+                                   label = label,
+                                   leaves = leaves,
+                                   pushes = pushes,
+                                   statements = s :: statements})
+                            )
+                        val shouldSplit =
+                           profile = ProfileAlloc
+                           andalso Bytes.> (bytesAllocated, Bytes.zero)
+                        val {args, kind, label, leaves, statements, ...} =
+                           maybeSplit {args = args,
+                                       bytesAllocated = bytesAllocated,
+                                       kind = kind,
+                                       label = label,
+                                       leaves = leaves,
+                                       pushes = pushes,
+                                       shouldSplit = shouldSplit,
+                                       statements = statements}
+                        val _ =
+                           Transfer.foreachLabel
+                           (transfer, fn l => goto (l, pushes))
+                        val transfer =
+                           case transfer of
+                              Transfer.Call {func, return, ...} =>
+                                 let
+                                    val fi as FuncInfo.T {callers, ...} =
+                                       funcInfo func
+                                 in
+                                    case return of
+                                       Return.NonTail _ =>
+                                          let
+                                             val _ =
+                                                case firstEnter pushes of
+                                                   NONE =>
+                                                      List.push (tailCalls, fi)
+                                                 | SOME n => 
+                                                      List.push (callers, n)
+                                          in
+                                             if profileStack
+                                                then profileEnter (pushes,
+                                                                   transfer)
+                                             else transfer
+                                          end
+                                     | _ =>
+                                          (List.push (tailCalls, fi)
+                                           ; transfer)
+                                 end
+                            | _ => transfer
+                     in
+                        backward {args = args,
+                                  kind = kind,
+                                  label = label,
+                                  leaves = leaves,
+                                  sourceSeq = Push.toSources pushes,
+                                  statements = statements,
+                                  transfer = transfer}
+                     end
+               end
+            val _ = goto (start, [])
+            val blocks = Vector.fromList (!blocks)
+         in
+            Function.new {args = args,
+                          blocks = blocks,
+                          name = name,
+                          raises = raises,
+                          returns = returns,
+                          start = start}
+         end
       val program = Program.T {functions = List.revMap (functions, doFunction),
-			       handlesSignals = handlesSignals,
-			       main = doFunction main,
-			       objectTypes = objectTypes}
+                               handlesSignals = handlesSignals,
+                               main = doFunction main,
+                               objectTypes = objectTypes}
       val _ = addFuncEdges ()
       val names = Vector.fromListRev (!names)
       val sources =
-	 Vector.map
-	 (Vector.fromListRev (!infoNodes),
-	  fn InfoNode.T {nameIndex, successors, ...} =>
-	  {nameIndex = nameIndex, 
-	   successorsIndex = (sourceSeqIndex
-			      (List.revMap (!successors,
-					    InfoNode.sourcesIndex)))})
+         Vector.map
+         (Vector.fromListRev (!infoNodes),
+          fn InfoNode.T {nameIndex, successors, ...} =>
+          {nameIndex = nameIndex, 
+           successorsIndex = (sourceSeqIndex
+                              (List.revMap (!successors,
+                                            InfoNode.sourcesIndex)))})
       (* makeSourceSeqs () must happen after making sources, since that creates
        * new sourceSeqs.
        *)
       val sourceSeqs = makeSourceSeqs ()
       fun makeProfileInfo {frames} =
-	 let
-	    val {get, set, ...} =
-	       Property.getSetOnce
-	       (Label.plist,
-		Property.initRaise ("frameProfileIndex", Label.layout))
-	    val _ =
-	       List.foreach (!frameProfileIndices, fn (l, i) =>
-			     set (l, i))
-	    val frameSources = Vector.map (frames, get)
-	 in
-	    SOME (Machine.ProfileInfo.T
-		  {frameSources = frameSources,
-		   labels = Vector.fromList (!labels),
-		   names = names,
-		   sourceSeqs = sourceSeqs,
-		   sources = sources})
-	 end
+         let
+            val {get, set, ...} =
+               Property.getSetOnce
+               (Label.plist,
+                Property.initRaise ("frameProfileIndex", Label.layout))
+            val _ =
+               List.foreach (!frameProfileIndices, fn (l, i) =>
+                             set (l, i))
+            val frameSources = Vector.map (frames, get)
+         in
+            SOME (Machine.ProfileInfo.T
+                  {frameSources = frameSources,
+                   labels = Vector.fromList (!labels),
+                   names = names,
+                   sourceSeqs = sourceSeqs,
+                   sources = sources})
+         end
    in 
       (program, makeProfileInfo)
    end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/backend/profile.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/backend/profile.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/backend/profile.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,10 @@
+(* Copyright (C) 2002-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 type int = Int.t
 type word = Word.t
    
@@ -13,7 +20,7 @@
       include PROFILE_STRUCTS
       
       val profile:
-	 Rssa.Program.t
-	 -> Rssa.Program.t * ({frames: Rssa.Label.t vector}
-			      -> Machine.ProfileInfo.t option)
+         Rssa.Program.t
+         -> Rssa.Program.t * ({frames: Rssa.Label.t vector}
+                              -> Machine.ProfileInfo.t option)
    end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/backend/rep-type.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/backend/rep-type.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/backend/rep-type.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,8 +1,8 @@
-(* Copyright (C) 2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 2004-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 functor RepType (S: REP_TYPE_STRUCTS): REP_TYPE =
@@ -17,73 +17,73 @@
 structure Type =
    struct
       datatype t = T of {node: node,
-			 width: Bits.t}
+                         width: Bits.t}
       and node =
-	 Address of t
-	| ExnStack
-	| GCState
-	| Label of Label.t
-	| Pointers of PointerTycon.t vector
-	| Real of RealSize.t
-	| Seq of t vector
-	| Word
+         Address of t
+        | ExnStack
+        | GCState
+        | Label of Label.t
+        | Pointers of PointerTycon.t vector
+        | Real of RealSize.t
+        | Seq of t vector
+        | Word
 
       local
-	 fun make f (T r) = f r
+         fun make f (T r) = f r
       in
-	 val node = make #node
-	 val width = make #width
+         val node = make #node
+         val width = make #width
       end
 
       val rec layout: t -> Layout.t =
-	 fn t =>
-	 let
-	    open Layout
-	 in
-	    case node t of
-	       Address t => seq [str "Address ", layout t]
-	     | ExnStack => str "ExnStack"
-	     | GCState => str "GCState"
-	     | Label l => seq [str "Label ", Label.layout l]
-	     | Pointers pts =>
-		  seq [str "Pointers ",
-		       tuple (Vector.toListMap (pts, PointerTycon.layout))]
-	     | Real s => str (concat ["Real", RealSize.toString s])
-	     | Seq ts => List.layout layout (Vector.toList ts)
-	     | Word => str (concat ["Word", Bits.toString (width t)])
-	 end
+         fn t =>
+         let
+            open Layout
+         in
+            case node t of
+               Address t => seq [str "Address ", layout t]
+             | ExnStack => str "ExnStack"
+             | GCState => str "GCState"
+             | Label l => seq [str "Label ", Label.layout l]
+             | Pointers pts =>
+                  seq [str "Pointers ",
+                       tuple (Vector.toListMap (pts, PointerTycon.layout))]
+             | Real s => str (concat ["Real", RealSize.toString s])
+             | Seq ts => List.layout layout (Vector.toList ts)
+             | Word => str (concat ["Word", Bits.toString (width t)])
+         end
 
       val toString = Layout.toString o layout
 
       val rec equals: t * t -> bool =
-	 fn (t, t') =>
-	 Bits.equals (width t, width t')
-	 andalso
-	 (case (node t, node t') of
-	     (Address t, Address t') => equals (t, t')
-	   | (ExnStack, ExnStack) => true
-	   | (GCState, GCState) => true
-	   | (Label l, Label l') => Label.equals (l, l')
-	   | (Pointers v, Pointers v') =>
-		Vector.equals (v, v', PointerTycon.equals)
-	   | (Real s, Real s') => RealSize.equals (s, s')
-	   | (Seq ts, Seq ts') => Vector.equals (ts, ts', equals)
-	   | (Word, Word) => true
-	   | _ => false)
+         fn (t, t') =>
+         Bits.equals (width t, width t')
+         andalso
+         (case (node t, node t') of
+             (Address t, Address t') => equals (t, t')
+           | (ExnStack, ExnStack) => true
+           | (GCState, GCState) => true
+           | (Label l, Label l') => Label.equals (l, l')
+           | (Pointers v, Pointers v') =>
+                Vector.equals (v, v', PointerTycon.equals)
+           | (Real s, Real s') => RealSize.equals (s, s')
+           | (Seq ts, Seq ts') => Vector.equals (ts, ts', equals)
+           | (Word, Word) => true
+           | _ => false)
 
       val sameWidth: t * t -> bool =
-	 fn (t, t') => Bits.equals (width t, width t')
+         fn (t, t') => Bits.equals (width t, width t')
 
       val word: Bits.t -> t = fn width => T {node = Word, width = width}
 
       val add: t * t -> t = #1
 
       val bogusWord: t -> WordX.t =
-	 fn t => WordX.one (WordSize.fromBits (width t))
+         fn t => WordX.one (WordSize.fromBits (width t))
 
       val address: t -> t =
-	 fn t => T {node = Address t,
-		    width = Bits.inPointer}
+         fn t => T {node = Address t,
+                    width = Bits.inPointer}
 
       val andb: t * t -> t option = SOME o #1
 
@@ -100,111 +100,110 @@
       val constant: WordX.t -> t = fn w => word (WordSize.bits (WordX.size w))
 
       val deLabel: t -> Label.t option =
-	 fn t =>
-	 case node t of
-	    Label l => SOME l
-	  | _ => NONE
+         fn t =>
+         case node t of
+            Label l => SOME l
+          | _ => NONE
 
       val dePointer: t -> PointerTycon.t option =
-	 fn t => 
-	 case node t of
-	    Pointers pts =>
-	       if 1 = Vector.length pts
-		  then SOME (Vector.sub (pts, 0))
-	       else NONE
-	  | _ => NONE
+         fn t => 
+         case node t of
+            Pointers pts =>
+               if 1 = Vector.length pts
+                  then SOME (Vector.sub (pts, 0))
+               else NONE
+          | _ => NONE
 
       val deReal: t -> RealSize.t option =
-	 fn t =>
-	 case node t of
-	    Real s => SOME s
-	  | _ => NONE
+         fn t =>
+         case node t of
+            Real s => SOME s
+          | _ => NONE
 
       val defaultWord: t = word Bits.inWord
 
       val exnStack: t = T {node = ExnStack,
-			   width = Bits.inPointer}
+                           width = Bits.inPointer}
 
       val rec isPointer: t -> bool =
-	 fn t =>
-	 case node t of
-	    Pointers _ => true
-	  | _ => false
+         fn t =>
+         case node t of
+            Pointers _ => true
+          | _ => false
 
       val real: RealSize.t -> t =
-	 fn s => T {node = Real s, width = RealSize.bits s}
+         fn s => T {node = Real s, width = RealSize.bits s}
 
       local
-	 structure C =
-	    struct
-	       open CType
+         structure C =
+            struct
+               open CType
 
-	       fun fromBits (b: Bits.t): t =
-		  case Bits.toInt b of
-		     8 => Word8
-		   | 16 => Word16
-		   | 32 => Word32
-		   | 64 => Word64
-		   | _ => Error.bug (concat ["CType.fromBits: ",
-					     Bits.toString b])
-	    end
-	 fun w i = word (Bits.fromInt i)
+               fun fromBits (b: Bits.t): t =
+                  case Bits.toInt b of
+                     8 => Word8
+                   | 16 => Word16
+                   | 32 => Word32
+                   | 64 => Word64
+                   | _ => Error.bug (concat ["RepType.Type.CType.fromBits: ",
+                                             Bits.toString b])
+            end
       in
-	 val rec toCType: t -> CType.t =
-	    fn t =>
-	    if isPointer t
-	       then C.Pointer
-	    else 
-	       case node t of
-		  Real s =>
-		     (case s of
-			 RealSize.R32 => C.Real32
-		       | RealSize.R64 => C.Real64)
-		| _ => C.fromBits (width t)
+         val rec toCType: t -> CType.t =
+            fn t =>
+            if isPointer t
+               then C.Pointer
+            else 
+               case node t of
+                  Real s =>
+                     (case s of
+                         RealSize.R32 => C.Real32
+                       | RealSize.R64 => C.Real64)
+                | _ => C.fromBits (width t)
 
-	 val name = C.name o toCType
+         val name = C.name o toCType
 
-	 val align: t * Bytes.t -> Bytes.t =
-	    fn (t, n) => C.align (toCType t, n)
+         val align: t * Bytes.t -> Bytes.t =
+            fn (t, n) => C.align (toCType t, n)
       end
 
       val gcState: t = T {node = GCState, width = Bits.inPointer}
 
       val isCPointer: t -> bool =
-	 fn t =>
-	 case node t of
-	    Word => Bits.equals (width t, Bits.inPointer)
-	  | _ => false
+         fn t =>
+         case node t of
+            Word => Bits.equals (width t, Bits.inPointer)
+          | _ => false
 
       val isUnit: t -> bool = fn t => Bits.equals (Bits.zero, width t)
 
-      val isUnit = Trace.trace ("RepType.isUnit", layout, Bool.layout) isUnit
-	 
+      val isUnit = Trace.trace ("RepType.Type.isUnit", layout, Bool.layout) isUnit
+         
       val isReal: t -> bool = isSome o deReal
  
       val rec isSubtype: t * t -> bool =
-	 fn (t, t') =>
-	 if not (sameWidth (t, t'))
-	    then Error.bug "RepType.isSubtype"
-	 else
-	    (equals (t, t')
-	     orelse
-	     case (node t, node t') of
-		(Pointers ps, Pointers ps') =>
-		   Vector.isSubsequence (ps, ps', PointerTycon.equals)
-	      | (Real _, _) => false
-	      | (Word, Pointers _) => true
-	      | (_, Word) => true
-	      | _ => false)
+         fn (t, t') =>
+         if not (sameWidth (t, t'))
+            then Error.bug "RepType.Type.isSubtype"
+         else
+            (equals (t, t')
+             orelse
+             case (node t, node t') of
+                (Pointers ps, Pointers ps') =>
+                   Vector.isSubsequence (ps, ps', PointerTycon.equals)
+              | (Real _, _) => false
+              | (Word, Pointers _) => true
+              | (_, Word) => true
+              | _ => false)
 
       val isSubtype =
-	 Trace.trace2 ("RepType.isSubtype", layout, layout, Bool.layout)
-	 isSubtype
+         Trace.trace2 ("RepType.Type.isSubtype", layout, layout, Bool.layout)
+         isSubtype
 
       val junk: Bits.t -> t = word
 
       val label: Label.t -> t =
-	 fn l => T {node = Label l, width = Bits.inPointer}
+         fn l => T {node = Label l, width = Bits.inPointer}
 
       val lshift: t * t -> t = #1
 
@@ -213,8 +212,8 @@
       val orb: t * t -> t option = SOME o #1
 
       val pointer: PointerTycon.t -> t =
-	 fn pt => T {node = Pointers (Vector.new1 pt),
-		     width = Bits.inPointer}
+         fn pt => T {node = Pointers (Vector.new1 pt),
+                     width = Bits.inPointer}
 
       val stack = pointer PointerTycon.stack
 
@@ -233,68 +232,68 @@
       val unit: t = word Bits.zero
 
       val seq: t vector -> t =
-	 fn ts =>
-	 if 0 = Vector.length ts
-	    then unit
-	 else
-	    let
-	       fun seqOnto (ts, ac) =
-		  Vector.foldr
-		  (ts, ac, fn (t, ac) =>
-		   case ac of
-		      [] => [t]
-		    | t' :: ac' =>
-			 (case (node t, node t') of
-			     (Seq ts, _) => seqOnto (ts, ac)
-			   | (Word, Word) =>
-				word (Bits.+ (width t, width t')) :: ac'
-			   | _ => t :: ac))
-	    in
-	       case seqOnto (ts, []) of
-		  [t] => t
-		| ts =>
-		     let
-			val ts = Vector.fromList ts
-		     in
-			T {node = Seq ts,
-			   width = Vector.fold (ts, Bits.zero, fn (t, ac) =>
-						Bits.+ (ac, width t))}
-		     end
-	    end
+         fn ts =>
+         if 0 = Vector.length ts
+            then unit
+         else
+            let
+               fun seqOnto (ts, ac) =
+                  Vector.foldr
+                  (ts, ac, fn (t, ac) =>
+                   case ac of
+                      [] => [t]
+                    | t' :: ac' =>
+                         (case (node t, node t') of
+                             (Seq ts, _) => seqOnto (ts, ac)
+                           | (Word, Word) =>
+                                word (Bits.+ (width t, width t')) :: ac'
+                           | _ => t :: ac))
+            in
+               case seqOnto (ts, []) of
+                  [t] => t
+                | ts =>
+                     let
+                        val ts = Vector.fromList ts
+                     in
+                        T {node = Seq ts,
+                           width = Vector.fold (ts, Bits.zero, fn (t, ac) =>
+                                                Bits.+ (ac, width t))}
+                     end
+            end
 
-      val seq = Trace.trace ("RepType.seq", Vector.layout layout, layout) seq
+      val seq = Trace.trace ("RepType.Type.seq", Vector.layout layout, layout) seq
 
       val sum: t vector -> t =
-	 fn ts =>
-	 if 0 = Vector.length ts
-	    then Error.bug "empty sum"
-	 else
-	    let
-	       val pts =
-		  Vector.concatV
-		  (Vector.keepAllMap
-		   (ts, fn t =>
-		    case node t of
-		       Pointers pts => SOME pts
-		     | _ => NONE))
-	    in
-	       if 0 = Vector.length pts
-		  then Vector.sub (ts, 0)
-	       else
-		  T {node = (Pointers
-			     (QuickSort.sortVector (pts, PointerTycon.<=))),
-		     width = Bits.inPointer}
-	    end
+         fn ts =>
+         if 0 = Vector.length ts
+            then Error.bug "RepType.Type.sum: empty"
+         else
+            let
+               val pts =
+                  Vector.concatV
+                  (Vector.keepAllMap
+                   (ts, fn t =>
+                    case node t of
+                       Pointers pts => SOME pts
+                     | _ => NONE))
+            in
+               if 0 = Vector.length pts
+                  then Vector.sub (ts, 0)
+               else
+                  T {node = (Pointers
+                             (QuickSort.sortVector (pts, PointerTycon.<=))),
+                     width = Bits.inPointer}
+            end
 
-      val sum = Trace.trace ("RepType.sum", Vector.layout layout, layout) sum
+      val sum = Trace.trace ("RepType.Type.sum", Vector.layout layout, layout) sum
 
       val intInf: t =
-	 sum (Vector.new2
-	      (wordVector Bits.inWord,
-	       seq (Vector.new2
-		    (constant (WordX.fromIntInf
-			       (1, WordSize.fromBits (Bits.fromInt 1))),
-		     word (Bits.fromInt 31)))))
+         sum (Vector.new2
+              (wordVector Bits.inWord,
+               seq (Vector.new2
+                    (constant (WordX.fromIntInf
+                               (1, WordSize.fromBits (Bits.fromInt 1))),
+                     word (Bits.fromInt 31)))))
 
       val word8: t = word Bits.inByte
 
@@ -303,19 +302,19 @@
       val zero: Bits.t -> t = word
 
       fun bytesAndPointers (t: t): Bytes.t * int =
-	 case node t of
-	    Pointers _ => (Bytes.zero, 1)
-	  | Seq ts =>
-	       (case Vector.peeki (ts, isPointer o #2) of
-		   NONE => (bytes t, 0)
-		 | SOME (i, _) =>
-		      let
-			 val b = bytes (seq (Vector.prefix (ts, i)))
-		      in
-			 (b, (Bytes.toInt (Bytes.- (bytes t, b))
-			      div Bytes.toInt Bytes.inPointer))
-		      end)
-	  | _ => (bytes t, 0)
+         case node t of
+            Pointers _ => (Bytes.zero, 1)
+          | Seq ts =>
+               (case Vector.peeki (ts, isPointer o #2) of
+                   NONE => (bytes t, 0)
+                 | SOME (i, _) =>
+                      let
+                         val b = bytes (seq (Vector.prefix (ts, i)))
+                      in
+                         (b, (Bytes.toInt (Bytes.- (bytes t, b))
+                              div Bytes.toInt Bytes.inPointer))
+                      end)
+          | _ => (bytes t, 0)
 
       val isZero = fn _ => false
    end
@@ -326,56 +325,56 @@
       structure Runtime = Runtime
 
       type ty = Type.t
-	 
+         
       datatype t =
-	 Array of {elt: Type.t,
-		   hasIdentity: bool}
+         Array of {elt: Type.t,
+                   hasIdentity: bool}
        | Normal of {hasIdentity: bool,
-		    ty: Type.t}
+                    ty: Type.t}
        | Stack
        | Weak of Type.t
        | WeakGone
 
       fun layout (t: t) =
-	 let
-	    open Layout
-	 in
-	    case t of
-	       Array {elt, hasIdentity} =>
-		  seq [str "Array ",
-		       record [("elt", Type.layout elt),
-			       ("hasIdentity", Bool.layout hasIdentity)]]
-	     | Normal {hasIdentity, ty} =>
-		  seq [str "Normal ",
-		       record [("hasIdentity", Bool.layout hasIdentity),
-			       ("ty", Type.layout ty)]]
-	     | Stack => str "Stack"
-	     | Weak t => seq [str "Weak ", Type.layout t]
-	     | WeakGone => str "WeakGone"
-	 end
+         let
+            open Layout
+         in
+            case t of
+               Array {elt, hasIdentity} =>
+                  seq [str "Array ",
+                       record [("elt", Type.layout elt),
+                               ("hasIdentity", Bool.layout hasIdentity)]]
+             | Normal {hasIdentity, ty} =>
+                  seq [str "Normal ",
+                       record [("hasIdentity", Bool.layout hasIdentity),
+                               ("ty", Type.layout ty)]]
+             | Stack => str "Stack"
+             | Weak t => seq [str "Weak ", Type.layout t]
+             | WeakGone => str "WeakGone"
+         end
 
       fun isOk (t: t): bool =
-	 case t of
-	    Array {elt, ...} =>
-	       let
-		  val b = Type.width elt
-	       in
-		  Bits.> (b, Bits.zero)
-		  andalso Bits.isByteAligned b
-	       end
-	  | Normal {ty, ...} =>
-	       not (Type.isUnit ty) andalso Bits.isWordAligned (Type.width ty)
-	  | Stack => true
-	  | Weak t => Type.isPointer t
-	  | WeakGone => true
+         case t of
+            Array {elt, ...} =>
+               let
+                  val b = Type.width elt
+               in
+                  Bits.> (b, Bits.zero)
+                  andalso Bits.isByteAligned b
+               end
+          | Normal {ty, ...} =>
+               not (Type.isUnit ty) andalso Bits.isWordAligned (Type.width ty)
+          | Stack => true
+          | Weak t => Type.isPointer t
+          | WeakGone => true
 
       val stack = Stack
 
       val thread =
-	 Normal {hasIdentity = true,
-		 ty = Type.seq (Vector.new3 (Type.defaultWord,
-					     Type.defaultWord,
-					     Type.stack))}
+         Normal {hasIdentity = true,
+                 ty = Type.seq (Vector.new3 (Type.defaultWord,
+                                             Type.defaultWord,
+                                             Type.stack))}
 
       (* Order in the following vector matters.  The basic pointer tycons must
        * correspond to the constants in gc.h.
@@ -386,49 +385,49 @@
        * WORD_VECTOR_TYPE_INDEX.
        *)
       val basic =
-	 let
-	    fun wordVec i =
-	       let
-		  val b = Bits.fromInt i
-	       in
-		  (PointerTycon.wordVector b,
-		   Array {hasIdentity = false,
-			  elt = Type.word b})
-	       end
-	 in
-	    Vector.fromList
-	    [(PointerTycon.stack, stack),
-	     wordVec 8,
-	     (PointerTycon.thread, thread),
-	     (PointerTycon.weakGone, WeakGone),
-	     wordVec 32,
-	     wordVec 16]
-	 end
+         let
+            fun wordVec i =
+               let
+                  val b = Bits.fromInt i
+               in
+                  (PointerTycon.wordVector b,
+                   Array {hasIdentity = false,
+                          elt = Type.word b})
+               end
+         in
+            Vector.fromList
+            [(PointerTycon.stack, stack),
+             wordVec 8,
+             (PointerTycon.thread, thread),
+             (PointerTycon.weakGone, WeakGone),
+             wordVec 32,
+             wordVec 16]
+         end
 
       local
-	 structure R = Runtime.RObjectType
+         structure R = Runtime.RObjectType
       in
-	 fun toRuntime (t: t): R.t =
-	    case t of
-	       Array {elt, hasIdentity} =>
-		  let
-		     val (b, p) = Type.bytesAndPointers elt
-		  in
-		     R.Array {hasIdentity = hasIdentity,
-			      nonPointer = b,
-			      pointers = p}
-		  end
-	     | Normal {hasIdentity, ty} =>
-		  let
-		     val (b, p) = Type.bytesAndPointers ty
-		  in
-		     R.Normal {hasIdentity = hasIdentity,
-			       nonPointer = Bytes.toWords b,
-			       pointers = p}
-		  end
-	     | Stack => R.Stack
-	     | Weak _ => R.Weak
-	     | WeakGone => R.WeakGone
+         fun toRuntime (t: t): R.t =
+            case t of
+               Array {elt, hasIdentity} =>
+                  let
+                     val (b, p) = Type.bytesAndPointers elt
+                  in
+                     R.Array {hasIdentity = hasIdentity,
+                              nonPointer = b,
+                              pointers = p}
+                  end
+             | Normal {hasIdentity, ty} =>
+                  let
+                     val (b, p) = Type.bytesAndPointers ty
+                  in
+                     R.Normal {hasIdentity = hasIdentity,
+                               nonPointer = Bytes.toWords b,
+                               pointers = p}
+                  end
+             | Stack => R.Stack
+             | Weak _ => R.Weak
+             | WeakGone => R.WeakGone
       end
    end
 
@@ -436,8 +435,8 @@
    
 fun pointerHeader p =
    constant (WordX.fromIntInf
-	     (1 + 2 * Int.toIntInf (PointerTycon.index p),
-	      WordSize.default))
+             (1 + 2 * Int.toIntInf (PointerTycon.index p),
+              WordSize.default))
 
 fun arrayOffsetIsOk _ = true
 
@@ -448,9 +447,10 @@
       datatype z = datatype GCField.t
    in
       case f of
-	 CanHandle => defaultWord
+         CanHandle => defaultWord
        | CardMap => cPointer ()
        | CurrentThread => cPointer ()
+       | CurSourceSeqsIndex => defaultWord
        | ExnStack => defaultWord
        | Frontier => cPointer ()
        | Limit => cPointer ()
@@ -478,46 +478,46 @@
 
       datatype z = datatype Convention.t
       datatype z = datatype Target.t
-	 
+         
       val bug = vanilla {args = Vector.new1 string,
-			 name = "MLton_bug",
-			 prototype = (Vector.new1 CType.pointer, NONE),
-			 return = unit}
+                         name = "MLton_bug",
+                         prototype = (Vector.new1 CType.pointer, NONE),
+                         return = unit}
 
       local
-	 open Type
+         open Type
       in
-	 val Word32 = word (Bits.fromInt 32)
-	 val unit = unit
+         val Word32 = word (Bits.fromInt 32)
+         val unit = unit
       end
    
       local
-	 fun make b =
-	    T {args = let
-			 open Type
-		      in
-			 Vector.new5 (gcState, Word32, bool, cPointer (), Word32)
-		      end,
-		   bytesNeeded = NONE,
-		   convention = Cdecl,
-		   ensuresBytesFree = true,
-		   mayGC = true,
-		   maySwitchThreads = b,
-		   modifiesFrontier = true,
-		   prototype = let
-				  open CType
-			       in
-				  (Vector.new5 (Pointer, Word32, bool, Pointer, Word32),
-				   NONE)
-			       end,
-		   readsStackTop = true,
-		   return = unit,	
-		   target = Direct "GC_gc",
-		   writesStackTop = true}
-	 val t = make true
-	 val f = make false
+         fun make b =
+            T {args = let
+                         open Type
+                      in
+                         Vector.new5 (gcState, Word32, bool, cPointer (), Word32)
+                      end,
+                   bytesNeeded = NONE,
+                   convention = Cdecl,
+                   ensuresBytesFree = true,
+                   mayGC = true,
+                   maySwitchThreads = b,
+                   modifiesFrontier = true,
+                   prototype = let
+                                  open CType
+                               in
+                                  (Vector.new5 (Pointer, Word32, bool, Pointer, Word32),
+                                   NONE)
+                               end,
+                   readsStackTop = true,
+                   return = unit,       
+                   target = Direct "GC_gc",
+                   writesStackTop = true}
+         val t = make true
+         val f = make false
       in
-	 fun gc {maySwitchThreads = b} = if b then t else f
+         fun gc {maySwitchThreads = b} = if b then t else f
       end
    end
 

Modified: mlton/branches/on-20050420-cmm-branch/mlton/backend/rep-type.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/backend/rep-type.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/backend/rep-type.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,8 +1,8 @@
-(* Copyright (C) 2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 2004-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 signature REP_TYPE_STRUCTS =
@@ -48,20 +48,20 @@
       val align: t * Bytes.t -> Bytes.t
       val andb: t * t -> t option
       val arrayOffsetIsOk: {base: t,
-			    index: t,
-			    offset: Bytes.t,
-			    pointerTy: PointerTycon.t -> ObjectType.t,
-			    result: t,
-			    scale: Scale.t} -> bool
+                            index: t,
+                            offset: Bytes.t,
+                            pointerTy: PointerTycon.t -> ObjectType.t,
+                            result: t,
+                            scale: Scale.t} -> bool
       val arshift: t * t -> t
       val bool: t
       val bytes: t -> Bytes.t
       val castIsOk: {from: t,
-		     to: t,
-		     tyconTy: PointerTycon.t -> ObjectType.t} -> bool
+                     to: t,
+                     tyconTy: PointerTycon.t -> ObjectType.t} -> bool
       val checkPrimApp: {args: t vector,
-			 prim: t Prim.t,
-			 result: t option} -> bool
+                         prim: t Prim.t,
+                         result: t option} -> bool
       val char: t
       val cPointer: unit -> t
       val constant: WordX.t -> t
@@ -88,9 +88,9 @@
       val ofGCField: Runtime.GCField.t -> t
       val ofWordVector: WordXVector.t -> t
       val offsetIsOk: {base: t,
-		       offset: Bytes.t,
-		       pointerTy: PointerTycon.t -> ObjectType.t,
-		       result: t} -> bool
+                       offset: Bytes.t,
+                       pointerTy: PointerTycon.t -> ObjectType.t,
+                       result: t} -> bool
       val orb: t * t -> t option
       val pointer: PointerTycon.t -> t
       val pointerHeader: PointerTycon.t -> t
@@ -112,8 +112,8 @@
       val zero: Bits.t -> t
 
       structure BuiltInCFunction:
-	 sig
-	    val bug: t CFunction.t
-	    val gc: {maySwitchThreads: bool} -> t CFunction.t
-	 end
+         sig
+            val bug: t CFunction.t
+            val gc: {maySwitchThreads: bool} -> t CFunction.t
+         end
    end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/backend/representation.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/backend/representation.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/backend/representation.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 type int = Int.t
    
 signature REPRESENTATION_STRUCTS = 
@@ -20,29 +21,29 @@
       include REPRESENTATION_STRUCTS
 
       val compute:
-	 Ssa.Program.t
-	 -> {diagnostic: unit -> unit,
-	     genCase: {cases: {con: Ssa.Con.t,
-			       dst: Rssa.Label.t,
-			       dstHasArg: bool} vector,
-		       default: Rssa.Label.t option,
-		       test: unit -> Rssa.Operand.t,
-		       tycon: Ssa.Tycon.t} -> (Rssa.Statement.t list
-					       * Rssa.Transfer.t
-					       * Rssa.Block.t list),
-	     object: {args: 'a vector,
-		      con: Ssa.Con.t option,
-		      dst: Rssa.Var.t * Rssa.Type.t,
-		      objectTy: Ssa.Type.t,
-		      oper: 'a -> Rssa.Operand.t} -> Rssa.Statement.t list,
-	     objectTypes: (Rssa.PointerTycon.t * Rssa.ObjectType.t) vector,
-	     select: {base: Rssa.Operand.t Ssa.Base.t,
-		      baseTy: Ssa.Type.t,
-		      dst: Rssa.Var.t * Rssa.Type.t,
-		      offset: int} -> Rssa.Statement.t list,
-	     toRtype: Ssa.Type.t -> Rssa.Type.t option,
-	     update: {base: Rssa.Operand.t Ssa.Base.t,
-		      baseTy: Ssa.Type.t,
-		      offset: int,
-		      value: Rssa.Operand.t} -> Rssa.Statement.t list}
+         Ssa.Program.t
+         -> {diagnostic: unit -> unit,
+             genCase: {cases: {con: Ssa.Con.t,
+                               dst: Rssa.Label.t,
+                               dstHasArg: bool} vector,
+                       default: Rssa.Label.t option,
+                       test: unit -> Rssa.Operand.t,
+                       tycon: Ssa.Tycon.t} -> (Rssa.Statement.t list
+                                               * Rssa.Transfer.t
+                                               * Rssa.Block.t list),
+             object: {args: 'a vector,
+                      con: Ssa.Con.t option,
+                      dst: Rssa.Var.t * Rssa.Type.t,
+                      objectTy: Ssa.Type.t,
+                      oper: 'a -> Rssa.Operand.t} -> Rssa.Statement.t list,
+             objectTypes: (Rssa.PointerTycon.t * Rssa.ObjectType.t) vector,
+             select: {base: Rssa.Operand.t Ssa.Base.t,
+                      baseTy: Ssa.Type.t,
+                      dst: Rssa.Var.t * Rssa.Type.t,
+                      offset: int} -> Rssa.Statement.t list,
+             toRtype: Ssa.Type.t -> Rssa.Type.t option,
+             update: {base: Rssa.Operand.t Ssa.Base.t,
+                      baseTy: Ssa.Type.t,
+                      offset: int,
+                      value: Rssa.Operand.t} -> Rssa.Statement.t list}
    end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/backend/rssa.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/backend/rssa.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/backend/rssa.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,9 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 functor Rssa (S: RSSA_STRUCTS): RSSA =
@@ -29,18 +29,18 @@
       open Layout
    in
       if !Control.showTypes
-	 then seq [str ": ", Type.layout ty]
+         then seq [str ": ", Type.layout ty]
       else empty
    end
 
 structure Operand =
    struct
       datatype t =
-	 ArrayOffset of {base: t,
-			 index: t,
-			 offset: Bytes.t,
-			 scale: Scale.t,
-			 ty: Type.t}
+         ArrayOffset of {base: t,
+                         index: t,
+                         offset: Bytes.t,
+                         scale: Scale.t,
+                         ty: Type.t}
        | Cast of t * Type.t
        | Const of Const.t
        | EnsuresBytesFree
@@ -48,149 +48,149 @@
        | GCState
        | Line
        | Offset of {base: t,
-		    offset: Bytes.t,
-		    ty: Type.t}
+                    offset: Bytes.t,
+                    ty: Type.t}
        | PointerTycon of PointerTycon.t
        | Runtime of GCField.t
        | Var of {var: Var.t,
-		 ty: Type.t}
+                 ty: Type.t}
 
       val word = Const o Const.word
 
       fun zero s = word (WordX.fromIntInf (0, s))
-	 
+         
       fun bool b =
-	 word (WordX.fromIntInf (if b then 1 else 0, WordSize.default))
-	 
+         word (WordX.fromIntInf (if b then 1 else 0, WordSize.default))
+         
       val ty =
-	 fn ArrayOffset {ty, ...} => ty
-	  | Cast (_, ty) => ty
-	  | Const c =>
-	       let
-		  datatype z = datatype Const.t
-	       in
-		  case c of
-		     IntInf _ => Type.intInf
-		   | Real r => Type.real (RealX.size r)
-		   | Word w => Type.constant w
-		   | WordVector v =>
-			Type.wordVector (WordSize.bits
-					 (WordXVector.elementSize v))
-	       end
-	  | EnsuresBytesFree => Type.defaultWord
-	  | File => Type.cPointer ()
-	  | GCState => Type.gcState
-	  | Line => Type.defaultWord
-	  | Offset {ty, ...} => ty
-	  | PointerTycon _ => Type.defaultWord
-	  | Runtime z => Type.ofGCField z
-	  | Var {ty, ...} => ty
+         fn ArrayOffset {ty, ...} => ty
+          | Cast (_, ty) => ty
+          | Const c =>
+               let
+                  datatype z = datatype Const.t
+               in
+                  case c of
+                     IntInf _ => Type.intInf
+                   | Real r => Type.real (RealX.size r)
+                   | Word w => Type.constant w
+                   | WordVector v =>
+                        Type.wordVector (WordSize.bits
+                                         (WordXVector.elementSize v))
+               end
+          | EnsuresBytesFree => Type.defaultWord
+          | File => Type.cPointer ()
+          | GCState => Type.gcState
+          | Line => Type.defaultWord
+          | Offset {ty, ...} => ty
+          | PointerTycon _ => Type.defaultWord
+          | Runtime z => Type.ofGCField z
+          | Var {ty, ...} => ty
 
       fun layout (z: t): Layout.t =
-	 let
-	    open Layout 
-	 in
-	    case z of
-	       ArrayOffset {base, index, offset, scale, ty} =>
-		  seq [str (concat ["X", Type.name ty, " "]),
-		       tuple [layout base, layout index, Scale.layout scale,
-			      Bytes.layout offset]]
-	     | Cast (z, ty) =>
-		  seq [str "Cast ", tuple [layout z, Type.layout ty]]
-	     | Const c => Const.layout c
-	     | EnsuresBytesFree => str "<EnsuresBytesFree>"
-	     | File => str "<File>"
-	     | GCState => str "<GCState>"
-	     | Line => str "<Line>"
-	     | Offset {base, offset, ty} =>
-		  seq [str (concat ["O", Type.name ty, " "]),
-		       tuple [layout base, Bytes.layout offset]]
-	     | PointerTycon pt => PointerTycon.layout pt
-	     | Runtime r => GCField.layout r
-	     | Var {var, ...} => Var.layout var
-	 end
+         let
+            open Layout 
+         in
+            case z of
+               ArrayOffset {base, index, offset, scale, ty} =>
+                  seq [str (concat ["X", Type.name ty, " "]),
+                       tuple [layout base, layout index, Scale.layout scale,
+                              Bytes.layout offset]]
+             | Cast (z, ty) =>
+                  seq [str "Cast ", tuple [layout z, Type.layout ty]]
+             | Const c => Const.layout c
+             | EnsuresBytesFree => str "<EnsuresBytesFree>"
+             | File => str "<File>"
+             | GCState => str "<GCState>"
+             | Line => str "<Line>"
+             | Offset {base, offset, ty} =>
+                  seq [str (concat ["O", Type.name ty, " "]),
+                       tuple [layout base, Bytes.layout offset]]
+             | PointerTycon pt => PointerTycon.layout pt
+             | Runtime r => GCField.layout r
+             | Var {var, ...} => Var.layout var
+         end
 
       fun cast (z: t, t: Type.t): t =
-	 if Type.equals (t, ty z)
-	    then z
-	 else Cast (z, t)
+         if Type.equals (t, ty z)
+            then z
+         else Cast (z, t)
 
-      val cast = Trace.trace2 ("Operand.cast", layout, Type.layout, layout) cast
+      val cast = Trace.trace2 ("Rssa.Operand.cast", layout, Type.layout, layout) cast
 
       val rec isLocation =
-	 fn ArrayOffset _ => true
-	  | Cast (z, _) => isLocation z
-	  | Offset _ => true
-	  | Runtime _ => true
-	  | Var _ => true
-	  | _ => false
+         fn ArrayOffset _ => true
+          | Cast (z, _) => isLocation z
+          | Offset _ => true
+          | Runtime _ => true
+          | Var _ => true
+          | _ => false
 
       fun 'a foldVars (z: t, a: 'a, f: Var.t * 'a -> 'a): 'a =
-	 case z of
-	    ArrayOffset {base, index, ...} =>
-	       foldVars (index, foldVars (base, a, f), f)
-	  | Cast (z, _) => foldVars (z, a, f)
-	  | Offset {base, ...} => foldVars (base, a, f)
-	  | Var {var, ...} => f (var, a)
-	  | _ => a
+         case z of
+            ArrayOffset {base, index, ...} =>
+               foldVars (index, foldVars (base, a, f), f)
+          | Cast (z, _) => foldVars (z, a, f)
+          | Offset {base, ...} => foldVars (base, a, f)
+          | Var {var, ...} => f (var, a)
+          | _ => a
 
       fun foreachVar (z: t, f: Var.t -> unit): unit =
-	 foldVars (z, (), f o #1)
+         foldVars (z, (), f o #1)
 
       fun replaceVar (z: t, f: Var.t -> t): t =
-	 let
-	    fun loop (z: t): t =
-	       case z of
-		  ArrayOffset {base, index, offset, scale, ty} =>
-		     ArrayOffset {base = loop base,
-				  index = loop index,
-				  offset = offset,
-				  scale = scale,
-				  ty = ty}
-		| Cast (t, ty) => Cast (loop t, ty)
-		| Offset {base, offset, ty} =>
-		     Offset {base = loop base,
-			     offset = offset,
-			     ty = ty}
-		| Var {var, ...} => f var
-		| _ => z
-	 in
-	    loop z
-	 end
+         let
+            fun loop (z: t): t =
+               case z of
+                  ArrayOffset {base, index, offset, scale, ty} =>
+                     ArrayOffset {base = loop base,
+                                  index = loop index,
+                                  offset = offset,
+                                  scale = scale,
+                                  ty = ty}
+                | Cast (t, ty) => Cast (loop t, ty)
+                | Offset {base, offset, ty} =>
+                     Offset {base = loop base,
+                             offset = offset,
+                             ty = ty}
+                | Var {var, ...} => f var
+                | _ => z
+         in
+            loop z
+         end
 
    end
 
 structure Switch =
    struct
       local
-	 structure S = Switch (open S
-			       structure Type = Type
-			       structure Use = Operand)
+         structure S = Switch (open S
+                               structure Type = Type
+                               structure Use = Operand)
       in
-	 open S
+         open S
       end
 
       fun replaceVar (T {cases, default, size, test}, f) =
-	 T {cases = cases,
-	    default = default,
-	    size = size,
-	    test = Operand.replaceVar (test, f)}
+         T {cases = cases,
+            default = default,
+            size = size,
+            test = Operand.replaceVar (test, f)}
    end
 
 structure Statement =
    struct
       datatype t =
-	 Bind of {dst: Var.t * Type.t,
-		  isMutable: bool,
-		  src: Operand.t}
+         Bind of {dst: Var.t * Type.t,
+                  isMutable: bool,
+                  src: Operand.t}
        | Move of {dst: Operand.t,
-		  src: Operand.t}
+                  src: Operand.t}
        | Object of {dst: Var.t * Type.t,
-		    header: word,
-		    size: Words.t}
+                    header: word,
+                    size: Words.t}
        | PrimApp of {args: Operand.t vector,
-		     dst: (Var.t * Type.t) option,
-		     prim: Type.t Prim.t}
+                     dst: (Var.t * Type.t) option,
+                     prim: Type.t Prim.t}
        | Profile of ProfileExp.t
        | ProfileLabel of ProfileLabel.t
        | SetExnStackLocal
@@ -199,330 +199,330 @@
        | SetSlotExnStack
 
       fun 'a foldDefUse (s, a: 'a, {def: Var.t * Type.t * 'a -> 'a,
-				    use: Var.t * 'a -> 'a}): 'a =
-	 let
-	    fun useOperand (z: Operand.t, a) = Operand.foldVars (z, a, use)
-	 in
-	    case s of
-	       Bind {dst = (x, t), src, ...} => def (x, t, useOperand (src, a))
-	     | Move {dst, src} => useOperand (src, useOperand (dst, a))
-	     | Object {dst = (dst, ty), ...} => def (dst, ty, a)
-	     | PrimApp {dst, args, ...} =>
-		  Vector.fold (args,
-			       Option.fold (dst, a, fn ((x, t), a) =>
-					    def (x, t, a)),
-			       useOperand)
-	     | Profile _ => a
-	     | ProfileLabel _ => a
-	     | SetExnStackLocal => a
-	     | SetExnStackSlot => a
-	     | SetHandler _ => a
-	     | SetSlotExnStack => a
-	 end
+                                    use: Var.t * 'a -> 'a}): 'a =
+         let
+            fun useOperand (z: Operand.t, a) = Operand.foldVars (z, a, use)
+         in
+            case s of
+               Bind {dst = (x, t), src, ...} => def (x, t, useOperand (src, a))
+             | Move {dst, src} => useOperand (src, useOperand (dst, a))
+             | Object {dst = (dst, ty), ...} => def (dst, ty, a)
+             | PrimApp {dst, args, ...} =>
+                  Vector.fold (args,
+                               Option.fold (dst, a, fn ((x, t), a) =>
+                                            def (x, t, a)),
+                               useOperand)
+             | Profile _ => a
+             | ProfileLabel _ => a
+             | SetExnStackLocal => a
+             | SetExnStackSlot => a
+             | SetHandler _ => a
+             | SetSlotExnStack => a
+         end
 
       fun foreachDefUse (s: t, {def, use}) =
-	 foldDefUse (s, (), {def = fn (x, t, ()) => def (x, t),
-			     use = use o #1})
+         foldDefUse (s, (), {def = fn (x, t, ()) => def (x, t),
+                             use = use o #1})
 
       fun 'a foldDef (s: t, a: 'a, f: Var.t * Type.t * 'a -> 'a): 'a =
-	 foldDefUse (s, a, {def = f, use = #2})
+         foldDefUse (s, a, {def = f, use = #2})
 
       fun foreachDef (s:t , f: Var.t * Type.t -> unit) =
-	 foldDef (s, (), fn (x, t, ()) => f (x, t))
+         foldDef (s, (), fn (x, t, ()) => f (x, t))
 
       fun 'a foldUse (s: t, a: 'a, f: Var.t * 'a -> 'a) =
-	 foldDefUse (s, a, {def = #3, use = f})
+         foldDefUse (s, a, {def = #3, use = f})
 
       fun foreachUse (s, f) = foldUse (s, (), f o #1)
 
       fun replaceUses (s: t, f: Var.t -> Operand.t): t =
-	 let
-	    fun oper (z: Operand.t): Operand.t =
-	       Operand.replaceVar (z, f)
-	 in
-	    case s of
-	       Bind {dst, isMutable, src} =>
-		  Bind {dst = dst,
-			isMutable = isMutable,
-			src = oper src}
-	     | Move {dst, src} => Move {dst = oper dst, src = oper src}
-	     | Object _ => s
-	     | PrimApp {args, dst, prim} =>
-		  PrimApp {args = Vector.map (args, oper),
-			   dst = dst,
-			   prim = prim}
-	     | Profile _ => s
-	     | ProfileLabel _ => s
-	     | SetExnStackLocal => s
-	     | SetExnStackSlot => s
-	     | SetHandler _ => s
-	     | SetSlotExnStack => s
-	 end
+         let
+            fun oper (z: Operand.t): Operand.t =
+               Operand.replaceVar (z, f)
+         in
+            case s of
+               Bind {dst, isMutable, src} =>
+                  Bind {dst = dst,
+                        isMutable = isMutable,
+                        src = oper src}
+             | Move {dst, src} => Move {dst = oper dst, src = oper src}
+             | Object _ => s
+             | PrimApp {args, dst, prim} =>
+                  PrimApp {args = Vector.map (args, oper),
+                           dst = dst,
+                           prim = prim}
+             | Profile _ => s
+             | ProfileLabel _ => s
+             | SetExnStackLocal => s
+             | SetExnStackSlot => s
+             | SetHandler _ => s
+             | SetSlotExnStack => s
+         end
 
       val layout =
-	 let
-	    open Layout
-	 in
-	    fn Bind {dst = (x, t), src, ...} =>
-		  seq [Var.layout x, constrain t, str " = ", Operand.layout src]
-	     | Move {dst, src} =>
-		  mayAlign [Operand.layout dst,
-			    seq [str " = ", Operand.layout src]]
-	     | Object {dst = (dst, ty), header, size} =>
-		  mayAlign
-		  [seq [Var.layout dst, constrain ty],
-		   seq [str "= Object ",
-			record [("header", seq [str "0x", Word.layout header]),
-				("size", Words.layout size)]]]
-	     | PrimApp {dst, prim, args, ...} =>
-		  let
-		     val rest =
-			seq [Prim.layout prim, str " ",
-			     Vector.layout Operand.layout args]
-		  in
-		     case dst of
-			NONE => rest
-		      | SOME (x, t) =>
-			   mayAlign [seq [Var.layout x, constrain t],
-				     seq [str "= ", rest]]
-		  end
-	     | Profile e => ProfileExp.layout e
-	     | ProfileLabel p =>
-		  seq [str "ProfileLabel ", ProfileLabel.layout p]
-	     | SetExnStackLocal => str "SetExnStackLocal"
-	     | SetExnStackSlot => str "SetExnStackSlot "
-	     | SetHandler l => seq [str "SetHandler ", Label.layout l]
-	     | SetSlotExnStack => str "SetSlotExnStack "
-	 end
+         let
+            open Layout
+         in
+            fn Bind {dst = (x, t), src, ...} =>
+                  seq [Var.layout x, constrain t, str " = ", Operand.layout src]
+             | Move {dst, src} =>
+                  mayAlign [Operand.layout dst,
+                            seq [str " = ", Operand.layout src]]
+             | Object {dst = (dst, ty), header, size} =>
+                  mayAlign
+                  [seq [Var.layout dst, constrain ty],
+                   seq [str "= Object ",
+                        record [("header", seq [str "0x", Word.layout header]),
+                                ("size", Words.layout size)]]]
+             | PrimApp {dst, prim, args, ...} =>
+                  let
+                     val rest =
+                        seq [Prim.layout prim, str " ",
+                             Vector.layout Operand.layout args]
+                  in
+                     case dst of
+                        NONE => rest
+                      | SOME (x, t) =>
+                           mayAlign [seq [Var.layout x, constrain t],
+                                     seq [str "= ", rest]]
+                  end
+             | Profile e => ProfileExp.layout e
+             | ProfileLabel p =>
+                  seq [str "ProfileLabel ", ProfileLabel.layout p]
+             | SetExnStackLocal => str "SetExnStackLocal"
+             | SetExnStackSlot => str "SetExnStackSlot "
+             | SetHandler l => seq [str "SetHandler ", Label.layout l]
+             | SetSlotExnStack => str "SetSlotExnStack "
+         end
 
       val toString = Layout.toString o layout
 
       fun clear (s: t) =
-	 foreachDef (s, Var.clear o #1)
+         foreachDef (s, Var.clear o #1)
 
       fun resize (z: Operand.t, b: Bits.t): Operand.t * t list =
-	 let
-	    val ty = Operand.ty z
-	    val w = Type.width ty
-	 in
-	    if Bits.equals (b, w)
-	       then (z, [])
-	    else
-	       let
-		  val tmp = Var.newNoname ()
-		  val tmpTy = Type.resize (ty, b)
-	       in
-		  (Operand.Var {ty = tmpTy, var = tmp},
-		   [PrimApp {args = Vector.new1 z,
-			     dst = SOME (tmp, tmpTy),
-			     prim = Prim.wordToWord (WordSize.fromBits w,
-						     WordSize.fromBits b,
-						     {signed = false})}])
-	       end
-	 end
+         let
+            val ty = Operand.ty z
+            val w = Type.width ty
+         in
+            if Bits.equals (b, w)
+               then (z, [])
+            else
+               let
+                  val tmp = Var.newNoname ()
+                  val tmpTy = Type.resize (ty, b)
+               in
+                  (Operand.Var {ty = tmpTy, var = tmp},
+                   [PrimApp {args = Vector.new1 z,
+                             dst = SOME (tmp, tmpTy),
+                             prim = Prim.wordToWord (WordSize.fromBits w,
+                                                     WordSize.fromBits b,
+                                                     {signed = false})}])
+               end
+         end
    end
 datatype z = datatype Statement.t
 
 structure Transfer =
    struct
       datatype t =
-	 Arith of {args: Operand.t vector,
-		   dst: Var.t,
-		   overflow: Label.t,
-		   prim: Type.t Prim.t,
-		   success: Label.t,
-		   ty: Type.t}
+         Arith of {args: Operand.t vector,
+                   dst: Var.t,
+                   overflow: Label.t,
+                   prim: Type.t Prim.t,
+                   success: Label.t,
+                   ty: Type.t}
        | CCall of {args: Operand.t vector,
-		   func: Type.t CFunction.t,
-		   return: Label.t option}
+                   func: Type.t CFunction.t,
+                   return: Label.t option}
        | Call of {args: Operand.t vector,
-		  func: Func.t,
-		  return: Return.t}
+                  func: Func.t,
+                  return: Return.t}
        | Goto of {args: Operand.t vector,
-		  dst: Label.t}
+                  dst: Label.t}
        | Raise of Operand.t vector
        | Return of Operand.t vector
        | Switch of Switch.t
 
       fun layout t =
-	 let
-	    open Layout
-	 in
-	    case t of
-	       Arith {args, dst, overflow, prim, success, ty} =>
-		  seq [str "Arith ",
-		       record [("args", Vector.layout Operand.layout args),
-			       ("dst", Var.layout dst),
-			       ("overflow", Label.layout overflow),
-			       ("prim", Prim.layout prim),
-			       ("success", Label.layout success),
-			       ("ty", Type.layout ty)]]
-	     | CCall {args, func, return} =>
-		  seq [str "CCall ",
-		       record [("args", Vector.layout Operand.layout args),
-			       ("func", CFunction.layout (func, Type.layout)),
-			       ("return", Option.layout Label.layout return)]]
-	     | Call {args, func, return} =>
-		  seq [Func.layout func, str " ",
-		       Vector.layout Operand.layout args,
-		       str " ", Return.layout return]
-	     | Goto {dst, args} =>
-		  seq [Label.layout dst, str " ",
-		       Vector.layout Operand.layout args]
-	     | Raise xs => seq [str "raise ", Vector.layout Operand.layout xs]
-	     | Return xs => seq [str "return ", Vector.layout Operand.layout xs]
-	     | Switch s => Switch.layout s
-	 end
+         let
+            open Layout
+         in
+            case t of
+               Arith {args, dst, overflow, prim, success, ty} =>
+                  seq [str "Arith ",
+                       record [("args", Vector.layout Operand.layout args),
+                               ("dst", Var.layout dst),
+                               ("overflow", Label.layout overflow),
+                               ("prim", Prim.layout prim),
+                               ("success", Label.layout success),
+                               ("ty", Type.layout ty)]]
+             | CCall {args, func, return} =>
+                  seq [str "CCall ",
+                       record [("args", Vector.layout Operand.layout args),
+                               ("func", CFunction.layout (func, Type.layout)),
+                               ("return", Option.layout Label.layout return)]]
+             | Call {args, func, return} =>
+                  seq [Func.layout func, str " ",
+                       Vector.layout Operand.layout args,
+                       str " ", Return.layout return]
+             | Goto {dst, args} =>
+                  seq [Label.layout dst, str " ",
+                       Vector.layout Operand.layout args]
+             | Raise xs => seq [str "raise ", Vector.layout Operand.layout xs]
+             | Return xs => seq [str "return ", Vector.layout Operand.layout xs]
+             | Switch s => Switch.layout s
+         end
 
       val bug =
-	 CCall {args = (Vector.new1
-			(Operand.Const
-			 (Const.string "control shouldn't reach here"))),
-		func = Type.BuiltInCFunction.bug,
-		return = NONE}
+         CCall {args = (Vector.new1
+                        (Operand.Const
+                         (Const.string "control shouldn't reach here"))),
+                func = Type.BuiltInCFunction.bug,
+                return = NONE}
 
       fun 'a foldDefLabelUse (t, a: 'a,
-			      {def: Var.t * Type.t * 'a -> 'a,
-			       label: Label.t * 'a -> 'a,
-			       use: Var.t * 'a -> 'a}): 'a =
-	 let
-	    fun useOperand (z, a) = Operand.foldVars (z, a, use)
-	    fun useOperands (zs: Operand.t vector, a) =
-	       Vector.fold (zs, a, useOperand)
-	 in
-	    case t of
-	       Arith {args, dst, overflow, success, ty, ...} =>
-		  let
-		     val a = label (overflow, a)
-		     val a = label (success, a)
-		     val a = def (dst, ty, a)
-		     val a = useOperands (args, a)
-		  in
-		     a
-		  end
-	     | CCall {args, return, ...} =>
-		  useOperands (args,
-			       case return of
-				  NONE => a
-				| SOME l => label (l, a))
-	     | Call {args, return, ...} =>
-		  useOperands (args, Return.foldLabel (return, a, label))
-	     | Goto {args, dst, ...} => label (dst, useOperands (args, a))
-	     | Raise zs => useOperands (zs, a)
-	     | Return zs => useOperands (zs, a)
-	     | Switch s => Switch.foldLabelUse (s, a, {label = label,
-						       use = useOperand})
-	 end
+                              {def: Var.t * Type.t * 'a -> 'a,
+                               label: Label.t * 'a -> 'a,
+                               use: Var.t * 'a -> 'a}): 'a =
+         let
+            fun useOperand (z, a) = Operand.foldVars (z, a, use)
+            fun useOperands (zs: Operand.t vector, a) =
+               Vector.fold (zs, a, useOperand)
+         in
+            case t of
+               Arith {args, dst, overflow, success, ty, ...} =>
+                  let
+                     val a = label (overflow, a)
+                     val a = label (success, a)
+                     val a = def (dst, ty, a)
+                     val a = useOperands (args, a)
+                  in
+                     a
+                  end
+             | CCall {args, return, ...} =>
+                  useOperands (args,
+                               case return of
+                                  NONE => a
+                                | SOME l => label (l, a))
+             | Call {args, return, ...} =>
+                  useOperands (args, Return.foldLabel (return, a, label))
+             | Goto {args, dst, ...} => label (dst, useOperands (args, a))
+             | Raise zs => useOperands (zs, a)
+             | Return zs => useOperands (zs, a)
+             | Switch s => Switch.foldLabelUse (s, a, {label = label,
+                                                       use = useOperand})
+         end
 
       fun foreachDefLabelUse (t, {def, label, use}) =
-	 foldDefLabelUse (t, (), {def = fn (x, t, ()) => def (x, t),
-				  label = label o #1,
-				  use = use o #1})
+         foldDefLabelUse (t, (), {def = fn (x, t, ()) => def (x, t),
+                                  label = label o #1,
+                                  use = use o #1})
 
       fun foldLabel (t, a, f) = foldDefLabelUse (t, a, {def = #3,
-							label = f,
-							use = #2})
+                                                        label = f,
+                                                        use = #2})
 
       fun foreachLabel (t, f) = foldLabel (t, (), f o #1)
 
       fun foldDef (t, a, f) = foldDefLabelUse (t, a, {def = f,
-						      label = #2,
-						      use = #2})
+                                                      label = #2,
+                                                      use = #2})
 
       fun foreachDef (t, f) =
-	 foldDef (t, (), fn (x, t, ()) => f (x, t))
+         foldDef (t, (), fn (x, t, ()) => f (x, t))
 
       fun foldUse (t, a, f) = foldDefLabelUse (t, a, {def = #3,
-						      label = #2,
-						      use = f})
+                                                      label = #2,
+                                                      use = f})
 
       fun foreachUse (t, f) = foldUse (t, (), f o #1)
 
       fun clear (t: t): unit =
-	 foreachDef (t, Var.clear o #1)
+         foreachDef (t, Var.clear o #1)
 
       local
-	 fun make i = WordX.fromIntInf (i, WordSize.default)
+         fun make i = WordX.fromIntInf (i, WordSize.default)
       in
-	 fun ifBool (test, {falsee, truee}) =
-	    Switch (Switch.T
-		    {cases = Vector.new2 ((make 0, falsee), (make 1, truee)),
-		     default = NONE,
-		     size = WordSize.default,
-		     test = test})
-	 fun ifZero (test, {falsee, truee}) =
-	    Switch (Switch.T
-		    {cases = Vector.new1 (make 0, truee),
-		     default = SOME falsee,
-		     size = WordSize.default,
-		     test = test})
+         fun ifBool (test, {falsee, truee}) =
+            Switch (Switch.T
+                    {cases = Vector.new2 ((make 0, falsee), (make 1, truee)),
+                     default = NONE,
+                     size = WordSize.default,
+                     test = test})
+         fun ifZero (test, {falsee, truee}) =
+            Switch (Switch.T
+                    {cases = Vector.new1 (make 0, truee),
+                     default = SOME falsee,
+                     size = WordSize.default,
+                     test = test})
       end
 
       fun replaceUses (t: t, f: Var.t -> Operand.t): t =
-	 let
-	    fun oper z = Operand.replaceVar (z, f)
-	    fun opers zs = Vector.map (zs, oper)
-	 in
-	    case t of
-	       Arith {args, dst, overflow, prim, success, ty} =>
-		  Arith {args = opers args,
-			 dst = dst,
-			 overflow = overflow,
-			 prim = prim,
-			 success = success,
-			 ty = ty}
-	     | CCall {args, func, return} =>
-		  CCall {args = opers args,
-			 func = func,
-			 return = return}
-	     | Call {args, func, return} =>
-		  Call {args = opers args,
-			func = func,
-			return = return}
-	     | Goto {args, dst} =>
-		  Goto {args = opers args,
-			dst = dst}
-	     | Raise zs => Raise (opers zs)
-	     | Return zs => Return (opers zs)
-	     | Switch s => Switch (Switch.replaceVar (s, f))
-	 end
+         let
+            fun oper z = Operand.replaceVar (z, f)
+            fun opers zs = Vector.map (zs, oper)
+         in
+            case t of
+               Arith {args, dst, overflow, prim, success, ty} =>
+                  Arith {args = opers args,
+                         dst = dst,
+                         overflow = overflow,
+                         prim = prim,
+                         success = success,
+                         ty = ty}
+             | CCall {args, func, return} =>
+                  CCall {args = opers args,
+                         func = func,
+                         return = return}
+             | Call {args, func, return} =>
+                  Call {args = opers args,
+                        func = func,
+                        return = return}
+             | Goto {args, dst} =>
+                  Goto {args = opers args,
+                        dst = dst}
+             | Raise zs => Raise (opers zs)
+             | Return zs => Return (opers zs)
+             | Switch s => Switch (Switch.replaceVar (s, f))
+         end
    end
 
 structure Kind =
    struct
       datatype t =
-	 Cont of {handler: Handler.t}
+         Cont of {handler: Handler.t}
        | CReturn of {func: Type.t CFunction.t}
        | Handler
        | Jump
 
       fun layout k =
-	 let
-	    open Layout
-	 in
-	    case k of
-	       Cont {handler} =>
-		  seq [str "Cont ",
-		       record [("handler", Handler.layout handler)]]
-	     | CReturn {func} =>
-		  seq [str "CReturn ",
-		       record [("func", CFunction.layout (func, Type.layout))]]
-	     | Handler => str "Handler"
-	     | Jump => str "Jump"
-	 end
+         let
+            open Layout
+         in
+            case k of
+               Cont {handler} =>
+                  seq [str "Cont ",
+                       record [("handler", Handler.layout handler)]]
+             | CReturn {func} =>
+                  seq [str "CReturn ",
+                       record [("func", CFunction.layout (func, Type.layout))]]
+             | Handler => str "Handler"
+             | Jump => str "Jump"
+         end
 
       datatype frameStyle = None | OffsetsAndSize | SizeOnly
       fun frameStyle (k: t): frameStyle =
-	 case k of
-	    Cont _ => OffsetsAndSize
-	  | CReturn {func, ...} =>
-	       if CFunction.mayGC func
-		  then OffsetsAndSize
-	       else if !Control.profile = Control.ProfileNone
-		       then None
-		    else SizeOnly
-	  | Handler => SizeOnly
-	  | Jump => None
+         case k of
+            Cont _ => OffsetsAndSize
+          | CReturn {func, ...} =>
+               if CFunction.mayGC func
+                  then OffsetsAndSize
+               else if !Control.profile = Control.ProfileNone
+                       then None
+                    else SizeOnly
+          | Handler => SizeOnly
+          | Jump => None
    end
 
 local
@@ -530,1129 +530,1160 @@
 in
    fun layoutFormals (xts: (Var.t * Type.t) vector) =
       Vector.layout (fn (x, t) =>
-		    seq [Var.layout x,
-			 if !Control.showTypes
-			    then seq [str ": ", Type.layout t]
-			 else empty])
+                    seq [Var.layout x,
+                         if !Control.showTypes
+                            then seq [str ": ", Type.layout t]
+                         else empty])
       xts
 end
 
 structure Block =
    struct
       datatype t =
-	 T of {args: (Var.t * Type.t) vector,
-	       kind: Kind.t,
-	       label: Label.t,
-	       statements: Statement.t vector,
-	       transfer: Transfer.t}
+         T of {args: (Var.t * Type.t) vector,
+               kind: Kind.t,
+               label: Label.t,
+               statements: Statement.t vector,
+               transfer: Transfer.t}
 
       local
-	 fun make f (T r) = f r
+         fun make f (T r) = f r
       in
-	 val args = make #args
-	 val kind = make #kind
-	 val label = make #label
-	 val statements = make #statements
-	 val transfer = make #transfer
+         val args = make #args
+         val kind = make #kind
+         val label = make #label
+         val statements = make #statements
+         val transfer = make #transfer
       end
    
       fun clear (T {args, label, statements, transfer, ...}) =
-	 (Vector.foreach (args, Var.clear o #1)
-	  ; Label.clear label
-	  ; Vector.foreach (statements, Statement.clear)
-	  ; Transfer.clear transfer)
+         (Vector.foreach (args, Var.clear o #1)
+          ; Label.clear label
+          ; Vector.foreach (statements, Statement.clear)
+          ; Transfer.clear transfer)
 
       fun layout (T {args, kind, label, statements, transfer, ...}) =
-	 let
-	    open Layout
-	 in
-	    align [seq [Label.layout label, str " ",
-			Vector.layout (fn (x, t) =>
-				       if !Control.showTypes
-					  then seq [Var.layout x, str ": ",
-						    Type.layout t]
-				       else Var.layout x) args,
-			str " ", Kind.layout kind, str " = "],
-		   indent (align
-			   [align
-			    (Vector.toListMap (statements, Statement.layout)),
-			    Transfer.layout transfer],
-			   2)]
-	 end
+         let
+            open Layout
+         in
+            align [seq [Label.layout label, str " ",
+                        Vector.layout (fn (x, t) =>
+                                       if !Control.showTypes
+                                          then seq [Var.layout x, str ": ",
+                                                    Type.layout t]
+                                       else Var.layout x) args,
+                        str " ", Kind.layout kind, str " = "],
+                   indent (align
+                           [align
+                            (Vector.toListMap (statements, Statement.layout)),
+                            Transfer.layout transfer],
+                           2)]
+         end
    end
 
 structure Function =
    struct
       datatype t = T of {args: (Var.t * Type.t) vector,
-			 blocks: Block.t vector,
-			 name: Func.t,
-			 raises: Type.t vector option,
-			 returns: Type.t vector option,
-			 start: Label.t}
+                         blocks: Block.t vector,
+                         name: Func.t,
+                         raises: Type.t vector option,
+                         returns: Type.t vector option,
+                         start: Label.t}
 
       local
-	 fun make f (T r) = f r
+         fun make f (T r) = f r
       in
-	 val blocks = make #blocks
-	 val name = make #name
-	 val start = make #start
+         val blocks = make #blocks
+         val name = make #name
+         val start = make #start
       end
 
       fun dest (T r) = r
       val new = T
 
       fun clear (T {name, args, blocks, ...}) =
-	 (Func.clear name
-	  ; Vector.foreach (args, Var.clear o #1)
-	  ; Vector.foreach (blocks, Block.clear))
+         (Func.clear name
+          ; Vector.foreach (args, Var.clear o #1)
+          ; Vector.foreach (blocks, Block.clear))
 
       fun layoutHeader (T {args, name, raises, returns, start, ...}): Layout.t =
-	 let
-	    open Layout
-	 in
-	    seq [str "fun ", Func.layout name,
-		 str " ", layoutFormals args,
-		 if !Control.showTypes
-		    then seq [str ": ",
-			      record [("raises",
-				       Option.layout
-				       (Vector.layout Type.layout) raises),
-				      ("returns",
-				       Option.layout
-				       (Vector.layout Type.layout) returns)]]
-		 else empty,
-		 str " = ", Label.layout start, str " ()"]
-	 end
+         let
+            open Layout
+         in
+            seq [str "fun ", Func.layout name,
+                 str " ", layoutFormals args,
+                 if !Control.showTypes
+                    then seq [str ": ",
+                              record [("raises",
+                                       Option.layout
+                                       (Vector.layout Type.layout) raises),
+                                      ("returns",
+                                       Option.layout
+                                       (Vector.layout Type.layout) returns)]]
+                 else empty,
+                 str " = ", Label.layout start, str " ()"]
+         end
 
       fun layouts (f as T {blocks, ...}, output) =
-	 (output (layoutHeader f)
-	  ; Vector.foreach (blocks, fn b =>
-			    output (Layout.indent (Block.layout b, 2))))
+         (output (layoutHeader f)
+          ; Vector.foreach (blocks, fn b =>
+                            output (Layout.indent (Block.layout b, 2))))
 
       fun layout (f as T {blocks, ...}) =
-	 let
-	    open Layout
-	 in
-	    align [layoutHeader f,
-		   indent (align (Vector.toListMap (blocks, Block.layout)), 2)]
-	 end
+         let
+            open Layout
+         in
+            align [layoutHeader f,
+                   indent (align (Vector.toListMap (blocks, Block.layout)), 2)]
+         end
 
       fun foreachVar (T {args, blocks, ...}, f) =
-	 (Vector.foreach (args, f)
-	  ; (Vector.foreach
-	     (blocks, fn Block.T {args, statements, transfer, ...} =>
-	      (Vector.foreach (args, f)
-	       ; Vector.foreach (statements, fn s => Statement.foreachDef (s, f))
-	       ; Transfer.foreachDef (transfer, f)))))
+         (Vector.foreach (args, f)
+          ; (Vector.foreach
+             (blocks, fn Block.T {args, statements, transfer, ...} =>
+              (Vector.foreach (args, f)
+               ; Vector.foreach (statements, fn s => Statement.foreachDef (s, f))
+               ; Transfer.foreachDef (transfer, f)))))
 
       fun dfs (T {blocks, start, ...}, v) =
-	 let
-	    val numBlocks = Vector.length blocks
-	    val {get = labelIndex, set = setLabelIndex, rem, ...} =
-	       Property.getSetOnce (Label.plist,
-				    Property.initRaise ("index", Label.layout))
-	    val _ = Vector.foreachi (blocks, fn (i, Block.T {label, ...}) =>
-				     setLabelIndex (label, i))
-	    val visited = Array.array (numBlocks, false)
-	    fun visit (l: Label.t): unit =
-	       let
-		  val i = labelIndex l
-	       in
-		  if Array.sub (visited, i)
-		     then ()
-		  else
-		     let
-			val _ = Array.update (visited, i, true)
-			val b as Block.T {transfer, ...} =
-			   Vector.sub (blocks, i)
-			val v' = v b
-			val _ = Transfer.foreachLabel (transfer, visit)
-			val _ = v' ()
-		     in
-			()
-		     end
-	       end
-	    val _ = visit start
-	    val _ = Vector.foreach (blocks, rem o Block.label)
-	 in
-	    ()
-	 end
+         let
+            val numBlocks = Vector.length blocks
+            val {get = labelIndex, set = setLabelIndex, rem, ...} =
+               Property.getSetOnce (Label.plist,
+                                    Property.initRaise ("index", Label.layout))
+            val _ = Vector.foreachi (blocks, fn (i, Block.T {label, ...}) =>
+                                     setLabelIndex (label, i))
+            val visited = Array.array (numBlocks, false)
+            fun visit (l: Label.t): unit =
+               let
+                  val i = labelIndex l
+               in
+                  if Array.sub (visited, i)
+                     then ()
+                  else
+                     let
+                        val _ = Array.update (visited, i, true)
+                        val b as Block.T {transfer, ...} =
+                           Vector.sub (blocks, i)
+                        val v' = v b
+                        val _ = Transfer.foreachLabel (transfer, visit)
+                        val _ = v' ()
+                     in
+                        ()
+                     end
+               end
+            val _ = visit start
+            val _ = Vector.foreach (blocks, rem o Block.label)
+         in
+            ()
+         end
 
       structure Graph = DirectedGraph
       structure Node = Graph.Node
 
       fun dominatorTree (T {blocks, start, ...}): Block.t Tree.t =
-	 let
-	    open Dot
-	    val g = Graph.new ()
-	    fun newNode () = Graph.newNode g
-	    val {get = labelNode, ...} =
-	       Property.get
-	       (Label.plist, Property.initFun (fn _ => newNode ()))
-	    val {get = nodeInfo: unit Node.t -> {block: Block.t},
-		 set = setNodeInfo, ...} =
-	       Property.getSetOnce
-	       (Node.plist, Property.initRaise ("info", Node.layout))
-	    val () =
-	       Vector.foreach
-	       (blocks, fn b as Block.T {label, ...}=>
-		setNodeInfo (labelNode label, {block = b}))
-	    val () =
-	       Vector.foreach
-	       (blocks, fn Block.T {label, transfer, ...} =>
-		let
-		   val from = labelNode label
-		   val _ =
-		      Transfer.foreachLabel
-		      (transfer, fn to =>
-		       (ignore o Graph.addEdge) 
-		       (g, {from = from, to = labelNode to}))
-		in
-		   ()
-		end)
-	 in
-	    Graph.dominatorTree (g, {root = labelNode start,
-				     nodeValue = #block o nodeInfo})
-	 end
+         let
+            open Dot
+            val g = Graph.new ()
+            fun newNode () = Graph.newNode g
+            val {get = labelNode, ...} =
+               Property.get
+               (Label.plist, Property.initFun (fn _ => newNode ()))
+            val {get = nodeInfo: unit Node.t -> {block: Block.t},
+                 set = setNodeInfo, ...} =
+               Property.getSetOnce
+               (Node.plist, Property.initRaise ("info", Node.layout))
+            val () =
+               Vector.foreach
+               (blocks, fn b as Block.T {label, ...}=>
+                setNodeInfo (labelNode label, {block = b}))
+            val () =
+               Vector.foreach
+               (blocks, fn Block.T {label, transfer, ...} =>
+                let
+                   val from = labelNode label
+                   val _ =
+                      Transfer.foreachLabel
+                      (transfer, fn to =>
+                       (ignore o Graph.addEdge) 
+                       (g, {from = from, to = labelNode to}))
+                in
+                   ()
+                end)
+         in
+            Graph.dominatorTree (g, {root = labelNode start,
+                                     nodeValue = #block o nodeInfo})
+         end
 
+      fun dropProfile (f: t): t =
+         let
+            val {args, blocks, name, raises, returns, start} = dest f
+            val blocks =
+               Vector.map
+               (blocks, fn Block.T {args, kind, label, statements, transfer} =>
+                Block.T {args = args,
+                         kind = kind,
+                         label = label,
+                         statements = Vector.keepAll
+                                      (statements,
+                                       fn Statement.Profile _ => false
+                                        | Statement.ProfileLabel _ => false
+                                        | _ => true),
+                         transfer = transfer})
+         in
+            new {args = args,
+                 blocks = blocks,
+                 name = name,
+                 raises = raises,
+                 returns = returns,
+                 start = start}
+         end
+
       fun shrink (f: t): t =
-	 let
-	    val {args, blocks, name, raises, returns, start} = dest f
-	    val {get = labelInfo, rem, set = setLabelInfo, ...} =
-	       Property.getSetOnce
-	       (Label.plist, Property.initRaise ("info", Label.layout))
-	    val () =
-	       Vector.foreach
-	       (blocks, fn block as Block.T {label, ...} =>
-		setLabelInfo (label, {block = block,
-				      inline = ref false,
-				      occurrences = ref 0}))
-	    fun visitLabel l = Int.inc (#occurrences (labelInfo l))
-	    val () = visitLabel start
-	    val () =
-	       Vector.foreach (blocks, fn Block.T {transfer, ...} =>
-			       Transfer.foreachLabel (transfer, visitLabel))
-	    datatype z = datatype Statement.t
-	    datatype z = datatype Transfer.t
-	    val () =
-	       Vector.foreach
-	       (blocks, fn Block.T {transfer, ...} =>
-		case transfer of
-		   Goto {dst, ...} =>
-		      let
-			 val {inline, occurrences, ...} = labelInfo dst
-		      in
-			 if 1 = !occurrences
-			    then inline := true
-			 else ()
-		      end
-		 | _ => ())
-	    fun expand (ss: Statement.t vector list, t: Transfer.t)
-	       : Statement.t vector * Transfer.t =
-	       let
-		  fun done () = (Vector.concat (rev ss), t)
-	       in
-		  case t of
-		     Goto {args, dst} =>
-			let
-			   val {block, inline, ...} = labelInfo dst
-			in
-			   if not (!inline)
-			      then done ()
-			   else
-			      let
-				 val Block.T {args = formals, statements,
-					      transfer, ...} =
-				    block
-				 val binds =
-				    Vector.map2
-				    (formals, args, fn (dst, src) =>
-				     Bind {dst = dst,
-					   isMutable = false,
-					   src = src})
-			      in
-				 expand (statements :: binds :: ss, transfer)
-			      end
-			end
-		   | _ => done ()
-	       end
-	    val blocks =
-	       Vector.fromList
-	       (Vector.fold
-		(blocks, [],
-		 fn (Block.T {args, kind, label, statements, transfer}, ac) =>
-		 let
-		    val {inline, ...} = labelInfo label
-		 in
-		    if !inline
-		       then ac
-		    else
-		       let
-			  val (statements, transfer) =
-			     expand ([statements], transfer)
-		       in
-			  Block.T {args = args,
-				   kind = kind,
-				   label = label,
-				   statements = statements,
-				   transfer = transfer} :: ac
-		       end
-		 end))
-	    val () = Vector.foreach (blocks, rem o Block.label)
-	 in
-	    new {args = args,
-		 blocks = blocks,
-		 name = name,
-		 raises = raises,
-		 returns = returns,
-		 start = start}
-	 end
+         let
+            val {args, blocks, name, raises, returns, start} = dest f
+            val {get = labelInfo, rem, set = setLabelInfo, ...} =
+               Property.getSetOnce
+               (Label.plist, Property.initRaise ("info", Label.layout))
+            val () =
+               Vector.foreach
+               (blocks, fn block as Block.T {label, ...} =>
+                setLabelInfo (label, {block = block,
+                                      inline = ref false,
+                                      occurrences = ref 0}))
+            fun visitLabel l = Int.inc (#occurrences (labelInfo l))
+            val () = visitLabel start
+            val () =
+               Vector.foreach (blocks, fn Block.T {transfer, ...} =>
+                               Transfer.foreachLabel (transfer, visitLabel))
+            datatype z = datatype Statement.t
+            datatype z = datatype Transfer.t
+            val () =
+               Vector.foreach
+               (blocks, fn Block.T {transfer, ...} =>
+                case transfer of
+                   Goto {dst, ...} =>
+                      let
+                         val {inline, occurrences, ...} = labelInfo dst
+                      in
+                         if 1 = !occurrences
+                            then inline := true
+                         else ()
+                      end
+                 | _ => ())
+            fun expand (ss: Statement.t vector list, t: Transfer.t)
+               : Statement.t vector * Transfer.t =
+               let
+                  fun done () = (Vector.concat (rev ss), t)
+               in
+                  case t of
+                     Goto {args, dst} =>
+                        let
+                           val {block, inline, ...} = labelInfo dst
+                        in
+                           if not (!inline)
+                              then done ()
+                           else
+                              let
+                                 val Block.T {args = formals, statements,
+                                              transfer, ...} =
+                                    block
+                                 val binds =
+                                    Vector.map2
+                                    (formals, args, fn (dst, src) =>
+                                     Bind {dst = dst,
+                                           isMutable = false,
+                                           src = src})
+                              in
+                                 expand (statements :: binds :: ss, transfer)
+                              end
+                        end
+                   | _ => done ()
+               end
+            val blocks =
+               Vector.fromList
+               (Vector.fold
+                (blocks, [],
+                 fn (Block.T {args, kind, label, statements, transfer}, ac) =>
+                 let
+                    val {inline, ...} = labelInfo label
+                 in
+                    if !inline
+                       then ac
+                    else
+                       let
+                          val (statements, transfer) =
+                             expand ([statements], transfer)
+                       in
+                          Block.T {args = args,
+                                   kind = kind,
+                                   label = label,
+                                   statements = statements,
+                                   transfer = transfer} :: ac
+                       end
+                 end))
+            val () = Vector.foreach (blocks, rem o Block.label)
+         in
+            new {args = args,
+                 blocks = blocks,
+                 name = name,
+                 raises = raises,
+                 returns = returns,
+                 start = start}
+         end
    end
 
 structure Program =
    struct
       datatype t =
-	 T of {functions: Function.t list,
-	       handlesSignals: bool,
-	       main: Function.t,
-	       objectTypes: ObjectType.t vector}
+         T of {functions: Function.t list,
+               handlesSignals: bool,
+               main: Function.t,
+               objectTypes: ObjectType.t vector}
 
       fun clear (T {functions, main, ...}) =
-	 (List.foreach (functions, Function.clear)
-	  ; Function.clear main)
+         (List.foreach (functions, Function.clear)
+          ; Function.clear main)
 
       fun layouts (T {functions, main, objectTypes, ...},
-		   output': Layout.t -> unit): unit =
-	 let
-	    open Layout
-	    val output = output'
-	 in
-	    output (str "\nObjectTypes:")
-	    ; Vector.foreachi (objectTypes, fn (i, ty) =>
-			       output (seq [str "pt_", Int.layout i,
-					    str " = ", ObjectType.layout ty]))
-	    ; output (str "\nMain:")
-	    ; Function.layouts (main, output)
-	    ; output (str "\nFunctions:")
-	    ; List.foreach (functions, fn f => Function.layouts (f, output))
-	 end
+                   output': Layout.t -> unit): unit =
+         let
+            open Layout
+            val output = output'
+         in
+            output (str "\nObjectTypes:")
+            ; Vector.foreachi (objectTypes, fn (i, ty) =>
+                               output (seq [str "pt_", Int.layout i,
+                                            str " = ", ObjectType.layout ty]))
+            ; output (str "\nMain:")
+            ; Function.layouts (main, output)
+            ; output (str "\nFunctions:")
+            ; List.foreach (functions, fn f => Function.layouts (f, output))
+         end
 
+      fun dropProfile (T {functions, handlesSignals, main, objectTypes}) =
+         (Control.profile := Control.ProfileNone
+          ; T {functions = List.map (functions, Function.dropProfile),
+               handlesSignals = handlesSignals,
+               main = Function.dropProfile main,
+               objectTypes = objectTypes})
+
       fun copyProp (T {functions, handlesSignals, main, objectTypes, ...}): t =
-	 let
-	    val tracePrimApply =
-	       Trace.trace3
-	       ("Rssa.primApply",
-		Prim.layout,
-		List.layout (ApplyArg.layout (Var.layout o #var)),
-		Layout.ignore,
-		ApplyResult.layout (Var.layout o #var))
-	    val {get = replaceVar: Var.t -> Operand.t,
-		 set = setReplaceVar, ...} =
-	       Property.getSetOnce
-	       (Var.plist, Property.initRaise ("replacement", Var.layout))
-	    fun dontReplace (x: Var.t, t: Type.t): unit =
-	       setReplaceVar (x, Operand.Var {var = x, ty = t})
-	    fun loopStatement (s: Statement.t): Statement.t option =
-	       let
-		  val s = Statement.replaceUses (s, replaceVar)
-		  fun keep () =
-		     (Statement.foreachDef (s, dontReplace)
-		      ; SOME s)
-	       in
-		  case s of
-		     Bind {dst = (x, _), isMutable, src} =>
-			if isMutable
-			   then keep ()
-			else
-			   let
-			      datatype z = datatype Operand.t
-			   in
-			      if (case src of
-				     Const _ => true
-				   | Var _ => true
-				   | _ => false)
-				 then (setReplaceVar (x, src)
-				       ; NONE)
-			      else keep ()
-			   end
-		   | PrimApp {args, dst, prim} =>
-			let
-			   fun replace (z: Operand.t): Statement.t option =
-			      (Option.app (dst, fn (x, _) =>
-					   setReplaceVar (x, z))
-			       ; NONE)
-			   val applyArgs =
-			      Vector.keepAllMap
-			      (args, fn z =>
-			       case z of
-				  Operand.Const c => SOME (ApplyArg.Const c)
-				| Operand.Var x => SOME (ApplyArg.Var x)
-				| _ => NONE)
-			   datatype z = datatype ApplyResult.t
-			in
-			   if Vector.length args <> Vector.length applyArgs
-			      then keep ()
-			   else
-			      case (tracePrimApply
-				    Prim.apply
-				    (prim, Vector.toList applyArgs,
-				     fn ({var = x, ...}, {var = y, ...}) =>
-				     Var.equals (x, y))) of
-				 Apply (p, args) =>
-				    let
-				       val args =
-					  Vector.fromListMap (args, Operand.Var)
-				       val () = Option.app (dst, dontReplace)
-				    in
-				       SOME (PrimApp {args = args,
-						      dst = dst,
-						      prim = prim})
-				    end
-			       | Bool b => replace (Operand.bool b)
-			       | Const c => replace (Operand.Const c)
-			       | Overflow => keep ()
-			       | Unknown => keep ()
-			       | Var x => replace (Operand.Var x)
-			end
-		| _ => keep ()
-	       end
-	    fun loopTransfer t =
-	       (Transfer.foreachDef (t, dontReplace)
-		; Transfer.replaceUses (t, replaceVar))
-	    fun loopFormals args = Vector.foreach (args, dontReplace)
-	    fun loopFunction (f: Function.t): Function.t =
-	       let
-		  val {args, blocks, name, raises, returns, start} =
-		     Function.dest f
-		  val () = loopFormals args
-		  val blocks = ref []
-		  val () =
-		     Function.dfs
-		     (f, fn Block.T {args, kind, label, statements, transfer} =>
-		      let
-			 val () = loopFormals args
-			 val statements =
-			    Vector.keepAllMap (statements, loopStatement)
-			 val transfer = loopTransfer transfer
-			 val () =
-			    List.push
-			    (blocks, Block.T {args = args,
-					      kind = kind,
-					      label = label,
-					      statements = statements,
-					      transfer = transfer})
-		      in
-			 fn () => ()
-		      end)
-		  val blocks = Vector.fromList (!blocks)
-	       in
-		  Function.new {args = args,
-				blocks = blocks,
-				name = name,
-				raises = raises,
-				returns = returns,
-				start = start}
-	       end
-	    (* Must process main first, because it defines globals that are
-	     * used in other functions.
-	     *)
-	    val main = loopFunction main
-	    val functions = List.revMap (functions, loopFunction)
-	 in
-	    T {functions = functions,
-	       handlesSignals = handlesSignals,
-	       main = main,
-	       objectTypes = objectTypes}
-	 end
-		  
+         let
+            val tracePrimApply =
+               Trace.trace3
+               ("Rssa.copyProp.primApply",
+                Prim.layout,
+                List.layout (ApplyArg.layout (Var.layout o #var)),
+                Layout.ignore,
+                ApplyResult.layout (Var.layout o #var))
+            val {get = replaceVar: Var.t -> Operand.t,
+                 set = setReplaceVar, ...} =
+               Property.getSetOnce
+               (Var.plist, Property.initRaise ("replacement", Var.layout))
+            fun dontReplace (x: Var.t, t: Type.t): unit =
+               setReplaceVar (x, Operand.Var {var = x, ty = t})
+            fun loopStatement (s: Statement.t): Statement.t option =
+               let
+                  val s = Statement.replaceUses (s, replaceVar)
+                  fun keep () =
+                     (Statement.foreachDef (s, dontReplace)
+                      ; SOME s)
+               in
+                  case s of
+                     Bind {dst = (x, _), isMutable, src} =>
+                        if isMutable
+                           then keep ()
+                        else
+                           let
+                              datatype z = datatype Operand.t
+                           in
+                              if (case src of
+                                     Const _ => true
+                                   | Var _ => true
+                                   | _ => false)
+                                 then (setReplaceVar (x, src)
+                                       ; NONE)
+                              else keep ()
+                           end
+                   | PrimApp {args, dst, prim} =>
+                        let
+                           fun replace (z: Operand.t): Statement.t option =
+                              (Option.app (dst, fn (x, _) =>
+                                           setReplaceVar (x, z))
+                               ; NONE)
+                           val applyArgs =
+                              Vector.keepAllMap
+                              (args, fn z =>
+                               case z of
+                                  Operand.Const c => SOME (ApplyArg.Const c)
+                                | Operand.Var x => SOME (ApplyArg.Var x)
+                                | _ => NONE)
+                           datatype z = datatype ApplyResult.t
+                        in
+                           if Vector.length args <> Vector.length applyArgs
+                              then keep ()
+                           else
+                              case (tracePrimApply
+                                    Prim.apply
+                                    (prim, Vector.toList applyArgs,
+                                     fn ({var = x, ...}, {var = y, ...}) =>
+                                     Var.equals (x, y))) of
+                                 Apply (prim, args) =>
+                                    let
+                                       val args =
+                                          Vector.fromListMap (args, Operand.Var)
+                                       val () = Option.app (dst, dontReplace)
+                                    in
+                                       SOME (PrimApp {args = args,
+                                                      dst = dst,
+                                                      prim = prim})
+                                    end
+                               | Bool b => replace (Operand.bool b)
+                               | Const c => replace (Operand.Const c)
+                               | Overflow => keep ()
+                               | Unknown => keep ()
+                               | Var x => replace (Operand.Var x)
+                        end
+                | _ => keep ()
+               end
+            fun loopTransfer t =
+               (Transfer.foreachDef (t, dontReplace)
+                ; Transfer.replaceUses (t, replaceVar))
+            fun loopFormals args = Vector.foreach (args, dontReplace)
+            fun loopFunction (f: Function.t): Function.t =
+               let
+                  val {args, name, raises, returns, start, ...} =
+                     Function.dest f
+                  val () = loopFormals args
+                  val blocks = ref []
+                  val () =
+                     Function.dfs
+                     (f, fn Block.T {args, kind, label, statements, transfer} =>
+                      let
+                         val () = loopFormals args
+                         val statements =
+                            Vector.keepAllMap (statements, loopStatement)
+                         val transfer = loopTransfer transfer
+                         val () =
+                            List.push
+                            (blocks, Block.T {args = args,
+                                              kind = kind,
+                                              label = label,
+                                              statements = statements,
+                                              transfer = transfer})
+                      in
+                         fn () => ()
+                      end)
+                  val blocks = Vector.fromList (!blocks)
+               in
+                  Function.new {args = args,
+                                blocks = blocks,
+                                name = name,
+                                raises = raises,
+                                returns = returns,
+                                start = start}
+               end
+            (* Must process main first, because it defines globals that are
+             * used in other functions.
+             *)
+            val main = loopFunction main
+            val functions = List.revMap (functions, loopFunction)
+         in
+            T {functions = functions,
+               handlesSignals = handlesSignals,
+               main = main,
+               objectTypes = objectTypes}
+         end
+                  
       fun shrink (T {functions, handlesSignals, main, objectTypes}) =
-	 let
-	    val p = 
-	       T {functions = List.map (functions, Function.shrink),
-		  handlesSignals = handlesSignals,
-		  main = Function.shrink main,
-		  objectTypes = objectTypes}
-	    val p = copyProp p
-	    val () = clear p
-	 in
-	    p
-	 end
+         let
+            val p = 
+               T {functions = List.map (functions, Function.shrink),
+                  handlesSignals = handlesSignals,
+                  main = Function.shrink main,
+                  objectTypes = objectTypes}
+            val p = copyProp p
+            val () = clear p
+         in
+            p
+         end
 
       structure ExnStack =
-	 struct
-	    structure ZPoint =
-	       struct
-		  datatype t = Caller | Me
+         struct
+            structure ZPoint =
+               struct
+                  datatype t = Caller | Me
 
-		  val equals: t * t -> bool = op =
-	       
-		  val toString =
-		     fn Caller => "Caller"
-		      | Me => "Me"
+                  val equals: t * t -> bool = op =
+               
+                  val toString =
+                     fn Caller => "Caller"
+                      | Me => "Me"
 
-		  val layout = Layout.str o toString
-	       end
+                  val layout = Layout.str o toString
+               end
 
-	    structure L = FlatLattice (structure Point = ZPoint)
-	    open L
-	    structure Point = ZPoint
-	 
-	    val me = point Point.Me
-	 end
+            structure L = FlatLattice (structure Point = ZPoint)
+            open L
+            structure Point = ZPoint
+         
+            val me = point Point.Me
+         end
 
       structure HandlerLat = FlatLattice (structure Point = Label)
 
       structure HandlerInfo =
-	 struct
-	    datatype t = T of {block: Block.t,
-			       global: ExnStack.t,
-			       handler: HandlerLat.t,
-			       slot: ExnStack.t,
-			       visited: bool ref}
+         struct
+            datatype t = T of {block: Block.t,
+                               global: ExnStack.t,
+                               handler: HandlerLat.t,
+                               slot: ExnStack.t,
+                               visited: bool ref}
 
-	    fun new (b: Block.t): t =
-	       T {block = b,
-		  global = ExnStack.new (),
-		  handler = HandlerLat.new (),
-		  slot = ExnStack.new (),
-		  visited = ref false}
+            fun new (b: Block.t): t =
+               T {block = b,
+                  global = ExnStack.new (),
+                  handler = HandlerLat.new (),
+                  slot = ExnStack.new (),
+                  visited = ref false}
 
-	    fun layout (T {global, handler, slot, ...}) =
-	       Layout.record [("global", ExnStack.layout global),
-			      ("slot", ExnStack.layout slot),
-			      ("handler", HandlerLat.layout handler)]
-	 end
+            fun layout (T {global, handler, slot, ...}) =
+               Layout.record [("global", ExnStack.layout global),
+                              ("slot", ExnStack.layout slot),
+                              ("handler", HandlerLat.layout handler)]
+         end
 
       val traceGoto =
-	 Trace.trace ("checkHandlers.goto", Label.layout, Unit.layout)
-	 
+         Trace.trace ("Rssa.checkHandlers.goto", Label.layout, Unit.layout)
+         
       fun checkHandlers (T {functions, ...}) =
-	 let
-	    val debug = false
-	    fun checkFunction (f: Function.t): unit =
-	       let
-		  val {name, start, blocks, ...} = Function.dest f
-		  val {get = labelInfo: Label.t -> HandlerInfo.t,
-		       rem = remLabelInfo, 
-		       set = setLabelInfo} =
-		     Property.getSetOnce
-		     (Label.plist, Property.initRaise ("info", Label.layout))
-		  val _ =
-		     Vector.foreach
-		     (blocks, fn b =>
-		      setLabelInfo (Block.label b, HandlerInfo.new b))
-		  (* Do a DFS of the control-flow graph. *)
-		  fun visitLabel l = visitInfo (labelInfo l)
-		  and visitInfo
-		     (hi as HandlerInfo.T {block, global, handler, slot,
-					   visited, ...}): unit =
-		     if !visited
-			then ()
-		     else
-			let
-			   val _ = visited := true
-			   val Block.T {label, statements, transfer, ...} = block
-			   val _ =
-			      if debug
-				 then
-				    let
-				       open Layout
-				    in
-				       outputl
-				       (seq [str "visiting ",
-					     Label.layout label],
-					Out.error)
-				    end
-			      else ()
-			   datatype z = datatype Statement.t
-			   val {global, handler, slot} =
-			      Vector.fold
-			      (statements,
-			       {global = global, handler = handler, slot = slot},
-			       fn (s, {global, handler, slot}) =>
-			       case s of
-				  SetExnStackLocal => {global = ExnStack.me,
-						       handler = handler,
-						       slot = slot}
-				| SetExnStackSlot => {global = slot,
-						      handler = handler,
-						      slot = slot}
-				| SetSlotExnStack => {global = global,
-						      handler = handler,
-						      slot = global}
-				| SetHandler l => {global = global,
-						   handler = HandlerLat.point l,
-						   slot = slot}
-				| _ => {global = global,
-					handler = handler,
-					slot = slot})
-			   fun fail msg =
-			      (Control.message
-			       (Control.Silent, fn () =>
-				let open Layout
-				in align
-				   [str "before: ", HandlerInfo.layout hi,
-				    str "block: ", Block.layout block,
-				    seq [str "after: ",
-					 Layout.record
-					 [("global", ExnStack.layout global),
-					  ("slot", ExnStack.layout slot),
-					  ("handler",
-					   HandlerLat.layout handler)]],
-				    Vector.layout
-				    (fn Block.T {label, ...} =>
-				     seq [Label.layout label,
-					  str " ",
-					  HandlerInfo.layout (labelInfo label)])
-				    blocks]
-				end)
-			       ; Error.bug (concat ["handler mismatch at ", msg]))
-			   fun assert (msg, f) =
-			      if f
-				 then ()
-			      else fail msg
-			   fun goto (l: Label.t): unit =
-			      let
-				 val HandlerInfo.T {global = g, handler = h,
-						    slot = s, ...} =
-				    labelInfo l
-				 val _ =
-				    assert ("goto",
-					    ExnStack.<= (global, g)
-					    andalso ExnStack.<= (slot, s)
-					    andalso HandlerLat.<= (handler, h))
-			      in
-				 visitLabel l
-			      end
-			   val goto = traceGoto goto
-			   fun tail name =
-			      assert (name,
-				      ExnStack.forcePoint
-				      (global, ExnStack.Point.Caller))
-			   datatype z = datatype Transfer.t
-			in
-			   case transfer of
-			      Arith {overflow, success, ...} =>
-				 (goto overflow; goto success)
-			    | CCall {return, ...} => Option.app (return, goto)
-			    | Call {return, ...} =>
-				 assert
-				 ("return",
-				  let
-				     datatype z = datatype Return.t
-				  in
-				     case return of
-					Dead => true
-				      | NonTail {handler = h, ...} =>
-					   (case h of
-					       Handler.Caller =>
-						  ExnStack.forcePoint
-						  (global, ExnStack.Point.Caller)
-					     | Handler.Dead => true
-					     | Handler.Handle l =>
-						  let
-						     val res =
-							ExnStack.forcePoint
-							(global,
-							 ExnStack.Point.Me)
-							andalso
-							HandlerLat.forcePoint
-							(handler, l)
-						     val _ = goto l
-						  in
-						     res
-						  end)
-				      | Tail => true
-				  end)
-			    | Goto {dst, ...} => goto dst
-			    | Raise _ => tail "raise"
-			    | Return _ => tail "return"
-			    | Switch s => Switch.foreachLabel (s, goto)
-			end
-		  val info as HandlerInfo.T {global, ...} = labelInfo start
-		  val _ = ExnStack.forcePoint (global, ExnStack.Point.Caller)
-		  val _ = visitInfo info
-		  val _ =
-		     Control.diagnostics
-		     (fn display =>
-		      let
-			 open Layout
-			 val _ = 
-			    display (seq [str "checkHandlers ",
-					  Func.layout name])
-			 val _ =
-			    Vector.foreach
-			    (blocks, fn Block.T {label, ...} =>
-			     display (seq
-				      [Label.layout label,
-				       str " ",
-				       HandlerInfo.layout (labelInfo label)]))
-		      in
-			 ()
-		      end)
-		  val _ = Vector.foreach (blocks, fn b =>
-					  remLabelInfo (Block.label b))
-	       in
-		  ()
-	       end
-	    val _ = List.foreach (functions, checkFunction)
-	 in
-	    ()
-	 end
-	    
+         let
+            val debug = false
+            fun checkFunction (f: Function.t): unit =
+               let
+                  val {name, start, blocks, ...} = Function.dest f
+                  val {get = labelInfo: Label.t -> HandlerInfo.t,
+                       rem = remLabelInfo, 
+                       set = setLabelInfo} =
+                     Property.getSetOnce
+                     (Label.plist, Property.initRaise ("info", Label.layout))
+                  val _ =
+                     Vector.foreach
+                     (blocks, fn b =>
+                      setLabelInfo (Block.label b, HandlerInfo.new b))
+                  (* Do a DFS of the control-flow graph. *)
+                  fun visitLabel l = visitInfo (labelInfo l)
+                  and visitInfo
+                     (hi as HandlerInfo.T {block, global, handler, slot,
+                                           visited, ...}): unit =
+                     if !visited
+                        then ()
+                     else
+                        let
+                           val _ = visited := true
+                           val Block.T {label, statements, transfer, ...} = block
+                           val _ =
+                              if debug
+                                 then
+                                    let
+                                       open Layout
+                                    in
+                                       outputl
+                                       (seq [str "visiting ",
+                                             Label.layout label],
+                                        Out.error)
+                                    end
+                              else ()
+                           datatype z = datatype Statement.t
+                           val {global, handler, slot} =
+                              Vector.fold
+                              (statements,
+                               {global = global, handler = handler, slot = slot},
+                               fn (s, {global, handler, slot}) =>
+                               case s of
+                                  SetExnStackLocal => {global = ExnStack.me,
+                                                       handler = handler,
+                                                       slot = slot}
+                                | SetExnStackSlot => {global = slot,
+                                                      handler = handler,
+                                                      slot = slot}
+                                | SetSlotExnStack => {global = global,
+                                                      handler = handler,
+                                                      slot = global}
+                                | SetHandler l => {global = global,
+                                                   handler = HandlerLat.point l,
+                                                   slot = slot}
+                                | _ => {global = global,
+                                        handler = handler,
+                                        slot = slot})
+                           fun fail msg =
+                              (Control.message
+                               (Control.Silent, fn () =>
+                                let open Layout
+                                in align
+                                   [str "before: ", HandlerInfo.layout hi,
+                                    str "block: ", Block.layout block,
+                                    seq [str "after: ",
+                                         Layout.record
+                                         [("global", ExnStack.layout global),
+                                          ("slot", ExnStack.layout slot),
+                                          ("handler",
+                                           HandlerLat.layout handler)]],
+                                    Vector.layout
+                                    (fn Block.T {label, ...} =>
+                                     seq [Label.layout label,
+                                          str " ",
+                                          HandlerInfo.layout (labelInfo label)])
+                                    blocks]
+                                end)
+                               ; Error.bug (concat ["Rssa.checkHandlers: handler mismatch at ", msg]))
+                           fun assert (msg, f) =
+                              if f
+                                 then ()
+                              else fail msg
+                           fun goto (l: Label.t): unit =
+                              let
+                                 val HandlerInfo.T {global = g, handler = h,
+                                                    slot = s, ...} =
+                                    labelInfo l
+                                 val _ =
+                                    assert ("goto",
+                                            ExnStack.<= (global, g)
+                                            andalso ExnStack.<= (slot, s)
+                                            andalso HandlerLat.<= (handler, h))
+                              in
+                                 visitLabel l
+                              end
+                           val goto = traceGoto goto
+                           fun tail name =
+                              assert (name,
+                                      ExnStack.forcePoint
+                                      (global, ExnStack.Point.Caller))
+                           datatype z = datatype Transfer.t
+                        in
+                           case transfer of
+                              Arith {overflow, success, ...} =>
+                                 (goto overflow; goto success)
+                            | CCall {return, ...} => Option.app (return, goto)
+                            | Call {return, ...} =>
+                                 assert
+                                 ("return",
+                                  let
+                                     datatype z = datatype Return.t
+                                  in
+                                     case return of
+                                        Dead => true
+                                      | NonTail {handler = h, ...} =>
+                                           (case h of
+                                               Handler.Caller =>
+                                                  ExnStack.forcePoint
+                                                  (global, ExnStack.Point.Caller)
+                                             | Handler.Dead => true
+                                             | Handler.Handle l =>
+                                                  let
+                                                     val res =
+                                                        ExnStack.forcePoint
+                                                        (global,
+                                                         ExnStack.Point.Me)
+                                                        andalso
+                                                        HandlerLat.forcePoint
+                                                        (handler, l)
+                                                     val _ = goto l
+                                                  in
+                                                     res
+                                                  end)
+                                      | Tail => true
+                                  end)
+                            | Goto {dst, ...} => goto dst
+                            | Raise _ => tail "raise"
+                            | Return _ => tail "return"
+                            | Switch s => Switch.foreachLabel (s, goto)
+                        end
+                  val info as HandlerInfo.T {global, ...} = labelInfo start
+                  val _ = ExnStack.forcePoint (global, ExnStack.Point.Caller)
+                  val _ = visitInfo info
+                  val _ =
+                     Control.diagnostics
+                     (fn display =>
+                      let
+                         open Layout
+                         val _ = 
+                            display (seq [str "checkHandlers ",
+                                          Func.layout name])
+                         val _ =
+                            Vector.foreach
+                            (blocks, fn Block.T {label, ...} =>
+                             display (seq
+                                      [Label.layout label,
+                                       str " ",
+                                       HandlerInfo.layout (labelInfo label)]))
+                      in
+                         ()
+                      end)
+                  val _ = Vector.foreach (blocks, fn b =>
+                                          remLabelInfo (Block.label b))
+               in
+                  ()
+               end
+            val _ = List.foreach (functions, checkFunction)
+         in
+            ()
+         end
+            
       fun checkScopes (program as T {functions, main, ...}): unit =
-	 let
-	    datatype status =
-	       Defined
-	     | Global
-	     | InScope
-	     | Undefined
-	    fun make (layout, plist) =
-	       let
-		  val {get, set, ...} =
-		     Property.getSet (plist, Property.initConst Undefined)
-		  fun bind (x, isGlobal) =
-		     case get x of
-			Global => ()
-		      | Undefined =>
-			   set (x, if isGlobal then Global else InScope)
-		      | _ => Error.bug ("duplicate definition of "
-					^ (Layout.toString (layout x)))
-		  fun reference x =
-		     case get x of
-			Global => ()
-		      | InScope => ()
-		      | _ => Error.bug (concat
-					["reference to ",
-					 Layout.toString (layout x),
-					 " not in scope"])
-		  fun unbind x =
-		     case get x of
-			Global => ()
-		      | _ => set (x, Defined)
-	       in (bind, reference, unbind)
-	       end
-	    val (bindVar, getVar, unbindVar) = make (Var.layout, Var.plist)
-	    val bindVar =
-	       Trace.trace2
-	       ("Rssa.bindVar", Var.layout, Bool.layout, Unit.layout)
-	       bindVar
-	    val getVar =
-	       Trace.trace ("Rssa.getVar", Var.layout, Unit.layout) getVar
-	    val unbindVar =
-	       Trace.trace ("Rssa.unbindVar", Var.layout, Unit.layout) unbindVar
-	    val (bindFunc, _, _) = make (Func.layout, Func.plist)
-	    val bindFunc = fn f => bindFunc (f, false)
-	    val (bindLabel, getLabel, unbindLabel) =
-	       make (Label.layout, Label.plist)
-	    val bindLabel = fn l => bindLabel (l, false)
-	    fun loopFunc (f: Function.t, isMain: bool): unit =
-	       let
-		  val bindVar = fn x => bindVar (x, isMain)
-		  val {args, blocks, ...} = Function.dest f
-		  val _ = Vector.foreach (args, bindVar o #1)
-		  val _ = Vector.foreach (blocks, bindLabel o Block.label)
-		  val _ =
-		     Vector.foreach
-		     (blocks, fn Block.T {transfer, ...} =>
-		      Transfer.foreachLabel (transfer, getLabel))
-		  (* Descend the dominator tree, verifying that variable
-		   * definitions dominate variable uses.
-		   *)
-		  val _ =
-		     Tree.traverse
-		     (Function.dominatorTree f,
-		      fn Block.T {args, statements, transfer, ...} =>
-		      let
-			 val _ = Vector.foreach (args, bindVar o #1)
-			 val _ =
-			    Vector.foreach
-			    (statements, fn s =>
-			     (Statement.foreachUse (s, getVar)
-			      ; Statement.foreachDef (s, bindVar o #1)))
-			 val _ = Transfer.foreachUse (transfer, getVar)
-			 val _ = Transfer.foreachDef (transfer, bindVar o #1)
-		      in
-			 fn () =>
-			 if isMain
-			    then ()
-			 else
-			    let
-			       val _ =
-				  Vector.foreach
-				  (statements, fn s =>
-				   Statement.foreachDef (s, unbindVar o #1))
-			       val _ =
-				  Transfer.foreachDef (transfer, unbindVar o #1)
-			       val _ = Vector.foreach (args, unbindVar o #1)
-			    in
-			       ()
-			    end
-		      end)
-		  val _ = Vector.foreach (blocks, unbindLabel o Block.label)
-		  val _ = Vector.foreach (args, unbindVar o #1)
-	       in
-		  ()
-	       end
-	    val _ = List.foreach (functions, bindFunc o Function.name)
-	    val _ = loopFunc (main, true)
-	    val _ = List.foreach (functions, fn f => loopFunc (f, false))
-	    val _ = clear program
-	 in ()
-	 end
+         let
+            datatype status =
+               Defined
+             | Global
+             | InScope
+             | Undefined
+            fun make (layout, plist) =
+               let
+                  val {get, set, ...} =
+                     Property.getSet (plist, Property.initConst Undefined)
+                  fun bind (x, isGlobal) =
+                     case get x of
+                        Global => ()
+                      | Undefined =>
+                           set (x, if isGlobal then Global else InScope)
+                      | _ => Error.bug ("Rssa.checkScopes: duplicate definition of "
+                                        ^ (Layout.toString (layout x)))
+                  fun reference x =
+                     case get x of
+                        Global => ()
+                      | InScope => ()
+                      | _ => Error.bug (concat
+                                        ["Rssa.checkScopes: reference to ",
+                                         Layout.toString (layout x),
+                                         " not in scope"])
+                  fun unbind x =
+                     case get x of
+                        Global => ()
+                      | _ => set (x, Defined)
+               in (bind, reference, unbind)
+               end
+            val (bindVar, getVar, unbindVar) = make (Var.layout, Var.plist)
+            val bindVar =
+               Trace.trace2
+               ("Rssa.bindVar", Var.layout, Bool.layout, Unit.layout)
+               bindVar
+            val getVar =
+               Trace.trace ("Rssa.getVar", Var.layout, Unit.layout) getVar
+            val unbindVar =
+               Trace.trace ("Rssa.unbindVar", Var.layout, Unit.layout) unbindVar
+            val (bindFunc, _, _) = make (Func.layout, Func.plist)
+            val bindFunc = fn f => bindFunc (f, false)
+            val (bindLabel, getLabel, unbindLabel) =
+               make (Label.layout, Label.plist)
+            val bindLabel = fn l => bindLabel (l, false)
+            fun loopFunc (f: Function.t, isMain: bool): unit =
+               let
+                  val bindVar = fn x => bindVar (x, isMain)
+                  val {args, blocks, ...} = Function.dest f
+                  val _ = Vector.foreach (args, bindVar o #1)
+                  val _ = Vector.foreach (blocks, bindLabel o Block.label)
+                  val _ =
+                     Vector.foreach
+                     (blocks, fn Block.T {transfer, ...} =>
+                      Transfer.foreachLabel (transfer, getLabel))
+                  (* Descend the dominator tree, verifying that variable
+                   * definitions dominate variable uses.
+                   *)
+                  val _ =
+                     Tree.traverse
+                     (Function.dominatorTree f,
+                      fn Block.T {args, statements, transfer, ...} =>
+                      let
+                         val _ = Vector.foreach (args, bindVar o #1)
+                         val _ =
+                            Vector.foreach
+                            (statements, fn s =>
+                             (Statement.foreachUse (s, getVar)
+                              ; Statement.foreachDef (s, bindVar o #1)))
+                         val _ = Transfer.foreachUse (transfer, getVar)
+                         val _ = Transfer.foreachDef (transfer, bindVar o #1)
+                      in
+                         fn () =>
+                         if isMain
+                            then ()
+                         else
+                            let
+                               val _ =
+                                  Vector.foreach
+                                  (statements, fn s =>
+                                   Statement.foreachDef (s, unbindVar o #1))
+                               val _ =
+                                  Transfer.foreachDef (transfer, unbindVar o #1)
+                               val _ = Vector.foreach (args, unbindVar o #1)
+                            in
+                               ()
+                            end
+                      end)
+                  val _ = Vector.foreach (blocks, unbindLabel o Block.label)
+                  val _ = Vector.foreach (args, unbindVar o #1)
+               in
+                  ()
+               end
+            val _ = List.foreach (functions, bindFunc o Function.name)
+            val _ = loopFunc (main, true)
+            val _ = List.foreach (functions, fn f => loopFunc (f, false))
+            val _ = clear program
+         in ()
+         end
    
       fun typeCheck (p as T {functions, main, objectTypes, ...}) =
-	 let
-	    val _ =
-	       Vector.foreach
-	       (objectTypes, fn ty =>
-		Err.check ("objectType",
-			   fn () => ObjectType.isOk ty,
-			   fn () => ObjectType.layout ty))
-	    fun tyconTy (pt: PointerTycon.t): ObjectType.t =
-	       Vector.sub (objectTypes, PointerTycon.index pt)
-	    val () = checkScopes p
-	    val {get = labelBlock: Label.t -> Block.t,
-		 set = setLabelBlock, ...} =
-	       Property.getSetOnce (Label.plist,
-				    Property.initRaise ("block", Label.layout))
-	    val {get = funcInfo, set = setFuncInfo, ...} =
-	       Property.getSetOnce (Func.plist,
-				    Property.initRaise ("info", Func.layout))
-	    val {get = varType: Var.t -> Type.t, set = setVarType, ...} =
-	       Property.getSetOnce (Var.plist,
-				    Property.initRaise ("type", Var.layout))
-	    val setVarType =
-	       Trace.trace2 ("setVarType", Var.layout, Type.layout,
-			     Unit.layout)
-	       setVarType
-	    fun checkOperand (x: Operand.t): unit =
-		let
-		   datatype z = datatype Operand.t
-		   fun ok () =
-		      case x of
-			 ArrayOffset {base, index, offset, scale, ty} =>
-			    (checkOperand base
-			     ; checkOperand index
-			     ; Type.arrayOffsetIsOk {base = Operand.ty base,
-						     index = Operand.ty index,
-						     offset = offset,
-						     pointerTy = tyconTy,
-						     result = ty,
-						     scale = scale})
-		       | Cast (z, ty) =>
-			    (checkOperand z
-			    ; Type.castIsOk {from = Operand.ty z,
-					     to = ty,
-					     tyconTy = tyconTy})
-		       | Const _ => true
-		       | EnsuresBytesFree => true
-		       | File => true
-		       | GCState => true
-		       | Line => true
-		       | Offset {base, offset, ty} =>
-			    Type.offsetIsOk {base = Operand.ty base,
-					     offset = offset,
-					     pointerTy = tyconTy,
-					     result = ty}
-		       | PointerTycon _ => true
-		       | Runtime _ => true
-		       | Var {ty, var} => Type.isSubtype (varType var, ty)
-		in
-		   Err.check ("operand", ok, fn () => Operand.layout x)
-		end
-	    val checkOperand =
-	       Trace.trace ("checkOperand", Operand.layout, Unit.layout)
-	       checkOperand
-	    fun checkOperands v = Vector.foreach (v, checkOperand)
-	    fun check' (x, name, isOk, layout) =
-	       Err.check (name, fn () => isOk x, fn () => layout x)
-	    val labelKind = Block.kind o labelBlock
-	    fun statementOk (s: Statement.t): bool =
-	       let
-		  datatype z = datatype Statement.t
-	       in
-		  case s of
-		     Bind {src, dst = (_, dstTy), ...} =>
-			(checkOperand src
-			 ; Type.isSubtype (Operand.ty src, dstTy))
-		   | Move {dst, src} =>
-			(checkOperand dst
-			 ; checkOperand src
-			 ; (Type.isSubtype (Operand.ty src, Operand.ty dst)
-			    andalso Operand.isLocation dst))
-		   | Object {dst = (_, ty), header, size} =>
-			let
-			   val tycon =
-			      PointerTycon.fromIndex
-			      (Runtime.headerToTypeIndex header)
-			   val size = Words.toBytes size
-			in
-			   Type.isSubtype (Type.pointer tycon, ty)
-			   andalso
-			   Bytes.equals
-			   (size,
-			    Bytes.align
-			    (size,
-			     {alignment = (Bytes.fromInt
-					   (case !Control.align of
-					       Control.Align4 => 4
-					     | Control.Align8 => 8))}))
-			   andalso
-			   (case tyconTy tycon of
-			       ObjectType.Normal {ty, ...} =>
-				  Bytes.equals
-				  (size, Bytes.+ (Runtime.normalHeaderSize,
-						  Type.bytes ty))
-			      | _ => false)
-			end
-		   | PrimApp {args, dst, prim} =>
-			(Vector.foreach (args, checkOperand)
-			 ; (Type.checkPrimApp
-			    {args = Vector.map (args, Operand.ty),
-			     prim = prim,
-			     result = Option.map (dst, #2)}))
-		   | Profile _ => true
-		   | ProfileLabel _ => true
-		   | SetExnStackLocal => true
-		   | SetExnStackSlot => true
-		   | SetHandler l =>
-			(case labelKind l of
-			    Kind.Handler => true
-			  | _ => false)
-		   | SetSlotExnStack => true
-	       end
-	    fun goto {args: Type.t vector,
-		      dst: Label.t}: bool =
-	       let
-		  val Block.T {args = formals, kind, ...} = labelBlock dst
-	       in
-		  Vector.equals (args, formals, fn (t, (_, t')) =>
-				 Type.isSubtype (t, t'))
-		  andalso (case kind of
-			      Kind.Jump => true
-			    | _ => false)
-	       end
-	    fun labelIsNullaryJump l = goto {dst = l, args = Vector.new0 ()}
-	    fun tailIsOk (caller: Type.t vector option,
-			  callee: Type.t vector option): bool =
-	       case (caller, callee) of
-		  (_, NONE) => true
-		| (SOME caller, SOME callee) =>
-		     Vector.equals (callee, caller, Type.isSubtype)
-		| _ => false
-	    fun nonTailIsOk (formals: (Var.t * Type.t) vector,
-			     returns: Type.t vector option): bool =
-	       case returns of
-		  NONE => true
-		| SOME ts => 
-		     Vector.equals (formals, ts, fn ((_, t), t') =>
-				    Type.isSubtype (t', t))
-	    fun callIsOk {args, func, raises, return, returns} =
-	       let
-		  val Function.T {args = formals,
-				  raises = raises',
-				  returns = returns', ...} =
-		     funcInfo func
+         let
+            val _ =
+               Vector.foreach
+               (objectTypes, fn ty =>
+                Err.check ("objectType",
+                           fn () => ObjectType.isOk ty,
+                           fn () => ObjectType.layout ty))
+            fun tyconTy (pt: PointerTycon.t): ObjectType.t =
+               Vector.sub (objectTypes, PointerTycon.index pt)
+            val () = checkScopes p
+            val {get = labelBlock: Label.t -> Block.t,
+                 set = setLabelBlock, ...} =
+               Property.getSetOnce (Label.plist,
+                                    Property.initRaise ("block", Label.layout))
+            val {get = funcInfo, set = setFuncInfo, ...} =
+               Property.getSetOnce (Func.plist,
+                                    Property.initRaise ("info", Func.layout))
+            val {get = varType: Var.t -> Type.t, set = setVarType, ...} =
+               Property.getSetOnce (Var.plist,
+                                    Property.initRaise ("type", Var.layout))
+            val setVarType =
+               Trace.trace2 ("Rssa.setVarType", Var.layout, Type.layout,
+                             Unit.layout)
+               setVarType
+            fun checkOperand (x: Operand.t): unit =
+                let
+                   datatype z = datatype Operand.t
+                   fun ok () =
+                      case x of
+                         ArrayOffset {base, index, offset, scale, ty} =>
+                            (checkOperand base
+                             ; checkOperand index
+                             ; Type.arrayOffsetIsOk {base = Operand.ty base,
+                                                     index = Operand.ty index,
+                                                     offset = offset,
+                                                     pointerTy = tyconTy,
+                                                     result = ty,
+                                                     scale = scale})
+                       | Cast (z, ty) =>
+                            (checkOperand z
+                            ; Type.castIsOk {from = Operand.ty z,
+                                             to = ty,
+                                             tyconTy = tyconTy})
+                       | Const _ => true
+                       | EnsuresBytesFree => true
+                       | File => true
+                       | GCState => true
+                       | Line => true
+                       | Offset {base, offset, ty} =>
+                            Type.offsetIsOk {base = Operand.ty base,
+                                             offset = offset,
+                                             pointerTy = tyconTy,
+                                             result = ty}
+                       | PointerTycon _ => true
+                       | Runtime _ => true
+                       | Var {ty, var} => Type.isSubtype (varType var, ty)
+                in
+                   Err.check ("operand", ok, fn () => Operand.layout x)
+                end
+            val checkOperand =
+               Trace.trace ("Rssa.checkOperand", Operand.layout, Unit.layout)
+               checkOperand
+            fun checkOperands v = Vector.foreach (v, checkOperand)
+            fun check' (x, name, isOk, layout) =
+               Err.check (name, fn () => isOk x, fn () => layout x)
+            val labelKind = Block.kind o labelBlock
+            fun statementOk (s: Statement.t): bool =
+               let
+                  datatype z = datatype Statement.t
+               in
+                  case s of
+                     Bind {src, dst = (_, dstTy), ...} =>
+                        (checkOperand src
+                         ; Type.isSubtype (Operand.ty src, dstTy))
+                   | Move {dst, src} =>
+                        (checkOperand dst
+                         ; checkOperand src
+                         ; (Type.isSubtype (Operand.ty src, Operand.ty dst)
+                            andalso Operand.isLocation dst))
+                   | Object {dst = (_, ty), header, size} =>
+                        let
+                           val tycon =
+                              PointerTycon.fromIndex
+                              (Runtime.headerToTypeIndex header)
+                           val size = Words.toBytes size
+                        in
+                           Type.isSubtype (Type.pointer tycon, ty)
+                           andalso
+                           Bytes.equals
+                           (size,
+                            Bytes.align
+                            (size,
+                             {alignment = (Bytes.fromInt
+                                           (case !Control.align of
+                                               Control.Align4 => 4
+                                             | Control.Align8 => 8))}))
+                           andalso
+                           (case tyconTy tycon of
+                               ObjectType.Normal {ty, ...} =>
+                                  Bytes.equals
+                                  (size, Bytes.+ (Runtime.normalHeaderSize,
+                                                  Type.bytes ty))
+                              | _ => false)
+                        end
+                   | PrimApp {args, dst, prim} =>
+                        (Vector.foreach (args, checkOperand)
+                         ; (Type.checkPrimApp
+                            {args = Vector.map (args, Operand.ty),
+                             prim = prim,
+                             result = Option.map (dst, #2)}))
+                   | Profile _ => true
+                   | ProfileLabel _ => true
+                   | SetExnStackLocal => true
+                   | SetExnStackSlot => true
+                   | SetHandler l =>
+                        (case labelKind l of
+                            Kind.Handler => true
+                          | _ => false)
+                   | SetSlotExnStack => true
+               end
+            fun goto {args: Type.t vector,
+                      dst: Label.t}: bool =
+               let
+                  val Block.T {args = formals, kind, ...} = labelBlock dst
+               in
+                  Vector.equals (args, formals, fn (t, (_, t')) =>
+                                 Type.isSubtype (t, t'))
+                  andalso (case kind of
+                              Kind.Jump => true
+                            | _ => false)
+               end
+            fun labelIsNullaryJump l = goto {dst = l, args = Vector.new0 ()}
+            fun tailIsOk (caller: Type.t vector option,
+                          callee: Type.t vector option): bool =
+               case (caller, callee) of
+                  (_, NONE) => true
+                | (SOME caller, SOME callee) =>
+                     Vector.equals (callee, caller, Type.isSubtype)
+                | _ => false
+            fun nonTailIsOk (formals: (Var.t * Type.t) vector,
+                             returns: Type.t vector option): bool =
+               case returns of
+                  NONE => true
+                | SOME ts => 
+                     Vector.equals (formals, ts, fn ((_, t), t') =>
+                                    Type.isSubtype (t', t))
+            fun callIsOk {args, func, raises, return, returns} =
+               let
+                  val Function.T {args = formals,
+                                  raises = raises',
+                                  returns = returns', ...} =
+                     funcInfo func
 
-	       in
-		  Vector.equals (args, formals, fn (z, (_, t)) =>
-				 Type.isSubtype (Operand.ty z, t))
-		  andalso
-		  (case return of
-		      Return.Dead =>
-			 Option.isNone raises'
-			 andalso Option.isNone returns'
-		    | Return.NonTail {cont, handler} =>
-			 let
-			    val Block.T {args = cArgs, kind = cKind, ...} =
-			       labelBlock cont
-			 in
-			    nonTailIsOk (cArgs, returns')
-			    andalso
-			    (case cKind of
-				Kind.Cont {handler = h} =>
-				   Handler.equals (handler, h)
-				   andalso
-				   (case h of
-				       Handler.Caller =>
-					  tailIsOk (raises, raises')
-				     | Handler.Dead => true
-				     | Handler.Handle l =>
-					  let
-					     val Block.T {args = hArgs,
-							  kind = hKind, ...} =
-						labelBlock l
-					  in
-					     nonTailIsOk (hArgs, raises')
-					     andalso
-					     (case hKind of
-						 Kind.Handler => true
-					       | _ => false)
-					  end)
-			      | _ => false)
-			 end
-		    | Return.Tail =>
-			 tailIsOk (raises, raises')
-			 andalso tailIsOk (returns, returns'))
-	       end
+               in
+                  Vector.equals (args, formals, fn (z, (_, t)) =>
+                                 Type.isSubtype (Operand.ty z, t))
+                  andalso
+                  (case return of
+                      Return.Dead =>
+                         Option.isNone raises'
+                         andalso Option.isNone returns'
+                    | Return.NonTail {cont, handler} =>
+                         let
+                            val Block.T {args = cArgs, kind = cKind, ...} =
+                               labelBlock cont
+                         in
+                            nonTailIsOk (cArgs, returns')
+                            andalso
+                            (case cKind of
+                                Kind.Cont {handler = h} =>
+                                   Handler.equals (handler, h)
+                                   andalso
+                                   (case h of
+                                       Handler.Caller =>
+                                          tailIsOk (raises, raises')
+                                     | Handler.Dead => true
+                                     | Handler.Handle l =>
+                                          let
+                                             val Block.T {args = hArgs,
+                                                          kind = hKind, ...} =
+                                                labelBlock l
+                                          in
+                                             nonTailIsOk (hArgs, raises')
+                                             andalso
+                                             (case hKind of
+                                                 Kind.Handler => true
+                                               | _ => false)
+                                          end)
+                              | _ => false)
+                         end
+                    | Return.Tail =>
+                         tailIsOk (raises, raises')
+                         andalso tailIsOk (returns, returns'))
+               end
 
-	    fun checkFunction (Function.T {args, blocks, raises, returns, start,
-					   ...}) =
-	       let
-		  val _ = Vector.foreach (args, setVarType)
-		  val _ =
-		     Vector.foreach
-		     (blocks, fn b as Block.T {args, label, statements,
-					       transfer, ...} =>
-		      (setLabelBlock (label, b)
-		       ; Vector.foreach (args, setVarType)
-		       ; Vector.foreach (statements, fn s =>
-					 Statement.foreachDef
-					 (s, setVarType))
-		       ; Transfer.foreachDef (transfer, setVarType)))
-		  val _ = labelIsNullaryJump start
-		  fun transferOk (t: Transfer.t): bool =
-		     let
-			datatype z = datatype Transfer.t
-		     in
-			case t of
-			   Arith {args, overflow, prim, success, ty, ...} =>
-			      let
-				 val _ = checkOperands args
-			      in
-				 Prim.mayOverflow prim
-				 andalso labelIsNullaryJump overflow
-				 andalso labelIsNullaryJump success
-				 andalso
-				 Type.checkPrimApp
-				 {args = Vector.map (args, Operand.ty),
-				  prim = prim,
-				  result = SOME ty}
-			      end
-			 | CCall {args, func, return} =>
-			      let
-				 val _ = checkOperands args
-			      in
-				 CFunction.isOk (func, {isUnit = Type.isUnit})
-				 andalso
-				 Vector.equals (args, CFunction.args func,
-						fn (z, t) =>
-						Type.isSubtype
-						(Operand.ty z, t))
-				 andalso
-				 case return of
-				    NONE => true
-				  | SOME l =>
-				       case labelKind l of
-					  Kind.CReturn {func = f} =>
-					     CFunction.equals (func, f)
-					| _ => false
-			      end
-			 | Call {args, func, return} =>
-			      let
-				 val _ = checkOperands args
-			      in
-				 callIsOk {args = args,
-					   func = func,
-					   raises = raises,
-					   return = return,
-					   returns = returns}
-			      end
-			 | Goto {args, dst} =>
-			      (checkOperands args
-			       ; goto {args = Vector.map (args, Operand.ty),
-				       dst = dst})
-			 | Raise zs =>
-			      (checkOperands zs
-			       ; (case raises of
-				     NONE => false
-				   | SOME ts =>
-					Vector.equals
-					(zs, ts, fn (z, t) =>
-					 Type.isSubtype (Operand.ty z, t))))
-			 | Return zs =>
-			      (checkOperands zs
-			       ; (case returns of
-				     NONE => false
-				   | SOME ts =>
-					Vector.equals
-					(zs, ts, fn (z, t) =>
-					 Type.isSubtype (Operand.ty z, t))))
-			 | Switch s =>
-			      Switch.isOk (s, {checkUse = checkOperand,
-					       labelIsOk = labelIsNullaryJump})
-		     end
-		  fun blockOk (Block.T {args, kind, statements, transfer, ...})
-		     : bool =
-		     let
-			fun kindOk (k: Kind.t): bool =
-			   let
-			      datatype z = datatype Kind.t
-			   in
-			      case k of
-				 Cont _ => true
-			       | CReturn {func} =>
-				    let
-				       val return = CFunction.return func
-				    in
-				       0 = Vector.length args
-				       orelse
-				       (1 = Vector.length args
-					andalso
-					let
-					   val expects =
-					      #2 (Vector.sub (args, 0))
-					in
-					   Type.isSubtype (return, expects) 
-					   andalso
-					   CType.equals (Type.toCType return,
-							 Type.toCType expects)
-					end)
-				    end
-			       | Handler => true
-			       | Jump => true
-			   end
-			val _ = check' (kind, "kind", kindOk, Kind.layout)
-			val _ =
-			   Vector.foreach
-			   (statements, fn s =>
-			    check' (s, "statement", statementOk,
-				    Statement.layout))
-			val _ = check' (transfer, "transfer", transferOk,
-					Transfer.layout)
-		     in
-			true
-		     end
+            fun checkFunction (Function.T {args, blocks, raises, returns, start,
+                                           ...}) =
+               let
+                  val _ = Vector.foreach (args, setVarType)
+                  val _ =
+                     Vector.foreach
+                     (blocks, fn b as Block.T {args, label, statements,
+                                               transfer, ...} =>
+                      (setLabelBlock (label, b)
+                       ; Vector.foreach (args, setVarType)
+                       ; Vector.foreach (statements, fn s =>
+                                         Statement.foreachDef
+                                         (s, setVarType))
+                       ; Transfer.foreachDef (transfer, setVarType)))
+                  val _ = labelIsNullaryJump start
+                  fun transferOk (t: Transfer.t): bool =
+                     let
+                        datatype z = datatype Transfer.t
+                     in
+                        case t of
+                           Arith {args, overflow, prim, success, ty, ...} =>
+                              let
+                                 val _ = checkOperands args
+                              in
+                                 Prim.mayOverflow prim
+                                 andalso labelIsNullaryJump overflow
+                                 andalso labelIsNullaryJump success
+                                 andalso
+                                 Type.checkPrimApp
+                                 {args = Vector.map (args, Operand.ty),
+                                  prim = prim,
+                                  result = SOME ty}
+                              end
+                         | CCall {args, func, return} =>
+                              let
+                                 val _ = checkOperands args
+                              in
+                                 CFunction.isOk (func, {isUnit = Type.isUnit})
+                                 andalso
+                                 Vector.equals (args, CFunction.args func,
+                                                fn (z, t) =>
+                                                Type.isSubtype
+                                                (Operand.ty z, t))
+                                 andalso
+                                 case return of
+                                    NONE => true
+                                  | SOME l =>
+                                       case labelKind l of
+                                          Kind.CReturn {func = f} =>
+                                             CFunction.equals (func, f)
+                                        | _ => false
+                              end
+                         | Call {args, func, return} =>
+                              let
+                                 val _ = checkOperands args
+                              in
+                                 callIsOk {args = args,
+                                           func = func,
+                                           raises = raises,
+                                           return = return,
+                                           returns = returns}
+                              end
+                         | Goto {args, dst} =>
+                              (checkOperands args
+                               ; goto {args = Vector.map (args, Operand.ty),
+                                       dst = dst})
+                         | Raise zs =>
+                              (checkOperands zs
+                               ; (case raises of
+                                     NONE => false
+                                   | SOME ts =>
+                                        Vector.equals
+                                        (zs, ts, fn (z, t) =>
+                                         Type.isSubtype (Operand.ty z, t))))
+                         | Return zs =>
+                              (checkOperands zs
+                               ; (case returns of
+                                     NONE => false
+                                   | SOME ts =>
+                                        Vector.equals
+                                        (zs, ts, fn (z, t) =>
+                                         Type.isSubtype (Operand.ty z, t))))
+                         | Switch s =>
+                              Switch.isOk (s, {checkUse = checkOperand,
+                                               labelIsOk = labelIsNullaryJump})
+                     end
+                  fun blockOk (Block.T {args, kind, statements, transfer, ...})
+                     : bool =
+                     let
+                        fun kindOk (k: Kind.t): bool =
+                           let
+                              datatype z = datatype Kind.t
+                           in
+                              case k of
+                                 Cont _ => true
+                               | CReturn {func} =>
+                                    let
+                                       val return = CFunction.return func
+                                    in
+                                       0 = Vector.length args
+                                       orelse
+                                       (1 = Vector.length args
+                                        andalso
+                                        let
+                                           val expects =
+                                              #2 (Vector.sub (args, 0))
+                                        in
+                                           Type.isSubtype (return, expects) 
+                                           andalso
+                                           CType.equals (Type.toCType return,
+                                                         Type.toCType expects)
+                                        end)
+                                    end
+                               | Handler => true
+                               | Jump => true
+                           end
+                        val _ = check' (kind, "kind", kindOk, Kind.layout)
+                        val _ =
+                           Vector.foreach
+                           (statements, fn s =>
+                            check' (s, "statement", statementOk,
+                                    Statement.layout))
+                        val _ = check' (transfer, "transfer", transferOk,
+                                        Transfer.layout)
+                     in
+                        true
+                     end
 
-		  val _ = 
-		     Vector.foreach
-		     (blocks, fn b =>
-		      check' (b, "block", blockOk, Block.layout))
-	       in
-		  ()
-	       end
-	    val _ =
-	       List.foreach
-	       (functions, fn f as Function.T {name, ...} =>
-		setFuncInfo (name, f))
-	    val _ = checkFunction main
-	    val _ = List.foreach (functions, checkFunction)
-	    val _ =
-	       check'
-	       (main, "main function",
-		fn f =>
-		let
-		   val {args, ...} = Function.dest f
-		in
-		   0 = Vector.length args
-		end,
-		Function.layout)
-	    val _ = clear p
-	 in
-	    ()
-	 end handle Err.E e => (Layout.outputl (Err.layout e, Out.error)
-				; Error.bug "Rssa type error")
+                  val _ = 
+                     Vector.foreach
+                     (blocks, fn b =>
+                      check' (b, "block", blockOk, Block.layout))
+               in
+                  ()
+               end
+            val _ =
+               List.foreach
+               (functions, fn f as Function.T {name, ...} =>
+                setFuncInfo (name, f))
+            val _ = checkFunction main
+            val _ = List.foreach (functions, checkFunction)
+            val _ =
+               check'
+               (main, "main function",
+                fn f =>
+                let
+                   val {args, ...} = Function.dest f
+                in
+                   0 = Vector.length args
+                end,
+                Function.layout)
+            val _ = clear p
+         in
+            ()
+         end handle Err.E e => (Layout.outputl (Err.layout e, Out.error)
+                                ; Error.bug "Rssa.typeCheck")
    end
 
 end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/backend/rssa.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/backend/rssa.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/backend/rssa.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,9 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 type word = Word.t
@@ -37,200 +37,201 @@
       sharing Atoms = Switch
 
       structure Operand:
-	 sig
-	    datatype t =
-	       ArrayOffset of {base: t,
-			       index: t,
-			       offset: Bytes.t,
-			       scale: Scale.t,
-			       ty: Type.t}
-	     | Cast of t * Type.t
-	     | Const of Const.t
-	       (* EnsuresBytesFree is a pseudo-op used by C functions (like
-		* GC_allocateArray) that take a number of bytes as an argument
-		* and ensure that that number of bytes is free upon return.
-		* EnsuresBytesFree is replaced by the limit check pass with
-		* a real operand.
-		*)
-	     | EnsuresBytesFree
-	     | File (* expand by codegen into string constant *)
-	     | GCState
-	     | Line (* expand by codegen into int constant *)
-	     | Offset of {base: t,
-			  offset: Bytes.t,
-			  ty: Type.t}
-	     | PointerTycon of PointerTycon.t
-	     | Runtime of Runtime.GCField.t
-	     | Var of {ty: Type.t,
-		       var: Var.t}
+         sig
+            datatype t =
+               ArrayOffset of {base: t,
+                               index: t,
+                               offset: Bytes.t,
+                               scale: Scale.t,
+                               ty: Type.t}
+             | Cast of t * Type.t
+             | Const of Const.t
+               (* EnsuresBytesFree is a pseudo-op used by C functions (like
+                * GC_allocateArray) that take a number of bytes as an argument
+                * and ensure that that number of bytes is free upon return.
+                * EnsuresBytesFree is replaced by the limit check pass with
+                * a real operand.
+                *)
+             | EnsuresBytesFree
+             | File (* expand by codegen into string constant *)
+             | GCState
+             | Line (* expand by codegen into int constant *)
+             | Offset of {base: t,
+                          offset: Bytes.t,
+                          ty: Type.t}
+             | PointerTycon of PointerTycon.t
+             | Runtime of Runtime.GCField.t
+             | Var of {ty: Type.t,
+                       var: Var.t}
 
-	    val bool: bool -> t
-	    val cast: t * Type.t -> t
-	    val layout: t -> Layout.t
-	    val foreachVar: t * (Var.t -> unit) -> unit
-	    val replaceVar: t * (Var.t -> t) -> t
-	    val ty: t -> Type.t
-	    val word: WordX.t -> t
-	    val zero: WordSize.t -> t
-	 end
+            val bool: bool -> t
+            val cast: t * Type.t -> t
+            val layout: t -> Layout.t
+            val foreachVar: t * (Var.t -> unit) -> unit
+            val replaceVar: t * (Var.t -> t) -> t
+            val ty: t -> Type.t
+            val word: WordX.t -> t
+            val zero: WordSize.t -> t
+         end
       sharing Operand = Switch.Use
     
       structure Statement:
-	 sig
-	    datatype t =
-	       Bind of {dst: Var.t * Type.t,
-			isMutable: bool,
-			src: Operand.t}
-	     | Move of {dst: Operand.t,
-			src: Operand.t}
-	     | Object of {dst: Var.t * Type.t,
-			  header: word,
-			  size: Words.t (* including header *)}
-	     | PrimApp of {args: Operand.t vector,
-			   dst: (Var.t * Type.t) option,
-			   prim: Type.t Prim.t}
-	     | Profile of ProfileExp.t
-	     | ProfileLabel of ProfileLabel.t
-	     | SetExnStackLocal
-	     | SetExnStackSlot
-	     | SetHandler of Label.t (* label must be of Handler kind. *)
-	     | SetSlotExnStack
+         sig
+            datatype t =
+               Bind of {dst: Var.t * Type.t,
+                        isMutable: bool,
+                        src: Operand.t}
+             | Move of {dst: Operand.t,
+                        src: Operand.t}
+             | Object of {dst: Var.t * Type.t,
+                          header: word,
+                          size: Words.t (* including header *)}
+             | PrimApp of {args: Operand.t vector,
+                           dst: (Var.t * Type.t) option,
+                           prim: Type.t Prim.t}
+             | Profile of ProfileExp.t
+             | ProfileLabel of ProfileLabel.t
+             | SetExnStackLocal
+             | SetExnStackSlot
+             | SetHandler of Label.t (* label must be of Handler kind. *)
+             | SetSlotExnStack
 
-	    (* foldDef (s, a, f)
-	     * If s defines a variable x, then return f (x, a), else return a.
-	     *)
-	    val foldDef: t * 'a * (Var.t * Type.t * 'a -> 'a) -> 'a
-	    (* foreachDef (s, f) = foldDef (s, (), fn (x, ()) => f x) *)
-	    val foreachDef: t * (Var.t * Type.t -> unit) -> unit
-	    val foreachDefUse: t * {def: (Var.t * Type.t) -> unit,
-				    use: Var.t -> unit} -> unit
-	    val foldUse: t * 'a * (Var.t * 'a -> 'a) -> 'a
-	    val foreachUse: t * (Var.t -> unit) -> unit
-	    val layout: t -> Layout.t
-	    val replaceUses: t * (Var.t -> Operand.t) -> t
-	    val resize: Operand.t * Bits.t -> Operand.t * t list
-	    val toString: t -> string
-	 end
+            (* foldDef (s, a, f)
+             * If s defines a variable x, then return f (x, a), else return a.
+             *)
+            val foldDef: t * 'a * (Var.t * Type.t * 'a -> 'a) -> 'a
+            (* foreachDef (s, f) = foldDef (s, (), fn (x, ()) => f x) *)
+            val foreachDef: t * (Var.t * Type.t -> unit) -> unit
+            val foreachDefUse: t * {def: (Var.t * Type.t) -> unit,
+                                    use: Var.t -> unit} -> unit
+            val foldUse: t * 'a * (Var.t * 'a -> 'a) -> 'a
+            val foreachUse: t * (Var.t -> unit) -> unit
+            val layout: t -> Layout.t
+            val replaceUses: t * (Var.t -> Operand.t) -> t
+            val resize: Operand.t * Bits.t -> Operand.t * t list
+            val toString: t -> string
+         end
 
       structure Transfer:
-	 sig
-	    datatype t =
-	       Arith of {args: Operand.t vector,
-			 dst: Var.t,
-			 overflow: Label.t, (* Must be nullary. *)
-			 prim: Type.t Prim.t,
-			 success: Label.t, (* Must be nullary. *)
-			 ty: Type.t}
-	     | CCall of {args: Operand.t vector,
-			 func: Type.t CFunction.t,
-			 (* return is NONE iff the CFunction doesn't return.
-			  * Else, return must be SOME l, where l is of kind
-			  * CReturn.  The return should be nullary if the C
-			  * function returns void.  Else, it should be unary with
-			  * a var of the appropriate type to accept the result.
-			  *)
-			 return: Label.t option}
-	     | Call of {args: Operand.t vector,
-			func: Func.t,
-			return: Return.t}
-	     | Goto of {args: Operand.t vector,
-			dst: Label.t}
-	     (* Raise implicitly raises to the caller.  
-	      * I.E. the local handler stack must be empty.
-	      *)
-	     | Raise of Operand.t vector
-	     | Return of Operand.t vector
-	     | Switch of Switch.t
+         sig
+            datatype t =
+               Arith of {args: Operand.t vector,
+                         dst: Var.t,
+                         overflow: Label.t, (* Must be nullary. *)
+                         prim: Type.t Prim.t,
+                         success: Label.t, (* Must be nullary. *)
+                         ty: Type.t}
+             | CCall of {args: Operand.t vector,
+                         func: Type.t CFunction.t,
+                         (* return is NONE iff the CFunction doesn't return.
+                          * Else, return must be SOME l, where l is of kind
+                          * CReturn.  The return should be nullary if the C
+                          * function returns void.  Else, it should be unary with
+                          * a var of the appropriate type to accept the result.
+                          *)
+                         return: Label.t option}
+             | Call of {args: Operand.t vector,
+                        func: Func.t,
+                        return: Return.t}
+             | Goto of {args: Operand.t vector,
+                        dst: Label.t}
+             (* Raise implicitly raises to the caller.  
+              * I.E. the local handler stack must be empty.
+              *)
+             | Raise of Operand.t vector
+             | Return of Operand.t vector
+             | Switch of Switch.t
 
-	    val bug: t
-	    (* foldDef (t, a, f)
-	     * If t defines a variable x, then return f (x, a), else return a.
-	     *)
-	    val foldDef: t * 'a * (Var.t * Type.t * 'a -> 'a) -> 'a
-	    (* foreachDef (t, f) = foldDef (t, (), fn (x, ()) => f x) *)
-	    val foreachDef: t * (Var.t * Type.t -> unit) -> unit
-	    val foreachDefLabelUse: t * {def: Var.t * Type.t -> unit,
-					 label: Label.t -> unit,
-					 use: Var.t -> unit} -> unit
-	    val foreachLabel: t * (Label.t -> unit) -> unit
-	    val foreachUse: t * (Var.t -> unit) -> unit
-	    val ifBool: Operand.t * {falsee: Label.t, truee: Label.t} -> t
-	    (* in ifZero, the operand should be of type defaultWord *)
-	    val ifZero: Operand.t * {falsee: Label.t, truee: Label.t} -> t
-	    val layout: t -> Layout.t
-	    val replaceUses: t * (Var.t -> Operand.t) -> t
-	 end
+            val bug: t
+            (* foldDef (t, a, f)
+             * If t defines a variable x, then return f (x, a), else return a.
+             *)
+            val foldDef: t * 'a * (Var.t * Type.t * 'a -> 'a) -> 'a
+            (* foreachDef (t, f) = foldDef (t, (), fn (x, ()) => f x) *)
+            val foreachDef: t * (Var.t * Type.t -> unit) -> unit
+            val foreachDefLabelUse: t * {def: Var.t * Type.t -> unit,
+                                         label: Label.t -> unit,
+                                         use: Var.t -> unit} -> unit
+            val foreachLabel: t * (Label.t -> unit) -> unit
+            val foreachUse: t * (Var.t -> unit) -> unit
+            val ifBool: Operand.t * {falsee: Label.t, truee: Label.t} -> t
+            (* in ifZero, the operand should be of type defaultWord *)
+            val ifZero: Operand.t * {falsee: Label.t, truee: Label.t} -> t
+            val layout: t -> Layout.t
+            val replaceUses: t * (Var.t -> Operand.t) -> t
+         end
 
       structure Kind:
-	 sig
-	    datatype t =
-	       Cont of {handler: Handler.t}
-	     | CReturn of {func: Type.t CFunction.t}
-	     | Handler
-	     | Jump
+         sig
+            datatype t =
+               Cont of {handler: Handler.t}
+             | CReturn of {func: Type.t CFunction.t}
+             | Handler
+             | Jump
 
-	    datatype frameStyle = None | OffsetsAndSize | SizeOnly
-	    val frameStyle: t -> frameStyle
-	 end
+            datatype frameStyle = None | OffsetsAndSize | SizeOnly
+            val frameStyle: t -> frameStyle
+         end
 
       structure Block:
-	 sig
-	    datatype t =
-	       T of {args: (Var.t * Type.t) vector,
-		     kind: Kind.t,
-		     label: Label.t,
-		     statements: Statement.t vector,
-		     transfer: Transfer.t}
+         sig
+            datatype t =
+               T of {args: (Var.t * Type.t) vector,
+                     kind: Kind.t,
+                     label: Label.t,
+                     statements: Statement.t vector,
+                     transfer: Transfer.t}
 
-	    val args: t -> (Var.t * Type.t) vector
-	    val clear: t -> unit
-	    val kind: t -> Kind.t
-	    val label: t -> Label.t
-	    val layout: t -> Layout.t
-	    val statements: t -> Statement.t vector
-	    val transfer: t -> Transfer.t
-	 end
+            val args: t -> (Var.t * Type.t) vector
+            val clear: t -> unit
+            val kind: t -> Kind.t
+            val label: t -> Label.t
+            val layout: t -> Layout.t
+            val statements: t -> Statement.t vector
+            val transfer: t -> Transfer.t
+         end
 
       structure Function:
-	 sig
-	    type t
-	       
-	    val blocks: t -> Block.t vector
-	    val clear: t -> unit
-	    val dest: t -> {args: (Var.t * Type.t) vector,
-			    blocks: Block.t vector,
-			    name: Func.t,
-			    raises: Type.t vector option,
-			    returns: Type.t vector option,
-			    start: Label.t}
-	    (* dfs (f, v) visits the blocks in depth-first order, applying v b
-	     * for block b to yield v', then visiting b's descendents,
-	     * then applying v' ().
-	     *)
-	    val dfs: t * (Block.t -> unit -> unit) -> unit
-	    val foreachVar: t * (Var.t * Type.t -> unit) -> unit
-	    val name: t -> Func.t
-	    val new: {args: (Var.t * Type.t) vector,
-		      blocks: Block.t vector,
-		      name: Func.t,
-		      raises: Type.t vector option,
-		      returns: Type.t vector option,
-		      start: Label.t} -> t
-	    val start: t -> Label.t
-	 end
+         sig
+            type t
+               
+            val blocks: t -> Block.t vector
+            val clear: t -> unit
+            val dest: t -> {args: (Var.t * Type.t) vector,
+                            blocks: Block.t vector,
+                            name: Func.t,
+                            raises: Type.t vector option,
+                            returns: Type.t vector option,
+                            start: Label.t}
+            (* dfs (f, v) visits the blocks in depth-first order, applying v b
+             * for block b to yield v', then visiting b's descendents,
+             * then applying v' ().
+             *)
+            val dfs: t * (Block.t -> unit -> unit) -> unit
+            val foreachVar: t * (Var.t * Type.t -> unit) -> unit
+            val name: t -> Func.t
+            val new: {args: (Var.t * Type.t) vector,
+                      blocks: Block.t vector,
+                      name: Func.t,
+                      raises: Type.t vector option,
+                      returns: Type.t vector option,
+                      start: Label.t} -> t
+            val start: t -> Label.t
+         end
      
       structure Program:
-	 sig
-	    datatype t =
-	       T of {functions: Function.t list,
-		     handlesSignals: bool,
-		     main: Function.t,
-		     objectTypes: ObjectType.t vector}
+         sig
+            datatype t =
+               T of {functions: Function.t list,
+                     handlesSignals: bool,
+                     main: Function.t,
+                     objectTypes: ObjectType.t vector}
 
-	    val clear: t -> unit
-	    val checkHandlers: t -> unit
-	    val layouts: t * (Layout.t -> unit) -> unit
-	    val shrink: t -> t
-	    val typeCheck: t -> unit
-	 end
+            val clear: t -> unit
+            val checkHandlers: t -> unit
+            val dropProfile: t -> t
+            val layouts: t * (Layout.t -> unit) -> unit
+            val shrink: t -> t
+            val typeCheck: t -> unit
+         end
    end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/backend/runtime.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/backend/runtime.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/backend/runtime.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 2002-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 2002-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 functor Runtime (S: RUNTIME_STRUCTS): RUNTIME =
 struct
 
@@ -12,9 +13,10 @@
 structure GCField =
    struct
       datatype t =
-	 CanHandle
+         CanHandle
        | CardMap
        | CurrentThread
+       | CurSourceSeqsIndex
        | ExnStack
        | Frontier
        | Limit
@@ -26,25 +28,26 @@
        | StackTop
 
       val equals: t * t -> bool = op =
-	 
+         
 (*       val ty =
- * 	 fn CanHandle => CType.defaultInt
- * 	  | CardMap => CType.pointer
- * 	  | CurrentThread => CType.pointer
- * 	  | ExnStack => CType.defaultWord
- * 	  | Frontier => CType.pointer
- * 	  | Limit => CType.pointer
- * 	  | LimitPlusSlop => CType.pointer
- * 	  | MaxFrameSize => CType.defaultWord
- * 	  | SignalIsPending => CType.defaultInt
- * 	  | StackBottom => CType.pointer
- * 	  | StackLimit => CType.pointer
- * 	  | StackTop => CType.pointer
+ *       fn CanHandle => CType.defaultInt
+ *        | CardMap => CType.pointer
+ *        | CurrentThread => CType.pointer
+ *        | ExnStack => CType.defaultWord
+ *        | Frontier => CType.pointer
+ *        | Limit => CType.pointer
+ *        | LimitPlusSlop => CType.pointer
+ *        | MaxFrameSize => CType.defaultWord
+ *        | SignalIsPending => CType.defaultInt
+ *        | StackBottom => CType.pointer
+ *        | StackLimit => CType.pointer
+ *        | StackTop => CType.pointer
  *)
 
       val canHandleOffset: Bytes.t ref = ref Bytes.zero
       val cardMapOffset: Bytes.t ref = ref Bytes.zero
       val currentThreadOffset: Bytes.t ref = ref Bytes.zero
+      val curSourceSeqsIndexOffset: Bytes.t ref = ref Bytes.zero
       val exnStackOffset: Bytes.t ref = ref Bytes.zero
       val frontierOffset: Bytes.t ref = ref Bytes.zero
       val limitOffset: Bytes.t ref = ref Bytes.zero
@@ -55,49 +58,52 @@
       val stackLimitOffset: Bytes.t ref = ref Bytes.zero
       val stackTopOffset: Bytes.t ref = ref Bytes.zero
 
-      fun setOffsets {canHandle, cardMap, currentThread, exnStack, frontier,
-		      limit, limitPlusSlop, maxFrameSize, signalIsPending,
-		      stackBottom, stackLimit, stackTop} =
-	 (canHandleOffset := canHandle
-	  ; cardMapOffset := cardMap
-	  ; currentThreadOffset := currentThread
-	  ; exnStackOffset := exnStack
-	  ; frontierOffset := frontier
-	  ; limitOffset := limit
-	  ; limitPlusSlopOffset := limitPlusSlop
-	  ; maxFrameSizeOffset := maxFrameSize
-	  ; signalIsPendingOffset := signalIsPending
-	  ; stackBottomOffset := stackBottom
-	  ; stackLimitOffset := stackLimit
-	  ; stackTopOffset := stackTop)
+      fun setOffsets {canHandle, cardMap, currentThread, curSourceSeqsIndex, 
+                      exnStack, frontier, limit, limitPlusSlop, maxFrameSize, 
+                      signalIsPending, stackBottom, stackLimit, stackTop} =
+         (canHandleOffset := canHandle
+          ; cardMapOffset := cardMap
+          ; currentThreadOffset := currentThread
+          ; curSourceSeqsIndexOffset := curSourceSeqsIndex
+          ; exnStackOffset := exnStack
+          ; frontierOffset := frontier
+          ; limitOffset := limit
+          ; limitPlusSlopOffset := limitPlusSlop
+          ; maxFrameSizeOffset := maxFrameSize
+          ; signalIsPendingOffset := signalIsPending
+          ; stackBottomOffset := stackBottom
+          ; stackLimitOffset := stackLimit
+          ; stackTopOffset := stackTop)
 
       val offset =
-	 fn CanHandle => !canHandleOffset
-	  | CardMap => !cardMapOffset
-	  | CurrentThread => !currentThreadOffset
-	  | ExnStack => !exnStackOffset
-	  | Frontier => !frontierOffset
-	  | Limit => !limitOffset
-	  | LimitPlusSlop => !limitPlusSlopOffset
-	  | MaxFrameSize => !maxFrameSizeOffset
-	  | SignalIsPending => !signalIsPendingOffset
-	  | StackBottom => !stackBottomOffset
-	  | StackLimit => !stackLimitOffset
-	  | StackTop => !stackTopOffset
+         fn CanHandle => !canHandleOffset
+          | CardMap => !cardMapOffset
+          | CurrentThread => !currentThreadOffset
+          | CurSourceSeqsIndex => !curSourceSeqsIndexOffset
+          | ExnStack => !exnStackOffset
+          | Frontier => !frontierOffset
+          | Limit => !limitOffset
+          | LimitPlusSlop => !limitPlusSlopOffset
+          | MaxFrameSize => !maxFrameSizeOffset
+          | SignalIsPending => !signalIsPendingOffset
+          | StackBottom => !stackBottomOffset
+          | StackLimit => !stackLimitOffset
+          | StackTop => !stackTopOffset
 
       val toString =
-	 fn CanHandle => "CanHandle"
-	  | CardMap => "CardMap"
-	  | CurrentThread => "CurrentThread"
-	  | ExnStack => "ExnStack"
-	  | Frontier => "Frontier"
-	  | Limit => "Limit"
-	  | LimitPlusSlop => "LimitPlusSlop"
-	  | MaxFrameSize => "MaxFrameSize"
-	  | SignalIsPending => "SignalIsPending"
-	  | StackBottom => "StackBottom"
-	  | StackLimit => "StackLimit"
-	  | StackTop => "StackTop"
+         fn CanHandle => "CanHandle"
+          | CardMap => "CardMap"
+          | CurrentThread => "CurrentThread"
+          | CurSourceSeqsIndex => "CurSourceSeqsIndex"
+          | ExnStack => "ExnStack"
+          | Frontier => "Frontier"
+          | Limit => "Limit"
+          | LimitPlusSlop => "LimitPlusSlop"
+          | MaxFrameSize => "MaxFrameSize"
+          | SignalIsPending => "SignalIsPending"
+          | StackBottom => "StackBottom"
+          | StackLimit => "StackLimit"
+          | StackTop => "StackTop"
 
       val layout = Layout.str o toString
    end
@@ -105,35 +111,35 @@
 structure RObjectType =
    struct
       datatype t =
-	 Array of {hasIdentity: bool,
-		   nonPointer: Bytes.t,
-		   pointers: int}
+         Array of {hasIdentity: bool,
+                   nonPointer: Bytes.t,
+                   pointers: int}
        | Normal of {hasIdentity: bool,
-		    nonPointer: Words.t,
-		    pointers: int}
+                    nonPointer: Words.t,
+                    pointers: int}
        | Stack
        | Weak
        | WeakGone
 
       fun layout (t: t): Layout.t =
-	 let
-	    open Layout
-	 in
-	    case t of
-	       Array {hasIdentity, nonPointer = np, pointers = p} =>
-		  seq [str "Array ",
-		       record [("hasIdentity", Bool.layout hasIdentity),
-			       ("nonPointer", Bytes.layout np),
-			       ("pointers", Int.layout p)]]
-	     | Normal {hasIdentity, nonPointer = np, pointers = p} =>
-		  seq [str "Normal ",
-		       record [("hasIdentity", Bool.layout hasIdentity),
-			       ("nonPointer", Words.layout np),
-			       ("pointers", Int.layout p)]]
-	     | Stack => str "Stack"
-	     | Weak => str "Weak"
-	     | WeakGone => str "WeakGone"
-	 end
+         let
+            open Layout
+         in
+            case t of
+               Array {hasIdentity, nonPointer = np, pointers = p} =>
+                  seq [str "Array ",
+                       record [("hasIdentity", Bool.layout hasIdentity),
+                               ("nonPointer", Bytes.layout np),
+                               ("pointers", Int.layout p)]]
+             | Normal {hasIdentity, nonPointer = np, pointers = p} =>
+                  seq [str "Normal ",
+                       record [("hasIdentity", Bool.layout hasIdentity),
+                               ("nonPointer", Words.layout np),
+                               ("pointers", Int.layout p)]]
+             | Stack => str "Stack"
+             | Weak => str "Weak"
+             | WeakGone => str "WeakGone"
+         end
       val _ = layout (* quell unused warning *)
    end
 
@@ -141,8 +147,8 @@
    
 fun typeIndexToHeader typeIndex =
    (Assert.assert ("Runtime.header", fn () =>
-		   0 <= typeIndex
-		   andalso typeIndex < maxTypeIndex)
+                   0 <= typeIndex
+                   andalso typeIndex < maxTypeIndex)
     ; Word.orb (0w1, Word.<< (Word.fromInt typeIndex, 0w1)))
 
 fun headerToTypeIndex w = Word.toInt (Word.>> (w, 0w1))
@@ -170,7 +176,7 @@
 
 fun normalSize {nonPointers, pointers} =
    Bytes.+ (Words.toBytes nonPointers,
-	    Bytes.scale (pointerSize, pointers))
+            Bytes.scale (pointerSize, pointers))
  
 val maxFrameSize = Bytes.fromInt (Int.pow (2, 16))
 

Modified: mlton/branches/on-20050420-cmm-branch/mlton/backend/runtime.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/backend/runtime.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/backend/runtime.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 type int = Int.t
 type word = Word.t
 
@@ -17,51 +18,53 @@
       include RUNTIME_STRUCTS
 
       structure GCField:
-	 sig
-	    datatype t =
-	       CanHandle
-	     | CardMap
-	     | CurrentThread
-	     | ExnStack
-	     | Frontier (* The place where the next object is allocated. *)
-	     | Limit (* frontier + heapSize - LIMIT_SLOP *)
-	     | LimitPlusSlop (* frontier + heapSize *)
-	     | MaxFrameSize
-	     | SignalIsPending
-	     | StackBottom
-	     | StackLimit (* Must have StackTop <= StackLimit *)
-	     | StackTop (* Points at the next available word on the stack. *)
+         sig
+            datatype t =
+               CanHandle
+             | CardMap
+             | CurrentThread
+             | CurSourceSeqsIndex
+             | ExnStack
+             | Frontier (* The place where the next object is allocated. *)
+             | Limit (* frontier + heapSize - LIMIT_SLOP *)
+             | LimitPlusSlop (* frontier + heapSize *)
+             | MaxFrameSize
+             | SignalIsPending
+             | StackBottom
+             | StackLimit (* Must have StackTop <= StackLimit *)
+             | StackTop (* Points at the next available word on the stack. *)
 
-	    val equals: t * t -> bool
-	    val layout: t -> Layout.t
-	    val offset: t -> Bytes.t (* Field offset in struct GC_state. *)
-	    val setOffsets: {canHandle: Bytes.t,
-			     cardMap: Bytes.t,
-			     currentThread: Bytes.t,
-			     exnStack: Bytes.t,
-			     frontier: Bytes.t,
-			     limit: Bytes.t,
-			     limitPlusSlop: Bytes.t,
-			     maxFrameSize: Bytes.t,
-			     signalIsPending: Bytes.t,
-			     stackBottom: Bytes.t,
-			     stackLimit: Bytes.t,
-			     stackTop: Bytes.t} -> unit
-	    val toString: t -> string
-	 end
+            val equals: t * t -> bool
+            val layout: t -> Layout.t
+            val offset: t -> Bytes.t (* Field offset in struct GC_state. *)
+            val setOffsets: {canHandle: Bytes.t,
+                             cardMap: Bytes.t,
+                             currentThread: Bytes.t,
+                             curSourceSeqsIndex: Bytes.t,
+                             exnStack: Bytes.t,
+                             frontier: Bytes.t,
+                             limit: Bytes.t,
+                             limitPlusSlop: Bytes.t,
+                             maxFrameSize: Bytes.t,
+                             signalIsPending: Bytes.t,
+                             stackBottom: Bytes.t,
+                             stackLimit: Bytes.t,
+                             stackTop: Bytes.t} -> unit
+            val toString: t -> string
+         end
       structure RObjectType:
-	 sig
-	    datatype t =
-	       Array of {hasIdentity: bool,
-			 nonPointer: Bytes.t,
-			 pointers: int}
-	     | Normal of {hasIdentity: bool,
-			  nonPointer: Words.t,
-			  pointers: int}
-	     | Stack
-	     | Weak
-	     | WeakGone
-	 end
+         sig
+            datatype t =
+               Array of {hasIdentity: bool,
+                         nonPointer: Bytes.t,
+                         pointers: int}
+             | Normal of {hasIdentity: bool,
+                          nonPointer: Words.t,
+                          pointers: int}
+             | Stack
+             | Weak
+             | WeakGone
+         end
 
       val allocTooLarge: Bytes.t
       val arrayHeaderSize: Bytes.t
@@ -77,7 +80,7 @@
       val normalHeaderSize: Bytes.t
       (* normalBytes does not include the header. *)
       val normalSize: {nonPointers: Words.t,
-		       pointers: int} -> Bytes.t
+                       pointers: int} -> Bytes.t
       val pointerSize: Bytes.t
       val typeIndexToHeader: int -> word
    end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/backend/scale.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/backend/scale.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/backend/scale.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,8 +1,8 @@
-(* Copyright (C) 2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 2004-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 functor Scale (S: SCALE_STRUCTS): SCALE =

Modified: mlton/branches/on-20050420-cmm-branch/mlton/backend/scale.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/backend/scale.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/backend/scale.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,8 +1,8 @@
-(* Copyright (C) 2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 2004-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 type int = Int.t
@@ -14,7 +14,7 @@
 signature SCALE =
    sig
       include SCALE_STRUCTS
-	 
+         
       datatype t = One | Two | Four | Eight
 
       val fromInt: int -> t option

Modified: mlton/branches/on-20050420-cmm-branch/mlton/backend/signal-check.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/backend/signal-check.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/backend/signal-check.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 functor SignalCheck (S: SIGNAL_CHECK_STRUCTS): SIGNAL_CHECK = 
 struct
 
@@ -27,155 +28,155 @@
 fun insertInFunction (f: Function.t): Function.t =
    let
       val {args, blocks, name, raises, returns, start} =
-	 Function.dest f
+         Function.dest f
       val {get = labelIndex: Label.t -> int, set = setLabelIndex, ...} =
-	 Property.getSetOnce
-	 (Label.plist, Property.initRaise ("index", Label.layout))
+         Property.getSetOnce
+         (Label.plist, Property.initRaise ("index", Label.layout))
       val _ =
-	 Vector.foreachi (blocks, fn (i, Block.T {label, ...}) =>
-			  setLabelIndex (label, i))
+         Vector.foreachi (blocks, fn (i, Block.T {label, ...}) =>
+                          setLabelIndex (label, i))
       val g = Graph.new ()
       val n = Vector.length blocks
       val {get = nodeIndex: unit Node.t -> int, set = setNodeIndex, ...} =
-	 Property.getSetOnce
-	 (Node.plist, Property.initRaise ("index", Node.layout))
+         Property.getSetOnce
+         (Node.plist, Property.initRaise ("index", Node.layout))
       val nodes =
-	 Vector.tabulate (n, fn i =>
-			  let
-			     val n = Graph.newNode g
-			     val _ = setNodeIndex (n, i)
-			  in
-			     n
-			  end)
+         Vector.tabulate (n, fn i =>
+                          let
+                             val n = Graph.newNode g
+                             val _ = setNodeIndex (n, i)
+                          in
+                             n
+                          end)
       val isHeader = Array.new (n, false)
       fun indexNode i = Vector.sub (nodes, i)
       val labelNode = indexNode o labelIndex
       val _ =
-	 Vector.foreachi
-	 (blocks, fn (i, Block.T {transfer, ...}) =>
-	  let
-	     val from = indexNode i
-	  in
-	     if (case transfer of
-		    Transfer.CCall {func, ...} =>
-		       CFunction.maySwitchThreads func
-		  | _ => false)
-		then ()
-	     else
-		Transfer.foreachLabel
-		(transfer, fn to =>
-		 (ignore o Graph.addEdge) 
-		 (g, {from = from, to = labelNode to}))
-	  end)
+         Vector.foreachi
+         (blocks, fn (i, Block.T {transfer, ...}) =>
+          let
+             val from = indexNode i
+          in
+             if (case transfer of
+                    Transfer.CCall {func, ...} =>
+                       CFunction.maySwitchThreads func
+                  | _ => false)
+                then ()
+             else
+                Transfer.foreachLabel
+                (transfer, fn to =>
+                 (ignore o Graph.addEdge) 
+                 (g, {from = from, to = labelNode to}))
+          end)
       val extra: Block.t list ref = ref []
       fun addSignalCheck (Block.T {args, kind, label, statements, transfer})
-	 : unit = 
-	 let
-	    val collect = Label.newNoname ()
-	    val collectReturn = Label.newNoname ()
-	    val dontCollect = Label.newNoname ()
-	    val res = Var.newNoname ()
-	    val compare =
-	       Vector.new1
-	       (Statement.PrimApp
-		{args = (Vector.new2
-			 (Operand.Runtime Runtime.GCField.Limit,
-			  Operand.word (WordX.zero (WordSize.pointer ())))),
-		 dst = SOME (res, Type.bool),
-		 prim = Prim.wordEqual (WordSize.pointer ())})
-	    val compareTransfer =
-	       Transfer.ifBool
-	       (Operand.Var {var = res, ty = Type.bool},
-		{falsee = dontCollect,
-		 truee = collect})
-	    val func = CFunction.gc {maySwitchThreads = true}
-	    val _ =
-	       extra :=
-	       Block.T {args = args,
-			kind = kind,
-			label = label,
-			statements = compare,
-			transfer = compareTransfer}
-	       :: (Block.T
-		   {args = Vector.new0 (),
-		    kind = Kind.Jump,
-		    label = collect,
-		    statements = Vector.new0 (),
-		    transfer =
-		    Transfer.CCall
-		    {args = Vector.new5 (Operand.GCState,
-					 Operand.word (WordX.zero
-						       WordSize.default),
-					 Operand.bool false,
-					 Operand.File,
-					 Operand.Line),
-		     func = func,
-		     return = SOME collectReturn}})
-	       :: (Block.T
-		   {args = Vector.new0 (),
-		    kind = Kind.CReturn {func = func},
-		    label = collectReturn,
-		    statements = Vector.new0 (),
-		    transfer =
-		    Transfer.Goto {dst = dontCollect,
-				   args = Vector.new0 ()}})
-	       :: Block.T {args = Vector.new0 (),
-			   kind = Kind.Jump,
-			   label = dontCollect,
-			   statements = statements,
-			   transfer = transfer}
-	       :: !extra
-	 in
-	    ()
-	 end
+         : unit = 
+         let
+            val collect = Label.newNoname ()
+            val collectReturn = Label.newNoname ()
+            val dontCollect = Label.newNoname ()
+            val res = Var.newNoname ()
+            val compare =
+               Vector.new1
+               (Statement.PrimApp
+                {args = (Vector.new2
+                         (Operand.Runtime Runtime.GCField.Limit,
+                          Operand.word (WordX.zero (WordSize.pointer ())))),
+                 dst = SOME (res, Type.bool),
+                 prim = Prim.wordEqual (WordSize.pointer ())})
+            val compareTransfer =
+               Transfer.ifBool
+               (Operand.Var {var = res, ty = Type.bool},
+                {falsee = dontCollect,
+                 truee = collect})
+            val func = CFunction.gc {maySwitchThreads = true}
+            val _ =
+               extra :=
+               Block.T {args = args,
+                        kind = kind,
+                        label = label,
+                        statements = compare,
+                        transfer = compareTransfer}
+               :: (Block.T
+                   {args = Vector.new0 (),
+                    kind = Kind.Jump,
+                    label = collect,
+                    statements = Vector.new0 (),
+                    transfer =
+                    Transfer.CCall
+                    {args = Vector.new5 (Operand.GCState,
+                                         Operand.word (WordX.zero
+                                                       WordSize.default),
+                                         Operand.bool false,
+                                         Operand.File,
+                                         Operand.Line),
+                     func = func,
+                     return = SOME collectReturn}})
+               :: (Block.T
+                   {args = Vector.new0 (),
+                    kind = Kind.CReturn {func = func},
+                    label = collectReturn,
+                    statements = Vector.new0 (),
+                    transfer =
+                    Transfer.Goto {dst = dontCollect,
+                                   args = Vector.new0 ()}})
+               :: Block.T {args = Vector.new0 (),
+                           kind = Kind.Jump,
+                           label = dontCollect,
+                           statements = statements,
+                           transfer = transfer}
+               :: !extra
+         in
+            ()
+         end
       (* Create extra blocks with signal checks for all blocks that are
        * loop headers.
        *)
       fun loop (f: unit Forest.t) =
-	 let
-	    val {loops, ...} = Forest.dest f
-	 in
-	    Vector.foreach
-	    (loops, fn {headers, child} =>
-	     let
-		val _ =
-		   Vector.foreach
-		   (headers, fn n =>
-		    let
-		       val i = nodeIndex n
-		       val _ = Array.update (isHeader, i, true)
-		    in
-		       addSignalCheck (Vector.sub (blocks, i))
-		    end)
-		val _ = loop child
-	     in
-		()
-	     end)
-	 end
+         let
+            val {loops, ...} = Forest.dest f
+         in
+            Vector.foreach
+            (loops, fn {headers, child} =>
+             let
+                val _ =
+                   Vector.foreach
+                   (headers, fn n =>
+                    let
+                       val i = nodeIndex n
+                       val _ = Array.update (isHeader, i, true)
+                    in
+                       addSignalCheck (Vector.sub (blocks, i))
+                    end)
+                val _ = loop child
+             in
+                ()
+             end)
+         end
       (* Add a signal check at the function entry. *)
       val newStart = Label.newNoname ()
       val _ =
-	 addSignalCheck
-	 (Block.T {args = Vector.new0 (),
-		   kind = Kind.Jump,
-		   label = newStart,
-		   statements = Vector.new0 (),
-		   transfer = Transfer.Goto {args = Vector.new0 (),
-					     dst = start}})
+         addSignalCheck
+         (Block.T {args = Vector.new0 (),
+                   kind = Kind.Jump,
+                   label = newStart,
+                   statements = Vector.new0 (),
+                   transfer = Transfer.Goto {args = Vector.new0 (),
+                                             dst = start}})
       val () = loop (Graph.loopForestSteensgaard (g, {root = labelNode start}))
       val blocks =
-	 Vector.keepAllMap
-	 (blocks, fn b as Block.T {label, ...} =>
-	  if Array.sub (isHeader, labelIndex label)
-	     then NONE
-	  else SOME b)
+         Vector.keepAllMap
+         (blocks, fn b as Block.T {label, ...} =>
+          if Array.sub (isHeader, labelIndex label)
+             then NONE
+          else SOME b)
       val blocks = Vector.concat [blocks, Vector.fromList (!extra)]
       val f = Function.new {args = args,
-			    blocks = blocks,
-			    name = name,
-			    raises = raises,
-			    returns = returns,
-			    start = newStart}
+                            blocks = blocks,
+                            name = name,
+                            raises = raises,
+                            returns = returns,
+                            start = newStart}
       val _ = Function.clear f
    in
       f
@@ -186,12 +187,12 @@
       val Program.T {functions, handlesSignals, main, objectTypes} = p
    in
       if not handlesSignals
-	 then p
+         then p
       else
-	 Program.T {functions = List.revMap (functions, insertInFunction),
-		    handlesSignals = handlesSignals,
-		    main = main,
-		    objectTypes = objectTypes}
+         Program.T {functions = List.revMap (functions, insertInFunction),
+                    handlesSignals = handlesSignals,
+                    main = main,
+                    objectTypes = objectTypes}
    end
 
 end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/backend/signal-check.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/backend/signal-check.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/backend/signal-check.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 type int = Int.t
    
 signature SIGNAL_CHECK_STRUCTS = 

Modified: mlton/branches/on-20050420-cmm-branch/mlton/backend/small-int-inf.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/backend/small-int-inf.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/backend/small-int-inf.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 functor SmallIntInf(S: SMALL_INT_INF_STRUCTS): SMALL_INT_INF = 
 struct
 
@@ -25,15 +26,15 @@
 fun fromString (str: string): t option =
    if IntInf.<= (minSmall, v) andalso IntInf.<= (v, maxSmall)
       then let val w = Word.fromInt (IntInf.toInt v)
-	       val res = Word.orb (0w1, Word.<< (w, 0w1))
-	   in SOME res
-	   end
+               val res = Word.orb (0w1, Word.<< (w, 0w1))
+           in SOME res
+           end
    else NONE
 
 (* val fromString =
  *    Trace.trace("SmallIntInf.fromString",
- * 	       String.layout,
- * 	       Option.layout layout) fromString
+ *             String.layout,
+ *             Option.layout layout) fromString
  *)
 
 (*

Modified: mlton/branches/on-20050420-cmm-branch/mlton/backend/small-int-inf.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/backend/small-int-inf.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/backend/small-int-inf.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature SMALL_INT_INF_STRUCTS = 
    sig
    end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/backend/sources.cm
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/backend/sources.cm	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/backend/sources.cm	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 Group
 
 signature MACHINE

Modified: mlton/branches/on-20050420-cmm-branch/mlton/backend/sources.mlb
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/backend/sources.mlb	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/backend/sources.mlb	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,62 +1,63 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 local
-    ../../lib/mlton/sources.mlb
-    ../ast/sources.mlb
-    ../atoms/sources.mlb
-    ../control/sources.mlb
-    ../ssa/sources.mlb
+   ../../lib/mlton/sources.mlb
+   ../ast/sources.mlb
+   ../atoms/sources.mlb
+   ../control/sources.mlb
+   ../ssa/sources.mlb
 
-    runtime.sig
-    runtime.fun
-    pointer-tycon.sig
-    pointer-tycon.fun
-    object-type.sig
-    scale.sig
-    scale.fun
-    rep-type.sig
-    rep-type.fun
-    switch.sig
-    switch.fun
-    err.sml
-    rssa.sig
-    rssa.fun
-    representation.sig
-    packed-representation.fun
-    ssa-to-rssa.sig
-    ssa-to-rssa.fun
-    implement-handlers.sig
-    implement-handlers.fun
-    limit-check.sig
-    limit-check.fun
-    signal-check.sig
-    signal-check.fun
-    machine.sig
-    machine.fun
-    profile.sig
-    profile.fun
-    live.sig
-    live.fun
-    allocate-registers.sig
-    allocate-registers.fun
-    equivalence-graph.sig
-    equivalence-graph.fun
-    chunkify.sig
-    chunkify.fun
-    parallel-move.sig
-    parallel-move.fun
-    backend.sig
-    backend.fun
+   runtime.sig
+   runtime.fun
+   pointer-tycon.sig
+   pointer-tycon.fun
+   object-type.sig
+   scale.sig
+   scale.fun
+   rep-type.sig
+   rep-type.fun
+   switch.sig
+   switch.fun
+   err.sml
+   rssa.sig
+   rssa.fun
+   representation.sig
+   packed-representation.fun
+   ssa-to-rssa.sig
+   ssa-to-rssa.fun
+   implement-handlers.sig
+   implement-handlers.fun
+   limit-check.sig
+   limit-check.fun
+   signal-check.sig
+   signal-check.fun
+   machine.sig
+   machine.fun
+   profile.sig
+   profile.fun
+   live.sig
+   live.fun
+   allocate-registers.sig
+   allocate-registers.fun
+   equivalence-graph.sig
+   equivalence-graph.fun
+   chunkify.sig
+   chunkify.fun
+   parallel-move.sig
+   parallel-move.fun
+   backend.sig
+   backend.fun
 in
-    signature MACHINE
-    signature REP_TYPE
-    signature RUNTIME
+   signature MACHINE
+   signature REP_TYPE
+   signature RUNTIME
 
-    functor Backend
-    functor Machine
-end
\ No newline at end of file
+   functor Backend
+   functor Machine
+end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/backend/ssa-to-rssa.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/backend/ssa-to-rssa.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/backend/ssa-to-rssa.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 functor SsaToRssa (S: SSA_TO_RSSA_STRUCTS): SSA_TO_RSSA =
 struct
 
@@ -43,208 +44,208 @@
       type t = Type.t CFunction.t
 
       local
-	 open Type
+         open Type
       in
-	 val gcState = gcState
-	 val Word32 = word (Bits.fromInt 32)
-	 val unit = unit
+         val gcState = gcState
+         val Word32 = word (Bits.fromInt 32)
+         val unit = unit
       end
 
       datatype z = datatype Convention.t
       datatype z = datatype Target.t
-	 
+         
       val copyCurrentThread =
-	 T {args = Vector.new1 gcState,
-	    bytesNeeded = NONE,
-	    convention = Cdecl,
-	    ensuresBytesFree = false,
-	    mayGC = true,
-	    maySwitchThreads = false,
-	    modifiesFrontier = true,
-	    prototype = let
-			   open CType
-			in
-			   (Vector.new1 Pointer, NONE)
-			end,
-	    readsStackTop = true,
-	    return = unit,
-	    target = Direct "GC_copyCurrentThread",
-	    writesStackTop = true}
+         T {args = Vector.new1 gcState,
+            bytesNeeded = NONE,
+            convention = Cdecl,
+            ensuresBytesFree = false,
+            mayGC = true,
+            maySwitchThreads = false,
+            modifiesFrontier = true,
+            prototype = let
+                           open CType
+                        in
+                           (Vector.new1 Pointer, NONE)
+                        end,
+            readsStackTop = true,
+            return = unit,
+            target = Direct "GC_copyCurrentThread",
+            writesStackTop = true}
 
       val copyThread =
-	 T {args = Vector.new2 (gcState, Type.thread),
-	    bytesNeeded = NONE,
-	    convention = Cdecl,
-	    ensuresBytesFree = false,
-	    mayGC = true,
-	    maySwitchThreads = false,
-	    modifiesFrontier = true,
-	    prototype = let
-			   open CType
-			in
-			   (Vector.new2 (Pointer, Pointer), SOME Pointer)
-			end,
-	    readsStackTop = true,
-	    return = Type.thread,
-	    target = Direct "GC_copyThread",
-	    writesStackTop = true}
+         T {args = Vector.new2 (gcState, Type.thread),
+            bytesNeeded = NONE,
+            convention = Cdecl,
+            ensuresBytesFree = false,
+            mayGC = true,
+            maySwitchThreads = false,
+            modifiesFrontier = true,
+            prototype = let
+                           open CType
+                        in
+                           (Vector.new2 (Pointer, Pointer), SOME Pointer)
+                        end,
+            readsStackTop = true,
+            return = Type.thread,
+            target = Direct "GC_copyThread",
+            writesStackTop = true}
 
       val exit =
-	 T {args = Vector.new1 Word32,
-	    bytesNeeded = NONE,
-	    convention = Cdecl,
-	    ensuresBytesFree = false,
-	    mayGC = false,
-	    maySwitchThreads = false,
-	    modifiesFrontier = true,
-	    prototype = let
-			   open CType
-			in
-			   (Vector.new1 Word32, NONE)
-			end,
-	    readsStackTop = true,
-	    return = unit,
-	    target = Direct "MLton_exit",
-	    writesStackTop = true}
+         T {args = Vector.new1 Word32,
+            bytesNeeded = NONE,
+            convention = Cdecl,
+            ensuresBytesFree = false,
+            mayGC = false,
+            maySwitchThreads = false,
+            modifiesFrontier = true,
+            prototype = let
+                           open CType
+                        in
+                           (Vector.new1 Word32, NONE)
+                        end,
+            readsStackTop = true,
+            return = unit,
+            target = Direct "MLton_exit",
+            writesStackTop = true}
 
       fun gcArrayAllocate {return} =
-	 T {args = Vector.new4 (gcState, Word32, Word32, Word32),
-	    bytesNeeded = NONE,
-	    convention = Cdecl,
-	    ensuresBytesFree = true,
-	    mayGC = true,
-	    maySwitchThreads = false,
-	    modifiesFrontier = true,
-	    prototype = let
-			   open CType
-			in
-			   (Vector.new4 (Pointer, Word32, Word32, Word32),
-			    SOME Pointer)
-			end,
-	    readsStackTop = true,
-	    return = return,
-	    target = Direct "GC_arrayAllocate",
-	    writesStackTop = true}
+         T {args = Vector.new4 (gcState, Word32, Word32, Word32),
+            bytesNeeded = NONE,
+            convention = Cdecl,
+            ensuresBytesFree = true,
+            mayGC = true,
+            maySwitchThreads = false,
+            modifiesFrontier = true,
+            prototype = let
+                           open CType
+                        in
+                           (Vector.new4 (Pointer, Word32, Word32, Word32),
+                            SOME Pointer)
+                        end,
+            readsStackTop = true,
+            return = return,
+            target = Direct "GC_arrayAllocate",
+            writesStackTop = true}
 
       val returnToC =
-	 T {args = Vector.new0 (),
-	    bytesNeeded = NONE,
-	    convention = Cdecl,
-	    ensuresBytesFree = false,
-	    mayGC = true,
-	    maySwitchThreads = true,
-	    modifiesFrontier = true,
-	    prototype = let
-			   open CType
-			in
-			   (Vector.new0 (), NONE)
-			end,
-	    readsStackTop = true,
-	    return = unit,
-	    target = Direct "Thread_returnToC",
-	    writesStackTop = true}
+         T {args = Vector.new0 (),
+            bytesNeeded = NONE,
+            convention = Cdecl,
+            ensuresBytesFree = false,
+            mayGC = true,
+            maySwitchThreads = true,
+            modifiesFrontier = true,
+            prototype = let
+                           open CType
+                        in
+                           (Vector.new0 (), NONE)
+                        end,
+            readsStackTop = true,
+            return = unit,
+            target = Direct "Thread_returnToC",
+            writesStackTop = true}
 
       val threadSwitchTo =
-	 T {args = Vector.new2 (Type.thread, Word32),
-	    bytesNeeded = NONE,
-	    convention = Cdecl,
-	    ensuresBytesFree = true,
-	    mayGC = true,
-	    maySwitchThreads = true,
-	    modifiesFrontier = true,
-	    prototype = let
-			   open CType
-			in
-			   (Vector.new2 (Pointer, Word32), NONE)
-			end,
-	    readsStackTop = true,
-	    return = unit,
-	    target = Direct "Thread_switchTo",
-	    writesStackTop = true}
+         T {args = Vector.new2 (Type.thread, Word32),
+            bytesNeeded = NONE,
+            convention = Cdecl,
+            ensuresBytesFree = true,
+            mayGC = true,
+            maySwitchThreads = true,
+            modifiesFrontier = true,
+            prototype = let
+                           open CType
+                        in
+                           (Vector.new2 (Pointer, Word32), NONE)
+                        end,
+            readsStackTop = true,
+            return = unit,
+            target = Direct "Thread_switchTo",
+            writesStackTop = true}
 
       fun weakCanGet t =
-	 vanilla {args = Vector.new1 t,
-		  name = "GC_weakCanGet",
-		  prototype = let
-				 open CType
-			      in
-				 (Vector.new1 Pointer, SOME bool)
-			      end,
-		  return = Type.bool}
-	 
+         vanilla {args = Vector.new1 t,
+                  name = "GC_weakCanGet",
+                  prototype = let
+                                 open CType
+                              in
+                                 (Vector.new1 Pointer, SOME bool)
+                              end,
+                  return = Type.bool}
+         
       fun weakGet {arg, return} =
-	 vanilla {args = Vector.new1 arg,
-		  name = "GC_weakGet",
-		  prototype = let
-				 open CType
-			      in
-				 (Vector.new1 Pointer, SOME Pointer)
-			      end,
-		  return = return}
-		  
+         vanilla {args = Vector.new1 arg,
+                  name = "GC_weakGet",
+                  prototype = let
+                                 open CType
+                              in
+                                 (Vector.new1 Pointer, SOME Pointer)
+                              end,
+                  return = return}
+                  
       fun weakNew {arg, return} =
-	 T {args = Vector.new3 (gcState, Word32, arg),
-	    bytesNeeded = NONE,
-	    convention = Cdecl,
-	    ensuresBytesFree = false,
-	    mayGC = true,
-	    maySwitchThreads = false,
-	    modifiesFrontier = true,
-	    prototype = let
-			   open CType
-			in
-			   (Vector.new3 (Pointer, Word32, Pointer), SOME Pointer)
-			end,
+         T {args = Vector.new3 (gcState, Word32, arg),
+            bytesNeeded = NONE,
+            convention = Cdecl,
+            ensuresBytesFree = false,
+            mayGC = true,
+            maySwitchThreads = false,
+            modifiesFrontier = true,
+            prototype = let
+                           open CType
+                        in
+                           (Vector.new3 (Pointer, Word32, Pointer), SOME Pointer)
+                        end,
             readsStackTop = true,
-	    return = return,
-	    target = Direct "GC_weakNew",
-	    writesStackTop = true}
+            return = return,
+            target = Direct "GC_weakNew",
+            writesStackTop = true}
 
       val worldSave =
-	 T {args = Vector.new2 (gcState, Word32),
-	    bytesNeeded = NONE,
-	    convention = Cdecl,
-	    ensuresBytesFree = false,
-	    mayGC = true,
-	    maySwitchThreads = false,
-	    modifiesFrontier = true,
-	    prototype = let
-			   open CType
-			in
-			   (Vector.new2 (Pointer, Word32), NONE)
-			end,
-	    readsStackTop = true,
-	    return = unit,
-	    target = Direct "GC_saveWorld",
-	    writesStackTop = true}
+         T {args = Vector.new2 (gcState, Word32),
+            bytesNeeded = NONE,
+            convention = Cdecl,
+            ensuresBytesFree = false,
+            mayGC = true,
+            maySwitchThreads = false,
+            modifiesFrontier = true,
+            prototype = let
+                           open CType
+                        in
+                           (Vector.new2 (Pointer, Word32), NONE)
+                        end,
+            readsStackTop = true,
+            return = unit,
+            target = Direct "GC_saveWorld",
+            writesStackTop = true}
 
       fun share t =
-	 T {args = Vector.new1 t,
-	    bytesNeeded = NONE,
-	    convention = Cdecl,
-	    ensuresBytesFree = false,
-	    mayGC = false,
-	    maySwitchThreads = false,
-	    modifiesFrontier = true, (* actually, just readsFrontier *)
-	    prototype = let
-			   open CType
-			in
-			   (Vector.new1 Pointer, NONE)
-			end,
-	    readsStackTop = false,
-	    return = unit,
-	    target = Direct "MLton_share",
-	    writesStackTop = false}
+         T {args = Vector.new1 t,
+            bytesNeeded = NONE,
+            convention = Cdecl,
+            ensuresBytesFree = false,
+            mayGC = false,
+            maySwitchThreads = false,
+            modifiesFrontier = true, (* actually, just readsFrontier *)
+            prototype = let
+                           open CType
+                        in
+                           (Vector.new1 Pointer, NONE)
+                        end,
+            readsStackTop = false,
+            return = unit,
+            target = Direct "MLton_share",
+            writesStackTop = false}
 
       fun size t =
-	 vanilla {args = Vector.new1 t,
-		  name = "MLton_size",
-		  prototype = let
-				 open CType
-			      in
-				 (Vector.new1 Pointer, SOME Word32)
-			      end,
-		  return = Word32}
+         vanilla {args = Vector.new1 t,
+                  name = "MLton_size",
+                  prototype = let
+                                 open CType
+                              in
+                                 (Vector.new1 Pointer, SOME Word32)
+                              end,
+                  return = Word32}
    end
 
 structure Name =
@@ -254,266 +255,283 @@
       type t = Type.t t
 
       fun cFunctionRaise (n: t): CFunction.t =
-	 let
-	    datatype z = datatype CFunction.Convention.t
-	    datatype z = datatype CFunction.Target.t
-	    val name = toString n
-	    val real = Type.real
-	    val word = Type.word o WordSize.bits
-	    val vanilla = CFunction.vanilla
-	    fun coerce (t1, t2, sg) =
-	       vanilla {args = Vector.new1 t1,
-			name = name,
-			prototype = (Vector.new1
-				     (CType.word
-				      (WordSize.fromBits (Type.width t1), sg)),
-				     SOME (Type.toCType t2)),
-			return = t2}
-	    fun intInfBinary () =
-	       CFunction.T {args = Vector.new3 (Type.intInf, Type.intInf,
-						Type.defaultWord),
-			    bytesNeeded = SOME 2,
-			    convention = Cdecl,
-			    ensuresBytesFree = false,
-			    mayGC = false,
-			    maySwitchThreads = false,
-			    modifiesFrontier = true,
-			    prototype = let
-					   open CType
-					in
-					   (Vector.new3 (Pointer, Pointer, Word32),
-					    SOME Pointer)
-					end,
-			    readsStackTop = false,
-			    return = Type.intInf,
-			    target = Direct name,
-			    writesStackTop = false}
-	    fun intInfShift () =
-	       CFunction.T {args = Vector.new3 (Type.intInf,
-						Type.defaultWord,
-						Type.defaultWord),
-			    bytesNeeded = SOME 2,
-			    convention = Cdecl,
-			    ensuresBytesFree = false,
-			    mayGC = false,
-			    maySwitchThreads = false,
-			    modifiesFrontier = true,
-			    prototype = let
-					   open CType
-					in
-					   (Vector.new3 (Pointer, Word32, Word32),
-					    SOME Pointer)
-					end,
-			    readsStackTop = false,
-			    return = Type.intInf,
-			    target = Direct name,
-			    writesStackTop = false}
-	    fun intInfToString () =
-	       CFunction.T {args = Vector.new3 (Type.intInf,
-						Type.defaultWord,
-						Type.defaultWord),
-			    bytesNeeded = SOME 2,
-			    convention = Cdecl,
-			    ensuresBytesFree = false,
-			    mayGC = false,
-			    maySwitchThreads = false,
-			    modifiesFrontier = true,
-			    prototype = let
-					   open CType
-					in
-					   (Vector.new3 (Pointer, Word32, Word32),
-					    SOME Pointer)
-					end,
-			    readsStackTop = false,
-			    return = Type.string,
-			    target = Direct name,
-			    writesStackTop = false}
-	    fun intInfUnary () =
-	       CFunction.T {args = Vector.new2 (Type.intInf, Type.defaultWord),
-			    bytesNeeded = SOME 1,
-			    convention = Cdecl,
-			    ensuresBytesFree = false,
-			    mayGC = false,
-			    maySwitchThreads = false,
-			    modifiesFrontier = true,
-			    prototype = let
-					   open CType
-					in
-					   (Vector.new2 (Pointer, Word32),
-					    SOME Pointer)
-					end,
-			    readsStackTop = false,
-			    return = Type.intInf,
-			    target = Direct name,
-			    writesStackTop = false}
-	    local
-	       fun make n s =
-		  let
-		     val t = real s
-		     val ct = CType.real s
-		  in
-		     vanilla {args = Vector.new (n, t),
-			      name = name,
-			      prototype = (Vector.new (n, ct), SOME ct),
-			      return = t}
-		  end
-	    in
-	       val realBinary = make 2
-	       val realTernary = make 3
-	       val realUnary = make 1
-	    end
-	    fun realCompare s =
-	       let
-		  val t = real s
-	       in
-		  vanilla {args = Vector.new2 (t, t),
-			   name = name,
-			   prototype = let
-					  val t = CType.real s
-				       in
-					  (Vector.new2 (t, t), SOME CType.bool)
-				       end,
-			   return = Type.bool}
-	       end
-	    fun wordBinary (s, sg) =
-	       let
-		  val t = word s
-	       in
-		  vanilla {args = Vector.new2 (t, t),
-			   name = name,
-			   prototype = let
-					  val t = CType.word (s, sg)
-				       in
-					  (Vector.new2 (t, t), SOME t)
-				       end,
-			   return = t}
-	       end
-	    fun wordCompare (s, sg) =
-	       vanilla {args = Vector.new2 (word s, word s),
-			name = name,
-			prototype = let
-				       val t = CType.word (s, sg)
-				    in
-				       (Vector.new2 (t, t), SOME CType.bool)
-				    end,
-			return = Type.bool}
-	    fun wordShift (s, sg) =
-	       vanilla {args = Vector.new2 (word s, Type.defaultWord),
-			name = name,
-			prototype = let
-				       open CType
-				    in
-				       (Vector.new2 (word (s, sg), Word32),
-					SOME bool)
-				    end,
-			return = word s}
-	    fun wordUnary s =
-	       vanilla {args = Vector.new1 (word s),
-			name = name,
-			prototype = let
-				       open CType
-				       val t = word (s, {signed = false})
-				    in
-				       (Vector.new1 t, SOME t)
-				    end,
-			return = word s}
-	 in
-	    case n of
-	       IntInf_add => intInfBinary ()
-	     | IntInf_andb => intInfBinary ()
-	     | IntInf_arshift => intInfShift ()
-	     | IntInf_compare => 
-		  vanilla {args = Vector.new2 (Type.intInf, Type.intInf),
-			   name = name,
-			   prototype = let
-					  open CType
-				       in
-					  (Vector.new2 (Pointer, Pointer),
-					   SOME Int32)
-				       end,
-			   return = Type.defaultWord}
-	     | IntInf_equal =>
-		  vanilla {args = Vector.new2 (Type.intInf, Type.intInf),
-			   name = name,
-			   prototype = let
-					  open CType
-				       in
-					  (Vector.new2 (Pointer, Pointer),
-					   SOME bool)
-				       end,
-			   return = Type.bool}
-	     | IntInf_gcd => intInfBinary ()
-	     | IntInf_lshift => intInfShift ()
-	     | IntInf_mul => intInfBinary ()
-	     | IntInf_neg => intInfUnary ()
-	     | IntInf_notb => intInfUnary ()
-	     | IntInf_orb => intInfBinary ()
-	     | IntInf_quot => intInfBinary ()
-	     | IntInf_rem => intInfBinary ()
-	     | IntInf_sub => intInfBinary ()
-	     | IntInf_toString => intInfToString ()
-	     | IntInf_xorb => intInfBinary ()
-	     | MLton_bug => CFunction.bug
-	     | Real_Math_acos s => realUnary s
-	     | Real_Math_asin s => realUnary s
-	     | Real_Math_atan s => realUnary s
-	     | Real_Math_atan2 s => realBinary s
-	     | Real_Math_cos s => realUnary s
-	     | Real_Math_exp s => realUnary s
-	     | Real_Math_ln s => realUnary s
-	     | Real_Math_log10 s => realUnary s
-	     | Real_Math_sin s => realUnary s
-	     | Real_Math_sqrt s => realUnary s
-	     | Real_Math_tan s => realUnary s
-	     | Real_abs s => realUnary s
-	     | Real_add s => realBinary s
-	     | Real_div s => realBinary s
-	     | Real_equal s => realCompare s
-	     | Real_ldexp s =>
-		  let
-		     val t = real s
-		     val ct = CType.real s
-		  in
-		     vanilla {args = Vector.new2 (t, Type.defaultWord),
-			      name = name,
-			      prototype = (Vector.new2 (ct, CType.Int32),
-					   SOME ct),
-			      return = t}
-		  end
-	     | Real_le s => realCompare s
-	     | Real_lt s => realCompare s
-	     | Real_mul s => realBinary s
-	     | Real_muladd s => realTernary s
-	     | Real_mulsub s => realTernary s
-	     | Real_neg s => realUnary s
-	     | Real_qequal s => realCompare s
-	     | Real_round s => realUnary s
-	     | Real_sub s => realBinary s
-	     | Thread_returnToC => CFunction.returnToC
-	     | Word_add s => wordBinary (s, {signed = false})
-	     | Word_andb s => wordBinary (s, {signed = false})
-	     | Word_equal s => wordCompare (s, {signed = false})
-	     | Word_lshift s => wordShift (s, {signed = false})
-	     | Word_lt z => wordCompare z
-	     | Word_mul z => wordBinary z
-	     | Word_neg s => wordUnary s
-	     | Word_notb s => wordUnary s
-	     | Word_orb s => wordBinary (s, {signed = false})
-	     | Word_quot z => wordBinary z
-	     | Word_rem z => wordBinary z
-	     | Word_rol s => wordShift (s, {signed = false})
-	     | Word_ror s => wordShift (s, {signed = false})
-	     | Word_rshift z => wordShift z
-	     | Word_sub s => wordBinary (s, {signed = false})
-	     | Word_toReal (s1, s2, sg) =>
-		  coerce (Type.word (WordSize.bits s1), Type.real s2, sg)
-	     | Word_toWord (s1, s2, sg) =>
-		  coerce (Type.word (WordSize.bits s1),
-			  Type.word (WordSize.bits s2),
-			  sg)
-	     | Word_xorb s => wordBinary (s, {signed = false})
-	     | _ => raise Fail "cFunctionRaise"
-	 end
+         let
+            datatype z = datatype CFunction.Convention.t
+            datatype z = datatype CFunction.Target.t
+            val name = toString n
+            val real = Type.real
+            val word = Type.word o WordSize.bits
+            val vanilla = CFunction.vanilla
+            fun coerce (t1, t2, sg) =
+               vanilla {args = Vector.new1 t1,
+                        name = name,
+                        prototype = (Vector.new1
+                                     (CType.word
+                                      (WordSize.fromBits (Type.width t1), sg)),
+                                     SOME (Type.toCType t2)),
+                        return = t2}
+            fun amAllocationProfiling () =
+               Control.ProfileAlloc = !Control.profile
+            fun intInfBinary () =
+               CFunction.T {args = Vector.new3 (Type.intInf, Type.intInf,
+                                                Type.defaultWord),
+                            bytesNeeded = SOME 2,
+                            convention = Cdecl,
+                            ensuresBytesFree = false,
+                            mayGC = false,
+                            maySwitchThreads = false,
+                            modifiesFrontier = true,
+                            prototype = let
+                                           open CType
+                                        in
+                                           (Vector.new3 (Pointer, Pointer, Word32),
+                                            SOME Pointer)
+                                        end,
+                            readsStackTop = amAllocationProfiling (),
+                            return = Type.intInf,
+                            target = Direct name,
+                            writesStackTop = false}
+            fun intInfShift () =
+               CFunction.T {args = Vector.new3 (Type.intInf,
+                                                Type.defaultWord,
+                                                Type.defaultWord),
+                            bytesNeeded = SOME 2,
+                            convention = Cdecl,
+                            ensuresBytesFree = false,
+                            mayGC = false,
+                            maySwitchThreads = false,
+                            modifiesFrontier = true,
+                            prototype = let
+                                           open CType
+                                        in
+                                           (Vector.new3 (Pointer, Word32, Word32),
+                                            SOME Pointer)
+                                        end,
+                            readsStackTop = amAllocationProfiling (),
+                            return = Type.intInf,
+                            target = Direct name,
+                            writesStackTop = false}
+            fun intInfToString () =
+               CFunction.T {args = Vector.new3 (Type.intInf,
+                                                Type.defaultWord,
+                                                Type.defaultWord),
+                            bytesNeeded = SOME 2,
+                            convention = Cdecl,
+                            ensuresBytesFree = false,
+                            mayGC = false,
+                            maySwitchThreads = false,
+                            modifiesFrontier = true,
+                            prototype = let
+                                           open CType
+                                        in
+                                           (Vector.new3 (Pointer, Word32, Word32),
+                                            SOME Pointer)
+                                        end,
+                            readsStackTop = amAllocationProfiling (),
+                            return = Type.string,
+                            target = Direct name,
+                            writesStackTop = false}
+            fun intInfUnary () =
+               CFunction.T {args = Vector.new2 (Type.intInf, Type.defaultWord),
+                            bytesNeeded = SOME 1,
+                            convention = Cdecl,
+                            ensuresBytesFree = false,
+                            mayGC = false,
+                            maySwitchThreads = false,
+                            modifiesFrontier = true,
+                            prototype = let
+                                           open CType
+                                        in
+                                           (Vector.new2 (Pointer, Word32),
+                                            SOME Pointer)
+                                        end,
+                            readsStackTop = amAllocationProfiling (),
+                            return = Type.intInf,
+                            target = Direct name,
+                            writesStackTop = false}
+            local
+               fun make n s =
+                  let
+                     val t = real s
+                     val ct = CType.real s
+                  in
+                     vanilla {args = Vector.new (n, t),
+                              name = name,
+                              prototype = (Vector.new (n, ct), SOME ct),
+                              return = t}
+                  end
+            in
+               val realBinary = make 2
+               val realTernary = make 3
+               val realUnary = make 1
+            end
+            fun realCompare s =
+               let
+                  val t = real s
+               in
+                  vanilla {args = Vector.new2 (t, t),
+                           name = name,
+                           prototype = let
+                                          val t = CType.real s
+                                       in
+                                          (Vector.new2 (t, t), SOME CType.bool)
+                                       end,
+                           return = Type.bool}
+               end
+            local
+               fun make n (s, sg) =
+                  let
+                     val t = word s
+                     val ct = CType.word (s, sg)
+                  in
+                     vanilla {args = Vector.new (n, t),
+                              name = name,
+                              prototype = (Vector.new (n, ct), SOME ct),
+                              return = t}
+                  end
+               fun makeOverflows n (s, sg) =
+                  let
+                     val t = word s
+                     val ct = CType.word (s, sg)
+                  in
+                     vanilla {args = Vector.new (n, t),
+                              name = name ^ "Overflows",
+                              prototype = (Vector.new (n, ct), SOME CType.bool),
+                              return = Type.bool}
+                  end
+            in
+               val wordBinary = make 2
+               val wordBinaryOverflows = makeOverflows 2
+               val wordUnary = make 1
+               val wordUnaryOverflows = makeOverflows 1
+            end
+            fun wordCompare (s, sg) =
+               let
+                  val t = word s
+               in
+                  vanilla {args = Vector.new2 (t, t),
+                           name = name,
+                           prototype = let
+                                          val t = CType.word (s, sg)
+                                       in
+                                          (Vector.new2 (t, t), SOME CType.bool)
+                                       end,
+                           return = Type.bool}
+               end
+            fun wordShift (s, sg) =
+               let
+                  val t = word s
+               in
+                  vanilla {args = Vector.new2 (t, Type.defaultWord),
+                           name = name,
+                           prototype = let
+                                          val t = CType.word (s, sg)
+                                       in
+                                          (Vector.new2 (t, CType.Word32), SOME t)
+                                       end,
+                           return = t}
+               end
+         in
+            case n of
+               IntInf_add => intInfBinary ()
+             | IntInf_andb => intInfBinary ()
+             | IntInf_arshift => intInfShift ()
+             | IntInf_compare => 
+                  vanilla {args = Vector.new2 (Type.intInf, Type.intInf),
+                           name = name,
+                           prototype = let
+                                          open CType
+                                       in
+                                          (Vector.new2 (Pointer, Pointer),
+                                           SOME Int32)
+                                       end,
+                           return = Type.defaultWord}
+             | IntInf_equal =>
+                  vanilla {args = Vector.new2 (Type.intInf, Type.intInf),
+                           name = name,
+                           prototype = let
+                                          open CType
+                                       in
+                                          (Vector.new2 (Pointer, Pointer),
+                                           SOME bool)
+                                       end,
+                           return = Type.bool}
+             | IntInf_gcd => intInfBinary ()
+             | IntInf_lshift => intInfShift ()
+             | IntInf_mul => intInfBinary ()
+             | IntInf_neg => intInfUnary ()
+             | IntInf_notb => intInfUnary ()
+             | IntInf_orb => intInfBinary ()
+             | IntInf_quot => intInfBinary ()
+             | IntInf_rem => intInfBinary ()
+             | IntInf_sub => intInfBinary ()
+             | IntInf_toString => intInfToString ()
+             | IntInf_xorb => intInfBinary ()
+             | MLton_bug => CFunction.bug
+             | Real_Math_acos s => realUnary s
+             | Real_Math_asin s => realUnary s
+             | Real_Math_atan s => realUnary s
+             | Real_Math_atan2 s => realBinary s
+             | Real_Math_cos s => realUnary s
+             | Real_Math_exp s => realUnary s
+             | Real_Math_ln s => realUnary s
+             | Real_Math_log10 s => realUnary s
+             | Real_Math_sin s => realUnary s
+             | Real_Math_sqrt s => realUnary s
+             | Real_Math_tan s => realUnary s
+             | Real_abs s => realUnary s
+             | Real_add s => realBinary s
+             | Real_div s => realBinary s
+             | Real_equal s => realCompare s
+             | Real_ldexp s =>
+                  let
+                     val t = real s
+                     val ct = CType.real s
+                  in
+                     vanilla {args = Vector.new2 (t, Type.defaultWord),
+                              name = name,
+                              prototype = (Vector.new2 (ct, CType.Int32),
+                                           SOME ct),
+                              return = t}
+                  end
+             | Real_le s => realCompare s
+             | Real_lt s => realCompare s
+             | Real_mul s => realBinary s
+             | Real_muladd s => realTernary s
+             | Real_mulsub s => realTernary s
+             | Real_neg s => realUnary s
+             | Real_qequal s => realCompare s
+             | Real_round s => realUnary s
+             | Real_sub s => realBinary s
+             | Thread_returnToC => CFunction.returnToC
+             | Word_add s => wordBinary (s, {signed = false})
+             | Word_addCheck (s, sg) => wordBinaryOverflows (s, sg)
+             | Word_andb s => wordBinary (s, {signed = false})
+             | Word_equal s => wordCompare (s, {signed = false})
+             | Word_lshift s => wordShift (s, {signed = false})
+             | Word_lt z => wordCompare z
+             | Word_mul z => wordBinary z
+             | Word_mulCheck (s, sg) => wordBinaryOverflows (s, sg)
+             | Word_neg s => wordUnary (s, {signed = true})
+             | Word_negCheck s => wordUnaryOverflows (s, {signed = true})
+             | Word_notb s => wordUnary (s, {signed = false})
+             | Word_orb s => wordBinary (s, {signed = false})
+             | Word_quot z => wordBinary z
+             | Word_rem z => wordBinary z
+             | Word_rol s => wordShift (s, {signed = false})
+             | Word_ror s => wordShift (s, {signed = false})
+             | Word_rshift z => wordShift z
+             | Word_sub s => wordBinary (s, {signed = false})
+             | Word_subCheck (s, sg) => wordBinaryOverflows (s, sg)
+             | Word_toReal (s1, s2, sg) =>
+                  coerce (Type.word (WordSize.bits s1), Type.real s2, sg)
+             | Word_toWord (s1, s2, sg) =>
+                  coerce (Type.word (WordSize.bits s1),
+                          Type.word (WordSize.bits s2),
+                          sg)
+             | Word_xorb s => wordBinary (s, {signed = false})
+             | _ => Error.bug "SsaToRssa.Name.cFunctionRaise"
+         end
 
       fun cFunction n = SOME (cFunctionRaise n) handle _ => NONE
    end
@@ -523,39 +541,39 @@
 datatype z = datatype Transfer.t
 
 structure PackedRepresentation = PackedRepresentation (structure Rssa = Rssa
-						       structure Ssa = Ssa)
+                                                       structure Ssa = Ssa)
 
 structure Type =
    struct
       open Type
-	 
+         
       fun scale (ty: t): Scale.t =
-	 case Scale.fromInt (Bytes.toInt (bytes ty)) of
-	    NONE => Error.bug "Type.scale"
-	  | SOME s => s
+         case Scale.fromInt (Bytes.toInt (bytes ty)) of
+            NONE => Error.bug "SsaToRssa.Type.scale"
+          | SOME s => s
    end
 
+val cardSizeLog2 : IntInf.t = 8 (* must agree with CARD_SIZE_LOG2 in gc.c *)
+
 fun updateCard (addr: Operand.t): Statement.t list =
    let
       val index = Var.newNoname ()
       val indexTy = Type.defaultWord
    in
       [PrimApp {args = (Vector.new2
-			(addr,
-			 Operand.word
-			 (WordX.fromIntInf (IntInf.fromInt
-					    (!Control.cardSizeLog2),
-					    WordSize.default)))),
-		dst = SOME (index, indexTy),
-		prim = Prim.wordRshift (WordSize.default,
-					{signed = false})},
+                        (addr,
+                         Operand.word
+                         (WordX.fromIntInf (cardSizeLog2, WordSize.default)))),
+                dst = SOME (index, indexTy),
+                prim = Prim.wordRshift (WordSize.default,
+                                        {signed = false})},
        Move {dst = (ArrayOffset
-		    {base = Runtime GCField.CardMap,
-		     index = Var {ty = indexTy, var = index},
-		     offset = Bytes.zero,
-		     scale = Scale.One,
-		     ty = Type.word Bits.inByte}),
-	     src = Operand.word (WordX.one (WordSize.fromBits Bits.inByte))}]
+                    {base = Runtime GCField.CardMap,
+                     index = Var {ty = indexTy, var = index},
+                     offset = Bytes.zero,
+                     scale = Scale.One,
+                     ty = Type.word Bits.inByte}),
+             src = Operand.word (WordX.one (WordSize.fromBits Bits.inByte))}]
    end
 
 fun convertConst (c: Const.t): Const.t =
@@ -563,831 +581,926 @@
       datatype z = datatype Const.t
    in
       case c of
-	 Word w => Word (WordX.resize (w, WordSize.roundUpToPrim (WordX.size w)))
+         Word w => Word (WordX.resize (w, WordSize.roundUpToPrim (WordX.size w)))
        | _ => c
    end
 
 fun convert (program as S.Program.T {functions, globals, main, ...},
-	     {codegenImplementsPrim}): Rssa.Program.t =
+             {codegenImplementsPrim: Rssa.Type.t Rssa.Prim.t -> bool}): Rssa.Program.t =
    let
       val {diagnostic, genCase, object, objectTypes, select, toRtype, update} =
-	 PackedRepresentation.compute program
+         PackedRepresentation.compute program
       val objectTypes = Vector.concat [ObjectType.basic, objectTypes]
       val () =
-	 Vector.foreachi
-	 (objectTypes, fn (i, (pt, _)) => PointerTycon.setIndex (pt, i))
+         Vector.foreachi
+         (objectTypes, fn (i, (pt, _)) => PointerTycon.setIndex (pt, i))
       val objectTypes = Vector.map (objectTypes, #2)
       val () = diagnostic ()
       val {get = varInfo: Var.t -> {ty: S.Type.t},
-	   set = setVarInfo, ...} =
-	 Property.getSetOnce (Var.plist,
-			      Property.initRaise ("varInfo", Var.layout))
+           set = setVarInfo, ...} =
+         Property.getSetOnce (Var.plist,
+                              Property.initRaise ("varInfo", Var.layout))
       val setVarInfo =
-	 Trace.trace2 ("SsaToRssa.setVarInfo",
-		       Var.layout, S.Type.layout o #ty, Unit.layout)
-	 setVarInfo
+         Trace.trace2 ("SsaToRssa.setVarInfo",
+                       Var.layout, S.Type.layout o #ty, Unit.layout)
+         setVarInfo
       val varType = #ty o varInfo
       fun varOp (x: Var.t): Operand.t =
-	 Var {var = x, ty = valOf (toRtype (varType x))}
+         Var {var = x, ty = valOf (toRtype (varType x))}
       val varOp =
-	 Trace.trace ("SsaToRssa.varOp", Var.layout, Operand.layout) varOp
+         Trace.trace ("SsaToRssa.varOp", Var.layout, Operand.layout) varOp
       fun varOps xs = Vector.map (xs, varOp)
       val extraBlocks = ref []
       fun newBlock {args, kind,
-		    statements: Statement.t vector,
-		    transfer: Transfer.t}: Label.t =
-	 let
-	    val l = Label.newNoname ()
-	    val _ = List.push (extraBlocks,
-			       Block.T {args = args,
-					kind = kind,
-					label = l,
-					statements = statements,
-					transfer = transfer})
-	 in
-	    l
-	 end
+                    statements: Statement.t vector,
+                    transfer: Transfer.t}: Label.t =
+         let
+            val l = Label.newNoname ()
+            val _ = List.push (extraBlocks,
+                               Block.T {args = args,
+                                        kind = kind,
+                                        label = l,
+                                        statements = statements,
+                                        transfer = transfer})
+         in
+            l
+         end
       val {get = labelInfo: (Label.t ->
-			     {args: (Var.t * S.Type.t) vector,
-			      cont: (Handler.t * Label.t) list ref,
-			      handler: Label.t option ref}),
-	   set = setLabelInfo, ...} =
-	 Property.getSetOnce (Label.plist,
-			      Property.initRaise ("label info", Label.layout))
+                             {args: (Var.t * S.Type.t) vector,
+                              cont: (Handler.t * Label.t) list ref,
+                              handler: Label.t option ref}),
+           set = setLabelInfo, ...} =
+         Property.getSetOnce (Label.plist,
+                              Property.initRaise ("label info", Label.layout))
       fun translateCase ({test: Var.t,
-			  cases: S.Cases.t,
-			  default: Label.t option})
-	 : Statement.t list * Transfer.t =
-	 case cases of
-	    S.Cases.Con cases =>
-	       (case (Vector.length cases, default) of
-		   (0, NONE) => ([], Transfer.bug)
-		 | _ =>
-		      (case S.Type.dest (varType test) of
-			  S.Type.Datatype tycon =>
-			     let
-				val test = fn () => varOp test
-				val cases =
-				   Vector.map
-				   (cases, fn (con, dst) =>
-				    {con = con,
-				     dst = dst,
-				     dstHasArg =
-				     0 < Vector.length (#args (labelInfo dst))})
-				val (ss, t, blocks) =
-				   genCase {cases = cases,
-					    default = default,
-					    test = test,
-					    tycon = tycon}
-				val () =
-				   extraBlocks := blocks @ !extraBlocks
-			     in
-				(ss, t)
-			     end
-			| _ => Error.bug "strange type in case"))
-	  | S.Cases.Word (s, cs) =>
-	       ([],
-		Switch
-		(Switch.T
-		 {cases = (QuickSort.sortVector
-			   (cs, fn ((w, _), (w', _)) =>
-			    WordX.le (w, w', {signed = false}))),
-		  default = default,
-		  size = s,
-		  test = varOp test}))
+                          cases: S.Cases.t,
+                          default: Label.t option})
+         : Statement.t list * Transfer.t =
+         case cases of
+            S.Cases.Con cases =>
+               (case (Vector.length cases, default) of
+                   (0, NONE) => ([], Transfer.bug)
+                 | _ =>
+                      (case S.Type.dest (varType test) of
+                          S.Type.Datatype tycon =>
+                             let
+                                val test = fn () => varOp test
+                                val cases =
+                                   Vector.map
+                                   (cases, fn (con, dst) =>
+                                    {con = con,
+                                     dst = dst,
+                                     dstHasArg =
+                                     Vector.fold
+                                     (#args (labelInfo dst), false, fn ((_,ty),b) =>
+                                      b orelse isSome (toRtype ty))})
+                                val (ss, t, blocks) =
+                                   genCase {cases = cases,
+                                            default = default,
+                                            test = test,
+                                            tycon = tycon}
+                                val () =
+                                   extraBlocks := blocks @ !extraBlocks
+                             in
+                                (ss, t)
+                             end
+                        | _ => Error.bug "SsaToRssa.translateCase: strange type"))
+          | S.Cases.Word (s, cs) =>
+               ([],
+                Switch
+                (Switch.T
+                 {cases = (QuickSort.sortVector
+                           (cs, fn ((w, _), (w', _)) =>
+                            WordX.le (w, w', {signed = false}))),
+                  default = default,
+                  size = s,
+                  test = varOp test}))
       fun eta (l: Label.t, kind: Kind.t): Label.t =
-	 let
-	    val {args, ...} = labelInfo l
-	    val args = Vector.keepAllMap (args, fn (x, t) =>
-					  Option.map (toRtype t, fn t =>
-						      (Var.new x, t)))
-	    val l' = Label.new l
-	    val _ = 
-	       List.push
-	       (extraBlocks,
-		Block.T {args = args,
-			 kind = kind,
-			 label = l',
-			 statements = Vector.new0 (),
-			 transfer = (Transfer.Goto
-				     {dst = l,
-				      args = Vector.map (args, fn (var, ty) =>
-							 Var {var = var,
-							      ty = ty})})})
-	 in
-	    l'
-	 end
+         let
+            val {args, ...} = labelInfo l
+            val args = Vector.keepAllMap (args, fn (x, t) =>
+                                          Option.map (toRtype t, fn t =>
+                                                      (Var.new x, t)))
+            val l' = Label.new l
+            val _ = 
+               List.push
+               (extraBlocks,
+                Block.T {args = args,
+                         kind = kind,
+                         label = l',
+                         statements = Vector.new0 (),
+                         transfer = (Transfer.Goto
+                                     {dst = l,
+                                      args = Vector.map (args, fn (var, ty) =>
+                                                         Var {var = var,
+                                                              ty = ty})})})
+         in
+            l'
+         end
       fun labelHandler (l: Label.t): Label.t =
-	 let
-	    val {handler, ...} = labelInfo l
-	 in
-	    case !handler of
-	       NONE =>
-		  let
-		     val l' = eta (l, Kind.Handler)
-		     val _ = handler := SOME l'
-		  in
-		     l'
-		  end
-	     | SOME l => l
-	 end
+         let
+            val {handler, ...} = labelInfo l
+         in
+            case !handler of
+               NONE =>
+                  let
+                     val l' = eta (l, Kind.Handler)
+                     val _ = handler := SOME l'
+                  in
+                     l'
+                  end
+             | SOME l => l
+         end
       fun labelCont (l: Label.t, h: Handler.t): Label.t =
-	 let
-	    val {cont, ...} = labelInfo l
-	    datatype z = datatype Handler.t
-	 in
-	    case List.peek (!cont, fn (h', _) => Handler.equals (h, h')) of
-	       SOME (_, l) => l
-	     | NONE =>
-		  let
-		     val l' = eta (l, Kind.Cont {handler = h})
-		     val _ = List.push (cont, (h, l'))
-		  in
-		     l'
-		  end
-	 end
+         let
+            val {cont, ...} = labelInfo l
+            datatype z = datatype Handler.t
+         in
+            case List.peek (!cont, fn (h', _) => Handler.equals (h, h')) of
+               SOME (_, l) => l
+             | NONE =>
+                  let
+                     val l' = eta (l, Kind.Cont {handler = h})
+                     val _ = List.push (cont, (h, l'))
+                  in
+                     l'
+                  end
+         end
       val labelCont =
-	 Trace.trace2 ("SsaToRssa.labelCont",
-		       Label.layout, Handler.layout, Label.layout)
-	 labelCont
+         Trace.trace2 ("SsaToRssa.labelCont",
+                       Label.layout, Handler.layout, Label.layout)
+         labelCont
       fun vos (xs: Var.t vector) =
-	 Vector.keepAllMap (xs, fn x =>
-			    Option.map (toRtype (varType x), fn _ =>
-					varOp x))
-      fun translatePrim p =
-	 Prim.map (p, fn t =>
-		   case toRtype t of
-		      NONE => Type.unit
-		    | SOME t => t)
-      fun translateTransfer (t: S.Transfer.t): Statement.t list * Transfer.t =
-	 case t of
-	    S.Transfer.Arith {args, overflow, prim, success, ty} =>
-	       let
-		  val ty = valOf (toRtype ty)
-		  val temp = Var.newNoname ()
-		  val noOverflow =
-		     newBlock
-		     {args = Vector.new0 (),
-		      kind = Kind.Jump,
-		      statements = Vector.new0 (),
-		      transfer = (Transfer.Goto
-				  {dst = success,
-				   args = (Vector.new1
-					   (Var {var = temp, ty = ty}))})}
-	       in
-		  ([], Transfer.Arith {dst = temp,
-				       args = vos args,
-				       overflow = overflow,
-				       prim = translatePrim prim,
-				       success = noOverflow,
-				       ty = ty})
-	       end
-	  | S.Transfer.Bug => ([], Transfer.bug)
-	  | S.Transfer.Call {func, args, return} =>
-	       let
-		  datatype z = datatype S.Return.t
-		  val return =
-		     case return of
-			Dead => Return.Dead
-		      | NonTail {cont, handler} =>
-			   let
-			      datatype z = datatype S.Handler.t
-			      val handler =
-				 case handler of
-				    Caller => Handler.Caller
-				  | Dead => Handler.Dead
-				  | Handle l => Handler.Handle (labelHandler l)
-			   in
-			      Return.NonTail {cont = labelCont (cont, handler),
-					      handler = handler}
-			   end
-		      | Tail => Return.Tail
-	       in
-		  ([], Transfer.Call {func = func,
-				      args = vos args,
-				      return = return})
-	       end
-	  | S.Transfer.Case r => translateCase r
-	  | S.Transfer.Goto {dst, args} =>
-	       ([], Transfer.Goto {dst = dst, args = vos args})
-	  | S.Transfer.Raise xs => ([], Transfer.Raise (vos xs))
-	  | S.Transfer.Return xs => ([], Transfer.Return (vos xs))
-	  | S.Transfer.Runtime {args, prim, return} =>
-	       let
-		  datatype z = datatype Prim.Name.t
-	       in
-		  case Prim.name prim of
-		     MLton_halt =>
-			([], Transfer.CCall {args = vos args,
-					     func = CFunction.exit,
-					     return = NONE})
-		   | Thread_copyCurrent =>
-			let
-			   val func = CFunction.copyCurrentThread
-			   val l =
-			      newBlock {args = Vector.new0 (),
-					kind = Kind.CReturn {func = func},
-					statements = Vector.new0 (),
-					transfer =
-					(Goto {args = Vector.new0 (),
-					       dst = return})}
-			in
-			   ([],
-			    Transfer.CCall
-			    {args = Vector.concat [Vector.new1 GCState,
-						   vos args],
-			     func = func,
-			     return = SOME l})
-			end
-		   | _ => Error.bug (concat
-				     ["strange prim in SSA Runtime transfer ",
-				      Prim.toString prim])
-	       end
-      val translateTransfer =
-	 Trace.trace ("SsaToRssa.translateTransfer",
-		      S.Transfer.layout,
-		      Layout.tuple2 (List.layout Statement.layout,
-				     Transfer.layout))
-	 translateTransfer
-      fun translateFormals v =
-	 Vector.keepAllMap (v, fn (x, t) =>
-			    Option.map (toRtype t, fn t => (x, t)))
+         Vector.keepAllMap (xs, fn x =>
+                            Option.map (toRtype (varType x), fn _ =>
+                                        varOp x))
       fun bogus (t: Type.t): Operand.t =
-	 case Type.deReal t of
-	    NONE => Operand.cast (Operand.word (Type.bogusWord t), t)
-	  | SOME s => Operand.Const (Const.real (RealX.zero s))
+         case Type.deReal t of
+            NONE => Operand.cast (Operand.word (Type.bogusWord t), t)
+          | SOME s => Operand.Const (Const.real (RealX.zero s))
       val handlesSignals = 
-	 S.Program.hasPrim 
-	 (program, fn p => 
-	  case Prim.name p of
-	     Prim.Name.MLton_installSignalHandler => true
-	   | _ => false)
+         S.Program.hasPrim 
+         (program, fn p => 
+          case Prim.name p of
+             Prim.Name.MLton_installSignalHandler => true
+           | _ => false)
+      fun translateFormals v =
+         Vector.keepAllMap (v, fn (x, t) =>
+                            Option.map (toRtype t, fn t => (x, t)))
+      fun translatePrim p =
+         Prim.map (p, fn t =>
+                   case toRtype t of
+                      NONE => Type.unit
+                    | SOME t => t)
+      fun translateTransfer (t: S.Transfer.t): (Statement.t list * 
+                                                Transfer.t) =
+         case t of
+            S.Transfer.Arith {args, overflow, prim, success, ty} =>
+               let
+                  val prim = translatePrim prim
+                  val ty = valOf (toRtype ty)
+                  val res = Var.newNoname ()
+                  val noOverflow =
+                     newBlock
+                     {args = Vector.new0 (),
+                      kind = Kind.Jump,
+                      statements = Vector.new0 (),
+                      transfer = (Transfer.Goto
+                                  {dst = success,
+                                   args = (Vector.new1
+                                           (Var {var = res, ty = ty}))})}
+               in
+                  if codegenImplementsPrim prim
+                     then ([], 
+                           Transfer.Arith {dst = res,
+                                           args = vos args,
+                                           overflow = overflow,
+                                           prim = prim,
+                                           success = noOverflow,
+                                           ty = ty})
+                     else 
+                        let
+                           datatype z = datatype Prim.Name.t
+                           fun doOperCheckCF (operCheck) =
+                              let
+                                 val operCheckCF =
+                                    case Name.cFunction operCheck of
+                                       NONE =>
+                                          Error.bug
+                                          (concat ["SsaToRssa.translateTransfer: ",
+                                                   "unimplemented arith:",
+                                                   Name.toString operCheck])
+                                     | SOME operCheckCF => operCheckCF
+                                 val afterOperCheck =
+                                    let
+                                       val checkRes = Var.newNoname ()
+                                    in
+                                       newBlock
+                                       {args = Vector.new1 (checkRes, Type.bool),
+                                        kind = Kind.CReturn {func = operCheckCF},
+                                        statements = Vector.new0 (),
+                                        transfer = (Transfer.ifBool
+                                                    (Var {var = checkRes,
+                                                          ty = Type.bool}, 
+                                                     {falsee = noOverflow, 
+                                                      truee = overflow}))}
+                                    end
+                              in
+                                 Transfer.CCall
+                                 {args = vos args,
+                                  func = operCheckCF,
+                                  return = SOME afterOperCheck}
+                              end
+                           fun doOperCF (oper, operCheck) =
+                              let
+                                 val operCF =
+                                    case Name.cFunction oper of
+                                       NONE =>
+                                          Error.bug
+                                          (concat ["SsaToRssa.translateTransfer: ",
+                                                   "unimplemented arith:",
+                                                   Name.toString oper])
+                                     | SOME operCF => operCF
+                                 val afterOper =
+                                    newBlock
+                                    {args = Vector.new1 (res, ty),
+                                     kind = Kind.CReturn {func = operCF},
+                                     statements = Vector.new0 (),
+                                     transfer = doOperCheckCF operCheck}
+                              in
+                                 Transfer.CCall
+                                 {args = vos args,
+                                  func = operCF,
+                                  return = SOME afterOper}
+                              end
+                           fun doPrim prim =
+                              [Statement.PrimApp
+                               {dst = SOME (res, ty),
+                                prim = prim,
+                                args = vos args}]
+                           fun doit (prim, operCheck) =
+                              if codegenImplementsPrim prim
+                                 then (doPrim prim, doOperCheckCF operCheck)
+                              else ([], doOperCF (Prim.name prim, operCheck))
+                        in
+                           case Prim.name prim of
+                              Word_addCheck (s, sg) => 
+                                 doit (Prim.wordAdd s, 
+                                       Word_addCheck (s, sg))
+                            | Word_mulCheck (s, sg) => 
+                                 doit (Prim.wordMul (s, sg),
+                                       Word_mulCheck (s, sg))
+                            | Word_negCheck s => 
+                                 doit (Prim.wordNeg s, 
+                                       Word_negCheck s)
+                            | Word_subCheck (s, sg) => 
+                                 doit (Prim.wordSub s, 
+                                       Word_subCheck (s, sg))
+                            | _ => Error.bug (concat ["SsaToRssa.translateTransfer: ",
+                                                      "strange arith:",
+                                                      Name.toString (Prim.name prim)])
+                        end
+               end
+          | S.Transfer.Bug => ([], Transfer.bug)
+          | S.Transfer.Call {func, args, return} =>
+               let
+                  datatype z = datatype S.Return.t
+                  val return =
+                     case return of
+                        Dead => Return.Dead
+                      | NonTail {cont, handler} =>
+                           let
+                              datatype z = datatype S.Handler.t
+                              val handler =
+                                 case handler of
+                                    Caller => Handler.Caller
+                                  | Dead => Handler.Dead
+                                  | Handle l => Handler.Handle (labelHandler l)
+                           in
+                              Return.NonTail {cont = labelCont (cont, handler),
+                                              handler = handler}
+                           end
+                      | Tail => Return.Tail
+               in
+                  ([], Transfer.Call {func = func,
+                                      args = vos args,
+                                      return = return})
+               end
+          | S.Transfer.Case r => translateCase r
+          | S.Transfer.Goto {dst, args} =>
+               ([], Transfer.Goto {dst = dst, args = vos args})
+          | S.Transfer.Raise xs => ([], Transfer.Raise (vos xs))
+          | S.Transfer.Return xs => ([], Transfer.Return (vos xs))
+          | S.Transfer.Runtime {args, prim, return} =>
+               let
+                  datatype z = datatype Prim.Name.t
+               in
+                  case Prim.name prim of
+                     MLton_halt =>
+                        ([], Transfer.CCall {args = vos args,
+                                             func = CFunction.exit,
+                                             return = NONE})
+                   | Thread_copyCurrent =>
+                        let
+                           val func = CFunction.copyCurrentThread
+                           val l =
+                              newBlock {args = Vector.new0 (),
+                                        kind = Kind.CReturn {func = func},
+                                        statements = Vector.new0 (),
+                                        transfer =
+                                        (Goto {args = Vector.new0 (),
+                                               dst = return})}
+                        in
+                           ([],
+                            Transfer.CCall
+                            {args = Vector.concat [Vector.new1 GCState,
+                                                   vos args],
+                             func = func,
+                             return = SOME l})
+                        end
+                   | _ => Error.bug (concat
+                                     ["SsaToRssa.translateTransfer: ",
+                                      "strange Runtime prim: ",
+                                      Prim.toString prim])
+               end
       fun translateStatementsTransfer (statements, ss, transfer) =
-	 let
-	    fun loop (i, ss, t): Statement.t vector * Transfer.t =
-	       if i < 0
-		  then (Vector.fromList ss, t)
-	       else
-		  let
-		     fun none () = loop (i - 1, ss, t)
-		     fun add s = loop (i - 1, s :: ss, t)
-		     fun adds ss' = loop (i - 1, ss' @ ss, t)
-		     val s = Vector.sub (statements, i)
-		  in
-		     case s of
-			S.Statement.Profile e => add (Statement.Profile e)
-		      | S.Statement.Update {base, offset, value} =>
-			   (case toRtype (varType value) of
-			       NONE => none ()
-			     | SOME t => 
-				  let
-				     val baseOp = Base.map (base, varOp)
-				     val ss =
-					update
-					{base = baseOp,
-					 baseTy = varType (Base.object base),
-					 offset = offset,
-					 value = varOp value}
-				     val ss =
-					if !Control.markCards
-					   andalso Type.isPointer t
-					   then
-					      updateCard (Base.object baseOp)
-					      @ ss
-					else ss
-				  in
-				     adds ss
-				  end)
-		      | S.Statement.Bind {exp, ty, var} =>
-	          let
-		     fun split (args, kind,
-				ss: Statement.t list,
-				make: Label.t -> Statement.t list * Transfer.t) =
-			let
-			   val l = newBlock {args = args,
-					     kind = kind,
-					     statements = Vector.fromList ss,
-					     transfer = t}
-			   val (ss, t) = make l
-			in
-			   loop (i - 1, ss, t)
-			end
-		     fun maybeMove (f: Type.t -> Operand.t) =
-			case toRtype ty of
-			   NONE => none ()
-			 | SOME ty =>
-			      add (Bind {dst = (valOf var, ty),
-					 isMutable = false,
-					 src = f ty})
-		     fun move (src: Operand.t) = maybeMove (fn _ => src)
-		  in
-		     case exp of
-			S.Exp.Const c => move (Const (convertConst c))
-		      | S.Exp.Inject {variant, ...} =>
-			   if isSome (toRtype ty)
-			      then move (varOp variant)
-			   else none ()
-		      | S.Exp.Object {args, con} =>
-			   (case toRtype ty of
-			       NONE => none ()
-			     | SOME dstTy => 
-				  adds (object {args = args,
-						con = con,
-						dst = (valOf var, dstTy),
-						objectTy = ty,
-						oper = varOp}))
-		      | S.Exp.PrimApp {args, prim} =>
-			   let
-			      val prim = translatePrim prim
-			      fun arg i = Vector.sub (args, i)
-			      fun a i = varOp (arg i)
-			      fun cast () =
-				 move (Operand.cast (a 0, valOf (toRtype ty)))
-			      fun ifIsWeakPointer (ty: S.Type.t, yes, no) =
-				 case S.Type.dest ty of
-				    S.Type.Weak ty =>
-				       (case toRtype ty of
-					   NONE => no ()
-					 | SOME t =>
-					      if Type.isPointer t
-						 then yes t
-					      else no ())
-				  | _ => Error.bug "ifIsWeakPointer"
-			      fun arrayOrVectorLength () =
-				 move (Offset
-				       {base = a 0,
-					offset = Runtime.arrayLengthOffset,
-					ty = Type.defaultWord})
-			      fun subWord () =
-				 move (ArrayOffset {base = a 0,
-						    index = a 1,
-						    offset = Bytes.zero,
-						    scale = Type.scale Type.defaultWord,
-						    ty = Type.defaultWord})
-			      fun dst () =
-				 case var of
-				    SOME x =>
-				       Option.map (toRtype (varType x), fn t =>
-						   (x, t))
-				  | NONE => NONE
-			      fun primApp prim =
-				 add (PrimApp {dst = dst (),
-					       prim = prim,
-					       args = varOps args})
-			      datatype z = datatype Prim.Name.t
-			      fun bumpCanHandle n =
-				 let
-				    val canHandle = Runtime GCField.CanHandle
-				    val res = Var.newNoname ()
-				    val resTy = Operand.ty canHandle
-				 in
-				    [Statement.PrimApp
-				     {args = (Vector.new2
-					      (canHandle,
-					       (Operand.word
-						(WordX.fromIntInf
-						 (IntInf.fromInt n,
-						  WordSize.default))))),
-				      dst = SOME (res, resTy),
-				      prim = Prim.wordAdd WordSize.default},
-				     Statement.Move
-				     {dst = canHandle,
-				      src = Var {ty = resTy, var = res}}]
-				 end
-			      fun ccall {args: Operand.t vector,
-					 func: CFunction.t} =
-				 let
-				    val formals =
-				       case dst () of
-					  NONE => Vector.new0 ()
-					| SOME (x, t) => Vector.new1 (x, t)
-				 in
-				    split
-				    (formals, Kind.CReturn {func = func}, ss,
-				     fn l =>
-				     ([],
-				      Transfer.CCall {args = args,
-						      func = func,
-						      return = SOME l}))
-				 end
-			      fun simpleCCall (f: CFunction.t) =
-				 ccall {args = vos args,
-					func = f}
-			      fun array (numElts: Operand.t) =
-				 let
-				    val result = valOf (toRtype ty)
-				    val pt =
-				       case Type.dePointer result of
-					  NONE => Error.bug "strange array"
-					| SOME pt => PointerTycon pt
-				    val args =
-				       Vector.new4 (GCState,
-						    EnsuresBytesFree,
-						    numElts,
-						    pt)
-				    val func =
-				       CFunction.gcArrayAllocate
-				       {return = result}
-				 in
-				    ccall {args = args, func = func}
-				 end
-		     fun pointerGet () =
-			maybeMove (fn ty =>
-				   ArrayOffset {base = a 0,
-						index = a 1,
-						offset = Bytes.zero,
-						scale = Type.scale ty,
-						ty = ty})
-		     fun pointerSet () =
-			let
-			   val src = a 2
-			   val ty = Operand.ty src
-			in
-			   add (Move {dst = ArrayOffset {base = a 0,
-							 index = a 1,
-							 offset = Bytes.zero,
-							 scale = Type.scale ty,
-							 ty = ty},
-				      src = a 2})
-			end
-		     fun codegenOrC (p: Prim.t) =
-			let
-			   val n = Prim.name p
-			in
-			   if codegenImplementsPrim p
-			      then primApp p
-			   else (case Name.cFunction n of
-				    NONE =>
-				       Error.bug (concat ["unimplemented prim:",
-							  Name.toString n])
-				  | SOME f => simpleCCall f)
-			end
-		     datatype z = datatype Prim.Name.t
-			   in
-			      case Prim.name prim of
-				 Array_array => array (a 0)
-			       | Array_length => arrayOrVectorLength ()
-			       | Array_toVector =>
-				    let
-				       val array = a 0
-				       val vecTy = valOf (toRtype ty)
-				       val pt =
-					  case Type.dePointer vecTy of
-					     NONE => Error.bug "strange Array_toVector"
-					   | SOME pt => pt
-				    in
-				       loop
-				       (i - 1,
-					Move
-					{dst = (Offset
-						{base = array,
-						 offset = Runtime.headerOffset,
-						 ty = Type.defaultWord}),
-					 src = PointerTycon pt}
-					:: Bind {dst = (valOf var, vecTy),
-						 isMutable = false,
-						 src = Operand.cast (array, vecTy)}
-					:: ss,
-					t)
-				    end
-			       | FFI f => simpleCCall f
-			       | GC_collect =>
-				    ccall
-				    {args = (Vector.new5
-					     (GCState,
-					      Operand.zero WordSize.default,
-					      Operand.bool true,
-					      File,
-					      Line)),
-				     func = (CFunction.gc
-					     {maySwitchThreads = handlesSignals})}
-			       | IntInf_toVector => cast ()
-			       | IntInf_toWord => cast ()
-			       | MLton_bogus =>
-				    (case toRtype ty of
-					NONE => none ()
-				      | SOME t => move (bogus t))
-			       | MLton_eq =>
-				    (case toRtype (varType (arg 0)) of
-					NONE => move (Operand.bool true)
-				      | SOME t =>
-					   codegenOrC
-					   (Prim.wordEqual
-					    (WordSize.fromBits (Type.width t))))
-			       | MLton_installSignalHandler => none ()
-			       | MLton_share =>
-				    (case toRtype (varType (arg 0)) of
-					NONE => none ()
-				      | SOME t =>
-					   if not (Type.isPointer t)
-					      then none ()
-					   else
-					      simpleCCall (CFunction.share
-							   (Operand.ty (a 0))))
-			       | MLton_size =>
-				    simpleCCall
-				    (CFunction.size (Operand.ty (a 0)))
-			       | MLton_touch => none ()
-			       | Pointer_getPointer => pointerGet ()
-			       | Pointer_getReal _ => pointerGet ()
-			       | Pointer_getWord _ => pointerGet ()
-			       | Pointer_setPointer => pointerSet ()
-			       | Pointer_setReal _ => pointerSet ()
-			       | Pointer_setWord _ => pointerSet ()
-			       | Thread_atomicBegin =>
-				    (* gcState.canHandle++;
-				     * if (gcState.signalIsPending)
-				     *   gcState.limit = gcState.limitPlusSlop - LIMIT_SLOP;
-				     *)
-				    split
-				    (Vector.new0 (), Kind.Jump, ss,
-				     fn continue =>
-				     let
-					datatype z = datatype GCField.t
-					val tmp = Var.newNoname ()
-					val size = WordSize.pointer ()
-					val ty = Type.cPointer ()
-					val statements =
-					   Vector.new2
-					   (Statement.PrimApp
-					    {args = (Vector.new2
-						     (Runtime LimitPlusSlop,
-						      Operand.word
-						      (WordX.fromIntInf
-						       (IntInf.fromInt
-							(Bytes.toInt Runtime.limitSlop),
-							size)))),
-					     dst = SOME (tmp, ty),
-					     prim = Prim.wordSub size},
-					    Statement.Move
-					    {dst = Runtime Limit,
-					     src = Var {ty = ty, var = tmp}})
-					val signalIsPending =
-					   newBlock
-					   {args = Vector.new0 (),
-					    kind = Kind.Jump,
-					    statements = statements,
-					    transfer = (Transfer.Goto
-							{args = Vector.new0 (),
-							 dst = continue})}
-				     in
-					(bumpCanHandle 1,
-					 if handlesSignals 
-					    then
-					       Transfer.ifBool
-					       (Runtime SignalIsPending,
-						{falsee = continue,
-						 truee = signalIsPending})
-					 else 
-					    Transfer.Goto {args = Vector.new0 (),
-							   dst = continue})
-				     end)
-			       | Thread_atomicEnd =>
-				    (* gcState.canHandle--;
-				     * if (gcState.signalIsPending
-				     *     and 0 == gcState.canHandle)
-				     *   gc;
-				     *)
-				    split
-				    (Vector.new0 (), Kind.Jump, ss,
-				     fn continue =>
-				     let
-					datatype z = datatype GCField.t
-					val func =
-					   CFunction.gc {maySwitchThreads = true}
-					val returnFromHandler = 
-					   newBlock
-					   {args = Vector.new0 (),
-					    kind = Kind.CReturn {func = func},
-					    statements = Vector.new0 (),
-					    transfer =
-					    Goto {args = Vector.new0 (),
-						  dst = continue}}
-					val args = 
-					   Vector.new5
-					   (GCState,
-					    Operand.zero WordSize.default,
-					    Operand.bool false,
-					    File,
-					    Line)
-					val switchToHandler =
-					   newBlock
-					   {args = Vector.new0 (),
-					    kind = Kind.Jump,
-					    statements = Vector.new0 (),
-					    transfer =
-					    Transfer.CCall
-					    {args = args,
-					     func = func,
-					     return = SOME returnFromHandler}}
-					val testCanHandle =
-					   newBlock
-					   {args = Vector.new0 (),
-					    kind = Kind.Jump,
-					    statements = Vector.new0 (),
-					    transfer =
-					    Transfer.ifZero
-					    (Runtime CanHandle,
-					     {falsee = continue,
-					      truee = switchToHandler})}
-				     in
-					(bumpCanHandle ~1,
-					 if handlesSignals 
-					    then 
-					       Transfer.ifBool
-					       (Runtime SignalIsPending,
-						{falsee = continue,
-						 truee = testCanHandle})
-					 else 
-					    Transfer.Goto {args = Vector.new0 (),
-							   dst = continue})
-				     end)
-			       | Thread_canHandle =>
-				    move (Runtime GCField.CanHandle)
-			       | Thread_copy =>
-				    ccall {args = (Vector.concat
-						   [Vector.new1 GCState,
-						    vos args]),
-					   func = CFunction.copyThread}
-			       | Thread_switchTo =>
-				    ccall {args = (Vector.new2
-						   (a 0, EnsuresBytesFree)),
-					   func = CFunction.threadSwitchTo}
-			       | Vector_length => arrayOrVectorLength ()
-			       | Weak_canGet =>
-				    ifIsWeakPointer
-				    (varType (arg 0),
-				     fn _ => simpleCCall (CFunction.weakCanGet
-							  (Operand.ty (a 0))),
-				     fn () => move (Operand.bool false))
-			       | Weak_get =>
-				    ifIsWeakPointer
-				    (varType (arg 0),
-				     fn t => (simpleCCall
-					      (CFunction.weakGet
-					       {arg = Operand.ty (a 0),
-						return = t})),
-				     none)
-			       | Weak_new =>
-				    ifIsWeakPointer
-				    (ty,
-				     fn t =>
-				     let
-					val result = valOf (toRtype ty)
-					val header =
-					   PointerTycon
-					   (case Type.dePointer result of
-					       NONE => Error.bug "Weak_new"
-					     | SOME pt => pt)
-					val func =
-					   CFunction.weakNew {arg = t,
-							      return = result}
-				     in
-					ccall {args = (Vector.concat
-						       [Vector.new2
-							(GCState, header),
-							vos args]),
-					       func = func}
-				     end,
-				     none)
-			       | Word_equal s =>
-				    codegenOrC (Prim.wordEqual
-					       (WordSize.roundUpToPrim s))
-			       | Word_toIntInf => cast ()
-			       | Word_toWord (s1, s2, {signed}) =>
-				    if WordSize.equals (s1, s2)
-				       then move (a 0)
-				    else
-				       let
-					  val signed =
-					     signed
-					     andalso Bits.< (WordSize.bits s1,
-							     WordSize.bits s2)
-					  val s1 = WordSize.roundUpToPrim s1
-					  val s2 = WordSize.roundUpToPrim s2
-				       in
-					  if WordSize.equals (s1, s2)
-					     then cast ()
-					  else
-					     codegenOrC
-					     (Prim.wordToWord
-					      (s1, s2, {signed = signed}))
-				       end
-			       | WordVector_toIntInf => move (a 0)
-			       | Word8Array_subWord => subWord ()
-			       | Word8Array_updateWord =>
-				    add (Move {dst = (ArrayOffset
-						      {base = a 0,
-						       index = a 1,
-						       offset = Bytes.zero,
-						       scale = Type.scale Type.defaultWord,
-						       ty = Type.defaultWord}),
-					       src = a 2})
-			       | Word8Vector_subWord => subWord ()
-			       | World_save =>
-				    ccall {args = (Vector.new2
-						   (GCState,
-						    Vector.sub (vos args, 0))),
-					   func = CFunction.worldSave}
-			       | _ => codegenOrC prim
-			   end
-		      | S.Exp.Select {base, offset} =>
-			   (case var of
-			       NONE => none ()
-			     | SOME var =>
-				  (case toRtype ty of
-				      NONE => none ()
-				    | SOME ty => 
-					 adds
-					 (select
-					  {base = Base.map (base, varOp),
-					   baseTy = varType (Base.object base),
-					   dst = (var, ty),
-					   offset = offset})))
-		      | S.Exp.Var y =>
-			   (case toRtype ty of
-			       NONE => none ()
-			     | SOME _ => move (varOp y))
-		  end
-		  end
-	 in
-	    loop (Vector.length statements - 1, ss, transfer)
-	 end
+         let
+            fun loop (i, ss, t): Statement.t vector * Transfer.t =
+               if i < 0
+                  then (Vector.fromList ss, t)
+               else
+                  let
+                     fun none () = loop (i - 1, ss, t)
+                     fun add s = loop (i - 1, s :: ss, t)
+                     fun adds ss' = loop (i - 1, ss' @ ss, t)
+                     val s = Vector.sub (statements, i)
+                  in
+                     case s of
+                        S.Statement.Profile e => add (Statement.Profile e)
+                      | S.Statement.Update {base, offset, value} =>
+                           (case toRtype (varType value) of
+                               NONE => none ()
+                             | SOME t => 
+                                  let
+                                     val baseOp = Base.map (base, varOp)
+                                     val ss =
+                                        update
+                                        {base = baseOp,
+                                         baseTy = varType (Base.object base),
+                                         offset = offset,
+                                         value = varOp value}
+                                     val ss =
+                                        if !Control.markCards
+                                           andalso Type.isPointer t
+                                           then
+                                              updateCard (Base.object baseOp)
+                                              @ ss
+                                        else ss
+                                  in
+                                     adds ss
+                                  end)
+                      | S.Statement.Bind {exp, ty, var} =>
+                  let
+                     fun split (args, kind,
+                                ss: Statement.t list,
+                                make: Label.t -> Statement.t list * Transfer.t) =
+                        let
+                           val l = newBlock {args = args,
+                                             kind = kind,
+                                             statements = Vector.fromList ss,
+                                             transfer = t}
+                           val (ss, t) = make l
+                        in
+                           loop (i - 1, ss, t)
+                        end
+                     fun maybeMove (f: Type.t -> Operand.t) =
+                        case toRtype ty of
+                           NONE => none ()
+                         | SOME ty =>
+                              add (Bind {dst = (valOf var, ty),
+                                         isMutable = false,
+                                         src = f ty})
+                     fun move (src: Operand.t) = maybeMove (fn _ => src)
+                  in
+                     case exp of
+                        S.Exp.Const c => move (Const (convertConst c))
+                      | S.Exp.Inject {variant, ...} =>
+                           if isSome (toRtype ty)
+                              then move (varOp variant)
+                           else none ()
+                      | S.Exp.Object {args, con} =>
+                           (case toRtype ty of
+                               NONE => none ()
+                             | SOME dstTy => 
+                                  adds (object {args = args,
+                                                con = con,
+                                                dst = (valOf var, dstTy),
+                                                objectTy = ty,
+                                                oper = varOp}))
+                      | S.Exp.PrimApp {args, prim} =>
+                           let
+                              val prim = translatePrim prim
+                              fun arg i = Vector.sub (args, i)
+                              fun a i = varOp (arg i)
+                              fun cast () =
+                                 move (Operand.cast (a 0, valOf (toRtype ty)))
+                              fun ifIsWeakPointer (ty: S.Type.t, yes, no) =
+                                 case S.Type.dest ty of
+                                    S.Type.Weak ty =>
+                                       (case toRtype ty of
+                                           NONE => no ()
+                                         | SOME t =>
+                                              if Type.isPointer t
+                                                 then yes t
+                                              else no ())
+                                  | _ => Error.bug "SsaToRssa.ifIsWeakPointer"
+                              fun arrayOrVectorLength () =
+                                 move (Offset
+                                       {base = a 0,
+                                        offset = Runtime.arrayLengthOffset,
+                                        ty = Type.defaultWord})
+                              fun subWord () =
+                                 move (ArrayOffset {base = a 0,
+                                                    index = a 1,
+                                                    offset = Bytes.zero,
+                                                    scale = Type.scale Type.defaultWord,
+                                                    ty = Type.defaultWord})
+                              fun dst () =
+                                 case var of
+                                    SOME x =>
+                                       Option.map (toRtype (varType x), fn t =>
+                                                   (x, t))
+                                  | NONE => NONE
+                              fun primApp prim =
+                                 add (PrimApp {dst = dst (),
+                                               prim = prim,
+                                               args = varOps args})
+                              datatype z = datatype Prim.Name.t
+                              fun bumpCanHandle n =
+                                 let
+                                    val canHandle = Runtime GCField.CanHandle
+                                    val res = Var.newNoname ()
+                                    val resTy = Operand.ty canHandle
+                                 in
+                                    [Statement.PrimApp
+                                     {args = (Vector.new2
+                                              (canHandle,
+                                               (Operand.word
+                                                (WordX.fromIntInf
+                                                 (IntInf.fromInt n,
+                                                  WordSize.default))))),
+                                      dst = SOME (res, resTy),
+                                      prim = Prim.wordAdd WordSize.default},
+                                     Statement.Move
+                                     {dst = canHandle,
+                                      src = Var {ty = resTy, var = res}}]
+                                 end
+                              fun ccall {args: Operand.t vector,
+                                         func: CFunction.t} =
+                                 let
+                                    val formals =
+                                       case dst () of
+                                          NONE => Vector.new0 ()
+                                        | SOME (x, t) => Vector.new1 (x, t)
+                                 in
+                                    split
+                                    (formals, Kind.CReturn {func = func}, ss,
+                                     fn l =>
+                                     ([],
+                                      Transfer.CCall {args = args,
+                                                      func = func,
+                                                      return = SOME l}))
+                                 end
+                              fun simpleCCall (f: CFunction.t) =
+                                 ccall {args = vos args,
+                                        func = f}
+                              fun array (numElts: Operand.t) =
+                                 let
+                                    val result = valOf (toRtype ty)
+                                    val pt =
+                                       case Type.dePointer result of
+                                          NONE => Error.bug "SsaToRssa.array"
+                                        | SOME pt => PointerTycon pt
+                                    val args =
+                                       Vector.new4 (GCState,
+                                                    EnsuresBytesFree,
+                                                    numElts,
+                                                    pt)
+                                    val func =
+                                       CFunction.gcArrayAllocate
+                                       {return = result}
+                                 in
+                                    ccall {args = args, func = func}
+                                 end
+                     fun pointerGet () =
+                        maybeMove (fn ty =>
+                                   ArrayOffset {base = a 0,
+                                                index = a 1,
+                                                offset = Bytes.zero,
+                                                scale = Type.scale ty,
+                                                ty = ty})
+                     fun pointerSet () =
+                        let
+                           val src = a 2
+                           val ty = Operand.ty src
+                        in
+                           add (Move {dst = ArrayOffset {base = a 0,
+                                                         index = a 1,
+                                                         offset = Bytes.zero,
+                                                         scale = Type.scale ty,
+                                                         ty = ty},
+                                      src = a 2})
+                        end
+                     fun codegenOrC (p: Prim.t) =
+                        let
+                           val n = Prim.name p
+                        in
+                           if codegenImplementsPrim p
+                              then primApp p
+                           else (case Name.cFunction n of
+                                    NONE =>
+                                       Error.bug (concat ["SsaToRssa.codegenOrC: ",
+                                                          "unimplemented prim:",
+                                                          Name.toString n])
+                                  | SOME f => simpleCCall f)
+                        end
+                     datatype z = datatype Prim.Name.t
+                           in
+                              case Prim.name prim of
+                                 Array_array => array (a 0)
+                               | Array_length => arrayOrVectorLength ()
+                               | Array_toVector =>
+                                    let
+                                       val array = a 0
+                                       val vecTy = valOf (toRtype ty)
+                                       val pt =
+                                          case Type.dePointer vecTy of
+                                             NONE => Error.bug "SsaToRssa.translateStatementsTransfer: PrimApp,Array_toVector"
+                                           | SOME pt => pt
+                                    in
+                                       loop
+                                       (i - 1,
+                                        Move
+                                        {dst = (Offset
+                                                {base = array,
+                                                 offset = Runtime.headerOffset,
+                                                 ty = Type.defaultWord}),
+                                         src = PointerTycon pt}
+                                        :: Bind {dst = (valOf var, vecTy),
+                                                 isMutable = false,
+                                                 src = Operand.cast (array, vecTy)}
+                                        :: ss,
+                                        t)
+                                    end
+                               | FFI f => simpleCCall f
+                               | GC_collect =>
+                                    ccall
+                                    {args = (Vector.new5
+                                             (GCState,
+                                              Operand.zero WordSize.default,
+                                              Operand.bool true,
+                                              File,
+                                              Line)),
+                                     func = (CFunction.gc
+                                             {maySwitchThreads = handlesSignals})}
+                               | IntInf_toVector => cast ()
+                               | IntInf_toWord => cast ()
+                               | MLton_bogus =>
+                                    (case toRtype ty of
+                                        NONE => none ()
+                                      | SOME t => move (bogus t))
+                               | MLton_eq =>
+                                    (case toRtype (varType (arg 0)) of
+                                        NONE => move (Operand.bool true)
+                                      | SOME t =>
+                                           codegenOrC
+                                           (Prim.wordEqual
+                                            (WordSize.fromBits (Type.width t))))
+                               | MLton_installSignalHandler => none ()
+                               | MLton_share =>
+                                    (case toRtype (varType (arg 0)) of
+                                        NONE => none ()
+                                      | SOME t =>
+                                           if not (Type.isPointer t)
+                                              then none ()
+                                           else
+                                              simpleCCall (CFunction.share
+                                                           (Operand.ty (a 0))))
+                               | MLton_size =>
+                                    simpleCCall
+                                    (CFunction.size (Operand.ty (a 0)))
+                               | MLton_touch =>
+                                    let
+                                       val a = arg 0
+                                       val args = 
+                                          if isSome (toRtype (varType a))
+                                             then Vector.new1 (varOp a)
+                                          else Vector.new0 ()
+                                    in
+                                       add (PrimApp {args = args,
+                                                     dst = NONE,
+                                                     prim = prim})
+                                    end
+                               | Pointer_getPointer => pointerGet ()
+                               | Pointer_getReal _ => pointerGet ()
+                               | Pointer_getWord _ => pointerGet ()
+                               | Pointer_setPointer => pointerSet ()
+                               | Pointer_setReal _ => pointerSet ()
+                               | Pointer_setWord _ => pointerSet ()
+                               | Thread_atomicBegin =>
+                                    (* gcState.canHandle++;
+                                     * if (gcState.signalIsPending)
+                                     *   gcState.limit = gcState.limitPlusSlop - LIMIT_SLOP;
+                                     *)
+                                    split
+                                    (Vector.new0 (), Kind.Jump, ss,
+                                     fn continue =>
+                                     let
+                                        datatype z = datatype GCField.t
+                                        val tmp = Var.newNoname ()
+                                        val size = WordSize.pointer ()
+                                        val ty = Type.cPointer ()
+                                        val statements =
+                                           Vector.new2
+                                           (Statement.PrimApp
+                                            {args = (Vector.new2
+                                                     (Runtime LimitPlusSlop,
+                                                      Operand.word
+                                                      (WordX.fromIntInf
+                                                       (IntInf.fromInt
+                                                        (Bytes.toInt Runtime.limitSlop),
+                                                        size)))),
+                                             dst = SOME (tmp, ty),
+                                             prim = Prim.wordSub size},
+                                            Statement.Move
+                                            {dst = Runtime Limit,
+                                             src = Var {ty = ty, var = tmp}})
+                                        val signalIsPending =
+                                           newBlock
+                                           {args = Vector.new0 (),
+                                            kind = Kind.Jump,
+                                            statements = statements,
+                                            transfer = (Transfer.Goto
+                                                        {args = Vector.new0 (),
+                                                         dst = continue})}
+                                     in
+                                        (bumpCanHandle 1,
+                                         if handlesSignals 
+                                            then
+                                               Transfer.ifBool
+                                               (Runtime SignalIsPending,
+                                                {falsee = continue,
+                                                 truee = signalIsPending})
+                                         else 
+                                            Transfer.Goto {args = Vector.new0 (),
+                                                           dst = continue})
+                                     end)
+                               | Thread_atomicEnd =>
+                                    (* gcState.canHandle--;
+                                     * if (gcState.signalIsPending
+                                     *     and 0 == gcState.canHandle)
+                                     *   gc;
+                                     *)
+                                    split
+                                    (Vector.new0 (), Kind.Jump, ss,
+                                     fn continue =>
+                                     let
+                                        datatype z = datatype GCField.t
+                                        val func =
+                                           CFunction.gc {maySwitchThreads = true}
+                                        val returnFromHandler = 
+                                           newBlock
+                                           {args = Vector.new0 (),
+                                            kind = Kind.CReturn {func = func},
+                                            statements = Vector.new0 (),
+                                            transfer =
+                                            Goto {args = Vector.new0 (),
+                                                  dst = continue}}
+                                        val args = 
+                                           Vector.new5
+                                           (GCState,
+                                            Operand.zero WordSize.default,
+                                            Operand.bool false,
+                                            File,
+                                            Line)
+                                        val switchToHandler =
+                                           newBlock
+                                           {args = Vector.new0 (),
+                                            kind = Kind.Jump,
+                                            statements = Vector.new0 (),
+                                            transfer =
+                                            Transfer.CCall
+                                            {args = args,
+                                             func = func,
+                                             return = SOME returnFromHandler}}
+                                        val testCanHandle =
+                                           newBlock
+                                           {args = Vector.new0 (),
+                                            kind = Kind.Jump,
+                                            statements = Vector.new0 (),
+                                            transfer =
+                                            Transfer.ifZero
+                                            (Runtime CanHandle,
+                                             {falsee = continue,
+                                              truee = switchToHandler})}
+                                     in
+                                        (bumpCanHandle ~1,
+                                         if handlesSignals 
+                                            then 
+                                               Transfer.ifBool
+                                               (Runtime SignalIsPending,
+                                                {falsee = continue,
+                                                 truee = testCanHandle})
+                                         else 
+                                            Transfer.Goto {args = Vector.new0 (),
+                                                           dst = continue})
+                                     end)
+                               | Thread_canHandle =>
+                                    move (Runtime GCField.CanHandle)
+                               | Thread_copy =>
+                                    ccall {args = (Vector.concat
+                                                   [Vector.new1 GCState,
+                                                    vos args]),
+                                           func = CFunction.copyThread}
+                               | Thread_switchTo =>
+                                    ccall {args = (Vector.new2
+                                                   (a 0, EnsuresBytesFree)),
+                                           func = CFunction.threadSwitchTo}
+                               | Vector_length => arrayOrVectorLength ()
+                               | Weak_canGet =>
+                                    ifIsWeakPointer
+                                    (varType (arg 0),
+                                     fn _ => simpleCCall (CFunction.weakCanGet
+                                                          (Operand.ty (a 0))),
+                                     fn () => move (Operand.bool false))
+                               | Weak_get =>
+                                    ifIsWeakPointer
+                                    (varType (arg 0),
+                                     fn t => (simpleCCall
+                                              (CFunction.weakGet
+                                               {arg = Operand.ty (a 0),
+                                                return = t})),
+                                     none)
+                               | Weak_new =>
+                                    ifIsWeakPointer
+                                    (ty,
+                                     fn t =>
+                                     let
+                                        val result = valOf (toRtype ty)
+                                        val header =
+                                           PointerTycon
+                                           (case Type.dePointer result of
+                                               NONE => Error.bug "SsaToRssa.translateStatementsTransfer: PrimApp,Weak_new"
+                                             | SOME pt => pt)
+                                        val func =
+                                           CFunction.weakNew {arg = t,
+                                                              return = result}
+                                     in
+                                        ccall {args = (Vector.concat
+                                                       [Vector.new2
+                                                        (GCState, header),
+                                                        vos args]),
+                                               func = func}
+                                     end,
+                                     none)
+                               | Word_equal s =>
+                                    codegenOrC (Prim.wordEqual
+                                               (WordSize.roundUpToPrim s))
+                               | Word_toIntInf => cast ()
+                               | Word_toWord (s1, s2, {signed}) =>
+                                    if WordSize.equals (s1, s2)
+                                       then move (a 0)
+                                    else
+                                       let
+                                          val signed =
+                                             signed
+                                             andalso Bits.< (WordSize.bits s1,
+                                                             WordSize.bits s2)
+                                          val s1 = WordSize.roundUpToPrim s1
+                                          val s2 = WordSize.roundUpToPrim s2
+                                       in
+                                          if WordSize.equals (s1, s2)
+                                             then cast ()
+                                          else
+                                             codegenOrC
+                                             (Prim.wordToWord
+                                              (s1, s2, {signed = signed}))
+                                       end
+                               | WordVector_toIntInf => move (a 0)
+                               | Word8Array_subWord => subWord ()
+                               | Word8Array_updateWord =>
+                                    add (Move {dst = (ArrayOffset
+                                                      {base = a 0,
+                                                       index = a 1,
+                                                       offset = Bytes.zero,
+                                                       scale = Type.scale Type.defaultWord,
+                                                       ty = Type.defaultWord}),
+                                               src = a 2})
+                               | Word8Vector_subWord => subWord ()
+                               | World_save =>
+                                    ccall {args = (Vector.new2
+                                                   (GCState,
+                                                    Vector.sub (vos args, 0))),
+                                           func = CFunction.worldSave}
+                               | _ => codegenOrC prim
+                           end
+                      | S.Exp.Select {base, offset} =>
+                           (case var of
+                               NONE => none ()
+                             | SOME var =>
+                                  (case toRtype ty of
+                                      NONE => none ()
+                                    | SOME ty => 
+                                         adds
+                                         (select
+                                          {base = Base.map (base, varOp),
+                                           baseTy = varType (Base.object base),
+                                           dst = (var, ty),
+                                           offset = offset})))
+                      | S.Exp.Var y =>
+                           (case toRtype ty of
+                               NONE => none ()
+                             | SOME _ => move (varOp y))
+                  end
+                  end
+         in
+            loop (Vector.length statements - 1, ss, transfer)
+         end
       fun translateBlock (S.Block.T {label, args, statements, transfer}) = 
-	 let
-	    val (ss, t) = translateTransfer transfer
-	    val (ss, t) = translateStatementsTransfer (statements, ss, t)
-	 in
-	    Block.T {args = translateFormals args,
-		     kind = Kind.Jump,
-		     label = label,
-		     statements = ss,
-		     transfer = t}
-	 end
+         let
+            val (ss, t) = translateTransfer transfer
+            val (ss, t) = translateStatementsTransfer (statements, ss, t)
+         in
+            Block.T {args = translateFormals args,
+                     kind = Kind.Jump,
+                     label = label,
+                     statements = ss,
+                     transfer = t}
+         end
       fun translateFunction (f: S.Function.t): Function.t =
-	 let
-	    val _ =
-	       S.Function.foreachVar (f, fn (x, t) => setVarInfo (x, {ty = t}))
-	    val {args, blocks, name, raises, returns, start, ...} =
-	       S.Function.dest f
-	    val _ =
-	       Vector.foreach
-	       (blocks, fn S.Block.T {label, args, ...} =>
-		setLabelInfo (label, {args = args,
-				      cont = ref [],
-				      handler = ref NONE}))
-	    val blocks = Vector.map (blocks, translateBlock)
-	    val blocks = Vector.concat [Vector.fromList (!extraBlocks), blocks]
-	    val _ = extraBlocks := []
-	    fun transTypes (ts : S.Type.t vector option)
-	       : Type.t vector option =
-	       Option.map (ts, fn ts => Vector.keepAllMap (ts, toRtype))
-	 in
-	    Function.new {args = translateFormals args,
-			  blocks = blocks,
-			  name = name,
-			  raises = transTypes raises,
-			  returns = transTypes returns,
-			  start = start}
-	 end
+         let
+            val _ =
+               S.Function.foreachVar (f, fn (x, t) => setVarInfo (x, {ty = t}))
+            val {args, blocks, name, raises, returns, start, ...} =
+               S.Function.dest f
+            val _ =
+               Vector.foreach
+               (blocks, fn S.Block.T {label, args, ...} =>
+                setLabelInfo (label, {args = args,
+                                      cont = ref [],
+                                      handler = ref NONE}))
+            val blocks = Vector.map (blocks, translateBlock)
+            val blocks = Vector.concat [Vector.fromList (!extraBlocks), blocks]
+            val _ = extraBlocks := []
+            fun transTypes (ts : S.Type.t vector option)
+               : Type.t vector option =
+               Option.map (ts, fn ts => Vector.keepAllMap (ts, toRtype))
+         in
+            Function.new {args = translateFormals args,
+                          blocks = blocks,
+                          name = name,
+                          raises = transTypes raises,
+                          returns = transTypes returns,
+                          start = start}
+         end
       val main =
-	  let
-	     val start = Label.newNoname ()
-	     val bug = Label.newNoname ()
-	  in
-	     translateFunction
-	     (S.Function.profile
-	      (S.Function.new
-	       {args = Vector.new0 (),
-		blocks = (Vector.new2
-			  (S.Block.T
-			   {label = start,
-			    args = Vector.new0 (),
-			    statements = globals,
-			    transfer = (S.Transfer.Call
-					{args = Vector.new0 (),
-					 func = main,
-					 return =
-					 S.Return.NonTail
-					 {cont = bug,
-					  handler = S.Handler.Dead}})},
-			   S.Block.T
-			   {label = bug,
-			    args = Vector.new0 (),
-			    statements = Vector.new0 (),
-			    transfer = S.Transfer.Bug})),
-		mayInline = false, (* doesn't matter *)
-		name = Func.newNoname (),
-		raises = NONE,
-		returns = NONE,
-		start = start},
-	       S.SourceInfo.main))
-	  end
+          let
+             val start = Label.newNoname ()
+             val bug = Label.newNoname ()
+          in
+             translateFunction
+             (S.Function.profile
+              (S.Function.new
+               {args = Vector.new0 (),
+                blocks = (Vector.new2
+                          (S.Block.T
+                           {label = start,
+                            args = Vector.new0 (),
+                            statements = globals,
+                            transfer = (S.Transfer.Call
+                                        {args = Vector.new0 (),
+                                         func = main,
+                                         return =
+                                         S.Return.NonTail
+                                         {cont = bug,
+                                          handler = S.Handler.Dead}})},
+                           S.Block.T
+                           {label = bug,
+                            args = Vector.new0 (),
+                            statements = Vector.new0 (),
+                            transfer = S.Transfer.Bug})),
+                mayInline = false, (* doesn't matter *)
+                name = Func.newNoname (),
+                raises = NONE,
+                returns = NONE,
+                start = start},
+               S.SourceInfo.main))
+          end
       val functions = List.revMap (functions, translateFunction)
       val p = Program.T {functions = functions,
-			 handlesSignals = handlesSignals,
-			 main = main,
-			 objectTypes = objectTypes}
+                         handlesSignals = handlesSignals,
+                         main = main,
+                         objectTypes = objectTypes}
       val _ = Program.clear p
    in
       p

Modified: mlton/branches/on-20050420-cmm-branch/mlton/backend/ssa-to-rssa.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/backend/ssa-to-rssa.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/backend/ssa-to-rssa.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
    
 signature SSA_TO_RSSA_STRUCTS =
    sig
@@ -23,9 +24,9 @@
 signature SSA_TO_RSSA =
    sig
       include SSA_TO_RSSA_STRUCTS
-	 
+         
       val convert:
-	 Ssa.Program.t
-	 * {codegenImplementsPrim: Rssa.Type.t Rssa.Prim.t -> bool}
-	 -> Rssa.Program.t
+         Ssa.Program.t
+         * {codegenImplementsPrim: Rssa.Type.t Rssa.Prim.t -> bool}
+         -> Rssa.Program.t
    end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/backend/switch.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/backend/switch.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/backend/switch.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,8 +1,8 @@
-(* Copyright (C) 2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 2002-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 functor Switch (S: SWITCH_STRUCTS): SWITCH =
@@ -11,41 +11,41 @@
 open S
    
 fun isRedundant {cases: 'a vector,
-		 equals: 'a * 'a -> bool}: bool =
+                 equals: 'a * 'a -> bool}: bool =
    let
       val nCases = Vector.length cases
    in
       0 < nCases
       andalso let
-		 fun loop (i: int, prev: 'a): bool =
-		    i < nCases
-		    andalso let
-			       val cur = Vector.sub (cases, i)
-			    in
-			       equals (cur, prev)
-			       orelse loop (i + 1, cur)
-			    end
-	      in
-		 loop (1, Vector.sub (cases, 0))
-	      end
+                 fun loop (i: int, prev: 'a): bool =
+                    i < nCases
+                    andalso let
+                               val cur = Vector.sub (cases, i)
+                            in
+                               equals (cur, prev)
+                               orelse loop (i + 1, cur)
+                            end
+              in
+                 loop (1, Vector.sub (cases, 0))
+              end
    end
 
 datatype t =
    T of {cases: (WordX.t * Label.t) vector,
-	 default: Label.t option,
-	 size: WordSize.t,
-	 test: Use.t}
+         default: Label.t option,
+         size: WordSize.t,
+         test: Use.t}
 
 fun layout (T {cases, default, test, ...})= 
    let
       open Layout
    in
       seq [str "switch ",
-	   record [("test", Use.layout test),
-		   ("default", Option.layout Label.layout default),
-		   ("cases",
-		    Vector.layout (Layout.tuple2 (WordX.layout, Label.layout))
-		    cases)]]
+           record [("test", Use.layout test),
+                   ("default", Option.layout Label.layout default),
+                   ("cases",
+                    Vector.layout (Layout.tuple2 (WordX.layout, Label.layout))
+                    cases)]]
    end
 
 fun isOk (T {cases, default, size = _, test}, {checkUse, labelIsOk}): bool =
@@ -55,25 +55,25 @@
    in
       Vector.forall (cases, labelIsOk o #2)
       andalso (case default of
-		  NONE => true
-		| SOME l => labelIsOk l)
+                  NONE => true
+                | SOME l => labelIsOk l)
       andalso Vector.isSorted (cases, fn ((w, _), (w', _)) =>
-			       WordX.le (w, w', {signed = false}))
+                               WordX.le (w, w', {signed = false}))
       andalso not (isRedundant
-		   {cases = cases,
-		    equals = fn ((w, _), (w', _)) => WordX.equals (w, w')})
+                   {cases = cases,
+                    equals = fn ((w, _), (w', _)) => WordX.equals (w, w')})
       andalso
       if 0 = Vector.length cases
-	 then isSome default
+         then isSome default
       else
-	 let
-	    val casesTy =
-	       Type.sum (Vector.map (cases, fn (w, _) => Type.constant w))
-	 in
-	    Bits.equals (Type.width ty, Type.width casesTy)
-	    andalso not (Type.isPointer ty)
-	    andalso (isSome default orelse Type.isSubtype (ty, casesTy))
-	 end
+         let
+            val casesTy =
+               Type.sum (Vector.map (cases, fn (w, _) => Type.constant w))
+         in
+            Bits.equals (Type.width ty, Type.width casesTy)
+            andalso not (Type.isPointer ty)
+            andalso (isSome default orelse Type.isSubtype (ty, casesTy))
+         end
    end
 
 fun foldLabelUse (T {cases, default, test, ...}, a: 'a, {label, use}): 'a =
@@ -81,13 +81,13 @@
       val a = use (test, a)
       val a = Option.fold (default, a, label)
       val a = Vector.fold (cases, a, fn ((_, l), a) =>
-			   label (l, a))
+                           label (l, a))
    in
       a
    end
 
 fun foreachLabel (s, f) =
    foldLabelUse (s, (), {label = f o #1,
-			 use = fn _ => ()})
+                         use = fn _ => ()})
 
 end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/backend/switch.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/backend/switch.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/backend/switch.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 2002-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 2002-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 type int = Int.t
    
 signature SWITCH_STRUCTS =
@@ -15,11 +16,11 @@
       sharing WordX = Type.WordX
 
       structure Use: sig
-			type t
+                        type t
 
-			val layout: t -> Layout.t
-			val ty: t -> Type.t
-		     end
+                        val layout: t -> Layout.t
+                        val ty: t -> Type.t
+                     end
    end
 
 signature SWITCH =
@@ -27,17 +28,17 @@
       include SWITCH_STRUCTS
 
       datatype t =
-	 T of {(* Cases are in increasing order of word. *)
-	       cases: (WordX.t * Label.t) vector,
-	       default: Label.t option,
-	       size: WordSize.t,
-	       test: Use.t}
+         T of {(* Cases are in increasing order of word. *)
+               cases: (WordX.t * Label.t) vector,
+               default: Label.t option,
+               size: WordSize.t,
+               test: Use.t}
 
       val foldLabelUse: t * 'a * {label: Label.t * 'a -> 'a,
-				  use: Use.t * 'a -> 'a} -> 'a
+                                  use: Use.t * 'a -> 'a} -> 'a
       val foreachLabel: t * (Label.t -> unit) -> unit
       val isOk: t * {checkUse: Use.t -> unit,
-		     labelIsOk: Label.t -> bool} -> bool
+                     labelIsOk: Label.t -> bool} -> bool
       val layout: t -> Layout.t
    end
 

Modified: mlton/branches/on-20050420-cmm-branch/mlton/call-main.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/call-main.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/call-main.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,9 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 val _ = Main.exportMLton ()

Modified: mlton/branches/on-20050420-cmm-branch/mlton/closure-convert/abstract-value.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/closure-convert/abstract-value.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/closure-convert/abstract-value.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 functor AbstractValue (S: ABSTRACT_VALUE_STRUCTS): ABSTRACT_VALUE = 
 struct
 
@@ -16,30 +17,30 @@
 structure Lambda =
    struct
       datatype t = Lambda of {lambda: Sxml.Lambda.t,
-			      hash: Word.t}
-	 
+                              hash: Word.t}
+         
       val newHash = Random.word
 
       fun new lambda = Lambda {lambda = lambda,
-			       hash = newHash ()}
+                               hash = newHash ()}
 
       fun hash (Lambda {hash, ...}) = hash
-	 
+         
       fun dest (Lambda {lambda, ...}) = lambda
 
       fun equals (Lambda r, Lambda r') =
-	 #hash r = #hash r'
-	 andalso Sxml.Lambda.equals (#lambda r, #lambda r')
+         #hash r = #hash r'
+         andalso Sxml.Lambda.equals (#lambda r, #lambda r')
 
       fun layout (Lambda {lambda, ...}) =
-	 let open Layout
-	 in seq [str "lambda ", Sxml.Var.layout (Sxml.Lambda.arg lambda)]
-	 end
+         let open Layout
+         in seq [str "lambda ", Sxml.Var.layout (Sxml.Lambda.arg lambda)]
+         end
    end
 
 structure Lambdas = UniqueSet (structure Element = Lambda
-			       val cacheSize: int = 5
-			       val bits: int = 13)
+                               val cacheSize: int = 5
+                               val bits: int = 13)
 
 structure LambdaNode:
    sig
@@ -55,97 +56,102 @@
    end =
    struct
       datatype t = LambdaNode of {me: Lambdas.t ref,
-				  handlers: (Lambda.t -> unit) list ref,
-				  coercedTo: t list ref} Dset.t
+                                  handlers: (Lambda.t -> unit) list ref,
+                                  coercedTo: t list ref} Dset.t
 
       fun toSet (LambdaNode d) = !(#me (Dset.! d))
 
       val layout = Lambdas.layout o toSet
 
       fun newSet s = LambdaNode (Dset.singleton {me = ref s,
-						 handlers = ref [],
-						 coercedTo = ref []})
+                                                 handlers = ref [],
+                                                 coercedTo = ref []})
 
       fun new () = newSet Lambdas.empty
 
       fun lambda l = newSet (Lambdas.singleton (Lambda.new l))
 
       fun handles (h: Lambda.t -> unit, s: Lambdas.t): unit =
-	 Lambdas.foreach (s, fn l => h l)
-	 
+         Lambdas.foreach (s, fn l => h l)
+         
       fun handless (hs: (Lambda.t -> unit) list, s: Lambdas.t): unit =
-	 List.foreach (hs, fn h => handles (h, s))
+         List.foreach (hs, fn h => handles (h, s))
 
       fun addHandler (LambdaNode d, h: Lambda.t -> unit) =
-	 let val {me, handlers, ...} = Dset.! d
-	 in List.push (handlers, h)
-	    ; handles (h, !me)
-	 end
+         let val {me, handlers, ...} = Dset.! d
+         in List.push (handlers, h)
+            ; handles (h, !me)
+         end
 
       fun send (LambdaNode d, s): unit =
-	 let val {me, coercedTo, handlers, ...} = Dset.! d
-	    val diff = Lambdas.- (s, !me)
-	 in if Lambdas.isEmpty diff
-	       then ()
-	    else (me := Lambdas.+ (diff, !me)
-		  ; List.foreach (!coercedTo, fn to => send (to, diff))
-		  ; handless (!handlers, diff))
-	 end
+         let val {me, coercedTo, handlers, ...} = Dset.! d
+            val diff = Lambdas.- (s, !me)
+         in if Lambdas.isEmpty diff
+               then ()
+            else (me := Lambdas.+ (diff, !me)
+                  ; List.foreach (!coercedTo, fn to => send (to, diff))
+                  ; handless (!handlers, diff))
+         end
 
       val send =
-	 Trace.trace2 ("LambdaNode.send", layout, Lambdas.layout, Unit.layout)
-	 send
+         Trace.trace2 
+         ("AbstractValue.LambdaNode.send", 
+          layout, Lambdas.layout, Unit.layout)
+         send
 
       fun equals (LambdaNode d, LambdaNode d') = Dset.equals (d, d')
 
       fun coerce {from = from as LambdaNode d, to: t}: unit =
-	 if equals (from, to)
-	    then ()
-	 else let
-		 val {me, coercedTo, ...} = Dset.! d
-	      in
-		 if List.exists (!coercedTo, fn ls => equals (ls, to))
-		    then ()
-		 else (List.push (coercedTo, to)
-		       ; send (to, !me))
-	      end
-	   		      
+         if equals (from, to)
+            then ()
+         else let
+                 val {me, coercedTo, ...} = Dset.! d
+              in
+                 if List.exists (!coercedTo, fn ls => equals (ls, to))
+                    then ()
+                 else (List.push (coercedTo, to)
+                       ; send (to, !me))
+              end
+                              
       fun update (c, h, diff) =
-	 if Lambdas.isEmpty diff
-	    then ()
-	 else (List.foreach (c, fn to => send (to, diff))
-	       ; handless (h, diff))
+         if Lambdas.isEmpty diff
+            then ()
+         else (List.foreach (c, fn to => send (to, diff))
+               ; handless (h, diff))
 
       fun unify (LambdaNode d, LambdaNode d'): unit =
-	 if Dset.equals (d, d')
-	    then ()
-	 else
-	    let
-	       val {me = ref m, coercedTo = ref c, handlers = ref h, ...} =
-		  Dset.! d
-	       val {me = ref m', coercedTo = ref c', handlers = ref h', ...} =
-		  Dset.! d'
-	       val diff = Lambdas.- (m, m')
-	       val diff' = Lambdas.- (m', m)
-	    in Dset.union (d, d')
-	       ; (Dset.:=
-		  (d, {me = ref (if Lambdas.isEmpty diff
-				   then m'
-				else Lambdas.+ (m', diff)),
-		       coercedTo = ref (List.fold
-					(c', c, fn (n', ac) =>
-					 if List.exists (c, fn n =>
-							 equals (n, n'))
-					    then ac
-					 else n' :: ac)),
-		       handlers = ref (List.appendRev (h, h'))}))
-	       ; update (c, h, diff')
-	       ; update (c', h', diff)
-	    end
+         if Dset.equals (d, d')
+            then ()
+         else
+            let
+               val {me = ref m, coercedTo = ref c, handlers = ref h, ...} =
+                  Dset.! d
+               val {me = ref m', coercedTo = ref c', handlers = ref h', ...} =
+                  Dset.! d'
+               val diff = Lambdas.- (m, m')
+               val diff' = Lambdas.- (m', m)
+            in Dset.union (d, d')
+               ; (Dset.:=
+                  (d, {me = ref (if Lambdas.isEmpty diff
+                                   then m'
+                                else Lambdas.+ (m', diff)),
+                       coercedTo = ref (List.fold
+                                        (c', c, fn (n', ac) =>
+                                         if List.exists (c, fn n =>
+                                                         equals (n, n'))
+                                            then ac
+                                         else n' :: ac)),
+                       handlers = ref (List.appendRev (h, h'))}))
+               ; update (c, h, diff')
+               ; update (c', h', diff)
+            end
 
-(*       val unify =
- * 	 Trace.trace2 ("LambdaNode.unify", layout, layout, Unit.layout) unify
- *)
+(*
+      val unify =
+         Trace.trace2 
+         ("AbstractValue.LambdaNode.unify", layout, layout, Unit.layout) 
+         unify
+*)       
    end
 
 structure UnaryTycon =
@@ -153,11 +159,11 @@
       datatype t = Array | Ref | Vector | Weak
    
       val toString =
-	 fn Array => "Array"
-	  | Ref => "Ref"
-	  | Vector => "Vector"
-	  | Weak => "Weak"
-	 
+         fn Array => "Array"
+          | Ref => "Ref"
+          | Vector => "Vector"
+          | Weak => "Weak"
+         
       val equals: t * t -> bool = op =
    
       val layout = Layout.str o toString
@@ -170,13 +176,13 @@
  | Unify of UnaryTycon.t * t
 
 withtype t = {tree: tree,
-	      ty: Type.t,
-	      ssaType: Ssa.Type.t option ref} Dset.t
+              ty: Type.t,
+              ssaType: Ssa.Type.t option ref} Dset.t
 
 fun new (tree: tree, ty: Type.t): t =
    Dset.singleton {ssaType = ref NONE,
-		   tree = tree,
-		   ty = ty}
+                   tree = tree,
+                   ty = ty}
 
 local
    fun make sel : t -> 'a = sel o Dset.!
@@ -208,20 +214,20 @@
    orelse
    (case (tree v,      tree v') of
        (Type t,        Type t')   =>
-	  if Type.equals (t, t')
-	     then true
-	  else Error.bug "Value.equals called on different types"
+          if Type.equals (t, t')
+             then true
+          else Error.bug "AbstractValue.equals: different types"
      | (Unify (t, v), Unify (t', v'))     =>
-	  UnaryTycon.equals (t, t') andalso equals (v, v')
+          UnaryTycon.equals (t, t') andalso equals (v, v')
      | (Tuple vs,  Tuple vs')  => Vector.forall2 (vs, vs', equals)
      | (Lambdas n, Lambdas n') => Lambdas.equals (LambdaNode.toSet n,
-						 LambdaNode.toSet n')
-     | _ => Error.bug "Value.equals called on different kinds of values")
+                                                 LambdaNode.toSet n')
+     | _ => Error.bug "AbstractValue.equals: different values")
 
 fun addHandler (v, h) =
    case tree v of
       Lambdas n => LambdaNode.addHandler (n, h)
-    | _ => Error.bug "can't addHandler to non lambda"
+    | _ => Error.bug "AbstractValue.addHandler: non-lambda"
 
 local
    val {hom, destroy} =
@@ -229,34 +235,36 @@
       {con = fn (t, tycon, vs) =>
        let val new = fn tree => new (tree, t)
        in if Tycon.equals (tycon, Tycon.arrow)
-	     then {isFirstOrder = false,
-		   make = fn () => new (Lambdas (LambdaNode.new ()))}
-	  else
-	     if Vector.forall (vs, #isFirstOrder)
-		then {isFirstOrder = true,
-		      make = let val v = new (Type t)
-			     in fn () => v
-			     end}
-	     else
-		{isFirstOrder = false,
-		 make = let
-			   fun mutable mt =
-			      let val make = #make (Vector.sub (vs, 0))
-			      in fn () => new (Unify (mt, make ()))
-			      end
-			in if Tycon.equals (tycon, Tycon.reff)
-			      then mutable UnaryTycon.Ref
-			   else if Tycon.equals (tycon, Tycon.array)
-				   then mutable UnaryTycon.Array
-			   else if Tycon.equals (tycon, Tycon.vector)
-				   then mutable UnaryTycon.Vector
-			   else if Tycon.equals (tycon, Tycon.tuple)
-				   then (fn () =>
-					 new (Tuple
-					      (Vector.map (vs, fn {make, ...} =>
-							   make ()))))
-				else Error.bug "fromType saw non-arrow type"
-			end}
+             then {isFirstOrder = false,
+                   make = fn () => new (Lambdas (LambdaNode.new ()))}
+          else
+             if Vector.forall (vs, #isFirstOrder)
+                then {isFirstOrder = true,
+                      make = let val v = new (Type t)
+                             in fn () => v
+                             end}
+             else
+                {isFirstOrder = false,
+                 make = let
+                           fun mutable mt =
+                              let val make = #make (Vector.sub (vs, 0))
+                              in fn () => new (Unify (mt, make ()))
+                              end
+                        in if Tycon.equals (tycon, Tycon.reff)
+                              then mutable UnaryTycon.Ref
+                           else if Tycon.equals (tycon, Tycon.array)
+                                   then mutable UnaryTycon.Array
+                           else if Tycon.equals (tycon, Tycon.vector)
+                                   then mutable UnaryTycon.Vector
+                           else if Tycon.equals (tycon, Tycon.weak)
+                                   then mutable UnaryTycon.Weak
+                           else if Tycon.equals (tycon, Tycon.tuple)
+                                   then (fn () =>
+                                         new (Tuple
+                                              (Vector.map (vs, fn {make, ...} =>
+                                                           make ()))))
+                           else Error.bug "AbstractValue.fromType: non-arrow"
+                        end}
        end}
 in
    val destroy = destroy
@@ -264,36 +272,36 @@
    fun fromType t = #make (hom t) ()
 end
 
-val fromType = Trace.trace ("Value.fromType", Type.layout, layout) fromType
+val fromType = Trace.trace ("AbstractValue.fromType", Type.layout, layout) fromType
 
 fun tuple (vs: t vector): t = new (Tuple vs,
-				   Type.tuple (Vector.map (vs, ty)))
+                                   Type.tuple (Vector.map (vs, ty)))
 
 fun select (v, i) =
    case tree v of
       Type t => fromType (Vector.sub (Type.deTuple t, i))
     | Tuple vs => Vector.sub (vs, i)
-    | _ => Error.bug "Value.select expected tuple"
+    | _ => Error.bug "AbstractValue.select: expected tuple"
 
 fun deRef v =
    case tree v of
       Type t => fromType (Type.deRef t)
     | Unify (_, v) => v
-    | _ => Error.bug "Value.deRef"
+    | _ => Error.bug "AbstractValue.deRef"
 
-val deRef = Trace.trace ("Value.deRef", layout, layout) deRef
+val deRef = Trace.trace ("AbstractValue.deRef", layout, layout) deRef
 
 fun deWeak v =
    case tree v of
       Type t => fromType (Type.deWeak t)
     | Unify (_, v) => v
-    | _ => Error.bug "Value.deWeak"
+    | _ => Error.bug "AbstractValue.deWeak"
 
 fun deArray v =
    case tree v of
       Type t => fromType (Type.deArray t)
     | Unify (_, v) => v
-    | _ => Error.bug "Value.deArray"
+    | _ => Error.bug "AbstractValue.deArray"
 
 fun lambda (l: Sxml.Lambda.t, t: Type.t): t =
    new (Lambdas (LambdaNode.lambda l), t)       
@@ -302,49 +310,49 @@
    if Dset.equals (v, v')
       then ()
    else let val t = tree v
-	    val t' = tree v'
-	in Dset.union (v, v')
-	   ; (case (t, t') of
-		 (Type t, Type t') => if Type.equals (t, t')
-					 then ()
-				      else Error.bug "unify"
-	       | (Unify (_, v), Unify (_, v')) => unify (v, v')
-	       | (Tuple vs, Tuple vs') => Vector.foreach2 (vs, vs', unify)
-	       | (Lambdas l, Lambdas l') => LambdaNode.unify (l, l')
-	       | _ => Error.bug "impossible unify")
-	end
+            val t' = tree v'
+        in Dset.union (v, v')
+           ; (case (t, t') of
+                 (Type t, Type t') => if Type.equals (t, t')
+                                         then ()
+                                      else Error.bug "AbstractValue.unify: different types"
+               | (Unify (_, v), Unify (_, v')) => unify (v, v')
+               | (Tuple vs, Tuple vs') => Vector.foreach2 (vs, vs', unify)
+               | (Lambdas l, Lambdas l') => LambdaNode.unify (l, l')
+               | _ => Error.bug "AbstractValue.unify: different values")
+        end
 
-val unify = Trace.trace2 ("Value.unify", layout, layout, Unit.layout) unify
+val unify = Trace.trace2 ("AbstractValue.unify", layout, layout, Unit.layout) unify
 
 fun coerce {from: t, to: t}: unit =
    if Dset.equals (from, to)
       then ()
    else (case (tree from, tree to) of
-	    (Type t,    Type t')    => if Type.equals (t, t')
-					  then ()
-				       else Error.bug "coerce"
-	  | (Unify _, Unify _) =>
-	       (* Can't do a coercion for vectors, since that would imply
-		* walking over the entire vector and coercing each element
-		*)
-	       unify (from, to)
-	  | (Tuple vs,  Tuple vs')  =>
-	       Vector.foreach2 (vs, vs', fn (v, v') =>
-				coerce {from = v, to = v'})
-	  | (Lambdas l, Lambdas l') => LambdaNode.coerce {from = l, to = l'}
-	  | _ => Error.bug "impossible coerce")
+            (Type t,    Type t')    => if Type.equals (t, t')
+                                          then ()
+                                       else Error.bug "coerce"
+          | (Unify _, Unify _) =>
+               (* Can't do a coercion for vectors, since that would imply
+                * walking over the entire vector and coercing each element
+                *)
+               unify (from, to)
+          | (Tuple vs,  Tuple vs')  =>
+               Vector.foreach2 (vs, vs', fn (v, v') =>
+                                coerce {from = v, to = v'})
+          | (Lambdas l, Lambdas l') => LambdaNode.coerce {from = l, to = l'}
+          | _ => Error.bug "AbstractValue.coerce: different values")
 
-val coerce = Trace.trace ("Value.coerce",
-			  fn {from, to} =>
-			  let open Layout
-			  in record [("from", layout from),
-				     ("to" , layout to)]
-			  end, Unit.layout) coerce
+val coerce = Trace.trace ("AbstractValue.coerce",
+                          fn {from, to} =>
+                          let open Layout
+                          in record [("from", layout from),
+                                     ("to" , layout to)]
+                          end, Unit.layout) coerce
 
 structure Dest =
    struct
       datatype dest =
-	 Array of t
+         Array of t
        | Lambdas of Lambdas.t
        | Ref of t
        | Tuple of t vector
@@ -357,10 +365,10 @@
    case tree v of
       Type t => Dest.Type t
     | Unify (mt, v) => (case mt of
-			   UnaryTycon.Array => Dest.Array v
-			 | UnaryTycon.Ref => Dest.Ref v
-			 | UnaryTycon.Vector => Dest.Vector v
-			 | UnaryTycon.Weak => Dest.Weak v)
+                           UnaryTycon.Array => Dest.Array v
+                         | UnaryTycon.Ref => Dest.Ref v
+                         | UnaryTycon.Vector => Dest.Vector v
+                         | UnaryTycon.Weak => Dest.Weak v)
     | Tuple vs => Dest.Tuple vs
     | Lambdas l => Dest.Lambdas (LambdaNode.toSet l)
 
@@ -377,105 +385,105 @@
    let 
       fun result () = fromType resultTy
       fun typeError () =
-	 (Control.message
-	  (Control.Silent, fn () =>
-	   let open Layout
-	   in align [seq [str "prim: ", Prim.layout prim],
-		     seq [str "args: ", Vector.layout layout args]]
-	   end)
-	  ; Error.bug "Value.primApply: type error")
+         (Control.message
+          (Control.Silent, fn () =>
+           let open Layout
+           in align [seq [str "prim: ", Prim.layout prim],
+                     seq [str "args: ", Vector.layout layout args]]
+           end)
+          ; Error.bug "AbstractValue.primApply: type error")
       fun arg i = Vector.sub (args, i)
       val n = Vector.length args
       fun oneArg () =
-	 if n = 1
-	    then arg 0
-	 else Error.bug "wrong number of args for primitive"
+         if n = 1
+            then arg 0
+         else Error.bug "AbstractValue.primApply.oneArg"
       fun twoArgs () =
-	 if n = 2
-	    then (arg 0, arg 1)
-	 else Error.bug "wrong number of args for primitive"
+         if n = 2
+            then (arg 0, arg 1)
+         else Error.bug "AbstractValue.primApply.twoArgs"
       fun threeArgs () =
-	 if n = 3
-	    then (arg 0, arg 1, arg 2)
-	 else Error.bug "wrong number of args for primitive"
+         if n = 3
+            then (arg 0, arg 1, arg 2)
+         else Error.bug "AbstractValue.primApply.threeArgs"
       datatype z = datatype Prim.Name.t
    in
       case Prim.name prim of
-	 Array_sub =>
-	    (case dest (#1 (twoArgs ())) of
-		Array x => x
-	      | Type _ => result ()
-	      | _ => typeError ())
+         Array_sub =>
+            (case dest (#1 (twoArgs ())) of
+                Array x => x
+              | Type _ => result ()
+              | _ => typeError ())
        | Array_update =>
-	    let val (a, _, x) = threeArgs ()
-	    in (case dest a of
-		   Array x' => coerce {from = x, to = x'} (* unify (x, x') *)
-		 | Type _ => ()
-		 | _ => typeError ())
-	       ; result ()
-	    end
+            let val (a, _, x) = threeArgs ()
+            in (case dest a of
+                   Array x' => coerce {from = x, to = x'} (* unify (x, x') *)
+                 | Type _ => ()
+                 | _ => typeError ())
+               ; result ()
+            end
        | MLton_deserialize => serialValue resultTy
        | MLton_serialize =>
-	    let val arg = oneArg ()
-	    in coerce {from = arg, to = serialValue (ty arg)}
-	       ; result ()
-	    end
+            let val arg = oneArg ()
+            in coerce {from = arg, to = serialValue (ty arg)}
+               ; result ()
+            end
        | Ref_assign =>
-	    let val (r, x) = twoArgs ()
-	    in (case dest r of
-		   Ref x' => coerce {from = x, to = x'} (* unify (x, x') *)
-		 | Type _ => ()
-		 | _ => typeError ())
-	       ; result ()
-	    end
+            let val (r, x) = twoArgs ()
+            in (case dest r of
+                   Ref x' => coerce {from = x, to = x'} (* unify (x, x') *)
+                 | Type _ => ()
+                 | _ => typeError ())
+               ; result ()
+            end
        | Ref_deref => (case dest (oneArg ()) of
-			  Ref v => v
-			| Type _ => result ()
-			| _ => typeError ())
+                          Ref v => v
+                        | Type _ => result ()
+                        | _ => typeError ())
        | Ref_ref =>
-	    let
-	       val r = result ()
-	       val _ = 
-		  case dest r of
-		     Ref x => coerce {from = oneArg (), to = x} (* unify (oneArg (), x) *)
-		   | Type _ => ()
-		   | _ => typeError ()
-	    in
-	       r
-	    end
+            let
+               val r = result ()
+               val _ = 
+                  case dest r of
+                     Ref x => coerce {from = oneArg (), to = x} (* unify (oneArg (), x) *)
+                   | Type _ => ()
+                   | _ => typeError ()
+            in
+               r
+            end
        | Array_toVector =>
-	    let val r = result ()
-	    in (case (dest (oneArg ()), dest r) of
-		   (Type _, Type _) => ()
-		 | (Array x, Vector y) =>
-		      (* Can't do a coercion here because that would imply
-		       * walking over each element of the array and coercing it.
-		       *)
-		      unify (x, y)
-		 | _ => typeError ())
-	       ; r
-	    end
+            let val r = result ()
+            in (case (dest (oneArg ()), dest r) of
+                   (Type _, Type _) => ()
+                 | (Array x, Vector y) =>
+                      (* Can't do a coercion here because that would imply
+                       * walking over each element of the array and coercing it.
+                       *)
+                      unify (x, y)
+                 | _ => typeError ())
+               ; r
+            end
        | Vector_sub =>
-	    (case dest (#1 (twoArgs ())) of
-		Vector x => x
-	      | Type _ => result ()
-	      | _ => typeError ())
+            (case dest (#1 (twoArgs ())) of
+                Vector x => x
+              | Type _ => result ()
+              | _ => typeError ())
        | Weak_get =>
-	    (case dest (oneArg ()) of
-		Weak v => v
-	      | Type _ => result ()
-	      | _ => typeError ())
+            (case dest (oneArg ()) of
+                Weak v => v
+              | Type _ => result ()
+              | _ => typeError ())
        | Weak_new =>
-	    let
-	       val r = result ()
-	       val _ =
-		  case dest r of
-		     Ref x => coerce {from = oneArg (), to = x}
-		   | Type _ => ()
-		   | _ => typeError ()
-	    in
-	       r
-	    end
+            let
+               val r = result ()
+               val _ =
+                  case dest r of
+                     Type _ => ()
+                   | Weak x => coerce {from = oneArg (), to = x}
+                   | _ => typeError ()
+            in
+               r
+            end
        | _ => result ()
    end
 

Modified: mlton/branches/on-20050420-cmm-branch/mlton/closure-convert/abstract-value.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/closure-convert/abstract-value.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/closure-convert/abstract-value.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 type int = Int.t
    
 signature ABSTRACT_VALUE_STRUCTS = 
@@ -18,26 +19,26 @@
       include ABSTRACT_VALUE_STRUCTS
 
       structure Lambda:
-	 sig
-	    type t
-	       
-	    val dest: t -> Sxml.Lambda.t
-	    val layout: t -> Layout.t
-	 end
+         sig
+            type t
+               
+            val dest: t -> Sxml.Lambda.t
+            val layout: t -> Layout.t
+         end
 
       structure Lambdas:
-	 sig
-	    type t
+         sig
+            type t
 
-	    val equals: t * t -> bool
-	    val plist: t -> PropertyList.t
-	    val toList: t -> Lambda.t list
-	 end
+            val equals: t * t -> bool
+            val plist: t -> PropertyList.t
+            val toList: t -> Lambda.t list
+         end
 
       type t
 
       datatype dest =
-	 Array of t
+         Array of t
        | Lambdas of Lambdas.t
        | Ref of t
        | Tuple of t vector
@@ -60,8 +61,8 @@
       val lambda: Sxml.Lambda.t * Sxml.Type.t (* The type of the lambda. *) -> t
       val layout: t -> Layout.t
       val primApply: {prim: Sxml.Type.t Sxml.Prim.t,
-		      args: t vector,
-		      resultTy: Sxml.Type.t} -> t
+                      args: t vector,
+                      resultTy: Sxml.Type.t} -> t
       val select: t * int -> t
       val serialValue: Sxml.Type.t -> t
       (* In tuple vs, there must be one argument that is not Type _. *)

Modified: mlton/branches/on-20050420-cmm-branch/mlton/closure-convert/closure-convert.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/closure-convert/closure-convert.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/closure-convert/closure-convert.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 (*
  * All local variables in the Sxml are renamed to new variables in Ssa,
  * unless they are global, as determined by the Globalization pass.
@@ -48,7 +49,7 @@
 end
 
 structure Value = AbstractValue (structure Ssa = Ssa
-				 structure Sxml = Sxml)
+                                 structure Sxml = Sxml)
 local open Value
 in structure Lambdas = Lambdas
 end
@@ -61,82 +62,98 @@
       structure AL = AppendList
 
       datatype t = T of {globals: {var: Var.t,
-				   ty: Type.t,
-				   exp: Dexp.t} AL.t,
-			 functions: Function.t list}
+                                   ty: Type.t,
+                                   exp: Dexp.t} AL.t,
+                         functions: Function.t list}
 
       val empty = T {globals = AL.empty, functions = []}
 
       fun addGlobals (T {globals, functions}, gs) =
-	 T {globals = AL.append (globals, AL.fromList gs),
-	    functions = functions}
+         T {globals = AL.append (globals, AL.fromList gs),
+            functions = functions}
 
       fun addGlobal (ac, g) = addGlobals (ac, [g])
 
       fun addFunc (T {globals, functions}, f) =
-	 T {globals = globals, functions = f :: functions}
+         T {globals = globals, functions = f :: functions}
 
       fun done (T {globals, functions}) =
-	 {functions = functions,
-	  globals =
-	  let
-	     (* Must shrink because coercions may be inserted at constructor
-	      * applications.  I'm pretty sure the shrinking will eliminate
-	      * any case expressions/local functions.
-	      * The "NoDelete" is because the shrinker is just processing
-	      * globals and hence cannot safely delete a variable that
-	      * has no occurrences, since there may still be occurrences in
-	      * functions.
-	      *)
-	     val globals = AL.toList globals
-	     val vars = Vector.fromListMap (globals, #var)
-	     val (start, blocks) =
-		Dexp.linearize
-		(Dexp.lett
-		 {decs = List.map (globals, fn {var, exp, ...} =>
-				   {var = var, exp = exp}),
-		  body = Dexp.tuple {exps = (Vector.fromListMap
-					     (globals, fn {var, ty, ...} =>
-					      Dexp.var (var, ty))),
-				     ty = Type.unit (* bogus *)}},
-		 Ssa.Handler.Caller)
-	     val {blocks, ...} =
-		Function.dest
-		(Ssa.shrinkFunction
-		 {globals = Vector.new0 ()}
-		 (Function.new {args = Vector.new0 (),
-				blocks = Vector.fromList blocks,
-				mayInline = false, (* doesn't matter *)
-				name = Func.newNoname (),
-				raises = NONE,
-				returns = NONE, (* bogus *)
-				start = start}))
-	  in
-	     if 1 <> Vector.length blocks
-		then Error.bug "shrinker didn't completely simplify"
-	     else
-		let
-		   val ss = Block.statements (Vector.sub (blocks, 0))
-		   val _ = 
-		      case Ssa.Statement.exp (Vector.last ss) of
-			 Ssa.Exp.Tuple v =>
-			    if Vector.equals (vars, v, Var.equals)
-			       then ()
-			    else Error.bug "shrinker didn't simplify right"
-		       | _ => Error.bug "shrinker didn't produce tuple"
-		in
-		   Vector.tabulate (Vector.length ss - 1, fn i =>
-				    Vector.sub (ss, i))
-		end
-	  end}
+         {functions = functions,
+          globals =
+          let
+             (* Must shrink because coercions may be inserted at constructor
+              * applications.  I'm pretty sure the shrinking will eliminate
+              * any case expressions/local functions.
+              * We must rebind eliminated variables because the shrinker is 
+              * just processing globals and hence cannot safely delete a 
+              * variable that has no occurrences, since there may still be 
+              * occurrences in functions.
+              *)
+             val globals = AL.toList globals
+             val vars = Vector.fromListMap (globals, #var)
+             val tys = Vector.fromListMap (globals, #ty)
+             val (start, blocks) =
+                Dexp.linearize
+                (Dexp.lett
+                 {decs = List.map (globals, fn {var, exp, ...} =>
+                                   {var = var, exp = exp}),
+                  body = Dexp.tuple {exps = (Vector.fromListMap
+                                             (globals, fn {var, ty, ...} =>
+                                              Dexp.var (var, ty))),
+                                     ty = Type.tuple tys}},
+                 Ssa.Handler.Caller)
+             val {blocks, ...} =
+                Function.dest
+                (Ssa.shrinkFunction
+                 {globals = Vector.new0 ()}
+                 (Function.new {args = Vector.new0 (),
+                                blocks = Vector.fromList blocks,
+                                mayInline = false, (* doesn't matter *)
+                                name = Func.newNoname (),
+                                raises = NONE,
+                                returns = SOME (Vector.new1 (Type.tuple tys)),
+                                start = start}))
+          in
+             if 1 <> Vector.length blocks
+                then Error.bug (concat ["ClosureConvert.Accum.done: ",
+                                        "shrinker didn't completely simplify"])
+             else
+                let
+                   val ss = Block.statements (Vector.sub (blocks, 0))
+                   val vs = 
+                      case Ssa.Statement.exp (Vector.last ss) of
+                         Ssa.Exp.Tuple vs =>
+                            if Vector.length vars = Vector.length vs
+                               then vs
+                            else Error.bug (concat ["ClosureConvert.Accum.done: ",
+                                                    "shrinker didn't simplify right"])
+                       | _ => Error.bug (concat ["ClosureConvert.Accum.done: ",
+                                                 "shrinker didn't produce tuple"])
+                   val ss = Vector.dropSuffix (ss, 1)
+                   val rebinds =
+                      Vector.keepAllMapi
+                      (vs, fn (i, v) =>
+                       if Var.equals (v, Vector.sub (vars, i))
+                          then NONE
+                          else SOME (Ssa.Statement.T 
+                                     {exp = Ssa.Exp.Var v,
+                                      ty = Vector.sub (tys, i),
+                                      var = SOME (Vector.sub (vars, i))}))
+                in
+                   Vector.concat [ss, rebinds]
+                end
+          end}
    end
 
-(* val traceConvertExp =
- *    Trace.trace2 ("convertExp", Sexp.layout, Instance.layout, Dexp.layout)
- *)
+(*
+val traceConvertExp =
+   Trace.trace2 
+   ("ClosureConvert.convertExp", 
+    Sexp.layout, Instance.layout, Dexp.layout)
+*)
 
 val convertPrimExpInfo = Trace.info "ClosureConvert.convertPrimExp"
-val valueTypeInfo = Trace.info "valueType"
+val valueTypeInfo = Trace.info "ClosureConvert.valueType"
 
 structure LambdaFree = LambdaFree (Sxml)
 
@@ -149,17 +166,17 @@
 structure LambdaInfo =
    struct
       datatype t =
-	 T of {
-	       con: Con.t ref,
-	       frees: Var.t vector ref,
-	       (* name is the original name in the source (i.e. SXML) program,
-		* so the closure conversion output has some readability.
-		*)
-	       name: Func.t,
-	       recs: Var.t vector ref,
-	       (* The type of its environment record. *)
-	       ty: Type.t option ref
-	       }
+         T of {
+               con: Con.t ref,
+               frees: Var.t vector ref,
+               (* name is the original name in the source (i.e. SXML) program,
+                * so the closure conversion output has some readability.
+                *)
+               name: Func.t,
+               recs: Var.t vector ref,
+               (* The type of its environment record. *)
+               ty: Type.t option ref
+               }
 
       fun frees (T {frees, ...}) = !frees
    end
@@ -167,45 +184,47 @@
 structure VarInfo =
    struct
       type t = {frees: Var.t list ref ref,
-		isGlobal: bool ref,
-		lambda: Slambda.t option,
-		replacement: Var.t ref,
-		status: Status.t ref,
-		value: Value.t}
+                isGlobal: bool ref,
+                lambda: Slambda.t option,
+                replacement: Var.t ref,
+                status: Status.t ref,
+                value: Value.t}
 
       local
-	 fun make sel (r: t) = sel r
+         fun make sel (r: t) = sel r
       in
-	 val lambda = valOf o make #lambda
-	 val value = make #value
+         val lambda = valOf o make #lambda
+         val value = make #value
       end
    end
 
 val traceLoopBind =
    Trace.trace
-   ("ClosureConvert.analyzeBind",
+   ("ClosureConvert.loopBind",
     fn {exp, ty = _: Stype.t, var} =>
     Layout.record [("var", Var.layout var),
-		   ("exp", SprimExp.layout exp)],
+                   ("exp", SprimExp.layout exp)],
     Unit.layout)
 
 fun closureConvert
    (program as Sxml.Program.T {datatypes, body, overflow}): Ssa.Program.t =
    let
       val {get = conArg: Con.t -> Value.t option, set = setConArg, ...} =
-	 Property.getSetOnce (Con.plist,
-			      Property.initRaise ("conArg", Con.layout))
+         Property.getSetOnce (Con.plist,
+                              Property.initRaise ("conArg", Con.layout))
       val {get = varInfo: Var.t -> VarInfo.t, set = setVarInfo, ...} =
-	 Property.getSetOnce
-	 (Var.plist, Property.initRaise ("closure convert info", Var.layout))
+         Property.getSetOnce
+         (Var.plist, Property.initRaise ("closure convert info", Var.layout))
       val varInfo =
-	 Trace.trace ("ClosureConvert.varInfo", Var.layout, Layout.ignore)
-	 varInfo
+         Trace.trace 
+         ("ClosureConvert.varInfo", Var.layout, Layout.ignore)
+         varInfo
       val varExpInfo = varInfo o SvarExp.var
       val isGlobal = ! o #isGlobal o varInfo
       val isGlobal =
-	 Trace.trace ("ClosureConvert.isGlobal", Var.layout, Bool.layout)
-	 isGlobal
+         Trace.trace 
+         ("ClosureConvert.isGlobal", Var.layout, Bool.layout)
+         isGlobal
       val value = #value o varInfo
       val varExp = value o SvarExp.var
       val expValue = varExp o Sexp.result
@@ -213,493 +232,497 @@
       (*             lambdaInfo             *)
       (* ---------------------------------- *)
       val {get = lambdaInfo: Slambda.t -> LambdaInfo.t,
-	   set = setLambdaInfo, ...} =
-	 Property.getSetOnce
-	 (Slambda.plist,
-	  Property.initRaise ("closure convert info", Layout.ignore))
+           set = setLambdaInfo, ...} =
+         Property.getSetOnce
+         (Slambda.plist,
+          Property.initRaise ("closure convert info", Layout.ignore))
       val allLambdas: Slambda.t list ref = ref []
       (* Do the flow analysis.
        * Initialize lambdaInfo and varInfo.
        *)
       val _ =
-	 Vector.foreach
-	 (datatypes, fn {cons, ...} =>
-	  Vector.foreach
-	  (cons, fn {con, arg} =>
-	   setConArg (con, (case arg of
-			       NONE => NONE
-			     | SOME t => SOME (Value.fromType t)))))
+         Vector.foreach
+         (datatypes, fn {cons, ...} =>
+          Vector.foreach
+          (cons, fn {con, arg} =>
+           setConArg (con, (case arg of
+                               NONE => NONE
+                             | SOME t => SOME (Value.fromType t)))))
       val _ =
-	 let
-	    open Sxml
-	    val bogusFrees = ref []
-	    fun newVar' (x, v, lambda) =
-	       setVarInfo (x, {frees = ref bogusFrees,
-			       isGlobal = ref false,
-			       lambda = lambda,
-			       replacement = ref x,
-			       status = ref Status.init,
-			       value = v})
-	    fun newVar (x, v) = newVar' (x, v, NONE)
-	    val newVar =
-	       Trace.trace2 ("ClosureConvert.newVar",
-			     Var.layout, Layout.ignore, Unit.layout)
-	       newVar
-	    fun varExps xs = Vector.map (xs, varExp)
-	    fun loopExp (e: Exp.t): Value.t =
-	       let
-		  val {decs, result} = Exp.dest e
-		  val () = List.foreach (decs, loopDec)
-	       in
-		  varExp result
-	       end
-	    and loopDec (d: Dec.t): unit =
-	       let
-		  datatype z = datatype Dec.t
-	       in
-		  case d of
-		     Fun {decs, ...} =>
-			(Vector.foreach (decs, fn {var, lambda, ty, ...} =>
-					 newVar' (var, Value.fromType ty,
-						  SOME lambda))
-			 ; (Vector.foreach
-			    (decs, fn {var, lambda, ...} =>
-			     Value.unify (value var,
-					  loopLambda (lambda, var)))))
-		   | MonoVal b => loopBind b
-		   | _ => Error.bug "closure convert saw bogus Dec"
-	       end
-	    and loopBind arg =
-	       traceLoopBind
-	       (fn {var, ty, exp} =>
-	       let
-		  fun set v = newVar (var, v)
-		  fun new () =
-		     let val v = Value.fromType ty
-		     in set v; v
-		     end
-		  val new' = ignore o new
-		  datatype z = datatype PrimExp.t
-	       in
-		  case exp of
-		     App {func, arg} =>
-			let val arg = varExp arg
-			   val result = new ()
-			in Value.addHandler
-			   (varExp func, fn l =>
-			    let
-			       val lambda = Value.Lambda.dest l
-			       val {arg = formal, body, ...} =
-				  Lambda.dest lambda
-			    in Value.coerce {from = arg,
-					     to = value formal}
-			       ; Value.coerce {from = expValue body,
-					       to = result}
-			    end)
-			end
-		   | Case {cases, default, ...} =>
-			let
-			   val result = new ()
-			   fun branch e =
-			      Value.coerce {from = loopExp e, to = result}
-			   fun handlePat (Pat.T {con, arg, ...}) =
-			      case (arg,      conArg con) of
-				 (NONE,        NONE)       => ()
-			       | (SOME (x, _), SOME v)     => newVar (x, v)
-			       | _ => Error.bug "constructor mismatch"
-			   val _ = Cases.foreach' (cases, branch, handlePat)
-			   val _ = Option.app (default, branch o #1)
-			in ()
-			end
-		   | ConApp {con, arg, ...} =>
-			(case (arg,    conArg con) of
-			    (NONE,   NONE)       => ()
-			  | (SOME x, SOME v)     =>
-			       Value.coerce {from = varExp x, to = v}
-			  | _ => Error.bug "constructor mismatch"
-			 ; new' ())
-		   | Const _ => new' ()
-		   | Handle {try, catch = (x, t), handler} =>
-			let
-			   val result = new ()
-			in Value.coerce {from = loopExp try, to = result}
-			   ; newVar (x, Value.fromType t)
-			   ; Value.coerce {from = loopExp handler, to = result}
-			end
-		   | Lambda l => set (loopLambda (l, var))
-		   | PrimApp {prim, args, ...} =>
-			set (Value.primApply {prim = prim,
-					      args = varExps args,
-					      resultTy = ty})
-		   | Profile _ => new' ()
-		   | Raise _ => new' ()
-		   | Select {tuple, offset} =>
-			set (Value.select (varExp tuple, offset))
-		   | Tuple xs =>
-			if Value.typeIsFirstOrder ty
-			   then new' ()
-		      else set (Value.tuple (Vector.map (xs, varExp)))
-		   | Var x => set (varExp x)
-	       end) arg
-	    and loopLambda (lambda: Lambda.t, x: Var.t): Value.t =
-	       let
-		  val _ = List.push (allLambdas, lambda)
-		  val {arg, argType, body, ...} = Lambda.dest lambda
-		  val _ =
-		     setLambdaInfo
-		     (lambda,
-		      LambdaInfo.T {con = ref Con.bogus,
-				    frees = ref (Vector.new0 ()),
-				    name = Func.newString (Var.originalName x),
-				    recs = ref (Vector.new0 ()),
-				    ty = ref NONE})
-		  val _ = newVar (arg, Value.fromType argType)
-	       in
-		  Value.lambda (lambda,
-				Type.arrow (argType, Value.ty (loopExp body)))
-	       end
-	    val _ =
-	       Control.trace (Control.Pass, "flow analysis")
-	       loopExp body
-	 in ()
-	 end
+         let
+            open Sxml
+            val bogusFrees = ref []
+            fun newVar' (x, v, lambda) =
+               setVarInfo (x, {frees = ref bogusFrees,
+                               isGlobal = ref false,
+                               lambda = lambda,
+                               replacement = ref x,
+                               status = ref Status.init,
+                               value = v})
+            fun newVar (x, v) = newVar' (x, v, NONE)
+            val newVar =
+               Trace.trace2 
+               ("ClosureConvert.newVar",
+                Var.layout, Layout.ignore, Unit.layout)
+               newVar
+            fun varExps xs = Vector.map (xs, varExp)
+            fun loopExp (e: Exp.t): Value.t =
+               let
+                  val {decs, result} = Exp.dest e
+                  val () = List.foreach (decs, loopDec)
+               in
+                  varExp result
+               end
+            and loopDec (d: Dec.t): unit =
+               let
+                  datatype z = datatype Dec.t
+               in
+                  case d of
+                     Fun {decs, ...} =>
+                        (Vector.foreach (decs, fn {var, lambda, ty, ...} =>
+                                         newVar' (var, Value.fromType ty,
+                                                  SOME lambda))
+                         ; (Vector.foreach
+                            (decs, fn {var, lambda, ...} =>
+                             Value.unify (value var,
+                                          loopLambda (lambda, var)))))
+                   | MonoVal b => loopBind b
+                   | _ => Error.bug "ClosureConvert.loopDec: strange dec"
+               end
+            and loopBind arg =
+               traceLoopBind
+               (fn {var, ty, exp} =>
+               let
+                  fun set v = newVar (var, v)
+                  fun new () =
+                     let val v = Value.fromType ty
+                     in set v; v
+                     end
+                  val new' = ignore o new
+                  datatype z = datatype PrimExp.t
+               in
+                  case exp of
+                     App {func, arg} =>
+                        let val arg = varExp arg
+                           val result = new ()
+                        in Value.addHandler
+                           (varExp func, fn l =>
+                            let
+                               val lambda = Value.Lambda.dest l
+                               val {arg = formal, body, ...} =
+                                  Lambda.dest lambda
+                            in Value.coerce {from = arg,
+                                             to = value formal}
+                               ; Value.coerce {from = expValue body,
+                                               to = result}
+                            end)
+                        end
+                   | Case {cases, default, ...} =>
+                        let
+                           val result = new ()
+                           fun branch e =
+                              Value.coerce {from = loopExp e, to = result}
+                           fun handlePat (Pat.T {con, arg, ...}) =
+                              case (arg,      conArg con) of
+                                 (NONE,        NONE)       => ()
+                               | (SOME (x, _), SOME v)     => newVar (x, v)
+                               | _ => Error.bug "ClosureConvert.loopBind: Case"
+                           val _ = Cases.foreach' (cases, branch, handlePat)
+                           val _ = Option.app (default, branch o #1)
+                        in ()
+                        end
+                   | ConApp {con, arg, ...} =>
+                        (case (arg,    conArg con) of
+                            (NONE,   NONE)       => ()
+                          | (SOME x, SOME v)     =>
+                               Value.coerce {from = varExp x, to = v}
+                          | _ => Error.bug "ClosureConvert.loopBind: ConApp"
+                         ; new' ())
+                   | Const _ => new' ()
+                   | Handle {try, catch = (x, t), handler} =>
+                        let
+                           val result = new ()
+                        in Value.coerce {from = loopExp try, to = result}
+                           ; newVar (x, Value.fromType t)
+                           ; Value.coerce {from = loopExp handler, to = result}
+                        end
+                   | Lambda l => set (loopLambda (l, var))
+                   | PrimApp {prim, args, ...} =>
+                        set (Value.primApply {prim = prim,
+                                              args = varExps args,
+                                              resultTy = ty})
+                   | Profile _ => new' ()
+                   | Raise _ => new' ()
+                   | Select {tuple, offset} =>
+                        set (Value.select (varExp tuple, offset))
+                   | Tuple xs =>
+                        if Value.typeIsFirstOrder ty
+                           then new' ()
+                      else set (Value.tuple (Vector.map (xs, varExp)))
+                   | Var x => set (varExp x)
+               end) arg
+            and loopLambda (lambda: Lambda.t, x: Var.t): Value.t =
+               let
+                  val _ = List.push (allLambdas, lambda)
+                  val {arg, argType, body, ...} = Lambda.dest lambda
+                  val _ =
+                     setLambdaInfo
+                     (lambda,
+                      LambdaInfo.T {con = ref Con.bogus,
+                                    frees = ref (Vector.new0 ()),
+                                    name = Func.newString (Var.originalName x),
+                                    recs = ref (Vector.new0 ()),
+                                    ty = ref NONE})
+                  val _ = newVar (arg, Value.fromType argType)
+               in
+                  Value.lambda (lambda,
+                                Type.arrow (argType, Value.ty (loopExp body)))
+               end
+            val _ =
+               Control.trace (Control.Pass, "flow analysis")
+               loopExp body
+         in ()
+         end
       val _ =
-	 Control.diagnostics
-	 (fn display =>
-	  Sexp.foreachBoundVar
-	  (body, fn (x, _, _) => display (let open Layout
-					  in seq [Var.layout x,
-						  str " ",
-						  Value.layout (value x)]
-					  end)))
+         Control.diagnostics
+         (fn display =>
+          Sexp.foreachBoundVar
+          (body, fn (x, _, _) => display (let open Layout
+                                          in seq [Var.layout x,
+                                                  str " ",
+                                                  Value.layout (value x)]
+                                          end)))
       val overflow = valOf overflow
       val _ =
-	 Control.trace (Control.Pass, "free variables")
-	 LambdaFree.lambdaFree
-	 {program = program,
-	  overflow = overflow,
-	  varInfo = fn x => let val {frees, status, ...} = varInfo x
-			    in {frees = frees, status = status}
-			    end,
-	  lambdaInfo = fn l => let val LambdaInfo.T {frees, recs, ...} = lambdaInfo l
-			       in {frees = frees, recs = recs}
-			       end}
+         Control.trace (Control.Pass, "free variables")
+         LambdaFree.lambdaFree
+         {program = program,
+          overflow = overflow,
+          varInfo = fn x => let val {frees, status, ...} = varInfo x
+                            in {frees = frees, status = status}
+                            end,
+          lambdaInfo = fn l => let val LambdaInfo.T {frees, recs, ...} = lambdaInfo l
+                               in {frees = frees, recs = recs}
+                               end}
       val _ =
-	 Control.trace (Control.Pass, "globalize")
-	 Globalize.globalize {program = program,
-			      lambdaFree = LambdaInfo.frees o lambdaInfo,
-			      varGlobal = #isGlobal o varInfo}
+         Control.trace (Control.Pass, "globalize")
+         Globalize.globalize {program = program,
+                              lambdaFree = LambdaInfo.frees o lambdaInfo,
+                              varGlobal = #isGlobal o varInfo}
       local
-	 fun removeGlobal v = Vector.keepAll (v, not o isGlobal)
-	 val _ =
-	    List.foreach (!allLambdas, fn l =>
-			  let
-			     val LambdaInfo.T {frees, recs, ...} = lambdaInfo l
-			  in
-			     frees := removeGlobal (!frees)
-			     ; recs := removeGlobal (!recs)
-			  end)
+         fun removeGlobal v = Vector.keepAll (v, not o isGlobal)
+         val _ =
+            List.foreach (!allLambdas, fn l =>
+                          let
+                             val LambdaInfo.T {frees, recs, ...} = lambdaInfo l
+                          in
+                             frees := removeGlobal (!frees)
+                             ; recs := removeGlobal (!recs)
+                          end)
       in
       end
       val {get = lambdasInfoOpt, ...} =
-	 Property.get (Lambdas.plist, Property.initFun (fn _ => ref NONE))
+         Property.get (Lambdas.plist, Property.initFun (fn _ => ref NONE))
       val {hom = convertType, destroy = destroyConvertType} =
-	 Stype.makeMonoHom {con = fn (_, c, ts) => Type.con (c, ts)}
+         Stype.makeMonoHom {con = fn (_, c, ts) => Type.con (c, ts)}
       (* newDatatypes accumulates the new datatypes built for sets of lambdas. *)
       val newDatatypes: Datatype.t list ref = ref []
       fun valueType arg: Type.t =
-	 Trace.traceInfo (valueTypeInfo,
-			  Layout.ignore,
-			  Type.layout,
-			  Trace.assertTrue)
-	 (fn (v: Value.t) =>
-	 let
-	    val r = Value.ssaType v
-	 in
-	    case !r of
-	       SOME t => t
-	     | NONE =>
-		  let
-		     val t = 
-			case Value.dest v of
-			   Value.Array v => Type.array (valueType v)
-			 | Value.Lambdas ls => #ty (lambdasInfo ls)
-			 | Value.Ref v => Type.reff (valueType v)
-			 | Value.Type t => convertType t
-			 | Value.Tuple vs =>
-			      Type.tuple (Vector.map (vs, valueType))
-			 | Value.Vector v => Type.vector (valueType v)
-			 | Value.Weak v => Type.weak (valueType v)
-		  in r := SOME t; t
-		  end
-	 end) arg
+         Trace.traceInfo (valueTypeInfo,
+                          Layout.ignore,
+                          Type.layout,
+                          Trace.assertTrue)
+         (fn (v: Value.t) =>
+         let
+            val r = Value.ssaType v
+         in
+            case !r of
+               SOME t => t
+             | NONE =>
+                  let
+                     val t = 
+                        case Value.dest v of
+                           Value.Array v => Type.array (valueType v)
+                         | Value.Lambdas ls => #ty (lambdasInfo ls)
+                         | Value.Ref v => Type.reff (valueType v)
+                         | Value.Type t => convertType t
+                         | Value.Tuple vs =>
+                              Type.tuple (Vector.map (vs, valueType))
+                         | Value.Vector v => Type.vector (valueType v)
+                         | Value.Weak v => Type.weak (valueType v)
+                  in r := SOME t; t
+                  end
+         end) arg
       and lambdasInfo (ls: Lambdas.t): {cons: {lambda: Slambda.t,
-					       con: Con.t} vector,
-					ty: Type.t} =
-	 let
-	    val r = lambdasInfoOpt ls
-	 in
-	    case !r of
-	       SOME info => info
-	     | NONE => 
-		  let
-		     val tycon = Tycon.newString "lambdas"
-		     val cons =
-			Vector.fromListMap
-			(Lambdas.toList ls, fn l =>
-			 {lambda = Value.Lambda.dest l,
-			  con = Con.newString "Env"})
-		     val ty = Type.con (tycon, Vector.new0 ())
-		     val info = {ty = ty, cons = cons}
-		     val _ = r := SOME info
-		     (* r must be set before the following, because calls to
-		      * lambdaInfoType may refer to the type of this lambdasInfo.
-		      *)
-		     val cons =
-			Vector.map
-			(cons, fn {con, lambda} =>
-			 {con = con,
-			  args = Vector.new1 (lambdaInfoType
-					      (lambdaInfo lambda))})
-		     val _ = List.push (newDatatypes,
-					Datatype.T {tycon = tycon,
-						    cons = cons})
-		  in
-		     info
-		  end
-	 end
+                                               con: Con.t} vector,
+                                        ty: Type.t} =
+         let
+            val r = lambdasInfoOpt ls
+         in
+            case !r of
+               SOME info => info
+             | NONE => 
+                  let
+                     val tycon = Tycon.newString "lambdas"
+                     val cons =
+                        Vector.fromListMap
+                        (Lambdas.toList ls, fn l =>
+                         {lambda = Value.Lambda.dest l,
+                          con = Con.newString "Env"})
+                     val ty = Type.con (tycon, Vector.new0 ())
+                     val info = {ty = ty, cons = cons}
+                     val _ = r := SOME info
+                     (* r must be set before the following, because calls to
+                      * lambdaInfoType may refer to the type of this lambdasInfo.
+                      *)
+                     val cons =
+                        Vector.map
+                        (cons, fn {con, lambda} =>
+                         {con = con,
+                          args = Vector.new1 (lambdaInfoType
+                                              (lambdaInfo lambda))})
+                     val _ = List.push (newDatatypes,
+                                        Datatype.T {tycon = tycon,
+                                                    cons = cons})
+                  in
+                     info
+                  end
+         end
       and varInfoType ({value, ...}: VarInfo.t) = valueType value
       and lambdaInfoType (LambdaInfo.T {frees, ty, ...}): Type.t =
-	 case !ty of
-	    NONE =>
-	       let val t = Type.tuple (Vector.map
-					(!frees, varInfoType o varInfo))
-	       in ty := SOME t; t
-	       end
-	  | SOME t => t
+         case !ty of
+            NONE =>
+               let val t = Type.tuple (Vector.map
+                                        (!frees, varInfoType o varInfo))
+               in ty := SOME t; t
+               end
+          | SOME t => t
       fun valueLambdasInfo v =
- 	 case Value.dest v of
-	    Value.Lambdas l => lambdasInfo l
-	  | _ => Error.bug "valueLambdasInfo of non-lambda"
+         case Value.dest v of
+            Value.Lambdas l => lambdasInfo l
+          | _ => Error.bug "ClosureConvert.valueLambdasInfo: non-lambda"
       val varLambdasInfo = valueLambdasInfo o value
       val emptyTypes = Vector.new0 ()
       val datatypes =
-	 Vector.map
-	 (datatypes, fn {tycon, cons, ...} =>
-	  Datatype.T
-	  {tycon = tycon,
-	   cons = (Vector.map
-		   (cons, fn {con, ...} =>
-		    {con = con,
-		     args = (case conArg con of
-				NONE => emptyTypes
-			      | SOME v => Vector.new1 (valueType v))}))})
+         Vector.map
+         (datatypes, fn {tycon, cons, ...} =>
+          Datatype.T
+          {tycon = tycon,
+           cons = (Vector.map
+                   (cons, fn {con, ...} =>
+                    {con = con,
+                     args = (case conArg con of
+                                NONE => emptyTypes
+                              | SOME v => Vector.new1 (valueType v))}))})
       (* Variable renaming *)
       fun newVarInfo (x: Var.t, {isGlobal, replacement, ...}: VarInfo.t): Var.t =
-	 if !isGlobal
-	    then x
-	 else let val x' = Var.new x
-	      in replacement := x'; x'
-	      end
+         if !isGlobal
+            then x
+         else let val x' = Var.new x
+              in replacement := x'; x'
+              end
       fun newVar x = newVarInfo (x, varInfo x)
-      val newVar = Trace.trace ("newVar", Var.layout, Var.layout) newVar
+      val newVar = Trace.trace ("ClosureConvert.newVar", Var.layout, Var.layout) newVar
       fun newScope (xs: Var.t vector, f: Var.t vector -> 'a): 'a =
-	 let
-	    val old = Vector.map (xs, ! o #replacement o varInfo)
-	    val res = f (Vector.map (xs, newVar))
-	    val _ = Vector.foreach2 (xs, old, fn (x, x') =>
-				     #replacement (varInfo x) := x')
-	 in
-	    res
-	 end
+         let
+            val old = Vector.map (xs, ! o #replacement o varInfo)
+            val res = f (Vector.map (xs, newVar))
+            val _ = Vector.foreach2 (xs, old, fn (x, x') =>
+                                     #replacement (varInfo x) := x')
+         in
+            res
+         end
       (*------------------------------------*)
       (*               coerce               *)
       (*------------------------------------*)
       val traceCoerce =
-	 Trace.trace3 ("coerce", Dexp.layout, Value.layout, Value.layout,
-		       Dexp.layout)
+         Trace.trace3 
+         ("ClosureConvert.coerce", 
+          Dexp.layout, Value.layout, Value.layout, Dexp.layout)
       (*       val traceCoerceTuple =
-       * 	 let val layoutValues = List.layout (", ", Value.layout)
-       * 	 in Trace.trace3 ("coerceTuple", Dexp.layout,
-       * 			 layoutValues, layoutValues, Dexp.layout)
-       * 	 end
+       *         let val layoutValues = List.layout (", ", Value.layout)
+       *         in Trace.trace3 ("ClosureConvert.coerceTuple", Dexp.layout,
+       *                         layoutValues, layoutValues, Dexp.layout)
+       *         end
        *)
       fun coerce arg: Dexp.t =
-	 traceCoerce
-	 (fn (e: Dexp.t, from: Value.t, to: Value.t) =>
-	  if Value.equals (from, to)
-	     then e
-	  else 
-	     case (Value.dest from, Value.dest to) of
-		(Value.Tuple vs, Value.Tuple vs') =>
-		   coerceTuple (e, valueType from, vs, valueType to, vs')
-	      | (Value.Lambdas ls, Value.Lambdas ls') =>
-		   if Lambdas.equals (ls, ls')
-		      then e
-		   else
-		      let
-			 val {cons, ...} = lambdasInfo ls
-			 val {cons = cons', ty, ...} = lambdasInfo ls'
-			 val _ =
-			    Vector.foreach
-			    (cons', fn {lambda, con, ...} =>
-			     let
-				val LambdaInfo.T {con = r, ...} =
-				   lambdaInfo lambda
-			     in r := con
-			     end)
-			 val exp =
-			    Dexp.casee
-			    {test = e,
-			     default = NONE,
-			     ty = ty,
-			     cases =
-			     Dexp.Con
-			     (Vector.map
-			      (cons, fn {lambda, con} =>
-			       let
-				  val info as LambdaInfo.T {con = r, ...} =
-				     lambdaInfo lambda
-				  val tuple = (Var.newNoname (),
-					       lambdaInfoType info)
-			       in {con = con,
-				   args = Vector.new1 tuple,
-				   body = (Dexp.conApp
-					   {con = !r,
-					    ty = ty,
-					    args =
-					    Vector.new1 (Dexp.var tuple)})}
-			       end))}
-		      in exp
-		      end
-	      | _ => Error.bug "impossible coercion") arg
+         traceCoerce
+         (fn (e: Dexp.t, from: Value.t, to: Value.t) =>
+          if Value.equals (from, to)
+             then e
+          else 
+             case (Value.dest from, Value.dest to) of
+                (Value.Tuple vs, Value.Tuple vs') =>
+                   coerceTuple (e, valueType from, vs, valueType to, vs')
+              | (Value.Lambdas ls, Value.Lambdas ls') =>
+                   if Lambdas.equals (ls, ls')
+                      then e
+                   else
+                      let
+                         val {cons, ...} = lambdasInfo ls
+                         val {cons = cons', ty, ...} = lambdasInfo ls'
+                         val _ =
+                            Vector.foreach
+                            (cons', fn {lambda, con, ...} =>
+                             let
+                                val LambdaInfo.T {con = r, ...} =
+                                   lambdaInfo lambda
+                             in r := con
+                             end)
+                         val exp =
+                            Dexp.casee
+                            {test = e,
+                             default = NONE,
+                             ty = ty,
+                             cases =
+                             Dexp.Con
+                             (Vector.map
+                              (cons, fn {lambda, con} =>
+                               let
+                                  val info as LambdaInfo.T {con = r, ...} =
+                                     lambdaInfo lambda
+                                  val tuple = (Var.newNoname (),
+                                               lambdaInfoType info)
+                               in {con = con,
+                                   args = Vector.new1 tuple,
+                                   body = (Dexp.conApp
+                                           {con = !r,
+                                            ty = ty,
+                                            args =
+                                            Vector.new1 (Dexp.var tuple)})}
+                               end))}
+                      in exp
+                      end
+              | _ => Error.bug "ClosureConvert.coerce") arg
       and coerceTuple arg =
-	 (*	 traceCoerceTuple *)
-	 (fn (e: Dexp.t,
-	      ty: Type.t, vs: Value.t vector,
-	      ty': Type.t, vs': Value.t vector) =>
-	  if Type.equals (ty, ty')
-	     then e
-	  else 
-	     Dexp.detuple
-	     {tuple = e,
-	      length = Vector.length vs,
-	      body =
-	      fn components => 
-	      Dexp.tuple
-	      {exps = Vector.map3 (components, vs, vs',
-				   fn (x, v, v') =>
-				   coerce (Dexp.var (x, valueType v), v, v')),
-	       ty = ty'}}) arg
+         (*      traceCoerceTuple *)
+         (fn (e: Dexp.t,
+              ty: Type.t, vs: Value.t vector,
+              ty': Type.t, vs': Value.t vector) =>
+          if Type.equals (ty, ty')
+             then e
+          else 
+             Dexp.detuple
+             {tuple = e,
+              length = Vector.length vs,
+              body =
+              fn components => 
+              Dexp.tuple
+              {exps = Vector.map3 (components, vs, vs',
+                                   fn (x, v, v') =>
+                                   coerce (Dexp.var (x, valueType v), v, v')),
+               ty = ty'}}) arg
       fun convertVarInfo (info as {replacement, ...}: VarInfo.t) =
-	 Dexp.var (!replacement, varInfoType info)
+         Dexp.var (!replacement, varInfoType info)
       val convertVar = convertVarInfo o varInfo
       val convertVarExp = convertVar o SvarExp.var
       val handlesSignals =
-	 Sexp.hasPrim (body, fn p =>
-		       case Prim.name p of
-			  Prim.Name.MLton_installSignalHandler => true
-			| _ => false)
-      (*------------------------------------*)      	       
+         Sexp.hasPrim (body, fn p =>
+                       case Prim.name p of
+                          Prim.Name.MLton_installSignalHandler => true
+                        | _ => false)
+      (*------------------------------------*)                 
       (*               apply                *)
       (*------------------------------------*)
       fun apply {func, arg, resultVal}: Dexp.t =
-	 let
-	    val func = varExpInfo func
-	    val arg = varExpInfo arg
-	    val funcVal = VarInfo.value func
-	    val argVal = VarInfo.value arg
-	    val argExp = convertVarInfo arg
-	    val ty = valueType resultVal
-	    val {cons, ...} = valueLambdasInfo funcVal
-	 in Dexp.casee
-	    {test = convertVarInfo func,
-	     ty = ty,
-	     default = NONE,
-	     cases =
-	     Dexp.Con
-	     (Vector.map
-	      (cons, fn {lambda, con} =>
-	       let
-		  val {arg = param, body, ...} = Slambda.dest lambda
-		  val info as LambdaInfo.T {name, ...} = lambdaInfo lambda
-		  val result = expValue body
-		  val env = (Var.newString "env", lambdaInfoType info)
-	       in {con = con,
-		   args = Vector.new1 env,
-		   body = coerce (Dexp.call
-				  {func = name,
-				   args = Vector.new2 (Dexp.var env,
-						       coerce (argExp, argVal,
-							       value param)),
-				   ty = valueType result},
-				  result, resultVal)}
-	       end))}
-	 end
+         let
+            val func = varExpInfo func
+            val arg = varExpInfo arg
+            val funcVal = VarInfo.value func
+            val argVal = VarInfo.value arg
+            val argExp = convertVarInfo arg
+            val ty = valueType resultVal
+            val {cons, ...} = valueLambdasInfo funcVal
+         in Dexp.casee
+            {test = convertVarInfo func,
+             ty = ty,
+             default = NONE,
+             cases =
+             Dexp.Con
+             (Vector.map
+              (cons, fn {lambda, con} =>
+               let
+                  val {arg = param, body, ...} = Slambda.dest lambda
+                  val info as LambdaInfo.T {name, ...} = lambdaInfo lambda
+                  val result = expValue body
+                  val env = (Var.newString "env", lambdaInfoType info)
+               in {con = con,
+                   args = Vector.new1 env,
+                   body = coerce (Dexp.call
+                                  {func = name,
+                                   args = Vector.new2 (Dexp.var env,
+                                                       coerce (argExp, argVal,
+                                                               value param)),
+                                   ty = valueType result},
+                                  result, resultVal)}
+               end))}
+         end
       (*------------------------------------*)
       (*             convertExp             *)
       (*------------------------------------*)
       fun lambdaInfoTuple (info as LambdaInfo.T {frees, ...}): Dexp.t =
-	 Dexp.tuple {exps = Vector.map (!frees, convertVar),
-		     ty = lambdaInfoType info}
+         Dexp.tuple {exps = Vector.map (!frees, convertVar),
+                     ty = lambdaInfoType info}
       fun recursives (old: Var.t vector, new: Var.t vector, env) =
-	 Vector.fold2
-	 (old, new, [], fn (old, new, ac) =>
-	  let
-	     val {cons, ty, ...} = varLambdasInfo old
-	     val l = VarInfo.lambda (varInfo old)
-	  in
-	     case Vector.peek (cons, fn {lambda = l', ...} =>
-			       Slambda.equals (l, l')) of
-		NONE => Error.bug "lambda must exist in its own set"
-	      | SOME {con, ...} =>
-		   {var = new,
-		    ty = ty,
-		    exp = Dexp.conApp {con = con, ty = ty,
-				       args = Vector.new1 (Dexp.var env)}}
-		   :: ac
-	  end)
+         Vector.fold2
+         (old, new, [], fn (old, new, ac) =>
+          let
+             val {cons, ty, ...} = varLambdasInfo old
+             val l = VarInfo.lambda (varInfo old)
+          in
+             case Vector.peek (cons, fn {lambda = l', ...} =>
+                               Slambda.equals (l, l')) of
+                NONE => Error.bug "ClosureConvert.recursives: lambda must exist in its own set"
+              | SOME {con, ...} =>
+                   {var = new,
+                    ty = ty,
+                    exp = Dexp.conApp {con = con, ty = ty,
+                                       args = Vector.new1 (Dexp.var env)}}
+                   :: ac
+          end)
       val recursives =
-	 Trace.trace ("recursives",
-		      fn (a, b, _) =>
-		      Layout.tuple [Vector.layout Var.layout a,
-				    Vector.layout Var.layout b],
-		      Layout.ignore)
-	 recursives
+         Trace.trace ("ClosureConvert.recursives",
+                      fn (a, b, _) =>
+                      Layout.tuple [Vector.layout Var.layout a,
+                                    Vector.layout Var.layout b],
+                      Layout.ignore)
+         recursives
       val raises: Type.t vector option =
-	 let
-	    exception Yes of Type.t vector
-	 in
-	    (Sexp.foreachPrimExp
-	     (body, fn (_, _, e) =>
-	      case e of
-		 SprimExp.Handle {catch = (x, _), ...} =>
-		    raise (Yes (Vector.new1 (varInfoType (varInfo x))))
-	       | _ => ())
-	     ; NONE)
-	    handle Yes ts => SOME ts
-	 end
+         let
+            exception Yes of Type.t vector
+         in
+            (Sexp.foreachPrimExp
+             (body, fn (_, _, e) =>
+              case e of
+                 SprimExp.Handle {catch = (x, _), ...} =>
+                    raise (Yes (Vector.new1 (varInfoType (varInfo x))))
+               | _ => ())
+             ; NONE)
+            handle Yes ts => SOME ts
+         end
       val shrinkFunction = Ssa.shrinkFunction {globals = Vector.new0 ()}
       fun addFunc (ac, {args, body, isMain, mayInline, name, returns}) =
-	 let
-	    val (start, blocks) =
-	       Dexp.linearize (body, Ssa.Handler.Caller)
-	    val f =
-	       shrinkFunction
-	       (Function.new {args = args,
-			      blocks = Vector.fromList blocks,
-			      mayInline = mayInline,
-			      name = name,
-			      raises = raises,
-			      returns = SOME returns,
-			      start = start})
-	    val f =
-	       if isMain
-		  then Function.profile (f, SourceInfo.main)
-	       else f
-	 in
-	    Accum.addFunc (ac, f)
-	 end
+         let
+            val (start, blocks) =
+               Dexp.linearize (body, Ssa.Handler.Caller)
+            val f =
+               shrinkFunction
+               (Function.new {args = args,
+                              blocks = Vector.fromList blocks,
+                              mayInline = mayInline,
+                              name = name,
+                              raises = if isMain
+                                          then NONE
+                                          else raises,
+                              returns = SOME returns,
+                              start = start})
+            val f =
+               if isMain
+                  then Function.profile (f, SourceInfo.main)
+               else f
+         in
+            Accum.addFunc (ac, f)
+         end
       (* Closure convert an expression, returning:
        *   - the target ssa expression
        *   - a list of global declarations (in order)
@@ -707,355 +730,355 @@
        * Accumulate the globals onto the end of the given ones.
        *)
       fun convertExp (e: Sexp.t, ac: Accum.t): Dexp.t * Accum.t =
-	 let
-	    val {decs, result} = Sexp.dest e
-	    (* Process decs left to right, since bindings of variables
-	     * must be visited before uses.
-	     *)
-	    val (decs, ac) =
-	       List.fold
-	       (decs, ([], ac), fn (d, (binds, ac)) =>
-		case d of
-		   Sdec.MonoVal {exp, var, ...} =>
-		      let
-			 val info as {isGlobal, value, ...} = varInfo var
-			 val (exp, ac) = convertPrimExp (exp, value, ac)
-			 val bind = {var = newVarInfo (var, info),
-				     ty = valueType value,
-				     exp = exp}
-		      in if !isGlobal
-			    then (binds, Accum.addGlobal (ac, bind))
-			 else (bind :: binds, ac)
-		      end
-		 | Sdec.Fun {decs, ...} =>
-		      if Vector.isEmpty decs
-			 then (binds, ac)
-		      else
-			 let 
-			    val {lambda, var, ...} = Vector.sub (decs, 0)
-			    val info = lambdaInfo lambda
-			    val tupleVar = Var.newString "tuple"
-			    val tupleTy = lambdaInfoType info
-			    val binds' =
-			       {var = tupleVar,
-				ty = tupleTy,
-				exp = lambdaInfoTuple info}
-			       :: (recursives
-				   (Vector.map (decs, #var),
-				    Vector.map (decs, newVar o #var),
-				    (tupleVar, tupleTy)))
-			    val (binds, ac) =
-			       if isGlobal var
-				  then (binds, Accum.addGlobals (ac, binds'))
-			       else (List.fold (binds', binds, op ::), ac)
-			 in (binds,
-			     Vector.fold (decs, ac, fn ({lambda, ...}, ac) =>
-					  convertLambda (lambda,
-							 lambdaInfo lambda,
-							 ac)))
-			 end
-		 | _ => Error.bug "closure convert saw strange dec")
-	 in (Dexp.lett {decs = List.fold (decs, [], fn ({var, exp, ...}, ac) =>
-					  {var = var, exp = exp} :: ac),
-			body = convertVarExp result},
-	     ac)
-	 end
+         let
+            val {decs, result} = Sexp.dest e
+            (* Process decs left to right, since bindings of variables
+             * must be visited before uses.
+             *)
+            val (decs, ac) =
+               List.fold
+               (decs, ([], ac), fn (d, (binds, ac)) =>
+                case d of
+                   Sdec.MonoVal {exp, var, ...} =>
+                      let
+                         val info as {isGlobal, value, ...} = varInfo var
+                         val (exp, ac) = convertPrimExp (exp, value, ac)
+                         val bind = {var = newVarInfo (var, info),
+                                     ty = valueType value,
+                                     exp = exp}
+                      in if !isGlobal
+                            then (binds, Accum.addGlobal (ac, bind))
+                         else (bind :: binds, ac)
+                      end
+                 | Sdec.Fun {decs, ...} =>
+                      if Vector.isEmpty decs
+                         then (binds, ac)
+                      else
+                         let 
+                            val {lambda, var, ...} = Vector.sub (decs, 0)
+                            val info = lambdaInfo lambda
+                            val tupleVar = Var.newString "tuple"
+                            val tupleTy = lambdaInfoType info
+                            val binds' =
+                               {var = tupleVar,
+                                ty = tupleTy,
+                                exp = lambdaInfoTuple info}
+                               :: (recursives
+                                   (Vector.map (decs, #var),
+                                    Vector.map (decs, newVar o #var),
+                                    (tupleVar, tupleTy)))
+                            val (binds, ac) =
+                               if isGlobal var
+                                  then (binds, Accum.addGlobals (ac, binds'))
+                               else (List.fold (binds', binds, op ::), ac)
+                         in (binds,
+                             Vector.fold (decs, ac, fn ({lambda, ...}, ac) =>
+                                          convertLambda (lambda,
+                                                         lambdaInfo lambda,
+                                                         ac)))
+                         end
+                 | _ => Error.bug "ClosureConvert.convertExp: strange dec")
+         in (Dexp.lett {decs = List.fold (decs, [], fn ({var, exp, ...}, ac) =>
+                                          {var = var, exp = exp} :: ac),
+                        body = convertVarExp result},
+             ac)
+         end
       and convertPrimExp arg : Dexp.t * Accum.t =
-	 Trace.traceInfo (convertPrimExpInfo,
-			  SprimExp.layout o #1,
-			  Layout.ignore,
-			  Trace.assertTrue)
-	 (fn (e: SprimExp.t, v: Value.t, ac: Accum.t) =>
-	 let
-	    val ty = valueType v
-	    fun convertJoin (e, ac) =
-	       let val (e', ac) = convertExp (e, ac)
-	       in (coerce (e', expValue e, v), ac)
-	       end
-	    fun simple e = (e, ac)
-	 in
-	    case e of
-	       SprimExp.App {func, arg} =>
-		  (apply {func = func, arg = arg, resultVal = v},
-		   ac)
-	     | SprimExp.Case {test, cases, default} =>
-		  let
-		     val (default, ac) =
-			case default of
-			   NONE => (NONE, ac)
-			 | SOME (e, _) => let
-					     val (e, ac) =  convertJoin (e, ac)
-					  in
-					     (SOME e, ac)
-					  end
-		     fun doCases (cases, finish, make) =
-			let
-			   val (cases, ac) =
-			      Vector.mapAndFold
-			      (cases, ac, fn ((x, e), ac) =>
-			       let
-				  val make = make x
-				  val (body, ac) = convertJoin (e, ac)
-			       in (make body, ac)
-			       end)
-			in (finish cases, ac)
-			end
-		     val (cases, ac) =
-			case cases of
-			   Scases.Con cases =>
-			      doCases
-			      (cases, Dexp.Con,
-			       fn Spat.T {con, arg, ...} =>
-			       let
-				  val args =
-				     case (conArg con, arg) of
-					(NONE, NONE) => Vector.new0 ()
-				      | (SOME v, SOME (arg, _)) =>
-					   Vector.new1 (newVar arg, valueType v)
-				      | _ => Error.bug "constructor mismatch"
-			       in
-				  fn body => {args = args,
-					      body = body,
-					      con = con}
-			       end)
-			 | Scases.Word (s, cs) =>
-			      doCases (cs, fn cs => Dexp.Word (s, cs),
-				       fn i => fn e => (i, e))
-		  in (Dexp.casee
-		      {test = convertVarExp test,
-		       ty = ty, cases = cases, default = default},
-		      ac)
-		  end
-	     | SprimExp.ConApp {con = con, arg, ...} =>
-		  simple
-		  (Dexp.conApp
-		   {con = con,
-		    ty = ty,
-		    args = (case (arg, conArg con) of
-			       (NONE, NONE) => Vector.new0 ()
-			     | (SOME arg, SOME conArg) =>
-				  let
-				     val arg = varExpInfo arg
-				     val argVal = VarInfo.value arg
-				     val arg = convertVarInfo arg
-				  in if Value.equals (argVal, conArg)
-					then Vector.new1 arg
-				     else Vector.new1 (coerce (arg, argVal, conArg))
-				  end
-			     | _ => Error.bug "constructor mismatch")})
-	     | SprimExp.Const c => simple (Dexp.const c)
-	     | SprimExp.Handle {try, catch = (catch, _), handler} =>
-		  let
-		     val catchInfo = varInfo catch
-		     val (try, ac) = convertJoin (try, ac)
-		     val catch = (newVarInfo (catch, catchInfo),
-				  varInfoType catchInfo)
-		     val (handler, ac) = convertJoin (handler, ac)
-		  in (Dexp.handlee {try = try, ty = ty,
-				    catch = catch, handler = handler},
-		      ac)
-		  end
-	     | SprimExp.Lambda l =>
-		  let
-		     val info = lambdaInfo l
-		     val ac = convertLambda (l, info, ac)
-		     val {cons, ...} = valueLambdasInfo v
-		  in case Vector.peek (cons, fn {lambda = l', ...} =>
-				       Slambda.equals (l, l')) of
-		     NONE => Error.bug "lambda must exist in its own set"
-		   | SOME {con, ...} =>
-			(Dexp.conApp {con = con, ty = ty,
-				      args = Vector.new1 (lambdaInfoTuple info)},
-			 ac)
-		  end
-	     | SprimExp.PrimApp {prim, targs, args} =>
-		  let
-		     val prim = Prim.map (prim, convertType)
-		     open Prim.Name
-		     fun arg i = Vector.sub (args, i)
-		     val v1 = Vector.new1
-		     val v2 = Vector.new2
-		     val v3 = Vector.new3
-		     fun primApp (targs, args) =
-			Dexp.primApp {args = args,
-				      prim = prim,
-				      targs = targs,
-				      ty = ty}
-		  in
-		     if Prim.mayOverflow prim
-			then simple (Dexp.arith
-				     {args = Vector.map (args, convertVarExp),
-				      overflow = Dexp.raisee (convertVar overflow),
-				      prim = prim,
-				      ty = ty})
-		     else
-			let
-			   datatype z = datatype Prim.Name.t
-			in
-			   simple
-			   (case Prim.name prim of
-			       Array_update =>
-				  let
-				     val a = varExpInfo (arg 0)
-				     val y = varExpInfo (arg 2)
-				     val v = Value.deArray (VarInfo.value a)
-				  in
-				     primApp (v1 (valueType v),
-					      v3 (convertVarInfo a,
-						  convertVarExp (arg 1),
-						  coerce (convertVarInfo y,
-							  VarInfo.value y, v)))
-				  end
-			     | MLton_eq =>
-				  let
-				     val a0 = varExpInfo (arg 0)
-				     val a1 = varExpInfo (arg 1)
-				     fun doit () =
-					primApp (v1 (valueType (VarInfo.value a0)),
-						 v2 (convertVarInfo a0,
-						     convertVarInfo a1))
-				  in
-				     case (Value.dest (VarInfo.value a0),
-					   Value.dest (VarInfo.value a1)) of
-					(Value.Lambdas l, Value.Lambdas l') =>
-					   if Lambdas.equals (l, l')
-					      then doit () 
-					   else Dexp.falsee
-				      | _ => doit ()
-				  end
-			     | MLton_handlesSignals =>
-				  if handlesSignals
-				     then Dexp.truee
-				  else Dexp.falsee
-			     | Ref_assign =>
-				  let
-				     val r = varExpInfo (arg 0)
-				     val y = varExpInfo (arg 1)
-				     val v = Value.deRef (VarInfo.value r)
-				  in
-				     primApp (v1 (valueType v),
-					      v2 (convertVarInfo r,
-						  coerce (convertVarInfo y,
-							  VarInfo.value y, v)))
-				  end
-			     | Ref_ref =>
-				  let
-				     val y = varExpInfo (arg 0)
-				     val v = Value.deRef v
-				  in
-				     primApp (v1 (valueType v),
-					      v1 (coerce (convertVarInfo y,
-							  VarInfo.value y, v)))
-				  end
-			     | MLton_serialize =>
-				  let
-				     val y = varExpInfo (arg 0)
-				     val v =
-					Value.serialValue (Vector.sub (targs, 0))
-				  in
-				     primApp (v1 (valueType v),
-					      v1 (coerce (convertVarInfo y,
-							  VarInfo.value y, v)))
-				  end
-			     | Weak_new =>
-				  let
-				     val y = varExpInfo (arg 0)
-				     val v = Value.deWeak v
-				  in
-				     primApp (v1 (valueType v),
-					      v1 (coerce (convertVarInfo y,
-							  VarInfo.value y, v)))
-				  end
-			     | _ =>
-				  let
-				     val args = Vector.map (args, varExpInfo)
-				  in
-				     primApp
-				     (Prim.extractTargs
-				      (prim,
-				       {args = Vector.map (args, varInfoType),
-					result = ty,
-					deArray = Type.deArray,
-					deArrow = Type.deArrow,
-					deVector = Type.deVector,
-					deWeak = Type.deWeak}),
-				       Vector.map (args, convertVarInfo))
-				  end)
-			end
-		  end
-	     | SprimExp.Profile e => simple (Dexp.profile e)
-	     | SprimExp.Raise {exn, ...} =>
-		  simple (Dexp.raisee (convertVarExp exn))
-	     | SprimExp.Select {offset, tuple} =>
-		  simple (Dexp.select {offset = offset,
-				       tuple = convertVarExp tuple,
-				       ty = ty})
-	     | SprimExp.Tuple xs =>
-		  simple (Dexp.tuple {exps = Vector.map (xs, convertVarExp),
-				      ty = ty})
-	     | SprimExp.Var y => simple (convertVarExp y)
-	 end) arg
+         Trace.traceInfo (convertPrimExpInfo,
+                          SprimExp.layout o #1,
+                          Layout.ignore,
+                          Trace.assertTrue)
+         (fn (e: SprimExp.t, v: Value.t, ac: Accum.t) =>
+         let
+            val ty = valueType v
+            fun convertJoin (e, ac) =
+               let val (e', ac) = convertExp (e, ac)
+               in (coerce (e', expValue e, v), ac)
+               end
+            fun simple e = (e, ac)
+         in
+            case e of
+               SprimExp.App {func, arg} =>
+                  (apply {func = func, arg = arg, resultVal = v},
+                   ac)
+             | SprimExp.Case {test, cases, default} =>
+                  let
+                     val (default, ac) =
+                        case default of
+                           NONE => (NONE, ac)
+                         | SOME (e, _) => let
+                                             val (e, ac) =  convertJoin (e, ac)
+                                          in
+                                             (SOME e, ac)
+                                          end
+                     fun doCases (cases, finish, make) =
+                        let
+                           val (cases, ac) =
+                              Vector.mapAndFold
+                              (cases, ac, fn ((x, e), ac) =>
+                               let
+                                  val make = make x
+                                  val (body, ac) = convertJoin (e, ac)
+                               in (make body, ac)
+                               end)
+                        in (finish cases, ac)
+                        end
+                     val (cases, ac) =
+                        case cases of
+                           Scases.Con cases =>
+                              doCases
+                              (cases, Dexp.Con,
+                               fn Spat.T {con, arg, ...} =>
+                               let
+                                  val args =
+                                     case (conArg con, arg) of
+                                        (NONE, NONE) => Vector.new0 ()
+                                      | (SOME v, SOME (arg, _)) =>
+                                           Vector.new1 (newVar arg, valueType v)
+                                      | _ => Error.bug "ClosureConvert.convertPrimExp: Case,constructor mismatch"
+                               in
+                                  fn body => {args = args,
+                                              body = body,
+                                              con = con}
+                               end)
+                         | Scases.Word (s, cs) =>
+                              doCases (cs, fn cs => Dexp.Word (s, cs),
+                                       fn i => fn e => (i, e))
+                  in (Dexp.casee
+                      {test = convertVarExp test,
+                       ty = ty, cases = cases, default = default},
+                      ac)
+                  end
+             | SprimExp.ConApp {con = con, arg, ...} =>
+                  simple
+                  (Dexp.conApp
+                   {con = con,
+                    ty = ty,
+                    args = (case (arg, conArg con) of
+                               (NONE, NONE) => Vector.new0 ()
+                             | (SOME arg, SOME conArg) =>
+                                  let
+                                     val arg = varExpInfo arg
+                                     val argVal = VarInfo.value arg
+                                     val arg = convertVarInfo arg
+                                  in if Value.equals (argVal, conArg)
+                                        then Vector.new1 arg
+                                     else Vector.new1 (coerce (arg, argVal, conArg))
+                                  end
+                             | _ => Error.bug "ClosureConvert.convertPrimExp: ConApp,constructor mismatch")})
+             | SprimExp.Const c => simple (Dexp.const c)
+             | SprimExp.Handle {try, catch = (catch, _), handler} =>
+                  let
+                     val catchInfo = varInfo catch
+                     val (try, ac) = convertJoin (try, ac)
+                     val catch = (newVarInfo (catch, catchInfo),
+                                  varInfoType catchInfo)
+                     val (handler, ac) = convertJoin (handler, ac)
+                  in (Dexp.handlee {try = try, ty = ty,
+                                    catch = catch, handler = handler},
+                      ac)
+                  end
+             | SprimExp.Lambda l =>
+                  let
+                     val info = lambdaInfo l
+                     val ac = convertLambda (l, info, ac)
+                     val {cons, ...} = valueLambdasInfo v
+                  in case Vector.peek (cons, fn {lambda = l', ...} =>
+                                       Slambda.equals (l, l')) of
+                     NONE => Error.bug "ClosureConvert.convertPrimExp: Lambda,lambda must exist in its own set"
+                   | SOME {con, ...} =>
+                        (Dexp.conApp {con = con, ty = ty,
+                                      args = Vector.new1 (lambdaInfoTuple info)},
+                         ac)
+                  end
+             | SprimExp.PrimApp {prim, targs, args} =>
+                  let
+                     val prim = Prim.map (prim, convertType)
+                     open Prim.Name
+                     fun arg i = Vector.sub (args, i)
+                     val v1 = Vector.new1
+                     val v2 = Vector.new2
+                     val v3 = Vector.new3
+                     fun primApp (targs, args) =
+                        Dexp.primApp {args = args,
+                                      prim = prim,
+                                      targs = targs,
+                                      ty = ty}
+                  in
+                     if Prim.mayOverflow prim
+                        then simple (Dexp.arith
+                                     {args = Vector.map (args, convertVarExp),
+                                      overflow = Dexp.raisee (convertVar overflow),
+                                      prim = prim,
+                                      ty = ty})
+                     else
+                        let
+                           datatype z = datatype Prim.Name.t
+                        in
+                           simple
+                           (case Prim.name prim of
+                               Array_update =>
+                                  let
+                                     val a = varExpInfo (arg 0)
+                                     val y = varExpInfo (arg 2)
+                                     val v = Value.deArray (VarInfo.value a)
+                                  in
+                                     primApp (v1 (valueType v),
+                                              v3 (convertVarInfo a,
+                                                  convertVarExp (arg 1),
+                                                  coerce (convertVarInfo y,
+                                                          VarInfo.value y, v)))
+                                  end
+                             | MLton_eq =>
+                                  let
+                                     val a0 = varExpInfo (arg 0)
+                                     val a1 = varExpInfo (arg 1)
+                                     fun doit () =
+                                        primApp (v1 (valueType (VarInfo.value a0)),
+                                                 v2 (convertVarInfo a0,
+                                                     convertVarInfo a1))
+                                  in
+                                     case (Value.dest (VarInfo.value a0),
+                                           Value.dest (VarInfo.value a1)) of
+                                        (Value.Lambdas l, Value.Lambdas l') =>
+                                           if Lambdas.equals (l, l')
+                                              then doit () 
+                                           else Dexp.falsee
+                                      | _ => doit ()
+                                  end
+                             | MLton_handlesSignals =>
+                                  if handlesSignals
+                                     then Dexp.truee
+                                  else Dexp.falsee
+                             | Ref_assign =>
+                                  let
+                                     val r = varExpInfo (arg 0)
+                                     val y = varExpInfo (arg 1)
+                                     val v = Value.deRef (VarInfo.value r)
+                                  in
+                                     primApp (v1 (valueType v),
+                                              v2 (convertVarInfo r,
+                                                  coerce (convertVarInfo y,
+                                                          VarInfo.value y, v)))
+                                  end
+                             | Ref_ref =>
+                                  let
+                                     val y = varExpInfo (arg 0)
+                                     val v = Value.deRef v
+                                  in
+                                     primApp (v1 (valueType v),
+                                              v1 (coerce (convertVarInfo y,
+                                                          VarInfo.value y, v)))
+                                  end
+                             | MLton_serialize =>
+                                  let
+                                     val y = varExpInfo (arg 0)
+                                     val v =
+                                        Value.serialValue (Vector.sub (targs, 0))
+                                  in
+                                     primApp (v1 (valueType v),
+                                              v1 (coerce (convertVarInfo y,
+                                                          VarInfo.value y, v)))
+                                  end
+                             | Weak_new =>
+                                  let
+                                     val y = varExpInfo (arg 0)
+                                     val v = Value.deWeak v
+                                  in
+                                     primApp (v1 (valueType v),
+                                              v1 (coerce (convertVarInfo y,
+                                                          VarInfo.value y, v)))
+                                  end
+                             | _ =>
+                                  let
+                                     val args = Vector.map (args, varExpInfo)
+                                  in
+                                     primApp
+                                     (Prim.extractTargs
+                                      (prim,
+                                       {args = Vector.map (args, varInfoType),
+                                        result = ty,
+                                        deArray = Type.deArray,
+                                        deArrow = Type.deArrow,
+                                        deVector = Type.deVector,
+                                        deWeak = Type.deWeak}),
+                                       Vector.map (args, convertVarInfo))
+                                  end)
+                        end
+                  end
+             | SprimExp.Profile e => simple (Dexp.profile e)
+             | SprimExp.Raise {exn, ...} =>
+                  simple (Dexp.raisee (convertVarExp exn))
+             | SprimExp.Select {offset, tuple} =>
+                  simple (Dexp.select {offset = offset,
+                                       tuple = convertVarExp tuple,
+                                       ty = ty})
+             | SprimExp.Tuple xs =>
+                  simple (Dexp.tuple {exps = Vector.map (xs, convertVarExp),
+                                      ty = ty})
+             | SprimExp.Var y => simple (convertVarExp y)
+         end) arg
       and convertLambda (lambda: Slambda.t,
-			 info as LambdaInfo.T {frees, name, recs, ...},
-			 ac: Accum.t): Accum.t =
-	 let
-	    val {arg = argVar, body, mayInline, ...} = Slambda.dest lambda
-	    val argVarInfo = varInfo argVar
-	    val env = Var.newString "env"
-	    val envType = lambdaInfoType info
-	    val args = Vector.new2 ((env, envType),
-				    (newVarInfo (argVar, argVarInfo),
-				     varInfoType argVarInfo))
-	    val returns = Vector.new1 (valueType (expValue body))
-	    val recs = !recs
-	 in
-	    newScope
-	    (!frees, fn components =>
-	     newScope
-	     (recs, fn recs' =>
-	      let
-		 val decs = recursives (recs, recs', (env, envType))
-		 val (body, ac) = convertExp (body, ac)
-		 val body =
-		    Dexp.lett
-		    {decs = List.fold (decs, [], fn ({var, exp, ...}, ac) =>
-				       {var = var, exp = exp} :: ac),
-		     body = Dexp.detupleBind {tuple = env,
-					      tupleTy = envType,
-					      components = components,
-					      body = body}}
-	      in
-		 addFunc (ac, {args = args,
-			       body = body,
-			       isMain = false,
-			       mayInline = mayInline,
-			       name = name,
-			       returns = returns})
-	      end))
-	 end
+                         info as LambdaInfo.T {frees, name, recs, ...},
+                         ac: Accum.t): Accum.t =
+         let
+            val {arg = argVar, body, mayInline, ...} = Slambda.dest lambda
+            val argVarInfo = varInfo argVar
+            val env = Var.newString "env"
+            val envType = lambdaInfoType info
+            val args = Vector.new2 ((env, envType),
+                                    (newVarInfo (argVar, argVarInfo),
+                                     varInfoType argVarInfo))
+            val returns = Vector.new1 (valueType (expValue body))
+            val recs = !recs
+         in
+            newScope
+            (!frees, fn components =>
+             newScope
+             (recs, fn recs' =>
+              let
+                 val decs = recursives (recs, recs', (env, envType))
+                 val (body, ac) = convertExp (body, ac)
+                 val body =
+                    Dexp.lett
+                    {decs = List.fold (decs, [], fn ({var, exp, ...}, ac) =>
+                                       {var = var, exp = exp} :: ac),
+                     body = Dexp.detupleBind {tuple = env,
+                                              tupleTy = envType,
+                                              components = components,
+                                              body = body}}
+              in
+                 addFunc (ac, {args = args,
+                               body = body,
+                               isMain = false,
+                               mayInline = mayInline,
+                               name = name,
+                               returns = returns})
+              end))
+         end
       (*------------------------------------*)
       (*    main body of closure convert    *)
       (*------------------------------------*)
       val main = Func.newString "main"
       val {functions, globals} =
-	 Control.trace (Control.Pass, "convert")
-	 (fn () =>
-	  let
-	     val (body, ac) = convertExp (body, Accum.empty)
-	     val ac = addFunc (ac, {args = Vector.new0 (),
-				    body = body,
-				    mayInline = false,
-				    isMain = true,
-				    name = main,
-				    returns = Vector.new1 Type.unit})
-	  in Accum.done ac
-	  end) ()
+         Control.trace (Control.Pass, "convert")
+         (fn () =>
+          let
+             val (body, ac) = convertExp (body, Accum.empty)
+             val ac = addFunc (ac, {args = Vector.new0 (),
+                                    body = body,
+                                    mayInline = false,
+                                    isMain = true,
+                                    name = main,
+                                    returns = Vector.new1 Type.unit})
+          in Accum.done ac
+          end) ()
       val datatypes = Vector.concat [datatypes, Vector.fromList (!newDatatypes)]
       val program =
-	 Ssa.Program.T {datatypes = datatypes,
-			globals = globals,
-			functions = functions,
-			main = main}
+         Ssa.Program.T {datatypes = datatypes,
+                        globals = globals,
+                        functions = functions,
+                        main = main}
       val _ = destroyConvertType ()
       val _ = Value.destroy ()
       val _ = Ssa.Program.clear program

Modified: mlton/branches/on-20050420-cmm-branch/mlton/closure-convert/closure-convert.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/closure-convert/closure-convert.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/closure-convert/closure-convert.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature CLOSURE_CONVERT_STRUCTS = 
    sig
       structure Ssa: SSA

Modified: mlton/branches/on-20050420-cmm-branch/mlton/closure-convert/globalize.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/closure-convert/globalize.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/closure-convert/globalize.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 functor Globalize (S: GLOBALIZE_STRUCTS): GLOBALIZE = 
 struct
 
@@ -12,142 +13,142 @@
 open Dec PrimExp
 
 fun globalize {program = Program.T {datatypes, body, ...},
-	       lambdaFree,
-	       varGlobal: Var.t -> bool ref} =
+               lambdaFree,
+               varGlobal: Var.t -> bool ref} =
    let
       val noConts =
-	 not (Exp.hasPrim (body, fn p =>
-			   case Prim.name p of
-			      Prim.Name.Thread_switchTo => true
-			    | _ => false))
+         not (Exp.hasPrim (body, fn p =>
+                           case Prim.name p of
+                              Prim.Name.Thread_switchTo => true
+                            | _ => false))
       local
-	 val {get: Tycon.t -> bool, set, destroy} =
-	    Property.destGetSetOnce (Tycon.plist, Property.initConst false)
-	 fun makeBig tycon = set (tycon, true)
-	 val _ = (Vector.foreach (datatypes, makeBig o #tycon)
-		  ; makeBig Tycon.array
-		  ; makeBig Tycon.arrow
-		  ; makeBig Tycon.vector)
+         val {get: Tycon.t -> bool, set, destroy} =
+            Property.destGetSetOnce (Tycon.plist, Property.initConst false)
+         fun makeBig tycon = set (tycon, true)
+         val _ = (Vector.foreach (datatypes, makeBig o #tycon)
+                  ; makeBig Tycon.array
+                  ; makeBig Tycon.arrow
+                  ; makeBig Tycon.vector)
       in
-	 val tyconIsBig = get
-	 val destroyTycon = destroy
+         val tyconIsBig = get
+         val destroyTycon = destroy
       end
       fun typeIsSmall t =
-	 let open Type
-	 in
-	    case dest t of
-	       Con (c, ts) =>
-		  not (tyconIsBig c)
-		  andalso if (Tycon.equals (c, Tycon.tuple)
-			      orelse Tycon.equals (c, Tycon.reff))
-			     then Vector.forall (ts, typeIsSmall)
-			  else true
-	     | _ => Error.bug "typeIsSmall saw type variable"
-	 end
+         let open Type
+         in
+            case dest t of
+               Con (c, ts) =>
+                  not (tyconIsBig c)
+                  andalso if (Tycon.equals (c, Tycon.tuple)
+                              orelse Tycon.equals (c, Tycon.reff))
+                             then Vector.forall (ts, typeIsSmall)
+                          else true
+             | _ => Error.bug "Globalize.typeIsSmall: type variable"
+         end
       val typeIsSmall =
-	 Trace.trace ("Globalize.typeIsSmall", Type.layout, Bool.layout)
-	 typeIsSmall
+         Trace.trace ("Globalize.typeIsSmall", Type.layout, Bool.layout)
+         typeIsSmall
       val varIsGlobal = ! o varGlobal
       val isGlobal = varIsGlobal o VarExp.var
       fun areGlobal xs = Vector.forall (xs, isGlobal)
       fun makeGlobal x = varGlobal x := true
       val traceLoopExp =
-	 Trace.trace2 ("Globalize.loopExp", Exp.layout, Bool.layout, Bool.layout)
+         Trace.trace2 ("Globalize.loopExp", Exp.layout, Bool.layout, Bool.layout)
       val traceLoopDec =
-	 Trace.trace2 ("Globalize.loopDec", Dec.layout, Bool.layout, Bool.layout)
+         Trace.trace2 ("Globalize.loopDec", Dec.layout, Bool.layout, Bool.layout)
       fun loopExp arg =
-	 traceLoopExp (fn (e: Exp.t, once: bool) =>
-		       List.fold (Exp.decs e, once, loopDec))
-	 arg
+         traceLoopExp (fn (e: Exp.t, once: bool) =>
+                       List.fold (Exp.decs e, once, loopDec))
+         arg
       and loopDec arg =
-	 traceLoopDec
-	 (fn (d, once) =>
-	   case d of
-	      MonoVal {var, ty, exp} =>
-		 let
-		    val (global, once) =
-		       case exp of
-			  App _ =>
-			     (* If conts are used, then the application might
-			      * call Thread_copyCurrent, in which case,
-			      * subsequent stuff might run many times.
-			      *)
-			     (false, once andalso noConts)
-			| Case {cases, default, ...} =>
-			     let
-				val once' =
-				   Cases.fold
-				   (cases, once, fn (e, b) =>
-				    loopExp (e, once) andalso b)
-				val once' =
-				   Option.fold (default, once',
-						fn ((e, _), b) =>
-						loopExp (e, once) andalso b)
-			     in (false, once')
-			     end
-			| ConApp {arg, ...} =>
-			     (case arg of
-				 NONE => true
-			       | SOME x => isGlobal x,
-				    once)
-			| Const _ => (true, once)
-			| Handle {try, handler, ...} =>
-			     (false,
-			      loopExp (handler, loopExp (try, once)))
-			| Lambda l =>
-			     (loopLambda l
-			      ; (Vector.forall (lambdaFree l, varIsGlobal),
-				 once))
-			| PrimApp {prim, args, ...} =>
-			     let
-				val global =
-				   areGlobal args andalso
-				   ((Prim.isFunctional prim
-				     (* Don't want to move MLton_equal into the globals
-				      * because polymorphic equality isn't implemented
-				      * there. 
-				      *)
-				     andalso
-				     (case Prim.name prim of
-					 Prim.Name.MLton_equal => false
-				       | _ => true))
-				    orelse
-				    (once andalso
-				     (case Prim.name prim of
-					 Prim.Name.Ref_ref => typeIsSmall ty
-				       | _ => false)))
-				val once =
-				    once andalso
-				    (case Prim.name prim of
-					Prim.Name.Thread_copyCurrent => false
-				      | _ => true)
-			     in
-				(global, once)
-			     end
-			| Profile _ => (false, once)
-			| Raise _ => (false, once)
-			| Select {tuple, ...} => (isGlobal tuple, once)
-			| Tuple xs => (areGlobal xs, once)
-			| Var x => (isGlobal x, once)
-		    val _ = if global then makeGlobal var else ()
-		 in once
-		 end
-	    | Fun {decs, ...} =>
-		 (if Vector.isEmpty decs
-		     then ()
-		  else
-		     let
-			val {lambda, ...} = Vector.sub (decs, 0)
-		     in
-			if Vector.forall (lambdaFree lambda, varIsGlobal)
-			   then Vector.foreach (decs, makeGlobal o #var)
-			else ()
-		     end
-		     ; Vector.foreach (decs, loopLambda o #lambda)
-		     ; once)
-	    | _ => Error.bug "globalize saw strange dec") arg
+         traceLoopDec
+         (fn (d, once) =>
+           case d of
+              MonoVal {var, ty, exp} =>
+                 let
+                    val (global, once) =
+                       case exp of
+                          App _ =>
+                             (* If conts are used, then the application might
+                              * call Thread_copyCurrent, in which case,
+                              * subsequent stuff might run many times.
+                              *)
+                             (false, once andalso noConts)
+                        | Case {cases, default, ...} =>
+                             let
+                                val once' =
+                                   Cases.fold
+                                   (cases, once, fn (e, b) =>
+                                    loopExp (e, once) andalso b)
+                                val once' =
+                                   Option.fold (default, once',
+                                                fn ((e, _), b) =>
+                                                loopExp (e, once) andalso b)
+                             in (false, once')
+                             end
+                        | ConApp {arg, ...} =>
+                             (case arg of
+                                 NONE => true
+                               | SOME x => isGlobal x,
+                                    once)
+                        | Const _ => (true, once)
+                        | Handle {try, handler, ...} =>
+                             (false,
+                              loopExp (handler, loopExp (try, once)))
+                        | Lambda l =>
+                             (loopLambda l
+                              ; (Vector.forall (lambdaFree l, varIsGlobal),
+                                 once))
+                        | PrimApp {prim, args, ...} =>
+                             let
+                                val global =
+                                   areGlobal args andalso
+                                   ((Prim.isFunctional prim
+                                     (* Don't want to move MLton_equal into the globals
+                                      * because polymorphic equality isn't implemented
+                                      * there. 
+                                      *)
+                                     andalso
+                                     (case Prim.name prim of
+                                         Prim.Name.MLton_equal => false
+                                       | _ => true))
+                                    orelse
+                                    (once andalso
+                                     (case Prim.name prim of
+                                         Prim.Name.Ref_ref => typeIsSmall ty
+                                       | _ => false)))
+                                val once =
+                                    once andalso
+                                    (case Prim.name prim of
+                                        Prim.Name.Thread_copyCurrent => false
+                                      | _ => true)
+                             in
+                                (global, once)
+                             end
+                        | Profile _ => (false, once)
+                        | Raise _ => (false, once)
+                        | Select {tuple, ...} => (isGlobal tuple, once)
+                        | Tuple xs => (areGlobal xs, once)
+                        | Var x => (isGlobal x, once)
+                    val _ = if global then makeGlobal var else ()
+                 in once
+                 end
+            | Fun {decs, ...} =>
+                 (if Vector.isEmpty decs
+                     then ()
+                  else
+                     let
+                        val {lambda, ...} = Vector.sub (decs, 0)
+                     in
+                        if Vector.forall (lambdaFree lambda, varIsGlobal)
+                           then Vector.foreach (decs, makeGlobal o #var)
+                        else ()
+                     end
+                     ; Vector.foreach (decs, loopLambda o #lambda)
+                     ; once)
+            | _ => Error.bug "Globalize.loopDec: strange dec") arg
       and loopLambda (l: Lambda.t): unit =
-	 ignore (loopExp (Lambda.body l, false))
+         ignore (loopExp (Lambda.body l, false))
       val _ = loopExp (body, true)
       val _ = destroyTycon ()
    in

Modified: mlton/branches/on-20050420-cmm-branch/mlton/closure-convert/globalize.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/closure-convert/globalize.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/closure-convert/globalize.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature GLOBALIZE_STRUCTS = 
    sig
       include SXML
@@ -15,8 +16,8 @@
       include GLOBALIZE_STRUCTS
       
       val globalize: {
-		      program: Program.t,
-		      lambdaFree: Lambda.t -> Var.t vector,
-		      varGlobal: Var.t -> bool ref
-		     } -> unit
+                      program: Program.t,
+                      lambdaFree: Lambda.t -> Var.t vector,
+                      varGlobal: Var.t -> bool ref
+                     } -> unit
    end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/closure-convert/lambda-free.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/closure-convert/lambda-free.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/closure-convert/lambda-free.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 functor LambdaFree (S: LAMBDA_FREE_STRUCTS): LAMBDA_FREE = 
 struct
 
@@ -20,122 +21,122 @@
 datatype status = datatype Status.t
 
 fun lambdaFree {program = Program.T {body, ...},
-		overflow: Var.t,
-		varInfo: Var.t -> {frees: Var.t list ref ref,
-				   status: Status.t ref},
-		lambdaInfo: Lambda.t -> {frees: Var.t vector ref,
-					 recs: Var.t vector ref}} =
+                overflow: Var.t,
+                varInfo: Var.t -> {frees: Var.t list ref ref,
+                                   status: Status.t ref},
+                lambdaInfo: Lambda.t -> {frees: Var.t vector ref,
+                                         recs: Var.t vector ref}} =
    let
       fun setFree (l: Lambda.t, xs: Var.t vector): unit =
-	 #frees (lambdaInfo l) := xs
+         #frees (lambdaInfo l) := xs
       fun setRec (l: Lambda.t, xs: Var.t vector): unit =
-	 #recs (lambdaInfo l) := xs
+         #recs (lambdaInfo l) := xs
       type scope = {frees: Var.t list ref,
-		    get: Var.t -> Status.t,
-		    set: Var.t * Status.t -> unit}
+                    get: Var.t -> Status.t,
+                    set: Var.t * Status.t -> unit}
       fun bind (x: Var.t, {set, ...}: scope) = set (x, Bound)
       fun var (x: Var.t, {get, set, frees}: scope) =
-	 case get x of
-	    Unseen => (set (x, Free); List.push (frees, x))
-	  | _ => ()
+         case get x of
+            Unseen => (set (x, Free); List.push (frees, x))
+          | _ => ()
       fun vars (xs, s) = Vector.foreach (xs, fn x => var (x, s))
       fun varExp (x: VarExp.t, s: scope) = var (VarExp.var x, s)
       fun varExpOpt (x, s) =
-	 case x of
-	    NONE => ()
-	  | SOME x => varExp (x, s)
+         case x of
+            NONE => ()
+          | SOME x => varExp (x, s)
       fun varExps (xs, s) = Vector.foreach (xs, fn x => varExp (x, s))
       fun newScope th = 
-	 let
-	    val frees = ref []
-	    val all = ref []
-	    fun statusRef x =
-	       let val {frees = frees', status, ...} = varInfo x
-	       in if frees = !frees'
-		     then ()
-		  else (List.push (all, (frees', !frees', status, !status))
-			; frees' := frees; status := Unseen)
-		     ; status
-	       end
-	    fun get x = !(statusRef x)
-	    fun set (x, s) = statusRef x := s
-	    val _ = th {frees = frees, get = get, set = set}
-	    val _ = List.foreach (!all, fn (r, v, r', v') => (r := v; r' := v'))
-	 in
-	    Vector.fromList (!frees)
-	 end
+         let
+            val frees = ref []
+            val all = ref []
+            fun statusRef x =
+               let val {frees = frees', status, ...} = varInfo x
+               in if frees = !frees'
+                     then ()
+                  else (List.push (all, (frees', !frees', status, !status))
+                        ; frees' := frees; status := Unseen)
+                     ; status
+               end
+            fun get x = !(statusRef x)
+            fun set (x, s) = statusRef x := s
+            val _ = th {frees = frees, get = get, set = set}
+            val _ = List.foreach (!all, fn (r, v, r', v') => (r := v; r' := v'))
+         in
+            Vector.fromList (!frees)
+         end
       fun exp (e, s) =
-	 let val {decs, result} = Exp.dest e
-	 in List.foreach
-	    (decs,
-	     fn Exception _ => ()
-	      | MonoVal {var, exp, ...} => (primExp (exp, s); bind (var, s))
-	      | PolyVal {var, exp = e, ...} => (exp (e, s); bind (var, s))
-	      | Fun {decs, ...} =>
-		   let
-		      val {get = isBound, set, destroy} =
-			 Property.destGetSetOnce (Var.plist,
-						  Property.initConst false)
-		      val _ =
-			 Vector.foreach (decs, fn {var, ...} => set (var, true))
-		      val xs =
-			 newScope
-			 (fn s =>
-			  Vector.foreach
-			  (decs, fn {lambda = l, ...} =>
-			   setRec (l,
-				   Vector.keepAll
-				   (lambda l, fn x =>
-				    if isBound x
-				       then true
-				    else (var (x, s); false)))))
-		      val _ = destroy ()
-		      val _ =
-			 Vector.foreach (decs, fn {var, lambda, ...} =>
-					 (setFree (lambda, xs)
-					  ; bind (var, s)))
-		   in
-		      vars (xs, s)
-		   end)
-	    ; varExp (result, s)
-	 end
+         let val {decs, result} = Exp.dest e
+         in List.foreach
+            (decs,
+             fn Exception _ => ()
+              | MonoVal {var, exp, ...} => (primExp (exp, s); bind (var, s))
+              | PolyVal {var, exp = e, ...} => (exp (e, s); bind (var, s))
+              | Fun {decs, ...} =>
+                   let
+                      val {get = isBound, set, destroy} =
+                         Property.destGetSetOnce (Var.plist,
+                                                  Property.initConst false)
+                      val _ =
+                         Vector.foreach (decs, fn {var, ...} => set (var, true))
+                      val xs =
+                         newScope
+                         (fn s =>
+                          Vector.foreach
+                          (decs, fn {lambda = l, ...} =>
+                           setRec (l,
+                                   Vector.keepAll
+                                   (lambda l, fn x =>
+                                    if isBound x
+                                       then true
+                                    else (var (x, s); false)))))
+                      val _ = destroy ()
+                      val _ =
+                         Vector.foreach (decs, fn {var, lambda, ...} =>
+                                         (setFree (lambda, xs)
+                                          ; bind (var, s)))
+                   in
+                      vars (xs, s)
+                   end)
+            ; varExp (result, s)
+         end
       and primExp (e, s) = 
-	 case e of
-	    App {func, arg} => (varExp (func, s); varExp (arg, s))
-	  | Case {test, cases, default} =>
-	       (varExp (test, s)
-		; Option.app (default, fn (e, _) => exp (e, s))
-		; Cases.foreach' (cases, fn e => exp (e, s),
-				  fn Pat.T {arg, ...} =>
-				  Option.app (arg, fn (x, _) => bind (x, s))))
-	  | ConApp {arg, ...} => varExpOpt (arg, s)
-	  | Const _ => ()
-	  | Handle {try, catch, handler} =>
-	       (exp (try, s); bind (#1 catch, s); exp (handler, s))
-	  | Lambda l =>
-	       let val xs = lambda l
-	       in setFree (l, xs); vars (xs, s)
-	       end
-	  | PrimApp {prim, args, ...} => 
-	       (if Prim.mayOverflow prim
-		  then var (overflow, s)
-		  else ();
-		varExps (args, s))
-	  | Profile _ => ()
-	  | Raise {exn, ...} => varExp (exn, s)
-	  | Select {tuple, ...} => varExp (tuple, s)
-	  | Tuple xs => varExps (xs, s)
-	  | Var x => varExp (x, s)
+         case e of
+            App {func, arg} => (varExp (func, s); varExp (arg, s))
+          | Case {test, cases, default} =>
+               (varExp (test, s)
+                ; Option.app (default, fn (e, _) => exp (e, s))
+                ; Cases.foreach' (cases, fn e => exp (e, s),
+                                  fn Pat.T {arg, ...} =>
+                                  Option.app (arg, fn (x, _) => bind (x, s))))
+          | ConApp {arg, ...} => varExpOpt (arg, s)
+          | Const _ => ()
+          | Handle {try, catch, handler} =>
+               (exp (try, s); bind (#1 catch, s); exp (handler, s))
+          | Lambda l =>
+               let val xs = lambda l
+               in setFree (l, xs); vars (xs, s)
+               end
+          | PrimApp {prim, args, ...} => 
+               (if Prim.mayOverflow prim
+                  then var (overflow, s)
+                  else ();
+                varExps (args, s))
+          | Profile _ => ()
+          | Raise {exn, ...} => varExp (exn, s)
+          | Select {tuple, ...} => varExp (tuple, s)
+          | Tuple xs => varExps (xs, s)
+          | Var x => varExp (x, s)
       and lambda (l: Lambda.t) : Var.t vector =
-	 let val {arg, body, ...} = Lambda.dest l
-	 in newScope (fn s => (bind (arg, s); exp (body, s)))
-	 end
+         let val {arg, body, ...} = Lambda.dest l
+         in newScope (fn s => (bind (arg, s); exp (body, s)))
+         end
       val frees = newScope (fn s => exp (body, s))
       val _ =
-	 if Vector.isEmpty frees
-	    then ()
-	 else Error.bug ("program has free variables: " ^
-			 (Layout.toString (Vector.layout Var.layout frees)))
+         if Vector.isEmpty frees
+            then ()
+         else Error.bug ("LambdaFree.lambdaFree: program has free variables: " ^
+                         (Layout.toString (Vector.layout Var.layout frees)))
    in
       ()
    end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/closure-convert/lambda-free.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/closure-convert/lambda-free.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/closure-convert/lambda-free.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature LAMBDA_FREE_STRUCTS = 
    sig
       include SXML
@@ -15,11 +16,11 @@
       include LAMBDA_FREE_STRUCTS
 
       structure Status:
-	 sig
-	    type t
+         sig
+            type t
 
-	    val init: t
-	 end
+            val init: t
+         end
       (*
        * When called, descends the entire program and attaches a property
        * to each lambda primExp in the program.  Then, you can use
@@ -40,11 +41,11 @@
        * lambdaRec(fn z =>) = [f]
        *)
       val lambdaFree:
-	 {program: Program.t,
-	  overflow: Var.t,
-	  varInfo: Var.t -> {frees: Var.t list ref ref,
-			     status: Status.t ref},
-	  lambdaInfo: Lambda.t -> {frees: Var.t vector ref,
-				   recs: Var.t vector ref}}
-	 -> unit
+         {program: Program.t,
+          overflow: Var.t,
+          varInfo: Var.t -> {frees: Var.t list ref ref,
+                             status: Status.t ref},
+          lambdaInfo: Lambda.t -> {frees: Var.t vector ref,
+                                   recs: Var.t vector ref}}
+         -> unit
    end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/closure-convert/sources.cm
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/closure-convert/sources.cm	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/closure-convert/sources.cm	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 Group
 
 functor ClosureConvert

Modified: mlton/branches/on-20050420-cmm-branch/mlton/closure-convert/sources.mlb
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/closure-convert/sources.mlb	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/closure-convert/sources.mlb	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,25 +1,26 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 local
-    ../../lib/mlton/sources.mlb
-    ../atoms/sources.mlb
-    ../control/sources.mlb
-    ../ssa/sources.mlb
-    ../xml/sources.mlb
+   ../../lib/mlton/sources.mlb
+   ../atoms/sources.mlb
+   ../control/sources.mlb
+   ../ssa/sources.mlb
+   ../xml/sources.mlb
 
-    abstract-value.sig
-    abstract-value.fun
-    globalize.sig
-    globalize.fun
-    lambda-free.sig
-    lambda-free.fun
-    closure-convert.sig
-    closure-convert.fun
+   abstract-value.sig
+   abstract-value.fun
+   globalize.sig
+   globalize.fun
+   lambda-free.sig
+   lambda-free.fun
+   closure-convert.sig
+   closure-convert.fun
 in
-    functor ClosureConvert
+   functor ClosureConvert
 end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/cm/cm.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/cm/cm.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/cm/cm.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature CM =
    sig
       (* cmfile can be relative or absolute.

Modified: mlton/branches/on-20050420-cmm-branch/mlton/cm/cm.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/cm/cm.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/cm/cm.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,9 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 structure CM: CM =
@@ -17,77 +17,77 @@
       (* The files in seen are absolute. *)
       val seen = String.memoize (fn _ => ref false)
       fun loop (cmfile: File.t,
-		nesting: int,
-		relativize: Dir.t option): unit =
-	 let
-	    val relativize =
-	       case relativize of
-		  NONE => NONE
-		| _ => if OS.Path.isAbsolute cmfile
-			  then NONE
-		       else relativize
-	    val {dir, file} = OS.Path.splitDirFile cmfile
-	 in
-	    Dir.inDir
-	    (if dir = "" then "." else dir, fn () =>
-		let
-		   val cwd = Dir.current ()
-		   fun abs f = OS.Path.mkAbsolute {path = f, relativeTo = cwd}
-		   fun finalize f =
-		      case relativize of
-			 NONE => abs f
-		       | SOME d =>
-			    OS.Path.mkRelative {path = f,
-						relativeTo = d}
-		   fun region () =
-		      let
-			 val sourcePos =
-			    SourcePos.make {column = 0,
-					    file = finalize cmfile,
-					    line = 0}
-		      in
-			 Region.make {left = sourcePos, right = sourcePos}
-		      end
-		   fun fail msg =
-		      Control.error (region (), Layout.str msg, Layout.empty)
-		   datatype z = datatype Parse.result
-		in
-		   case Parse.parse {cmfile = file} of
-		      Alias f =>
-			 if nesting > maxAliasNesting
-			    then fail "alias nesting too deep."
-			 else loop (f, nesting + 1, relativize)
-		    | Bad s => fail (concat ["bad CM file: ", s])
-		    | Members members =>
-			 List.foreach
-			 (members, fn m =>
-			  let
-			     val m' = abs m
-			     val seen = seen m'
-			  in
-			     if !seen
-				then ()
-			     else let
-				     val _ = seen := true
-				     fun sml () =
-					List.push (files, finalize m')
-				  in
-				     Control.checkFile
-				     (m, fail, fn () =>
-				      case File.suffix m of
-					 SOME "cm" =>
-					    loop (m, 0, relativize)
-				       | SOME "sml" => sml ()
-				       | SOME "sig" => sml ()
-				       | SOME "fun" => sml ()
-				       | SOME "ML" => sml ()
-				       | _ =>
-					    fail (concat ["MLton can't process ",
-							  m]))
-				  end
-			  end)
-		end)
-	 end 
+                nesting: int,
+                relativize: Dir.t option): unit =
+         let
+            val relativize =
+               case relativize of
+                  NONE => NONE
+                | _ => if OS.Path.isAbsolute cmfile
+                          then NONE
+                       else relativize
+            val {dir, file} = OS.Path.splitDirFile cmfile
+         in
+            Dir.inDir
+            (if dir = "" then "." else dir, fn () =>
+                let
+                   val cwd = Dir.current ()
+                   fun abs f = OS.Path.mkAbsolute {path = f, relativeTo = cwd}
+                   fun finalize f =
+                      case relativize of
+                         NONE => abs f
+                       | SOME d =>
+                            OS.Path.mkRelative {path = f,
+                                                relativeTo = d}
+                   fun region () =
+                      let
+                         val sourcePos =
+                            SourcePos.make {column = 0,
+                                            file = finalize cmfile,
+                                            line = 0}
+                      in
+                         Region.make {left = sourcePos, right = sourcePos}
+                      end
+                   fun fail msg =
+                      Control.error (region (), Layout.str msg, Layout.empty)
+                   datatype z = datatype Parse.result
+                in
+                   case Parse.parse {cmfile = file} of
+                      Alias f =>
+                         if nesting > maxAliasNesting
+                            then fail "alias nesting too deep."
+                         else loop (f, nesting + 1, relativize)
+                    | Bad s => fail (concat ["bad CM file: ", s])
+                    | Members members =>
+                         List.foreach
+                         (members, fn m =>
+                          let
+                             val m' = abs m
+                             val seen = seen m'
+                          in
+                             if !seen
+                                then ()
+                             else let
+                                     val _ = seen := true
+                                     fun sml () =
+                                        List.push (files, finalize m')
+                                  in
+                                     Control.checkFile
+                                     (m, fail, fn () =>
+                                      case File.suffix m of
+                                         SOME "cm" =>
+                                            loop (m, 0, relativize)
+                                       | SOME "sml" => sml ()
+                                       | SOME "sig" => sml ()
+                                       | SOME "fun" => sml ()
+                                       | SOME "ML" => sml ()
+                                       | _ =>
+                                            fail (concat ["MLton can't process ",
+                                                          m]))
+                                  end
+                          end)
+                end)
+         end 
       val d = Dir.current ()
       val _ = loop (cmfile, 0, SOME d)
       val files = rev (!files)

Modified: mlton/branches/on-20050420-cmm-branch/mlton/cm/lexer.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/cm/lexer.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/cm/lexer.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,6 @@
-(* Copyright (C) 2004 Henry Cejtin, Matthew Fluet, Suresh
- *    Jagannathan, and Stephen Weeks.
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
- *)
-(* Based on the file entity/lexer.sig in the SML/NJ CM sources.
- *
+(* Based on the file entity/lexer.sig in the SML/NJ CM sources. *)
+
+(*
  * entity/lexer.sig: lexical analysis of description files
  *
  *   Copyright (c) 1995 by AT&T Bell Laboratories
@@ -19,7 +15,7 @@
     exception UserError of string * string
 
     datatype keyword =
-	K_GROUP | K_LIBRARY | K_ALIAS | K_IS
+        K_GROUP | K_LIBRARY | K_ALIAS | K_IS
       | K_SIGNATURE | K_STRUCTURE | K_FUNSIG | K_FUNCTOR
       | K_IF | K_ELIF | K_ELSE | K_ENDIF | K_DEFINED
       | K_ERROR
@@ -31,7 +27,7 @@
     datatype compare = C_LT | C_LE | C_GT | C_GE | C_EQ | C_NE
 
     datatype token =
-	T_COLON
+        T_COLON
       | T_HASH
       | T_KEYWORD of keyword
       | T_SYMBOL of string
@@ -51,12 +47,12 @@
     val MEMBERS: mode
 
     val lexer: {
-		strdef: string -> bool,
-		sigdef: string -> bool,
-		fctdef: string -> bool,
-		fsigdef: string -> bool,
-		symval: string -> int option
-	       } ->
-	string * In.t -> mode -> token
+                strdef: string -> bool,
+                sigdef: string -> bool,
+                fctdef: string -> bool,
+                fsigdef: string -> bool,
+                symval: string -> int option
+               } ->
+        string * In.t -> mode -> token
 
 end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/cm/lexer.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/cm/lexer.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/cm/lexer.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,6 @@
-(* Copyright (C) 2004 Henry Cejtin, Matthew Fluet, Suresh
- *    Jagannathan, and Stephen Weeks.
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
- *)
-(* Based on the file entity/lexer.sml in the SML/NJ CM sources.
- *
+(* Based on the file entity/lexer.sml in the SML/NJ CM sources. *)
+
+(*
  * entity/lexer.sml: lexical analysis of description files
  *
  *   Copyright (c) 1995 by AT&T Bell Laboratories
@@ -19,7 +15,7 @@
     exception LexerBug
 
     datatype keyword =
-	K_GROUP | K_LIBRARY | K_ALIAS | K_IS
+        K_GROUP | K_LIBRARY | K_ALIAS | K_IS
       | K_SIGNATURE | K_STRUCTURE | K_FUNSIG | K_FUNCTOR
       | K_IF | K_ELIF | K_ELSE | K_ENDIF | K_DEFINED
       | K_ERROR
@@ -31,7 +27,7 @@
     datatype compare = C_LT | C_LE | C_GT | C_GE | C_EQ | C_NE
 
     datatype token =
-	T_COLON
+        T_COLON
       | T_HASH
       | T_KEYWORD of keyword
       | T_SYMBOL of string
@@ -49,495 +45,495 @@
 
     fun lexer { strdef, sigdef, fctdef, fsigdef, symval } (fname, stream) = let
 
-	fun lexerr s = raise LexicalError (fname, s)
-	fun synerr s = raise SyntaxError (fname, s)
-	fun usererr s = raise UserError (fname, s)
+        fun lexerr s = raise LexicalError (fname, s)
+        fun synerr s = raise SyntaxError (fname, s)
+        fun usererr s = raise UserError (fname, s)
 
-	val lookahead: char list ref = ref []
+        val lookahead: char list ref = ref []
 
-	fun getc () =
-	    case !lookahead of
-		[] => let
-		    val new = String.explode (In.input stream)
-		in
-		    case new of
-			[] => NONE
-		      | h :: t => (lookahead := t; SOME h)
-		end
-	      | h :: t => (lookahead := t; SOME h)
+        fun getc () =
+            case !lookahead of
+                [] => let
+                    val new = String.explode (In.input stream)
+                in
+                    case new of
+                        [] => NONE
+                      | h :: t => (lookahead := t; SOME h)
+                end
+              | h :: t => (lookahead := t; SOME h)
 
-	fun ungetc c = (lookahead := (c :: (!lookahead)))
+        fun ungetc c = (lookahead := (c :: (!lookahead)))
 
-	fun skip_white mode = let
+        fun skip_white mode = let
 
-	    fun skip_scheme_comment () =
-		case getc () of
-		    NONE => ()
-		  | SOME #"\n" => (ungetc #"\n")
-		  | _ => skip_scheme_comment ()
+            fun skip_scheme_comment () =
+                case getc () of
+                    NONE => ()
+                  | SOME #"\n" => (ungetc #"\n")
+                  | _ => skip_scheme_comment ()
 
-	    fun skip_ml_comment () = let
-		fun incomplete () = lexerr "incomplete ML-style comment"
-	    in
-		case getc () of
-		    SOME #"*" =>
-			(case getc () of
-			     SOME #")" => ()
-			   | NONE => incomplete ()
-			   | SOME c => (ungetc c; skip_ml_comment ()))
-		  | SOME #"(" => 
-			(case getc () of
-			     SOME #"*" =>
-				 (skip_ml_comment (); skip_ml_comment ())
-			   | NONE => incomplete ()
-			   | SOME c => (ungetc c; skip_ml_comment ()))
-	        (*| SOME #";" => (skip_scheme_comment (); skip_ml_comment ())*)
-		  | NONE => incomplete ()
-		  | SOME _ => skip_ml_comment ()
-	    end
+            fun skip_ml_comment () = let
+                fun incomplete () = lexerr "incomplete ML-style comment"
+            in
+                case getc () of
+                    SOME #"*" =>
+                        (case getc () of
+                             SOME #")" => ()
+                           | NONE => incomplete ()
+                           | SOME c => (ungetc c; skip_ml_comment ()))
+                  | SOME #"(" => 
+                        (case getc () of
+                             SOME #"*" =>
+                                 (skip_ml_comment (); skip_ml_comment ())
+                           | NONE => incomplete ()
+                           | SOME c => (ungetc c; skip_ml_comment ()))
+                (*| SOME #";" => (skip_scheme_comment (); skip_ml_comment ())*)
+                  | NONE => incomplete ()
+                  | SOME _ => skip_ml_comment ()
+            end
 
-	    fun skip () = let
-		fun done () = ()
-		fun preproc_nl thunk =
-		    (if mode = PREPROC orelse mode = ERRORMSG then
-			 ungetc #"\n"
-		     else thunk ())
-	    in
-		case getc () of
-		    NONE => ()
-		  | SOME #";" => (skip_scheme_comment (); skip ())
-		  | SOME #"\n" =>
-			(case getc () of
-			     NONE => preproc_nl done
-			   | SOME #"#" => (ungetc #"#"; preproc_nl done)
-			   | SOME c => (ungetc c; preproc_nl skip))
-		  | SOME #"(" =>
-			(case getc () of
-			     NONE => ungetc #"("
-			   | SOME #"*" => (skip_ml_comment (); skip ())
-			   | SOME c => (ungetc c; ungetc #"("))
-		  | SOME c =>
-			if Char.isSpace c then skip () else ungetc c
-	    end
-	in
-	    skip
-	end
+            fun skip () = let
+                fun done () = ()
+                fun preproc_nl thunk =
+                    (if mode = PREPROC orelse mode = ERRORMSG then
+                         ungetc #"\n"
+                     else thunk ())
+            in
+                case getc () of
+                    NONE => ()
+                  | SOME #";" => (skip_scheme_comment (); skip ())
+                  | SOME #"\n" =>
+                        (case getc () of
+                             NONE => preproc_nl done
+                           | SOME #"#" => (ungetc #"#"; preproc_nl done)
+                           | SOME c => (ungetc c; preproc_nl skip))
+                  | SOME #"(" =>
+                        (case getc () of
+                             NONE => ungetc #"("
+                           | SOME #"*" => (skip_ml_comment (); skip ())
+                           | SOME c => (ungetc c; ungetc #"("))
+                  | SOME c =>
+                        if Char.isSpace c then skip () else ungetc c
+            end
+        in
+            skip
+        end
 
-	fun rawlex mode = let
+        fun rawlex mode = let
 
-	    val skip = skip_white mode
+            val skip = skip_white mode
 
-	    fun getc_nonwhite () = (skip (); getc ())
+            fun getc_nonwhite () = (skip (); getc ())
 
-	    fun getnum c = let
-		fun loop (n, c) = let
-		    val n = 10 * n + Char.ord c - Char.ord #"0"
-		in
-		    case getc () of
-			NONE => n
-		      | SOME c => if Char.isDigit c then loop (n, c)
-				  else (ungetc c; n)
-		end
-	    in
-		loop (0, c) handle Overflow => lexerr "arithmetic overflow"
-	    end
+            fun getnum c = let
+                fun loop (n, c) = let
+                    val n = 10 * n + Char.ord c - Char.ord #"0"
+                in
+                    case getc () of
+                        NONE => n
+                      | SOME c => if Char.isDigit c then loop (n, c)
+                                  else (ungetc c; n)
+                end
+            in
+                loop (0, c) handle Overflow => lexerr "arithmetic overflow"
+            end
 
-	    fun expect (c, t) =
-		if getc () = SOME c then t
-		else lexerr (concat ["expecting ", String.implode [c]])
+            fun expect (c, t) =
+                if getc () = SOME c then t
+                else lexerr (concat ["expecting ", String.implode [c]])
 
-	    fun ifnext (c, ty, tn) =
-		case getc () of
-		    NONE => tn
-		  | SOME c1 =>
-			if c = c1 then ty else (ungetc c1; tn)
+            fun ifnext (c, ty, tn) =
+                case getc () of
+                    NONE => tn
+                  | SOME c1 =>
+                        if c = c1 then ty else (ungetc c1; tn)
 
-	    fun getsym (c, delim) = let
-		fun loop (accu, c) = let
-		    val accu = c :: accu
-		in
-		    case getc () of
-			NONE => String.implode (rev accu)
-		      | SOME c =>
-			    if Char.isSpace c orelse String.contains(delim, c)
-			       then (ungetc c; String.implode (rev accu))
-			    else loop (accu, c)
-		end
-	    in
-		loop ([], c)
-	    end
+            fun getsym (c, delim) = let
+                fun loop (accu, c) = let
+                    val accu = c :: accu
+                in
+                    case getc () of
+                        NONE => String.implode (rev accu)
+                      | SOME c =>
+                            if Char.isSpace c orelse String.contains(delim, c)
+                               then (ungetc c; String.implode (rev accu))
+                            else loop (accu, c)
+                end
+            in
+                loop ([], c)
+            end
 
-	    fun getline c = let
-		fun loop accu =
-		    case getc () of
-			NONE => String.implode (rev accu)
-		      | SOME #"\n" => String.implode (rev accu)
-		      | SOME c => loop (c :: accu)
-	    in
-		loop [c]
-	    end
+            fun getline c = let
+                fun loop accu =
+                    case getc () of
+                        NONE => String.implode (rev accu)
+                      | SOME #"\n" => String.implode (rev accu)
+                      | SOME c => loop (c :: accu)
+            in
+                loop [c]
+            end
 
-	    val preproc_delim = "():;#+-*/%&!|><="
-	    val non_preproc_delim = "():;#"
+            val preproc_delim = "():;#+-*/%&!|><="
+            val non_preproc_delim = "():;#"
 
-	    fun preproc_sym "if" = T_KEYWORD K_IF
-	      | preproc_sym "elif" = T_KEYWORD K_ELIF
-	      | preproc_sym "else" = T_KEYWORD K_ELSE
-	      | preproc_sym "endif" = T_KEYWORD K_ENDIF
-	      | preproc_sym "defined" = T_KEYWORD K_DEFINED
-	      | preproc_sym "structure" = T_KEYWORD K_STRUCTURE
-	      | preproc_sym "signature" = T_KEYWORD K_SIGNATURE
-	      | preproc_sym "functor" = T_KEYWORD K_FUNCTOR
-	      | preproc_sym "funsig" = T_KEYWORD K_FUNSIG
-	      | preproc_sym "error" = T_KEYWORD K_ERROR
-	      | preproc_sym s = T_SYMBOL s
+            fun preproc_sym "if" = T_KEYWORD K_IF
+              | preproc_sym "elif" = T_KEYWORD K_ELIF
+              | preproc_sym "else" = T_KEYWORD K_ELSE
+              | preproc_sym "endif" = T_KEYWORD K_ENDIF
+              | preproc_sym "defined" = T_KEYWORD K_DEFINED
+              | preproc_sym "structure" = T_KEYWORD K_STRUCTURE
+              | preproc_sym "signature" = T_KEYWORD K_SIGNATURE
+              | preproc_sym "functor" = T_KEYWORD K_FUNCTOR
+              | preproc_sym "funsig" = T_KEYWORD K_FUNSIG
+              | preproc_sym "error" = T_KEYWORD K_ERROR
+              | preproc_sym s = T_SYMBOL s
 
-	    fun normal_sym "group" = T_KEYWORD K_GROUP
-	      | normal_sym "Group" = T_KEYWORD K_GROUP
-	      | normal_sym "GROUP" = T_KEYWORD K_GROUP
-	      | normal_sym "library" = T_KEYWORD K_LIBRARY
-	      | normal_sym "Library" = T_KEYWORD K_LIBRARY
-	      | normal_sym "LIBRARY" = T_KEYWORD K_LIBRARY
-	      | normal_sym "alias" = T_KEYWORD K_ALIAS
-	      | normal_sym "Alias" = T_KEYWORD K_ALIAS
-	      | normal_sym "ALIAS" = T_KEYWORD K_ALIAS
-	      | normal_sym "is" = T_KEYWORD K_IS
-	      | normal_sym "IS" = T_KEYWORD K_IS
-	      | normal_sym "structure" = T_KEYWORD K_STRUCTURE
-	      | normal_sym "signature" = T_KEYWORD K_SIGNATURE
-	      | normal_sym "functor" = T_KEYWORD K_FUNCTOR
-	      | normal_sym "funsig" = T_KEYWORD K_FUNSIG
-	      | normal_sym s = T_SYMBOL s
+            fun normal_sym "group" = T_KEYWORD K_GROUP
+              | normal_sym "Group" = T_KEYWORD K_GROUP
+              | normal_sym "GROUP" = T_KEYWORD K_GROUP
+              | normal_sym "library" = T_KEYWORD K_LIBRARY
+              | normal_sym "Library" = T_KEYWORD K_LIBRARY
+              | normal_sym "LIBRARY" = T_KEYWORD K_LIBRARY
+              | normal_sym "alias" = T_KEYWORD K_ALIAS
+              | normal_sym "Alias" = T_KEYWORD K_ALIAS
+              | normal_sym "ALIAS" = T_KEYWORD K_ALIAS
+              | normal_sym "is" = T_KEYWORD K_IS
+              | normal_sym "IS" = T_KEYWORD K_IS
+              | normal_sym "structure" = T_KEYWORD K_STRUCTURE
+              | normal_sym "signature" = T_KEYWORD K_SIGNATURE
+              | normal_sym "functor" = T_KEYWORD K_FUNCTOR
+              | normal_sym "funsig" = T_KEYWORD K_FUNSIG
+              | normal_sym s = T_SYMBOL s
 
-	    fun string () = let
-		fun collect l =
-		    case getc () of
-			NONE => lexerr "missing string delimiter"
-		      | SOME #"\"" =>
-			    (case getc () of
-				 SOME #"\"" => collect (#"\"" :: l)
-		               | SOME c => (ungetc c; String.implode (rev l))
-			       | NONE => String.implode (rev l))
-		      | SOME c => collect (c :: l)
-	    in
-		collect []
-	    end
+            fun string () = let
+                fun collect l =
+                    case getc () of
+                        NONE => lexerr "missing string delimiter"
+                      | SOME #"\"" =>
+                            (case getc () of
+                                 SOME #"\"" => collect (#"\"" :: l)
+                               | SOME c => (ungetc c; String.implode (rev l))
+                               | NONE => String.implode (rev l))
+                      | SOME c => collect (c :: l)
+            in
+                collect []
+            end
 
-	in
-	  if mode = ERRORMSG then
-	      T_SYMBOL (case getc_nonwhite () of
-			    NONE => "error"
-			  | SOME #"\n" => "error"
-			  | SOME c => getline c)
-	  else
-	    case getc_nonwhite () of
-		NONE => T_EOF
-	      | SOME #":" => T_COLON
-	      | SOME #"\n" => T_NL
-	      | SOME #"#" => T_HASH
-	      | SOME #"\"" =>
-		    (case mode of
-			 NORMAL => T_STRING (string ())
-		       | MEMBERS => T_STRING (string ())
-		       | _ => 
-			     synerr "quoted string in wrong context")
-	      | SOME c =>
-		    if mode = PREPROC then
-			case c of
-			    #"(" => T_LPAREN
-			  | #")" => T_RPAREN
-			  | #"+" => T_ARITH A_PLUS
-			  | #"-" => T_ARITH A_MINUS
-			  | #"*" => T_ARITH A_TIMES
-			  | #"/" => T_ARITH A_DIV
-			  | #"%" => T_ARITH A_MOD
-			  | #"&" => expect (#"&", T_LCONN L_AND)
-			  | #"|" => expect (#"|", T_LCONN L_OR)
-			  | #"!" =>
-				ifnext (#"=", T_COMPARE C_NE, T_LCONN L_NOT)
-			  | #">" =>
-				ifnext (#"=", T_COMPARE C_GE, T_COMPARE C_GT)
-			  | #"<" =>
-				ifnext (#"=", T_COMPARE C_LE, T_COMPARE C_LT)
-			  | #"=" => expect (#"=", T_COMPARE C_EQ)
-			  | _ =>
-				if Char.isDigit c then
-				    T_NUMBER (getnum c)
-				else if Char.isAlpha c then
-				    preproc_sym (getsym (c, preproc_delim))
-				else
-				    synerr "illegal preprocessor line"
-		    else let
-			val s = getsym (c, non_preproc_delim)
-		    in
-			if mode = NORMAL then
-			    normal_sym s
-			else
-			    T_SYMBOL s
-		    end
-	end
+        in
+          if mode = ERRORMSG then
+              T_SYMBOL (case getc_nonwhite () of
+                            NONE => "error"
+                          | SOME #"\n" => "error"
+                          | SOME c => getline c)
+          else
+            case getc_nonwhite () of
+                NONE => T_EOF
+              | SOME #":" => T_COLON
+              | SOME #"\n" => T_NL
+              | SOME #"#" => T_HASH
+              | SOME #"\"" =>
+                    (case mode of
+                         NORMAL => T_STRING (string ())
+                       | MEMBERS => T_STRING (string ())
+                       | _ => 
+                             synerr "quoted string in wrong context")
+              | SOME c =>
+                    if mode = PREPROC then
+                        case c of
+                            #"(" => T_LPAREN
+                          | #")" => T_RPAREN
+                          | #"+" => T_ARITH A_PLUS
+                          | #"-" => T_ARITH A_MINUS
+                          | #"*" => T_ARITH A_TIMES
+                          | #"/" => T_ARITH A_DIV
+                          | #"%" => T_ARITH A_MOD
+                          | #"&" => expect (#"&", T_LCONN L_AND)
+                          | #"|" => expect (#"|", T_LCONN L_OR)
+                          | #"!" =>
+                                ifnext (#"=", T_COMPARE C_NE, T_LCONN L_NOT)
+                          | #">" =>
+                                ifnext (#"=", T_COMPARE C_GE, T_COMPARE C_GT)
+                          | #"<" =>
+                                ifnext (#"=", T_COMPARE C_LE, T_COMPARE C_LT)
+                          | #"=" => expect (#"=", T_COMPARE C_EQ)
+                          | _ =>
+                                if Char.isDigit c then
+                                    T_NUMBER (getnum c)
+                                else if Char.isAlpha c then
+                                    preproc_sym (getsym (c, preproc_delim))
+                                else
+                                    synerr "illegal preprocessor line"
+                    else let
+                        val s = getsym (c, non_preproc_delim)
+                    in
+                        if mode = NORMAL then
+                            normal_sym s
+                        else
+                            T_SYMBOL s
+                    end
+        end
 
-	val lex = let
+        val lex = let
 
-	    val lookahead: token list ref = ref []
+            val lookahead: token list ref = ref []
 
-	    fun gett () =
-		case !lookahead of
-		    [] => rawlex PREPROC
-		  | (h :: t) => (lookahead := t; h)
+            fun gett () =
+                case !lookahead of
+                    [] => rawlex PREPROC
+                  | (h :: t) => (lookahead := t; h)
 
-	    fun ungett t = lookahead := (t :: (!lookahead))
+            fun ungett t = lookahead := (t :: (!lookahead))
 
-	    fun leftrec (f, tokf) = let
-		fun loop accu = let
-		    val nt = gett ()
-		in
-		    case tokf nt of
-			NONE => (ungett nt; accu)
-		      | SOME c => loop (c (accu, f ()))
-		end
-	    in
-		loop (f ())
-	    end
+            fun leftrec (f, tokf) = let
+                fun loop accu = let
+                    val nt = gett ()
+                in
+                    case tokf nt of
+                        NONE => (ungett nt; accu)
+                      | SOME c => loop (c (accu, f ()))
+                end
+            in
+                loop (f ())
+            end
 
-	    fun nonassoc (f, tokf) = let
-		val lhs = f ()
-		val nt = gett ()
-	    in
-		case tokf nt of
-		    NONE => (ungett nt; lhs)
-		  | SOME c => c (lhs, f ())
-	    end
+            fun nonassoc (f, tokf) = let
+                val lhs = f ()
+                val nt = gett ()
+            in
+                case tokf nt of
+                    NONE => (ungett nt; lhs)
+                  | SOME c => c (lhs, f ())
+            end
 
-	    fun expect (t, m) =
-		if gett () = t then () else synerr (concat ["missing ", m])
+            fun expect (t, m) =
+                if gett () = t then () else synerr (concat ["missing ", m])
 
-	    fun intbool f (x: unit -> int, y: unit -> int) =
-		fn () => if f (x (), y ()) then 1 else 0
+            fun intbool f (x: unit -> int, y: unit -> int) =
+                fn () => if f (x (), y ()) then 1 else 0
 
-	    fun orf (x, y) =
-		fn () => if (x () <> 0) orelse (y () <> 0) then 1 else 0
-	    fun andf (x, y) =
-		fn () => if (x () <> 0) andalso (y () <> 0) then 1 else 0
-	    fun notf x = fn () => if x () <> 0 then 0 else 1
-	    val eqf = intbool (op =)
-	    val nef = intbool (op <>)
-	    val gtf = intbool (op >)
-	    val gef = intbool (op >=)
-	    val ltf = intbool (op <)
-	    val lef = intbool (op <=)
+            fun orf (x, y) =
+                fn () => if (x () <> 0) orelse (y () <> 0) then 1 else 0
+            fun andf (x, y) =
+                fn () => if (x () <> 0) andalso (y () <> 0) then 1 else 0
+            fun notf x = fn () => if x () <> 0 then 0 else 1
+            val eqf = intbool (op =)
+            val nef = intbool (op <>)
+            val gtf = intbool (op >)
+            val gef = intbool (op >=)
+            val ltf = intbool (op <)
+            val lef = intbool (op <=)
 
-	    fun binaryf binop (x: unit -> int, y: unit -> int) =
-		fn () => (binop (x (), y ()))
-	    fun unaryf uop (x: unit -> int) =
-		fn () => uop (x ())
+            fun binaryf binop (x: unit -> int, y: unit -> int) =
+                fn () => (binop (x (), y ()))
+            fun unaryf uop (x: unit -> int) =
+                fn () => uop (x ())
 
-	    val plusf = binaryf (op +)
-	    val minusf = binaryf (op -)
-	    val timesf = binaryf (op * )
-	    val divf = binaryf (op div)
-	    val modf = binaryf (op mod)
-	    val negatef = unaryf ~
+            val plusf = binaryf (op +)
+            val minusf = binaryf (op -)
+            val timesf = binaryf (op * )
+            val divf = binaryf (op div)
+            val modf = binaryf (op mod)
+            val negatef = unaryf ~
 
-	    fun expression () = disjunction ()
+            fun expression () = disjunction ()
 
-	    and disjunction () = let
-		fun tokf (T_LCONN L_OR) = SOME orf
-		  | tokf _ = NONE
-	    in
-		leftrec (conjunction, tokf)
-	    end
+            and disjunction () = let
+                fun tokf (T_LCONN L_OR) = SOME orf
+                  | tokf _ = NONE
+            in
+                leftrec (conjunction, tokf)
+            end
 
-	    and conjunction () = let
-		fun tokf (T_LCONN L_AND) = SOME andf
-		  | tokf _ = NONE
-	    in
-		leftrec (equivalence, tokf)
-	    end
+            and conjunction () = let
+                fun tokf (T_LCONN L_AND) = SOME andf
+                  | tokf _ = NONE
+            in
+                leftrec (equivalence, tokf)
+            end
 
-	    and equivalence () = let
-		fun tokf (T_COMPARE C_EQ) = SOME eqf
-		  | tokf (T_COMPARE C_NE) = SOME nef
-		  | tokf _ = NONE
-	    in
-		nonassoc (comparison, tokf)
-	    end
+            and equivalence () = let
+                fun tokf (T_COMPARE C_EQ) = SOME eqf
+                  | tokf (T_COMPARE C_NE) = SOME nef
+                  | tokf _ = NONE
+            in
+                nonassoc (comparison, tokf)
+            end
 
-	    and comparison () = let
-		fun tokf (T_COMPARE C_GT) = SOME gtf
-		  | tokf (T_COMPARE C_GE) = SOME gef
-		  | tokf (T_COMPARE C_LT) = SOME ltf
-		  | tokf (T_COMPARE C_LE) = SOME lef
-		  | tokf _ = NONE
-	    in
-		nonassoc (sum, tokf)
-	    end
+            and comparison () = let
+                fun tokf (T_COMPARE C_GT) = SOME gtf
+                  | tokf (T_COMPARE C_GE) = SOME gef
+                  | tokf (T_COMPARE C_LT) = SOME ltf
+                  | tokf (T_COMPARE C_LE) = SOME lef
+                  | tokf _ = NONE
+            in
+                nonassoc (sum, tokf)
+            end
 
-	    and sum () = let
-		fun tokf (T_ARITH A_PLUS) = SOME plusf
-		  | tokf (T_ARITH A_MINUS) = SOME minusf
-		  | tokf _ = NONE
-	    in
-		leftrec (product, tokf)
-	    end
+            and sum () = let
+                fun tokf (T_ARITH A_PLUS) = SOME plusf
+                  | tokf (T_ARITH A_MINUS) = SOME minusf
+                  | tokf _ = NONE
+            in
+                leftrec (product, tokf)
+            end
 
-	    and product () = let
-		fun tokf (T_ARITH A_TIMES) = SOME timesf
-		  | tokf (T_ARITH A_DIV) = SOME divf
-		  | tokf (T_ARITH A_MOD) = SOME modf
-		  | tokf _ = NONE
-	    in
-		leftrec (unary, tokf)
-	    end
+            and product () = let
+                fun tokf (T_ARITH A_TIMES) = SOME timesf
+                  | tokf (T_ARITH A_DIV) = SOME divf
+                  | tokf (T_ARITH A_MOD) = SOME modf
+                  | tokf _ = NONE
+            in
+                leftrec (unary, tokf)
+            end
 
-	    and unary () =
-		case gett () of
-		    T_LCONN L_NOT => notf (unary ())
-		  | T_ARITH A_MINUS => negatef (unary ())
-		  | nt => (ungett nt; primary ())
+            and unary () =
+                case gett () of
+                    T_LCONN L_NOT => notf (unary ())
+                  | T_ARITH A_MINUS => negatef (unary ())
+                  | nt => (ungett nt; primary ())
 
-	    and primary () =
-		case gett () of
-		    T_LPAREN =>
-			expression ()
-			before expect (T_RPAREN, "right parenthesis")
-		  | T_NUMBER n => (fn () => n)
-		  | T_SYMBOL s =>
-			(fn () =>
-			 (case symval s of
-			      NONE => synerr (concat ["undefined symbol: ", s])
-			    | SOME v => v))
-		  | T_KEYWORD K_DEFINED => let
-			val _ = expect (T_LPAREN, "left parenthesis")
-		    in
-			case gett () of
-			    T_KEYWORD k => let
-				val look =
-				    case k of
-					K_STRUCTURE => strdef
-				      | K_SIGNATURE => sigdef
-				      | K_FUNCTOR => fctdef
-				      | K_FUNSIG => fsigdef
-				      | _ => synerr "unexpected keyword"
-			    in
-				case gett () of
-				    T_SYMBOL s =>
-					(expect (T_RPAREN,
-						 "right parenthesis");
-					 fn () => if look s then 1 else 0)
-				  | _ => synerr "missing symbol"
-			    end
-			  | T_SYMBOL s =>
-				(expect (T_RPAREN, "right parenthesis");
-				 fn () => (case symval s of
-					       NONE => 0
-					     | SOME _ => 1))
-			  | _ => synerr "illegal `defined' construct"
-		    end
-		  | _ => synerr "unexpected token"
+            and primary () =
+                case gett () of
+                    T_LPAREN =>
+                        expression ()
+                        before expect (T_RPAREN, "right parenthesis")
+                  | T_NUMBER n => (fn () => n)
+                  | T_SYMBOL s =>
+                        (fn () =>
+                         (case symval s of
+                              NONE => synerr (concat ["undefined symbol: ", s])
+                            | SOME v => v))
+                  | T_KEYWORD K_DEFINED => let
+                        val _ = expect (T_LPAREN, "left parenthesis")
+                    in
+                        case gett () of
+                            T_KEYWORD k => let
+                                val look =
+                                    case k of
+                                        K_STRUCTURE => strdef
+                                      | K_SIGNATURE => sigdef
+                                      | K_FUNCTOR => fctdef
+                                      | K_FUNSIG => fsigdef
+                                      | _ => synerr "unexpected keyword"
+                            in
+                                case gett () of
+                                    T_SYMBOL s =>
+                                        (expect (T_RPAREN,
+                                                 "right parenthesis");
+                                         fn () => if look s then 1 else 0)
+                                  | _ => synerr "missing symbol"
+                            end
+                          | T_SYMBOL s =>
+                                (expect (T_RPAREN, "right parenthesis");
+                                 fn () => (case symval s of
+                                               NONE => 0
+                                             | SOME _ => 1))
+                          | _ => synerr "illegal `defined' construct"
+                    end
+                  | _ => synerr "unexpected token"
 
-	    datatype localstate =
-		T_C | T | E_C | E
+            datatype localstate =
+                T_C | T | E_C | E
 
-	    datatype cmd =
-		IF of unit -> int
-	      | ELIF of unit -> int
-	      | ELSE
-	      | ENDIF
+            datatype cmd =
+                IF of unit -> int
+              | ELIF of unit -> int
+              | ELSE
+              | ENDIF
 
-	    type state = localstate * bool
+            type state = localstate * bool
 
-	    fun iscopying s =
-		case s of
-		    [] => true
-		  | (_, copying) :: _ => copying
+            fun iscopying s =
+                case s of
+                    [] => true
+                  | (_, copying) :: _ => copying
 
-	    fun transform (IF c, s) =
-		if iscopying s andalso c () <> 0 then
-		    (T_C, true) :: s
-		else
-		    (T, false) :: s
-	      | transform (ELIF _, (T_C, _) :: s) = (T_C, false) :: s
-	      | transform (ELIF c, (T, _) :: s) =
-		if iscopying s andalso c () <> 0 then
-		    (T_C, true) :: s
-		else
-		    (T, false) :: s
-	      | transform (ELIF _, _) = synerr "unexpected #elif"
-	      | transform (ELSE, (T_C, _) :: s) = (E, false) :: s
-	      | transform (ELSE, (T, _) :: s) = (E_C, iscopying s) :: s
-	      | transform (ELSE, _) = synerr "unexpected #else"
-	      | transform (ENDIF, []) = synerr "unexpected #endif"
-	      | transform (ENDIF, _ :: s) = s
+            fun transform (IF c, s) =
+                if iscopying s andalso c () <> 0 then
+                    (T_C, true) :: s
+                else
+                    (T, false) :: s
+              | transform (ELIF _, (T_C, _) :: s) = (T_C, false) :: s
+              | transform (ELIF c, (T, _) :: s) =
+                if iscopying s andalso c () <> 0 then
+                    (T_C, true) :: s
+                else
+                    (T, false) :: s
+              | transform (ELIF _, _) = synerr "unexpected #elif"
+              | transform (ELSE, (T_C, _) :: s) = (E, false) :: s
+              | transform (ELSE, (T, _) :: s) = (E_C, iscopying s) :: s
+              | transform (ELSE, _) = synerr "unexpected #else"
+              | transform (ENDIF, []) = synerr "unexpected #endif"
+              | transform (ENDIF, _ :: s) = s
 
-	    val state: state list ref = ref []
+            val state: state list ref = ref []
 
-	    fun checklook () =
-		case !lookahead of
-		    [] => ()
-		  | _ => raise LexerBug
+            fun checklook () =
+                case !lookahead of
+                    [] => ()
+                  | _ => raise LexerBug
 
-	    fun condition () = let
-		val e = expression ()
-	    in
-		fn () =>
-		(e ()
-		 handle Overflow => synerr "arithmetic overflow in condition"
-		      | Div => synerr "divide by zero in condition")
-	    end
+            fun condition () = let
+                val e = expression ()
+            in
+                fn () =>
+                (e ()
+                 handle Overflow => synerr "arithmetic overflow in condition"
+                      | Div => synerr "divide by zero in condition")
+            end
 
-	    fun nexttoken mode =
-		case rawlex mode of
-		    T_HASH =>
-			(case rawlex PREPROC of
-			     T_KEYWORD K_IF => let
-				 val c = condition ()
-				 val _ = expect (T_NL, "line break (#if)")
-				 val _ = checklook ()
-			     in
-				 state := transform (IF c, !state);
-				 nexttoken mode
-			     end
-			   | T_KEYWORD K_ELSE =>
-				 (expect (T_NL, "line break (#else)");
-				  checklook ();
-				  state := transform (ELSE, !state);
-				  nexttoken mode)
-			   | T_KEYWORD K_ELIF => let
-				 val c = condition ()
-				 val _ = expect (T_NL, "line break (#elif)")
-				 val _ = checklook ()
-			     in
-				 state := transform (ELIF c, !state);
-				 nexttoken mode
-			     end
-			   | T_KEYWORD K_ENDIF =>
-				 (expect (T_NL, "line break (#endif)");
-				  checklook ();
-				  state := transform (ENDIF, !state);
-				  nexttoken mode)
-			   | T_KEYWORD K_ERROR => let
-				 val msg =
-				     case rawlex ERRORMSG of
-					 T_SYMBOL msg => msg
-				       | _ => raise LexerBug
-			     in
-				 if iscopying (!state) then
-				     usererr msg
-				 else
-				     (checklook (); nexttoken mode)
-			     end
-			   | _ => synerr "illegal preprocessor line")
-		  | T_EOF =>
-			if (!state) = [] then T_EOF
-			else synerr "missing #endif"
-		  | t => if iscopying (!state) then t else nexttoken mode
+            fun nexttoken mode =
+                case rawlex mode of
+                    T_HASH =>
+                        (case rawlex PREPROC of
+                             T_KEYWORD K_IF => let
+                                 val c = condition ()
+                                 val _ = expect (T_NL, "line break (#if)")
+                                 val _ = checklook ()
+                             in
+                                 state := transform (IF c, !state);
+                                 nexttoken mode
+                             end
+                           | T_KEYWORD K_ELSE =>
+                                 (expect (T_NL, "line break (#else)");
+                                  checklook ();
+                                  state := transform (ELSE, !state);
+                                  nexttoken mode)
+                           | T_KEYWORD K_ELIF => let
+                                 val c = condition ()
+                                 val _ = expect (T_NL, "line break (#elif)")
+                                 val _ = checklook ()
+                             in
+                                 state := transform (ELIF c, !state);
+                                 nexttoken mode
+                             end
+                           | T_KEYWORD K_ENDIF =>
+                                 (expect (T_NL, "line break (#endif)");
+                                  checklook ();
+                                  state := transform (ENDIF, !state);
+                                  nexttoken mode)
+                           | T_KEYWORD K_ERROR => let
+                                 val msg =
+                                     case rawlex ERRORMSG of
+                                         T_SYMBOL msg => msg
+                                       | _ => raise LexerBug
+                             in
+                                 if iscopying (!state) then
+                                     usererr msg
+                                 else
+                                     (checklook (); nexttoken mode)
+                             end
+                           | _ => synerr "illegal preprocessor line")
+                  | T_EOF =>
+                        if (!state) = [] then T_EOF
+                        else synerr "missing #endif"
+                  | t => if iscopying (!state) then t else nexttoken mode
 
-	in
-	    nexttoken
-	end
+        in
+            nexttoken
+        end
 
     in
-	lex
+        lex
     end
 end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/cm/parse.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/cm/parse.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/cm/parse.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,14 +1,15 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature PARSE =
    sig
       datatype result =
-	 Alias of File.t
+         Alias of File.t
        | Bad of string (* error message *)
        | Members of File.t list
 

Modified: mlton/branches/on-20050420-cmm-branch/mlton/cm/parse.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/cm/parse.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/cm/parse.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,13 @@
-(* Copyright (C) 2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 2004-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
-(* Based on the file entity/description.sml in the SML/NJ CM sources.
- *
+
+(* Based on the file entity/description.sml in the SML/NJ CM sources. *)
+
+(*
  * entity/description.sml: Entity description file parser.
  *
  *   Copyright (c) 1995 by AT&T Bell Laboratories
@@ -25,103 +28,103 @@
    
 (* The main read function for CM entities. *)
 fun parse {cmfile: string} =
-   DynamicWind.withEscape
+   Exn.withEscape
    (fn escape =>
     let
-       fun bad m = (escape (Bad m); raise Fail "impossible")
+       fun bad m = (ignore (escape (Bad m)); raise Fail "impossible")
     in
        File.withIn
        (cmfile, fn ins =>
-	let
-	   fun no _ = false
-	   val lex =
-	      Lexer.lexer {strdef = no,
-			   sigdef = no,
-			   fctdef = no,
-			   fsigdef = no,
-			   symval = fn _ => NONE}
-	      (cmfile, ins)
-	   val lex =
-	      fn m =>
-	      lex m
-	      handle Lexer.LexicalError (_, s) => bad s
-		   | Lexer.SyntaxError (_, s) => bad s
-		   | Lexer.UserError (_, s) => bad s
-	   val lookahead: Lexer.token list ref = ref []
-	   fun normal () =
-	      case !lookahead of
-		 [] => lex Lexer.NORMAL
-	       | h :: t => (lookahead := t; h)
-	   fun member () =
-	      case !lookahead of
-		 [] => lex Lexer.MEMBERS
-	       | h :: t => (lookahead := t; h)
-	   fun unget t = lookahead := (t :: (!lookahead))
-	   fun readExport () =
-	      let
-		 fun name () =
-		    (case normal () of
-			Lexer.T_SYMBOL _ => ()
-		      | Lexer.T_STRING _ => ()
-		      | _ => bad "missing exported name"
-			   ; SOME ())
-	      in case normal () of
-		 Lexer.T_KEYWORD Lexer.K_SIGNATURE => name ()
-	       | Lexer.T_KEYWORD Lexer.K_STRUCTURE => name ()
-	       | Lexer.T_KEYWORD Lexer.K_FUNCTOR => name ()
-	       | Lexer.T_KEYWORD Lexer.K_FUNSIG => name ()
-	       | x => (unget x; NONE)
-	      end
-	   fun readList readItem =
-	      let
-		 fun loop ac =
-		    case readItem () of
-		       NONE => rev ac
-		     | SOME i => loop (i :: ac)
-	      in loop []
-	      end
-	   fun getFileName () =
-	      case member () of
-		 Lexer.T_SYMBOL name => SOME name
-	       | Lexer.T_STRING name => SOME name
-	       | t => (unget t; NONE)
-	   fun readMember () =
-	      case getFileName () of
-		 NONE => NONE
-	       | SOME f =>
-		    (case member () of
-			Lexer.T_COLON =>
-			   (case member () of
-			       Lexer.T_SYMBOL _ => ()
-			     | Lexer.T_STRING _ => ()
-			     | _ => bad "missing class name")
-		      | t => unget t
-			   ; SOME f)
-	   fun readMembers () =
-	      case normal () of
-		 Lexer.T_KEYWORD Lexer.K_IS =>
-		    (if !lookahead <> [] then fail "Bug in parser" else ()
-			; readList readMember)
-	       | _ => bad "missing keyword 'is'"
-	   fun parseAlias () =
-	      case getFileName () of
-		 NONE => bad "alias name missing"
-	       | SOME f => let val _ = In.close ins
-			   in Alias f
-			   end
-	   fun parseGroup () =
-	      let
-		 val _ = readList readExport
-		 val members = readMembers ()
-		 val _ = In.close ins
-	      in Members members
-	      end
-	in case normal () of
-	   Lexer.T_KEYWORD Lexer.K_GROUP => parseGroup ()
-	 | Lexer.T_KEYWORD Lexer.K_LIBRARY => parseGroup ()
-	 | Lexer.T_KEYWORD Lexer.K_ALIAS => parseAlias ()
-	 | _ => bad "expected 'group' or 'library'"
-	end)
+        let
+           fun no _ = false
+           val lex =
+              Lexer.lexer {strdef = no,
+                           sigdef = no,
+                           fctdef = no,
+                           fsigdef = no,
+                           symval = fn _ => NONE}
+              (cmfile, ins)
+           val lex =
+              fn m =>
+              lex m
+              handle Lexer.LexicalError (_, s) => bad s
+                   | Lexer.SyntaxError (_, s) => bad s
+                   | Lexer.UserError (_, s) => bad s
+           val lookahead: Lexer.token list ref = ref []
+           fun normal () =
+              case !lookahead of
+                 [] => lex Lexer.NORMAL
+               | h :: t => (lookahead := t; h)
+           fun member () =
+              case !lookahead of
+                 [] => lex Lexer.MEMBERS
+               | h :: t => (lookahead := t; h)
+           fun unget t = lookahead := (t :: (!lookahead))
+           fun readExport () =
+              let
+                 fun name () =
+                    (case normal () of
+                        Lexer.T_SYMBOL _ => ()
+                      | Lexer.T_STRING _ => ()
+                      | _ => bad "missing exported name"
+                           ; SOME ())
+              in case normal () of
+                 Lexer.T_KEYWORD Lexer.K_SIGNATURE => name ()
+               | Lexer.T_KEYWORD Lexer.K_STRUCTURE => name ()
+               | Lexer.T_KEYWORD Lexer.K_FUNCTOR => name ()
+               | Lexer.T_KEYWORD Lexer.K_FUNSIG => name ()
+               | x => (unget x; NONE)
+              end
+           fun readList readItem =
+              let
+                 fun loop ac =
+                    case readItem () of
+                       NONE => rev ac
+                     | SOME i => loop (i :: ac)
+              in loop []
+              end
+           fun getFileName () =
+              case member () of
+                 Lexer.T_SYMBOL name => SOME name
+               | Lexer.T_STRING name => SOME name
+               | t => (unget t; NONE)
+           fun readMember () =
+              case getFileName () of
+                 NONE => NONE
+               | SOME f =>
+                    (case member () of
+                        Lexer.T_COLON =>
+                           (case member () of
+                               Lexer.T_SYMBOL _ => ()
+                             | Lexer.T_STRING _ => ()
+                             | _ => bad "missing class name")
+                      | t => unget t
+                           ; SOME f)
+           fun readMembers () =
+              case normal () of
+                 Lexer.T_KEYWORD Lexer.K_IS =>
+                    (if !lookahead <> [] then fail "Bug in parser" else ()
+                     ; readList readMember)
+               | _ => bad "missing keyword 'is'"
+           fun parseAlias () =
+              case getFileName () of
+                 NONE => bad "alias name missing"
+               | SOME f => let val _ = In.close ins
+                           in Alias f
+                           end
+           fun parseGroup () =
+              let
+                 val _ = readList readExport
+                 val members = readMembers ()
+                 val _ = In.close ins
+              in Members members
+              end
+        in case normal () of
+           Lexer.T_KEYWORD Lexer.K_GROUP => parseGroup ()
+         | Lexer.T_KEYWORD Lexer.K_LIBRARY => parseGroup ()
+         | Lexer.T_KEYWORD Lexer.K_ALIAS => parseAlias ()
+         | _ => bad "expected 'group' or 'library'"
+        end)
     end)
  
 end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/cm/sources.cm
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/cm/sources.cm	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/cm/sources.cm	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 Group
 
 structure CM

Modified: mlton/branches/on-20050420-cmm-branch/mlton/cm/sources.mlb
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/cm/sources.mlb	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/cm/sources.mlb	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,20 +1,21 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 local
-    ../../lib/mlton/sources.mlb
-    ../control/sources.mlb
+   ../../lib/mlton/sources.mlb
+   ../control/sources.mlb
 
-    lexer.sig
-    lexer.sml
-    parse.sig
-    parse.sml
-    cm.sig
-    cm.sml
+   lexer.sig
+   lexer.sml
+   parse.sig
+   parse.sml
+   cm.sig
+   cm.sml
 in
-    structure CM
+   structure CM
 end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/codegen/bytecode/bytecode.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/codegen/bytecode/bytecode.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/codegen/bytecode/bytecode.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,8 +1,8 @@
-(* Copyright (C) 2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 2004-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 functor Bytecode (S: BYTECODE_STRUCTS): BYTECODE = 
@@ -46,7 +46,7 @@
       datatype z = datatype Prim.Name.t
    in
       case Prim.name p of
-	 Real_Math_acos _ => false
+         Real_Math_acos _ => false
        | Real_Math_asin _ => false
        | Real_Math_atan _ => false
        | Real_Math_atan2 _ => false
@@ -70,28 +70,28 @@
       open CType
 
       val memo: (t -> 'a) -> t -> 'a =
-	 fn f =>
-	 let
-	    val m =
-	       CType.memo (fn t =>
-			   case t of
-			      CType.Pointer => NONE
-			    | _ => SOME (f t))
-	 in
-	    CType.memo (fn t =>
-			valOf (case t of
-				  CType.Pointer => m CType.Word32
-				| _ => m t))
-	 end
+         fn f =>
+         let
+            val m =
+               CType.memo (fn t =>
+                           case t of
+                              CType.Pointer => NONE
+                            | _ => SOME (f t))
+         in
+            CType.memo (fn t =>
+                        valOf (case t of
+                                  CType.Pointer => m CType.Word32
+                                | _ => m t))
+         end
 
       val noSigned =
-	 memo (fn t =>
-	       case t of
-		  Int8 => Word8
-		| Int16 => Word16
-		| Int32 => Word32
-		| Int64 =>  Word64
-		| _ => t)
+         memo (fn t =>
+               case t of
+                  Int8 => Word8
+                | Int16 => Word16
+                | Int32 => Word32
+                | Int64 =>  Word64
+                | _ => t)
 
       val toStringOrig = toString
       val toString = memo toString
@@ -102,8 +102,8 @@
       datatype t = Load | Store
 
       val toString =
-	 fn Load => "load"
-	  | Store => "store"
+         fn Load => "load"
+          | Store => "store"
 
       val layout = Layout.str o toString
    end
@@ -116,213 +116,216 @@
       (* Build a table of the opcodes. *)
       val table = HashSet.new {hash = #hash}
       val _ =
-	 File.withIn
-	 (concat [!Control.libDir, "/opcodes"], fn ins =>
-	  In.foldLines
-	  (ins, 0, fn (l, i) =>
-	   case String.tokens (l, Char.isSpace) of
-	     [name] =>
-		let
-		   val hash = String.hash name
-		   val _ =
-		      HashSet.insertIfNew
-		      (table, hash,
-		       fn {name = name', ...} => name = name',
-		       fn () => {hash = hash,
-				 opcode = Int.toIntInf i,
-				 name = name},
-		       fn _ => Error.bug (concat ["duplicate opcode: ", name]))
-		in
-		   i + 1
-		end
-	   | _ => Error.bug "strange opcode file"))
+         File.withIn
+         (concat [!Control.libDir, "/opcodes"], fn ins =>
+          In.foldLines
+          (ins, 0, fn (l, i) =>
+           case String.tokens (l, Char.isSpace) of
+             [name] =>
+                let
+                   val hash = String.hash name
+                   val _ =
+                      HashSet.insertIfNew
+                      (table, hash,
+                       fn {name = name', ...} => name = name',
+                       fn () => {hash = hash,
+                                 opcode = Int.toIntInf i,
+                                 name = name},
+                       fn _ => Error.bug 
+                               (concat ["Bytecode.output: duplicate opcode: ", 
+                                        name]))
+                in
+                   i + 1
+                end
+           | _ => Error.bug "Bytecode.output: strange opcode file"))
       val opcode: string -> Opcode.t =
-	 fn name =>
-	 #opcode (HashSet.lookupOrInsert
-		  (table, String.hash name,
-		   fn {name = name', ...} => name = name',
-		   fn () => Error.bug (concat ["missing opcode: ", name, "\n"])))
-      val decls = ref []
+         fn name =>
+         #opcode (HashSet.lookupOrInsert
+                  (table, String.hash name,
+                   fn {name = name', ...} => name = name',
+                   fn () => Error.bug 
+                            (concat ["Bytecode.output: missing opcode: ", 
+                                     name])))
       val callCounter = Counter.new 0
       val callCs = ref []
       fun callC {function: string,
-		 prototype}: string =
-	 let
-	    val (args, result) = prototype
-	    val c = Counter.new 0
-	    fun temp () = concat ["t", Int.toString (Counter.next c)]
-	    fun cast (cty, src) =
-	       concat ["(", cty, ")(", src, ")"]
-	    val args =
-	       Vector.map
-	       (args, fn cty =>
-		let
-		   val mty = CType.noSigned cty
-		   val (declarePop,mtemp) =
-		      let
-			 val mty = CType.toString mty
-			 val mtemp = temp ()
-		      in
-			 (concat ["\t", mty, " ", mtemp, 
-				  " = PopReg (", mty, ");\n"],
-			  mtemp)
-		      end
-		   val (declareCast, ctemp) =
-		      if mty = cty
-			 then ("", mtemp)
-			 else let
-				 val cty = CType.toString cty
-				 val ctemp = temp ()
-			      in
-				 (concat ["\t", cty, " ", ctemp, " = ",
-					  cast (cty, mtemp), ";\n"],
-				  ctemp)
-			      end
-		in
-		   {declare = concat [declarePop, declareCast],
-		    temp = ctemp}
-		end)
-	    val call =
-	       concat [function,
-		       " (",
-		       (concat o List.separate) 
-		       (Vector.toListMap (args, #temp), ", "),
-		       ");\n"]
-	    val result =
-	       case result of
-		  NONE => concat ["\t", call]
-		| SOME cty =>
-		     let
-			val mty = CType.noSigned cty
-		     in
-			if mty = cty
-			   then concat 
-			        ["\tPushReg (", CType.toString cty, ") = ", 
-				 call]
-			   else let
-				   val cty = CType.toString cty
-				   val ctemp = temp ()
-				   val mty = CType.toString mty
-				in
-				   concat 
-				   ["\t", cty, " ", ctemp, " = ", call,
-				    "\tPushReg (", mty, ") = ", 
-				    cast (mty, ctemp), ";\n"]
-				end
-		     end
-	 in
-	    concat
-	    ["{\n",
-	     concat (Vector.toListMap (args, #declare)),
-	     "\tassertRegsEmpty ();\n",
-	     result,
-	     "\t}\n"]
-	 end
+                 prototype}: string =
+         let
+            val (args, result) = prototype
+            val c = Counter.new 0
+            fun temp () = concat ["t", Int.toString (Counter.next c)]
+            fun cast (cty, src) =
+               concat ["(", cty, ")(", src, ")"]
+            val args =
+               Vector.map
+               (args, fn cty =>
+                let
+                   val mty = CType.noSigned cty
+                   val (declarePop,mtemp) =
+                      let
+                         val mty = CType.toString mty
+                         val mtemp = temp ()
+                      in
+                         (concat ["\t", mty, " ", mtemp, 
+                                  " = PopReg (", mty, ");\n"],
+                          mtemp)
+                      end
+                   val (declareCast, ctemp) =
+                      if mty = cty
+                         then ("", mtemp)
+                         else let
+                                 val cty = CType.toString cty
+                                 val ctemp = temp ()
+                              in
+                                 (concat ["\t", cty, " ", ctemp, " = ",
+                                          cast (cty, mtemp), ";\n"],
+                                  ctemp)
+                              end
+                in
+                   {declare = concat [declarePop, declareCast],
+                    temp = ctemp}
+                end)
+            val call =
+               concat [function,
+                       " (",
+                       (concat o List.separate) 
+                       (Vector.toListMap (args, #temp), ", "),
+                       ");\n"]
+            val result =
+               case result of
+                  NONE => concat ["\t", call]
+                | SOME cty =>
+                     let
+                        val mty = CType.noSigned cty
+                     in
+                        if mty = cty
+                           then concat 
+                                ["\tPushReg (", CType.toString cty, ") = ", 
+                                 call]
+                           else let
+                                   val cty = CType.toString cty
+                                   val ctemp = temp ()
+                                   val mty = CType.toString mty
+                                in
+                                   concat 
+                                   ["\t", cty, " ", ctemp, " = ", call,
+                                    "\tPushReg (", mty, ") = ", 
+                                    cast (mty, ctemp), ";\n"]
+                                end
+                     end
+         in
+            concat
+            ["{\n",
+             concat (Vector.toListMap (args, #declare)),
+             "\tassertRegsEmpty ();\n",
+             result,
+             "\t}\n"]
+         end
       local
-	 val calls = HashSet.new {hash = #hash}
+         val calls = HashSet.new {hash = #hash}
       in
-	 val () =
-	    (* Visit each direct C Call in the program. *)
-	    List.foreach
-	    (chunks, fn Chunk.T {blocks, ...} =>
-	     Vector.foreach
-	     (blocks, fn Block.T {statements, transfer, ...} =>
-	      (Vector.foreach
-	       (statements, fn s =>
-		case s of
-		   PrimApp {dst, prim, ...} =>
-		      (case Prim.name prim of
-			  Prim.Name.FFI_Symbol {name, ...} =>
-			     Option.app
-			     (dst, fn dst =>
-			      let
-				 val hash = String.hash name
-			      in
-				 ignore
-				 (HashSet.lookupOrInsert
-				  (calls, hash,
-				   fn {name = n, ...} => n = name,
-				   fn () =>
-				   let
-				      val index = Counter.next callCounter
-				      val display =
-					 let
-					    val ptr = 
-					       CType.toString CType.Pointer
-					 in
-					    concat
-					    ["PushReg (",ptr,") = ",
-					     "((",ptr,")(&",name,"));\n"]
-					 end
-				      val () =
-					 List.push
-					 (callCs, {display = display,
-						   index = index})
-				   in
-				      {hash = hash,
-				       index = index,
-				       name = name}
-				   end))
-			      end)
-			| _ => ())
-		 | _ => ())
-	       ; (case transfer of
-		     CCall {func, ...} =>
-			let
-			   val CFunction.T {prototype, target, ...} = func
-			   datatype z = datatype Target.t
-			in
-			   case target of
-			      Direct name =>
-				 let
-				    val hash = String.hash name
-				 in
-				    ignore
-				    (HashSet.lookupOrInsert
-				     (calls, hash,
-				      fn {name = n, ...} => n = name,
-				      fn () =>
-				      let
-					 val index = Counter.next callCounter
-					 val display =
-					    callC {function = name,
-						   prototype = prototype}
-					 val () =
-					    List.push
-					    (callCs, {display = display,
-						      index = index})
-				      in
-					 {hash = hash,
-					  index = index,
-					  name = name}
-				      end))
-				 end
-			    | Indirect => ()
-			end
-		   | _ => ()))))
-	 fun directIndex (name: string) =
-	    #index (HashSet.lookupOrInsert
-		    (calls, String.hash name,
-		     fn {name = n, ...} => n = name,
-		     fn () => Error.bug "directIndex"))
-	 val ffiSymbolIndex = directIndex
+         val () =
+            (* Visit each direct C Call in the program. *)
+            List.foreach
+            (chunks, fn Chunk.T {blocks, ...} =>
+             Vector.foreach
+             (blocks, fn Block.T {statements, transfer, ...} =>
+              (Vector.foreach
+               (statements, fn s =>
+                case s of
+                   PrimApp {dst, prim, ...} =>
+                      (case Prim.name prim of
+                          Prim.Name.FFI_Symbol {name, ...} =>
+                             Option.app
+                             (dst, fn _ =>
+                              let
+                                 val hash = String.hash name
+                              in
+                                 ignore
+                                 (HashSet.lookupOrInsert
+                                  (calls, hash,
+                                   fn {name = n, ...} => n = name,
+                                   fn () =>
+                                   let
+                                      val index = Counter.next callCounter
+                                      val display =
+                                         let
+                                            val ptr = 
+                                               CType.toString CType.Pointer
+                                         in
+                                            concat
+                                            ["PushReg (",ptr,") = ",
+                                             "((",ptr,")(&",name,"));\n"]
+                                         end
+                                      val () =
+                                         List.push
+                                         (callCs, {display = display,
+                                                   index = index})
+                                   in
+                                      {hash = hash,
+                                       index = index,
+                                       name = name}
+                                   end))
+                              end)
+                        | _ => ())
+                 | _ => ())
+               ; (case transfer of
+                     CCall {func, ...} =>
+                        let
+                           val CFunction.T {prototype, target, ...} = func
+                           datatype z = datatype Target.t
+                        in
+                           case target of
+                              Direct name =>
+                                 let
+                                    val hash = String.hash name
+                                 in
+                                    ignore
+                                    (HashSet.lookupOrInsert
+                                     (calls, hash,
+                                      fn {name = n, ...} => n = name,
+                                      fn () =>
+                                      let
+                                         val index = Counter.next callCounter
+                                         val display =
+                                            callC {function = name,
+                                                   prototype = prototype}
+                                         val () =
+                                            List.push
+                                            (callCs, {display = display,
+                                                      index = index})
+                                      in
+                                         {hash = hash,
+                                          index = index,
+                                          name = name}
+                                      end))
+                                 end
+                            | Indirect => ()
+                        end
+                   | _ => ()))))
+         fun directIndex (name: string) =
+            #index (HashSet.lookupOrInsert
+                    (calls, String.hash name,
+                     fn {name = n, ...} => n = name,
+                     fn () => Error.bug "Bytecode.output.directIndex"))
+         val ffiSymbolIndex = directIndex
       end
       fun indirectIndex (f: 'a CFunction.t): int =
-	 let
-	    val index = Counter.next callCounter
-	    val function =
-	       concat ["(", "*(", CFunction.cPointerType f, " fptr)) "]
-	    val display =
-	       concat ["{\n\tWord32 fptr = PopReg (Word32);\n\t",
-		       callC {function = function,
-			      prototype = CFunction.prototype f},
-		       "\t}\n"]
-	    val () =
-	       List.push (callCs, {display = display,
-				   index = index})
-	 in
-	    index
-	 end
+         let
+            val index = Counter.next callCounter
+            val function =
+               concat ["(", "*(", CFunction.cPointerType f, " fptr)) "]
+            val display =
+               concat ["{\n\tWord32 fptr = PopReg (Word32);\n\t",
+                       callC {function = function,
+                              prototype = CFunction.prototype f},
+                       "\t}\n"]
+            val () =
+               List.push (callCs, {display = display,
+                                   index = index})
+         in
+            index
+         end
       val callC = opcode "CallC"
       val jumpOnOverflow = opcode "JumpOnOverflow"
       val profileLabel = opcode "ProfileLabel"
@@ -330,476 +333,490 @@
       val returnOp = opcode "Return"
       datatype z = datatype WordSize.prim
       val switch: WordSize.t -> Opcode.t =
-	 let
-	    val s8 = opcode "Switch8"
-	    val s16 = opcode "Switch16"
-	    val s32 = opcode "Switch32"
-	    val s64 = opcode "Switch64"
-	 in
-	    fn w =>
-	    case WordSize.prim w of
-	       W8 => s8
-	     | W16 => s16
-	     | W32 => s32
-	     | W64 => s64
-	 end
-      val thread_returnToC = opcode "Thread_returnToC"
+         let
+            val s8 = opcode "Switch8"
+            val s16 = opcode "Switch16"
+            val s32 = opcode "Switch32"
+            val s64 = opcode "Switch64"
+         in
+            fn w =>
+            case WordSize.prim w of
+               W8 => s8
+             | W16 => s16
+             | W32 => s32
+             | W64 => s64
+         end
       local
-	 fun make (name, distinguishPointers: bool)
-	    (ls: LoadStore.t, cty: CType.t): Opcode.t =
-	    opcode
-	    (concat [if distinguishPointers
-			then CType.toStringOrig cty
-		     else CType.toString cty,
-		     "_", LoadStore.toString ls, name])
+         fun make (name, distinguishPointers: bool)
+            (ls: LoadStore.t, cty: CType.t): Opcode.t =
+            opcode
+            (concat [if distinguishPointers
+                        then CType.toStringOrig cty
+                     else CType.toString cty,
+                     "_", LoadStore.toString ls, name])
       in
-	 val arrayOffset = make ("ArrayOffset", false)
-	 val contents = make ("Contents", false)
-   	 val global = make ("Global", true)
-	 val offsetOp = make ("Offset", false)
-	 val register = make ("Register", true)
-	 val stackOffset = make ("StackOffset", false)
-	 val wordOpcode = make ("Word", false)
+         val arrayOffset = make ("ArrayOffset", false)
+         val contents = make ("Contents", false)
+         val global = make ("Global", true)
+         val offsetOp = make ("Offset", false)
+         val register = make ("Register", true)
+         val stackOffset = make ("StackOffset", false)
+         val wordOpcode = make ("Word", false)
       end
       val branchIfZero = opcode "BranchIfZero"
       fun gpnr ls = opcode (concat [LoadStore.toString ls, "GPNR"])
       local
-	 fun make name (ls: LoadStore.t): Opcode.t =
-	    opcode (concat [LoadStore.toString ls, name])
+         fun make name (ls: LoadStore.t): Opcode.t =
+            opcode (concat [LoadStore.toString ls, name])
       in
-   	 val frontier = make "Frontier"
-	 val gcState = make "GCState"
-	 val stackTop = make "StackTop"
+         val frontier = make "Frontier"
+         val gcState = make "GCState"
+         val stackTop = make "StackTop"
       end
       val code: Word8.t list ref = ref []
       val offset = ref 0
       val emitByte: Word8.t -> unit =
-	 fn w =>
-	 (List.push (code, w)
-	  ; Int.inc offset)
+         fn w =>
+         (List.push (code, w)
+          ; Int.inc offset)
       local
-	 fun make (bits: int, {signed}): IntInf.t -> unit =
-	    let
-	       val bits = Bits.fromInt bits
-	    in
-	       fn i =>
-	       if not (WordSize.isInRange (WordSize.fromBits bits, i,
-					   {signed = signed}))
-		  then Error.bug (concat ["emitWord", Bits.toString bits,
-					  " failed on ", IntInf.toString i])
-	       else
-		  let
-		     fun loop (j, i) =
-			if 0 = j
-			   then ()
-			else
-			   let
-			      val (q, r) = IntInf.quotRem (i, 0x100)
-			      val () = emitByte (Word8.fromIntInf r)
-			   in
-			      loop (j - 1, q)
-			   end
-		  in
-		     loop (Bytes.toInt (Bits.toBytes bits),
-			   IntInf.mod (i, IntInf.<< (1, Bits.toWord bits)))
-		  end
-	    end
+         fun make (bits: int, {signed}): IntInf.t -> unit =
+            let
+               val bits = Bits.fromInt bits
+            in
+               fn i =>
+               if not (WordSize.isInRange (WordSize.fromBits bits, i,
+                                           {signed = signed}))
+                  then Error.bug (concat ["Bytecode.output: emitWord", 
+                                          Bits.toString bits,
+                                          " failed on ", 
+                                          IntInf.toString i])
+               else
+                  let
+                     fun loop (j, i) =
+                        if 0 = j
+                           then ()
+                        else
+                           let
+                              val (q, r) = IntInf.quotRem (i, 0x100)
+                              val () = emitByte (Word8.fromIntInf r)
+                           in
+                              loop (j - 1, q)
+                           end
+                  in
+                     loop (Bytes.toInt (Bits.toBytes bits),
+                           IntInf.mod (i, IntInf.<< (1, Bits.toWord bits)))
+                  end
+            end
       in
-	 val emitWord8 = make (8, {signed = false})
-	 val emitWord16 = make (16, {signed = false})
-	 val emitWordS16 = make (16, {signed = true})
-	 val emitWord32 = make (32, {signed = false})
-	 val emitWord64 = make (64, {signed = false})
+         val emitWord8 = make (8, {signed = false})
+         val emitWord16 = make (16, {signed = false})
+         val emitWordS16 = make (16, {signed = true})
+         val emitWord32 = make (32, {signed = false})
+         val emitWord64 = make (64, {signed = false})
       end
       val emitWordX: WordX.t -> unit =
-	 fn w =>
-	 (case WordSize.prim (WordX.size w) of
-	     W8 => emitWord8
-	   | W16 => emitWord16
-	   | W32 => emitWord32
-	   | W64 => emitWord64) (WordX.toIntInf w)
+         fn w =>
+         (case WordSize.prim (WordX.size w) of
+             W8 => emitWord8
+           | W16 => emitWord16
+           | W32 => emitWord32
+           | W64 => emitWord64) (WordX.toIntInf w)
       val emitOpcode = emitWord8
       val emitPrim: 'a Prim.t -> unit =
-	 fn p => emitOpcode (opcode (Prim.toString p))
+         fn p => emitOpcode (opcode (Prim.toString p))
       fun emitCallC (index: int): unit =
-	 (emitOpcode callC
-	  ; emitWord16 (Int.toIntInf index))
+         (emitOpcode callC
+          ; emitWord16 (Int.toIntInf index))
       val {get = labelInfo: Label.t -> {block: Block.t,
-					emitted: bool ref,
-					occurrenceOffsets: int list ref,
-					offset: int option ref},
-	   set = setLabelInfo, ...} =
-	 Property.getSetOnce (Label.plist,
-			      Property.initRaise ("info", Label.layout))
+                                        emitted: bool ref,
+                                        occurrenceOffsets: int list ref,
+                                        offset: int option ref},
+           set = setLabelInfo, ...} =
+         Property.getSetOnce (Label.plist,
+                              Property.initRaise ("info", Label.layout))
       val needToEmit: Label.t list ref = ref []
       val emitLabel: Label.t -> unit =
-	 fn l =>
-	 let
-	    val {emitted, occurrenceOffsets, ...} = labelInfo l
-	    val () = List.push (occurrenceOffsets, !offset)
-	    val () = if !emitted then () else List.push (needToEmit, l)
-	 in
-	    emitWord32 0
-	 end
+         fn l =>
+         let
+            val {emitted, occurrenceOffsets, ...} = labelInfo l
+            val () = List.push (occurrenceOffsets, !offset)
+            val () = if !emitted then () else List.push (needToEmit, l)
+         in
+            emitWord32 0
+         end
       val emitLabel =
-	 Trace.trace ("emitLabel", Label.layout, Unit.layout) emitLabel
+         Trace.trace ("Bytecode.emitLabel", Label.layout, Unit.layout) emitLabel
       fun emitLoadWord32Zero () =
-	 (emitOpcode (wordOpcode (Load, CType.Word32))
-	  ; emitWord32 0)
+         (emitOpcode (wordOpcode (Load, CType.Word32))
+          ; emitWord32 0)
       fun loadStoreStackOffset (offset, cty, ls) =
-	 (emitOpcode (stackOffset (ls, cty))
-	  ; emitWord16 (Bytes.toIntInf offset))
+         (emitOpcode (stackOffset (ls, cty))
+          ; emitWord16 (Bytes.toIntInf offset))
       val rec emitLoadOperand = fn z => emitOperand (z, Load)
       and emitOperand: Operand.t * LoadStore.t -> unit =
-	 fn (z, ls) =>
-	 let
-	    val cty = Type.toCType (Operand.ty z)
-	    datatype z = datatype Operand.t
-	 in
-	    case z of
-	       ArrayOffset {base, index, offset, scale, ...} =>
-		  (emitLoadOperand base
-		   ; emitLoadOperand index
-		   ; emitOpcode (arrayOffset (ls, cty))
-		   ; emitWord16 (Bytes.toIntInf offset)
-		   ; emitWord8 (Int.toIntInf (Scale.toInt scale)))
-	     | Cast (z, _) => emitOperand (z, ls)
-	     | Contents {oper, ...} =>
-		   (emitLoadOperand oper
-		    ; emitOpcode (contents (ls, cty)))
-	     | File => emitLoadWord32Zero ()
-	     | Frontier => emitOpcode (frontier ls)
-	     | GCState => emitOpcode (gcState ls)
-	     | Global g =>
-		  (if Global.isRoot g
-		      then emitOpcode (global (ls, cty))
-		   else emitOpcode (gpnr ls)
-		   ; emitWord16 (Int.toIntInf (Global.index g)))
-	     | Label l =>
-		  (emitOpcode (wordOpcode (ls, cty))
-		   ; emitLabel l)
-	     | Line => emitLoadWord32Zero ()
-	     | Offset {base, offset = off, ...} =>
-		  (emitLoadOperand base
-		   ; emitOpcode (offsetOp (ls, cty))
-		   ; emitWordS16 (Bytes.toIntInf off))
-	     | Real _ => Error.bug "shouldn't see Real operands in bytecode"
-	     | Register r =>
-		  (emitOpcode (register (ls, cty))
-		   ; emitWord16 (Int.toIntInf (Register.index r)))
-	     | StackOffset (StackOffset.T {offset, ...}) =>
-		  loadStoreStackOffset (offset, cty, ls)
-	     | StackTop => emitOpcode (stackTop ls)
-	     | Word w =>
-		  case ls of
-		     Load => (emitOpcode (wordOpcode (ls, cty)); emitWordX w)
-		   | Store => Error.bug "can't store to word constant"
-	 end
+         fn (z, ls) =>
+         let
+            val cty = Type.toCType (Operand.ty z)
+            datatype z = datatype Operand.t
+         in
+            case z of
+               ArrayOffset {base, index, offset, scale, ...} =>
+                  (emitLoadOperand base
+                   ; emitLoadOperand index
+                   ; emitOpcode (arrayOffset (ls, cty))
+                   ; emitWord16 (Bytes.toIntInf offset)
+                   ; emitWord8 (Int.toIntInf (Scale.toInt scale)))
+             | Cast (z, _) => emitOperand (z, ls)
+             | Contents {oper, ...} =>
+                   (emitLoadOperand oper
+                    ; emitOpcode (contents (ls, cty)))
+             | File => emitLoadWord32Zero ()
+             | Frontier => emitOpcode (frontier ls)
+             | GCState => emitOpcode (gcState ls)
+             | Global g =>
+                  (if Global.isRoot g
+                      then emitOpcode (global (ls, cty))
+                   else emitOpcode (gpnr ls)
+                   ; emitWord16 (Int.toIntInf (Global.index g)))
+             | Label l =>
+                  (emitOpcode (wordOpcode (ls, cty))
+                   ; emitLabel l)
+             | Line => emitLoadWord32Zero ()
+             | Offset {base, offset = off, ...} =>
+                  (emitLoadOperand base
+                   ; emitOpcode (offsetOp (ls, cty))
+                   ; emitWordS16 (Bytes.toIntInf off))
+             | Real _ => Error.bug "Bytecode.emitOperand: Real"
+             | Register r =>
+                  (emitOpcode (register (ls, cty))
+                   ; emitWord16 (Int.toIntInf (Register.index r)))
+             | StackOffset (StackOffset.T {offset, ...}) =>
+                  loadStoreStackOffset (offset, cty, ls)
+             | StackTop => emitOpcode (stackTop ls)
+             | Word w =>
+                  case ls of
+                     Load => (emitOpcode (wordOpcode (ls, cty)); emitWordX w)
+                   | Store => Error.bug "Bytecode.emitOperand: Word, Store"
+         end
       val emitOperand =
-	 Trace.trace2
-	 ("emitOperand", Operand.layout, LoadStore.layout, Unit.layout)
-	 emitOperand
+         Trace.trace2
+         ("Bytecode.emitOperand", Operand.layout, LoadStore.layout, Unit.layout)
+         emitOperand
       fun emitStoreOperand z = emitOperand (z, Store)
       fun move {dst, src} =
-	 (emitLoadOperand src
-	  ; emitStoreOperand dst)
+         (emitLoadOperand src
+          ; emitStoreOperand dst)
       fun emitArgs args = Vector.foreach (Vector.rev args, emitLoadOperand)
       fun primApp {args, dst, prim} =
-	 case Prim.name prim of
-	    Prim.Name.FFI_Symbol {name, ...} =>
-	       Option.app
-	       (dst, fn dst =>
-		(emitCallC (ffiSymbolIndex name)
-		 ; emitStoreOperand dst))
-	  | _ => 
-	       (emitArgs args
-		; emitPrim prim
-		; Option.app (dst, emitStoreOperand))
+         case Prim.name prim of
+            Prim.Name.FFI_Symbol {name, ...} =>
+               Option.app
+               (dst, fn dst =>
+                (emitCallC (ffiSymbolIndex name)
+                 ; emitStoreOperand dst))
+          | _ => 
+               (emitArgs args
+                ; emitPrim prim
+                ; Option.app (dst, emitStoreOperand))
       val emitStatement: Statement.t -> unit =
-	 fn s =>
-	 case s of
-	    Move z => move z
-	  | Noop => ()
-	  | PrimApp z => primApp z
-	  | ProfileLabel _ => emitOpcode profileLabel
+         fn s =>
+         case s of
+            Move z => move z
+          | Noop => ()
+          | PrimApp z => primApp z
+          | ProfileLabel _ => emitOpcode profileLabel
       val emitStatement =
-	 Trace.trace ("emitStatement", Statement.layout, Unit.layout)
-	 emitStatement
+         Trace.trace ("Bytecode.emitStatement", Statement.layout, Unit.layout)
+         emitStatement
       val gotoOp = opcode "Goto"
       val pointerSize = WordSize.pointer ()
       fun shiftStackTop (size: Bytes.t) =
-	 primApp {args = (Vector.new2
-			  (Operand.StackTop,
-			   Operand.Word (WordX.fromIntInf
-					 (Bytes.toIntInf size,
-					  pointerSize)))),
-		  dst = SOME Operand.StackTop,
-		  prim = Prim.wordAdd pointerSize}
+         primApp {args = (Vector.new2
+                          (Operand.StackTop,
+                           Operand.Word (WordX.fromIntInf
+                                         (Bytes.toIntInf size,
+                                          pointerSize)))),
+                  dst = SOME Operand.StackTop,
+                  prim = Prim.wordAdd pointerSize}
       fun push (label: Label.t, size: Bytes.t): unit =
-	 (move {dst = (Operand.StackOffset
-		       (StackOffset.T
-			{offset = Bytes.- (size, Runtime.labelSize),
-			 ty = Type.label label})),
-		src = Operand.Label label}
-	  ; shiftStackTop size)
+         (move {dst = (Operand.StackOffset
+                       (StackOffset.T
+                        {offset = Bytes.- (size, Runtime.labelSize),
+                         ty = Type.label label})),
+                src = Operand.Label label}
+          ; shiftStackTop size)
       fun pop (size: Bytes.t) = shiftStackTop (Bytes.~ size)
       val () =
-	 List.foreach
-	 (chunks, fn Chunk.T {blocks, ...} =>
-	  Vector.foreach
-	  (blocks, fn block =>
-	   setLabelInfo (Block.label block,
-			 {block = block,
-			  emitted = ref false,
-			  occurrenceOffsets = ref [],
-			  offset = ref NONE})))
+         List.foreach
+         (chunks, fn Chunk.T {blocks, ...} =>
+          Vector.foreach
+          (blocks, fn block =>
+           setLabelInfo (Block.label block,
+                         {block = block,
+                          emitted = ref false,
+                          occurrenceOffsets = ref [],
+                          offset = ref NONE})))
       val traceEmitTransfer =
-	 Trace.trace ("emitTransfer", Transfer.layout, Unit.layout)
+         Trace.trace ("Bytecode.emitTransfer", Transfer.layout, Unit.layout)
       fun emitBlock (Block.T {kind, label, statements, transfer, ...}): unit =
-	 let
-	    val () =
-	       Option.app
-	       (Kind.frameInfoOpt kind,
-		fn FrameInfo.T {frameLayoutsIndex} =>
-		((* This load will never be used.  We just have it there
-		  * so the disassembler doesn't get confused when it
-		  * sees the frameLayoutsIndex.
-		  *)
-		 emitOpcode (wordOpcode (Load, CType.Word32))
-		 ; emitWord32 (Int.toIntInf frameLayoutsIndex)))
-	    val () = #offset (labelInfo label) := SOME (!offset)
-	    fun popFrame () =
-	       Option.app (Kind.frameInfoOpt kind, fn fi =>
-			   pop (Program.frameSize (program, fi)))
-	    val () =
-	       case kind of
-		  Kind.CReturn {dst, func, ...} =>
-		     (case #2 (CFunction.prototype func) of
-			 NONE => popFrame ()
-		       | SOME cty => 
-			    case dst of
-			       NONE =>
-				  (* Even if there is no dst, we still need to
-				   * pop the value returned by the C function.
-				   * We write it to a bogus location in the
-				   * callee's frame before popping back to the
-				   * caller.
-				   * We mediated between the signed/unsigned treatment
-				   * in the stub.
-				   *)
-				  (loadStoreStackOffset 
-				   (Bytes.zero, CType.noSigned cty, Store)
-				   ; popFrame ())
-			     | SOME z =>
-				  (popFrame ()
-				   ; emitStoreOperand (Live.toOperand z)))
-		| _ => popFrame ()
-	    val () =
-	       (Vector.foreach (statements, emitStatement)
-		; emitTransfer transfer)
-	 in
-	    ()
-	 end
+         let
+            val () =
+               Option.app
+               (Kind.frameInfoOpt kind,
+                fn FrameInfo.T {frameLayoutsIndex} =>
+                ((* This load will never be used.  We just have it there
+                  * so the disassembler doesn't get confused when it
+                  * sees the frameLayoutsIndex.
+                  *)
+                 emitOpcode (wordOpcode (Load, CType.Word32))
+                 ; emitWord32 (Int.toIntInf frameLayoutsIndex)))
+            val () = #offset (labelInfo label) := SOME (!offset)
+            fun popFrame () =
+               Option.app (Kind.frameInfoOpt kind, fn fi =>
+                           pop (Program.frameSize (program, fi)))
+            val () =
+               case kind of
+                  Kind.CReturn {dst, func, ...} =>
+                     (case #2 (CFunction.prototype func) of
+                         NONE => popFrame ()
+                       | SOME cty => 
+                            case dst of
+                               NONE =>
+                                  (* Even if there is no dst, we still need to
+                                   * pop the value returned by the C function.
+                                   * We write it to a bogus location in the
+                                   * callee's frame before popping back to the
+                                   * caller.
+                                   * We mediated between the signed/unsigned treatment
+                                   * in the stub.
+                                   *)
+                                  (loadStoreStackOffset 
+                                   (Bytes.zero, CType.noSigned cty, Store)
+                                   ; popFrame ())
+                             | SOME z =>
+                                  (popFrame ()
+                                   ; emitStoreOperand (Live.toOperand z)))
+                | _ => popFrame ()
+            val () =
+               (Vector.foreach (statements, emitStatement)
+                ; emitTransfer transfer)
+         in
+            ()
+         end
       and goto (l: Label.t): unit =
-	 let
-	    val {block as Block.T {kind, ...}, emitted, ...} = labelInfo l
-	 in
-	    if !emitted orelse isSome (Kind.frameInfoOpt kind)
-	       then (emitOpcode gotoOp; emitLabel l)
-	    else (emitted := true; emitBlock block)
-	 end
+         let
+            val {block as Block.T {kind, ...}, emitted, ...} = labelInfo l
+         in
+            if !emitted orelse isSome (Kind.frameInfoOpt kind)
+               then (emitOpcode gotoOp; emitLabel l)
+            else (emitted := true; emitBlock block)
+         end
       and emitTransfer arg: unit =
-	 traceEmitTransfer
-	 (fn (t: Transfer.t) => 
-	  let
-	     datatype z = datatype Transfer.t
-	  in
-	     case t of
-		Arith {args, dst, overflow, prim, success} =>
-		   (emitArgs args
-		    ; emitPrim prim
-		    ; emitStoreOperand dst
-		    ; emitOpcode jumpOnOverflow
-		    ; emitLabel overflow
-		    ; goto success)
-	      | CCall {args, frameInfo, func, return} =>
-		   let
-		      val () = emitArgs args
-		      val CFunction.T {maySwitchThreads, target, ...} =
-			 func
-		      val () =
-			 Option.app
-			 (frameInfo, fn frameInfo =>
-			  push (valOf return,
-				Program.frameSize (program, frameInfo)))
-		      datatype z = datatype Target.t
-		      val () =
-			 case target of
-			    Direct name => emitCallC (directIndex name)
-			  | Indirect => emitCallC (indirectIndex func)
-		      val () =
-			 if maySwitchThreads
-			    then emitOpcode returnOp
-			    else Option.app (return, goto)
-		   in
-		      ()
-		   end
-	      | Call {label, return, ...} =>
-		   (Option.app (return, fn {return, size, ...} =>
-				push (return, size))
-		    ; goto label)
-	      | Goto l => goto l
-	      | Raise => emitOpcode raisee
-	      | Return => emitOpcode returnOp
-	      | Switch (Switch.T {cases, default, size, test}) =>
-		   let
-		      val () = emitLoadOperand test
-		      fun bool (test: Operand.t, a: Label.t, b: Label.t) =
-			 (emitOpcode branchIfZero
-			  ; emitLabel b
-			  ; goto a)
-		      fun normal () =
-			 let
-			    val numCases =
-			       Vector.length cases
-			       + (if isSome default then 1 else 0)
-			       - 1
-			    val () =
-			       (emitOpcode (switch size)
-				; emitWord16 (Int.toIntInf numCases))
-			    fun emitCases cases =
-			       Vector.foreach (cases, fn (w, l) =>
-					       (emitWordX w; emitLabel l))
-			 in
-			    case default of
-			       NONE =>
-				  (emitCases (Vector.dropSuffix (cases, 1))
-				   ; goto (#2 (Vector.last cases)))
-			     | SOME l =>
-				  (emitCases cases; goto l)
-			 end
-		   in
-		      if 2 = Vector.length cases
-			 andalso Option.isNone default
-			 andalso WordSize.equals (size, WordSize.default)
-			 then
-			    let
-			       val (c0, l0) = Vector.sub (cases, 0)
-			       val (c1, l1) = Vector.sub (cases, 1)
-			       val i0 = WordX.toIntInf c0
-			       val i1 = WordX.toIntInf c1
-			    in
-			       if i0 = 0 andalso i1 = 1
-				  then bool (test, l1, l0)
-				  else if i0 = 1 andalso i1 = 0
-					  then bool (test, l0, l1)
-					  else normal ()
-			    end
-			 else normal ()
-		   end
-	  end) arg
+         traceEmitTransfer
+         (fn (t: Transfer.t) => 
+          let
+             datatype z = datatype Transfer.t
+          in
+             case t of
+                Arith {args, dst, overflow, prim, success} =>
+                   (emitArgs args
+                    ; emitPrim prim
+                    ; emitStoreOperand dst
+                    ; emitOpcode jumpOnOverflow
+                    ; emitLabel overflow
+                    ; goto success)
+              | CCall {args, frameInfo, func, return} =>
+                   let
+                      val () = emitArgs args
+                      val CFunction.T {maySwitchThreads, target, ...} =
+                         func
+                      val () =
+                         Option.app
+                         (frameInfo, fn frameInfo =>
+                          push (valOf return,
+                                Program.frameSize (program, frameInfo)))
+                      datatype z = datatype Target.t
+                      val () =
+                         case target of
+                            Direct name => emitCallC (directIndex name)
+                          | Indirect => emitCallC (indirectIndex func)
+                      val () =
+                         if maySwitchThreads
+                            then emitOpcode returnOp
+                            else Option.app (return, goto)
+                   in
+                      ()
+                   end
+              | Call {label, return, ...} =>
+                   (Option.app (return, fn {return, size, ...} =>
+                                push (return, size))
+                    ; goto label)
+              | Goto l => goto l
+              | Raise => emitOpcode raisee
+              | Return => emitOpcode returnOp
+              | Switch (Switch.T {cases, default, size, test}) =>
+                   let
+                      val () = emitLoadOperand test
+                      fun bool (a: Label.t, b: Label.t) =
+                         (emitOpcode branchIfZero
+                          ; emitLabel b
+                          ; goto a)
+                      fun normal () =
+                         let
+                            val numCases =
+                               Vector.length cases
+                               + (if isSome default then 1 else 0)
+                               - 1
+                            val () =
+                               (emitOpcode (switch size)
+                                ; emitWord16 (Int.toIntInf numCases))
+                            fun emitCases cases =
+                               Vector.foreach (cases, fn (w, l) =>
+                                               (emitWordX w; emitLabel l))
+                         in
+                            case default of
+                               NONE =>
+                                  (emitCases (Vector.dropSuffix (cases, 1))
+                                   ; goto (#2 (Vector.last cases)))
+                             | SOME l =>
+                                  (emitCases cases; goto l)
+                         end
+                   in
+                      if 2 = Vector.length cases
+                         andalso Option.isNone default
+                         andalso WordSize.equals (size, WordSize.default)
+                         then
+                            let
+                               val (c0, l0) = Vector.sub (cases, 0)
+                               val (c1, l1) = Vector.sub (cases, 1)
+                               val i0 = WordX.toIntInf c0
+                               val i1 = WordX.toIntInf c1
+                            in
+                               if i0 = 0 andalso i1 = 1
+                                  then bool (l1, l0)
+                                  else if i0 = 1 andalso i1 = 0
+                                          then bool (l0, l1)
+                                          else normal ()
+                            end
+                         else normal ()
+                   end
+          end) arg
       fun loop () =
-	 case !needToEmit of
-	    [] => ()
-	  | l :: ls =>
-	       let
-		  val () = needToEmit := ls
-		  val {block, emitted, ...} = labelInfo l
-		  val () =
-		     if !emitted
-			then ()
-		     else (emitted := true; emitBlock block)
-	       in
-		  loop ()
-	       end
+         case !needToEmit of
+            [] => ()
+          | l :: ls =>
+               let
+                  val () = needToEmit := ls
+                  val {block, emitted, ...} = labelInfo l
+                  val () =
+                     if !emitted
+                        then ()
+                     else (emitted := true; emitBlock block)
+               in
+                  loop ()
+               end
       val () = List.push (needToEmit, #label main)
       val () = loop ()
+      (* Discard unreachable blocks *)
+      val chunks =
+         List.map
+         (chunks, fn Chunk.T {blocks, chunkLabel, regMax} =>
+          let
+             val blocks =
+                Vector.keepAll
+                (blocks, fn Block.T {label, ...} =>
+                 ! (#emitted (labelInfo label)))
+          in
+             Chunk.T {blocks = blocks,
+                      chunkLabel = chunkLabel,
+                      regMax = regMax}
+          end)
       fun labelOffset l = valOf (! (#offset (labelInfo l)))
       val code = Array.fromListRev (!code)
       (* Backpatch all label references. *)
       val () =
-	 List.foreach
-	 (chunks, fn Chunk.T {blocks, ...} =>
-	  Vector.foreach
-	  (blocks, fn Block.T {label, ...} =>
-	   let
-	      val {occurrenceOffsets = r, offset, ...} = labelInfo label
-	      val offset = valOf (!offset)
-	      fun loop (i, address) =
-		 if 0 = address
-		    then ()
-		 else (Array.update (code, i,
-				     Word8.fromInt (Int.rem (address, 0x100)))
-		       ; loop (i + 1, Int.quot (address, 0x100)))
-	   in
-	      List.foreach (!r, fn occ => loop (occ, offset))
-	  end))
+         List.foreach
+         (chunks, fn Chunk.T {blocks, ...} =>
+          Vector.foreach
+          (blocks, fn Block.T {label, ...} =>
+           let
+              val {occurrenceOffsets = r, offset, ...} = labelInfo label
+              val offset = valOf (!offset)
+              fun loop (i, address) =
+                 if 0 = address
+                    then ()
+                 else (Array.update (code, i,
+                                     Word8.fromInt (Int.rem (address, 0x100)))
+                       ; loop (i + 1, Int.quot (address, 0x100)))
+           in
+              List.foreach (!r, fn occ => loop (occ, offset))
+          end))
       val {done, file = _, print} = outputC ()
       val print =
-	 Trace.trace ("Bytecode.print", String.layout, Unit.layout) print
+         Trace.trace ("Bytecode.print", String.layout, Unit.layout) print
       val () =
-	 CCodegen.outputDeclarations
-	 {additionalMainArgs = [Int.toString (labelOffset (#label main))],
+         CCodegen.outputDeclarations
+         {additionalMainArgs = [Int.toString (labelOffset (#label main))],
           includes = ["bytecode-main.h"],
-	  print = print,
-	  program = program,
-	  rest = fn () => ()}
+          print = print,
+          program = program,
+          rest = fn () => ()}
       val () = done ()
       val {done, print, ...} = outputC ()
       fun declareCallC () =
-	  (print "void MLton_callC (int i) {\n"
-	   ; print "switch (i) {\n"
-	   ; List.foreach (!callCs, fn {display, index} =>
-			   (print (concat ["case ", Int.toString index, ":\n\t"])
-			    ; print display
-			    ; print "break;\n"))
-	   ; print "}}\n")
+          (print "void MLton_callC (int i) {\n"
+           ; print "switch (i) {\n"
+           ; List.foreach (!callCs, fn {display, index} =>
+                           (print (concat ["case ", Int.toString index, ":\n\t"])
+                            ; print display
+                            ; print "break;\n"))
+           ; print "}}\n")
       val () =
-	  (print "#include \"bytecode.h\"\n\n"
-	   ; List.foreach (chunks, fn c =>
-			   CCodegen.declareFFI (c, {print = print}))
-	   ; print "\n"
-	   ; declareCallC ()
-	   ; print "\n")
-      val addressNamesSize = ref 0
+          (print "#include \"bytecode.h\"\n\n"
+           ; List.foreach (chunks, fn c =>
+                           CCodegen.declareFFI (c, {print = print}))
+           ; print "\n"
+           ; declareCallC ()
+           ; print "\n")
       val word8ArrayToString: Word8.t array -> string =
-	 fn a => String.tabulate (Array.length a, fn i =>
-				  Char.fromWord8 (Array.sub (a, i)))
+         fn a => String.tabulate (Array.length a, fn i =>
+                                  Char.fromWord8 (Array.sub (a, i)))
       val {labels, offsets, ...} =
-	 List.fold
-	 (chunks, {labels = [], offset = 0, offsets = []},
-	  fn (Chunk.T {blocks, ...}, ac) =>
-	  Vector.fold
-	  (blocks, ac, fn (Block.T {label, ...}, {labels, offset, offsets}) =>
-	   let
-	      val offsets = {code = labelOffset label, name = offset} :: offsets
-	      val label = Label.toString label
-	   in
-	      {labels = label :: labels,
-	       offset = offset + String.size label + 1,
-	       offsets = offsets}
-	   end))
+         List.fold
+         (chunks, {labels = [], offset = 0, offsets = []},
+          fn (Chunk.T {blocks, ...}, ac) =>
+          Vector.fold
+          (blocks, ac, fn (Block.T {label, ...}, {labels, offset, offsets}) =>
+           let
+              val offsets = {code = labelOffset label, name = offset} :: offsets
+              val label = Label.toString label
+           in
+              {labels = label :: labels,
+               offset = offset + String.size label + 1,
+               offsets = offsets}
+           end))
       val labels =
-	 concat (List.fold (labels, [], fn (l, ac) => l :: "\000" :: ac))
+         concat (List.fold (labels, [], fn (l, ac) => l :: "\000" :: ac))
       val offsets = rev offsets
       fun printString s =
-	 (print "\t\""; print (String.escapeC s); print "\",\n")
+         (print "\t\""; print (String.escapeC s); print "\",\n")
       fun printInt i = print (concat ["\t", Int.toString i, ",\n"])
       val () =
-	 (print "static struct NameOffsets nameOffsets [] = {\n"
-	  ; List.foreach (offsets, fn {code, name} =>
-			  print (concat ["\t{ ",
-					 Int.toString code, ", ",
-					 Int.toString name,
-					 " },\n"]))
-	  ; print "};\n"
-	  ; print "struct Bytecode MLton_bytecode = {\n"
-	  ; printString labels
-	  ; printString (word8ArrayToString code)
-	  ; printInt (Array.length code)
-	  ; print "\tnameOffsets,\n"
-	  ; printInt (List.length offsets)
-	  ; print "};\n")
+         (print "static struct NameOffsets nameOffsets [] = {\n"
+          ; List.foreach (offsets, fn {code, name} =>
+                          print (concat ["\t{ ",
+                                         Int.toString code, ", ",
+                                         Int.toString name,
+                                         " },\n"]))
+          ; print "};\n"
+          ; print "struct Bytecode MLton_bytecode = {\n"
+          ; printString labels
+          ; printString (word8ArrayToString code)
+          ; printInt (Array.length code)
+          ; print "\tnameOffsets,\n"
+          ; printInt (List.length offsets)
+          ; print "};\n")
       val () = done ()
    in
       ()

Modified: mlton/branches/on-20050420-cmm-branch/mlton/codegen/bytecode/bytecode.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/codegen/bytecode/bytecode.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/codegen/bytecode/bytecode.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,8 +1,8 @@
-(* Copyright (C) 2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 2004-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 signature BYTECODE_STRUCTS = 
@@ -18,7 +18,7 @@
       
       val implementsPrim: 'a Machine.Prim.t -> bool
       val output: {program: Machine.Program.t,
-		   outputC: unit -> {file: File.t,
-				     print: string -> unit,
-				     done: unit -> unit}} -> unit
+                   outputC: unit -> {file: File.t,
+                                     print: string -> unit,
+                                     done: unit -> unit}} -> unit
    end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/codegen/bytecode/sources.cm
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/codegen/bytecode/sources.cm	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/codegen/bytecode/sources.cm	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,10 @@
+(* Copyright (C) 2004-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 Group is
 
 ../../../lib/mlton/sources.cm

Modified: mlton/branches/on-20050420-cmm-branch/mlton/codegen/bytecode/sources.mlb
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/codegen/bytecode/sources.mlb	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/codegen/bytecode/sources.mlb	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,18 +1,18 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 2004-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 local
-    ../../../lib/mlton/sources.mlb
-    ../../backend/sources.mlb
-    ../../control/sources.mlb
-    ../c-codegen/sources.mlb
+   ../../../lib/mlton/sources.mlb
+   ../../backend/sources.mlb
+   ../../control/sources.mlb
+   ../c-codegen/sources.mlb
 
-    bytecode.sig
-    bytecode.fun
+   bytecode.sig
+   bytecode.fun
 in
-    functor Bytecode
-end
\ No newline at end of file
+   functor Bytecode
+   end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/codegen/c-codegen/c-codegen.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/codegen/c-codegen/c-codegen.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/codegen/c-codegen/c-codegen.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,9 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 functor CCodegen (S: C_CODEGEN_STRUCTS): C_CODEGEN =
@@ -29,33 +29,33 @@
       open Kind
 
       fun isEntry (k: t): bool =
-	 case k of
-	    Cont _ => true
-	  | CReturn {func, ...} => CFunction.mayGC func
-	  | Func => true
-	  | Handler _ => true
-	  | _ => false
+         case k of
+            Cont _ => true
+          | CReturn {func, ...} => CFunction.mayGC func
+          | Func => true
+          | Handler _ => true
+          | _ => false
    end
 
-val traceGotoLabel = Trace.trace ("gotoLabel", Label.layout, Unit.layout) 
+val traceGotoLabel = Trace.trace ("CCodegen.gotoLabel", Label.layout, Unit.layout) 
 
 structure RealX =
    struct
       open RealX
 
       fun toC (r: t): string =
-	 let
-	    (* The only difference between SML reals and C floats/doubles is that
-	     * SML uses "~" while C uses "-".
-	     *)
-	    val s =
-	       String.translate (toString r,
-				 fn #"~" => "-" | c => String.fromChar c)
-	 in
-	    case size r of
-	       R32 => concat ["(Real32)", s]
-	     | R64 => s
-	 end
+         let
+            (* The only difference between SML reals and C floats/doubles is that
+             * SML uses "~" while C uses "-".
+             *)
+            val s =
+               String.translate (toString r,
+                                 fn #"~" => "-" | c => String.fromChar c)
+         in
+            case size r of
+               R32 => concat ["(Real32)", s]
+             | R64 => s
+         end
    end
 
 structure WordX =
@@ -63,16 +63,16 @@
       open WordX
 
       fun toC (w: t): string =
-	 let
-	    fun simple s =
-	       concat ["(Word", s, ")0x", toString w]
-	 in
-	    case WordSize.prim (size w) of
-	       W8 => simple "8"
-	     | W16 => simple "16"
-	     | W32 => concat ["0x", toString w]
-	     | W64 => concat ["0x", toString w, "llu"]
-	 end
+         let
+            fun simple s =
+               concat ["(Word", s, ")0x", toString w]
+         in
+            case WordSize.prim (size w) of
+               W8 => simple "8"
+             | W16 => simple "16"
+             | W32 => concat ["0x", toString w]
+             | W64 => concat ["0x", toString w, "llu"]
+         end
    end
    
 structure C =
@@ -81,40 +81,40 @@
       val falsee = "FALSE"
 
       fun bool b = if b then truee else falsee
-	 
+         
       fun args (ss: string list): string
-	 = concat ("(" :: List.separate (ss, ", ") @ [")"])
+         = concat ("(" :: List.separate (ss, ", ") @ [")"])
          
       fun callNoSemi (f: string, xs: string list, print: string -> unit): unit 
-	 = (print f
-	    ; print " ("
-	    ; (case xs 
-		  of [] => ()
-		| x :: xs => (print x
-			      ; List.foreach (xs, 
-					     fn x => (print ", "; print x))))
-	    ; print ")")
+         = (print f
+            ; print " ("
+            ; (case xs 
+                  of [] => ()
+                | x :: xs => (print x
+                              ; List.foreach (xs, 
+                                             fn x => (print ", "; print x))))
+            ; print ")")
 
       fun call (f, xs, print) =
-	 (callNoSemi (f, xs, print)
-	  ; print ";\n")
+         (callNoSemi (f, xs, print)
+          ; print ";\n")
 
       fun int (i: int) =
-	 if i >= 0
-	    then Int.toString i
-	 else concat ["-", Int.toString (~ i)]
+         if i >= 0
+            then Int.toString i
+         else concat ["-", Int.toString (~ i)]
 
       val bytes = int o Bytes.toInt
 
       fun string s =
-	 let val quote = "\""
-	 in concat [quote, String.escapeC s, quote]
-	 end
+         let val quote = "\""
+         in concat [quote, String.escapeC s, quote]
+         end
 
       fun word (w: Word.t) = "0x" ^ Word.toString w
 
       fun push (size: Bytes.t, print) =
-	 call ("\tPush", [bytes size], print)
+         call ("\tPush", [bytes size], print)
    end
 
 structure Operand =
@@ -122,21 +122,27 @@
       open Operand
 
       fun isMem (z: t): bool =
-	 case z of
-	    ArrayOffset _ => true
-	  | Cast (z, _) => isMem z
-	  | Contents _ => true
-	  | Offset _ => true
-	  | StackOffset _ => true
-	  | _ => false
+         case z of
+            ArrayOffset _ => true
+          | Cast (z, _) => isMem z
+          | Contents _ => true
+          | Offset _ => true
+          | StackOffset _ => true
+          | _ => false
    end
 
 fun implementsPrim (p: 'a Prim.t): bool =
    let
       datatype z = datatype Prim.Name.t
+      fun w32168 s =
+         case WordSize.prim s of
+            W8 => true
+          | W16 => true
+          | W32 => true
+          | W64 => false
    in
       case Prim.name p of
-	 FFI_Symbol _ => true
+         FFI_Symbol _ => true
        | Real_Math_acos _ => true
        | Real_Math_asin _ => true
        | Real_Math_atan _ => true
@@ -164,12 +170,15 @@
        | Real_toWord _ => true
        | Thread_returnToC => true
        | Word_add _ => true
+       | Word_addCheck _ => true
        | Word_andb _ => true
        | Word_equal _ => true
        | Word_lshift _ => true
        | Word_lt _ => true
        | Word_mul _ => true
+       | Word_mulCheck (s, _) => w32168 s
        | Word_neg _ => true
+       | Word_negCheck _ => true
        | Word_notb _ => true
        | Word_orb _ => true
        | Word_quot (_, {signed}) => not signed
@@ -178,6 +187,7 @@
        | Word_ror _ => true
        | Word_rshift _ => true
        | Word_sub _ => true
+       | Word_subCheck _ => true
        | Word_toReal _ => true
        | Word_toWord _ => true
        | Word_xorb _ => true
@@ -190,8 +200,8 @@
 fun outputIncludes (includes, print) =
    (print "#define _ISOC99_SOURCE\n"
     ; List.foreach (includes, fn i => (print "#include <";
-				       print i;
-				       print ">\n"))
+                                       print i;
+                                       print ">\n"))
     ; print "\n")
 
 fun declareProfileLabel (l, print) =
@@ -204,19 +214,19 @@
        *)
       val _ = print (concat [prefix, "struct GC_state gcState;\n"])
       val _ =
-	 List.foreach
-	 (CType.all, fn t =>
-	  let
-	     val s = CType.toString t
-	  in		
-	     print (concat [prefix, s, " global", s,
-			    " [", C.int (Global.numberOfType t), "];\n"])
-	     ; print (concat [prefix, s, " CReturn", CType.name t, ";\n"])
-	  end)
-      val _ =	       			    
-	 print (concat [prefix, "Pointer globalPointerNonRoot [",
-			C.int (Global.numberOfNonRoot ()),
-			"];\n"])
+         List.foreach
+         (CType.all, fn t =>
+          let
+             val s = CType.toString t
+          in            
+             print (concat [prefix, s, " global", s,
+                            " [", C.int (Global.numberOfType t), "];\n"])
+             ; print (concat [prefix, s, " CReturn", CType.name t, ";\n"])
+          end)
+      val _ =                               
+         print (concat [prefix, "Pointer globalPointerNonRoot [",
+                        C.int (Global.numberOfNonRoot ()),
+                        "];\n"])
    in
       ()
    end
@@ -226,175 +236,176 @@
     includes: string list,
     print: string -> unit,
     program = (Program.T
-	       {frameLayouts, frameOffsets, intInfs, maxFrameSize,
-		objectTypes, profileInfo, reals, vectors, ...}),
+               {frameLayouts, frameOffsets, intInfs, maxFrameSize,
+                objectTypes, profileInfo, reals, vectors, ...}),
     rest: unit -> unit
     }: unit =
    let
       fun declareExports () =
-	 Ffi.declareExports {print = print}
+         Ffi.declareExports {print = print}
       fun declareLoadSaveGlobals () =
-	 let
-	    val _ =
-	       (print "static void saveGlobals (int fd) {\n"
-		; (List.foreach
-		   (CType.all, fn t =>
-		    print (concat ["\tSaveArray (global",
-				   CType.toString t, ", fd);\n"])))
-		; print "}\n")
-	    val _ =
-	       (print "static void loadGlobals (FILE *file) {\n"
-		; (List.foreach
-		   (CType.all, fn t =>
-		    print (concat ["\tLoadArray (global",
-				   CType.toString t, ", file);\n"])))
-		; print "}\n")
-	 in
-	    ()
-	 end
+         let
+            val _ =
+               (print "static void saveGlobals (int fd) {\n"
+                ; (List.foreach
+                   (CType.all, fn t =>
+                    print (concat ["\tSaveArray (global",
+                                   CType.toString t, ", fd);\n"])))
+                ; print "}\n")
+            val _ =
+               (print "static void loadGlobals (FILE *file) {\n"
+                ; (List.foreach
+                   (CType.all, fn t =>
+                    print (concat ["\tLoadArray (global",
+                                   CType.toString t, ", file);\n"])))
+                ; print "}\n")
+         in
+            ()
+         end
       fun declareIntInfs () =
-	 (print "BeginIntInfs\n"
-	  ; List.foreach (intInfs, fn (g, s) =>
-			  (C.callNoSemi ("IntInf",
-					 [C.int (Global.index g),
-					  C.string s],
-					 print)
-			   ; print "\n"))
-	  ; print "EndIntInfs\n")
+         (print "BeginIntInfs\n"
+          ; List.foreach (intInfs, fn (g, s) =>
+                          (C.callNoSemi ("IntInf",
+                                         [C.int (Global.index g),
+                                          C.string s],
+                                         print)
+                           ; print "\n"))
+          ; print "EndIntInfs\n")
       fun declareStrings () =
-	 (print "BeginVectors\n"
-	  ; (List.foreach
-	     (vectors, fn (g, v) =>
-	      (C.callNoSemi ("Vector",
-			     [C.string (WordXVector.toString v),
-			      C.int (Bytes.toInt
-				     (WordSize.bytes
-				      (WordXVector.elementSize v))),
-			      C.int (Global.index g),
-			      C.int (WordXVector.length v)],
-			     print)
-		 ; print "\n")))
-	  ; print "EndVectors\n")
+         (print "BeginVectors\n"
+          ; (List.foreach
+             (vectors, fn (g, v) =>
+              (C.callNoSemi ("Vector",
+                             [C.string (WordXVector.toString v),
+                              C.int (Bytes.toInt
+                                     (WordSize.bytes
+                                      (WordXVector.elementSize v))),
+                              C.int (Global.index g),
+                              C.int (WordXVector.length v)],
+                             print)
+                 ; print "\n")))
+          ; print "EndVectors\n")
       fun declareReals () =
-	 (print "static void real_Init() {\n"
-	  ; List.foreach (reals, fn (g, r) =>
-			  print (concat ["\tglobalReal",
-					 RealSize.toString (RealX.size r),
-					 "[", C.int (Global.index g), "] = ",
-					 RealX.toC r, ";\n"]))
-	  ; print "}\n")
+         (print "static void real_Init() {\n"
+          ; List.foreach (reals, fn (g, r) =>
+                          print (concat ["\tglobalReal",
+                                         RealSize.toString (RealX.size r),
+                                         "[", C.int (Global.index g), "] = ",
+                                         RealX.toC r, ";\n"]))
+          ; print "}\n")
       fun declareFrameOffsets () =
-	 Vector.foreachi
-	 (frameOffsets, fn (i, v) =>
-	  (print (concat ["static ushort frameOffsets", C.int i, "[] = {"])
-	   ; print (C.int (Vector.length v))
-	   ; Vector.foreach (v, fn i => (print ","; print (C.bytes i)))
-	   ; print "};\n"))
+         Vector.foreachi
+         (frameOffsets, fn (i, v) =>
+          (print (concat ["static ushort frameOffsets", C.int i, "[] = {"])
+           ; print (C.int (Vector.length v))
+           ; Vector.foreach (v, fn i => (print ","; print (C.bytes i)))
+           ; print "};\n"))
       fun declareArray (ty: string,
-			name: string,
-			v: 'a vector,
-			toString: int * 'a -> string) =
-	 (print (concat ["static ", ty, " ", name, "[] = {\n"])
-	  ; Vector.foreachi (v, fn (i, x) =>
-			     print (concat ["\t", toString (i, x), ",\n"]))
-	  ; print "};\n")
+                        name: string,
+                        v: 'a vector,
+                        toString: int * 'a -> string) =
+         (print (concat ["static ", ty, " ", name, "[] = {\n"])
+          ; Vector.foreachi (v, fn (i, x) =>
+                             print (concat ["\t", toString (i, x), ",\n"]))
+          ; print "};\n")
       fun declareFrameLayouts () =
-	 declareArray ("GC_frameLayout", "frameLayouts", frameLayouts,
-		       fn (_, {frameOffsetsIndex, isC, size}) =>
-		       concat ["{",
-			       C.bool isC,
-			       ", ", C.bytes size,
-			       ", frameOffsets", C.int frameOffsetsIndex,
-			       "}"])
+         declareArray ("GC_frameLayout", "frameLayouts", frameLayouts,
+                       fn (_, {frameOffsetsIndex, isC, size}) =>
+                       concat ["{",
+                               C.bool isC,
+                               ", ", C.bytes size,
+                               ", frameOffsets", C.int frameOffsetsIndex,
+                               "}"])
       fun declareAtMLtons () =
-	 declareArray ("string", "atMLtons", !Control.atMLtons, C.string o #2)
+         declareArray ("string", "atMLtons", !Control.atMLtons, C.string o #2)
       fun declareObjectTypes () =
-	 declareArray
-	 ("GC_ObjectType", "objectTypes", objectTypes,
-	  fn (_, ty) =>
-	  let
-	     datatype z = datatype Runtime.RObjectType.t
-	     val (tag, hasIdentity, nonPointers, pointers) =
-		case ObjectType.toRuntime ty of
-		   Array {hasIdentity, nonPointer, pointers} =>
-		      (0, hasIdentity, Bytes.toInt nonPointer, pointers)
-		 | Normal {hasIdentity, nonPointer, pointers} =>
-		      (1, hasIdentity, Words.toInt nonPointer, pointers)
-		 | Stack =>
-		      (2, false, 0, 0)
-		 | Weak =>
-		      (3, false, 2, 1)
-		 | WeakGone =>
-		      (3, false, 3, 0)
-	  in
-	     concat ["{ ", C.int tag, ", ",
-		     C.bool hasIdentity, ", ",
-		     C.int nonPointers, ", ",
-		     C.int pointers, " }"]
-	  end)
+         declareArray
+         ("GC_ObjectType", "objectTypes", objectTypes,
+          fn (_, ty) =>
+          let
+             datatype z = datatype Runtime.RObjectType.t
+             val (tag, hasIdentity, nonPointers, pointers) =
+                case ObjectType.toRuntime ty of
+                   Array {hasIdentity, nonPointer, pointers} =>
+                      (0, hasIdentity, Bytes.toInt nonPointer, pointers)
+                 | Normal {hasIdentity, nonPointer, pointers} =>
+                      (1, hasIdentity, Words.toInt nonPointer, pointers)
+                 | Stack =>
+                      (2, false, 0, 0)
+                 | Weak =>
+                      (3, false, 2, 1)
+                 | WeakGone =>
+                      (3, false, 3, 0)
+          in
+             concat ["{ ", C.int tag, ", ",
+                     C.bool hasIdentity, ", ",
+                     C.int nonPointers, ", ",
+                     C.int pointers, " }"]
+          end)
       fun declareMain () =
-	 let
-	    val align =
-	       case !Control.align of
-		  Control.Align4 => 4
-		| Control.Align8 => 8
-	    val magic = C.word (case Random.useed () of
-				   NONE => String.hash (!Control.inputFile)
-				 | SOME w => w)
-	    val profile =
-	       case !Control.profile of
-		  Control.ProfileNone => "PROFILE_NONE"
-		| Control.ProfileAlloc => "PROFILE_ALLOC"
-		| Control.ProfileCallStack => "PROFILE_NONE"
-		| Control.ProfileCount => "PROFILE_COUNT"
-		| Control.ProfileMark => "PROFILE_NONE"
-		| Control.ProfileTime => "PROFILE_TIME"
-	 in 
-	    C.callNoSemi ("Main",
-			  [C.int align,
-			   C.int (!Control.cardSizeLog2),
-			   magic,
-			   C.bytes maxFrameSize,
-			   C.bool (!Control.markCards),
-			   profile,
-			   C.bool (!Control.profileStack)]
-			  @ additionalMainArgs,
-			  print)
-	    ; print "\n"
-	 end
+         let
+            val align =
+               case !Control.align of
+                  Control.Align4 => 4
+                | Control.Align8 => 8
+            val magic = C.word (case Random.useed () of
+                                   NONE => String.hash (!Control.inputFile)
+                                 | SOME w => w)
+            val profile =
+               case !Control.profile of
+                  Control.ProfileNone => "PROFILE_NONE"
+                | Control.ProfileAlloc => "PROFILE_ALLOC"
+                | Control.ProfileCallStack => "PROFILE_NONE"
+                | Control.ProfileCount => "PROFILE_COUNT"
+                | Control.ProfileDrop => "PROFILE_NONE"
+                | Control.ProfileLabel => "PROFILE_NONE"
+                | Control.ProfileTimeField => "PROFILE_TIME_FIELD"
+                | Control.ProfileTimeLabel => "PROFILE_TIME_LABEL"
+         in 
+            C.callNoSemi ("Main",
+                          [C.int align,
+                           magic,
+                           C.bytes maxFrameSize,
+                           C.bool (!Control.markCards),
+                           profile,
+                           C.bool (!Control.profileStack)]
+                          @ additionalMainArgs,
+                          print)
+            ; print "\n"
+         end
       fun declareProfileInfo () =
-	 let
-	    fun doit (ProfileInfo.T {frameSources, labels, names, sourceSeqs,
-				     sources}) =
-	       (Vector.foreach (labels, fn {label, ...} =>
-				declareProfileLabel (label, print))
-		; (Vector.foreachi
-		   (sourceSeqs, fn (i, v) =>
-		    (print (concat ["static int sourceSeq",
-				    Int.toString i,
-				    "[] = {"])
-		     ; print (C.int (Vector.length v))
-		     ; Vector.foreach (v, fn i =>
-				       (print (concat [",", C.int i])))
-		     ; print "};\n")))
-		; declareArray ("uint", "*sourceSeqs", sourceSeqs, fn (i, _) =>
-				concat ["sourceSeq", Int.toString i])
-		; declareArray ("uint", "frameSources", frameSources, C.int o #2)
-		; (declareArray
-		   ("struct GC_sourceLabel", "sourceLabels", labels,
-		    fn (_, {label, sourceSeqsIndex}) =>
-		    concat ["{(pointer)", ProfileLabel.toString label, ", ",
-			    C.int sourceSeqsIndex, "}"]))
-		; declareArray ("string", "sourceNames", names, C.string o #2)
-		; declareArray ("struct GC_source", "sources", sources,
-				fn (_, {nameIndex, successorsIndex}) =>
-				concat ["{ ", Int.toString nameIndex, ", ",
-					Int.toString successorsIndex, " }"]))
-	 in
-	    case profileInfo of
-	       NONE => doit ProfileInfo.empty
-	     | SOME z => doit z
-	 end
+         let
+            fun doit (ProfileInfo.T {frameSources, labels, names, sourceSeqs,
+                                     sources}) =
+               (Vector.foreach (labels, fn {label, ...} =>
+                                declareProfileLabel (label, print))
+                ; (Vector.foreachi
+                   (sourceSeqs, fn (i, v) =>
+                    (print (concat ["static int sourceSeq",
+                                    Int.toString i,
+                                    "[] = {"])
+                     ; print (C.int (Vector.length v))
+                     ; Vector.foreach (v, fn i =>
+                                       (print (concat [",", C.int i])))
+                     ; print "};\n")))
+                ; declareArray ("uint", "*sourceSeqs", sourceSeqs, fn (i, _) =>
+                                concat ["sourceSeq", Int.toString i])
+                ; declareArray ("uint", "frameSources", frameSources, C.int o #2)
+                ; (declareArray
+                   ("struct GC_sourceLabel", "sourceLabels", labels,
+                    fn (_, {label, sourceSeqsIndex}) =>
+                    concat ["{(pointer)&", ProfileLabel.toString label, ", ",
+                            C.int sourceSeqsIndex, "}"]))
+                ; declareArray ("string", "sourceNames", names, C.string o #2)
+                ; declareArray ("struct GC_source", "sources", sources,
+                                fn (_, {nameIndex, successorsIndex}) =>
+                                concat ["{ ", Int.toString nameIndex, ", ",
+                                        Int.toString successorsIndex, " }"]))
+         in
+            case profileInfo of
+               NONE => doit ProfileInfo.empty
+             | SOME z => doit z
+         end
    in
       outputIncludes (includes, print)
       ; declareGlobals ("", print)
@@ -417,7 +428,7 @@
       open Type
 
       fun toC (t: t): string =
-	 CType.toString (Type.toCType t)
+         CType.toString (Type.toCType t)
    end
 
 structure StackOffset =
@@ -425,7 +436,7 @@
       open StackOffset
 
       fun toString (T {offset, ty}): string =
-	 concat ["S", C.args [Type.toC ty, C.bytes offset]]
+         concat ["S", C.args [Type.toC ty, C.bytes offset]]
    end
 
 fun contents (ty, z) = concat ["C", C.args [Type.toC ty, z]]
@@ -434,718 +445,714 @@
    let
       val seen = String.memoize (fn _ => ref false)
       fun doit (name: string, declare: unit -> string): unit =
-	 let
-	    val r = seen name
-	 in
-	    if !r
-	       then ()
-	    else (r := true; print (declare ()))
-	 end
+         let
+            val r = seen name
+         in
+            if !r
+               then ()
+            else (r := true; print (declare ()))
+         end
    in
       Vector.foreach
       (blocks, fn Block.T {statements, transfer, ...} =>
        let
-	  val _ =
-	     Vector.foreach
-	     (statements, fn s =>
-	      case s of
-		 Statement.PrimApp {prim, ...} =>
-		    (case Prim.name prim of
-			Prim.Name.FFI_Symbol {name, ...} =>
-			   doit
-			   (name, fn () =>
-			    (* Only take address of FFI_Symbol,
-			     * so no need for a type specifier
-			     *)
-			    concat ["extern ", name, ";\n"])
-		      | _ => ())
-	       | _ => ())
-	  val _ =
-	     case transfer of
-		Transfer.CCall {func, ...} =>
-		   let
-		      datatype z = datatype CFunction.Target.t
-		      val CFunction.T {target, ...} = func
-		   in
-		      case target of
-			 Direct "Thread_returnToC" => ()
-		       | Direct name =>
-			    doit (name, fn () =>
-				  concat [CFunction.cPrototype func, ";\n"])
-		       | Indirect => ()
-		   end
-	      | _ => ()
+          val _ =
+             Vector.foreach
+             (statements, fn s =>
+              case s of
+                 Statement.PrimApp {prim, ...} =>
+                    (case Prim.name prim of
+                        Prim.Name.FFI_Symbol {name} =>
+                           doit
+                           (name, fn () =>
+                            concat ["extern ", name, ";\n"])
+                      | _ => ())
+               | _ => ())
+          val _ =
+             case transfer of
+                Transfer.CCall {func, ...} =>
+                   let
+                      datatype z = datatype CFunction.Target.t
+                      val CFunction.T {target, ...} = func
+                   in
+                      case target of
+                         Direct "Thread_returnToC" => ()
+                       | Direct name =>
+                            doit (name, fn () =>
+                                  concat [CFunction.cPrototype func, ";\n"])
+                       | Indirect => ()
+                   end
+              | _ => ()
        in
-	  ()
+          ()
        end)
    end
 
 fun output {program as Machine.Program.T {chunks,
-					  frameLayouts,
-					  main = {chunkLabel, label}, ...},
-	    outputC: unit -> {file: File.t,
-			      print: string -> unit,
-			      done: unit -> unit}} =
+                                          frameLayouts,
+                                          main = {chunkLabel, label}, ...},
+            outputC: unit -> {file: File.t,
+                              print: string -> unit,
+                              done: unit -> unit}} =
    let
       datatype status = None | One | Many
       val {get = labelInfo: Label.t -> {block: Block.t,
-					chunkLabel: ChunkLabel.t,
-					frameIndex: int option,
-					status: status ref,
-					layedOut: bool ref},
-	   set = setLabelInfo, ...} =
-	 Property.getSetOnce
-	 (Label.plist, Property.initRaise ("CCodeGen.info", Label.layout))
+                                        chunkLabel: ChunkLabel.t,
+                                        frameIndex: int option,
+                                        status: status ref,
+                                        layedOut: bool ref},
+           set = setLabelInfo, ...} =
+         Property.getSetOnce
+         (Label.plist, Property.initRaise ("CCodeGen.info", Label.layout))
       val entryLabels: (Label.t * int) list ref = ref []
       val indexCounter = Counter.new (Vector.length frameLayouts)
       val _ =
-	 List.foreach
-	 (chunks, fn Chunk.T {blocks, chunkLabel, ...} =>
-	  Vector.foreach
-	  (blocks, fn b as Block.T {kind, label, ...} =>
-	   let
-	      fun entry (index: int) =
-		 List.push (entryLabels, (label, index))
-	      val frameIndex = 
-		 case Kind.frameInfoOpt kind of
-		    NONE => (if Kind.isEntry kind
-				then entry (Counter.next indexCounter)
-			     else ()
-		             ; NONE)
-		  | SOME (FrameInfo.T {frameLayoutsIndex, ...}) =>
-		       (entry frameLayoutsIndex
-			; SOME frameLayoutsIndex)
-	   in
-	      setLabelInfo (label, {block = b,
-				    chunkLabel = chunkLabel,
-				    frameIndex = frameIndex,
-				    layedOut = ref false,
-				    status = ref None})
-	   end))
-      val entryLabels =
-	 Vector.map
-	 (Vector.fromArray
-	  (QuickSort.sortArray
-	   (Array.fromList (!entryLabels), fn ((_, i), (_, i')) => i <= i')),
-	  #1)
+         List.foreach
+         (chunks, fn Chunk.T {blocks, chunkLabel, ...} =>
+          Vector.foreach
+          (blocks, fn b as Block.T {kind, label, ...} =>
+           let
+              fun entry (index: int) =
+                 List.push (entryLabels, (label, index))
+              val frameIndex = 
+                 case Kind.frameInfoOpt kind of
+                    NONE => (if Kind.isEntry kind
+                                then entry (Counter.next indexCounter)
+                             else ()
+                             ; NONE)
+                  | SOME (FrameInfo.T {frameLayoutsIndex, ...}) =>
+                       (entry frameLayoutsIndex
+                        ; SOME frameLayoutsIndex)
+           in
+              setLabelInfo (label, {block = b,
+                                    chunkLabel = chunkLabel,
+                                    frameIndex = frameIndex,
+                                    layedOut = ref false,
+                                    status = ref None})
+           end))
+      val a = Array.fromList (!entryLabels)
+      val () = QuickSort.sortArray (a, fn ((_, i), (_, i')) => i <= i')
+      val entryLabels = Vector.map (Vector.fromArray a, #1)
       val labelChunk = #chunkLabel o labelInfo
       val {get = chunkLabelIndex: ChunkLabel.t -> int, ...} =
-	 Property.getSet (ChunkLabel.plist,
-			  Property.initFun (let
-					       val c = Counter.new 0
-					    in
-					       fn _ => Counter.next c
-					    end))
+         Property.getSet (ChunkLabel.plist,
+                          Property.initFun (let
+                                               val c = Counter.new 0
+                                            in
+                                               fn _ => Counter.next c
+                                            end))
       val chunkLabelToString = C.int o chunkLabelIndex
       fun declareChunk (Chunk.T {chunkLabel, ...}, print) =
-	 C.call ("DeclareChunk",
-		 [chunkLabelToString chunkLabel],
-		 print)
+         C.call ("DeclareChunk",
+                 [chunkLabelToString chunkLabel],
+                 print)
       val {get = labelIndex, set = setLabelIndex, ...} =
-	 Property.getSetOnce (Label.plist,
-			      Property.initRaise ("index", Label.layout))
+         Property.getSetOnce (Label.plist,
+                              Property.initRaise ("index", Label.layout))
       val _ =
-	 Vector.foreachi (entryLabels, fn (i, l) => setLabelIndex (l, i))
+         Vector.foreachi (entryLabels, fn (i, l) => setLabelIndex (l, i))
       fun labelToStringIndex (l: Label.t): string =
-	 let
-	    val s = C.int (labelIndex l)
-	 in
-	    if 0 = !Control.Native.commented
-	       then s
-	    else concat [s, " /* ", Label.toString l, " */"]
-	 end
+         let
+            val s = C.int (labelIndex l)
+         in
+            if 0 = !Control.Native.commented
+               then s
+            else concat [s, " /* ", Label.toString l, " */"]
+         end
       val handleMisalignedReals =
-	 let
-	    open Control
-	 in
-	    !align = Align4 andalso !targetArch = Sparc
-	 end
+         let
+            open Control
+         in
+            !align = Align4 andalso !targetArch = Sparc
+         end
       fun addr z = concat ["&(", z, ")"]
       fun realFetch z = concat ["Real64_fetch(", addr z, ")"]
       fun realMove {dst, src} =
-	 concat ["Real64_move(", addr dst, ", ", addr src, ");\n"]
+         concat ["Real64_move(", addr dst, ", ", addr src, ");\n"]
       fun realStore {dst, src} =
-	 concat ["Real64_store(", addr dst, ", ", src, ");\n"]
+         concat ["Real64_store(", addr dst, ", ", src, ");\n"]
       fun move {dst: string, dstIsMem: bool,
-		src: string, srcIsMem: bool,
-		ty: Type.t}: string =
-	 if handleMisalignedReals
-	    andalso Type.equals (ty, Type.real R64)
-	    then
-	       case (dstIsMem, srcIsMem) of
-		  (false, false) => concat [dst, " = ", src, ";\n"]
-		| (false, true) => concat [dst, " = ", realFetch src, ";\n"]
-		| (true, false) => realStore {dst = dst, src = src}
-		| (true, true) => realMove {dst = dst, src = src}
-	 else concat [dst, " = ", src, ";\n"]
+                src: string, srcIsMem: bool,
+                ty: Type.t}: string =
+         if handleMisalignedReals
+            andalso Type.equals (ty, Type.real R64)
+            then
+               case (dstIsMem, srcIsMem) of
+                  (false, false) => concat [dst, " = ", src, ";\n"]
+                | (false, true) => concat [dst, " = ", realFetch src, ";\n"]
+                | (true, false) => realStore {dst = dst, src = src}
+                | (true, true) => realMove {dst = dst, src = src}
+         else concat [dst, " = ", src, ";\n"]
       local
-	 datatype z = datatype Operand.t
-      	 fun toString (z: Operand.t): string =
-	    case z of
-	       ArrayOffset {base, index, offset, scale, ty} =>
-		  concat ["X", C.args [Type.toC ty,
-				       toString base,
-				       toString index,
-				       Scale.toString scale,
-				       C.bytes offset]]
-	     | Cast (z, ty) => concat ["(", Type.toC ty, ")", toString z]
-	     | Contents {oper, ty} => contents (ty, toString oper)
-	     | File => "__FILE__"
-	     | Frontier => "Frontier"
-	     | GCState => "GCState"
-	     | Global g =>
-		  if Global.isRoot g
-		     then concat ["G",
-				  C.args [Type.toC (Global.ty g),
-					  Int.toString (Global.index g)]]
-		  else concat ["GPNR", C.args [Int.toString (Global.index g)]]
-	     | Label l => labelToStringIndex l
-	     | Line => "__LINE__"
-	     | Offset {base, offset, ty} =>
-		  concat ["O", C.args [Type.toC ty,
-				       toString base,
-				       C.bytes offset]]
-	     | Real r => RealX.toC r
-	     | Register r =>
-		  concat [Type.name (Register.ty r), "_",
-			  Int.toString (Register.index r)]
-	     | StackOffset s => StackOffset.toString s
-	     | StackTop => "StackTop"
-	     | Word w => WordX.toC w
+         datatype z = datatype Operand.t
+         fun toString (z: Operand.t): string =
+            case z of
+               ArrayOffset {base, index, offset, scale, ty} =>
+                  concat ["X", C.args [Type.toC ty,
+                                       toString base,
+                                       toString index,
+                                       Scale.toString scale,
+                                       C.bytes offset]]
+             | Cast (z, ty) => concat ["(", Type.toC ty, ")", toString z]
+             | Contents {oper, ty} => contents (ty, toString oper)
+             | File => "__FILE__"
+             | Frontier => "Frontier"
+             | GCState => "GCState"
+             | Global g =>
+                  if Global.isRoot g
+                     then concat ["G",
+                                  C.args [Type.toC (Global.ty g),
+                                          Int.toString (Global.index g)]]
+                  else concat ["GPNR", C.args [Int.toString (Global.index g)]]
+             | Label l => labelToStringIndex l
+             | Line => "__LINE__"
+             | Offset {base, offset, ty} =>
+                  concat ["O", C.args [Type.toC ty,
+                                       toString base,
+                                       C.bytes offset]]
+             | Real r => RealX.toC r
+             | Register r =>
+                  concat [Type.name (Register.ty r), "_",
+                          Int.toString (Register.index r)]
+             | StackOffset s => StackOffset.toString s
+             | StackTop => "StackTop"
+             | Word w => WordX.toC w
       in
-	 val operandToString = toString
+         val operandToString = toString
       end
       fun fetchOperand (z: Operand.t): string =
-	 if handleMisalignedReals
-	    andalso Type.equals (Operand.ty z, Type.real R64)
-	    andalso Operand.isMem z
-	    then realFetch (operandToString z)
-	 else operandToString z
+         if handleMisalignedReals
+            andalso Type.equals (Operand.ty z, Type.real R64)
+            andalso Operand.isMem z
+            then realFetch (operandToString z)
+         else operandToString z
       fun outputStatement (s, print) =
-	 let
-	    datatype z = datatype Statement.t
-	 in
-	    case s of
-	       Noop => ()
-	     | _ =>
-		  (print "\t"
-		   ; (case s of
-			 Move {dst, src} =>
-			    print
-			    (move {dst = operandToString dst,
-				   dstIsMem = Operand.isMem dst,
-				   src = operandToString src,
-				   srcIsMem = Operand.isMem src,
-				   ty = Operand.ty dst})
-		       | Noop => ()
-		       | PrimApp {args, dst, prim} =>
-			    let
-			       fun call (): string =
-				  concat
-				  [Prim.toString prim,
-				   " (",
-				   concat
-				   (List.separate
-				    (Vector.toListMap (args, fetchOperand),
-				     ", ")),
-				   ")"]
-			       fun app (): string =
-				  case Prim.name prim of
-				     Prim.Name.FFI_Symbol {name, ...} => 
-					concat 
-					["((",CType.toString CType.Pointer,
-					 ")(&", name, "))"]
-				   | _ => call ()
-			    in
-			       case dst of
-				  NONE => (print (app ())
-					   ; print ";\n")
-				| SOME dst =>
-				     print (move {dst = operandToString dst,
-						  dstIsMem = Operand.isMem dst,
-						  src = app (),
-						  srcIsMem = false,
-						  ty = Operand.ty dst})
-			    end
-		       | ProfileLabel l =>
-			    C.call ("ProfileLabel", [ProfileLabel.toString l],
-				    print)
-			    ))
-	 end
-      val amTimeProfiling = !Control.profile = Control.ProfileTime
+         let
+            datatype z = datatype Statement.t
+         in
+            case s of
+               Noop => ()
+             | _ =>
+                  (print "\t"
+                   ; (case s of
+                         Move {dst, src} =>
+                            print
+                            (move {dst = operandToString dst,
+                                   dstIsMem = Operand.isMem dst,
+                                   src = operandToString src,
+                                   srcIsMem = Operand.isMem src,
+                                   ty = Operand.ty dst})
+                       | Noop => ()
+                       | PrimApp {args, dst, prim} =>
+                            let
+                               fun call (): string =
+                                  concat
+                                  [Prim.toString prim,
+                                   " (",
+                                   concat
+                                   (List.separate
+                                    (Vector.toListMap (args, fetchOperand),
+                                     ", ")),
+                                   ")"]
+                               fun app (): string =
+                                  case Prim.name prim of
+                                     Prim.Name.FFI_Symbol {name, ...} => 
+                                        concat 
+                                        ["((",CType.toString CType.Pointer,
+                                         ")(&", name, "))"]
+                                   | _ => call ()
+                            in
+                               case dst of
+                                  NONE => (print (app ())
+                                           ; print ";\n")
+                                | SOME dst =>
+                                     print (move {dst = operandToString dst,
+                                                  dstIsMem = Operand.isMem dst,
+                                                  src = app (),
+                                                  srcIsMem = false,
+                                                  ty = Operand.ty dst})
+                            end
+                       | ProfileLabel l =>
+                            C.call ("ProfileLabel", [ProfileLabel.toString l],
+                                    print)
+                            ))
+         end
+      val amTimeProfiling = 
+         !Control.profile = Control.ProfileTimeField
+         orelse !Control.profile = Control.ProfileTimeLabel
       fun outputChunk (chunk as Chunk.T {chunkLabel, blocks, regMax, ...}) =
-	 let
-	    val {done, print, ...} = outputC ()
-	    fun declareChunks () =
-	       let
-		  val {get, ...} =
-		     Property.get (ChunkLabel.plist,
-				   Property.initFun (fn _ => ref false))
-		  val _ =
-		     Vector.foreach
-		     (blocks, fn Block.T {transfer, ...} =>
-		      case transfer of
-			 Transfer.Call {label, ...} =>
-			    get (labelChunk label) := true
-		       | _ => ())
-		  val _ =
-		     List.foreach
-		     (chunks, fn c as Chunk.T {chunkLabel, ...} =>
-		      if ! (get chunkLabel)
-			 then declareChunk (c, print)
-		      else ())
-	       in
-		  ()
-	       end
-	    fun declareProfileLabels () =
-	       Vector.foreach
-	       (blocks, fn Block.T {statements, ...} =>
-		Vector.foreach
-		(statements, fn s =>
-		 case s of
-		    Statement.ProfileLabel l => declareProfileLabel (l, print)
-		  | _ => ()))
-	    (* Count how many times each label is jumped to. *)
-	    fun jump l =
-	       let
-		  val {status, ...} = labelInfo l
-	       in
-		  case !status of
-		     None => status := One
-		   | One => status := Many
-		   | Many => ()
-	       end
-	    fun force l = #status (labelInfo l) := Many
-	    val _ =
-		Vector.foreach
-		(blocks, fn Block.T {kind, label, transfer, ...} =>
-		 let
-		    val _ = if Kind.isEntry kind then jump label else ()
-		    datatype z = datatype Transfer.t
-		 in
-		    case transfer of
-		       Arith {overflow, success, ...} =>
-			  (jump overflow; jump success)
-		     | CCall {func, return, ...} =>
-			  if CFunction.maySwitchThreads func
-			     then ()
-			  else Option.app (return, jump)
-		     | Call {label, ...} => jump label
-		     | Goto dst => jump dst
-		     | Raise => ()
-		     | Return => ()
-		     | Switch s => Switch.foreachLabel (s, jump)
-		 end)
-	    fun push (return: Label.t, size: Bytes.t) =
-	       (print "\t"
-		; print (move {dst = (StackOffset.toString
-				      (StackOffset.T
-				       {offset = Bytes.- (size, Runtime.labelSize),
-					ty = Type.label return})),
-			       dstIsMem = true,
-			       src = operandToString (Operand.Label return),
-			       srcIsMem = false,
-			       ty = Type.label return})
-		; C.push (size, print)
-		; if amTimeProfiling
-		     then print "\tFlushStackTop();\n"
-		  else ())
-	    fun copyArgs (args: Operand.t vector): string list * (unit -> unit) =
-	       if Vector.exists (args,
-				 fn Operand.StackOffset _ => true
-				  | _ => false)
-		  then
-		     let
-			val _ = print "\t{\n"
-			val c = Counter.new 0
-			val args =
-			   Vector.toListMap
-			   (args, fn z =>
-			    case z of
-			       Operand.StackOffset s =>
-				  let
-				     val ty = StackOffset.ty s
-				     val tmp =
-					concat ["tmp",
-						Int.toString (Counter.next c)]
-				     val _ =
-					print
-					(concat
-					 ["\t", Type.toC ty, " ", tmp, " = ",
-					  fetchOperand z, ";\n"])
-				  in
-				     tmp
-				  end
-			     | _ => fetchOperand z)
-		     in
-			(args, fn () => print "\t}\n")
-		     end
-	       else (Vector.toListMap (args, fetchOperand),
-		     fn () => ())
-	    val tracePrintLabelCode =
-	       Trace.trace
-	       ("printLabelCode",
-		fn {block, layedOut, ...} =>
-		Layout.record [("block", Label.layout (Block.label block)),
-			       ("layedOut", Bool.layout (!layedOut))],
-		Unit.layout)
-	    fun maybePrintLabel l =
-	       if ! (#layedOut (labelInfo l))
-		  then ()
-	       else gotoLabel l
-	    and gotoLabel arg =
-	       traceGotoLabel
-	       (fn l =>
-		let
-		   val info as {layedOut, ...} = labelInfo l
-		in
-		   if !layedOut 
-		      then print (concat ["\tgoto ", Label.toString l, ";\n"])
-		   else printLabelCode info
-		end) arg
-	    and printLabelCode arg =
-	       tracePrintLabelCode
-	       (fn {block = Block.T {kind, label = l, live, statements,
-				     transfer, ...},
-		    layedOut, status, ...} =>
-		let
-		  val _ = layedOut := true
-		  val _ =
-		     case !status of
-			Many =>
-			   let
-			      val s = Label.toString l
-			   in
-			      print s
-			      ; print ":\n"
-			   end 
-		      | _ => ()
-		  fun pop (fi: FrameInfo.t) =
-		     (C.push (Bytes.~ (Program.frameSize (program, fi)), print)
-		      ; if amTimeProfiling
-			   then print "\tFlushStackTop();\n"
-			else ())
-		  val _ =
-		     case kind of
-			Kind.Cont {frameInfo, ...} => pop frameInfo
-		      | Kind.CReturn {dst, frameInfo, ...} =>
-			   (case frameInfo of
-			       NONE => ()
-			     | SOME fi => pop fi
-			    ; (Option.app
-			       (dst, fn x =>
-				let
-				   val x = Live.toOperand x
-				   val ty = Operand.ty x
-				in
-				   print
-				   (concat
-				    ["\t",
-				     move {dst = operandToString x,
-					   dstIsMem = Operand.isMem x,
-					   src = creturn ty,
-					   srcIsMem = false,
-					   ty = ty}])
-				end)))
-		      | Kind.Func => ()
-		      | Kind.Handler {frameInfo, ...} => pop frameInfo
-		      | Kind.Jump => ()
-		  val _ =
-		     if 0 = !Control.Native.commented
-			then ()
-		     else
-			if false
-			   then
-			      Vector.foreach
-			      (live, fn z =>
-			       let
-				  val z = Live.toOperand z
-			       in
-				  if Type.isPointer (Operand.ty z)
-				     then
-					print
-					(concat ["\tCheckPointer(",
-						 operandToString z,
-						 ");\n"])
-				  else ()
-			       end)
-			else
-			   print (let open Layout
-				  in toString
-				     (seq [str "\t/* live: ",
-					   Vector.layout Live.layout live,
-					   str " */\n"])
-				  end)
-		  val _ = Vector.foreach (statements, fn s =>
-					  outputStatement (s, print))
-		  val _ = outputTransfer (transfer, l)
-	       in ()
-	       end) arg
-	    and outputTransfer (t, source: Label.t) =
-	       let
-		  fun iff (test, a, b) =
-		     (force a
-		      ; C.call ("\tBNZ", [test, Label.toString a], print)
-		      ; gotoLabel b
-		      ; maybePrintLabel a)
-		  datatype z = datatype Transfer.t
-	       in
-		  case t of
-		     Arith {prim, args, dst, overflow, success, ...} =>
-			let
-			   val prim =
-			      let
-				 datatype z = datatype Prim.Name.t
-				 fun const i =
-				    case Vector.sub (args, i) of
-				       Operand.Word _ => true
-				     | _ => false
-				 fun const0 () = const 0
-				 fun const1 () = const 1
-			      in
-				 case Prim.name prim of
-				    Word_addCheck _ =>
-				       concat [Prim.toString prim,
-					       if const0 ()
-						  then "CX"
-					       else if const1 ()
-						       then "XC"
-						    else ""]
-				  | Word_mulCheck _ => Prim.toString prim
-				  | Word_negCheck _ => Prim.toString prim
-				  | Word_subCheck _ =>
-				       concat [Prim.toString prim,
-					       if const0 ()
-						  then "CX"
-					       else if const1 ()
-						       then "XC"
-						    else ""]
-				  | _ => Error.bug "strange overflow prim"
-			      end
-			   val _ = force overflow
-			in
+         let
+            val {done, print, ...} = outputC ()
+            fun declareChunks () =
+               let
+                  val {get, ...} =
+                     Property.get (ChunkLabel.plist,
+                                   Property.initFun (fn _ => ref false))
+                  val _ =
+                     Vector.foreach
+                     (blocks, fn Block.T {transfer, ...} =>
+                      case transfer of
+                         Transfer.Call {label, ...} =>
+                            get (labelChunk label) := true
+                       | _ => ())
+                  val _ =
+                     List.foreach
+                     (chunks, fn c as Chunk.T {chunkLabel, ...} =>
+                      if ! (get chunkLabel)
+                         then declareChunk (c, print)
+                      else ())
+               in
+                  ()
+               end
+            fun declareProfileLabels () =
+               Vector.foreach
+               (blocks, fn Block.T {statements, ...} =>
+                Vector.foreach
+                (statements, fn s =>
+                 case s of
+                    Statement.ProfileLabel l => declareProfileLabel (l, print)
+                  | _ => ()))
+            (* Count how many times each label is jumped to. *)
+            fun jump l =
+               let
+                  val {status, ...} = labelInfo l
+               in
+                  case !status of
+                     None => status := One
+                   | One => status := Many
+                   | Many => ()
+               end
+            fun force l = #status (labelInfo l) := Many
+            val _ =
+                Vector.foreach
+                (blocks, fn Block.T {kind, label, transfer, ...} =>
+                 let
+                    val _ = if Kind.isEntry kind then jump label else ()
+                    datatype z = datatype Transfer.t
+                 in
+                    case transfer of
+                       Arith {overflow, success, ...} =>
+                          (jump overflow; jump success)
+                     | CCall {func, return, ...} =>
+                          if CFunction.maySwitchThreads func
+                             then ()
+                          else Option.app (return, jump)
+                     | Call {label, ...} => jump label
+                     | Goto dst => jump dst
+                     | Raise => ()
+                     | Return => ()
+                     | Switch s => Switch.foreachLabel (s, jump)
+                 end)
+            fun push (return: Label.t, size: Bytes.t) =
+               (print "\t"
+                ; print (move {dst = (StackOffset.toString
+                                      (StackOffset.T
+                                       {offset = Bytes.- (size, Runtime.labelSize),
+                                        ty = Type.label return})),
+                               dstIsMem = true,
+                               src = operandToString (Operand.Label return),
+                               srcIsMem = false,
+                               ty = Type.label return})
+                ; C.push (size, print)
+                ; if amTimeProfiling
+                     then print "\tFlushStackTop();\n"
+                  else ())
+            fun copyArgs (args: Operand.t vector): string list * (unit -> unit) =
+               if Vector.exists (args,
+                                 fn Operand.StackOffset _ => true
+                                  | _ => false)
+                  then
+                     let
+                        val _ = print "\t{\n"
+                        val c = Counter.new 0
+                        val args =
+                           Vector.toListMap
+                           (args, fn z =>
+                            case z of
+                               Operand.StackOffset s =>
+                                  let
+                                     val ty = StackOffset.ty s
+                                     val tmp =
+                                        concat ["tmp",
+                                                Int.toString (Counter.next c)]
+                                     val _ =
+                                        print
+                                        (concat
+                                         ["\t", Type.toC ty, " ", tmp, " = ",
+                                          fetchOperand z, ";\n"])
+                                  in
+                                     tmp
+                                  end
+                             | _ => fetchOperand z)
+                     in
+                        (args, fn () => print "\t}\n")
+                     end
+               else (Vector.toListMap (args, fetchOperand),
+                     fn () => ())
+            val tracePrintLabelCode =
+               Trace.trace
+               ("CCodegen.printLabelCode",
+                fn {block, layedOut, ...} =>
+                Layout.record [("block", Label.layout (Block.label block)),
+                               ("layedOut", Bool.layout (!layedOut))],
+                Unit.layout)
+            fun maybePrintLabel l =
+               if ! (#layedOut (labelInfo l))
+                  then ()
+               else gotoLabel l
+            and gotoLabel arg =
+               traceGotoLabel
+               (fn l =>
+                let
+                   val info as {layedOut, ...} = labelInfo l
+                in
+                   if !layedOut 
+                      then print (concat ["\tgoto ", Label.toString l, ";\n"])
+                   else printLabelCode info
+                end) arg
+            and printLabelCode arg =
+               tracePrintLabelCode
+               (fn {block = Block.T {kind, label = l, live, statements,
+                                     transfer, ...},
+                    layedOut, status, ...} =>
+                let
+                  val _ = layedOut := true
+                  val _ =
+                     case !status of
+                        Many =>
+                           let
+                              val s = Label.toString l
+                           in
+                              print s
+                              ; print ":\n"
+                           end 
+                      | _ => ()
+                  fun pop (fi: FrameInfo.t) =
+                     (C.push (Bytes.~ (Program.frameSize (program, fi)), print)
+                      ; if amTimeProfiling
+                           then print "\tFlushStackTop();\n"
+                        else ())
+                  val _ =
+                     case kind of
+                        Kind.Cont {frameInfo, ...} => pop frameInfo
+                      | Kind.CReturn {dst, frameInfo, ...} =>
+                           (case frameInfo of
+                               NONE => ()
+                             | SOME fi => pop fi
+                            ; (Option.app
+                               (dst, fn x =>
+                                let
+                                   val x = Live.toOperand x
+                                   val ty = Operand.ty x
+                                in
+                                   print
+                                   (concat
+                                    ["\t",
+                                     move {dst = operandToString x,
+                                           dstIsMem = Operand.isMem x,
+                                           src = creturn ty,
+                                           srcIsMem = false,
+                                           ty = ty}])
+                                end)))
+                      | Kind.Func => ()
+                      | Kind.Handler {frameInfo, ...} => pop frameInfo
+                      | Kind.Jump => ()
+                  val _ =
+                     if 0 = !Control.Native.commented
+                        then ()
+                     else
+                        if false
+                           then
+                              Vector.foreach
+                              (live, fn z =>
+                               let
+                                  val z = Live.toOperand z
+                               in
+                                  if Type.isPointer (Operand.ty z)
+                                     then
+                                        print
+                                        (concat ["\tCheckPointer(",
+                                                 operandToString z,
+                                                 ");\n"])
+                                  else ()
+                               end)
+                        else
+                           print (let open Layout
+                                  in toString
+                                     (seq [str "\t/* live: ",
+                                           Vector.layout Live.layout live,
+                                           str " */\n"])
+                                  end)
+                  val _ = Vector.foreach (statements, fn s =>
+                                          outputStatement (s, print))
+                  val _ = outputTransfer (transfer, l)
+               in ()
+               end) arg
+            and outputTransfer (t, source: Label.t) =
+               let
+                  fun iff (test, a, b) =
+                     (force a
+                      ; C.call ("\tBNZ", [test, Label.toString a], print)
+                      ; gotoLabel b
+                      ; maybePrintLabel a)
+                  datatype z = datatype Transfer.t
+               in
+                  case t of
+                     Arith {prim, args, dst, overflow, success, ...} =>
+                        let
+                           val prim =
+                              let
+                                 datatype z = datatype Prim.Name.t
+                                 fun const i =
+                                    case Vector.sub (args, i) of
+                                       Operand.Word _ => true
+                                     | _ => false
+                                 fun const0 () = const 0
+                                 fun const1 () = const 1
+                              in
+                                 case Prim.name prim of
+                                    Word_addCheck _ =>
+                                       concat [Prim.toString prim,
+                                               if const0 ()
+                                                  then "CX"
+                                               else if const1 ()
+                                                       then "XC"
+                                                    else ""]
+                                  | Word_mulCheck _ => Prim.toString prim
+                                  | Word_negCheck _ => Prim.toString prim
+                                  | Word_subCheck _ =>
+                                       concat [Prim.toString prim,
+                                               if const0 ()
+                                                  then "CX"
+                                               else if const1 ()
+                                                       then "XC"
+                                                    else ""]
+                                  | _ => Error.bug "CCodegen.outputTransfer: Arith"
+                              end
+                           val _ = force overflow
+                        in
                            print "\t"
-			   ; C.call (prim,
-				     operandToString dst
-				     :: (Vector.toListMap (args, operandToString)
-					 @ [Label.toString overflow]),
-				     print)
-			   ; gotoLabel success 
-			   ; maybePrintLabel overflow
-			end
-		   | CCall {args, frameInfo, func, return} =>
-			let
-			   val CFunction.T {maySwitchThreads,
-					    modifiesFrontier,
-					    readsStackTop,
-					    return = returnTy,
-					    target,
-					    writesStackTop,...} = func
-			   val (args, afterCall) =
-			      case frameInfo of
-				 NONE =>
-				    (Vector.toListMap (args, fetchOperand),
-				     fn () => ())
-			       | SOME frameInfo =>
-				    let
-				       val size =
-					  Program.frameSize (program, frameInfo)
-				       val res = copyArgs args
-				       val _ = push (valOf return, size)
-				    in
-				       res
-				    end
-			   val _ =
-			      if modifiesFrontier
-				 then print "\tFlushFrontier();\n"
-			      else ()
-			   val _ =
-			      if readsStackTop
-				 then print "\tFlushStackTop();\n"
-			      else ()
-			   val _ = print "\t"
-			   val _ =
-			      if Type.isUnit returnTy
-				 then ()
-			      else print (concat [creturn returnTy, " = "])
-			   datatype z = datatype CFunction.Target.t
-			   val _ =
-			      case target of
-				 Direct name => C.call (name, args, print)
-			       | Indirect =>
-				    let
-				       val (fptr,args) =
-					  case args of
-					     (fptr::args) => (fptr, args)
-					   | _ => Error.bug "indirect ccall: empty args"
-				       val name =
-					  concat ["(*(", 
-						  CFunction.cPointerType func,
-						  " ", fptr, "))"]
-				    in
-				       C.call (name, args, print)
-				    end
-			   val _ = afterCall ()
- 			   val _ =
-			      if modifiesFrontier
-				 then print "\tCacheFrontier();\n"
-			      else ()
-			   val _ =
-			      if writesStackTop
-				 then print "\tCacheStackTop();\n"
-			      else ()
-			   val _ =
-			      if maySwitchThreads
-				 then print "\tReturn();\n"
-			      else Option.app (return, gotoLabel)
-			in
-			   ()
-			end
-		   | Call {label, return, ...} =>
-			let
-			   val dstChunk = labelChunk label
-			   val _ =
-			      case return of
-				 NONE => ()
-			       | SOME {return, size, ...} =>
-				    push (return, size)
-			in
-			   if ChunkLabel.equals (labelChunk source, dstChunk)
-			      then gotoLabel label
-			   else
-			      C.call ("\tFarJump", 
-				      [chunkLabelToString dstChunk, 
-				       labelToStringIndex label],
-				      print)
-			end
-		   | Goto dst => gotoLabel dst
-		   | Raise => C.call ("\tRaise", [], print)
-		   | Return => C.call ("\tReturn", [], print)
-		   | Switch switch =>
-			let 
-			   fun bool (test: Operand.t, t, f) =
-			      iff (operandToString test, t, f)
-			   fun doit {cases: (string * Label.t) vector,
-				     default: Label.t option,
-				     test: Operand.t}: unit =
-			      let
-				 val test = operandToString test
-				 fun switch (cases: (string * Label.t) vector,
-					     default: Label.t): unit =
-				    (print "switch ("
-				     ; print test
-				     ; print ") {\n"
-				     ; (Vector.foreach
-					(cases, fn (n, l) => (print "case "
-							      ; print n
-							      ; print ":\n"
-							      ; gotoLabel l)))
-				     ; print "default:\n"
-				     ; gotoLabel default
-				     ; print "}\n")
-			      in
-				 case (Vector.length cases, default) of
-				    (0, NONE) =>
-				       Error.bug "switch: empty cases"
-				  | (0, SOME l) => gotoLabel l
-				  | (1, NONE) =>
-				       gotoLabel (#2 (Vector.sub (cases, 0)))
-				  | (_, NONE) =>
-				       switch (Vector.dropPrefix (cases, 1),
-					       #2 (Vector.sub (cases, 0)))
-				  | (_, SOME l) => switch (cases, l)
-			      end
-			   val Switch.T {cases, default, test, ...} = switch
-			   fun normal () =
-			      doit {cases = Vector.map (cases, fn (c, l) =>
-							(WordX.toC c, l)),
-				    default = default,
-				    test = test}
-			in
-			   if 2 = Vector.length cases
-			      andalso Option.isNone default
-			      then
-				 let
-				    val (c0, l0) = Vector.sub (cases, 0)
-				    val (c1, l1) = Vector.sub (cases, 1)
-				    val i0 = WordX.toIntInf c0
-				    val i1 = WordX.toIntInf c1
-				 in
-				    if i0 = 0 andalso i1 = 1
-				       then bool (test, l1, l0)
-				    else if i0 = 1 andalso i1 = 0
-					    then bool (test, l0, l1)
-					 else normal ()
-				 end
-			   else normal ()
-			end
-	       end
-	    fun declareRegisters () =
-	       List.foreach
-	       (CType.all, fn t =>
-		let
-		   val pre = concat ["\t", CType.toString t, " ",
-				     CType.name t, "_"]
-		in
-		   Int.for (0, 1 + regMax t, fn i =>
-			    print (concat [pre, C.int i, ";\n"]))
-		end)
-	    fun outputOffsets () =
-	       List.foreach
-	       ([("ExnStackOffset", GCField.ExnStack),
-		 ("FrontierOffset", GCField.Frontier),
-		 ("StackBottomOffset", GCField.StackBottom),
-		 ("StackTopOffset", GCField.StackTop)],
-		fn (name, f) =>
-		print (concat ["#define ", name, " ",
-			       Bytes.toString (GCField.offset f), "\n"]))
-	 in
-	    outputIncludes (["c-chunk.h"], print)
-	    ; outputOffsets ()
-	    ; declareGlobals ("extern ", print)
-	    ; declareFFI (chunk, {print = print})
-	    ; declareChunks ()
-	    ; declareProfileLabels ()
-	    ; C.callNoSemi ("Chunk", [chunkLabelToString chunkLabel], print)
-	    ; print "\n"
-	    ; declareRegisters ()
-	    ; C.callNoSemi ("ChunkSwitch", [chunkLabelToString chunkLabel],
-			    print)
-	    ; print "\n"
-	    ; Vector.foreach (blocks, fn Block.T {kind, label, ...} =>
-			      if Kind.isEntry kind
-				 then (print "case "
-				       ; print (labelToStringIndex label)
-				       ; print ":\n"
-				       ; gotoLabel label)
-			      else ())
-	    ; print "EndChunk\n"
-	    ; done ()
-	 end
+                           ; C.call (prim,
+                                     operandToString dst
+                                     :: (Vector.toListMap (args, operandToString)
+                                         @ [Label.toString overflow]),
+                                     print)
+                           ; gotoLabel success 
+                           ; maybePrintLabel overflow
+                        end
+                   | CCall {args, frameInfo, func, return} =>
+                        let
+                           val CFunction.T {maySwitchThreads,
+                                            modifiesFrontier,
+                                            readsStackTop,
+                                            return = returnTy,
+                                            target,
+                                            writesStackTop,...} = func
+                           val (args, afterCall) =
+                              case frameInfo of
+                                 NONE =>
+                                    (Vector.toListMap (args, fetchOperand),
+                                     fn () => ())
+                               | SOME frameInfo =>
+                                    let
+                                       val size =
+                                          Program.frameSize (program, frameInfo)
+                                       val res = copyArgs args
+                                       val _ = push (valOf return, size)
+                                    in
+                                       res
+                                    end
+                           val _ =
+                              if modifiesFrontier
+                                 then print "\tFlushFrontier();\n"
+                              else ()
+                           val _ =
+                              if readsStackTop
+                                 then print "\tFlushStackTop();\n"
+                              else ()
+                           val _ = print "\t"
+                           val _ =
+                              if Type.isUnit returnTy
+                                 then ()
+                              else print (concat [creturn returnTy, " = "])
+                           datatype z = datatype CFunction.Target.t
+                           val _ =
+                              case target of
+                                 Direct name => C.call (name, args, print)
+                               | Indirect =>
+                                    let
+                                       val (fptr,args) =
+                                          case args of
+                                             (fptr::args) => (fptr, args)
+                                           | _ => Error.bug "CCodegen.outputTransfer: CCall,Indirect"
+                                       val name =
+                                          concat ["(*(", 
+                                                  CFunction.cPointerType func,
+                                                  " ", fptr, "))"]
+                                    in
+                                       C.call (name, args, print)
+                                    end
+                           val _ = afterCall ()
+                           val _ =
+                              if modifiesFrontier
+                                 then print "\tCacheFrontier();\n"
+                              else ()
+                           val _ =
+                              if writesStackTop
+                                 then print "\tCacheStackTop();\n"
+                              else ()
+                           val _ =
+                              if maySwitchThreads
+                                 then print "\tReturn();\n"
+                              else Option.app (return, gotoLabel)
+                        in
+                           ()
+                        end
+                   | Call {label, return, ...} =>
+                        let
+                           val dstChunk = labelChunk label
+                           val _ =
+                              case return of
+                                 NONE => ()
+                               | SOME {return, size, ...} =>
+                                    push (return, size)
+                        in
+                           if ChunkLabel.equals (labelChunk source, dstChunk)
+                              then gotoLabel label
+                           else
+                              C.call ("\tFarJump", 
+                                      [chunkLabelToString dstChunk, 
+                                       labelToStringIndex label],
+                                      print)
+                        end
+                   | Goto dst => gotoLabel dst
+                   | Raise => C.call ("\tRaise", [], print)
+                   | Return => C.call ("\tReturn", [], print)
+                   | Switch switch =>
+                        let 
+                           fun bool (test: Operand.t, t, f) =
+                              iff (operandToString test, t, f)
+                           fun doit {cases: (string * Label.t) vector,
+                                     default: Label.t option,
+                                     test: Operand.t}: unit =
+                              let
+                                 val test = operandToString test
+                                 fun switch (cases: (string * Label.t) vector,
+                                             default: Label.t): unit =
+                                    (print "switch ("
+                                     ; print test
+                                     ; print ") {\n"
+                                     ; (Vector.foreach
+                                        (cases, fn (n, l) => (print "case "
+                                                              ; print n
+                                                              ; print ":\n"
+                                                              ; gotoLabel l)))
+                                     ; print "default:\n"
+                                     ; gotoLabel default
+                                     ; print "}\n")
+                              in
+                                 case (Vector.length cases, default) of
+                                    (0, NONE) =>
+                                       Error.bug "CCodegen.outputTransfers: Switch"
+                                  | (0, SOME l) => gotoLabel l
+                                  | (1, NONE) =>
+                                       gotoLabel (#2 (Vector.sub (cases, 0)))
+                                  | (_, NONE) =>
+                                       switch (Vector.dropPrefix (cases, 1),
+                                               #2 (Vector.sub (cases, 0)))
+                                  | (_, SOME l) => switch (cases, l)
+                              end
+                           val Switch.T {cases, default, test, ...} = switch
+                           fun normal () =
+                              doit {cases = Vector.map (cases, fn (c, l) =>
+                                                        (WordX.toC c, l)),
+                                    default = default,
+                                    test = test}
+                        in
+                           if 2 = Vector.length cases
+                              andalso Option.isNone default
+                              then
+                                 let
+                                    val (c0, l0) = Vector.sub (cases, 0)
+                                    val (c1, l1) = Vector.sub (cases, 1)
+                                    val i0 = WordX.toIntInf c0
+                                    val i1 = WordX.toIntInf c1
+                                 in
+                                    if i0 = 0 andalso i1 = 1
+                                       then bool (test, l1, l0)
+                                    else if i0 = 1 andalso i1 = 0
+                                            then bool (test, l0, l1)
+                                         else normal ()
+                                 end
+                           else normal ()
+                        end
+               end
+            fun declareRegisters () =
+               List.foreach
+               (CType.all, fn t =>
+                let
+                   val pre = concat ["\t", CType.toString t, " ",
+                                     CType.name t, "_"]
+                in
+                   Int.for (0, 1 + regMax t, fn i =>
+                            print (concat [pre, C.int i, ";\n"]))
+                end)
+            fun outputOffsets () =
+               List.foreach
+               ([("ExnStackOffset", GCField.ExnStack),
+                 ("FrontierOffset", GCField.Frontier),
+                 ("StackBottomOffset", GCField.StackBottom),
+                 ("StackTopOffset", GCField.StackTop)],
+                fn (name, f) =>
+                print (concat ["#define ", name, " ",
+                               Bytes.toString (GCField.offset f), "\n"]))
+         in
+            outputIncludes (["c-chunk.h"], print)
+            ; outputOffsets ()
+            ; declareGlobals ("extern ", print)
+            ; declareFFI (chunk, {print = print})
+            ; declareChunks ()
+            ; declareProfileLabels ()
+            ; C.callNoSemi ("Chunk", [chunkLabelToString chunkLabel], print)
+            ; print "\n"
+            ; declareRegisters ()
+            ; C.callNoSemi ("ChunkSwitch", [chunkLabelToString chunkLabel],
+                            print)
+            ; print "\n"
+            ; Vector.foreach (blocks, fn Block.T {kind, label, ...} =>
+                              if Kind.isEntry kind
+                                 then (print "case "
+                                       ; print (labelToStringIndex label)
+                                       ; print ":\n"
+                                       ; gotoLabel label)
+                              else ())
+            ; print "EndChunk\n"
+            ; done ()
+         end
       val additionalMainArgs =
-	 [chunkLabelToString chunkLabel,
-	  labelToStringIndex label]
+         [chunkLabelToString chunkLabel,
+          labelToStringIndex label]
       val {print, done, ...} = outputC ()
       fun rest () =
-	 (List.foreach (chunks, fn c => declareChunk (c, print))
-	  ; print "struct cont ( *nextChunks []) () = {"
-	  ; Vector.foreach (entryLabels, fn l =>
-			    let
-			       val {chunkLabel, ...} = labelInfo l
-			    in
-			       print "\t"
-			       ; C.callNoSemi ("Chunkp",
-					       [chunkLabelToString chunkLabel],
-					       print)
-			       ; print ",\n"
-			    end)
-	  ; print "};\n")
+         (List.foreach (chunks, fn c => declareChunk (c, print))
+          ; print "struct cont ( *nextChunks []) () = {"
+          ; Vector.foreach (entryLabels, fn l =>
+                            let
+                               val {chunkLabel, ...} = labelInfo l
+                            in
+                               print "\t"
+                               ; C.callNoSemi ("Chunkp",
+                                               [chunkLabelToString chunkLabel],
+                                               print)
+                               ; print ",\n"
+                            end)
+          ; print "};\n")
       val _ = 
-	 outputDeclarations {additionalMainArgs = additionalMainArgs,
-			     includes = ["c-main.h"],
-			     program = program,
-			     print = print,
-			     rest = rest}
+         outputDeclarations {additionalMainArgs = additionalMainArgs,
+                             includes = ["c-main.h"],
+                             program = program,
+                             print = print,
+                             rest = rest}
       val _ = done ()
       val _ = List.foreach (chunks, outputChunk)
    in

Modified: mlton/branches/on-20050420-cmm-branch/mlton/codegen/c-codegen/c-codegen.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/codegen/c-codegen/c-codegen.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/codegen/c-codegen/c-codegen.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature C_CODEGEN_STRUCTS =
    sig
       structure Ffi: FFI
@@ -19,14 +20,14 @@
       val declareFFI: Machine.Chunk.t * {print: string -> unit} -> unit
       val implementsPrim: 'a Machine.Prim.t -> bool
       val output: {program: Machine.Program.t,
-		   outputC: unit -> {file: File.t,
-				     print: string -> unit,
-				     done: unit -> unit}
-		   } -> unit
+                   outputC: unit -> {file: File.t,
+                                     print: string -> unit,
+                                     done: unit -> unit}
+                   } -> unit
       val outputDeclarations: {additionalMainArgs: string list,
-			       includes: string list,
-			       print: string -> unit,
-			       program: Machine.Program.t,
-			       rest: unit -> unit
-			       } -> unit
+                               includes: string list,
+                               print: string -> unit,
+                               program: Machine.Program.t,
+                               rest: unit -> unit
+                               } -> unit
    end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/codegen/c-codegen/sources.cm
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/codegen/c-codegen/sources.cm	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/codegen/c-codegen/sources.cm	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 Group
 
 signature C_CODEGEN

Modified: mlton/branches/on-20050420-cmm-branch/mlton/codegen/c-codegen/sources.mlb
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/codegen/c-codegen/sources.mlb	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/codegen/c-codegen/sources.mlb	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,19 +1,20 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 local
-    ../../atoms/sources.mlb
-    ../../control/sources.mlb
-    ../../../lib/mlton/sources.mlb
-    ../../backend/sources.mlb
+   ../../atoms/sources.mlb
+   ../../control/sources.mlb
+   ../../../lib/mlton/sources.mlb
+   ../../backend/sources.mlb
 
-    c-codegen.sig
-    c-codegen.fun
+   c-codegen.sig
+   c-codegen.fun
 in
-    signature C_CODEGEN
-    functor CCodegen
+   signature C_CODEGEN
+   functor CCodegen
 end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/codegen/sources.cm
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/codegen/sources.cm	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/codegen/sources.cm	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 Group
 
 functor Bytecode

Modified: mlton/branches/on-20050420-cmm-branch/mlton/codegen/sources.mlb
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/codegen/sources.mlb	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/codegen/sources.mlb	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,19 +1,19 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 local
-    c-codegen/sources.mlb
-    cmm-codegen/sources.mlb
-    bytecode/sources.mlb
-    x86-codegen/sources.mlb
+   c-codegen/sources.mlb
+   cmm-codegen/sources.mlb
+   bytecode/sources.mlb
+   x86-codegen/sources.mlb
 in
-    functor Bytecode
-    functor CCodegen
-    functor CmmCodegen
-    functor x86Codegen
+   functor Bytecode
+   functor CCodegen
+   functor CmmCodegen
+   functor x86Codegen
 end
-

Modified: mlton/branches/on-20050420-cmm-branch/mlton/codegen/x86-codegen/peephole.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/codegen/x86-codegen/peephole.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/codegen/x86-codegen/peephole.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,9 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 functor Peephole(T : PEEPHOLE_TYPES): PEEPHOLE =
@@ -11,7 +11,7 @@
     open T
 
     datatype statement_border = Empty
-	                      | EmptyOrNonEmpty
+                              | EmptyOrNonEmpty
     type statement_element = (int * int option) * (statement_type -> bool)
     type transfer_element = transfer_type -> bool
 
@@ -25,320 +25,320 @@
       = fn p => ((0, NONE), p)
 
     type template = {start: statement_border,
-		     statements: statement_element list,
-		     finish: statement_border,
-		     transfer: transfer_element}
-	
+                     statements: statement_element list,
+                     finish: statement_border,
+                     transfer: transfer_element}
+        
     type match = {entry: entry_type,
-		  profileLabel: profileLabel_type,
-		  start: statement_type list,
-		  statements: statement_type list list,
-		  finish: statement_type list,
-		  transfer: transfer_type}
+                  profileLabel: profileLabel_type,
+                  start: statement_type list,
+                  statements: statement_type list list,
+                  finish: statement_type list,
+                  transfer: transfer_type}
 
     type rewriter = match -> block option
 
     type callback = bool -> unit
 
     type optimization = {template: template, 
-			 rewriter: rewriter, 
-			 callback: callback}
+                         rewriter: rewriter, 
+                         callback: callback}
 
     datatype match_state
       = Start of {block: block}
       | Continue of {remaining: optimization list,
-		     match: match}
+                     match: match}
       | Done of {block: block}
 
     type find_state = {remaining: optimization list,
-		       state: {entry: entry_type,
-			       profileLabel: profileLabel_type,
-			       start: statement_type list,
-			       finish: statement_type list,
-			       transfer: transfer_type}}
+                       state: {entry: entry_type,
+                               profileLabel: profileLabel_type,
+                               start: statement_type list,
+                               finish: statement_type list,
+                               transfer: transfer_type}}
 
     fun split (l, p) 
       = case l 
           of [] => ([],[])
-	   | l as h::t => if p h
-			    then let
-				    val (tt,ff) = split (t, p)
-				 in
-				    (h::tt,ff)
-				 end
-			    else ([],l)
+           | l as h::t => if p h
+                            then let
+                                    val (tt,ff) = split (t, p)
+                                 in
+                                    (h::tt,ff)
+                                 end
+                            else ([],l)
 
     val rec matcher' : {template_statement: statement_element,
-			statement: statement_type list,
-			finish: statement_type list} ->
+                        statement: statement_type list,
+                        finish: statement_type list} ->
                        {statement: statement_type list,
-			finish: statement_type list} option
+                        finish: statement_type list} option
       = fn (* Zero *)
-	   {template_statement = ((0, SOME 0), _),
-	    statement,
-	    finish}
-	 => SOME {statement = List.rev statement,
-		  finish = finish}
-	 | (* ZeroOrOne *)
-	   {template_statement = ((0, SOME 1), p),
-	    statement,
-	    finish}
-	 => (case finish
-	       of [] => SOME {statement = List.rev statement,
-			      finish = finish}
-		| (statement'::finish')
-		=> if p statement'
-		     then SOME {statement = List.rev (statement'::statement),
-				finish = finish'}
-		     else SOME {statement = List.rev statement,
-				finish = finish})
-	 | (* One *)
-	   {template_statement = ((1, SOME 1), p),
-	    statement,
-	    finish}
-	 => (case finish
-	       of [] => NONE
-		| (statement'::finish')
-		=> if p statement'
-		     then SOME {statement = List.rev (statement'::statement),
-				finish = finish'}
-		     else NONE)
-	 | (* *)
-	   {template_statement = ((0, SOME i), p),
-	    statement,
-	    finish}
-	 => (case finish
-	       of [] => SOME {statement = List.rev statement,
-			      finish = finish}
-		| (statement'::finish')
-		=> if p statement'
-		     then matcher' {template_statement = ((0, SOME (i-1)), p),
-				    statement = statement'::statement,
-				    finish = finish'}
-		     else SOME {statement = List.rev statement,
-				finish = finish})
-	 | (* All *)
-	   {template_statement = ((0, NONE), p),
-	    statement,
-	    finish}
+           {template_statement = ((0, SOME 0), _),
+            statement,
+            finish}
+         => SOME {statement = List.rev statement,
+                  finish = finish}
+         | (* ZeroOrOne *)
+           {template_statement = ((0, SOME 1), p),
+            statement,
+            finish}
+         => (case finish
+               of [] => SOME {statement = List.rev statement,
+                              finish = finish}
+                | (statement'::finish')
+                => if p statement'
+                     then SOME {statement = List.rev (statement'::statement),
+                                finish = finish'}
+                     else SOME {statement = List.rev statement,
+                                finish = finish})
+         | (* One *)
+           {template_statement = ((1, SOME 1), p),
+            statement,
+            finish}
+         => (case finish
+               of [] => NONE
+                | (statement'::finish')
+                => if p statement'
+                     then SOME {statement = List.rev (statement'::statement),
+                                finish = finish'}
+                     else NONE)
+         | (* *)
+           {template_statement = ((0, SOME i), p),
+            statement,
+            finish}
+         => (case finish
+               of [] => SOME {statement = List.rev statement,
+                              finish = finish}
+                | (statement'::finish')
+                => if p statement'
+                     then matcher' {template_statement = ((0, SOME (i-1)), p),
+                                    statement = statement'::statement,
+                                    finish = finish'}
+                     else SOME {statement = List.rev statement,
+                                finish = finish})
+         | (* All *)
+           {template_statement = ((0, NONE), p),
+            statement,
+            finish}
          => let
-	      val (statement',finish') = split (finish, p)
-	    in
-	      SOME {statement = List.fold(statement,
-					  statement',
-					  op ::),
-		    finish = finish'}
-	    end
-	 | {template_statement = ((min, max), p),
-	    statement,
-	    finish = (statement'::finish')}
-	 => if p statement'
-	      then matcher' {template_statement 
-			     = ((Int.max(min-1,0),
-				 Option.map(max,fn i => i - 1)), p),
-			     statement = statement'::statement,
-			     finish = finish'}
-	      else NONE
-	 | _ => NONE
+              val (statement',finish') = split (finish, p)
+            in
+              SOME {statement = List.fold(statement,
+                                          statement',
+                                          op ::),
+                    finish = finish'}
+            end
+         | {template_statement = ((min, max), p),
+            statement,
+            finish = (statement'::finish')}
+         => if p statement'
+              then matcher' {template_statement 
+                             = ((Int.max(min-1,0),
+                                 Option.map(max,fn i => i - 1)), p),
+                             statement = statement'::statement,
+                             finish = finish'}
+              else NONE
+         | _ => NONE
 
     val rec matcher : {template_statements: statement_element list,
-		       statements: statement_type list list,
-		       finish: statement_type list} ->
+                       statements: statement_type list list,
+                       finish: statement_type list} ->
                       {statements: statement_type list list,
-		       finish: statement_type list} option
+                       finish: statement_type list} option
       = fn {template_statements = [],
-	    statements,
-	    finish}
-	 => SOME {statements = List.rev statements,
-		  finish = finish}
-	 | {template_statements = (template_statement::template_statements),
-	    statements,
-	    finish}
-	 => (case matcher' {template_statement = template_statement,
-			    statement = [],
-			    finish = finish}
-	       of NONE => NONE
-		| SOME {statement, finish} 
-		=> matcher {template_statements = template_statements,
-			    statements = statement::statements,
-			    finish = finish})
+            statements,
+            finish}
+         => SOME {statements = List.rev statements,
+                  finish = finish}
+         | {template_statements = (template_statement::template_statements),
+            statements,
+            finish}
+         => (case matcher' {template_statement = template_statement,
+                            statement = [],
+                            finish = finish}
+               of NONE => NONE
+                | SOME {statement, finish} 
+                => matcher {template_statements = template_statements,
+                            statements = statement::statements,
+                            finish = finish})
 
     fun peepholeBlock' {optimizations: optimization list,
-			match_state: match_state}
+                        match_state: match_state}
       = let
-	  fun next {remaining: optimization list,
-		    state as {entry, profileLabel, start, finish, transfer}} : 
-	           find_state option 
-	    = (case remaining
-		 of [] => NONE
-		  | _::nil 
-		  => (case finish
-			of [] => NONE
-			 | statement::finish
-			 => SOME {remaining = optimizations,
-				  state = {entry = entry,
-					   profileLabel = profileLabel,
-					   start = statement::start,
-					   finish = finish,
-					   transfer = transfer}})
-		  | _::remaining
-		  => SOME {remaining = remaining,
-			   state = state})
+          fun next {remaining: optimization list,
+                    state as {entry, profileLabel, start, finish, transfer}} : 
+                   find_state option 
+            = (case remaining
+                 of [] => NONE
+                  | _::nil 
+                  => (case finish
+                        of [] => NONE
+                         | statement::finish
+                         => SOME {remaining = optimizations,
+                                  state = {entry = entry,
+                                           profileLabel = profileLabel,
+                                           start = statement::start,
+                                           finish = finish,
+                                           transfer = transfer}})
+                  | _::remaining
+                  => SOME {remaining = remaining,
+                           state = state})
      
-	  fun findMatch' (find_state 
-			  as {remaining as {template = {start 
-							= template_start,
-							statements 
-							= template_statements,
-							finish 
-							= template_finish,
-							transfer 
-							= template_transfer},
-					    ...}::_,
-			      state = {entry,
-				       profileLabel,
-				       start, 
-				       finish, 
-				       transfer}}) : 
-	                 match_state
-	    = let
-		fun loop ()
-		  = (case next find_state
-		       of SOME find_state => findMatch' find_state
-			| NONE 
-			=> Done {block = T {entry = entry,
-					    profileLabel = profileLabel,
-					    statements = List.fold(start,
-								   finish,
-								   op ::),
-					    transfer = transfer}})
-	      in
-		if not (template_transfer transfer)
-		  then loop ()
-		else if template_start = Empty
-		        andalso
-			not (List.isEmpty start)
-		     then loop ()
-		else case matcher {template_statements = template_statements,
-				   statements = [],
-				   finish = finish}
-		       of NONE => loop ()
-		        | SOME {statements, finish}
-		        => if template_finish = Empty
-			      andalso
-			      not (List.isEmpty finish)
-			     then loop ()
-			     else Continue {remaining = remaining,
-					    match 
-					    = {entry = entry,
-					       profileLabel = profileLabel,
-					       start = start,
-					       statements = statements,
-					       finish = finish,
-					       transfer = transfer}}
-	      end
-	    | findMatch' _ = Error.bug "findMatch'"
+          fun findMatch' (find_state 
+                          as {remaining as {template = {start 
+                                                        = template_start,
+                                                        statements 
+                                                        = template_statements,
+                                                        finish 
+                                                        = template_finish,
+                                                        transfer 
+                                                        = template_transfer},
+                                            ...}::_,
+                              state = {entry,
+                                       profileLabel,
+                                       start, 
+                                       finish, 
+                                       transfer}}) : 
+                         match_state
+            = let
+                fun loop ()
+                  = (case next find_state
+                       of SOME find_state => findMatch' find_state
+                        | NONE 
+                        => Done {block = T {entry = entry,
+                                            profileLabel = profileLabel,
+                                            statements = List.fold(start,
+                                                                   finish,
+                                                                   op ::),
+                                            transfer = transfer}})
+              in
+                if not (template_transfer transfer)
+                  then loop ()
+                else if template_start = Empty
+                        andalso
+                        not (List.isEmpty start)
+                     then loop ()
+                else case matcher {template_statements = template_statements,
+                                   statements = [],
+                                   finish = finish}
+                       of NONE => loop ()
+                        | SOME {statements, finish}
+                        => if template_finish = Empty
+                              andalso
+                              not (List.isEmpty finish)
+                             then loop ()
+                             else Continue {remaining = remaining,
+                                            match 
+                                            = {entry = entry,
+                                               profileLabel = profileLabel,
+                                               start = start,
+                                               statements = statements,
+                                               finish = finish,
+                                               transfer = transfer}}
+              end
+            | findMatch' _ = Error.bug "Peephole.peepholeBlock'.findMatch'"
 
-	  fun findMatch (match_state: match_state) : match_state
-	    = case match_state
-		of Start {block = T {entry, profileLabel, 
-				     statements, transfer}}
-		 => let
-		      val find_state
-			= {remaining = optimizations,
-			   state = {entry = entry,
-				    profileLabel = profileLabel,
-				    start = [],
-				    finish = statements,
-				    transfer = transfer}}
-		    in
-		      findMatch' find_state
-		    end
-	         | Continue {remaining,
-			     match = {entry, 
-				      profileLabel,
-				      start, 
-				      statements, 
-				      finish, 
-				      transfer},
-			     ...}
-		 => let
-		      val finish = List.foldr(statements,
-					      finish,
-					      op @)
-		      val find_state
-			= {remaining = remaining,
-			   state = {entry = entry,
-				    profileLabel = profileLabel,
-				    start = start,
-				    finish = finish,
-				    transfer = transfer}}
-		    in
-		      case next find_state
-			of NONE => Done {block 
-					 = T {entry = entry,
-					      profileLabel = profileLabel,
-					      statements = List.fold(start,
-								     finish,
-								     op ::),
-					      transfer = transfer}}
-			 | SOME find_state => findMatch' find_state
-		    end
-	       | Done _ => match_state
+          fun findMatch (match_state: match_state) : match_state
+            = case match_state
+                of Start {block = T {entry, profileLabel, 
+                                     statements, transfer}}
+                 => let
+                      val find_state
+                        = {remaining = optimizations,
+                           state = {entry = entry,
+                                    profileLabel = profileLabel,
+                                    start = [],
+                                    finish = statements,
+                                    transfer = transfer}}
+                    in
+                      findMatch' find_state
+                    end
+                 | Continue {remaining,
+                             match = {entry, 
+                                      profileLabel,
+                                      start, 
+                                      statements, 
+                                      finish, 
+                                      transfer},
+                             ...}
+                 => let
+                      val finish = List.foldr(statements,
+                                              finish,
+                                              op @)
+                      val find_state
+                        = {remaining = remaining,
+                           state = {entry = entry,
+                                    profileLabel = profileLabel,
+                                    start = start,
+                                    finish = finish,
+                                    transfer = transfer}}
+                    in
+                      case next find_state
+                        of NONE => Done {block 
+                                         = T {entry = entry,
+                                              profileLabel = profileLabel,
+                                              statements = List.fold(start,
+                                                                     finish,
+                                                                     op ::),
+                                              transfer = transfer}}
+                         | SOME find_state => findMatch' find_state
+                    end
+               | Done _ => match_state
 
-	  fun peepholeBlock'' {match_state: match_state,
-			       changed: bool}
-	    = case findMatch match_state
-		of match_state as Continue {remaining = {rewriter,
-							 callback,
-							 ...}::_,
-					    match}
-		 => (case rewriter match
-		       of SOME block 
-			=> (callback true;
-			    peepholeBlock'' {match_state 
-					     = Start {block = block},
-					     changed = true})
-		        | NONE 
-			=> (callback false;
-			    peepholeBlock'' {match_state = match_state,
-					     changed = changed}))
-	         | Done {block} => {block = block, changed = changed}
-		 | _ => Error.bug "Peephole: peepholeBlock''"
-	in
-	  case optimizations
-	    of [] => (case match_state
-			of Start {block = block} => {block = block,
-						     changed = false}
-			 | _ => Error.bug "Peephole: peepholeBlock'")
-	     | _ => peepholeBlock'' {match_state = match_state,
-				     changed = false}
-	end
+          fun peepholeBlock'' {match_state: match_state,
+                               changed: bool}
+            = case findMatch match_state
+                of match_state as Continue {remaining = {rewriter,
+                                                         callback,
+                                                         ...}::_,
+                                            match}
+                 => (case rewriter match
+                       of SOME block 
+                        => (callback true;
+                            peepholeBlock'' {match_state 
+                                             = Start {block = block},
+                                             changed = true})
+                        | NONE 
+                        => (callback false;
+                            peepholeBlock'' {match_state = match_state,
+                                             changed = changed}))
+                 | Done {block} => {block = block, changed = changed}
+                 | _ => Error.bug "Peephole.peepholeBlock''"
+        in
+          case optimizations
+            of [] => (case match_state
+                        of Start {block = block} => {block = block,
+                                                     changed = false}
+                         | _ => Error.bug "Peephole.peepholeBlock'")
+             | _ => peepholeBlock'' {match_state = match_state,
+                                     changed = false}
+        end
 
     fun peepholeBlock {block: block,
-		       optimizations: optimization list}
+                       optimizations: optimization list}
       = peepholeBlock' {optimizations = optimizations,
-			match_state = Start {block = block}}
+                        match_state = Start {block = block}}
 
     fun peepholeBlocks {blocks: block list,
-			optimizations: optimization list}
+                        optimizations: optimization list}
       = let
-	  val {blocks, changed}
-	    = List.foldr
-	      (blocks,
-	       {blocks = [], changed = false},
-	       fn (block,{blocks,changed})
-	        => let
-		     val {block = block',
-			  changed = changed'}
-		       = peepholeBlock' {optimizations = optimizations,
-					 match_state = Start {block = block}}
-		   in
-		     {blocks = block'::blocks,
-		      changed = changed orelse changed'}
-		   end)
-	in
-	  {blocks = blocks,
-	   changed = changed}
-	end
+          val {blocks, changed}
+            = List.foldr
+              (blocks,
+               {blocks = [], changed = false},
+               fn (block,{blocks,changed})
+                => let
+                     val {block = block',
+                          changed = changed'}
+                       = peepholeBlock' {optimizations = optimizations,
+                                         match_state = Start {block = block}}
+                   in
+                     {blocks = block'::blocks,
+                      changed = changed orelse changed'}
+                   end)
+        in
+          {blocks = blocks,
+           changed = changed}
+        end
   end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/codegen/x86-codegen/peephole.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/codegen/x86-codegen/peephole.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/codegen/x86-codegen/peephole.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 type int = Int.t
 
 signature PEEPHOLE_TYPES =
@@ -14,9 +15,9 @@
     type statement_type
     type transfer_type
     datatype block = T of {entry: entry_type,
-			   profileLabel: profileLabel_type,
-			   statements: statement_type list,
-			   transfer: transfer_type}
+                           profileLabel: profileLabel_type,
+                           statements: statement_type list,
+                           transfer: transfer_type}
   end
 
 signature PEEPHOLE =
@@ -32,33 +33,33 @@
     val One : (statement_type -> bool) -> statement_element 
     val ZeroOrOne : (statement_type -> bool) -> statement_element
     val All : (statement_type -> bool) -> statement_element
-		      
+                      
     type template = {start: statement_border,
-		     statements: statement_element list,
-		     finish: statement_border,
-		     transfer: transfer_element}
-	
+                     statements: statement_element list,
+                     finish: statement_border,
+                     transfer: transfer_element}
+        
     type match = {entry: entry_type,
-		  profileLabel: profileLabel_type,
-		  start: statement_type list,
-		  statements: statement_type list list,
-		  finish: statement_type list,
-		  transfer: transfer_type}
-		    
+                  profileLabel: profileLabel_type,
+                  start: statement_type list,
+                  statements: statement_type list list,
+                  finish: statement_type list,
+                  transfer: transfer_type}
+                    
     type rewriter = match -> block option
 
     type callback = bool -> unit
       
     type optimization = {template: template, 
-			 rewriter: rewriter,
-			 callback: callback}
+                         rewriter: rewriter,
+                         callback: callback}
       
     val peepholeBlock : {block: block,
-			 optimizations: optimization list} ->
+                         optimizations: optimization list} ->
                         {block: block,
-			 changed: bool}
+                         changed: bool}
     val peepholeBlocks : {blocks: block list,
-			  optimizations: optimization list} ->
+                          optimizations: optimization list} ->
                          {blocks: block list,
-			  changed: bool}
+                          changed: bool}
   end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/codegen/x86-codegen/sources.cm
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/codegen/x86-codegen/sources.cm	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/codegen/x86-codegen/sources.cm	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 Group
 
 functor x86Codegen

Modified: mlton/branches/on-20050420-cmm-branch/mlton/codegen/x86-codegen/sources.mlb
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/codegen/x86-codegen/sources.mlb	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/codegen/x86-codegen/sources.mlb	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,48 +1,49 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 local
-    ../../../lib/mlton/sources.mlb
-    ../../atoms/sources.mlb
-    ../../control/sources.mlb
-    ../../backend/sources.mlb
-    ../c-codegen/sources.mlb
+   ../../../lib/mlton/sources.mlb
+   ../../atoms/sources.mlb
+   ../../control/sources.mlb
+   ../../backend/sources.mlb
+   ../c-codegen/sources.mlb
 
-    peephole.sig
-    peephole.fun
-    x86.sig
-    x86.fun
-    x86-pseudo.sig
-    x86-mlton-basic.sig
-    x86-mlton-basic.fun
-    x86-liveness.sig
-    x86-liveness.fun
-    x86-mlton.sig
-    x86-mlton.fun
-    x86-allocate-registers.sig
-    x86-allocate-registers.fun
-    x86-entry-transfer.sig
-    x86-entry-transfer.fun
-    x86-jump-info.sig
-    x86-jump-info.fun
-    x86-loop-info.sig
-    x86-loop-info.fun
-    x86-live-transfers.sig
-    x86-live-transfers.fun
-    x86-generate-transfers.sig
-    x86-generate-transfers.fun
-    x86-simplify.sig
-    x86-simplify.fun
-    x86-translate.sig
-    x86-translate.fun
-    x86-validate.sig
-    x86-validate.fun
-    x86-codegen.sig
-    x86-codegen.fun
+   peephole.sig
+   peephole.fun
+   x86.sig
+   x86.fun
+   x86-pseudo.sig
+   x86-mlton-basic.sig
+   x86-mlton-basic.fun
+   x86-liveness.sig
+   x86-liveness.fun
+   x86-mlton.sig
+   x86-mlton.fun
+   x86-allocate-registers.sig
+   x86-allocate-registers.fun
+   x86-entry-transfer.sig
+   x86-entry-transfer.fun
+   x86-jump-info.sig
+   x86-jump-info.fun
+   x86-loop-info.sig
+   x86-loop-info.fun
+   x86-live-transfers.sig
+   x86-live-transfers.fun
+   x86-generate-transfers.sig
+   x86-generate-transfers.fun
+   x86-simplify.sig
+   x86-simplify.fun
+   x86-translate.sig
+   x86-translate.fun
+   x86-validate.sig
+   x86-validate.fun
+   x86-codegen.sig
+   x86-codegen.fun
 in
-    functor x86Codegen
-end
\ No newline at end of file
+   functor x86Codegen
+end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/codegen/x86-codegen/x86-allocate-registers.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/codegen/x86-codegen/x86-allocate-registers.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/codegen/x86-codegen/x86-allocate-registers.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 functor x86AllocateRegisters(S: X86_ALLOCATE_REGISTERS_STRUCTS) : X86_ALLOCATE_REGISTERS =
 struct
   
@@ -15,54 +16,54 @@
   val tracerTop = x86.tracerTop
 
   fun track memloc = let
-		       val trackClasses 
-			 = ClassSet.add(ClassSet.+
-					(!x86MLton.Classes.livenessClasses,
-					 !x86MLton.Classes.holdClasses),
-					x86MLton.Classes.StaticNonTemp)
-		     in
-		       ClassSet.contains(trackClasses, MemLoc.class memloc)
-		     end
+                       val trackClasses 
+                         = ClassSet.add(ClassSet.+
+                                        (!x86MLton.Classes.livenessClasses,
+                                         !x86MLton.Classes.holdClasses),
+                                        x86MLton.Classes.StaticNonTemp)
+                     in
+                       ClassSet.contains(trackClasses, MemLoc.class memloc)
+                     end
   fun volatile memloc = let
-			  val volatileClasses 
-			    = !x86MLton.Classes.volatileClasses
-		     in
-		       ClassSet.contains(volatileClasses, MemLoc.class memloc)
-		     end
+                          val volatileClasses 
+                            = !x86MLton.Classes.volatileClasses
+                     in
+                       ClassSet.contains(volatileClasses, MemLoc.class memloc)
+                     end
 
   fun partition(l, p)
     = let
-	val rec partition' 
-	  = fn ([],PS) => PS
-	     | (h::t,PS) => let
-			      val rec partition''
-				= fn [] => [[h]]
-				   | P::PS => if List.exists(P,fn x => p(h, x))
-						then (h::P)::PS
-						else P::(partition'' PS)
-			    in
-			      partition'(t,partition'' PS)
-			    end
+        val rec partition' 
+          = fn ([],PS) => PS
+             | (h::t,PS) => let
+                              val rec partition''
+                                = fn [] => [[h]]
+                                   | P::PS => if List.exists(P,fn x => p(h, x))
+                                                then (h::P)::PS
+                                                else P::(partition'' PS)
+                            in
+                              partition'(t,partition'' PS)
+                            end
       in
-	partition'(l,[])
+        partition'(l,[])
       end
 
   fun totalOrder (l, plt)
     = let
-	val rec totalOrder'
-	  = fn ([],l) => l
-	     | (h::t,l) => let
-			     val rec split
-			       = fn (lt,t) 
-			          => case List.splitPrefix
-			                  (t, fn x => plt(x,h))
-				       of (nil,t) => lt@[h]@t
-					| (lt',t) => split(lt@lt',t)
-			   in
-			     totalOrder'(t,split([],l))
-			   end
+        val rec totalOrder'
+          = fn ([],l) => l
+             | (h::t,l) => let
+                             val rec split
+                               = fn (lt,t) 
+                                  => case List.splitPrefix
+                                          (t, fn x => plt(x,h))
+                                       of (nil,t) => lt@[h]@t
+                                        | (lt',t) => split(lt@lt',t)
+                           in
+                             totalOrder'(t,split([],l))
+                           end
       in
-	totalOrder'(l,[])
+        totalOrder'(l,[])
       end
 
   val bool_lt
@@ -86,13 +87,13 @@
                                | FUSE | FUSEDEF | FDEF
 
       val futureMemlocTag_toString
-	= fn FLIVE => "FLIVE"
-	   | FCOMMIT => "FCOMMIT"
-	   | FREMOVE => "FREMOVE"
-	   | FDEAD => "FDEAD"
-	   | FUSE => "FUSE"
-	   | FUSEDEF => "FUSEDEF"
-	   | FDEF => "FDEF"
+        = fn FLIVE => "FLIVE"
+           | FCOMMIT => "FCOMMIT"
+           | FREMOVE => "FREMOVE"
+           | FDEAD => "FDEAD"
+           | FUSE => "FUSE"
+           | FUSEDEF => "FUSEDEF"
+           | FDEF => "FDEF"
 
       type futureMemloc = futureMemlocTag * MemLoc.t
 
@@ -100,564 +101,566 @@
                                    | FMCOMMITP | FMREMOVEP
 
       val futureMemlocPredTag_toString
-	= fn FCOMMITP => "FCOMMITP"
-	   | FREMOVEP => "FREMOVEP"
-	   | FDEADP => "FDEADP"
-	   | FMCOMMITP => "FMCOMMITP"
-	   | FMREMOVEP => "FMREMOVEP"
+        = fn FCOMMITP => "FCOMMITP"
+           | FREMOVEP => "FREMOVEP"
+           | FDEADP => "FDEADP"
+           | FMCOMMITP => "FMCOMMITP"
+           | FMREMOVEP => "FMREMOVEP"
 
       type futureMemlocPred = futureMemlocPredTag * (MemLoc.t -> bool)
 
       datatype future = M of futureMemloc | MP of futureMemlocPred
 
       val future_toString
-	= fn (M (tag, memloc))
-	   => concat [futureMemlocTag_toString tag, " ", MemLoc.toString memloc]
-	   | (MP (tag, _))
-	   => concat [futureMemlocPredTag_toString tag]
+        = fn (M (tag, memloc))
+           => concat [futureMemlocTag_toString tag, " ", MemLoc.toString memloc]
+           | (MP (tag, _))
+           => concat [futureMemlocPredTag_toString tag]
 
 
       type hint = Register.t * MemLoc.t list * MemLocSet.t
 
       val hint_toString
-	= fn (register, memlocs, _) 
-	   => concat ["{ ",
-		      List.fold
-		      (memlocs,
-		       "",
-		       fn (memloc, s) => s ^ (MemLoc.toString memloc) ^ " "),
-		      "} -> ",
-		      Register.toString register]
+        = fn (register, memlocs, _) 
+           => concat ["{ ",
+                      List.fold
+                      (memlocs,
+                       "",
+                       fn (memloc, s) => s ^ (MemLoc.toString memloc) ^ " "),
+                      "} -> ",
+                      Register.toString register]
 
       type t = {dead: MemLocSet.t,
-		commit: MemLocSet.t,
-		remove: MemLocSet.t,
-		futures: {pre: future list,
-			  post: future list},
-		hint: hint list}
+                commit: MemLocSet.t,
+                remove: MemLocSet.t,
+                futures: {pre: future list,
+                          post: future list},
+                hint: hint list}
 
+(*
       fun toString {dead, commit, remove, futures = {pre, post}, hint}
-	= let
-	    fun doit (name, l, toString, s)
-	      = List.fold(l, s,
-			  fn (x, s)
-			   => concat [name, toString x, "\n", s])
-	    fun doit' (name, l, toString, s)
-	      = MemLocSet.fold(l, s,
-			       fn (x, s)
-			        => concat [name, toString x, "\n", s])
-	  in
-	    doit'("dead: ", dead, MemLoc.toString,
-	    doit'("commit: ", commit, MemLoc.toString,
-	    doit'("remove: ", remove, MemLoc.toString,
-	    doit("future (pre): ", List.rev pre, future_toString,
-	    doit("future (post): ", List.rev post, future_toString, 
-	    doit("hint: ", hint, hint_toString, ""))))))
-	  end
+        = let
+            fun doit (name, l, toString, s)
+              = List.fold(l, s,
+                          fn (x, s)
+                           => concat [name, toString x, "\n", s])
+            fun doit' (name, l, toString, s)
+              = MemLocSet.fold(l, s,
+                               fn (x, s)
+                                => concat [name, toString x, "\n", s])
+          in
+            doit'("dead: ", dead, MemLoc.toString,
+            doit'("commit: ", commit, MemLoc.toString,
+            doit'("remove: ", remove, MemLoc.toString,
+            doit("future (pre): ", List.rev pre, future_toString,
+            doit("future (post): ", List.rev post, future_toString, 
+            doit("hint: ", hint, hint_toString, ""))))))
+          end
+*)
 
       fun toComments {dead, commit, remove, futures = {pre, post}, hint} 
-	= let
-	    fun doit (name, l, toString, ac)
-	      = List.fold(l, ac, 
-			  fn (x, ac) 
-		           => (Assembly.comment (concat [name, toString x]))::
-		              ac)
-	    fun doit' (name, l, toString, ac)
-	      = MemLocSet.fold(l, ac, 
-			       fn (x, ac) 
-			        => (Assembly.comment (concat [name, toString x]))::
-			           ac)
-	  in
-	    doit'("dead: ", dead, MemLoc.toString,
-	    doit'("commit: ", commit, MemLoc.toString,
-	    doit'("remove: ", remove, MemLoc.toString,
-	    doit("future (pre): ", List.rev pre, future_toString,
-	    doit("future (post): ", List.rev post, future_toString,
-	    doit("hint: ", hint, hint_toString, []))))))
-	  end
+        = let
+            fun doit (name, l, toString, ac)
+              = List.fold(l, ac, 
+                          fn (x, ac) 
+                           => (Assembly.comment (concat [name, toString x]))::
+                              ac)
+            fun doit' (name, l, toString, ac)
+              = MemLocSet.fold(l, ac, 
+                               fn (x, ac) 
+                                => (Assembly.comment (concat [name, toString x]))::
+                                   ac)
+          in
+            doit'("dead: ", dead, MemLoc.toString,
+            doit'("commit: ", commit, MemLoc.toString,
+            doit'("remove: ", remove, MemLoc.toString,
+            doit("future (pre): ", List.rev pre, future_toString,
+            doit("future (post): ", List.rev post, future_toString,
+            doit("hint: ", hint, hint_toString, []))))))
+          end
 
 
       datatype commit = NO | COMMIT | REMOVE | DEAD
 
       fun predict(future, memloc)
-	= let
-	    val rec sawNothing
-	      = fn [] => if track memloc then DEAD else REMOVE
-	         | (M (tag',memloc'))::future
-	         => if MemLoc.eq(memloc, memloc')
-		      then case tag'
-			     of FLIVE => NO
-			      | FCOMMIT => sawCommit future
-			      | FREMOVE => sawRemove future
-			      | FDEAD => DEAD
-			      | FUSE => sawUse future
-			      | FUSEDEF => NO
-			      | FDEF => DEAD
-		    else if ((tag' = FUSEDEF) orelse (tag' = FDEF))
+        = let
+            val rec sawNothing
+              = fn [] => if track memloc then DEAD else REMOVE
+                 | (M (tag',memloc'))::future
+                 => if MemLoc.eq(memloc, memloc')
+                      then case tag'
+                             of FLIVE => NO
+                              | FCOMMIT => sawCommit future
+                              | FREMOVE => sawRemove future
+                              | FDEAD => DEAD
+                              | FUSE => sawUse future
+                              | FUSEDEF => NO
+                              | FDEF => DEAD
+                    else if ((tag' = FUSEDEF) orelse (tag' = FDEF))
                             andalso
-		            List.exists
-			    (MemLoc.utilized memloc,
-			     fn memloc'' => MemLoc.mayAlias(memloc'', memloc'))
-		      then REMOVE
-		    else if MemLoc.mayAlias(memloc, memloc')
-		      then case tag'
-			     of FUSE => sawCommit future
-			      | FUSEDEF => REMOVE
-			      | FDEF => REMOVE
-			      | _ => sawNothing future
-		    else sawNothing future
-		 | (MP (tag',pred'))::future
-		 => if pred' memloc
-		      then case tag'
-			     of FCOMMITP => sawCommit future
-			      | FREMOVEP => sawRemove future
-			      | FDEADP => DEAD
-			      | FMCOMMITP => sawCommit future
-			      | FMREMOVEP => sawRemove future
-		      else sawNothing future
-	    and sawCommit
-	      = fn [] => REMOVE
-	         | (M (tag',memloc'))::future
-	         => if MemLoc.eq(memloc, memloc')
-		      then case tag'
-			     of FLIVE => COMMIT
-			      | FCOMMIT => sawCommit future
-			      | FREMOVE => REMOVE
-			      | FDEAD => REMOVE
-			      | FUSE => COMMIT
-			      | FUSEDEF => COMMIT
-			      | FDEF => REMOVE
-		    else if MemLoc.mayAlias(memloc, memloc')
-		      then case tag'
-			     of FUSE => sawCommit future
-			      | FUSEDEF => REMOVE
-			      | FDEF => REMOVE
-			      | _ => sawCommit future
-		    else sawCommit future
-		 | (MP (tag',pred'))::future
-		 => if pred' memloc
-		      then case tag'
-			     of FCOMMITP => sawCommit future
-			      | FREMOVEP => REMOVE
-			      | FDEADP => REMOVE
-			      | FMCOMMITP => sawCommit future
-			      | FMREMOVEP => REMOVE
-		      else sawCommit future
-	    and sawRemove
-	      = fn [] => REMOVE
-	         | (M (tag',memloc'))::future
-	         => if MemLoc.eq(memloc, memloc')
-		      then case tag'
-			     of FLIVE => REMOVE
-			      | FCOMMIT => REMOVE
-			      | FREMOVE => sawRemove future
-			      | FDEAD => DEAD
-			      | FUSE => REMOVE
-			      | FUSEDEF => REMOVE
-			      | FDEF => DEAD
-		    else if MemLoc.mayAlias(memloc, memloc')
-		      then case tag'
-			     of FUSE => REMOVE
-			      | FUSEDEF => REMOVE
-			      | FDEF => REMOVE
-			      | _ => sawRemove future
-		    else sawRemove future
-		 | (MP (tag',pred'))::future
-		 => if pred' memloc
-		      then case tag'
-			     of FCOMMITP => REMOVE
-			      | FREMOVEP => REMOVE
-			      | FDEADP => DEAD
-			      | FMCOMMITP => REMOVE
-			      | FMREMOVEP => sawRemove future
-		      else sawRemove future
-	    and sawUse
-	      = fn [] => if track memloc then NO else COMMIT
-	         | (M (tag',memloc'))::future
-	         => if MemLoc.eq(memloc, memloc')
-		      then case tag'
-			     of FLIVE => NO
-			      | FCOMMIT => sawUseCommit future
-			      | FREMOVE => NO
-			      | FDEAD => NO
-			      | FUSE => sawUse future
-			      | FUSEDEF => NO
-			      | FDEF => NO
-		    else if MemLoc.mayAlias(memloc, memloc')
-		      then case tag'
-			     of FUSE => sawUseCommit future
-			      | FUSEDEF => NO
-			      | FDEF => NO
-			      | _ => sawUse future
-		    else sawUse future
-		 | (MP (tag',pred'))::future
-		 => if pred' memloc
-		      then case tag'
-			     of FCOMMITP => sawUseCommit future
-			      | FREMOVEP => NO
-			      | FDEADP => NO
-			      | FMCOMMITP => sawUseCommit future
-			      | FMREMOVEP => NO
-		      else sawUse future
-	    and sawUseCommit
-	      = fn [] => if track memloc then NO else COMMIT
-	         | (M (tag',memloc'))::future
-	         => if MemLoc.eq(memloc, memloc')
-		      then case tag'
-			     of FLIVE => COMMIT
-			      | FCOMMIT => sawUseCommit future
-			      | FREMOVE => NO
-			      | FDEAD => NO
-			      | FUSE => COMMIT
-			      | FUSEDEF => COMMIT
-			      | FDEF => NO
-		    else if MemLoc.mayAlias(memloc, memloc')
-		      then case tag'
-			     of FUSE => sawUseCommit future
-			      | FUSEDEF => NO
-			      | FDEF => NO
-			      | _ => sawUseCommit future
-		    else sawUseCommit future
-		 | (MP (tag',pred'))::future
-		 => if pred' memloc
-		      then case tag'
-			     of FCOMMITP => sawUseCommit future
-			      | FREMOVEP => NO
-			      | FDEADP => NO
-			      | FMCOMMITP => sawUseCommit future
-			      | FMREMOVEP => NO
-		      else sawUseCommit future
+                            List.exists
+                            (MemLoc.utilized memloc,
+                             fn memloc'' => MemLoc.mayAlias(memloc'', memloc'))
+                      then REMOVE
+                    else if MemLoc.mayAlias(memloc, memloc')
+                      then case tag'
+                             of FUSE => sawCommit future
+                              | FUSEDEF => REMOVE
+                              | FDEF => REMOVE
+                              | _ => sawNothing future
+                    else sawNothing future
+                 | (MP (tag',pred'))::future
+                 => if pred' memloc
+                      then case tag'
+                             of FCOMMITP => sawCommit future
+                              | FREMOVEP => sawRemove future
+                              | FDEADP => DEAD
+                              | FMCOMMITP => sawCommit future
+                              | FMREMOVEP => sawRemove future
+                      else sawNothing future
+            and sawCommit
+              = fn [] => REMOVE
+                 | (M (tag',memloc'))::future
+                 => if MemLoc.eq(memloc, memloc')
+                      then case tag'
+                             of FLIVE => COMMIT
+                              | FCOMMIT => sawCommit future
+                              | FREMOVE => REMOVE
+                              | FDEAD => REMOVE
+                              | FUSE => COMMIT
+                              | FUSEDEF => COMMIT
+                              | FDEF => REMOVE
+                    else if MemLoc.mayAlias(memloc, memloc')
+                      then case tag'
+                             of FUSE => sawCommit future
+                              | FUSEDEF => REMOVE
+                              | FDEF => REMOVE
+                              | _ => sawCommit future
+                    else sawCommit future
+                 | (MP (tag',pred'))::future
+                 => if pred' memloc
+                      then case tag'
+                             of FCOMMITP => sawCommit future
+                              | FREMOVEP => REMOVE
+                              | FDEADP => REMOVE
+                              | FMCOMMITP => sawCommit future
+                              | FMREMOVEP => REMOVE
+                      else sawCommit future
+            and sawRemove
+              = fn [] => REMOVE
+                 | (M (tag',memloc'))::future
+                 => if MemLoc.eq(memloc, memloc')
+                      then case tag'
+                             of FLIVE => REMOVE
+                              | FCOMMIT => REMOVE
+                              | FREMOVE => sawRemove future
+                              | FDEAD => DEAD
+                              | FUSE => REMOVE
+                              | FUSEDEF => REMOVE
+                              | FDEF => DEAD
+                    else if MemLoc.mayAlias(memloc, memloc')
+                      then case tag'
+                             of FUSE => REMOVE
+                              | FUSEDEF => REMOVE
+                              | FDEF => REMOVE
+                              | _ => sawRemove future
+                    else sawRemove future
+                 | (MP (tag',pred'))::future
+                 => if pred' memloc
+                      then case tag'
+                             of FCOMMITP => REMOVE
+                              | FREMOVEP => REMOVE
+                              | FDEADP => DEAD
+                              | FMCOMMITP => REMOVE
+                              | FMREMOVEP => sawRemove future
+                      else sawRemove future
+            and sawUse
+              = fn [] => if track memloc then NO else COMMIT
+                 | (M (tag',memloc'))::future
+                 => if MemLoc.eq(memloc, memloc')
+                      then case tag'
+                             of FLIVE => NO
+                              | FCOMMIT => sawUseCommit future
+                              | FREMOVE => NO
+                              | FDEAD => NO
+                              | FUSE => sawUse future
+                              | FUSEDEF => NO
+                              | FDEF => NO
+                    else if MemLoc.mayAlias(memloc, memloc')
+                      then case tag'
+                             of FUSE => sawUseCommit future
+                              | FUSEDEF => NO
+                              | FDEF => NO
+                              | _ => sawUse future
+                    else sawUse future
+                 | (MP (tag',pred'))::future
+                 => if pred' memloc
+                      then case tag'
+                             of FCOMMITP => sawUseCommit future
+                              | FREMOVEP => NO
+                              | FDEADP => NO
+                              | FMCOMMITP => sawUseCommit future
+                              | FMREMOVEP => NO
+                      else sawUse future
+            and sawUseCommit
+              = fn [] => if track memloc then NO else COMMIT
+                 | (M (tag',memloc'))::future
+                 => if MemLoc.eq(memloc, memloc')
+                      then case tag'
+                             of FLIVE => COMMIT
+                              | FCOMMIT => sawUseCommit future
+                              | FREMOVE => NO
+                              | FDEAD => NO
+                              | FUSE => COMMIT
+                              | FUSEDEF => COMMIT
+                              | FDEF => NO
+                    else if MemLoc.mayAlias(memloc, memloc')
+                      then case tag'
+                             of FUSE => sawUseCommit future
+                              | FUSEDEF => NO
+                              | FDEF => NO
+                              | _ => sawUseCommit future
+                    else sawUseCommit future
+                 | (MP (tag',pred'))::future
+                 => if pred' memloc
+                      then case tag'
+                             of FCOMMITP => sawUseCommit future
+                              | FREMOVEP => NO
+                              | FDEADP => NO
+                              | FMCOMMITP => sawUseCommit future
+                              | FMREMOVEP => NO
+                      else sawUseCommit future
 
-	    fun check commit
-	      = if List.exists
-	           (MemLoc.utilized memloc,
-		    fn memloc' => case predict (future, memloc')
-				    of REMOVE => true
-				     | DEAD => true
-				     | _ => false)
-		  then REMOVE
-		  else commit
+            fun check commit
+              = if List.exists
+                   (MemLoc.utilized memloc,
+                    fn memloc' => case predict (future, memloc')
+                                    of REMOVE => true
+                                     | DEAD => true
+                                     | _ => false)
+                  then REMOVE
+                  else commit
 
-	    val default = case sawNothing future
-			    of REMOVE => REMOVE
-			     | DEAD => DEAD
-			     | commit => check commit
-	  in
-	    default
-	  end
+            val default = case sawNothing future
+                            of REMOVE => REMOVE
+                             | DEAD => DEAD
+                             | commit => check commit
+          in
+            default
+          end
 
       val split
-	= fn (set, p)
-	   => MemLocSet.fold
-	      (set,
-	       (MemLocSet.empty,MemLocSet.empty,MemLocSet.empty,MemLocSet.empty),
-	       fn (memloc, (no, commit, remove, dead))
-	        => let
-		     val add = fn set => MemLocSet.add(set, memloc)
-		   in
-		     case p memloc
-		       of NO => (add no, commit, remove, dead)
-			| COMMIT => (no, add commit, remove, dead)
-			| REMOVE => (no, commit, add remove, dead)
-			| DEAD => (no, commit, remove, add dead)
-		   end)
+        = fn (set, p)
+           => MemLocSet.fold
+              (set,
+               (MemLocSet.empty,MemLocSet.empty,MemLocSet.empty,MemLocSet.empty),
+               fn (memloc, (no, commit, remove, dead))
+                => let
+                     val add = fn set => MemLocSet.add(set, memloc)
+                   in
+                     case p memloc
+                       of NO => (add no, commit, remove, dead)
+                        | COMMIT => (no, add commit, remove, dead)
+                        | REMOVE => (no, commit, add remove, dead)
+                        | DEAD => (no, commit, remove, add dead)
+                   end)
 
       fun liveness {uses: MemLocSet.t,
-		    defs: MemLocSet.t,
-		    future: future list} :
-	           {dead: MemLocSet.t,
-		    commit: MemLocSet.t,
-		    remove: MemLocSet.t,
-		    future: future list}
-	= let
-	    local
-	      fun doit' (memlocs, set)
-		= MemLocSet.fold
-		  (memlocs,
-		   set,
-		   fn (memloc, set)
-		    => MemLocSet.union
-		       (set, MemLocSet.fromList (MemLoc.utilized memloc)))
-	    in
-	      val allUses
-		= doit'(defs,
-		  doit'(uses,
-			uses))
-	      val allDefs 
-		= defs
-	    end
+                    defs: MemLocSet.t,
+                    future: future list} :
+                   {dead: MemLocSet.t,
+                    commit: MemLocSet.t,
+                    remove: MemLocSet.t,
+                    future: future list}
+        = let
+            local
+              fun doit' (memlocs, set)
+                = MemLocSet.fold
+                  (memlocs,
+                   set,
+                   fn (memloc, set)
+                    => MemLocSet.union
+                       (set, MemLocSet.fromList (MemLoc.utilized memloc)))
+            in
+              val allUses
+                = doit'(defs,
+                  doit'(uses,
+                        uses))
+              val allDefs 
+                = defs
+            end
 
-	    val current
-	      = MemLocSet.+(allUses, allDefs)
-	    val current_usedef
-	      = MemLocSet.intersect(allUses, allDefs)
-	    val current_use
-	      = MemLocSet.-(allUses, current_usedef)
-	    val current_def
-	      = MemLocSet.-(allDefs, current_usedef)
+            val current
+              = MemLocSet.+(allUses, allDefs)
+            val current_usedef
+              = MemLocSet.intersect(allUses, allDefs)
+            val current_use
+              = MemLocSet.-(allUses, current_usedef)
+            val current_def
+              = MemLocSet.-(allDefs, current_usedef)
 
-	    val (_,commit,remove,dead)
-	      = split(current, fn memloc => predict(future, memloc))
+            val (_,commit,remove,dead)
+              = split(current, fn memloc => predict(future, memloc))
 
-	    val future
-	      = let
-		  fun doit(memlocs, tag, future)
-		    = MemLocSet.fold
-		      (memlocs,
-		       future,
-		       fn (memloc,future)
-		        => (M (tag, memloc))::future)
-		in
-		  doit(current_use, FUSE,
-		  doit(current_usedef, FUSEDEF,
-		  doit(current_def, FDEF,
-		       future)))
-		end
+            val future
+              = let
+                  fun doit(memlocs, tag, future)
+                    = MemLocSet.fold
+                      (memlocs,
+                       future,
+                       fn (memloc,future)
+                        => (M (tag, memloc))::future)
+                in
+                  doit(current_use, FUSE,
+                  doit(current_usedef, FUSEDEF,
+                  doit(current_def, FDEF,
+                       future)))
+                end
 
-	    val info
-	      = {dead = dead,
-		 commit = commit,
-		 remove = remove,
-		 future = future}
-	  in
-	    info
-	  end
+            val info
+              = {dead = dead,
+                 commit = commit,
+                 remove = remove,
+                 future = future}
+          in
+            info
+          end
 
       fun livenessInstruction {instruction: Instruction.t,
-			       future: future list}
+                               future: future list}
         = let
-	    val future_post = future
+            val future_post = future
 
-	    val {uses, defs, ...} = Instruction.uses_defs_kills instruction
-	    local 
-	      fun doit operands
-		= List.fold
-		  (operands,
-		   MemLocSet.empty,
-		   fn (operand, memlocs)
-		    => case Operand.deMemloc operand
-			 of SOME memloc => MemLocSet.add(memlocs, memloc)
-			  | NONE => memlocs)
-	    in
-	      val uses = doit uses
-	      val defs = doit defs
-	    end 
+            val {uses, defs, ...} = Instruction.uses_defs_kills instruction
+            local 
+              fun doit operands
+                = List.fold
+                  (operands,
+                   MemLocSet.empty,
+                   fn (operand, memlocs)
+                    => case Operand.deMemloc operand
+                         of SOME memloc => MemLocSet.add(memlocs, memloc)
+                          | NONE => memlocs)
+            in
+              val uses = doit uses
+              val defs = doit defs
+            end 
 
-	    val {dead,commit,remove,future}
-	      = liveness {uses = uses,
-			  defs = defs,
-			  future = future_post}
-	    val future_pre = future
+            val {dead,commit,remove,future}
+              = liveness {uses = uses,
+                          defs = defs,
+                          future = future_post}
+            val future_pre = future
 
-	    val info = {dead = dead,
-			commit = commit,
-			remove = remove,
-			futures = {pre = future_pre, post = future_post}}
+            val info = {dead = dead,
+                        commit = commit,
+                        remove = remove,
+                        futures = {pre = future_pre, post = future_post}}
 
-	  in
-	    info
-	  end
+          in
+            info
+          end
 
       fun livenessDirective {directive: Directive.t,
-			     future: future list}
-	= let
-	    val future_post = future
+                             future: future list}
+        = let
+            val future_post = future
 
-	    fun addLive (memlocsX, f)
-	      = List.fold
-	        (memlocsX,
-		 future,
-		 fn (X, future) => (M (FLIVE, f X))::future)
-	    fun addLive' (memlocs)
-	      = MemLocSet.fold
-	        (memlocs,
-		 future,
-		 fn (memloc, future) => (M (FLIVE, memloc))::future)
+            fun addLive (memlocsX, f)
+              = List.fold
+                (memlocsX,
+                 future,
+                 fn (X, future) => (M (FLIVE, f X))::future)
+            fun addLive' (memlocs)
+              = MemLocSet.fold
+                (memlocs,
+                 future,
+                 fn (memloc, future) => (M (FLIVE, memloc))::future)
 
-	    val future_pre
-	      = case directive
-		  of Directive.Reset 
-		   => []
-		   | Directive.Cache {caches, ...}
-		   => addLive(caches, fn {memloc, ...} => memloc)
-		   | Directive.FltCache {caches, ...}
-		   => addLive(caches, fn {memloc, ...} => memloc)
-		   | Directive.Force {commit_memlocs,
-				      commit_classes,
-				      remove_memlocs,
-				      remove_classes,
-				      dead_memlocs,
-				      dead_classes,
-				      ...}
-		   => MemLocSet.fold
-		      (commit_memlocs,
-		       MemLocSet.fold
-		       (remove_memlocs,
-			MemLocSet.fold
-			(dead_memlocs,
-			 (MP (FCOMMITP, 
-			      fn memloc 
-			       => ClassSet.contains(commit_classes,
-						    MemLoc.class memloc)))::
-			 (MP (FREMOVEP, 
-			      fn memloc 
-			       => ClassSet.contains(remove_classes,
-						    MemLoc.class memloc)))::
-			 (MP (FDEADP, 
-			      fn memloc 
-			       => ClassSet.contains(dead_classes,
-						    MemLoc.class memloc)))::
-			 future,
-			 fn (memloc,future) => (M (FDEAD, memloc))::future),
-			fn (memloc,future) => (M (FREMOVE, memloc))::future),
-		       fn (memloc,future) => (M (FCOMMIT, memloc))::future)
-		   | Directive.CCall
-		   => (MP (FCOMMITP,
-			   fn memloc
-			    => MemLoc.Class.eq
-			       (MemLoc.class memloc, 
-				MemLoc.Class.CStack)))::
-		      (MP (FMREMOVEP,
-			   fn memloc
-			    => (not (MemLoc.Class.eq
-				     (MemLoc.class memloc,
-				      MemLoc.Class.CStack)))
-			       andalso
-			       (Size.class (MemLoc.size memloc) <> Size.INT)))::
-		      future
-		   | Directive.Return {returns}
-		   => (List.map(returns, fn {dst, ...} => M (FDEF, dst))) @ future
-		   | Directive.ClearFlt
-		   => (MP (FMREMOVEP,
-			   fn memloc
-			    => (Size.class (MemLoc.size memloc) <> Size.INT)))::
-		      future
-		   | Directive.SaveRegAlloc {live, ...}
-		   => addLive'(live)
-		   | _ => future
+            val future_pre
+              = case directive
+                  of Directive.Reset 
+                   => []
+                   | Directive.Cache {caches, ...}
+                   => addLive(caches, fn {memloc, ...} => memloc)
+                   | Directive.FltCache {caches, ...}
+                   => addLive(caches, fn {memloc, ...} => memloc)
+                   | Directive.Force {commit_memlocs,
+                                      commit_classes,
+                                      remove_memlocs,
+                                      remove_classes,
+                                      dead_memlocs,
+                                      dead_classes,
+                                      ...}
+                   => MemLocSet.fold
+                      (commit_memlocs,
+                       MemLocSet.fold
+                       (remove_memlocs,
+                        MemLocSet.fold
+                        (dead_memlocs,
+                         (MP (FCOMMITP, 
+                              fn memloc 
+                               => ClassSet.contains(commit_classes,
+                                                    MemLoc.class memloc)))::
+                         (MP (FREMOVEP, 
+                              fn memloc 
+                               => ClassSet.contains(remove_classes,
+                                                    MemLoc.class memloc)))::
+                         (MP (FDEADP, 
+                              fn memloc 
+                               => ClassSet.contains(dead_classes,
+                                                    MemLoc.class memloc)))::
+                         future,
+                         fn (memloc,future) => (M (FDEAD, memloc))::future),
+                        fn (memloc,future) => (M (FREMOVE, memloc))::future),
+                       fn (memloc,future) => (M (FCOMMIT, memloc))::future)
+                   | Directive.CCall
+                   => (MP (FCOMMITP,
+                           fn memloc
+                            => MemLoc.Class.eq
+                               (MemLoc.class memloc, 
+                                MemLoc.Class.CStack)))::
+                      (MP (FMREMOVEP,
+                           fn memloc
+                            => (not (MemLoc.Class.eq
+                                     (MemLoc.class memloc,
+                                      MemLoc.Class.CStack)))
+                               andalso
+                               (Size.class (MemLoc.size memloc) <> Size.INT)))::
+                      future
+                   | Directive.Return {returns}
+                   => (List.map(returns, fn {dst, ...} => M (FDEF, dst))) @ future
+                   | Directive.ClearFlt
+                   => (MP (FMREMOVEP,
+                           fn memloc
+                            => (Size.class (MemLoc.size memloc) <> Size.INT)))::
+                      future
+                   | Directive.SaveRegAlloc {live, ...}
+                   => addLive'(live)
+                   | _ => future
 
-	    val info = {dead = MemLocSet.empty,
-			commit = MemLocSet.empty,
-			remove = MemLocSet.empty,
-			futures = {pre = future_pre, post = future_post}}
-	  in
-	    info
-	  end
+            val info = {dead = MemLocSet.empty,
+                        commit = MemLocSet.empty,
+                        remove = MemLocSet.empty,
+                        futures = {pre = future_pre, post = future_post}}
+          in
+            info
+          end
 
       fun livenessAssembly {assembly: Assembly.t,
-			    future: future list,
-			    hint: hint list} : t
-	= let
-	    fun default () = {dead = MemLocSet.empty,
-			      commit = MemLocSet.empty,
-			      remove = MemLocSet.empty,
-			      futures = {pre = future, post = future}}
-	    val {dead, commit, remove, futures}
-	      = case assembly
-		  of Assembly.Comment _ => default ()
-		   | Assembly.Directive d 
-		   => livenessDirective {directive = d,
-					 future = future}
-		   | Assembly.Instruction i 
-		   => livenessInstruction {instruction = i,
-					   future = future}
-		   | Assembly.Label _ => default ()
-		   | Assembly.PseudoOp _ => default ()
+                            future: future list,
+                            hint: hint list} : t
+        = let
+            fun default () = {dead = MemLocSet.empty,
+                              commit = MemLocSet.empty,
+                              remove = MemLocSet.empty,
+                              futures = {pre = future, post = future}}
+            val {dead, commit, remove, futures}
+              = case assembly
+                  of Assembly.Comment _ => default ()
+                   | Assembly.Directive d 
+                   => livenessDirective {directive = d,
+                                         future = future}
+                   | Assembly.Instruction i 
+                   => livenessInstruction {instruction = i,
+                                           future = future}
+                   | Assembly.Label _ => default ()
+                   | Assembly.PseudoOp _ => default ()
 
-	    val hint' = Assembly.hints assembly
-	    val hint
-	      = List.fold
-	        (case assembly
-		   of Assembly.Directive Directive.Reset => []
-		    | _ => hint,
-		 List.revMap
-		 (hint',
-		  fn (memloc, register)
-		   => (register, [memloc], MemLocSet.empty)),
-		 fn ((hint_register,hint_memlocs,hint_ignore),hint)
-		  => if List.exists
-		        (hint,
-			 fn (hint_register',_,_) => Register.coincide(hint_register,
-								      hint_register'))
-		       then hint
-		       else let
-			      val hint_memloc = hd hint_memlocs
-			    in
-			      if List.fold
-				 (hint,
-				  false,
-				  fn ((_,hint_memlocs',_),b)
-				   => b orelse List.contains
-				               (hint_memlocs',
-						hint_memloc,
-						MemLoc.eq))
-				then hint
-				else (hint_register,
-				      [hint_memloc],
-				      MemLocSet.union(dead, hint_ignore))::hint
-			    end)
-	    val hint
-	      = case assembly
-		  of (Assembly.Instruction (Instruction.MOV 
-					    {src = Operand.MemLoc src', 
-					     dst = Operand.MemLoc dst',
-					     ...}))
-		   => List.revMap
-		      (hint,
-		       fn (hint_register,hint_memlocs,hint_ignore)
-		        => if List.contains(hint_memlocs, dst', MemLoc.eq)
-			     then (hint_register,
-				   src'::hint_memlocs,
-				   hint_ignore)
-			     else (hint_register,hint_memlocs,hint_ignore))
-		   | _ => hint
+            val hint' = Assembly.hints assembly
+            val hint
+              = List.fold
+                (case assembly
+                   of Assembly.Directive Directive.Reset => []
+                    | _ => hint,
+                 List.revMap
+                 (hint',
+                  fn (memloc, register)
+                   => (register, [memloc], MemLocSet.empty)),
+                 fn ((hint_register,hint_memlocs,hint_ignore),hint)
+                  => if List.exists
+                        (hint,
+                         fn (hint_register',_,_) => Register.coincide(hint_register,
+                                                                      hint_register'))
+                       then hint
+                       else let
+                              val hint_memloc = hd hint_memlocs
+                            in
+                              if List.fold
+                                 (hint,
+                                  false,
+                                  fn ((_,hint_memlocs',_),b)
+                                   => b orelse List.contains
+                                               (hint_memlocs',
+                                                hint_memloc,
+                                                MemLoc.eq))
+                                then hint
+                                else (hint_register,
+                                      [hint_memloc],
+                                      MemLocSet.union(dead, hint_ignore))::hint
+                            end)
+            val hint
+              = case assembly
+                  of (Assembly.Instruction (Instruction.MOV 
+                                            {src = Operand.MemLoc src', 
+                                             dst = Operand.MemLoc dst',
+                                             ...}))
+                   => List.revMap
+                      (hint,
+                       fn (hint_register,hint_memlocs,hint_ignore)
+                        => if List.contains(hint_memlocs, dst', MemLoc.eq)
+                             then (hint_register,
+                                   src'::hint_memlocs,
+                                   hint_ignore)
+                             else (hint_register,hint_memlocs,hint_ignore))
+                   | _ => hint
 
-	    val info = {dead = dead,
-			commit = commit,
-			remove = remove,
-			futures = futures,
-			hint = hint}
-	  in
-	    info
-	  end
+            val info = {dead = dead,
+                        commit = commit,
+                        remove = remove,
+                        futures = futures,
+                        hint = hint}
+          in
+            info
+          end
 
       fun toLiveness (assembly: Assembly.t list) : ((Assembly.t * t) list)
-	= let
-	    val {assembly,...}
-	      = List.foldr
-	        (assembly,
-		 {assembly = [], future = [], hint = []},
-		 fn (asm, {assembly,future,hint})
-		  => let
-		       val info as {futures = {pre, ...}, hint, ...}
-			 = livenessAssembly {assembly = asm,
-					     future = future,
-					     hint = hint}
-		     in
-		       {assembly = (asm,info)::assembly,
-			future = pre,
-			hint = hint}
-		     end)
-	  in
-	    assembly
-	  end
+        = let
+            val {assembly,...}
+              = List.foldr
+                (assembly,
+                 {assembly = [], future = [], hint = []},
+                 fn (asm, {assembly,future,hint})
+                  => let
+                       val info as {futures = {pre, ...}, hint, ...}
+                         = livenessAssembly {assembly = asm,
+                                             future = future,
+                                             hint = hint}
+                     in
+                       {assembly = (asm,info)::assembly,
+                        future = pre,
+                        hint = hint}
+                     end)
+          in
+            assembly
+          end
 
       val (toLiveness,toLiveness_msg)
-	= tracer
-	  "toLiveness"
-	  toLiveness
+        = tracer
+          "toLiveness"
+          toLiveness
 
       fun toNoLiveness (assembly: Assembly.t list) : ((Assembly.t * t) list)
-	= List.map(assembly, fn asm => (asm,{dead = MemLocSet.empty,
-					     commit = MemLocSet.empty,
-					     remove = MemLocSet.empty,
-					     futures = {pre = [], post = []},
-					     hint = []}))
+        = List.map(assembly, fn asm => (asm,{dead = MemLocSet.empty,
+                                             commit = MemLocSet.empty,
+                                             remove = MemLocSet.empty,
+                                             futures = {pre = [], post = []},
+                                             hint = []}))
 
       val (toNoLiveness,toNoLiveness_msg)
-	= tracer
-	  "toNoLiveness"
-	  toNoLiveness
+        = tracer
+          "toNoLiveness"
+          toNoLiveness
    end
 
   structure RegisterAllocation =
@@ -668,5510 +671,5490 @@
       val depth : Int.t ref = ref 0
 
       datatype commit 
-	= NO 
-	| COMMIT of int 
-	| REMOVE of int
-	| TRYCOMMIT of int 
-	| TRYREMOVE of int
+        = NO 
+        | COMMIT of int 
+        | REMOVE of int
+        | TRYCOMMIT of int 
+        | TRYREMOVE of int
 
       val commit_toString
-	= fn NO => "NO"
+        = fn NO => "NO"
            | COMMIT i => "COMMIT " ^ (Int.toString i)
-	   | REMOVE i => "REMOVE " ^ (Int.toString i)
+           | REMOVE i => "REMOVE " ^ (Int.toString i)
            | TRYCOMMIT i => "TRYCOMMIT " ^ (Int.toString i)
-	   | TRYREMOVE i => "TRYREMOVE " ^ (Int.toString i)
+           | TRYREMOVE i => "TRYREMOVE " ^ (Int.toString i)
 
       type value = {register: Register.t,
-		    memloc: MemLoc.t,
-		    weight: int,
-		    sync: bool,
-		    commit: commit}
+                    memloc: MemLoc.t,
+                    weight: int,
+                    sync: bool,
+                    commit: commit}
 
       fun value_toString {register, memloc, weight, sync, commit}
-	= concat [Register.toString register, " ",
-		  MemLoc.toString memloc, " ",
-		  Int.toString weight, " ",
-		  Bool.toString sync, " ",
-		  commit_toString commit]
+        = concat [Register.toString register, " ",
+                  MemLoc.toString memloc, " ",
+                  Int.toString weight, " ",
+                  Bool.toString sync, " ",
+                  commit_toString commit]
 
       type fltvalue = {fltregister: FltRegister.t,
-		       memloc: MemLoc.t,
-		       weight: int,
-		       sync: bool,
-		       commit: commit}
+                       memloc: MemLoc.t,
+                       weight: int,
+                       sync: bool,
+                       commit: commit}
 
       fun fltvalue_toString {fltregister, memloc, weight, sync, commit}
-	= concat [FltRegister.toString fltregister, " ",
-		  MemLoc.toString memloc, " ",
-		  Int.toString weight, " ",
-		  Bool.toString sync, " ",
-		  commit_toString commit]
+        = concat [FltRegister.toString fltregister, " ",
+                  MemLoc.toString memloc, " ",
+                  Int.toString weight, " ",
+                  Bool.toString sync, " ",
+                  commit_toString commit]
 
       type t = {entries: value list,
-		reserved: Register.t list,
-		fltstack: fltvalue list}
+                reserved: Register.t list,
+                fltstack: fltvalue list}
 
+(*
       fun unique ({entries, fltstack, ...}: t)
-	= let
-	    fun check_entries (entries: value list, res) =
-	      case entries of
-		[] => res
-	      | ({register, memloc, ...})::entries =>
-		  check_entries
-		  (entries,
-		   List.foldr
-		   (entries, res, 
-		    fn ({register = register',
-			 memloc = memloc', ...}, res) =>
-		    res 
-		    andalso (not (Register.coincide (register, register')))
-		    andalso (not (MemLoc.eq (memloc, memloc')))))
-	    fun check_fltstack (fltstack: fltvalue list, res) =
-	      case fltstack of
-		[] => res
-	      | ({fltregister, memloc, ...})::fltstack =>
-		  check_fltstack
-		  (fltstack,
-		   List.foldr
-		   (fltstack, res, 
-		    fn ({fltregister = fltregister',
-			 memloc = memloc', ...}, res) =>
-		    res 
-		    andalso (not (FltRegister.eq (fltregister, fltregister')))
-		    andalso (not (MemLoc.eq (memloc, memloc')))))
-	  in
-	    check_entries(entries, true)
-	    andalso
-	    check_fltstack(fltstack, true)
-	  end
+        = let
+            fun check_entries (entries: value list, res) =
+              case entries of
+                [] => res
+              | ({register, memloc, ...})::entries =>
+                  check_entries
+                  (entries,
+                   List.foldr
+                   (entries, res, 
+                    fn ({register = register',
+                         memloc = memloc', ...}, res) =>
+                    res 
+                    andalso (not (Register.coincide (register, register')))
+                    andalso (not (MemLoc.eq (memloc, memloc')))))
+            fun check_fltstack (fltstack: fltvalue list, res) =
+              case fltstack of
+                [] => res
+              | ({fltregister, memloc, ...})::fltstack =>
+                  check_fltstack
+                  (fltstack,
+                   List.foldr
+                   (fltstack, res, 
+                    fn ({fltregister = fltregister',
+                         memloc = memloc', ...}, res) =>
+                    res 
+                    andalso (not (FltRegister.eq (fltregister, fltregister')))
+                    andalso (not (MemLoc.eq (memloc, memloc')))))
+          in
+            check_entries(entries, true)
+            andalso
+            check_fltstack(fltstack, true)
+          end
+*)
 
       fun toString ({entries, reserved, fltstack}: t) 
-	= let
-	    fun doit (name, l, toString, ac)
-	      = (name ^ "\n") ^
-	        (List.fold(l, ac,
-			   fn (x, ac)
-			    => (toString x) ^ "\n" ^ ac))
-	  in
-	    doit("entries:", entries, value_toString,
-	    doit("reserved:", reserved, Register.toString,
-	    doit("fltstack:", fltstack, fltvalue_toString, 
-		 "")))
-	  end
+        = let
+            fun doit (name, l, toString, ac)
+              = (name ^ "\n") ^
+                (List.fold(l, ac,
+                           fn (x, ac)
+                            => (toString x) ^ "\n" ^ ac))
+          in
+            doit("entries:", entries, value_toString,
+            doit("reserved:", reserved, Register.toString,
+            doit("fltstack:", fltstack, fltvalue_toString, 
+                 "")))
+          end
 
       fun toComments ({entries, reserved, fltstack}: t)
-	= let
-	    fun doit (name, l, toString, ac)
-	      = (Assembly.comment name)::
-	        (List.fold(l, ac,
-			   fn (x, ac)
-			    => (Assembly.comment (toString x))::
-			       ac))
-	  in
-	    AppendList.fromList
-	    (doit("entries:", entries, value_toString,
-	     doit("reserved:", reserved, Register.toString,
-	     doit("fltstack:", fltstack, fltvalue_toString,
-		  []))))
-	  end
+        = let
+            fun doit (name, l, toString, ac)
+              = (Assembly.comment name)::
+                (List.fold(l, ac,
+                           fn (x, ac)
+                            => (Assembly.comment (toString x))::
+                               ac))
+          in
+            AppendList.fromList
+            (doit("entries:", entries, value_toString,
+             doit("reserved:", reserved, Register.toString,
+             doit("fltstack:", fltstack, fltvalue_toString,
+                  []))))
+          end
 
       val {get = getRA : Directive.Id.t -> {registerAllocation: t},
-	   set = setRA, ...}
-	= Property.getSetOnce
-	  (Directive.Id.plist,
-	   Property.initRaise ("getRA", fn _ => Layout.empty))
+           set = setRA, ...}
+        = Property.getSetOnce
+          (Directive.Id.plist,
+           Property.initRaise ("getRA", fn _ => Layout.empty))
 
       fun empty () : t
-	= {entries = [],
-	   reserved = [],
-	   fltstack = []}
+        = {entries = [],
+           reserved = [],
+           fltstack = []}
 
       fun reserve' {register: Register.t,
-		    registerAllocation = {entries, reserved, fltstack}: t}
-	= {assembly = AppendList.empty,
-	   registerAllocation = {entries = entries,
-				 reserved = register::reserved,
-				 fltstack = fltstack}}
+                    registerAllocation = {entries, reserved, fltstack}: t}
+        = {assembly = AppendList.empty,
+           registerAllocation = {entries = entries,
+                                 reserved = register::reserved,
+                                 fltstack = fltstack}}
 
       fun reserve {registers: Register.t list,
-		   registerAllocation = {entries, reserved, fltstack}: t}
-	= {assembly = AppendList.empty,
-	   registerAllocation = {entries = entries,
-				 reserved = registers @ reserved,
-				 fltstack = fltstack}}
+                   registerAllocation = {entries, reserved, fltstack}: t}
+        = {assembly = AppendList.empty,
+           registerAllocation = {entries = entries,
+                                 reserved = registers @ reserved,
+                                 fltstack = fltstack}}
 
       fun unreserve' {register: Register.t,
-		      registerAllocation = {entries, reserved, fltstack}: t}
-	= {assembly = AppendList.empty,
-	   registerAllocation = {entries = entries,
-				 reserved = List.revRemoveAll
-				            (reserved,
-					     fn register' 
-					      => Register.eq
-					         (register',
-						  register)),
-				 fltstack = fltstack}}
+                      registerAllocation = {entries, reserved, fltstack}: t}
+        = {assembly = AppendList.empty,
+           registerAllocation = {entries = entries,
+                                 reserved = List.revRemoveAll
+                                            (reserved,
+                                             fn register' 
+                                              => Register.eq
+                                                 (register',
+                                                  register)),
+                                 fltstack = fltstack}}
 
       fun unreserve {registers: Register.t list,
-		     registerAllocation = {entries, reserved, fltstack}: t}
-	= {assembly = AppendList.empty,
-	   registerAllocation = {entries = entries,
-				 reserved = List.revRemoveAll
-				            (reserved,
-					     fn register' 
-					     => List.contains
-					        (registers,
-						 register',
-						 Register.eq)),
-				 fltstack = fltstack}}
+                     registerAllocation = {entries, reserved, fltstack}: t}
+        = {assembly = AppendList.empty,
+           registerAllocation = {entries = entries,
+                                 reserved = List.revRemoveAll
+                                            (reserved,
+                                             fn register' 
+                                             => List.contains
+                                                (registers,
+                                                 register',
+                                                 Register.eq)),
+                                 fltstack = fltstack}}
 
       fun valueMap {map, 
-		    registerAllocation = {entries,
-					  reserved, 
-					  fltstack}: t}
-	= {entries = List.revMap(entries, map),
-	   reserved = reserved,
-	   fltstack = fltstack}
+                    registerAllocation = {entries,
+                                          reserved, 
+                                          fltstack}: t}
+        = {entries = List.revMap(entries, map),
+           reserved = reserved,
+           fltstack = fltstack}
 
       fun valueFilter {filter,
-		       registerAllocation = {entries, 
-					     ...}: t}
-	= List.revKeepAll(entries, filter)
+                       registerAllocation = {entries, 
+                                             ...}: t}
+        = List.revKeepAll(entries, filter)
 
       fun valueRegister {register,
-			 registerAllocation}
-	= case valueFilter {filter = fn {register = register', ...}
-			              => Register.eq(register, register'),
-			    registerAllocation = registerAllocation}
-	    of [] => NONE
-	     | [value] => SOME value
-	     | _ => Error.bug "valueRegister"
+                         registerAllocation}
+        = case valueFilter {filter = fn {register = register', ...}
+                                      => Register.eq(register, register'),
+                            registerAllocation = registerAllocation}
+            of [] => NONE
+             | [value] => SOME value
+             | _ => Error.bug "x86AllocateRegisters.RegisterAllocation.valueRegister"
 
       fun valuesRegister {register = Register.T {reg, ...}, 
-			  registerAllocation = {entries, 
-						...}: t}
-	= List.revKeepAll(entries, 
-			  fn {register 
-			      = Register.T {reg = reg',
-					    ...},
-			      ...}
-			   => reg = reg')
+                          registerAllocation = {entries, 
+                                                ...}: t}
+        = List.revKeepAll(entries, 
+                          fn {register 
+                              = Register.T {reg = reg',
+                                            ...},
+                              ...}
+                           => reg = reg')
 
       fun fltvalueMap {map,
-		       registerAllocation = {entries, 
-					     reserved, 
-					     fltstack}: t}
-	= {entries = entries,
-	   reserved = reserved,
-	   fltstack = List.map(fltstack, map)}
+                       registerAllocation = {entries, 
+                                             reserved, 
+                                             fltstack}: t}
+        = {entries = entries,
+           reserved = reserved,
+           fltstack = List.map(fltstack, map)}
 
       fun fltvalueFilter {filter,
-			  registerAllocation = {fltstack, 
-						...} :t}
-	= List.keepAll(fltstack, filter)
+                          registerAllocation = {fltstack, 
+                                                ...} :t}
+        = List.keepAll(fltstack, filter)
 
       fun update {value as {register,...},
-		  registerAllocation = {entries, reserved, fltstack}: t}
-	= {entries = let
-		       val entries 
-			 = List.revRemoveAll(entries,
-					     fn {register = register',...} 
-					      => Register.eq(register,register'))
-		     in
-		       value::entries
-		     end,
-	   reserved = reserved,
-	   fltstack = fltstack}
+                  registerAllocation = {entries, reserved, fltstack}: t}
+        = {entries = let
+                       val entries 
+                         = List.revRemoveAll(entries,
+                                             fn {register = register',...} 
+                                              => Register.eq(register,register'))
+                     in
+                       value::entries
+                     end,
+           reserved = reserved,
+           fltstack = fltstack}
 
       fun fltupdate {value as {fltregister, ...},
-		     registerAllocation = {entries, reserved, fltstack}: t}
-	= {entries = entries,
-	   reserved = reserved,
-	   fltstack = let
-			val rec fltupdate'
-			  = fn [] => Error.bug "fltupdate"
-			     | (value' as {fltregister = fltregister', ...})::l
-			     => if FltRegister.eq(fltregister, fltregister')
-				  then value::l
-				  else value'::(fltupdate' l)
-		      in
-			fltupdate' fltstack
-		      end}
+                     registerAllocation = {entries, reserved, fltstack}: t}
+        = {entries = entries,
+           reserved = reserved,
+           fltstack = let
+                        val rec fltupdate'
+                          = fn [] => Error.bug "x86AllocateRegisters.RegisterAllocation.fltupdate"
+                             | (value' as {fltregister = fltregister', ...})::l
+                             => if FltRegister.eq(fltregister, fltregister')
+                                  then value::l
+                                  else value'::(fltupdate' l)
+                      in
+                        fltupdate' fltstack
+                      end}
 
       fun delete {register,
-		  registerAllocation = {entries, reserved, fltstack}: t}
-	= {entries = List.revRemoveAll(entries,
-				       fn {register = register',...}
-				        => Register.eq(register, register')),
-	   reserved = reserved,
-	   fltstack = fltstack}
+                  registerAllocation = {entries, reserved, fltstack}: t}
+        = {entries = List.revRemoveAll(entries,
+                                       fn {register = register',...}
+                                        => Register.eq(register, register')),
+           reserved = reserved,
+           fltstack = fltstack}
       fun deletes {registers, registerAllocation: t}
-	= List.fold(registers,
-		    registerAllocation,
-		    fn (register, registerAllocation)
-		     => delete {register = register,
-				registerAllocation = registerAllocation})
+        = List.fold(registers,
+                    registerAllocation,
+                    fn (register, registerAllocation)
+                     => delete {register = register,
+                                registerAllocation = registerAllocation})
 
       fun fltpush {value,
-		   registerAllocation = {entries, reserved, fltstack}: t}
-	= {fltrename = FltRegister.push,
-	   registerAllocation
-	   = {entries = entries,
-	      reserved = reserved,
-	      fltstack = case #fltregister value
-			   of FltRegister.T 0
-			    => value::(List.map(fltstack,
-						fn {fltregister 
-						    = FltRegister.T i,
-						    memloc,
-						    weight,
-						    sync,
-						    commit}
-						 => {fltregister =
-						     FltRegister.T (i + 1),
-						     memloc = memloc,
-						     weight = weight,
-						     sync = sync,
-						     commit = commit}))
-			    | _ => Error.bug "fltpush"}}
+                   registerAllocation = {entries, reserved, fltstack}: t}
+        = {fltrename = FltRegister.push,
+           registerAllocation
+           = {entries = entries,
+              reserved = reserved,
+              fltstack = case #fltregister value
+                           of FltRegister.T 0
+                            => value::(List.map(fltstack,
+                                                fn {fltregister 
+                                                    = FltRegister.T i,
+                                                    memloc,
+                                                    weight,
+                                                    sync,
+                                                    commit}
+                                                 => {fltregister =
+                                                     FltRegister.T (i + 1),
+                                                     memloc = memloc,
+                                                     weight = weight,
+                                                     sync = sync,
+                                                     commit = commit}))
+                            | _ => Error.bug "x86AllocateRegisters.RegisterAllocation.fltpush"}}
 
       fun fltpop {registerAllocation = {entries, reserved, fltstack}: t}
-	= {fltrename = FltRegister.pop,
-	   registerAllocation
-	   = {entries = entries,
-	      reserved = reserved,
-	      fltstack = case fltstack
-			   of [] => Error.bug "fltpop"
-			    | _::fltstack
-			    => List.map(fltstack,
-					fn {fltregister = FltRegister.T i,
-					    memloc,
-					    weight,
-					    sync,
-					    commit}
-					 => {fltregister 
-					     = FltRegister.T (i - 1),
-					     memloc = memloc,
-					     weight = weight,
-					     sync = sync,
-					     commit = commit})}}
+        = {fltrename = FltRegister.pop,
+           registerAllocation
+           = {entries = entries,
+              reserved = reserved,
+              fltstack = case fltstack
+                           of [] => Error.bug "x86AllocateRegisters.RegisterAllocation.fltpop"
+                            | _::fltstack
+                            => List.map(fltstack,
+                                        fn {fltregister = FltRegister.T i,
+                                            memloc,
+                                            weight,
+                                            sync,
+                                            commit}
+                                         => {fltregister 
+                                             = FltRegister.T (i - 1),
+                                             memloc = memloc,
+                                             weight = weight,
+                                             sync = sync,
+                                             commit = commit})}}
 
       fun fltxch' {fltregister: FltRegister.t,
-		   registerAllocation = {entries, reserved, fltstack}: t}
-	= let
-	    val rec split
-	      = fn (_ : fltvalue list, []) => Error.bug "fltxch': split"
-	         | (fltstack_pre,value::fltstack_post)
-	         => if FltRegister.eq(fltregister, #fltregister value)
-		      then (List.rev fltstack_pre, value, fltstack_post)
-		      else split (value::fltstack_pre, fltstack_post)
+                   registerAllocation = {entries, reserved, fltstack}: t}
+        = let
+            val rec split
+              = fn (_ : fltvalue list, []) => Error.bug "x86AllocateRegisters.RegisterAllocation.fltxch'.split"
+                 | (fltstack_pre,value::fltstack_post)
+                 => if FltRegister.eq(fltregister, #fltregister value)
+                      then (List.rev fltstack_pre, value, fltstack_post)
+                      else split (value::fltstack_pre, fltstack_post)
 
-	    val (fltstack_pre,
-		 {fltregister = fltregister', 
-		  memloc = memloc', 
-		  weight = weight', 
-		  sync = sync', 
-		  commit = commit'}, 
-		 fltstack_post) = split ([], fltstack)
-	  in 
-	    {fltrename = fn fltregister 
-	               => if FltRegister.eq(fltregister,
-					    fltregister')
-			    then FltRegister.top
-			  else if FltRegister.eq(fltregister,
-						 FltRegister.top)
-			    then fltregister'
-			  else fltregister,
-	     registerAllocation 
-	     = {entries = entries,
-		reserved = reserved,
-		fltstack = case fltstack_pre
-			     of [] => Error.bug "fltxch'"
-			      | ({fltregister,
-				  memloc,
-				  weight,
-				  sync,
-				  commit})::fltstack_pre
-			      => ({fltregister = fltregister,
-				   memloc = memloc',
-				   weight = weight',
-				   sync = sync',
-				   commit = commit'})::
-			         (List.concat
-				  [fltstack_pre,
-				   ({fltregister = fltregister',
-				     memloc = memloc,
-				     weight = weight,
-				     sync = sync,
-				     commit = commit})::
-				   fltstack_post])}}
-	  end
+            val (fltstack_pre,
+                 {fltregister = fltregister', 
+                  memloc = memloc', 
+                  weight = weight', 
+                  sync = sync', 
+                  commit = commit'}, 
+                 fltstack_post) = split ([], fltstack)
+          in 
+            {fltrename = fn fltregister 
+                       => if FltRegister.eq(fltregister,
+                                            fltregister')
+                            then FltRegister.top
+                          else if FltRegister.eq(fltregister,
+                                                 FltRegister.top)
+                            then fltregister'
+                          else fltregister,
+             registerAllocation 
+             = {entries = entries,
+                reserved = reserved,
+                fltstack = case fltstack_pre
+                             of [] => Error.bug "x86AllocateRegisters.RegisterAllocation.fltxch'"
+                              | ({fltregister,
+                                  memloc,
+                                  weight,
+                                  sync,
+                                  commit})::fltstack_pre
+                              => ({fltregister = fltregister,
+                                   memloc = memloc',
+                                   weight = weight',
+                                   sync = sync',
+                                   commit = commit'})::
+                                 (List.concat
+                                  [fltstack_pre,
+                                   ({fltregister = fltregister',
+                                     memloc = memloc,
+                                     weight = weight,
+                                     sync = sync,
+                                     commit = commit})::
+                                   fltstack_post])}}
+          end
 
       fun fltxch {value: fltvalue, registerAllocation: t}
-	= fltxch' {fltregister = #fltregister value,
-		   registerAllocation = registerAllocation}
+        = fltxch' {fltregister = #fltregister value,
+                   registerAllocation = registerAllocation}
 
       fun fltxch1 {registerAllocation: t}
-	= fltxch' {fltregister = FltRegister.one,
-		   registerAllocation = registerAllocation}
+        = fltxch' {fltregister = FltRegister.one,
+                   registerAllocation = registerAllocation}
 
       fun allocated {memloc, 
-		     registerAllocation: t}
-	= case valueFilter {filter = fn {memloc = memloc',...}
-			              => MemLoc.eq(memloc,memloc'),
-			    registerAllocation = registerAllocation}
-	    of [] => NONE
-	     | [value] => SOME value
-	     | _ => Error.bug "allocated"
+                     registerAllocation: t}
+        = case valueFilter {filter = fn {memloc = memloc',...}
+                                      => MemLoc.eq(memloc,memloc'),
+                            registerAllocation = registerAllocation}
+            of [] => NONE
+             | [value] => SOME value
+             | _ => Error.bug "x86AllocateRegisters.RegisterAllocation.allocated"
 
       fun fltallocated {memloc,
-			registerAllocation: t}
-	= case fltvalueFilter {filter = fn {memloc = memloc',...}
-			                 => MemLoc.eq(memloc,memloc'),
-			       registerAllocation = registerAllocation}
-	    of [] => NONE
-	     | [value] => SOME value
-	     | _ => Error.bug "fltallocated"
+                        registerAllocation: t}
+        = case fltvalueFilter {filter = fn {memloc = memloc',...}
+                                         => MemLoc.eq(memloc,memloc'),
+                               registerAllocation = registerAllocation}
+            of [] => NONE
+             | [value] => SOME value
+             | _ => Error.bug "x86AllocateRegisters.RegisterAllocation.fltallocated"
 
       fun remove {memloc,
-		  registerAllocation: t}
-	= case allocated {memloc = memloc,
-			  registerAllocation = registerAllocation}
-	    of SOME {register, ...}
-	     => delete {register = register,
-			registerAllocation = registerAllocation}
-	     | NONE => registerAllocation
+                  registerAllocation: t}
+        = case allocated {memloc = memloc,
+                          registerAllocation = registerAllocation}
+            of SOME {register, ...}
+             => delete {register = register,
+                        registerAllocation = registerAllocation}
+             | NONE => registerAllocation
       fun removes {memlocs,
-		   registerAllocation: t}
-	= List.fold(memlocs,
-		    registerAllocation,
-		    fn (memloc,registerAllocation)
-		     => remove {memloc = memloc,
-				registerAllocation = registerAllocation})
+                   registerAllocation: t}
+        = List.fold(memlocs,
+                    registerAllocation,
+                    fn (memloc,registerAllocation)
+                     => remove {memloc = memloc,
+                                registerAllocation = registerAllocation})
 
       local
-	val commitPush' 
-	  = fn NO => NO
-	     | COMMIT i => COMMIT (i + 1)
-	     | REMOVE i => REMOVE (i + 1)
-	     | TRYCOMMIT i => TRYCOMMIT (i + 1)
-	     | TRYREMOVE i => TRYREMOVE (i + 1)
+        val commitPush' 
+          = fn NO => NO
+             | COMMIT i => COMMIT (i + 1)
+             | REMOVE i => REMOVE (i + 1)
+             | TRYCOMMIT i => TRYCOMMIT (i + 1)
+             | TRYREMOVE i => TRYREMOVE (i + 1)
 
-	val commitPop' 
-	  = fn NO => NO
-	     | COMMIT i => COMMIT (i - 1)
-	     | REMOVE i => REMOVE (i - 1)
-	     | TRYCOMMIT i => TRYCOMMIT (i - 1)
-	     | TRYREMOVE i => TRYREMOVE (i - 1)
+        val commitPop' 
+          = fn NO => NO
+             | COMMIT i => COMMIT (i - 1)
+             | REMOVE i => REMOVE (i - 1)
+             | TRYCOMMIT i => TRYCOMMIT (i - 1)
+             | TRYREMOVE i => TRYREMOVE (i - 1)
       in
-	fun commitPush {registerAllocation: t}
-	  = valueMap {map = fn {register,memloc,weight,sync,commit}
-		             => {register = register,
-				 memloc = memloc,
-				 weight = weight,
-				 sync = sync,
-				 commit = commitPush' commit},
-		      registerAllocation = registerAllocation}
+        fun commitPush {registerAllocation: t}
+          = valueMap {map = fn {register,memloc,weight,sync,commit}
+                             => {register = register,
+                                 memloc = memloc,
+                                 weight = weight,
+                                 sync = sync,
+                                 commit = commitPush' commit},
+                      registerAllocation = registerAllocation}
 
-	fun commitPop {registerAllocation: t}
-	  = valueMap {map = fn {register,memloc,weight,sync,commit}
-		             => {register = register,
-				 memloc = memloc,
-				 weight = weight,
-				 sync = sync,
-				 commit = commitPop' commit},
-		      registerAllocation = registerAllocation}
+        fun commitPop {registerAllocation: t}
+          = valueMap {map = fn {register,memloc,weight,sync,commit}
+                             => {register = register,
+                                 memloc = memloc,
+                                 weight = weight,
+                                 sync = sync,
+                                 commit = commitPop' commit},
+                      registerAllocation = registerAllocation}
       end
 
       fun savedRegisters {saves: Operand.t list,
-			  registerAllocation: t} :
+                          registerAllocation: t} :
                          Register.t list
-	= List.concatMap
-	  (saves,
-	   fn Operand.MemLoc m
-	    => (case allocated {memloc = m,
-				registerAllocation = registerAllocation}
-		  of SOME {register, ...} => [register]
-		   | NONE => [])
-	    | Operand.Register r => [r]
-	    | Operand.Address (Address.T {base, index, ...})
-	    => (case (base, index)
-		  of (NONE,    NONE   ) => []
-		   | (SOME rb, NONE   ) => [rb] 
-		   | (NONE,    SOME ro) => [ro]
-		   | (SOME rb, SOME ro) => [rb,ro])
-	   | _ => [])
+        = List.concatMap
+          (saves,
+           fn Operand.MemLoc m
+            => (case allocated {memloc = m,
+                                registerAllocation = registerAllocation}
+                  of SOME {register, ...} => [register]
+                   | NONE => [])
+            | Operand.Register r => [r]
+            | Operand.Address (Address.T {base, index, ...})
+            => (case (base, index)
+                  of (NONE,    NONE   ) => []
+                   | (SOME rb, NONE   ) => [rb] 
+                   | (NONE,    SOME ro) => [ro]
+                   | (SOME rb, SOME ro) => [rb,ro])
+           | _ => [])
 
       fun supportedRegisters {supports: Operand.t list,
-			      registerAllocation: t} :
-	                     Register.t list
-	= let
-	    fun supportedRegisters' memloc
-	      = case (allocated {memloc = memloc,
-				 registerAllocation = registerAllocation},
-		      fltallocated {memloc = memloc,
-				    registerAllocation = registerAllocation})
-		  of (SOME {register, ...}, _) => [register]
-		   | (_, SOME _) => []
-		   | (NONE, NONE) => List.concatMap(MemLoc.utilized memloc,
-						    supportedRegisters')
-	  in
-	    List.concatMap
-	    (supports,
-	     fn Operand.MemLoc m => supportedRegisters' m
-	      | _ => [])
-	  end
+                              registerAllocation: t} :
+                             Register.t list
+        = let
+            fun supportedRegisters' memloc
+              = case (allocated {memloc = memloc,
+                                 registerAllocation = registerAllocation},
+                      fltallocated {memloc = memloc,
+                                    registerAllocation = registerAllocation})
+                  of (SOME {register, ...}, _) => [register]
+                   | (_, SOME _) => []
+                   | (NONE, NONE) => List.concatMap(MemLoc.utilized memloc,
+                                                    supportedRegisters')
+          in
+            List.concatMap
+            (supports,
+             fn Operand.MemLoc m => supportedRegisters' m
+              | _ => [])
+          end
 
       fun supportedMemLocs {supports: Operand.t list,
-			    registerAllocation: t} :
-	                   MemLoc.t list
-	= let
-	    fun supportedMemLocs' memloc
-	      = case (allocated {memloc = memloc,
-				 registerAllocation = registerAllocation},
-		      fltallocated {memloc = memloc,
-				    registerAllocation = registerAllocation})
-		  of (SOME _, _) => [memloc]
-		   | (_, SOME _) => [memloc]
-		   | (NONE, NONE) => List.concatMap(MemLoc.utilized memloc,
-						    supportedMemLocs')
-	  in
-	    List.concatMap
-	    (supports,
-	     fn Operand.MemLoc m => supportedMemLocs' m
-	      | _ => [])
-	  end
+                            registerAllocation: t} :
+                           MemLoc.t list
+        = let
+            fun supportedMemLocs' memloc
+              = case (allocated {memloc = memloc,
+                                 registerAllocation = registerAllocation},
+                      fltallocated {memloc = memloc,
+                                    registerAllocation = registerAllocation})
+                  of (SOME _, _) => [memloc]
+                   | (_, SOME _) => [memloc]
+                   | (NONE, NONE) => List.concatMap(MemLoc.utilized memloc,
+                                                    supportedMemLocs')
+          in
+            List.concatMap
+            (supports,
+             fn Operand.MemLoc m => supportedMemLocs' m
+              | _ => [])
+          end
 
       fun fltsavedMemLocs {saves: Operand.t list,
-			   registerAllocation: t} :
+                           registerAllocation: t} :
                           MemLoc.t list
-	= List.revKeepAllMap
-	  (saves,
-	   fn Operand.MemLoc m
-	    => (case fltallocated {memloc = m,
-				   registerAllocation = registerAllocation}
-		  of SOME _ => SOME m
-		   | NONE => NONE)
-	    | _ => NONE)
+        = List.revKeepAllMap
+          (saves,
+           fn Operand.MemLoc m
+            => (case fltallocated {memloc = m,
+                                   registerAllocation = registerAllocation}
+                  of SOME _ => SOME m
+                   | NONE => NONE)
+            | _ => NONE)
 
       fun fltsupportedMemLocs {supports: Operand.t list,
-			       registerAllocation: t} :
-	                      MemLoc.t list
-	= List.revKeepAllMap
-	  (supports,
-	   fn Operand.MemLoc m
-	    => (case fltallocated {memloc = m,
-				   registerAllocation = registerAllocation}
-		  of SOME _ => SOME m
-		   | NONE => NONE)
-	    | _ => NONE)
+                               registerAllocation: t} :
+                              MemLoc.t list
+        = List.revKeepAllMap
+          (supports,
+           fn Operand.MemLoc m
+            => (case fltallocated {memloc = m,
+                                   registerAllocation = registerAllocation}
+                  of SOME _ => SOME m
+                   | NONE => NONE)
+            | _ => NONE)
 
       fun 'a spillAndReissue {info: Liveness.t,
-			      supports: Operand.t list,
-			      saves: Operand.t list,
-			      registerAllocation: t,
-			      spiller : {info: Liveness.t,
-					 supports: Operand.t list,
-					 saves: Operand.t list,
-					 registerAllocation: t} ->
-			                {assembly: Assembly.t AppendList.t,
-					 registerAllocation: t},
-			      msg : string,
-			      reissue : {assembly: Assembly.t AppendList.t,
-					 registerAllocation: t} -> 'a} : 'a
-	= (Int.dec depth;
-	   if !depth = 0
-	     then let
-		    val _ = Int.inc depth
-		    val {assembly, registerAllocation}
-		      = spiller
-		        {info = info,
-			 supports = supports,
-			 saves = saves,
-			 registerAllocation = registerAllocation}
-		    val return
-		      = reissue {assembly = assembly,
-				 registerAllocation = registerAllocation}
-		        handle Spill
-			 => (print (concat ["handling respill in ",
-					    msg,
-					    "\n"]);
-			     print (toString registerAllocation);
-			     Error.bug (concat [msg, ":reSpill"]))
-		    val _ = Int.dec depth
-		  in
-		    return
-		  end
-	     else raise Spill)
+                              supports: Operand.t list,
+                              saves: Operand.t list,
+                              registerAllocation: t,
+                              spiller : {info: Liveness.t,
+                                         supports: Operand.t list,
+                                         saves: Operand.t list,
+                                         registerAllocation: t} ->
+                                        {assembly: Assembly.t AppendList.t,
+                                         registerAllocation: t},
+                              msg : string,
+                              reissue : {assembly: Assembly.t AppendList.t,
+                                         registerAllocation: t} -> 'a} : 'a
+        = (Int.dec depth;
+           if !depth = 0
+             then let
+                    val _ = Int.inc depth
+                    val {assembly, registerAllocation}
+                      = spiller
+                        {info = info,
+                         supports = supports,
+                         saves = saves,
+                         registerAllocation = registerAllocation}
+                    val return
+                      = reissue {assembly = assembly,
+                                 registerAllocation = registerAllocation}
+                        handle Spill
+                         => (Error.bug (concat [msg, ":reSpill"]))
+                    val _ = Int.dec depth
+                  in
+                    return
+                  end
+             else raise Spill)
 
       fun potentialRegisters ({size, force, ...}:
-			      {size: Size.t,
-			       saves: Operand.t list,
-			       force: Register.t list,
-			       registerAllocation: t}):
+                              {size: Size.t,
+                               saves: Operand.t list,
+                               force: Register.t list,
+                               registerAllocation: t}):
                              Register.t list
-	= case force
-	    of [] => Register.registers size
-	     | registers => List.revKeepAll(Register.registers size,
-					    fn register 
-					     => List.contains(registers, 
-							      register, 
-							      Register.eq))
+        = case force
+            of [] => Register.registers size
+             | registers => List.revKeepAll(Register.registers size,
+                                            fn register 
+                                             => List.contains(registers, 
+                                                              register, 
+                                                              Register.eq))
 
       fun chooseRegister {info = {futures = {pre = future, ...},
-				  hint,...}: Liveness.t,
-			  memloc: MemLoc.t option,
-			  size: Size.t,
-			  supports: Operand.t list,
-			  saves: Operand.t list,
-			  force: Register.t list,
-			  registerAllocation as {reserved,...}: t} :
-	                 {register: Register.t,
-			  coincide_values: value list}
+                                  hint,...}: Liveness.t,
+                          memloc: MemLoc.t option,
+                          size: Size.t,
+                          supports: Operand.t list,
+                          saves: Operand.t list,
+                          force: Register.t list,
+                          registerAllocation as {reserved,...}: t} :
+                         {register: Register.t,
+                          coincide_values: value list}
         = let
-	    val registers = potentialRegisters {size = size,
-						saves = saves,
-						force = force,
-						registerAllocation
-						= registerAllocation}
+            val registers = potentialRegisters {size = size,
+                                                saves = saves,
+                                                force = force,
+                                                registerAllocation
+                                                = registerAllocation}
 
-	    val saved
-	      = savedRegisters {saves = saves,
-				registerAllocation = registerAllocation}
+            val saved
+              = savedRegisters {saves = saves,
+                                registerAllocation = registerAllocation}
 
-	    val preserved
-	      = let
-		  fun doit(registers, preserved)
-		    = List.fold
-		      (registers,
-		       preserved,
-		       fn (register,preserved) 
-		        => if List.contains(preserved,
-					    register,
-					    Register.eq)
-			     then preserved
-			     else register::preserved)
-		in
-		  doit(saved,
-		  doit(reserved,
-		       []))
-		end
+            val preserved
+              = let
+                  fun doit(registers, preserved)
+                    = List.fold
+                      (registers,
+                       preserved,
+                       fn (register,preserved) 
+                        => if List.contains(preserved,
+                                            register,
+                                            Register.eq)
+                             then preserved
+                             else register::preserved)
+                in
+                  doit(saved,
+                  doit(reserved,
+                       []))
+                end
 
-	    val registers 
-	      = List.revRemoveAll
-	        (registers,
-		 fn register'
-		  => List.exists
-		     (preserved,
-		      fn register''
-		       => Register.coincide(register',register'')))
+            val registers 
+              = List.revRemoveAll
+                (registers,
+                 fn register'
+                  => List.exists
+                     (preserved,
+                      fn register''
+                       => Register.coincide(register',register'')))
 
-	    val supported = supportedRegisters {supports = supports,
-						registerAllocation
-						= registerAllocation}
+            val supported = supportedRegisters {supports = supports,
+                                                registerAllocation
+                                                = registerAllocation}
 
-	    val values = valueFilter {filter = fn _ => true,
-				      registerAllocation = registerAllocation}
-	    val memlocs = List.revMap(values, #memloc)
+            val values = valueFilter {filter = fn _ => true,
+                                      registerAllocation = registerAllocation}
+            val memlocs = List.revMap(values, #memloc)
 
-	    val registers_costs
-	      = List.revMap
-	        (registers,
-		 fn register'
-		  => let
-		       val hint_cost
-			 = List.fold
-			   (hint,
-			    0,
-			    fn ((hint_register,hint_memlocs,hint_ignore),
-				hint_cost)
-			     => if Register.eq(register',
-					       hint_register)
-				  then case memloc
-					 of SOME memloc
-					  => (case (List.contains
-						    (hint_memlocs,
-						     memloc,
-						     MemLoc.eq),
-						    MemLocSet.contains
-						    (hint_ignore,
-						     memloc))
-						of (true, _) => hint_cost + 5
-						 | (false, true) => hint_cost
-						 | (false, false) => hint_cost - 5)
-					  | NONE => hint_cost - 5
-				else if Register.coincide(register',
-							  hint_register)
-				  then hint_cost - 5
-				else hint_cost)
+            val registers_costs
+              = List.revMap
+                (registers,
+                 fn register'
+                  => let
+                       val hint_cost
+                         = List.fold
+                           (hint,
+                            0,
+                            fn ((hint_register,hint_memlocs,hint_ignore),
+                                hint_cost)
+                             => if Register.eq(register',
+                                               hint_register)
+                                  then case memloc
+                                         of SOME memloc
+                                          => (case (List.contains
+                                                    (hint_memlocs,
+                                                     memloc,
+                                                     MemLoc.eq),
+                                                    MemLocSet.contains
+                                                    (hint_ignore,
+                                                     memloc))
+                                                of (true, _) => hint_cost + 5
+                                                 | (false, true) => hint_cost
+                                                 | (false, false) => hint_cost - 5)
+                                          | NONE => hint_cost - 5
+                                else if Register.coincide(register',
+                                                          hint_register)
+                                  then hint_cost - 5
+                                else hint_cost)
 
-		       val values = valuesRegister {register = register',
-						    registerAllocation 
-						    = registerAllocation}
-		       val (support_cost,
-			    commit_cost,
-			    future_cost,
-			    utilized_cost,
-			    sync_cost,
-			    weight_cost)
-			 = List.fold
-			   (values,
-			    (false,false,NONE,0,true,0),
-			    fn ({register,memloc,weight,sync,commit,...},
-				cost as (support_cost,
-					 commit_cost,
-					 future_cost,
-					 utilized_cost,
-					 sync_cost,
-					 weight_cost))
-			     => if Register.coincide(register,register')
-				  then let
-					 val support_cost'
-					   = List.contains(supported,
-							   register,
-							   Register.eq)
+                       val values = valuesRegister {register = register',
+                                                    registerAllocation 
+                                                    = registerAllocation}
+                       val (support_cost,
+                            commit_cost,
+                            future_cost,
+                            utilized_cost,
+                            sync_cost,
+                            weight_cost)
+                         = List.fold
+                           (values,
+                            (false,false,NONE,0,true,0),
+                            fn ({register,memloc,weight,sync,commit,...},
+                                cost as (support_cost,
+                                         commit_cost,
+                                         future_cost,
+                                         utilized_cost,
+                                         sync_cost,
+                                         weight_cost))
+                             => if Register.coincide(register,register')
+                                  then let
+                                         val support_cost'
+                                           = List.contains(supported,
+                                                           register,
+                                                           Register.eq)
 
-					 val commit_cost'
-					   = case commit
-					       of TRYREMOVE _ => false
-						| REMOVE _ => false
-						| _ => true
+                                         val commit_cost'
+                                           = case commit
+                                               of TRYREMOVE _ => false
+                                                | REMOVE _ => false
+                                                | _ => true
 
-					 val future_cost'
-					   = List.index
-					     (future,
-					      fn Liveness.M (tag, memloc')
-					       => let
-						    val eq = MemLoc.eq(memloc, memloc')
-						  in 
-						    case tag
-						      of Liveness.FLIVE => eq
-						       | Liveness.FUSE => eq
-						       | Liveness.FUSEDEF => eq
-						       | _ => false
-						  end
+                                         val future_cost'
+                                           = List.index
+                                             (future,
+                                              fn Liveness.M (tag, memloc')
+                                               => let
+                                                    val eq = MemLoc.eq(memloc, memloc')
+                                                  in 
+                                                    case tag
+                                                      of Liveness.FLIVE => eq
+                                                       | Liveness.FUSE => eq
+                                                       | Liveness.FUSEDEF => eq
+                                                       | _ => false
+                                                  end
                                                | _ => false)
 
-					 val utilized_cost'
-					   = List.fold
-					     (memlocs,
-					      0,
-					      fn (memloc',uc')
-					       => List.fold
-					          (MemLoc.utilized memloc',
-						   0,
-						   fn (memloc'',uc'')
-						    => if MemLoc.eq
-						          (memloc,
-							   memloc'')
-							 then uc'' + 1
-							 else uc'') + uc')
+                                         val utilized_cost'
+                                           = List.fold
+                                             (memlocs,
+                                              0,
+                                              fn (memloc',uc')
+                                               => List.fold
+                                                  (MemLoc.utilized memloc',
+                                                   0,
+                                                   fn (memloc'',uc'')
+                                                    => if MemLoc.eq
+                                                          (memloc,
+                                                           memloc'')
+                                                         then uc'' + 1
+                                                         else uc'') + uc')
 
-					 val sync_cost' = sync
+                                         val sync_cost' = sync
 
-					 val weight_cost' = weight
-				       in
-					 (support_cost orelse support_cost',
-					  commit_cost orelse commit_cost',
-					  case (future_cost,future_cost')
-					    of (_, NONE) => future_cost
-					     | (NONE, _) => future_cost'
-					     | (SOME f,SOME f') 
-					     => SOME (Int.min(f,f')),
-					  utilized_cost + utilized_cost',
-					  sync_cost andalso sync_cost',
-					  weight_cost + weight_cost')
-				       end
-				  else cost)
-		     in
-		       (register',
-			(support_cost,
-			 commit_cost,
-			 future_cost,
-			 hint_cost,
-			 utilized_cost,
-			 sync_cost,
-			 weight_cost))
-		     end)
+                                         val weight_cost' = weight
+                                       in
+                                         (support_cost orelse support_cost',
+                                          commit_cost orelse commit_cost',
+                                          case (future_cost,future_cost')
+                                            of (_, NONE) => future_cost
+                                             | (NONE, _) => future_cost'
+                                             | (SOME f,SOME f') 
+                                             => SOME (Int.min(f,f')),
+                                          utilized_cost + utilized_cost',
+                                          sync_cost andalso sync_cost',
+                                          weight_cost + weight_cost')
+                                       end
+                                  else cost)
+                     in
+                       (register',
+                        (support_cost,
+                         commit_cost,
+                         future_cost,
+                         hint_cost,
+                         utilized_cost,
+                         sync_cost,
+                         weight_cost))
+                     end)
 
-	    val registers_costs_sorted
-	      = List.insertionSort
-	        (registers_costs,
-		 fn ((_,(support_c1,
-			 commit_c1,
-			 future_c1,
-			 hint_c1,
-			 utilized_c1,
-			 sync_c1,
-			 weight_c1)),
-		     (_,(support_c2,
-			 commit_c2,
-			 future_c2,
-			 hint_c2,
-			 utilized_c2,
-			 sync_c2,
-			 weight_c2)))
-		  => bool_lt(support_c1,support_c2) orelse
-		     (support_c1 = support_c2 andalso
-		      (bool_lt(commit_c1,commit_c2) orelse
-		       (commit_c1 = commit_c2 andalso
-			(option_lt (op >) (future_c1, future_c2) orelse
-			 (future_c1 = future_c2 andalso
-			  (hint_c1 > hint_c2 orelse
-			   (hint_c1 = hint_c2 andalso
-			    (utilized_c1 < utilized_c2 orelse
-			     (utilized_c1 = utilized_c2 andalso
-			      (bool_gt(sync_c1,sync_c2) orelse
-			       (sync_c1 = sync_c2 andalso
-				weight_c1 < weight_c2))))))))))))
+            val registers_costs_sorted
+              = List.insertionSort
+                (registers_costs,
+                 fn ((_,(support_c1,
+                         commit_c1,
+                         future_c1,
+                         hint_c1,
+                         utilized_c1,
+                         sync_c1,
+                         weight_c1)),
+                     (_,(support_c2,
+                         commit_c2,
+                         future_c2,
+                         hint_c2,
+                         utilized_c2,
+                         sync_c2,
+                         weight_c2)))
+                  => bool_lt(support_c1,support_c2) orelse
+                     (support_c1 = support_c2 andalso
+                      (bool_lt(commit_c1,commit_c2) orelse
+                       (commit_c1 = commit_c2 andalso
+                        (option_lt (op >) (future_c1, future_c2) orelse
+                         (future_c1 = future_c2 andalso
+                          (hint_c1 > hint_c2 orelse
+                           (hint_c1 = hint_c2 andalso
+                            (utilized_c1 < utilized_c2 orelse
+                             (utilized_c1 = utilized_c2 andalso
+                              (bool_gt(sync_c1,sync_c2) orelse
+                               (sync_c1 = sync_c2 andalso
+                                weight_c1 < weight_c2))))))))))))
 
-	    val registers
-	      = List.map(registers_costs_sorted, #1)
+            val registers
+              = List.map(registers_costs_sorted, #1)
 
-	    val register
-	      = case registers
-		  of [] 
+            val register
+              = case registers
+                  of [] 
 (*
-		   => raise Spill
+                   => raise Spill
 *)
-		   => let
-			fun listToString(ss: string list): string
-			  = "[" ^ (concat(List.separate(ss, ", "))) ^ "]"
+                   => let
+                        fun listToString(ss: string list): string
+                          = "[" ^ (concat(List.separate(ss, ", "))) ^ "]"
 
-			val size = Size.toString size
-			val supports
-			  = listToString(List.map(supports,Operand.toString))
-			val saves 
-			  = listToString(List.map(saves,Operand.toString)) 
-			val force
-			  = listToString(List.map(force,Register.toString)) 
-			val reserved
-			  = listToString(List.map(reserved,Register.toString)) 
+                        val size = Size.toString size
+                        val supports
+                          = listToString(List.map(supports,Operand.toString))
+                        val saves 
+                          = listToString(List.map(saves,Operand.toString)) 
+                        val force
+                          = listToString(List.map(force,Register.toString)) 
+                        val reserved
+                          = listToString(List.map(reserved,Register.toString)) 
 
-			val msg = concat["\n",
-					 "chooseRegister:\n",
-					 (toString registerAllocation),
-					 "size = ", size, "\n",
-					 "supports = ", supports, "\n",
-					 "saves = ", saves, "\n",
-					 "force = ", force, "\n",
-					 "reserved = ", reserved, "\n",
-					 "depth = ", Int.toString (!depth), "\n"]
+                        val msg = concat["\n",
+                                         "chooseRegister:\n",
+                                         (toString registerAllocation),
+                                         "size = ", size, "\n",
+                                         "supports = ", supports, "\n",
+                                         "saves = ", saves, "\n",
+                                         "force = ", force, "\n",
+                                         "reserved = ", reserved, "\n",
+                                         "depth = ", Int.toString (!depth), "\n"]
 
-			val _ = print msg
-		      in
-			print "Raising Spill in chooseRegister\n";
-			raise Spill
-		      end
-		   | register::_ => register
-			
-	    val values = valuesRegister {register = register,
-					 registerAllocation 
-					 = registerAllocation}
-	    val coincide_values
-	      = List.revKeepAll(values,
-				fn {register = register',...}
-				 => Register.coincide(register',register))
-	  in
-	    {register = register,
-	     coincide_values = coincide_values}
-	  end
+                        val _ = print msg
+                      in
+                        print "Raising Spill in chooseRegister\n";
+                        raise Spill
+                      end
+                   | register::_ => register
+                        
+            val values = valuesRegister {register = register,
+                                         registerAllocation 
+                                         = registerAllocation}
+            val coincide_values
+              = List.revKeepAll(values,
+                                fn {register = register',...}
+                                 => Register.coincide(register',register))
+          in
+            {register = register,
+             coincide_values = coincide_values}
+          end
 
       fun freeRegister ({info: Liveness.t,
-			 memloc: MemLoc.t option,
-			 size: Size.t,
-			 supports: Operand.t list,
-			 saves: Operand.t list,
-			 force: Register.t list, 
-			 registerAllocation: t}) :
+                         memloc: MemLoc.t option,
+                         size: Size.t,
+                         supports: Operand.t list,
+                         saves: Operand.t list,
+                         force: Register.t list, 
+                         registerAllocation: t}) :
                        {register: Register.t,
-			assembly: Assembly.t AppendList.t,
-			registerAllocation: t}
-	= let
-	    val _ = Int.inc depth
+                        assembly: Assembly.t AppendList.t,
+                        registerAllocation: t}
+        = let
+            val _ = Int.inc depth
 
-	    val {register = final_register,
-		 coincide_values}
-	      = chooseRegister {info = info,
-				memloc = memloc,
-				size = size,
-				supports = supports,
-				saves = saves,
-				force = force,
-				registerAllocation = registerAllocation}
+            val {register = final_register,
+                 coincide_values}
+              = chooseRegister {info = info,
+                                memloc = memloc,
+                                size = size,
+                                supports = supports,
+                                saves = saves,
+                                force = force,
+                                registerAllocation = registerAllocation}
 
-	    val supported = supportedMemLocs {supports = supports,
-					      registerAllocation
-					      = registerAllocation}
+            val supported = supportedMemLocs {supports = supports,
+                                              registerAllocation
+                                              = registerAllocation}
 
-	    fun supportRemove memloc
-	      = let
-		  fun supportRemove' memlocs
-		    = List.concatMap
-		      (memlocs,
-		       fn memloc' 
-		        => if MemLoc.eq(memloc,memloc')
-			     then []
-			     else supportRemove' (MemLoc.utilized memloc'))
-		in
-		  List.fold
-		  (supports,
-		   [],
-		   fn (Operand.MemLoc memloc', supports)
-		    => List.concat [(supportRemove' [memloc']), supports]
-		    | (_, supports) => supports)
-		end
+            fun supportRemove memloc
+              = let
+                  fun supportRemove' memlocs
+                    = List.concatMap
+                      (memlocs,
+                       fn memloc' 
+                        => if MemLoc.eq(memloc,memloc')
+                             then []
+                             else supportRemove' (MemLoc.utilized memloc'))
+                in
+                  List.fold
+                  (supports,
+                   [],
+                   fn (Operand.MemLoc memloc', supports)
+                    => List.concat [(supportRemove' [memloc']), supports]
+                    | (_, supports) => supports)
+                end
 
-	    val {assembly = assembly_support,
-		 registerAllocation}
-	      = List.fold
-	        (coincide_values,
-		 {assembly = AppendList.empty,
-		  registerAllocation = registerAllocation},
-		 fn ({memloc,...},
-		     {assembly,
-		      registerAllocation})
-		  => if List.contains(supported,
-				      memloc,
-				      MemLoc.eq)
-		       then let
-			      val supports = supportRemove memloc
+            val {assembly = assembly_support,
+                 registerAllocation}
+              = List.fold
+                (coincide_values,
+                 {assembly = AppendList.empty,
+                  registerAllocation = registerAllocation},
+                 fn ({memloc,...},
+                     {assembly,
+                      registerAllocation})
+                  => if List.contains(supported,
+                                      memloc,
+                                      MemLoc.eq)
+                       then let
+                              val supports = supportRemove memloc
 
-			      val force
-				= List.revRemoveAll
-				  (Register.registers (MemLoc.size memloc),
-				   fn register'
-				    => Register.coincide(final_register,
-							 register'))
-				  
-			      val {assembly = assembly_register,
-				   registerAllocation,
-				   ...}
-				= toRegisterMemLoc
-				  {memloc = memloc,
-				   info = info,
-				   size = MemLoc.size memloc,
-				   move = true,
-				   supports = supports,
-				   saves = (Operand.register 
-					    final_register)::saves,
-				   force = force,
-				   registerAllocation = registerAllocation}
-			    in
-			      {assembly = AppendList.append (assembly, 
-							     assembly_register),
-			       registerAllocation = registerAllocation}
-			    end
-		       else {assembly = assembly,
-			     registerAllocation = registerAllocation})
+                              val force
+                                = List.revRemoveAll
+                                  (Register.registers (MemLoc.size memloc),
+                                   fn register'
+                                    => Register.coincide(final_register,
+                                                         register'))
+                                  
+                              val {assembly = assembly_register,
+                                   registerAllocation,
+                                   ...}
+                                = toRegisterMemLoc
+                                  {memloc = memloc,
+                                   info = info,
+                                   size = MemLoc.size memloc,
+                                   move = true,
+                                   supports = supports,
+                                   saves = (Operand.register 
+                                            final_register)::saves,
+                                   force = force,
+                                   registerAllocation = registerAllocation}
+                            in
+                              {assembly = AppendList.append (assembly, 
+                                                             assembly_register),
+                               registerAllocation = registerAllocation}
+                            end
+                       else {assembly = assembly,
+                             registerAllocation = registerAllocation})
 
-	    val registerAllocation
-	      = valueMap
-	        {map = fn value as {register,
-				    memloc,
-				    weight,
-				    sync,
-				    ...}
-		        => if Register.coincide(register,
-						final_register)
-			     then {register = register,
-				   memloc = memloc,
-				   weight = weight,
-				   sync = sync,				   
-				   commit = REMOVE 0}
-			     else value,
-		 registerAllocation = registerAllocation}
+            val registerAllocation
+              = valueMap
+                {map = fn value as {register,
+                                    memloc,
+                                    weight,
+                                    sync,
+                                    ...}
+                        => if Register.coincide(register,
+                                                final_register)
+                             then {register = register,
+                                   memloc = memloc,
+                                   weight = weight,
+                                   sync = sync,                            
+                                   commit = REMOVE 0}
+                             else value,
+                 registerAllocation = registerAllocation}
 
-	    val {assembly = assembly_commit,
-		 registerAllocation}
-	      = commitRegisters {info = info,
-				 supports = supports,
-				 saves = saves,
-				 registerAllocation = registerAllocation}
+            val {assembly = assembly_commit,
+                 registerAllocation}
+              = commitRegisters {info = info,
+                                 supports = supports,
+                                 saves = saves,
+                                 registerAllocation = registerAllocation}
 
-	    val _ = Int.dec depth
-	  in
-	    {register = final_register,
-	     assembly = AppendList.appends [assembly_support, 
-					    assembly_commit],
-	     registerAllocation = registerAllocation}
-	  end
-	  handle Spill 
-	   => spillAndReissue 
-	      {info = info,
-	       supports = supports,
-	       saves = saves,
-	       registerAllocation = registerAllocation,
-	       spiller = spillRegisters,
-	       msg = "freeRegister",
-	       reissue = fn {assembly = assembly_spill,
-			     registerAllocation}
-	                  => let
-			       val {register, assembly, registerAllocation}
-				 = freeRegister 
-				   {info = info,
-				    memloc = memloc,
-				    size = size,
-				    supports = supports,
-				    saves = saves,
-				    force = force,
-				    registerAllocation = registerAllocation}
-			     in
-			       {register = register,
-				assembly = AppendList.append (assembly_spill,
-							      assembly),
-				registerAllocation = registerAllocation}
-			     end}
+            val _ = Int.dec depth
+          in
+            {register = final_register,
+             assembly = AppendList.appends [assembly_support, 
+                                            assembly_commit],
+             registerAllocation = registerAllocation}
+          end
+          handle Spill 
+           => spillAndReissue 
+              {info = info,
+               supports = supports,
+               saves = saves,
+               registerAllocation = registerAllocation,
+               spiller = spillRegisters,
+               msg = "freeRegister",
+               reissue = fn {assembly = assembly_spill,
+                             registerAllocation}
+                          => let
+                               val {register, assembly, registerAllocation}
+                                 = freeRegister 
+                                   {info = info,
+                                    memloc = memloc,
+                                    size = size,
+                                    supports = supports,
+                                    saves = saves,
+                                    force = force,
+                                    registerAllocation = registerAllocation}
+                             in
+                               {register = register,
+                                assembly = AppendList.append (assembly_spill,
+                                                              assembly),
+                                registerAllocation = registerAllocation}
+                             end}
 
       and freeFltRegister {info: Liveness.t,
-			   size: Size.t,
-			   supports: Operand.t list,
-			   saves: Operand.t list,
-			   registerAllocation: t} :
-	                  {assembly: Assembly.t AppendList.t,
-			   fltrename: FltRegister.t -> FltRegister.t,
-			   registerAllocation: t}
-	= let
-	    val info as {futures = {pre = future, ...},...} = info
-	    val values
-	      = fltvalueFilter {filter = fn _ => true,
-				registerAllocation = registerAllocation}
-	  in
-	    if List.length values >= FltRegister.total
-	      then let
-		     val saved = fltsavedMemLocs {saves = saves,
-						  registerAllocation 
-						  = registerAllocation}
+                           size: Size.t,
+                           supports: Operand.t list,
+                           saves: Operand.t list,
+                           registerAllocation: t} :
+                          {assembly: Assembly.t AppendList.t,
+                           fltrename: FltRegister.t -> FltRegister.t,
+                           registerAllocation: t}
+        = let
+            val info as {futures = {pre = future, ...},...} = info
+            val values
+              = fltvalueFilter {filter = fn _ => true,
+                                registerAllocation = registerAllocation}
+          in
+            if List.length values >= FltRegister.total
+              then let
+                     val saved = fltsavedMemLocs {saves = saves,
+                                                  registerAllocation 
+                                                  = registerAllocation}
 
-		     val supported = fltsupportedMemLocs {supports = supports,
-							  registerAllocation
-							  = registerAllocation}
+                     val supported = fltsupportedMemLocs {supports = supports,
+                                                          registerAllocation
+                                                          = registerAllocation}
 
-		     val values
-		       = List.revRemoveAll(values,
-					   fn {memloc,...}
-					    => List.contains(saved,
-							     memloc,
-							     MemLoc.eq))
+                     val values
+                       = List.revRemoveAll(values,
+                                           fn {memloc,...}
+                                            => List.contains(saved,
+                                                             memloc,
+                                                             MemLoc.eq))
 
-		     val values_costs
-		       = List.revMap
-		         (values,
-			  fn value as {memloc,weight,sync,commit,...}
-			   => let
-				val support_cost
-				  = List.contains(supported,
-						  memloc,
-						  MemLoc.eq)
+                     val values_costs
+                       = List.revMap
+                         (values,
+                          fn value as {memloc,weight,sync,commit,...}
+                           => let
+                                val support_cost
+                                  = List.contains(supported,
+                                                  memloc,
+                                                  MemLoc.eq)
 
-				val commit_cost
-				  = case commit
-				      of TRYREMOVE _ => false
-				       | REMOVE _ => false
-				       | _ => true
+                                val commit_cost
+                                  = case commit
+                                      of TRYREMOVE _ => false
+                                       | REMOVE _ => false
+                                       | _ => true
 
-				val future_cost
-				  = List.index
-				    (future,
-				     fn Liveness.M (tag, memloc')
-				      => let
-					   val eq = MemLoc.eq(memloc, memloc')
-					 in
-					   case tag
-					     of Liveness.FLIVE => eq
-					      | Liveness.FUSE => eq
-					      | Liveness.FUSEDEF => eq
-					      | _ => false
-					 end
+                                val future_cost
+                                  = List.index
+                                    (future,
+                                     fn Liveness.M (tag, memloc')
+                                      => let
+                                           val eq = MemLoc.eq(memloc, memloc')
+                                         in
+                                           case tag
+                                             of Liveness.FLIVE => eq
+                                              | Liveness.FUSE => eq
+                                              | Liveness.FUSEDEF => eq
+                                              | _ => false
+                                         end
                                       | _ => false)
 
-				val sync_cost = sync
+                                val sync_cost = sync
 
-				val weight_cost = weight
-			      in
-				(value,
-				 (support_cost,
-				  commit_cost,
-				  future_cost,
-				  sync_cost,
-				  weight_cost))
-			      end)
+                                val weight_cost = weight
+                              in
+                                (value,
+                                 (support_cost,
+                                  commit_cost,
+                                  future_cost,
+                                  sync_cost,
+                                  weight_cost))
+                              end)
 
-		     val values_costs_sorted
-		       = List.insertionSort
-		         (values_costs,
-			  fn ((_,(support_c1,
-				  commit_c1,
-				  future_c1,
-				  sync_c1,
-				  weight_c1)),
-			      (_,(support_c2,
-				  commit_c2,
-				  future_c2,
-				  sync_c2,
-				  weight_c2))) 
-			   => bool_lt(support_c1,support_c2) orelse
-			      (support_c1 = support_c2 andalso
-			       (bool_lt(commit_c1,commit_c2) orelse
-				(commit_c1 = commit_c2 andalso
-				 (option_lt (op >) 
-				            (future_c1, future_c2) orelse
-				  (future_c1 = future_c2 andalso
-				   (bool_gt(sync_c1,sync_c2) orelse
-				    (sync_c1 = sync_c2 andalso
-				     weight_c1 < weight_c2))))))))
+                     val values_costs_sorted
+                       = List.insertionSort
+                         (values_costs,
+                          fn ((_,(support_c1,
+                                  commit_c1,
+                                  future_c1,
+                                  sync_c1,
+                                  weight_c1)),
+                              (_,(support_c2,
+                                  commit_c2,
+                                  future_c2,
+                                  sync_c2,
+                                  weight_c2))) 
+                           => bool_lt(support_c1,support_c2) orelse
+                              (support_c1 = support_c2 andalso
+                               (bool_lt(commit_c1,commit_c2) orelse
+                                (commit_c1 = commit_c2 andalso
+                                 (option_lt (op >) 
+                                            (future_c1, future_c2) orelse
+                                  (future_c1 = future_c2 andalso
+                                   (bool_gt(sync_c1,sync_c2) orelse
+                                    (sync_c1 = sync_c2 andalso
+                                     weight_c1 < weight_c2))))))))
 
-		     val values = List.map(values_costs_sorted, #1)
-		   in
-		     case values
-		       of [] => Error.bug "freeFltRegister"
-			| {fltregister,
-			   memloc,
-			   weight,
-			   sync,
-			   ...}::_
-			=> let
-			     val registerAllocation
-			       = fltupdate {value = {fltregister = fltregister,
-						     memloc = memloc,
-						     weight = weight,
-						     sync = sync,
-						     commit = REMOVE 0},
-					    registerAllocation 
-					    = registerAllocation}
+                     val values = List.map(values_costs_sorted, #1)
+                   in
+                     case values
+                       of [] => Error.bug "x86AllocateRegisters.RegisterAllocation.freeFltRegister"
+                        | {fltregister,
+                           memloc,
+                           weight,
+                           sync,
+                           ...}::_
+                        => let
+                             val registerAllocation
+                               = fltupdate {value = {fltregister = fltregister,
+                                                     memloc = memloc,
+                                                     weight = weight,
+                                                     sync = sync,
+                                                     commit = REMOVE 0},
+                                            registerAllocation 
+                                            = registerAllocation}
 
-			     val {assembly = assembly_commit,
-				  fltrename = fltrename_commit,
-				  registerAllocation}
-			       = commitFltRegisters {info = info,
-						     supports = supports,
-						     saves = saves,
-						     registerAllocation
-						     = registerAllocation}
-			   in
-			     {assembly = assembly_commit,
-			      fltrename = fltrename_commit,
-			      registerAllocation = registerAllocation}
-			   end
-		   end
-	      else {assembly = AppendList.empty,
-		    fltrename = FltRegister.id,
-		    registerAllocation = registerAllocation}
-	  end
-	  handle Spill 
-	   => spillAndReissue 
-	      {info = info,
-	       supports = supports,
-	       saves = saves,
-	       registerAllocation = registerAllocation,
-	       spiller = spillRegisters,
-	       msg = "freeFltRegisters",
-	       reissue = fn {assembly = assembly_spill,
-			     registerAllocation}
-	                  => let
-			       val {assembly, fltrename, registerAllocation}
-				 = freeFltRegister 
-				   {info = info,
-				    size = size,
-				    supports = supports,
-				    saves = saves,
-				    registerAllocation = registerAllocation}
-			     in
-			       {assembly = AppendList.append (assembly_spill,
-							      assembly),
-				fltrename = fltrename,
-				registerAllocation = registerAllocation}
-			     end}
+                             val {assembly = assembly_commit,
+                                  fltrename = fltrename_commit,
+                                  registerAllocation}
+                               = commitFltRegisters {info = info,
+                                                     supports = supports,
+                                                     saves = saves,
+                                                     registerAllocation
+                                                     = registerAllocation}
+                           in
+                             {assembly = assembly_commit,
+                              fltrename = fltrename_commit,
+                              registerAllocation = registerAllocation}
+                           end
+                   end
+              else {assembly = AppendList.empty,
+                    fltrename = FltRegister.id,
+                    registerAllocation = registerAllocation}
+          end
+          handle Spill 
+           => spillAndReissue 
+              {info = info,
+               supports = supports,
+               saves = saves,
+               registerAllocation = registerAllocation,
+               spiller = spillRegisters,
+               msg = "freeFltRegisters",
+               reissue = fn {assembly = assembly_spill,
+                             registerAllocation}
+                          => let
+                               val {assembly, fltrename, registerAllocation}
+                                 = freeFltRegister 
+                                   {info = info,
+                                    size = size,
+                                    supports = supports,
+                                    saves = saves,
+                                    registerAllocation = registerAllocation}
+                             in
+                               {assembly = AppendList.append (assembly_spill,
+                                                              assembly),
+                                fltrename = fltrename,
+                                registerAllocation = registerAllocation}
+                             end}
 
       and commitRegisters {info: Liveness.t,
-			   supports: Operand.t list,
-			   saves: Operand.t list,
-			   registerAllocation as {reserved,...}: t} :
-	                  {assembly: Assembly.t AppendList.t,
-			   registerAllocation: t}
-	= let
-	    val _ = Int.inc depth
+                           supports: Operand.t list,
+                           saves: Operand.t list,
+                           registerAllocation as {reserved,...}: t} :
+                          {assembly: Assembly.t AppendList.t,
+                           registerAllocation: t}
+        = let
+            val _ = Int.inc depth
             val commit_values
-	      = valueFilter {filter = fn {commit = COMMIT 0, ...} => true
-			               | {commit = REMOVE 0, ...} => true
-			               | {commit = TRYCOMMIT 0, ...} => true
-			               | {commit = TRYREMOVE 0, ...} => true
-			               | _ => false, 
-			     registerAllocation = registerAllocation}
+              = valueFilter {filter = fn {commit = COMMIT 0, ...} => true
+                                       | {commit = REMOVE 0, ...} => true
+                                       | {commit = TRYCOMMIT 0, ...} => true
+                                       | {commit = TRYREMOVE 0, ...} => true
+                                       | _ => false, 
+                             registerAllocation = registerAllocation}
 
-	    val commit_memlocs = List.revMap(commit_values, #memloc)
+            val commit_memlocs = List.revMap(commit_values, #memloc)
 
-	    val commit_memlocs
-	      = totalOrder
-	        (commit_memlocs,
-		 fn (memloc1,memloc2)
-		  => List.contains(MemLoc.utilized memloc1,
-				   memloc2,
-				   MemLoc.eq))
+            val commit_memlocs
+              = totalOrder
+                (commit_memlocs,
+                 fn (memloc1,memloc2)
+                  => List.contains(MemLoc.utilized memloc1,
+                                   memloc2,
+                                   MemLoc.eq))
 
-	    val {assembly = assembly_commit,
-		 registerAllocation}
-	      = List.fold
-	        (commit_memlocs,
-		 {assembly = AppendList.empty,
-		  registerAllocation = registerAllocation},
-		 fn (memloc,
-		     {assembly,
-		      registerAllocation})
-		  => (case allocated {memloc = memloc,
-				      registerAllocation 
-				      = registerAllocation}
-			of NONE => {assembly = assembly,
-				    registerAllocation = registerAllocation}
-			 | SOME ({register,
-				  memloc,
-				  weight,
-				  sync,
-				  commit})
-			 => let
-			      fun doCommitFalse ()
-				= let
-				    val registerAllocation
-				      = update {value = {register = register,
-							 memloc = memloc,
-							 weight = weight,
-							 sync = true,
-							 commit = NO},
-						registerAllocation 
-						= registerAllocation}
+            val {assembly = assembly_commit,
+                 registerAllocation}
+              = List.fold
+                (commit_memlocs,
+                 {assembly = AppendList.empty,
+                  registerAllocation = registerAllocation},
+                 fn (memloc,
+                     {assembly,
+                      registerAllocation})
+                  => (case allocated {memloc = memloc,
+                                      registerAllocation 
+                                      = registerAllocation}
+                        of NONE => {assembly = assembly,
+                                    registerAllocation = registerAllocation}
+                         | SOME ({register,
+                                  memloc,
+                                  weight,
+                                  sync,
+                                  commit})
+                         => let
+                              fun doCommitFalse ()
+                                = let
+                                    val registerAllocation
+                                      = update {value = {register = register,
+                                                         memloc = memloc,
+                                                         weight = weight,
+                                                         sync = true,
+                                                         commit = NO},
+                                                registerAllocation 
+                                                = registerAllocation}
 
-				    val registerAllocation
-				      = commitPush {registerAllocation 
-						    = registerAllocation}
+                                    val registerAllocation
+                                      = commitPush {registerAllocation 
+                                                    = registerAllocation}
 
-				    val commit_saves 
-				      = List.removeDuplicates
-				        ((Operand.register register)::saves,
-					 Operand.eq)
+                                    val commit_saves 
+                                      = List.removeDuplicates
+                                        ((Operand.register register)::saves,
+                                         Operand.eq)
 
-				    val size = Register.size register
-				    val {address,
-					 assembly = assembly_address,
-					 registerAllocation}
-				      = toAddressMemLoc {memloc = memloc,
-							 info = info,
-							 size = size,
-							 supports = supports,
-							 saves = commit_saves,
-							 registerAllocation 
-							 = registerAllocation}
+                                    val size = Register.size register
+                                    val {address,
+                                         assembly = assembly_address,
+                                         registerAllocation}
+                                      = toAddressMemLoc {memloc = memloc,
+                                                         info = info,
+                                                         size = size,
+                                                         supports = supports,
+                                                         saves = commit_saves,
+                                                         registerAllocation 
+                                                         = registerAllocation}
 
-				    val registerAllocation
-				      = commitPop {registerAllocation 
-						   = registerAllocation}
-				  in
-				    {assembly 
-				     = AppendList.appends 
-				       [assembly,
-					assembly_address,
-					AppendList.single
-					(Assembly.instruction_mov
-					 {dst = Operand.Address address,
-					  src = Operand.Register register,
-					  size = size})],
-				     registerAllocation = registerAllocation}
-				  end
+                                    val registerAllocation
+                                      = commitPop {registerAllocation 
+                                                   = registerAllocation}
+                                  in
+                                    {assembly 
+                                     = AppendList.appends 
+                                       [assembly,
+                                        assembly_address,
+                                        AppendList.single
+                                        (Assembly.instruction_mov
+                                         {dst = Operand.Address address,
+                                          src = Operand.Register register,
+                                          size = size})],
+                                     registerAllocation = registerAllocation}
+                                  end
 
-			      fun doCommitTrue ()
-				= let
-				    val registerAllocation
-				      = update {value = {register = register,
-							 memloc = memloc,
-							 weight = weight,
-							 sync = true,
-							 commit = NO},
-						registerAllocation 
-						= registerAllocation}
-				  in
-				    {assembly = assembly,
-				     registerAllocation = registerAllocation}
-				  end
+                              fun doCommitTrue ()
+                                = let
+                                    val registerAllocation
+                                      = update {value = {register = register,
+                                                         memloc = memloc,
+                                                         weight = weight,
+                                                         sync = true,
+                                                         commit = NO},
+                                                registerAllocation 
+                                                = registerAllocation}
+                                  in
+                                    {assembly = assembly,
+                                     registerAllocation = registerAllocation}
+                                  end
 
-			      fun doRemoveFalse ()
-				= let
-				    val registerAllocation
-				      = update {value = {register = register,
-							 memloc = memloc,
-							 weight = weight,
-							 sync = true,
-							 commit = NO},
-						registerAllocation 
-						= registerAllocation}
-				
-				    val registerAllocation
-				      = commitPush {registerAllocation 
-						    = registerAllocation}
-				      
-				    val commit_saves 
-				      = List.removeDuplicates
-				        ((Operand.register register)::saves,
-					 Operand.eq)
+                              fun doRemoveFalse ()
+                                = let
+                                    val registerAllocation
+                                      = update {value = {register = register,
+                                                         memloc = memloc,
+                                                         weight = weight,
+                                                         sync = true,
+                                                         commit = NO},
+                                                registerAllocation 
+                                                = registerAllocation}
+                                
+                                    val registerAllocation
+                                      = commitPush {registerAllocation 
+                                                    = registerAllocation}
+                                      
+                                    val commit_saves 
+                                      = List.removeDuplicates
+                                        ((Operand.register register)::saves,
+                                         Operand.eq)
 
-				    val size = Register.size register
-				    val {address,
-					 assembly = assembly_address,
-					 registerAllocation}
-				      = toAddressMemLoc {memloc = memloc,
-							 info = info,
-							 size = size,
-							 supports = supports,
-							 saves = commit_saves,
-							 registerAllocation 
-							 = registerAllocation}
-				  
-				    val registerAllocation
-				      = commitPop {registerAllocation 
-						   = registerAllocation}
-				      
-				    val registerAllocation
-				      = if List.contains
-				           (reserved,
-					    register,
-					    Register.eq)
-					  then registerAllocation
-					  else remove {memloc = memloc,
-						       registerAllocation 
-						       = registerAllocation}
-				  in
-				    {assembly 
-				     = AppendList.appends
-				       [assembly,
-					assembly_address,
-					AppendList.single
-					(Assembly.instruction_mov
-					 {dst = Operand.Address address,
-					  src = Operand.Register register,
-					  size = size})],
-				     registerAllocation = registerAllocation}
-				  end
+                                    val size = Register.size register
+                                    val {address,
+                                         assembly = assembly_address,
+                                         registerAllocation}
+                                      = toAddressMemLoc {memloc = memloc,
+                                                         info = info,
+                                                         size = size,
+                                                         supports = supports,
+                                                         saves = commit_saves,
+                                                         registerAllocation 
+                                                         = registerAllocation}
+                                  
+                                    val registerAllocation
+                                      = commitPop {registerAllocation 
+                                                   = registerAllocation}
+                                      
+                                    val registerAllocation
+                                      = if List.contains
+                                           (reserved,
+                                            register,
+                                            Register.eq)
+                                          then registerAllocation
+                                          else remove {memloc = memloc,
+                                                       registerAllocation 
+                                                       = registerAllocation}
+                                  in
+                                    {assembly 
+                                     = AppendList.appends
+                                       [assembly,
+                                        assembly_address,
+                                        AppendList.single
+                                        (Assembly.instruction_mov
+                                         {dst = Operand.Address address,
+                                          src = Operand.Register register,
+                                          size = size})],
+                                     registerAllocation = registerAllocation}
+                                  end
 
-			      fun doRemoveTrue ()
-				= let
-				    val registerAllocation
-				      = update {value = {register = register,
-							 memloc = memloc,
-							 weight = weight,
-							 sync = true,
-							 commit = NO},
-						registerAllocation 
-						= registerAllocation}
-				      
-				    val registerAllocation
-				      = if List.contains
-				           (reserved,
-					    register,
-					    Register.eq)
-					  then registerAllocation
-					  else remove {memloc = memloc,
-						       registerAllocation 
-						       = registerAllocation}
-				  in
-				    {assembly = assembly,
-				     registerAllocation = registerAllocation}
-				  end
-			    in
-			      case (commit,sync)
-				of (COMMIT 0, false) => doCommitFalse ()
-				 | (COMMIT 0, true) => doCommitTrue ()
-				 | (REMOVE 0, false) => doRemoveFalse ()
-				 | (REMOVE 0, true) => doRemoveTrue ()
-				 | (TRYCOMMIT 0, false) => doCommitFalse ()
-				 | (TRYCOMMIT 0, true) => doCommitTrue ()
-				 | (TRYREMOVE 0, false) => doRemoveFalse ()
-				 | (TRYREMOVE 0, true) => doRemoveTrue ()
-				 | _ 
-				 => Error.bug "commitRegisters"
-			    end))
-	    val _ = Int.dec depth
-	  in
-	    {assembly = assembly_commit,
-	     registerAllocation = registerAllocation}
-	  end
-	  handle Spill 
-	   => spillAndReissue 
-	      {info = info,
-	       supports = supports,
-	       saves = saves,
-	       registerAllocation = registerAllocation,
-	       spiller = spillRegisters,
-	       msg = "commitRegisters",
-	       reissue = fn {assembly = assembly_spill,
-			     registerAllocation}
-	                  => let
-			       val {assembly, registerAllocation}
-				 = commitRegisters 
-				   {info = info,
-				    supports = supports,
-				    saves = saves,
-				    registerAllocation = registerAllocation}
-			     in
-			       {assembly = AppendList.append (assembly_spill,
-							      assembly),
-				registerAllocation = registerAllocation}
-			     end}
+                              fun doRemoveTrue ()
+                                = let
+                                    val registerAllocation
+                                      = update {value = {register = register,
+                                                         memloc = memloc,
+                                                         weight = weight,
+                                                         sync = true,
+                                                         commit = NO},
+                                                registerAllocation 
+                                                = registerAllocation}
+                                      
+                                    val registerAllocation
+                                      = if List.contains
+                                           (reserved,
+                                            register,
+                                            Register.eq)
+                                          then registerAllocation
+                                          else remove {memloc = memloc,
+                                                       registerAllocation 
+                                                       = registerAllocation}
+                                  in
+                                    {assembly = assembly,
+                                     registerAllocation = registerAllocation}
+                                  end
+                            in
+                              case (commit,sync)
+                                of (COMMIT 0, false) => doCommitFalse ()
+                                 | (COMMIT 0, true) => doCommitTrue ()
+                                 | (REMOVE 0, false) => doRemoveFalse ()
+                                 | (REMOVE 0, true) => doRemoveTrue ()
+                                 | (TRYCOMMIT 0, false) => doCommitFalse ()
+                                 | (TRYCOMMIT 0, true) => doCommitTrue ()
+                                 | (TRYREMOVE 0, false) => doRemoveFalse ()
+                                 | (TRYREMOVE 0, true) => doRemoveTrue ()
+                                 | _ 
+                                 => Error.bug "x86AllocateRegisters.RegisterAllocation.commitRegisters"
+                            end))
+            val _ = Int.dec depth
+          in
+            {assembly = assembly_commit,
+             registerAllocation = registerAllocation}
+          end
+          handle Spill 
+           => spillAndReissue 
+              {info = info,
+               supports = supports,
+               saves = saves,
+               registerAllocation = registerAllocation,
+               spiller = spillRegisters,
+               msg = "commitRegisters",
+               reissue = fn {assembly = assembly_spill,
+                             registerAllocation}
+                          => let
+                               val {assembly, registerAllocation}
+                                 = commitRegisters 
+                                   {info = info,
+                                    supports = supports,
+                                    saves = saves,
+                                    registerAllocation = registerAllocation}
+                             in
+                               {assembly = AppendList.append (assembly_spill,
+                                                              assembly),
+                                registerAllocation = registerAllocation}
+                             end}
 
       and commitFltRegisters {info: Liveness.t,
-			      supports: Operand.t list,
-			      saves: Operand.t list,
-			      registerAllocation: t} :
-	                     {assembly: Assembly.t AppendList.t,
-			      fltrename: FltRegister.t -> FltRegister.t,
-			      registerAllocation: t}
-	= let
-	    val _ = Int.inc depth
-	    val commit_values
-	      = fltvalueFilter {filter
-				= fn {commit = COMMIT 0, ...} => true
-			           | {commit = REMOVE 0, ...} => true
-			           | {commit = TRYCOMMIT 0, ...} => true
-			           | {commit = TRYREMOVE 0, ...} => true
-				   | _ => false,
-				registerAllocation = registerAllocation}
+                              supports: Operand.t list,
+                              saves: Operand.t list,
+                              registerAllocation: t} :
+                             {assembly: Assembly.t AppendList.t,
+                              fltrename: FltRegister.t -> FltRegister.t,
+                              registerAllocation: t}
+        = let
+            val _ = Int.inc depth
+            val commit_values
+              = fltvalueFilter {filter
+                                = fn {commit = COMMIT 0, ...} => true
+                                   | {commit = REMOVE 0, ...} => true
+                                   | {commit = TRYCOMMIT 0, ...} => true
+                                   | {commit = TRYREMOVE 0, ...} => true
+                                   | _ => false,
+                                registerAllocation = registerAllocation}
 
-	    val {assembly = assembly_commit,
-		 fltrename = fltrename_commit,
-		 registerAllocation}
-	      = List.fold
-	        (commit_values,
-		 {assembly = AppendList.empty,
-		  fltrename = FltRegister.id,
-		  registerAllocation = registerAllocation},
-		 fn ({fltregister,
-		      memloc,
-		      weight,
-		      sync,
-		      commit},
-		     {assembly, fltrename, registerAllocation})
-		  => let
-		       fun doCommitFalse ()
-			 = let
-			     val fltregister = fltrename fltregister
-			     val {assembly = assembly_xch,
-				  fltrename = fltrename_xch,
-				  registerAllocation}
-			       = if FltRegister.eq(fltregister, 
-						   FltRegister.top)
-				   then {assembly = AppendList.empty,
-					 fltrename = FltRegister.id,
-					 registerAllocation 
-					 = registerAllocation}
-				   else let
-					  val {fltrename = fltrename_xch,
-					       registerAllocation}
-					    = fltxch' 
-					      {fltregister = fltregister,
-					       registerAllocation 
-					       = registerAllocation}
-					in
-					  {assembly
-					   = AppendList.single
-					     (Assembly.instruction_fxch
-					      {src = Operand.fltregister 
-					             fltregister}),
-					   fltrename = fltrename_xch,
-					   registerAllocation 
-					   = registerAllocation}
-					end
+            val {assembly = assembly_commit,
+                 fltrename = fltrename_commit,
+                 registerAllocation}
+              = List.fold
+                (commit_values,
+                 {assembly = AppendList.empty,
+                  fltrename = FltRegister.id,
+                  registerAllocation = registerAllocation},
+                 fn ({fltregister,
+                      memloc,
+                      weight,
+                      sync,
+                      commit},
+                     {assembly, fltrename, registerAllocation})
+                  => let
+                       fun doCommitFalse ()
+                         = let
+                             val fltregister = fltrename fltregister
+                             val {assembly = assembly_xch,
+                                  fltrename = fltrename_xch,
+                                  registerAllocation}
+                               = if FltRegister.eq(fltregister, 
+                                                   FltRegister.top)
+                                   then {assembly = AppendList.empty,
+                                         fltrename = FltRegister.id,
+                                         registerAllocation 
+                                         = registerAllocation}
+                                   else let
+                                          val {fltrename = fltrename_xch,
+                                               registerAllocation}
+                                            = fltxch' 
+                                              {fltregister = fltregister,
+                                               registerAllocation 
+                                               = registerAllocation}
+                                        in
+                                          {assembly
+                                           = AppendList.single
+                                             (Assembly.instruction_fxch
+                                              {src = Operand.fltregister 
+                                                     fltregister}),
+                                           fltrename = fltrename_xch,
+                                           registerAllocation 
+                                           = registerAllocation}
+                                        end
 
-			     val size = MemLoc.size memloc
-			       
-			     val {address,
-				  assembly = assembly_address,
-				  registerAllocation}
-			       = toAddressMemLoc {memloc = memloc,
-						  info = info,
-						  size = size,
-						  supports = supports,
-						  saves = saves,
-						  registerAllocation 
-						  = registerAllocation}
-			       
-			     val registerAllocation
-			       = fltupdate {value 
-					    = {fltregister = FltRegister.top,
-					       memloc = memloc,
-					       weight = weight,
-					       sync = true,
-					       commit = NO},
-					    registerAllocation 
-					    = registerAllocation}
-			   in
-			     {assembly 
-			      = AppendList.appends
-			        [assembly,
-				 assembly_xch,
-				 assembly_address,
-				 case Size.class size
-				   of Size.FLT 
-				    => AppendList.single
-				       (Assembly.instruction_fst
-					{dst = Operand.Address address,
-					 size = size,
-					 pop = false})
-				    | Size.FPI 
-				    => AppendList.single
-				       (Assembly.instruction_fist
-					{dst = Operand.Address address,
-					 size = size,
-					 pop = false})
-				    | _ => Error.bug "commitFltRegisters"],
-			      fltrename 
-			      = fltrename_xch o fltrename,
-			      registerAllocation  = registerAllocation}
-			   end
+                             val size = MemLoc.size memloc
+                               
+                             val {address,
+                                  assembly = assembly_address,
+                                  registerAllocation}
+                               = toAddressMemLoc {memloc = memloc,
+                                                  info = info,
+                                                  size = size,
+                                                  supports = supports,
+                                                  saves = saves,
+                                                  registerAllocation 
+                                                  = registerAllocation}
+                               
+                             val registerAllocation
+                               = fltupdate {value 
+                                            = {fltregister = FltRegister.top,
+                                               memloc = memloc,
+                                               weight = weight,
+                                               sync = true,
+                                               commit = NO},
+                                            registerAllocation 
+                                            = registerAllocation}
+                           in
+                             {assembly 
+                              = AppendList.appends
+                                [assembly,
+                                 assembly_xch,
+                                 assembly_address,
+                                 case Size.class size
+                                   of Size.FLT 
+                                    => AppendList.single
+                                       (Assembly.instruction_fst
+                                        {dst = Operand.Address address,
+                                         size = size,
+                                         pop = false})
+                                    | Size.FPI 
+                                    => AppendList.single
+                                       (Assembly.instruction_fist
+                                        {dst = Operand.Address address,
+                                         size = size,
+                                         pop = false})
+                                    | _ => Error.bug "x86AllocateRegisters.RegisterAllocation.commitFltRegisters"],
+                              fltrename 
+                              = fltrename_xch o fltrename,
+                              registerAllocation  = registerAllocation}
+                           end
 
-		       fun doCommitTrue ()
-			 = let
-			     val fltregister = fltrename fltregister
-			     val registerAllocation
-			       = fltupdate 
-			         {value = {fltregister = fltregister,
-					   memloc = memloc,
-					   weight = weight,
-					   sync = true,
-					   commit = NO},
-				  registerAllocation = registerAllocation}
-			   in
-			     {assembly = assembly,
-			      fltrename = fltrename,
-			      registerAllocation = registerAllocation}
-			   end
+                       fun doCommitTrue ()
+                         = let
+                             val fltregister = fltrename fltregister
+                             val registerAllocation
+                               = fltupdate 
+                                 {value = {fltregister = fltregister,
+                                           memloc = memloc,
+                                           weight = weight,
+                                           sync = true,
+                                           commit = NO},
+                                  registerAllocation = registerAllocation}
+                           in
+                             {assembly = assembly,
+                              fltrename = fltrename,
+                              registerAllocation = registerAllocation}
+                           end
 
-		       fun doRemoveFalse ()
-			 = let
-			     val fltregister = fltrename fltregister
-			     val {assembly = assembly_xch,
-				  fltrename = fltrename_xch,
-				  registerAllocation}
-			       = if FltRegister.eq(fltregister, 
-						   FltRegister.top)
-				   then {assembly = AppendList.empty,
-					 fltrename = FltRegister.id,
-					 registerAllocation 
-					 = registerAllocation}
-				   else let
-					  val {fltrename = fltrename_xch,
-					       registerAllocation}
-					    = fltxch' 
-					      {fltregister = fltregister,
-					       registerAllocation 
-					       = registerAllocation}
-					in
-					  {assembly
-					   = AppendList.single
-					     (Assembly.instruction_fxch
-					      {src = Operand.fltregister 
-					             fltregister}),
-					   fltrename = fltrename_xch,
-					   registerAllocation 
-					   = registerAllocation}
-					end
+                       fun doRemoveFalse ()
+                         = let
+                             val fltregister = fltrename fltregister
+                             val {assembly = assembly_xch,
+                                  fltrename = fltrename_xch,
+                                  registerAllocation}
+                               = if FltRegister.eq(fltregister, 
+                                                   FltRegister.top)
+                                   then {assembly = AppendList.empty,
+                                         fltrename = FltRegister.id,
+                                         registerAllocation 
+                                         = registerAllocation}
+                                   else let
+                                          val {fltrename = fltrename_xch,
+                                               registerAllocation}
+                                            = fltxch' 
+                                              {fltregister = fltregister,
+                                               registerAllocation 
+                                               = registerAllocation}
+                                        in
+                                          {assembly
+                                           = AppendList.single
+                                             (Assembly.instruction_fxch
+                                              {src = Operand.fltregister 
+                                                     fltregister}),
+                                           fltrename = fltrename_xch,
+                                           registerAllocation 
+                                           = registerAllocation}
+                                        end
 
-			     val size = MemLoc.size memloc
-			       
-			     val {address,
-				  assembly = assembly_address,
-				  registerAllocation}
-			       = toAddressMemLoc {memloc = memloc,
-						  info = info,
-						  size = size,
-						  supports = supports,
-						  saves = saves,
-						  registerAllocation 
-						  = registerAllocation}
+                             val size = MemLoc.size memloc
+                               
+                             val {address,
+                                  assembly = assembly_address,
+                                  registerAllocation}
+                               = toAddressMemLoc {memloc = memloc,
+                                                  info = info,
+                                                  size = size,
+                                                  supports = supports,
+                                                  saves = saves,
+                                                  registerAllocation 
+                                                  = registerAllocation}
 
-			     val {fltrename = fltrename_pop,
-				  registerAllocation}
-			       = fltpop 
-			         {registerAllocation = registerAllocation}
-			   in
-			     {assembly 
-			      = AppendList.appends
-			        [assembly,
-				 assembly_xch,
-				 assembly_address,
-				 case Size.class size
-				   of Size.FLT 
-				    => AppendList.single
-				       (Assembly.instruction_fst
-					{dst = Operand.Address address,
-					 size = size,
-					 pop = true})
-				    | Size.FPI 
-				    => AppendList.single
-				       (Assembly.instruction_fist
-					{dst = Operand.Address address,
-					 size = size,
-					 pop = true})
-				    | _ => Error.bug "commitFltRegisters"],
-			      fltrename 
-			      = fltrename_pop o fltrename_xch o fltrename,
-			      registerAllocation  = registerAllocation}
-			   end
+                             val {fltrename = fltrename_pop,
+                                  registerAllocation}
+                               = fltpop 
+                                 {registerAllocation = registerAllocation}
+                           in
+                             {assembly 
+                              = AppendList.appends
+                                [assembly,
+                                 assembly_xch,
+                                 assembly_address,
+                                 case Size.class size
+                                   of Size.FLT 
+                                    => AppendList.single
+                                       (Assembly.instruction_fst
+                                        {dst = Operand.Address address,
+                                         size = size,
+                                         pop = true})
+                                    | Size.FPI 
+                                    => AppendList.single
+                                       (Assembly.instruction_fist
+                                        {dst = Operand.Address address,
+                                         size = size,
+                                         pop = true})
+                                    | _ => Error.bug "x86AllocateRegisters.RegisterAllocation.commitFltRegisters"],
+                              fltrename 
+                              = fltrename_pop o fltrename_xch o fltrename,
+                              registerAllocation  = registerAllocation}
+                           end
 
-		       fun doRemoveTrue ()
-			 = let
-			     val fltregister = fltrename fltregister
-			     val {assembly = assembly_xch,
-				  fltrename = fltrename_xch,
-				  registerAllocation}
-			       = if FltRegister.eq(fltregister, 
-						   FltRegister.top)
-				   then {assembly = AppendList.empty,
-					 fltrename = FltRegister.id,
-					 registerAllocation 
-					 = registerAllocation}
-				   else let
-					  val {fltrename = fltrename_xch,
-					       registerAllocation}
-					    = fltxch' 
-					      {fltregister = fltregister,
-					       registerAllocation 
-					       = registerAllocation}
-					in
-					  {assembly 
-					   = AppendList.single
-					     (Assembly.instruction_fxch
-					      {src = Operand.fltregister 
-					       fltregister}),
-					   fltrename = fltrename_xch,
-					   registerAllocation 
-					   = registerAllocation}
-					end
-		     
-			     val {fltrename = fltrename_pop,
-				  registerAllocation}
-			       = fltpop {registerAllocation 
-					 = registerAllocation}
+                       fun doRemoveTrue ()
+                         = let
+                             val fltregister = fltrename fltregister
+                             val {assembly = assembly_xch,
+                                  fltrename = fltrename_xch,
+                                  registerAllocation}
+                               = if FltRegister.eq(fltregister, 
+                                                   FltRegister.top)
+                                   then {assembly = AppendList.empty,
+                                         fltrename = FltRegister.id,
+                                         registerAllocation 
+                                         = registerAllocation}
+                                   else let
+                                          val {fltrename = fltrename_xch,
+                                               registerAllocation}
+                                            = fltxch' 
+                                              {fltregister = fltregister,
+                                               registerAllocation 
+                                               = registerAllocation}
+                                        in
+                                          {assembly 
+                                           = AppendList.single
+                                             (Assembly.instruction_fxch
+                                              {src = Operand.fltregister 
+                                               fltregister}),
+                                           fltrename = fltrename_xch,
+                                           registerAllocation 
+                                           = registerAllocation}
+                                        end
+                     
+                             val {fltrename = fltrename_pop,
+                                  registerAllocation}
+                               = fltpop {registerAllocation 
+                                         = registerAllocation}
 
-			     val size = MemLoc.size memloc
-			   in
-			     {assembly 
-			      = AppendList.appends
-			        [assembly,
-				 assembly_xch,
-				 case Size.class size
-				   of Size.FLT 
-				    => AppendList.single
-				       (Assembly.instruction_fst
-					{dst = Operand.fltregister 
-					       FltRegister.top,
-					 size = size,
-					 pop = true})
-				  | Size.FPI 
-				  => AppendList.single
-				     (Assembly.instruction_fst
-				      {dst = Operand.fltregister
-				             FltRegister.top,
-				       size = Size.DBLE,
-				       pop = true})
-				  | _ => Error.bug "commitFltRegisters"],
-			      fltrename = fltrename_pop o fltrename_xch o fltrename,
-			      registerAllocation  = registerAllocation}
-			   end
+                             val size = MemLoc.size memloc
+                           in
+                             {assembly 
+                              = AppendList.appends
+                                [assembly,
+                                 assembly_xch,
+                                 case Size.class size
+                                   of Size.FLT 
+                                    => AppendList.single
+                                       (Assembly.instruction_fst
+                                        {dst = Operand.fltregister 
+                                               FltRegister.top,
+                                         size = size,
+                                         pop = true})
+                                  | Size.FPI 
+                                  => AppendList.single
+                                     (Assembly.instruction_fst
+                                      {dst = Operand.fltregister
+                                             FltRegister.top,
+                                       size = Size.DBLE,
+                                       pop = true})
+                                  | _ => Error.bug "x86AllocateRegisters.RegisterAllocation.commitFltRegisters"],
+                              fltrename = fltrename_pop o fltrename_xch o fltrename,
+                              registerAllocation  = registerAllocation}
+                           end
 
-		       fun doNothing ()
-			 = {assembly = assembly,
-			    fltrename = fltrename,
-			    registerAllocation = registerAllocation}
-		     in
-		       case (commit,sync)
-			 of (COMMIT 0, false) => doCommitFalse ()
-			  | (COMMIT 0, true) => doCommitTrue ()
-			  | (REMOVE 0, false) => doRemoveFalse ()
-			  | (REMOVE 0, true) => doRemoveTrue ()
-			  | (TRYCOMMIT 0, false)
-			  => if FltRegister.eq(fltrename fltregister, 
-					       FltRegister.top)
-			       then doCommitFalse ()
-			       else doNothing ()
-			  | (TRYCOMMIT 0, true)
-			  => if FltRegister.eq(fltrename fltregister, 
-					       FltRegister.top)
-			       then doCommitTrue ()
-			       else doNothing ()
-			  | (TRYREMOVE 0, false)
-			  => if FltRegister.eq(fltrename fltregister, 
-					       FltRegister.top)
-			       then doRemoveFalse ()
-			       else doNothing ()
-			  | (TRYREMOVE 0, true)
-			  => if FltRegister.eq(fltrename fltregister, 
-					       FltRegister.top)
-			       then doRemoveTrue ()
-			       else doNothing ()
-			  | _ => Error.bug "commitFltRegisters"
-		     end)
+                       fun doNothing ()
+                         = {assembly = assembly,
+                            fltrename = fltrename,
+                            registerAllocation = registerAllocation}
+                     in
+                       case (commit,sync)
+                         of (COMMIT 0, false) => doCommitFalse ()
+                          | (COMMIT 0, true) => doCommitTrue ()
+                          | (REMOVE 0, false) => doRemoveFalse ()
+                          | (REMOVE 0, true) => doRemoveTrue ()
+                          | (TRYCOMMIT 0, false)
+                          => if FltRegister.eq(fltrename fltregister, 
+                                               FltRegister.top)
+                               then doCommitFalse ()
+                               else doNothing ()
+                          | (TRYCOMMIT 0, true)
+                          => if FltRegister.eq(fltrename fltregister, 
+                                               FltRegister.top)
+                               then doCommitTrue ()
+                               else doNothing ()
+                          | (TRYREMOVE 0, false)
+                          => if FltRegister.eq(fltrename fltregister, 
+                                               FltRegister.top)
+                               then doRemoveFalse ()
+                               else doNothing ()
+                          | (TRYREMOVE 0, true)
+                          => if FltRegister.eq(fltrename fltregister, 
+                                               FltRegister.top)
+                               then doRemoveTrue ()
+                               else doNothing ()
+                          | _ => Error.bug "x86AllocateRegisters.RegisterAllocation.commitFltRegisters"
+                     end)
 
-	    val _ = Int.dec depth
-	  in
-	    {assembly = assembly_commit,
-	     fltrename = fltrename_commit,
-	     registerAllocation = registerAllocation}
-	  end
-	  handle Spill 
-	   => spillAndReissue 
-	      {info = info,
-	       supports = supports,
-	       saves = saves,
-	       registerAllocation = registerAllocation,
-	       spiller = spillRegisters,
-	       msg = "commitFltRegisters",
-	       reissue = fn {assembly = assembly_spill,
-			     registerAllocation}
-	                  => let
-			       val {assembly, fltrename, registerAllocation}
-				 = commitFltRegisters 
-				   {info = info,
-				    supports = supports,
-				    saves = saves,
-				    registerAllocation = registerAllocation}
-			     in
-			       {assembly = AppendList.append (assembly_spill,
-							      assembly),
-				fltrename = fltrename,
-				registerAllocation = registerAllocation}
-			     end}
+            val _ = Int.dec depth
+          in
+            {assembly = assembly_commit,
+             fltrename = fltrename_commit,
+             registerAllocation = registerAllocation}
+          end
+          handle Spill 
+           => spillAndReissue 
+              {info = info,
+               supports = supports,
+               saves = saves,
+               registerAllocation = registerAllocation,
+               spiller = spillRegisters,
+               msg = "commitFltRegisters",
+               reissue = fn {assembly = assembly_spill,
+                             registerAllocation}
+                          => let
+                               val {assembly, fltrename, registerAllocation}
+                                 = commitFltRegisters 
+                                   {info = info,
+                                    supports = supports,
+                                    saves = saves,
+                                    registerAllocation = registerAllocation}
+                             in
+                               {assembly = AppendList.append (assembly_spill,
+                                                              assembly),
+                                fltrename = fltrename,
+                                registerAllocation = registerAllocation}
+                             end}
 
       and spillRegisters {info: Liveness.t,
-			  supports: Operand.t list,
-			  saves: Operand.t list,
-			  registerAllocation} :
-	                 {assembly: Assembly.t AppendList.t,
-			  registerAllocation: t}
-	= let
-	    val _ = Int.inc depth
-	    val spillStart = !spill
+                          supports: Operand.t list,
+                          saves: Operand.t list,
+                          registerAllocation} :
+                         {assembly: Assembly.t AppendList.t,
+                          registerAllocation: t}
+        = let
+            val _ = Int.inc depth
+            val spillStart = !spill
 
-	    val {reserved, ...} = registerAllocation
-	    val {assembly = assembly_unreserve,
-		 registerAllocation}
-	      = List.fold
-	        (reserved,
-		 {assembly = AppendList.empty,
-		  registerAllocation = registerAllocation},
-		 fn (register, 
-		     {assembly, registerAllocation})
-		  => let
-		       val {assembly = assembly_unreserve,
-			    registerAllocation}
-			 = unreserve'
-			   {register = register,
-			    registerAllocation = registerAllocation}
-		     in
-		       {assembly = AppendList.append (assembly,
-						      assembly_unreserve),
-			registerAllocation = registerAllocation}
-		     end)
+            val {reserved, ...} = registerAllocation
+            val {assembly = assembly_unreserve,
+                 registerAllocation}
+              = List.fold
+                (reserved,
+                 {assembly = AppendList.empty,
+                  registerAllocation = registerAllocation},
+                 fn (register, 
+                     {assembly, registerAllocation})
+                  => let
+                       val {assembly = assembly_unreserve,
+                            registerAllocation}
+                         = unreserve'
+                           {register = register,
+                            registerAllocation = registerAllocation}
+                     in
+                       {assembly = AppendList.append (assembly,
+                                                      assembly_unreserve),
+                        registerAllocation = registerAllocation}
+                     end)
 
-	    val saved = savedRegisters {saves = saves,
-					registerAllocation = registerAllocation}
+            val saved = savedRegisters {saves = saves,
+                                        registerAllocation = registerAllocation}
 
-	    val saved = List.fold
-	                (reserved,
-			 saved,
-			 fn (register,saved)
-			  => if List.contains(saved,register,Register.eq)
-			       then saved
-			       else register::saved)
+            val saved = List.fold
+                        (reserved,
+                         saved,
+                         fn (register,saved)
+                          => if List.contains(saved,register,Register.eq)
+                               then saved
+                               else register::saved)
 
-	    val saves = valueFilter
-	                {filter = fn {register, ...}
-			           => List.contains(saved,
-						    register,
-						    Register.eq),
-			 registerAllocation = registerAllocation}
-			
-	    val all = valueFilter 
-	              {filter = fn _ => true,
-		       registerAllocation = registerAllocation}
+            val saves = valueFilter
+                        {filter = fn {register, ...}
+                                   => List.contains(saved,
+                                                    register,
+                                                    Register.eq),
+                         registerAllocation = registerAllocation}
+                        
+            val all = valueFilter 
+                      {filter = fn _ => true,
+                       registerAllocation = registerAllocation}
 
-	    (* partition the values in the register file 
-	     * by their base register.
-	     *)
-	    val groups = partition (all,
-				    fn ({register = Register.T {reg = reg1, ...},...},
-					{register = Register.T {reg = reg2, ...},...})
-				     => reg1 = reg2)
+            (* partition the values in the register file 
+             * by their base register.
+             *)
+            val groups = partition (all,
+                                    fn ({register = Register.T {reg = reg1, ...},...},
+                                        {register = Register.T {reg = reg2, ...},...})
+                                     => reg1 = reg2)
 
-	    (* order the groups by number of registers used
-	     *)
-	    val groups
-	      = List.insertionSort
-	        (groups, 
-		 fn (g1,g2) => (List.length g1) < (List.length g2))
+            (* order the groups by number of registers used
+             *)
+            val groups
+              = List.insertionSort
+                (groups, 
+                 fn (g1,g2) => (List.length g1) < (List.length g2))
 
-	    (* choose four registers to spill
-	     *)
-	    val spills
-	      = case groups
-		  of g1::g2::g3::g4::_ => List.concat [g1,g2,g3,g4]
-		   | _ => Error.bug "spillRegisters"
+            (* choose four registers to spill
+             *)
+            val spills
+              = case groups
+                  of g1::g2::g3::g4::_ => List.concat [g1,g2,g3,g4]
+                   | _ => Error.bug "x86AllocateRegisters.RegisterAllocation.spillRegisters"
 
-	    (* totally order the spills by utilization
-	     *)
-	    val spills
-	      = totalOrder
-	        (spills,
-		 fn ({memloc = memloc1, ...},
-		     {memloc = memloc2, ...})
-		  => List.contains(MemLoc.utilized memloc2,
-				   memloc1,
-				   MemLoc.eq))
+            (* totally order the spills by utilization
+             *)
+            val spills
+              = totalOrder
+                (spills,
+                 fn ({memloc = memloc1, ...},
+                     {memloc = memloc2, ...})
+                  => List.contains(MemLoc.utilized memloc2,
+                                   memloc1,
+                                   MemLoc.eq))
 
-	    fun mkReplacer (spillMap : (value * MemLoc.t) list)
-	      = fn memloc'
-	         => case List.peek(spillMap, fn ({memloc,...},_) 
-				              => MemLoc.eq(memloc,memloc'))
-		      of SOME (_,spillMemloc) => spillMemloc
-		       | NONE => memloc'
+            fun mkReplacer (spillMap : (value * MemLoc.t) list)
+              = fn memloc'
+                 => case List.peek(spillMap, fn ({memloc,...},_) 
+                                              => MemLoc.eq(memloc,memloc'))
+                      of SOME (_,spillMemloc) => spillMemloc
+                       | NONE => memloc'
 
-	    (* associate each spilled value with a spill slot
-	     *)
-	    val (spillMap, spillEnd)
-	      = List.fold
-	        (spills,
-		 ([], spillStart),
-		 fn (value as {memloc, ...},
-		     (spillMap, spillEnd))
-		  => let	
-		       val spillMemLoc
-			 = MemLoc.imm {base = Immediate.label spillLabel,
-				       index = Immediate.const_int spillEnd,
-				       scale = x86MLton.wordScale,
-				       size = MemLoc.size memloc,
-				       class = x86MLton.Classes.Temp}
-		     in
-		       ((value,spillMemLoc)::spillMap, 
-			spillEnd + 1)
-		     end)
+            (* associate each spilled value with a spill slot
+             *)
+            val (spillMap, spillEnd)
+              = List.fold
+                (spills,
+                 ([], spillStart),
+                 fn (value as {memloc, ...},
+                     (spillMap, spillEnd))
+                  => let        
+                       val spillMemLoc
+                         = MemLoc.imm {base = Immediate.label spillLabel,
+                                       index = Immediate.const_int spillEnd,
+                                       scale = x86MLton.wordScale,
+                                       size = MemLoc.size memloc,
+                                       class = x86MLton.Classes.Temp}
+                     in
+                       ((value,spillMemLoc)::spillMap, 
+                        spillEnd + 1)
+                     end)
 
-	    val replacer = mkReplacer spillMap
+            val replacer = mkReplacer spillMap
 
-	    (* commit everything in the register file;
-	     * also replace all memlocs that are spilled with their spill slot
-	     *)
-	    val registerAllocation
-	      = valueMap {map = fn {register, memloc, weight, sync, commit}
-			         => if List.exists
-			               (spillMap,
-					fn ({memloc = memloc',...},_)
-					 => MemLoc.eq(memloc,memloc'))
-				      then {register = register,
-					    memloc = MemLoc.replace replacer memloc,
-					    weight = weight,
-					    sync = false,
-					    commit = NO}
-				      else {register = register,
-					    memloc = MemLoc.replace replacer memloc,
-					    weight = weight,
-					    sync = sync,
-					    commit = case commit
-						       of NO => COMMIT 0
-							| COMMIT _ => COMMIT 0
-							| TRYCOMMIT _ => COMMIT 0
-							| REMOVE _ => REMOVE 0
-							| TRYREMOVE _ => REMOVE 0},
-			  registerAllocation = registerAllocation}
+            (* commit everything in the register file;
+             * also replace all memlocs that are spilled with their spill slot
+             *)
+            val registerAllocation
+              = valueMap {map = fn {register, memloc, weight, sync, commit}
+                                 => if List.exists
+                                       (spillMap,
+                                        fn ({memloc = memloc',...},_)
+                                         => MemLoc.eq(memloc,memloc'))
+                                      then {register = register,
+                                            memloc = MemLoc.replace replacer memloc,
+                                            weight = weight,
+                                            sync = false,
+                                            commit = NO}
+                                      else {register = register,
+                                            memloc = MemLoc.replace replacer memloc,
+                                            weight = weight,
+                                            sync = sync,
+                                            commit = case commit
+                                                       of NO => COMMIT 0
+                                                        | COMMIT _ => COMMIT 0
+                                                        | TRYCOMMIT _ => COMMIT 0
+                                                        | REMOVE _ => REMOVE 0
+                                                        | TRYREMOVE _ => REMOVE 0},
+                          registerAllocation = registerAllocation}
 
-	    (* update next available spill slot for cascading spills *)
-	    val _ = spill := spillEnd
-	    (* commit everything;
-	     * since the spilt memlocs look like they are spill slots,
-	     * they can all be committed to memory without any additional
-	     * registers.
-	     *)
-	    val {assembly = assembly_commit1,
-		 registerAllocation = registerAllocation}
-	      = commitRegisters
-	        {info = info,
-		 supports = [],
-		 saves = [],
-		 registerAllocation = registerAllocation}
-	        handle Spill => Error.bug "spillRegisters::reSpill:commitRegisters1"
+            (* update next available spill slot for cascading spills *)
+            val _ = spill := spillEnd
+            (* commit everything;
+             * since the spilt memlocs look like they are spill slots,
+             * they can all be committed to memory without any additional
+             * registers.
+             *)
+            val {assembly = assembly_commit1,
+                 registerAllocation = registerAllocation}
+              = commitRegisters
+                {info = info,
+                 supports = [],
+                 saves = [],
+                 registerAllocation = registerAllocation}
 
-	    (* unspill; as we pull values in, we update the memloc to what it 
-	     * looks under the pending unspills, and then replace any occurences 
-	     * of the spill slot with the updated memloc;
-	     * by the time we are done, everything should be mapped back to 
-	     * its original form.
-	     *)
-	    val {assembly = assembly_unspill,
-		 registerAllocation = registerAllocation}
-	      = let
-		  val rec doit
-		    = fn ([],{assembly,registerAllocation}) 
-		       => {assembly = assembly,
-			   registerAllocation = registerAllocation}
-		       | (({memloc, weight, sync, commit, ...},
-			   spillMemLoc)::spillMap,
-			  {assembly, registerAllocation})
-		       => let
-			    val replacer = mkReplacer spillMap
-			    val memloc' = MemLoc.replace replacer memloc
-			      
-			    val {register,
-				 assembly = assembly_unspill,
-				 registerAllocation}
-			      = toRegisterMemLoc
-			        {memloc = spillMemLoc,
-				 info = info,
-				 size = MemLoc.size memloc,
-				 move = true,
-				 supports = [],
-				 saves = [],
-				 force = [],
-				 registerAllocation = registerAllocation}
-			    val registerAllocation
-			      = update {value = {register = register,
-						 memloc = memloc',
-						 weight = weight,
-						 sync = sync,
-						 commit 
-						 = case commit
-						     of NO => COMMIT 0
-						      | COMMIT _ => COMMIT 0
-						      | TRYCOMMIT _ => COMMIT 0
-						      | REMOVE _ => REMOVE 0
-						      | TRYREMOVE _ => REMOVE 0},
-					registerAllocation = registerAllocation}
+            (* unspill; as we pull values in, we update the memloc to what it 
+             * looks under the pending unspills, and then replace any occurences 
+             * of the spill slot with the updated memloc;
+             * by the time we are done, everything should be mapped back to 
+             * its original form.
+             *)
+            val {assembly = assembly_unspill,
+                 registerAllocation = registerAllocation}
+              = let
+                  val rec doit
+                    = fn ([],{assembly,registerAllocation}) 
+                       => {assembly = assembly,
+                           registerAllocation = registerAllocation}
+                       | (({memloc, weight, sync, commit, ...},
+                           spillMemLoc)::spillMap,
+                          {assembly, registerAllocation})
+                       => let
+                            val replacer = mkReplacer spillMap
+                            val memloc' = MemLoc.replace replacer memloc
+                              
+                            val {register,
+                                 assembly = assembly_unspill,
+                                 registerAllocation}
+                              = toRegisterMemLoc
+                                {memloc = spillMemLoc,
+                                 info = info,
+                                 size = MemLoc.size memloc,
+                                 move = true,
+                                 supports = [],
+                                 saves = [],
+                                 force = [],
+                                 registerAllocation = registerAllocation}
+                            val registerAllocation
+                              = update {value = {register = register,
+                                                 memloc = memloc',
+                                                 weight = weight,
+                                                 sync = sync,
+                                                 commit 
+                                                 = case commit
+                                                     of NO => COMMIT 0
+                                                      | COMMIT _ => COMMIT 0
+                                                      | TRYCOMMIT _ => COMMIT 0
+                                                      | REMOVE _ => REMOVE 0
+                                                      | TRYREMOVE _ => REMOVE 0},
+                                        registerAllocation = registerAllocation}
 
-			    val registerAllocation
-			      = valueMap
-			        {map = fn {register,
-					   memloc,
-					   weight,
-					   sync,
-					   commit}
-				        => {register = register,
-					    memloc = MemLoc.replace
+                            val registerAllocation
+                              = valueMap
+                                {map = fn {register,
+                                           memloc,
+                                           weight,
+                                           sync,
+                                           commit}
+                                        => {register = register,
+                                            memloc = MemLoc.replace
                                                      (fn memloc'' => if MemLoc.eq
-						                        (memloc'',
-									 spillMemLoc)
-								       then memloc'
-								       else memloc'')
+                                                                        (memloc'',
+                                                                         spillMemLoc)
+                                                                       then memloc'
+                                                                       else memloc'')
                                                      memloc,
-					    weight = weight,
-					    sync = sync,
-					    commit = commit},
-				 registerAllocation = registerAllocation}
+                                            weight = weight,
+                                            sync = sync,
+                                            commit = commit},
+                                 registerAllocation = registerAllocation}
 
-			  in
-			    doit(spillMap,
-				 {assembly = AppendList.append (assembly,
-								assembly_unspill),
-				  registerAllocation = registerAllocation})
-			  end
-		in
-		  doit(spillMap,
-		       {assembly = AppendList.empty, 
-			registerAllocation = registerAllocation})
-		end
-	    (* everything is unspilled *)
-	    val _ = spill := spillStart
+                          in
+                            doit(spillMap,
+                                 {assembly = AppendList.append (assembly,
+                                                                assembly_unspill),
+                                  registerAllocation = registerAllocation})
+                          end
+                in
+                  doit(spillMap,
+                       {assembly = AppendList.empty, 
+                        registerAllocation = registerAllocation})
+                end
+            (* everything is unspilled *)
+            val _ = spill := spillStart
 
-	    (* commit all the memlocs that got spilled.
-	     *)
-	    val {assembly = assembly_commit2,
-		 registerAllocation = registerAllocation}
-	      = commitRegisters
-	        {info = info,
-		 supports = [],
-		 saves = [],
-		 registerAllocation = registerAllocation}
-	        handle Spill => Error.bug "spillRegisters::reSpill:commitRegisters2"
-	    val _ = spill := spillStart
+            (* commit all the memlocs that got spilled.
+             *)
+            val {assembly = assembly_commit2,
+                 registerAllocation = registerAllocation}
+              = commitRegisters
+                {info = info,
+                 supports = [],
+                 saves = [],
+                 registerAllocation = registerAllocation}
+            val _ = spill := spillStart
 
-	    (* restore the saved operands to their previous locations.
-	     *)
-	    val {assembly = assembly_restore,
-		 registerAllocation}
-	      = List.fold
-	        (saves,
-		 {assembly = AppendList.empty,
-		  registerAllocation = registerAllocation},
-		 fn ({register, memloc, weight, commit, ...},
-		     {assembly, registerAllocation})
-		  => let
-		       val {assembly = assembly_register,
-			    registerAllocation,
-			    ...}
-			 = toRegisterMemLoc
-			   {memloc = memloc,
-			    info = info,
-			    size = Register.size register,
-			    move = true,
-			    supports = supports,
-			    saves = [],
-			    force = [register],
-			    registerAllocation = registerAllocation}
-		       val registerAllocation
-			 = update {value = {register = register,
-					    memloc = memloc,
-					    weight = weight,
-					    sync = true,
-					    commit = commit},
-				   registerAllocation = registerAllocation}
-		       val {assembly = assembly_reserve,
-			    registerAllocation}
-			 = reserve' {register = register,
-				     registerAllocation = registerAllocation}
-		     in
-		       {assembly = AppendList.appends [assembly,
-						       assembly_register,
-						       assembly_reserve],
-			registerAllocation = registerAllocation}
-		     end)
-	        handle Spill => Error.bug "spillRegisters::reSpill:restore"
-	    val {assembly = assembly_unreserve',
-		 registerAllocation}
-	      = List.fold
-	        (saved,
-		 {assembly = AppendList.empty,
-		  registerAllocation = registerAllocation},
-		 fn (register, 
-		     {assembly, registerAllocation})
-		  => let
-		       val {assembly = assembly_unreserve',
-			    registerAllocation}
-			 = unreserve'
-			   {register = register,
-			    registerAllocation = registerAllocation}
-		     in
-		       {assembly = AppendList.append (assembly,
-						      assembly_unreserve'),
-			registerAllocation = registerAllocation}
-		     end)
-	    val {assembly = assembly_reserve,
-		 registerAllocation}
-	      = List.fold
-	        (reserved,
-		 {assembly = AppendList.empty,
-		  registerAllocation = registerAllocation},
-		 fn (register, 
-		     {assembly, registerAllocation})
-		  => let
-		       val {assembly = assembly_reserve,
-			    registerAllocation}
-			 = reserve'
-			   {register = register,
-			    registerAllocation = registerAllocation}
-		     in
-		       {assembly = AppendList.append (assembly,
-						      assembly_reserve),
-			registerAllocation = registerAllocation}
-		     end)
+            (* restore the saved operands to their previous locations.
+             *)
+            val {assembly = assembly_restore,
+                 registerAllocation}
+              = List.fold
+                (saves,
+                 {assembly = AppendList.empty,
+                  registerAllocation = registerAllocation},
+                 fn ({register, memloc, weight, commit, ...},
+                     {assembly, registerAllocation})
+                  => let
+                       val {assembly = assembly_register,
+                            registerAllocation,
+                            ...}
+                         = toRegisterMemLoc
+                           {memloc = memloc,
+                            info = info,
+                            size = Register.size register,
+                            move = true,
+                            supports = supports,
+                            saves = [],
+                            force = [register],
+                            registerAllocation = registerAllocation}
+                       val registerAllocation
+                         = update {value = {register = register,
+                                            memloc = memloc,
+                                            weight = weight,
+                                            sync = true,
+                                            commit = commit},
+                                   registerAllocation = registerAllocation}
+                       val {assembly = assembly_reserve,
+                            registerAllocation}
+                         = reserve' {register = register,
+                                     registerAllocation = registerAllocation}
+                     in
+                       {assembly = AppendList.appends [assembly,
+                                                       assembly_register,
+                                                       assembly_reserve],
+                        registerAllocation = registerAllocation}
+                     end)
+            val {assembly = assembly_unreserve',
+                 registerAllocation}
+              = List.fold
+                (saved,
+                 {assembly = AppendList.empty,
+                  registerAllocation = registerAllocation},
+                 fn (register, 
+                     {assembly, registerAllocation})
+                  => let
+                       val {assembly = assembly_unreserve',
+                            registerAllocation}
+                         = unreserve'
+                           {register = register,
+                            registerAllocation = registerAllocation}
+                     in
+                       {assembly = AppendList.append (assembly,
+                                                      assembly_unreserve'),
+                        registerAllocation = registerAllocation}
+                     end)
+            val {assembly = assembly_reserve,
+                 registerAllocation}
+              = List.fold
+                (reserved,
+                 {assembly = AppendList.empty,
+                  registerAllocation = registerAllocation},
+                 fn (register, 
+                     {assembly, registerAllocation})
+                  => let
+                       val {assembly = assembly_reserve,
+                            registerAllocation}
+                         = reserve'
+                           {register = register,
+                            registerAllocation = registerAllocation}
+                     in
+                       {assembly = AppendList.append (assembly,
+                                                      assembly_reserve),
+                        registerAllocation = registerAllocation}
+                     end)
 
-	    val _ = Int.dec depth
-	  in
-	    {assembly = AppendList.appends [assembly_unreserve,
-					    assembly_commit1,
-					    assembly_unspill,
-					    assembly_commit2,
-					    assembly_restore,
-					    assembly_unreserve',
-					    assembly_reserve],
-	     registerAllocation = registerAllocation}
-	  end
-	  handle Spill => Error.bug "spillRegisters::reSpill"
+            val _ = Int.dec depth
+          in
+            {assembly = AppendList.appends [assembly_unreserve,
+                                            assembly_commit1,
+                                            assembly_unspill,
+                                            assembly_commit2,
+                                            assembly_restore,
+                                            assembly_unreserve',
+                                            assembly_reserve],
+             registerAllocation = registerAllocation}
+          end
 
       and toRegisterMemLoc {memloc: MemLoc.t, 
-			    info: Liveness.t,
-			    size: Size.t, 
-			    move: bool,
-			    supports: Operand.t list,
-			    saves: Operand.t list, 
-			    force: Register.t list, 
-			    registerAllocation: t} :
-	                   {register: Register.t,
-			    assembly: Assembly.t AppendList.t,
-			    registerAllocation: t}
-	= (Int.inc depth;
-	   (case allocated {memloc = memloc,
-			    registerAllocation = registerAllocation}
-	      of SOME {register,memloc,weight,sync,commit}
-	       => let
-		    val registers
-		      = potentialRegisters {size = size,
-					    saves = saves,
-					    force = force,
-					    registerAllocation
-					    = registerAllocation}
-		  in
-		    if List.contains(registers, register, Register.eq)
-		      then {register = register,
-			    assembly = AppendList.empty,
-			    registerAllocation = registerAllocation}
-		      else let
-			     val {register = final_register,
-				  coincide_values}
-			       = chooseRegister 
-				 {info = info,
-				  memloc = SOME memloc,
-				  size = size,
-				  supports = supports,
-				  saves = (Operand.register register)::saves,
-				  force = force,
-				  registerAllocation = registerAllocation}
+                            info: Liveness.t,
+                            size: Size.t, 
+                            move: bool,
+                            supports: Operand.t list,
+                            saves: Operand.t list, 
+                            force: Register.t list, 
+                            registerAllocation: t} :
+                           {register: Register.t,
+                            assembly: Assembly.t AppendList.t,
+                            registerAllocation: t}
+        = (Int.inc depth;
+           (case allocated {memloc = memloc,
+                            registerAllocation = registerAllocation}
+              of SOME {register,memloc,weight,sync,commit}
+               => let
+                    val registers
+                      = potentialRegisters {size = size,
+                                            saves = saves,
+                                            force = force,
+                                            registerAllocation
+                                            = registerAllocation}
+                  in
+                    if List.contains(registers, register, Register.eq)
+                      then {register = register,
+                            assembly = AppendList.empty,
+                            registerAllocation = registerAllocation}
+                      else let
+                             val {register = final_register,
+                                  coincide_values}
+                               = chooseRegister 
+                                 {info = info,
+                                  memloc = SOME memloc,
+                                  size = size,
+                                  supports = supports,
+                                  saves = (Operand.register register)::saves,
+                                  force = force,
+                                  registerAllocation = registerAllocation}
 
-			     val {memloc,
-				  sync,
-				  registerAllocation}
-			       = if List.contains(saves, 
-						  Operand.register final_register,
-						  Operand.eq)
-			            orelse
+                             val {memloc,
+                                  sync,
+                                  registerAllocation}
+                               = if List.contains(saves, 
+                                                  Operand.register final_register,
+                                                  Operand.eq)
+                                    orelse
                                     List.contains(saves,
-						  Operand.memloc memloc,
-						  Operand.eq)
-				   then {memloc 
-					 = MemLoc.imm
-					   {base = Immediate.label
-					           (Label.fromString "BUG"),
-					    index = Immediate.const_int 0,
-					    scale = Scale.One,
-					    size = MemLoc.size memloc,
-					    class = MemLoc.Class.Temp},
-					 sync = true,
-					 registerAllocation
-					 = registerAllocation}
-				   else {memloc = memloc,
-					 sync = sync,
-					 registerAllocation
-					 = delete {register = register,
-						   registerAllocation
-						   = registerAllocation}}
-			   in
-			     case coincide_values
-			       of [] 
-				=> if move
-				     then let
-					    val registerAllocation
-					      = update {value 
-							= {register 
-							   = final_register,
-							   memloc = memloc,
-							   weight = weight,
-							   sync = sync,
-							   commit = commit},
-							registerAllocation
-							= registerAllocation}
-					  in
-					    {register = final_register,
-					     assembly
-					     = AppendList.single
-					       (Assembly.instruction_mov
-						{src = Operand.register register,
-						 dst = Operand.register 
-						       final_register,
-						 size = size}),
-					     registerAllocation 
-					     = registerAllocation}
-					  end
-				     else let
-					    val registerAllocation
-					      = update {value 
-							= {register 
-							   = final_register,
-							   memloc = memloc,
-							   weight = weight,
-							   sync = true,
-							   commit = commit},
-							registerAllocation
-							= registerAllocation}
-					  in
-					    {register = final_register,
-					     assembly = AppendList.empty,
-					     registerAllocation
-					     = registerAllocation}
-					  end
-				| [{register = register',
-				    memloc = memloc',
-				    weight = weight',
-				    sync = sync',
-				    commit = commit'}] 
-				=> if Register.eq(register',final_register)
-				     then let
-					    val registerAllocation
-					      = delete {register
-							= register',
-							registerAllocation
-							= registerAllocation}
-					    val registerAllocation
-					      = update {value
-							= {register 
-							   = register,
-							   memloc = memloc',
-							   weight = weight',
-							   sync = sync',
-							   commit = commit'},
-							registerAllocation
-							= registerAllocation}
-					  in
-					    if move
-					      then let
-						     val registerAllocation
-						       = update
-							 {value
-							  = {register 
-							     = final_register,
-							     memloc = memloc,
-							     weight = weight,
-							     sync = sync,
-							     commit = commit},
-							  registerAllocation
-							  = registerAllocation}
-						   in
-						     {register = final_register,
-						      assembly 
-						      = AppendList.single
-						        (Assembly.instruction_xchg
-							 {src = Operand.register 
-							        register,
-							  dst = Operand.register 
-							        final_register,
-							  size = size}),
-						      registerAllocation
-						      = registerAllocation}
-						   end
-					      else let
-						     val registerAllocation
-						       = update
-							 {value
-							  = {register 
-							     = final_register,
-							     memloc = memloc,
-							     weight = weight,
-							     sync = true,
-							     commit = commit},
-							  registerAllocation
-							  = registerAllocation}
-						   in
-						     {register = final_register,
-						      assembly 
-						      = AppendList.single
-						        (Assembly.instruction_mov
-							 {src = Operand.register 
-							        final_register,
-							  dst = Operand.register 
-							        register,
-							  size = size}),
-						      registerAllocation
-						      = registerAllocation}
-						   end
-					  end
-				     else let
-					    val {register = final_register,
-						 assembly = assembly_register,
-						 registerAllocation}
-					      = freeRegister
-						{info = info,
-						 memloc = SOME memloc,
-						 size = size,
-						 supports = supports,
-						 saves = (Operand.register
-							  register)::saves,
-						 force = force,
-						 registerAllocation
-						 = registerAllocation}
-					    val registerAllocation
-					      = remove 
-						{memloc = memloc,
-						 registerAllocation
-						 = registerAllocation}
-					  in
-					    if move
-					      then let
-						     val registerAllocation
-						       = update 
-						         {value
-							  = {register
-							     = final_register,
-							     memloc = memloc,
-							     weight = weight,
-							     sync = sync,
-							     commit = commit},
-							  registerAllocation
-							  = registerAllocation}
-						   in
-						     {register = final_register,
-						      assembly 
-						      = AppendList.appends
-							[assembly_register,
-							 AppendList.single
-							 (Assembly.instruction_mov
-							  {src = Operand.register 
-							         register,
-							   dst = Operand.register 
-							         final_register,
-							   size = size})],
-						      registerAllocation
-						      = registerAllocation}
-						   end
-					      else let
-						     val registerAllocation
-						       = update 
-						         {value
-							  = {register
-							     = final_register,
-							     memloc = memloc,
-							     weight = weight,
-							     sync = true,
-							     commit = commit},
-							  registerAllocation
-							  = registerAllocation}
-						   in
-						     {register = final_register,
-						      assembly 
-						      = assembly_register,
-						      registerAllocation
-						      = registerAllocation}
-						   end
-					  end
-				| _ 
-				=> let
-				     val {register = final_register,
-					  assembly = assembly_register,
-					  registerAllocation}
-				       = freeRegister {info = info,
-						       memloc = SOME memloc,
-						       size = size,
-						       supports = supports,
-						       saves = (Operand.register
-								register)::saves,
-						       force = force,
-						       registerAllocation
-						       = registerAllocation}
-				     val registerAllocation
-				       = remove {memloc = memloc,
-						 registerAllocation
-						 = registerAllocation}
-				   in
-				     if move
-				       then let
-					      val registerAllocation
-						= update {value
-							  = {register
-							     = final_register,
-							     memloc = memloc,
-							     weight = weight,
-							     sync = sync,
-							     commit = commit},
-							  registerAllocation
-							  = registerAllocation}
-					    in
-					      {register = final_register,
-					       assembly 
-					       = AppendList.appends
-						 [assembly_register,
-						  AppendList.single
-						  (Assembly.instruction_mov
-						   {src = Operand.register 
-						          register,
-						    dst = Operand.register 
-						          final_register,
-						    size = size})],
-					       registerAllocation
-					       = registerAllocation}
-					    end
-				       else let
-					      val registerAllocation
-						= update {value
-							  = {register
-							     = final_register,
-							     memloc = memloc,
-							     weight = weight,
-							     sync = true,
-							     commit = commit},
-							  registerAllocation
-							  = registerAllocation}
-					    in
-					      {register = final_register,
-					       assembly 
-					       = assembly_register,
-					       registerAllocation
-					       = registerAllocation}
-					    end
-				   end
-			   end
+                                                  Operand.memloc memloc,
+                                                  Operand.eq)
+                                   then {memloc 
+                                         = MemLoc.imm
+                                           {base = Immediate.label
+                                                   (Label.fromString "BUG"),
+                                            index = Immediate.const_int 0,
+                                            scale = Scale.One,
+                                            size = MemLoc.size memloc,
+                                            class = MemLoc.Class.Temp},
+                                         sync = true,
+                                         registerAllocation
+                                         = registerAllocation}
+                                   else {memloc = memloc,
+                                         sync = sync,
+                                         registerAllocation
+                                         = delete {register = register,
+                                                   registerAllocation
+                                                   = registerAllocation}}
+                           in
+                             case coincide_values
+                               of [] 
+                                => if move
+                                     then let
+                                            val registerAllocation
+                                              = update {value 
+                                                        = {register 
+                                                           = final_register,
+                                                           memloc = memloc,
+                                                           weight = weight,
+                                                           sync = sync,
+                                                           commit = commit},
+                                                        registerAllocation
+                                                        = registerAllocation}
+                                          in
+                                            {register = final_register,
+                                             assembly
+                                             = AppendList.single
+                                               (Assembly.instruction_mov
+                                                {src = Operand.register register,
+                                                 dst = Operand.register 
+                                                       final_register,
+                                                 size = size}),
+                                             registerAllocation 
+                                             = registerAllocation}
+                                          end
+                                     else let
+                                            val registerAllocation
+                                              = update {value 
+                                                        = {register 
+                                                           = final_register,
+                                                           memloc = memloc,
+                                                           weight = weight,
+                                                           sync = true,
+                                                           commit = commit},
+                                                        registerAllocation
+                                                        = registerAllocation}
+                                          in
+                                            {register = final_register,
+                                             assembly = AppendList.empty,
+                                             registerAllocation
+                                             = registerAllocation}
+                                          end
+                                | [{register = register',
+                                    memloc = memloc',
+                                    weight = weight',
+                                    sync = sync',
+                                    commit = commit'}] 
+                                => if Register.eq(register',final_register)
+                                     then let
+                                            val registerAllocation
+                                              = delete {register
+                                                        = register',
+                                                        registerAllocation
+                                                        = registerAllocation}
+                                            val registerAllocation
+                                              = update {value
+                                                        = {register 
+                                                           = register,
+                                                           memloc = memloc',
+                                                           weight = weight',
+                                                           sync = sync',
+                                                           commit = commit'},
+                                                        registerAllocation
+                                                        = registerAllocation}
+                                          in
+                                            if move
+                                              then let
+                                                     val registerAllocation
+                                                       = update
+                                                         {value
+                                                          = {register 
+                                                             = final_register,
+                                                             memloc = memloc,
+                                                             weight = weight,
+                                                             sync = sync,
+                                                             commit = commit},
+                                                          registerAllocation
+                                                          = registerAllocation}
+                                                   in
+                                                     {register = final_register,
+                                                      assembly 
+                                                      = AppendList.single
+                                                        (Assembly.instruction_xchg
+                                                         {src = Operand.register 
+                                                                register,
+                                                          dst = Operand.register 
+                                                                final_register,
+                                                          size = size}),
+                                                      registerAllocation
+                                                      = registerAllocation}
+                                                   end
+                                              else let
+                                                     val registerAllocation
+                                                       = update
+                                                         {value
+                                                          = {register 
+                                                             = final_register,
+                                                             memloc = memloc,
+                                                             weight = weight,
+                                                             sync = true,
+                                                             commit = commit},
+                                                          registerAllocation
+                                                          = registerAllocation}
+                                                   in
+                                                     {register = final_register,
+                                                      assembly 
+                                                      = AppendList.single
+                                                        (Assembly.instruction_mov
+                                                         {src = Operand.register 
+                                                                final_register,
+                                                          dst = Operand.register 
+                                                                register,
+                                                          size = size}),
+                                                      registerAllocation
+                                                      = registerAllocation}
+                                                   end
+                                          end
+                                     else let
+                                            val {register = final_register,
+                                                 assembly = assembly_register,
+                                                 registerAllocation}
+                                              = freeRegister
+                                                {info = info,
+                                                 memloc = SOME memloc,
+                                                 size = size,
+                                                 supports = supports,
+                                                 saves = (Operand.register
+                                                          register)::saves,
+                                                 force = force,
+                                                 registerAllocation
+                                                 = registerAllocation}
+                                            val registerAllocation
+                                              = remove 
+                                                {memloc = memloc,
+                                                 registerAllocation
+                                                 = registerAllocation}
+                                          in
+                                            if move
+                                              then let
+                                                     val registerAllocation
+                                                       = update 
+                                                         {value
+                                                          = {register
+                                                             = final_register,
+                                                             memloc = memloc,
+                                                             weight = weight,
+                                                             sync = sync,
+                                                             commit = commit},
+                                                          registerAllocation
+                                                          = registerAllocation}
+                                                   in
+                                                     {register = final_register,
+                                                      assembly 
+                                                      = AppendList.appends
+                                                        [assembly_register,
+                                                         AppendList.single
+                                                         (Assembly.instruction_mov
+                                                          {src = Operand.register 
+                                                                 register,
+                                                           dst = Operand.register 
+                                                                 final_register,
+                                                           size = size})],
+                                                      registerAllocation
+                                                      = registerAllocation}
+                                                   end
+                                              else let
+                                                     val registerAllocation
+                                                       = update 
+                                                         {value
+                                                          = {register
+                                                             = final_register,
+                                                             memloc = memloc,
+                                                             weight = weight,
+                                                             sync = true,
+                                                             commit = commit},
+                                                          registerAllocation
+                                                          = registerAllocation}
+                                                   in
+                                                     {register = final_register,
+                                                      assembly 
+                                                      = assembly_register,
+                                                      registerAllocation
+                                                      = registerAllocation}
+                                                   end
+                                          end
+                                | _ 
+                                => let
+                                     val {register = final_register,
+                                          assembly = assembly_register,
+                                          registerAllocation}
+                                       = freeRegister {info = info,
+                                                       memloc = SOME memloc,
+                                                       size = size,
+                                                       supports = supports,
+                                                       saves = (Operand.register
+                                                                register)::saves,
+                                                       force = force,
+                                                       registerAllocation
+                                                       = registerAllocation}
+                                     val registerAllocation
+                                       = remove {memloc = memloc,
+                                                 registerAllocation
+                                                 = registerAllocation}
+                                   in
+                                     if move
+                                       then let
+                                              val registerAllocation
+                                                = update {value
+                                                          = {register
+                                                             = final_register,
+                                                             memloc = memloc,
+                                                             weight = weight,
+                                                             sync = sync,
+                                                             commit = commit},
+                                                          registerAllocation
+                                                          = registerAllocation}
+                                            in
+                                              {register = final_register,
+                                               assembly 
+                                               = AppendList.appends
+                                                 [assembly_register,
+                                                  AppendList.single
+                                                  (Assembly.instruction_mov
+                                                   {src = Operand.register 
+                                                          register,
+                                                    dst = Operand.register 
+                                                          final_register,
+                                                    size = size})],
+                                               registerAllocation
+                                               = registerAllocation}
+                                            end
+                                       else let
+                                              val registerAllocation
+                                                = update {value
+                                                          = {register
+                                                             = final_register,
+                                                             memloc = memloc,
+                                                             weight = weight,
+                                                             sync = true,
+                                                             commit = commit},
+                                                          registerAllocation
+                                                          = registerAllocation}
+                                            in
+                                              {register = final_register,
+                                               assembly 
+                                               = assembly_register,
+                                               registerAllocation
+                                               = registerAllocation}
+                                            end
+                                   end
+                           end
 
-		  end
-	       | NONE 
-	       => if move
-		    then case MemLoc.size memloc
-			   of Size.BYTE
-			    => let
-				 val {register = register', 
-				      assembly = assembly_register,
-				      registerAllocation}
-				   = freeRegister 
-				     {info = info,
-				      memloc = SOME memloc,
-				      size = size,
-				      supports = (Operand.memloc memloc)::
-				                 supports,
-				      saves = saves,
-				      force = [],
-				      registerAllocation 
-				      = registerAllocation}
+                  end
+               | NONE 
+               => if move
+                    then case MemLoc.size memloc
+                           of Size.BYTE
+                            => let
+                                 val {register = register', 
+                                      assembly = assembly_register,
+                                      registerAllocation}
+                                   = freeRegister 
+                                     {info = info,
+                                      memloc = SOME memloc,
+                                      size = size,
+                                      supports = (Operand.memloc memloc)::
+                                                 supports,
+                                      saves = saves,
+                                      force = [],
+                                      registerAllocation 
+                                      = registerAllocation}
 
-				 val {address, 
-				      assembly = assembly_address,
-				      registerAllocation}
-				   = toAddressMemLoc 
-				     {memloc = memloc,
-				      info = info,
-				      size = size,
-				      supports = supports,
-				      saves = (Operand.register register')::
-				              saves,
-				      registerAllocation = registerAllocation}
+                                 val {address, 
+                                      assembly = assembly_address,
+                                      registerAllocation}
+                                   = toAddressMemLoc 
+                                     {memloc = memloc,
+                                      info = info,
+                                      size = size,
+                                      supports = supports,
+                                      saves = (Operand.register register')::
+                                              saves,
+                                      registerAllocation = registerAllocation}
 
 
-				 val registerAllocation
-				   = remove 
-				     {memloc = memloc,
-				      registerAllocation = registerAllocation}
-				   
-				 val registerAllocation
-				   = update 
-				     {value = {register = register',
-					       memloc = memloc,
-					       weight = 1024,
-					       sync = true,
-					       commit = NO},
-				      registerAllocation = registerAllocation}
-				   
-				 val {register,
-				      assembly = assembly_force,
-				      registerAllocation}
-				   = toRegisterMemLoc
-				     {memloc = memloc,
-				      info = info,
-				      size = size,
-				      move = move,
-				      supports = supports,
-				      saves = saves,
-				      force = force,
-				      registerAllocation = registerAllocation}
-				     
-			       in
-				 {register = register,
-				  assembly 
-				  = AppendList.appends
-				    [assembly_register,
-				     assembly_address,
-				     AppendList.single
-				     (Assembly.instruction_mov
-				      {dst = Operand.register register',
-				       src = Operand.address address,
-				       size = size}),
-				     assembly_force],
-				  registerAllocation = registerAllocation}
-			       end
-			    | _ 
+                                 val registerAllocation
+                                   = remove 
+                                     {memloc = memloc,
+                                      registerAllocation = registerAllocation}
+                                   
+                                 val registerAllocation
+                                   = update 
+                                     {value = {register = register',
+                                               memloc = memloc,
+                                               weight = 1024,
+                                               sync = true,
+                                               commit = NO},
+                                      registerAllocation = registerAllocation}
+                                   
+                                 val {register,
+                                      assembly = assembly_force,
+                                      registerAllocation}
+                                   = toRegisterMemLoc
+                                     {memloc = memloc,
+                                      info = info,
+                                      size = size,
+                                      move = move,
+                                      supports = supports,
+                                      saves = saves,
+                                      force = force,
+                                      registerAllocation = registerAllocation}
+                                     
+                               in
+                                 {register = register,
+                                  assembly 
+                                  = AppendList.appends
+                                    [assembly_register,
+                                     assembly_address,
+                                     AppendList.single
+                                     (Assembly.instruction_mov
+                                      {dst = Operand.register register',
+                                       src = Operand.address address,
+                                       size = size}),
+                                     assembly_force],
+                                  registerAllocation = registerAllocation}
+                               end
+                            | _ 
                             => let
-				 val {address, 
-				      assembly = assembly_address,
-				      registerAllocation}
-				   = toAddressMemLoc 
-				     {memloc = memloc,
-				      info = info,
-				      size = size,
-				      supports = supports,
-				      saves = saves,
-				      registerAllocation = registerAllocation}
+                                 val {address, 
+                                      assembly = assembly_address,
+                                      registerAllocation}
+                                   = toAddressMemLoc 
+                                     {memloc = memloc,
+                                      info = info,
+                                      size = size,
+                                      supports = supports,
+                                      saves = saves,
+                                      registerAllocation = registerAllocation}
 
-				 val saves'
-				   = case address
-				       of Address.T {base = SOME base',
-						     index = SOME index',
-						     ...}
-					=> (Operand.register base')::
-					   (Operand.register index')::saves
-					| Address.T {base = SOME base',
-						     ...}
-				        => (Operand.register base')::saves
-				        | Address.T {index = SOME index',
-						     ...}
-				        => (Operand.register index')::saves
-				        | _ => saves
+                                 val saves'
+                                   = case address
+                                       of Address.T {base = SOME base',
+                                                     index = SOME index',
+                                                     ...}
+                                        => (Operand.register base')::
+                                           (Operand.register index')::saves
+                                        | Address.T {base = SOME base',
+                                                     ...}
+                                        => (Operand.register base')::saves
+                                        | Address.T {index = SOME index',
+                                                     ...}
+                                        => (Operand.register index')::saves
+                                        | _ => saves
 
-				 val {register = register', 
-				      assembly = assembly_register,
-				      registerAllocation}
-				   = freeRegister 
-				     {info = info,
-				      memloc = SOME memloc,
-				      size = size,
-				      supports = supports,
-				      saves = saves',
-				      force = [],
-				      registerAllocation = registerAllocation}
+                                 val {register = register', 
+                                      assembly = assembly_register,
+                                      registerAllocation}
+                                   = freeRegister 
+                                     {info = info,
+                                      memloc = SOME memloc,
+                                      size = size,
+                                      supports = supports,
+                                      saves = saves',
+                                      force = [],
+                                      registerAllocation = registerAllocation}
 
-				 val registerAllocation
-				   = remove 
-				     {memloc = memloc,
-				      registerAllocation = registerAllocation}
+                                 val registerAllocation
+                                   = remove 
+                                     {memloc = memloc,
+                                      registerAllocation = registerAllocation}
 
-				 val registerAllocation
-				   = update 
-				     {value = {register = register',
-					       memloc = memloc,
-					       weight = 1024,
-					       sync = true,
-					       commit = NO},
-				      registerAllocation = registerAllocation}
+                                 val registerAllocation
+                                   = update 
+                                     {value = {register = register',
+                                               memloc = memloc,
+                                               weight = 1024,
+                                               sync = true,
+                                               commit = NO},
+                                      registerAllocation = registerAllocation}
 
-				 val {register,
-				      assembly = assembly_force,
-				      registerAllocation}
-				   = toRegisterMemLoc
-				     {memloc = memloc,
-				      info = info,
-				      size = size,
-				      move = move,
-				      supports = supports,
-				      saves = saves,
-				      force = force,
-				      registerAllocation = registerAllocation}
-				
-			       in
-				 {register = register,
-				  assembly 
-				  = AppendList.appends 
-				    [assembly_address,
-				     assembly_register,
-				     AppendList.single
-				     (Assembly.instruction_mov
-				      {dst = Operand.register register',
-				       src = Operand.address address,
-				       size = size}),
-				     assembly_force],
-				  registerAllocation = registerAllocation}
-			       end
-		    else let
-			   val {register, 
-				assembly = assembly_register,
-				registerAllocation}
-			     = freeRegister {info = info,
-					     memloc = SOME memloc,
-					     size = size,
-					     supports = supports,
-					     saves = saves,
-					     force = force,
-					     registerAllocation 
-					     = registerAllocation}
-			   val registerAllocation
-			     = remove {memloc = memloc,
-				       registerAllocation = registerAllocation}
+                                 val {register,
+                                      assembly = assembly_force,
+                                      registerAllocation}
+                                   = toRegisterMemLoc
+                                     {memloc = memloc,
+                                      info = info,
+                                      size = size,
+                                      move = move,
+                                      supports = supports,
+                                      saves = saves,
+                                      force = force,
+                                      registerAllocation = registerAllocation}
+                                
+                               in
+                                 {register = register,
+                                  assembly 
+                                  = AppendList.appends 
+                                    [assembly_address,
+                                     assembly_register,
+                                     AppendList.single
+                                     (Assembly.instruction_mov
+                                      {dst = Operand.register register',
+                                       src = Operand.address address,
+                                       size = size}),
+                                     assembly_force],
+                                  registerAllocation = registerAllocation}
+                               end
+                    else let
+                           val {register, 
+                                assembly = assembly_register,
+                                registerAllocation}
+                             = freeRegister {info = info,
+                                             memloc = SOME memloc,
+                                             size = size,
+                                             supports = supports,
+                                             saves = saves,
+                                             force = force,
+                                             registerAllocation 
+                                             = registerAllocation}
+                           val registerAllocation
+                             = remove {memloc = memloc,
+                                       registerAllocation = registerAllocation}
 
-			   val registerAllocation
-			     = update {value = {register = register,
-						memloc = memloc,
-						weight = 1024,
-						sync = true,
-						commit = NO},
-				       registerAllocation = registerAllocation}
-			 in
-			   {register = register,
-			    assembly = assembly_register,
-			    registerAllocation = registerAllocation}
-			 end) 
-	      before (Int.dec depth))
-	  handle Spill 
-	   => spillAndReissue 
-	      {info = info,
-	       supports = supports,
-	       saves = saves,
-	       registerAllocation = registerAllocation,
-	       spiller = spillRegisters,
-	       msg = "toRegisterMemLoc",
-	       reissue = fn {assembly = assembly_spill,
-			     registerAllocation}
-	                  => let
-			       val {register, assembly, registerAllocation}
-				 = toRegisterMemLoc
-				   {memloc = memloc,
-				    info = info,
-				    size = size,
-				    move = move,
-				    supports = supports,
-				    saves = saves,
-				    force = force,
-				    registerAllocation = registerAllocation}
-			     in
-			       {register = register,
-				assembly = AppendList.append (assembly_spill,
-							      assembly),
-				registerAllocation = registerAllocation}
-			     end}
+                           val registerAllocation
+                             = update {value = {register = register,
+                                                memloc = memloc,
+                                                weight = 1024,
+                                                sync = true,
+                                                commit = NO},
+                                       registerAllocation = registerAllocation}
+                         in
+                           {register = register,
+                            assembly = assembly_register,
+                            registerAllocation = registerAllocation}
+                         end) 
+              before (Int.dec depth))
+          handle Spill 
+           => spillAndReissue 
+              {info = info,
+               supports = supports,
+               saves = saves,
+               registerAllocation = registerAllocation,
+               spiller = spillRegisters,
+               msg = "toRegisterMemLoc",
+               reissue = fn {assembly = assembly_spill,
+                             registerAllocation}
+                          => let
+                               val {register, assembly, registerAllocation}
+                                 = toRegisterMemLoc
+                                   {memloc = memloc,
+                                    info = info,
+                                    size = size,
+                                    move = move,
+                                    supports = supports,
+                                    saves = saves,
+                                    force = force,
+                                    registerAllocation = registerAllocation}
+                             in
+                               {register = register,
+                                assembly = AppendList.append (assembly_spill,
+                                                              assembly),
+                                registerAllocation = registerAllocation}
+                             end}
 
       and toFltRegisterMemLoc {memloc: MemLoc.t,
-			       info: Liveness.t,
-			       size: Size.t,
-			       move: bool,
-			       supports: Operand.t list,
-			       saves: Operand.t list, 
-			       top: bool option,
-			       registerAllocation: t} :
-	                      {fltregister: FltRegister.t,
-			       assembly: Assembly.t AppendList.t,
-			       fltrename : FltRegister.t -> FltRegister.t,
-			       registerAllocation: t}
-	= (Int.inc depth;
-	   (case fltallocated {memloc = memloc,
-			       registerAllocation = registerAllocation}
-	      of SOME (value as {fltregister,memloc,weight,sync,commit})
-	       => (case (FltRegister.eq(fltregister, FltRegister.top),
-			 top)
-		     of (true, NONE)
-		      => let
-			   val {fltrename = fltrename_pop,
-				registerAllocation}
-			     = fltpop {registerAllocation
-				       = registerAllocation}
-			   val assembly_pop
-			     = AppendList.single
-			       (Assembly.instruction_fst
-				{dst = Operand.fltregister FltRegister.top,
-				 size = size,
-				 pop = true})
+                               info: Liveness.t,
+                               size: Size.t,
+                               move: bool,
+                               supports: Operand.t list,
+                               saves: Operand.t list, 
+                               top: bool option,
+                               registerAllocation: t} :
+                              {fltregister: FltRegister.t,
+                               assembly: Assembly.t AppendList.t,
+                               fltrename : FltRegister.t -> FltRegister.t,
+                               registerAllocation: t}
+        = (Int.inc depth;
+           (case fltallocated {memloc = memloc,
+                               registerAllocation = registerAllocation}
+              of SOME (value as {fltregister,memloc,weight,sync,commit})
+               => (case (FltRegister.eq(fltregister, FltRegister.top),
+                         top)
+                     of (true, NONE)
+                      => let
+                           val {fltrename = fltrename_pop,
+                                registerAllocation}
+                             = fltpop {registerAllocation
+                                       = registerAllocation}
+                           val assembly_pop
+                             = AppendList.single
+                               (Assembly.instruction_fst
+                                {dst = Operand.fltregister FltRegister.top,
+                                 size = size,
+                                 pop = true})
 
-			   val {registerAllocation,
-				...}
-			     = fltpush {value = {fltregister = FltRegister.top,
-						 memloc = memloc,
-						 weight = weight,
-						 sync = sync,
-						 commit = commit},
-					registerAllocation = registerAllocation}
-			 in
-			   {fltregister = FltRegister.top,
-			    assembly = assembly_pop,
-			    fltrename = fltrename_pop,
-			    registerAllocation = registerAllocation}
-			 end
-		      | (false, NONE)
-		      => let
-			   val {fltrename = fltrename_xch,
-				registerAllocation}
-			     = fltxch {value = value,
-				       registerAllocation 
-				       = registerAllocation}
-			   val assembly_xch
-			     = AppendList.single
-			       (Assembly.instruction_fxch
-				{src = Operand.fltregister fltregister})
+                           val {registerAllocation,
+                                ...}
+                             = fltpush {value = {fltregister = FltRegister.top,
+                                                 memloc = memloc,
+                                                 weight = weight,
+                                                 sync = sync,
+                                                 commit = commit},
+                                        registerAllocation = registerAllocation}
+                         in
+                           {fltregister = FltRegister.top,
+                            assembly = assembly_pop,
+                            fltrename = fltrename_pop,
+                            registerAllocation = registerAllocation}
+                         end
+                      | (false, NONE)
+                      => let
+                           val {fltrename = fltrename_xch,
+                                registerAllocation}
+                             = fltxch {value = value,
+                                       registerAllocation 
+                                       = registerAllocation}
+                           val assembly_xch
+                             = AppendList.single
+                               (Assembly.instruction_fxch
+                                {src = Operand.fltregister fltregister})
 
-			   val {fltrename = fltrename_pop,
-				registerAllocation}
-			     = fltpop {registerAllocation
-				       = registerAllocation}
-			   val assembly_pop
-			     = AppendList.single
-			       (Assembly.instruction_fst
-				{dst = Operand.fltregister FltRegister.top,
-				 size = size,
-				 pop = true})
+                           val {fltrename = fltrename_pop,
+                                registerAllocation}
+                             = fltpop {registerAllocation
+                                       = registerAllocation}
+                           val assembly_pop
+                             = AppendList.single
+                               (Assembly.instruction_fst
+                                {dst = Operand.fltregister FltRegister.top,
+                                 size = size,
+                                 pop = true})
 
-			   val {registerAllocation,
-				...}
-			     = fltpush {value = {fltregister = FltRegister.top,
-						 memloc = memloc,
-						 weight = weight,
-						 sync = sync,
-						 commit = commit},
-					registerAllocation = registerAllocation}
-			 in
-			   {fltregister = FltRegister.top,
-			    assembly = AppendList.append (assembly_xch, 
-							  assembly_pop),
-			    fltrename = fltrename_pop o fltrename_xch,
-			    registerAllocation = registerAllocation}
-			 end
-		      | (false, SOME true)
-		      => let
-			   val {fltrename = fltrename_xch,
-				registerAllocation}
-			     = fltxch {value = value,
-				       registerAllocation 
-				       = registerAllocation}
-			   val assembly_xch
-			     = AppendList.single
-			       (Assembly.instruction_fxch
-				{src = Operand.fltregister fltregister})
-			 in
-			   {fltregister = FltRegister.top,
-			    assembly = assembly_xch,
-			    fltrename = fltrename_xch,
-			    registerAllocation = registerAllocation}
-			 end
-		      | (_, SOME _)
-		      => {fltregister = fltregister,
-			  assembly = AppendList.empty,
-			  fltrename = FltRegister.id,
-			  registerAllocation = registerAllocation})
-	       | NONE
-	       => (case (top, move)
-		     of (NONE, _)
-		      => let
-			   val {assembly = assembly_free,
-				fltrename = fltrename_free,
-				registerAllocation
-				= registerAllocation}
-			     = freeFltRegister {info = info,
-						size = size,
-						supports = supports,
-						saves = saves,
-						registerAllocation
-						= registerAllocation}
+                           val {registerAllocation,
+                                ...}
+                             = fltpush {value = {fltregister = FltRegister.top,
+                                                 memloc = memloc,
+                                                 weight = weight,
+                                                 sync = sync,
+                                                 commit = commit},
+                                        registerAllocation = registerAllocation}
+                         in
+                           {fltregister = FltRegister.top,
+                            assembly = AppendList.append (assembly_xch, 
+                                                          assembly_pop),
+                            fltrename = fltrename_pop o fltrename_xch,
+                            registerAllocation = registerAllocation}
+                         end
+                      | (false, SOME true)
+                      => let
+                           val {fltrename = fltrename_xch,
+                                registerAllocation}
+                             = fltxch {value = value,
+                                       registerAllocation 
+                                       = registerAllocation}
+                           val assembly_xch
+                             = AppendList.single
+                               (Assembly.instruction_fxch
+                                {src = Operand.fltregister fltregister})
+                         in
+                           {fltregister = FltRegister.top,
+                            assembly = assembly_xch,
+                            fltrename = fltrename_xch,
+                            registerAllocation = registerAllocation}
+                         end
+                      | (_, SOME _)
+                      => {fltregister = fltregister,
+                          assembly = AppendList.empty,
+                          fltrename = FltRegister.id,
+                          registerAllocation = registerAllocation})
+               | NONE
+               => (case (top, move)
+                     of (NONE, _)
+                      => let
+                           val {assembly = assembly_free,
+                                fltrename = fltrename_free,
+                                registerAllocation
+                                = registerAllocation}
+                             = freeFltRegister {info = info,
+                                                size = size,
+                                                supports = supports,
+                                                saves = saves,
+                                                registerAllocation
+                                                = registerAllocation}
 
-			   val {registerAllocation, 
-				...}
-			     = fltpush {value = {fltregister = FltRegister.top,
-						 memloc = memloc,
-						 weight = 1024,
-						 sync = true,
-						 commit = NO},
-					registerAllocation = registerAllocation}
-			 in
-			   {fltregister = FltRegister.top,
-			    assembly = assembly_free,
-			    fltrename = fltrename_free,
-			    registerAllocation = registerAllocation}
-			 end
-		      | (SOME _, true)
-		      => let
-			   val {assembly = assembly_free,
-				fltrename = fltrename_free,
-				registerAllocation
-				= registerAllocation}
-			     = freeFltRegister {info = info,
-						size = size,
-						supports = supports,
-						saves = saves,
-						registerAllocation
-						= registerAllocation}
+                           val {registerAllocation, 
+                                ...}
+                             = fltpush {value = {fltregister = FltRegister.top,
+                                                 memloc = memloc,
+                                                 weight = 1024,
+                                                 sync = true,
+                                                 commit = NO},
+                                        registerAllocation = registerAllocation}
+                         in
+                           {fltregister = FltRegister.top,
+                            assembly = assembly_free,
+                            fltrename = fltrename_free,
+                            registerAllocation = registerAllocation}
+                         end
+                      | (SOME _, true)
+                      => let
+                           val {assembly = assembly_free,
+                                fltrename = fltrename_free,
+                                registerAllocation
+                                = registerAllocation}
+                             = freeFltRegister {info = info,
+                                                size = size,
+                                                supports = supports,
+                                                saves = saves,
+                                                registerAllocation
+                                                = registerAllocation}
 
-			   val {address,
-				assembly = assembly_address,
-				registerAllocation}
-			     = toAddressMemLoc {memloc = memloc,
-						info = info,
-						size = size,
-						supports = supports,
-						saves = saves,
-						registerAllocation 
-						= registerAllocation}
+                           val {address,
+                                assembly = assembly_address,
+                                registerAllocation}
+                             = toAddressMemLoc {memloc = memloc,
+                                                info = info,
+                                                size = size,
+                                                supports = supports,
+                                                saves = saves,
+                                                registerAllocation 
+                                                = registerAllocation}
 
-			   val {fltrename = fltrename_push,
-				registerAllocation}
-			     = fltpush {value = {fltregister = FltRegister.top,
-						 memloc = memloc,
-						 weight = 1024,
-						 sync = true,
-						 commit = NO},
-					registerAllocation = registerAllocation}
+                           val {fltrename = fltrename_push,
+                                registerAllocation}
+                             = fltpush {value = {fltregister = FltRegister.top,
+                                                 memloc = memloc,
+                                                 weight = 1024,
+                                                 sync = true,
+                                                 commit = NO},
+                                        registerAllocation = registerAllocation}
 
-			   val assembly_load
-			     = case Size.class size
-				 of Size.FLT
-				  => AppendList.single
-				     (Assembly.instruction_fld
-				      {src = Operand.address address,
-				       size = size})
-				  | Size.FPI
-				  => AppendList.single
-				     (Assembly.instruction_fild
-				      {src = Operand.address address,
-				       size = size})
-				  | _ 
-				  => Error.bug "toFltRegisterMemLoc, size"
-			 in
-			   {fltregister = FltRegister.top,
-			    assembly = AppendList.appends
-				       [assembly_free,
-					assembly_address,
-					assembly_load],
-			    fltrename = fltrename_push o fltrename_free,
-			    registerAllocation = registerAllocation}
-			 end
-		      | (SOME _, false)
-		      => Error.bug "toFltRegisterMemLoc: (top, move)")) 
-	      before (Int.dec depth))
-	  handle Spill 
-	   => spillAndReissue 
-	      {info = info,
-	       supports = supports,
-	       saves = saves,
-	       registerAllocation = registerAllocation,
-	       spiller = spillRegisters,
-	       msg = "toFltRegisterMemLoc",
-	       reissue = fn {assembly = assembly_spill,
-			     registerAllocation}
-	                  => let
-			       val {fltregister, assembly, 
-				    fltrename, registerAllocation}
-				 = toFltRegisterMemLoc
-				   {memloc = memloc,
-				    info = info,
-				    size = size,
-				    move = move,
-				    supports = supports,
-				    saves = saves,
-				    top = top,
-				    registerAllocation = registerAllocation}
-			     in
-			       {fltregister = fltregister,
-				assembly = AppendList.append (assembly_spill,
-							      assembly),
-				fltrename = fltrename,
-				registerAllocation = registerAllocation}
-			     end}
+                           val assembly_load
+                             = case Size.class size
+                                 of Size.FLT
+                                  => AppendList.single
+                                     (Assembly.instruction_fld
+                                      {src = Operand.address address,
+                                       size = size})
+                                  | Size.FPI
+                                  => AppendList.single
+                                     (Assembly.instruction_fild
+                                      {src = Operand.address address,
+                                       size = size})
+                                  | _ 
+                                  => Error.bug "x86AllocateRegisters.RegisterAllocation.toFltRegisterMemLoc: size"
+                         in
+                           {fltregister = FltRegister.top,
+                            assembly = AppendList.appends
+                                       [assembly_free,
+                                        assembly_address,
+                                        assembly_load],
+                            fltrename = fltrename_push o fltrename_free,
+                            registerAllocation = registerAllocation}
+                         end
+                      | (SOME _, false)
+                      => Error.bug "x86AllocateRegisters.RegisterAllocation.toFltRegisterMemLoc: (top, move)"))
+              before (Int.dec depth))
+          handle Spill 
+           => spillAndReissue 
+              {info = info,
+               supports = supports,
+               saves = saves,
+               registerAllocation = registerAllocation,
+               spiller = spillRegisters,
+               msg = "toFltRegisterMemLoc",
+               reissue = fn {assembly = assembly_spill,
+                             registerAllocation}
+                          => let
+                               val {fltregister, assembly, 
+                                    fltrename, registerAllocation}
+                                 = toFltRegisterMemLoc
+                                   {memloc = memloc,
+                                    info = info,
+                                    size = size,
+                                    move = move,
+                                    supports = supports,
+                                    saves = saves,
+                                    top = top,
+                                    registerAllocation = registerAllocation}
+                             in
+                               {fltregister = fltregister,
+                                assembly = AppendList.append (assembly_spill,
+                                                              assembly),
+                                fltrename = fltrename,
+                                registerAllocation = registerAllocation}
+                             end}
 
       and toAddressMemLoc {memloc: MemLoc.t, 
-			   info: Liveness.t,
-			   size: Size.t, 
-			   supports: Operand.t list,
-			   saves: Operand.t list, 
-			   registerAllocation: t} :
-	                  {address: Address.t,
-			   assembly: Assembly.t AppendList.t,
-			   registerAllocation: t}
+                           info: Liveness.t,
+                           size: Size.t, 
+                           supports: Operand.t list,
+                           saves: Operand.t list, 
+                           registerAllocation: t} :
+                          {address: Address.t,
+                           assembly: Assembly.t AppendList.t,
+                           registerAllocation: t}
         = (Int.inc depth;
-	   (let
-	      val MemLoc.U {immBase, memBase, immIndex, memIndex, scale, ...}
-		= MemLoc.destruct memloc
+           (let
+              val MemLoc.U {immBase, memBase, immIndex, memIndex, scale, ...}
+                = MemLoc.destruct memloc
 
-	      val disp 
-		= Immediate.binexp
-		  {oper = Immediate.Addition,
-		   exp1 = case immBase
-			    of NONE => Immediate.const_int 0
-			     | SOME immBase => immBase,
-		   exp2 = case immIndex
-			    of NONE => Immediate.const_int 0
-			     | SOME immIndex => immIndex}
+              val disp 
+                = Immediate.binexp
+                  {oper = Immediate.Addition,
+                   exp1 = case immBase
+                            of NONE => Immediate.const_int 0
+                             | SOME immBase => immBase,
+                   exp2 = case immIndex
+                            of NONE => Immediate.const_int 0
+                             | SOME immIndex => immIndex}
 
-	      val {register = register_base,
-		   assembly = assembly_base,
-		   registerAllocation}
-		= case memBase
-		    of NONE => {register = NONE,
-				assembly = AppendList.empty,
-				registerAllocation = registerAllocation}
-		     | SOME memBase
-		     => let
-			  val {register, assembly, registerAllocation}
-			    = toRegisterMemLoc 
-			      {memloc = memBase,
-			       info = info,
-			       size = MemLoc.size memBase,
-			       move = true,
-			       supports 
-			       = case memIndex
-				   of NONE => supports
-				    | SOME memIndex
-				    => (Operand.memloc memIndex)::
-				       supports,
-			       saves = saves,
-			       force = Register.baseRegisters,
-			       registerAllocation = registerAllocation}
-			in
-			  {register = SOME register,
-			   assembly = assembly,
-			   registerAllocation = registerAllocation}
-			end
+              val {register = register_base,
+                   assembly = assembly_base,
+                   registerAllocation}
+                = case memBase
+                    of NONE => {register = NONE,
+                                assembly = AppendList.empty,
+                                registerAllocation = registerAllocation}
+                     | SOME memBase
+                     => let
+                          val {register, assembly, registerAllocation}
+                            = toRegisterMemLoc 
+                              {memloc = memBase,
+                               info = info,
+                               size = MemLoc.size memBase,
+                               move = true,
+                               supports 
+                               = case memIndex
+                                   of NONE => supports
+                                    | SOME memIndex
+                                    => (Operand.memloc memIndex)::
+                                       supports,
+                               saves = saves,
+                               force = Register.baseRegisters,
+                               registerAllocation = registerAllocation}
+                        in
+                          {register = SOME register,
+                           assembly = assembly,
+                           registerAllocation = registerAllocation}
+                        end
 
-	      val {register = register_index,
-		   assembly = assembly_index,
-		   registerAllocation}
-		= case memIndex
-		    of NONE => {register = NONE,
-				assembly = AppendList.empty,
-				registerAllocation = registerAllocation}
-		     | SOME memIndex
-		     => let
-			  val {register, assembly, registerAllocation}
-			    = toRegisterMemLoc 
-			      {memloc = memIndex,
-			       info = info,
-			       size = MemLoc.size memIndex,
-			       move = true,
-			       supports = supports,
-			       saves 
-			       = case (memBase, register_base)
-				   of (NONE, NONE) => saves
-				    | (SOME memBase, SOME register_base)
-				    => (Operand.memloc memBase)::
-				       (Operand.register register_base)::
-				       saves
-				    | _ => Error.bug "toAddressMemLoc",
-			       force = Register.indexRegisters,
-			       registerAllocation = registerAllocation}
-			in
-			  {register = SOME register,
-			   assembly = assembly,
-			   registerAllocation = registerAllocation}
-			end
-	    in
-	      {address = Address.T {disp = SOME disp,
-				    base = register_base,
-				    index = register_index,
-				    scale = case memIndex
-					      of SOME _ => SOME scale
-					       | NONE => NONE},
-	       assembly = AppendList.append (assembly_base, 
-					     assembly_index),
-	       registerAllocation = registerAllocation}
-	    end)
+              val {register = register_index,
+                   assembly = assembly_index,
+                   registerAllocation}
+                = case memIndex
+                    of NONE => {register = NONE,
+                                assembly = AppendList.empty,
+                                registerAllocation = registerAllocation}
+                     | SOME memIndex
+                     => let
+                          val {register, assembly, registerAllocation}
+                            = toRegisterMemLoc 
+                              {memloc = memIndex,
+                               info = info,
+                               size = MemLoc.size memIndex,
+                               move = true,
+                               supports = supports,
+                               saves 
+                               = case (memBase, register_base)
+                                   of (NONE, NONE) => saves
+                                    | (SOME memBase, SOME register_base)
+                                    => (Operand.memloc memBase)::
+                                       (Operand.register register_base)::
+                                       saves
+                                    | _ => Error.bug "x86AllocateRegisters.RegisterAllocation.toAddressMemLoc",
+                               force = Register.indexRegisters,
+                               registerAllocation = registerAllocation}
+                        in
+                          {register = SOME register,
+                           assembly = assembly,
+                           registerAllocation = registerAllocation}
+                        end
+            in
+              {address = Address.T {disp = SOME disp,
+                                    base = register_base,
+                                    index = register_index,
+                                    scale = case memIndex
+                                              of SOME _ => SOME scale
+                                               | NONE => NONE},
+               assembly = AppendList.append (assembly_base, 
+                                             assembly_index),
+               registerAllocation = registerAllocation}
+            end)
 
 (*
-	   (case MemLoc.destruct memloc
-	      of MemLoc.U {base = MemLoc.Imm base, index = MemLoc.Imm index,
-			   scale, size, ...}
-	       => let
-		    val disp' 
-		      = if Immediate.eq(index, Immediate.const_int 0)
-			  then NONE
-			  else SOME (Immediate.binexp 
-				     {oper = Immediate.Multiplication, 
-				      exp1 = index, 
-				      exp2 = Scale.toImmediate scale})
-		    val disp
-		      = case disp'
-			  of NONE => SOME base
-			   | SOME disp' => SOME (Immediate.binexp 
-						 {oper = Immediate.Addition,
-						  exp1 = base, 
-						  exp2 = disp'})
-		  in
-		    {address = Address.T {disp = disp,
-					  base = NONE,
-					  index = NONE,
-					  scale = NONE},
-		     assembly = AppendList.empty,
-		     registerAllocation = registerAllocation}
-		  end
-	       | MemLoc.U {base = MemLoc.Imm base, index = MemLoc.Mem index,
-			   scale, size, ...}
-	       => let
-		    val disp = SOME base
+           (case MemLoc.destruct memloc
+              of MemLoc.U {base = MemLoc.Imm base, index = MemLoc.Imm index,
+                           scale, size, ...}
+               => let
+                    val disp' 
+                      = if Immediate.eq(index, Immediate.const_int 0)
+                          then NONE
+                          else SOME (Immediate.binexp 
+                                     {oper = Immediate.Multiplication, 
+                                      exp1 = index, 
+                                      exp2 = Scale.toImmediate scale})
+                    val disp
+                      = case disp'
+                          of NONE => SOME base
+                           | SOME disp' => SOME (Immediate.binexp 
+                                                 {oper = Immediate.Addition,
+                                                  exp1 = base, 
+                                                  exp2 = disp'})
+                  in
+                    {address = Address.T {disp = disp,
+                                          base = NONE,
+                                          index = NONE,
+                                          scale = NONE},
+                     assembly = AppendList.empty,
+                     registerAllocation = registerAllocation}
+                  end
+               | MemLoc.U {base = MemLoc.Imm base, index = MemLoc.Mem index,
+                           scale, size, ...}
+               => let
+                    val disp = SOME base
 
-		    val {register = register_index,
-			 assembly = assembly_index,
-			 registerAllocation}
-		      = toRegisterMemLoc {memloc = index,
-					  info = info,
-					  size = MemLoc.size index,
-					  move = true,
-					  supports = supports,
-					  saves = saves,
-					  force = Register.indexRegisters,
-					  registerAllocation 
-					  = registerAllocation}
-		  in
-		    {address = Address.T {disp = disp,
-					  base = NONE,
-					  index = SOME register_index,
-					  scale = SOME scale},
-		     assembly = assembly_index,
-		     registerAllocation = registerAllocation}
-		  end
-	       | MemLoc.U {base = MemLoc.Mem base, index = MemLoc.Imm index,
-			   scale, size, ...}
-	       => let
-		    val disp
-		      = if Immediate.eq(index, Immediate.const_int 0)
-			  then NONE
-			  else SOME (Immediate.binexp 
-				     {oper = Immediate.Multiplication,
-				      exp1 = index, 
-				      exp2 = Scale.toImmediate scale})
+                    val {register = register_index,
+                         assembly = assembly_index,
+                         registerAllocation}
+                      = toRegisterMemLoc {memloc = index,
+                                          info = info,
+                                          size = MemLoc.size index,
+                                          move = true,
+                                          supports = supports,
+                                          saves = saves,
+                                          force = Register.indexRegisters,
+                                          registerAllocation 
+                                          = registerAllocation}
+                  in
+                    {address = Address.T {disp = disp,
+                                          base = NONE,
+                                          index = SOME register_index,
+                                          scale = SOME scale},
+                     assembly = assembly_index,
+                     registerAllocation = registerAllocation}
+                  end
+               | MemLoc.U {base = MemLoc.Mem base, index = MemLoc.Imm index,
+                           scale, size, ...}
+               => let
+                    val disp
+                      = if Immediate.eq(index, Immediate.const_int 0)
+                          then NONE
+                          else SOME (Immediate.binexp 
+                                     {oper = Immediate.Multiplication,
+                                      exp1 = index, 
+                                      exp2 = Scale.toImmediate scale})
 
-		    val {register = register_base,
-			 assembly = assembly_base,
-			 registerAllocation}
-		      = toRegisterMemLoc {memloc = base,
-					  info = info,
-					  size = MemLoc.size base,
-					  move = true,
-					  supports = supports,
-					  saves = saves,
-					  force = Register.baseRegisters,
-					  registerAllocation 
-					  = registerAllocation}
-		  in
-		    {address = Address.T {disp = disp,
-					  base = SOME register_base,
-					  index = NONE,
-					  scale = NONE},
-		     assembly = assembly_base,
-		     registerAllocation = registerAllocation}
-		  end
-	       | MemLoc.U {base = MemLoc.Mem base, index = MemLoc.Mem index,
-			   scale, size, ...}
-	       => let
-		    val {register = register_base,
-			 assembly = assembly_base,
-			 registerAllocation}
-		      = toRegisterMemLoc {memloc = base,
-					  info = info,
-					  size = MemLoc.size base,
-					  move = true,
-					  supports 
-					  = (Operand.memloc index)::supports,
-					  saves = saves,
-					  force = Register.baseRegisters,
-					  registerAllocation 
-					  = registerAllocation}
+                    val {register = register_base,
+                         assembly = assembly_base,
+                         registerAllocation}
+                      = toRegisterMemLoc {memloc = base,
+                                          info = info,
+                                          size = MemLoc.size base,
+                                          move = true,
+                                          supports = supports,
+                                          saves = saves,
+                                          force = Register.baseRegisters,
+                                          registerAllocation 
+                                          = registerAllocation}
+                  in
+                    {address = Address.T {disp = disp,
+                                          base = SOME register_base,
+                                          index = NONE,
+                                          scale = NONE},
+                     assembly = assembly_base,
+                     registerAllocation = registerAllocation}
+                  end
+               | MemLoc.U {base = MemLoc.Mem base, index = MemLoc.Mem index,
+                           scale, size, ...}
+               => let
+                    val {register = register_base,
+                         assembly = assembly_base,
+                         registerAllocation}
+                      = toRegisterMemLoc {memloc = base,
+                                          info = info,
+                                          size = MemLoc.size base,
+                                          move = true,
+                                          supports 
+                                          = (Operand.memloc index)::supports,
+                                          saves = saves,
+                                          force = Register.baseRegisters,
+                                          registerAllocation 
+                                          = registerAllocation}
 
-		    val {register = register_index,
-			 assembly = assembly_index,
-			 registerAllocation}
-		      = toRegisterMemLoc {memloc = index,
-					  info = info,
-					  size = MemLoc.size index,
-					  move = true,
-					  supports = supports,
-					  saves = (Operand.memloc base)::
-						  (Operand.register 
-						   register_base)::
-						  saves,
-					  force = Register.indexRegisters,
-					  registerAllocation 
-					  = registerAllocation}
-		  in
-		    {address = Address.T {disp = NONE,
-					  base = SOME register_base,
-					  index = SOME register_index,
-					  scale = SOME scale},
-		     assembly = AppendList.append (assembly_base, 
-						   assembly_index),
-		     registerAllocation = registerAllocation}
-		  end)
+                    val {register = register_index,
+                         assembly = assembly_index,
+                         registerAllocation}
+                      = toRegisterMemLoc {memloc = index,
+                                          info = info,
+                                          size = MemLoc.size index,
+                                          move = true,
+                                          supports = supports,
+                                          saves = (Operand.memloc base)::
+                                                  (Operand.register 
+                                                   register_base)::
+                                                  saves,
+                                          force = Register.indexRegisters,
+                                          registerAllocation 
+                                          = registerAllocation}
+                  in
+                    {address = Address.T {disp = NONE,
+                                          base = SOME register_base,
+                                          index = SOME register_index,
+                                          scale = SOME scale},
+                     assembly = AppendList.append (assembly_base, 
+                                                   assembly_index),
+                     registerAllocation = registerAllocation}
+                  end)
 *)
-	      before (Int.dec depth))
-	  handle Spill 
-	   => spillAndReissue 
-	      {info = info,
-	       supports = supports,
-	       saves = saves,
-	       registerAllocation = registerAllocation,
-	       spiller = spillRegisters,
-	       msg = "toAddressMemLoc",
-	       reissue = fn {assembly = assembly_spill,
-			     registerAllocation}
-	                  => let
-			       val {address, assembly, registerAllocation}
-				 = toAddressMemLoc
-				   {memloc = memloc,
-				    info = info,
-				    size = size,
-				    supports = supports,
-				    saves = saves,
-				    registerAllocation = registerAllocation}
-			     in
-			       {address = address,
-				assembly = AppendList.append (assembly_spill,
-							      assembly),
-				registerAllocation = registerAllocation}
-			     end}
+              before (Int.dec depth))
+          handle Spill 
+           => spillAndReissue 
+              {info = info,
+               supports = supports,
+               saves = saves,
+               registerAllocation = registerAllocation,
+               spiller = spillRegisters,
+               msg = "toAddressMemLoc",
+               reissue = fn {assembly = assembly_spill,
+                             registerAllocation}
+                          => let
+                               val {address, assembly, registerAllocation}
+                                 = toAddressMemLoc
+                                   {memloc = memloc,
+                                    info = info,
+                                    size = size,
+                                    supports = supports,
+                                    saves = saves,
+                                    registerAllocation = registerAllocation}
+                             in
+                               {address = address,
+                                assembly = AppendList.append (assembly_spill,
+                                                              assembly),
+                                registerAllocation = registerAllocation}
+                             end}
 
       and toRegisterImmediate {immediate: Immediate.t,
-			       info: Liveness.t, 
-			       size: Size.t,
-			       supports: Operand.t list,
-			       saves: Operand.t list,
-			       force: Register.t list,
-			       registerAllocation: t} :
-	                      {register: Register.t,
-			       assembly: Assembly.t AppendList.t,
-			       registerAllocation: t}
-	= let
-	    val _ = Int.inc depth
-	    val {register = final_register, assembly, registerAllocation}
-	      = freeRegister {info = info,
-			      memloc = NONE,
-			      size = size,
-			      supports = supports,
-			      saves = saves,
-			      force = force,
-			      registerAllocation = registerAllocation}
-	    val _ = Int.dec depth
-	  in
-	    {register = final_register,
-	     assembly = AppendList.appends
-	                [assembly,
-			 AppendList.single
-			 (Assembly.instruction_mov
-			  {dst = Operand.Register final_register,
-			   src = Operand.Immediate immediate,
-			   size = size})],
-	     registerAllocation = registerAllocation}
-	  end
-	  handle Spill 
-	   => spillAndReissue 
-	      {info = info,
-	       supports = supports,
-	       saves = saves,
-	       registerAllocation = registerAllocation,
-	       spiller = spillRegisters,
-	       msg = "toRegisterImmediate",
-	       reissue = fn {assembly = assembly_spill,
-			     registerAllocation}
-	                  => let
-			       val {register, assembly, registerAllocation}
-				 = toRegisterImmediate
-				   {immediate = immediate,
-				    info = info,
-				    size = size,
-				    supports = supports,
-				    saves = saves,
-				    force = force,
-				    registerAllocation = registerAllocation}
-			     in
-			       {register = register,
-				assembly = AppendList.append (assembly_spill,
-							      assembly),
-				registerAllocation = registerAllocation}
-			     end}
+                               info: Liveness.t, 
+                               size: Size.t,
+                               supports: Operand.t list,
+                               saves: Operand.t list,
+                               force: Register.t list,
+                               registerAllocation: t} :
+                              {register: Register.t,
+                               assembly: Assembly.t AppendList.t,
+                               registerAllocation: t}
+        = let
+            val _ = Int.inc depth
+            val {register = final_register, assembly, registerAllocation}
+              = freeRegister {info = info,
+                              memloc = NONE,
+                              size = size,
+                              supports = supports,
+                              saves = saves,
+                              force = force,
+                              registerAllocation = registerAllocation}
+            val _ = Int.dec depth
+          in
+            {register = final_register,
+             assembly = AppendList.appends
+                        [assembly,
+                         AppendList.single
+                         (Assembly.instruction_mov
+                          {dst = Operand.Register final_register,
+                           src = Operand.Immediate immediate,
+                           size = size})],
+             registerAllocation = registerAllocation}
+          end
+          handle Spill 
+           => spillAndReissue 
+              {info = info,
+               supports = supports,
+               saves = saves,
+               registerAllocation = registerAllocation,
+               spiller = spillRegisters,
+               msg = "toRegisterImmediate",
+               reissue = fn {assembly = assembly_spill,
+                             registerAllocation}
+                          => let
+                               val {register, assembly, registerAllocation}
+                                 = toRegisterImmediate
+                                   {immediate = immediate,
+                                    info = info,
+                                    size = size,
+                                    supports = supports,
+                                    saves = saves,
+                                    force = force,
+                                    registerAllocation = registerAllocation}
+                             in
+                               {register = register,
+                                assembly = AppendList.append (assembly_spill,
+                                                              assembly),
+                                registerAllocation = registerAllocation}
+                             end}
 
       fun pre {uses: Operand.t list,
-	       defs: Operand.t list,
-	       kills: Operand.t list,
-	       info as {dead,
-			remove,
-			...}: Liveness.t,
-	       registerAllocation: t} :
-	      {assembly: Assembly.t AppendList.t,
-	       registerAllocation: t}
-	= let
-	    val ra = registerAllocation 
-	    val _ =
-	       if true
-		  then ()
-	       else
-		  Assert.assert
-		  ("pre: " ^ (toString ra),
-		   fn () => unique ra)
+               defs: Operand.t list,
+               kills: Operand.t list,
+               info as {dead,
+                        remove,
+                        ...}: Liveness.t,
+               registerAllocation: t} :
+              {assembly: Assembly.t AppendList.t,
+               registerAllocation: t}
+        = let
+            val ra = registerAllocation 
 
-	    val dead_memlocs = dead
-	    val remove_memlocs = remove
+            val dead_memlocs = dead
+            val remove_memlocs = remove
 
-	    val (allUses, allDefs, allKills)
-	      = let
-		  fun doit operands
-		    = List.fold
-		      (operands,
-		       MemLocSet.empty,
-		       fn (operand,set)
-		        => case Operand.deMemloc operand
-			     of SOME memloc
-			      => MemLocSet.add(set, memloc)
-			      | NONE => set)
+            val (allUses, allDefs, allKills)
+              = let
+                  fun doit operands
+                    = List.fold
+                      (operands,
+                       MemLocSet.empty,
+                       fn (operand,set)
+                        => case Operand.deMemloc operand
+                             of SOME memloc
+                              => MemLocSet.add(set, memloc)
+                              | NONE => set)
 
-		  val uses = doit uses
-		  val defs = doit defs
-		  val kills = doit kills
+                  val uses = doit uses
+                  val defs = doit defs
+                  val kills = doit kills
 
-		  fun doit' (memlocs, set)
-		    = MemLocSet.fold
-		      (memlocs,
-		       set,
-		       fn (memloc, set)
-		        => MemLocSet.union
-		           (set,
-			    MemLocSet.fromList (MemLoc.utilized memloc)))
-		  val allUses
-		    = doit'(uses,
-		      doit'(defs,
-			    uses))
-		  val allDefs = defs
-		  val allKills = kills
-		in
-		  (allUses, allDefs, allKills)
-		end
+                  fun doit' (memlocs, set)
+                    = MemLocSet.fold
+                      (memlocs,
+                       set,
+                       fn (memloc, set)
+                        => MemLocSet.union
+                           (set,
+                            MemLocSet.fromList (MemLoc.utilized memloc)))
+                  val allUses
+                    = doit'(uses,
+                      doit'(defs,
+                            uses))
+                  val allDefs = defs
+                  val allKills = kills
+                in
+                  (allUses, allDefs, allKills)
+                end
 
-	    val allDest = MemLocSet.unions 
-	                  [allDefs, allKills, dead_memlocs, remove_memlocs]
+            val allDest = MemLocSet.unions 
+                          [allDefs, allKills, dead_memlocs, remove_memlocs]
             val allKeep = MemLocSet.unions 
-	                  [allUses, allDefs, allKills]
+                          [allUses, allDefs, allKills]
 
-	    val registerAllocation
-	      = fltvalueMap
-	        {map = fn {fltregister,
-			   memloc,
-			   weight, 
-			   sync, 
-			   commit}
-		        => let
-		             val must_commit0
-			       = (MemLocSet.exists
-				  (allDefs,
-				   fn memloc'
-				    => not (MemLoc.eq(memloc', memloc))
-				       andalso (MemLoc.mayAlias(memloc', memloc))))
-			     val must_commit1
-			       = (MemLocSet.exists
-				  (allUses,
-				   fn memloc' 
-				    => not (MemLoc.eq(memloc', memloc))
-				       andalso (MemLoc.mayAlias(memloc', memloc))))
-			     val must_commit2
-			       = (List.exists
-				  (MemLoc.utilized memloc,
-				   fn memloc
-				    => MemLocSet.contains (allDest, memloc)))
-			     val must_commit3
-			       = (MemLocSet.contains
-				  (MemLocSet.-(allKills, dead_memlocs), memloc))
-			     val sync
-			       = if volatile memloc
-				   then true
-				   else sync
-			     val commit
-			       = if volatile memloc
-				   then REMOVE 0
-				 else if must_commit3
-				   then COMMIT 0
-				 else if must_commit2
-				   then if MemLocSet.contains
-				           (allKeep, memloc)
-					  then COMMIT 0
-					  else REMOVE 0
-				 else if must_commit1 orelse must_commit0
-				   then case commit
-					  of TRYREMOVE _ => REMOVE 0
-					   | REMOVE _ => REMOVE 0
-					   | _ => COMMIT 0
-				 else commit
-			   in
-			     {fltregister = fltregister,
-			      memloc = memloc,
-			      weight = weight,
-			      sync = sync,
-			      commit = commit}
-			   end,
-		 registerAllocation = registerAllocation}
+            val registerAllocation
+              = fltvalueMap
+                {map = fn {fltregister,
+                           memloc,
+                           weight, 
+                           sync, 
+                           commit}
+                        => let
+                             val must_commit0
+                               = (MemLocSet.exists
+                                  (allDefs,
+                                   fn memloc'
+                                    => not (MemLoc.eq(memloc', memloc))
+                                       andalso (MemLoc.mayAlias(memloc', memloc))))
+                             val must_commit1
+                               = (MemLocSet.exists
+                                  (allUses,
+                                   fn memloc' 
+                                    => not (MemLoc.eq(memloc', memloc))
+                                       andalso (MemLoc.mayAlias(memloc', memloc))))
+                             val must_commit2
+                               = (List.exists
+                                  (MemLoc.utilized memloc,
+                                   fn memloc
+                                    => MemLocSet.contains (allDest, memloc)))
+                             val must_commit3
+                               = (MemLocSet.contains
+                                  (MemLocSet.-(allKills, dead_memlocs), memloc))
+                             val sync
+                               = if volatile memloc
+                                   then true
+                                   else sync
+                             val commit
+                               = if volatile memloc
+                                   then REMOVE 0
+                                 else if must_commit3
+                                   then COMMIT 0
+                                 else if must_commit2
+                                   then if MemLocSet.contains
+                                           (allKeep, memloc)
+                                          then COMMIT 0
+                                          else REMOVE 0
+                                 else if must_commit1 orelse must_commit0
+                                   then case commit
+                                          of TRYREMOVE _ => REMOVE 0
+                                           | REMOVE _ => REMOVE 0
+                                           | _ => COMMIT 0
+                                 else commit
+                           in
+                             {fltregister = fltregister,
+                              memloc = memloc,
+                              weight = weight,
+                              sync = sync,
+                              commit = commit}
+                           end,
+                 registerAllocation = registerAllocation}
 
-	    val {assembly = assembly_commit_fltregisters,
-		 registerAllocation,
-		 ...}
-	      = commitFltRegisters {info = info,
-				    supports = [],
-				    saves = [],
-				    registerAllocation = registerAllocation}
+            val {assembly = assembly_commit_fltregisters,
+                 registerAllocation,
+                 ...}
+              = commitFltRegisters {info = info,
+                                    supports = [],
+                                    saves = [],
+                                    registerAllocation = registerAllocation}
 
-	    val registerAllocation
-	      = valueMap
-	        {map = fn {register,
-			   memloc,
-			   weight, 
-			   sync, 
-			   commit}
-		        => let
-		             val must_commit0
-			       = (MemLocSet.exists
-				  (allDefs,
-				   fn memloc'
-				    => not (MemLoc.eq(memloc', memloc))
-				       andalso (MemLoc.mayAlias(memloc', memloc))))
-			     val must_commit1
-			       = (MemLocSet.exists
-				  (allUses,
-				   fn memloc' 
-				    => not (MemLoc.eq(memloc', memloc))
-				       andalso (MemLoc.mayAlias(memloc', memloc))))
-			     val must_commit2
-			       = (List.exists
-				  (MemLoc.utilized memloc,
-				   fn memloc
-				    => MemLocSet.contains (allDest, memloc)))
-			     val must_commit3
-			       = (MemLocSet.contains
-				  (MemLocSet.-(allKills, dead_memlocs), memloc))
-			     val sync
-			       = if volatile memloc
-				   then true
-				   else sync
-			     val commit
-			       = if volatile memloc
-			           then REMOVE 0
-				 else if MemLocSet.contains(allDefs, memloc)
-				   then if must_commit1 orelse must_commit0
-					  then case commit
-						 of TRYREMOVE _ => REMOVE 0
-						  | REMOVE _ => REMOVE 0
-						  | _ => COMMIT 0
-					  else commit
-				 else if must_commit3
-				   then COMMIT 0
-				 else if must_commit2
-				   then if MemLocSet.contains
-				           (allKeep, memloc)
-					  then COMMIT 0
-					  else REMOVE 0
-				 else if must_commit1 orelse must_commit0
-				   then case commit 
-					  of TRYREMOVE _ => REMOVE 0
-					   | REMOVE _ => REMOVE 0
-					   | _ => COMMIT 0
-				 else commit
-			   in
-			     {register = register,
-			      memloc = memloc,
-			      weight = weight,
-			      sync = sync,
-			      commit = commit}
-			   end,
-		 registerAllocation = registerAllocation}
+            val registerAllocation
+              = valueMap
+                {map = fn {register,
+                           memloc,
+                           weight, 
+                           sync, 
+                           commit}
+                        => let
+                             val must_commit0
+                               = (MemLocSet.exists
+                                  (allDefs,
+                                   fn memloc'
+                                    => not (MemLoc.eq(memloc', memloc))
+                                       andalso (MemLoc.mayAlias(memloc', memloc))))
+                             val must_commit1
+                               = (MemLocSet.exists
+                                  (allUses,
+                                   fn memloc' 
+                                    => not (MemLoc.eq(memloc', memloc))
+                                       andalso (MemLoc.mayAlias(memloc', memloc))))
+                             val must_commit2
+                               = (List.exists
+                                  (MemLoc.utilized memloc,
+                                   fn memloc
+                                    => MemLocSet.contains (allDest, memloc)))
+                             val must_commit3
+                               = (MemLocSet.contains
+                                  (MemLocSet.-(allKills, dead_memlocs), memloc))
+                             val sync
+                               = if volatile memloc
+                                   then true
+                                   else sync
+                             val commit
+                               = if volatile memloc
+                                   then REMOVE 0
+                                 else if MemLocSet.contains(allDefs, memloc)
+                                   then if must_commit1 orelse must_commit0
+                                          then case commit
+                                                 of TRYREMOVE _ => REMOVE 0
+                                                  | REMOVE _ => REMOVE 0
+                                                  | _ => COMMIT 0
+                                          else commit
+                                 else if must_commit3
+                                   then COMMIT 0
+                                 else if must_commit2
+                                   then if MemLocSet.contains
+                                           (allKeep, memloc)
+                                          then COMMIT 0
+                                          else REMOVE 0
+                                 else if must_commit1 orelse must_commit0
+                                   then case commit 
+                                          of TRYREMOVE _ => REMOVE 0
+                                           | REMOVE _ => REMOVE 0
+                                           | _ => COMMIT 0
+                                 else commit
+                           in
+                             {register = register,
+                              memloc = memloc,
+                              weight = weight,
+                              sync = sync,
+                              commit = commit}
+                           end,
+                 registerAllocation = registerAllocation}
 
-	    val {assembly = assembly_commit_registers,
-		 registerAllocation}
-	      = commitRegisters {info = info,
-				 supports = [],
-				 saves = [],
-				 registerAllocation = registerAllocation}
-	  in
-	    {assembly = AppendList.appends
-	                [if !Control.Native.commented > 3
-			   then AppendList.cons
-			        ((Assembly.comment "pre begin:"),
-				 (toComments ra))
-			   else AppendList.empty,
-			 assembly_commit_fltregisters,
-			 assembly_commit_registers,
-			 if !Control.Native.commented > 3
-			   then AppendList.cons
-			        ((Assembly.comment "pre end:"),
-				 (toComments registerAllocation))
-			   else AppendList.empty],
-	     registerAllocation = registerAllocation}
-	  end
+            val {assembly = assembly_commit_registers,
+                 registerAllocation}
+              = commitRegisters {info = info,
+                                 supports = [],
+                                 saves = [],
+                                 registerAllocation = registerAllocation}
+          in
+            {assembly = AppendList.appends
+                        [if !Control.Native.commented > 3
+                           then AppendList.cons
+                                ((Assembly.comment "pre begin:"),
+                                 (toComments ra))
+                           else AppendList.empty,
+                         assembly_commit_fltregisters,
+                         assembly_commit_registers,
+                         if !Control.Native.commented > 3
+                           then AppendList.cons
+                                ((Assembly.comment "pre end:"),
+                                 (toComments registerAllocation))
+                           else AppendList.empty],
+             registerAllocation = registerAllocation}
+          end
 
       val (pre, pre_msg)
-	= tracer
-	  "pre"
-	  pre
+        = tracer
+          "pre"
+          pre
 
       fun post {uses: Operand.t list,
-		final_uses: Operand.t list,
-		defs: Operand.t list,
-		final_defs: Operand.t list,
-		kills: Operand.t list,
-		info as {dead,
-			 commit,
-			 remove,
-			 ...}: Liveness.t,
-		registerAllocation: t} :
-	       {assembly: Assembly.t AppendList.t,
-		registerAllocation: t}
-	= let 
-	    val ra = registerAllocation
-	    val _ =
-	       if true
-		  then ()
-	       else
-		  Assert.assert
-		  ("post: " ^ (toString ra),
-		   fn () => unique ra)
+                final_uses: Operand.t list,
+                defs: Operand.t list,
+                final_defs: Operand.t list,
+                kills: Operand.t list,
+                info as {dead,
+                         commit,
+                         remove,
+                         ...}: Liveness.t,
+                registerAllocation: t} :
+               {assembly: Assembly.t AppendList.t,
+                registerAllocation: t}
+        = let 
+            val ra = registerAllocation
 
-	    val (final_uses_registers,
-		 final_defs_registers,
-		 final_uses_fltregisters,
-		 final_defs_fltregisters)
-	      = let
-		  fun doit(operands, (final_registers, final_fltregisters))
-		    = List.fold
-		      (operands,
-		       (final_registers, final_fltregisters),
-		       fn (operand, (final_registers, final_fltregisters))
-		        => case (Operand.deRegister operand,
-				 Operand.deFltregister operand)
-			     of (SOME register, _) 
-			      => if List.contains(final_registers,
-						  register,
-						  Register.eq)
-				   then (final_registers,
-					 final_fltregisters)
-				   else (register::final_registers,
-					 final_fltregisters)
-			      | (_, SOME fltregister)
-			      => if List.contains(final_fltregisters,
-						  fltregister,
-						  FltRegister.eq)
-				   then (final_registers,
-					 final_fltregisters)
-				   else (final_registers,
-					 fltregister::final_fltregisters)
-			      | _ => (final_registers, final_fltregisters))
-		  val (final_uses_registers, final_uses_fltregisters)
-		    = doit(final_uses, ([], []))
-		  val (final_defs_registers, final_defs_fltregisters)
-		    = doit(final_defs, ([], []))
-		in
-		  (final_uses_registers,
-		   final_defs_registers,
-		   final_uses_fltregisters,
-		   final_defs_fltregisters)
-		end
+            val (final_uses_registers,
+                 final_defs_registers,
+                 final_uses_fltregisters,
+                 final_defs_fltregisters)
+              = let
+                  fun doit(operands, (final_registers, final_fltregisters))
+                    = List.fold
+                      (operands,
+                       (final_registers, final_fltregisters),
+                       fn (operand, (final_registers, final_fltregisters))
+                        => case (Operand.deRegister operand,
+                                 Operand.deFltregister operand)
+                             of (SOME register, _) 
+                              => if List.contains(final_registers,
+                                                  register,
+                                                  Register.eq)
+                                   then (final_registers,
+                                         final_fltregisters)
+                                   else (register::final_registers,
+                                         final_fltregisters)
+                              | (_, SOME fltregister)
+                              => if List.contains(final_fltregisters,
+                                                  fltregister,
+                                                  FltRegister.eq)
+                                   then (final_registers,
+                                         final_fltregisters)
+                                   else (final_registers,
+                                         fltregister::final_fltregisters)
+                              | _ => (final_registers, final_fltregisters))
+                  val (final_uses_registers, final_uses_fltregisters)
+                    = doit(final_uses, ([], []))
+                  val (final_defs_registers, final_defs_fltregisters)
+                    = doit(final_defs, ([], []))
+                in
+                  (final_uses_registers,
+                   final_defs_registers,
+                   final_uses_fltregisters,
+                   final_defs_fltregisters)
+                end
 
-	    val dead_memlocs = dead
-	    val commit_memlocs = commit
-	    val remove_memlocs = remove
+            val dead_memlocs = dead
+            val commit_memlocs = commit
+            val remove_memlocs = remove
 
-	    val (_, allDefs, allKills)
-	      = let
-		  fun doit operands
-		    = List.fold
-		      (operands,
-		       MemLocSet.empty,
-		       fn (operand,set)
-		        => case Operand.deMemloc operand
-			     of SOME memloc
-			      => MemLocSet.add(set, memloc)
-			      | NONE => set)
+            val (_, allDefs, allKills)
+              = let
+                  fun doit operands
+                    = List.fold
+                      (operands,
+                       MemLocSet.empty,
+                       fn (operand,set)
+                        => case Operand.deMemloc operand
+                             of SOME memloc
+                              => MemLocSet.add(set, memloc)
+                              | NONE => set)
 
-		  val uses = doit uses
-		  val defs = doit defs
-		  val kills = doit kills
+                  val uses = doit uses
+                  val defs = doit defs
+                  val kills = doit kills
 
-		  fun doit' (memlocs, set)
-		    = MemLocSet.fold
-		      (memlocs,
-		       set,
-		       fn (memloc, set)
-		        => MemLocSet.union
-		           (set,
-			    MemLocSet.fromList (MemLoc.utilized memloc)))
-		  val allUses
-		    = doit'(uses,
-		      doit'(defs,
-			    uses))
-		  val allDefs = defs
-		  val allKills = kills
-		in
-		  (allUses, allDefs, allKills)
-		end
+                  fun doit' (memlocs, set)
+                    = MemLocSet.fold
+                      (memlocs,
+                       set,
+                       fn (memloc, set)
+                        => MemLocSet.union
+                           (set,
+                            MemLocSet.fromList (MemLoc.utilized memloc)))
+                  val allUses
+                    = doit'(uses,
+                      doit'(defs,
+                            uses))
+                  val allDefs = defs
+                  val allKills = kills
+                in
+                  (allUses, allDefs, allKills)
+                end
 
-	    val allDest = MemLocSet.unions 
-	                  [allDefs, allKills, dead_memlocs, remove_memlocs]
+            val allDest = MemLocSet.unions 
+                          [allDefs, allKills, dead_memlocs, remove_memlocs]
 
-	    val registerAllocation
-	      = fltvalueMap 
-	        {map = fn {fltregister,
-			   memloc,
-			   weight,
-			   sync,
-			   commit}
-		        => if volatile memloc
-		             then let
-				    val isDst
-				      = List.contains
-				        (final_defs_fltregisters,
-					 fltregister,
-				       FltRegister.eq)
-				    val isDef = isDst
-				  in
-				    {fltregister = fltregister,
-				     memloc = memloc,
-				     sync = sync andalso (not isDef),
-				     weight = weight - 500,
-				     commit = REMOVE 0}
-				  end
-			   else if MemLocSet.contains
-		                  (dead_memlocs, memloc)
-			     then {fltregister = fltregister,
-				   memloc = memloc,
-				   sync = true,
-				   weight = weight - 500,
-				   commit = TRYREMOVE 0}
-			   else let
-				  val isSrc
-				    = List.contains
-				      (final_uses_fltregisters,
-				       fltregister,
-				       FltRegister.eq)
-				      
-				  val isDst
-				    = List.contains
-				      (final_defs_fltregisters,
-				       fltregister,
-				       FltRegister.eq)
-				      
-				  val isDef = isDst
-				in
-				  {fltregister = fltregister,
-				   memloc = memloc,
-				   weight = weight - 5
-				            + (if isSrc
-						 then 5
-						 else 0)
-				            + (if isDst
-						 then 10
-						 else 0),
-				   sync = sync andalso (not isDef),
-				   commit = if !Control.Native.IEEEFP
-				               andalso
-					       not (sync andalso (not isDef))
-					      then REMOVE 0
-					      else if List.exists
-						      (MemLoc.utilized memloc,
-						       fn memloc'
-						       => MemLocSet.contains
-						          (allDest, memloc'))
-						     then REMOVE 0
-						   else if MemLocSet.contains
-						           (remove_memlocs,
-						            memloc)
-						     then TRYREMOVE 0
-						   else if MemLocSet.contains
-						           (commit_memlocs,
-							    memloc)
-						     then TRYCOMMIT 0
-						   else commit}
-				end,
-		  registerAllocation = registerAllocation}
+            val registerAllocation
+              = fltvalueMap 
+                {map = fn {fltregister,
+                           memloc,
+                           weight,
+                           sync,
+                           commit}
+                        => if volatile memloc
+                             then let
+                                    val isDst
+                                      = List.contains
+                                        (final_defs_fltregisters,
+                                         fltregister,
+                                       FltRegister.eq)
+                                    val isDef = isDst
+                                  in
+                                    {fltregister = fltregister,
+                                     memloc = memloc,
+                                     sync = sync andalso (not isDef),
+                                     weight = weight - 500,
+                                     commit = REMOVE 0}
+                                  end
+                           else if MemLocSet.contains
+                                  (dead_memlocs, memloc)
+                             then {fltregister = fltregister,
+                                   memloc = memloc,
+                                   sync = true,
+                                   weight = weight - 500,
+                                   commit = TRYREMOVE 0}
+                           else let
+                                  val isSrc
+                                    = List.contains
+                                      (final_uses_fltregisters,
+                                       fltregister,
+                                       FltRegister.eq)
+                                      
+                                  val isDst
+                                    = List.contains
+                                      (final_defs_fltregisters,
+                                       fltregister,
+                                       FltRegister.eq)
+                                      
+                                  val isDef = isDst
+                                in
+                                  {fltregister = fltregister,
+                                   memloc = memloc,
+                                   weight = weight - 5
+                                            + (if isSrc
+                                                 then 5
+                                                 else 0)
+                                            + (if isDst
+                                                 then 10
+                                                 else 0),
+                                   sync = sync andalso (not isDef),
+                                   commit = if !Control.Native.IEEEFP
+                                               andalso
+                                               not (sync andalso (not isDef))
+                                              then REMOVE 0
+                                              else if List.exists
+                                                      (MemLoc.utilized memloc,
+                                                       fn memloc'
+                                                       => MemLocSet.contains
+                                                          (allDest, memloc'))
+                                                     then REMOVE 0
+                                                   else if MemLocSet.contains
+                                                           (remove_memlocs,
+                                                            memloc)
+                                                     then TRYREMOVE 0
+                                                   else if MemLocSet.contains
+                                                           (commit_memlocs,
+                                                            memloc)
+                                                     then TRYCOMMIT 0
+                                                   else commit}
+                                end,
+                  registerAllocation = registerAllocation}
 
-	    val {assembly = assembly_commit_fltregisters,
-		 registerAllocation,
-		 ...}
-	      = commitFltRegisters {info = info,
-				    supports = [],
-				    saves = [],
-				    registerAllocation = registerAllocation}
+            val {assembly = assembly_commit_fltregisters,
+                 registerAllocation,
+                 ...}
+              = commitFltRegisters {info = info,
+                                    supports = [],
+                                    saves = [],
+                                    registerAllocation = registerAllocation}
 
-	    val registerAllocation
-	      = valueMap 
-	        {map = fn value as {register,
-				    memloc,
-				    weight,
-				    sync,
-				    commit}
-		        => if volatile memloc
-		             then let
-				    val isDst
-				      = List.contains
-				        (final_defs_registers,
-					 register,
-					 Register.eq)
-				    val isDef = isDst
-				  in
-				    {register = register,
-				     memloc = memloc,
-				     sync = sync andalso (not isDef),
-				     weight = weight - 500,
-				     commit = REMOVE 0}
-				  end
-			   else if MemLocSet.contains
-		                   (dead_memlocs, memloc)
-			     then value
-			   else let
-				  val isSrc
-				    = List.contains
-				      (final_uses_registers,
-				       register,
-				       Register.eq)
+            val registerAllocation
+              = valueMap 
+                {map = fn value as {register,
+                                    memloc,
+                                    weight,
+                                    sync,
+                                    commit}
+                        => if volatile memloc
+                             then let
+                                    val isDst
+                                      = List.contains
+                                        (final_defs_registers,
+                                         register,
+                                         Register.eq)
+                                    val isDef = isDst
+                                  in
+                                    {register = register,
+                                     memloc = memloc,
+                                     sync = sync andalso (not isDef),
+                                     weight = weight - 500,
+                                     commit = REMOVE 0}
+                                  end
+                           else if MemLocSet.contains
+                                   (dead_memlocs, memloc)
+                             then value
+                           else let
+                                  val isSrc
+                                    = List.contains
+                                      (final_uses_registers,
+                                       register,
+                                       Register.eq)
 
-				  val isDst
-				    = List.contains
-			              (final_defs_registers,
-				       register,
-				       Register.eq)
-			       
-				  val isDef = isDst
-				in
-				  {register = register,
-				   memloc = memloc,
-				   weight = weight - 5
-				            + (if isSrc
-						 then 5
-						 else 0)
-				            + (if isDst
-						 then 10
-						 else 0),
-				   sync = sync andalso (not isDef),
-				   commit = if List.exists
-				               (MemLoc.utilized memloc,
-						fn memloc'
-						 => MemLocSet.contains
-						    (allDest, memloc'))
-					      then REMOVE 0
-					    else if MemLocSet.contains
-						    (remove_memlocs,
-						     memloc)
-					      then TRYREMOVE 0
-					    else if MemLocSet.contains
-						    (commit_memlocs,
-						     memloc)
-					      then TRYCOMMIT 0
-					    else commit}
-				end,
-		  registerAllocation = registerAllocation}
+                                  val isDst
+                                    = List.contains
+                                      (final_defs_registers,
+                                       register,
+                                       Register.eq)
+                               
+                                  val isDef = isDst
+                                in
+                                  {register = register,
+                                   memloc = memloc,
+                                   weight = weight - 5
+                                            + (if isSrc
+                                                 then 5
+                                                 else 0)
+                                            + (if isDst
+                                                 then 10
+                                                 else 0),
+                                   sync = sync andalso (not isDef),
+                                   commit = if List.exists
+                                               (MemLoc.utilized memloc,
+                                                fn memloc'
+                                                 => MemLocSet.contains
+                                                    (allDest, memloc'))
+                                              then REMOVE 0
+                                            else if MemLocSet.contains
+                                                    (remove_memlocs,
+                                                     memloc)
+                                              then TRYREMOVE 0
+                                            else if MemLocSet.contains
+                                                    (commit_memlocs,
+                                                     memloc)
+                                              then TRYCOMMIT 0
+                                            else commit}
+                                end,
+                  registerAllocation = registerAllocation}
 
-	    val {assembly = assembly_commit_registers,
-		 registerAllocation}
-	      = commitRegisters {info = info,
-				 supports = [],
-				 saves = [],
-				 registerAllocation = registerAllocation}
+            val {assembly = assembly_commit_registers,
+                 registerAllocation}
+              = commitRegisters {info = info,
+                                 supports = [],
+                                 saves = [],
+                                 registerAllocation = registerAllocation}
 
-	    val registerAllocation
-	      = valueMap 
-	        {map = fn value as {register,
-				    memloc,
-				    weight,
-				    ...}
-		        => if MemLocSet.contains
-		              (dead_memlocs, memloc)
-			     then {register = register,
-				   memloc = memloc,
-				   sync = true,
-				   weight = weight,
-				   commit = REMOVE 0}
-			     else value,
-		 registerAllocation = registerAllocation}
+            val registerAllocation
+              = valueMap 
+                {map = fn value as {register,
+                                    memloc,
+                                    weight,
+                                    ...}
+                        => if MemLocSet.contains
+                              (dead_memlocs, memloc)
+                             then {register = register,
+                                   memloc = memloc,
+                                   sync = true,
+                                   weight = weight,
+                                   commit = REMOVE 0}
+                             else value,
+                 registerAllocation = registerAllocation}
 
-	    val {assembly = assembly_dead_registers,
-		 registerAllocation}
-	      = commitRegisters {info = info,
-				 supports = [],
-				 saves = [],
-				 registerAllocation = registerAllocation}
-	  in
-	    {assembly = AppendList.appends
-	                [if !Control.Native.commented > 3
-			   then AppendList.cons
-			        ((Assembly.comment "post begin:"),
-				 (toComments ra))
-			   else AppendList.empty,
-			 assembly_commit_fltregisters,
-			 assembly_commit_registers,
-			 assembly_dead_registers,
-			 if !Control.Native.commented > 3
-			   then AppendList.cons
-			        ((Assembly.comment "post end:"),
-				 (toComments registerAllocation))
-			   else AppendList.empty],
-	     registerAllocation = registerAllocation}
-	  end
+            val {assembly = assembly_dead_registers,
+                 registerAllocation}
+              = commitRegisters {info = info,
+                                 supports = [],
+                                 saves = [],
+                                 registerAllocation = registerAllocation}
+          in
+            {assembly = AppendList.appends
+                        [if !Control.Native.commented > 3
+                           then AppendList.cons
+                                ((Assembly.comment "post begin:"),
+                                 (toComments ra))
+                           else AppendList.empty,
+                         assembly_commit_fltregisters,
+                         assembly_commit_registers,
+                         assembly_dead_registers,
+                         if !Control.Native.commented > 3
+                           then AppendList.cons
+                                ((Assembly.comment "post end:"),
+                                 (toComments registerAllocation))
+                           else AppendList.empty],
+             registerAllocation = registerAllocation}
+          end
 
       val (post, post_msg)
-	= tracer
-	  "post"
-	  post
+        = tracer
+          "post"
+          post
 
       fun allocateOperand {operand: Operand.t,
-			   options = {register: bool,
-				      immediate: bool,
-				      label: bool,
-				      address: bool},
-			   info as {dead, 
-				    remove,
-				    ...}: Liveness.t,
-			   size: Size.t,
-			   move: bool,
-			   supports: Operand.t list,
-			   saves: Operand.t list,
-			   force: Register.t list,
-			   registerAllocation: t} :
-	                  {operand: Operand.t,
-			   assembly: Assembly.t AppendList.t,
-			   registerAllocation: t}
-	= case operand
-	    of Operand.Immediate i
-	     => if immediate
-		  then {operand = operand,
-			assembly = AppendList.empty,
-			registerAllocation = registerAllocation}
-		else if register
-		  then let
-			 val {register, 
-			      assembly, 
-			      registerAllocation}
-			   = toRegisterImmediate {immediate = i,
-						  info = info,
-						  size = size,
-						  supports = supports,
-						  saves = saves,
-						  force = force,
-						  registerAllocation
-						  = registerAllocation}
-		       in
-			 {operand = Operand.register register,
-			  assembly = assembly,
-			  registerAllocation = registerAllocation}
-		       end
-		else if address
-		  then let
-			 val address
-			   = Address.T 
-			     {disp = SOME (Immediate.label (Label.fromString "raTemp1")),
-			      base = NONE,
-			      index = NONE,
-			      scale = NONE}
-		       in 
-			 {operand = Operand.address address,
-			  assembly = AppendList.single
-			             (Assembly.instruction_mov
-				      {src = Operand.immediate i,
-				       dst = Operand.address address,
-				       size = size}),
-			  registerAllocation = registerAllocation}
-		       end 
-	       else Error.bug "allocateOperand: operand:Immediate"
-	     | Operand.Label l
-	     => if label
-		  then {operand = operand,
-			assembly = AppendList.empty,
-			registerAllocation = registerAllocation}
-		else if immediate
-		  then {operand = Operand.immediate_label l,
-			assembly = AppendList.empty,
-			registerAllocation = registerAllocation}
-		else if register
-		  then let
-			 val {register, 
-			      assembly, 
-			      registerAllocation}
-			   = toRegisterImmediate {immediate 
-						  = Immediate.label l,
-						  info = info,
-						  size = size,
-						  supports = supports,
-						  saves = saves,
-						  force = force,
-						  registerAllocation
-						  = registerAllocation}
-		       in
-			 {operand = Operand.register register,
-			  assembly = assembly,
-			  registerAllocation = registerAllocation}
-		       end
-		else Error.bug "allocateOperand: operand:Label"
-	     | Operand.MemLoc m
-	     => let
-		  fun toRegisterMemLoc' ()
-		    = let
-			val {register, 
-			     assembly, 
-			     registerAllocation}
-			  = toRegisterMemLoc 
-			    {memloc = m,
-			     info = info,
-			     size = size,
-			     move = move,
-			     supports = supports,
-			     saves = saves,
-			     force = force,
-			     registerAllocation = registerAllocation}
-		      in
-			{operand = Operand.Register register,
-			 assembly = assembly,
-			 registerAllocation = registerAllocation}
-		      end
-		  fun toAddressMemLoc' ()
-		    = let
-			val {address, 
-			     assembly, 
-			     registerAllocation}
-			  = toAddressMemLoc 
-			    {memloc = m,
-			     info = info,
-			     size = size,
-			     supports = supports,
-			     saves = saves,
-			     registerAllocation
-			     = registerAllocation}
-		      in
-			{operand = Operand.Address address,
-			 assembly = assembly,
-			 registerAllocation = registerAllocation}
-		      end
-		  fun toAddressMemLocRemove' ()
-		    = let
-			val registerAllocation
-			  = valueMap {map 
-				      = fn value as {register,
-						     memloc,
-						     weight,
-						     sync,
-						     ...}
-				         => if MemLoc.eq(memloc, m)
-					      then {register = register, 
-						    memloc = memloc, 
-						    weight = weight, 
-						    sync = sync, 
-						    commit = REMOVE 0}
-					      else value,
-				      registerAllocation = registerAllocation}
-		     
-			val {assembly = assembly_commit,
-			     registerAllocation}
-			  = commitRegisters {info = info,
-					     supports = supports,
-					     saves = saves,
-					     registerAllocation 
-					     = registerAllocation}
-			  
-			val {address, assembly, registerAllocation}
-			  = toAddressMemLoc {memloc = m,
-					     info = info,
-					     size = size,
-					     supports = supports,
-					     saves = saves,
-					     registerAllocation
-					     = registerAllocation}
-		      in
-			{operand = Operand.Address address,
-			 assembly = AppendList.append (assembly_commit,
-						       assembly),
-			 registerAllocation = registerAllocation}
-		      end
-		in 
-		  if register andalso address
-		    then case allocated {memloc = m,
-					 registerAllocation 
-					 = registerAllocation}
-			   of NONE 
-			    => if MemLocSet.contains(dead, m)
-			          orelse
-				  MemLocSet.contains(remove, m)
-				 then toAddressMemLoc' ()
-				 else toRegisterMemLoc' ()
-		            | SOME _
-			    => toRegisterMemLoc' ()
-		  else if register
-		     then toRegisterMemLoc' ()
-		  else if address
-		     then toAddressMemLocRemove' ()
-		  else Error.bug "allocateOperand: operand:MemLoc"
-		end
-	     | _ => Error.bug "allocateOperand: operand"
+                           options = {register: bool,
+                                      immediate: bool,
+                                      label: bool,
+                                      address: bool},
+                           info as {dead, 
+                                    remove,
+                                    ...}: Liveness.t,
+                           size: Size.t,
+                           move: bool,
+                           supports: Operand.t list,
+                           saves: Operand.t list,
+                           force: Register.t list,
+                           registerAllocation: t} :
+                          {operand: Operand.t,
+                           assembly: Assembly.t AppendList.t,
+                           registerAllocation: t}
+        = case operand
+            of Operand.Immediate i
+             => if immediate
+                  then {operand = operand,
+                        assembly = AppendList.empty,
+                        registerAllocation = registerAllocation}
+                else if register
+                  then let
+                         val {register, 
+                              assembly, 
+                              registerAllocation}
+                           = toRegisterImmediate {immediate = i,
+                                                  info = info,
+                                                  size = size,
+                                                  supports = supports,
+                                                  saves = saves,
+                                                  force = force,
+                                                  registerAllocation
+                                                  = registerAllocation}
+                       in
+                         {operand = Operand.register register,
+                          assembly = assembly,
+                          registerAllocation = registerAllocation}
+                       end
+                else if address
+                  then let
+                         val address
+                           = Address.T 
+                             {disp = SOME (Immediate.label (Label.fromString "raTemp1")),
+                              base = NONE,
+                              index = NONE,
+                              scale = NONE}
+                       in 
+                         {operand = Operand.address address,
+                          assembly = AppendList.single
+                                     (Assembly.instruction_mov
+                                      {src = Operand.immediate i,
+                                       dst = Operand.address address,
+                                       size = size}),
+                          registerAllocation = registerAllocation}
+                       end 
+               else Error.bug "x86AllocateRegisters.RegisterAllocation.allocateOperand: operand:Immediate"
+             | Operand.Label l
+             => if label
+                  then {operand = operand,
+                        assembly = AppendList.empty,
+                        registerAllocation = registerAllocation}
+                else if immediate
+                  then {operand = Operand.immediate_label l,
+                        assembly = AppendList.empty,
+                        registerAllocation = registerAllocation}
+                else if register
+                  then let
+                         val {register, 
+                              assembly, 
+                              registerAllocation}
+                           = toRegisterImmediate {immediate 
+                                                  = Immediate.label l,
+                                                  info = info,
+                                                  size = size,
+                                                  supports = supports,
+                                                  saves = saves,
+                                                  force = force,
+                                                  registerAllocation
+                                                  = registerAllocation}
+                       in
+                         {operand = Operand.register register,
+                          assembly = assembly,
+                          registerAllocation = registerAllocation}
+                       end
+                else Error.bug "x86AllocateRegisters.RegisterAllocation.allocateOperand: operand:Label"
+             | Operand.MemLoc m
+             => let
+                  fun toRegisterMemLoc' ()
+                    = let
+                        val {register, 
+                             assembly, 
+                             registerAllocation}
+                          = toRegisterMemLoc 
+                            {memloc = m,
+                             info = info,
+                             size = size,
+                             move = move,
+                             supports = supports,
+                             saves = saves,
+                             force = force,
+                             registerAllocation = registerAllocation}
+                      in
+                        {operand = Operand.Register register,
+                         assembly = assembly,
+                         registerAllocation = registerAllocation}
+                      end
+                  fun toAddressMemLoc' ()
+                    = let
+                        val {address, 
+                             assembly, 
+                             registerAllocation}
+                          = toAddressMemLoc 
+                            {memloc = m,
+                             info = info,
+                             size = size,
+                             supports = supports,
+                             saves = saves,
+                             registerAllocation
+                             = registerAllocation}
+                      in
+                        {operand = Operand.Address address,
+                         assembly = assembly,
+                         registerAllocation = registerAllocation}
+                      end
+                  fun toAddressMemLocRemove' ()
+                    = let
+                        val registerAllocation
+                          = valueMap {map 
+                                      = fn value as {register,
+                                                     memloc,
+                                                     weight,
+                                                     sync,
+                                                     ...}
+                                         => if MemLoc.eq(memloc, m)
+                                              then {register = register, 
+                                                    memloc = memloc, 
+                                                    weight = weight, 
+                                                    sync = sync, 
+                                                    commit = REMOVE 0}
+                                              else value,
+                                      registerAllocation = registerAllocation}
+                     
+                        val {assembly = assembly_commit,
+                             registerAllocation}
+                          = commitRegisters {info = info,
+                                             supports = supports,
+                                             saves = saves,
+                                             registerAllocation 
+                                             = registerAllocation}
+                          
+                        val {address, assembly, registerAllocation}
+                          = toAddressMemLoc {memloc = m,
+                                             info = info,
+                                             size = size,
+                                             supports = supports,
+                                             saves = saves,
+                                             registerAllocation
+                                             = registerAllocation}
+                      in
+                        {operand = Operand.Address address,
+                         assembly = AppendList.append (assembly_commit,
+                                                       assembly),
+                         registerAllocation = registerAllocation}
+                      end
+                in 
+                  if register andalso address
+                    then case allocated {memloc = m,
+                                         registerAllocation 
+                                         = registerAllocation}
+                           of NONE 
+                            => if MemLocSet.contains(dead, m)
+                                  orelse
+                                  MemLocSet.contains(remove, m)
+                                 then toAddressMemLoc' ()
+                                 else toRegisterMemLoc' ()
+                            | SOME _
+                            => toRegisterMemLoc' ()
+                  else if register
+                     then toRegisterMemLoc' ()
+                  else if address
+                     then toAddressMemLocRemove' ()
+                  else Error.bug "x86AllocateRegisters.RegisterAllocation.allocateOperand: operand:MemLoc"
+                end
+             | _ => Error.bug "x86AllocateRegisters.RegisterAllocation.allocateOperand: operand"
 
       val (allocateOperand, allocateOperand_msg)
-	= tracer
-	  "allocateOperand"
-	  allocateOperand
+        = tracer
+          "allocateOperand"
+          allocateOperand
 
       fun allocateFltOperand {operand: Operand.t,
-			      options = {fltregister: bool,
-					 address: bool},
-			      info as {dead, 
-				       remove,
-				       ...}: Liveness.t,
-			      size: Size.t,
-			      move: bool,
-			      supports: Operand.t list,
-			      saves: Operand.t list,
-			      top: bool option,
-			      registerAllocation: t} :
-	                     {operand: Operand.t,
-			      assembly: Assembly.t AppendList.t,
-			      fltrename: FltRegister.t -> FltRegister.t,
-			      registerAllocation: t}
-	= case operand
+                              options = {fltregister: bool,
+                                         address: bool},
+                              info as {dead, 
+                                       remove,
+                                       ...}: Liveness.t,
+                              size: Size.t,
+                              move: bool,
+                              supports: Operand.t list,
+                              saves: Operand.t list,
+                              top: bool option,
+                              registerAllocation: t} :
+                             {operand: Operand.t,
+                              assembly: Assembly.t AppendList.t,
+                              fltrename: FltRegister.t -> FltRegister.t,
+                              registerAllocation: t}
+        = case operand
             of Operand.MemLoc m 
-	     => if fltregister andalso address
-		  then case fltallocated {memloc = m,
-					  registerAllocation 
-					  = registerAllocation}
-			 of NONE 
-			  => if MemLocSet.contains(dead, m)
-			        orelse 
-				MemLocSet.contains(remove, m)
-			       then let
-				      val {address, 
-					   assembly, 
-					   registerAllocation}
-					= toAddressMemLoc 
-					  {memloc = m,
-					   info = info,
-					   size = size,
-					   supports = supports,
-					   saves = saves,
-					   registerAllocation
-					   = registerAllocation}
-				    in
-				      {operand = Operand.Address address,
-				       assembly = assembly,
-				       fltrename = FltRegister.id,
-				       registerAllocation = registerAllocation}
-				    end
-			       else let
-				      val {fltregister, 
-					   assembly, 
-					   fltrename,
-					   registerAllocation}
-					= toFltRegisterMemLoc 
-					  {memloc = m,
-					   info = info,
-					   size = size,
-					   move = move,
-					   supports = supports,
-					   saves = saves,
-					   top = top,
-					   registerAllocation
-					   = registerAllocation}
-				    in
-				      {operand 
-				       = Operand.FltRegister fltregister,
-				       assembly = assembly,
-				       fltrename = fltrename,
-				       registerAllocation = registerAllocation}
-				    end
-	                  | SOME _
-			  => let
-			       val {fltregister, 
-				    assembly, 
-				    fltrename,
-				    registerAllocation}
-				 = toFltRegisterMemLoc {memloc = m,
-							info = info,
-							size = size,
-							move = move,
-							supports = supports,
-							saves = saves,
-							top = top,
-							registerAllocation
-							= registerAllocation}
-			     in
-			       {operand = Operand.FltRegister fltregister,
-				assembly = assembly,
-				fltrename = fltrename,
-				registerAllocation = registerAllocation}
-			     end
-		else if fltregister
-		  then let
-			 val {fltregister, 
-			      assembly, 
-			      fltrename, 
-			      registerAllocation}
-			   = toFltRegisterMemLoc {memloc = m,
-						  info = info,
-						  size = size,
-						  move = move,
-						  supports = supports,
-						  saves = saves,
-						  top = top,
-						  registerAllocation
-						  = registerAllocation}
-		       in
-			 {operand = Operand.FltRegister fltregister,
-			  assembly = assembly,
-			  fltrename = fltrename,
-			  registerAllocation = registerAllocation}
-		       end
-		else if address
-		  then let
-			 val registerAllocation
-			   = fltvalueMap {map 
-					  = fn value as {fltregister,
-							 memloc,
-							 weight,
-							 sync,
-							 ...}
-				             => if MemLoc.eq(memloc, m)
-						  then {fltregister 
-							= fltregister, 
-							memloc = memloc, 
-							weight = weight, 
-							sync = sync, 
-							commit = REMOVE 0}
-						  else value,
-				          registerAllocation 
-					  = registerAllocation}
-		     
-			 val {assembly = assembly_commit,
-			      fltrename = fltrename_commit,
-			      registerAllocation}
-			   = commitFltRegisters {info = info,
-						 supports = supports,
-						 saves = saves,
-						 registerAllocation 
-						 = registerAllocation}
+             => if fltregister andalso address
+                  then case fltallocated {memloc = m,
+                                          registerAllocation 
+                                          = registerAllocation}
+                         of NONE 
+                          => if MemLocSet.contains(dead, m)
+                                orelse 
+                                MemLocSet.contains(remove, m)
+                               then let
+                                      val {address, 
+                                           assembly, 
+                                           registerAllocation}
+                                        = toAddressMemLoc 
+                                          {memloc = m,
+                                           info = info,
+                                           size = size,
+                                           supports = supports,
+                                           saves = saves,
+                                           registerAllocation
+                                           = registerAllocation}
+                                    in
+                                      {operand = Operand.Address address,
+                                       assembly = assembly,
+                                       fltrename = FltRegister.id,
+                                       registerAllocation = registerAllocation}
+                                    end
+                               else let
+                                      val {fltregister, 
+                                           assembly, 
+                                           fltrename,
+                                           registerAllocation}
+                                        = toFltRegisterMemLoc 
+                                          {memloc = m,
+                                           info = info,
+                                           size = size,
+                                           move = move,
+                                           supports = supports,
+                                           saves = saves,
+                                           top = top,
+                                           registerAllocation
+                                           = registerAllocation}
+                                    in
+                                      {operand 
+                                       = Operand.FltRegister fltregister,
+                                       assembly = assembly,
+                                       fltrename = fltrename,
+                                       registerAllocation = registerAllocation}
+                                    end
+                          | SOME _
+                          => let
+                               val {fltregister, 
+                                    assembly, 
+                                    fltrename,
+                                    registerAllocation}
+                                 = toFltRegisterMemLoc {memloc = m,
+                                                        info = info,
+                                                        size = size,
+                                                        move = move,
+                                                        supports = supports,
+                                                        saves = saves,
+                                                        top = top,
+                                                        registerAllocation
+                                                        = registerAllocation}
+                             in
+                               {operand = Operand.FltRegister fltregister,
+                                assembly = assembly,
+                                fltrename = fltrename,
+                                registerAllocation = registerAllocation}
+                             end
+                else if fltregister
+                  then let
+                         val {fltregister, 
+                              assembly, 
+                              fltrename, 
+                              registerAllocation}
+                           = toFltRegisterMemLoc {memloc = m,
+                                                  info = info,
+                                                  size = size,
+                                                  move = move,
+                                                  supports = supports,
+                                                  saves = saves,
+                                                  top = top,
+                                                  registerAllocation
+                                                  = registerAllocation}
+                       in
+                         {operand = Operand.FltRegister fltregister,
+                          assembly = assembly,
+                          fltrename = fltrename,
+                          registerAllocation = registerAllocation}
+                       end
+                else if address
+                  then let
+                         val registerAllocation
+                           = fltvalueMap {map 
+                                          = fn value as {fltregister,
+                                                         memloc,
+                                                         weight,
+                                                         sync,
+                                                         ...}
+                                             => if MemLoc.eq(memloc, m)
+                                                  then {fltregister 
+                                                        = fltregister, 
+                                                        memloc = memloc, 
+                                                        weight = weight, 
+                                                        sync = sync, 
+                                                        commit = REMOVE 0}
+                                                  else value,
+                                          registerAllocation 
+                                          = registerAllocation}
+                     
+                         val {assembly = assembly_commit,
+                              fltrename = fltrename_commit,
+                              registerAllocation}
+                           = commitFltRegisters {info = info,
+                                                 supports = supports,
+                                                 saves = saves,
+                                                 registerAllocation 
+                                                 = registerAllocation}
 
-			 val {address, 
-			      assembly = assembly_address, 
-			      registerAllocation}
-			   = toAddressMemLoc {memloc = m,
-					      info = info,
-					      size = size,
-					      supports = supports,
-					      saves = saves,
-					      registerAllocation
-					      = registerAllocation}
-		       in
-			 {operand = Operand.Address address,
-			  assembly = AppendList.append (assembly_commit,
-							assembly_address),
-			  fltrename = fltrename_commit,
-			  registerAllocation = registerAllocation}
-		       end
-		else Error.bug "allocateFltOperand: operand:MemLoc"
-	     | _ => Error.bug "allocateFltOperand: operand"
+                         val {address, 
+                              assembly = assembly_address, 
+                              registerAllocation}
+                           = toAddressMemLoc {memloc = m,
+                                              info = info,
+                                              size = size,
+                                              supports = supports,
+                                              saves = saves,
+                                              registerAllocation
+                                              = registerAllocation}
+                       in
+                         {operand = Operand.Address address,
+                          assembly = AppendList.append (assembly_commit,
+                                                        assembly_address),
+                          fltrename = fltrename_commit,
+                          registerAllocation = registerAllocation}
+                       end
+                else Error.bug "x86AllocateRegisters.RegisterAllocation.allocateFltOperand: operand:MemLoc"
+             | _ => Error.bug "x86AllocateRegisters.RegisterAllocation.allocateFltOperand: operand"
 
       val (allocateFltOperand, allocateFltOperand_msg)
-	= tracer
-	  "allocateFltOperand"
-	  allocateFltOperand
+        = tracer
+          "allocateFltOperand"
+          allocateFltOperand
 
       local 
-	fun allocateFltStackOperands' {fltregister_top: FltRegister.t,
-				       fltregister_one: FltRegister.t,
-				       registerAllocation: t} :
-	                              {assembly: Assembly.t AppendList.t,
-				       fltrename: FltRegister.t -> FltRegister.t,
-				       registerAllocation: t}
-	  = case (fltregister_top, fltregister_one)
-	      of (FltRegister.T 0, FltRegister.T 1)
-	       => {assembly = AppendList.empty,
-		   fltrename = FltRegister.id,
-		   registerAllocation = registerAllocation}
-	       | (FltRegister.T 1, FltRegister.T 0)
-	       => let
-		    val {fltrename = fltrename,
-			 registerAllocation}
-		      = fltxch1 {registerAllocation = registerAllocation}
-		  in
-		    {assembly = AppendList.single
-		                (Assembly.instruction_fxch 
-				 {src = Operand.fltregister 
-				        (FltRegister.T 1)}),
-		     fltrename = fltrename,
-		     registerAllocation = registerAllocation}
-		  end
-	       | (FltRegister.T 0, FltRegister.T j)
-	       => let
-		    val {fltrename = fltrename,
-			 registerAllocation}
-		      = fltxch1 {registerAllocation = registerAllocation}
+        fun allocateFltStackOperands' {fltregister_top: FltRegister.t,
+                                       fltregister_one: FltRegister.t,
+                                       registerAllocation: t} :
+                                      {assembly: Assembly.t AppendList.t,
+                                       fltrename: FltRegister.t -> FltRegister.t,
+                                       registerAllocation: t}
+          = case (fltregister_top, fltregister_one)
+              of (FltRegister.T 0, FltRegister.T 1)
+               => {assembly = AppendList.empty,
+                   fltrename = FltRegister.id,
+                   registerAllocation = registerAllocation}
+               | (FltRegister.T 1, FltRegister.T 0)
+               => let
+                    val {fltrename = fltrename,
+                         registerAllocation}
+                      = fltxch1 {registerAllocation = registerAllocation}
+                  in
+                    {assembly = AppendList.single
+                                (Assembly.instruction_fxch 
+                                 {src = Operand.fltregister 
+                                        (FltRegister.T 1)}),
+                     fltrename = fltrename,
+                     registerAllocation = registerAllocation}
+                  end
+               | (FltRegister.T 0, FltRegister.T j)
+               => let
+                    val {fltrename = fltrename,
+                         registerAllocation}
+                      = fltxch1 {registerAllocation = registerAllocation}
 
-		    val {fltrename = fltrename',
-			 registerAllocation}
-		      = fltxch' {fltregister = FltRegister.T j,
-				 registerAllocation = registerAllocation}
+                    val {fltrename = fltrename',
+                         registerAllocation}
+                      = fltxch' {fltregister = FltRegister.T j,
+                                 registerAllocation = registerAllocation}
 
-		    val {fltrename = fltrename'',
-			 registerAllocation}
-		      = fltxch1 {registerAllocation = registerAllocation}
-		  in
-		    {assembly = AppendList.fromList
-		                [Assembly.instruction_fxch 
-				 {src = Operand.fltregister 
-				        (FltRegister.T 1)},
-				 Assembly.instruction_fxch 
-				 {src = Operand.fltregister 
-				        (FltRegister.T j)},
-				 Assembly.instruction_fxch 
-				 {src = Operand.fltregister 
-				        (FltRegister.T 1)}],
-		     fltrename = fltrename'' o fltrename' o fltrename,
-		     registerAllocation = registerAllocation}
-		  end
-	       | (FltRegister.T 1, FltRegister.T j)
-	       => let
-		    val {fltrename = fltrename,
-			 registerAllocation}
-		      = fltxch' {fltregister = FltRegister.T j,
-				 registerAllocation = registerAllocation}
+                    val {fltrename = fltrename'',
+                         registerAllocation}
+                      = fltxch1 {registerAllocation = registerAllocation}
+                  in
+                    {assembly = AppendList.fromList
+                                [Assembly.instruction_fxch 
+                                 {src = Operand.fltregister 
+                                        (FltRegister.T 1)},
+                                 Assembly.instruction_fxch 
+                                 {src = Operand.fltregister 
+                                        (FltRegister.T j)},
+                                 Assembly.instruction_fxch 
+                                 {src = Operand.fltregister 
+                                        (FltRegister.T 1)}],
+                     fltrename = fltrename'' o fltrename' o fltrename,
+                     registerAllocation = registerAllocation}
+                  end
+               | (FltRegister.T 1, FltRegister.T j)
+               => let
+                    val {fltrename = fltrename,
+                         registerAllocation}
+                      = fltxch' {fltregister = FltRegister.T j,
+                                 registerAllocation = registerAllocation}
 
-		    val {fltrename = fltrename',
-			 registerAllocation}
-		      = fltxch1 {registerAllocation = registerAllocation}
-		  in
-		    {assembly = AppendList.fromList
-		                [Assembly.instruction_fxch 
-				 {src = Operand.fltregister 
-				        (FltRegister.T j)},
-				 Assembly.instruction_fxch 
-				 {src = Operand.fltregister 
-				        (FltRegister.T 1)}],
-		     fltrename = fltrename' o fltrename,
-		     registerAllocation = registerAllocation}
-		  end
-	       | (FltRegister.T i, FltRegister.T 1)
-	       => let
-		    val {fltrename = fltrename,
-			 registerAllocation}
-		      = fltxch' {fltregister = FltRegister.T i,
-				 registerAllocation = registerAllocation}
-		  in
-		    {assembly = AppendList.single
-		                (Assembly.instruction_fxch 
-				 {src = Operand.fltregister 
-				        (FltRegister.T i)}),
-		     fltrename = fltrename,
-		     registerAllocation = registerAllocation}
-		  end
-	       | (FltRegister.T i, FltRegister.T 0)
-	       => let
-		    val {fltrename = fltrename,
-			 registerAllocation}
-		      = fltxch1 {registerAllocation = registerAllocation}
+                    val {fltrename = fltrename',
+                         registerAllocation}
+                      = fltxch1 {registerAllocation = registerAllocation}
+                  in
+                    {assembly = AppendList.fromList
+                                [Assembly.instruction_fxch 
+                                 {src = Operand.fltregister 
+                                        (FltRegister.T j)},
+                                 Assembly.instruction_fxch 
+                                 {src = Operand.fltregister 
+                                        (FltRegister.T 1)}],
+                     fltrename = fltrename' o fltrename,
+                     registerAllocation = registerAllocation}
+                  end
+               | (FltRegister.T i, FltRegister.T 1)
+               => let
+                    val {fltrename = fltrename,
+                         registerAllocation}
+                      = fltxch' {fltregister = FltRegister.T i,
+                                 registerAllocation = registerAllocation}
+                  in
+                    {assembly = AppendList.single
+                                (Assembly.instruction_fxch 
+                                 {src = Operand.fltregister 
+                                        (FltRegister.T i)}),
+                     fltrename = fltrename,
+                     registerAllocation = registerAllocation}
+                  end
+               | (FltRegister.T i, FltRegister.T 0)
+               => let
+                    val {fltrename = fltrename,
+                         registerAllocation}
+                      = fltxch1 {registerAllocation = registerAllocation}
 
-		    val {fltrename = fltrename',
-			 registerAllocation}
-		      = fltxch' {fltregister = FltRegister.T i,
-				 registerAllocation = registerAllocation}
-		  in
-		    {assembly = AppendList.fromList
-		                [Assembly.instruction_fxch 
-				 {src = Operand.fltregister 
-				        (FltRegister.T 1)},
-				 Assembly.instruction_fxch 
-				 {src = Operand.fltregister 
-				        (FltRegister.T i)}],
-		     fltrename = fltrename' o fltrename,
-		     registerAllocation = registerAllocation}
-		  end
-	       | (FltRegister.T i, FltRegister.T j)
-	       => let
-		    val {fltrename = fltrename,
-			 registerAllocation}
-		      = fltxch' {fltregister = FltRegister.T j,
-				 registerAllocation = registerAllocation}
+                    val {fltrename = fltrename',
+                         registerAllocation}
+                      = fltxch' {fltregister = FltRegister.T i,
+                                 registerAllocation = registerAllocation}
+                  in
+                    {assembly = AppendList.fromList
+                                [Assembly.instruction_fxch 
+                                 {src = Operand.fltregister 
+                                        (FltRegister.T 1)},
+                                 Assembly.instruction_fxch 
+                                 {src = Operand.fltregister 
+                                        (FltRegister.T i)}],
+                     fltrename = fltrename' o fltrename,
+                     registerAllocation = registerAllocation}
+                  end
+               | (FltRegister.T i, FltRegister.T j)
+               => let
+                    val {fltrename = fltrename,
+                         registerAllocation}
+                      = fltxch' {fltregister = FltRegister.T j,
+                                 registerAllocation = registerAllocation}
 
-		    val {fltrename = fltrename',
-			 registerAllocation}
-		      = fltxch1 {registerAllocation = registerAllocation}
-		      
-		    val {fltrename = fltrename'',
-			 registerAllocation}
-		      = fltxch' {fltregister = FltRegister.T i,
-				 registerAllocation = registerAllocation}
-		  in
-		    {assembly = AppendList.fromList
-		                [Assembly.instruction_fxch 
-				 {src = Operand.fltregister 
-				        (FltRegister.T j)},
-				 Assembly.instruction_fxch 
-				 {src = Operand.fltregister 
-				        (FltRegister.T 1)},
-				 Assembly.instruction_fxch 
-				 {src = Operand.fltregister 
-				        (FltRegister.T i)}],
-		     fltrename = fltrename'' o fltrename' o fltrename,
-		     registerAllocation = registerAllocation}
-		  end
+                    val {fltrename = fltrename',
+                         registerAllocation}
+                      = fltxch1 {registerAllocation = registerAllocation}
+                      
+                    val {fltrename = fltrename'',
+                         registerAllocation}
+                      = fltxch' {fltregister = FltRegister.T i,
+                                 registerAllocation = registerAllocation}
+                  in
+                    {assembly = AppendList.fromList
+                                [Assembly.instruction_fxch 
+                                 {src = Operand.fltregister 
+                                        (FltRegister.T j)},
+                                 Assembly.instruction_fxch 
+                                 {src = Operand.fltregister 
+                                        (FltRegister.T 1)},
+                                 Assembly.instruction_fxch 
+                                 {src = Operand.fltregister 
+                                        (FltRegister.T i)}],
+                     fltrename = fltrename'' o fltrename' o fltrename,
+                     registerAllocation = registerAllocation}
+                  end
       in
-	fun allocateFltStackOperands {operand_top: Operand.t,
-				      size_top: Size.t,
-				      move_top: bool,
-				      operand_one: Operand.t,
-				      move_one: bool,
-				      size_one: Size.t,
-				      info: Liveness.t,
-				      supports: Operand.t list,
-				      saves: Operand.t list,
-				      registerAllocation: t} :
-	                             {operand_top: Operand.t,
-				      operand_one: Operand.t,
-				      assembly: Assembly.t AppendList.t,
-				      fltrename: FltRegister.t -> FltRegister.t,
-				      registerAllocation: t}
-	  = if Operand.eq(operand_top, operand_one)
-	      then let
-		     val {assembly = assembly_free,
-			  fltrename = fltrename_free,
-			  registerAllocation}
-		       = freeFltRegister {info = info,
-					  size = size_top,
-					  supports = operand_top::supports,
-					  saves = saves,
-					  registerAllocation
-					  = registerAllocation}
+        fun allocateFltStackOperands {operand_top: Operand.t,
+                                      size_top: Size.t,
+                                      move_top: bool,
+                                      operand_one: Operand.t,
+                                      move_one: bool,
+                                      size_one: Size.t,
+                                      info: Liveness.t,
+                                      supports: Operand.t list,
+                                      saves: Operand.t list,
+                                      registerAllocation: t} :
+                                     {operand_top: Operand.t,
+                                      operand_one: Operand.t,
+                                      assembly: Assembly.t AppendList.t,
+                                      fltrename: FltRegister.t -> FltRegister.t,
+                                      registerAllocation: t}
+          = if Operand.eq(operand_top, operand_one)
+              then let
+                     val {assembly = assembly_free,
+                          fltrename = fltrename_free,
+                          registerAllocation}
+                       = freeFltRegister {info = info,
+                                          size = size_top,
+                                          supports = operand_top::supports,
+                                          saves = saves,
+                                          registerAllocation
+                                          = registerAllocation}
 
-		     val {assembly = assembly_allocate_top_one,
-			  fltrename = fltrename_allocate_top_one,
-			  registerAllocation,
-			  ...}
-		       = allocateFltOperand 
-		         {operand = operand_top,
-			  options = {fltregister = true,
-				     address = false},
-			  info = info,
-			  size = size_top,
-			  move = move_top,
-			  supports = supports,
-			  saves = saves,
-			  top = SOME true,
-			  registerAllocation 
-			  = registerAllocation}
+                     val {assembly = assembly_allocate_top_one,
+                          fltrename = fltrename_allocate_top_one,
+                          registerAllocation,
+                          ...}
+                       = allocateFltOperand 
+                         {operand = operand_top,
+                          options = {fltregister = true,
+                                     address = false},
+                          info = info,
+                          size = size_top,
+                          move = move_top,
+                          supports = supports,
+                          saves = saves,
+                          top = SOME true,
+                          registerAllocation 
+                          = registerAllocation}
 
-		     val temp 
-		       = MemLoc.imm
-		         {base = Immediate.label (Label.fromString "raTemp2"),
-			  index = Immediate.const_int 0,
-			  scale = Scale.Eight,
-			  size = Size.DBLE,
-			  class = MemLoc.Class.Temp}
+                     val temp 
+                       = MemLoc.imm
+                         {base = Immediate.label (Label.fromString "raTemp2"),
+                          index = Immediate.const_int 0,
+                          scale = Scale.Eight,
+                          size = Size.DBLE,
+                          class = MemLoc.Class.Temp}
 
-		     val {fltrename = fltrename_push,
-			  registerAllocation}
-		       = fltpush {value = {fltregister = FltRegister.top,
-					   memloc = temp,
-					   weight = 0,
-					   sync = true,
-					   commit = NO},
-				  registerAllocation = registerAllocation}
-		   in
-		     {operand_top = Operand.FltRegister FltRegister.top,
-		      operand_one = Operand.FltRegister FltRegister.one,
-		      assembly = AppendList.appends
-		                 [assembly_free,
-				  assembly_allocate_top_one,
-				  AppendList.single
-				  (Assembly.instruction_fld
-				   {src = Operand.FltRegister FltRegister.top,
-				    size = size_top})],
-		      fltrename = fltrename_push o
-		               fltrename_allocate_top_one o
+                     val {fltrename = fltrename_push,
+                          registerAllocation}
+                       = fltpush {value = {fltregister = FltRegister.top,
+                                           memloc = temp,
+                                           weight = 0,
+                                           sync = true,
+                                           commit = NO},
+                                  registerAllocation = registerAllocation}
+                   in
+                     {operand_top = Operand.FltRegister FltRegister.top,
+                      operand_one = Operand.FltRegister FltRegister.one,
+                      assembly = AppendList.appends
+                                 [assembly_free,
+                                  assembly_allocate_top_one,
+                                  AppendList.single
+                                  (Assembly.instruction_fld
+                                   {src = Operand.FltRegister FltRegister.top,
+                                    size = size_top})],
+                      fltrename = fltrename_push o
+                               fltrename_allocate_top_one o
                                fltrename_free,
-		      registerAllocation = registerAllocation}
-		   end
-	      else let
-		     val {operand = operand_allocate_one,
-			  assembly = assembly_allocate_one,
-			  fltrename = fltrename_allocate_one,
-			  registerAllocation}
-		       = case operand_one
-			   of (Operand.MemLoc memloc_one)
-			    => (case fltallocated {memloc = memloc_one,
-						   registerAllocation 
-						   = registerAllocation}
-				  of SOME value_one
-				    => {operand = Operand.FltRegister 
-					          (#fltregister value_one),
-					assembly = AppendList.empty,
-					fltrename = FltRegister.id,
-					registerAllocation 
-					= registerAllocation}
-				    | NONE
-				    => allocateFltOperand 
-				       {operand = operand_one,
-					options = {fltregister = true,
-						   address = false},
-					info = info,
-					size = size_one,
-					move = move_one,
-					supports = supports,
-					saves = operand_top::saves,
-					top = SOME true,
-					registerAllocation 
-					= registerAllocation})
-			    | _ => allocateFltOperand 
-		                   {operand = operand_one,
-				    options = {fltregister = true,
-					       address = false},
-				    info = info,
-				    size = size_one,
-				    move = move_one,
-				    supports = supports,
-				    saves = operand_top::saves,
-				    top = SOME true,
-				    registerAllocation = registerAllocation}
+                      registerAllocation = registerAllocation}
+                   end
+              else let
+                     val {operand = operand_allocate_one,
+                          assembly = assembly_allocate_one,
+                          fltrename = fltrename_allocate_one,
+                          registerAllocation}
+                       = case operand_one
+                           of (Operand.MemLoc memloc_one)
+                            => (case fltallocated {memloc = memloc_one,
+                                                   registerAllocation 
+                                                   = registerAllocation}
+                                  of SOME value_one
+                                    => {operand = Operand.FltRegister 
+                                                  (#fltregister value_one),
+                                        assembly = AppendList.empty,
+                                        fltrename = FltRegister.id,
+                                        registerAllocation 
+                                        = registerAllocation}
+                                    | NONE
+                                    => allocateFltOperand 
+                                       {operand = operand_one,
+                                        options = {fltregister = true,
+                                                   address = false},
+                                        info = info,
+                                        size = size_one,
+                                        move = move_one,
+                                        supports = supports,
+                                        saves = operand_top::saves,
+                                        top = SOME true,
+                                        registerAllocation 
+                                        = registerAllocation})
+                            | _ => allocateFltOperand 
+                                   {operand = operand_one,
+                                    options = {fltregister = true,
+                                               address = false},
+                                    info = info,
+                                    size = size_one,
+                                    move = move_one,
+                                    supports = supports,
+                                    saves = operand_top::saves,
+                                    top = SOME true,
+                                    registerAllocation = registerAllocation}
 
-		     val {operand = operand_allocate_top,
-			  assembly = assembly_allocate_top,
-			  fltrename = fltrename_allocate_top,
-			  registerAllocation}
-		       = case operand_top
-			   of (Operand.MemLoc memloc_top)
-			    => (case fltallocated {memloc = memloc_top,
-						   registerAllocation 
-						   = registerAllocation}
-				  of SOME value_top
-				    => {operand = Operand.FltRegister 
-					          (#fltregister value_top),
-					assembly = AppendList.empty,
-					fltrename = FltRegister.id,
-					registerAllocation 
-					= registerAllocation}
-				    | NONE
-			            => allocateFltOperand 
-				       {operand = operand_top,
-					options = {fltregister = true,
-						   address = false},
-					info = info,
-					size = size_top,
-					move = move_top,
-					supports = supports,
-					saves = operand_top::saves,
-					top = SOME true,
-					registerAllocation 
-					= registerAllocation})
-			    | _ => allocateFltOperand 
-			           {operand = operand_top,
-				    options = {fltregister = true,
-					       address = false},
-				    info = info,
-				    size = size_top,
-				    move = move_top,
-				    supports = supports,
-				    saves = operand_top::saves,
-				    top = SOME true,
-				    registerAllocation = registerAllocation}
+                     val {operand = operand_allocate_top,
+                          assembly = assembly_allocate_top,
+                          fltrename = fltrename_allocate_top,
+                          registerAllocation}
+                       = case operand_top
+                           of (Operand.MemLoc memloc_top)
+                            => (case fltallocated {memloc = memloc_top,
+                                                   registerAllocation 
+                                                   = registerAllocation}
+                                  of SOME value_top
+                                    => {operand = Operand.FltRegister 
+                                                  (#fltregister value_top),
+                                        assembly = AppendList.empty,
+                                        fltrename = FltRegister.id,
+                                        registerAllocation 
+                                        = registerAllocation}
+                                    | NONE
+                                    => allocateFltOperand 
+                                       {operand = operand_top,
+                                        options = {fltregister = true,
+                                                   address = false},
+                                        info = info,
+                                        size = size_top,
+                                        move = move_top,
+                                        supports = supports,
+                                        saves = operand_top::saves,
+                                        top = SOME true,
+                                        registerAllocation 
+                                        = registerAllocation})
+                            | _ => allocateFltOperand 
+                                   {operand = operand_top,
+                                    options = {fltregister = true,
+                                               address = false},
+                                    info = info,
+                                    size = size_top,
+                                    move = move_top,
+                                    supports = supports,
+                                    saves = operand_top::saves,
+                                    top = SOME true,
+                                    registerAllocation = registerAllocation}
 
-		     val fltregister_one
-		       = case operand_allocate_one
-			   of Operand.FltRegister f => f
-			    | _ => Error.bug "allocateFltStackOperand"
-		     val fltregister_one = fltrename_allocate_top fltregister_one
+                     val fltregister_one
+                       = case operand_allocate_one
+                           of Operand.FltRegister f => f
+                            | _ => Error.bug "x86AllocateRegisters.RegisterAllocation.allocateFltStackOperand: one"
+                     val fltregister_one = fltrename_allocate_top fltregister_one
 
-		     val fltregister_top
-		       = case operand_allocate_top
-			   of Operand.FltRegister f => f
-			    | _ => Error.bug "allocateFltStackOperand"
+                     val fltregister_top
+                       = case operand_allocate_top
+                           of Operand.FltRegister f => f
+                            | _ => Error.bug "x86AllocateRegisters.RegisterAllocation.allocateFltStackOperand: top"
 
-		     val {assembly,
-			  fltrename,
-			  registerAllocation}
-		       = allocateFltStackOperands'
-  		         {fltregister_top = fltregister_top,
-			  fltregister_one = fltregister_one,
-			  registerAllocation = registerAllocation}
-		   in
-		     {operand_top = Operand.FltRegister FltRegister.top,
-		      operand_one = Operand.FltRegister FltRegister.one,
-		      assembly = AppendList.appends
-		                 [assembly_allocate_one,
-				  assembly_allocate_top,
-				  assembly],
-		      fltrename = fltrename o
-		               fltrename_allocate_top o
-			       fltrename_allocate_one,
-		      registerAllocation = registerAllocation}
-		   end
+                     val {assembly,
+                          fltrename,
+                          registerAllocation}
+                       = allocateFltStackOperands'
+                         {fltregister_top = fltregister_top,
+                          fltregister_one = fltregister_one,
+                          registerAllocation = registerAllocation}
+                   in
+                     {operand_top = Operand.FltRegister FltRegister.top,
+                      operand_one = Operand.FltRegister FltRegister.one,
+                      assembly = AppendList.appends
+                                 [assembly_allocate_one,
+                                  assembly_allocate_top,
+                                  assembly],
+                      fltrename = fltrename o
+                               fltrename_allocate_top o
+                               fltrename_allocate_one,
+                      registerAllocation = registerAllocation}
+                   end
       end
 
       val (allocateFltStackOperands, allocateFltStackOperands_msg)
-	= tracer
-	  "allocateFltStackOperands"
-	  allocateFltStackOperands
+        = tracer
+          "allocateFltStackOperands"
+          allocateFltStackOperands
 
       fun fltrenameLift fltrename 
-	= fn Operand.FltRegister f
-	   => Operand.FltRegister (fltrename f)
-	   | operand => operand
+        = fn Operand.FltRegister f
+           => Operand.FltRegister (fltrename f)
+           | operand => operand
 
       (* Implementation of directives. *)
 
       fun assume {assumes : {register: Register.t, 
-			     memloc: MemLoc.t, 
-			     weight: int,
-			     sync: bool,
-			     reserve: bool} list,
-		  info = _,
-		  registerAllocation}
-	= let
-	    val {assembly,
-		 registerAllocation}
-	      = List.foldr
-	        (assumes,
-		 {assembly = AppendList.empty,
-		  registerAllocation = registerAllocation},
-		 fn ({register,
-		      memloc,
-		      weight,
-		      sync,
-		      reserve},
-		     {assembly, registerAllocation})
-		  => let
-		       val registerAllocation
-			 = update
-			   {value = {register = register,
-				     memloc = memloc,
-				     weight = weight,
-				     sync = sync,
-				     commit = NO},
-			    registerAllocation = registerAllocation}
-			   
-		       val {assembly = assembly_reserve,
-			    registerAllocation}
-			 = if reserve
-			     then reserve' {register = register,
-					    registerAllocation = registerAllocation}
-			     else unreserve' {register = register,
-					      registerAllocation = registerAllocation}
-		     in
-		       {assembly = AppendList.append (assembly,
-						      assembly_reserve),
-			registerAllocation = registerAllocation}
-		     end)
-	  in
-	    {assembly = assembly,
-	     registerAllocation = registerAllocation}
-	  end 
+                             memloc: MemLoc.t, 
+                             weight: int,
+                             sync: bool,
+                             reserve: bool} list,
+                  info = _,
+                  registerAllocation}
+        = let
+            val {assembly,
+                 registerAllocation}
+              = List.foldr
+                (assumes,
+                 {assembly = AppendList.empty,
+                  registerAllocation = registerAllocation},
+                 fn ({register,
+                      memloc,
+                      weight,
+                      sync,
+                      reserve},
+                     {assembly, registerAllocation})
+                  => let
+                       val registerAllocation
+                         = update
+                           {value = {register = register,
+                                     memloc = memloc,
+                                     weight = weight,
+                                     sync = sync,
+                                     commit = NO},
+                            registerAllocation = registerAllocation}
+                           
+                       val {assembly = assembly_reserve,
+                            registerAllocation}
+                         = if reserve
+                             then reserve' {register = register,
+                                            registerAllocation = registerAllocation}
+                             else unreserve' {register = register,
+                                              registerAllocation = registerAllocation}
+                     in
+                       {assembly = AppendList.append (assembly,
+                                                      assembly_reserve),
+                        registerAllocation = registerAllocation}
+                     end)
+          in
+            {assembly = assembly,
+             registerAllocation = registerAllocation}
+          end 
 
       fun fltassume {assumes : {memloc: MemLoc.t,
-				weight: int,
-				sync: bool} list,
-		     info = _,
-		     registerAllocation = {entries,
-					   reserved,
-					   ...} : t}
-	= let
-	    val registerAllocation
-	      = {entries = entries,
-		 reserved = reserved,
-		 fltstack = []}
+                                weight: int,
+                                sync: bool} list,
+                     info = _,
+                     registerAllocation = {entries,
+                                           reserved,
+                                           ...} : t}
+        = let
+            val registerAllocation
+              = {entries = entries,
+                 reserved = reserved,
+                 fltstack = []}
 
-	    val {assembly, 
-		 registerAllocation}
-	      = List.foldr
-	        (assumes,
-		 {assembly = AppendList.empty,
-		  registerAllocation = registerAllocation},
-		 fn ({memloc,
-		      weight,
-		      sync},
-		     {assembly, registerAllocation})
-		  => let
-		       val {registerAllocation, ...}
-			 = fltpush {value = {fltregister = FltRegister.top,
-					     memloc = memloc,
-					     weight = weight,
-					     sync = sync,
-					     commit = NO},
-				    registerAllocation = registerAllocation}
-		     in
-		       {assembly = assembly,
-			registerAllocation = registerAllocation}
-		     end)
-	  in
-	    {assembly = assembly,
-	     registerAllocation = registerAllocation}
-	  end
+            val {assembly, 
+                 registerAllocation}
+              = List.foldr
+                (assumes,
+                 {assembly = AppendList.empty,
+                  registerAllocation = registerAllocation},
+                 fn ({memloc,
+                      weight,
+                      sync},
+                     {assembly, registerAllocation})
+                  => let
+                       val {registerAllocation, ...}
+                         = fltpush {value = {fltregister = FltRegister.top,
+                                             memloc = memloc,
+                                             weight = weight,
+                                             sync = sync,
+                                             commit = NO},
+                                    registerAllocation = registerAllocation}
+                     in
+                       {assembly = assembly,
+                        registerAllocation = registerAllocation}
+                     end)
+          in
+            {assembly = assembly,
+             registerAllocation = registerAllocation}
+          end
 
       fun cache {caches: {register: Register.t,
-			  memloc: MemLoc.t,
-			  reserve: bool} list,
-		 info,
-		 registerAllocation}
-	= let
-	    val supports
-	      = List.revMap
-	        (caches,
-		 fn {memloc, ...} => Operand.memloc memloc)
+                          memloc: MemLoc.t,
+                          reserve: bool} list,
+                 info,
+                 registerAllocation}
+        = let
+            val supports
+              = List.revMap
+                (caches,
+                 fn {memloc, ...} => Operand.memloc memloc)
 
-	    datatype u = None | Reg of Register.t | Mem of MemLoc.t
-	      
-	    fun computeEdges' {reg,
-			       registerAllocation}
-	      = List.revMap
-	        (Register.coincident' reg,
-		 fn register'
-		  => let
-		       val (from, m)
-			 = case List.peek
-			        (caches,
-				 fn {register, ...} 
-				  => Register.eq(register, register'))
-			     of NONE => (None, NONE)
-			      | SOME {memloc, ...}
-			      => (case allocated {memloc = memloc,
-						  registerAllocation 
-						  = registerAllocation}
-				    of NONE 
-				     => (Mem memloc, SOME memloc)
-				     | SOME {register, ...} 
-				     => (Reg register, SOME memloc))
+            datatype u = None | Reg of Register.t | Mem of MemLoc.t
+              
+            fun computeEdges' {reg,
+                               registerAllocation}
+              = List.revMap
+                (Register.coincident' reg,
+                 fn register'
+                  => let
+                       val (from, m)
+                         = case List.peek
+                                (caches,
+                                 fn {register, ...} 
+                                  => Register.eq(register, register'))
+                             of NONE => (None, NONE)
+                              | SOME {memloc, ...}
+                              => (case allocated {memloc = memloc,
+                                                  registerAllocation 
+                                                  = registerAllocation}
+                                    of NONE 
+                                     => (Mem memloc, SOME memloc)
+                                     | SOME {register, ...} 
+                                     => (Reg register, SOME memloc))
 
-		       val to
-			 = case valueRegister
-			        {register = register',
-				 registerAllocation = registerAllocation}
-			     of NONE => None
-			      | SOME {memloc = memloc', ...}
-			      => (case List.peek
-				       (caches,
-					fn {memloc, ...}
-				         => MemLoc.eq(memloc, memloc'))
-				    of NONE => None
-				     | SOME {register, ...} => Reg register)
-		     in
-		       (from, m, register', to)
-		     end)
+                       val to
+                         = case valueRegister
+                                {register = register',
+                                 registerAllocation = registerAllocation}
+                             of NONE => None
+                              | SOME {memloc = memloc', ...}
+                              => (case List.peek
+                                       (caches,
+                                        fn {memloc, ...}
+                                         => MemLoc.eq(memloc, memloc'))
+                                    of NONE => None
+                                     | SOME {register, ...} => Reg register)
+                     in
+                       (from, m, register', to)
+                     end)
 
-	    fun computeEdges {registerAllocation}
-	      = List.revMap
-	        (Register.allReg,
-		 fn reg
-		  => (reg, computeEdges' {reg = reg,
-					  registerAllocation = registerAllocation}))
+            fun computeEdges {registerAllocation}
+              = List.revMap
+                (Register.allReg,
+                 fn reg
+                  => (reg, computeEdges' {reg = reg,
+                                          registerAllocation = registerAllocation}))
 
-	    fun doitSelf {edges,
-			  saves,
-			  assembly,
-			  registerAllocation}
-	      = let
-		  val {yes = self, no = edges}
-		    = List.partition
-		      (edges,
-		       fn (_, edges')
-		        => List.forall
-		           (edges', 
-			    fn (Reg rf, _, r, Reg rt)
-			     => Register.eq(rf, r) andalso
-			        Register.eq(r, rt)
-			     | _ => false))
-		in
-		  if not (List.isEmpty self)
-		    then let
-			   val saves_self 
-			     = List.fold
-			       (self,
-				[],
-				fn ((_, edges'), saves)
-				 => List.fold
-				    (edges',
-				     saves,
-				     fn ((_,_,r,_), saves)
-				      => (Operand.register r)::saves))
-			 in
-			   doit {edges = edges,
-				 saves = saves_self @ saves,
-				 assembly = assembly,
-				 registerAllocation = registerAllocation}
-			 end
-		    else doitEasy {edges = edges,
-				   saves = saves,
-				   assembly = assembly,
-				   registerAllocation = registerAllocation}
-		end
+            fun doitSelf {edges,
+                          saves,
+                          assembly,
+                          registerAllocation}
+              = let
+                  val {yes = self, no = edges}
+                    = List.partition
+                      (edges,
+                       fn (_, edges')
+                        => List.forall
+                           (edges', 
+                            fn (Reg rf, _, r, Reg rt)
+                             => Register.eq(rf, r) andalso
+                                Register.eq(r, rt)
+                             | _ => false))
+                in
+                  if not (List.isEmpty self)
+                    then let
+                           val saves_self 
+                             = List.fold
+                               (self,
+                                [],
+                                fn ((_, edges'), saves)
+                                 => List.fold
+                                    (edges',
+                                     saves,
+                                     fn ((_,_,r,_), saves)
+                                      => (Operand.register r)::saves))
+                         in
+                           doit {edges = edges,
+                                 saves = saves_self @ saves,
+                                 assembly = assembly,
+                                 registerAllocation = registerAllocation}
+                         end
+                    else doitEasy {edges = edges,
+                                   saves = saves,
+                                   assembly = assembly,
+                                   registerAllocation = registerAllocation}
+                end
 
-	    and doitEasy {edges,
-			  saves,
-			  assembly,
-			  registerAllocation}
-	      = let
-		  val {easy}
-		    = List.fold
-		      (edges,
-		       {easy = NONE},
-		       fn ((_, edges'), {easy = NONE})
-		        => let
-			     val {easy}
-			       = List.fold
-			         (edges',
-				  {easy = NONE},
-				  fn ((Reg _, SOME m, r, None), 
-				      {easy = NONE})
-				   => {easy = SOME (m, r)}
-				   | (_, {easy})
-				   => {easy = easy})
-			   in
-			     {easy = easy}
-			   end
-			| ((_, _), {easy})
-			=> {easy = easy})
-		in
-		  case easy
-		    of SOME (m, r)
-		     => let
-			  val {assembly = assembly_register,
-			       registerAllocation,
-			       ...}
-			    = toRegisterMemLoc 
-			      {memloc = m,
-			       info = info,
-			       size = MemLoc.size m,
-			       move = true,
-			       supports = supports,
-			       saves = saves, 
-			       force = [r], 
-			       registerAllocation = registerAllocation}
+            and doitEasy {edges,
+                          saves,
+                          assembly,
+                          registerAllocation}
+              = let
+                  val {easy}
+                    = List.fold
+                      (edges,
+                       {easy = NONE},
+                       fn ((_, edges'), {easy = NONE})
+                        => let
+                             val {easy}
+                               = List.fold
+                                 (edges',
+                                  {easy = NONE},
+                                  fn ((Reg _, SOME m, r, None), 
+                                      {easy = NONE})
+                                   => {easy = SOME (m, r)}
+                                   | (_, {easy})
+                                   => {easy = easy})
+                           in
+                             {easy = easy}
+                           end
+                        | ((_, _), {easy})
+                        => {easy = easy})
+                in
+                  case easy
+                    of SOME (m, r)
+                     => let
+                          val {assembly = assembly_register,
+                               registerAllocation,
+                               ...}
+                            = toRegisterMemLoc 
+                              {memloc = m,
+                               info = info,
+                               size = MemLoc.size m,
+                               move = true,
+                               supports = supports,
+                               saves = saves, 
+                               force = [r], 
+                               registerAllocation = registerAllocation}
 
-			  val edges = computeEdges 
-			              {registerAllocation = registerAllocation}
-			in
-			  doit {edges = edges,
-				saves = [],
-				assembly = AppendList.append
-				           (assembly, assembly_register),
-			        registerAllocation = registerAllocation}
-			end
-		     | NONE => doitHard {edges = edges,
-					 saves = saves,
-					 assembly = assembly,
-					 registerAllocation = registerAllocation}
-		end
+                          val edges = computeEdges 
+                                      {registerAllocation = registerAllocation}
+                        in
+                          doit {edges = edges,
+                                saves = [],
+                                assembly = AppendList.append
+                                           (assembly, assembly_register),
+                                registerAllocation = registerAllocation}
+                        end
+                     | NONE => doitHard {edges = edges,
+                                         saves = saves,
+                                         assembly = assembly,
+                                         registerAllocation = registerAllocation}
+                end
 
-	    and doitHard {edges,
-			  saves,
-			  assembly,
-			  registerAllocation}
-	      = let
-		  val {hard}
-		    = List.fold
-		      (edges,
-		       {hard = NONE},
-		       fn ((_, edges'), {hard = NONE})
-		        => let
-			     val {hard}
-			       = List.fold
-			         (edges',
-				  {hard = NONE},
-				  fn ((Mem _, SOME m, r, None), 
-				      {hard = NONE})
-				   => {hard = SOME (m, r)}
-				   | (_, {hard})
-				   => {hard = hard})
-			   in
-			     {hard = hard}
-			   end
-			| ((_, _), {hard})
-			=> {hard = hard})
-		in
-		  case hard
-		    of SOME (m, r)
-		     => let
-			  val {assembly = assembly_register,
-			       registerAllocation,
-			       ...}
-			    = toRegisterMemLoc 
-			      {memloc = m,
-			       info = info,
-			       size = MemLoc.size m,
-			       move = true,
-			       supports = supports,
-			       saves = saves, 
-			       force = [r], 
-			       registerAllocation = registerAllocation}
+            and doitHard {edges,
+                          saves,
+                          assembly,
+                          registerAllocation}
+              = let
+                  val {hard}
+                    = List.fold
+                      (edges,
+                       {hard = NONE},
+                       fn ((_, edges'), {hard = NONE})
+                        => let
+                             val {hard}
+                               = List.fold
+                                 (edges',
+                                  {hard = NONE},
+                                  fn ((Mem _, SOME m, r, None), 
+                                      {hard = NONE})
+                                   => {hard = SOME (m, r)}
+                                   | (_, {hard})
+                                   => {hard = hard})
+                           in
+                             {hard = hard}
+                           end
+                        | ((_, _), {hard})
+                        => {hard = hard})
+                in
+                  case hard
+                    of SOME (m, r)
+                     => let
+                          val {assembly = assembly_register,
+                               registerAllocation,
+                               ...}
+                            = toRegisterMemLoc 
+                              {memloc = m,
+                               info = info,
+                               size = MemLoc.size m,
+                               move = true,
+                               supports = supports,
+                               saves = saves, 
+                               force = [r], 
+                               registerAllocation = registerAllocation}
 
-			  val edges = computeEdges 
-			              {registerAllocation = registerAllocation}
-			in
-			  doit {edges = edges,
-				saves = [],
-				assembly = AppendList.append
-				           (assembly, assembly_register),
-			        registerAllocation = registerAllocation}
-			end
-		     | NONE => doitCycle {edges = edges,
-					  saves = saves,
-					  assembly = assembly,
-					  registerAllocation = registerAllocation}
-		end
+                          val edges = computeEdges 
+                                      {registerAllocation = registerAllocation}
+                        in
+                          doit {edges = edges,
+                                saves = [],
+                                assembly = AppendList.append
+                                           (assembly, assembly_register),
+                                registerAllocation = registerAllocation}
+                        end
+                     | NONE => doitCycle {edges = edges,
+                                          saves = saves,
+                                          assembly = assembly,
+                                          registerAllocation = registerAllocation}
+                end
 
-	    and doitCycle {edges,
-			   saves,
-			   assembly,
-			   registerAllocation = registerAllocation}
-	      = let
-		  val {cycle}
-		    = List.fold
-		      (edges,
-		       {cycle = NONE},
-		       fn ((_, edges'), {cycle = NONE})
-		        => let
-			     val {cycle}
-			       = List.fold
-			         (edges',
-				  {cycle = NONE},
-				  fn ((Reg _, SOME m, r, Reg _), 
-				      {cycle = NONE})
-				   => {cycle = SOME (m, r)}
-				   | (_, {cycle})
-				   => {cycle = cycle})
-			   in
-			     {cycle = cycle}
-			   end
-			| ((_, _), {cycle})
-			=> {cycle = cycle})
-		in
-		  case cycle
-		    of SOME (m, r)
-		     => let
-			  val {assembly = assembly_register,
-			       registerAllocation,
-			       ...}
-			    = toRegisterMemLoc 
-			      {memloc = m,
-			       info = info,
-			       size = MemLoc.size m,
-			       move = true,
-			       supports = supports,
-			       saves = saves, 
-			       force = [r], 
-			       registerAllocation = registerAllocation}
+            and doitCycle {edges,
+                           saves,
+                           assembly,
+                           registerAllocation = registerAllocation}
+              = let
+                  val {cycle}
+                    = List.fold
+                      (edges,
+                       {cycle = NONE},
+                       fn ((_, edges'), {cycle = NONE})
+                        => let
+                             val {cycle}
+                               = List.fold
+                                 (edges',
+                                  {cycle = NONE},
+                                  fn ((Reg _, SOME m, r, Reg _), 
+                                      {cycle = NONE})
+                                   => {cycle = SOME (m, r)}
+                                   | (_, {cycle})
+                                   => {cycle = cycle})
+                           in
+                             {cycle = cycle}
+                           end
+                        | ((_, _), {cycle})
+                        => {cycle = cycle})
+                in
+                  case cycle
+                    of SOME (m, r)
+                     => let
+                          val {assembly = assembly_register,
+                               registerAllocation,
+                               ...}
+                            = toRegisterMemLoc 
+                              {memloc = m,
+                               info = info,
+                               size = MemLoc.size m,
+                               move = true,
+                               supports = supports,
+                               saves = saves, 
+                               force = [r], 
+                               registerAllocation = registerAllocation}
 
-			  val edges = computeEdges 
-			              {registerAllocation = registerAllocation}
-			in
-			  doit {edges = edges,
-				saves = [],
-				assembly = AppendList.append
-				           (assembly, assembly_register),
-			        registerAllocation = registerAllocation}
-			end
-		     | NONE => doitCycle {edges = edges,
-					  saves = saves,
-					  assembly = assembly,
-					  registerAllocation = registerAllocation}
-		end
+                          val edges = computeEdges 
+                                      {registerAllocation = registerAllocation}
+                        in
+                          doit {edges = edges,
+                                saves = [],
+                                assembly = AppendList.append
+                                           (assembly, assembly_register),
+                                registerAllocation = registerAllocation}
+                        end
+                     | NONE => doitCycle {edges = edges,
+                                          saves = saves,
+                                          assembly = assembly,
+                                          registerAllocation = registerAllocation}
+                end
 
-	    and doit {edges,
-		      saves,
-		      assembly,
-		      registerAllocation}
-	      = let
-		  val edges
-		    = List.fold
-		      (edges,
-		       [],
-		       fn ((reg, edges'), edges)
-		        => let
-			     val edges' 
-			       = List.revRemoveAll
-			         (edges',
-				  fn (None, _, _, None) => true
-				   | _ => false)
-			   in
-			     if List.isEmpty edges'
-			       then edges
-			       else (reg, edges')::edges
-			   end)
-		in
-		  if List.isEmpty edges
-		    then {assembly = assembly,
-			  registerAllocation = registerAllocation}
-		    else doitSelf {edges = edges,
-				   saves = saves,
-				   assembly = assembly,
-				   registerAllocation = registerAllocation}
-		end
+            and doit {edges,
+                      saves,
+                      assembly,
+                      registerAllocation}
+              = let
+                  val edges
+                    = List.fold
+                      (edges,
+                       [],
+                       fn ((reg, edges'), edges)
+                        => let
+                             val edges' 
+                               = List.revRemoveAll
+                                 (edges',
+                                  fn (None, _, _, None) => true
+                                   | _ => false)
+                           in
+                             if List.isEmpty edges'
+                               then edges
+                               else (reg, edges')::edges
+                           end)
+                in
+                  if List.isEmpty edges
+                    then {assembly = assembly,
+                          registerAllocation = registerAllocation}
+                    else doitSelf {edges = edges,
+                                   saves = saves,
+                                   assembly = assembly,
+                                   registerAllocation = registerAllocation}
+                end
 
-	    val {assembly = assembly_force,
-		 registerAllocation}
-	      = doit {edges = computeEdges {registerAllocation = registerAllocation},
-		      saves = [],
-		      assembly = AppendList.empty,
-		      registerAllocation = registerAllocation}
+            val {assembly = assembly_force,
+                 registerAllocation}
+              = doit {edges = computeEdges {registerAllocation = registerAllocation},
+                      saves = [],
+                      assembly = AppendList.empty,
+                      registerAllocation = registerAllocation}
 
-	    val {assembly = assembly_reserve,
-		 registerAllocation}
-	      = reserve {registers = List.revKeepAllMap
+            val {assembly = assembly_reserve,
+                 registerAllocation}
+              = reserve {registers = List.revKeepAllMap
                                      (caches, 
-				      fn {register, reserve, ...} 
-				       => if reserve 
+                                      fn {register, reserve, ...} 
+                                       => if reserve 
                                             then SOME register 
                                             else NONE),
-			 registerAllocation = registerAllocation}
+                         registerAllocation = registerAllocation}
 
-	  in
-	    {assembly = AppendList.append(assembly_force, assembly_reserve),
-	     registerAllocation = registerAllocation}
-	  end
+          in
+            {assembly = AppendList.append(assembly_force, assembly_reserve),
+             registerAllocation = registerAllocation}
+          end
 
 (*
       fun cache {caches : {register: Register.t,
-			   memloc: MemLoc.t,
-			   reserve: bool} list,
-		 info,
-		 registerAllocation}
-	= let
-	    val supports
-	      = List.map
-	        (caches,
-		 fn {memloc, ...} => Operand.memloc memloc)
+                           memloc: MemLoc.t,
+                           reserve: bool} list,
+                 info,
+                 registerAllocation}
+        = let
+            val supports
+              = List.map
+                (caches,
+                 fn {memloc, ...} => Operand.memloc memloc)
 
-	    val {assembly,
-		 registerAllocation,
-		 ...}
-	      = List.foldr
-	        (caches,
-		 {assembly = AppendList.empty,
-		  registerAllocation = registerAllocation,
-		  saves = []},
-		 fn (cache as {register,
-			       memloc,
-			       reserve},
-		     {assembly,
-		      registerAllocation,
-		      saves})
-		  => let
-		       val {register,
-			    assembly = assembly_register,
-			    registerAllocation}
-			 = toRegisterMemLoc 
-			   {memloc = memloc,
-			    info = info,
-			    size = MemLoc.size memloc,
-			    move = true,
-			    supports = supports,
-			    saves = saves, 
-			    force = [register], 
-			    registerAllocation = registerAllocation}
-			   
-		       val {assembly = assembly_reserve,
-			    registerAllocation}
-			 = if reserve
-			     then reserve' {register = register,
-					    registerAllocation = registerAllocation}
-			     else {assembly = AppendList.empty,
-				   registerAllocation = registerAllocation}
-		     in
-		       {assembly = AppendList.appends [assembly,
-						       assembly_register,
-						       assembly_reserve],
-			registerAllocation = registerAllocation,
-			saves = (Operand.memloc memloc)::saves}
-		     end)
-	  in
-	    {assembly = assembly,
-	     registerAllocation = registerAllocation}
-	  end
+            val {assembly,
+                 registerAllocation,
+                 ...}
+              = List.foldr
+                (caches,
+                 {assembly = AppendList.empty,
+                  registerAllocation = registerAllocation,
+                  saves = []},
+                 fn (cache as {register,
+                               memloc,
+                               reserve},
+                     {assembly,
+                      registerAllocation,
+                      saves})
+                  => let
+                       val {register,
+                            assembly = assembly_register,
+                            registerAllocation}
+                         = toRegisterMemLoc 
+                           {memloc = memloc,
+                            info = info,
+                            size = MemLoc.size memloc,
+                            move = true,
+                            supports = supports,
+                            saves = saves, 
+                            force = [register], 
+                            registerAllocation = registerAllocation}
+                           
+                       val {assembly = assembly_reserve,
+                            registerAllocation}
+                         = if reserve
+                             then reserve' {register = register,
+                                            registerAllocation = registerAllocation}
+                             else {assembly = AppendList.empty,
+                                   registerAllocation = registerAllocation}
+                     in
+                       {assembly = AppendList.appends [assembly,
+                                                       assembly_register,
+                                                       assembly_reserve],
+                        registerAllocation = registerAllocation,
+                        saves = (Operand.memloc memloc)::saves}
+                     end)
+          in
+            {assembly = assembly,
+             registerAllocation = registerAllocation}
+          end
 *)
 
       fun fltcache {caches : {memloc: MemLoc.t} list,
-		    info,
-		    registerAllocation}
-	= let
-	    val supports
-	      = List.revMap
-	        (caches,
-		 fn {memloc, ...} => Operand.memloc memloc)
+                    info,
+                    registerAllocation}
+        = let
+            val supports
+              = List.revMap
+                (caches,
+                 fn {memloc, ...} => Operand.memloc memloc)
 
-	    val {assembly = assembly_load,
-		 registerAllocation,
-		 ...}
-	      = List.foldr
-	        (caches,
-		 {assembly = AppendList.empty,
-		  registerAllocation = registerAllocation,
-		  saves = []},
-		 fn ({memloc: MemLoc.t},
-		     {assembly,
-		      registerAllocation,
-		      saves})
-		  => let
-		       val {assembly = assembly_fltregister,
-			    registerAllocation,
-			    ...}
-			 = toFltRegisterMemLoc 
-			   {memloc = memloc,
-			    info = info,
-			    size = MemLoc.size memloc,
-			    move = true,
-			    supports = supports,
-			    saves = saves, 
-			    top = SOME false,
-			    registerAllocation = registerAllocation}
-		     in
-		       {assembly = AppendList.append (assembly,
-						      assembly_fltregister),
-			registerAllocation = registerAllocation,
-			saves = (Operand.memloc memloc)::saves}
-		     end)
+            val {assembly = assembly_load,
+                 registerAllocation,
+                 ...}
+              = List.foldr
+                (caches,
+                 {assembly = AppendList.empty,
+                  registerAllocation = registerAllocation,
+                  saves = []},
+                 fn ({memloc: MemLoc.t},
+                     {assembly,
+                      registerAllocation,
+                      saves})
+                  => let
+                       val {assembly = assembly_fltregister,
+                            registerAllocation,
+                            ...}
+                         = toFltRegisterMemLoc 
+                           {memloc = memloc,
+                            info = info,
+                            size = MemLoc.size memloc,
+                            move = true,
+                            supports = supports,
+                            saves = saves, 
+                            top = SOME false,
+                            registerAllocation = registerAllocation}
+                     in
+                       {assembly = AppendList.append (assembly,
+                                                      assembly_fltregister),
+                        registerAllocation = registerAllocation,
+                        saves = (Operand.memloc memloc)::saves}
+                     end)
 
-	    val (num_caches,
-		 dest_caches)
-	      = List.fold
-	        (caches,
-		 (0,[]),
-		 fn ({memloc},
-		     (num_caches, dest_caches))
-		  => (num_caches + 1,
-		      {memloc = memloc, 
-		       fltregister = FltRegister.T num_caches}::dest_caches))
+            val (num_caches,
+                 dest_caches)
+              = List.fold
+                (caches,
+                 (0,[]),
+                 fn ({memloc},
+                     (num_caches, dest_caches))
+                  => (num_caches + 1,
+                      {memloc = memloc, 
+                       fltregister = FltRegister.T num_caches}::dest_caches))
 
-	    fun check {assembly, registerAllocation}
-	      = let
-		  val {fltstack, ...} = registerAllocation
-		  val disp = (List.length fltstack) - num_caches
+            fun check {assembly, registerAllocation}
+              = let
+                  val {fltstack, ...} = registerAllocation
+                  val disp = (List.length fltstack) - num_caches
 
-		  val dest
-		    = fn (FltRegister.T i) => FltRegister.T (i + disp)
+                  val dest
+                    = fn (FltRegister.T i) => FltRegister.T (i + disp)
 
-		  val rec check'
-		    = fn [] => {assembly = assembly,
-				registerAllocation = registerAllocation}
-		       | ({fltregister,
-			   memloc,
-			   ...}: fltvalue)::fltstack
-		       => (case List.peek
-			        (dest_caches,
-				 fn {memloc = memloc', ...}
-				  => MemLoc.eq(memloc, memloc'))
-			     of SOME {fltregister = fltregister', ...}
-			      => let
-				   val fltregister' = dest fltregister'
-				 in
-				   if FltRegister.eq
-				      (fltregister,
-				       fltregister')
-				     then check' fltstack
-				     else let
-					    val fltregister''
-					      = if FltRegister.eq
-					           (fltregister,
-						    FltRegister.top)
-						  then fltregister'
-						  else fltregister
+                  val rec check'
+                    = fn [] => {assembly = assembly,
+                                registerAllocation = registerAllocation}
+                       | ({fltregister,
+                           memloc,
+                           ...}: fltvalue)::fltstack
+                       => (case List.peek
+                                (dest_caches,
+                                 fn {memloc = memloc', ...}
+                                  => MemLoc.eq(memloc, memloc'))
+                             of SOME {fltregister = fltregister', ...}
+                              => let
+                                   val fltregister' = dest fltregister'
+                                 in
+                                   if FltRegister.eq
+                                      (fltregister,
+                                       fltregister')
+                                     then check' fltstack
+                                     else let
+                                            val fltregister''
+                                              = if FltRegister.eq
+                                                   (fltregister,
+                                                    FltRegister.top)
+                                                  then fltregister'
+                                                  else fltregister
 
-					    val {registerAllocation,
-						 ...}
-					      = fltxch'
-					        {fltregister = fltregister'',
-						 registerAllocation
-						 = registerAllocation}
+                                            val {registerAllocation,
+                                                 ...}
+                                              = fltxch'
+                                                {fltregister = fltregister'',
+                                                 registerAllocation
+                                                 = registerAllocation}
 
-					    val assembly_xch
-					      = AppendList.single
-					        (Assembly.instruction_fxch
-						 {src = Operand.fltregister
-						        fltregister''})
-					  in
-					    check
-					    {assembly 
-					     = AppendList.append (assembly, 
-								  assembly_xch),
-					     registerAllocation = registerAllocation}
-					  end
-				 end
-			      | NONE
-			      => let
-				   val registerAllocation
-				     = fltvalueMap
-				       {map = fn value as {fltregister,
-							   memloc,
-							   weight,
-							   sync,
-							   ...}
-					       => if FltRegister.eq
-					             (fltregister,
-						      FltRegister.top)
-						    then {fltregister = fltregister,
-							  memloc = memloc,
-							  weight = weight,
-							  sync = sync,
-							  commit = REMOVE 0}
-						    else value,
-					registerAllocation = registerAllocation}
+                                            val assembly_xch
+                                              = AppendList.single
+                                                (Assembly.instruction_fxch
+                                                 {src = Operand.fltregister
+                                                        fltregister''})
+                                          in
+                                            check
+                                            {assembly 
+                                             = AppendList.append (assembly, 
+                                                                  assembly_xch),
+                                             registerAllocation = registerAllocation}
+                                          end
+                                 end
+                              | NONE
+                              => let
+                                   val registerAllocation
+                                     = fltvalueMap
+                                       {map = fn value as {fltregister,
+                                                           memloc,
+                                                           weight,
+                                                           sync,
+                                                           ...}
+                                               => if FltRegister.eq
+                                                     (fltregister,
+                                                      FltRegister.top)
+                                                    then {fltregister = fltregister,
+                                                          memloc = memloc,
+                                                          weight = weight,
+                                                          sync = sync,
+                                                          commit = REMOVE 0}
+                                                    else value,
+                                        registerAllocation = registerAllocation}
 
-				   val {assembly = assembly_commit,
-					registerAllocation,
-					...}
-				     = commitFltRegisters
-				       {info = info,
-					supports = supports,
-					saves = [],
-					registerAllocation
-					= registerAllocation}
-				 in
-				   check {assembly 
-					  = AppendList.append (assembly,
-							       assembly_commit),
-					  registerAllocation = registerAllocation}
-				 end)
-		in
-		  check' fltstack
-		end
+                                   val {assembly = assembly_commit,
+                                        registerAllocation,
+                                        ...}
+                                     = commitFltRegisters
+                                       {info = info,
+                                        supports = supports,
+                                        saves = [],
+                                        registerAllocation
+                                        = registerAllocation}
+                                 in
+                                   check {assembly 
+                                          = AppendList.append (assembly,
+                                                               assembly_commit),
+                                          registerAllocation = registerAllocation}
+                                 end)
+                in
+                  check' fltstack
+                end
 
-	    val {assembly = assembly_shuffle, 
-		 registerAllocation}
-	      = check {assembly = AppendList.empty,
-		       registerAllocation = registerAllocation}
-	  in
-	    {assembly = AppendList.appends [assembly_load,
-					    assembly_shuffle],
-	     registerAllocation = registerAllocation}
-	  end
+            val {assembly = assembly_shuffle, 
+                 registerAllocation}
+              = check {assembly = AppendList.empty,
+                       registerAllocation = registerAllocation}
+          in
+            {assembly = AppendList.appends [assembly_load,
+                                            assembly_shuffle],
+             registerAllocation = registerAllocation}
+          end
 
 
       fun reset ({...}: {registerAllocation: t})
-	= {assembly = AppendList.empty,
-	   registerAllocation = empty ()}
+        = {assembly = AppendList.empty,
+           registerAllocation = empty ()}
 
       fun force {commit_memlocs: MemLocSet.t,
-		 commit_classes: ClassSet.t,
-		 remove_memlocs: MemLocSet.t,
-		 remove_classes: ClassSet.t,
-		 dead_memlocs: MemLocSet.t,
-		 dead_classes: ClassSet.t,
-		 info: Liveness.t,
-		 registerAllocation: t}
-	= let
-	    val toCommit 
-	      = fn TRYREMOVE _ => REMOVE 0
-	         | REMOVE _ => REMOVE 0
-	         | _ => COMMIT 0
-	    val toRemove
-	      = fn _ => REMOVE 0
+                 commit_classes: ClassSet.t,
+                 remove_memlocs: MemLocSet.t,
+                 remove_classes: ClassSet.t,
+                 dead_memlocs: MemLocSet.t,
+                 dead_classes: ClassSet.t,
+                 info: Liveness.t,
+                 registerAllocation: t}
+        = let
+            val toCommit 
+              = fn TRYREMOVE _ => REMOVE 0
+                 | REMOVE _ => REMOVE 0
+                 | _ => COMMIT 0
+            val toRemove
+              = fn _ => REMOVE 0
 
-	    val shouldCommit 
-	      = fn memloc => (MemLocSet.contains(commit_memlocs,
-						 memloc)
-			      orelse
-			      ClassSet.contains(commit_classes,
-						MemLoc.class memloc))
-	    val shouldRemove
-	      = fn memloc => (MemLocSet.contains(remove_memlocs,
-						 memloc)
-			      orelse
-			      ClassSet.contains(remove_classes,
-						MemLoc.class memloc))
-	    val shouldDead
-	      = fn memloc => (MemLocSet.contains(dead_memlocs,
-						 memloc)
-			      orelse
-			      ClassSet.contains(dead_classes,
-						MemLoc.class memloc))
+            val shouldCommit 
+              = fn memloc => (MemLocSet.contains(commit_memlocs,
+                                                 memloc)
+                              orelse
+                              ClassSet.contains(commit_classes,
+                                                MemLoc.class memloc))
+            val shouldRemove
+              = fn memloc => (MemLocSet.contains(remove_memlocs,
+                                                 memloc)
+                              orelse
+                              ClassSet.contains(remove_classes,
+                                                MemLoc.class memloc))
+            val shouldDead
+              = fn memloc => (MemLocSet.contains(dead_memlocs,
+                                                 memloc)
+                              orelse
+                              ClassSet.contains(dead_classes,
+                                                MemLoc.class memloc))
 
-	    val registerAllocation
-	      = fltvalueMap {map 
-			     = fn value as {fltregister,
-					    memloc,
-					    weight,
-					    sync,
-					    commit}
-				 => case (shouldCommit memloc,
-					  shouldRemove memloc,
-					  shouldDead memloc)
-				      of (true,false,false)
-				       => {fltregister = fltregister, 
-					   memloc = memloc, 
-					   weight = weight, 
-					   sync = sync, 
-					   commit = toCommit commit}
-				       | (false,true,false)
-				       => {fltregister = fltregister, 
-					   memloc = memloc, 
-					   weight = weight, 
-					   sync = sync, 
-					   commit = toRemove commit}
-				       | (false,false,true)
-				       => {fltregister = fltregister, 
-					   memloc = memloc, 
-					   weight = weight, 
-					   sync = true, 
-					   commit = toRemove commit}
-				       | (false,false,false)
-				       => if List.exists
-					     (MemLoc.utilized memloc,
-					      fn memloc' => shouldDead memloc')
-					    then {fltregister = fltregister, 
-						  memloc = memloc, 
-						  weight = weight, 
-						  sync = sync, 
-						  commit = toRemove commit}
-					  else if List.exists
-					          (MemLoc.utilized memloc,
-						   fn memloc' => shouldRemove memloc')
-					    then {fltregister = fltregister, 
-						  memloc = memloc, 
-						  weight = weight, 
-						  sync = sync, 
-						  commit = toCommit commit}
-					    else value
-				       | _ => Error.bug "commit",
-			  registerAllocation = registerAllocation}
+            val registerAllocation
+              = fltvalueMap {map 
+                             = fn value as {fltregister,
+                                            memloc,
+                                            weight,
+                                            sync,
+                                            commit}
+                                 => case (shouldCommit memloc,
+                                          shouldRemove memloc,
+                                          shouldDead memloc)
+                                      of (true,false,false)
+                                       => {fltregister = fltregister, 
+                                           memloc = memloc, 
+                                           weight = weight, 
+                                           sync = sync, 
+                                           commit = toCommit commit}
+                                       | (false,true,false)
+                                       => {fltregister = fltregister, 
+                                           memloc = memloc, 
+                                           weight = weight, 
+                                           sync = sync, 
+                                           commit = toRemove commit}
+                                       | (false,false,true)
+                                       => {fltregister = fltregister, 
+                                           memloc = memloc, 
+                                           weight = weight, 
+                                           sync = true, 
+                                           commit = toRemove commit}
+                                       | (false,false,false)
+                                       => if List.exists
+                                             (MemLoc.utilized memloc,
+                                              fn memloc' => shouldDead memloc')
+                                            then {fltregister = fltregister, 
+                                                  memloc = memloc, 
+                                                  weight = weight, 
+                                                  sync = sync, 
+                                                  commit = toRemove commit}
+                                          else if List.exists
+                                                  (MemLoc.utilized memloc,
+                                                   fn memloc' => shouldRemove memloc')
+                                            then {fltregister = fltregister, 
+                                                  memloc = memloc, 
+                                                  weight = weight, 
+                                                  sync = sync, 
+                                                  commit = toCommit commit}
+                                            else value
+                                       | _ => Error.bug "x86AllocateRegisters.RegisterAllocation.force",
+                          registerAllocation = registerAllocation}
 
-	    val {assembly = assembly_commit_fltregisters,
-		 registerAllocation, 
-		 ...}
-	      = commitFltRegisters {info = info,
-				    supports = [],
-				    saves = [],
-				    registerAllocation 
-				    = registerAllocation}
+            val {assembly = assembly_commit_fltregisters,
+                 registerAllocation, 
+                 ...}
+              = commitFltRegisters {info = info,
+                                    supports = [],
+                                    saves = [],
+                                    registerAllocation 
+                                    = registerAllocation}
 
-	    val registerAllocation
-	      = valueMap {map 
-			  = fn value as {register,
-					 memloc,
-					 weight,
-					 sync,
-					 commit}
-			     => case (shouldCommit memloc,
-				      shouldRemove memloc,
-				      shouldDead memloc)
-				  of (true,false,false)
-				   => {register = register, 
-				       memloc = memloc, 
-				       weight = weight, 
-				       sync = sync, 
-				       commit = toCommit commit}
-				   | (false,true,false)
-				   => {register = register, 
-				       memloc = memloc, 
-				       weight = weight, 
-				       sync = sync, 
-				       commit = toRemove commit}
-				   | (false,false,true)
-				   => value
-				   | (false,false,false)
-				   => if List.exists
-	                                 (MemLoc.utilized memloc,
-					  fn memloc' => shouldDead memloc')
-					then {register = register, 
-					      memloc = memloc, 
-					      weight = weight, 
-					      sync = sync, 
-					      commit = toRemove commit}
-				      else if List.exists
-					      (MemLoc.utilized memloc,
-					       fn memloc' => shouldRemove memloc')
-					then {register = register, 
-					      memloc = memloc, 
-					      weight = weight, 
-					      sync = sync, 
-					      commit = toCommit commit}
-					else value
-				   | _ => Error.bug "commit",
-			  registerAllocation = registerAllocation}
+            val registerAllocation
+              = valueMap {map 
+                          = fn value as {register,
+                                         memloc,
+                                         weight,
+                                         sync,
+                                         commit}
+                             => case (shouldCommit memloc,
+                                      shouldRemove memloc,
+                                      shouldDead memloc)
+                                  of (true,false,false)
+                                   => {register = register, 
+                                       memloc = memloc, 
+                                       weight = weight, 
+                                       sync = sync, 
+                                       commit = toCommit commit}
+                                   | (false,true,false)
+                                   => {register = register, 
+                                       memloc = memloc, 
+                                       weight = weight, 
+                                       sync = sync, 
+                                       commit = toRemove commit}
+                                   | (false,false,true)
+                                   => value
+                                   | (false,false,false)
+                                   => if List.exists
+                                         (MemLoc.utilized memloc,
+                                          fn memloc' => shouldDead memloc')
+                                        then {register = register, 
+                                              memloc = memloc, 
+                                              weight = weight, 
+                                              sync = sync, 
+                                              commit = toRemove commit}
+                                      else if List.exists
+                                              (MemLoc.utilized memloc,
+                                               fn memloc' => shouldRemove memloc')
+                                        then {register = register, 
+                                              memloc = memloc, 
+                                              weight = weight, 
+                                              sync = sync, 
+                                              commit = toCommit commit}
+                                        else value
+                                   | _ => Error.bug "x86AllocateRegisters.RegisterAllocation.force",
+                          registerAllocation = registerAllocation}
 
-	    val {assembly = assembly_commit_registers,
-		 registerAllocation}
-	      = commitRegisters {info = info,
-				 supports = [],
-				 saves = [],
-				 registerAllocation 
-				 = registerAllocation}
+            val {assembly = assembly_commit_registers,
+                 registerAllocation}
+              = commitRegisters {info = info,
+                                 supports = [],
+                                 saves = [],
+                                 registerAllocation 
+                                 = registerAllocation}
 
-	    val registerAllocation
-	      = valueMap {map 
-			  = fn value as {register,
-					 memloc,
-					 weight,
-					 commit,
-					 ...}
-			     => if shouldDead memloc
-				  then {register = register, 
-					memloc = memloc, 
-					weight = weight, 
-					sync = true, 
-					commit = toRemove commit}
-				  else value,
-			  registerAllocation = registerAllocation}
+            val registerAllocation
+              = valueMap {map 
+                          = fn value as {register,
+                                         memloc,
+                                         weight,
+                                         commit,
+                                         ...}
+                             => if shouldDead memloc
+                                  then {register = register, 
+                                        memloc = memloc, 
+                                        weight = weight, 
+                                        sync = true, 
+                                        commit = toRemove commit}
+                                  else value,
+                          registerAllocation = registerAllocation}
 
-	    val {assembly = assembly_dead_registers,
-		 registerAllocation}
-	      = commitRegisters {info = info,
-				 supports = [],
-				 saves = [],
-				 registerAllocation 
-				 = registerAllocation}
-	  in
-	    {assembly = AppendList.appends
-	                [assembly_commit_fltregisters,
-			 assembly_commit_registers,
-			 assembly_dead_registers],
-	     registerAllocation = registerAllocation}
-	  end
+            val {assembly = assembly_dead_registers,
+                 registerAllocation}
+              = commitRegisters {info = info,
+                                 supports = [],
+                                 saves = [],
+                                 registerAllocation 
+                                 = registerAllocation}
+          in
+            {assembly = AppendList.appends
+                        [assembly_commit_fltregisters,
+                         assembly_commit_registers,
+                         assembly_dead_registers],
+             registerAllocation = registerAllocation}
+          end
 
       fun ccall {info: Liveness.t,
-		 registerAllocation: t}
-	= let
-	    val cstaticClasses = !x86MLton.Classes.cstaticClasses
+                 registerAllocation: t}
+        = let
+            val cstaticClasses = !x86MLton.Classes.cstaticClasses
 
-	    val {reserved = reservedStart, ...} = registerAllocation
+            val {reserved = reservedStart, ...} = registerAllocation
 
-	    val {assembly = assembly_reserve,
-		 registerAllocation}
-	      = List.fold
-	        (Register.callerSaveRegisters,
-		 {assembly = AppendList.empty, 
-		  registerAllocation = registerAllocation},
-		 fn (register, {assembly, registerAllocation})
-		  => let
-		       val {assembly = assembly_reserve,
-			    registerAllocation}
-			 = reserve' {register = register,
-				     registerAllocation = registerAllocation}
-		     in
-		       {assembly = AppendList.append (assembly,
-						      assembly_reserve),
-			registerAllocation = registerAllocation}
-		     end)
+            val {assembly = assembly_reserve,
+                 registerAllocation}
+              = List.fold
+                (Register.callerSaveRegisters,
+                 {assembly = AppendList.empty, 
+                  registerAllocation = registerAllocation},
+                 fn (register, {assembly, registerAllocation})
+                  => let
+                       val {assembly = assembly_reserve,
+                            registerAllocation}
+                         = reserve' {register = register,
+                                     registerAllocation = registerAllocation}
+                     in
+                       {assembly = AppendList.append (assembly,
+                                                      assembly_reserve),
+                        registerAllocation = registerAllocation}
+                     end)
 
-	    val {assembly = assembly_shuffle,
-		 registerAllocation, ...}
-	      = if !Control.Native.shuffle then 
-	        List.fold
-	        (valueFilter {filter = fn {register, ...}
-			                => List.contains
-			                   (Register.callerSaveRegisters,
-					    register,
-					    Register.eq),
-			      registerAllocation = registerAllocation},
-		 {assembly = AppendList.empty, 
-		  registerAllocation = registerAllocation,
-		  saves = []},
-		 fn ({memloc, ...}, {assembly, registerAllocation, saves})
-		  => let
-		       val {assembly = assembly_shuffle,
-			    registerAllocation, ...} 
-			 = allocateOperand {operand = Operand.memloc memloc,
-					    options = {register = true,
-						       immediate = false,
-						       label = false,
-						       address = true},
-					    info = info,
-					    size = MemLoc.size memloc,
-					    move = true,
-					    supports = [],
-					    saves = saves,
-					    force = Register.calleeSaveRegisters,
-					    registerAllocation
-					    = registerAllocation}
-		     in
-		       {assembly = AppendList.append (assembly,
-						      assembly_shuffle),
-			registerAllocation = registerAllocation,
-			saves = saves}
-		     end)
-		else {assembly = AppendList.empty,
-		      registerAllocation = registerAllocation,
-		      saves = []}
+            val {assembly = assembly_shuffle,
+                 registerAllocation, ...}
+              = if !Control.Native.shuffle then 
+                List.fold
+                (valueFilter {filter = fn {register, ...}
+                                        => List.contains
+                                           (Register.callerSaveRegisters,
+                                            register,
+                                            Register.eq),
+                              registerAllocation = registerAllocation},
+                 {assembly = AppendList.empty, 
+                  registerAllocation = registerAllocation,
+                  saves = []},
+                 fn ({memloc, ...}, {assembly, registerAllocation, saves})
+                  => let
+                       val {assembly = assembly_shuffle,
+                            registerAllocation, ...} 
+                         = allocateOperand {operand = Operand.memloc memloc,
+                                            options = {register = true,
+                                                       immediate = false,
+                                                       label = false,
+                                                       address = true},
+                                            info = info,
+                                            size = MemLoc.size memloc,
+                                            move = true,
+                                            supports = [],
+                                            saves = saves,
+                                            force = Register.calleeSaveRegisters,
+                                            registerAllocation
+                                            = registerAllocation}
+                     in
+                       {assembly = AppendList.append (assembly,
+                                                      assembly_shuffle),
+                        registerAllocation = registerAllocation,
+                        saves = saves}
+                     end)
+                else {assembly = AppendList.empty,
+                      registerAllocation = registerAllocation,
+                      saves = []}
 
-	    val registerAllocation
-	      = valueMap {map = fn value as {register,
-					     memloc,
-					     weight,
-					     sync,
-					     ...}
-				 => if List.contains
-			               (Register.callerSaveRegisters,
-					register,
-					Register.eq)
-				       orelse
-				       ClassSet.contains
-				       (cstaticClasses,
-					MemLoc.class memloc)
-				      then {register = register, 
-					    memloc = memloc, 
-					    weight = weight, 
-					    sync = sync, 
-					    commit = REMOVE 0}
-				      else value,
-			  registerAllocation = registerAllocation}
+            val registerAllocation
+              = valueMap {map = fn value as {register,
+                                             memloc,
+                                             weight,
+                                             sync,
+                                             ...}
+                                 => if List.contains
+                                       (Register.callerSaveRegisters,
+                                        register,
+                                        Register.eq)
+                                       orelse
+                                       ClassSet.contains
+                                       (cstaticClasses,
+                                        MemLoc.class memloc)
+                                      then {register = register, 
+                                            memloc = memloc, 
+                                            weight = weight, 
+                                            sync = sync, 
+                                            commit = REMOVE 0}
+                                      else value,
+                          registerAllocation = registerAllocation}
 
-	    val registerAllocation
-	      = fltvalueMap {map = fn {fltregister,
-				       memloc,
-				       weight,
-				       sync,
-				       ...}
-			            => {fltregister = fltregister, 
-					memloc = memloc, 
-					weight = weight, 
-					sync = sync, 
-					commit = REMOVE 0},
-			     registerAllocation = registerAllocation}
+            val registerAllocation
+              = fltvalueMap {map = fn {fltregister,
+                                       memloc,
+                                       weight,
+                                       sync,
+                                       ...}
+                                    => {fltregister = fltregister, 
+                                        memloc = memloc, 
+                                        weight = weight, 
+                                        sync = sync, 
+                                        commit = REMOVE 0},
+                             registerAllocation = registerAllocation}
 
-	    val {assembly = assembly_commit_fltregisters,
-		 registerAllocation, ...}
-	      = commitFltRegisters {info = info,
-				    supports = [],
-				    saves = [],
-				    registerAllocation = registerAllocation}
+            val {assembly = assembly_commit_fltregisters,
+                 registerAllocation, ...}
+              = commitFltRegisters {info = info,
+                                    supports = [],
+                                    saves = [],
+                                    registerAllocation = registerAllocation}
 
-	    val {assembly = assembly_commit_registers,
-		 registerAllocation}
-	      = commitRegisters {info = info,
-				 supports = [],
-				 saves = [],
-				 registerAllocation = registerAllocation}
+            val {assembly = assembly_commit_registers,
+                 registerAllocation}
+              = commitRegisters {info = info,
+                                 supports = [],
+                                 saves = [],
+                                 registerAllocation = registerAllocation}
 
-	    val {assembly = assembly_unreserve,
-		 registerAllocation}
-	      = List.fold
-	        (List.removeAll
-		 (Register.callerSaveRegisters,
-		  fn register => List.contains(reservedStart, register, Register.eq)),
-		 {assembly = AppendList.empty, 
-		  registerAllocation = registerAllocation},
-		 fn (register, {assembly, registerAllocation})
-		  => let
-		       val {assembly = assembly_unreserve,
-			    registerAllocation}
-			 = unreserve' {register = register,
-				       registerAllocation = registerAllocation}
-		     in
-		       {assembly = AppendList.append (assembly,
-						      assembly_unreserve),
-			registerAllocation = registerAllocation}
-		     end)
+            val {assembly = assembly_unreserve,
+                 registerAllocation}
+              = List.fold
+                (List.removeAll
+                 (Register.callerSaveRegisters,
+                  fn register => List.contains(reservedStart, register, Register.eq)),
+                 {assembly = AppendList.empty, 
+                  registerAllocation = registerAllocation},
+                 fn (register, {assembly, registerAllocation})
+                  => let
+                       val {assembly = assembly_unreserve,
+                            registerAllocation}
+                         = unreserve' {register = register,
+                                       registerAllocation = registerAllocation}
+                     in
+                       {assembly = AppendList.append (assembly,
+                                                      assembly_unreserve),
+                        registerAllocation = registerAllocation}
+                     end)
 
-	    val registerAllocation
-	      = deletes {registers = Register.callerSaveRegisters,
-			 registerAllocation = registerAllocation}
-	  in
-	    {assembly = AppendList.appends
-	                [assembly_reserve,
-			 assembly_shuffle,
-			 assembly_commit_registers,
-			 assembly_commit_fltregisters,
-			 assembly_unreserve],
-	     registerAllocation = registerAllocation}
-	  end
+            val registerAllocation
+              = deletes {registers = Register.callerSaveRegisters,
+                         registerAllocation = registerAllocation}
+          in
+            {assembly = AppendList.appends
+                        [assembly_reserve,
+                         assembly_shuffle,
+                         assembly_commit_registers,
+                         assembly_commit_fltregisters,
+                         assembly_unreserve],
+             registerAllocation = registerAllocation}
+          end
 
       fun return {returns: {src: Operand.t, dst: MemLoc.t} list,
-		  info: Liveness.t,
-		  registerAllocation: t} =
-	 let
-	    val killed_values =
-	       valueFilter {filter = fn {memloc, ...} =>
-			    List.exists
-			    (returns, fn {dst = return_memloc, ...} =>
-			     List.exists(MemLoc.utilized memloc,
-					 fn memloc' =>
-					 MemLoc.eq(memloc', return_memloc))
-			     orelse
-			     MemLoc.mayAlias(return_memloc, memloc)),
-			    registerAllocation = registerAllocation}
-	    val killed_memlocs = List.revMap(killed_values, #memloc)
+                  info: Liveness.t,
+                  registerAllocation: t} =
+         let
+            val killed_values =
+               valueFilter {filter = fn {memloc, ...} =>
+                            List.exists
+                            (returns, fn {dst = return_memloc, ...} =>
+                             List.exists(MemLoc.utilized memloc,
+                                         fn memloc' =>
+                                         MemLoc.eq(memloc', return_memloc))
+                             orelse
+                             MemLoc.mayAlias(return_memloc, memloc)),
+                            registerAllocation = registerAllocation}
+            val killed_memlocs = List.revMap(killed_values, #memloc)
 
-	    val registerAllocation =
-	       removes {memlocs = killed_memlocs,
-			registerAllocation = registerAllocation}
+            val registerAllocation =
+               removes {memlocs = killed_memlocs,
+                        registerAllocation = registerAllocation}
 
-	    val registerAllocation =
-	       List.fold
-	       (returns, registerAllocation, fn ({src = operand, 
-						  dst = return_memloc}, registerAllocation) =>
-		case operand of
-		   Operand.Register return_register =>
-		      update {value = {register = return_register,
-				       memloc = return_memloc,
-				       weight = 1024,
-				       sync = false,
-				       commit = NO},
-			      registerAllocation = registerAllocation}
-	         | Operand.FltRegister return_register => 
-		      #registerAllocation
-		      (fltpush {value = {fltregister = return_register,
-					 memloc = return_memloc,
-					 weight = 1024,
-					 sync = false,
-					 commit = NO},
-				registerAllocation = registerAllocation})
-		 | _ => Error.bug "return")
+            val registerAllocation =
+               List.fold
+               (returns, registerAllocation, fn ({src = operand, 
+                                                  dst = return_memloc}, registerAllocation) =>
+                case operand of
+                   Operand.Register return_register =>
+                      update {value = {register = return_register,
+                                       memloc = return_memloc,
+                                       weight = 1024,
+                                       sync = false,
+                                       commit = NO},
+                              registerAllocation = registerAllocation}
+                 | Operand.FltRegister return_register => 
+                      #registerAllocation
+                      (fltpush {value = {fltregister = return_register,
+                                         memloc = return_memloc,
+                                         weight = 1024,
+                                         sync = false,
+                                         commit = NO},
+                                registerAllocation = registerAllocation})
+                 | _ => Error.bug "x86AllocateRegisters.RegisterAllocation.return")
 
-	    val (final_defs, defs) =
-	       List.fold
-	       (returns, ([],[]), fn ({src,dst},(final_defs,defs)) =>
-		(src::final_defs,(Operand.memloc dst)::defs))
-	    val {assembly = assembly_post,
-		 registerAllocation}
-	      = post {uses = [],
-		      final_uses = [],
-		      defs = defs,
-		      final_defs = final_defs,
-		      kills = [],
-		      info = info,
-		      registerAllocation = registerAllocation}
-	  in
-	    {assembly = assembly_post,
-	     registerAllocation = registerAllocation}
-	  end
+            val (final_defs, defs) =
+               List.fold
+               (returns, ([],[]), fn ({src,dst},(final_defs,defs)) =>
+                (src::final_defs,(Operand.memloc dst)::defs))
+            val {assembly = assembly_post,
+                 registerAllocation}
+              = post {uses = [],
+                      final_uses = [],
+                      defs = defs,
+                      final_defs = final_defs,
+                      kills = [],
+                      info = info,
+                      registerAllocation = registerAllocation}
+          in
+            {assembly = assembly_post,
+             registerAllocation = registerAllocation}
+          end
 
 (*
       fun return {memloc = return_memloc,
-		  info: Liveness.t,
-		  registerAllocation: t}
-	= let
-	    val killed_values
-	      = valueFilter {filter = fn value as {memloc,...}
-			               => List.exists
-			                  (MemLoc.utilized memloc,
-					   fn memloc'
-					    => MemLoc.eq(memloc',
-							 return_memloc))
-					  orelse
-					  MemLoc.mayAlias(return_memloc,
-							  memloc),
-			     registerAllocation = registerAllocation}
-	    val killed_memlocs = List.revMap(killed_values, #memloc)
+                  info: Liveness.t,
+                  registerAllocation: t}
+        = let
+            val killed_values
+              = valueFilter {filter = fn value as {memloc,...}
+                                       => List.exists
+                                          (MemLoc.utilized memloc,
+                                           fn memloc'
+                                            => MemLoc.eq(memloc',
+                                                         return_memloc))
+                                          orelse
+                                          MemLoc.mayAlias(return_memloc,
+                                                          memloc),
+                             registerAllocation = registerAllocation}
+            val killed_memlocs = List.revMap(killed_values, #memloc)
 
-	    val registerAllocation
-	      = removes {memlocs = killed_memlocs,
-			 registerAllocation = registerAllocation}
+            val registerAllocation
+              = removes {memlocs = killed_memlocs,
+                         registerAllocation = registerAllocation}
 
-	    val return_register = Register.return (MemLoc.size return_memloc)
-	    val registerAllocation
-	      = update
+            val return_register = Register.return (MemLoc.size return_memloc)
+            val registerAllocation
+              = update
                 {value = {register = return_register,
-			  memloc = return_memloc,
-			  weight = 1024,
-			  sync = false,
-			  commit = NO},
-		 registerAllocation = registerAllocation}
+                          memloc = return_memloc,
+                          weight = 1024,
+                          sync = false,
+                          commit = NO},
+                 registerAllocation = registerAllocation}
 
-	    val {assembly = assembly_post,
-		 registerAllocation}
-	      = post {uses = [],
-		      final_uses = [],
-		      defs = [Operand.memloc return_memloc],
-		      final_defs = [Operand.register return_register],
-		      kills = [],
-		      info = info,
-		      registerAllocation = registerAllocation}
-	  in
-	    {assembly = assembly_post,
-	     registerAllocation = registerAllocation}
-	  end
+            val {assembly = assembly_post,
+                 registerAllocation}
+              = post {uses = [],
+                      final_uses = [],
+                      defs = [Operand.memloc return_memloc],
+                      final_defs = [Operand.register return_register],
+                      kills = [],
+                      info = info,
+                      registerAllocation = registerAllocation}
+          in
+            {assembly = assembly_post,
+             registerAllocation = registerAllocation}
+          end
 
       fun fltreturn {memloc = return_memloc,
-		     info: Liveness.t,
-		     registerAllocation: t}
-	= let
-	    val return_register = FltRegister.return
+                     info: Liveness.t,
+                     registerAllocation: t}
+        = let
+            val return_register = FltRegister.return
 
-	    val {fltrename = fltrename_push,
-		 registerAllocation}
-	      = fltpush
+            val {fltrename = fltrename_push,
+                 registerAllocation}
+              = fltpush
                 {value = {fltregister = return_register,
-			  memloc = return_memloc,
-			  weight = 1024,
-			  sync = false,
-			  commit = NO},
-		 registerAllocation = registerAllocation}
+                          memloc = return_memloc,
+                          weight = 1024,
+                          sync = false,
+                          commit = NO},
+                 registerAllocation = registerAllocation}
 
-	    val {assembly = assembly_post,
-		 registerAllocation}
-	      = post {uses = [],
-		      final_uses = [],
-		      defs = [Operand.memloc return_memloc],
-		      final_defs = [Operand.fltregister return_register],
-		      kills = [],
-		      info = info,
-		      registerAllocation = registerAllocation}
+            val {assembly = assembly_post,
+                 registerAllocation}
+              = post {uses = [],
+                      final_uses = [],
+                      defs = [Operand.memloc return_memloc],
+                      final_defs = [Operand.fltregister return_register],
+                      kills = [],
+                      info = info,
+                      registerAllocation = registerAllocation}
 
-	  in
-	    {assembly = assembly_post,
-	     registerAllocation = registerAllocation}
-	  end
+          in
+            {assembly = assembly_post,
+             registerAllocation = registerAllocation}
+          end
 *)
 
       fun clearflt {info: Liveness.t,
-		    registerAllocation: t}
-	= let
-	    val registerAllocation
-	      = fltvalueMap {map = fn {fltregister,
-				       memloc,
-				       weight,
-				       sync,
-				       ...}
-			            => {fltregister = fltregister, 
-					memloc = memloc, 
-					weight = weight, 
-					sync = sync, 
-					commit = REMOVE 0},
-			     registerAllocation = registerAllocation}
+                    registerAllocation: t}
+        = let
+            val registerAllocation
+              = fltvalueMap {map = fn {fltregister,
+                                       memloc,
+                                       weight,
+                                       sync,
+                                       ...}
+                                    => {fltregister = fltregister, 
+                                        memloc = memloc, 
+                                        weight = weight, 
+                                        sync = sync, 
+                                        commit = REMOVE 0},
+                             registerAllocation = registerAllocation}
 
-	    val {assembly = assembly_commit_fltregisters,
-		 registerAllocation,
-		 ...}
-	      = commitFltRegisters {info = info,
-				    supports = [],
-				    saves = [],
-				    registerAllocation = registerAllocation}
-	  in
-	    {assembly = assembly_commit_fltregisters,
-	     registerAllocation = registerAllocation}
-	  end
+            val {assembly = assembly_commit_fltregisters,
+                 registerAllocation,
+                 ...}
+              = commitFltRegisters {info = info,
+                                    supports = [],
+                                    saves = [],
+                                    registerAllocation = registerAllocation}
+          in
+            {assembly = assembly_commit_fltregisters,
+             registerAllocation = registerAllocation}
+          end
 
       fun saveregalloc ({id, registerAllocation, ...}: 
-			{live: MemLocSet.t,
-			 id: Directive.Id.t,
-			 info: Liveness.t,
-			 registerAllocation: t})
-	= let
-	    val _ = setRA(id, {registerAllocation = registerAllocation})
-	  in
-	    {assembly = if !Control.Native.commented > 2
-			  then (toComments registerAllocation)
-			  else AppendList.empty,
-	     registerAllocation = registerAllocation}
-	  end
+                        {live: MemLocSet.t,
+                         id: Directive.Id.t,
+                         info: Liveness.t,
+                         registerAllocation: t})
+        = let
+            val _ = setRA(id, {registerAllocation = registerAllocation})
+          in
+            {assembly = if !Control.Native.commented > 2
+                          then (toComments registerAllocation)
+                          else AppendList.empty,
+             registerAllocation = registerAllocation}
+          end
 
       fun restoreregalloc ({live, id, info, ...}: 
-			   {live: MemLocSet.t,
-			    id: Directive.Id.t,
-			    info: Liveness.t,
-			    registerAllocation: t})
-	= let
-	    val {registerAllocation} = getRA id
+                           {live: MemLocSet.t,
+                            id: Directive.Id.t,
+                            info: Liveness.t,
+                            registerAllocation: t})
+        = let
+            val {registerAllocation} = getRA id
 
-	    fun dump memloc
-	      = (track memloc) andalso 
-	        not (MemLocSet.contains(live,memloc))
+            fun dump memloc
+              = (track memloc) andalso 
+                not (MemLocSet.contains(live,memloc))
 
-	    val registerAllocation
-	      = fltvalueMap
-	        {map = fn value as {fltregister,
-				    memloc,
-				    weight,
-				    sync,
-				    ...}
-		        => if dump memloc
-			     then {fltregister = fltregister,
-				   memloc = memloc,
-				   weight = weight,
-				   sync = true,
-				   commit = TRYREMOVE 0}
-			   else if List.exists(MemLoc.utilized memloc, dump)
-			      then {fltregister = fltregister,
-				    memloc = memloc,
-				    weight = weight,
-				    sync = sync,
-				    commit = TRYREMOVE 0}
-			   else value,
-		 registerAllocation = registerAllocation}
+            val registerAllocation
+              = fltvalueMap
+                {map = fn value as {fltregister,
+                                    memloc,
+                                    weight,
+                                    sync,
+                                    ...}
+                        => if dump memloc
+                             then {fltregister = fltregister,
+                                   memloc = memloc,
+                                   weight = weight,
+                                   sync = true,
+                                   commit = TRYREMOVE 0}
+                           else if List.exists(MemLoc.utilized memloc, dump)
+                              then {fltregister = fltregister,
+                                    memloc = memloc,
+                                    weight = weight,
+                                    sync = sync,
+                                    commit = TRYREMOVE 0}
+                           else value,
+                 registerAllocation = registerAllocation}
 
-	    val {assembly = assembly_commit_fltregisters,
-		 registerAllocation,
-		 ...}
-	      = commitFltRegisters {info = info,
-				    supports = [],
-				    saves = [],
-				    registerAllocation = registerAllocation}
+            val {assembly = assembly_commit_fltregisters,
+                 registerAllocation,
+                 ...}
+              = commitFltRegisters {info = info,
+                                    supports = [],
+                                    saves = [],
+                                    registerAllocation = registerAllocation}
 
-	    val registerAllocation
-	      = valueMap
-	        {map = fn value as {register,
-				    memloc,
-				    weight,
-				    sync,
-				    ...}
-		        => if dump memloc
-			     then {register = register,
-				   memloc = memloc,
-				   weight = weight,
-				   sync = true,
-				   commit = TRYREMOVE 0}
-			   else if List.exists(MemLoc.utilized memloc, dump)
-			      then {register = register,
-				    memloc = memloc,
-				    weight = weight,
-				    sync = sync,
-				    commit = TRYREMOVE 0}
-			   else value,
-		 registerAllocation = registerAllocation}
+            val registerAllocation
+              = valueMap
+                {map = fn value as {register,
+                                    memloc,
+                                    weight,
+                                    sync,
+                                    ...}
+                        => if dump memloc
+                             then {register = register,
+                                   memloc = memloc,
+                                   weight = weight,
+                                   sync = true,
+                                   commit = TRYREMOVE 0}
+                           else if List.exists(MemLoc.utilized memloc, dump)
+                              then {register = register,
+                                    memloc = memloc,
+                                    weight = weight,
+                                    sync = sync,
+                                    commit = TRYREMOVE 0}
+                           else value,
+                 registerAllocation = registerAllocation}
 
-	    val {assembly = assembly_commit_registers,
-		 registerAllocation,
-		 ...}
-	      = commitRegisters {info = info,
-				 supports = [],
-				 saves = [],
-				 registerAllocation = registerAllocation}
-	  in
-	    {assembly = AppendList.append (assembly_commit_fltregisters,
-					   assembly_commit_registers),
-	     registerAllocation = registerAllocation}
-	  end
+            val {assembly = assembly_commit_registers,
+                 registerAllocation,
+                 ...}
+              = commitRegisters {info = info,
+                                 supports = [],
+                                 saves = [],
+                                 registerAllocation = registerAllocation}
+          in
+            {assembly = AppendList.append (assembly_commit_fltregisters,
+                                           assembly_commit_registers),
+             registerAllocation = registerAllocation}
+          end
     end
 
   structure Instruction =
@@ -6190,229 +6173,229 @@
        *      add  X
        *)
       fun allocateSrcDst {src: Operand.t,
-			  dst: Operand.t,
-			  move_dst: bool,
-			  size: Size.t,
-			  info as {dead, remove, ...}: Liveness.t,
-			  registerAllocation: RegisterAllocation.t}
-	= if Operand.eq(src, dst)
-	    then let
-		   val {operand = final_src_dst, 
-			assembly = assembly_src_dst,
-			registerAllocation}
-		     = RA.allocateOperand 
-		       {operand = src,
-			options = {register = true,
-				   immediate = false,
-				   label = false,
-				   address = false},
-			info = info,
-			size = size,
-			move = true,
-			supports = [],
-			saves = [],
-			force = [],
-			registerAllocation 
-			= registerAllocation}
-		 in
-		   {final_src = final_src_dst,
-		    final_dst = final_src_dst,
-		    assembly_src_dst = assembly_src_dst,
-		    registerAllocation = registerAllocation}
-		 end
-	    else case (src, dst)
-		   of (Operand.MemLoc _,
-		       Operand.MemLoc memloc_dst)
-		    => if MemLocSet.contains(dead,
-					     memloc_dst)
-		          orelse
-			  MemLocSet.contains(remove,
-					     memloc_dst)
-			 then let
-				val {operand = final_dst,
-				     assembly = assembly_dst,
-				     registerAllocation}
-				  = RA.allocateOperand 
-				    {operand = dst,
-				     options = {register = true,
-						immediate = false,
-						label = false,
-						address = true},
-				     info = info,
-				     size = size,
-				     move = move_dst,
-				     supports = [src],
-				     saves = [],
-				     force = [],
-				     registerAllocation 
-				     = registerAllocation}
+                          dst: Operand.t,
+                          move_dst: bool,
+                          size: Size.t,
+                          info as {dead, remove, ...}: Liveness.t,
+                          registerAllocation: RegisterAllocation.t}
+        = if Operand.eq(src, dst)
+            then let
+                   val {operand = final_src_dst, 
+                        assembly = assembly_src_dst,
+                        registerAllocation}
+                     = RA.allocateOperand 
+                       {operand = src,
+                        options = {register = true,
+                                   immediate = false,
+                                   label = false,
+                                   address = false},
+                        info = info,
+                        size = size,
+                        move = true,
+                        supports = [],
+                        saves = [],
+                        force = [],
+                        registerAllocation 
+                        = registerAllocation}
+                 in
+                   {final_src = final_src_dst,
+                    final_dst = final_src_dst,
+                    assembly_src_dst = assembly_src_dst,
+                    registerAllocation = registerAllocation}
+                 end
+            else case (src, dst)
+                   of (Operand.MemLoc _,
+                       Operand.MemLoc memloc_dst)
+                    => if MemLocSet.contains(dead,
+                                             memloc_dst)
+                          orelse
+                          MemLocSet.contains(remove,
+                                             memloc_dst)
+                         then let
+                                val {operand = final_dst,
+                                     assembly = assembly_dst,
+                                     registerAllocation}
+                                  = RA.allocateOperand 
+                                    {operand = dst,
+                                     options = {register = true,
+                                                immediate = false,
+                                                label = false,
+                                                address = true},
+                                     info = info,
+                                     size = size,
+                                     move = move_dst,
+                                     supports = [src],
+                                     saves = [],
+                                     force = [],
+                                     registerAllocation 
+                                     = registerAllocation}
 
-				val options_src
-				  = case final_dst
-				      of Operand.Register _
-				       => {register = true,
-					   immediate = true,
-					   label = false,
-					   address = true}
-				       | _ 
-				       => {register = true,
-					   immediate = true,
-					   label = false,
-					   address = false}
+                                val options_src
+                                  = case final_dst
+                                      of Operand.Register _
+                                       => {register = true,
+                                           immediate = true,
+                                           label = false,
+                                           address = true}
+                                       | _ 
+                                       => {register = true,
+                                           immediate = true,
+                                           label = false,
+                                           address = false}
  
-				val {operand = final_src, 
-				     assembly = assembly_src,
-				     registerAllocation}
-				  = RA.allocateOperand 
-				    {operand = src,
-				     options = options_src,
-				     info = info,
-				     size = size,
-				     move = true,
-				     supports = [],
-				     saves = [dst,final_dst],
-				     force = [],
-				     registerAllocation 
-				     = registerAllocation}
-			      in
-				{final_src = final_src,
-				 final_dst = final_dst,
-				 assembly_src_dst 
-				 = AppendList.appends 
-				   [assembly_dst,
-				    assembly_src],
-				 registerAllocation = registerAllocation}
-			      end
- 			 else let
-				val {operand = final_src, 
-				     assembly = assembly_src,
-				     registerAllocation}
-				  = RA.allocateOperand 
-				    {operand = src,
-				     options = {register = true,
-						immediate = true,
-						label = false,
-						address = true},
-				     info = info,
-				     size = size,
-				     move = true,
-				     supports = [dst],
-				     saves = [],
-				     force = [],
-				     registerAllocation 
-				     = registerAllocation}
+                                val {operand = final_src, 
+                                     assembly = assembly_src,
+                                     registerAllocation}
+                                  = RA.allocateOperand 
+                                    {operand = src,
+                                     options = options_src,
+                                     info = info,
+                                     size = size,
+                                     move = true,
+                                     supports = [],
+                                     saves = [dst,final_dst],
+                                     force = [],
+                                     registerAllocation 
+                                     = registerAllocation}
+                              in
+                                {final_src = final_src,
+                                 final_dst = final_dst,
+                                 assembly_src_dst 
+                                 = AppendList.appends 
+                                   [assembly_dst,
+                                    assembly_src],
+                                 registerAllocation = registerAllocation}
+                              end
+                         else let
+                                val {operand = final_src, 
+                                     assembly = assembly_src,
+                                     registerAllocation}
+                                  = RA.allocateOperand 
+                                    {operand = src,
+                                     options = {register = true,
+                                                immediate = true,
+                                                label = false,
+                                                address = true},
+                                     info = info,
+                                     size = size,
+                                     move = true,
+                                     supports = [dst],
+                                     saves = [],
+                                     force = [],
+                                     registerAllocation 
+                                     = registerAllocation}
 
-				val {operand = final_dst,
-				     assembly = assembly_dst,
-				     registerAllocation}
-				  = RA.allocateOperand 
-				    {operand = dst,
-				     options = {register = true,
-						immediate = false,
-						label = false,
-						address = false},
-				     info = info,
-				     size = size,
-				     move = move_dst,
-				     supports = [],
-				     saves = [src,final_src],
-				     force = [],
-				     registerAllocation 
-				     = registerAllocation}
-			      in
-				{final_src = final_src,
-				 final_dst = final_dst,
-				 assembly_src_dst 
-				 = AppendList.appends 
-				   [assembly_src, 
-				    assembly_dst],
-				 registerAllocation = registerAllocation}
-			      end
-		    | (_,
-		       Operand.MemLoc memloc_dst)
-		    => let
-			 val {operand = final_src, 
-			      assembly = assembly_src,
-			      registerAllocation}
-			   = RA.allocateOperand 
-			     {operand = src,
-			      options = {register = true,
-					 immediate = true,
-					 label = false,
-					 address = false},
-			      info = info,
-			      size = size,
-			      move = true,
-			      supports = [dst],
-			      saves = [],
-			      force = [],
-			      registerAllocation 
-			      = registerAllocation}
+                                val {operand = final_dst,
+                                     assembly = assembly_dst,
+                                     registerAllocation}
+                                  = RA.allocateOperand 
+                                    {operand = dst,
+                                     options = {register = true,
+                                                immediate = false,
+                                                label = false,
+                                                address = false},
+                                     info = info,
+                                     size = size,
+                                     move = move_dst,
+                                     supports = [],
+                                     saves = [src,final_src],
+                                     force = [],
+                                     registerAllocation 
+                                     = registerAllocation}
+                              in
+                                {final_src = final_src,
+                                 final_dst = final_dst,
+                                 assembly_src_dst 
+                                 = AppendList.appends 
+                                   [assembly_src, 
+                                    assembly_dst],
+                                 registerAllocation = registerAllocation}
+                              end
+                    | (_,
+                       Operand.MemLoc memloc_dst)
+                    => let
+                         val {operand = final_src, 
+                              assembly = assembly_src,
+                              registerAllocation}
+                           = RA.allocateOperand 
+                             {operand = src,
+                              options = {register = true,
+                                         immediate = true,
+                                         label = false,
+                                         address = false},
+                              info = info,
+                              size = size,
+                              move = true,
+                              supports = [dst],
+                              saves = [],
+                              force = [],
+                              registerAllocation 
+                              = registerAllocation}
 
-			 fun default ()
-			   = RA.allocateOperand 
-			     {operand = dst,
-			      options = {register = true,
-					 immediate = false,
-					 label = false,
-					 address = true},
-			      info = info,
-			      size = size,
-			      move = move_dst,
-			      supports = [],
-			      saves = [src,final_src],
-			      force = [],
-			      registerAllocation 
-			      = registerAllocation}
-			   
-			 val {operand = final_dst,
-			      assembly = assembly_dst,
-			      registerAllocation}
-			   = if MemLocSet.contains(dead,
-						   memloc_dst)
-			        orelse
-				MemLocSet.contains(remove,
-						   memloc_dst)
-			       then case RA.allocated 
-				         {memloc = memloc_dst,
-					  registerAllocation = registerAllocation}
-				      of SOME {register, sync, ...}
-				       => if sync
-					    then let
-						   val registerAllocation
-						     = RA.delete
-						       {register = register,
-							registerAllocation 
-							= registerAllocation}
-						 in
-						   RA.allocateOperand 
-						   {operand = dst,
-						    options = {register = false,
-							       immediate = false,
-							       label = false,
-							       address = true},
-						    info = info,
-						    size = size,
-						    move = move_dst,
-						    supports = [],
-						    saves = [src,final_src],
-						    force = [],
-						    registerAllocation 
-						    = registerAllocation}
-						 end
-					    else default ()
-				       | NONE => default ()
-			       else default ()
-		       in
-			 {final_src = final_src,
-			  final_dst = final_dst,
-			  assembly_src_dst 
-			  = AppendList.appends 
-			    [assembly_src, 
-			     assembly_dst],
-			  registerAllocation = registerAllocation}
-		       end
-		    | _ => Error.bug "allocateSrcDst"
+                         fun default ()
+                           = RA.allocateOperand 
+                             {operand = dst,
+                              options = {register = true,
+                                         immediate = false,
+                                         label = false,
+                                         address = true},
+                              info = info,
+                              size = size,
+                              move = move_dst,
+                              supports = [],
+                              saves = [src,final_src],
+                              force = [],
+                              registerAllocation 
+                              = registerAllocation}
+                           
+                         val {operand = final_dst,
+                              assembly = assembly_dst,
+                              registerAllocation}
+                           = if MemLocSet.contains(dead,
+                                                   memloc_dst)
+                                orelse
+                                MemLocSet.contains(remove,
+                                                   memloc_dst)
+                               then case RA.allocated 
+                                         {memloc = memloc_dst,
+                                          registerAllocation = registerAllocation}
+                                      of SOME {register, sync, ...}
+                                       => if sync
+                                            then let
+                                                   val registerAllocation
+                                                     = RA.delete
+                                                       {register = register,
+                                                        registerAllocation 
+                                                        = registerAllocation}
+                                                 in
+                                                   RA.allocateOperand 
+                                                   {operand = dst,
+                                                    options = {register = false,
+                                                               immediate = false,
+                                                               label = false,
+                                                               address = true},
+                                                    info = info,
+                                                    size = size,
+                                                    move = move_dst,
+                                                    supports = [],
+                                                    saves = [src,final_src],
+                                                    force = [],
+                                                    registerAllocation 
+                                                    = registerAllocation}
+                                                 end
+                                            else default ()
+                                       | NONE => default ()
+                               else default ()
+                       in
+                         {final_src = final_src,
+                          final_dst = final_dst,
+                          assembly_src_dst 
+                          = AppendList.appends 
+                            [assembly_src, 
+                             assembly_dst],
+                          registerAllocation = registerAllocation}
+                       end
+                    | _ => Error.bug "x86AllocateRegisters.Instruction.allocateSrcDst"
 
       (* 
        * Require src1/src2 operands as follows:
@@ -6425,4174 +6408,4174 @@
        *       add  X   X
        *)
       fun allocateSrc1Src2 {src1: Operand.t,
-			    src2: Operand.t,
-			    size: Size.t,
-			    info: Liveness.t,
-			    registerAllocation: RegisterAllocation.t}
-	= if Operand.eq(src1, src2)
-	    then let
-		   val {operand = final_src1_src2, 
-			assembly = assembly_src1_src2,
-			registerAllocation}
-		     = RA.allocateOperand 
-		       {operand = src1,
-			options = {register = true,
-				   immediate = false,
-				   label = false,
-				   address = false},
-			info = info,
-			size = size,
-			move = true,
-			supports = [],
-			saves = [],
-			force = [],
-			registerAllocation 
-			= registerAllocation}
-		 in
-		   {final_src1 = final_src1_src2,
-		    final_src2 = final_src1_src2,
-		    assembly_src1_src2 = assembly_src1_src2,
-		    registerAllocation = registerAllocation}
-		 end
-	    else let
-		   val {operand = final_src1,
-			assembly = assembly_src1,
-			registerAllocation}
-		     = RA.allocateOperand 
-		       {operand = src1,
-			options = {register = true,
-				   immediate = false,
-				   label = false,
-				   address = true},
-			info = info,
-			size = size,
-			move = true,
-			supports = [src2],
-			saves = [],
-			force = [],
-			registerAllocation 
-			= registerAllocation}
+                            src2: Operand.t,
+                            size: Size.t,
+                            info: Liveness.t,
+                            registerAllocation: RegisterAllocation.t}
+        = if Operand.eq(src1, src2)
+            then let
+                   val {operand = final_src1_src2, 
+                        assembly = assembly_src1_src2,
+                        registerAllocation}
+                     = RA.allocateOperand 
+                       {operand = src1,
+                        options = {register = true,
+                                   immediate = false,
+                                   label = false,
+                                   address = false},
+                        info = info,
+                        size = size,
+                        move = true,
+                        supports = [],
+                        saves = [],
+                        force = [],
+                        registerAllocation 
+                        = registerAllocation}
+                 in
+                   {final_src1 = final_src1_src2,
+                    final_src2 = final_src1_src2,
+                    assembly_src1_src2 = assembly_src1_src2,
+                    registerAllocation = registerAllocation}
+                 end
+            else let
+                   val {operand = final_src1,
+                        assembly = assembly_src1,
+                        registerAllocation}
+                     = RA.allocateOperand 
+                       {operand = src1,
+                        options = {register = true,
+                                   immediate = false,
+                                   label = false,
+                                   address = true},
+                        info = info,
+                        size = size,
+                        move = true,
+                        supports = [src2],
+                        saves = [],
+                        force = [],
+                        registerAllocation 
+                        = registerAllocation}
 
-		   val options_src2
-		     = case final_src1
-			 of Operand.Register _
-			  => {register = true,
-			      immediate = true,
-			      label = false,
-			      address = true}
-			  | _ 
-			  => {register = true,
-			      immediate = true,
-			      label = false,
-			      address = false}
+                   val options_src2
+                     = case final_src1
+                         of Operand.Register _
+                          => {register = true,
+                              immediate = true,
+                              label = false,
+                              address = true}
+                          | _ 
+                          => {register = true,
+                              immediate = true,
+                              label = false,
+                              address = false}
  
-		   val {operand = final_src2, 
-			assembly = assembly_src2,
-			registerAllocation}
-		     = RA.allocateOperand 
-		       {operand = src2,
-			options = options_src2,
-			info = info,
-			size = size,
-			move = true,
-			supports = [],
-			saves = [src1,final_src1],
-			force = [],
-			registerAllocation 
-			= registerAllocation}
-		 in
-		   {final_src1 = final_src1,
-		    final_src2 = final_src2,
-		    assembly_src1_src2 
-		    = AppendList.appends 
-		      [assembly_src1, 
-		       assembly_src2],
-		    registerAllocation = registerAllocation}
-		 end
+                   val {operand = final_src2, 
+                        assembly = assembly_src2,
+                        registerAllocation}
+                     = RA.allocateOperand 
+                       {operand = src2,
+                        options = options_src2,
+                        info = info,
+                        size = size,
+                        move = true,
+                        supports = [],
+                        saves = [src1,final_src1],
+                        force = [],
+                        registerAllocation 
+                        = registerAllocation}
+                 in
+                   {final_src1 = final_src1,
+                    final_src2 = final_src2,
+                    assembly_src1_src2 
+                    = AppendList.appends 
+                      [assembly_src1, 
+                       assembly_src2],
+                    registerAllocation = registerAllocation}
+                 end
 
       fun pfmov {instruction, info as {dead, remove, ...}, 
-		 registerAllocation,
-		 src, dst, srcsize, dstsize} =
-	 let
-	    fun default ()
-	       = let
-		    val {uses,defs,kills} 
-		       = Instruction.uses_defs_kills instruction
-		    val {assembly = assembly_pre,
-			 registerAllocation}
-		       = RA.pre {uses = uses,
-				 defs = defs,
-				 kills = kills,
-				 info = info,
-				 registerAllocation = registerAllocation}
-		       
-		    val {operand = final_src,
-			 assembly = assembly_src,
-			 registerAllocation,
-			 ...}
-		       = RA.allocateFltOperand 
-		         {operand = src,
-			  options = {fltregister = true,
-				     address = true},
-			  info = info,
-			  size = srcsize,
-			  move = true,
-			  supports = [dst],
-			  saves = [],
-			  top = SOME false,
-			  registerAllocation
-			  = registerAllocation}
-			 
-		    val {assembly = assembly_dst,
-			 fltrename = fltrename_dst,
-			 registerAllocation,
-			 ...}
-		       = RA.allocateFltOperand 
-		         {operand = dst,
-			  options = {fltregister = true,
-				     address = false},
-			  info = info,
-			  size = dstsize,
-			  move = false,
-			  supports = [],
-			  saves = [src,final_src],
-			  top = NONE,
-			  registerAllocation
-			  = registerAllocation}
-			 
-		    val final_src = (RA.fltrenameLift fltrename_dst) final_src
-		       
-		    val instruction
-		       = Instruction.FLD
-		         {src = final_src,
-			  size = srcsize}
-			 
-		    val {uses = final_uses,
-			 defs = final_defs,  
-			 ...}
-		       = Instruction.uses_defs_kills instruction
-		       
-		    val {assembly = assembly_post,
-			 registerAllocation}
-		       = RA.post {uses = uses,
-				  final_uses = final_uses,
-				  defs = defs,
-				  final_defs = final_defs,
-				  kills = kills,
-				  info = info,
-				  registerAllocation = registerAllocation}
-		 in
-		    {assembly 
-		     = AppendList.appends
-		       [assembly_pre,
-			assembly_src,	
-			assembly_dst,
-			AppendList.single
-			(Assembly.instruction instruction),
-			assembly_post],
-		       registerAllocation = registerAllocation}
-		 end
-	      
-	    fun default' ()
-	       = let
-		    val {uses,defs,kills} 
-		       = Instruction.uses_defs_kills instruction
-		    val {assembly = assembly_pre,
-			 registerAllocation}
-		       = RA.pre {uses = uses,
-				 defs = defs,
-				 kills = kills,
-				 info = info,
-				 registerAllocation = registerAllocation}
-		       
-		    val {operand = final_src,
-			 assembly = assembly_src,
-			 registerAllocation,
-			 ...}
-		       = RA.allocateFltOperand 
-		         {operand = src,
-			  options = {fltregister = true,
-				     address = false},
-			  info = info,
-			  size = srcsize,
-			  move = true,
-			  supports = [dst],
-			  saves = [],
-			  top = SOME true,
-			  registerAllocation = registerAllocation}
-			 
-		    val {operand = final_dst,
-			 assembly = assembly_dst,
-			 registerAllocation,
-			 ...}
-		       = RA.allocateFltOperand 
-		         {operand = dst,
-			  options = {fltregister = false,
-				     address = true},
-			  info = info,
-			  size = dstsize,
-			  move = false,
-			  supports = [],
-			  saves = [src,final_src],
-			  top = SOME false,
-			  registerAllocation = registerAllocation}
-			 
-		    val instruction
-		       = Instruction.FST
-		         {dst = final_dst,
-			  size = dstsize,
-			  pop = true}
-			 
-		    val {fltrename = fltrename_pop,
-			 registerAllocation}
-		       = RA.fltpop {registerAllocation = registerAllocation}
-		       
-		    val {uses = final_uses,
-			 defs = final_defs,
-			 ...}
-		       = Instruction.uses_defs_kills instruction
-		       
-		    val final_uses
-		       = List.revMap(final_uses, RA.fltrenameLift fltrename_pop)
-		    val final_defs
-		       = List.revMap(final_defs, RA.fltrenameLift fltrename_pop)
-		       
-		    val {assembly = assembly_post,
-			 registerAllocation}
-		       = RA.post {uses = uses,
-				  final_uses = final_uses,
-				  defs = defs,
-				  final_defs = final_defs,
-				  kills = kills,
-				  info = info,
-				  registerAllocation = registerAllocation}
-		 in
-		    {assembly 
-		     = AppendList.appends 
-		       [assembly_pre,
-			assembly_src,
-			assembly_dst,
-			AppendList.single
-			(Assembly.instruction instruction),
-			assembly_post],
-		       registerAllocation = registerAllocation}
-		 end
-	 in
-	    case (src,dst)
-	       of (Operand.MemLoc memloc_src,
-		   Operand.MemLoc memloc_dst)
-		  => (case (RA.fltallocated {memloc = memloc_src,
-					     registerAllocation 
-					     = registerAllocation},
-			    RA.fltallocated {memloc = memloc_dst,
-					     registerAllocation 
-					     = registerAllocation})
-			 of (SOME {fltregister = fltregister_src, 
-				   sync = sync_src,
-				   commit = commit_src, 
-				   ...},
-			     NONE)
-			    => if MemLocSet.contains(dead,memloc_src)
-			           orelse
-				   (MemLocSet.contains(remove,memloc_src)
-				    andalso
-				    sync_src)
-				  then if MemLocSet.contains(remove,
-							     memloc_dst)
-					  then default' ()
-					  else let
-						  val registerAllocation
-						     = RA.fltupdate 
-						       {value = {fltregister 
-								 = fltregister_src,
-								 memloc 
-								 = memloc_dst,
-								 weight = 1024,
-								 sync = false,
-								 commit 
-								 = commit_src},
-							registerAllocation 
-							= registerAllocation}
-						       
-						  val {uses,defs,kills} 
-						     = Instruction.uses_defs_kills
-						       instruction
-						  val {assembly = assembly_pre,
-						       registerAllocation}
-						     = RA.pre 
-						       {uses = uses,
-							defs = defs,
-							kills = kills,
-							info = info,
-							registerAllocation 
-							= registerAllocation}
-						       
-						  val final_uses = []
-						  val final_defs 
-						     = [Operand.fltregister 
-							fltregister_src]
-						     
-						  val {assembly = assembly_post,
-						       registerAllocation}
-						     = RA.post 
-						       {uses = uses,
-							final_uses = final_uses,
-							defs = defs,
-							final_defs = final_defs,
-							kills = kills,
-							info = info,
-							registerAllocation 
-							= registerAllocation}
-					       in
-						  {assembly 
-						   = AppendList.appends 
-						     [assembly_pre,
-						      assembly_post],
-						     registerAllocation 
-						     = registerAllocation}
-					       end
-				  else default ()
-			  | _ => default ())
-		| _ => default ()
-	 end
+                 registerAllocation,
+                 src, dst, srcsize, dstsize} =
+         let
+            fun default ()
+               = let
+                    val {uses,defs,kills} 
+                       = Instruction.uses_defs_kills instruction
+                    val {assembly = assembly_pre,
+                         registerAllocation}
+                       = RA.pre {uses = uses,
+                                 defs = defs,
+                                 kills = kills,
+                                 info = info,
+                                 registerAllocation = registerAllocation}
+                       
+                    val {operand = final_src,
+                         assembly = assembly_src,
+                         registerAllocation,
+                         ...}
+                       = RA.allocateFltOperand 
+                         {operand = src,
+                          options = {fltregister = true,
+                                     address = true},
+                          info = info,
+                          size = srcsize,
+                          move = true,
+                          supports = [dst],
+                          saves = [],
+                          top = SOME false,
+                          registerAllocation
+                          = registerAllocation}
+                         
+                    val {assembly = assembly_dst,
+                         fltrename = fltrename_dst,
+                         registerAllocation,
+                         ...}
+                       = RA.allocateFltOperand 
+                         {operand = dst,
+                          options = {fltregister = true,
+                                     address = false},
+                          info = info,
+                          size = dstsize,
+                          move = false,
+                          supports = [],
+                          saves = [src,final_src],
+                          top = NONE,
+                          registerAllocation
+                          = registerAllocation}
+                         
+                    val final_src = (RA.fltrenameLift fltrename_dst) final_src
+                       
+                    val instruction
+                       = Instruction.FLD
+                         {src = final_src,
+                          size = srcsize}
+                         
+                    val {uses = final_uses,
+                         defs = final_defs,  
+                         ...}
+                       = Instruction.uses_defs_kills instruction
+                       
+                    val {assembly = assembly_post,
+                         registerAllocation}
+                       = RA.post {uses = uses,
+                                  final_uses = final_uses,
+                                  defs = defs,
+                                  final_defs = final_defs,
+                                  kills = kills,
+                                  info = info,
+                                  registerAllocation = registerAllocation}
+                 in
+                    {assembly 
+                     = AppendList.appends
+                       [assembly_pre,
+                        assembly_src,   
+                        assembly_dst,
+                        AppendList.single
+                        (Assembly.instruction instruction),
+                        assembly_post],
+                       registerAllocation = registerAllocation}
+                 end
+              
+            fun default' ()
+               = let
+                    val {uses,defs,kills} 
+                       = Instruction.uses_defs_kills instruction
+                    val {assembly = assembly_pre,
+                         registerAllocation}
+                       = RA.pre {uses = uses,
+                                 defs = defs,
+                                 kills = kills,
+                                 info = info,
+                                 registerAllocation = registerAllocation}
+                       
+                    val {operand = final_src,
+                         assembly = assembly_src,
+                         registerAllocation,
+                         ...}
+                       = RA.allocateFltOperand 
+                         {operand = src,
+                          options = {fltregister = true,
+                                     address = false},
+                          info = info,
+                          size = srcsize,
+                          move = true,
+                          supports = [dst],
+                          saves = [],
+                          top = SOME true,
+                          registerAllocation = registerAllocation}
+                         
+                    val {operand = final_dst,
+                         assembly = assembly_dst,
+                         registerAllocation,
+                         ...}
+                       = RA.allocateFltOperand 
+                         {operand = dst,
+                          options = {fltregister = false,
+                                     address = true},
+                          info = info,
+                          size = dstsize,
+                          move = false,
+                          supports = [],
+                          saves = [src,final_src],
+                          top = SOME false,
+                          registerAllocation = registerAllocation}
+                         
+                    val instruction
+                       = Instruction.FST
+                         {dst = final_dst,
+                          size = dstsize,
+                          pop = true}
+                         
+                    val {fltrename = fltrename_pop,
+                         registerAllocation}
+                       = RA.fltpop {registerAllocation = registerAllocation}
+                       
+                    val {uses = final_uses,
+                         defs = final_defs,
+                         ...}
+                       = Instruction.uses_defs_kills instruction
+                       
+                    val final_uses
+                       = List.revMap(final_uses, RA.fltrenameLift fltrename_pop)
+                    val final_defs
+                       = List.revMap(final_defs, RA.fltrenameLift fltrename_pop)
+                       
+                    val {assembly = assembly_post,
+                         registerAllocation}
+                       = RA.post {uses = uses,
+                                  final_uses = final_uses,
+                                  defs = defs,
+                                  final_defs = final_defs,
+                                  kills = kills,
+                                  info = info,
+                                  registerAllocation = registerAllocation}
+                 in
+                    {assembly 
+                     = AppendList.appends 
+                       [assembly_pre,
+                        assembly_src,
+                        assembly_dst,
+                        AppendList.single
+                        (Assembly.instruction instruction),
+                        assembly_post],
+                       registerAllocation = registerAllocation}
+                 end
+         in
+            case (src,dst)
+               of (Operand.MemLoc memloc_src,
+                   Operand.MemLoc memloc_dst)
+                  => (case (RA.fltallocated {memloc = memloc_src,
+                                             registerAllocation 
+                                             = registerAllocation},
+                            RA.fltallocated {memloc = memloc_dst,
+                                             registerAllocation 
+                                             = registerAllocation})
+                         of (SOME {fltregister = fltregister_src, 
+                                   sync = sync_src,
+                                   commit = commit_src, 
+                                   ...},
+                             NONE)
+                            => if MemLocSet.contains(dead,memloc_src)
+                                   orelse
+                                   (MemLocSet.contains(remove,memloc_src)
+                                    andalso
+                                    sync_src)
+                                  then if MemLocSet.contains(remove,
+                                                             memloc_dst)
+                                          then default' ()
+                                          else let
+                                                  val registerAllocation
+                                                     = RA.fltupdate 
+                                                       {value = {fltregister 
+                                                                 = fltregister_src,
+                                                                 memloc 
+                                                                 = memloc_dst,
+                                                                 weight = 1024,
+                                                                 sync = false,
+                                                                 commit 
+                                                                 = commit_src},
+                                                        registerAllocation 
+                                                        = registerAllocation}
+                                                       
+                                                  val {uses,defs,kills} 
+                                                     = Instruction.uses_defs_kills
+                                                       instruction
+                                                  val {assembly = assembly_pre,
+                                                       registerAllocation}
+                                                     = RA.pre 
+                                                       {uses = uses,
+                                                        defs = defs,
+                                                        kills = kills,
+                                                        info = info,
+                                                        registerAllocation 
+                                                        = registerAllocation}
+                                                       
+                                                  val final_uses = []
+                                                  val final_defs 
+                                                     = [Operand.fltregister 
+                                                        fltregister_src]
+                                                     
+                                                  val {assembly = assembly_post,
+                                                       registerAllocation}
+                                                     = RA.post 
+                                                       {uses = uses,
+                                                        final_uses = final_uses,
+                                                        defs = defs,
+                                                        final_defs = final_defs,
+                                                        kills = kills,
+                                                        info = info,
+                                                        registerAllocation 
+                                                        = registerAllocation}
+                                               in
+                                                  {assembly 
+                                                   = AppendList.appends 
+                                                     [assembly_pre,
+                                                      assembly_post],
+                                                     registerAllocation 
+                                                     = registerAllocation}
+                                               end
+                                  else default ()
+                          | _ => default ())
+                | _ => default ()
+         end
 
 
       fun removable {memloc,
-		     info = {dead, remove, ...}: Liveness.t,
-		     registerAllocation}
-	= MemLocSet.contains(dead,
-			     memloc)
-	  orelse
-	  (MemLocSet.contains(remove,
-			      memloc)
-	   andalso
-	   (case RA.fltallocated {memloc = memloc,
-				  registerAllocation = registerAllocation}
-	      of SOME {sync,...} => sync
-	       | NONE => true))
+                     info = {dead, remove, ...}: Liveness.t,
+                     registerAllocation}
+        = MemLocSet.contains(dead,
+                             memloc)
+          orelse
+          (MemLocSet.contains(remove,
+                              memloc)
+           andalso
+           (case RA.fltallocated {memloc = memloc,
+                                  registerAllocation = registerAllocation}
+              of SOME {sync,...} => sync
+               | NONE => true))
 
       fun allocateRegisters {instruction: t,
-			     info as {dead, remove, ...}: Liveness.t,
-			     registerAllocation: RegisterAllocation.t}
-	= case instruction
-	    of NOP
-	       (* No operation; p. 496 *)
-	     => let
-		  val {uses,defs,kills} 
-		    = Instruction.uses_defs_kills instruction
-		  val {assembly = assembly_pre,
-		       registerAllocation}
-		    = RA.pre {uses = uses,
-			      defs = defs,
-			      kills = kills,
-			      info = info,
-			      registerAllocation = registerAllocation}
+                             info as {dead, remove, ...}: Liveness.t,
+                             registerAllocation: RegisterAllocation.t}
+        = case instruction
+            of NOP
+               (* No operation; p. 496 *)
+             => let
+                  val {uses,defs,kills} 
+                    = Instruction.uses_defs_kills instruction
+                  val {assembly = assembly_pre,
+                       registerAllocation}
+                    = RA.pre {uses = uses,
+                              defs = defs,
+                              kills = kills,
+                              info = info,
+                              registerAllocation = registerAllocation}
 
-		  val instruction 
-		    = Instruction.NOP
+                  val instruction 
+                    = Instruction.NOP
 
-		  val {uses = final_uses,
-		       defs = final_defs,
-		       ...}
-		    = Instruction.uses_defs_kills instruction
+                  val {uses = final_uses,
+                       defs = final_defs,
+                       ...}
+                    = Instruction.uses_defs_kills instruction
 
-		  val {assembly = assembly_post,
-		       registerAllocation}
-		    = RA.post {uses = uses,
-			       final_uses = final_uses,
-			       defs = defs,
-			       final_defs = final_defs,
-			       kills = kills,
-			       info = info,
-			       registerAllocation = registerAllocation}
-		in
-		  {assembly
-		   = AppendList.appends 
-		     [assembly_pre,
-		      assembly_post],
-		   registerAllocation = registerAllocation}
-		end
-	     | BinAL {oper, src, dst, size}
-	       (* Integer binary arithmetic(w/o mult & div)/logic instructions.
-		* Require src/dst operands as follows:
-		*
-		*              dst
-		*          reg imm lab add 
-		*      reg  X           X
-		*  src imm  X           X
-		*      lab
-		*      add  X
-		*)
-	     => let
-		  val {uses,defs,kills} 
-		    = Instruction.uses_defs_kills instruction
-		  val {assembly = assembly_pre,
-		       registerAllocation}
-		    = RA.pre {uses = uses,
-			      defs = defs,
-			      kills = kills,
-			      info = info,
-			      registerAllocation = registerAllocation}
+                  val {assembly = assembly_post,
+                       registerAllocation}
+                    = RA.post {uses = uses,
+                               final_uses = final_uses,
+                               defs = defs,
+                               final_defs = final_defs,
+                               kills = kills,
+                               info = info,
+                               registerAllocation = registerAllocation}
+                in
+                  {assembly
+                   = AppendList.appends 
+                     [assembly_pre,
+                      assembly_post],
+                   registerAllocation = registerAllocation}
+                end
+             | BinAL {oper, src, dst, size}
+               (* Integer binary arithmetic(w/o mult & div)/logic instructions.
+                * Require src/dst operands as follows:
+                *
+                *              dst
+                *          reg imm lab add 
+                *      reg  X           X
+                *  src imm  X           X
+                *      lab
+                *      add  X
+                *)
+             => let
+                  val {uses,defs,kills} 
+                    = Instruction.uses_defs_kills instruction
+                  val {assembly = assembly_pre,
+                       registerAllocation}
+                    = RA.pre {uses = uses,
+                              defs = defs,
+                              kills = kills,
+                              info = info,
+                              registerAllocation = registerAllocation}
 
-		  fun default ()
-		    = let
-			val {final_src,
-			     final_dst,
-			     assembly_src_dst,
-			     registerAllocation}
-			  = allocateSrcDst {src = src,
-					    dst = dst,
-					    move_dst = true,
-					    size = size,
-					    info = info,
-					    registerAllocation = registerAllocation}
-			  
-			val instruction 
-			  = Instruction.BinAL
-			    {oper = oper,
-			     src = final_src,
-			     dst = final_dst,
-			     size = size}
-			    
-			val {uses = final_uses,
-			     defs = final_defs,
-			     ...}
-			  = Instruction.uses_defs_kills instruction
-			  
-			val {assembly = assembly_post,
-			     registerAllocation}
-			  = RA.post {uses = uses,
-				     final_uses = final_uses,
-				     defs = defs,
-				     final_defs = final_defs,
-				     kills = kills,
-				     info = info,
-				     registerAllocation = registerAllocation}
-		      in
-			{assembly
-			 = AppendList.appends 
-			   [assembly_pre,
-			    assembly_src_dst,
-			    AppendList.single
-			    (Assembly.instruction instruction),
-			    assembly_post],
-			   registerAllocation = registerAllocation}
-		      end
-		in
-		  default ()
-		end
-	     | pMD {oper, dst, src, size}
-	       (* Integer multiplication and division.
-		* Require src operand as follows:
-		*
-		*               src
-		*           reg imm lab add
-		*            X           X
-		*)
-	     => let
-		  val {uses,defs,kills} 
-		    = Instruction.uses_defs_kills instruction
-		  val {assembly = assembly_pre,
-		       registerAllocation}
-		    = RA.pre {uses = uses,
-			      defs = defs,
-			      kills = kills,
-			      info = info,
-			      registerAllocation = registerAllocation}
+                  fun default ()
+                    = let
+                        val {final_src,
+                             final_dst,
+                             assembly_src_dst,
+                             registerAllocation}
+                          = allocateSrcDst {src = src,
+                                            dst = dst,
+                                            move_dst = true,
+                                            size = size,
+                                            info = info,
+                                            registerAllocation = registerAllocation}
+                          
+                        val instruction 
+                          = Instruction.BinAL
+                            {oper = oper,
+                             src = final_src,
+                             dst = final_dst,
+                             size = size}
+                            
+                        val {uses = final_uses,
+                             defs = final_defs,
+                             ...}
+                          = Instruction.uses_defs_kills instruction
+                          
+                        val {assembly = assembly_post,
+                             registerAllocation}
+                          = RA.post {uses = uses,
+                                     final_uses = final_uses,
+                                     defs = defs,
+                                     final_defs = final_defs,
+                                     kills = kills,
+                                     info = info,
+                                     registerAllocation = registerAllocation}
+                      in
+                        {assembly
+                         = AppendList.appends 
+                           [assembly_pre,
+                            assembly_src_dst,
+                            AppendList.single
+                            (Assembly.instruction instruction),
+                            assembly_post],
+                           registerAllocation = registerAllocation}
+                      end
+                in
+                  default ()
+                end
+             | pMD {oper, dst, src, size}
+               (* Integer multiplication and division.
+                * Require src operand as follows:
+                *
+                *               src
+                *           reg imm lab add
+                *            X           X
+                *)
+             => let
+                  val {uses,defs,kills} 
+                    = Instruction.uses_defs_kills instruction
+                  val {assembly = assembly_pre,
+                       registerAllocation}
+                    = RA.pre {uses = uses,
+                              defs = defs,
+                              kills = kills,
+                              info = info,
+                              registerAllocation = registerAllocation}
 
-		  val (hi,lo) 
-		    = case size
-			of Size.BYTE 
-			=> (Register.T {reg = Register.EAX, part = Register.H},
-			    Register.T {reg = Register.EAX, part = Register.L})
-			| Size.WORD 
-			=> (Register.T {reg = Register.EDX, part = Register.X},
-			    Register.T {reg = Register.EAX, part = Register.X})
-			| Size.LONG
-			=> (Register.T {reg = Register.EDX, part = Register.E},
-			    Register.T {reg = Register.EAX, part = Register.E})
-			| _ => Error.bug "allocateRegisters: pMD, size"
+                  val (hi,lo) 
+                    = case size
+                        of Size.BYTE 
+                        => (Register.T {reg = Register.EAX, part = Register.H},
+                            Register.T {reg = Register.EAX, part = Register.L})
+                        | Size.WORD 
+                        => (Register.T {reg = Register.EDX, part = Register.X},
+                            Register.T {reg = Register.EAX, part = Register.X})
+                        | Size.LONG
+                        => (Register.T {reg = Register.EDX, part = Register.E},
+                            Register.T {reg = Register.EAX, part = Register.E})
+                        | _ => Error.bug "x86AllocateRegisters.Instruction.allocateRegisters: pMD, size"
 
-		  val {assembly = assembly_clear,
-		       registerAllocation,
-		       ...}
-		    = RA.freeRegister 
-		      {info = info,
-		       memloc = NONE,
-		       size = size,
-		       supports = [src,dst],
-		       saves = [], 
-		       force = [hi],
-		       registerAllocation = registerAllocation}
+                  val {assembly = assembly_clear,
+                       registerAllocation,
+                       ...}
+                    = RA.freeRegister 
+                      {info = info,
+                       memloc = NONE,
+                       size = size,
+                       supports = [src,dst],
+                       saves = [], 
+                       force = [hi],
+                       registerAllocation = registerAllocation}
 
-		  val registerAllocation
-		    = RA.delete {register = hi,
-				 registerAllocation = registerAllocation}
+                  val registerAllocation
+                    = RA.delete {register = hi,
+                                 registerAllocation = registerAllocation}
 
-		  val {final_src,
-		       assembly_src_dst,
-		       registerAllocation,
-		       ...}
-		    = if Operand.eq(src, dst)
-			then let
-			       val {operand = final_src_dst,
-				    assembly = assembly_src_dst,
-				    registerAllocation = registerAllocation}
-				 = RA.allocateOperand 
-				   {operand = dst,
-				    options = {register = true,
-					       immediate = false,
-					       label = false,
-					       address = false},
-				    info = info,
-				    size = size,
-				    move = true,
-				    supports = [],
-				    saves = [Operand.register hi],
-				    force = [lo],
-				    registerAllocation 
-				    = registerAllocation}
-			     in
-			       {final_src = final_src_dst,
-				final_dst = final_src_dst,
-				assembly_src_dst = assembly_src_dst,
-				registerAllocation = registerAllocation}
-			     end
-			else let
-			       val {operand = final_dst,
-				    assembly = assembly_dst,
-				    registerAllocation = registerAllocation}
-				 = RA.allocateOperand 
-				   {operand = dst,
-				    options = {register = true,
-					       immediate = false,
-					       label = false,
-					       address = false},
-				    info = info,
-				    size = size,
-				    move = true,
-				    supports = [src],
-				    saves = [Operand.register hi],
-				    force = [lo],
-				    registerAllocation 
-				    = registerAllocation}
+                  val {final_src,
+                       assembly_src_dst,
+                       registerAllocation,
+                       ...}
+                    = if Operand.eq(src, dst)
+                        then let
+                               val {operand = final_src_dst,
+                                    assembly = assembly_src_dst,
+                                    registerAllocation = registerAllocation}
+                                 = RA.allocateOperand 
+                                   {operand = dst,
+                                    options = {register = true,
+                                               immediate = false,
+                                               label = false,
+                                               address = false},
+                                    info = info,
+                                    size = size,
+                                    move = true,
+                                    supports = [],
+                                    saves = [Operand.register hi],
+                                    force = [lo],
+                                    registerAllocation 
+                                    = registerAllocation}
+                             in
+                               {final_src = final_src_dst,
+                                final_dst = final_src_dst,
+                                assembly_src_dst = assembly_src_dst,
+                                registerAllocation = registerAllocation}
+                             end
+                        else let
+                               val {operand = final_dst,
+                                    assembly = assembly_dst,
+                                    registerAllocation = registerAllocation}
+                                 = RA.allocateOperand 
+                                   {operand = dst,
+                                    options = {register = true,
+                                               immediate = false,
+                                               label = false,
+                                               address = false},
+                                    info = info,
+                                    size = size,
+                                    move = true,
+                                    supports = [src],
+                                    saves = [Operand.register hi],
+                                    force = [lo],
+                                    registerAllocation 
+                                    = registerAllocation}
 
-			       val force_src 
-				 = List.revKeepAll
-				   (Register.registers size,
-				    fn r => not (Register.eq(r, hi) orelse 
-						 Register.eq(r, lo)))
+                               val force_src 
+                                 = List.revKeepAll
+                                   (Register.registers size,
+                                    fn r => not (Register.eq(r, hi) orelse 
+                                                 Register.eq(r, lo)))
 
-			       val {operand = final_src, 
-				    assembly = assembly_src,
-				    registerAllocation}
-				 = RA.allocateOperand 
-				   {operand = src,
-				    options = {register = true,
-					       immediate = false,
-					       label = false,
-					       address = true}, 
-				    info = info,
-				    size = size,
-				    move = true,
-				    supports = [],
-				    saves = [Operand.register hi,
-					     dst,final_dst],
-				    force = force_src,
-				    registerAllocation 
-				    = registerAllocation}
-			     in
-			       {final_src = final_src,
-				final_dst = final_dst,
-				assembly_src_dst 
-				= AppendList.appends 
-				  [assembly_dst, 
-				   assembly_src],
-				registerAllocation = registerAllocation}
-			     end
+                               val {operand = final_src, 
+                                    assembly = assembly_src,
+                                    registerAllocation}
+                                 = RA.allocateOperand 
+                                   {operand = src,
+                                    options = {register = true,
+                                               immediate = false,
+                                               label = false,
+                                               address = true}, 
+                                    info = info,
+                                    size = size,
+                                    move = true,
+                                    supports = [],
+                                    saves = [Operand.register hi,
+                                             dst,final_dst],
+                                    force = force_src,
+                                    registerAllocation 
+                                    = registerAllocation}
+                             in
+                               {final_src = final_src,
+                                final_dst = final_dst,
+                                assembly_src_dst 
+                                = AppendList.appends 
+                                  [assembly_dst, 
+                                   assembly_src],
+                                registerAllocation = registerAllocation}
+                             end
 
-		  val oper' 
-		    = case oper
-			of Instruction.IMUL => Instruction.IMUL
-			 | Instruction.MUL => Instruction.MUL
-			 | Instruction.IDIV => Instruction.IDIV
-			 | Instruction.DIV => Instruction.DIV
-			 | Instruction.IMOD => Instruction.IDIV
-			 | Instruction.MOD => Instruction.DIV
+                  val oper' 
+                    = case oper
+                        of Instruction.IMUL => Instruction.IMUL
+                         | Instruction.MUL => Instruction.MUL
+                         | Instruction.IDIV => Instruction.IDIV
+                         | Instruction.DIV => Instruction.DIV
+                         | Instruction.IMOD => Instruction.IDIV
+                         | Instruction.MOD => Instruction.DIV
 
-		  val registerAllocation
-		    = if oper = Instruction.IMOD orelse
-		         oper = Instruction.MOD
-			then case RA.valuesRegister {register = lo,
-						     registerAllocation
-						     = registerAllocation}
-			       of [{memloc,
-				    weight,
-				    sync,
-				    commit, 
-				    ...}]
-				=> let
-				     val registerAllocation
-				       = RA.delete {register = lo,
-						    registerAllocation
-						    = registerAllocation}
+                  val registerAllocation
+                    = if oper = Instruction.IMOD orelse
+                         oper = Instruction.MOD
+                        then case RA.valuesRegister {register = lo,
+                                                     registerAllocation
+                                                     = registerAllocation}
+                               of [{memloc,
+                                    weight,
+                                    sync,
+                                    commit, 
+                                    ...}]
+                                => let
+                                     val registerAllocation
+                                       = RA.delete {register = lo,
+                                                    registerAllocation
+                                                    = registerAllocation}
 
-				     val registerAllocation
-				       = RA.update {value = {register = hi,
-							     memloc = memloc,
-							     weight = weight,
-							     sync = sync,
-							     commit = commit},
-						    registerAllocation 
-						    = registerAllocation}
-				   in
-				     registerAllocation
-				   end
-				| _ => Error.bug "allocateRegisters: pMD, lo"
-			else registerAllocation
+                                     val registerAllocation
+                                       = RA.update {value = {register = hi,
+                                                             memloc = memloc,
+                                                             weight = weight,
+                                                             sync = sync,
+                                                             commit = commit},
+                                                    registerAllocation 
+                                                    = registerAllocation}
+                                   in
+                                     registerAllocation
+                                   end
+                                | _ => Error.bug "x86AllocateRegisters.Instruction.allocateRegisters: pMD, lo"
+                        else registerAllocation
 
-		  val instruction
-		    = Instruction.MD
-		      {oper = oper',
-		       src = final_src,
-		       size = size}
+                  val instruction
+                    = Instruction.MD
+                      {oper = oper',
+                       src = final_src,
+                       size = size}
 
-		  val {uses = final_uses,
-		       defs = final_defs,  
-		       ...}
-		    = Instruction.uses_defs_kills instruction
+                  val {uses = final_uses,
+                       defs = final_defs,  
+                       ...}
+                    = Instruction.uses_defs_kills instruction
 
-		  val {assembly = assembly_post,
-		       registerAllocation}
-		    = RA.post {uses = uses,
-			       final_uses = final_uses,
-			       defs = defs,
-			       final_defs = final_defs,
-			       kills = kills,
-			       info = info,
-			       registerAllocation = registerAllocation}
-		in
-		  {assembly 
-		   = AppendList.appends 
-		     [assembly_pre,
-		      assembly_clear,
-		      assembly_src_dst,
-		      (if oper = Instruction.IDIV orelse
-			  oper = Instruction.IMOD
-			 then AppendList.single
-			      (Assembly.instruction_cx
-			       {size = size})
-			 else if oper = Instruction.DIV orelse
-			         oper = Instruction.MOD
-				then AppendList.single
-				     (Assembly.instruction_binal
-				      {oper = Instruction.XOR,
-				       dst = Operand.register hi,
-				       src = Operand.register hi,
-				       size = size})
-				else AppendList.empty),
-		      AppendList.single
-		      (Assembly.instruction instruction),
-		      assembly_post],
-		   registerAllocation = registerAllocation}
-		end
-	     | IMUL2 {src, dst, size}
-	       (* Integer signed/unsigned multiplication (two operand form).
-		* Require src/dst operands as follows:
-		*
-		*              dst
-		*          reg imm lab add 
-		*      reg  X
-		*  src imm  X
-		*      lab
-		*      add  X
-		*)
-	     => let
-		  val {uses,defs,kills} 
-		    = Instruction.uses_defs_kills instruction
-		  val {assembly = assembly_pre,
-		       registerAllocation}
-		    = RA.pre {uses = uses,
-			      defs = defs,
-			      kills = kills,
-			      info = info,
-			      registerAllocation = registerAllocation}
+                  val {assembly = assembly_post,
+                       registerAllocation}
+                    = RA.post {uses = uses,
+                               final_uses = final_uses,
+                               defs = defs,
+                               final_defs = final_defs,
+                               kills = kills,
+                               info = info,
+                               registerAllocation = registerAllocation}
+                in
+                  {assembly 
+                   = AppendList.appends 
+                     [assembly_pre,
+                      assembly_clear,
+                      assembly_src_dst,
+                      (if oper = Instruction.IDIV orelse
+                          oper = Instruction.IMOD
+                         then AppendList.single
+                              (Assembly.instruction_cx
+                               {size = size})
+                         else if oper = Instruction.DIV orelse
+                                 oper = Instruction.MOD
+                                then AppendList.single
+                                     (Assembly.instruction_binal
+                                      {oper = Instruction.XOR,
+                                       dst = Operand.register hi,
+                                       src = Operand.register hi,
+                                       size = size})
+                                else AppendList.empty),
+                      AppendList.single
+                      (Assembly.instruction instruction),
+                      assembly_post],
+                   registerAllocation = registerAllocation}
+                end
+             | IMUL2 {src, dst, size}
+               (* Integer signed/unsigned multiplication (two operand form).
+                * Require src/dst operands as follows:
+                *
+                *              dst
+                *          reg imm lab add 
+                *      reg  X
+                *  src imm  X
+                *      lab
+                *      add  X
+                *)
+             => let
+                  val {uses,defs,kills} 
+                    = Instruction.uses_defs_kills instruction
+                  val {assembly = assembly_pre,
+                       registerAllocation}
+                    = RA.pre {uses = uses,
+                              defs = defs,
+                              kills = kills,
+                              info = info,
+                              registerAllocation = registerAllocation}
 
-		  val {final_src,
-		       final_dst,
-		       assembly_src_dst,
-		       registerAllocation}
-		    = if Operand.eq(src, dst)
-			then let
-			       val {operand = final_src_dst, 
-				    assembly = assembly_src_dst,
-				    registerAllocation}
-				 = RA.allocateOperand 
-				   {operand = src,
-				    options = {register = true,
-					       immediate = false,
-					       label = false,
-					       address = false},
-				    info = info,
-				    size = size,
-				    move = true,
-				    supports = [],
-				    saves = [],
-				    force = [],
-				    registerAllocation 
-				    = registerAllocation}
-			     in
-			       {final_src = final_src_dst,
-				final_dst = final_src_dst,
-				assembly_src_dst = assembly_src_dst,
-				registerAllocation = registerAllocation}
-			     end
-			else let
-			       val {operand = final_dst,
-				    assembly = assembly_dst,
-				    registerAllocation}
-				 = RA.allocateOperand 
-				   {operand = dst,
-				    options = {register = true,
-					       immediate = false,
-					       label = false,
-					       address = false},
-				    info = info,
-				    size = size,
-				    move = true,
-				    supports = [src],
-				    saves = [],
-				    force = [],
-				    registerAllocation 
-				    = registerAllocation}
+                  val {final_src,
+                       final_dst,
+                       assembly_src_dst,
+                       registerAllocation}
+                    = if Operand.eq(src, dst)
+                        then let
+                               val {operand = final_src_dst, 
+                                    assembly = assembly_src_dst,
+                                    registerAllocation}
+                                 = RA.allocateOperand 
+                                   {operand = src,
+                                    options = {register = true,
+                                               immediate = false,
+                                               label = false,
+                                               address = false},
+                                    info = info,
+                                    size = size,
+                                    move = true,
+                                    supports = [],
+                                    saves = [],
+                                    force = [],
+                                    registerAllocation 
+                                    = registerAllocation}
+                             in
+                               {final_src = final_src_dst,
+                                final_dst = final_src_dst,
+                                assembly_src_dst = assembly_src_dst,
+                                registerAllocation = registerAllocation}
+                             end
+                        else let
+                               val {operand = final_dst,
+                                    assembly = assembly_dst,
+                                    registerAllocation}
+                                 = RA.allocateOperand 
+                                   {operand = dst,
+                                    options = {register = true,
+                                               immediate = false,
+                                               label = false,
+                                               address = false},
+                                    info = info,
+                                    size = size,
+                                    move = true,
+                                    supports = [src],
+                                    saves = [],
+                                    force = [],
+                                    registerAllocation 
+                                    = registerAllocation}
  
-			       val {operand = final_src, 
-				    assembly = assembly_src,
-				    registerAllocation}
-				 = RA.allocateOperand 
-				   {operand = src,
-				    options = {register = true,
-					       immediate = true,
-					       label = false,
-					       address = false},
-				    info = info,
-				    size = size,
-				    move = true,
-				    supports = [],
-				    saves = [dst,final_dst],
-				    force = [],
-				    registerAllocation 
-				    = registerAllocation}
-			     in
-			       {final_src = final_src,
-				final_dst = final_dst,
-				assembly_src_dst 
-				= AppendList.appends 
-				  [assembly_dst,
-				   assembly_src],
-				registerAllocation = registerAllocation}
-			     end
-			  
-		  val instruction 
-		    = Instruction.IMUL2
-		      {src = final_src,
-		       dst = final_dst,
-		       size = size}
-		      
-		  val {uses = final_uses,
-		       defs = final_defs,
-		       ...}
-		    = Instruction.uses_defs_kills instruction
-		    
-		  val {assembly = assembly_post,
-		       registerAllocation}
-		    = RA.post {uses = uses,
-			       final_uses = final_uses,
-			       defs = defs,
-			       final_defs = final_defs,
-			       kills = kills,
-			       info = info,
-			       registerAllocation = registerAllocation}
-		in
-		  {assembly
-		   = AppendList.appends 
-		     [assembly_pre,
-		      assembly_src_dst,
-		      AppendList.single
-		      (Assembly.instruction instruction),
-		      assembly_post],
-		     registerAllocation = registerAllocation}
-		end
-	     | UnAL {oper, dst, size}
-	       (* Integer unary arithmetic/logic instructions.
-		* Require dst operand as follows:
-		*
-		*               dst
-		*           reg imm lab add
-		*            X           X
-		*)
-	     => let
-		  val {uses,defs,kills} 
-		    = Instruction.uses_defs_kills instruction
-		  val {assembly = assembly_pre,
-		       registerAllocation}
-		    = RA.pre {uses = uses,
-			      defs = defs,
-			      kills = kills,
-			      info = info,
-			      registerAllocation = registerAllocation}
+                               val {operand = final_src, 
+                                    assembly = assembly_src,
+                                    registerAllocation}
+                                 = RA.allocateOperand 
+                                   {operand = src,
+                                    options = {register = true,
+                                               immediate = true,
+                                               label = false,
+                                               address = false},
+                                    info = info,
+                                    size = size,
+                                    move = true,
+                                    supports = [],
+                                    saves = [dst,final_dst],
+                                    force = [],
+                                    registerAllocation 
+                                    = registerAllocation}
+                             in
+                               {final_src = final_src,
+                                final_dst = final_dst,
+                                assembly_src_dst 
+                                = AppendList.appends 
+                                  [assembly_dst,
+                                   assembly_src],
+                                registerAllocation = registerAllocation}
+                             end
+                          
+                  val instruction 
+                    = Instruction.IMUL2
+                      {src = final_src,
+                       dst = final_dst,
+                       size = size}
+                      
+                  val {uses = final_uses,
+                       defs = final_defs,
+                       ...}
+                    = Instruction.uses_defs_kills instruction
+                    
+                  val {assembly = assembly_post,
+                       registerAllocation}
+                    = RA.post {uses = uses,
+                               final_uses = final_uses,
+                               defs = defs,
+                               final_defs = final_defs,
+                               kills = kills,
+                               info = info,
+                               registerAllocation = registerAllocation}
+                in
+                  {assembly
+                   = AppendList.appends 
+                     [assembly_pre,
+                      assembly_src_dst,
+                      AppendList.single
+                      (Assembly.instruction instruction),
+                      assembly_post],
+                     registerAllocation = registerAllocation}
+                end
+             | UnAL {oper, dst, size}
+               (* Integer unary arithmetic/logic instructions.
+                * Require dst operand as follows:
+                *
+                *               dst
+                *           reg imm lab add
+                *            X           X
+                *)
+             => let
+                  val {uses,defs,kills} 
+                    = Instruction.uses_defs_kills instruction
+                  val {assembly = assembly_pre,
+                       registerAllocation}
+                    = RA.pre {uses = uses,
+                              defs = defs,
+                              kills = kills,
+                              info = info,
+                              registerAllocation = registerAllocation}
 
-		  val {operand = final_dst,
-		       assembly = assembly_dst,
-		       registerAllocation = registerAllocation}
-		    = RA.allocateOperand {operand = dst,
-					  options = {register = true,
-						     immediate = false,
-						     label = false,
-						     address = true},
-					  info = info,
-					  size = size,
-					  move = true,
-					  supports = [],
-					  saves = [],
-					  force = [],
-					  registerAllocation 
-					  = registerAllocation}
+                  val {operand = final_dst,
+                       assembly = assembly_dst,
+                       registerAllocation = registerAllocation}
+                    = RA.allocateOperand {operand = dst,
+                                          options = {register = true,
+                                                     immediate = false,
+                                                     label = false,
+                                                     address = true},
+                                          info = info,
+                                          size = size,
+                                          move = true,
+                                          supports = [],
+                                          saves = [],
+                                          force = [],
+                                          registerAllocation 
+                                          = registerAllocation}
 
-		  val instruction
-		    = Instruction.UnAL
-		      {oper = oper,
-		       dst = final_dst,
-		       size = size}
+                  val instruction
+                    = Instruction.UnAL
+                      {oper = oper,
+                       dst = final_dst,
+                       size = size}
 
-		  val {uses = final_uses,
-		       defs = final_defs,  
-		       ...}
-		    = Instruction.uses_defs_kills instruction
+                  val {uses = final_uses,
+                       defs = final_defs,  
+                       ...}
+                    = Instruction.uses_defs_kills instruction
 
-		  val {assembly = assembly_post,
-		       registerAllocation}
-		    = RA.post {uses = uses,
-			       final_uses = final_uses,
-			       defs = defs,
-			       final_defs = final_defs,
-			       kills = kills,
-			       info = info,
-			       registerAllocation = registerAllocation}
-		in
-		  {assembly 
-		   = AppendList.appends 
-		     [assembly_pre,
-		      assembly_dst,
-		      AppendList.single
-		      (Assembly.instruction instruction),
-		      assembly_post],
-		   registerAllocation = registerAllocation}
-		end
-	     | SRAL {oper, count, dst, size}
-	       (* Integer shift/rotate arithmetic/logic instructions.
-		* Require count operand as follows:
-		*
-		*              count
-		*           reg imm lab add
-		*            *   X
-		*  * only register %cl
-		*
-		* Require dst operand as follows:
-		*
-		*               dst
-		*           reg imm lab add
-		*            X           X
-		*)
-	     => let
-		  val {uses,defs,kills} 
-		    = Instruction.uses_defs_kills instruction
-		  val {assembly = assembly_pre,
-		       registerAllocation}
-		    = RA.pre {uses = uses,
-			      defs = defs,
-			      kills = kills,
-			      info = info,
-			      registerAllocation = registerAllocation}
+                  val {assembly = assembly_post,
+                       registerAllocation}
+                    = RA.post {uses = uses,
+                               final_uses = final_uses,
+                               defs = defs,
+                               final_defs = final_defs,
+                               kills = kills,
+                               info = info,
+                               registerAllocation = registerAllocation}
+                in
+                  {assembly 
+                   = AppendList.appends 
+                     [assembly_pre,
+                      assembly_dst,
+                      AppendList.single
+                      (Assembly.instruction instruction),
+                      assembly_post],
+                   registerAllocation = registerAllocation}
+                end
+             | SRAL {oper, count, dst, size}
+               (* Integer shift/rotate arithmetic/logic instructions.
+                * Require count operand as follows:
+                *
+                *              count
+                *           reg imm lab add
+                *            *   X
+                *  * only register %cl
+                *
+                * Require dst operand as follows:
+                *
+                *               dst
+                *           reg imm lab add
+                *            X           X
+                *)
+             => let
+                  val {uses,defs,kills} 
+                    = Instruction.uses_defs_kills instruction
+                  val {assembly = assembly_pre,
+                       registerAllocation}
+                    = RA.pre {uses = uses,
+                              defs = defs,
+                              kills = kills,
+                              info = info,
+                              registerAllocation = registerAllocation}
 
-		  val {final_count,
-		       assembly_count,
-		       final_dst,
-		       assembly_dst,
-		       registerAllocation}
-		    = if Operand.eq(count,dst)
-			then let
-			       val {operand = final_count, 
-				    assembly = assembly_count,
-				    registerAllocation}
-				 = RA.allocateOperand 
-				   {operand = count,
-				    options = {register = true,
-					       immediate = false,
-					       label = false,
-					       address = false}, 
-				    info = info,
-				    size = size,
-				    move = true,
-				    supports = [],
-				    saves = [],
-				    force 
-				    = [Register.T {reg = Register.ECX,
-						   part = Register.L},
-				       Register.T {reg = Register.ECX,
-						   part = Register.X},
-				       Register.T {reg = Register.ECX,
-						   part = Register.E}],
-				    registerAllocation 
-				    = registerAllocation}
+                  val {final_count,
+                       assembly_count,
+                       final_dst,
+                       assembly_dst,
+                       registerAllocation}
+                    = if Operand.eq(count,dst)
+                        then let
+                               val {operand = final_count, 
+                                    assembly = assembly_count,
+                                    registerAllocation}
+                                 = RA.allocateOperand 
+                                   {operand = count,
+                                    options = {register = true,
+                                               immediate = false,
+                                               label = false,
+                                               address = false}, 
+                                    info = info,
+                                    size = size,
+                                    move = true,
+                                    supports = [],
+                                    saves = [],
+                                    force 
+                                    = [Register.T {reg = Register.ECX,
+                                                   part = Register.L},
+                                       Register.T {reg = Register.ECX,
+                                                   part = Register.X},
+                                       Register.T {reg = Register.ECX,
+                                                   part = Register.E}],
+                                    registerAllocation 
+                                    = registerAllocation}
 
-			       val final_dst = final_count
-			       val assembly_dst = AppendList.empty
-			     in
-			       {final_count = final_count,
-				assembly_count = assembly_count,
-				final_dst = final_dst,
-				assembly_dst = assembly_dst,
-				registerAllocation = registerAllocation}
-			     end
-			else let
-			       val count_size = case Operand.size count
-						  of NONE => Size.BYTE
-						   | SOME size => size
+                               val final_dst = final_count
+                               val assembly_dst = AppendList.empty
+                             in
+                               {final_count = final_count,
+                                assembly_count = assembly_count,
+                                final_dst = final_dst,
+                                assembly_dst = assembly_dst,
+                                registerAllocation = registerAllocation}
+                             end
+                        else let
+                               val count_size = case Operand.size count
+                                                  of NONE => Size.BYTE
+                                                   | SOME size => size
 
-			       val {operand = final_count, 
-				    assembly = assembly_count,
-				    registerAllocation}
-				 = RA.allocateOperand 
-				   {operand = count,
-				    options = {register = true,
-					       immediate = true,
-					       label = false,
-					       address = false}, 
-				    info = info,
-				    size = count_size,
-				    move = true,
-				    supports = [dst],
-				    saves = [],
-				    force 
-				    = [Register.T {reg = Register.ECX,
-						   part = Register.L},
-				       Register.T {reg = Register.ECX,
-						   part = Register.X},
-				       Register.T {reg = Register.ECX,
-						   part = Register.E}],
-				    registerAllocation 
-				    = registerAllocation}
+                               val {operand = final_count, 
+                                    assembly = assembly_count,
+                                    registerAllocation}
+                                 = RA.allocateOperand 
+                                   {operand = count,
+                                    options = {register = true,
+                                               immediate = true,
+                                               label = false,
+                                               address = false}, 
+                                    info = info,
+                                    size = count_size,
+                                    move = true,
+                                    supports = [dst],
+                                    saves = [],
+                                    force 
+                                    = [Register.T {reg = Register.ECX,
+                                                   part = Register.L},
+                                       Register.T {reg = Register.ECX,
+                                                   part = Register.X},
+                                       Register.T {reg = Register.ECX,
+                                                   part = Register.E}],
+                                    registerAllocation 
+                                    = registerAllocation}
 
-			       val {operand = final_dst,
-				    assembly = assembly_dst,
-				    registerAllocation = registerAllocation}
-				 = RA.allocateOperand 
-				   {operand = dst,
-				    options = {register = true,
-					       immediate = false,
-					       label = false,
-					       address = true},
-				    info = info,
-				    size = size,
-				    move = true,
-				    supports = [],
-				    saves = [count,final_count],
-				    force = [],
-				    registerAllocation 
-				    = registerAllocation}
-			     in
-			       {final_count = final_count,
-				assembly_count = assembly_count,
-				final_dst = final_dst,
-				assembly_dst = assembly_dst,
-				registerAllocation = registerAllocation}
-			     end
+                               val {operand = final_dst,
+                                    assembly = assembly_dst,
+                                    registerAllocation = registerAllocation}
+                                 = RA.allocateOperand 
+                                   {operand = dst,
+                                    options = {register = true,
+                                               immediate = false,
+                                               label = false,
+                                               address = true},
+                                    info = info,
+                                    size = size,
+                                    move = true,
+                                    supports = [],
+                                    saves = [count,final_count],
+                                    force = [],
+                                    registerAllocation 
+                                    = registerAllocation}
+                             in
+                               {final_count = final_count,
+                                assembly_count = assembly_count,
+                                final_dst = final_dst,
+                                assembly_dst = assembly_dst,
+                                registerAllocation = registerAllocation}
+                             end
 
-		  val final_count
-		    = case final_count
-			of Operand.Register _ 
-			 => Operand.register 
-			    (Register.T {reg = Register.ECX,
-					 part = Register.L})
-		         | _ => final_count
+                  val final_count
+                    = case final_count
+                        of Operand.Register _ 
+                         => Operand.register 
+                            (Register.T {reg = Register.ECX,
+                                         part = Register.L})
+                         | _ => final_count
 
-		  val instruction 
-		    = Instruction.SRAL
-		      {oper = oper,
-		       count = final_count,
-		       dst = final_dst,
-		       size = size}
+                  val instruction 
+                    = Instruction.SRAL
+                      {oper = oper,
+                       count = final_count,
+                       dst = final_dst,
+                       size = size}
 
-		  val {uses = final_uses,
-		       defs = final_defs,  
-		       ...}
-		    = Instruction.uses_defs_kills instruction
+                  val {uses = final_uses,
+                       defs = final_defs,  
+                       ...}
+                    = Instruction.uses_defs_kills instruction
 
-		  val {assembly = assembly_post,
-		       registerAllocation}
-		    = RA.post {uses = uses,
-			       final_uses = final_uses,
-			       defs = defs,
-			       final_defs = final_defs,
-			       kills = kills,
-			       info = info,
-			       registerAllocation = registerAllocation}
-		in
-		  {assembly 
-		   = AppendList.appends 
-		     [assembly_pre,
-		      assembly_count,
-		      assembly_dst,
-		      AppendList.single
-		      (Assembly.instruction instruction),
-		      assembly_post],
-		   registerAllocation = registerAllocation}
-		end
+                  val {assembly = assembly_post,
+                       registerAllocation}
+                    = RA.post {uses = uses,
+                               final_uses = final_uses,
+                               defs = defs,
+                               final_defs = final_defs,
+                               kills = kills,
+                               info = info,
+                               registerAllocation = registerAllocation}
+                in
+                  {assembly 
+                   = AppendList.appends 
+                     [assembly_pre,
+                      assembly_count,
+                      assembly_dst,
+                      AppendList.single
+                      (Assembly.instruction instruction),
+                      assembly_post],
+                   registerAllocation = registerAllocation}
+                end
              | CMP {src2, src1, size}
-	       (* Arithmetic compare;  p. 116
-		* Require src1/src2 operands as follows:
-		*
-		*               src2
-		*           reg imm lab add 
-		*       reg  X   X       X
-		*  src1 imm
-		*       lab
-		*       add  X   X
-		*)
-	     => let
-		  val {uses,defs,kills} 
-		    = Instruction.uses_defs_kills instruction
-		  val {assembly = assembly_pre,
-		       registerAllocation}
-		    = RA.pre {uses = uses,
-			      defs = defs,
-			      kills = kills,
-			      info = info,
-			      registerAllocation = registerAllocation}
+               (* Arithmetic compare;  p. 116
+                * Require src1/src2 operands as follows:
+                *
+                *               src2
+                *           reg imm lab add 
+                *       reg  X   X       X
+                *  src1 imm
+                *       lab
+                *       add  X   X
+                *)
+             => let
+                  val {uses,defs,kills} 
+                    = Instruction.uses_defs_kills instruction
+                  val {assembly = assembly_pre,
+                       registerAllocation}
+                    = RA.pre {uses = uses,
+                              defs = defs,
+                              kills = kills,
+                              info = info,
+                              registerAllocation = registerAllocation}
 
-		  val {final_src1,
-		       final_src2,
-		       assembly_src1_src2,
-		       registerAllocation}
-		    = allocateSrc1Src2 
-		      {src1 = src1,
-		       src2 = src2,
-		       size = size,
-		       info = info,
-		       registerAllocation = registerAllocation}
+                  val {final_src1,
+                       final_src2,
+                       assembly_src1_src2,
+                       registerAllocation}
+                    = allocateSrc1Src2 
+                      {src1 = src1,
+                       src2 = src2,
+                       size = size,
+                       info = info,
+                       registerAllocation = registerAllocation}
 
-		  val instruction
-		    = Instruction.CMP 
-		      {src1 = final_src1,
-		       src2 = final_src2,
-		       size = size}
+                  val instruction
+                    = Instruction.CMP 
+                      {src1 = final_src1,
+                       src2 = final_src2,
+                       size = size}
 
-		  val {uses = final_uses,
-		       defs = final_defs,  
-		       ...}
-		    = Instruction.uses_defs_kills instruction
+                  val {uses = final_uses,
+                       defs = final_defs,  
+                       ...}
+                    = Instruction.uses_defs_kills instruction
 
-		  val {assembly = assembly_post,
-		       registerAllocation}
-		    = RA.post {uses = uses,
-			       final_uses = final_uses,
-			       defs = defs,
-			       final_defs = final_defs,
-			       kills = kills,
-			       info = info,
-			       registerAllocation = registerAllocation}
-		in
-		  {assembly 
-		   = AppendList.appends 
-		     [assembly_pre,
-		      assembly_src1_src2,
-		      AppendList.single
-		      (Assembly.instruction instruction),
-		      assembly_post],
-		   registerAllocation = registerAllocation}
-		end
+                  val {assembly = assembly_post,
+                       registerAllocation}
+                    = RA.post {uses = uses,
+                               final_uses = final_uses,
+                               defs = defs,
+                               final_defs = final_defs,
+                               kills = kills,
+                               info = info,
+                               registerAllocation = registerAllocation}
+                in
+                  {assembly 
+                   = AppendList.appends 
+                     [assembly_pre,
+                      assembly_src1_src2,
+                      AppendList.single
+                      (Assembly.instruction instruction),
+                      assembly_post],
+                   registerAllocation = registerAllocation}
+                end
              | TEST {src2, src1, size}
-	       (* Logical compare; p. 728
-		* Require src1/src2 operands as follows:
-		*
-		*               src2
-		*           reg imm lab add 
-		*       reg  X   X       X
-		*  src1 imm  
-		*       lab
-		*       add  X   X    
-		*)
+               (* Logical compare; p. 728
+                * Require src1/src2 operands as follows:
+                *
+                *               src2
+                *           reg imm lab add 
+                *       reg  X   X       X
+                *  src1 imm  
+                *       lab
+                *       add  X   X    
+                *)
              => let
-		  val {uses,defs,kills} 
-		    = Instruction.uses_defs_kills instruction
-		  val {assembly = assembly_pre,
-		       registerAllocation}
-		    = RA.pre {uses = uses,
-			      defs = defs,
-			      kills = kills,
-			      info = info,
-			      registerAllocation = registerAllocation}
+                  val {uses,defs,kills} 
+                    = Instruction.uses_defs_kills instruction
+                  val {assembly = assembly_pre,
+                       registerAllocation}
+                    = RA.pre {uses = uses,
+                              defs = defs,
+                              kills = kills,
+                              info = info,
+                              registerAllocation = registerAllocation}
 
-		  val {final_src1,
-		       final_src2,
-		       assembly_src1_src2,
-		       registerAllocation}
-		    = allocateSrc1Src2 
-		      {src1 = src1,
-		       src2 = src2,
-		       size = size,
-		       info = info,
-		       registerAllocation = registerAllocation}
+                  val {final_src1,
+                       final_src2,
+                       assembly_src1_src2,
+                       registerAllocation}
+                    = allocateSrc1Src2 
+                      {src1 = src1,
+                       src2 = src2,
+                       size = size,
+                       info = info,
+                       registerAllocation = registerAllocation}
 
-		  val instruction
-		    = Instruction.TEST
-		      {src1 = final_src1,
-		       src2 = final_src2,
-		       size = size}
+                  val instruction
+                    = Instruction.TEST
+                      {src1 = final_src1,
+                       src2 = final_src2,
+                       size = size}
 
-		  val {uses = final_uses,
-		       defs = final_defs,  
-		       ...}
-		    = Instruction.uses_defs_kills instruction
+                  val {uses = final_uses,
+                       defs = final_defs,  
+                       ...}
+                    = Instruction.uses_defs_kills instruction
 
-		  val {assembly = assembly_post,
-		       registerAllocation}
-		    = RA.post {uses = uses,
-			       final_uses = final_uses,
-			       defs = defs,
-			       final_defs = final_defs,
-			       kills = kills,
-			       info = info,
-			       registerAllocation = registerAllocation}
-		in
-		  {assembly 
-		   = AppendList.appends 
-		     [assembly_pre,
-		      assembly_src1_src2,
-		      AppendList.single
-		      (Assembly.instruction instruction),
-		      assembly_post],
-		   registerAllocation = registerAllocation}
-		end
-	     | SETcc {condition, dst, size}
-	       (* Set byte on condition; p. 672
-		* Require dst operand as follows:
-		*
-		*                dst
-		*            reg imm lab add
-		*             *           X
-		*  * only byte registers
-		*)
-	     => let
-		  val {uses,defs,kills} 
-		    = Instruction.uses_defs_kills instruction
-		  val {assembly = assembly_pre,
-		       registerAllocation}
-		    = RA.pre {uses = uses,
-			      defs = defs,
-			      kills = kills,
-			      info = info,
-			      registerAllocation = registerAllocation}
+                  val {assembly = assembly_post,
+                       registerAllocation}
+                    = RA.post {uses = uses,
+                               final_uses = final_uses,
+                               defs = defs,
+                               final_defs = final_defs,
+                               kills = kills,
+                               info = info,
+                               registerAllocation = registerAllocation}
+                in
+                  {assembly 
+                   = AppendList.appends 
+                     [assembly_pre,
+                      assembly_src1_src2,
+                      AppendList.single
+                      (Assembly.instruction instruction),
+                      assembly_post],
+                   registerAllocation = registerAllocation}
+                end
+             | SETcc {condition, dst, size}
+               (* Set byte on condition; p. 672
+                * Require dst operand as follows:
+                *
+                *                dst
+                *            reg imm lab add
+                *             *           X
+                *  * only byte registers
+                *)
+             => let
+                  val {uses,defs,kills} 
+                    = Instruction.uses_defs_kills instruction
+                  val {assembly = assembly_pre,
+                       registerAllocation}
+                    = RA.pre {uses = uses,
+                              defs = defs,
+                              kills = kills,
+                              info = info,
+                              registerAllocation = registerAllocation}
 
-		  val {operand = final_dst,
-		       assembly = assembly_dst,
-		       registerAllocation = registerAllocation}
-		    = RA.allocateOperand 
-		      {operand = dst,
-		       options = {register = true,
-				  immediate = false,
-				  label = false,
-				  address = false},
-		       info = info,
-		       size = size,
-		       move = false,
-		       supports = [],
-		       saves = [],
-		       force = Register.withLowPart (size, Size.BYTE),
-		       registerAllocation = registerAllocation}
+                  val {operand = final_dst,
+                       assembly = assembly_dst,
+                       registerAllocation = registerAllocation}
+                    = RA.allocateOperand 
+                      {operand = dst,
+                       options = {register = true,
+                                  immediate = false,
+                                  label = false,
+                                  address = false},
+                       info = info,
+                       size = size,
+                       move = false,
+                       supports = [],
+                       saves = [],
+                       force = Register.withLowPart (size, Size.BYTE),
+                       registerAllocation = registerAllocation}
 
-		  val temp_dst
-		    = case final_dst
-			of Operand.Register r
-			 => let
-			      val register 
-				= Register.lowPartOf (r, Size.BYTE)
-			    in
-			      Operand.register register
-			    end
-			 | _ => Error.bug "allocateRegisters: SETcc, temp_reg"
+                  val temp_dst
+                    = case final_dst
+                        of Operand.Register r
+                         => let
+                              val register 
+                                = Register.lowPartOf (r, Size.BYTE)
+                            in
+                              Operand.register register
+                            end
+                         | _ => Error.bug "x86AllocateRegisters.Instruction.allocateRegisters: SETcc, temp_reg"
 
-		  val {uses = final_uses,
-		       defs = final_defs,  
-		       ...}
-		    = Instruction.uses_defs_kills
-		      (Instruction.SETcc {condition = condition,
-					  dst = final_dst,
-					  size = size})
+                  val {uses = final_uses,
+                       defs = final_defs,  
+                       ...}
+                    = Instruction.uses_defs_kills
+                      (Instruction.SETcc {condition = condition,
+                                          dst = final_dst,
+                                          size = size})
 
-		  val {assembly = assembly_post,
-		       registerAllocation}
-		    = RA.post {uses = uses,
-			       final_uses = final_uses,
-			       defs = defs,
-			       final_defs = final_defs,
-			       kills = kills,
-			       info = info,
-			       registerAllocation = registerAllocation}
-		in
-		  {assembly 
-		   = AppendList.appends 
-		     [assembly_pre,
-		      assembly_dst,
-		      AppendList.single
-		      (Assembly.instruction_setcc
-		       {condition = condition,
-			dst = temp_dst,
-			size = Size.BYTE}),
-		      if size = Size.BYTE
-			then if Operand.eq (final_dst, temp_dst)
-			       then AppendList.empty
-			       else AppendList.single
-				    (Assembly.instruction_mov
-				     {dst = final_dst,
-				      src = temp_dst,
-				      size = Size.BYTE})
-			else AppendList.single
-			     (Assembly.instruction_movx
-			      {oper = Instruction.MOVZX,
-			       dst = final_dst,
-			       src = temp_dst,
-			       dstsize = size,
-			       srcsize = Size.BYTE}),
-		      assembly_post],
-		   registerAllocation = registerAllocation}
-		end
+                  val {assembly = assembly_post,
+                       registerAllocation}
+                    = RA.post {uses = uses,
+                               final_uses = final_uses,
+                               defs = defs,
+                               final_defs = final_defs,
+                               kills = kills,
+                               info = info,
+                               registerAllocation = registerAllocation}
+                in
+                  {assembly 
+                   = AppendList.appends 
+                     [assembly_pre,
+                      assembly_dst,
+                      AppendList.single
+                      (Assembly.instruction_setcc
+                       {condition = condition,
+                        dst = temp_dst,
+                        size = Size.BYTE}),
+                      if size = Size.BYTE
+                        then if Operand.eq (final_dst, temp_dst)
+                               then AppendList.empty
+                               else AppendList.single
+                                    (Assembly.instruction_mov
+                                     {dst = final_dst,
+                                      src = temp_dst,
+                                      size = Size.BYTE})
+                        else AppendList.single
+                             (Assembly.instruction_movx
+                              {oper = Instruction.MOVZX,
+                               dst = final_dst,
+                               src = temp_dst,
+                               dstsize = size,
+                               srcsize = Size.BYTE}),
+                      assembly_post],
+                   registerAllocation = registerAllocation}
+                end
              | JMP {target, absolute}
-	       (* Jump; p. 373
-		* Require target operand as follows:
-		*
-		*               target
-		*            reg imm lab add
-		*             X   X   X   X
-		*)
-	     => let
-		  val {uses,defs,kills} 
-		    = Instruction.uses_defs_kills instruction
-		  val {assembly = assembly_pre,
-		       registerAllocation}
-		    = RA.pre {uses = uses,
-			      defs = defs,
-			      kills = kills,
-			      info = info,
-			      registerAllocation = registerAllocation}
+               (* Jump; p. 373
+                * Require target operand as follows:
+                *
+                *               target
+                *            reg imm lab add
+                *             X   X   X   X
+                *)
+             => let
+                  val {uses,defs,kills} 
+                    = Instruction.uses_defs_kills instruction
+                  val {assembly = assembly_pre,
+                       registerAllocation}
+                    = RA.pre {uses = uses,
+                              defs = defs,
+                              kills = kills,
+                              info = info,
+                              registerAllocation = registerAllocation}
 
-		  val {operand = final_target,
-		       assembly = assembly_target,
-		       registerAllocation = registerAllocation}
-		    = RA.allocateOperand {operand = target,
-					  options = {register = false,
-						     immediate = true,
-						     label = true,
-						     address = true},
-					  info = info,
-					  size = Size.LONG,
-					  move = true,
-					  supports = [],
-					  saves = [],
-					  force = [],
-					  registerAllocation 
-					  = registerAllocation}
+                  val {operand = final_target,
+                       assembly = assembly_target,
+                       registerAllocation = registerAllocation}
+                    = RA.allocateOperand {operand = target,
+                                          options = {register = false,
+                                                     immediate = true,
+                                                     label = true,
+                                                     address = true},
+                                          info = info,
+                                          size = Size.LONG,
+                                          move = true,
+                                          supports = [],
+                                          saves = [],
+                                          force = [],
+                                          registerAllocation 
+                                          = registerAllocation}
 
-		  val instruction
-		    = Instruction.JMP
-		      {target = final_target,
-		       absolute = absolute}
+                  val instruction
+                    = Instruction.JMP
+                      {target = final_target,
+                       absolute = absolute}
 
-		  val {uses = final_uses,
-		       defs = final_defs,  
-		       ...}
-		    = Instruction.uses_defs_kills instruction
+                  val {uses = final_uses,
+                       defs = final_defs,  
+                       ...}
+                    = Instruction.uses_defs_kills instruction
 
-		  val {assembly = assembly_post,
-		       registerAllocation}
-		    = RA.post {uses = uses,
-			       final_uses = final_uses,
-			       defs = defs,
-			       final_defs = final_defs,
-			       kills = kills,
-			       info = info,
-			       registerAllocation = registerAllocation}
-		in
-		  {assembly 
-		   = AppendList.appends 
-		     [assembly_pre,
-		      assembly_target,
-		      AppendList.single
-		      (Assembly.instruction instruction),
-		      assembly_post],
-		   registerAllocation = registerAllocation}
-		end
-	     | Jcc {condition, target}
-	       (* Jump if condition is met; p. 369
-		* Require target operand as follows:
-		*
-		*               target
-		*            reg imm lab add
-		*                 X   X
-		*)
-	     => let
-		  val {uses,defs,kills} 
-		    = Instruction.uses_defs_kills instruction
-		  val {assembly = assembly_pre,
-		       registerAllocation}
-		    = RA.pre {uses = uses,
-			      defs = defs,
-			      kills = kills,
-			      info = info,
-			      registerAllocation = registerAllocation}
+                  val {assembly = assembly_post,
+                       registerAllocation}
+                    = RA.post {uses = uses,
+                               final_uses = final_uses,
+                               defs = defs,
+                               final_defs = final_defs,
+                               kills = kills,
+                               info = info,
+                               registerAllocation = registerAllocation}
+                in
+                  {assembly 
+                   = AppendList.appends 
+                     [assembly_pre,
+                      assembly_target,
+                      AppendList.single
+                      (Assembly.instruction instruction),
+                      assembly_post],
+                   registerAllocation = registerAllocation}
+                end
+             | Jcc {condition, target}
+               (* Jump if condition is met; p. 369
+                * Require target operand as follows:
+                *
+                *               target
+                *            reg imm lab add
+                *                 X   X
+                *)
+             => let
+                  val {uses,defs,kills} 
+                    = Instruction.uses_defs_kills instruction
+                  val {assembly = assembly_pre,
+                       registerAllocation}
+                    = RA.pre {uses = uses,
+                              defs = defs,
+                              kills = kills,
+                              info = info,
+                              registerAllocation = registerAllocation}
 
-		  val {operand = final_target,
-		       assembly = assembly_target,
-		       registerAllocation = registerAllocation}
-		    = RA.allocateOperand {operand = target,
-					  options = {register = false,
-						     immediate = true,
-						     label = true,
-						     address = false},
-					  info = info,
-					  size = Size.LONG,
-					  move = true,
-					  supports = [],
-					  saves = [],
-					  force = [],
-					  registerAllocation 
-					  = registerAllocation}
+                  val {operand = final_target,
+                       assembly = assembly_target,
+                       registerAllocation = registerAllocation}
+                    = RA.allocateOperand {operand = target,
+                                          options = {register = false,
+                                                     immediate = true,
+                                                     label = true,
+                                                     address = false},
+                                          info = info,
+                                          size = Size.LONG,
+                                          move = true,
+                                          supports = [],
+                                          saves = [],
+                                          force = [],
+                                          registerAllocation 
+                                          = registerAllocation}
 
-		  val instruction
-		    = Instruction.Jcc
-		      {condition = condition,
-		       target = final_target}
+                  val instruction
+                    = Instruction.Jcc
+                      {condition = condition,
+                       target = final_target}
 
-		  val {uses = final_uses,
-		       defs = final_defs,  
-		       ...}
-		    = Instruction.uses_defs_kills instruction
+                  val {uses = final_uses,
+                       defs = final_defs,  
+                       ...}
+                    = Instruction.uses_defs_kills instruction
 
-		  val {assembly = assembly_post,
-		       registerAllocation}
-		    = RA.post {uses = uses,
-			       final_uses = final_uses,
-			       defs = defs,
-			       final_defs = final_defs,
-			       kills = kills,
-			       info = info,
-			       registerAllocation = registerAllocation}
-		in
-		  {assembly 
-		   = AppendList.appends 
-		     [assembly_pre,
-		      assembly_target,
-		      AppendList.single
-		      (Assembly.instruction instruction),
-		      assembly_post],
-		   registerAllocation = registerAllocation}
-		end
+                  val {assembly = assembly_post,
+                       registerAllocation}
+                    = RA.post {uses = uses,
+                               final_uses = final_uses,
+                               defs = defs,
+                               final_defs = final_defs,
+                               kills = kills,
+                               info = info,
+                               registerAllocation = registerAllocation}
+                in
+                  {assembly 
+                   = AppendList.appends 
+                     [assembly_pre,
+                      assembly_target,
+                      AppendList.single
+                      (Assembly.instruction instruction),
+                      assembly_post],
+                   registerAllocation = registerAllocation}
+                end
              | CALL {target, absolute}
-	       (* Call procedure; p. 93 
-		* Require target operand as follows:
-		*
-		*               target
-		*            reg imm lab add
-		*             X   X   X   X
-		*)
-	     => let
-		  val {uses,defs,kills} 
-		    = Instruction.uses_defs_kills instruction
-		  val {assembly = assembly_pre,
-		       registerAllocation}
-		    = RA.pre {uses = uses,
-			      defs = defs,
-			      kills = kills,
-			      info = info,
-			      registerAllocation = registerAllocation}
+               (* Call procedure; p. 93 
+                * Require target operand as follows:
+                *
+                *               target
+                *            reg imm lab add
+                *             X   X   X   X
+                *)
+             => let
+                  val {uses,defs,kills} 
+                    = Instruction.uses_defs_kills instruction
+                  val {assembly = assembly_pre,
+                       registerAllocation}
+                    = RA.pre {uses = uses,
+                              defs = defs,
+                              kills = kills,
+                              info = info,
+                              registerAllocation = registerAllocation}
 
-		  val {operand = final_target,
-		       assembly = assembly_target,
-		       registerAllocation = registerAllocation}
-		    = RA.allocateOperand {operand = target,
-					  options = {register = true,
-						     immediate = true,
-						     label = true,
-						     address = true},
-					  info = info,
-					  size = Size.LONG,
-					  move = true,
-					  supports = [],
-					  saves = [],
-					  force = [],
-					  registerAllocation 
-					  = registerAllocation}
+                  val {operand = final_target,
+                       assembly = assembly_target,
+                       registerAllocation = registerAllocation}
+                    = RA.allocateOperand {operand = target,
+                                          options = {register = true,
+                                                     immediate = true,
+                                                     label = true,
+                                                     address = true},
+                                          info = info,
+                                          size = Size.LONG,
+                                          move = true,
+                                          supports = [],
+                                          saves = [],
+                                          force = [],
+                                          registerAllocation 
+                                          = registerAllocation}
 
-		  val instruction
-		    = Instruction.CALL
-		      {target = final_target,
-		       absolute = absolute}
+                  val instruction
+                    = Instruction.CALL
+                      {target = final_target,
+                       absolute = absolute}
 
-		  val {uses = final_uses,
-		       defs = final_defs,  
-		       ...}
-		    = Instruction.uses_defs_kills instruction
+                  val {uses = final_uses,
+                       defs = final_defs,  
+                       ...}
+                    = Instruction.uses_defs_kills instruction
 
-		  val {assembly = assembly_post,
-		       registerAllocation}
-		    = RA.post {uses = uses,
-			       final_uses = final_uses,
-			       defs = defs,
-			       final_defs = final_defs,
-			       kills = kills,
-			       info = info,
-			       registerAllocation = registerAllocation}
-		in
-		  {assembly 
-		   = AppendList.appends 
-		     [assembly_pre,
-		      assembly_target,
-		      AppendList.single
-		      (Assembly.instruction instruction),
-		      assembly_post],
-		   registerAllocation = registerAllocation}
-		end
+                  val {assembly = assembly_post,
+                       registerAllocation}
+                    = RA.post {uses = uses,
+                               final_uses = final_uses,
+                               defs = defs,
+                               final_defs = final_defs,
+                               kills = kills,
+                               info = info,
+                               registerAllocation = registerAllocation}
+                in
+                  {assembly 
+                   = AppendList.appends 
+                     [assembly_pre,
+                      assembly_target,
+                      AppendList.single
+                      (Assembly.instruction instruction),
+                      assembly_post],
+                   registerAllocation = registerAllocation}
+                end
              | RET {src = SOME src}
-	       (* Return from procedure; p. 648 
-		* Require optional src operand as follows:
-		*
-		*                src
-		*            reg imm lab add
-		*                 X   
-		*)
+               (* Return from procedure; p. 648 
+                * Require optional src operand as follows:
+                *
+                *                src
+                *            reg imm lab add
+                *                 X   
+                *)
              => let
-		  val {uses,defs,kills} 
-		    = Instruction.uses_defs_kills instruction
-		  val {assembly = assembly_pre,
-		       registerAllocation}
-		    = RA.pre {uses = uses,
-			      defs = defs,
-			      kills = kills,
-			      info = info,
-			      registerAllocation = registerAllocation}
+                  val {uses,defs,kills} 
+                    = Instruction.uses_defs_kills instruction
+                  val {assembly = assembly_pre,
+                       registerAllocation}
+                    = RA.pre {uses = uses,
+                              defs = defs,
+                              kills = kills,
+                              info = info,
+                              registerAllocation = registerAllocation}
 
-		  val {operand = final_src,
-		       assembly = assembly_src,
-		       registerAllocation = registerAllocation}
-		    = RA.allocateOperand {operand = src,
-					  options = {register = false,
-						     immediate = true,
-						     label = false,
-						     address = false},
-					  info = info,
-					  size = Size.LONG,
-					  move = true,
-					  supports = [],
-					  saves = [],
-					  force = [],
-					  registerAllocation 
-					  = registerAllocation}
+                  val {operand = final_src,
+                       assembly = assembly_src,
+                       registerAllocation = registerAllocation}
+                    = RA.allocateOperand {operand = src,
+                                          options = {register = false,
+                                                     immediate = true,
+                                                     label = false,
+                                                     address = false},
+                                          info = info,
+                                          size = Size.LONG,
+                                          move = true,
+                                          supports = [],
+                                          saves = [],
+                                          force = [],
+                                          registerAllocation 
+                                          = registerAllocation}
 
-		  val instruction
-		    = Instruction.RET
-		      {src = SOME final_src}
+                  val instruction
+                    = Instruction.RET
+                      {src = SOME final_src}
 
-		  val {uses = final_uses,
-		       defs = final_defs,  
-		       ...}
-		    = Instruction.uses_defs_kills instruction
+                  val {uses = final_uses,
+                       defs = final_defs,  
+                       ...}
+                    = Instruction.uses_defs_kills instruction
 
-		  val {assembly = assembly_post,
-		       registerAllocation}
-		    = RA.post {uses = uses,
-			       final_uses = final_uses,
-			       defs = defs,
-			       final_defs = final_defs,
-			       kills = kills,
-			       info = info,
-			       registerAllocation = registerAllocation}
-		in
-		  {assembly 
-		   = AppendList.appends 
-		     [assembly_pre,
-		      assembly_src,
-		      AppendList.single
-		      (Assembly.instruction instruction),
-		      assembly_post],
-		   registerAllocation = registerAllocation}
-		end
+                  val {assembly = assembly_post,
+                       registerAllocation}
+                    = RA.post {uses = uses,
+                               final_uses = final_uses,
+                               defs = defs,
+                               final_defs = final_defs,
+                               kills = kills,
+                               info = info,
+                               registerAllocation = registerAllocation}
+                in
+                  {assembly 
+                   = AppendList.appends 
+                     [assembly_pre,
+                      assembly_src,
+                      AppendList.single
+                      (Assembly.instruction instruction),
+                      assembly_post],
+                   registerAllocation = registerAllocation}
+                end
              | RET {src = NONE}
-	     => let
-		  val {uses,defs,kills} 
-		    = Instruction.uses_defs_kills instruction
-		  val {assembly = assembly_pre,
-		       registerAllocation}
-		    = RA.pre {uses = uses,
-			      defs = defs,
-			      kills = kills,
-			      info = info,
-			      registerAllocation = registerAllocation}
+             => let
+                  val {uses,defs,kills} 
+                    = Instruction.uses_defs_kills instruction
+                  val {assembly = assembly_pre,
+                       registerAllocation}
+                    = RA.pre {uses = uses,
+                              defs = defs,
+                              kills = kills,
+                              info = info,
+                              registerAllocation = registerAllocation}
 
-		  val instruction
-		    = Instruction.RET
-		      {src = NONE}
+                  val instruction
+                    = Instruction.RET
+                      {src = NONE}
 
-		  val {uses = final_uses,
-		       defs = final_defs,  
-		       ...}
-		    = Instruction.uses_defs_kills instruction
+                  val {uses = final_uses,
+                       defs = final_defs,  
+                       ...}
+                    = Instruction.uses_defs_kills instruction
 
-		  val {assembly = assembly_post,
-		       registerAllocation}
-		    = RA.post {uses = uses,
-			       final_uses = final_uses,
-			       defs = defs,
-			       final_defs = final_defs,
-			       kills = kills,
-			       info = info,
-			       registerAllocation = registerAllocation}
-		in
-		  {assembly 
-		   = AppendList.appends 
-		     [assembly_pre,
-		      AppendList.single
-		      (Assembly.instruction instruction),
-		      assembly_post],
-		   registerAllocation = registerAllocation}
-		end
-	     | MOV {src, dst, size}
-	       (* Move; p. 442 
-		* Require src/dst operands as follows:
-		*
-		*              dst
-		*          reg imm lab add 
-		*      reg  X           X
-		*  src imm  X           X
-		*      lab
-		*      add  X
-		*)
-	     => let
-		  val {uses,defs,kills} 
-		    = Instruction.uses_defs_kills instruction
-		  val {assembly = assembly_pre,
-		       registerAllocation}
-		    = RA.pre {uses = uses,
-			      defs = defs,
-			      kills = kills,
-			      info = info,
-			      registerAllocation = registerAllocation}
+                  val {assembly = assembly_post,
+                       registerAllocation}
+                    = RA.post {uses = uses,
+                               final_uses = final_uses,
+                               defs = defs,
+                               final_defs = final_defs,
+                               kills = kills,
+                               info = info,
+                               registerAllocation = registerAllocation}
+                in
+                  {assembly 
+                   = AppendList.appends 
+                     [assembly_pre,
+                      AppendList.single
+                      (Assembly.instruction instruction),
+                      assembly_post],
+                   registerAllocation = registerAllocation}
+                end
+             | MOV {src, dst, size}
+               (* Move; p. 442 
+                * Require src/dst operands as follows:
+                *
+                *              dst
+                *          reg imm lab add 
+                *      reg  X           X
+                *  src imm  X           X
+                *      lab
+                *      add  X
+                *)
+             => let
+                  val {uses,defs,kills} 
+                    = Instruction.uses_defs_kills instruction
+                  val {assembly = assembly_pre,
+                       registerAllocation}
+                    = RA.pre {uses = uses,
+                              defs = defs,
+                              kills = kills,
+                              info = info,
+                              registerAllocation = registerAllocation}
 
-		  fun default ()
-		    = let
-			val {final_src,
-			     final_dst,
-			     assembly_src_dst,
-			     registerAllocation}
-			  = allocateSrcDst
-			    {src = src,
-			     dst = dst,
-			     move_dst = false,
-			     size = size,
-			     info = info,
-			     registerAllocation = registerAllocation}
-	
-			val isConst0
-			  = fn Immediate.Const (Immediate.Char #"\000") => true
-			     | Immediate.Const (Immediate.Int 0) => true
-			     | Immediate.Const (Immediate.Word 0wx0) => true
-			     | _ => false
+                  fun default ()
+                    = let
+                        val {final_src,
+                             final_dst,
+                             assembly_src_dst,
+                             registerAllocation}
+                          = allocateSrcDst
+                            {src = src,
+                             dst = dst,
+                             move_dst = false,
+                             size = size,
+                             info = info,
+                             registerAllocation = registerAllocation}
+        
+                        val isConst0
+                          = fn Immediate.Const (Immediate.Char #"\000") => true
+                             | Immediate.Const (Immediate.Int 0) => true
+                             | Immediate.Const (Immediate.Word 0wx0) => true
+                             | _ => false
 
-			(* special case moving 0 to a register
-			 *)
-			val instruction
-			  = case (final_src, final_dst)
-			      of (Operand.Immediate immediate,
-				  Operand.Register _)
-			       => if isConst0 (Immediate.destruct immediate)
-				    then Instruction.BinAL
-				         {oper = XOR,
-					  src = final_dst,
-					  dst = final_dst,
-					  size = size}
-				    else Instruction.MOV
-				         {src = final_src,
-					  dst = final_dst,
-					  size = size}
-			       | _ => Instruction.MOV
-				      {src = final_src,
-				       dst = final_dst,
-				       size = size}
+                        (* special case moving 0 to a register
+                         *)
+                        val instruction
+                          = case (final_src, final_dst)
+                              of (Operand.Immediate immediate,
+                                  Operand.Register _)
+                               => if isConst0 (Immediate.destruct immediate)
+                                    then Instruction.BinAL
+                                         {oper = XOR,
+                                          src = final_dst,
+                                          dst = final_dst,
+                                          size = size}
+                                    else Instruction.MOV
+                                         {src = final_src,
+                                          dst = final_dst,
+                                          size = size}
+                               | _ => Instruction.MOV
+                                      {src = final_src,
+                                       dst = final_dst,
+                                       size = size}
 
-			val {uses = final_uses,
-			     defs = final_defs,  
-			     ...}
-			  = Instruction.uses_defs_kills instruction
+                        val {uses = final_uses,
+                             defs = final_defs,  
+                             ...}
+                          = Instruction.uses_defs_kills instruction
 
-			val {assembly = assembly_post,
-			     registerAllocation}
-			  = RA.post {uses = uses,
-				     final_uses = final_uses,
-				     defs = defs,
-				     final_defs = final_defs,
-				     kills = kills,
-				     info = info,
-				     registerAllocation = registerAllocation}
-		      in
-			{assembly 
-			 = AppendList.appends 
-			   [assembly_pre,
-			    assembly_src_dst,
-			    AppendList.single
-			    (Assembly.instruction instruction),
-			    assembly_post],
-			 registerAllocation = registerAllocation}
-		      end
+                        val {assembly = assembly_post,
+                             registerAllocation}
+                          = RA.post {uses = uses,
+                                     final_uses = final_uses,
+                                     defs = defs,
+                                     final_defs = final_defs,
+                                     kills = kills,
+                                     info = info,
+                                     registerAllocation = registerAllocation}
+                      in
+                        {assembly 
+                         = AppendList.appends 
+                           [assembly_pre,
+                            assembly_src_dst,
+                            AppendList.single
+                            (Assembly.instruction instruction),
+                            assembly_post],
+                         registerAllocation = registerAllocation}
+                      end
 
-		  fun default' ({register = register_src,
-				 commit = commit_src,
-				 ...} : RegisterAllocation.value,
-				memloc_dst)
-		    = let
-			val registerAllocation
-			  = RA.remove
-			    {memloc = memloc_dst,
-			     registerAllocation = registerAllocation}
-			    
-			val registerAllocation
-			  = RA.update
-			    {value = {register = register_src,
-				      memloc = memloc_dst,
-				      weight = 1024,
-				      sync = false,
-				      commit = commit_src},
-			     registerAllocation = registerAllocation}
+                  fun default' ({register = register_src,
+                                 commit = commit_src,
+                                 ...} : RegisterAllocation.value,
+                                memloc_dst)
+                    = let
+                        val registerAllocation
+                          = RA.remove
+                            {memloc = memloc_dst,
+                             registerAllocation = registerAllocation}
+                            
+                        val registerAllocation
+                          = RA.update
+                            {value = {register = register_src,
+                                      memloc = memloc_dst,
+                                      weight = 1024,
+                                      sync = false,
+                                      commit = commit_src},
+                             registerAllocation = registerAllocation}
 
-			val final_uses = []
-			val final_defs 
-			  = [Operand.register register_src]
+                        val final_uses = []
+                        val final_defs 
+                          = [Operand.register register_src]
 
-			val {assembly = assembly_post,
-			     registerAllocation}
-			  = RA.post {uses = uses,
-				     final_uses = final_uses,
-				     defs = defs,
-				     final_defs = final_defs,
-				     kills = kills,
-				     info = info,
-				     registerAllocation = registerAllocation}
-		      in
-			{assembly 
-			 = AppendList.appends [assembly_pre,
-					       assembly_post],
-			 registerAllocation = registerAllocation}
-		      end
+                        val {assembly = assembly_post,
+                             registerAllocation}
+                          = RA.post {uses = uses,
+                                     final_uses = final_uses,
+                                     defs = defs,
+                                     final_defs = final_defs,
+                                     kills = kills,
+                                     info = info,
+                                     registerAllocation = registerAllocation}
+                      in
+                        {assembly 
+                         = AppendList.appends [assembly_pre,
+                                               assembly_post],
+                         registerAllocation = registerAllocation}
+                      end
 
-		  fun default'' (memloc_dst)
-		    = let
-			val registerAllocation
-			  = RA.remove
-			    {memloc = memloc_dst,
-			     registerAllocation = registerAllocation}
+                  fun default'' (memloc_dst)
+                    = let
+                        val registerAllocation
+                          = RA.remove
+                            {memloc = memloc_dst,
+                             registerAllocation = registerAllocation}
 
-			val {final_src,
-			     final_dst,
-			     assembly_src_dst,
-			     registerAllocation}
-			  = allocateSrcDst
-			    {src = src,
-			     dst = dst,
-			     move_dst = false,
-			     size = size,
-			     info = info,
-			     registerAllocation = registerAllocation}
+                        val {final_src,
+                             final_dst,
+                             assembly_src_dst,
+                             registerAllocation}
+                          = allocateSrcDst
+                            {src = src,
+                             dst = dst,
+                             move_dst = false,
+                             size = size,
+                             info = info,
+                             registerAllocation = registerAllocation}
 
-			val instruction
-			  = Instruction.MOV
-			    {src = final_src,
-			     dst = final_dst,
-			     size = size}
+                        val instruction
+                          = Instruction.MOV
+                            {src = final_src,
+                             dst = final_dst,
+                             size = size}
 
-			val {uses = final_uses,
-			     defs = final_defs,
-			     ...}
-			  = Instruction.uses_defs_kills instruction
+                        val {uses = final_uses,
+                             defs = final_defs,
+                             ...}
+                          = Instruction.uses_defs_kills instruction
 
-			val {assembly = assembly_post,
-			     registerAllocation}
-			  = RA.post {uses = uses,
-				     final_uses = final_uses,
-				     defs = defs,
-				     final_defs = final_defs,
-				     kills = kills,
-				     info = info,
-				     registerAllocation = registerAllocation}
-		      in
-			{assembly 
-			 = AppendList.appends 
-			   [assembly_pre,
-			    assembly_src_dst,
-			    AppendList.single
-			    (Assembly.instruction instruction),
-			    assembly_post],
-			 registerAllocation = registerAllocation}
-		      end
+                        val {assembly = assembly_post,
+                             registerAllocation}
+                          = RA.post {uses = uses,
+                                     final_uses = final_uses,
+                                     defs = defs,
+                                     final_defs = final_defs,
+                                     kills = kills,
+                                     info = info,
+                                     registerAllocation = registerAllocation}
+                      in
+                        {assembly 
+                         = AppendList.appends 
+                           [assembly_pre,
+                            assembly_src_dst,
+                            AppendList.single
+                            (Assembly.instruction instruction),
+                            assembly_post],
+                         registerAllocation = registerAllocation}
+                      end
 
-		  val memloc_src = Operand.deMemloc src
-		  val value_src 
-		    = case memloc_src
-			of NONE => NONE
-			 | SOME memloc_src
-			 => RA.allocated {memloc = memloc_src,
-					  registerAllocation 
-					  = registerAllocation}
-		  val memloc_dst = Operand.deMemloc dst
-		in
-		  case memloc_dst
-		    of SOME memloc_dst
-		     => if MemLocSet.contains(remove,memloc_dst)
-			  then (case memloc_src
-				  of SOME memloc_src
-				   => if List.contains
-				         (memloc_src::(MemLoc.utilized memloc_src),
-					  memloc_dst,
-					  MemLoc.eq)
-					then default ()
-					else default'' memloc_dst
-				   | NONE => default'' memloc_dst)
-			  else (case value_src
-				  of SOME (value_src as {memloc = memloc_src,
-							 sync = sync_src, ...})
-				    => if MemLocSet.contains(dead,memloc_src)
-				          orelse
-					  (MemLocSet.contains(remove,memloc_src)
-					   andalso
-					   sync_src)
-					 then default' (value_src, memloc_dst)
-					 else default ()
-				    | NONE => default ())
-		     | NONE => default ()
-		end
+                  val memloc_src = Operand.deMemloc src
+                  val value_src 
+                    = case memloc_src
+                        of NONE => NONE
+                         | SOME memloc_src
+                         => RA.allocated {memloc = memloc_src,
+                                          registerAllocation 
+                                          = registerAllocation}
+                  val memloc_dst = Operand.deMemloc dst
+                in
+                  case memloc_dst
+                    of SOME memloc_dst
+                     => if MemLocSet.contains(remove,memloc_dst)
+                          then (case memloc_src
+                                  of SOME memloc_src
+                                   => if List.contains
+                                         (memloc_src::(MemLoc.utilized memloc_src),
+                                          memloc_dst,
+                                          MemLoc.eq)
+                                        then default ()
+                                        else default'' memloc_dst
+                                   | NONE => default'' memloc_dst)
+                          else (case value_src
+                                  of SOME (value_src as {memloc = memloc_src,
+                                                         sync = sync_src, ...})
+                                    => if MemLocSet.contains(dead,memloc_src)
+                                          orelse
+                                          (MemLocSet.contains(remove,memloc_src)
+                                           andalso
+                                           sync_src)
+                                         then default' (value_src, memloc_dst)
+                                         else default ()
+                                    | NONE => default ())
+                     | NONE => default ()
+                end
              | CMOVcc {condition, src, dst, size}
                (* Conditional move; p. 112
-		* Require src/dst operands as follows:
-		*
-		*              dst
-		*          reg imm lab add 
-		*      reg  X
-		*  src imm           
-		*      lab
-		*      add  X
-		*)
-	     => let
-		  val {uses,defs,kills} 
-		    = Instruction.uses_defs_kills instruction
-		  val {assembly = assembly_pre,
-		       registerAllocation}
-		    = RA.pre {uses = uses,
-			      defs = defs,
-			      kills = kills,
-			      info = info,
-			      registerAllocation = registerAllocation}
+                * Require src/dst operands as follows:
+                *
+                *              dst
+                *          reg imm lab add 
+                *      reg  X
+                *  src imm           
+                *      lab
+                *      add  X
+                *)
+             => let
+                  val {uses,defs,kills} 
+                    = Instruction.uses_defs_kills instruction
+                  val {assembly = assembly_pre,
+                       registerAllocation}
+                    = RA.pre {uses = uses,
+                              defs = defs,
+                              kills = kills,
+                              info = info,
+                              registerAllocation = registerAllocation}
 
-		  val {operand = final_src, 
-		       assembly = assembly_src,
-		       registerAllocation}
-		    = RA.allocateOperand {operand = src,
-					  options = {register = true,
-						     immediate = false,
-						     label = false,
-						     address = true}, 
-					  info = info,
-					  size = size,
-					  move = true,
-					  supports = [dst],
-					  saves = [],
-					  force = [],
-					  registerAllocation 
-					  = registerAllocation}
+                  val {operand = final_src, 
+                       assembly = assembly_src,
+                       registerAllocation}
+                    = RA.allocateOperand {operand = src,
+                                          options = {register = true,
+                                                     immediate = false,
+                                                     label = false,
+                                                     address = true}, 
+                                          info = info,
+                                          size = size,
+                                          move = true,
+                                          supports = [dst],
+                                          saves = [],
+                                          force = [],
+                                          registerAllocation 
+                                          = registerAllocation}
 
-		  val {operand = final_dst,
-		       assembly = assembly_dst,
-		       registerAllocation = registerAllocation}
-		    = RA.allocateOperand {operand = dst,
-					  options = {register = true,
-						     immediate = false,
-						     label = false,
-						     address = false},
-					  info = info,
-					  size = size,
-					  move = false,
-					  supports = [],
-					  saves = [src,final_src],
-					  force = [],
-					  registerAllocation 
-					  = registerAllocation}
+                  val {operand = final_dst,
+                       assembly = assembly_dst,
+                       registerAllocation = registerAllocation}
+                    = RA.allocateOperand {operand = dst,
+                                          options = {register = true,
+                                                     immediate = false,
+                                                     label = false,
+                                                     address = false},
+                                          info = info,
+                                          size = size,
+                                          move = false,
+                                          supports = [],
+                                          saves = [src,final_src],
+                                          force = [],
+                                          registerAllocation 
+                                          = registerAllocation}
 
-		  val instruction
-		    = Instruction.CMOVcc 
-		      {condition = condition,
-		       src = final_src,
-		       dst = final_dst,
-		       size = size}
+                  val instruction
+                    = Instruction.CMOVcc 
+                      {condition = condition,
+                       src = final_src,
+                       dst = final_dst,
+                       size = size}
 
-		  val {uses = final_uses,
-		       defs = final_defs,  
-		       ...}
-		    = Instruction.uses_defs_kills instruction
+                  val {uses = final_uses,
+                       defs = final_defs,  
+                       ...}
+                    = Instruction.uses_defs_kills instruction
 
-		  val {assembly = assembly_post,
-		       registerAllocation}
-		    = RA.post {uses = uses,
-			       final_uses = final_uses,
-			       defs = defs,
-			       final_defs = final_defs,
-			       kills = kills,
-			       info = info,
-			       registerAllocation = registerAllocation}
-		in
-		  {assembly 
-		   = AppendList.appends 
-		     [assembly_pre,
-		      assembly_src,
-		      assembly_dst,
-		      AppendList.single
-		      (Assembly.instruction instruction),
-		      assembly_post],
-		   registerAllocation = registerAllocation}
-		end
+                  val {assembly = assembly_post,
+                       registerAllocation}
+                    = RA.post {uses = uses,
+                               final_uses = final_uses,
+                               defs = defs,
+                               final_defs = final_defs,
+                               kills = kills,
+                               info = info,
+                               registerAllocation = registerAllocation}
+                in
+                  {assembly 
+                   = AppendList.appends 
+                     [assembly_pre,
+                      assembly_src,
+                      assembly_dst,
+                      AppendList.single
+                      (Assembly.instruction instruction),
+                      assembly_post],
+                   registerAllocation = registerAllocation}
+                end
              | XCHG {src, dst, size}
-       	       (* Exchange register/memory with register; p. 754
-		* Require src/dst operands as follows:
-		*
-		*              dst
-		*          reg imm lab add 
-		*      reg  X           X
-		*  src imm           
-		*      lab
-		*      add  X
-		*)
-	     => let
-		  val {uses,defs,kills} 
-		    = Instruction.uses_defs_kills instruction
-		  val {assembly = assembly_pre,
-		       registerAllocation}
-		    = RA.pre {uses = uses,
-			      defs = defs,
-			      kills = kills,
-			      info = info,
-			      registerAllocation = registerAllocation}
+               (* Exchange register/memory with register; p. 754
+                * Require src/dst operands as follows:
+                *
+                *              dst
+                *          reg imm lab add 
+                *      reg  X           X
+                *  src imm           
+                *      lab
+                *      add  X
+                *)
+             => let
+                  val {uses,defs,kills} 
+                    = Instruction.uses_defs_kills instruction
+                  val {assembly = assembly_pre,
+                       registerAllocation}
+                    = RA.pre {uses = uses,
+                              defs = defs,
+                              kills = kills,
+                              info = info,
+                              registerAllocation = registerAllocation}
 
-		  val {final_src,
-		       final_dst,
-		       assembly_src_dst,
-		       registerAllocation}
-		    = allocateSrcDst {src = src,
-				      dst = dst,
-				      move_dst = true,
-				      size = size,
-				      info = info,
-				      registerAllocation = registerAllocation}
+                  val {final_src,
+                       final_dst,
+                       assembly_src_dst,
+                       registerAllocation}
+                    = allocateSrcDst {src = src,
+                                      dst = dst,
+                                      move_dst = true,
+                                      size = size,
+                                      info = info,
+                                      registerAllocation = registerAllocation}
 
-		  val instruction
-		    = Instruction.XCHG
-		      {src = final_src,
-		       dst = final_dst,
-		       size = size}
+                  val instruction
+                    = Instruction.XCHG
+                      {src = final_src,
+                       dst = final_dst,
+                       size = size}
 
-		  val {uses = final_uses,
-		       defs = final_defs,  
-		       ...}
-		    = Instruction.uses_defs_kills instruction
+                  val {uses = final_uses,
+                       defs = final_defs,  
+                       ...}
+                    = Instruction.uses_defs_kills instruction
 
-		  val {assembly = assembly_post,
-		       registerAllocation}
-		    = RA.post {uses = uses,
-			       final_uses = final_uses,
-			       defs = defs,
-			       final_defs = final_defs,
-			       kills = kills,
-			       info = info,
-			       registerAllocation = registerAllocation}
-		in
-		  {assembly 
-		   = AppendList.appends 
-		     [assembly_pre,
-		      assembly_src_dst,
-		      AppendList.single
-		      (Assembly.instruction instruction),
-		      assembly_post],
-		   registerAllocation = registerAllocation}
-		end
+                  val {assembly = assembly_post,
+                       registerAllocation}
+                    = RA.post {uses = uses,
+                               final_uses = final_uses,
+                               defs = defs,
+                               final_defs = final_defs,
+                               kills = kills,
+                               info = info,
+                               registerAllocation = registerAllocation}
+                in
+                  {assembly 
+                   = AppendList.appends 
+                     [assembly_pre,
+                      assembly_src_dst,
+                      AppendList.single
+                      (Assembly.instruction instruction),
+                      assembly_post],
+                   registerAllocation = registerAllocation}
+                end
              | pPUSH {src, base, size}
-  	       (* Pseudo push a value onto the stack; p. 621
-		* Require src operand as follows:
-		*
-		*               src
-		*           reg imm lab add
-		*            *   X       X
-		*   * only word or long registers
-		*
-		*               base
-		*           reg imm lab add
-		*            *
-		*   * only %esp
-		*)
+               (* Pseudo push a value onto the stack; p. 621
+                * Require src operand as follows:
+                *
+                *               src
+                *           reg imm lab add
+                *            *   X       X
+                *   * only word or long registers
+                *
+                *               base
+                *           reg imm lab add
+                *            *
+                *   * only %esp
+                *)
              => let
-		  val {uses,defs,kills} 
-		    = Instruction.uses_defs_kills instruction
-		  val {assembly = assembly_pre,
-		       registerAllocation}
-		    = RA.pre {uses = uses,
-			      defs = defs,
-			      kills = kills,
-			      info = info,
-			      registerAllocation = registerAllocation}
+                  val {uses,defs,kills} 
+                    = Instruction.uses_defs_kills instruction
+                  val {assembly = assembly_pre,
+                       registerAllocation}
+                    = RA.pre {uses = uses,
+                              defs = defs,
+                              kills = kills,
+                              info = info,
+                              registerAllocation = registerAllocation}
 
-		  val {assembly = assembly_base,
-		       registerAllocation,
-		       ...}
-		    = RA.allocateOperand {operand = base,
-					  options = {register = true,
-						     immediate = false,
-						     label = false,
-						     address = false},
-					  info = info,
-					  size = Size.LONG,
-					  move = true,
-					  supports = [src],
-					  saves = [],
-					  force = [Register.esp],
-					  registerAllocation 
-					  = registerAllocation}
+                  val {assembly = assembly_base,
+                       registerAllocation,
+                       ...}
+                    = RA.allocateOperand {operand = base,
+                                          options = {register = true,
+                                                     immediate = false,
+                                                     label = false,
+                                                     address = false},
+                                          info = info,
+                                          size = Size.LONG,
+                                          move = true,
+                                          supports = [src],
+                                          saves = [],
+                                          force = [Register.esp],
+                                          registerAllocation 
+                                          = registerAllocation}
 
-		  val options
-		    = case size
-			of Size.WORD
-			 => {register = true,
-			     immediate = true,
-			     label = false,
-			     address = true}
-			 | Size.LONG
-			 => {register = true,
-			     immediate = true,
-			     label = false,
-			     address = true}
-			 | _
-			 => {register = false,
-			     immediate = true,
-			     label = false,
-			     address = true}
+                  val options
+                    = case size
+                        of Size.WORD
+                         => {register = true,
+                             immediate = true,
+                             label = false,
+                             address = true}
+                         | Size.LONG
+                         => {register = true,
+                             immediate = true,
+                             label = false,
+                             address = true}
+                         | _
+                         => {register = false,
+                             immediate = true,
+                             label = false,
+                             address = true}
 
-		  val {operand = final_src, 
-		       assembly = assembly_src,
-		       registerAllocation}
-		    = RA.allocateOperand {operand = src,
-					  options = options,
-					  info = info,
-					  size = size,
-					  move = true,
-					  supports = [],
-					  saves = [],
-					  force = [],
-					  registerAllocation 
-					  = registerAllocation}
+                  val {operand = final_src, 
+                       assembly = assembly_src,
+                       registerAllocation}
+                    = RA.allocateOperand {operand = src,
+                                          options = options,
+                                          info = info,
+                                          size = size,
+                                          move = true,
+                                          supports = [],
+                                          saves = [],
+                                          force = [],
+                                          registerAllocation 
+                                          = registerAllocation}
 
-		  val instruction
-		    = Instruction.PUSH
-		      {src = final_src,
-		       size = size}
+                  val instruction
+                    = Instruction.PUSH
+                      {src = final_src,
+                       size = size}
 
-		  val {uses = final_uses,
-		       defs = final_defs,  
-		       ...}
-		    = Instruction.uses_defs_kills instruction
+                  val {uses = final_uses,
+                       defs = final_defs,  
+                       ...}
+                    = Instruction.uses_defs_kills instruction
 
-		  val {assembly = assembly_post,
-		       registerAllocation}
-		    = RA.post {uses = uses,
-			       final_uses = final_uses,
-			       defs = defs,
-			       final_defs = final_defs,
-			       kills = kills,
-			       info = info,
-			       registerAllocation = registerAllocation}
-		in
-		  {assembly 
-		   = AppendList.appends 
-		     [assembly_pre,
-		      assembly_base,
-		      assembly_src,
-		      AppendList.single
-		      (Assembly.instruction instruction),
-		      assembly_post],
-		   registerAllocation = registerAllocation}
-		end
+                  val {assembly = assembly_post,
+                       registerAllocation}
+                    = RA.post {uses = uses,
+                               final_uses = final_uses,
+                               defs = defs,
+                               final_defs = final_defs,
+                               kills = kills,
+                               info = info,
+                               registerAllocation = registerAllocation}
+                in
+                  {assembly 
+                   = AppendList.appends 
+                     [assembly_pre,
+                      assembly_base,
+                      assembly_src,
+                      AppendList.single
+                      (Assembly.instruction instruction),
+                      assembly_post],
+                   registerAllocation = registerAllocation}
+                end
              | pPOP {dst, base, size}
-	       (* Pseudo pop a value from the stack; p. 571
-		* Require dst operand as follows:
-		*
-		*               dst
-		*           reg imm lab add
-		*            *           X
-		*   * only word or long registers
-		*               base
-		*           reg imm lab add
-		*            *
-		*   * only %esp
-		*)
+               (* Pseudo pop a value from the stack; p. 571
+                * Require dst operand as follows:
+                *
+                *               dst
+                *           reg imm lab add
+                *            *           X
+                *   * only word or long registers
+                *               base
+                *           reg imm lab add
+                *            *
+                *   * only %esp
+                *)
              => let
-		  val {uses,defs,kills} 
-		    = Instruction.uses_defs_kills instruction
-		  val {assembly = assembly_pre,
-		       registerAllocation}
-		    = RA.pre {uses = uses,
-			      defs = defs,
-			      kills = kills,
-			      info = info,
-			      registerAllocation = registerAllocation}
+                  val {uses,defs,kills} 
+                    = Instruction.uses_defs_kills instruction
+                  val {assembly = assembly_pre,
+                       registerAllocation}
+                    = RA.pre {uses = uses,
+                              defs = defs,
+                              kills = kills,
+                              info = info,
+                              registerAllocation = registerAllocation}
 
-		  val {assembly = assembly_base,
-		       registerAllocation,
-		       ...}
-		    = RA.allocateOperand {operand = base,
-					  options = {register = true,
-						     immediate = false,
-						     label = false,
-						     address = false},
-					  info = info,
-					  size = Size.LONG,
-					  move = true,
-					  supports = [dst],
-					  saves = [],
-					  force = [Register.esp],
-					  registerAllocation 
-					  = registerAllocation}
+                  val {assembly = assembly_base,
+                       registerAllocation,
+                       ...}
+                    = RA.allocateOperand {operand = base,
+                                          options = {register = true,
+                                                     immediate = false,
+                                                     label = false,
+                                                     address = false},
+                                          info = info,
+                                          size = Size.LONG,
+                                          move = true,
+                                          supports = [dst],
+                                          saves = [],
+                                          force = [Register.esp],
+                                          registerAllocation 
+                                          = registerAllocation}
 
-		  val options
-		    = case size
-			of Size.WORD
-			 => {register = true,
-			     immediate = false,
-			     label = false,
-			     address = true}
-			 | Size.LONG
-			 => {register = true,
-			     immediate = false,
-			     label = false,
-			     address = true}
-			 | _
-			 => {register = false,
-			     immediate = false,
-			     label = false,
-			     address = true}
+                  val options
+                    = case size
+                        of Size.WORD
+                         => {register = true,
+                             immediate = false,
+                             label = false,
+                             address = true}
+                         | Size.LONG
+                         => {register = true,
+                             immediate = false,
+                             label = false,
+                             address = true}
+                         | _
+                         => {register = false,
+                             immediate = false,
+                             label = false,
+                             address = true}
 
-		  val {operand = final_dst, 
-		       assembly = assembly_dst,
-		       registerAllocation}
-		    = RA.allocateOperand {operand = dst,
-					  options = options,
-					  info = info,
-					  size = size,
-					  move = false,
-					  supports = [],
-					  saves = [],
-					  force = [],
-					  registerAllocation 
-					  = registerAllocation}
+                  val {operand = final_dst, 
+                       assembly = assembly_dst,
+                       registerAllocation}
+                    = RA.allocateOperand {operand = dst,
+                                          options = options,
+                                          info = info,
+                                          size = size,
+                                          move = false,
+                                          supports = [],
+                                          saves = [],
+                                          force = [],
+                                          registerAllocation 
+                                          = registerAllocation}
 
-		  val instruction
-		    = Instruction.POP
-		      {dst = final_dst,
-		       size = size}
+                  val instruction
+                    = Instruction.POP
+                      {dst = final_dst,
+                       size = size}
 
-		  val {uses = final_uses,
-		       defs = final_defs,  
-		       ...}
-		    = Instruction.uses_defs_kills instruction
+                  val {uses = final_uses,
+                       defs = final_defs,  
+                       ...}
+                    = Instruction.uses_defs_kills instruction
 
-		  val {assembly = assembly_post,
-		       registerAllocation}
-		    = RA.post {uses = uses,
-			       final_uses = final_uses,
-			       defs = defs,
-			       final_defs = final_defs,
-			       kills = kills,
-			       info = info,
-			       registerAllocation = registerAllocation}
-		in
-		  {assembly 
-		   = AppendList.appends 
-		     [assembly_pre,
-		      assembly_base,
-		      assembly_dst,
-		      AppendList.single
-		      (Assembly.instruction instruction),
-		      assembly_post],
-		   registerAllocation = registerAllocation}
-		end
+                  val {assembly = assembly_post,
+                       registerAllocation}
+                    = RA.post {uses = uses,
+                               final_uses = final_uses,
+                               defs = defs,
+                               final_defs = final_defs,
+                               kills = kills,
+                               info = info,
+                               registerAllocation = registerAllocation}
+                in
+                  {assembly 
+                   = AppendList.appends 
+                     [assembly_pre,
+                      assembly_base,
+                      assembly_dst,
+                      AppendList.single
+                      (Assembly.instruction instruction),
+                      assembly_post],
+                   registerAllocation = registerAllocation}
+                end
              | MOVX {oper, src, dst, srcsize, dstsize}
-	       (* Move with extention.
-		* Require src/dst operands as follows:
-		*
-		*              dst
-		*          reg imm lab add 
-		*      reg  X
-		*  src imm
-		*      lab
-		*      add  X
-		*)
-	     => let
-		  val {uses,defs,kills} 
-		    = Instruction.uses_defs_kills instruction
-		  val {assembly = assembly_pre,
-		       registerAllocation}
-		    = RA.pre {uses = uses,
-			      defs = defs,
-			      kills = kills,
-			      info = info,
-			      registerAllocation = registerAllocation}
+               (* Move with extention.
+                * Require src/dst operands as follows:
+                *
+                *              dst
+                *          reg imm lab add 
+                *      reg  X
+                *  src imm
+                *      lab
+                *      add  X
+                *)
+             => let
+                  val {uses,defs,kills} 
+                    = Instruction.uses_defs_kills instruction
+                  val {assembly = assembly_pre,
+                       registerAllocation}
+                    = RA.pre {uses = uses,
+                              defs = defs,
+                              kills = kills,
+                              info = info,
+                              registerAllocation = registerAllocation}
 
-		  val {operand = final_src, 
-		       assembly = assembly_src,
-		       registerAllocation}
-		    = RA.allocateOperand {operand = src,
-					  options = {register = true,
-						     immediate = false,
-						     label = false,
-						     address = true}, 
-					  info = info,
-					  size = srcsize,
-					  move = true,
-					  supports = [dst],
-					  saves = [],
-					  force = [],
-					  registerAllocation 
-					  = registerAllocation}
+                  val {operand = final_src, 
+                       assembly = assembly_src,
+                       registerAllocation}
+                    = RA.allocateOperand {operand = src,
+                                          options = {register = true,
+                                                     immediate = false,
+                                                     label = false,
+                                                     address = true}, 
+                                          info = info,
+                                          size = srcsize,
+                                          move = true,
+                                          supports = [dst],
+                                          saves = [],
+                                          force = [],
+                                          registerAllocation 
+                                          = registerAllocation}
 
-		  val {operand = final_dst,
-		       assembly = assembly_dst,
-		       registerAllocation = registerAllocation}
-		    = RA.allocateOperand {operand = dst,
-					  options = {register = true,
-						     immediate = false,
-						     label = false,
-						     address = false},
-					  info = info,
-					  size = dstsize,
-					  move = false,
-					  supports = [],
-					  saves = [src,final_src],
-					  force = [],
-					  registerAllocation 
-					  = registerAllocation}
+                  val {operand = final_dst,
+                       assembly = assembly_dst,
+                       registerAllocation = registerAllocation}
+                    = RA.allocateOperand {operand = dst,
+                                          options = {register = true,
+                                                     immediate = false,
+                                                     label = false,
+                                                     address = false},
+                                          info = info,
+                                          size = dstsize,
+                                          move = false,
+                                          supports = [],
+                                          saves = [src,final_src],
+                                          force = [],
+                                          registerAllocation 
+                                          = registerAllocation}
 
-		  val instruction
-		    = Instruction.MOVX
-		      {oper = oper,
-		       src = final_src,
-		       dst = final_dst,
-		       srcsize = srcsize,
-		       dstsize = dstsize}
+                  val instruction
+                    = Instruction.MOVX
+                      {oper = oper,
+                       src = final_src,
+                       dst = final_dst,
+                       srcsize = srcsize,
+                       dstsize = dstsize}
 
-		  val {uses = final_uses,
-		       defs = final_defs,  
-		       ...}
-		    = Instruction.uses_defs_kills instruction
+                  val {uses = final_uses,
+                       defs = final_defs,  
+                       ...}
+                    = Instruction.uses_defs_kills instruction
 
-		  val {assembly = assembly_post,
-		       registerAllocation}
-		    = RA.post {uses = uses,
-			       final_uses = final_uses,
-			       defs = defs,
-			       final_defs = final_defs,
-			       kills = kills,
-			       info = info,
-			       registerAllocation = registerAllocation}
-		in
-		  {assembly 
-		   = AppendList.appends 
-		     [assembly_pre,
-		      assembly_src,
-		      assembly_dst,
-		      AppendList.single
-		      (Assembly.instruction instruction),
-		      assembly_post],
-		   registerAllocation = registerAllocation}
-		end
+                  val {assembly = assembly_post,
+                       registerAllocation}
+                    = RA.post {uses = uses,
+                               final_uses = final_uses,
+                               defs = defs,
+                               final_defs = final_defs,
+                               kills = kills,
+                               info = info,
+                               registerAllocation = registerAllocation}
+                in
+                  {assembly 
+                   = AppendList.appends 
+                     [assembly_pre,
+                      assembly_src,
+                      assembly_dst,
+                      AppendList.single
+                      (Assembly.instruction instruction),
+                      assembly_post],
+                   registerAllocation = registerAllocation}
+                end
              | XVOM {src, dst, srcsize, dstsize}
-	       (* Move with contraction.
-		* Require src/dst operands as follows:
-		*
-		*              dst
-		*          reg imm lab add 
-		*      reg  X           X
-		*  src imm
-		*      lab
-		*      add
-		*)
-	     => let
-		  val {uses,defs,kills} 
-		    = Instruction.uses_defs_kills instruction
-		  val {assembly = assembly_pre,
-		       registerAllocation}
-		    = RA.pre {uses = uses,
-			      defs = defs,
-			      kills = kills,
-			      info = info,
-			      registerAllocation = registerAllocation}
+               (* Move with contraction.
+                * Require src/dst operands as follows:
+                *
+                *              dst
+                *          reg imm lab add 
+                *      reg  X           X
+                *  src imm
+                *      lab
+                *      add
+                *)
+             => let
+                  val {uses,defs,kills} 
+                    = Instruction.uses_defs_kills instruction
+                  val {assembly = assembly_pre,
+                       registerAllocation}
+                    = RA.pre {uses = uses,
+                              defs = defs,
+                              kills = kills,
+                              info = info,
+                              registerAllocation = registerAllocation}
 
-		  val {operand = final_src, 
-		       assembly = assembly_src,
-		       registerAllocation}
-		    = RA.allocateOperand {operand = src,
-					  options = {register = true,
-						     immediate = false,
-						     label = false,
-						     address = false}, 
-					  info = info,
-					  size = srcsize,
-					  move = true,
-					  supports = [dst],
-					  saves = [],
-					  force 
-					  = Register.withLowPart (srcsize,
-								  dstsize),
-					  registerAllocation 
-					  = registerAllocation}
+                  val {operand = final_src, 
+                       assembly = assembly_src,
+                       registerAllocation}
+                    = RA.allocateOperand {operand = src,
+                                          options = {register = true,
+                                                     immediate = false,
+                                                     label = false,
+                                                     address = false}, 
+                                          info = info,
+                                          size = srcsize,
+                                          move = true,
+                                          supports = [dst],
+                                          saves = [],
+                                          force 
+                                          = Register.withLowPart (srcsize,
+                                                                  dstsize),
+                                          registerAllocation 
+                                          = registerAllocation}
 
-		  val {operand = final_dst,
-		       assembly = assembly_dst,
-		       registerAllocation = registerAllocation}
-		    = RA.allocateOperand {operand = dst,
-					  options = {register = true,
-						     immediate = false,
-						     label = false,
-						     address = true},
-					  info = info,
-					  size = dstsize,
-					  move = false,
-					  supports = [],
-					  saves = [src,final_src],
-					  force = [],
-					  registerAllocation 
-					  = registerAllocation}
+                  val {operand = final_dst,
+                       assembly = assembly_dst,
+                       registerAllocation = registerAllocation}
+                    = RA.allocateOperand {operand = dst,
+                                          options = {register = true,
+                                                     immediate = false,
+                                                     label = false,
+                                                     address = true},
+                                          info = info,
+                                          size = dstsize,
+                                          move = false,
+                                          supports = [],
+                                          saves = [src,final_src],
+                                          force = [],
+                                          registerAllocation 
+                                          = registerAllocation}
 
-		  val {uses = final_uses,
-		       defs = final_defs,  
-		       ...}
-		    = Instruction.uses_defs_kills
-		      (Instruction.XVOM
-		       {src = final_src,
-			dst = final_dst,
-			srcsize = srcsize,
-			dstsize = dstsize})
+                  val {uses = final_uses,
+                       defs = final_defs,  
+                       ...}
+                    = Instruction.uses_defs_kills
+                      (Instruction.XVOM
+                       {src = final_src,
+                        dst = final_dst,
+                        srcsize = srcsize,
+                        dstsize = dstsize})
 
-		  val temp_reg
-		    = case final_src
-			of Operand.Register r 
-			 => Register.lowPartOf (r, dstsize)
-			 | _ 
-			 => Error.bug "allocateRegisters: XVOM, temp_reg"
+                  val temp_reg
+                    = case final_src
+                        of Operand.Register r 
+                         => Register.lowPartOf (r, dstsize)
+                         | _ 
+                         => Error.bug "x86AllocateRegisters.Instruction.allocateRegisters: XVOM, temp_reg"
 
-		  val instruction
-		     = Instruction.MOV
-		       {src = Operand.register temp_reg,
-			dst = final_dst,
-			size = dstsize}
+                  val instruction
+                     = Instruction.MOV
+                       {src = Operand.register temp_reg,
+                        dst = final_dst,
+                        size = dstsize}
 
-		  val {assembly = assembly_post,
-		       registerAllocation}
-		    = RA.post {uses = uses,
-			       final_uses = final_uses,
-			       defs = defs,
-			       final_defs = final_defs,
-			       kills = kills,
-			       info = info,
-			       registerAllocation = registerAllocation}
-		in
-		  {assembly 
-		   = AppendList.appends 
-		     [assembly_pre,
-		      assembly_src,
-		      assembly_dst,	
-		      AppendList.single
-		      (Assembly.instruction instruction),
-		      assembly_post],
-		   registerAllocation = registerAllocation}
-		end
+                  val {assembly = assembly_post,
+                       registerAllocation}
+                    = RA.post {uses = uses,
+                               final_uses = final_uses,
+                               defs = defs,
+                               final_defs = final_defs,
+                               kills = kills,
+                               info = info,
+                               registerAllocation = registerAllocation}
+                in
+                  {assembly 
+                   = AppendList.appends 
+                     [assembly_pre,
+                      assembly_src,
+                      assembly_dst,     
+                      AppendList.single
+                      (Assembly.instruction instruction),
+                      assembly_post],
+                   registerAllocation = registerAllocation}
+                end
              | LEA {src, dst, size}
-	       (* Load effective address; p. 393
-		* Require src/dst operands as follows:
-		*
-		*              dst
-		*          reg imm lab add 
-		*      reg
-		*  src imm
-		*      lab
-		*      add  X
-		*)
-	     => let
-		  val {uses,defs,kills} 
-		    = Instruction.uses_defs_kills instruction
-		  val {assembly = assembly_pre,
-		       registerAllocation}
-		    = RA.pre {uses = uses,
-			      defs = defs,
-			      kills = kills,
-			      info = info,
-			      registerAllocation = registerAllocation}
+               (* Load effective address; p. 393
+                * Require src/dst operands as follows:
+                *
+                *              dst
+                *          reg imm lab add 
+                *      reg
+                *  src imm
+                *      lab
+                *      add  X
+                *)
+             => let
+                  val {uses,defs,kills} 
+                    = Instruction.uses_defs_kills instruction
+                  val {assembly = assembly_pre,
+                       registerAllocation}
+                    = RA.pre {uses = uses,
+                              defs = defs,
+                              kills = kills,
+                              info = info,
+                              registerAllocation = registerAllocation}
 
-		  val {operand = final_src, 
-		       assembly = assembly_src,
-		       registerAllocation}
-		    = RA.allocateOperand {operand = src,
-					  options = {register = false,
-						     immediate = false,
-						     label = false,
-						     address = true}, 
-					  info = info,
-					  size = size,
-					  move = true,
-					  supports = [dst],
-					  saves = [],
-					  force = [],
-					  registerAllocation 
-					  = registerAllocation}
+                  val {operand = final_src, 
+                       assembly = assembly_src,
+                       registerAllocation}
+                    = RA.allocateOperand {operand = src,
+                                          options = {register = false,
+                                                     immediate = false,
+                                                     label = false,
+                                                     address = true}, 
+                                          info = info,
+                                          size = size,
+                                          move = true,
+                                          supports = [dst],
+                                          saves = [],
+                                          force = [],
+                                          registerAllocation 
+                                          = registerAllocation}
 
-		  val {operand = final_dst,
-		       assembly = assembly_dst,
-		       registerAllocation = registerAllocation}
-		    = RA.allocateOperand {operand = dst,
-					  options = {register = true,
-						     immediate = false,
-						     label = false,
-						     address = false},
-					  info = info,
-					  size = size,
-					  move = false,	
-					  supports = [],
-					  saves = [src,final_src],
-					  force = [],
-					  registerAllocation 
-					  = registerAllocation}
+                  val {operand = final_dst,
+                       assembly = assembly_dst,
+                       registerAllocation = registerAllocation}
+                    = RA.allocateOperand {operand = dst,
+                                          options = {register = true,
+                                                     immediate = false,
+                                                     label = false,
+                                                     address = false},
+                                          info = info,
+                                          size = size,
+                                          move = false, 
+                                          supports = [],
+                                          saves = [src,final_src],
+                                          force = [],
+                                          registerAllocation 
+                                          = registerAllocation}
 
-		  val instruction
-		    = Instruction.LEA
-		      {src = final_src,
-		       dst = final_dst,
-		       size = size}
+                  val instruction
+                    = Instruction.LEA
+                      {src = final_src,
+                       dst = final_dst,
+                       size = size}
 
-		  val {uses = final_uses,
-		       defs = final_defs,  
-		       ...}
-		    = Instruction.uses_defs_kills instruction
+                  val {uses = final_uses,
+                       defs = final_defs,  
+                       ...}
+                    = Instruction.uses_defs_kills instruction
 
-		  val {assembly = assembly_post,
-		       registerAllocation}
-		    = RA.post {uses = uses,
-			       final_uses = final_uses,
-			       defs = defs,
-			       final_defs = final_defs,
-			       kills = kills,
-			       info = info,
-			       registerAllocation = registerAllocation}
-		in
-		  {assembly 
-		   = AppendList.appends 
-		     [assembly_pre,
-		      assembly_src,
-		      assembly_dst,
-		      AppendList.single
-		      (Assembly.instruction instruction),
-		      assembly_post],
-		   registerAllocation = registerAllocation}
-		end
-	     | pFMOV {src, dst, size} => pfmov {instruction = instruction, info = info,
-						registerAllocation = registerAllocation,
-						src = src, dst = dst, 
-						srcsize = size, dstsize = size}
-	     | pFMOVX {src, dst, srcsize, dstsize} => pfmov {instruction = instruction, info = info,
-							     registerAllocation = registerAllocation,
-							     src = src, dst = dst, 
-							     srcsize = srcsize, dstsize = dstsize}
-	     | pFXVOM {src, dst, srcsize, dstsize} => pfmov {instruction = instruction, info = info,
-							     registerAllocation = registerAllocation,
-							     src = src, dst = dst, 
-							     srcsize = srcsize, dstsize = dstsize}
+                  val {assembly = assembly_post,
+                       registerAllocation}
+                    = RA.post {uses = uses,
+                               final_uses = final_uses,
+                               defs = defs,
+                               final_defs = final_defs,
+                               kills = kills,
+                               info = info,
+                               registerAllocation = registerAllocation}
+                in
+                  {assembly 
+                   = AppendList.appends 
+                     [assembly_pre,
+                      assembly_src,
+                      assembly_dst,
+                      AppendList.single
+                      (Assembly.instruction instruction),
+                      assembly_post],
+                   registerAllocation = registerAllocation}
+                end
+             | pFMOV {src, dst, size} => pfmov {instruction = instruction, info = info,
+                                                registerAllocation = registerAllocation,
+                                                src = src, dst = dst, 
+                                                srcsize = size, dstsize = size}
+             | pFMOVX {src, dst, srcsize, dstsize} => pfmov {instruction = instruction, info = info,
+                                                             registerAllocation = registerAllocation,
+                                                             src = src, dst = dst, 
+                                                             srcsize = srcsize, dstsize = dstsize}
+             | pFXVOM {src, dst, srcsize, dstsize} => pfmov {instruction = instruction, info = info,
+                                                             registerAllocation = registerAllocation,
+                                                             src = src, dst = dst, 
+                                                             srcsize = srcsize, dstsize = dstsize}
              | pFLDC {oper, dst, size}
-	       (* Pseudo floating-point load constant.
-	        *)
+               (* Pseudo floating-point load constant.
+                *)
              => let
-		  val {uses,defs,kills} 
-		    = Instruction.uses_defs_kills instruction
-		  val {assembly = assembly_pre,
-		       registerAllocation}
-		    = RA.pre {uses = uses,
-			      defs = defs,
-			      kills = kills,
-			      info = info,
-			      registerAllocation = registerAllocation}
+                  val {uses,defs,kills} 
+                    = Instruction.uses_defs_kills instruction
+                  val {assembly = assembly_pre,
+                       registerAllocation}
+                    = RA.pre {uses = uses,
+                              defs = defs,
+                              kills = kills,
+                              info = info,
+                              registerAllocation = registerAllocation}
 
-		  val {assembly = assembly_dst,
-		       registerAllocation,
-		       ...}
-		    = RA.allocateFltOperand {operand = dst,
-					     options = {fltregister = true,
-							address = false},
-					     info = info,
-					     size = size,
-					     move = false,
-					     supports = [],
-					     saves = [],
-					     top = NONE,
-					     registerAllocation
-					     = registerAllocation}
+                  val {assembly = assembly_dst,
+                       registerAllocation,
+                       ...}
+                    = RA.allocateFltOperand {operand = dst,
+                                             options = {fltregister = true,
+                                                        address = false},
+                                             info = info,
+                                             size = size,
+                                             move = false,
+                                             supports = [],
+                                             saves = [],
+                                             top = NONE,
+                                             registerAllocation
+                                             = registerAllocation}
 
-		  val instruction
-		    = Instruction.FLDC
-		      {oper = oper}
+                  val instruction
+                    = Instruction.FLDC
+                      {oper = oper}
 
-		  val {uses = final_uses,
-		       defs = final_defs,  
-		       ...}
-		    = Instruction.uses_defs_kills instruction
+                  val {uses = final_uses,
+                       defs = final_defs,  
+                       ...}
+                    = Instruction.uses_defs_kills instruction
 
-		  val {assembly = assembly_post,
-		       registerAllocation}
-		    = RA.post {uses = uses,
-			       final_uses = final_uses,
-			       defs = defs,
-			       final_defs = final_defs,
-			       kills = kills,
-			       info = info,
-			       registerAllocation = registerAllocation}
-		in
-		  {assembly 
-		   = AppendList.appends
-		     [assembly_pre,
-		      assembly_dst,
-		      AppendList.single
-		      (Assembly.instruction instruction),
-		      assembly_post],
-		   registerAllocation = registerAllocation}
-		end
-	     | pFMOVFI {src, dst, srcsize, dstsize}
-	       (* Pseudo floating-point from integer.
-		*)
-	     => let
-		  val {uses,defs,kills} 
-		    = Instruction.uses_defs_kills instruction
-		  val {assembly = assembly_pre,
-		       registerAllocation}
-		    = RA.pre {uses = uses,
-			      defs = defs,
-			      kills = kills,
-			      info = info,
-			      registerAllocation = registerAllocation}
+                  val {assembly = assembly_post,
+                       registerAllocation}
+                    = RA.post {uses = uses,
+                               final_uses = final_uses,
+                               defs = defs,
+                               final_defs = final_defs,
+                               kills = kills,
+                               info = info,
+                               registerAllocation = registerAllocation}
+                in
+                  {assembly 
+                   = AppendList.appends
+                     [assembly_pre,
+                      assembly_dst,
+                      AppendList.single
+                      (Assembly.instruction instruction),
+                      assembly_post],
+                   registerAllocation = registerAllocation}
+                end
+             | pFMOVFI {src, dst, srcsize, dstsize}
+               (* Pseudo floating-point from integer.
+                *)
+             => let
+                  val {uses,defs,kills} 
+                    = Instruction.uses_defs_kills instruction
+                  val {assembly = assembly_pre,
+                       registerAllocation}
+                    = RA.pre {uses = uses,
+                              defs = defs,
+                              kills = kills,
+                              info = info,
+                              registerAllocation = registerAllocation}
 
-		  val {operand = final_src,
-		       assembly = assembly_src,
-		       registerAllocation}
-		    = RA.allocateOperand {operand = src,
-					  options = {register = false,
-						     immediate = false,
-						     label = false,
-						     address = true},
-					  info = info,
-					  size = srcsize,
-					  move = true,	
-					  supports = [dst],
-					  saves = [],
-					  force = [],
-					  registerAllocation
-					  = registerAllocation}
+                  val {operand = final_src,
+                       assembly = assembly_src,
+                       registerAllocation}
+                    = RA.allocateOperand {operand = src,
+                                          options = {register = false,
+                                                     immediate = false,
+                                                     label = false,
+                                                     address = true},
+                                          info = info,
+                                          size = srcsize,
+                                          move = true,  
+                                          supports = [dst],
+                                          saves = [],
+                                          force = [],
+                                          registerAllocation
+                                          = registerAllocation}
 
-		  val {assembly = assembly_dst,
-		       registerAllocation,
-		       ...}
-		    = RA.allocateFltOperand {operand = dst,
-					     options = {fltregister = true,
-							address = false},
-					     info = info,
-					     size = dstsize,
-					     move = false,	
-					     supports = [],
-					     saves = [src,final_src],
-					     top = NONE,
-					     registerAllocation
-					     = registerAllocation}
+                  val {assembly = assembly_dst,
+                       registerAllocation,
+                       ...}
+                    = RA.allocateFltOperand {operand = dst,
+                                             options = {fltregister = true,
+                                                        address = false},
+                                             info = info,
+                                             size = dstsize,
+                                             move = false,      
+                                             supports = [],
+                                             saves = [src,final_src],
+                                             top = NONE,
+                                             registerAllocation
+                                             = registerAllocation}
 
-		  val instruction
-		    = Instruction.FILD
+                  val instruction
+                    = Instruction.FILD
                       {src = final_src,
-		       size = Size.toFPI srcsize}
+                       size = Size.toFPI srcsize}
 
-		  val {uses = final_uses,
-		       defs = final_defs,  
-		       ...}
-		    = Instruction.uses_defs_kills instruction
+                  val {uses = final_uses,
+                       defs = final_defs,  
+                       ...}
+                    = Instruction.uses_defs_kills instruction
 
-		  val {assembly = assembly_post,
-		       registerAllocation}
-		    = RA.post {uses = uses,
-			       final_uses = final_uses,
-			       defs = defs,
-			       final_defs = final_defs,
-			       kills = kills,
-			       info = info,
-			       registerAllocation = registerAllocation}
-		in
-		  {assembly 
-		   = AppendList.appends
-		     [assembly_pre,
-		      assembly_src,
-		      assembly_dst,
-		      AppendList.single
-		      (Assembly.instruction instruction),
-		      assembly_post],
-		   registerAllocation = registerAllocation}
-		end
-	     | pFMOVTI {src, dst, srcsize, dstsize}
-	       (* Pseudo floating-point to integer.
-		*)
-	     => let
-		  val {uses,defs,kills} 
-		    = Instruction.uses_defs_kills instruction
-		  val {assembly = assembly_pre,
-		       registerAllocation}
-		    = RA.pre {uses = uses,
-			      defs = defs,
-			      kills = kills,
-			      info = info,
-			      registerAllocation = registerAllocation}
+                  val {assembly = assembly_post,
+                       registerAllocation}
+                    = RA.post {uses = uses,
+                               final_uses = final_uses,
+                               defs = defs,
+                               final_defs = final_defs,
+                               kills = kills,
+                               info = info,
+                               registerAllocation = registerAllocation}
+                in
+                  {assembly 
+                   = AppendList.appends
+                     [assembly_pre,
+                      assembly_src,
+                      assembly_dst,
+                      AppendList.single
+                      (Assembly.instruction instruction),
+                      assembly_post],
+                   registerAllocation = registerAllocation}
+                end
+             | pFMOVTI {src, dst, srcsize, dstsize}
+               (* Pseudo floating-point to integer.
+                *)
+             => let
+                  val {uses,defs,kills} 
+                    = Instruction.uses_defs_kills instruction
+                  val {assembly = assembly_pre,
+                       registerAllocation}
+                    = RA.pre {uses = uses,
+                              defs = defs,
+                              kills = kills,
+                              info = info,
+                              registerAllocation = registerAllocation}
 
-		  fun default ()
-		    = let
-			val {operand = final_src,
-			     assembly = assembly_src,
-			     registerAllocation,
-			     ...}
-			  = RA.allocateFltOperand 
-			    {operand = src,
-			     options = {fltregister = true,
-					address = false},
-			     info = info,
-			     size = srcsize,
-			     move = true,
-			     supports = [dst],
-			     saves = [],
-			     top = SOME true,
-			     registerAllocation = registerAllocation}
+                  fun default ()
+                    = let
+                        val {operand = final_src,
+                             assembly = assembly_src,
+                             registerAllocation,
+                             ...}
+                          = RA.allocateFltOperand 
+                            {operand = src,
+                             options = {fltregister = true,
+                                        address = false},
+                             info = info,
+                             size = srcsize,
+                             move = true,
+                             supports = [dst],
+                             saves = [],
+                             top = SOME true,
+                             registerAllocation = registerAllocation}
 
-			val {operand = final_dst,
-			     assembly = assembly_dst,
-			     registerAllocation}
-			  = RA.allocateOperand 
-			    {operand = dst,
-			     options = {register = false,
-					immediate = false,
-					label = false,
-					address = true},
-			     info = info,
-			     size = dstsize,
-			     move = false,
-			     supports = [],
-			     saves = [src,final_src],
-			     force = [],
-			     registerAllocation = registerAllocation}
+                        val {operand = final_dst,
+                             assembly = assembly_dst,
+                             registerAllocation}
+                          = RA.allocateOperand 
+                            {operand = dst,
+                             options = {register = false,
+                                        immediate = false,
+                                        label = false,
+                                        address = true},
+                             info = info,
+                             size = dstsize,
+                             move = false,
+                             supports = [],
+                             saves = [src,final_src],
+                             force = [],
+                             registerAllocation = registerAllocation}
 
-			val instruction
-			  = Instruction.FIST
-			    {dst = final_dst,
-			     size = Size.toFPI dstsize,
-			     pop = false}
+                        val instruction
+                          = Instruction.FIST
+                            {dst = final_dst,
+                             size = Size.toFPI dstsize,
+                             pop = false}
 
-			val {uses = final_uses,
-			     defs = final_defs,  
-			     ...}
-			  = Instruction.uses_defs_kills instruction
+                        val {uses = final_uses,
+                             defs = final_defs,  
+                             ...}
+                          = Instruction.uses_defs_kills instruction
 
-			val {assembly = assembly_post,
-			     registerAllocation}
-			  = RA.post {uses = uses,
-				     final_uses = final_uses,
-				     defs = defs,
-				     final_defs = final_defs,
-				     kills = kills,
-				     info = info,
-				     registerAllocation = registerAllocation}
-		      in
-			{assembly 
-			 = AppendList.appends
-			   [assembly_pre,
-			    assembly_src,
-			    assembly_dst,
-			    AppendList.single
-			    (Assembly.instruction instruction),
-			    assembly_post],
-			 registerAllocation = registerAllocation}
-		      end
+                        val {assembly = assembly_post,
+                             registerAllocation}
+                          = RA.post {uses = uses,
+                                     final_uses = final_uses,
+                                     defs = defs,
+                                     final_defs = final_defs,
+                                     kills = kills,
+                                     info = info,
+                                     registerAllocation = registerAllocation}
+                      in
+                        {assembly 
+                         = AppendList.appends
+                           [assembly_pre,
+                            assembly_src,
+                            assembly_dst,
+                            AppendList.single
+                            (Assembly.instruction instruction),
+                            assembly_post],
+                         registerAllocation = registerAllocation}
+                      end
 
-		  fun default' ()
-		    = let
-			val {operand = final_src,
-			     assembly = assembly_src,
-			     registerAllocation,
-			     ...}
-			  = RA.allocateFltOperand 
-			    {operand = src,
-			     options = {fltregister = true,
-					address = false},
-			     info = info,
-			     size = srcsize,
-			     move = true,
-			     supports = [dst],
-			     saves = [],
-			     top = SOME true,
-			     registerAllocation = registerAllocation}
+                  fun default' ()
+                    = let
+                        val {operand = final_src,
+                             assembly = assembly_src,
+                             registerAllocation,
+                             ...}
+                          = RA.allocateFltOperand 
+                            {operand = src,
+                             options = {fltregister = true,
+                                        address = false},
+                             info = info,
+                             size = srcsize,
+                             move = true,
+                             supports = [dst],
+                             saves = [],
+                             top = SOME true,
+                             registerAllocation = registerAllocation}
 
-			val {operand = final_dst,
-			     assembly = assembly_dst,
-			     registerAllocation,
-			     ...}
-			  = RA.allocateFltOperand 
-			    {operand = dst,
-			     options = {fltregister = false,
-					address = true},
-			     info = info,
-			     size = dstsize,
-			     move = false,
-			     supports = [],
-			     saves = [src,final_src],
-			     top = SOME false,
-			     registerAllocation = registerAllocation}
+                        val {operand = final_dst,
+                             assembly = assembly_dst,
+                             registerAllocation,
+                             ...}
+                          = RA.allocateFltOperand 
+                            {operand = dst,
+                             options = {fltregister = false,
+                                        address = true},
+                             info = info,
+                             size = dstsize,
+                             move = false,
+                             supports = [],
+                             saves = [src,final_src],
+                             top = SOME false,
+                             registerAllocation = registerAllocation}
 
-			val instruction
-			  = Instruction.FIST
-			    {dst = final_dst,
-			     size = Size.toFPI dstsize,
-			     pop = true}
+                        val instruction
+                          = Instruction.FIST
+                            {dst = final_dst,
+                             size = Size.toFPI dstsize,
+                             pop = true}
 
-			val {fltrename = fltrename_pop,
-			     registerAllocation}
-			  = RA.fltpop {registerAllocation = registerAllocation}
+                        val {fltrename = fltrename_pop,
+                             registerAllocation}
+                          = RA.fltpop {registerAllocation = registerAllocation}
 
-			val {uses = final_uses,
-			     defs = final_defs,
-			     ...}
-			  = Instruction.uses_defs_kills instruction
+                        val {uses = final_uses,
+                             defs = final_defs,
+                             ...}
+                          = Instruction.uses_defs_kills instruction
  
-			val final_uses
-			  = List.revMap(final_uses, RA.fltrenameLift fltrename_pop)
-			val final_defs
-			  = List.revMap(final_defs, RA.fltrenameLift fltrename_pop)
+                        val final_uses
+                          = List.revMap(final_uses, RA.fltrenameLift fltrename_pop)
+                        val final_defs
+                          = List.revMap(final_defs, RA.fltrenameLift fltrename_pop)
 
-			val {assembly = assembly_post,
-			     registerAllocation}
-			  = RA.post {uses = uses,
-				     final_uses = final_uses,
-				     defs = defs,
-				     final_defs = final_defs,
-				     kills = kills,
-				     info = info,
-				     registerAllocation 
-				     = registerAllocation}
-		      in
-			{assembly 
-			 = AppendList.appends 
-			   [assembly_pre,
-			    assembly_src,
-			    assembly_dst,
-			    AppendList.single
-			    (Assembly.instruction instruction),
-			    assembly_post],
-			 registerAllocation = registerAllocation}
-		      end
-		in
-		  case src
-		    of Operand.MemLoc memloc_src
-		     => if removable {memloc = memloc_src,
-				      info = info,
-				      registerAllocation
-				      = registerAllocation}
-			  then default' ()
-			  else default ()
-		     | _ => default ()
-		end
-	     | pFCOM {src1, src2, size}
-	       (* Floating-point compare real; p. 220
-	        * Require src operand as follows:
-		*
-		*               src
-		*           fltreg add 
-		*             *     X
-		*   * only st(1) if pop and pop'
-	        *
-		* Require size modifier class as follows: FLT(SNGL,DBLE)
-		*)
-	     => let
-		  val {uses,defs,kills} 
-		    = Instruction.uses_defs_kills instruction
-		  val {assembly = assembly_pre,
-		       registerAllocation}
-		    = RA.pre {uses = uses,
-			      defs = defs,
-			      kills = kills,
-			      info = info,
-			      registerAllocation = registerAllocation}
-		    
-		  val {final_src2,
-		       assembly_src1_src2,
-		       pop,
-		       pop',
-		       registerAllocation,
-		       ...}
-		    = if Operand.eq(src1,src2)
-			then let
-			       fun default b
-				 = let
-				     val {operand = final_src1_src2,
-					  assembly = assembly_src1_src2,
-					  fltrename = fltrename_src1_src2,
-					  registerAllocation}
-				       = RA.allocateFltOperand 
-				         {operand = src1,
-					  options = {fltregister = true,
-						     address = false},
-					  info = info,
-					  size = size,
-					  move = true,
-					  supports = [],
-					  saves = [],
-					  top = SOME true,
-					  registerAllocation
-					  = registerAllocation}
-				   in
-				     {final_src1 = final_src1_src2,
-				      final_src2 = final_src1_src2,
-				      assembly_src1_src2 = assembly_src1_src2,
-				      fltrename_src1_src2 = fltrename_src1_src2,
-				      pop = b,
-				      pop' = false,
-				      registerAllocation = registerAllocation}
-				   end
-			     in
-			       case src1
-				 of Operand.MemLoc memloc_src1
-				  => if removable {memloc = memloc_src1,
-						   info = info,
-						   registerAllocation
-						   = registerAllocation}
-				       then default true
-				       else default false
-				  | _ => default false
-			     end
-			else let
-			       fun default b
-				 = let
-				     val {operand = final_src2,
-					  assembly = assembly_src2,
-					  fltrename = fltrename_src2,
-					  registerAllocation}
-				       = RA.allocateFltOperand 
-				         {operand = src2,
-					  options = {fltregister = true,
-						     address = true},
-					  info = info,
-					  size = size,
-					  move = true,
-					  supports = [src1],
-					  saves = [],
-					  top = SOME false,
-					  registerAllocation
-					  = registerAllocation}
-					 
-				     val {operand = final_src1,
-					  assembly = assembly_src1,
-					  fltrename = fltrename_src1,
-					  registerAllocation}
-				       = RA.allocateFltOperand 
-				       {operand = src1,
-					options = {fltregister = true,
-						   address = false},
-					info = info,
-					size = size,
-					move = true,	
-					supports = [],
-					saves = [src2,final_src2],
-					top = SOME true,
-					registerAllocation
-					= registerAllocation}
-		    
-				     val final_src2 
-				       = (RA.fltrenameLift fltrename_src1) final_src2
-				   in
-				     {final_src1 = final_src1,
-				      final_src2 = final_src2,
-				      assembly_src1_src2 
-				      = AppendList.appends 
-				        [assembly_src2,
-					 assembly_src1],
-				      fltrename_src1_src2 = fltrename_src1 o 
-				                         fltrename_src2,
-				      pop = b,
-				      pop' = false,
-				      registerAllocation = registerAllocation}
-				   end
+                        val {assembly = assembly_post,
+                             registerAllocation}
+                          = RA.post {uses = uses,
+                                     final_uses = final_uses,
+                                     defs = defs,
+                                     final_defs = final_defs,
+                                     kills = kills,
+                                     info = info,
+                                     registerAllocation 
+                                     = registerAllocation}
+                      in
+                        {assembly 
+                         = AppendList.appends 
+                           [assembly_pre,
+                            assembly_src,
+                            assembly_dst,
+                            AppendList.single
+                            (Assembly.instruction instruction),
+                            assembly_post],
+                         registerAllocation = registerAllocation}
+                      end
+                in
+                  case src
+                    of Operand.MemLoc memloc_src
+                     => if removable {memloc = memloc_src,
+                                      info = info,
+                                      registerAllocation
+                                      = registerAllocation}
+                          then default' ()
+                          else default ()
+                     | _ => default ()
+                end
+             | pFCOM {src1, src2, size}
+               (* Floating-point compare real; p. 220
+                * Require src operand as follows:
+                *
+                *               src
+                *           fltreg add 
+                *             *     X
+                *   * only st(1) if pop and pop'
+                *
+                * Require size modifier class as follows: FLT(SNGL,DBLE)
+                *)
+             => let
+                  val {uses,defs,kills} 
+                    = Instruction.uses_defs_kills instruction
+                  val {assembly = assembly_pre,
+                       registerAllocation}
+                    = RA.pre {uses = uses,
+                              defs = defs,
+                              kills = kills,
+                              info = info,
+                              registerAllocation = registerAllocation}
+                    
+                  val {final_src2,
+                       assembly_src1_src2,
+                       pop,
+                       pop',
+                       registerAllocation,
+                       ...}
+                    = if Operand.eq(src1,src2)
+                        then let
+                               fun default b
+                                 = let
+                                     val {operand = final_src1_src2,
+                                          assembly = assembly_src1_src2,
+                                          fltrename = fltrename_src1_src2,
+                                          registerAllocation}
+                                       = RA.allocateFltOperand 
+                                         {operand = src1,
+                                          options = {fltregister = true,
+                                                     address = false},
+                                          info = info,
+                                          size = size,
+                                          move = true,
+                                          supports = [],
+                                          saves = [],
+                                          top = SOME true,
+                                          registerAllocation
+                                          = registerAllocation}
+                                   in
+                                     {final_src1 = final_src1_src2,
+                                      final_src2 = final_src1_src2,
+                                      assembly_src1_src2 = assembly_src1_src2,
+                                      fltrename_src1_src2 = fltrename_src1_src2,
+                                      pop = b,
+                                      pop' = false,
+                                      registerAllocation = registerAllocation}
+                                   end
+                             in
+                               case src1
+                                 of Operand.MemLoc memloc_src1
+                                  => if removable {memloc = memloc_src1,
+                                                   info = info,
+                                                   registerAllocation
+                                                   = registerAllocation}
+                                       then default true
+                                       else default false
+                                  | _ => default false
+                             end
+                        else let
+                               fun default b
+                                 = let
+                                     val {operand = final_src2,
+                                          assembly = assembly_src2,
+                                          fltrename = fltrename_src2,
+                                          registerAllocation}
+                                       = RA.allocateFltOperand 
+                                         {operand = src2,
+                                          options = {fltregister = true,
+                                                     address = true},
+                                          info = info,
+                                          size = size,
+                                          move = true,
+                                          supports = [src1],
+                                          saves = [],
+                                          top = SOME false,
+                                          registerAllocation
+                                          = registerAllocation}
+                                         
+                                     val {operand = final_src1,
+                                          assembly = assembly_src1,
+                                          fltrename = fltrename_src1,
+                                          registerAllocation}
+                                       = RA.allocateFltOperand 
+                                       {operand = src1,
+                                        options = {fltregister = true,
+                                                   address = false},
+                                        info = info,
+                                        size = size,
+                                        move = true,    
+                                        supports = [],
+                                        saves = [src2,final_src2],
+                                        top = SOME true,
+                                        registerAllocation
+                                        = registerAllocation}
+                    
+                                     val final_src2 
+                                       = (RA.fltrenameLift fltrename_src1) final_src2
+                                   in
+                                     {final_src1 = final_src1,
+                                      final_src2 = final_src2,
+                                      assembly_src1_src2 
+                                      = AppendList.appends 
+                                        [assembly_src2,
+                                         assembly_src1],
+                                      fltrename_src1_src2 = fltrename_src1 o 
+                                                         fltrename_src2,
+                                      pop = b,
+                                      pop' = false,
+                                      registerAllocation = registerAllocation}
+                                   end
 
-			       fun default' ()
-				 = let
-				     val {operand_top = final_src1,
-					  operand_one = final_src2,
-					  assembly = assembly_src1_src2,
-					  fltrename = fltrename_src1_src2,
-					  registerAllocation}
-				       = RA.allocateFltStackOperands
-				         {operand_top = src1,
-					  move_top = true,
-					  size_top = size,
-					  operand_one = src2,
-					  move_one = true,
-					  size_one = size,
-					  info = info,
-					  supports = [],
-					  saves = [],
-					  registerAllocation 
-					  = registerAllocation}
-				   in
-				     {final_src1 = final_src1,
-				      final_src2 = final_src2,
-				      assembly_src1_src2 = assembly_src1_src2,
-				      fltrename_src1_src2 = fltrename_src1_src2,
-				      pop = true,
-				      pop' = true,
-				      registerAllocation = registerAllocation}
-				   end
-			     in
-			       case (src1,src2)
-				 of (Operand.MemLoc memloc_src1,
-				     Operand.MemLoc memloc_src2)
-				  => if removable {memloc = memloc_src1,
-						   info = info,
-						   registerAllocation
-						   = registerAllocation}
-				       then if removable
-					       {memloc = memloc_src2,
-						info = info,
-						registerAllocation
-						= registerAllocation}
-					      then default' ()
-					      else default true
-				       else default false
-				  | (Operand.MemLoc memloc_src1, _)
-				  => if removable {memloc = memloc_src1,
-						   info = info,
-						   registerAllocation
-						   = registerAllocation}
-				       then default true
-				       else default false
-				  | _ => default false
-			     end
+                               fun default' ()
+                                 = let
+                                     val {operand_top = final_src1,
+                                          operand_one = final_src2,
+                                          assembly = assembly_src1_src2,
+                                          fltrename = fltrename_src1_src2,
+                                          registerAllocation}
+                                       = RA.allocateFltStackOperands
+                                         {operand_top = src1,
+                                          move_top = true,
+                                          size_top = size,
+                                          operand_one = src2,
+                                          move_one = true,
+                                          size_one = size,
+                                          info = info,
+                                          supports = [],
+                                          saves = [],
+                                          registerAllocation 
+                                          = registerAllocation}
+                                   in
+                                     {final_src1 = final_src1,
+                                      final_src2 = final_src2,
+                                      assembly_src1_src2 = assembly_src1_src2,
+                                      fltrename_src1_src2 = fltrename_src1_src2,
+                                      pop = true,
+                                      pop' = true,
+                                      registerAllocation = registerAllocation}
+                                   end
+                             in
+                               case (src1,src2)
+                                 of (Operand.MemLoc memloc_src1,
+                                     Operand.MemLoc memloc_src2)
+                                  => if removable {memloc = memloc_src1,
+                                                   info = info,
+                                                   registerAllocation
+                                                   = registerAllocation}
+                                       then if removable
+                                               {memloc = memloc_src2,
+                                                info = info,
+                                                registerAllocation
+                                                = registerAllocation}
+                                              then default' ()
+                                              else default true
+                                       else default false
+                                  | (Operand.MemLoc memloc_src1, _)
+                                  => if removable {memloc = memloc_src1,
+                                                   info = info,
+                                                   registerAllocation
+                                                   = registerAllocation}
+                                       then default true
+                                       else default false
+                                  | _ => default false
+                             end
 
-		  val instruction
-		    = Instruction.FCOM
-		      {src = final_src2,
-		       size = size,
-		       pop = pop,
-		       pop' = pop'}
-			    
-		  val {fltrename = fltrename_pop,
-		       registerAllocation}
-		    = if pop
-			then if pop'
-			       then let
-				      val {fltrename = fltrename_pop,
-					   registerAllocation}
-					= RA.fltpop {registerAllocation 
-						     = registerAllocation}
-				      val {fltrename = fltrename_pop',
-					   registerAllocation}
-					= RA.fltpop {registerAllocation 
-						     = registerAllocation}
-				    in
-				      {fltrename = fltrename_pop' o fltrename_pop,
-				       registerAllocation= registerAllocation}
-				    end
-			       else let
-				      val {fltrename = fltrename_pop,
-					   registerAllocation}
-					= RA.fltpop {registerAllocation 
-						     = registerAllocation}
-				    in
-				      {fltrename = fltrename_pop,
-				       registerAllocation = registerAllocation}
-				    end
-			else {fltrename = FltRegister.id,
-			      registerAllocation = registerAllocation}
+                  val instruction
+                    = Instruction.FCOM
+                      {src = final_src2,
+                       size = size,
+                       pop = pop,
+                       pop' = pop'}
+                            
+                  val {fltrename = fltrename_pop,
+                       registerAllocation}
+                    = if pop
+                        then if pop'
+                               then let
+                                      val {fltrename = fltrename_pop,
+                                           registerAllocation}
+                                        = RA.fltpop {registerAllocation 
+                                                     = registerAllocation}
+                                      val {fltrename = fltrename_pop',
+                                           registerAllocation}
+                                        = RA.fltpop {registerAllocation 
+                                                     = registerAllocation}
+                                    in
+                                      {fltrename = fltrename_pop' o fltrename_pop,
+                                       registerAllocation= registerAllocation}
+                                    end
+                               else let
+                                      val {fltrename = fltrename_pop,
+                                           registerAllocation}
+                                        = RA.fltpop {registerAllocation 
+                                                     = registerAllocation}
+                                    in
+                                      {fltrename = fltrename_pop,
+                                       registerAllocation = registerAllocation}
+                                    end
+                        else {fltrename = FltRegister.id,
+                              registerAllocation = registerAllocation}
 
-		  val {uses = final_uses,
-		       defs = final_defs,
-		       ...}
-		    = Instruction.uses_defs_kills instruction
-		    
-		  val final_uses
-		    = List.revMap(final_uses, RA.fltrenameLift fltrename_pop)
-		  val final_defs
-		    = List.revMap(final_defs, RA.fltrenameLift fltrename_pop)
+                  val {uses = final_uses,
+                       defs = final_defs,
+                       ...}
+                    = Instruction.uses_defs_kills instruction
+                    
+                  val final_uses
+                    = List.revMap(final_uses, RA.fltrenameLift fltrename_pop)
+                  val final_defs
+                    = List.revMap(final_defs, RA.fltrenameLift fltrename_pop)
 
-		  val {assembly = assembly_post,
-		       registerAllocation}
-		    = RA.post {uses = uses,
-			       final_uses = final_uses,
-			       defs = defs,
-			       final_defs = final_defs,
-			       kills = kills,
-			       info = info,
-			       registerAllocation = registerAllocation}
-		in
-		  {assembly 
-		   = AppendList.appends 
-		     [assembly_pre,
-		      assembly_src1_src2,
-		      AppendList.single
-		      (Assembly.instruction instruction),
-		      assembly_post],
-		   registerAllocation = registerAllocation}
-		end
-	     | pFUCOM {src1, src2, size}
-	       (* Floating-point unordered compare real; p. 307
-	        * Require src operand as follows:
-		*
-		*               src
-		*           fltreg add 
-		*             *
-		*   * only st(1) if pop and pop'
-		*)
-	     => let
-		  val {uses,defs,kills} 
-		    = Instruction.uses_defs_kills instruction
-		  val {assembly = assembly_pre,
-		       registerAllocation}
-		    = RA.pre {uses = uses,
-			      defs = defs,
-			      kills = kills,
-			      info = info,
-			      registerAllocation = registerAllocation}
+                  val {assembly = assembly_post,
+                       registerAllocation}
+                    = RA.post {uses = uses,
+                               final_uses = final_uses,
+                               defs = defs,
+                               final_defs = final_defs,
+                               kills = kills,
+                               info = info,
+                               registerAllocation = registerAllocation}
+                in
+                  {assembly 
+                   = AppendList.appends 
+                     [assembly_pre,
+                      assembly_src1_src2,
+                      AppendList.single
+                      (Assembly.instruction instruction),
+                      assembly_post],
+                   registerAllocation = registerAllocation}
+                end
+             | pFUCOM {src1, src2, size}
+               (* Floating-point unordered compare real; p. 307
+                * Require src operand as follows:
+                *
+                *               src
+                *           fltreg add 
+                *             *
+                *   * only st(1) if pop and pop'
+                *)
+             => let
+                  val {uses,defs,kills} 
+                    = Instruction.uses_defs_kills instruction
+                  val {assembly = assembly_pre,
+                       registerAllocation}
+                    = RA.pre {uses = uses,
+                              defs = defs,
+                              kills = kills,
+                              info = info,
+                              registerAllocation = registerAllocation}
 
-		  val {final_src2,
-		       assembly_src1_src2,
-		       pop,
-		       pop',
-		       registerAllocation,
-		       ...}
-		    = if Operand.eq(src1,src2)
-			then let
-			       fun default b
-				 = let
-				     val {operand = final_src1_src2,
-					  assembly = assembly_src1_src2,
-					  fltrename = fltrename_src1_src2,
-					  registerAllocation}
-				       = RA.allocateFltOperand 
-				         {operand = src1,
-					  options = {fltregister = true,
-						     address = false},
-					  info = info,
-					  size = size,
-					  move = true,
-					  supports = [],
-					  saves = [],
-					  top = SOME true,
-					  registerAllocation
-					  = registerAllocation}
-				   in
-				     {final_src1 = final_src1_src2,
-				      final_src2 = final_src1_src2,
-				      assembly_src1_src2 = assembly_src1_src2,
-				      fltrename_src1_src2 = fltrename_src1_src2,
-				      pop = b,
-				      pop' = false,
-				      registerAllocation = registerAllocation}
-				   end
-			     in
-			       case src1
-				 of Operand.MemLoc memloc_src1
-				  => if removable {memloc = memloc_src1,
-						   info = info,
-						   registerAllocation
-						   = registerAllocation}
-				       then default true
-				       else default false
-				  | _ => default false
-			     end
-			else let
-			       fun default b
-				 = let
-				     val {operand = final_src2,
-					  assembly = assembly_src2,
-					  fltrename = fltrename_src2,
-					  registerAllocation}
-				       = RA.allocateFltOperand 
-				         {operand = src2,
-					  options = {fltregister = true,
-						     address = false},
-					  info = info,
-					  size = size,
-					  move = true,
-					  supports = [src1],
-					  saves = [],
-					  top = SOME false,
-					  registerAllocation
-					  = registerAllocation}
-					 
-				     val {operand = final_src1,
-					  assembly = assembly_src1,
-					  fltrename = fltrename_src1,
-					  registerAllocation}
-				       = RA.allocateFltOperand 
-				       {operand = src1,
-					options = {fltregister = true,
-						   address = false},
-					info = info,
-					size = size,
-					move = true,	
-					supports = [],
-					saves = [src2,final_src2],
-					top = SOME true,
-					registerAllocation
-					= registerAllocation}
-		    
-				     val final_src2 
-				       = (RA.fltrenameLift fltrename_src1) final_src2
-				   in
-				     {final_src1 = final_src1,
-				      final_src2 = final_src2,
-				      assembly_src1_src2 
-				      = AppendList.appends
-				        [assembly_src2,
-					 assembly_src1],
-				      fltrename_src1_src2 = fltrename_src1 o 
-				                            fltrename_src2,
-				      pop = b,
-				      pop' = false,
-				      registerAllocation = registerAllocation}
-				   end
-			     in
-			       case (src1,src2)
-				 of (Operand.MemLoc memloc_src1,
-				     Operand.MemLoc memloc_src2)
-				  => let
-				       fun default' ()
-					 = case RA.fltallocated 
-					        {memloc = memloc_src2,
-						 registerAllocation
-						 = registerAllocation}
-					     of SOME _
-					      => let
-						   val {operand_top 
-							= final_src1,
-							operand_one 
-							= final_src2,
-							assembly 
-							= assembly_src1_src2,
-							fltrename 
-							= fltrename_src1_src2,
-							registerAllocation}
-						     = RA.allocateFltStackOperands
-						       {operand_top = src1,
-							move_top = true,
-							size_top = size,
-							operand_one = src2,
-							move_one = true,
-							size_one = size,
-							info = info,
-							supports = [],
-							saves = [],
-							registerAllocation 
-							= registerAllocation}
-						 in
-						   {final_src1 = final_src1,
-						    final_src2 = final_src2,
-						    assembly_src1_src2 
-						    = assembly_src1_src2,
-						    fltrename_src1_src2 
-						    = fltrename_src1_src2,
-						    pop = true,
-						    pop' = true,
-						    registerAllocation 
-						    = registerAllocation}
-						 end
-					      | NONE
-					      => default true
-				     in 
-				       if removable 
-					  {memloc = memloc_src1,
-					   info = info,
-					   registerAllocation
-					   = registerAllocation}
-					 then if removable 
-					         {memloc = memloc_src2,
-						  info = info,
-						  registerAllocation
-						  = registerAllocation}
-						then default' ()
-						else default true
-					 else default false
-				     end
-				  | (Operand.MemLoc memloc_src1, _)
-				  => if removable {memloc = memloc_src1,
-						   info = info,
-						   registerAllocation
-						   = registerAllocation}
-				       then default true
-				       else default false
-				  | _ => default false
-			     end
+                  val {final_src2,
+                       assembly_src1_src2,
+                       pop,
+                       pop',
+                       registerAllocation,
+                       ...}
+                    = if Operand.eq(src1,src2)
+                        then let
+                               fun default b
+                                 = let
+                                     val {operand = final_src1_src2,
+                                          assembly = assembly_src1_src2,
+                                          fltrename = fltrename_src1_src2,
+                                          registerAllocation}
+                                       = RA.allocateFltOperand 
+                                         {operand = src1,
+                                          options = {fltregister = true,
+                                                     address = false},
+                                          info = info,
+                                          size = size,
+                                          move = true,
+                                          supports = [],
+                                          saves = [],
+                                          top = SOME true,
+                                          registerAllocation
+                                          = registerAllocation}
+                                   in
+                                     {final_src1 = final_src1_src2,
+                                      final_src2 = final_src1_src2,
+                                      assembly_src1_src2 = assembly_src1_src2,
+                                      fltrename_src1_src2 = fltrename_src1_src2,
+                                      pop = b,
+                                      pop' = false,
+                                      registerAllocation = registerAllocation}
+                                   end
+                             in
+                               case src1
+                                 of Operand.MemLoc memloc_src1
+                                  => if removable {memloc = memloc_src1,
+                                                   info = info,
+                                                   registerAllocation
+                                                   = registerAllocation}
+                                       then default true
+                                       else default false
+                                  | _ => default false
+                             end
+                        else let
+                               fun default b
+                                 = let
+                                     val {operand = final_src2,
+                                          assembly = assembly_src2,
+                                          fltrename = fltrename_src2,
+                                          registerAllocation}
+                                       = RA.allocateFltOperand 
+                                         {operand = src2,
+                                          options = {fltregister = true,
+                                                     address = false},
+                                          info = info,
+                                          size = size,
+                                          move = true,
+                                          supports = [src1],
+                                          saves = [],
+                                          top = SOME false,
+                                          registerAllocation
+                                          = registerAllocation}
+                                         
+                                     val {operand = final_src1,
+                                          assembly = assembly_src1,
+                                          fltrename = fltrename_src1,
+                                          registerAllocation}
+                                       = RA.allocateFltOperand 
+                                       {operand = src1,
+                                        options = {fltregister = true,
+                                                   address = false},
+                                        info = info,
+                                        size = size,
+                                        move = true,    
+                                        supports = [],
+                                        saves = [src2,final_src2],
+                                        top = SOME true,
+                                        registerAllocation
+                                        = registerAllocation}
+                    
+                                     val final_src2 
+                                       = (RA.fltrenameLift fltrename_src1) final_src2
+                                   in
+                                     {final_src1 = final_src1,
+                                      final_src2 = final_src2,
+                                      assembly_src1_src2 
+                                      = AppendList.appends
+                                        [assembly_src2,
+                                         assembly_src1],
+                                      fltrename_src1_src2 = fltrename_src1 o 
+                                                            fltrename_src2,
+                                      pop = b,
+                                      pop' = false,
+                                      registerAllocation = registerAllocation}
+                                   end
+                             in
+                               case (src1,src2)
+                                 of (Operand.MemLoc memloc_src1,
+                                     Operand.MemLoc memloc_src2)
+                                  => let
+                                       fun default' ()
+                                         = case RA.fltallocated 
+                                                {memloc = memloc_src2,
+                                                 registerAllocation
+                                                 = registerAllocation}
+                                             of SOME _
+                                              => let
+                                                   val {operand_top 
+                                                        = final_src1,
+                                                        operand_one 
+                                                        = final_src2,
+                                                        assembly 
+                                                        = assembly_src1_src2,
+                                                        fltrename 
+                                                        = fltrename_src1_src2,
+                                                        registerAllocation}
+                                                     = RA.allocateFltStackOperands
+                                                       {operand_top = src1,
+                                                        move_top = true,
+                                                        size_top = size,
+                                                        operand_one = src2,
+                                                        move_one = true,
+                                                        size_one = size,
+                                                        info = info,
+                                                        supports = [],
+                                                        saves = [],
+                                                        registerAllocation 
+                                                        = registerAllocation}
+                                                 in
+                                                   {final_src1 = final_src1,
+                                                    final_src2 = final_src2,
+                                                    assembly_src1_src2 
+                                                    = assembly_src1_src2,
+                                                    fltrename_src1_src2 
+                                                    = fltrename_src1_src2,
+                                                    pop = true,
+                                                    pop' = true,
+                                                    registerAllocation 
+                                                    = registerAllocation}
+                                                 end
+                                              | NONE
+                                              => default true
+                                     in 
+                                       if removable 
+                                          {memloc = memloc_src1,
+                                           info = info,
+                                           registerAllocation
+                                           = registerAllocation}
+                                         then if removable 
+                                                 {memloc = memloc_src2,
+                                                  info = info,
+                                                  registerAllocation
+                                                  = registerAllocation}
+                                                then default' ()
+                                                else default true
+                                         else default false
+                                     end
+                                  | (Operand.MemLoc memloc_src1, _)
+                                  => if removable {memloc = memloc_src1,
+                                                   info = info,
+                                                   registerAllocation
+                                                   = registerAllocation}
+                                       then default true
+                                       else default false
+                                  | _ => default false
+                             end
  
-		  val instruction
-		    = Instruction.FUCOM
-		      {src = final_src2,
-		       pop = pop,
-		       pop' = pop'}
+                  val instruction
+                    = Instruction.FUCOM
+                      {src = final_src2,
+                       pop = pop,
+                       pop' = pop'}
 
-		  val {fltrename = fltrename_pop,
-		       registerAllocation}
-		    = if pop
-			then if pop'
-			       then let
-				      val {fltrename = fltrename_pop,
-					   registerAllocation}
-					= RA.fltpop {registerAllocation 
-						     = registerAllocation}
-				      val {fltrename = fltrename_pop',
-					   registerAllocation}
-					= RA.fltpop {registerAllocation 
-						     = registerAllocation}
-				    in
-				      {fltrename = fltrename_pop' o fltrename_pop,
-				       registerAllocation= registerAllocation}
-				    end
-			       else let
-				      val {fltrename = fltrename_pop,
-					   registerAllocation}
-					= RA.fltpop {registerAllocation 
-						     = registerAllocation}
-				    in
-				      {fltrename = fltrename_pop,
-				       registerAllocation = registerAllocation}
-				    end
-			else {fltrename = FltRegister.id,
-			      registerAllocation = registerAllocation}
+                  val {fltrename = fltrename_pop,
+                       registerAllocation}
+                    = if pop
+                        then if pop'
+                               then let
+                                      val {fltrename = fltrename_pop,
+                                           registerAllocation}
+                                        = RA.fltpop {registerAllocation 
+                                                     = registerAllocation}
+                                      val {fltrename = fltrename_pop',
+                                           registerAllocation}
+                                        = RA.fltpop {registerAllocation 
+                                                     = registerAllocation}
+                                    in
+                                      {fltrename = fltrename_pop' o fltrename_pop,
+                                       registerAllocation= registerAllocation}
+                                    end
+                               else let
+                                      val {fltrename = fltrename_pop,
+                                           registerAllocation}
+                                        = RA.fltpop {registerAllocation 
+                                                     = registerAllocation}
+                                    in
+                                      {fltrename = fltrename_pop,
+                                       registerAllocation = registerAllocation}
+                                    end
+                        else {fltrename = FltRegister.id,
+                              registerAllocation = registerAllocation}
 
-		  val {uses = final_uses,
-		       defs = final_defs,
-		       ...}
-		    = Instruction.uses_defs_kills instruction
-		    
-		  val final_uses
-		    = List.revMap(final_uses, RA.fltrenameLift fltrename_pop)
-		  val final_defs
-		    = List.revMap(final_defs, RA.fltrenameLift fltrename_pop)
+                  val {uses = final_uses,
+                       defs = final_defs,
+                       ...}
+                    = Instruction.uses_defs_kills instruction
+                    
+                  val final_uses
+                    = List.revMap(final_uses, RA.fltrenameLift fltrename_pop)
+                  val final_defs
+                    = List.revMap(final_defs, RA.fltrenameLift fltrename_pop)
 
-		  val {assembly = assembly_post,
-		       registerAllocation}
-		    = RA.post {uses = uses,
-			       final_uses = final_uses,
-			       defs = defs,
-			       final_defs = final_defs,
-			       kills = kills,
-			       info = info,
-			       registerAllocation = registerAllocation}
-		in
-		  {assembly 
-		   = AppendList.appends 
-		     [assembly_pre,
-		      assembly_src1_src2,
-		      AppendList.single
-		      (Assembly.instruction instruction),
-		      assembly_post],
-		   registerAllocation = registerAllocation}
-		end
-	     | pFBinA {oper, src, dst, size}
-	       (* Floating-point binary arithmetic instructions.
-		* Require src operand as follows:
-		*
-		*               src
-		*           fltreg add 
-		*             *     X
-		*   * only st(0) if pop
-		*
-		* Require dst operand as follows:
-		*
-		*               dst
-		*           fltreg add 
-		*            *
-		*   * only st(0) if src add
-		*
-		*   * one of src,dst must be st(0)
-		*
-		* Require size modifier class as follows: FLT
-		*)		
-	     => let
-		  val {uses,defs,kills} 
-		    = Instruction.uses_defs_kills instruction
-		  val {assembly = assembly_pre,
-		       registerAllocation}
-		    = RA.pre {uses = uses,
-			      defs = defs,
-			      kills = kills,
-			      info = info,
-			      registerAllocation = registerAllocation}
+                  val {assembly = assembly_post,
+                       registerAllocation}
+                    = RA.post {uses = uses,
+                               final_uses = final_uses,
+                               defs = defs,
+                               final_defs = final_defs,
+                               kills = kills,
+                               info = info,
+                               registerAllocation = registerAllocation}
+                in
+                  {assembly 
+                   = AppendList.appends 
+                     [assembly_pre,
+                      assembly_src1_src2,
+                      AppendList.single
+                      (Assembly.instruction instruction),
+                      assembly_post],
+                   registerAllocation = registerAllocation}
+                end
+             | pFBinA {oper, src, dst, size}
+               (* Floating-point binary arithmetic instructions.
+                * Require src operand as follows:
+                *
+                *               src
+                *           fltreg add 
+                *             *     X
+                *   * only st(0) if pop
+                *
+                * Require dst operand as follows:
+                *
+                *               dst
+                *           fltreg add 
+                *            *
+                *   * only st(0) if src add
+                *
+                *   * one of src,dst must be st(0)
+                *
+                * Require size modifier class as follows: FLT
+                *)              
+             => let
+                  val {uses,defs,kills} 
+                    = Instruction.uses_defs_kills instruction
+                  val {assembly = assembly_pre,
+                       registerAllocation}
+                    = RA.pre {uses = uses,
+                              defs = defs,
+                              kills = kills,
+                              info = info,
+                              registerAllocation = registerAllocation}
 
-		  val {final_src,
-		       final_dst,
-		       assembly_src_dst,
-		       oper,
-		       pop,
-		       registerAllocation,
-		       ...}
-		    = if Operand.eq(src,dst)
-			then let
-			       val {operand = final_src_dst,
-				    assembly = assembly_src_dst,
-				    fltrename = fltrename_src_dst,
-				    registerAllocation}
-				 = RA.allocateFltOperand 
-				   {operand = dst,
-				    options = {fltregister = true,
-					       address = false},
-				    info = info,
-				    size = size,
-				    move = true,	
-				    supports = [],
-				    saves = [],
-				    top = SOME true,
-				    registerAllocation 
-				    = registerAllocation}
-			     in
-			       {final_src = final_src_dst,
-				final_dst = final_src_dst,
-				assembly_src_dst = assembly_src_dst,
-				fltrename_src_dst = fltrename_src_dst,
-				oper = oper,
-				pop = false,
-				registerAllocation = registerAllocation}
-			     end
-			else let
-			       fun default ()
-				 = let
-				     val {operand = final_src,
-					  assembly = assembly_src,
-					  fltrename = fltrename_src,
-					  registerAllocation}
-				       = RA.allocateFltOperand 
-				         {operand = src,
-					  options = {fltregister = true,
-						     address = true},
-					  info = info,
-					  size = size,
-					  move = true,	
-					  supports = [dst],
-					  saves = [],
-					  top = SOME false,
-					  registerAllocation
-					  = registerAllocation}
+                  val {final_src,
+                       final_dst,
+                       assembly_src_dst,
+                       oper,
+                       pop,
+                       registerAllocation,
+                       ...}
+                    = if Operand.eq(src,dst)
+                        then let
+                               val {operand = final_src_dst,
+                                    assembly = assembly_src_dst,
+                                    fltrename = fltrename_src_dst,
+                                    registerAllocation}
+                                 = RA.allocateFltOperand 
+                                   {operand = dst,
+                                    options = {fltregister = true,
+                                               address = false},
+                                    info = info,
+                                    size = size,
+                                    move = true,        
+                                    supports = [],
+                                    saves = [],
+                                    top = SOME true,
+                                    registerAllocation 
+                                    = registerAllocation}
+                             in
+                               {final_src = final_src_dst,
+                                final_dst = final_src_dst,
+                                assembly_src_dst = assembly_src_dst,
+                                fltrename_src_dst = fltrename_src_dst,
+                                oper = oper,
+                                pop = false,
+                                registerAllocation = registerAllocation}
+                             end
+                        else let
+                               fun default ()
+                                 = let
+                                     val {operand = final_src,
+                                          assembly = assembly_src,
+                                          fltrename = fltrename_src,
+                                          registerAllocation}
+                                       = RA.allocateFltOperand 
+                                         {operand = src,
+                                          options = {fltregister = true,
+                                                     address = true},
+                                          info = info,
+                                          size = size,
+                                          move = true,  
+                                          supports = [dst],
+                                          saves = [],
+                                          top = SOME false,
+                                          registerAllocation
+                                          = registerAllocation}
 
-				     val {operand = final_dst,
-					  assembly = assembly_dst,
-					  fltrename = fltrename_dst,
-					  registerAllocation}
-				       = case final_src
-					   of Operand.Address _
-					    => RA.allocateFltOperand 
-					       {operand = dst,
-						options = {fltregister = true,
-							   address = false},
-						info = info,
-						size = size,
-						move = true,
-						supports = [],
-						saves = [src,final_src],
-						top = SOME true,
-						registerAllocation 
-						= registerAllocation}
-				            | Operand.FltRegister f
-				            => if FltRegister.eq
-					          (f, FltRegister.top)
-						 then RA.allocateFltOperand 
-					              {operand = dst,
-						       options 
-						       = {fltregister = true,
-							  address = false},
-						       info = info,
-						       size = size,
-						       move = true,
-						       supports = [],
-						       saves = [src,final_src],
-						       top = SOME false,
-						       registerAllocation 
-						       = registerAllocation}
-						 else RA.allocateFltOperand 
-						      {operand = dst,
-						       options 
-						       = {fltregister = true,
-							  address = false},
-						       info = info,
-						       size = size,
-						       move = true,	
-						       supports = [],
-						       saves = [src,final_src],
-						       top = SOME true,
-						       registerAllocation 
-						       = registerAllocation}
-					    | _
-				            => Error.bug 
-					       "allocateRegisters: pFBinA, final_src"
+                                     val {operand = final_dst,
+                                          assembly = assembly_dst,
+                                          fltrename = fltrename_dst,
+                                          registerAllocation}
+                                       = case final_src
+                                           of Operand.Address _
+                                            => RA.allocateFltOperand 
+                                               {operand = dst,
+                                                options = {fltregister = true,
+                                                           address = false},
+                                                info = info,
+                                                size = size,
+                                                move = true,
+                                                supports = [],
+                                                saves = [src,final_src],
+                                                top = SOME true,
+                                                registerAllocation 
+                                                = registerAllocation}
+                                            | Operand.FltRegister f
+                                            => if FltRegister.eq
+                                                  (f, FltRegister.top)
+                                                 then RA.allocateFltOperand 
+                                                      {operand = dst,
+                                                       options 
+                                                       = {fltregister = true,
+                                                          address = false},
+                                                       info = info,
+                                                       size = size,
+                                                       move = true,
+                                                       supports = [],
+                                                       saves = [src,final_src],
+                                                       top = SOME false,
+                                                       registerAllocation 
+                                                       = registerAllocation}
+                                                 else RA.allocateFltOperand 
+                                                      {operand = dst,
+                                                       options 
+                                                       = {fltregister = true,
+                                                          address = false},
+                                                       info = info,
+                                                       size = size,
+                                                       move = true,     
+                                                       supports = [],
+                                                       saves = [src,final_src],
+                                                       top = SOME true,
+                                                       registerAllocation 
+                                                       = registerAllocation}
+                                            | _
+                                            => Error.bug 
+                                               "x86AllocateRegisters.Instruction.allocateRegisters: pFBinA, final_src"
 
-				     val final_src 
-				       = (RA.fltrenameLift fltrename_dst) final_src
-				   in
-				     {final_src = final_src,
-				      final_dst = final_dst,
-				      assembly_src_dst 
-				      = AppendList.appends
-				        [assembly_src,
-					 assembly_dst],
-				      fltrename_src_dst = fltrename_dst o
-				                          fltrename_src,
-				      oper = oper,
-				      pop = false,
-				      registerAllocation = registerAllocation}
-				   end
+                                     val final_src 
+                                       = (RA.fltrenameLift fltrename_dst) final_src
+                                   in
+                                     {final_src = final_src,
+                                      final_dst = final_dst,
+                                      assembly_src_dst 
+                                      = AppendList.appends
+                                        [assembly_src,
+                                         assembly_dst],
+                                      fltrename_src_dst = fltrename_dst o
+                                                          fltrename_src,
+                                      oper = oper,
+                                      pop = false,
+                                      registerAllocation = registerAllocation}
+                                   end
 
-			       fun default' ()
-				 = let
-				     val {operand = final_dst,
-					  assembly = assembly_dst,
-					  fltrename = fltrename_dst,
-					  registerAllocation}
-				       = RA.allocateFltOperand 
-				         {operand = dst,
-					  options = {fltregister = true,
-						     address = false},
-					  info = info,
-					  size = size,
-					  move = true,
-					  supports = [src],
-					  saves = [],
-					  top = SOME false,
-					  registerAllocation
-					  = registerAllocation}
-					 
-				     val {operand = final_src,
-					  assembly = assembly_src,
-					  fltrename = fltrename_src,
-					  registerAllocation}
-				       = RA.allocateFltOperand 
-				         {operand = src,
-					  options = {fltregister = true,
-						     address = false},
-					  info = info,
-					  size = size,
-					  move = true,	
-					  supports = [],
-					  saves = [dst,final_dst],
-					  top = SOME true,
-					  registerAllocation
-					  = registerAllocation}
-		    
-				     val final_dst 
-				       = (RA.fltrenameLift fltrename_src) final_dst
-				   in
-				     {final_src = final_src,
-				      final_dst = final_dst,
-				      assembly_src_dst 
-				      = AppendList.appends
-				        [assembly_dst,
-					 assembly_src],
-				      fltrename_src_dst = fltrename_src o 
-				                          fltrename_dst,
-				      oper = oper,
-				      pop = true,
-				      registerAllocation = registerAllocation}
-				   end
+                               fun default' ()
+                                 = let
+                                     val {operand = final_dst,
+                                          assembly = assembly_dst,
+                                          fltrename = fltrename_dst,
+                                          registerAllocation}
+                                       = RA.allocateFltOperand 
+                                         {operand = dst,
+                                          options = {fltregister = true,
+                                                     address = false},
+                                          info = info,
+                                          size = size,
+                                          move = true,
+                                          supports = [src],
+                                          saves = [],
+                                          top = SOME false,
+                                          registerAllocation
+                                          = registerAllocation}
+                                         
+                                     val {operand = final_src,
+                                          assembly = assembly_src,
+                                          fltrename = fltrename_src,
+                                          registerAllocation}
+                                       = RA.allocateFltOperand 
+                                         {operand = src,
+                                          options = {fltregister = true,
+                                                     address = false},
+                                          info = info,
+                                          size = size,
+                                          move = true,  
+                                          supports = [],
+                                          saves = [dst,final_dst],
+                                          top = SOME true,
+                                          registerAllocation
+                                          = registerAllocation}
+                    
+                                     val final_dst 
+                                       = (RA.fltrenameLift fltrename_src) final_dst
+                                   in
+                                     {final_src = final_src,
+                                      final_dst = final_dst,
+                                      assembly_src_dst 
+                                      = AppendList.appends
+                                        [assembly_dst,
+                                         assembly_src],
+                                      fltrename_src_dst = fltrename_src o 
+                                                          fltrename_dst,
+                                      oper = oper,
+                                      pop = true,
+                                      registerAllocation = registerAllocation}
+                                   end
 
-			       fun default'' value_dst
-				 = let
-				     val {operand = final_dst,
-					  assembly = assembly_dst,
-					  fltrename = fltrename_dst,
-					  registerAllocation}
-				       = RA.allocateFltOperand 
-				         {operand = dst,
-					  options = {fltregister = true,
-						     address = false},
-					  info = info,
-					  size = size,
-					  move = true,
-					  supports = [src],
-					  saves = [],
-					  top = SOME true,
-					  registerAllocation
-					  = registerAllocation}
-					 
-				     val {operand = final_src,
-					  assembly = assembly_src,
-					  fltrename = fltrename_src,
-					  registerAllocation}
-				       = RA.allocateFltOperand 
-				         {operand = src,
-					  options = {fltregister = true,
-						     address = false},
-					  info = info,
-					  size = size,
-					  move = true,	
-					  supports = [],
-					  saves = [dst,final_dst],
-					  top = SOME false,
-					  registerAllocation
-					  = registerAllocation}
+                               fun default'' value_dst
+                                 = let
+                                     val {operand = final_dst,
+                                          assembly = assembly_dst,
+                                          fltrename = fltrename_dst,
+                                          registerAllocation}
+                                       = RA.allocateFltOperand 
+                                         {operand = dst,
+                                          options = {fltregister = true,
+                                                     address = false},
+                                          info = info,
+                                          size = size,
+                                          move = true,
+                                          supports = [src],
+                                          saves = [],
+                                          top = SOME true,
+                                          registerAllocation
+                                          = registerAllocation}
+                                         
+                                     val {operand = final_src,
+                                          assembly = assembly_src,
+                                          fltrename = fltrename_src,
+                                          registerAllocation}
+                                       = RA.allocateFltOperand 
+                                         {operand = src,
+                                          options = {fltregister = true,
+                                                     address = false},
+                                          info = info,
+                                          size = size,
+                                          move = true,  
+                                          supports = [],
+                                          saves = [dst,final_dst],
+                                          top = SOME false,
+                                          registerAllocation
+                                          = registerAllocation}
 
-				     val final_dst 
-				       = (RA.fltrenameLift fltrename_src) final_dst
+                                     val final_dst 
+                                       = (RA.fltrenameLift fltrename_src) final_dst
 
-				     val {memloc = memloc_dst,
-					  weight = weight_dst,
-					  sync = sync_dst,
-					  commit = commit_dst,
-					  ...} : RegisterAllocation.fltvalue
-				       = value_dst
+                                     val {memloc = memloc_dst,
+                                          weight = weight_dst,
+                                          sync = sync_dst,
+                                          commit = commit_dst,
+                                          ...} : RegisterAllocation.fltvalue
+                                       = value_dst
 
-				     val fltregister_src
-				       = case Operand.deFltregister final_src
-					   of SOME fltregister => fltregister
-					    | NONE 
-					    => Error.bug "allocateRegisters: pFBinA, final_src"
+                                     val fltregister_src
+                                       = case Operand.deFltregister final_src
+                                           of SOME fltregister => fltregister
+                                            | NONE 
+                                            => Error.bug "x86AllocateRegisters.Instruction.allocateRegisters: pFBinA, final_src"
 
-				     val registerAllocation
-				       = RA.fltupdate
-				         {value
-					  = {fltregister = fltregister_src,
-					     memloc = memloc_dst,
-					     weight = weight_dst,
-					     sync = sync_dst,
-					     commit = commit_dst},
-					  registerAllocation
-					  = registerAllocation}
-				   in
-				     {final_src = final_dst,
-				      final_dst = final_src,
-				      assembly_src_dst 
-				      = AppendList.appends
-				        [assembly_dst,
-					 assembly_src],
-				      fltrename_src_dst = fltrename_src o 
-				                          fltrename_dst,
-				      oper = Instruction.fbina_reverse oper,
-				      pop = true,
-				      registerAllocation = registerAllocation}
-				   end
+                                     val registerAllocation
+                                       = RA.fltupdate
+                                         {value
+                                          = {fltregister = fltregister_src,
+                                             memloc = memloc_dst,
+                                             weight = weight_dst,
+                                             sync = sync_dst,
+                                             commit = commit_dst},
+                                          registerAllocation
+                                          = registerAllocation}
+                                   in
+                                     {final_src = final_dst,
+                                      final_dst = final_src,
+                                      assembly_src_dst 
+                                      = AppendList.appends
+                                        [assembly_dst,
+                                         assembly_src],
+                                      fltrename_src_dst = fltrename_src o 
+                                                          fltrename_dst,
+                                      oper = Instruction.fbina_reverse oper,
+                                      pop = true,
+                                      registerAllocation = registerAllocation}
+                                   end
 
-			       fun default''' memloc_dst
-				 = let
-				     val {operand = final_dst,
-					  assembly = assembly_dst,
-					  fltrename = fltrename_dst,
-					  registerAllocation}
-				       = RA.allocateFltOperand 
-				         {operand = dst,
-					  options = {fltregister = false,
-						     address = true},
-					  info = info,
-					  size = size,
-					  move = true,
-					  supports = [src],
-					  saves = [],
-					  top = SOME false,
-					  registerAllocation
-					  = registerAllocation}
-					 
-				     val {operand = final_src,
-					  assembly = assembly_src,
-					  fltrename = fltrename_src,
-					  registerAllocation}
-				       = RA.allocateFltOperand 
-				         {operand = src,
-					  options = {fltregister = true,
-						     address = false},
-					  info = info,
-					  size = size,
-					  move = true,	
-					  supports = [],
-					  saves = [dst,final_dst],
-					  top = SOME true,
-					  registerAllocation
-					  = registerAllocation}
+                               fun default''' memloc_dst
+                                 = let
+                                     val {operand = final_dst,
+                                          assembly = assembly_dst,
+                                          fltrename = fltrename_dst,
+                                          registerAllocation}
+                                       = RA.allocateFltOperand 
+                                         {operand = dst,
+                                          options = {fltregister = false,
+                                                     address = true},
+                                          info = info,
+                                          size = size,
+                                          move = true,
+                                          supports = [src],
+                                          saves = [],
+                                          top = SOME false,
+                                          registerAllocation
+                                          = registerAllocation}
+                                         
+                                     val {operand = final_src,
+                                          assembly = assembly_src,
+                                          fltrename = fltrename_src,
+                                          registerAllocation}
+                                       = RA.allocateFltOperand 
+                                         {operand = src,
+                                          options = {fltregister = true,
+                                                     address = false},
+                                          info = info,
+                                          size = size,
+                                          move = true,  
+                                          supports = [],
+                                          saves = [dst,final_dst],
+                                          top = SOME true,
+                                          registerAllocation
+                                          = registerAllocation}
 
-				     val final_dst 
-				       = (RA.fltrenameLift fltrename_src) final_dst
+                                     val final_dst 
+                                       = (RA.fltrenameLift fltrename_src) final_dst
 
-				     val {fltrename = fltrename_pop,
-					  registerAllocation}
-				       = RA.fltpop 
-				         {registerAllocation
-					  = registerAllocation}
+                                     val {fltrename = fltrename_pop,
+                                          registerAllocation}
+                                       = RA.fltpop 
+                                         {registerAllocation
+                                          = registerAllocation}
 
-				     val {fltrename = fltrename_push,
-					  registerAllocation}
-				       = RA.fltpush
-				         {value
-					  = {fltregister = FltRegister.top,
-					     memloc = memloc_dst,
-					     weight = 1024,
-					     sync = false,
-					     commit = RA.NO},
-					  registerAllocation
-					  = registerAllocation}
-				   in
-				     {final_src = final_dst,
-				      final_dst = final_src,
-				      assembly_src_dst 
-				      = AppendList.appends
-				        [assembly_dst,
-					 assembly_src],
-				      fltrename_src_dst = fltrename_push o
-				                          fltrename_pop o
-							  fltrename_src o 
-							  fltrename_dst,
-				      oper = Instruction.fbina_reverse oper,
-				      pop = false,
-				      registerAllocation = registerAllocation}
-				   end
-			     in
-			       case (src,dst)
-				 of (Operand.MemLoc memloc_src,
-				     Operand.MemLoc memloc_dst)
-				  => (case (RA.fltallocated 
-					    {memloc = memloc_src,
-					     registerAllocation 
-					     = registerAllocation},
-					    RA.fltallocated
-					    {memloc = memloc_dst,
-					     registerAllocation
-					     = registerAllocation})
-					of (SOME ({sync = sync_src,
-						   ...}),
-					    SOME (value_dst as
-						  {fltregister 
-						   = fltregister_dst,
-						   ...}))
-					 => if MemLocSet.contains(dead,
-								  memloc_src)
-					       orelse
-					       (MemLocSet.contains(remove,
-								   memloc_src)
-						andalso
-						sync_src)
-					      then if FltRegister.eq
-						      (fltregister_dst,
-						       FltRegister.top)
-						     then default'' value_dst
-						     else default' ()
-					      else default ()
-					 | (SOME {sync = sync_src,...},
-					    NONE)
-					 => if MemLocSet.contains(dead,
-								  memloc_src)
-					       orelse
-					       (MemLocSet.contains(remove,
-								   memloc_src)
-						andalso
-						sync_src)
-					      then default''' memloc_dst
-					      else default ()
+                                     val {fltrename = fltrename_push,
+                                          registerAllocation}
+                                       = RA.fltpush
+                                         {value
+                                          = {fltregister = FltRegister.top,
+                                             memloc = memloc_dst,
+                                             weight = 1024,
+                                             sync = false,
+                                             commit = RA.NO},
+                                          registerAllocation
+                                          = registerAllocation}
+                                   in
+                                     {final_src = final_dst,
+                                      final_dst = final_src,
+                                      assembly_src_dst 
+                                      = AppendList.appends
+                                        [assembly_dst,
+                                         assembly_src],
+                                      fltrename_src_dst = fltrename_push o
+                                                          fltrename_pop o
+                                                          fltrename_src o 
+                                                          fltrename_dst,
+                                      oper = Instruction.fbina_reverse oper,
+                                      pop = false,
+                                      registerAllocation = registerAllocation}
+                                   end
+                             in
+                               case (src,dst)
+                                 of (Operand.MemLoc memloc_src,
+                                     Operand.MemLoc memloc_dst)
+                                  => (case (RA.fltallocated 
+                                            {memloc = memloc_src,
+                                             registerAllocation 
+                                             = registerAllocation},
+                                            RA.fltallocated
+                                            {memloc = memloc_dst,
+                                             registerAllocation
+                                             = registerAllocation})
+                                        of (SOME ({sync = sync_src,
+                                                   ...}),
+                                            SOME (value_dst as
+                                                  {fltregister 
+                                                   = fltregister_dst,
+                                                   ...}))
+                                         => if MemLocSet.contains(dead,
+                                                                  memloc_src)
+                                               orelse
+                                               (MemLocSet.contains(remove,
+                                                                   memloc_src)
+                                                andalso
+                                                sync_src)
+                                              then if FltRegister.eq
+                                                      (fltregister_dst,
+                                                       FltRegister.top)
+                                                     then default'' value_dst
+                                                     else default' ()
+                                              else default ()
+                                         | (SOME {sync = sync_src,...},
+                                            NONE)
+                                         => if MemLocSet.contains(dead,
+                                                                  memloc_src)
+                                               orelse
+                                               (MemLocSet.contains(remove,
+                                                                   memloc_src)
+                                                andalso
+                                                sync_src)
+                                              then default''' memloc_dst
+                                              else default ()
                                          | _ => default ())
-				  | (Operand.MemLoc memloc_src, _)
-				  => (case RA.fltallocated 
-					   {memloc = memloc_src,
-					    registerAllocation 
-					    = registerAllocation}
-					of SOME {sync = sync_src,...}
-					 => if MemLocSet.contains(dead,
-								  memloc_src)
-					       orelse
-					       (MemLocSet.contains(remove,
-								   memloc_src)
-						andalso
-						sync_src)
-					      then default' ()
-					      else default ()
+                                  | (Operand.MemLoc memloc_src, _)
+                                  => (case RA.fltallocated 
+                                           {memloc = memloc_src,
+                                            registerAllocation 
+                                            = registerAllocation}
+                                        of SOME {sync = sync_src,...}
+                                         => if MemLocSet.contains(dead,
+                                                                  memloc_src)
+                                               orelse
+                                               (MemLocSet.contains(remove,
+                                                                   memloc_src)
+                                                andalso
+                                                sync_src)
+                                              then default' ()
+                                              else default ()
                                          | _ => default ())
                                   | _ => default ()
-			     end
+                             end
 
-		  val oper
-		    = if Operand.eq(final_src,
-				    Operand.fltregister FltRegister.top)
-		         andalso isSome (Operand.deFltregister final_dst)
-			then fbina_reverse oper
-			else oper
+                  val oper
+                    = if Operand.eq(final_src,
+                                    Operand.fltregister FltRegister.top)
+                         andalso isSome (Operand.deFltregister final_dst)
+                        then fbina_reverse oper
+                        else oper
 
-		  val instruction
-		    = Instruction.FBinA
-		      {oper = oper,
-		       src = final_src,
-		       dst = final_dst,
-		       size = size,
-		       pop = pop}
+                  val instruction
+                    = Instruction.FBinA
+                      {oper = oper,
+                       src = final_src,
+                       dst = final_dst,
+                       size = size,
+                       pop = pop}
 
-		  val {fltrename = fltrename_pop,
-		       registerAllocation}
-		    = if pop
-			then let
-			       val {fltrename = fltrename_pop,
-				    registerAllocation}
-				 = RA.fltpop {registerAllocation 
-					      = registerAllocation}
-			     in
-			       {fltrename = fltrename_pop,
-				registerAllocation = registerAllocation}
-			     end
-			else {fltrename = FltRegister.id,
-			      registerAllocation = registerAllocation}
+                  val {fltrename = fltrename_pop,
+                       registerAllocation}
+                    = if pop
+                        then let
+                               val {fltrename = fltrename_pop,
+                                    registerAllocation}
+                                 = RA.fltpop {registerAllocation 
+                                              = registerAllocation}
+                             in
+                               {fltrename = fltrename_pop,
+                                registerAllocation = registerAllocation}
+                             end
+                        else {fltrename = FltRegister.id,
+                              registerAllocation = registerAllocation}
 
-		  val {uses = final_uses,
-		       defs = final_defs,
-		       ...}
-		    = Instruction.uses_defs_kills instruction
-		    
-		  val final_uses
-		    = List.revMap(final_uses, RA.fltrenameLift fltrename_pop)
-		  val final_defs
-		    = List.revMap(final_defs, RA.fltrenameLift fltrename_pop)
+                  val {uses = final_uses,
+                       defs = final_defs,
+                       ...}
+                    = Instruction.uses_defs_kills instruction
+                    
+                  val final_uses
+                    = List.revMap(final_uses, RA.fltrenameLift fltrename_pop)
+                  val final_defs
+                    = List.revMap(final_defs, RA.fltrenameLift fltrename_pop)
 
-		  val {assembly = assembly_post,
-		       registerAllocation}
-		    = RA.post {uses = uses,
-			       final_uses = final_uses,
-			       defs = defs,
-			       final_defs = final_defs,
-			       kills = kills,
-			       info = info,
-			       registerAllocation = registerAllocation}
+                  val {assembly = assembly_post,
+                       registerAllocation}
+                    = RA.post {uses = uses,
+                               final_uses = final_uses,
+                               defs = defs,
+                               final_defs = final_defs,
+                               kills = kills,
+                               info = info,
+                               registerAllocation = registerAllocation}
 
-		in
-		  {assembly 
-		   = AppendList.appends
-		     [assembly_pre,
-		      assembly_src_dst,
-		      AppendList.single
-		      (Assembly.instruction instruction),
-		      assembly_post],
-		   registerAllocation = registerAllocation}
-		end
-	     | pFUnA {oper, dst, size}
-	       (* Floating-point unary arithmetic instructions.
-		* Require src operand as follows:
-		*
-		*               src
-		*           fltreg add 
-		*            *
-		*   * only st(0)
-		*
-		* Require size modifier class as follows: FLT
-		*)		
-	     => let
-		  val {uses,defs,kills} 
-		    = Instruction.uses_defs_kills instruction
-		  val {assembly = assembly_pre,
-		       registerAllocation}
-		    = RA.pre {uses = uses,
-			      defs = defs,
-			      kills = kills,
-			      info = info,
-			      registerAllocation = registerAllocation}
+                in
+                  {assembly 
+                   = AppendList.appends
+                     [assembly_pre,
+                      assembly_src_dst,
+                      AppendList.single
+                      (Assembly.instruction instruction),
+                      assembly_post],
+                   registerAllocation = registerAllocation}
+                end
+             | pFUnA {oper, dst, size}
+               (* Floating-point unary arithmetic instructions.
+                * Require src operand as follows:
+                *
+                *               src
+                *           fltreg add 
+                *            *
+                *   * only st(0)
+                *
+                * Require size modifier class as follows: FLT
+                *)              
+             => let
+                  val {uses,defs,kills} 
+                    = Instruction.uses_defs_kills instruction
+                  val {assembly = assembly_pre,
+                       registerAllocation}
+                    = RA.pre {uses = uses,
+                              defs = defs,
+                              kills = kills,
+                              info = info,
+                              registerAllocation = registerAllocation}
 
-		  val {assembly = assembly_dst,
-		       registerAllocation,
-		       ...}
-		    = RA.allocateFltOperand {operand = dst,
-					     options = {fltregister = true,
-							address = false},
-					     info = info,
-					     size = size,
-					     move = true,
-					     supports = [],
-					     saves = [],
-					     top = SOME true,
-					     registerAllocation
-					     = registerAllocation}
+                  val {assembly = assembly_dst,
+                       registerAllocation,
+                       ...}
+                    = RA.allocateFltOperand {operand = dst,
+                                             options = {fltregister = true,
+                                                        address = false},
+                                             info = info,
+                                             size = size,
+                                             move = true,
+                                             supports = [],
+                                             saves = [],
+                                             top = SOME true,
+                                             registerAllocation
+                                             = registerAllocation}
 
-		  val instruction
-		    = Instruction.FUnA
-		      {oper = oper}
+                  val instruction
+                    = Instruction.FUnA
+                      {oper = oper}
 
-		  val {uses = final_uses,
-		       defs = final_defs,  
-		       ...}
-		    = Instruction.uses_defs_kills instruction
+                  val {uses = final_uses,
+                       defs = final_defs,  
+                       ...}
+                    = Instruction.uses_defs_kills instruction
 
-		  val {assembly = assembly_post,
-		       registerAllocation}
-		    = RA.post {uses = uses,
-			       final_uses = final_uses,
-			       defs = defs,
-			       final_defs = final_defs,
-			       kills = kills,
-			       info = info,
-			       registerAllocation = registerAllocation}
-		in
-		  {assembly 
-		   = AppendList.appends
-		     [assembly_pre,
-		      assembly_dst,
-		      AppendList.single
-		      (Assembly.instruction instruction),
-		      assembly_post],
-		   registerAllocation = registerAllocation}
-		end
-	     | pFPTAN {dst, size}
-	       (* Floating-point partial tangent instruction.
-		* Require src operand as follows:
-		*
-		*               src
-		*           fltreg add 
-		*            *
-		*   * only st(0)
-		*
-		* Require size modifier class as follows: FLT
-		* Automatically pushes 1.0 onto stack.
-		*)		
-	     => let
-		  val {uses,defs,kills} 
-		    = Instruction.uses_defs_kills instruction
-		  val {assembly = assembly_pre,
-		       registerAllocation}
-		    = RA.pre {uses = uses,
-			      defs = defs,
-			      kills = kills,
-			      info = info,
-			      registerAllocation = registerAllocation}
+                  val {assembly = assembly_post,
+                       registerAllocation}
+                    = RA.post {uses = uses,
+                               final_uses = final_uses,
+                               defs = defs,
+                               final_defs = final_defs,
+                               kills = kills,
+                               info = info,
+                               registerAllocation = registerAllocation}
+                in
+                  {assembly 
+                   = AppendList.appends
+                     [assembly_pre,
+                      assembly_dst,
+                      AppendList.single
+                      (Assembly.instruction instruction),
+                      assembly_post],
+                   registerAllocation = registerAllocation}
+                end
+             | pFPTAN {dst, size}
+               (* Floating-point partial tangent instruction.
+                * Require src operand as follows:
+                *
+                *               src
+                *           fltreg add 
+                *            *
+                *   * only st(0)
+                *
+                * Require size modifier class as follows: FLT
+                * Automatically pushes 1.0 onto stack.
+                *)              
+             => let
+                  val {uses,defs,kills} 
+                    = Instruction.uses_defs_kills instruction
+                  val {assembly = assembly_pre,
+                       registerAllocation}
+                    = RA.pre {uses = uses,
+                              defs = defs,
+                              kills = kills,
+                              info = info,
+                              registerAllocation = registerAllocation}
 
-		  val {assembly = assembly_free,
-		       registerAllocation, 
-		       ...}
-		    = RA.freeFltRegister
-		      {info = info,
-		       size = Size.DBLE,
-		       supports = [dst],
-		       saves = [],
-		       registerAllocation = registerAllocation}
+                  val {assembly = assembly_free,
+                       registerAllocation, 
+                       ...}
+                    = RA.freeFltRegister
+                      {info = info,
+                       size = Size.DBLE,
+                       supports = [dst],
+                       saves = [],
+                       registerAllocation = registerAllocation}
 
-		  val {assembly = assembly_dst,
-		       registerAllocation,
-		       ...}
-		    = RA.allocateFltOperand {operand = dst,
-					     options = {fltregister = true,
-							address = false},
-					     info = info,
-					     size = size,
-					     move = true,
-					     supports = [],
-					     saves = [],
-					     top = SOME true,
-					     registerAllocation
-					     = registerAllocation}
+                  val {assembly = assembly_dst,
+                       registerAllocation,
+                       ...}
+                    = RA.allocateFltOperand {operand = dst,
+                                             options = {fltregister = true,
+                                                        address = false},
+                                             info = info,
+                                             size = size,
+                                             move = true,
+                                             supports = [],
+                                             saves = [],
+                                             top = SOME true,
+                                             registerAllocation
+                                             = registerAllocation}
 
-		  val instruction
-		    = Instruction.FPTAN
+                  val instruction
+                    = Instruction.FPTAN
 
-		  val {uses = final_uses,
-		       defs = final_defs,  
-		       ...}
-		    = Instruction.uses_defs_kills instruction
+                  val {uses = final_uses,
+                       defs = final_defs,  
+                       ...}
+                    = Instruction.uses_defs_kills instruction
 
-		  val {assembly = assembly_post,
-		       registerAllocation}
-		    = RA.post {uses = uses,
-			       final_uses = final_uses,
-			       defs = defs,
-			       final_defs = final_defs,
-			       kills = kills,
-			       info = info,
-			       registerAllocation = registerAllocation}
-		in
-		  {assembly 
-		   = AppendList.appends
-		     [assembly_pre,
-		      assembly_free,
-		      assembly_dst,
-		      AppendList.single
-		      (Assembly.instruction instruction),
-		      AppendList.single
-		      (Assembly.instruction_fst
-		       {dst = Operand.fltregister FltRegister.top,
-			size = Size.DBLE,
-			pop = true}),
-		      assembly_post],
-		   registerAllocation = registerAllocation}
-		end
-	     | pFBinAS {oper, src, dst, size}
-	       (* Floating-point binary arithmetic stack instructions.
-		* Require src operand as follows:
-		*
-		*               src
-		*           fltreg add 
-		*             *
-		*   * only st(1)
-		*
-		* Require dst operand as follows:
-		*
-		*               dst
-		*           fltreg add 
-		*            *
-		*   * only st(0)
-		*
-		* Require size modifier class as follows: FLT
-		*)		
-	     => let
-		  val {uses,defs,kills} 
-		    = Instruction.uses_defs_kills instruction
-		  val {assembly = assembly_pre,
-		       registerAllocation}
-		    = RA.pre {uses = uses,
-			      defs = defs,
-			      kills = kills,
-			      info = info,
-			      registerAllocation = registerAllocation}
+                  val {assembly = assembly_post,
+                       registerAllocation}
+                    = RA.post {uses = uses,
+                               final_uses = final_uses,
+                               defs = defs,
+                               final_defs = final_defs,
+                               kills = kills,
+                               info = info,
+                               registerAllocation = registerAllocation}
+                in
+                  {assembly 
+                   = AppendList.appends
+                     [assembly_pre,
+                      assembly_free,
+                      assembly_dst,
+                      AppendList.single
+                      (Assembly.instruction instruction),
+                      AppendList.single
+                      (Assembly.instruction_fst
+                       {dst = Operand.fltregister FltRegister.top,
+                        size = Size.DBLE,
+                        pop = true}),
+                      assembly_post],
+                   registerAllocation = registerAllocation}
+                end
+             | pFBinAS {oper, src, dst, size}
+               (* Floating-point binary arithmetic stack instructions.
+                * Require src operand as follows:
+                *
+                *               src
+                *           fltreg add 
+                *             *
+                *   * only st(1)
+                *
+                * Require dst operand as follows:
+                *
+                *               dst
+                *           fltreg add 
+                *            *
+                *   * only st(0)
+                *
+                * Require size modifier class as follows: FLT
+                *)              
+             => let
+                  val {uses,defs,kills} 
+                    = Instruction.uses_defs_kills instruction
+                  val {assembly = assembly_pre,
+                       registerAllocation}
+                    = RA.pre {uses = uses,
+                              defs = defs,
+                              kills = kills,
+                              info = info,
+                              registerAllocation = registerAllocation}
 
-		  val {assembly = assembly_dst_src,
-		       registerAllocation,
-		       ...}
-		    = RA.allocateFltStackOperands
-		      {operand_top = dst,
-		       move_top = true,
-		       size_top = size,
-		       operand_one = src,
-		       move_one = true,
-		       size_one = size,
-		       info = info,
-		       supports = [],
-		       saves = [],
-		       registerAllocation = registerAllocation}
+                  val {assembly = assembly_dst_src,
+                       registerAllocation,
+                       ...}
+                    = RA.allocateFltStackOperands
+                      {operand_top = dst,
+                       move_top = true,
+                       size_top = size,
+                       operand_one = src,
+                       move_one = true,
+                       size_one = size,
+                       info = info,
+                       supports = [],
+                       saves = [],
+                       registerAllocation = registerAllocation}
 
-		  val instruction
-		    = Instruction.FBinAS
-		      {oper = oper}
+                  val instruction
+                    = Instruction.FBinAS
+                      {oper = oper}
 
-		  val {uses = final_uses,
-		       defs = final_defs,
-		       ...}
-		    = Instruction.uses_defs_kills instruction
+                  val {uses = final_uses,
+                       defs = final_defs,
+                       ...}
+                    = Instruction.uses_defs_kills instruction
 
-		  val {assembly = assembly_post,
-		       registerAllocation}
-		    = RA.post {uses = uses,
-			       final_uses = final_uses,
-			       defs = defs,
-			       final_defs = final_defs,
-			       kills = kills,
-			       info = info,
-			       registerAllocation = registerAllocation}
-		in
-		  {assembly 
-		   = AppendList.appends
-		     [assembly_pre,
-		      assembly_dst_src,
-		      AppendList.single
-		      (Assembly.instruction instruction),
-		      assembly_post],
-		   registerAllocation = registerAllocation}
-		end
-	     | pFBinASP {oper, src, dst, size}
-	       (* Floating-point binary arithmetic stack pop instructions.
-		* Require src operand as follows:
-		*
-		*               src
-		*           fltreg add 
-		*             *
-		*   * only st(0)
-		*
-		* Require dst operand as follows:
-		*
-		*               dst
-		*           fltreg add 
-		*            *
-		*   * only st(1)
-		*
-		* Require size modifier class as follows: FLT
-		*)		
-	     => let
-		  val {uses,defs,kills} 
-		    = Instruction.uses_defs_kills instruction
-		  val {assembly = assembly_pre,
-		       registerAllocation}
-		    = RA.pre {uses = uses,
-			      defs = defs,
-			      kills = kills,
-			      info = info,
-			      registerAllocation = registerAllocation}
+                  val {assembly = assembly_post,
+                       registerAllocation}
+                    = RA.post {uses = uses,
+                               final_uses = final_uses,
+                               defs = defs,
+                               final_defs = final_defs,
+                               kills = kills,
+                               info = info,
+                               registerAllocation = registerAllocation}
+                in
+                  {assembly 
+                   = AppendList.appends
+                     [assembly_pre,
+                      assembly_dst_src,
+                      AppendList.single
+                      (Assembly.instruction instruction),
+                      assembly_post],
+                   registerAllocation = registerAllocation}
+                end
+             | pFBinASP {oper, src, dst, size}
+               (* Floating-point binary arithmetic stack pop instructions.
+                * Require src operand as follows:
+                *
+                *               src
+                *           fltreg add 
+                *             *
+                *   * only st(0)
+                *
+                * Require dst operand as follows:
+                *
+                *               dst
+                *           fltreg add 
+                *            *
+                *   * only st(1)
+                *
+                * Require size modifier class as follows: FLT
+                *)              
+             => let
+                  val {uses,defs,kills} 
+                    = Instruction.uses_defs_kills instruction
+                  val {assembly = assembly_pre,
+                       registerAllocation}
+                    = RA.pre {uses = uses,
+                              defs = defs,
+                              kills = kills,
+                              info = info,
+                              registerAllocation = registerAllocation}
 
-		  val {assembly = assembly_src_dst,
-		       registerAllocation, ...}
-		    = RA.allocateFltStackOperands
-		      {operand_top = src,
-		       move_top = true,
-		       size_top = size,
-		       operand_one = dst,
-		       move_one = true,
-		       size_one = size,
-		       info = info,	
-		       supports = [],
-		       saves = [],
-		       registerAllocation = registerAllocation}
+                  val {assembly = assembly_src_dst,
+                       registerAllocation, ...}
+                    = RA.allocateFltStackOperands
+                      {operand_top = src,
+                       move_top = true,
+                       size_top = size,
+                       operand_one = dst,
+                       move_one = true,
+                       size_one = size,
+                       info = info,     
+                       supports = [],
+                       saves = [],
+                       registerAllocation = registerAllocation}
 
-		  val instruction
-		    = Instruction.FBinASP
-		      {oper = oper}
+                  val instruction
+                    = Instruction.FBinASP
+                      {oper = oper}
 
-		  val {fltrename = fltrename_pop,
-		       registerAllocation}
-		    = RA.fltpop {registerAllocation = registerAllocation}
+                  val {fltrename = fltrename_pop,
+                       registerAllocation}
+                    = RA.fltpop {registerAllocation = registerAllocation}
 
-		  val {uses = final_uses,
-		       defs = final_defs,
-		       ...}
-		    = Instruction.uses_defs_kills instruction
-		    
-		  val final_uses
-		    = List.revMap(final_uses, RA.fltrenameLift fltrename_pop)
-		  val final_defs
-		    = List.revMap(final_defs, RA.fltrenameLift fltrename_pop)
+                  val {uses = final_uses,
+                       defs = final_defs,
+                       ...}
+                    = Instruction.uses_defs_kills instruction
+                    
+                  val final_uses
+                    = List.revMap(final_uses, RA.fltrenameLift fltrename_pop)
+                  val final_defs
+                    = List.revMap(final_defs, RA.fltrenameLift fltrename_pop)
 
-		  val {assembly = assembly_post,
-		       registerAllocation}
-		    = RA.post {uses = uses,
-			       final_uses = final_uses,
-			       defs = defs,
-			       final_defs = final_defs,
-			       kills = kills,
-			       info = info,
-			       registerAllocation = registerAllocation}
-		in
-		  {assembly 
-		   = AppendList.appends
-		     [assembly_pre,
-		      assembly_src_dst,
-		      AppendList.single
-		      (Assembly.instruction instruction),
-		      assembly_post],
-		   registerAllocation = registerAllocation}
-		end
-	     | FLDCW {src}
-	       (* Floating-point load control word; p. 252
-		* Require src operand as follows:
-		*
-		*              dst
-		*          reg imm lab add 
-		*                       X
-		*)
-	     => let
-		  val {uses,defs,kills} 
-		    = Instruction.uses_defs_kills instruction
-		  val {assembly = assembly_pre,
-		       registerAllocation}
-		    = RA.pre {uses = uses,
-			      defs = defs,
-			      kills = kills,
-			      info = info,
-			      registerAllocation = registerAllocation}
+                  val {assembly = assembly_post,
+                       registerAllocation}
+                    = RA.post {uses = uses,
+                               final_uses = final_uses,
+                               defs = defs,
+                               final_defs = final_defs,
+                               kills = kills,
+                               info = info,
+                               registerAllocation = registerAllocation}
+                in
+                  {assembly 
+                   = AppendList.appends
+                     [assembly_pre,
+                      assembly_src_dst,
+                      AppendList.single
+                      (Assembly.instruction instruction),
+                      assembly_post],
+                   registerAllocation = registerAllocation}
+                end
+             | FLDCW {src}
+               (* Floating-point load control word; p. 252
+                * Require src operand as follows:
+                *
+                *              dst
+                *          reg imm lab add 
+                *                       X
+                *)
+             => let
+                  val {uses,defs,kills} 
+                    = Instruction.uses_defs_kills instruction
+                  val {assembly = assembly_pre,
+                       registerAllocation}
+                    = RA.pre {uses = uses,
+                              defs = defs,
+                              kills = kills,
+                              info = info,
+                              registerAllocation = registerAllocation}
 
-		  val {operand = final_src, 
-		       assembly = assembly_src,
-		       registerAllocation}
-		    = RA.allocateOperand {operand = src,
-					  options = {register = false,
-						     immediate = false,
-						     label = false,
-						     address = true}, 
-					  info = info,
-					  size = Size.WORD,
-					  move = false,
-					  supports = [],
-					  saves = [],
-					  force = [],
-					  registerAllocation 
-					  = registerAllocation}
+                  val {operand = final_src, 
+                       assembly = assembly_src,
+                       registerAllocation}
+                    = RA.allocateOperand {operand = src,
+                                          options = {register = false,
+                                                     immediate = false,
+                                                     label = false,
+                                                     address = true}, 
+                                          info = info,
+                                          size = Size.WORD,
+                                          move = false,
+                                          supports = [],
+                                          saves = [],
+                                          force = [],
+                                          registerAllocation 
+                                          = registerAllocation}
 
-		  val instruction
-		    = Instruction.FLDCW
-		      {src = final_src}
+                  val instruction
+                    = Instruction.FLDCW
+                      {src = final_src}
 
-		  val {uses = final_uses,
-		       defs = final_defs,  
-		       ...}
-		    = Instruction.uses_defs_kills instruction
+                  val {uses = final_uses,
+                       defs = final_defs,  
+                       ...}
+                    = Instruction.uses_defs_kills instruction
 
-		  val {assembly = assembly_post,
-		       registerAllocation}
-		    = RA.post {uses = uses,
-			       final_uses = final_uses,
-			       defs = defs,
-			       final_defs = final_defs,
-			       kills = kills,
-			       info = info,
-			       registerAllocation = registerAllocation}
-		in
-		  {assembly 
-		   = AppendList.appends 
-		     [assembly_pre,
-		      assembly_src,
-		      AppendList.single
-		      (Assembly.instruction instruction),
-		      assembly_post],
-		   registerAllocation = registerAllocation}
-		end
-	     | FSTCW {dst, check}
-	       (* Floating-point store control word; p. 289
-		* Require dst operand as follows:
-		*
-		*              dst
-		*          reg imm lab add 
-		*                       X
-		*)
-	     => let
-		  val {uses,defs,kills} 
-		    = Instruction.uses_defs_kills instruction
-		  val {assembly = assembly_pre,
-		       registerAllocation}
-		    = RA.pre {uses = uses,
-			      defs = defs,
-			      kills = kills,
-			      info = info,
-			      registerAllocation = registerAllocation}
+                  val {assembly = assembly_post,
+                       registerAllocation}
+                    = RA.post {uses = uses,
+                               final_uses = final_uses,
+                               defs = defs,
+                               final_defs = final_defs,
+                               kills = kills,
+                               info = info,
+                               registerAllocation = registerAllocation}
+                in
+                  {assembly 
+                   = AppendList.appends 
+                     [assembly_pre,
+                      assembly_src,
+                      AppendList.single
+                      (Assembly.instruction instruction),
+                      assembly_post],
+                   registerAllocation = registerAllocation}
+                end
+             | FSTCW {dst, check}
+               (* Floating-point store control word; p. 289
+                * Require dst operand as follows:
+                *
+                *              dst
+                *          reg imm lab add 
+                *                       X
+                *)
+             => let
+                  val {uses,defs,kills} 
+                    = Instruction.uses_defs_kills instruction
+                  val {assembly = assembly_pre,
+                       registerAllocation}
+                    = RA.pre {uses = uses,
+                              defs = defs,
+                              kills = kills,
+                              info = info,
+                              registerAllocation = registerAllocation}
 
-		  val {operand = final_dst, 
-		       assembly = assembly_dst,
-		       registerAllocation}
-		    = RA.allocateOperand {operand = dst,
-					  options = {register = false,
-						     immediate = false,
-						     label = false,
-						     address = true}, 
-					  info = info,
-					  size = Size.WORD,
-					  move = false,
-					  supports = [],
-					  saves = [],
-					  force = [],
-					  registerAllocation 
-					  = registerAllocation}
+                  val {operand = final_dst, 
+                       assembly = assembly_dst,
+                       registerAllocation}
+                    = RA.allocateOperand {operand = dst,
+                                          options = {register = false,
+                                                     immediate = false,
+                                                     label = false,
+                                                     address = true}, 
+                                          info = info,
+                                          size = Size.WORD,
+                                          move = false,
+                                          supports = [],
+                                          saves = [],
+                                          force = [],
+                                          registerAllocation 
+                                          = registerAllocation}
 
-		  val instruction
-		    = Instruction.FSTCW
-		      {dst = final_dst,
-		       check = check}
+                  val instruction
+                    = Instruction.FSTCW
+                      {dst = final_dst,
+                       check = check}
 
-		  val {uses = final_uses,
-		       defs = final_defs,  
-		       ...}
-		    = Instruction.uses_defs_kills instruction
+                  val {uses = final_uses,
+                       defs = final_defs,  
+                       ...}
+                    = Instruction.uses_defs_kills instruction
 
-		  val {assembly = assembly_post,
-		       registerAllocation}
-		    = RA.post {uses = uses,
-			       final_uses = final_uses,
-			       defs = defs,
-			       final_defs = final_defs,
-			       kills = kills,
-			       info = info,
-			       registerAllocation = registerAllocation}
-		in
-		  {assembly 
-		   = AppendList.appends 
-		     [assembly_pre,
-		      assembly_dst,
-		      AppendList.single
-		      (Assembly.instruction instruction),
-		      assembly_post],
-		   registerAllocation = registerAllocation}
-		end
-	     | FSTSW {dst, check}
-	       (* Floating-point store status word; p. 294
-		* Require dst operand as follows:
-		*
-		*              dst
-		*          reg imm lab add 
-		*           *           X
-		*   * only register %ax
-		*)
-	     => let
-		  val {uses,defs,kills} 
-		    = Instruction.uses_defs_kills instruction
-		  val {assembly = assembly_pre,
-		       registerAllocation}
-		    = RA.pre {uses = uses,
-			      defs = defs,
-			      kills = kills,
-			      info = info,
-			      registerAllocation = registerAllocation}
+                  val {assembly = assembly_post,
+                       registerAllocation}
+                    = RA.post {uses = uses,
+                               final_uses = final_uses,
+                               defs = defs,
+                               final_defs = final_defs,
+                               kills = kills,
+                               info = info,
+                               registerAllocation = registerAllocation}
+                in
+                  {assembly 
+                   = AppendList.appends 
+                     [assembly_pre,
+                      assembly_dst,
+                      AppendList.single
+                      (Assembly.instruction instruction),
+                      assembly_post],
+                   registerAllocation = registerAllocation}
+                end
+             | FSTSW {dst, check}
+               (* Floating-point store status word; p. 294
+                * Require dst operand as follows:
+                *
+                *              dst
+                *          reg imm lab add 
+                *           *           X
+                *   * only register %ax
+                *)
+             => let
+                  val {uses,defs,kills} 
+                    = Instruction.uses_defs_kills instruction
+                  val {assembly = assembly_pre,
+                       registerAllocation}
+                    = RA.pre {uses = uses,
+                              defs = defs,
+                              kills = kills,
+                              info = info,
+                              registerAllocation = registerAllocation}
 
-		  val {operand = final_dst, 
-		       assembly = assembly_dst,
-		       registerAllocation}
-		    = RA.allocateOperand {operand = dst,
-					  options = {register = true,
-						     immediate = false,
-						     label = false,
-						     address = false}, 
-					  info = info,
-					  size = Size.WORD,
-					  move = false,
-					  supports = [],
-					  saves = [],
-					  force = [Register.T 
-						   {reg = Register.EAX, 
-						    part = Register.X}],
-					  registerAllocation 
-					  = registerAllocation}
+                  val {operand = final_dst, 
+                       assembly = assembly_dst,
+                       registerAllocation}
+                    = RA.allocateOperand {operand = dst,
+                                          options = {register = true,
+                                                     immediate = false,
+                                                     label = false,
+                                                     address = false}, 
+                                          info = info,
+                                          size = Size.WORD,
+                                          move = false,
+                                          supports = [],
+                                          saves = [],
+                                          force = [Register.T 
+                                                   {reg = Register.EAX, 
+                                                    part = Register.X}],
+                                          registerAllocation 
+                                          = registerAllocation}
 
-		  val instruction
-		    = Instruction.FSTSW
-		      {dst = final_dst,
-		       check = check}
+                  val instruction
+                    = Instruction.FSTSW
+                      {dst = final_dst,
+                       check = check}
 
-		  val {uses = final_uses,
-		       defs = final_defs,  
-		       ...}
-		    = Instruction.uses_defs_kills instruction
+                  val {uses = final_uses,
+                       defs = final_defs,  
+                       ...}
+                    = Instruction.uses_defs_kills instruction
 
-		  val {assembly = assembly_post,
-		       registerAllocation}
-		    = RA.post {uses = uses,
-			       final_uses = final_uses,
-			       defs = defs,
-			       final_defs = final_defs,
-			       kills = kills,
-			       info = info,
-			       registerAllocation = registerAllocation}
-		in
-		  {assembly 
-		   = AppendList.appends 
-		     [assembly_pre,
-		      assembly_dst,
-		      AppendList.single
-		      (Assembly.instruction instruction),
-		      assembly_post],
-		   registerAllocation = registerAllocation}
-		end
-	     | _ => Error.bug "allocateRegisters: unimplemented"
+                  val {assembly = assembly_post,
+                       registerAllocation}
+                    = RA.post {uses = uses,
+                               final_uses = final_uses,
+                               defs = defs,
+                               final_defs = final_defs,
+                               kills = kills,
+                               info = info,
+                               registerAllocation = registerAllocation}
+                in
+                  {assembly 
+                   = AppendList.appends 
+                     [assembly_pre,
+                      assembly_dst,
+                      AppendList.single
+                      (Assembly.instruction instruction),
+                      assembly_post],
+                   registerAllocation = registerAllocation}
+                end
+             | _ => Error.bug "x86AllocateRegisters.Instruction.allocateRegisters: unimplemented"
 
       val (allocateRegisters, allocateRegisters_msg)
-	= tracer
-	  "Instruction.allocateRegisters"
-	  allocateRegisters
+        = tracer
+          "Instruction.allocateRegisters"
+          allocateRegisters
      end
 
   structure Directive =
@@ -10600,86 +10583,86 @@
       open Directive
 
       fun allocateRegisters {directive, info, registerAllocation}
-	= let 
-	    val {assembly, registerAllocation}
-	      = case directive
-		  of Assume {assumes}
+        = let 
+            val {assembly, registerAllocation}
+              = case directive
+                  of Assume {assumes}
                    => RegisterAllocation.assume 
-		      {assumes = assumes,
-		       info = info,
-		       registerAllocation = registerAllocation}
-		   | FltAssume {assumes}
-		   => RegisterAllocation.fltassume
-		      {assumes = assumes,
-		       info = info,
-		       registerAllocation = registerAllocation}
-	           | Cache {caches}
-	           => RegisterAllocation.cache 
-		      {caches = caches,
-		       info = info,
-		       registerAllocation = registerAllocation}
-		   | FltCache {caches}
-		   => RegisterAllocation.fltcache
-		      {caches = caches,
-		       info = info,
-		       registerAllocation = registerAllocation}
-		   | Reset
-		   => RegisterAllocation.reset 
-		      {registerAllocation = registerAllocation}
-		   | Force {commit_memlocs, commit_classes, 
-			    remove_memlocs, remove_classes, 
-			    dead_memlocs, dead_classes}
-		   => RegisterAllocation.force
-		      {commit_memlocs = commit_memlocs,
-		       commit_classes = commit_classes,
-		       remove_memlocs = remove_memlocs,
-		       remove_classes = remove_classes,
-		       dead_memlocs = dead_memlocs,
-		       dead_classes = dead_classes,
-		       info = info,
-		       registerAllocation = registerAllocation}
-		   | CCall
-		   => RegisterAllocation.ccall
-		      {info = info,
-		       registerAllocation = registerAllocation}
-		   | Return {returns}
-		   => RegisterAllocation.return
-		      {returns = returns,
-		       info = info,
-		       registerAllocation = registerAllocation}
-		   | Reserve {registers}
-		   => RegisterAllocation.reserve 
-		      {registers = registers,
-		       registerAllocation = registerAllocation}
-		   | Unreserve {registers}
-		   => RegisterAllocation.unreserve 
-	              {registers = registers,
-		       registerAllocation = registerAllocation}
-		   | ClearFlt
-		   => RegisterAllocation.clearflt
-		      {info = info,
-		       registerAllocation = registerAllocation}
-		   | SaveRegAlloc {live, id}
-		   => RegisterAllocation.saveregalloc 
-		      {live = live,
-		       id = id,
-		       info = info,
-		       registerAllocation = registerAllocation}
-		   | RestoreRegAlloc {live, id}
-		   => RegisterAllocation.restoreregalloc
-		      {live = live,
-		       id = id,
-		       info = info,
-		       registerAllocation = registerAllocation}
-	  in
-	    {assembly = assembly,
-	     registerAllocation = registerAllocation}
-	  end
+                      {assumes = assumes,
+                       info = info,
+                       registerAllocation = registerAllocation}
+                   | FltAssume {assumes}
+                   => RegisterAllocation.fltassume
+                      {assumes = assumes,
+                       info = info,
+                       registerAllocation = registerAllocation}
+                   | Cache {caches}
+                   => RegisterAllocation.cache 
+                      {caches = caches,
+                       info = info,
+                       registerAllocation = registerAllocation}
+                   | FltCache {caches}
+                   => RegisterAllocation.fltcache
+                      {caches = caches,
+                       info = info,
+                       registerAllocation = registerAllocation}
+                   | Reset
+                   => RegisterAllocation.reset 
+                      {registerAllocation = registerAllocation}
+                   | Force {commit_memlocs, commit_classes, 
+                            remove_memlocs, remove_classes, 
+                            dead_memlocs, dead_classes}
+                   => RegisterAllocation.force
+                      {commit_memlocs = commit_memlocs,
+                       commit_classes = commit_classes,
+                       remove_memlocs = remove_memlocs,
+                       remove_classes = remove_classes,
+                       dead_memlocs = dead_memlocs,
+                       dead_classes = dead_classes,
+                       info = info,
+                       registerAllocation = registerAllocation}
+                   | CCall
+                   => RegisterAllocation.ccall
+                      {info = info,
+                       registerAllocation = registerAllocation}
+                   | Return {returns}
+                   => RegisterAllocation.return
+                      {returns = returns,
+                       info = info,
+                       registerAllocation = registerAllocation}
+                   | Reserve {registers}
+                   => RegisterAllocation.reserve 
+                      {registers = registers,
+                       registerAllocation = registerAllocation}
+                   | Unreserve {registers}
+                   => RegisterAllocation.unreserve 
+                      {registers = registers,
+                       registerAllocation = registerAllocation}
+                   | ClearFlt
+                   => RegisterAllocation.clearflt
+                      {info = info,
+                       registerAllocation = registerAllocation}
+                   | SaveRegAlloc {live, id}
+                   => RegisterAllocation.saveregalloc 
+                      {live = live,
+                       id = id,
+                       info = info,
+                       registerAllocation = registerAllocation}
+                   | RestoreRegAlloc {live, id}
+                   => RegisterAllocation.restoreregalloc
+                      {live = live,
+                       id = id,
+                       info = info,
+                       registerAllocation = registerAllocation}
+          in
+            {assembly = assembly,
+             registerAllocation = registerAllocation}
+          end
 
       val (allocateRegisters, allocateRegisters_msg)
-	= tracer
-	  "Directive.allocateRegisters"
-	  allocateRegisters
+        = tracer
+          "Directive.allocateRegisters"
+          allocateRegisters
     end
 
   structure Assembly =
@@ -10687,243 +10670,207 @@
       open Assembly
 
       fun allocateRegisters {assembly: (t * Liveness.t) list,
-			     registerAllocation: RegisterAllocation.t}
- 	= let
-	    val {assembly, registerAllocation}
-	      = List.fold
-	        (assembly,
-		 {assembly = AppendList.empty,
-		  registerAllocation = registerAllocation},
-		 fn ((Comment s,_), {assembly, registerAllocation})
-		  => {assembly = AppendList.snoc
-		                 (assembly,
-				  Comment s),
-		      registerAllocation = registerAllocation}
-		   | ((Directive d,info), {assembly, registerAllocation})
-		   => let
-			val {assembly = assembly',
-			     registerAllocation}
-			  = Directive.allocateRegisters 
-			    {directive = d,
-			     info = info,
-			     registerAllocation = registerAllocation}
-			    handle Fail msg
-			    => (print (toString (Directive d));
-				print "\n";
-				print (RegisterAllocation.toString 
-				       registerAllocation);
-				print "\n";
-				Error.bug msg)
-			    | RegisterAllocation.Spill
-			    => (print (toString (Directive d));
-				print "\n";
-				print (RegisterAllocation.toString 
-				       registerAllocation);
-				print "\n";
-				Error.bug "Spill")
+                             registerAllocation: RegisterAllocation.t}
+        = let
+            val {assembly, registerAllocation}
+              = List.fold
+                (assembly,
+                 {assembly = AppendList.empty,
+                  registerAllocation = registerAllocation},
+                 fn ((Comment s,_), {assembly, registerAllocation})
+                  => {assembly = AppendList.snoc
+                                 (assembly,
+                                  Comment s),
+                      registerAllocation = registerAllocation}
+                   | ((Directive d,info), {assembly, registerAllocation})
+                   => let
+                        val {assembly = assembly',
+                             registerAllocation}
+                          = Directive.allocateRegisters 
+                            {directive = d,
+                             info = info,
+                             registerAllocation = registerAllocation}
 
-			val assembly''
-			  = AppendList.appends
-			    [if !Control.Native.commented > 1
-			       then AppendList.fromList
-				    [Assembly.comment
-				     (String.make (60, #"*")),
-				     (Assembly.comment
-				      (Directive.toString d))]
-			       else AppendList.empty,
-			     if !Control.Native.commented > 4
-			       then AppendList.fromList
-				    (Liveness.toComments info)
-			       else AppendList.empty,
-			     assembly',
-			     if !Control.Native.commented > 5
-			       then (RegisterAllocation.toComments 
-				     registerAllocation)
-			       else AppendList.empty]
-		      in
-			{assembly = AppendList.append 
-			            (assembly, 
-				     assembly''),
-			 registerAllocation = registerAllocation}
-		      end
-		   | ((PseudoOp p,_), {assembly, registerAllocation})
-		   => {assembly = AppendList.snoc
-		                  (assembly,
-				   PseudoOp p),
-		       registerAllocation = registerAllocation}
-		   | ((Label l,_), {assembly, registerAllocation})
-		   => {assembly = AppendList.snoc
-		                  (assembly,
-				   Label l),
-		       registerAllocation = registerAllocation}
-		   | ((Instruction i,info), {assembly, registerAllocation})
-		   => let
-			val {assembly = assembly',
-			     registerAllocation}
-			  = Instruction.allocateRegisters 
-			    {instruction = i,
-			     info = info,
-			     registerAllocation = registerAllocation}
-			    handle Fail msg
-			    => (print (toString (Instruction i));
-				print "\n";
-				print (RegisterAllocation.toString 
-				       registerAllocation);
-				print "\n";
-				Error.bug msg)
-			    | RegisterAllocation.Spill
-			    => (print (toString (Instruction i));
-				print "\n";
-				print (RegisterAllocation.toString 
-				       registerAllocation);
-				print "\n";
-				Error.bug "Spill")
+                        val assembly''
+                          = AppendList.appends
+                            [if !Control.Native.commented > 1
+                               then AppendList.fromList
+                                    [Assembly.comment
+                                     (String.make (60, #"*")),
+                                     (Assembly.comment
+                                      (Directive.toString d))]
+                               else AppendList.empty,
+                             if !Control.Native.commented > 4
+                               then AppendList.fromList
+                                    (Liveness.toComments info)
+                               else AppendList.empty,
+                             assembly',
+                             if !Control.Native.commented > 5
+                               then (RegisterAllocation.toComments 
+                                     registerAllocation)
+                               else AppendList.empty]
+                      in
+                        {assembly = AppendList.append 
+                                    (assembly, 
+                                     assembly''),
+                         registerAllocation = registerAllocation}
+                      end
+                   | ((PseudoOp p,_), {assembly, registerAllocation})
+                   => {assembly = AppendList.snoc
+                                  (assembly,
+                                   PseudoOp p),
+                       registerAllocation = registerAllocation}
+                   | ((Label l,_), {assembly, registerAllocation})
+                   => {assembly = AppendList.snoc
+                                  (assembly,
+                                   Label l),
+                       registerAllocation = registerAllocation}
+                   | ((Instruction i,info), {assembly, registerAllocation})
+                   => let
+                        val {assembly = assembly',
+                             registerAllocation}
+                          = Instruction.allocateRegisters 
+                            {instruction = i,
+                             info = info,
+                             registerAllocation = registerAllocation}
 
-			val assembly''
-			  = AppendList.appends
-			    [if !Control.Native.commented > 1
-			       then AppendList.fromList
-				    [Assembly.comment
-				     (String.make (60, #"*")),
-				     (Assembly.comment
-				      (Instruction.toString i))]
-			       else AppendList.empty,
-			     if !Control.Native.commented > 4
-			       then AppendList.fromList
-				    (Liveness.toComments info)
-			       else AppendList.empty,
-			     assembly',
-			     if !Control.Native.commented > 5
-			       then (RegisterAllocation.toComments 
-				     registerAllocation)
-			       else AppendList.empty]
-		      in
-			{assembly = AppendList.append
-			            (assembly,
-				     assembly''),
-			 registerAllocation = registerAllocation}
-		      end)
-		
-	    val assembly = AppendList.toList assembly
-	    val assembly = if !Control.Native.commented > 1
-			     then (Assembly.comment
-				   (String.make (60, #"&"))::
-				   Assembly.comment
-				   (String.make (60, #"&"))::
-				   assembly)
-			     else assembly
-	  in
-	    {assembly = assembly,
-	     registerAllocation = registerAllocation}
-	  end
+                        val assembly''
+                          = AppendList.appends
+                            [if !Control.Native.commented > 1
+                               then AppendList.fromList
+                                    [Assembly.comment
+                                     (String.make (60, #"*")),
+                                     (Assembly.comment
+                                      (Instruction.toString i))]
+                               else AppendList.empty,
+                             if !Control.Native.commented > 4
+                               then AppendList.fromList
+                                    (Liveness.toComments info)
+                               else AppendList.empty,
+                             assembly',
+                             if !Control.Native.commented > 5
+                               then (RegisterAllocation.toComments 
+                                     registerAllocation)
+                               else AppendList.empty]
+                      in
+                        {assembly = AppendList.append
+                                    (assembly,
+                                     assembly''),
+                         registerAllocation = registerAllocation}
+                      end)
+                
+            val assembly = AppendList.toList assembly
+            val assembly = if !Control.Native.commented > 1
+                             then (Assembly.comment
+                                   (String.make (60, #"&"))::
+                                   Assembly.comment
+                                   (String.make (60, #"&"))::
+                                   assembly)
+                             else assembly
+          in
+            {assembly = assembly,
+             registerAllocation = registerAllocation}
+          end
 
       val (allocateRegisters, allocateRegisters_msg)
-	= tracer
-	  "Assembly.allocateRegisters"
-	  allocateRegisters
+        = tracer
+          "Assembly.allocateRegisters"
+          allocateRegisters
     end
 
   fun allocateRegisters {assembly : Assembly.t list list,
-			 liveness : bool} :
+                         liveness : bool} :
                         Assembly.t list list
     = let
-	val {get = getInfo : Label.t -> Label.t option,
-	     set = setInfo, ...}
-	  = Property.getSetOnce
-	    (Label.plist,
-	     Property.initConst NONE)
+        val {get = getInfo : Label.t -> Label.t option,
+             set = setInfo, ...}
+          = Property.getSetOnce
+            (Label.plist,
+             Property.initConst NONE)
 
-	fun unroll label
-	  = case getInfo label
-	      of NONE => label
-	       | SOME label' => unroll label'
+        fun unroll label
+          = case getInfo label
+              of NONE => label
+               | SOME label' => unroll label'
 
-	val assembly
-	  = List.fold
-	    (assembly,
-	     [],
-	     fn (assembly,assembly')
-	      => let
-		   val assembly
-		     = if liveness
-			 then Liveness.toLiveness assembly
-			 else Liveness.toNoLiveness assembly
+        val assembly
+          = List.fold
+            (assembly,
+             [],
+             fn (assembly,assembly')
+              => let
+                   val assembly
+                     = if liveness
+                         then Liveness.toLiveness assembly
+                         else Liveness.toNoLiveness assembly
 
-		   val {assembly, ...}
-		     = Assembly.allocateRegisters
-		       {assembly = assembly,
-			registerAllocation
-			= RegisterAllocation.empty ()}
-		       handle Fail msg
-		       => (List.foreach(assembly,
-					fn (asm,info)
-					 => (print (Assembly.toString asm);
-					     print "\n";
-					     print (Liveness.toString info);
-					     print "\n"));
-			   Error.bug msg)
+                   val {assembly, ...}
+                     = Assembly.allocateRegisters
+                       {assembly = assembly,
+                        registerAllocation
+                        = RegisterAllocation.empty ()}
 
-		   val rec doit 
-		     = fn (Assembly.Comment _)::assembly 
-		        => doit assembly
-			| (Assembly.PseudoOp (PseudoOp.P2align _))::assembly
-		        => doit' (assembly, [])
-		        | _ => false
-		   and doit'
-		     = fn ((Assembly.Comment _)::assembly, labels) 
-		        => doit' (assembly, labels)
-		        | ((Assembly.PseudoOp (PseudoOp.Local _))::assembly, labels)
-		        => doit' (assembly, labels)
-			| ((Assembly.Label l)::assembly, labels)
-		        => doit' (assembly, l::labels)
-		        | (assembly, labels) => doit'' (assembly, labels)
-		   and doit''
-		     = fn ((Assembly.Comment _)::assembly, labels)
-		        => doit'' (assembly, labels)
-			| ((Assembly.Instruction 
-			    (Instruction.JMP 
-			     {target = Operand.Label label, 
-			      absolute = false}))::assembly, labels)
-		        => doit''' (assembly, labels, label)
-		        | _ => false
-		   and doit'''
-		     = fn ([], labels, label)
-		        => let
-			     val label' = unroll label
-			   in
-			     if List.contains(labels, label', Label.equals)
-			       then false
-			       else (List.foreach
-				     (labels,
-				      fn label'' => setInfo(label'', SOME label'));
-				     true)
-			   end
-			| ((Assembly.Comment _)::assembly, labels, label)
-		        => doit''' (assembly, labels, label)
-		        | _ => false
-		 in
-		   if doit assembly
-		     then assembly'
-		     else assembly::assembly'
-		 end)
+                   val rec doit 
+                     = fn (Assembly.Comment _)::assembly 
+                        => doit assembly
+                        | (Assembly.PseudoOp (PseudoOp.P2align _))::assembly
+                        => doit' (assembly, [])
+                        | _ => false
+                   and doit'
+                     = fn ((Assembly.Comment _)::assembly, labels) 
+                        => doit' (assembly, labels)
+                        | ((Assembly.PseudoOp (PseudoOp.Local _))::assembly, labels)
+                        => doit' (assembly, labels)
+                        | ((Assembly.Label l)::assembly, labels)
+                        => doit' (assembly, l::labels)
+                        | (assembly, labels) => doit'' (assembly, labels)
+                   and doit''
+                     = fn ((Assembly.Comment _)::assembly, labels)
+                        => doit'' (assembly, labels)
+                        | ((Assembly.Instruction 
+                            (Instruction.JMP 
+                             {target = Operand.Label label, 
+                              absolute = false}))::assembly, labels)
+                        => doit''' (assembly, labels, label)
+                        | _ => false
+                   and doit'''
+                     = fn ([], labels, label)
+                        => let
+                             val label' = unroll label
+                           in
+                             if List.contains(labels, label', Label.equals)
+                               then false
+                               else (List.foreach
+                                     (labels,
+                                      fn label'' => setInfo(label'', SOME label'));
+                                     true)
+                           end
+                        | ((Assembly.Comment _)::assembly, labels, label)
+                        => doit''' (assembly, labels, label)
+                        | _ => false
+                 in
+                   if doit assembly
+                     then assembly'
+                     else assembly::assembly'
+                 end)
 
-	fun replacer _ oper
-	  = (case (Operand.deImmediate oper, Operand.deLabel oper)
-	       of (SOME immediate, _) 
-		=> (case Immediate.deLabel immediate
-		      of SOME label => Operand.immediate_label (unroll label)
-		       | NONE => oper)
-	        | (_, SOME label) => Operand.label (unroll label)
-		| _ => oper)
+        fun replacer _ oper
+          = (case (Operand.deImmediate oper, Operand.deLabel oper)
+               of (SOME immediate, _) 
+                => (case Immediate.deLabel immediate
+                      of SOME label => Operand.immediate_label (unroll label)
+                       | NONE => oper)
+                | (_, SOME label) => Operand.label (unroll label)
+                | _ => oper)
 
-	val assembly
-	  = List.fold
-	    (assembly,
-	     [],
-	     fn (assembly,assembly')
-	      => (List.map(assembly, Assembly.replace replacer))::assembly')
+        val assembly
+          = List.fold
+            (assembly,
+             [],
+             fn (assembly,assembly')
+              => (List.map(assembly, Assembly.replace replacer))::assembly')
       in
-	assembly
+        assembly
       end
 
   val (allocateRegisters, allocateRegisters_msg)

Modified: mlton/branches/on-20050420-cmm-branch/mlton/codegen/x86-codegen/x86-allocate-registers.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/codegen/x86-codegen/x86-allocate-registers.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/codegen/x86-codegen/x86-allocate-registers.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 type int = Int.t
 
 signature X86_ALLOCATE_REGISTERS_STRUCTS =
@@ -19,7 +20,7 @@
     include X86_ALLOCATE_REGISTERS_STRUCTS
 
     val allocateRegisters : {assembly: x86.Assembly.t list list,
-			     liveness: bool} -> 
+                             liveness: bool} -> 
                             x86.Assembly.t list list
 
     val allocateRegisters_totals : unit -> unit

Modified: mlton/branches/on-20050420-cmm-branch/mlton/codegen/x86-codegen/x86-codegen.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/codegen/x86-codegen/x86-codegen.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/codegen/x86-codegen/x86-codegen.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,24 +1,25 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 functor x86Codegen (S: X86_CODEGEN_STRUCTS): X86_CODEGEN =
 struct
   open S
      
   structure x86 = x86 (open Machine
-		       structure RepType = Type)
+                       structure RepType = Type)
 
   structure x86MLtonBasic
     = x86MLtonBasic (structure x86 = x86
-		     structure Machine = Machine)
+                     structure Machine = Machine)
 
   structure x86Liveness
     = x86Liveness (structure x86 = x86
-		   structure x86MLtonBasic = x86MLtonBasic)
+                   structure x86MLtonBasic = x86MLtonBasic)
 
   structure x86JumpInfo
     = x86JumpInfo (structure x86 = x86)
@@ -31,32 +32,32 @@
 
   structure x86MLton 
     = x86MLton (structure x86MLtonBasic = x86MLtonBasic
-		structure x86Liveness = x86Liveness)
+                structure x86Liveness = x86Liveness)
 
   val implementsPrim = x86MLton.implementsPrim
     
   structure x86Translate 
     = x86Translate (structure x86 = x86
-		    structure x86MLton = x86MLton
-		    structure x86Liveness = x86Liveness)
+                    structure x86MLton = x86MLton
+                    structure x86Liveness = x86Liveness)
 
   structure x86Simplify
     = x86Simplify (structure x86 = x86
-		   structure x86Liveness = x86Liveness
-		   structure x86JumpInfo = x86JumpInfo
-		   structure x86EntryTransfer = x86EntryTransfer)
+                   structure x86Liveness = x86Liveness
+                   structure x86JumpInfo = x86JumpInfo
+                   structure x86EntryTransfer = x86EntryTransfer)
 
   structure x86GenerateTransfers
     = x86GenerateTransfers (structure x86 = x86
-			    structure x86MLton = x86MLton
-			    structure x86Liveness = x86Liveness
-			    structure x86JumpInfo = x86JumpInfo
-			    structure x86LoopInfo = x86LoopInfo
-			    structure x86EntryTransfer = x86EntryTransfer)
+                            structure x86MLton = x86MLton
+                            structure x86Liveness = x86Liveness
+                            structure x86JumpInfo = x86JumpInfo
+                            structure x86LoopInfo = x86LoopInfo
+                            structure x86EntryTransfer = x86EntryTransfer)
 
   structure x86AllocateRegisters
     = x86AllocateRegisters (structure x86 = x86
-			    structure x86MLton = x86MLton)
+                            structure x86MLton = x86MLton)
 
   structure x86Validate
     = x86Validate (structure x86 = x86)
@@ -69,261 +70,227 @@
 
   open x86
   fun output {program as Machine.Program.T {chunks, frameLayouts, handlesSignals,
-					    main, ...},
-	      outputC: unit -> {file: File.t,
-				print: string -> unit,
-				done: unit -> unit},
-	      outputS: unit -> {file: File.t,
-				print: string -> unit,
-				done: unit -> unit}}: unit
+                                            main, ...},
+              outputC: unit -> {file: File.t,
+                                print: string -> unit,
+                                done: unit -> unit},
+              outputS: unit -> {file: File.t,
+                                print: string -> unit,
+                                done: unit -> unit}}: unit
     = let
-	 val reserveEsp =
-	    (* There is no sigaltstack on cygwin, we need to reserve %esp to
-	     * hold the C stack pointer.  We need to do this even in programs
-	     * that don't handle signals, since signals get used under the hood
-	     * in Cygwin.
-	     *)
-	    case !Control.reserveEsp of
-	       NONE =>
-		  handlesSignals
-		  andalso let open Control in !targetOS = Cygwin end
-	     | SOME b => b
+         val reserveEsp =
+            (* There is no sigaltstack on cygwin, we need to reserve %esp to
+             * hold the C stack pointer.  We need to do this even in programs
+             * that don't handle signals, since signals get used under the hood
+             * in Cygwin.
+             *)
+            handlesSignals andalso let open Control in !targetOS = Cygwin end
 
-	val makeC = outputC
-	val makeS = outputS
+        val makeC = outputC
+        val makeS = outputS
 
-	val Machine.Program.T {profileInfo, ...} = program
-	val profileInfo =
-	   case profileInfo of
-	      NONE => Machine.ProfileInfo.empty
-	    | SOME pi => pi
-	val {newProfileLabel, delProfileLabel, getProfileInfo} = 
-	  Machine.ProfileInfo.modify profileInfo
+        val Machine.Program.T {profileInfo, ...} = program
+        val profileInfo =
+           case profileInfo of
+              NONE => Machine.ProfileInfo.empty
+            | SOME pi => pi
+        val {newProfileLabel, delProfileLabel, getProfileInfo} = 
+          Machine.ProfileInfo.modify profileInfo
 
-	(* C specific *)
-	fun outputC ()
-	  = let
-	      local
-		val Machine.Program.T 
-		    {chunks, 
-		     frameLayouts, 
-		     frameOffsets, 
-		     handlesSignals, 
-		     intInfs, 
-		     main, 
-		     maxFrameSize, 
-		     objectTypes, 
-		     reals, 
-		     vectors, ...} =
-		  program
-	      in
-		val program =
-		  Machine.Program.T 
-		  {chunks = chunks, 
-		   frameLayouts = frameLayouts, 
-		   frameOffsets = frameOffsets, 
-		   handlesSignals = handlesSignals, 
-		   intInfs = intInfs,  
-		   main = main, 
-		   maxFrameSize = maxFrameSize, 
-		   objectTypes = objectTypes, 
-		   profileInfo = SOME (getProfileInfo ()),
-		   reals = reals, 
-		   vectors = vectors}
-	      end
-	      val {print, done, ...} = makeC ()
-	      val additionalMainArgs =
-		 let
-		    val mainLabel = Label.toString (#label main)
-		    (* Drop the leading _, because gcc will add it. *)
-		    val mainLabel =
-		       if !Control.labelsHaveExtra_
-			  then String.dropPrefix (mainLabel, 1)
-		       else mainLabel
-		 in
-		    [mainLabel, if reserveEsp then C.truee else C.falsee]
-		 end
-	      fun declareLocals () =
-		 List.foreach
-		 (CType.all,
-		  fn t =>
-		  let
-		     val m =
-			List.fold
-			(chunks, ~1, fn (Machine.Chunk.T {regMax, ...}, max) =>
-			 Int.max (max, regMax t))
-		     val m = m + 1
-		  in
-		     print (concat [CType.toString t, 
-				    " local", CType.toString t,
-				    "[", Int.toString m, "];\n"])
-		  end)
-	      fun rest () =
-		 declareLocals ()
-	    in
-	      CCodegen.outputDeclarations
-	      {additionalMainArgs = additionalMainArgs,
-	       includes = ["x86-main.h"],
-	       print = print,
-	       program = program,
-	       rest = rest}
-	      ; done ()
-	    end 
+        (* C specific *)
+        fun outputC ()
+          = let
+              local
+                val Machine.Program.T 
+                    {chunks, 
+                     frameLayouts, 
+                     frameOffsets, 
+                     handlesSignals, 
+                     intInfs, 
+                     main, 
+                     maxFrameSize, 
+                     objectTypes, 
+                     reals, 
+                     vectors, ...} =
+                  program
+              in
+                val program =
+                  Machine.Program.T 
+                  {chunks = chunks, 
+                   frameLayouts = frameLayouts, 
+                   frameOffsets = frameOffsets, 
+                   handlesSignals = handlesSignals, 
+                   intInfs = intInfs,  
+                   main = main, 
+                   maxFrameSize = maxFrameSize, 
+                   objectTypes = objectTypes, 
+                   profileInfo = SOME (getProfileInfo ()),
+                   reals = reals, 
+                   vectors = vectors}
+              end
+              val {print, done, ...} = makeC ()
+              val additionalMainArgs =
+                 let
+                    val mainLabel = Label.toString (#label main)
+                    (* Drop the leading _, because gcc will add it. *)
+                    val mainLabel =
+                       if !Control.labelsHaveExtra_
+                          then String.dropPrefix (mainLabel, 1)
+                       else mainLabel
+                 in
+                    [mainLabel, if reserveEsp then C.truee else C.falsee]
+                 end
+              fun declareLocals () =
+                 List.foreach
+                 (CType.all,
+                  fn t =>
+                  let
+                     val m =
+                        List.fold
+                        (chunks, ~1, fn (Machine.Chunk.T {regMax, ...}, max) =>
+                         Int.max (max, regMax t))
+                     val m = m + 1
+                  in
+                     print (concat [CType.toString t, 
+                                    " local", CType.toString t,
+                                    "[", Int.toString m, "];\n"])
+                  end)
+              fun rest () =
+                 declareLocals ()
+            in
+              CCodegen.outputDeclarations
+              {additionalMainArgs = additionalMainArgs,
+               includes = ["x86-main.h"],
+               print = print,
+               program = program,
+               rest = rest}
+              ; done ()
+            end 
 
         val outputC = Control.trace (Control.Pass, "outputC") outputC
 
-	(* Assembly specific *)
+        (* Assembly specific *)
 
-	val _ = x86MLtonBasic.init ()
+        val _ = x86MLtonBasic.init ()
 
-	fun file_begin file
-	  = [x86.Assembly.pseudoop_data (),
-	     x86.Assembly.pseudoop_p2align 
-	     (x86.Immediate.const_int 2, NONE, NONE),
-	     x86.Assembly.label x86MLton.fileNameLabel,
-	     x86.Assembly.pseudoop_string [file]]
+        fun file_begin file
+          = [x86.Assembly.pseudoop_data (),
+             x86.Assembly.pseudoop_p2align 
+             (x86.Immediate.const_int 2, NONE, NONE),
+             x86.Assembly.label x86MLton.fileNameLabel,
+             x86.Assembly.pseudoop_string [file]]
 
-	val liveInfo = x86Liveness.LiveInfo.newLiveInfo ()
-	val jumpInfo = x86JumpInfo.newJumpInfo ()
+        val liveInfo = x86Liveness.LiveInfo.newLiveInfo ()
+        val jumpInfo = x86JumpInfo.newJumpInfo ()
 
-	fun frameInfoToX86 (Machine.FrameInfo.T {frameLayoutsIndex, ...}) =
-	   x86.FrameInfo.T
-	   {frameLayoutsIndex = frameLayoutsIndex,
-	    size = Bytes.toInt (#size (Vector.sub (frameLayouts,
-						   frameLayoutsIndex)))}
-	   
-	fun outputChunk (chunk as Machine.Chunk.T {blocks, chunkLabel, ...},
-			 print)
-	  = let
-	      val isMain 
-		= Machine.ChunkLabel.equals(#chunkLabel main, chunkLabel)
+        fun frameInfoToX86 (Machine.FrameInfo.T {frameLayoutsIndex, ...}) =
+           x86.FrameInfo.T
+           {frameLayoutsIndex = frameLayoutsIndex,
+            size = Bytes.toInt (#size (Vector.sub (frameLayouts,
+                                                   frameLayoutsIndex)))}
+           
+        fun outputChunk (chunk as Machine.Chunk.T {blocks, chunkLabel, ...},
+                         print)
+          = let
+              val isMain 
+                = Machine.ChunkLabel.equals(#chunkLabel main, chunkLabel)
 
-	      val {chunk}
-		= x86Translate.translateChunk 
-		  {chunk = chunk,
-		   frameInfoToX86 = frameInfoToX86,
-		   liveInfo = liveInfo}
-		  handle exn
-		   => Error.bug ("x86Translate.translateChunk::" ^ 
-				 (case exn
-				    of Fail s => s
-				     | _ => "?"))
-		  
-	      val chunk : x86.Chunk.t
-		= x86Simplify.simplify 
-		  {chunk = chunk,
-		   (* don't perform optimizations on
-		    * the main function (initGlobals)
-		    *)
-		   optimize = if isMain
-				then 0
-				else !Control.Native.optimize,
-		   delProfileLabel = delProfileLabel,
-		   liveInfo = liveInfo,
-		   jumpInfo = jumpInfo}
-		  handle exn
-		   => Error.bug ("x86Simplify.simplify::" ^
-				 (case exn
-				    of Fail s => s
-				     | _ => "?"))
+              val {chunk}
+                = x86Translate.translateChunk 
+                  {chunk = chunk,
+                   frameInfoToX86 = frameInfoToX86,
+                   liveInfo = liveInfo}
+                  
+              val chunk : x86.Chunk.t
+                = x86Simplify.simplify 
+                  {chunk = chunk,
+                   (* don't perform optimizations on
+                    * the main function (initGlobals)
+                    *)
+                   optimize = if isMain
+                                then 0
+                                else !Control.Native.optimize,
+                   delProfileLabel = delProfileLabel,
+                   liveInfo = liveInfo,
+                   jumpInfo = jumpInfo}
 
-	      val unallocated_assembly : x86.Assembly.t list list
-		= (x86GenerateTransfers.generateTransfers
-		   {chunk = chunk,
-		    optimize = !Control.Native.optimize,
-		    newProfileLabel = newProfileLabel,
-		    liveInfo = liveInfo,
-		    jumpInfo = jumpInfo,
-		    reserveEsp = reserveEsp})
-		  handle exn
-		   => (Error.bug ("x86GenerateTransfers.generateTransfers::" ^
-				  Layout.toString (Exn.layout exn)))
+              val unallocated_assembly : x86.Assembly.t list list
+                = (x86GenerateTransfers.generateTransfers
+                   {chunk = chunk,
+                    optimize = !Control.Native.optimize,
+                    newProfileLabel = newProfileLabel,
+                    liveInfo = liveInfo,
+                    jumpInfo = jumpInfo,
+                    reserveEsp = reserveEsp})
 
-	      val allocated_assembly : Assembly.t list list
-		= x86AllocateRegisters.allocateRegisters 
-		  {assembly = unallocated_assembly,
-		   (* don't calculate liveness info
-		    * on the main function (initGlobals)
-		    *)
-		   liveness = not isMain}
-		  handle exn
-		   => Error.bug ("x86AllocateRegister.allocateRegisters::" ^
-				 (case exn
-				    of Fail s => s
-				     | _ => "?"))
+              val allocated_assembly : Assembly.t list list
+                = x86AllocateRegisters.allocateRegisters 
+                  {assembly = unallocated_assembly,
+                   (* don't calculate liveness info
+                    * on the main function (initGlobals)
+                    *)
+                   liveness = not isMain}
 
-	      val _ =
-(*
-		 Assert.assert
-		 ("x86CodeGen.output: invalid",
-		  fn () => 
-*)
-		  (ignore (x86Validate.validate 
-			   {assembly = allocated_assembly}))
-		  handle exn => 
-		     Error.warning ("x86Validate.validate::" ^ 
-				    (case exn of 
-					Fail s => s
-				      | _ => "?"))
-(*
-		 )
-*)
+              val _ =
+                 Assert.assert
+                 ("x86CodeGen.outputChunk", fn () => 
+                  x86Validate.validate {assembly = allocated_assembly})
 
-	      val validated_assembly = allocated_assembly
+              val validated_assembly = allocated_assembly
 
-	      val _ = Vector.foreach (blocks, Label.clear o Machine.Block.label)
-	      val _ = x86.Immediate.clearAll ()
-	      val _ = x86.MemLoc.clearAll ()
-	    in
-	      List.fold
-	      (validated_assembly,
-	       0,
-	       fn (block, n)
-	        => List.fold
-	           (block,
-		    n,
-		    fn (asm, n)
-		     => (Layout.print (Assembly.layout asm, print);
-			 print "\n";
-			 n + 1)))
-	    end
-	  
-	fun outputAssembly ()
-	  = let
-	      val split = !Control.Native.split
-	      fun loop chunks
-		= let
-		    val {file, print, done} = makeS()
-		    val _ = List.foreach
-		            (file_begin file,
-			     fn asm => (Layout.print(Assembly.layout asm, print);
-					print "\n"))
-		    fun loop' (chunks, size) 
-		      = case chunks
-			  of [] => done ()
-			   | chunk::chunks
-			   => if (case split
-				    of NONE => false
-				     | SOME maxSize => size > maxSize)
-				then (done (); loop (chunk::chunks))
-				else loop'(chunks, 
-					   size + outputChunk (chunk, print))
-		  in 
-		    loop' (chunks, 0)
-		  end
-	    in 
-	      loop chunks
-	      ; x86Translate.translateChunk_totals ()
+              val _ = Vector.foreach (blocks, Label.clear o Machine.Block.label)
+              val _ = x86.Immediate.clearAll ()
+              val _ = x86.MemLoc.clearAll ()
+            in
+              List.fold
+              (validated_assembly,
+               0,
+               fn (block, n)
+                => List.fold
+                   (block,
+                    n,
+                    fn (asm, n)
+                     => (Layout.print (Assembly.layout asm, print);
+                         print "\n";
+                         n + 1)))
+            end
+          
+        fun outputAssembly ()
+          = let
+              val split = !Control.Native.split
+              fun loop chunks
+                = let
+                    val {file, print, done} = makeS()
+                    val _ = List.foreach
+                            (file_begin file,
+                             fn asm => (Layout.print(Assembly.layout asm, print);
+                                        print "\n"))
+                    fun loop' (chunks, size) 
+                      = case chunks
+                          of [] => done ()
+                           | chunk::chunks
+                           => if (case split
+                                    of NONE => false
+                                     | SOME maxSize => size > maxSize)
+                                then (done (); loop (chunk::chunks))
+                                else loop'(chunks, 
+                                           size + outputChunk (chunk, print))
+                  in 
+                    loop' (chunks, 0)
+                  end
+            in 
+              loop chunks
+              ; x86Translate.translateChunk_totals ()
               ; x86Simplify.simplify_totals ()
               ; x86GenerateTransfers.generateTransfers_totals ()
-	      ; x86AllocateRegisters.allocateRegisters_totals ()
-	      ; x86Validate.validate_totals ()
-	    end
+              ; x86AllocateRegisters.allocateRegisters_totals ()
+              ; x86Validate.validate_totals ()
+            end
 
-	val outputAssembly =
-	   Control.trace (Control.Pass, "outputAssembly") outputAssembly
+        val outputAssembly =
+           Control.trace (Control.Pass, "outputAssembly") outputAssembly
       in
-	outputAssembly()
-	; outputC()
+        outputAssembly()
+        ; outputC()
       end 
 end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/codegen/x86-codegen/x86-codegen.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/codegen/x86-codegen/x86-codegen.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/codegen/x86-codegen/x86-codegen.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature X86_CODEGEN_STRUCTS =
    sig
       structure CCodegen: C_CODEGEN
@@ -18,11 +19,11 @@
 
       val implementsPrim: Machine.Type.t Machine.Prim.t -> bool
       val output: {program: Machine.Program.t,
-		   outputC: unit -> {file: File.t,
-				     print: string -> unit,
-				     done: unit -> unit},
-		   outputS: unit -> {file: File.t,
-				     print: string -> unit,
-				     done: unit -> unit}} -> unit
+                   outputC: unit -> {file: File.t,
+                                     print: string -> unit,
+                                     done: unit -> unit},
+                   outputS: unit -> {file: File.t,
+                                     print: string -> unit,
+                                     done: unit -> unit}} -> unit
    end
 

Modified: mlton/branches/on-20050420-cmm-branch/mlton/codegen/x86-codegen/x86-entry-transfer.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/codegen/x86-codegen/x86-entry-transfer.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/codegen/x86-codegen/x86-entry-transfer.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 functor x86EntryTransfer(S: X86_ENTRY_TRANSFER_STRUCTS) : X86_ENTRY_TRANSFER =
 struct
   open S
@@ -14,64 +15,64 @@
 
   fun verifyEntryTransfer {chunk = Chunk.T {blocks, ...}}
     = let
-	val {get : Label.t -> Block.t option, 
-	     set, destroy}
-	  = Property.destGetSetOnce(Label.plist,
-				    Property.initConst NONE)
+        val {get : Label.t -> Block.t option, 
+             set, destroy}
+          = Property.destGetSetOnce(Label.plist,
+                                    Property.initConst NONE)
 
-	val _
-	  = List.foreach
-	    (blocks,
-	     fn block as Block.T {entry,...}
-	      => set(Entry.label entry, SOME block))
+        val _
+          = List.foreach
+            (blocks,
+             fn block as Block.T {entry,...}
+              => set(Entry.label entry, SOME block))
 
-	fun isJump l = case get l
-			 of SOME (Block.T {entry = Entry.Jump _, ...}) => true
-			  | _ => false
-	fun isFunc l = case get l
-			 of SOME (Block.T {entry = Entry.Func _, ...}) => true
-			  | NONE => true
-			  | _ => false
-	fun isCont l = case get l
-			 of SOME (Block.T {entry = Entry.Cont _, ...}) => true
-			  | _ => false
-	fun isHandler l = case get l
-			    of SOME (Block.T {entry = Entry.Handler _, ...}) => true
-			     | _ => false
-	fun isCReturn l f = case get l
-			      of SOME (Block.T {entry = Entry.CReturn {func, ...}, ...})
-			       => CFunction.equals (f, func)
-			       | _ => false
-	val b = List.forall
-	        (blocks,
-		 fn Block.T {transfer, ...}
-		  => (case transfer
-			of Transfer.Goto {target, ...}
-			 => isJump target
-			 | Transfer.Iff {truee, falsee, ...}
-			 => isJump truee andalso isJump falsee
-			 | Transfer.Switch {cases, default, ...}
-			 => isJump default andalso
-			    Transfer.Cases.forall(cases, isJump)
-			 | Transfer.Tail {target, ...}
-			 => isFunc target
-			 | Transfer.NonTail {target, return, handler, ...}
-			 => isFunc target andalso
-			    isCont return andalso
-			    (case handler
-			       of SOME handler => isHandler handler
-				| NONE => true)
-		         | Transfer.Return {...} => true
-			 | Transfer.Raise {...} => true
-			 | Transfer.CCall {return, func, ...} 
-			 => (case return
-			       of NONE => true
-				| SOME l => isCReturn l func)))
-	val _ = destroy ()
-	val _ = if b then ()
-		  else List.foreach(blocks, Block.printBlock)
+        fun isJump l = case get l
+                         of SOME (Block.T {entry = Entry.Jump _, ...}) => true
+                          | _ => false
+        fun isFunc l = case get l
+                         of SOME (Block.T {entry = Entry.Func _, ...}) => true
+                          | NONE => true
+                          | _ => false
+        fun isCont l = case get l
+                         of SOME (Block.T {entry = Entry.Cont _, ...}) => true
+                          | _ => false
+        fun isHandler l = case get l
+                            of SOME (Block.T {entry = Entry.Handler _, ...}) => true
+                             | _ => false
+        fun isCReturn l f = case get l
+                              of SOME (Block.T {entry = Entry.CReturn {func, ...}, ...})
+                               => CFunction.equals (f, func)
+                               | _ => false
+        val b = List.forall
+                (blocks,
+                 fn Block.T {transfer, ...}
+                  => (case transfer
+                        of Transfer.Goto {target, ...}
+                         => isJump target
+                         | Transfer.Iff {truee, falsee, ...}
+                         => isJump truee andalso isJump falsee
+                         | Transfer.Switch {cases, default, ...}
+                         => isJump default andalso
+                            Transfer.Cases.forall(cases, isJump o #2)
+                         | Transfer.Tail {target, ...}
+                         => isFunc target
+                         | Transfer.NonTail {target, return, handler, ...}
+                         => isFunc target andalso
+                            isCont return andalso
+                            (case handler
+                               of SOME handler => isHandler handler
+                                | NONE => true)
+                         | Transfer.Return {...} => true
+                         | Transfer.Raise {...} => true
+                         | Transfer.CCall {return, func, ...} 
+                         => (case return
+                               of NONE => true
+                                | SOME l => isCReturn l func)))
+        val _ = destroy ()
+        val _ = if b then ()
+                  else List.foreach(blocks, Block.printBlock)
       in
-	b
+        b
       end
 
   val (verifyEntryTransfer, verifyEntryTransfer_msg)

Modified: mlton/branches/on-20050420-cmm-branch/mlton/codegen/x86-codegen/x86-entry-transfer.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/codegen/x86-codegen/x86-entry-transfer.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/codegen/x86-codegen/x86-entry-transfer.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature X86_ENTRY_TRANSFER_STRUCTS =
   sig
     structure x86 : X86

Modified: mlton/branches/on-20050420-cmm-branch/mlton/codegen/x86-codegen/x86-generate-transfers.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/codegen/x86-codegen/x86-generate-transfers.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/codegen/x86-codegen/x86-generate-transfers.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,9 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 functor x86GenerateTransfers(S: X86_GENERATE_TRANSFERS_STRUCTS): X86_GENERATE_TRANSFERS =
@@ -31,10 +31,10 @@
 
   structure x86LiveTransfers 
     = x86LiveTransfers(structure x86 = x86
-		       structure x86MLton = x86MLton
-		       structure x86Liveness = x86Liveness
-		       structure x86JumpInfo = x86JumpInfo
-		       structure x86LoopInfo = x86LoopInfo)
+                       structure x86MLton = x86MLton
+                       structure x86Liveness = x86Liveness
+                       structure x86JumpInfo = x86JumpInfo
+                       structure x86LoopInfo = x86LoopInfo)
 
   val pointerSize = x86MLton.pointerSize
   val wordSize = x86MLton.wordSize
@@ -42,66 +42,66 @@
   val normalRegs =
     let
       val transferRegs
-	=
-	  (*
-	  Register.eax::
-	  Register.al::
-	  *)
-	  Register.ebx::
-	  Register.bl::
-	  Register.ecx::
-	  Register.cl::
-	  Register.edx:: 
-	  Register.dl::
-	  Register.edi::
-	  Register.esi::
-	  (*
-	  Register.esp::
-	  Register.ebp::
-	  *)
-	  nil
+        =
+          (*
+          Register.eax::
+          Register.al::
+          *)
+          Register.ebx::
+          Register.bl::
+          Register.ecx::
+          Register.cl::
+          Register.edx:: 
+          Register.dl::
+          Register.edi::
+          Register.esi::
+          (*
+          Register.esp::
+          Register.ebp::
+          *)
+          nil
      in
-	{frontierReg = Register.esp,
-	 stackTopReg = Register.ebp,
-	 transferRegs = fn Entry.Jump _ => transferRegs
-	                 | Entry.CReturn _ => Register.eax::Register.al::transferRegs
-			 | _ => []}
+        {frontierReg = Register.esp,
+         stackTopReg = Register.ebp,
+         transferRegs = fn Entry.Jump _ => transferRegs
+                         | Entry.CReturn _ => Register.eax::Register.al::transferRegs
+                         | _ => []}
      end
 
   val reserveEspRegs =
     let
       val transferRegs
-	=
-	  (*
-	  Register.eax::
-	  Register.al::
-	  *)
-	  Register.ebx::
-	  Register.bl::
-	  Register.ecx::
-	  Register.cl::
-	  Register.edx:: 
-	  Register.dl::
-	  (*
-	  Register.edi::
+        =
+          (*
+          Register.eax::
+          Register.al::
           *)
-	  Register.esi::
+          Register.ebx::
+          Register.bl::
+          Register.ecx::
+          Register.cl::
+          Register.edx:: 
+          Register.dl::
           (*
-	  Register.esp::
-	  Register.ebp::
-	  *)
-	  nil
+          Register.edi::
+          *)
+          Register.esi::
+          (*
+          Register.esp::
+          Register.ebp::
+          *)
+          nil
      in
-	{frontierReg = Register.edi,
-	 stackTopReg = Register.ebp,
-	 transferRegs = fn Entry.Jump _ => transferRegs
-	                 | Entry.CReturn _ => Register.eax::Register.al::transferRegs
-			 | _ => []}
+        {frontierReg = Register.edi,
+         stackTopReg = Register.ebp,
+         transferRegs = fn Entry.Jump _ => transferRegs
+                         | Entry.CReturn _ => Register.eax::Register.al::transferRegs
+                         | _ => []}
      end
 
   val transferFltRegs : Entry.t -> Int.t = fn Entry.Jump _ => 6
                                             | Entry.CReturn _ => 6
-					    | _ => 0
+                                            | _ => 0
 
   val indexReg = x86.Register.eax
 
@@ -109,1854 +109,1808 @@
   val frontier = x86MLton.gcState_frontierContents
 
   datatype gef = GEF of {generate : gef -> 
-			            {label : Label.t,
-				     falling : bool,
-				     unique : bool} -> 
-				    Assembly.t AppendList.t,
-			 effect : gef -> 
-			          {label : Label.t,
-				   transfer : Transfer.t} ->
-				  Assembly.t AppendList.t,
-			 fall : gef ->
-			        {label : Label.t,
-				 live : LiveSet.t} ->
-				Assembly.t AppendList.t}
+                                    {label : Label.t,
+                                     falling : bool,
+                                     unique : bool} -> 
+                                    Assembly.t AppendList.t,
+                         effect : gef -> 
+                                  {label : Label.t,
+                                   transfer : Transfer.t} ->
+                                  Assembly.t AppendList.t,
+                         fall : gef ->
+                                {label : Label.t,
+                                 live : LiveSet.t} ->
+                                Assembly.t AppendList.t}
 
   fun generateTransfers {chunk as Chunk.T {data, blocks, ...},
-			 optimize: int,
-			 newProfileLabel: x86.ProfileLabel.t -> x86.ProfileLabel.t,
-			 liveInfo : x86Liveness.LiveInfo.t,
-			 jumpInfo : x86JumpInfo.t,
-			 reserveEsp: bool}
+                         optimize: int,
+                         newProfileLabel: x86.ProfileLabel.t -> x86.ProfileLabel.t,
+                         liveInfo : x86Liveness.LiveInfo.t,
+                         jumpInfo : x86JumpInfo.t,
+                         reserveEsp: bool}
     = let
-	 val {frontierReg, stackTopReg, transferRegs} =
-	    if reserveEsp
-	       then reserveEspRegs
-	    else normalRegs
-	val allClasses = !x86MLton.Classes.allClasses
-	val livenessClasses = !x86MLton.Classes.livenessClasses
-	val livenessClasses = ClassSet.add(livenessClasses, 
-					   x86MLton.Classes.StaticNonTemp)
-	val nonlivenessClasses = ClassSet.-(allClasses, livenessClasses)
-	val holdClasses = !x86MLton.Classes.holdClasses
-	val farflushClasses = ClassSet.-(nonlivenessClasses, holdClasses)
-	val nearflushClasses = ClassSet.-(nonlivenessClasses, holdClasses)
-	val runtimeClasses = !x86MLton.Classes.runtimeClasses
-	val cstaticClasses = !x86MLton.Classes.cstaticClasses
-	val heapClasses = !x86MLton.Classes.heapClasses
-	val ccallflushClasses = ClassSet.+(cstaticClasses, heapClasses)
-	  
-	fun removeHoldMemLocs memlocs
-	  = MemLocSet.subset
-	    (memlocs, 
-	     fn m => not (ClassSet.contains(holdClasses, MemLoc.class m)))
+         val {frontierReg, stackTopReg, transferRegs} =
+            if reserveEsp
+               then reserveEspRegs
+            else normalRegs
+        val allClasses = !x86MLton.Classes.allClasses
+        val livenessClasses = !x86MLton.Classes.livenessClasses
+        val livenessClasses = ClassSet.add(livenessClasses, 
+                                           x86MLton.Classes.StaticNonTemp)
+        val nonlivenessClasses = ClassSet.-(allClasses, livenessClasses)
+        val holdClasses = !x86MLton.Classes.holdClasses
+        val farflushClasses = ClassSet.-(nonlivenessClasses, holdClasses)
+        val nearflushClasses = ClassSet.-(nonlivenessClasses, holdClasses)
+        val runtimeClasses = !x86MLton.Classes.runtimeClasses
+        val cstaticClasses = !x86MLton.Classes.cstaticClasses
+        val heapClasses = !x86MLton.Classes.heapClasses
+        val ccallflushClasses = ClassSet.+(cstaticClasses, heapClasses)
+          
+        fun removeHoldMemLocs memlocs
+          = MemLocSet.subset
+            (memlocs, 
+             fn m => not (ClassSet.contains(holdClasses, MemLoc.class m)))
 
-	val stackAssume = {register = stackTopReg,
-			   memloc = stackTop (),
-			   weight = 1024,
-			   sync = false,
-			   reserve = false}
-	val frontierAssume = {register = frontierReg,
-			      memloc = frontier (),
-			      weight = 2048,
-			      sync = false,
-			      reserve = false}
-	val cStackAssume = {register = Register.esp,
-			    memloc = x86MLton.c_stackPContents,
-			    weight = 2048, (* ??? *)
-			    sync = false,
-			    reserve = true}
+        val stackAssume = {register = stackTopReg,
+                           memloc = stackTop (),
+                           weight = 1024,
+                           sync = false,
+                           reserve = false}
+        val frontierAssume = {register = frontierReg,
+                              memloc = frontier (),
+                              weight = 2048,
+                              sync = false,
+                              reserve = false}
+        val cStackAssume = {register = Register.esp,
+                            memloc = x86MLton.c_stackPContents,
+                            weight = 2048, (* ??? *)
+                            sync = false,
+                            reserve = true}
 
-	fun blockAssumes l =
-	   let
-	      val l = frontierAssume :: stackAssume :: l
-	   in
-	      Assembly.directive_assume {assumes = if reserveEsp
-						      then cStackAssume :: l
-						   else l}
-	   end
-	   
-	fun runtimeTransfer live setup trans
-	  = AppendList.appends
-	    [AppendList.single
-	     (Assembly.directive_force
-	      {commit_memlocs = removeHoldMemLocs live,
-	       commit_classes = ClassSet.empty,
-	       remove_memlocs = MemLocSet.empty,
-	       remove_classes = ClassSet.empty,
-	       dead_memlocs = MemLocSet.empty,
-	       dead_classes = ClassSet.empty}),
-	     setup,
-	     AppendList.fromList
-	     [(Assembly.directive_clearflt ()),
-	      (Assembly.directive_force
-	       {commit_memlocs = MemLocSet.empty,
-		commit_classes = farflushClasses,
-		remove_memlocs = MemLocSet.empty,
-		remove_classes = ClassSet.empty,
-		dead_memlocs = MemLocSet.empty,
-		dead_classes = ClassSet.empty})],
-	     trans]
+        fun blockAssumes l =
+           let
+              val l = frontierAssume :: stackAssume :: l
+           in
+              Assembly.directive_assume {assumes = if reserveEsp
+                                                      then cStackAssume :: l
+                                                   else l}
+           end
+           
+        fun runtimeTransfer live setup trans
+          = AppendList.appends
+            [AppendList.single
+             (Assembly.directive_force
+              {commit_memlocs = removeHoldMemLocs live,
+               commit_classes = ClassSet.empty,
+               remove_memlocs = MemLocSet.empty,
+               remove_classes = ClassSet.empty,
+               dead_memlocs = MemLocSet.empty,
+               dead_classes = ClassSet.empty}),
+             setup,
+             AppendList.fromList
+             [(Assembly.directive_clearflt ()),
+              (Assembly.directive_force
+               {commit_memlocs = MemLocSet.empty,
+                commit_classes = farflushClasses,
+                remove_memlocs = MemLocSet.empty,
+                remove_classes = ClassSet.empty,
+                dead_memlocs = MemLocSet.empty,
+                dead_classes = ClassSet.empty})],
+             trans]
 
-	fun farEntry l = AppendList.cons (blockAssumes [], l)
+        fun farEntry l = AppendList.cons (blockAssumes [], l)
 
-	fun farTransfer live setup trans
-	  = AppendList.appends
-	    [AppendList.single
-	     (Assembly.directive_force
-	      {commit_memlocs = removeHoldMemLocs live,
-	       commit_classes = ClassSet.empty,
-	       remove_memlocs = MemLocSet.empty,
-	       remove_classes = ClassSet.empty,
-	       dead_memlocs = MemLocSet.empty,
-	       dead_classes = ClassSet.empty}),
-	     setup,
-	     AppendList.fromList
-	     [(Assembly.directive_cache
-	       {caches = [{register = stackTopReg,
-			   memloc = stackTop (),
-			   reserve = true},
-			  {register = frontierReg,
-			   memloc = frontier (),
-			   reserve = true}]}),
-	      (Assembly.directive_clearflt ()),
-	      (Assembly.directive_force
-	       {commit_memlocs = MemLocSet.empty,
-		commit_classes = farflushClasses,
-		remove_memlocs = MemLocSet.empty,
-		remove_classes = ClassSet.empty,
-		dead_memlocs = MemLocSet.empty,
-		dead_classes = ClassSet.empty})],
-	     trans]
+        fun farTransfer live setup trans
+          = AppendList.appends
+            [AppendList.single
+             (Assembly.directive_force
+              {commit_memlocs = removeHoldMemLocs live,
+               commit_classes = ClassSet.empty,
+               remove_memlocs = MemLocSet.empty,
+               remove_classes = ClassSet.empty,
+               dead_memlocs = MemLocSet.empty,
+               dead_classes = ClassSet.empty}),
+             setup,
+             AppendList.fromList
+             [(Assembly.directive_cache
+               {caches = [{register = stackTopReg,
+                           memloc = stackTop (),
+                           reserve = true},
+                          {register = frontierReg,
+                           memloc = frontier (),
+                           reserve = true}]}),
+              (Assembly.directive_clearflt ()),
+              (Assembly.directive_force
+               {commit_memlocs = MemLocSet.empty,
+                commit_classes = farflushClasses,
+                remove_memlocs = MemLocSet.empty,
+                remove_classes = ClassSet.empty,
+                dead_memlocs = MemLocSet.empty,
+                dead_classes = ClassSet.empty})],
+             trans]
 
-	val profileStackTopCommit' = 
-	  x86.Assembly.directive_force
-	  {commit_memlocs = MemLocSet.singleton (stackTop ()),
-	   commit_classes = ClassSet.empty,
-	   remove_memlocs = MemLocSet.empty,
-	   remove_classes = ClassSet.empty,
-	   dead_memlocs = MemLocSet.empty,
-	   dead_classes = ClassSet.empty}
-	val profileStackTopCommit =
-	  if !Control.profile <> Control.ProfileNone
-	    then AppendList.single profileStackTopCommit'
-	    else AppendList.empty
-	    
-	val _
-	  = Assert.assert
-	    ("verifyLiveInfo",
-	     fn () => x86Liveness.LiveInfo.verifyLiveInfo {chunk = chunk,
-							   liveInfo = liveInfo})
-	val _
-	  = Assert.assert
-	    ("verifyJumpInfo", 
-	     fn () => x86JumpInfo.verifyJumpInfo {chunk = chunk,
-						  jumpInfo = jumpInfo})
+        val profileStackTopCommit' = 
+          x86.Assembly.directive_force
+          {commit_memlocs = MemLocSet.singleton (stackTop ()),
+           commit_classes = ClassSet.empty,
+           remove_memlocs = MemLocSet.empty,
+           remove_classes = ClassSet.empty,
+           dead_memlocs = MemLocSet.empty,
+           dead_classes = ClassSet.empty}
+        val profileStackTopCommit =
+          if !Control.profile <> Control.ProfileNone
+            then AppendList.single profileStackTopCommit'
+            else AppendList.empty
+            
+        val _
+          = Assert.assert
+            ("x86GenerateTransfers.verifyLiveInfo",
+             fn () => x86Liveness.LiveInfo.verifyLiveInfo {chunk = chunk,
+                                                           liveInfo = liveInfo})
+        val _
+          = Assert.assert
+            ("x86GenerateTransfers.verifyJumpInfo", 
+             fn () => x86JumpInfo.verifyJumpInfo {chunk = chunk,
+                                                  jumpInfo = jumpInfo})
 
-	val _
-	  = Assert.assert
-	    ("verifyEntryTransfer", 
-	     fn () => x86EntryTransfer.verifyEntryTransfer {chunk = chunk})
+        val _
+          = Assert.assert
+            ("x86GenerateTransfers.verifyEntryTransfer", 
+             fn () => x86EntryTransfer.verifyEntryTransfer {chunk = chunk})
 
-	local
-	  val {get: Label.t -> {block:Block.t},
-	       set,
-	       destroy}
-	    = Property.destGetSetOnce
-	      (Label.plist, Property.initRaise ("gotoInfo", Label.layout))
+        local
+          val {get: Label.t -> {block:Block.t},
+               set,
+               destroy}
+            = Property.destGetSetOnce
+              (Label.plist, Property.initRaise ("gotoInfo", Label.layout))
 
-	  val labels
-	    = List.fold
-	      (blocks, [],
-	       fn (block as Block.T {entry, ...}, labels)
-	        => let
-		     val label = Entry.label entry
-		   in
-		     set(label, {block = block}) ;
-		     label::labels
-		   end)
-	      
-	  fun loop labels
-	    = let
-		val (labels, b)
-		  = List.fold
-		    (labels, ([], false),
-		     fn (label, (labels, b))
-		      => case x86JumpInfo.getNear (jumpInfo, label)
-			   of x86JumpInfo.Count 0 
-			    => let
-				 val {block = Block.T {transfer, ...}}
-				   = get label
-			       in
-				 List.foreach 
-				 (Transfer.nearTargets transfer,
-				  fn label 
-				   => x86JumpInfo.decNear (jumpInfo, label));
-				 (labels, true)
-			       end
-			    | _ => (label::labels, b))
-	      in
-		if b
-		  then loop labels
-		  else List.map (labels, #block o get)
-	      end
-	  val blocks = loop labels
-	    
-	  val _ = destroy ()
-	in
-	  val chunk = Chunk.T {data = data, blocks = blocks}
-	end
+          val labels
+            = List.fold
+              (blocks, [],
+               fn (block as Block.T {entry, ...}, labels)
+                => let
+                     val label = Entry.label entry
+                   in
+                     set(label, {block = block}) ;
+                     label::labels
+                   end)
+              
+          fun loop labels
+            = let
+                val (labels, b)
+                  = List.fold
+                    (labels, ([], false),
+                     fn (label, (labels, b))
+                      => case x86JumpInfo.getNear (jumpInfo, label)
+                           of x86JumpInfo.Count 0 
+                            => let
+                                 val {block = Block.T {transfer, ...}}
+                                   = get label
+                               in
+                                 List.foreach 
+                                 (Transfer.nearTargets transfer,
+                                  fn label 
+                                   => x86JumpInfo.decNear (jumpInfo, label));
+                                 (labels, true)
+                               end
+                            | _ => (label::labels, b))
+              in
+                if b
+                  then loop labels
+                  else List.map (labels, #block o get)
+              end
+          val blocks = loop labels
+            
+          val _ = destroy ()
+        in
+          val chunk = Chunk.T {data = data, blocks = blocks}
+        end
 
-	val loopInfo
-	  = x86LoopInfo.createLoopInfo {chunk = chunk, farLoops = false}
-	val isLoopHeader
-	  = fn label => isLoopHeader(loopInfo, label)
-	                handle _ => false
+        val loopInfo
+          = x86LoopInfo.createLoopInfo {chunk = chunk, farLoops = false}
+        val isLoopHeader
+          = fn label => isLoopHeader(loopInfo, label)
+                        handle _ => false
 
-	val liveTransfers
-	  = x86LiveTransfers.computeLiveTransfers
-	    {chunk = chunk,
-	     transferRegs = transferRegs,
-	     transferFltRegs = transferFltRegs,
-	     liveInfo = liveInfo,
-	     jumpInfo = jumpInfo,
-	     loopInfo = loopInfo}
-	    handle exn
-	     => Error.reraise (exn, "x86LiveTransfers.computeLiveTransfers")
+        val liveTransfers
+          = x86LiveTransfers.computeLiveTransfers
+            {chunk = chunk,
+             transferRegs = transferRegs,
+             transferFltRegs = transferFltRegs,
+             liveInfo = liveInfo,
+             jumpInfo = jumpInfo,
+             loopInfo = loopInfo}
 
-	val getLiveRegsTransfers
-	  = #1 o x86LiveTransfers.getLiveTransfers
-	val getLiveFltRegsTransfers
-	  = #2 o x86LiveTransfers.getLiveTransfers
+        val getLiveRegsTransfers
+          = #1 o x86LiveTransfers.getLiveTransfers
+        val getLiveFltRegsTransfers
+          = #2 o x86LiveTransfers.getLiveTransfers
 
-	val {get = getLayoutInfo : Label.t -> Block.t option,
-	     set = setLayoutInfo,
-	     destroy = destLayoutInfo}
-	  = Property.destGetSet(Label.plist, 
-				Property.initRaise ("layoutInfo", Label.layout))
-	val _ 
-	  = List.foreach
-	    (blocks,
-	     fn block as Block.T {entry, ...}
-	      => let
-		   val label = Entry.label entry
-		 in 
-		   setLayoutInfo(label, SOME block)
-		 end)
+        val {get = getLayoutInfo : Label.t -> Block.t option,
+             set = setLayoutInfo,
+             destroy = destLayoutInfo}
+          = Property.destGetSet(Label.plist, 
+                                Property.initRaise ("layoutInfo", Label.layout))
+        val _ 
+          = List.foreach
+            (blocks,
+             fn block as Block.T {entry, ...}
+              => let
+                   val label = Entry.label entry
+                 in 
+                   setLayoutInfo(label, SOME block)
+                 end)
 
- 	val {get = getProfileLabel : Label.t -> ProfileLabel.t option,
-	     set = setProfileLabel,
-	     destroy = destProfileLabel}
-	  = Property.destGetSetOnce
-	    (Label.plist, 
-	     Property.initRaise ("profileLabel", Label.layout))
-	val _ 
-	  = List.foreach
-	    (blocks,
-	     fn Block.T {entry, profileLabel, ...}
-	      => let
-		   val label = Entry.label entry
-		 in 
-		   setProfileLabel(label, profileLabel)
-		 end)
+        val {get = getProfileLabel : Label.t -> ProfileLabel.t option,
+             set = setProfileLabel,
+             destroy = destProfileLabel}
+          = Property.destGetSetOnce
+            (Label.plist, 
+             Property.initRaise ("profileLabel", Label.layout))
+        val _ 
+          = List.foreach
+            (blocks,
+             fn Block.T {entry, profileLabel, ...}
+              => let
+                   val label = Entry.label entry
+                 in 
+                   setProfileLabel(label, profileLabel)
+                 end)
 
-	local	
-	  val stack = ref []
-	  val queue = ref (Queue.empty ())
-	in
-	  fun enque x = queue := Queue.enque(!queue, x)
-	  fun push x = stack := x::(!stack)
+        local   
+          val stack = ref []
+          val queue = ref (Queue.empty ())
+        in
+          fun enque x = queue := Queue.enque(!queue, x)
+          fun push x = stack := x::(!stack)
 
-	  fun deque () = (case (!stack)
-			    of [] => (case Queue.deque(!queue)
-					of NONE => NONE
-					 | SOME(queue', x) => (queue := queue';
-							       SOME x))
-			     | x::stack' => (stack := stack';
-					     SOME x))
-	end
+          fun deque () = (case (!stack)
+                            of [] => (case Queue.deque(!queue)
+                                        of NONE => NONE
+                                         | SOME(queue', x) => (queue := queue';
+                                                               SOME x))
+                             | x::stack' => (stack := stack';
+                                             SOME x))
+        end
 
-	fun pushCompensationBlock {label, id}
-	  = let
-	      val label' = Label.new label
-	      val live = getLive(liveInfo, label)
-	      val profileLabel = getProfileLabel label
-	      val profileLabel' = Option.map (profileLabel, newProfileLabel)
-	      val block
-		= Block.T {entry = Entry.jump {label = label'},
-			   profileLabel = profileLabel',
-			   statements 
-			   = (Assembly.directive_restoreregalloc
-			      {live = MemLocSet.add
-			              (MemLocSet.add
-				       (LiveSet.toMemLocSet live,
-					stackTop ()),
-			              frontier ()),
-			       id = id})::
-			     nil,
-			   transfer = Transfer.goto {target = label}}
-	    in
-	      setLive(liveInfo, label', live);
-	      setProfileLabel(label', profileLabel');
-	      incNear(jumpInfo, label');
-	      Assert.assert("pushCompensationBlock",
-			    fn () => getNear(jumpInfo, label') = Count 1);
-	      x86LiveTransfers.setLiveTransfersEmpty(liveTransfers, label');
-	      setLayoutInfo(label', SOME block);
-	      push label';
-	      label'
-	    end
+        fun pushCompensationBlock {label, id}
+          = let
+              val label' = Label.new label
+              val live = getLive(liveInfo, label)
+              val profileLabel = getProfileLabel label
+              val profileLabel' = Option.map (profileLabel, newProfileLabel)
+              val block
+                = Block.T {entry = Entry.jump {label = label'},
+                           profileLabel = profileLabel',
+                           statements 
+                           = (Assembly.directive_restoreregalloc
+                              {live = MemLocSet.add
+                                      (MemLocSet.add
+                                       (LiveSet.toMemLocSet live,
+                                        stackTop ()),
+                                      frontier ()),
+                               id = id})::
+                             nil,
+                           transfer = Transfer.goto {target = label}}
+            in
+              setLive(liveInfo, label', live);
+              setProfileLabel(label', profileLabel');
+              incNear(jumpInfo, label');
+              Assert.assert("x86GenerateTransfers.pushCompensationBlock",
+                            fn () => getNear(jumpInfo, label') = Count 1);
+              x86LiveTransfers.setLiveTransfersEmpty(liveTransfers, label');
+              setLayoutInfo(label', SOME block);
+              push label';
+              label'
+            end
 
-	val c_stackP = x86MLton.c_stackPContentsOperand
+        val c_stackP = x86MLton.c_stackPContentsOperand
 
-	fun cacheEsp () =
-	   if reserveEsp
-	      then AppendList.empty
-	   else
-	      AppendList.single
-	      ((* explicit cache in case there are no args *)
-	       Assembly.directive_cache 
-	       {caches = [{register = Register.esp,
-			   memloc = valOf (Operand.deMemloc c_stackP),
-			   reserve = true}]})
+        fun cacheEsp () =
+           if reserveEsp
+              then AppendList.empty
+           else
+              AppendList.single
+              ((* explicit cache in case there are no args *)
+               Assembly.directive_cache 
+               {caches = [{register = Register.esp,
+                           memloc = valOf (Operand.deMemloc c_stackP),
+                           reserve = true}]})
 
-	fun unreserveEsp () =
-	   if reserveEsp
-	      then AppendList.empty
-	   else AppendList.single (Assembly.directive_unreserve 
-				   {registers = [Register.esp]})
+        fun unreserveEsp () =
+           if reserveEsp
+              then AppendList.empty
+           else AppendList.single (Assembly.directive_unreserve 
+                                   {registers = [Register.esp]})
 
-	datatype z = datatype Entry.t
-	datatype z = datatype Transfer.t
-	fun generateAll (gef as GEF {effect,...})
-	                {label, falling, unique} : 
-			Assembly.t AppendList.t
-	  = (case getLayoutInfo label
-	       of NONE => AppendList.empty
-	        | SOME (Block.T {entry, profileLabel, statements, transfer})
-		=> let
-		     val _ = setLayoutInfo(label, NONE)
+        datatype z = datatype Entry.t
+        datatype z = datatype Transfer.t
+        fun generateAll (gef as GEF {effect,...})
+                        {label, falling, unique} : 
+                        Assembly.t AppendList.t
+          = (case getLayoutInfo label
+               of NONE => AppendList.empty
+                | SOME (Block.T {entry, profileLabel, statements, transfer})
+                => let
+                     val _ = setLayoutInfo(label, NONE)
 
 (*
-		     val isLoopHeader = fn _ => false
+                     val isLoopHeader = fn _ => false
 *)
 
-		       
-		     fun near label =
-			let
-			   val align =
-			      if isLoopHeader label handle _ => false
-				 then
-				    AppendList.single
-				    (Assembly.pseudoop_p2align 
-				     (Immediate.const_int 4,
-				      NONE,
-				      SOME (Immediate.const_int 7)))
-			      else if falling
-				      then AppendList.empty
-				   else
-				      AppendList.single
-				      (Assembly.pseudoop_p2align
-				       (Immediate.const_int 4, 
-					NONE, 
-					NONE))
-			   val assumes =
-			      if falling andalso unique
-				 then AppendList.empty
-			      else
-				 (* near entry & live transfer assumptions *)
-				 AppendList.fromList
-				 [(blockAssumes
-				   (List.map
-				    (getLiveRegsTransfers
-				     (liveTransfers, label),
-				     fn (memloc,register,sync)
-				     => {register = register,
-					 memloc = memloc,
-					 sync = sync, 
-					 weight = 1024,
-					 reserve = false}))),
-				  (Assembly.directive_fltassume
-				   {assumes
-				    = (List.map
-				       (getLiveFltRegsTransfers
-					(liveTransfers, label),
-					fn (memloc,sync)
-					=> {memloc = memloc,
-					    sync = sync,
-					    weight = 1024}))})]
-			in
-			   AppendList.appends
-			   [align,
-			    AppendList.single 
-			    (Assembly.label label),
-			    AppendList.fromList 
-			    (ProfileLabel.toAssemblyOpt profileLabel),
-			    assumes]
-			end
-		     val pre
-		       = case entry
-			   of Jump {label}
-			    => near label
-			    | CReturn {dsts, frameInfo, func, label}
-			    => let
-				 fun getReturn () =
-				    if Vector.length dsts = 0
-				       then AppendList.empty
-				       else let
-					       val srcs =
-						  Vector.fromList
-						  (List.map
-						   (Operand.cReturnTemps
-						    (CFunction.return func),
-						    #dst))
-					    in
-					       (AppendList.fromList o Vector.fold2)
-					       (dsts, srcs, [], fn ((dst,dstsize),src,stmts) =>
-						case Size.class dstsize of
-						   Size.INT =>
-						      (x86.Assembly.instruction_mov
-						       {dst = dst,
-							src = Operand.memloc src,
-							size = dstsize})::stmts
-						 | Size.FLT =>
-						      (x86.Assembly.instruction_pfmov
-						       {dst = dst,
-							src = Operand.memloc src,
-							size = dstsize})::stmts
-						 | _ => Error.bug "CReturn")
-					    end
-			       in
-				 case frameInfo of
-				   SOME fi =>
-				      let
-					  val FrameInfo.T {size, frameLayoutsIndex}
-					    = fi
-					  val finish
-					    = AppendList.appends
-					      [let	
-						 val stackTop 
-						   = x86MLton.gcState_stackTopContentsOperand ()
-						 val bytes 
-						   = x86.Operand.immediate_const_int (~ size)
-					       in
-						 AppendList.cons
-						 ((* stackTop += bytes *)
-						  x86.Assembly.instruction_binal 
-						  {oper = x86.Instruction.ADD,
-						   dst = stackTop,
-						   src = bytes, 
-						   size = pointerSize},
-						 profileStackTopCommit)
-					       end,
-					       (* assignTo dst *)
-					       getReturn ()]
-					in
-					  AppendList.appends
-					  [AppendList.fromList
-					   [Assembly.pseudoop_p2align 
-					    (Immediate.const_int 4, NONE, NONE),
-					    Assembly.pseudoop_long 
-					    [Immediate.const_int frameLayoutsIndex],
-					    Assembly.label label],
-					   AppendList.fromList
-					   (ProfileLabel.toAssemblyOpt profileLabel),
-					   if CFunction.maySwitchThreads func
-					     then (* entry from far assumptions *)
-					          farEntry finish
-					     else (* near entry & live transfer assumptions *)
-					          AppendList.append
-						  (AppendList.fromList
-						   [(blockAssumes
-						     (List.map
-						      (getLiveRegsTransfers
-						       (liveTransfers, label),
-						       fn (memloc,register,sync)
-						       => {register = register,
-							   memloc = memloc,
-							   sync = sync, 
-							   weight = 1024,
-							   reserve = false}))),
-						    (Assembly.directive_fltassume
-						     {assumes
-						      = (List.map
-							 (getLiveFltRegsTransfers
-							  (liveTransfers, label),
-							  fn (memloc,sync)
-							  => {memloc = memloc,
-							      sync = sync,
-							      weight = 1024}))})],
-						   finish)]
-					end
-				 | NONE => 
-				      AppendList.append (near label, getReturn ())
-			       end
-			    | Func {label,...}
-			    => AppendList.appends
-			       [AppendList.fromList
-				[Assembly.pseudoop_p2align 
-				 (Immediate.const_int 4, NONE, NONE),
-				 Assembly.pseudoop_global label,
-				 Assembly.label label],
-				AppendList.fromList
-				(ProfileLabel.toAssemblyOpt profileLabel),
-				(* entry from far assumptions *)
-				(farEntry AppendList.empty)]
-			    | Cont {label, 
-				    frameInfo = FrameInfo.T {size,
-							     frameLayoutsIndex},
-				    ...}
-			    =>
-			       AppendList.appends
-			       [AppendList.fromList
-				[Assembly.pseudoop_p2align
-				 (Immediate.const_int 4, NONE, NONE),
-				 Assembly.pseudoop_long
-				 [Immediate.const_int frameLayoutsIndex],
-				 Assembly.label label],
-				AppendList.fromList
-				(ProfileLabel.toAssemblyOpt profileLabel),
-				(* entry from far assumptions *)
-				(farEntry
-				 (let
-				     val stackTop 
-					= x86MLton.gcState_stackTopContentsOperand ()
-				     val bytes 
-					= x86.Operand.immediate_const_int (~ size)
-				  in
-				     AppendList.cons
-				     ((* stackTop += bytes *)
-				      x86.Assembly.instruction_binal 
-				      {oper = x86.Instruction.ADD,
-				       dst = stackTop,
-				       src = bytes, 
-				       size = pointerSize},
-				      profileStackTopCommit)
-				  end))]
-		            | Handler {frameInfo = (FrameInfo.T
-						    {frameLayoutsIndex, size}),
-				       label,
-				       ...}
-			    => AppendList.appends
-			       [AppendList.fromList
-				[Assembly.pseudoop_p2align 
-				 (Immediate.const_int 4, NONE, NONE),
-				 Assembly.pseudoop_long
-				 [Immediate.const_int frameLayoutsIndex],
-				 Assembly.label label],
-				AppendList.fromList
-				(ProfileLabel.toAssemblyOpt profileLabel),
-				(* entry from far assumptions *)
-				(farEntry
-				 (let
-				     val stackTop 
-					= x86MLton.gcState_stackTopContentsOperand ()
-				     val bytes 
-					= x86.Operand.immediate_const_int (~ size)
-				  in
-				     AppendList.cons
-				     ((* stackTop += bytes *)
-				      x86.Assembly.instruction_binal 
-				      {oper = x86.Instruction.ADD,
-				       dst = stackTop,
-				       src = bytes, 
-				       size = pointerSize},
-				      profileStackTopCommit)
-				  end))]
-		     val pre
-		       = AppendList.appends
-		         [if !Control.Native.commented > 1
-			    then AppendList.single
-			         (Assembly.comment (Entry.toString entry))
-			    else AppendList.empty,
-			  if !Control.Native.commented > 2
-			    then AppendList.single
-			         (Assembly.comment 
-				  (LiveSet.fold
-				   (getLive(liveInfo, label),
-				    "",
-				    fn (memloc, s)
-				     => concat [s, 
-						MemLoc.toString memloc, 
-						" "])))
-			    else AppendList.empty,
-			  pre]
+                       
+                     fun near label =
+                        let
+                           val align =
+                              if isLoopHeader label handle _ => false
+                                 then
+                                    AppendList.single
+                                    (Assembly.pseudoop_p2align 
+                                     (Immediate.const_int 4,
+                                      NONE,
+                                      SOME (Immediate.const_int 7)))
+                              else if falling
+                                      then AppendList.empty
+                                   else
+                                      AppendList.single
+                                      (Assembly.pseudoop_p2align
+                                       (Immediate.const_int 4, 
+                                        NONE, 
+                                        NONE))
+                           val assumes =
+                              if falling andalso unique
+                                 then AppendList.empty
+                              else
+                                 (* near entry & live transfer assumptions *)
+                                 AppendList.fromList
+                                 [(blockAssumes
+                                   (List.map
+                                    (getLiveRegsTransfers
+                                     (liveTransfers, label),
+                                     fn (memloc,register,sync)
+                                     => {register = register,
+                                         memloc = memloc,
+                                         sync = sync, 
+                                         weight = 1024,
+                                         reserve = false}))),
+                                  (Assembly.directive_fltassume
+                                   {assumes
+                                    = (List.map
+                                       (getLiveFltRegsTransfers
+                                        (liveTransfers, label),
+                                        fn (memloc,sync)
+                                        => {memloc = memloc,
+                                            sync = sync,
+                                            weight = 1024}))})]
+                        in
+                           AppendList.appends
+                           [align,
+                            AppendList.single 
+                            (Assembly.label label),
+                            AppendList.fromList 
+                            (ProfileLabel.toAssemblyOpt profileLabel),
+                            assumes]
+                        end
+                     val pre
+                       = case entry
+                           of Jump {label}
+                            => near label
+                            | CReturn {dsts, frameInfo, func, label}
+                            => let
+                                 fun getReturn () =
+                                    if Vector.length dsts = 0
+                                       then AppendList.empty
+                                       else let
+                                               val srcs =
+                                                  Vector.fromList
+                                                  (List.map
+                                                   (Operand.cReturnTemps
+                                                    (CFunction.return func),
+                                                    #dst))
+                                            in
+                                               (AppendList.fromList o Vector.fold2)
+                                               (dsts, srcs, [], fn ((dst,dstsize),src,stmts) =>
+                                                case Size.class dstsize of
+                                                   Size.INT =>
+                                                      (x86.Assembly.instruction_mov
+                                                       {dst = dst,
+                                                        src = Operand.memloc src,
+                                                        size = dstsize})::stmts
+                                                 | Size.FLT =>
+                                                      (x86.Assembly.instruction_pfmov
+                                                       {dst = dst,
+                                                        src = Operand.memloc src,
+                                                        size = dstsize})::stmts
+                                                 | _ => Error.bug "x86GenerateTransfers.generateAll: CReturn")
+                                            end
+                               in
+                                 case frameInfo of
+                                   SOME fi =>
+                                      let
+                                          val FrameInfo.T {size, frameLayoutsIndex}
+                                            = fi
+                                          val finish
+                                            = AppendList.appends
+                                              [let      
+                                                 val stackTop 
+                                                   = x86MLton.gcState_stackTopContentsOperand ()
+                                                 val bytes 
+                                                   = x86.Operand.immediate_const_int (~ size)
+                                               in
+                                                 AppendList.cons
+                                                 ((* stackTop += bytes *)
+                                                  x86.Assembly.instruction_binal 
+                                                  {oper = x86.Instruction.ADD,
+                                                   dst = stackTop,
+                                                   src = bytes, 
+                                                   size = pointerSize},
+                                                 profileStackTopCommit)
+                                               end,
+                                               (* assignTo dst *)
+                                               getReturn ()]
+                                        in
+                                          AppendList.appends
+                                          [AppendList.fromList
+                                           [Assembly.pseudoop_p2align 
+                                            (Immediate.const_int 4, NONE, NONE),
+                                            Assembly.pseudoop_long 
+                                            [Immediate.const_int frameLayoutsIndex],
+                                            Assembly.label label],
+                                           AppendList.fromList
+                                           (ProfileLabel.toAssemblyOpt profileLabel),
+                                           if CFunction.maySwitchThreads func
+                                             then (* entry from far assumptions *)
+                                                  farEntry finish
+                                             else (* near entry & live transfer assumptions *)
+                                                  AppendList.append
+                                                  (AppendList.fromList
+                                                   [(blockAssumes
+                                                     (List.map
+                                                      (getLiveRegsTransfers
+                                                       (liveTransfers, label),
+                                                       fn (memloc,register,sync)
+                                                       => {register = register,
+                                                           memloc = memloc,
+                                                           sync = sync, 
+                                                           weight = 1024,
+                                                           reserve = false}))),
+                                                    (Assembly.directive_fltassume
+                                                     {assumes
+                                                      = (List.map
+                                                         (getLiveFltRegsTransfers
+                                                          (liveTransfers, label),
+                                                          fn (memloc,sync)
+                                                          => {memloc = memloc,
+                                                              sync = sync,
+                                                              weight = 1024}))})],
+                                                   finish)]
+                                        end
+                                 | NONE => 
+                                      AppendList.append (near label, getReturn ())
+                               end
+                            | Func {label,...}
+                            => AppendList.appends
+                               [AppendList.fromList
+                                [Assembly.pseudoop_p2align 
+                                 (Immediate.const_int 4, NONE, NONE),
+                                 Assembly.pseudoop_global label,
+                                 Assembly.label label],
+                                AppendList.fromList
+                                (ProfileLabel.toAssemblyOpt profileLabel),
+                                (* entry from far assumptions *)
+                                (farEntry AppendList.empty)]
+                            | Cont {label, 
+                                    frameInfo = FrameInfo.T {size,
+                                                             frameLayoutsIndex},
+                                    ...}
+                            =>
+                               AppendList.appends
+                               [AppendList.fromList
+                                [Assembly.pseudoop_p2align
+                                 (Immediate.const_int 4, NONE, NONE),
+                                 Assembly.pseudoop_long
+                                 [Immediate.const_int frameLayoutsIndex],
+                                 Assembly.label label],
+                                AppendList.fromList
+                                (ProfileLabel.toAssemblyOpt profileLabel),
+                                (* entry from far assumptions *)
+                                (farEntry
+                                 (let
+                                     val stackTop 
+                                        = x86MLton.gcState_stackTopContentsOperand ()
+                                     val bytes 
+                                        = x86.Operand.immediate_const_int (~ size)
+                                  in
+                                     AppendList.cons
+                                     ((* stackTop += bytes *)
+                                      x86.Assembly.instruction_binal 
+                                      {oper = x86.Instruction.ADD,
+                                       dst = stackTop,
+                                       src = bytes, 
+                                       size = pointerSize},
+                                      profileStackTopCommit)
+                                  end))]
+                            | Handler {frameInfo = (FrameInfo.T
+                                                    {frameLayoutsIndex, size}),
+                                       label,
+                                       ...}
+                            => AppendList.appends
+                               [AppendList.fromList
+                                [Assembly.pseudoop_p2align 
+                                 (Immediate.const_int 4, NONE, NONE),
+                                 Assembly.pseudoop_long
+                                 [Immediate.const_int frameLayoutsIndex],
+                                 Assembly.label label],
+                                AppendList.fromList
+                                (ProfileLabel.toAssemblyOpt profileLabel),
+                                (* entry from far assumptions *)
+                                (farEntry
+                                 (let
+                                     val stackTop 
+                                        = x86MLton.gcState_stackTopContentsOperand ()
+                                     val bytes 
+                                        = x86.Operand.immediate_const_int (~ size)
+                                  in
+                                     AppendList.cons
+                                     ((* stackTop += bytes *)
+                                      x86.Assembly.instruction_binal 
+                                      {oper = x86.Instruction.ADD,
+                                       dst = stackTop,
+                                       src = bytes, 
+                                       size = pointerSize},
+                                      profileStackTopCommit)
+                                  end))]
+                     val pre
+                       = AppendList.appends
+                         [if !Control.Native.commented > 1
+                            then AppendList.single
+                                 (Assembly.comment (Entry.toString entry))
+                            else AppendList.empty,
+                          if !Control.Native.commented > 2
+                            then AppendList.single
+                                 (Assembly.comment 
+                                  (LiveSet.fold
+                                   (getLive(liveInfo, label),
+                                    "",
+                                    fn (memloc, s)
+                                     => concat [s, 
+                                                MemLoc.toString memloc, 
+                                                " "])))
+                            else AppendList.empty,
+                          pre]
 
-		     val (statements,_)
-		       = List.foldr
-		         (statements,
-			  ([], 
-			   Liveness.liveIn
-			   (livenessTransfer {transfer = transfer, 
-					      liveInfo = liveInfo})),
-			  fn (assembly,(statements,live))
-			   => let
-				val Liveness.T {liveIn,dead, ...}
-				  = livenessAssembly {assembly = assembly,
-						      live = live}
-			      in
-				(if LiveSet.isEmpty dead
-				   then assembly::statements
-				   else assembly::
-				        (Assembly.directive_force
-					 {commit_memlocs = MemLocSet.empty,
-					  commit_classes = ClassSet.empty,
-					  remove_memlocs = MemLocSet.empty,
-					  remove_classes = ClassSet.empty,
-					  dead_memlocs = LiveSet.toMemLocSet dead,
-					  dead_classes = ClassSet.empty})::
-					statements,
-				 liveIn)
-			      end)
+                     val (statements,_)
+                       = List.foldr
+                         (statements,
+                          ([], 
+                           Liveness.liveIn
+                           (livenessTransfer {transfer = transfer, 
+                                              liveInfo = liveInfo})),
+                          fn (assembly,(statements,live))
+                           => let
+                                val Liveness.T {liveIn,dead, ...}
+                                  = livenessAssembly {assembly = assembly,
+                                                      live = live}
+                              in
+                                (if LiveSet.isEmpty dead
+                                   then assembly::statements
+                                   else assembly::
+                                        (Assembly.directive_force
+                                         {commit_memlocs = MemLocSet.empty,
+                                          commit_classes = ClassSet.empty,
+                                          remove_memlocs = MemLocSet.empty,
+                                          remove_classes = ClassSet.empty,
+                                          dead_memlocs = LiveSet.toMemLocSet dead,
+                                          dead_classes = ClassSet.empty})::
+                                        statements,
+                                 liveIn)
+                              end)
 
-		     val statements = AppendList.fromList statements
+                     val statements = AppendList.fromList statements
 
-		     val transfer = effect gef {label = label, 
-						transfer = transfer}
-		   in
-		     AppendList.appends 
-		     [pre,
-		      statements,
-		      transfer]
-		   end)
-	  
-	and effectDefault (gef as GEF {fall,...})
-	                  {label, transfer} : Assembly.t AppendList.t
-	  = AppendList.append
-	    (if !Control.Native.commented > 1
-	       then AppendList.single
-		    (Assembly.comment
-		     (Transfer.toString transfer))
-	       else AppendList.empty,
-	     case transfer
-	       of Goto {target}
-		=> fall gef
-		        {label = target,
-			 live = getLive(liveInfo, target)}
-		| Iff {condition, truee, falsee}
-		=> let
-		     val condition_neg
-		       = Instruction.condition_negate condition
+                     val transfer = effect gef {label = label, 
+                                                transfer = transfer}
+                   in
+                     AppendList.appends 
+                     [pre,
+                      statements,
+                      transfer]
+                   end)
+          
+        and effectDefault (gef as GEF {fall,...})
+                          {label, transfer} : Assembly.t AppendList.t
+          = AppendList.append
+            (if !Control.Native.commented > 1
+               then AppendList.single
+                    (Assembly.comment
+                     (Transfer.toString transfer))
+               else AppendList.empty,
+             case transfer
+               of Goto {target}
+                => fall gef
+                        {label = target,
+                         live = getLive(liveInfo, target)}
+                | Iff {condition, truee, falsee}
+                => let
+                     val condition_neg
+                       = Instruction.condition_negate condition
 
-		     val truee_live
-		       = getLive(liveInfo, truee)
-		     val truee_live_length
-		       = LiveSet.size truee_live
+                     val truee_live
+                       = getLive(liveInfo, truee)
+                     val truee_live_length
+                       = LiveSet.size truee_live
 
-		     val falsee_live
-		       = getLive(liveInfo, falsee)
-		     val falsee_live_length
-		       = LiveSet.size falsee_live
+                     val falsee_live
+                       = getLive(liveInfo, falsee)
+                     val falsee_live_length
+                       = LiveSet.size falsee_live
 
-		     fun fall_truee ()
-		       = let
-			   val id = Directive.Id.new ()
-			   val falsee'
-			     = pushCompensationBlock {label = falsee,
-						      id = id};
-			 in
-			   AppendList.append
-			   (AppendList.fromList
-			    [Assembly.directive_force
-			     {commit_memlocs = MemLocSet.empty,
-			      commit_classes = nearflushClasses,
-			      remove_memlocs = MemLocSet.empty,
-			      remove_classes = ClassSet.empty,
-			      dead_memlocs = MemLocSet.empty,
-			      dead_classes = ClassSet.empty},
-			     Assembly.directive_saveregalloc
-			     {live = MemLocSet.add
-			             (MemLocSet.add
-				      (LiveSet.toMemLocSet falsee_live,
-				       stackTop ()),
-				      frontier ()),
-			      id = id},
-			     Assembly.instruction_jcc
-			     {condition = condition_neg,
-			      target = Operand.label falsee'}],
-			    (fall gef 
-			          {label = truee,
-				   live = truee_live}))
-			 end
+                     fun fall_truee ()
+                       = let
+                           val id = Directive.Id.new ()
+                           val falsee'
+                             = pushCompensationBlock {label = falsee,
+                                                      id = id};
+                         in
+                           AppendList.append
+                           (AppendList.fromList
+                            [Assembly.directive_force
+                             {commit_memlocs = MemLocSet.empty,
+                              commit_classes = nearflushClasses,
+                              remove_memlocs = MemLocSet.empty,
+                              remove_classes = ClassSet.empty,
+                              dead_memlocs = MemLocSet.empty,
+                              dead_classes = ClassSet.empty},
+                             Assembly.directive_saveregalloc
+                             {live = MemLocSet.add
+                                     (MemLocSet.add
+                                      (LiveSet.toMemLocSet falsee_live,
+                                       stackTop ()),
+                                      frontier ()),
+                              id = id},
+                             Assembly.instruction_jcc
+                             {condition = condition_neg,
+                              target = Operand.label falsee'}],
+                            (fall gef 
+                                  {label = truee,
+                                   live = truee_live}))
+                         end
 
-		     fun fall_falsee ()
-		       = let
-			   val id = Directive.Id.new ()
-			   val truee' = pushCompensationBlock {label = truee,
-							       id = id};
-			 in
-			   AppendList.append
-			   (AppendList.fromList
-			    [Assembly.directive_force
-			     {commit_memlocs = MemLocSet.empty,
-			      commit_classes = nearflushClasses,
-			      remove_memlocs = MemLocSet.empty,
-			      remove_classes = ClassSet.empty,
-			      dead_memlocs = MemLocSet.empty,
-			      dead_classes = ClassSet.empty},
-			     Assembly.directive_saveregalloc
-			     {live = MemLocSet.add
-			             (MemLocSet.add
-				      (LiveSet.toMemLocSet truee_live,
-				       stackTop ()),
-				      frontier ()),
-			      id = id},
-			     Assembly.instruction_jcc
-			     {condition = condition,
-			      target = Operand.label truee'}],
-			    (fall gef 
-			          {label = falsee,
-				   live = falsee_live}))
-			 end
-		   in
-		     case (getLayoutInfo truee,
-			   getLayoutInfo falsee)
-		       of (NONE, SOME _) => fall_falsee ()
-			| (SOME _, NONE) => fall_truee ()
-			| _ 
-			=> let
-			     fun default' ()
-			       = if truee_live_length <= falsee_live_length
-				   then fall_falsee ()
-				   else fall_truee ()
+                     fun fall_falsee ()
+                       = let
+                           val id = Directive.Id.new ()
+                           val truee' = pushCompensationBlock {label = truee,
+                                                               id = id};
+                         in
+                           AppendList.append
+                           (AppendList.fromList
+                            [Assembly.directive_force
+                             {commit_memlocs = MemLocSet.empty,
+                              commit_classes = nearflushClasses,
+                              remove_memlocs = MemLocSet.empty,
+                              remove_classes = ClassSet.empty,
+                              dead_memlocs = MemLocSet.empty,
+                              dead_classes = ClassSet.empty},
+                             Assembly.directive_saveregalloc
+                             {live = MemLocSet.add
+                                     (MemLocSet.add
+                                      (LiveSet.toMemLocSet truee_live,
+                                       stackTop ()),
+                                      frontier ()),
+                              id = id},
+                             Assembly.instruction_jcc
+                             {condition = condition,
+                              target = Operand.label truee'}],
+                            (fall gef 
+                                  {label = falsee,
+                                   live = falsee_live}))
+                         end
+                   in
+                     case (getLayoutInfo truee,
+                           getLayoutInfo falsee)
+                       of (NONE, SOME _) => fall_falsee ()
+                        | (SOME _, NONE) => fall_truee ()
+                        | _ 
+                        => let
+                             fun default' ()
+                               = if truee_live_length <= falsee_live_length
+                                   then fall_falsee ()
+                                   else fall_truee ()
 
-			     fun default ()
-			       = case (getNear(jumpInfo, truee),
-				       getNear(jumpInfo, falsee))
-				   of (Count 1, Count 1) => default' ()
-				    | (Count 1, _) => fall_truee ()
-				    | (_, Count 1) => fall_falsee ()
-				    | _ => default' ()
-			   in 
-			     case (getLoopDistance(loopInfo, label, truee),
-				   getLoopDistance(loopInfo, label, falsee))
-			       of (NONE, NONE) => default ()
-				| (SOME _, NONE) => fall_truee ()
-				| (NONE, SOME _) => fall_falsee ()
-			        | (SOME dtruee, SOME dfalsee)
-				=> (case Int.compare(dtruee, dfalsee)
-				      of EQUAL => default ()
-				       | LESS => fall_falsee ()
-				       | GREATER => fall_truee ())
-			   end
-		   end
-		| Switch {test, cases, default}
-		=> let
-		     val Liveness.T {dead, ...}
-		       = livenessTransfer {transfer = transfer,
-					   liveInfo = liveInfo}
+                             fun default ()
+                               = case (getNear(jumpInfo, truee),
+                                       getNear(jumpInfo, falsee))
+                                   of (Count 1, Count 1) => default' ()
+                                    | (Count 1, _) => fall_truee ()
+                                    | (_, Count 1) => fall_falsee ()
+                                    | _ => default' ()
+                           in 
+                             case (getLoopDistance(loopInfo, label, truee),
+                                   getLoopDistance(loopInfo, label, falsee))
+                               of (NONE, NONE) => default ()
+                                | (SOME _, NONE) => fall_truee ()
+                                | (NONE, SOME _) => fall_falsee ()
+                                | (SOME dtruee, SOME dfalsee)
+                                => (case Int.compare(dtruee, dfalsee)
+                                      of EQUAL => default ()
+                                       | LESS => fall_falsee ()
+                                       | GREATER => fall_truee ())
+                           end
+                   end
+                | Switch {test, cases, default}
+                => let
+                     val Liveness.T {dead, ...}
+                       = livenessTransfer {transfer = transfer,
+                                           liveInfo = liveInfo}
 
-		     val size
-		       = case Operand.size test
-			   of SOME size => size
-			    | NONE => Size.LONG
+                     val size
+                       = case Operand.size test
+                           of SOME size => size
+                            | NONE => Size.LONG
 
-		     val default_live
-		       = getLive(liveInfo, default)
+                     val default_live
+                       = getLive(liveInfo, default)
 
-		     val cases
-		       = Transfer.Cases.map'
-		         (cases,
-			  fn (k, target)
-			   => let
-				val target_live
-				  = getLive(liveInfo, target)
-				val id = Directive.Id.new ()
-				val target' = pushCompensationBlock 
-				              {label = target,
-					       id = id}
-			      in
-				AppendList.fromList
-				[Assembly.instruction_cmp
-				 {src1 = test,
-				  src2 = Operand.immediate_const k,
-				  size = size},
-				 Assembly.directive_saveregalloc
-				 {live = MemLocSet.add
-				         (MemLocSet.add
-					  (LiveSet.toMemLocSet target_live,
-					   stackTop ()),
-					  frontier ()),
-				  id = id},
-				 Assembly.instruction_jcc
-				 {condition = Instruction.E,
-				  target = Operand.label target'}]
-			      end,
-			  fn (c, target) => (Immediate.Char c, target),
-			  fn (i, target) => (Immediate.Int i, target),
-			  fn (w, target) => (Immediate.Word w, target))
-		   in
-		     AppendList.appends
-		     [AppendList.single
-		      (Assembly.directive_force
-		       {commit_memlocs = MemLocSet.empty,
-			commit_classes = nearflushClasses,
-			remove_memlocs = MemLocSet.empty,
-			remove_classes = ClassSet.empty,
-			dead_memlocs = MemLocSet.empty,
-			dead_classes = ClassSet.empty}),
-		      AppendList.appends cases,
-		      if LiveSet.isEmpty dead
-			then AppendList.empty
-			else AppendList.single
-			     (Assembly.directive_force
-			      {commit_memlocs = MemLocSet.empty,
-			       commit_classes = ClassSet.empty,
-			       remove_memlocs = MemLocSet.empty,
-			       remove_classes = ClassSet.empty,
-			       dead_memlocs = LiveSet.toMemLocSet dead,
-			       dead_classes = ClassSet.empty}),
-		      (fall gef
-		            {label = default,
-			     live = default_live})]
-		   end
+                     val cases
+                       = Transfer.Cases.mapToList
+                         (cases,
+                          fn (k, target)
+                           => let
+                                val target_live
+                                  = getLive(liveInfo, target)
+                                val id = Directive.Id.new ()
+                                val target' = pushCompensationBlock 
+                                              {label = target,
+                                               id = id}
+                              in
+                                AppendList.fromList
+                                [Assembly.instruction_cmp
+                                 {src1 = test,
+                                  src2 = Operand.immediate_const_word k,
+                                  size = size},
+                                 Assembly.directive_saveregalloc
+                                 {live = MemLocSet.add
+                                         (MemLocSet.add
+                                          (LiveSet.toMemLocSet target_live,
+                                           stackTop ()),
+                                          frontier ()),
+                                  id = id},
+                                 Assembly.instruction_jcc
+                                 {condition = Instruction.E,
+                                  target = Operand.label target'}]
+                              end)
+                   in
+                     AppendList.appends
+                     [AppendList.single
+                      (Assembly.directive_force
+                       {commit_memlocs = MemLocSet.empty,
+                        commit_classes = nearflushClasses,
+                        remove_memlocs = MemLocSet.empty,
+                        remove_classes = ClassSet.empty,
+                        dead_memlocs = MemLocSet.empty,
+                        dead_classes = ClassSet.empty}),
+                      AppendList.appends cases,
+                      if LiveSet.isEmpty dead
+                        then AppendList.empty
+                        else AppendList.single
+                             (Assembly.directive_force
+                              {commit_memlocs = MemLocSet.empty,
+                               commit_classes = ClassSet.empty,
+                               remove_memlocs = MemLocSet.empty,
+                               remove_classes = ClassSet.empty,
+                               dead_memlocs = LiveSet.toMemLocSet dead,
+                               dead_classes = ClassSet.empty}),
+                      (fall gef
+                            {label = default,
+                             live = default_live})]
+                   end
                 | Tail {target, live}
-		=> (* flushing at far transfer *)
-		   (farTransfer live
-		    AppendList.empty
-		    (AppendList.single
-		     (Assembly.instruction_jmp
-		      {target = Operand.label target,
-		       absolute = false})))
-		| NonTail {target, live, return, handler, size}
-		=> let
-		     val _ = enque return
-		     val _ = case handler
-			       of SOME handler => enque handler
-				| NONE => ()
+                => (* flushing at far transfer *)
+                   (farTransfer live
+                    AppendList.empty
+                    (AppendList.single
+                     (Assembly.instruction_jmp
+                      {target = Operand.label target,
+                       absolute = false})))
+                | NonTail {target, live, return, handler, size}
+                => let
+                     val _ = enque return
+                     val _ = case handler
+                               of SOME handler => enque handler
+                                | NONE => ()
 
-		     val stackTopTemp
-		       = x86MLton.stackTopTempContentsOperand ()
-		     val stackTopTempMinusWordDeref'
-		       = x86MLton.stackTopTempMinusWordDeref ()
-		     val stackTopTempMinusWordDeref
-		       = x86MLton.stackTopTempMinusWordDerefOperand ()
-		     val stackTop 
-		       = x86MLton.gcState_stackTopContentsOperand ()
-		     val stackTopMinusWordDeref'
-		       = x86MLton.gcState_stackTopMinusWordDeref ()
-		     val stackTopMinusWordDeref
-		       = x86MLton.gcState_stackTopMinusWordDerefOperand ()
-		     val bytes 
-		       = x86.Operand.immediate_const_int size
+                     val stackTopTemp
+                       = x86MLton.stackTopTempContentsOperand ()
+                     val stackTopTempMinusWordDeref'
+                       = x86MLton.stackTopTempMinusWordDeref ()
+                     val stackTopTempMinusWordDeref
+                       = x86MLton.stackTopTempMinusWordDerefOperand ()
+                     val stackTop 
+                       = x86MLton.gcState_stackTopContentsOperand ()
+                     val stackTopMinusWordDeref'
+                       = x86MLton.gcState_stackTopMinusWordDeref ()
+                     val stackTopMinusWordDeref
+                       = x86MLton.gcState_stackTopMinusWordDerefOperand ()
+                     val bytes 
+                       = x86.Operand.immediate_const_int size
 
-		     val liveReturn = x86Liveness.LiveInfo.getLive(liveInfo, return)
-		     val liveHandler 
-		       = case handler
-			   of SOME handler
-			    => x86Liveness.LiveInfo.getLive(liveInfo, handler)
-			    | _ => LiveSet.empty
-		     val live = MemLocSet.unions [live,
-						  LiveSet.toMemLocSet liveReturn,
-						  LiveSet.toMemLocSet liveHandler]
-		   in
-		     (* flushing at far transfer *)
-		     (farTransfer live
-		      (if !Control.profile <> Control.ProfileNone
-			 then (AppendList.fromList
-			       [(* stackTopTemp = stackTop + bytes *)
-				x86.Assembly.instruction_mov
-				{dst = stackTopTemp,
-				 src = stackTop,
-				 size = pointerSize},
-				x86.Assembly.instruction_binal
-				{oper = x86.Instruction.ADD,
-				 dst = stackTopTemp,
-				 src = bytes,
-				 size = pointerSize},
-				(* *(stackTopTemp - WORD_SIZE) = return *)
-				x86.Assembly.instruction_mov
-				{dst = stackTopTempMinusWordDeref,
-				 src = Operand.immediate_label return,
-				 size = pointerSize},
-				x86.Assembly.directive_force
-				{commit_memlocs = MemLocSet.singleton stackTopTempMinusWordDeref',
-				 commit_classes = ClassSet.empty,
-				 remove_memlocs = MemLocSet.empty,
-				 remove_classes = ClassSet.empty,
-				 dead_memlocs = MemLocSet.empty,
-				 dead_classes = ClassSet.empty},
-				(* stackTop = stackTopTemp *)
-				x86.Assembly.instruction_mov
-				{dst = stackTop,
-				 src = stackTopTemp,
-				 size = pointerSize},
-				profileStackTopCommit'])
-			 else (AppendList.fromList
-			       [(* stackTop += bytes *)
-				x86.Assembly.instruction_binal 
-				{oper = x86.Instruction.ADD,
-				 dst = stackTop,
-				 src = bytes, 
-				 size = pointerSize},
-				(* *(stackTop - WORD_SIZE) = return *)
-				x86.Assembly.instruction_mov
-				{dst = stackTopMinusWordDeref,
-				 src = Operand.immediate_label return,
-				 size = pointerSize},
-				x86.Assembly.directive_force
-				{commit_memlocs = MemLocSet.singleton stackTopMinusWordDeref',
-				 commit_classes = ClassSet.empty,
-				 remove_memlocs = MemLocSet.empty,
-				 remove_classes = ClassSet.empty,
-				 dead_memlocs = MemLocSet.empty,
-				 dead_classes = ClassSet.empty}]))
-		      (AppendList.single
-		       (Assembly.instruction_jmp
-			{target = Operand.label target,
-			 absolute = false})))
-		   end
-		| Return {live}
-		=> let
-		     val stackTopMinusWordDeref
-		       = x86MLton.gcState_stackTopMinusWordDerefOperand ()
-		   in
-		     (* flushing at far transfer *)
-		     (farTransfer live
-		      AppendList.empty
-		      (AppendList.single
-		       (* jmp *(stackTop - WORD_SIZE) *)
-		       (x86.Assembly.instruction_jmp
-			{target = stackTopMinusWordDeref,
-			 absolute = true})))
-		   end
-		| Raise {live}
-		=> let
-		     val exnStack 
-		       = x86MLton.gcState_exnStackContentsOperand ()
-		     val stackTopTemp
-		       = x86MLton.stackTopTempContentsOperand ()
-		     val stackTop 
-		       = x86MLton.gcState_stackTopContentsOperand ()
-		     val stackBottom 
-		       = x86MLton.gcState_stackBottomContentsOperand ()
-		    in
-		      (* flushing at far transfer *)
-		      (farTransfer live
-		       (if !Control.profile <> Control.ProfileNone
-			  then (AppendList.fromList
-				[(* stackTopTemp = stackBottom + exnStack *)
-				 x86.Assembly.instruction_mov
-				 {dst = stackTopTemp,
-				  src = stackBottom,
-				  size = pointerSize},
-				 x86.Assembly.instruction_binal
-				 {oper = x86.Instruction.ADD,
-				  dst = stackTopTemp,
-				  src = exnStack,
-				  size = pointerSize},
-				 (* stackTop = stackTopTemp *)
-				 x86.Assembly.instruction_mov
-				 {dst = stackTop,
-				  src = stackTopTemp,
-				  size = pointerSize},
-				 profileStackTopCommit'])
-			  else (AppendList.fromList
-				[(* stackTop = stackBottom + exnStack *)
-				 x86.Assembly.instruction_mov
-				 {dst = stackTop,
-				  src = stackBottom,
-				  size = pointerSize},
-				 x86.Assembly.instruction_binal
-				 {oper = x86.Instruction.ADD,
-				  dst = stackTop,
-				  src = exnStack,
-				  size = pointerSize}]))
-		       (AppendList.single
-			(* jmp *(stackTop - WORD_SIZE) *)
-			(x86.Assembly.instruction_jmp
-			 {target = x86MLton.gcState_stackTopMinusWordDerefOperand (),
-			  absolute = true})))
-		    end
-	        | CCall {args, frameInfo, func, return}
-		=> let
-		     datatype z = datatype CFunction.Convention.t
-		     datatype z = datatype CFunction.Target.t
-		     val CFunction.T {convention,
-				      maySwitchThreads,
-				      modifiesFrontier,
-				      readsStackTop, 
-				      return = returnTy,
-				      target,
-				      writesStackTop, ...} = func
-		     val stackTopMinusWordDeref
-		       = x86MLton.gcState_stackTopMinusWordDerefOperand ()
-		     val Liveness.T {dead, ...}
-		       = livenessTransfer {transfer = transfer,
-					   liveInfo = liveInfo}
-		     val c_stackP = x86MLton.c_stackPContentsOperand
-		     val c_stackPDerefFloat = x86MLton.c_stackPDerefFloatOperand
-		     val c_stackPDerefDouble = x86MLton.c_stackPDerefDoubleOperand
-		     val applyFFTemp = x86MLton.applyFFTempContentsOperand
-		     val applyFFTemp2 = x86MLton.applyFFTemp2ContentsOperand
-		     val (fptrArg, args) =
-			case target of 
-			   Direct _ => (AppendList.empty, args)
-			 | Indirect => 
-			      let
-				 val (fptrArg, args) =
-				    case args of
-				       fptrArg::args => (fptrArg, args)
-				     | _ => Error.bug "CCall"
-			      in
-				 (AppendList.single
-				  (Assembly.instruction_mov
-				   {src = #1 fptrArg,
-				    dst = applyFFTemp2,
-				    size = #2 fptrArg}),
-				  args)
-			      end
-		     val (pushArgs, size_args)
-		       = List.fold
-		         (args, (AppendList.empty, 0),
-			  fn ((arg, size), (assembly_args, size_args)) =>
-			  (AppendList.append
-			   (if Size.eq (size, Size.DBLE)
-			      then AppendList.fromList
-			   	   [Assembly.instruction_binal
-				    {oper = Instruction.SUB,
-				     dst = c_stackP,
-				     src = Operand.immediate_const_int 8,
-				     size = pointerSize},
-				    Assembly.instruction_pfmov
-				    {src = arg,
-				     dst = c_stackPDerefDouble,
-				     size = size}]
+                     val liveReturn = x86Liveness.LiveInfo.getLive(liveInfo, return)
+                     val liveHandler 
+                       = case handler
+                           of SOME handler
+                            => x86Liveness.LiveInfo.getLive(liveInfo, handler)
+                            | _ => LiveSet.empty
+                     val live = MemLocSet.unions [live,
+                                                  LiveSet.toMemLocSet liveReturn,
+                                                  LiveSet.toMemLocSet liveHandler]
+                   in
+                     (* flushing at far transfer *)
+                     (farTransfer live
+                      (if !Control.profile <> Control.ProfileNone
+                         then (AppendList.fromList
+                               [(* stackTopTemp = stackTop + bytes *)
+                                x86.Assembly.instruction_mov
+                                {dst = stackTopTemp,
+                                 src = stackTop,
+                                 size = pointerSize},
+                                x86.Assembly.instruction_binal
+                                {oper = x86.Instruction.ADD,
+                                 dst = stackTopTemp,
+                                 src = bytes,
+                                 size = pointerSize},
+                                (* *(stackTopTemp - WORD_SIZE) = return *)
+                                x86.Assembly.instruction_mov
+                                {dst = stackTopTempMinusWordDeref,
+                                 src = Operand.immediate_label return,
+                                 size = pointerSize},
+                                x86.Assembly.directive_force
+                                {commit_memlocs = MemLocSet.singleton stackTopTempMinusWordDeref',
+                                 commit_classes = ClassSet.empty,
+                                 remove_memlocs = MemLocSet.empty,
+                                 remove_classes = ClassSet.empty,
+                                 dead_memlocs = MemLocSet.empty,
+                                 dead_classes = ClassSet.empty},
+                                (* stackTop = stackTopTemp *)
+                                x86.Assembly.instruction_mov
+                                {dst = stackTop,
+                                 src = stackTopTemp,
+                                 size = pointerSize},
+                                profileStackTopCommit'])
+                         else (AppendList.fromList
+                               [(* stackTop += bytes *)
+                                x86.Assembly.instruction_binal 
+                                {oper = x86.Instruction.ADD,
+                                 dst = stackTop,
+                                 src = bytes, 
+                                 size = pointerSize},
+                                (* *(stackTop - WORD_SIZE) = return *)
+                                x86.Assembly.instruction_mov
+                                {dst = stackTopMinusWordDeref,
+                                 src = Operand.immediate_label return,
+                                 size = pointerSize},
+                                x86.Assembly.directive_force
+                                {commit_memlocs = MemLocSet.singleton stackTopMinusWordDeref',
+                                 commit_classes = ClassSet.empty,
+                                 remove_memlocs = MemLocSet.empty,
+                                 remove_classes = ClassSet.empty,
+                                 dead_memlocs = MemLocSet.empty,
+                                 dead_classes = ClassSet.empty}]))
+                      (AppendList.single
+                       (Assembly.instruction_jmp
+                        {target = Operand.label target,
+                         absolute = false})))
+                   end
+                | Return {live}
+                => let
+                     val stackTopMinusWordDeref
+                       = x86MLton.gcState_stackTopMinusWordDerefOperand ()
+                   in
+                     (* flushing at far transfer *)
+                     (farTransfer live
+                      AppendList.empty
+                      (AppendList.single
+                       (* jmp *(stackTop - WORD_SIZE) *)
+                       (x86.Assembly.instruction_jmp
+                        {target = stackTopMinusWordDeref,
+                         absolute = true})))
+                   end
+                | Raise {live}
+                => let
+                     val exnStack 
+                       = x86MLton.gcState_exnStackContentsOperand ()
+                     val stackTopTemp
+                       = x86MLton.stackTopTempContentsOperand ()
+                     val stackTop 
+                       = x86MLton.gcState_stackTopContentsOperand ()
+                     val stackBottom 
+                       = x86MLton.gcState_stackBottomContentsOperand ()
+                    in
+                      (* flushing at far transfer *)
+                      (farTransfer live
+                       (if !Control.profile <> Control.ProfileNone
+                          then (AppendList.fromList
+                                [(* stackTopTemp = stackBottom + exnStack *)
+                                 x86.Assembly.instruction_mov
+                                 {dst = stackTopTemp,
+                                  src = stackBottom,
+                                  size = pointerSize},
+                                 x86.Assembly.instruction_binal
+                                 {oper = x86.Instruction.ADD,
+                                  dst = stackTopTemp,
+                                  src = exnStack,
+                                  size = pointerSize},
+                                 (* stackTop = stackTopTemp *)
+                                 x86.Assembly.instruction_mov
+                                 {dst = stackTop,
+                                  src = stackTopTemp,
+                                  size = pointerSize},
+                                 profileStackTopCommit'])
+                          else (AppendList.fromList
+                                [(* stackTop = stackBottom + exnStack *)
+                                 x86.Assembly.instruction_mov
+                                 {dst = stackTop,
+                                  src = stackBottom,
+                                  size = pointerSize},
+                                 x86.Assembly.instruction_binal
+                                 {oper = x86.Instruction.ADD,
+                                  dst = stackTop,
+                                  src = exnStack,
+                                  size = pointerSize}]))
+                       (AppendList.single
+                        (* jmp *(stackTop - WORD_SIZE) *)
+                        (x86.Assembly.instruction_jmp
+                         {target = x86MLton.gcState_stackTopMinusWordDerefOperand (),
+                          absolute = true})))
+                    end
+                | CCall {args, frameInfo, func, return}
+                => let
+                     datatype z = datatype CFunction.Convention.t
+                     datatype z = datatype CFunction.Target.t
+                     val CFunction.T {convention,
+                                      maySwitchThreads,
+                                      modifiesFrontier,
+                                      readsStackTop, 
+                                      return = returnTy,
+                                      target,
+                                      writesStackTop, ...} = func
+                     val stackTopMinusWordDeref
+                       = x86MLton.gcState_stackTopMinusWordDerefOperand ()
+                     val Liveness.T {dead, ...}
+                       = livenessTransfer {transfer = transfer,
+                                           liveInfo = liveInfo}
+                     val c_stackP = x86MLton.c_stackPContentsOperand
+                     val c_stackPDerefFloat = x86MLton.c_stackPDerefFloatOperand
+                     val c_stackPDerefDouble = x86MLton.c_stackPDerefDoubleOperand
+                     val applyFFTemp = x86MLton.applyFFTempContentsOperand
+                     val applyFFTemp2 = x86MLton.applyFFTemp2ContentsOperand
+                     val (fptrArg, args) =
+                        case target of 
+                           Direct _ => (AppendList.empty, args)
+                         | Indirect => 
+                              let
+                                 val (fptrArg, args) =
+                                    case args of
+                                       fptrArg::args => (fptrArg, args)
+                                     | _ => Error.bug "x86GenerateTransfers.generateAll: CCall"
+                              in
+                                 (AppendList.single
+                                  (Assembly.instruction_mov
+                                   {src = #1 fptrArg,
+                                    dst = applyFFTemp2,
+                                    size = #2 fptrArg}),
+                                  args)
+                              end
+                     val (pushArgs, size_args)
+                       = List.fold
+                         (args, (AppendList.empty, 0),
+                          fn ((arg, size), (assembly_args, size_args)) =>
+                          (AppendList.append
+                           (if Size.eq (size, Size.DBLE)
+                              then AppendList.fromList
+                                   [Assembly.instruction_binal
+                                    {oper = Instruction.SUB,
+                                     dst = c_stackP,
+                                     src = Operand.immediate_const_int 8,
+                                     size = pointerSize},
+                                    Assembly.instruction_pfmov
+                                    {src = arg,
+                                     dst = c_stackPDerefDouble,
+                                     size = size}]
                             else if Size.eq (size, Size.SNGL)
-			      then AppendList.fromList
-			   	   [Assembly.instruction_binal
-				    {oper = Instruction.SUB,
-				     dst = c_stackP,
-				     src = Operand.immediate_const_int 4,
-				     size = pointerSize},
-				    Assembly.instruction_pfmov
-				    {src = arg,
-				     dst = c_stackPDerefFloat,
-				     size = size}]
-			    else if Size.eq (size, Size.BYTE)
-			      then AppendList.fromList
-			           [Assembly.instruction_movx
-				    {oper = Instruction.MOVZX,
-				     dst = applyFFTemp,
-				     src = arg,
-				     dstsize = wordSize,
-				     srcsize = size},
-				    Assembly.instruction_ppush
-				    {src = applyFFTemp,
-				     base = c_stackP,
-				     size = wordSize}]
-			    else AppendList.single
-				 (Assembly.instruction_ppush
-				  {src = arg,
-				   base = c_stackP,
-				   size = size}),
-				 assembly_args),
-			   (Size.toBytes size) + size_args))
-		     val flush =
-			case frameInfo of
-			   SOME (FrameInfo.T {size, ...}) =>
-			        (* Entering runtime *)
-			        let
-				  val return = valOf return
-				  val _ = enque return
-				    
-				  val stackTopTemp
-				    = x86MLton.stackTopTempContentsOperand ()
-				  val stackTopTempMinusWordDeref'
-				    = x86MLton.stackTopTempMinusWordDeref ()
-				  val stackTopTempMinusWordDeref
-				    = x86MLton.stackTopTempMinusWordDerefOperand ()
-				  val stackTop 
-				    = x86MLton.gcState_stackTopContentsOperand ()
-				  val stackTopMinusWordDeref'
-				    = x86MLton.gcState_stackTopMinusWordDeref ()
-				  val stackTopMinusWordDeref
-				    = x86MLton.gcState_stackTopMinusWordDerefOperand ()
-				  val bytes = x86.Operand.immediate_const_int size
-				    
-				  val live =
-				    x86Liveness.LiveInfo.getLive(liveInfo, return)
-				  val {defs, ...} = Transfer.uses_defs_kills transfer
-				  val live = 
-				    List.fold
-				    (defs,
-				     live,
-				     fn (oper,live) =>
-				     case Operand.deMemloc oper of
-				       SOME memloc =>  LiveSet.remove (live, memloc)
-				     | NONE => live)
-				in
-				  (runtimeTransfer (LiveSet.toMemLocSet live)
-				   (if !Control.profile <> Control.ProfileNone
-				      then (AppendList.fromList
-					    [(* stackTopTemp = stackTop + bytes *)
-					     x86.Assembly.instruction_mov
-					     {dst = stackTopTemp,
-					      src = stackTop,
-					      size = pointerSize},
-					     x86.Assembly.instruction_binal
-					     {oper = x86.Instruction.ADD,
-					      dst = stackTopTemp,
-					      src = bytes,
-					      size = pointerSize},
-					     (* *(stackTopTemp - WORD_SIZE) = return *)
-					     x86.Assembly.instruction_mov
-					     {dst = stackTopTempMinusWordDeref,
-					      src = Operand.immediate_label return,
-					      size = pointerSize},
-					     x86.Assembly.directive_force
-					     {commit_memlocs = MemLocSet.singleton stackTopTempMinusWordDeref',
-					      commit_classes = ClassSet.empty,
-					      remove_memlocs = MemLocSet.empty,
-					      remove_classes = ClassSet.empty,
-					      dead_memlocs = MemLocSet.empty,
-					      dead_classes = ClassSet.empty},
-					     (* stackTop = stackTopTemp *)
-					     x86.Assembly.instruction_mov
-					     {dst = stackTop,
-					      src = stackTopTemp,
-					      size = pointerSize},
-					     profileStackTopCommit'])
-				      else (AppendList.fromList
-					    [(* stackTop += bytes *)
-					     x86.Assembly.instruction_binal 
-					     {oper = x86.Instruction.ADD,
-					      dst = stackTop,
-					      src = bytes, 
-					      size = pointerSize},
-					     (* *(stackTop - WORD_SIZE) = return *)
-					     x86.Assembly.instruction_mov
-					     {dst = stackTopMinusWordDeref,
-					      src = Operand.immediate_label return,
-					      size = pointerSize},
-					     x86.Assembly.directive_force
-					     {commit_memlocs = MemLocSet.singleton stackTopMinusWordDeref',
-					      commit_classes = ClassSet.empty,
-					      remove_memlocs = MemLocSet.empty,
-					      remove_classes = ClassSet.empty,
-					      dead_memlocs = MemLocSet.empty,
-					      dead_classes = ClassSet.empty}]))
-				   (AppendList.single
-				    (Assembly.directive_force
-				     {commit_memlocs = LiveSet.toMemLocSet live,
-				      commit_classes = runtimeClasses,
-				      remove_memlocs = MemLocSet.empty,
-				      remove_classes = ClassSet.empty,
-				      dead_memlocs = MemLocSet.empty,
-				      dead_classes = ClassSet.empty})))
-				end
-			 | NONE => 
-			        AppendList.single
-			        (Assembly.directive_force
-				 {commit_memlocs = let
-						     val s = MemLocSet.empty
-						     val s = if modifiesFrontier
-							       then MemLocSet.add
-								    (s, frontier ())
-							       else s
-						     val s = if readsStackTop
-							       then MemLocSet.add
-								    (s, stackTop ())
-							       else s
-						   in
-						     s
-						   end,
-				  commit_classes = ccallflushClasses,
-				  remove_memlocs = MemLocSet.empty,
-				  remove_classes = ClassSet.empty,
-				  dead_memlocs = LiveSet.toMemLocSet dead,
-				  dead_classes = ClassSet.empty})
-		     val call =
-			case target of
-			   Direct name =>
-			      let
-				 val name = 
-				    case convention of
-				       Cdecl => name
-				     | Stdcall => concat [name, "@", Int.toString size_args]
-			      in
-				 AppendList.fromList
-				 [Assembly.directive_ccall (),
-				  Assembly.instruction_call
-				  {target = Operand.label (Label.fromString name),
-				   absolute = false}]
-			      end
-			 | Indirect =>
-			      AppendList.fromList
-			      [Assembly.directive_ccall (),
-			       Assembly.instruction_call
-			       {target = applyFFTemp2,
-				absolute = true}]
-		     val kill
-		       = if isSome frameInfo
-			   then AppendList.single
-			        (Assembly.directive_force
-				 {commit_memlocs = MemLocSet.empty,
-				  commit_classes = ClassSet.empty,
-				  remove_memlocs = MemLocSet.empty,
-				  remove_classes = ClassSet.empty,
-				  dead_memlocs = MemLocSet.empty,
-				  dead_classes = runtimeClasses})
-			   else AppendList.single
-			        (Assembly.directive_force
-				 {commit_memlocs = MemLocSet.empty,
-				  commit_classes = ClassSet.empty,
-				  remove_memlocs = MemLocSet.empty,
-				  remove_classes = ClassSet.empty,
-				  dead_memlocs = let
-						   val s = MemLocSet.empty
-						   val s = if modifiesFrontier
-							     then MemLocSet.add
-							          (s, frontier ())
-							     else s
-						   val s = if writesStackTop
-							     then MemLocSet.add
-							          (s, stackTop ())
-							     else s
-						 in
-						   s
-						 end,
-				  dead_classes = ccallflushClasses})
-		     val getResult =
-			AppendList.single
-			(Assembly.directive_return
-			 {returns = Operand.cReturnTemps returnTy})
-		     val fixCStack =
-			if size_args > 0
-			   andalso convention = CFunction.Convention.Cdecl
-			   then (AppendList.single
-				 (Assembly.instruction_binal
-				  {oper = Instruction.ADD,
-				   dst = c_stackP,
-				   src = Operand.immediate_const_int size_args,
-				   size = pointerSize}))
-			   else AppendList.empty
-		     val continue
-		       = if maySwitchThreads
-			   then (* Returning from runtime *)
-			        (farTransfer MemLocSet.empty
-				 AppendList.empty
-				 (AppendList.single
-				  (* jmp *(stackTop - WORD_SIZE) *)
-				  (x86.Assembly.instruction_jmp
-				   {target = stackTopMinusWordDeref,
-				    absolute = true})))
-			 else case return
-				of NONE => AppendList.empty
-				 | SOME l => (if isSome frameInfo
-						then (* Don't need to trampoline,
-						      * since didn't switch threads,
-						      * but can't fall because
-						      * frame layout data is prefixed
-						      * to l's code; use fallNone
-						      * to force a jmp with near
-						      * jump assumptions.
-						      *)
-						     fallNone
-						else fall)
-				             gef 
-					     {label = l,
-					      live = getLive (liveInfo, l)}
-		   in
-		     AppendList.appends
-		     [cacheEsp (),
-		      fptrArg,
-		      pushArgs,
-		      flush,
-		      call,
-		      kill,
-		      getResult,
-		      fixCStack,
-		      unreserveEsp (),
-		      continue]
-		   end)
+                              then AppendList.fromList
+                                   [Assembly.instruction_binal
+                                    {oper = Instruction.SUB,
+                                     dst = c_stackP,
+                                     src = Operand.immediate_const_int 4,
+                                     size = pointerSize},
+                                    Assembly.instruction_pfmov
+                                    {src = arg,
+                                     dst = c_stackPDerefFloat,
+                                     size = size}]
+                            else if Size.eq (size, Size.BYTE)
+                              then AppendList.fromList
+                                   [Assembly.instruction_movx
+                                    {oper = Instruction.MOVZX,
+                                     dst = applyFFTemp,
+                                     src = arg,
+                                     dstsize = wordSize,
+                                     srcsize = size},
+                                    Assembly.instruction_ppush
+                                    {src = applyFFTemp,
+                                     base = c_stackP,
+                                     size = wordSize}]
+                            else AppendList.single
+                                 (Assembly.instruction_ppush
+                                  {src = arg,
+                                   base = c_stackP,
+                                   size = size}),
+                                 assembly_args),
+                           (Size.toBytes size) + size_args))
+                     val flush =
+                        case frameInfo of
+                           SOME (FrameInfo.T {size, ...}) =>
+                                (* Entering runtime *)
+                                let
+                                  val return = valOf return
+                                  val _ = enque return
+                                    
+                                  val stackTopTemp
+                                    = x86MLton.stackTopTempContentsOperand ()
+                                  val stackTopTempMinusWordDeref'
+                                    = x86MLton.stackTopTempMinusWordDeref ()
+                                  val stackTopTempMinusWordDeref
+                                    = x86MLton.stackTopTempMinusWordDerefOperand ()
+                                  val stackTop 
+                                    = x86MLton.gcState_stackTopContentsOperand ()
+                                  val stackTopMinusWordDeref'
+                                    = x86MLton.gcState_stackTopMinusWordDeref ()
+                                  val stackTopMinusWordDeref
+                                    = x86MLton.gcState_stackTopMinusWordDerefOperand ()
+                                  val bytes = x86.Operand.immediate_const_int size
+                                    
+                                  val live =
+                                    x86Liveness.LiveInfo.getLive(liveInfo, return)
+                                  val {defs, ...} = Transfer.uses_defs_kills transfer
+                                  val live = 
+                                    List.fold
+                                    (defs,
+                                     live,
+                                     fn (oper,live) =>
+                                     case Operand.deMemloc oper of
+                                       SOME memloc =>  LiveSet.remove (live, memloc)
+                                     | NONE => live)
+                                in
+                                  (runtimeTransfer (LiveSet.toMemLocSet live)
+                                   (if !Control.profile <> Control.ProfileNone
+                                      then (AppendList.fromList
+                                            [(* stackTopTemp = stackTop + bytes *)
+                                             x86.Assembly.instruction_mov
+                                             {dst = stackTopTemp,
+                                              src = stackTop,
+                                              size = pointerSize},
+                                             x86.Assembly.instruction_binal
+                                             {oper = x86.Instruction.ADD,
+                                              dst = stackTopTemp,
+                                              src = bytes,
+                                              size = pointerSize},
+                                             (* *(stackTopTemp - WORD_SIZE) = return *)
+                                             x86.Assembly.instruction_mov
+                                             {dst = stackTopTempMinusWordDeref,
+                                              src = Operand.immediate_label return,
+                                              size = pointerSize},
+                                             x86.Assembly.directive_force
+                                             {commit_memlocs = MemLocSet.singleton stackTopTempMinusWordDeref',
+                                              commit_classes = ClassSet.empty,
+                                              remove_memlocs = MemLocSet.empty,
+                                              remove_classes = ClassSet.empty,
+                                              dead_memlocs = MemLocSet.empty,
+                                              dead_classes = ClassSet.empty},
+                                             (* stackTop = stackTopTemp *)
+                                             x86.Assembly.instruction_mov
+                                             {dst = stackTop,
+                                              src = stackTopTemp,
+                                              size = pointerSize},
+                                             profileStackTopCommit'])
+                                      else (AppendList.fromList
+                                            [(* stackTop += bytes *)
+                                             x86.Assembly.instruction_binal 
+                                             {oper = x86.Instruction.ADD,
+                                              dst = stackTop,
+                                              src = bytes, 
+                                              size = pointerSize},
+                                             (* *(stackTop - WORD_SIZE) = return *)
+                                             x86.Assembly.instruction_mov
+                                             {dst = stackTopMinusWordDeref,
+                                              src = Operand.immediate_label return,
+                                              size = pointerSize},
+                                             x86.Assembly.directive_force
+                                             {commit_memlocs = MemLocSet.singleton stackTopMinusWordDeref',
+                                              commit_classes = ClassSet.empty,
+                                              remove_memlocs = MemLocSet.empty,
+                                              remove_classes = ClassSet.empty,
+                                              dead_memlocs = MemLocSet.empty,
+                                              dead_classes = ClassSet.empty}]))
+                                   (AppendList.single
+                                    (Assembly.directive_force
+                                     {commit_memlocs = LiveSet.toMemLocSet live,
+                                      commit_classes = runtimeClasses,
+                                      remove_memlocs = MemLocSet.empty,
+                                      remove_classes = ClassSet.empty,
+                                      dead_memlocs = MemLocSet.empty,
+                                      dead_classes = ClassSet.empty})))
+                                end
+                         | NONE => 
+                                AppendList.single
+                                (Assembly.directive_force
+                                 {commit_memlocs = let
+                                                     val s = MemLocSet.empty
+                                                     val s = if modifiesFrontier
+                                                               then MemLocSet.add
+                                                                    (s, frontier ())
+                                                               else s
+                                                     val s = if readsStackTop
+                                                               then MemLocSet.add
+                                                                    (s, stackTop ())
+                                                               else s
+                                                   in
+                                                     s
+                                                   end,
+                                  commit_classes = ccallflushClasses,
+                                  remove_memlocs = MemLocSet.empty,
+                                  remove_classes = ClassSet.empty,
+                                  dead_memlocs = LiveSet.toMemLocSet dead,
+                                  dead_classes = ClassSet.empty})
+                     val call =
+                        case target of
+                           Direct name =>
+                              let
+                                 val name = 
+                                    case convention of
+                                       Cdecl => name
+                                     | Stdcall => concat [name, "@", Int.toString size_args]
+                              in
+                                 AppendList.fromList
+                                 [Assembly.directive_ccall (),
+                                  Assembly.instruction_call
+                                  {target = Operand.label (Label.fromString name),
+                                   absolute = false}]
+                              end
+                         | Indirect =>
+                              AppendList.fromList
+                              [Assembly.directive_ccall (),
+                               Assembly.instruction_call
+                               {target = applyFFTemp2,
+                                absolute = true}]
+                     val kill
+                       = if isSome frameInfo
+                           then AppendList.single
+                                (Assembly.directive_force
+                                 {commit_memlocs = MemLocSet.empty,
+                                  commit_classes = ClassSet.empty,
+                                  remove_memlocs = MemLocSet.empty,
+                                  remove_classes = ClassSet.empty,
+                                  dead_memlocs = MemLocSet.empty,
+                                  dead_classes = runtimeClasses})
+                           else AppendList.single
+                                (Assembly.directive_force
+                                 {commit_memlocs = MemLocSet.empty,
+                                  commit_classes = ClassSet.empty,
+                                  remove_memlocs = MemLocSet.empty,
+                                  remove_classes = ClassSet.empty,
+                                  dead_memlocs = let
+                                                   val s = MemLocSet.empty
+                                                   val s = if modifiesFrontier
+                                                             then MemLocSet.add
+                                                                  (s, frontier ())
+                                                             else s
+                                                   val s = if writesStackTop
+                                                             then MemLocSet.add
+                                                                  (s, stackTop ())
+                                                             else s
+                                                 in
+                                                   s
+                                                 end,
+                                  dead_classes = ccallflushClasses})
+                     val getResult =
+                        AppendList.single
+                        (Assembly.directive_return
+                         {returns = Operand.cReturnTemps returnTy})
+                     val fixCStack =
+                        if size_args > 0
+                           andalso convention = CFunction.Convention.Cdecl
+                           then (AppendList.single
+                                 (Assembly.instruction_binal
+                                  {oper = Instruction.ADD,
+                                   dst = c_stackP,
+                                   src = Operand.immediate_const_int size_args,
+                                   size = pointerSize}))
+                           else AppendList.empty
+                     val continue
+                       = if maySwitchThreads
+                           then (* Returning from runtime *)
+                                (farTransfer MemLocSet.empty
+                                 AppendList.empty
+                                 (AppendList.single
+                                  (* jmp *(stackTop - WORD_SIZE) *)
+                                  (x86.Assembly.instruction_jmp
+                                   {target = stackTopMinusWordDeref,
+                                    absolute = true})))
+                         else case return
+                                of NONE => AppendList.empty
+                                 | SOME l => (if isSome frameInfo
+                                                then (* Don't need to trampoline,
+                                                      * since didn't switch threads,
+                                                      * but can't fall because
+                                                      * frame layout data is prefixed
+                                                      * to l's code; use fallNone
+                                                      * to force a jmp with near
+                                                      * jump assumptions.
+                                                      *)
+                                                     fallNone
+                                                else fall)
+                                             gef 
+                                             {label = l,
+                                              live = getLive (liveInfo, l)}
+                   in
+                     AppendList.appends
+                     [cacheEsp (),
+                      fptrArg,
+                      pushArgs,
+                      flush,
+                      call,
+                      kill,
+                      getResult,
+                      fixCStack,
+                      unreserveEsp (),
+                      continue]
+                   end)
 
         and effectJumpTable (gef as GEF {...})
-	                     {label, transfer} : Assembly.t AppendList.t
-	  = case transfer
-	      of Switch {test, cases, default}
-	       => let
-		     type 'a ops =
-			{zero: 'a,
-			 even: 'a -> bool,
-			 incFn: 'a -> 'a,
-			 decFn: 'a -> 'a,
-			 halfFn: 'a -> 'a,
-			 ltFn: 'a * 'a -> bool,
-			 gtFn: 'a * 'a -> bool,
-			 min: 'a,
-			 minFn: 'a * 'a -> 'a,
-			 max: 'a,
-			 maxFn: 'a * 'a -> 'a,
-			 range: 'a * 'a -> int}
+                             {label, transfer} : Assembly.t AppendList.t
+          = case transfer
+              of Switch {test, cases, default}
+               => let
+                     type 'a ops =
+                        {zero: 'a,
+                         even: 'a -> bool,
+                         incFn: 'a -> 'a,
+                         decFn: 'a -> 'a,
+                         halfFn: 'a -> 'a,
+                         ltFn: 'a * 'a -> bool,
+                         gtFn: 'a * 'a -> bool,
+                         min: 'a,
+                         minFn: 'a * 'a -> 'a,
+                         max: 'a,
+                         maxFn: 'a * 'a -> 'a,
+                         range: 'a * 'a -> word}
 
-		    val Liveness.T {dead, ...}
-		      = livenessTransfer {transfer = transfer,
-					  liveInfo = liveInfo}
+                    val Liveness.T {dead, ...}
+                      = livenessTransfer {transfer = transfer,
+                                          liveInfo = liveInfo}
 
-		    fun reduce(cases,
-			       {even,
-				decFn, halfFn,
-				min, minFn,
-				max, maxFn,
-				...} : 'a ops)
-		      = let
-			  fun reduce' cases
-			    = let
-				val (minK,maxK,length,
-				     allEven,allOdd)
-				  = List.fold
-				    (cases,
-				     (max, min, 0,
-				      true, true),
-				     fn ((k,_),
-					 (minK,maxK,length,
-					  allEven,allOdd))
-				      => let
-					   val isEven = even k
-					 in
-					   (minFn(k,minK),
-					    maxFn(k,maxK),
-					    length + 1,
-					    allEven andalso isEven,
-					    allOdd andalso not isEven)
-					 end)
-			      in
-				if length > 1 andalso
-				   (allEven orelse allOdd)
-				  then let
-					 val f = if allOdd
-						   then halfFn o decFn
-						   else halfFn
-					 val cases' 
-					   = List.map
-					     (cases,
-					      fn (k,target)
-					       => (f k, target))
-					     
-					 val (cases'', 
-					      minK'', maxK'', length'',
-					      shift'', mask'')
-					   = reduce' cases'
+                    fun reduce(cases,
+                               {even,
+                                decFn, halfFn,
+                                min, minFn,
+                                max, maxFn,
+                                ...} : 'a ops)
+                      = let
+                          fun reduce' cases
+                            = let
+                                val (minK,maxK,length,
+                                     allEven,allOdd)
+                                  = List.fold
+                                    (cases,
+                                     (max, min, 0,
+                                      true, true),
+                                     fn ((k,_),
+                                         (minK,maxK,length,
+                                          allEven,allOdd))
+                                      => let
+                                           val isEven = even k
+                                         in
+                                           (minFn(k,minK),
+                                            maxFn(k,maxK),
+                                            length + 1,
+                                            allEven andalso isEven,
+                                            allOdd andalso not isEven)
+                                         end)
+                              in
+                                if length > 1 andalso
+                                   (allEven orelse allOdd)
+                                  then let
+                                         val f = if allOdd
+                                                   then halfFn o decFn
+                                                   else halfFn
+                                         val cases' 
+                                           = List.map
+                                             (cases,
+                                              fn (k,target)
+                                               => (f k, target))
+                                             
+                                         val (cases'', 
+                                              minK'', maxK'', length'',
+                                              shift'', mask'')
+                                           = reduce' cases'
 
-					 val shift' = 1 + shift''
-					 val mask' 
-					   = Word.orb
-					     (Word.<<(mask'', 0wx1),
-					      if allOdd
-						then 0wx1
-						else 0wx0)
-				       in
-					 (cases'', 
-					  minK'', maxK'', length'',
-					  shift', mask')
-				       end
-				  else (cases, 
-					minK, maxK, length,
-					0, 0wx0)
-			      end
-			in 
-			  reduce' cases
-			end
-		      
-		    fun doitTable(cases,
-				  {zero,
-				   incFn, 
-				   ...} : ''a ops,
-				  minK, _, rangeK, shift, mask,
-				  constFn)
-		      = let
-			  val jump_table_label
-			    = Label.newString "jumpTable"
+                                         val shift' = 1 + shift''
+                                         val mask' 
+                                           = Word.orb
+                                             (Word.<<(mask'', 0wx1),
+                                              if allOdd
+                                                then 0wx1
+                                                else 0wx0)
+                                       in
+                                         (cases'', 
+                                          minK'', maxK'', length'',
+                                          shift', mask')
+                                       end
+                                  else (cases, 
+                                        minK, maxK, length,
+                                        0, 0wx0)
+                              end
+                        in 
+                          reduce' cases
+                        end
+                      
+                    fun doitTable(cases,
+                                  {zero,
+                                   incFn, 
+                                   ...} : ''a ops,
+                                  minK, _, rangeK, shift, mask,
+                                  constFn)
+                      = let
+                          val jump_table_label
+                            = Label.newString "jumpTable"
 
-			  val idT = Directive.Id.new ()
-			  val defaultT = pushCompensationBlock
-			                 {label = default,
-					  id = idT}
+                          val idT = Directive.Id.new ()
+                          val defaultT = pushCompensationBlock
+                                         {label = default,
+                                          id = idT}
 
-			  val rec filler 
-			    = fn ([],_) => []
-			       | (cases as (i,target)::cases',j)
-			       => if i = j
-				    then let
-					   val target'
-					     = pushCompensationBlock
-					       {label = target,
-						id = idT}
-					 in 
-					   (Immediate.label target')::
-					   (filler(cases', incFn j))
-					 end 
-				    else (Immediate.label defaultT)::
-				         (filler(cases, incFn j))
+                          val rec filler 
+                            = fn ([],_) => []
+                               | (cases as (i,target)::cases',j)
+                               => if i = j
+                                    then let
+                                           val target'
+                                             = pushCompensationBlock
+                                               {label = target,
+                                                id = idT}
+                                         in 
+                                           (Immediate.label target')::
+                                           (filler(cases', incFn j))
+                                         end 
+                                    else (Immediate.label defaultT)::
+                                         (filler(cases, incFn j))
 
-			  val jump_table = filler (cases, minK)
+                          val jump_table = filler (cases, minK)
 
-			  val default_live = getLive(liveInfo, default)
-			  val live
-			    = List.fold
-			      (cases,
-			       default_live,
-			       fn ((_,target), live)
-			        => LiveSet.+(live, getLive(liveInfo, target)))
+                          val default_live = getLive(liveInfo, default)
+                          val live
+                            = List.fold
+                              (cases,
+                               default_live,
+                               fn ((_,target), live)
+                                => LiveSet.+(live, getLive(liveInfo, target)))
 
-			  val indexTemp
-			    = MemLoc.imm 
-			      {base = Immediate.label (Label.fromString "indexTemp"),
-			       index = Immediate.const_int 0,
-			       scale = Scale.Four,
-			       size = Size.LONG,
-			       class = MemLoc.Class.Temp}
-			  val checkTemp
-			    = MemLoc.imm 
-			      {base = Immediate.label (Label.fromString "checkTemp"),
-			       index = Immediate.const_int 0,
-			       scale = Scale.Four,
-			       size = Size.LONG,
-			       class = MemLoc.Class.Temp}
-			  val address
-			    = MemLoc.basic
-			      {base = Immediate.label jump_table_label,
-			       index = indexTemp,
-			       scale = Scale.Four,
-			       size = Size.LONG,
-			       class = MemLoc.Class.Code}
-			      
-			  val size 
-			    = case Operand.size test
-				of SOME size => size
-				 | NONE => Size.LONG
-			  val indexTemp' = indexTemp
-			  val indexTemp = Operand.memloc indexTemp
-			  val checkTemp' = checkTemp
-			  val checkTemp = Operand.memloc checkTemp
-			  val address = Operand.memloc address
-			in
-			  AppendList.appends
-			  [if Size.lt(size, Size.LONG)
-			     then AppendList.single
-			          (Assembly.instruction_movx
-				   {oper = Instruction.MOVZX,
-				    src = test,
-				    srcsize = size,
-				    dst = indexTemp,
-				    dstsize = Size.LONG})
-			     else AppendList.single
-			          (Assembly.instruction_mov
-				   {src = test,
-				    dst = indexTemp,
-				    size = Size.LONG}),
-			   if LiveSet.isEmpty dead
-			     then AppendList.empty
-			     else AppendList.single
-			          (Assembly.directive_force
-				   {commit_memlocs = MemLocSet.empty,
-				    commit_classes = ClassSet.empty,
-				    remove_memlocs = MemLocSet.empty,
-				    remove_classes = ClassSet.empty,
-				    dead_memlocs = LiveSet.toMemLocSet dead,
-				    dead_classes = ClassSet.empty}),
-			   if shift > 0
-			     then let
-				    val idC = Directive.Id.new ()
-				    val defaultC = pushCompensationBlock
-				                   {label = default,
-						    id = idC}
-				    val _ = incNear(jumpInfo, default)
-				  in
-				    AppendList.appends
-				    [AppendList.fromList
-				     [Assembly.instruction_mov
-				      {src = indexTemp,
-				       dst = checkTemp,
-				       size = Size.LONG},
-				      Assembly.instruction_binal
-				      {oper = Instruction.AND,
-				       src = Operand.immediate_const_word 
-				             (ones shift),
-				       dst = checkTemp,
-				       size = Size.LONG}],
-				     if mask = 0wx0
-				       then AppendList.empty
-				       else AppendList.single
-					    (Assembly.instruction_binal
-					     {oper = Instruction.SUB,
-					      src = Operand.immediate_const_word mask,
-					      dst = checkTemp,
-					      size = Size.LONG}),
-				     AppendList.fromList
-				     [Assembly.directive_force
-				      {commit_memlocs = MemLocSet.empty,
-				       commit_classes = nearflushClasses,
-				       remove_memlocs = MemLocSet.empty,
-				       remove_classes = ClassSet.empty,
-				       dead_memlocs = MemLocSet.singleton checkTemp',
-				       dead_classes = ClassSet.empty},
-				      Assembly.directive_saveregalloc
-				      {id = idC,
-				       live = MemLocSet.add
-				              (MemLocSet.add
-					       (LiveSet.toMemLocSet default_live,
-						stackTop ()),
-					       frontier ())},
-				      Assembly.instruction_jcc
-				      {condition = Instruction.NZ,
-				       target = Operand.label defaultC},
-				      Assembly.instruction_sral
-				      {oper = Instruction.SAR,
-				       count = Operand.immediate_const_int shift,
-				       dst = indexTemp,
-				       size = Size.LONG}]]
-				  end
-			     else AppendList.empty,
-			   if minK = zero
-			     then AppendList.empty
-			     else AppendList.single
-			          (Assembly.instruction_binal
-				   {oper = Instruction.SUB,
-				    src = Operand.immediate (constFn minK),
-				    dst = indexTemp,
-				    size = Size.LONG}),
-			  AppendList.fromList
-			  [Assembly.directive_force
-			   {commit_memlocs = MemLocSet.empty,
-			    commit_classes = nearflushClasses,
-			    remove_memlocs = MemLocSet.empty,
-			    remove_classes = ClassSet.empty,
-			    dead_memlocs = MemLocSet.empty,
-			    dead_classes = ClassSet.empty},
-			   Assembly.directive_cache
-			   {caches = [{register = indexReg,
-				       memloc = indexTemp',
-				       reserve = false}]},
-			   Assembly.instruction_cmp
-			   {src1 = indexTemp,
-			    src2 = Operand.immediate_const_int rangeK,
-			    size = Size.LONG},
-			   Assembly.directive_saveregalloc
-			   {id = idT,
-			    live = MemLocSet.add
-				   (MemLocSet.add
-				    (LiveSet.toMemLocSet live,
-				     stackTop ()),
-				    frontier ())},
-			   Assembly.instruction_jcc
-			   {condition = Instruction.AE,
-			    target = Operand.label defaultT},
-			   Assembly.instruction_jmp
-			   {target = address,
-			    absolute = true},
-			   Assembly.directive_force
-			   {commit_memlocs = MemLocSet.empty,
-			    commit_classes = ClassSet.empty,
-			    remove_memlocs = MemLocSet.empty,
-			    remove_classes = ClassSet.empty,
-			    dead_memlocs = MemLocSet.singleton indexTemp',
-			    dead_classes = ClassSet.empty}],
-			  AppendList.fromList
-			  [Assembly.pseudoop_data (),
-			   Assembly.pseudoop_p2align 
-			   (Immediate.const_int 4, NONE, NONE),
-			   Assembly.label jump_table_label,
-			   Assembly.pseudoop_long jump_table,
-			   Assembly.pseudoop_text ()]]
-			end
+                          val indexTemp
+                            = MemLoc.imm 
+                              {base = Immediate.label (Label.fromString "indexTemp"),
+                               index = Immediate.const_int 0,
+                               scale = Scale.Four,
+                               size = Size.LONG,
+                               class = MemLoc.Class.Temp}
+                          val checkTemp
+                            = MemLoc.imm 
+                              {base = Immediate.label (Label.fromString "checkTemp"),
+                               index = Immediate.const_int 0,
+                               scale = Scale.Four,
+                               size = Size.LONG,
+                               class = MemLoc.Class.Temp}
+                          val address
+                            = MemLoc.basic
+                              {base = Immediate.label jump_table_label,
+                               index = indexTemp,
+                               scale = Scale.Four,
+                               size = Size.LONG,
+                               class = MemLoc.Class.Code}
+                              
+                          val size 
+                            = case Operand.size test
+                                of SOME size => size
+                                 | NONE => Size.LONG
+                          val indexTemp' = indexTemp
+                          val indexTemp = Operand.memloc indexTemp
+                          val checkTemp' = checkTemp
+                          val checkTemp = Operand.memloc checkTemp
+                          val address = Operand.memloc address
+                        in
+                          AppendList.appends
+                          [if Size.lt(size, Size.LONG)
+                             then AppendList.single
+                                  (Assembly.instruction_movx
+                                   {oper = Instruction.MOVZX,
+                                    src = test,
+                                    srcsize = size,
+                                    dst = indexTemp,
+                                    dstsize = Size.LONG})
+                             else AppendList.single
+                                  (Assembly.instruction_mov
+                                   {src = test,
+                                    dst = indexTemp,
+                                    size = Size.LONG}),
+                           if LiveSet.isEmpty dead
+                             then AppendList.empty
+                             else AppendList.single
+                                  (Assembly.directive_force
+                                   {commit_memlocs = MemLocSet.empty,
+                                    commit_classes = ClassSet.empty,
+                                    remove_memlocs = MemLocSet.empty,
+                                    remove_classes = ClassSet.empty,
+                                    dead_memlocs = LiveSet.toMemLocSet dead,
+                                    dead_classes = ClassSet.empty}),
+                           if shift > 0
+                             then let
+                                    val idC = Directive.Id.new ()
+                                    val defaultC = pushCompensationBlock
+                                                   {label = default,
+                                                    id = idC}
+                                    val _ = incNear(jumpInfo, default)
+                                  in
+                                    AppendList.appends
+                                    [AppendList.fromList
+                                     [Assembly.instruction_mov
+                                      {src = indexTemp,
+                                       dst = checkTemp,
+                                       size = Size.LONG},
+                                      Assembly.instruction_binal
+                                      {oper = Instruction.AND,
+                                       src = Operand.immediate_const_word 
+                                             (ones shift),
+                                       dst = checkTemp,
+                                       size = Size.LONG}],
+                                     if mask = 0wx0
+                                       then AppendList.empty
+                                       else AppendList.single
+                                            (Assembly.instruction_binal
+                                             {oper = Instruction.SUB,
+                                              src = Operand.immediate_const_word mask,
+                                              dst = checkTemp,
+                                              size = Size.LONG}),
+                                     AppendList.fromList
+                                     [Assembly.directive_force
+                                      {commit_memlocs = MemLocSet.empty,
+                                       commit_classes = nearflushClasses,
+                                       remove_memlocs = MemLocSet.empty,
+                                       remove_classes = ClassSet.empty,
+                                       dead_memlocs = MemLocSet.singleton checkTemp',
+                                       dead_classes = ClassSet.empty},
+                                      Assembly.directive_saveregalloc
+                                      {id = idC,
+                                       live = MemLocSet.add
+                                              (MemLocSet.add
+                                               (LiveSet.toMemLocSet default_live,
+                                                stackTop ()),
+                                               frontier ())},
+                                      Assembly.instruction_jcc
+                                      {condition = Instruction.NZ,
+                                       target = Operand.label defaultC},
+                                      Assembly.instruction_sral
+                                      {oper = Instruction.SAR,
+                                       count = Operand.immediate_const_int shift,
+                                       dst = indexTemp,
+                                       size = Size.LONG}]]
+                                  end
+                             else AppendList.empty,
+                           if minK = zero
+                             then AppendList.empty
+                             else AppendList.single
+                                  (Assembly.instruction_binal
+                                   {oper = Instruction.SUB,
+                                    src = Operand.immediate (constFn minK),
+                                    dst = indexTemp,
+                                    size = Size.LONG}),
+                          AppendList.fromList
+                          [Assembly.directive_force
+                           {commit_memlocs = MemLocSet.empty,
+                            commit_classes = nearflushClasses,
+                            remove_memlocs = MemLocSet.empty,
+                            remove_classes = ClassSet.empty,
+                            dead_memlocs = MemLocSet.empty,
+                            dead_classes = ClassSet.empty},
+                           Assembly.directive_cache
+                           {caches = [{register = indexReg,
+                                       memloc = indexTemp',
+                                       reserve = false}]},
+                           Assembly.instruction_cmp
+                           {src1 = indexTemp,
+                            src2 = Operand.immediate_const_word rangeK,
+                            size = Size.LONG},
+                           Assembly.directive_saveregalloc
+                           {id = idT,
+                            live = MemLocSet.add
+                                   (MemLocSet.add
+                                    (LiveSet.toMemLocSet live,
+                                     stackTop ()),
+                                    frontier ())},
+                           Assembly.instruction_jcc
+                           {condition = Instruction.A,
+                            target = Operand.label defaultT},
+                           Assembly.instruction_jmp
+                           {target = address,
+                            absolute = true},
+                           Assembly.directive_force
+                           {commit_memlocs = MemLocSet.empty,
+                            commit_classes = ClassSet.empty,
+                            remove_memlocs = MemLocSet.empty,
+                            remove_classes = ClassSet.empty,
+                            dead_memlocs = MemLocSet.singleton indexTemp',
+                            dead_classes = ClassSet.empty}],
+                          AppendList.fromList
+                          [Assembly.pseudoop_data (),
+                           Assembly.pseudoop_p2align 
+                           (Immediate.const_int 4, NONE, NONE),
+                           Assembly.label jump_table_label,
+                           Assembly.pseudoop_long jump_table,
+                           Assembly.pseudoop_text ()]]
+                        end
 
-		    fun doit(cases,
-			     ops as {ltFn, 
-				     range,
-				     ...} : ''a ops,
-			     constFn)
-		      = let
-			  val (cases, 
-			       minK, maxK, length,
-			       shift, mask) 
-			    = reduce(cases, ops)
-			    
-			  val rangeK 
-			    = SOME (range(minK,maxK))
-			      handle Overflow
-			       => NONE
-			in
-			  if length >= 8 
-			     andalso
-			     (isSome rangeK
-			      andalso
-			      valOf rangeK <= 2 * length)
-			    then let
-				   val rangeK = valOf rangeK
+                    fun doit(cases,
+                             ops as {ltFn, 
+                                     range,
+                                     ...} : ''a ops,
+                             constFn)
+                      = let
+                          val (cases, 
+                               minK, maxK, length,
+                               shift, mask) 
+                            = reduce(cases, ops)
+                            
+                          val rangeK 
+                            = range(minK,maxK)
+                        in
+                          if length >= 8 
+                             andalso
+                             Word.div(rangeK,0wx2) <= Word.fromInt length
+                            then let
+                                   val cases 
+                                     = List.insertionSort
+                                       (cases, 
+                                        fn ((k,_),(k',_)) 
+                                         => ltFn(k,k'))
+                                 in 
+                                   doitTable(cases, 
+                                             ops,
+                                             minK, maxK, rangeK,
+                                             shift, mask,
+                                             constFn)
+                                 end
+                            else effectDefault gef
+                                               {label = label, 
+                                                transfer = transfer}
+                        end
+                  in
+                    case cases
+                      of Transfer.Cases.Word cases
+                       => doit
+                          (cases,
+                           {zero = 0wx0,
+                            even = fn w => Word.mod(w,0wx2) = 0wx0,
+                            incFn = fn x => Word.+(x,0wx1),
+                            decFn = fn x => Word.-(x,0wx1),
+                            halfFn = fn x => Word.div(x,0wx2),
+                            ltFn = Word.<,
+                            gtFn = Word.>,
+                            min = 0wx0,
+                            minFn = Word.min,
+                            max = 0wxFFFFFFFF,
+                            maxFn = Word.max,
+                            range = fn (min,max) => max - min},
+                           Immediate.const_word)
+                  end
+               | _ => effectDefault gef 
+                                    {label = label,
+                                     transfer = transfer}
 
-				   val cases 
-				     = List.insertionSort
-				       (cases, 
-					fn ((k,_),(k',_)) 
-					 => ltFn(k,k'))
-				 in 
-				   doitTable(cases, 
-					     ops,
-					     minK, maxK, rangeK,
-					     shift, mask,
-					     constFn)
-				 end
-			    else effectDefault gef
-			                       {label = label, 
-						transfer = transfer}
-			end
-		  in
-		    case cases
-		      of Transfer.Cases.Char cases
-		       => doit
-			  (cases,
-			   {zero = #"\000",
-			    even = fn c => (Char.ord c) mod 2 = 0,
-			    incFn = Char.succ,
-			    decFn = Char.pred,
-			    halfFn = fn c => Char.chr((Char.ord c) div 2),
-			    ltFn = Char.<,
-			    gtFn = Char.>,
-			    min = Char.minChar,
-			    minFn = Char.min,
-			    max = Char.maxChar,
-			    maxFn = Char.max,
-			    range = fn (min,max) => ((Char.ord max) - 
-						     (Char.ord min)) + 1},
-			   Immediate.const_char)
-		       | Transfer.Cases.Int cases
-		       => doit
-			  (cases,
-			   {zero = 0,
-			    even = fn i => i mod 2 = 0,
-			    incFn = fn i => i + 1,
-			    decFn = fn i => i - 1,
-			    halfFn = fn i => i div 2,
-			    ltFn = Int.<,
-			    gtFn = Int.>,
-			    min = Int.minInt,
-			    minFn = Int.min,
-			    max = Int.maxInt,
-			    maxFn = Int.max,
-			    range = fn (min,max) => max - min + 1},
-			   Immediate.const_int)
-		       | Transfer.Cases.Word cases
-		       => doit
-			  (cases,
-			   {zero = 0wx0,
-			    even = fn w => Word.mod(w,0wx2) = 0wx0,
-			    incFn = fn x => Word.+(x,0wx1),
-			    decFn = fn x => Word.-(x,0wx1),
-			    halfFn = fn x => Word.div(x,0wx2),
-			    ltFn = Word.<,
-			    gtFn = Word.>,
-			    min = 0wx0,
-			    minFn = Word.min,
-			    max = 0wxFFFFFFFF,
-			    maxFn = Word.max,
-			    range = fn (min,max) => ((Word.toInt max) -
-						     (Word.toInt min) + 
-						     1)},
-			   Immediate.const_word)
-		  end
-	       | _ => effectDefault gef 
-		                    {label = label,
-				     transfer = transfer}
+        and fallNone (GEF {...})
+                     {label, live} : Assembly.t AppendList.t
+          = let
+              val liveRegsTransfer = getLiveRegsTransfers
+                                     (liveTransfers, label)
+              val liveFltRegsTransfer = getLiveFltRegsTransfers
+                                        (liveTransfers, label)
 
-	and fallNone (GEF {...})
-	             {label, live} : Assembly.t AppendList.t
-	  = let
-	      val liveRegsTransfer = getLiveRegsTransfers
-		                     (liveTransfers, label)
-	      val liveFltRegsTransfer = getLiveFltRegsTransfers
-		                        (liveTransfers, label)
+              val live
+                = List.fold
+                  (liveRegsTransfer,
+                   live,
+                   fn ((memloc,_,_),live)
+                    => LiveSet.remove(live,memloc))
+              val live
+                = List.fold
+                  (liveFltRegsTransfer,
+                   live,
+                   fn ((memloc,_),live)
+                    => LiveSet.remove(live,memloc))
 
-	      val live
-		= List.fold
-		  (liveRegsTransfer,
-		   live,
-		   fn ((memloc,_,_),live)
-		    => LiveSet.remove(live,memloc))
-	      val live
-		= List.fold
-		  (liveFltRegsTransfer,
-		   live,
-		   fn ((memloc,_),live)
-		    => LiveSet.remove(live,memloc))
+              fun default ()
+                = AppendList.fromList
+                  ((* flushing at near transfer *)
+                   (Assembly.directive_cache
+                    {caches = [{register = stackTopReg,
+                                memloc = stackTop (),
+                                reserve = true},
+                               {register = frontierReg,
+                                memloc = frontier (),
+                                reserve = true}]})::
+                   (Assembly.directive_fltcache
+                    {caches 
+                     = List.map
+                       (liveFltRegsTransfer,
+                        fn (memloc,_) 
+                         => {memloc = memloc})})::
+                   (Assembly.directive_cache
+                    {caches
+                     = List.map
+                       (liveRegsTransfer,
+                        fn (temp,register,_)
+                         => {register = register,
+                             memloc = temp,
+                             reserve = true})})::
+                   (Assembly.directive_force
+                    {commit_memlocs = LiveSet.toMemLocSet live,
+                     commit_classes = nearflushClasses,
+                     remove_memlocs = MemLocSet.empty,
+                     remove_classes = ClassSet.empty,
+                     dead_memlocs = MemLocSet.empty,
+                     dead_classes = ClassSet.empty})::
+                   (Assembly.instruction_jmp
+                    {target = Operand.label label,
+                     absolute = false})::
+                   (Assembly.directive_unreserve
+                    {registers
+                     = (stackTopReg)::
+                       (frontierReg)::
+                       (List.map
+                        (liveRegsTransfer,
+                         fn (_,register,_)
+                          => register))})::
+                   nil)
+            in
+              case getLayoutInfo label
+                of NONE
+                 => default ()
+                 | SOME (Block.T {...})
+                 => (push label;
+                     default ())
+            end
 
-	      fun default ()
-		= AppendList.fromList
-		  ((* flushing at near transfer *)
-		   (Assembly.directive_cache
-		    {caches = [{register = stackTopReg,
-				memloc = stackTop (),
-				reserve = true},
-			       {register = frontierReg,
-				memloc = frontier (),
-				reserve = true}]})::
-		   (Assembly.directive_fltcache
-		    {caches 
-		     = List.map
-		       (liveFltRegsTransfer,
-			fn (memloc,_) 
-			 => {memloc = memloc})})::
-		   (Assembly.directive_cache
-		    {caches
-		     = List.map
-		       (liveRegsTransfer,
-			fn (temp,register,_)
-			 => {register = register,
-			     memloc = temp,
-			     reserve = true})})::
-		   (Assembly.directive_force
-		    {commit_memlocs = LiveSet.toMemLocSet live,
-		     commit_classes = nearflushClasses,
-		     remove_memlocs = MemLocSet.empty,
-		     remove_classes = ClassSet.empty,
-		     dead_memlocs = MemLocSet.empty,
-		     dead_classes = ClassSet.empty})::
-		   (Assembly.instruction_jmp
-		    {target = Operand.label label,
-		     absolute = false})::
-		   (Assembly.directive_unreserve
-		    {registers
-		     = (stackTopReg)::
-		       (frontierReg)::
-		       (List.map
-			(liveRegsTransfer,
-			 fn (_,register,_)
-			  => register))})::
-		   nil)
-	    in
-	      case getLayoutInfo label
-		of NONE
-		 => default ()
-		 | SOME (Block.T {...})
-		 => (push label;
-		     default ())
-	    end
+        and fallDefault (gef as GEF {generate,...})
+                        {label, live} : Assembly.t AppendList.t
+          = let 
+              datatype z = datatype x86JumpInfo.status
+              val liveRegsTransfer = getLiveRegsTransfers
+                                     (liveTransfers, label)
+              val liveFltRegsTransfer = getLiveFltRegsTransfers
+                                        (liveTransfers, label)
 
-	and fallDefault (gef as GEF {generate,...})
-	                {label, live} : Assembly.t AppendList.t
-	  = let	
-	      datatype z = datatype x86JumpInfo.status
-	      val liveRegsTransfer = getLiveRegsTransfers
-		                     (liveTransfers, label)
-	      val liveFltRegsTransfer = getLiveFltRegsTransfers
-		                        (liveTransfers, label)
+              val live
+                = List.fold
+                  (liveRegsTransfer,
+                   live,
+                   fn ((memloc,_,_),live)
+                    => LiveSet.remove(live,memloc))
+              val live
+                = List.fold
+                  (liveFltRegsTransfer,
+                   live,
+                   fn ((memloc,_),live)
+                    => LiveSet.remove(live,memloc))
 
-	      val live
-		= List.fold
-		  (liveRegsTransfer,
-		   live,
-		   fn ((memloc,_,_),live)
-		    => LiveSet.remove(live,memloc))
-	      val live
-		= List.fold
-		  (liveFltRegsTransfer,
-		   live,
-		   fn ((memloc,_),live)
-		    => LiveSet.remove(live,memloc))
+              fun default jmp
+                = AppendList.appends
+                  [AppendList.fromList
+                   [(* flushing at near transfer *)
+                    (Assembly.directive_cache
+                     {caches = [{register = stackTopReg,
+                                 memloc = stackTop (),
+                                 reserve = true},
+                                {register = frontierReg,
+                                 memloc = frontier (),
+                                 reserve = true}]}),
+                    (Assembly.directive_fltcache
+                     {caches 
+                      = List.map
+                        (liveFltRegsTransfer,
+                         fn (memloc,_) 
+                          => {memloc = memloc})}),
+                    (Assembly.directive_cache
+                     {caches
+                      = List.map
+                        (liveRegsTransfer,
+                         fn (temp,register,_)
+                          => {register = register,
+                              memloc = temp,
+                              reserve = true})}),
+                    (Assembly.directive_force
+                     {commit_memlocs = LiveSet.toMemLocSet live,
+                      commit_classes = nearflushClasses,
+                      remove_memlocs = MemLocSet.empty,
+                      remove_classes = ClassSet.empty,
+                      dead_memlocs = MemLocSet.empty,
+                      dead_classes = ClassSet.empty})],
+                   if jmp
+                     then AppendList.single
+                          (Assembly.instruction_jmp
+                           {target = Operand.label label,
+                            absolute = false})
+                     else AppendList.empty,
+                   AppendList.single
+                   (Assembly.directive_unreserve
+                    {registers
+                     = (stackTopReg)::
+                       (frontierReg)::
+                       (List.map
+                        (liveRegsTransfer,
+                         fn (_,register,_)
+                          => register))})]
+            in
+              case getLayoutInfo label
+                of NONE 
+                 => default true
+                 | SOME (Block.T {...})
+                 => (case getNear(jumpInfo, label)
+                       of Count 1 
+                        => generate gef
+                                    {label = label,
+                                     falling = true,
+                                     unique = true}
+                        | _ => AppendList.append
+                               (default false,
+                                AppendList.cons
+                                (Assembly.directive_reset (),
+                                 (generate gef
+                                           {label = label,
+                                            falling = true,
+                                            unique = false}))))
+            end
+          
+        fun make {generate, effect, fall}
+          = generate (GEF {generate = generate,
+                           effect = effect,
+                           fall = fall})
 
-	      fun default jmp
-		= AppendList.appends
-		  [AppendList.fromList
-		   [(* flushing at near transfer *)
-		    (Assembly.directive_cache
-		     {caches = [{register = stackTopReg,
-				 memloc = stackTop (),
-				 reserve = true},
-				{register = frontierReg,
-				 memloc = frontier (),
-				 reserve = true}]}),
-		    (Assembly.directive_fltcache
-		     {caches 
-		      = List.map
-		        (liveFltRegsTransfer,
-			 fn (memloc,_) 
-			  => {memloc = memloc})}),
-		    (Assembly.directive_cache
-		     {caches
-		      = List.map
-		        (liveRegsTransfer,
-			 fn (temp,register,_)
-			  => {register = register,
-			      memloc = temp,
-			      reserve = true})}),
-		    (Assembly.directive_force
-		     {commit_memlocs = LiveSet.toMemLocSet live,
-		      commit_classes = nearflushClasses,
-		      remove_memlocs = MemLocSet.empty,
-		      remove_classes = ClassSet.empty,
-		      dead_memlocs = MemLocSet.empty,
-		      dead_classes = ClassSet.empty})],
-		   if jmp
-		     then AppendList.single
-		          (Assembly.instruction_jmp
-			   {target = Operand.label label,
-			    absolute = false})
-		     else AppendList.empty,
-		   AppendList.single
-		   (Assembly.directive_unreserve
-		    {registers
-		     = (stackTopReg)::
-		       (frontierReg)::
-		       (List.map
-			(liveRegsTransfer,
-			 fn (_,register,_)
-			  => register))})]
-	    in
-	      case getLayoutInfo label
-		of NONE 
-		 => default true
-		 | SOME (Block.T {...})
-		 => (case getNear(jumpInfo, label)
-		       of Count 1 
-			=> generate gef
-			            {label = label,
-				     falling = true,
-				     unique = true}
-		        | _ => AppendList.append
-			       (default false,
-				AppendList.cons
-				(Assembly.directive_reset (),
-				 (generate gef
-				           {label = label,
-					    falling = true,
-					    unique = false}))))
-	    end
-	  
-	fun make {generate, effect, fall}
-	  = generate (GEF {generate = generate,
-			   effect = effect,
-			   fall = fall})
+        val generate
+          = case optimize 
+              of 0 => make {generate = generateAll,
+                            effect = effectDefault,
+                            fall = fallNone}
+               | _ => make {generate = generateAll,
+                            effect = effectJumpTable,
+                            fall = fallDefault}
 
-	val generate
-	  = case optimize 
-	      of 0 => make {generate = generateAll,
-			    effect = effectDefault,
-			    fall = fallNone}
-	       | _ => make {generate = generateAll,
-			    effect = effectJumpTable,
-			    fall = fallDefault}
-
-	val _ = List.foreach
-	        (blocks,
-		 fn Block.T {entry, ...}
-		  => (case entry
-			of Func {label, ...} => enque label
-			 | _ => ()))
-	fun doit () : Assembly.t list list
-	  = (case deque ()
-	       of NONE => []
-	        | SOME label
-		=> (case AppendList.toList (generate {label = label,
-						      falling = false,
-						      unique = false})
-		      of [] => doit ()
-		       | block => block::(doit ())))
-	val assembly = doit ()
-	val _ = destLayoutInfo ()
-	val _ = destProfileLabel ()
+        val _ = List.foreach
+                (blocks,
+                 fn Block.T {entry, ...}
+                  => (case entry
+                        of Func {label, ...} => enque label
+                         | _ => ()))
+        fun doit () : Assembly.t list list
+          = (case deque ()
+               of NONE => []
+                | SOME label
+                => (case AppendList.toList (generate {label = label,
+                                                      falling = false,
+                                                      unique = false})
+                      of [] => doit ()
+                       | block => block::(doit ())))
+        val assembly = doit ()
+        val _ = destLayoutInfo ()
+        val _ = destProfileLabel ()
       in
-	data::assembly
+        data::assembly
       end
 
   val (generateTransfers, generateTransfers_msg)

Modified: mlton/branches/on-20050420-cmm-branch/mlton/codegen/x86-codegen/x86-generate-transfers.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/codegen/x86-codegen/x86-generate-transfers.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/codegen/x86-codegen/x86-generate-transfers.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,9 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 type int = Int.t
@@ -30,10 +30,10 @@
 
     val generateTransfers:
        {chunk: x86.Chunk.t,
-	optimize: int,
-	newProfileLabel: x86.ProfileLabel.t -> x86.ProfileLabel.t,
-	liveInfo: x86Liveness.LiveInfo.t,
-	jumpInfo: x86JumpInfo.t,
-	reserveEsp: bool} -> x86.Assembly.t list list
+        optimize: int,
+        newProfileLabel: x86.ProfileLabel.t -> x86.ProfileLabel.t,
+        liveInfo: x86Liveness.LiveInfo.t,
+        jumpInfo: x86JumpInfo.t,
+        reserveEsp: bool} -> x86.Assembly.t list list
     val generateTransfers_totals : unit -> unit
   end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/codegen/x86-codegen/x86-jump-info.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/codegen/x86-codegen/x86-jump-info.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/codegen/x86-codegen/x86-jump-info.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,9 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 functor x86JumpInfo(S: X86_JUMP_INFO_STRUCTS) : X86_JUMP_INFO =
@@ -28,18 +28,18 @@
       
   fun newJumpInfo ()
     = let
-	val {get : Label.t -> status ref, ...}
-	  = Property.get(Label.plist, 
-			 Property.initFun (fn _ => ref (Count 0)))
+        val {get : Label.t -> status ref, ...}
+          = Property.get(Label.plist, 
+                         Property.initFun (fn _ => ref (Count 0)))
       in
-	T {get = get}
+        T {get = get}
       end
 
   local
     fun doit (status_ref, maybe_fn)
       = case !status_ref
-	  of None => ()
-	   | Count i => status_ref := (maybe_fn i)
+          of None => ()
+           | Count i => status_ref := (maybe_fn i)
   in
     fun incNear (T {get}, label)
       = doit (get label, fn i => Count (i+1))
@@ -51,23 +51,23 @@
   fun getNear (T {get}, label) = !(get label)
 
   fun completeJumpInfo {chunk = Chunk.T {blocks, ...},
-			jumpInfo: t}
+                        jumpInfo: t}
     = List.foreach
       (blocks,
        fn Block.T {entry, transfer,...}
         => (case entry
-	      of Entry.Jump _ => ()
-	       | Entry.Func {label, ...} => forceNear (jumpInfo, label)
-	       | Entry.Cont {label, ...} => forceNear (jumpInfo, label)
-	       | Entry.Handler {label, ...} => forceNear (jumpInfo, label)
-	       | Entry.CReturn {label, func, ...}
-	       => if CFunction.maySwitchThreads func
-		    then forceNear (jumpInfo, label)
-		    else ();
-	    List.foreach
-	    (Transfer.nearTargets transfer,
-	     fn label 
-	      => incNear (jumpInfo, label))))
+              of Entry.Jump _ => ()
+               | Entry.Func {label, ...} => forceNear (jumpInfo, label)
+               | Entry.Cont {label, ...} => forceNear (jumpInfo, label)
+               | Entry.Handler {label, ...} => forceNear (jumpInfo, label)
+               | Entry.CReturn {label, func, ...}
+               => if CFunction.maySwitchThreads func
+                    then forceNear (jumpInfo, label)
+                    else ();
+            List.foreach
+            (Transfer.nearTargets transfer,
+             fn label 
+              => incNear (jumpInfo, label))))
 
   val (completeJumpInfo, completeJumpInfo_msg)
     = tracer
@@ -75,45 +75,45 @@
       completeJumpInfo
 
   fun verifyJumpInfo {chunk as Chunk.T {blocks, ...}, 
-		      jumpInfo: t}
+                      jumpInfo: t}
     = let
-	local
-	  val {get : Label.t -> status ref,
-	       destroy}
-	    = Property.destGet(Label.plist,
-			       Property.initFun (fn _ => ref (Count 0)))
-	in
-	  val jumpInfo' = T {get = get}
-	  val destroy = destroy
-	end
-	val _ = completeJumpInfo {chunk = chunk,
-				  jumpInfo = jumpInfo'}
+        local
+          val {get : Label.t -> status ref,
+               destroy}
+            = Property.destGet(Label.plist,
+                               Property.initFun (fn _ => ref (Count 0)))
+        in
+          val jumpInfo' = T {get = get}
+          val destroy = destroy
+        end
+        val _ = completeJumpInfo {chunk = chunk,
+                                  jumpInfo = jumpInfo'}
 
-	val verified 
-	  = List.forall
-	    (blocks,
-	     fn Block.T {entry,...}
-	      => let
-		   val label = Entry.label entry
-		 in 
-		   if status_eq(getNear(jumpInfo, label), 
-				getNear(jumpInfo', label))
-		     then true
-		     else (print "verifyJumpInfo: ";
-			   print (Label.toString label);
-			   print "\n";
-			   print "jumpInfo: ";	
-			   print (status_toString (getNear(jumpInfo, label)));
-			   print "\n";
-			   print "jumpInfo': ";
-			   print (status_toString (getNear(jumpInfo', label)));
-			   print "\n";
-			   false)
-		 end)
+        val verified 
+          = List.forall
+            (blocks,
+             fn Block.T {entry,...}
+              => let
+                   val label = Entry.label entry
+                 in 
+                   if status_eq(getNear(jumpInfo, label), 
+                                getNear(jumpInfo', label))
+                     then true
+                     else (print "verifyJumpInfo: ";
+                           print (Label.toString label);
+                           print "\n";
+                           print "jumpInfo: ";  
+                           print (status_toString (getNear(jumpInfo, label)));
+                           print "\n";
+                           print "jumpInfo': ";
+                           print (status_toString (getNear(jumpInfo', label)));
+                           print "\n";
+                           false)
+                 end)
 
-	val _ = destroy ()
+        val _ = destroy ()
       in
-	verified
+        verified
       end
 
   val (verifyJumpInfo, verifyJumpInfo_msg)

Modified: mlton/branches/on-20050420-cmm-branch/mlton/codegen/x86-codegen/x86-jump-info.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/codegen/x86-codegen/x86-jump-info.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/codegen/x86-codegen/x86-jump-info.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 type int = Int.t
 
 signature X86_JUMP_INFO_STRUCTS =
@@ -22,10 +23,10 @@
     val newJumpInfo : unit -> t
 
     val completeJumpInfo : {chunk: x86.Chunk.t,
-			    jumpInfo: t} -> unit
+                            jumpInfo: t} -> unit
     val completeJumpInfo_msg : unit -> unit
     val verifyJumpInfo : {chunk: x86.Chunk.t,
-			  jumpInfo: t} -> bool
+                          jumpInfo: t} -> bool
     val verifyJumpInfo_msg : unit -> unit
 
     val incNear : t * x86.Label.t -> unit

Modified: mlton/branches/on-20050420-cmm-branch/mlton/codegen/x86-codegen/x86-live-transfers.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/codegen/x86-codegen/x86-live-transfers.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/codegen/x86-codegen/x86-live-transfers.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,9 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 (*
@@ -31,12 +31,12 @@
 
   fun take (l, n) 
     = let
-	val rec take'
-	  = fn ([], _, ac) => List.rev ac
-	     | (_, 0 : Int.t, ac) => List.rev ac
-	     | (h::t, i, ac) => take' (t, i - 1, h::ac)
+        val rec take'
+          = fn ([], _, ac) => List.rev ac
+             | (_, 0 : Int.t, ac) => List.rev ac
+             | (h::t, i, ac) => take' (t, i - 1, h::ac)
       in
-	take' (l, n, [])
+        take' (l, n, [])
       end
 
   val track = x86Liveness.track
@@ -44,1047 +44,1047 @@
   val tracerTop = x86.tracerTop
 
   fun temp_uses_defs {uses : Operand.t list,
-		      defs : Operand.t list}
+                      defs : Operand.t list}
     = let
-	val baseUses
-	  = List.fold
-	    (uses,
-	     MemLocSet.empty,
-	     fn (operand, baseUses)
-	      => case Operand.deMemloc operand
-		   of SOME memloc => if x86Liveness.track memloc
-				       then MemLocSet.add(baseUses, memloc)
-				       else baseUses
-		    | NONE => baseUses)
-	    
-	val tempUses
-	  = let
-	      fun doit (operands, tempUses)
-		= List.fold
-		  (operands,
-		   tempUses,
-		   fn (operand, tempUses)
-		    => case Operand.deMemloc operand
-			 of SOME memloc
-			  => List.fold(MemLoc.utilized memloc,
-				       tempUses,
-				       fn (memloc, tempUses)
-				        => if x86Liveness.track memloc
-					     then MemLocSet.add(tempUses, memloc)
-					     else tempUses)
-			  | NONE => tempUses)
-	    in
-	      doit(defs, 
-	      doit(uses, 
-		   baseUses))
-	    end
+        val baseUses
+          = List.fold
+            (uses,
+             MemLocSet.empty,
+             fn (operand, baseUses)
+              => case Operand.deMemloc operand
+                   of SOME memloc => if x86Liveness.track memloc
+                                       then MemLocSet.add(baseUses, memloc)
+                                       else baseUses
+                    | NONE => baseUses)
+            
+        val tempUses
+          = let
+              fun doit (operands, tempUses)
+                = List.fold
+                  (operands,
+                   tempUses,
+                   fn (operand, tempUses)
+                    => case Operand.deMemloc operand
+                         of SOME memloc
+                          => List.fold(MemLoc.utilized memloc,
+                                       tempUses,
+                                       fn (memloc, tempUses)
+                                        => if x86Liveness.track memloc
+                                             then MemLocSet.add(tempUses, memloc)
+                                             else tempUses)
+                          | NONE => tempUses)
+            in
+              doit(defs, 
+              doit(uses, 
+                   baseUses))
+            end
 
-	val baseDefs
-	  = List.fold
-	    (defs,
-	     MemLocSet.empty,
-	     fn (operand, baseDefs)
-	      => case Operand.deMemloc operand
-		   of SOME memloc => if x86Liveness.track memloc
-				       then MemLocSet.add(baseDefs, memloc)
-				       else baseDefs
-		    | NONE => baseDefs)
-	val tempDefs = baseDefs
+        val baseDefs
+          = List.fold
+            (defs,
+             MemLocSet.empty,
+             fn (operand, baseDefs)
+              => case Operand.deMemloc operand
+                   of SOME memloc => if x86Liveness.track memloc
+                                       then MemLocSet.add(baseDefs, memloc)
+                                       else baseDefs
+                    | NONE => baseDefs)
+        val tempDefs = baseDefs
       in
-	{uses = tempUses,
-	 defs = tempDefs}
+        {uses = tempUses,
+         defs = tempDefs}
       end
 
   datatype t = T of {get: Label.t -> 
                           ((MemLoc.t * Register.t * bool) list *
-			   (MemLoc.t * bool) list),
-		     set: Label.t * 
+                           (MemLoc.t * bool) list),
+                     set: Label.t * 
                           ((MemLoc.t * Register.t * bool) list *
-			   (MemLoc.t * bool) list) -> unit}
+                           (MemLoc.t * bool) list) -> unit}
 
   local
 
   in
     structure I' = struct
-		     open Int
-		     fun sign x = if x = 0
-				    then 0
-				  else if x > 0
-				    then 1
-				  else ~1
-		   end
+                     open Int
+                     fun sign x = if x = 0
+                                    then 0
+                                  else if x > 0
+                                    then 1
+                                  else ~1
+                   end
     structure I =
       struct
-	datatype t = NegInfinity
-	           | Finite of I'.t
-	           | PosInfinity
-	val toString
-	  = fn NegInfinity => "-inf"
-	     | Finite n => I'.toString n
-	     | PosInfinity => "+inf"
-	val zero = Finite (I'.zero)
+        datatype t = NegInfinity
+                   | Finite of I'.t
+                   | PosInfinity
+        val toString
+          = fn NegInfinity => "-inf"
+             | Finite n => I'.toString n
+             | PosInfinity => "+inf"
+        val zero = Finite (I'.zero)
 
-	fun NegInfinity < NegInfinity = false
-	  | NegInfinity < _ = true
-	  | (Finite _) < NegInfinity = false
-	  | (Finite x) < (Finite y) = I'.<(x,y)
-	  | (Finite _) < PosInfinity = true
-	  | PosInfinity < _ = false
+        fun NegInfinity < NegInfinity = false
+          | NegInfinity < _ = true
+          | (Finite _) < NegInfinity = false
+          | (Finite x) < (Finite y) = I'.<(x,y)
+          | (Finite _) < PosInfinity = true
+          | PosInfinity < _ = false
 
-	fun NegInfinity + PosInfinity = zero
-	  | NegInfinity + _ = NegInfinity
-	  | (Finite _) + NegInfinity = NegInfinity
-	  | (Finite x) + (Finite y) 
-	  = ((Finite (I'.+(x,y))) handle Overflow => if x > 0 
-						       then PosInfinity
-						       else NegInfinity)
-	  | (Finite _) + PosInfinity = PosInfinity
-	  | PosInfinity + NegInfinity = zero
-	  | PosInfinity + _ = PosInfinity
+        fun NegInfinity + PosInfinity = zero
+          | NegInfinity + _ = NegInfinity
+          | (Finite _) + NegInfinity = NegInfinity
+          | (Finite x) + (Finite y) 
+          = ((Finite (I'.+(x,y))) handle Overflow => if x > 0 
+                                                       then PosInfinity
+                                                       else NegInfinity)
+          | (Finite _) + PosInfinity = PosInfinity
+          | PosInfinity + NegInfinity = zero
+          | PosInfinity + _ = PosInfinity
 
-	fun NegInfinity * NegInfinity = PosInfinity
-	  | NegInfinity * (Finite x)
-	  = (case I'.sign x
-	       of ~1 => PosInfinity
-		| 0 => zero
-		| _ => NegInfinity)
-	  | NegInfinity * PosInfinity = NegInfinity
-	  | (Finite x) * NegInfinity
-	  = (case I'.sign x
-	       of ~1 => PosInfinity
-		| 0 => zero
-		| _ => NegInfinity)
-	  | (Finite x) * (Finite y)
-	  = ((Finite (I'.*(x, y))) handle Overflow => (case (I'.sign x, I'.sign y)
-							 of (~1, ~1) => PosInfinity
-							  | (1, ~1) => NegInfinity
-							  | (~1, 1) => NegInfinity
-							  | _ => PosInfinity))
-	  | (Finite x) * PosInfinity
-	  = (case I'.sign x
-	       of ~1 => NegInfinity
-		| 0 => zero
-		| _ => PosInfinity)
-	  | PosInfinity * NegInfinity = NegInfinity
-	  | PosInfinity * (Finite x)
-	  = (case I'.sign x
-	       of ~1 => NegInfinity
-		| 0 => zero
-		| _ => PosInfinity)
-	  | PosInfinity * PosInfinity = PosInfinity
+        fun NegInfinity * NegInfinity = PosInfinity
+          | NegInfinity * (Finite x)
+          = (case I'.sign x
+               of ~1 => PosInfinity
+                | 0 => zero
+                | _ => NegInfinity)
+          | NegInfinity * PosInfinity = NegInfinity
+          | (Finite x) * NegInfinity
+          = (case I'.sign x
+               of ~1 => PosInfinity
+                | 0 => zero
+                | _ => NegInfinity)
+          | (Finite x) * (Finite y)
+          = ((Finite (I'.*(x, y))) handle Overflow => (case (I'.sign x, I'.sign y)
+                                                         of (~1, ~1) => PosInfinity
+                                                          | (1, ~1) => NegInfinity
+                                                          | (~1, 1) => NegInfinity
+                                                          | _ => PosInfinity))
+          | (Finite x) * PosInfinity
+          = (case I'.sign x
+               of ~1 => NegInfinity
+                | 0 => zero
+                | _ => PosInfinity)
+          | PosInfinity * NegInfinity = NegInfinity
+          | PosInfinity * (Finite x)
+          = (case I'.sign x
+               of ~1 => NegInfinity
+                | 0 => zero
+                | _ => PosInfinity)
+          | PosInfinity * PosInfinity = PosInfinity
       end
   end
 
   fun computeLiveTransfers {chunk = Chunk.T {blocks,...},
-			    transferRegs : Entry.t -> Register.t list,
-			    transferFltRegs : Entry.t -> Int.t,
-			    liveInfo : x86Liveness.LiveInfo.t,
-			    jumpInfo : x86JumpInfo.t,
-			    loopInfo : x86LoopInfo.t}
+                            transferRegs : Entry.t -> Register.t list,
+                            transferFltRegs : Entry.t -> Int.t,
+                            liveInfo : x86Liveness.LiveInfo.t,
+                            jumpInfo : x86JumpInfo.t,
+                            loopInfo : x86LoopInfo.t}
     = let
-	val (useLF, useB, sync)
-	  = case !Control.Native.liveTransfer
-	      of 1 => (false, false, false)
-	       | 2 => (false, false, true)
-	       | 3 => (false, true, false)
-	       | 4 => (false, true, true)
-	       | 5 => (true, false, false)
-	       | 6 => (true, false, true)
-	       | 7 => (true, true, false)
-	       | _ => (true, true, true)
+        val (useLF, useB, sync)
+          = case !Control.Native.liveTransfer
+              of 1 => (false, false, false)
+               | 2 => (false, false, true)
+               | 3 => (false, true, false)
+               | 4 => (false, true, true)
+               | 5 => (true, false, false)
+               | 6 => (true, false, true)
+               | 7 => (true, true, false)
+               | _ => (true, true, true)
 
-	val cutoff = !Control.Native.cutoff
-	datatype u = Position of I.t | Length of I'.t
+        val cutoff = !Control.Native.cutoff
+        datatype u = Position of I.t | Length of I'.t
 
-	val {get = getInfo :
-	           Label.t -> 
-		   {block: Block.t,
-		    pred: Label.t list ref,
-		    succ: Label.t list ref,
-		    live: {memloc: MemLoc.t,
-			   distanceF': u option ref,
-			   distanceF: (I.t * Label.t option) option ref,
-			   distanceB': u option ref,
-			   distanceB: (I.t * Label.t option) option ref} vector,
-		    liveTransfers: ((MemLoc.t * Register.t * bool ref) list *
-				    (MemLoc.t * bool ref) list) option ref,
-		    defed: MemLocSet.t option ref},
-	     set = setInfo,
-	     destroy = destInfo}
-	  = Property.destGetSetOnce
-	    (Label.plist,
-	     Property.initRaise ("x86LiveTransfers:getInfo", Label.layout))
+        val {get = getInfo :
+                   Label.t -> 
+                   {block: Block.t,
+                    pred: Label.t list ref,
+                    succ: Label.t list ref,
+                    live: {memloc: MemLoc.t,
+                           distanceF': u option ref,
+                           distanceF: (I.t * Label.t option) option ref,
+                           distanceB': u option ref,
+                           distanceB: (I.t * Label.t option) option ref} vector,
+                    liveTransfers: ((MemLoc.t * Register.t * bool ref) list *
+                                    (MemLoc.t * bool ref) list) option ref,
+                    defed: MemLocSet.t option ref},
+             set = setInfo,
+             destroy = destInfo}
+          = Property.destGetSetOnce
+            (Label.plist,
+             Property.initRaise ("x86LiveTransfers:getInfo", Label.layout))
 
-	val (labels, funcs)
-	  = List.fold
-	    (blocks,
-	     ([], []),
-	     fn (block as Block.T {entry, transfer, ...}, (labels, funcs))
-	      => let
-		   val label = Entry.label entry
-		   val succ = Transfer.nearTargets transfer
-		   val live = LiveInfo.getLive(liveInfo, label)
-		   val live = List.fold
-		              (succ,
-			       live,
-			       fn (label, live)
-			        => LiveSet.+(live, LiveInfo.getLive(liveInfo, label)))
-		   val live = LiveSet.toList live
-		   val _ 
-		     = setInfo(label,
-			       {block = block,
-				pred = ref [],
-				succ = ref succ,
-				live = Vector.fromListMap
-				       (live,
-					fn memloc 
-					 => {memloc = memloc,
-					     distanceF' = ref NONE,
-					     distanceF = ref NONE,
-					     distanceB' = ref NONE,
-					     distanceB = ref NONE}),
-				liveTransfers = ref NONE,
-				defed = ref NONE})
-		   val labels = label::labels
-		   val funcs = case entry
-				 of Entry.Func _ => label::funcs
-				  | _ => funcs
-		 in
-	   (labels, funcs)
-		 end)
+        val (labels, funcs)
+          = List.fold
+            (blocks,
+             ([], []),
+             fn (block as Block.T {entry, transfer, ...}, (labels, funcs))
+              => let
+                   val label = Entry.label entry
+                   val succ = Transfer.nearTargets transfer
+                   val live = LiveInfo.getLive(liveInfo, label)
+                   val live = List.fold
+                              (succ,
+                               live,
+                               fn (label, live)
+                                => LiveSet.+(live, LiveInfo.getLive(liveInfo, label)))
+                   val live = LiveSet.toList live
+                   val _ 
+                     = setInfo(label,
+                               {block = block,
+                                pred = ref [],
+                                succ = ref succ,
+                                live = Vector.fromListMap
+                                       (live,
+                                        fn memloc 
+                                         => {memloc = memloc,
+                                             distanceF' = ref NONE,
+                                             distanceF = ref NONE,
+                                             distanceB' = ref NONE,
+                                             distanceB = ref NONE}),
+                                liveTransfers = ref NONE,
+                                defed = ref NONE})
+                   val labels = label::labels
+                   val funcs = case entry
+                                 of Entry.Func _ => label::funcs
+                                  | _ => funcs
+                 in
+           (labels, funcs)
+                 end)
 
-	val labels = Vector.fromList labels
-	val funcs = Vector.fromList funcs
+        val labels = Vector.fromList labels
+        val funcs = Vector.fromList funcs
 
-	val _
-	  = Vector.foreach
-	    (labels,
-	     fn label
-	      => let
-		   val {block, ...} = getInfo label
-		   fun doit target
-		     = let
-			 val {pred = pred', ...} = getInfo target
-		       in
-			 List.push (pred', label)
-		       end
-		   val Block.T {transfer, ...} = block
-		   datatype z = datatype Transfer.t
-		 in
-		   case transfer
-		     of Goto {target, ...} 
-		      => doit target
-		      | Iff {truee, falsee, ...} 
-		      => (doit truee; 
-			  doit falsee)
-		      | Switch {cases, default, ...}
-		      => (doit default;
-			  Transfer.Cases.foreach(cases, doit))
-		      | Tail {...}
-		      => ()
-		      | NonTail {return, handler, ...}
-		      => (doit return;
-			  case handler 
-			    of SOME handler => doit handler
-			     | NONE => ())
-		      | Return {...}
-		      => ()
-		      | Raise {...}
-		      => ()
-		      | CCall {return, ...}
-		      => Option.app (return, doit)
-		 end)
+        val _
+          = Vector.foreach
+            (labels,
+             fn label
+              => let
+                   val {block, ...} = getInfo label
+                   fun doit target
+                     = let
+                         val {pred = pred', ...} = getInfo target
+                       in
+                         List.push (pred', label)
+                       end
+                   val Block.T {transfer, ...} = block
+                   datatype z = datatype Transfer.t
+                 in
+                   case transfer
+                     of Goto {target, ...} 
+                      => doit target
+                      | Iff {truee, falsee, ...} 
+                      => (doit truee; 
+                          doit falsee)
+                      | Switch {cases, default, ...}
+                      => (doit default;
+                          Transfer.Cases.foreach(cases, doit o #2))
+                      | Tail {...}
+                      => ()
+                      | NonTail {return, handler, ...}
+                      => (doit return;
+                          case handler 
+                            of SOME handler => doit handler
+                             | NONE => ())
+                      | Return {...}
+                      => ()
+                      | Raise {...}
+                      => ()
+                      | CCall {return, ...}
+                      => Option.app (return, doit)
+                 end)
 
-	val _
-	  = Vector.foreach
-	    (labels,
-	     fn label
-	      => let
-		   val {block, live, ...} = getInfo label
-		   val Block.T {entry, statements, transfer, ...} = block
+        val _
+          = Vector.foreach
+            (labels,
+             fn label
+              => let
+                   val {block, live, ...} = getInfo label
+                   val Block.T {entry, statements, transfer, ...} = block
 
-		   val l
-		     = List.fold
-		       (statements,
-			I'.two,
-			fn (Assembly.Comment _, l) => l
-			 | (_, l) => I'.+(l, I'.one))
+                   val l
+                     = List.fold
+                       (statements,
+                        I'.two,
+                        fn (Assembly.Comment _, l) => l
+                         | (_, l) => I'.+(l, I'.one))
 
-		   fun pos ([], n, m)
-		     = let
-			 val {uses, defs, ...}
-			   = Transfer.uses_defs_kills transfer
-			 val {uses,defs} 
-			   = temp_uses_defs {uses = uses,
-					     defs = defs}
-		       in
-			 Vector.foreach
-			 (live,
-			  fn {memloc, distanceF' as ref NONE, ...}
-			   => if MemLocSet.contains(uses,memloc)
-				then distanceF' := SOME (Position (I.Finite n))
-				else distanceF' := SOME (Length l)
-			   | _ => ());
-			 Vector.foreach
-			 (live,
-			  fn {memloc, distanceB', ...}
-			   => if MemLocSet.contains(uses,memloc)
-			         orelse
-				 MemLocSet.contains(defs,memloc)
-				then distanceB' := SOME (Position (I.Finite m))
-				else ())
-		       end
-		     | pos ((Assembly.Comment _)::assembly,n,m)
-		     = pos (assembly,n,m)
-		     | pos (asm::assembly,n,m)
-		     = let
-			 val {uses,defs,...} 
-			      = Assembly.uses_defs_kills asm
-			 val {uses,defs} 
-			   = temp_uses_defs {uses = uses,
-					     defs = defs}
-		       in
-			 Vector.foreach
-			 (live,
-			  fn {memloc, distanceF' as ref NONE, ...}
-			   => if MemLocSet.contains(uses,memloc)
-				then distanceF' := SOME (Position (I.Finite n))
-				else ()
-			   | _ => ());
-			 Vector.foreach
-			 (live,
-			  fn {memloc, distanceB', ...}
-			   => if MemLocSet.contains(uses,memloc)
-			         orelse
-				 MemLocSet.contains(defs,memloc)
-				then distanceB' := SOME (Position (I.Finite m))
-				else ());
-			 pos(assembly, I'.+(n, I'.one), I'.-(m, I'.one))
-		       end
-		 in
-		   let
-		     val n = I'.zero
-		     val m = I'.-(l, I'.one)
-		     val {uses,defs,...}
-		       = Entry.uses_defs_kills entry
-		     val {uses,defs} 
-		       = temp_uses_defs {uses = uses,
-					 defs = defs}
-		   in
-		     Vector.foreach
-		     (live,
-		      fn {memloc, distanceF' as ref NONE, ...}
-		       => if MemLocSet.contains(uses,memloc)
-			    then distanceF' := SOME (Position (I.Finite n))
-			    else ()
-		       | _ => ());
-		     Vector.foreach
-		     (live,
-		      fn {memloc, distanceB', ...}
-		       => if MemLocSet.contains(uses,memloc)
-		             orelse
-			     MemLocSet.contains(defs,memloc)
-			    then distanceB' := SOME (Position (I.Finite m))
-			    else distanceB' := SOME (Length l));
-		     pos(statements, I'.+(n, I'.one), I'.-(m, I'.one))
-		   end 
-		 end)
+                   fun pos ([], n, m)
+                     = let
+                         val {uses, defs, ...}
+                           = Transfer.uses_defs_kills transfer
+                         val {uses,defs} 
+                           = temp_uses_defs {uses = uses,
+                                             defs = defs}
+                       in
+                         Vector.foreach
+                         (live,
+                          fn {memloc, distanceF' as ref NONE, ...}
+                           => if MemLocSet.contains(uses,memloc)
+                                then distanceF' := SOME (Position (I.Finite n))
+                                else distanceF' := SOME (Length l)
+                           | _ => ());
+                         Vector.foreach
+                         (live,
+                          fn {memloc, distanceB', ...}
+                           => if MemLocSet.contains(uses,memloc)
+                                 orelse
+                                 MemLocSet.contains(defs,memloc)
+                                then distanceB' := SOME (Position (I.Finite m))
+                                else ())
+                       end
+                     | pos ((Assembly.Comment _)::assembly,n,m)
+                     = pos (assembly,n,m)
+                     | pos (asm::assembly,n,m)
+                     = let
+                         val {uses,defs,...} 
+                              = Assembly.uses_defs_kills asm
+                         val {uses,defs} 
+                           = temp_uses_defs {uses = uses,
+                                             defs = defs}
+                       in
+                         Vector.foreach
+                         (live,
+                          fn {memloc, distanceF' as ref NONE, ...}
+                           => if MemLocSet.contains(uses,memloc)
+                                then distanceF' := SOME (Position (I.Finite n))
+                                else ()
+                           | _ => ());
+                         Vector.foreach
+                         (live,
+                          fn {memloc, distanceB', ...}
+                           => if MemLocSet.contains(uses,memloc)
+                                 orelse
+                                 MemLocSet.contains(defs,memloc)
+                                then distanceB' := SOME (Position (I.Finite m))
+                                else ());
+                         pos(assembly, I'.+(n, I'.one), I'.-(m, I'.one))
+                       end
+                 in
+                   let
+                     val n = I'.zero
+                     val m = I'.-(l, I'.one)
+                     val {uses,defs,...}
+                       = Entry.uses_defs_kills entry
+                     val {uses,defs} 
+                       = temp_uses_defs {uses = uses,
+                                         defs = defs}
+                   in
+                     Vector.foreach
+                     (live,
+                      fn {memloc, distanceF' as ref NONE, ...}
+                       => if MemLocSet.contains(uses,memloc)
+                            then distanceF' := SOME (Position (I.Finite n))
+                            else ()
+                       | _ => ());
+                     Vector.foreach
+                     (live,
+                      fn {memloc, distanceB', ...}
+                       => if MemLocSet.contains(uses,memloc)
+                             orelse
+                             MemLocSet.contains(defs,memloc)
+                            then distanceB' := SOME (Position (I.Finite m))
+                            else distanceB' := SOME (Length l));
+                     pos(statements, I'.+(n, I'.one), I'.-(m, I'.one))
+                   end 
+                 end)
 
-	fun get_distanceF {temp: MemLoc.t,
-			   label: Label.t}
-	  = let
-	      val {block, succ, live, ...} = getInfo label
-	      val Block.T {transfer, ...} = block
-	    in
-	      case Vector.peek
-		   (live, 
-		    fn {memloc, ...} => MemLoc.eq(temp, memloc))
-		of SOME {distanceF = ref (SOME (df, dfl)), ...}
-		 => (df, dfl)
-		 | SOME {distanceF', distanceF, ...}
-		 => (case valOf (!distanceF')
-		       of Position n => (distanceF := SOME (n, SOME label); 
-					 (n, SOME label))
-			| Length n
-			=> let
-			     val loopLabels = getLoopLabels (loopInfo, label)
-			     val _ = distanceF := SOME (I.PosInfinity, NONE)
-			     fun default ()
-			       = let
-				   val n = I.Finite n
-				   val (min, minl)
-				     = List.fold
-				       (!succ,
-					(I.PosInfinity, NONE),
-					fn (label, (min, minl))
-					 => let
-					      val (n', l') 
-						= get_distanceF {temp = temp,
-								 label = label}
-					      val n' = I.+(n, n')
-					      val n''
-						= case (l', useLF)
-						    of (NONE, _) => n'
-						     | (_, false) => n'
-						     | (SOME l', true)
-						     => if List.contains
-						           (loopLabels,
-							    l', Label.equals)
-							  then n'
-							  else I.*(I.Finite 5, n')
-					    in
-					      if I.<(n'', min)
-						then (n', l')
-						else (min, minl)
-					    end)
-				 in
-				   (min, minl)
-				 end
-			       
-			     datatype z = datatype Transfer.t
-			     val (n, l)
-			       = case transfer
-				   of Tail _ => (I.PosInfinity, NONE)
-				    | NonTail _ => (I.PosInfinity, NONE)
-				    | Return _ => (I.PosInfinity, NONE)
-				    | Raise _ => (I.PosInfinity, NONE)
-			            | CCall {func, ...}
-				    => if CFunction.maySwitchThreads func
-				          orelse Size.class (MemLoc.size temp) <> Size.INT
-					 then (I.PosInfinity, NONE)
-					 else default ()
-				  | _ => default ()
-			   in
-			     distanceF := SOME (n, l) ; (n, l)
-			   end)
-		 | _ => (I.PosInfinity, NONE)
-	    end
+        fun get_distanceF {temp: MemLoc.t,
+                           label: Label.t}
+          = let
+              val {block, succ, live, ...} = getInfo label
+              val Block.T {transfer, ...} = block
+            in
+              case Vector.peek
+                   (live, 
+                    fn {memloc, ...} => MemLoc.eq(temp, memloc))
+                of SOME {distanceF = ref (SOME (df, dfl)), ...}
+                 => (df, dfl)
+                 | SOME {distanceF', distanceF, ...}
+                 => (case valOf (!distanceF')
+                       of Position n => (distanceF := SOME (n, SOME label); 
+                                         (n, SOME label))
+                        | Length n
+                        => let
+                             val loopLabels = getLoopLabels (loopInfo, label)
+                             val _ = distanceF := SOME (I.PosInfinity, NONE)
+                             fun default ()
+                               = let
+                                   val n = I.Finite n
+                                   val (min, minl)
+                                     = List.fold
+                                       (!succ,
+                                        (I.PosInfinity, NONE),
+                                        fn (label, (min, minl))
+                                         => let
+                                              val (n', l') 
+                                                = get_distanceF {temp = temp,
+                                                                 label = label}
+                                              val n' = I.+(n, n')
+                                              val n''
+                                                = case (l', useLF)
+                                                    of (NONE, _) => n'
+                                                     | (_, false) => n'
+                                                     | (SOME l', true)
+                                                     => if List.contains
+                                                           (loopLabels,
+                                                            l', Label.equals)
+                                                          then n'
+                                                          else I.*(I.Finite 5, n')
+                                            in
+                                              if I.<(n'', min)
+                                                then (n', l')
+                                                else (min, minl)
+                                            end)
+                                 in
+                                   (min, minl)
+                                 end
+                               
+                             datatype z = datatype Transfer.t
+                             val (n, l)
+                               = case transfer
+                                   of Tail _ => (I.PosInfinity, NONE)
+                                    | NonTail _ => (I.PosInfinity, NONE)
+                                    | Return _ => (I.PosInfinity, NONE)
+                                    | Raise _ => (I.PosInfinity, NONE)
+                                    | CCall {func, ...}
+                                    => if CFunction.maySwitchThreads func
+                                          orelse Size.class (MemLoc.size temp) <> Size.INT
+                                         then (I.PosInfinity, NONE)
+                                         else default ()
+                                  | _ => default ()
+                           in
+                             distanceF := SOME (n, l) ; (n, l)
+                           end)
+                 | _ => (I.PosInfinity, NONE)
+            end
 
-	fun get_distanceB {temp: MemLoc.t,
-			   label: Label.t}
-	  = let
-	      val {block, pred, live, ...} = getInfo label
-	      val Block.T {entry, ...} = block
-	    in
-	      case Vector.peek
-		   (live, 
-		    fn {memloc, ...} => MemLoc.eq(temp, memloc))
-		of SOME {distanceB = ref (SOME (db, dbl)), ...}
-		 => (db, dbl)
-		 | SOME {distanceB, ...}
-		 => let
-		      val loopLabels = getLoopLabels(loopInfo, label)
-		      val _ = distanceB := SOME (I.PosInfinity, NONE)
-		      fun default () 
-			= List.fold
-			  (!pred, 
-			   (I.PosInfinity, NONE),
-			   fn (label, (min, minl))
-			    => let
-				 val {live, ...} = getInfo label
-			       in
-				 case Vector.peek
-				      (live, 
-				       fn {memloc, ...} => MemLoc.eq(temp, memloc))
-				   of SOME {distanceB', ...}
-				    => (case valOf(!distanceB')
-					  of Position n 
-					   => if I.<(n, min)
-						then (n, SOME label)
-						else (min, minl)
-					   | Length n
-					   => let
-						val n = I.Finite n
-						val (n', l') 
-						  = get_distanceB {temp = temp,
-								   label = label}
-						val n' = I.+(n, n')
-						val n''
-						  = case (l', useLF)
-						      of (NONE, _) => n'
-						       | (_, false) => n'
-						       | (SOME l', true)
-						       => if List.contains
-							     (loopLabels,
-							      l', Label.equals)
-							    then n'
-							    else I.*(I.Finite 5, n')
-					      in
-						if I.<(n'', min)
-						  then (n', l')
-						  else (min, minl)
-					      end)
-				    | _ => (min, minl)
-			       end)
+        fun get_distanceB {temp: MemLoc.t,
+                           label: Label.t}
+          = let
+              val {block, pred, live, ...} = getInfo label
+              val Block.T {entry, ...} = block
+            in
+              case Vector.peek
+                   (live, 
+                    fn {memloc, ...} => MemLoc.eq(temp, memloc))
+                of SOME {distanceB = ref (SOME (db, dbl)), ...}
+                 => (db, dbl)
+                 | SOME {distanceB, ...}
+                 => let
+                      val loopLabels = getLoopLabels(loopInfo, label)
+                      val _ = distanceB := SOME (I.PosInfinity, NONE)
+                      fun default () 
+                        = List.fold
+                          (!pred, 
+                           (I.PosInfinity, NONE),
+                           fn (label, (min, minl))
+                            => let
+                                 val {live, ...} = getInfo label
+                               in
+                                 case Vector.peek
+                                      (live, 
+                                       fn {memloc, ...} => MemLoc.eq(temp, memloc))
+                                   of SOME {distanceB', ...}
+                                    => (case valOf(!distanceB')
+                                          of Position n 
+                                           => if I.<(n, min)
+                                                then (n, SOME label)
+                                                else (min, minl)
+                                           | Length n
+                                           => let
+                                                val n = I.Finite n
+                                                val (n', l') 
+                                                  = get_distanceB {temp = temp,
+                                                                   label = label}
+                                                val n' = I.+(n, n')
+                                                val n''
+                                                  = case (l', useLF)
+                                                      of (NONE, _) => n'
+                                                       | (_, false) => n'
+                                                       | (SOME l', true)
+                                                       => if List.contains
+                                                             (loopLabels,
+                                                              l', Label.equals)
+                                                            then n'
+                                                            else I.*(I.Finite 5, n')
+                                              in
+                                                if I.<(n'', min)
+                                                  then (n', l')
+                                                  else (min, minl)
+                                              end)
+                                    | _ => (min, minl)
+                               end)
 
-		      datatype z = datatype Entry.t
-		      val (n, l)
-			= case entry
-			    of Func {...} => (I.PosInfinity, NONE)
-			     | Cont {...} => (I.PosInfinity, NONE)
-			     | Handler {...} => (I.PosInfinity, NONE)
-			     | CReturn {func, ...}
-			     => if (CFunction.maySwitchThreads func
-				    orelse Size.class (MemLoc.size temp) <> Size.INT)
-				  then (I.PosInfinity, NONE)
-				  else default ()
-			     | _ => default ()
-		    in
-		      distanceB := SOME (n, l) ; (n, l)
-		    end
-		 | _ => (I.PosInfinity, NONE)
-	    end
+                      datatype z = datatype Entry.t
+                      val (n, l)
+                        = case entry
+                            of Func {...} => (I.PosInfinity, NONE)
+                             | Cont {...} => (I.PosInfinity, NONE)
+                             | Handler {...} => (I.PosInfinity, NONE)
+                             | CReturn {func, ...}
+                             => if (CFunction.maySwitchThreads func
+                                    orelse Size.class (MemLoc.size temp) <> Size.INT)
+                                  then (I.PosInfinity, NONE)
+                                  else default ()
+                             | _ => default ()
+                    in
+                      distanceB := SOME (n, l) ; (n, l)
+                    end
+                 | _ => (I.PosInfinity, NONE)
+            end
 
-	local
-	  val queue = ref (Queue.empty ())
-	in
-	  fun enque x = queue := Queue.enque(!queue, x)
-	  fun deque () =
-	     case Queue.deque (!queue) of
-		NONE => NONE
-	      | SOME (queue', x) => (queue := queue'; SOME x)
-	end
+        local
+          val queue = ref (Queue.empty ())
+        in
+          fun enque x = queue := Queue.enque(!queue, x)
+          fun deque () =
+             case Queue.deque (!queue) of
+                NONE => NONE
+              | SOME (queue', x) => (queue := queue'; SOME x)
+        end
 
-	fun doit {label, hints}
-	  = let
-	      val {block as Block.T {entry, ...}, 
-		   live = liveData, liveTransfers, ...} = getInfo label
-	    in
-	      case !liveTransfers
-		of SOME _ => ()
-		 | NONE 
-		 => let
-		      val loopLabels = getLoopLabels(loopInfo, label)
-		      val Block.T {transfer, ...} = block
-			
-		      val (regHints, fltregHints) = hints
+        fun doit {label, hints}
+          = let
+              val {block as Block.T {entry, ...}, 
+                   live = liveData, liveTransfers, ...} = getInfo label
+            in
+              case !liveTransfers
+                of SOME _ => ()
+                 | NONE 
+                 => let
+                      val loopLabels = getLoopLabels(loopInfo, label)
+                      val Block.T {transfer, ...} = block
+                        
+                      val (regHints, fltregHints) = hints
 
-		      val live = LiveSet.toList(LiveInfo.getLive(liveInfo, label))
+                      val live = LiveSet.toList(LiveInfo.getLive(liveInfo, label))
 
-		      val _ 
-			= if true then ()
-			  else
-			  (print (Label.toString label);
-			   print "\nloopLabels: ";
-			   print (List.toString Label.toString loopLabels);
-			   print "\nliveData:\n";
-			   Vector.foreach
-			   (liveData,
-			    fn {memloc, distanceF', distanceB', ...} => 
-			    (print (MemLoc.toString memloc);
-			     print ": ";
-			     case !distanceF' of
-			       NONE => print "?"
-			     | SOME (Position i) => (print "Pos "; print (I.toString i))
-			     | SOME (Length i) => (print "Len "; print (I'.toString i));
-			     print " ";
-			     case !distanceB' of
-			       NONE => print "?"
-			     | SOME (Position i) => (print "Pos "; print (I.toString i))
-			     | SOME (Length i) => (print "Len "; print (I'.toString i));
-			     print "\n"));
-			   print "regHints:\n";
-			   List.foreach
-			   (regHints,
-			    fn (memloc,register,sync) =>
-			    (print (MemLoc.toString memloc);
-			     print ": ";
-			     print (Register.toString register);
-			     print ": ";
-			     print (Bool.toString (!sync));
-			     print "\n"));
-			   print "fltregHints:\n";
-			   List.foreach
-			   (fltregHints,
-			    fn (memloc,sync) =>
-			    (print (MemLoc.toString memloc);
-			     print ": ";
-			     print (Bool.toString (!sync));
-			     print "\n"));
-			   print "live:\n";
-			   List.foreach
-			   (live,
-			    fn memloc
-			     => (print (MemLoc.toString memloc);
-				 print "\n"));
-			   print "distance_F:\n";
-			   List.foreach
-			   (live,
-			    fn memloc
-			     => (print (MemLoc.toString memloc);
-				 print ": ";
-				 let
-				   val (n, l) = get_distanceF {temp = memloc,
-							       label = label}
-				 in
-				   print (I.toString n);
-				   print " ";
-				   print (Option.toString Label.toString l)
-				 end;
-				 print "\n"));
-			   print "distance_B:\n";
-			   List.foreach
-			   (live,
-			    fn memloc
-			     => (print (MemLoc.toString memloc);
-				 print ": ";
-				 let
-				   val (n, l) = get_distanceB {temp = memloc,
-							       label = label}
-				 in
-				   print (I.toString n);
-				   print " ";
-				   print (Option.toString Label.toString l)
-				 end;
-				 print "\n")))
+                      val _ 
+                        = if true then ()
+                          else
+                          (print (Label.toString label);
+                           print "\nloopLabels: ";
+                           print (List.toString Label.toString loopLabels);
+                           print "\nliveData:\n";
+                           Vector.foreach
+                           (liveData,
+                            fn {memloc, distanceF', distanceB', ...} => 
+                            (print (MemLoc.toString memloc);
+                             print ": ";
+                             case !distanceF' of
+                               NONE => print "?"
+                             | SOME (Position i) => (print "Pos "; print (I.toString i))
+                             | SOME (Length i) => (print "Len "; print (I'.toString i));
+                             print " ";
+                             case !distanceB' of
+                               NONE => print "?"
+                             | SOME (Position i) => (print "Pos "; print (I.toString i))
+                             | SOME (Length i) => (print "Len "; print (I'.toString i));
+                             print "\n"));
+                           print "regHints:\n";
+                           List.foreach
+                           (regHints,
+                            fn (memloc,register,sync) =>
+                            (print (MemLoc.toString memloc);
+                             print ": ";
+                             print (Register.toString register);
+                             print ": ";
+                             print (Bool.toString (!sync));
+                             print "\n"));
+                           print "fltregHints:\n";
+                           List.foreach
+                           (fltregHints,
+                            fn (memloc,sync) =>
+                            (print (MemLoc.toString memloc);
+                             print ": ";
+                             print (Bool.toString (!sync));
+                             print "\n"));
+                           print "live:\n";
+                           List.foreach
+                           (live,
+                            fn memloc
+                             => (print (MemLoc.toString memloc);
+                                 print "\n"));
+                           print "distance_F:\n";
+                           List.foreach
+                           (live,
+                            fn memloc
+                             => (print (MemLoc.toString memloc);
+                                 print ": ";
+                                 let
+                                   val (n, l) = get_distanceF {temp = memloc,
+                                                               label = label}
+                                 in
+                                   print (I.toString n);
+                                   print " ";
+                                   print (Option.toString Label.toString l)
+                                 end;
+                                 print "\n"));
+                           print "distance_B:\n";
+                           List.foreach
+                           (live,
+                            fn memloc
+                             => (print (MemLoc.toString memloc);
+                                 print ": ";
+                                 let
+                                   val (n, l) = get_distanceB {temp = memloc,
+                                                               label = label}
+                                 in
+                                   print (I.toString n);
+                                   print " ";
+                                   print (Option.toString Label.toString l)
+                                 end;
+                                 print "\n")))
 
-		      val live
-			= if not useB
-			    then List.keepAllMap
-			         (live,
-				  fn memloc
-				   => case get_distanceF {temp = memloc, 
-							  label = label}
-				        of (I.Finite n, SOME l)
-					 => if n < cutoff
-					      then if useLF
-						     then if List.contains
-						             (loopLabels,
-							      l, Label.equals)
-							    then SOME (memloc, n)
-							    else SOME (memloc, n * 5)
-						     else SOME (memloc, n)
-					      else NONE
-				         | (I.PosInfinity, _)
-					 => NONE
-					 | _
-					 => Error.bug 
-					    "computeLiveTransfers::get_distance")
-			    else List.keepAllMap
-			         (live,
-				  fn memloc
-				   => case (get_distanceB {temp = memloc, 
-							   label = label},
-					    get_distanceF {temp = memloc, 
-							   label = label})
-				        of ((I.PosInfinity, _), _)
-					 => NONE
-				         | (_, (I.PosInfinity, _))
-					 => NONE
-				         | ((I.Finite n, SOME nl), 
-					    (I.Finite m, SOME ml))
-				         => if (n + m) < cutoff
-					      then if useLF
-						     then case (List.contains
-								(loopLabels,
-								 nl, Label.equals),
-								List.contains
-								(loopLabels,
-								 ml, Label.equals))
-							    of (true, true)
-							     => SOME (memloc, n + m)
-							     | (true, false)
-							     => SOME (memloc, 
-								      n + 5 * m)
-							     | (false, true)
-							     => SOME (memloc,
-								      5 * n + m)
-							     | (false, false)
-							     => SOME (memloc,
-								      5 * n + 5 * m)
-						     else SOME (memloc, n + m)
-					      else NONE
-					 | _
-					 => Error.bug 
-					    "computeLiveTransfers::get_distance")
+                      val live
+                        = if not useB
+                            then List.keepAllMap
+                                 (live,
+                                  fn memloc
+                                   => case get_distanceF {temp = memloc, 
+                                                          label = label}
+                                        of (I.Finite n, SOME l)
+                                         => if n < cutoff
+                                              then if useLF
+                                                     then if List.contains
+                                                             (loopLabels,
+                                                              l, Label.equals)
+                                                            then SOME (memloc, n)
+                                                            else SOME (memloc, n * 5)
+                                                     else SOME (memloc, n)
+                                              else NONE
+                                         | (I.PosInfinity, _)
+                                         => NONE
+                                         | _
+                                         => Error.bug 
+                                            "x86LiveTransfers.computeLiveTransfers.live: get_distanceF")
+                            else List.keepAllMap
+                                 (live,
+                                  fn memloc
+                                   => case (get_distanceB {temp = memloc, 
+                                                           label = label},
+                                            get_distanceF {temp = memloc, 
+                                                           label = label})
+                                        of ((I.PosInfinity, _), _)
+                                         => NONE
+                                         | (_, (I.PosInfinity, _))
+                                         => NONE
+                                         | ((I.Finite n, SOME nl), 
+                                            (I.Finite m, SOME ml))
+                                         => if (n + m) < cutoff
+                                              then if useLF
+                                                     then case (List.contains
+                                                                (loopLabels,
+                                                                 nl, Label.equals),
+                                                                List.contains
+                                                                (loopLabels,
+                                                                 ml, Label.equals))
+                                                            of (true, true)
+                                                             => SOME (memloc, n + m)
+                                                             | (true, false)
+                                                             => SOME (memloc, 
+                                                                      n + 5 * m)
+                                                             | (false, true)
+                                                             => SOME (memloc,
+                                                                      5 * n + m)
+                                                             | (false, false)
+                                                             => SOME (memloc,
+                                                                      5 * n + 5 * m)
+                                                     else SOME (memloc, n + m)
+                                              else NONE
+                                         | _
+                                         => Error.bug 
+                                            "x86LiveTransfers.computeLiveTransfers.live: get_distanceB")
 
-		      (* List.partition will reverse the lists.
-		       * So sort in increasing order.
-		       *)
-		      val live
-			= List.insertionSort
-			  (live, fn ((_,n1),(_,n2)) => I'.>(n1, n2))
+                      (* List.partition will reverse the lists.
+                       * So sort in increasing order.
+                       *)
+                      val live
+                        = List.insertionSort
+                          (live, fn ((_,n1),(_,n2)) => I'.>(n1, n2))
 
-		      val _ 
-			= if true then () else
+                      val _ 
+                        = if true then () else
                           (print "live:\n";
-			   List.foreach
-			   (live,
-			    fn (memloc,n)
-			     => (print (MemLoc.toString memloc);
-				 print ": ";
-				 print (I'.toString n);
-				 print "\n")))
+                           List.foreach
+                           (live,
+                            fn (memloc,n)
+                             => (print (MemLoc.toString memloc);
+                                 print ": ";
+                                 print (I'.toString n);
+                                 print "\n")))
 
-		      val {yes = liveRegs, no = liveFltRegs}
-			= List.partition
-			  (live,
-			   fn (memloc,_) 
-			    => Size.class (MemLoc.size memloc) = Size.INT)
+                      val {yes = liveRegs, no = liveFltRegs}
+                        = List.partition
+                          (live,
+                           fn (memloc,_) 
+                            => Size.class (MemLoc.size memloc) = Size.INT)
 
-		      val liveRegs
-			= List.map
-			  (liveRegs,
-			   fn (memloc,weight)
-			    => case List.peek
-			            (regHints,
-				     fn (memloc',_,_)
-				      => MemLoc.eq(memloc,memloc'))
-				 of SOME (_,register',_)
-				 => (memloc,weight,SOME register')
-				 | NONE 
-				 => (memloc,weight,NONE))		  
+                      val liveRegs
+                        = List.map
+                          (liveRegs,
+                           fn (memloc,weight)
+                            => case List.peek
+                                    (regHints,
+                                     fn (memloc',_,_)
+                                      => MemLoc.eq(memloc,memloc'))
+                                 of SOME (_,register',_)
+                                 => (memloc,weight,SOME register')
+                                 | NONE 
+                                 => (memloc,weight,NONE))                 
 
-		      val rec doitRegs
-			= fn ([],_,liveTransfers) => liveTransfers
-		           | (_,[],liveTransfers) => liveTransfers
-		           | (transferRegs,
-			      (memloc,_,register)::live,
-			      liveTransfers)
-		           => let
-				fun finish register
-				  = let
-				      val transferRegs
-					= List.removeAll
-					  (transferRegs,
-					   fn register'
-					    => Register.coincide(register, 
-								 register'))
-				    in
-				      doitRegs 
-				      (transferRegs,
-				       live,
-				       (memloc,register,ref true)::liveTransfers)
-				    end
+                      val rec doitRegs
+                        = fn ([],_,liveTransfers) => liveTransfers
+                           | (_,[],liveTransfers) => liveTransfers
+                           | (transferRegs,
+                              (memloc,_,register)::live,
+                              liveTransfers)
+                           => let
+                                fun finish register
+                                  = let
+                                      val transferRegs
+                                        = List.removeAll
+                                          (transferRegs,
+                                           fn register'
+                                            => Register.coincide(register, 
+                                                                 register'))
+                                    in
+                                      doitRegs 
+                                      (transferRegs,
+                                       live,
+                                       (memloc,register,ref true)::liveTransfers)
+                                    end
 
-				fun default ()
-				  = let
-				      val size = MemLoc.size memloc
-				      val transferRegs'
-					= List.keepAllMap
-					  (transferRegs,
-					   fn register
-					    => if Size.eq
-					          (size,
-						   Register.size register)
-						 then SOME
-						      (register,
-						       List.index
-						       (live,
-							fn (_,_,SOME register')
-						         => Register.eq
-						            (register,
-							     register')
-							 | (_,_,NONE) => false))
-						 else NONE)
-				      val transferRegs'
-					= List.insertionSort
-					  (transferRegs',
-					   fn ((_,SOME index1),(_,SOME index2))
-					    => Int.>(index1, index2)
-					    | ((_, NONE),_)
-					    => true
-					    | (_, (_, NONE))
-					    => false)
-				    in
-				      case transferRegs'
-					of nil
-					 => doitRegs (transferRegs,
-						      live,
-						      liveTransfers)
-					 | (register,_)::_
-					 => finish register
-				    end
-			      in
-				case register
-				  of SOME register
-				   => if List.contains(transferRegs,
-						       register,
-						       Register.eq)
-					then finish register
-					else default ()
-				   | NONE => default ()
-			      end
+                                fun default ()
+                                  = let
+                                      val size = MemLoc.size memloc
+                                      val transferRegs'
+                                        = List.keepAllMap
+                                          (transferRegs,
+                                           fn register
+                                            => if Size.eq
+                                                  (size,
+                                                   Register.size register)
+                                                 then SOME
+                                                      (register,
+                                                       List.index
+                                                       (live,
+                                                        fn (_,_,SOME register')
+                                                         => Register.eq
+                                                            (register,
+                                                             register')
+                                                         | (_,_,NONE) => false))
+                                                 else NONE)
+                                      val transferRegs'
+                                        = List.insertionSort
+                                          (transferRegs',
+                                           fn ((_,SOME index1),(_,SOME index2))
+                                            => Int.>(index1, index2)
+                                            | ((_, NONE),_)
+                                            => true
+                                            | (_, (_, NONE))
+                                            => false)
+                                    in
+                                      case transferRegs'
+                                        of nil
+                                         => doitRegs (transferRegs,
+                                                      live,
+                                                      liveTransfers)
+                                         | (register,_)::_
+                                         => finish register
+                                    end
+                              in
+                                case register
+                                  of SOME register
+                                   => if List.contains(transferRegs,
+                                                       register,
+                                                       Register.eq)
+                                        then finish register
+                                        else default ()
+                                   | NONE => default ()
+                              end
 
-		      val liveRegsTransfers = doitRegs(transferRegs entry, liveRegs, [])
+                      val liveRegsTransfers = doitRegs(transferRegs entry, liveRegs, [])
 
 
-		      val liveFltRegs = take(liveFltRegs, transferFltRegs entry)
-		      val liveFltRegsTransfers
-			= List.map(liveFltRegs, fn (memloc, _) => (memloc, ref true))
-			  
+                      val liveFltRegs = take(liveFltRegs, transferFltRegs entry)
+                      val liveFltRegsTransfers
+                        = List.map(liveFltRegs, fn (memloc, _) => (memloc, ref true))
+                          
 
-		      val _ = liveTransfers := SOME (liveRegsTransfers, 
-						     liveFltRegsTransfers)
+                      val _ = liveTransfers := SOME (liveRegsTransfers, 
+                                                     liveFltRegsTransfers)
 
 (*
-		      val _
-			= (print "liveRegsTransfers:\n";
-			   List.foreach
-			   (liveRegsTransfers,
-			    fn (memloc,register,sync) =>
-			    (print (MemLoc.toString memloc);
-			     print ": ";
-			     print (Register.toString register);
-			     print ": ";
-			     print (Bool.toString (!sync));
-			     print "\n"));
-			   print "liveFltRegsTransfers:\n";
-			   List.foreach
-			   (liveFltRegsTransfers,
-			    fn (memloc,sync) =>
-			    (print (MemLoc.toString memloc);
-			     print ": ";
-			     print (Bool.toString (!sync));
-			     print "\n"));
-			   print "")
+                      val _
+                        = (print "liveRegsTransfers:\n";
+                           List.foreach
+                           (liveRegsTransfers,
+                            fn (memloc,register,sync) =>
+                            (print (MemLoc.toString memloc);
+                             print ": ";
+                             print (Register.toString register);
+                             print ": ";
+                             print (Bool.toString (!sync));
+                             print "\n"));
+                           print "liveFltRegsTransfers:\n";
+                           List.foreach
+                           (liveFltRegsTransfers,
+                            fn (memloc,sync) =>
+                            (print (MemLoc.toString memloc);
+                             print ": ";
+                             print (Bool.toString (!sync));
+                             print "\n"));
+                           print "")
 *)
 
-		      fun doit' label = enque {label = label, 
-					       hints = (liveRegsTransfers,
-							liveFltRegsTransfers)}
-		      fun doit'' label = enque {label = label, 
-						hints = ([],[])}
-		      fun doit''' func label =
-			 let
-			    val hints =
-			       List.fold
-			       (Operand.cReturnTemps (CFunction.return func),
-				([],[]),
-				fn ({src, dst}, (regHints, fltregHints)) =>
-				case src of
-				   Operand.Register reg =>
-				      ((dst, reg, ref true) :: regHints,
-				       fltregHints)
-				 | Operand.FltRegister _ =>
-				      (regHints,
-				       (dst, ref true) :: fltregHints)
-				 | _ => (regHints, fltregHints))
-			 in
-			    enque {hints = hints,
-				   label = label}
-			 end
-		      datatype z = datatype Transfer.t
-		    in
-		      case transfer
-			of Goto {target, ...} 
-			 => (doit' target)
-			 | Iff {truee, falsee, ...}
-			 => (doit' truee;
-			     doit' falsee)
-			 | Switch {cases, default, ...}
-			 => (doit' default;
-			     Transfer.Cases.foreach(cases, doit'))
-			 | Tail {...}
-			 => ()
-			 | NonTail {return, handler, ...}
-			 => (doit'' return;
-			     case handler 
-			       of SOME handler => doit'' handler
-				| NONE => ())
-			 | Return {...}
-			 => ()
-			 | Raise {...}
-			 => ()
-			 | CCall {func, return, ...}
-			 => if CFunction.maySwitchThreads func
-			      then Option.app (return, doit'')
-			    else Option.app (return, doit''' func)
-		    end
-	    end
+                      fun doit' label = enque {label = label, 
+                                               hints = (liveRegsTransfers,
+                                                        liveFltRegsTransfers)}
+                      fun doit'' label = enque {label = label, 
+                                                hints = ([],[])}
+                      fun doit''' func label =
+                         let
+                            val hints =
+                               List.fold
+                               (Operand.cReturnTemps (CFunction.return func),
+                                ([],[]),
+                                fn ({src, dst}, (regHints, fltregHints)) =>
+                                case src of
+                                   Operand.Register reg =>
+                                      ((dst, reg, ref true) :: regHints,
+                                       fltregHints)
+                                 | Operand.FltRegister _ =>
+                                      (regHints,
+                                       (dst, ref true) :: fltregHints)
+                                 | _ => (regHints, fltregHints))
+                         in
+                            enque {hints = hints,
+                                   label = label}
+                         end
+                      datatype z = datatype Transfer.t
+                    in
+                      case transfer
+                        of Goto {target, ...} 
+                         => (doit' target)
+                         | Iff {truee, falsee, ...}
+                         => (doit' truee;
+                             doit' falsee)
+                         | Switch {cases, default, ...}
+                         => (doit' default;
+                             Transfer.Cases.foreach(cases, doit' o #2))
+                         | Tail {...}
+                         => ()
+                         | NonTail {return, handler, ...}
+                         => (doit'' return;
+                             case handler 
+                               of SOME handler => doit'' handler
+                                | NONE => ())
+                         | Return {...}
+                         => ()
+                         | Raise {...}
+                         => ()
+                         | CCall {func, return, ...}
+                         => if CFunction.maySwitchThreads func
+                              then Option.app (return, doit'')
+                            else Option.app (return, doit''' func)
+                    end
+            end
 
-	val _ = Vector.foreach
-	        (funcs, 
-		 fn label => enque {label = label, hints = ([],[])})
+        val _ = Vector.foreach
+                (funcs, 
+                 fn label => enque {label = label, hints = ([],[])})
 
-	fun loop ()
-	  = (case deque ()
-	       of NONE => ()
-		| SOME {label, hints}
-		=> (doit {label = label, hints = hints};
-		    loop ()))
-	val _ = loop ()
+        fun loop ()
+          = (case deque ()
+               of NONE => ()
+                | SOME {label, hints}
+                => (doit {label = label, hints = hints};
+                    loop ()))
+        val _ = loop ()
 
-	fun doit {label, defed = defed'}
-	  = let
+        fun doit {label, defed = defed'}
+          = let
 
-	      val {block, liveTransfers, defed, ...} = getInfo label
-	      val (liveRegs, liveFltRegs) = valOf (!liveTransfers)
+              val {block, liveTransfers, defed, ...} = getInfo label
+              val (liveRegs, liveFltRegs) = valOf (!liveTransfers)
 
-	      val defed'
-		= case getNear(jumpInfo, label)
-		    of None => MemLocSet.empty
-		     | Count 0 => MemLocSet.empty
-		     | Count 1 => defed'
-		     | Count _ 
-		     => MemLocSet.subset
-		        (defed',
-			 fn memloc
-			  => List.exists
-			     (liveRegs, 
-			      fn (memloc',_,_) => MemLoc.eq(memloc', memloc))
-			     orelse
-			     List.exists
-			     (liveFltRegs, 
-			      fn (memloc',_) => MemLoc.eq(memloc', memloc)))
+              val defed'
+                = case getNear(jumpInfo, label)
+                    of None => MemLocSet.empty
+                     | Count 0 => MemLocSet.empty
+                     | Count 1 => defed'
+                     | Count _ 
+                     => MemLocSet.subset
+                        (defed',
+                         fn memloc
+                          => List.exists
+                             (liveRegs, 
+                              fn (memloc',_,_) => MemLoc.eq(memloc', memloc))
+                             orelse
+                             List.exists
+                             (liveFltRegs, 
+                              fn (memloc',_) => MemLoc.eq(memloc', memloc)))
 
-	      fun default defed''
-		= let
-		    val Block.T {entry, statements, transfer, ...} = block
+              fun default defed''
+                = let
+                    val Block.T {entry, statements, transfer, ...} = block
 
-		    val _ = List.foreach
-		            (liveRegs,
-			     fn (memloc,_,sync) 
-			      => if MemLocSet.contains(defed', memloc)
-				   then sync := false
-				   else ())
-		    val _ = List.foreach
-		            (liveFltRegs,
-			     fn (memloc,sync) 
-			      => if MemLocSet.contains(defed', memloc)
-				   then sync := false
-				   else ())
+                    val _ = List.foreach
+                            (liveRegs,
+                             fn (memloc,_,sync) 
+                              => if MemLocSet.contains(defed', memloc)
+                                   then sync := false
+                                   else ())
+                    val _ = List.foreach
+                            (liveFltRegs,
+                             fn (memloc,sync) 
+                              => if MemLocSet.contains(defed', memloc)
+                                   then sync := false
+                                   else ())
 
-		    val defed' = MemLocSet.+(defed'', defed')
-		    val _ = defed := SOME defed'
+                    val defed' = MemLocSet.+(defed'', defed')
+                    val _ = defed := SOME defed'
 
-		    fun doit' (defed', defs)
-		      = List.fold
-		        (defs,
-			 defed',
-			 fn (def,defed')
-			  => case Operand.deMemloc def
-			       of SOME def => if track def
-						then MemLocSet.add(defed', def)
-						else defed'
-			        | NONE => defed')
+                    fun doit' (defed', defs)
+                      = List.fold
+                        (defs,
+                         defed',
+                         fn (def,defed')
+                          => case Operand.deMemloc def
+                               of SOME def => if track def
+                                                then MemLocSet.add(defed', def)
+                                                else defed'
+                                | NONE => defed')
 
-		       val {defs, ...} = Entry.uses_defs_kills entry
-		       val defed' = doit' (defed', defs)
+                       val {defs, ...} = Entry.uses_defs_kills entry
+                       val defed' = doit' (defed', defs)
 
-		       val defed'
-			 = List.fold
-			   (statements,
-			    defed',
-			    fn (asm,defed')
-			     => let
-				  val {defs, ...} = Assembly.uses_defs_kills asm
-				in
-				  doit' (defed', defs)
-				end)
+                       val defed'
+                         = List.fold
+                           (statements,
+                            defed',
+                            fn (asm,defed')
+                             => let
+                                  val {defs, ...} = Assembly.uses_defs_kills asm
+                                in
+                                  doit' (defed', defs)
+                                end)
 
-		       val {defs, ...} = Transfer.uses_defs_kills transfer
-		       val defed' = doit' (defed', defs)
+                       val {defs, ...} = Transfer.uses_defs_kills transfer
+                       val defed' = doit' (defed', defs)
 
-		       fun doit' label = doit {label = label,
-					       defed = defed'}
-		       fun doit'' label = doit {label = label,
-						defed = MemLocSet.empty}
+                       fun doit' label = doit {label = label,
+                                               defed = defed'}
+                       fun doit'' label = doit {label = label,
+                                                defed = MemLocSet.empty}
 
-		       datatype z = datatype Transfer.t
-		  in
-		    case transfer
-		      of Goto {target, ...}
-		       => (doit' target)
-		       | Iff {truee, falsee, ...}
-		       => (doit' truee;
-			   doit' falsee)
-		       | Switch {cases, default, ...}
-		       => (Transfer.Cases.foreach(cases, doit');
-			   doit' default)
-		       | Tail {...}
-		       => ()
-		       | NonTail {return, handler, ...}
-		       => (doit'' return;
-			   case handler 
-			     of SOME handler => doit'' handler
-			      | NONE => ())
-		       | Return {...}
-		       => ()
-		       | Raise {...}
-		       => ()
-		       | CCall {func, return, ...}
-		       => if CFunction.maySwitchThreads func
-			    then Option.app (return, doit'')
-			    else Option.app (return, doit')
-		  end
-	    in
-	      case !defed
-		of NONE => default MemLocSet.empty
-		 | SOME defed => if MemLocSet.<=(defed',defed)
-				   then ()
-				   else default defed
-	    end
-	  
-	val _ = Vector.foreach
-	        (funcs,
-		 fn label => doit {label = label, 
-				   defed = MemLocSet.empty})
+                       datatype z = datatype Transfer.t
+                  in
+                    case transfer
+                      of Goto {target, ...}
+                       => (doit' target)
+                       | Iff {truee, falsee, ...}
+                       => (doit' truee;
+                           doit' falsee)
+                       | Switch {cases, default, ...}
+                       => (Transfer.Cases.foreach(cases, doit' o #2);
+                           doit' default)
+                       | Tail {...}
+                       => ()
+                       | NonTail {return, handler, ...}
+                       => (doit'' return;
+                           case handler 
+                             of SOME handler => doit'' handler
+                              | NONE => ())
+                       | Return {...}
+                       => ()
+                       | Raise {...}
+                       => ()
+                       | CCall {func, return, ...}
+                       => if CFunction.maySwitchThreads func
+                            then Option.app (return, doit'')
+                            else Option.app (return, doit')
+                  end
+            in
+              case !defed
+                of NONE => default MemLocSet.empty
+                 | SOME defed => if MemLocSet.<=(defed',defed)
+                                   then ()
+                                   else default defed
+            end
+          
+        val _ = Vector.foreach
+                (funcs,
+                 fn label => doit {label = label, 
+                                   defed = MemLocSet.empty})
 
-	val {get = getLiveTransfers : 
-	     Label.t -> ((MemLoc.t * Register.t * bool) list *
-			 (MemLoc.t * bool) list),
-	     set = setLiveTransfers, ...}
-	   = Property.getSet
-	     (Label.plist, 
-	      Property.initRaise ("x86LiveTransfers:getLiveTransfers", Label.layout))
+        val {get = getLiveTransfers : 
+             Label.t -> ((MemLoc.t * Register.t * bool) list *
+                         (MemLoc.t * bool) list),
+             set = setLiveTransfers, ...}
+           = Property.getSet
+             (Label.plist, 
+              Property.initRaise ("x86LiveTransfers:getLiveTransfers", Label.layout))
 
-	val _ = Vector.foreach
-	        (labels,
-		 fn label
-		  => let
-		       val {liveTransfers, ...} = getInfo label
-		       val (liveRegs, liveFltRegs) = valOf (!liveTransfers)
-		       val (liveRegs, liveFltRegs)
-			 = if sync
-			     then (List.map
-				   (liveRegs, 
-				    fn (memloc,reg, sync) => (memloc, reg, !sync)),
-				   List.map
-				   (liveFltRegs, 
-				    fn (memloc, sync) => (memloc, !sync)))
-			     else (List.map
-				   (liveRegs, 
-				    fn (memloc,reg, _) => (memloc, reg, false)),
-				   List.map
-				   (liveFltRegs, 
-				    fn (memloc, _) => (memloc, false)))
-		     in
-		       setLiveTransfers(label, (liveRegs, liveFltRegs))
-		     end)
+        val _ = Vector.foreach
+                (labels,
+                 fn label
+                  => let
+                       val {liveTransfers, ...} = getInfo label
+                       val (liveRegs, liveFltRegs) = valOf (!liveTransfers)
+                       val (liveRegs, liveFltRegs)
+                         = if sync
+                             then (List.map
+                                   (liveRegs, 
+                                    fn (memloc,reg, sync) => (memloc, reg, !sync)),
+                                   List.map
+                                   (liveFltRegs, 
+                                    fn (memloc, sync) => (memloc, !sync)))
+                             else (List.map
+                                   (liveRegs, 
+                                    fn (memloc,reg, _) => (memloc, reg, false)),
+                                   List.map
+                                   (liveFltRegs, 
+                                    fn (memloc, _) => (memloc, false)))
+                     in
+                       setLiveTransfers(label, (liveRegs, liveFltRegs))
+                     end)
 
-	val _ = destInfo ()
+        val _ = destInfo ()
       in
-	T {get = getLiveTransfers,
-	   set = setLiveTransfers}
+        T {get = getLiveTransfers,
+           set = setLiveTransfers}
       end
 
 
   val computeLiveTransfers 
     = fn {chunk, transferRegs, transferFltRegs, liveInfo, jumpInfo, loopInfo}
        => if !Control.Native.liveTransfer > 0
-	    then computeLiveTransfers {chunk = chunk, 
-				       transferRegs = transferRegs,
-				       transferFltRegs = transferFltRegs,
-				       liveInfo = liveInfo, 
-				       jumpInfo = jumpInfo,
-				       loopInfo = loopInfo}
-	    else let
-		   val {get = getLiveTransfers,
-			set = setLiveTransfers, ...}
-		     = Property.getSetOnce(Label.plist, 
-					   Property.initConst ([], []))
-		 in
-		   T {get = getLiveTransfers,
-		      set = setLiveTransfers}
-		 end
+            then computeLiveTransfers {chunk = chunk, 
+                                       transferRegs = transferRegs,
+                                       transferFltRegs = transferFltRegs,
+                                       liveInfo = liveInfo, 
+                                       jumpInfo = jumpInfo,
+                                       loopInfo = loopInfo}
+            else let
+                   val {get = getLiveTransfers,
+                        set = setLiveTransfers, ...}
+                     = Property.getSetOnce(Label.plist, 
+                                           Property.initConst ([], []))
+                 in
+                   T {get = getLiveTransfers,
+                      set = setLiveTransfers}
+                 end
 
   val (computeLiveTransfers : {chunk : Chunk.t,
-			       transferRegs : Entry.t -> Register.t list,
-			       transferFltRegs : Entry.t -> Int.t,
-			       liveInfo : LiveInfo.t,
-			       jumpInfo : x86JumpInfo.t,
-			       loopInfo : x86LoopInfo.t} -> t,
+                               transferRegs : Entry.t -> Register.t list,
+                               transferFltRegs : Entry.t -> Int.t,
+                               liveInfo : LiveInfo.t,
+                               jumpInfo : x86JumpInfo.t,
+                               loopInfo : x86LoopInfo.t} -> t,
        computeLiveTransfers_msg)
     = tracerTop
       "computeLiveTransfers"

Modified: mlton/branches/on-20050420-cmm-branch/mlton/codegen/x86-codegen/x86-live-transfers.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/codegen/x86-codegen/x86-live-transfers.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/codegen/x86-codegen/x86-live-transfers.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature X86_LIVE_TRANSFERS_STRUCTS =
   sig
     structure x86 : X86
@@ -25,15 +26,15 @@
     type t
 
     val computeLiveTransfers : {chunk : x86.Chunk.t,
-				transferRegs : x86.Entry.t -> x86.Register.t list,
-				transferFltRegs : x86.Entry.t -> Int.t, 
-				liveInfo : x86Liveness.LiveInfo.t,
-				jumpInfo : x86JumpInfo.t,
-				loopInfo : x86LoopInfo.t} -> t
+                                transferRegs : x86.Entry.t -> x86.Register.t list,
+                                transferFltRegs : x86.Entry.t -> Int.t, 
+                                liveInfo : x86Liveness.LiveInfo.t,
+                                jumpInfo : x86JumpInfo.t,
+                                loopInfo : x86LoopInfo.t} -> t
     val computeLiveTransfers_totals : unit -> unit
 
     val getLiveTransfers : t * x86.Label.t -> 
                            ((x86.MemLoc.t * x86.Register.t * bool) list *
-			    (x86.MemLoc.t * bool) list)
+                            (x86.MemLoc.t * bool) list)
     val setLiveTransfersEmpty : t * x86.Label.t -> unit 
   end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/codegen/x86-codegen/x86-liveness.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/codegen/x86-codegen/x86-liveness.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/codegen/x86-codegen/x86-liveness.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,9 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 functor x86Liveness(S: X86_LIVENESS_STRUCTS) : X86_LIVENESS =
@@ -17,12 +17,12 @@
   val tracerTop = x86.tracerTop
 
   structure LiveSet = struct 
-			open MemLocSet
-			fun fromMemLocSet s = s
-			fun toMemLocSet s = s
-		      end
+                        open MemLocSet
+                        fun fromMemLocSet s = s
+                        fun toMemLocSet s = s
+                      end
   fun track memloc = ClassSet.contains(!x86MLtonBasic.Classes.livenessClasses, 
-				       MemLoc.class memloc)
+                                       MemLoc.class memloc)
 
   fun livenessOperands live
     = List.fold
@@ -30,11 +30,11 @@
        LiveSet.empty,
        fn (operand, live)
         => (case Operand.deMemloc operand
-	      of NONE => live
-	       | SOME memloc
-	       => if track memloc
-		    then LiveSet.add(live, memloc)
-		    else live))
+              of NONE => live
+               | SOME memloc
+               => if track memloc
+                    then LiveSet.add(live, memloc)
+                    else live))
 
   fun livenessMemlocs live
     = MemLocSet.fold
@@ -42,257 +42,218 @@
        LiveSet.empty,
        fn (memloc, live) 
         => if track memloc
-	     then LiveSet.add(live, memloc)
-	     else live)
+             then LiveSet.add(live, memloc)
+             else live)
 
   structure LiveInfo =
     struct
       datatype t = T of {get: Label.t -> LiveSet.t,
-			 set: Label.t * LiveSet.t -> unit}
+                         set: Label.t * LiveSet.t -> unit}
       
       fun newLiveInfo ()
-	= let
-	    val {get : Label.t -> LiveSet.t,
-		 set : Label.t * LiveSet.t -> unit, ...}
-	      = Property.getSet
-	        (Label.plist, Property.initRaise ("liveInfo", Label.layout))
-	  in
-	    T {get = get, set = set}
-	  end
+        = let
+            val {get : Label.t -> LiveSet.t,
+                 set : Label.t * LiveSet.t -> unit, ...}
+              = Property.getSet
+                (Label.plist, Property.initRaise ("liveInfo", Label.layout))
+          in
+            T {get = get, set = set}
+          end
 
       fun setLiveOperands (T {set, ...}, label, live)
-	= set(label, livenessOperands live)
+        = set(label, livenessOperands live)
       fun setLiveMemlocs (T {set, ...}, label, live)
-	= set(label, livenessMemlocs live)
+        = set(label, livenessMemlocs live)
       fun setLive (T {set, ...}, label, live)
-	= set(label, live)
+        = set(label, live)
       fun getLive (T {get, ...}, label)
-	= get label
+        = get label
     end
 
   fun liveness_uses_defs {uses : Operand.t list,
-			  defs : Operand.t list} :
+                          defs : Operand.t list} :
                          {uses : LiveSet.t,
-			  defs : LiveSet.t}
+                          defs : LiveSet.t}
     = let
-	val baseUses = livenessOperands uses
-	val livenessUses 
-	  = let
-	      fun doit (operands, livenessUses)
-		= List.fold
-		  (operands,
-		   livenessUses,
-		   fn (operand, livenessUses)
-		    => case Operand.deMemloc operand
-			 of SOME memloc
-			  => List.fold
-		             (MemLoc.utilized memloc,
-			      livenessUses,
-			      fn (memloc, livenessUses)
-			       => if track memloc
-				    then LiveSet.add(livenessUses, memloc)
-				    else livenessUses)
-			  | NONE => livenessUses)
-	    in
-	      doit(defs,
-	      doit(uses,
-		   baseUses))
-	    end
+        val baseUses = livenessOperands uses
+        val livenessUses 
+          = let
+              fun doit (operands, livenessUses)
+                = List.fold
+                  (operands,
+                   livenessUses,
+                   fn (operand, livenessUses)
+                    => case Operand.deMemloc operand
+                         of SOME memloc
+                          => List.fold
+                             (MemLoc.utilized memloc,
+                              livenessUses,
+                              fn (memloc, livenessUses)
+                               => if track memloc
+                                    then LiveSet.add(livenessUses, memloc)
+                                    else livenessUses)
+                          | NONE => livenessUses)
+            in
+              doit(defs,
+              doit(uses,
+                   baseUses))
+            end
 
-	val baseDefs = livenessOperands defs
-	val livenessDefs = baseDefs
+        val baseDefs = livenessOperands defs
+        val livenessDefs = baseDefs
       in
-	{uses = livenessUses,
-	 defs = livenessDefs}
+        {uses = livenessUses,
+         defs = livenessDefs}
       end
 
   structure Liveness = 
     struct
        datatype t = T of {liveIn: LiveSet.t,
-			  liveOut: LiveSet.t,
-			  dead: LiveSet.t}
+                          liveOut: LiveSet.t,
+                          dead: LiveSet.t}
 
        local
-	  fun make f (T r) = f r
+          fun make f (T r) = f r
        in
-	  val dead = make #dead
-	  val liveIn = make #liveIn
-	  val liveOut = make #liveOut
+          val dead = make #dead
+          val liveIn = make #liveIn
+          val liveOut = make #liveOut
        end
 
       fun toString (T {liveIn, liveOut, dead})
-	= let
-	    fun doit (name, l, toString, s)
-	      = LiveSet.fold(l, s,
-			     fn (x, s)
-			      => concat [name, toString x, "\n", s])
-	  in
-	    doit("liveIn: ", liveIn, MemLoc.toString,
-	    doit("liveOut: ", liveOut, MemLoc.toString,
-	    doit("dead: ", dead, MemLoc.toString,
-		 "")))
-	  end
-	
+        = let
+            fun doit (name, l, toString, s)
+              = LiveSet.fold(l, s,
+                             fn (x, s)
+                              => concat [name, toString x, "\n", s])
+          in
+            doit("liveIn: ", liveIn, MemLoc.toString,
+            doit("liveOut: ", liveOut, MemLoc.toString,
+            doit("dead: ", dead, MemLoc.toString,
+                 "")))
+          end
+        
 
       fun eq (T {liveIn = liveIn1,
-		 liveOut = liveOut1,
-		 dead = dead1},
-	      T {liveIn = liveIn2,
-		 liveOut = liveOut2,
-		 dead = dead2})
-	= LiveSet.equals(liveIn1, liveIn2) andalso
-	  LiveSet.equals(liveOut1, liveOut2) andalso
-	  LiveSet.equals(dead1, dead2)	      
+                 liveOut = liveOut1,
+                 dead = dead1},
+              T {liveIn = liveIn2,
+                 liveOut = liveOut2,
+                 dead = dead2})
+        = LiveSet.equals(liveIn1, liveIn2) andalso
+          LiveSet.equals(liveOut1, liveOut2) andalso
+          LiveSet.equals(dead1, dead2)        
 
-(*
-      fun invariant (T {liveIn : LiveSet.t,
-			liveOut : LiveSet.t,
-			dead : LiveSet.t})
-	= let
-	    val rec check 
-	      = fn [] => true
-	         | m::l => List.forall
-	                   (l, 
-			    fn m' 
-			     => if not(MemLoc.mayAlias(m,m'))
-				  then true
-				  else (print 
-					(concat 
-					 ["\nmayAlias:\n",
-					  MemLoc.toString m,
-					  "\n",
-					  MemLoc.toString m',
-					  "\n"]);
-					false))
-                           andalso
-			   check l
-
-	    fun doit s
-	      = let
-		  val _
-		    = Assert.assert
-		      ("invariant - mayAlias",
-		       fn () => check (LiveSet.toList s))
-		in
-		  s
-		end
-	  in
-	    {liveIn = doit liveIn,
-	     liveOut = doit liveOut,
-	     dead = doit dead}
-	  end
-*)
-
       fun liveness ({uses : LiveSet.t,
-		     defs : LiveSet.t,
-		     live : LiveSet.t}) : t
-	= let
-	    val liveOut = live
+                     defs : LiveSet.t,
+                     live : LiveSet.t}) : t
+        = let
+            val liveOut = live
 
-	    (* liveIn = uses \/ (liveOut - defs) *)
-	    val liveIn = LiveSet.+(uses, LiveSet.-(live, defs))
+            (* liveIn = uses \/ (liveOut - defs) *)
+            val liveIn = LiveSet.+(uses, LiveSet.-(live, defs))
 
-	    (* dead = (liveIn \/ defs) - liveOut *)
-	    val dead = LiveSet.-(LiveSet.+(liveIn, defs), liveOut)
-	  in
-	    (* invariant *) T {liveIn = liveIn,
-			       liveOut = liveOut,
-			       dead = dead}
-	  end
+            (* dead = (liveIn \/ defs) - liveOut *)
+            val dead = LiveSet.-(LiveSet.+(liveIn, defs), liveOut)
+          in
+            T {liveIn = liveIn,
+               liveOut = liveOut,
+               dead = dead}
+          end
 
       fun livenessEntry {entry : Entry.t,
-			 live : LiveSet.t} : t
-	= let
-	    val {uses, defs, ...} = Entry.uses_defs_kills entry
-	    val {uses, defs} = liveness_uses_defs {uses = uses, defs = defs}
-	    val defs = MemLocSet.fold
-	               (Entry.live entry,
-			defs,
-			fn (memloc, defs)
-			 => if track memloc
-			      then LiveSet.add(defs, memloc)
-			      else defs)
-	  in
-	    liveness {uses = uses,
-		      defs = defs,
-		      live = live}
-	  end
+                         live : LiveSet.t} : t
+        = let
+            val {uses, defs, ...} = Entry.uses_defs_kills entry
+            val {uses, defs} = liveness_uses_defs {uses = uses, defs = defs}
+            val defs = MemLocSet.fold
+                       (Entry.live entry,
+                        defs,
+                        fn (memloc, defs)
+                         => if track memloc
+                              then LiveSet.add(defs, memloc)
+                              else defs)
+          in
+            liveness {uses = uses,
+                      defs = defs,
+                      live = live}
+          end
 
       fun livenessAssembly {assembly : Assembly.t,
-			    live : LiveSet.t} : t
-	= let
-	    val {uses, defs, ...} = Assembly.uses_defs_kills assembly
-	    val {uses, defs} = liveness_uses_defs {uses = uses, defs = defs}
-	  in
-	    liveness {uses = uses,
-		      defs = defs,
-		      live = live}
-	  end
+                            live : LiveSet.t} : t
+        = let
+            val {uses, defs, ...} = Assembly.uses_defs_kills assembly
+            val {uses, defs} = liveness_uses_defs {uses = uses, defs = defs}
+          in
+            liveness {uses = uses,
+                      defs = defs,
+                      live = live}
+          end
 
       fun livenessTransfer' {transfer: Transfer.t,
-			     live : LiveSet.t} : t
-	= let
-	    val {uses,defs,...} = Transfer.uses_defs_kills transfer
-	    val {uses,defs} = liveness_uses_defs {uses = uses, defs = defs}
-	    (* Transfer.live transfer could be considered uses,
-	     *  but the Liveness.t of a transfer should have
-	     *  Transfer.live transfer as liveOut.
-	     *)
-	    val live = MemLocSet.fold
-	               (Transfer.live transfer,
-			live,
-			fn (memloc, live)
-			 => if track memloc
-			      then LiveSet.add(live, memloc)
-			      else live)
-	  in 
-	    liveness {uses = uses,
-		      defs = defs,
-		      live = live}
-	  end
+                             live : LiveSet.t} : t
+        = let
+            val {uses,defs,...} = Transfer.uses_defs_kills transfer
+            val {uses,defs} = liveness_uses_defs {uses = uses, defs = defs}
+            (* Transfer.live transfer could be considered uses,
+             *  but the Liveness.t of a transfer should have
+             *  Transfer.live transfer as liveOut.
+             *)
+            val live = MemLocSet.fold
+                       (Transfer.live transfer,
+                        live,
+                        fn (memloc, live)
+                         => if track memloc
+                              then LiveSet.add(live, memloc)
+                              else live)
+          in 
+            liveness {uses = uses,
+                      defs = defs,
+                      live = live}
+          end
 
       fun livenessTransfer {transfer: Transfer.t,
-			    liveInfo: LiveInfo.t} : t
-	= let
-	    val targets = Transfer.nearTargets transfer
-	    val live
-	      = List.fold
-	        (targets,
-		 LiveSet.empty,
-		 fn (target, live) 
-	          => LiveSet.union(LiveInfo.getLive(liveInfo, target), 
-				   live))
-	  in
-	    livenessTransfer' {transfer = transfer,
-			       live = live}
-	  end
+                            liveInfo: LiveInfo.t} : t
+        = let
+            val targets = Transfer.nearTargets transfer
+            val live
+              = List.fold
+                (targets,
+                 LiveSet.empty,
+                 fn (target, live) 
+                  => LiveSet.union(LiveInfo.getLive(liveInfo, target), 
+                                   live))
+          in
+            livenessTransfer' {transfer = transfer,
+                               live = live}
+          end
 
       fun livenessBlock {block = Block.T {entry, statements, transfer, ...},
-			 liveInfo : LiveInfo.t}
-	= let
-	    val T {liveIn = live, ...}
-	      = livenessTransfer {transfer = transfer,
-				  liveInfo = liveInfo}
+                         liveInfo : LiveInfo.t}
+        = let
+            val T {liveIn = live, ...}
+              = livenessTransfer {transfer = transfer,
+                                  liveInfo = liveInfo}
 
-	    val live
-	      = List.foldr
-	        (statements,
-		 live,
-		 fn (asm,live)
-		  => let
-		       val T {liveIn = live, ...}
-			 = livenessAssembly {assembly = asm,
-					     live = live}
-		     in
-		       live
-		     end)
+            val live
+              = List.foldr
+                (statements,
+                 live,
+                 fn (asm,live)
+                  => let
+                       val T {liveIn = live, ...}
+                         = livenessAssembly {assembly = asm,
+                                             live = live}
+                     in
+                       live
+                     end)
 
-	    val T {liveIn = live, ...} 
-	      = livenessEntry {entry = entry,
-			       live = live}
-	  in
-	    live
-	  end
+            val T {liveIn = live, ...} 
+              = livenessEntry {entry = entry,
+                               live = live}
+          in
+            live
+          end
     end
 
   structure LiveInfo =
@@ -300,500 +261,500 @@
       open LiveInfo
 
       fun completeLiveInfo {chunk = Chunk.T {blocks, ...}, 
-			    liveInfo : LiveInfo.t,
-			    pass: string}
-	= let
-	    val {get = getBlockInfo : 
-		       Label.t -> {pred: Label.t list ref,
-				   block: Block.t option ref,
-				   topo: int ref},
-		 destroy = destBlockInfo}
-	      = Property.destGet
-	        (Label.plist,
-		 Property.initFun (fn _ => {pred = ref [],
-					    block = ref NONE,
-					    topo = ref ~1}))
-	    val get_pred = (#pred o getBlockInfo)
-	    val get_topo = (#topo o getBlockInfo)
-	    val get_pred' = (! o #pred o getBlockInfo)
-	    val get_block' = (! o #block o getBlockInfo)
-	    val get_topo' = (! o #topo o getBlockInfo)
-	      
-	    val labels
-	      = List.map
-	        (blocks,
-		 fn block' as Block.T {entry, transfer,...}
-		  => let
-		       val label = Entry.label entry
-		       val {block,topo,...} = getBlockInfo label
-		       val targets = Transfer.nearTargets transfer
-		     in 
-		       block := SOME block';
-		       topo := 0;
-		       List.foreach
-		       (targets,
-			fn target => List.push(get_pred target, label));
-		       label
-		     end)
-		
-	    local
-	      val todo = ref []
-	      fun topo_order(x,y) = Int.compare(get_topo' x, get_topo' y)
+                            liveInfo : LiveInfo.t,
+                            pass: string}
+        = let
+            val {get = getBlockInfo : 
+                       Label.t -> {pred: Label.t list ref,
+                                   block: Block.t option ref,
+                                   topo: int ref},
+                 destroy = destBlockInfo}
+              = Property.destGet
+                (Label.plist,
+                 Property.initFun (fn _ => {pred = ref [],
+                                            block = ref NONE,
+                                            topo = ref ~1}))
+            val get_pred = (#pred o getBlockInfo)
+            val get_topo = (#topo o getBlockInfo)
+            val get_pred' = (! o #pred o getBlockInfo)
+            val get_block' = (! o #block o getBlockInfo)
+            val get_topo' = (! o #topo o getBlockInfo)
+              
+            val labels
+              = List.map
+                (blocks,
+                 fn block' as Block.T {entry, transfer,...}
+                  => let
+                       val label = Entry.label entry
+                       val {block,topo,...} = getBlockInfo label
+                       val targets = Transfer.nearTargets transfer
+                     in 
+                       block := SOME block';
+                       topo := 0;
+                       List.foreach
+                       (targets,
+                        fn target => List.push(get_pred target, label));
+                       label
+                     end)
+                
+            local
+              val todo = ref []
+              fun topo_order(x,y) = Int.compare(get_topo' x, get_topo' y)
 
-	      fun insert (l, x, compare)
-		= let
-		    val rec insert'
-		      = fn ([],acc) => List.appendRev(acc, [x])
-		         | (l as h::t,acc) 
-		         => (case compare(h,x)
-			       of LESS
-				=> insert' (t, h::acc)
-			        | EQUAL
-				=> List.appendRev(acc, l)
-			        | GREATER
-			        => List.appendRev(acc, x::l))
-		  in
-		    insert' (l,[])
-		  end
-	    in
-	      fun add_todo x = todo := insert(!todo, x, topo_order)
-	      fun push_todo x = todo := x::(!todo)
-	      fun rev_todo () = todo := List.rev (!todo)
-	      fun get_todo () 
-		= (case !todo
-		     of [] => NONE
-		      | (x::todo') => (todo := todo';
-				       SOME x))
-	    end
-	  
-	    local
-	      val num = Counter.new 1
-	    in
-	      fun topo_sort label
-		= let
-		    val {topo, pred, ...} = getBlockInfo label
-		  in
-		    if !topo = 0
-		      then (topo := Counter.next num;
-			    push_todo label;
-			    List.foreach(!pred, topo_sort))
-		      else ()
-		  end
-	      fun topo_root label
-		= (get_topo label := Counter.next num;
-		   push_todo label)
-	    end
-	  
-	    fun loop (labels, n)
-	      = if List.isEmpty labels
-		  then ()
-		  else let
-			 val {yes = exits, no = labels}
-			   = List.partition
-			     (labels,
-			      fn label
-			       => let
-				    val Block.T {transfer, ...} 
-				      = valOf (get_block' label)
-				    val targets = Transfer.nearTargets transfer
-				      
-				    val targets'
-				      = List.fold(targets,
-						  0,
-						  fn (target,targets')
-						   => if get_topo' target = ~1
-							then targets'
-							else targets' + 1)
-				  in
-				    targets' = n
-				  end)
-			 val exits
-			   = List.removeAll
-			     (exits,
-			      fn label => get_topo' label <> 0)
-			 val _ 
-			   = (List.foreach
-			      (exits, 
-			       fn label => topo_root label);
-			      List.foreach
-			      (exits,
-			       fn label 
-			       => List.foreach(get_pred' label, topo_sort)))
-		       in
-			 loop(labels, n + 1)
-		       end
-	    val _ = loop(labels, 0)
-	    val _ = rev_todo ()
-	      
-	    val changed = ref false
-	    fun doit ()
-	      = (case get_todo ()
-		   of NONE => ()
- 		    | SOME label
-		    => let
-			 val {pred, block, ...} = getBlockInfo label
-			 val block = valOf (!block)
-			 val live = Liveness.livenessBlock {block = block,
-							    liveInfo = liveInfo}
-			     
-			 val live' = LiveInfo.getLive(liveInfo, label)
-		       in
-			 if LiveSet.equals(live, live')
-			   then ()
-			   else (LiveInfo.setLive(liveInfo, label, live);
-				 List.foreach(!pred, add_todo);
-				 if true then () else
-				 (print "completeLiveInfo:";
-				  print pass;
-				  print ": ";
-				  print (Label.toString label);
-				  print ": ";
-				  if LiveSet.<(live, live')
-				    then print "new < old"
-				  else if LiveSet.<(live', live)
-				    then print "old < new"
-				  else print "?";
-				  print "\n";
-				  if true
-				    then (print "old: ";
-				 	  LiveSet.foreach
-				 	  (live', fn m => 
-					   (print (MemLoc.toString m);
-					    print " "));
-					  print "\n";
-					  print "new: ";
-					  LiveSet.foreach
-					  (live, fn m => 
-					   (print (MemLoc.toString m);
-					    print " "));
-					  print "\n")
-				     else ());
-				 changed := true);
-			 doit ()
-		       end)
+              fun insert (l, x, compare)
+                = let
+                    val rec insert'
+                      = fn ([],acc) => List.appendRev(acc, [x])
+                         | (l as h::t,acc) 
+                         => (case compare(h,x)
+                               of LESS
+                                => insert' (t, h::acc)
+                                | EQUAL
+                                => List.appendRev(acc, l)
+                                | GREATER
+                                => List.appendRev(acc, x::l))
+                  in
+                    insert' (l,[])
+                  end
+            in
+              fun add_todo x = todo := insert(!todo, x, topo_order)
+              fun push_todo x = todo := x::(!todo)
+              fun rev_todo () = todo := List.rev (!todo)
+              fun get_todo () 
+                = (case !todo
+                     of [] => NONE
+                      | (x::todo') => (todo := todo';
+                                       SOME x))
+            end
+          
+            local
+              val num = Counter.new 1
+            in
+              fun topo_sort label
+                = let
+                    val {topo, pred, ...} = getBlockInfo label
+                  in
+                    if !topo = 0
+                      then (topo := Counter.next num;
+                            push_todo label;
+                            List.foreach(!pred, topo_sort))
+                      else ()
+                  end
+              fun topo_root label
+                = (get_topo label := Counter.next num;
+                   push_todo label)
+            end
+          
+            fun loop (labels, n)
+              = if List.isEmpty labels
+                  then ()
+                  else let
+                         val {yes = exits, no = labels}
+                           = List.partition
+                             (labels,
+                              fn label
+                               => let
+                                    val Block.T {transfer, ...} 
+                                      = valOf (get_block' label)
+                                    val targets = Transfer.nearTargets transfer
+                                      
+                                    val targets'
+                                      = List.fold(targets,
+                                                  0,
+                                                  fn (target,targets')
+                                                   => if get_topo' target = ~1
+                                                        then targets'
+                                                        else targets' + 1)
+                                  in
+                                    targets' = n
+                                  end)
+                         val exits
+                           = List.removeAll
+                             (exits,
+                              fn label => get_topo' label <> 0)
+                         val _ 
+                           = (List.foreach
+                              (exits, 
+                               fn label => topo_root label);
+                              List.foreach
+                              (exits,
+                               fn label 
+                               => List.foreach(get_pred' label, topo_sort)))
+                       in
+                         loop(labels, n + 1)
+                       end
+            val _ = loop(labels, 0)
+            val _ = rev_todo ()
+              
+            val changed = ref false
+            fun doit ()
+              = (case get_todo ()
+                   of NONE => ()
+                    | SOME label
+                    => let
+                         val {pred, block, ...} = getBlockInfo label
+                         val block = valOf (!block)
+                         val live = Liveness.livenessBlock {block = block,
+                                                            liveInfo = liveInfo}
+                             
+                         val live' = LiveInfo.getLive(liveInfo, label)
+                       in
+                         if LiveSet.equals(live, live')
+                           then ()
+                           else (LiveInfo.setLive(liveInfo, label, live);
+                                 List.foreach(!pred, add_todo);
+                                 if true then () else
+                                 (print "completeLiveInfo:";
+                                  print pass;
+                                  print ": ";
+                                  print (Label.toString label);
+                                  print ": ";
+                                  if LiveSet.<(live, live')
+                                    then print "new < old"
+                                  else if LiveSet.<(live', live)
+                                    then print "old < new"
+                                  else print "?";
+                                  print "\n";
+                                  if true
+                                    then (print "old: ";
+                                          LiveSet.foreach
+                                          (live', fn m => 
+                                           (print (MemLoc.toString m);
+                                            print " "));
+                                          print "\n";
+                                          print "new: ";
+                                          LiveSet.foreach
+                                          (live, fn m => 
+                                           (print (MemLoc.toString m);
+                                            print " "));
+                                          print "\n")
+                                     else ());
+                                 changed := true);
+                         doit ()
+                       end)
 
-	    val _ = doit ()
-	    val _ = destBlockInfo ()
-	  in
-	    ()
-	  end
-	
+            val _ = doit ()
+            val _ = destBlockInfo ()
+          in
+            ()
+          end
+        
       val (completeLiveInfo : {chunk: Chunk.t, 
-			       liveInfo: LiveInfo.t,
-			       pass: string} -> unit,
-	   completeLiveInfo_msg)
-	= tracerTop
-	  "completeLiveInfo"
-	  completeLiveInfo
+                               liveInfo: LiveInfo.t,
+                               pass: string} -> unit,
+           completeLiveInfo_msg)
+        = tracerTop
+          "completeLiveInfo"
+          completeLiveInfo
 
       fun verifyLiveInfo {chunk = Chunk.T {blocks, ...},
-			  liveInfo : t}
-	= List.forall
-	  (blocks,
-	   fn block as Block.T {entry, ...} 
-	    => let
-		 val label = Entry.label entry
-		 val live = LiveInfo.getLive(liveInfo, label)
-		 val live' = Liveness.livenessBlock {block = block,
-						     liveInfo = liveInfo}
-	       in
-		 LiveSet.equals(live, live')
-	       end)
+                          liveInfo : t}
+        = List.forall
+          (blocks,
+           fn block as Block.T {entry, ...} 
+            => let
+                 val label = Entry.label entry
+                 val live = LiveInfo.getLive(liveInfo, label)
+                 val live' = Liveness.livenessBlock {block = block,
+                                                     liveInfo = liveInfo}
+               in
+                 LiveSet.equals(live, live')
+               end)
 
       val (verifyLiveInfo : {chunk: Chunk.t, liveInfo: LiveInfo.t} -> bool,
-	   verifyLiveInfo_msg)
-	= tracer
-	  "verifyLiveInfo"
-	  verifyLiveInfo
+           verifyLiveInfo_msg)
+        = tracer
+          "verifyLiveInfo"
+          verifyLiveInfo
 
     end
 
   structure LivenessBlock =
     struct
       datatype t = T of {entry: (Entry.t * Liveness.t),
-			 profileLabel: ProfileLabel.t option,
-			 statements: (Assembly.t * Liveness.t) list,
-			 transfer: Transfer.t * Liveness.t}
+                         profileLabel: ProfileLabel.t option,
+                         statements: (Assembly.t * Liveness.t) list,
+                         transfer: Transfer.t * Liveness.t}
 
       fun toString (T {entry, statements, transfer, ...})
-	= concat [let
-		    val (entry,info) = entry
-		  in
-		    concat[Entry.toString entry,
-			   "\n",
-			   Liveness.toString info,
-			   "\n"]
-		  end,
-		  List.fold
-		  (statements,
-		   "",
-		   fn ((asm,info),s)
-		    => concat [s,
-			       Assembly.toString asm,
-			       "\n",
-			       Liveness.toString info]),
-		  let
-		    val (trans,info) = transfer
-		  in
-		    concat[Transfer.toString trans,
-			   "\n",
-			   Liveness.toString info,
-			   "\n"]
-		  end]
+        = concat [let
+                    val (entry,info) = entry
+                  in
+                    concat[Entry.toString entry,
+                           "\n",
+                           Liveness.toString info,
+                           "\n"]
+                  end,
+                  List.fold
+                  (statements,
+                   "",
+                   fn ((asm,info),s)
+                    => concat [s,
+                               Assembly.toString asm,
+                               "\n",
+                               Liveness.toString info]),
+                  let
+                    val (trans,info) = transfer
+                  in
+                    concat[Transfer.toString trans,
+                           "\n",
+                           Liveness.toString info,
+                           "\n"]
+                  end]
 
       fun printBlock (T {entry, statements, transfer, ...})
-	= (let
-	     val (entry,info) = entry
-	   in 
-	     print (Entry.toString entry);
-	     print "\n";
-	     print (Liveness.toString info)
-	   end;
-	   List.foreach
-	   (statements,
-	    fn (asm,info)
-	     => (print (Assembly.toString asm);
-		 print "\n";
-		 print (Liveness.toString info)));
-	   let
-	     val (trans,info) = transfer
-	   in
-	     print (Transfer.toString trans);
-	     print "\n";
-	     print (Liveness.toString info);
-	     print "\n"
-	   end)
+        = (let
+             val (entry,info) = entry
+           in 
+             print (Entry.toString entry);
+             print "\n";
+             print (Liveness.toString info)
+           end;
+           List.foreach
+           (statements,
+            fn (asm,info)
+             => (print (Assembly.toString asm);
+                 print "\n";
+                 print (Liveness.toString info)));
+           let
+             val (trans,info) = transfer
+           in
+             print (Transfer.toString trans);
+             print "\n";
+             print (Liveness.toString info);
+             print "\n"
+           end)
 
       fun toLivenessEntry {entry,
-			   live}
-	= let
-	    val info as Liveness.T {liveIn = live, ...}
-	      = Liveness.livenessEntry {entry = entry,
-					live = live}
-	  in
-	    {entry = (entry,info),
-	     live = live}
-	  end
+                           live}
+        = let
+            val info as Liveness.T {liveIn = live, ...}
+              = Liveness.livenessEntry {entry = entry,
+                                        live = live}
+          in
+            {entry = (entry,info),
+             live = live}
+          end
 
       fun reLivenessEntry {entry,
-			   live}
-	= let
-	    val (entry,_) = entry
-	    val info as Liveness.T {liveIn = live, ...}
-	      = Liveness.livenessEntry {entry = entry,
-					live = live}
-	  in
-	    {entry = (entry,info),
-	     live = live}
-	  end
+                           live}
+        = let
+            val (entry,_) = entry
+            val info as Liveness.T {liveIn = live, ...}
+              = Liveness.livenessEntry {entry = entry,
+                                        live = live}
+          in
+            {entry = (entry,info),
+             live = live}
+          end
 
       fun toLivenessStatements {statements,
-				live}
-	= let
-	    val {statements,live}
-	      = List.foldr(statements,
-			   {statements = [], live = live},
-			   fn (asm,{statements,live})
-			    => let
-				 val info as Liveness.T {liveIn = live, ...}
-				   = Liveness.livenessAssembly 
-				     {assembly = asm,
-				      live = live}
-			       in
-				 {statements = (asm, info)::statements, 
-				  live = live}
-			       end)
-	  in
-	    {statements = statements,
-	     live = live}
-	  end
+                                live}
+        = let
+            val {statements,live}
+              = List.foldr(statements,
+                           {statements = [], live = live},
+                           fn (asm,{statements,live})
+                            => let
+                                 val info as Liveness.T {liveIn = live, ...}
+                                   = Liveness.livenessAssembly 
+                                     {assembly = asm,
+                                      live = live}
+                               in
+                                 {statements = (asm, info)::statements, 
+                                  live = live}
+                               end)
+          in
+            {statements = statements,
+             live = live}
+          end
 
       fun reLivenessStatements {statements: (Assembly.t * Liveness.t) list,
-				live}
-	= let
-	    val {statements,live,...}
-	      = List.foldr(statements,
-			   {statements = [], 
-			    live = live, 
-			    continue = false},
-			   fn ((asm,info),{statements,live,continue})
-			    => if continue
-				 then {statements = (asm,info)::statements,
-				       live = Liveness.liveIn info,
-				       continue = continue}
-				 else let
-				       val info' as Liveness.T {liveIn = live',...}
-					 = Liveness.livenessAssembly 
-					   {assembly = asm,
-					    live = live}
-				     in
-				       {statements = (asm, info')::statements, 
-					live = live',
-					continue = Liveness.eq(info,info')}
-				     end)
-	  in
-	    {statements = statements,
-	     live = live}
-	  end
+                                live}
+        = let
+            val {statements,live,...}
+              = List.foldr(statements,
+                           {statements = [], 
+                            live = live, 
+                            continue = false},
+                           fn ((asm,info),{statements,live,continue})
+                            => if continue
+                                 then {statements = (asm,info)::statements,
+                                       live = Liveness.liveIn info,
+                                       continue = continue}
+                                 else let
+                                       val info' as Liveness.T {liveIn = live',...}
+                                         = Liveness.livenessAssembly 
+                                           {assembly = asm,
+                                            live = live}
+                                     in
+                                       {statements = (asm, info')::statements, 
+                                        live = live',
+                                        continue = Liveness.eq(info,info')}
+                                     end)
+          in
+            {statements = statements,
+             live = live}
+          end
 
       fun toLivenessTransfer {transfer,
-			      liveInfo}
-	= let
-	    val info as Liveness.T {liveIn = live, ...}
-	      = Liveness.livenessTransfer {transfer = transfer,
-					   liveInfo = liveInfo}
-	  in
-	    {transfer = (transfer,info),
-	     live = live}
-	  end
+                              liveInfo}
+        = let
+            val info as Liveness.T {liveIn = live, ...}
+              = Liveness.livenessTransfer {transfer = transfer,
+                                           liveInfo = liveInfo}
+          in
+            {transfer = (transfer,info),
+             live = live}
+          end
 
       fun reLivenessTransfer {transfer: Transfer.t * Liveness.t}
-	= let
-	    val (transfer, Liveness.T {liveOut,...}) = transfer
-	    val info as Liveness.T {liveIn = live, ...} 
-	      = Liveness.livenessTransfer' {transfer = transfer,
-					    live = liveOut}
-	  in
-	    {transfer = (transfer, info),
-	     live = live}
-	  end
+        = let
+            val (transfer, Liveness.T {liveOut,...}) = transfer
+            val info as Liveness.T {liveIn = live, ...} 
+              = Liveness.livenessTransfer' {transfer = transfer,
+                                            live = liveOut}
+          in
+            {transfer = (transfer, info),
+             live = live}
+          end
 
       fun toLivenessBlock {block = Block.T {entry, profileLabel,
-					    statements, transfer},
-			   liveInfo : LiveInfo.t}
-	= let
-	    val {transfer, live}
-	      = toLivenessTransfer {transfer = transfer,
-				    liveInfo = liveInfo}
+                                            statements, transfer},
+                           liveInfo : LiveInfo.t}
+        = let
+            val {transfer, live}
+              = toLivenessTransfer {transfer = transfer,
+                                    liveInfo = liveInfo}
 
-	    val {statements, live}
-	      = toLivenessStatements {statements =statements,
-				      live = live}
+            val {statements, live}
+              = toLivenessStatements {statements =statements,
+                                      live = live}
 
-	    val {entry, ...}
-	      = toLivenessEntry {entry = entry,
-				 live = live}
+            val {entry, ...}
+              = toLivenessEntry {entry = entry,
+                                 live = live}
 
-	    val liveness_block
-	      = T {entry = entry,
-		   profileLabel = profileLabel,
-		   statements = statements,
-		   transfer = transfer}
-	  in 
-	    liveness_block
-	  end
+            val liveness_block
+              = T {entry = entry,
+                   profileLabel = profileLabel,
+                   statements = statements,
+                   transfer = transfer}
+          in 
+            liveness_block
+          end
 
       val (toLivenessBlock: {block: Block.t, liveInfo: LiveInfo.t} -> t,
-	   toLivenessBlock_msg)
-	= tracer
-	  "toLivenessBlock"
+           toLivenessBlock_msg)
+        = tracer
+          "toLivenessBlock"
           toLivenessBlock
 
       fun verifyLivenessEntry {entry = (entry,info),
-			       live}
-	= let
-	    val info' as Liveness.T {liveIn = live', ...}
-	      = Liveness.livenessEntry {entry = entry,
-					live = live}
-	  in
-	    {verified = Liveness.eq(info, info'),
-	     live = live'}
-	  end
+                               live}
+        = let
+            val info' as Liveness.T {liveIn = live', ...}
+              = Liveness.livenessEntry {entry = entry,
+                                        live = live}
+          in
+            {verified = Liveness.eq(info, info'),
+             live = live'}
+          end
 
       fun verifyLivenessStatements {statements,
-				    live}
-	= List.foldr(statements,
-		     {verified = true, live = live},
-		     fn ((asm,info),{verified, live})
-		      => let
-			   val info' as Liveness.T {liveIn = live', ...}
-			     = Liveness.livenessAssembly 
-			       {assembly = asm,
-				live = live}
-			   val eq = Liveness.eq(info, info')
-			   val () =
-			      if eq 
-				 then ()
-				 else (print "asm ::\n";
-				       print (Assembly.toString asm);
-				       print "\n";
-				       print "info ::\n";
-				       print (Liveness.toString info);
-				       print "\n";
-				       print "info' ::\n";
-				       print (Liveness.toString info');
-				       print "\n")
-			 in
-			   {verified = verified andalso 
-			               Liveness.eq(info, info'), 
-			    live = live'}
-			 end)
+                                    live}
+        = List.foldr(statements,
+                     {verified = true, live = live},
+                     fn ((asm,info),{verified, live})
+                      => let
+                           val info' as Liveness.T {liveIn = live', ...}
+                             = Liveness.livenessAssembly 
+                               {assembly = asm,
+                                live = live}
+                           val eq = Liveness.eq(info, info')
+                           val () =
+                              if eq 
+                                 then ()
+                                 else (print "asm ::\n";
+                                       print (Assembly.toString asm);
+                                       print "\n";
+                                       print "info ::\n";
+                                       print (Liveness.toString info);
+                                       print "\n";
+                                       print "info' ::\n";
+                                       print (Liveness.toString info');
+                                       print "\n")
+                         in
+                           {verified = verified andalso 
+                                       Liveness.eq(info, info'), 
+                            live = live'}
+                         end)
 
       fun verifyLivenessTransfer {transfer = (transfer,info),
-				  liveInfo}
-	= let
-	    val info' as Liveness.T {liveIn = live', ...}
-	      = Liveness.livenessTransfer {transfer = transfer,
-					   liveInfo = liveInfo}
-	  in
-	    {verified = Liveness.eq(info, info'),
-	     live = live'}
-	  end
+                                  liveInfo}
+        = let
+            val info' as Liveness.T {liveIn = live', ...}
+              = Liveness.livenessTransfer {transfer = transfer,
+                                           liveInfo = liveInfo}
+          in
+            {verified = Liveness.eq(info, info'),
+             live = live'}
+          end
 
       fun verifyLivenessBlock {block = T {entry, statements, transfer, ...},
-			       liveInfo: LiveInfo.t}
-	= let
-	    val {verified = verified_transfer,
-		 live}
-	      = verifyLivenessTransfer {transfer = transfer,
-					liveInfo = liveInfo}
+                               liveInfo: LiveInfo.t}
+        = let
+            val {verified = verified_transfer,
+                 live}
+              = verifyLivenessTransfer {transfer = transfer,
+                                        liveInfo = liveInfo}
 
-	    val {verified = verified_statements,
-		 live}
-	      = verifyLivenessStatements {statements =statements,
-					  live = live}
+            val {verified = verified_statements,
+                 live}
+              = verifyLivenessStatements {statements =statements,
+                                          live = live}
 
-	    val {verified = verified_entry,
-		 ...}
-	      = verifyLivenessEntry {entry = entry,
-				     live = live}
+            val {verified = verified_entry,
+                 ...}
+              = verifyLivenessEntry {entry = entry,
+                                     live = live}
 
 (* FIXME -- the live-in set changed because of dead code elimination.
-	    val live' = get label
+            val live' = get label
 
-	    val verified_live = List.equalsAsSet(live, live', MemLoc.eq)
+            val verified_live = List.equalsAsSet(live, live', MemLoc.eq)
 *)
-	    val verified_live = true
-	  in 
-	    verified_transfer andalso 
-	    verified_statements andalso
-	    verified_entry andalso
-	    verified_live
-	  end
+            val verified_live = true
+          in 
+            verified_transfer andalso 
+            verified_statements andalso
+            verified_entry andalso
+            verified_live
+          end
 
       val (verifyLivenessBlock: {block: t, liveInfo: LiveInfo.t} -> bool,
-	   verifyLivenessBlock_msg)
-	= tracer
-	  "verifyLivenessBlock"
+           verifyLivenessBlock_msg)
+        = tracer
+          "verifyLivenessBlock"
           verifyLivenessBlock
 
       fun toBlock {block = T {entry, profileLabel,
-			      statements, transfer}}
-	= let
-	    val (entry,_) = entry
-	    val statements = List.map(statements, fn (asm,_) => asm)
-	    val (transfer,_) = transfer
-	  in 
-	    Block.T {entry = entry,
-		     profileLabel = profileLabel,
-		     statements = statements,
-		     transfer = transfer}
-	  end
+                              statements, transfer}}
+        = let
+            val (entry,_) = entry
+            val statements = List.map(statements, fn (asm,_) => asm)
+            val (transfer,_) = transfer
+          in 
+            Block.T {entry = entry,
+                     profileLabel = profileLabel,
+                     statements = statements,
+                     transfer = transfer}
+          end
 
       val (toBlock: {block: t} -> Block.t, 
-	   toBlock_msg)
-	= tracer
-	  "toBlock"
+           toBlock_msg)
+        = tracer
+          "toBlock"
           toBlock
     end
 

Modified: mlton/branches/on-20050420-cmm-branch/mlton/codegen/x86-codegen/x86-liveness.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/codegen/x86-codegen/x86-liveness.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/codegen/x86-codegen/x86-liveness.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature X86_LIVENESS_STRUCTS =
   sig
     structure x86: X86
@@ -18,84 +19,84 @@
 
     structure LiveSet: sig 
                          include SET
-			 val fromMemLocSet: x86.MemLocSet.t -> t
-			 val toMemLocSet: t -> x86.MemLocSet.t
-		       end
+                         val fromMemLocSet: x86.MemLocSet.t -> t
+                         val toMemLocSet: t -> x86.MemLocSet.t
+                       end
     sharing type LiveSet.Element.t = x86.MemLoc.t
 
     val track : x86.MemLoc.t -> bool
 
     structure LiveInfo:
       sig
-	type t
-	val newLiveInfo : unit -> t
+        type t
+        val newLiveInfo : unit -> t
 
-	val setLiveOperands : t * x86.Label.t * x86.Operand.t list -> unit
-	val setLiveMemlocs : t * x86.Label.t * x86.MemLocSet.t -> unit
-	val setLive : t * x86.Label.t * LiveSet.t -> unit
-	val getLive : t * x86.Label.t -> LiveSet.t
-	val completeLiveInfo : {chunk: x86.Chunk.t,
-				liveInfo: t,
-				pass: string} -> unit
-	val completeLiveInfo_msg : unit -> unit
-	val verifyLiveInfo : {chunk: x86.Chunk.t,
-			      liveInfo: t} -> bool
-	val verifyLiveInfo_msg : unit -> unit
+        val setLiveOperands : t * x86.Label.t * x86.Operand.t list -> unit
+        val setLiveMemlocs : t * x86.Label.t * x86.MemLocSet.t -> unit
+        val setLive : t * x86.Label.t * LiveSet.t -> unit
+        val getLive : t * x86.Label.t -> LiveSet.t
+        val completeLiveInfo : {chunk: x86.Chunk.t,
+                                liveInfo: t,
+                                pass: string} -> unit
+        val completeLiveInfo_msg : unit -> unit
+        val verifyLiveInfo : {chunk: x86.Chunk.t,
+                              liveInfo: t} -> bool
+        val verifyLiveInfo_msg : unit -> unit
       end
 
     structure Liveness:
       sig
-	datatype t = T of {liveIn: LiveSet.t,
-			   liveOut: LiveSet.t,
-			   dead: LiveSet.t}
+        datatype t = T of {liveIn: LiveSet.t,
+                           liveOut: LiveSet.t,
+                           dead: LiveSet.t}
 
-	val dead: t -> LiveSet.t
-	val liveIn: t -> LiveSet.t
-	val liveOut: t -> LiveSet.t
-	val livenessAssembly : {assembly : x86.Assembly.t, live : LiveSet.t} -> t
-	val livenessEntry : {entry : x86.Entry.t, live : LiveSet.t} -> t
-	val livenessTransfer : {transfer: x86.Transfer.t, liveInfo: LiveInfo.t} -> t
+        val dead: t -> LiveSet.t
+        val liveIn: t -> LiveSet.t
+        val liveOut: t -> LiveSet.t
+        val livenessAssembly : {assembly : x86.Assembly.t, live : LiveSet.t} -> t
+        val livenessEntry : {entry : x86.Entry.t, live : LiveSet.t} -> t
+        val livenessTransfer : {transfer: x86.Transfer.t, liveInfo: LiveInfo.t} -> t
       end
 
     structure LivenessBlock:
       sig
-	datatype t = T of {entry: (x86.Entry.t * Liveness.t),
-			   profileLabel: x86.ProfileLabel.t option,
-			   statements: (x86.Assembly.t * Liveness.t) list,
-			   transfer: (x86.Transfer.t * Liveness.t)}
+        datatype t = T of {entry: (x86.Entry.t * Liveness.t),
+                           profileLabel: x86.ProfileLabel.t option,
+                           statements: (x86.Assembly.t * Liveness.t) list,
+                           transfer: (x86.Transfer.t * Liveness.t)}
 
-	val toString : t -> string
-	val printBlock : t -> unit
-	val toLivenessEntry : {entry: x86.Entry.t,
-			       live: LiveSet.t} ->
-	                      {entry: (x86.Entry.t * Liveness.t),
-			       live: LiveSet.t}
-	val reLivenessEntry : {entry: (x86.Entry.t * Liveness.t),
-			       live: LiveSet.t} ->
-	                      {entry: (x86.Entry.t * Liveness.t),
-			       live: LiveSet.t}
-	val toLivenessStatements : {statements: x86.Assembly.t list,
-				    live: LiveSet.t} ->
+        val toString : t -> string
+        val printBlock : t -> unit
+        val toLivenessEntry : {entry: x86.Entry.t,
+                               live: LiveSet.t} ->
+                              {entry: (x86.Entry.t * Liveness.t),
+                               live: LiveSet.t}
+        val reLivenessEntry : {entry: (x86.Entry.t * Liveness.t),
+                               live: LiveSet.t} ->
+                              {entry: (x86.Entry.t * Liveness.t),
+                               live: LiveSet.t}
+        val toLivenessStatements : {statements: x86.Assembly.t list,
+                                    live: LiveSet.t} ->
                                    {statements: (x86.Assembly.t * Liveness.t) list,
-				    live: LiveSet.t}
-	val reLivenessStatements : {statements: (x86.Assembly.t * Liveness.t) list,
-				    live: LiveSet.t} ->
+                                    live: LiveSet.t}
+        val reLivenessStatements : {statements: (x86.Assembly.t * Liveness.t) list,
+                                    live: LiveSet.t} ->
                                    {statements: (x86.Assembly.t * Liveness.t) list,
-				    live: LiveSet.t}
-	val toLivenessTransfer : {transfer: x86.Transfer.t,
-				  liveInfo: LiveInfo.t} ->
-	                         {transfer: (x86.Transfer.t * Liveness.t),
-				  live: LiveSet.t}
-	val reLivenessTransfer : {transfer: (x86.Transfer.t * Liveness.t)} ->
-	                         {transfer: (x86.Transfer.t * Liveness.t),
-				  live: LiveSet.t}
-	val toLivenessBlock : {block: x86.Block.t, liveInfo: LiveInfo.t} -> t
-	val toLivenessBlock_msg : unit -> unit
-	val verifyLivenessBlock : {block: t,
-				   liveInfo: LiveInfo.t} -> bool
-	val verifyLivenessBlock_msg : unit -> unit
-	val toBlock : {block: t} -> x86.Block.t	  
-	val toBlock_msg : unit -> unit
+                                    live: LiveSet.t}
+        val toLivenessTransfer : {transfer: x86.Transfer.t,
+                                  liveInfo: LiveInfo.t} ->
+                                 {transfer: (x86.Transfer.t * Liveness.t),
+                                  live: LiveSet.t}
+        val reLivenessTransfer : {transfer: (x86.Transfer.t * Liveness.t)} ->
+                                 {transfer: (x86.Transfer.t * Liveness.t),
+                                  live: LiveSet.t}
+        val toLivenessBlock : {block: x86.Block.t, liveInfo: LiveInfo.t} -> t
+        val toLivenessBlock_msg : unit -> unit
+        val verifyLivenessBlock : {block: t,
+                                   liveInfo: LiveInfo.t} -> bool
+        val verifyLivenessBlock_msg : unit -> unit
+        val toBlock : {block: t} -> x86.Block.t   
+        val toBlock_msg : unit -> unit
       end
   end
 

Modified: mlton/branches/on-20050420-cmm-branch/mlton/codegen/x86-codegen/x86-loop-info.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/codegen/x86-codegen/x86-loop-info.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/codegen/x86-codegen/x86-loop-info.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,9 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 functor x86LoopInfo(S: X86_LOOP_INFO_STRUCTS) : X86_LOOP_INFO =
@@ -18,127 +18,127 @@
   val tracer = x86.tracer
 
   datatype t = T of {getLoopInfo : Label.t ->
-		                   {loopHeader: bool,
-				    loopLabels: Label.t list,
-				    loopPath: int list}}
+                                   {loopHeader: bool,
+                                    loopLabels: Label.t list,
+                                    loopPath: int list}}
 
   fun createLoopInfo {chunk = Chunk.T {blocks, ...}, farLoops}
     = let
-	val G = Graph.new ()
+        val G = Graph.new ()
 
-	val {get = getNodeInfo : unit Node.t -> Label.t,
-	     set = setNodeInfo, ...}
-	  = Property.getSetOnce
-	    (Node.plist,
-	     Property.initRaise ("x86LoopInfo:getNodeInfo", Node.layout))
+        val {get = getNodeInfo : unit Node.t -> Label.t,
+             set = setNodeInfo, ...}
+          = Property.getSetOnce
+            (Node.plist,
+             Property.initRaise ("x86LoopInfo:getNodeInfo", Node.layout))
 
-	val {get = getInfo : Label.t -> unit Node.t,
-	     destroy = destInfo}
-	  = Property.destGet
-	    (Label.plist,
-	     Property.initFun (fn l => let
-					 val n = Graph.newNode G
-					 val _ = setNodeInfo(n, l)
-				       in
-					 n
-				       end))
+        val {get = getInfo : Label.t -> unit Node.t,
+             destroy = destInfo}
+          = Property.destGet
+            (Label.plist,
+             Property.initFun (fn l => let
+                                         val n = Graph.newNode G
+                                         val _ = setNodeInfo(n, l)
+                                       in
+                                         n
+                                       end))
 
-	val {get = getLoopInfo : 
-	           Label.t -> 
-		   {loopHeader: bool,
-		    loopLabels: Label.t list,
-		    loopPath: int list},
-	     set = setLoopInfo, ...}
-	  = Property.getSetOnce
-	    (Label.plist,
-	     Property.initRaise ("x86LoopInfo:getLoopInfo", Label.layout))
+        val {get = getLoopInfo : 
+                   Label.t -> 
+                   {loopHeader: bool,
+                    loopLabels: Label.t list,
+                    loopPath: int list},
+             set = setLoopInfo, ...}
+          = Property.getSetOnce
+            (Label.plist,
+             Property.initRaise ("x86LoopInfo:getLoopInfo", Label.layout))
 
-	val rootLabel = Label.newString "root"
-	val root = getInfo rootLabel
+        val rootLabel = Label.newString "root"
+        val root = getInfo rootLabel
 
-	fun addEdge edge
-	  = ignore (Graph.addEdge (G, edge))
+        fun addEdge edge
+          = ignore (Graph.addEdge (G, edge))
 
-	val _
-	  = List.foreach
-	    (blocks,
-	     fn Block.T {entry, transfer, ...}
-	      => let
-		   val label = Entry.label entry
-		   val node = getInfo label
+        val _
+          = List.foreach
+            (blocks,
+             fn Block.T {entry, transfer, ...}
+              => let
+                   val label = Entry.label entry
+                   val node = getInfo label
 
-		   fun doit' target
-		     = let
-			 val node' = getInfo target
-		       in
-			 addEdge {from = node, to = node'}
-		       end
-		   fun doit'' target
-		     = let
-			 val node' = getInfo target
-		       in
-			 if farLoops
-			   then addEdge {from = node, to = node'}
-			   else addEdge {from = root, to = node'}
-		       end
+                   fun doit' target
+                     = let
+                         val node' = getInfo target
+                       in
+                         addEdge {from = node, to = node'}
+                       end
+                   fun doit'' target
+                     = let
+                         val node' = getInfo target
+                       in
+                         if farLoops
+                           then addEdge {from = node, to = node'}
+                           else addEdge {from = root, to = node'}
+                       end
 
-		   datatype z = datatype Transfer.t
-		 in
-		   if Entry.isFunc entry
-		     then addEdge {from = root, to = node}
-		     else () ;
-		   case transfer
-		     of Goto {target, ...} 
-		      => doit' target
-		      | Iff {truee, falsee, ...} 
-		      => (doit' truee; 
-			  doit' falsee)
-		      | Switch {cases, default, ...}
-		      => (doit' default;
-			  Transfer.Cases.foreach(cases, doit'))
-		      | Tail {...}
-		      => ()
-		      | NonTail {return, handler, ...}
-		      => (doit'' return;
-			  case handler 
-			    of SOME handler => doit'' handler
-			     | NONE => ())
-		      | Return {...}
-		      => ()
-		      | Raise {...}
-		      => ()
-		      | CCall {return, func, ...}
-		      => Option.app (return, if CFunction.mayGC func
-					       then doit''
-					       else doit')
-		 end)
-	val _ = destInfo ()
+                   datatype z = datatype Transfer.t
+                 in
+                   if Entry.isFunc entry
+                     then addEdge {from = root, to = node}
+                     else () ;
+                   case transfer
+                     of Goto {target, ...} 
+                      => doit' target
+                      | Iff {truee, falsee, ...} 
+                      => (doit' truee; 
+                          doit' falsee)
+                      | Switch {cases, default, ...}
+                      => (doit' default;
+                          Transfer.Cases.foreach(cases, doit' o #2))
+                      | Tail {...}
+                      => ()
+                      | NonTail {return, handler, ...}
+                      => (doit'' return;
+                          case handler 
+                            of SOME handler => doit'' handler
+                             | NONE => ())
+                      | Return {...}
+                      => ()
+                      | Raise {...}
+                      => ()
+                      | CCall {return, func, ...}
+                      => Option.app (return, if CFunction.mayGC func
+                                               then doit''
+                                               else doit')
+                 end)
+        val _ = destInfo ()
 
-	val lf = Graph.loopForestSteensgaard (G, {root = root})
-	  
-	fun doit (f: unit LoopForest.t,
-		  headers,
-		  path)
-	  = let
-	      val {loops, notInLoop} = LoopForest.dest f
-	      val notInLoop = Vector.toListMap (notInLoop, getNodeInfo)
-	      val path' = List.rev path
-	    in
-	      List.foreach
-	      (notInLoop, fn l =>
-	       setLoopInfo 
-	       (l, {loopHeader = Vector.contains (headers, l, Label.equals),
-		    loopLabels = notInLoop,
-		    loopPath = path'})) ;
-	      Vector.foreachi
-	      (loops, fn (i,{headers, child}) =>
-	       doit (child, 
-		     Vector.map (headers, getNodeInfo),
-		     i::path))
-	    end
-	val _ = doit (lf, Vector.new0 (), [])
+        val lf = Graph.loopForestSteensgaard (G, {root = root})
+          
+        fun doit (f: unit LoopForest.t,
+                  headers,
+                  path)
+          = let
+              val {loops, notInLoop} = LoopForest.dest f
+              val notInLoop = Vector.toListMap (notInLoop, getNodeInfo)
+              val path' = List.rev path
+            in
+              List.foreach
+              (notInLoop, fn l =>
+               setLoopInfo 
+               (l, {loopHeader = Vector.contains (headers, l, Label.equals),
+                    loopLabels = notInLoop,
+                    loopPath = path'})) ;
+              Vector.foreachi
+              (loops, fn (i,{headers, child}) =>
+               doit (child, 
+                     Vector.map (headers, getNodeInfo),
+                     i::path))
+            end
+        val _ = doit (lf, Vector.new0 (), [])
       in
-	T {getLoopInfo = getLoopInfo}
+        T {getLoopInfo = getLoopInfo}
       end
 
   val (createLoopInfo, createLoopInfo_msg)
@@ -148,20 +148,20 @@
 
   fun getLoopDistance (T {getLoopInfo, ...}, from, to)
     = (case (#loopPath (getLoopInfo from), #loopPath (getLoopInfo to))
-	 of ([], _) => NONE
-	  | (_, []) => NONE
-	  | (pfrom, pto)
-	  => let
-	       val rec check
-		 = fn ([], pto) => SOME (List.length pto)
-		    | (pfrom, []) => SOME (~(List.length pfrom))
-		    | (f::pfrom,t::pto)
-		    => if f = t
-			 then check (pfrom, pto)
-			 else NONE
-	     in
-	       check (pfrom, pto)
-	     end)
+         of ([], _) => NONE
+          | (_, []) => NONE
+          | (pfrom, pto)
+          => let
+               val rec check
+                 = fn ([], pto) => SOME (List.length pto)
+                    | (pfrom, []) => SOME (~(List.length pfrom))
+                    | (f::pfrom,t::pto)
+                    => if f = t
+                         then check (pfrom, pto)
+                         else NONE
+             in
+               check (pfrom, pto)
+             end)
   fun getLoopLabels (T {getLoopInfo, ...}, label) = #loopLabels (getLoopInfo label)
   fun isLoopHeader (T {getLoopInfo, ...}, l) = #loopHeader (getLoopInfo l)
 end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/codegen/x86-codegen/x86-loop-info.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/codegen/x86-codegen/x86-loop-info.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/codegen/x86-codegen/x86-loop-info.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 type int = Int.t
 
 signature X86_LOOP_INFO_STRUCTS =

Modified: mlton/branches/on-20050420-cmm-branch/mlton/codegen/x86-codegen/x86-mlton-basic.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/codegen/x86-codegen/x86-mlton-basic.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/codegen/x86-codegen/x86-mlton-basic.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 functor x86MLtonBasic (S: X86_MLTON_BASIC_STRUCTS): X86_MLTON_BASIC =
 struct
 
@@ -38,24 +39,24 @@
   structure Classes =
     struct
       local
-	fun new s = MemLoc.Class.new {name = s}
+        fun new s = MemLoc.Class.new {name = s}
       in
-	val Heap = new "Heap"
-	val Stack = new "Stack"
-	val Locals = new "Locals"
-	val Globals = new "Globals"
-	  
-	val Temp = MemLoc.Class.Temp	
-	val StaticTemp = MemLoc.Class.StaticTemp
-	val CStack = MemLoc.Class.CStack
-	val Code = MemLoc.Class.Code
-	  
-	val CStatic = new "CStatic"
-	val StaticNonTemp = new "StaticNonTemp"
+        val Heap = new "Heap"
+        val Stack = new "Stack"
+        val Locals = new "Locals"
+        val Globals = new "Globals"
+          
+        val Temp = MemLoc.Class.Temp    
+        val StaticTemp = MemLoc.Class.StaticTemp
+        val CStack = MemLoc.Class.CStack
+        val Code = MemLoc.Class.Code
+          
+        val CStatic = new "CStatic"
+        val StaticNonTemp = new "StaticNonTemp"
 
-	val GCState = new "GCState"
-	val GCStateHold = new "GCStateHold"
-	val GCStateVolatile = new "GCStateVolatile"
+        val GCState = new "GCState"
+        val GCStateHold = new "GCStateHold"
+        val GCStateVolatile = new "GCStateVolatile"
       end
 
       val allClasses = ref x86.ClassSet.empty 
@@ -67,264 +68,264 @@
       val cstaticClasses = ref x86.ClassSet.empty 
 
       fun initClasses ()
-	= let
-	    val _ = allClasses :=	
-	            x86.ClassSet.fromList
-		    (
-		     Heap::
-		     Stack::
-		     Locals::
-		     Globals::
-		     Temp::
-		     StaticTemp::
-		     CStack::
-		     Code::
-		     CStatic::
-		     StaticNonTemp::
-		     GCState::
-		     GCStateHold::
-		     GCStateVolatile::
-		     nil)
+        = let
+            val _ = allClasses :=       
+                    x86.ClassSet.fromList
+                    (
+                     Heap::
+                     Stack::
+                     Locals::
+                     Globals::
+                     Temp::
+                     StaticTemp::
+                     CStack::
+                     Code::
+                     CStatic::
+                     StaticNonTemp::
+                     GCState::
+                     GCStateHold::
+                     GCStateVolatile::
+                     nil)
 
-	    val _ = livenessClasses :=
-	            (if !Control.Native.liveStack
-		       then x86.ClassSet.fromList
-			    (
-			     Temp::
-			     Locals::
-			     StaticTemp::
-			     Stack::
-			     nil)
-		       else x86.ClassSet.fromList
-			    (
-			     Temp::
-			     Locals::
-			     StaticTemp::
-			     nil))
+            val _ = livenessClasses :=
+                    (if !Control.Native.liveStack
+                       then x86.ClassSet.fromList
+                            (
+                             Temp::
+                             Locals::
+                             StaticTemp::
+                             Stack::
+                             nil)
+                       else x86.ClassSet.fromList
+                            (
+                             Temp::
+                             Locals::
+                             StaticTemp::
+                             nil))
 
-	    val _ = holdClasses :=
-	            x86.ClassSet.fromList
-		    (
-		     GCStateHold::
+            val _ = holdClasses :=
+                    x86.ClassSet.fromList
+                    (
+                     GCStateHold::
 (*
-		     GCStateVolatile::
+                     GCStateVolatile::
 *)
-		     nil)
+                     nil)
 
-	    val _ = volatileClasses :=
-	            x86.ClassSet.fromList
-		    (
-		     GCStateVolatile::
-		     nil)
+            val _ = volatileClasses :=
+                    x86.ClassSet.fromList
+                    (
+                     GCStateVolatile::
+                     nil)
 
-	    val _ = runtimeClasses :=
-	            x86.ClassSet.fromList
-		    (
-		     Heap::
-		     Stack::
-		     Globals::
-		     GCState::
-		     GCStateHold::
-		     GCStateVolatile::
-		     nil)
+            val _ = runtimeClasses :=
+                    x86.ClassSet.fromList
+                    (
+                     Heap::
+                     Stack::
+                     Globals::
+                     GCState::
+                     GCStateHold::
+                     GCStateVolatile::
+                     nil)
 
-	    val _ = heapClasses :=
-	            x86.ClassSet.fromList
-		    (
-		     Heap::
-		     nil)
+            val _ = heapClasses :=
+                    x86.ClassSet.fromList
+                    (
+                     Heap::
+                     nil)
 
-	    val _ = cstaticClasses :=
-	            x86.ClassSet.fromList
-		    (
-		     CStatic::
-		     nil)
-	  in
-	    ()
-	  end
+            val _ = cstaticClasses :=
+                    x86.ClassSet.fromList
+                    (
+                     CStatic::
+                     nil)
+          in
+            ()
+          end
     end
 
   val makeContents = x86.MemLoc.makeContents
   val c_stackP = Label.fromString "c_stackP"
   val c_stackPContents 
     = makeContents {base = Immediate.label c_stackP,
-		    size = pointerSize,
-		    class = Classes.StaticNonTemp}
+                    size = pointerSize,
+                    class = Classes.StaticNonTemp}
   val c_stackPContentsOperand 
     = Operand.memloc c_stackPContents
   val c_stackPDeref
     = MemLoc.simple {base = c_stackPContents,
-		     index = Immediate.const_int 0,
-		     scale = wordScale,
-		     size = pointerSize,
-		     class = Classes.CStack}
+                     index = Immediate.const_int 0,
+                     scale = wordScale,
+                     size = pointerSize,
+                     class = Classes.CStack}
   val c_stackPDerefOperand
     = Operand.memloc c_stackPDeref
   val c_stackPDerefDouble
     = MemLoc.simple {base = c_stackPContents,
-		     index = Immediate.const_int 0,
-		     scale = wordScale,
-		     size = Size.DBLE,
-		     class = Classes.CStack}
+                     index = Immediate.const_int 0,
+                     scale = wordScale,
+                     size = Size.DBLE,
+                     class = Classes.CStack}
   val c_stackPDerefDoubleOperand
     = Operand.memloc c_stackPDerefDouble
   val c_stackPDerefFloat
     = MemLoc.simple {base = c_stackPContents,
-		     index = Immediate.const_int 0,
-		     scale = wordScale,
-		     size = Size.SNGL,
-		     class = Classes.CStack}
+                     index = Immediate.const_int 0,
+                     scale = wordScale,
+                     size = Size.SNGL,
+                     class = Classes.CStack}
   val c_stackPDerefFloatOperand
     = Operand.memloc c_stackPDerefFloat
-				 
+                                 
   val threadTemp = Label.fromString "threadTemp"
   val threadTempContents 
     = makeContents {base = Immediate.label threadTemp,
-		    size = wordSize,
-		    class = Classes.StaticTemp}
+                    size = wordSize,
+                    class = Classes.StaticTemp}
   val threadTempContentsOperand
     = Operand.memloc threadTempContents
     
   val statusTemp = Label.fromString "statusTemp"
   val statusTempContents 
     = makeContents {base = Immediate.label statusTemp,
-		    size = wordSize,
-		    class = Classes.StaticTemp}
+                    size = wordSize,
+                    class = Classes.StaticTemp}
   val statusTempContentsOperand
     = Operand.memloc statusTempContents
 
   val fileTemp = Label.fromString "fileTemp"
   val fileTempContents 
     = makeContents {base = Immediate.label fileTemp,
-		    size = pointerSize,
-		    class = Classes.StaticTemp}
+                    size = pointerSize,
+                    class = Classes.StaticTemp}
   val fileTempContentsOperand
     = Operand.memloc fileTempContents
 
   val applyFFTemp = Label.fromString "applyFFTemp"
   val applyFFTempContents 
     = makeContents {base = Immediate.label applyFFTemp,
-		    size = wordSize,
-		    class = Classes.StaticTemp}
+                    size = wordSize,
+                    class = Classes.StaticTemp}
   val applyFFTempContentsOperand
     = Operand.memloc applyFFTempContents
   val applyFFTemp2 = Label.fromString "applyFFTemp2"
   val applyFFTemp2Contents 
     = makeContents {base = Immediate.label applyFFTemp2,
-		    size = wordSize,
-		    class = Classes.StaticTemp}
+                    size = wordSize,
+                    class = Classes.StaticTemp}
   val applyFFTemp2ContentsOperand
     = Operand.memloc applyFFTemp2Contents
 
   val realTemp1D = Label.fromString "realTemp1D"
   val realTemp1ContentsD
     = makeContents {base = Immediate.label realTemp1D,
-		    size = Size.DBLE,
-		    class = Classes.StaticTemp}
+                    size = Size.DBLE,
+                    class = Classes.StaticTemp}
   val realTemp1ContentsOperandD
     = Operand.memloc realTemp1ContentsD
   val realTemp1S = Label.fromString "realTemp1S"
   val realTemp1ContentsS
     = makeContents {base = Immediate.label realTemp1S,
-		    size = Size.SNGL,
-		    class = Classes.StaticTemp}
+                    size = Size.SNGL,
+                    class = Classes.StaticTemp}
   val realTemp1ContentsOperandS
     = Operand.memloc realTemp1ContentsS
   fun realTemp1ContentsOperand floatSize
     = case floatSize of
         Size.DBLE => realTemp1ContentsOperandD
       | Size.SNGL => realTemp1ContentsOperandS
-      | _ => Error.bug "realTemp1ContentsOperand: floatSize"
+      | _ => Error.bug "x86MLtonBasic.realTemp1ContentsOperand: floatSize"
 
   val realTemp2D = Label.fromString "realTemp2D"
   val realTemp2ContentsD
     = makeContents {base = Immediate.label realTemp2D,
-		    size = Size.DBLE,
-		    class = Classes.StaticTemp}
+                    size = Size.DBLE,
+                    class = Classes.StaticTemp}
   val realTemp2ContentsOperandD
     = Operand.memloc realTemp2ContentsD
   val realTemp2S = Label.fromString "realTemp2S"
   val realTemp2ContentsS
     = makeContents {base = Immediate.label realTemp2S,
-		    size = Size.SNGL,
-		    class = Classes.StaticTemp}
+                    size = Size.SNGL,
+                    class = Classes.StaticTemp}
   val realTemp2ContentsOperandS
     = Operand.memloc realTemp2ContentsS
   fun realTemp2ContentsOperand floatSize
     = case floatSize of
         Size.DBLE => realTemp2ContentsOperandD
       | Size.SNGL => realTemp2ContentsOperandS
-      | _ => Error.bug "realTemp2ContentsOperand: floatSize"
+      | _ => Error.bug "x86MLtonBasic.realTemp2ContentsOperand: floatSize"
 
   val realTemp3D = Label.fromString "realTemp3D"
   val realTemp3ContentsD
     = makeContents {base = Immediate.label realTemp3D,
-		    size = Size.DBLE,
-		    class = Classes.StaticTemp}
+                    size = Size.DBLE,
+                    class = Classes.StaticTemp}
   val realTemp3ContentsOperandD
     = Operand.memloc realTemp3ContentsD
   val realTemp3S = Label.fromString "realTemp3S"
   val realTemp3ContentsS
     = makeContents {base = Immediate.label realTemp3S,
-		    size = Size.SNGL,
-		    class = Classes.StaticTemp}
+                    size = Size.SNGL,
+                    class = Classes.StaticTemp}
   val realTemp3ContentsOperandS
     = Operand.memloc realTemp3ContentsS
   fun realTemp3ContentsOperand floatSize
     = case floatSize of
         Size.DBLE => realTemp3ContentsOperandD
       | Size.SNGL => realTemp3ContentsOperandS
-      | _ => Error.bug "realTemp3ContentsOperand: floatSize"
+      | _ => Error.bug "x86MLtonBasic.realTemp3ContentsOperand: floatSize"
 
   val fpswTemp = Label.fromString "fpswTemp"
   val fpswTempContents 
     = makeContents {base = Immediate.label fpswTemp,
-		    size = Size.WORD,
-		    class = Classes.StaticTemp}
+                    size = Size.WORD,
+                    class = Classes.StaticTemp}
   val fpswTempContentsOperand
     = Operand.memloc fpswTempContents
   val fildTemp = Label.fromString "fildTemp"
   val fildTempContents 
     = makeContents {base = Immediate.label fildTemp,
-		    size = Size.WORD,
-		    class = Classes.StaticTemp}
+                    size = Size.WORD,
+                    class = Classes.StaticTemp}
   val fildTempContentsOperand
     = Operand.memloc fildTempContents
 
   val eq1Temp = Label.fromString "eq1Temp"
   val eq1TempContents 
     = makeContents {base = Immediate.label eq1Temp,
-		    size = wordSize,
-		    class = Classes.StaticTemp}
+                    size = wordSize,
+                    class = Classes.StaticTemp}
   val eq1TempContentsOperand
     = Operand.memloc eq1TempContents
   val eq2Temp = Label.fromString "eq2Temp"
   val eq2TempContents 
     = makeContents {base = Immediate.label eq2Temp,
-		    size = wordSize,
-		    class = Classes.StaticTemp}
+                    size = wordSize,
+                    class = Classes.StaticTemp}
   val eq2TempContentsOperand
     = Operand.memloc eq2TempContents
 
   val wordTemp1B = Label.fromString "wordTemp1B"
   val wordTemp1ContentsB
     = makeContents {base = Immediate.label wordTemp1B,
-		    size = Size.BYTE,
-		    class = Classes.StaticTemp}
+                    size = Size.BYTE,
+                    class = Classes.StaticTemp}
   val wordTemp1ContentsOperandB
     = Operand.memloc wordTemp1ContentsB
   val wordTemp1W = Label.fromString "wordTemp1W"
   val wordTemp1ContentsW
     = makeContents {base = Immediate.label wordTemp1W,
-		    size = Size.WORD,
-		    class = Classes.StaticTemp}
+                    size = Size.WORD,
+                    class = Classes.StaticTemp}
   val wordTemp1ContentsOperandW
     = Operand.memloc wordTemp1ContentsW
   val wordTemp1L = Label.fromString "wordTemp1L"
   val wordTemp1ContentsL
     = makeContents {base = Immediate.label wordTemp1L,
-		    size = Size.LONG,
-		    class = Classes.StaticTemp}
+                    size = Size.LONG,
+                    class = Classes.StaticTemp}
   val wordTemp1ContentsOperandL
     = Operand.memloc wordTemp1ContentsL
   fun wordTemp1ContentsOperand wordSize
@@ -332,27 +333,27 @@
         Size.BYTE => wordTemp1ContentsOperandB
       | Size.WORD => wordTemp1ContentsOperandW
       | Size.LONG => wordTemp1ContentsOperandL
-      | _ => Error.bug "wordTemp1ContentsOperand: wordSize"
+      | _ => Error.bug "x86MLtonBasic.wordTemp1ContentsOperand: wordSize"
 
   val wordTemp2B = Label.fromString "wordTemp2B"
   val wordTemp2ContentsB
     = makeContents {base = Immediate.label wordTemp2B,
-		    size = Size.BYTE,
-		    class = Classes.StaticTemp}
+                    size = Size.BYTE,
+                    class = Classes.StaticTemp}
   val wordTemp2ContentsOperandB
     = Operand.memloc wordTemp2ContentsB
   val wordTemp2W = Label.fromString "wordTemp2W"
   val wordTemp2ContentsW
     = makeContents {base = Immediate.label wordTemp2W,
-		    size = Size.WORD,
-		    class = Classes.StaticTemp}
+                    size = Size.WORD,
+                    class = Classes.StaticTemp}
   val wordTemp2ContentsOperandW
     = Operand.memloc wordTemp2ContentsW
   val wordTemp2L = Label.fromString "wordTemp2L"
   val wordTemp2ContentsL
     = makeContents {base = Immediate.label wordTemp2L,
-		    size = Size.LONG,
-		    class = Classes.StaticTemp}
+                    size = Size.LONG,
+                    class = Classes.StaticTemp}
   val wordTemp2ContentsOperandL
     = Operand.memloc wordTemp2ContentsL
   fun wordTemp2ContentsOperand wordSize
@@ -360,32 +361,32 @@
         Size.BYTE => wordTemp2ContentsOperandB
       | Size.WORD => wordTemp2ContentsOperandW
       | Size.LONG => wordTemp2ContentsOperandL
-      | _ => Error.bug "wordTemp2ContentsOperand: wordSize"
+      | _ => Error.bug "x86MLtonBasic.wordTemp2ContentsOperand: wordSize"
 
 
   local
      fun make prefix =
-	let
-	   fun make name size = Label.fromString (concat [prefix, name, size])
-	   val r = make "Real"
-	   val w = make "Word"
-	   datatype z = datatype CType.t
-	in
-	   CType.memo
-	   (fn t =>
-	    case t of
-	       Int8 => w "8"
-	     | Int16 => w "16"
-	     | Int32 => w "32"
-	     | Int64 => w "64"
-	     | Pointer => Label.fromString (concat [prefix, "Pointer"])
-	     | Real32 => r "32"
-	     | Real64 => r "64"
-	     | Word8 => w "8"
-	     | Word16 => w "16"
-	     | Word32 => w "32"
-	     | Word64 => w "64")
-	end
+        let
+           fun make name size = Label.fromString (concat [prefix, name, size])
+           val r = make "Real"
+           val w = make "Word"
+           datatype z = datatype CType.t
+        in
+           CType.memo
+           (fn t =>
+            case t of
+               Int8 => w "8"
+             | Int16 => w "16"
+             | Int32 => w "32"
+             | Int64 => w "64"
+             | Pointer => Label.fromString (concat [prefix, "Pointer"])
+             | Real32 => r "32"
+             | Real64 => r "64"
+             | Word8 => w "8"
+             | Word16 => w "16"
+             | Word32 => w "32"
+             | Word64 => w "64")
+        end
   in
      val local_base = make "local"
      val global_base = make "global"
@@ -409,50 +410,50 @@
    *)
   val fileLineLabel =
      Promise.lazy (fn () => Label.fromString (if !Control.labelsHaveExtra_
-						 then "_LINE__"
-					      else "__LINE__"))
-					 
+                                                 then "_LINE__"
+                                              else "__LINE__"))
+                                         
   val fileLine
     = fn () => if !Control.debug
-		 then Operand.immediate (Immediate.const_int 0)
-		 else (Operand.immediate
-		       (Immediate.binexp
-			{oper = Immediate.Addition,
-			 exp1 = Immediate.label (fileLineLabel ()),
-			 exp2 = Immediate.const_int 9}))
+                 then Operand.immediate (Immediate.const_int 0)
+                 else (Operand.immediate
+                       (Immediate.binexp
+                        {oper = Immediate.Addition,
+                         exp1 = Immediate.label (fileLineLabel ()),
+                         exp2 = Immediate.const_int 9}))
 
   val gcState_label = Label.fromString "gcState"
 
   structure Field = Runtime.GCField
   fun make' (offset: int, size, class) =
      let
-	fun imm () =
-	   Immediate.binexp
-	   {oper = Immediate.Addition,
-	    exp1 = Immediate.label gcState_label,
-	    exp2 = Immediate.const_int offset}
-	fun contents () =
-	   makeContents {base = imm (),
-			 size = size,
-			 class = class}
-	fun operand () = Operand.memloc (contents ())
+        fun imm () =
+           Immediate.binexp
+           {oper = Immediate.Addition,
+            exp1 = Immediate.label gcState_label,
+            exp2 = Immediate.const_int offset}
+        fun contents () =
+           makeContents {base = imm (),
+                         size = size,
+                         class = class}
+        fun operand () = Operand.memloc (contents ())
      in
-	(imm, contents, operand)
+        (imm, contents, operand)
      end
   fun make (f: Field.t, size, class) =
      let
-	fun imm () =
-	   Immediate.binexp
-	   {oper = Immediate.Addition,
-	    exp1 = Immediate.label gcState_label,
-	    exp2 = Immediate.const_int (Bytes.toInt (Field.offset f))}
-	fun contents () =
-	   makeContents {base = imm (),
-			 size = size,
-			 class = class}
-	fun operand () = Operand.memloc (contents ())
+        fun imm () =
+           Immediate.binexp
+           {oper = Immediate.Addition,
+            exp1 = Immediate.label gcState_label,
+            exp2 = Immediate.const_int (Bytes.toInt (Field.offset f))}
+        fun contents () =
+           makeContents {base = imm (),
+                         size = size,
+                         class = class}
+        fun operand () = Operand.memloc (contents ())
      in
-	(imm, contents, operand)
+        (imm, contents, operand)
      end
 
   val (_, gcState_exnStackContents,
@@ -476,8 +477,8 @@
       Immediate.label (Label.fromString "stackTopTemp")
     val stackTopTempContents = 
       makeContents {base = stackTopTemp,
-		    size = wordSize,
-		    class = Classes.StaticTemp} 
+                    size = wordSize,
+                    class = Classes.StaticTemp} 
     val stackTopTempContentsOperand = 
       Operand.memloc (stackTopTempContents)
   in
@@ -487,50 +488,50 @@
 
   local
      fun make (contents, class) () =
-	Operand.memloc (MemLoc.simple {base = contents (),
-				       index = Immediate.const_int 0,
-				       scale = wordScale,
-				       size = pointerSize,
-				       class = class})
+        Operand.memloc (MemLoc.simple {base = contents (),
+                                       index = Immediate.const_int 0,
+                                       scale = wordScale,
+                                       size = pointerSize,
+                                       class = class})
   in
      val gcState_frontierDerefOperand =
-	make (gcState_frontierContents, Classes.Heap)
+        make (gcState_frontierContents, Classes.Heap)
      val gcState_stackTopDerefOperand =
-	make (gcState_stackTopContents, Classes.Stack)
+        make (gcState_stackTopContents, Classes.Stack)
      val stackTopTempDerefOperand =
-	make (stackTopTempContents, Classes.Stack)
+        make (stackTopTempContents, Classes.Stack)
   end
 
   fun gcState_stackTopMinusWordDeref () =
      MemLoc.simple {base = gcState_stackTopContents (), 
-		    index = Immediate.const_int ~1,
-		    scale = wordScale,
-		    size = pointerSize,
-		    class = Classes.Stack}
+                    index = Immediate.const_int ~1,
+                    scale = wordScale,
+                    size = pointerSize,
+                    class = Classes.Stack}
   fun gcState_stackTopMinusWordDerefOperand () =
      Operand.memloc (gcState_stackTopMinusWordDeref ())
 
   fun stackTopTempMinusWordDeref () =
      MemLoc.simple {base = stackTopTempContents (), 
-		    index = Immediate.const_int ~1,
-		    scale = wordScale,
-		    size = pointerSize,
-		    class = Classes.Stack}
+                    index = Immediate.const_int ~1,
+                    scale = wordScale,
+                    size = pointerSize,
+                    class = Classes.Stack}
   fun stackTopTempMinusWordDerefOperand () =
      Operand.memloc (stackTopTempMinusWordDeref ())
 
   fun gcState_offset {offset, ty} =
     let
       val (_,_,operand) = 
-	make' (offset, Vector.sub(x86.Size.fromCType ty, 0), Classes.GCState)
+        make' (offset, Vector.sub(x86.Size.fromCType ty, 0), Classes.GCState)
     in
       operand ()
     end
 
   (* init *)
   fun init () = let
-		  val _ = Classes.initClasses ()
-		in
-		  ()
-		end
+                  val _ = Classes.initClasses ()
+                in
+                  ()
+                end
 end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/codegen/x86-codegen/x86-mlton-basic.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/codegen/x86-codegen/x86-mlton-basic.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/codegen/x86-codegen/x86-mlton-basic.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 type int = Int.t
 
 signature X86_MLTON_BASIC_STRUCTS =
@@ -50,30 +51,30 @@
      *)
     structure Classes :
       sig
-	val Heap : x86.MemLoc.Class.t
-	val Stack : x86.MemLoc.Class.t
-	val Locals : x86.MemLoc.Class.t
-	val Globals : x86.MemLoc.Class.t
+        val Heap : x86.MemLoc.Class.t
+        val Stack : x86.MemLoc.Class.t
+        val Locals : x86.MemLoc.Class.t
+        val Globals : x86.MemLoc.Class.t
 
-	val Temp : x86.MemLoc.Class.t
-	val StaticTemp : x86.MemLoc.Class.t
-	val CStack : x86.MemLoc.Class.t
-	val Code : x86.MemLoc.Class.t
+        val Temp : x86.MemLoc.Class.t
+        val StaticTemp : x86.MemLoc.Class.t
+        val CStack : x86.MemLoc.Class.t
+        val Code : x86.MemLoc.Class.t
 
-	val CStatic : x86.MemLoc.Class.t
-	val StaticNonTemp : x86.MemLoc.Class.t
-	  
-	val GCState : x86.MemLoc.Class.t
-	val GCStateHold : x86.MemLoc.Class.t
-	val GCStateVolatile : x86.MemLoc.Class.t
-	  
-	val allClasses : x86.ClassSet.t ref
-	val livenessClasses : x86.ClassSet.t ref
-	val holdClasses : x86.ClassSet.t ref
-	val volatileClasses : x86.ClassSet.t ref
-	val runtimeClasses : x86.ClassSet.t ref
-	val heapClasses : x86.ClassSet.t ref
-	val cstaticClasses : x86.ClassSet.t ref
+        val CStatic : x86.MemLoc.Class.t
+        val StaticNonTemp : x86.MemLoc.Class.t
+          
+        val GCState : x86.MemLoc.Class.t
+        val GCStateHold : x86.MemLoc.Class.t
+        val GCStateVolatile : x86.MemLoc.Class.t
+          
+        val allClasses : x86.ClassSet.t ref
+        val livenessClasses : x86.ClassSet.t ref
+        val holdClasses : x86.ClassSet.t ref
+        val volatileClasses : x86.ClassSet.t ref
+        val runtimeClasses : x86.ClassSet.t ref
+        val heapClasses : x86.ClassSet.t ref
+        val cstaticClasses : x86.ClassSet.t ref
       end
 
     (* CStack locations *)

Modified: mlton/branches/on-20050420-cmm-branch/mlton/codegen/x86-codegen/x86-mlton.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/codegen/x86-codegen/x86-mlton.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/codegen/x86-codegen/x86-mlton.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,9 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 functor x86MLton (S: X86_MLTON_STRUCTS): X86_MLTON =
@@ -25,1767 +25,1771 @@
   end
 
   type transInfo = {addData : x86.Assembly.t list -> unit,
-		    frameInfoToX86: (x86MLtonBasic.Machine.FrameInfo.t
-				     -> x86.FrameInfo.t),
-		    live: x86.Label.t -> x86.Operand.t list,
-		    liveInfo: x86Liveness.LiveInfo.t}
+                    frameInfoToX86: (x86MLtonBasic.Machine.FrameInfo.t
+                                     -> x86.FrameInfo.t),
+                    live: x86.Label.t -> x86.Operand.t list,
+                    liveInfo: x86Liveness.LiveInfo.t}
 
   fun implementsPrim (p: 'a Prim.t) =
      let
-	datatype z = datatype IntSize.prim
-	datatype z = datatype RealSize.t
-	datatype z = datatype WordSize.prim
-	fun w32168 s =
-	   case WordSize.prim s of
-	      W8 => true
-	    | W16 => true
-	    | W32 => true
-	    | W64 => false
-	datatype z = datatype Prim.Name.t
+        datatype z = datatype IntSize.prim
+        datatype z = datatype RealSize.t
+        datatype z = datatype WordSize.prim
+        fun w32168 s =
+           case WordSize.prim s of
+              W8 => true
+            | W16 => true
+            | W32 => true
+            | W64 => false
+        datatype z = datatype Prim.Name.t
      in
-	case Prim.name p of
-	   FFI_Symbol _ => true
-	 | Real_Math_acos _ => true
-	 | Real_Math_asin _ => true
-	 | Real_Math_atan _ => true
-	 | Real_Math_atan2 _ => true
-	 | Real_Math_cos _ => true
-	 | Real_Math_exp _ => true
-	 | Real_Math_ln _ => true
-	 | Real_Math_log10 _ => true
-	 | Real_Math_sin _ => true
-	 | Real_Math_sqrt _ => true
-	 | Real_Math_tan _ => true
-	 | Real_abs _ => true
-	 | Real_add _ => true
-	 | Real_div _ => true
-	 | Real_equal _ => true
-	 | Real_ldexp _ => true
-	 | Real_le _ => true
-	 | Real_lt _ => true
-	 | Real_mul _ => true
-	 | Real_muladd _ => true
-	 | Real_mulsub _ => true
-	 | Real_neg _ => true
-	 | Real_qequal _ => true
-	 | Real_round _ => true
-	 | Real_sub _ => true
-	 | Real_toReal _ => true
-	 | Real_toWord (s1, s2, {signed}) =>
-	      signed
-	      andalso (case (s1, WordSize.prim s2) of
-			  (R64, W32) => true
-			| (R64, W16) => true
-			| (R64, W8) => true
-			| (R32, W32) => true
-			| (R32, W16) => true
-			| (R32, W8) => true
-			| _ => false)
-	 | Word_add _ => true
-	 | Word_addCheck _ => true
-	 | Word_andb _ => true
-	 | Word_equal s => w32168 s
-	 | Word_lshift s => w32168 s
-	 | Word_lt (s, _) => w32168 s
-	 | Word_mul (s, _) => w32168 s
-	 | Word_mulCheck (s, _) => w32168 s
-	 | Word_neg _ => true
-	 | Word_notb _ => true
-	 | Word_orb _ => true
-	 | Word_quot (s, _) => w32168 s
-	 | Word_rem (s, _) => w32168 s
-	 | Word_rol s => w32168 s
-	 | Word_ror s => w32168 s
-	 | Word_rshift (s, _) => w32168 s
-	 | Word_sub _ => true
-	 | Word_toReal (s1, s2, {signed}) =>
-	      signed
-	      andalso (case (WordSize.prim s1, s2) of
-			  (W32, R64) => true
-			| (W32, R32) => true
-			| (W16, R64) => true
-			| (W16, R32) => true
-			| (W8, R64) => true
-			| (W8, R32) => true
-			| _ => false)
-	 | Word_toWord (s1, s2, _) =>
-	      (case (WordSize.prim s1, WordSize.prim s2) of
-		  (W32, W32) => true
-		| (W32, W16) => true
-		| (W32, W8) => true
-		| (W16, W32) => true
-		| (W16, W16) => true
-		| (W16, W8) => true
-		| (W8, W32) => true
-		| (W8, W16) => true
-		| (W8, W8) => true
-		| _ => false)
-	 | Word_xorb _ => true
-	 | _ => false
+        case Prim.name p of
+           FFI_Symbol _ => true
+         | Real_Math_acos _ => true
+         | Real_Math_asin _ => true
+         | Real_Math_atan _ => true
+         | Real_Math_atan2 _ => true
+         | Real_Math_cos _ => true
+         | Real_Math_exp _ => true
+         | Real_Math_ln _ => true
+         | Real_Math_log10 _ => true
+         | Real_Math_sin _ => true
+         | Real_Math_sqrt _ => true
+         | Real_Math_tan _ => true
+         | Real_abs _ => true
+         | Real_add _ => true
+         | Real_div _ => true
+         | Real_equal _ => true
+         | Real_ldexp _ => true
+         | Real_le _ => true
+         | Real_lt _ => true
+         | Real_mul _ => true
+         | Real_muladd _ => true
+         | Real_mulsub _ => true
+         | Real_neg _ => true
+         | Real_qequal _ => true
+         | Real_round _ => true
+         | Real_sub _ => true
+         | Real_toReal _ => true
+         | Real_toWord (s1, s2, {signed}) =>
+              signed
+              andalso (case (s1, WordSize.prim s2) of
+                          (R64, W32) => true
+                        | (R64, W16) => true
+                        | (R64, W8) => true
+                        | (R32, W32) => true
+                        | (R32, W16) => true
+                        | (R32, W8) => true
+                        | _ => false)
+         | Word_add _ => true
+         | Word_addCheck _ => true
+         | Word_andb _ => true
+         | Word_equal s => w32168 s
+         | Word_lshift s => w32168 s
+         | Word_lt (s, _) => w32168 s
+         | Word_mul (s, _) => w32168 s
+         | Word_mulCheck (s, _) => w32168 s
+         | Word_neg _ => true
+         | Word_negCheck _ => true
+         | Word_notb _ => true
+         | Word_orb _ => true
+         | Word_quot (s, _) => w32168 s
+         | Word_rem (s, _) => w32168 s
+         | Word_rol s => w32168 s
+         | Word_ror s => w32168 s
+         | Word_rshift (s, _) => w32168 s
+         | Word_sub _ => true
+         | Word_subCheck _ => true
+         | Word_toReal (s1, s2, {signed}) =>
+              signed
+              andalso (case (WordSize.prim s1, s2) of
+                          (W32, R64) => true
+                        | (W32, R32) => true
+                        | (W16, R64) => true
+                        | (W16, R32) => true
+                        | (W8, R64) => true
+                        | (W8, R32) => true
+                        | _ => false)
+         | Word_toWord (s1, s2, _) =>
+              (case (WordSize.prim s1, WordSize.prim s2) of
+                  (W32, W32) => true
+                | (W32, W16) => true
+                | (W32, W8) => true
+                | (W16, W32) => true
+                | (W16, W16) => true
+                | (W16, W8) => true
+                | (W8, W32) => true
+                | (W8, W16) => true
+                | (W8, W8) => true
+                | _ => false)
+         | Word_xorb _ => true
+         | _ => false
      end
 
   val implementsPrim: Machine.Type.t Prim.t -> bool =
-     Trace.trace ("implementsPrim", Prim.layout, Bool.layout) implementsPrim
+     Trace.trace 
+     ("x86MLton.implementsPrim", Prim.layout, Bool.layout) 
+     implementsPrim
 
   fun prim {prim : RepType.t Prim.t,
-	    args : (Operand.t * Size.t) vector,
-	    dsts : (Operand.t * Size.t) vector,
-	    transInfo = {...} : transInfo}
+            args : (Operand.t * Size.t) vector,
+            dsts : (Operand.t * Size.t) vector,
+            transInfo = {...} : transInfo}
     = let
-	val primName = Prim.toString prim
-	datatype z = datatype Prim.Name.t
+        val primName = Prim.toString prim
+        datatype z = datatype Prim.Name.t
 
-	fun getDst1 ()
-	  = Vector.sub (dsts, 0)
-	    handle _ => Error.bug "applyPrim: getDst1"
-	fun getDst2 ()
-	  = (Vector.sub (dsts, 0), Vector.sub (dsts, 1))
-	    handle _ => Error.bug "applyPrim: getDst2"
-	fun getSrc1 ()
-	  = Vector.sub (args, 0)
-	    handle _ => Error.bug "applyPrim: getSrc1"
-	fun getSrc2 ()
-	  = (Vector.sub (args, 0), Vector.sub (args, 1))
-	    handle _ => Error.bug "applyPrim: getSrc2"
-	fun getSrc3 ()
-	  = (Vector.sub (args, 0), Vector.sub (args, 1), Vector.sub (args, 2))
-	    handle _ => Error.bug "applyPrim: getSrc3"
-	fun getSrc4 ()
-	  = (Vector.sub (args, 0), Vector.sub (args, 1), 
-	     Vector.sub (args, 2), Vector.sub (args, 3))
-	    handle _ => Error.bug "applyPrim: getSrc4"
+        fun getDst1 ()
+          = Vector.sub (dsts, 0)
+            handle _ => Error.bug "x86MLton.prim: getDst1"
+        fun getDst2 ()
+          = (Vector.sub (dsts, 0), Vector.sub (dsts, 1))
+            handle _ => Error.bug "x86MLton.prim: getDst2"
+        fun getSrc1 ()
+          = Vector.sub (args, 0)
+            handle _ => Error.bug "x86MLton.prim: getSrc1"
+        fun getSrc2 ()
+          = (Vector.sub (args, 0), Vector.sub (args, 1))
+            handle _ => Error.bug "x86MLton.prim: getSrc2"
+        fun getSrc3 ()
+          = (Vector.sub (args, 0), Vector.sub (args, 1), Vector.sub (args, 2))
+            handle _ => Error.bug "x86MLton.prim: getSrc3"
+        fun getSrc4 ()
+          = (Vector.sub (args, 0), Vector.sub (args, 1), 
+             Vector.sub (args, 2), Vector.sub (args, 3))
+            handle _ => Error.bug "x86MLton.prim: getSrc4"
 
-	fun mov ()
-	  = let
-	      val (dst,dstsize) = getDst1 ()
-	      val (src,srcsize) = getSrc1 ()
-	      val _ 
-		= Assert.assert
-		  ("applyPrim: mov, dstsize/srcsize",
-		   fn () => srcsize = dstsize)
-	    in
-	      AppendList.fromList
-	      [Block.mkBlock'
-	       {entry = NONE,
-		statements
-		= [Assembly.instruction_mov
-		   {dst = dst,
-		    src = src,
-		    size = srcsize}],
-		transfer = NONE}]
-	    end
-	  
-	fun movx oper
-	  = let
-	      val (dst,dstsize) = getDst1 ()
-	      val (src,srcsize) = getSrc1 ()
-	      val _ 
-		= Assert.assert
-		  ("applyPrim: movx, dstsize/srcsize",
-		   fn () => Size.lt(srcsize,dstsize))
-	    in
-	      AppendList.fromList
-	      [Block.mkBlock'
-	       {entry = NONE,
-		statements
-		= [Assembly.instruction_movx
-		   {oper = oper,
-		    dst = dst,
-		    src = src,
-		    dstsize = dstsize,
-		    srcsize = srcsize}],
-		transfer = NONE}]
-	    end
+        fun mov ()
+          = let
+              val (dst,dstsize) = getDst1 ()
+              val (src,srcsize) = getSrc1 ()
+              val _ 
+                = Assert.assert
+                  ("x86MLton.prim: mov, dstsize/srcsize",
+                   fn () => srcsize = dstsize)
+            in
+              AppendList.fromList
+              [Block.mkBlock'
+               {entry = NONE,
+                statements
+                = [Assembly.instruction_mov
+                   {dst = dst,
+                    src = src,
+                    size = srcsize}],
+                transfer = NONE}]
+            end
+          
+        fun movx oper
+          = let
+              val (dst,dstsize) = getDst1 ()
+              val (src,srcsize) = getSrc1 ()
+              val _ 
+                = Assert.assert
+                  ("x86MLton.prim: movx, dstsize/srcsize",
+                   fn () => Size.lt(srcsize,dstsize))
+            in
+              AppendList.fromList
+              [Block.mkBlock'
+               {entry = NONE,
+                statements
+                = [Assembly.instruction_movx
+                   {oper = oper,
+                    dst = dst,
+                    src = src,
+                    dstsize = dstsize,
+                    srcsize = srcsize}],
+                transfer = NONE}]
+            end
 
-	fun xvom ()
-	  = let
-	      val (dst,dstsize) = getDst1 ()
-	      val (src,srcsize) = getSrc1 ()
-	      val _ 
-		= Assert.assert
-		  ("applyPrim: xvom, dstsize/srcsize",
-		   fn () => Size.lt(dstsize,srcsize))
-	    in
-	      AppendList.fromList
-	      [Block.mkBlock'
-	       {entry = NONE,
-		statements
-		= [Assembly.instruction_xvom
-		   {dst = dst,
-		    src = src,
-		    dstsize = dstsize,
-		    srcsize = srcsize}],
-		transfer = NONE}]
-	    end
+        fun xvom ()
+          = let
+              val (dst,dstsize) = getDst1 ()
+              val (src,srcsize) = getSrc1 ()
+              val _ 
+                = Assert.assert
+                  ("x86MLton.prim: xvom, dstsize/srcsize",
+                   fn () => Size.lt(dstsize,srcsize))
+            in
+              AppendList.fromList
+              [Block.mkBlock'
+               {entry = NONE,
+                statements
+                = [Assembly.instruction_xvom
+                   {dst = dst,
+                    src = src,
+                    dstsize = dstsize,
+                    srcsize = srcsize}],
+                transfer = NONE}]
+            end
 
-	fun binal oper
-	  = let
-	      val ((src1,src1size),
-		   (src2,src2size)) = getSrc2 ()
-	      val (dst,dstsize) = getDst1 ()
-	      val _ 
-		= Assert.assert
-		  ("applyPrim: binal, dstsize/src1size/src2size",
-		   fn () => src1size = dstsize andalso
-		            src2size = dstsize)
+        fun binal oper
+          = let
+              val ((src1,src1size),
+                   (src2,src2size)) = getSrc2 ()
+              val (dst,dstsize) = getDst1 ()
+              val _ 
+                = Assert.assert
+                  ("x86MLton.prim: binal, dstsize/src1size/src2size",
+                   fn () => src1size = dstsize andalso
+                            src2size = dstsize)
 
-	      (* Reverse src1/src2 when src1 and src2 are temporaries
-	       * and the oper is commutative. 
-	       *)
-	      val (src1,src2)
-		= if (oper = Instruction.ADD)
-		     orelse
-		     (oper = Instruction.ADC)
-		     orelse
-		     (oper = Instruction.AND)
-		     orelse
-		     (oper = Instruction.OR)
-		     orelse
-		     (oper = Instruction.XOR)
-		    then case (Operand.deMemloc src1, Operand.deMemloc src2)
-			   of (SOME memloc_src1, SOME memloc_src2)
-			    => if x86Liveness.track memloc_src1
-			          andalso
-				  x86Liveness.track memloc_src2
-				 then (src2,src1)
-				 else (src1,src2)
-			    | _ => (src1,src2)
-		    else (src1,src2)
-	    in
-	      AppendList.fromList
-	      [Block.mkBlock'
-	       {entry = NONE,
-		statements
-		= [Assembly.instruction_mov
-		   {dst = dst,
-		    src = src1,
-		    size = src1size},
-		   Assembly.instruction_binal
-		   {oper = oper,
-		    dst = dst,
-		    src = src2,
-		    size = dstsize}],
-		transfer = NONE}]
-	    end
+              (* Reverse src1/src2 when src1 and src2 are temporaries
+               * and the oper is commutative. 
+               *)
+              val (src1,src2)
+                = if (oper = Instruction.ADD)
+                     orelse
+                     (oper = Instruction.ADC)
+                     orelse
+                     (oper = Instruction.AND)
+                     orelse
+                     (oper = Instruction.OR)
+                     orelse
+                     (oper = Instruction.XOR)
+                    then case (Operand.deMemloc src1, Operand.deMemloc src2)
+                           of (SOME memloc_src1, SOME memloc_src2)
+                            => if x86Liveness.track memloc_src1
+                                  andalso
+                                  x86Liveness.track memloc_src2
+                                 then (src2,src1)
+                                 else (src1,src2)
+                            | _ => (src1,src2)
+                    else (src1,src2)
+            in
+              AppendList.fromList
+              [Block.mkBlock'
+               {entry = NONE,
+                statements
+                = [Assembly.instruction_mov
+                   {dst = dst,
+                    src = src1,
+                    size = src1size},
+                   Assembly.instruction_binal
+                   {oper = oper,
+                    dst = dst,
+                    src = src2,
+                    size = dstsize}],
+                transfer = NONE}]
+            end
 
-	fun binal64 (oper1, oper2)
-	  = let
-	      val ((src1,src1size),
-		   (src2,src2size),
-		   (src3,src3size),
-		   (src4,src4size)) = getSrc4 ()
-	      val ((dst1,dst1size),
-		   (dst2,dst2size)) = getDst2 ()
-	      val _ 
-		= Assert.assert
-		  ("applyPrim: binal64, dst1size/dst2size/src1size/src2size/src3size/src4size",
-		   fn () => src1size = dst1size andalso
-		            src3size = dst1size andalso
-			    src2size = dst2size andalso
-		            src4size = dst2size andalso
-		            dst1size = dst2size)
-	      val tdst1 =
-		 if List.exists ([src2,src3,src4], fn src =>
-				 Operand.mayAlias (dst1, src))
-		    then wordTemp1ContentsOperand dst1size
-		    else dst1
-	      val tdst2 =
-		 if List.exists ([src3,src4], fn src =>
-				 Operand.mayAlias (dst2, src))
-		    then wordTemp1ContentsOperand dst2size
-		    else dst2
-	    in
-	      AppendList.fromList
-	      [Block.mkBlock'
-	       {entry = NONE,
-		statements
-		= [Assembly.instruction_mov
-		   {dst = tdst1,
-		    src = src1,
-		    size = src1size},
-		   Assembly.instruction_mov
-		   {dst = tdst2,
-		    src = src2,
-		    size = src2size},
-		   Assembly.instruction_binal
-		   {oper = oper1,
-		    dst = tdst1,
-		    src = src3,
-		    size = dst1size},
-		   Assembly.instruction_binal
-		   {oper = oper2,
-		    dst = tdst2,
-		    src = src4,
-		    size = dst2size},
-		   Assembly.instruction_mov
-		   {dst = dst1,
-		    src = tdst1,
-		    size = dst1size},
-		   Assembly.instruction_mov
-		   {dst = dst2,
-		    src = tdst2,
-		    size = dst2size}],
-		transfer = NONE}]
-	    end
+        fun binal64 (oper1, oper2)
+          = let
+              val ((src1,src1size),
+                   (src2,src2size),
+                   (src3,src3size),
+                   (src4,src4size)) = getSrc4 ()
+              val ((dst1,dst1size),
+                   (dst2,dst2size)) = getDst2 ()
+              val _ 
+                = Assert.assert
+                  ("x86MLton.prim: binal64, dst1size/dst2size/src1size/src2size/src3size/src4size",
+                   fn () => src1size = dst1size andalso
+                            src3size = dst1size andalso
+                            src2size = dst2size andalso
+                            src4size = dst2size andalso
+                            dst1size = dst2size)
+              val tdst1 =
+                 if List.exists ([src2,src3,src4], fn src =>
+                                 Operand.mayAlias (dst1, src))
+                    then wordTemp1ContentsOperand dst1size
+                    else dst1
+              val tdst2 =
+                 if List.exists ([src3,src4], fn src =>
+                                 Operand.mayAlias (dst2, src))
+                    then wordTemp1ContentsOperand dst2size
+                    else dst2
+            in
+              AppendList.fromList
+              [Block.mkBlock'
+               {entry = NONE,
+                statements
+                = [Assembly.instruction_mov
+                   {dst = tdst1,
+                    src = src1,
+                    size = src1size},
+                   Assembly.instruction_mov
+                   {dst = tdst2,
+                    src = src2,
+                    size = src2size},
+                   Assembly.instruction_binal
+                   {oper = oper1,
+                    dst = tdst1,
+                    src = src3,
+                    size = dst1size},
+                   Assembly.instruction_binal
+                   {oper = oper2,
+                    dst = tdst2,
+                    src = src4,
+                    size = dst2size},
+                   Assembly.instruction_mov
+                   {dst = dst1,
+                    src = tdst1,
+                    size = dst1size},
+                   Assembly.instruction_mov
+                   {dst = dst2,
+                    src = tdst2,
+                    size = dst2size}],
+                transfer = NONE}]
+            end
 
-	fun pmd oper
-	  = let
-	      val ((src1,src1size),
-		   (src2,src2size)) = getSrc2 ()
-	      val (dst,dstsize) = getDst1 ()
-	      val _ 
-		= Assert.assert
-		  ("applyPrim: pmd, dstsize/src1size/src2size",
-		   fn () => src1size = dstsize andalso
-		            src2size = dstsize)
+        fun pmd oper
+          = let
+              val ((src1,src1size),
+                   (src2,src2size)) = getSrc2 ()
+              val (dst,dstsize) = getDst1 ()
+              val _ 
+                = Assert.assert
+                  ("x86MLton.prim: pmd, dstsize/src1size/src2size",
+                   fn () => src1size = dstsize andalso
+                            src2size = dstsize)
 
-	      (* Reverse src1/src2 when src1 and src2 are temporaries
-	       * and the oper is commutative. 
-	       *)
-	      val (src1,src2)
-		= if (oper = Instruction.IMUL)
-		     orelse
-		     (oper = Instruction.MUL)
-		    then case (Operand.deMemloc src1, Operand.deMemloc src2)
-			   of (SOME memloc_src1, SOME memloc_src2)
-			    => if x86Liveness.track memloc_src1
-			          andalso
-				  x86Liveness.track memloc_src2
-				 then (src2,src1)
-				 else (src1,src2)
-			    | _ => (src1,src2)
-		    else (src1,src2)
-	    in
-	      AppendList.fromList
-	      [Block.mkBlock'
-	       {entry = NONE,
-		statements
-		= [Assembly.instruction_mov
-		   {dst = dst,
-		    src = src1,
-		    size = src1size},
-		   Assembly.instruction_pmd
-		   {oper = oper,
-		    dst = dst,
-		    src = src2,
-		    size = dstsize}],
-		transfer = NONE}]
-	    end
+              (* Reverse src1/src2 when src1 and src2 are temporaries
+               * and the oper is commutative. 
+               *)
+              val (src1,src2)
+                = if (oper = Instruction.IMUL)
+                     orelse
+                     (oper = Instruction.MUL)
+                    then case (Operand.deMemloc src1, Operand.deMemloc src2)
+                           of (SOME memloc_src1, SOME memloc_src2)
+                            => if x86Liveness.track memloc_src1
+                                  andalso
+                                  x86Liveness.track memloc_src2
+                                 then (src2,src1)
+                                 else (src1,src2)
+                            | _ => (src1,src2)
+                    else (src1,src2)
+            in
+              AppendList.fromList
+              [Block.mkBlock'
+               {entry = NONE,
+                statements
+                = [Assembly.instruction_mov
+                   {dst = dst,
+                    src = src1,
+                    size = src1size},
+                   Assembly.instruction_pmd
+                   {oper = oper,
+                    dst = dst,
+                    src = src2,
+                    size = dstsize}],
+                transfer = NONE}]
+            end
 
-	fun imul2 ()
-	  = let
-	      val ((src1,src1size),
-		   (src2,src2size)) = getSrc2 ()
-	      val (dst,dstsize) = getDst1 ()
-	      val _ 
-		= Assert.assert
-		  ("applyPrim: pmd, dstsize/src1size/src2size",
-		   fn () => src1size = dstsize andalso
-		            src2size = dstsize)
+        fun imul2 ()
+          = let
+              val ((src1,src1size),
+                   (src2,src2size)) = getSrc2 ()
+              val (dst,dstsize) = getDst1 ()
+              val _ 
+                = Assert.assert
+                  ("x86MLton.prim: imul2, dstsize/src1size/src2size",
+                   fn () => src1size = dstsize andalso
+                            src2size = dstsize)
 
-	      (* Reverse src1/src2 when src1 and src2 are temporaries
-	       * and the oper is commutative. 
-	       *)
-	      val (src1,src2)
-		= case (Operand.deMemloc src1, Operand.deMemloc src2)
-		    of (SOME memloc_src1, SOME memloc_src2)
-		     => if x86Liveness.track memloc_src1
-		           andalso
-			   x86Liveness.track memloc_src2
-			  then (src2,src1)
-			  else (src1,src2)
-		     | _ => (src1,src2)
-	    in
-	      AppendList.fromList
-	      [Block.mkBlock'
-	       {entry = NONE,
-		statements
-		= [Assembly.instruction_mov
-		   {dst = dst,
-		    src = src1,
-		    size = src1size},
-		   Assembly.instruction_imul2
-		   {dst = dst,
-		    src = src2,
-		    size = dstsize}],
-		transfer = NONE}]
-	    end
+              (* Reverse src1/src2 when src1 and src2 are temporaries
+               * and the oper is commutative. 
+               *)
+              val (src1,src2)
+                = case (Operand.deMemloc src1, Operand.deMemloc src2)
+                    of (SOME memloc_src1, SOME memloc_src2)
+                     => if x86Liveness.track memloc_src1
+                           andalso
+                           x86Liveness.track memloc_src2
+                          then (src2,src1)
+                          else (src1,src2)
+                     | _ => (src1,src2)
+            in
+              AppendList.fromList
+              [Block.mkBlock'
+               {entry = NONE,
+                statements
+                = [Assembly.instruction_mov
+                   {dst = dst,
+                    src = src1,
+                    size = src1size},
+                   Assembly.instruction_imul2
+                   {dst = dst,
+                    src = src2,
+                    size = dstsize}],
+                transfer = NONE}]
+            end
 
-	fun unal oper
-	  = let
-	      val (src,srcsize) = getSrc1 ()
-	      val (dst,dstsize) = getDst1 ()
-	      val _ 
-		= Assert.assert
-		  ("applyPrim: unal, dstsize/srcsize",
-		   fn () => srcsize = dstsize)
-	    in
-	      AppendList.fromList
-	      [Block.mkBlock'
-	       {entry = NONE,
-		statements 
-		= [Assembly.instruction_mov
-		   {dst = dst,
-		    src = src,
-		    size = srcsize},
-		   Assembly.instruction_unal
-		   {oper = oper,
-		    dst = dst,
-		    size = dstsize}],
-		transfer = NONE}]
-	    end
+        fun unal oper
+          = let
+              val (src,srcsize) = getSrc1 ()
+              val (dst,dstsize) = getDst1 ()
+              val _ 
+                = Assert.assert
+                  ("x86MLton.prim: unal, dstsize/srcsize",
+                   fn () => srcsize = dstsize)
+            in
+              AppendList.fromList
+              [Block.mkBlock'
+               {entry = NONE,
+                statements 
+                = [Assembly.instruction_mov
+                   {dst = dst,
+                    src = src,
+                    size = srcsize},
+                   Assembly.instruction_unal
+                   {oper = oper,
+                    dst = dst,
+                    size = dstsize}],
+                transfer = NONE}]
+            end
 
-	fun unal64 (oper, mk)
-	  = let
-	      val ((src1,src1size),(src2,src2size)) = getSrc2 ()
-	      val ((dst1,dst1size),(dst2,dst2size)) = getDst2 ()
-	      val _ 
-		= Assert.assert
-		  ("applyPrim: unal, dst1size/dst2size/src1size/src2size",
-		   fn () => src1size = dst1size andalso
+        fun unal64 (oper, mk)
+          = let
+              val ((src1,src1size),(src2,src2size)) = getSrc2 ()
+              val ((dst1,dst1size),(dst2,dst2size)) = getDst2 ()
+              val _ 
+                = Assert.assert
+                  ("x86MLton.prim: unal64, dst1size/dst2size/src1size/src2size",
+                   fn () => src1size = dst1size andalso
                             src2size = dst2size andalso
                             dst1size = dst2size)
-	      val tdst1 =
-		 if List.exists ([src2], fn src =>
-				 Operand.mayAlias (dst1, src))
-		    then wordTemp1ContentsOperand dst1size
-		    else dst1
-	    in
-	      AppendList.fromList
-	      [Block.mkBlock'
-	       {entry = NONE,
-		statements 
-		= [Assembly.instruction_mov
-		   {dst = tdst1,
-		    src = src1,
-		    size = src1size},
-		   Assembly.instruction_mov
-		   {dst = dst2,
-		    src = src2,
-		    size = src2size},
-		   Assembly.instruction_mov
-		   {dst = dst1,
-		    src = tdst1,
-		    size = dst1size},
-		   Assembly.instruction_unal
-		   {oper = oper,
-		    dst = dst1,
-		    size = dst1size}] @
-		  (mk (dst2,dst2size)) @
-		  [Assembly.instruction_unal
-		   {oper = oper,
-		    dst = dst2,
-		    size = dst2size}],
-		transfer = NONE}]
-	    end
+              val tdst1 =
+                 if List.exists ([src2], fn src =>
+                                 Operand.mayAlias (dst1, src))
+                    then wordTemp1ContentsOperand dst1size
+                    else dst1
+            in
+              AppendList.fromList
+              [Block.mkBlock'
+               {entry = NONE,
+                statements 
+                = [Assembly.instruction_mov
+                   {dst = tdst1,
+                    src = src1,
+                    size = src1size},
+                   Assembly.instruction_mov
+                   {dst = dst2,
+                    src = src2,
+                    size = src2size},
+                   Assembly.instruction_mov
+                   {dst = dst1,
+                    src = tdst1,
+                    size = dst1size},
+                   Assembly.instruction_unal
+                   {oper = oper,
+                    dst = dst1,
+                    size = dst1size}] @
+                  (mk (dst2,dst2size)) @
+                  [Assembly.instruction_unal
+                   {oper = oper,
+                    dst = dst2,
+                    size = dst2size}],
+                transfer = NONE}]
+            end
 
-	fun sral oper
-	  = let
-	      val (dst,dstsize) = getDst1 ()
-	      val ((src1,src1size),
-		   (src2,src2size)) = getSrc2 ()
-	      val _ 
-		= Assert.assert
-		  ("applyPrim: sral, dstsize/src1size",
-		   fn () => src1size = dstsize)
-	      val _ 
-		= Assert.assert
-		  ("applyPrim: sral, src2size",
-		   fn () => src2size = wordSize)
-	    in
-	      AppendList.fromList
-	      [Block.mkBlock'
-	       {entry = NONE,
-		statements
-		= [Assembly.instruction_mov
-		   {dst = dst,
-		    src = src1,
-		    size = dstsize},
-		   Assembly.instruction_sral
-		   {oper = oper,
-		    dst = dst,
-		    count = src2,
-		    size = dstsize}],
-		transfer = NONE}]
-	    end
+        fun sral oper
+          = let
+              val (dst,dstsize) = getDst1 ()
+              val ((src1,src1size),
+                   (src2,src2size)) = getSrc2 ()
+              val _ 
+                = Assert.assert
+                  ("x86MLton.prim: sral, dstsize/src1size",
+                   fn () => src1size = dstsize)
+              val _ 
+                = Assert.assert
+                  ("x86MLton.prim: sral, src2size",
+                   fn () => src2size = wordSize)
+            in
+              AppendList.fromList
+              [Block.mkBlock'
+               {entry = NONE,
+                statements
+                = [Assembly.instruction_mov
+                   {dst = dst,
+                    src = src1,
+                    size = dstsize},
+                   Assembly.instruction_sral
+                   {oper = oper,
+                    dst = dst,
+                    count = src2,
+                    size = dstsize}],
+                transfer = NONE}]
+            end
 
-	fun cmp condition
-	  = let
-	      val (dst,dstsize) = getDst1 ()
-	      val ((src1,src1size),
-		   (src2,src2size)) = getSrc2 ()
-	      val _ 
-		= Assert.assert
-		  ("applyPrim: cmp, src1size/src2size",
-		   fn () => src1size = src2size)
-	    in
-	      (* Can't have an immediate in src1 position,
-	       * so reverse the srcs and reverse the condition.
-	       *
-	       * This won't fix an immediate in both positions.
-	       * Either constant folding eliminated it
-	       * or the register allocator will raise an error.
-	       *)
-	      case Operand.deImmediate src1
-		of SOME _ => AppendList.fromList
-		             [Block.mkBlock'
-			      {entry = NONE,
-			       statements
-			       = [Assembly.instruction_cmp
-				  {src1 = src2,
-				   src2 = src1,
-				   size = src1size},
-				  Assembly.instruction_setcc
-				  {condition = Instruction.condition_reverse condition,
-				   dst = dst,
-				   size = dstsize}],
-			       transfer = NONE}]
-		 | NONE => AppendList.fromList
-			   [Block.mkBlock'
-			    {entry = NONE,	
-			     statements
-			     = [Assembly.instruction_cmp
-				{src1 = src1,
-				 src2 = src2,
-				 size = src1size},
-				Assembly.instruction_setcc
-				{condition = condition,
-				 dst = dst,
-				 size = dstsize}],
-			     transfer = NONE}]
-	    end
-	  
-	fun fbina oper
-	  = let
-	      val (dst,dstsize) = getDst1 ()
-	      val ((src1,src1size),
-		   (src2,src2size)) = getSrc2 ()
-	      val _ 
-		= Assert.assert
-		  ("applyPrim: fbina, dstsize/src1size/src2size",
-		   fn () => src1size = dstsize andalso
-		            src2size = dstsize)
+        fun cmp condition
+          = let
+              val (dst,dstsize) = getDst1 ()
+              val ((src1,src1size),
+                   (src2,src2size)) = getSrc2 ()
+              val _ 
+                = Assert.assert
+                  ("x86MLton.prim: cmp, src1size/src2size",
+                   fn () => src1size = src2size)
+            in
+              (* Can't have an immediate in src1 position,
+               * so reverse the srcs and reverse the condition.
+               *
+               * This won't fix an immediate in both positions.
+               * Either constant folding eliminated it
+               * or the register allocator will raise an error.
+               *)
+              case Operand.deImmediate src1
+                of SOME _ => AppendList.fromList
+                             [Block.mkBlock'
+                              {entry = NONE,
+                               statements
+                               = [Assembly.instruction_cmp
+                                  {src1 = src2,
+                                   src2 = src1,
+                                   size = src1size},
+                                  Assembly.instruction_setcc
+                                  {condition = Instruction.condition_reverse condition,
+                                   dst = dst,
+                                   size = dstsize}],
+                               transfer = NONE}]
+                 | NONE => AppendList.fromList
+                           [Block.mkBlock'
+                            {entry = NONE,      
+                             statements
+                             = [Assembly.instruction_cmp
+                                {src1 = src1,
+                                 src2 = src2,
+                                 size = src1size},
+                                Assembly.instruction_setcc
+                                {condition = condition,
+                                 dst = dst,
+                                 size = dstsize}],
+                             transfer = NONE}]
+            end
+          
+        fun fbina oper
+          = let
+              val (dst,dstsize) = getDst1 ()
+              val ((src1,src1size),
+                   (src2,src2size)) = getSrc2 ()
+              val _ 
+                = Assert.assert
+                  ("x86MLton.prim: fbina, dstsize/src1size/src2size",
+                   fn () => src1size = dstsize andalso
+                            src2size = dstsize)
 
-	      (* Reverse src1/src2 when src1 and src2 are temporaries.
-	       *)
-	      val (oper,src1,src2)
-		= case (Operand.deMemloc src1, Operand.deMemloc src2)
-		    of (SOME memloc_src1, SOME memloc_src2) 
+              (* Reverse src1/src2 when src1 and src2 are temporaries.
+               *)
+              val (oper,src1,src2)
+                = case (Operand.deMemloc src1, Operand.deMemloc src2)
+                    of (SOME memloc_src1, SOME memloc_src2) 
                      => if x86Liveness.track memloc_src1
-		           andalso
-			   x86Liveness.track memloc_src2
-			  then (Instruction.fbina_reverse oper,src2,src1)
-			  else (oper,src1,src2)
-		     | _ => (oper,src1,src2)
-	    in
-	      AppendList.fromList
-	      [Block.mkBlock'
-	       {entry = NONE,
-		statements
-		= [Assembly.instruction_pfmov
-		   {dst = dst,
-		    src = src1,
-		    size = src1size},
-		   Assembly.instruction_pfbina
-		   {oper = oper,
-		    dst = dst,
-		    src = src2,
-		    size = dstsize}],
-		transfer = NONE}]
-	    end
+                           andalso
+                           x86Liveness.track memloc_src2
+                          then (Instruction.fbina_reverse oper,src2,src1)
+                          else (oper,src1,src2)
+                     | _ => (oper,src1,src2)
+            in
+              AppendList.fromList
+              [Block.mkBlock'
+               {entry = NONE,
+                statements
+                = [Assembly.instruction_pfmov
+                   {dst = dst,
+                    src = src1,
+                    size = src1size},
+                   Assembly.instruction_pfbina
+                   {oper = oper,
+                    dst = dst,
+                    src = src2,
+                    size = dstsize}],
+                transfer = NONE}]
+            end
 
-	fun fbina_fmul oper
-	  = let
-	      val (dst,dstsize) = getDst1 ()
-	      val ((src1,src1size),
-		   (src2,src2size),
-		   (src3,src3size)) = getSrc3 ()
-	      val _ 
-		= Assert.assert
-		  ("applyPrim: fbina_fmul, dstsize/src1size/src2size/src3size",
-		   fn () => src1size = dstsize andalso
-		            src2size = dstsize andalso
-			    src3size = dstsize)
-	    in
-	      AppendList.fromList
-	      [Block.mkBlock'
-	       {entry = NONE,
-		statements
-		= [Assembly.instruction_pfmov
-		   {dst = dst,
-		    src = src1,
-		    size = src1size},
-		   Assembly.instruction_pfbina
-		   {oper = Instruction.FMUL,
-		    dst = dst,
-		    src = src2,
-		    size = dstsize},
-		   Assembly.instruction_pfbina
-		   {oper = oper,
-		    dst = dst,
-		    src = src3,
-		    size = dstsize}],
-		transfer = NONE}]
-	    end
+        fun fbina_fmul oper
+          = let
+              val (dst,dstsize) = getDst1 ()
+              val ((src1,src1size),
+                   (src2,src2size),
+                   (src3,src3size)) = getSrc3 ()
+              val _ 
+                = Assert.assert
+                  ("x86MLton.prim: fbina_fmul, dstsize/src1size/src2size/src3size",
+                   fn () => src1size = dstsize andalso
+                            src2size = dstsize andalso
+                            src3size = dstsize)
+            in
+              AppendList.fromList
+              [Block.mkBlock'
+               {entry = NONE,
+                statements
+                = [Assembly.instruction_pfmov
+                   {dst = dst,
+                    src = src1,
+                    size = src1size},
+                   Assembly.instruction_pfbina
+                   {oper = Instruction.FMUL,
+                    dst = dst,
+                    src = src2,
+                    size = dstsize},
+                   Assembly.instruction_pfbina
+                   {oper = oper,
+                    dst = dst,
+                    src = src3,
+                    size = dstsize}],
+                transfer = NONE}]
+            end
 
-	fun funa oper
-	  = let
-	      val (dst,dstsize) = getDst1 ()
-	      val (src,srcsize) = getSrc1 ()
-	      val _ 
-		= Assert.assert
-		  ("applyPrim: funa, dstsize/srcsize",
-		   fn () => srcsize = dstsize)
-	    in
-	      AppendList.fromList
-	      [Block.mkBlock'
-	       {entry = NONE,
-		statements 
-		= [Assembly.instruction_pfmov
-		   {dst = dst,
-		    src = src,
-		    size = srcsize},
-		   Assembly.instruction_pfuna
-		   {oper = oper,
-		    dst = dst,
-		    size = dstsize}],
-		transfer = NONE}]
-	    end
+        fun funa oper
+          = let
+              val (dst,dstsize) = getDst1 ()
+              val (src,srcsize) = getSrc1 ()
+              val _ 
+                = Assert.assert
+                  ("x86MLton.prim: funa, dstsize/srcsize",
+                   fn () => srcsize = dstsize)
+            in
+              AppendList.fromList
+              [Block.mkBlock'
+               {entry = NONE,
+                statements 
+                = [Assembly.instruction_pfmov
+                   {dst = dst,
+                    src = src,
+                    size = srcsize},
+                   Assembly.instruction_pfuna
+                   {oper = oper,
+                    dst = dst,
+                    size = dstsize}],
+                transfer = NONE}]
+            end
 
-	fun flogarithm oper
-	  = let
-	      val (dst,dstsize) = getDst1 ()
-	      val (src,srcsize) = getSrc1 ()
-	      val _ 
-		= Assert.assert
-		  ("applyPrim: logarithm, dstsize/srcsize",
-		   fn () => srcsize = dstsize)
-	    in	
-	      AppendList.fromList
-	      [Block.mkBlock'
-	       {entry = NONE,
-		statements 
-		= [Assembly.instruction_pfldc
-		   {oper = oper,
-		    dst = dst,
-		    size = dstsize},
-		   Assembly.instruction_pfbinasp
-		   {oper = Instruction.FYL2X,
-		    src = src,
-		    dst = dst,
-		    size = dstsize}],
-		transfer = NONE}]
-	    end
+        fun flogarithm oper
+          = let
+              val (dst,dstsize) = getDst1 ()
+              val (src,srcsize) = getSrc1 ()
+              val _ 
+                = Assert.assert
+                  ("x86MLton.prim: flogarithm, dstsize/srcsize",
+                   fn () => srcsize = dstsize)
+            in  
+              AppendList.fromList
+              [Block.mkBlock'
+               {entry = NONE,
+                statements 
+                = [Assembly.instruction_pfldc
+                   {oper = oper,
+                    dst = dst,
+                    size = dstsize},
+                   Assembly.instruction_pfbinasp
+                   {oper = Instruction.FYL2X,
+                    src = src,
+                    dst = dst,
+                    size = dstsize}],
+                transfer = NONE}]
+            end
 
-	val (comment_begin,
-	     comment_end)
-	  = if !Control.Native.commented > 0
-	      then let
-		     val comment = primName
-		   in 
-		     (AppendList.single
-		      (x86.Block.mkBlock'
-		       {entry = NONE,
-			statements 
-			= [x86.Assembly.comment 
-			   ("begin prim: " ^ comment)],
-			transfer = NONE}),
-		      AppendList.single
-		      (x86.Block.mkBlock'
-		       {entry = NONE,
-			statements 
-			= [x86.Assembly.comment 
-			   ("end prim: " ^ comment)],
-			transfer = NONE}))
-		   end
-	      else (AppendList.empty,AppendList.empty)
-	fun bitop (size, i) =
-	   case WordSize.prim size of
-	      W8 => binal i
-	    | W16 => binal i
-	    | W32 => binal i
-	    | W64 => binal64 (i, i)
-	fun compare (size, {signed}, s, u) =
-	   let
-	      val f = if signed then s else u
-	   in
-	      case WordSize.prim size of
-		 W8 => cmp f
-	       | W16 => cmp f
-	       | W32 => cmp f
-	       | W64 => Error.bug "FIXME"
-	   end
-	fun shift (size, i) =
-	   case WordSize.prim size of
-	      W8 => sral i
-	    | W16 => sral i
-	    | W32 => sral i
-	    | W64 => Error.bug "FIXME"
+        val (comment_begin,
+             comment_end)
+          = if !Control.Native.commented > 0
+              then let
+                     val comment = primName
+                   in 
+                     (AppendList.single
+                      (x86.Block.mkBlock'
+                       {entry = NONE,
+                        statements 
+                        = [x86.Assembly.comment 
+                           ("begin prim: " ^ comment)],
+                        transfer = NONE}),
+                      AppendList.single
+                      (x86.Block.mkBlock'
+                       {entry = NONE,
+                        statements 
+                        = [x86.Assembly.comment 
+                           ("end prim: " ^ comment)],
+                        transfer = NONE}))
+                   end
+              else (AppendList.empty,AppendList.empty)
+        fun bitop (size, i) =
+           case WordSize.prim size of
+              W8 => binal i
+            | W16 => binal i
+            | W32 => binal i
+            | W64 => binal64 (i, i)
+        fun compare (size, {signed}, s, u) =
+           let
+              val f = if signed then s else u
+           in
+              case WordSize.prim size of
+                 W8 => cmp f
+               | W16 => cmp f
+               | W32 => cmp f
+               | W64 => Error.bug "x86MLton.prim: compare, W64"
+           end
+        fun shift (size, i) =
+           case WordSize.prim size of
+              W8 => sral i
+            | W16 => sral i
+            | W32 => sral i
+            | W64 => Error.bug "x86MLton.prim: shift, W64"
       in
-	AppendList.appends
-	[comment_begin,
-	 (case Prim.name prim of
-	     FFI_Symbol {name, ...}
-	     => let	
-		   val (dst,dstsize) = getDst1 ()
-		in
-		   AppendList.fromList
-		   [Block.mkBlock'
-		    {entry = NONE,
-		     statements =
-		     [Assembly.instruction_mov
-		      {dst = dst,
-		       src = Operand.immediate_label (Label.fromString name),
-		       size = dstsize}],
-		     transfer = NONE}]
-		end
-	     | Real_Math_acos _
-	     => let
-		  val (dst,dstsize) = getDst1 ()
-		  val (src,srcsize) = getSrc1 ()
-		  val _
-		    = Assert.assert
-		      ("applyPrim: Real_Math_acos, dstsize/srcsize",
-		       fn () => srcsize = dstsize)
-		  val realTemp1ContentsOperand = realTemp1ContentsOperand srcsize
-		  val realTemp2ContentsOperand = realTemp2ContentsOperand srcsize
-		  val realTemp3ContentsOperand = realTemp3ContentsOperand srcsize
-		in
-		  AppendList.fromList
-		  [Block.mkBlock'
-		   {entry = NONE,
-		    statements
-		    = [Assembly.instruction_pfmov
-		       {dst = realTemp1ContentsOperand,
-			src = src,
-			size = srcsize},
-		       Assembly.instruction_pfmov
-		       {dst = realTemp2ContentsOperand,
-			src = realTemp1ContentsOperand,
-			size = srcsize},
-		       Assembly.instruction_pfbina
-		       {oper = Instruction.FMUL,
-			dst = realTemp2ContentsOperand,
-			src = realTemp2ContentsOperand,
-			size = srcsize},
-		       Assembly.instruction_pfldc
-		       {oper = Instruction.ONE,
-			dst = realTemp3ContentsOperand,
-			size = srcsize},
-		       Assembly.instruction_pfbina
-		       {oper = Instruction.FSUB,
-			dst = realTemp3ContentsOperand,
-			src = realTemp2ContentsOperand,
-			size = srcsize},
-		       Assembly.instruction_pfuna
-		       {oper = Instruction.FSQRT,
-			dst = realTemp3ContentsOperand,
-			size = srcsize},
-		       Assembly.instruction_pfmov
-		       {dst = dst,
-			src = realTemp3ContentsOperand,
-			size = dstsize},
-		       Assembly.instruction_pfbinasp
-		       {oper = Instruction.FPATAN,
-			src = realTemp1ContentsOperand,
-			dst = dst,
-			size = dstsize}],
-		    transfer = NONE}]
-		end
-	     | Real_Math_asin _
-	     => let
-		  val (dst,dstsize) = getDst1 ()
-		  val (src,srcsize) = getSrc1 ()
-		  val _
-		    = Assert.assert
-		      ("applyPrim: Real_Math_asin, dstsize/srcsize",
-		       fn () => srcsize = dstsize)
-		  val realTemp1ContentsOperand = realTemp1ContentsOperand srcsize
-		  val realTemp2ContentsOperand = realTemp2ContentsOperand srcsize
-		in
-		  AppendList.fromList
-		  [Block.mkBlock'
-		   {entry = NONE,
-		    statements
-		    = [Assembly.instruction_pfmov
-		       {dst = dst,
-			src = src,
-			size = srcsize},
-		       Assembly.instruction_pfmov
-		       {dst = realTemp1ContentsOperand,
-			src = dst,
-			size = dstsize},
-		       Assembly.instruction_pfbina
-		       {oper = Instruction.FMUL,
-			dst = realTemp1ContentsOperand,
-			src = realTemp1ContentsOperand,
-			size = dstsize},
-		       Assembly.instruction_pfldc
-		       {oper = Instruction.ONE,
-			dst = realTemp2ContentsOperand,
-			size = dstsize},
-		       Assembly.instruction_pfbina
-		       {oper = Instruction.FSUB,
-			dst = realTemp2ContentsOperand,
-			src = realTemp1ContentsOperand,
-			size = dstsize},
-		       Assembly.instruction_pfuna
-		       {oper = Instruction.FSQRT,
-			dst = realTemp2ContentsOperand,
-			size = dstsize},
-		       Assembly.instruction_pfbinasp
-		       {oper = Instruction.FPATAN,
-			src = realTemp2ContentsOperand,
-			dst = dst,
-			size = dstsize}],
-		    transfer = NONE}]
-		end
-	     | Real_Math_atan _
-	     => let
-		  val (dst,dstsize) = getDst1 ()
-		  val (src,srcsize) = getSrc1 ()
-		  val _
-		    = Assert.assert
-		      ("applyPrim: Real_Math_atan, dstsize/srcsize",
-		       fn () => srcsize = dstsize)
-		  val realTemp1ContentsOperand = realTemp1ContentsOperand srcsize
-		in
-		  AppendList.fromList
-		  [Block.mkBlock'
-		   {entry = NONE,
-		    statements 
-		    = [Assembly.instruction_pfmov
-		       {dst = dst,
-			src = src,
-			size = srcsize},
-		       Assembly.instruction_pfldc
-		       {oper = Instruction.ONE,
-			dst = realTemp1ContentsOperand,
-			size = dstsize},
-		       Assembly.instruction_pfbinasp
-		       {oper = Instruction.FPATAN,
-			src = realTemp1ContentsOperand,
-			dst = dst,
-			size = dstsize}],
-		    transfer = NONE}]
-		end
-	     | Real_Math_atan2 _
-	     => let
-		  val (dst,dstsize) = getDst1 ()
-		  val ((src1,src1size),
-		       (src2,src2size))= getSrc2 ()
-		  val _
-		    = Assert.assert
-		      ("applyPrim: Real_Math_atan2, dstsize/src1size/src2size",
-		       fn () => src1size = dstsize andalso
-		                src2size = dstsize)
-		in
-		  AppendList.fromList
-		  [Block.mkBlock'
-		   {entry = NONE,
-		    statements 
-		    = [Assembly.instruction_pfmov
-		       {dst = dst,
-			src = src1,
-			size = src1size},
-		       Assembly.instruction_pfbinasp
-		       {oper = Instruction.FPATAN,
-			src = src2,
-			dst = dst,
-			size = dstsize}],
-		    transfer = NONE}]
-		end
-	     | Real_Math_cos _ => funa Instruction.FCOS
-	     | Real_Math_exp _
-	     => let
-		  val (dst,dstsize) = getDst1 ()
-		  val (src,srcsize) = getSrc1 ()
-		  val _
-		    = Assert.assert
-		      ("applyPrim: Real_Math_exp, dstsize/srcsize",
-		       fn () => srcsize = dstsize)
-		  val realTemp1ContentsOperand = realTemp1ContentsOperand srcsize
-		  val realTemp2ContentsOperand = realTemp2ContentsOperand srcsize
-		in
-		  AppendList.fromList
-		  [Block.mkBlock'
-		   {entry = NONE,
-		    statements 
-		    = [Assembly.instruction_pfldc
-		       {oper = Instruction.L2E,
-			dst = dst,
-			size = dstsize},
-		       Assembly.instruction_pfbina
-		       {oper = Instruction.FMUL,
-			src = src,
-			dst = dst,
-			size = dstsize},
-		       Assembly.instruction_pfmov
-		       {src = dst,
-			dst = realTemp1ContentsOperand,
-			size = dstsize},
-		       Assembly.instruction_pfuna
-		       {oper = Instruction.FRNDINT,
-			dst = realTemp1ContentsOperand,
-			size = dstsize},
-		       Assembly.instruction_pfbina
-		       {oper = Instruction.FSUB,
-			src = realTemp1ContentsOperand,
-			dst = dst,
-			size = dstsize},
-		       Assembly.instruction_pfuna
-		       {oper = Instruction.F2XM1,
-			dst = dst,
-			size = dstsize},
-		       Assembly.instruction_pfldc
-		       {oper = Instruction.ONE,
-			dst = realTemp2ContentsOperand,
-			size = dstsize},
-		       Assembly.instruction_pfbina
-		       {oper = Instruction.FADD,
-			src = realTemp2ContentsOperand,
-			dst = dst,
-			size = dstsize},
-		       Assembly.instruction_pfbinas
-		       {oper = Instruction.FSCALE,
-			src = realTemp1ContentsOperand,
-			dst = dst,
-			size = dstsize}],
-		    transfer = NONE}]
-		end
- 	     | Real_Math_ln _ => flogarithm Instruction.LN2
-	     | Real_Math_log10 _ => flogarithm Instruction.LG2
-	     | Real_Math_sin _ => funa Instruction.FSIN
-	     | Real_Math_sqrt _ => funa Instruction.FSQRT
-	     | Real_Math_tan _
-	     => let
-		  val (dst,dstsize) = getDst1 ()
-		  val (src,srcsize) = getSrc1 ()
-		  val _
-		    = Assert.assert
-		      ("applyPrim: Real_Math_tan, dstsize/srcsize",
-		       fn () => srcsize = dstsize)
-		in
-		  AppendList.fromList
-		  [Block.mkBlock'
-		   {entry = NONE,
-		    statements 
-		    = [Assembly.instruction_pfmov
-		       {src = src,
-			dst = dst,
-			size = dstsize},
-		       Assembly.instruction_pfptan
-		       {dst = dst,
-			size = dstsize}],
-		    transfer = NONE}]
-		end
-	     | Real_mul _ => fbina Instruction.FMUL
-	     | Real_muladd _ => fbina_fmul Instruction.FADD
-	     | Real_mulsub _ => fbina_fmul Instruction.FSUB
-	     | Real_add _ => fbina Instruction.FADD
-	     | Real_sub _ => fbina Instruction.FSUB
-	     | Real_div _ => fbina Instruction.FDIV
-	     | Real_lt _
-	     => let
-		  val (dst,dstsize) = getDst1 ()
-		  val ((src1,src1size),
-		       (src2,src2size))= getSrc2 ()
-		  val _
-		    = Assert.assert
-		      ("applyPrim: Real_lt, src1size/src2size",
-		       fn () => src1size = src2size)
-		in
-		  AppendList.fromList
-		  [Block.mkBlock'
-		   {entry = NONE,
-		    statements
-		    = [Assembly.instruction_pfcom
-		       {src1 = src2,
-			src2 = src1,
-			size = src1size},
-		       Assembly.instruction_fstsw
-		       {dst = fpswTempContentsOperand,
-			check = false},
-		       Assembly.instruction_test
-		       {src1 = fpswTempContentsOperand,
-			src2 = Operand.immediate_const_word 0wx4500,
-			size = Size.WORD},
-		       Assembly.instruction_setcc
-		       {condition = Instruction.Z,
-			dst = dst,
-			size = dstsize}],
-		    transfer = NONE}]
-		end
-	     | Real_le _
-	     => let
-		  val (dst,dstsize) = getDst1 ()
-		  val ((src1,src1size),
-		       (src2,src2size))= getSrc2 ()
-		  val _
-		    = Assert.assert
-		      ("applyPrim: Real_le, src1size/src2size",
-		       fn () => src1size = src2size)
-		in
-		  AppendList.fromList
-		  [Block.mkBlock'
-		   {entry = NONE,
-		    statements
-		    = [Assembly.instruction_pfcom
-		       {src1 = src2,
-			src2 = src1,
-			size = src1size},
-		       Assembly.instruction_fstsw
-		       {dst = fpswTempContentsOperand,
-			check = false},
-		       Assembly.instruction_test
-		       {src1 = fpswTempContentsOperand,
-			src2 = Operand.immediate_const_word 0wx500,
-			size = Size.WORD},
-		       Assembly.instruction_setcc
-		       {condition = Instruction.Z,
-			dst = dst,
-			size = dstsize}],
-		    transfer = NONE}]
-		end
-	     | Real_equal _
-	     => let
-		  val (dst,dstsize) = getDst1 ()
-		  val ((src1,src1size),
-		       (src2,src2size))= getSrc2 ()
-		  val _
-		    = Assert.assert
-		      ("applyPrim: Real_equal, src1size/src2size",
-		       fn () => src1size = src2size)
-		in
-		  AppendList.fromList
-		  [Block.mkBlock'
-		   {entry = NONE,
-		    statements
-		    = [Assembly.instruction_pfucom
-		       {src1 = src2,
-			src2 = src1,
-			size = src1size},
-		       Assembly.instruction_fstsw
-		       {dst = fpswTempContentsOperand,
-			check = false},
-		       Assembly.instruction_binal
-		       {oper = Instruction.AND,
-			dst = fpswTempContentsOperand,
-			src = Operand.immediate_const_word 0wx4500,
-			size = Size.WORD},
-		       Assembly.instruction_cmp
-		       {src1 = fpswTempContentsOperand,
-			src2 = Operand.immediate_const_word 0wx4000,
-			size = Size.WORD},
-		       Assembly.instruction_setcc
-		       {condition = Instruction.E,
-			dst = dst,
-			size = dstsize}],
-		    transfer = NONE}]
-		end
-	     | Real_qequal _
-	     => let
-		  val (dst,dstsize) = getDst1 ()
-		  val ((src1,src1size),
-		       (src2,src2size))= getSrc2 ()
-		  val _
-		    = Assert.assert
-		      ("applyPrim: Real_qequal, src1size/src2size",
-		       fn () => src1size = src2size)
-		in
-		  AppendList.fromList
-		  [Block.mkBlock'
-		   {entry = NONE,
-		    statements
-		    = [Assembly.instruction_pfucom
-		       {src1 = src2,
-			src2 = src1,
-			size = src1size},
-		       Assembly.instruction_fstsw
-		       {dst = fpswTempContentsOperand,
-			check = false},
-		       Assembly.instruction_test
-		       {src1 = fpswTempContentsOperand,
-			src2 = Operand.immediate_const_word 0wx4400,
-			size = Size.WORD},
-		       Assembly.instruction_setcc
-		       {condition = Instruction.NE,
-			dst = dst,
-			size = dstsize}],
-		    transfer = NONE}]
-		end
-	     | Real_abs _ => funa Instruction.FABS
+        AppendList.appends
+        [comment_begin,
+         (case Prim.name prim of
+             FFI_Symbol {name, ...}
+             => let     
+                   val (dst,dstsize) = getDst1 ()
+                in
+                   AppendList.fromList
+                   [Block.mkBlock'
+                    {entry = NONE,
+                     statements =
+                     [Assembly.instruction_mov
+                      {dst = dst,
+                       src = Operand.immediate_label (Label.fromString name),
+                       size = dstsize}],
+                     transfer = NONE}]
+                end
+             | Real_Math_acos _
+             => let
+                  val (dst,dstsize) = getDst1 ()
+                  val (src,srcsize) = getSrc1 ()
+                  val _
+                    = Assert.assert
+                      ("x86MLton.prim: Real_Math_acos, dstsize/srcsize",
+                       fn () => srcsize = dstsize)
+                  val realTemp1ContentsOperand = realTemp1ContentsOperand srcsize
+                  val realTemp2ContentsOperand = realTemp2ContentsOperand srcsize
+                  val realTemp3ContentsOperand = realTemp3ContentsOperand srcsize
+                in
+                  AppendList.fromList
+                  [Block.mkBlock'
+                   {entry = NONE,
+                    statements
+                    = [Assembly.instruction_pfmov
+                       {dst = realTemp1ContentsOperand,
+                        src = src,
+                        size = srcsize},
+                       Assembly.instruction_pfmov
+                       {dst = realTemp2ContentsOperand,
+                        src = realTemp1ContentsOperand,
+                        size = srcsize},
+                       Assembly.instruction_pfbina
+                       {oper = Instruction.FMUL,
+                        dst = realTemp2ContentsOperand,
+                        src = realTemp2ContentsOperand,
+                        size = srcsize},
+                       Assembly.instruction_pfldc
+                       {oper = Instruction.ONE,
+                        dst = realTemp3ContentsOperand,
+                        size = srcsize},
+                       Assembly.instruction_pfbina
+                       {oper = Instruction.FSUB,
+                        dst = realTemp3ContentsOperand,
+                        src = realTemp2ContentsOperand,
+                        size = srcsize},
+                       Assembly.instruction_pfuna
+                       {oper = Instruction.FSQRT,
+                        dst = realTemp3ContentsOperand,
+                        size = srcsize},
+                       Assembly.instruction_pfmov
+                       {dst = dst,
+                        src = realTemp3ContentsOperand,
+                        size = dstsize},
+                       Assembly.instruction_pfbinasp
+                       {oper = Instruction.FPATAN,
+                        src = realTemp1ContentsOperand,
+                        dst = dst,
+                        size = dstsize}],
+                    transfer = NONE}]
+                end
+             | Real_Math_asin _
+             => let
+                  val (dst,dstsize) = getDst1 ()
+                  val (src,srcsize) = getSrc1 ()
+                  val _
+                    = Assert.assert
+                      ("x86MLton.prim: Real_Math_asin, dstsize/srcsize",
+                       fn () => srcsize = dstsize)
+                  val realTemp1ContentsOperand = realTemp1ContentsOperand srcsize
+                  val realTemp2ContentsOperand = realTemp2ContentsOperand srcsize
+                in
+                  AppendList.fromList
+                  [Block.mkBlock'
+                   {entry = NONE,
+                    statements
+                    = [Assembly.instruction_pfmov
+                       {dst = dst,
+                        src = src,
+                        size = srcsize},
+                       Assembly.instruction_pfmov
+                       {dst = realTemp1ContentsOperand,
+                        src = dst,
+                        size = dstsize},
+                       Assembly.instruction_pfbina
+                       {oper = Instruction.FMUL,
+                        dst = realTemp1ContentsOperand,
+                        src = realTemp1ContentsOperand,
+                        size = dstsize},
+                       Assembly.instruction_pfldc
+                       {oper = Instruction.ONE,
+                        dst = realTemp2ContentsOperand,
+                        size = dstsize},
+                       Assembly.instruction_pfbina
+                       {oper = Instruction.FSUB,
+                        dst = realTemp2ContentsOperand,
+                        src = realTemp1ContentsOperand,
+                        size = dstsize},
+                       Assembly.instruction_pfuna
+                       {oper = Instruction.FSQRT,
+                        dst = realTemp2ContentsOperand,
+                        size = dstsize},
+                       Assembly.instruction_pfbinasp
+                       {oper = Instruction.FPATAN,
+                        src = realTemp2ContentsOperand,
+                        dst = dst,
+                        size = dstsize}],
+                    transfer = NONE}]
+                end
+             | Real_Math_atan _
+             => let
+                  val (dst,dstsize) = getDst1 ()
+                  val (src,srcsize) = getSrc1 ()
+                  val _
+                    = Assert.assert
+                      ("x86MLton.prim: Real_Math_atan, dstsize/srcsize",
+                       fn () => srcsize = dstsize)
+                  val realTemp1ContentsOperand = realTemp1ContentsOperand srcsize
+                in
+                  AppendList.fromList
+                  [Block.mkBlock'
+                   {entry = NONE,
+                    statements 
+                    = [Assembly.instruction_pfmov
+                       {dst = dst,
+                        src = src,
+                        size = srcsize},
+                       Assembly.instruction_pfldc
+                       {oper = Instruction.ONE,
+                        dst = realTemp1ContentsOperand,
+                        size = dstsize},
+                       Assembly.instruction_pfbinasp
+                       {oper = Instruction.FPATAN,
+                        src = realTemp1ContentsOperand,
+                        dst = dst,
+                        size = dstsize}],
+                    transfer = NONE}]
+                end
+             | Real_Math_atan2 _
+             => let
+                  val (dst,dstsize) = getDst1 ()
+                  val ((src1,src1size),
+                       (src2,src2size))= getSrc2 ()
+                  val _
+                    = Assert.assert
+                      ("x86MLton.prim: Real_Math_atan2, dstsize/src1size/src2size",
+                       fn () => src1size = dstsize andalso
+                                src2size = dstsize)
+                in
+                  AppendList.fromList
+                  [Block.mkBlock'
+                   {entry = NONE,
+                    statements 
+                    = [Assembly.instruction_pfmov
+                       {dst = dst,
+                        src = src1,
+                        size = src1size},
+                       Assembly.instruction_pfbinasp
+                       {oper = Instruction.FPATAN,
+                        src = src2,
+                        dst = dst,
+                        size = dstsize}],
+                    transfer = NONE}]
+                end
+             | Real_Math_cos _ => funa Instruction.FCOS
+             | Real_Math_exp _
+             => let
+                  val (dst,dstsize) = getDst1 ()
+                  val (src,srcsize) = getSrc1 ()
+                  val _
+                    = Assert.assert
+                      ("x86MLton.prim: Real_Math_exp, dstsize/srcsize",
+                       fn () => srcsize = dstsize)
+                  val realTemp1ContentsOperand = realTemp1ContentsOperand srcsize
+                  val realTemp2ContentsOperand = realTemp2ContentsOperand srcsize
+                in
+                  AppendList.fromList
+                  [Block.mkBlock'
+                   {entry = NONE,
+                    statements 
+                    = [Assembly.instruction_pfldc
+                       {oper = Instruction.L2E,
+                        dst = dst,
+                        size = dstsize},
+                       Assembly.instruction_pfbina
+                       {oper = Instruction.FMUL,
+                        src = src,
+                        dst = dst,
+                        size = dstsize},
+                       Assembly.instruction_pfmov
+                       {src = dst,
+                        dst = realTemp1ContentsOperand,
+                        size = dstsize},
+                       Assembly.instruction_pfuna
+                       {oper = Instruction.FRNDINT,
+                        dst = realTemp1ContentsOperand,
+                        size = dstsize},
+                       Assembly.instruction_pfbina
+                       {oper = Instruction.FSUB,
+                        src = realTemp1ContentsOperand,
+                        dst = dst,
+                        size = dstsize},
+                       Assembly.instruction_pfuna
+                       {oper = Instruction.F2XM1,
+                        dst = dst,
+                        size = dstsize},
+                       Assembly.instruction_pfldc
+                       {oper = Instruction.ONE,
+                        dst = realTemp2ContentsOperand,
+                        size = dstsize},
+                       Assembly.instruction_pfbina
+                       {oper = Instruction.FADD,
+                        src = realTemp2ContentsOperand,
+                        dst = dst,
+                        size = dstsize},
+                       Assembly.instruction_pfbinas
+                       {oper = Instruction.FSCALE,
+                        src = realTemp1ContentsOperand,
+                        dst = dst,
+                        size = dstsize}],
+                    transfer = NONE}]
+                end
+             | Real_Math_ln _ => flogarithm Instruction.LN2
+             | Real_Math_log10 _ => flogarithm Instruction.LG2
+             | Real_Math_sin _ => funa Instruction.FSIN
+             | Real_Math_sqrt _ => funa Instruction.FSQRT
+             | Real_Math_tan _
+             => let
+                  val (dst,dstsize) = getDst1 ()
+                  val (src,srcsize) = getSrc1 ()
+                  val _
+                    = Assert.assert
+                      ("x86MLton.prim: Real_Math_tan, dstsize/srcsize",
+                       fn () => srcsize = dstsize)
+                in
+                  AppendList.fromList
+                  [Block.mkBlock'
+                   {entry = NONE,
+                    statements 
+                    = [Assembly.instruction_pfmov
+                       {src = src,
+                        dst = dst,
+                        size = dstsize},
+                       Assembly.instruction_pfptan
+                       {dst = dst,
+                        size = dstsize}],
+                    transfer = NONE}]
+                end
+             | Real_mul _ => fbina Instruction.FMUL
+             | Real_muladd _ => fbina_fmul Instruction.FADD
+             | Real_mulsub _ => fbina_fmul Instruction.FSUB
+             | Real_add _ => fbina Instruction.FADD
+             | Real_sub _ => fbina Instruction.FSUB
+             | Real_div _ => fbina Instruction.FDIV
+             | Real_lt _
+             => let
+                  val (dst,dstsize) = getDst1 ()
+                  val ((src1,src1size),
+                       (src2,src2size))= getSrc2 ()
+                  val _
+                    = Assert.assert
+                      ("x86MLton.prim: Real_lt, src1size/src2size",
+                       fn () => src1size = src2size)
+                in
+                  AppendList.fromList
+                  [Block.mkBlock'
+                   {entry = NONE,
+                    statements
+                    = [Assembly.instruction_pfcom
+                       {src1 = src2,
+                        src2 = src1,
+                        size = src1size},
+                       Assembly.instruction_fstsw
+                       {dst = fpswTempContentsOperand,
+                        check = false},
+                       Assembly.instruction_test
+                       {src1 = fpswTempContentsOperand,
+                        src2 = Operand.immediate_const_word 0wx4500,
+                        size = Size.WORD},
+                       Assembly.instruction_setcc
+                       {condition = Instruction.Z,
+                        dst = dst,
+                        size = dstsize}],
+                    transfer = NONE}]
+                end
+             | Real_le _
+             => let
+                  val (dst,dstsize) = getDst1 ()
+                  val ((src1,src1size),
+                       (src2,src2size))= getSrc2 ()
+                  val _
+                    = Assert.assert
+                      ("x86MLton.prim: Real_le, src1size/src2size",
+                       fn () => src1size = src2size)
+                in
+                  AppendList.fromList
+                  [Block.mkBlock'
+                   {entry = NONE,
+                    statements
+                    = [Assembly.instruction_pfcom
+                       {src1 = src2,
+                        src2 = src1,
+                        size = src1size},
+                       Assembly.instruction_fstsw
+                       {dst = fpswTempContentsOperand,
+                        check = false},
+                       Assembly.instruction_test
+                       {src1 = fpswTempContentsOperand,
+                        src2 = Operand.immediate_const_word 0wx500,
+                        size = Size.WORD},
+                       Assembly.instruction_setcc
+                       {condition = Instruction.Z,
+                        dst = dst,
+                        size = dstsize}],
+                    transfer = NONE}]
+                end
+             | Real_equal _
+             => let
+                  val (dst,dstsize) = getDst1 ()
+                  val ((src1,src1size),
+                       (src2,src2size))= getSrc2 ()
+                  val _
+                    = Assert.assert
+                      ("x86MLton.prim: Real_equal, src1size/src2size",
+                       fn () => src1size = src2size)
+                in
+                  AppendList.fromList
+                  [Block.mkBlock'
+                   {entry = NONE,
+                    statements
+                    = [Assembly.instruction_pfucom
+                       {src1 = src2,
+                        src2 = src1,
+                        size = src1size},
+                       Assembly.instruction_fstsw
+                       {dst = fpswTempContentsOperand,
+                        check = false},
+                       Assembly.instruction_binal
+                       {oper = Instruction.AND,
+                        dst = fpswTempContentsOperand,
+                        src = Operand.immediate_const_word 0wx4500,
+                        size = Size.WORD},
+                       Assembly.instruction_cmp
+                       {src1 = fpswTempContentsOperand,
+                        src2 = Operand.immediate_const_word 0wx4000,
+                        size = Size.WORD},
+                       Assembly.instruction_setcc
+                       {condition = Instruction.E,
+                        dst = dst,
+                        size = dstsize}],
+                    transfer = NONE}]
+                end
+             | Real_qequal _
+             => let
+                  val (dst,dstsize) = getDst1 ()
+                  val ((src1,src1size),
+                       (src2,src2size))= getSrc2 ()
+                  val _
+                    = Assert.assert
+                      ("x86MLton.prim: Real_qequal, src1size/src2size",
+                       fn () => src1size = src2size)
+                in
+                  AppendList.fromList
+                  [Block.mkBlock'
+                   {entry = NONE,
+                    statements
+                    = [Assembly.instruction_pfucom
+                       {src1 = src2,
+                        src2 = src1,
+                        size = src1size},
+                       Assembly.instruction_fstsw
+                       {dst = fpswTempContentsOperand,
+                        check = false},
+                       Assembly.instruction_test
+                       {src1 = fpswTempContentsOperand,
+                        src2 = Operand.immediate_const_word 0wx4400,
+                        size = Size.WORD},
+                       Assembly.instruction_setcc
+                       {condition = Instruction.NE,
+                        dst = dst,
+                        size = dstsize}],
+                    transfer = NONE}]
+                end
+             | Real_abs _ => funa Instruction.FABS
              | Real_toReal (s, s')
-	     => let
-		  val (dst,dstsize) = getDst1 ()
-		  val (src,srcsize) = getSrc1 ()
-		  fun mov () =
-		     AppendList.fromList
-		     [Block.mkBlock'
-		      {entry = NONE,
-		       statements 
-		       = [Assembly.instruction_pfmov
-			  {dst = dst,
-			   src = src,
-			   size = srcsize}],
-		       transfer = NONE}]
-		  fun movx () =
-		     AppendList.fromList
-		     [Block.mkBlock'
-		      {entry = NONE,
-		       statements 
-		       = [Assembly.instruction_pfmovx
-			  {dst = dst,
-			   src = src,
-			   srcsize = srcsize,
-			   dstsize = dstsize}],
-		       transfer = NONE}]
-		  fun xvom () =
-		     AppendList.fromList
-		     [Block.mkBlock'
-		      {entry = NONE,
-		       statements 
-		       = [Assembly.instruction_pfxvom
-			  {dst = dst,
-			   src = src,
-			   srcsize = srcsize,
-			   dstsize = dstsize}],
-		       transfer = NONE}]
-		in	
-		   case (s, s') of
-		      (R64, R64) => mov ()
-		    | (R64, R32) => xvom ()
-		    | (R32, R64) => movx ()
-		    | (R32, R32) => mov ()
-		end 
-	     | Real_toWord (s, s', _)
-	     => let
-		  fun default () =
-		    let
-		      val (dst,dstsize) = getDst1 ()
-		      val (src,srcsize) = getSrc1 ()
-		    in
-		      AppendList.fromList
-		      [Block.mkBlock'
-		       {entry = NONE,
-			statements 
-			= [Assembly.instruction_pfmovti
-			   {dst = dst,
-			    src = src,
-			    srcsize = srcsize,
-			    dstsize = dstsize}],
-			transfer = NONE}]
-		    end 
-		  fun default' () =
-		    let
-		      val (dst,dstsize) = getDst1 ()
-		      val (src,srcsize) = getSrc1 ()
-		      val (tmp,tmpsize) =
-			 (fildTempContentsOperand, Size.WORD)
-		    in
-		      AppendList.fromList
-		      [Block.mkBlock'
-		       {entry = NONE,
-			statements 
-			= [Assembly.instruction_pfmovti
-			   {dst = dst,
-			    src = src,
-			    srcsize = srcsize,
-			    dstsize = dstsize},
-			   Assembly.instruction_xvom
-			   {src = tmp,
-			    dst = dst,
-			    dstsize = dstsize,
-			    srcsize = tmpsize}],
-			transfer = NONE}]
-		    end 
-		in
-		   case (s, WordSize.prim s') of
-		      (R64, W64) => Error.bug "FIXME"
-		    | (R64, W32) => default ()
-		    | (R64, W16) => default ()
-		    | (R64, W8) => default' ()
-		    | (R32, W64) => Error.bug "FIXME"
-		    | (R32, W32) => default ()
-		    | (R32, W16) => default ()
-		    | (R32, W8) => default' ()
-		end
-	     | Real_ldexp _ 
-	     => let
-		  val (dst,dstsize) = getDst1 ()
-		  val ((src1,src1size),
-		       (src2,src2size)) = getSrc2 ()
-		  val _
-		    = Assert.assert
-		      ("applyPrim: Real_ldexp, dstsize/src1size",
-		       fn () => src1size = dstsize)
-		  val _
-		    = Assert.assert
-		      ("applyPrim: Real_qequal, src2size",
-		       fn () => src2size = Size.LONG)
-		  val realTemp1ContentsOperand = realTemp1ContentsOperand src1size
-		in
-		  AppendList.fromList
-		  [Block.mkBlock'
-		   {entry = NONE,
-		    statements 
-		    = [Assembly.instruction_pfmovfi
-		       {dst = realTemp1ContentsOperand,
-			src = src2,
-			srcsize = src2size,
-			dstsize = dstsize},
-		       Assembly.instruction_pfmov
-		       {dst = dst,
-			src = src1,
-			size = dstsize},
-		       Assembly.instruction_pfbinas
-		       {oper = Instruction.FSCALE,
-			dst = dst,
-			src = realTemp1ContentsOperand,
-			size = dstsize}],
-		    transfer = NONE}]
-		end
-	     | Real_neg _ => funa Instruction.FCHS
-	     | Real_round _ => funa Instruction.FRNDINT
-	     | Word_add s => 
-		(case WordSize.prim s of
-		    W8 => binal Instruction.ADD
-		  | W16 => binal Instruction.ADD
-		  | W32 => binal Instruction.ADD
-		  | W64 => binal64 (Instruction.ADD, Instruction.ADC))
-	     | Word_andb s => bitop (s, Instruction.AND)
-	     | Word_equal _ => cmp Instruction.E
-	     | Word_lshift s => shift (s, Instruction.SHL)
-	     | Word_lt (s, sg) => compare (s, sg, Instruction.L, Instruction.B)
-	     | Word_mul (s, {signed}) =>
-		(case WordSize.prim s of
-		    W8 => pmd (if signed
-				  then Instruction.IMUL
-			       else Instruction.MUL)
-		  | W16 => imul2 ()
-		  | W32 => imul2 ()
-		  | W64 => Error.bug "FIXME")
-	     | Word_neg s => 
-		(case WordSize.prim s of
-		    W8 => unal Instruction.NEG
-		  | W16 => unal Instruction.NEG
-		  | W32 => unal Instruction.NEG
-		  | W64 => unal64 (Instruction.NEG, 
-				   fn (dst,dstsize) => [Assembly.instruction_binal
-							{dst = dst,
-							 oper = Instruction.ADC,
-							 src = Operand.immediate_const_int 0,
-							 size = dstsize}]))
-	     | Word_notb s => 
-		(case WordSize.prim s of
-		    W8 => unal Instruction.NOT
-		  | W16 => unal Instruction.NOT
-		  | W32 => unal Instruction.NOT
-		  | W64 => unal64 (Instruction.NOT, fn _ => []))
-	     | Word_orb s => bitop (s, Instruction.OR)
-	     | Word_quot (_, {signed}) =>
-		  pmd (if signed then Instruction.IDIV else Instruction.DIV)
-	     | Word_rem (_, {signed}) =>
-		  pmd (if signed then Instruction.IMOD else Instruction.MOD)
-	     | Word_rol s => shift (s, Instruction.ROL)
-	     | Word_ror s => shift (s, Instruction.ROR)
-	     | Word_rshift (s, {signed}) =>
-		  shift (s, if signed then Instruction.SAR else Instruction.SHR)
-	     | Word_sub s => 
-		(case WordSize.prim s of
-		    W8 => binal Instruction.SUB
-		  | W16 => binal Instruction.SUB
-		  | W32 => binal Instruction.SUB
-		  | W64 => binal64 (Instruction.SUB, Instruction.SBB))
-	     | Word_toReal (s, s', _)
-	     => let
-		  fun default () =
-		    let
-		      val (dst,dstsize) = getDst1 ()
-		      val (src,srcsize) = getSrc1 ()
-		    in
-		      AppendList.fromList
-		      [Block.mkBlock'
-		       {entry = NONE,
-			statements 
-			= [Assembly.instruction_pfmovfi
-			   {src = src,
-			    dst = dst,
-			    srcsize = srcsize,
-			    dstsize = dstsize}],
-			transfer = NONE}]
-		    end 
-		  fun default' () =
-		    let
-		      val (dst,dstsize) = getDst1 ()
-		      val (src,srcsize) = getSrc1 ()
-		      val (tmp,tmpsize) =
-			 (fildTempContentsOperand, Size.WORD)
-		    in
-		      AppendList.fromList
-		      [Block.mkBlock'
-		       {entry = NONE,
-			statements 
-			= [Assembly.instruction_movx
-			   {oper = Instruction.MOVSX,
-			    src = src,
-			    dst = tmp,
-			    dstsize = tmpsize,
-			    srcsize = srcsize},
-			   Assembly.instruction_pfmovfi
-			   {src = tmp,
-			    dst = dst,
-			    srcsize = tmpsize,
-			    dstsize = dstsize}],
-			transfer = NONE}]
-		    end 
-		in
-		   case (WordSize.prim s, s') of
-		      (W32, R64) => default ()
-		    | (W32, R32) => default ()
-		    | (W16, R64) => default ()
-		    | (W16, R32) => default ()
-		    | (W8, R64) => default' ()
-		    | (W8, R32) => default' ()
-		    | _ => Error.bug "FIXME"
-		end
-	     | Word_toWord (s, s', {signed}) =>
-		  let
-		     val b = WordSize.bits s
-		     val b' = WordSize.bits s'
-		  in
-		     if Bits.< (b, b')
-			then movx (if signed
-				      then Instruction.MOVSX
-				   else Instruction.MOVZX)
-		     else if Bits.equals (b, b')
-			     then mov ()
-			  else xvom ()
-		  end
-	     | Word_xorb s => bitop (s, Instruction.XOR)
-	     | _ => Error.bug ("prim: strange Prim.Name.t: " ^ primName)),
-	 comment_end]
+             => let
+                  val (dst,dstsize) = getDst1 ()
+                  val (src,srcsize) = getSrc1 ()
+                  fun mov () =
+                     AppendList.fromList
+                     [Block.mkBlock'
+                      {entry = NONE,
+                       statements 
+                       = [Assembly.instruction_pfmov
+                          {dst = dst,
+                           src = src,
+                           size = srcsize}],
+                       transfer = NONE}]
+                  fun movx () =
+                     AppendList.fromList
+                     [Block.mkBlock'
+                      {entry = NONE,
+                       statements 
+                       = [Assembly.instruction_pfmovx
+                          {dst = dst,
+                           src = src,
+                           srcsize = srcsize,
+                           dstsize = dstsize}],
+                       transfer = NONE}]
+                  fun xvom () =
+                     AppendList.fromList
+                     [Block.mkBlock'
+                      {entry = NONE,
+                       statements 
+                       = [Assembly.instruction_pfxvom
+                          {dst = dst,
+                           src = src,
+                           srcsize = srcsize,
+                           dstsize = dstsize}],
+                       transfer = NONE}]
+                in      
+                   case (s, s') of
+                      (R64, R64) => mov ()
+                    | (R64, R32) => xvom ()
+                    | (R32, R64) => movx ()
+                    | (R32, R32) => mov ()
+                end 
+             | Real_toWord (s, s', _)
+             => let
+                  fun default () =
+                    let
+                      val (dst,dstsize) = getDst1 ()
+                      val (src,srcsize) = getSrc1 ()
+                    in
+                      AppendList.fromList
+                      [Block.mkBlock'
+                       {entry = NONE,
+                        statements 
+                        = [Assembly.instruction_pfmovti
+                           {dst = dst,
+                            src = src,
+                            srcsize = srcsize,
+                            dstsize = dstsize}],
+                        transfer = NONE}]
+                    end 
+                  fun default' () =
+                    let
+                      val (dst,dstsize) = getDst1 ()
+                      val (src,srcsize) = getSrc1 ()
+                      val (tmp,tmpsize) =
+                         (fildTempContentsOperand, Size.WORD)
+                    in
+                      AppendList.fromList
+                      [Block.mkBlock'
+                       {entry = NONE,
+                        statements 
+                        = [Assembly.instruction_pfmovti
+                           {dst = dst,
+                            src = src,
+                            srcsize = srcsize,
+                            dstsize = dstsize},
+                           Assembly.instruction_xvom
+                           {src = tmp,
+                            dst = dst,
+                            dstsize = dstsize,
+                            srcsize = tmpsize}],
+                        transfer = NONE}]
+                    end 
+                in
+                   case (s, WordSize.prim s') of
+                      (R64, W64) => Error.bug "x86MLton.prim: Real_toWord, W64"
+                    | (R64, W32) => default ()
+                    | (R64, W16) => default ()
+                    | (R64, W8) => default' ()
+                    | (R32, W64) => Error.bug "x86MLton.prim: Real_toWord, W64"
+                    | (R32, W32) => default ()
+                    | (R32, W16) => default ()
+                    | (R32, W8) => default' ()
+                end
+             | Real_ldexp _ 
+             => let
+                  val (dst,dstsize) = getDst1 ()
+                  val ((src1,src1size),
+                       (src2,src2size)) = getSrc2 ()
+                  val _
+                    = Assert.assert
+                      ("x86MLton.prim: Real_ldexp, dstsize/src1size",
+                       fn () => src1size = dstsize)
+                  val _
+                    = Assert.assert
+                      ("x86MLton.prim: Real_ldexp, src2size",
+                       fn () => src2size = Size.LONG)
+                  val realTemp1ContentsOperand = realTemp1ContentsOperand src1size
+                in
+                  AppendList.fromList
+                  [Block.mkBlock'
+                   {entry = NONE,
+                    statements 
+                    = [Assembly.instruction_pfmovfi
+                       {dst = realTemp1ContentsOperand,
+                        src = src2,
+                        srcsize = src2size,
+                        dstsize = dstsize},
+                       Assembly.instruction_pfmov
+                       {dst = dst,
+                        src = src1,
+                        size = dstsize},
+                       Assembly.instruction_pfbinas
+                       {oper = Instruction.FSCALE,
+                        dst = dst,
+                        src = realTemp1ContentsOperand,
+                        size = dstsize}],
+                    transfer = NONE}]
+                end
+             | Real_neg _ => funa Instruction.FCHS
+             | Real_round _ => funa Instruction.FRNDINT
+             | Word_add s => 
+                (case WordSize.prim s of
+                    W8 => binal Instruction.ADD
+                  | W16 => binal Instruction.ADD
+                  | W32 => binal Instruction.ADD
+                  | W64 => binal64 (Instruction.ADD, Instruction.ADC))
+             | Word_andb s => bitop (s, Instruction.AND)
+             | Word_equal _ => cmp Instruction.E
+             | Word_lshift s => shift (s, Instruction.SHL)
+             | Word_lt (s, sg) => compare (s, sg, Instruction.L, Instruction.B)
+             | Word_mul (s, {signed}) =>
+                (case WordSize.prim s of
+                    W8 => pmd (if signed
+                                  then Instruction.IMUL
+                               else Instruction.MUL)
+                  | W16 => imul2 ()
+                  | W32 => imul2 ()
+                  | W64 => Error.bug "x86MLton.prim: Word_mul, W64")
+             | Word_neg s => 
+                (case WordSize.prim s of
+                    W8 => unal Instruction.NEG
+                  | W16 => unal Instruction.NEG
+                  | W32 => unal Instruction.NEG
+                  | W64 => unal64 (Instruction.NEG, 
+                                   fn (dst,dstsize) => [Assembly.instruction_binal
+                                                        {dst = dst,
+                                                         oper = Instruction.ADC,
+                                                         src = Operand.immediate_const_int 0,
+                                                         size = dstsize}]))
+             | Word_notb s => 
+                (case WordSize.prim s of
+                    W8 => unal Instruction.NOT
+                  | W16 => unal Instruction.NOT
+                  | W32 => unal Instruction.NOT
+                  | W64 => unal64 (Instruction.NOT, fn _ => []))
+             | Word_orb s => bitop (s, Instruction.OR)
+             | Word_quot (_, {signed}) =>
+                  pmd (if signed then Instruction.IDIV else Instruction.DIV)
+             | Word_rem (_, {signed}) =>
+                  pmd (if signed then Instruction.IMOD else Instruction.MOD)
+             | Word_rol s => shift (s, Instruction.ROL)
+             | Word_ror s => shift (s, Instruction.ROR)
+             | Word_rshift (s, {signed}) =>
+                  shift (s, if signed then Instruction.SAR else Instruction.SHR)
+             | Word_sub s => 
+                (case WordSize.prim s of
+                    W8 => binal Instruction.SUB
+                  | W16 => binal Instruction.SUB
+                  | W32 => binal Instruction.SUB
+                  | W64 => binal64 (Instruction.SUB, Instruction.SBB))
+             | Word_toReal (s, s', _)
+             => let
+                  fun default () =
+                    let
+                      val (dst,dstsize) = getDst1 ()
+                      val (src,srcsize) = getSrc1 ()
+                    in
+                      AppendList.fromList
+                      [Block.mkBlock'
+                       {entry = NONE,
+                        statements 
+                        = [Assembly.instruction_pfmovfi
+                           {src = src,
+                            dst = dst,
+                            srcsize = srcsize,
+                            dstsize = dstsize}],
+                        transfer = NONE}]
+                    end 
+                  fun default' () =
+                    let
+                      val (dst,dstsize) = getDst1 ()
+                      val (src,srcsize) = getSrc1 ()
+                      val (tmp,tmpsize) =
+                         (fildTempContentsOperand, Size.WORD)
+                    in
+                      AppendList.fromList
+                      [Block.mkBlock'
+                       {entry = NONE,
+                        statements 
+                        = [Assembly.instruction_movx
+                           {oper = Instruction.MOVSX,
+                            src = src,
+                            dst = tmp,
+                            dstsize = tmpsize,
+                            srcsize = srcsize},
+                           Assembly.instruction_pfmovfi
+                           {src = tmp,
+                            dst = dst,
+                            srcsize = tmpsize,
+                            dstsize = dstsize}],
+                        transfer = NONE}]
+                    end 
+                in
+                   case (WordSize.prim s, s') of
+                      (W32, R64) => default ()
+                    | (W32, R32) => default ()
+                    | (W16, R64) => default ()
+                    | (W16, R32) => default ()
+                    | (W8, R64) => default' ()
+                    | (W8, R32) => default' ()
+                    | _ => Error.bug "x86MLton.prim: Word_toReal, W64"
+                end
+             | Word_toWord (s, s', {signed}) =>
+                  let
+                     val b = WordSize.bits s
+                     val b' = WordSize.bits s'
+                  in
+                     if Bits.< (b, b')
+                        then movx (if signed
+                                      then Instruction.MOVSX
+                                   else Instruction.MOVZX)
+                     else if Bits.equals (b, b')
+                             then mov ()
+                          else xvom ()
+                  end
+             | Word_xorb s => bitop (s, Instruction.XOR)
+             | _ => Error.bug ("x86MLton.prim: strange Prim.Name.t: " ^ primName)),
+         comment_end]
       end
 
   fun ccall {args: (x86.Operand.t * x86.Size.t) vector,
-	     frameInfo,
-	     func,
-	     return: x86.Label.t option,
-	     transInfo = {...}: transInfo}
+             frameInfo,
+             func,
+             return: x86.Label.t option,
+             transInfo = {...}: transInfo}
     = let
-	val CFunction.T {convention, target, ...} = func
-	val comment_begin
-	  = if !Control.Native.commented > 0
-	      then AppendList.single 
-		   (x86.Block.mkBlock'
-		    {entry = NONE,
-		     statements = 
-		     [x86.Assembly.comment
-		      (concat 
-		       ["begin ccall: ",
-			CFunction.Convention.toString convention,
-			" ",
-			CFunction.Target.toString target])],
-		     transfer = NONE})
-	    else AppendList.empty
+        val CFunction.T {convention, target, ...} = func
+        val comment_begin
+          = if !Control.Native.commented > 0
+              then AppendList.single 
+                   (x86.Block.mkBlock'
+                    {entry = NONE,
+                     statements = 
+                     [x86.Assembly.comment
+                      (concat 
+                       ["begin ccall: ",
+                        CFunction.Convention.toString convention,
+                        " ",
+                        CFunction.Target.toString target])],
+                     transfer = NONE})
+            else AppendList.empty
       in
-	AppendList.appends
-	[comment_begin,
-	 AppendList.single
-	 (Block.mkBlock'
-	  {entry = NONE,
-	   statements = [],
-	   transfer = SOME (Transfer.ccall 
-			    {args = Vector.toList args,
-			     frameInfo = frameInfo,
-			     func = func,
-			     return = return})})]
+        AppendList.appends
+        [comment_begin,
+         AppendList.single
+         (Block.mkBlock'
+          {entry = NONE,
+           statements = [],
+           transfer = SOME (Transfer.ccall 
+                            {args = Vector.toList args,
+                             frameInfo = frameInfo,
+                             func = func,
+                             return = return})})]
       end
 
   fun creturn {dsts: (x86.Operand.t * x86.Size.t) vector,
-	       frameInfo: x86.FrameInfo.t option,
-	       func: RepType.t CFunction.t,
-	       label: x86.Label.t, 
-	       transInfo = {live, liveInfo, ...}: transInfo}
+               frameInfo: x86.FrameInfo.t option,
+               func: RepType.t CFunction.t,
+               label: x86.Label.t, 
+               transInfo = {live, liveInfo, ...}: transInfo}
     = let
-	val CFunction.T {convention, target, ...} = func
-	fun default ()
-	  = let
-	      val _ = x86Liveness.LiveInfo.setLiveOperands
-		      (liveInfo, label, live label)
-	    in 
-	      AppendList.single
-	      (x86.Block.mkBlock'
-	       {entry = SOME (Entry.creturn {dsts = dsts,
-					     frameInfo = frameInfo,
-					     func = func,
-					     label = label}),
-		statements = [],
-		transfer = NONE})
-	    end
-	val comment_end
-	  = if !Control.Native.commented > 0
-	      then AppendList.single 
-		   (x86.Block.mkBlock'
-		    {entry = NONE,
-		     statements = 
-		     [x86.Assembly.comment
-		      (concat 
-		       ["begin creturn: ",
-			CFunction.Convention.toString convention,
-			" ",
-			CFunction.Target.toString target])],
-		     transfer = NONE})
-	      else AppendList.empty
+        val CFunction.T {convention, target, ...} = func
+        fun default ()
+          = let
+              val _ = x86Liveness.LiveInfo.setLiveOperands
+                      (liveInfo, label, live label)
+            in 
+              AppendList.single
+              (x86.Block.mkBlock'
+               {entry = SOME (Entry.creturn {dsts = dsts,
+                                             frameInfo = frameInfo,
+                                             func = func,
+                                             label = label}),
+                statements = [],
+                transfer = NONE})
+            end
+        val comment_end
+          = if !Control.Native.commented > 0
+              then AppendList.single 
+                   (x86.Block.mkBlock'
+                    {entry = NONE,
+                     statements = 
+                     [x86.Assembly.comment
+                      (concat 
+                       ["begin creturn: ",
+                        CFunction.Convention.toString convention,
+                        " ",
+                        CFunction.Target.toString target])],
+                     transfer = NONE})
+              else AppendList.empty
       in
-	AppendList.appends [default (), comment_end]
+        AppendList.appends [default (), comment_end]
       end
 
   fun arith {prim : RepType.t Prim.t,
-	     args : (Operand.t * Size.t) vector,
-	     dsts : (Operand.t * Size.t) vector,
-	     overflow : Label.t,
-	     success : Label.t,
-	     transInfo = {live, liveInfo, ...} : transInfo}
+             args : (Operand.t * Size.t) vector,
+             dsts : (Operand.t * Size.t) vector,
+             overflow : Label.t,
+             success : Label.t,
+             transInfo = {live, liveInfo, ...} : transInfo}
     = let
-	val primName = Prim.toString prim
-	datatype z = datatype Prim.Name.t
+        val primName = Prim.toString prim
+        datatype z = datatype Prim.Name.t
 
-	fun getDst1 ()
-	  = Vector.sub (dsts, 0)
-	    handle _ => Error.bug "arith: getDst1"
-	fun getDst2 ()
-	  = (Vector.sub (dsts, 0), Vector.sub (dsts, 1))
-	    handle _ => Error.bug "arith: getDst2"
-	fun getSrc1 ()
-	  = Vector.sub (args, 0)
-	    handle _ => Error.bug "arith: getSrc1"
-	fun getSrc2 ()
-	  = (Vector.sub (args, 0), Vector.sub (args, 1))
-	    handle _ => Error.bug "arith: getSrc2"
-	fun getSrc4 ()
-	  = (Vector.sub (args, 0), Vector.sub (args, 1), 
-	     Vector.sub (args, 2), Vector.sub (args, 3))
-	    handle _ => Error.bug "arith: getSrc4"
+        fun getDst1 ()
+          = Vector.sub (dsts, 0)
+            handle _ => Error.bug "x86MLton.arith: getDst1"
+        fun getDst2 ()
+          = (Vector.sub (dsts, 0), Vector.sub (dsts, 1))
+            handle _ => Error.bug "x86MLton.arith: getDst2"
+        fun getSrc1 ()
+          = Vector.sub (args, 0)
+            handle _ => Error.bug "x86MLton.arith: getSrc1"
+        fun getSrc2 ()
+          = (Vector.sub (args, 0), Vector.sub (args, 1))
+            handle _ => Error.bug "x86MLton.arith: getSrc2"
+        fun getSrc4 ()
+          = (Vector.sub (args, 0), Vector.sub (args, 1), 
+             Vector.sub (args, 2), Vector.sub (args, 3))
+            handle _ => Error.bug "x86MLton.arith: getSrc4"
 
-	fun check (statements, condition)
-	  = AppendList.single
-	    (x86.Block.mkBlock'
-	     {entry = NONE,	
-	      statements = statements,
-	      transfer = SOME (x86.Transfer.iff
-			       {condition = condition,
-				truee = overflow,
-				falsee = success})})
-	fun binal (oper: x86.Instruction.binal, condition)
-	  = let
-	      val (dst, dstsize) = getDst1 ()
-	      val ((src1, src1size), (src2, src2size)) = getSrc2 ()
-	      val _ = Assert.assert
-		      ("arith: binal, dstsize/src1size/src2size",
-		       fn () => src1size = dstsize andalso src2size = dstsize)
-	      (* Reverse src1/src2 when src1 and src2 are
-	       * temporaries and the oper is commutative. 
-	       *)
-	      val (src1,src2)
-		= if (oper = x86.Instruction.ADD)
-		    then case (x86.Operand.deMemloc src1,
-			       x86.Operand.deMemloc src2)
-			   of (SOME memloc_src1, SOME memloc_src2)
-			    => if x86Liveness.track memloc_src1
-			          andalso
-				  x86Liveness.track memloc_src2
-				 then (src2,src1)
-				 else (src1,src2)
-			    | _ => (src1,src2)
-		    else (src1,src2)
-	    in
-	      check ([Assembly.instruction_mov
-		      {dst = dst,
-		       src = src1,
-		       size = dstsize},
-		      Assembly.instruction_binal
-		      {oper = oper,
-		       dst = dst,
-		       src = src2,
-		       size = dstsize}],
-		     condition)
-	    end
-	fun binal64 (oper1: x86.Instruction.binal, 
-		     oper2: x86.Instruction.binal, 
-		     condition)
-	  = let
-	      val ((dst1, dst1size), (dst2, dst2size)) = getDst2 ()
-	      val ((src1, src1size), (src2, src2size),
-		   (src3, src3size), (src4, src4size)) = getSrc4 ()
-	      val _ = Assert.assert
-		      ("arith: binal64, dst1size/dst2size/src1size/src2size/src3size/src4size",
-		       fn () => src1size = dst1size andalso src3size = dst1size andalso
+        fun check (statements, condition)
+          = AppendList.single
+            (x86.Block.mkBlock'
+             {entry = NONE,     
+              statements = statements,
+              transfer = SOME (x86.Transfer.iff
+                               {condition = condition,
+                                truee = overflow,
+                                falsee = success})})
+        fun binal (oper: x86.Instruction.binal, condition)
+          = let
+              val (dst, dstsize) = getDst1 ()
+              val ((src1, src1size), (src2, src2size)) = getSrc2 ()
+              val _ = Assert.assert
+                      ("x86MLton.arith: binal, dstsize/src1size/src2size",
+                       fn () => src1size = dstsize andalso src2size = dstsize)
+              (* Reverse src1/src2 when src1 and src2 are
+               * temporaries and the oper is commutative. 
+               *)
+              val (src1,src2)
+                = if (oper = x86.Instruction.ADD)
+                    then case (x86.Operand.deMemloc src1,
+                               x86.Operand.deMemloc src2)
+                           of (SOME memloc_src1, SOME memloc_src2)
+                            => if x86Liveness.track memloc_src1
+                                  andalso
+                                  x86Liveness.track memloc_src2
+                                 then (src2,src1)
+                                 else (src1,src2)
+                            | _ => (src1,src2)
+                    else (src1,src2)
+            in
+              check ([Assembly.instruction_mov
+                      {dst = dst,
+                       src = src1,
+                       size = dstsize},
+                      Assembly.instruction_binal
+                      {oper = oper,
+                       dst = dst,
+                       src = src2,
+                       size = dstsize}],
+                     condition)
+            end
+        fun binal64 (oper1: x86.Instruction.binal, 
+                     oper2: x86.Instruction.binal, 
+                     condition)
+          = let
+              val ((dst1, dst1size), (dst2, dst2size)) = getDst2 ()
+              val ((src1, src1size), (src2, src2size),
+                   (src3, src3size), (src4, src4size)) = getSrc4 ()
+              val _ = Assert.assert
+                      ("x86MLton.arith: binal64, dst1size/dst2size/src1size/src2size/src3size/src4size",
+                       fn () => src1size = dst1size andalso src3size = dst1size andalso
                                 src2size = dst2size andalso src4size = dst2size andalso
                                 dst1size = dst2size)
-	      val tdst1 =
-		 if List.exists ([src2,src3,src4], fn src =>
-				 Operand.mayAlias (dst1, src))
-		    then wordTemp1ContentsOperand dst1size
-		    else dst1
-	      val tdst2 =
-		 if List.exists ([src3,src4], fn src =>
-				 Operand.mayAlias (dst2, src))
-		    then wordTemp1ContentsOperand dst2size
-		    else dst2
-	    in
-	      check ([Assembly.instruction_mov
-		      {dst = tdst1,
-		       src = src1,
-		       size = dst1size},
-		      Assembly.instruction_mov
-		      {dst = tdst2,
-		       src = src2,
-		       size = dst2size},
-		      Assembly.instruction_binal
-		      {oper = oper1,
-		       dst = tdst1,
-		       src = src3,
-		       size = dst1size},
-		      Assembly.instruction_binal
-		      {oper = oper2,
-		       dst = tdst2,
-		       src = src4,
-		       size = dst2size},
-		      Assembly.instruction_mov
-		      {dst = dst1,
-		       src = tdst1,
-		       size = dst1size},
-		      Assembly.instruction_mov
-		      {dst = dst2,
-		       src = tdst2,
-		       size = dst2size}],
-		     condition)
-	    end
- 	fun pmd (oper: x86.Instruction.md, condition)
-  	  = let
-	      val (dst, dstsize) = getDst1 ()
-	      val ((src1, src1size), (src2, src2size)) = getSrc2 ()
-	      val _ = Assert.assert
-		      ("arith: pmd, dstsize/src1size/src2size",
-		       fn () => src1size = dstsize andalso src2size = dstsize)
- 	      (* Reverse src1/src2 when src1 and src2 are
- 	       * temporaries and the oper is commutative. 
- 	       *)
- 	      val (src1, src2)
- 		= if oper = x86.Instruction.MUL
- 		    then case (x86.Operand.deMemloc src1,
- 			       x86.Operand.deMemloc src2)
- 			   of (SOME memloc_src1, SOME memloc_src2)
- 			    => if x86Liveness.track memloc_src1
- 			          andalso
- 				  x86Liveness.track memloc_src2
- 				 then (src2,src1)
- 				 else (src1,src2)
- 			    | _ => (src1,src2)
- 		    else (src1,src2)
- 	    in
- 	      check ([Assembly.instruction_mov
-		      {dst = dst,
-		       src = src1,
-		       size = dstsize},
-		      Assembly.instruction_pmd
-		      {oper = oper,
-		       dst = dst,
-		       src = src2,
-		       size = dstsize}],
-		     condition)
- 	    end
-	fun unal (oper: x86.Instruction.unal, condition)
-	  = let
-	      val (dst, dstsize) = getDst1 ()
-	      val (src1, src1size) = getSrc1 ()
-	      val _ = Assert.assert
-		      ("arith: unal, dstsize/src1size",
-		       fn () => src1size = dstsize)
-	    in
-	      check ([Assembly.instruction_mov
-		      {dst = dst,
-		       src = src1,
-		       size = dstsize},
-		      Assembly.instruction_unal 
-		      {oper = oper,
-		       dst = dst,
-		       size = dstsize}],
-		     condition)
-	    end
+              val tdst1 =
+                 if List.exists ([src2,src3,src4], fn src =>
+                                 Operand.mayAlias (dst1, src))
+                    then wordTemp1ContentsOperand dst1size
+                    else dst1
+              val tdst2 =
+                 if List.exists ([src3,src4], fn src =>
+                                 Operand.mayAlias (dst2, src))
+                    then wordTemp1ContentsOperand dst2size
+                    else dst2
+            in
+              check ([Assembly.instruction_mov
+                      {dst = tdst1,
+                       src = src1,
+                       size = dst1size},
+                      Assembly.instruction_mov
+                      {dst = tdst2,
+                       src = src2,
+                       size = dst2size},
+                      Assembly.instruction_binal
+                      {oper = oper1,
+                       dst = tdst1,
+                       src = src3,
+                       size = dst1size},
+                      Assembly.instruction_binal
+                      {oper = oper2,
+                       dst = tdst2,
+                       src = src4,
+                       size = dst2size},
+                      Assembly.instruction_mov
+                      {dst = dst1,
+                       src = tdst1,
+                       size = dst1size},
+                      Assembly.instruction_mov
+                      {dst = dst2,
+                       src = tdst2,
+                       size = dst2size}],
+                     condition)
+            end
+        fun pmd (oper: x86.Instruction.md, condition)
+          = let
+              val (dst, dstsize) = getDst1 ()
+              val ((src1, src1size), (src2, src2size)) = getSrc2 ()
+              val _ = Assert.assert
+                      ("x86MLton.arith: pmd, dstsize/src1size/src2size",
+                       fn () => src1size = dstsize andalso src2size = dstsize)
+              (* Reverse src1/src2 when src1 and src2 are
+               * temporaries and the oper is commutative. 
+               *)
+              val (src1, src2)
+                = if oper = x86.Instruction.MUL
+                    then case (x86.Operand.deMemloc src1,
+                               x86.Operand.deMemloc src2)
+                           of (SOME memloc_src1, SOME memloc_src2)
+                            => if x86Liveness.track memloc_src1
+                                  andalso
+                                  x86Liveness.track memloc_src2
+                                 then (src2,src1)
+                                 else (src1,src2)
+                            | _ => (src1,src2)
+                    else (src1,src2)
+            in
+              check ([Assembly.instruction_mov
+                      {dst = dst,
+                       src = src1,
+                       size = dstsize},
+                      Assembly.instruction_pmd
+                      {oper = oper,
+                       dst = dst,
+                       src = src2,
+                       size = dstsize}],
+                     condition)
+            end
+        fun unal (oper: x86.Instruction.unal, condition)
+          = let
+              val (dst, dstsize) = getDst1 ()
+              val (src1, src1size) = getSrc1 ()
+              val _ = Assert.assert
+                      ("x86MLton.arith: unal, dstsize/src1size",
+                       fn () => src1size = dstsize)
+            in
+              check ([Assembly.instruction_mov
+                      {dst = dst,
+                       src = src1,
+                       size = dstsize},
+                      Assembly.instruction_unal 
+                      {oper = oper,
+                       dst = dst,
+                       size = dstsize}],
+                     condition)
+            end
 
-	fun neg64 ()
-	  = let
-	      val ((dst1, dst1size), (dst2, dst2size)) = getDst2 ()
-	      val ((src1, src1size), (src2, src2size)) = getSrc2 ()
-	      val _ = Assert.assert
-		      ("arith: neg64, dst1size/dst2size/src1size/src2size",
-		       fn () => src1size = dst1size andalso
-		                src2size = dst2size andalso
-				dst1size = dst2size)
-	      val tdst1 =
-		 if List.exists ([src2], fn src =>
-				 Operand.mayAlias (dst1, src))
-		    then wordTemp1ContentsOperand dst1size
-		    else dst1
-	      val loZ = Label.newString "loZ"
-	      val _ = x86Liveness.LiveInfo.setLiveOperands
-		      (liveInfo, loZ, dst2::((live success) @ (live overflow)))
-	      val loNZ = Label.newString "loNZ"
-	      val _ = x86Liveness.LiveInfo.setLiveOperands
-		      (liveInfo, loNZ, dst2::(live success))
-	    in
-	       AppendList.fromList
-	       [x86.Block.mkBlock'
-		{entry = NONE,
-		 statements = [Assembly.instruction_mov
-			       {dst = tdst1,
-				src = src1,
-				size = dst1size},
-			       Assembly.instruction_mov
-			       {dst = dst2,
-				src = src2,
-				size = dst2size},
-			       Assembly.instruction_mov
-			       {dst = dst1,
-				src = tdst1,
-				size = dst1size},
-			       Assembly.instruction_unal 
-			       {oper = x86.Instruction.NEG,
-				dst = dst1,
-				size = dst1size}],
+        fun neg64 ()
+          = let
+              val ((dst1, dst1size), (dst2, dst2size)) = getDst2 ()
+              val ((src1, src1size), (src2, src2size)) = getSrc2 ()
+              val _ = Assert.assert
+                      ("x86MLton.arith: neg64, dst1size/dst2size/src1size/src2size",
+                       fn () => src1size = dst1size andalso
+                                src2size = dst2size andalso
+                                dst1size = dst2size)
+              val tdst1 =
+                 if List.exists ([src2], fn src =>
+                                 Operand.mayAlias (dst1, src))
+                    then wordTemp1ContentsOperand dst1size
+                    else dst1
+              val loZ = Label.newString "loZ"
+              val _ = x86Liveness.LiveInfo.setLiveOperands
+                      (liveInfo, loZ, dst2::((live success) @ (live overflow)))
+              val loNZ = Label.newString "loNZ"
+              val _ = x86Liveness.LiveInfo.setLiveOperands
+                      (liveInfo, loNZ, dst2::(live success))
+            in
+               AppendList.fromList
+               [x86.Block.mkBlock'
+                {entry = NONE,
+                 statements = [Assembly.instruction_mov
+                               {dst = tdst1,
+                                src = src1,
+                                size = dst1size},
+                               Assembly.instruction_mov
+                               {dst = dst2,
+                                src = src2,
+                                size = dst2size},
+                               Assembly.instruction_mov
+                               {dst = dst1,
+                                src = tdst1,
+                                size = dst1size},
+                               Assembly.instruction_unal 
+                               {oper = x86.Instruction.NEG,
+                                dst = dst1,
+                                size = dst1size}],
                  transfer = SOME (x86.Transfer.iff
                                   {condition = x86.Instruction.Z,
-				   truee = loZ,
-				   falsee = loNZ})},
-		x86.Block.mkBlock'
-		{entry = SOME (x86.Entry.jump {label = loNZ}),
-		 statements = [Assembly.instruction_unal
-			       {dst = dst2,
-				oper = Instruction.INC,
-				size = dst2size},
-			       Assembly.instruction_unal 
-			       {oper = x86.Instruction.NEG,
-				dst = dst2,
-				size = dst2size}],
-		 transfer = SOME (x86.Transfer.goto {target = success})},
-		x86.Block.mkBlock'
-		{entry = SOME (x86.Entry.jump {label = loZ}),
-		 statements = [Assembly.instruction_unal 
-			       {oper = x86.Instruction.NEG,
-				dst = dst2,
-				size = dst2size}],
-		 transfer = SOME (x86.Transfer.iff
-				  {condition = x86.Instruction.O,
-				   truee = overflow,
-				   falsee = success})}]
-	    end
+                                   truee = loZ,
+                                   falsee = loNZ})},
+                x86.Block.mkBlock'
+                {entry = SOME (x86.Entry.jump {label = loNZ}),
+                 statements = [Assembly.instruction_unal
+                               {dst = dst2,
+                                oper = Instruction.INC,
+                                size = dst2size},
+                               Assembly.instruction_unal 
+                               {oper = x86.Instruction.NEG,
+                                dst = dst2,
+                                size = dst2size}],
+                 transfer = SOME (x86.Transfer.goto {target = success})},
+                x86.Block.mkBlock'
+                {entry = SOME (x86.Entry.jump {label = loZ}),
+                 statements = [Assembly.instruction_unal 
+                               {oper = x86.Instruction.NEG,
+                                dst = dst2,
+                                size = dst2size}],
+                 transfer = SOME (x86.Transfer.iff
+                                  {condition = x86.Instruction.O,
+                                   truee = overflow,
+                                   falsee = success})}]
+            end
 
-	fun imul2 condition
-	  = let
-	      val (dst, dstsize) = getDst1 ()
-	      val ((src1, src1size), (src2, src2size)) = getSrc2 ()
-	      val _ = Assert.assert
-		      ("arith: imul2, dstsize/src1size/src2size",
-		       fn () => src1size = dstsize andalso src2size = dstsize)
-	      (* Reverse src1/src2 when src1 and src2 are
-	       * temporaries and the oper is commutative. 
-	       *)
-	      val (src1, src2)
-		= case (x86.Operand.deMemloc src1,
-			x86.Operand.deMemloc src2)
-		    of (SOME memloc_src1, SOME memloc_src2)
-		     => if x86Liveness.track memloc_src1
-		           andalso
-			   x86Liveness.track memloc_src2
-			  then (src2,src1)
-			  else (src1,src2)
-		     | _ => (src1,src2)
-	    in
-	      check ([Assembly.instruction_mov
-		      {dst = dst,
-		       src = src1,
-		       size = dstsize},
-		      Assembly.instruction_imul2
-		      {dst = dst,
-		       src = src2,
-		       size = dstsize}],
-		     condition)
-	    end
+        fun imul2 condition
+          = let
+              val (dst, dstsize) = getDst1 ()
+              val ((src1, src1size), (src2, src2size)) = getSrc2 ()
+              val _ = Assert.assert
+                      ("x86MLton.arith: imul2, dstsize/src1size/src2size",
+                       fn () => src1size = dstsize andalso src2size = dstsize)
+              (* Reverse src1/src2 when src1 and src2 are
+               * temporaries and the oper is commutative. 
+               *)
+              val (src1, src2)
+                = case (x86.Operand.deMemloc src1,
+                        x86.Operand.deMemloc src2)
+                    of (SOME memloc_src1, SOME memloc_src2)
+                     => if x86Liveness.track memloc_src1
+                           andalso
+                           x86Liveness.track memloc_src2
+                          then (src2,src1)
+                          else (src1,src2)
+                     | _ => (src1,src2)
+            in
+              check ([Assembly.instruction_mov
+                      {dst = dst,
+                       src = src1,
+                       size = dstsize},
+                      Assembly.instruction_imul2
+                      {dst = dst,
+                       src = src2,
+                       size = dstsize}],
+                     condition)
+            end
 
-	val (comment_begin,_)
-	  = if !Control.Native.commented > 0
-	      then let
-		     val comment = primName
-		   in 
-		     (AppendList.single
-		      (x86.Block.mkBlock'
-		       {entry = NONE,
-			statements 
-			= [x86.Assembly.comment 
-			   ("begin arith: " ^ comment)],
-			transfer = NONE}),
-		      AppendList.single
-		      (x86.Block.mkBlock'
-		       {entry = NONE,
-			statements 
-			= [x86.Assembly.comment 
-			   ("end arith: " ^ comment)],
-			transfer = NONE}))
-		   end
-	      else (AppendList.empty,AppendList.empty)
-	fun flag {signed} =
-	   if signed then x86.Instruction.O else x86.Instruction.C
+        val (comment_begin,_)
+          = if !Control.Native.commented > 0
+              then let
+                     val comment = primName
+                   in 
+                     (AppendList.single
+                      (x86.Block.mkBlock'
+                       {entry = NONE,
+                        statements 
+                        = [x86.Assembly.comment 
+                           ("begin arith: " ^ comment)],
+                        transfer = NONE}),
+                      AppendList.single
+                      (x86.Block.mkBlock'
+                       {entry = NONE,
+                        statements 
+                        = [x86.Assembly.comment 
+                           ("end arith: " ^ comment)],
+                        transfer = NONE}))
+                   end
+              else (AppendList.empty,AppendList.empty)
+        fun flag {signed} =
+           if signed then x86.Instruction.O else x86.Instruction.C
       in
-	AppendList.appends
-	[comment_begin,
-	 (case Prim.name prim of
-	     Word_addCheck (s, sg) =>
-		let
-		   val flag = flag sg
-		in
-		   case WordSize.prim s of
-		      W8 => binal (x86.Instruction.ADD, flag)
-		    | W16 => binal (x86.Instruction.ADD, flag)
-		    | W32 => binal (x86.Instruction.ADD, flag)
-		    | W64 => binal64 (x86.Instruction.ADD, x86.Instruction.ADC, flag)
-		end
-	   | Word_mulCheck (s, {signed}) =>
-		let
-		in
-		   if signed
-		      then
-			 (case WordSize.prim s of
-			     W8 => pmd (x86.Instruction.IMUL, x86.Instruction.O)
-			   | W16 => imul2 x86.Instruction.O
-			   | W32 => imul2 x86.Instruction.O
-			   | W64 => Error.bug "FIXME")
-		   else
-		      (case WordSize.prim s of
-			  W8 => pmd (x86.Instruction.MUL, x86.Instruction.C)
-			| W16 => pmd (x86.Instruction.MUL, x86.Instruction.C)
-			| W32 => pmd (x86.Instruction.MUL, x86.Instruction.C)
-			| W64 => Error.bug "FIXME")
-		end
-	   | Word_negCheck s => 
-	       (case WordSize.prim s of
-		  W8 => unal (x86.Instruction.NEG, x86.Instruction.O)
-		| W16 => unal (x86.Instruction.NEG, x86.Instruction.O)
-		| W32 => unal (x86.Instruction.NEG, x86.Instruction.O)
-		| W64 => neg64 ())
-	   | Word_subCheck (s, {signed}) =>
-		let
-		   val flag =
-		      if signed then x86.Instruction.O else x86.Instruction.C
-		in
-		   case WordSize.prim s of
-		      W8 => binal (x86.Instruction.SUB, flag)
-		    | W16 => binal (x86.Instruction.SUB, flag)
-		    | W32 => binal (x86.Instruction.SUB, flag)
-		    | W64 => binal64 (x86.Instruction.SUB, x86.Instruction.SBB, flag)
-		end
-	   | _ => Error.bug ("arith: strange Prim.Name.t: " ^ primName))]
+        AppendList.appends
+        [comment_begin,
+         (case Prim.name prim of
+             Word_addCheck (s, sg) =>
+                let
+                   val flag = flag sg
+                in
+                   case WordSize.prim s of
+                      W8 => binal (x86.Instruction.ADD, flag)
+                    | W16 => binal (x86.Instruction.ADD, flag)
+                    | W32 => binal (x86.Instruction.ADD, flag)
+                    | W64 => binal64 (x86.Instruction.ADD, x86.Instruction.ADC, flag)
+                end
+           | Word_mulCheck (s, {signed}) =>
+                let
+                in
+                   if signed
+                      then
+                         (case WordSize.prim s of
+                             W8 => pmd (x86.Instruction.IMUL, x86.Instruction.O)
+                           | W16 => imul2 x86.Instruction.O
+                           | W32 => imul2 x86.Instruction.O
+                           | W64 => Error.bug "x86MLton.arith: Word_mulCheck, W64")
+                   else
+                      (case WordSize.prim s of
+                          W8 => pmd (x86.Instruction.MUL, x86.Instruction.C)
+                        | W16 => pmd (x86.Instruction.MUL, x86.Instruction.C)
+                        | W32 => pmd (x86.Instruction.MUL, x86.Instruction.C)
+                        | W64 => Error.bug "x86MLton.arith: Word_mulCheck, W64")
+                end
+           | Word_negCheck s => 
+               (case WordSize.prim s of
+                  W8 => unal (x86.Instruction.NEG, x86.Instruction.O)
+                | W16 => unal (x86.Instruction.NEG, x86.Instruction.O)
+                | W32 => unal (x86.Instruction.NEG, x86.Instruction.O)
+                | W64 => neg64 ())
+           | Word_subCheck (s, {signed}) =>
+                let
+                   val flag =
+                      if signed then x86.Instruction.O else x86.Instruction.C
+                in
+                   case WordSize.prim s of
+                      W8 => binal (x86.Instruction.SUB, flag)
+                    | W16 => binal (x86.Instruction.SUB, flag)
+                    | W32 => binal (x86.Instruction.SUB, flag)
+                    | W64 => binal64 (x86.Instruction.SUB, x86.Instruction.SBB, flag)
+                end
+           | _ => Error.bug ("x86MLton.arith: strange Prim.Name.t: " ^ primName))]
       end
 
 end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/codegen/x86-codegen/x86-mlton.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/codegen/x86-codegen/x86-mlton.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/codegen/x86-codegen/x86-mlton.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature X86_MLTON_STRUCTS =
   sig
     structure x86MLtonBasic : X86_MLTON_BASIC
@@ -22,31 +23,31 @@
     sharing Machine = x86MLtonBasic.Machine
 
     type transInfo = {addData : x86.Assembly.t list -> unit,
-		      frameInfoToX86: (x86MLtonBasic.Machine.FrameInfo.t
-				       -> x86.FrameInfo.t),
-		      live: x86.Label.t -> x86.Operand.t list,
-		      liveInfo: x86Liveness.LiveInfo.t}
+                      frameInfoToX86: (x86MLtonBasic.Machine.FrameInfo.t
+                                       -> x86.FrameInfo.t),
+                      live: x86.Label.t -> x86.Operand.t list,
+                      liveInfo: x86Liveness.LiveInfo.t}
 
     (* arith, c call, and primitive assembly sequences. *)
     val arith: {prim: RepType.t Machine.Prim.t,
-		args: (x86.Operand.t * x86.Size.t) vector,
-		dsts: (x86.Operand.t * x86.Size.t) vector,
-		overflow: x86.Label.t,
-		success: x86.Label.t,
-		transInfo : transInfo} -> x86.Block.t' AppendList.t
+                args: (x86.Operand.t * x86.Size.t) vector,
+                dsts: (x86.Operand.t * x86.Size.t) vector,
+                overflow: x86.Label.t,
+                success: x86.Label.t,
+                transInfo : transInfo} -> x86.Block.t' AppendList.t
     val ccall: {args: (x86.Operand.t * x86.Size.t) vector,
-		frameInfo: x86.FrameInfo.t option,
-		func: RepType.t Machine.CFunction.t,
-		return: x86.Label.t option,
-		transInfo: transInfo} -> x86.Block.t' AppendList.t
+                frameInfo: x86.FrameInfo.t option,
+                func: RepType.t Machine.CFunction.t,
+                return: x86.Label.t option,
+                transInfo: transInfo} -> x86.Block.t' AppendList.t
     val creturn: {dsts: (x86.Operand.t * x86.Size.t) vector,
-		  frameInfo: x86.FrameInfo.t option,
-		  func: RepType.t Machine.CFunction.t,
-		  label: x86.Label.t, 
-		  transInfo: transInfo} -> x86.Block.t' AppendList.t
+                  frameInfo: x86.FrameInfo.t option,
+                  func: RepType.t Machine.CFunction.t,
+                  label: x86.Label.t, 
+                  transInfo: transInfo} -> x86.Block.t' AppendList.t
   val implementsPrim: RepType.t Machine.Prim.t -> bool
   val prim: {prim: RepType.t Machine.Prim.t,
-	       args: (x86.Operand.t * x86.Size.t) vector,
-	       dsts: (x86.Operand.t * x86.Size.t) vector,
-	       transInfo: transInfo} -> x86.Block.t' AppendList.t
+               args: (x86.Operand.t * x86.Size.t) vector,
+               dsts: (x86.Operand.t * x86.Size.t) vector,
+               transInfo: transInfo} -> x86.Block.t' AppendList.t
   end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/codegen/x86-codegen/x86-pseudo.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/codegen/x86-codegen/x86-pseudo.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/codegen/x86-codegen/x86-pseudo.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 type int = Int.t
 type word = Word.t
 
@@ -25,112 +26,112 @@
 
     structure Size :
       sig
-	datatype class = INT | FLT | FPI
-	datatype t 
-	  = BYTE | WORD | LONG 
-	  | SNGL | DBLE | EXTD
-	  | FPIS | FPIL | FPIQ
-	val fromBytes : int -> t
-	val toBytes : t -> int
-	val fromCType : CType.t -> t vector
-	val class : t -> class
-	val eq : t * t -> bool
-	val lt : t * t -> bool
+        datatype class = INT | FLT | FPI
+        datatype t 
+          = BYTE | WORD | LONG 
+          | SNGL | DBLE | EXTD
+          | FPIS | FPIL | FPIQ
+        val fromBytes : int -> t
+        val toBytes : t -> int
+        val fromCType : CType.t -> t vector
+        val class : t -> class
+        val eq : t * t -> bool
+        val lt : t * t -> bool
       end
 
     structure Immediate :
       sig
-	datatype const
-	  = Char of char
-	  | Int of int
-	  | Word of word
-	datatype un
-	  = Negation
-	  | Complementation
-	datatype bin
-	  = Multiplication
-	  | Division
-	  | Remainder
-	  | ShiftLeft
+        datatype const
+          = Char of char
+          | Int of int
+          | Word of word
+        datatype un
+          = Negation
+          | Complementation
+        datatype bin
+          = Multiplication
+          | Division
+          | Remainder
+          | ShiftLeft
           | ShiftRight
-	  | BitOr
-  	  | BitAnd
-	  | BitXor
-	  | BitOrNot
-	  | Addition
-	  | Subtraction
-	type t
+          | BitOr
+          | BitAnd
+          | BitXor
+          | BitOrNot
+          | Addition
+          | Subtraction
+        type t
 
-	val const : const -> t
-	val const_char : char -> t
-	val const_int : int -> t
-	val const_word : word -> t
-	val deConst : t -> const option
-	val label : Label.t -> t
-	val unexp : {oper: un,
-		     exp: t} -> t
-	val binexp : {oper: bin,
-		      exp1: t,
-		      exp2: t} -> t
+        val const : const -> t
+        val const_char : char -> t
+        val const_int : int -> t
+        val const_word : word -> t
+        val deConst : t -> const option
+        val label : Label.t -> t
+        val unexp : {oper: un,
+                     exp: t} -> t
+        val binexp : {oper: bin,
+                      exp1: t,
+                      exp2: t} -> t
       end
 
     structure Scale :
       sig
-	datatype t = One | Two | Four | Eight
-	val fromBytes : int -> t
-	val fromCType : CType.t -> t
+        datatype t = One | Two | Four | Eight
+        val fromBytes : int -> t
+        val fromCType : CType.t -> t
       end
 
     structure MemLoc :
       sig
-	structure Class :
+        structure Class :
           sig
-	    type t
-	    val new : {name: string} -> t
-	    val Temp : t
-	    val StaticTemp : t
-	    val CStack : t
-	    val Code : t
+            type t
+            val new : {name: string} -> t
+            val Temp : t
+            val StaticTemp : t
+            val CStack : t
+            val Code : t
 
-	    val eq : t * t -> bool
-	  end
+            val eq : t * t -> bool
+          end
 
-	type t
-	val layout : t -> Layout.t
+        type t
+        val layout : t -> Layout.t
 
-	val imm : {base: Immediate.t,
-		   index: Immediate.t,
-		   scale: Scale.t,
-		   size: Size.t,
-		   class: Class.t} -> t
-	val basic : {base: Immediate.t,
-		     index: t,
-		     scale: Scale.t,
-		     size: Size.t,
-		     class: Class.t} -> t
-	val simple : {base: t,
-		      index: Immediate.t,
-		      scale: Scale.t,
-		      size: Size.t,
-		      class: Class.t} -> t
-	val complex : {base: t,
-		       index: t,
-		       scale: Scale.t,
-		       size: Size.t,
-		       class: Class.t} -> t
-	val shift : {origin: t,
-		     disp: Immediate.t,
-		     scale: Scale.t,
-		     size: Size.t} -> t
-	  
-	val class : t -> Class.t
-	val compare : t * t -> order
-	(*
-	 * Static memory locations
-	 *)
-	val makeContents : {base: Immediate.t,
-			    size: Size.t,
-			    class: Class.t} -> t
+        val imm : {base: Immediate.t,
+                   index: Immediate.t,
+                   scale: Scale.t,
+                   size: Size.t,
+                   class: Class.t} -> t
+        val basic : {base: Immediate.t,
+                     index: t,
+                     scale: Scale.t,
+                     size: Size.t,
+                     class: Class.t} -> t
+        val simple : {base: t,
+                      index: Immediate.t,
+                      scale: Scale.t,
+                      size: Size.t,
+                      class: Class.t} -> t
+        val complex : {base: t,
+                       index: t,
+                       scale: Scale.t,
+                       size: Size.t,
+                       class: Class.t} -> t
+        val shift : {origin: t,
+                     disp: Immediate.t,
+                     scale: Scale.t,
+                     size: Size.t} -> t
+          
+        val class : t -> Class.t
+        val compare : t * t -> order
+        (*
+         * Static memory locations
+         *)
+        val makeContents : {base: Immediate.t,
+                            size: Size.t,
+                            class: Class.t} -> t
       end
 
     structure ClassSet : SET
@@ -140,363 +141,361 @@
 
     structure Operand : 
       sig
-	type t
+        type t
 
-	val layout : t -> Layout.t
-	val toString : t -> string
+        val layout : t -> Layout.t
+        val toString : t -> string
 
-	val immediate : Immediate.t -> t
-	val immediate_const_char : char -> t
-	val immediate_const_int : int -> t
-	val immediate_const_word : word -> t
-	val immediate_label : Label.t -> t
-	val deImmediate : t -> Immediate.t option
-	val label : Label.t -> t
-	val deLabel : t -> Label.t option
-	val memloc : MemLoc.t -> t
-	val deMemloc : t -> MemLoc.t option
+        val immediate : Immediate.t -> t
+        val immediate_const_char : char -> t
+        val immediate_const_int : int -> t
+        val immediate_const_word : word -> t
+        val immediate_label : Label.t -> t
+        val deImmediate : t -> Immediate.t option
+        val label : Label.t -> t
+        val deLabel : t -> Label.t option
+        val memloc : MemLoc.t -> t
+        val deMemloc : t -> MemLoc.t option
 
-	val size : t -> Size.t option
-	val eq : t * t -> bool
-	val mayAlias : t * t -> bool
+        val size : t -> Size.t option
+        val eq : t * t -> bool
+        val mayAlias : t * t -> bool
       end
 
     structure Instruction : 
       sig
-	(* Integer binary arithmetic(w/o mult & div)/logic instructions. *)
-	datatype binal
-	  = ADD (* signed/unsigned addition; p. 63 *)
+        (* Integer binary arithmetic(w/o mult & div)/logic instructions. *)
+        datatype binal
+          = ADD (* signed/unsigned addition; p. 63 *)
           | ADC (* signed/unsigned addition with carry; p. 61 *)
           | SUB (* signed/unsigned subtraction; p. 713 *)
           | SBB (* signed/unsigned subtraction with borrow; p. 667 *)
           | AND (* logical and; p. 70 *)
           | OR  (* logical or; p. 499 *)
           | XOR (* logical xor; p. 758 *)
-	(* Integer multiplication and division. *)
-	datatype md
-	  = IMUL (* signed multiplication (one operand form); p. 335 *)
-	  | MUL  (* unsigned multiplication; p. 488 *)
-	  | IDIV (* signed division; p. 332 *)
-	  | DIV  (* unsigned division; p. 188 *)
-	  | IMOD (* signed modulus; *)
-	  | MOD  (* unsigned modulus; *)
-	datatype unal
-	  = INC (* increment by 1; p. 341 *)
-	  | DEC (* decrement by 1; p. 186 *)
-	  | NEG (* two's complement negation; p. 494 *)
-	  | NOT (* one's complement negation; p. 497 *)
-	(* Integer shift/rotate arithmetic/logic instructions. *)
-	datatype sral
-	  = SAL (* shift arithmetic left; p. 662 *)
-	  | SHL (* shift logical left; p. 662 *)
-	  | SAR (* shift arithmetic right; p. 662 *)
-	  | SHR (* shift logical right; p. 662 *)
-	  | ROL (* rotate left; p. 631 *)
-	  | RCL (* rotate through carry left; p. 631 *)
-	  | ROR (* rotate right; p. 631 *)
-	  | RCR (* rotate through carry right; p. 631 *)
-	(* Move with extention instructions. *)
-	datatype movx
-	  = MOVSX (* move with sign extention; p. 481 *)
-	  | MOVZX (* move with zero extention; p. 486 *)
-	(* Condition test field; p. 795 *)
-	datatype condition
-	  = O   (* overflow *)       | NO  (* not overflow *)
-	  | B   (* below *)          | NB  (* not below *)
-	  | AE  (* above or equal *) | NAE (* not above or equal *)
-	  | C   (* carry *)          | NC  (* not carry *)
-	  | E   (* equal *)          | NE  (* not equal *)
-	  | Z   (* zero *)           | NZ  (* not zero *)
-	  | BE  (* below or equal *) | NBE (* not below or equal *)
-	  | A   (* above *)          | NA  (* not above *)
-	  | S   (* sign *)           | NS  (* not sign *)
-	  | P   (* parity *)         | NP  (* not parity *)
-	  | PE  (* parity even *)    | PO  (* parity odd *)
-	  | L   (* less than *)      
-	  | NL  (* not less than *)
-	  | LE  (* less than or equal *) 
-	  | NLE (* not less than or equal *)
-	  | G   (* greater than *)   
-	  | NG  (* not greater than *)
-	  | GE  (* greater than or equal *) 
-	  | NGE (* not greater than or equal *)
-	val condition_negate : condition -> condition
-	val condition_reverse : condition -> condition
-	(* Floating-point binary arithmetic instructions. *)
-	datatype fbina
-	  = FADD  (* addition; p. 205 *)
+        (* Integer multiplication and division. *)
+        datatype md
+          = IMUL (* signed multiplication (one operand form); p. 335 *)
+          | MUL  (* unsigned multiplication; p. 488 *)
+          | IDIV (* signed division; p. 332 *)
+          | DIV  (* unsigned division; p. 188 *)
+          | IMOD (* signed modulus; *)
+          | MOD  (* unsigned modulus; *)
+        datatype unal
+          = INC (* increment by 1; p. 341 *)
+          | DEC (* decrement by 1; p. 186 *)
+          | NEG (* two's complement negation; p. 494 *)
+          | NOT (* one's complement negation; p. 497 *)
+        (* Integer shift/rotate arithmetic/logic instructions. *)
+        datatype sral
+          = SAL (* shift arithmetic left; p. 662 *)
+          | SHL (* shift logical left; p. 662 *)
+          | SAR (* shift arithmetic right; p. 662 *)
+          | SHR (* shift logical right; p. 662 *)
+          | ROL (* rotate left; p. 631 *)
+          | RCL (* rotate through carry left; p. 631 *)
+          | ROR (* rotate right; p. 631 *)
+          | RCR (* rotate through carry right; p. 631 *)
+        (* Move with extention instructions. *)
+        datatype movx
+          = MOVSX (* move with sign extention; p. 481 *)
+          | MOVZX (* move with zero extention; p. 486 *)
+        (* Condition test field; p. 795 *)
+        datatype condition
+          = O   (* overflow *)       | NO  (* not overflow *)
+          | B   (* below *)          | NB  (* not below *)
+          | AE  (* above or equal *) | NAE (* not above or equal *)
+          | C   (* carry *)          | NC  (* not carry *)
+          | E   (* equal *)          | NE  (* not equal *)
+          | Z   (* zero *)           | NZ  (* not zero *)
+          | BE  (* below or equal *) | NBE (* not below or equal *)
+          | A   (* above *)          | NA  (* not above *)
+          | S   (* sign *)           | NS  (* not sign *)
+          | P   (* parity *)         | NP  (* not parity *)
+          | PE  (* parity even *)    | PO  (* parity odd *)
+          | L   (* less than *)      
+          | NL  (* not less than *)
+          | LE  (* less than or equal *) 
+          | NLE (* not less than or equal *)
+          | G   (* greater than *)   
+          | NG  (* not greater than *)
+          | GE  (* greater than or equal *) 
+          | NGE (* not greater than or equal *)
+        val condition_negate : condition -> condition
+        val condition_reverse : condition -> condition
+        (* Floating-point binary arithmetic instructions. *)
+        datatype fbina
+          = FADD  (* addition; p. 205 *)
           | FSUB  (* subtraction; p. 297 *)
-	  | FSUBR (* reversed subtraction; p. 301 *)
-	  | FMUL  (* multiplication; p. 256 *)
-	  | FDIV  (* division; p. 229 *)
-	  | FDIVR (* reversed division; p. 233 *)
-	val fbina_reverse : fbina -> fbina
-	(* Floating-point unary arithmetic instructions. *)
-	datatype funa
-	  = F2XM1   (* compute 2^x-1; p. 201 *)
-	  | FABS    (* absolute value; p. 203 *)
-	  | FCHS    (* change sign; p. 214 *)
-	  | FSQRT   (* square root; p. 284 *)
-	  | FSIN    (* sine; p. 280 *)
-	  | FCOS    (* cosine; p. 226 *)
-	  | FRNDINT (* round to integer; p. 271 *)
-	(* Floating-point binary arithmetic stack instructions. *)
-	datatype fbinas
-	  = FSCALE (* scale; p. 278 *)
-	  | FPREM  (* partial remainder; p. 263 *)
-	  | FPREM1 (* IEEE partial remainder; p. 266 *)
-	(* floating point binary arithmetic stack pop instructions. *)
+          | FSUBR (* reversed subtraction; p. 301 *)
+          | FMUL  (* multiplication; p. 256 *)
+          | FDIV  (* division; p. 229 *)
+          | FDIVR (* reversed division; p. 233 *)
+        val fbina_reverse : fbina -> fbina
+        (* Floating-point unary arithmetic instructions. *)
+        datatype funa
+          = F2XM1   (* compute 2^x-1; p. 201 *)
+          | FABS    (* absolute value; p. 203 *)
+          | FCHS    (* change sign; p. 214 *)
+          | FSQRT   (* square root; p. 284 *)
+          | FSIN    (* sine; p. 280 *)
+          | FCOS    (* cosine; p. 226 *)
+          | FRNDINT (* round to integer; p. 271 *)
+        (* Floating-point binary arithmetic stack instructions. *)
+        datatype fbinas
+          = FSCALE (* scale; p. 278 *)
+          | FPREM  (* partial remainder; p. 263 *)
+          | FPREM1 (* IEEE partial remainder; p. 266 *)
+        (* floating point binary arithmetic stack pop instructions. *)
         datatype fbinasp
-	  = FYL2X   (* compute y * log_2 x; p. 327 *)
-	  | FYL2XP1 (* compute y * log_2 (x + 1.0); p. 329 *)
-	  | FPATAN  (* partial arctangent; p. 261 *)
-	(* Floating-point constants. *)
-	datatype fldc
-	  = ONE  (* +1.0; p. 250 *) 
-	  | ZERO (* +0.0; p. 250 *)
-	  | PI   (* pi; p. 250 *)
-	  | L2E  (* log_2 e; p. 250 *)
-	  | LN2  (* log_e 2; p. 250 *)
-	  | L2T  (* log_2 10; p. 250 *)
-	  | LG2  (* log_10 2; p. 250 *)
+          = FYL2X   (* compute y * log_2 x; p. 327 *)
+          | FYL2XP1 (* compute y * log_2 (x + 1.0); p. 329 *)
+          | FPATAN  (* partial arctangent; p. 261 *)
+        (* Floating-point constants. *)
+        datatype fldc
+          = ONE  (* +1.0; p. 250 *) 
+          | ZERO (* +0.0; p. 250 *)
+          | PI   (* pi; p. 250 *)
+          | L2E  (* log_2 e; p. 250 *)
+          | LN2  (* log_e 2; p. 250 *)
+          | L2T  (* log_2 10; p. 250 *)
+          | LG2  (* log_10 2; p. 250 *)
 
-	type t
+        type t
       end
 
     structure PseudoOp :
       sig
-	type t
+        type t
 
-	val toString : t -> string
-	  
-	val data : unit -> t
-	val text : unit -> t
-	val p2align : Immediate.t * Immediate.t option * Immediate.t option -> t
-	val byte : Immediate.t list -> t
-	val word : Immediate.t list -> t
-	val long : Immediate.t list -> t
+        val toString : t -> string
+          
+        val data : unit -> t
+        val text : unit -> t
+        val p2align : Immediate.t * Immediate.t option * Immediate.t option -> t
+        val byte : Immediate.t list -> t
+        val word : Immediate.t list -> t
+        val long : Immediate.t list -> t
       end
 
     structure Assembly :
       sig
-	type t
+        type t
 
-	val toString : t -> string
+        val toString : t -> string
 
-	val comment : string -> t
-	val isComment : t -> bool
-	val pseudoop : PseudoOp.t -> t
-	val pseudoop_data : unit -> t
-	val pseudoop_text : unit -> t
-	val pseudoop_p2align : Immediate.t * Immediate.t option * Immediate.t option -> t
-	val pseudoop_byte : Immediate.t list -> t
-	val pseudoop_global: Label.t -> t
-	val pseudoop_word : Immediate.t list -> t
-	val pseudoop_long : Immediate.t list -> t
-	val label : Label.t -> t
-	val instruction : Instruction.t -> t
-	val instruction_nop : unit -> t
-	val instruction_binal : {oper: Instruction.binal,
-				 src: Operand.t,
-				 dst: Operand.t,
-				 size: Size.t} -> t
-	val instruction_pmd : {oper: Instruction.md,
-			       src: Operand.t,
-			       dst: Operand.t,
-			       size: Size.t} -> t
-	val instruction_imul2 : {src: Operand.t,
-				 dst: Operand.t,
-				 size: Size.t} -> t
-	val instruction_unal : {oper: Instruction.unal,
-				dst: Operand.t,
-				size: Size.t} -> t
-	val instruction_sral : {oper: Instruction.sral,
-				count: Operand.t,
-				dst: Operand.t,
-				size: Size.t} -> t
-	val instruction_cmp : {src1: Operand.t,
-			       src2: Operand.t,
-			       size: Size.t} -> t
-	val instruction_test : {src1: Operand.t,
-				src2: Operand.t,
-				size: Size.t} -> t
-	val instruction_setcc : {condition: Instruction.condition,
-				 dst: Operand.t,
-				 size: Size.t} -> t
-	val instruction_jmp : {target: Operand.t,
-			       absolute: bool} -> t
-	val instruction_jcc : {condition: Instruction.condition, 
-			       target: Operand.t} -> t
-	val instruction_call : {target: Operand.t,
-				absolute: bool} -> t
-	val instruction_ret : {src: Operand.t option} -> t
-	val instruction_mov : {src: Operand.t,
-			       dst: Operand.t,
-			       size: Size.t} -> t
-	val instruction_cmovcc : {condition: Instruction.condition,
-				  src: Operand.t,
-				  dst: Operand.t,
-				  size: Size.t} -> t
-	val instruction_xchg : {src: Operand.t, 
-				dst: Operand.t,
-				size: Size.t} -> t
-	val instruction_ppush : {src: Operand.t,
-				 base: Operand.t,
-				 size: Size.t} -> t
-	val instruction_ppop : {dst: Operand.t,
-				base: Operand.t,
-				size: Size.t} -> t
-	val instruction_movx : {oper: Instruction.movx,
-				src: Operand.t,
-				srcsize: Size.t,
-				dst: Operand.t,
-				dstsize: Size.t} -> t
-	val instruction_xvom : {src: Operand.t,
-				srcsize: Size.t,
-				dst: Operand.t,
-				dstsize: Size.t} -> t
-	val instruction_lea : {src: Operand.t,
-			       dst: Operand.t,
-			       size: Size.t} -> t
-	val instruction_pfmov : {src: Operand.t,
-				 dst: Operand.t,
-				 size: Size.t} -> t
-	val instruction_pfmovx : {src: Operand.t,
-				  dst: Operand.t,
-				  srcsize: Size.t,
-				  dstsize: Size.t} -> t
-	val instruction_pfxvom : {src: Operand.t,
-				  dst: Operand.t,
-				  srcsize: Size.t,
-				  dstsize: Size.t} -> t
-	val instruction_pfldc : {oper: Instruction.fldc,
-				 dst: Operand.t,
-				 size: Size.t} -> t
-	val instruction_pfmovfi : {src: Operand.t,
-				   srcsize: Size.t,
-				   dst: Operand.t,
-				   dstsize: Size.t} -> t
-	val instruction_pfmovti : {src: Operand.t,
-				   srcsize: Size.t,
-				   dst: Operand.t,
-				   dstsize: Size.t} -> t
-	val instruction_pfcom : {src1: Operand.t,
-				 src2: Operand.t,
-				 size: Size.t} -> t
-	val instruction_pfucom : {src1: Operand.t,
-				  src2: Operand.t,
-				  size: Size.t} -> t
-	val instruction_pfbina : {oper: Instruction.fbina,
-				  src: Operand.t,
-				  dst: Operand.t,
-				  size: Size.t} -> t
-	val instruction_pfuna : {oper: Instruction.funa,
-				 dst: Operand.t,
-				 size: Size.t} -> t
-	val instruction_pfptan : {dst: Operand.t,
-				  size: Size.t} -> t
-	val instruction_pfbinas : {oper: Instruction.fbinas,
-				   src: Operand.t,
-				   dst: Operand.t,
-				   size: Size.t} -> t
-	val instruction_pfbinasp : {oper: Instruction.fbinasp,
-				    src: Operand.t,
-				    dst: Operand.t,
-				    size: Size.t} -> t
-	val instruction_fldcw : {src: Operand.t} -> t
-	val instruction_fstcw : {dst: Operand.t,
-				 check: bool} -> t
-	val instruction_fstsw : {dst: Operand.t,
-				 check: bool} -> t
+        val comment : string -> t
+        val isComment : t -> bool
+        val pseudoop : PseudoOp.t -> t
+        val pseudoop_data : unit -> t
+        val pseudoop_text : unit -> t
+        val pseudoop_p2align : Immediate.t * Immediate.t option * Immediate.t option -> t
+        val pseudoop_byte : Immediate.t list -> t
+        val pseudoop_global: Label.t -> t
+        val pseudoop_word : Immediate.t list -> t
+        val pseudoop_long : Immediate.t list -> t
+        val label : Label.t -> t
+        val instruction : Instruction.t -> t
+        val instruction_nop : unit -> t
+        val instruction_binal : {oper: Instruction.binal,
+                                 src: Operand.t,
+                                 dst: Operand.t,
+                                 size: Size.t} -> t
+        val instruction_pmd : {oper: Instruction.md,
+                               src: Operand.t,
+                               dst: Operand.t,
+                               size: Size.t} -> t
+        val instruction_imul2 : {src: Operand.t,
+                                 dst: Operand.t,
+                                 size: Size.t} -> t
+        val instruction_unal : {oper: Instruction.unal,
+                                dst: Operand.t,
+                                size: Size.t} -> t
+        val instruction_sral : {oper: Instruction.sral,
+                                count: Operand.t,
+                                dst: Operand.t,
+                                size: Size.t} -> t
+        val instruction_cmp : {src1: Operand.t,
+                               src2: Operand.t,
+                               size: Size.t} -> t
+        val instruction_test : {src1: Operand.t,
+                                src2: Operand.t,
+                                size: Size.t} -> t
+        val instruction_setcc : {condition: Instruction.condition,
+                                 dst: Operand.t,
+                                 size: Size.t} -> t
+        val instruction_jmp : {target: Operand.t,
+                               absolute: bool} -> t
+        val instruction_jcc : {condition: Instruction.condition, 
+                               target: Operand.t} -> t
+        val instruction_call : {target: Operand.t,
+                                absolute: bool} -> t
+        val instruction_ret : {src: Operand.t option} -> t
+        val instruction_mov : {src: Operand.t,
+                               dst: Operand.t,
+                               size: Size.t} -> t
+        val instruction_cmovcc : {condition: Instruction.condition,
+                                  src: Operand.t,
+                                  dst: Operand.t,
+                                  size: Size.t} -> t
+        val instruction_xchg : {src: Operand.t, 
+                                dst: Operand.t,
+                                size: Size.t} -> t
+        val instruction_ppush : {src: Operand.t,
+                                 base: Operand.t,
+                                 size: Size.t} -> t
+        val instruction_ppop : {dst: Operand.t,
+                                base: Operand.t,
+                                size: Size.t} -> t
+        val instruction_movx : {oper: Instruction.movx,
+                                src: Operand.t,
+                                srcsize: Size.t,
+                                dst: Operand.t,
+                                dstsize: Size.t} -> t
+        val instruction_xvom : {src: Operand.t,
+                                srcsize: Size.t,
+                                dst: Operand.t,
+                                dstsize: Size.t} -> t
+        val instruction_lea : {src: Operand.t,
+                               dst: Operand.t,
+                               size: Size.t} -> t
+        val instruction_pfmov : {src: Operand.t,
+                                 dst: Operand.t,
+                                 size: Size.t} -> t
+        val instruction_pfmovx : {src: Operand.t,
+                                  dst: Operand.t,
+                                  srcsize: Size.t,
+                                  dstsize: Size.t} -> t
+        val instruction_pfxvom : {src: Operand.t,
+                                  dst: Operand.t,
+                                  srcsize: Size.t,
+                                  dstsize: Size.t} -> t
+        val instruction_pfldc : {oper: Instruction.fldc,
+                                 dst: Operand.t,
+                                 size: Size.t} -> t
+        val instruction_pfmovfi : {src: Operand.t,
+                                   srcsize: Size.t,
+                                   dst: Operand.t,
+                                   dstsize: Size.t} -> t
+        val instruction_pfmovti : {src: Operand.t,
+                                   srcsize: Size.t,
+                                   dst: Operand.t,
+                                   dstsize: Size.t} -> t
+        val instruction_pfcom : {src1: Operand.t,
+                                 src2: Operand.t,
+                                 size: Size.t} -> t
+        val instruction_pfucom : {src1: Operand.t,
+                                  src2: Operand.t,
+                                  size: Size.t} -> t
+        val instruction_pfbina : {oper: Instruction.fbina,
+                                  src: Operand.t,
+                                  dst: Operand.t,
+                                  size: Size.t} -> t
+        val instruction_pfuna : {oper: Instruction.funa,
+                                 dst: Operand.t,
+                                 size: Size.t} -> t
+        val instruction_pfptan : {dst: Operand.t,
+                                  size: Size.t} -> t
+        val instruction_pfbinas : {oper: Instruction.fbinas,
+                                   src: Operand.t,
+                                   dst: Operand.t,
+                                   size: Size.t} -> t
+        val instruction_pfbinasp : {oper: Instruction.fbinasp,
+                                    src: Operand.t,
+                                    dst: Operand.t,
+                                    size: Size.t} -> t
+        val instruction_fldcw : {src: Operand.t} -> t
+        val instruction_fstcw : {dst: Operand.t,
+                                 check: bool} -> t
+        val instruction_fstsw : {dst: Operand.t,
+                                 check: bool} -> t
       end
 
     structure FrameInfo:
        sig
-	  datatype t = T of {size: int, 
-			     frameLayoutsIndex: int}
+          datatype t = T of {size: int, 
+                             frameLayoutsIndex: int}
 
-	  val frameInfo : {size: int, 
-			   frameLayoutsIndex: int} -> t
+          val frameInfo : {size: int, 
+                           frameLayoutsIndex: int} -> t
        end
 
     structure Entry:
       sig
-	type t
+        type t
 
-	val cont: {label: Label.t,
-		   live: MemLocSet.t,
-		   frameInfo: FrameInfo.t} -> t
-	val creturn: {dsts: (Operand.t * Size.t) vector,
-		      frameInfo: FrameInfo.t option,
-		      func: RepType.t CFunction.t,
-		      label: Label.t} -> t
-	val func: {label: Label.t,
-		   live: MemLocSet.t} -> t
-	val handler: {frameInfo: FrameInfo.t,
-		      label: Label.t,
-		      live: MemLocSet.t} -> t
-	val jump: {label: Label.t} -> t
-	val label: t -> Label.t
+        val cont: {label: Label.t,
+                   live: MemLocSet.t,
+                   frameInfo: FrameInfo.t} -> t
+        val creturn: {dsts: (Operand.t * Size.t) vector,
+                      frameInfo: FrameInfo.t option,
+                      func: RepType.t CFunction.t,
+                      label: Label.t} -> t
+        val func: {label: Label.t,
+                   live: MemLocSet.t} -> t
+        val handler: {frameInfo: FrameInfo.t,
+                      label: Label.t,
+                      live: MemLocSet.t} -> t
+        val jump: {label: Label.t} -> t
+        val label: t -> Label.t
       end
 
     structure Transfer :
       sig
-	structure Cases :
-	  sig
-	    type 'a t
-	      
-	    val char : (char * 'a) list -> 'a t
-	    val int : (int * 'a) list -> 'a t
-	    val word : (word * 'a) list -> 'a t
-	  end
+        structure Cases :
+          sig
+            type 'a t
+              
+            val word : (word * 'a) list -> 'a t
+          end
 
-	type t
+        type t
 
-	val goto : {target: Label.t} -> t
-	val iff : {condition: Instruction.condition,
-		   truee: Label.t,
-		   falsee: Label.t} -> t
-	val switch : {test: Operand.t,
-		      cases: Label.t Cases.t,
-		      default: Label.t} -> t
-	val tail : {target: Label.t,
-		    live: MemLocSet.t} -> t
-	val nontail : {target: Label.t, 
-		       live: MemLocSet.t,
-		       return: Label.t,
-		       handler: Label.t option,
-		       size: int} -> t
-	val return : {live: MemLocSet.t} -> t 
-	val raisee : {live: MemLocSet.t} -> t
-	val ccall : {args: (Operand.t * Size.t) list,
-		     frameInfo: FrameInfo.t option,
-		     func: RepType.t CFunction.t,
-		     return: Label.t option} -> t
+        val goto : {target: Label.t} -> t
+        val iff : {condition: Instruction.condition,
+                   truee: Label.t,
+                   falsee: Label.t} -> t
+        val switch : {test: Operand.t,
+                      cases: Label.t Cases.t,
+                      default: Label.t} -> t
+        val tail : {target: Label.t,
+                    live: MemLocSet.t} -> t
+        val nontail : {target: Label.t, 
+                       live: MemLocSet.t,
+                       return: Label.t,
+                       handler: Label.t option,
+                       size: int} -> t
+        val return : {live: MemLocSet.t} -> t 
+        val raisee : {live: MemLocSet.t} -> t
+        val ccall : {args: (Operand.t * Size.t) list,
+                     frameInfo: FrameInfo.t option,
+                     func: RepType.t CFunction.t,
+                     return: Label.t option} -> t
       end
 
     structure ProfileLabel :
       sig
-	type t
+        type t
       end
 
     structure Block :
-      sig	
-	type t'
-	val mkBlock': {entry: Entry.t option,
-		       statements: Assembly.t list,
-		       transfer: Transfer.t option} -> t'
-	val mkProfileBlock': {profileLabel: ProfileLabel.t} -> t'
-	val printBlock' : t' -> unit
+      sig       
+        type t'
+        val mkBlock': {entry: Entry.t option,
+                       statements: Assembly.t list,
+                       transfer: Transfer.t option} -> t'
+        val mkProfileBlock': {profileLabel: ProfileLabel.t} -> t'
+        val printBlock' : t' -> unit
 
-	type t
-	val printBlock : t -> unit
+        type t
+        val printBlock : t -> unit
 
-	val compress: t' list -> t list
+        val compress: t' list -> t list
       end
 
     structure Chunk :
       sig
-	datatype t = T of {data: Assembly.t list, blocks: Block.t list}
-			   
+        datatype t = T of {data: Assembly.t list, blocks: Block.t list}
+                           
       end
   end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/codegen/x86-codegen/x86-simplify.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/codegen/x86-codegen/x86-simplify.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/codegen/x86-codegen/x86-simplify.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 functor x86Simplify(S: X86_SIMPLIFY_STRUCTS): X86_SIMPLIFY =
 struct
 
@@ -21,2259 +22,2237 @@
   structure PeepholeBlock =
     struct
       structure Peephole
-	= Peephole(type entry_type = Entry.t
-		   type profileLabel_type = ProfileLabel.t option
-		   type statement_type = Assembly.t
-		   type transfer_type = Transfer.t
-		   datatype block = datatype Block.t)
+        = Peephole(type entry_type = Entry.t
+                   type profileLabel_type = ProfileLabel.t option
+                   type statement_type = Assembly.t
+                   type transfer_type = Transfer.t
+                   datatype block = datatype Block.t)
       open Peephole
 
       fun make_callback_msg name
-	= let
-	    val count = ref 0
-	    val total = ref 0
-	    val callback = fn true => (Int.inc count; Int.inc total)
-	                    | false => Int.inc total
-	    val msg = fn () => Control.messageStr 
-	                       (Control.Detail,
-				concat [name, 
-					": ", Int.toString (!count),
-					" / ", Int.toString (!total)])
-	  in
-	    (callback,msg)
-	  end
+        = let
+            val count = ref 0
+            val total = ref 0
+            val callback = fn true => (Int.inc count; Int.inc total)
+                            | false => Int.inc total
+            val msg = fn () => Control.messageStr 
+                               (Control.Detail,
+                                concat [name, 
+                                        ": ", Int.toString (!count),
+                                        " / ", Int.toString (!total)])
+          in
+            (callback,msg)
+          end
 
       val isComment : statement_type -> bool
-	= fn Assembly.Comment _
-	   => true
-	   | _ => false
+        = fn Assembly.Comment _
+           => true
+           | _ => false
 
       local
-	val isInstructionMOV : statement_type -> bool
-	  = fn Assembly.Instruction (Instruction.MOV _)
-	     => true
-	     | _ => false
+        val isInstructionMOV : statement_type -> bool
+          = fn Assembly.Instruction (Instruction.MOV _)
+             => true
+             | _ => false
 
-	val isInstructionBinALMD : statement_type -> bool
-	  = fn Assembly.Instruction (Instruction.BinAL _)
-	     => true
-	     | Assembly.Instruction (Instruction.pMD _)
-	     => true
-	     | Assembly.Instruction (Instruction.IMUL2 _)
-	     => true
-	     | _ => false
+        val isInstructionBinALMD : statement_type -> bool
+          = fn Assembly.Instruction (Instruction.BinAL _)
+             => true
+             | Assembly.Instruction (Instruction.pMD _)
+             => true
+             | Assembly.Instruction (Instruction.IMUL2 _)
+             => true
+             | _ => false
 
-	val template : template
-	  = {start = EmptyOrNonEmpty,
-	     statements = [One isInstructionMOV,
-			   All isComment,
-			   One isInstructionBinALMD],
-	     finish = EmptyOrNonEmpty,
-	     transfer = fn _ => true}
+        val template : template
+          = {start = EmptyOrNonEmpty,
+             statements = [One isInstructionMOV,
+                           All isComment,
+                           One isInstructionBinALMD],
+             finish = EmptyOrNonEmpty,
+             transfer = fn _ => true}
 
-	val rewriter : rewriter
-	  = fn {entry,
-		profileLabel,
-		start, 
-		statements =
-		[[Assembly.Instruction (Instruction.MOV
-					{src = src1,
-					 dst = dst1, 
-					 size = size1})],
-		 comments,
-		 [Assembly.Instruction (Instruction.BinAL
-					{oper = oper2,
-					 src = src2,
-					 dst = dst2,
-					 size = size2})]],
-		finish, 
-		transfer}
-	     => if Size.eq(size1, size2) andalso
-	           Operand.eq(dst1, dst2) andalso
-		   Operand.eq(src1, src2)
-		  then let
-			 val statements
-			   = (Assembly.instruction_mov
-			      {src = src1,
-			       dst = dst1,
-			       size = size1})::
-			     (Assembly.instruction_binal
-			      {oper = oper2,
-			       src = dst1,
-			       dst = dst2,
-			       size = size1})::
-			     finish
+        val rewriter : rewriter
+          = fn {entry,
+                profileLabel,
+                start, 
+                statements =
+                [[Assembly.Instruction (Instruction.MOV
+                                        {src = src1,
+                                         dst = dst1, 
+                                         size = size1})],
+                 comments,
+                 [Assembly.Instruction (Instruction.BinAL
+                                        {oper = oper2,
+                                         src = src2,
+                                         dst = dst2,
+                                         size = size2})]],
+                finish, 
+                transfer}
+             => if Size.eq(size1, size2) andalso
+                   Operand.eq(dst1, dst2) andalso
+                   Operand.eq(src1, src2)
+                  then let
+                         val statements
+                           = (Assembly.instruction_mov
+                              {src = src1,
+                               dst = dst1,
+                               size = size1})::
+                             (Assembly.instruction_binal
+                              {oper = oper2,
+                               src = dst1,
+                               dst = dst2,
+                               size = size1})::
+                             finish
 
-			 val statements
-			   = List.fold(start,
-				       List.concat [comments, 
-						    statements],
-				       op ::)
-		       in
-			 SOME (Block.T
-			       {entry = entry,
-				profileLabel = profileLabel,
-				statements = statements,
-				transfer = transfer})
-		       end
-		  else NONE
-	     | {entry,
-		profileLabel,
-		start, 
-		statements =
-		[[Assembly.Instruction (Instruction.MOV
-					{src = src1,
-					 dst = dst1, 
-					 size = size1})],
-		 comments,
-		 [Assembly.Instruction (Instruction.pMD
-					{oper = oper2,
-					 src = src2,
-					 dst = dst2,
-					 size = size2})]],
-		finish, 
-		transfer}
-	     => if Size.eq(size1, size2) andalso
-	           Operand.eq(dst1, dst2) andalso
-		   Operand.eq(src1, src2)
-		  then let
-			 val statements
-			   = (Assembly.instruction_mov
-			      {src = src1,
-			       dst = dst1,
-			       size = size1})::
-			     (Assembly.instruction_pmd
-			      {oper = oper2,
-			       src = dst1,
-			       dst = dst2,
-			       size = size1})::
-			     finish
+                         val statements
+                           = List.fold(start,
+                                       List.concat [comments, 
+                                                    statements],
+                                       op ::)
+                       in
+                         SOME (Block.T
+                               {entry = entry,
+                                profileLabel = profileLabel,
+                                statements = statements,
+                                transfer = transfer})
+                       end
+                  else NONE
+             | {entry,
+                profileLabel,
+                start, 
+                statements =
+                [[Assembly.Instruction (Instruction.MOV
+                                        {src = src1,
+                                         dst = dst1, 
+                                         size = size1})],
+                 comments,
+                 [Assembly.Instruction (Instruction.pMD
+                                        {oper = oper2,
+                                         src = src2,
+                                         dst = dst2,
+                                         size = size2})]],
+                finish, 
+                transfer}
+             => if Size.eq(size1, size2) andalso
+                   Operand.eq(dst1, dst2) andalso
+                   Operand.eq(src1, src2)
+                  then let
+                         val statements
+                           = (Assembly.instruction_mov
+                              {src = src1,
+                               dst = dst1,
+                               size = size1})::
+                             (Assembly.instruction_pmd
+                              {oper = oper2,
+                               src = dst1,
+                               dst = dst2,
+                               size = size1})::
+                             finish
 
-			 val statements
-			   = List.fold(start,
-				       List.concat [comments, 
-						    statements],
-				       op ::)
-		       in
-			 SOME (Block.T
-			       {entry = entry,
-				profileLabel = profileLabel,
-				statements = statements,
-				transfer = transfer})
-		       end
-		  else NONE
-	     | {entry,
-		profileLabel,
-		start, 
-		statements =
-		[[Assembly.Instruction (Instruction.MOV
-					{src = src1,
-					 dst = dst1, 
-					 size = size1})],
-		 comments,
-		 [Assembly.Instruction (Instruction.IMUL2
-					{src = src2,
-					 dst = dst2,
-					 size = size2})]],
-		finish, 
-		transfer}
-	     => if Size.eq(size1, size2) andalso
-	           Operand.eq(dst1, dst2) andalso
-		   Operand.eq(src1, src2)
-		  then let
-			 val statements
-			   = (Assembly.instruction_mov
-			      {src = src1,
-			       dst = dst1,
-			       size = size1})::
-			     (Assembly.instruction_imul2
-			      {src = dst1,
-			       dst = dst2,
-			       size = size1})::
-			     finish
+                         val statements
+                           = List.fold(start,
+                                       List.concat [comments, 
+                                                    statements],
+                                       op ::)
+                       in
+                         SOME (Block.T
+                               {entry = entry,
+                                profileLabel = profileLabel,
+                                statements = statements,
+                                transfer = transfer})
+                       end
+                  else NONE
+             | {entry,
+                profileLabel,
+                start, 
+                statements =
+                [[Assembly.Instruction (Instruction.MOV
+                                        {src = src1,
+                                         dst = dst1, 
+                                         size = size1})],
+                 comments,
+                 [Assembly.Instruction (Instruction.IMUL2
+                                        {src = src2,
+                                         dst = dst2,
+                                         size = size2})]],
+                finish, 
+                transfer}
+             => if Size.eq(size1, size2) andalso
+                   Operand.eq(dst1, dst2) andalso
+                   Operand.eq(src1, src2)
+                  then let
+                         val statements
+                           = (Assembly.instruction_mov
+                              {src = src1,
+                               dst = dst1,
+                               size = size1})::
+                             (Assembly.instruction_imul2
+                              {src = dst1,
+                               dst = dst2,
+                               size = size1})::
+                             finish
 
-			 val statements
-			   = List.fold(start,
-				       List.concat [comments, 
-						    statements],
-				       op ::)
-		       in
-			 SOME (Block.T
-			       {entry = entry,
-				profileLabel = profileLabel,
-				statements = statements,
-				transfer = transfer})
-		       end
-		  else NONE
-	     | _ => Error.bug "Peephole: elimBinALMDDouble"
+                         val statements
+                           = List.fold(start,
+                                       List.concat [comments, 
+                                                    statements],
+                                       op ::)
+                       in
+                         SOME (Block.T
+                               {entry = entry,
+                                profileLabel = profileLabel,
+                                statements = statements,
+                                transfer = transfer})
+                       end
+                  else NONE
+             | _ => Error.bug "x86Simplify.PeepholeBlock: elimBinALMDDouble"
 
-	val (callback,elimBinALMDDouble_msg) 
-	  = make_callback_msg "elimBinALMDDouble"
+        val (callback,elimBinALMDDouble_msg) 
+          = make_callback_msg "elimBinALMDDouble"
       in
-	val elimBinALMDDouble : optimization
-	  = {template = template,
-	     rewriter = rewriter,
-	     callback = callback}
-	val elimBinALMDDouble_msg = elimBinALMDDouble_msg
+        val elimBinALMDDouble : optimization
+          = {template = template,
+             rewriter = rewriter,
+             callback = callback}
+        val elimBinALMDDouble_msg = elimBinALMDDouble_msg
       end
 
       local
-	val isInstructionFMOV : statement_type -> bool
-	  = fn Assembly.Instruction (Instruction.pFMOV _)
-	     => true
-	     | _ => false
+        val isInstructionFMOV : statement_type -> bool
+          = fn Assembly.Instruction (Instruction.pFMOV _)
+             => true
+             | _ => false
 
-	val isInstructionFBinA : statement_type -> bool
-	  = fn Assembly.Instruction (Instruction.pFBinA _)
-	     => true
-	     | Assembly.Instruction (Instruction.pFBinAS _)
-	     => true
-	     | Assembly.Instruction (Instruction.pFBinASP _)
-	     => true
-	     | _ => false
+        val isInstructionFBinA : statement_type -> bool
+          = fn Assembly.Instruction (Instruction.pFBinA _)
+             => true
+             | Assembly.Instruction (Instruction.pFBinAS _)
+             => true
+             | Assembly.Instruction (Instruction.pFBinASP _)
+             => true
+             | _ => false
 
-	val template : template
-	  = {start = EmptyOrNonEmpty,
-	     statements = [One isInstructionFMOV,
-			   All isComment,
-			   One isInstructionFBinA],
-	     finish = EmptyOrNonEmpty,
-	     transfer = fn _ => true}
+        val template : template
+          = {start = EmptyOrNonEmpty,
+             statements = [One isInstructionFMOV,
+                           All isComment,
+                           One isInstructionFBinA],
+             finish = EmptyOrNonEmpty,
+             transfer = fn _ => true}
 
-	val rewriter : rewriter
-	  = fn {entry,
-		profileLabel,
-		start, 
-		statements =
-		[[Assembly.Instruction (Instruction.pFMOV
-					{src = src1,
-					 dst = dst1, 
-					 size = size1})],
-		 comments,
-		 [Assembly.Instruction (Instruction.pFBinA
-					{oper = oper2,
-					 src = src2,
-					 dst = dst2,
-					 size = size2})]],
-		finish, 
-		transfer}
-	     => if Size.eq(size1, size2) andalso
-	           Operand.eq(dst1, dst2) andalso
-		   Operand.eq(src1, src2)
-		  then let
-			 val statements
-			   = (Assembly.instruction_pfmov
-			      {src = src1,
-			       dst = dst1,
-			       size = size1})::
-			     (Assembly.instruction_pfbina
-			      {oper = oper2,
-			       src = dst1,
-			       dst = dst2,
-			       size = size1})::
-			     finish
+        val rewriter : rewriter
+          = fn {entry,
+                profileLabel,
+                start, 
+                statements =
+                [[Assembly.Instruction (Instruction.pFMOV
+                                        {src = src1,
+                                         dst = dst1, 
+                                         size = size1})],
+                 comments,
+                 [Assembly.Instruction (Instruction.pFBinA
+                                        {oper = oper2,
+                                         src = src2,
+                                         dst = dst2,
+                                         size = size2})]],
+                finish, 
+                transfer}
+             => if Size.eq(size1, size2) andalso
+                   Operand.eq(dst1, dst2) andalso
+                   Operand.eq(src1, src2)
+                  then let
+                         val statements
+                           = (Assembly.instruction_pfmov
+                              {src = src1,
+                               dst = dst1,
+                               size = size1})::
+                             (Assembly.instruction_pfbina
+                              {oper = oper2,
+                               src = dst1,
+                               dst = dst2,
+                               size = size1})::
+                             finish
 
-			 val statements
-			   = List.fold(start,
-				       List.concat [comments, 
-						    statements],
-				       op ::)
-		       in
-			 SOME (Block.T
-			       {entry = entry,
-				profileLabel = profileLabel,
-				statements = statements,
-				transfer = transfer})
-		       end
-		  else NONE
-	     | {entry,
-		profileLabel, 
-		start, 
-		statements =
-		[[Assembly.Instruction (Instruction.pFMOV
-					{src = src1,
-					 dst = dst1, 
-					 size = size1})],
-		 comments,
-		 [Assembly.Instruction (Instruction.pFBinAS
-					{oper = oper2,
-					 src = src2,
-					 dst = dst2,
-					 size = size2})]],
-		finish, 
-		transfer}
-	     => if Size.eq(size1, size2) andalso
-	           Operand.eq(dst1, dst2) andalso
-		   Operand.eq(src1, src2)
-		  then let
-			 val statements
-			   = (Assembly.instruction_pfmov
-			      {src = src1,
-			       dst = dst1,
-			       size = size1})::
-			     (Assembly.instruction_pfbinas
-			      {oper = oper2,
-			       src = dst1,
-			       dst = dst2,
-			       size = size1})::
-			     finish
+                         val statements
+                           = List.fold(start,
+                                       List.concat [comments, 
+                                                    statements],
+                                       op ::)
+                       in
+                         SOME (Block.T
+                               {entry = entry,
+                                profileLabel = profileLabel,
+                                statements = statements,
+                                transfer = transfer})
+                       end
+                  else NONE
+             | {entry,
+                profileLabel, 
+                start, 
+                statements =
+                [[Assembly.Instruction (Instruction.pFMOV
+                                        {src = src1,
+                                         dst = dst1, 
+                                         size = size1})],
+                 comments,
+                 [Assembly.Instruction (Instruction.pFBinAS
+                                        {oper = oper2,
+                                         src = src2,
+                                         dst = dst2,
+                                         size = size2})]],
+                finish, 
+                transfer}
+             => if Size.eq(size1, size2) andalso
+                   Operand.eq(dst1, dst2) andalso
+                   Operand.eq(src1, src2)
+                  then let
+                         val statements
+                           = (Assembly.instruction_pfmov
+                              {src = src1,
+                               dst = dst1,
+                               size = size1})::
+                             (Assembly.instruction_pfbinas
+                              {oper = oper2,
+                               src = dst1,
+                               dst = dst2,
+                               size = size1})::
+                             finish
 
-			 val statements
-			   = List.fold(start,
-				       List.concat [comments,
-						    statements],
-				       op ::)
-		       in
-			 SOME (Block.T
-			       {entry = entry,
-				profileLabel = profileLabel,
-				statements = statements,
-				transfer = transfer})
-		       end
-		  else NONE
-	     | {entry,
-	        profileLabel,
-		start, 
-		statements =
-		[[Assembly.Instruction (Instruction.pFMOV
-					{src = src1,
-					 dst = dst1, 
-					 size = size1})],
-		 comments,
-		 [Assembly.Instruction (Instruction.pFBinASP
-					{oper = oper2,
-					 src = src2,
-					 dst = dst2,
-					 size = size2})]],
-		finish, 
-		transfer}
-	     => if Size.eq(size1, size2) andalso
-	           Operand.eq(dst1, dst2) andalso
-		   Operand.eq(src1, src2)
-		  then let
-			 val statements
-			   = (Assembly.instruction_pfmov
-			      {src = src1,
-			       dst = dst1,
-			       size = size1})::
-			     (Assembly.instruction_pfbinasp
-			      {oper = oper2,
-			       src = dst1,
-			       dst = dst2,
-			       size = size1})::
-			     finish
+                         val statements
+                           = List.fold(start,
+                                       List.concat [comments,
+                                                    statements],
+                                       op ::)
+                       in
+                         SOME (Block.T
+                               {entry = entry,
+                                profileLabel = profileLabel,
+                                statements = statements,
+                                transfer = transfer})
+                       end
+                  else NONE
+             | {entry,
+                profileLabel,
+                start, 
+                statements =
+                [[Assembly.Instruction (Instruction.pFMOV
+                                        {src = src1,
+                                         dst = dst1, 
+                                         size = size1})],
+                 comments,
+                 [Assembly.Instruction (Instruction.pFBinASP
+                                        {oper = oper2,
+                                         src = src2,
+                                         dst = dst2,
+                                         size = size2})]],
+                finish, 
+                transfer}
+             => if Size.eq(size1, size2) andalso
+                   Operand.eq(dst1, dst2) andalso
+                   Operand.eq(src1, src2)
+                  then let
+                         val statements
+                           = (Assembly.instruction_pfmov
+                              {src = src1,
+                               dst = dst1,
+                               size = size1})::
+                             (Assembly.instruction_pfbinasp
+                              {oper = oper2,
+                               src = dst1,
+                               dst = dst2,
+                               size = size1})::
+                             finish
 
-			 val statements
-			   = List.fold(start,
-				       List.concat [comments,
-						    statements],
-				       op ::)
-		       in
-			 SOME (Block.T
-			       {entry = entry,
-				profileLabel = profileLabel,
-				statements = statements,
-				transfer = transfer})
-		       end
-		  else NONE
-	     | _ => Error.bug "Peephole: elimFltBinADouble"
+                         val statements
+                           = List.fold(start,
+                                       List.concat [comments,
+                                                    statements],
+                                       op ::)
+                       in
+                         SOME (Block.T
+                               {entry = entry,
+                                profileLabel = profileLabel,
+                                statements = statements,
+                                transfer = transfer})
+                       end
+                  else NONE
+             | _ => Error.bug "x86Simplify.PeepholeBlock: elimFltBinADouble"
 
-	val (callback,elimFltBinADouble_msg) 
-	  = make_callback_msg "elimFltBinADouble"
+        val (callback,elimFltBinADouble_msg) 
+          = make_callback_msg "elimFltBinADouble"
       in
-	val elimFltBinADouble : optimization
-	  = {template = template,
-	     rewriter = rewriter,
-	     callback = callback}
-	val elimFltBinADouble_msg = elimFltBinADouble_msg
+        val elimFltBinADouble : optimization
+          = {template = template,
+             rewriter = rewriter,
+             callback = callback}
+        val elimFltBinADouble_msg = elimFltBinADouble_msg
       end
 
       local
-	val isInstructionMOV_srcImmediate : statement_type -> bool
-	  = fn Assembly.Instruction (Instruction.MOV 
-				     {src = Operand.Immediate _,
-				      ...})
-	     => true
-	     | _ => false				     
+        val isInstructionMOV_srcImmediate : statement_type -> bool
+          = fn Assembly.Instruction (Instruction.MOV 
+                                     {src = Operand.Immediate _,
+                                      ...})
+             => true
+             | _ => false                                    
 
-	val isInstructionBinALMD_operCommute : statement_type -> bool
-	  = fn Assembly.Instruction (Instruction.BinAL
-				     {oper, src, dst, ...})
-	     => ((oper = Instruction.ADD)
-		 orelse
-		 (oper = Instruction.ADC)
-		 orelse
-		 (oper = Instruction.AND)
-		 orelse
-		 (oper = Instruction.OR)
-		 orelse
-		 (oper = Instruction.XOR))
-	        andalso
-		(case (Operand.deMemloc src,
-		       Operand.deMemloc dst)
-		   of (SOME src, SOME dst)
-		    => not (List.exists
-			    (src::(MemLoc.utilized src),
-			     fn memloc => MemLoc.mayAlias(memloc, dst)))
-	            | _ => true)
-	     | Assembly.Instruction (Instruction.pMD
-				     {oper, src, dst, ...})
-	     => ((oper = Instruction.IMUL)
-		 orelse
-		 (oper = Instruction.MUL))
-	        andalso
-		(case (Operand.deMemloc src,
-		       Operand.deMemloc dst)
-		   of (SOME src, SOME dst)
-		    => not (List.exists
-			    (src::(MemLoc.utilized src),
-			     fn memloc => MemLoc.mayAlias(memloc, dst)))
-	            | _ => true)
-	     | Assembly.Instruction (Instruction.IMUL2
-				     {src, dst, ...})
-	     => (case (Operand.deMemloc src,
-		       Operand.deMemloc dst)
-		   of (SOME src, SOME dst)
-		    => not (List.exists
-			    (src::(MemLoc.utilized src),
-			     fn memloc => MemLoc.mayAlias(memloc, dst)))
-	            | _ => true)
-	     | _ => false
+        val isInstructionBinALMD_operCommute : statement_type -> bool
+          = fn Assembly.Instruction (Instruction.BinAL
+                                     {oper, src, dst, ...})
+             => ((oper = Instruction.ADD)
+                 orelse
+                 (oper = Instruction.ADC)
+                 orelse
+                 (oper = Instruction.AND)
+                 orelse
+                 (oper = Instruction.OR)
+                 orelse
+                 (oper = Instruction.XOR))
+                andalso
+                (case (Operand.deMemloc src,
+                       Operand.deMemloc dst)
+                   of (SOME src, SOME dst)
+                    => not (List.exists
+                            (src::(MemLoc.utilized src),
+                             fn memloc => MemLoc.mayAlias(memloc, dst)))
+                    | _ => true)
+             | Assembly.Instruction (Instruction.pMD
+                                     {oper, src, dst, ...})
+             => ((oper = Instruction.IMUL)
+                 orelse
+                 (oper = Instruction.MUL))
+                andalso
+                (case (Operand.deMemloc src,
+                       Operand.deMemloc dst)
+                   of (SOME src, SOME dst)
+                    => not (List.exists
+                            (src::(MemLoc.utilized src),
+                             fn memloc => MemLoc.mayAlias(memloc, dst)))
+                    | _ => true)
+             | Assembly.Instruction (Instruction.IMUL2
+                                     {src, dst, ...})
+             => (case (Operand.deMemloc src,
+                       Operand.deMemloc dst)
+                   of (SOME src, SOME dst)
+                    => not (List.exists
+                            (src::(MemLoc.utilized src),
+                             fn memloc => MemLoc.mayAlias(memloc, dst)))
+                    | _ => true)
+             | _ => false
 
-	val template : template
-	  = {start = EmptyOrNonEmpty,
-	     statements = [One isInstructionMOV_srcImmediate,
-			   All isComment,
-			   One isInstructionBinALMD_operCommute],
-	     finish = EmptyOrNonEmpty,
-	     transfer = fn _ => true}
+        val template : template
+          = {start = EmptyOrNonEmpty,
+             statements = [One isInstructionMOV_srcImmediate,
+                           All isComment,
+                           One isInstructionBinALMD_operCommute],
+             finish = EmptyOrNonEmpty,
+             transfer = fn _ => true}
 
-	val rewriter : rewriter
-	  = fn {entry,
-		profileLabel,
-		start, 
-		statements =
-		[[Assembly.Instruction (Instruction.MOV
-					{src = src1, 
-					 dst = dst1, 
-					 size = size1})],
-		 comments,
-		 [Assembly.Instruction (Instruction.BinAL
-					{oper = oper2,
-					 src = src2,
-					 dst = dst2,
-					 size = size2})]],
-		finish, 
-		transfer}
-	     => if Size.eq(size1, size2) andalso
-	           Operand.eq(dst1, dst2)
-		  then case (src1, src2)
-			 of (Operand.Immediate _, Operand.Immediate _)
-			  => NONE
-			  | (Operand.Immediate _, _)
-			  => let
-			       val statements
-				 = (Assembly.instruction_mov
-				    {src = src2,
-				     dst = dst1,
-				     size = size1})::
-				   (Assembly.instruction_binal
-				    {oper = oper2,
-				     src = src1,
-				     dst = dst2,
-				     size = size2})::
-				   finish
+        val rewriter : rewriter
+          = fn {entry,
+                profileLabel,
+                start, 
+                statements =
+                [[Assembly.Instruction (Instruction.MOV
+                                        {src = src1, 
+                                         dst = dst1, 
+                                         size = size1})],
+                 comments,
+                 [Assembly.Instruction (Instruction.BinAL
+                                        {oper = oper2,
+                                         src = src2,
+                                         dst = dst2,
+                                         size = size2})]],
+                finish, 
+                transfer}
+             => if Size.eq(size1, size2) andalso
+                   Operand.eq(dst1, dst2)
+                  then case (src1, src2)
+                         of (Operand.Immediate _, Operand.Immediate _)
+                          => NONE
+                          | (Operand.Immediate _, _)
+                          => let
+                               val statements
+                                 = (Assembly.instruction_mov
+                                    {src = src2,
+                                     dst = dst1,
+                                     size = size1})::
+                                   (Assembly.instruction_binal
+                                    {oper = oper2,
+                                     src = src1,
+                                     dst = dst2,
+                                     size = size2})::
+                                   finish
 
-			       val statements
-				 = List.fold(start,
-					     List.concat [comments,
-							  statements],
-					     op ::)
-			     in
-			       SOME (Block.T
-				     {entry = entry,
-				      profileLabel = profileLabel,
-				      statements = statements,
-				      transfer = transfer})
-			     end
-			  | _ => NONE
-		  else NONE
-	     | {entry,
-		profileLabel,
-		start, 
-		statements =
-		[[Assembly.Instruction (Instruction.MOV
-					{src = src1, 
-					 dst = dst1, 
-					 size = size1})],
-		 comments,
-		 [Assembly.Instruction (Instruction.pMD
-					{oper = oper2,
-					 src = src2,
-					 dst = dst2,
-					 size = size2})]],
-		finish, 
-		transfer}
-	     => if Size.eq(size1, size2) andalso
-	           Operand.eq(dst1, dst2)
-		  then case (src1, src2)
-			 of (Operand.Immediate _, Operand.Immediate _)
-			  => NONE
-			  | (Operand.Immediate _, _)
-			  => let
-			       val statements
-				 = (Assembly.instruction_mov
-				    {src = src2,
-				     dst = dst1,
-				     size = size1})::
-				   (Assembly.instruction_pmd
-				    {oper = oper2,
-				     src = src1,
-				     dst = dst2,
-				     size = size2})::
-				   finish
+                               val statements
+                                 = List.fold(start,
+                                             List.concat [comments,
+                                                          statements],
+                                             op ::)
+                             in
+                               SOME (Block.T
+                                     {entry = entry,
+                                      profileLabel = profileLabel,
+                                      statements = statements,
+                                      transfer = transfer})
+                             end
+                          | _ => NONE
+                  else NONE
+             | {entry,
+                profileLabel,
+                start, 
+                statements =
+                [[Assembly.Instruction (Instruction.MOV
+                                        {src = src1, 
+                                         dst = dst1, 
+                                         size = size1})],
+                 comments,
+                 [Assembly.Instruction (Instruction.pMD
+                                        {oper = oper2,
+                                         src = src2,
+                                         dst = dst2,
+                                         size = size2})]],
+                finish, 
+                transfer}
+             => if Size.eq(size1, size2) andalso
+                   Operand.eq(dst1, dst2)
+                  then case (src1, src2)
+                         of (Operand.Immediate _, Operand.Immediate _)
+                          => NONE
+                          | (Operand.Immediate _, _)
+                          => let
+                               val statements
+                                 = (Assembly.instruction_mov
+                                    {src = src2,
+                                     dst = dst1,
+                                     size = size1})::
+                                   (Assembly.instruction_pmd
+                                    {oper = oper2,
+                                     src = src1,
+                                     dst = dst2,
+                                     size = size2})::
+                                   finish
 
-			       val statements
-				 = List.fold(start,
-					     List.concat [comments,
-							  statements],
-					     op ::)
-			     in
-			       SOME (Block.T
-				     {entry = entry,
-				      profileLabel = profileLabel,
-				      statements = statements,
-				      transfer = transfer})
-			     end
-			  | _ => NONE
-		  else NONE
-	     | {entry,
-		profileLabel,
-		start, 
-		statements =
-		[[Assembly.Instruction (Instruction.MOV
-					{src = src1, 
-					 dst = dst1, 
-					 size = size1})],
-		 comments,
-		 [Assembly.Instruction (Instruction.IMUL2
-					{src = src2,
-					 dst = dst2,
-					 size = size2})]],
-		finish, 
-		transfer}
-	     => if Size.eq(size1, size2) andalso
-	           Operand.eq(dst1, dst2)
-		  then case (src1, src2)
-			 of (Operand.Immediate _, Operand.Immediate _)
-			  => NONE
-			  | (Operand.Immediate _, _)
-			  => let
-			       val statements
-				 = (Assembly.instruction_mov
-				    {src = src2,
-				     dst = dst1,
-				     size = size1})::
-				   (Assembly.instruction_imul2
-				    {src = src1,
-				     dst = dst2,
-				     size = size2})::
-				   finish
+                               val statements
+                                 = List.fold(start,
+                                             List.concat [comments,
+                                                          statements],
+                                             op ::)
+                             in
+                               SOME (Block.T
+                                     {entry = entry,
+                                      profileLabel = profileLabel,
+                                      statements = statements,
+                                      transfer = transfer})
+                             end
+                          | _ => NONE
+                  else NONE
+             | {entry,
+                profileLabel,
+                start, 
+                statements =
+                [[Assembly.Instruction (Instruction.MOV
+                                        {src = src1, 
+                                         dst = dst1, 
+                                         size = size1})],
+                 comments,
+                 [Assembly.Instruction (Instruction.IMUL2
+                                        {src = src2,
+                                         dst = dst2,
+                                         size = size2})]],
+                finish, 
+                transfer}
+             => if Size.eq(size1, size2) andalso
+                   Operand.eq(dst1, dst2)
+                  then case (src1, src2)
+                         of (Operand.Immediate _, Operand.Immediate _)
+                          => NONE
+                          | (Operand.Immediate _, _)
+                          => let
+                               val statements
+                                 = (Assembly.instruction_mov
+                                    {src = src2,
+                                     dst = dst1,
+                                     size = size1})::
+                                   (Assembly.instruction_imul2
+                                    {src = src1,
+                                     dst = dst2,
+                                     size = size2})::
+                                   finish
 
-			       val statements
-				 = List.fold(start,
-					     List.concat [comments,
-							  statements],
-					     op ::)
-			     in
-			       SOME (Block.T
-				     {entry = entry,
-				      profileLabel = profileLabel,
-				      statements = statements,
-				      transfer = transfer})
-			     end
-			  | _ => NONE
-		  else NONE
-	     | _ => Error.bug "Peephole: commuteBinALMD"
+                               val statements
+                                 = List.fold(start,
+                                             List.concat [comments,
+                                                          statements],
+                                             op ::)
+                             in
+                               SOME (Block.T
+                                     {entry = entry,
+                                      profileLabel = profileLabel,
+                                      statements = statements,
+                                      transfer = transfer})
+                             end
+                          | _ => NONE
+                  else NONE
+             | _ => Error.bug "x86Simplify.PeepholeBlock: commuteBinALMD"
 
-	val (callback,commuteBinALMD_msg) 
-	  = make_callback_msg "commuteBinALMD"
+        val (callback,commuteBinALMD_msg) 
+          = make_callback_msg "commuteBinALMD"
       in
-	val commuteBinALMD : optimization
-	  = {template = template,
-	     rewriter = rewriter,
-	     callback = callback}
-	val commuteBinALMD_msg = commuteBinALMD_msg
+        val commuteBinALMD : optimization
+          = {template = template,
+             rewriter = rewriter,
+             callback = callback}
+        val commuteBinALMD_msg = commuteBinALMD_msg
       end
 
       local
-	val getImmediate1
-	  = fn Immediate.Const (Immediate.Char #"\001") => SOME false
-	     | Immediate.Const (Immediate.Int 1) => SOME false
-	     | Immediate.Const (Immediate.Int ~1) => SOME true
-	     | Immediate.Const (Immediate.Word 0wx1) => SOME false
-	     | Immediate.Const (Immediate.Word 0wxFFFFFFFF) => SOME true
-	     | _ => NONE
+        val getImmediate1
+          = fn Immediate.Const (Immediate.Char #"\001") => SOME false
+             | Immediate.Const (Immediate.Int 1) => SOME false
+             | Immediate.Const (Immediate.Int ~1) => SOME true
+             | Immediate.Const (Immediate.Word 0wx1) => SOME false
+             | Immediate.Const (Immediate.Word 0wxFFFFFFFF) => SOME true
+             | _ => NONE
 
-	val isInstructionADDorSUB_srcImmediate1 : statement_type -> bool
-	= fn Assembly.Instruction (Instruction.BinAL 
-				   {oper,
-				    src = Operand.Immediate immediate,
-				    ...})
-	   => (case oper
-		 of Instruction.ADD => true
-		  | Instruction.SUB => true
-		  | _ => false)
-	      andalso
-	      isSome (getImmediate1 (Immediate.destruct immediate))
-	   | _ => false
+        val isInstructionADDorSUB_srcImmediate1 : statement_type -> bool
+        = fn Assembly.Instruction (Instruction.BinAL 
+                                   {oper,
+                                    src = Operand.Immediate immediate,
+                                    ...})
+           => (case oper
+                 of Instruction.ADD => true
+                  | Instruction.SUB => true
+                  | _ => false)
+              andalso
+              isSome (getImmediate1 (Immediate.destruct immediate))
+           | _ => false
 
-	val template : template 
-	  = {start = EmptyOrNonEmpty,
-	     statements = [One isInstructionADDorSUB_srcImmediate1],
-	     finish = EmptyOrNonEmpty,
-	     transfer = fn _ => true}
+        val template : template 
+          = {start = EmptyOrNonEmpty,
+             statements = [One isInstructionADDorSUB_srcImmediate1],
+             finish = EmptyOrNonEmpty,
+             transfer = fn _ => true}
 
-	val rewriter : rewriter
-	  = fn {entry,
-		profileLabel,
-		start, 
-		statements =
-		[[Assembly.Instruction (Instruction.BinAL 
-					{oper,
-					 src = Operand.Immediate immediate, 
-					 dst, 
-					 size})]],
-		finish, 
-		transfer}
-	     => if (case List.fold
-		         (finish, (false, false), fn (asm, (b, b')) =>
-			  case asm
-			    of Assembly.Comment _ => (b, b')
-			     | Assembly.Instruction
-			       (Instruction.BinAL
-				{oper = Instruction.ADC, ...})
-			     => (true, if b then b' else true)
-			     | Assembly.Instruction
-			       (Instruction.BinAL
-				{oper = Instruction.SBB, ...})
-			     => (true, if b then b' else true)
-			     | Assembly.Instruction
-			       (Instruction.SETcc
-				{condition = Instruction.C, ...})
-			     => (true, if b then b' else true)
-			     | Assembly.Instruction
-			       (Instruction.SETcc
-				{condition = Instruction.NC, ...})
-			     => (true, if b then b' else true)
-			     | _ => (true, b'))
-		      of (_, true) => true
-		       | (false, _) => (case transfer
-					  of Transfer.Iff
-					     {condition = Instruction.C, ...} => true
-					   | Transfer.Iff
-					     {condition = Instruction.NC, ...} => true
-					   | _ => false)
-		       | _ => false)
-		  then NONE
-		  else let
-			 val oper
-			   = case (oper, getImmediate1 (Immediate.destruct immediate))
-			       of (Instruction.ADD, SOME false) => Instruction.INC
-				| (Instruction.ADD, SOME true ) => Instruction.DEC
-				| (Instruction.SUB, SOME false) => Instruction.DEC
-				| (Instruction.SUB, SOME true ) => Instruction.INC
-				| _ => Error.bug "elimAddSub1"
+        val rewriter : rewriter
+          = fn {entry,
+                profileLabel,
+                start, 
+                statements =
+                [[Assembly.Instruction (Instruction.BinAL 
+                                        {oper,
+                                         src = Operand.Immediate immediate, 
+                                         dst, 
+                                         size})]],
+                finish, 
+                transfer}
+             => if (case List.fold
+                         (finish, (false, false), fn (asm, (b, b')) =>
+                          case asm
+                            of Assembly.Comment _ => (b, b')
+                             | Assembly.Instruction
+                               (Instruction.BinAL
+                                {oper = Instruction.ADC, ...})
+                             => (true, if b then b' else true)
+                             | Assembly.Instruction
+                               (Instruction.BinAL
+                                {oper = Instruction.SBB, ...})
+                             => (true, if b then b' else true)
+                             | Assembly.Instruction
+                               (Instruction.SETcc
+                                {condition = Instruction.C, ...})
+                             => (true, if b then b' else true)
+                             | Assembly.Instruction
+                               (Instruction.SETcc
+                                {condition = Instruction.NC, ...})
+                             => (true, if b then b' else true)
+                             | _ => (true, b'))
+                      of (_, true) => true
+                       | (false, _) => (case transfer
+                                          of Transfer.Iff
+                                             {condition = Instruction.C, ...} => true
+                                           | Transfer.Iff
+                                             {condition = Instruction.NC, ...} => true
+                                           | _ => false)
+                       | _ => false)
+                  then NONE
+                  else let
+                         val oper
+                           = case (oper, getImmediate1 (Immediate.destruct immediate))
+                               of (Instruction.ADD, SOME false) => Instruction.INC
+                                | (Instruction.ADD, SOME true ) => Instruction.DEC
+                                | (Instruction.SUB, SOME false) => Instruction.DEC
+                                | (Instruction.SUB, SOME true ) => Instruction.INC
+                                | _ => Error.bug "x86Simplify.PeeholeBlock: elimAddSub1:oper"
 
-			 val statements
-			   = (Assembly.instruction_unal
-			      {oper = oper,
-			       dst = dst,
-			       size = size})::
-			     finish
+                         val statements
+                           = (Assembly.instruction_unal
+                              {oper = oper,
+                               dst = dst,
+                               size = size})::
+                             finish
 
-			 val statements
-			   = List.fold(start,
-				       statements,
-				       op ::)
-		       in 
-			 SOME (Block.T
-			       {entry = entry,
-				profileLabel = profileLabel,
-				statements = statements,
-				transfer = transfer})
-		       end
-	     | _ => Error.bug "Peephole: elimAddSub1"
+                         val statements
+                           = List.fold(start,
+                                       statements,
+                                       op ::)
+                       in 
+                         SOME (Block.T
+                               {entry = entry,
+                                profileLabel = profileLabel,
+                                statements = statements,
+                                transfer = transfer})
+                       end
+             | _ => Error.bug "x86Simplify.PeeholeBlock: elimAddSub1"
  
-	val (callback,elimAddSub1_msg) 
-	  = make_callback_msg "elimAddSub1"
+        val (callback,elimAddSub1_msg) 
+          = make_callback_msg "elimAddSub1"
       in
-	val elimAddSub1: optimization
-	  = {template = template,
-	     rewriter = rewriter,
-	     callback = callback}
-	val elimAddSub1_msg = elimAddSub1_msg
+        val elimAddSub1: optimization
+          = {template = template,
+             rewriter = rewriter,
+             callback = callback}
+        val elimAddSub1_msg = elimAddSub1_msg
       end
 
       local
-	val rec log2'
-	  = fn (0wx0, _) => NONE
-	     | (w : Word32.word, i : int)
-	     => if 0wx1 = Word32.andb(w, 0wx1)
-		  then case w
-			 of 0wx00000001 => SOME (i, false)
-			  | 0wxFFFFFFFF => SOME (i, true)
-			  | _ => NONE
-		  else log2' (Word32.~>>(w, 0wx1), i + 1)
-	fun log2 w = log2' (w, 0 : int)
-	fun divTemp size
-	  = MemLoc.imm {base = Immediate.label (Label.fromString "divTemp"),
-			index = Immediate.const_int 0,
-			scale = Scale.Four,
-			size = size,
-			class = MemLoc.Class.Temp}
+        val rec log2'
+          = fn (0wx0, _) => NONE
+             | (w : Word32.word, i : int)
+             => if 0wx1 = Word32.andb(w, 0wx1)
+                  then case w
+                         of 0wx00000001 => SOME (i, false)
+                          | 0wxFFFFFFFF => SOME (i, true)
+                          | _ => NONE
+                  else log2' (Word32.~>>(w, 0wx1), i + 1)
+        fun log2 w = log2' (w, 0 : int)
+        fun divTemp size
+          = MemLoc.imm {base = Immediate.label (Label.fromString "divTemp"),
+                        index = Immediate.const_int 0,
+                        scale = Scale.Four,
+                        size = size,
+                        class = MemLoc.Class.Temp}
 
-	val isImmediatePow2
-	  = fn Immediate.Const (Immediate.Char c) 
-	     => isSome (log2 (Word.fromChar c))
-	     | Immediate.Const (Immediate.Int i) 
-	     => isSome (log2 (Word.fromInt i))
-	     | Immediate.Const (Immediate.Word w) 
-	     => isSome (log2 w)
-	     | _ => false
+        val isImmediatePow2
+          = fn Immediate.Const (Immediate.Char c) 
+             => isSome (log2 (Word.fromChar c))
+             | Immediate.Const (Immediate.Int i) 
+             => isSome (log2 (Word.fromInt i))
+             | Immediate.Const (Immediate.Word w) 
+             => isSome (log2 w)
+             | _ => false
 
-	val getImmediateLog2
-	  = fn Immediate.Const (Immediate.Char c) 
-	     => log2 (Word.fromChar c)
-	     | Immediate.Const (Immediate.Int i) 
-	     => log2 (Word.fromInt i)
-	     | Immediate.Const (Immediate.Word w)
-	     => log2 w
-	     | _ => NONE
+        val getImmediateLog2
+          = fn Immediate.Const (Immediate.Char c) 
+             => log2 (Word.fromChar c)
+             | Immediate.Const (Immediate.Int i) 
+             => log2 (Word.fromInt i)
+             | Immediate.Const (Immediate.Word w)
+             => log2 w
+             | _ => NONE
 
-	val isInstructionMULorDIV_srcImmediatePow2 : statement_type -> bool
- 	 = fn Assembly.Instruction (Instruction.pMD 
-				    {oper,
-				     src = Operand.Immediate immediate,
-				     ...})
-	    => (case oper
-		  of Instruction.IMUL => true
-		   | Instruction.MUL => true
-		   | Instruction.IDIV => true
-		   | Instruction.DIV => true
-		   | _ => false)
-	       andalso
-	       isImmediatePow2 (Immediate.destruct immediate)
- 	    | Assembly.Instruction (Instruction.IMUL2
-				    {src = Operand.Immediate immediate,
-				     ...})
-	    => isImmediatePow2 (Immediate.destruct immediate)
-	    | _ => false
+        val isInstructionMULorDIV_srcImmediatePow2 : statement_type -> bool
+         = fn Assembly.Instruction (Instruction.pMD 
+                                    {oper,
+                                     src = Operand.Immediate immediate,
+                                     ...})
+            => (case oper
+                  of Instruction.IMUL => true
+                   | Instruction.MUL => true
+                   | Instruction.IDIV => true
+                   | Instruction.DIV => true
+                   | _ => false)
+               andalso
+               isImmediatePow2 (Immediate.destruct immediate)
+            | Assembly.Instruction (Instruction.IMUL2
+                                    {src = Operand.Immediate immediate,
+                                     ...})
+            => isImmediatePow2 (Immediate.destruct immediate)
+            | _ => false
 
-	val template : template 
-	  = {start = EmptyOrNonEmpty,
-	     statements 
-	     = [One isInstructionMULorDIV_srcImmediatePow2,
-		All isComment],
-	     finish = EmptyOrNonEmpty,
-	     transfer = fn _ => true}
+        val template : template 
+          = {start = EmptyOrNonEmpty,
+             statements 
+             = [One isInstructionMULorDIV_srcImmediatePow2,
+                All isComment],
+             finish = EmptyOrNonEmpty,
+             transfer = fn _ => true}
 
-	val rewriter : rewriter
-	  = fn {entry,
-		profileLabel,
-		start, 
-		statements =
-		[[Assembly.Instruction (Instruction.pMD 
-					{oper = Instruction.IMUL, 
-					 src = Operand.Immediate immediate, 
-					 dst, 
-					 size})],
-		 comments],
-		finish = [], 
-		transfer as Transfer.Iff {condition,
-					  truee,
-					  falsee}}
-	     => (case getImmediateLog2 (Immediate.destruct immediate)
-		   of NONE => Error.bug "Peephole: elimMDPow2"
-		    | SOME (0,false)
-		    => let
-			 val transfer
-			   = case condition
-			       of Instruction.O 
-				=> Transfer.Goto {target = falsee}
-				| Instruction.NO 
-				=> Transfer.Goto {target = truee}
-				| _ => Error.bug "Peephole: elimMDPow2"
-				 
-			 val statements
-			   = List.fold(start,
-				       comments,
-				       op ::)
-		       in
-			 SOME (Block.T
-			       {entry = entry,
-				profileLabel = profileLabel,
-				statements = statements,
-				transfer = transfer})
-		       end
-		    | SOME (0,true)
-		    => let
-			 val statements
-			   = List.fold
-			     (start,
-			      (Assembly.instruction_unal
-			       {oper = Instruction.NEG,
-				dst = dst,
-				size = size})::
-			      comments,
-			      op ::)
-		       in 
-			 SOME (Block.T
-			       {entry = entry,
-				profileLabel = profileLabel,
-				statements = statements,
-				transfer = transfer})
-		       end
-		    | SOME (1,b)
-		    => let
-			 val statements
-			   = List.fold
-			     (start,
-			      (fn l
-			        => if b
-				     then (Assembly.instruction_unal
-					   {oper = Instruction.NEG,
-					    dst = dst,
-					    size = size})::
-				          l
-				     else l)
-			      ((Assembly.instruction_binal
-				{oper = Instruction.ADD,
-				 src = dst,
-				 dst = dst,
-				 size = size})::
-			       comments),
-			      op ::)
-		       in
-			 SOME (Block.T
-			       {entry = entry,
-				profileLabel = profileLabel,
-				statements = statements,
-				transfer = transfer})
-		       end
-		    | _ => NONE)
-	     | {entry,
-		profileLabel,
-		start, 
-		statements =
-		[[Assembly.Instruction (Instruction.pMD 
-					{oper = Instruction.IMUL, 
-					 src = Operand.Immediate immediate, 
-					 dst, 
-					 size})],
-		 comments],
-		finish, 
-		transfer}
-	     => (case getImmediateLog2 (Immediate.destruct immediate)
-		   of NONE => Error.bug "Peephole: elimMDPow2"
-		    | SOME (0,false) 
-		    => SOME (Block.T
-			     {entry = entry,
-			      profileLabel = profileLabel,
-			      statements = List.fold(start,
-						     List.concat [comments, finish],
-						     op ::),
-			      transfer = transfer})
-		    | SOME (0,true)
-		    => let
-			 val statements
-			   = (Assembly.instruction_unal
-			      {oper = Instruction.NEG,
-			       dst = dst,
-			       size = size})::
-			     (List.concat [comments, finish])
+        val rewriter : rewriter
+          = fn {entry,
+                profileLabel,
+                start, 
+                statements =
+                [[Assembly.Instruction (Instruction.pMD 
+                                        {oper = Instruction.IMUL, 
+                                         src = Operand.Immediate immediate, 
+                                         dst, 
+                                         size})],
+                 comments],
+                finish = [], 
+                transfer as Transfer.Iff {condition,
+                                          truee,
+                                          falsee}}
+             => (case getImmediateLog2 (Immediate.destruct immediate)
+                   of NONE => Error.bug "x86Simplify.PeeholeBlock: elimMDPow2:getImmediateLog2"
+                    | SOME (0,false)
+                    => let
+                         val transfer
+                           = case condition
+                               of Instruction.O 
+                                => Transfer.Goto {target = falsee}
+                                | Instruction.NO 
+                                => Transfer.Goto {target = truee}
+                                | _ => Error.bug "x86Simplify.PeeholeBlock: elimMDPow2:transfer"
+                                 
+                         val statements
+                           = List.fold(start,
+                                       comments,
+                                       op ::)
+                       in
+                         SOME (Block.T
+                               {entry = entry,
+                                profileLabel = profileLabel,
+                                statements = statements,
+                                transfer = transfer})
+                       end
+                    | SOME (0,true)
+                    => let
+                         val statements
+                           = List.fold
+                             (start,
+                              (Assembly.instruction_unal
+                               {oper = Instruction.NEG,
+                                dst = dst,
+                                size = size})::
+                              comments,
+                              op ::)
+                       in 
+                         SOME (Block.T
+                               {entry = entry,
+                                profileLabel = profileLabel,
+                                statements = statements,
+                                transfer = transfer})
+                       end
+                    | SOME (1,b)
+                    => let
+                         val statements
+                           = List.fold
+                             (start,
+                              (fn l
+                                => if b
+                                     then (Assembly.instruction_unal
+                                           {oper = Instruction.NEG,
+                                            dst = dst,
+                                            size = size})::
+                                          l
+                                     else l)
+                              ((Assembly.instruction_binal
+                                {oper = Instruction.ADD,
+                                 src = dst,
+                                 dst = dst,
+                                 size = size})::
+                               comments),
+                              op ::)
+                       in
+                         SOME (Block.T
+                               {entry = entry,
+                                profileLabel = profileLabel,
+                                statements = statements,
+                                transfer = transfer})
+                       end
+                    | _ => NONE)
+             | {entry,
+                profileLabel,
+                start, 
+                statements =
+                [[Assembly.Instruction (Instruction.pMD 
+                                        {oper = Instruction.IMUL, 
+                                         src = Operand.Immediate immediate, 
+                                         dst, 
+                                         size})],
+                 comments],
+                finish, 
+                transfer}
+             => (case getImmediateLog2 (Immediate.destruct immediate)
+                   of NONE => Error.bug "x86Simplify.PeeholeBlock: elimMDPow2:getImmediateLog2"
+                    | SOME (0,false) 
+                    => SOME (Block.T
+                             {entry = entry,
+                              profileLabel = profileLabel,
+                              statements = List.fold(start,
+                                                     List.concat [comments, finish],
+                                                     op ::),
+                              transfer = transfer})
+                    | SOME (0,true)
+                    => let
+                         val statements
+                           = (Assembly.instruction_unal
+                              {oper = Instruction.NEG,
+                               dst = dst,
+                               size = size})::
+                             (List.concat [comments, finish])
 
-			 val statements
-			   = List.fold(start, 
-				       statements,
-				       op ::)
-		       in
-			 SOME (Block.T
-			       {entry = entry,
-				profileLabel = profileLabel,
-				statements = statements,
-				transfer = transfer})
-		       end
-		    | SOME (1,b)
-		    => let
-			 val statements
-			   = List.fold
-			     (start,
-			      (fn l
-			        => if b
-				     then (Assembly.instruction_unal
-					   {oper = Instruction.NEG,
-					    dst = dst,
-					    size = size})::
-				          l
-				     else l)
-			      ((Assembly.instruction_binal
-				{oper = Instruction.ADD,
-				 src = dst,
-				 dst = dst,
-				 size = size})::
-			       (List.concat [comments, finish])),
-			      op ::)
-		       in
-			 SOME (Block.T
-			       {entry = entry,
-				profileLabel = profileLabel,
-				statements = statements,
-				transfer = transfer})
-		       end
-		    | SOME (i,b)
-		    => if i < (8 * Size.toBytes size)
-			 then let
-				val statements
-				  = (fn l
-				      => (Assembly.instruction_sral
-					  {oper = Instruction.SAL,
-					   count = Operand.immediate_const_int i,
-					   dst = dst,
-					   size = size})::
-				         (if b
-					    then (Assembly.instruction_unal
-						  {oper = Instruction.NEG,
-						   dst = dst,
-						   size = size})::
-					         l
-					    else l))
+                         val statements
+                           = List.fold(start, 
+                                       statements,
+                                       op ::)
+                       in
+                         SOME (Block.T
+                               {entry = entry,
+                                profileLabel = profileLabel,
+                                statements = statements,
+                                transfer = transfer})
+                       end
+                    | SOME (1,b)
+                    => let
+                         val statements
+                           = List.fold
+                             (start,
+                              (fn l
+                                => if b
+                                     then (Assembly.instruction_unal
+                                           {oper = Instruction.NEG,
+                                            dst = dst,
+                                            size = size})::
+                                          l
+                                     else l)
+                              ((Assembly.instruction_binal
+                                {oper = Instruction.ADD,
+                                 src = dst,
+                                 dst = dst,
+                                 size = size})::
+                               (List.concat [comments, finish])),
+                              op ::)
+                       in
+                         SOME (Block.T
+                               {entry = entry,
+                                profileLabel = profileLabel,
+                                statements = statements,
+                                transfer = transfer})
+                       end
+                    | SOME (i,b)
+                    => if i < (8 * Size.toBytes size)
+                         then let
+                                val statements
+                                  = (fn l
+                                      => (Assembly.instruction_sral
+                                          {oper = Instruction.SAL,
+                                           count = Operand.immediate_const_int i,
+                                           dst = dst,
+                                           size = size})::
+                                         (if b
+                                            then (Assembly.instruction_unal
+                                                  {oper = Instruction.NEG,
+                                                   dst = dst,
+                                                   size = size})::
+                                                 l
+                                            else l))
                                     (List.concat [comments, finish])
 
-				val statements
-				  = List.fold(start,
-					      statements,
-					      op ::)
-			      in
-				SOME (Block.T
-				      {entry = entry,
-				       profileLabel = profileLabel,
-				       statements = statements,
-				       transfer = transfer})
-			      end
-			 else NONE)
-	     | {entry,
-		profileLabel,
-		start, 
-		statements =
-		[[Assembly.Instruction (Instruction.pMD 
-					 {oper = Instruction.MUL, 
-					  src = Operand.Immediate immediate, 
-					  dst, 
-					  size})],
-		 comments],
-		finish, 
-		transfer}
-	     => (case getImmediateLog2 (Immediate.destruct immediate)
-		   of NONE => Error.bug "Peephole: elimMDPow2"
-		    | SOME (0,false) 
-		    => SOME (Block.T
-			     {entry = entry,
-			      profileLabel = profileLabel,
-			      statements = List.fold(start,
-						     List.concat [comments, finish],
-						     op ::),
-			      transfer = transfer})
-		    | SOME (i,false)
-		    => if i < (8 * Size.toBytes size)
-			 then let
-				val statements
-				  = (Assembly.instruction_sral
-				     {oper = Instruction.SAL,
-				      count = Operand.immediate_const_int i,
-				      dst = dst,
-				      size = size})::
-				    (List.concat [comments, finish])
+                                val statements
+                                  = List.fold(start,
+                                              statements,
+                                              op ::)
+                              in
+                                SOME (Block.T
+                                      {entry = entry,
+                                       profileLabel = profileLabel,
+                                       statements = statements,
+                                       transfer = transfer})
+                              end
+                         else NONE)
+             | {entry,
+                profileLabel,
+                start, 
+                statements =
+                [[Assembly.Instruction (Instruction.pMD 
+                                         {oper = Instruction.MUL, 
+                                          src = Operand.Immediate immediate, 
+                                          dst, 
+                                          size})],
+                 comments],
+                finish, 
+                transfer}
+             => (case getImmediateLog2 (Immediate.destruct immediate)
+                   of NONE => Error.bug "x86Simplify.PeeholeBlock: elimMDPow2:getImmediateLog2"
+                    | SOME (0,false) 
+                    => SOME (Block.T
+                             {entry = entry,
+                              profileLabel = profileLabel,
+                              statements = List.fold(start,
+                                                     List.concat [comments, finish],
+                                                     op ::),
+                              transfer = transfer})
+                    | SOME (i,false)
+                    => if i < (8 * Size.toBytes size)
+                         then let
+                                val statements
+                                  = (Assembly.instruction_sral
+                                     {oper = Instruction.SAL,
+                                      count = Operand.immediate_const_int i,
+                                      dst = dst,
+                                      size = size})::
+                                    (List.concat [comments, finish])
 
-				val statements
-				  = List.fold(start, 
-					      statements,
-					      op ::)
-			      in 
-				SOME (Block.T
-				      {entry = entry,
-				       profileLabel = profileLabel,
-				       statements = statements,
-				       transfer = transfer})
-			      end
-			 else NONE
-		    | SOME (_,true)
-		    => NONE)
-	     | {entry,
-		profileLabel,
-		start, 
-		statements =
-		[[Assembly.Instruction (Instruction.pMD
-					{oper = Instruction.IDIV,
-					 src = Operand.Immediate immediate, 
-					 dst, 
-					 size})],
-		 comments],
-		finish, 
-		transfer}
-	     => (case getImmediateLog2 (Immediate.destruct immediate)
-		   of NONE => Error.bug "Peephole: elimMDPow2"
-		    | SOME (0,false) 
-		    => SOME (Block.T
-			     {entry = entry,
-			      profileLabel = profileLabel,
-			      statements = List.fold(start,
-						     List.concat [comments, finish],
-						     op ::),
-			      transfer = transfer})
-		    | SOME (0,true)
-		    => let
-			 val statements
-			   = (Assembly.instruction_unal
-			      {oper = Instruction.NEG,
-			       dst = dst,
-			       size = size})::
-			     (List.concat [comments, finish])
+                                val statements
+                                  = List.fold(start, 
+                                              statements,
+                                              op ::)
+                              in 
+                                SOME (Block.T
+                                      {entry = entry,
+                                       profileLabel = profileLabel,
+                                       statements = statements,
+                                       transfer = transfer})
+                              end
+                         else NONE
+                    | SOME (_,true)
+                    => NONE)
+             | {entry,
+                profileLabel,
+                start, 
+                statements =
+                [[Assembly.Instruction (Instruction.pMD
+                                        {oper = Instruction.IDIV,
+                                         src = Operand.Immediate immediate, 
+                                         dst, 
+                                         size})],
+                 comments],
+                finish, 
+                transfer}
+             => (case getImmediateLog2 (Immediate.destruct immediate)
+                   of NONE => Error.bug "x86Simplify.PeeholeBlock: elimMDPow2:getImmediateLog2"
+                    | SOME (0,false) 
+                    => SOME (Block.T
+                             {entry = entry,
+                              profileLabel = profileLabel,
+                              statements = List.fold(start,
+                                                     List.concat [comments, finish],
+                                                     op ::),
+                              transfer = transfer})
+                    | SOME (0,true)
+                    => let
+                         val statements
+                           = (Assembly.instruction_unal
+                              {oper = Instruction.NEG,
+                               dst = dst,
+                               size = size})::
+                             (List.concat [comments, finish])
 
-			 val statements
-			   = List.fold(start, 
-				       statements,
-				       op ::)
-		       in
-			 SOME (Block.T
-			       {entry = entry,
-				profileLabel = profileLabel,
-				statements = statements,
-				transfer = transfer})
-		       end
-		    | SOME (i,b)
-		    => if i < (8 * Size.toBytes size)
-			 then let
-				val divTemp = Operand.MemLoc (divTemp size)
-				val width = 8 * Size.toBytes size
+                         val statements
+                           = List.fold(start, 
+                                       statements,
+                                       op ::)
+                       in
+                         SOME (Block.T
+                               {entry = entry,
+                                profileLabel = profileLabel,
+                                statements = statements,
+                                transfer = transfer})
+                       end
+                    | SOME (i,b)
+                    => if i < (8 * Size.toBytes size)
+                         then let
+                                val divTemp = Operand.MemLoc (divTemp size)
+                                val width = 8 * Size.toBytes size
 
-				val statements
-				  = ((fn l
-				       => (Assembly.instruction_mov
-					   {src = dst,
-					    dst = divTemp,
-					    size = size})::
-				          l) o
-				     (fn l
-				       => if i > 1
-					    then (Assembly.instruction_sral
-						  {oper = Instruction.SAR,
-						   dst = divTemp,
-						   count 
-						   = Operand.immediate_const_int 
-						     (i - 1),
-						   size = size})::
-					         l
-					    else l) o
-				     (fn l
-				       => if i < width
-					    then (Assembly.instruction_sral
-						  {oper = Instruction.SHR,
-						   dst = divTemp,
-						   count 
-						   = Operand.immediate_const_int 
-						     (width - i),
-						   size = size})::
-					         l
-					    else l) o
-				     (fn l
-				       => (Assembly.instruction_binal
-					   {oper = Instruction.ADD,
-					    src = divTemp,
-					    dst = dst,
-					    size = size})::
-					  (Assembly.instruction_sral
-					   {oper = Instruction.SAR,
-					    count = Operand.immediate_const_int i,
-					    dst = dst,
-					    size = size})::
-					  l) o
-				     (fn l
-				       => if b
-					    then (Assembly.instruction_unal
-						  {oper = Instruction.NEG,
-						   dst = dst,
-						   size = size})::
-					          l
-					     else l))
-				    (List.concat [comments, finish])
+                                val statements
+                                  = ((fn l
+                                       => (Assembly.instruction_mov
+                                           {src = dst,
+                                            dst = divTemp,
+                                            size = size})::
+                                          l) o
+                                     (fn l
+                                       => if i > 1
+                                            then (Assembly.instruction_sral
+                                                  {oper = Instruction.SAR,
+                                                   dst = divTemp,
+                                                   count 
+                                                   = Operand.immediate_const_int 
+                                                     (i - 1),
+                                                   size = size})::
+                                                 l
+                                            else l) o
+                                     (fn l
+                                       => if i < width
+                                            then (Assembly.instruction_sral
+                                                  {oper = Instruction.SHR,
+                                                   dst = divTemp,
+                                                   count 
+                                                   = Operand.immediate_const_int 
+                                                     (width - i),
+                                                   size = size})::
+                                                 l
+                                            else l) o
+                                     (fn l
+                                       => (Assembly.instruction_binal
+                                           {oper = Instruction.ADD,
+                                            src = divTemp,
+                                            dst = dst,
+                                            size = size})::
+                                          (Assembly.instruction_sral
+                                           {oper = Instruction.SAR,
+                                            count = Operand.immediate_const_int i,
+                                            dst = dst,
+                                            size = size})::
+                                          l) o
+                                     (fn l
+                                       => if b
+                                            then (Assembly.instruction_unal
+                                                  {oper = Instruction.NEG,
+                                                   dst = dst,
+                                                   size = size})::
+                                                  l
+                                             else l))
+                                    (List.concat [comments, finish])
 
-				val statements
-				  = List.fold(start,
-					      statements,
-					      op ::)
-			      in 
-				SOME (Block.T
-				      {entry = entry,
-				       profileLabel = profileLabel,
-				       statements = statements,
-				       transfer = transfer})
-			      end
-			 else NONE)
-	     | {entry,
-		profileLabel,
-		start, 
-		statements =
-		[[Assembly.Instruction (Instruction.pMD
-					{oper = Instruction.DIV,
-					 src = Operand.Immediate immediate, 
-					 dst, 
-					 size})],
-		 comments],
-		finish, 
-		transfer}
-	     => (case getImmediateLog2 (Immediate.destruct immediate)
-		   of NONE => Error.bug "Peephole: elimMDPow2"
-		    | SOME (0,false) 
-		    => SOME (Block.T
-			     {entry = entry,
-			      profileLabel = profileLabel,
-			      statements = List.fold(start,
-						     List.concat [comments, finish],
-						     op ::),
-			      transfer = transfer})
-		    | SOME (i,false)
-		    => if i < (8 * Size.toBytes size)
-			 then let
-				val statements
-				  = (Assembly.instruction_sral
-				     {oper = Instruction.SHR,
-				      count = Operand.immediate_const_int i,
-				      dst = dst,
-				      size = size})::
-				    (List.concat [comments, finish])
+                                val statements
+                                  = List.fold(start,
+                                              statements,
+                                              op ::)
+                              in 
+                                SOME (Block.T
+                                      {entry = entry,
+                                       profileLabel = profileLabel,
+                                       statements = statements,
+                                       transfer = transfer})
+                              end
+                         else NONE)
+             | {entry,
+                profileLabel,
+                start, 
+                statements =
+                [[Assembly.Instruction (Instruction.pMD
+                                        {oper = Instruction.DIV,
+                                         src = Operand.Immediate immediate, 
+                                         dst, 
+                                         size})],
+                 comments],
+                finish, 
+                transfer}
+             => (case getImmediateLog2 (Immediate.destruct immediate)
+                   of NONE => Error.bug "x86Simplify.PeeholeBlock: elimMDPow2:getImmediateLog2"
+                    | SOME (0,false) 
+                    => SOME (Block.T
+                             {entry = entry,
+                              profileLabel = profileLabel,
+                              statements = List.fold(start,
+                                                     List.concat [comments, finish],
+                                                     op ::),
+                              transfer = transfer})
+                    | SOME (i,false)
+                    => if i < (8 * Size.toBytes size)
+                         then let
+                                val statements
+                                  = (Assembly.instruction_sral
+                                     {oper = Instruction.SHR,
+                                      count = Operand.immediate_const_int i,
+                                      dst = dst,
+                                      size = size})::
+                                    (List.concat [comments, finish])
 
-				val statements
-				  = List.fold(start,
-					      statements,
-					      op ::)
-			      in 
-				SOME (Block.T
-				      {entry = entry,
-				       profileLabel = profileLabel,
-				       statements = statements,
-				       transfer = transfer})
-			      end
-			 else NONE
-	            | SOME (_,true) => NONE)
-	     | {entry,
-		profileLabel,
-		start, 
-		statements =
-		[[Assembly.Instruction (Instruction.IMUL2
-					{src = Operand.Immediate immediate, 
-					 dst, 
-					 size})],
-		 comments],
-		finish = [], 
-		transfer as Transfer.Iff {condition,
-					  truee,
-					  falsee}}
-	     => (case getImmediateLog2 (Immediate.destruct immediate)
-		   of NONE => Error.bug "Peephole: elimMDPow2"
-		    | SOME (0,false)
-		    => let
-			 val transfer
-			   = case condition
-			       of Instruction.O 
-				=> Transfer.Goto {target = falsee}
-				| Instruction.NO 
-				=> Transfer.Goto {target = truee}
-				| _ => Error.bug "Peephole: elimMDPow2"
-				 
-			 val statements
-			   = List.fold(start,
-				       comments,
-				       op ::)
-		       in
-			 SOME (Block.T
-			       {entry = entry,
-				profileLabel = profileLabel,
-				statements = statements,
-				transfer = transfer})
-		       end
-		    | SOME (0,true)
-		    => let
-			 val statements
-			   = List.fold
-			     (start,
-			      (Assembly.instruction_unal
-			       {oper = Instruction.NEG,
-				dst = dst,
-				size = size})::
-			      comments,
-			      op ::)
-		       in 
-			 SOME (Block.T
-			       {entry = entry,
-				profileLabel = profileLabel,
-				statements = statements,
-				transfer = transfer})
-		       end
-		    | SOME (1,b)
-		    => let
-			 val statements
-			   = List.fold
-			     (start,
-			      (fn l
-			        => if b
-				     then (Assembly.instruction_unal
-					   {oper = Instruction.NEG,
-					    dst = dst,
-					    size = size})::
-				          l
-				     else l)
-			      ((Assembly.instruction_binal
-				{oper = Instruction.ADD,
-				 src = dst,
-				 dst = dst,
-				 size = size})::
-			       comments),
-			      op ::)
-		       in
-			 SOME (Block.T
-			       {entry = entry,
-				profileLabel = profileLabel,
-				statements = statements,
-				transfer = transfer})
-		       end
-		    | _ => NONE)
-	     | {entry,
-		profileLabel,
-		start, 
-		statements =
-		[[Assembly.Instruction (Instruction.IMUL2
-					{src = Operand.Immediate immediate, 
-					 dst, 
-					 size})],
-		 comments],
-		finish, 
-		transfer}
-	     => (case getImmediateLog2 (Immediate.destruct immediate)
-		   of NONE => Error.bug "Peephole: elimMDPow2"
-		    | SOME (0,false) 
-		    => SOME (Block.T
-			     {entry = entry,
-			      profileLabel = profileLabel,
-			      statements = List.fold(start,
-						     List.concat [comments, finish],
-						     op ::),
-			      transfer = transfer})
-		    | SOME (0,true)
-		    => let
-			 val statements
-			   = (Assembly.instruction_unal
-			      {oper = Instruction.NEG,
-			       dst = dst,
-			       size = size})::
-			     (List.concat [comments, finish])
+                                val statements
+                                  = List.fold(start,
+                                              statements,
+                                              op ::)
+                              in 
+                                SOME (Block.T
+                                      {entry = entry,
+                                       profileLabel = profileLabel,
+                                       statements = statements,
+                                       transfer = transfer})
+                              end
+                         else NONE
+                    | SOME (_,true) => NONE)
+             | {entry,
+                profileLabel,
+                start, 
+                statements =
+                [[Assembly.Instruction (Instruction.IMUL2
+                                        {src = Operand.Immediate immediate, 
+                                         dst, 
+                                         size})],
+                 comments],
+                finish = [], 
+                transfer as Transfer.Iff {condition,
+                                          truee,
+                                          falsee}}
+             => (case getImmediateLog2 (Immediate.destruct immediate)
+                   of NONE => Error.bug "x86Simplify.PeeholeBlock: elimMDPow2:getImmediateLog2"
+                    | SOME (0,false)
+                    => let
+                         val transfer
+                           = case condition
+                               of Instruction.O 
+                                => Transfer.Goto {target = falsee}
+                                | Instruction.NO 
+                                => Transfer.Goto {target = truee}
+                                | _ => Error.bug "x86Simplify.PeeholeBlock: elimMDPow2:transfer"
+                                 
+                         val statements
+                           = List.fold(start,
+                                       comments,
+                                       op ::)
+                       in
+                         SOME (Block.T
+                               {entry = entry,
+                                profileLabel = profileLabel,
+                                statements = statements,
+                                transfer = transfer})
+                       end
+                    | SOME (0,true)
+                    => let
+                         val statements
+                           = List.fold
+                             (start,
+                              (Assembly.instruction_unal
+                               {oper = Instruction.NEG,
+                                dst = dst,
+                                size = size})::
+                              comments,
+                              op ::)
+                       in 
+                         SOME (Block.T
+                               {entry = entry,
+                                profileLabel = profileLabel,
+                                statements = statements,
+                                transfer = transfer})
+                       end
+                    | SOME (1,b)
+                    => let
+                         val statements
+                           = List.fold
+                             (start,
+                              (fn l
+                                => if b
+                                     then (Assembly.instruction_unal
+                                           {oper = Instruction.NEG,
+                                            dst = dst,
+                                            size = size})::
+                                          l
+                                     else l)
+                              ((Assembly.instruction_binal
+                                {oper = Instruction.ADD,
+                                 src = dst,
+                                 dst = dst,
+                                 size = size})::
+                               comments),
+                              op ::)
+                       in
+                         SOME (Block.T
+                               {entry = entry,
+                                profileLabel = profileLabel,
+                                statements = statements,
+                                transfer = transfer})
+                       end
+                    | _ => NONE)
+             | {entry,
+                profileLabel,
+                start, 
+                statements =
+                [[Assembly.Instruction (Instruction.IMUL2
+                                        {src = Operand.Immediate immediate, 
+                                         dst, 
+                                         size})],
+                 comments],
+                finish, 
+                transfer}
+             => (case getImmediateLog2 (Immediate.destruct immediate)
+                   of NONE => Error.bug "x86Simplify.PeeholeBlock: elimMDPow2:getImmediateLog2"
+                    | SOME (0,false) 
+                    => SOME (Block.T
+                             {entry = entry,
+                              profileLabel = profileLabel,
+                              statements = List.fold(start,
+                                                     List.concat [comments, finish],
+                                                     op ::),
+                              transfer = transfer})
+                    | SOME (0,true)
+                    => let
+                         val statements
+                           = (Assembly.instruction_unal
+                              {oper = Instruction.NEG,
+                               dst = dst,
+                               size = size})::
+                             (List.concat [comments, finish])
 
-			 val statements
-			   = List.fold(start, 
-				       statements,
-				       op ::)
-		       in
-			 SOME (Block.T
-			       {entry = entry,
-				profileLabel = profileLabel,
-				statements = statements,
-				transfer = transfer})
-		       end
-		    | SOME (1,b)
-		    => let
-			 val statements
-			   = List.fold
-			     (start,
-			      (fn l
-			        => if b
-				     then (Assembly.instruction_unal
-					   {oper = Instruction.NEG,
-					    dst = dst,
-					    size = size})::
-				          l
-				     else l)
-			      ((Assembly.instruction_binal
-				{oper = Instruction.ADD,
-				 src = dst,
-				 dst = dst,
-				 size = size})::
-			       (List.concat [comments, finish])),
-			      op ::)
-		       in
-			 SOME (Block.T
-			       {entry = entry,
-				profileLabel = profileLabel,
-				statements = statements,
-				transfer = transfer})
-		       end
-		    | SOME (i,b)
-		    => if i < (8 * Size.toBytes size)
-			 then let
-				val statements
-				  = (fn l
-				      => (Assembly.instruction_sral
-					  {oper = Instruction.SAL,
-					   count = Operand.immediate_const_int i,
-					   dst = dst,
-					   size = size})::
-				         (if b
-					    then (Assembly.instruction_unal
-						  {oper = Instruction.NEG,
-						   dst = dst,
-						   size = size})::
-					         l
-					    else l))
+                         val statements
+                           = List.fold(start, 
+                                       statements,
+                                       op ::)
+                       in
+                         SOME (Block.T
+                               {entry = entry,
+                                profileLabel = profileLabel,
+                                statements = statements,
+                                transfer = transfer})
+                       end
+                    | SOME (1,b)
+                    => let
+                         val statements
+                           = List.fold
+                             (start,
+                              (fn l
+                                => if b
+                                     then (Assembly.instruction_unal
+                                           {oper = Instruction.NEG,
+                                            dst = dst,
+                                            size = size})::
+                                          l
+                                     else l)
+                              ((Assembly.instruction_binal
+                                {oper = Instruction.ADD,
+                                 src = dst,
+                                 dst = dst,
+                                 size = size})::
+                               (List.concat [comments, finish])),
+                              op ::)
+                       in
+                         SOME (Block.T
+                               {entry = entry,
+                                profileLabel = profileLabel,
+                                statements = statements,
+                                transfer = transfer})
+                       end
+                    | SOME (i,b)
+                    => if i < (8 * Size.toBytes size)
+                         then let
+                                val statements
+                                  = (fn l
+                                      => (Assembly.instruction_sral
+                                          {oper = Instruction.SAL,
+                                           count = Operand.immediate_const_int i,
+                                           dst = dst,
+                                           size = size})::
+                                         (if b
+                                            then (Assembly.instruction_unal
+                                                  {oper = Instruction.NEG,
+                                                   dst = dst,
+                                                   size = size})::
+                                                 l
+                                            else l))
                                     (List.concat [comments, finish])
 
-				val statements
-				  = List.fold(start,
-					      statements,
-					      op ::)
-			      in
-				SOME (Block.T
-				      {entry = entry,
-				       profileLabel = profileLabel,
-				       statements = statements,
-				       transfer = transfer})
-			      end
-			 else NONE)
- 	     | _ => Error.bug "Peephole: elimMDPow2"
+                                val statements
+                                  = List.fold(start,
+                                              statements,
+                                              op ::)
+                              in
+                                SOME (Block.T
+                                      {entry = entry,
+                                       profileLabel = profileLabel,
+                                       statements = statements,
+                                       transfer = transfer})
+                              end
+                         else NONE)
+             | _ => Error.bug "x86Simplify.PeeholeBlock: elimMDPow2"
 
-	val (callback,elimMDPow2_msg) 
-	  = make_callback_msg "elimMDPow2"
+        val (callback,elimMDPow2_msg) 
+          = make_callback_msg "elimMDPow2"
       in
-	val elimMDPow2 : optimization
-	  = {template = template,
-	     rewriter = rewriter,
-	     callback = callback}
-	val elimMDPow2_msg = elimMDPow2_msg
+        val elimMDPow2 : optimization
+          = {template = template,
+             rewriter = rewriter,
+             callback = callback}
+        val elimMDPow2_msg = elimMDPow2_msg
       end  
 
       local
-	val isInstructionCMPorTEST : statement_type -> bool
-	  = fn Assembly.Instruction (Instruction.CMP _)
-	     => true
-	     | Assembly.Instruction (Instruction.TEST _)
-	     => true
-	     | _ => false
+        val isInstructionCMPorTEST : statement_type -> bool
+          = fn Assembly.Instruction (Instruction.CMP _)
+             => true
+             | Assembly.Instruction (Instruction.TEST _)
+             => true
+             | _ => false
 
-	val isInstructionMOV : statement_type -> bool
-	  = fn Assembly.Instruction (Instruction.MOV _)
-	     => true
-	     | _ => false
+        val isInstructionMOV : statement_type -> bool
+          = fn Assembly.Instruction (Instruction.MOV _)
+             => true
+             | _ => false
 
-	val isInstructionSETcc : statement_type -> bool
-	  = fn Assembly.Instruction (Instruction.SETcc _)
-	     => true
-	     | _ => false
+        val isInstructionSETcc : statement_type -> bool
+          = fn Assembly.Instruction (Instruction.SETcc _)
+             => true
+             | _ => false
 
-	val isInstruction : statement_type -> bool
-	  = fn Assembly.Instruction _
-	     => true
-	     | _ => false
+        val isInstruction : statement_type -> bool
+          = fn Assembly.Instruction _
+             => true
+             | _ => false
 
-	val isTransfer_Iff : transfer_type -> bool
-	  = fn Transfer.Iff _
-	     => true
-	     | _ => false
+        val isTransfer_Iff : transfer_type -> bool
+          = fn Transfer.Iff _
+             => true
+             | _ => false
 
-	val template 
-	  = {start = EmptyOrNonEmpty,
-	     statements = [One isInstructionCMPorTEST,
-			   All isComment],
-	     finish = EmptyOrNonEmpty,
-	     transfer = fn _ => true}
+        val template 
+          = {start = EmptyOrNonEmpty,
+             statements = [One isInstructionCMPorTEST,
+                           All isComment],
+             finish = EmptyOrNonEmpty,
+             transfer = fn _ => true}
 
-	val rewriter 
-	  = fn {entry,
-		profileLabel,
-		start, 
-		statements =
-		[[Assembly.Instruction _],
-		 comments],
-		finish,
-		transfer}
-	     => let
-		  val rec scan 
-		    = fn [] => not (isTransfer_Iff transfer)
-		       | asm::statements
-		       => if isComment asm
-		             orelse 
-			     isInstructionMOV asm
-			    then scan statements
-			  else if isInstructionSETcc asm
-			    then false
-			  else if isInstruction asm
-			    then true
-			  else false
-		in
-		  if scan finish
-		    then let
-			  val statements 
-			    = List.fold(start, 
-					List.concat [comments, finish],
-					op ::)
-			 in
-			   SOME (Block.T {entry = entry,
-					  profileLabel = profileLabel,
-					  statements = statements,
-					  transfer = transfer})
-			 end
-		    else NONE
-		end
-	     | _ => Error.bug "elimCMPTEST"
+        val rewriter 
+          = fn {entry,
+                profileLabel,
+                start, 
+                statements =
+                [[Assembly.Instruction _],
+                 comments],
+                finish,
+                transfer}
+             => let
+                  val rec scan 
+                    = fn [] => not (isTransfer_Iff transfer)
+                       | asm::statements
+                       => if isComment asm
+                             orelse 
+                             isInstructionMOV asm
+                            then scan statements
+                          else if isInstructionSETcc asm
+                            then false
+                          else if isInstruction asm
+                            then true
+                          else false
+                in
+                  if scan finish
+                    then let
+                          val statements 
+                            = List.fold(start, 
+                                        List.concat [comments, finish],
+                                        op ::)
+                         in
+                           SOME (Block.T {entry = entry,
+                                          profileLabel = profileLabel,
+                                          statements = statements,
+                                          transfer = transfer})
+                         end
+                    else NONE
+                end
+             | _ => Error.bug "x86Simplify.PeeholeBlock: elimCMPTEST"
 
-	val (callback,elimCMPTEST_msg) 
-	  = make_callback_msg "elimCMPTEST"
+        val (callback,elimCMPTEST_msg) 
+          = make_callback_msg "elimCMPTEST"
       in
-	val elimCMPTEST : optimization
-	  = {template = template,
-	     rewriter = rewriter,
-	     callback = callback}
-	val elimCMPTEST_msg = elimCMPTEST_msg
+        val elimCMPTEST : optimization
+          = {template = template,
+             rewriter = rewriter,
+             callback = callback}
+        val elimCMPTEST_msg = elimCMPTEST_msg
       end
 
       local
-	val isInstructionCMP_srcImmediate0
-	  = fn Assembly.Instruction (Instruction.CMP
-				     {src1 = Operand.Immediate immediate,
-				      ...})
-	     => Immediate.zero immediate
-	     | Assembly.Instruction (Instruction.CMP
-				     {src2 = Operand.Immediate immediate,
-				      ...})
-	     => Immediate.zero immediate
-	     | _ => false
+        val isInstructionCMP_srcImmediate0
+          = fn Assembly.Instruction (Instruction.CMP
+                                     {src1 = Operand.Immediate immediate,
+                                      ...})
+             => Immediate.zero immediate
+             | Assembly.Instruction (Instruction.CMP
+                                     {src2 = Operand.Immediate immediate,
+                                      ...})
+             => Immediate.zero immediate
+             | _ => false
 
-	val isTransfer_Iff_E_NE
-	  = fn Transfer.Iff {condition, ...}
-	     => condition = Instruction.E
-	        orelse
-		condition = Instruction.NE
-	     | _ => false
+        val isTransfer_Iff_E_NE
+          = fn Transfer.Iff {condition, ...}
+             => condition = Instruction.E
+                orelse
+                condition = Instruction.NE
+             | _ => false
 
-	val template 
-	  = {start = EmptyOrNonEmpty,
-	     statements = [One isInstructionCMP_srcImmediate0,
-			   All isComment],
-	     finish = Empty,
-	     transfer = isTransfer_Iff_E_NE}
+        val template 
+          = {start = EmptyOrNonEmpty,
+             statements = [One isInstructionCMP_srcImmediate0,
+                           All isComment],
+             finish = Empty,
+             transfer = isTransfer_Iff_E_NE}
 
-	val rewriter 
-	  = fn {entry,
-		profileLabel,
-		start, 
-		statements =
-		[[Assembly.Instruction
-		  (Instruction.CMP {src1, src2, size})],
-		 comments],
-		finish = [],
-		transfer = Transfer.Iff {condition, truee, falsee}}
-	     => let
-		  val condition
-		    = case condition
-			of Instruction.E => Instruction.Z
-			 | Instruction.NE => Instruction.NZ
-			 | _ => Error.bug "Peephole: elimCMP0"
+        val rewriter 
+          = fn {entry,
+                profileLabel,
+                start, 
+                statements =
+                [[Assembly.Instruction
+                  (Instruction.CMP {src1, src2, size})],
+                 comments],
+                finish = [],
+                transfer = Transfer.Iff {condition, truee, falsee}}
+             => let
+                  val condition
+                    = case condition
+                        of Instruction.E => Instruction.Z
+                         | Instruction.NE => Instruction.NZ
+                         | _ => Error.bug "x86Simplify.PeeholeBlock: elimCMP0:condition"
 
-		  val src
-		    = case (Operand.deImmediate src1, 
-			    Operand.deImmediate src2)
-			of (SOME _, NONE) => src2
-			 | (NONE, SOME _) => src1
-			 | (SOME immediate1, SOME _)
-			 => if Immediate.zero immediate1
-			      then src2
-			      else src1
-			 | _ => Error.bug "Peephole: elimCMP0"
+                  val src
+                    = case (Operand.deImmediate src1, 
+                            Operand.deImmediate src2)
+                        of (SOME _, NONE) => src2
+                         | (NONE, SOME _) => src1
+                         | (SOME immediate1, SOME _)
+                         => if Immediate.zero immediate1
+                              then src2
+                              else src1
+                         | _ => Error.bug "x86Simplify.PeeholeBlock: elimCMP0:src"
 
-		  val statements 
-		    = List.fold(start, 
-				(Assembly.instruction_test
-				 {src1 = src,
-				  src2 = src,
-				  size = size})::
-				comments,
-				op ::)
+                  val statements 
+                    = List.fold(start, 
+                                (Assembly.instruction_test
+                                 {src1 = src,
+                                  src2 = src,
+                                  size = size})::
+                                comments,
+                                op ::)
 
-		  val transfer
-		    = Transfer.Iff {condition = condition,
-				    truee = truee,
-				    falsee = falsee}
-		in 
-		  SOME (Block.T {entry = entry,
-				 profileLabel = profileLabel,
-				 statements = statements,
-				 transfer = transfer})
-		end
-	     | _ => Error.bug "elimCMP0"
+                  val transfer
+                    = Transfer.Iff {condition = condition,
+                                    truee = truee,
+                                    falsee = falsee}
+                in 
+                  SOME (Block.T {entry = entry,
+                                 profileLabel = profileLabel,
+                                 statements = statements,
+                                 transfer = transfer})
+                end
+             | _ => Error.bug "x86Simplify.PeeholeBlock: elimCMP0"
 
-	val (callback,elimCMP0_msg) 
-	  = make_callback_msg "elimCMP0"
+        val (callback,elimCMP0_msg) 
+          = make_callback_msg "elimCMP0"
       in
-	val elimCMP0 : optimization
-	  = {template = template,
-	     rewriter = rewriter,
-	     callback = callback}
-	val elimCMP0_msg = elimCMP0_msg
+        val elimCMP0 : optimization
+          = {template = template,
+             rewriter = rewriter,
+             callback = callback}
+        val elimCMP0_msg = elimCMP0_msg
       end
 
       local
-	val isInstructionAL_setZF
-	  = fn Assembly.Instruction (Instruction.BinAL _)
-	     => true
-	     | Assembly.Instruction (Instruction.UnAL {oper, ...})
-	     => (case oper
-		   of Instruction.NOT => false
-		    | _ => true)
-	     | Assembly.Instruction (Instruction.SRAL {oper, ...})
-	     => (case oper
-		   of Instruction.ROL => false
-		    | Instruction.RCL => false
-		    | Instruction.ROR => false
-		    | Instruction.RCR => false
-		    | _ => true)
-	     | _ => false
+        val isInstructionAL_setZF
+          = fn Assembly.Instruction (Instruction.BinAL _)
+             => true
+             | Assembly.Instruction (Instruction.UnAL {oper, ...})
+             => (case oper
+                   of Instruction.NOT => false
+                    | _ => true)
+             | Assembly.Instruction (Instruction.SRAL {oper, ...})
+             => (case oper
+                   of Instruction.ROL => false
+                    | Instruction.RCL => false
+                    | Instruction.ROR => false
+                    | Instruction.RCR => false
+                    | _ => true)
+             | _ => false
 
-	val isInstructionTEST_eqSrcs
-	  = fn Assembly.Instruction (Instruction.TEST {src1, src2, ...})
-	     => Operand.eq(src1, src2)
-	     | _ => false
+        val isInstructionTEST_eqSrcs
+          = fn Assembly.Instruction (Instruction.TEST {src1, src2, ...})
+             => Operand.eq(src1, src2)
+             | _ => false
 
-	val isTransfer_Iff_Z_NZ
-	  = fn Transfer.Iff {condition, ...}
-	     => condition = Instruction.Z
-	        orelse
-		condition = Instruction.NZ
-	     | _ => false
+        val isTransfer_Iff_Z_NZ
+          = fn Transfer.Iff {condition, ...}
+             => condition = Instruction.Z
+                orelse
+                condition = Instruction.NZ
+             | _ => false
 
-	val template 
-	  = {start = EmptyOrNonEmpty,
-	     statements = [One isInstructionAL_setZF,
-			   All isComment,
-			   One isInstructionTEST_eqSrcs,
-			   All isComment],
-	     finish = Empty,
-	     transfer = isTransfer_Iff_Z_NZ}
+        val template 
+          = {start = EmptyOrNonEmpty,
+             statements = [One isInstructionAL_setZF,
+                           All isComment,
+                           One isInstructionTEST_eqSrcs,
+                           All isComment],
+             finish = Empty,
+             transfer = isTransfer_Iff_Z_NZ}
 
-	val rewriter 
-	  = fn {entry,
-		profileLabel,
-		start, 
-		statements =
-		[[Assembly.Instruction instruction],
-		 comments1,
-		 [Assembly.Instruction
-		  (Instruction.TEST {src1, ...})],
-		 comments2],
-		finish = [],
-		transfer as Transfer.Iff {...}}
-	     => let
-		  val dst
-		    = case instruction
-			of Instruction.BinAL {dst, ...} => dst
-			 | Instruction.UnAL {dst, ...} => dst
-			 | Instruction.SRAL {dst, ...} => dst
-			 | _ => Error.bug "elimALTEST"
-		in
-		  if Operand.eq(dst,src1)
-		    then let
-			   val statements
-			     = List.fold
-			       (start,
-				(Assembly.instruction instruction)::
-				(List.concat [comments1, comments2]),
-				op ::)
-			 in
-			   SOME (Block.T {entry = entry,
-					  profileLabel = profileLabel,
-					  statements = statements,
-					  transfer = transfer})
-			 end
-		    else NONE
-		end
-	     | _ => Error.bug "elimALTEST"
+        val rewriter 
+          = fn {entry,
+                profileLabel,
+                start, 
+                statements =
+                [[Assembly.Instruction instruction],
+                 comments1,
+                 [Assembly.Instruction
+                  (Instruction.TEST {src1, ...})],
+                 comments2],
+                finish = [],
+                transfer as Transfer.Iff {...}}
+             => let
+                  val dst
+                    = case instruction
+                        of Instruction.BinAL {dst, ...} => dst
+                         | Instruction.UnAL {dst, ...} => dst
+                         | Instruction.SRAL {dst, ...} => dst
+                         | _ => Error.bug "x86Simplify.PeeholeBlock: elimALTEST:dst"
+                in
+                  if Operand.eq(dst,src1)
+                    then let
+                           val statements
+                             = List.fold
+                               (start,
+                                (Assembly.instruction instruction)::
+                                (List.concat [comments1, comments2]),
+                                op ::)
+                         in
+                           SOME (Block.T {entry = entry,
+                                          profileLabel = profileLabel,
+                                          statements = statements,
+                                          transfer = transfer})
+                         end
+                    else NONE
+                end
+             | _ => Error.bug "x86Simplify.PeeholeBlock: elimALTEST"
 
-	val (callback,elimALTEST_msg) 
-	  = make_callback_msg "elimALTEST"
+        val (callback,elimALTEST_msg) 
+          = make_callback_msg "elimALTEST"
       in
-	val elimALTEST : optimization
-	  = {template = template,
-	     rewriter = rewriter,
-	     callback = callback}
-	val elimALTEST_msg = elimALTEST_msg
+        val elimALTEST : optimization
+          = {template = template,
+             rewriter = rewriter,
+             callback = callback}
+        val elimALTEST_msg = elimALTEST_msg
       end
 
       local
-	val optimizations_pre
-	  = commuteBinALMD::
-(*	    elimBinAL0L:: *)
-(*	    elimBinAL0R:: *)
-	    elimAddSub1::
-	    elimMDPow2::
-	    elimCMPTEST::
-	    nil
-	val optimizations_pre_msg
-	  = commuteBinALMD_msg::
-(*	    elimBinAL0L_msg:: *)
-(*	    elimBinAL0R_msg:: *)
-	    elimAddSub1_msg::
-	    elimMDPow2_msg::
-	    nil
+        val optimizations_pre
+          = commuteBinALMD::
+(*          elimBinAL0L:: *)
+(*          elimBinAL0R:: *)
+            elimAddSub1::
+            elimMDPow2::
+            elimCMPTEST::
+            nil
+        val optimizations_pre_msg
+          = commuteBinALMD_msg::
+(*          elimBinAL0L_msg:: *)
+(*          elimBinAL0R_msg:: *)
+            elimAddSub1_msg::
+            elimMDPow2_msg::
+            nil
 
-	val optimizations_post
-	  = elimBinALMDDouble::
-	    elimFltBinADouble::
-	    elimCMPTEST::
-	    elimCMP0::
-	    elimALTEST::
-	    nil
-	val optimizations_post_msg
-	  = elimBinALMDDouble_msg::
-	    elimFltBinADouble_msg::
-	    elimCMPTEST_msg::
-	    elimCMP0_msg::
-	    elimALTEST_msg::
-	    nil
+        val optimizations_post
+          = elimBinALMDDouble::
+            elimFltBinADouble::
+            elimCMPTEST::
+            elimCMP0::
+            elimALTEST::
+            nil
+        val optimizations_post_msg
+          = elimBinALMDDouble_msg::
+            elimFltBinADouble_msg::
+            elimCMPTEST_msg::
+            elimCMP0_msg::
+            elimALTEST_msg::
+            nil
       in
-	val peepholeBlock_pre
-	  = fn block => (peepholeBlock {optimizations = optimizations_pre,
-				       block = block}
-			 handle exn
-			  => (print "\n\n***** raising in peepholeBlock_pre\n";
-			      Block.printBlock block;
-			      raise exn))
-	val (peepholeBlock_pre, peepholeBlock_pre_msg)
-	  = tracer
-	    "peepholeBlock_pre"
-	    peepholeBlock_pre
+        val peepholeBlock_pre
+          = fn block => (peepholeBlock {optimizations = optimizations_pre,
+                                       block = block})
+        val (peepholeBlock_pre, peepholeBlock_pre_msg)
+          = tracer
+            "peepholeBlock_pre"
+            peepholeBlock_pre
 
-	val peepholeBlock_pre_msg
-	  = fn () => (peepholeBlock_pre_msg ();
-		      Control.indent ();
-		      List.foreach(optimizations_pre_msg, fn msg => msg ());
-		      Control.unindent ())
+        val peepholeBlock_pre_msg
+          = fn () => (peepholeBlock_pre_msg ();
+                      Control.indent ();
+                      List.foreach(optimizations_pre_msg, fn msg => msg ());
+                      Control.unindent ())
 
-	val peepholeBlock_post
-	  = fn block => (peepholeBlock {optimizations = optimizations_post,
-				       block = block}
-			 handle exn
-			 => (print "\n\n***** raising in peepholeBlock_post\n";
-			     Block.printBlock block;
-			     raise exn))
-	val (peepholeBlock_post, peepholeBlock_post_msg)
-	  = tracer
-	    "peepholeBlock_post"
-	    peepholeBlock_post
+        val peepholeBlock_post
+          = fn block => (peepholeBlock {optimizations = optimizations_post,
+                                       block = block})
+        val (peepholeBlock_post, peepholeBlock_post_msg)
+          = tracer
+            "peepholeBlock_post"
+            peepholeBlock_post
 
-	val peepholeBlock_post_msg
-	  = fn () => (peepholeBlock_post_msg ();
-		      Control.indent ();
-		      List.foreach(optimizations_post_msg, fn msg => msg ());
-		      Control.unindent ())
+        val peepholeBlock_post_msg
+          = fn () => (peepholeBlock_post_msg ();
+                      Control.indent ();
+                      List.foreach(optimizations_post_msg, fn msg => msg ());
+                      Control.unindent ())
       end
 
       val (callback_elimIff,elimIff_msg)
-	= make_callback_msg "elimIff"
+        = make_callback_msg "elimIff"
       fun makeElimIff {jumpInfo : x86JumpInfo.t} :
-	              optimization
-	= let
-	    val isTransferIff_eqTargets
-	      = fn Transfer.Iff {truee, falsee, ...}
-	         => Label.equals(truee, falsee)
-	         | _ => false
+                      optimization
+        = let
+            val isTransferIff_eqTargets
+              = fn Transfer.Iff {truee, falsee, ...}
+                 => Label.equals(truee, falsee)
+                 | _ => false
 
-	    val template 
-	      = {start = EmptyOrNonEmpty,
-		 statements = [],
-		 finish = Empty,
-		 transfer = isTransferIff_eqTargets}
+            val template 
+              = {start = EmptyOrNonEmpty,
+                 statements = [],
+                 finish = Empty,
+                 transfer = isTransferIff_eqTargets}
 
-	    val rewriter 
-	      = fn {entry,
-		    profileLabel,
-		    start, 
-		    statements = [],
-		    finish = [],
-		    transfer = Transfer.Iff {truee, falsee, ...}}
-	         => let
-		      val _ = x86JumpInfo.decNear(jumpInfo, falsee)
-			
-		      val statements 
-			= List.fold(start, 
-				    [],
-				    op ::)
-			
-		      val transfer = Transfer.goto {target = truee}
-		    in 
-		      SOME (Block.T {entry = entry,
-				     profileLabel = profileLabel,
-				     statements = statements,
-				     transfer = transfer})
-		    end
-	         | _ => Error.bug "elimIff"
-	  in
-	    {template = template,
-	     rewriter = rewriter,
-	     callback = callback_elimIff}
-	  end
+            val rewriter 
+              = fn {entry,
+                    profileLabel,
+                    start, 
+                    statements = [],
+                    finish = [],
+                    transfer = Transfer.Iff {truee, falsee, ...}}
+                 => let
+                      val _ = x86JumpInfo.decNear(jumpInfo, falsee)
+                        
+                      val statements 
+                        = List.fold(start, 
+                                    [],
+                                    op ::)
+                        
+                      val transfer = Transfer.goto {target = truee}
+                    in 
+                      SOME (Block.T {entry = entry,
+                                     profileLabel = profileLabel,
+                                     statements = statements,
+                                     transfer = transfer})
+                    end
+                 | _ => Error.bug "x86Simplify.PeeholeBlock: elimIff"
+          in
+            {template = template,
+             rewriter = rewriter,
+             callback = callback_elimIff}
+          end
 
       val (callback_elimSwitchTest,elimSwitchTest_msg)
-	= make_callback_msg "elimSwitchTest"
+        = make_callback_msg "elimSwitchTest"
       fun makeElimSwitchTest {jumpInfo : x86JumpInfo.t} :
-	                     optimization
-	= let
-	    val isTransferSwitch_testImmediateEval
-	      = fn Transfer.Switch {test = Operand.Immediate immediate, ...}
-	         => isSome (Immediate.eval immediate)
+                             optimization
+        = let
+            val isTransferSwitch_testImmediateEval
+              = fn Transfer.Switch {test = Operand.Immediate immediate, ...}
+                 => isSome (Immediate.eval immediate)
                  | _ => false
 
-	    val template 
-	      = {start = Empty,
-		 statements = [All (fn _ => true)],
-		 finish = Empty,
-		 transfer = isTransferSwitch_testImmediateEval}
+            val template 
+              = {start = Empty,
+                 statements = [All (fn _ => true)],
+                 finish = Empty,
+                 transfer = isTransferSwitch_testImmediateEval}
 
-	    val rewriter 
-	      = fn {entry,
-		    profileLabel,
-		    start = [], 
-		    statements = [statements'],
-		    finish = [],
-		    transfer = 
-		    Transfer.Switch {test = Operand.Immediate immediate,
-				     cases, 
-				     default}}
-	         => let
-		      val statements = statements'
-		      val test = valOf (Immediate.eval immediate)
-		      val cases
-			= Transfer.Cases.keepAll'
-			  (cases,
-			   fn k => k = test,
-			   fn (c,target) 
-			    => (x86JumpInfo.decNear(jumpInfo, target);
-				(Word.fromInt o Char.ord) c),
-			   fn (i,target) 
-			    => (x86JumpInfo.decNear(jumpInfo, target);
-				Word.fromInt i),
-			   fn (w,target) 
-			    => (x86JumpInfo.decNear(jumpInfo, target);
-				w))
+            val rewriter 
+              = fn {entry,
+                    profileLabel,
+                    start = [], 
+                    statements = [statements'],
+                    finish = [],
+                    transfer = 
+                    Transfer.Switch {test = Operand.Immediate immediate,
+                                     cases, 
+                                     default}}
+                 => let
+                      val statements = statements'
+                      val test = valOf (Immediate.eval immediate)
+                      val cases
+                        = Transfer.Cases.keepAll
+                          (cases,
+                           fn (w,target) 
+                            => (x86JumpInfo.decNear(jumpInfo, target);
+                                w = test))
 
-		      val transfer
-			= if Transfer.Cases.isEmpty cases
-			    then Transfer.goto {target = default}
-			  else if Transfer.Cases.isSingle cases
-			    then let
-				   val _ = x86JumpInfo.decNear
-				           (jumpInfo, default)
+                      val transfer
+                        = if Transfer.Cases.isEmpty cases
+                            then Transfer.goto {target = default}
+                          else if Transfer.Cases.isSingle cases
+                            then let
+                                   val _ = x86JumpInfo.decNear
+                                           (jumpInfo, default)
 
-				   val target
-				     = Transfer.Cases.extract
-				       (cases, 
-					fn target => target)
-				   val _ = x86JumpInfo.incNear
-				           (jumpInfo, target)
-				 in
-				   Transfer.goto {target = target}
-				 end
-			  else Error.bug "elimSwitchTest"
-		    in
-		      SOME (Block.T {entry = entry,
-				     profileLabel = profileLabel,
-				     statements = statements,
-				     transfer = transfer})
-		    end
-	         | _ => Error.bug "elimSwitchTest"
-	  in
-	    {template = template,
-	     rewriter = rewriter,
-	     callback = callback_elimSwitchTest}
-	  end
+                                   val target
+                                     = Transfer.Cases.extract
+                                       (cases, #2)
+                                   val _ = x86JumpInfo.incNear
+                                           (jumpInfo, target)
+                                 in
+                                   Transfer.goto {target = target}
+                                 end
+                          else Error.bug "x86Simplify.PeeholeBlock: elimSwitchTest:transfer"
+                    in
+                      SOME (Block.T {entry = entry,
+                                     profileLabel = profileLabel,
+                                     statements = statements,
+                                     transfer = transfer})
+                    end
+                 | _ => Error.bug "x86Simplify.PeeholeBlock: elimSwitchTest"
+          in
+            {template = template,
+             rewriter = rewriter,
+             callback = callback_elimSwitchTest}
+          end
 
       val (callback_elimSwitchCases,elimSwitchCases_msg)
-	= make_callback_msg "elimSwitchCases"
+        = make_callback_msg "elimSwitchCases"
       fun makeElimSwitchCases {jumpInfo : x86JumpInfo.t} :
-	                      optimization
-	= let
-	    val isTransferSwitch_casesDefault
-	      = fn Transfer.Switch {cases, default, ...}
-	         => let
-		      val n = Transfer.Cases.count
-			      (cases, 
-			       fn target => Label.equals(target, default))
-		    in 
-		      n > 0
-		    end
-		 | _ => false
+                              optimization
+        = let
+            val isTransferSwitch_casesDefault
+              = fn Transfer.Switch {cases, default, ...}
+                 => let
+                      val n = Transfer.Cases.count
+                              (cases, 
+                               fn target => Label.equals(target, default))
+                    in 
+                      n > 0
+                    end
+                 | _ => false
 
-	    val template 
-	      = {start = Empty,
-		 statements = [All (fn _ => true)],
-		 finish = Empty,
-		 transfer = isTransferSwitch_casesDefault}
+            val template 
+              = {start = Empty,
+                 statements = [All (fn _ => true)],
+                 finish = Empty,
+                 transfer = isTransferSwitch_casesDefault}
 
-	    val rewriter 
-	      = fn {entry,
-		    profileLabel,
-		    start = [], 
-		    statements = [statements'],
-		    finish = [],
-		    transfer = Transfer.Switch {test, cases, default}}
-	         => let
-		      val statements = statements'
-		      val cases
-			= Transfer.Cases.keepAll
-			  (cases,
-			   fn target => if Label.equals(target, default)
-					  then (x86JumpInfo.decNear
-						(jumpInfo, target);
-						false)
-					  else true)
+            val rewriter 
+              = fn {entry,
+                    profileLabel,
+                    start = [], 
+                    statements = [statements'],
+                    finish = [],
+                    transfer = Transfer.Switch {test, cases, default}}
+                 => let
+                      val statements = statements'
+                      val cases
+                        = Transfer.Cases.keepAll
+                          (cases,
+                           fn (_,target) => if Label.equals(target, default)
+                                               then (x86JumpInfo.decNear
+                                                     (jumpInfo, target);
+                                                     false)
+                                               else true)
 
-		      val (statements, transfer)
-			= if Transfer.Cases.isEmpty cases
-			    then (statements,
-				  Transfer.goto {target = default})
-			  else if Transfer.Cases.isSingle cases
-			    then let
-				   val (k,target)
-				     = Transfer.Cases.extract'
-				       (cases,
-					fn (k,target) => (k,target),
-					fn (c,target) 
-					 => (Immediate.const_char c, target),
-					fn (i,target)
-					 => (Immediate.const_int i, target),
-					fn (w,target)
-					 => (Immediate.const_word w, target))
-				   val size
-				     = case Operand.size test
-					 of SOME size => size
-					  | NONE => Size.LONG
-				 in 
-				   (List.concat
-				    [statements,
-				     [Assembly.instruction_cmp
-				      {src1 = test,
-				       src2 = Operand.immediate k,
-				       size = size}]],
-				    Transfer.iff {condition = Instruction.E,
-						  truee = target,
-						  falsee = default})
-				 end				    
-			  else (statements,
-				Transfer.switch {test = test,
-						 cases = cases,
-						 default = default})
-		    in 
-		      SOME (Block.T {entry = entry,	
-				     profileLabel = profileLabel,
-				     statements = statements,
-				     transfer = transfer})
-		    end
-	         | _ => Error.bug "elimSwitchCases"
-	  in
-	    {template = template,
-	     rewriter = rewriter,
-	     callback = callback_elimSwitchCases}
-	  end
+                      val (statements, transfer)
+                        = if Transfer.Cases.isEmpty cases
+                            then (statements,
+                                  Transfer.goto {target = default})
+                          else if Transfer.Cases.isSingle cases
+                            then let
+                                   val (k,target)
+                                     = Transfer.Cases.extract
+                                       (cases,
+                                        fn (w,target) =>
+                                        (Immediate.const_word w, target))
+                                   val size
+                                     = case Operand.size test
+                                         of SOME size => size
+                                          | NONE => Size.LONG
+                                 in 
+                                   (List.concat
+                                    [statements,
+                                     [Assembly.instruction_cmp
+                                      {src1 = test,
+                                       src2 = Operand.immediate k,
+                                       size = size}]],
+                                    Transfer.iff {condition = Instruction.E,
+                                                  truee = target,
+                                                  falsee = default})
+                                 end                                
+                          else (statements,
+                                Transfer.switch {test = test,
+                                                 cases = cases,
+                                                 default = default})
+                    in 
+                      SOME (Block.T {entry = entry,     
+                                     profileLabel = profileLabel,
+                                     statements = statements,
+                                     transfer = transfer})
+                    end
+                 | _ => Error.bug "x86Simplify.PeeholeBlock: elimSwitchCases"
+          in
+            {template = template,
+             rewriter = rewriter,
+             callback = callback_elimSwitchCases}
+          end
     end
 
   structure ElimGoto =
     struct
       fun elimSimpleGoto {chunk = Chunk.T {data, blocks, ...},
-			  delProfileLabel : x86.ProfileLabel.t -> unit,
-			  jumpInfo : x86JumpInfo.t} 
-	= let
-	    val {get: Label.t -> Label.t option,
-		 set: Label.t * Label.t option -> unit,
-		 destroy}
-	      = Property.destGetSet(Label.plist, Property.initConst NONE)
-	    val changed = ref false
-	      
-	    val labels
-	      = List.keepAllMap
-	        (blocks,
-		 fn Block.T {entry = Entry.Jump {label}, 
-			     profileLabel,
-			     statements, 
-			     transfer = Transfer.Goto {target}}
-		  => if List.forall(statements,
-				    fn Assembly.Comment _ => true
-				     | _ => false)
+                          delProfileLabel : x86.ProfileLabel.t -> unit,
+                          jumpInfo : x86JumpInfo.t} 
+        = let
+            val {get: Label.t -> Label.t option,
+                 set: Label.t * Label.t option -> unit,
+                 destroy}
+              = Property.destGetSet(Label.plist, Property.initConst NONE)
+            val changed = ref false
+              
+            val labels
+              = List.keepAllMap
+                (blocks,
+                 fn Block.T {entry = Entry.Jump {label}, 
+                             profileLabel,
+                             statements, 
+                             transfer = Transfer.Goto {target}}
+                  => if List.forall(statements,
+                                    fn Assembly.Comment _ => true
+                                     | _ => false)
 (*
-		        andalso
-			not (Label.equals(label, target))
+                        andalso
+                        not (Label.equals(label, target))
 *)
-		       then (Option.app(profileLabel, delProfileLabel);
-			     set(label, SOME target); 
-			     SOME label)
-		       else NONE
-		  | _ => NONE)
-		
-	    fun loop ()
-	      = if List.fold(labels,
-			     false,
-			     fn (label,b)
-			      => case get label
-				   of NONE => b
-			            | SOME target
-				    => (case get target
-					  of NONE => b
-					   | SOME target'
-					   => if Label.equals(label, target')
-						then (set(label, NONE);
-						      b)
-						else (set(label, SOME target');
-						      true)))
-		  then loop ()
-		  else ()
-		    
-	    val _ = loop ()
+                       then (Option.app(profileLabel, delProfileLabel);
+                             set(label, SOME target); 
+                             SOME label)
+                       else NONE
+                  | _ => NONE)
+                
+            fun loop ()
+              = if List.fold(labels,
+                             false,
+                             fn (label,b)
+                              => case get label
+                                   of NONE => b
+                                    | SOME target
+                                    => (case get target
+                                          of NONE => b
+                                           | SOME target'
+                                           => if Label.equals(label, target')
+                                                then (set(label, NONE);
+                                                      b)
+                                                else (set(label, SOME target');
+                                                      true)))
+                  then loop ()
+                  else ()
+                    
+            val _ = loop ()
 
-	    fun update target
-	      = case get target
-		  of SOME target'
-		   => (changed := true;
-		       x86JumpInfo.decNear(jumpInfo, target); 
-		       x86JumpInfo.incNear(jumpInfo, target'); 
-		       target')
-		   | NONE => target
+            fun update target
+              = case get target
+                  of SOME target'
+                   => (changed := true;
+                       x86JumpInfo.decNear(jumpInfo, target); 
+                       x86JumpInfo.incNear(jumpInfo, target'); 
+                       target')
+                   | NONE => target
 
-	    val elimSimpleGoto'
-	      = fn Transfer.Goto {target} 
-	         => Transfer.Goto {target = update target}
-		 | Transfer.Iff {condition, truee, falsee}
-	         => Transfer.Iff {condition = condition,
-				  truee = update truee,
-				  falsee = update falsee}
-	         | Transfer.Switch {test, cases, default}
-	         => Transfer.Switch {test = test,
-				     cases = Transfer.Cases.map
-				             (cases,
-					      fn target => update target),
-			             default = update default}
-	         | transfer => transfer
+            val elimSimpleGoto'
+              = fn Transfer.Goto {target} 
+                 => Transfer.Goto {target = update target}
+                 | Transfer.Iff {condition, truee, falsee}
+                 => Transfer.Iff {condition = condition,
+                                  truee = update truee,
+                                  falsee = update falsee}
+                 | Transfer.Switch {test, cases, default}
+                 => Transfer.Switch {test = test,
+                                     cases = Transfer.Cases.map
+                                             (cases, update o #2),
+                                     default = update default}
+                 | transfer => transfer
 
-	    val blocks
-	      = List.map
-	        (blocks,
-		 fn Block.T {entry, profileLabel, statements, transfer}
-		  => Block.T {entry = entry,
-			      profileLabel = profileLabel,
-			      statements = statements,
-			      transfer = elimSimpleGoto' transfer})
+            val blocks
+              = List.map
+                (blocks,
+                 fn Block.T {entry, profileLabel, statements, transfer}
+                  => Block.T {entry = entry,
+                              profileLabel = profileLabel,
+                              statements = statements,
+                              transfer = elimSimpleGoto' transfer})
 
-	    val blocks
-	      = List.removeAll
-	        (blocks,
-		 fn Block.T {entry,...}
-		  => (case get (Entry.label entry)
-			of SOME label' => (changed := true;
-					   x86JumpInfo.decNear(jumpInfo, 
-							       label');
-					   true)
-			 | NONE => false))
+            val blocks
+              = List.removeAll
+                (blocks,
+                 fn Block.T {entry,...}
+                  => (case get (Entry.label entry)
+                        of SOME label' => (changed := true;
+                                           x86JumpInfo.decNear(jumpInfo, 
+                                                               label');
+                                           true)
+                         | NONE => false))
 
-	    val _ = destroy ()
-	  in
-	    {chunk = Chunk.T {data = data, blocks = blocks},
-	     changed = !changed}
-	  end
+            val _ = destroy ()
+          in
+            {chunk = Chunk.T {data = data, blocks = blocks},
+             changed = !changed}
+          end
 
       val (elimSimpleGoto,elimSimpleGoto_msg)
-	= tracer
-	  "elimSimpleGoto"
-	  elimSimpleGoto
+        = tracer
+          "elimSimpleGoto"
+          elimSimpleGoto
 
       fun elimComplexGoto {chunk = Chunk.T {data, blocks, ...},
-			   jumpInfo : x86JumpInfo.t}
-	= let
-	    datatype z = datatype x86JumpInfo.status
+                           jumpInfo : x86JumpInfo.t}
+        = let
+            datatype z = datatype x86JumpInfo.status
 
-	    val {get: Label.t -> Block.t option,
-		 set: Label.t * Block.t option -> unit,
-		 destroy}
-	      = Property.destGetSet(Label.plist, Property.initConst NONE)
+            val {get: Label.t -> Block.t option,
+                 set: Label.t * Block.t option -> unit,
+                 destroy}
+              = Property.destGetSet(Label.plist, Property.initConst NONE)
 
-	    val labels
-	      = List.keepAllMap
-	        (blocks,
-		 fn block as Block.T {entry = Entry.Jump {label},...}
-		  => if x86JumpInfo.getNear(jumpInfo, label) = Count 1
-			 then (set(label, SOME block); SOME label)
-			 else NONE
-		  | _ => NONE)
+            val labels
+              = List.keepAllMap
+                (blocks,
+                 fn block as Block.T {entry = Entry.Jump {label},...}
+                  => if x86JumpInfo.getNear(jumpInfo, label) = Count 1
+                         then (set(label, SOME block); SOME label)
+                         else NONE
+                  | _ => NONE)
 
-	    fun loop ()
-	      = if List.fold
-	           (labels,
-		    false,
-		    fn (label,b)
-		     => case get label
-			  of SOME (Block.T 
-				   {entry,
-				    profileLabel,
-				    statements,
-				    transfer = Transfer.Goto {target}})
-			   => (if Label.equals(label,target)
-				 then b
-				 else (case get target
-					 of NONE => b
-					  | SOME (Block.T
-						  {entry = entry',
-						   profileLabel = profileLabel',
-						   statements = statements',
-						   transfer = transfer'})
-					  => (set(label,
-						  SOME (Block.T
-							{entry = entry,
-							 profileLabel = profileLabel,
-							 statements
-							 = List.concat
-							   [statements,
-							    [Assembly.Label
-							     (Entry.label entry')],
-							    ProfileLabel.toAssemblyOpt
-							    profileLabel',
-							    statements'],
-						         transfer 
-						         = transfer'}));
-					      true)))
-		           | _ => b)
-		  then loop ()
-		  else ()
+            fun loop ()
+              = if List.fold
+                   (labels,
+                    false,
+                    fn (label,b)
+                     => case get label
+                          of SOME (Block.T 
+                                   {entry,
+                                    profileLabel,
+                                    statements,
+                                    transfer = Transfer.Goto {target}})
+                           => (if Label.equals(label,target)
+                                 then b
+                                 else (case get target
+                                         of NONE => b
+                                          | SOME (Block.T
+                                                  {entry = entry',
+                                                   profileLabel = profileLabel',
+                                                   statements = statements',
+                                                   transfer = transfer'})
+                                          => (set(label,
+                                                  SOME (Block.T
+                                                        {entry = entry,
+                                                         profileLabel = profileLabel,
+                                                         statements
+                                                         = List.concat
+                                                           [statements,
+                                                            [Assembly.Label
+                                                             (Entry.label entry')],
+                                                            ProfileLabel.toAssemblyOpt
+                                                            profileLabel',
+                                                            statements'],
+                                                         transfer 
+                                                         = transfer'}));
+                                              true)))
+                           | _ => b)
+                  then loop ()
+                  else ()
 
-	    val _ = loop ()
+            val _ = loop ()
 
-	    val changed = ref false
-	    val elimComplexGoto'
-	      = fn block as Block.T {entry, 
-				     profileLabel,
-				     statements, 
-				     transfer = Transfer.Goto {target}}
-		 => if Label.equals(Entry.label entry,target)
-		      then block
-		      else (case get target
-			      of NONE => block
-			       | SOME (Block.T {entry = entry',
-						profileLabel = profileLabel',
-						statements = statements',
-						transfer = transfer'})
-			       => let
-				    val _ = changed := true
-				    val _ = x86JumpInfo.decNear
-				            (jumpInfo, 
-					     Entry.label entry')
-				    val _ = List.foreach
-				            (Transfer.nearTargets transfer',
-					     fn target 
-					      => x86JumpInfo.incNear
-					         (jumpInfo, target))
+            val changed = ref false
+            val elimComplexGoto'
+              = fn block as Block.T {entry, 
+                                     profileLabel,
+                                     statements, 
+                                     transfer = Transfer.Goto {target}}
+                 => if Label.equals(Entry.label entry,target)
+                      then block
+                      else (case get target
+                              of NONE => block
+                               | SOME (Block.T {entry = entry',
+                                                profileLabel = profileLabel',
+                                                statements = statements',
+                                                transfer = transfer'})
+                               => let
+                                    val _ = changed := true
+                                    val _ = x86JumpInfo.decNear
+                                            (jumpInfo, 
+                                             Entry.label entry')
+                                    val _ = List.foreach
+                                            (Transfer.nearTargets transfer',
+                                             fn target 
+                                              => x86JumpInfo.incNear
+                                                 (jumpInfo, target))
 
-				    val block
-				      = Block.T {entry = entry,
-						 profileLabel = profileLabel,
-						 statements 
-						 = List.concat
-						   [statements,
-						    [Assembly.label
-						     (Entry.label entry')],
-						    ProfileLabel.toAssemblyOpt
-						    profileLabel',
-						    statements'],
-						 transfer = transfer'}
-				  in
-				    block
-				  end)
-	         | block => block
+                                    val block
+                                      = Block.T {entry = entry,
+                                                 profileLabel = profileLabel,
+                                                 statements 
+                                                 = List.concat
+                                                   [statements,
+                                                    [Assembly.label
+                                                     (Entry.label entry')],
+                                                    ProfileLabel.toAssemblyOpt
+                                                    profileLabel',
+                                                    statements'],
+                                                 transfer = transfer'}
+                                  in
+                                    block
+                                  end)
+                 | block => block
 
-	    val blocks
-	      = List.map(blocks, elimComplexGoto')
+            val blocks
+              = List.map(blocks, elimComplexGoto')
 
-	    val _ = destroy ()
-	  in
-	    {chunk = Chunk.T {data = data, blocks = blocks},
-	     changed = !changed}
-	  end
+            val _ = destroy ()
+          in
+            {chunk = Chunk.T {data = data, blocks = blocks},
+             changed = !changed}
+          end
 
       val (elimComplexGoto, elimComplexGoto_msg)
-	= tracer
-	  "elimComplexGoto"
-	  elimComplexGoto
+        = tracer
+          "elimComplexGoto"
+          elimComplexGoto
 
       fun elimBlocks {chunk = Chunk.T {data, blocks, ...},
-		      jumpInfo : x86JumpInfo.t}
-	= let
-	    val {get: Label.t -> {block: Block.t,
-				  reach: bool ref},
-		 set, 
-		 destroy}
-	      = Property.destGetSetOnce
-	        (Label.plist, Property.initRaise ("gotoInfo", Label.layout))
+                      jumpInfo : x86JumpInfo.t}
+        = let
+            val {get: Label.t -> {block: Block.t,
+                                  reach: bool ref},
+                 set, 
+                 destroy}
+              = Property.destGetSetOnce
+                (Label.plist, Property.initRaise ("gotoInfo", Label.layout))
 
-	    val (labels, funcs)
-	      = List.fold
-	        (blocks, ([], []),
-		 fn (block as Block.T {entry, ...}, (labels, funcs))
-		  => let
-		       val label = Entry.label entry
-		     in
-		       set(label, {block = block,
-				   reach = ref false}) ;
-		       case entry
-			 of Entry.Func _ => (label::labels, label::funcs)
-			  | _ => (label::labels, funcs)
-		     end)
+            val (labels, funcs)
+              = List.fold
+                (blocks, ([], []),
+                 fn (block as Block.T {entry, ...}, (labels, funcs))
+                  => let
+                       val label = Entry.label entry
+                     in
+                       set(label, {block = block,
+                                   reach = ref false}) ;
+                       case entry
+                         of Entry.Func _ => (label::labels, label::funcs)
+                          | _ => (label::labels, funcs)
+                     end)
 
-	    fun loop label
-	      = let
-		  val {block = Block.T {transfer, ...}, reach} = get label
-		in
-		  if !reach
-		    then ()
-		    else (reach := true ;
-			  List.foreach (Transfer.nearTargets transfer, loop))
-		end
-	    val _ = List.foreach (funcs, loop)
+            fun loop label
+              = let
+                  val {block = Block.T {transfer, ...}, reach} = get label
+                in
+                  if !reach
+                    then ()
+                    else (reach := true ;
+                          List.foreach (Transfer.nearTargets transfer, loop))
+                end
+            val _ = List.foreach (funcs, loop)
 
-	    fun check oper
-	      = case (Operand.deImmediate oper, Operand.deLabel oper)
-		  of (SOME immediate, _) 
-		   => (case Immediate.deLabel immediate
-			 of SOME label => ! (#reach (get label))
-			  | NONE => true)
-		   | (_, SOME label) => ! (#reach (get label))
-		   | _ => true
+            fun check oper
+              = case (Operand.deImmediate oper, Operand.deLabel oper)
+                  of (SOME immediate, _) 
+                   => (case Immediate.deLabel immediate
+                         of SOME label => ! (#reach (get label))
+                          | NONE => true)
+                   | (_, SOME label) => ! (#reach (get label))
+                   | _ => true
 
-	    val changed = ref false
-	    val blocks
-	      = List.keepAllMap
-	        (labels,
-		 fn label 
-		  => let
-		       val {block = Block.T {entry, 
-					     profileLabel, 
-					     statements, 
-					     transfer}, 
-			    reach} = get label
-		     in
-		       if !reach
-			 then SOME 
-			      (Block.T 
-			       {entry = entry,
-				profileLabel = profileLabel,
-				statements
-				= List.keepAll
-				  (statements,
-				   fn Assembly.Instruction i 
-				    => (case #srcs (Instruction.srcs_dsts i)
-					  of NONE => true
-					   | SOME srcs
-					   => List.forall(srcs, check))
-				    | _ => true),
-				transfer = transfer})
-			 else (changed := true ;
-			       List.foreach 
-			       (Transfer.nearTargets transfer,
-				fn label => x86JumpInfo.decNear (jumpInfo, label));
-			       NONE)
-		     end)
+            val changed = ref false
+            val blocks
+              = List.keepAllMap
+                (labels,
+                 fn label 
+                  => let
+                       val {block = Block.T {entry, 
+                                             profileLabel, 
+                                             statements, 
+                                             transfer}, 
+                            reach} = get label
+                     in
+                       if !reach
+                         then SOME 
+                              (Block.T 
+                               {entry = entry,
+                                profileLabel = profileLabel,
+                                statements
+                                = List.keepAll
+                                  (statements,
+                                   fn Assembly.Instruction i 
+                                    => (case #srcs (Instruction.srcs_dsts i)
+                                          of NONE => true
+                                           | SOME srcs
+                                           => List.forall(srcs, check))
+                                    | _ => true),
+                                transfer = transfer})
+                         else (changed := true ;
+                               List.foreach 
+                               (Transfer.nearTargets transfer,
+                                fn label => x86JumpInfo.decNear (jumpInfo, label));
+                               NONE)
+                     end)
 
-	    val _ = destroy ()
-	  in
-	    {chunk = Chunk.T {data = data, blocks = blocks},
-	     changed = !changed}
-	  end
+            val _ = destroy ()
+          in
+            {chunk = Chunk.T {data = data, blocks = blocks},
+             changed = !changed}
+          end
 
       val (elimBlocks, elimBlocks_msg)
-	= tracer
-	  "elimBlocks"
-	  elimBlocks
+        = tracer
+          "elimBlocks"
+          elimBlocks
 
       fun elimGoto {chunk : Chunk.t,
-		    delProfileLabel: x86.ProfileLabel.t -> unit,
-		    jumpInfo : x86JumpInfo.t}
-	= let
-	    val elimIff 
-	      = PeepholeBlock.makeElimIff {jumpInfo = jumpInfo}
-	    val elimSwitchTest
-	      = PeepholeBlock.makeElimSwitchTest {jumpInfo = jumpInfo}
-	    val elimSwitchCases 
-	      = PeepholeBlock.makeElimSwitchCases {jumpInfo = jumpInfo}
+                    delProfileLabel: x86.ProfileLabel.t -> unit,
+                    jumpInfo : x86JumpInfo.t}
+        = let
+            val elimIff 
+              = PeepholeBlock.makeElimIff {jumpInfo = jumpInfo}
+            val elimSwitchTest
+              = PeepholeBlock.makeElimSwitchTest {jumpInfo = jumpInfo}
+            val elimSwitchCases 
+              = PeepholeBlock.makeElimSwitchCases {jumpInfo = jumpInfo}
 
-	    fun loop {chunk, changed}
-	      = let
-		  val {chunk,
-		       changed = changed_elimSimpleGoto}
-		    = elimSimpleGoto {chunk = chunk,
-				      delProfileLabel = delProfileLabel,
-				      jumpInfo = jumpInfo}
+            fun loop {chunk, changed}
+              = let
+                  val {chunk,
+                       changed = changed_elimSimpleGoto}
+                    = elimSimpleGoto {chunk = chunk,
+                                      delProfileLabel = delProfileLabel,
+                                      jumpInfo = jumpInfo}
 
-		  val Chunk.T {data, blocks, ...} = chunk
+                  val Chunk.T {data, blocks, ...} = chunk
 
-		  val {blocks,
-		       changed = changed_peepholeBlocks}
-		    = PeepholeBlock.peepholeBlocks
-		      {blocks = blocks,
-		       optimizations = [elimIff,
-					elimSwitchTest,
-					elimSwitchCases]}
+                  val {blocks,
+                       changed = changed_peepholeBlocks}
+                    = PeepholeBlock.peepholeBlocks
+                      {blocks = blocks,
+                       optimizations = [elimIff,
+                                        elimSwitchTest,
+                                        elimSwitchCases]}
 
-		  val chunk = Chunk.T {data = data, blocks = blocks}
-		in
-		  if changed_elimSimpleGoto orelse changed_peepholeBlocks
-		    then loop {chunk = chunk, changed = true}
-		    else {chunk = chunk, changed = changed}
-		end
+                  val chunk = Chunk.T {data = data, blocks = blocks}
+                in
+                  if changed_elimSimpleGoto orelse changed_peepholeBlocks
+                    then loop {chunk = chunk, changed = true}
+                    else {chunk = chunk, changed = changed}
+                end
 
-	    val {chunk, 
-		 changed = changed_loop} 
-	      = loop {chunk = chunk, changed = false}
+            val {chunk, 
+                 changed = changed_loop} 
+              = loop {chunk = chunk, changed = false}
 
-	    val {chunk,
-		 changed = changed_elimComplexGoto} 
-	      = elimComplexGoto {chunk = chunk,
-				 jumpInfo = jumpInfo}
+            val {chunk,
+                 changed = changed_elimComplexGoto} 
+              = elimComplexGoto {chunk = chunk,
+                                 jumpInfo = jumpInfo}
 
-	    val {chunk,
-		 changed = changed_elimBlocks}
-	      = elimBlocks {chunk = chunk,
-			    jumpInfo = jumpInfo}
-	  in
-	    {chunk = chunk,
-	     changed = changed_loop 
-	               orelse changed_elimComplexGoto 
-		       orelse changed_elimBlocks}
-	  end
+            val {chunk,
+                 changed = changed_elimBlocks}
+              = elimBlocks {chunk = chunk,
+                            jumpInfo = jumpInfo}
+          in
+            {chunk = chunk,
+             changed = changed_loop 
+                       orelse changed_elimComplexGoto 
+                       orelse changed_elimBlocks}
+          end
 
       val (elimGoto, elimGoto_msg)
-	= tracer
-	  "elimGoto"
-	  elimGoto
+        = tracer
+          "elimGoto"
+          elimGoto
 
       val elimGoto_msg 
-	= fn () => (elimGoto_msg ();
-		    Control.indent ();
-		    PeepholeBlock.elimIff_msg ();
-		    PeepholeBlock.elimSwitchTest_msg ();
-		    PeepholeBlock.elimSwitchCases_msg ();
-		    elimSimpleGoto_msg ();
-		    elimComplexGoto_msg ();
-		    elimBlocks_msg ();
-		    Control.unindent ())
+        = fn () => (elimGoto_msg ();
+                    Control.indent ();
+                    PeepholeBlock.elimIff_msg ();
+                    PeepholeBlock.elimSwitchTest_msg ();
+                    PeepholeBlock.elimSwitchCases_msg ();
+                    elimSimpleGoto_msg ();
+                    elimComplexGoto_msg ();
+                    elimBlocks_msg ();
+                    Control.unindent ())
     end
 
   structure MoveHoistLivenessBlock = 
@@ -2283,281 +2262,277 @@
       structure LivenessBlock = x86Liveness.LivenessBlock
 
       fun moveHoist {block = LivenessBlock.T 
-		             {entry, profileLabel, statements, transfer}}
-	 = let
-	    val {transfer,live} 
-	      = LivenessBlock.reLivenessTransfer {transfer = transfer}
+                             {entry, profileLabel, statements, transfer}}
+         = let
+            val {transfer,live} 
+              = LivenessBlock.reLivenessTransfer {transfer = transfer}
 
-	    val {statements, changed, moves, live}
-	      = List.foldr
-	        (statements,
-		 {statements = [],
-		  changed = false,
-		  moves = [],
-		  live = live},
-		 fn ((asm: Assembly.t, Liveness.T {dead,...}),
-		     {statements: (Assembly.t * Liveness.t) list,
-		      changed : bool,
-		      moves,
-		      live: x86Liveness.LiveSet.t})
-		  => let
-		       fun default ()
-			 = let
-			     val {uses,defs,...} = Assembly.uses_defs_kills asm
+            val {statements, changed, moves, live}
+              = List.foldr
+                (statements,
+                 {statements = [],
+                  changed = false,
+                  moves = [],
+                  live = live},
+                 fn ((asm: Assembly.t, Liveness.T {dead,...}),
+                     {statements: (Assembly.t * Liveness.t) list,
+                      changed : bool,
+                      moves,
+                      live: x86Liveness.LiveSet.t})
+                  => let
+                       fun default ()
+                         = let
+                             val {uses,defs,...} = Assembly.uses_defs_kills asm
 
-			     val baseUses
-			       = List.fold
-			         (uses,
-				  [],
-				  fn (operand,baseUses)
-				   => case Operand.deMemloc operand
-					of SOME memloc
-					 => if List.contains
-					       (baseUses,
-						memloc,
-						MemLoc.eq)
-					      then baseUses
-					      else memloc::baseUses
-				         | NONE => baseUses)
-			     val baseDefs
-			       = List.fold
-			         (defs,
-				  [],
-				  fn (operand,baseDefs)
-				   => case Operand.deMemloc operand
-					of SOME memloc
-					 => if List.contains
-					       (baseDefs,
-						memloc,
-						MemLoc.eq)
-					      then baseDefs
-					      else memloc::baseDefs
-				         | NONE => baseDefs)
+                             val baseUses
+                               = List.fold
+                                 (uses,
+                                  [],
+                                  fn (operand,baseUses)
+                                   => case Operand.deMemloc operand
+                                        of SOME memloc
+                                         => if List.contains
+                                               (baseUses,
+                                                memloc,
+                                                MemLoc.eq)
+                                              then baseUses
+                                              else memloc::baseUses
+                                         | NONE => baseUses)
+                             val baseDefs
+                               = List.fold
+                                 (defs,
+                                  [],
+                                  fn (operand,baseDefs)
+                                   => case Operand.deMemloc operand
+                                        of SOME memloc
+                                         => if List.contains
+                                               (baseDefs,
+                                                memloc,
+                                                MemLoc.eq)
+                                              then baseDefs
+                                              else memloc::baseDefs
+                                         | NONE => baseDefs)
 
-			     val allUses
-			       = let
-				   fun doit(memlocs,allUses)
-				     = List.fold
-				       (memlocs,
-					allUses,
-					fn (memloc,allUses)
-					 => List.fold
-					    (MemLoc.utilized memloc,
-					     allUses,
-					     fn (memloc,allUses)
-					      => if List.contains
-					            (allUses,
-						     memloc,
-						     MemLoc.eq)
-						   then allUses
-						   else memloc::allUses))
-				 in
-				   doit(baseDefs,
-				   doit(baseUses,
-					baseUses))
-				 end
-			     val allDefs = baseDefs
+                             val allUses
+                               = let
+                                   fun doit(memlocs,allUses)
+                                     = List.fold
+                                       (memlocs,
+                                        allUses,
+                                        fn (memloc,allUses)
+                                         => List.fold
+                                            (MemLoc.utilized memloc,
+                                             allUses,
+                                             fn (memloc,allUses)
+                                              => if List.contains
+                                                    (allUses,
+                                                     memloc,
+                                                     MemLoc.eq)
+                                                   then allUses
+                                                   else memloc::allUses))
+                                 in
+                                   doit(baseDefs,
+                                   doit(baseUses,
+                                        baseUses))
+                                 end
+                             val allDefs = baseDefs
 
-			     val {forces,
-				  moves,
-				  ...}
-			       = List.fold
-			         (moves,
-				  {forces = [],
-				   moves = [],
-				   allUses = allUses,
-				   allDefs = allDefs},
-				  fn (move as {src,dst,...},
-				      {forces,
-				       moves,
-				       allUses,
-				       allDefs})
-				   => let
-					val utilized_src
-					  = MemLoc.utilized src
-					val utilized_dst
-					  = MemLoc.utilized dst
-				      in 
-					if List.exists
-				           (allDefs,
-					    fn memloc'
-					     => List.exists
-					        (src::utilized_src,
-						 fn memloc'' 
-						  => MemLoc.mayAlias
-						     (memloc', memloc'')))
-					   orelse
-					   List.exists
-					   (allDefs,
-					    fn memloc'
-					     => List.exists
-					        (dst::utilized_dst,
-						 fn memloc'' 
-						  => MemLoc.mayAlias
-						     (memloc', memloc'')))
-					   orelse
-					   List.exists
-					   (allUses,
-					    fn memloc'
-					     => MemLoc.mayAlias
-					        (memloc',dst) 
-						orelse
-						MemLoc.mayAlias
-						(memloc',src))
-					  then {forces = move::forces,
-						moves = moves,
-						allUses
-						= src::(List.concat
-							[utilized_src,
-							 utilized_dst,
-							 allUses]),
-						allDefs 
-						= dst::allDefs}
-					  else {forces = forces,
-						moves = move::moves,
-						allUses = allUses,
-						allDefs = allDefs}
-				      end)
+                             val {forces,
+                                  moves,
+                                  ...}
+                               = List.fold
+                                 (moves,
+                                  {forces = [],
+                                   moves = [],
+                                   allUses = allUses,
+                                   allDefs = allDefs},
+                                  fn (move as {src,dst,...},
+                                      {forces,
+                                       moves,
+                                       allUses,
+                                       allDefs})
+                                   => let
+                                        val utilized_src
+                                          = MemLoc.utilized src
+                                        val utilized_dst
+                                          = MemLoc.utilized dst
+                                      in 
+                                        if List.exists
+                                           (allDefs,
+                                            fn memloc'
+                                             => List.exists
+                                                (src::utilized_src,
+                                                 fn memloc'' 
+                                                  => MemLoc.mayAlias
+                                                     (memloc', memloc'')))
+                                           orelse
+                                           List.exists
+                                           (allDefs,
+                                            fn memloc'
+                                             => List.exists
+                                                (dst::utilized_dst,
+                                                 fn memloc'' 
+                                                  => MemLoc.mayAlias
+                                                     (memloc', memloc'')))
+                                           orelse
+                                           List.exists
+                                           (allUses,
+                                            fn memloc'
+                                             => MemLoc.mayAlias
+                                                (memloc',dst) 
+                                                orelse
+                                                MemLoc.mayAlias
+                                                (memloc',src))
+                                          then {forces = move::forces,
+                                                moves = moves,
+                                                allUses
+                                                = src::(List.concat
+                                                        [utilized_src,
+                                                         utilized_dst,
+                                                         allUses]),
+                                                allDefs 
+                                                = dst::allDefs}
+                                          else {forces = forces,
+                                                moves = move::moves,
+                                                allUses = allUses,
+                                                allDefs = allDefs}
+                                      end)
 
-			     val moves 
-			       = List.revMap
-			         (moves,
-				  fn {src,dst,size,age}
-				   => {src = src,
-				       dst = dst,
-				       size = size,
-				       age = age + 1})
-			       
-			     val statements_forces
-			       = List.revMap
-			         (forces,
-				  fn {src,dst,size,...}
-				   => (case Size.class size
-					 of Size.INT
-					  => Assembly.instruction_mov
-					     {src = Operand.memloc src,
-					      dst = Operand.memloc dst,
-					      size = size}
-					  | _
-					  => Assembly.instruction_pfmov
-					     {src = Operand.memloc src,
-					      dst = Operand.memloc dst,
-					      size = size}))
+                             val moves 
+                               = List.revMap
+                                 (moves,
+                                  fn {src,dst,size,age}
+                                   => {src = src,
+                                       dst = dst,
+                                       size = size,
+                                       age = age + 1})
+                               
+                             val statements_forces
+                               = List.revMap
+                                 (forces,
+                                  fn {src,dst,size,...}
+                                   => (case Size.class size
+                                         of Size.INT
+                                          => Assembly.instruction_mov
+                                             {src = Operand.memloc src,
+                                              dst = Operand.memloc dst,
+                                              size = size}
+                                          | _
+                                          => Assembly.instruction_pfmov
+                                             {src = Operand.memloc src,
+                                              dst = Operand.memloc dst,
+                                              size = size}))
 
-			     val {statements = statements_asm_forces,
-				  live}
-			       = LivenessBlock.toLivenessStatements
-			         {statements = asm::statements_forces,
-				  live = live}
-			   in
-			     {statements 
-			      = List.concat
-			        [statements_asm_forces,
-				 statements],
-			      changed 
-			      = changed 
-			        orelse
-				List.exists(forces,
-					    fn {age,...}
-					     => age <> 0),
-			      moves = moves,
-			      live = live}
-			   end
-		     in
-		       case asm
-			 of Assembly.Instruction 
-			    (Instruction.MOV
-			     {src = Operand.MemLoc memloc_src,
-			      dst = Operand.MemLoc memloc_dst,
-			      size})
-			  => if LiveSet.contains(dead,
-						 memloc_src)
-			        orelse
-				List.exists(moves,
-					    fn {src,...}
-					     => MemLoc.eq(memloc_src,src))
-			       then {statements = statements,
-				     changed = changed,
-				     moves = {src = memloc_src,
-					      dst = memloc_dst,
-					      size = size,
-					      age = 0}::moves,
-				     live = live}
-			       else default ()
-			  | Assembly.Instruction 
-			    (Instruction.pFMOV
-			     {src = Operand.MemLoc memloc_src,
-			      dst = Operand.MemLoc memloc_dst,
-			      size})
-			  => if LiveSet.contains(dead,
-						 memloc_src)
-			        orelse
-				List.exists(moves,
-					    fn {src,...}
-					     => MemLoc.eq(memloc_src,src))
-			       then {statements = statements,
-				     changed = changed,
-				     moves = {src = memloc_src,
-					      dst = memloc_dst,
-					      size = size,
-					      age = 0}::moves,
-				     live = live}
-			       else default ()
-			  | _ => default ()
-		     end)
+                             val {statements = statements_asm_forces,
+                                  live}
+                               = LivenessBlock.toLivenessStatements
+                                 {statements = asm::statements_forces,
+                                  live = live}
+                           in
+                             {statements 
+                              = List.concat
+                                [statements_asm_forces,
+                                 statements],
+                              changed 
+                              = changed 
+                                orelse
+                                List.exists(forces,
+                                            fn {age,...}
+                                             => age <> 0),
+                              moves = moves,
+                              live = live}
+                           end
+                     in
+                       case asm
+                         of Assembly.Instruction 
+                            (Instruction.MOV
+                             {src = Operand.MemLoc memloc_src,
+                              dst = Operand.MemLoc memloc_dst,
+                              size})
+                          => if LiveSet.contains(dead,
+                                                 memloc_src)
+                                orelse
+                                List.exists(moves,
+                                            fn {src,...}
+                                             => MemLoc.eq(memloc_src,src))
+                               then {statements = statements,
+                                     changed = changed,
+                                     moves = {src = memloc_src,
+                                              dst = memloc_dst,
+                                              size = size,
+                                              age = 0}::moves,
+                                     live = live}
+                               else default ()
+                          | Assembly.Instruction 
+                            (Instruction.pFMOV
+                             {src = Operand.MemLoc memloc_src,
+                              dst = Operand.MemLoc memloc_dst,
+                              size})
+                          => if LiveSet.contains(dead,
+                                                 memloc_src)
+                                orelse
+                                List.exists(moves,
+                                            fn {src,...}
+                                             => MemLoc.eq(memloc_src,src))
+                               then {statements = statements,
+                                     changed = changed,
+                                     moves = {src = memloc_src,
+                                              dst = memloc_dst,
+                                              size = size,
+                                              age = 0}::moves,
+                                     live = live}
+                               else default ()
+                          | _ => default ()
+                     end)
 
-	    val forces = moves
-	    val statements_forces
-	      = List.map
-	        (forces,
-		 fn {src,dst,size,...}
-		  => (case Size.class size
-			of Size.INT
-			 => Assembly.instruction_mov
-			    {src = Operand.memloc src,
-			     dst = Operand.memloc dst,
-			     size = size}
-			 | _
-			 => Assembly.instruction_pfmov
-			    {src = Operand.memloc src,
-			     dst = Operand.memloc dst,
-			     size = size}))
-	    val {statements = statements_forces,
-		 ...}
-	      = LivenessBlock.toLivenessStatements
-	        {statements = statements_forces,
-		 live = live}
-	    val statements = List.concat [statements_forces, 
-					  statements]
-	    val changed = changed
-	                  orelse
-			  List.exists(forces,
-				      fn {age,...}
-				       => age <> 0)
-	    val block = LivenessBlock.T {entry = entry,
-					 profileLabel = profileLabel,
-					 statements = statements,
-					 transfer = transfer}
-	  in
-	    {block = block,
-	     changed = changed}
-	  end
+            val forces = moves
+            val statements_forces
+              = List.map
+                (forces,
+                 fn {src,dst,size,...}
+                  => (case Size.class size
+                        of Size.INT
+                         => Assembly.instruction_mov
+                            {src = Operand.memloc src,
+                             dst = Operand.memloc dst,
+                             size = size}
+                         | _
+                         => Assembly.instruction_pfmov
+                            {src = Operand.memloc src,
+                             dst = Operand.memloc dst,
+                             size = size}))
+            val {statements = statements_forces,
+                 ...}
+              = LivenessBlock.toLivenessStatements
+                {statements = statements_forces,
+                 live = live}
+            val statements = List.concat [statements_forces, 
+                                          statements]
+            val changed = changed
+                          orelse
+                          List.exists(forces,
+                                      fn {age,...}
+                                       => age <> 0)
+            val block = LivenessBlock.T {entry = entry,
+                                         profileLabel = profileLabel,
+                                         statements = statements,
+                                         transfer = transfer}
+          in
+            {block = block,
+             changed = changed}
+          end
 
       val moveHoist
-	= fn {block} => (moveHoist {block = block}
-			 handle exn
-			 => (print "\n\n***** raising in moveHoist\n";
-			     LivenessBlock.printBlock block;
-			     raise exn))
+        = fn {block} => (moveHoist {block = block})
 
       val (moveHoist: 
-	   {block: LivenessBlock.t} -> 
-	   {block: LivenessBlock.t, 
-	    changed: bool},
-	   moveHoist_msg)
-	= tracer
-	  "moveHoist"
-	  moveHoist
+           {block: LivenessBlock.t} -> 
+           {block: LivenessBlock.t, 
+            changed: bool},
+           moveHoist_msg)
+        = tracer
+          "moveHoist"
+          moveHoist
     end
 
   structure CopyPropagateLivenessBlock =
@@ -2568,334 +2543,330 @@
       structure LivenessBlock = x86Liveness.LivenessBlock
 
       fun copyPropagate' {src,
-			  dst as Operand.MemLoc memloc_dst,
-			  pblock = {statements, transfer},
-			  liveInfo}
-	= let
-	    val changed = ref 0
-	    val (all,replacer)
-	      = case src
-		  of Operand.MemLoc memloc_src
-		   => let
-			val all
-			  = let
-			      fun doit (memlocs, all)
-				= List.fold
-				  (memlocs,
-				   all,
-				   fn (memloc,all)
-				    => if List.contains(all,
-							memloc,
-							MemLoc.eq)
-					 then all
-					 else memloc::all)
-			    in
-			      doit(memloc_dst::(MemLoc.utilized memloc_dst),
-			      doit(memloc_src::(MemLoc.utilized memloc_src),
-				   []))
-			    end
+                          dst as Operand.MemLoc memloc_dst,
+                          pblock = {statements, transfer},
+                          liveInfo}
+        = let
+            val changed = ref 0
+            val (all,replacer)
+              = case src
+                  of Operand.MemLoc memloc_src
+                   => let
+                        val all
+                          = let
+                              fun doit (memlocs, all)
+                                = List.fold
+                                  (memlocs,
+                                   all,
+                                   fn (memloc,all)
+                                    => if List.contains(all,
+                                                        memloc,
+                                                        MemLoc.eq)
+                                         then all
+                                         else memloc::all)
+                            in
+                              doit(memloc_dst::(MemLoc.utilized memloc_dst),
+                              doit(memloc_src::(MemLoc.utilized memloc_src),
+                                   []))
+                            end
 
-			fun replacer' memloc
-			  = if MemLoc.eq(memloc,memloc_dst)
-			      then (changed := !changed + 1; 
-				    memloc_src)
-			      else memloc
-				
-			val replacer
-			  = fn {use,def} => fn operand
-			     => case Operand.deMemloc operand
-				  of SOME memloc
-				   => if (use andalso not def)
-				         orelse
-					 (not (MemLoc.eq(memloc, memloc_dst)))
-					then Operand.memloc
-					     (MemLoc.replace replacer' memloc)
-					else operand
-				   | _ => operand
-		      in
-			(all, replacer)
-		      end
-		   | _
-		   => let
-			val all
-			  = let
-			      fun doit (memlocs, all)
-				= List.fold
-				  (memlocs,
-				   all,
-				   fn (memloc,all)
-				    => if List.contains(all,
-							memloc,
-							MemLoc.eq)
-					 then all
-					 else memloc::all)
-			    in
-			      doit(memloc_dst::(MemLoc.utilized memloc_dst),
-				   [])
-			    end
-				
-			val replacer
-			  = fn {use,def} 
-			     => fn operand
-			         => if use andalso not def
-				      then if Operand.eq(operand,dst)
-					     then (changed := !changed + 1; 
-						   src)
-					     else operand
-				      else operand
-		      in
-			(all, replacer)
-		      end
+                        fun replacer' memloc
+                          = if MemLoc.eq(memloc,memloc_dst)
+                              then (changed := !changed + 1; 
+                                    memloc_src)
+                              else memloc
+                                
+                        val replacer
+                          = fn {use,def} => fn operand
+                             => case Operand.deMemloc operand
+                                  of SOME memloc
+                                   => if (use andalso not def)
+                                         orelse
+                                         (not (MemLoc.eq(memloc, memloc_dst)))
+                                        then Operand.memloc
+                                             (MemLoc.replace replacer' memloc)
+                                        else operand
+                                   | _ => operand
+                      in
+                        (all, replacer)
+                      end
+                   | _
+                   => let
+                        val all
+                          = let
+                              fun doit (memlocs, all)
+                                = List.fold
+                                  (memlocs,
+                                   all,
+                                   fn (memloc,all)
+                                    => if List.contains(all,
+                                                        memloc,
+                                                        MemLoc.eq)
+                                         then all
+                                         else memloc::all)
+                            in
+                              doit(memloc_dst::(MemLoc.utilized memloc_dst),
+                                   [])
+                            end
+                                
+                        val replacer
+                          = fn {use,def} 
+                             => fn operand
+                                 => if use andalso not def
+                                      then if Operand.eq(operand,dst)
+                                             then (changed := !changed + 1; 
+                                                   src)
+                                             else operand
+                                      else operand
+                      in
+                        (all, replacer)
+                      end
 
-	    val (transfer,_) = transfer
+            val (transfer,_) = transfer
 
-	    fun doit (statements : (Assembly.t * Liveness.t) list)
-	      = let
-		  fun uses_defs {uses, defs}
-		    = let
-			local
-			  fun doit operands
-			    = List.fold
-			      (operands,
-			       [],
-			       fn (operand,memlocs)
-			        => case Operand.deMemloc operand
-				     of SOME memloc
-				      => if List.contains(memlocs,
-							  memloc,
-							  MemLoc.eq)
-					   then memlocs
-					   else memloc::memlocs
-				    | NONE => memlocs)
+            fun doit (statements : (Assembly.t * Liveness.t) list)
+              = let
+                  fun uses_defs {uses, defs}
+                    = let
+                        local
+                          fun doit operands
+                            = List.fold
+                              (operands,
+                               [],
+                               fn (operand,memlocs)
+                                => case Operand.deMemloc operand
+                                     of SOME memloc
+                                      => if List.contains(memlocs,
+                                                          memloc,
+                                                          MemLoc.eq)
+                                           then memlocs
+                                           else memloc::memlocs
+                                    | NONE => memlocs)
 
-			  fun doit'(memlocs,uses)
-			    = List.fold
-			      (memlocs,
-			       uses,
-			       fn (memloc,uses)
-			        => if List.contains(uses,
-						    memloc,
-						    MemLoc.eq)
-				     then uses
-				     else memloc::uses)
-			  fun doit''(memlocs,uses)
-			    = List.fold
-			      (memlocs,
-			       uses,
-			       fn (memloc,uses)
-			        => doit'(MemLoc.utilized memloc, uses))
-			in
-			  val uses = doit uses
-			  val defs = doit defs
-			  val uses = doit''(defs,
-				     doit''(uses,
-					    uses))
-			end
-		      in
-			{uses = uses, defs = defs}
-		      end
-		in
-		  case statements
-		    of []
-		     => let
-			  val transfer = Transfer.replace replacer transfer
-			  val {uses,defs,...} = Transfer.uses_defs_kills transfer
+                          fun doit'(memlocs,uses)
+                            = List.fold
+                              (memlocs,
+                               uses,
+                               fn (memloc,uses)
+                                => if List.contains(uses,
+                                                    memloc,
+                                                    MemLoc.eq)
+                                     then uses
+                                     else memloc::uses)
+                          fun doit''(memlocs,uses)
+                            = List.fold
+                              (memlocs,
+                               uses,
+                               fn (memloc,uses)
+                                => doit'(MemLoc.utilized memloc, uses))
+                        in
+                          val uses = doit uses
+                          val defs = doit defs
+                          val uses = doit''(defs,
+                                     doit''(uses,
+                                            uses))
+                        end
+                      in
+                        {uses = uses, defs = defs}
+                      end
+                in
+                  case statements
+                    of []
+                     => let
+                          val transfer = Transfer.replace replacer transfer
+                          val {uses,defs,...} = Transfer.uses_defs_kills transfer
 
-			  val {uses, defs} = uses_defs {uses = uses, defs = defs}
-			in
-			  if not (List.contains(uses,
-						memloc_dst,
-						MemLoc.eq))
-			     andalso
-			     not (MemLocSet.contains(Transfer.live transfer,
-						     memloc_dst))
-			    then if List.forall
-			            (all,
-				     fn memloc
-				      => List.forall
-				         (defs,
-					  fn memloc'
-					   => not (MemLoc.mayAlias(memloc, 
-								   memloc'))))
-				   then SOME {statements = [],
-					      transfer = transfer}
-				 else NONE
-			    else NONE
-			end
-		     | (asm, Liveness.T {dead, ...}) :: statements
-		     => let
-			  val asm = Assembly.replace replacer asm
-			  val {uses,defs,...} = Assembly.uses_defs_kills asm
+                          val {uses, defs} = uses_defs {uses = uses, defs = defs}
+                        in
+                          if not (List.contains(uses,
+                                                memloc_dst,
+                                                MemLoc.eq))
+                             andalso
+                             not (MemLocSet.contains(Transfer.live transfer,
+                                                     memloc_dst))
+                            then if List.forall
+                                    (all,
+                                     fn memloc
+                                      => List.forall
+                                         (defs,
+                                          fn memloc'
+                                           => not (MemLoc.mayAlias(memloc, 
+                                                                   memloc'))))
+                                   then SOME {statements = [],
+                                              transfer = transfer}
+                                 else NONE
+                            else NONE
+                        end
+                     | (asm, Liveness.T {dead, ...}) :: statements
+                     => let
+                          val asm = Assembly.replace replacer asm
+                          val {uses,defs,...} = Assembly.uses_defs_kills asm
 
-			  val {uses, defs} = uses_defs {uses = uses, defs = defs}
-			in
-			  if not (List.contains(uses,
-						memloc_dst,
-						MemLoc.eq))
-			    then if LiveSet.contains(dead,memloc_dst)
-				   then let
-					  val statements 
-					    = List.map (statements, #1)
-					in 
-					  SOME {statements = asm::statements,
-						transfer = transfer}
-					end
-				 else if List.forall
-				         (all,
-					  fn memloc
-					   => List.forall
-					      (defs,
-					       fn memloc'
-					        => not (MemLoc.mayAlias(memloc, 
-									memloc'))))
-				   then case doit statements
-					  of NONE => NONE
-					   | SOME {statements,
-						   transfer}
-				           => SOME {statements = asm::statements,
-						    transfer = transfer}
-				 else NONE
-			    else NONE
-			end
-		end
-	  in
-	    case doit statements
-	      of NONE => NONE
-	       | SOME {statements, transfer}
-	       => let
-		    val {transfer, live} 
-		      = LivenessBlock.toLivenessTransfer 
-		        {transfer = transfer,
-			 liveInfo = liveInfo}
-		    val {statements, ...} 
-		      = LivenessBlock.toLivenessStatements
-		        {statements = statements,
-			 live = live}
-		  in
-		    SOME {pblock = {statements = statements,
-				    transfer = transfer},
-			  changed = !changed > 0}
-		  end
-	  end
-	| copyPropagate' _ = Error.bug "copyPropagate'"
+                          val {uses, defs} = uses_defs {uses = uses, defs = defs}
+                        in
+                          if not (List.contains(uses,
+                                                memloc_dst,
+                                                MemLoc.eq))
+                            then if LiveSet.contains(dead,memloc_dst)
+                                   then let
+                                          val statements 
+                                            = List.map (statements, #1)
+                                        in 
+                                          SOME {statements = asm::statements,
+                                                transfer = transfer}
+                                        end
+                                 else if List.forall
+                                         (all,
+                                          fn memloc
+                                           => List.forall
+                                              (defs,
+                                               fn memloc'
+                                                => not (MemLoc.mayAlias(memloc, 
+                                                                        memloc'))))
+                                   then case doit statements
+                                          of NONE => NONE
+                                           | SOME {statements,
+                                                   transfer}
+                                           => SOME {statements = asm::statements,
+                                                    transfer = transfer}
+                                 else NONE
+                            else NONE
+                        end
+                end
+          in
+            case doit statements
+              of NONE => NONE
+               | SOME {statements, transfer}
+               => let
+                    val {transfer, live} 
+                      = LivenessBlock.toLivenessTransfer 
+                        {transfer = transfer,
+                         liveInfo = liveInfo}
+                    val {statements, ...} 
+                      = LivenessBlock.toLivenessStatements
+                        {statements = statements,
+                         live = live}
+                  in
+                    SOME {pblock = {statements = statements,
+                                    transfer = transfer},
+                          changed = !changed > 0}
+                  end
+          end
+        | copyPropagate' _ = Error.bug "x86Simplify.PeeholeBlock: copyPropagate'"
 
 
       fun copyPropagate {block = LivenessBlock.T 
-			         {entry, profileLabel, statements, transfer},
-			 liveInfo}
-	= let
-	    val {pblock = {statements,transfer},changed}
-	      = List.foldr
-	        (statements,
-		 {pblock = {statements = [],
-			    transfer = transfer},
-		  changed = false},
-		 fn ((asm as Assembly.Instruction
-		             (Instruction.MOV
-			      {src,
-			       dst as Operand.MemLoc memloc_dst,
-			       ...}),
-		      info: Liveness.t),
-		     {pblock as {statements, transfer},
-		      changed})
-		   => let
-			val pblock' = {statements = (asm,info)::statements,
-				       transfer = transfer}
-		      in
-			if x86Liveness.track memloc_dst
-			   andalso
-			   (List.fold
-			    (statements,
-			     false,
-			     fn ((_, Liveness.T {dead,...}),b)
-			      => b orelse LiveSet.contains(dead,memloc_dst))
-			    orelse
-			    LiveSet.contains(Liveness.dead(#2(transfer)),memloc_dst))
-			  then case copyPropagate' {src = src,
-						    dst = dst,
-						    pblock = pblock,
-						    liveInfo = liveInfo}
-				of NONE => {pblock = pblock',
-					    changed = changed}
-				 | SOME {pblock,
-					 changed = changed'}
-				  => {pblock = pblock,
-				      changed = changed orelse changed'}
-			 else {pblock = pblock',
-			       changed = changed}
-		      end
-		   | ((asm as Assembly.Instruction
-		             (Instruction.pFMOV
-			      {src,
-			       dst as Operand.MemLoc memloc_dst,
-			       ...}),
-		      info),
-		     {pblock as {statements, transfer},
-		      changed})
-		   => let
-			val pblock' = {statements = (asm,info)::statements,
-				       transfer = transfer}
-		      in
-			if x86Liveness.track memloc_dst
-			   andalso
-			   (List.fold
-			    (statements,
-			     false,
-			     fn ((_, Liveness.T {dead,...}),b)
-			      => b orelse LiveSet.contains(dead,memloc_dst))
-			    orelse
-			    LiveSet.contains(Liveness.dead (#2 transfer),
-					     memloc_dst))
-			  then case copyPropagate' {src = src,
-						    dst = dst,
-						    pblock = pblock,
-						    liveInfo = liveInfo}
-				of NONE => {pblock = pblock',
-					    changed = changed}
-				 | SOME {pblock,
-					 changed = changed'}
-				  => {pblock = pblock,
-				      changed = changed orelse changed'}
-			 else {pblock = pblock',
-			       changed = changed}
-		      end
-		   | ((asm,info),
-		      {pblock = {statements, transfer},
-		       changed})
-		   => {pblock = {statements = (asm,info)::statements,
-				 transfer = transfer},
-		       changed = changed})
-	  in
-	    {block = LivenessBlock.T {entry = entry,
-				      profileLabel = profileLabel,
-				      statements = statements,
-				      transfer = transfer},
-	     changed = changed}
-	  end
+                                 {entry, profileLabel, statements, transfer},
+                         liveInfo}
+        = let
+            val {pblock = {statements,transfer},changed}
+              = List.foldr
+                (statements,
+                 {pblock = {statements = [],
+                            transfer = transfer},
+                  changed = false},
+                 fn ((asm as Assembly.Instruction
+                             (Instruction.MOV
+                              {src,
+                               dst as Operand.MemLoc memloc_dst,
+                               ...}),
+                      info: Liveness.t),
+                     {pblock as {statements, transfer},
+                      changed})
+                   => let
+                        val pblock' = {statements = (asm,info)::statements,
+                                       transfer = transfer}
+                      in
+                        if x86Liveness.track memloc_dst
+                           andalso
+                           (List.fold
+                            (statements,
+                             false,
+                             fn ((_, Liveness.T {dead,...}),b)
+                              => b orelse LiveSet.contains(dead,memloc_dst))
+                            orelse
+                            LiveSet.contains(Liveness.dead(#2(transfer)),memloc_dst))
+                          then case copyPropagate' {src = src,
+                                                    dst = dst,
+                                                    pblock = pblock,
+                                                    liveInfo = liveInfo}
+                                of NONE => {pblock = pblock',
+                                            changed = changed}
+                                 | SOME {pblock,
+                                         changed = changed'}
+                                  => {pblock = pblock,
+                                      changed = changed orelse changed'}
+                         else {pblock = pblock',
+                               changed = changed}
+                      end
+                   | ((asm as Assembly.Instruction
+                             (Instruction.pFMOV
+                              {src,
+                               dst as Operand.MemLoc memloc_dst,
+                               ...}),
+                      info),
+                     {pblock as {statements, transfer},
+                      changed})
+                   => let
+                        val pblock' = {statements = (asm,info)::statements,
+                                       transfer = transfer}
+                      in
+                        if x86Liveness.track memloc_dst
+                           andalso
+                           (List.fold
+                            (statements,
+                             false,
+                             fn ((_, Liveness.T {dead,...}),b)
+                              => b orelse LiveSet.contains(dead,memloc_dst))
+                            orelse
+                            LiveSet.contains(Liveness.dead (#2 transfer),
+                                             memloc_dst))
+                          then case copyPropagate' {src = src,
+                                                    dst = dst,
+                                                    pblock = pblock,
+                                                    liveInfo = liveInfo}
+                                of NONE => {pblock = pblock',
+                                            changed = changed}
+                                 | SOME {pblock,
+                                         changed = changed'}
+                                  => {pblock = pblock,
+                                      changed = changed orelse changed'}
+                         else {pblock = pblock',
+                               changed = changed}
+                      end
+                   | ((asm,info),
+                      {pblock = {statements, transfer},
+                       changed})
+                   => {pblock = {statements = (asm,info)::statements,
+                                 transfer = transfer},
+                       changed = changed})
+          in
+            {block = LivenessBlock.T {entry = entry,
+                                      profileLabel = profileLabel,
+                                      statements = statements,
+                                      transfer = transfer},
+             changed = changed}
+          end
 
       val copyPropagate
-	= fn {block, liveInfo}
-	   => (copyPropagate {block = block, liveInfo = liveInfo}
-	       handle exn
-	        => (print "\n\n***** raising in copyPropagate\n";
-		    LivenessBlock.printBlock block;
-		    raise exn))
+        = fn {block, liveInfo}
+           => (copyPropagate {block = block, liveInfo = liveInfo})
 
       val (copyPropagate : 
-	   {block: LivenessBlock.t, 
-	    liveInfo: LiveInfo.t} -> 
-	   {block: LivenessBlock.t,
-	    changed: bool},
-	   copyPropagate_msg)
-	= tracer
-	  "copyPropagate"
-	  copyPropagate
+           {block: LivenessBlock.t, 
+            liveInfo: LiveInfo.t} -> 
+           {block: LivenessBlock.t,
+            changed: bool},
+           copyPropagate_msg)
+        = tracer
+          "copyPropagate"
+          copyPropagate
 
       val copyPropagate =
-	 fn arg as {block as LivenessBlock.T {statements, ...}, ...} =>
-	 if List.length statements <= !Control.Native.copyPropCutoff
-	    then copyPropagate arg
-	 else {block = block, changed = false}
+         fn arg as {block as LivenessBlock.T {statements, ...}, ...} =>
+         if List.length statements <= !Control.Native.copyPropCutoff
+            then copyPropagate arg
+         else {block = block, changed = false}
     end
 
   structure PeepholeLivenessBlock =
@@ -2905,1784 +2876,1678 @@
       structure LivenessBlock = x86Liveness.LivenessBlock
 
       structure Peephole 
-	= Peephole(type entry_type = Entry.t * Liveness.t
-		   type profileLabel_type = ProfileLabel.t option
-		   type statement_type = Assembly.t * Liveness.t
-		   type transfer_type = Transfer.t * Liveness.t
-		   datatype block = datatype LivenessBlock.t)
+        = Peephole(type entry_type = Entry.t * Liveness.t
+                   type profileLabel_type = ProfileLabel.t option
+                   type statement_type = Assembly.t * Liveness.t
+                   type transfer_type = Transfer.t * Liveness.t
+                   datatype block = datatype LivenessBlock.t)
       open Peephole
 
       fun make_callback_msg name
-	= let
-	    val count = ref 0
-	    val total = ref 0
-	    val callback = fn true => (Int.inc count; Int.inc total)
-	                    | false => Int.inc total
-	    val msg = fn () => Control.messageStr 
-	                       (Control.Detail,
-				concat [name, 
-					": ", Int.toString (!count),
-					" / ", Int.toString (!total)])
-	  in
-	    (callback,msg)
-	  end
+        = let
+            val count = ref 0
+            val total = ref 0
+            val callback = fn true => (Int.inc count; Int.inc total)
+                            | false => Int.inc total
+            val msg = fn () => Control.messageStr 
+                               (Control.Detail,
+                                concat [name, 
+                                        ": ", Int.toString (!count),
+                                        " / ", Int.toString (!total)])
+          in
+            (callback,msg)
+          end
 
       val isComment : statement_type -> bool
-	= fn (Assembly.Comment _, _) => true
-	   | _ => false
+        = fn (Assembly.Comment _, _) => true
+           | _ => false
 
       local
-	val isInstruction_dstsTemp_dstsDead : statement_type -> bool
-	  = fn (Assembly.Instruction instruction,
-		Liveness.T {dead,...})
-	     => let
-		  val {dsts,...} = Instruction.srcs_dsts instruction
-		in 
-		  case dsts
-		    of NONE => false
-		     | SOME dsts => List.forall
-		                    (dsts,
-				     fn Operand.MemLoc memloc
-				      => x86Liveness.track memloc
-				         andalso
-					 LiveSet.contains(dead,memloc)
-				      | _ => false)
-		end 
-	     | _ => false
+        val isInstruction_dstsTemp_dstsDead : statement_type -> bool
+          = fn (Assembly.Instruction instruction,
+                Liveness.T {dead,...})
+             => let
+                  val {dsts,...} = Instruction.srcs_dsts instruction
+                in 
+                  case dsts
+                    of NONE => false
+                     | SOME dsts => List.forall
+                                    (dsts,
+                                     fn Operand.MemLoc memloc
+                                      => x86Liveness.track memloc
+                                         andalso
+                                         LiveSet.contains(dead,memloc)
+                                      | _ => false)
+                end 
+             | _ => false
 
-	val template : template 
-	  = {start = EmptyOrNonEmpty,
-	     statements = [One isInstruction_dstsTemp_dstsDead],
-	     finish = EmptyOrNonEmpty,
-	     transfer = fn _ => true}
+        val template : template 
+          = {start = EmptyOrNonEmpty,
+             statements = [One isInstruction_dstsTemp_dstsDead],
+             finish = EmptyOrNonEmpty,
+             transfer = fn _ => true}
 
-	val rewriter : rewriter
-	  = fn {entry,
-		profileLabel,
-		start, 
-		statements =
-		[[(Assembly.Instruction _,
-		   Liveness.T {liveOut,...})]],
-		finish, 
-		transfer}
-	     => if (case List.fold
-		         (finish, (false, false), fn ((asm, _), (b, b')) =>
-			  case asm
-			    of Assembly.Comment _ => (b, b')
-			     | Assembly.Instruction
-			       (Instruction.SETcc _) 
-			     => (true, if b then b' else true)
-			     | _ => (true, b'))
-		      of (_, true) => true
-		       | (false, _) => (case #1 transfer
-					  of Transfer.Iff _ => true
-					   | _ => false)
-		       | _ => false)
-		  then NONE
-		  else let
+        val rewriter : rewriter
+          = fn {entry,
+                profileLabel,
+                start, 
+                statements =
+                [[(Assembly.Instruction _,
+                   Liveness.T {liveOut,...})]],
+                finish, 
+                transfer}
+             => if (case List.fold
+                         (finish, (false, false), fn ((asm, _), (b, b')) =>
+                          case asm
+                            of Assembly.Comment _ => (b, b')
+                             | Assembly.Instruction
+                               (Instruction.SETcc _) 
+                             => (true, if b then b' else true)
+                             | _ => (true, b'))
+                      of (_, true) => true
+                       | (false, _) => (case #1 transfer
+                                          of Transfer.Iff _ => true
+                                           | _ => false)
+                       | _ => false)
+                  then NONE
+                  else let
 (*
-			  val label = let
-					val (entry,_) = entry
-				      in 
-					Entry.label entry
-				      end
-			  val {dsts, ...} = Instruction.srcs_dsts instruction
-			  val _ = print (Label.toString label)
-			  val _ = print ": "
-			  val _ = print (Instruction.toString instruction)
-			  val _ = print ": "
-			  val _ = Option.app
-			          (dsts,
-				   fn dsts 
-				   => List.foreach
-				   (dsts,
-				    fn operand 
-				    => (print (Operand.toString operand);
-					print " ")))
-			  val _ = print "\n"
+                          val label = let
+                                        val (entry,_) = entry
+                                      in 
+                                        Entry.label entry
+                                      end
+                          val {dsts, ...} = Instruction.srcs_dsts instruction
+                          val _ = print (Label.toString label)
+                          val _ = print ": "
+                          val _ = print (Instruction.toString instruction)
+                          val _ = print ": "
+                          val _ = Option.app
+                                  (dsts,
+                                   fn dsts 
+                                   => List.foreach
+                                   (dsts,
+                                    fn operand 
+                                    => (print (Operand.toString operand);
+                                        print " ")))
+                          val _ = print "\n"
 *)
 
-			  val {statements, live}
-			    = LivenessBlock.reLivenessStatements
-			      {statements = List.rev start,
-			       live = liveOut}
-			      
-			  val {entry, ...}
-			    = LivenessBlock.reLivenessEntry
-			      {entry = entry,
-			       live = live}
-			      
-			  val statements
-			    = List.concat [statements, finish]
-		       in
-			 SOME (LivenessBlock.T
-			       {entry = entry,
-				profileLabel = profileLabel,
-				statements = statements,
-				transfer = transfer})
-		       end
-             | _ => Error.bug "Peephole: elimDeadDsts"
+                          val {statements, live}
+                            = LivenessBlock.reLivenessStatements
+                              {statements = List.rev start,
+                               live = liveOut}
+                              
+                          val {entry, ...}
+                            = LivenessBlock.reLivenessEntry
+                              {entry = entry,
+                               live = live}
+                              
+                          val statements
+                            = List.concat [statements, finish]
+                       in
+                         SOME (LivenessBlock.T
+                               {entry = entry,
+                                profileLabel = profileLabel,
+                                statements = statements,
+                                transfer = transfer})
+                       end
+             | _ => Error.bug "x86Simplify.PeeholeBlock: elimDeadDsts"
 
-	val (callback,elimDeadDsts_msg)
-	  = make_callback_msg "elimDeadDsts"
+        val (callback,elimDeadDsts_msg)
+          = make_callback_msg "elimDeadDsts"
       in
-	val elimDeadDsts : optimization
-	  = {template = template,
-	     rewriter = rewriter,
-	     callback = callback}
-	val elimDeadDsts_msg = elimDeadDsts_msg
+        val elimDeadDsts : optimization
+          = {template = template,
+             rewriter = rewriter,
+             callback = callback}
+        val elimDeadDsts_msg = elimDeadDsts_msg
       end
 
       local
-	val isInstructionMOV_dstTemp : statement_type -> bool
-	  = fn (Assembly.Instruction (Instruction.MOV 
-				      {dst = Operand.MemLoc memloc,...}), 
-		_)
-	     => x86Liveness.track memloc
-	     | _ => false
+        val isInstructionMOV_dstTemp : statement_type -> bool
+          = fn (Assembly.Instruction (Instruction.MOV 
+                                      {dst = Operand.MemLoc memloc,...}), 
+                _)
+             => x86Liveness.track memloc
+             | _ => false
 
-	val isInstructionAL_dstTemp : statement_type -> bool
-	  = fn (Assembly.Instruction (Instruction.BinAL
-				      {dst = Operand.MemLoc memloc,...}),
-		_)
-	     => x86Liveness.track memloc
-	     | (Assembly.Instruction (Instruction.pMD
-				      {dst = Operand.MemLoc memloc,...}),
-		
-		_)
-	     => x86Liveness.track memloc
-	     | (Assembly.Instruction (Instruction.IMUL2
-				      {dst = Operand.MemLoc memloc,...}),
-		
-		_)
-	     => x86Liveness.track memloc
-	     | (Assembly.Instruction (Instruction.UnAL
-				      {dst = Operand.MemLoc memloc,...}),
-		
-		_)
-	     => x86Liveness.track memloc
-	     | (Assembly.Instruction (Instruction.SRAL
-				      {dst = Operand.MemLoc memloc,...}),
-		
-		_)
-	     => x86Liveness.track memloc
-	     | _ => false
+        val isInstructionAL_dstTemp : statement_type -> bool
+          = fn (Assembly.Instruction (Instruction.BinAL
+                                      {dst = Operand.MemLoc memloc,...}),
+                _)
+             => x86Liveness.track memloc
+             | (Assembly.Instruction (Instruction.pMD
+                                      {dst = Operand.MemLoc memloc,...}),
+                
+                _)
+             => x86Liveness.track memloc
+             | (Assembly.Instruction (Instruction.IMUL2
+                                      {dst = Operand.MemLoc memloc,...}),
+                
+                _)
+             => x86Liveness.track memloc
+             | (Assembly.Instruction (Instruction.UnAL
+                                      {dst = Operand.MemLoc memloc,...}),
+                
+                _)
+             => x86Liveness.track memloc
+             | (Assembly.Instruction (Instruction.SRAL
+                                      {dst = Operand.MemLoc memloc,...}),
+                
+                _)
+             => x86Liveness.track memloc
+             | _ => false
 
-	val isInstructionMOV_srcTemp_srcDead : statement_type -> bool
-	  = fn (Assembly.Instruction (Instruction.MOV 
-				      {src = Operand.MemLoc memloc,...}),
-		Liveness.T {dead,...})
-	     => x86Liveness.track memloc
-	        andalso
-		LiveSet.contains(dead, memloc)
-	     | _ => false
+        val isInstructionMOV_srcTemp_srcDead : statement_type -> bool
+          = fn (Assembly.Instruction (Instruction.MOV 
+                                      {src = Operand.MemLoc memloc,...}),
+                Liveness.T {dead,...})
+             => x86Liveness.track memloc
+                andalso
+                LiveSet.contains(dead, memloc)
+             | _ => false
 
-	val template : template 
-	  = {start = EmptyOrNonEmpty,
-	     statements = [One isInstructionMOV_dstTemp,
-			   All (fn asm 
-				 => (isComment asm) 
-				    orelse
-				    (isInstructionAL_dstTemp asm)),
-			   One isInstructionMOV_srcTemp_srcDead],
-	     finish = EmptyOrNonEmpty,
-	     transfer = fn _ => true}
+        val template : template 
+          = {start = EmptyOrNonEmpty,
+             statements = [One isInstructionMOV_dstTemp,
+                           All (fn asm 
+                                 => (isComment asm) 
+                                    orelse
+                                    (isInstructionAL_dstTemp asm)),
+                           One isInstructionMOV_srcTemp_srcDead],
+             finish = EmptyOrNonEmpty,
+             transfer = fn _ => true}
 
-	val rewriter : rewriter
-	  = fn {entry,
-		profileLabel,
-		start, 
-		statements =
-		[[(Assembly.Instruction (Instruction.MOV 
-					 {src = src1,
-					  dst = dst1 as Operand.MemLoc memloc1,
-					  size = size1}),
-		   _)],
-		 statements',
-		 [(Assembly.Instruction (Instruction.MOV 
-					 {src = Operand.MemLoc memloc2,
-					  dst = dst2,
-					  size = size2}),
-		   Liveness.T {liveOut = liveOut2,...})]],
-		finish, 
-		transfer}
-	     => if Size.eq(size1,size2) andalso
-	           MemLoc.eq(memloc1,memloc2) andalso
-		   List.forall
-		   (statements',
-		    fn (Assembly.Comment _, _) => true
-		     | (Assembly.Instruction (Instruction.BinAL
-					      {src, 
-					       dst = Operand.MemLoc memloc, 
-					       size,
-					       ...}),
-			_)
-		     => Size.eq(size1,size) andalso
+        val rewriter : rewriter
+          = fn {entry,
+                profileLabel,
+                start, 
+                statements =
+                [[(Assembly.Instruction (Instruction.MOV 
+                                         {src = src1,
+                                          dst = dst1 as Operand.MemLoc memloc1,
+                                          size = size1}),
+                   _)],
+                 statements',
+                 [(Assembly.Instruction (Instruction.MOV 
+                                         {src = Operand.MemLoc memloc2,
+                                          dst = dst2,
+                                          size = size2}),
+                   Liveness.T {liveOut = liveOut2,...})]],
+                finish, 
+                transfer}
+             => if Size.eq(size1,size2) andalso
+                   MemLoc.eq(memloc1,memloc2) andalso
+                   List.forall
+                   (statements',
+                    fn (Assembly.Comment _, _) => true
+                     | (Assembly.Instruction (Instruction.BinAL
+                                              {src, 
+                                               dst = Operand.MemLoc memloc, 
+                                               size,
+                                               ...}),
+                        _)
+                     => Size.eq(size1,size) andalso
                         MemLoc.eq(memloc1,memloc) andalso
-			(case (src,dst2)
-			   of (Operand.MemLoc memloc_src,
-			       Operand.MemLoc memloc_dst2)
-			    => List.forall
-			       (memloc_src::(MemLoc.utilized memloc_src),
-				fn memloc' 
-				 => not (MemLoc.mayAlias(memloc_dst2,memloc')))
-			    | (Operand.Immediate _, _) => true
-			    | _ => false)
-		     | (Assembly.Instruction (Instruction.pMD
-					      {src, 
-					       dst = Operand.MemLoc memloc, 
-					       size,
-					       ...}),
-			_)
-		     => Size.eq(size1,size) andalso
+                        (case (src,dst2)
+                           of (Operand.MemLoc memloc_src,
+                               Operand.MemLoc memloc_dst2)
+                            => List.forall
+                               (memloc_src::(MemLoc.utilized memloc_src),
+                                fn memloc' 
+                                 => not (MemLoc.mayAlias(memloc_dst2,memloc')))
+                            | (Operand.Immediate _, _) => true
+                            | _ => false)
+                     | (Assembly.Instruction (Instruction.pMD
+                                              {src, 
+                                               dst = Operand.MemLoc memloc, 
+                                               size,
+                                               ...}),
+                        _)
+                     => Size.eq(size1,size) andalso
                         MemLoc.eq(memloc1,memloc) andalso
-			(case (src,dst2)
-			   of (Operand.MemLoc memloc_src,
-			       Operand.MemLoc memloc_dst2)
-			    => List.forall
-			       (memloc_src::(MemLoc.utilized memloc_src),
-				fn memloc' 
-				 => not (MemLoc.mayAlias(memloc_dst2,memloc')))
-			    | (Operand.Immediate _, _) => true
-			    | _ => false)
-		     | (Assembly.Instruction (Instruction.IMUL2
-					      {src, 
-					       dst = Operand.MemLoc memloc, 
-					       size}),
-			_)
-		     => Size.eq(size1,size) andalso
+                        (case (src,dst2)
+                           of (Operand.MemLoc memloc_src,
+                               Operand.MemLoc memloc_dst2)
+                            => List.forall
+                               (memloc_src::(MemLoc.utilized memloc_src),
+                                fn memloc' 
+                                 => not (MemLoc.mayAlias(memloc_dst2,memloc')))
+                            | (Operand.Immediate _, _) => true
+                            | _ => false)
+                     | (Assembly.Instruction (Instruction.IMUL2
+                                              {src, 
+                                               dst = Operand.MemLoc memloc, 
+                                               size}),
+                        _)
+                     => Size.eq(size1,size) andalso
                         MemLoc.eq(memloc1,memloc) andalso
-			(case (src,dst2)
-			   of (Operand.MemLoc memloc_src,
-			       Operand.MemLoc memloc_dst2)
-			    => List.forall
-			       (memloc_src::(MemLoc.utilized memloc_src),
-				fn memloc' 
-				 => not (MemLoc.mayAlias(memloc_dst2,memloc')))
-			    | (Operand.Immediate _, _) => true
-			    | _ => false)
-		     | (Assembly.Instruction (Instruction.UnAL
-					      {dst = Operand.MemLoc memloc, 
-					       size,
-					       ...}),
-			_)
-		     => Size.eq(size1,size) andalso
+                        (case (src,dst2)
+                           of (Operand.MemLoc memloc_src,
+                               Operand.MemLoc memloc_dst2)
+                            => List.forall
+                               (memloc_src::(MemLoc.utilized memloc_src),
+                                fn memloc' 
+                                 => not (MemLoc.mayAlias(memloc_dst2,memloc')))
+                            | (Operand.Immediate _, _) => true
+                            | _ => false)
+                     | (Assembly.Instruction (Instruction.UnAL
+                                              {dst = Operand.MemLoc memloc, 
+                                               size,
+                                               ...}),
+                        _)
+                     => Size.eq(size1,size) andalso
                         MemLoc.eq(memloc1,memloc) 
-		     | (Assembly.Instruction (Instruction.SRAL
-					      {count,
-					       dst = Operand.MemLoc memloc, 
-					       size, 
-					       ...}),
-			_)
-		     => Size.eq(size1,size) andalso
+                     | (Assembly.Instruction (Instruction.SRAL
+                                              {count,
+                                               dst = Operand.MemLoc memloc, 
+                                               size, 
+                                               ...}),
+                        _)
+                     => Size.eq(size1,size) andalso
                         MemLoc.eq(memloc1,memloc) andalso
-			(case (count,dst2)
-			   of (Operand.MemLoc memloc_count,
-			       Operand.MemLoc memloc_dst2)
-			    => List.forall
-			       (memloc_count::(MemLoc.utilized memloc_count),
-				fn memloc' 
-				 => not (MemLoc.mayAlias(memloc_dst2,memloc')))
-			    | (Operand.Immediate _, _) => true
-			    | _ => false)
-		     | _ => Error.bug "Peephole: elimALCopy")
-		  then let
-			 val statements
-			   = List.map
-			     (statements',
-			      fn (asm,_)
-			       => Assembly.replace
-			          (fn {...} 
-				    => fn operand 
-				        => if Operand.eq(operand,dst1)
-					     then dst2
-					     else operand)
+                        (case (count,dst2)
+                           of (Operand.MemLoc memloc_count,
+                               Operand.MemLoc memloc_dst2)
+                            => List.forall
+                               (memloc_count::(MemLoc.utilized memloc_count),
+                                fn memloc' 
+                                 => not (MemLoc.mayAlias(memloc_dst2,memloc')))
+                            | (Operand.Immediate _, _) => true
+                            | _ => false)
+                     | _ => Error.bug "x86Simplify.PeeholeBlock: elimALCopy")
+                  then let
+                         val statements
+                           = List.map
+                             (statements',
+                              fn (asm,_)
+                               => Assembly.replace
+                                  (fn {...} 
+                                    => fn operand 
+                                        => if Operand.eq(operand,dst1)
+                                             then dst2
+                                             else operand)
                                   asm)
 
-			 val {statements, ...}
-			   = LivenessBlock.toLivenessStatements
-			     {statements 
-			      = (Assembly.instruction_mov
-				 {src = src1,
-				  dst = dst2,
-				  size = size1})::statements,
-			      live = liveOut2}
+                         val {statements, ...}
+                           = LivenessBlock.toLivenessStatements
+                             {statements 
+                              = (Assembly.instruction_mov
+                                 {src = src1,
+                                  dst = dst2,
+                                  size = size1})::statements,
+                              live = liveOut2}
 
-			 val statements
-			   = List.fold(start,
-				       List.concat [statements,
-						    finish],
-				       op ::)
-		       in
-			 SOME (LivenessBlock.T
-			       {entry = entry,
-				profileLabel = profileLabel,
-				statements = statements,
-				transfer = transfer})		 
-		       end
-		  else NONE
-             | _ => Error.bug "Peephole: elimALCopy"
+                         val statements
+                           = List.fold(start,
+                                       List.concat [statements,
+                                                    finish],
+                                       op ::)
+                       in
+                         SOME (LivenessBlock.T
+                               {entry = entry,
+                                profileLabel = profileLabel,
+                                statements = statements,
+                                transfer = transfer})            
+                       end
+                  else NONE
+             | _ => Error.bug "x86Simplify.PeeholeBlock: elimALCopy"
 
-	val (callback,elimALCopy_msg)
-	  = make_callback_msg "elimALCopy"
+        val (callback,elimALCopy_msg)
+          = make_callback_msg "elimALCopy"
       in
-	val elimALCopy : optimization
-	  = {template = template,
-	     rewriter = rewriter,
-	     callback = callback}
-	val elimALCopy_msg = elimALCopy_msg
+        val elimALCopy : optimization
+          = {template = template,
+             rewriter = rewriter,
+             callback = callback}
+        val elimALCopy_msg = elimALCopy_msg
       end
 
       local
-	val isInstructionMOV_eqSrcDst : statement_type -> bool
-	= fn (Assembly.Instruction (Instruction.MOV 
-				    {dst = Operand.MemLoc memloc1,
-				     src = Operand.MemLoc memloc2,...}),
-	      _) 
-	   => MemLoc.eq(memloc1,memloc2) 
-	   | _ => false
+        val isInstructionMOV_eqSrcDst : statement_type -> bool
+        = fn (Assembly.Instruction (Instruction.MOV 
+                                    {dst = Operand.MemLoc memloc1,
+                                     src = Operand.MemLoc memloc2,...}),
+              _) 
+           => MemLoc.eq(memloc1,memloc2) 
+           | _ => false
 
-	val template : template 
-	  = {start = EmptyOrNonEmpty,
-	     statements = [One isInstructionMOV_eqSrcDst],
-	     finish = EmptyOrNonEmpty,
-	     transfer = fn _ => true}
+        val template : template 
+          = {start = EmptyOrNonEmpty,
+             statements = [One isInstructionMOV_eqSrcDst],
+             finish = EmptyOrNonEmpty,
+             transfer = fn _ => true}
 
-	val rewriter : rewriter
-	  = fn {entry,
-		profileLabel,
-		start, 
-		statements =
-		[[(Assembly.Instruction (Instruction.MOV 
-					 {src = Operand.MemLoc memloc, ...}),
-		   Liveness.T {liveOut,...})]],
-		finish, 
-		transfer}
-	     => if List.exists (MemLoc.utilized memloc, x86Liveness.track)
-		   then let
-			   val {statements, live} =
-			      LivenessBlock.reLivenessStatements
-			      {statements = List.rev start,
-			       live = liveOut}
-			   val {entry, ...} =
-			      LivenessBlock.reLivenessEntry
-			      {entry = entry,
-			       live = live}
-			   val statements =
-			      List.concat [statements, finish]
-			in 
-			   SOME (LivenessBlock.T
-				 {entry = entry,
-				  profileLabel = profileLabel,
-				  statements = statements,
-				  transfer = transfer})
-			end
-		   else let
-			   val statements =
-			      List.fold(start, finish, op ::)
-			in
-			   SOME (LivenessBlock.T
-				 {entry = entry,
-				  profileLabel = profileLabel,
-				  statements = statements,
-				  transfer = transfer})
-			end
-	     | _ => Error.bug "Peephole: elimSelfMove"
+        val rewriter : rewriter
+          = fn {entry,
+                profileLabel,
+                start, 
+                statements =
+                [[(Assembly.Instruction (Instruction.MOV 
+                                         {src = Operand.MemLoc memloc, ...}),
+                   Liveness.T {liveOut,...})]],
+                finish, 
+                transfer}
+             => if List.exists (MemLoc.utilized memloc, x86Liveness.track)
+                   then let
+                           val {statements, live} =
+                              LivenessBlock.reLivenessStatements
+                              {statements = List.rev start,
+                               live = liveOut}
+                           val {entry, ...} =
+                              LivenessBlock.reLivenessEntry
+                              {entry = entry,
+                               live = live}
+                           val statements =
+                              List.concat [statements, finish]
+                        in 
+                           SOME (LivenessBlock.T
+                                 {entry = entry,
+                                  profileLabel = profileLabel,
+                                  statements = statements,
+                                  transfer = transfer})
+                        end
+                   else let
+                           val statements =
+                              List.fold(start, finish, op ::)
+                        in
+                           SOME (LivenessBlock.T
+                                 {entry = entry,
+                                  profileLabel = profileLabel,
+                                  statements = statements,
+                                  transfer = transfer})
+                        end
+             | _ => Error.bug "x86Simplify.PeeholeBlock: elimSelfMove"
 
-	val (callback,elimSelfMove_msg)
-	  = make_callback_msg "elimSelfMove"
+        val (callback,elimSelfMove_msg)
+          = make_callback_msg "elimSelfMove"
       in
-	val elimSelfMove : optimization
-	  = {template = template,
-	     rewriter = rewriter,
-	     callback = callback}
-	val elimSelfMove_msg = elimSelfMove_msg
+        val elimSelfMove : optimization
+          = {template = template,
+             rewriter = rewriter,
+             callback = callback}
+        val elimSelfMove_msg = elimSelfMove_msg
       end
 
       local
-	val isInstructionMOV_dstMemloc : statement_type -> bool
-	  = fn (Assembly.Instruction (Instruction.MOV 
-				      {dst = Operand.MemLoc _,...}),
-		_)
-	     => true
-	     | _ => false
+        val isInstructionMOV_dstMemloc : statement_type -> bool
+          = fn (Assembly.Instruction (Instruction.MOV 
+                                      {dst = Operand.MemLoc _,...}),
+                _)
+             => true
+             | _ => false
 
-	val isInstructionBinALMD_dstMemloc_operCommute : statement_type -> bool
-	  = fn (Assembly.Instruction (Instruction.BinAL
-				      {oper,
-				       dst = Operand.MemLoc _,...}),
-		_)
-	     => (oper = Instruction.ADD)
-	        orelse
-		(oper = Instruction.ADC)
-		orelse
-		(oper = Instruction.AND)
-		orelse
-		(oper = Instruction.OR)
-		orelse
-		(oper = Instruction.XOR)
-	     | (Assembly.Instruction (Instruction.pMD
-				      {oper,
-				       dst = Operand.MemLoc _,...}),
-		_)
-	     => (oper = Instruction.IMUL)
-	        orelse
-		(oper = Instruction.MUL)
-	     | (Assembly.Instruction (Instruction.IMUL2
-				      {dst = Operand.MemLoc _,...}),
-		_)
-	     => true 
-	     | _ => false
+        val isInstructionBinALMD_dstMemloc_operCommute : statement_type -> bool
+          = fn (Assembly.Instruction (Instruction.BinAL
+                                      {oper,
+                                       dst = Operand.MemLoc _,...}),
+                _)
+             => (oper = Instruction.ADD)
+                orelse
+                (oper = Instruction.ADC)
+                orelse
+                (oper = Instruction.AND)
+                orelse
+                (oper = Instruction.OR)
+                orelse
+                (oper = Instruction.XOR)
+             | (Assembly.Instruction (Instruction.pMD
+                                      {oper,
+                                       dst = Operand.MemLoc _,...}),
+                _)
+             => (oper = Instruction.IMUL)
+                orelse
+                (oper = Instruction.MUL)
+             | (Assembly.Instruction (Instruction.IMUL2
+                                      {dst = Operand.MemLoc _,...}),
+                _)
+             => true 
+             | _ => false
 
-	val template : template 
-	  = {start = EmptyOrNonEmpty,
-	     statements = [One isInstructionMOV_dstMemloc,
-			   All isComment,
-			   One isInstructionBinALMD_dstMemloc_operCommute],
-	     finish = EmptyOrNonEmpty,
-	     transfer = fn _ => true}
+        val template : template 
+          = {start = EmptyOrNonEmpty,
+             statements = [One isInstructionMOV_dstMemloc,
+                           All isComment,
+                           One isInstructionBinALMD_dstMemloc_operCommute],
+             finish = EmptyOrNonEmpty,
+             transfer = fn _ => true}
 
-	val rewriter : rewriter
-	  = fn {entry,
-		profileLabel,
-		start, 
-		statements =
-		[[(Assembly.Instruction (Instruction.MOV 
-					 {src = src1,
-					  dst 
-					  = dst1 as Operand.MemLoc memloc_dst1,
-					  size = size1}),
-		   Liveness.T {dead = dead1,...})],
-		 comments,
-		 [(Assembly.Instruction (Instruction.BinAL 
-					 {oper = oper2,
-					  src = src2,
-					  dst 
-					  = dst2 as Operand.MemLoc _,
-					  size = size2}),
-		   Liveness.T {dead = dead2,
-			       liveOut = liveOut2, ...})]],
-		finish, 
-		transfer}
-	     => if Size.eq(size1,size2) andalso
-	           Operand.eq(dst1,dst2) andalso
-		   not (Operand.eq(src1,src2)) andalso
-		   (case (src1,src2)
-		      of (Operand.MemLoc memloc_src1,
-			  Operand.MemLoc memloc_src2)
-		       => LiveSet.contains(dead2,
-					   memloc_src2)
-			  andalso
-			  not (LiveSet.contains(dead1,
-						memloc_src1))
-		       | (_, Operand.MemLoc memloc_src2)
-		       => LiveSet.contains(dead2,
-					   memloc_src2)
-		       | _ => false) andalso
-		   (case src1
-		      of Operand.MemLoc memloc_src1
-		       => not (List.exists
-			       (memloc_src1::(MemLoc.utilized memloc_src1),
-				fn memloc'
-				 => MemLoc.mayAlias(memloc',memloc_dst1)))
-		       | _ => true) andalso
-		   (case src2
-		      of Operand.MemLoc memloc_src2
-		       => not (List.exists
-			       (memloc_src2::(MemLoc.utilized memloc_src2),
-				fn memloc'
-				 => MemLoc.mayAlias(memloc',memloc_dst1)))
-		       | _ => true)
-		  then let
-			 val statements
-			   = (Assembly.instruction_mov
-			      {src = src2,
-			       dst = dst1,
-			       size = size1})::
-			     (List.concat
-			      [List.map(comments, #1),
-			       [Assembly.instruction_binal
-				{oper = oper2,
-				 src = src1,
-				 dst = dst2,
-				 size = size2}]])
+        val rewriter : rewriter
+          = fn {entry,
+                profileLabel,
+                start, 
+                statements =
+                [[(Assembly.Instruction (Instruction.MOV 
+                                         {src = src1,
+                                          dst 
+                                          = dst1 as Operand.MemLoc memloc_dst1,
+                                          size = size1}),
+                   Liveness.T {dead = dead1,...})],
+                 comments,
+                 [(Assembly.Instruction (Instruction.BinAL 
+                                         {oper = oper2,
+                                          src = src2,
+                                          dst 
+                                          = dst2 as Operand.MemLoc _,
+                                          size = size2}),
+                   Liveness.T {dead = dead2,
+                               liveOut = liveOut2, ...})]],
+                finish, 
+                transfer}
+             => if Size.eq(size1,size2) andalso
+                   Operand.eq(dst1,dst2) andalso
+                   not (Operand.eq(src1,src2)) andalso
+                   (case (src1,src2)
+                      of (Operand.MemLoc memloc_src1,
+                          Operand.MemLoc memloc_src2)
+                       => LiveSet.contains(dead2,
+                                           memloc_src2)
+                          andalso
+                          not (LiveSet.contains(dead1,
+                                                memloc_src1))
+                       | (_, Operand.MemLoc memloc_src2)
+                       => LiveSet.contains(dead2,
+                                           memloc_src2)
+                       | _ => false) andalso
+                   (case src1
+                      of Operand.MemLoc memloc_src1
+                       => not (List.exists
+                               (memloc_src1::(MemLoc.utilized memloc_src1),
+                                fn memloc'
+                                 => MemLoc.mayAlias(memloc',memloc_dst1)))
+                       | _ => true) andalso
+                   (case src2
+                      of Operand.MemLoc memloc_src2
+                       => not (List.exists
+                               (memloc_src2::(MemLoc.utilized memloc_src2),
+                                fn memloc'
+                                 => MemLoc.mayAlias(memloc',memloc_dst1)))
+                       | _ => true)
+                  then let
+                         val statements
+                           = (Assembly.instruction_mov
+                              {src = src2,
+                               dst = dst1,
+                               size = size1})::
+                             (List.concat
+                              [List.map(comments, #1),
+                               [Assembly.instruction_binal
+                                {oper = oper2,
+                                 src = src1,
+                                 dst = dst2,
+                                 size = size2}]])
 
-			 val {statements, ...}
-			   = LivenessBlock.toLivenessStatements
-			     {statements = statements,
-			      live = liveOut2}
+                         val {statements, ...}
+                           = LivenessBlock.toLivenessStatements
+                             {statements = statements,
+                              live = liveOut2}
 
-			 val statements
-			   = List.fold(start,
-				       List.concat [statements, 
-						    finish],
-				       op ::)
-		       in
-			 SOME (LivenessBlock.T
-			       {entry = entry,	
-				profileLabel = profileLabel,
-				statements = statements,
-				transfer = transfer})		 
-		       end
-		  else NONE
-	     | {entry,
-		profileLabel,
-		start, 
-		statements =
-		[[(Assembly.Instruction (Instruction.MOV 
-					 {src = src1,
-					  dst 
-					  = dst1 as Operand.MemLoc memloc_dst1,
-					  size = size1}),
-		   Liveness.T {dead = dead1,...})],
-		 comments,
-		 [(Assembly.Instruction (Instruction.pMD 
-					 {oper = oper2,
-					  src = src2,
-					  dst 
-					  = dst2 as Operand.MemLoc _,
-					  size = size2}),
-		   Liveness.T {dead = dead2,
-			       liveOut = liveOut2,...})]],
-		finish, 
-		transfer}
-	     => if Size.eq(size1,size2) andalso
-	           Operand.eq(dst1,dst2) andalso
-		   not (Operand.eq(src1,src2)) andalso
-		   (case (src1,src2)
-		      of (Operand.MemLoc memloc_src1,
-			  Operand.MemLoc memloc_src2)
-		       => LiveSet.contains(dead2,
-					   memloc_src2)
-			  andalso
-			  not (LiveSet.contains(dead1,
-						memloc_src1))
-		       | (_, Operand.MemLoc memloc_src2)
-		       => LiveSet.contains(dead2,
-					   memloc_src2)
-		       | _ => false) andalso
-		   (case src1
-		      of Operand.MemLoc memloc_src1
-		       => not (List.exists
-			       (memloc_src1::(MemLoc.utilized memloc_src1),
-				fn memloc'
-				 => MemLoc.mayAlias(memloc',memloc_dst1)))
-		       | _ => true) andalso
-		   (case src2
-		      of Operand.MemLoc memloc_src2
-		       => not (List.exists
-			       (memloc_src2::(MemLoc.utilized memloc_src2),
-				fn memloc'
-				 => MemLoc.mayAlias(memloc',memloc_dst1)))
-		       | _ => true)
-		  then let
-			 val statements
-			   = (Assembly.instruction_mov
-			      {src = src2,
-			       dst = dst1,
-			       size = size1})::
-			     (List.concat
-			      [List.map(comments, #1),
-			       [Assembly.instruction_pmd
-				{oper = oper2,
-				 src = src1,
-				 dst = dst2,
-				 size = size2}]])
+                         val statements
+                           = List.fold(start,
+                                       List.concat [statements, 
+                                                    finish],
+                                       op ::)
+                       in
+                         SOME (LivenessBlock.T
+                               {entry = entry,  
+                                profileLabel = profileLabel,
+                                statements = statements,
+                                transfer = transfer})            
+                       end
+                  else NONE
+             | {entry,
+                profileLabel,
+                start, 
+                statements =
+                [[(Assembly.Instruction (Instruction.MOV 
+                                         {src = src1,
+                                          dst 
+                                          = dst1 as Operand.MemLoc memloc_dst1,
+                                          size = size1}),
+                   Liveness.T {dead = dead1,...})],
+                 comments,
+                 [(Assembly.Instruction (Instruction.pMD 
+                                         {oper = oper2,
+                                          src = src2,
+                                          dst 
+                                          = dst2 as Operand.MemLoc _,
+                                          size = size2}),
+                   Liveness.T {dead = dead2,
+                               liveOut = liveOut2,...})]],
+                finish, 
+                transfer}
+             => if Size.eq(size1,size2) andalso
+                   Operand.eq(dst1,dst2) andalso
+                   not (Operand.eq(src1,src2)) andalso
+                   (case (src1,src2)
+                      of (Operand.MemLoc memloc_src1,
+                          Operand.MemLoc memloc_src2)
+                       => LiveSet.contains(dead2,
+                                           memloc_src2)
+                          andalso
+                          not (LiveSet.contains(dead1,
+                                                memloc_src1))
+                       | (_, Operand.MemLoc memloc_src2)
+                       => LiveSet.contains(dead2,
+                                           memloc_src2)
+                       | _ => false) andalso
+                   (case src1
+                      of Operand.MemLoc memloc_src1
+                       => not (List.exists
+                               (memloc_src1::(MemLoc.utilized memloc_src1),
+                                fn memloc'
+                                 => MemLoc.mayAlias(memloc',memloc_dst1)))
+                       | _ => true) andalso
+                   (case src2
+                      of Operand.MemLoc memloc_src2
+                       => not (List.exists
+                               (memloc_src2::(MemLoc.utilized memloc_src2),
+                                fn memloc'
+                                 => MemLoc.mayAlias(memloc',memloc_dst1)))
+                       | _ => true)
+                  then let
+                         val statements
+                           = (Assembly.instruction_mov
+                              {src = src2,
+                               dst = dst1,
+                               size = size1})::
+                             (List.concat
+                              [List.map(comments, #1),
+                               [Assembly.instruction_pmd
+                                {oper = oper2,
+                                 src = src1,
+                                 dst = dst2,
+                                 size = size2}]])
 
-			 val {statements, ...}
-			   = LivenessBlock.toLivenessStatements
-			     {statements = statements,
-			      live = liveOut2}
+                         val {statements, ...}
+                           = LivenessBlock.toLivenessStatements
+                             {statements = statements,
+                              live = liveOut2}
 
-			 val statements
-			   = List.fold(start,
-				       List.concat [statements,
-						    finish],
-				       op ::)
-		       in
-			 SOME (LivenessBlock.T
-			       {entry = entry,
-				profileLabel = profileLabel,
-				statements = statements,
-				transfer = transfer})		 
-		       end
-		  else NONE
-	     | {entry,
-		profileLabel,
-		start, 
-		statements =
-		[[(Assembly.Instruction (Instruction.MOV 
-					 {src = src1,
-					  dst 
-					  = dst1 as Operand.MemLoc memloc_dst1,
-					  size = size1}),
-		   Liveness.T {dead = dead1,...})],
-		 comments,
-		 [(Assembly.Instruction (Instruction.IMUL2
-					 {src = src2,
-					  dst 
-					  = dst2 as Operand.MemLoc _,
-					  size = size2}),
-		   Liveness.T {dead = dead2,
-			       liveOut = liveOut2,...})]],
-		finish, 
-		transfer}
-	     => if Size.eq(size1,size2) andalso
-	           Operand.eq(dst1,dst2) andalso
-		   not (Operand.eq(src1,src2)) andalso
-		   (case (src1,src2)
-		      of (Operand.MemLoc memloc_src1,
-			  Operand.MemLoc memloc_src2)
-		       => LiveSet.contains(dead2,
-					   memloc_src2)
-			  andalso
-			  not (LiveSet.contains(dead1,
-						memloc_src1))
-		       | (_, Operand.MemLoc memloc_src2)
-		       => LiveSet.contains(dead2,
-					   memloc_src2)
-		       | _ => false) andalso
-		   (case src1
-		      of Operand.MemLoc memloc_src1
-		       => not (List.exists
-			       (memloc_src1::(MemLoc.utilized memloc_src1),
-				fn memloc'
-				 => MemLoc.mayAlias(memloc',memloc_dst1)))
-		       | _ => true) andalso
-		   (case src2
-		      of Operand.MemLoc memloc_src2
-		       => not (List.exists
-			       (memloc_src2::(MemLoc.utilized memloc_src2),
-				fn memloc'
-				 => MemLoc.mayAlias(memloc',memloc_dst1)))
-		       | _ => true)
-		  then let
-			 val statements
-			   = (Assembly.instruction_mov
-			      {src = src2,
-			       dst = dst1,
-			       size = size1})::
-			     (List.concat
-			      [List.map(comments, #1),
-			       [Assembly.instruction_imul2
-				{src = src1,
-				 dst = dst2,
-				 size = size2}]])
+                         val statements
+                           = List.fold(start,
+                                       List.concat [statements,
+                                                    finish],
+                                       op ::)
+                       in
+                         SOME (LivenessBlock.T
+                               {entry = entry,
+                                profileLabel = profileLabel,
+                                statements = statements,
+                                transfer = transfer})            
+                       end
+                  else NONE
+             | {entry,
+                profileLabel,
+                start, 
+                statements =
+                [[(Assembly.Instruction (Instruction.MOV 
+                                         {src = src1,
+                                          dst 
+                                          = dst1 as Operand.MemLoc memloc_dst1,
+                                          size = size1}),
+                   Liveness.T {dead = dead1,...})],
+                 comments,
+                 [(Assembly.Instruction (Instruction.IMUL2
+                                         {src = src2,
+                                          dst 
+                                          = dst2 as Operand.MemLoc _,
+                                          size = size2}),
+                   Liveness.T {dead = dead2,
+                               liveOut = liveOut2,...})]],
+                finish, 
+                transfer}
+             => if Size.eq(size1,size2) andalso
+                   Operand.eq(dst1,dst2) andalso
+                   not (Operand.eq(src1,src2)) andalso
+                   (case (src1,src2)
+                      of (Operand.MemLoc memloc_src1,
+                          Operand.MemLoc memloc_src2)
+                       => LiveSet.contains(dead2,
+                                           memloc_src2)
+                          andalso
+                          not (LiveSet.contains(dead1,
+                                                memloc_src1))
+                       | (_, Operand.MemLoc memloc_src2)
+                       => LiveSet.contains(dead2,
+                                           memloc_src2)
+                       | _ => false) andalso
+                   (case src1
+                      of Operand.MemLoc memloc_src1
+                       => not (List.exists
+                               (memloc_src1::(MemLoc.utilized memloc_src1),
+                                fn memloc'
+                                 => MemLoc.mayAlias(memloc',memloc_dst1)))
+                       | _ => true) andalso
+                   (case src2
+                      of Operand.MemLoc memloc_src2
+                       => not (List.exists
+                               (memloc_src2::(MemLoc.utilized memloc_src2),
+                                fn memloc'
+                                 => MemLoc.mayAlias(memloc',memloc_dst1)))
+                       | _ => true)
+                  then let
+                         val statements
+                           = (Assembly.instruction_mov
+                              {src = src2,
+                               dst = dst1,
+                               size = size1})::
+                             (List.concat
+                              [List.map(comments, #1),
+                               [Assembly.instruction_imul2
+                                {src = src1,
+                                 dst = dst2,
+                                 size = size2}]])
 
-			 val {statements, ...}
-			   = LivenessBlock.toLivenessStatements
-			     {statements = statements,
-			      live = liveOut2}
+                         val {statements, ...}
+                           = LivenessBlock.toLivenessStatements
+                             {statements = statements,
+                              live = liveOut2}
 
-			 val statements
-			   = List.fold(start,
-				       List.concat [statements,
-						    finish],
-				       op ::)
-		       in
-			 SOME (LivenessBlock.T
-			       {entry = entry,
-				profileLabel = profileLabel,
-				statements = statements,
-				transfer = transfer})		 
-		       end
-		  else NONE
-             | _ => Error.bug "Peephole: commuteBinALMD"
+                         val statements
+                           = List.fold(start,
+                                       List.concat [statements,
+                                                    finish],
+                                       op ::)
+                       in
+                         SOME (LivenessBlock.T
+                               {entry = entry,
+                                profileLabel = profileLabel,
+                                statements = statements,
+                                transfer = transfer})            
+                       end
+                  else NONE
+             | _ => Error.bug "x86Simplify.PeeholeBlock: commuteBinALMD"
 
-	val (callback,commuteBinALMD_msg)
-	  = make_callback_msg "commuteBinALMD"
+        val (callback,commuteBinALMD_msg)
+          = make_callback_msg "commuteBinALMD"
       in
-	val commuteBinALMD : optimization
-	  = {template = template,
-	     rewriter = rewriter,
-	     callback = callback}
-	val commuteBinALMD_msg = commuteBinALMD_msg
+        val commuteBinALMD : optimization
+          = {template = template,
+             rewriter = rewriter,
+             callback = callback}
+        val commuteBinALMD_msg = commuteBinALMD_msg
       end
 
       local
-	val isInstructionFMOV_dstTemp : statement_type -> bool
-	  = fn (Assembly.Instruction (Instruction.pFMOV 
-				      {dst = Operand.MemLoc memloc,...}), 
-		_)
-	     => x86Liveness.track memloc
-	     | _ => false
+        val isInstructionFMOV_dstTemp : statement_type -> bool
+          = fn (Assembly.Instruction (Instruction.pFMOV 
+                                      {dst = Operand.MemLoc memloc,...}), 
+                _)
+             => x86Liveness.track memloc
+             | _ => false
 
-	val isInstructionFltA_dstTemp : statement_type -> bool
-	  = fn (Assembly.Instruction (Instruction.pFBinA
-				      {dst = Operand.MemLoc memloc,...}),
-		_)
-	     => x86Liveness.track memloc
-	     | (Assembly.Instruction (Instruction.pFUnA
-				      {dst = Operand.MemLoc memloc,...}),
-		
-		_)
-	     => x86Liveness.track memloc
-	     | (Assembly.Instruction (Instruction.pFPTAN
-				      {dst = Operand.MemLoc memloc,...}),
-		
-		_)
-	     => x86Liveness.track memloc
-	     | (Assembly.Instruction (Instruction.pFBinAS
-				      {dst = Operand.MemLoc memloc,...}),
-		_)
-	     => x86Liveness.track memloc
-	     | (Assembly.Instruction (Instruction.pFBinASP
-				      {dst = Operand.MemLoc memloc,...}),
-		_)
-	     => x86Liveness.track memloc
-	     | _ => false
+        val isInstructionFltA_dstTemp : statement_type -> bool
+          = fn (Assembly.Instruction (Instruction.pFBinA
+                                      {dst = Operand.MemLoc memloc,...}),
+                _)
+             => x86Liveness.track memloc
+             | (Assembly.Instruction (Instruction.pFUnA
+                                      {dst = Operand.MemLoc memloc,...}),
+                
+                _)
+             => x86Liveness.track memloc
+             | (Assembly.Instruction (Instruction.pFPTAN
+                                      {dst = Operand.MemLoc memloc,...}),
+                
+                _)
+             => x86Liveness.track memloc
+             | (Assembly.Instruction (Instruction.pFBinAS
+                                      {dst = Operand.MemLoc memloc,...}),
+                _)
+             => x86Liveness.track memloc
+             | (Assembly.Instruction (Instruction.pFBinASP
+                                      {dst = Operand.MemLoc memloc,...}),
+                _)
+             => x86Liveness.track memloc
+             | _ => false
 
-	val isInstructionFMOV_srcTemp_srcDead : statement_type -> bool
-	  = fn (Assembly.Instruction (Instruction.pFMOV 
-				      {src = Operand.MemLoc memloc,...}),
-		Liveness.T {dead,...})
-	     => x86Liveness.track memloc
-	        andalso
-		LiveSet.contains(dead, memloc)
-	     | _ => false
+        val isInstructionFMOV_srcTemp_srcDead : statement_type -> bool
+          = fn (Assembly.Instruction (Instruction.pFMOV 
+                                      {src = Operand.MemLoc memloc,...}),
+                Liveness.T {dead,...})
+             => x86Liveness.track memloc
+                andalso
+                LiveSet.contains(dead, memloc)
+             | _ => false
 
-	val template : template 
-	  = {start = EmptyOrNonEmpty,
-	     statements = [One isInstructionFMOV_dstTemp,
-			   All (fn asm 
-				 => (isComment asm) 
-				    orelse
-				    (isInstructionFltA_dstTemp asm)),
-			   One isInstructionFMOV_srcTemp_srcDead],
-	     finish = EmptyOrNonEmpty,
-	     transfer = fn _ => true}
+        val template : template 
+          = {start = EmptyOrNonEmpty,
+             statements = [One isInstructionFMOV_dstTemp,
+                           All (fn asm 
+                                 => (isComment asm) 
+                                    orelse
+                                    (isInstructionFltA_dstTemp asm)),
+                           One isInstructionFMOV_srcTemp_srcDead],
+             finish = EmptyOrNonEmpty,
+             transfer = fn _ => true}
 
-	val rewriter : rewriter
-	  = fn {entry,
-		profileLabel,
-		start, 
-		statements =
-		[[(Assembly.Instruction (Instruction.pFMOV 
-					 {src = src1,
-					  dst = dst1 as Operand.MemLoc memloc1,
-					  size = size1}),
-		   _)],
-		 statements',
-		 [(Assembly.Instruction (Instruction.pFMOV 
-					 {src = Operand.MemLoc memloc2,
-					  dst = dst2,
-					  size = size2}),
-		   Liveness.T {liveOut = liveOut2,...})]],
-		finish, 
-		transfer}
-	     => if Size.eq(size1,size2) andalso
-	           MemLoc.eq(memloc1,memloc2) andalso
-		   List.forall
-		   (statements',
-		    fn (Assembly.Comment _, _) => true
-		     | (Assembly.Instruction (Instruction.pFBinA
-					      {src, 
-					       dst = Operand.MemLoc memloc, 
-					       size,
-					       ...}),
-			_)
-		     => Size.eq(size1,size) andalso
+        val rewriter : rewriter
+          = fn {entry,
+                profileLabel,
+                start, 
+                statements =
+                [[(Assembly.Instruction (Instruction.pFMOV 
+                                         {src = src1,
+                                          dst = dst1 as Operand.MemLoc memloc1,
+                                          size = size1}),
+                   _)],
+                 statements',
+                 [(Assembly.Instruction (Instruction.pFMOV 
+                                         {src = Operand.MemLoc memloc2,
+                                          dst = dst2,
+                                          size = size2}),
+                   Liveness.T {liveOut = liveOut2,...})]],
+                finish, 
+                transfer}
+             => if Size.eq(size1,size2) andalso
+                   MemLoc.eq(memloc1,memloc2) andalso
+                   List.forall
+                   (statements',
+                    fn (Assembly.Comment _, _) => true
+                     | (Assembly.Instruction (Instruction.pFBinA
+                                              {src, 
+                                               dst = Operand.MemLoc memloc, 
+                                               size,
+                                               ...}),
+                        _)
+                     => Size.eq(size1,size) andalso
                         MemLoc.eq(memloc1,memloc) andalso
-			(case (src,dst2)
-			   of (Operand.MemLoc memloc_src,
-			       Operand.MemLoc memloc_dst2)
-			    => List.forall
-			       (memloc_src::(MemLoc.utilized memloc_src),
-				fn memloc' 
-				 => not (MemLoc.mayAlias(memloc_dst2,memloc')))
-			    | (Operand.Immediate _, _) => true
-			    | _ => false)
-		     | (Assembly.Instruction (Instruction.pFUnA
-					      {dst = Operand.MemLoc memloc, 
-					       size, 
-					       ...}),
-			_)
-		     => Size.eq(size1,size) andalso
+                        (case (src,dst2)
+                           of (Operand.MemLoc memloc_src,
+                               Operand.MemLoc memloc_dst2)
+                            => List.forall
+                               (memloc_src::(MemLoc.utilized memloc_src),
+                                fn memloc' 
+                                 => not (MemLoc.mayAlias(memloc_dst2,memloc')))
+                            | (Operand.Immediate _, _) => true
+                            | _ => false)
+                     | (Assembly.Instruction (Instruction.pFUnA
+                                              {dst = Operand.MemLoc memloc, 
+                                               size, 
+                                               ...}),
+                        _)
+                     => Size.eq(size1,size) andalso
                         MemLoc.eq(memloc1,memloc) 
-		     | (Assembly.Instruction (Instruction.pFPTAN
-					      {dst = Operand.MemLoc memloc, 
-					       size}),
-			_)
-		     => Size.eq(size1,size) andalso
+                     | (Assembly.Instruction (Instruction.pFPTAN
+                                              {dst = Operand.MemLoc memloc, 
+                                               size}),
+                        _)
+                     => Size.eq(size1,size) andalso
                         MemLoc.eq(memloc1,memloc) 
-		     | (Assembly.Instruction (Instruction.pFBinAS
-					      {src, 
-					       dst = Operand.MemLoc memloc, 
-					       size,
-					       ...}),
-			_)
-		     => Size.eq(size1,size) andalso
+                     | (Assembly.Instruction (Instruction.pFBinAS
+                                              {src, 
+                                               dst = Operand.MemLoc memloc, 
+                                               size,
+                                               ...}),
+                        _)
+                     => Size.eq(size1,size) andalso
                         MemLoc.eq(memloc1,memloc) andalso
-			(case (src,dst2)
-			   of (Operand.MemLoc memloc_src,
-			       Operand.MemLoc memloc_dst2)
-			    => List.forall
-			       (memloc_src::(MemLoc.utilized memloc_src),
-				fn memloc' 
-				 => not (MemLoc.mayAlias(memloc_dst2,memloc')))
-			    | (Operand.Immediate _, _) => true
-			    | _ => false)
-		     | (Assembly.Instruction (Instruction.pFBinASP
-					      {src, 
-					       dst = Operand.MemLoc memloc, 
-					       size, 
-					       ...}),
-			_)
-		     => Size.eq(size1,size) andalso
+                        (case (src,dst2)
+                           of (Operand.MemLoc memloc_src,
+                               Operand.MemLoc memloc_dst2)
+                            => List.forall
+                               (memloc_src::(MemLoc.utilized memloc_src),
+                                fn memloc' 
+                                 => not (MemLoc.mayAlias(memloc_dst2,memloc')))
+                            | (Operand.Immediate _, _) => true
+                            | _ => false)
+                     | (Assembly.Instruction (Instruction.pFBinASP
+                                              {src, 
+                                               dst = Operand.MemLoc memloc, 
+                                               size, 
+                                               ...}),
+                        _)
+                     => Size.eq(size1,size) andalso
                         MemLoc.eq(memloc1,memloc) andalso
-			(case (src,dst2)
-			   of (Operand.MemLoc memloc_src,
-			       Operand.MemLoc memloc_dst2)
-			    => List.forall
-			       (memloc_src::(MemLoc.utilized memloc_src),
-				fn memloc' 
-				 => not (MemLoc.mayAlias(memloc_dst2,memloc')))
-			    | (Operand.Immediate _, _) => true
-			    | _ => false)
-		     | _ => Error.bug "Peephole: elimFltACopy")
-		  then let
-			 val statements
-			   = List.map
-			     (statements',
-			      fn (asm,_)
-			       => Assembly.replace
-			          (fn {...} 
-				    => fn operand 
-				        => if Operand.eq(operand,dst1)
-					     then dst2
-					     else operand)
+                        (case (src,dst2)
+                           of (Operand.MemLoc memloc_src,
+                               Operand.MemLoc memloc_dst2)
+                            => List.forall
+                               (memloc_src::(MemLoc.utilized memloc_src),
+                                fn memloc' 
+                                 => not (MemLoc.mayAlias(memloc_dst2,memloc')))
+                            | (Operand.Immediate _, _) => true
+                            | _ => false)
+                     | _ => Error.bug "x86Simplify.PeeholeBlock: elimFltACopy")
+                  then let
+                         val statements
+                           = List.map
+                             (statements',
+                              fn (asm,_)
+                               => Assembly.replace
+                                  (fn {...} 
+                                    => fn operand 
+                                        => if Operand.eq(operand,dst1)
+                                             then dst2
+                                             else operand)
                                   asm)
 
-			 val {statements, ...}
-			   = LivenessBlock.toLivenessStatements
-			     {statements 
-			      = (Assembly.instruction_pfmov
-				 {src = src1,
-				  dst = dst2,
-				  size = size1})::statements,
-			      live = liveOut2}
+                         val {statements, ...}
+                           = LivenessBlock.toLivenessStatements
+                             {statements 
+                              = (Assembly.instruction_pfmov
+                                 {src = src1,
+                                  dst = dst2,
+                                  size = size1})::statements,
+                              live = liveOut2}
 
-			 val statements
-			   = List.fold(start,
-				       List.concat [statements, 
-						    finish],
-				       op ::)
-		       in
-			 SOME (LivenessBlock.T
-			       {entry = entry,
-				profileLabel = profileLabel,
-				statements = statements,
-				transfer = transfer})		 
-		       end
-		  else NONE
-             | _ => Error.bug "Peephole: elimFltACopy"
+                         val statements
+                           = List.fold(start,
+                                       List.concat [statements, 
+                                                    finish],
+                                       op ::)
+                       in
+                         SOME (LivenessBlock.T
+                               {entry = entry,
+                                profileLabel = profileLabel,
+                                statements = statements,
+                                transfer = transfer})            
+                       end
+                  else NONE
+             | _ => Error.bug "x86Simplify.PeeholeBlock: elimFltACopy"
 
-	val (callback,elimFltACopy_msg)
-	  = make_callback_msg "elimFltACopy"
+        val (callback,elimFltACopy_msg)
+          = make_callback_msg "elimFltACopy"
       in
-	val elimFltACopy : optimization
-	  = {template = template,
-	     rewriter = rewriter,
-	     callback = callback}
-	val elimFltACopy_msg = elimFltACopy_msg
+        val elimFltACopy : optimization
+          = {template = template,
+             rewriter = rewriter,
+             callback = callback}
+        val elimFltACopy_msg = elimFltACopy_msg
       end
 
       local
-	val isInstructionFMOV_eqSrcDst : statement_type -> bool
-	= fn (Assembly.Instruction (Instruction.pFMOV 
-				    {dst = Operand.MemLoc memloc1,
-				     src = Operand.MemLoc memloc2,...}),
-	      _) 
-	   => MemLoc.eq(memloc1,memloc2) 
-	   | _ => false
+        val isInstructionFMOV_eqSrcDst : statement_type -> bool
+        = fn (Assembly.Instruction (Instruction.pFMOV 
+                                    {dst = Operand.MemLoc memloc1,
+                                     src = Operand.MemLoc memloc2,...}),
+              _) 
+           => MemLoc.eq(memloc1,memloc2) 
+           | _ => false
 
-	val template : template 
-	  = {start = EmptyOrNonEmpty,
-	     statements = [One isInstructionFMOV_eqSrcDst],
-	     finish = EmptyOrNonEmpty,
-	     transfer = fn _ => true}
+        val template : template 
+          = {start = EmptyOrNonEmpty,
+             statements = [One isInstructionFMOV_eqSrcDst],
+             finish = EmptyOrNonEmpty,
+             transfer = fn _ => true}
 
-	val rewriter : rewriter
-	  = fn {entry,
-		profileLabel,
-		start, 
-		statements =
-		[[(Assembly.Instruction (Instruction.pFMOV 
-					 {...}),
-		   _)]],
-		finish, 
-		transfer}
-	     => let
-		  val statements 
-		    = List.fold
-		      (start, 
-		       finish, 
-		       op ::)
-		in 
-		  SOME (LivenessBlock.T
-			{entry = entry,
-			 profileLabel = profileLabel,
-			 statements = statements,
-			 transfer = transfer})
-		end
-	     | _ => Error.bug "Peephole: elimFltSelfMove"
+        val rewriter : rewriter
+          = fn {entry,
+                profileLabel,
+                start, 
+                statements =
+                [[(Assembly.Instruction (Instruction.pFMOV 
+                                         {...}),
+                   _)]],
+                finish, 
+                transfer}
+             => let
+                  val statements 
+                    = List.fold
+                      (start, 
+                       finish, 
+                       op ::)
+                in 
+                  SOME (LivenessBlock.T
+                        {entry = entry,
+                         profileLabel = profileLabel,
+                         statements = statements,
+                         transfer = transfer})
+                end
+             | _ => Error.bug "x86Simplify.PeeholeBlock: elimFltSelfMove"
  
-	val (callback,elimFltSelfMove_msg)
-	  = make_callback_msg "elimFltSelfMove"
+        val (callback,elimFltSelfMove_msg)
+          = make_callback_msg "elimFltSelfMove"
       in
-	val elimFltSelfMove : optimization
-	  = {template = template,
-	     rewriter = rewriter,
-	     callback = callback}
-	val elimFltSelfMove_msg = elimFltSelfMove_msg
+        val elimFltSelfMove : optimization
+          = {template = template,
+             rewriter = rewriter,
+             callback = callback}
+        val elimFltSelfMove_msg = elimFltSelfMove_msg
       end
 
       local
-	val isInstructionFMOV_dstMemloc : statement_type -> bool
-	  = fn (Assembly.Instruction (Instruction.pFMOV 
-				      {dst = Operand.MemLoc _,...}),
-		_)
-	     => true
-	     | _ => false
+        val isInstructionFMOV_dstMemloc : statement_type -> bool
+          = fn (Assembly.Instruction (Instruction.pFMOV 
+                                      {dst = Operand.MemLoc _,...}),
+                _)
+             => true
+             | _ => false
 
-	val isInstructionFltBinA_dstMemloc : statement_type -> bool
-	  = fn (Assembly.Instruction (Instruction.pFBinA
-				      {dst = Operand.MemLoc _,...}),
-		_)
-	     => true
-	     | _ => false
+        val isInstructionFltBinA_dstMemloc : statement_type -> bool
+          = fn (Assembly.Instruction (Instruction.pFBinA
+                                      {dst = Operand.MemLoc _,...}),
+                _)
+             => true
+             | _ => false
 
-	val template : template 
-	  = {start = EmptyOrNonEmpty,
-	     statements = [One isInstructionFMOV_dstMemloc,
-			   All isComment,
-			   One isInstructionFltBinA_dstMemloc],
-	     finish = EmptyOrNonEmpty,
-	     transfer = fn _ => true}
+        val template : template 
+          = {start = EmptyOrNonEmpty,
+             statements = [One isInstructionFMOV_dstMemloc,
+                           All isComment,
+                           One isInstructionFltBinA_dstMemloc],
+             finish = EmptyOrNonEmpty,
+             transfer = fn _ => true}
 
-	val rewriter : rewriter
-	  = fn {entry,
-		profileLabel,
-		start, 
-		statements =
-		[[(Assembly.Instruction (Instruction.pFMOV 
-					 {src = src1,
-					  dst 
-					  = dst1 as Operand.MemLoc memloc_dst1,
-					  size = size1}),
-		   Liveness.T {dead = dead1,...})],
-		 comments,
-		 [(Assembly.Instruction (Instruction.pFBinA 
-					 {oper = oper2,
-					  src = src2,
-					  dst 
-					  = dst2 as Operand.MemLoc _,
-					  size = size2}),
-		   Liveness.T {dead = dead2,
-			       liveOut = liveOut2,...})]],
-		finish, 
-		transfer}
-	     => if Size.eq(size1,size2) andalso
-	           Operand.eq(dst1,dst2) andalso
-		   not (Operand.eq(src1, src2)) andalso
-		   (case (src1,src2)
-		      of (Operand.MemLoc memloc_src1,
-			  Operand.MemLoc memloc_src2)
-		       => LiveSet.contains(dead2,
-					   memloc_src2)
-			  andalso
-			  not (LiveSet.contains(dead1,
-						memloc_src1))
-		       | (_, Operand.MemLoc memloc_src2)
-		       => LiveSet.contains(dead2,
-					   memloc_src2)
-		       | _ => false) andalso
-		   (case src1
-		      of Operand.MemLoc memloc_src1
-		       => not (List.exists
-			       (memloc_src1::(MemLoc.utilized memloc_src1),
-				fn memloc'
-				 => MemLoc.mayAlias(memloc',memloc_dst1)))
-		       | _ => true) andalso
-		   (case src2
-		      of Operand.MemLoc memloc_src2
-		       => not (List.exists
-			       (memloc_src2::(MemLoc.utilized memloc_src2),
-				fn memloc'
-				 => MemLoc.mayAlias(memloc',memloc_dst1)))
-		       | _ => true)
-		  then let
-			 val statements
-			   = (Assembly.instruction_pfmov
-			      {src = src2,
-			       dst = dst1,
-			       size = size1})::
-			     (List.concat
-			      [List.map(comments, #1),
-			       [Assembly.instruction_pfbina
-				{oper = Instruction.fbina_reverse oper2,
-				 src = src1,
-				 dst = dst2,
-				 size = size2}]])
+        val rewriter : rewriter
+          = fn {entry,
+                profileLabel,
+                start, 
+                statements =
+                [[(Assembly.Instruction (Instruction.pFMOV 
+                                         {src = src1,
+                                          dst 
+                                          = dst1 as Operand.MemLoc memloc_dst1,
+                                          size = size1}),
+                   Liveness.T {dead = dead1,...})],
+                 comments,
+                 [(Assembly.Instruction (Instruction.pFBinA 
+                                         {oper = oper2,
+                                          src = src2,
+                                          dst 
+                                          = dst2 as Operand.MemLoc _,
+                                          size = size2}),
+                   Liveness.T {dead = dead2,
+                               liveOut = liveOut2,...})]],
+                finish, 
+                transfer}
+             => if Size.eq(size1,size2) andalso
+                   Operand.eq(dst1,dst2) andalso
+                   not (Operand.eq(src1, src2)) andalso
+                   (case (src1,src2)
+                      of (Operand.MemLoc memloc_src1,
+                          Operand.MemLoc memloc_src2)
+                       => LiveSet.contains(dead2,
+                                           memloc_src2)
+                          andalso
+                          not (LiveSet.contains(dead1,
+                                                memloc_src1))
+                       | (_, Operand.MemLoc memloc_src2)
+                       => LiveSet.contains(dead2,
+                                           memloc_src2)
+                       | _ => false) andalso
+                   (case src1
+                      of Operand.MemLoc memloc_src1
+                       => not (List.exists
+                               (memloc_src1::(MemLoc.utilized memloc_src1),
+                                fn memloc'
+                                 => MemLoc.mayAlias(memloc',memloc_dst1)))
+                       | _ => true) andalso
+                   (case src2
+                      of Operand.MemLoc memloc_src2
+                       => not (List.exists
+                               (memloc_src2::(MemLoc.utilized memloc_src2),
+                                fn memloc'
+                                 => MemLoc.mayAlias(memloc',memloc_dst1)))
+                       | _ => true)
+                  then let
+                         val statements
+                           = (Assembly.instruction_pfmov
+                              {src = src2,
+                               dst = dst1,
+                               size = size1})::
+                             (List.concat
+                              [List.map(comments, #1),
+                               [Assembly.instruction_pfbina
+                                {oper = Instruction.fbina_reverse oper2,
+                                 src = src1,
+                                 dst = dst2,
+                                 size = size2}]])
 
-			 val {statements, ...}
-			   = LivenessBlock.toLivenessStatements
-			     {statements = statements,
-			      live = liveOut2}
+                         val {statements, ...}
+                           = LivenessBlock.toLivenessStatements
+                             {statements = statements,
+                              live = liveOut2}
 
-			 val statements 
-			   = List.fold(start, 
-				       List.concat [statements,
-						    finish], 
-				       op ::)
-		       in
-			 SOME (LivenessBlock.T
-			       {entry = entry,	
-				profileLabel = profileLabel,
-				statements = statements,
-				transfer = transfer})		 
-		       end
-		  else NONE
-             | _ => Error.bug "Peephole: commuteFltBinA"
+                         val statements 
+                           = List.fold(start, 
+                                       List.concat [statements,
+                                                    finish], 
+                                       op ::)
+                       in
+                         SOME (LivenessBlock.T
+                               {entry = entry,  
+                                profileLabel = profileLabel,
+                                statements = statements,
+                                transfer = transfer})            
+                       end
+                  else NONE
+             | _ => Error.bug "x86Simplify.PeeholeBlock: commuteFltBinA"
 
-	val (callback,commuteFltBinA_msg)
-	  = make_callback_msg "commuteFltBinA"
+        val (callback,commuteFltBinA_msg)
+          = make_callback_msg "commuteFltBinA"
       in
-	val commuteFltBinA : optimization
-	  = {template = template,
-	     rewriter = rewriter,
-	     callback = callback}
-	val commuteFltBinA_msg = commuteFltBinA_msg
+        val commuteFltBinA : optimization
+          = {template = template,
+             rewriter = rewriter,
+             callback = callback}
+        val commuteFltBinA_msg = commuteFltBinA_msg
       end
 
       local
-	val isInstructionSETcc : statement_type -> bool
-	  = fn (Assembly.Instruction (Instruction.SETcc 
-				      {...}),
-		_) 
-	     => true
-	     | _ => false
+        val isInstructionSETcc : statement_type -> bool
+          = fn (Assembly.Instruction (Instruction.SETcc 
+                                      {...}),
+                _) 
+             => true
+             | _ => false
 
-	val isInstructionTEST_eqSrcs : statement_type -> bool
-	  = fn (Assembly.Instruction (Instruction.TEST 
-				      {src1 = Operand.MemLoc memloc1,
-				       src2 = Operand.MemLoc memloc2,...}),
-		Liveness.T {...})
-	     => MemLoc.eq(memloc1, memloc2) 
-	     | _ => false
+        val isInstructionTEST_eqSrcs : statement_type -> bool
+          = fn (Assembly.Instruction (Instruction.TEST 
+                                      {src1 = Operand.MemLoc memloc1,
+                                       src2 = Operand.MemLoc memloc2,...}),
+                Liveness.T {...})
+             => MemLoc.eq(memloc1, memloc2) 
+             | _ => false
 
-	val isIff_conditionZorNZ : transfer_type -> bool
-	  = fn (Transfer.Iff {condition,...},
-		_)
-	     => (case condition
-		   of Instruction.Z => true
-		    | Instruction.NZ => true
-		    | _ => false)
-	     | _ => false
+        val isIff_conditionZorNZ : transfer_type -> bool
+          = fn (Transfer.Iff {condition,...},
+                _)
+             => (case condition
+                   of Instruction.Z => true
+                    | Instruction.NZ => true
+                    | _ => false)
+             | _ => false
 
-	val template : template
-	  = {start = EmptyOrNonEmpty,
-	     statements = [One isInstructionSETcc,
-			   All isComment,
-			   One isInstructionTEST_eqSrcs,
-			   All isComment],
-	     finish = Empty,
-	     transfer = isIff_conditionZorNZ}
+        val template : template
+          = {start = EmptyOrNonEmpty,
+             statements = [One isInstructionSETcc,
+                           All isComment,
+                           One isInstructionTEST_eqSrcs,
+                           All isComment],
+             finish = Empty,
+             transfer = isIff_conditionZorNZ}
 
-	val rewriter : rewriter
-	  = fn {entry,
-		profileLabel,
-		start, 
-		statements =
-		[[(statement as 
-		   Assembly.Instruction (Instruction.SETcc
-					 {condition = condition1,
-					  dst 
-					  = Operand.MemLoc memloc1,
-					  ...}),
-		   _)],
-		 comments1,
-		 [(Assembly.Instruction (Instruction.TEST
-					 {src1 
-					  = Operand.MemLoc memloc12,
-					  ...}),
-		   Liveness.T {dead, ...})],
-		 comments2],
-		finish = [],
-		transfer =
-		(Transfer.Iff {condition, truee, falsee},
-		 infoT as _)}
-	     => if MemLoc.eq(memloc1,memloc12)
-		  then let
-			 val condition 
-			   = case condition
-			       of Instruction.Z 
-				=> Instruction.condition_negate condition1
-			        | Instruction.NZ => condition1
-			        | _ => Error.bug "Peephole: conditionalJump"
+        val rewriter : rewriter
+          = fn {entry,
+                profileLabel,
+                start, 
+                statements =
+                [[(statement as 
+                   Assembly.Instruction (Instruction.SETcc
+                                         {condition = condition1,
+                                          dst 
+                                          = Operand.MemLoc memloc1,
+                                          ...}),
+                   _)],
+                 comments1,
+                 [(Assembly.Instruction (Instruction.TEST
+                                         {src1 
+                                          = Operand.MemLoc memloc12,
+                                          ...}),
+                   Liveness.T {dead, ...})],
+                 comments2],
+                finish = [],
+                transfer =
+                (Transfer.Iff {condition, truee, falsee},
+                 infoT as _)}
+             => if MemLoc.eq(memloc1,memloc12)
+                  then let
+                         val condition 
+                           = case condition
+                               of Instruction.Z 
+                                => Instruction.condition_negate condition1
+                                | Instruction.NZ => condition1
+                                | _ => Error.bug "x86Simplify.PeeholeBlock: conditionalJump:condition"
 
-			 val transfer 
-			   = (Transfer.iff {condition = condition,
-					    truee = truee,
-					    falsee = falsee},
-			      infoT)
+                         val transfer 
+                           = (Transfer.iff {condition = condition,
+                                            truee = truee,
+                                            falsee = falsee},
+                              infoT)
 
-			 val {transfer,live}
-			   = LivenessBlock.reLivenessTransfer 
-			     {transfer = transfer}
+                         val {transfer,live}
+                           = LivenessBlock.reLivenessTransfer 
+                             {transfer = transfer}
 
-			 val statements
-			   = List.concat
-			     [List.map(comments1, #1),
-			      List.map(comments2, #1)]
-			 val statements 
-			   = if x86Liveness.track memloc1 andalso
-			        LiveSet.contains(dead, memloc1)
-			       then statements
-			       else statement::statements
+                         val statements
+                           = List.concat
+                             [List.map(comments1, #1),
+                              List.map(comments2, #1)]
+                         val statements 
+                           = if x86Liveness.track memloc1 andalso
+                                LiveSet.contains(dead, memloc1)
+                               then statements
+                               else statement::statements
 
-			 val {statements, ...}
-			   = LivenessBlock.toLivenessStatements
-			     {statements = statements,
-			      live = live}
+                         val {statements, ...}
+                           = LivenessBlock.toLivenessStatements
+                             {statements = statements,
+                              live = live}
 
-			 val statements 
-			   = List.fold(start, 
-				       statements, 
-				       op ::)
+                         val statements 
+                           = List.fold(start, 
+                                       statements, 
+                                       op ::)
 
-			 val live
-			   = case statements
-			       of (_, Liveness.T {liveIn,...})::_ => liveIn
-				| _ => Error.bug "Peephole: conditionalJump"
+                         val live
+                           = case statements
+                               of (_, Liveness.T {liveIn,...})::_ => liveIn
+                                | _ => Error.bug "x86Simplify.PeeholeBlock: conditionalJump:live"
 
-			 val {entry, ...}
-			   = LivenessBlock.reLivenessEntry
-			     {entry = entry,
-			      live = live}
-		       in
-			 SOME (LivenessBlock.T
-			       {entry = entry,
-				profileLabel = profileLabel,
-				statements = statements,
-				transfer = transfer})
-		       end
-		  else NONE
-	     | _ => Error.bug "Peephole: conditionalJump"
+                         val {entry, ...}
+                           = LivenessBlock.reLivenessEntry
+                             {entry = entry,
+                              live = live}
+                       in
+                         SOME (LivenessBlock.T
+                               {entry = entry,
+                                profileLabel = profileLabel,
+                                statements = statements,
+                                transfer = transfer})
+                       end
+                  else NONE
+             | _ => Error.bug "x86Simplify.PeeholeBlock: conditionalJump"
 
-	val (callback,conditionalJump_msg)
-	  = make_callback_msg "conditionalJump"
+        val (callback,conditionalJump_msg)
+          = make_callback_msg "conditionalJump"
       in
-	val conditionalJump : optimization
-	  = {template = template,
-	     rewriter = rewriter,
-	     callback = callback}
-	val conditionalJump_msg = conditionalJump_msg
+        val conditionalJump : optimization
+          = {template = template,
+             rewriter = rewriter,
+             callback = callback}
+        val conditionalJump_msg = conditionalJump_msg
       end
 
       local
-	val {template, rewriter, ...} = elimDeadDsts
-	val (callback,elimDeadDsts_minor_msg)
-	  = make_callback_msg "elimDeadDsts_minor"
+        val {template, rewriter, ...} = elimDeadDsts
+        val (callback,elimDeadDsts_minor_msg)
+          = make_callback_msg "elimDeadDsts_minor"
       in
-	val elimDeadDsts_minor : optimization
-	  = {template = template,
-	     rewriter = rewriter,
-	     callback = callback}
-	val elimDeadDsts_minor_msg = elimDeadDsts_minor_msg
+        val elimDeadDsts_minor : optimization
+          = {template = template,
+             rewriter = rewriter,
+             callback = callback}
+        val elimDeadDsts_minor_msg = elimDeadDsts_minor_msg
       end
 
       local
-	val {template, rewriter, ...} = elimSelfMove
-	val (callback,elimSelfMove_minor_msg)
-	  = make_callback_msg "elimSelfMove_minor"
+        val {template, rewriter, ...} = elimSelfMove
+        val (callback,elimSelfMove_minor_msg)
+          = make_callback_msg "elimSelfMove_minor"
       in
-	val elimSelfMove_minor : optimization
-	  = {template = template,
-	     rewriter = rewriter,
-	     callback = callback}
-	val elimSelfMove_minor_msg = elimSelfMove_minor_msg
+        val elimSelfMove_minor : optimization
+          = {template = template,
+             rewriter = rewriter,
+             callback = callback}
+        val elimSelfMove_minor_msg = elimSelfMove_minor_msg
       end
 
       local
-	val {template, rewriter, ...} = elimFltSelfMove
-	val (callback,elimFltSelfMove_minor_msg)
-	  = make_callback_msg "elimFltSelfMove_minor"
+        val {template, rewriter, ...} = elimFltSelfMove
+        val (callback,elimFltSelfMove_minor_msg)
+          = make_callback_msg "elimFltSelfMove_minor"
       in
-	val elimFltSelfMove_minor : optimization
-	  = {template = template,
-	     rewriter = rewriter,
-	     callback = callback}
-	val elimFltSelfMove_minor_msg = elimFltSelfMove_minor_msg
+        val elimFltSelfMove_minor : optimization
+          = {template = template,
+             rewriter = rewriter,
+             callback = callback}
+        val elimFltSelfMove_minor_msg = elimFltSelfMove_minor_msg
       end
 
       local
-	val optimizations 
-	  = elimALCopy::
-	    elimFltACopy::
-	    elimDeadDsts::
-	    elimSelfMove::
-	    elimFltSelfMove::
-	    commuteBinALMD::
-	    commuteFltBinA::
-	    conditionalJump::
-	    nil
-	val optimizations_msg
-	  = elimALCopy_msg:: 
-	    elimFltACopy_msg::
-	    elimDeadDsts_msg::
-	    elimSelfMove_msg::
-	    elimFltSelfMove_msg::
-	    commuteBinALMD_msg::
-	    commuteFltBinA_msg::
-	    conditionalJump_msg::
-	    nil
+        val optimizations 
+          = elimALCopy::
+            elimFltACopy::
+            elimDeadDsts::
+            elimSelfMove::
+            elimFltSelfMove::
+            commuteBinALMD::
+            commuteFltBinA::
+            conditionalJump::
+            nil
+        val optimizations_msg
+          = elimALCopy_msg:: 
+            elimFltACopy_msg::
+            elimDeadDsts_msg::
+            elimSelfMove_msg::
+            elimFltSelfMove_msg::
+            commuteBinALMD_msg::
+            commuteFltBinA_msg::
+            conditionalJump_msg::
+            nil
 
-	val optimizations_minor
-	  = elimDeadDsts_minor::
-	    elimSelfMove_minor::
-	    elimFltSelfMove_minor::
-	    nil
-	val optimizations_minor_msg
-	  = elimDeadDsts_minor_msg::
-	    elimSelfMove_minor_msg::
-	    elimFltSelfMove_minor_msg::
-	    nil
+        val optimizations_minor
+          = elimDeadDsts_minor::
+            elimSelfMove_minor::
+            elimFltSelfMove_minor::
+            nil
+        val optimizations_minor_msg
+          = elimDeadDsts_minor_msg::
+            elimSelfMove_minor_msg::
+            elimFltSelfMove_minor_msg::
+            nil
       in
-	val peepholeLivenessBlock
-	  = fn block => (peepholeBlock {optimizations = optimizations,
-					block = block}
-	                 handle exn
-			  => (print "\n\n***** raising in peepholeLivenessBlock\n";
-			      LivenessBlock.printBlock block;
-			      raise exn))
+        val peepholeLivenessBlock
+          = fn block => (peepholeBlock {optimizations = optimizations,
+                                        block = block})
 
-	val (peepholeLivenessBlock, peepholeLivenessBlock_msg)
-	  = tracer
+        val (peepholeLivenessBlock, peepholeLivenessBlock_msg)
+          = tracer
             "peepholeLivenessBlock"
-	    peepholeLivenessBlock
+            peepholeLivenessBlock
 
-	val peepholeLivenessBlock_msg
-	  = fn () => (peepholeLivenessBlock_msg ();
-		      Control.indent ();
-		      List.foreach(optimizations_msg, fn msg => msg ());
-		      Control.unindent ())
+        val peepholeLivenessBlock_msg
+          = fn () => (peepholeLivenessBlock_msg ();
+                      Control.indent ();
+                      List.foreach(optimizations_msg, fn msg => msg ());
+                      Control.unindent ())
 
-	val peepholeLivenessBlock_minor
-	  = fn block => (peepholeBlock {optimizations = optimizations_minor,
-					block = block}
-	                 handle exn
-			  => (print "\n\n***** raising in peepholeLivenessBlock_minor\n";
-			      LivenessBlock.printBlock block;
-			      raise exn))
+        val peepholeLivenessBlock_minor
+          = fn block => (peepholeBlock {optimizations = optimizations_minor,
+                                        block = block})
 
-	val (peepholeLivenessBlock_minor, peepholeLivenessBlock_minor_msg)
-	  = tracer
+        val (peepholeLivenessBlock_minor, peepholeLivenessBlock_minor_msg)
+          = tracer
             "peepholeLivenessBlock_minor"
-	    peepholeLivenessBlock_minor
+            peepholeLivenessBlock_minor
 
-	val peepholeLivenessBlock_minor_msg
-	  = fn () => (peepholeLivenessBlock_minor_msg ();
-		      Control.indent ();
-		      List.foreach(optimizations_minor_msg, fn msg => msg ());
-		      Control.unindent ())
+        val peepholeLivenessBlock_minor_msg
+          = fn () => (peepholeLivenessBlock_minor_msg ();
+                      Control.indent ();
+                      List.foreach(optimizations_minor_msg, fn msg => msg ());
+                      Control.unindent ())
       end
     end
 
   fun simplify {chunk : Chunk.t,
-		optimize : int,
-		delProfileLabel : x86.ProfileLabel.t -> unit,
-		liveInfo : x86Liveness.LiveInfo.t,
-		jumpInfo : x86JumpInfo.t} :
+                optimize : int,
+                delProfileLabel : x86.ProfileLabel.t -> unit,
+                liveInfo : x86Liveness.LiveInfo.t,
+                jumpInfo : x86JumpInfo.t} :
                Chunk.t
     = let
-	fun changedChunk_msg 
+        fun changedChunk_msg 
             ({...} : {chunk : Chunk.t, changed: bool, msg: string})
-	  = ()
-	fun changedBlock_msg 
-	    ({...} : {block : Block.t, changed: bool, msg: string})
-	  = ()
-	fun changedLivenessBlock_msg 
-	    ({...} : {block : x86Liveness.LivenessBlock.t, changed: bool, msg: string})
-	  = ()
+          = ()
+        fun changedBlock_msg 
+            ({...} : {block : Block.t, changed: bool, msg: string})
+          = ()
+        fun changedLivenessBlock_msg 
+            ({...} : {block : x86Liveness.LivenessBlock.t, changed: bool, msg: string})
+          = ()
 
 (*
-	fun changedChunk_msg 
+        fun changedChunk_msg 
             {chunk as Chunk.T {blocks, ...}, changed, msg}
-	  = (print ("finished " ^ msg ^ "\n"))
-	fun changedBlock_msg 
-	    {block as Block.T {entry, ...}, changed, msg}
-	  = (print ("finished " ^ msg ^ "\n"))
-	fun changedLivenessBlock_msg 
-	    {block as x86Liveness.LivenessBlock.T {entry, ...}, changed, msg}
-	  = if changed then (print ("finished " ^ msg ^ "\n")) else ()
+          = (print ("finished " ^ msg ^ "\n"))
+        fun changedBlock_msg 
+            {block as Block.T {entry, ...}, changed, msg}
+          = (print ("finished " ^ msg ^ "\n"))
+        fun changedLivenessBlock_msg 
+            {block as x86Liveness.LivenessBlock.T {entry, ...}, changed, msg}
+          = if changed then (print ("finished " ^ msg ^ "\n")) else ()
 *)
 
 (*
-	fun changedChunk_msg 
+        fun changedChunk_msg 
             {chunk as Chunk.T {blocks, ...}, changed, msg}
-	  = (print (String.make (60, #"*"));
-	     print "\n";
-	     print msg;
-	     print "\n";
-	     List.foreach(blocks, 
-			  fn b as Block.T {entry, ...}
-			   => (print (concat
-				      ["liveIn: ",
-				       (concat o List.separate)
-				       (List.map
-					(x86Liveness.LiveSet.toList
-					 (x86Liveness.LiveInfo.getLive
-					  (liveInfo, Entry.label entry)),
-					 fn memloc => MemLoc.toString memloc),
-					"\n        "),
-				       "\n"]);
-			       x86.Block.printBlock b)))
+          = (print (String.make (60, #"*"));
+             print "\n";
+             print msg;
+             print "\n";
+             List.foreach(blocks, 
+                          fn b as Block.T {entry, ...}
+                           => (print (concat
+                                      ["liveIn: ",
+                                       (concat o List.separate)
+                                       (List.map
+                                        (x86Liveness.LiveSet.toList
+                                         (x86Liveness.LiveInfo.getLive
+                                          (liveInfo, Entry.label entry)),
+                                         fn memloc => MemLoc.toString memloc),
+                                        "\n        "),
+                                       "\n"]);
+                               x86.Block.printBlock b)))
 
-	fun changedBlock_msg 
-	    {block as Block.T {entry, ...}, changed, msg}
-	  = (print (String.make (60, #"*"));
-	     print "\n";
-	     print msg;
-	     print "\n";
-	     (print (concat
-		     ["liveIn: ",
-		      (concat o List.separate)
-		      (List.map
-		       (x86Liveness.LiveSet.toList
-			(x86Liveness.LiveInfo.getLive
-			 (liveInfo, Entry.label entry)),
-			fn memloc => MemLoc.toString memloc),
-		       "\n        "),
-		      "\n"]);
-	      x86.Block.printBlock block))
+        fun changedBlock_msg 
+            {block as Block.T {entry, ...}, changed, msg}
+          = (print (String.make (60, #"*"));
+             print "\n";
+             print msg;
+             print "\n";
+             (print (concat
+                     ["liveIn: ",
+                      (concat o List.separate)
+                      (List.map
+                       (x86Liveness.LiveSet.toList
+                        (x86Liveness.LiveInfo.getLive
+                         (liveInfo, Entry.label entry)),
+                        fn memloc => MemLoc.toString memloc),
+                       "\n        "),
+                      "\n"]);
+              x86.Block.printBlock block))
 
-	fun changedLivenessBlock_msg 
-	    {block as x86Liveness.LivenessBlock.T {entry, ...}, changed, msg}
-	  = (print (String.make (60, #"*"));
-	     print "\n";
-	     print msg;
-	     print "\n";
-	     (print (concat
-		     ["liveIn: ",
-		      (concat o List.separate)
-		      (List.map
-		       (x86Liveness.LiveSet.toList
-			(x86Liveness.LiveInfo.getLive
-			 (liveInfo, Entry.label (#1 entry))),
-			fn memloc => MemLoc.toString memloc),
-		       "\n        "),
-		      "\n"]);
-	      x86Liveness.LivenessBlock.printBlock block))
+        fun changedLivenessBlock_msg 
+            {block as x86Liveness.LivenessBlock.T {entry, ...}, changed, msg}
+          = (print (String.make (60, #"*"));
+             print "\n";
+             print msg;
+             print "\n";
+             (print (concat
+                     ["liveIn: ",
+                      (concat o List.separate)
+                      (List.map
+                       (x86Liveness.LiveSet.toList
+                        (x86Liveness.LiveInfo.getLive
+                         (liveInfo, Entry.label (#1 entry))),
+                        fn memloc => MemLoc.toString memloc),
+                       "\n        "),
+                      "\n"]);
+              x86Liveness.LivenessBlock.printBlock block))
 *)
 
-	fun checkLivenessBlock
-	    {block, block', msg}
-	  = Assert.assert
-	    ("verifyLivenessBlock: " ^ msg,
-	     fn () => if x86Liveness.LivenessBlock.verifyLivenessBlock
-	                 {block = block,
-			  liveInfo = liveInfo}
-			 handle exn
-			  => Error.bug 
-			     ("x86Liveness.LivenessBlock.verifyLivenessBlock::" ^
-			      (case exn
-				 of Fail s => s
-				  | _ => "?"))
-			then true
-			else (print ("pre: " ^ msg);
-			      x86Liveness.LivenessBlock.printBlock block;
-			      print (String.make(60, #"*"));
-			      print ("\n");
-			      print ("post: " ^ msg);
-			      x86Liveness.LivenessBlock.printBlock block';
-			      print (String.make(60, #"*"));
-			      print ("\n");
-			      false))
+        fun checkLivenessBlock
+            {block, block', msg}
+          = Assert.assert
+            ("x86Simplify.checkLivenessBlock: " ^ msg,
+             fn () => if x86Liveness.LivenessBlock.verifyLivenessBlock
+                         {block = block,
+                          liveInfo = liveInfo}
+                        then true
+                        else (print ("pre: " ^ msg);
+                              x86Liveness.LivenessBlock.printBlock block;
+                              print (String.make(60, #"*"));
+                              print ("\n");
+                              print ("post: " ^ msg);
+                              x86Liveness.LivenessBlock.printBlock block';
+                              print (String.make(60, #"*"));
+                              print ("\n");
+                              false))
 
-	(*********************************************************************)
-	(* simplify                                                          *)
-	(*********************************************************************)
+        (*********************************************************************)
+        (* simplify                                                          *)
+        (*********************************************************************)
 
-	val _ = changedChunk_msg 
-	        {chunk = chunk,
-		 changed = false,
-		 msg = "simplify:"}
+        val _ = changedChunk_msg 
+                {chunk = chunk,
+                 changed = false,
+                 msg = "simplify:"}
 
-	(*********************************************************************)
-	(* completeLiveInfo                                                  *)
-	(*********************************************************************)
-	val _ = x86Liveness.LiveInfo.completeLiveInfo 
-	        {chunk = chunk,
-		 liveInfo = liveInfo,
-		 pass = "pre"}
-		handle exn
-		 => Error.bug 
-		    ("x86Liveness.LiveInfo.completeLiveInfo (pre)::" ^
-		     (case exn
-			of Fail s => s
-			 | _ => "?"))
+        (*********************************************************************)
+        (* completeLiveInfo                                                  *)
+        (*********************************************************************)
+        val _ = x86Liveness.LiveInfo.completeLiveInfo 
+                {chunk = chunk,
+                 liveInfo = liveInfo,
+                 pass = "pre"}
 
-	val _ = changedChunk_msg 
-	        {chunk = chunk,
-		 changed = false,
-		 msg = "completeLiveInfo (pre):"}
+        val _ = changedChunk_msg 
+                {chunk = chunk,
+                 changed = false,
+                 msg = "completeLiveInfo (pre):"}
 
-	(*********************************************************************)
-	(* completeJumpInfo                                                  *)
-	(*********************************************************************)
-	val _ = x86JumpInfo.completeJumpInfo 
-	        {chunk = chunk,
-		 jumpInfo = jumpInfo}
-		handle exn
-		 => Error.bug 
-		    ("x86JumpInfo.completeJumpInfo::" ^
-		     (case exn
-			of Fail s => s
-			 | _ => "?"))
+        (*********************************************************************)
+        (* completeJumpInfo                                                  *)
+        (*********************************************************************)
+        val _ = x86JumpInfo.completeJumpInfo 
+                {chunk = chunk,
+                 jumpInfo = jumpInfo}
 
-	val _
-	  = Assert.assert
-	    ("verifyEntryTransfer",
-	     fn () => x86EntryTransfer.verifyEntryTransfer
-	              {chunk = chunk}
-		      handle exn
-		       => Error.bug 
-		          ("x86JumpInfo.verifyEntryTransfer::" ^
-			   (case exn
-			      of Fail s => s
-			       | _ => "?")))
+        val _
+          = Assert.assert
+            ("x86Simplify.verifyEntryTransfer",
+             fn () => x86EntryTransfer.verifyEntryTransfer
+                      {chunk = chunk})
 
-	(*********************************************************************)
-	(* optimizer                                                         *)
-	(*********************************************************************)
-	fun optimizer chunk
-	  = let
-	       val chunk = chunk
-	       val changed = false
+        (*********************************************************************)
+        (* optimizer                                                         *)
+        (*********************************************************************)
+        fun optimizer chunk
+          = let
+               val chunk = chunk
+               val changed = false
 
-	       (**************************************************************)
-	       (* elimGoto                                                   *)
-	       (**************************************************************)
-	       val {chunk = chunk',
-		    changed = changed'}
-		 = ElimGoto.elimGoto {chunk = chunk,
-				      delProfileLabel = delProfileLabel,
-				      jumpInfo = jumpInfo}
-		   handle exn
-		    => Error.bug 
-		       ("ElimGoto.elimGoto::" ^
-			(case exn
-			   of Fail s => s
-			    | _ => "?"))
+               (**************************************************************)
+               (* elimGoto                                                   *)
+               (**************************************************************)
+               val {chunk = chunk',
+                    changed = changed'}
+                 = ElimGoto.elimGoto {chunk = chunk,
+                                      delProfileLabel = delProfileLabel,
+                                      jumpInfo = jumpInfo}
 
-	       val _
-		 = Assert.assert
-		   ("verifyJumpInfo",
-		    fn () => x86JumpInfo.verifyJumpInfo 
-		             {chunk = chunk',
-			      jumpInfo = jumpInfo}
-		             handle exn
-			      => Error.bug 
-			         ("x86JumpInfo.verifyJumpInfo::" ^
-				  (case exn
-				     of Fail s => s
-				      | _ => "?")))
+               val _
+                 = Assert.assert
+                   ("x86Simplify.verifyJumpInfo",
+                    fn () => x86JumpInfo.verifyJumpInfo 
+                             {chunk = chunk',
+                              jumpInfo = jumpInfo})
 
-	       val _
-		 = Assert.assert
-		   ("verifyEntryTransfer",
-		    fn () => x86EntryTransfer.verifyEntryTransfer
-		             {chunk = chunk'}
-			     handle exn
-			      => Error.bug 
-			         ("x86JumpInfo.verifyEntryTransfer::" ^
-				  (case exn
-				     of Fail s => s
-				      | _ => "?")))
+               val _
+                 = Assert.assert
+                   ("x86Simplify.verifyEntryTransfer",
+                    fn () => x86EntryTransfer.verifyEntryTransfer
+                             {chunk = chunk'})
 
-	       val _ = changedChunk_msg 
-		       {chunk = chunk,
-			changed = changed',
-			msg = "ElimGoto.elimGoto:"}
-	       val chunk = chunk'
-	       val changed = changed orelse changed'		 
+               val _ = changedChunk_msg 
+                       {chunk = chunk,
+                        changed = changed',
+                        msg = "ElimGoto.elimGoto:"}
+               val chunk = chunk'
+               val changed = changed orelse changed'             
 
-	       (**************************************************************)
-	       (* peepholeBlock/moveHoist/peepholeLivenessBlock/copyPropagate*)
-	       (**************************************************************)
-	       val Chunk.T {data, blocks} = chunk
-	       val {blocks = blocks',
-		    changed = changed'}
-		 = List.fold
-		   (blocks,
-		    {blocks = [], changed = false},
-		    fn (block, {blocks, changed})
-		     => let
-			  val _ = changedBlock_msg 
-			          {block = block,
-				   changed = false,
-				   msg = "peepholeBlock/moveHoist/peepholeLivenessBlock/copyPropagate"}
-			  (***************************************************)
-			  (* peepholeBlock_pre                               *)
-			  (***************************************************)
-			  val {block = block',
-			       changed = changed'}
-			    = PeepholeBlock.peepholeBlock_pre block
-			      handle exn
-			       => Error.bug 
-			          ("PeepholeBlock.peepholeBlock_pre::" ^
-				   (case exn
-				      of Fail s => s
-				       | _ => "?"))
+               (**************************************************************)
+               (* peepholeBlock/moveHoist/peepholeLivenessBlock/copyPropagate*)
+               (**************************************************************)
+               val Chunk.T {data, blocks} = chunk
+               val {blocks = blocks',
+                    changed = changed'}
+                 = List.fold
+                   (blocks,
+                    {blocks = [], changed = false},
+                    fn (block, {blocks, changed})
+                     => let
+                          val _ = changedBlock_msg 
+                                  {block = block,
+                                   changed = false,
+                                   msg = "peepholeBlock/moveHoist/peepholeLivenessBlock/copyPropagate"}
+                          (***************************************************)
+                          (* peepholeBlock_pre                               *)
+                          (***************************************************)
+                          val {block = block',
+                               changed = changed'}
+                            = PeepholeBlock.peepholeBlock_pre block
 
-			  val _ = changedBlock_msg 
-			          {block = block',
-				   changed = changed',
-				   msg = "PeepholeBlock.peepholeBlock_pre"}
-			  val block = block'
-			  val changed = changed orelse changed'
+                          val _ = changedBlock_msg 
+                                  {block = block',
+                                   changed = changed',
+                                   msg = "PeepholeBlock.peepholeBlock_pre"}
+                          val block = block'
+                          val changed = changed orelse changed'
 
-			  (***************************************************)
-			  (* toLivenessBlock                                 *)
-			  (***************************************************)
-			  val block'
-			    = x86Liveness.LivenessBlock.toLivenessBlock 
-			      {block = block,
-			       liveInfo = liveInfo}
-			      handle exn
-			       => Error.bug 
-			          ("x86Liveness.LivenessBlock.toLivenessBlock::" ^
-				   (case exn
-				      of Fail s => s
-				       | _ => "?"))
+                          (***************************************************)
+                          (* toLivenessBlock                                 *)
+                          (***************************************************)
+                          val block'
+                            = x86Liveness.LivenessBlock.toLivenessBlock 
+                              {block = block,
+                               liveInfo = liveInfo}
 
-			  val block = block'
-			  val _ = changedLivenessBlock_msg 
-			          {block = block',
-				   changed = false,
-				   msg = "x86Liveness.LivenessBlock.toLivenessBlock"}
+                          val block = block'
+                          val _ = changedLivenessBlock_msg 
+                                  {block = block',
+                                   changed = false,
+                                   msg = "x86Liveness.LivenessBlock.toLivenessBlock"}
 
-			  (***************************************************)
-			  (* moveHoist                                       *)
-			  (***************************************************)
-			  val {block = block', 
-			       changed = changed'}
-			    = if !Control.Native.moveHoist
-				then MoveHoistLivenessBlock.moveHoist
-				     {block = block}
-				     handle exn
-				      => Error.bug 
-				         ("MoveHoistLivenessBlock.moveHoist::" ^
-					  (case exn
-					     of Fail s => s
-					      | _ => "?"))
-				else {block = block,
-				      changed = false}
+                          (***************************************************)
+                          (* moveHoist                                       *)
+                          (***************************************************)
+                          val {block = block', 
+                               changed = changed'}
+                            = if !Control.Native.moveHoist
+                                then MoveHoistLivenessBlock.moveHoist
+                                     {block = block}
+                                else {block = block,
+                                      changed = false}
 
-			  val _ = checkLivenessBlock 
+                          val _ = checkLivenessBlock 
                                   {block = block,
-				   block' = block',
-				   msg = "MoveHoistLivenessBlock.moveHoist"}
+                                   block' = block',
+                                   msg = "MoveHoistLivenessBlock.moveHoist"}
 
-			  val _ = changedLivenessBlock_msg 
-			          {block = block',
-				   changed = changed',
-				   msg = "MoveHoistLivenessBlock.moveHoist"}
-			  val block = block'
-			  val changed = changed orelse changed'
+                          val _ = changedLivenessBlock_msg 
+                                  {block = block',
+                                   changed = changed',
+                                   msg = "MoveHoistLivenessBlock.moveHoist"}
+                          val block = block'
+                          val changed = changed orelse changed'
 
-			  (***************************************************)
-			  (* peepholeLivenessBlock                           *)
-			  (***************************************************)
-			  val {block = block',
-			       changed = changed'}
-			    = PeepholeLivenessBlock.peepholeLivenessBlock
-			      block
-			      handle exn
-			       => Error.bug 
-			          ("PeepholeLivenessBlock.peepholeLivenessBlock::" ^
-				   (case exn
-				      of Fail s => s
-				       | _ => "?"))
+                          (***************************************************)
+                          (* peepholeLivenessBlock                           *)
+                          (***************************************************)
+                          val {block = block',
+                               changed = changed'}
+                            = PeepholeLivenessBlock.peepholeLivenessBlock block
 
-			  val _ = checkLivenessBlock 
+                          val _ = checkLivenessBlock 
                                   {block = block,
-				   block' = block',
-				   msg = "PeepholeLivenessBlock.peepholeLivenessBlock"}
+                                   block' = block',
+                                   msg = "PeepholeLivenessBlock.peepholeLivenessBlock"}
 
-			  val _ = changedLivenessBlock_msg 
-			          {block = block',
-				   changed = changed',
-				   msg = "PeepholeLivenessBlock.peepholeLivenessBlock"}
-			  val block = block'
-			  val changed = changed orelse changed'
+                          val _ = changedLivenessBlock_msg 
+                                  {block = block',
+                                   changed = changed',
+                                   msg = "PeepholeLivenessBlock.peepholeLivenessBlock"}
+                          val block = block'
+                          val changed = changed orelse changed'
 
-			  (***************************************************)
-			  (* copyPropagate                                   *)
-			  (***************************************************)
-			  val {block = block', 
-			       changed = changed'}
-			    = if !Control.Native.copyProp
-				then CopyPropagateLivenessBlock.copyPropagate
-				     {block = block,
-				      liveInfo = liveInfo}
-				     handle exn
-				      => Error.bug 
-				         ("CopyPropagateLivenessBlock.copyPropagate::" ^ 
-					  (case exn
-					     of Fail s => s
-					      | _ => "?"))
-				else {block = block,
-				      changed = false}
+                          (***************************************************)
+                          (* copyPropagate                                   *)
+                          (***************************************************)
+                          val {block = block', 
+                               changed = changed'}
+                            = if !Control.Native.copyProp
+                                then CopyPropagateLivenessBlock.copyPropagate
+                                     {block = block,
+                                      liveInfo = liveInfo}
+                                else {block = block,
+                                      changed = false}
 
-			  val _ = checkLivenessBlock 
+                          val _ = checkLivenessBlock 
                                   {block = block,
-				   block' = block',
-				   msg = "CopyPropagateLivenessBlock.copyPropagate"}
+                                   block' = block',
+                                   msg = "CopyPropagateLivenessBlock.copyPropagate"}
 
-			  val _ = changedLivenessBlock_msg 
-			          {block = block',
-				   changed = changed',
-				   msg = "CopyPropagateLivenessBlock.copyPropagate"}
-			  val block = block'
-			  val changed = changed orelse changed'
+                          val _ = changedLivenessBlock_msg 
+                                  {block = block',
+                                   changed = changed',
+                                   msg = "CopyPropagateLivenessBlock.copyPropagate"}
+                          val block = block'
+                          val changed = changed orelse changed'
 
-			  (***************************************************)
-			  (* peepholeLivenessBlock_minor                     *)
-			  (***************************************************)
-			  val {block = block',
-			       changed = changed'}
-			    = PeepholeLivenessBlock.peepholeLivenessBlock_minor
-			      block
-			      handle exn
-			       => Error.bug 
-			          ("PeepholeLivenessBlock.peepholeLivenessBlock_minor::" ^ 
-				   (case exn
-				      of Fail s => s
-				       | _ => "?"))
+                          (***************************************************)
+                          (* peepholeLivenessBlock_minor                     *)
+                          (***************************************************)
+                          val {block = block',
+                               changed = changed'}
+                            = PeepholeLivenessBlock.peepholeLivenessBlock_minor block
 
-			  val _ = checkLivenessBlock 
+                          val _ = checkLivenessBlock 
                                   {block = block,
-				   block' = block',
-				   msg = "PeepholeLivenessBlock.peepholeLivenessBlock_minor"}
+                                   block' = block',
+                                   msg = "PeepholeLivenessBlock.peepholeLivenessBlock_minor"}
 
-			  val _ = changedLivenessBlock_msg 
-			          {block = block',
-				   changed = changed',
-				   msg = "PeepholeLivenessBlock.peepholeLivenessBlock_minor"}
-			  val block = block'
-			  val changed = changed orelse changed'
+                          val _ = changedLivenessBlock_msg 
+                                  {block = block',
+                                   changed = changed',
+                                   msg = "PeepholeLivenessBlock.peepholeLivenessBlock_minor"}
+                          val block = block'
+                          val changed = changed orelse changed'
 
-			  (***************************************************)
-			  (* toBlock                                         *)
-			  (***************************************************)
-			  val block'
-			    = x86Liveness.LivenessBlock.toBlock {block = block}
-			      handle exn
-			       => Error.bug 
-			          ("x86Liveness.LivenessBlock.toBlock::" ^ 
-				   (case exn
-				      of Fail s => s
-				       | _ => "?"))
+                          (***************************************************)
+                          (* toBlock                                         *)
+                          (***************************************************)
+                          val block'
+                            = x86Liveness.LivenessBlock.toBlock {block = block}
 
-			  val _ = changedBlock_msg 
-			          {block = block',
-				   changed = false,
-				   msg = "x86Liveness.LivenessBlock.toBlock"}
-			  val block = block'
+                          val _ = changedBlock_msg 
+                                  {block = block',
+                                   changed = false,
+                                   msg = "x86Liveness.LivenessBlock.toBlock"}
+                          val block = block'
 
-			  (***************************************************)
-			  (* peepholeBlock_post                              *)
-			  (***************************************************)
-			  val {block = block',
-			       changed = changed'}
-			    = PeepholeBlock.peepholeBlock_post block
-			      handle exn
-			       => Error.bug 
-			          ("PeepholeBlock.peepholeBlock_post::" ^ 
-				   (case exn
-				      of Fail s => s
-				       | _ => "?"))
+                          (***************************************************)
+                          (* peepholeBlock_post                              *)
+                          (***************************************************)
+                          val {block = block',
+                               changed = changed'}
+                            = PeepholeBlock.peepholeBlock_post block
 
-			  val _ = changedBlock_msg 
-			          {block = block',
-				   changed = changed',
-				   msg = "PeepholeBlock.peepholeBlock_post"}
-			  val block = block'
-			  val changed = changed orelse changed'
-			in
-			  {blocks = block::blocks,
-			   changed = changed}
-			end)
-	       val chunk' = Chunk.T {data = data, blocks = blocks'}
+                          val _ = changedBlock_msg 
+                                  {block = block',
+                                   changed = changed',
+                                   msg = "PeepholeBlock.peepholeBlock_post"}
+                          val block = block'
+                          val changed = changed orelse changed'
+                        in
+                          {blocks = block::blocks,
+                           changed = changed}
+                        end)
+               val chunk' = Chunk.T {data = data, blocks = blocks'}
 
-	       val _ = changedChunk_msg 
-		       {chunk = chunk',
-			changed = changed',
-			msg = "peepholeBlock/moveHoist/peepholeLivenessBlock/copyPropagate"}
-	       val chunk = chunk'
-	       val changed = changed orelse changed'
+               val _ = changedChunk_msg 
+                       {chunk = chunk',
+                        changed = changed',
+                        msg = "peepholeBlock/moveHoist/peepholeLivenessBlock/copyPropagate"}
+               val chunk = chunk'
+               val changed = changed orelse changed'
 
-	       (**************************************************************)
-	       (* completeLiveInfo                                           *)
-	       (**************************************************************)
-	       val _
-		 = x86Liveness.LiveInfo.completeLiveInfo 
-		   {chunk = chunk,
-		    liveInfo = liveInfo,
-		    pass = "post"}
-		   handle exn
-		    => Error.bug 
-		       ("x86Liveness.LiveInfo.completeLiveInfo (post)::" ^ 
-			(case exn
-			   of Fail s => s
-			    | _ => "?"))
+               (**************************************************************)
+               (* completeLiveInfo                                           *)
+               (**************************************************************)
+               val _
+                 = x86Liveness.LiveInfo.completeLiveInfo 
+                   {chunk = chunk,
+                    liveInfo = liveInfo,
+                    pass = "post"}
 
-	       val _ = changedChunk_msg 
-		       {chunk = chunk,
-			changed = false,
-			msg = "completeLiveInfo (post):"}
-	    in
-	      {chunk = chunk,
-	       changed = changed}
-	    end
+               val _ = changedChunk_msg 
+                       {chunk = chunk,
+                        changed = false,
+                        msg = "completeLiveInfo (post):"}
+            in
+              {chunk = chunk,
+               changed = changed}
+            end
 
-	(*********************************************************************)
-	(* optimizer_loop                                                    *)
-	(*********************************************************************)
-	fun optimizer_loop chunk
-	  = let
-	      fun loop {chunk, changed}
-		= let
-		    val {chunk, changed = changed'}
-		      = optimizer chunk
-		  in
-		    if changed'
-		      then loop {chunk = chunk, 
-				 changed = true}
-		      else {chunk = chunk,
-			    changed = changed}
-		  end
+        (*********************************************************************)
+        (* optimizer_loop                                                    *)
+        (*********************************************************************)
+        fun optimizer_loop chunk
+          = let
+              fun loop {chunk, changed}
+                = let
+                    val {chunk, changed = changed'}
+                      = optimizer chunk
+                  in
+                    if changed'
+                      then loop {chunk = chunk, 
+                                 changed = true}
+                      else {chunk = chunk,
+                            changed = changed}
+                  end
 
-	      val {chunk, changed} 
-		= loop {chunk = chunk, changed = false}
-	    in
-	      {chunk = chunk,
-	       changed = changed}
-	    end
+              val {chunk, changed} 
+                = loop {chunk = chunk, changed = false}
+            in
+              {chunk = chunk,
+               changed = changed}
+            end
 
 
-	(*********************************************************************)
-	(* chunk                                                            *)
-	(*********************************************************************)
-	val {chunk, ...}
-	  = case optimize
-	      of 0 => {chunk = chunk, changed = false}
-	       | 1 => optimizer chunk
-	       | _ => optimizer_loop chunk
+        (*********************************************************************)
+        (* chunk                                                            *)
+        (*********************************************************************)
+        val {chunk, ...}
+          = case optimize
+              of 0 => {chunk = chunk, changed = false}
+               | 1 => optimizer chunk
+               | _ => optimizer_loop chunk
       in
-	chunk
+        chunk
       end
 
   val (simplify, simplify_msg)

Modified: mlton/branches/on-20050420-cmm-branch/mlton/codegen/x86-codegen/x86-simplify.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/codegen/x86-codegen/x86-simplify.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/codegen/x86-codegen/x86-simplify.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 type int = Int.t
 type word = Word.t
 
@@ -24,10 +25,10 @@
     include X86_SIMPLIFY_STRUCTS
 
     val simplify : {chunk : x86.Chunk.t,
-		    optimize : int,
-		    delProfileLabel : x86.ProfileLabel.t -> unit,
-		    liveInfo : x86Liveness.LiveInfo.t,
-		    jumpInfo : x86JumpInfo.t} -> x86.Chunk.t
+                    optimize : int,
+                    delProfileLabel : x86.ProfileLabel.t -> unit,
+                    liveInfo : x86Liveness.LiveInfo.t,
+                    jumpInfo : x86JumpInfo.t} -> x86.Chunk.t
 
     val simplify_totals : unit -> unit
   end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/codegen/x86-codegen/x86-translate.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/codegen/x86-codegen/x86-translate.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/codegen/x86-codegen/x86-translate.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 functor x86Translate(S: X86_TRANSLATE_STRUCTS): X86_TRANSLATE =
 struct
 
@@ -34,34 +35,34 @@
 
   structure Global =
      struct
-	open Machine.Global
+        open Machine.Global
 
-	fun toX86Operand (g: t) : (x86.Operand.t * x86.Size.t) vector =
-	   let
-	      val ty = Machine.Type.toCType (ty g)
-	      val index = index g
-	      val base =
-		 x86.Immediate.label
-		 (if isRoot g
-		     then x86MLton.global_base ty
-		  else x86MLton.globalPointerNonRoot_base)
-	      val origin =
-		 x86.MemLoc.imm
-		 {base = base,
-		  index = x86.Immediate.const_int index,
-		  scale = x86.Scale.fromCType ty,
-		  size = x86.Size.BYTE,
-		  class = x86MLton.Classes.Globals}
-	      val sizes = x86.Size.fromCType ty
-	   in
-	      (#1 o Vector.mapAndFold)
-	      (sizes, 0, fn (size,offset) =>
-	       (((x86.Operand.memloc o x86.MemLoc.shift)
-		 {origin = origin,
-		  disp = x86.Immediate.const_int offset,
-		  scale = x86.Scale.One,
-		  size = size}, size), offset + x86.Size.toBytes size))
-	   end
+        fun toX86Operand (g: t) : (x86.Operand.t * x86.Size.t) vector =
+           let
+              val ty = Machine.Type.toCType (ty g)
+              val index = index g
+              val base =
+                 x86.Immediate.label
+                 (if isRoot g
+                     then x86MLton.global_base ty
+                  else x86MLton.globalPointerNonRoot_base)
+              val origin =
+                 x86.MemLoc.imm
+                 {base = base,
+                  index = x86.Immediate.const_int index,
+                  scale = x86.Scale.fromCType ty,
+                  size = x86.Size.BYTE,
+                  class = x86MLton.Classes.Globals}
+              val sizes = x86.Size.fromCType ty
+           in
+              (#1 o Vector.mapAndFold)
+              (sizes, 0, fn (size,offset) =>
+               (((x86.Operand.memloc o x86.MemLoc.shift)
+                 {origin = origin,
+                  disp = x86.Immediate.const_int offset,
+                  scale = x86.Scale.One,
+                  size = size}, size), offset + x86.Size.toBytes size))
+           end
      end
 
   structure Operand =
@@ -69,232 +70,226 @@
       open Machine.Operand
 
       fun get (f: ('a * 'b) -> 'c) (i: int) (v: ('a * 'b) vector) =
-	 f (Vector.sub (v, i))
-	 handle _ => Error.bug (concat ["toX86Operand: get"])
+         f (Vector.sub (v, i))
       fun getOp0 v =
-	 get #1 0 v
+         get #1 0 v
 
       val rec toX86Operand : t -> (x86.Operand.t * x86.Size.t) vector =
-	 fn ArrayOffset {base, index, offset, scale, ty}
- 	    => let
-		  val base = toX86Operand base
-		  val _ = Assert.assert("x86Translate.Operand.toX86Operand: Array/base",
-					fn () => Vector.length base = 1)
-		  val base = getOp0 base
-		  val index = toX86Operand index
-		  val _ = Assert.assert("x86Translate.Operand.toX86Operand: Array/index",
-				       fn () => Vector.length index = 1)
-		  val index = getOp0 index
-		  val scale =
-		     case scale of
-			Scale.One => x86.Scale.One
-		      | Scale.Two => x86.Scale.Two
-		      | Scale.Four => x86.Scale.Four
-		      | Scale.Eight => x86.Scale.Eight
-		  val ty = Type.toCType ty
-		  val origin =
-		     case (x86.Operand.deMemloc base,
-			   x86.Operand.deImmediate index,
-			   x86.Operand.deMemloc index) of
-			(SOME base, SOME index, _) =>
-			   x86.MemLoc.simple 
-			   {base = base,
-			    index = index,
-			    scale = scale,
-			    size = x86.Size.BYTE,
-			    class = x86MLton.Classes.Heap}
-		      | (SOME base, _, SOME index) =>
-			   x86.MemLoc.complex 
-			   {base = base,
-			    index = index,
-			    scale = scale,
-			    size = x86.Size.BYTE,
-			    class = x86MLton.Classes.Heap}
-		      | _ => Error.bug (concat ["toX86Operand: strange Offset:",
-						" base: ",
-						x86.Operand.toString base,
-						" index: ",
-						x86.Operand.toString index])
-		  val origin =
-		     if Bytes.isZero offset
-			then origin
-			else x86.MemLoc.shift
-			     {origin = origin,
-			      disp = x86.Immediate.const_int (Bytes.toInt offset),
-			      scale = x86.Scale.One,
-			      size = x86.Size.BYTE}
-		  val sizes = x86.Size.fromCType ty
-	       in
-		  (#1 o Vector.mapAndFold)
-		  (sizes, 0, fn (size,offset) =>
-		   (((x86.Operand.memloc o x86.MemLoc.shift)
-		     {origin = origin,
-		      disp = x86.Immediate.const_int offset,
-		      scale = x86.Scale.One,
-		      size = size}, size), offset + x86.Size.toBytes size))
-	       end
-	  | Cast (z, _) => toX86Operand z
-	  | Contents {oper, ty} =>
-	       let
-		  val ty = Type.toCType ty
-		  val base = toX86Operand oper
-		  val _ = Assert.assert("x86Translate.Operand.toX86Operand: Contents/base",
-					fn () => Vector.length base = 1)
-		  val base = getOp0 base
-		  val origin =
-		     case x86.Operand.deMemloc base of
-			SOME base =>
-			   x86.MemLoc.simple 
-			   {base = base,
-			    index = x86.Immediate.const_int 0,
-			    scale = x86.Scale.One,
-			    size = x86.Size.BYTE,
-			    class = x86MLton.Classes.Heap}
-		      | _ => Error.bug (concat
-					["toX86Operand: strange Contents",
-					 " base: ",
-					 x86.Operand.toString base])	
-		  val sizes = x86.Size.fromCType ty
-	       in
-		  (#1 o Vector.mapAndFold)
-		  (sizes, 0, fn (size,offset) =>
-		   (((x86.Operand.memloc o x86.MemLoc.shift)
-		     {origin = origin,
-		      disp = x86.Immediate.const_int offset,
-		      scale = x86.Scale.One,
-		      size = size}, size), offset + x86.Size.toBytes size))
-	       end
-	  | File => Vector.new1 (x86MLton.fileName, x86MLton.pointerSize)
-	  | Frontier => 
-	       let 
-		  val frontier = x86MLton.gcState_frontierContentsOperand ()
-	       in
-		  Vector.new1 (frontier, valOf (x86.Operand.size frontier))
-	       end
-	  | GCState => 
-	       Vector.new1 (x86.Operand.label x86MLton.gcState_label,
-			    x86MLton.pointerSize)
-	  | Global g => Global.toX86Operand g
-	  | Label l => 
-	       Vector.new1 (x86.Operand.immediate_label l, x86MLton.pointerSize)
-	  | Line => 
-	       Vector.new1 (x86MLton.fileLine (), x86MLton.wordSize)
-	  | Offset {base = GCState, offset, ty} =>
-	       let
-		  val offset = Bytes.toInt offset
-		  val ty = Type.toCType ty
-		  val offset = x86MLton.gcState_offset {offset = offset, ty = ty}
-	       in
-		  Vector.new1 (offset, valOf (x86.Operand.size offset))
-	       end
-	  | Offset {base, offset, ty} =>
-	       let
-		  val offset = Bytes.toInt offset
-		 val ty = Type.toCType ty
-		 val base = toX86Operand base
-		 val _ = Assert.assert("x86Translate.Operand.toX86Operand: Contents/base",
-				       fn () => Vector.length base = 1)
-		 val base = getOp0 base
-		 val origin =
-		   case x86.Operand.deMemloc base of
-		     SOME base =>
-		       x86.MemLoc.simple 
-		       {base = base,
-			index = x86.Immediate.const_int offset,
-			scale = x86.Scale.One,
-			size = x86.Size.BYTE,
-			class = x86MLton.Classes.Heap}
-		   | _ => Error.bug (concat ["toX86Operand: strange Offset:",
-					     " base: ",
-					     x86.Operand.toString base])
-		  val sizes = x86.Size.fromCType ty
-	       in
-		  (#1 o Vector.mapAndFold)
-		  (sizes, 0, fn (size,offset) =>
-		   (((x86.Operand.memloc o x86.MemLoc.shift)
-		     {origin = origin,
-		      disp = x86.Immediate.const_int offset,
-		      scale = x86.Scale.One,
-		      size = size}, size), offset + x86.Size.toBytes size))
-	       end
-	  | Real _ => Error.bug "toX86Operand: Real unimplemented"
-	  | Register r =>
-	       let
-		  val ty = Machine.Type.toCType (Register.ty r)
-		  val index = Machine.Register.index r
-		  val base = x86.Immediate.label (x86MLton.local_base ty)
-		  val origin =
-		     x86.MemLoc.imm
-		     {base = base,
-		      index = x86.Immediate.const_int index,
-		      scale = x86.Scale.fromCType ty,
-		      size = x86.Size.BYTE,
-		      class = x86MLton.Classes.Locals}
-		  val sizes = x86.Size.fromCType ty
-	       in
-		  (#1 o Vector.mapAndFold)
-		  (sizes, 0, fn (size,offset) =>
-		   (((x86.Operand.memloc o x86.MemLoc.shift)
-		     {origin = origin,
-		      disp = x86.Immediate.const_int offset,
-		      scale = x86.Scale.One,
-		      size = size}, size), offset + x86.Size.toBytes size))
-	       end
-	  | StackOffset (StackOffset.T {offset, ty}) =>
-	       let
-		  val offset = Bytes.toInt offset
-		  val ty = Type.toCType ty
-		  val origin =
-		     x86.MemLoc.simple 
-		     {base = x86MLton.gcState_stackTopContents (), 
-		      index = x86.Immediate.const_int offset,
-		      scale = x86.Scale.One,
-		      size = x86.Size.BYTE,
-		      class = x86MLton.Classes.Stack}
-		  val sizes = x86.Size.fromCType ty
-	       in
-		  (#1 o Vector.mapAndFold)
-		  (sizes, 0, fn (size,offset) =>
-		   (((x86.Operand.memloc o x86.MemLoc.shift)
-		     {origin = origin,
-		      disp = x86.Immediate.const_int offset,
-		      scale = x86.Scale.One,
-		      size = size}, size), offset + x86.Size.toBytes size))
-	       end
-	  | StackTop => 
-	       let 
-		  val stackTop = x86MLton.gcState_stackTopContentsOperand ()
-	       in
-		  Vector.new1 (stackTop, valOf (x86.Operand.size stackTop))
-	       end
-	  | Word w =>
-	       let
-		  fun single size =
-		     Vector.new1
-		     (x86.Operand.immediate_const_word
-		      (Word.fromIntInf (WordX.toIntInf w)),
-		      size)
-	       in
-		  case WordSize.prim (WordX.size w) of
-		     W8 => single x86.Size.BYTE
-		   | W16 => single x86.Size.WORD
-		   | W32 => single x86.Size.LONG
-		   | W64 =>
-			let
-			   val w = WordX.toIntInf w
-			   val lo = Word.fromIntInf w
-			   val hi = Word.fromIntInf (IntInf.~>> (w, 0w32))
-			in
-			   Vector.new2
-			   ((x86.Operand.immediate_const_word lo, x86.Size.LONG),
-			    (x86.Operand.immediate_const_word hi, x86.Size.LONG))
-			end
-	       end
-	       
-      val toX86Operand =
-	 fn operand =>
-	 toX86Operand operand
-	 handle exn => Error.reraise (exn, "x86Translate.Operand.toX86Operand")
+         fn ArrayOffset {base, index, offset, scale, ty}
+            => let
+                  val base = toX86Operand base
+                  val _ = Assert.assert("x86Translate.Operand.toX86Operand: Array/base",
+                                        fn () => Vector.length base = 1)
+                  val base = getOp0 base
+                  val index = toX86Operand index
+                  val _ = Assert.assert("x86Translate.Operand.toX86Operand: Array/index",
+                                       fn () => Vector.length index = 1)
+                  val index = getOp0 index
+                  val scale =
+                     case scale of
+                        Scale.One => x86.Scale.One
+                      | Scale.Two => x86.Scale.Two
+                      | Scale.Four => x86.Scale.Four
+                      | Scale.Eight => x86.Scale.Eight
+                  val ty = Type.toCType ty
+                  val origin =
+                     case (x86.Operand.deMemloc base,
+                           x86.Operand.deImmediate index,
+                           x86.Operand.deMemloc index) of
+                        (SOME base, SOME index, _) =>
+                           x86.MemLoc.simple 
+                           {base = base,
+                            index = index,
+                            scale = scale,
+                            size = x86.Size.BYTE,
+                            class = x86MLton.Classes.Heap}
+                      | (SOME base, _, SOME index) =>
+                           x86.MemLoc.complex 
+                           {base = base,
+                            index = index,
+                            scale = scale,
+                            size = x86.Size.BYTE,
+                            class = x86MLton.Classes.Heap}
+                      | _ => Error.bug (concat ["x86Translate.Operand.toX86Operand: ",
+                                                "strange Offset: base: ",
+                                                x86.Operand.toString base,
+                                                " index: ",
+                                                x86.Operand.toString index])
+                  val origin =
+                     if Bytes.isZero offset
+                        then origin
+                        else x86.MemLoc.shift
+                             {origin = origin,
+                              disp = x86.Immediate.const_int (Bytes.toInt offset),
+                              scale = x86.Scale.One,
+                              size = x86.Size.BYTE}
+                  val sizes = x86.Size.fromCType ty
+               in
+                  (#1 o Vector.mapAndFold)
+                  (sizes, 0, fn (size,offset) =>
+                   (((x86.Operand.memloc o x86.MemLoc.shift)
+                     {origin = origin,
+                      disp = x86.Immediate.const_int offset,
+                      scale = x86.Scale.One,
+                      size = size}, size), offset + x86.Size.toBytes size))
+               end
+          | Cast (z, _) => toX86Operand z
+          | Contents {oper, ty} =>
+               let
+                  val ty = Type.toCType ty
+                  val base = toX86Operand oper
+                  val _ = Assert.assert("x86Translate.Operand.toX86Operand: Contents/base",
+                                        fn () => Vector.length base = 1)
+                  val base = getOp0 base
+                  val origin =
+                     case x86.Operand.deMemloc base of
+                        SOME base =>
+                           x86.MemLoc.simple 
+                           {base = base,
+                            index = x86.Immediate.const_int 0,
+                            scale = x86.Scale.One,
+                            size = x86.Size.BYTE,
+                            class = x86MLton.Classes.Heap}
+                      | _ => Error.bug (concat
+                                        ["x86Translate.Operand.toX86Operand: ",
+                                         "strange Contents: base: ",
+                                         x86.Operand.toString base])    
+                  val sizes = x86.Size.fromCType ty
+               in
+                  (#1 o Vector.mapAndFold)
+                  (sizes, 0, fn (size,offset) =>
+                   (((x86.Operand.memloc o x86.MemLoc.shift)
+                     {origin = origin,
+                      disp = x86.Immediate.const_int offset,
+                      scale = x86.Scale.One,
+                      size = size}, size), offset + x86.Size.toBytes size))
+               end
+          | File => Vector.new1 (x86MLton.fileName, x86MLton.pointerSize)
+          | Frontier => 
+               let 
+                  val frontier = x86MLton.gcState_frontierContentsOperand ()
+               in
+                  Vector.new1 (frontier, valOf (x86.Operand.size frontier))
+               end
+          | GCState => 
+               Vector.new1 (x86.Operand.label x86MLton.gcState_label,
+                            x86MLton.pointerSize)
+          | Global g => Global.toX86Operand g
+          | Label l => 
+               Vector.new1 (x86.Operand.immediate_label l, x86MLton.pointerSize)
+          | Line => 
+               Vector.new1 (x86MLton.fileLine (), x86MLton.wordSize)
+          | Offset {base = GCState, offset, ty} =>
+               let
+                  val offset = Bytes.toInt offset
+                  val ty = Type.toCType ty
+                  val offset = x86MLton.gcState_offset {offset = offset, ty = ty}
+               in
+                  Vector.new1 (offset, valOf (x86.Operand.size offset))
+               end
+          | Offset {base, offset, ty} =>
+               let
+                  val offset = Bytes.toInt offset
+                 val ty = Type.toCType ty
+                 val base = toX86Operand base
+                 val _ = Assert.assert("x86Translate.Operand.toX86Operand: Offset/base",
+                                       fn () => Vector.length base = 1)
+                 val base = getOp0 base
+                 val origin =
+                   case x86.Operand.deMemloc base of
+                     SOME base =>
+                       x86.MemLoc.simple 
+                       {base = base,
+                        index = x86.Immediate.const_int offset,
+                        scale = x86.Scale.One,
+                        size = x86.Size.BYTE,
+                        class = x86MLton.Classes.Heap}
+                   | _ => Error.bug (concat ["x86Translate.Operand.toX86Operand: ",
+                                             "strange Offset: base: ",
+                                             x86.Operand.toString base])
+                  val sizes = x86.Size.fromCType ty
+               in
+                  (#1 o Vector.mapAndFold)
+                  (sizes, 0, fn (size,offset) =>
+                   (((x86.Operand.memloc o x86.MemLoc.shift)
+                     {origin = origin,
+                      disp = x86.Immediate.const_int offset,
+                      scale = x86.Scale.One,
+                      size = size}, size), offset + x86.Size.toBytes size))
+               end
+          | Real _ => Error.bug "x86Translate.Operand.toX86Operand: Real unimplemented"
+          | Register r =>
+               let
+                  val ty = Machine.Type.toCType (Register.ty r)
+                  val index = Machine.Register.index r
+                  val base = x86.Immediate.label (x86MLton.local_base ty)
+                  val origin =
+                     x86.MemLoc.imm
+                     {base = base,
+                      index = x86.Immediate.const_int index,
+                      scale = x86.Scale.fromCType ty,
+                      size = x86.Size.BYTE,
+                      class = x86MLton.Classes.Locals}
+                  val sizes = x86.Size.fromCType ty
+               in
+                  (#1 o Vector.mapAndFold)
+                  (sizes, 0, fn (size,offset) =>
+                   (((x86.Operand.memloc o x86.MemLoc.shift)
+                     {origin = origin,
+                      disp = x86.Immediate.const_int offset,
+                      scale = x86.Scale.One,
+                      size = size}, size), offset + x86.Size.toBytes size))
+               end
+          | StackOffset (StackOffset.T {offset, ty}) =>
+               let
+                  val offset = Bytes.toInt offset
+                  val ty = Type.toCType ty
+                  val origin =
+                     x86.MemLoc.simple 
+                     {base = x86MLton.gcState_stackTopContents (), 
+                      index = x86.Immediate.const_int offset,
+                      scale = x86.Scale.One,
+                      size = x86.Size.BYTE,
+                      class = x86MLton.Classes.Stack}
+                  val sizes = x86.Size.fromCType ty
+               in
+                  (#1 o Vector.mapAndFold)
+                  (sizes, 0, fn (size,offset) =>
+                   (((x86.Operand.memloc o x86.MemLoc.shift)
+                     {origin = origin,
+                      disp = x86.Immediate.const_int offset,
+                      scale = x86.Scale.One,
+                      size = size}, size), offset + x86.Size.toBytes size))
+               end
+          | StackTop => 
+               let 
+                  val stackTop = x86MLton.gcState_stackTopContentsOperand ()
+               in
+                  Vector.new1 (stackTop, valOf (x86.Operand.size stackTop))
+               end
+          | Word w =>
+               let
+                  fun single size =
+                     Vector.new1
+                     (x86.Operand.immediate_const_word
+                      (Word.fromIntInf (WordX.toIntInf w)),
+                      size)
+               in
+                  case WordSize.prim (WordX.size w) of
+                     W8 => single x86.Size.BYTE
+                   | W16 => single x86.Size.WORD
+                   | W32 => single x86.Size.LONG
+                   | W64 =>
+                        let
+                           val w = WordX.toIntInf w
+                           val lo = Word.fromIntInf w
+                           val hi = Word.fromIntInf (IntInf.~>> (w, 0w32))
+                        in
+                           Vector.new2
+                           ((x86.Operand.immediate_const_word lo, x86.Size.LONG),
+                            (x86.Operand.immediate_const_word hi, x86.Size.LONG))
+                        end
+               end
     end
 
   type transInfo = x86MLton.transInfo
@@ -302,89 +297,89 @@
   structure Entry =
     struct
       structure Kind = Machine.Kind
-	 
+         
       fun toX86Blocks {label, kind, 
-		       transInfo as {frameInfoToX86, live, liveInfo,
-				     ...}: transInfo}
-	= (
-	   x86Liveness.LiveInfo.setLiveOperands
-	   (liveInfo, label, live label);
-	   case kind
-	     of Kind.Jump
-	      => let
-		 in
-		   AppendList.single
-		   (x86.Block.mkBlock'
-		    {entry = SOME (x86.Entry.jump {label = label}),
-		     statements = [],
-		     transfer = NONE})
-		 end
-	      | Kind.Func
-	      => let
-		   val args
-		     = List.fold
-		       (live label,
-			x86.MemLocSet.empty,
-			fn (operand, args)
-			 => case x86.Operand.deMemloc operand
-			      of SOME memloc => x86.MemLocSet.add(args, memloc)
-			       | NONE => args)
-		 in
-		   AppendList.single
-		   (x86.Block.mkBlock'
-		    {entry = SOME (x86.Entry.func {label = label,
-						   live = args}),
-		     statements = [],
-		     transfer = NONE})
-		 end
-	      | Kind.Cont {args, frameInfo, ...}
-	      => let
-		    val frameInfo = frameInfoToX86 frameInfo
-		    val args =
-		       Vector.fold
-		       (args, x86.MemLocSet.empty,
-			fn (operand,args) =>
-			Vector.fold
-			(Operand.toX86Operand (Live.toOperand operand), args,
-			 fn ((operand,_),args) =>
-			 case x86.Operand.deMemloc operand of
-			    SOME memloc => x86.MemLocSet.add(args, memloc)
-			  | NONE => args))
-		 in
-		   AppendList.single
-		   (x86.Block.mkBlock'
-		    {entry = SOME (x86.Entry.cont {label = label,
-						   live = args,
-						   frameInfo = frameInfo}),
-		     statements = [],
-		     transfer = NONE})
-		 end
-	      | Kind.Handler {frameInfo, ...}
-	      => let
-		 in 
-		   AppendList.single
-		   (x86.Block.mkBlock'
-		    {entry = SOME (x86.Entry.handler
-				   {frameInfo = frameInfoToX86 frameInfo,
-				    label = label,
-				    live = x86.MemLocSet.empty}),
-		     statements = [],
-		     transfer = NONE})
-		 end
-	      | Kind.CReturn {dst, frameInfo, func}
-	      => let
-		   val dsts =
-		      case dst of
-			 NONE => Vector.new0 ()
-		       | SOME dst => Operand.toX86Operand (Live.toOperand dst)
-		 in
-		   x86MLton.creturn
-		   {dsts = dsts,
-		    frameInfo = Option.map (frameInfo, frameInfoToX86),
-		    func = func,
-		    label = label,
-		    transInfo = transInfo}
-		 end)
+                       transInfo as {frameInfoToX86, live, liveInfo,
+                                     ...}: transInfo}
+        = (
+           x86Liveness.LiveInfo.setLiveOperands
+           (liveInfo, label, live label);
+           case kind
+             of Kind.Jump
+              => let
+                 in
+                   AppendList.single
+                   (x86.Block.mkBlock'
+                    {entry = SOME (x86.Entry.jump {label = label}),
+                     statements = [],
+                     transfer = NONE})
+                 end
+              | Kind.Func
+              => let
+                   val args
+                     = List.fold
+                       (live label,
+                        x86.MemLocSet.empty,
+                        fn (operand, args)
+                         => case x86.Operand.deMemloc operand
+                              of SOME memloc => x86.MemLocSet.add(args, memloc)
+                               | NONE => args)
+                 in
+                   AppendList.single
+                   (x86.Block.mkBlock'
+                    {entry = SOME (x86.Entry.func {label = label,
+                                                   live = args}),
+                     statements = [],
+                     transfer = NONE})
+                 end
+              | Kind.Cont {args, frameInfo, ...}
+              => let
+                    val frameInfo = frameInfoToX86 frameInfo
+                    val args =
+                       Vector.fold
+                       (args, x86.MemLocSet.empty,
+                        fn (operand,args) =>
+                        Vector.fold
+                        (Operand.toX86Operand (Live.toOperand operand), args,
+                         fn ((operand,_),args) =>
+                         case x86.Operand.deMemloc operand of
+                            SOME memloc => x86.MemLocSet.add(args, memloc)
+                          | NONE => args))
+                 in
+                   AppendList.single
+                   (x86.Block.mkBlock'
+                    {entry = SOME (x86.Entry.cont {label = label,
+                                                   live = args,
+                                                   frameInfo = frameInfo}),
+                     statements = [],
+                     transfer = NONE})
+                 end
+              | Kind.Handler {frameInfo, ...}
+              => let
+                 in 
+                   AppendList.single
+                   (x86.Block.mkBlock'
+                    {entry = SOME (x86.Entry.handler
+                                   {frameInfo = frameInfoToX86 frameInfo,
+                                    label = label,
+                                    live = x86.MemLocSet.empty}),
+                     statements = [],
+                     transfer = NONE})
+                 end
+              | Kind.CReturn {dst, frameInfo, func}
+              => let
+                   val dsts =
+                      case dst of
+                         NONE => Vector.new0 ()
+                       | SOME dst => Operand.toX86Operand (Live.toOperand dst)
+                 in
+                   x86MLton.creturn
+                   {dsts = dsts,
+                    frameInfo = Option.map (frameInfo, frameInfoToX86),
+                    func = func,
+                    label = label,
+                    transInfo = transInfo}
+                 end)
     end
 
   structure Statement =
@@ -392,99 +387,96 @@
       open Machine.Statement
 
       fun comments statement
-	= if !Control.Native.commented > 0
-	    then let
-		   val comment = (Layout.toString o layout) statement
-		 in
-		   (AppendList.single
-		    (x86.Block.mkBlock'
-		     {entry = NONE,
-		      statements = [x86.Assembly.comment
-				    (concat ["begin: ",
-					     comment])],
-		      transfer = NONE}),
-		    AppendList.single
-		    (x86.Block.mkBlock'
-		     {entry = NONE,
-		      statements = [x86.Assembly.comment
-				    (concat ["end: ",
-					     comment])],
-		      transfer = NONE}))
-		 end
-	    else (AppendList.empty,AppendList.empty)
+        = if !Control.Native.commented > 0
+            then let
+                   val comment = (Layout.toString o layout) statement
+                 in
+                   (AppendList.single
+                    (x86.Block.mkBlock'
+                     {entry = NONE,
+                      statements = [x86.Assembly.comment
+                                    (concat ["begin: ",
+                                             comment])],
+                      transfer = NONE}),
+                    AppendList.single
+                    (x86.Block.mkBlock'
+                     {entry = NONE,
+                      statements = [x86.Assembly.comment
+                                    (concat ["end: ",
+                                             comment])],
+                      transfer = NONE}))
+                 end
+            else (AppendList.empty,AppendList.empty)
 
       fun toX86Blocks {statement,
-		       transInfo as {...} : transInfo}
-	= (case statement
-	     of Noop
-	      => AppendList.empty
-	      | Move {src, dst}
-	      => let
-		   val (comment_begin,
-			comment_end) = comments statement
-		     
-		   val dsts = Operand.toX86Operand dst
-		   val srcs = Operand.toX86Operand src
-		   (* Operand.toX86Operand returns multi-word 
-		    * operands in and they will be moved in order,
-		    * so it suffices to check for aliasing between 
-		    * the first dst and second src.
-		    *)
-		   val (dsts,srcs) =
-		      if Vector.length srcs > 1
-			 andalso x86.Operand.mayAlias
-			         (#1 (Vector.sub (dsts, 0)), 
-				  #1 (Vector.sub (srcs, 1)))
-			 then (Vector.rev dsts, Vector.rev srcs)
-			 else (dsts,srcs)
-		 in
-		   AppendList.appends
-		   [comment_begin,
-		    AppendList.single
-		    (x86.Block.mkBlock'
-		     {entry = NONE,
-		      statements
-		      = (Vector.toList o Vector.map2)
-		        (dsts,srcs,fn ((dst,_),(src,srcsize)) =>
-			 (* dst = src *)
-			 case x86.Size.class srcsize
-			    of x86.Size.INT => x86.Assembly.instruction_mov 
-			                       {dst = dst,
-						src = src,
-						size = srcsize}
-			  | x86.Size.FLT => x86.Assembly.instruction_pfmov
-					    {dst = dst,
-					     src = src,
-					     size = srcsize}
-			  | _ => Error.bug "toX86Blocks: Move"),
-		      transfer = NONE}),
-		    comment_end]
-		 end 
-	      | PrimApp {dst, prim, args}
-   	      => let
-		   val (comment_begin, comment_end) = comments statement
-		   val args = (Vector.concatV o Vector.map)
-		              (args, Operand.toX86Operand)
-		   val dsts = 
-		      case dst of
-			 NONE => Vector.new0 ()
-		       | SOME dst => Operand.toX86Operand dst
-		 in
-		   AppendList.appends
-		   [comment_begin,
-		    (x86MLton.prim {prim = prim,
-				    args = args,
-				    dsts = dsts,
-				    transInfo = transInfo}),
-		    comment_end]
-		 end
-	      | ProfileLabel l =>
-		   AppendList.single
-		   (x86.Block.mkProfileBlock'
-		    {profileLabel = l}))
-	  handle exn
-	   => Error.reraise (exn, concat ["x86Translate.Statement.toX86Blocks::",
-					  Layout.toString (layout statement)])
+                       transInfo as {...} : transInfo}
+        = (case statement
+             of Noop
+              => AppendList.empty
+              | Move {src, dst}
+              => let
+                   val (comment_begin,
+                        comment_end) = comments statement
+                     
+                   val dsts = Operand.toX86Operand dst
+                   val srcs = Operand.toX86Operand src
+                   (* Operand.toX86Operand returns multi-word 
+                    * operands in and they will be moved in order,
+                    * so it suffices to check for aliasing between 
+                    * the first dst and second src.
+                    *)
+                   val (dsts,srcs) =
+                      if Vector.length srcs > 1
+                         andalso x86.Operand.mayAlias
+                                 (#1 (Vector.sub (dsts, 0)), 
+                                  #1 (Vector.sub (srcs, 1)))
+                         then (Vector.rev dsts, Vector.rev srcs)
+                         else (dsts,srcs)
+                 in
+                   AppendList.appends
+                   [comment_begin,
+                    AppendList.single
+                    (x86.Block.mkBlock'
+                     {entry = NONE,
+                      statements
+                      = (Vector.toList o Vector.map2)
+                        (dsts,srcs,fn ((dst,_),(src,srcsize)) =>
+                         (* dst = src *)
+                         case x86.Size.class srcsize
+                            of x86.Size.INT => x86.Assembly.instruction_mov 
+                                               {dst = dst,
+                                                src = src,
+                                                size = srcsize}
+                          | x86.Size.FLT => x86.Assembly.instruction_pfmov
+                                            {dst = dst,
+                                             src = src,
+                                             size = srcsize}
+                          | _ => Error.bug "x86Translate.Statement.toX86Blocks: Move"),
+                      transfer = NONE}),
+                    comment_end]
+                 end 
+              | PrimApp {dst, prim, args}
+              => let
+                   val (comment_begin, comment_end) = comments statement
+                   val args = (Vector.concatV o Vector.map)
+                              (args, Operand.toX86Operand)
+                   val dsts = 
+                      case dst of
+                         NONE => Vector.new0 ()
+                       | SOME dst => Operand.toX86Operand dst
+                 in
+                   AppendList.appends
+                   [comment_begin,
+                    (x86MLton.prim {prim = prim,
+                                    args = args,
+                                    dsts = dsts,
+                                    transInfo = transInfo}),
+                    comment_end]
+                 end
+              | ProfileLabel l =>
+                   AppendList.single
+                   (x86.Block.mkProfileBlock'
+                    {profileLabel = l}))
     end
 
   structure Transfer =
@@ -492,237 +484,235 @@
       open Machine.Transfer
 
       fun goto l
-	= AppendList.single
-	  (x86.Block.mkBlock'
-	   {entry = NONE,
-	    statements = [],
-	    transfer = SOME (x86.Transfer.goto
-			     {target = l})})
+        = AppendList.single
+          (x86.Block.mkBlock'
+           {entry = NONE,
+            statements = [],
+            transfer = SOME (x86.Transfer.goto
+                             {target = l})})
  
       fun iff (test, a, b)
-	= let
-	    val (test,testsize) =
-	       Vector.sub (Operand.toX86Operand test, 0)
-	  in
-	    if Label.equals(a, b)
-	      then AppendList.single
-		   (x86.Block.mkBlock'
-		    {entry = NONE,
-		     statements = [],
-		     transfer = SOME (x86.Transfer.goto {target = a})})
-	      else AppendList.single
-		   ((* if (test) goto a
-		     * goto b
-		     *)
-		    x86.Block.mkBlock'
-		    {entry = NONE,
-		     statements 
-		     = [x86.Assembly.instruction_test
-			{src1 = test,
-			 src2 = test,
-			 size = testsize}],
-		     transfer
-		     = SOME (x86.Transfer.iff
-			     {condition = x86.Instruction.NZ,
-			      truee = a,
-			      falsee = b})})
-	  end
+        = let
+            val (test,testsize) =
+               Vector.sub (Operand.toX86Operand test, 0)
+          in
+            if Label.equals(a, b)
+              then AppendList.single
+                   (x86.Block.mkBlock'
+                    {entry = NONE,
+                     statements = [],
+                     transfer = SOME (x86.Transfer.goto {target = a})})
+              else AppendList.single
+                   ((* if (test) goto a
+                     * goto b
+                     *)
+                    x86.Block.mkBlock'
+                    {entry = NONE,
+                     statements 
+                     = [x86.Assembly.instruction_test
+                        {src1 = test,
+                         src2 = test,
+                         size = testsize}],
+                     transfer
+                     = SOME (x86.Transfer.iff
+                             {condition = x86.Instruction.NZ,
+                              truee = a,
+                              falsee = b})})
+          end
 
       fun cmp (test, k, a, b)
-	= let
-	    val (test,testsize) =
-	       Vector.sub (Operand.toX86Operand test, 0)
-	  in
-	    if Label.equals(a, b)
-	      then AppendList.single
-		   (x86.Block.mkBlock'
-		    {entry = NONE,
-		     statements = [],
-		     transfer = SOME (x86.Transfer.goto {target = a})})
-	      else AppendList.single
-		   ((* if (test = k) goto a
-		     * goto b
-		     *)
-		    x86.Block.mkBlock'
-		    {entry = NONE,
-		     statements 
-		     = [x86.Assembly.instruction_cmp
-			{src1 = test,
-			 src2 = x86.Operand.immediate k,
-			 size = testsize}],
-		     transfer
-		     = SOME (x86.Transfer.iff
-			     {condition = x86.Instruction.E,
-			      truee = a,
-			      falsee = b})})
-	  end
+        = let
+            val (test,testsize) =
+               Vector.sub (Operand.toX86Operand test, 0)
+          in
+            if Label.equals(a, b)
+              then AppendList.single
+                   (x86.Block.mkBlock'
+                    {entry = NONE,
+                     statements = [],
+                     transfer = SOME (x86.Transfer.goto {target = a})})
+              else AppendList.single
+                   ((* if (test = k) goto a
+                     * goto b
+                     *)
+                    x86.Block.mkBlock'
+                    {entry = NONE,
+                     statements 
+                     = [x86.Assembly.instruction_cmp
+                        {src1 = test,
+                         src2 = x86.Operand.immediate k,
+                         size = testsize}],
+                     transfer
+                     = SOME (x86.Transfer.iff
+                             {condition = x86.Instruction.E,
+                              truee = a,
+                              falsee = b})})
+          end
 
       fun switch(test, cases, default)
-	= let
-	    val test = Operand.toX86Operand test
-	    val (test,_) = Vector.sub(test, 0)
-	  in
-	    AppendList.single
-	    (x86.Block.mkBlock'
-	     {entry = NONE,
-	      statements = [],
-	      transfer = SOME (x86.Transfer.switch
-			       {test = test,
-				cases = cases,
-				default = default})})
-	  end
+        = let
+            val test = Operand.toX86Operand test
+            val (test,_) = Vector.sub(test, 0)
+          in
+            AppendList.single
+            (x86.Block.mkBlock'
+             {entry = NONE,
+              statements = [],
+              transfer = SOME (x86.Transfer.switch
+                               {test = test,
+                                cases = cases,
+                                default = default})})
+          end
 
       fun doSwitchWord (test, cases, default)
-	= (case (cases, default)
-	     of ([],            NONE)
-	      => Error.bug "toX86Blocks: doSwitchWord"
-	      | ([(_,l)],       NONE) => goto l
-	      | ([],            SOME l) => goto l
-	      | ([(0wx0,f),(0wx1,t)], NONE) => iff(test,t,f)
-	      | ([(0wx1,t),(0wx0,f)], NONE) => iff(test,t,f)
-	      | ([(_,l),(k',l')],NONE) 
-	      => cmp(test,x86.Immediate.const_word k',l',l)
-	      | ([(k',l')],      SOME l)
-	      => cmp(test,x86.Immediate.const_word k',l',l)
-	      | ((_,l)::cases,  NONE) 
-	      => switch(test, x86.Transfer.Cases.word cases, l)
-	      | (cases,         SOME l) 
-	      => switch(test, x86.Transfer.Cases.word cases, l))
+        = (case (cases, default)
+             of ([],            NONE)
+              => Error.bug "x86Translate.Transfer.doSwitchWord"
+              | ([(_,l)],       NONE) => goto l
+              | ([],            SOME l) => goto l
+              | ([(0wx0,f),(0wx1,t)], NONE) => iff(test,t,f)
+              | ([(0wx1,t),(0wx0,f)], NONE) => iff(test,t,f)
+              | ([(_,l),(k',l')],NONE) 
+              => cmp(test,x86.Immediate.const_word k',l',l)
+              | ([(k',l')],      SOME l)
+              => cmp(test,x86.Immediate.const_word k',l',l)
+              | ((_,l)::cases,  NONE) 
+              => switch(test, x86.Transfer.Cases.word cases, l)
+              | (cases,         SOME l) 
+              => switch(test, x86.Transfer.Cases.word cases, l))
 
       fun comments transfer
-	= if !Control.Native.commented > 0
-	    then let
-		   val comment = (Layout.toString o layout) transfer
-		 in
-		   AppendList.single
-		   (x86.Block.mkBlock'
-		    {entry = NONE,
-		     statements = [x86.Assembly.comment comment],
-		      transfer = NONE})
-		 end
-	    else AppendList.empty
+        = if !Control.Native.commented > 0
+            then let
+                   val comment = (Layout.toString o layout) transfer
+                 in
+                   AppendList.single
+                   (x86.Block.mkBlock'
+                    {entry = NONE,
+                     statements = [x86.Assembly.comment comment],
+                      transfer = NONE})
+                 end
+            else AppendList.empty
 
-	 
+         
       fun toX86Blocks {returns, transfer,
-		       transInfo as {frameInfoToX86, ...}: transInfo}
-	= (case transfer
-	     of Arith {prim, args, dst, overflow, success, ...}
-	      => let
-		   val args = (Vector.concatV o Vector.map)
-		              (args, Operand.toX86Operand)
-		   val dsts = Operand.toX86Operand dst
-		 in
-		   AppendList.append
-		   (comments transfer,
-		    x86MLton.arith {prim = prim,
-				    args = args,
-				    dsts = dsts,
-				    overflow = overflow,
-				    success = success,
-				    transInfo = transInfo})
-		 end
-	      | CCall {args, frameInfo, func, return}
-	      => let
-		   val args = (Vector.concatV o Vector.map)
-		              (args, Operand.toX86Operand)
-		 in
-		   AppendList.append
-		   (comments transfer,	
-		    x86MLton.ccall {args = args,
-				    frameInfo = (Option.map
-						 (frameInfo, frameInfoToX86)),
-				    func = func,
-				    return = return,
-				    transInfo = transInfo})
-		 end
-	      | Return
-	      => AppendList.append
-	         (comments transfer,
-		  AppendList.single
-		  (x86.Block.mkBlock'
-		   {entry = NONE,
-		    statements = [],
-		    transfer 
-		    = SOME (x86.Transfer.return 
-			    {live 
-			     = Vector.fold
-			       ((case returns of
-				    NONE => Error.bug "strange Return"
-				  | SOME zs => zs),
-				x86.MemLocSet.empty,
-				fn (operand, live) =>
-				Vector.fold
-				(Operand.toX86Operand operand, live,
-				 fn ((operand,_),live) =>
-				 case x86.Operand.deMemloc operand of
-				    SOME memloc => x86.MemLocSet.add(live, memloc)
-				  | NONE => live))})}))
-  	      | Raise
-	      => AppendList.append
-	         (comments transfer,
-		  AppendList.single
-		  (x86.Block.mkBlock'
-		   {entry = NONE,
-		    statements = [],
-		    transfer 
-		    = SOME (x86.Transfer.raisee 
-			    {live 
-			     = x86.MemLocSet.add
-			       (x86.MemLocSet.add
-				(x86.MemLocSet.empty,
-				 x86MLton.gcState_stackBottomContents ()),
-				x86MLton.gcState_exnStackContents ())})}))
-	      | Switch (Machine.Switch.T {cases, default, test, ...})
+                       transInfo as {frameInfoToX86, ...}: transInfo}
+        = (case transfer
+             of Arith {prim, args, dst, overflow, success, ...}
               => let
-		    val cases =
-		       Vector.toListMap (cases, fn (w, l) =>
-					 (Word.fromIntInf (WordX.toIntInf w), l))
-		 in
-		    AppendList.append
-		    (comments transfer,
-		     doSwitchWord (test, cases, default))
-		 end
-	      | Goto label
-	      => (AppendList.append
-		  (comments transfer,
-		   AppendList.single
-		   ((* goto label *)
-		    x86.Block.mkBlock'
-		    {entry = NONE,
-		     statements = [],
-		     transfer = SOME (x86.Transfer.goto {target = label})})))
-	      | Call {label, live, return, ...}
-	      => let
-		    val live =
-		       Vector.fold
-		       (live, x86.MemLocSet.empty, fn (operand, live) =>
-			Vector.fold
-			(Operand.toX86Operand (Live.toOperand operand), live,
-			 fn ((operand, _), live) =>
-			 case x86.Operand.deMemloc operand of
-			    NONE => live
-			  | SOME memloc => x86.MemLocSet.add (live, memloc)))
-		    val com = comments transfer
-		    val transfer =
-		       case return of
-			  NONE => x86.Transfer.tail {target = label,
-						     live = live}
-			| SOME {return, handler, size} =>
-			     x86.Transfer.nontail {target = label,
-						   live = live,
-						   return = return,
-						   handler = handler,
-						   size = Bytes.toInt size}
-		 in
-		    AppendList.append
-		    (com,
-		     AppendList.single
-		     (x86.Block.mkBlock' {entry = NONE,
-				    statements = [],
-				    transfer = SOME transfer}))
-		 end)
-	  handle exn
-	   => Error.reraise (exn, "x86Translate.Transfer.toX86Blocks")
+                   val args = (Vector.concatV o Vector.map)
+                              (args, Operand.toX86Operand)
+                   val dsts = Operand.toX86Operand dst
+                 in
+                   AppendList.append
+                   (comments transfer,
+                    x86MLton.arith {prim = prim,
+                                    args = args,
+                                    dsts = dsts,
+                                    overflow = overflow,
+                                    success = success,
+                                    transInfo = transInfo})
+                 end
+              | CCall {args, frameInfo, func, return}
+              => let
+                   val args = (Vector.concatV o Vector.map)
+                              (args, Operand.toX86Operand)
+                 in
+                   AppendList.append
+                   (comments transfer,  
+                    x86MLton.ccall {args = args,
+                                    frameInfo = (Option.map
+                                                 (frameInfo, frameInfoToX86)),
+                                    func = func,
+                                    return = return,
+                                    transInfo = transInfo})
+                 end
+              | Return
+              => AppendList.append
+                 (comments transfer,
+                  AppendList.single
+                  (x86.Block.mkBlock'
+                   {entry = NONE,
+                    statements = [],
+                    transfer 
+                    = SOME (x86.Transfer.return 
+                            {live 
+                             = Vector.fold
+                               ((case returns of
+                                    NONE => Error.bug "x86Translate.Transfer.toX86Blocsk: Return"
+                                  | SOME zs => zs),
+                                x86.MemLocSet.empty,
+                                fn (operand, live) =>
+                                Vector.fold
+                                (Operand.toX86Operand operand, live,
+                                 fn ((operand,_),live) =>
+                                 case x86.Operand.deMemloc operand of
+                                    SOME memloc => x86.MemLocSet.add(live, memloc)
+                                  | NONE => live))})}))
+              | Raise
+              => AppendList.append
+                 (comments transfer,
+                  AppendList.single
+                  (x86.Block.mkBlock'
+                   {entry = NONE,
+                    statements = [],
+                    transfer 
+                    = SOME (x86.Transfer.raisee 
+                            {live 
+                             = x86.MemLocSet.add
+                               (x86.MemLocSet.add
+                                (x86.MemLocSet.empty,
+                                 x86MLton.gcState_stackBottomContents ()),
+                                x86MLton.gcState_exnStackContents ())})}))
+              | Switch (Machine.Switch.T {cases, default, test, ...})
+              => let
+                    val cases =
+                       Vector.toListMap (cases, fn (w, l) =>
+                                         (Word.fromIntInf (WordX.toIntInf w), l))
+                 in
+                    AppendList.append
+                    (comments transfer,
+                     doSwitchWord (test, cases, default))
+                 end
+              | Goto label
+              => (AppendList.append
+                  (comments transfer,
+                   AppendList.single
+                   ((* goto label *)
+                    x86.Block.mkBlock'
+                    {entry = NONE,
+                     statements = [],
+                     transfer = SOME (x86.Transfer.goto {target = label})})))
+              | Call {label, live, return, ...}
+              => let
+                    val live =
+                       Vector.fold
+                       (live, x86.MemLocSet.empty, fn (operand, live) =>
+                        Vector.fold
+                        (Operand.toX86Operand (Live.toOperand operand), live,
+                         fn ((operand, _), live) =>
+                         case x86.Operand.deMemloc operand of
+                            NONE => live
+                          | SOME memloc => x86.MemLocSet.add (live, memloc)))
+                    val com = comments transfer
+                    val transfer =
+                       case return of
+                          NONE => x86.Transfer.tail {target = label,
+                                                     live = live}
+                        | SOME {return, handler, size} =>
+                             x86.Transfer.nontail {target = label,
+                                                   live = live,
+                                                   return = return,
+                                                   handler = handler,
+                                                   size = Bytes.toInt size}
+                 in
+                    AppendList.append
+                    (com,
+                     AppendList.single
+                     (x86.Block.mkBlock' {entry = NONE,
+                                    statements = [],
+                                    transfer = SOME transfer}))
+                 end)
     end
 
   structure Block =
@@ -730,57 +720,55 @@
       open Machine.Block
 
       fun toX86Blocks {block = T {label, 
-				  live, 
-				  kind, 
-				  returns,
-				  statements, 
-				  transfer,
-				  ...},
-		       transInfo as {...} : transInfo}
-	= let
-	    val pseudo_blocks
-	      = AppendList.append
-	        (AppendList.snoc
-		 (Entry.toX86Blocks {label = label,
-				     kind = kind,
-				     transInfo = transInfo},
-		  x86.Block.mkBlock'
-		  {entry = NONE,
-		   statements 
-		   = if !Control.Native.commented > 0
-		       then let
-			      val comment =
-				 concat ["Live: ",
-					 argsToString
-					 (Vector.toListMap
-					  (live, fn l =>
-					   Operand.toString (Live.toOperand l)))]
-			    in
-			      [x86.Assembly.comment comment]
-			    end
-		       else [],
-		    transfer = NONE}),
-		 Vector.foldr(statements,
-			      (Transfer.toX86Blocks
-			       {returns = (Option.map
-					   (returns, fn v =>
-					    Vector.map (v, Live.toOperand))),
-				transfer = transfer,
-				transInfo = transInfo}),
-			      fn (statement,l)
-			       => AppendList.append
-			          (Statement.toX86Blocks 
-				   {statement = statement,
-				    transInfo = transInfo}, l)))
+                                  live, 
+                                  kind, 
+                                  returns,
+                                  statements, 
+                                  transfer,
+                                  ...},
+                       transInfo as {...} : transInfo}
+        = let
+            val pseudo_blocks
+              = AppendList.append
+                (AppendList.snoc
+                 (Entry.toX86Blocks {label = label,
+                                     kind = kind,
+                                     transInfo = transInfo},
+                  x86.Block.mkBlock'
+                  {entry = NONE,
+                   statements 
+                   = if !Control.Native.commented > 0
+                       then let
+                              val comment =
+                                 concat ["Live: ",
+                                         argsToString
+                                         (Vector.toListMap
+                                          (live, fn l =>
+                                           Operand.toString (Live.toOperand l)))]
+                            in
+                              [x86.Assembly.comment comment]
+                            end
+                       else [],
+                    transfer = NONE}),
+                 Vector.foldr(statements,
+                              (Transfer.toX86Blocks
+                               {returns = (Option.map
+                                           (returns, fn v =>
+                                            Vector.map (v, Live.toOperand))),
+                                transfer = transfer,
+                                transInfo = transInfo}),
+                              fn (statement,l)
+                               => AppendList.append
+                                  (Statement.toX86Blocks 
+                                   {statement = statement,
+                                    transInfo = transInfo}, l)))
 
-	    val pseudo_blocks = AppendList.toList pseudo_blocks
+            val pseudo_blocks = AppendList.toList pseudo_blocks
 
-	    val blocks = x86.Block.compress pseudo_blocks
-	  in
-	    blocks
-	  end
-	  handle exn
-	   => Error.reraise (exn, "x86Translate.Block.toX86Blocks")
+            val blocks = x86.Block.compress pseudo_blocks
+          in
+            blocks
+          end
     end
 
   structure Chunk =
@@ -788,52 +776,50 @@
       open Machine.Chunk
 
       fun toX86Chunk {chunk = T {blocks, ...}, 
-		      frameInfoToX86,
-		      liveInfo}
-	= let
-	    val data = ref []
-	    val addData = fn l => List.push (data, l)
-	    val _ = addData [x86.Assembly.pseudoop_data ()]
-	    val {get = live : Label.t -> x86.Operand.t list,
-		 set = setLive, 
-		 rem = remLive, ...}
-	      = Property.getSetOnce
-	        (Label.plist, Property.initRaise ("live", Label.layout))
-	    val _ = Vector.foreach
-	            (blocks, fn Block.T {label, live, ...} =>
-		     setLive (label,
-			      (Vector.toList o #1 o Vector.unzip o 
-			       Vector.concatV o Vector.map)
-			      (live, Operand.toX86Operand o Live.toOperand)))
-	    val transInfo = {addData = addData,
-			     frameInfoToX86 = frameInfoToX86,
-			     live = live,
-			     liveInfo = liveInfo}
-	    val x86Blocks 
-	      = List.concat (Vector.toListMap
-			     (blocks, 
-				fn block
-				 => Block.toX86Blocks 
-				    {block = block,
-				     transInfo = transInfo}))
-	    val _ = Vector.foreach (blocks, fn Block.T {label, ...} =>
-				    remLive label)
-	    val _ = addData [x86.Assembly.pseudoop_text ()]
-	    val data = List.concatRev (!data)
-	  in
-	    x86.Chunk.T {data = data, blocks = x86Blocks}
-	  end
-	  handle exn
-	   => Error.reraise (exn, "x86Translate.Chunk.toX86Chunk")
+                      frameInfoToX86,
+                      liveInfo}
+        = let
+            val data = ref []
+            val addData = fn l => List.push (data, l)
+            val _ = addData [x86.Assembly.pseudoop_data ()]
+            val {get = live : Label.t -> x86.Operand.t list,
+                 set = setLive, 
+                 rem = remLive, ...}
+              = Property.getSetOnce
+                (Label.plist, Property.initRaise ("live", Label.layout))
+            val _ = Vector.foreach
+                    (blocks, fn Block.T {label, live, ...} =>
+                     setLive (label,
+                              (Vector.toList o #1 o Vector.unzip o 
+                               Vector.concatV o Vector.map)
+                              (live, Operand.toX86Operand o Live.toOperand)))
+            val transInfo = {addData = addData,
+                             frameInfoToX86 = frameInfoToX86,
+                             live = live,
+                             liveInfo = liveInfo}
+            val x86Blocks 
+              = List.concat (Vector.toListMap
+                             (blocks, 
+                                fn block
+                                 => Block.toX86Blocks 
+                                    {block = block,
+                                     transInfo = transInfo}))
+            val _ = Vector.foreach (blocks, fn Block.T {label, ...} =>
+                                    remLive label)
+            val _ = addData [x86.Assembly.pseudoop_text ()]
+            val data = List.concatRev (!data)
+          in
+            x86.Chunk.T {data = data, blocks = x86Blocks}
+          end
     end
 
   fun translateChunk {chunk: x86MLton.Machine.Chunk.t,
-		      frameInfoToX86,
-		      liveInfo: x86Liveness.LiveInfo.t}:
+                      frameInfoToX86,
+                      liveInfo: x86Liveness.LiveInfo.t}:
                      {chunk: x86.Chunk.t}
     = {chunk = Chunk.toX86Chunk {chunk = chunk,
-				 frameInfoToX86 = frameInfoToX86,
-				 liveInfo = liveInfo}}
+                                 frameInfoToX86 = frameInfoToX86,
+                                 liveInfo = liveInfo}}
 
   val (translateChunk, translateChunk_msg)
     = tracerTop

Modified: mlton/branches/on-20050420-cmm-branch/mlton/codegen/x86-codegen/x86-translate.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/codegen/x86-codegen/x86-translate.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/codegen/x86-codegen/x86-translate.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 type int = Int.t
 
 signature X86_TRANSLATE_STRUCTS =
@@ -22,9 +23,9 @@
     include X86_TRANSLATE_STRUCTS
 
     val translateChunk : {chunk: x86MLton.Machine.Chunk.t,
-			  frameInfoToX86: (x86MLton.Machine.FrameInfo.t
-					   -> x86.FrameInfo.t),
-			  liveInfo: x86Liveness.LiveInfo.t}
+                          frameInfoToX86: (x86MLton.Machine.FrameInfo.t
+                                           -> x86.FrameInfo.t),
+                          liveInfo: x86Liveness.LiveInfo.t}
                          -> {chunk: x86.Chunk.t}
 
     val translateChunk_totals : unit -> unit

Modified: mlton/branches/on-20050420-cmm-branch/mlton/codegen/x86-codegen/x86-validate.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/codegen/x86-codegen/x86-validate.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/codegen/x86-codegen/x86-validate.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 functor x86Validate(S: X86_VALIDATE_STRUCTS): X86_VALIDATE =
 struct
 
@@ -18,29 +19,29 @@
       open Register
 
       fun validate {register}
-	= if not (List.contains(registers (size register),
-				register,
-				eq))
-	    then Error.bug "validate: Register"
-	    else true
+        = if not (List.contains(registers (size register),
+                                register,
+                                eq))
+            then Error.bug "x86Validate.Register.validate"
+            else true
 
       fun validate_base {register}
-	= if not (validate {register = register}
-		  andalso
-		  List.contains(baseRegisters,
-				register,
-				eq))
-	    then Error.bug "validate: Register, base"
-	    else true
+        = if not (validate {register = register}
+                  andalso
+                  List.contains(baseRegisters,
+                                register,
+                                eq))
+            then Error.bug "x86Validate.Register.validate_base"
+            else true
 
       fun validate_index {register}
-	= if not (validate {register = register}
-		  andalso
-		  List.contains(indexRegisters,
-				register,
-				eq))
-	    then Error.bug "validate: Register, index"
-	    else true
+        = if not (validate {register = register}
+                  andalso
+                  List.contains(indexRegisters,
+                                register,
+                                eq))
+            then Error.bug "x86Validate.Register.validate_index"
+            else true
     end
 
   structure FltRegister =
@@ -48,9 +49,9 @@
       open FltRegister
 
       fun validate {fltregister = FltRegister.T i}
-	= if 0 > i orelse i > 7
-	    then Error.bug "validate: FltRegister"
-	    else true
+        = if 0 > i orelse i > 7
+            then Error.bug "x86Validate.FltRegister.validate"
+            else true
     end
 
   structure Address =
@@ -58,27 +59,27 @@
       open Address
 
       fun validate {address as Address.T {base, index, ...}}
-	= let
-	    val _ = case base
-	              of NONE => ()
-		       | SOME r => if Register.validate_base {register = r}
-				     then ()
-				     else Error.bug "validate: Address, base"
+        = let
+            val _ = case base
+                      of NONE => ()
+                       | SOME r => if Register.validate_base {register = r}
+                                     then ()
+                                     else Error.bug "x86Validate.Address.validate: base"
 
-	    val _ = case index
-	              of NONE => ()
-		       | SOME r => if Register.validate_index {register = r}
-				     then ()
-				     else Error.bug "validate: Address, index"
-	  in
-	    case address
-	      of Address.T {disp = NONE, base = NONE, 
-			    index = NONE, scale = NONE}
-	       => Error.bug "validate: Address"
-	       | Address.T {index = NONE, scale = SOME _, ...}
-	       => Error.bug "validate: Address, scale"
-	       | _ => true
-	  end
+            val _ = case index
+                      of NONE => ()
+                       | SOME r => if Register.validate_index {register = r}
+                                     then ()
+                                     else Error.bug "x86Validate.Address.validate: index"
+          in
+            case address
+              of Address.T {disp = NONE, base = NONE, 
+                            index = NONE, scale = NONE}
+               => Error.bug "x86Validate.Address.validate"
+               | Address.T {index = NONE, scale = SOME _, ...}
+               => Error.bug "x86Validate.Address.validate: scale"
+               | _ => true
+          end
     end
 
   structure Operand =
@@ -86,13 +87,13 @@
       open Operand
 
       fun validate {operand: t}
-	= case operand
-	    of Register r => Register.validate {register = r}
-	     | FltRegister f => FltRegister.validate {fltregister = f}
-	     | Immediate _ => true
-	     | Label _ => true
-	     | Address a => Address.validate {address = a}
-	     | MemLoc _ => Error.bug "validate: Operand, MemLoc"
+        = case operand
+            of Register r => Register.validate {register = r}
+             | FltRegister f => FltRegister.validate {fltregister = f}
+             | Immediate _ => true
+             | Label _ => true
+             | Address a => Address.validate {address = a}
+             | MemLoc _ => Error.bug "x86Validate.Operand.validate: MemLoc"
     end
 
   structure Instruction =
@@ -100,1152 +101,1152 @@
       open x86.Instruction
 
       fun validate {instruction: t}
-	= case instruction
-	    of NOP => true
-	     | BinAL {src, dst, size, ...}
-	       (* Integer binary arithmetic(w/o mult & div)/logic instructions.
-		* Require src/dst operands as follows:
-		*
-		*              dst
-		*          reg imm lab add 
-		*      reg  X           X
-		*  src imm  X           X
-		*      lab
-		*      add  X
-		*
-		* Require size modifier class as follows: INT
-		*)
-	     => let
-		  val _ = if Size.class size = Size.INT
-			    then ()
-			    else Error.bug "validate: BinAL, size"
-		  val _ = case Operand.size src
-			    of NONE => ()
-			     | SOME srcsize 
-			     => if srcsize = size
-				  then ()
-				  else Error.bug "validate: BinAL, srcsize"
- 		  val _ = case Operand.size dst
-			    of NONE => ()
-			     | SOME dstsize 
-			     => if dstsize = size
-				  then ()
-				  else Error.bug "validate: BinAL, dstsize"
-		in
-		  case (src,dst)
-		    of (Operand.MemLoc _, _)
-		     => Error.bug "validate: BinAL, src:MemLoc"
-		     | (_, Operand.MemLoc _)
-		     => Error.bug "validate: BinAL, dst:MemLoc"
-		     | (Operand.FltRegister _, _)
-		     => Error.bug "validate: BinAL, src:FltRegister"
-		     | (Operand.Label _, _)
-		     => Error.bug "validate: BinAL, src:Label"
-		     | (_, Operand.FltRegister _)
-		     => Error.bug "validate: BinAL, dst:FltRegister"
-		     | (_, Operand.Immediate _)
-		     => Error.bug "validate: BinAL, dst:Immediate"
-		     | (_, Operand.Label _)
-                     => Error.bug "validate: BinAL, dst:Label"
-		     | (Operand.Address _, Operand.Address _)
-		     => Error.bug "validate: BinAL, src,dst:Address"
-		     | _ => (Operand.validate {operand = src}) andalso
+        = case instruction
+            of NOP => true
+             | BinAL {src, dst, size, ...}
+               (* Integer binary arithmetic(w/o mult & div)/logic instructions.
+                * Require src/dst operands as follows:
+                *
+                *              dst
+                *          reg imm lab add 
+                *      reg  X           X
+                *  src imm  X           X
+                *      lab
+                *      add  X
+                *
+                * Require size modifier class as follows: INT
+                *)
+             => let
+                  val _ = if Size.class size = Size.INT
+                            then ()
+                            else Error.bug "x86Validate.Instruction.validate: BinAL, size"
+                  val _ = case Operand.size src
+                            of NONE => ()
+                             | SOME srcsize 
+                             => if srcsize = size
+                                  then ()
+                                  else Error.bug "x86Validate.Instruction.validate: BinAL, srcsize"
+                  val _ = case Operand.size dst
+                            of NONE => ()
+                             | SOME dstsize 
+                             => if dstsize = size
+                                  then ()
+                                  else Error.bug "x86Validate.Instruction.validate: BinAL, dstsize"
+                in
+                  case (src,dst)
+                    of (Operand.MemLoc _, _)
+                     => Error.bug "x86Validate.Instruction.validate: BinAL, src:MemLoc"
+                     | (_, Operand.MemLoc _)
+                     => Error.bug "x86Validate.Instruction.validate: BinAL, dst:MemLoc"
+                     | (Operand.FltRegister _, _)
+                     => Error.bug "x86Validate.Instruction.validate: BinAL, src:FltRegister"
+                     | (Operand.Label _, _)
+                     => Error.bug "x86Validate.Instruction.validate: BinAL, src:Label"
+                     | (_, Operand.FltRegister _)
+                     => Error.bug "x86Validate.Instruction.validate: BinAL, dst:FltRegister"
+                     | (_, Operand.Immediate _)
+                     => Error.bug "x86Validate.Instruction.validate: BinAL, dst:Immediate"
+                     | (_, Operand.Label _)
+                     => Error.bug "x86Validate.Instruction.validate: BinAL, dst:Label"
+                     | (Operand.Address _, Operand.Address _)
+                     => Error.bug "x86Validate.Instruction.validate: BinAL, src,dst:Address"
+                     | _ => (Operand.validate {operand = src}) andalso
                             (Operand.validate {operand = dst})
-		end
-	     | MD {src, size, ...} 
-	       (* Integer multiplication and division.
-		* Require src operand as follows:
-		*
-		*               src
-		*           reg imm lab add
-		*            X           X
-		*
-		* Require size modifier class as follows: INT
-		*)
+                end
+             | MD {src, size, ...} 
+               (* Integer multiplication and division.
+                * Require src operand as follows:
+                *
+                *               src
+                *           reg imm lab add
+                *            X           X
+                *
+                * Require size modifier class as follows: INT
+                *)
              => let
-		  val _ = if Size.class size = Size.INT
-			    then ()
-			    else Error.bug "validate: BinMD, size"
-		  val _ = case Operand.size src
-			    of NONE => ()
-			     | SOME srcsize 
-			     => if srcsize = size
-				  then ()
-				  else Error.bug "validate: MD, srcsize"
-		in
-		  case src
-		    of Operand.MemLoc _
-		     => Error.bug "validate: MD, src:MemLoc"
-		     | Operand.FltRegister _
-		     => Error.bug "validate: MD, src:FltRegister"
-		     | Operand.Immediate _
-		     => Error.bug "validate: MD, src:Immediate"
-		     | Operand.Label _
-		     => Error.bug "validate: MD, src:Label"
-		     | _ => (Operand.validate {operand = src})
-		end
-	     | IMUL2 {src, dst, size}
-	       (* Integer signed/unsigned multiplication (two operand form).
-		* Require src/dst operands as follows:
-		*
-		*              dst
-		*          reg imm lab add 
-		*      reg  X
-		*  src imm  X
-		*      lab
-		*      add  X
-		*
-		* Require size modifier class as follows: INT(WORD, LONG)
-		*)
-	     => let
-		  val _ = case size
-			    of Size.WORD => ()
-			     | Size.LONG => ()
-			     | _ => Error.bug "validate: IMUL2, size"
-		  val _ = case Operand.size src
-			    of NONE => ()
-			     | SOME srcsize 
-			     => if srcsize = size
-				  then ()
-				  else Error.bug "validate: IMUL2, srcsize"
- 		  val _ = case Operand.size dst
-			    of NONE => ()
-			     | SOME dstsize 
-			     => if dstsize = size
-				  then ()
-				  else Error.bug "validate: IMUL2, dstsize"
-		in
-		  case (src,dst)
-		    of (Operand.MemLoc _, _)
-		     => Error.bug "validate: IMUL2, src:MemLoc"
-		     | (_, Operand.MemLoc _)
-		     => Error.bug "validate: IMUL2, dst:MemLoc"
-		     | (Operand.FltRegister _, _)
-		     => Error.bug "validate: IMUL2, src:FltRegister"
-		     | (Operand.Label _, _)
-		     => Error.bug "validate: IMUL2, src:Label"
-		     | (_, Operand.FltRegister _)
-		     => Error.bug "validate: IMUL2, dst:FltRegister"
-		     | (_, Operand.Immediate _)
-		     => Error.bug "validate: IMUL2, dst:Immediate"
-		     | (_, Operand.Label _)
-                     => Error.bug "validate: IMUL2, dst:Label"
-		     | (Operand.Address _, _)
-		     => Error.bug "validate: IMUL2, src:Address"
-		     | _ => (Operand.validate {operand = src}) andalso
+                  val _ = if Size.class size = Size.INT
+                            then ()
+                            else Error.bug "x86Validate.Instruction.validate: BinMD, size"
+                  val _ = case Operand.size src
+                            of NONE => ()
+                             | SOME srcsize 
+                             => if srcsize = size
+                                  then ()
+                                  else Error.bug "x86Validate.Instruction.validate: MD, srcsize"
+                in
+                  case src
+                    of Operand.MemLoc _
+                     => Error.bug "x86Validate.Instruction.validate: MD, src:MemLoc"
+                     | Operand.FltRegister _
+                     => Error.bug "x86Validate.Instruction.validate: MD, src:FltRegister"
+                     | Operand.Immediate _
+                     => Error.bug "x86Validate.Instruction.validate: MD, src:Immediate"
+                     | Operand.Label _
+                     => Error.bug "x86Validate.Instruction.validate: MD, src:Label"
+                     | _ => (Operand.validate {operand = src})
+                end
+             | IMUL2 {src, dst, size}
+               (* Integer signed/unsigned multiplication (two operand form).
+                * Require src/dst operands as follows:
+                *
+                *              dst
+                *          reg imm lab add 
+                *      reg  X
+                *  src imm  X
+                *      lab
+                *      add  X
+                *
+                * Require size modifier class as follows: INT(WORD, LONG)
+                *)
+             => let
+                  val _ = case size
+                            of Size.WORD => ()
+                             | Size.LONG => ()
+                             | _ => Error.bug "x86Validate.Instruction.validate: IMUL2, size"
+                  val _ = case Operand.size src
+                            of NONE => ()
+                             | SOME srcsize 
+                             => if srcsize = size
+                                  then ()
+                                  else Error.bug "x86Validate.Instruction.validate: IMUL2, srcsize"
+                  val _ = case Operand.size dst
+                            of NONE => ()
+                             | SOME dstsize 
+                             => if dstsize = size
+                                  then ()
+                                  else Error.bug "x86Validate.Instruction.validate: IMUL2, dstsize"
+                in
+                  case (src,dst)
+                    of (Operand.MemLoc _, _)
+                     => Error.bug "x86Validate.Instruction.validate: IMUL2, src:MemLoc"
+                     | (_, Operand.MemLoc _)
+                     => Error.bug "x86Validate.Instruction.validate: IMUL2, dst:MemLoc"
+                     | (Operand.FltRegister _, _)
+                     => Error.bug "x86Validate.Instruction.validate: IMUL2, src:FltRegister"
+                     | (Operand.Label _, _)
+                     => Error.bug "x86Validate.Instruction.validate: IMUL2, src:Label"
+                     | (_, Operand.FltRegister _)
+                     => Error.bug "x86Validate.Instruction.validate: IMUL2, dst:FltRegister"
+                     | (_, Operand.Immediate _)
+                     => Error.bug "x86Validate.Instruction.validate: IMUL2, dst:Immediate"
+                     | (_, Operand.Label _)
+                     => Error.bug "x86Validate.Instruction.validate: IMUL2, dst:Label"
+                     | (Operand.Address _, _)
+                     => Error.bug "x86Validate.Instruction.validate: IMUL2, src:Address"
+                     | _ => (Operand.validate {operand = src}) andalso
                             (Operand.validate {operand = dst})
-		end
-	     | UnAL {dst, size, ...}
-	       (* Integer unary arithmetic/logic instructions.
-		* Require dst operand as follows:
-		*
-		*               dst
-		*           reg imm lab add
-		*            X           X
-		*
-		* Require size modifier class as follows: INT
-		*)
+                end
+             | UnAL {dst, size, ...}
+               (* Integer unary arithmetic/logic instructions.
+                * Require dst operand as follows:
+                *
+                *               dst
+                *           reg imm lab add
+                *            X           X
+                *
+                * Require size modifier class as follows: INT
+                *)
              => let
-		  val _ = if Size.class size = Size.INT
-			    then ()
-			    else Error.bug "validate: UnAL, size"
- 		  val _ = case Operand.size dst
-			    of NONE => ()
-			     | SOME dstsize 
-			     => if dstsize = size
-				  then ()
-				  else Error.bug "validate: UnAL, dstsize"
-		in
-		  case dst
-		    of Operand.MemLoc _
-		     => Error.bug "validate: UnAL, dst:MemLoc"
-		     | Operand.FltRegister _
-		     => Error.bug "validate: UnAL, dst:FltRegister"
-		     | Operand.Immediate _
-		     => Error.bug "validate: UnAL, dst:Immediate"
-		     | Operand.Label _
-		     => Error.bug "validate: UnAL, dst:Label"
-		     | _ => (Operand.validate {operand = dst})
-		end
-	     | SRAL {count, dst, size, ...}
-	       (* Integer shift/rotate arithmetic/logic instructions.
-		* Require count operand as follows:
-		*
-		*               src
-		*           reg imm lab add
-		*            *   X
-		*  * only register %cl
-		*
-		* Require dst operand as follows:
-		*
-		*               dst
-		*           reg imm lab add
-		*            X           X
-		*
-		* Require size modifier class as follows: INT
-		*)
-             => let	
-		  val _ = if Size.class size = Size.INT
-			    then ()
-			    else Error.bug "validate: SRAL, size"
- 		  val _ = case Operand.size dst
-			    of NONE => ()
-			     | SOME dstsize 
-			     => if dstsize = size
-				  then ()
-				  else Error.bug "validate: SRAL, dstsize"
+                  val _ = if Size.class size = Size.INT
+                            then ()
+                            else Error.bug "x86Validate.Instruction.validate: UnAL, size"
+                  val _ = case Operand.size dst
+                            of NONE => ()
+                             | SOME dstsize 
+                             => if dstsize = size
+                                  then ()
+                                  else Error.bug "x86Validate.Instruction.validate: UnAL, dstsize"
+                in
+                  case dst
+                    of Operand.MemLoc _
+                     => Error.bug "x86Validate.Instruction.validate: UnAL, dst:MemLoc"
+                     | Operand.FltRegister _
+                     => Error.bug "x86Validate.Instruction.validate: UnAL, dst:FltRegister"
+                     | Operand.Immediate _
+                     => Error.bug "x86Validate.Instruction.validate: UnAL, dst:Immediate"
+                     | Operand.Label _
+                     => Error.bug "x86Validate.Instruction.validate: UnAL, dst:Label"
+                     | _ => (Operand.validate {operand = dst})
+                end
+             | SRAL {count, dst, size, ...}
+               (* Integer shift/rotate arithmetic/logic instructions.
+                * Require count operand as follows:
+                *
+                *               src
+                *           reg imm lab add
+                *            *   X
+                *  * only register %cl
+                *
+                * Require dst operand as follows:
+                *
+                *               dst
+                *           reg imm lab add
+                *            X           X
+                *
+                * Require size modifier class as follows: INT
+                *)
+             => let     
+                  val _ = if Size.class size = Size.INT
+                            then ()
+                            else Error.bug "x86Validate.Instruction.validate: SRAL, size"
+                  val _ = case Operand.size dst
+                            of NONE => ()
+                             | SOME dstsize 
+                             => if dstsize = size
+                                  then ()
+                                  else Error.bug "x86Validate.Instruction.validate: SRAL, dstsize"
 
-		  val _ = case count
-			    of Operand.MemLoc _
-			     => Error.bug "validate: SRAL, count:MemLoc"
-			     | Operand.FltRegister _
-			     => Error.bug "validate: SRAL, count:FltRegister"
-			     | Operand.Label _
-			     => Error.bug "validate: SRAL, count:Label"
-			     | Operand.Address _
-			     => Error.bug "validate: SRAL, count:Address"
-			     | Operand.Register (Register.T {reg, part})
-			     => if reg <> Register.ECX orelse
-			           part <> Register.L
-				  then Error.bug 
-				       "validate: SRAL, count:Register"
-				  else ()
-			     | _ => ()
-		in
-		  case dst
-		    of Operand.MemLoc _
-		     => Error.bug "validate: SRAL, dst:MemLoc"
-		     | Operand.FltRegister _
-		     => Error.bug "validate: SRAL, dst:FltRegister"
-		     | Operand.Immediate _
-		     => Error.bug "validate: SRAL, dst:Immediate"
-		     | Operand.Label _
-		     => Error.bug "validate: SRAL, dst:Label"
-		     | _ => Operand.validate {operand = dst}
-		end
+                  val _ = case count
+                            of Operand.MemLoc _
+                             => Error.bug "x86Validate.Instruction.validate: SRAL, count:MemLoc"
+                             | Operand.FltRegister _
+                             => Error.bug "x86Validate.Instruction.validate: SRAL, count:FltRegister"
+                             | Operand.Label _
+                             => Error.bug "x86Validate.Instruction.validate: SRAL, count:Label"
+                             | Operand.Address _
+                             => Error.bug "x86Validate.Instruction.validate: SRAL, count:Address"
+                             | Operand.Register (Register.T {reg, part})
+                             => if reg <> Register.ECX orelse
+                                   part <> Register.L
+                                  then Error.bug 
+                                       "x86Validate.Instruction.validate: SRAL, count:Register"
+                                  else ()
+                             | _ => ()
+                in
+                  case dst
+                    of Operand.MemLoc _
+                     => Error.bug "x86Validate.Instruction.validate: SRAL, dst:MemLoc"
+                     | Operand.FltRegister _
+                     => Error.bug "x86Validate.Instruction.validate: SRAL, dst:FltRegister"
+                     | Operand.Immediate _
+                     => Error.bug "x86Validate.Instruction.validate: SRAL, dst:Immediate"
+                     | Operand.Label _
+                     => Error.bug "x86Validate.Instruction.validate: SRAL, dst:Label"
+                     | _ => Operand.validate {operand = dst}
+                end
              | CMP {src1, src2, size}
-	       (* Arithmetic compare;  p. 116
-		* Require src1/src2 operands as follows:
-		*
-		*               src2
-		*           reg imm lab add 
-		*       reg  X   X       X
-		*  src1 imm
-		*       lab
-		*       add  X   X
-		*
-		* Require size modifier class as follows: INT
-		*)
+               (* Arithmetic compare;  p. 116
+                * Require src1/src2 operands as follows:
+                *
+                *               src2
+                *           reg imm lab add 
+                *       reg  X   X       X
+                *  src1 imm
+                *       lab
+                *       add  X   X
+                *
+                * Require size modifier class as follows: INT
+                *)
              => let
-		  val _ = if Size.class size = Size.INT
-			    then ()
-			    else Error.bug "validate: CMP, size"
-		  val _ = case Operand.size src1
-			    of NONE => ()
-			     | SOME src1size 
-			     => if src1size = size
-				  then ()
-				  else Error.bug "validate: CMP, src1size"
- 		  val _ = case Operand.size src2
-			    of NONE => ()
-			     | SOME src2size 
-			     => if src2size = size
-				  then ()
-				  else Error.bug "validate: CMP, src2size"
-		in
-		  case (src1,src2)
-		    of (Operand.MemLoc _, _)
-		     => Error.bug "validate: CMP, src1:MemLoc"
-		     | (_, Operand.MemLoc _)
-		     => Error.bug "validate: CMP, src2:MemLoc"
-		     | (Operand.FltRegister _, _)
-		     => Error.bug "validate: CMP, src1: FltRegister"
-		     | (Operand.Immediate _, _)
-		     => Error.bug "validate: CMP, src1:Immediate"
-		     | (Operand.Label _, _)
-		     => Error.bug "validate: CMP, src1:Label"
-		     | (_, Operand.FltRegister _)
-		     => Error.bug "validate: CMP, src2: FltRegister"
-		     | (_, Operand.Label _)
-		     => Error.bug "validate: CMP, src2:Label"
-		     | (Operand.Address _, Operand.Address _)
-                     => Error.bug "validate: CMP, src1,src2:Address"
-		     | _ => (Operand.validate {operand = src1}) andalso
+                  val _ = if Size.class size = Size.INT
+                            then ()
+                            else Error.bug "x86Validate.Instruction.validate: CMP, size"
+                  val _ = case Operand.size src1
+                            of NONE => ()
+                             | SOME src1size 
+                             => if src1size = size
+                                  then ()
+                                  else Error.bug "x86Validate.Instruction.validate: CMP, src1size"
+                  val _ = case Operand.size src2
+                            of NONE => ()
+                             | SOME src2size 
+                             => if src2size = size
+                                  then ()
+                                  else Error.bug "x86Validate.Instruction.validate: CMP, src2size"
+                in
+                  case (src1,src2)
+                    of (Operand.MemLoc _, _)
+                     => Error.bug "x86Validate.Instruction.validate: CMP, src1:MemLoc"
+                     | (_, Operand.MemLoc _)
+                     => Error.bug "x86Validate.Instruction.validate: CMP, src2:MemLoc"
+                     | (Operand.FltRegister _, _)
+                     => Error.bug "x86Validate.Instruction.validate: CMP, src1: FltRegister"
+                     | (Operand.Immediate _, _)
+                     => Error.bug "x86Validate.Instruction.validate: CMP, src1:Immediate"
+                     | (Operand.Label _, _)
+                     => Error.bug "x86Validate.Instruction.validate: CMP, src1:Label"
+                     | (_, Operand.FltRegister _)
+                     => Error.bug "x86Validate.Instruction.validate: CMP, src2: FltRegister"
+                     | (_, Operand.Label _)
+                     => Error.bug "x86Validate.Instruction.validate: CMP, src2:Label"
+                     | (Operand.Address _, Operand.Address _)
+                     => Error.bug "x86Validate.Instruction.validate: CMP, src1,src2:Address"
+                     | _ => (Operand.validate {operand = src1}) andalso
                             (Operand.validate {operand = src2})
-		end
+                end
              | TEST {src1, src2, size}
-	       (* Logical compare; p. 728
-		* Require src1/src2 operands as follows:
-		*
-		*               src2
-		*           reg imm lab add 
-		*       reg  X   X       X
-		*  src1 imm  
-		*       lab
-		*       add  X   X    
-		*
-		* Require size modifier class as follows: INT
-		*)
+               (* Logical compare; p. 728
+                * Require src1/src2 operands as follows:
+                *
+                *               src2
+                *           reg imm lab add 
+                *       reg  X   X       X
+                *  src1 imm  
+                *       lab
+                *       add  X   X    
+                *
+                * Require size modifier class as follows: INT
+                *)
              => let
-		  val _ = if Size.class size = Size.INT
-			    then ()
-			    else Error.bug "validate: TEST, size"
-		  val _ = case Operand.size src1
-			    of NONE => ()
-			     | SOME src1size 
-			     => if src1size = size
-				  then ()
-				  else Error.bug "validate: TEST, src1size"
- 		  val _ = case Operand.size src2
-			    of NONE => ()
-			     | SOME src2size 
-			     => if src2size = size
-				  then ()
-				  else Error.bug "validate: TEST, src2size"
-		in
-		  case (src1,src2)
-		    of (Operand.MemLoc _, _)
-		     => Error.bug "validate: TEST, src1:MemLoc"
-		     | (_, Operand.MemLoc _)
-		     => Error.bug "validate: TEST, src2:MemLoc"
-		     | (Operand.FltRegister _, _)
-		     => Error.bug "validate: TEST, src1: FltRegister"
-		     | (Operand.Immediate _, _)
-		     => Error.bug "validate: TEST, src1:Immediate"	
-		     | (Operand.Label _, _)
-		     => Error.bug "validate: TEST, src1:Label"
-		     | (_, Operand.FltRegister _)
-		     => Error.bug "validate: TEST, src2: FltRegister"
-		     | (_, Operand.Label _)
-		     => Error.bug "validate: TEST, src2:Label"
-		     | (Operand.Address _, Operand.Address _)
-                     => Error.bug "validate: TEST, src1,src2:Address"
-		     | _ => (Operand.validate {operand = src1}) andalso
+                  val _ = if Size.class size = Size.INT
+                            then ()
+                            else Error.bug "x86Validate.Instruction.validate: TEST, size"
+                  val _ = case Operand.size src1
+                            of NONE => ()
+                             | SOME src1size 
+                             => if src1size = size
+                                  then ()
+                                  else Error.bug "x86Validate.Instruction.validate: TEST, src1size"
+                  val _ = case Operand.size src2
+                            of NONE => ()
+                             | SOME src2size 
+                             => if src2size = size
+                                  then ()
+                                  else Error.bug "x86Validate.Instruction.validate: TEST, src2size"
+                in
+                  case (src1,src2)
+                    of (Operand.MemLoc _, _)
+                     => Error.bug "x86Validate.Instruction.validate: TEST, src1:MemLoc"
+                     | (_, Operand.MemLoc _)
+                     => Error.bug "x86Validate.Instruction.validate: TEST, src2:MemLoc"
+                     | (Operand.FltRegister _, _)
+                     => Error.bug "x86Validate.Instruction.validate: TEST, src1: FltRegister"
+                     | (Operand.Immediate _, _)
+                     => Error.bug "x86Validate.Instruction.validate: TEST, src1:Immediate"      
+                     | (Operand.Label _, _)
+                     => Error.bug "x86Validate.Instruction.validate: TEST, src1:Label"
+                     | (_, Operand.FltRegister _)
+                     => Error.bug "x86Validate.Instruction.validate: TEST, src2: FltRegister"
+                     | (_, Operand.Label _)
+                     => Error.bug "x86Validate.Instruction.validate: TEST, src2:Label"
+                     | (Operand.Address _, Operand.Address _)
+                     => Error.bug "x86Validate.Instruction.validate: TEST, src1,src2:Address"
+                     | _ => (Operand.validate {operand = src1}) andalso
                             (Operand.validate {operand = src2})
-		end
-	     | SETcc {dst, size, ...}
-	       (* Set byte on condition; p. 672
-		* Require dst operand as follows:
-		*
-		*                dst
-		*            reg imm lab add
-		*             *           X
-		*  * only byte registers
-		*
-		* Require size modifier class as follows: INT(BYTE)
-		*)
-	     => let
-		  val _ = case size
-			    of Size.BYTE => ()
-			     | _ => Error.bug "validate: SETcc, size"
-		  val _ = case Operand.size dst
-			    of NONE => ()
-			     | SOME dstsize 
-			     => if dstsize = size
-				  then ()
-				  else Error.bug "validate: SETcc, dstsize"
-		in
-		  case dst
-		    of Operand.MemLoc _
-		     => Error.bug "validate: SETcc, dst:MemLoc"
-		     | Operand.FltRegister _
-		     => Error.bug "validate: SETcc, dst:FltRegister"
-		     | Operand.Immediate _
-		     => Error.bug "validate: SETcc, dst:Immediate"
-		     | Operand.Label _
-		     => Error.bug "validate: SETcc, dst:Label"
-		     | _ => (Operand.validate {operand = dst})
-		end
+                end
+             | SETcc {dst, size, ...}
+               (* Set byte on condition; p. 672
+                * Require dst operand as follows:
+                *
+                *                dst
+                *            reg imm lab add
+                *             *           X
+                *  * only byte registers
+                *
+                * Require size modifier class as follows: INT(BYTE)
+                *)
+             => let
+                  val _ = case size
+                            of Size.BYTE => ()
+                             | _ => Error.bug "x86Validate.Instruction.validate: SETcc, size"
+                  val _ = case Operand.size dst
+                            of NONE => ()
+                             | SOME dstsize 
+                             => if dstsize = size
+                                  then ()
+                                  else Error.bug "x86Validate.Instruction.validate: SETcc, dstsize"
+                in
+                  case dst
+                    of Operand.MemLoc _
+                     => Error.bug "x86Validate.Instruction.validate: SETcc, dst:MemLoc"
+                     | Operand.FltRegister _
+                     => Error.bug "x86Validate.Instruction.validate: SETcc, dst:FltRegister"
+                     | Operand.Immediate _
+                     => Error.bug "x86Validate.Instruction.validate: SETcc, dst:Immediate"
+                     | Operand.Label _
+                     => Error.bug "x86Validate.Instruction.validate: SETcc, dst:Label"
+                     | _ => (Operand.validate {operand = dst})
+                end
              | JMP {target, ...}
-	       (* Jump; p. 373
-		* Require target operand as follows:
-		*
-		*               target
-		*            reg imm lab add
-		*             X   X   X   X
-		*)
-	     => let
-		in
-		  case target
-		    of Operand.MemLoc _
-		     => Error.bug "validate: JMP, target:MemLoc"
-		     | Operand.FltRegister _
-		     => Error.bug "validate: JMP, target:FltRegister"
-		     | _ => (Operand.validate {operand = target})
-		end
-	     | Jcc {target, ...}
-	       (* Jump if condition is met; p. 369
-		* Require target operand as follows:
-		*
-		*               target
-		*            reg imm lab add
-		*                 X   X
-		*)
-	     => let
-		in
-		  case target
-		    of Operand.MemLoc _
-		     => Error.bug "validate: Jcc, target:MemLoc"
-		     | Operand.Register _
-		     => Error.bug "validate: Jcc, target:Register"
-		     | Operand.FltRegister _
-		     => Error.bug "validate: Jcc, target:FltRegister"
-		     | Operand.Address _
-		     => Error.bug "validate: Jcc, target:Address"
-		     | _ => (Operand.validate {operand = target})
-		end
+               (* Jump; p. 373
+                * Require target operand as follows:
+                *
+                *               target
+                *            reg imm lab add
+                *             X   X   X   X
+                *)
+             => let
+                in
+                  case target
+                    of Operand.MemLoc _
+                     => Error.bug "x86Validate.Instruction.validate: JMP, target:MemLoc"
+                     | Operand.FltRegister _
+                     => Error.bug "x86Validate.Instruction.validate: JMP, target:FltRegister"
+                     | _ => (Operand.validate {operand = target})
+                end
+             | Jcc {target, ...}
+               (* Jump if condition is met; p. 369
+                * Require target operand as follows:
+                *
+                *               target
+                *            reg imm lab add
+                *                 X   X
+                *)
+             => let
+                in
+                  case target
+                    of Operand.MemLoc _
+                     => Error.bug "x86Validate.Instruction.validate: Jcc, target:MemLoc"
+                     | Operand.Register _
+                     => Error.bug "x86Validate.Instruction.validate: Jcc, target:Register"
+                     | Operand.FltRegister _
+                     => Error.bug "x86Validate.Instruction.validate: Jcc, target:FltRegister"
+                     | Operand.Address _
+                     => Error.bug "x86Validate.Instruction.validate: Jcc, target:Address"
+                     | _ => (Operand.validate {operand = target})
+                end
              | CALL {target, ...}
-	       (* Call procedure; p. 93 
-		* Require target operand as follows:
-		*
-		*               target
-		*            reg imm lab add
-		*             X   X   X   X
-		*)
-	     => let
-		in
-		  case target
-		    of Operand.MemLoc _
-		     => Error.bug "validate: CALL, target:MemLoc"
-		     | Operand.FltRegister _
-		     => Error.bug "validate: CALL, target:FltRegister"
-		     | _ => (Operand.validate {operand = target})
-		end
+               (* Call procedure; p. 93 
+                * Require target operand as follows:
+                *
+                *               target
+                *            reg imm lab add
+                *             X   X   X   X
+                *)
+             => let
+                in
+                  case target
+                    of Operand.MemLoc _
+                     => Error.bug "x86Validate.Instruction.validate: CALL, target:MemLoc"
+                     | Operand.FltRegister _
+                     => Error.bug "x86Validate.Instruction.validate: CALL, target:FltRegister"
+                     | _ => (Operand.validate {operand = target})
+                end
              | RET {src}
-	       (* Return from procedure; p. 648 
-		* Require src operand as follows:
-		*
-		*                src
-		*            reg imm lab add
-		*                 X   
-		*)
+               (* Return from procedure; p. 648 
+                * Require src operand as follows:
+                *
+                *                src
+                *            reg imm lab add
+                *                 X   
+                *)
              => let
-		in
-		  case src
-		    of SOME (Operand.MemLoc _)
-		     => Error.bug "validate: RET, src:MemLoc"
-		     | SOME (Operand.Register _)
-		     => Error.bug "validate: RET, src:Register"
-		     | SOME (Operand.FltRegister _)
-		     => Error.bug "validate: RET, src:FltRegister"
-		     | SOME (Operand.Label _)
-		     => Error.bug "validate: RET, src:Label"
-		     | SOME (Operand.Address _)
-		     => Error.bug "validate: RET, src:Address"
-		     | SOME operand => (Operand.validate {operand = operand})
-		     | NONE => true
-		end
-	     | MOV {dst,src,size} 
-	       (* Move; p. 442 
-		* Require src/dst operands as follows:
-		*
-		*              dst
-		*          reg imm lab add 
-		*      reg  X           X
-		*  src imm  X           X
-		*      lab
-		*      add  X
-		*
-		* Require size modifier class as follows: INT
-		*)
-	     => let
-		  val _ = if Size.class size = Size.INT
-			    then ()
-			    else Error.bug "validate: MOV, size"
-		  val _ = case Operand.size src
-			    of NONE => ()
-			     | SOME srcsize
-			     => if srcsize = size
-				  then ()
-				  else Error.bug "validate: MOV, srcsize"
- 		  val _ = case Operand.size dst
-			    of NONE => ()
-			     | SOME dstsize 
-			     => if dstsize = size
-				  then ()
-				  else Error.bug "validate: MOV, dstsize"
-		in
-		  case (src,dst)
-		    of (Operand.MemLoc _, _)
-		     => Error.bug "validate: MOV, src:MemLoc"
-		     | (_, Operand.MemLoc _)
-		     => Error.bug "validate: MOV, dst:MemLoc"
-		     | (Operand.FltRegister _, _)
-		     => Error.bug "validate: MOV, src:FltRegister"
-		     | (Operand.Label _, _)
-		     => Error.bug "validate: MOV, src:Label"
-		     | (_, Operand.FltRegister _)
-		     => Error.bug "validate: MOV, dst:FltRegister"
-		     | (_, Operand.Immediate _)
-		     => Error.bug "validate: MOV, dst:Immediate"
-		     | (_, Operand.Label _)
-                     => Error.bug "validate: MOV, dst:Label"
-		     | (Operand.Address _, Operand.Address _)
-		     => Error.bug "validate: MOV, src,dst:Address"
-		     | _ => (Operand.validate {operand = src}) andalso
+                in
+                  case src
+                    of SOME (Operand.MemLoc _)
+                     => Error.bug "x86Validate.Instruction.validate: RET, src:MemLoc"
+                     | SOME (Operand.Register _)
+                     => Error.bug "x86Validate.Instruction.validate: RET, src:Register"
+                     | SOME (Operand.FltRegister _)
+                     => Error.bug "x86Validate.Instruction.validate: RET, src:FltRegister"
+                     | SOME (Operand.Label _)
+                     => Error.bug "x86Validate.Instruction.validate: RET, src:Label"
+                     | SOME (Operand.Address _)
+                     => Error.bug "x86Validate.Instruction.validate: RET, src:Address"
+                     | SOME operand => (Operand.validate {operand = operand})
+                     | NONE => true
+                end
+             | MOV {dst,src,size} 
+               (* Move; p. 442 
+                * Require src/dst operands as follows:
+                *
+                *              dst
+                *          reg imm lab add 
+                *      reg  X           X
+                *  src imm  X           X
+                *      lab
+                *      add  X
+                *
+                * Require size modifier class as follows: INT
+                *)
+             => let
+                  val _ = if Size.class size = Size.INT
+                            then ()
+                            else Error.bug "x86Validate.Instruction.validate: MOV, size"
+                  val _ = case Operand.size src
+                            of NONE => ()
+                             | SOME srcsize
+                             => if srcsize = size
+                                  then ()
+                                  else Error.bug "x86Validate.Instruction.validate: MOV, srcsize"
+                  val _ = case Operand.size dst
+                            of NONE => ()
+                             | SOME dstsize 
+                             => if dstsize = size
+                                  then ()
+                                  else Error.bug "x86Validate.Instruction.validate: MOV, dstsize"
+                in
+                  case (src,dst)
+                    of (Operand.MemLoc _, _)
+                     => Error.bug "x86Validate.Instruction.validate: MOV, src:MemLoc"
+                     | (_, Operand.MemLoc _)
+                     => Error.bug "x86Validate.Instruction.validate: MOV, dst:MemLoc"
+                     | (Operand.FltRegister _, _)
+                     => Error.bug "x86Validate.Instruction.validate: MOV, src:FltRegister"
+                     | (Operand.Label _, _)
+                     => Error.bug "x86Validate.Instruction.validate: MOV, src:Label"
+                     | (_, Operand.FltRegister _)
+                     => Error.bug "x86Validate.Instruction.validate: MOV, dst:FltRegister"
+                     | (_, Operand.Immediate _)
+                     => Error.bug "x86Validate.Instruction.validate: MOV, dst:Immediate"
+                     | (_, Operand.Label _)
+                     => Error.bug "x86Validate.Instruction.validate: MOV, dst:Label"
+                     | (Operand.Address _, Operand.Address _)
+                     => Error.bug "x86Validate.Instruction.validate: MOV, src,dst:Address"
+                     | _ => (Operand.validate {operand = src}) andalso
                             (Operand.validate {operand = dst})
-		end
+                end
              | CMOVcc {src, dst, size, ...}
                (* Conditional move; p. 112
-		* Require src/dst operands as follows:
-		*
-		*              dst
-		*          reg imm lab add 
-		*      reg  X
-		*  src imm           
-		*      lab
-		*      add  X
-		*
-		* Require size modifier class as follows: INT(WORD, LONG)
-		*)
-	     => let
-		  val _ = case size
-			    of Size.WORD => ()
-			     | Size.LONG => ()
-			     | _ => Error.bug "validate: CMOVcc, size"
-		  val _ = case Operand.size src
-			    of NONE => ()
-			     | SOME srcsize 
-			     => if srcsize = size
-				  then ()
-				  else Error.bug "validate: CMOVcc, srcsize"
- 		  val _ = case Operand.size dst
-			    of NONE => ()
-			     | SOME dstsize 
-			     => if dstsize = size
-				  then ()
-				  else Error.bug "validate: CMOVcc, dstsize"
-		in
-		  case (src,dst)
-		    of (Operand.MemLoc _, _)
-		     => Error.bug "validate: CMOVcc, src:MemLoc"
-		     | (_, Operand.MemLoc _)
-		     => Error.bug "validate: CMOVcc, dst:MemLoc"
-		     | (Operand.FltRegister _, _)
-		     => Error.bug "validate: CMOVcc, src:FltRegister"
-		     | (Operand.Immediate _, _)
-		     => Error.bug "validate: CMOVcc, src:Immediate"
-		     | (Operand.Label _, _)
-		     => Error.bug "validate: CMOVcc, src:Label"	
-		     | (_, Operand.FltRegister _)
-		     => Error.bug "validate: CMOVcc, dst:FltRegister"
-		     | (_, Operand.Immediate _)
-		     => Error.bug "validate: CMOVcc, dst:Immediate"
-		     | (_, Operand.Label _)
-                     => Error.bug "validate: CMOVcc, dst:Label"
-		     | (_, Operand.Address _)
-		     => Error.bug "validate: CMOVcc, dst:Address"
-		     | _ => (Operand.validate {operand = src}) andalso
+                * Require src/dst operands as follows:
+                *
+                *              dst
+                *          reg imm lab add 
+                *      reg  X
+                *  src imm           
+                *      lab
+                *      add  X
+                *
+                * Require size modifier class as follows: INT(WORD, LONG)
+                *)
+             => let
+                  val _ = case size
+                            of Size.WORD => ()
+                             | Size.LONG => ()
+                             | _ => Error.bug "x86Validate.Instruction.validate: CMOVcc, size"
+                  val _ = case Operand.size src
+                            of NONE => ()
+                             | SOME srcsize 
+                             => if srcsize = size
+                                  then ()
+                                  else Error.bug "x86Validate.Instruction.validate: CMOVcc, srcsize"
+                  val _ = case Operand.size dst
+                            of NONE => ()
+                             | SOME dstsize 
+                             => if dstsize = size
+                                  then ()
+                                  else Error.bug "x86Validate.Instruction.validate: CMOVcc, dstsize"
+                in
+                  case (src,dst)
+                    of (Operand.MemLoc _, _)
+                     => Error.bug "x86Validate.Instruction.validate: CMOVcc, src:MemLoc"
+                     | (_, Operand.MemLoc _)
+                     => Error.bug "x86Validate.Instruction.validate: CMOVcc, dst:MemLoc"
+                     | (Operand.FltRegister _, _)
+                     => Error.bug "x86Validate.Instruction.validate: CMOVcc, src:FltRegister"
+                     | (Operand.Immediate _, _)
+                     => Error.bug "x86Validate.Instruction.validate: CMOVcc, src:Immediate"
+                     | (Operand.Label _, _)
+                     => Error.bug "x86Validate.Instruction.validate: CMOVcc, src:Label" 
+                     | (_, Operand.FltRegister _)
+                     => Error.bug "x86Validate.Instruction.validate: CMOVcc, dst:FltRegister"
+                     | (_, Operand.Immediate _)
+                     => Error.bug "x86Validate.Instruction.validate: CMOVcc, dst:Immediate"
+                     | (_, Operand.Label _)
+                     => Error.bug "x86Validate.Instruction.validate: CMOVcc, dst:Label"
+                     | (_, Operand.Address _)
+                     => Error.bug "x86Validate.Instruction.validate: CMOVcc, dst:Address"
+                     | _ => (Operand.validate {operand = src}) andalso
                             (Operand.validate {operand = dst})
-		end
+                end
              | XCHG {src, dst, size}
-       	       (* Exchange register/memory with register; p. 754
-		* Require src/dst operands as follows:
-		*
-		*              dst
-		*          reg imm lab add 
-		*      reg  X           X
-		*  src imm           
-		*      lab
-		*      add  X
-		*
-		* Require size modifier class as follows: INT
-		*)
-	     => let
-		  val _ = if Size.class size = Size.INT
-			    then ()
-			    else Error.bug "validate: XCHG, size"
-		  val _ = case Operand.size src
-			    of NONE => ()
-			     | SOME srcsize 
-			     => if srcsize = size
-				  then ()
-				  else Error.bug "validate: XCHG, srcsize"
- 		  val _ = case Operand.size dst
-			    of NONE => ()
-			     | SOME dstsize 
-			     => if dstsize = size
-				  then ()
-				  else Error.bug "validate: XCHG, dstsize"
-		in
-		  case (src,dst)
-		    of (Operand.MemLoc _, _)
-		     => Error.bug "validate: XCHG, src:MemLoc"
-		     | (_, Operand.MemLoc _)
-		     => Error.bug "validate: XCHG, dst:MemLoc"
-		     | (Operand.FltRegister _, _)
-		     => Error.bug "validate: XCHG, src:FltRegister"
-		     | (Operand.Immediate _, _)
-		     => Error.bug "validate: XCHG, src:Immediate"
-		     | (Operand.Label _, _)
-		     => Error.bug "validate: XCHG, src:Label"
-		     | (_, Operand.FltRegister _)
-		     => Error.bug "validate: XCHG, dst:FltRegister"
-		     | (_, Operand.Immediate _)
-		     => Error.bug "validate: XCHG, dst:Immediate"
-		     | (_, Operand.Label _)
-                     => Error.bug "validate: XCHG, dst:Label"
-		     | (Operand.Address _, Operand.Address _)
-		     => Error.bug "validate: XCHG, src,dst:Address"
-		     | _ => (Operand.validate {operand = src}) andalso
+               (* Exchange register/memory with register; p. 754
+                * Require src/dst operands as follows:
+                *
+                *              dst
+                *          reg imm lab add 
+                *      reg  X           X
+                *  src imm           
+                *      lab
+                *      add  X
+                *
+                * Require size modifier class as follows: INT
+                *)
+             => let
+                  val _ = if Size.class size = Size.INT
+                            then ()
+                            else Error.bug "x86Validate.Instruction.validate: XCHG, size"
+                  val _ = case Operand.size src
+                            of NONE => ()
+                             | SOME srcsize 
+                             => if srcsize = size
+                                  then ()
+                                  else Error.bug "x86Validate.Instruction.validate: XCHG, srcsize"
+                  val _ = case Operand.size dst
+                            of NONE => ()
+                             | SOME dstsize 
+                             => if dstsize = size
+                                  then ()
+                                  else Error.bug "x86Validate.Instruction.validate: XCHG, dstsize"
+                in
+                  case (src,dst)
+                    of (Operand.MemLoc _, _)
+                     => Error.bug "x86Validate.Instruction.validate: XCHG, src:MemLoc"
+                     | (_, Operand.MemLoc _)
+                     => Error.bug "x86Validate.Instruction.validate: XCHG, dst:MemLoc"
+                     | (Operand.FltRegister _, _)
+                     => Error.bug "x86Validate.Instruction.validate: XCHG, src:FltRegister"
+                     | (Operand.Immediate _, _)
+                     => Error.bug "x86Validate.Instruction.validate: XCHG, src:Immediate"
+                     | (Operand.Label _, _)
+                     => Error.bug "x86Validate.Instruction.validate: XCHG, src:Label"
+                     | (_, Operand.FltRegister _)
+                     => Error.bug "x86Validate.Instruction.validate: XCHG, dst:FltRegister"
+                     | (_, Operand.Immediate _)
+                     => Error.bug "x86Validate.Instruction.validate: XCHG, dst:Immediate"
+                     | (_, Operand.Label _)
+                     => Error.bug "x86Validate.Instruction.validate: XCHG, dst:Label"
+                     | (Operand.Address _, Operand.Address _)
+                     => Error.bug "x86Validate.Instruction.validate: XCHG, src,dst:Address"
+                     | _ => (Operand.validate {operand = src}) andalso
                             (Operand.validate {operand = dst})
-		end
+                end
              | PUSH {src, size}
-	       (* Push a value onto the stack; p. 621
-		* Require src operand as follows:
-		*
-		*               dst
-		*           reg imm lab add
-		*            *   X       X
-		*   * only word or long registers
-		*
-		* Require size modifier class as follows: INT(WORD, LONG)
-		*)
+               (* Push a value onto the stack; p. 621
+                * Require src operand as follows:
+                *
+                *               dst
+                *           reg imm lab add
+                *            *   X       X
+                *   * only word or long registers
+                *
+                * Require size modifier class as follows: INT(WORD, LONG)
+                *)
              => let
-		  val _ = case size
-			    of Size.WORD => ()
-			     | Size.LONG => ()
-			     | _ => Error.bug "validate: PUSH, size"
- 		  val _ = case Operand.size src
-			    of NONE => ()
-			     | SOME srcsize 
-			     => if srcsize = size
-				  then ()
-				  else Error.bug "validate: PUSH, srcsize"
-		in
-		  case src
-		    of Operand.MemLoc _
-		     => Error.bug "validate: PUSH, src:MemLoc"
-		     | Operand.FltRegister _
-		     => Error.bug "validate: PUSH, src:FltRegister"
-		     | Operand.Label _
-		     => Error.bug "validate: PUSH, src:Label"
-		     | _ => (Operand.validate {operand = src}) 
-		end
+                  val _ = case size
+                            of Size.WORD => ()
+                             | Size.LONG => ()
+                             | _ => Error.bug "x86Validate.Instruction.validate: PUSH, size"
+                  val _ = case Operand.size src
+                            of NONE => ()
+                             | SOME srcsize 
+                             => if srcsize = size
+                                  then ()
+                                  else Error.bug "x86Validate.Instruction.validate: PUSH, srcsize"
+                in
+                  case src
+                    of Operand.MemLoc _
+                     => Error.bug "x86Validate.Instruction.validate: PUSH, src:MemLoc"
+                     | Operand.FltRegister _
+                     => Error.bug "x86Validate.Instruction.validate: PUSH, src:FltRegister"
+                     | Operand.Label _
+                     => Error.bug "x86Validate.Instruction.validate: PUSH, src:Label"
+                     | _ => (Operand.validate {operand = src}) 
+                end
              | POP {dst, size}
-	       (* Pop a value from the stack; p. 571
-		* Require dst operand as follows:
-		*
-		*               dst
-		*           reg imm lab add
-		*            *           X
-		*   * only word or long registers
-		*
-		* Require size modifier as follows:
-		* 
-		*                size
-		*      VOID BYTE WORD LONG DBLE
-		*                 X    X
-		*)
+               (* Pop a value from the stack; p. 571
+                * Require dst operand as follows:
+                *
+                *               dst
+                *           reg imm lab add
+                *            *           X
+                *   * only word or long registers
+                *
+                * Require size modifier as follows:
+                * 
+                *                size
+                *      VOID BYTE WORD LONG DBLE
+                *                 X    X
+                *)
              => let
-		  val _ = case size
-			    of Size.WORD => ()
-			     | Size.LONG => ()
-			     | _ => Error.bug "validate: POP, size"
- 		  val _ = case Operand.size dst
-			    of NONE => ()
-			     | SOME dstsize 
-			     => if dstsize = size
-				  then ()
-				  else Error.bug "validate: POP, dstsize"
-		in
-		  case dst
-		    of Operand.MemLoc _
-		     => Error.bug "validate: POP, dst:MemLoc"
-		     | Operand.FltRegister _
-		     => Error.bug "validate: POP, src:FltRegister"
-		     | Operand.Immediate _
-		     => Error.bug "validate: POP, dst:Immediate"
-		     | Operand.Label _
-		     => Error.bug "validate: POP, dst:Label"
-		     | _ => (Operand.validate {operand = dst}) 
-		end
+                  val _ = case size
+                            of Size.WORD => ()
+                             | Size.LONG => ()
+                             | _ => Error.bug "x86Validate.Instruction.validate: POP, size"
+                  val _ = case Operand.size dst
+                            of NONE => ()
+                             | SOME dstsize 
+                             => if dstsize = size
+                                  then ()
+                                  else Error.bug "x86Validate.Instruction.validate: POP, dstsize"
+                in
+                  case dst
+                    of Operand.MemLoc _
+                     => Error.bug "x86Validate.Instruction.validate: POP, dst:MemLoc"
+                     | Operand.FltRegister _
+                     => Error.bug "x86Validate.Instruction.validate: POP, src:FltRegister"
+                     | Operand.Immediate _
+                     => Error.bug "x86Validate.Instruction.validate: POP, dst:Immediate"
+                     | Operand.Label _
+                     => Error.bug "x86Validate.Instruction.validate: POP, dst:Label"
+                     | _ => (Operand.validate {operand = dst}) 
+                end
              | CX {size}
-	       (* Convert X to 2X with sign extension; p. 104,181
-		* Require size modifier class as follows: INT
-		*)
-	     => let
-		  val _ = if Size.class size = Size.INT
-			    then ()
-			    else Error.bug "validate: CX, srcsize"
-		in
-		  true
-		end
-	     | MOVX {src, dst, srcsize, dstsize, ...}
-	       (* Move with extention.
-		* Require src/dst operands as follows:
-		*
-		*              dst
-		*          reg imm lab add 
-		*      reg  X
-		*  src imm
-		*      lab
-		*      add  X
-		*
-		* Require srcsize/dstsize modifier class as follows: INT < INT
-		*)
-	     => let
-		  val _ = if Size.class srcsize = Size.INT
-			    then ()
-			    else Error.bug "validate: MOVX, srcsize"
-		  val _ = if Size.class dstsize = Size.INT
-			    then ()
-			    else Error.bug "validate: MOVX, dstsize"
-		  val _ = case Operand.size src
-			    of NONE => ()
-			     | SOME srcsize' 
-			     => if srcsize' = srcsize
-				  then ()
-				  else Error.bug "validate: MOVX, srcsize"
- 		  val _ = case Operand.size dst
-			    of NONE => ()
-			     | SOME dstsize' 
-			     => if dstsize' = dstsize
-				  then ()
-				  else Error.bug "validate: MOVX, dstsize"
-		  val _ = if Size.lt(srcsize,dstsize)
-			    then ()
-			    else Error.bug 
-			         "validate: MOVX, srcsize >= dstsize"
-		in
-		  case (src,dst)
-		    of (Operand.MemLoc _, _)
-		     => Error.bug "validate: MOVX, src:MemLoc"
-		     | (_, Operand.MemLoc _)
-		     => Error.bug "validate: MOVX, dst:MemLoc"
-		     | (Operand.FltRegister _, _)
-		     => Error.bug "validate: MOVX, src:FltRegister"
-		     | (Operand.Immediate _, _)
-		     => Error.bug "validate: MOVX, src:Immediate"
-		     | (Operand.Label _, _)
-		     => Error.bug "validate: MOVX, src:Label"
-		     | (_, Operand.FltRegister _)
-		     => Error.bug "validate: MOVX, dst:FltRegister"
-		     | (_, Operand.Immediate _)
-		     => Error.bug "validate: MOVX, dst:Immediate"
-		     | (_, Operand.Label _)
-                     => Error.bug "validate: MOVX, dst:Label"
-		     | (_, Operand.Address _)
-		     => Error.bug "validate: MOVX, dst:Address"
-		     | _ => (Operand.validate {operand = src}) andalso
+               (* Convert X to 2X with sign extension; p. 104,181
+                * Require size modifier class as follows: INT
+                *)
+             => let
+                  val _ = if Size.class size = Size.INT
+                            then ()
+                            else Error.bug "x86Validate.Instruction.validate: CX, srcsize"
+                in
+                  true
+                end
+             | MOVX {src, dst, srcsize, dstsize, ...}
+               (* Move with extention.
+                * Require src/dst operands as follows:
+                *
+                *              dst
+                *          reg imm lab add 
+                *      reg  X
+                *  src imm
+                *      lab
+                *      add  X
+                *
+                * Require srcsize/dstsize modifier class as follows: INT < INT
+                *)
+             => let
+                  val _ = if Size.class srcsize = Size.INT
+                            then ()
+                            else Error.bug "x86Validate.Instruction.validate: MOVX, srcsize"
+                  val _ = if Size.class dstsize = Size.INT
+                            then ()
+                            else Error.bug "x86Validate.Instruction.validate: MOVX, dstsize"
+                  val _ = case Operand.size src
+                            of NONE => ()
+                             | SOME srcsize' 
+                             => if srcsize' = srcsize
+                                  then ()
+                                  else Error.bug "x86Validate.Instruction.validate: MOVX, srcsize"
+                  val _ = case Operand.size dst
+                            of NONE => ()
+                             | SOME dstsize' 
+                             => if dstsize' = dstsize
+                                  then ()
+                                  else Error.bug "x86Validate.Instruction.validate: MOVX, dstsize"
+                  val _ = if Size.lt(srcsize,dstsize)
+                            then ()
+                            else Error.bug 
+                                 "x86Validate.Instruction.validate: MOVX, srcsize >= dstsize"
+                in
+                  case (src,dst)
+                    of (Operand.MemLoc _, _)
+                     => Error.bug "x86Validate.Instruction.validate: MOVX, src:MemLoc"
+                     | (_, Operand.MemLoc _)
+                     => Error.bug "x86Validate.Instruction.validate: MOVX, dst:MemLoc"
+                     | (Operand.FltRegister _, _)
+                     => Error.bug "x86Validate.Instruction.validate: MOVX, src:FltRegister"
+                     | (Operand.Immediate _, _)
+                     => Error.bug "x86Validate.Instruction.validate: MOVX, src:Immediate"
+                     | (Operand.Label _, _)
+                     => Error.bug "x86Validate.Instruction.validate: MOVX, src:Label"
+                     | (_, Operand.FltRegister _)
+                     => Error.bug "x86Validate.Instruction.validate: MOVX, dst:FltRegister"
+                     | (_, Operand.Immediate _)
+                     => Error.bug "x86Validate.Instruction.validate: MOVX, dst:Immediate"
+                     | (_, Operand.Label _)
+                     => Error.bug "x86Validate.Instruction.validate: MOVX, dst:Label"
+                     | (_, Operand.Address _)
+                     => Error.bug "x86Validate.Instruction.validate: MOVX, dst:Address"
+                     | _ => (Operand.validate {operand = src}) andalso
                             (Operand.validate {operand = dst})
-		end
+                end
              | LEA {src, dst, size}
-	       (* Load effective address; p. 393
-		* Require src/dst operands as follows:
-		*
-		*              dst
-		*          reg imm lab add 
-		*      reg
-		*  src imm
-		*      lab
-		*      add  X
-		*
-		* Require size modifier class as follows: INT(WORD, LONG)
-		*)
-	     => let
-		  val _ = case size
-			    of Size.WORD => ()
-			     | Size.LONG => ()
-			     | _ => Error.bug "validate: LEA, size"
-		in
-		  case (src,dst)
-		    of (Operand.MemLoc _, _)
-		     => Error.bug "validate: LEA, src:MemLoc"
-		     | (_, Operand.MemLoc _)
-		     => Error.bug "validate: LEA, dst:MemLoc"
-		     | (Operand.Register _, _)
-		     => Error.bug "validate: LEA, src:Register"
-		     | (Operand.FltRegister _, _)
-		     => Error.bug "validate: LEA, src:FltRegister"
-		     | (Operand.Immediate _, _)
-		     => Error.bug "validate: LEA, src:Immediate"
-		     | (Operand.Label _, _)
-		     => Error.bug "validate: LEA, src:Label"
-		     | (_, Operand.FltRegister _)
-		     => Error.bug "validate: LEA, dst:FltRegister"
-		     | (_, Operand.Immediate _)
-		     => Error.bug "validate: LEA, dst:Immediate"
-		     | (_, Operand.Label _)
-                     => Error.bug "validate: LEA, dst:Label"
-		     | (_, Operand.Address _)
-		     => Error.bug "validate: LEA, dst:Address"
-		     | _ => (Operand.validate {operand = src}) andalso
+               (* Load effective address; p. 393
+                * Require src/dst operands as follows:
+                *
+                *              dst
+                *          reg imm lab add 
+                *      reg
+                *  src imm
+                *      lab
+                *      add  X
+                *
+                * Require size modifier class as follows: INT(WORD, LONG)
+                *)
+             => let
+                  val _ = case size
+                            of Size.WORD => ()
+                             | Size.LONG => ()
+                             | _ => Error.bug "x86Validate.Instruction.validate: LEA, size"
+                in
+                  case (src,dst)
+                    of (Operand.MemLoc _, _)
+                     => Error.bug "x86Validate.Instruction.validate: LEA, src:MemLoc"
+                     | (_, Operand.MemLoc _)
+                     => Error.bug "x86Validate.Instruction.validate: LEA, dst:MemLoc"
+                     | (Operand.Register _, _)
+                     => Error.bug "x86Validate.Instruction.validate: LEA, src:Register"
+                     | (Operand.FltRegister _, _)
+                     => Error.bug "x86Validate.Instruction.validate: LEA, src:FltRegister"
+                     | (Operand.Immediate _, _)
+                     => Error.bug "x86Validate.Instruction.validate: LEA, src:Immediate"
+                     | (Operand.Label _, _)
+                     => Error.bug "x86Validate.Instruction.validate: LEA, src:Label"
+                     | (_, Operand.FltRegister _)
+                     => Error.bug "x86Validate.Instruction.validate: LEA, dst:FltRegister"
+                     | (_, Operand.Immediate _)
+                     => Error.bug "x86Validate.Instruction.validate: LEA, dst:Immediate"
+                     | (_, Operand.Label _)
+                     => Error.bug "x86Validate.Instruction.validate: LEA, dst:Label"
+                     | (_, Operand.Address _)
+                     => Error.bug "x86Validate.Instruction.validate: LEA, dst:Address"
+                     | _ => (Operand.validate {operand = src}) andalso
                             (Operand.validate {operand = dst})
-		end
+                end
              | FLD {src, size}
-	       (* Floating-point load real; p. 248
-		* Require src operand as follows:
-		*
-		*              src
-		*          fltreg add 
-		*            X     X
-		*
-		* Require size modifier class as follows: FLT
-		*)		
-	     => let
-		  val _ = if Size.class size = Size.FLT
-			    then ()
-			    else Error.bug "validate: FLD, size"
-		in
-		  case src
-		    of Operand.MemLoc _
-		     => Error.bug "validate: FLD, src:MemLoc"
-		     | Operand.Register _
-		     => Error.bug "validate: FLD, src:Register"
-		     | Operand.Immediate _
-		     => Error.bug "validate: FLD, src:Immediate"
-		     | Operand.Label _
-		     => Error.bug "validate: FLD, src:Label"
-		     | _ => Operand.validate {operand = src}
-		end
+               (* Floating-point load real; p. 248
+                * Require src operand as follows:
+                *
+                *              src
+                *          fltreg add 
+                *            X     X
+                *
+                * Require size modifier class as follows: FLT
+                *)              
+             => let
+                  val _ = if Size.class size = Size.FLT
+                            then ()
+                            else Error.bug "x86Validate.Instruction.validate: FLD, size"
+                in
+                  case src
+                    of Operand.MemLoc _
+                     => Error.bug "x86Validate.Instruction.validate: FLD, src:MemLoc"
+                     | Operand.Register _
+                     => Error.bug "x86Validate.Instruction.validate: FLD, src:Register"
+                     | Operand.Immediate _
+                     => Error.bug "x86Validate.Instruction.validate: FLD, src:Immediate"
+                     | Operand.Label _
+                     => Error.bug "x86Validate.Instruction.validate: FLD, src:Label"
+                     | _ => Operand.validate {operand = src}
+                end
              | FST {dst, size, pop}
-	       (* Floating-point store real; p. 286
-		* Require src operand as follows:
-		*
-		*              src
-		*          fltreg add 
-		*            X     X
-		*
-		* Require size modifier class as follows: FLT*
-		*   * FLT(SNGL,DBLE)       if not pop
-		*   * FLT(SNGL,DBLE,EXTD)  if pop
-		*)
-	     => let
-		  val _ = if Size.class size = Size.FLT
-			    then (if not pop
-				    then case size
-					   of Size.SNGL => ()
-					    | Size.DBLE => ()
-					    | _
-					    => Error.bug "validate: FST, size"
-				    else ())
-			    else Error.bug "validate: FST, size"
-		in
-		  case dst
-		    of Operand.MemLoc _
-		     => Error.bug "validate: FST, dst:MemLoc"
-		     | Operand.Register _
-		     => Error.bug "validate: FST, dst:Register"
-		     | Operand.Immediate _
-		     => Error.bug "validate: FST, dst:Immediate"
-		     | Operand.Label _
-		     => Error.bug "validate: FST, dst:Label"
-		     | _ => Operand.validate {operand = dst}
-		end
+               (* Floating-point store real; p. 286
+                * Require src operand as follows:
+                *
+                *              src
+                *          fltreg add 
+                *            X     X
+                *
+                * Require size modifier class as follows: FLT*
+                *   * FLT(SNGL,DBLE)       if not pop
+                *   * FLT(SNGL,DBLE,EXTD)  if pop
+                *)
+             => let
+                  val _ = if Size.class size = Size.FLT
+                            then (if not pop
+                                    then case size
+                                           of Size.SNGL => ()
+                                            | Size.DBLE => ()
+                                            | _
+                                            => Error.bug "x86Validate.Instruction.validate: FST, size"
+                                    else ())
+                            else Error.bug "x86Validate.Instruction.validate: FST, size"
+                in
+                  case dst
+                    of Operand.MemLoc _
+                     => Error.bug "x86Validate.Instruction.validate: FST, dst:MemLoc"
+                     | Operand.Register _
+                     => Error.bug "x86Validate.Instruction.validate: FST, dst:Register"
+                     | Operand.Immediate _
+                     => Error.bug "x86Validate.Instruction.validate: FST, dst:Immediate"
+                     | Operand.Label _
+                     => Error.bug "x86Validate.Instruction.validate: FST, dst:Label"
+                     | _ => Operand.validate {operand = dst}
+                end
              | FILD {src, size}
-	       (* Floating-point load integer; p. 240
-		* Require src operand as follows:
-		*
-		*              src
-		*          fltreg add 
-		*                  X
-		*
-		* Require size modifier class as follows: FPI
-		*)		
-	     => let
-		  val _ = if Size.class size = Size.FPI
-			    then ()
-			    else Error.bug "validate: FILD, size"
-		in
-		  case src
-		    of Operand.MemLoc _
-		     => Error.bug "validate: FILD, src:MemLoc"
-		     | Operand.Register _
-		     => Error.bug "validate: FILD, src:Register"
-		     | Operand.FltRegister _
-		     => Error.bug "validate: FILD, src:FltRegister"
-		     | Operand.Immediate _
-		     => Error.bug "validate: FILD, src:Immediate"
-		     | Operand.Label _
-		     => Error.bug "validate: FILD, src:Label"
-		     | _ => Operand.validate {operand = src}
-		end
+               (* Floating-point load integer; p. 240
+                * Require src operand as follows:
+                *
+                *              src
+                *          fltreg add 
+                *                  X
+                *
+                * Require size modifier class as follows: FPI
+                *)              
+             => let
+                  val _ = if Size.class size = Size.FPI
+                            then ()
+                            else Error.bug "x86Validate.Instruction.validate: FILD, size"
+                in
+                  case src
+                    of Operand.MemLoc _
+                     => Error.bug "x86Validate.Instruction.validate: FILD, src:MemLoc"
+                     | Operand.Register _
+                     => Error.bug "x86Validate.Instruction.validate: FILD, src:Register"
+                     | Operand.FltRegister _
+                     => Error.bug "x86Validate.Instruction.validate: FILD, src:FltRegister"
+                     | Operand.Immediate _
+                     => Error.bug "x86Validate.Instruction.validate: FILD, src:Immediate"
+                     | Operand.Label _
+                     => Error.bug "x86Validate.Instruction.validate: FILD, src:Label"
+                     | _ => Operand.validate {operand = src}
+                end
              | FIST {dst, size, ...}
-	       (* Floating-point store integer; p. 245
-		* Require dst operand as follows:
-		*
-		*              dst
-		*          fltreg add 
-		*                  X
-		*
-		* Require size modifier class as follows: FPI
-		*)		
-	     => let
-		  val _ = if Size.class size = Size.FPI
-			    then ()
-			    else Error.bug "validate: FIST, size"
-		in
-		  case dst
-		    of Operand.MemLoc _
-		     => Error.bug "validate: FIST, src:MemLoc"
-		     | Operand.Register _
-		     => Error.bug "validate: FIST, src:Register"
-		     | Operand.FltRegister _
-		     => Error.bug "validate: FIST, src:FltRegister"
-		     | Operand.Immediate _
-		     => Error.bug "validate: FIST, src:Immediate"
-		     | Operand.Label _
-		     => Error.bug "validate: FIST, src:Label"
-		     | _ => Operand.validate {operand = dst}
-		end
+               (* Floating-point store integer; p. 245
+                * Require dst operand as follows:
+                *
+                *              dst
+                *          fltreg add 
+                *                  X
+                *
+                * Require size modifier class as follows: FPI
+                *)              
+             => let
+                  val _ = if Size.class size = Size.FPI
+                            then ()
+                            else Error.bug "x86Validate.Instruction.validate: FIST, size"
+                in
+                  case dst
+                    of Operand.MemLoc _
+                     => Error.bug "x86Validate.Instruction.validate: FIST, src:MemLoc"
+                     | Operand.Register _
+                     => Error.bug "x86Validate.Instruction.validate: FIST, src:Register"
+                     | Operand.FltRegister _
+                     => Error.bug "x86Validate.Instruction.validate: FIST, src:FltRegister"
+                     | Operand.Immediate _
+                     => Error.bug "x86Validate.Instruction.validate: FIST, src:Immediate"
+                     | Operand.Label _
+                     => Error.bug "x86Validate.Instruction.validate: FIST, src:Label"
+                     | _ => Operand.validate {operand = dst}
+                end
              | FXCH {src}
-	       (* Floating-point exchange; p. 313
-		* Require src operand as follows:
-		*
-		*              src
-		*          fltreg add 
-		*            X
-		*)
-	     => let
-		in
-		  case src
-		    of Operand.MemLoc _
-		     => Error.bug "validate: FXCH, dst:MemLoc"
-		     | Operand.Register _
-		     => Error.bug "validate: FXCH, dst:Register"
-		     | Operand.Immediate _
-		     => Error.bug "validate: FXCH, dst:Immediate"
-		     | Operand.Label _
-		     => Error.bug "validate: FXCH, dst:Label"
-		     | _ => Operand.validate {operand = src}
-		end
+               (* Floating-point exchange; p. 313
+                * Require src operand as follows:
+                *
+                *              src
+                *          fltreg add 
+                *            X
+                *)
+             => let
+                in
+                  case src
+                    of Operand.MemLoc _
+                     => Error.bug "x86Validate.Instruction.validate: FXCH, dst:MemLoc"
+                     | Operand.Register _
+                     => Error.bug "x86Validate.Instruction.validate: FXCH, dst:Register"
+                     | Operand.Immediate _
+                     => Error.bug "x86Validate.Instruction.validate: FXCH, dst:Immediate"
+                     | Operand.Label _
+                     => Error.bug "x86Validate.Instruction.validate: FXCH, dst:Label"
+                     | _ => Operand.validate {operand = src}
+                end
              | FLDC {...}
                (* Floating-point load constant; p. 250
-		*)
-	     => true
-	     | FLDCW {src}
-	       (* Floating-point load control word; p. 252
-		* Require src operand as follows:
-		*
-		*              dst
-		*          reg imm lab add 
-		*                       X
-		*)
-	     => let		   
-		in
-		  case src
-		    of Operand.MemLoc _
-		     => Error.bug "validate: FLDCW, src:MemLoc"
-		     | Operand.Register _ 
-		     => Error.bug "validate: FLDCW, src:Register"
-		     | Operand.FltRegister _ 
-		     => Error.bug "validate: FLDCW, src:Register"
-		     | Operand.Immediate _
-		     => Error.bug "validate: FLDCW, src:Immediate"
-		     | Operand.Label _
-		     => Error.bug "validate: FLDCW, src:Label"
-		     | _ => Operand.validate {operand = src}
-		end
-	     | FSTCW {dst, ...}
-	       (* Floating-point store control word; p. 289
-		* Require dst operand as follows:
-		*
-		*              dst
-		*          reg imm lab add 
-		*                       X
-		*)
-	     => let		   
-		in
-		  case dst
-		    of Operand.MemLoc _
-		     => Error.bug "validate: FSTCW, dst:MemLoc"
-		     | Operand.Register _ 
-		     => Error.bug "validate: FSTCW, dst:Register"
-		     | Operand.FltRegister _ 
-		     => Error.bug "validate: FSTCW, dst:FltRegister"
-		     | Operand.Immediate _
-		     => Error.bug "validate: FSTCW, dst:Immediate"
-		     | Operand.Label _
-		     => Error.bug "validate: FSTCW, dst:Label"
-		     | _ => Operand.validate {operand = dst}
-		end
-	     | FSTSW {dst, ...}
-	       (* Floating-point store status word; p. 294
-		* Require dst operand as follows:
-		*
-		*              dst
-		*          reg imm lab add 
-		*           *           X
-		*   * only register %ax
-		*)
-	     => let		   
-		in
-		  case dst
-		    of Operand.MemLoc _
-		     => Error.bug "validate: FSTSW, dst:MemLoc"
-		     | Operand.Register (Register.T {reg = Register.EAX,
-						     part = Register.X})
-		     => Operand.validate {operand = dst}
-		     | Operand.Register _ 
-		     => Error.bug "validate: FSTSW, dst:Register"
-		     | Operand.FltRegister _ 
-		     => Error.bug "validate: FSTSW, dst:FltRegister"
-		     | Operand.Immediate _
-		     => Error.bug "validate: FSTSW, dst:Immediate"
-		     | Operand.Label _
-		     => Error.bug "validate: FSTSW, dst:Label"
-		     | _ => Operand.validate {operand = dst}
-		end
-	     | FCOM {src, size, pop, pop'}
-	       (* Floating-point compare real; p. 220
-	        * Require src operand as follows:
-		*
-		*               src
-		*           fltreg add 
-		*             *     X
-		*   * only st(1) if pop and pop'
-	        *
-		* Require size modifier class as follows: FLT(SNGL,DBLE)
-		*)
-	     => let
-		  val _ = if Size.class size = Size.FLT
-			    then case src
-				   of Operand.Address _ 
-				    => (case size
-					  of Size.SNGL => ()
-					   | Size.DBLE => ()
-					   | _
-					   => Error.bug 
-					      "validate: FCOM, size")
-				    | _ => ()
-			    else Error.bug "validate: FCOM, size"
-		in
-		  case src
-		    of Operand.MemLoc _
-		     => Error.bug "validate: FCOM, src:MemLoc"
-		     | Operand.Register _
-		     => Error.bug "validate: FCOM, src:Register"
-		     | Operand.Immediate _
-		     => Error.bug "validate: FCOM, src:Immediate"
-		     | Operand.Label _
-		     => Error.bug "validate: FCOM, src:Label"
-		     | _ 
-		     => if pop andalso pop'
-			   andalso
-			   not 
-			   (Operand.eq(src,
-				       Operand.fltregister FltRegister.one))
-			  then Error.bug "validate: FCOM, pop, pop'"
-			  else Operand.validate {operand = src}
-		end
-	     | FUCOM {src, pop, pop'}
-	       (* Floating-point compare real; p. 307
-	        * Require src operand as follows:
-		*
-		*               src
-		*           fltreg add 
-		*             *
-		*   * only st(1) if pop and pop'
-		*)
-	     => let
-		in
-		  case src
-		    of Operand.MemLoc _
-		     => Error.bug "validate: FUCOM, src:MemLoc"
-		     | Operand.Register _
-		     => Error.bug "validate: FUCOM, src:Register"
-		     | Operand.Immediate _
-		     => Error.bug "validate: FUCOM, src:Immediate"
-		     | Operand.Label _
-		     => Error.bug "validate: FUCOM, src:Label"
-		     | Operand.Address _
-		     => Error.bug "validate: FUCOM, src:Address"
-		     | _ 
-		     => if pop andalso pop'
-			   andalso
-			   not 
-			   (Operand.eq(src,
-				       Operand.fltregister FltRegister.one))
-			  then Error.bug "validate: FUCOM, pop, pop'"
-			  else Operand.validate {operand = src}
-		end
-	     | FBinA {src, dst, size, pop, ...}
-	       (* Floating-point unary arithmetic instructions; p. 248
-		* Require src operand as follows:
-		*
-		*               src
-		*           fltreg add 
-		*             *     X
-		*   * only st(0) if pop
-		*
-		* Require dst operand as follows:
-		*
-		*               src
-		*           fltreg add 
-		*            *
-		*   * only st(0) if src add
-		*
-		* Require size modifier class as follows: FLT*
-		*   * FLT(SNGL,DBLE)       if src add
-		*   * FLT(SNGL,DBLE,EXTD)
-		*)		
-	     => let
-		  val _ = if Size.class size = Size.FLT
-			    then case src
-				   of Operand.Address _ 
-				    => (case size
-					  of Size.SNGL => ()
-					   | Size.DBLE => ()
-					   | _
-					   => Error.bug 
-					      "validate: FBinA, size")
-				    | _ => ()
-			    else Error.bug "validate: FBinA, size"
-		in
-		  case (src,dst)
-		    of (Operand.MemLoc _, _)
-		     => Error.bug "validate: FBinA, src:MemLoc"
-		     | (_, Operand.MemLoc _)
-		     => Error.bug "validate: FBinA, dst:MemLoc"
-		     | (Operand.Register _, _)
-		     => Error.bug "validate: FBinA, src:Register"
-		     | (Operand.Immediate _, _)
-		     => Error.bug "validate: FBinA, src:Immediate"
-		     | (Operand.Label _, _)
-		     => Error.bug "validate: FBinA, src:Label"
-		     | (_, Operand.Register _)
-		     => Error.bug "validate: FBinA, dst:Register"
-		     | (_, Operand.Immediate _)
-		     => Error.bug "validate: FBinA, dst:Immediate"
-		     | (_, Operand.Label _)
-                     => Error.bug "validate: FBinA, dst:Label"
-		     | (_, Operand.Address _)
-		     => Error.bug "validate: FBinA, dst:Address"
-		     | (Operand.Address _, _)
-		     => if Operand.eq(dst, 
-				      Operand.fltregister FltRegister.top)
-			  then (Operand.validate {operand = src}) andalso
+                *)
+             => true
+             | FLDCW {src}
+               (* Floating-point load control word; p. 252
+                * Require src operand as follows:
+                *
+                *              dst
+                *          reg imm lab add 
+                *                       X
+                *)
+             => let                
+                in
+                  case src
+                    of Operand.MemLoc _
+                     => Error.bug "x86Validate.Instruction.validate: FLDCW, src:MemLoc"
+                     | Operand.Register _ 
+                     => Error.bug "x86Validate.Instruction.validate: FLDCW, src:Register"
+                     | Operand.FltRegister _ 
+                     => Error.bug "x86Validate.Instruction.validate: FLDCW, src:Register"
+                     | Operand.Immediate _
+                     => Error.bug "x86Validate.Instruction.validate: FLDCW, src:Immediate"
+                     | Operand.Label _
+                     => Error.bug "x86Validate.Instruction.validate: FLDCW, src:Label"
+                     | _ => Operand.validate {operand = src}
+                end
+             | FSTCW {dst, ...}
+               (* Floating-point store control word; p. 289
+                * Require dst operand as follows:
+                *
+                *              dst
+                *          reg imm lab add 
+                *                       X
+                *)
+             => let                
+                in
+                  case dst
+                    of Operand.MemLoc _
+                     => Error.bug "x86Validate.Instruction.validate: FSTCW, dst:MemLoc"
+                     | Operand.Register _ 
+                     => Error.bug "x86Validate.Instruction.validate: FSTCW, dst:Register"
+                     | Operand.FltRegister _ 
+                     => Error.bug "x86Validate.Instruction.validate: FSTCW, dst:FltRegister"
+                     | Operand.Immediate _
+                     => Error.bug "x86Validate.Instruction.validate: FSTCW, dst:Immediate"
+                     | Operand.Label _
+                     => Error.bug "x86Validate.Instruction.validate: FSTCW, dst:Label"
+                     | _ => Operand.validate {operand = dst}
+                end
+             | FSTSW {dst, ...}
+               (* Floating-point store status word; p. 294
+                * Require dst operand as follows:
+                *
+                *              dst
+                *          reg imm lab add 
+                *           *           X
+                *   * only register %ax
+                *)
+             => let                
+                in
+                  case dst
+                    of Operand.MemLoc _
+                     => Error.bug "x86Validate.Instruction.validate: FSTSW, dst:MemLoc"
+                     | Operand.Register (Register.T {reg = Register.EAX,
+                                                     part = Register.X})
+                     => Operand.validate {operand = dst}
+                     | Operand.Register _ 
+                     => Error.bug "x86Validate.Instruction.validate: FSTSW, dst:Register"
+                     | Operand.FltRegister _ 
+                     => Error.bug "x86Validate.Instruction.validate: FSTSW, dst:FltRegister"
+                     | Operand.Immediate _
+                     => Error.bug "x86Validate.Instruction.validate: FSTSW, dst:Immediate"
+                     | Operand.Label _
+                     => Error.bug "x86Validate.Instruction.validate: FSTSW, dst:Label"
+                     | _ => Operand.validate {operand = dst}
+                end
+             | FCOM {src, size, pop, pop'}
+               (* Floating-point compare real; p. 220
+                * Require src operand as follows:
+                *
+                *               src
+                *           fltreg add 
+                *             *     X
+                *   * only st(1) if pop and pop'
+                *
+                * Require size modifier class as follows: FLT(SNGL,DBLE)
+                *)
+             => let
+                  val _ = if Size.class size = Size.FLT
+                            then case src
+                                   of Operand.Address _ 
+                                    => (case size
+                                          of Size.SNGL => ()
+                                           | Size.DBLE => ()
+                                           | _
+                                           => Error.bug 
+                                              "x86Validate.Instruction.validate: FCOM, size")
+                                    | _ => ()
+                            else Error.bug "x86Validate.Instruction.validate: FCOM, size"
+                in
+                  case src
+                    of Operand.MemLoc _
+                     => Error.bug "x86Validate.Instruction.validate: FCOM, src:MemLoc"
+                     | Operand.Register _
+                     => Error.bug "x86Validate.Instruction.validate: FCOM, src:Register"
+                     | Operand.Immediate _
+                     => Error.bug "x86Validate.Instruction.validate: FCOM, src:Immediate"
+                     | Operand.Label _
+                     => Error.bug "x86Validate.Instruction.validate: FCOM, src:Label"
+                     | _ 
+                     => if pop andalso pop'
+                           andalso
+                           not 
+                           (Operand.eq(src,
+                                       Operand.fltregister FltRegister.one))
+                          then Error.bug "x86Validate.Instruction.validate: FCOM, pop, pop'"
+                          else Operand.validate {operand = src}
+                end
+             | FUCOM {src, pop, pop'}
+               (* Floating-point compare real; p. 307
+                * Require src operand as follows:
+                *
+                *               src
+                *           fltreg add 
+                *             *
+                *   * only st(1) if pop and pop'
+                *)
+             => let
+                in
+                  case src
+                    of Operand.MemLoc _
+                     => Error.bug "x86Validate.Instruction.validate: FUCOM, src:MemLoc"
+                     | Operand.Register _
+                     => Error.bug "x86Validate.Instruction.validate: FUCOM, src:Register"
+                     | Operand.Immediate _
+                     => Error.bug "x86Validate.Instruction.validate: FUCOM, src:Immediate"
+                     | Operand.Label _
+                     => Error.bug "x86Validate.Instruction.validate: FUCOM, src:Label"
+                     | Operand.Address _
+                     => Error.bug "x86Validate.Instruction.validate: FUCOM, src:Address"
+                     | _ 
+                     => if pop andalso pop'
+                           andalso
+                           not 
+                           (Operand.eq(src,
+                                       Operand.fltregister FltRegister.one))
+                          then Error.bug "x86Validate.Instruction.validate: FUCOM, pop, pop'"
+                          else Operand.validate {operand = src}
+                end
+             | FBinA {src, dst, size, pop, ...}
+               (* Floating-point unary arithmetic instructions; p. 248
+                * Require src operand as follows:
+                *
+                *               src
+                *           fltreg add 
+                *             *     X
+                *   * only st(0) if pop
+                *
+                * Require dst operand as follows:
+                *
+                *               src
+                *           fltreg add 
+                *            *
+                *   * only st(0) if src add
+                *
+                * Require size modifier class as follows: FLT*
+                *   * FLT(SNGL,DBLE)       if src add
+                *   * FLT(SNGL,DBLE,EXTD)
+                *)              
+             => let
+                  val _ = if Size.class size = Size.FLT
+                            then case src
+                                   of Operand.Address _ 
+                                    => (case size
+                                          of Size.SNGL => ()
+                                           | Size.DBLE => ()
+                                           | _
+                                           => Error.bug 
+                                              "x86Validate.Instruction.validate: FBinA, size")
+                                    | _ => ()
+                            else Error.bug "x86Validate.Instruction.validate: FBinA, size"
+                in
+                  case (src,dst)
+                    of (Operand.MemLoc _, _)
+                     => Error.bug "x86Validate.Instruction.validate: FBinA, src:MemLoc"
+                     | (_, Operand.MemLoc _)
+                     => Error.bug "x86Validate.Instruction.validate: FBinA, dst:MemLoc"
+                     | (Operand.Register _, _)
+                     => Error.bug "x86Validate.Instruction.validate: FBinA, src:Register"
+                     | (Operand.Immediate _, _)
+                     => Error.bug "x86Validate.Instruction.validate: FBinA, src:Immediate"
+                     | (Operand.Label _, _)
+                     => Error.bug "x86Validate.Instruction.validate: FBinA, src:Label"
+                     | (_, Operand.Register _)
+                     => Error.bug "x86Validate.Instruction.validate: FBinA, dst:Register"
+                     | (_, Operand.Immediate _)
+                     => Error.bug "x86Validate.Instruction.validate: FBinA, dst:Immediate"
+                     | (_, Operand.Label _)
+                     => Error.bug "x86Validate.Instruction.validate: FBinA, dst:Label"
+                     | (_, Operand.Address _)
+                     => Error.bug "x86Validate.Instruction.validate: FBinA, dst:Address"
+                     | (Operand.Address _, _)
+                     => if Operand.eq(dst, 
+                                      Operand.fltregister FltRegister.top)
+                          then (Operand.validate {operand = src}) andalso
                                (Operand.validate {operand = dst})
-			  else Error.bug "validate: FBinA, src:Address"
-		     | _
-		     => if pop 
-			   andalso
-			   not 
-			   (Operand.eq(src,
-				       Operand.fltregister FltRegister.top))
-			  then Error.bug "validate: FBinA, pop"
-			  else (Operand.validate {operand = src}) andalso
-			       (Operand.validate {operand = dst})
-		end
-	     | FUnA {...}
-	       (* Floating-point unary arithmetic instructions.
-		*)
-	     => true
-	     | FPTAN
-	       (* Floating-point partial tangent instruction.
-		*)
-	     => true
-	     | FBinAS {...}
-	       (* Floating-point binary arithmetic stack instructions.
-		*)
-	     => true
-	     | FBinASP {...}
-	       (* Floating-point binary arithmetic stack pop instructions.
-		*)
-	     => true
-             | _ => Error.bug (concat ["validate: instruction :: ",
-				       toString instruction])
+                          else Error.bug "x86Validate.Instruction.validate: FBinA, src:Address"
+                     | _
+                     => if pop 
+                           andalso
+                           not 
+                           (Operand.eq(src,
+                                       Operand.fltregister FltRegister.top))
+                          then Error.bug "x86Validate.Instruction.validate: FBinA, pop"
+                          else (Operand.validate {operand = src}) andalso
+                               (Operand.validate {operand = dst})
+                end
+             | FUnA {...}
+               (* Floating-point unary arithmetic instructions.
+                *)
+             => true
+             | FPTAN
+               (* Floating-point partial tangent instruction.
+                *)
+             => true
+             | FBinAS {...}
+               (* Floating-point binary arithmetic stack instructions.
+                *)
+             => true
+             | FBinASP {...}
+               (* Floating-point binary arithmetic stack pop instructions.
+                *)
+             => true
+             | _ => Error.bug (concat ["x86Validate.Instruction.validate: instruction :: ",
+                                       toString instruction])
     end
 
   structure Assembly =
@@ -1253,37 +1254,37 @@
       open x86.Assembly
 
       fun validate {assembly: t list} : bool
- 	= List.fold(assembly,
-		    true,
-		    fn (Comment _, b)
-		     => b
-		     | (Directive _, _)
-		     => Error.bug "validate: Directive"
-		     | (PseudoOp _, b)
-		     => b
-		     | (Label _, b)
-		     => b
-		     | (Instruction i, b)
-		     => (Instruction.validate {instruction = i}) andalso b
-		        handle Fail msg
-			 => (print (toString (Instruction i));
-			     print "\n";
-			     Error.bug msg))
+        = List.fold(assembly,
+                    true,
+                    fn (Comment _, b)
+                     => b
+                     | (Directive _, _)
+                     => Error.bug "x86Validate.Assembly.validate: Directive"
+                     | (PseudoOp _, b)
+                     => b
+                     | (Label _, b)
+                     => b
+                     | (Instruction i, b)
+                     => (Instruction.validate {instruction = i}) andalso b
+                        handle Fail msg
+                         => (print (toString (Instruction i));
+                             print "\n";
+                             Error.bug msg))
     end
 
   fun validate {assembly: Assembly.t list list} : bool
     = (if List.forall(assembly,
-		      fn assembly
-		       => Assembly.validate {assembly = assembly}
-		          handle Fail msg
-			   => (List.foreach
-			       (assembly,
-				fn assembly
-				 => (print (Assembly.toString assembly);
-				     print "\n"));
-			       Error.bug msg))
-	 then true
-	 else Error.bug "x86Validate.validate")       
+                      fn assembly
+                       => Assembly.validate {assembly = assembly}
+                          handle Fail _
+                           => (List.foreach
+                               (assembly,
+                                fn assembly
+                                 => (print (Assembly.toString assembly);
+                                     print "\n"));
+                               false))
+         then true
+         else Error.bug "x86Validate.validate")       
 
   val (validate, validate_msg)
     = tracerTop

Modified: mlton/branches/on-20050420-cmm-branch/mlton/codegen/x86-codegen/x86-validate.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/codegen/x86-codegen/x86-validate.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/codegen/x86-codegen/x86-validate.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature X86_VALIDATE_STRUCTS =
   sig
     structure x86 : X86

Modified: mlton/branches/on-20050420-cmm-branch/mlton/codegen/x86-codegen/x86.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/codegen/x86-codegen/x86.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/codegen/x86-codegen/x86.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 functor x86 (S: X86_STRUCTS): X86 =
 struct
 
@@ -24,140 +25,140 @@
    *) 
   val Char_escapeASM = fn #"\000" => "\\000"
                         | #"\^G" => "\\007"
-			| #"\^K" => "\\013"
-			| #"?" => "?"
-			| #"'" => "'"
-			| c => Char.escapeC c
+                        | #"\^K" => "\\013"
+                        | #"?" => "?"
+                        | #"'" => "'"
+                        | c => Char.escapeC c
   fun String_escapeASM s = String.translate(s, Char_escapeASM)
 
   val rec lexical
     = fn [] => EQUAL
        | thunk::tl => let
-			val ord = thunk ()
-		      in 
-			if Relation.equals(ord, EQUAL)
-			  then lexical tl
-			  else ord
-		      end
+                        val ord = thunk ()
+                      in 
+                        if Relation.equals(ord, EQUAL)
+                          then lexical tl
+                          else ord
+                      end
 
 
   open S
 
   structure Label =
      struct
-	open Label
+        open Label
 
-	fun toString l =
-	   if !Control.labelsHaveExtra_
-	      then concat ["_", Label.toString l]
-	   else Label.toString l
+        fun toString l =
+           if !Control.labelsHaveExtra_
+              then concat ["_", Label.toString l]
+           else Label.toString l
 
-	val layout = Layout.str o toString
+        val layout = Layout.str o toString
      end
 
   structure Size =
     struct
       datatype class = INT | FLT | FPI
       val class_layout
-	= let
-	    open Layout
-	  in
-	    fn INT => str "INT"
-	     | FLT => str "FLT"
-	     | FPI => str "FPI"
-	  end
+        = let
+            open Layout
+          in
+            fn INT => str "INT"
+             | FLT => str "FLT"
+             | FPI => str "FPI"
+          end
       val class_toString = Layout.toString o class_layout 
 
       datatype t 
-	= BYTE | WORD | LONG
-	| SNGL | DBLE | EXTD
-	| FPIS | FPIL | FPIQ
+        = BYTE | WORD | LONG
+        | SNGL | DBLE | EXTD
+        | FPIS | FPIL | FPIQ
 
       val layout
-	= let
-	    open Layout
-	  in
-	    fn BYTE => str "b"
-	     | WORD => str "w"
-	     | LONG => str "l"
-	     | SNGL => str "S"
-	     | DBLE => str "L"
-	     | EXTD => str "T"
-	     | FPIS => str "s"
-	     | FPIL => str "l"
-	     | FPIQ => str "q"
-	  end
+        = let
+            open Layout
+          in
+            fn BYTE => str "b"
+             | WORD => str "w"
+             | LONG => str "l"
+             | SNGL => str "S"
+             | DBLE => str "L"
+             | EXTD => str "T"
+             | FPIS => str "s"
+             | FPIL => str "l"
+             | FPIQ => str "q"
+          end
       val toString = Layout.toString o layout
 
       val layout'
-	= let
-	    open Layout
-	  in 
-	    fn BYTE => str "byte"
-	     | WORD => str "word"
-	     | LONG => str "long"
-	     | SNGL => str "sngl"
-	     | DBLE => str "dble"
-	     | EXTD => str "extd"
-	     | FPIS => str "fpis"
-	     | FPIL => str "fpil"
-	     | FPIQ => str "fpiq"
-	  end
+        = let
+            open Layout
+          in 
+            fn BYTE => str "byte"
+             | WORD => str "word"
+             | LONG => str "long"
+             | SNGL => str "sngl"
+             | DBLE => str "dble"
+             | EXTD => str "extd"
+             | FPIS => str "fpis"
+             | FPIL => str "fpil"
+             | FPIQ => str "fpiq"
+          end
       val toString' = Layout.toString o layout'
-	    
+            
       val fromBytes : int -> t
-	= fn 1 => BYTE
-	   | 2 => WORD
-	   | 4 => LONG
-	   | _ => Error.bug "Size.fromBytes"
+        = fn 1 => BYTE
+           | 2 => WORD
+           | 4 => LONG
+           | _ => Error.bug "x86.Size.fromBytes"
       val toBytes : t -> int
-	= fn BYTE => 1
-	   | WORD => 2
-	   | LONG => 4
-	   | SNGL => 4
-	   | DBLE => 8
-	   | EXTD => 10
-	   | FPIS => 2
-	   | FPIL => 4
-	   | FPIQ => 8
+        = fn BYTE => 1
+           | WORD => 2
+           | LONG => 4
+           | SNGL => 4
+           | DBLE => 8
+           | EXTD => 10
+           | FPIS => 2
+           | FPIL => 4
+           | FPIQ => 8
 
       local
-	 datatype z = datatype CType.t
+         datatype z = datatype CType.t
       in
-	 fun fromCType t =
-	    case t of
-	       Int8 => Vector.new1 BYTE
-	     | Int16 => Vector.new1 WORD
-	     | Int32 => Vector.new1 LONG
-	     | Int64 => Vector.new2 (LONG, LONG)
-	     | Pointer => Vector.new1 LONG
-	     | Real32 => Vector.new1 SNGL
-	     | Real64 => Vector.new1 DBLE
-	     | Word8 => Vector.new1 BYTE
-	     | Word16 => Vector.new1 WORD
-	     | Word32 => Vector.new1 LONG
-	     | Word64 => Vector.new2 (LONG, LONG)
+         fun fromCType t =
+            case t of
+               Int8 => Vector.new1 BYTE
+             | Int16 => Vector.new1 WORD
+             | Int32 => Vector.new1 LONG
+             | Int64 => Vector.new2 (LONG, LONG)
+             | Pointer => Vector.new1 LONG
+             | Real32 => Vector.new1 SNGL
+             | Real64 => Vector.new1 DBLE
+             | Word8 => Vector.new1 BYTE
+             | Word16 => Vector.new1 WORD
+             | Word32 => Vector.new1 LONG
+             | Word64 => Vector.new2 (LONG, LONG)
       end
 
       val class
-	= fn BYTE => INT
-	   | WORD => INT
-	   | LONG => INT
-	   | SNGL => FLT
-	   | DBLE => FLT
-	   | EXTD => FLT
-	   | FPIS => FPI
-	   | FPIL => FPI
-	   | FPIQ => FPI
+        = fn BYTE => INT
+           | WORD => INT
+           | LONG => INT
+           | SNGL => FLT
+           | DBLE => FLT
+           | EXTD => FLT
+           | FPIS => FPI
+           | FPIL => FPI
+           | FPIQ => FPI
 
       val toFPI
-	= fn WORD => FPIS
-	   | LONG => FPIL
-	   | FPIS => FPIS
-	   | FPIL => FPIL
-	   | FPIQ => FPIQ
-	   | _ => Error.bug "Size.toFPI"
-	
+        = fn WORD => FPIS
+           | LONG => FPIL
+           | FPIS => FPIS
+           | FPIL => FPIL
+           | FPIQ => FPIQ
+           | _ => Error.bug "x86.Size.toFPI"
+        
       val eq = fn (s1, s2) => s1 = s2
       val lt = fn (s1, s2) => (toBytes s1) < (toBytes s2)
     end
@@ -166,53 +167,45 @@
     struct
 
       datatype reg
-	= EAX | EBX | ECX | EDX | EDI | ESI | EBP | ESP
+        = EAX | EBX | ECX | EDX | EDI | ESI | EBP | ESP
       val allReg = [EAX, EBX, ECX, EDX, EDI, ESI, EBP, ESP]
 
       datatype part
-	= E | X | L | H
+        = E | X | L | H
 
       datatype t = T of {reg: reg, part: part}
 
       fun size (T {part, ...})
-	= case part
-	    of E => Size.LONG
-	     | X => Size.WORD
-	     | L => Size.BYTE
-	     | H => Size.BYTE
+        = case part
+            of E => Size.LONG
+             | X => Size.WORD
+             | L => Size.BYTE
+             | H => Size.BYTE
 
       fun layout (T {reg, part})
-	= let
-	    open Layout
-	    val {prefix, suffix}
-	      = case part
-		  of E => {prefix = str "%e", suffix = str "x"}
-		   | X => {prefix = str "%", suffix = str "x"}
-		   | L => {prefix = str "%", suffix = str "l"}
-		   | H => {prefix = str "%", suffix = str "h"}
-	  in
-	    case reg
-	      of EAX => seq [prefix, str "a", suffix]
-	       | EBX => seq [prefix, str "b", suffix]
-	       | ECX => seq [prefix, str "c", suffix]
-	       | EDX => seq [prefix, str "d", suffix]
-	       | EDI => seq [prefix, str "di"]
-	       | ESI => seq [prefix, str "si"]
-	       | EBP => seq [prefix, str "bp"]
-	       | ESP => seq [prefix, str "sp"]
-	  end
+        = let
+            open Layout
+            val {prefix, suffix}
+              = case part
+                  of E => {prefix = str "%e", suffix = str "x"}
+                   | X => {prefix = str "%", suffix = str "x"}
+                   | L => {prefix = str "%", suffix = str "l"}
+                   | H => {prefix = str "%", suffix = str "h"}
+          in
+            case reg
+              of EAX => seq [prefix, str "a", suffix]
+               | EBX => seq [prefix, str "b", suffix]
+               | ECX => seq [prefix, str "c", suffix]
+               | EDX => seq [prefix, str "d", suffix]
+               | EDI => seq [prefix, str "di"]
+               | ESI => seq [prefix, str "si"]
+               | EBP => seq [prefix, str "bp"]
+               | ESP => seq [prefix, str "sp"]
+          end
       val toString = Layout.toString o layout
 
       fun eq(T r1, T r2) = r1 = r2
 
-(*
-      fun return size
-	= T {reg = EAX, part = case size
-				 of Size.BYTE => L
-				  | Size.WORD => X
-				  | Size.LONG => E
-				  | _ => Error.bug "Register.return"}
-*)
       val eax = T {reg = EAX, part = E}
       val ebx = T {reg = EBX, part = E}
       val ecx = T {reg = ECX, part = E}
@@ -228,33 +221,33 @@
       val ebp = T {reg = EBP, part = E}
 
       val byteRegisters = [T {reg = EAX, part = L},
-			   T {reg = EAX, part = H},
-			   T {reg = EBX, part = L},
-			   T {reg = EBX, part = H},
-			   T {reg = ECX, part = L},
-			   T {reg = ECX, part = H},
-			   T {reg = EDX, part = L},
-			   T {reg = EDX, part = H}]
+                           T {reg = EAX, part = H},
+                           T {reg = EBX, part = L},
+                           T {reg = EBX, part = H},
+                           T {reg = ECX, part = L},
+                           T {reg = ECX, part = H},
+                           T {reg = EDX, part = L},
+                           T {reg = EDX, part = H}]
       val byteRegisters = List.rev byteRegisters
 
       val wordRegisters = [T {reg = EAX, part = X},
-			   T {reg = EBX, part = X},
-			   T {reg = ECX, part = X},
-			   T {reg = EDX, part = X},
-			   T {reg = EDI, part = X},
-			   T {reg = ESI, part = X},
-			   T {reg = EBP, part = X},
-			   T {reg = ESP, part = X}]
+                           T {reg = EBX, part = X},
+                           T {reg = ECX, part = X},
+                           T {reg = EDX, part = X},
+                           T {reg = EDI, part = X},
+                           T {reg = ESI, part = X},
+                           T {reg = EBP, part = X},
+                           T {reg = ESP, part = X}]
       val wordRegisters = List.rev wordRegisters
 
       val longRegisters = [T {reg = EAX, part = E},
-			   T {reg = EBX, part = E},
-			   T {reg = ECX, part = E},
-			   T {reg = EDX, part = E},
-			   T {reg = EDI, part = E},
-			   T {reg = ESI, part = E},
-			   T {reg = EBP, part = E},
-			   T {reg = ESP, part = E}]
+                           T {reg = EBX, part = E},
+                           T {reg = ECX, part = E},
+                           T {reg = EDX, part = E},
+                           T {reg = EDI, part = E},
+                           T {reg = ESI, part = E},
+                           T {reg = EBP, part = E},
+                           T {reg = ESP, part = E}]
       val longRegisters = List.rev longRegisters
 
       val all = List.concat [byteRegisters, wordRegisters, longRegisters]
@@ -262,99 +255,99 @@
       fun valid r = List.contains(all, r, eq)
 
       val contains 
-	= fn (E, E) => true | (E, X) => true | (E, L) => true | (E, H) => true
-	   | (X, X) => true | (X, L) => true | (X, H) => true
-	   | (L, L) => true 
-	   | (H, H) => true
-	   | _      => false
+        = fn (E, E) => true | (E, X) => true | (E, L) => true | (E, H) => true
+           | (X, X) => true | (X, L) => true | (X, H) => true
+           | (L, L) => true 
+           | (H, H) => true
+           | _      => false
 
       fun coincide (T {reg = reg1, part = part1}, 
-		    T {reg = reg2, part = part2}) 
-	= reg1 = reg2 andalso (contains(part1,part2) orelse 
-			       contains(part2,part1))
+                    T {reg = reg2, part = part2}) 
+        = reg1 = reg2 andalso (contains(part1,part2) orelse 
+                               contains(part2,part1))
 
       fun coincident' reg
-	= List.keepAllMap([E, X, L, H],
-			  fn part 
-			   => let
-				val register' = T {reg = reg, part = part}
-			      in 
-				if valid register' andalso 
-				   coincide(T {reg = reg, part = E}, register')
-				  then SOME register'
-				  else NONE
-			      end)
+        = List.keepAllMap([E, X, L, H],
+                          fn part 
+                           => let
+                                val register' = T {reg = reg, part = part}
+                              in 
+                                if valid register' andalso 
+                                   coincide(T {reg = reg, part = E}, register')
+                                  then SOME register'
+                                  else NONE
+                              end)
 
       fun coincident (T {reg, ...}) = coincident' reg
 
       val registers
-	= fn Size.BYTE => byteRegisters
-	   | Size.WORD => wordRegisters
-	   | Size.LONG => longRegisters
-	   | _ => Error.bug "Register.registers"
+        = fn Size.BYTE => byteRegisters
+           | Size.WORD => wordRegisters
+           | Size.LONG => longRegisters
+           | _ => Error.bug "x86.Register.registers"
 
       val baseRegisters = longRegisters
       val indexRegisters = [T {reg = EAX, part = E},
-			    T {reg = EBX, part = E},
-			    T {reg = ECX, part = E},
-			    T {reg = EDX, part = E},
-			    T {reg = EDI, part = E},
-			    T {reg = ESI, part = E},
-			    T {reg = EBP, part = E}]
+                            T {reg = EBX, part = E},
+                            T {reg = ECX, part = E},
+                            T {reg = EDX, part = E},
+                            T {reg = EDI, part = E},
+                            T {reg = ESI, part = E},
+                            T {reg = EBP, part = E}]
 
       val callerSaveRegisters = [T {reg = EAX, part = E},
-				 T {reg = EAX, part = X},
-				 T {reg = EAX, part = L},
-				 T {reg = EAX, part = H},
-				 T {reg = ECX, part = E},
-				 T {reg = ECX, part = X},
-				 T {reg = ECX, part = L},
-				 T {reg = ECX, part = H},
-				 T {reg = EDX, part = E},
-				 T {reg = EDX, part = X},
-				 T {reg = EDX, part = L},
-				 T {reg = EDX, part = H}]
+                                 T {reg = EAX, part = X},
+                                 T {reg = EAX, part = L},
+                                 T {reg = EAX, part = H},
+                                 T {reg = ECX, part = E},
+                                 T {reg = ECX, part = X},
+                                 T {reg = ECX, part = L},
+                                 T {reg = ECX, part = H},
+                                 T {reg = EDX, part = E},
+                                 T {reg = EDX, part = X},
+                                 T {reg = EDX, part = L},
+                                 T {reg = EDX, part = H}]
       val calleeSaveRegisters = [T {reg = EBX, part = E},
-				 T {reg = EBX, part = X},
-				 T {reg = EBX, part = L},
-				 T {reg = EBX, part = H},
-				 T {reg = EDI, part = E},
-				 T {reg = EDI, part = X},
-				 T {reg = ESI, part = E},
-				 T {reg = ESI, part = X}]
+                                 T {reg = EBX, part = X},
+                                 T {reg = EBX, part = L},
+                                 T {reg = EBX, part = H},
+                                 T {reg = EDI, part = E},
+                                 T {reg = EDI, part = X},
+                                 T {reg = ESI, part = E},
+                                 T {reg = ESI, part = X}]
 
       val withLowPart (* (fullsize,lowsize) *)
-	= fn (Size.WORD,Size.BYTE) => [T {reg = EAX, part = X},
-				       T {reg = EBX, part = X},
-				       T {reg = ECX, part = X},
-				       T {reg = EDX, part = X}]
-	   | (Size.LONG,Size.BYTE) => [T {reg = EAX, part = E},
-				       T {reg = EBX, part = E},
-				       T {reg = ECX, part = E},
-				       T {reg = EDX, part = E}]
-	   | (Size.LONG,Size.WORD) => longRegisters
-	   | _ => Error.bug "withLowPart: fullsize,lowsize"
+        = fn (Size.WORD,Size.BYTE) => [T {reg = EAX, part = X},
+                                       T {reg = EBX, part = X},
+                                       T {reg = ECX, part = X},
+                                       T {reg = EDX, part = X}]
+           | (Size.LONG,Size.BYTE) => [T {reg = EAX, part = E},
+                                       T {reg = EBX, part = E},
+                                       T {reg = ECX, part = E},
+                                       T {reg = EDX, part = E}]
+           | (Size.LONG,Size.WORD) => longRegisters
+           | _ => Error.bug "x86.Register.withLowPart: fullsize,lowsize"
 
       val lowPartOf (* (register,lowsize) *)
-	= fn (T {reg,       part = L},Size.BYTE) => T {reg = reg, part = L}
-	   | (T {reg,       part = H},Size.BYTE) => T {reg = reg, part = H}
-	   | (T {reg = EAX, ...},     Size.BYTE) => T {reg = EAX, part = L}
-	   | (T {reg = EBX, ...},     Size.BYTE) => T {reg = EBX, part = L}
-	   | (T {reg = ECX, ...},     Size.BYTE) => T {reg = ECX, part = L}
-	   | (T {reg = EDX, ...},     Size.BYTE) => T {reg = EDX, part = L}
-	   | (T {reg,       part = X},Size.WORD) => T {reg = reg, part = X}
-	   | (T {reg,       ...},     Size.WORD) => T {reg = reg, part = X}
-	   | _ => Error.bug "lowPartOf: register,lowsize"
+        = fn (T {reg,       part = L},Size.BYTE) => T {reg = reg, part = L}
+           | (T {reg,       part = H},Size.BYTE) => T {reg = reg, part = H}
+           | (T {reg = EAX, ...},     Size.BYTE) => T {reg = EAX, part = L}
+           | (T {reg = EBX, ...},     Size.BYTE) => T {reg = EBX, part = L}
+           | (T {reg = ECX, ...},     Size.BYTE) => T {reg = ECX, part = L}
+           | (T {reg = EDX, ...},     Size.BYTE) => T {reg = EDX, part = L}
+           | (T {reg,       part = X},Size.WORD) => T {reg = reg, part = X}
+           | (T {reg,       ...},     Size.WORD) => T {reg = reg, part = X}
+           | _ => Error.bug "x86.Register.lowPartOf: register,lowsize"
 
       val fullPartOf (* (register,fullsize) *)
-	= fn (T {reg, part = L},Size.BYTE) => T {reg = reg, part = L}
-	   | (T {reg, part = H},Size.BYTE) => T {reg = reg, part = H}
-	   | (T {reg, part = L},Size.WORD) => T {reg = reg, part = X}
-	   | (T {reg, part = X},Size.WORD) => T {reg = reg, part = X}
-	   | (T {reg, part = L},Size.LONG) => T {reg = reg, part = E}
-	   | (T {reg, part = X},Size.LONG) => T {reg = reg, part = E}
-	   | (T {reg, part = E},Size.LONG) => T {reg = reg, part = L}
-	   | _ => Error.bug "fullPartOf: register,fullsize"
+        = fn (T {reg, part = L},Size.BYTE) => T {reg = reg, part = L}
+           | (T {reg, part = H},Size.BYTE) => T {reg = reg, part = H}
+           | (T {reg, part = L},Size.WORD) => T {reg = reg, part = X}
+           | (T {reg, part = X},Size.WORD) => T {reg = reg, part = X}
+           | (T {reg, part = L},Size.LONG) => T {reg = reg, part = E}
+           | (T {reg, part = X},Size.LONG) => T {reg = reg, part = E}
+           | (T {reg, part = E},Size.LONG) => T {reg = reg, part = L}
+           | _ => Error.bug "x86.Register.fullPartOf: register,fullsize"
     end
 
   structure FltRegister =
@@ -362,12 +355,12 @@
       datatype t = T of int
 
       fun layout (T i)
-	= let
-	    open Layout
-	  in if i = 0
-	       then str "%st"
-	       else seq [str "%st", paren (Int.layout i)]
-	  end
+        = let
+            open Layout
+          in if i = 0
+               then str "%st"
+               else seq [str "%st", paren (Int.layout i)]
+          end
       val toString = Layout.toString o layout
 
       fun eq (T f1, T f2) = f1 = f2
@@ -387,247 +380,247 @@
   structure Immediate =
     struct
       datatype const
-	= Char of char
-	| Int of int
-	| Word of word
+        = Char of char
+        | Int of int
+        | Word of word
       val const_layout
-	= let
-	    open Layout
-	  in
-	    fn Char c => (Int.layout o Char.ord) c
-	     | Int i => if i >= 0
-			  then Int.layout i
-			  else seq [str "-", 
-				    str (String.dropPrefix(Int.toString i, 1))]
-	     | Word w => seq [str "0x", Word.layout w]
-	  end
+        = let
+            open Layout
+          in
+            fn Char c => (Int.layout o Char.ord) c
+             | Int i => if i >= 0
+                          then Int.layout i
+                          else seq [str "-", 
+                                    str (String.dropPrefix(Int.toString i, 1))]
+             | Word w => seq [str "0x", Word.layout w]
+          end
       val const_eval
-	= fn Char c => (Word.fromInt o Char.ord) c
-	   | Int i => Word.fromInt i
-	   | Word w => w
+        = fn Char c => (Word.fromInt o Char.ord) c
+           | Int i => Word.fromInt i
+           | Word w => w
       val const_hash = const_eval
       val const_compare
-	= fn (Char c1, Char c2) => Char.compare (c1, c2)
-	   | (Char _, Int _) => LESS
-	   | (Char _, Word _) => LESS
-	   | (Int i1, Int i2) => Int.compare (i1, i2)
-	   | (Int _, Word _) => LESS
-	   | (Word w1, Word w2) => Word.compare (w1, w2)
-	   | _ => GREATER
+        = fn (Char c1, Char c2) => Char.compare (c1, c2)
+           | (Char _, Int _) => LESS
+           | (Char _, Word _) => LESS
+           | (Int i1, Int i2) => Int.compare (i1, i2)
+           | (Int _, Word _) => LESS
+           | (Word w1, Word w2) => Word.compare (w1, w2)
+           | _ => GREATER
 
       datatype un
-	= Negation
-	| Complementation
+        = Negation
+        | Complementation
       val un_layout
-	= let
-	    open Layout
-	  in 
-	    fn Negation => str "-"
-	     | Complementation => str "~"
-	  end
+        = let
+            open Layout
+          in 
+            fn Negation => str "-"
+             | Complementation => str "~"
+          end
       val un_hash : un -> Word.t
-	= fn Negation => 0w1
-	   | Complementation => 0w2
+        = fn Negation => 0w1
+           | Complementation => 0w2
       val un_compare
-	= fn (un1, un2) => Word.compare (un_hash un1, un_hash un2)
+        = fn (un1, un2) => Word.compare (un_hash un1, un_hash un2)
 
       datatype bin
-	= Multiplication
-	| Division
-	| Remainder
-	| ShiftLeft
+        = Multiplication
+        | Division
+        | Remainder
+        | ShiftLeft
         | ShiftRight
-	| BitOr
-	| BitAnd
-	| BitXor
-	| BitOrNot
-	| Addition
-	| Subtraction
+        | BitOr
+        | BitAnd
+        | BitXor
+        | BitOrNot
+        | Addition
+        | Subtraction
       val bin_layout
-	= let
-	    open Layout
-	  in 
-	    fn Multiplication => str "*"
-	     | Division => str "/"
-	     | Remainder => str "%"
-	     | ShiftLeft => str "<<"
-	     | ShiftRight => str ">>"
-	     | BitOr => str "|"
-	     | BitAnd => str "&"
-	     | BitXor => str "^"
-	     | BitOrNot => str "!"
-	     | Addition => str "+"
-	     | Subtraction => str "-"
-	  end
+        = let
+            open Layout
+          in 
+            fn Multiplication => str "*"
+             | Division => str "/"
+             | Remainder => str "%"
+             | ShiftLeft => str "<<"
+             | ShiftRight => str ">>"
+             | BitOr => str "|"
+             | BitAnd => str "&"
+             | BitXor => str "^"
+             | BitOrNot => str "!"
+             | Addition => str "+"
+             | Subtraction => str "-"
+          end
       val bin_hash : bin -> Word.t
-	= fn Multiplication => 0w1
+        = fn Multiplication => 0w1
            | Division => 0w2
-	   | Remainder => 0w3
-	   | ShiftLeft => 0w4
-	   | ShiftRight => 0w5
-	   | BitOr => 0w6
-	   | BitAnd => 0w7
-	   | BitXor => 0w8 
-	   | BitOrNot => 0w9
-	   | Addition => 0w10
-	   | Subtraction => 0w11
+           | Remainder => 0w3
+           | ShiftLeft => 0w4
+           | ShiftRight => 0w5
+           | BitOr => 0w6
+           | BitAnd => 0w7
+           | BitXor => 0w8 
+           | BitOrNot => 0w9
+           | Addition => 0w10
+           | Subtraction => 0w11
       val bin_compare
-	= fn (bin1, bin2) => Word.compare (bin_hash bin1, bin_hash bin2)
+        = fn (bin1, bin2) => Word.compare (bin_hash bin1, bin_hash bin2)
 
       datatype u
-	= Const of const
-	
+        = Const of const
+        
         | Label of Label.t
-	| ImmedUnExp of {oper: un,
-			 exp: t}
-	| ImmedBinExp of {oper: bin,
-			  exp1: t,
-			  exp2: t}
+        | ImmedUnExp of {oper: un,
+                         exp: t}
+        | ImmedBinExp of {oper: bin,
+                          exp1: t,
+                          exp2: t}
       and t
-	= T of {immediate: u,
-		plist: PropertyList.t,
-		hash: Word.t,
-		eval: Word.t option}
+        = T of {immediate: u,
+                plist: PropertyList.t,
+                hash: Word.t,
+                eval: Word.t option}
 
       local 
-	open Layout
+        open Layout
       in
-	val rec layoutU
-	  = fn Const c => const_layout c
-	     | Label l => Label.layout l
-	     | ImmedUnExp {oper, exp}
-	     => paren (seq [un_layout oper, layout exp])
-	     | ImmedBinExp {oper, exp1, exp2}
-	     => paren (seq [layout exp1, bin_layout oper, layout exp2])
-	and layout
-	  = fn T {immediate, ...} => layoutU immediate
+        val rec layoutU
+          = fn Const c => const_layout c
+             | Label l => Label.layout l
+             | ImmedUnExp {oper, exp}
+             => paren (seq [un_layout oper, layout exp])
+             | ImmedBinExp {oper, exp1, exp2}
+             => paren (seq [layout exp1, bin_layout oper, layout exp2])
+        and layout
+          = fn T {immediate, ...} => layoutU immediate
       end
  
       val rec eqU
-	= fn (Const c1, Const c2) => c1 = c2
-	   | (Label l1, Label l2) => Label.equals(l1, l2)
-	   | (ImmedUnExp {oper = oper,  exp = exp},
-	      ImmedUnExp {oper = oper', exp = exp'})
-	   => oper = oper' andalso 
-	      eq(exp, exp') 
-	   | (ImmedBinExp {oper = oper,  exp1 = exp1,  exp2 = exp2},
-	      ImmedBinExp {oper = oper', exp1 = exp1', exp2 = exp2'})
-	   => oper = oper' andalso 
-	      eq(exp1, exp1') andalso 
-	      eq(exp2, exp2')
-	   | _ => false
+        = fn (Const c1, Const c2) => c1 = c2
+           | (Label l1, Label l2) => Label.equals(l1, l2)
+           | (ImmedUnExp {oper = oper,  exp = exp},
+              ImmedUnExp {oper = oper', exp = exp'})
+           => oper = oper' andalso 
+              eq(exp, exp') 
+           | (ImmedBinExp {oper = oper,  exp1 = exp1,  exp2 = exp2},
+              ImmedBinExp {oper = oper', exp1 = exp1', exp2 = exp2'})
+           => oper = oper' andalso 
+              eq(exp1, exp1') andalso 
+              eq(exp2, exp2')
+           | _ => false
       and eq
-	= fn (T {plist = plist1, ...},
-	      T {plist = plist2, ...})
-	   => PropertyList.equals(plist1, plist2)
+        = fn (T {plist = plist1, ...},
+              T {plist = plist2, ...})
+           => PropertyList.equals(plist1, plist2)
 
       val rec compareU
-	= fn (Const c1, Const c2) => const_compare (c1, c2)
-	   | (Const _, Label _) => LESS
-	   | (Const _, ImmedUnExp _) => LESS
-	   | (Const _, ImmedBinExp _) => LESS
-	   | (Label l1, Label l2) 
-	   => lexical [fn () => EQUAL,
-		       fn () => String.compare (Label.toString l1,
-						Label.toString l2)]
-	   | (Label _, ImmedUnExp _) => LESS
-	   | (Label _, ImmedBinExp _) => LESS
-	   | (ImmedUnExp {oper = oper1, exp = exp1},
-	      ImmedUnExp {oper = oper2, exp = exp2})
-	   => lexical [fn () => un_compare (oper1, oper2),
-		       fn () => compare (exp1, exp2)]
-	   | (ImmedUnExp _, ImmedBinExp _) => LESS
-	   | (ImmedBinExp {oper = oper1, exp1 = exp11, exp2 = exp12},
-	      ImmedBinExp {oper = oper2, exp1 = exp21, exp2 = exp22})
-	   => lexical [fn () => bin_compare (oper1, oper2),
-		       fn () => compare (exp11, exp21),
-		       fn () => compare (exp12, exp22)]
-	   | _ => GREATER
+        = fn (Const c1, Const c2) => const_compare (c1, c2)
+           | (Const _, Label _) => LESS
+           | (Const _, ImmedUnExp _) => LESS
+           | (Const _, ImmedBinExp _) => LESS
+           | (Label l1, Label l2) 
+           => lexical [fn () => EQUAL,
+                       fn () => String.compare (Label.toString l1,
+                                                Label.toString l2)]
+           | (Label _, ImmedUnExp _) => LESS
+           | (Label _, ImmedBinExp _) => LESS
+           | (ImmedUnExp {oper = oper1, exp = exp1},
+              ImmedUnExp {oper = oper2, exp = exp2})
+           => lexical [fn () => un_compare (oper1, oper2),
+                       fn () => compare (exp1, exp2)]
+           | (ImmedUnExp _, ImmedBinExp _) => LESS
+           | (ImmedBinExp {oper = oper1, exp1 = exp11, exp2 = exp12},
+              ImmedBinExp {oper = oper2, exp1 = exp21, exp2 = exp22})
+           => lexical [fn () => bin_compare (oper1, oper2),
+                       fn () => compare (exp11, exp21),
+                       fn () => compare (exp12, exp22)]
+           | _ => GREATER
       and compare
-	= fn (T {immediate = immediate1, ...},
-	      T {immediate = immediate2, ...})
-	   => compareU(immediate1, immediate2)
+        = fn (T {immediate = immediate1, ...},
+              T {immediate = immediate2, ...})
+           => compareU(immediate1, immediate2)
 
       local 
-	open Word 
+        open Word 
       in
-	val rec evalU
-	  = fn Const c => SOME (const_eval c)
-	     | Label _ => NONE
-	     | ImmedUnExp {oper, exp}
-	     => (case eval exp
-		   of SOME i 
-		    => (case oper
-			  of Negation => SOME (0wx0 - i)
-			   | Complementation => SOME (notb i))
-		    | NONE => NONE)
-	     | ImmedBinExp {oper, exp1, exp2}
-	     => (case (eval exp1, eval exp2)
-		   of (SOME i1, SOME i2)
-		    => (case oper
-			  of Multiplication => SOME (i1 * i2)
-			   | Division => SOME (i1 div i2)
-			   | Remainder => SOME (i1 mod i2)
-			   | ShiftLeft => SOME (<<(i1, i2))
-			   | ShiftRight => SOME (>>(i1, i2))
-			   | BitOr => SOME (orb(i1, i2))
-			   | BitAnd => SOME (andb(i1, i2))
-			   | BitXor => SOME (xorb(i1, i2))
-			   | BitOrNot => SOME ((notb o orb)(i1, i2))
-			   | Addition => SOME (i1 + i2)
-			   | Subtraction => SOME (i1 - i2))
-		    | _ => NONE)
-	and eval
-	  = fn T {eval, ...} => eval
+        val rec evalU
+          = fn Const c => SOME (const_eval c)
+             | Label _ => NONE
+             | ImmedUnExp {oper, exp}
+             => (case eval exp
+                   of SOME i 
+                    => (case oper
+                          of Negation => SOME (0wx0 - i)
+                           | Complementation => SOME (notb i))
+                    | NONE => NONE)
+             | ImmedBinExp {oper, exp1, exp2}
+             => (case (eval exp1, eval exp2)
+                   of (SOME i1, SOME i2)
+                    => (case oper
+                          of Multiplication => SOME (i1 * i2)
+                           | Division => SOME (i1 div i2)
+                           | Remainder => SOME (i1 mod i2)
+                           | ShiftLeft => SOME (<<(i1, i2))
+                           | ShiftRight => SOME (>>(i1, i2))
+                           | BitOr => SOME (orb(i1, i2))
+                           | BitAnd => SOME (andb(i1, i2))
+                           | BitXor => SOME (xorb(i1, i2))
+                           | BitOrNot => SOME ((notb o orb)(i1, i2))
+                           | Addition => SOME (i1 + i2)
+                           | Subtraction => SOME (i1 - i2))
+                    | _ => NONE)
+        and eval
+          = fn T {eval, ...} => eval
       end
 
       val zero = fn i => eval i = SOME 0wx0
     
       local 
-	open Word
+        open Word
       in 
-	val rec hashU
-	  = fn Const c => const_hash c
-	     | Label l => Label.hash l
-	     | ImmedUnExp {exp, ...}
-	     => hash exp
-	     | ImmedBinExp {exp1, exp2, ...}
-	     => Word.xorb(0wx5555 * (hash exp1), hash exp2)
-	and hash
-	  = fn T {hash, ...} => hash
+        val rec hashU
+          = fn Const c => const_hash c
+             | Label l => Label.hash l
+             | ImmedUnExp {exp, ...}
+             => hash exp
+             | ImmedBinExp {exp1, exp2, ...}
+             => Word.xorb(0wx5555 * (hash exp1), hash exp2)
+        and hash
+          = fn T {hash, ...} => hash
       end
 
       local
-	val table: t HashSet.t ref = ref (HashSet.new {hash = hash})
+        val table: t HashSet.t ref = ref (HashSet.new {hash = hash})
       in
-	val construct
-	  = fn immediate
-	     => let
-		  val hash = hashU immediate
-		in
-		  HashSet.lookupOrInsert
-		  (!table,
-		   hash,
-		   fn T {immediate = immediate', ...}
-		    => eqU(immediate', immediate),
-		   fn () => T {immediate = immediate,
-			       hash = hash,
-			       plist = PropertyList.new (),
-			       eval = evalU immediate})
-		end
+        val construct
+          = fn immediate
+             => let
+                  val hash = hashU immediate
+                in
+                  HashSet.lookupOrInsert
+                  (!table,
+                   hash,
+                   fn T {immediate = immediate', ...}
+                    => eqU(immediate', immediate),
+                   fn () => T {immediate = immediate,
+                               hash = hash,
+                               plist = PropertyList.new (),
+                               eval = evalU immediate})
+                end
 
-	val destruct
-	  = fn T {immediate, ...} => immediate
+        val destruct
+          = fn T {immediate, ...} => immediate
 
-	fun clearAll ()
-	  = HashSet.foreach
-	    (!table, fn T {immediate, plist, ...} =>
-	     let in
-	       PropertyList.clear plist;
-	       case immediate
-		 of Label l => Label.clear l
-		  | _ => ()
-	     end)
+        fun clearAll ()
+          = HashSet.foreach
+            (!table, fn T {immediate, plist, ...} =>
+             let in
+               PropertyList.clear plist;
+               case immediate
+                 of Label l => Label.clear l
+                  | _ => ()
+             end)
       end
 
       val const = construct o Const
@@ -635,12 +628,12 @@
       val const_int = const o Int
       val const_word = const o Word
       val deConst
-	= fn T {immediate = Const c, ...} => SOME c
-	   | _ => NONE
+        = fn T {immediate = Const c, ...} => SOME c
+           | _ => NONE
       val label = construct o Label
       val deLabel
-	= fn T {immediate = Label l, ...} => SOME l
-	   | _ => NONE
+        = fn T {immediate = Label l, ...} => SOME l
+           | _ => NONE
       val unexp = construct o ImmedUnExp
       val binexp = construct o ImmedBinExp
     end
@@ -648,615 +641,615 @@
   structure Scale = 
     struct
       datatype t 
-	= One | Two | Four | Eight
-	
+        = One | Two | Four | Eight
+        
       val layout
-	= let
-	    open Layout
-	  in
-	    fn One => str "1"
-	     | Two => str "2"
-	     | Four => str "4"
-	     | Eight => str "8"
-	  end
+        = let
+            open Layout
+          in
+            fn One => str "1"
+             | Two => str "2"
+             | Four => str "4"
+             | Eight => str "8"
+          end
 
       val fromBytes : int -> t
-	= fn 1 => One
-	   | 2 => Two
-	   | 4 => Four
-	   | 8 => Eight
-	   | _ => Error.bug "Scale.fromBytes"
+        = fn 1 => One
+           | 2 => Two
+           | 4 => Four
+           | 8 => Eight
+           | _ => Error.bug "x86.Scale.fromBytes"
       local
-	 datatype z = datatype CType.t
+         datatype z = datatype CType.t
       in
-	 fun fromCType t =
-	    case t of
-	       Int8 => One
-	     | Int16 => Two
-	     | Int32 => Four
-	     | Int64 => Eight
-	     | Pointer => Four
-	     | Real32 => Four
-	     | Real64 => Eight
-	     | Word8 => One
-	     | Word16 => Two
-	     | Word32 => Four
-	     | Word64 => Eight
+         fun fromCType t =
+            case t of
+               Int8 => One
+             | Int16 => Two
+             | Int32 => Four
+             | Int64 => Eight
+             | Pointer => Four
+             | Real32 => Four
+             | Real64 => Eight
+             | Word8 => One
+             | Word16 => Two
+             | Word32 => Four
+             | Word64 => Eight
       end
 
       fun eq(s1, s2) = s1 = s2
 
       val toImmediate
-	= fn One => Immediate.const_int 1
+        = fn One => Immediate.const_int 1
            | Two => Immediate.const_int 2
-	   | Four => Immediate.const_int 4
-	   | Eight => Immediate.const_int 8
+           | Four => Immediate.const_int 4
+           | Eight => Immediate.const_int 8
     end
     
   structure Address =
     struct
       datatype t = T of {disp: Immediate.t option,
-			 base: Register.t option,
-			 index: Register.t option,
-			 scale: Scale.t option}
+                         base: Register.t option,
+                         index: Register.t option,
+                         scale: Scale.t option}
 
       fun layout (T {disp, base, index, scale})
-	= let
-	    open Layout
-	  in
-	    seq [case disp
-		   of NONE => empty
-		    | SOME disp => Immediate.layout disp,
-		 if (isSome base orelse isSome index)
-		   then paren (seq
-			       [case base
-				  of NONE => empty
-				  | SOME base
-				  => Register.layout base,
-				case index
-				  of NONE => empty
-				   | SOME index
-				   => seq [str ",", Register.layout index],
-				case scale
-				  of NONE => empty
-				  | SOME scale
-				  => seq [str ",", Scale.layout scale]])
-		   else empty]
-	  end
+        = let
+            open Layout
+          in
+            seq [case disp
+                   of NONE => empty
+                    | SOME disp => Immediate.layout disp,
+                 if (isSome base orelse isSome index)
+                   then paren (seq
+                               [case base
+                                  of NONE => empty
+                                  | SOME base
+                                  => Register.layout base,
+                                case index
+                                  of NONE => empty
+                                   | SOME index
+                                   => seq [str ",", Register.layout index],
+                                case scale
+                                  of NONE => empty
+                                  | SOME scale
+                                  => seq [str ",", Scale.layout scale]])
+                   else empty]
+          end
 
       fun eq(T {disp = disp,  base = base,  index = index,  scale = scale},
-	     T {disp = disp', base = base', index = index', scale = scale'})
-	= (case (disp, disp')
-	     of (NONE, NONE) => true
-	      | (SOME disp, SOME disp') => Immediate.eq(disp, disp') 
-	      | _ => false) andalso
-	  base = base' andalso
-	  index = index' andalso
-	  scale = scale'
+             T {disp = disp', base = base', index = index', scale = scale'})
+        = (case (disp, disp')
+             of (NONE, NONE) => true
+              | (SOME disp, SOME disp') => Immediate.eq(disp, disp') 
+              | _ => false) andalso
+          base = base' andalso
+          index = index' andalso
+          scale = scale'
 
       fun shift (T {disp, base, index, scale}, i)
-	= T {disp = case disp
-		      of SOME disp 
-		       => SOME (Immediate.binexp {oper = Immediate.Addition,
-						  exp1 = disp,
-						  exp2 = i})
-		       | NONE => SOME i,
-	     base = base, index = index, scale = scale}
+        = T {disp = case disp
+                      of SOME disp 
+                       => SOME (Immediate.binexp {oper = Immediate.Addition,
+                                                  exp1 = disp,
+                                                  exp2 = i})
+                       | NONE => SOME i,
+             base = base, index = index, scale = scale}
     end
 
   structure MemLoc =
     struct
       structure Class =
-	struct
-	  val counter = Counter.new 0
-	  datatype t = T of {counter: int,
-			     name: string}
+        struct
+          val counter = Counter.new 0
+          datatype t = T of {counter: int,
+                             name: string}
 
-	  fun layout (T {name, ...})
-	    = let
-		open Layout
-	      in
-		str name
-	      end
-	  val toString = Layout.toString o layout
+          fun layout (T {name, ...})
+            = let
+                open Layout
+              in
+                str name
+              end
+          val toString = Layout.toString o layout
 
-	  fun new {name}
-	    = let
-		val class = T {counter = Counter.next counter,
-			       name = name}
-	      in
-		class
-	      end
+          fun new {name}
+            = let
+                val class = T {counter = Counter.next counter,
+                               name = name}
+              in
+                class
+              end
 
-	  val eq 
-	    = fn (T {counter = counter1, ...}, 
-		  T {counter = counter2, ...}) 
-	       => counter1 = counter2
-	  val compare 
-	    = fn (T {counter = counter1, ...}, 
-		  T {counter = counter2, ...}) 
-	       => Int.compare (counter1, counter2)
-	  val counter
-	    = fn (T {counter, ...}) => counter
-	  val mayAlias = eq
+          val eq 
+            = fn (T {counter = counter1, ...}, 
+                  T {counter = counter2, ...}) 
+               => counter1 = counter2
+          val compare 
+            = fn (T {counter = counter1, ...}, 
+                  T {counter = counter2, ...}) 
+               => Int.compare (counter1, counter2)
+          val counter
+            = fn (T {counter, ...}) => counter
+          val mayAlias = eq
 
-	  val Temp = new {name = "Temp"}
-	  val StaticTemp = new {name = "StaticTemp"}
-	  val CStack = new {name = "CStack"}
-	  val Code = new {name = "Code"}
-	end
+          val Temp = new {name = "Temp"}
+          val StaticTemp = new {name = "StaticTemp"}
+          val CStack = new {name = "CStack"}
+          val Code = new {name = "Code"}
+        end
 
       datatype u
-	= U of {immBase: Immediate.t option,
-		memBase: t option,
-		immIndex: Immediate.t option,
-		memIndex: t option,
-		scale: Scale.t,
-		size: Size.t,
-		class: Class.t}
+        = U of {immBase: Immediate.t option,
+                memBase: t option,
+                immIndex: Immediate.t option,
+                memIndex: t option,
+                scale: Scale.t,
+                size: Size.t,
+                class: Class.t}
       and t
-	= T of {memloc: u,
-		hash: Word.t,
-		plist: PropertyList.t,
-		counter: Int.t,
-		utilized: t list}
+        = T of {memloc: u,
+                hash: Word.t,
+                plist: PropertyList.t,
+                counter: Int.t,
+                utilized: t list}
 
       local
-	open Layout
+        open Layout
       in
-	val rec layoutImmMem 
-	  = fn (NONE, NONE) => str "0"
-	     | (SOME imm, NONE) => Immediate.layout imm
-	     | (NONE, SOME mem) => layout mem
-	     | (SOME imm, SOME mem) => seq [Immediate.layout imm,
-					    str "+",
-					    layout mem]
-	and layoutU
-	  = fn U {immBase, memBase,
-		  immIndex, memIndex,
-		  scale,
-		  size, class}
-	     => seq [str "MEM<",
-		     Size.layout size,
-		     str ">{",
-		     Class.layout class,
-		     str "}[(",
-		     layoutImmMem (immBase, memBase),
-		     str ")+((",
-		     layoutImmMem (immIndex, memIndex),
-		     str ")*",
-		     Scale.layout scale,
-		     str ")]"]
-	and layout
-	  = fn T {memloc, ...} => layoutU memloc
+        val rec layoutImmMem 
+          = fn (NONE, NONE) => str "0"
+             | (SOME imm, NONE) => Immediate.layout imm
+             | (NONE, SOME mem) => layout mem
+             | (SOME imm, SOME mem) => seq [Immediate.layout imm,
+                                            str "+",
+                                            layout mem]
+        and layoutU
+          = fn U {immBase, memBase,
+                  immIndex, memIndex,
+                  scale,
+                  size, class}
+             => seq [str "MEM<",
+                     Size.layout size,
+                     str ">{",
+                     Class.layout class,
+                     str "}[(",
+                     layoutImmMem (immBase, memBase),
+                     str ")+((",
+                     layoutImmMem (immIndex, memIndex),
+                     str ")*",
+                     Scale.layout scale,
+                     str ")]"]
+        and layout
+          = fn T {memloc, ...} => layoutU memloc
       end
       val toString = Layout.toString o layout
 
       val rec hashImmMem
-	= fn (NONE, NONE) => 0wx55555555
-	   | (SOME imm, NONE) => Immediate.hash imm
-	   | (NONE, SOME mem) => hash mem
-	   | (SOME imm, SOME mem)
-	   => Word.xorb(0wx5555 * (Immediate.hash imm), hash mem)
+        = fn (NONE, NONE) => 0wx55555555
+           | (SOME imm, NONE) => Immediate.hash imm
+           | (NONE, SOME mem) => hash mem
+           | (SOME imm, SOME mem)
+           => Word.xorb(0wx5555 * (Immediate.hash imm), hash mem)
       and hashU
-	= fn U {immBase, memBase, immIndex, memIndex, ...}
-	   => let
-		val hashBase = hashImmMem(immBase, memBase)
-		val hashIndex = hashImmMem(immIndex, memIndex)
-	      in
-		Word.xorb(0wx5555 * hashBase, hashIndex)
-	      end
+        = fn U {immBase, memBase, immIndex, memIndex, ...}
+           => let
+                val hashBase = hashImmMem(immBase, memBase)
+                val hashIndex = hashImmMem(immIndex, memIndex)
+              in
+                Word.xorb(0wx5555 * hashBase, hashIndex)
+              end
       and hash
-	= fn T {hash, ...} => hash
+        = fn T {hash, ...} => hash
 
       val rec eqImm
-	= fn (NONE, NONE) => true
-	   | (SOME imm1, SOME imm2) => Immediate.eq(imm1, imm2)
+        = fn (NONE, NONE) => true
+           | (SOME imm1, SOME imm2) => Immediate.eq(imm1, imm2)
            | _ => false
       and eqMem
-	= fn (NONE, NONE) => true
-	   | (SOME mem1, SOME mem2) => eq(mem1, mem2)
-	   | _ => false
+        = fn (NONE, NONE) => true
+           | (SOME mem1, SOME mem2) => eq(mem1, mem2)
+           | _ => false
       and eqU
-	= fn (U {immBase = immBase1, memBase = memBase1,
-		 immIndex = immIndex1, memIndex = memIndex1,
-		 scale = scale1, size = size1, 
-		 class = class1},
-	      U {immBase = immBase2, memBase = memBase2,
-		 immIndex = immIndex2, memIndex = memIndex2,
-		 scale = scale2, size = size2, 
-		 class = class2})
-	   => Class.eq(class1, class2) andalso
-	      eqImm(immBase1, immBase2) andalso
-	      eqMem(memBase1, memBase2) andalso
-	      eqImm(immIndex1, immIndex2) andalso
-	      eqMem(memIndex1, memIndex2) andalso
-	      Scale.eq(scale1, scale2) andalso
-	      Size.eq(size1, size2)
+        = fn (U {immBase = immBase1, memBase = memBase1,
+                 immIndex = immIndex1, memIndex = memIndex1,
+                 scale = scale1, size = size1, 
+                 class = class1},
+              U {immBase = immBase2, memBase = memBase2,
+                 immIndex = immIndex2, memIndex = memIndex2,
+                 scale = scale2, size = size2, 
+                 class = class2})
+           => Class.eq(class1, class2) andalso
+              eqImm(immBase1, immBase2) andalso
+              eqMem(memBase1, memBase2) andalso
+              eqImm(immIndex1, immIndex2) andalso
+              eqMem(memIndex1, memIndex2) andalso
+              Scale.eq(scale1, scale2) andalso
+              Size.eq(size1, size2)
       and eq
-	= fn (T {plist = plist1, ...},
-	      T {plist = plist2, ...})
-	   => PropertyList.equals(plist1, plist2)
+        = fn (T {plist = plist1, ...},
+              T {plist = plist2, ...})
+           => PropertyList.equals(plist1, plist2)
 
       val rec utilizedMem
-	= fn NONE => []
-	   | SOME m => m::(utilized m)
+        = fn NONE => []
+           | SOME m => m::(utilized m)
       and utilizedU
-	= fn U {memBase, memIndex, ...} 
-	   => (utilizedMem memBase) @ (utilizedMem memIndex)
+        = fn U {memBase, memIndex, ...} 
+           => (utilizedMem memBase) @ (utilizedMem memIndex)
       and utilized
-	= fn T {utilized, ...}
-	   => utilized
+        = fn T {utilized, ...}
+           => utilized
 
       local
-	val counter = Counter.new 0
-	val table: t HashSet.t ref = ref (HashSet.new {hash = hash})
+        val counter = Counter.new 0
+        val table: t HashSet.t ref = ref (HashSet.new {hash = hash})
       in
-	val construct 
-	  = fn memloc
-	     => let
-		  val hash = hashU memloc
-		in 
-		  HashSet.lookupOrInsert
-		  (!table,
-		   hash,
-		   fn T {memloc = memloc', ...} => eqU(memloc', memloc),
-		   fn () => T {memloc = memloc,
-			       hash = hash,
-			       plist = PropertyList.new (),
-			       counter = Counter.next counter,
-			       utilized = utilizedU memloc})
-		end
+        val construct 
+          = fn memloc
+             => let
+                  val hash = hashU memloc
+                in 
+                  HashSet.lookupOrInsert
+                  (!table,
+                   hash,
+                   fn T {memloc = memloc', ...} => eqU(memloc', memloc),
+                   fn () => T {memloc = memloc,
+                               hash = hash,
+                               plist = PropertyList.new (),
+                               counter = Counter.next counter,
+                               utilized = utilizedU memloc})
+                end
 
-	val destruct 
-	  = fn T {memloc, ...}
-	     => memloc
+        val destruct 
+          = fn T {memloc, ...}
+             => memloc
 
-	fun clearAll ()
-	  = HashSet.foreach
-	    (!table, fn T {plist, ...} =>
-	     let in
-	       PropertyList.clear plist
-	     end)
+        fun clearAll ()
+          = HashSet.foreach
+            (!table, fn T {plist, ...} =>
+             let in
+               PropertyList.clear plist
+             end)
       end
 
       val rec mayAliasImmIndex 
-	= fn ({immIndex = immIndex1, size = size1},
-	      {immIndex = immIndex2, size = size2})
-	   => let
-		val size1 = Size.toBytes size1
-		val size2 = Size.toBytes size2
-	      in
-		case (Immediate.eval (case immIndex1
-					of NONE => Immediate.const_int 0
-					 | SOME immIndex => immIndex),
-		      Immediate.eval (case immIndex2
-					of NONE => Immediate.const_int 0
-					 | SOME immIndex => immIndex))
-		  of (SOME pos1, SOME pos2)
-		   => (let
-			 val pos1 = Word.toInt pos1
-			 val pos2 = Word.toInt pos2
-		       in 
-			 if pos1 < pos2 
-			   then pos2 < (pos1 + size1) 
-			   else pos1 < (pos2 + size2)
-		       end
-		       handle Overflow => false)
-	           | _ => true
-	  end
+        = fn ({immIndex = immIndex1, size = size1},
+              {immIndex = immIndex2, size = size2})
+           => let
+                val size1 = Size.toBytes size1
+                val size2 = Size.toBytes size2
+              in
+                case (Immediate.eval (case immIndex1
+                                        of NONE => Immediate.const_int 0
+                                         | SOME immIndex => immIndex),
+                      Immediate.eval (case immIndex2
+                                        of NONE => Immediate.const_int 0
+                                         | SOME immIndex => immIndex))
+                  of (SOME pos1, SOME pos2)
+                   => (let
+                         val pos1 = Word.toInt pos1
+                         val pos2 = Word.toInt pos2
+                       in 
+                         if pos1 < pos2 
+                           then pos2 < (pos1 + size1) 
+                           else pos1 < (pos2 + size2)
+                       end
+                       handle Overflow => false)
+                   | _ => true
+          end
       and mayAliasU
-	= fn (U {immBase = SOME immBase1, memBase = NONE,
-		 immIndex = immIndex1, memIndex = NONE,
-		 size = size1, ...},
-	      U {immBase = SOME immBase2, memBase = NONE,
-		 immIndex = immIndex2, memIndex = NONE,
-		 size = size2, ...})
-	   => Immediate.eq(immBase1, immBase2)
-	      andalso
-	      mayAliasImmIndex ({immIndex = immIndex1, 
-				 size = size1},
-				{immIndex = immIndex2,
-				 size = size2})
-	   | (U {immBase = SOME immBase1, memBase = NONE,
-		 immIndex = immIndex1, memIndex = SOME memIndex1,
-		 size = size1, ...},
-	      U {immBase = SOME immBase2, memBase = NONE,
-		 immIndex = immIndex2, memIndex = SOME memIndex2,
-		 size = size2, ...})
-	   => not (Immediate.eq(immBase1, immBase2))
-	      andalso
-	      (not (eq(memIndex1, memIndex2))
-	       orelse
-	       mayAliasImmIndex ({immIndex = immIndex1,
-				  size = size1},
-				 {immIndex = immIndex2,
-				  size = size2}))
-	   | (U {immBase = NONE, memBase = SOME memBase1,
-		 immIndex = immIndex1, memIndex = NONE,
-		 size = size1, ...},
-	      U {immBase = NONE, memBase = SOME memBase2,
-		 immIndex = immIndex2, memIndex = NONE,
-		 size = size2, ...})
-	   => not (eq(memBase1, memBase2))
-	      orelse
-	      mayAliasImmIndex ({immIndex = immIndex1,
-				 size = size1},
-				{immIndex = immIndex2,
-				 size = size2})
-	   | (U {immBase = NONE, memBase = SOME memBase1,
-		 immIndex = immIndex1, memIndex = SOME memIndex1,
-		 size = size1, ...},
-	      U {immBase = NONE, memBase = SOME memBase2,
-		 immIndex = immIndex2, memIndex = SOME memIndex2,
-		 size = size2, ...})
-	   => not (eq(memBase1, memBase2))
-	      orelse
-	      not (eq(memIndex1, memIndex2))
-	      orelse
-	      mayAliasImmIndex ({immIndex = immIndex1,
-				 size = size1},
-				{immIndex = immIndex2,
-				 size = size2})
-	   | _ => true
+        = fn (U {immBase = SOME immBase1, memBase = NONE,
+                 immIndex = immIndex1, memIndex = NONE,
+                 size = size1, ...},
+              U {immBase = SOME immBase2, memBase = NONE,
+                 immIndex = immIndex2, memIndex = NONE,
+                 size = size2, ...})
+           => Immediate.eq(immBase1, immBase2)
+              andalso
+              mayAliasImmIndex ({immIndex = immIndex1, 
+                                 size = size1},
+                                {immIndex = immIndex2,
+                                 size = size2})
+           | (U {immBase = SOME immBase1, memBase = NONE,
+                 immIndex = immIndex1, memIndex = SOME memIndex1,
+                 size = size1, ...},
+              U {immBase = SOME immBase2, memBase = NONE,
+                 immIndex = immIndex2, memIndex = SOME memIndex2,
+                 size = size2, ...})
+           => not (Immediate.eq(immBase1, immBase2))
+              andalso
+              (not (eq(memIndex1, memIndex2))
+               orelse
+               mayAliasImmIndex ({immIndex = immIndex1,
+                                  size = size1},
+                                 {immIndex = immIndex2,
+                                  size = size2}))
+           | (U {immBase = NONE, memBase = SOME memBase1,
+                 immIndex = immIndex1, memIndex = NONE,
+                 size = size1, ...},
+              U {immBase = NONE, memBase = SOME memBase2,
+                 immIndex = immIndex2, memIndex = NONE,
+                 size = size2, ...})
+           => not (eq(memBase1, memBase2))
+              orelse
+              mayAliasImmIndex ({immIndex = immIndex1,
+                                 size = size1},
+                                {immIndex = immIndex2,
+                                 size = size2})
+           | (U {immBase = NONE, memBase = SOME memBase1,
+                 immIndex = immIndex1, memIndex = SOME memIndex1,
+                 size = size1, ...},
+              U {immBase = NONE, memBase = SOME memBase2,
+                 immIndex = immIndex2, memIndex = SOME memIndex2,
+                 size = size2, ...})
+           => not (eq(memBase1, memBase2))
+              orelse
+              not (eq(memIndex1, memIndex2))
+              orelse
+              mayAliasImmIndex ({immIndex = immIndex1,
+                                 size = size1},
+                                {immIndex = immIndex2,
+                                 size = size2})
+           | _ => true
       and mayAlias
-	= fn (T {memloc = memloc1 as U {class = class1, ...}, ...},
-	      T {memloc = memloc2 as U {class = class2, ...}, ...})
-	   => Class.mayAlias(class1, class2) andalso
-	      mayAliasU(memloc1, memloc2)
+        = fn (T {memloc = memloc1 as U {class = class1, ...}, ...},
+              T {memloc = memloc2 as U {class = class2, ...}, ...})
+           => Class.mayAlias(class1, class2) andalso
+              mayAliasU(memloc1, memloc2)
 
       val rec mayAliasOrdImmIndex 
-	= fn ({immIndex = immIndex1, size = size1},
-	      {immIndex = immIndex2, size = size2})
-	   => let
-		val size1 = Size.toBytes size1
-		val size2 = Size.toBytes size2
-	      in
-		case (Immediate.eval (case immIndex1
-					of NONE => Immediate.const_int 0
-					 | SOME immIndex => immIndex),
-		      Immediate.eval (case immIndex2
-					of NONE => Immediate.const_int 0
-					 | SOME immIndex => immIndex))
-		  of (SOME pos1, SOME pos2)
-		   => (let
-			 val pos1 = Word.toInt pos1
-			 val pos2 = Word.toInt pos2
-		       in 
-			 if pos1 < pos2 
-			   then if pos2 < (pos1 + size1) 
-				  then SOME LESS
-				  else NONE
-			   else if pos1 < (pos2 + size2)
-				  then SOME GREATER
-				  else NONE
-		       end
-		       handle Overflow => NONE)
-	           | _ => SOME EQUAL
-	  end
+        = fn ({immIndex = immIndex1, size = size1},
+              {immIndex = immIndex2, size = size2})
+           => let
+                val size1 = Size.toBytes size1
+                val size2 = Size.toBytes size2
+              in
+                case (Immediate.eval (case immIndex1
+                                        of NONE => Immediate.const_int 0
+                                         | SOME immIndex => immIndex),
+                      Immediate.eval (case immIndex2
+                                        of NONE => Immediate.const_int 0
+                                         | SOME immIndex => immIndex))
+                  of (SOME pos1, SOME pos2)
+                   => (let
+                         val pos1 = Word.toInt pos1
+                         val pos2 = Word.toInt pos2
+                       in 
+                         if pos1 < pos2 
+                           then if pos2 < (pos1 + size1) 
+                                  then SOME LESS
+                                  else NONE
+                           else if pos1 < (pos2 + size2)
+                                  then SOME GREATER
+                                  else NONE
+                       end
+                       handle Overflow => NONE)
+                   | _ => SOME EQUAL
+          end
       and mayAliasOrdU
-	= fn (U {immBase = SOME immBase1, memBase = NONE,
-		 immIndex = immIndex1, memIndex = NONE,
-		 size = size1, ...},
-	      U {immBase = SOME immBase2, memBase = NONE,
-		 immIndex = immIndex2, memIndex = NONE,
-		 size = size2, ...})
-	   => if Immediate.eq(immBase1, immBase2)
-		then mayAliasOrdImmIndex ({immIndex = immIndex1, 
-					   size = size1},
-					  {immIndex = immIndex2,
-					   size = size2})
-		else NONE
-	   | (U {immBase = SOME immBase1, memBase = NONE,
-		 immIndex = immIndex1, memIndex = SOME memIndex1,
-		 size = size1, ...},
-	      U {immBase = SOME immBase2, memBase = NONE,
-		 immIndex = immIndex2, memIndex = SOME memIndex2,
-		 size = size2, ...})
-	   => if Immediate.eq(immBase1, immBase2)
-		then if not (eq(memIndex1, memIndex2))
-		       then SOME EQUAL
-		       else mayAliasOrdImmIndex ({immIndex = immIndex1,
-						  size = size1},
-						 {immIndex = immIndex2,
-						  size = size2})
-		else NONE
-	   | (U {immBase = NONE, memBase = SOME memBase1,
-		 immIndex = immIndex1, memIndex = NONE,
-		 size = size1, ...},
-	      U {immBase = NONE, memBase = SOME memBase2,
-		 immIndex = immIndex2, memIndex = NONE,
-		 size = size2, ...})
-	   => if not (eq(memBase1, memBase2))
-		then SOME EQUAL
-		else mayAliasOrdImmIndex ({immIndex = immIndex1,
-					   size = size1},
-					  {immIndex = immIndex2,
-					   size = size2})
-	   | (U {immBase = NONE, memBase = SOME memBase1,
-		 immIndex = immIndex1, memIndex = SOME memIndex1,
-		 size = size1, ...},
-	      U {immBase = NONE, memBase = SOME memBase2,
-		 immIndex = immIndex2, memIndex = SOME memIndex2,
-		 size = size2, ...})
-	   => if (not (eq(memBase1, memBase2))
-		  orelse
-		  not (eq(memIndex1, memIndex2)))
-		then SOME EQUAL
-		else mayAliasOrdImmIndex ({immIndex = immIndex1,
-					   size = size1},
-					  {immIndex = immIndex2,
-					   size = size2})
-	   | _ => SOME EQUAL
+        = fn (U {immBase = SOME immBase1, memBase = NONE,
+                 immIndex = immIndex1, memIndex = NONE,
+                 size = size1, ...},
+              U {immBase = SOME immBase2, memBase = NONE,
+                 immIndex = immIndex2, memIndex = NONE,
+                 size = size2, ...})
+           => if Immediate.eq(immBase1, immBase2)
+                then mayAliasOrdImmIndex ({immIndex = immIndex1, 
+                                           size = size1},
+                                          {immIndex = immIndex2,
+                                           size = size2})
+                else NONE
+           | (U {immBase = SOME immBase1, memBase = NONE,
+                 immIndex = immIndex1, memIndex = SOME memIndex1,
+                 size = size1, ...},
+              U {immBase = SOME immBase2, memBase = NONE,
+                 immIndex = immIndex2, memIndex = SOME memIndex2,
+                 size = size2, ...})
+           => if Immediate.eq(immBase1, immBase2)
+                then if not (eq(memIndex1, memIndex2))
+                       then SOME EQUAL
+                       else mayAliasOrdImmIndex ({immIndex = immIndex1,
+                                                  size = size1},
+                                                 {immIndex = immIndex2,
+                                                  size = size2})
+                else NONE
+           | (U {immBase = NONE, memBase = SOME memBase1,
+                 immIndex = immIndex1, memIndex = NONE,
+                 size = size1, ...},
+              U {immBase = NONE, memBase = SOME memBase2,
+                 immIndex = immIndex2, memIndex = NONE,
+                 size = size2, ...})
+           => if not (eq(memBase1, memBase2))
+                then SOME EQUAL
+                else mayAliasOrdImmIndex ({immIndex = immIndex1,
+                                           size = size1},
+                                          {immIndex = immIndex2,
+                                           size = size2})
+           | (U {immBase = NONE, memBase = SOME memBase1,
+                 immIndex = immIndex1, memIndex = SOME memIndex1,
+                 size = size1, ...},
+              U {immBase = NONE, memBase = SOME memBase2,
+                 immIndex = immIndex2, memIndex = SOME memIndex2,
+                 size = size2, ...})
+           => if (not (eq(memBase1, memBase2))
+                  orelse
+                  not (eq(memIndex1, memIndex2)))
+                then SOME EQUAL
+                else mayAliasOrdImmIndex ({immIndex = immIndex1,
+                                           size = size1},
+                                          {immIndex = immIndex2,
+                                           size = size2})
+           | _ => SOME EQUAL
       and mayAliasOrd
-	= fn (T {memloc = memloc1 as U {class = class1, ...}, ...},
-	      T {memloc = memloc2 as U {class = class2, ...}, ...})
-	   => if Class.mayAlias(class1, class2) 
-		then mayAliasOrdU(memloc1, memloc2)
-		else NONE
+        = fn (T {memloc = memloc1 as U {class = class1, ...}, ...},
+              T {memloc = memloc2 as U {class = class2, ...}, ...})
+           => if Class.mayAlias(class1, class2) 
+                then mayAliasOrdU(memloc1, memloc2)
+                else NONE
 
       val compare
-	= fn (T {counter = counter1, ...},
-	      T {counter = counter2, ...})
-	   => Int.compare(counter1, counter2)
+        = fn (T {counter = counter1, ...},
+              T {counter = counter2, ...})
+           => Int.compare(counter1, counter2)
 
       fun replaceMem replacer
-	= fn NONE => NONE
-	   | SOME mem => SOME (replace replacer mem)
+        = fn NONE => NONE
+           | SOME mem => SOME (replace replacer mem)
       and replaceU replacer
-	= fn memloc as T {memloc = U {immBase, memBase, immIndex, memIndex,
-				      scale, size, class}, ...}
-	   => let
-		val memBase' = replaceMem replacer memBase
-		val memIndex' = replaceMem replacer memIndex
-	      in 
-		if eqMem(memBase, memBase') andalso eqMem(memIndex, memIndex')
-		  then memloc
-		  else construct (U {immBase = immBase,
-				     memBase = memBase',
-				     immIndex = immIndex,
-				     memIndex = memIndex',
-				     scale = scale,
-				     size = size,
-				     class = class})
-	      end
+        = fn memloc as T {memloc = U {immBase, memBase, immIndex, memIndex,
+                                      scale, size, class}, ...}
+           => let
+                val memBase' = replaceMem replacer memBase
+                val memIndex' = replaceMem replacer memIndex
+              in 
+                if eqMem(memBase, memBase') andalso eqMem(memIndex, memIndex')
+                  then memloc
+                  else construct (U {immBase = immBase,
+                                     memBase = memBase',
+                                     immIndex = immIndex,
+                                     memIndex = memIndex',
+                                     scale = scale,
+                                     size = size,
+                                     class = class})
+              end
       and replace replacer
-	= fn memloc 
-	   => let
-		val memloc' = replacer memloc
-	      in
-		if eq(memloc', memloc)
-		  then replaceU replacer memloc
-		  else memloc'
-	      end
-	    
+        = fn memloc 
+           => let
+                val memloc' = replacer memloc
+              in
+                if eq(memloc', memloc)
+                  then replaceU replacer memloc
+                  else memloc'
+              end
+            
       val rec sizeU = fn U {size, ...} => size
       and size = fn T {memloc, ...} => sizeU memloc
       val rec classU = fn U {class, ...} => class
       and class = fn T {memloc, ...} => classU memloc
 
       val imm = fn {base, index, scale, size, class} 
-	=> construct (U {immBase = SOME base,
-			 memBase = NONE,
-			 immIndex = SOME (Immediate.binexp
-					  {oper = Immediate.Multiplication,
-					   exp1 = index,
-					   exp2 = Scale.toImmediate scale}),
-			 memIndex = NONE,
-			 scale = scale,
-			 size = size,
-			 class = class})
+        => construct (U {immBase = SOME base,
+                         memBase = NONE,
+                         immIndex = SOME (Immediate.binexp
+                                          {oper = Immediate.Multiplication,
+                                           exp1 = index,
+                                           exp2 = Scale.toImmediate scale}),
+                         memIndex = NONE,
+                         scale = scale,
+                         size = size,
+                         class = class})
       val basic = fn {base, index, scale, size, class} 
-	=> construct (U {immBase = SOME base,
-			 memBase = NONE,
-			 immIndex = NONE,
-			 memIndex = SOME index, 
-			 scale = scale,
-			 size = size,
-			 class = class})
+        => construct (U {immBase = SOME base,
+                         memBase = NONE,
+                         immIndex = NONE,
+                         memIndex = SOME index, 
+                         scale = scale,
+                         size = size,
+                         class = class})
       val simple = fn {base, index, scale, size, class} 
-	=> construct (U {immBase = NONE,
-			 memBase = SOME base,
-			 immIndex 
-			 = SOME (Immediate.binexp
-				 {oper = Immediate.Multiplication,
-				  exp1 = index,
-				  exp2 = Scale.toImmediate scale}),
-			 memIndex = NONE,
-			 scale = scale,
-			 size = size,
-			 class = class})
+        => construct (U {immBase = NONE,
+                         memBase = SOME base,
+                         immIndex 
+                         = SOME (Immediate.binexp
+                                 {oper = Immediate.Multiplication,
+                                  exp1 = index,
+                                  exp2 = Scale.toImmediate scale}),
+                         memIndex = NONE,
+                         scale = scale,
+                         size = size,
+                         class = class})
 
       val complex = fn {base, index, scale, size, class} 
-	=> construct (U {immBase = NONE,
-			 memBase = SOME base,
-			 immIndex = NONE,
-			 memIndex = SOME index,
-			 scale = scale,
-			 size = size,
-			 class = class})
+        => construct (U {immBase = NONE,
+                         memBase = SOME base,
+                         immIndex = NONE,
+                         memIndex = SOME index,
+                         scale = scale,
+                         size = size,
+                         class = class})
       val shift = fn {origin, disp, scale, size} 
-        => let	
-	      val disp =
-		 Immediate.binexp
-		 {oper = Immediate.Multiplication,
-		  exp1 = disp,
-		  exp2 = Scale.toImmediate scale}
-	      val U {immBase, memBase, 
-		     immIndex, memIndex, 
-		     scale, class, ...} =
-		 destruct origin
-	   in
-	      construct (U {immBase = immBase,
-			    memBase = memBase,
-			    immIndex = 
-			    case immIndex of
-			       NONE => SOME disp
-			     | SOME immIndex => SOME (Immediate.binexp
-						      {oper = Immediate.Addition,
-						       exp1 = immIndex,
-						       exp2 = disp}),
-			    memIndex = memIndex,
-			    scale = scale,
-			    size = size,
-			    class = class})
-	   end
+        => let  
+              val disp =
+                 Immediate.binexp
+                 {oper = Immediate.Multiplication,
+                  exp1 = disp,
+                  exp2 = Scale.toImmediate scale}
+              val U {immBase, memBase, 
+                     immIndex, memIndex, 
+                     scale, class, ...} =
+                 destruct origin
+           in
+              construct (U {immBase = immBase,
+                            memBase = memBase,
+                            immIndex = 
+                            case immIndex of
+                               NONE => SOME disp
+                             | SOME immIndex => SOME (Immediate.binexp
+                                                      {oper = Immediate.Addition,
+                                                       exp1 = immIndex,
+                                                       exp2 = disp}),
+                            memIndex = memIndex,
+                            scale = scale,
+                            size = size,
+                            class = class})
+           end
 
       local
-	val num : int ref = ref 0
+        val num : int ref = ref 0
       in
-	val temp = fn {size} => (Int.inc num;
-				 imm {base = Immediate.const_int 0,
-				      index = Immediate.const_int (!num),
-				      scale = Scale.One,
-				      size = size,
-				      class = Class.Temp})
+        val temp = fn {size} => (Int.inc num;
+                                 imm {base = Immediate.const_int 0,
+                                      index = Immediate.const_int (!num),
+                                      scale = Scale.One,
+                                      size = size,
+                                      class = Class.Temp})
       end
 
       (*
        * Static memory locations
        *)
       fun makeContents {base, size, class}
-	= imm {base = base,
-	       index = Immediate.const_int 0,
-	       scale = Scale.Four,
-	       size = size,
-	       class = class}
+        = imm {base = base,
+               index = Immediate.const_int 0,
+               scale = Scale.Four,
+               size = size,
+               class = class}
 (*
       local
-	datatype z = datatype CType.t
-	datatype z = datatype Size.t
+        datatype z = datatype CType.t
+        datatype z = datatype Size.t
       in
-	 fun cReturnTempContents sizes =
-	    (List.rev o #1)
-	    (List.fold
-	     (sizes, ([],0), fn (size, (contents, index)) =>
-	      ((cReturnTempContent (index, size))::contents,
-	       index + Size.toBytes size)))
-	 fun cReturnTempContent size =
-	    List.first(cReturnTempContents [size])
-	 val cReturnTempContents = fn size =>
-	    cReturnTempContents (
-	    case size of
-	       Int s => let datatype z = datatype IntSize.t
-			in case s of
-			     I8 => [BYTE]
-			   | I16 => [WORD]
-			   | I32 => [LONG]
-			   | I64 => [LONG, LONG]
-			end
-	     | Pointer => [LONG]
-	     | Real s => let datatype z = datatype RealSize.t
-			 in case s of
-			      R32 => [SNGL]
-			    | R64 => [DBLE]
-			 end
-	     | Word s => let datatype z = datatype WordSize.t
-			 in case s of
-			      W8 => [BYTE]
-			    | W16 => [WORD]
-			    | W32 => [LONG]
-			 end)
+         fun cReturnTempContents sizes =
+            (List.rev o #1)
+            (List.fold
+             (sizes, ([],0), fn (size, (contents, index)) =>
+              ((cReturnTempContent (index, size))::contents,
+               index + Size.toBytes size)))
+         fun cReturnTempContent size =
+            List.first(cReturnTempContents [size])
+         val cReturnTempContents = fn size =>
+            cReturnTempContents (
+            case size of
+               Int s => let datatype z = datatype IntSize.t
+                        in case s of
+                             I8 => [BYTE]
+                           | I16 => [WORD]
+                           | I32 => [LONG]
+                           | I64 => [LONG, LONG]
+                        end
+             | Pointer => [LONG]
+             | Real s => let datatype z = datatype RealSize.t
+                         in case s of
+                              R32 => [SNGL]
+                            | R64 => [DBLE]
+                         end
+             | Word s => let datatype z = datatype WordSize.t
+                         in case s of
+                              W8 => [BYTE]
+                            | W16 => [WORD]
+                            | W32 => [LONG]
+                         end)
       end
 *)
     end
@@ -1264,22 +1257,22 @@
   local
     structure ClassElement =
       struct
-	type t = MemLoc.Class.t
-	val compare = MemLoc.Class.compare
-	local
-	  fun make f = fn (a, b) => f (MemLoc.Class.counter a, MemLoc.Class.counter b)
-	in
-	  val op < = make Int.<
-	  val op > = make Int.>
-	  val op >= = make Int.>=
-	  val op <= = make Int.<=
-	end
-	val min = fn (a, b) => if Int.<(MemLoc.Class.counter a, MemLoc.Class.counter b)
-				 then a
-				 else b
-	val max = fn (a, b) => min (b, a)
-	val equals = MemLoc.Class.eq
-	val layout = MemLoc.Class.layout
+        type t = MemLoc.Class.t
+        val compare = MemLoc.Class.compare
+        local
+          fun make f = fn (a, b) => f (MemLoc.Class.counter a, MemLoc.Class.counter b)
+        in
+          val op < = make Int.<
+          val op > = make Int.>
+          val op >= = make Int.>=
+          val op <= = make Int.<=
+        end
+        val min = fn (a, b) => if Int.<(MemLoc.Class.counter a, MemLoc.Class.counter b)
+                                 then a
+                                 else b
+        val max = fn (a, b) => min (b, a)
+        val equals = MemLoc.Class.eq
+        val layout = MemLoc.Class.layout
       end
   in
     structure ClassSet = OrderedUniqueSet(open ClassElement)
@@ -1287,24 +1280,24 @@
   local 
     structure MemLocElement =
       struct
-	type t = MemLoc.t	
-	val equals = MemLoc.eq
-	val layout = MemLoc.layout
+        type t = MemLoc.t       
+        val equals = MemLoc.eq
+        val layout = MemLoc.layout
 (*
-	val compare = MemLoc.compare
-	local
-	  fun make f = fn (a, b) => f (MemLoc.counter a, MemLoc.counter b)
-	in
-	  val op < = make Int.<
-	  val op > = make Int.>
-	  val op >= = make Int.>=
-	  val op <= = make Int.<=
-	end
-	val min = fn (a, b) => if Int.<(MemLoc.counter a, MemLoc.counter b)
-				 then a
-				 else b
-	val max = fn (a, b) => min (b, a)
-	val hash = MemLoc.hash
+        val compare = MemLoc.compare
+        local
+          fun make f = fn (a, b) => f (MemLoc.counter a, MemLoc.counter b)
+        in
+          val op < = make Int.<
+          val op > = make Int.>
+          val op >= = make Int.>=
+          val op <= = make Int.<=
+        end
+        val min = fn (a, b) => if Int.<(MemLoc.counter a, MemLoc.counter b)
+                                 then a
+                                 else b
+        val max = fn (a, b) => min (b, a)
+        val hash = MemLoc.hash
 *)
       end
   in
@@ -1315,77 +1308,77 @@
 (*
     structure MemLocSet' = UnorderedSet(open MemLocElement)
     structure MemLocSet = HashedUniqueSet(structure Set = MemLocSet'
-					  structure Element = MemLocElement)
+                                          structure Element = MemLocElement)
 *)
   end
 
   structure Operand =
     struct
       datatype t
-	= Register of Register.t
-	| FltRegister of FltRegister.t
-	| Immediate of Immediate.t
-	| Label of Label.t
-	| Address of Address.t
-	| MemLoc of MemLoc.t
+        = Register of Register.t
+        | FltRegister of FltRegister.t
+        | Immediate of Immediate.t
+        | Label of Label.t
+        | Address of Address.t
+        | MemLoc of MemLoc.t
 
       val size
-	= fn Register r => SOME (Register.size r)
-	   | FltRegister _ => SOME Size.EXTD
-	   | Immediate _ => NONE
-	   | Label _ => NONE
-	   | Address _ => NONE
-	   | MemLoc m => SOME (MemLoc.size m)
+        = fn Register r => SOME (Register.size r)
+           | FltRegister _ => SOME Size.EXTD
+           | Immediate _ => NONE
+           | Label _ => NONE
+           | Address _ => NONE
+           | MemLoc m => SOME (MemLoc.size m)
 
       val layout
-	= let
-	    open Layout
-	  in 
-	    fn Register r => Register.layout r
-	     | FltRegister f => FltRegister.layout f
-	     | Immediate i => seq [str "$", Immediate.layout i]
-	     | Label l => Label.layout l
-	     | Address a => Address.layout a
-	     | MemLoc m => MemLoc.layout m
-	  end
+        = let
+            open Layout
+          in 
+            fn Register r => Register.layout r
+             | FltRegister f => FltRegister.layout f
+             | Immediate i => seq [str "$", Immediate.layout i]
+             | Label l => Label.layout l
+             | Address a => Address.layout a
+             | MemLoc m => MemLoc.layout m
+          end
       val toString = Layout.toString o layout
 
       val eq
-	= fn (Register r1,    Register r2)    => Register.eq(r1, r2)
-	   | (FltRegister f1, FltRegister f2) => FltRegister.eq(f1, f2)
-	   | (Immediate i1,   Immediate i2)   => Immediate.eq(i1, i2)
-	   | (Label l1,       Label l2)       => Label.equals(l1, l2)
-	   | (Address a1,     Address a2)     => Address.eq(a1, a2)
-	   | (MemLoc m1,      MemLoc m2)      => MemLoc.eq(m1, m2)
-	   | _                                => false
+        = fn (Register r1,    Register r2)    => Register.eq(r1, r2)
+           | (FltRegister f1, FltRegister f2) => FltRegister.eq(f1, f2)
+           | (Immediate i1,   Immediate i2)   => Immediate.eq(i1, i2)
+           | (Label l1,       Label l2)       => Label.equals(l1, l2)
+           | (Address a1,     Address a2)     => Address.eq(a1, a2)
+           | (MemLoc m1,      MemLoc m2)      => MemLoc.eq(m1, m2)
+           | _                                => false
 
       val mayAlias
-	= fn (Register r1,    Register r2)    => Register.eq(r1, r2)
-	   | (Register r1,    _)              => false
-	   | (FltRegister f1, FltRegister f2) => FltRegister.eq(f1, f2)
-	   | (FltRegister f1, _)              => false
-	   | (Immediate i1,   Immediate i2)   => Immediate.eq(i1, i2)
-           | (Immediate i1,   _)              => false
-	   | (Label l1,       Label l2)       => Label.equals(l1, l2)
-	   | (Label l1,       _)              => false
-	   | (Address a1,     Address a2)     => true
-	   | (Address a1,     MemLoc m2)      => true
-           | (Address a1,     _)              => false
-	   | (MemLoc m1,      MemLoc m2)      => MemLoc.mayAlias(m1, m2)
-	   | (MemLoc m1,      Address a2)     => true
-	   | (MemLoc m1,      _)              => false
+        = fn (Register r1,    Register r2)    => Register.eq(r1, r2)
+           | (Register _,     _)              => false
+           | (FltRegister f1, FltRegister f2) => FltRegister.eq(f1, f2)
+           | (FltRegister _,  _)              => false
+           | (Immediate i1,   Immediate i2)   => Immediate.eq(i1, i2)
+           | (Immediate _,    _)              => false
+           | (Label l1,       Label l2)       => Label.equals(l1, l2)
+           | (Label _,        _)              => false
+           | (Address _,      Address _)      => true
+           | (Address _,      MemLoc _)       => true
+           | (Address _,      _)              => false
+           | (MemLoc m1,      MemLoc m2)      => MemLoc.mayAlias(m1, m2)
+           | (MemLoc _,       Address _)      => true
+           | (MemLoc _,       _)              => false
 
       val register = Register
       val deRegister
-	= fn Register x => SOME x
+        = fn Register x => SOME x
            | _ => NONE
       val fltregister = FltRegister
       val deFltregister
-	= fn FltRegister x => SOME x
-	   | _ => NONE
+        = fn FltRegister x => SOME x
+           | _ => NONE
       val immediate = Immediate
       val deImmediate
-	= fn Immediate x => SOME x
+        = fn Immediate x => SOME x
            | _ => NONE
       val immediate_const = immediate o Immediate.const
       val immediate_const_char = immediate o Immediate.const_char
@@ -1394,56 +1387,56 @@
       val immediate_label = immediate o Immediate.label
       val label = Label
       val deLabel
-	= fn Label x => SOME x
-	   | _ => NONE
+        = fn Label x => SOME x
+           | _ => NONE
       val address = Address
       val memloc = MemLoc
       val deMemloc 
-	= fn MemLoc x => SOME x
+        = fn MemLoc x => SOME x
            | _ => NONE
 
       local
-	val cReturnTemp = Label.fromString "cReturnTemp"
-	fun cReturnTempContent (index, size) =
-	   MemLoc.imm
-	   {base = Immediate.label cReturnTemp,
-	    index = Immediate.const_int index,
-	    scale = Scale.One,
-	    size = size,
-	    class = MemLoc.Class.StaticTemp}
-	 datatype z = datatype CType.t
-	 datatype z = datatype Size.t
+        val cReturnTemp = Label.fromString "cReturnTemp"
+        fun cReturnTempContent (index, size) =
+           MemLoc.imm
+           {base = Immediate.label cReturnTemp,
+            index = Immediate.const_int index,
+            scale = Scale.One,
+            size = size,
+            class = MemLoc.Class.StaticTemp}
+         datatype z = datatype CType.t
+         datatype z = datatype Size.t
       in
-	 fun cReturnTemps ty =
-	    if RepType.isUnit ty
-	       then []
-	    else
-	       let
-		  fun w (r, s) =
-		     [{src = register r, dst = cReturnTempContent (0, s)}]
-		  val w8 = w (Register.al, BYTE)
-		  val w16 = w (Register.ax, WORD)
-		  val w32 = w (Register.eax, LONG)
-		  val w64 =[{src = register Register.eax,
-			     dst = cReturnTempContent (0, LONG)},
-			    {src = register Register.edx,
-			     dst = cReturnTempContent (4, LONG)}]
-	       in
-		  case RepType.toCType ty of
-		     Int8 => w8
-		   | Int16 => w16
-		   | Int32 => w32
-		   | Int64 => w64
-		   | Pointer => w32
-		   | Real32 => [{src = fltregister FltRegister.top,
-				 dst = cReturnTempContent (0, SNGL)}]
-		   | Real64 => [{src = fltregister FltRegister.top,
-				 dst = cReturnTempContent (0, DBLE)}]
-		   | Word8 => w8
-		   | Word16 => w16
-		   | Word32 => w32
-		   | Word64 => w64
-	       end
+         fun cReturnTemps ty =
+            if RepType.isUnit ty
+               then []
+            else
+               let
+                  fun w (r, s) =
+                     [{src = register r, dst = cReturnTempContent (0, s)}]
+                  val w8 = w (Register.al, BYTE)
+                  val w16 = w (Register.ax, WORD)
+                  val w32 = w (Register.eax, LONG)
+                  val w64 =[{src = register Register.eax,
+                             dst = cReturnTempContent (0, LONG)},
+                            {src = register Register.edx,
+                             dst = cReturnTempContent (4, LONG)}]
+               in
+                  case RepType.toCType ty of
+                     Int8 => w8
+                   | Int16 => w16
+                   | Int32 => w32
+                   | Int64 => w64
+                   | Pointer => w32
+                   | Real32 => [{src = fltregister FltRegister.top,
+                                 dst = cReturnTempContent (0, SNGL)}]
+                   | Real64 => [{src = fltregister FltRegister.top,
+                                 dst = cReturnTempContent (0, DBLE)}]
+                   | Word8 => w8
+                   | Word16 => w16
+                   | Word32 => w32
+                   | Word64 => w64
+               end
       end
     end
 
@@ -1451,7 +1444,7 @@
     struct
       (* Integer binary arithmetic(w/o mult & div)/logic instructions. *)
       datatype binal
-	= ADD (* signed/unsigned addition; p. 63 *)
+        = ADD (* signed/unsigned addition; p. 63 *)
         | ADC (* signed/unsigned addition with carry; p. 61 *)
         | SUB (* signed/unsigned subtraction; p. 713 *)
         | SBB (* signed/unsigned subtraction with borrow; p. 667 *)
@@ -1459,131 +1452,131 @@
         | OR  (* logical or; p. 499 *)
         | XOR (* logical xor; p. 758 *)
       val binal_layout
-	= let
-	    open Layout
-	  in 
-	    fn ADD => str "add"
-	     | ADC => str "adc"
-	     | SUB => str "sub"
-	     | SBB => str "sbb"
-	     | AND => str "and"
-	     | OR  => str "or"
-	     | XOR => str "xor"
-	  end
+        = let
+            open Layout
+          in 
+            fn ADD => str "add"
+             | ADC => str "adc"
+             | SUB => str "sub"
+             | SBB => str "sbb"
+             | AND => str "and"
+             | OR  => str "or"
+             | XOR => str "xor"
+          end
 
       (* Integer multiplication and division. *)
       datatype md
-	= IMUL (* signed multiplication (one operand form); p. 335 *)
+        = IMUL (* signed multiplication (one operand form); p. 335 *)
         | MUL  (* unsigned multiplication; p. 488 *)
-	| IDIV (* signed division; p. 332 *)
-	| DIV  (* unsigned division; p. 188 *)
-	| IMOD (* signed modulus; *)
-	| MOD  (* unsigned modulus; *)
+        | IDIV (* signed division; p. 332 *)
+        | DIV  (* unsigned division; p. 188 *)
+        | IMOD (* signed modulus; *)
+        | MOD  (* unsigned modulus; *)
       val md_layout
-	= let
-	    open Layout
-	  in 
-	    fn IMUL => str "imul"
-	     | MUL  => str "mul"
-	     | IDIV => str "idiv"
-	     | DIV  => str "div"
-	     | IMOD => str "imod"
-	     | MOD  => str "mod"
-	  end
+        = let
+            open Layout
+          in 
+            fn IMUL => str "imul"
+             | MUL  => str "mul"
+             | IDIV => str "idiv"
+             | DIV  => str "div"
+             | IMOD => str "imod"
+             | MOD  => str "mod"
+          end
 
       (* Integer unary arithmetic/logic instructions. *)
       datatype unal
-	= INC (* increment by 1; p. 341 *)
-	| DEC (* decrement by 1; p. 186 *)
-	| NEG (* two's complement negation; p. 494 *)
-	| NOT (* one's complement negation; p. 497 *)
+        = INC (* increment by 1; p. 341 *)
+        | DEC (* decrement by 1; p. 186 *)
+        | NEG (* two's complement negation; p. 494 *)
+        | NOT (* one's complement negation; p. 497 *)
       val unal_layout
-	= let
-	    open Layout
-	  in 
-	    fn INC => str "inc"
-	     | DEC => str "dec"
-	     | NEG => str "neg"
-	     | NOT => str "not"
-	  end
-	    
+        = let
+            open Layout
+          in 
+            fn INC => str "inc"
+             | DEC => str "dec"
+             | NEG => str "neg"
+             | NOT => str "not"
+          end
+            
       (* Integer shift/rotate arithmetic/logic instructions. *)
       datatype sral
-	= SAL (* shift arithmetic left; p. 662 *)
-	| SHL (* shift logical left; p. 662 *)
-	| SAR (* shift arithmetic right; p. 662 *)
-	| SHR (* shift logical right; p. 662 *)
-	| ROL (* rotate left; p. 631 *)
-	| RCL (* rotate through carry left; p. 631 *)
-	| ROR (* rotate right; p. 631 *)
-	| RCR (* rotate through carry right; p. 631 *)
+        = SAL (* shift arithmetic left; p. 662 *)
+        | SHL (* shift logical left; p. 662 *)
+        | SAR (* shift arithmetic right; p. 662 *)
+        | SHR (* shift logical right; p. 662 *)
+        | ROL (* rotate left; p. 631 *)
+        | RCL (* rotate through carry left; p. 631 *)
+        | ROR (* rotate right; p. 631 *)
+        | RCR (* rotate through carry right; p. 631 *)
       val sral_layout 
-	= let
-	    open Layout
-	  in 
-	    fn SAL => str "sal"
-	     | SHL => str "shl"
-	     | SAR => str "sar"
-	     | SHR => str "shr"
-	     | ROL => str "rol"
-	     | RCL => str "rcl"
-	     | ROR => str "ror"
-	     | RCR => str "rcr"
-	  end
+        = let
+            open Layout
+          in 
+            fn SAL => str "sal"
+             | SHL => str "shl"
+             | SAR => str "sar"
+             | SHR => str "shr"
+             | ROL => str "rol"
+             | RCL => str "rcl"
+             | ROR => str "ror"
+             | RCR => str "rcr"
+          end
 
       (* Move with extention instructions. *)
       datatype movx
-	= MOVSX (* move with sign extention; p. 481 *)
-	| MOVZX (* move with zero extention; p. 486 *)
+        = MOVSX (* move with sign extention; p. 481 *)
+        | MOVZX (* move with zero extention; p. 486 *)
       val movx_layout
-	= let
-	    open Layout
-	  in 
-	    fn MOVSX => str "movs"
-	     | MOVZX => str "movz"
-	  end
+        = let
+            open Layout
+          in 
+            fn MOVSX => str "movs"
+             | MOVZX => str "movz"
+          end
 
       (* Condition test field; p. 795 *)
       datatype condition
-	= O   (* overflow *)       | NO  (* not overflow *)
-	| B   (* below *)          | NB  (* not below *)
-	| AE  (* above or equal *) | NAE (* not above or equal *)
-	| C   (* carry *)          | NC  (* not carry *)
-	| E   (* equal *)          | NE  (* not equal *)
-	| Z   (* zero *)           | NZ  (* not zero *)
-	| BE  (* below or equal *) | NBE (* not below or equal *)
-	| A   (* above *)          | NA  (* not above *)
-	| S   (* sign *)           | NS  (* not sign *)
-	| P   (* parity *)         | NP  (* not parity *)
-	| PE  (* parity even *)    | PO  (* parity odd *)
-	| L   (* less than *)      
-	| NL  (* not less than *)
-	| LE  (* less than or equal *) 
-	| NLE (* not less than or equal *)
-	| G   (* greater than *)   
-	| NG  (* not greater than *)
-	| GE  (* greater than or equal *) 
-	| NGE (* not greater than or equal *)
+        = O   (* overflow *)       | NO  (* not overflow *)
+        | B   (* below *)          | NB  (* not below *)
+        | AE  (* above or equal *) | NAE (* not above or equal *)
+        | C   (* carry *)          | NC  (* not carry *)
+        | E   (* equal *)          | NE  (* not equal *)
+        | Z   (* zero *)           | NZ  (* not zero *)
+        | BE  (* below or equal *) | NBE (* not below or equal *)
+        | A   (* above *)          | NA  (* not above *)
+        | S   (* sign *)           | NS  (* not sign *)
+        | P   (* parity *)         | NP  (* not parity *)
+        | PE  (* parity even *)    | PO  (* parity odd *)
+        | L   (* less than *)      
+        | NL  (* not less than *)
+        | LE  (* less than or equal *) 
+        | NLE (* not less than or equal *)
+        | G   (* greater than *)   
+        | NG  (* not greater than *)
+        | GE  (* greater than or equal *) 
+        | NGE (* not greater than or equal *)
 
       val condition_negate
-	= fn O   => NO  | NO  => O
+        = fn O   => NO  | NO  => O
            | B   => NB  | NB  => B
-	   | AE  => NAE | NAE => AE
-	   | C   => NC  | NC  => C
-	   | E   => NE  | NE  => E
-	   | Z   => NZ  | NZ  => Z
-	   | BE  => NBE | NBE => BE
-	   | A   => NA  | NA  => A
-	   | S   => NS  | NS  => S
-	   | P   => NP  | NP  => P
-	   | PE  => PO  | PO  => PE
-	   | L   => NL  | NL  => L
-	   | LE  => NLE | NLE => LE
-	   | G   => NG  | NG  => G
-	   | GE  => NGE | NGE => GE
+           | AE  => NAE | NAE => AE
+           | C   => NC  | NC  => C
+           | E   => NE  | NE  => E
+           | Z   => NZ  | NZ  => Z
+           | BE  => NBE | NBE => BE
+           | A   => NA  | NA  => A
+           | S   => NS  | NS  => S
+           | P   => NP  | NP  => P
+           | PE  => PO  | PO  => PE
+           | L   => NL  | NL  => L
+           | LE  => NLE | NLE => LE
+           | G   => NG  | NG  => G
+           | GE  => NGE | NGE => GE
 
       val condition_reverse
-	= fn B   => A   | NB  => NA
+        = fn B   => A   | NB  => NA
            | AE  => BE  | NAE => NBE
            | E   => E   | NE  => NE
            | BE  => AE  | NBE => NAE
@@ -1593,129 +1586,129 @@
            | G   => L   | NG  => NL
            | GE  => LE  | NGE => NLE
            | c   => c
-	
+        
       local 
-	open Layout
+        open Layout
       in
-	val rec condition_layout
-	= fn O  => str "o"
+        val rec condition_layout
+        = fn O  => str "o"
            | B  => str "b"
-	   | AE => str "ae"
-	   | C  => str "c"
-	   | E  => str "e"
-	   | Z  => str "z"
-	   | BE => str "be"
-	   | A  => str "a"
-	   | S  => str "s"
-	   | P  => str "p"
-	   | PE => str "pe"
-	   | PO => str "po"
-	   | L  => str "l"
-	   | LE => str "le"
-	   | G  => str "g"
-	   | GE => str "ge"
-	   | c  => seq [str "n", condition_layout (condition_negate c)]
+           | AE => str "ae"
+           | C  => str "c"
+           | E  => str "e"
+           | Z  => str "z"
+           | BE => str "be"
+           | A  => str "a"
+           | S  => str "s"
+           | P  => str "p"
+           | PE => str "pe"
+           | PO => str "po"
+           | L  => str "l"
+           | LE => str "le"
+           | G  => str "g"
+           | GE => str "ge"
+           | c  => seq [str "n", condition_layout (condition_negate c)]
       end
       val condition_toString = Layout.toString o condition_layout
 
       (* Floating-point binary arithmetic instructions. *)
       datatype fbina
-	= FADD  (* addition; p. 205 *)
+        = FADD  (* addition; p. 205 *)
         | FSUB  (* subtraction; p. 297 *)
-	| FSUBR (* reversed subtraction; p. 301 *)
-	| FMUL  (* multiplication; p. 256 *)
-	| FDIV  (* division; p. 229 *)
-	| FDIVR (* reversed division; p. 233 *)
+        | FSUBR (* reversed subtraction; p. 301 *)
+        | FMUL  (* multiplication; p. 256 *)
+        | FDIV  (* division; p. 229 *)
+        | FDIVR (* reversed division; p. 233 *)
       val fbina_layout
-	= let
-	    open Layout
-	  in 
-	    fn FADD => str "fadd"
-	     | FSUB => str "fsub"
-	     | FSUBR => str "fsubr"
-	     | FMUL => str "fmul"
-	     | FDIV => str "fdiv"
-	     | FDIVR => str "fdivr"
-	  end
+        = let
+            open Layout
+          in 
+            fn FADD => str "fadd"
+             | FSUB => str "fsub"
+             | FSUBR => str "fsubr"
+             | FMUL => str "fmul"
+             | FDIV => str "fdiv"
+             | FDIVR => str "fdivr"
+          end
       val fbina_reverse
-	= fn FADD  => FADD
+        = fn FADD  => FADD
            | FSUB  => FSUBR
-	   | FSUBR => FSUB
-	   | FMUL  => FMUL
-	   | FDIV  => FDIVR
-	   | FDIVR => FDIV
+           | FSUBR => FSUB
+           | FMUL  => FMUL
+           | FDIV  => FDIVR
+           | FDIVR => FDIV
 
       (* Floating-point unary arithmetic instructions. *)
       datatype funa
-	= F2XM1   (* compute 2^x-1; p. 201 *)
-	| FABS    (* absolute value; p. 203 *)
-	| FCHS    (* change sign; p. 214 *)
-	| FSQRT   (* square root; p. 284 *)
-	| FSIN    (* sine; p. 280 *)
-	| FCOS    (* cosine; p. 226 *)
-	| FRNDINT (* round to integer; p. 271 *)
+        = F2XM1   (* compute 2^x-1; p. 201 *)
+        | FABS    (* absolute value; p. 203 *)
+        | FCHS    (* change sign; p. 214 *)
+        | FSQRT   (* square root; p. 284 *)
+        | FSIN    (* sine; p. 280 *)
+        | FCOS    (* cosine; p. 226 *)
+        | FRNDINT (* round to integer; p. 271 *)
       val funa_layout
-	= let
-	    open Layout
-	  in 
-	    fn F2XM1 => str "f2xm1"
-	     | FABS => str "fabs"
-	     | FCHS => str "fchs"
-	     | FSQRT => str "fsqrt"
-	     | FSIN => str "fsin"
-	     | FCOS => str "fcos"
-	     | FRNDINT => str "frndint"
-	  end
+        = let
+            open Layout
+          in 
+            fn F2XM1 => str "f2xm1"
+             | FABS => str "fabs"
+             | FCHS => str "fchs"
+             | FSQRT => str "fsqrt"
+             | FSIN => str "fsin"
+             | FCOS => str "fcos"
+             | FRNDINT => str "frndint"
+          end
 
       (* Floating-point binary arithmetic stack instructions. *)
       datatype fbinas
-	= FSCALE (* scale; p. 278 *)
-	| FPREM (* partial remainder; p. 263 *)
-	| FPREM1 (* IEEE partial remainder; p. 266 *)
+        = FSCALE (* scale; p. 278 *)
+        | FPREM (* partial remainder; p. 263 *)
+        | FPREM1 (* IEEE partial remainder; p. 266 *)
       val fbinas_layout
-	= let
-	    open Layout
-	  in
-	    fn FSCALE => str "fscale"
-	     | FPREM=> str "fprem"
-	     | FPREM1 => str "fprem1"
-	  end
+        = let
+            open Layout
+          in
+            fn FSCALE => str "fscale"
+             | FPREM=> str "fprem"
+             | FPREM1 => str "fprem1"
+          end
 
       (* floating point binary arithmetic stack pop instructions. *)
       datatype fbinasp
-	= FYL2X (* compute y * log_2 x; p. 327 *)
-	| FYL2XP1 (* compute y * log_2 (x + 1.0); p. 329 *)
-	| FPATAN (* partial arctangent; p. 261 *)
+        = FYL2X (* compute y * log_2 x; p. 327 *)
+        | FYL2XP1 (* compute y * log_2 (x + 1.0); p. 329 *)
+        | FPATAN (* partial arctangent; p. 261 *)
       val fbinasp_layout
-	= let
-	    open Layout
-	  in
-	    fn FYL2X => str "fyl2x"
-	     | FYL2XP1 => str "fyl2xp1"
-	     | FPATAN => str "fpatan"
-	  end
+        = let
+            open Layout
+          in
+            fn FYL2X => str "fyl2x"
+             | FYL2XP1 => str "fyl2xp1"
+             | FPATAN => str "fpatan"
+          end
 
       (* Floating-point constants. *)
       datatype fldc
-	= ONE  (* +1.0; p. 250 *) 
-	| ZERO (* +0.0; p. 250 *)
-	| PI   (* pi; p. 250 *)
-	| L2E  (* log_2 e; p. 250 *)
-	| LN2  (* log_e 2; p. 250 *)
-	| L2T  (* log_2 10; p. 250 *)
-	| LG2  (* log_10 2; p. 250 *)
+        = ONE  (* +1.0; p. 250 *) 
+        | ZERO (* +0.0; p. 250 *)
+        | PI   (* pi; p. 250 *)
+        | L2E  (* log_2 e; p. 250 *)
+        | LN2  (* log_e 2; p. 250 *)
+        | L2T  (* log_2 10; p. 250 *)
+        | LG2  (* log_10 2; p. 250 *)
       val fldc_layout
-	= let
-	    open Layout
-	  in 
-	    fn ONE => str "fld1"
-	     | ZERO => str "fldz"
-	     | PI => str "fldpi"
-	     | L2E => str "fldl2e"
-	     | LN2 => str "fldln2"
-	     | L2T => str "fldl2t"
-	     | LG2 => str "fldlg2"
-	  end
+        = let
+            open Layout
+          in 
+            fn ONE => str "fld1"
+             | ZERO => str "fldz"
+             | PI => str "fldpi"
+             | L2E => str "fldl2e"
+             | LN2 => str "fldln2"
+             | L2T => str "fldl2t"
+             | LG2 => str "fldlg2"
+          end
 
       (* x86 Instructions.
        * src operands are not changed by the instruction.
@@ -1724,1276 +1717,1276 @@
       datatype t
         (* No operation *)
         = NOP
-	(* Integer binary arithmetic(w/o mult & div)/logic instructions.
-	 *)
-	| BinAL of {oper: binal,
-		    src: Operand.t,
-		    dst: Operand.t,
-		    size: Size.t}
-	(* Psuedo integer multiplication and division.
-	 *)
-	| pMD of {oper: md,
-		  src: Operand.t,
-		  dst: Operand.t,
-		  size: Size.t}
-	(* Integer multiplication and division. 
-	 *)
+        (* Integer binary arithmetic(w/o mult & div)/logic instructions.
+         *)
+        | BinAL of {oper: binal,
+                    src: Operand.t,
+                    dst: Operand.t,
+                    size: Size.t}
+        (* Psuedo integer multiplication and division.
+         *)
+        | pMD of {oper: md,
+                  src: Operand.t,
+                  dst: Operand.t,
+                  size: Size.t}
+        (* Integer multiplication and division. 
+         *)
         | MD of {oper: md,
-		 src: Operand.t,
-		 size: Size.t}
-	(* Integer signed/unsiged multiplication (two operand form); p. 335
-	 *)
-	| IMUL2 of {src: Operand.t,
-		    dst: Operand.t, 
-		    size: Size.t}
-	(* Integer unary arithmetic/logic instructions.
-	 *)
-	| UnAL of {oper: unal,
-		   dst: Operand.t,
-		   size: Size.t}
-	(* Integer shift/rotate arithmetic/logic instructions.
-	 *)
-	| SRAL of {oper: sral,
-		   count: Operand.t,
-		   dst: Operand.t,
-		   size: Size.t}
-	(* Arithmetic compare.
-	 *)
-	| CMP  of {src1: Operand.t,
-		   src2: Operand.t,
-		   size: Size.t}
-	(* Logical compare.
-	 *)
-	| TEST of {src1: Operand.t,
-		   src2: Operand.t,
-		   size: Size.t}
-	(* Set byte on condition.
-	 *)
-	| SETcc of {condition: condition,
-		    dst: Operand.t,
-		    size: Size.t}
-	(* Jump.
-	 *)
-	| JMP of {target: Operand.t,
-		  absolute: bool}
-	(* Jump if condition is met.
-	 *)
-	| Jcc of {condition: condition,
-		  target: Operand.t}
-	(* Call procedure.
-	 *)
-	| CALL of {target: Operand.t,
-		   absolute: bool}
-	(* Return from procedure.
-	 *)
-	| RET of {src: Operand.t option}
-	(* Move.
-	 *)
-	| MOV of {src: Operand.t,
-		  dst: Operand.t,
-		  size: Size.t}
-	(* Conditional move.
-	 *)
-	| CMOVcc of {condition: condition,
-		     src: Operand.t,
-		     dst: Operand.t,
-		     size: Size.t}
-	(* Exchange register/memory with register.
-	 *)
-	| XCHG of {src: Operand.t,
-		   dst: Operand.t,
-		   size: Size.t}
-	(* Pseudo-push a value onto a stack.
-	 *)
-	| pPUSH of {src: Operand.t,
-		    base: Operand.t,
-		    size: Size.t}
-	(* Pseudo-pop a value from a stack.
-	 *)
-	| pPOP of {dst: Operand.t,
-		   base: Operand.t, 
-		   size: Size.t}
-	(* Push a value onto the stack.
-	 *)
-	| PUSH of {src: Operand.t,
-		   size: Size.t}
-	(* Pop a value from the stack.
-	 *)
-	| POP of {dst: Operand.t,
-		  size: Size.t}
-	(* Convert X to 2X with sign extension.
-	 *)
-	| CX of {size: Size.t}
-	(* Move with extention.
-	 *)
-	| MOVX of {oper: movx,
-		   src: Operand.t,
-		   srcsize: Size.t,
-		   dst: Operand.t,
-		   dstsize: Size.t}
-	(* Move with contraction.
-	 *)
-	| XVOM of {src: Operand.t,
-		   srcsize: Size.t,
-		   dst: Operand.t,
-		   dstsize: Size.t}
-	(* Load effective address.
-	 *)
-	| LEA of {src: Operand.t,
-		  dst: Operand.t,
-		  size: Size.t}
-	(* Pseudo floating-point move.
-	 *)
-	| pFMOV of {src: Operand.t,
-		    dst: Operand.t,
-		    size: Size.t}
-	(* Pseudo floating-point move with extension.
-	 *)
-	| pFMOVX of {src: Operand.t,
-		     dst: Operand.t,
-		     srcsize: Size.t,
-		     dstsize: Size.t}
-	(* Pseudo floating-point move with contraction.
-	 *)
-	| pFXVOM of {src: Operand.t,
-		     dst: Operand.t,
-		     srcsize: Size.t,
-		     dstsize: Size.t}
-	(* Pseudo floating-point load constant.
-	 *)
-	| pFLDC of {oper: fldc,
-		    dst: Operand.t,
-		    size: Size.t}
-	(* Pseudo floating-point move from integer.
-	 *)
-	| pFMOVFI of {src: Operand.t,
-		      dst: Operand.t,
-		      srcsize: Size.t,
-		      dstsize: Size.t}
-	(* Pseudo floating-point move to integer.
-	 *)
-	| pFMOVTI of {src: Operand.t,
-		      dst: Operand.t,
-		      srcsize: Size.t,
-		      dstsize: Size.t}
-	(* Pseudo floating-point compare.
-	 *)
-	| pFCOM of {src1: Operand.t,
-		    src2: Operand.t,
-		    size: Size.t}
-	(* Pseudo floating-point unordered compare.
-	 *)
-	| pFUCOM of {src1: Operand.t,
-		     src2: Operand.t,
-		     size: Size.t}
-	(* Pseudo floating-point binary arithmetic instructions.
-	 *)
-	| pFBinA of {oper: fbina, 
-		     src: Operand.t, 
-		     dst: Operand.t,
-		     size: Size.t}
-	(* Pseudo floating-point unary arithmetic instructions.
-	 *)
-	| pFUnA of {oper: funa,
-		    dst: Operand.t,
-		    size: Size.t}
-	(* Pseudo floating-point partial tangent instruction.
-	 *)
-	| pFPTAN of {dst: Operand.t,
-		     size: Size.t}
-	(* Pseudo floating-point binary arithmetic stack instructions.
-	 *)
-	| pFBinAS of {oper: fbinas,
-		      src: Operand.t,
-		      dst: Operand.t,
-		      size: Size.t}
-	(* Pseudo floating-point binary arithmetic stack pop instructions.
-	 *)
-	| pFBinASP of {oper: fbinasp,
-		       src: Operand.t,
-		       dst: Operand.t,
-		       size: Size.t}
-	(* Floating-point load real.
-	 *)
-	| FLD of {src: Operand.t,
-		  size: Size.t}
-	(* Floating-point store real.
-	 *)
-	| FST of {dst: Operand.t,
-		  size: Size.t,
-		  pop: bool}
-	(* Floating-point load integer.
-	 *)
-	| FILD of {src: Operand.t,
-		   size: Size.t}
-	(* Floating-point store integer.
-	 *)
-	| FIST of {dst: Operand.t,
-		   size: Size.t,
-		   pop: bool}
-	(* Floating-point exchange.
-	 *)
-	| FXCH of {src: Operand.t}
-	(* Floating-point load constant.
-	 *)
-	| FLDC of {oper: fldc}
-	(* Floating-point load control word.
-	 *)
-	| FLDCW of {src: Operand.t}
-	(* Floating-point store control word.
-	 *)
-	| FSTCW of {dst: Operand.t,
-		    check: bool}
-	(* Floating-point store status word.
-	 *)
-	| FSTSW of {dst: Operand.t,
-		    check: bool}
-	(* Floating-point compare.
-	 *)
-	| FCOM of {src: Operand.t,
-		   size: Size.t,
-		   pop: bool,
-		   pop': bool}
-	(* Floating-point unordered compare.
-	 *)
-	| FUCOM of {src: Operand.t,
-		    pop: bool,
-		    pop': bool}
-	(* Floating-point binary arithmetic instructions.
-	 *)
-	| FBinA of {oper: fbina, 
-		    src: Operand.t,
-		    dst: Operand.t,
-		    size: Size.t,
-		    pop: bool}
-	(* Floating-point unary arithmetic instructions.
-	 *)
-	| FUnA of {oper: funa}
-	(* Floating-point partial tangent instruction.
-	 *)
-	| FPTAN
-	(* Floating-point binary arithmetic stack instructions.
-	 *)
-	| FBinAS of {oper: fbinas}
-	(* Floating-point binary arithmetic stack pop instructions.
-	 *)
-	| FBinASP of {oper: fbinasp}
+                 src: Operand.t,
+                 size: Size.t}
+        (* Integer signed/unsiged multiplication (two operand form); p. 335
+         *)
+        | IMUL2 of {src: Operand.t,
+                    dst: Operand.t, 
+                    size: Size.t}
+        (* Integer unary arithmetic/logic instructions.
+         *)
+        | UnAL of {oper: unal,
+                   dst: Operand.t,
+                   size: Size.t}
+        (* Integer shift/rotate arithmetic/logic instructions.
+         *)
+        | SRAL of {oper: sral,
+                   count: Operand.t,
+                   dst: Operand.t,
+                   size: Size.t}
+        (* Arithmetic compare.
+         *)
+        | CMP  of {src1: Operand.t,
+                   src2: Operand.t,
+                   size: Size.t}
+        (* Logical compare.
+         *)
+        | TEST of {src1: Operand.t,
+                   src2: Operand.t,
+                   size: Size.t}
+        (* Set byte on condition.
+         *)
+        | SETcc of {condition: condition,
+                    dst: Operand.t,
+                    size: Size.t}
+        (* Jump.
+         *)
+        | JMP of {target: Operand.t,
+                  absolute: bool}
+        (* Jump if condition is met.
+         *)
+        | Jcc of {condition: condition,
+                  target: Operand.t}
+        (* Call procedure.
+         *)
+        | CALL of {target: Operand.t,
+                   absolute: bool}
+        (* Return from procedure.
+         *)
+        | RET of {src: Operand.t option}
+        (* Move.
+         *)
+        | MOV of {src: Operand.t,
+                  dst: Operand.t,
+                  size: Size.t}
+        (* Conditional move.
+         *)
+        | CMOVcc of {condition: condition,
+                     src: Operand.t,
+                     dst: Operand.t,
+                     size: Size.t}
+        (* Exchange register/memory with register.
+         *)
+        | XCHG of {src: Operand.t,
+                   dst: Operand.t,
+                   size: Size.t}
+        (* Pseudo-push a value onto a stack.
+         *)
+        | pPUSH of {src: Operand.t,
+                    base: Operand.t,
+                    size: Size.t}
+        (* Pseudo-pop a value from a stack.
+         *)
+        | pPOP of {dst: Operand.t,
+                   base: Operand.t, 
+                   size: Size.t}
+        (* Push a value onto the stack.
+         *)
+        | PUSH of {src: Operand.t,
+                   size: Size.t}
+        (* Pop a value from the stack.
+         *)
+        | POP of {dst: Operand.t,
+                  size: Size.t}
+        (* Convert X to 2X with sign extension.
+         *)
+        | CX of {size: Size.t}
+        (* Move with extention.
+         *)
+        | MOVX of {oper: movx,
+                   src: Operand.t,
+                   srcsize: Size.t,
+                   dst: Operand.t,
+                   dstsize: Size.t}
+        (* Move with contraction.
+         *)
+        | XVOM of {src: Operand.t,
+                   srcsize: Size.t,
+                   dst: Operand.t,
+                   dstsize: Size.t}
+        (* Load effective address.
+         *)
+        | LEA of {src: Operand.t,
+                  dst: Operand.t,
+                  size: Size.t}
+        (* Pseudo floating-point move.
+         *)
+        | pFMOV of {src: Operand.t,
+                    dst: Operand.t,
+                    size: Size.t}
+        (* Pseudo floating-point move with extension.
+         *)
+        | pFMOVX of {src: Operand.t,
+                     dst: Operand.t,
+                     srcsize: Size.t,
+                     dstsize: Size.t}
+        (* Pseudo floating-point move with contraction.
+         *)
+        | pFXVOM of {src: Operand.t,
+                     dst: Operand.t,
+                     srcsize: Size.t,
+                     dstsize: Size.t}
+        (* Pseudo floating-point load constant.
+         *)
+        | pFLDC of {oper: fldc,
+                    dst: Operand.t,
+                    size: Size.t}
+        (* Pseudo floating-point move from integer.
+         *)
+        | pFMOVFI of {src: Operand.t,
+                      dst: Operand.t,
+                      srcsize: Size.t,
+                      dstsize: Size.t}
+        (* Pseudo floating-point move to integer.
+         *)
+        | pFMOVTI of {src: Operand.t,
+                      dst: Operand.t,
+                      srcsize: Size.t,
+                      dstsize: Size.t}
+        (* Pseudo floating-point compare.
+         *)
+        | pFCOM of {src1: Operand.t,
+                    src2: Operand.t,
+                    size: Size.t}
+        (* Pseudo floating-point unordered compare.
+         *)
+        | pFUCOM of {src1: Operand.t,
+                     src2: Operand.t,
+                     size: Size.t}
+        (* Pseudo floating-point binary arithmetic instructions.
+         *)
+        | pFBinA of {oper: fbina, 
+                     src: Operand.t, 
+                     dst: Operand.t,
+                     size: Size.t}
+        (* Pseudo floating-point unary arithmetic instructions.
+         *)
+        | pFUnA of {oper: funa,
+                    dst: Operand.t,
+                    size: Size.t}
+        (* Pseudo floating-point partial tangent instruction.
+         *)
+        | pFPTAN of {dst: Operand.t,
+                     size: Size.t}
+        (* Pseudo floating-point binary arithmetic stack instructions.
+         *)
+        | pFBinAS of {oper: fbinas,
+                      src: Operand.t,
+                      dst: Operand.t,
+                      size: Size.t}
+        (* Pseudo floating-point binary arithmetic stack pop instructions.
+         *)
+        | pFBinASP of {oper: fbinasp,
+                       src: Operand.t,
+                       dst: Operand.t,
+                       size: Size.t}
+        (* Floating-point load real.
+         *)
+        | FLD of {src: Operand.t,
+                  size: Size.t}
+        (* Floating-point store real.
+         *)
+        | FST of {dst: Operand.t,
+                  size: Size.t,
+                  pop: bool}
+        (* Floating-point load integer.
+         *)
+        | FILD of {src: Operand.t,
+                   size: Size.t}
+        (* Floating-point store integer.
+         *)
+        | FIST of {dst: Operand.t,
+                   size: Size.t,
+                   pop: bool}
+        (* Floating-point exchange.
+         *)
+        | FXCH of {src: Operand.t}
+        (* Floating-point load constant.
+         *)
+        | FLDC of {oper: fldc}
+        (* Floating-point load control word.
+         *)
+        | FLDCW of {src: Operand.t}
+        (* Floating-point store control word.
+         *)
+        | FSTCW of {dst: Operand.t,
+                    check: bool}
+        (* Floating-point store status word.
+         *)
+        | FSTSW of {dst: Operand.t,
+                    check: bool}
+        (* Floating-point compare.
+         *)
+        | FCOM of {src: Operand.t,
+                   size: Size.t,
+                   pop: bool,
+                   pop': bool}
+        (* Floating-point unordered compare.
+         *)
+        | FUCOM of {src: Operand.t,
+                    pop: bool,
+                    pop': bool}
+        (* Floating-point binary arithmetic instructions.
+         *)
+        | FBinA of {oper: fbina, 
+                    src: Operand.t,
+                    dst: Operand.t,
+                    size: Size.t,
+                    pop: bool}
+        (* Floating-point unary arithmetic instructions.
+         *)
+        | FUnA of {oper: funa}
+        (* Floating-point partial tangent instruction.
+         *)
+        | FPTAN
+        (* Floating-point binary arithmetic stack instructions.
+         *)
+        | FBinAS of {oper: fbinas}
+        (* Floating-point binary arithmetic stack pop instructions.
+         *)
+        | FBinASP of {oper: fbinasp}
 
       val layout
-	= let
-	    open Layout
-	    fun bin (oper, size, oper1, oper2)
-	      = seq [oper,
-		     size,
-		     str " ",
-		     oper1,
-		     str ",",
-		     oper2]
-	    fun un (oper, size, oper1)
-	      = seq [oper,
-		     size,
-		     str " ",
-		     oper1]
-	  in 
-	    fn NOP
-	     => str "nop"
-	     | BinAL {oper, src, dst, size}
-	     => bin (binal_layout oper, 
-		     Size.layout size,
-		     Operand.layout src,
-		     Operand.layout dst)
-	     | pMD {oper, src, dst, size}
-	     => bin (md_layout oper, 
-		     Size.layout size,
-		     Operand.layout src,
-		     Operand.layout dst)
-	     | MD {oper, src, size}
-	     => un (md_layout oper, 
-		    Size.layout size,
-		    Operand.layout src)
-	     | IMUL2 {src, dst, size}
-	     => bin (str "imul",
-		     Size.layout size,
-		     Operand.layout src,
-		     Operand.layout dst)
-	     | UnAL {oper, dst, size}
-	     => un (unal_layout oper, 
-		    Size.layout size, 
-		    Operand.layout dst)
-	     | SRAL {oper, count, dst, size}
-	     => bin (sral_layout oper, 
-		     Size.layout size, 
-		     Operand.layout count,
-		     Operand.layout dst)
-	     | CMP {src1, src2, size}
-	     => bin (str "cmp", 
-		     Size.layout size,
-		     Operand.layout src2,
-		     Operand.layout src1)
-	     | TEST {src1, src2, size}
-	     => bin (str "test", 
-		     Size.layout size,
-		     Operand.layout src2,
-		     Operand.layout src1)
-	     | SETcc {condition, dst, ...}
-	     => seq [str "set", 
-		     condition_layout condition, 
-		     str " ",
-		     Operand.layout dst]
-	     | JMP {target, absolute}
-	     => seq [str "jmp ", 
-		     if absolute then str "*" else empty, 
-		     Operand.layout target]
-	     | Jcc {condition, target}
-	     => seq [str "j", 
-		     condition_layout condition, 
-		     str " ",
-		     Operand.layout target]
-	     | CALL {target, absolute}
- 	     => seq [str "call ", 
-		     if absolute then str "*" else empty, 
-		     Operand.layout target]
-	     | RET {src}
-	     => seq [str "ret", 
-		     case src
-		       of NONE => empty
-			| SOME src => seq [str " ", Operand.layout src]]
-	     | MOV {src, dst, size}
-	     => bin (str "mov", 
-		     Size.layout size,
-		     Operand.layout src,
-		     Operand.layout dst)
-	     | CMOVcc {condition, src, dst, size}
-	     => seq [str "cmov", 
-		     condition_layout condition,
-		     Size.layout size, 
-		     str " ",
-		     Operand.layout src,
-		     str ",",
-		     Operand.layout dst]
-	     | XCHG {src, dst, size}
-	     => bin (str "xchg", 
-		     Size.layout size,
-		     Operand.layout src,
-		     Operand.layout dst)
-	     | pPUSH {src, base, size}
-	     => seq [str "ppush", 
-		     Size.layout size, 
-		     str " [",
-		     Operand.layout base, 
-		     str "] ",
-		     Operand.layout src]
-	     | pPOP {dst, base, size}
-	     => seq [str "ppop", 
-		     Size.layout size, 
-		     str " [",
-		     Operand.layout base, 
-		     str " ]",
-		     Operand.layout dst]
-	     | PUSH {src, size}
-	     => seq [str "push", 
-		     Size.layout size, 
-		     str " ",
-		     Operand.layout src]
-	     | POP {dst, size}
-	     => seq [str "pop", 
-		     Size.layout size, 
-		     str " ",
-		     Operand.layout dst]
-	     | CX {size}
-	     => (case size
-		   of Size.BYTE => str "cbtw"
-		    | Size.WORD => str "cwtd"
-		    | Size.LONG => str "cltd"
-		    | _ => Error.bug "unsupported conversion")
-	     | MOVX {oper, src, srcsize, dst, dstsize}
-	     => bin (movx_layout oper, 
-		     seq [Size.layout srcsize, 
-			  Size.layout dstsize],
-		     Operand.layout src, 
-		     Operand.layout dst)
-	     | XVOM {src, srcsize, dst, dstsize}
-	     => bin (str "xvom",
-		     seq [Size.layout srcsize,
-			  Size.layout dstsize],
-		     Operand.layout src,
-		     Operand.layout dst)
-	     | LEA {src, dst, size}
-	     => bin (str "lea", 
-		     Size.layout size,
-		     Operand.layout src,
-		     Operand.layout dst)
-	     | pFMOV {src, dst, size}
-	     => bin (str "fmov", 
-		     Size.layout size,
-		     Operand.layout src,
-		     Operand.layout dst)
-	     | pFMOVX {src, dst, srcsize, dstsize}
-	     => bin (str "fmovx", 
-		     seq [Size.layout srcsize, 
-			  Size.layout dstsize],
-		     Operand.layout src,
-		     Operand.layout dst)
-	     | pFXVOM {src, dst, srcsize, dstsize}
-	     => bin (str "fmov", 
-		     seq [Size.layout srcsize,
-			  Size.layout dstsize],
-		     Operand.layout src,
-		     Operand.layout dst)
-	     | pFLDC {oper, dst, size}
-	     => un (fldc_layout oper,
-		    Size.layout size,
-		    Operand.layout dst)
-	     | pFMOVFI {src, dst, srcsize, dstsize}
-	     => bin (str "fmovfi", 
-		     seq [Size.layout srcsize,
-			  Size.layout dstsize],
-		     Operand.layout src,
-		     Operand.layout dst)
-	     | pFMOVTI {src, dst, srcsize, dstsize}
-	     => bin (str "fmovti", 
-		     seq [Size.layout srcsize, 
-			  Size.layout dstsize],
-		     Operand.layout src,
-		     Operand.layout dst)
-	     | pFCOM {src1, src2, size}
-	     => bin (str "fcom",
-		     Size.layout size,
-		     Operand.layout src1,
-		     Operand.layout src2)
-	     | pFUCOM {src1, src2, size}
-	     => bin (str "fucom",
-		     Size.layout size,
-		     Operand.layout src1,
-		     Operand.layout src2)
-	     | pFBinA {oper, src, dst, size}
-	     => bin (fbina_layout oper, 
-		     Size.layout size,
-		     Operand.layout src,
-		     Operand.layout dst)
-	     | pFUnA {oper, dst, size}
- 	     => un (funa_layout oper,
-		    Size.layout size,
-		    Operand.layout dst)
-	     | pFPTAN {dst, size}
-	     => un (str "fptan",
-		    Size.layout size,
-		    Operand.layout dst)
-	     | pFBinAS {oper, src, dst, size}
-	     => bin (fbinas_layout oper,
-		     Size.layout size,
-		     Operand.layout src,
-		     Operand.layout dst)
-	     | pFBinASP {oper, src, dst, size}
-	     => bin (fbinasp_layout oper,
-		     Size.layout size,
-		     Operand.layout src,
-		     Operand.layout dst)
-	     | FLD {src, size}
-	     => un (str "fld", 
-		    case src
-		      of Operand.FltRegister _ => empty
-		       | _ => Size.layout size,
-		    Operand.layout src)
-	     | FST {dst, size, pop}
-	     => un (str "fst", 
-		    seq [if pop then str "p" else empty, 
-			 case dst
-			   of Operand.FltRegister _ => empty
-			    | _ => Size.layout size],
-		    Operand.layout dst)
-	     | FILD {src, size}
-	     => un (str "fild", 
-		    Size.layout size, 
-		    Operand.layout src)
-	     | FIST {dst, size, pop}
-	     => un (str "fist", 
-		    seq [if pop then str "p" else empty, 
-		         Size.layout size],
-		    Operand.layout dst)
-	     | FXCH {src}
-	     => seq [str "fxch ",
-		     Operand.layout src]
-	     | FLDC {oper}
-	     => seq [fldc_layout oper]
-	     | FLDCW {src}
-	     => seq [str "fldcw ",
-		     Operand.layout src]
-	     | FSTCW {dst, check}
-	     => seq [if check then str "fstcw " else str "fnstcw ",
-		     Operand.layout dst]
-	     | FSTSW {dst, check}
-	     => seq [if check then str "fstsw " else str "fnstsw ",
-		     Operand.layout dst]
-	     | FCOM {src, size, pop, pop'}
-	     => seq [str "fcom",
-		     if pop andalso pop' 
-		       then str "pp"
-		       else seq [if pop then str "p" else empty,
-				 case src
-				   of Operand.FltRegister _
-				    => empty
-				    | _ => Size.layout size,
-				 str " ",
-				 Operand.layout src]]
-	     | FUCOM {src, pop, pop'}
-	     => seq [str "fucom",
-		     if pop andalso pop' 
-		       then str "pp"
-		       else seq [if pop then str "p " else str " ",
-				 Operand.layout src]]
-	     | FBinA {oper, src, dst, size, pop}
-	     => seq [fbina_layout oper,
-		     case src
-		       of Operand.FltRegister _ 
-			=> seq [if pop then str "p " else str " ",
-				Operand.layout src, 
-				str ", ",
-				Operand.layout dst]
-		        | _ 
-			=> seq [Size.layout size, 
-				str " ",
-				Operand.layout src]]
-	     | FUnA {oper}
-	     => seq [funa_layout oper]
-	     | FPTAN 
-	     => seq [str "fptan"]
-	     | FBinAS {oper}
-	     => seq [fbinas_layout oper]
-	     | FBinASP {oper}
-	     => seq [fbinasp_layout oper]
-	  end
+        = let
+            open Layout
+            fun bin (oper, size, oper1, oper2)
+              = seq [oper,
+                     size,
+                     str " ",
+                     oper1,
+                     str ",",
+                     oper2]
+            fun un (oper, size, oper1)
+              = seq [oper,
+                     size,
+                     str " ",
+                     oper1]
+          in 
+            fn NOP
+             => str "nop"
+             | BinAL {oper, src, dst, size}
+             => bin (binal_layout oper, 
+                     Size.layout size,
+                     Operand.layout src,
+                     Operand.layout dst)
+             | pMD {oper, src, dst, size}
+             => bin (md_layout oper, 
+                     Size.layout size,
+                     Operand.layout src,
+                     Operand.layout dst)
+             | MD {oper, src, size}
+             => un (md_layout oper, 
+                    Size.layout size,
+                    Operand.layout src)
+             | IMUL2 {src, dst, size}
+             => bin (str "imul",
+                     Size.layout size,
+                     Operand.layout src,
+                     Operand.layout dst)
+             | UnAL {oper, dst, size}
+             => un (unal_layout oper, 
+                    Size.layout size, 
+                    Operand.layout dst)
+             | SRAL {oper, count, dst, size}
+             => bin (sral_layout oper, 
+                     Size.layout size, 
+                     Operand.layout count,
+                     Operand.layout dst)
+             | CMP {src1, src2, size}
+             => bin (str "cmp", 
+                     Size.layout size,
+                     Operand.layout src2,
+                     Operand.layout src1)
+             | TEST {src1, src2, size}
+             => bin (str "test", 
+                     Size.layout size,
+                     Operand.layout src2,
+                     Operand.layout src1)
+             | SETcc {condition, dst, ...}
+             => seq [str "set", 
+                     condition_layout condition, 
+                     str " ",
+                     Operand.layout dst]
+             | JMP {target, absolute}
+             => seq [str "jmp ", 
+                     if absolute then str "*" else empty, 
+                     Operand.layout target]
+             | Jcc {condition, target}
+             => seq [str "j", 
+                     condition_layout condition, 
+                     str " ",
+                     Operand.layout target]
+             | CALL {target, absolute}
+             => seq [str "call ", 
+                     if absolute then str "*" else empty, 
+                     Operand.layout target]
+             | RET {src}
+             => seq [str "ret", 
+                     case src
+                       of NONE => empty
+                        | SOME src => seq [str " ", Operand.layout src]]
+             | MOV {src, dst, size}
+             => bin (str "mov", 
+                     Size.layout size,
+                     Operand.layout src,
+                     Operand.layout dst)
+             | CMOVcc {condition, src, dst, size}
+             => seq [str "cmov", 
+                     condition_layout condition,
+                     Size.layout size, 
+                     str " ",
+                     Operand.layout src,
+                     str ",",
+                     Operand.layout dst]
+             | XCHG {src, dst, size}
+             => bin (str "xchg", 
+                     Size.layout size,
+                     Operand.layout src,
+                     Operand.layout dst)
+             | pPUSH {src, base, size}
+             => seq [str "ppush", 
+                     Size.layout size, 
+                     str " [",
+                     Operand.layout base, 
+                     str "] ",
+                     Operand.layout src]
+             | pPOP {dst, base, size}
+             => seq [str "ppop", 
+                     Size.layout size, 
+                     str " [",
+                     Operand.layout base, 
+                     str " ]",
+                     Operand.layout dst]
+             | PUSH {src, size}
+             => seq [str "push", 
+                     Size.layout size, 
+                     str " ",
+                     Operand.layout src]
+             | POP {dst, size}
+             => seq [str "pop", 
+                     Size.layout size, 
+                     str " ",
+                     Operand.layout dst]
+             | CX {size}
+             => (case size
+                   of Size.BYTE => str "cbtw"
+                    | Size.WORD => str "cwtd"
+                    | Size.LONG => str "cltd"
+                    | _ => Error.bug "x86.Instruction.layout: CX,unsupported conversion")
+             | MOVX {oper, src, srcsize, dst, dstsize}
+             => bin (movx_layout oper, 
+                     seq [Size.layout srcsize, 
+                          Size.layout dstsize],
+                     Operand.layout src, 
+                     Operand.layout dst)
+             | XVOM {src, srcsize, dst, dstsize}
+             => bin (str "xvom",
+                     seq [Size.layout srcsize,
+                          Size.layout dstsize],
+                     Operand.layout src,
+                     Operand.layout dst)
+             | LEA {src, dst, size}
+             => bin (str "lea", 
+                     Size.layout size,
+                     Operand.layout src,
+                     Operand.layout dst)
+             | pFMOV {src, dst, size}
+             => bin (str "fmov", 
+                     Size.layout size,
+                     Operand.layout src,
+                     Operand.layout dst)
+             | pFMOVX {src, dst, srcsize, dstsize}
+             => bin (str "fmovx", 
+                     seq [Size.layout srcsize, 
+                          Size.layout dstsize],
+                     Operand.layout src,
+                     Operand.layout dst)
+             | pFXVOM {src, dst, srcsize, dstsize}
+             => bin (str "fmov", 
+                     seq [Size.layout srcsize,
+                          Size.layout dstsize],
+                     Operand.layout src,
+                     Operand.layout dst)
+             | pFLDC {oper, dst, size}
+             => un (fldc_layout oper,
+                    Size.layout size,
+                    Operand.layout dst)
+             | pFMOVFI {src, dst, srcsize, dstsize}
+             => bin (str "fmovfi", 
+                     seq [Size.layout srcsize,
+                          Size.layout dstsize],
+                     Operand.layout src,
+                     Operand.layout dst)
+             | pFMOVTI {src, dst, srcsize, dstsize}
+             => bin (str "fmovti", 
+                     seq [Size.layout srcsize, 
+                          Size.layout dstsize],
+                     Operand.layout src,
+                     Operand.layout dst)
+             | pFCOM {src1, src2, size}
+             => bin (str "fcom",
+                     Size.layout size,
+                     Operand.layout src1,
+                     Operand.layout src2)
+             | pFUCOM {src1, src2, size}
+             => bin (str "fucom",
+                     Size.layout size,
+                     Operand.layout src1,
+                     Operand.layout src2)
+             | pFBinA {oper, src, dst, size}
+             => bin (fbina_layout oper, 
+                     Size.layout size,
+                     Operand.layout src,
+                     Operand.layout dst)
+             | pFUnA {oper, dst, size}
+             => un (funa_layout oper,
+                    Size.layout size,
+                    Operand.layout dst)
+             | pFPTAN {dst, size}
+             => un (str "fptan",
+                    Size.layout size,
+                    Operand.layout dst)
+             | pFBinAS {oper, src, dst, size}
+             => bin (fbinas_layout oper,
+                     Size.layout size,
+                     Operand.layout src,
+                     Operand.layout dst)
+             | pFBinASP {oper, src, dst, size}
+             => bin (fbinasp_layout oper,
+                     Size.layout size,
+                     Operand.layout src,
+                     Operand.layout dst)
+             | FLD {src, size}
+             => un (str "fld", 
+                    case src
+                      of Operand.FltRegister _ => empty
+                       | _ => Size.layout size,
+                    Operand.layout src)
+             | FST {dst, size, pop}
+             => un (str "fst", 
+                    seq [if pop then str "p" else empty, 
+                         case dst
+                           of Operand.FltRegister _ => empty
+                            | _ => Size.layout size],
+                    Operand.layout dst)
+             | FILD {src, size}
+             => un (str "fild", 
+                    Size.layout size, 
+                    Operand.layout src)
+             | FIST {dst, size, pop}
+             => un (str "fist", 
+                    seq [if pop then str "p" else empty, 
+                         Size.layout size],
+                    Operand.layout dst)
+             | FXCH {src}
+             => seq [str "fxch ",
+                     Operand.layout src]
+             | FLDC {oper}
+             => seq [fldc_layout oper]
+             | FLDCW {src}
+             => seq [str "fldcw ",
+                     Operand.layout src]
+             | FSTCW {dst, check}
+             => seq [if check then str "fstcw " else str "fnstcw ",
+                     Operand.layout dst]
+             | FSTSW {dst, check}
+             => seq [if check then str "fstsw " else str "fnstsw ",
+                     Operand.layout dst]
+             | FCOM {src, size, pop, pop'}
+             => seq [str "fcom",
+                     if pop andalso pop' 
+                       then str "pp"
+                       else seq [if pop then str "p" else empty,
+                                 case src
+                                   of Operand.FltRegister _
+                                    => empty
+                                    | _ => Size.layout size,
+                                 str " ",
+                                 Operand.layout src]]
+             | FUCOM {src, pop, pop'}
+             => seq [str "fucom",
+                     if pop andalso pop' 
+                       then str "pp"
+                       else seq [if pop then str "p " else str " ",
+                                 Operand.layout src]]
+             | FBinA {oper, src, dst, size, pop}
+             => seq [fbina_layout oper,
+                     case src
+                       of Operand.FltRegister _ 
+                        => seq [if pop then str "p " else str " ",
+                                Operand.layout src, 
+                                str ", ",
+                                Operand.layout dst]
+                        | _ 
+                        => seq [Size.layout size, 
+                                str " ",
+                                Operand.layout src]]
+             | FUnA {oper}
+             => seq [funa_layout oper]
+             | FPTAN 
+             => seq [str "fptan"]
+             | FBinAS {oper}
+             => seq [fbinas_layout oper]
+             | FBinASP {oper}
+             => seq [fbinasp_layout oper]
+          end
       val toString = Layout.toString o layout
-	
+        
       val uses_defs_kills
-	= fn NOP
-	   => {uses = [], defs = [], kills = []}
+        = fn NOP
+           => {uses = [], defs = [], kills = []}
            | BinAL {src, dst, ...}
-	   => {uses = [src, dst], defs = [dst], kills = []}
-	   | pMD {src, dst, ...}
-	   => {uses = [src, dst], defs = [dst], kills = []}
-	   | MD {oper, src, size}
-	   => let
-		val (hi,lo) 
-		  = case size
-		      of Size.BYTE 
-		       => (Register.T {reg = Register.EAX, part = Register.H},
-			   Register.T {reg = Register.EAX, part = Register.L})
-		       | Size.WORD 
-		       => (Register.T {reg = Register.EDX, part = Register.X},
-			   Register.T {reg = Register.EAX, part = Register.X})
-		       | Size.LONG
-		       => (Register.T {reg = Register.EDX, part = Register.E},
-			   Register.T {reg = Register.EAX, part = Register.E})
-		       | _ => Error.bug "Instruction.uses_defs: MD, size"
-	      in 
-		if oper = IMUL orelse oper = MUL
-		  then {uses = [src, Operand.register lo],
-			defs = [Operand.register hi, Operand.register lo],
-			kills = []}
-		  else {uses = [src, Operand.register hi, Operand.register lo],
-			defs = [Operand.register hi, Operand.register lo],
-			kills = []}
-	      end
-	   | IMUL2 {src, dst, ...}
-	   => {uses = [src, dst], defs = [dst], kills = []}
-	   | UnAL {dst, ...}
-	   => {uses = [dst], defs = [dst], kills = []}
-	   | SRAL {count, dst, size, ...}
-	   => if isSome (Operand.deMemloc count)
-		then let
-		       val reg
-			 = case size
-			     of Size.BYTE 
-			       => Register.T {reg = Register.ECX, 
-					      part = Register.L}
-			       | Size.WORD 
-			       => Register.T {reg = Register.ECX, 
-					      part = Register.X}
-			       | Size.LONG
-		               => Register.T {reg = Register.ECX, 
-					      part = Register.E}
-		               | _ => Error.bug "Instruction.uses_defs: SRAL, size"
-		     in
-		       {uses = [count, dst, Operand.register reg], 
-			defs = [dst], 
-			kills = []}
-		     end
-		else {uses = [count, dst], 
-		      defs = [dst], 
-		      kills = []}
-	   | CMP {src1, src2, ...}
-	   => {uses = [src1, src2], defs = [], kills = []}
-	   | TEST {src1, src2, ...}
-	   => {uses = [src1, src2], defs = [], kills = []}
-	   | SETcc {dst, ...}
-	   => {uses = [], defs = [dst], kills = []}
-	   | JMP {target, ...}
-	   => {uses = [target], defs = [], kills = []}
-	   | Jcc {target, ...}
-	   => {uses = [target], defs = [], kills = []}
-	   | CALL {target, ...}
-	   => {uses = [target], defs = [], kills = []}
-	   | RET {src}
-	   => {uses = case src of NONE => [] | SOME src => [src], 
-	       defs = [], 
-	       kills = []}
-	   | MOV {src, dst, ...}
-	   => {uses = [src], defs = [dst], kills = []}
-	   | CMOVcc {src, dst, ...}
-	   => {uses = [src], defs = [dst], kills = []}
-	   | XCHG {src, dst, ...}
-	   => {uses = [src,dst], defs = [src,dst], kills = []}
-	   | pPUSH {src, base, size, ...}
-	   => {uses = [src,base], 
-	       defs = base::
-	              (case base
-			 of Operand.MemLoc base
-			  => [Operand.MemLoc 
-			      (MemLoc.simple {base = base,
-					      index = Immediate.const_int 0,
-					      size = size,
-					      scale = Scale.One,
-					      class = MemLoc.Class.CStack})]
-			  | _ => []),
-	       kills = []}
-	   | pPOP {dst, base, size, ...}
-	   => {uses = base::
-	              (case base
-			 of Operand.MemLoc base
-			  => [Operand.MemLoc 
-			      (MemLoc.simple {base = base,
-					      index = Immediate.const_int 0,
-					      size = size,
-					      scale = Scale.One,
-					      class = MemLoc.Class.CStack})]
-			  | _ => []),
-	       defs = [dst,base],
-	       kills = []}
-	   | PUSH {src, ...}
-	   => {uses = [src, Operand.register Register.esp],
-	       defs = [Operand.register Register.esp,
-		       Operand.address (Address.T {disp = NONE,
-						   base = SOME Register.esp,
-						   index = NONE,
-						   scale = NONE})], 
-	       kills = []}
-	   | POP {dst, ...}
-	   => {uses = [Operand.register Register.esp,
-		       Operand.address (Address.T {disp = NONE,
-						   base = SOME Register.esp,
-						   index = NONE,
-						   scale = NONE})],
-	       defs = [dst, Operand.register Register.esp], 
-	       kills = []}
-	   | CX {size}
-	   => let
-		val (hi,lo) 
-		  = case size
-		      of Size.BYTE 
-		       => (Register.T {reg = Register.EAX, part = Register.H},
-			   Register.T {reg = Register.EAX, part = Register.L})
-		       | Size.WORD 
-		       => (Register.T {reg = Register.EDX, part = Register.X},
-			   Register.T {reg = Register.EAX, part = Register.X})
-		       | Size.LONG
-		       => (Register.T {reg = Register.EDX, part = Register.E},
-			   Register.T {reg = Register.EAX, part = Register.E})
-		       | _ => Error.bug "Instruction.uses_defs: CX, size"
-	      in
-		{uses = [Operand.register lo],
-		 defs = [Operand.register hi, Operand.register lo], 
-		 kills = []}
-	      end
-	   | MOVX {src, dst, ...}
-	   => {uses = [src], defs = [dst], kills = []}
-	   | XVOM {src, dst, ...}
-	   => {uses = [src], defs = [dst], kills = []}
-	   | LEA {src, dst, ...}
-	   => {uses = [src], defs = [dst], kills = []}
-	   | pFMOV {src, dst, ...}
-	   => {uses = [src], defs = [dst], kills = []}
-	   | pFMOVX {src, dst, ...}
-	   => {uses = [src], defs = [dst], kills = []}
-	   | pFXVOM {src, dst, ...}
-	   => {uses = [src], defs = [dst], kills = []}
-	   | pFLDC {dst, ...}
-	   => {uses = [], defs = [dst], kills = []}
-	   | pFMOVFI {src, dst, ...}
-	   => {uses = [src], defs = [dst], kills = []}
-	   | pFMOVTI {src, dst, ...}
-	   => {uses = [src], defs = [dst], kills = []}
-	   | pFCOM {src1, src2, ...}
-	   => {uses = [src1, src2], defs = [], kills = []}
-	   | pFUCOM {src1, src2, ...}
-	   => {uses = [src1, src2], defs = [], kills = []}
-	   | pFBinA {src, dst, ...}
-	   => {uses = [src, dst], defs = [dst], kills = []}
-	   | pFUnA {dst, ...}
-	   => {uses = [dst], defs = [dst], kills = []}
-	   | pFPTAN {dst, ...}
-	   => {uses = [dst], defs = [dst], kills = []}
-	   | pFBinAS {src, dst, ...}
-	   => {uses = [src, dst], defs = [dst], kills = []}
-	   | pFBinASP {src, dst, ...}
-	   => {uses = [src, dst], 
-	       defs = [dst], 
-	       kills = if Operand.eq(src,dst)
-			 then []
-			 else [src]}
-	   | FLD {src, ...}
-	   => {uses = [src], 
-	       defs = [Operand.fltregister FltRegister.top], 
-	       kills = []}
-	   | FST {dst, pop, ...}
-	   => {uses = [Operand.fltregister FltRegister.top], 
-	       defs = [dst], 
-	       kills = if pop 
-			 then [Operand.fltregister FltRegister.top] 
-			 else []}
-	   | FILD {src, ...}
-	   => {uses = [src], 
-	       defs = [Operand.fltregister FltRegister.top], 
-	       kills = []}
-	   | FIST {dst, pop, ...}
-	   => {uses = [Operand.fltregister FltRegister.top], 
-	       defs = [dst], 
-	       kills = if pop 
-			 then [Operand.fltregister FltRegister.top] 
-			 else []}
-	   | FXCH {src}
-	   => {uses = [src, Operand.fltregister FltRegister.top],
-	       defs = [src, Operand.fltregister FltRegister.top], 
-	       kills = []}
-	   | FLDC {...}
-	   => {uses = [], 
-	       defs = [Operand.fltregister FltRegister.top], 
-	       kills = []}
-	   | FLDCW {src}
+           => {uses = [src, dst], defs = [dst], kills = []}
+           | pMD {src, dst, ...}
+           => {uses = [src, dst], defs = [dst], kills = []}
+           | MD {oper, src, size}
+           => let
+                val (hi,lo) 
+                  = case size
+                      of Size.BYTE 
+                       => (Register.T {reg = Register.EAX, part = Register.H},
+                           Register.T {reg = Register.EAX, part = Register.L})
+                       | Size.WORD 
+                       => (Register.T {reg = Register.EDX, part = Register.X},
+                           Register.T {reg = Register.EAX, part = Register.X})
+                       | Size.LONG
+                       => (Register.T {reg = Register.EDX, part = Register.E},
+                           Register.T {reg = Register.EAX, part = Register.E})
+                       | _ => Error.bug "x86.Instruction.uses_defs: MD, size"
+              in 
+                if oper = IMUL orelse oper = MUL
+                  then {uses = [src, Operand.register lo],
+                        defs = [Operand.register hi, Operand.register lo],
+                        kills = []}
+                  else {uses = [src, Operand.register hi, Operand.register lo],
+                        defs = [Operand.register hi, Operand.register lo],
+                        kills = []}
+              end
+           | IMUL2 {src, dst, ...}
+           => {uses = [src, dst], defs = [dst], kills = []}
+           | UnAL {dst, ...}
+           => {uses = [dst], defs = [dst], kills = []}
+           | SRAL {count, dst, size, ...}
+           => if isSome (Operand.deMemloc count)
+                then let
+                       val reg
+                         = case size
+                             of Size.BYTE 
+                               => Register.T {reg = Register.ECX, 
+                                              part = Register.L}
+                               | Size.WORD 
+                               => Register.T {reg = Register.ECX, 
+                                              part = Register.X}
+                               | Size.LONG
+                               => Register.T {reg = Register.ECX, 
+                                              part = Register.E}
+                               | _ => Error.bug "x86.Instruction.uses_defs: SRAL, size"
+                     in
+                       {uses = [count, dst, Operand.register reg], 
+                        defs = [dst], 
+                        kills = []}
+                     end
+                else {uses = [count, dst], 
+                      defs = [dst], 
+                      kills = []}
+           | CMP {src1, src2, ...}
+           => {uses = [src1, src2], defs = [], kills = []}
+           | TEST {src1, src2, ...}
+           => {uses = [src1, src2], defs = [], kills = []}
+           | SETcc {dst, ...}
+           => {uses = [], defs = [dst], kills = []}
+           | JMP {target, ...}
+           => {uses = [target], defs = [], kills = []}
+           | Jcc {target, ...}
+           => {uses = [target], defs = [], kills = []}
+           | CALL {target, ...}
+           => {uses = [target], defs = [], kills = []}
+           | RET {src}
+           => {uses = case src of NONE => [] | SOME src => [src], 
+               defs = [], 
+               kills = []}
+           | MOV {src, dst, ...}
+           => {uses = [src], defs = [dst], kills = []}
+           | CMOVcc {src, dst, ...}
+           => {uses = [src], defs = [dst], kills = []}
+           | XCHG {src, dst, ...}
+           => {uses = [src,dst], defs = [src,dst], kills = []}
+           | pPUSH {src, base, size, ...}
+           => {uses = [src,base], 
+               defs = base::
+                      (case base
+                         of Operand.MemLoc base
+                          => [Operand.MemLoc 
+                              (MemLoc.simple {base = base,
+                                              index = Immediate.const_int 0,
+                                              size = size,
+                                              scale = Scale.One,
+                                              class = MemLoc.Class.CStack})]
+                          | _ => []),
+               kills = []}
+           | pPOP {dst, base, size, ...}
+           => {uses = base::
+                      (case base
+                         of Operand.MemLoc base
+                          => [Operand.MemLoc 
+                              (MemLoc.simple {base = base,
+                                              index = Immediate.const_int 0,
+                                              size = size,
+                                              scale = Scale.One,
+                                              class = MemLoc.Class.CStack})]
+                          | _ => []),
+               defs = [dst,base],
+               kills = []}
+           | PUSH {src, ...}
+           => {uses = [src, Operand.register Register.esp],
+               defs = [Operand.register Register.esp,
+                       Operand.address (Address.T {disp = NONE,
+                                                   base = SOME Register.esp,
+                                                   index = NONE,
+                                                   scale = NONE})], 
+               kills = []}
+           | POP {dst, ...}
+           => {uses = [Operand.register Register.esp,
+                       Operand.address (Address.T {disp = NONE,
+                                                   base = SOME Register.esp,
+                                                   index = NONE,
+                                                   scale = NONE})],
+               defs = [dst, Operand.register Register.esp], 
+               kills = []}
+           | CX {size}
+           => let
+                val (hi,lo) 
+                  = case size
+                      of Size.BYTE 
+                       => (Register.T {reg = Register.EAX, part = Register.H},
+                           Register.T {reg = Register.EAX, part = Register.L})
+                       | Size.WORD 
+                       => (Register.T {reg = Register.EDX, part = Register.X},
+                           Register.T {reg = Register.EAX, part = Register.X})
+                       | Size.LONG
+                       => (Register.T {reg = Register.EDX, part = Register.E},
+                           Register.T {reg = Register.EAX, part = Register.E})
+                       | _ => Error.bug "x86.Instruction.uses_defs: CX, size"
+              in
+                {uses = [Operand.register lo],
+                 defs = [Operand.register hi, Operand.register lo], 
+                 kills = []}
+              end
+           | MOVX {src, dst, ...}
+           => {uses = [src], defs = [dst], kills = []}
+           | XVOM {src, dst, ...}
+           => {uses = [src], defs = [dst], kills = []}
+           | LEA {src, dst, ...}
+           => {uses = [src], defs = [dst], kills = []}
+           | pFMOV {src, dst, ...}
+           => {uses = [src], defs = [dst], kills = []}
+           | pFMOVX {src, dst, ...}
+           => {uses = [src], defs = [dst], kills = []}
+           | pFXVOM {src, dst, ...}
+           => {uses = [src], defs = [dst], kills = []}
+           | pFLDC {dst, ...}
+           => {uses = [], defs = [dst], kills = []}
+           | pFMOVFI {src, dst, ...}
+           => {uses = [src], defs = [dst], kills = []}
+           | pFMOVTI {src, dst, ...}
+           => {uses = [src], defs = [dst], kills = []}
+           | pFCOM {src1, src2, ...}
+           => {uses = [src1, src2], defs = [], kills = []}
+           | pFUCOM {src1, src2, ...}
+           => {uses = [src1, src2], defs = [], kills = []}
+           | pFBinA {src, dst, ...}
+           => {uses = [src, dst], defs = [dst], kills = []}
+           | pFUnA {dst, ...}
+           => {uses = [dst], defs = [dst], kills = []}
+           | pFPTAN {dst, ...}
+           => {uses = [dst], defs = [dst], kills = []}
+           | pFBinAS {src, dst, ...}
+           => {uses = [src, dst], defs = [dst], kills = []}
+           | pFBinASP {src, dst, ...}
+           => {uses = [src, dst], 
+               defs = [dst], 
+               kills = if Operand.eq(src,dst)
+                         then []
+                         else [src]}
+           | FLD {src, ...}
+           => {uses = [src], 
+               defs = [Operand.fltregister FltRegister.top], 
+               kills = []}
+           | FST {dst, pop, ...}
+           => {uses = [Operand.fltregister FltRegister.top], 
+               defs = [dst], 
+               kills = if pop 
+                         then [Operand.fltregister FltRegister.top] 
+                         else []}
+           | FILD {src, ...}
+           => {uses = [src], 
+               defs = [Operand.fltregister FltRegister.top], 
+               kills = []}
+           | FIST {dst, pop, ...}
+           => {uses = [Operand.fltregister FltRegister.top], 
+               defs = [dst], 
+               kills = if pop 
+                         then [Operand.fltregister FltRegister.top] 
+                         else []}
+           | FXCH {src}
+           => {uses = [src, Operand.fltregister FltRegister.top],
+               defs = [src, Operand.fltregister FltRegister.top], 
+               kills = []}
+           | FLDC {...}
+           => {uses = [], 
+               defs = [Operand.fltregister FltRegister.top], 
+               kills = []}
+           | FLDCW {src}
            => {uses = [src], defs = [], kills = []}
-	   | FSTCW {dst, ...}
-	   => {uses = [], defs = [dst], kills = []}
-	   | FSTSW {dst, ...}
-	   => {uses = [], defs = [dst], kills = []}
-	   | FCOM {src, pop, pop', ...}
-	   => {uses = [src, Operand.fltregister FltRegister.top],
-	       defs = [],
-	       kills = if pop andalso pop'
-			 then [Operand.fltregister FltRegister.top, src]
-		       else if pop
-			 then [Operand.fltregister FltRegister.top]
-		       else []}
-	   | FUCOM {src, pop, pop'}
-	   => {uses = [src, Operand.fltregister FltRegister.top],
-	       defs = [],
-	       kills = if pop andalso pop'
-			 then [Operand.fltregister FltRegister.top, src]
-		       else if pop
-			 then [Operand.fltregister FltRegister.top]
-		       else []}
-	   | FBinA {src, dst, pop, ...}
-	   => {uses = [src, dst], 
-	       defs = [dst], 
-	       kills = if pop then [src] else []}
-	   | FUnA {...}
-	   => {uses = [Operand.fltregister FltRegister.top],
-	       defs = [Operand.fltregister FltRegister.top], kills = []}
-	   | FPTAN
-	   => {uses = [Operand.fltregister FltRegister.top],
-	       defs = [Operand.fltregister FltRegister.top], kills = []}
-	   | FBinAS {...}
-	   => {uses = [Operand.fltregister FltRegister.top,
-		       Operand.fltregister FltRegister.one],
-	       defs = [Operand.fltregister FltRegister.top,
-		       Operand.fltregister FltRegister.one], 
-	       kills = []}
-	   | FBinASP {...}
-	   => {uses = [Operand.fltregister FltRegister.top,
-		       Operand.fltregister FltRegister.one],
-	       defs = [Operand.fltregister FltRegister.one],
-	       kills = [Operand.fltregister FltRegister.top]}
+           | FSTCW {dst, ...}
+           => {uses = [], defs = [dst], kills = []}
+           | FSTSW {dst, ...}
+           => {uses = [], defs = [dst], kills = []}
+           | FCOM {src, pop, pop', ...}
+           => {uses = [src, Operand.fltregister FltRegister.top],
+               defs = [],
+               kills = if pop andalso pop'
+                         then [Operand.fltregister FltRegister.top, src]
+                       else if pop
+                         then [Operand.fltregister FltRegister.top]
+                       else []}
+           | FUCOM {src, pop, pop'}
+           => {uses = [src, Operand.fltregister FltRegister.top],
+               defs = [],
+               kills = if pop andalso pop'
+                         then [Operand.fltregister FltRegister.top, src]
+                       else if pop
+                         then [Operand.fltregister FltRegister.top]
+                       else []}
+           | FBinA {src, dst, pop, ...}
+           => {uses = [src, dst], 
+               defs = [dst], 
+               kills = if pop then [src] else []}
+           | FUnA {...}
+           => {uses = [Operand.fltregister FltRegister.top],
+               defs = [Operand.fltregister FltRegister.top], kills = []}
+           | FPTAN
+           => {uses = [Operand.fltregister FltRegister.top],
+               defs = [Operand.fltregister FltRegister.top], kills = []}
+           | FBinAS {...}
+           => {uses = [Operand.fltregister FltRegister.top,
+                       Operand.fltregister FltRegister.one],
+               defs = [Operand.fltregister FltRegister.top,
+                       Operand.fltregister FltRegister.one], 
+               kills = []}
+           | FBinASP {...}
+           => {uses = [Operand.fltregister FltRegister.top,
+                       Operand.fltregister FltRegister.one],
+               defs = [Operand.fltregister FltRegister.one],
+               kills = [Operand.fltregister FltRegister.top]}
 
       val hints
-	= fn pMD {dst, size, ...}
-	   => let
-		val (hi,lo) 
-		  = case size
-		      of Size.BYTE 
-		       => (Register.T {reg = Register.EAX, part = Register.H},
-			   Register.T {reg = Register.EAX, part = Register.L})
-		       | Size.WORD 
-		       => (Register.T {reg = Register.EDX, part = Register.X},
-			   Register.T {reg = Register.EAX, part = Register.X})
-		       | Size.LONG
-		       => (Register.T {reg = Register.EDX, part = Register.E},
-			   Register.T {reg = Register.EAX, part = Register.E})
-		       | _ => Error.bug "Instruction.hints: MD, size"
+        = fn pMD {dst, size, ...}
+           => let
+                val (hi,lo) 
+                  = case size
+                      of Size.BYTE 
+                       => (Register.T {reg = Register.EAX, part = Register.H},
+                           Register.T {reg = Register.EAX, part = Register.L})
+                       | Size.WORD 
+                       => (Register.T {reg = Register.EDX, part = Register.X},
+                           Register.T {reg = Register.EAX, part = Register.X})
+                       | Size.LONG
+                       => (Register.T {reg = Register.EDX, part = Register.E},
+                           Register.T {reg = Register.EAX, part = Register.E})
+                       | _ => Error.bug "x86.Instruction.hints: MD, size"
 
-		val temp = MemLoc.temp {size = size}
-	      in 
-		[(temp, hi),
-		 (case Operand.deMemloc dst
-		    of SOME memloc => (memloc, lo)
-		     | NONE => (temp, lo))]
-	      end
-	  | MD {src, size, ...}
-	   => let
-		val (hi,lo) 
-		  = case size
-		      of Size.BYTE 
-		       => (Register.T {reg = Register.EAX, part = Register.H},
-			   Register.T {reg = Register.EAX, part = Register.L})
-		       | Size.WORD 
-		       => (Register.T {reg = Register.EDX, part = Register.X},
-			   Register.T {reg = Register.EAX, part = Register.X})
-		       | Size.LONG
-		       => (Register.T {reg = Register.EDX, part = Register.E},
-			   Register.T {reg = Register.EAX, part = Register.E})
-		       | _ => Error.bug "Instruction.hints: MD, size"
-			
-		val temp = MemLoc.temp {size = size}
-	      in 
-		[(temp, hi),
-		 (case Operand.deMemloc src
-		    of SOME memloc => (memloc, lo)
-		     | NONE => (temp, lo))]
-	      end
-	   | SRAL {count, size, ...}
-	   => (case Operand.deMemloc count
-		 of SOME memloc 
-		  => let
-		       val reg
-			 = case size
-			     of Size.BYTE 
-			       => Register.T {reg = Register.ECX, 
-					      part = Register.L}
-			       | Size.WORD 
-			       => Register.T {reg = Register.ECX, 
-					      part = Register.X}
-			       | Size.LONG
-		               => Register.T {reg = Register.ECX, 
-					      part = Register.E}
-		               | _ => Error.bug "Instruction.hints: SRAL, size"
-		     in
-		       [(memloc, reg)]
-		     end
-		  | NONE => [])
-	   | pPUSH {base, ...}
-	   => (case Operand.deMemloc base
-		 of SOME base => [(base,Register.esp)]
-		  | NONE => [])
-	   | pPOP {base, ...}
-	   => (case Operand.deMemloc base
-		 of SOME base => [(base,Register.esp)]
-		  | NONE => [])
-	   | PUSH {...}
-	   => let
-		val temp = MemLoc.temp {size = Size.LONG}
-	      in
-		[(temp,Register.esp)]
-	      end
-	   | POP {...}
-	   => let
-		val temp = MemLoc.temp {size = Size.LONG}
-	      in
-		[(temp,Register.esp)]
-	      end
-	   | _ => []
+                val temp = MemLoc.temp {size = size}
+              in 
+                [(temp, hi),
+                 (case Operand.deMemloc dst
+                    of SOME memloc => (memloc, lo)
+                     | NONE => (temp, lo))]
+              end
+          | MD {src, size, ...}
+           => let
+                val (hi,lo) 
+                  = case size
+                      of Size.BYTE 
+                       => (Register.T {reg = Register.EAX, part = Register.H},
+                           Register.T {reg = Register.EAX, part = Register.L})
+                       | Size.WORD 
+                       => (Register.T {reg = Register.EDX, part = Register.X},
+                           Register.T {reg = Register.EAX, part = Register.X})
+                       | Size.LONG
+                       => (Register.T {reg = Register.EDX, part = Register.E},
+                           Register.T {reg = Register.EAX, part = Register.E})
+                       | _ => Error.bug "x86.Instruction.hints: MD, size"
+                        
+                val temp = MemLoc.temp {size = size}
+              in 
+                [(temp, hi),
+                 (case Operand.deMemloc src
+                    of SOME memloc => (memloc, lo)
+                     | NONE => (temp, lo))]
+              end
+           | SRAL {count, size, ...}
+           => (case Operand.deMemloc count
+                 of SOME memloc 
+                  => let
+                       val reg
+                         = case size
+                             of Size.BYTE 
+                               => Register.T {reg = Register.ECX, 
+                                              part = Register.L}
+                               | Size.WORD 
+                               => Register.T {reg = Register.ECX, 
+                                              part = Register.X}
+                               | Size.LONG
+                               => Register.T {reg = Register.ECX, 
+                                              part = Register.E}
+                               | _ => Error.bug "x86.Instruction.hints: SRAL, size"
+                     in
+                       [(memloc, reg)]
+                     end
+                  | NONE => [])
+           | pPUSH {base, ...}
+           => (case Operand.deMemloc base
+                 of SOME base => [(base,Register.esp)]
+                  | NONE => [])
+           | pPOP {base, ...}
+           => (case Operand.deMemloc base
+                 of SOME base => [(base,Register.esp)]
+                  | NONE => [])
+           | PUSH {...}
+           => let
+                val temp = MemLoc.temp {size = Size.LONG}
+              in
+                [(temp,Register.esp)]
+              end
+           | POP {...}
+           => let
+                val temp = MemLoc.temp {size = Size.LONG}
+              in
+                [(temp,Register.esp)]
+              end
+           | _ => []
 
       val srcs_dsts
-	= fn NOP
-	   => {srcs = NONE, dsts = NONE}
+        = fn NOP
+           => {srcs = NONE, dsts = NONE}
            | BinAL {src, dst, ...}
-	   => {srcs = SOME [src, dst], dsts = SOME [dst]}
-	   | pMD {src, dst, ...}
-	   => {srcs = SOME [src, dst], dsts = SOME [dst]}
-	   | MD {oper, src, size, ...}
-	   => let
-		val (hi,lo) 
-		  = case size
-		      of Size.BYTE 
-		       => (Register.T {reg = Register.EAX, part = Register.H},
-			   Register.T {reg = Register.EAX, part = Register.L})
-		       | Size.WORD 
-		       => (Register.T {reg = Register.EDX, part = Register.X},
-			   Register.T {reg = Register.EAX, part = Register.X})
-		       | Size.LONG
-		       => (Register.T {reg = Register.EDX, part = Register.E},
-			   Register.T {reg = Register.EAX, part = Register.E})
-		       | _ => Error.bug "Instruction.srcs_dsts: MD, size"
-	      in 
-		if oper = IMUL orelse oper = MUL
-		  then {srcs = SOME [src, 
-				     Operand.register lo],
-			dsts = SOME [Operand.register hi, 
-				     Operand.register lo]}
-		  else {srcs = SOME [src, 
-				     Operand.register hi, 
-				     Operand.register lo],
-			dsts = SOME [Operand.register hi, 
-				     Operand.register lo]}
-	      end
-	   | IMUL2 {src, dst, ...}
-	   => {srcs = SOME [src, dst], dsts = SOME [dst]}
-	   | UnAL {dst, ...}
-	   => {srcs = SOME [dst], dsts = SOME [dst]}
-	   | SRAL {count, dst, size, ...}
-	   => if isSome (Operand.deMemloc count)
-		then let
-		       val reg
-			 = case size
-			     of Size.BYTE 
-			       => Register.T {reg = Register.ECX, 
-					      part = Register.L}
-			       | Size.WORD 
-			       => Register.T {reg = Register.ECX, 
-					      part = Register.X}
-			       | Size.LONG
-		               => Register.T {reg = Register.ECX, 
-					      part = Register.E}
-		               | _ => Error.bug "Instruction.srcs_dsts: SRAL, size"
-		     in
-		       {srcs = SOME [count, dst, Operand.register reg], 
-			dsts = SOME [dst]} 
-		     end
-		else {srcs = SOME [count, dst],
-		      dsts = SOME [dst]}
-	   | CMP {src1, src2, ...}
-	   => {srcs = SOME [src1, src2], dsts = NONE}
-	   | TEST {src1, src2, ...}
-	   => {srcs = SOME [src1, src2], dsts = NONE}
-	   | SETcc {dst, ...}
-	   => {srcs = NONE, dsts = SOME [dst]}
-	   | JMP {target, ...}
-	   => {srcs = SOME [target], dsts = NONE}
-	   | Jcc {target, ...}
-	   => {srcs = SOME [target], dsts = NONE}
-	   | CALL {target, ...}
-	   => {srcs = SOME [target], dsts = NONE}
-	   | RET {src}
-	   => {srcs = case src of NONE => NONE | SOME src => SOME [src], 
-	       dsts = NONE} 
-	   | MOV {src, dst, ...}
-	   => {srcs = SOME [src], dsts = SOME [dst]}
-	   | CMOVcc {src, dst, ...}
-	   => {srcs = SOME [src], dsts = SOME [dst]}
-	   | XCHG {src, dst, ...}
-	   => {srcs = SOME [src,dst], dsts = SOME [src,dst]}
-	   | pPUSH {src, base, ...}
-	   => {srcs = SOME [src,base], dsts = SOME [base]}
-	   | pPOP {dst, base, ...}
-	   => {srcs = SOME [base], dsts = SOME [dst,base]}
-	   | PUSH {src, ...}
-	   => {srcs = SOME [src, Operand.register Register.esp],
-	       dsts = SOME [Operand.register Register.esp]}
-	   | POP {dst, ...}
-	   => {srcs = SOME [Operand.register Register.esp],
-	       dsts = SOME [dst, Operand.register Register.esp]}
-	   | CX {size, ...}
-	   => let
-		val (hi,lo) 
-		  = case size
-		      of Size.BYTE 
-		       => (Register.T {reg = Register.EAX, part = Register.H},
-			   Register.T {reg = Register.EAX, part = Register.L})
-		       | Size.WORD 
-		       => (Register.T {reg = Register.EDX, part = Register.X},
-			   Register.T {reg = Register.EAX, part = Register.X})
-		       | Size.LONG
-		       => (Register.T {reg = Register.EDX, part = Register.E},
-			   Register.T {reg = Register.EAX, part = Register.E})
-		       | _ => Error.bug "Instruction.srcs_dsts: CX, size"
-	      in
-		{srcs = SOME [Operand.register lo],
-		 dsts = SOME [Operand.register hi, Operand.register lo]}
-	      end
-	   | MOVX {src, dst, ...}
-	   => {srcs = SOME [src], dsts = SOME [dst]}
-	   | XVOM {src, dst, ...}
-	   => {srcs = SOME [src], dsts = SOME [dst]}
-	   | LEA {src, dst, ...}
-	   => {srcs = SOME [src], dsts = SOME [dst]}
-	   | pFMOV {src, dst, ...}
-	   => {srcs = SOME [src], dsts = SOME [dst]}
-	   | pFMOVX {src, dst, ...}
-	   => {srcs = SOME [src], dsts = SOME [dst]}
-	   | pFXVOM {src, dst, ...}
-	   => {srcs = SOME [src], dsts = SOME [dst]}
-	   | pFLDC {dst, ...}
-	   => {srcs = SOME [], dsts = SOME [dst]}
-	   | pFMOVFI {src, dst, ...}
-	   => {srcs = SOME [src], dsts = SOME [dst]}
-	   | pFMOVTI {src, dst, ...}
-	   => {srcs = SOME [src], dsts = SOME [dst]}
-	   | pFCOM {src1, src2, ...}
-	   => {srcs = SOME [src1, src2], dsts = NONE}
-	   | pFUCOM {src1, src2, ...}
-	   => {srcs = SOME [src1, src2], dsts = NONE}
-	   | pFBinA {src, dst, ...}
-	   => {srcs = SOME [src, dst], dsts = SOME [dst]}
-	   | pFUnA {dst, ...}
-	   => {srcs = SOME [dst], dsts = SOME [dst]}
-	   | pFPTAN {dst, ...}
-	   => {srcs = SOME [dst], dsts = SOME [dst]}
-	   | pFBinAS {src, dst, ...}
-	   => {srcs = SOME [src, dst], dsts = SOME [dst]}
-	   | pFBinASP {src, dst, ...}
-	   => {srcs = SOME [src, dst], 
-	       dsts = SOME [dst]}
-	   | FLD {src, ...}
-	   => {srcs = SOME [src], 
-	       dsts = SOME [Operand.fltregister FltRegister.top]}
-	   | FST {dst, ...}
-	   => {srcs = SOME [Operand.fltregister FltRegister.top], 
-	       dsts = SOME [dst]}
-	   | FILD {src, ...}
-	   => {srcs = SOME [src], 
-	       dsts = SOME [Operand.fltregister FltRegister.top]}
-	   | FIST {dst, ...}
-	   => {srcs = SOME [Operand.fltregister FltRegister.top], 
-	       dsts = SOME [dst]}
-	   | FXCH {src}
-	   => {srcs = SOME [src, Operand.fltregister FltRegister.top],
-	       dsts = SOME [src, Operand.fltregister FltRegister.top]}
-	   | FLDC {...}
-	   => {srcs = NONE, 
-	       dsts = SOME [Operand.fltregister FltRegister.top]}
-	   | FLDCW {src}
+           => {srcs = SOME [src, dst], dsts = SOME [dst]}
+           | pMD {src, dst, ...}
+           => {srcs = SOME [src, dst], dsts = SOME [dst]}
+           | MD {oper, src, size, ...}
+           => let
+                val (hi,lo) 
+                  = case size
+                      of Size.BYTE 
+                       => (Register.T {reg = Register.EAX, part = Register.H},
+                           Register.T {reg = Register.EAX, part = Register.L})
+                       | Size.WORD 
+                       => (Register.T {reg = Register.EDX, part = Register.X},
+                           Register.T {reg = Register.EAX, part = Register.X})
+                       | Size.LONG
+                       => (Register.T {reg = Register.EDX, part = Register.E},
+                           Register.T {reg = Register.EAX, part = Register.E})
+                       | _ => Error.bug "x86.Instruction.srcs_dsts: MD, size"
+              in 
+                if oper = IMUL orelse oper = MUL
+                  then {srcs = SOME [src, 
+                                     Operand.register lo],
+                        dsts = SOME [Operand.register hi, 
+                                     Operand.register lo]}
+                  else {srcs = SOME [src, 
+                                     Operand.register hi, 
+                                     Operand.register lo],
+                        dsts = SOME [Operand.register hi, 
+                                     Operand.register lo]}
+              end
+           | IMUL2 {src, dst, ...}
+           => {srcs = SOME [src, dst], dsts = SOME [dst]}
+           | UnAL {dst, ...}
+           => {srcs = SOME [dst], dsts = SOME [dst]}
+           | SRAL {count, dst, size, ...}
+           => if isSome (Operand.deMemloc count)
+                then let
+                       val reg
+                         = case size
+                             of Size.BYTE 
+                               => Register.T {reg = Register.ECX, 
+                                              part = Register.L}
+                               | Size.WORD 
+                               => Register.T {reg = Register.ECX, 
+                                              part = Register.X}
+                               | Size.LONG
+                               => Register.T {reg = Register.ECX, 
+                                              part = Register.E}
+                               | _ => Error.bug "x86.Instruction.srcs_dsts: SRAL, size"
+                     in
+                       {srcs = SOME [count, dst, Operand.register reg], 
+                        dsts = SOME [dst]} 
+                     end
+                else {srcs = SOME [count, dst],
+                      dsts = SOME [dst]}
+           | CMP {src1, src2, ...}
+           => {srcs = SOME [src1, src2], dsts = NONE}
+           | TEST {src1, src2, ...}
+           => {srcs = SOME [src1, src2], dsts = NONE}
+           | SETcc {dst, ...}
+           => {srcs = NONE, dsts = SOME [dst]}
+           | JMP {target, ...}
+           => {srcs = SOME [target], dsts = NONE}
+           | Jcc {target, ...}
+           => {srcs = SOME [target], dsts = NONE}
+           | CALL {target, ...}
+           => {srcs = SOME [target], dsts = NONE}
+           | RET {src}
+           => {srcs = case src of NONE => NONE | SOME src => SOME [src], 
+               dsts = NONE} 
+           | MOV {src, dst, ...}
+           => {srcs = SOME [src], dsts = SOME [dst]}
+           | CMOVcc {src, dst, ...}
+           => {srcs = SOME [src], dsts = SOME [dst]}
+           | XCHG {src, dst, ...}
+           => {srcs = SOME [src,dst], dsts = SOME [src,dst]}
+           | pPUSH {src, base, ...}
+           => {srcs = SOME [src,base], dsts = SOME [base]}
+           | pPOP {dst, base, ...}
+           => {srcs = SOME [base], dsts = SOME [dst,base]}
+           | PUSH {src, ...}
+           => {srcs = SOME [src, Operand.register Register.esp],
+               dsts = SOME [Operand.register Register.esp]}
+           | POP {dst, ...}
+           => {srcs = SOME [Operand.register Register.esp],
+               dsts = SOME [dst, Operand.register Register.esp]}
+           | CX {size, ...}
+           => let
+                val (hi,lo) 
+                  = case size
+                      of Size.BYTE 
+                       => (Register.T {reg = Register.EAX, part = Register.H},
+                           Register.T {reg = Register.EAX, part = Register.L})
+                       | Size.WORD 
+                       => (Register.T {reg = Register.EDX, part = Register.X},
+                           Register.T {reg = Register.EAX, part = Register.X})
+                       | Size.LONG
+                       => (Register.T {reg = Register.EDX, part = Register.E},
+                           Register.T {reg = Register.EAX, part = Register.E})
+                       | _ => Error.bug "x86.Instruction.srcs_dsts: CX, size"
+              in
+                {srcs = SOME [Operand.register lo],
+                 dsts = SOME [Operand.register hi, Operand.register lo]}
+              end
+           | MOVX {src, dst, ...}
+           => {srcs = SOME [src], dsts = SOME [dst]}
+           | XVOM {src, dst, ...}
+           => {srcs = SOME [src], dsts = SOME [dst]}
+           | LEA {src, dst, ...}
+           => {srcs = SOME [src], dsts = SOME [dst]}
+           | pFMOV {src, dst, ...}
+           => {srcs = SOME [src], dsts = SOME [dst]}
+           | pFMOVX {src, dst, ...}
+           => {srcs = SOME [src], dsts = SOME [dst]}
+           | pFXVOM {src, dst, ...}
+           => {srcs = SOME [src], dsts = SOME [dst]}
+           | pFLDC {dst, ...}
+           => {srcs = SOME [], dsts = SOME [dst]}
+           | pFMOVFI {src, dst, ...}
+           => {srcs = SOME [src], dsts = SOME [dst]}
+           | pFMOVTI {src, dst, ...}
+           => {srcs = SOME [src], dsts = SOME [dst]}
+           | pFCOM {src1, src2, ...}
+           => {srcs = SOME [src1, src2], dsts = NONE}
+           | pFUCOM {src1, src2, ...}
+           => {srcs = SOME [src1, src2], dsts = NONE}
+           | pFBinA {src, dst, ...}
+           => {srcs = SOME [src, dst], dsts = SOME [dst]}
+           | pFUnA {dst, ...}
+           => {srcs = SOME [dst], dsts = SOME [dst]}
+           | pFPTAN {dst, ...}
+           => {srcs = SOME [dst], dsts = SOME [dst]}
+           | pFBinAS {src, dst, ...}
+           => {srcs = SOME [src, dst], dsts = SOME [dst]}
+           | pFBinASP {src, dst, ...}
+           => {srcs = SOME [src, dst], 
+               dsts = SOME [dst]}
+           | FLD {src, ...}
+           => {srcs = SOME [src], 
+               dsts = SOME [Operand.fltregister FltRegister.top]}
+           | FST {dst, ...}
+           => {srcs = SOME [Operand.fltregister FltRegister.top], 
+               dsts = SOME [dst]}
+           | FILD {src, ...}
+           => {srcs = SOME [src], 
+               dsts = SOME [Operand.fltregister FltRegister.top]}
+           | FIST {dst, ...}
+           => {srcs = SOME [Operand.fltregister FltRegister.top], 
+               dsts = SOME [dst]}
+           | FXCH {src}
+           => {srcs = SOME [src, Operand.fltregister FltRegister.top],
+               dsts = SOME [src, Operand.fltregister FltRegister.top]}
+           | FLDC {...}
+           => {srcs = NONE, 
+               dsts = SOME [Operand.fltregister FltRegister.top]}
+           | FLDCW {src}
            => {srcs = SOME [src], dsts = NONE}
-	   | FSTCW {dst, ...}
-	   => {srcs = NONE, dsts = SOME [dst]}
-	   | FSTSW {dst, ...}
-	   => {srcs = NONE, dsts = SOME [dst]}
-	   | FCOM {src, ...}
-	   => {srcs = SOME [src, Operand.fltregister FltRegister.top],
-	       dsts = NONE}
-	   | FUCOM {src, ...}
-	   => {srcs = SOME [src, Operand.fltregister FltRegister.top],
-	       dsts = NONE}
-	   | FBinA {src, dst, ...}
-	   => {srcs = SOME [src, dst], 
-	       dsts = SOME [dst]}
-	   | FUnA {...}
-	   => {srcs = SOME [Operand.fltregister FltRegister.top],
-	       dsts = SOME [Operand.fltregister FltRegister.top]}
-	   | FPTAN
-	   => {srcs = SOME [Operand.fltregister FltRegister.top],
-	       dsts = SOME [Operand.fltregister FltRegister.top]}
-	   | FBinAS {...}
-	   => {srcs = SOME [Operand.fltregister FltRegister.top,
-			    Operand.fltregister FltRegister.one],
-	       dsts = SOME [Operand.fltregister FltRegister.top,
-			    Operand.fltregister FltRegister.one]}
-	   | FBinASP {...}
-	   => {srcs = SOME [Operand.fltregister FltRegister.top,
-			    Operand.fltregister FltRegister.one],
-	       dsts = SOME [Operand.fltregister FltRegister.one]}
+           | FSTCW {dst, ...}
+           => {srcs = NONE, dsts = SOME [dst]}
+           | FSTSW {dst, ...}
+           => {srcs = NONE, dsts = SOME [dst]}
+           | FCOM {src, ...}
+           => {srcs = SOME [src, Operand.fltregister FltRegister.top],
+               dsts = NONE}
+           | FUCOM {src, ...}
+           => {srcs = SOME [src, Operand.fltregister FltRegister.top],
+               dsts = NONE}
+           | FBinA {src, dst, ...}
+           => {srcs = SOME [src, dst], 
+               dsts = SOME [dst]}
+           | FUnA {...}
+           => {srcs = SOME [Operand.fltregister FltRegister.top],
+               dsts = SOME [Operand.fltregister FltRegister.top]}
+           | FPTAN
+           => {srcs = SOME [Operand.fltregister FltRegister.top],
+               dsts = SOME [Operand.fltregister FltRegister.top]}
+           | FBinAS {...}
+           => {srcs = SOME [Operand.fltregister FltRegister.top,
+                            Operand.fltregister FltRegister.one],
+               dsts = SOME [Operand.fltregister FltRegister.top,
+                            Operand.fltregister FltRegister.one]}
+           | FBinASP {...}
+           => {srcs = SOME [Operand.fltregister FltRegister.top,
+                            Operand.fltregister FltRegister.one],
+               dsts = SOME [Operand.fltregister FltRegister.one]}
 
       fun replace replacer
-	= fn NOP
-	   => NOP
-	   | BinAL {oper, src, dst, size}
-	   => BinAL {oper = oper,
-		     src = replacer {use = true, def = false} src,
-		     dst = replacer {use = true, def = true} dst,
-		     size = size}
-	   | pMD {oper, src, dst, size}
-	   => pMD {oper = oper,
-		   src = replacer {use = true, def = false} src,
-		   dst = replacer {use = true, def = true} dst,
-		   size = size}
-	   | MD {oper, src, size}
-	   => MD {oper = oper,
-		  src = replacer {use = true, def = false} src,
-		  size = size}
-	   | IMUL2 {src, dst, size}
-	   => IMUL2 {src = replacer {use = true, def = false} src,
-		     dst = replacer {use = true, def = true} dst,
-		     size = size}
-	   | UnAL {oper, dst, size}
-	   => UnAL {oper = oper,
-		    dst = replacer {use = true, def = true} dst,
-		    size = size}
-	   | SRAL {oper, count, dst, size}
-	   => SRAL {oper = oper,
-		    count = replacer {use = true, def = false} count,
-		    dst = replacer {use = true, def = true} dst,
-		    size = size}
-	   | CMP {src1, src2, size}
-	   => CMP {src1 = replacer {use = true, def = false} src1,
-		   src2 = replacer {use = true, def = false} src2,
-		   size = size}
-	   | TEST {src1, src2, size}
-	   => TEST {src1 = replacer {use = true, def = false} src1,
-		    src2 = replacer {use = true, def = false} src2,
-		    size = size}
-	   | SETcc {condition, dst, size}
-	   => SETcc {condition = condition,
-		     dst = replacer {use = false, def = true} dst,
-		     size = size}
-	   | JMP {target, absolute}
-	   => JMP {target = replacer {use = true, def = false} target,
-		   absolute = absolute}
-	   | Jcc {condition, target}
-	   => Jcc {condition = condition,
-		   target = replacer {use = true, def = false} target}
-	   | CALL {target, absolute}
-	   => CALL {target = replacer {use = true, def = false} target,
-		    absolute = absolute}
-	   | RET {src}
-	   => (case src 
-		 of NONE => RET {src = NONE} 
-		  | SOME src 
-		  => RET {src = SOME (replacer {use = true, def = false} src)})
-	   | MOV {src, dst, size}
-	   => MOV {src = replacer {use = true, def = false} src,
-		   dst = replacer {use = false, def = true} dst,
-		   size = size}
-	   | CMOVcc {condition, src, dst, size}
-	   => CMOVcc {condition = condition,
-		      src = replacer {use = true, def = false} src,
-		      dst = replacer {use = false, def = true} dst,
-		      size = size}
-	   | XCHG {src, dst, size}
-	   => XCHG {src = replacer {use = true, def = true} src,
-		    dst = replacer {use = true, def = true} dst,
-		    size = size}
-	   | pPUSH {src, base, size}
+        = fn NOP
+           => NOP
+           | BinAL {oper, src, dst, size}
+           => BinAL {oper = oper,
+                     src = replacer {use = true, def = false} src,
+                     dst = replacer {use = true, def = true} dst,
+                     size = size}
+           | pMD {oper, src, dst, size}
+           => pMD {oper = oper,
+                   src = replacer {use = true, def = false} src,
+                   dst = replacer {use = true, def = true} dst,
+                   size = size}
+           | MD {oper, src, size}
+           => MD {oper = oper,
+                  src = replacer {use = true, def = false} src,
+                  size = size}
+           | IMUL2 {src, dst, size}
+           => IMUL2 {src = replacer {use = true, def = false} src,
+                     dst = replacer {use = true, def = true} dst,
+                     size = size}
+           | UnAL {oper, dst, size}
+           => UnAL {oper = oper,
+                    dst = replacer {use = true, def = true} dst,
+                    size = size}
+           | SRAL {oper, count, dst, size}
+           => SRAL {oper = oper,
+                    count = replacer {use = true, def = false} count,
+                    dst = replacer {use = true, def = true} dst,
+                    size = size}
+           | CMP {src1, src2, size}
+           => CMP {src1 = replacer {use = true, def = false} src1,
+                   src2 = replacer {use = true, def = false} src2,
+                   size = size}
+           | TEST {src1, src2, size}
+           => TEST {src1 = replacer {use = true, def = false} src1,
+                    src2 = replacer {use = true, def = false} src2,
+                    size = size}
+           | SETcc {condition, dst, size}
+           => SETcc {condition = condition,
+                     dst = replacer {use = false, def = true} dst,
+                     size = size}
+           | JMP {target, absolute}
+           => JMP {target = replacer {use = true, def = false} target,
+                   absolute = absolute}
+           | Jcc {condition, target}
+           => Jcc {condition = condition,
+                   target = replacer {use = true, def = false} target}
+           | CALL {target, absolute}
+           => CALL {target = replacer {use = true, def = false} target,
+                    absolute = absolute}
+           | RET {src}
+           => (case src 
+                 of NONE => RET {src = NONE} 
+                  | SOME src 
+                  => RET {src = SOME (replacer {use = true, def = false} src)})
+           | MOV {src, dst, size}
+           => MOV {src = replacer {use = true, def = false} src,
+                   dst = replacer {use = false, def = true} dst,
+                   size = size}
+           | CMOVcc {condition, src, dst, size}
+           => CMOVcc {condition = condition,
+                      src = replacer {use = true, def = false} src,
+                      dst = replacer {use = false, def = true} dst,
+                      size = size}
+           | XCHG {src, dst, size}
+           => XCHG {src = replacer {use = true, def = true} src,
+                    dst = replacer {use = true, def = true} dst,
+                    size = size}
+           | pPUSH {src, base, size}
            => pPUSH {src = replacer {use = true, def = false} src,
-		     base = replacer {use = true, def = true} base,
-		     size = size}
-	   | pPOP {dst, base, size}
-	   => pPOP {dst = replacer {use = false, def = true} dst,
-		    base = replacer {use = true, def = true} base,
-		    size = size}
-	   | PUSH {src, size}
-	   => PUSH {src = replacer {use = true, def = false} src,
-		    size = size}
-	   | POP {dst, size}
-	   => POP {dst = replacer {use = false, def = true} dst,
-		   size = size}
-	   | CX {size}
-	   => CX {size = size}
-	   | MOVX {oper, src, srcsize, dst, dstsize}
-	   => MOVX {oper = oper,
-		    src = replacer {use = true, def = false} src,
-		    srcsize = srcsize,
-		    dst = replacer {use = false, def = true} dst,
-		    dstsize = dstsize}
-	   | XVOM {src, srcsize, dst, dstsize}
-	   => XVOM {src = replacer {use = true, def = false} src,
-		    srcsize = srcsize,
-		    dst = replacer {use = false, def = true} dst,
-		    dstsize = dstsize}
-	   | LEA {src, dst, size}
-	   => LEA {src = replacer {use = true, def = false} src,
-		   dst = replacer {use = false, def = true} dst,
-		   size = size}
-	   | pFMOV {src, dst, size}
-	   => pFMOV {src = replacer {use = true, def = false} src,
-		     dst = replacer {use = false, def = true} dst,
-		     size = size}
-	   | pFMOVX {src, dst, srcsize, dstsize}
-	   => pFMOVX {src = replacer {use = true, def = false} src,
-		      dst = replacer {use = false, def = true} dst,
-		      srcsize = srcsize, dstsize = dstsize}
-	   | pFXVOM {src, dst, srcsize, dstsize}
-	   => pFXVOM {src = replacer {use = true, def = false} src,
-		      dst = replacer {use = false, def = true} dst,
-		      srcsize = srcsize, dstsize = dstsize}
+                     base = replacer {use = true, def = true} base,
+                     size = size}
+           | pPOP {dst, base, size}
+           => pPOP {dst = replacer {use = false, def = true} dst,
+                    base = replacer {use = true, def = true} base,
+                    size = size}
+           | PUSH {src, size}
+           => PUSH {src = replacer {use = true, def = false} src,
+                    size = size}
+           | POP {dst, size}
+           => POP {dst = replacer {use = false, def = true} dst,
+                   size = size}
+           | CX {size}
+           => CX {size = size}
+           | MOVX {oper, src, srcsize, dst, dstsize}
+           => MOVX {oper = oper,
+                    src = replacer {use = true, def = false} src,
+                    srcsize = srcsize,
+                    dst = replacer {use = false, def = true} dst,
+                    dstsize = dstsize}
+           | XVOM {src, srcsize, dst, dstsize}
+           => XVOM {src = replacer {use = true, def = false} src,
+                    srcsize = srcsize,
+                    dst = replacer {use = false, def = true} dst,
+                    dstsize = dstsize}
+           | LEA {src, dst, size}
+           => LEA {src = replacer {use = true, def = false} src,
+                   dst = replacer {use = false, def = true} dst,
+                   size = size}
+           | pFMOV {src, dst, size}
+           => pFMOV {src = replacer {use = true, def = false} src,
+                     dst = replacer {use = false, def = true} dst,
+                     size = size}
+           | pFMOVX {src, dst, srcsize, dstsize}
+           => pFMOVX {src = replacer {use = true, def = false} src,
+                      dst = replacer {use = false, def = true} dst,
+                      srcsize = srcsize, dstsize = dstsize}
+           | pFXVOM {src, dst, srcsize, dstsize}
+           => pFXVOM {src = replacer {use = true, def = false} src,
+                      dst = replacer {use = false, def = true} dst,
+                      srcsize = srcsize, dstsize = dstsize}
            | pFLDC {oper, dst, size}
            => pFLDC {oper = oper,
-		     dst = replacer {use = false, def = true} dst,
-		     size = size}
-	   | pFMOVFI {src, srcsize, dst, dstsize}
-	   => pFMOVFI {src = replacer {use = true, def = false} src,
-		       srcsize = srcsize,
-		       dst = replacer {use = false, def = true} dst,
-		       dstsize = dstsize}
-	   | pFMOVTI {src, dst, srcsize, dstsize}
-	   => pFMOVTI {src = replacer {use = true, def = false} src,
-		       srcsize = srcsize,
-		       dst = replacer {use = false, def = true} dst,
-		       dstsize = dstsize}
-	   | pFCOM {src1, src2, size}
-	   => pFCOM {src1 = replacer {use = true, def = false} src1,
-		     src2 = replacer {use = true, def = false} src2,
-		     size = size}
-	   | pFUCOM {src1, src2, size}
-	   => pFUCOM {src1 = replacer {use = true, def = false} src1,
-		      src2 = replacer {use = true, def = false} src2,
-		      size = size}
-	   | pFBinA {oper, src, dst, size}
-	   => pFBinA {oper = oper,
-		      src = replacer {use = true, def = false} src,
-		      dst = replacer {use = true, def = true} dst,
-		      size = size}
-	   | pFUnA {oper, dst, size}
-	   => pFUnA {oper = oper,
-		     dst = replacer {use = true, def = true} dst,
-		     size = size}
-	   | pFPTAN {dst, size}
-	   => pFPTAN {dst = replacer {use = true, def = true} dst,
-		      size = size}
-	   | pFBinAS {oper, src, dst, size}
-	   => pFBinAS {oper = oper,
-		       src = replacer {use = true, def = false} src,
-		       dst = replacer {use = true, def = true} dst,
-		       size = size}
-	   | pFBinASP {oper, src, dst, size}
-	   => pFBinASP {oper = oper,
-			src = replacer {use = true, def = true} src,
-			dst = replacer {use = true, def = true} dst,
-			size = size}
-	   | FLD {src, size}
-	   => FLD {src = replacer {use = true, def = false} src,
-		   size = size}
-	   | FST {dst, size, pop}
-	   => FST {dst = replacer {use = false, def = true} dst,
-		   size = size,
-		   pop = pop}
-	   | FILD {src, size}
-	   => FILD {src = replacer {use = true, def = false} src,
-		    size = size}
-	   | FIST {dst, size, pop}
-	   => FIST {dst = replacer {use = false, def = true} dst,
-		    size = size,
-		    pop = pop}
-	   | FXCH {src}
-	   => FXCH {src = replacer {use = true, def = true} src}
-	   | FLDC {oper}
-	   => FLDC {oper = oper}
-	   | FLDCW {src}
-	   => FLDCW {src = replacer {use = true, def = false} src}
-	   | FSTCW {dst, check}
-	   => FSTCW {dst = replacer {use = false, def = true} dst,
-		     check = check}
-	   | FSTSW {dst, check}
-	   => FSTSW {dst = replacer {use = false, def = true} dst,
-		     check = check}
-	   | FCOM {src, size, pop, pop'}
-	   => FCOM {src = replacer {use = true, def = false} src,
-		    size = size, 
-		    pop = pop,
-		    pop' = pop'}
-	   | FUCOM {src, pop, pop'}
-	   => FUCOM {src = replacer {use = true, def = false} src,
-		     pop = pop,
-		     pop' = pop'}
-	   | FBinA {oper, src, dst, size, pop}
-	   => FBinA {oper = oper,
-		     src = replacer {use = true, def = false} src,
-		     dst = replacer {use = true, def = true} dst,
-		     size = size,
-		     pop = pop}
-	   | FUnA {oper}
-	   => FUnA {oper = oper}
-	   | FPTAN
-	   => FPTAN
-	   | FBinAS {oper}
-	   => FBinAS {oper = oper}
-	   | FBinASP {oper}
-	   => FBinASP {oper = oper}
+                     dst = replacer {use = false, def = true} dst,
+                     size = size}
+           | pFMOVFI {src, srcsize, dst, dstsize}
+           => pFMOVFI {src = replacer {use = true, def = false} src,
+                       srcsize = srcsize,
+                       dst = replacer {use = false, def = true} dst,
+                       dstsize = dstsize}
+           | pFMOVTI {src, dst, srcsize, dstsize}
+           => pFMOVTI {src = replacer {use = true, def = false} src,
+                       srcsize = srcsize,
+                       dst = replacer {use = false, def = true} dst,
+                       dstsize = dstsize}
+           | pFCOM {src1, src2, size}
+           => pFCOM {src1 = replacer {use = true, def = false} src1,
+                     src2 = replacer {use = true, def = false} src2,
+                     size = size}
+           | pFUCOM {src1, src2, size}
+           => pFUCOM {src1 = replacer {use = true, def = false} src1,
+                      src2 = replacer {use = true, def = false} src2,
+                      size = size}
+           | pFBinA {oper, src, dst, size}
+           => pFBinA {oper = oper,
+                      src = replacer {use = true, def = false} src,
+                      dst = replacer {use = true, def = true} dst,
+                      size = size}
+           | pFUnA {oper, dst, size}
+           => pFUnA {oper = oper,
+                     dst = replacer {use = true, def = true} dst,
+                     size = size}
+           | pFPTAN {dst, size}
+           => pFPTAN {dst = replacer {use = true, def = true} dst,
+                      size = size}
+           | pFBinAS {oper, src, dst, size}
+           => pFBinAS {oper = oper,
+                       src = replacer {use = true, def = false} src,
+                       dst = replacer {use = true, def = true} dst,
+                       size = size}
+           | pFBinASP {oper, src, dst, size}
+           => pFBinASP {oper = oper,
+                        src = replacer {use = true, def = true} src,
+                        dst = replacer {use = true, def = true} dst,
+                        size = size}
+           | FLD {src, size}
+           => FLD {src = replacer {use = true, def = false} src,
+                   size = size}
+           | FST {dst, size, pop}
+           => FST {dst = replacer {use = false, def = true} dst,
+                   size = size,
+                   pop = pop}
+           | FILD {src, size}
+           => FILD {src = replacer {use = true, def = false} src,
+                    size = size}
+           | FIST {dst, size, pop}
+           => FIST {dst = replacer {use = false, def = true} dst,
+                    size = size,
+                    pop = pop}
+           | FXCH {src}
+           => FXCH {src = replacer {use = true, def = true} src}
+           | FLDC {oper}
+           => FLDC {oper = oper}
+           | FLDCW {src}
+           => FLDCW {src = replacer {use = true, def = false} src}
+           | FSTCW {dst, check}
+           => FSTCW {dst = replacer {use = false, def = true} dst,
+                     check = check}
+           | FSTSW {dst, check}
+           => FSTSW {dst = replacer {use = false, def = true} dst,
+                     check = check}
+           | FCOM {src, size, pop, pop'}
+           => FCOM {src = replacer {use = true, def = false} src,
+                    size = size, 
+                    pop = pop,
+                    pop' = pop'}
+           | FUCOM {src, pop, pop'}
+           => FUCOM {src = replacer {use = true, def = false} src,
+                     pop = pop,
+                     pop' = pop'}
+           | FBinA {oper, src, dst, size, pop}
+           => FBinA {oper = oper,
+                     src = replacer {use = true, def = false} src,
+                     dst = replacer {use = true, def = true} dst,
+                     size = size,
+                     pop = pop}
+           | FUnA {oper}
+           => FUnA {oper = oper}
+           | FPTAN
+           => FPTAN
+           | FBinAS {oper}
+           => FBinAS {oper = oper}
+           | FBinASP {oper}
+           => FBinASP {oper = oper}
 
       val nop = fn () => NOP
       val binal = BinAL
@@ -3054,389 +3047,389 @@
   structure Directive =
     struct
       structure Id = 
-	struct
-	  val num : int ref = ref 0
-	  datatype t = T of {num : int,
-			     plist: PropertyList.t}
-	  fun new () = let
-			 val id = T {num = !num,
-				     plist = PropertyList.new ()}
-			 val _ = Int.inc num
-		       in
-			 id
-		       end
-	  val plist = fn T {plist, ...} => plist
-	  val layout
-	    = let
-		open Layout
-	      in
-		fn T {num, ...} => seq [str "RegAlloc", Int.layout num]
-	      end
-	  val toString = Layout.toString o layout
-	end
+        struct
+          val num : int ref = ref 0
+          datatype t = T of {num : int,
+                             plist: PropertyList.t}
+          fun new () = let
+                         val id = T {num = !num,
+                                     plist = PropertyList.new ()}
+                         val _ = Int.inc num
+                       in
+                         id
+                       end
+          val plist = fn T {plist, ...} => plist
+          val layout
+            = let
+                open Layout
+              in
+                fn T {num, ...} => seq [str "RegAlloc", Int.layout num]
+              end
+          val toString = Layout.toString o layout
+        end
       
       datatype t 
         (* Transfers *)
           (* Assert that a memloc is in a register with properties;
-	   * used at top of basic blocks to establish passing convention.
-	   *)
-	= Assume of {assumes: {register: Register.t, 
-			       memloc: MemLoc.t, 
-			       weight: int,
-			       sync: bool,
-			       reserve: bool} list}
+           * used at top of basic blocks to establish passing convention.
+           *)
+        = Assume of {assumes: {register: Register.t, 
+                               memloc: MemLoc.t, 
+                               weight: int,
+                               sync: bool,
+                               reserve: bool} list}
         | FltAssume of {assumes: {memloc: MemLoc.t, 
-				  weight: int,
-				  sync: bool} list}
-	  (* Ensure that memloc is in the register, possibly reserverd; 
-	   * used at bot of basic blocks to establish passing convention,
-	   * also used before C calls to set-up %esp.
-	   *)
-	| Cache of {caches: {register: Register.t,
-			     memloc: MemLoc.t,
-			     reserve: bool} list}
-	| FltCache of {caches: {memloc: MemLoc.t} list}
-	  (* Reset the register allocation;
-	   * used at bot of basic blocks that fall-thru
-	   * to a block with multiple incoming paths of control.
-	   *)
-	| Reset
-	  (* Ensure that memlocs are commited to memory;
-	   * used at bot of basic blocks to establish passing conventions
-	   *)
-	| Force of {commit_memlocs: MemLocSet.t,
-		    commit_classes: ClassSet.t,
-		    remove_memlocs: MemLocSet.t,
-		    remove_classes: ClassSet.t,
-		    dead_memlocs: MemLocSet.t,
-		    dead_classes: ClassSet.t}
-	(* C calls *)
-	  (* Prepare for a C call; i.e., clear all caller save registers;
-	   * also, clear the flt. register stack;
-	   * used before C calls.
-	   *)
-	| CCall
+                                  weight: int,
+                                  sync: bool} list}
+          (* Ensure that memloc is in the register, possibly reserverd; 
+           * used at bot of basic blocks to establish passing convention,
+           * also used before C calls to set-up %esp.
+           *)
+        | Cache of {caches: {register: Register.t,
+                             memloc: MemLoc.t,
+                             reserve: bool} list}
+        | FltCache of {caches: {memloc: MemLoc.t} list}
+          (* Reset the register allocation;
+           * used at bot of basic blocks that fall-thru
+           * to a block with multiple incoming paths of control.
+           *)
+        | Reset
+          (* Ensure that memlocs are commited to memory;
+           * used at bot of basic blocks to establish passing conventions
+           *)
+        | Force of {commit_memlocs: MemLocSet.t,
+                    commit_classes: ClassSet.t,
+                    remove_memlocs: MemLocSet.t,
+                    remove_classes: ClassSet.t,
+                    dead_memlocs: MemLocSet.t,
+                    dead_classes: ClassSet.t}
+        (* C calls *)
+          (* Prepare for a C call; i.e., clear all caller save registers;
+           * also, clear the flt. register stack;
+           * used before C calls.
+           *)
+        | CCall
         (* Assert the return value;
-	 * used after C calls.
-	 *)
+         * used after C calls.
+         *)
         | Return of {returns: {src: Operand.t, dst: MemLoc.t} list}
-	(* Misc. *)
-	  (* Assert that the register is not free for the allocator;
-	   * used ???
-	   *)
-	| Reserve of {registers: Register.t list}
-	  (* Assert that the register is free for the allocator;
-	   * used to free registers at fall-thru;
-	   * also used after C calls to free %esp.
-	   *)
-	| Unreserve of {registers : Register.t list}
-	  (* Clear the floating point stack;
-	   * used at bot of basic blocks to establish passing convention
-	   *)
-	| ClearFlt
-	  (* Save the register allocation in id and
-	   *  assert that live are used at this point;
-	   * used at bot of basic blocks to delay establishment
-	   *  of passing convention to compensation block
-	   *)
-	| SaveRegAlloc of {live: MemLocSet.t,
-			   id: Id.t}
-	  (* Restore the register allocation from id and
-	   *  remove anything tracked that is not live;
-	   * used at bot of basic blocks to delay establishment
-	   *  of passing convention to compensation block
-	   *)
-	| RestoreRegAlloc of {live: MemLocSet.t,
-			      id: Id.t}
+        (* Misc. *)
+          (* Assert that the register is not free for the allocator;
+           * used ???
+           *)
+        | Reserve of {registers: Register.t list}
+          (* Assert that the register is free for the allocator;
+           * used to free registers at fall-thru;
+           * also used after C calls to free %esp.
+           *)
+        | Unreserve of {registers : Register.t list}
+          (* Clear the floating point stack;
+           * used at bot of basic blocks to establish passing convention
+           *)
+        | ClearFlt
+          (* Save the register allocation in id and
+           *  assert that live are used at this point;
+           * used at bot of basic blocks to delay establishment
+           *  of passing convention to compensation block
+           *)
+        | SaveRegAlloc of {live: MemLocSet.t,
+                           id: Id.t}
+          (* Restore the register allocation from id and
+           *  remove anything tracked that is not live;
+           * used at bot of basic blocks to delay establishment
+           *  of passing convention to compensation block
+           *)
+        | RestoreRegAlloc of {live: MemLocSet.t,
+                              id: Id.t}
 
       val toString
-	= fn Assume {assumes}
-	   => concat["Assume: ",
-		     "assumes: ",
-		     List.fold
-		     (assumes,
-		      "",
-		      fn ({register, memloc, sync, reserve, ...}, s)
-		       => concat[MemLoc.toString memloc, 
-				 " -> ", Register.toString register,
-				 if reserve then " (reserved)" else "",
-				 if sync then " (sync)" else "",
-				 " ",
-				 s])]
-	   | FltAssume {assumes}
-	   => concat["FltAssume: ",
-		     "assumes: ",
-		     List.fold
-		     (assumes,
-		      "",
-		      fn ({memloc, sync, ...}, s)
-		       => concat[MemLoc.toString memloc, 
-				 if sync then " (sync)" else "",
-				 " ",
-				 s])]
-	   | Cache {caches}
-	   => concat["Cache: ",
-		     "caches: ",
-		     List.fold
-		     (caches,
-		      "",
-		      fn ({register, memloc, reserve}, s)
-		       => concat[MemLoc.toString memloc, 
-				 " -> ", Register.toString register,
-				 if reserve then " (reserved)" else "",
-				 " ",
-				 s])]
-	   | FltCache {caches}
-	   => concat["FltCache: ",
-		     "caches: ",
-		     List.fold
-		     (caches,
-		      "",
-		      fn ({memloc}, s)
-		       => concat[MemLoc.toString memloc, 
-				 " ",
-				 s])]
-	   | Force {commit_memlocs, commit_classes,
-		    remove_memlocs, remove_classes,
-		    dead_memlocs, dead_classes}
-	   => concat["Force: ", 
-		     "commit_memlocs: ",
-		     MemLocSet.fold
-		     (commit_memlocs,
-		      "",
-		      fn (memloc,s)
-		       => concat[MemLoc.toString memloc, " ", s]),
-		     "commit_classes: ",
-		     ClassSet.fold
-		     (commit_classes,
-		      "",
-		      fn (class,s)
-		       => concat[MemLoc.Class.toString class, " ", s]),
-		     "remove_memlocs: ",
-		     MemLocSet.fold
-		     (remove_memlocs,
-		      "",
-		      fn (memloc,s)
-		       => concat[MemLoc.toString memloc, " ", s]),
-		     "remove_classes: ",
-		     ClassSet.fold
-		     (remove_classes,
-		      "",
-		      fn (class,s)
-		       => concat[MemLoc.Class.toString class, " ", s]),
-		     "dead_memlocs: ",
-		     MemLocSet.fold
-		     (dead_memlocs,
-		      "",
-		      fn (memloc,s)
-		       => concat[MemLoc.toString memloc, " ", s]),
-		     "dead_classes: ",
-		     ClassSet.fold
-		     (dead_classes,
-		      "",
-		      fn (class,s)
-		       => concat[MemLoc.Class.toString class, " ", s])]
-	   | Reset
-	   => concat["Reset"]
-	   | CCall
-	   => concat["CCall"]
-	   | Return {returns}
-	   => concat["Return: ", List.toString (fn {src,dst} =>
-						concat ["(", Operand.toString src,
-							",", MemLoc.toString dst, ")"]) returns]
-	   | Reserve {registers}
-	   => concat["Reserve: ", 
-		     "registers: ",
-		     List.fold(registers,
-			       "",
-			       fn (register,s)
-			        => concat[Register.toString register, " ", s])]
-	   | Unreserve {registers}
-	   => concat["Unreserve: ", 
-		     "registers: ",
-		     List.fold(registers,
-			       "",
-			       fn (register,s)
-			        => concat[Register.toString register, " ", s])]
-	   | ClearFlt
-	   => concat["ClearFlt"]
-	   | SaveRegAlloc {live, id}
-	   => concat["SaveRegAlloc: ", 
-		     "live: ",
-		     MemLocSet.fold
-		     (live,
-		      "",
-		      fn (memloc,s)
-		       => concat[MemLoc.toString memloc, " ", s]),
-		     Id.toString id]
-	   | RestoreRegAlloc {live, id}
-	   => concat["RestoreRegAlloc: ", 
-		     "live: ",
-		     MemLocSet.fold
-		     (live,
-		      "",
-		      fn (memloc,s)
-		       => concat[MemLoc.toString memloc, " ", s]),
-		     Id.toString id]
+        = fn Assume {assumes}
+           => concat["Assume: ",
+                     "assumes: ",
+                     List.fold
+                     (assumes,
+                      "",
+                      fn ({register, memloc, sync, reserve, ...}, s)
+                       => concat[MemLoc.toString memloc, 
+                                 " -> ", Register.toString register,
+                                 if reserve then " (reserved)" else "",
+                                 if sync then " (sync)" else "",
+                                 " ",
+                                 s])]
+           | FltAssume {assumes}
+           => concat["FltAssume: ",
+                     "assumes: ",
+                     List.fold
+                     (assumes,
+                      "",
+                      fn ({memloc, sync, ...}, s)
+                       => concat[MemLoc.toString memloc, 
+                                 if sync then " (sync)" else "",
+                                 " ",
+                                 s])]
+           | Cache {caches}
+           => concat["Cache: ",
+                     "caches: ",
+                     List.fold
+                     (caches,
+                      "",
+                      fn ({register, memloc, reserve}, s)
+                       => concat[MemLoc.toString memloc, 
+                                 " -> ", Register.toString register,
+                                 if reserve then " (reserved)" else "",
+                                 " ",
+                                 s])]
+           | FltCache {caches}
+           => concat["FltCache: ",
+                     "caches: ",
+                     List.fold
+                     (caches,
+                      "",
+                      fn ({memloc}, s)
+                       => concat[MemLoc.toString memloc, 
+                                 " ",
+                                 s])]
+           | Force {commit_memlocs, commit_classes,
+                    remove_memlocs, remove_classes,
+                    dead_memlocs, dead_classes}
+           => concat["Force: ", 
+                     "commit_memlocs: ",
+                     MemLocSet.fold
+                     (commit_memlocs,
+                      "",
+                      fn (memloc,s)
+                       => concat[MemLoc.toString memloc, " ", s]),
+                     "commit_classes: ",
+                     ClassSet.fold
+                     (commit_classes,
+                      "",
+                      fn (class,s)
+                       => concat[MemLoc.Class.toString class, " ", s]),
+                     "remove_memlocs: ",
+                     MemLocSet.fold
+                     (remove_memlocs,
+                      "",
+                      fn (memloc,s)
+                       => concat[MemLoc.toString memloc, " ", s]),
+                     "remove_classes: ",
+                     ClassSet.fold
+                     (remove_classes,
+                      "",
+                      fn (class,s)
+                       => concat[MemLoc.Class.toString class, " ", s]),
+                     "dead_memlocs: ",
+                     MemLocSet.fold
+                     (dead_memlocs,
+                      "",
+                      fn (memloc,s)
+                       => concat[MemLoc.toString memloc, " ", s]),
+                     "dead_classes: ",
+                     ClassSet.fold
+                     (dead_classes,
+                      "",
+                      fn (class,s)
+                       => concat[MemLoc.Class.toString class, " ", s])]
+           | Reset
+           => concat["Reset"]
+           | CCall
+           => concat["CCall"]
+           | Return {returns}
+           => concat["Return: ", List.toString (fn {src,dst} =>
+                                                concat ["(", Operand.toString src,
+                                                        ",", MemLoc.toString dst, ")"]) returns]
+           | Reserve {registers}
+           => concat["Reserve: ", 
+                     "registers: ",
+                     List.fold(registers,
+                               "",
+                               fn (register,s)
+                                => concat[Register.toString register, " ", s])]
+           | Unreserve {registers}
+           => concat["Unreserve: ", 
+                     "registers: ",
+                     List.fold(registers,
+                               "",
+                               fn (register,s)
+                                => concat[Register.toString register, " ", s])]
+           | ClearFlt
+           => concat["ClearFlt"]
+           | SaveRegAlloc {live, id}
+           => concat["SaveRegAlloc: ", 
+                     "live: ",
+                     MemLocSet.fold
+                     (live,
+                      "",
+                      fn (memloc,s)
+                       => concat[MemLoc.toString memloc, " ", s]),
+                     Id.toString id]
+           | RestoreRegAlloc {live, id}
+           => concat["RestoreRegAlloc: ", 
+                     "live: ",
+                     MemLocSet.fold
+                     (live,
+                      "",
+                      fn (memloc,s)
+                       => concat[MemLoc.toString memloc, " ", s]),
+                     Id.toString id]
       val layout = Layout.str o toString
 
       val uses_defs_kills
-	= fn Assume {assumes}
-	   => List.fold
-	      (assumes,
-	       {uses = [], defs = [], kills = []},
-	       fn ({register, memloc, ...},
-		   {uses, defs, ...})
-	        => {uses = (Operand.memloc memloc)::uses,
-		    defs = (Operand.register register)::defs, 
-		    kills = []})
-	   | FltAssume {assumes}
-	   => List.fold
-	      (assumes,
-	       {uses = [], defs = [], kills = []},
-	       fn ({memloc, ...},
-		   {uses, defs, ...})
-	        => {uses = (Operand.memloc memloc)::uses,
-		    defs = defs, 
-		    kills = []})
-	   | Cache {caches}
-	   => List.fold
-	      (caches,
-	       {uses = [], defs = [], kills = []},
-	       fn ({register, memloc, ...},
-		   {uses, defs, ...})
-	        => {uses = (Operand.memloc memloc)::uses,
-		    defs = (Operand.register register)::defs, 
-		    kills = []})
-	   | FltCache {caches}
-	   => List.fold
-	      (caches,
-	       {uses = [], defs = [], kills = []},
-	       fn ({memloc, ...},
-		   {uses, defs, ...})
-	        => {uses = (Operand.memloc memloc)::uses,
-		    defs = defs, 
-		    kills = []})
-	   | Reset => {uses = [], defs = [], kills = []}
+        = fn Assume {assumes}
+           => List.fold
+              (assumes,
+               {uses = [], defs = [], kills = []},
+               fn ({register, memloc, ...},
+                   {uses, defs, ...})
+                => {uses = (Operand.memloc memloc)::uses,
+                    defs = (Operand.register register)::defs, 
+                    kills = []})
+           | FltAssume {assumes}
+           => List.fold
+              (assumes,
+               {uses = [], defs = [], kills = []},
+               fn ({memloc, ...},
+                   {uses, defs, ...})
+                => {uses = (Operand.memloc memloc)::uses,
+                    defs = defs, 
+                    kills = []})
+           | Cache {caches}
+           => List.fold
+              (caches,
+               {uses = [], defs = [], kills = []},
+               fn ({register, memloc, ...},
+                   {uses, defs, ...})
+                => {uses = (Operand.memloc memloc)::uses,
+                    defs = (Operand.register register)::defs, 
+                    kills = []})
+           | FltCache {caches}
+           => List.fold
+              (caches,
+               {uses = [], defs = [], kills = []},
+               fn ({memloc, ...},
+                   {uses, defs, ...})
+                => {uses = (Operand.memloc memloc)::uses,
+                    defs = defs, 
+                    kills = []})
+           | Reset => {uses = [], defs = [], kills = []}
            | Force {commit_memlocs, remove_memlocs, ...}
-	   => {uses = List.map(MemLocSet.toList commit_memlocs, Operand.memloc) @
-	              List.map(MemLocSet.toList remove_memlocs, Operand.memloc),
-	       defs = [], 
-	       kills = []}
-	   | CCall => {uses = [], defs = [], kills = []}
+           => {uses = List.map(MemLocSet.toList commit_memlocs, Operand.memloc) @
+                      List.map(MemLocSet.toList remove_memlocs, Operand.memloc),
+               defs = [], 
+               kills = []}
+           | CCall => {uses = [], defs = [], kills = []}
            | Return {returns}
-	   => let 
-		 val uses = List.map(returns, fn {src, ...} => src)
-		 val defs = List.map(returns, fn {dst, ...} => Operand.memloc dst)
-	      in
-		 {uses = uses, defs = defs, kills = []}
-	      end
-	   | Reserve {...} => {uses = [], defs = [], kills = []}
-	   | Unreserve {...} => {uses = [], defs = [], kills = []}
-	   | ClearFlt => {uses = [], defs = [], kills = []}
-	   | SaveRegAlloc {live, ...} 
-	   => {uses = List.map(MemLocSet.toList live, Operand.memloc), 
-	       defs = [], 
-	       kills = []}
-	   | RestoreRegAlloc {...} 
-	   => {uses = [], defs = [], kills = []}
+           => let 
+                 val uses = List.map(returns, fn {src, ...} => src)
+                 val defs = List.map(returns, fn {dst, ...} => Operand.memloc dst)
+              in
+                 {uses = uses, defs = defs, kills = []}
+              end
+           | Reserve {...} => {uses = [], defs = [], kills = []}
+           | Unreserve {...} => {uses = [], defs = [], kills = []}
+           | ClearFlt => {uses = [], defs = [], kills = []}
+           | SaveRegAlloc {live, ...} 
+           => {uses = List.map(MemLocSet.toList live, Operand.memloc), 
+               defs = [], 
+               kills = []}
+           | RestoreRegAlloc {...} 
+           => {uses = [], defs = [], kills = []}
 
       val hints
-	= fn Cache {caches}
-	   => List.map
-	      (caches,
-	       fn {register, memloc, ...} 
-	        => (memloc, register))
-	   | _ => []
+        = fn Cache {caches}
+           => List.map
+              (caches,
+               fn {register, memloc, ...} 
+                => (memloc, register))
+           | _ => []
 
       fun replace replacer
-	= fn Assume {assumes}
-	   => Assume {assumes
-		      = List.map
-		        (assumes,
-			 fn {register, memloc, weight, sync, reserve}
-			  => {register = register,
-			      memloc = memloc,
-			      weight = weight,
-			      sync = sync,
-			      reserve = reserve})}
-	   | FltAssume {assumes}
-	   => FltAssume {assumes
-			 = List.map
-			   (assumes,
-			    fn {memloc, weight, sync}
-			     => {memloc = memloc,
-				 weight = weight,
-				 sync = sync})}
-	   | Cache {caches}
+        = fn Assume {assumes}
+           => Assume {assumes
+                      = List.map
+                        (assumes,
+                         fn {register, memloc, weight, sync, reserve}
+                          => {register = register,
+                              memloc = memloc,
+                              weight = weight,
+                              sync = sync,
+                              reserve = reserve})}
+           | FltAssume {assumes}
+           => FltAssume {assumes
+                         = List.map
+                           (assumes,
+                            fn {memloc, weight, sync}
+                             => {memloc = memloc,
+                                 weight = weight,
+                                 sync = sync})}
+           | Cache {caches}
            => Cache {caches
-		     = List.map
-		       (caches,
-			fn {register, memloc, reserve}
-			 => {register = case replacer {use = false, def = true}
-			                     (Operand.register register)
-					  of Operand.Register register => register
-					   | _ => Error.bug "Directive.replace",
-			     memloc = case replacer {use = true, def = false}
-			                   (Operand.memloc memloc)
-					of Operand.MemLoc memloc => memloc
-					 | _ => Error.bug "Directive.replace",
-			     reserve = reserve})}
-	   | FltCache {caches}
+                     = List.map
+                       (caches,
+                        fn {register, memloc, reserve}
+                         => {register = case replacer {use = false, def = true}
+                                             (Operand.register register)
+                                          of Operand.Register register => register
+                                           | _ => Error.bug "x86.Directive.replace: Cache, register",
+                             memloc = case replacer {use = true, def = false}
+                                           (Operand.memloc memloc)
+                                        of Operand.MemLoc memloc => memloc
+                                         | _ => Error.bug "x86.Directive.replace: Cache, memloc",
+                             reserve = reserve})}
+           | FltCache {caches}
            => FltCache {caches
-			= List.map
-			  (caches,
-			   fn {memloc}
-			    => {memloc = case replacer {use = true, def = false}
-				              (Operand.memloc memloc)
-					   of Operand.MemLoc memloc => memloc
-					    | _ => Error.bug "Directive.replace"})}
-	   | Reset => Reset
-	   | Force {commit_memlocs, commit_classes, 
-		    remove_memlocs, remove_classes,
-		    dead_memlocs, dead_classes}
+                        = List.map
+                          (caches,
+                           fn {memloc}
+                            => {memloc = case replacer {use = true, def = false}
+                                              (Operand.memloc memloc)
+                                           of Operand.MemLoc memloc => memloc
+                                            | _ => Error.bug "x86.Directive.replace: FltCache, memloc"})}
+           | Reset => Reset
+           | Force {commit_memlocs, commit_classes, 
+                    remove_memlocs, remove_classes,
+                    dead_memlocs, dead_classes}
            => Force {commit_memlocs = MemLocSet.map
-		                      (commit_memlocs,
-				       fn memloc
-				        => case replacer 
-				                {use = true, def = false}
-						(Operand.memloc memloc)
-					     of Operand.MemLoc memloc => memloc
-					      | _ => Error.bug "Directive.replace"),
-		     commit_classes = commit_classes,
-		     remove_memlocs = MemLocSet.map
-		                      (remove_memlocs,
-				       fn memloc
-				        => case replacer 
-				                {use = true, def = false}
-						(Operand.memloc memloc)
-					     of Operand.MemLoc memloc => memloc
-					      | _ => Error.bug "Directive.replace"),
-		     remove_classes = remove_classes,
-		     dead_memlocs = MemLocSet.map
-		                    (dead_memlocs,
-				     fn memloc
-				      => case replacer 
-				              {use = false, def = false}
-					      (Operand.memloc memloc)
-					   of Operand.MemLoc memloc => memloc
-				            | _ => Error.bug "Directive.replace"),
-		     dead_classes = dead_classes}
-	   | CCall => CCall
+                                      (commit_memlocs,
+                                       fn memloc
+                                        => case replacer 
+                                                {use = true, def = false}
+                                                (Operand.memloc memloc)
+                                             of Operand.MemLoc memloc => memloc
+                                              | _ => Error.bug "x86.Directive.replace: Force, commit_memlocs"),
+                     commit_classes = commit_classes,
+                     remove_memlocs = MemLocSet.map
+                                      (remove_memlocs,
+                                       fn memloc
+                                        => case replacer 
+                                                {use = true, def = false}
+                                                (Operand.memloc memloc)
+                                             of Operand.MemLoc memloc => memloc
+                                              | _ => Error.bug "x86.Directive.replace: Force, remove_memlocs"),
+                     remove_classes = remove_classes,
+                     dead_memlocs = MemLocSet.map
+                                    (dead_memlocs,
+                                     fn memloc
+                                      => case replacer 
+                                              {use = false, def = false}
+                                              (Operand.memloc memloc)
+                                           of Operand.MemLoc memloc => memloc
+                                            | _ => Error.bug "x86.Directive.replace: Force, dead_memlocs"),
+                     dead_classes = dead_classes}
+           | CCall => CCall
            | Return {returns}
-	   => Return {returns = List.map
+           => Return {returns = List.map
                                 (returns, fn {src,dst} =>
-				 {src = src,
-				  dst = 
-				  case replacer {use = true, def = false}
-				       (Operand.memloc dst)
-				    of Operand.MemLoc memloc => memloc
-				     | _ => Error.bug "Directive.replace"})}
-	   | Reserve {registers} => Reserve {registers = registers}
-	   | Unreserve {registers} => Unreserve {registers = registers}
-	   | ClearFlt => ClearFlt
-	   | SaveRegAlloc {live, id} => SaveRegAlloc {live = live, id = id}
-	   | RestoreRegAlloc {live, id} => RestoreRegAlloc {live = live, id = id}
+                                 {src = src,
+                                  dst = 
+                                  case replacer {use = true, def = false}
+                                       (Operand.memloc dst)
+                                    of Operand.MemLoc memloc => memloc
+                                     | _ => Error.bug "x86.Directive.replace: Return, returns"})}
+           | Reserve {registers} => Reserve {registers = registers}
+           | Unreserve {registers} => Unreserve {registers = registers}
+           | ClearFlt => ClearFlt
+           | SaveRegAlloc {live, id} => SaveRegAlloc {live = live, id = id}
+           | RestoreRegAlloc {live, id} => RestoreRegAlloc {live = live, id = id}
 
       val assume = Assume
       val fltassume = FltAssume
@@ -3456,125 +3449,125 @@
   structure PseudoOp = 
     struct
       datatype t
-	= Data
-	| Text
-	| Balign of Immediate.t * Immediate.t option * Immediate.t option
-	| P2align of Immediate.t * Immediate.t option * Immediate.t option
-	| Space of Immediate.t * Immediate.t
-	| Byte of Immediate.t list
-	| Word of Immediate.t list
-	| Long of Immediate.t list
-	| String of string list
+        = Data
+        | Text
+        | Balign of Immediate.t * Immediate.t option * Immediate.t option
+        | P2align of Immediate.t * Immediate.t option * Immediate.t option
+        | Space of Immediate.t * Immediate.t
+        | Byte of Immediate.t list
+        | Word of Immediate.t list
+        | Long of Immediate.t list
+        | String of string list
         | Global of Label.t
         | Local of Label.t
-	| Comm of Label.t * Immediate.t * Immediate.t option
+        | Comm of Label.t * Immediate.t * Immediate.t option
 
       val layout
-	= let
-	    open Layout
-	  in
-	    fn Data => str ".data"
-	     | Text => str ".text"
-	     | Balign (i,fill,max) 
-	     => seq [str ".balign ", 
-		     Immediate.layout i,
-		     case (fill, max)
-		       of (NONE, NONE) => empty
-			| (SOME fill, NONE) => seq [str ",",
-						    Immediate.layout fill]
-			| (NONE, SOME max) => seq [str ",,",
-						   Immediate.layout max]
-			| (SOME fill, SOME max) => seq [str ",",
-							Immediate.layout fill,
-							str ",",
-							Immediate.layout max]]
-	     | P2align (i,fill,max)
-	     => seq [str ".p2align ", 
-		     Immediate.layout i,
-		     case (fill, max)
-		       of (NONE, NONE) => empty
-			| (SOME fill, NONE) => seq [str ",",
-						    Immediate.layout fill]
-			| (NONE, SOME max) => seq [str ",,",
-						   Immediate.layout max]
-			| (SOME fill, SOME max) => seq [str ",",
-							Immediate.layout fill,
-							str ",",
-							Immediate.layout max]]
-	     | Space (i,f) 
-	     => seq [str ".space ", 
-		     Immediate.layout i, 
-		     str ",", 
-		     Immediate.layout f]
-	     | Byte bs
-	     => seq [str ".byte ",
-		     seq (separate(List.map (bs, Immediate.layout), ","))]
-	     | Word ws
-	     => seq [str ".word ",
-		     seq (separate(List.map (ws, Immediate.layout), ","))]
-	     | Long ls
-	     => seq [str ".long ",
-		     seq (separate(List.map (ls, Immediate.layout), ","))]
-	     | String ss 
-	     => seq [str ".string ",
-		     seq (separate(List.map
-				   (ss,
-				    fn s => seq [str "\"",
-						 str (String_escapeASM s),
-						 str "\""]),
-				   ","))]
-	     | Global l 
-	     => seq [str ".global ",
-		     Label.layout l]
-	     | Local l 
-	     => seq [str ".local ", 
-		     Label.layout l]
-	     | Comm (l, i, a) 
-	     => seq [str ".comm ", 
-		     Label.layout l, 
-		     str ",", 
-		     Immediate.layout i,
-		     case a of NONE => empty 
-		             | SOME i => seq [str ",", Immediate.layout i]]
-	  end
+        = let
+            open Layout
+          in
+            fn Data => str ".data"
+             | Text => str ".text"
+             | Balign (i,fill,max) 
+             => seq [str ".balign ", 
+                     Immediate.layout i,
+                     case (fill, max)
+                       of (NONE, NONE) => empty
+                        | (SOME fill, NONE) => seq [str ",",
+                                                    Immediate.layout fill]
+                        | (NONE, SOME max) => seq [str ",,",
+                                                   Immediate.layout max]
+                        | (SOME fill, SOME max) => seq [str ",",
+                                                        Immediate.layout fill,
+                                                        str ",",
+                                                        Immediate.layout max]]
+             | P2align (i,fill,max)
+             => seq [str ".p2align ", 
+                     Immediate.layout i,
+                     case (fill, max)
+                       of (NONE, NONE) => empty
+                        | (SOME fill, NONE) => seq [str ",",
+                                                    Immediate.layout fill]
+                        | (NONE, SOME max) => seq [str ",,",
+                                                   Immediate.layout max]
+                        | (SOME fill, SOME max) => seq [str ",",
+                                                        Immediate.layout fill,
+                                                        str ",",
+                                                        Immediate.layout max]]
+             | Space (i,f) 
+             => seq [str ".space ", 
+                     Immediate.layout i, 
+                     str ",", 
+                     Immediate.layout f]
+             | Byte bs
+             => seq [str ".byte ",
+                     seq (separate(List.map (bs, Immediate.layout), ","))]
+             | Word ws
+             => seq [str ".word ",
+                     seq (separate(List.map (ws, Immediate.layout), ","))]
+             | Long ls
+             => seq [str ".long ",
+                     seq (separate(List.map (ls, Immediate.layout), ","))]
+             | String ss 
+             => seq [str ".string ",
+                     seq (separate(List.map
+                                   (ss,
+                                    fn s => seq [str "\"",
+                                                 str (String_escapeASM s),
+                                                 str "\""]),
+                                   ","))]
+             | Global l 
+             => seq [str ".global ",
+                     Label.layout l]
+             | Local l 
+             => seq [str ".local ", 
+                     Label.layout l]
+             | Comm (l, i, a) 
+             => seq [str ".comm ", 
+                     Label.layout l, 
+                     str ",", 
+                     Immediate.layout i,
+                     case a of NONE => empty 
+                             | SOME i => seq [str ",", Immediate.layout i]]
+          end
       val toString = Layout.toString o layout
 
       fun replace replacer
-	= let
-	    val replacerLabel
-	      = fn label 
-		 => case Operand.deLabel 
-			 (replacer {use = true, def = false} 
-			           (Operand.label label))
-		      of SOME label => label
-		       | NONE => Error.bug "PseudoOp.replace: replacerLabel"
-	    val replacerImmediate
-	      = fn immediate
-		 => case Operand.deImmediate
-			 (replacer {use = true, def = false} 
-			           (Operand.immediate immediate))
-			     of SOME immediate => immediate
-			      | NONE => Error.bug "PseudoOp.replace: replacerImmediate"
-	  in
-	    fn Data => Data
-	     | Text => Text
+        = let
+            val replacerLabel
+              = fn label 
+                 => case Operand.deLabel 
+                         (replacer {use = true, def = false} 
+                                   (Operand.label label))
+                      of SOME label => label
+                       | NONE => Error.bug "x86.PseudoOp.replace.replacerLabel"
+            val replacerImmediate
+              = fn immediate
+                 => case Operand.deImmediate
+                         (replacer {use = true, def = false} 
+                                   (Operand.immediate immediate))
+                             of SOME immediate => immediate
+                              | NONE => Error.bug "x86.PseudoOp.replace.replacerImmediate"
+          in
+            fn Data => Data
+             | Text => Text
              | Balign (i,fill,max) => Balign (replacerImmediate i,
-					      Option.map(fill, replacerImmediate),
-					      Option.map(max, replacerImmediate))
-	     | P2align (i,fill,max) => P2align (replacerImmediate i,
-						Option.map(fill, replacerImmediate),
-						Option.map(max, replacerImmediate))
-	     | Space (i,f) => Space (replacerImmediate i, replacerImmediate f)
-	     | Byte bs => Byte (List.map(bs, replacerImmediate))
-	     | Word ws => Word (List.map(ws, replacerImmediate))
-	     | Long ls => Long (List.map(ls, replacerImmediate))
-	     | String ss => String ss
-	     | Global l => Global (replacerLabel l)
-	     | Local l => Local (replacerLabel l)
-	     | Comm (l, i, a) => Comm (replacerLabel l, 
-				       replacerImmediate i,
-				       Option.map(a, replacerImmediate))
-	  end
+                                              Option.map(fill, replacerImmediate),
+                                              Option.map(max, replacerImmediate))
+             | P2align (i,fill,max) => P2align (replacerImmediate i,
+                                                Option.map(fill, replacerImmediate),
+                                                Option.map(max, replacerImmediate))
+             | Space (i,f) => Space (replacerImmediate i, replacerImmediate f)
+             | Byte bs => Byte (List.map(bs, replacerImmediate))
+             | Word ws => Word (List.map(ws, replacerImmediate))
+             | Long ls => Long (List.map(ls, replacerImmediate))
+             | String ss => String ss
+             | Global l => Global (replacerLabel l)
+             | Local l => Local (replacerLabel l)
+             | Comm (l, i, a) => Comm (replacerLabel l, 
+                                       replacerImmediate i,
+                                       Option.map(a, replacerImmediate))
+          end
 
       val data = fn () => Data
       val text = fn () => Text
@@ -3593,48 +3586,48 @@
   structure Assembly =
     struct
       datatype t 
-	= Comment of string
-	| Directive of Directive.t
-	| PseudoOp of PseudoOp.t
-	| Label of Label.t
+        = Comment of string
+        | Directive of Directive.t
+        | PseudoOp of PseudoOp.t
+        | Label of Label.t
         | Instruction of Instruction.t
-							   
+                                                           
       val layout
-	= let
-	    open Layout
-	  in
-	    fn Comment s => seq [str "/* ",  str s, str " */"]
-	     | Directive d => seq [str "# directive: ", Directive.layout d]
-	     | PseudoOp p => seq [PseudoOp.layout p]
-	     | Label l => seq [Label.layout l, str ":"]
-	     | Instruction i => seq [str "\t", Instruction.layout i]
-	  end
+        = let
+            open Layout
+          in
+            fn Comment s => seq [str "/* ",  str s, str " */"]
+             | Directive d => seq [str "# directive: ", Directive.layout d]
+             | PseudoOp p => seq [PseudoOp.layout p]
+             | Label l => seq [Label.layout l, str ":"]
+             | Instruction i => seq [str "\t", Instruction.layout i]
+          end
       val toString = Layout.toString o layout
 
       val uses_defs_kills
-	= fn Comment _ => {uses = [], defs = [], kills = []}
-	   | Directive d => Directive.uses_defs_kills d
-	   | PseudoOp _ => {uses = [], defs = [], kills = []}
-	   | Label _ => {uses = [], defs = [], kills = []}
-	   | Instruction i => Instruction.uses_defs_kills i
+        = fn Comment _ => {uses = [], defs = [], kills = []}
+           | Directive d => Directive.uses_defs_kills d
+           | PseudoOp _ => {uses = [], defs = [], kills = []}
+           | Label _ => {uses = [], defs = [], kills = []}
+           | Instruction i => Instruction.uses_defs_kills i
 
       val hints
-	= fn Comment _ => []
-	   | Directive d => Directive.hints d
-	   | PseudoOp _ => []
-	   | Label _ => []
-	   | Instruction i => Instruction.hints i
+        = fn Comment _ => []
+           | Directive d => Directive.hints d
+           | PseudoOp _ => []
+           | Label _ => []
+           | Instruction i => Instruction.hints i
 
       fun replace replacer
-	= fn Comment s => Comment s
-	   | Directive d => Directive (Directive.replace replacer d)
-	   | PseudoOp p => PseudoOp (PseudoOp.replace replacer p)
-	   | Label l => Label (case Operand.deLabel 
-				    (replacer {use = false, def = true}
-				              (Operand.label l))
-				 of SOME l => l
-				  | NONE => Error.bug "Assembly.replace")
-	   | Instruction i => Instruction (Instruction.replace replacer i)
+        = fn Comment s => Comment s
+           | Directive d => Directive (Directive.replace replacer d)
+           | PseudoOp p => PseudoOp (PseudoOp.replace replacer p)
+           | Label l => Label (case Operand.deLabel 
+                                    (replacer {use = false, def = true}
+                                              (Operand.label l))
+                                 of SOME l => l
+                                  | NONE => Error.bug "x86.Assembly.replace, Label")
+           | Instruction i => Instruction (Instruction.replace replacer i)
 
       val comment = Comment
       val isComment = fn Comment _ => true | _ => false
@@ -3725,111 +3718,111 @@
 
   structure FrameInfo =
      struct
-	datatype t = T of {size: int, 
-			   frameLayoutsIndex: int}
+        datatype t = T of {size: int, 
+                           frameLayoutsIndex: int}
 
-	fun toString (T {size, frameLayoutsIndex})
-	   = concat ["{",
-		     "size = ", Int.toString size, ", ",
-		     "frameLayoutsIndex = ", 
-		     Int.toString frameLayoutsIndex, "}"]
+        fun toString (T {size, frameLayoutsIndex})
+           = concat ["{",
+                     "size = ", Int.toString size, ", ",
+                     "frameLayoutsIndex = ", 
+                     Int.toString frameLayoutsIndex, "}"]
 
-	val frameInfo = T
+        val frameInfo = T
      end
 
   structure Entry =
     struct
       datatype t
-	= Jump of {label: Label.t}
+        = Jump of {label: Label.t}
         | Func of {label: Label.t,
-		   live: MemLocSet.t}
+                   live: MemLocSet.t}
         | Cont of {label: Label.t,
-		   live: MemLocSet.t,
-		   frameInfo: FrameInfo.t}
-	| Handler of {frameInfo: FrameInfo.t,
-		      label: Label.t,
-		      live: MemLocSet.t}
-	| CReturn of {dsts: (Operand.t * Size.t) vector,
-		      frameInfo: FrameInfo.t option,
-		      func: RepType.t CFunction.t,
-		      label: Label.t}
-				    
+                   live: MemLocSet.t,
+                   frameInfo: FrameInfo.t}
+        | Handler of {frameInfo: FrameInfo.t,
+                      label: Label.t,
+                      live: MemLocSet.t}
+        | CReturn of {dsts: (Operand.t * Size.t) vector,
+                      frameInfo: FrameInfo.t option,
+                      func: RepType.t CFunction.t,
+                      label: Label.t}
+                                    
       val toString
-	= fn Jump {label} => concat ["Jump::",
-				     Label.toString label]
-	   | Func {label, live}
-	   => concat ["Func::",
-		      Label.toString label,
-		      " [",
-		      (concat o List.separate)
-		      (MemLocSet.fold
-		       (live,
-			[],
-			fn (memloc, l) => (MemLoc.toString memloc)::l),
-		       ", "),
-		      "]"]
-	   | Cont {label, live, frameInfo} 
-	   => concat ["Cont::",
-		      Label.toString label,
-		      " [",
-		      (concat o List.separate)
-		      (MemLocSet.fold
-		       (live,
-			[],
-			fn (memloc, l) => (MemLoc.toString memloc)::l),
-		       ", "),
-		      "] ",
-		      FrameInfo.toString frameInfo]
-	   | Handler {frameInfo, label, live} 
+        = fn Jump {label} => concat ["Jump::",
+                                     Label.toString label]
+           | Func {label, live}
+           => concat ["Func::",
+                      Label.toString label,
+                      " [",
+                      (concat o List.separate)
+                      (MemLocSet.fold
+                       (live,
+                        [],
+                        fn (memloc, l) => (MemLoc.toString memloc)::l),
+                       ", "),
+                      "]"]
+           | Cont {label, live, frameInfo} 
+           => concat ["Cont::",
+                      Label.toString label,
+                      " [",
+                      (concat o List.separate)
+                      (MemLocSet.fold
+                       (live,
+                        [],
+                        fn (memloc, l) => (MemLoc.toString memloc)::l),
+                       ", "),
+                      "] ",
+                      FrameInfo.toString frameInfo]
+           | Handler {frameInfo, label, live} 
            => concat ["Handler::",
-		      Label.toString label,
-		      " [",
-		      (concat o List.separate)
-		      (MemLocSet.fold
-		       (live,
-			[],
-			fn (memloc, l) => (MemLoc.toString memloc)::l),
-		       ", "),
-		      "] (",
-		      FrameInfo.toString frameInfo,
-		      ")"]
-	   | CReturn {dsts, frameInfo, func, label} 
-	   => concat ["CReturn::",
-		      Label.toString label,
-		      " ",
-		      Vector.toString (fn (dst,_) => Operand.toString dst) dsts,
-		      " ",
-		      (CFunction.Target.toString o CFunction.target) func,
-		      " ",
-		      case frameInfo of
-			 NONE => ""
-		       | SOME f => FrameInfo.toString f]
+                      Label.toString label,
+                      " [",
+                      (concat o List.separate)
+                      (MemLocSet.fold
+                       (live,
+                        [],
+                        fn (memloc, l) => (MemLoc.toString memloc)::l),
+                       ", "),
+                      "] (",
+                      FrameInfo.toString frameInfo,
+                      ")"]
+           | CReturn {dsts, frameInfo, func, label} 
+           => concat ["CReturn::",
+                      Label.toString label,
+                      " ",
+                      Vector.toString (fn (dst,_) => Operand.toString dst) dsts,
+                      " ",
+                      (CFunction.Target.toString o CFunction.target) func,
+                      " ",
+                      case frameInfo of
+                         NONE => ""
+                       | SOME f => FrameInfo.toString f]
 
       val uses_defs_kills
-	= fn CReturn {dsts, func, ...} 
-	   => let
-		 val uses =
-		    List.map (Operand.cReturnTemps (CFunction.return func),
-			      fn {dst, ...} => Operand.memloc dst)
-	      in
-		 {uses = uses, 
-		  defs = Vector.toListMap(dsts, fn (dst, _) => dst), 
-		  kills = []}
-	      end
-	   | _ => {uses = [], defs = [], kills = []}
-	   
+        = fn CReturn {dsts, func, ...} 
+           => let
+                 val uses =
+                    List.map (Operand.cReturnTemps (CFunction.return func),
+                              fn {dst, ...} => Operand.memloc dst)
+              in
+                 {uses = uses, 
+                  defs = Vector.toListMap(dsts, fn (dst, _) => dst), 
+                  kills = []}
+              end
+           | _ => {uses = [], defs = [], kills = []}
+           
       val label
-	= fn Jump {label, ...} => label
-	   | Func {label, ...} => label
-	   | Cont {label, ...} => label
-	   | Handler {label, ...} => label
-	   | CReturn {label, ...} => label
+        = fn Jump {label, ...} => label
+           | Func {label, ...} => label
+           | Cont {label, ...} => label
+           | Handler {label, ...} => label
+           | CReturn {label, ...} => label
 
       val live
-	= fn Func {live, ...} => live
-	   | Cont {live, ...} => live
-	   | Handler {live, ...} => live
-	   | _ => MemLocSet.empty
+        = fn Func {live, ...} => live
+           | Cont {live, ...} => live
+           | Handler {live, ...} => live
+           | _ => MemLocSet.empty
 
       val jump = Jump
       val func = Func
@@ -3839,323 +3832,253 @@
       val creturn = CReturn
 
       val isNear = fn Jump _ => true
-	            | CReturn {func, ...} 
-	            => not (CFunction.maySwitchThreads func)
-	            | _ => false
+                    | CReturn {func, ...} 
+                    => not (CFunction.maySwitchThreads func)
+                    | _ => false
     end
 
   structure Transfer =
     struct
       structure Cases =
-	struct
-	  datatype 'a t
-	    = Char of (char * 'a) list
-	    | Int of (int * 'a) list
-	    | Word of (word * 'a) list
+        struct
+          datatype 'a t = Word of (word * 'a) list
 
-	  val char = Char
-	  val int = Int
-	  val word = Word
+          val word = Word
 
-	  fun isEmpty cases
-	    = case cases
-	       of Char [] => true
-		| Int [] => true
-		| Word [] => true
-		| _ => false 
+          fun isEmpty cases
+            = case cases
+               of Word [] => true
+                | _ => false
 
-	  fun isSingle cases
-	    = case cases
-		of Char [_] => true
-		 | Int [_] => true
-		 | Word [_] => true
-		 | _ => false
+          fun isSingle cases
+            = case cases
+                of Word [_] => true
+                 | _ => false
 
-	  fun extract(cases,f)
-	    = let
-		fun doit [(_,target)] = f target
-		  | doit _ = Error.bug "Transfer.Cases.extract"
-	      in
-		case cases
-		  of Char cases => doit cases
-		   | Int cases => doit cases
-		   | Word cases => doit cases
-	      end
+          fun extract(cases,f)
+            = let
+                fun doit [(k,target)] = f (k, target)
+                  | doit _ = Error.bug "x86.Transfer.Cases.extract"
+              in
+                case cases
+                  of Word cases => doit cases
+              end
 
-	  fun extract'(cases,f,cf',if',wf')
-	    = let
-		fun doit ([(k,target)],f') = (f o f') (k, target)
-		  | doit _ = Error.bug "Transfer.Cases.extract"
-	      in
-		case cases
-		  of Char cases => doit(cases,cf')
-		   | Int cases => doit(cases,if')
-		   | Word cases => doit(cases,wf')
-	      end
+          fun count(cases, p)
+            = let
+                fun doit [] = (0 : int)
+                  | doit ((_,target)::cases) = let
+                                                 val n = doit cases
+                                               in
+                                                 if p target
+                                                   then 1 + n
+                                                   else n
+                                               end
+              in
+                case cases
+                  of Word cases => doit cases
+              end
 
-	  fun count(cases, p)
-	    = let
-		fun doit [] = (0 : int)
-		  | doit ((_,target)::cases) = let
-						 val n = doit cases
-					       in
-						 if p target
-						   then 1 + n
-						   else n
-					       end
-	      in
-		case cases
-		  of Char cases => doit cases
-		   | Int cases => doit cases
-		   | Word cases => doit cases
-	      end
+          fun keepAll(cases, p)
+            = let
+                fun doit l = List.keepAll(l, fn (k,target) => p (k,target))
+              in
+                case cases
+                  of Word cases => Word(doit cases)
+              end
 
-	  fun keepAll(cases, p)
-	    = let
-		fun doit l = List.keepAll(l, fn (_,target) => p target)
-	      in
-		case cases
-		  of Char cases => Char(doit cases)
-		   | Int cases => Int(doit cases)
-		   | Word cases => Word(doit cases)
-	      end
+          fun forall(cases, f)
+            = let
+                fun doit l = List.forall(l, fn (k, target) => f (k, target))
+              in
+                case cases
+                  of Word cases => doit cases
+              end
 
-	  fun keepAll'(cases, p, cp', ip', wp')
-	    = let
-		fun doit (l, p') = List.keepAll(l, p o p')
-	      in
-		case cases
-		  of Char cases => Char(doit(cases,cp'))
-		   | Int cases => Int(doit(cases,ip'))
-		   | Word cases => Word(doit(cases,wp'))
-	      end
+          fun foreach(cases, f)
+            = let
+                fun doit l = List.foreach(l, fn (k, target) => f (k, target))
+              in
+                case cases
+                  of Word cases => doit cases
+              end
 
-	  fun forall(cases, f)
-	    = let
-		fun doit l = List.forall(l, fn (_, target) => f target)
-	      in
-		case cases
-		  of Char cases => doit cases
-		   | Int cases => doit cases
-		   | Word cases => doit cases
-	      end
+          fun map(cases, f)
+            = let
+                fun doit l = List.map(l, fn (k,target) => (k, f (k, target)))
+              in
+                case cases
+                  of Word cases => Word(doit cases)
+              end
 
-	  fun forall'(cases, f, cf', if', wf')
-	    = let
-		fun doit(l,f') = List.forall(l, f o f')
-	      in
-		case cases
-		  of Char cases => doit(cases, cf')
-		   | Int cases => doit(cases, if')
-		   | Word cases => doit(cases, wf')
-	      end
+          fun mapToList(cases, f)
+            = let
+                fun doit l = List.map(l, fn (k,target) => f (k, target))
+              in
+                case cases
+                  of Word cases => doit cases
+              end
+        end
 
-	  fun foreach(cases, f)
-	    = let
-		fun doit l = List.foreach(l, fn (_, target) => f target)
-	      in
-		case cases
-		  of Char cases => doit cases
-		   | Int cases => doit cases
-		   | Word cases => doit cases
-	      end
-
-	  fun foreach'(cases, f, cf', if', wf')
-	    = let
-		fun doit(l,f') = List.foreach(l, f o f')
-	      in
-		case cases
-		  of Char cases => doit(cases, cf')
-		   | Int cases => doit(cases, if')
-		   | Word cases => doit(cases, wf')
-	      end
-
-	  fun map(cases, f)
-	    = let
-		fun doit l = List.map(l, fn (k,target) => (k, f target))
-	      in
-		case cases
-		  of Char cases => Char(doit cases)
-		   | Int cases => Int(doit cases)
-		   | Word cases => Word(doit cases)
-	      end
-
-	  fun map'(cases, f, cf', if', wf')
-	    = let
-		fun doit(l,f') = List.map(l, f o f')
-	      in
-		case cases
-		  of Char cases => doit(cases, cf')
-		   | Int cases => doit(cases, if')
-		   | Word cases => doit(cases, wf')
-	      end
-	end
-
       datatype t
-	= Goto of {target: Label.t}
+        = Goto of {target: Label.t}
         | Iff of {condition: Instruction.condition,
-		  truee: Label.t,
-		  falsee: Label.t}
-	| Switch of {test: Operand.t,
-		     cases: Label.t Cases.t,
-		     default: Label.t}
-	| Tail of {target: Label.t,
-		   live: MemLocSet.t}
-	| NonTail of {target: Label.t,
-		      live: MemLocSet.t,
-		      return: Label.t,
-		      handler: Label.t option,
-		      size: int}
-	| Return of {live: MemLocSet.t}
-	| Raise of {live: MemLocSet.t}
-	| CCall of {args: (Operand.t * Size.t) list,
-		    frameInfo: FrameInfo.t option,
-		    func: RepType.t CFunction.t,
-		    return: Label.t option}
+                  truee: Label.t,
+                  falsee: Label.t}
+        | Switch of {test: Operand.t,
+                     cases: Label.t Cases.t,
+                     default: Label.t}
+        | Tail of {target: Label.t,
+                   live: MemLocSet.t}
+        | NonTail of {target: Label.t,
+                      live: MemLocSet.t,
+                      return: Label.t,
+                      handler: Label.t option,
+                      size: int}
+        | Return of {live: MemLocSet.t}
+        | Raise of {live: MemLocSet.t}
+        | CCall of {args: (Operand.t * Size.t) list,
+                    frameInfo: FrameInfo.t option,
+                    func: RepType.t CFunction.t,
+                    return: Label.t option}
 
       val toString
-	= fn Goto {target}
-	   => concat ["GOTO ",
-		      Label.toString target]
-	   | Iff {condition, truee, falsee}
-	   => concat["IF ", 
-		     Instruction.condition_toString condition,
-		     " THEN GOTO ",
-		     Label.toString truee,
-		     " ELSE GOTO ",
-		     Label.toString falsee]
-	   | Switch {test, cases, default}
-	   => (concat["SWITCH ",
-		      Operand.toString test]) ^
-	      (concat o Cases.map')
-	      (cases,
-	       fn (s, target) => concat[" (",
-					s,
-					" -> GOTO ",
-					Label.toString target,
-					")"],
-	       fn (c, target) => (Char.escapeC c, target),
-	       fn (i, target) => (Int.toString i, target),
-	       fn (w, target) => (Word.toString w, target)) ^
-	      (concat[" GOTO ",
-		      Label.toString default])
-	   | Tail {target, live} 
-	   => concat ["TAIL ", 
-		      Label.toString target,
-		      " [",
-		      (concat o List.separate)
-		      (MemLocSet.fold
-		       (live,
-			[],
-			fn (memloc, l) => (MemLoc.toString memloc)::l),
-		       ", "),
-		      "]"]
-	   | NonTail {target, live, return, handler, size}
-	   => concat ["NONTAIL ",
-		      Label.toString target,
-		      " [",
-		      (concat o List.separate)
-		      (MemLocSet.fold
-		       (live,
-			[],
-			fn (memloc, l) => (MemLoc.toString memloc)::l),
-		       ", "),
-		      "] <",
-		      Label.toString return,
-		      " ",
-		      Int.toString size,
-		      "> {",
-		      case handler 
-			of SOME handler => Label.toString handler
-			 | NONE => "",
-		      "}"]
-	   | Return {live}
-	   => concat ["RETURN",
-		      " [",
-		      (concat o List.separate)
-		      (MemLocSet.fold
-		       (live,
-			[],
-			fn (memloc, l) => (MemLoc.toString memloc)::l),
-		       ", "),
-		      "]"]
-	   | Raise {live}
-	   => concat ["RAISE",	
-		      " [",
-		      (concat o List.separate)
-		      (MemLocSet.fold
-		       (live,
-			[],
-			fn (memloc, l) => (MemLoc.toString memloc)::l),
-		       ", "),
-		      "]"]
-	   | CCall {args, func, return, ...}
-	   => concat ["CCALL ",
-		      (CFunction.Convention.toString o CFunction.convention) func,
-		      " ",
-		      (CFunction.Target.toString o CFunction.target) func,
-		      "(",
-		      (concat o List.separate)
-		      (List.map(args, fn (oper,_) => Operand.toString oper),
-		       ", "),
-		      ") <",
-		      Option.toString Label.toString return,
-		      ">"]
+        = fn Goto {target}
+           => concat ["GOTO ",
+                      Label.toString target]
+           | Iff {condition, truee, falsee}
+           => concat["IF ", 
+                     Instruction.condition_toString condition,
+                     " THEN GOTO ",
+                     Label.toString truee,
+                     " ELSE GOTO ",
+                     Label.toString falsee]
+           | Switch {test, cases, default}
+           => (concat["SWITCH ",
+                      Operand.toString test]) ^
+              (concat o Cases.mapToList)
+              (cases,
+               fn (w, target) => concat[" (",
+                                        Word.toString w,
+                                        " -> GOTO ",
+                                        Label.toString target,
+                                        ")"]) ^
+              (concat[" GOTO ",
+                      Label.toString default])
+           | Tail {target, live} 
+           => concat ["TAIL ", 
+                      Label.toString target,
+                      " [",
+                      (concat o List.separate)
+                      (MemLocSet.fold
+                       (live,
+                        [],
+                        fn (memloc, l) => (MemLoc.toString memloc)::l),
+                       ", "),
+                      "]"]
+           | NonTail {target, live, return, handler, size}
+           => concat ["NONTAIL ",
+                      Label.toString target,
+                      " [",
+                      (concat o List.separate)
+                      (MemLocSet.fold
+                       (live,
+                        [],
+                        fn (memloc, l) => (MemLoc.toString memloc)::l),
+                       ", "),
+                      "] <",
+                      Label.toString return,
+                      " ",
+                      Int.toString size,
+                      "> {",
+                      case handler 
+                        of SOME handler => Label.toString handler
+                         | NONE => "",
+                      "}"]
+           | Return {live}
+           => concat ["RETURN",
+                      " [",
+                      (concat o List.separate)
+                      (MemLocSet.fold
+                       (live,
+                        [],
+                        fn (memloc, l) => (MemLoc.toString memloc)::l),
+                       ", "),
+                      "]"]
+           | Raise {live}
+           => concat ["RAISE",  
+                      " [",
+                      (concat o List.separate)
+                      (MemLocSet.fold
+                       (live,
+                        [],
+                        fn (memloc, l) => (MemLoc.toString memloc)::l),
+                       ", "),
+                      "]"]
+           | CCall {args, func, return, ...}
+           => concat ["CCALL ",
+                      (CFunction.Convention.toString o CFunction.convention) func,
+                      " ",
+                      (CFunction.Target.toString o CFunction.target) func,
+                      "(",
+                      (concat o List.separate)
+                      (List.map(args, fn (oper,_) => Operand.toString oper),
+                       ", "),
+                      ") <",
+                      Option.toString Label.toString return,
+                      ">"]
 
       val uses_defs_kills
-	= fn Switch {test, ...}
-	   => {uses = [test], defs = [], kills = []}
-	   | CCall {args, func, ...}
-	   => let
-		 val defs =
-		    List.map (Operand.cReturnTemps (CFunction.return func),
-			      fn {dst, ...} => Operand.memloc dst)
-	      in
-		 {uses = List.map(args, fn (oper,_) => oper),
-		  defs = defs, kills = []}
-	      end
-	   | _ => {uses = [], defs = [], kills = []}
+        = fn Switch {test, ...}
+           => {uses = [test], defs = [], kills = []}
+           | CCall {args, func, ...}
+           => let
+                 val defs =
+                    List.map (Operand.cReturnTemps (CFunction.return func),
+                              fn {dst, ...} => Operand.memloc dst)
+              in
+                 {uses = List.map(args, fn (oper,_) => oper),
+                  defs = defs, kills = []}
+              end
+           | _ => {uses = [], defs = [], kills = []}
 
       val nearTargets
-	= fn Goto {target} => [target]
-	   | Iff {truee,falsee,...} => [truee,falsee]
-	   | Switch {cases,default,...} 
-	   => default::(Cases.map'
-			(cases,
-			 fn target => target,
-			 fn (_,target) => target,
-			 fn (_,target) => target,
-			 fn (_,target) => target))
-	   | NonTail {return,handler,...} => return::(case handler 
-							of NONE => nil
-							 | SOME handler => [handler])
-	   | CCall {return, ...} 
-	   => (case return of
-		 NONE => []
-	       | SOME l => [l])
-	   | _ => []
+        = fn Goto {target} => [target]
+           | Iff {truee,falsee,...} => [truee,falsee]
+           | Switch {cases,default,...} 
+           => default::(Cases.mapToList
+                        (cases,
+                         fn (_,target) => target))
+           | NonTail {return,handler,...} => return::(case handler 
+                                                        of NONE => nil
+                                                         | SOME handler => [handler])
+           | CCall {return, ...} 
+           => (case return of
+                 NONE => []
+               | SOME l => [l])
+           | _ => []
 
       val live
-	= fn Tail {live,...} => live
-	   | NonTail {live,...} => live
-	   | Return {live,...} => live
-	   | Raise {live,...} => live
-	   | _ => MemLocSet.empty
+        = fn Tail {live,...} => live
+           | NonTail {live,...} => live
+           | Return {live,...} => live
+           | Raise {live,...} => live
+           | _ => MemLocSet.empty
 
       fun replace replacer
-	= fn Switch {test, cases, default}
-	   => Switch {test = replacer {use = true, def = false} test,
-		      cases = cases,
-		      default = default}
-	   | CCall {args, frameInfo, func, return}
-	   => CCall {args = List.map(args,
-				     fn (oper,size) => (replacer {use = true,
-								  def = false}
-							         oper,
-							size)),
-		     frameInfo = frameInfo,
-		     func = func,
-		     return = return}
+        = fn Switch {test, cases, default}
+           => Switch {test = replacer {use = true, def = false} test,
+                      cases = cases,
+                      default = default}
+           | CCall {args, frameInfo, func, return}
+           => CCall {args = List.map(args,
+                                     fn (oper,size) => (replacer {use = true,
+                                                                  def = false}
+                                                                 oper,
+                                                        size)),
+                     frameInfo = frameInfo,
+                     func = func,
+                     return = return}
            | transfer => transfer
 
       val goto = Goto
@@ -4173,128 +4096,128 @@
       open ProfileLabel
 
       fun toAssembly pl =
-	let
-	  val label = Label.fromString (toString pl)
-	in
-	  [Assembly.pseudoop_global label,
-	   Assembly.label label]
-	end
+        let
+          val label = Label.fromString (toString pl)
+        in
+          [Assembly.pseudoop_global label,
+           Assembly.label label]
+        end
       fun toAssemblyOpt pl =
-	case pl of
-	  NONE => []
-	| SOME pl => toAssembly pl
+        case pl of
+          NONE => []
+        | SOME pl => toAssembly pl
     end
 
   structure Block =
     struct
       datatype t' = T' of {entry: Entry.t option,
-			   profileLabel: ProfileLabel.t option,
-			   statements: Assembly.t list,
-			   transfer: Transfer.t option}
+                           profileLabel: ProfileLabel.t option,
+                           statements: Assembly.t list,
+                           transfer: Transfer.t option}
       fun mkBlock' {entry, statements, transfer} =
-	T' {entry = entry,
-	    profileLabel = NONE,
-	    statements = statements,
-	    transfer = transfer}
+        T' {entry = entry,
+            profileLabel = NONE,
+            statements = statements,
+            transfer = transfer}
       fun mkProfileBlock' {profileLabel} =
-	T' {entry = NONE,
-	    profileLabel = SOME profileLabel,
-	    statements = [],
-	    transfer = NONE}
+        T' {entry = NONE,
+            profileLabel = SOME profileLabel,
+            statements = [],
+            transfer = NONE}
 
       datatype t = T of {entry: Entry.t,
-			 profileLabel: ProfileLabel.t option,
-			 statements: Assembly.t list,
-			 transfer: Transfer.t}
+                         profileLabel: ProfileLabel.t option,
+                         statements: Assembly.t list,
+                         transfer: Transfer.t}
 
       fun printBlock (T {entry, profileLabel, statements, transfer, ...})
-	= (print (Entry.toString entry);
-	   print ":\n";
-	   Option.app
-	   (profileLabel, fn profileLabel =>
-	    (print (ProfileLabel.toString profileLabel);
-	     print ":\n"));
-	   List.foreach
-	   (statements, fn asm => 
-	    (print (Assembly.toString asm);
-	     print "\n"));
-	   print (Transfer.toString transfer);
-	   print "\n")
+        = (print (Entry.toString entry);
+           print ":\n";
+           Option.app
+           (profileLabel, fn profileLabel =>
+            (print (ProfileLabel.toString profileLabel);
+             print ":\n"));
+           List.foreach
+           (statements, fn asm => 
+            (print (Assembly.toString asm);
+             print "\n"));
+           print (Transfer.toString transfer);
+           print "\n")
 
       fun printBlock' (T' {entry, profileLabel, statements, transfer, ...})
-	= (print (if isSome entry
-		    then Entry.toString (valOf entry)
-		    else "---");
-	   print ":\n";
-	   Option.app
-	   (profileLabel, fn profileLabel =>
-	    (print (ProfileLabel.toString profileLabel);
-	     print ":\n"));
-	   List.foreach
-	   (statements, fn asm => 
-	    (print (Assembly.toString asm);
-	     print "\n"));
-	   print (if isSome transfer
-		    then Transfer.toString (valOf transfer)
-		    else "NONE");
-	   print "\n")
+        = (print (if isSome entry
+                    then Entry.toString (valOf entry)
+                    else "---");
+           print ":\n";
+           Option.app
+           (profileLabel, fn profileLabel =>
+            (print (ProfileLabel.toString profileLabel);
+             print ":\n"));
+           List.foreach
+           (statements, fn asm => 
+            (print (Assembly.toString asm);
+             print "\n"));
+           print (if isSome transfer
+                    then Transfer.toString (valOf transfer)
+                    else "NONE");
+           print "\n")
  
       val compress': t' list -> t' list =
-	 fn l =>
-	 List.fold
-	 (rev l, [],
-	  fn (b' as T' {entry, profileLabel, statements, transfer}, ac) =>
-	  case transfer of
-	     SOME _ => b' :: ac
-	   | NONE =>
-		case ac of
-		   [] => Error.bug "compress' with dangling transfer"
-		 | b2' :: ac =>
-		      let
-			 val T' {entry = entry2,
-				 profileLabel = profileLabel2,
-				 statements = statements2,
-				 transfer = transfer2} = b2'
-		      in
-			 case entry2 of
-			    SOME _ =>
-			       Error.bug "compress' with mismatched transfer"
-			  | NONE =>
-			       let
-				  val (pl, ss) =
-				     case (profileLabel, statements) of
-					(NONE, []) =>
-					   (profileLabel2, statements2)
-				      | _ => 
-					   (profileLabel,
-					    statements
-					    @ (ProfileLabel.toAssemblyOpt
-					       profileLabel2)
-					    @ statements2)
-			       in
-				  T' {entry = entry,
-				      profileLabel = pl,
-				      statements = ss,
-				      transfer = transfer2} :: ac
-			       end
-		      end)
+         fn l =>
+         List.fold
+         (rev l, [],
+          fn (b' as T' {entry, profileLabel, statements, transfer}, ac) =>
+          case transfer of
+             SOME _ => b' :: ac
+           | NONE =>
+                case ac of
+                   [] => Error.bug "x86.Block.compress': dangling transfer"
+                 | b2' :: ac =>
+                      let
+                         val T' {entry = entry2,
+                                 profileLabel = profileLabel2,
+                                 statements = statements2,
+                                 transfer = transfer2} = b2'
+                      in
+                         case entry2 of
+                            SOME _ =>
+                               Error.bug "x86.Block.compress': mismatched transfer"
+                          | NONE =>
+                               let
+                                  val (pl, ss) =
+                                     case (profileLabel, statements) of
+                                        (NONE, []) =>
+                                           (profileLabel2, statements2)
+                                      | _ => 
+                                           (profileLabel,
+                                            statements
+                                            @ (ProfileLabel.toAssemblyOpt
+                                               profileLabel2)
+                                            @ statements2)
+                               in
+                                  T' {entry = entry,
+                                      profileLabel = pl,
+                                      statements = ss,
+                                      transfer = transfer2} :: ac
+                               end
+                      end)
 
       val compress: t' list -> t list =
-	 fn l =>
-	 List.map
-	 (compress' l, fn T' {entry, profileLabel, statements, transfer} =>
-	  case (entry, transfer) of
-	     (SOME e, SOME t) =>
-		T {entry = e,
-		   profileLabel = profileLabel,
-		   statements = statements,
-		   transfer = t}
-	   | _ => Error.bug "compress")
+         fn l =>
+         List.map
+         (compress' l, fn T' {entry, profileLabel, statements, transfer} =>
+          case (entry, transfer) of
+             (SOME e, SOME t) =>
+                T {entry = e,
+                   profileLabel = profileLabel,
+                   statements = statements,
+                   transfer = t}
+           | _ => Error.bug "x86.Block.compress")
     end
 
   structure Chunk =
     struct
       datatype t = T of {data: Assembly.t list,
-			 blocks: Block.t list}
+                         blocks: Block.t list}
     end
 end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/codegen/x86-codegen/x86.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/codegen/x86-codegen/x86.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/codegen/x86-codegen/x86.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 type int = Int.t
 type word = Word.t
 
@@ -37,239 +38,239 @@
 
     structure Size :
       sig
-	datatype class = INT | FLT | FPI
-	val class_toString : class -> string
+        datatype class = INT | FLT | FPI
+        val class_toString : class -> string
 
-	datatype t 
-	  = BYTE | WORD | LONG 
-	  | SNGL | DBLE | EXTD
-	  | FPIS | FPIL | FPIQ
+        datatype t 
+          = BYTE | WORD | LONG 
+          | SNGL | DBLE | EXTD
+          | FPIS | FPIL | FPIQ
 
-	val toString : t -> string
-	val toString' : t -> string
-	val fromBytes : int -> t
-	val toBytes : t -> int
-	val fromCType : CType.t -> t vector
-	val class : t -> class
-	val toFPI : t -> t
-	val eq : t * t -> bool
-	val lt : t * t -> bool
+        val toString : t -> string
+        val toString' : t -> string
+        val fromBytes : int -> t
+        val toBytes : t -> int
+        val fromCType : CType.t -> t vector
+        val class : t -> class
+        val toFPI : t -> t
+        val eq : t * t -> bool
+        val lt : t * t -> bool
       end
 
     structure Register :
       sig
-	datatype reg
-	  = EAX | EBX | ECX | EDX | EDI | ESI | EBP | ESP
-	val allReg : reg list
+        datatype reg
+          = EAX | EBX | ECX | EDX | EDI | ESI | EBP | ESP
+        val allReg : reg list
 
-	datatype part
-	  = E | X | L | H
+        datatype part
+          = E | X | L | H
 
-	datatype t = T of {reg: reg, part: part}
-	val all : t list
+        datatype t = T of {reg: reg, part: part}
+        val all : t list
 
-	val toString : t -> string
-	val size : t -> Size.t
-	val eq : t * t -> bool
-	val valid  : t -> bool
-	val coincide : t * t -> bool
-	val coincident' : reg -> t list
-	val coincident : t -> t list
+        val toString : t -> string
+        val size : t -> Size.t
+        val eq : t * t -> bool
+        val valid  : t -> bool
+        val coincide : t * t -> bool
+        val coincident' : reg -> t list
+        val coincident : t -> t list
 
 (*
-	val return : Size.t -> t
+        val return : Size.t -> t
 *)
-	val eax : t
-	val ebx : t
-	val ecx : t
-	val edx : t
-	val al : t
-	val bl : t
-	val cl : t
-	val dl : t
-	val edi : t
-	val esi : t
-	val esp : t
-	val ebp : t
+        val eax : t
+        val ebx : t
+        val ecx : t
+        val edx : t
+        val al : t
+        val bl : t
+        val cl : t
+        val dl : t
+        val edi : t
+        val esi : t
+        val esp : t
+        val ebp : t
 
-	val registers : Size.t -> t list
-	val baseRegisters : t list
-	val indexRegisters : t list
-	val callerSaveRegisters : t list
-	val calleeSaveRegisters : t list
+        val registers : Size.t -> t list
+        val baseRegisters : t list
+        val indexRegisters : t list
+        val callerSaveRegisters : t list
+        val calleeSaveRegisters : t list
 
-	val withLowPart : Size.t * Size.t -> t list
-	val lowPartOf : t * Size.t -> t
-	val fullPartOf : t * Size.t -> t
+        val withLowPart : Size.t * Size.t -> t list
+        val lowPartOf : t * Size.t -> t
+        val fullPartOf : t * Size.t -> t
       end
 
     structure FltRegister :
       sig
-	datatype t = T of int
-	val toString : t -> string
-	val eq: t * t -> bool
+        datatype t = T of int
+        val toString : t -> string
+        val eq: t * t -> bool
 (*
-	val return : t
+        val return : t
 *)
-	val top : t
-	val one : t
-	val total : int
-	val push : t -> t
-	val pop : t -> t
-	val id : t -> t
+        val top : t
+        val one : t
+        val total : int
+        val push : t -> t
+        val pop : t -> t
+        val id : t -> t
       end
 
     structure Immediate :
       sig
-	type t 
+        type t 
 
-	datatype const
-	  = Char of char
-	  | Int of int
-	  | Word of word
-	datatype un
-	  = Negation
-	  | Complementation
-	datatype bin
-	  = Multiplication
-	  | Division
-	  | Remainder
-	  | ShiftLeft
+        datatype const
+          = Char of char
+          | Int of int
+          | Word of word
+        datatype un
+          = Negation
+          | Complementation
+        datatype bin
+          = Multiplication
+          | Division
+          | Remainder
+          | ShiftLeft
           | ShiftRight
-	  | BitOr
-  	  | BitAnd
-	  | BitXor
-	  | BitOrNot
-	  | Addition
-	  | Subtraction
-	datatype u
-	  = Const of const
+          | BitOr
+          | BitAnd
+          | BitXor
+          | BitOrNot
+          | Addition
+          | Subtraction
+        datatype u
+          = Const of const
           | Label of Label.t
-	  | ImmedUnExp of {oper: un,
-			   exp: t}
-	  | ImmedBinExp of {oper: bin,
-			    exp1: t,
-			    exp2: t}
+          | ImmedUnExp of {oper: un,
+                           exp: t}
+          | ImmedBinExp of {oper: bin,
+                            exp1: t,
+                            exp2: t}
 
-	val const : const -> t
-	val const_char : char -> t
-	val const_int : int -> t
-	val const_word : word -> t
-	val deConst : t -> const option
-	val label : Label.t -> t
-	val deLabel : t -> Label.t option
-	val unexp : {oper: un, 
-		     exp: t} -> t
-	val binexp : {oper: bin, 
-		      exp1: t,
-		      exp2: t} -> t
-	val destruct : t -> u
-	val clearAll : unit -> unit
+        val const : const -> t
+        val const_char : char -> t
+        val const_int : int -> t
+        val const_word : word -> t
+        val deConst : t -> const option
+        val label : Label.t -> t
+        val deLabel : t -> Label.t option
+        val unexp : {oper: un, 
+                     exp: t} -> t
+        val binexp : {oper: bin, 
+                      exp1: t,
+                      exp2: t} -> t
+        val destruct : t -> u
+        val clearAll : unit -> unit
 
-	val eval : t -> word option
-	val zero : t -> bool
-	val eq : t * t -> bool
+        val eval : t -> word option
+        val zero : t -> bool
+        val eq : t * t -> bool
     end
 
     structure Scale : 
       sig
-	datatype t 
-	  = One | Two | Four | Eight
-	val eq : t * t -> bool
-	val toImmediate : t -> Immediate.t
-	val fromBytes : int -> t
-	val fromCType : CType.t -> t
+        datatype t 
+          = One | Two | Four | Eight
+        val eq : t * t -> bool
+        val toImmediate : t -> Immediate.t
+        val fromBytes : int -> t
+        val fromCType : CType.t -> t
       end
 
     structure Address :
       sig
-	datatype t = T of {disp: Immediate.t option,
-			   base: Register.t option,
-			   index: Register.t option,
-			   scale: Scale.t option}
-	val shift : t * Immediate.t -> t
+        datatype t = T of {disp: Immediate.t option,
+                           base: Register.t option,
+                           index: Register.t option,
+                           scale: Scale.t option}
+        val shift : t * Immediate.t -> t
       end
 
     structure MemLoc :
       sig
-	structure Class :
+        structure Class :
           sig
-	    type t
+            type t
 
-	    val toString : t -> string
+            val toString : t -> string
 
-	    val new : {name: string} -> t
-	    val Temp : t
-	    val StaticTemp : t
-	    val CStack : t
-	    val Code : t
+            val new : {name: string} -> t
+            val Temp : t
+            val StaticTemp : t
+            val CStack : t
+            val Code : t
 
-	    val eq : t * t -> bool
-	    val compare : t * t -> order
-	  end
+            val eq : t * t -> bool
+            val compare : t * t -> order
+          end
 
-	type t
+        type t
 
-	datatype u
-	  = U of {immBase: Immediate.t option,
-		  memBase: t option,
-		  immIndex: Immediate.t option,
-		  memIndex: t option,
-		  scale: Scale.t,
-		  size: Size.t,
-		  class: Class.t}
+        datatype u
+          = U of {immBase: Immediate.t option,
+                  memBase: t option,
+                  immIndex: Immediate.t option,
+                  memIndex: t option,
+                  scale: Scale.t,
+                  size: Size.t,
+                  class: Class.t}
 
-	val layout : t -> Layout.t
-	val toString : t -> string
+        val layout : t -> Layout.t
+        val toString : t -> string
 
-	val imm : {base: Immediate.t,
-		   index: Immediate.t,
-		   scale: Scale.t,
-		   size: Size.t,
-		   class: Class.t} -> t
-	val basic : {base: Immediate.t,
-		     index: t,
-		     scale: Scale.t,
-		     size: Size.t,
-		     class: Class.t} -> t
-	val simple : {base: t,
-		      index: Immediate.t,
-		      scale: Scale.t,
-		      size: Size.t,
-		      class: Class.t} -> t
-	val complex : {base: t,
-		       index: t,
-		       scale: Scale.t,
-		       size: Size.t,
-		       class: Class.t} -> t
-	val shift : {origin: t,
-		     disp: Immediate.t,
-		     scale: Scale.t,
-		     size: Size.t} -> t
-	val destruct : t -> u
-	val clearAll : unit -> unit
+        val imm : {base: Immediate.t,
+                   index: Immediate.t,
+                   scale: Scale.t,
+                   size: Size.t,
+                   class: Class.t} -> t
+        val basic : {base: Immediate.t,
+                     index: t,
+                     scale: Scale.t,
+                     size: Size.t,
+                     class: Class.t} -> t
+        val simple : {base: t,
+                      index: Immediate.t,
+                      scale: Scale.t,
+                      size: Size.t,
+                      class: Class.t} -> t
+        val complex : {base: t,
+                       index: t,
+                       scale: Scale.t,
+                       size: Size.t,
+                       class: Class.t} -> t
+        val shift : {origin: t,
+                     disp: Immediate.t,
+                     scale: Scale.t,
+                     size: Size.t} -> t
+        val destruct : t -> u
+        val clearAll : unit -> unit
 
-	val size : t -> Size.t
-	val class : t -> Class.t
-	val eq : t * t -> bool
-	val compare : t * t -> order
+        val size : t -> Size.t
+        val class : t -> Class.t
+        val eq : t * t -> bool
+        val compare : t * t -> order
 
-	val utilized : t -> t list
-	val mayAlias : t * t -> bool
-	val mayAliasOrd : t * t -> order option
+        val utilized : t -> t list
+        val mayAlias : t * t -> bool
+        val mayAliasOrd : t * t -> order option
 
-	val replace : (t -> t) -> t -> t
+        val replace : (t -> t) -> t -> t
 
-	(*
-	 * Static memory locations
-	 *)
-	val makeContents : {base: Immediate.t,
-			    size: Size.t,
-			    class: Class.t} -> t
-	(* CReturn locations *)
+        (*
+         * Static memory locations
+         *)
+        val makeContents : {base: Immediate.t,
+                            size: Size.t,
+                            class: Class.t} -> t
+        (* CReturn locations *)
 (*
-	val cReturnTempContent : Size.t -> t
-	val cReturnTempContents : CFunction.CType.t -> t list
+        val cReturnTempContent : Size.t -> t
+        val cReturnTempContents : CFunction.CType.t -> t list
 *)
     end
 
@@ -280,958 +281,934 @@
 
     structure Operand :
       sig
-	datatype t
-	  = Register of Register.t
-	  | FltRegister of FltRegister.t
-	  | Immediate of Immediate.t
-	  | Label of Label.t
-	  | Address of Address.t
-	  | MemLoc of MemLoc.t
+        datatype t
+          = Register of Register.t
+          | FltRegister of FltRegister.t
+          | Immediate of Immediate.t
+          | Label of Label.t
+          | Address of Address.t
+          | MemLoc of MemLoc.t
 
-	val layout : t -> Layout.t
-	val toString : t -> string
+        val layout : t -> Layout.t
+        val toString : t -> string
 
-	val register : Register.t -> t
-	val deRegister : t -> Register.t option
-	val fltregister : FltRegister.t -> t
-	val deFltregister : t -> FltRegister.t option
-	val immediate : Immediate.t -> t
-	val immediate_const : Immediate.const -> t
-	val immediate_const_char : char -> t
-	val immediate_const_int : int -> t
-	val immediate_const_word : word -> t
-	val immediate_label : Label.t -> t
-	val deImmediate : t -> Immediate.t option
-	val label : Label.t -> t
-	val deLabel : t -> Label.t option
-	val address : Address.t -> t
-	val memloc : MemLoc.t -> t
-	val deMemloc : t -> MemLoc.t option
+        val register : Register.t -> t
+        val deRegister : t -> Register.t option
+        val fltregister : FltRegister.t -> t
+        val deFltregister : t -> FltRegister.t option
+        val immediate : Immediate.t -> t
+        val immediate_const : Immediate.const -> t
+        val immediate_const_char : char -> t
+        val immediate_const_int : int -> t
+        val immediate_const_word : word -> t
+        val immediate_label : Label.t -> t
+        val deImmediate : t -> Immediate.t option
+        val label : Label.t -> t
+        val deLabel : t -> Label.t option
+        val address : Address.t -> t
+        val memloc : MemLoc.t -> t
+        val deMemloc : t -> MemLoc.t option
 
-	val size : t -> Size.t option
-	val eq : t * t -> bool
-	val mayAlias : t * t -> bool
+        val size : t -> Size.t option
+        val eq : t * t -> bool
+        val mayAlias : t * t -> bool
 
-	val cReturnTemps: RepType.t -> {src: t, dst: MemLoc.t} list
+        val cReturnTemps: RepType.t -> {src: t, dst: MemLoc.t} list
       end
 
     structure Instruction :
       sig
-	(* Integer binary arithmetic(w/o mult & div)/logic instructions. *)
-	datatype binal
-	  = ADD (* signed/unsigned addition; p. 63 *)
+        (* Integer binary arithmetic(w/o mult & div)/logic instructions. *)
+        datatype binal
+          = ADD (* signed/unsigned addition; p. 63 *)
           | ADC (* signed/unsigned addition with carry; p. 61 *)
           | SUB (* signed/unsigned subtraction; p. 713 *)
           | SBB (* signed/unsigned subtraction with borrow; p. 667 *)
           | AND (* logical and; p. 70 *)
           | OR  (* logical or; p. 499 *)
           | XOR (* logical xor; p. 758 *)
-	(* Integer multiplication and division. *)
-	datatype md
-	  = IMUL (* signed multiplication (one operand form); p. 335 *)
-	  | MUL  (* unsigned multiplication; p. 488 *)
-	  | IDIV (* signed division; p. 332 *)
-	  | DIV  (* unsigned division; p. 188 *)
-	  | IMOD (* signed modulus; *)
-	  | MOD  (* unsigned modulus; *)
-	(* Integer unary arithmetic/logic instructions. *)
-	datatype unal
-	  = INC (* increment by 1; p. 341 *)
-	  | DEC (* decrement by 1; p. 186 *)
-	  | NEG (* two's complement negation; p. 494 *)
-	  | NOT (* one's complement negation; p. 497 *)
-	(* Integer shift/rotate arithmetic/logic instructions. *)
-	datatype sral
-	  = SAL (* shift arithmetic left; p. 662 *)
-	  | SHL (* shift logical left; p. 662 *)
-	  | SAR (* shift arithmetic right; p. 662 *)
-	  | SHR (* shift logical right; p. 662 *)
-	  | ROL (* rotate left; p. 631 *)
-	  | RCL (* rotate through carry left; p. 631 *)
-	  | ROR (* rotate right; p. 631 *)
-	  | RCR (* rotate through carry right; p. 631 *)
-	(* Move with extention instructions. *)
-	datatype movx
-	  = MOVSX (* move with sign extention; p. 481 *)
-	  | MOVZX (* move with zero extention; p. 486 *)
-	(* Condition test field; p. 795 *)
-	datatype condition
-	  = O   (* overflow *)       | NO  (* not overflow *)
-	  | B   (* below *)          | NB  (* not below *)
-	  | AE  (* above or equal *) | NAE (* not above or equal *)
-	  | C   (* carry *)          | NC  (* not carry *)
-	  | E   (* equal *)          | NE  (* not equal *)
-	  | Z   (* zero *)           | NZ  (* not zero *)
-	  | BE  (* below or equal *) | NBE (* not below or equal *)
-	  | A   (* above *)          | NA  (* not above *)
-	  | S   (* sign *)           | NS  (* not sign *)
-	  | P   (* parity *)         | NP  (* not parity *)
-	  | PE  (* parity even *)    | PO  (* parity odd *)
-	  | L   (* less than *)      
-	  | NL  (* not less than *)
-	  | LE  (* less than or equal *) 
-	  | NLE (* not less than or equal *)
-	  | G   (* greater than *)   
-	  | NG  (* not greater than *)
-	  | GE  (* greater than or equal *) 
-	  | NGE (* not greater than or equal *)
-	val condition_negate : condition -> condition
-	val condition_reverse : condition -> condition
+        (* Integer multiplication and division. *)
+        datatype md
+          = IMUL (* signed multiplication (one operand form); p. 335 *)
+          | MUL  (* unsigned multiplication; p. 488 *)
+          | IDIV (* signed division; p. 332 *)
+          | DIV  (* unsigned division; p. 188 *)
+          | IMOD (* signed modulus; *)
+          | MOD  (* unsigned modulus; *)
+        (* Integer unary arithmetic/logic instructions. *)
+        datatype unal
+          = INC (* increment by 1; p. 341 *)
+          | DEC (* decrement by 1; p. 186 *)
+          | NEG (* two's complement negation; p. 494 *)
+          | NOT (* one's complement negation; p. 497 *)
+        (* Integer shift/rotate arithmetic/logic instructions. *)
+        datatype sral
+          = SAL (* shift arithmetic left; p. 662 *)
+          | SHL (* shift logical left; p. 662 *)
+          | SAR (* shift arithmetic right; p. 662 *)
+          | SHR (* shift logical right; p. 662 *)
+          | ROL (* rotate left; p. 631 *)
+          | RCL (* rotate through carry left; p. 631 *)
+          | ROR (* rotate right; p. 631 *)
+          | RCR (* rotate through carry right; p. 631 *)
+        (* Move with extention instructions. *)
+        datatype movx
+          = MOVSX (* move with sign extention; p. 481 *)
+          | MOVZX (* move with zero extention; p. 486 *)
+        (* Condition test field; p. 795 *)
+        datatype condition
+          = O   (* overflow *)       | NO  (* not overflow *)
+          | B   (* below *)          | NB  (* not below *)
+          | AE  (* above or equal *) | NAE (* not above or equal *)
+          | C   (* carry *)          | NC  (* not carry *)
+          | E   (* equal *)          | NE  (* not equal *)
+          | Z   (* zero *)           | NZ  (* not zero *)
+          | BE  (* below or equal *) | NBE (* not below or equal *)
+          | A   (* above *)          | NA  (* not above *)
+          | S   (* sign *)           | NS  (* not sign *)
+          | P   (* parity *)         | NP  (* not parity *)
+          | PE  (* parity even *)    | PO  (* parity odd *)
+          | L   (* less than *)      
+          | NL  (* not less than *)
+          | LE  (* less than or equal *) 
+          | NLE (* not less than or equal *)
+          | G   (* greater than *)   
+          | NG  (* not greater than *)
+          | GE  (* greater than or equal *) 
+          | NGE (* not greater than or equal *)
+        val condition_negate : condition -> condition
+        val condition_reverse : condition -> condition
 
-	(* Floating-point binary arithmetic instructions. *)
-	datatype fbina
-	  = FADD  (* addition; p. 205 *)
+        (* Floating-point binary arithmetic instructions. *)
+        datatype fbina
+          = FADD  (* addition; p. 205 *)
           | FSUB  (* subtraction; p. 297 *)
-	  | FSUBR (* reversed subtraction; p. 301 *)
-	  | FMUL  (* multiplication; p. 256 *)
-	  | FDIV  (* division; p. 229 *)
-	  | FDIVR (* reversed division; p. 233 *)
-	val fbina_reverse : fbina -> fbina
-	(* Floating-point unary arithmetic instructions. *)
-	datatype funa
-	  = F2XM1   (* compute 2^x-1; p. 201 *)
-	  | FABS    (* absolute value; p. 203 *)
-	  | FCHS    (* change sign; p. 214 *)
-	  | FSQRT   (* square root; p. 284 *)
-	  | FSIN    (* sine; p. 280 *)
-	  | FCOS    (* cosine; p. 226 *)
-	  | FRNDINT (* round to integer; p. 271 *)
-	(* Floating-point binary arithmetic stack instructions. *)
-	datatype fbinas
-	  = FSCALE (* scale; p. 278 *)
-	  | FPREM  (* partial remainder; p. 263 *)
-	  | FPREM1 (* IEEE partial remainder; p. 266 *)
-	(* floating point binary arithmetic stack pop instructions. *)
+          | FSUBR (* reversed subtraction; p. 301 *)
+          | FMUL  (* multiplication; p. 256 *)
+          | FDIV  (* division; p. 229 *)
+          | FDIVR (* reversed division; p. 233 *)
+        val fbina_reverse : fbina -> fbina
+        (* Floating-point unary arithmetic instructions. *)
+        datatype funa
+          = F2XM1   (* compute 2^x-1; p. 201 *)
+          | FABS    (* absolute value; p. 203 *)
+          | FCHS    (* change sign; p. 214 *)
+          | FSQRT   (* square root; p. 284 *)
+          | FSIN    (* sine; p. 280 *)
+          | FCOS    (* cosine; p. 226 *)
+          | FRNDINT (* round to integer; p. 271 *)
+        (* Floating-point binary arithmetic stack instructions. *)
+        datatype fbinas
+          = FSCALE (* scale; p. 278 *)
+          | FPREM  (* partial remainder; p. 263 *)
+          | FPREM1 (* IEEE partial remainder; p. 266 *)
+        (* floating point binary arithmetic stack pop instructions. *)
         datatype fbinasp
-	  = FYL2X   (* compute y * log_2 x; p. 327 *)
-	  | FYL2XP1 (* compute y * log_2 (x + 1.0); p. 329 *)
-	  | FPATAN  (* partial arctangent; p. 261 *)
-	(* Floating-point constants. *)
-	datatype fldc
-	  = ONE  (* +1.0; p. 250 *) 
-	  | ZERO (* +0.0; p. 250 *)
-	  | PI   (* pi; p. 250 *)
-	  | L2E  (* log_2 e; p. 250 *)
-	  | LN2  (* log_e 2; p. 250 *)
-	  | L2T  (* log_2 10; p. 250 *)
-	  | LG2  (* log_10 2; p. 250 *)
+          = FYL2X   (* compute y * log_2 x; p. 327 *)
+          | FYL2XP1 (* compute y * log_2 (x + 1.0); p. 329 *)
+          | FPATAN  (* partial arctangent; p. 261 *)
+        (* Floating-point constants. *)
+        datatype fldc
+          = ONE  (* +1.0; p. 250 *) 
+          | ZERO (* +0.0; p. 250 *)
+          | PI   (* pi; p. 250 *)
+          | L2E  (* log_2 e; p. 250 *)
+          | LN2  (* log_e 2; p. 250 *)
+          | L2T  (* log_2 10; p. 250 *)
+          | LG2  (* log_10 2; p. 250 *)
 
-	(* x86 Instructions.
-	 * src operands are not changed by the instruction.
-	 * dst operands are changed by the instruction.
-	 *)
-	datatype t
-	  = NOP
-	  (* Integer binary arithmetic(w/o mult & div)/logic instructions.
-	   *)
-	  | BinAL of {oper: binal,
-		      src: Operand.t,
-		      dst: Operand.t,
-		      size: Size.t}
-	  (* Psuedo integer multiplication and division.
-	   *)
-	  | pMD of {oper: md,
-		    src: Operand.t,
-		    dst: Operand.t,
-		    size: Size.t}
-	  (* Integer multiplication and division. 
-	   *)
+        (* x86 Instructions.
+         * src operands are not changed by the instruction.
+         * dst operands are changed by the instruction.
+         *)
+        datatype t
+          = NOP
+          (* Integer binary arithmetic(w/o mult & div)/logic instructions.
+           *)
+          | BinAL of {oper: binal,
+                      src: Operand.t,
+                      dst: Operand.t,
+                      size: Size.t}
+          (* Psuedo integer multiplication and division.
+           *)
+          | pMD of {oper: md,
+                    src: Operand.t,
+                    dst: Operand.t,
+                    size: Size.t}
+          (* Integer multiplication and division. 
+           *)
           | MD of {oper: md,
-		   src: Operand.t,
-		   size: Size.t}
-	  (* Integer signed/unsiged multiplication (two operand form); p. 335
-	   *)
-	  | IMUL2 of {src: Operand.t,
-		      dst: Operand.t, 
-		      size: Size.t}
-  	  (* Integer unary arithmetic/logic instructions.
-	   *)
-	  | UnAL of {oper: unal,
-		     dst: Operand.t,
-		     size: Size.t}
-	  (* Integer shift/rotate arithmetic/logic instructions.
-	   *)
-	  | SRAL of {oper: sral,
-		     count: Operand.t,
-		     dst: Operand.t,
-		     size: Size.t}
-	  (* Arithmetic compare.
-	   *)
-	  | CMP  of {src1: Operand.t,
-		     src2: Operand.t,
-		     size: Size.t}
-	  (* Logical compare.
-	   *)
-	  | TEST of {src1: Operand.t,
-		     src2: Operand.t,
-		     size: Size.t}
-	  (* Set byte on condition.
-	   *)
-	  | SETcc of {condition: condition,
-		      dst: Operand.t,
-		      size: Size.t}
-	  (* Jump; p. 373
-	   *)
-	  | JMP of {target: Operand.t,
-		    absolute: bool}
-	  (* Jump if condition is met.
-	   *)
-	  | Jcc of {condition: condition,
-		    target: Operand.t}
-	  (* Call procedure.
-	   *)
-	  | CALL of {target: Operand.t,
-		     absolute: bool}
-	  (* Return from procedure.
-	   *)
-	  | RET of {src: Operand.t option}
-	  (* Move.
-	   *)
-	  | MOV of {src: Operand.t,
-		    dst: Operand.t,
-		    size: Size.t}
-	  (* Conditional move.
-	   *)
-	  | CMOVcc of {condition: condition,
-		       src: Operand.t,
-		       dst: Operand.t,
-		       size: Size.t}
-	  (* Exchange register/memory with register.
-	   *)
-	  | XCHG of {src: Operand.t,
-		     dst: Operand.t,
-		     size: Size.t}
-	  (* Pseudo push a value onto a stack.
-	   *)
-	  | pPUSH of {src: Operand.t,
-		      base: Operand.t,
-		      size: Size.t}
-	  (* Pseudo pop a value from a stack.
-	   *)
-	  | pPOP of {dst: Operand.t,
-		     base: Operand.t,
-		     size: Size.t}
-	  (* Push a value onto the stack.
-	   *)
-	  | PUSH of {src: Operand.t,
-		     size: Size.t}
-	  (* Pop a value from the stack.
-	   *)
-	  | POP of {dst: Operand.t,
-		    size: Size.t}
-	  (* Convert X to 2X with sign extension.
-	   *)
-	  | CX of {size: Size.t}
-	  (* Move with extention.
-	   *)
-	  | MOVX of {oper: movx,
-		     src: Operand.t,
-		     srcsize: Size.t,
-		     dst: Operand.t,
-		     dstsize: Size.t}
-	  (* Move with contraction.
-	   *)
-	  | XVOM of {src: Operand.t,
-		     srcsize: Size.t,
-		     dst: Operand.t,
-		     dstsize: Size.t}
-	  (* Load effective address.
-	   *)
-	  | LEA of {src: Operand.t,
-		    dst: Operand.t,
-		    size: Size.t}
-	  (* Pseudo floating-point move.
-	   *)
-	  | pFMOV of {src: Operand.t,
-		      dst: Operand.t,
-		      size: Size.t}
-	  (* Pseudo floating-point move with extension.
-	   *)
-	  | pFMOVX of {src: Operand.t,
-		       dst: Operand.t,
-		       srcsize: Size.t,
-		       dstsize: Size.t}
-	  (* Pseudo floating-point move with contraction.
-	   *)
-	  | pFXVOM of {src: Operand.t,
-		       dst: Operand.t,
-		       srcsize: Size.t,
-		       dstsize: Size.t}
-	  (* Pseudo floating-point load constant.
-	   *)
-	  | pFLDC of {oper: fldc,
-		      dst: Operand.t,
-		      size: Size.t}
-	  (* Pseudo floating-point move from integer.
-	   *)
-  	  | pFMOVFI of {src: Operand.t,
-			dst: Operand.t,
-			srcsize: Size.t,
-			dstsize: Size.t}
-	  (* Pseudo floating-point move to integer.
-	   *)
-	  | pFMOVTI of {src: Operand.t,
-			dst: Operand.t,
-			srcsize: Size.t,
-  			dstsize: Size.t}
-	  (* Pseudo floating-point compare.
-	   *)
-	  | pFCOM of {src1: Operand.t,
-		      src2: Operand.t,
-		      size: Size.t}
-	  (* Pseudo floating-point unordered compare.
-	   *)
-	  | pFUCOM of {src1: Operand.t,
-		       src2: Operand.t,
-		       size: Size.t}
-	  (* Pseudo floating-point binary arithmetic instructions.
-	   *)
-	  | pFBinA of {oper: fbina, 
-		       src: Operand.t, 
-		       dst: Operand.t,
-		       size: Size.t}
-	  (* Pseudo floating-point unary arithmetic instructions.
-	   *)
-	  | pFUnA of {oper: funa,
-		      dst: Operand.t,
-		      size: Size.t}
-	  (* Pseudo floating-point partial tangetn instruction.
-	   *)
-	  | pFPTAN of {dst: Operand.t,
-		       size: Size.t}
-	  (* Pseudo floating-point binary arithmetic stack instructions.
-	   *)
-	  | pFBinAS of {oper: fbinas, 
-			src: Operand.t, 
-			dst: Operand.t,
-			size: Size.t}
-	  (* Pseudo floating-point binary arithmetic stack pop instructions.
-	   *)
-	  | pFBinASP of {oper: fbinasp, 
-			 src: Operand.t, 
-			 dst: Operand.t,
-			 size: Size.t}
-	  (* Floating-point load real.
-	   *)
-	  | FLD of {src: Operand.t,
-		    size: Size.t}
-	  (* Floating-point store real.
-	   *)
-	  | FST of {dst: Operand.t,
-		    size: Size.t,
-		    pop: bool}
-	  (* Floating-point load integer.
-	   *)
-	  | FILD of {src: Operand.t,
-		     size: Size.t}
-	  (* Floating-point store integer.
-	   *)
-	  | FIST of {dst: Operand.t,
-		     size: Size.t,
-		     pop: bool}
-	  (* Floating-point exchange.
-	   *)
-	  | FXCH of {src: Operand.t}
-	  (* Floating-point load constant.
-	   *)
-	  | FLDC of {oper: fldc}
-	  (* Floating-point load control word.
-	   *)
-	  | FLDCW of {src: Operand.t}
-	  (* Floating-point store control word.
-	   *)
-	  | FSTCW of {dst: Operand.t,
-		      check: bool}
-  	  (* Floating-point store status word.
-	   *)
-	  | FSTSW of {dst: Operand.t,
-		      check: bool}
-	  (* Floating-point compare.
-	   *)
-	  | FCOM of {src: Operand.t,
-		     size: Size.t,
-		     pop: bool,
-		     pop': bool}
-	  (* Floating-point unordered compare.
-	   *)
-	  | FUCOM of {src: Operand.t,
-		      pop: bool,
-		      pop': bool}
-	  (* Floating-point binary arithmetic instructions.
-	   *)
-	  | FBinA of {oper: fbina, 
-		      src: Operand.t,
-		      dst: Operand.t,
-		      size: Size.t,
-		      pop: bool}
-	  (* Floating-point unary arithmetic instructions.
-	   *)
-	  | FUnA of {oper: funa}
-	  (* Floating-point partial tangent instruction.
-	   *)
-	  | FPTAN
-	  (* Floating-point binary arithmetic stack instructions.
-	   *)
-	  | FBinAS of {oper: fbinas}
-	  (* Floating-point binary arithmetic stack pop instructions.
-	   *)
-	  | FBinASP of {oper: fbinasp}
+                   src: Operand.t,
+                   size: Size.t}
+          (* Integer signed/unsiged multiplication (two operand form); p. 335
+           *)
+          | IMUL2 of {src: Operand.t,
+                      dst: Operand.t, 
+                      size: Size.t}
+          (* Integer unary arithmetic/logic instructions.
+           *)
+          | UnAL of {oper: unal,
+                     dst: Operand.t,
+                     size: Size.t}
+          (* Integer shift/rotate arithmetic/logic instructions.
+           *)
+          | SRAL of {oper: sral,
+                     count: Operand.t,
+                     dst: Operand.t,
+                     size: Size.t}
+          (* Arithmetic compare.
+           *)
+          | CMP  of {src1: Operand.t,
+                     src2: Operand.t,
+                     size: Size.t}
+          (* Logical compare.
+           *)
+          | TEST of {src1: Operand.t,
+                     src2: Operand.t,
+                     size: Size.t}
+          (* Set byte on condition.
+           *)
+          | SETcc of {condition: condition,
+                      dst: Operand.t,
+                      size: Size.t}
+          (* Jump; p. 373
+           *)
+          | JMP of {target: Operand.t,
+                    absolute: bool}
+          (* Jump if condition is met.
+           *)
+          | Jcc of {condition: condition,
+                    target: Operand.t}
+          (* Call procedure.
+           *)
+          | CALL of {target: Operand.t,
+                     absolute: bool}
+          (* Return from procedure.
+           *)
+          | RET of {src: Operand.t option}
+          (* Move.
+           *)
+          | MOV of {src: Operand.t,
+                    dst: Operand.t,
+                    size: Size.t}
+          (* Conditional move.
+           *)
+          | CMOVcc of {condition: condition,
+                       src: Operand.t,
+                       dst: Operand.t,
+                       size: Size.t}
+          (* Exchange register/memory with register.
+           *)
+          | XCHG of {src: Operand.t,
+                     dst: Operand.t,
+                     size: Size.t}
+          (* Pseudo push a value onto a stack.
+           *)
+          | pPUSH of {src: Operand.t,
+                      base: Operand.t,
+                      size: Size.t}
+          (* Pseudo pop a value from a stack.
+           *)
+          | pPOP of {dst: Operand.t,
+                     base: Operand.t,
+                     size: Size.t}
+          (* Push a value onto the stack.
+           *)
+          | PUSH of {src: Operand.t,
+                     size: Size.t}
+          (* Pop a value from the stack.
+           *)
+          | POP of {dst: Operand.t,
+                    size: Size.t}
+          (* Convert X to 2X with sign extension.
+           *)
+          | CX of {size: Size.t}
+          (* Move with extention.
+           *)
+          | MOVX of {oper: movx,
+                     src: Operand.t,
+                     srcsize: Size.t,
+                     dst: Operand.t,
+                     dstsize: Size.t}
+          (* Move with contraction.
+           *)
+          | XVOM of {src: Operand.t,
+                     srcsize: Size.t,
+                     dst: Operand.t,
+                     dstsize: Size.t}
+          (* Load effective address.
+           *)
+          | LEA of {src: Operand.t,
+                    dst: Operand.t,
+                    size: Size.t}
+          (* Pseudo floating-point move.
+           *)
+          | pFMOV of {src: Operand.t,
+                      dst: Operand.t,
+                      size: Size.t}
+          (* Pseudo floating-point move with extension.
+           *)
+          | pFMOVX of {src: Operand.t,
+                       dst: Operand.t,
+                       srcsize: Size.t,
+                       dstsize: Size.t}
+          (* Pseudo floating-point move with contraction.
+           *)
+          | pFXVOM of {src: Operand.t,
+                       dst: Operand.t,
+                       srcsize: Size.t,
+                       dstsize: Size.t}
+          (* Pseudo floating-point load constant.
+           *)
+          | pFLDC of {oper: fldc,
+                      dst: Operand.t,
+                      size: Size.t}
+          (* Pseudo floating-point move from integer.
+           *)
+          | pFMOVFI of {src: Operand.t,
+                        dst: Operand.t,
+                        srcsize: Size.t,
+                        dstsize: Size.t}
+          (* Pseudo floating-point move to integer.
+           *)
+          | pFMOVTI of {src: Operand.t,
+                        dst: Operand.t,
+                        srcsize: Size.t,
+                        dstsize: Size.t}
+          (* Pseudo floating-point compare.
+           *)
+          | pFCOM of {src1: Operand.t,
+                      src2: Operand.t,
+                      size: Size.t}
+          (* Pseudo floating-point unordered compare.
+           *)
+          | pFUCOM of {src1: Operand.t,
+                       src2: Operand.t,
+                       size: Size.t}
+          (* Pseudo floating-point binary arithmetic instructions.
+           *)
+          | pFBinA of {oper: fbina, 
+                       src: Operand.t, 
+                       dst: Operand.t,
+                       size: Size.t}
+          (* Pseudo floating-point unary arithmetic instructions.
+           *)
+          | pFUnA of {oper: funa,
+                      dst: Operand.t,
+                      size: Size.t}
+          (* Pseudo floating-point partial tangetn instruction.
+           *)
+          | pFPTAN of {dst: Operand.t,
+                       size: Size.t}
+          (* Pseudo floating-point binary arithmetic stack instructions.
+           *)
+          | pFBinAS of {oper: fbinas, 
+                        src: Operand.t, 
+                        dst: Operand.t,
+                        size: Size.t}
+          (* Pseudo floating-point binary arithmetic stack pop instructions.
+           *)
+          | pFBinASP of {oper: fbinasp, 
+                         src: Operand.t, 
+                         dst: Operand.t,
+                         size: Size.t}
+          (* Floating-point load real.
+           *)
+          | FLD of {src: Operand.t,
+                    size: Size.t}
+          (* Floating-point store real.
+           *)
+          | FST of {dst: Operand.t,
+                    size: Size.t,
+                    pop: bool}
+          (* Floating-point load integer.
+           *)
+          | FILD of {src: Operand.t,
+                     size: Size.t}
+          (* Floating-point store integer.
+           *)
+          | FIST of {dst: Operand.t,
+                     size: Size.t,
+                     pop: bool}
+          (* Floating-point exchange.
+           *)
+          | FXCH of {src: Operand.t}
+          (* Floating-point load constant.
+           *)
+          | FLDC of {oper: fldc}
+          (* Floating-point load control word.
+           *)
+          | FLDCW of {src: Operand.t}
+          (* Floating-point store control word.
+           *)
+          | FSTCW of {dst: Operand.t,
+                      check: bool}
+          (* Floating-point store status word.
+           *)
+          | FSTSW of {dst: Operand.t,
+                      check: bool}
+          (* Floating-point compare.
+           *)
+          | FCOM of {src: Operand.t,
+                     size: Size.t,
+                     pop: bool,
+                     pop': bool}
+          (* Floating-point unordered compare.
+           *)
+          | FUCOM of {src: Operand.t,
+                      pop: bool,
+                      pop': bool}
+          (* Floating-point binary arithmetic instructions.
+           *)
+          | FBinA of {oper: fbina, 
+                      src: Operand.t,
+                      dst: Operand.t,
+                      size: Size.t,
+                      pop: bool}
+          (* Floating-point unary arithmetic instructions.
+           *)
+          | FUnA of {oper: funa}
+          (* Floating-point partial tangent instruction.
+           *)
+          | FPTAN
+          (* Floating-point binary arithmetic stack instructions.
+           *)
+          | FBinAS of {oper: fbinas}
+          (* Floating-point binary arithmetic stack pop instructions.
+           *)
+          | FBinASP of {oper: fbinasp}
 
-	val toString : t -> string
-	val uses_defs_kills : t -> {uses: Operand.t list,
-				    defs: Operand.t list,
-				    kills: Operand.t list}
-	val hints : t -> (MemLoc.t * Register.t) list
-	val srcs_dsts : t -> {srcs: Operand.t list option, 
-			      dsts: Operand.t list option}
-	val replace : ({use: bool, def: bool} -> Operand.t -> Operand.t) -> 
+        val toString : t -> string
+        val uses_defs_kills : t -> {uses: Operand.t list,
+                                    defs: Operand.t list,
+                                    kills: Operand.t list}
+        val hints : t -> (MemLoc.t * Register.t) list
+        val srcs_dsts : t -> {srcs: Operand.t list option, 
+                              dsts: Operand.t list option}
+        val replace : ({use: bool, def: bool} -> Operand.t -> Operand.t) -> 
                       t -> t
       end
 
     structure Directive :
       sig
-	structure Id :
-	  sig
-	    type t
-	    val new : unit -> t
-	    val plist : t -> PropertyList.t
-	  end
+        structure Id :
+          sig
+            type t
+            val new : unit -> t
+            val plist : t -> PropertyList.t
+          end
 
-	datatype t
-	  (* Transfers *)
-	    (* Assert that a memloc is in a register with properties;
-	     * used at top of basic blocks to establish passing convention.
-	     *)
-	  = Assume of {assumes: {register: Register.t, 
-				 memloc: MemLoc.t, 
-				 weight: int,
-				 sync: bool,
-				 reserve: bool} list}
-	  | FltAssume of {assumes: {memloc: MemLoc.t, 
-				    weight: int,
-				    sync: bool} list}
-	    (* Ensure that memloc is in the register, possibly reserved; 
-	     * used at bot of basic blocks to establish passing convention,
-	     * also used before C calls to set-up %esp.
-	     *)
-	  | Cache of {caches: {register: Register.t,
-			       memloc: MemLoc.t,
-			       reserve: bool} list}
-	  | FltCache of {caches: {memloc: MemLoc.t} list}
-	    (* Reset the register allocation;
-	     * used at bot of basic blocks that fall-thru
-	     * to a block with multiple incoming paths of control.
-	     *)
-	  | Reset
-	    (* Ensure that memlocs are commited to memory;
-	     * used at bot of basic blocks to establish passing conventions
-	     *)
-	  | Force of {commit_memlocs: MemLocSet.t,
-		      commit_classes: ClassSet.t,
-		      remove_memlocs: MemLocSet.t,
-		      remove_classes: ClassSet.t,
-		      dead_memlocs: MemLocSet.t,
-		      dead_classes: ClassSet.t}
-	  (* C calls *)
-	    (* Prepare for a C call; i.e., clear all caller save registers;
-	     * also, clear the flt. register stack;
-	     * used before C calls.
-	     *)
-	  | CCall
-	  (* Assert the return value;
-	   * used after C calls.
-	   *)
+        datatype t
+          (* Transfers *)
+            (* Assert that a memloc is in a register with properties;
+             * used at top of basic blocks to establish passing convention.
+             *)
+          = Assume of {assumes: {register: Register.t, 
+                                 memloc: MemLoc.t, 
+                                 weight: int,
+                                 sync: bool,
+                                 reserve: bool} list}
+          | FltAssume of {assumes: {memloc: MemLoc.t, 
+                                    weight: int,
+                                    sync: bool} list}
+            (* Ensure that memloc is in the register, possibly reserved; 
+             * used at bot of basic blocks to establish passing convention,
+             * also used before C calls to set-up %esp.
+             *)
+          | Cache of {caches: {register: Register.t,
+                               memloc: MemLoc.t,
+                               reserve: bool} list}
+          | FltCache of {caches: {memloc: MemLoc.t} list}
+            (* Reset the register allocation;
+             * used at bot of basic blocks that fall-thru
+             * to a block with multiple incoming paths of control.
+             *)
+          | Reset
+            (* Ensure that memlocs are commited to memory;
+             * used at bot of basic blocks to establish passing conventions
+             *)
+          | Force of {commit_memlocs: MemLocSet.t,
+                      commit_classes: ClassSet.t,
+                      remove_memlocs: MemLocSet.t,
+                      remove_classes: ClassSet.t,
+                      dead_memlocs: MemLocSet.t,
+                      dead_classes: ClassSet.t}
+          (* C calls *)
+            (* Prepare for a C call; i.e., clear all caller save registers;
+             * also, clear the flt. register stack;
+             * used before C calls.
+             *)
+          | CCall
+          (* Assert the return value;
+           * used after C calls.
+           *)
           | Return of {returns: {src:Operand.t, dst: MemLoc.t} list}
-	  (* Misc. *)
-	    (* Assert that the register is not free for the allocator;
-	     * used ???
-	     *)
-	  | Reserve of {registers: Register.t list}
-	    (* Assert that the register is free for the allocator;
-	     * used to free registers at fall-thru;
-	     * also used after C calls to free %esp.
-	     *)
-	  | Unreserve of {registers: Register.t list}
-	    (* Clear the floating point stack;
-	     * used at bot of basic blocks to establish passing convention,
-	     *)
-	  | ClearFlt
-  	    (* Save the register allocation in id and
-	     *  assert that live are used at this point;
-	     * used at bot of basic blocks to delay establishment
-	     *  of passing convention to compensation block
-	     *)
-	  | SaveRegAlloc of {live: MemLocSet.t,
-			     id: Id.t}
-	    (* Restore the register allocation from id and
-	     *  remove anything tracked that is not live;
-	     * used at bot of basic blocks to delay establishment
-	     *  of passing convention to compensation block
-	     *)
-	  | RestoreRegAlloc of {live: MemLocSet.t,
-				id: Id.t}
+          (* Misc. *)
+            (* Assert that the register is not free for the allocator;
+             * used ???
+             *)
+          | Reserve of {registers: Register.t list}
+            (* Assert that the register is free for the allocator;
+             * used to free registers at fall-thru;
+             * also used after C calls to free %esp.
+             *)
+          | Unreserve of {registers: Register.t list}
+            (* Clear the floating point stack;
+             * used at bot of basic blocks to establish passing convention,
+             *)
+          | ClearFlt
+            (* Save the register allocation in id and
+             *  assert that live are used at this point;
+             * used at bot of basic blocks to delay establishment
+             *  of passing convention to compensation block
+             *)
+          | SaveRegAlloc of {live: MemLocSet.t,
+                             id: Id.t}
+            (* Restore the register allocation from id and
+             *  remove anything tracked that is not live;
+             * used at bot of basic blocks to delay establishment
+             *  of passing convention to compensation block
+             *)
+          | RestoreRegAlloc of {live: MemLocSet.t,
+                                id: Id.t}
 
-	val toString : t -> string
-	val uses_defs_kills : t -> {uses: Operand.t list, 
-				    defs: Operand.t list, 
-				    kills: Operand.t list}
-	val hints : t -> (MemLoc.t * Register.t) list
-	val replace : ({use: bool, def: bool} -> Operand.t -> Operand.t) ->
+        val toString : t -> string
+        val uses_defs_kills : t -> {uses: Operand.t list, 
+                                    defs: Operand.t list, 
+                                    kills: Operand.t list}
+        val hints : t -> (MemLoc.t * Register.t) list
+        val replace : ({use: bool, def: bool} -> Operand.t -> Operand.t) ->
                       t -> t
-	val assume : {assumes: {register: Register.t,
-				memloc: MemLoc.t,
-				weight: int,
-				sync: bool,
-				reserve: bool} list} -> t
-	val fltassume : {assumes: {memloc: MemLoc.t,
-				   weight: int,
-				   sync: bool} list} -> t
-	val cache : {caches: {register: Register.t,
-			      memloc: MemLoc.t,
-			      reserve: bool} list} -> t
-	val fltcache : {caches: {memloc: MemLoc.t} list} -> t
-	val reset : unit -> t
-	val force : {commit_memlocs: MemLocSet.t,
-		     commit_classes: ClassSet.t,
-		     remove_memlocs: MemLocSet.t,
-		     remove_classes: ClassSet.t,
-		     dead_memlocs: MemLocSet.t,
-		     dead_classes: ClassSet.t} -> t
-	val ccall : unit -> t
-	val return : {returns: {src: Operand.t, dst: MemLoc.t} list} -> t
-	val reserve : {registers: Register.t list} -> t
-	val unreserve : {registers: Register.t list} -> t
-	val clearflt : unit -> t
-	val saveregalloc : {live: MemLocSet.t,
-			    id: Id.t} -> t
-	val restoreregalloc : {live: MemLocSet.t,
-			       id: Id.t} -> t
+        val assume : {assumes: {register: Register.t,
+                                memloc: MemLoc.t,
+                                weight: int,
+                                sync: bool,
+                                reserve: bool} list} -> t
+        val fltassume : {assumes: {memloc: MemLoc.t,
+                                   weight: int,
+                                   sync: bool} list} -> t
+        val cache : {caches: {register: Register.t,
+                              memloc: MemLoc.t,
+                              reserve: bool} list} -> t
+        val fltcache : {caches: {memloc: MemLoc.t} list} -> t
+        val reset : unit -> t
+        val force : {commit_memlocs: MemLocSet.t,
+                     commit_classes: ClassSet.t,
+                     remove_memlocs: MemLocSet.t,
+                     remove_classes: ClassSet.t,
+                     dead_memlocs: MemLocSet.t,
+                     dead_classes: ClassSet.t} -> t
+        val ccall : unit -> t
+        val return : {returns: {src: Operand.t, dst: MemLoc.t} list} -> t
+        val reserve : {registers: Register.t list} -> t
+        val unreserve : {registers: Register.t list} -> t
+        val clearflt : unit -> t
+        val saveregalloc : {live: MemLocSet.t,
+                            id: Id.t} -> t
+        val restoreregalloc : {live: MemLocSet.t,
+                               id: Id.t} -> t
     end
 
     structure PseudoOp :
       sig
-	datatype t
-	  = Data
-	  | Text
-	  | Balign of Immediate.t * Immediate.t option * Immediate.t option
-	  | P2align of Immediate.t * Immediate.t option * Immediate.t option
-	  | Space of Immediate.t * Immediate.t
-  	  | Byte of Immediate.t list
-	  | Word of Immediate.t list
-	  | Long of Immediate.t list
-	  | String of string list
+        datatype t
+          = Data
+          | Text
+          | Balign of Immediate.t * Immediate.t option * Immediate.t option
+          | P2align of Immediate.t * Immediate.t option * Immediate.t option
+          | Space of Immediate.t * Immediate.t
+          | Byte of Immediate.t list
+          | Word of Immediate.t list
+          | Long of Immediate.t list
+          | String of string list
           | Global of Label.t
           | Local of Label.t
-	  | Comm of Label.t * Immediate.t * Immediate.t option
+          | Comm of Label.t * Immediate.t * Immediate.t option
 
-	val toString : t -> string
-	  
-	val data : unit -> t
-	val text : unit -> t
-	val balign : Immediate.t * Immediate.t option * Immediate.t option -> t
-	val p2align : Immediate.t * Immediate.t option * Immediate.t option -> t
-	val space : Immediate.t * Immediate.t -> t
-	val byte : Immediate.t list -> t
-	val word : Immediate.t list -> t
-	val long : Immediate.t list -> t
-	val string : string list -> t
-	val global : Label.t -> t
-	val locall : Label.t -> t
-	val comm : Label.t * Immediate.t * Immediate.t option -> t
+        val toString : t -> string
+          
+        val data : unit -> t
+        val text : unit -> t
+        val balign : Immediate.t * Immediate.t option * Immediate.t option -> t
+        val p2align : Immediate.t * Immediate.t option * Immediate.t option -> t
+        val space : Immediate.t * Immediate.t -> t
+        val byte : Immediate.t list -> t
+        val word : Immediate.t list -> t
+        val long : Immediate.t list -> t
+        val string : string list -> t
+        val global : Label.t -> t
+        val locall : Label.t -> t
+        val comm : Label.t * Immediate.t * Immediate.t option -> t
       end
 
     structure Assembly :
       sig
-	datatype t 
-	  = Comment of string
-	  | Directive of Directive.t
-	  | PseudoOp of PseudoOp.t
-	  | Label of Label.t
+        datatype t 
+          = Comment of string
+          | Directive of Directive.t
+          | PseudoOp of PseudoOp.t
+          | Label of Label.t
           | Instruction of Instruction.t
 
-	val layout : t -> Layout.t
-	val toString : t -> string
-	val uses_defs_kills : t -> {uses: Operand.t list, 
-				    defs: Operand.t list,
-				    kills: Operand.t list}
-	val hints : t -> (MemLoc.t * Register.t) list
-	val replace : ({use: bool, def: bool} -> Operand.t -> Operand.t) ->
+        val layout : t -> Layout.t
+        val toString : t -> string
+        val uses_defs_kills : t -> {uses: Operand.t list, 
+                                    defs: Operand.t list,
+                                    kills: Operand.t list}
+        val hints : t -> (MemLoc.t * Register.t) list
+        val replace : ({use: bool, def: bool} -> Operand.t -> Operand.t) ->
                       t -> t
 
-	val comment : string -> t
-	val isComment : t -> bool
-	val directive : Directive.t -> t
-	val directive_assume : {assumes: {register: Register.t,
-					  memloc: MemLoc.t,
-					  weight: int,
-					  sync: bool,
-					  reserve: bool} list} -> t
-	val directive_fltassume : {assumes: {memloc: MemLoc.t,
-					     weight: int,
-					     sync: bool} list} -> t
-	val directive_cache : {caches: {register: Register.t,
-					memloc: MemLoc.t,
-					reserve: bool} list} -> t
-	val directive_fltcache : {caches: {memloc: MemLoc.t} list} -> t
-	val directive_reset : unit -> t
-	val directive_force : {commit_memlocs: MemLocSet.t,
-			       commit_classes: ClassSet.t,
-			       remove_memlocs: MemLocSet.t,
-			       remove_classes: ClassSet.t,
-			       dead_memlocs: MemLocSet.t,
-			       dead_classes: ClassSet.t} -> t
-	val directive_ccall : unit -> t
-	val directive_return : {returns: {src: Operand.t, dst: MemLoc.t} list} -> t
-	val directive_reserve : {registers: Register.t list} -> t
-	val directive_unreserve : {registers: Register.t list} -> t
-	val directive_saveregalloc : {live: MemLocSet.t,
-				      id: Directive.Id.t} -> t
-	val directive_restoreregalloc : {live: MemLocSet.t,
-					 id: Directive.Id.t} -> t
-	val directive_clearflt : unit -> t
-	val pseudoop : PseudoOp.t -> t
-	val pseudoop_data : unit -> t
-	val pseudoop_text : unit -> t
-	val pseudoop_balign : Immediate.t * Immediate.t option * Immediate.t option ->t 
-	val pseudoop_p2align : Immediate.t * Immediate.t option * Immediate.t option -> t
-	val pseudoop_space : Immediate.t * Immediate.t -> t
-	val pseudoop_byte : Immediate.t list -> t
-	val pseudoop_word : Immediate.t list -> t
-	val pseudoop_long : Immediate.t list -> t
-	val pseudoop_string : string list -> t
-	val pseudoop_global : Label.t -> t
-	val pseudoop_local : Label.t -> t
-	val pseudoop_comm : Label.t * Immediate.t * Immediate.t option -> t
-	val label : Label.t -> t
-	val instruction : Instruction.t -> t
-	val instruction_nop : unit -> t
-	val instruction_binal : {oper: Instruction.binal, 
-				 src: Operand.t,
-				 dst: Operand.t,
-				 size: Size.t} -> t
-	val instruction_pmd : {oper: Instruction.md,
-			       src: Operand.t,
-			       dst: Operand.t,
-			       size: Size.t} -> t
-	val instruction_md : {oper: Instruction.md,
-			      src: Operand.t,
-			      size: Size.t} -> t
-	val instruction_imul2 : {src: Operand.t,
-				 dst: Operand.t,
-				 size: Size.t} -> t
-	val instruction_unal : {oper: Instruction.unal,
-				dst: Operand.t,
-				size: Size.t} -> t
-	val instruction_sral : {oper: Instruction.sral,
-				count: Operand.t,
-				dst: Operand.t,
-				size: Size.t} -> t
-	val instruction_cmp : {src1: Operand.t,
-			       src2: Operand.t,
-			       size: Size.t} -> t
-	val instruction_test : {src1: Operand.t,
-				src2: Operand.t,
-				size: Size.t} -> t
-	val instruction_setcc : {condition: Instruction.condition,
-				 dst: Operand.t,
-				 size: Size.t} -> t
-	val instruction_jmp : {target: Operand.t,
-			       absolute: bool} -> t
-	val instruction_jcc : {condition: Instruction.condition, 
-			       target: Operand.t} -> t
-	val instruction_call : {target: Operand.t,
-				absolute: bool} -> t
-	val instruction_ret : {src: Operand.t option} -> t
-	val instruction_mov : {src: Operand.t,
-			       dst: Operand.t,
-			       size: Size.t} -> t
-	val instruction_cmovcc : {condition: Instruction.condition,
-				  src: Operand.t,
-				  dst: Operand.t,
-				  size: Size.t} -> t
-	val instruction_xchg : {src: Operand.t, 
-				dst: Operand.t,
-				size: Size.t} -> t
-	val instruction_ppush : {src: Operand.t,
-				 base: Operand.t,
-				 size: Size.t} -> t
-	val instruction_ppop : {dst: Operand.t,
-				base: Operand.t,
-				size: Size.t} -> t
-	val instruction_push : {src: Operand.t,
-				size: Size.t} -> t
-	val instruction_pop : {dst: Operand.t,
-			       size: Size.t} -> t
-	val instruction_cx : {size: Size.t} -> t
-	val instruction_movx : {oper: Instruction.movx,
-				src: Operand.t,
-				srcsize: Size.t,
-				dst: Operand.t,
-				dstsize: Size.t} -> t
-	val instruction_xvom : {src: Operand.t,
-				srcsize: Size.t,
-				dst: Operand.t,
-				dstsize: Size.t} -> t
-	val instruction_lea : {src: Operand.t,
-			       dst: Operand.t,
-			       size: Size.t} -> t
-	val instruction_pfmov : {src: Operand.t,
-				 dst: Operand.t,
-				 size: Size.t} -> t
-	val instruction_pfmovx : {src: Operand.t,
-				  dst: Operand.t,
-				  srcsize: Size.t,
-				  dstsize: Size.t} -> t
-	val instruction_pfxvom : {src: Operand.t,
-				  dst: Operand.t,
-				  srcsize: Size.t,
-				  dstsize: Size.t} -> t
-	val instruction_pfldc : {oper: Instruction.fldc,
-				 dst: Operand.t,
-				 size: Size.t} -> t
-	val instruction_pfmovfi : {src: Operand.t,
-				   srcsize: Size.t,
-				   dst: Operand.t,
-				   dstsize: Size.t} -> t
-	val instruction_pfmovti : {src: Operand.t,
-				   srcsize: Size.t,
-				   dst: Operand.t,
-				   dstsize: Size.t} -> t
-	val instruction_pfcom : {src1: Operand.t,
-				 src2: Operand.t,
-				 size: Size.t} -> t
-	val instruction_pfucom : {src1: Operand.t,
-				  src2: Operand.t,
-				  size: Size.t} -> t
-	val instruction_pfbina : {oper: Instruction.fbina,
-				  src: Operand.t,
-				  dst: Operand.t,
-				  size: Size.t} -> t
-	val instruction_pfuna : {oper: Instruction.funa,
-				 dst: Operand.t,
-				 size: Size.t} -> t
-	val instruction_pfptan : {dst: Operand.t,
-				  size: Size.t} -> t
-	val instruction_pfbinas : {oper: Instruction.fbinas,
-				   src: Operand.t,
-				   dst: Operand.t,
-				   size: Size.t} -> t
-	val instruction_pfbinasp : {oper: Instruction.fbinasp,
-				    src: Operand.t,
-				    dst: Operand.t,
-				    size: Size.t} -> t
-	val instruction_fld : {src: Operand.t,
-			       size: Size.t} -> t
-	val instruction_fst : {dst: Operand.t,
-			       size: Size.t,
-			       pop: bool} -> t
-	val instruction_fild : {src: Operand.t,
-				size: Size.t} -> t
-	val instruction_fist : {dst: Operand.t,
-				size: Size.t,
-				pop: bool} -> t
-	val instruction_fxch : {src: Operand.t} -> t
-	val instruction_fldc : {oper: Instruction.fldc} -> t
-	val instruction_fldcw : {src: Operand.t} -> t
-	val instruction_fstcw : {dst: Operand.t,
-				 check: bool} -> t
-	val instruction_fstsw : {dst: Operand.t,
-				 check: bool} -> t
-	val instruction_fcom : {src: Operand.t,
-				size: Size.t,
-				pop: bool,
-				pop': bool} -> t
-	val instruction_fucom : {src: Operand.t,
-				 pop: bool,
-				 pop': bool} -> t
-	val instruction_fbina : {oper: Instruction.fbina,
-				 src: Operand.t,
-				 dst: Operand.t,
-				 size: Size.t,
-				 pop: bool} -> t
-	val instruction_funa : {oper: Instruction.funa} -> t
-	val instruction_fptan : unit -> t
-	val instruction_fbinas : {oper: Instruction.fbinas} -> t
-	val instruction_fbinasp : {oper: Instruction.fbinasp} -> t
+        val comment : string -> t
+        val isComment : t -> bool
+        val directive : Directive.t -> t
+        val directive_assume : {assumes: {register: Register.t,
+                                          memloc: MemLoc.t,
+                                          weight: int,
+                                          sync: bool,
+                                          reserve: bool} list} -> t
+        val directive_fltassume : {assumes: {memloc: MemLoc.t,
+                                             weight: int,
+                                             sync: bool} list} -> t
+        val directive_cache : {caches: {register: Register.t,
+                                        memloc: MemLoc.t,
+                                        reserve: bool} list} -> t
+        val directive_fltcache : {caches: {memloc: MemLoc.t} list} -> t
+        val directive_reset : unit -> t
+        val directive_force : {commit_memlocs: MemLocSet.t,
+                               commit_classes: ClassSet.t,
+                               remove_memlocs: MemLocSet.t,
+                               remove_classes: ClassSet.t,
+                               dead_memlocs: MemLocSet.t,
+                               dead_classes: ClassSet.t} -> t
+        val directive_ccall : unit -> t
+        val directive_return : {returns: {src: Operand.t, dst: MemLoc.t} list} -> t
+        val directive_reserve : {registers: Register.t list} -> t
+        val directive_unreserve : {registers: Register.t list} -> t
+        val directive_saveregalloc : {live: MemLocSet.t,
+                                      id: Directive.Id.t} -> t
+        val directive_restoreregalloc : {live: MemLocSet.t,
+                                         id: Directive.Id.t} -> t
+        val directive_clearflt : unit -> t
+        val pseudoop : PseudoOp.t -> t
+        val pseudoop_data : unit -> t
+        val pseudoop_text : unit -> t
+        val pseudoop_balign : Immediate.t * Immediate.t option * Immediate.t option ->t 
+        val pseudoop_p2align : Immediate.t * Immediate.t option * Immediate.t option -> t
+        val pseudoop_space : Immediate.t * Immediate.t -> t
+        val pseudoop_byte : Immediate.t list -> t
+        val pseudoop_word : Immediate.t list -> t
+        val pseudoop_long : Immediate.t list -> t
+        val pseudoop_string : string list -> t
+        val pseudoop_global : Label.t -> t
+        val pseudoop_local : Label.t -> t
+        val pseudoop_comm : Label.t * Immediate.t * Immediate.t option -> t
+        val label : Label.t -> t
+        val instruction : Instruction.t -> t
+        val instruction_nop : unit -> t
+        val instruction_binal : {oper: Instruction.binal, 
+                                 src: Operand.t,
+                                 dst: Operand.t,
+                                 size: Size.t} -> t
+        val instruction_pmd : {oper: Instruction.md,
+                               src: Operand.t,
+                               dst: Operand.t,
+                               size: Size.t} -> t
+        val instruction_md : {oper: Instruction.md,
+                              src: Operand.t,
+                              size: Size.t} -> t
+        val instruction_imul2 : {src: Operand.t,
+                                 dst: Operand.t,
+                                 size: Size.t} -> t
+        val instruction_unal : {oper: Instruction.unal,
+                                dst: Operand.t,
+                                size: Size.t} -> t
+        val instruction_sral : {oper: Instruction.sral,
+                                count: Operand.t,
+                                dst: Operand.t,
+                                size: Size.t} -> t
+        val instruction_cmp : {src1: Operand.t,
+                               src2: Operand.t,
+                               size: Size.t} -> t
+        val instruction_test : {src1: Operand.t,
+                                src2: Operand.t,
+                                size: Size.t} -> t
+        val instruction_setcc : {condition: Instruction.condition,
+                                 dst: Operand.t,
+                                 size: Size.t} -> t
+        val instruction_jmp : {target: Operand.t,
+                               absolute: bool} -> t
+        val instruction_jcc : {condition: Instruction.condition, 
+                               target: Operand.t} -> t
+        val instruction_call : {target: Operand.t,
+                                absolute: bool} -> t
+        val instruction_ret : {src: Operand.t option} -> t
+        val instruction_mov : {src: Operand.t,
+                               dst: Operand.t,
+                               size: Size.t} -> t
+        val instruction_cmovcc : {condition: Instruction.condition,
+                                  src: Operand.t,
+                                  dst: Operand.t,
+                                  size: Size.t} -> t
+        val instruction_xchg : {src: Operand.t, 
+                                dst: Operand.t,
+                                size: Size.t} -> t
+        val instruction_ppush : {src: Operand.t,
+                                 base: Operand.t,
+                                 size: Size.t} -> t
+        val instruction_ppop : {dst: Operand.t,
+                                base: Operand.t,
+                                size: Size.t} -> t
+        val instruction_push : {src: Operand.t,
+                                size: Size.t} -> t
+        val instruction_pop : {dst: Operand.t,
+                               size: Size.t} -> t
+        val instruction_cx : {size: Size.t} -> t
+        val instruction_movx : {oper: Instruction.movx,
+                                src: Operand.t,
+                                srcsize: Size.t,
+                                dst: Operand.t,
+                                dstsize: Size.t} -> t
+        val instruction_xvom : {src: Operand.t,
+                                srcsize: Size.t,
+                                dst: Operand.t,
+                                dstsize: Size.t} -> t
+        val instruction_lea : {src: Operand.t,
+                               dst: Operand.t,
+                               size: Size.t} -> t
+        val instruction_pfmov : {src: Operand.t,
+                                 dst: Operand.t,
+                                 size: Size.t} -> t
+        val instruction_pfmovx : {src: Operand.t,
+                                  dst: Operand.t,
+                                  srcsize: Size.t,
+                                  dstsize: Size.t} -> t
+        val instruction_pfxvom : {src: Operand.t,
+                                  dst: Operand.t,
+                                  srcsize: Size.t,
+                                  dstsize: Size.t} -> t
+        val instruction_pfldc : {oper: Instruction.fldc,
+                                 dst: Operand.t,
+                                 size: Size.t} -> t
+        val instruction_pfmovfi : {src: Operand.t,
+                                   srcsize: Size.t,
+                                   dst: Operand.t,
+                                   dstsize: Size.t} -> t
+        val instruction_pfmovti : {src: Operand.t,
+                                   srcsize: Size.t,
+                                   dst: Operand.t,
+                                   dstsize: Size.t} -> t
+        val instruction_pfcom : {src1: Operand.t,
+                                 src2: Operand.t,
+                                 size: Size.t} -> t
+        val instruction_pfucom : {src1: Operand.t,
+                                  src2: Operand.t,
+                                  size: Size.t} -> t
+        val instruction_pfbina : {oper: Instruction.fbina,
+                                  src: Operand.t,
+                                  dst: Operand.t,
+                                  size: Size.t} -> t
+        val instruction_pfuna : {oper: Instruction.funa,
+                                 dst: Operand.t,
+                                 size: Size.t} -> t
+        val instruction_pfptan : {dst: Operand.t,
+                                  size: Size.t} -> t
+        val instruction_pfbinas : {oper: Instruction.fbinas,
+                                   src: Operand.t,
+                                   dst: Operand.t,
+                                   size: Size.t} -> t
+        val instruction_pfbinasp : {oper: Instruction.fbinasp,
+                                    src: Operand.t,
+                                    dst: Operand.t,
+                                    size: Size.t} -> t
+        val instruction_fld : {src: Operand.t,
+                               size: Size.t} -> t
+        val instruction_fst : {dst: Operand.t,
+                               size: Size.t,
+                               pop: bool} -> t
+        val instruction_fild : {src: Operand.t,
+                                size: Size.t} -> t
+        val instruction_fist : {dst: Operand.t,
+                                size: Size.t,
+                                pop: bool} -> t
+        val instruction_fxch : {src: Operand.t} -> t
+        val instruction_fldc : {oper: Instruction.fldc} -> t
+        val instruction_fldcw : {src: Operand.t} -> t
+        val instruction_fstcw : {dst: Operand.t,
+                                 check: bool} -> t
+        val instruction_fstsw : {dst: Operand.t,
+                                 check: bool} -> t
+        val instruction_fcom : {src: Operand.t,
+                                size: Size.t,
+                                pop: bool,
+                                pop': bool} -> t
+        val instruction_fucom : {src: Operand.t,
+                                 pop: bool,
+                                 pop': bool} -> t
+        val instruction_fbina : {oper: Instruction.fbina,
+                                 src: Operand.t,
+                                 dst: Operand.t,
+                                 size: Size.t,
+                                 pop: bool} -> t
+        val instruction_funa : {oper: Instruction.funa} -> t
+        val instruction_fptan : unit -> t
+        val instruction_fbinas : {oper: Instruction.fbinas} -> t
+        val instruction_fbinasp : {oper: Instruction.fbinasp} -> t
     end
 
     structure FrameInfo:
        sig
-	  datatype t = T of {size: int, 
-			     frameLayoutsIndex: int}
+          datatype t = T of {size: int, 
+                             frameLayoutsIndex: int}
 
-	  val frameInfo: {size: int, 
-			  frameLayoutsIndex: int} -> t
+          val frameInfo: {size: int, 
+                          frameLayoutsIndex: int} -> t
        end
 
     structure Entry:
       sig
-	datatype t
-	  = Jump of {label: Label.t}
-	  | Func of {label: Label.t,
-		     live: MemLocSet.t}
-	  | Cont of {label: Label.t,
-		     live: MemLocSet.t,
-		     frameInfo: FrameInfo.t}
-	  | Handler of {frameInfo: FrameInfo.t,
-			label: Label.t,
-			live: MemLocSet.t}
-	  | CReturn of {dsts: (Operand.t * Size.t) vector,
-			frameInfo: FrameInfo.t option,
-			func: RepType.t CFunction.t,
-			label: Label.t}
+        datatype t
+          = Jump of {label: Label.t}
+          | Func of {label: Label.t,
+                     live: MemLocSet.t}
+          | Cont of {label: Label.t,
+                     live: MemLocSet.t,
+                     frameInfo: FrameInfo.t}
+          | Handler of {frameInfo: FrameInfo.t,
+                        label: Label.t,
+                        live: MemLocSet.t}
+          | CReturn of {dsts: (Operand.t * Size.t) vector,
+                        frameInfo: FrameInfo.t option,
+                        func: RepType.t CFunction.t,
+                        label: Label.t}
 
-	val cont : {label: Label.t,
-		    live: MemLocSet.t,
-		    frameInfo: FrameInfo.t} -> t
-	val creturn: {dsts: (Operand.t * Size.t) vector,
-		      frameInfo: FrameInfo.t option,
-		      func: RepType.t CFunction.t,
-		      label: Label.t}  -> t
-	val func : {label: Label.t,
-		    live: MemLocSet.t} -> t
-	val handler : {frameInfo: FrameInfo.t,
-		       label: Label.t,
-		       live: MemLocSet.t} -> t
-	val isFunc : t -> bool
-	val isNear : t -> bool
-	val jump : {label: Label.t} -> t
-	val label : t -> Label.t
-	val live : t -> MemLocSet.t
-	val toString : t -> string
-	val uses_defs_kills : t -> {uses: Operand.t list, 
-				    defs: Operand.t list,
-				    kills: Operand.t list}
+        val cont : {label: Label.t,
+                    live: MemLocSet.t,
+                    frameInfo: FrameInfo.t} -> t
+        val creturn: {dsts: (Operand.t * Size.t) vector,
+                      frameInfo: FrameInfo.t option,
+                      func: RepType.t CFunction.t,
+                      label: Label.t}  -> t
+        val func : {label: Label.t,
+                    live: MemLocSet.t} -> t
+        val handler : {frameInfo: FrameInfo.t,
+                       label: Label.t,
+                       live: MemLocSet.t} -> t
+        val isFunc : t -> bool
+        val isNear : t -> bool
+        val jump : {label: Label.t} -> t
+        val label : t -> Label.t
+        val live : t -> MemLocSet.t
+        val toString : t -> string
+        val uses_defs_kills : t -> {uses: Operand.t list, 
+                                    defs: Operand.t list,
+                                    kills: Operand.t list}
       end
 
     structure Transfer :
       sig
-	structure Cases :
-	  sig
-	    datatype 'a t
-	      = Char of (char * 'a) list
-	      | Int of (int * 'a) list
-	      | Word of (word * 'a) list
+        structure Cases :
+          sig
+            datatype 'a t = Word of (word * 'a) list
 
-	    val char : (char * 'a) list -> 'a t
-	    val int : (int * 'a) list -> 'a t
-	    val word : (word * 'a) list -> 'a t
+            val word : (word * 'a) list -> 'a t
 
-	    val isEmpty : 'a t -> bool
-	    val isSingle : 'a t -> bool
-	    val extract : 'a t * ('a -> 'b) -> 'b
-	    val extract' : 'a t * ('b -> 'c) *
-	                          (char * 'a -> 'b) *
-				  (int * 'a -> 'b) *
-				  (word * 'a -> 'b) -> 'c
-	    val count : 'a t * ('a -> bool) -> int
-	    val keepAll : 'a t * ('a -> bool) -> 'a t
-	    val keepAll' : 'a t * ('b -> bool) *
-                                  (char * 'a -> 'b) *
-                                  (int * 'a -> 'b) *
-                                  (word * 'a -> 'b) -> 'a t
-	    val forall : 'a t * ('a -> bool) -> bool
-	    val forall' : 'a t * ('b -> bool) *
-	                         (char * 'a -> 'b) *
-				 (int * 'a -> 'b) *
-				 (word * 'a -> 'b) -> bool
-	    val foreach : 'a t * ('a -> unit) -> unit
-	    val foreach' : 'a t * ('b -> unit) *
-	                          (char * 'a -> 'b) *
-				  (int * 'a -> 'b) *
-				  (word * 'a -> 'b) -> unit
-	    val map : 'a t * ('a -> 'b) -> 'b t
-	    val map' : 'a t * ('b -> 'c) *
-	                      (char * 'a -> 'b) *
-	                      (int * 'a -> 'b) *
-	                      (word * 'a -> 'b) -> 'c list
-	  end
+            val isEmpty : 'a t -> bool
+            val isSingle : 'a t -> bool
+            val extract : 'a t * (word * 'a -> 'b) -> 'b
+            val count : 'a t * ('a -> bool) -> int
+            val keepAll : 'a t * (word * 'a -> bool) -> 'a t
+            val forall : 'a t * (word * 'a -> bool) -> bool
+            val foreach : 'a t * (word * 'a -> unit) -> unit
+            val map : 'a t * (word * 'a -> 'b) -> 'b t
+            val mapToList : 'a t * (word * 'a -> 'b) -> 'b list
+          end
 
-	datatype t
-	  = Goto of {target: Label.t}
-	  | Iff of {condition: Instruction.condition,
-		    truee: Label.t,
-		    falsee: Label.t}
-	  | Switch of {test: Operand.t,
-		       cases: Label.t Cases.t,
-		       default: Label.t}
-	  | Tail of {target: Label.t,
-		     live: MemLocSet.t}
-	  | NonTail of {target: Label.t,
-			live: MemLocSet.t,
-			return: Label.t,
-			handler: Label.t option,
-			size: int}
-	  | Return of {live: MemLocSet.t}
-	  | Raise of {live: MemLocSet.t}
-	  | CCall of {args: (Operand.t * Size.t) list,
-		      frameInfo: FrameInfo.t option,
-		      func: RepType.t CFunction.t,
-		      return: Label.t option}
+        datatype t
+          = Goto of {target: Label.t}
+          | Iff of {condition: Instruction.condition,
+                    truee: Label.t,
+                    falsee: Label.t}
+          | Switch of {test: Operand.t,
+                       cases: Label.t Cases.t,
+                       default: Label.t}
+          | Tail of {target: Label.t,
+                     live: MemLocSet.t}
+          | NonTail of {target: Label.t,
+                        live: MemLocSet.t,
+                        return: Label.t,
+                        handler: Label.t option,
+                        size: int}
+          | Return of {live: MemLocSet.t}
+          | Raise of {live: MemLocSet.t}
+          | CCall of {args: (Operand.t * Size.t) list,
+                      frameInfo: FrameInfo.t option,
+                      func: RepType.t CFunction.t,
+                      return: Label.t option}
 
-	val toString : t -> string
+        val toString : t -> string
 
-	val uses_defs_kills : t -> {uses: Operand.t list, 
-				    defs: Operand.t list,
-				    kills: Operand.t list}
-	val nearTargets : t -> Label.t list
-	val live : t -> MemLocSet.t
-	val replace : ({use: bool, def: bool} -> Operand.t -> Operand.t) -> 
+        val uses_defs_kills : t -> {uses: Operand.t list, 
+                                    defs: Operand.t list,
+                                    kills: Operand.t list}
+        val nearTargets : t -> Label.t list
+        val live : t -> MemLocSet.t
+        val replace : ({use: bool, def: bool} -> Operand.t -> Operand.t) -> 
                       t -> t
 
-	val goto : {target: Label.t} -> t
-	val iff : {condition: Instruction.condition,
-		   truee: Label.t,
-		   falsee: Label.t} -> t
-	val switch : {test: Operand.t,
-		      cases: Label.t Cases.t,
-		      default: Label.t} -> t
-	val tail : {target: Label.t,
-		    live: MemLocSet.t} -> t
-	val nontail : {target: Label.t, 
-		       live: MemLocSet.t,
-		       return: Label.t,
-		       handler: Label.t option,
-		       size: int} -> t
-	val return : {live: MemLocSet.t} -> t 
-	val raisee : {live: MemLocSet.t} -> t
-	val ccall: {args: (Operand.t * Size.t) list,
-		    frameInfo: FrameInfo.t option,
-		    func: RepType.t CFunction.t,
-		    return: Label.t option} -> t 
+        val goto : {target: Label.t} -> t
+        val iff : {condition: Instruction.condition,
+                   truee: Label.t,
+                   falsee: Label.t} -> t
+        val switch : {test: Operand.t,
+                      cases: Label.t Cases.t,
+                      default: Label.t} -> t
+        val tail : {target: Label.t,
+                    live: MemLocSet.t} -> t
+        val nontail : {target: Label.t, 
+                       live: MemLocSet.t,
+                       return: Label.t,
+                       handler: Label.t option,
+                       size: int} -> t
+        val return : {live: MemLocSet.t} -> t 
+        val raisee : {live: MemLocSet.t} -> t
+        val ccall: {args: (Operand.t * Size.t) list,
+                    frameInfo: FrameInfo.t option,
+                    func: RepType.t CFunction.t,
+                    return: Label.t option} -> t 
       end
 
     structure ProfileLabel :
       sig
-	include PROFILE_LABEL
-	val toAssembly : t -> Assembly.t list
-	val toAssemblyOpt : t option -> Assembly.t list
+        include PROFILE_LABEL
+        val toAssembly : t -> Assembly.t list
+        val toAssemblyOpt : t option -> Assembly.t list
       end
 
     structure Block :
       sig
-	datatype t' = T' of {entry: Entry.t option,
-			     profileLabel: ProfileLabel.t option,
-			     statements: Assembly.t list,
-			     transfer: Transfer.t option}
-	val mkBlock': {entry: Entry.t option,
-		       statements: Assembly.t list,
-		       transfer: Transfer.t option} -> t'
-	val mkProfileBlock': {profileLabel: ProfileLabel.t} -> t'
-	val printBlock' : t' -> unit
+        datatype t' = T' of {entry: Entry.t option,
+                             profileLabel: ProfileLabel.t option,
+                             statements: Assembly.t list,
+                             transfer: Transfer.t option}
+        val mkBlock': {entry: Entry.t option,
+                       statements: Assembly.t list,
+                       transfer: Transfer.t option} -> t'
+        val mkProfileBlock': {profileLabel: ProfileLabel.t} -> t'
+        val printBlock' : t' -> unit
 
-	datatype t = T of {entry: Entry.t,
-			   profileLabel: ProfileLabel.t option,
-			   statements: Assembly.t list,
-			   transfer: Transfer.t}
-	val printBlock : t -> unit
+        datatype t = T of {entry: Entry.t,
+                           profileLabel: ProfileLabel.t option,
+                           statements: Assembly.t list,
+                           transfer: Transfer.t}
+        val printBlock : t -> unit
 
-	val compress : t' list -> t list
+        val compress : t' list -> t list
       end
 
     structure Chunk :
       sig
-	datatype t = T of {data: Assembly.t list,
-			   blocks: Block.t list}
+        datatype t = T of {data: Assembly.t list,
+                           blocks: Block.t list}
       end
 end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/control/bits.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/control/bits.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/control/bits.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,178 +1,180 @@
-(* Copyright (C) 2004 Henry Cejtin, Matthew Fluet, Suresh Jagannathan, and
- *    Stephen Weeks.
+(* Copyright (C) 2004-2005 Henry Cejtin, Matthew Fluet, Suresh 
+ *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 local
    type int = Int.t
    type word = Word.t
    structure All:>
       sig
-	 type bytes
-	 type words
-	    
-	 structure Bits:
-	    sig
-	       eqtype t
+         type bytes
+         type words
+            
+         structure Bits:
+            sig
+               eqtype t
 
-	       val + : t * t -> t
-	       val - : t * t -> t
-	       val < : t * t -> bool
-	       val <= : t * t -> bool
-	       val > : t * t -> bool
-	       val >= : t * t -> bool
-	       val compare: t * t -> Relation.t
-	       val equals: t * t -> bool
-	       val fromInt: int -> t
-	       val fromIntInf: IntInf.t -> t
-	       val fromWord: word -> t
-	       val inByte: t
-	       val inPointer: t
-	       val inWord: t
-	       val isByteAligned: t -> bool
-	       val isWordAligned: t -> bool
-	       val isZero: t -> bool
-	       val layout: t -> Layout.t
-	       val toBytes: t -> bytes
-	       val toInt: t -> int
-	       val toIntInf: t -> IntInf.t
-	       val toString: t -> string
-	       val toWord: t -> word
-	       val toWords: t -> words
-	       val zero: t
-	    end
-	 
-	 structure Bytes:
-	    sig
-	       type t
+               val + : t * t -> t
+               val - : t * t -> t
+               val < : t * t -> bool
+               val <= : t * t -> bool
+               val > : t * t -> bool
+               val >= : t * t -> bool
+               val compare: t * t -> Relation.t
+               val equals: t * t -> bool
+               val fromInt: int -> t
+               val fromIntInf: IntInf.t -> t
+               val inByte: t
+               val inPointer: t
+               val inWord: t
+               val isByteAligned: t -> bool
+               val isWordAligned: t -> bool
+               val isZero: t -> bool
+               val layout: t -> Layout.t
+               val toBytes: t -> bytes
+               val toInt: t -> int
+               val toIntInf: t -> IntInf.t
+               val toString: t -> string
+               val toWord: t -> word
+               val toWords: t -> words
+               val zero: t
+            end
+         
+         structure Bytes:
+            sig
+               type t
 
-	       val + : t * t -> t
-	       val - : t * t -> t
-	       val ~ : t -> t
-	       val < : t * t -> bool
-	       val <= : t * t -> bool
-	       val > : t * t -> bool
-	       val >= : t * t -> bool
-	       val align: t * {alignment: t} -> t
-	       val equals: t * t -> bool
-	       val fromInt: int -> t
-	       val fromIntInf: IntInf.t -> t
-	       val fromWord: word -> t
-	       val inPointer: t
-	       val inWord: t
-	       val isWordAligned: t -> bool
-	       val isZero: t -> bool
-	       val layout: t -> Layout.t
-	       val max: t * t -> t
-	       val scale: t * int -> t
-	       val toBits: t -> Bits.t
-	       val toInt: t -> int
-	       val toIntInf: t -> IntInf.t
-	       val toString: t -> string
-	       val toWord: t -> word
-	       val toWords: t -> words
-	       val wordAlign: t -> t
-	       val zero: t
-	    end
-	 
-	 structure Words:
-	    sig
-	       type t
+               val + : t * t -> t
+               val - : t * t -> t
+               val ~ : t -> t
+               val < : t * t -> bool
+               val <= : t * t -> bool
+               val > : t * t -> bool
+               val >= : t * t -> bool
+               val align: t * {alignment: t} -> t
+               val equals: t * t -> bool
+               val fromInt: int -> t
+               val fromIntInf: IntInf.t -> t
+               val fromWord: word -> t
+               val inPointer: t
+               val inWord: t
+               val isWordAligned: t -> bool
+               val isZero: t -> bool
+               val layout: t -> Layout.t
+               val max: t * t -> t
+               val scale: t * int -> t
+               val toBits: t -> Bits.t
+               val toInt: t -> int
+               val toIntInf: t -> IntInf.t
+               val toString: t -> string
+               val toWord: t -> word
+               val toWords: t -> words
+               val wordAlign: t -> t
+               val zero: t
+            end
+         
+         structure Words:
+            sig
+               type t
 
-	       val + : t * t -> t
-	       val equals: t * t -> bool
-	       val fromInt: int -> t
-	       val inPointer: t
-	       val layout: t -> Layout.t
-	       val one: t
-	       val toInt: t -> int
-	       val toBytes: t -> Bytes.t
-	       val zero: t
-	    end
-	 
-	 sharing type bytes = Bytes.t
+               val + : t * t -> t
+               val equals: t * t -> bool
+               val fromInt: int -> t
+               val inPointer: t
+               val layout: t -> Layout.t
+               val one: t
+               val toInt: t -> int
+               val toBytes: t -> Bytes.t
+               val zero: t
+            end
+         
+         sharing type bytes = Bytes.t
          sharing type words = Words.t
       end =
       struct
-	 val rem = IntInf.rem
-	    
-	 fun align (b, {alignment = a}) =
-	    let
-	       val b = b + (a - 1)
-	    in
-	       b - rem (b, a)
-	    end
+         val rem = IntInf.rem
+            
+         fun align (b, {alignment = a}) =
+            let
+               val b = b + (a - 1)
+            in
+               b - rem (b, a)
+            end
 
-	 structure Bits =
-	    struct
-	       open IntInf
+         structure Bits =
+            struct
+               open IntInf
 
-	       val fromWord = Word.toIntInf
-		  
-	       val inByte: t = 8
-		  
-	       val inWord: t = 32
+               val inByte: t = 8
+                  
+               val inWord: t = 32
 
-	       val inPointer = inWord
+               val inPointer = inWord
 
-	       fun isByteAligned b = 0 = rem (b, inByte)
-		  
-	       fun isWordAligned b = 0 = rem (b, inWord)
-		  
-	       fun toBytes b =
-		  if isByteAligned b
-		     then quot (b, inByte)
-		  else Error.bug "Bits.toBytes"
+               fun isByteAligned b = 0 = rem (b, inByte)
+                  
+               fun isWordAligned b = 0 = rem (b, inWord)
+                  
+               fun toBytes b =
+                  if isByteAligned b
+                     then quot (b, inByte)
+                  else Error.bug "Bits.toBytes"
 
-	       val toWord = Word.fromIntInf
+               val toWord = Word.fromIntInf
 
-	       fun toWords b =
-		  if isWordAligned b
-		     then quot (b, inWord)
-		  else Error.bug "Bits.toWords"
-	    end
+               fun toWords b =
+                  if isWordAligned b
+                     then quot (b, inWord)
+                  else Error.bug "Bits.toWords"
+            end
 
-	 structure Bytes =
-	    struct
-	       open IntInf
+         type bytes = IntInf.t
 
-	       val fromWord = Word.toIntInf
+         structure Bytes =
+            struct
+               open IntInf
 
-	       val inWord: t = 4
+               type t = bytes
 
-	       val inPointer = inWord
+               val fromWord = Word.toIntInf
 
-	       fun isWordAligned b = 0 = rem (b, inWord)
+               val inWord: t = 4
 
-	       fun scale (b, i) = b * Int.toIntInf i
-		  
-	       fun toBits b = b * Bits.inByte
+               val inPointer = inWord
 
-	       val toWord = Word.fromIntInf
+               fun isWordAligned b = 0 = rem (b, inWord)
 
-	       fun toWords b =
-		  if isWordAligned b
-		     then quot (b, inWord)
-		  else Error.bug "Bytes.toWords"
+               fun scale (b, i) = b * Int.toIntInf i
+                  
+               fun toBits b = b * Bits.inByte
 
-	       val align = align
+               val toWord = Word.fromIntInf
 
-	       fun wordAlign b = align (b, {alignment = inWord})
-	    end
+               fun toWords b =
+                  if isWordAligned b
+                     then quot (b, inWord)
+                  else Error.bug "Bytes.toWords"
 
-	 type bytes = Bytes.t
+               val align = align
 
-	 structure Words =
-	    struct
-	       open IntInf
+               fun wordAlign b = align (b, {alignment = inWord})
+            end
 
-	       val inPointer = Bytes.toWords Bytes.inPointer
-		  
-	       fun toBytes w = w * Bytes.inWord
-	    end
+         type words = IntInf.t
+            
+         structure Words =
+            struct
+               open IntInf
 
-	 type words = Words.t
+               type t = words
+
+               val inPointer = Bytes.toWords Bytes.inPointer
+                  
+               fun toBytes w = w * Bytes.inWord
+            end
       end
    open All
 in

Copied: mlton/branches/on-20050420-cmm-branch/mlton/control/control-flags.sig (from rev 4358, mlton/trunk/mlton/control/control-flags.sig)
===================================================================
--- mlton/trunk/mlton/control/control-flags.sig	2006-02-15 03:30:28 UTC (rev 4358)
+++ mlton/branches/on-20050420-cmm-branch/mlton/control/control-flags.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -0,0 +1,340 @@
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
+type int = Int.t
+   
+signature CONTROL_FLAGS =
+   sig
+      (* set all flags to their default values *)
+      val defaults: unit -> unit
+         
+      val all : unit -> {name: string, 
+                         value: string} list
+
+      (*------------------------------------*)
+      (*            Begin Flags             *)
+      (*------------------------------------*)
+
+      datatype align = Align4 | Align8
+      val align: align ref
+
+      val atMLtons: string vector ref
+
+      (* build identifies the machine on which this MLton was built. *)
+      val build: string
+
+      datatype chunk =
+         OneChunk
+       | ChunkPerFunc
+       | Coalesce of {limit: int}
+
+      val chunk: chunk ref
+
+      structure Cmm :
+         sig
+            val debug : bool ref
+
+            datatype nonTail =
+               CutTo of {neverReturns: bool} | Return
+
+            val nonTail : nonTail ref
+         end
+
+      datatype codegen =
+         Bytecode
+       | CCodegen
+       | CmmCodegen
+       | Native
+
+      val codegen: codegen ref
+
+      val contifyIntoMain: bool ref
+
+      (* Generate an executable with debugging info. *)
+      val debug: bool ref
+
+      (* List of pass names to keep diagnostic info on. *)
+      val diagPasses: Regexp.Compiled.t list ref
+
+      (* List of optimization passes to skip. *)
+      val dropPasses: Regexp.Compiled.t list ref
+
+      structure Elaborate:
+         sig
+            structure DiagEIW :
+               sig
+                  datatype t =
+                     Error
+                   | Ignore
+                   | Warn
+               end
+            structure DiagDI :
+               sig
+                  datatype t =
+                     Default
+                   | Ignore
+               end
+
+            type ('args, 'st) t
+
+            val document: {expert: bool} -> Layout.t
+
+            val allowConstant: (bool,bool) t
+            val allowFFI: (bool,bool) t
+            val allowOverload: (bool,bool) t
+            val allowPrim: (bool,bool) t
+            val allowRebindEquals: (bool,bool) t
+            val deadCode: (bool,bool) t
+            val forceUsed: (unit,bool) t
+            val ffiStr: (string,string option) t
+            val nonexhaustiveExnMatch: (DiagDI.t,DiagDI.t) t
+            val nonexhaustiveMatch: (DiagEIW.t,DiagEIW.t) t
+            val redundantMatch: (DiagEIW.t,DiagEIW.t) t
+            val sequenceNonUnit: (DiagEIW.t,DiagEIW.t) t
+            val warnUnused: (bool,bool) t
+
+            val current: ('args, 'st) t -> 'st
+            val default: ('args, 'st) t -> 'st
+            val enabled: ('args, 'st) t -> bool
+            val expert: ('args, 'st) t -> bool
+            val name: ('args, 'st) t -> string
+
+            datatype ('a, 'b) parseResult =
+               Bad | Deprecated of 'a | Good of 'b | Other
+
+            structure Id :
+               sig
+                  type t
+                  val name: t -> string
+               end
+            val equalsId: ('args, 'st) t * Id.t -> bool
+            val parseId: string -> (Id.t list , Id.t) parseResult
+
+            structure Args :
+               sig
+                  type t
+                  val processAnn: t -> (unit -> unit)
+               end
+            val parseIdAndArgs: string -> ((Id.t * Args.t) list, Id.t * Args.t) parseResult
+
+            val processDefault: string -> (Id.t list, unit) parseResult
+            val processEnabled: string * bool -> (Id.t list, unit) parseResult
+
+            val withDef: (unit -> 'a) -> 'a
+            val snapshot: unit -> (unit -> 'a) -> 'a
+         end
+
+      (* stop after elaboration.  So, no need for the elaborator to generate
+       * valid CoreML.
+       *)
+      val elaborateOnly: bool ref
+
+      val exportHeader: File.t option ref
+         
+      val exnHistory: bool ref
+
+      (* *)
+      datatype gcCheck =
+         Limit
+       | First
+       | Every
+      val gcCheck: gcCheck ref
+
+      (* Indentation used in laying out ILs. *)
+      val indentation: int ref
+         
+      datatype inline =
+         NonRecursive of {product: int,
+                          small: int}
+       | Leaf of {size: int option}
+       | LeafNoLoop of {size: int option}
+      val inline: inline ref
+      val setInlineSize: int -> unit
+
+      val inlineIntoMain: bool ref
+
+      (* The input file on the command line, minus path and extension *)
+      val inputFile: File.t ref
+
+      (* Keep dot files for whatever SSA files are produced. *)
+      val keepDot: bool ref
+
+      (* Save the Machine to a file. *)
+      val keepMachine: bool ref
+         
+      (* List of pass names to save the result of. *)
+      val keepPasses: Regexp.Compiled.t list ref
+
+      (* Save the RSSA to a file. *)
+      val keepRSSA: bool ref
+         
+      (* Save the SSA to a file. *)
+      val keepSSA: bool ref
+      (* Save the SSA2 to a file. *)
+      val keepSSA2: bool ref
+
+      (* For the codegen -- do labels for gcc and assembler need an extra leading
+       * underscore.
+       *)
+      val labelsHaveExtra_: bool ref
+
+      (* lib/mlton directory *)
+      val libDir: Dir.t ref
+
+      (* lib/mlton/target directory *)
+      val libTargetDir: Dir.t ref
+
+      (* Number of times to loop through optimization passes. *)
+      val loopPasses: int ref
+         
+      (* Should the mutator mark cards? *)
+      val markCards: bool ref
+
+      val maxFunctionSize: int ref
+
+      val mlbPathMaps: string list ref
+
+      structure Native:
+         sig
+            (* whether or not to use comments in native codegen *)
+            val commented: int ref
+
+            (* whether or not to track liveness of stack slots *)
+            val liveStack: bool ref 
+
+            (* level of optimization to use in native codegen *)
+            val optimize: int ref
+
+            (* whether or not to use move hoisting in native codegen *)
+            val moveHoist: bool ref
+               
+            (* whether or not to use copy propagation in native codegen *)
+            val copyProp: bool ref
+
+            (* Don't use copy propagation on blocks larger than this. *)
+            val copyPropCutoff: int ref
+               
+            (* live transfer cutoff distance *)
+            val cutoff: int ref 
+
+            (* whether or not to use live transfer in native codegen *)
+            val liveTransfer: int ref 
+
+            (* whether or not to shuffle registers around C-calls *)
+            val shuffle: bool ref
+
+            (* whether or not to use strict IEEE floating-point in native codegen *)
+            val IEEEFP: bool ref
+
+            (* whether or not to split assembly file in native codegen *)
+            val split: int option ref
+         end
+
+      datatype optimizationPasses =
+         OptPassesCustom of string
+       | OptPassesDefault
+       | OptPassesMinimal
+      val optimizationPassesSet: 
+         (string * (optimizationPasses -> unit Result.t)) list ref
+
+      (* Only duplicate big functions when
+       * (size - small) * (number of occurrences - 1) <= product
+       *)
+      val polyvariance:
+         {
+          rounds: int,
+          small: int,
+          product: int
+         } option ref
+
+      (* List of pass names to keep profiling info on. *)
+      val profPasses: Regexp.Compiled.t list ref
+
+      (* Insert profiling information. *)
+      datatype profile =
+         ProfileNone
+       | ProfileAlloc
+       | ProfileCallStack
+       | ProfileCount
+       | ProfileDrop
+       | ProfileLabel
+       | ProfileTimeField
+       | ProfileTimeLabel
+      val profile: profile ref
+
+      val profileBranch: bool ref
+
+      val profileC: Regexp.Compiled.t list ref
+
+      datatype profileIL = ProfileSSA | ProfileSSA2 | ProfileSource
+      val profileIL: profileIL ref
+
+      val profileInclExcl: (Regexp.Compiled.t * bool) list ref
+
+      val profileRaise: bool ref
+
+      val profileStack: bool ref
+
+      (* Show the basis library. *)
+      val showBasis: File.t option ref
+         
+      (* Show def-use information. *)
+      val showDefUse: File.t option ref
+         
+      (* Should types be printed in ILs. *)
+      val showTypes: bool ref
+
+      (* SSA Passes *)
+      val ssaPassesSet: (optimizationPasses -> unit Result.t) ref
+      val ssaPasses: string list ref
+      val ssa2PassesSet: (optimizationPasses -> unit Result.t) ref
+      val ssa2Passes: string list ref
+
+      (* SXML Passes *)
+      val sxmlPassesSet: (optimizationPasses -> unit Result.t) ref
+      val sxmlPasses: string list ref
+
+      datatype target =
+         Cross of string
+       | Self
+      val target: target ref
+
+      datatype arch = datatype MLton.Platform.Arch.t
+      val targetArch: arch ref
+
+      val setTargetBigEndian: bool -> unit
+      val targetIsBigEndian: unit -> bool
+
+      datatype os = datatype MLton.Platform.OS.t
+      val targetOS: os ref
+
+      (* Type check ILs. *)
+      val typeCheck: bool ref
+
+      datatype verbosity = 
+         Silent
+       | Top
+       | Pass
+       | Detail
+      val verbosity: verbosity ref
+
+      (* version number *)
+      val version: string
+
+      val warnAnn: bool ref
+
+      (* XML Passes *)
+      val xmlPassesSet: (optimizationPasses -> unit Result.t) ref
+      val xmlPasses: string list ref
+
+      val zoneCutDepth: int ref
+
+      (*------------------------------------*)
+      (*             End Flags              *)
+      (*------------------------------------*)
+end

Copied: mlton/branches/on-20050420-cmm-branch/mlton/control/control-flags.sml (from rev 4358, mlton/trunk/mlton/control/control-flags.sml)
===================================================================
--- mlton/trunk/mlton/control/control-flags.sml	2006-02-15 03:30:28 UTC (rev 4358)
+++ mlton/branches/on-20050420-cmm-branch/mlton/control/control-flags.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -0,0 +1,1052 @@
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
+structure ControlFlags: CONTROL_FLAGS =
+struct
+
+structure C = Control ()
+open C
+
+structure Align =
+   struct
+      datatype t = Align4 | Align8
+
+      val toString =
+         fn Align4 => "4"
+          | Align8 => "8"
+   end
+
+datatype align = datatype Align.t
+
+val align = control {name = "align",
+                     default = Align4,
+                     toString = Align.toString}
+
+val atMLtons = control {name = "atMLtons",
+                        default = Vector.new0 (),
+                        toString = fn v => Layout.toString (Vector.layout
+                                                            String.layout v)}
+
+val build = concat ["(built ", Date.toString (Date.now ()),
+                    " on ", Process.hostName (), ")"]
+
+structure Cmm =
+   struct
+      val debug = control {name = "cmm debug",
+                           default = false,
+                           toString = Bool.toString}
+
+      structure NonTail =
+         struct
+            datatype t =
+               CutTo of {neverReturns: bool} | Return
+            val toString =
+               fn CutTo {neverReturns} => 
+                     concat ["cut to {neverReturns = ", 
+                             Bool.toString neverReturns,
+                             "}"]
+                | Return => "return"
+         end
+      datatype nonTail = datatype NonTail.t
+ 
+      val nonTail = control {name = "cmm non-tail",
+                             default = Return,
+                             toString = NonTail.toString}
+   end
+
+structure Chunk =
+   struct
+      datatype t =
+         OneChunk
+       | ChunkPerFunc
+       | Coalesce of {limit: int}
+
+      val toString =
+         fn OneChunk => "one chunk"
+          | ChunkPerFunc => "chunk per function"
+          | Coalesce {limit} => concat ["coalesce ", Int.toString limit]
+   end
+
+datatype chunk = datatype Chunk.t
+   
+val chunk = control {name = "chunk",
+                     default = Coalesce {limit = 4096},
+                     toString = Chunk.toString}
+
+structure Codegen =
+   struct
+      datatype t =
+         Bytecode
+       | CCodegen
+       | CmmCodegen
+       | Native
+
+      val toString: t -> string =
+         fn Bytecode => "Bytecode"
+          | CCodegen => "C"
+          | CmmCodegen => "C--"
+          | Native => "Native"
+   end
+
+datatype codegen = datatype Codegen.t
+   
+val codegen = control {name = "codegen",
+                       default = Native,
+                       toString = Codegen.toString}
+
+val contifyIntoMain = control {name = "contifyIntoMain",
+                               default = false,
+                               toString = Bool.toString}
+
+val debug = control {name = "debug",
+                     default = false,
+                     toString = Bool.toString}
+
+val diagPasses = 
+   control {name = "diag passes",
+            default = [],
+            toString = List.toString 
+                       (Layout.toString o 
+                        Regexp.Compiled.layout)}
+
+val dropPasses =
+   control {name = "drop passes",
+            default = [],
+            toString = List.toString
+                       (Layout.toString o
+                        Regexp.Compiled.layout)}
+
+structure Elaborate =
+   struct
+      structure DiagEIW =
+         struct
+            datatype t =
+               Error
+             | Ignore
+             | Warn
+
+            val fromString: string -> t option =
+               fn "error" => SOME Error
+                | "ignore" => SOME Ignore
+                | "warn" => SOME Warn
+                | _ => NONE
+
+            val toString: t -> string = 
+               fn Error => "error"
+                | Ignore => "ignore"
+                | Warn => "warn"
+         end
+      
+      structure DiagDI =
+         struct
+            datatype t =
+               Default
+             | Ignore
+
+            val fromString: string -> t option =
+               fn "default" => SOME Default
+                | "ignore" => SOME Ignore
+                | _ => NONE
+
+            val toString: t -> string = 
+               fn Default => "default"
+                | Ignore => "ignore"
+         end
+
+      structure Id =
+         struct
+            datatype t = T of {enabled: bool ref,
+                               expert: bool,
+                               name: string}
+            fun equals (T {enabled = enabled1, ...}, 
+                        T {enabled = enabled2, ...}) = 
+               enabled1 = enabled2
+
+            val enabled = fn (T {enabled, ...}) => !enabled
+            val setEnabled = fn (T {enabled, expert, ...}, b) =>
+               if expert
+                  then false
+                  else (enabled := b; true)
+            val expert = fn (T {expert, ...}) => expert
+            val name = fn (T {name, ...}) => name
+         end
+      structure Args =
+         struct
+            datatype t = T of {fillArgs: unit -> (unit -> unit),
+                               processAnn: unit -> (unit -> unit),
+                               processDef: unit -> bool}
+            local
+               fun make sel (T r) = sel r
+            in
+               fun processAnn args = (make #processAnn args) ()
+               fun processDef args = (make #processDef args) ()
+            end
+         end
+      datatype ('args, 'st) t = T of {args: 'args option ref,
+                                      cur: 'st ref,
+                                      def: 'st ref,
+                                      id: Id.t}
+      fun current (T {cur, ...}) = !cur
+      fun default (T {def, ...}) = !def
+      fun id (T {id, ...}) = id
+      fun enabled ctrl = Id.enabled (id ctrl)
+      fun expert ctrl = Id.expert (id ctrl)
+      fun name ctrl = Id.name (id ctrl)
+      fun equalsId (ctrl, id') = Id.equals (id ctrl, id')
+
+      datatype ('a, 'b) parseResult =
+         Bad | Deprecated of 'a | Good of 'b | Other
+      val deGood = 
+         fn Good z => z
+          | _ => Error.bug "Control.Elaborate.deGood"
+
+      val documentation: {choices: string list option,
+                          expert: bool,
+                          name: string} list ref = ref []
+
+      fun document {expert} =
+         let
+            val all = !documentation
+            val all =
+               if expert then all
+               else List.keepAll (all, not o #expert)
+            val all =
+               List.insertionSort
+               (all, fn ({name = n, ...}, {name = n', ...}) => n <= n')
+            open Layout
+         in
+            align
+            (List.map
+             (all, fn {choices, name, ...} =>
+              str (concat [name,
+                           case choices of
+                              NONE => ""
+                            | SOME cs =>
+                                 concat [" {",
+                                         concat (List.separate (cs, "|")),
+                                         "}"]])))
+         end
+         
+      local 
+         fun make ({choices: 'st list option,
+                    default: 'st,
+                    expert: bool,
+                    toString: 'st -> string,
+                    name: string,
+                    newCur: 'st * 'args -> 'st,
+                    newDef: 'st * 'args -> 'st,
+                    parseArgs: string list -> 'args option},
+                   {parseId: string -> (Id.t list, Id.t) parseResult,
+                    parseIdAndArgs: string -> ((Id.t * Args.t) list, (Id.t * Args.t)) parseResult,
+                    withDef: unit -> (unit -> unit),
+                    snapshot: unit -> unit -> (unit -> unit)}) =
+            let
+               val () =
+                  List.push
+                  (documentation,
+                   {choices = Option.map (choices, fn cs =>
+                                          List.map (cs, toString)),
+                    expert = expert,
+                    name = name})
+               val ctrl as T {args = argsRef, cur, def, 
+                              id as Id.T {enabled, ...}, ...} =
+                  T {args = ref NONE,
+                     cur = ref default,
+                     def = control {name = concat ["elaborate ", name,
+                                                   " (default)"],
+                                    default = default,
+                                    toString = toString},
+                     id = Id.T {enabled = control {name = concat ["elaborate ", name,
+                                                                  " (enabled)"],
+                                                   default = true,
+                                                   toString = Bool.toString},
+                                expert = expert,
+                                name = name}}
+               val parseId = fn name' =>
+                  if String.equals (name', name) 
+                     then Good id 
+                     else parseId name'
+               val parseIdAndArgs = fn s =>
+                  case String.tokens (s, Char.isSpace) of
+                     name'::args' =>
+                        if String.equals (name', name)
+                           then 
+                              case parseArgs args' of
+                                 SOME v => 
+                                    let
+                                       fun fillArgs () =
+                                          (argsRef := SOME v
+                                           ; fn () => argsRef := NONE)
+                                       fun processAnn () =
+                                          if !enabled
+                                             then let
+                                                     val old = !cur
+                                                     val new = newCur (old, v)
+                                                  in
+                                                     cur := new
+                                                     ; fn () => cur := old
+                                                  end
+                                             else fn () => ()
+                                       fun processDef () =
+                                          if expert
+                                             then false
+                                             else let
+                                                     val old = !def
+                                                     val new = newDef (old, v)
+                                                  in
+                                                     def := new
+                                                     ; true
+                                                  end
+                                       val args =
+                                          Args.T {fillArgs = fillArgs,
+                                                  processAnn = processAnn,
+                                                  processDef = processDef}
+                                    in
+                                       Good (id, args)
+                                    end
+                               | NONE => Bad
+                           else parseIdAndArgs s
+                   | _ => Bad
+               val withDef : unit -> (unit -> unit) =
+                  fn () =>
+                  let
+                     val restore = withDef ()
+                     val old = !cur
+                  in
+                     cur := !def
+                     ; fn () => (cur := old
+                                 ; restore ())
+                  end
+               val snapshot : unit -> unit -> (unit -> unit) =
+                  fn () =>
+                  let 
+                     val withSaved = snapshot ()
+                     val saved = !cur 
+                  in
+                     fn () =>
+                     let
+                        val restore = withSaved ()
+                        val old = !cur
+                     in
+                        cur := saved
+                        ; fn () => (cur := old
+                                    ; restore ())
+                     end
+                  end
+            in
+               (ctrl, 
+                {parseId = parseId,
+                 parseIdAndArgs = parseIdAndArgs,
+                 withDef = withDef,
+                 snapshot = snapshot})
+            end
+
+         fun makeBool ({default: bool,
+                        expert: bool,
+                        name: string}, ac) =
+            make ({choices = SOME (if default then [true, false]
+                                   else [false, true]),
+                   default = default,
+                   expert = expert,
+                   toString = Bool.toString,
+                   name = name,
+                   newCur = fn (_,b) => b,
+                   newDef = fn (_,b) => b,
+                   parseArgs = fn args' =>
+                               case args' of
+                                  [arg'] => Bool.fromString arg'
+                                | _ => NONE}, 
+                  ac)
+
+         fun makeDiagnostic ({choices,
+                              default,
+                              diagToString,
+                              diagFromString,
+                              expert: bool,
+                              name: string}, ac) =
+             make ({choices = choices,
+                    default = default,
+                    expert = expert,
+                    toString = diagToString,
+                    name = name,
+                    newCur = fn (_,d) => d,
+                    newDef = fn (_,d) => d,
+                    parseArgs = fn args' =>
+                                case args' of
+                                   [arg'] => diagFromString arg'
+                                 | _ => NONE},
+                   ac)
+         fun makeDiagEIW ({default: DiagEIW.t,
+                           expert: bool,
+                           name: string}, ac) =
+            makeDiagnostic ({choices = (SOME
+                                        (let
+                                            datatype z = datatype DiagEIW.t
+                                         in
+                                            case default of
+                                               Error => [Error, Ignore, Warn]
+                                             | Ignore => [Ignore, Error, Warn]
+                                             | Warn => [Warn, Ignore, Error]
+                                         end)),
+                             default = default,
+                             diagToString = DiagEIW.toString,
+                             diagFromString = DiagEIW.fromString,
+                             expert = expert,
+                             name = name}, ac)
+         fun makeDiagDI ({default: DiagDI.t,
+                          expert: bool,
+                          name: string}, ac) =
+            makeDiagnostic ({choices = (SOME
+                                        (let
+                                            datatype z = datatype DiagDI.t
+                                         in
+                                            case default of
+                                               Default => [Default, Ignore]
+                                             | Ignore => [Ignore, Default]
+                                         end)),
+                             default = default,
+                             diagToString = DiagDI.toString,
+                             diagFromString = DiagDI.fromString,
+                             expert = expert,
+                             name = name}, ac)
+      in
+         val ac =
+            {parseId = fn _ => Bad,
+             parseIdAndArgs = fn _ => Bad,
+             withDef = fn () => (fn () => ()),
+             snapshot = fn () => fn () => (fn () => ())}
+         val (allowConstant, ac) =
+            makeBool ({name = "allowConstant", 
+                       default = false, expert = true}, ac)
+         val (allowFFI, ac) =
+            makeBool ({name = "allowFFI",
+                       default = false, expert = false}, ac)
+         val (allowPrim, ac) =
+            makeBool ({name = "allowPrim", 
+                       default = false, expert = true}, ac)
+         val (allowOverload, ac) =
+            makeBool ({name = "allowOverload", 
+                       default = false, expert = false}, ac)
+         val (allowRebindEquals, ac) =
+            makeBool ({name = "allowRebindEquals", 
+                       default = false, expert = true}, ac)
+         val (deadCode, ac) =
+            makeBool ({name = "deadCode", 
+                       default = false, expert = false}, ac)
+         val (forceUsed, ac) =
+            make ({choices = NONE,
+                   default = false,
+                   expert = false,
+                   toString = Bool.toString,
+                   name = "forceUsed",
+                   newCur = fn (b,()) => b,
+                   newDef = fn (_,()) => true,
+                   parseArgs = fn args' =>
+                               case args' of
+                                  [] => SOME ()
+                                | _ => NONE},
+                  ac)
+         val (ffiStr, ac) =
+            make ({choices = SOME [SOME "<longstrid>"],
+                   default = NONE,
+                   expert = true,
+                   toString = fn NONE => "" | SOME s => s,
+                   name = "ffiStr",
+                   newCur = fn (_,s) => SOME s,
+                   newDef = fn _ => NONE,
+                   parseArgs = fn args' =>
+                               case args' of
+                                  [s] => SOME s
+                                | _ => NONE},
+                  ac)
+         val (nonexhaustiveExnMatch, ac) =
+             makeDiagDI ({name = "nonexhaustiveExnMatch",
+                          default = DiagDI.Default, expert = false}, ac)
+         val (nonexhaustiveMatch, ac) =
+             makeDiagEIW ({name = "nonexhaustiveMatch", 
+                           default = DiagEIW.Warn, expert = false}, ac)
+         val (redundantMatch, ac) =
+             makeDiagEIW ({name = "redundantMatch", 
+                           default = DiagEIW.Warn, expert = false}, ac)
+         val (sequenceNonUnit, ac) =
+            makeDiagEIW ({name = "sequenceNonUnit", 
+                          default = DiagEIW.Ignore, expert = false}, ac)
+         val (warnUnused, ac) =
+            makeBool ({name = "warnUnused", 
+                       default = false, expert = false}, ac)
+
+         val {parseId, parseIdAndArgs, withDef, snapshot} = ac
+      end
+
+      local
+         fun makeDeprecated ({alts: string list,
+                              name: string,
+                              parseArgs: string list -> string list option},
+                             {parseId: string -> (Id.t list, Id.t) parseResult,
+                              parseIdAndArgs: string -> ((Id.t * Args.t) list, (Id.t * Args.t)) parseResult}) =
+            let
+               val parseId = fn name' =>
+                  if String.equals (name', name) 
+                     then Deprecated (List.map (alts, deGood o parseId))
+                     else parseId name'
+               val parseIdAndArgs = fn s =>
+                  case String.tokens (s, Char.isSpace) of
+                     name'::args' =>
+                        if String.equals (name', name)
+                           then 
+                              case parseArgs args' of
+                                 SOME alts => 
+                                    Deprecated (List.map (alts, deGood o parseIdAndArgs))
+                               | NONE => Bad
+                           else parseIdAndArgs s
+                   | _ => Bad
+            in
+               {parseId = parseId,
+                parseIdAndArgs = parseIdAndArgs}
+            end
+         fun makeDeprecatedBool ({altIds: string list,
+                                  altArgs: bool -> string list list,
+                                  name: string},
+                                 ac) =
+            let
+               local
+                  fun make b =
+                     List.map2
+                     (altIds, altArgs b, fn (altId, altArgs) =>
+                      String.concatWith (altId::altArgs, " "))
+               in
+                  val trueAltIdAndArgs = make true
+                  val falseAltIdAndArgs = make false
+               end
+            in
+               makeDeprecated ({alts = altIds,
+                                name = name,
+                                parseArgs = fn args' =>
+                                            case args' of
+                                               [arg'] => 
+                                                  (case Bool.fromString arg' of
+                                                      SOME true => SOME trueAltIdAndArgs
+                                                    | SOME false => SOME falseAltIdAndArgs
+                                                    | NONE => NONE)
+                                             | _ => NONE}, 
+                               ac)
+            end
+      in
+         val ac = {parseId = parseId, parseIdAndArgs = parseIdAndArgs}
+
+         val ac =
+            makeDeprecatedBool ({altIds = ["allowFFI"],
+                                 altArgs = fn b => [[Bool.toString b]],
+                                 name = "allowExport"}, ac)
+         val ac =
+            makeDeprecatedBool ({altIds = ["allowFFI"],
+                                 altArgs = fn b => [[Bool.toString b]],
+                                 name = "allowImport"}, ac)
+         val ac =
+            makeDeprecatedBool ({altIds = ["sequenceNonUnit"],
+                                 altArgs = fn true => [["warn"]] | false => [["ignore"]],
+                                 name = "sequenceUnit"}, ac)
+         val ac =
+            makeDeprecatedBool ({altIds = ["nonexhaustiveMatch", "redundantMatch"],
+                                 altArgs = fn true => [["warn"], ["warn"]] | false => [["ignore"], ["ignore"]],
+                                 name = "warnMatch"}, ac)
+         val {parseId, parseIdAndArgs} = ac
+      end
+
+      local
+         fun checkPrefix (s, f) =
+            case String.peeki (s, fn (_, c) => c = #":") of
+               NONE => f s
+             | SOME (i, _) =>
+                  let
+                     val comp = String.prefix (s, i)
+                     val comp = String.deleteSurroundingWhitespace comp
+                     val s = String.dropPrefix (s, i + 1)
+                  in
+                     if String.equals (comp, "mlton")
+                        then f s
+                        else Other
+                  end
+      in
+         val parseId = fn s => checkPrefix (s, parseId)
+         val parseIdAndArgs = fn s => checkPrefix (s, parseIdAndArgs)
+      end
+
+      val processDefault = fn s =>
+         case parseIdAndArgs s of
+            Bad => Bad
+          | Deprecated alts =>
+               List.fold
+               (alts, Deprecated (List.map (alts, #1)), fn ((_,args),res) =>
+                if Args.processDef args then res else Bad)
+          | Good (_, args) => if Args.processDef args then Good () else Bad
+          | Other => Bad
+
+      val processEnabled = fn (s, b) =>
+         case parseId s of
+            Bad => Bad
+          | Deprecated alts => 
+               List.fold
+               (alts, Deprecated alts, fn (id,res) =>
+                if Id.setEnabled (id, b) then res else Bad)
+          | Good id => if Id.setEnabled (id, b) then Good () else Bad
+          | Other => Bad
+
+      val withDef : (unit -> 'a) -> 'a = fn f =>
+         let
+            val restore = withDef ()
+         in
+            Exn.finally (f, restore)
+         end
+      
+      val snapshot : unit -> (unit -> 'a) -> 'a = fn () =>
+         let
+            val withSaved = snapshot ()
+         in
+            fn f =>
+            let
+               val restore = withSaved ()
+            in
+               Exn.finally (f, restore)
+            end
+         end
+
+   end
+
+val elaborateOnly =
+   control {name = "elaborate only",
+            default = false,
+            toString = Bool.toString}
+
+val exportHeader =
+   control {name = "export header",
+            default = NONE,
+            toString = Option.toString File.toString}
+   
+val exnHistory = control {name = "exn history",
+                          default = false,
+                          toString = Bool.toString}
+   
+structure GcCheck =
+   struct
+      datatype t =
+         Limit
+       | First
+       | Every
+
+      local open Layout
+      in
+         val layout =
+            fn Limit => str "Limit"
+             | First => str "First"
+             | Every => str "Every"
+      end
+      val toString = Layout.toString o layout
+   end
+
+datatype gcCheck = datatype GcCheck.t
+
+val gcCheck = control {name = "gc check",
+                       default = Limit,
+                       toString = GcCheck.toString}
+
+val indentation = control {name = "indentation",
+                           default = 3,
+                           toString = Int.toString}
+
+structure Inline =
+   struct
+      datatype t =
+         NonRecursive of {product: int,
+                          small: int}
+       | Leaf of {size: int option}
+       | LeafNoLoop of {size: int option}
+
+      local open Layout
+         val iol = Option.layout Int.layout
+      in
+         val layout = 
+            fn NonRecursive {product, small} =>
+            seq [str "NonRecursive ",
+                record [("product", Int.layout product),
+                       ("small", Int.layout small)]]
+             | Leaf {size} => seq [str "Leaf ", iol size]
+             | LeafNoLoop {size} => seq [str "LeafNoLoop ", iol size]
+      end
+      val toString = Layout.toString o layout
+   end
+
+datatype inline = datatype Inline.t
+
+val inline = control {name = "inline",
+                      default = NonRecursive {product = 320,
+                                              small = 60},
+                      toString = Inline.toString}
+
+fun setInlineSize (size: int): unit =
+   inline := (case !inline of
+                 NonRecursive {small, ...} =>
+                    NonRecursive {product = size, small = small}
+               | Leaf _ => Leaf {size = SOME size}
+               | LeafNoLoop _ => LeafNoLoop {size = SOME size})
+
+val inlineIntoMain = control {name = "inlineIntoMain",
+                              default = true,
+                              toString = Bool.toString}
+
+val inputFile = control {name = "input file",
+                         default = "<bogus>",
+                         toString = File.toString}
+
+val keepMachine = control {name = "keep Machine",
+                           default = false,
+                           toString = Bool.toString}
+   
+val keepRSSA = control {name = "keep RSSA",
+                        default = false,
+                        toString = Bool.toString}
+
+val keepSSA = control {name = "keep SSA",
+                       default = false,
+                       toString = Bool.toString}
+
+val keepSSA2 = control {name = "keep SSA2",
+                        default = false,
+                        toString = Bool.toString}
+
+val keepDot = control {name = "keep dot",
+                       default = false,
+                       toString = Bool.toString}
+
+val keepPasses = control {name = "keep passes",
+                          default = [],
+                          toString = List.toString 
+                                     (Layout.toString o 
+                                      Regexp.Compiled.layout)}
+
+val labelsHaveExtra_ = control {name = "extra_",
+                                default = false,
+                                toString = Bool.toString}
+
+val libDir = control {name = "lib dir",
+                      default = "<libDir unset>",
+                      toString = fn s => s}
+
+val libTargetDir = control {name = "lib target dir",
+                            default = "<libTargetDir unset>",
+                            toString = fn s => s} 
+   
+val loopPasses = control {name = "loop passes",
+                          default = 1,
+                          toString = Int.toString}
+
+val markCards = control {name = "mark cards",
+                         default = true,
+                         toString = Bool.toString}
+
+val maxFunctionSize = control {name = "max function size",
+                               default = 10000,
+                               toString = Int.toString}
+
+val mlbPathMaps = control {name = "mlb path maps",
+                           default = [],
+                           toString = List.toString (fn s => s)}
+   
+structure Native =
+   struct
+      val commented = control {name = "native commented",
+                               default = 0,
+                               toString = Int.toString}
+
+      val liveStack = control {name = "native live stack",
+                               default = false,
+                               toString = Bool.toString}
+
+      val optimize = control {name = "native optimize",
+                              default = 1,
+                              toString = Int.toString}
+
+      val moveHoist = control {name = "native move hoist",
+                               default = true,
+                               toString = Bool.toString}
+
+      val copyProp = control {name = "native copy prop",
+                              default = true,
+                              toString = Bool.toString}
+
+      val copyPropCutoff = control {name = "native copy prop cutoff",
+                                    default = 1000,
+                                    toString = Int.toString}
+
+      val cutoff = control {name = "native cutoff",
+                            default = 100,
+                            toString = Int.toString}
+
+      val liveTransfer = control {name = "native live transfer",
+                                  default = 8,
+                                  toString = Int.toString}
+
+      val shuffle = control {name = "native shuffle",
+                             default = true,
+                             toString = Bool.toString}
+
+      val IEEEFP = control {name = "native ieee fp",
+                            default = false,
+                            toString = Bool.toString}
+
+      val split = control {name = "native split",
+                           default = SOME 20000,
+                           toString = Option.toString Int.toString}
+   end
+
+structure OptimizationPasses =
+   struct
+      datatype t = 
+         OptPassesCustom of string
+       | OptPassesDefault
+       | OptPassesMinimal
+
+(*
+      local open Layout
+      in
+         val layout =
+            fn OptPassesCustom s => seq [str "Limit: ", str s]
+             | OptPassesDefault => str "Default"
+             | OptPassesMinimal => str "Minimal"
+      end
+      val toString = Layout.toString o layout
+*)
+   end
+datatype optimizationPasses = datatype OptimizationPasses.t
+val optimizationPassesSet : 
+   (string * (optimizationPasses -> unit Result.t)) list ref =
+   control {name = "optimizationPassesSet",
+            default = [],
+            toString = List.toString 
+                       (fn (s,_) => concat ["<",s,"PassesSet>"])}
+
+val polyvariance =
+   control {name = "polyvariance",
+            default = SOME {rounds = 2,
+                            small = 30,
+                            product = 300},
+            toString =
+            fn p =>
+            Layout.toString
+            (Option.layout
+             (fn {rounds, small, product} =>
+              Layout.record [("rounds", Int.layout rounds),
+                             ("small", Int.layout small),
+                             ("product", Int.layout product)])
+             p)}
+
+val profPasses = 
+   control {name = "prof passes",
+            default = [],
+            toString = List.toString 
+            (Layout.toString o 
+             Regexp.Compiled.layout)}
+
+structure Profile =
+   struct
+      datatype t =
+         ProfileNone
+       | ProfileAlloc
+       | ProfileCallStack
+       | ProfileCount
+       | ProfileDrop
+       | ProfileLabel
+       | ProfileTimeField
+       | ProfileTimeLabel
+
+      val toString =
+         fn ProfileNone => "None"
+          | ProfileAlloc => "Alloc"
+          | ProfileCallStack => "CallStack"
+          | ProfileCount => "Count"
+          | ProfileDrop => "Drop"
+          | ProfileLabel => "Label"
+          | ProfileTimeField => "TimeField"
+          | ProfileTimeLabel => "TimeLabel"
+   end
+
+datatype profile = datatype Profile.t
+   
+val profile = control {name = "profile",
+                       default = ProfileNone,
+                       toString = Profile.toString}
+
+val profileBranch = control {name = "profile branch",
+                             default = false,
+                             toString = Bool.toString}
+
+val profileC = control {name = "profile C",
+                        default = [],
+                        toString = List.toString
+                                   (Layout.toString o 
+                                    Regexp.Compiled.layout)}
+
+structure ProfileIL =
+   struct
+      datatype t = ProfileSSA | ProfileSSA2 | ProfileSource
+
+      val toString =
+         fn ProfileSSA => "ProfileSSA"
+          | ProfileSSA2 => "ProfileSSA2"
+          | ProfileSource => "ProfileSource"
+   end
+
+datatype profileIL = datatype ProfileIL.t
+   
+val profileIL = control {name = "profile IL",
+                         default = ProfileSource,
+                         toString = ProfileIL.toString}
+
+val profileInclExcl = 
+   control {name = "profile include/exclude",
+            default = [],
+            toString = List.toString
+                       (Layout.toString o 
+                        (Layout.tuple2 (Regexp.Compiled.layout, 
+                                        Bool.layout)))}
+
+val profileRaise = control {name = "profile raise",
+                            default = false,
+                            toString = Bool.toString}
+
+val profileStack = control {name = "profile stack",
+                            default = false,
+                            toString = Bool.toString}
+
+val showBasis = control {name = "show basis",
+                         default = NONE,
+                         toString = Option.toString File.toString}
+   
+val showDefUse = control {name = "show def-use",
+                          default = NONE,
+                          toString = Option.toString File.toString}
+
+val showTypes = control {name = "show types",
+                         default = false,
+                         toString = Bool.toString}
+
+val ssaPassesSet : (optimizationPasses -> unit Result.t) ref = 
+   control {name = "ssaPassesSet",
+            default = fn _ => Error.bug ("ControlFlags.ssaPassesSet: not installed"),
+            toString = fn _ => "<ssaPassesSet>"}
+val ssaPasses : string list ref = 
+   control {name = "ssaPasses",
+            default = ["default"],
+            toString = List.toString String.toString}
+val ssa2PassesSet : (optimizationPasses -> unit Result.t) ref = 
+   control {name = "ssa2PassesSet",
+            default = fn _ => Error.bug ("ControlFlags.ssa2PassesSet: not installed"),
+            toString = fn _ => "<ssa2PassesSet>"}
+val ssa2Passes : string list ref = 
+   control {name = "ssa2Passes",
+            default = ["default"],
+            toString = List.toString String.toString}
+
+val sxmlPassesSet : (optimizationPasses -> unit Result.t) ref = 
+   control {name = "sxmlPassesSet",
+            default = fn _ => Error.bug ("ControlFlags.sxmlPassesSet: not installed"),
+            toString = fn _ => "<sxmlPassesSet>"}
+val sxmlPasses : string list ref = 
+   control {name = "sxmlPasses",
+            default = ["default"],
+            toString = List.toString String.toString}
+
+structure Target =
+   struct
+      datatype t =
+         Cross of string
+       | Self
+
+      val toString =
+         fn Cross s => s
+          | Self => "self"
+   end
+
+datatype target = datatype Target.t
+   
+val target = control {name = "target",
+                      default = Self,
+                      toString = Target.toString}
+
+datatype arch = datatype MLton.Platform.Arch.t
+
+val targetArch = control {name = "target arch",
+                          default = X86,
+                          toString = MLton.Platform.Arch.toString}
+
+local
+   val r: bool option ref = ref NONE
+in
+   fun setTargetBigEndian b = r := SOME b
+   fun targetIsBigEndian () =
+      case !r of
+         NONE => Error.bug "ControlFlags.targetIsBigEndian: not set"
+       | SOME b => b
+end
+
+datatype os = datatype MLton.Platform.OS.t
+
+val targetOS = control {name = "target OS",
+                        default = Linux,
+                        toString = MLton.Platform.OS.toString}
+
+val typeCheck = control {name = "type check",
+                         default = false,
+                         toString = Bool.toString}
+   
+structure Verbosity =
+   struct
+      datatype t =
+         Silent
+       | Top
+       | Pass
+       | Detail
+
+      val toString =
+         fn Silent => "Silent"
+          | Top => "Top"
+          | Pass => "Pass"
+          | Detail => "Detail"
+   end
+
+datatype verbosity = datatype Verbosity.t
+   
+val verbosity = control {name = "verbosity",
+                         default = Silent,
+                         toString = Verbosity.toString}
+
+val version = "MLton MLTONVERSION"
+
+val warnAnn = control {name = "warn unrecognized annotation",
+                       default = true,
+                       toString = Bool.toString}
+
+val xmlPassesSet: (optimizationPasses -> unit Result.t) ref = 
+   control {name = "xmlPassesSet",
+            default = fn _ => Error.bug ("ControlFlags.xmlPassesSet: not installed"),
+            toString = fn _ => "<xmlPassesSet>"}
+val xmlPasses: string list ref = 
+   control {name = "xmlPasses",
+            default = ["default"],
+            toString = List.toString String.toString}
+
+val zoneCutDepth: int ref =
+   control {name = "zone cut depth",
+            default = 100,
+            toString = Int.toString}
+
+val defaults = setDefaults
+
+val _ = defaults ()
+
+end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/control/control.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/control/control.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/control/control.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,372 +1,17 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 type int = Int.t
    
 signature CONTROL =
    sig
-      val instrumentSxml: bool ref
-	 
-      (* set all flags to their default values *)
-      val defaults: unit -> unit
+      include CONTROL_FLAGS
 
-      (*------------------------------------*)
-      (*            Begin Flags             *)
-      (*------------------------------------*)
-
-      datatype align = Align4 | Align8
-      val align: align ref
-
-      val atMLtons: string vector ref
-
-      val basisLibs: string list
-      val basisLibrary: string ref
-
-      (* build identifies the machine on which this MLton was built. *)
-      val build: string
-
-      val cardSizeLog2: int ref
-
-      datatype chunk =
-	 OneChunk
-       | ChunkPerFunc
-       | Coalesce of {limit: int}
-
-      val chunk: chunk ref
-
-      structure Cmm :
-	 sig
-	    val debug : bool ref
-
-	    datatype nonTail =
-	       CutTo of {neverReturns: bool} | Return
-
-	    val nonTail : nonTail ref
-	 end
-
-      datatype codegen =
-	 Bytecode
-       | CCodegen
-       | CmmCodegen
-       | Native
-
-      val codegen: codegen ref
-
-      val contifyIntoMain: bool ref
-
-      (* Generate an executable with debugging info. *)
-      val debug: bool ref
-
-      val deepFlattenDelay: bool ref
-	 
-      val deepFlattenUnify: bool ref
-	 
-      val defines: string list ref
-
-      (* List of pass names to keep diagnostic info on. *)
-      val diagPasses: Regexp.Compiled.t list ref
-
-      (* List of optimization passes to skip. *)
-      val dropPasses: Regexp.Compiled.t list ref
-
-      structure Elaborate :
-	 sig
-	    type ('args, 'st) t
-
-	    val allowConstant: (bool,bool) t
-	    val allowExport: (bool,bool) t
-	    val allowImport: (bool,bool) t
-	    val allowOverload: (bool,bool) t
-	    val allowPrim: (bool,bool) t
-	    val allowRebindEquals: (bool,bool) t
-	    val deadCode: (bool,bool) t
-	    val forceUsed: (unit,bool) t
-	    val ffiStr: (string,string option) t
-	    (* in (e1; e2), require e1: unit. *)
-	    val sequenceUnit: (bool,bool) t
-	    val warnMatch: (bool,bool) t
-	    val warnUnused: (bool,bool) t
-
-	    val current: ('args, 'st) t -> 'st
-	    val default: ('args, 'st) t -> 'st
-	    val setDefault: ('args, 'st) t * 'st -> unit
-	    val enabled: ('args, 'st) t -> bool
-	    val setEnabled: ('args, 'st) t * bool -> bool
-	    val expert: ('args, 'st) t -> bool
-	    val name: ('args, 'st) t -> string
-
-	    structure Id :
-	       sig
-		  type t
-	       end
-	    val equalsId: ('args, 'st) t * Id.t -> bool
-	    val parseId: string -> Id.t option
-
-	    structure Args :
-	       sig
-		  type t
-		  val processAnn: t -> (unit -> unit)
-	       end
-	    val args: ('args, 'st) t * Args.t -> 'args option
-	    val parseIdAndArgs: string -> (Id.t * Args.t) option
-
-	    val processDefault: string -> bool
-	    val processEnabled: string * bool -> bool
-
-	    val withDef: (unit -> 'a) -> 'a
-	    val snapshot: unit -> (unit -> 'a) -> 'a
-	 end
-
-      (* stop after elaboration.  So, no need for the elaborator to generate
-       * valid CoreML.
-       *)
-      val elaborateOnly: bool ref
-
-      (* whether optimization passes should eliminate useless overflow tests *)
-      val eliminateOverflow: bool ref
-
-      val exportHeader: File.t option ref
-	 
-      val exnHistory: bool ref
-
-      (* *)
-      datatype gcCheck =
-	 Limit
-       | First
-       | Every
-      val gcCheck: gcCheck ref
-
-      datatype handlers = Flow | Simple
-      val handlers: handlers ref
-
-      (* Indentation used in laying out ILs. *)
-      val indentation: int ref
-	 
-      datatype inline =
-	 NonRecursive of {product: int,
-			  small: int}
-       | Leaf of {size: int option}
-       | LeafNoLoop of {size: int option}
-      val inline: inline ref
-      val layoutInline: inline -> Layout.t
-      val setInlineSize: int -> unit
-
-      val inlineIntoMain: bool ref
-
-      (* The input file on the command line, minus path and extension *)
-      val inputFile: File.t ref
-
-      (* call count instrumentation *)
-      val instrument: bool ref
-
-      (* Keep dot files for whatever SSA files are produced. *)
-      val keepDot: bool ref
-
-      (* Save the Machine to a file. *)
-      val keepMachine: bool ref
-	 
-      (* List of pass names to save the result of. *)
-      val keepPasses: Regexp.Compiled.t list ref
-
-      (* Save the RSSA to a file. *)
-      val keepRSSA: bool ref
-	 
-      (* Save the SSA to a file. *)
-      val keepSSA: bool ref
-      (* Save the SSA2 to a file. *)
-      val keepSSA2: bool ref
-
-      (* For the codegen -- do labels for gcc and assembler need an extra leading
-       * underscore.
-       *)
-      val labelsHaveExtra_: bool ref
-
-      (* lib/mlton directory *)
-      val libDir: Dir.t ref
-
-      (* lib/mlton/target directory *)
-      val libTargetDir: Dir.t ref
-
-      datatype limitCheck =
-	 (* per block *)
-	 PerBlock
-         (* decycle using extended basic blocks 
-	  *)
-       | ExtBasicBlocks
-	 (* decycle using loop headers
-	  *  - use full CFG
-	  *  - use loop exits of non-allocating loops
-	  *)
-       | LoopHeaders of {fullCFG: bool,
-			 loopExits: bool}
-
-      val limitCheck: limitCheck ref
-
-      (* Whether or not dynamic counts of limit checks are computed. *)
-      val limitCheckCounts: bool ref
-
-      (* Number of times to loop through optimization passes. *)
-      val loopPasses: int ref
-	 
-      (* Should the mutator mark cards? *)
-      val markCards: bool ref
-
-      val maxFunctionSize: int ref
-
-      (* May the executable use @MLton load-world -- *)
-      val mayLoadWorld: bool ref
-
-      structure Native:
-	 sig
-	    (* whether or not to use comments in native codegen *)
-	    val commented: int ref
-
-	    (* whether or not to track liveness of stack slots *)
-	    val liveStack: bool ref 
-
-	    (* level of optimization to use in native codegen *)
-	    val optimize: int ref
-
-	    (* whether or not to use move hoisting in native codegen *)
-	    val moveHoist: bool ref
-	       
-	    (* whether or not to use copy propagation in native codegen *)
-	    val copyProp: bool ref
-
-	    (* Don't use copy propagation on blocks larger than this. *)
-	    val copyPropCutoff: int ref
-	       
-	    (* live transfer cutoff distance *)
-	    val cutoff: int ref 
-
-	    (* whether or not to use live transfer in native codegen *)
-	    val liveTransfer: int ref 
-
-	    (* size of future list for register allocation *)
-	    val future: int ref
-
-	    (* whether or not to shuffle registers around C-calls *)
-	    val shuffle: bool ref
-
-	    (* whether or not to use strict IEEE floating-point in native codegen *)
-	    val IEEEFP: bool ref
-
-	    (* whether or not to split assembly file in native codegen *)
-	    val split: int option ref
-	 end
-
-      (* Whether or not to use the new non-tail call return convention.
-       *)
-      val newReturn: bool ref
-
-      (* Only duplicate big functions when
-       * (size - small) * (number of occurrences - 1) <= product
-       *)
-      val polyvariance:
-	 {
-	  rounds: int,
-	  small: int,
-	  product: int
-	 } option ref
-
-      (* List of pass names to keep profiling info on. *)
-      val profPasses: Regexp.Compiled.t list ref
-
-      (* Insert profiling information. *)
-      datatype profile =
-	 ProfileNone
-       | ProfileAlloc
-       | ProfileCallStack
-       | ProfileCount
-       | ProfileMark
-       | ProfileTime
-      val profile: profile ref
-
-      val profileBasis: bool ref
-
-      datatype profileIL = ProfileSSA | ProfileSSA2 | ProfileSource
-      val profileIL: profileIL ref
-
-      val profileBranch: bool ref
-
-      val profileStack: bool ref
-
-      val reserveEsp: bool option ref
-
-      (* Show the basis library. *)
-      val showBasis: File.t option ref
-	 
-      (* Show def-use information. *)
-      val showDefUse: File.t option ref
-	 
-      (* Should types be printed in ILs. *)
-      val showTypes: bool ref
-
-      (* SSA Passes *)
-      val ssaPassesSet: (string -> string list Result.t) ref
-      val ssaPasses: string list ref
-      val ssa2PassesSet: (string -> string list Result.t) ref
-      val ssa2Passes: string list ref
-
-      (* Force continuation formals to stack. *)
-      val stackCont: bool ref 
-
-      (* Generate a statically linked executable. *)
-      val static: bool ref
-
-      (* SXML Passes *)
-      val sxmlPassesSet: (string -> string list Result.t) ref
-      val sxmlPasses: string list ref
-
-      datatype target =
-	 Cross of string
-       | Self
-      val target: target ref
-
-      datatype arch = datatype MLton.Platform.Arch.t
-      val targetArch: arch ref
-
-      val setTargetBigEndian: bool -> unit
-      val targetIsBigEndian: unit -> bool
-
-      datatype os = datatype MLton.Platform.OS.t
-      val targetOS: os ref
-
-      (* Type check ILs. *)
-      val typeCheck: bool ref
-
-      datatype typeError = Concise | Full
-      val typeError: typeError ref
-	 
-      (* Should the basis library be prefixed onto the program. *)
-      val useBasisLibrary: bool ref
-
-      datatype verbosity =
-	 Silent
-       | Top
-       | Pass
-       | Detail
-      val verbosity: verbosity ref
-
-      (* version number *)
-      val version: string
-
-      val warnAnn: bool ref
-
-      (* XML Passes *)
-      val xmlPassesSet: (string -> string list Result.t) ref
-      val xmlPasses: string list ref
-
-      val zoneCutDepth: int ref
-
-      (*------------------------------------*)
-      (*             End Flags              *)
-      (*------------------------------------*)
-
       (* Tracing and other informative messages.
        * Some take a verbosity argument that specifies the verbosity level at
        * which messages should be printed. 
@@ -395,44 +40,36 @@
       val errorThreshhold: int ref
       val numErrors: int ref
       val warning: Region.t * Layout.t * Layout.t -> unit
-	 
+         
       (*------------------------------------*)
       (*          Compiler Passes           *)
       (*------------------------------------*)
       datatype style = No | Assembly | C | Dot | ML
 
       datatype 'a display =
-	 NoDisplay
+         NoDisplay
        | Layout of 'a -> Layout.t
        | Layouts of 'a * (Layout.t -> unit) -> unit
 
       val diagnostic: (unit -> Layout.t) -> unit
       val diagnostics: ((Layout.t -> unit) -> unit) -> unit
       val maybeSaveToFile:
-	 {name: string, suffix: string} * style * 'a * 'a display -> unit
+         {name: string, suffix: string} * style * 'a * 'a display -> unit
       val saveToFile:
-	 {suffix: string} * style * 'a * 'a display -> unit
+         {suffix: string} * style * 'a * 'a display -> unit
       val outputHeader: style * (Layout.t -> unit) -> unit
       val outputHeader': style * Out.t -> unit
 
       val pass: {name: string,
-		 suffix: string,
-		 style: style,
-		 thunk: unit -> 'a,
-		 display: 'a display} -> 'a
-	 
+                 suffix: string,
+                 style: style,
+                 thunk: unit -> 'a,
+                 display: 'a display} -> 'a
+         
       val passTypeCheck: {name: string,
-			  suffix: string,
-			  style: style,
-			  thunk: unit -> 'a,
-			  display: 'a display,
-			  typeCheck: 'a -> unit} -> 'a
-	 
-      val passSimplify: {name: string,
-			 suffix: string,
-			 style: style,
-			 thunk: unit -> 'a,
-			 display: 'a display,
-			 simplify: 'a -> 'a,
-			 typeCheck: 'a -> unit} -> 'a
+                          suffix: string,
+                          style: style,
+                          thunk: unit -> 'a,
+                          display: 'a display,
+                          typeCheck: 'a -> unit} -> 'a
    end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/control/control.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/control/control.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/control/control.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,914 +1,60 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 structure Control: CONTROL =
 struct
 
-structure C = Control ()
-open C
+open ControlFlags
 
-structure Align =
-   struct
-      datatype t = Align4 | Align8
-
-      val toString =
-	 fn Align4 => "4"
-	  | Align8 => "8"
-   end
-
-datatype align = datatype Align.t
-
-val align = control {name = "align",
-		     default = Align4,
-		     toString = Align.toString}
-
-val atMLtons = control {name = "atMLtons",
-			default = Vector.new0 (),
-			toString = fn v => Layout.toString (Vector.layout
-							    String.layout v)}
-   
-val basisLibs = ["basis-2002", "basis-1997", "basis-none"]
-   
-val basisLibrary = control {name = "basis library",
-			    default = "basis-2002",
-			    toString = fn s => s}
-
-val cardSizeLog2 = control {name = "log2 (card size)",
-			    default = 8,
-			    toString = Int.toString}
-
-structure Cmm =
-   struct
-      val debug = control {name = "cmm debug",
-			   default = false,
-			   toString = Bool.toString}
-
-      structure NonTail =
-	 struct
-	    datatype t =
-	       CutTo of {neverReturns: bool} | Return
-	    val toString =
-	       fn CutTo {neverReturns} => 
-  	             concat ["cut to {neverReturns = ", 
-			     Bool.toString neverReturns,
-			     "}"]
-	        | Return => "return"
-	 end
-      datatype nonTail = datatype NonTail.t
- 
-      val nonTail = control {name = "cmm non-tail",
-			     default = Return,
-			     toString = NonTail.toString}
-   end
-   
-structure Chunk =
-   struct
-      datatype t =
-	 OneChunk
-       | ChunkPerFunc
-       | Coalesce of {limit: int}
-
-      val toString =
-	 fn OneChunk => "one chunk"
-	  | ChunkPerFunc => "chunk per function"
-	  | Coalesce {limit} => concat ["coalesce ", Int.toString limit]
-   end
-
-datatype chunk = datatype Chunk.t
-   
-val chunk = control {name = "chunk",
-		     default = Coalesce {limit = 4096},
-		     toString = Chunk.toString}
-
-structure Codegen =
-   struct
-      datatype t =
-	 Bytecode
-       | CCodegen
-       | CmmCodegen
-       | Native
-
-      val toString: t -> string =
-	 fn Bytecode => "Bytecode"
-	  | CCodegen => "C"
-	  | CmmCodegen => "C--"
-	  | Native => "Native"
-   end
-
-datatype codegen = datatype Codegen.t
-   
-val codegen = control {name = "codegen",
-		       default = Native,
-		       toString = Codegen.toString}
-
-val contifyIntoMain = control {name = "contifyIntoMain",
-			       default = false,
-			       toString = Bool.toString}
-
-val debug = control {name = "debug",
-		     default = false,
-		     toString = Bool.toString}
-
-val deepFlattenDelay =
-   control {name = "deepFlattenDelay",
-	    default = true,
-	    toString = Bool.toString}
-
-val deepFlattenUnify =
-   control {name = "deepFlattenUnify",
-	    default = false,
-	    toString = Bool.toString}
-
-val defines = control {name = "defines",
-		       default = [],
-		       toString = List.toString String.toString}
-
-val diagPasses = 
-   control {name = "diag passes",
-	    default = [],
-	    toString = List.toString 
-	    (Layout.toString o 
-	     Regexp.Compiled.layout)}
-
-val dropPasses =
-   control {name = "drop passes",
-	    default = [],
-	    toString = List.toString
-	               (Layout.toString o
-			Regexp.Compiled.layout)}
-
-structure Elaborate =
-   struct
-      structure Id =
-	 struct
-	    datatype t = T of {enabled: bool ref,
-			       expert: bool,
-			       name: string}
-	    fun equals (T {enabled = enabled1, ...}, 
-			T {enabled = enabled2, ...}) = 
-	       enabled1 = enabled2
-
-	    val enabled = fn (T {enabled, ...}) => !enabled
-	    val setEnabled = fn (T {enabled, expert, ...}, b) =>
-	       if expert
-		  then false
-		  else (enabled := b; true)
-	    val expert = fn (T {expert, ...}) => expert
-	    val name = fn (T {name, ...}) => name
-	 end
-      structure Args =
-	 struct
-	    datatype t = T of {fillArgs: unit -> (unit -> unit),
-			       processAnn: unit -> (unit -> unit),
-			       processDef: unit -> bool}
-	    local
-	       fun make sel (T r) = sel r
-	    in
-	       fun fillArgs args = (make #fillArgs args) ()
-	       fun processAnn args = (make #processAnn args) ()
-	       fun processDef args = (make #processDef args) ()
-	    end
-	 end
-      datatype ('args, 'st) t = T of {args: 'args option ref,
-				      cur: 'st ref,
-				      def: 'st ref,
-				      id: Id.t}
-      val args = fn (T {args = argsRef, ...}, args) =>
-	 let val emptyArgs = Args.fillArgs args
-	 in (!argsRef) before (emptyArgs ())
-	 end
-      fun current (T {cur, ...}) = !cur
-      fun default (T {def, ...}) = !def
-      fun setDefault (T {def, ...}, def') = def := def'
-      fun id (T {id, ...}) = id
-      fun enabled ctrl = Id.enabled (id ctrl)
-      fun setEnabled (ctrl, b) = Id.setEnabled (id ctrl, b)
-      fun expert ctrl = Id.expert (id ctrl)
-      fun name ctrl = Id.name (id ctrl)
-      fun equalsId (ctrl, id') = Id.equals (id ctrl, id')
-
-      local 
-	 fun make ({default: 'st,
-		    expert: bool,
-		    toString: 'st -> string,
-		    name: string,
-		    newCur: 'st * 'args -> 'st,
-		    newDef: 'st * 'args -> 'st,
-		    parseArgs: string list -> 'args option},
-		   {parseId: string -> Id.t option,
-		    parseIdAndArgs: string -> (Id.t * Args.t) option,
-		    withDef: unit -> (unit -> unit),
-		    snapshot: unit -> unit -> (unit -> unit)}) =
-	    let
-	       val ctrl as T {args = argsRef, cur, def, 
-			      id as Id.T {enabled, ...}, ...} =
-		  T {args = ref NONE,
-		     cur = ref default,
-		     def = control {name = concat ["elaborate ", name,
-						   " (default)"],
-				    default = default,
-				    toString = toString},
-		     id = Id.T {enabled = control {name = concat ["elaborate ", name,
-								  " (enabled)"],
-						   default = true,
-						   toString = Bool.toString},
-				expert = expert,
-				name = name}}
-	       val parseId = fn name' =>
-		  if String.equals (name', name) 
-		     then SOME id 
-		     else parseId name'
-	       val parseIdAndArgs = fn s =>
-		  case String.tokens (s, Char.isSpace) of
-		     name'::args' =>
-			if String.equals (name', name)
-			   then 
-			      case parseArgs args' of
-				 SOME v => 
-				    let
-				       fun fillArgs () =
-					  (argsRef := SOME v
-					   ; fn () => argsRef := NONE)
-				       fun processAnn () =
-					  if !enabled
-					     then let
-						     val old = !cur
-						     val new = newCur (old, v)
-						  in
-						     cur := new
-						     ; fn () => cur := old
-						  end
-					     else fn () => ()
-				       fun processDef () =
-					  if expert
-					     then false
-					     else let
-						     val old = !def
-						     val new = newDef (old, v)
-						  in
-						     def := new
-						     ; true
-						  end
-				       val args =
-					  Args.T {fillArgs = fillArgs,
-						  processAnn = processAnn,
-						  processDef = processDef}
-				    in
-				       SOME (id, args)
-				    end
-			       | NONE => NONE
-			   else parseIdAndArgs s
-		   | _ => NONE
-	       val withDef : unit -> (unit -> unit) =
-		  fn () =>
-		  let
-		     val restore = withDef ()
-		     val old = !cur
-		  in
-		     cur := !def
-		     ; fn () => (cur := old
-				 ; restore ())
-		  end
-	       val snapshot : unit -> unit -> (unit -> unit) =
-		  fn () =>
-		  let 
-		     val withSaved = snapshot ()
-		     val saved = !cur 
-		  in
-		     fn () =>
-		     let
-			val restore = withSaved ()
-			val old = !cur
-		     in
-			cur := saved
-			; fn () => (cur := old
-				    ; restore ())
-		     end
-		  end
-	    in
-	       (ctrl, 
-		{parseId = parseId,
-		 parseIdAndArgs = parseIdAndArgs,
-		 withDef = withDef,
-		 snapshot = snapshot})
-	    end
-
-	 fun makeBool ({default: bool,
-			expert: bool,
-			name: string}, ac) =
-	    make ({default = default,
-		   expert = expert,
-		   toString = Bool.toString,
-		   name = name,
-		   newCur = fn (_,b) => b,
-		   newDef = fn (_,b) => b,
-		   parseArgs = fn args' =>
-		               case args' of
-				  [arg'] => Bool.fromString arg'
-				| _ => NONE}, 
-		  ac)
-      in
-	 val ac =
-	    {parseId = fn _ => NONE,
-	     parseIdAndArgs = fn _ => NONE,
-	     withDef = fn () => (fn () => ()),
-	     snapshot = fn () => fn () => (fn () => ())}
-	 val (allowConstant, ac) =
-	    makeBool ({name = "allowConstant", default = false, expert = true}, ac)
-	 val (allowExport, ac) =
-	    makeBool ({name = "allowExport", default = false, expert = false}, ac)
-	 val (allowImport, ac) =
-	    makeBool ({name = "allowImport", default = false, expert = false}, ac)
-	 val (allowPrim, ac) =
-	    makeBool ({name = "allowPrim", default = false, expert = true}, ac)
-	 val (allowOverload, ac) =
-	    makeBool ({name = "allowOverload", default = false, expert = false}, ac)
-	 val (allowRebindEquals, ac) =
-	    makeBool ({name = "allowRebindEquals", default = false, expert = true}, ac)
-	 val (deadCode, ac) =
-	    makeBool ({name = "deadCode", default = false, expert = false}, ac)
-	 val (forceUsed, ac) =
-	    make ({default = false,
-		   expert = false,
-		   toString = Bool.toString,
-		   name = "forceUsed",
-		   newCur = fn (b,()) => b,
-		   newDef = fn (_,()) => true,
-		   parseArgs = fn args' =>
-		               case args' of
-				  [] => SOME ()
-				| _ => NONE},
-		  ac)
-	 val (ffiStr, ac) =
-	    make ({default = NONE,
-		   expert = true,
-		   toString = Option.toString String.toString,
-		   name = "ffiStr",
-		   newCur = fn (_,s) => SOME s,
-		   newDef = fn _ => NONE,
-		   parseArgs = fn args' =>
-		               case args' of
-				  [s] => SOME s
-				| _ => NONE},
-		  ac)
-	 val (sequenceUnit, ac) =
-	    makeBool ({name = "sequenceUnit", default = false, expert = false}, ac)
-	 val (warnMatch, ac) =
-	    makeBool ({name = "warnMatch", default = true, expert = false}, ac)
-	 val (warnUnused, ac) =
-	    makeBool ({name = "warnUnused", default = false, expert = false}, ac)
-	 val {parseId, parseIdAndArgs, withDef, snapshot} = ac
-      end
-
-      val processDefault = fn s =>
-	 case parseIdAndArgs s of
-	    SOME (_, args) => Args.processDef args
-	  | NONE => false
-      val processEnabled = fn (s, b) =>
-	 case parseId s of
-	    SOME id => Id.setEnabled (id, b)
-	  | NONE => false
-
-      val withDef : (unit -> 'a) -> 'a = fn f =>
-	 let val restore = withDef ()
-	 in DynamicWind.wind (f, restore)
-	 end
-      val snapshot : unit -> (unit -> 'a) -> 'a = fn () =>
-	 let val withSaved = snapshot () in fn f =>
-	 let val restore = withSaved ()
-	 in DynamicWind.wind (f, restore)
-	 end end
-
-   end
-
-val elaborateOnly =
-   control {name = "elaborate only",
-	    default = false,
-	    toString = Bool.toString}
-
-val eliminateOverflow =
-   control {name = "eliminate overflow",
-	    default = true,
-	    toString = Bool.toString}
-
-val exportHeader =
-   control {name = "export header",
-	    default = NONE,
-	    toString = Option.toString File.toString}
-   
-val exnHistory = control {name = "exn history",
-			  default = false,
-			  toString = Bool.toString}
-   
-structure GcCheck =
-   struct
-      datatype t =
-	 Limit
-       | First
-       | Every
-
-      local open Layout
-      in
-	 val layout =
-	    fn Limit => str "Limit"
-	     | First => str "First"
-	     | Every => str "Every"
-      end
-      val toString = Layout.toString o layout
-   end
-
-datatype gcCheck = datatype GcCheck.t
-
-val gcCheck = control {name = "gc check",
-		       default = Limit,
-		       toString = GcCheck.toString}
-
-structure Handlers =
-   struct
-      datatype t = Flow | Simple
-
-      val toString =
-	 fn Flow => "Flow"
-	  | Simple => "Simple"
-   end
-
-datatype handlers = datatype Handlers.t
-
-val handlers = control {name = "handlers",
-			default = Flow,
-			toString = Handlers.toString}
-
-val indentation = control {name = "indentation",
-			   default = 3,
-			   toString = Int.toString}
-
-structure Inline =
-   struct
-      datatype t =
-	 NonRecursive of {product: int,
-			  small: int}
-       | Leaf of {size: int option}
-       | LeafNoLoop of {size: int option}
-
-      local open Layout
-	 val iol = Option.layout Int.layout
-      in
-	 val layout = 
-	    fn NonRecursive {product, small} =>
-	    seq [str "NonRecursive ",
-		record [("product", Int.layout product),
-		       ("small", Int.layout small)]]
-	     | Leaf {size} => seq [str "Leaf ", iol size]
-	     | LeafNoLoop {size} => seq [str "LeafNoLoop ", iol size]
-      end
-      val toString = Layout.toString o layout
-   end
-
-datatype inline = datatype Inline.t
-
-val layoutInline = Inline.layout
-
-val inline = control {name = "inline",
-		      default = NonRecursive {product = 320,
-					      small = 60},
-		      toString = Inline.toString}
-
-fun setInlineSize (size: int): unit =
-   inline := (case !inline of
-		 NonRecursive {small, ...} =>
-		    NonRecursive {product = size, small = small}
-	       | Leaf _ => Leaf {size = SOME size}
-	       | LeafNoLoop _ => LeafNoLoop {size = SOME size})
-
-val inlineIntoMain = control {name = "inlineIntoMain",
-			      default = true,
-			      toString = Bool.toString}
-
-val inputFile = control {name = "input file",
-			 default = "<bogus>",
-			 toString = File.toString}
-
-val instrument = control {name = "instrument",
-			  default = false,
-			  toString = Bool.toString}
-
-val instrumentSxml = control {name = "instrument Sxml",
-			      default = false,
-			      toString = Bool.toString}
-	     
-val keepMachine = control {name = "keep Machine",
-			   default = false,
-			   toString = Bool.toString}
-   
-val keepRSSA = control {name = "keep RSSA",
-			default = false,
-			toString = Bool.toString}
-
-val keepSSA = control {name = "keep SSA",
-		       default = false,
-		       toString = Bool.toString}
-
-val keepSSA2 = control {name = "keep SSA2",
-			default = false,
-			toString = Bool.toString}
-
-val keepDot = control {name = "keep dot",
-		       default = false,
-		       toString = Bool.toString}
-
-val keepPasses = control {name = "keep passes",
-			  default = [],
-			  toString = List.toString 
-			             (Layout.toString o 
-				      Regexp.Compiled.layout)}
-
-val labelsHaveExtra_ = control {name = "extra_",
-				default = false,
-				toString = Bool.toString}
-
-val libDir = control {name = "lib dir",
-		      default = "<libDir unset>",
-		      toString = fn s => s}
-
-val libTargetDir = control {name = "lib target dir",
-			    default = "<libTargetDir unset>",
-			    toString = fn s => s} 
-   
-structure LimitCheck =
-   struct
-      datatype t = 
-	 PerBlock
-       | ExtBasicBlocks
-       | LoopHeaders of {fullCFG: bool,
-			 loopExits: bool}
-
-      val toString =
-	 fn PerBlock => "per block"
-	  | ExtBasicBlocks => "extended basic blocks"
-	  | LoopHeaders {fullCFG, loopExits} =>
-	       concat ["loop headers (fullCFG = ",
-		       Bool.toString fullCFG,
-		       ", loopExits = ",
-		       Bool.toString loopExits,
-		       ")"]
-   end
-
-datatype limitCheck = datatype LimitCheck.t
-
-val limitCheck = control {name = "limit check",
-			  default = LoopHeaders {fullCFG = false,
-						 loopExits = true},
-			  toString = LimitCheck.toString}
-
-val limitCheckCounts = control {name = "limit check counts",
-				default = false,
-				toString = Bool.toString}
-
-val loopPasses = control {name = "loop passes",
-			  default = 1,
-			  toString = Int.toString}
-
-val markCards = control {name = "mark cards",
-			 default = true,
-			 toString = Bool.toString}
-
-val maxFunctionSize = control {name = "max function size",
-			       default = 10000,
-			       toString = Int.toString}
-   
-val mayLoadWorld = control {name = "may load world",
-			    default = true,
-			    toString = Bool.toString}
-
-structure Native =
-   struct
-      val commented = control {name = "native commented",
-			       default = 0,
-			       toString = Int.toString}
-
-      val liveStack = control {name = "native live stack",
-			       default = false,
-			       toString = Bool.toString}
-
-      val optimize = control {name = "native optimize",
-			      default = 1,
-			      toString = Int.toString}
-
-      val moveHoist = control {name = "native move hoist",
-			       default = true,
-			       toString = Bool.toString}
-
-      val copyProp = control {name = "native copy prop",
-			      default = true,
-			      toString = Bool.toString}
-
-      val copyPropCutoff = control {name = "native copy prop cutoff",
-				    default = 1000,
-				    toString = Int.toString}
-
-      val cutoff = control {name = "native cutoff",
-			    default = 100,
-			    toString = Int.toString}
-
-      val liveTransfer = control {name = "native live transfer",
-				  default = 8,
-				  toString = Int.toString}
-
-      val future = control {name = "native future",
-			    default = 64,
-			    toString = Int.toString}
-
-      val shuffle = control {name = "native shuffle",
-			     default = true,
-			     toString = Bool.toString}
-
-      val IEEEFP = control {name = "native ieee fp",
-			    default = false,
-			    toString = Bool.toString}
-
-      val split = control {name = "native split",
-			   default = SOME 20000,
-			   toString = Option.toString Int.toString}
-   end
-
-val newReturn = control {name = "new return",
-			 default = false,
-			 toString = Bool.toString}
-
-val polyvariance =
-   control {name = "polyvariance",
-	    default = SOME {rounds = 2,
-			    small = 30,
-			    product = 300},
-	    toString =
-	    fn p =>
-	    Layout.toString
-	    (Option.layout
-	     (fn {rounds, small, product} =>
-	      Layout.record [("rounds", Int.layout rounds),
-			     ("small", Int.layout small),
-			     ("product", Int.layout product)])
-	     p)}
-
-val profPasses = 
-   control {name = "prof passes",
-	    default = [],
-	    toString = List.toString 
-	    (Layout.toString o 
-	     Regexp.Compiled.layout)}
-
-structure Profile =
-   struct
-      datatype t =
-	 ProfileNone
-       | ProfileAlloc
-       | ProfileCallStack
-       | ProfileCount
-       | ProfileMark
-       | ProfileTime
-
-      val toString =
-	 fn ProfileNone => "None"
-	  | ProfileAlloc => "Alloc"
-	  | ProfileCallStack => "CallStack"
-	  | ProfileCount => "Count"
-	  | ProfileMark => "Mark"
-	  | ProfileTime => "Time"
-   end
-
-datatype profile = datatype Profile.t
-   
-val profile = control {name = "profile",
-		       default = ProfileNone,
-		       toString = Profile.toString}
-
-val profileBasis = control {name = "profile basis",
-			    default = false,
-			    toString = Bool.toString}
-
-val profileBranch = control {name = "profile branch",
-			     default = false,
-			     toString = Bool.toString}
-
-structure ProfileIL =
-   struct
-      datatype t = ProfileSSA | ProfileSSA2 | ProfileSource
-
-      val toString =
-	 fn ProfileSSA => "ProfileSSA"
-	  | ProfileSSA2 => "ProfileSSA2"
-	  | ProfileSource => "ProfileSource"
-   end
-
-datatype profileIL = datatype ProfileIL.t
-   
-val profileIL = control {name = "profile IL",
-			 default = ProfileSource,
-			 toString = ProfileIL.toString}
-
-val profileStack = control {name = "profile stack",
-			    default = false,
-			    toString = Bool.toString}
-
-val reserveEsp = control {name = "reserve esp",
-			  default = NONE,
-			  toString = Option.toString Bool.toString}
-
-val showBasis = control {name = "show basis",
-			 default = NONE,
-			 toString = Option.toString File.toString}
-   
-val showDefUse = control {name = "show def-use",
-			  default = NONE,
-			  toString = Option.toString File.toString}
-
-val showTypes = control {name = "show types",
-			 default = false,
-			 toString = Bool.toString}
-
-val ssaPassesSet : (string -> string list Result.t) ref = 
-   control {name = "ssaPassesSet",
-	    default = fn _ => Error.bug ("ssaPassesSet not installed"),
-	    toString = fn _ => "<ssaPassesSet>"}
-val ssaPasses : string list ref = 
-   control {name = "ssaPasses",
-	    default = ["default"],
-	    toString = List.toString String.toString}
-val ssa2PassesSet : (string -> string list Result.t) ref = 
-   control {name = "ssa2PassesSet",
-	    default = fn _ => Error.bug ("ssa2PassesSet not installed"),
-	    toString = fn _ => "<ssa2PassesSet>"}
-val ssa2Passes : string list ref = 
-   control {name = "ssa2Passes",
-	    default = ["default"],
-	    toString = List.toString String.toString}
-
-val stackCont = control {name = "stack cont",
-			 default = false,
-			 toString = Bool.toString}
-
-val static = control {name = "static",
-		      default = false,
-		      toString = Bool.toString}
-
-val sxmlPassesSet : (string -> string list Result.t) ref = 
-   control {name = "sxmlPassesSet",
-	    default = fn _ => Error.bug ("sxmlPassesSet not installed"),
-	    toString = fn _ => "<sxmlPassesSet>"}
-val sxmlPasses : string list ref = 
-   control {name = "sxmlPasses",
-	    default = ["default"],
-	    toString = List.toString String.toString}
-
-structure Target =
-   struct
-      datatype t =
-	 Cross of string
-       | Self
-
-      val toString =
-	 fn Cross s => s
-	  | Self => "self"
-   end
-
-datatype target = datatype Target.t
-   
-val target = control {name = "target",
-		      default = Self,
-		      toString = Target.toString}
-
-datatype arch = datatype MLton.Platform.Arch.t
-
-val targetArch = control {name = "target arch",
-			  default = X86,
-			  toString = MLton.Platform.Arch.toString}
-
-local
-   val r: bool option ref = ref NONE
-in
-   fun setTargetBigEndian b = r := SOME b
-   fun targetIsBigEndian () =
-      case !r of
-	 NONE => Error.bug "targetIsBigEndian not set"
-       | SOME b => b
-end
-
-datatype os = datatype MLton.Platform.OS.t
-
-val targetOS = control {name = "target OS",
-			default = Linux,
-			toString = MLton.Platform.OS.toString}
-
-val typeCheck = control {name = "type check",
-			 default = false,
-			 toString = Bool.toString}
-
-structure TypeError =
-   struct
-      datatype t = Concise | Full
-
-      val toString =
-	 fn Concise => "concise"
-	  | Full => "full"
-   end
-
-datatype typeError = datatype TypeError.t
-
-val typeError = control {name = "type error",
-			 default = Concise,
-			 toString = TypeError.toString}
-   
-val useBasisLibrary = control {name = "use basis library",
-			       default = true,
-			       toString = Bool.toString}
-
 structure Verbosity =
    struct
-      datatype t =
-	 Silent
-       | Top
-       | Pass
-       | Detail
+      datatype t = datatype verbosity
 
-      val toString =
-	 fn Silent => "Silent"
-	  | Top => "Top"
-	  | Pass => "Pass"
-	  | Detail => "Detail"
-
       val op <= =
-	 fn (Silent, _) => true
-	  | (Top, Silent) => false
-	  | (Top, _) => true
-	  | (Pass, Pass) => true
-	  | (_, Detail) => true
-	  | _ => false
+         fn (Silent, _) => true
+          | (Top, Silent) => false
+          | (Top, _) => true
+          | (Pass, Pass) => true
+          | (_, Detail) => true
+          | _ => false
    end
-
-datatype verbosity = datatype Verbosity.t
    
-val verbosity = control {name = "verbosity",
-			 default = Silent,
-			 toString = Verbosity.toString}
-
-val version = "MLton MLTONVERSION"
-
-val warnAnn = control {name = "warn unrecognized annotation",
-		       default = true,
-		       toString = Bool.toString}
-
-val xmlPassesSet: (string -> string list Result.t) ref = 
-   control {name = "xmlPassesSet",
-	    default = fn _ => Error.bug ("xmlPassesSet not installed"),
-	    toString = fn _ => "<xmlPassesSet>"}
-val xmlPasses: string list ref = 
-   control {name = "xmlPasses",
-	    default = ["default"],
-	    toString = List.toString String.toString}
-
-val zoneCutDepth: int ref =
-   control {name = "zone cut depth",
-	    default = 100,
-	    toString = Int.toString}
-   
 datatype style = No | Assembly | C | Dot | ML
 
 fun preSuf style =
    let
       val (p, s) =
-	 case style of
-	    No => ("", "")
-	  | Assembly => ("/* ", " */")
-	  | C => ("/* ", " */")
-	  | Dot => ("// ", "")
-	  | ML => ("(* ", " *)")
+         case style of
+            No => ("", "")
+          | Assembly => ("/* ", " */")
+          | C => ("/* ", " */")
+          | Dot => ("// ", "")
+          | ML => ("(* ", " *)")
    in (p, s)
    end
 
-val build = concat ["(built ", Date.toString (Date.now ()),
-		    " on ", Process.hostName (), ")"]
-
 fun outputHeader (style: style, output: Layout.t -> unit) =
    let
       val (pre, suf) = preSuf style
       val lines =
-	 concat [version, " ", build]
-	 :: concat ["  created this file on ", Date.toString (Date.now ()), "."]
-	 :: "Do not edit this file."
-	 :: "Flag settings: "
-	 :: (List.map (all (), fn {name, value} =>
-		       concat ["   ", name, ": ", value]))
+         concat [version, " ", build]
+         :: concat ["  created this file on ", Date.toString (Date.now ()), "."]
+         :: "Do not edit this file."
+         :: "Flag settings: "
+         :: (List.map (all (), fn {name, value} =>
+                       concat ["   ", name, ": ", value]))
    in List.foreach (lines, fn l => output (Layout.str (concat [pre, l, suf])))
    end
 
 fun outputHeader' (style, out: Out.t) =
    outputHeader (style, fn l =>
-		 (Layout.output (l, out);
-		  Out.newline out))
+                 (Layout.output (l, out);
+                  Out.newline out))
 
 val depth: int ref = ref 0
 fun getDepth () = !depth
@@ -918,18 +64,14 @@
 fun message (verb: Verbosity.t, th: unit -> Layout.t): unit =
    if Verbosity.<= (verb, !verbosity)
       then let val out = Out.error
-	   in Layout.output (Layout.indent (th (), !depth), out)
-	      ; Out.newline out
-	   end
+           in Layout.output (Layout.indent (th (), !depth), out)
+              ; Out.newline out
+           end
    else ()
       
 fun messageStr (verb, s: string): unit =
    message (verb, fn () => Layout.str s)
 
-val defaults = setDefaults
-
-val _ = defaults ()
-
 fun time () =
    let
       open Time
@@ -944,41 +86,48 @@
       fun fmt (x, n) = Real.format (x, Real.Format.fix (SOME n))
       val toReal = Real.fromIntInf o Time.toMilliseconds
       val per =
-	 if Time.equals (total, Time.zero)
-	    then "0"
-	 else fmt (100.0 * (toReal gc / toReal total), 0)
+         if Time.equals (total, Time.zero)
+            then "0"
+         else fmt (100.0 * (toReal gc / toReal total), 0)
       fun t2s t =
-	 fmt (Real./ (toReal t, 1000.0), 2)
+         fmt (Real./ (toReal t, 1000.0), 2)
    in concat [t2s (Time.- (total, gc)), " + ", t2s gc, " (", per, "% GC)"]
    end
 
 fun trace (verb, name: string) (f: 'a -> 'b) (a: 'a): 'b =
    if Verbosity.<= (verb, !verbosity)
       then
-	 let
-	    val _ = messageStr (verb, concat [name, " starting"])
-	    val (t, gc) = time ()
-	    val _ = indent ()
-	    fun done () =
-	       let
-		  val _ = unindent ()
-		  val (t', gc') = time ()
-	       in
-		  timeToString {total = Time.- (t', t),
-				gc = Time.- (gc', gc)}
-	       end
-	 in (f a
-	     before messageStr (verb, concat [name, " finished in ", done ()]))
-	    handle e =>
-	       (messageStr (verb, concat [name, " raised in ", done ()])
-		; raise e)
-	 end
+         let
+            val _ = messageStr (verb, concat [name, " starting"])
+            val (t, gc) = time ()
+            val _ = indent ()
+            fun done () =
+               let
+                  val _ = unindent ()
+                  val (t', gc') = time ()
+               in
+                  timeToString {total = Time.- (t', t),
+                                gc = Time.- (gc', gc)}
+               end
+         in (f a
+             before messageStr (verb, concat [name, " finished in ", done ()]))
+            handle e =>
+               (messageStr (verb, concat [name, " raised in ", done ()])
+                ; (case Exn.history e of
+                      [] => ()
+                    | history =>
+                         (messageStr (verb, concat [name, " raised with history: "])
+                          ; (List.foreach
+                             (history, fn s =>
+                              messageStr (verb, concat ["\t", s])))))
+                ; raise e)
+         end
    else
       f a
 
 type traceAccum = {verb: verbosity, 
-		   total: Time.t ref, 
-		   totalGC: Time.t ref}
+                   total: Time.t ref, 
+                   totalGC: Time.t ref}
 
 val traceAccum: (verbosity * string) -> (traceAccum * (unit -> unit)) =
    fn (verb, name) =>
@@ -988,11 +137,11 @@
    in
      ({verb = verb, total = total, totalGC = totalGC},
       fn () => messageStr (verb,
-			   concat [name, 
-				   " totals ",
-				   timeToString
-				   {total = !total,
-				    gc = !totalGC}]))
+                           concat [name, 
+                                   " totals ",
+                                   timeToString
+                                   {total = !total,
+                                    gc = !totalGC}]))
    end
 
 val ('a, 'b) traceAdd: (traceAccum * string) -> ('a -> 'b) -> 'a -> 'b =
@@ -1001,21 +150,28 @@
    fn a =>
    if Verbosity.<= (verb, !verbosity)
      then let
-	    val (t, gc) = time ()
-	    fun done () 
-	      = let
-		  val (t', gc') = time ()
-		in
-		  total := Time.+ (!total, Time.- (t', t))
-		  ; totalGC := Time.+ (!totalGC, Time.- (gc', gc))
-		end
-	  in
-	    (f a
-	     before done ())
-	    handle e => (messageStr (verb,
-				     concat [name, " raised"])
-			 ; raise e)
-	  end
+            val (t, gc) = time ()
+            fun done () 
+              = let
+                  val (t', gc') = time ()
+                in
+                  total := Time.+ (!total, Time.- (t', t))
+                  ; totalGC := Time.+ (!totalGC, Time.- (gc', gc))
+                end
+          in
+            (f a
+             before done ())
+            handle e => 
+               (messageStr (verb, concat [name, " raised"])
+                ; (case Exn.history e of
+                      [] => ()
+                    | history =>
+                         (messageStr (verb, concat [name, " raised with history: "])
+                          ; (List.foreach
+                             (history, fn s =>
+                              messageStr (verb, concat ["\t", s])))))
+                ; raise e)
+          end
      else f a
 
 val ('a, 'b) traceBatch: (verbosity * string) -> ('a -> 'b) ->
@@ -1041,34 +197,34 @@
 local
    fun msg (kind: string, r: Region.t, msg: Layout.t, extra: Layout.t): unit =
       let
-	 open Layout
-	 val p =
-	    case Region.left r of
-	       NONE => "<bogus>"
-	     | SOME p => SourcePos.toString p
-	 val msg = Layout.toString msg
-	 val msg =
-	    Layout.str
-	    (concat [String.fromChar (Char.toUpper (String.sub (msg, 0))),
-		     String.dropPrefix (msg, 1),
-		     "."])
-	 in
-	    outputl (align [seq [str (concat [kind, ": "]), str p, str "."],
-			    indent (align [msg,
-					   indent (extra, 2)],
-				    2)],
-		     Out.error)
+         open Layout
+         val p =
+            case Region.left r of
+               NONE => "<bogus>"
+             | SOME p => SourcePos.toString p
+         val msg = Layout.toString msg
+         val msg =
+            Layout.str
+            (concat [String.fromChar (Char.toUpper (String.sub (msg, 0))),
+                     String.dropPrefix (msg, 1),
+                     "."])
+         in
+            outputl (align [seq [str (concat [kind, ": "]), str p, str "."],
+                            indent (align [msg,
+                                           indent (extra, 2)],
+                                    2)],
+                     Out.error)
       end
 in
    fun warning (r, m, e) = msg ("Warning", r, m, e)
    fun error (r, m, e) =
       let
-	 val _ = Int.inc numErrors
-	 val _ = msg ("Error", r, m, e)
+         val _ = Int.inc numErrors
+         val _ = msg ("Error", r, m, e)
       in
-	 if !numErrors = !errorThreshhold
-	    then die "compilation aborted: too many errors"
-	 else ()
+         if !numErrors = !errorThreshhold
+            then die "compilation aborted: too many errors"
+         else ()
       end
 end
 
@@ -1082,12 +238,12 @@
 fun checkFile (f: File.t, error: string -> 'a, k: unit -> 'a): 'a =
    let
       fun check (test, msg, k) =
-	 if not (test f)
-	    then error (concat ["File ", f, " ", msg])
-	 else k ()
+         if not (test f)
+            then error (concat ["File ", f, " ", msg])
+         else k ()
    in
       check (File.doesExist, "does not exist", fn () =>
-	     check (File.canRead, "cannot be read", k))
+             check (File.canRead, "cannot be read", k))
    end
 
 (*---------------------------------------------------*)
@@ -1102,7 +258,7 @@
 fun 'a sizeMessage (name: string, a: 'a): Layout.t =
    let open Layout
    in str (concat [name, " size is ",
-		   Int.toCommaString (MLton.size a), " bytes"])
+                   Int.toCommaString (MLton.size a), " bytes"])
    end
 
 val diagnosticWriter: (Layout.t -> unit) option ref = ref NONE
@@ -1115,68 +271,68 @@
 fun diagnostic f = diagnostics (fn disp => disp (f ()))
 
 fun saveToFile ({suffix: string},
-		style,
-		a: 'a,
-		d: 'a display): unit =
+                style,
+                a: 'a,
+                d: 'a display): unit =
    let
       fun doit f =
-	 trace (Pass, "display")
-	 Ref.fluidLet
-	 (inputFile, concat [!inputFile, ".", suffix], fn () =>
-	  File.withOut (!inputFile, fn out =>
-			f (fn l => (Layout.outputl (l, out)))))
+         trace (Pass, "display")
+         Ref.fluidLet
+         (inputFile, concat [!inputFile, ".", suffix], fn () =>
+          File.withOut (!inputFile, fn out =>
+                        f (fn l => (Layout.outputl (l, out)))))
    in
       case d of
-	 NoDisplay => ()
+         NoDisplay => ()
        | Layout layout =>
-	    doit (fn output =>
-		  (outputHeader (style, output)
-		   ; output (layout a)))
+            doit (fn output =>
+                  (outputHeader (style, output)
+                   ; output (layout a)))
        | Layouts layout =>
-	    doit (fn output =>
-		  (outputHeader (style, output)
-		   ; layout (a, output)))
+            doit (fn output =>
+                  (outputHeader (style, output)
+                   ; layout (a, output)))
    end
 
 fun maybeSaveToFile ({name: string, suffix: string},
-		     style: style,
-		     a: 'a,
-		     d: 'a display): unit =
+                     style: style,
+                     a: 'a,
+                     d: 'a display): unit =
    if not (List.exists (!keepPasses, fn re =>
-			Regexp.Compiled.matchesAll (re, name)))
+                        Regexp.Compiled.matchesAll (re, name)))
       then ()
    else saveToFile ({suffix = concat [name, ".", suffix]}, style, a, d)
 
 fun pass {name: string,
-	  suffix: string,
-	  style: style,
-	  display = disp,
-	  thunk: unit -> 'a}: 'a =
+          suffix: string,
+          style: style,
+          display = disp,
+          thunk: unit -> 'a}: 'a =
    let
       val result = 
-	 if not (List.exists (!diagPasses, fn re =>
-			      Regexp.Compiled.matchesAll (re, name)))
-	    then trace (Pass, name) thunk ()
-	 else
-	    let
-	       val result = ref NONE
-	       val _ =
-		  saveToFile
-		  ({suffix = concat [name, ".diagnostic"]}, No, (),
-		   Layouts (fn ((), disp) =>
-			    (diagnosticWriter := SOME disp
-			     ; result := SOME (trace (Pass, name) thunk ())
-			     ; diagnosticWriter := NONE)))
-	    in
-	       valOf (!result)
-	    end
+         if not (List.exists (!diagPasses, fn re =>
+                              Regexp.Compiled.matchesAll (re, name)))
+            then trace (Pass, name) thunk ()
+         else
+            let
+               val result = ref NONE
+               val _ =
+                  saveToFile
+                  ({suffix = concat [name, ".diagnostic"]}, No, (),
+                   Layouts (fn ((), disp) =>
+                            (diagnosticWriter := SOME disp
+                             ; result := SOME (trace (Pass, name) thunk ())
+                             ; diagnosticWriter := NONE)))
+            in
+               valOf (!result)
+            end
       val verb = Detail
       val _ = message (verb, fn () => sizeMessage (suffix, result))
       val _ = message (verb, PropertyList.stats)
       val _ = message (verb, HashSet.stats)
       val _ = checkForErrors name
       val _ = maybeSaveToFile ({name = name, suffix = suffix},
-			       style, result, disp)
+                               style, result, disp)
    in
       result
    end
@@ -1186,54 +342,37 @@
    fn z as {name, ...} =>
    if MLton.Profile.isOn
       then if not (List.exists (!profPasses, fn re =>
-				Regexp.Compiled.matchesAll (re, name)))
-	      then pass z
-	   else let
-		   open MLton.Profile
-		   val d = Data.malloc ()
-		   val result = withData (d, fn () => pass z)
-		   val _ = Data.write (d, concat [!inputFile, ".", name, ".mlmon"])
-		   val _ = Data.free d
-		in
-		   result
-		end
+                                Regexp.Compiled.matchesAll (re, name)))
+              then pass z
+           else let
+                   open MLton.Profile
+                   val d = Data.malloc ()
+                   val result = withData (d, fn () => pass z)
+                   val _ = Data.write (d, concat [!inputFile, ".", name, ".mlmon"])
+                   val _ = Data.free d
+                in
+                   result
+                end
    else pass z
 
 fun passTypeCheck {name: string,
-		   suffix: string,
-		   style: style,
-		   display,
-		   thunk: unit -> 'a,
-		   typeCheck = tc: 'a -> unit}: 'a =
+                   suffix: string,
+                   style: style,
+                   display,
+                   thunk: unit -> 'a,
+                   typeCheck = tc: 'a -> unit}: 'a =
    let
       val result = pass {name = name,
-			 suffix = suffix,
-			 display = display,
-			 style = style,
-			 thunk = thunk}
+                         suffix = suffix,
+                         display = display,
+                         style = style,
+                         thunk = thunk}
       val _ =
-	 if !typeCheck
-	    then trace (Pass, "typeCheck") tc result
-	 else ()
+         if !typeCheck
+            then trace (Pass, "typeCheck") tc result
+         else ()
    in
       result
    end
 
-fun passSimplify {name, suffix, style, thunk, display, typeCheck, simplify} =
-   let
-      val result =
-	 passTypeCheck {name = name,
-			suffix = suffix,
-			style = style,
-			thunk = thunk,
-			display = display,
-			typeCheck = typeCheck}
-   in passTypeCheck {name = name ^ "Simplify",
-		     suffix = suffix,
-		     style = style,
-		     thunk = fn () => simplify result,
-		     display = display,
-		     typeCheck = typeCheck}
-   end
-
 end

Deleted: mlton/branches/on-20050420-cmm-branch/mlton/control/layout.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/control/layout.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/control/layout.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +0,0 @@
-structure Code =
-   struct
-      fun nest (prefix, x, y) =
-   align [seq [str prefix, x],
-	      seq [str "in ", y],
-	      str "end"]
-
-fun layoutLet (d, e) = nest ("let ", d, e)
-fun layoutLocal (d, d') = nest ("local ", d, d')
-

Modified: mlton/branches/on-20050420-cmm-branch/mlton/control/pretty.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/control/pretty.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/control/pretty.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,10 @@
+(* Copyright (C) 2003-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 signature PRETTY =
    sig
       type t = Layout.t
@@ -3,21 +10,19 @@
 
       val casee: {default: t option,
-		  rules: (t * t) vector,
-		  test: t} -> t
+                  rules: (t * t) vector,
+                  test: t} -> t
       val conApp: {arg: t option,
-		   con: Layout.t,
-		   targs: Layout.t vector} -> t
+                   con: Layout.t,
+                   targs: Layout.t vector} -> t
       val handlee: {catch: t,
-		    handler: t,
-		    try: t} -> t
+                    handler: t,
+                    try: t} -> t
       val lett: t * t -> t
       val locall: t * t -> t
       val longid: t list * t -> t
       val primApp: {args: t vector,
-		    prim: t,
-		    targs: t vector} -> t
+                    prim: t,
+                    targs: t vector} -> t
       val raisee: t -> t
       val seq: t vector -> t
-      val var: {targs: t vector,
-		var: t} -> t
    end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/control/pretty.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/control/pretty.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/control/pretty.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,10 @@
+(* Copyright (C) 2003-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 structure Pretty: PRETTY =
 struct
 
@@ -2,30 +9,30 @@
 open Layout
-	 
+         
 fun casee {default, rules, test} =
    let
       val rules =
-	 case default of
-	    NONE => rules
-	  | SOME l => Vector.concat [rules, Vector.new1 (str "_", l)]
+         case default of
+            NONE => rules
+          | SOME l => Vector.concat [rules, Vector.new1 (str "_", l)]
    in
       align [seq [str "case ", test, str " of"],
-	     indent (alignPrefix (Vector.toListMap
-				  (rules, fn (lhs, rhs) =>
-				   mayAlign [seq [lhs, str " =>"], rhs]),
-				  "| "),
-		     2)]
+             indent (alignPrefix (Vector.toListMap
+                                  (rules, fn (lhs, rhs) =>
+                                   mayAlign [seq [lhs, str " =>"], rhs]),
+                                  "| "),
+                     2)]
    end
 
 fun conApp {arg, con, targs} =
    seq [con,
-	if !Control.showTypes
-	   then tuple (Vector.toList targs)
-	else empty,
-	case arg of
-	   NONE => empty
-	 | SOME x => seq [str " ", x]]
+        if !Control.showTypes
+           then tuple (Vector.toList targs)
+        else empty,
+        case arg of
+           NONE => empty
+         | SOME x => seq [str " ", x]]
 
 fun handlee {catch, handler, try} =
    align [try,
-	  seq [str "handle ", catch, str " => ", handler]]
+          seq [str "handle ", catch, str " => ", handler]]
 
@@ -35,30 +42,25 @@
    
 fun nest (prefix, x, y) =
    align [seq [str prefix, x],
-	  str "in",
-	  indent (y, 3),
-	  str "end"]
+          str "in",
+          indent (y, 3),
+          str "end"]
 
 fun lett (d, e) = nest ("let ", d, e)
-	 
+         
 fun locall (d, d') = nest ("local ", d, d')
 
 fun primApp {args, prim, targs} =
    seq [prim,
-	if !Control.showTypes
-	   andalso 0 < Vector.length targs
-	   then list (Vector.toList targs)
-	else empty,
-	str " ",
-	tuple (Vector.toList args)]
+        if !Control.showTypes
+           andalso 0 < Vector.length targs
+           then list (Vector.toList targs)
+        else empty,
+        str " ",
+        tuple (Vector.toList args)]
 
 fun raisee exn = seq [str "raise ", exn]
 
-fun var {targs, var} =
-   if !Control.showTypes
-      then seq [var, tuple (Vector.toList targs)]
-   else var
-      
 fun seq es = mayAlign (separateLeft (Vector.toList es, ";"))
 
 end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/control/region.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/control/region.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/control/region.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature REGION_STRUCTS = 
    sig
    end
@@ -23,23 +24,22 @@
       val extendRight: t * SourcePos.t -> t
       val left: t -> SourcePos.t option
       val layout: t -> Layout.t
-      val list: 'a list * ('a -> t) -> t
       val make: {left: SourcePos.t, right: SourcePos.t} -> t
       val right: t -> SourcePos.t option
       val toString: t -> string
 
       structure Wrap:
-	 sig
-	    type region
-	    type 'a t
-	    val region: 'a t -> region
-	    val node: 'a t -> 'a
-	    val makeRegion: 'a * region -> 'a t
-	    val makeRegion':  'a * SourcePos.t * SourcePos.t -> 'a t
-(*	    val make: 'a -> 'a t *)
-	    val dest: 'a t -> 'a * region
-(*	    val left: 'a t -> int *)
-(*	    val right: 'a t -> int *)
-	 end
+         sig
+            type region
+            type 'a t
+            val region: 'a t -> region
+            val node: 'a t -> 'a
+            val makeRegion: 'a * region -> 'a t
+            val makeRegion':  'a * SourcePos.t * SourcePos.t -> 'a t
+(*          val make: 'a -> 'a t *)
+            val dest: 'a t -> 'a * region
+(*          val left: 'a t -> int *)
+(*          val right: 'a t -> int *)
+         end
       sharing type Wrap.region = t
    end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/control/region.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/control/region.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/control/region.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,24 +1,25 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 structure Region: REGION =
 struct
 
 datatype t =
    Bogus
  | T of {left: SourcePos.t,
-	 right: SourcePos.t}
+         right: SourcePos.t}
 
 val bogus = Bogus
 
 local
    fun make f r =
       case r of
-	 Bogus => NONE
+         Bogus => NONE
        | T r => SOME (f r)
 in
    val left = make #left
@@ -32,8 +33,8 @@
 val toString =
    fn Bogus => "Bogus"
     | T {left, right} =>
-	 concat [SourcePos.file left, ":",
-		 SourcePos.posToString left, "-", SourcePos.posToString right]
+         concat [SourcePos.file left, ":",
+                 SourcePos.posToString left, "-", SourcePos.posToString right]
 
 val layout = Layout.str o toString
 
@@ -44,18 +45,16 @@
     | (r, Bogus) => r
     | (T {left, ...}, T {right, ...}) => T {left = left, right = right}
 
-fun list (xs, reg) = List.fold (xs, Bogus, fn (x, r) => append (reg x, r))
-
 fun compare (r, r') =
    case (left r, left r') of
       (NONE, NONE) => EQUAL
     | (NONE, _) => LESS
     | (_, NONE) => GREATER
     | (SOME p, SOME p') => SourcePos.compare (p, p')
-	 
+         
 val compare =
    Trace.trace2 ("Region.compare", layout, layout, Relation.layout) compare
-	 
+         
 fun equals (r, r') = compare (r, r') = EQUAL
    
 fun r <= r' =
@@ -68,14 +67,14 @@
    struct
       type region = t
       datatype 'a t = T of {node: 'a,
-			    region: region}
+                            region: region}
 
       fun node (T {node, ...}) = node
       fun region (T {region, ...}) = region
       fun makeRegion (node, region) = T {node = node, region = region}
       fun makeRegion' (node, left, right) = T {node = node,
-					       region = make {left = left,
-							      right = right}}
+                                               region = make {left = left,
+                                                              right = right}}
 
       fun dest (T {node, region}) = (node, region)
    end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/control/source-pos.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/control/source-pos.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/control/source-pos.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 type int = Int.t
    
 signature SOURCE_POS_STRUCTS = 
@@ -18,27 +19,13 @@
       type t
 
       val bogus: t
-      val column: t -> int
       val compare: t * t -> Relation.t
       val equals: t * t -> bool
       val file: t -> File.t
-      val isBasis: t -> bool
       val line: t -> int
       val make: {column: int,
-		 file: File.t,
-		 line: int} -> t
+                 file: File.t,
+                 line: int} -> t
       val posToString: t -> string
       val toString: t -> string
    end
-
-
-functor TestSourcePos (S: SOURCE_POS): sig end = 
-struct
-
-val _ = print "TestSourcePos\n"
-
-open S
-
-val _ = Assert.assert ("SourcePos", fn () => true)
-
-end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/control/source-pos.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/control/source-pos.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/control/source-pos.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,57 +1,63 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 structure SourcePos: SOURCE_POS =
 struct
 
 datatype t = T of {column: int,
-		   file: File.t,
-		   line: int}
+                   file: File.t,
+                   line: int}
 
 local
    fun f g (T r) = g r
 in
-   val column = f #column
    val line = f #line
 end
 
 fun compare (T {column = c, file = f, line = l},
-	     T {column = c', file = f', line = l'}) =
+             T {column = c', file = f', line = l'}) =
    case String.compare (f, f') of
       EQUAL =>
-	 (case Int.compare (l, l') of
-	     EQUAL => Int.compare (c, c')
-	   | r => r)
+         (case Int.compare (l, l') of
+             EQUAL => Int.compare (c, c')
+           | r => r)
     | r => r
 
 fun equals (T r, T r') = r = r'
+val _ = equals
 
 fun make {column, file, line} =
    T {column = column,
       file = file,
       line = line}
 
-val basisString = "/basis/"
+fun getLib (T {file, ...}) =
+   let 
+      val libDir = concat [!ControlFlags.libDir, "/sml"]
+   in 
+      if String.hasPrefix (file, {prefix = libDir})
+         then SOME (String.size libDir)
+         else NONE
+   end
 
-fun getBasis (T {file, ...}) =
-   String.findSubstring (file, {substring = basisString})
-
-fun isBasis p = isSome (getBasis p)
-
 fun file (p as T {file, ...}) =
-   case getBasis p of
+   case getLib p of
       NONE => file
     | SOME i =>
-	 concat ["<basis>/",
-		 String.dropPrefix (file, i + String.size basisString)]
+         String.substituteFirst
+         (String.substituteFirst
+          (String.dropPrefix (file, i), 
+           {substring = "/", replacement = "<"}),
+          {substring = "/", replacement = ">/"})
 
 val bogus = T {column = ~1,
-	       file = "<bogus>",
-	       line = ~1}
+               file = "<bogus>",
+               line = ~1}
 
 fun toString (p as T {column, line, ...}) =
    concat [file p, " ", Int.toString line, ".", Int.toString column]

Modified: mlton/branches/on-20050420-cmm-branch/mlton/control/source.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/control/source.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/control/source.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 type int = Int.t
    
 signature SOURCE =
@@ -15,7 +16,7 @@
        *)
       val getPos: t * int -> SourcePos.t
       val lineDirective:
-	 t * File.t option * {lineNum: int, lineStart: int} -> unit
+         t * File.t option * {lineNum: int, lineStart: int} -> unit
       val lineStart: t -> SourcePos.t
       val new: File.t -> t
       val newline: t * int -> unit

Modified: mlton/branches/on-20050420-cmm-branch/mlton/control/source.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/control/source.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/control/source.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,34 +1,40 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 structure Source: SOURCE =
 struct
   
 datatype t = T of {file: File.t ref,
-		   lineNum: int ref,
-		   lineStart: int ref}
+                   lineNum: int ref,
+                   lineStart: int ref}
 
 fun getPos (T {file, lineNum, lineStart, ...}, n) =
    SourcePos.make {column = n - !lineStart,
-		   file = !file,
-		   line = !lineNum}
-		
+                   file = !file,
+                   line = !lineNum}
+                
 fun lineStart (s as T {lineStart, ...}) = getPos (s, !lineStart)
 
 fun lineDirective (T {file, lineNum, lineStart},
-		   f,
-		   {lineNum = n, lineStart = s}) =
+                   f,
+                   {lineNum = n, lineStart = s}) =
    (Option.app (f, fn f => file := f)
     ; lineNum := n
     ; lineStart := s)
-		      
+                      
 fun new file = T {file = ref file,
-		  lineNum = ref 1,
-		  lineStart = ref 1}
+                  lineNum = ref 1,
+                  (* mllex file positions start at zero, while we report errors
+                   * starting in column 1, so we need to pretend the first line
+                   * starts at position ~1, which will translate position 0 to
+                   * column 1.
+                   *)
+                  lineStart = ref ~1}
 
 fun newline (T {lineStart, lineNum, ...}, n) =
    (Int.inc lineNum

Modified: mlton/branches/on-20050420-cmm-branch/mlton/control/sources.cm
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/control/sources.cm	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/control/sources.cm	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 Group
 
 signature REGION
@@ -23,6 +24,8 @@
 
 ../../lib/mlton/sources.cm
 
+control-flags.sig
+control-flags.sml
 bits.sml
 source-pos.sig
 source-pos.sml

Modified: mlton/branches/on-20050420-cmm-branch/mlton/control/sources.mlb
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/control/sources.mlb	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/control/sources.mlb	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,36 +1,37 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 local
-    ../../lib/mlton/sources.mlb
+   ../../lib/mlton/sources.mlb
 
-    bits.sml
-    source-pos.sig
-    source-pos.sml
-    region.sig
-    region.sml
-    source.sig
-    source.sml
-    control.sig
-    control.sml
-    system.sig
-    system.sml
-    pretty.sig
-    pretty.sml
+   bits.sml
+   control-flags.sig
+   control-flags.sml
+   source-pos.sig
+   source-pos.sml
+   region.sig
+   region.sml
+   source.sig
+   source.sml
+   control.sig
+   control.sml
+   system.sig
+   system.sml
+   pretty.sig
+   pretty.sml
 in
-    signature REGION
-
-    structure Bits
-    structure Bytes
-    structure Control
-    structure Pretty
-    structure Region
-    structure Source
-    structure SourcePos
-    structure System
-    structure Words
+   structure Bits
+   structure Bytes
+   structure Control
+   structure Pretty
+   structure Region
+   structure Source
+   structure SourcePos
+   structure System
+   structure Words
 end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/control/system.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/control/system.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/control/system.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 type int = Int.t
    
 signature SYSTEM =

Modified: mlton/branches/on-20050420-cmm-branch/mlton/control/system.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/control/system.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/control/system.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,68 +1,69 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 structure System: SYSTEM =
    struct
       fun insertBackslashes (ss: string list,
-			     width: int,
-			     indent: int): string list =
-	 let
-	    val indentation = String.make (indent, #" ")
-	    fun loop (ss, pos, line, lines) =
-	       (* pos + 2 < width (so the backslash can be inserted) *)
-	       case ss of
-		  [] => rev (concat (rev line) :: lines)
-		| s :: ss =>
-		     let
-			val n = String.size s
-			val (pos, line') =
-			   case line of
-			      [] => (pos + n, [s])
-			    | _ => (pos + n + 1, s :: " " :: line)
-			fun newLine () =
-			   loop (ss, indent + n, [s, indentation],
-				 concat (rev (" \\" :: line)) :: lines)
-		     in
-			if pos <= width
-			   then
-			      case ss of
-				 [] => rev (concat (rev line') :: lines)
-			       | _ => 
-				    if pos + 2 <= width
-				       then loop (ss, pos, line', lines)
-				    else newLine ()
-			else newLine ()
-		     end
-	 in loop (ss, 0, [], [])
-	 end
+                             width: int,
+                             indent: int): string list =
+         let
+            val indentation = String.make (indent, #" ")
+            fun loop (ss, pos, line, lines) =
+               (* pos + 2 < width (so the backslash can be inserted) *)
+               case ss of
+                  [] => rev (concat (rev line) :: lines)
+                | s :: ss =>
+                     let
+                        val n = String.size s
+                        val (pos, line') =
+                           case line of
+                              [] => (pos + n, [s])
+                            | _ => (pos + n + 1, s :: " " :: line)
+                        fun newLine () =
+                           loop (ss, indent + n, [s, indentation],
+                                 concat (rev (" \\" :: line)) :: lines)
+                     in
+                        if pos <= width
+                           then
+                              case ss of
+                                 [] => rev (concat (rev line') :: lines)
+                               | _ => 
+                                    if pos + 2 <= width
+                                       then loop (ss, pos, line', lines)
+                                    else newLine ()
+                        else newLine ()
+                     end
+         in loop (ss, 0, [], [])
+         end
 
       fun system (com: string, args: string list): unit =
-	 let
-	    (* Many terminal emulators do the line folding one character early,
-	     * so we use 79 instead of 80 columns.
-	     *)
-	    val width = 79
-	    val indentAmount = 4
-	    val s = concat (List.separate (com :: args, " "))
-	    val _ =
-	       let
-		  open Control
-	       in
-		  message (Top, fn () =>
-			   Layout.align
-			   (List.map (insertBackslashes
-				      (com :: args,
-				       width - getDepth (),
-				       indentAmount),
-				      Layout.str)))
-	       end
-	 in
-	    Process.wait (MLton.Process.spawnp {file = com, args = com :: args})
-	    handle e => Error.bug (concat ["call to system failed with ",
-					   Exn.toString e, ":\n", s])
-	 end
+         let
+            (* Many terminal emulators do the line folding one character early,
+             * so we use 79 instead of 80 columns.
+             *)
+            val width = 79
+            val indentAmount = 4
+            val s = concat (List.separate (com :: args, " "))
+            val _ =
+               let
+                  open Control
+               in
+                  message (Top, fn () =>
+                           Layout.align
+                           (List.map (insertBackslashes
+                                      (com :: args,
+                                       width - getDepth (),
+                                       indentAmount),
+                                      Layout.str)))
+               end
+         in
+            Process.wait (MLton.Process.spawnp {file = com, args = com :: args})
+            handle e => Error.bug (concat ["call to system failed with ",
+                                           Exn.toString e, ":\n", s])
+         end
    end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/core-ml/core-ml.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/core-ml/core-ml.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/core-ml/core-ml.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,9 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 functor CoreML (S: CORE_ML_STRUCTS): CORE_ML = 
@@ -18,18 +18,18 @@
       open Layout
    in
       if !Control.showTypes
-	 then seq [x, str ": ", Type.layout t]
+         then seq [x, str ": ", Type.layout t]
       else x
    end
 
 structure Pat =
    struct
       datatype t = T of {node: node,
-			 ty: Type.t}
+                         ty: Type.t}
       and node =
-	 Con of {arg: t option,
-		 con: Con.t,
-		 targs: Type.t vector}
+         Con of {arg: t option,
+                 con: Con.t,
+                 targs: Type.t vector}
        | Const of unit -> Const.t
        | Layered of Var.t * t
        | List of t vector
@@ -39,92 +39,92 @@
        | Wild
 
       local
-	 fun make f (T r) = f r
+         fun make f (T r) = f r
       in
-	 val dest = make (fn {node, ty} => (node, ty))
-	 val node = make #node
-	 val ty = make #ty
+         val dest = make (fn {node, ty} => (node, ty))
+         val node = make #node
+         val ty = make #ty
       end
 
       fun make (n, t) = T {node = n, ty = t}
 
       fun layout p =
-	 let
-	    val t = ty p
-	    open Layout
-	 in
-	    case node p of
-	       Con {arg, con, targs} =>
-		  seq [Con.layout con,
-		       if !Control.showTypes andalso 0 < Vector.length targs
-			  then tuple (Vector.toListMap (targs, Type.layout))
-		       else empty,
-		       case arg of
-			  NONE => empty
-			| SOME p => seq [str " ", layout p]]
-	     | Const f => Const.layout (f ())
-	     | Layered (x, p) =>
-		  seq [maybeConstrain (Var.layout x, t), str " as ", layout p]
-	     | List ps => list (Vector.toListMap (ps, layout))
-	     | Record r =>
-		  record (Vector.toListMap
-			  (Record.toVector r, fn (f, p) =>
-			   (Field.toString f, layout p)))
-	     | Tuple ps => tuple (Vector.toListMap (ps, layout))
-	     | Var x => maybeConstrain (Var.layout x, t)
-	     | Wild => str "_"
-	 end
+         let
+            val t = ty p
+            open Layout
+         in
+            case node p of
+               Con {arg, con, targs} =>
+                  seq [Con.layout con,
+                       if !Control.showTypes andalso 0 < Vector.length targs
+                          then tuple (Vector.toListMap (targs, Type.layout))
+                       else empty,
+                       case arg of
+                          NONE => empty
+                        | SOME p => seq [str " ", layout p]]
+             | Const f => Const.layout (f ())
+             | Layered (x, p) =>
+                  seq [maybeConstrain (Var.layout x, t), str " as ", layout p]
+             | List ps => list (Vector.toListMap (ps, layout))
+             | Record r =>
+                  record (Vector.toListMap
+                          (Record.toVector r, fn (f, p) =>
+                           (Field.toString f, layout p)))
+             | Tuple ps => tuple (Vector.toListMap (ps, layout))
+             | Var x => maybeConstrain (Var.layout x, t)
+             | Wild => str "_"
+         end
 
       fun wild t = make (Wild, t)
 
       fun var (x, t) = make (Var x, t)
 
       fun tuple ps = make (Tuple ps, Type.tuple (Vector.map (ps, ty)))
-	 
+         
       local
-	 fun bool c = make (Con {arg = NONE, con = c, targs = Vector.new0 ()},
-			    Type.bool)
+         fun bool c = make (Con {arg = NONE, con = c, targs = Vector.new0 ()},
+                            Type.bool)
       in
-	 val falsee: t = bool Con.falsee
-	 val truee: t = bool Con.truee
+         val falsee: t = bool Con.falsee
+         val truee: t = bool Con.truee
       end
 
       fun isUnit (p: t): bool =
-	 case node p of
-	    Tuple v => 0 = Vector.length v
-	  | _ => false
-	       
+         case node p of
+            Tuple v => 0 = Vector.length v
+          | _ => false
+               
       fun isWild (p: t): bool =
-	 case node p of
-	    Wild => true
-	  | _ => false
-	 
+         case node p of
+            Wild => true
+          | _ => false
+         
       fun isRefutable (p: t): bool =
-	 case node p of
-	    Con _ => true
-	  | Const _ => true
-	  | Layered (_, p) => isRefutable p
-	  | List _ => true
-	  | Record r => Record.exists (r, isRefutable)
-	  | Tuple ps => Vector.exists (ps, isRefutable)
-	  | Var _ => false
-	  | Wild => false
+         case node p of
+            Con _ => true
+          | Const _ => true
+          | Layered (_, p) => isRefutable p
+          | List _ => true
+          | Record r => Record.exists (r, isRefutable)
+          | Tuple ps => Vector.exists (ps, isRefutable)
+          | Var _ => false
+          | Wild => false
 
       fun foreachVar (p: t, f: Var.t -> unit): unit =
-	 let
-	    fun loop (p: t): unit =
-	       case node p of
-		  Con _ => ()
-		| Const _ => ()
-		| Layered (x, p) => (f x; loop p)
-		| List ps => Vector.foreach (ps, loop)
-		| Record r => Record.foreach (r, loop)
-		| Tuple ps => Vector.foreach (ps, loop)
-		| Var x => f x
-		| Wild => ()
-	 in
-	    loop p
-	 end
+         let
+            fun loop (p: t): unit =
+               case node p of
+                  Con _ => ()
+                | Const _ => ()
+                | Layered (x, p) => (f x; loop p)
+                | List ps => Vector.foreach (ps, loop)
+                | Record r => Record.foreach (r, loop)
+                | Tuple ps => Vector.foreach (ps, loop)
+                | Var x => f x
+                | Wild => ()
+         in
+            loop p
+         end
    end
 
 structure NoMatch =
@@ -136,142 +136,147 @@
 
 datatype dec =
    Datatype of {cons: {arg: Type.t option,
-		       con: Con.t} vector,
-		tycon: Tycon.t,
-		tyvars: Tyvar.t vector} vector
+                       con: Con.t} vector,
+                tycon: Tycon.t,
+                tyvars: Tyvar.t vector} vector
  | Exception of {arg: Type.t option,
-		 con: Con.t}
+                 con: Con.t}
  | Fun of {decs: {lambda: lambda,
-		  var: Var.t} vector,
-	   tyvars: unit -> Tyvar.t vector}
- | Val of {rvbs: {lambda: lambda,
-		  var: Var.t} vector,
-	   tyvars: unit -> Tyvar.t vector,
-	   vbs: {exp: exp,
-		 lay: unit -> Layout.t,
-		 pat: Pat.t,
-		 patRegion: Region.t} vector,
-	   warnMatch: bool}
+                  var: Var.t} vector,
+           tyvars: unit -> Tyvar.t vector}
+ | Val of {nonexhaustiveExnMatch: Control.Elaborate.DiagDI.t,
+           nonexhaustiveMatch: Control.Elaborate.DiagEIW.t,
+           rvbs: {lambda: lambda,
+                  var: Var.t} vector,
+           tyvars: unit -> Tyvar.t vector,
+           vbs: {exp: exp,
+                 lay: unit -> Layout.t,
+                 pat: Pat.t,
+                 patRegion: Region.t} vector}
 and exp = Exp of {node: expNode,
-		  ty: Type.t}
+                  ty: Type.t}
 and expNode =
    App of exp * exp
   | Case of {kind: string,
-	     lay: unit -> Layout.t,
-	     noMatch: noMatch,
-	     region: Region.t,
-	     rules: {exp: exp,
-		     lay: (unit -> Layout.t) option,
-		     pat: Pat.t} vector,
-	     test: exp,
-	     warnMatch: bool}
+             lay: unit -> Layout.t,
+             noMatch: noMatch,
+             nonexhaustiveExnMatch: Control.Elaborate.DiagDI.t,
+             nonexhaustiveMatch: Control.Elaborate.DiagEIW.t,
+             redundantMatch: Control.Elaborate.DiagEIW.t,
+             region: Region.t,
+             rules: {exp: exp,
+                     lay: (unit -> Layout.t) option,
+                     pat: Pat.t} vector,
+             test: exp}
   | Con of Con.t * Type.t vector
   | Const of unit -> Const.t
   | EnterLeave of exp * SourceInfo.t
   | Handle of {catch: Var.t * Type.t,
-	       handler: exp,
-	       try: exp}
+               handler: exp,
+               try: exp}
   | Lambda of lambda
   | Let of dec vector * exp
   | List of exp vector
   | PrimApp of {args: exp vector,
-		prim: Type.t Prim.t,
-		targs: Type.t vector}
+                prim: Type.t Prim.t,
+                targs: Type.t vector}
   | Raise of exp
   | Record of exp Record.t
   | Seq of exp vector
   | Var of (unit -> Var.t) * (unit -> Type.t vector)
 and lambda = Lam of {arg: Var.t,
-		     argType: Type.t,
-		     body: exp,
-		     mayInline: bool}
+                     argType: Type.t,
+                     body: exp,
+                     mayInline: bool}
 
 local
    open Layout
 in
    fun layoutTyvars ts =
       case Vector.length ts of
-	 0 => empty
+         0 => empty
        | 1 => seq [str " ", Tyvar.layout (Vector.sub (ts, 0))]
        | _ => seq [str " ", tuple (Vector.toListMap (ts, Tyvar.layout))]
-	 
+         
    fun layoutConArg {arg, con} =
       seq [Con.layout con,
-	   case arg of
-	      NONE => empty
-	    | SOME t => seq [str " of ", Type.layout t]]
+           case arg of
+              NONE => empty
+            | SOME t => seq [str " of ", Type.layout t]]
 
    fun layoutDec d =
       case d of
-	 Datatype v =>
-	    seq [str "datatype",
-		 align
-		 (Vector.toListMap
-		  (v, fn {cons, tycon, tyvars} =>
-		   seq [layoutTyvars tyvars,
-			str " ", Tycon.layout tycon, str " = ",
-			align
-			(separateLeft (Vector.toListMap (cons, layoutConArg),
-				       "| "))]))]
+         Datatype v =>
+            seq [str "datatype",
+                 align
+                 (Vector.toListMap
+                  (v, fn {cons, tycon, tyvars} =>
+                   seq [layoutTyvars tyvars,
+                        str " ", Tycon.layout tycon, str " = ",
+                        align
+                        (separateLeft (Vector.toListMap (cons, layoutConArg),
+                                       "| "))]))]
        | Exception ca =>
-	    seq [str "exception ", layoutConArg ca]
+            seq [str "exception ", layoutConArg ca]
        | Fun {decs, tyvars, ...} => layoutFuns (tyvars, decs)
        | Val {rvbs, tyvars, vbs, ...} =>
-	    align [layoutFuns (tyvars, rvbs),
-		   align (Vector.toListMap
-			  (vbs, fn {exp, pat, ...} =>
-			   seq [str "val",
-				mayAlign [seq [layoutTyvars (tyvars ()),
-					       str " ", Pat.layout pat,
-					       str " ="],
-					  layoutExp exp]]))]
+            align [layoutFuns (tyvars, rvbs),
+                   align (Vector.toListMap
+                          (vbs, fn {exp, pat, ...} =>
+                           seq [str "val",
+                                mayAlign [seq [layoutTyvars (tyvars ()),
+                                               str " ", Pat.layout pat,
+                                               str " ="],
+                                          layoutExp exp]]))]
    and layoutExp (Exp {node, ...}) =
       case node of
-	 App (e1, e2) => paren (seq [layoutExp e1, str " ", layoutExp e2])
+         App (e1, e2) => paren (seq [layoutExp e1, str " ", layoutExp e2])
        | Case {rules, test, ...} =>
-	    Pretty.casee {default = NONE,
-			  rules = Vector.map (rules, fn {exp, pat, ...} =>
-					      (Pat.layout pat, layoutExp exp)),
-			  test = layoutExp test}
+            Pretty.casee {default = NONE,
+                          rules = Vector.map (rules, fn {exp, pat, ...} =>
+                                              (Pat.layout pat, layoutExp exp)),
+                          test = layoutExp test}
        | Con (c, _) => Con.layout c
        | Const f => Const.layout (f ())
-       | EnterLeave (e, _) => layoutExp e
+       | EnterLeave (e, si) =>
+            seq [str "EnterLeave ",
+                 tuple [layoutExp e, SourceInfo.layout si]]
        | Handle {catch, handler, try} =>
-	    Pretty.handlee {catch = Var.layout (#1 catch),
-			    handler = layoutExp handler,
-			    try = layoutExp try}
+            Pretty.handlee {catch = Var.layout (#1 catch),
+                            handler = layoutExp handler,
+                            try = layoutExp try}
        | Lambda l => layoutLambda l
        | Let (ds, e) =>
-	    Pretty.lett (align (Vector.toListMap (ds, layoutDec)),
-			 layoutExp e)
+            Pretty.lett (align (Vector.toListMap (ds, layoutDec)),
+                         layoutExp e)
        | List es => list (Vector.toListMap (es, layoutExp))
        | PrimApp {args, prim, targs} =>
-	    Pretty.primApp {args = Vector.map (args, layoutExp),
-			    prim = Prim.layout prim,
-			    targs = Vector.map (targs, Type.layout)}
+            Pretty.primApp {args = Vector.map (args, layoutExp),
+                            prim = Prim.layout prim,
+                            targs = Vector.map (targs, Type.layout)}
        | Raise e => Pretty.raisee (layoutExp e)
        | Record r =>
-	    Record.layout
-	    {extra = "",
-	     layoutElt = layoutExp,
-	     layoutTuple = fn es => tuple (Vector.toListMap (es, layoutExp)),
-	     record = r,
-	     separator = " = "}
+            Record.layout
+            {extra = "",
+             layoutElt = layoutExp,
+             layoutTuple = fn es => tuple (Vector.toListMap (es, layoutExp)),
+             record = r,
+             separator = " = "}
        | Seq es => Pretty.seq (Vector.map (es, layoutExp))
        | Var (x, _) => Var.layout (x ())
    and layoutFuns (tyvars, decs)  =
       if 0 = Vector.length decs
-	 then empty
+         then empty
       else
-	 align [seq [str "val rec", layoutTyvars (tyvars ())],
-		indent (align (Vector.toListMap
-			       (decs, fn {lambda, var} =>
-				align [seq [Var.layout var, str " = "],
-				       indent (layoutLambda lambda, 3)])),
-			3)]
+         align [seq [str "val rec", layoutTyvars (tyvars ())],
+                indent (align (Vector.toListMap
+                               (decs, fn {lambda, var} =>
+                                align [seq [Var.layout var, str " = "],
+                                       indent (layoutLambda lambda, 3)])),
+                        3)]
    and layoutLambda (Lam {arg, body, ...}) =
       paren (align [seq [str "fn ", Var.layout arg, str " =>"],
-		    layoutExp body])
+                    layoutExp body])
 end
 
 structure Lambda =
@@ -285,10 +290,10 @@
       fun dest (Lam r) = r
 
       val bogus = make {arg = Var.newNoname (),
-			argType = Type.unit,
-			body = Exp {node = Seq (Vector.new0 ()),
-				    ty = Type.unit},
-			mayInline = true}
+                        argType = Type.unit,
+                        body = Exp {node = Seq (Vector.new0 ()),
+                                    ty = Type.unit},
+                        mayInline = true}
    end
 
 structure Exp =
@@ -299,141 +304,143 @@
       datatype node = datatype expNode
 
       datatype noMatch = datatype noMatch
-	    
+            
       val layout = layoutExp
 
       local
-	 fun make f (Exp r) = f r
+         fun make f (Exp r) = f r
       in
-	 val dest = make (fn {node, ty} => (node, ty))
-	 val node = make #node
-	 val ty = make #ty
+         val dest = make (fn {node, ty} => (node, ty))
+         val node = make #node
+         val ty = make #ty
       end
-	    
+            
       fun make (n, t) = Exp {node = n,
-			     ty = t}
+                             ty = t}
 
       fun var (x: Var.t, ty: Type.t): t =
-	 make (Var (fn () => x, fn () => Vector.new0 ()), ty)
-	 
+         make (Var (fn () => x, fn () => Vector.new0 ()), ty)
+         
       fun isExpansive (e: t): bool =
-	 case node e of
-	    App (e1, e2) =>
-	       (case node e1 of
-		   Con (c, _) => Con.equals (c, Con.reff) orelse isExpansive e2
-		 | _ => true)
-	  | Case _ => true
-	  | Con _ => false
-	  | Const _ => false
-	  | EnterLeave _ => true
-	  | Handle _ => true
-	  | Lambda _ => false
-	  | Let _ => true
-	  | List es => Vector.exists (es, isExpansive)
-	  | PrimApp _ => true
-	  | Raise _ => true
-	  | Record r => Record.exists (r, isExpansive)
-	  | Seq _ => true
-	  | Var _ => false
+         case node e of
+            App (e1, e2) =>
+               (case node e1 of
+                   Con (c, _) => Con.equals (c, Con.reff) orelse isExpansive e2
+                 | _ => true)
+          | Case _ => true
+          | Con _ => false
+          | Const _ => false
+          | EnterLeave _ => true
+          | Handle _ => true
+          | Lambda _ => false
+          | Let _ => true
+          | List es => Vector.exists (es, isExpansive)
+          | PrimApp _ => true
+          | Raise _ => true
+          | Record r => Record.exists (r, isExpansive)
+          | Seq _ => true
+          | Var _ => false
 
       fun tuple es =
-	 if 1 = Vector.length es
-	    then Vector.sub (es, 0)
-	 else make (Record (Record.tuple es),
-		    Type.tuple (Vector.map (es, ty)))
+         if 1 = Vector.length es
+            then Vector.sub (es, 0)
+         else make (Record (Record.tuple es),
+                    Type.tuple (Vector.map (es, ty)))
 
       val unit = tuple (Vector.new0 ())
 
       local
-	 fun bool c = make (Con (c, Vector.new0 ()), Type.bool)
+         fun bool c = make (Con (c, Vector.new0 ()), Type.bool)
       in
-	 val falsee: t = bool Con.falsee
-	 val truee: t = bool Con.truee
+         val falsee: t = bool Con.falsee
+         val truee: t = bool Con.truee
       end
 
       fun lambda (l as Lam {argType, body, ...}) =
-	 make (Lambda l, Type.arrow (argType, ty body))
+         make (Lambda l, Type.arrow (argType, ty body))
 
       fun casee (z as {rules, ...}) =
-	 if 0 = Vector.length rules
-	    then Error.bug "CoreML.casee"
-	 else make (Case z, ty (#exp (Vector.sub (rules, 0))))
+         if 0 = Vector.length rules
+            then Error.bug "CoreML.Exp.casee"
+         else make (Case z, ty (#exp (Vector.sub (rules, 0))))
 
       fun iff (test, thenCase, elseCase): t =
-	 casee {kind = "if",
-		lay = fn () => Layout.empty,
-		noMatch = Impossible,
-		region = Region.bogus,
-		rules = Vector.new2 ({exp = thenCase,
-				      lay = NONE,
-				      pat = Pat.truee},
-				     {exp = elseCase,
-				      lay = NONE,
-				      pat = Pat.falsee}),
-		test = test,
-		warnMatch = false}
+         casee {kind = "if",
+                lay = fn () => Layout.empty,
+                noMatch = Impossible,
+                nonexhaustiveExnMatch = Control.Elaborate.DiagDI.Default,
+                nonexhaustiveMatch = Control.Elaborate.DiagEIW.Ignore,
+                redundantMatch = Control.Elaborate.DiagEIW.Ignore,
+                region = Region.bogus,
+                rules = Vector.new2 ({exp = thenCase,
+                                      lay = NONE,
+                                      pat = Pat.truee},
+                                     {exp = elseCase,
+                                      lay = NONE,
+                                      pat = Pat.falsee}),
+                test = test}
 
       fun andAlso (e1, e2) = iff (e1, e2, falsee)
-	 
+         
       fun orElse (e1, e2) = iff (e1, truee, e2)
 
       fun whilee {expr, test} =
-	 let
-	    val loop = Var.newNoname ()
-	    val loopTy = Type.arrow (Type.unit, Type.unit)
-	    val call = make (App (var (loop, loopTy), unit), Type.unit)
-	    val lambda =
-	       Lambda.make
-	       {arg = Var.newNoname (),
-		argType = Type.unit,
-		body = iff (test,
-			    make (Seq (Vector.new2 (expr, call)),
-				  Type.unit),
-			    unit),
-		mayInline = true}
-	 in
-	    make
-	    (Let (Vector.new1 (Fun {decs = Vector.new1 {lambda = lambda,
-							var = loop},
-				    tyvars = fn () => Vector.new0 ()}),
-		  call),
-	     Type.unit)
-	 end
+         let
+            val loop = Var.newNoname ()
+            val loopTy = Type.arrow (Type.unit, Type.unit)
+            val call = make (App (var (loop, loopTy), unit), Type.unit)
+            val lambda =
+               Lambda.make
+               {arg = Var.newNoname (),
+                argType = Type.unit,
+                body = iff (test,
+                            make (Seq (Vector.new2 (expr, call)),
+                                  Type.unit),
+                            unit),
+                mayInline = true}
+         in
+            make
+            (Let (Vector.new1 (Fun {decs = Vector.new1 {lambda = lambda,
+                                                        var = loop},
+                                    tyvars = fn () => Vector.new0 ()}),
+                  call),
+             Type.unit)
+         end
 
       fun foreachVar (e: t, f: Var.t -> unit): unit =
-	 let
-	    fun loop (e: t): unit =
-	       case node e of
-		  App (e1, e2) => (loop e1; loop e2)
-		| Case {rules, test, ...} =>
-		     (loop test
-		      ; Vector.foreach (rules, loop o #exp))
-		| Con _ => ()
-		| Const _ => ()
-		| EnterLeave (e, _) => loop e
-		| Handle {handler, try, ...} => (loop handler; loop try)
-		| Lambda l => loopLambda l
-		| Let (ds, e) =>
-		     (Vector.foreach (ds, loopDec)
-		      ; loop e)
-		| List es => Vector.foreach (es, loop)
-		| PrimApp {args, ...} => Vector.foreach (args, loop)
-		| Raise e => loop e
-		| Record r => Record.foreach (r, loop)
-		| Seq es => Vector.foreach (es, loop)
-		| Var (x, _) => f (x ())
-	    and loopDec d =
-	       case d of
-		  Datatype _ => ()
-		| Exception _ => ()
-		| Fun {decs, ...} => Vector.foreach (decs, loopLambda o #lambda)
-		| Val {rvbs, vbs, ...} =>
-		     (Vector.foreach (rvbs, loopLambda o #lambda)
-		      ; Vector.foreach (vbs, loop o #exp))
-	    and loopLambda (Lam {body, ...}) = loop body
-	 in
-	    loop e
-	 end
+         let
+            fun loop (e: t): unit =
+               case node e of
+                  App (e1, e2) => (loop e1; loop e2)
+                | Case {rules, test, ...} =>
+                     (loop test
+                      ; Vector.foreach (rules, loop o #exp))
+                | Con _ => ()
+                | Const _ => ()
+                | EnterLeave (e, _) => loop e
+                | Handle {handler, try, ...} => (loop handler; loop try)
+                | Lambda l => loopLambda l
+                | Let (ds, e) =>
+                     (Vector.foreach (ds, loopDec)
+                      ; loop e)
+                | List es => Vector.foreach (es, loop)
+                | PrimApp {args, ...} => Vector.foreach (args, loop)
+                | Raise e => loop e
+                | Record r => Record.foreach (r, loop)
+                | Seq es => Vector.foreach (es, loop)
+                | Var (x, _) => f (x ())
+            and loopDec d =
+               case d of
+                  Datatype _ => ()
+                | Exception _ => ()
+                | Fun {decs, ...} => Vector.foreach (decs, loopLambda o #lambda)
+                | Val {rvbs, vbs, ...} =>
+                     (Vector.foreach (rvbs, loopLambda o #lambda)
+                      ; Vector.foreach (vbs, loop o #exp))
+            and loopLambda (Lam {body, ...}) = loop body
+         in
+            loop e
+         end
    end
 
 structure Dec =
@@ -448,42 +455,42 @@
       datatype t = T of {decs: Dec.t vector}
 
       fun layout (T {decs, ...}) =
-	 Layout.align (Vector.toListMap (decs, Dec.layout))
+         Layout.align (Vector.toListMap (decs, Dec.layout))
 
 (*       fun typeCheck (T {decs, ...}) =
- * 	 let
- * 	    fun checkExp (e: Exp.t): Ty.t =
- * 	       let
- * 		  val (n, t) = Exp.dest e
- * 		  val 
- * 		  datatype z = datatype Exp.t
- * 		  val t' =
- * 		     case n of
- * 			App (e1, e2) =>
- * 			   let
- * 			      val t1 = checkExp e1
- * 			      val t2 = checkExp e2
- * 			   in
- * 			      case Type.deArrowOpt t1 of
- * 				 NONE => error "application of non-function"
- * 			       | SOME (u1, u2) =>
- * 				    if Type.equals (u1, t2)
- * 				       then t2
- * 				    else error "function/argument mismatch"
- * 			   end
- * 		      | Case {rules, test} =>
- * 			   let
- * 			      val {pat, exp} = Vector.sub (rules, 0)
- * 			   in
- * 			      Vector.foreach (rules, fn {pat, exp} =>
- * 					      Type.equals
- * 					      (checkPat pat, 
- * 			   end
- * 	       in
- * 				     
- * 	       end
- * 	 in
- * 	 end
+ *       let
+ *          fun checkExp (e: Exp.t): Ty.t =
+ *             let
+ *                val (n, t) = Exp.dest e
+ *                val 
+ *                datatype z = datatype Exp.t
+ *                val t' =
+ *                   case n of
+ *                      App (e1, e2) =>
+ *                         let
+ *                            val t1 = checkExp e1
+ *                            val t2 = checkExp e2
+ *                         in
+ *                            case Type.deArrowOpt t1 of
+ *                               NONE => error "application of non-function"
+ *                             | SOME (u1, u2) =>
+ *                                  if Type.equals (u1, t2)
+ *                                     then t2
+ *                                  else error "function/argument mismatch"
+ *                         end
+ *                    | Case {rules, test} =>
+ *                         let
+ *                            val {pat, exp} = Vector.sub (rules, 0)
+ *                         in
+ *                            Vector.foreach (rules, fn {pat, exp} =>
+ *                                            Type.equals
+ *                                            (checkPat pat, 
+ *                         end
+ *             in
+ *                                   
+ *             end
+ *       in
+ *       end
  *)
    end
 

Modified: mlton/branches/on-20050420-cmm-branch/mlton/core-ml/core-ml.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/core-ml/core-ml.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/core-ml/core-ml.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,31 +1,31 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 signature CORE_ML_STRUCTS = 
    sig
       include ATOMS
       structure Type:
-	 sig
-	    type t
+         sig
+            type t
 
-	    val arrow: t * t -> t
-	    val bool: t
-	    val deConOpt: t -> (Tycon.t * t vector) option
-	    val deRecord: t -> (Record.Field.t * t) vector
-	    val isCharX: t -> bool
-	    val isInt: t -> bool
-	    val layout: t -> Layout.t
-	    val makeHom: {con: Tycon.t * 'a vector -> 'a,
-			  var: Tyvar.t -> 'a} -> {destroy: unit -> unit,
-						  hom: t -> 'a}
-	    val tuple: t vector -> t
-	    val unit: t
-	 end
+            val arrow: t * t -> t
+            val bool: t
+            val deConOpt: t -> (Tycon.t * t vector) option
+            val deRecord: t -> (Record.Field.t * t) vector
+            val isCharX: t -> bool
+            val isInt: t -> bool
+            val layout: t -> Layout.t
+            val makeHom: {con: Tycon.t * 'a vector -> 'a,
+                          var: Tyvar.t -> 'a} -> {destroy: unit -> unit,
+                                                  hom: t -> 'a}
+            val tuple: t vector -> t
+            val unit: t
+         end
    end
 
 signature CORE_ML = 
@@ -33,146 +33,151 @@
       include CORE_ML_STRUCTS
 
       structure Pat:
-	 sig
-	    type t
-	    datatype node =
-	       Con of {arg: t option,
-		       con: Con.t,
-		       targs: Type.t vector}
-	     | Const of unit -> Const.t
-	     | Layered of Var.t * t
-	     | List of t vector
-	     | Record of t Record.t
-	     | Tuple of t vector
-	     | Var of Var.t
-	     | Wild
+         sig
+            type t
+            datatype node =
+               Con of {arg: t option,
+                       con: Con.t,
+                       targs: Type.t vector}
+             | Const of unit -> Const.t
+             | Layered of Var.t * t
+             | List of t vector
+             | Record of t Record.t
+             | Tuple of t vector
+             | Var of Var.t
+             | Wild
 
-	    val dest: t -> node * Type.t
-	    val falsee: t
-	    val foreachVar: t * (Var.t -> unit) -> unit
-	    (* true if pattern contains a constant, constructor or variable *)
-	    val isRefutable: t -> bool
-	    val isUnit: t -> bool
-	    val isWild: t -> bool
-	    val layout: t -> Layout.t
-	    val make: node * Type.t -> t
-	    val node: t -> node
-	    val var: Var.t * Type.t -> t
-	    val truee: t
-	    val tuple: t vector -> t
-	    val ty: t -> Type.t
-	    val wild: Type.t -> t
-	 end
+            val dest: t -> node * Type.t
+            val falsee: t
+            val foreachVar: t * (Var.t -> unit) -> unit
+            (* true if pattern contains a constant, constructor or variable *)
+            val isRefutable: t -> bool
+            val isUnit: t -> bool
+            val isWild: t -> bool
+            val layout: t -> Layout.t
+            val make: node * Type.t -> t
+            val node: t -> node
+            val var: Var.t * Type.t -> t
+            val truee: t
+            val tuple: t vector -> t
+            val ty: t -> Type.t
+            val wild: Type.t -> t
+         end
 
       structure Exp:
-	 sig
-	    type dec
-	    type lambda
-	    type t
-	    datatype noMatch = Impossible | RaiseAgain | RaiseBind | RaiseMatch
-	    datatype node =
-	       App of t * t
-	     | Case of {kind: string,
-			lay: unit -> Layout.t,
-			noMatch: noMatch,
-			region: Region.t,
-			rules: {exp: t,
-				lay: (unit -> Layout.t) option,
-				pat: Pat.t} vector,
-			test: t,
-			warnMatch: bool}
-	     | Con of Con.t * Type.t vector
-	     | Const of unit -> Const.t
-	     | EnterLeave of t * SourceInfo.t
-	     | Handle of {catch: Var.t * Type.t,
-			  handler: t,
-			  try: t}
-	     | Lambda of lambda
-	     | Let of dec vector * t
-	     | List of t vector
-	     | PrimApp of {args: t vector,
-			   prim: Type.t Prim.t,
-			   targs: Type.t vector}
-	     | Raise of t
-	     | Record of t Record.t
-	     | Seq of t vector
-	     | Var of (unit -> Var.t) * (unit -> Type.t vector)
+         sig
+            type dec
+            type lambda
+            type t
+            datatype noMatch = Impossible | RaiseAgain | RaiseBind | RaiseMatch
+            datatype node =
+               App of t * t
+             | Case of {kind: string,
+                        lay: unit -> Layout.t,
+                        noMatch: noMatch,
+                        nonexhaustiveExnMatch: Control.Elaborate.DiagDI.t,
+                        nonexhaustiveMatch: Control.Elaborate.DiagEIW.t,
+                        redundantMatch: Control.Elaborate.DiagEIW.t,
+                        region: Region.t,
+                        rules: {exp: t,
+                                lay: (unit -> Layout.t) option,
+                                pat: Pat.t} vector,
+                        test: t}
+             | Con of Con.t * Type.t vector
+             | Const of unit -> Const.t
+             | EnterLeave of t * SourceInfo.t
+             | Handle of {catch: Var.t * Type.t,
+                          handler: t,
+                          try: t}
+             | Lambda of lambda
+             | Let of dec vector * t
+             | List of t vector
+             | PrimApp of {args: t vector,
+                           prim: Type.t Prim.t,
+                           targs: Type.t vector}
+             | Raise of t
+             | Record of t Record.t
+             | Seq of t vector
+             | Var of (unit -> Var.t) * (unit -> Type.t vector)
 
-	    val andAlso: t * t -> t
-	    val casee: {kind: string,
-			lay: unit -> Layout.t,
-			noMatch: noMatch,
-			region: Region.t,
-			rules: {exp: t,
-				lay: (unit -> Layout.t) option,
-				pat: Pat.t} vector,
-			test: t,
-			warnMatch: bool} -> t
-	    val dest: t -> node * Type.t
-	    val iff: t * t * t -> t
-	    val falsee: t
-	    val foreachVar: t * (Var.t -> unit) -> unit
-	    (* true if the expression may side-effect. See p 19 of Definition *)
-	    val isExpansive: t -> bool
-	    val lambda: lambda -> t
-	    val layout: t -> Layout.t
-	    val make: node * Type.t -> t
-	    val node: t -> node
-	    val orElse: t * t -> t
-	    val truee: t
-	    val tuple: t vector -> t
-	    val ty: t -> Type.t
-	    val unit: t
-	    val var: Var.t * Type.t -> t
-	    val whilee: {expr: t, test: t} -> t
-	 end
+            val andAlso: t * t -> t
+            val casee: {kind: string,
+                        lay: unit -> Layout.t,
+                        noMatch: noMatch,
+                        nonexhaustiveExnMatch: Control.Elaborate.DiagDI.t,
+                        nonexhaustiveMatch: Control.Elaborate.DiagEIW.t,
+                        redundantMatch: Control.Elaborate.DiagEIW.t,
+                        region: Region.t,
+                        rules: {exp: t,
+                                lay: (unit -> Layout.t) option,
+                                pat: Pat.t} vector,
+                        test: t} -> t
+            val dest: t -> node * Type.t
+            val iff: t * t * t -> t
+            val falsee: t
+            val foreachVar: t * (Var.t -> unit) -> unit
+            (* true if the expression may side-effect. See p 19 of Definition *)
+            val isExpansive: t -> bool
+            val lambda: lambda -> t
+            val layout: t -> Layout.t
+            val make: node * Type.t -> t
+            val node: t -> node
+            val orElse: t * t -> t
+            val truee: t
+            val tuple: t vector -> t
+            val ty: t -> Type.t
+            val unit: t
+            val var: Var.t * Type.t -> t
+            val whilee: {expr: t, test: t} -> t
+         end
 
       structure Lambda:
-	 sig
-	    type t
+         sig
+            type t
 
-	    val bogus: t
-	    val dest: t -> {arg: Var.t,
-			    argType: Type.t,
-			    body: Exp.t,
-			    mayInline: bool}
-	    val layout: t -> Layout.t
-	    val make: {arg: Var.t,
-		       argType: Type.t,
-		       body: Exp.t,
-		       mayInline: bool} -> t
-	 end
+            val bogus: t
+            val dest: t -> {arg: Var.t,
+                            argType: Type.t,
+                            body: Exp.t,
+                            mayInline: bool}
+            val layout: t -> Layout.t
+            val make: {arg: Var.t,
+                       argType: Type.t,
+                       body: Exp.t,
+                       mayInline: bool} -> t
+         end
       sharing type Exp.lambda = Lambda.t
 
       structure Dec:
-	 sig
-	    datatype t =
-	       Datatype of {cons: {arg: Type.t option,
-				   con: Con.t} vector,
-			    tycon: Tycon.t,
-			    tyvars: Tyvar.t vector} vector
-	     | Exception of {arg: Type.t option,
-			     con: Con.t}
-	     | Fun of {decs: {lambda: Lambda.t,
-			      var: Var.t} vector,
-		       tyvars: unit -> Tyvar.t vector}
-	     | Val of {rvbs: {lambda: Lambda.t,
-			      var: Var.t} vector,
-		       tyvars: unit -> Tyvar.t vector,
-		       vbs: {exp: Exp.t,
-			     lay: unit -> Layout.t,
-			     pat: Pat.t,
-			     patRegion: Region.t} vector,
-		       warnMatch: bool}
+         sig
+            datatype t =
+               Datatype of {cons: {arg: Type.t option,
+                                   con: Con.t} vector,
+                            tycon: Tycon.t,
+                            tyvars: Tyvar.t vector} vector
+             | Exception of {arg: Type.t option,
+                             con: Con.t}
+             | Fun of {decs: {lambda: Lambda.t,
+                              var: Var.t} vector,
+                       tyvars: unit -> Tyvar.t vector}
+             | Val of {nonexhaustiveExnMatch: Control.Elaborate.DiagDI.t,
+                       nonexhaustiveMatch: Control.Elaborate.DiagEIW.t,
+                       rvbs: {lambda: Lambda.t,
+                              var: Var.t} vector,
+                       tyvars: unit -> Tyvar.t vector,
+                       vbs: {exp: Exp.t,
+                             lay: unit -> Layout.t,
+                             pat: Pat.t,
+                             patRegion: Region.t} vector}
 
-	    val layout: t -> Layout.t
-	 end
+            val layout: t -> Layout.t
+         end
       where type t = Exp.dec
 
       structure Program:
-	 sig
-	    datatype t = T of {decs: Dec.t vector}
+         sig
+            datatype t = T of {decs: Dec.t vector}
 
-	    val layout: t -> Layout.t
-	 end
+            val layout: t -> Layout.t
+         end
    end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/core-ml/dead-code.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/core-ml/dead-code.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/core-ml/dead-code.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 functor DeadCode (S: DEAD_CODE_STRUCTS): DEAD_CODE = 
 struct
 
@@ -15,62 +16,62 @@
 fun deadCode {prog} =
    let
       val {get = varIsUsed, set = setVarIsUsed, destroy, ...} =
-	 Property.destGetSet (Var.plist, Property.initConst false)
+         Property.destGetSet (Var.plist, Property.initConst false)
       fun patVarIsUsed (p: Pat.t): bool =
-	 DynamicWind.withEscape
-	 (fn escape =>
-	  (Pat.foreachVar (p, fn x => if varIsUsed x
-					 then escape true
-				      else ())
-	   ; false))
+         Exn.withEscape
+         (fn escape =>
+          (Pat.foreachVar (p, fn x => if varIsUsed x
+                                         then escape true
+                                      else ())
+           ; false))
       fun decIsWild (d: Dec.t): bool =
-	 case d of
-	    Val {rvbs, vbs, ...} =>
-	       0 = Vector.length rvbs
-	       andalso 1 = Vector.length vbs
-	       andalso let
-			  val pat = #pat (Vector.sub (vbs, 0))
-		       in
-			  Pat.isWild pat orelse Pat.isUnit pat
-		       end
-	  | _ => false
+         case d of
+            Val {rvbs, vbs, ...} =>
+               0 = Vector.length rvbs
+               andalso 1 = Vector.length vbs
+               andalso let
+                          val pat = #pat (Vector.sub (vbs, 0))
+                       in
+                          Pat.isWild pat orelse Pat.isUnit pat
+                       end
+          | _ => false
       fun decIsNeeded (d: Dec.t): bool =
-	 case d of
-	    Datatype _ => true
-	  | Exception _ => true
-	  | Fun {decs, ...} => Vector.exists (decs, varIsUsed o #var)
-	  | Val {rvbs, vbs, ...} =>
-	       Vector.exists (rvbs, varIsUsed o #var)
-	       orelse Vector.exists (vbs, patVarIsUsed o #pat)
-	       orelse decIsWild d
+         case d of
+            Datatype _ => true
+          | Exception _ => true
+          | Fun {decs, ...} => Vector.exists (decs, varIsUsed o #var)
+          | Val {rvbs, vbs, ...} =>
+               Vector.exists (rvbs, varIsUsed o #var)
+               orelse Vector.exists (vbs, patVarIsUsed o #pat)
+               orelse decIsWild d
       fun useVar x = setVarIsUsed (x, true)
       fun useExp (e: Exp.t): unit = Exp.foreachVar (e, useVar)
       fun useLambda (l: Lambda.t): unit =
-	 useExp (#body (Lambda.dest l))
+         useExp (#body (Lambda.dest l))
       fun useDec (d: Dec.t): unit = 
-	 case d of
-	    Datatype _ => ()
-	  | Exception _ => ()
-	  | Fun {decs, ...} => Vector.foreach (decs, useLambda o #lambda)
-	  | Val {rvbs, vbs, ...} =>
-	       (Vector.foreach (rvbs, useLambda o #lambda)
-		; Vector.foreach (vbs, useExp o #exp))
+         case d of
+            Datatype _ => ()
+          | Exception _ => ()
+          | Fun {decs, ...} => Vector.foreach (decs, useLambda o #lambda)
+          | Val {rvbs, vbs, ...} =>
+               (Vector.foreach (rvbs, useLambda o #lambda)
+                ; Vector.foreach (vbs, useExp o #exp))
 
       val n = Vector.length prog
       val m = n - 1
       val prog =
-	 Vector.tabulate
-	 (n, fn i =>
-	  let val (decs, deadCode) = Vector.sub (prog, m - i)
-	  in
-	     if deadCode
-		then List.fold (rev decs, [], fn (dec, decs) =>
-				if decIsWild dec orelse decIsNeeded dec
-				   then (useDec dec; dec :: decs)
-				   else decs)
-		else (List.foreach (decs, useDec)
-		      ; decs)
-	  end)
+         Vector.tabulate
+         (n, fn i =>
+          let val (decs, deadCode) = Vector.sub (prog, m - i)
+          in
+             if deadCode
+                then List.fold (rev decs, [], fn (dec, decs) =>
+                                if decIsWild dec orelse decIsNeeded dec
+                                   then (useDec dec; dec :: decs)
+                                   else decs)
+                else (List.foreach (decs, useDec)
+                      ; decs)
+          end)
       val _ = destroy ()
    in {prog = Vector.rev prog}
    end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/core-ml/dead-code.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/core-ml/dead-code.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/core-ml/dead-code.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature DEAD_CODE_STRUCTS = 
    sig
       structure CoreML: CORE_ML

Modified: mlton/branches/on-20050420-cmm-branch/mlton/core-ml/sources.cm
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/core-ml/sources.cm	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/core-ml/sources.cm	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 Group
 
 signature CORE_ML

Modified: mlton/branches/on-20050420-cmm-branch/mlton/core-ml/sources.mlb
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/core-ml/sources.mlb	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/core-ml/sources.mlb	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,22 +1,23 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 local
-    ../ast/sources.mlb
-    ../atoms/sources.mlb
-    ../control/sources.mlb
-    ../../lib/mlton/sources.mlb
+   ../ast/sources.mlb
+   ../atoms/sources.mlb
+   ../control/sources.mlb
+   ../../lib/mlton/sources.mlb
 
-    core-ml.sig
-    core-ml.fun
-    dead-code.sig
-    dead-code.fun
+   core-ml.sig
+   core-ml.fun
+   dead-code.sig
+   dead-code.fun
 in
-    signature CORE_ML
-    functor CoreML
-    functor DeadCode
-end
\ No newline at end of file
+   signature CORE_ML
+   functor CoreML
+   functor DeadCode
+end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/defunctorize/defunctorize.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/defunctorize/defunctorize.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/defunctorize/defunctorize.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,9 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 functor Defunctorize (S: DEFUNCTORIZE_STRUCTS): DEFUNCTORIZE = 
@@ -22,6 +22,7 @@
    structure Prim = Prim
    structure RealSize = RealSize
    structure Record = Record
+   structure SourceInfo = SourceInfo
    structure Ctype = Type
    structure WordSize = WordSize
    structure WordX = WordX
@@ -46,998 +47,1046 @@
    structure XvarExp = VarExp
 end
 
-structure Region =
-   struct
-      open Region
-
-      fun toFilePos r = Option.map (left r, SourcePos.toString)
-   end
-
 structure NestedPat = NestedPat (open Xml)
 
 structure MatchCompile =
    MatchCompile (open CoreML
-		 structure Type = Xtype
-		 structure NestedPat = NestedPat
-		 structure Cases =
-		    struct
-		       type exp = Xexp.t
+                 structure Type = Xtype
+                 structure NestedPat = NestedPat
+                 structure Cases =
+                    struct
+                       type exp = Xexp.t
 
-		       open Xcases
-		       type t = exp t
-		       val word = Word
-		       fun con v =
-			  Con (Vector.map
-			       (v, fn {con, targs, arg, rhs} =>
-				(Xpat.T {con = con,
-					 targs = targs,
-					 arg = arg},
-				 rhs)))
-		    end
-		structure Exp =
-		   struct
-		      open Xexp
-		      val lett = let1
-		      val var = monoVar
+                       open Xcases
+                       type t = exp t
+                       val word = Word
+                       fun con v =
+                          Con (Vector.map
+                               (v, fn {con, targs, arg, rhs} =>
+                                (Xpat.T {con = con,
+                                         targs = targs,
+                                         arg = arg},
+                                 rhs)))
+                    end
+                structure Exp =
+                   struct
+                      open Xexp
+                      val lett = let1
+                      val var = monoVar
 
-		      fun detuple {tuple, body} =
-			 Xexp.detuple
-			 {tuple = tuple,
-			  body = fn xts => body (Vector.map
-						 (xts, fn (x, t) =>
-						  (XvarExp.var x, t)))}
-		   end)
+                      fun detuple {tuple, body} =
+                         Xexp.detuple
+                         {tuple = tuple,
+                          body = fn xts => body (Vector.map
+                                                 (xts, fn (x, t) =>
+                                                  (XvarExp.var x, t)))}
+                   end)
 
 structure Xexp =
    struct
       open Xexp
-	 
+         
       local
-	 fun exn (c: Con.t): Xexp.t =
-	    conApp {arg = NONE,
-		    con = c,
-		    targs = Vector.new0 (),
-		    ty = Xtype.exn}
+         fun exn (c: Con.t): Xexp.t =
+            conApp {arg = NONE,
+                    con = c,
+                    targs = Vector.new0 (),
+                    ty = Xtype.exn}
       in
-	 val bind = exn Con.bind
-	 val match = exn Con.match
+         val bind = exn Con.bind
+         val match = exn Con.match
       end
    end
 
-val warnings: (unit -> unit) list ref = ref []
+fun enterLeave (e: Xexp.t, t, si): Xexp.t =
+   Xexp.fromExp (Xml.Exp.enterLeave (Xexp.toExp e, t, si), t)
+
+val diagnostics: (unit -> unit) list ref = ref []
    
 fun casee {caseType: Xtype.t,
-	   cases: {exp: Xexp.t,
-		   lay: (unit -> Layout.t) option,
-		   pat: NestedPat.t} vector,
-	   conTycon,
-	   kind: string,
-	   lay: unit -> Layout.t,
-	   mayWarn: bool,
-	   noMatch,
-	   region: Region.t,
-	   test = (test: Xexp.t, testType: Xtype.t),
-	   tyconCons}: Xexp.t =
+           cases: {exp: Xexp.t,
+                   lay: (unit -> Layout.t) option,
+                   pat: NestedPat.t} vector,
+           conTycon,
+           kind: string,
+           lay: unit -> Layout.t,
+           noMatch,
+           nonexhaustiveExnMatch: Control.Elaborate.DiagDI.t,
+           nonexhaustiveMatch: Control.Elaborate.DiagEIW.t,
+           redundantMatch: Control.Elaborate.DiagEIW.t,
+           region: Region.t,
+           test = (test: Xexp.t, testType: Xtype.t),
+           tyconCons}: Xexp.t =
    let
       val cases = Vector.map (cases, fn {exp, lay, pat} =>
-			      {exp = exp,
-			       isDefault = false,
-			       lay = lay,
-			       numUses = ref 0,
-			       pat = pat})
-      fun raiseExn f =
-	 let
-	    val e = Var.newNoname ()
-	 in
-	    Vector.concat
-	    [cases,
-	     Vector.new1 {exp = Xexp.raisee (f e, {extend = true}, caseType),
-			  isDefault = true,
-			  lay = NONE,
-			  numUses = ref 0,
-			  pat = NestedPat.make (NestedPat.Var e, testType)}]
-	 end
+                              {exp = fn () => exp,
+                               isDefault = false,
+                               lay = lay,
+                               numUses = ref 0,
+                               pat = pat})
+      fun raiseExn (f, mayWrap) =
+         let
+            val e = Var.newNoname ()
+            val exp = Xexp.raisee (f e, {extend = true}, caseType)
+            val exp =
+               fn () =>
+               if mayWrap andalso
+                  let
+                     open Control
+                  in
+                     !profile <> ProfileNone 
+                     andalso !profileIL = ProfileSource
+                     andalso !profileRaise
+                  end
+                  then enterLeave (exp, caseType,
+                                   SourceInfo.function {name = ["raise"],
+                                                        region = region})
+               else exp
+         in
+            Vector.concat
+            [cases,
+             Vector.new1 {exp = exp,
+                          isDefault = true,
+                          lay = NONE,
+                          numUses = ref 0,
+                          pat = NestedPat.make (NestedPat.Var e, testType)}]
+         end
       val cases =
-	 let
-	    datatype z = datatype Cexp.noMatch
-	 in
-	    case noMatch of
-	       Impossible => cases
-	     | RaiseAgain => raiseExn (fn e => Xexp.monoVar (e, Xtype.exn))
-	     | RaiseBind => raiseExn (fn _ => Xexp.bind)
-	     | RaiseMatch => raiseExn (fn _ => Xexp.match)
-	 end
+         let
+            datatype z = datatype Cexp.noMatch
+         in
+            case noMatch of
+               Impossible => cases
+             | RaiseAgain =>
+                  raiseExn (fn e => Xexp.monoVar (e, Xtype.exn), false)
+             | RaiseBind => raiseExn (fn _ => Xexp.bind, true)
+             | RaiseMatch => raiseExn (fn _ => Xexp.match, true)
+         end
       val examples = ref (fn () => Vector.new0 ())
-      fun matchCompile () =		     		     
-	 let
-	    val (cases, decs) =
-	       Vector.mapAndFold
-	       (cases, [],
-		fn ({exp = e, numUses, pat = p, ...}, decs) =>
-		let
-		   val args = Vector.fromList (NestedPat.varsAndTypes p)
-		   val (vars, tys) = Vector.unzip args
-		   val func = Var.newNoname ()
-		   val arg = Var.newNoname ()
-		   val argType = Xtype.tuple tys
-		   val funcType = Xtype.arrow (argType, caseType)
-		   val dec =
-		      Xdec.MonoVal
-		      {var = func,
-		       ty = funcType,
-		       exp =
-		       XprimExp.Lambda
-		       (Xlambda.make
-			{arg = arg,
-			 argType = argType,
-			 body = (Xexp.toExp
-				 (Xexp.detupleBind
-				  {tuple = Xexp.monoVar (arg, argType),
-				   components = vars,
-				   body = e})),
-			 mayInline = true})}
-		   fun finish rename =
-		      (Int.inc numUses
-		       ; (Xexp.app
-			  {func = Xexp.monoVar (func, funcType),
-			   arg =
-			   Xexp.tuple {exps = (Vector.map
-					       (args, fn (x, t) =>
-						Xexp.monoVar (rename x, t))),
-				       ty = argType},
-			   ty = caseType}))
-		in
-		   ((p, finish), dec :: decs)
-		end)
-	    val testVar = Var.newNoname ()
-	    val (body, es) =
-	       MatchCompile.matchCompile {caseType = caseType,
-					  cases = cases,
-					  conTycon = conTycon,
-					  region = region,
-					  test = testVar,
-					  testType = testType,
-					  tyconCons = tyconCons}
-	    val _ = examples := es
-	 in
-	    Xexp.let1 {var = testVar,
-		       exp = test,
-		       body = Xexp.lett {decs = decs,
-					 body = body}}
-	 end
+      fun matchCompile () =                                  
+         let
+            val testVar = Var.newNoname ()
+            val decs = ref []
+            val cases =
+               Vector.map
+               (cases, fn {exp = e, numUses, pat = p, ...} =>
+                let
+                   val args = Vector.fromList (NestedPat.varsAndTypes p)
+                   val (vars, tys) = Vector.unzip args
+                   val func = Var.newNoname ()
+                   val arg = Var.newNoname ()
+                   val argType = Xtype.tuple tys
+                   val funcType = Xtype.arrow (argType, caseType)
+                   fun dec () =
+                      Xdec.MonoVal
+                      {var = func,
+                       ty = funcType,
+                       exp =
+                       XprimExp.Lambda
+                       (Xlambda.make
+                        {arg = arg,
+                         argType = argType,
+                         body = (Xexp.toExp
+                                 (Xexp.detupleBind
+                                  {tuple = Xexp.monoVar (arg, argType),
+                                   components = vars,
+                                   body = e ()})),
+                         mayInline = true})}
+                   fun finish rename =
+                      (if 0 = !numUses then List.push (decs, dec ()) else ()
+                       ; Int.inc numUses
+                       ; (Xexp.app
+                          {func = Xexp.monoVar (func, funcType),
+                           arg =
+                           Xexp.tuple {exps = (Vector.map
+                                               (args, fn (x, t) =>
+                                                Xexp.monoVar (rename x, t))),
+                                       ty = argType},
+                           ty = caseType}))
+                in
+                   (p, finish)
+                end)
+            val (body, es) =
+               MatchCompile.matchCompile {caseType = caseType,
+                                          cases = cases,
+                                          conTycon = conTycon,
+                                          region = region,
+                                          test = testVar,
+                                          testType = testType,
+                                          tyconCons = tyconCons}
+            (* Must convert to a normal expression to force everything. *)
+            val body = Xexp.toExp body
+            val () = examples := es
+         in
+            Xexp.let1 {var = testVar,
+                       exp = test,
+                       body = Xexp.lett {decs = !decs,
+                                         body = Xexp.fromExp (body, caseType)}}
+         end
       datatype z = datatype NestedPat.node
       fun lett (x, e) = Xexp.let1 {var = x, exp = test, body = e}
       fun wild e = lett (Var.newNoname (), e)
       val exp =
-	 if Vector.isEmpty cases
-	    then Error.bug "case with no patterns"
-	 else
-	    let
-	       val {exp = e, pat = p, numUses, ...} = Vector.sub (cases, 0)
-	       fun use () = Int.inc numUses 
-	    in
-	       case NestedPat.node p of
-		  Wild => (use (); wild e)
-		| Var x => (use (); lett (x, e))
-		| Tuple ps =>
-		     if Vector.forall (ps, NestedPat.isVar)
-			then
-			   (* It's a flat tuple pattern.
-			    * Generate the selects.
-			    *)
-			   let
-			      val _ = use ()
-			      val t = Var.newNoname ()
-			      val tuple = XvarExp.mono t
-			      val tys = Xtype.deTuple testType
-			      val (_, decs) =
-				 Vector.fold2
-				 (ps, tys, (0, []),
-				  fn (p, ty, (i, decs)) =>
-				  case NestedPat.node p of
-				     Var x =>
-					(i + 1,
-					 Xdec.MonoVal
-					 {var = x,
-					  ty = ty,
-					  exp = (XprimExp.Select
-						 {tuple = tuple,
-						  offset = i})}
-					 :: decs)
-				   | _ => Error.bug "infer flat tuple")
-			   in
-			      Xexp.let1 {var = t, exp = test,
-					 body = Xexp.lett {decs = decs,
-							   body = e}}
-			   end
-		     else matchCompile ()
+         if Vector.isEmpty cases
+            then Error.bug "Defunctorize.casee: case with no patterns"
+         else
+            let
+               val {exp = e, pat = p, numUses, ...} = Vector.sub (cases, 0)
+               fun use () = Int.inc numUses 
+            in
+               case NestedPat.node p of
+                  Wild => (use (); wild (e ()))
+                | Var x => (use (); lett (x, e ()))
+                | Tuple ps =>
+                     if Vector.forall (ps, NestedPat.isVar)
+                        then
+                           (* It's a flat tuple pattern.
+                            * Generate the selects.
+                            *)
+                           let
+                              val _ = use ()
+                              val t = Var.newNoname ()
+                              val tuple = XvarExp.mono t
+                              val tys = Xtype.deTuple testType
+                              val (_, decs) =
+                                 Vector.fold2
+                                 (ps, tys, (0, []),
+                                  fn (p, ty, (i, decs)) =>
+                                  case NestedPat.node p of
+                                     Var x =>
+                                        (i + 1,
+                                         Xdec.MonoVal
+                                         {var = x,
+                                          ty = ty,
+                                          exp = (XprimExp.Select
+                                                 {tuple = tuple,
+                                                  offset = i})}
+                                         :: decs)
+                                   | _ => Error.bug "Defunctorize.casee: infer flat tuple")
+                           in
+                              Xexp.let1 {var = t, exp = test,
+                                         body = Xexp.lett {decs = decs,
+                                                           body = e ()}}
+                           end
+                     else matchCompile ()
                 | _ => matchCompile ()
-	    end
-      fun warn () =
-	 let
-	    val _ =
-	       if noMatch <> Cexp.RaiseAgain
-		  then
-		     case Vector.peeki (cases,
-					fn (_, {isDefault, numUses, ...}) =>
-					isDefault andalso !numUses > 0) of
-			NONE => ()
-		      | SOME (i, _) =>
-			   let
-			      open Layout
-			   in
-			      Control.warning
-			      (region,
-			       str (concat [kind, " is not exhaustive"]),
-			       align [seq [str "missing pattern: ",
-					   Vector.sub (!examples (), i)],
-				      lay ()])
-			   end
-	       else ()
-	    val redundant =
-	       Vector.keepAll (cases, fn {isDefault, numUses, ...} =>
-			       not isDefault andalso !numUses = 0)
-	    val _ =
-	       if 0 = Vector.length redundant
-		  then ()
-	       else 
-		  let
-		     open Layout
-		  in
-		     Control.warning
-		     (region,
-		      str (concat [kind, " has redundant rules"]),
-		      align
-		      [seq [str "rules: ",
-			    align (Vector.toListMap
-				   (redundant, fn {lay, ...} =>
-				    case lay of
-				       NONE => Error.bug "redundant match with no lay"
-				     | SOME l => l ()))],
-		       lay ()])
-		  end
-	 in
-	    ()
-	 end
-      val _ = if mayWarn then List.push (warnings, warn) else ()
+            end
+      fun diagnoseNonexhaustiveMatch () =
+         if noMatch = Cexp.RaiseAgain
+            then ()
+         else
+            case Vector.peeki (cases,
+                               fn (_, {isDefault, numUses, ...}) =>
+                                  isDefault andalso !numUses > 0) of
+               NONE => ()
+             | SOME (i, _) =>
+               let
+                  val es = Vector.sub (!examples (), i)
+                  val es =
+                     case nonexhaustiveExnMatch of
+                        Control.Elaborate.DiagDI.Default =>
+                           Vector.map (es, #1)
+                      | Control.Elaborate.DiagDI.Ignore =>
+                           Vector.keepAllMap
+                           (es, fn (e, {isOnlyExns}) =>
+                            if isOnlyExns
+                               then NONE
+                               else SOME e)
+
+                  open Layout
+               in
+                  if 0 = Vector.length es
+                     then ()
+                  else
+                     (if nonexhaustiveMatch = Control.Elaborate.DiagEIW.Error
+                         then Control.error
+                         else Control.warning)
+                     (region,
+                      str (concat [kind, " is not exhaustive"]),
+                      align [seq [str "missing pattern: ",
+                                  Layout.alignPrefix
+                                     (Vector.toList es, "| ")],
+                             lay ()])
+               end
+      fun diagnoseRedundantMatch () =
+         let
+            val redundant =
+                Vector.keepAll (cases, fn {isDefault, numUses, ...} =>
+                                not isDefault andalso !numUses = 0)
+         in
+            if 0 = Vector.length redundant
+               then ()
+            else 
+               let
+                  open Layout
+               in
+                  (if redundantMatch = Control.Elaborate.DiagEIW.Error
+                      then Control.error
+                      else Control.warning)
+                  (region,
+                   str (concat [kind, " has redundant rules"]),
+                   align
+                      [seq [str "rules: ",
+                            align (Vector.toListMap
+                                      (redundant, fn {lay, ...} =>
+                                       case lay of
+                                          NONE => Error.bug "Defunctorize.casee: redundant match with no lay"
+                                        | SOME l => l ()))],
+                       lay ()])
+               end
+         end
    in
-      exp
+      if redundantMatch <> Control.Elaborate.DiagEIW.Ignore
+         then List.push (diagnostics, diagnoseRedundantMatch)
+         else ()
+      ; if nonexhaustiveMatch  <> Control.Elaborate.DiagEIW.Ignore
+           then List.push (diagnostics, diagnoseNonexhaustiveMatch)
+           else ()
+      ; exp
    end
 
 val casee =
    Trace.trace ("Defunctorize.casee",
-		Region.layout o #region,
-		Xml.Exp.layout o Xexp.toExp)
+                Region.layout o #region,
+                Xml.Exp.layout o Xexp.toExp)
    casee
 
 fun 'a sortByField (v: (Field.t * 'a) vector): 'a vector =
    Vector.map (QuickSort.sortVector (v, fn ((f, _), (f', _)) =>
-				     Field.<= (f, f')),
-	       #2)
+                                     Field.<= (f, f')),
+               #2)
 
 fun valDec (tyvars: Tyvar.t vector,
-	    x: Var.t,
-	    e: Xexp.t,
-	    et: Xtype.t,
-	    e': Xexp.t): Xexp.t =
+            x: Var.t,
+            e: Xexp.t,
+            et: Xtype.t,
+            e': Xexp.t): Xexp.t =
    Xexp.lett {body = e',
-	      decs = [Xdec.PolyVal {exp = Xexp.toExp e,
-				    ty = et,
-				    tyvars = tyvars,
-				    var = x}]}
+              decs = [Xdec.PolyVal {exp = Xexp.toExp e,
+                                    ty = et,
+                                    tyvars = tyvars,
+                                    var = x}]}
 
 structure Xexp =
    struct
       open Xexp
 
       fun list (es: Xexp.t vector, ty: Xtype.t, {forceLeftToRight: bool})
-	 : Xexp.t =
-	 let
-	    val targs = #2 (valOf (Xtype.deConOpt ty))
-	    val eltTy = Vector.sub (targs, 0)
-	    val nill: Xexp.t =
-	       Xexp.conApp {arg = NONE,
-			    con = Con.nill,
-			    targs = targs,
-			    ty = ty}
-	    val consArgTy = Xtype.tuple (Vector.new2 (eltTy, ty))
-	    val cons: Xexp.t * Xexp.t -> Xexp.t =
-	       fn (e1, e2) =>
-	       Xexp.conApp
-	       {arg = SOME (Xexp.tuple {exps = Vector.new2 (e1, e2),
-					ty = consArgTy}),
-		con = Con.cons,
-		targs = targs,
-		ty = ty}
-	 in
-	    if not forceLeftToRight
-	       then
-		  (* Build the list right to left. *)
-		  Vector.foldr (es, nill, fn (e, rest) =>
-				let
-				   val var = Var.newNoname ()
-				in
-				   Xexp.let1 {body = cons (e, monoVar (var, ty)),
-					      exp = rest,
-					      var = var}
-				end)
-	    else if Vector.length es < 20
-	       then Vector.foldr (es, nill, cons)
-	    else
-	       let
-		  val revArgTy = Xtype.tuple (Vector.new2 (ty, ty))
-		  val revTy = Xtype.arrow (revArgTy, ty)
-		  val revVar = Var.newString "rev"
-		  fun rev (e1, e2) =
-		     Xexp.app
-		     {func = Xexp.monoVar (revVar, revTy),
-		      arg = Xexp.tuple {exps = Vector.new2 (e1, e2),
-					ty = revArgTy},
-		      ty = ty}
-		  fun detuple2 (tuple: Xexp.t,
-				f: XvarExp.t * XvarExp.t -> Xexp.t): Xexp.t =
-		     Xexp.detuple {body = fn xs => let
-						      fun x i = #1 (Vector.sub (xs, i))
-						   in
-						      f (x 0, x 1)
-						   end,
-						tuple = tuple}
-		  val revArg = Var.newNoname ()
-		  val revLambda =
-		     Xlambda.make
-		     {arg = revArg,
-		      argType = revArgTy,
-		      mayInline = true,
-		      body =
-		      Xexp.toExp
-		      (detuple2
-		       (Xexp.monoVar (revArg, revArgTy), fn (l, ac) =>
-			let
-			   val ac = Xexp.varExp (ac, ty)
-			   val consArg = Var.newNoname ()
-			in
-			   Xexp.casee
-			   {cases =
-			    Xcases.Con
-			    (Vector.new2
-			     ((Xpat.T {arg = NONE,
-				       con = Con.nill,
-				       targs = targs},
-			       ac),
-			      (Xpat.T {arg = SOME (consArg, consArgTy),
-				       con = Con.cons,
-				       targs = targs},
-			       detuple2
-			       (Xexp.monoVar (consArg, consArgTy),
-				fn (x, l) =>
-				rev (Xexp.varExp (l, ty),
-				     cons (Xexp.varExp (x, eltTy),
-					   ac)))))),
-			    default = NONE,
-			    test = Xexp.varExp (l, ty),
-			    ty = ty}
-			end))}
-		  val revDec =
-		     Xdec.Fun
-		     {decs = Vector.new1 {lambda = revLambda,
-					  ty = revTy,
-					  var = revVar},
-		      tyvars = Vector.new0 ()}
-		  val l = Var.newNoname ()
-		  val (l, body) =
-		     Vector.foldr
-		     (es, (l, Xexp.lett {decs = [revDec],
-					 body = rev (Xexp.monoVar (l, ty),
-						     nill)}),
-		      fn (e, (l, body)) =>
-		      let
-			 val l' = Var.newNoname ()
-		      in
-			 (l',
-			  Xexp.let1 {body = body,
-				     exp = cons (e, Xexp.monoVar (l', ty)),
-				     var = l})
-		      end)
-	       in
-		  Xexp.let1 {body = body,
-			     exp = nill,
-			     var = l}
-	       end
-	 end
+         : Xexp.t =
+         let
+            val targs = #2 (valOf (Xtype.deConOpt ty))
+            val eltTy = Vector.sub (targs, 0)
+            val nill: Xexp.t =
+               Xexp.conApp {arg = NONE,
+                            con = Con.nill,
+                            targs = targs,
+                            ty = ty}
+            val consArgTy = Xtype.tuple (Vector.new2 (eltTy, ty))
+            val cons: Xexp.t * Xexp.t -> Xexp.t =
+               fn (e1, e2) =>
+               Xexp.conApp
+               {arg = SOME (Xexp.tuple {exps = Vector.new2 (e1, e2),
+                                        ty = consArgTy}),
+                con = Con.cons,
+                targs = targs,
+                ty = ty}
+         in
+            if not forceLeftToRight
+               then
+                  (* Build the list right to left. *)
+                  Vector.foldr (es, nill, fn (e, rest) =>
+                                let
+                                   val var = Var.newNoname ()
+                                in
+                                   Xexp.let1 {body = cons (e, monoVar (var, ty)),
+                                              exp = rest,
+                                              var = var}
+                                end)
+            else if Vector.length es < 20
+               then Vector.foldr (es, nill, cons)
+            else
+               let
+                  val revArgTy = Xtype.tuple (Vector.new2 (ty, ty))
+                  val revTy = Xtype.arrow (revArgTy, ty)
+                  val revVar = Var.newString "rev"
+                  fun rev (e1, e2) =
+                     Xexp.app
+                     {func = Xexp.monoVar (revVar, revTy),
+                      arg = Xexp.tuple {exps = Vector.new2 (e1, e2),
+                                        ty = revArgTy},
+                      ty = ty}
+                  fun detuple2 (tuple: Xexp.t,
+                                f: XvarExp.t * XvarExp.t -> Xexp.t): Xexp.t =
+                     Xexp.detuple {body = fn xs => let
+                                                      fun x i = #1 (Vector.sub (xs, i))
+                                                   in
+                                                      f (x 0, x 1)
+                                                   end,
+                                                tuple = tuple}
+                  val revArg = Var.newNoname ()
+                  val revLambda =
+                     Xlambda.make
+                     {arg = revArg,
+                      argType = revArgTy,
+                      mayInline = true,
+                      body =
+                      Xexp.toExp
+                      (detuple2
+                       (Xexp.monoVar (revArg, revArgTy), fn (l, ac) =>
+                        let
+                           val ac = Xexp.varExp (ac, ty)
+                           val consArg = Var.newNoname ()
+                        in
+                           Xexp.casee
+                           {cases =
+                            Xcases.Con
+                            (Vector.new2
+                             ((Xpat.T {arg = NONE,
+                                       con = Con.nill,
+                                       targs = targs},
+                               ac),
+                              (Xpat.T {arg = SOME (consArg, consArgTy),
+                                       con = Con.cons,
+                                       targs = targs},
+                               detuple2
+                               (Xexp.monoVar (consArg, consArgTy),
+                                fn (x, l) =>
+                                rev (Xexp.varExp (l, ty),
+                                     cons (Xexp.varExp (x, eltTy),
+                                           ac)))))),
+                            default = NONE,
+                            test = Xexp.varExp (l, ty),
+                            ty = ty}
+                        end))}
+                  val revDec =
+                     Xdec.Fun
+                     {decs = Vector.new1 {lambda = revLambda,
+                                          ty = revTy,
+                                          var = revVar},
+                      tyvars = Vector.new0 ()}
+                  val l = Var.newNoname ()
+                  val (l, body) =
+                     Vector.foldr
+                     (es, (l, Xexp.lett {decs = [revDec],
+                                         body = rev (Xexp.monoVar (l, ty),
+                                                     nill)}),
+                      fn (e, (l, body)) =>
+                      let
+                         val l' = Var.newNoname ()
+                      in
+                         (l',
+                          Xexp.let1 {body = body,
+                                     exp = cons (e, Xexp.monoVar (l', ty)),
+                                     var = l})
+                      end)
+               in
+                  Xexp.let1 {body = body,
+                             exp = nill,
+                             var = l}
+               end
+         end
    end
 
 fun defunctorize (CoreML.Program.T {decs}) =
    let
       val {get = conExtraArgs: Con.t -> Xtype.t vector option,
-	   set = setConExtraArgs, destroy = destroy1, ...} =
-	 Property.destGetSetOnce (Con.plist, Property.initConst NONE)
+           set = setConExtraArgs, destroy = destroy1, ...} =
+         Property.destGetSetOnce (Con.plist, Property.initConst NONE)
       val {get = tyconExtraArgs: Tycon.t -> Xtype.t vector option,
-	   set = setTyconExtraArgs, destroy = destroy2, ...} =
-	 Property.destGetSetOnce (Tycon.plist, Property.initConst NONE)
+           set = setTyconExtraArgs, destroy = destroy2, ...} =
+         Property.destGetSetOnce (Tycon.plist, Property.initConst NONE)
       val {destroy = destroy3, hom = loopTy} =
-	 let
-	    fun con (c, ts) =
-	       let
-		  val ts =
-		     case tyconExtraArgs c of
-			NONE => ts
-		      | SOME ts' => Vector.concat [ts', ts]
-	       in
-		  Xtype.con (c, ts)
-	       end
-	 in
-	    Ctype.makeHom {con = con, var = Xtype.var}
-	 end
+         let
+            fun con (c, ts) =
+               let
+                  val ts =
+                     case tyconExtraArgs c of
+                        NONE => ts
+                      | SOME ts' => Vector.concat [ts', ts]
+               in
+                  Xtype.con (c, ts)
+               end
+         in
+            Ctype.makeHom {con = con, var = Xtype.var}
+         end
       fun conTargs (c: Con.t, ts: Ctype.t vector): Xtype.t vector =
-	 let
-	    val ts = Vector.map (ts, loopTy)
-	 in
-	    case conExtraArgs c of
-	       NONE => ts
-	     | SOME ts' => Vector.concat [ts', ts]
-	 end
+         let
+            val ts = Vector.map (ts, loopTy)
+         in
+            case conExtraArgs c of
+               NONE => ts
+             | SOME ts' => Vector.concat [ts', ts]
+         end
       val {get = conTycon, set = setConTycon, ...} =
-	 Property.getSetOnce (Con.plist,
-			      Property.initRaise ("conTycon", Con.layout))
+         Property.getSetOnce (Con.plist,
+                              Property.initRaise ("conTycon", Con.layout))
       val {get = tyconCons: Tycon.t -> {con: Con.t,
-					hasArg: bool} vector,
-	   set = setTyconCons, ...} =
-	 Property.getSetOnce (Tycon.plist,
-			      Property.initRaise ("tyconCons", Tycon.layout))
+                                        hasArg: bool} vector,
+           set = setTyconCons, ...} =
+         Property.getSetOnce (Tycon.plist,
+                              Property.initRaise ("tyconCons", Tycon.layout))
       val setConTycon =
-	 Trace.trace2 ("setConTycon", Con.layout, Tycon.layout, Unit.layout)
-	 setConTycon
+         Trace.trace2 
+         ("Defunctorize.setConTycon", 
+          Con.layout, Tycon.layout, Unit.layout)
+         setConTycon
       val datatypes = ref []
       (* Process all the datatypes. *)
       fun loopDec (d: Cdec.t) =
-	 let
+         let
 (*          Use open Cdec instead of the following due to an SML/NJ bug *)
-(*	    datatype z = datatype Cdec.t *)
-	    open Cdec
-	 in
-	    case d of
-	       Datatype dbs =>
-		  let
-		     val frees: Tyvar.t list ref = ref []
-		     val _ =
-			Vector.foreach
-			(dbs, fn {cons, tyvars, ...} =>
-			 let
-			    fun var (a: Tyvar.t): unit =
-			       let
-				  fun eq a' = Tyvar.equals (a, a')
-			       in
-				  if Vector.exists (tyvars, eq)
-				     orelse List.exists (!frees, eq)
-				     then ()
-				  else List.push (frees, a)
-			       end
-			    val {destroy, hom} =
-			       Ctype.makeHom {con = fn _ => (),
-					      var = var}
-			    val _ =
-			       Vector.foreach (cons, fn {arg, ...} =>
-					       Option.app (arg, hom))
-			    val _ = destroy ()
-			 in
-			    ()
-			 end)
-		     val frees = !frees
-		     val dbs =
-			if List.isEmpty frees
-			   then dbs
-			else
-			   let
-			      val frees = Vector.fromList frees
-			      val extra = Vector.map (frees, Xtype.var)
-			   in
-			      Vector.map
-			      (dbs, fn {cons, tycon, tyvars} =>
-			       let
-				  val _ = setTyconExtraArgs (tycon, SOME extra)
-				  val _ =
-				     Vector.foreach
-				     (cons, fn {con, ...} =>
-				      setConExtraArgs (con, SOME extra))
-			       in
-				  {cons = cons,
-				   tycon = tycon,
-				   tyvars = Vector.concat [frees, tyvars]}
-			       end)
-			   end
-		  in
-		     Vector.foreach
-		     (dbs, fn {cons, tycon, tyvars} =>
-		      let
-			 val _ =
-			    setTyconCons (tycon,
-					  Vector.map (cons, fn {arg, con} =>
-						      {con = con,
-						       hasArg = isSome arg}))
-			 val cons =
-			    Vector.map
-			    (cons, fn {arg, con} =>
-			     (setConTycon (con, tycon)
-			      ; {arg = Option.map (arg, loopTy),
-				 con = con}))
-			 
-			 val _ = 
-			    if Tycon.equals (tycon, Tycon.reff)
-			       then ()
-			    else
-			       List.push (datatypes, {cons = cons,
-						      tycon = tycon,
-						      tyvars = tyvars})
-		      in
-			 ()
-		      end)
-		  end
-	     | Exception {con, ...} => setConTycon (con, Tycon.exn)
-	     | Fun {decs, ...} => Vector.foreach (decs, loopLambda o #lambda)
-	     | Val {rvbs, vbs, ...} =>
-		  (Vector.foreach (rvbs, loopLambda o #lambda)
-		   ; Vector.foreach (vbs, loopExp o #exp))
-	 end
+(*          datatype z = datatype Cdec.t *)
+            open Cdec
+         in
+            case d of
+               Datatype dbs =>
+                  let
+                     val frees: Tyvar.t list ref = ref []
+                     val _ =
+                        Vector.foreach
+                        (dbs, fn {cons, tyvars, ...} =>
+                         let
+                            fun var (a: Tyvar.t): unit =
+                               let
+                                  fun eq a' = Tyvar.equals (a, a')
+                               in
+                                  if Vector.exists (tyvars, eq)
+                                     orelse List.exists (!frees, eq)
+                                     then ()
+                                  else List.push (frees, a)
+                               end
+                            val {destroy, hom} =
+                               Ctype.makeHom {con = fn _ => (),
+                                              var = var}
+                            val _ =
+                               Vector.foreach (cons, fn {arg, ...} =>
+                                               Option.app (arg, hom))
+                            val _ = destroy ()
+                         in
+                            ()
+                         end)
+                     val frees = !frees
+                     val dbs =
+                        if List.isEmpty frees
+                           then dbs
+                        else
+                           let
+                              val frees = Vector.fromList frees
+                              val extra = Vector.map (frees, Xtype.var)
+                           in
+                              Vector.map
+                              (dbs, fn {cons, tycon, tyvars} =>
+                               let
+                                  val _ = setTyconExtraArgs (tycon, SOME extra)
+                                  val _ =
+                                     Vector.foreach
+                                     (cons, fn {con, ...} =>
+                                      setConExtraArgs (con, SOME extra))
+                               in
+                                  {cons = cons,
+                                   tycon = tycon,
+                                   tyvars = Vector.concat [frees, tyvars]}
+                               end)
+                           end
+                  in
+                     Vector.foreach
+                     (dbs, fn {cons, tycon, tyvars} =>
+                      let
+                         val _ =
+                            setTyconCons (tycon,
+                                          Vector.map (cons, fn {arg, con} =>
+                                                      {con = con,
+                                                       hasArg = isSome arg}))
+                         val cons =
+                            Vector.map
+                            (cons, fn {arg, con} =>
+                             (setConTycon (con, tycon)
+                              ; {arg = Option.map (arg, loopTy),
+                                 con = con}))
+                         
+                         val _ = 
+                            if Tycon.equals (tycon, Tycon.reff)
+                               then ()
+                            else
+                               List.push (datatypes, {cons = cons,
+                                                      tycon = tycon,
+                                                      tyvars = tyvars})
+                      in
+                         ()
+                      end)
+                  end
+             | Exception {con, ...} => setConTycon (con, Tycon.exn)
+             | Fun {decs, ...} => Vector.foreach (decs, loopLambda o #lambda)
+             | Val {rvbs, vbs, ...} =>
+                  (Vector.foreach (rvbs, loopLambda o #lambda)
+                   ; Vector.foreach (vbs, loopExp o #exp))
+         end
       and loopExp (e: Cexp.t): unit =
-	 let
-	    datatype z = datatype Cexp.node
-	 in
-	    case Cexp.node e of
-	       App (e, e') => (loopExp e; loopExp e')
-	     | Case {rules, test, ...} =>
-		  (loopExp test
-		   ; Vector.foreach (rules, loopExp o #exp))
-	     | Con _ => ()
-	     | Const _ => ()
-	     | EnterLeave (e, _) => loopExp e
-	     | Handle {handler, try, ...} => (loopExp handler; loopExp try)
-	     | Lambda l => loopLambda l
-	     | Let (ds, e) => (Vector.foreach (ds, loopDec); loopExp e)
-	     | List es => Vector.foreach (es, loopExp)
-	     | PrimApp {args, ...} => Vector.foreach (args, loopExp)
-	     | Raise e => loopExp e
-	     | Record r => Record.foreach (r, loopExp)
-	     | Seq es => Vector.foreach (es, loopExp)
-	     | Var _ => ()
-	 end
+         let
+            datatype z = datatype Cexp.node
+         in
+            case Cexp.node e of
+               App (e, e') => (loopExp e; loopExp e')
+             | Case {rules, test, ...} =>
+                  (loopExp test
+                   ; Vector.foreach (rules, loopExp o #exp))
+             | Con _ => ()
+             | Const _ => ()
+             | EnterLeave (e, _) => loopExp e
+             | Handle {handler, try, ...} => (loopExp handler; loopExp try)
+             | Lambda l => loopLambda l
+             | Let (ds, e) => (Vector.foreach (ds, loopDec); loopExp e)
+             | List es => Vector.foreach (es, loopExp)
+             | PrimApp {args, ...} => Vector.foreach (args, loopExp)
+             | Raise e => loopExp e
+             | Record r => Record.foreach (r, loopExp)
+             | Seq es => Vector.foreach (es, loopExp)
+             | Var _ => ()
+         end
       and loopLambda (l: Clambda.t): unit =
-	 loopExp (#body (Clambda.dest l))
+         loopExp (#body (Clambda.dest l))
       fun loopPat (p: Cpat.t): NestedPat.t =
-	 let
-	    val (p, t) = Cpat.dest p
-	    val t' = loopTy t
-	    datatype z = datatype Cpat.node
-	    val p = 
-	       case p of
-		  Con {arg, con, targs} =>
-		     NestedPat.Con {arg = Option.map (arg, loopPat),
-				    con = con,
-				    targs = conTargs (con, targs)}
-		| Const f =>
-		     NestedPat.Const {const = f (),
-				      isChar = Ctype.isCharX t,
-				      isInt = Ctype.isInt t}
-		| Layered (x, p) => NestedPat.Layered (x, loopPat p)
-		| List ps =>
-		     let
-			val targs = Vector.map (#2 (valOf (Ctype.deConOpt t)),
-						loopTy)
-		     in
-			Vector.foldr
-			(ps,
-			 NestedPat.Con {arg = NONE,
-					con = Con.nill,
-					targs = targs},
-			 fn (p, np) =>
-			 NestedPat.Con {arg = SOME (NestedPat.tuple
-						    (Vector.new2
-						     (loopPat p,
-						      NestedPat.make (np, t')))),
-					con = Con.cons,
-					targs = targs})
-		     end
-		| Record r =>
-		     NestedPat.Tuple
-		     (Vector.map
-		      (Ctype.deRecord t, fn (f, t: Ctype.t) =>
-		       case Record.peek (r, f) of
-			  NONE => NestedPat.make (NestedPat.Wild, loopTy t)
-			| SOME p => loopPat p))
-		| Tuple ps => NestedPat.Tuple (Vector.map (ps, loopPat))
-		| Var x => NestedPat.Var x
-		| Wild => NestedPat.Wild
-	 in
-	    NestedPat.make (p, t')
-	 end
+         let
+            val (p, t) = Cpat.dest p
+            val t' = loopTy t
+            datatype z = datatype Cpat.node
+            val p = 
+               case p of
+                  Con {arg, con, targs} =>
+                     NestedPat.Con {arg = Option.map (arg, loopPat),
+                                    con = con,
+                                    targs = conTargs (con, targs)}
+                | Const f =>
+                     NestedPat.Const {const = f (),
+                                      isChar = Ctype.isCharX t,
+                                      isInt = Ctype.isInt t}
+                | Layered (x, p) => NestedPat.Layered (x, loopPat p)
+                | List ps =>
+                     let
+                        val targs = Vector.map (#2 (valOf (Ctype.deConOpt t)),
+                                                loopTy)
+                     in
+                        Vector.foldr
+                        (ps,
+                         NestedPat.Con {arg = NONE,
+                                        con = Con.nill,
+                                        targs = targs},
+                         fn (p, np) =>
+                         NestedPat.Con {arg = SOME (NestedPat.tuple
+                                                    (Vector.new2
+                                                     (loopPat p,
+                                                      NestedPat.make (np, t')))),
+                                        con = Con.cons,
+                                        targs = targs})
+                     end
+                | Record r =>
+                     NestedPat.Tuple
+                     (Vector.map
+                      (Ctype.deRecord t, fn (f, t: Ctype.t) =>
+                       case Record.peek (r, f) of
+                          NONE => NestedPat.make (NestedPat.Wild, loopTy t)
+                        | SOME p => loopPat p))
+                | Tuple ps => NestedPat.Tuple (Vector.map (ps, loopPat))
+                | Var x => NestedPat.Var x
+                | Wild => NestedPat.Wild
+         in
+            NestedPat.make (p, t')
+         end
       val _ = Vector.foreach (decs, loopDec)
       (* Now, do the actual defunctorization. *)
       fun loopDec (d: Cdec.t, e: Xexp.t, et: Xtype.t): Xexp.t =
-	 let
-	    fun prefix (d: Xdec.t) =
-	       Xexp.lett {decs = [d], body = e}
-	    fun processLambdas v =
-	       Vector.map
-	       (v, fn {lambda, var} =>
-		let
-		   val {arg, argType, body, bodyType, mayInline} =
-		      loopLambda lambda
-		in
-		   {lambda = Xlambda.make {arg = arg,
-					   argType = argType,
-					   body = Xexp.toExp body,
-					   mayInline = mayInline},
-		    ty = Xtype.arrow (argType, bodyType),
-		    var = var}
-		end)
+         let
+            fun prefix (d: Xdec.t) =
+               Xexp.lett {decs = [d], body = e}
+            fun processLambdas v =
+               Vector.map
+               (v, fn {lambda, var} =>
+                let
+                   val {arg, argType, body, bodyType, mayInline} =
+                      loopLambda lambda
+                in
+                   {lambda = Xlambda.make {arg = arg,
+                                           argType = argType,
+                                           body = Xexp.toExp body,
+                                           mayInline = mayInline},
+                    ty = Xtype.arrow (argType, bodyType),
+                    var = var}
+                end)
 (* Use open Cdec instead of the following due to an SML/NJ bug *)
-(*	    datatype z = datatype Cdec.t *)
-	    open Cdec
-	 in
-	    case d of
-	       Datatype _ => e
-	     | Exception {arg, con} =>
-		  prefix (Xdec.Exception {arg = Option.map (arg, loopTy),
-					  con = con})
-	     | Fun {decs, tyvars} =>
-		  prefix (Xdec.Fun {decs = processLambdas decs,
-				    tyvars = tyvars ()})
-	     | Val {rvbs, tyvars, vbs, warnMatch} =>
-	       let
-		  val tyvars = tyvars ()
-		  val bodyType = et
-		  val e =
-		     Vector.foldr
-		     (vbs, e, fn ({exp, lay, pat, patRegion}, e) =>
-		      let
-			 fun patDec (p: NestedPat.t,
-				     e: Xexp.t,
-				     r: Region.t,
-				     body: Xexp.t,
-				     bodyType: Xtype.t,
-				     mayWarn: bool) =
-			    casee {caseType = bodyType,
-				   cases = Vector.new1 {exp = body,
-							lay = SOME lay,
-							pat = p},
-				   conTycon = conTycon,
-				   kind = "declaration",
-				   lay = lay,
-				   mayWarn = warnMatch andalso mayWarn,
-				   noMatch = Cexp.RaiseBind,
-				   region = r,
-				   test = (e, NestedPat.ty p),
-				   tyconCons = tyconCons}
-			 val isExpansive = Cexp.isExpansive exp
-			 val (exp, expType) = loopExp exp
-			 val pat = loopPat pat
-			 fun vd (x: Var.t) = valDec (tyvars, x, exp, expType, e)
-		      in
-			 if Vector.isEmpty tyvars orelse isExpansive
-			    then
-			       let
-				  val (pat, exp) =
-				     if Vector.isEmpty tyvars
-					then (pat, exp)
-				     else
-					let
-					   val x = Var.newNoname ()
-					   val thunk =
-					      let
-						 open Xexp
-					      in
-						 toExp
-						 (lambda
-						  {arg = Var.newNoname (),
-						   argType = Xtype.unit,
-						   body = exp,
-						   bodyType = expType,
-						   mayInline = true})
-					      end
-					   val thunkTy =
-					      Xtype.arrow (Xtype.unit, expType)
-					   fun subst t =
-					      Xtype.substitute
-					      (t, Vector.map (tyvars, fn a =>
-							      (a, Xtype.unit)))
-					   val body =
-					      Xexp.app
-					      {arg = Xexp.unit (),
-					       func =
-					       Xexp.var
-					       {targs = (Vector.map
-							 (tyvars, fn _ =>
-							  Xtype.unit)),
-						ty = subst thunkTy,
-						var = x},
-					       ty = subst expType}
-					   val decs =
-					      [Xdec.PolyVal {exp = thunk, 
-							     ty = thunkTy,
-							     tyvars = tyvars,
-							     var = x}]
-					in
-					   (NestedPat.replaceTypes (pat, subst),
-					    Xexp.lett {body = body, decs = decs})
-					end
-			       in
-				  patDec (pat, exp, patRegion, e, bodyType, true)
-			       end
-			 else
-			    case NestedPat.node pat of
-			       NestedPat.Wild => vd (Var.newNoname ())
-			     | NestedPat.Var x => vd x
-			     | _ =>
-				  (* Polymorphic pattern.
-				   *  val 'a Foo (y1, y2) = e
-				   * Expands to
-				   *  val 'a x = e
-				   *  val Foo _ = x
-				   *  val 'a y1 = case x of Foo (y1', _) => y1'
-				   *  val 'a y2 = case x of Foo (_, y2') => y2'
-				   *)
-				  let
-				     val x = Var.newNoname ()
-				     val xt = expType
-				     val targs = Vector.map (tyvars, Xtype.var)
-				     val e =
-					List.fold
-					(NestedPat.varsAndTypes pat, e,
-					 fn ((y, yt), e) =>
-					 let
-					    val y' = Var.new y
-					    val pat =
-					       NestedPat.removeOthersReplace
-					       (pat, {old = y, new = y'})
-					 in
-					    valDec
-					    (tyvars,
-					     y,
-					     patDec (pat,
-						     Xexp.var {targs = targs,
-							       ty = xt,
-							       var = x},
-						     patRegion,
-						     Xexp.monoVar (y', yt),
-						     yt,
-						     false),
-					     yt,
-					     e)
-					 end)
-				     fun instantiatePat () =
-					let
-					   val pat = NestedPat.removeVars pat
-					   fun con (_, c, ts) = Xtype.con (c, ts)
-					   fun var (t, a) =
-					      if (Vector.exists
-						  (tyvars, fn a' =>
-						   Tyvar.equals (a, a')))
-						 then Xtype.unit
-					      else t
-					   val {destroy, hom} =
-					      Xtype.makeHom {con = con,
-							     var = var}
-					   val pat =
-					      NestedPat.replaceTypes
-					      (pat, hom)
-					   val _ = destroy ()
-					in
-					   pat
-					end
-				     val e =
-					if NestedPat.isRefutable pat
-					   then
-					       let
-						  val targs =
-						     Vector.map (tyvars, fn _ =>
-								 Xtype.unit)
-						  val pat = instantiatePat ()
-					       in
-						  patDec
-						  (pat,
-						   Xexp.var
-						   {targs = targs,
-						    ty = NestedPat.ty pat,
-						    var = x},
-						   patRegion,
-						   e,
-						   bodyType,
-						   true)
-					       end
-					else e
-				  in
-				     valDec (tyvars, x, exp, expType, e)
-				  end
-		      end)
-	       in
-		  if 0 = Vector.length rvbs
-		     then e
-		  else
-		     Xexp.lett {decs = [Xdec.Fun {decs = processLambdas rvbs,
-						  tyvars = tyvars}],
-				body = e}
-	       end
-	 end
+(*          datatype z = datatype Cdec.t *)
+            open Cdec
+         in
+            case d of
+               Datatype _ => e
+             | Exception {arg, con} =>
+                  prefix (Xdec.Exception {arg = Option.map (arg, loopTy),
+                                          con = con})
+             | Fun {decs, tyvars} =>
+                  prefix (Xdec.Fun {decs = processLambdas decs,
+                                    tyvars = tyvars ()})
+             | Val {nonexhaustiveExnMatch, nonexhaustiveMatch, rvbs, tyvars, vbs} =>
+               let
+                  val tyvars = tyvars ()
+                  val bodyType = et
+                  val e =
+                     Vector.foldr
+                     (vbs, e, fn ({exp, lay, pat, patRegion}, e) =>
+                      let
+                         fun patDec (p: NestedPat.t,
+                                     e: Xexp.t,
+                                     body: Xexp.t,
+                                     bodyType: Xtype.t,
+                                     mayWarn: bool) =
+                            casee {caseType = bodyType,
+                                   cases = Vector.new1 {exp = body,
+                                                        lay = SOME lay,
+                                                        pat = p},
+                                   conTycon = conTycon,
+                                   kind = "declaration",
+                                   lay = lay,
+                                   noMatch = Cexp.RaiseBind,
+                                   nonexhaustiveExnMatch = nonexhaustiveExnMatch,
+                                   nonexhaustiveMatch = if mayWarn
+                                                           then nonexhaustiveMatch
+                                                        else Control.Elaborate.DiagEIW.Ignore,
+                                   redundantMatch = Control.Elaborate.DiagEIW.Ignore,
+                                   region = patRegion,
+                                   test = (e, NestedPat.ty p),
+                                   tyconCons = tyconCons}
+                         val isExpansive = Cexp.isExpansive exp
+                         val (exp, expType) = loopExp exp
+                         val pat = loopPat pat
+                         fun vd (x: Var.t) = valDec (tyvars, x, exp, expType, e)
+                      in
+                         if Vector.isEmpty tyvars orelse isExpansive
+                            then
+                               let
+                                  val (pat, exp) =
+                                     if Vector.isEmpty tyvars
+                                        then (pat, exp)
+                                     else
+                                        let
+                                           val x = Var.newNoname ()
+                                           val thunk =
+                                              let
+                                                 open Xexp
+                                              in
+                                                 toExp
+                                                 (lambda
+                                                  {arg = Var.newNoname (),
+                                                   argType = Xtype.unit,
+                                                   body = exp,
+                                                   bodyType = expType,
+                                                   mayInline = true})
+                                              end
+                                           val thunkTy =
+                                              Xtype.arrow (Xtype.unit, expType)
+                                           fun subst t =
+                                              Xtype.substitute
+                                              (t, Vector.map (tyvars, fn a =>
+                                                              (a, Xtype.unit)))
+                                           val body =
+                                              Xexp.app
+                                              {arg = Xexp.unit (),
+                                               func =
+                                               Xexp.var
+                                               {targs = (Vector.map
+                                                         (tyvars, fn _ =>
+                                                          Xtype.unit)),
+                                                ty = subst thunkTy,
+                                                var = x},
+                                               ty = subst expType}
+                                           val decs =
+                                              [Xdec.PolyVal {exp = thunk, 
+                                                             ty = thunkTy,
+                                                             tyvars = tyvars,
+                                                             var = x}]
+                                        in
+                                           (NestedPat.replaceTypes (pat, subst),
+                                            Xexp.lett {body = body, decs = decs})
+                                        end
+                               in
+                                  patDec (pat, exp, e, bodyType, true)
+                               end
+                         else
+                            case NestedPat.node pat of
+                               NestedPat.Wild => vd (Var.newNoname ())
+                             | NestedPat.Var x => vd x
+                             | _ =>
+                                  (* Polymorphic pattern.
+                                   *  val 'a Foo (y1, y2) = e
+                                   * Expands to
+                                   *  val 'a x = e
+                                   *  val Foo _ = x
+                                   *  val 'a y1 = case x of Foo (y1', _) => y1'
+                                   *  val 'a y2 = case x of Foo (_, y2') => y2'
+                                   *)
+                                  let
+                                     val x = Var.newNoname ()
+                                     val xt = expType
+                                     val targs = Vector.map (tyvars, Xtype.var)
+                                     val e =
+                                        List.fold
+                                        (NestedPat.varsAndTypes pat, e,
+                                         fn ((y, yt), e) =>
+                                         let
+                                            val y' = Var.new y
+                                            val pat =
+                                               NestedPat.removeOthersReplace
+                                               (pat, {old = y, new = y'})
+                                         in
+                                            valDec
+                                            (tyvars,
+                                             y,
+                                             patDec (pat,
+                                                     Xexp.var {targs = targs,
+                                                               ty = xt,
+                                                               var = x},
+                                                     Xexp.monoVar (y', yt),
+                                                     yt,
+                                                     false),
+                                             yt,
+                                             e)
+                                         end)
+                                     fun instantiatePat () =
+                                        let
+                                           val pat = NestedPat.removeVars pat
+                                           fun con (_, c, ts) = Xtype.con (c, ts)
+                                           fun var (t, a) =
+                                              if (Vector.exists
+                                                  (tyvars, fn a' =>
+                                                   Tyvar.equals (a, a')))
+                                                 then Xtype.unit
+                                              else t
+                                           val {destroy, hom} =
+                                              Xtype.makeHom {con = con,
+                                                             var = var}
+                                           val pat =
+                                              NestedPat.replaceTypes
+                                              (pat, hom)
+                                           val _ = destroy ()
+                                        in
+                                           pat
+                                        end
+                                     val e =
+                                        if NestedPat.isRefutable pat
+                                           then
+                                               let
+                                                  val targs =
+                                                     Vector.map (tyvars, fn _ =>
+                                                                 Xtype.unit)
+                                                  val pat = instantiatePat ()
+                                               in
+                                                  patDec
+                                                  (pat,
+                                                   Xexp.var
+                                                   {targs = targs,
+                                                    ty = NestedPat.ty pat,
+                                                    var = x},
+                                                   e,
+                                                   bodyType,
+                                                   true)
+                                               end
+                                        else e
+                                  in
+                                     valDec (tyvars, x, exp, expType, e)
+                                  end
+                      end)
+               in
+                  if 0 = Vector.length rvbs
+                     then e
+                  else
+                     Xexp.lett {decs = [Xdec.Fun {decs = processLambdas rvbs,
+                                                  tyvars = tyvars}],
+                                body = e}
+               end
+         end
       and loopDecs (ds: Cdec.t vector, (e: Xexp.t, t: Xtype.t)): Xexp.t =
          Vector.foldr (ds, e, fn (d, e) => loopDec (d, e, t))
       and loopExp (e: Cexp.t): Xexp.t * Xtype.t =
-	 let
-	    val (n, ty) = Cexp.dest e
-	    val ty = loopTy ty
-	    fun conApp {arg, con, targs, ty} =
-	       if Con.equals (con, Con.reff)
-		  then Xexp.primApp {args = Vector.new1 arg,
-				     prim = Prim.reff,
-				     targs = targs,
-				     ty = ty}
-	       else Xexp.conApp {arg = SOME arg,
-				 con = con,
-				 targs = targs,
-				 ty = ty}
-	    datatype z = datatype Cexp.node
-	    val exp =
-	       case n of
-		  App (e1, e2) =>
-		     let
-			val (e2, _) = loopExp e2
-		     in
-			case Cexp.node e1 of
-			   Con (con, targs) =>
-			      conApp {arg = e2,
-				      con = con,
-				      targs = conTargs (con, targs),
-				      ty = ty}
-			 | _ => 
-			      Xexp.app {arg = e2,
-					func = #1 (loopExp e1),
-					ty = ty}
-		     end
-		| Case {kind, lay, noMatch, region, rules, test, warnMatch, ...} =>
-		     casee {caseType = ty,
-			    cases = Vector.map (rules, fn {exp, lay, pat} =>
-						{exp = #1 (loopExp exp),
-						 lay = lay,
-						 pat = loopPat pat}),
-			    conTycon = conTycon,
-			    kind = kind,
-			    lay = lay,
-			    mayWarn = warnMatch,
-			    noMatch = noMatch,
-			    region = region,
-			    test = loopExp test,
-			    tyconCons = tyconCons}
-		| Con (con, targs) =>
-		     let
-			val targs = conTargs (con, targs)
-		     in
-			case Xtype.deArrowOpt ty of
-			   NONE =>
-			      Xexp.conApp {arg = NONE,
-					   con = con,
-					   targs = targs,
-					   ty = ty}
-			 | SOME (argType, bodyType) =>
-			      let
-				 val arg = Var.newNoname ()
-			      in
-				 Xexp.lambda
-				 {arg = arg,
-				  argType = argType,
-				  body = (conApp
-					  {arg = Xexp.monoVar (arg, argType),
-					   con = con,
-					   targs = targs,
-					   ty = bodyType}),
-				  bodyType = bodyType,
-				  mayInline = true}
-			      end
-		     end
-		| Const f =>
-		     let
-			val c = f ()
-		     in
-			if Xtype.equals (ty, Xtype.bool)
-			   then
-			      (case c of
-				  Const.Word w =>
-				     if WordX.isZero w
-					then Xexp.falsee ()
-				     else Xexp.truee ()
-				| _ => Error.bug "strange boolean constant")
-			else Xexp.const c
-		     end
-		| EnterLeave (e, si) =>
-		     let
-			val (e, t) = loopExp e
-		     in
-			Xexp.fromExp (Xml.Exp.enterLeave (Xexp.toExp e, t, si),
-				      t)
-		     end
-		| Handle {catch = (x, t), handler, try} =>
-		     Xexp.handlee {catch = (x, loopTy t),
-				   handler = #1 (loopExp handler),
-				   try = #1 (loopExp try),
-				   ty = ty}
-		| Lambda l => Xexp.lambda (loopLambda l)
-		| Let (ds, e) => loopDecs (ds, loopExp e)
-		| List es =>
-		     let
-			(* Must evaluate list components left-to-right if there
-			 * is more than one expansive expression.
-			 *)
-			val numExpansive =
-			   Vector.fold (es, 0, fn (e, n) =>
-					if Cexp.isExpansive e then n + 1 else n)
-		     in
-			Xexp.list (Vector.map (es, #1 o loopExp), ty,
-				   {forceLeftToRight = 2 <= numExpansive})
-		     end
-		| PrimApp {args, prim, targs} =>
-		     let
-			val args = Vector.map (args, #1 o loopExp)
-			datatype z = datatype Prim.Name.t
-		     in
-			if (case Prim.name prim of
-			       Real_toReal (s1, s2) =>
-				  RealSize.equals (s1, s2)
-			     | String_toWord8Vector => true
-			     | Word8Vector_toString => true
-			     | Word_toWord (s1, s2, _) => 
-				  WordSize.equals (s1, s2)
-			     | _ => false)
-			   then Vector.sub (args, 0)
-			else
-			   Xexp.primApp {args = args,
-					 prim = Prim.map (prim, loopTy),
-					 targs = Vector.map (targs, loopTy),
-					 ty = ty}
+         let
+            val (n, ty) = Cexp.dest e
+            val ty = loopTy ty
+            fun conApp {arg, con, targs, ty} =
+               if Con.equals (con, Con.reff)
+                  then Xexp.primApp {args = Vector.new1 arg,
+                                     prim = Prim.reff,
+                                     targs = targs,
+                                     ty = ty}
+               else Xexp.conApp {arg = SOME arg,
+                                 con = con,
+                                 targs = targs,
+                                 ty = ty}
+            datatype z = datatype Cexp.node
+            val exp =
+               case n of
+                  App (e1, e2) =>
+                     let
+                        val (e2, _) = loopExp e2
+                     in
+                        case Cexp.node e1 of
+                           Con (con, targs) =>
+                              conApp {arg = e2,
+                                      con = con,
+                                      targs = conTargs (con, targs),
+                                      ty = ty}
+                         | _ => 
+                              Xexp.app {arg = e2,
+                                        func = #1 (loopExp e1),
+                                        ty = ty}
+                     end
+                | Case {kind, lay, noMatch,
+                        nonexhaustiveExnMatch, nonexhaustiveMatch, redundantMatch, 
+                        region, rules, test, ...} =>
+                     casee {caseType = ty,
+                            cases = Vector.map (rules, fn {exp, lay, pat} =>
+                                                {exp = #1 (loopExp exp),
+                                                 lay = lay,
+                                                 pat = loopPat pat}),
+                            conTycon = conTycon,
+                            kind = kind,
+                            lay = lay,
+                            noMatch = noMatch,
+                            nonexhaustiveExnMatch = nonexhaustiveExnMatch,
+                            nonexhaustiveMatch = nonexhaustiveMatch,
+                            redundantMatch = redundantMatch,
+                            region = region,
+                            test = loopExp test,
+                            tyconCons = tyconCons}
+                | Con (con, targs) =>
+                     let
+                        val targs = conTargs (con, targs)
+                     in
+                        case Xtype.deArrowOpt ty of
+                           NONE =>
+                              Xexp.conApp {arg = NONE,
+                                           con = con,
+                                           targs = targs,
+                                           ty = ty}
+                         | SOME (argType, bodyType) =>
+                              let
+                                 val arg = Var.newNoname ()
+                              in
+                                 Xexp.lambda
+                                 {arg = arg,
+                                  argType = argType,
+                                  body = (conApp
+                                          {arg = Xexp.monoVar (arg, argType),
+                                           con = con,
+                                           targs = targs,
+                                           ty = bodyType}),
+                                  bodyType = bodyType,
+                                  mayInline = true}
+                              end
+                     end
+                | Const f =>
+                     let
+                        val c = f ()
+                     in
+                        if Xtype.equals (ty, Xtype.bool)
+                           then
+                              (case c of
+                                  Const.Word w =>
+                                     if WordX.isZero w
+                                        then Xexp.falsee ()
+                                     else Xexp.truee ()
+                                | _ => Error.bug "Defunctorize.loopExp: Const:strange boolean constant")
+                        else Xexp.const c
+                     end
+                | EnterLeave (e, si) =>
+                     let
+                        val (e, t) = loopExp e
+                     in
+                        enterLeave (e, t, si)
+                     end
+                | Handle {catch = (x, t), handler, try} =>
+                     Xexp.handlee {catch = (x, loopTy t),
+                                   handler = #1 (loopExp handler),
+                                   try = #1 (loopExp try),
+                                   ty = ty}
+                | Lambda l => Xexp.lambda (loopLambda l)
+                | Let (ds, e) => loopDecs (ds, loopExp e)
+                | List es =>
+                     let
+                        (* Must evaluate list components left-to-right if there
+                         * is more than one expansive expression.
+                         *)
+                        val numExpansive =
+                           Vector.fold (es, 0, fn (e, n) =>
+                                        if Cexp.isExpansive e then n + 1 else n)
+                     in
+                        Xexp.list (Vector.map (es, #1 o loopExp), ty,
+                                   {forceLeftToRight = 2 <= numExpansive})
+                     end
+                | PrimApp {args, prim, targs} =>
+                     let
+                        val args = Vector.map (args, #1 o loopExp)
+                        datatype z = datatype Prim.Name.t
+                     in
+                        if (case Prim.name prim of
+                               Real_toReal (s1, s2) =>
+                                  RealSize.equals (s1, s2)
+                             | String_toWord8Vector => true
+                             | Word8Vector_toString => true
+                             | Word_toWord (s1, s2, _) => 
+                                  WordSize.equals (s1, s2)
+                             | _ => false)
+                           then Vector.sub (args, 0)
+                        else
+                           Xexp.primApp {args = args,
+                                         prim = Prim.map (prim, loopTy),
+                                         targs = Vector.map (targs, loopTy),
+                                         ty = ty}
 
-		     end
-		| Raise e => Xexp.raisee (#1 (loopExp e), {extend = true}, ty)
-		| Record r =>
-		     (* The components of the record have to be evaluated left to 
-		      * right as they appeared in the source program, but then
-		      * ordered according to sorted field name within the tuple.
-		      *)
-		     let
-			val fes = Record.toVector r
-		     in
-			Xexp.seq
-			(Vector.map (fes, #1 o loopExp o #2), fn es =>
-			 Xexp.tuple {exps = (sortByField
-					     (Vector.map2
-					      (fes, es, fn ((f, _), e) => (f, e)))),
-				     ty = ty})
-		     end
-		| Seq es => Xexp.sequence (Vector.map (es, #1 o loopExp))
-		| Var (var, targs) =>
-		     Xexp.var {targs = Vector.map (targs (), loopTy),
-			       ty = ty,
-			       var = var ()}
-	 in
-	    (exp, ty)
-	 end
+                     end
+                | Raise e => Xexp.raisee (#1 (loopExp e), {extend = true}, ty)
+                | Record r =>
+                     (* The components of the record have to be evaluated left to 
+                      * right as they appeared in the source program, but then
+                      * ordered according to sorted field name within the tuple.
+                      *)
+                     let
+                        val fes = Record.toVector r
+                     in
+                        Xexp.seq
+                        (Vector.map (fes, #1 o loopExp o #2), fn es =>
+                         Xexp.tuple {exps = (sortByField
+                                             (Vector.map2
+                                              (fes, es, fn ((f, _), e) => (f, e)))),
+                                     ty = ty})
+                     end
+                | Seq es => Xexp.sequence (Vector.map (es, #1 o loopExp))
+                | Var (var, targs) =>
+                     Xexp.var {targs = Vector.map (targs (), loopTy),
+                               ty = ty,
+                               var = var ()}
+         in
+            (exp, ty)
+         end
       and loopLambda (l: Clambda.t) =
-	 let
-	    val {arg, argType, body, mayInline} = Clambda.dest l
-	    val (body, bodyType) = loopExp body
-	 in
-	    {arg = arg,
-	     argType = loopTy argType,
-	     body = body,
-	     bodyType = bodyType,
-	     mayInline = mayInline}
-	 end
+         let
+            val {arg, argType, body, mayInline} = Clambda.dest l
+            val (body, bodyType) = loopExp body
+         in
+            {arg = arg,
+             argType = loopTy argType,
+             body = body,
+             bodyType = bodyType,
+             mayInline = mayInline}
+         end
       val body = Xexp.toExp (loopDecs (decs, (Xexp.unit (), Xtype.unit)))
-      val _ = List.foreach (!warnings, fn f => f ())
+      val _ = List.foreach (!diagnostics, fn f => f ())
       val _ = (destroy1 (); destroy2 (); destroy3 ())
    in
       Xml.Program.T {body = body,
-		     datatypes = Vector.fromList (!datatypes),
-		     overflow = NONE}
+                     datatypes = Vector.fromList (!datatypes),
+                     overflow = NONE}
    end
 
 val defunctorize =
-   Trace.trace ("defunctorize", CoreML.Program.layout, Xml.Program.layout)
+   Trace.trace 
+   ("Defunctorize.defunctorize", 
+    CoreML.Program.layout, Xml.Program.layout)
    defunctorize
 
 end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/defunctorize/defunctorize.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/defunctorize/defunctorize.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/defunctorize/defunctorize.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,8 +1,8 @@
-(* Copyright (C) 2003-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 2003-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 signature DEFUNCTORIZE_STRUCTS = 

Modified: mlton/branches/on-20050420-cmm-branch/mlton/defunctorize/sources.cm
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/defunctorize/sources.cm	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/defunctorize/sources.cm	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,11 @@
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 Group
 
 functor Defunctorize

Modified: mlton/branches/on-20050420-cmm-branch/mlton/defunctorize/sources.mlb
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/defunctorize/sources.mlb	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/defunctorize/sources.mlb	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,19 +1,20 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 local
-    ../../lib/mlton/sources.mlb
-    ../control/sources.mlb
-    ../core-ml/sources.mlb
-    ../match-compile/sources.mlb
-    ../xml/sources.mlb
+   ../../lib/mlton/sources.mlb
+   ../control/sources.mlb
+   ../core-ml/sources.mlb
+   ../match-compile/sources.mlb
+   ../xml/sources.mlb
 
-    defunctorize.sig
-    defunctorize.fun
+   defunctorize.sig
+   defunctorize.fun
 in
-    functor Defunctorize
-end
\ No newline at end of file
+   functor Defunctorize
+end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/elaborate/decs.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/elaborate/decs.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/elaborate/decs.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 functor Decs (S: DECS_STRUCTS): DECS =
 struct
 

Modified: mlton/branches/on-20050420-cmm-branch/mlton/elaborate/decs.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/elaborate/decs.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/elaborate/decs.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature DECS_STRUCTS =
    sig
       structure CoreML: CORE_ML
@@ -15,7 +16,7 @@
       include DECS_STRUCTS
       
       type dec = CoreML.Dec.t
-	 
+         
       type t
 
       val add: t * dec -> t      (* add a dec to the end of the list *)

Modified: mlton/branches/on-20050420-cmm-branch/mlton/elaborate/elaborate-core.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/elaborate/elaborate-core.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/elaborate/elaborate-core.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,9 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 functor ElaborateCore (S: ELABORATE_CORE_STRUCTS): ELABORATE_CORE = 
@@ -15,8 +15,10 @@
    open Control.Elaborate
 in
    val allowRebindEquals = fn () => current allowRebindEquals
-   val sequenceUnit = fn () => current sequenceUnit
-   val warnMatch = fn () => current warnMatch
+   val nonexhaustiveExnMatch = fn () => current nonexhaustiveExnMatch
+   val nonexhaustiveMatch = fn () => current nonexhaustiveMatch
+   val redundantMatch = fn () => current redundantMatch
+   val sequenceNonUnit = fn () => current sequenceNonUnit
 end
 
 local
@@ -38,7 +40,8 @@
    structure Longvid = Longvid
    structure Longtycon = Longtycon
    structure PrimKind = PrimKind
-   structure Attribute = PrimKind.Attribute
+   structure ImportExportAttribute = PrimKind.ImportExportAttribute
+   structure SymbolAttribute = PrimKind.SymbolAttribute
    structure Priority = Priority
    structure Record = Record
    structure SortedRecord = SortedRecord
@@ -74,7 +77,7 @@
    structure CFunction = CFunction
    structure CType = CType
    structure CharSize = CharSize
-   structure Convention	 = CFunction.Convention	
+   structure Convention  = CFunction.Convention 
    structure Con = Con
    structure Const = Const
    structure ConstType = Const.ConstType
@@ -105,7 +108,7 @@
 end
 
 structure Parse = PrecedenceParse (structure Ast = Ast
-				   structure Env = Env)
+                                   structure Env = Env)
 
 structure Scope = Scope (structure Ast = Ast)
 
@@ -114,19 +117,19 @@
       open Apat
 
       fun getName (p: t): string option =
-	 case node p of
-	    Var {name, ...} => SOME (Longvid.toString name)
-	  | Constraint (p, _) => getName p
-	  | FlatApp v =>
-	       if 1 = Vector.length v
-		  then getName (Vector.sub (v, 0))
-	       else NONE
-	  | Layered {var, ...} => SOME (Avar.toString var)
-	  | _ => NONE
+         case node p of
+            Var {name, ...} => SOME (Longvid.toString name)
+          | Constraint (p, _) => getName p
+          | FlatApp v =>
+               if 1 = Vector.length v
+                  then getName (Vector.sub (v, 0))
+               else NONE
+          | Layered {var, ...} => SOME (Avar.toString var)
+          | _ => NONE
 
       val getName =
-	 Trace.trace ("Apat.getName", layout, Option.layout String.layout)
-	 getName
+         Trace.trace ("ElaborateCore.Apat.getName", layout, Option.layout String.layout)
+         getName
    end
 
 structure Lookup =
@@ -139,55 +142,55 @@
 fun elaborateType (ty: Atype.t, lookup: Lookup.t): Type.t =
    let 
       fun loop (ty: Atype.t): Type.t =
-	 case Atype.node ty of
-	    Atype.Var a => (* rule 44 *)
-	       Type.var a
-	  | Atype.Con (c, ts) => (* rules 46, 47 *)
-	       let
-		  val ts = Vector.map (ts, loop)
-		  fun normal () =
-		     case lookup c of
-			NONE => Type.new ()
-		      | SOME s => 
-			   let
-			      val kind = TypeStr.kind s
-			      val numArgs = Vector.length ts
-			   in
-			      if (case kind of
-				     Kind.Arity n => n = numArgs
-				   | Kind.Nary => true)
-				 then TypeStr.apply (s, ts)
-			      else
-				 let
-				    open Layout
-				    val _ = 
-				       Control.error
-				       (Atype.region ty,
-					seq [str "type ",
-					     Ast.Longtycon.layout c,
-					     str " given ",
-					     Int.layout numArgs,
-					     str (if numArgs = 1
-						     then " argument"
-						  else " arguments"),
-					     str " but wants ",
-					     Kind.layout kind],
-					empty)
-				 in
-				    Type.new ()
-				 end
-			   end
-	       in
-		  case (Ast.Longtycon.split c, Vector.length ts) of
-		     (([], c), 2) =>
-			if Ast.Tycon.equals (c, Ast.Tycon.arrow)
-			   then Type.arrow (Vector.sub (ts, 0),
-					    Vector.sub (ts, 1))
-			else normal ()
-		   | _ => normal ()
-	       end
-	  | Atype.Record r => (* rules 45, 49 *)
-	       Type.record (SortedRecord.map (r, loop))
+         case Atype.node ty of
+            Atype.Var a => (* rule 44 *)
+               Type.var a
+          | Atype.Con (c, ts) => (* rules 46, 47 *)
+               let
+                  val ts = Vector.map (ts, loop)
+                  fun normal () =
+                     case lookup c of
+                        NONE => Type.new ()
+                      | SOME s => 
+                           let
+                              val kind = TypeStr.kind s
+                              val numArgs = Vector.length ts
+                           in
+                              if (case kind of
+                                     Kind.Arity n => n = numArgs
+                                   | Kind.Nary => true)
+                                 then TypeStr.apply (s, ts)
+                              else
+                                 let
+                                    open Layout
+                                    val _ = 
+                                       Control.error
+                                       (Atype.region ty,
+                                        seq [str "type ",
+                                             Ast.Longtycon.layout c,
+                                             str " given ",
+                                             Int.layout numArgs,
+                                             str (if numArgs = 1
+                                                     then " argument"
+                                                  else " arguments"),
+                                             str " but wants ",
+                                             Kind.layout kind],
+                                        empty)
+                                 in
+                                    Type.new ()
+                                 end
+                           end
+               in
+                  case (Ast.Longtycon.split c, Vector.length ts) of
+                     (([], c), 2) =>
+                        if Ast.Tycon.equals (c, Ast.Tycon.arrow)
+                           then Type.arrow (Vector.sub (ts, 0),
+                                            Vector.sub (ts, 1))
+                        else normal ()
+                   | _ => normal ()
+               end
+          | Atype.Record r => (* rules 45, 49 *)
+               Type.record (SortedRecord.map (r, loop))
    in
       loop ty
    end
@@ -196,120 +199,123 @@
 
 val freeTyvarChecks: (unit -> unit) list ref = ref []
 
+val sequenceTypeChecks: (unit -> unit) list ref = ref []
+
 val {hom = typeTycon: Type.t -> Tycon.t option, ...} =
    Type.makeHom {con = fn (c, _) => SOME c,
-		 expandOpaque = false,
-		 var = fn _ => NONE}
+                 expandOpaque = false,
+                 var = fn _ => NONE}
 
 val typeTycon =
-   Trace.trace ("typeTycon", Type.layout, Option.layout Tycon.layout) typeTycon
+   Trace.trace 
+   ("ElaborateCore.typeTycon", Type.layout, Option.layout Tycon.layout) 
+   typeTycon
 
 fun 'a elabConst (c: Aconst.t,
-		  make: (unit -> Const.t) * Type.t -> 'a,
-		  {false = f: 'a, true = t: 'a}): 'a =
+                  make: (unit -> Const.t) * Type.t -> 'a,
+                  {false = f: 'a, true = t: 'a}): 'a =
    let
       fun error (ty: Type.t): unit =
-	 let
-	    open Layout
-	 in
-	    Control.error
-	    (Aconst.region c,
-	     seq [Type.layoutPretty ty, str " too big: ", Aconst.layout c],
-	     empty)
-	 end
+         let
+            open Layout
+         in
+            Control.error
+            (Aconst.region c,
+             seq [Type.layoutPretty ty, str " too big: ", Aconst.layout c],
+             empty)
+         end
       fun ensureChar (cs: CharSize.t, ch: IntInf.t): unit =
-	 if CharSize.isInRange (cs, ch)
-	    then ()
-	 else
-	    let
-	       open Layout
-	    in
-	       Control.error (Aconst.region c,
-			      str (concat
-				   ["character too big: ",
-				    "#\"", Aconst.ordToString ch, "\""]),
-			      empty)
-	    end
+         if CharSize.isInRange (cs, ch)
+            then ()
+         else
+            let
+               open Layout
+            in
+               Control.error (Aconst.region c,
+                              str (concat
+                                   ["character too big: ",
+                                    "#\"", Aconst.ordToString ch, "\""]),
+                              empty)
+            end
       fun choose (tycon, all, sizeTycon, make) =
-	 case List.peek (all, fn s => Tycon.equals (tycon, sizeTycon s)) of
-	    NONE => Const.string "<bogus>"
-	  | SOME s => make s
-      fun now (c: Const.t, ty: Type.t): 'a = make (fn () => c, ty)
+         case List.peek (all, fn s => Tycon.equals (tycon, sizeTycon s)) of
+            NONE => Const.string "<bogus>"
+          | SOME s => make s
       fun delay (ty: unit -> Type.t, resolve: Type.t -> Const.t): 'a =
-	 let
-	    val ty = ty ()
-	    val resolve = Promise.lazy (fn () => resolve ty)
-	    val _ = List.push (overloads, (Priority.default, ignore o resolve))
-	 in
-	    make (resolve, ty)
-	 end
+         let
+            val ty = ty ()
+            val resolve = Promise.lazy (fn () => resolve ty)
+            val _ = List.push (overloads, (Priority.default, ignore o resolve))
+         in
+            make (resolve, ty)
+         end
       val typeTycon =
-	 fn ty =>
-	 case typeTycon ty of
-	    NONE => Tycon.bogus
-	  | SOME c => c
+         fn ty =>
+         case typeTycon ty of
+            NONE => Tycon.bogus
+          | SOME c => c
    in
       case Aconst.node c of
-	 Aconst.Bool b => if b then t else f
+         Aconst.Bool b => if b then t else f
        | Aconst.Char c =>
-	    delay
-	    (Type.unresolvedChar, fn ty =>
-	     choose (typeTycon ty,
-		     List.map ([8, 16, 32], WordSize.fromBits o Bits.fromInt),
-		     Tycon.word,
-		     fn s =>
-		     (ensureChar (CharSize.fromBits (WordSize.bits s), c)
-		      ; Const.Word (WordX.fromIntInf (c, s)))))
+            delay
+            (Type.unresolvedChar, fn ty =>
+             choose (typeTycon ty,
+                     List.map ([8, 16, 32], WordSize.fromBits o Bits.fromInt),
+                     Tycon.word,
+                     fn s =>
+                     (ensureChar (CharSize.fromBits (WordSize.bits s), c)
+                      ; Const.Word (WordX.fromIntInf (c, s)))))
        | Aconst.Int i =>
-	    delay
-	    (Type.unresolvedInt, fn ty =>
-	     let
-		val tycon = typeTycon ty
-	     in
-		if Tycon.equals (tycon, Tycon.intInf)
-		   then Const.IntInf i
-		else
-		   choose (tycon, WordSize.all, Tycon.word, fn s =>
-			   Const.Word
-			   (if WordSize.isInRange (s, i, {signed = true})
-			       then WordX.fromIntInf (i, s)
-			    else (error ty; WordX.zero s)))
-	     end)
+            delay
+            (Type.unresolvedInt, fn ty =>
+             let
+                val tycon = typeTycon ty
+             in
+                if Tycon.equals (tycon, Tycon.intInf)
+                   then Const.IntInf i
+                else
+                   choose (tycon, WordSize.all, Tycon.word, fn s =>
+                           Const.Word
+                           (if WordSize.isInRange (s, i, {signed = true})
+                               then WordX.fromIntInf (i, s)
+                            else (error ty; WordX.zero s)))
+             end)
        | Aconst.Real r =>
-	    delay
-	    (Type.unresolvedReal, fn ty =>
-	     choose (typeTycon ty, RealSize.all, Tycon.real, fn s =>
-		     Const.Real (case RealX.make (r, s) of
-				    NONE => (error ty; RealX.zero s)
-				  | SOME r => r)))
+            delay
+            (Type.unresolvedReal, fn ty =>
+             choose (typeTycon ty, RealSize.all, Tycon.real, fn s =>
+                     Const.Real (case RealX.make (r, s) of
+                                    NONE => (error ty; RealX.zero s)
+                                  | SOME r => r)))
        | Aconst.String v =>
-	    delay
-	    (Type.unresolvedString, fn ty =>
-	     choose (typeTycon (Type.deVector ty),
-		     List.map ([8, 16, 32], WordSize.fromBits o Bits.fromInt),
-		     Tycon.word,
-		     fn s =>
-		     let
-			val cs = CharSize.fromBits (WordSize.bits s)
-		     in
-			Const.WordVector
-			(WordXVector.tabulate
-			 ({elementSize = s}, Vector.length v, fn i =>
-			  let
-			     val ch = Vector.sub (v, i)
-			     val () = ensureChar (cs, ch)
-			  in
-			     WordX.fromIntInf (ch, s)
-			  end))
-		     end))
+            delay
+            (Type.unresolvedString, fn ty =>
+             choose (typeTycon (Type.deVector ty),
+                     List.map ([8, 16, 32], WordSize.fromBits o Bits.fromInt),
+                     Tycon.word,
+                     fn s =>
+                     let
+                        val cs = CharSize.fromBits (WordSize.bits s)
+                     in
+                        Const.WordVector
+                        (WordXVector.tabulate
+                         ({elementSize = s}, Vector.length v, fn i =>
+                          let
+                             val ch = Vector.sub (v, i)
+                             val () = ensureChar (cs, ch)
+                          in
+                             WordX.fromIntInf (ch, s)
+                          end))
+                     end))
        | Aconst.Word w =>
-	    delay
-	    (Type.unresolvedWord, fn ty =>
-	     choose (typeTycon ty, WordSize.all, Tycon.word, fn s =>
-		     Const.Word
-		     (if WordSize.isInRange (s, w, {signed = false})
-			 then WordX.fromIntInf (w, s)
-		      else (error ty; WordX.zero s))))
+            delay
+            (Type.unresolvedWord, fn ty =>
+             choose (typeTycon ty, WordSize.all, Tycon.word, fn s =>
+                     Const.Word
+                     (if WordSize.isInRange (s, w, {signed = false})
+                         then WordX.fromIntInf (w, s)
+                      else (error ty; WordX.zero s))))
    end
 
 local
@@ -324,30 +330,30 @@
 val unify =
    fn (t, t', preError, error) =>
    Type.unify (t, t', {error = Control.error o error,
-		       preError = preError})
+                       preError = preError})
    
 fun unifyList (trs: (Type.t * Region.t) vector,
-	       z,
-	       lay: unit -> Layout.t): Type.t =
+               z,
+               lay: unit -> Layout.t): Type.t =
    if 0 = Vector.length trs
       then Type.list (Type.new ())
    else
       let
-	 val (t, _) = Vector.sub (trs, 0)
-	 val _ =
-	    Vector.foreach
-	    (trs, fn (t', r) =>
-	     unify (t, t', z, fn (l, l') =>
-		    (r,
-		     str "list element types disagree",
-		     align [seq [str "element:  ", l'],
-			    seq [str "previous: ", l],
-			    lay ()])))
+         val (t, _) = Vector.sub (trs, 0)
+         val _ =
+            Vector.foreach
+            (trs, fn (t', r) =>
+             unify (t, t', z, fn (l, l') =>
+                    (r,
+                     str "list element types disagree",
+                     align [seq [str "element:  ", l'],
+                            seq [str "previous: ", l],
+                            lay ()])))
       in
-	 Type.list t
+         Type.list t
       end
 
-val elabPatInfo = Trace.info "elaboratePat"
+val elabPatInfo = Trace.info "ElaborateCore.elabPat"
 
 structure Var =
    struct
@@ -361,12 +367,12 @@
 in
    fun ensureNotEquals x =
       if not (allowRebindEquals ()) andalso Avar.equals (x, eq)
-	 then
-	    let
-	       open Layout
-	    in
-	       Control.error (Avar.region x, str "= can't be redefined", empty)
-	    end
+         then
+            let
+               open Layout
+            in
+               Control.error (Avar.region x, str "= can't be redefined", empty)
+            end
       else ()
 end
 
@@ -377,7 +383,7 @@
    in
       Layout.str
       (if n <= 60
-	  then s
+          then s
        else concat [String.prefix (s, 35), "  ...  ", String.suffix (s, 25)])
    end
 
@@ -391,283 +397,295 @@
    in
       fn (p: Apat.t, E: Env.t, {bind, isRvb}, preError: unit -> unit) =>
       let
-	 val xts: (Avar.t * Var.t * Type.t) list ref = ref []
-	 fun bindToType (x: Avar.t, t: Type.t): Var.t =
-	    let
-	       val _ = ensureNotEquals x
-	       val x' = Var.fromAst x
-	       val _ =
-		  if List.exists (!xts, fn (x', _, _) => Avar.equals (x, x'))
-		     then
-			let
-			   open Layout
-			in
-			   Control.error (Avar.region x,
-					  seq [str "variable ",
-					       Avar.layout x,
-					       str " occurs more than once in pattern"],
-					  seq [str "in: ",
-					       approximate (Apat.layout p)])
-			end
-		  else ()
-	       val _ =
-		  case (List.peekMap
-			(!others, fn (p, v) =>
-			 if Vector.exists (v, fn (x', _, _) =>
-					   Avar.equals (x, x'))
-			    then SOME p
-			 else NONE)) of
-		     NONE => ()
-		   | SOME p' => 
-			let
-			   open Layout
-			in
-			   Control.error
-			   (Apat.region p,
-			    seq [str "variable ",
-				 Avar.layout x,
-				 str " occurs in multiple patterns"],
-			    align [seq [str "in: ",
-					approximate (Apat.layout p)],
-				   seq [str "and in: ",
-					approximate (Apat.layout p')]])
+         val xts: (Avar.t * Var.t * Type.t) list ref = ref []
+         fun bindToType (x: Avar.t, t: Type.t): Var.t =
+            let
+               val _ = ensureNotEquals x
+               val x' = Var.fromAst x
+               val _ =
+                  if List.exists (!xts, fn (x', _, _) => Avar.equals (x, x'))
+                     then
+                        let
+                           open Layout
+                        in
+                           Control.error (Avar.region x,
+                                          seq [str "variable ",
+                                               Avar.layout x,
+                                               str " occurs more than once in pattern"],
+                                          seq [str "in: ",
+                                               approximate (Apat.layout p)])
+                        end
+                  else ()
+               val _ =
+                  case (List.peekMap
+                        (!others, fn (p, v) =>
+                         if Vector.exists (v, fn (x', _, _) =>
+                                           Avar.equals (x, x'))
+                            then SOME p
+                         else NONE)) of
+                     NONE => ()
+                   | SOME p' => 
+                        let
+                           open Layout
+                        in
+                           Control.error
+                           (Apat.region p,
+                            seq [str "variable ",
+                                 Avar.layout x,
+                                 str " occurs in multiple patterns"],
+                            align [seq [str "in: ",
+                                        approximate (Apat.layout p)],
+                                   seq [str "and in: ",
+                                        approximate (Apat.layout p')]])
 
-			end
-	       val _ = List.push (xts, (x, x', t))
-	       val _ =
-		  if bind
-		     then Env.extendVar (E, x, x', Scheme.fromType t,
-					 {isRebind = false})
-		  else ()
-	    in
-	       x'
-	    end
-	 fun bind (x: Avar.t): Var.t * Type.t =
-	    let
-	       val t = Type.new ()
-	    in
-	       (bindToType (x, t), t)
-	    end
-	 fun loop arg: Cpat.t =
-	    Trace.traceInfo' (elabPatInfo, Apat.layout, Cpat.layout)
-	    (fn p: Apat.t =>
-	     let
-		val region = Apat.region p
-		val unify = fn (t, t', f) => unify (t, t', preError, f)
-		fun unifyPatternConstraint (p, lay, c) =
-		   unify
-		   (p, c, fn (l1, l2) =>
-		    (region,
-		     str "pattern and constraint disagree",
-		     align [seq [str "expects: ", l2],
-			    seq [str "but got: ", l1],
-			    seq [str "in: ", lay ()]]))
-		fun lay () = approximate (Apat.layout p)
-		fun dontCare () =
-		   Cpat.wild (Type.new ())
-	     in
-		case Apat.node p of
-		   Apat.App (c, p) =>
-		      let
-			 val (con, s) = Env.lookupLongcon (E, c)
-		      in
-			 case s of
-			    NONE => dontCare ()
-			  | SOME s => 
-			       let
-				  val {args, instance} = Scheme.instantiate s
-				  val args = args ()
-				  val p = loop p
-				  val argType = Type.new ()
-				  val resultType = Type.new ()
-				  val _ =
-				     unify
-				     (instance, Type.arrow (argType, resultType),
-				      fn _ =>
-				      (region,
-				       str "constant constructor applied to argument",
-				       seq [str "in: ", lay ()]))
-				  val _ =
-				     unify
-				     (Cpat.ty p, argType, fn (l, l') =>
-				      (region,
-				       str "constructor applied to incorrect argument",
-				       align [seq [str "expects: ", l'],
-					      seq [str "but got: ", l],
-					      seq [str "in: ", lay ()]]))
-			       in
-				  Cpat.make (Cpat.Con {arg = SOME p,
-						       con = con,
-						       targs = args},
-					     resultType)
-			       end
-		      end
-		 | Apat.Const c =>
-		      elabConst
-		      (c,
-		       fn (resolve, ty) => Cpat.make (Cpat.Const resolve, ty),
-		       {false = Cpat.falsee,
-			true = Cpat.truee})
-		 | Apat.Constraint (p, t) =>
-		      let
-			 val p' = loop p
-			 val _ =
-			    unifyPatternConstraint
-			    (Cpat.ty p', fn () => Apat.layout p,
-			     elaborateType (t, Lookup.fromEnv E))
-		      in
-			 p'
-		      end
-		 | Apat.FlatApp items =>
-		      loop (Parse.parsePat
-			    (items, E, fn () => seq [str "in: ", lay ()]))
-		 | Apat.Layered {var = x, constraint, pat, ...} =>
-		      let
-			 val t =
-			    case constraint of
-			       NONE => Type.new ()
-			     | SOME t => elaborateType (t, Lookup.fromEnv E)
-			 val x = bindToType (x, t)
-			 val pat' = loop pat
-			 val _ =
-			    unifyPatternConstraint (Cpat.ty pat',
-						    fn () => Apat.layout pat,
-						    t)
-		      in
-			 Cpat.make (Cpat.Layered (x, pat'), t)
-		      end
-		 | Apat.List ps =>
-		      let
-			 val ps' = Vector.map (ps, loop)
-		      in
-			 Cpat.make (Cpat.List ps',
-				    unifyList
-				    (Vector.map2 (ps, ps', fn (p, p') =>
-						  (Cpat.ty p', Apat.region p)),
-				     preError,
-				     fn () => seq [str "in:  ", lay ()]))
-		      end
-		 | Apat.Record {flexible, items} =>
-		      (* rules 36, 38, 39 and Appendix A, p.57 *)
-		      let
-			 val (fs, ps) =
-			    Vector.unzip
-			    (Vector.map
-			     (items,
-			      fn (f, i) =>
-			      (f,
-			       case i of
-				  Apat.Item.Field p => p
-				| Apat.Item.Vid (vid, tyo, po) =>
-				     let
-					val p =
-					   case po of
-					      NONE =>
-						 Apat.longvid (Longvid.short vid)
-					    | SOME p =>
-						 Apat.layered
-						 {fixop = Fixop.None,
-						  var = Ast.Vid.toVar vid,
-						  constraint = NONE,
-						  pat = p}
-				     in
-					case tyo of
-					   NONE => p
-					 | SOME ty => Apat.constraint (p, ty)
-				     end)))
-			 val ps = Vector.map (ps, loop)
-			 val r = SortedRecord.zip (fs, Vector.map (ps, Cpat.ty))
-			 val ty =
-			    if flexible
-			       then
-				  let
-				     val (t, isResolved) = Type.flexRecord r
-				     fun resolve () =
-					if isResolved ()
-					   then ()
-					else
-					   Control.error
-					   (region,
-					    str "unresolved ... in record pattern",
-					    seq [str "in: ", lay ()])
-				     val _ = List.push (overloads, (Priority.default, resolve))
-				  in
-				     t
-				  end
-			    else
-			       Type.record r
-		      in
-			 Cpat.make
-			 (Cpat.Record (Record.fromVector (Vector.zip (fs, ps))),
-			  ty)
-		      end
-		 | Apat.Tuple ps =>
-		      let
-			 val ps = Vector.map (ps, loop)
-		      in
-			 Cpat.make (Cpat.Tuple ps,
-				    Type.tuple (Vector.map (ps, Cpat.ty)))
-		      end
-		 | Apat.Var {name, ...} =>
-		      let
-			 val (strids, x) = Ast.Longvid.split name
-			 fun var () =
-			    let
-			       val (x, t) = bind (Ast.Vid.toVar x)
-			    in
-			       Cpat.make (Cpat.Var x, t)
-			    end
-		      in
-			 case Env.peekLongcon (E, Ast.Longvid.toLongcon name) of
-			    NONE =>
-			       if List.isEmpty strids
-				  then var ()
-			       else
-				  let
-				     val _ = 
-					Control.error
-					(region,
-					 seq [str "undefined constructor: ",
-					      Ast.Longvid.layout name],
-					 empty)
-				  in
-				     Cpat.make (Cpat.Wild, Type.new ())
-				  end
-			  | SOME (c, s) =>
-			       let
-				  val _ =
-				     if not isRvb
-					then ()
-				     else
-					Control.error
-					(region,
-					 seq [str "constructor can not be redefined by val rec: ",
-					      Ast.Longvid.layout name],
-					 empty)
-			       in
-				  case s of
-				     NONE => dontCare ()
-				   | SOME s =>
-					let 
-					   val {args, instance} =
-					      Scheme.instantiate s
-					in
-					   Cpat.make
-					   (Cpat.Con {arg = NONE,
-						      con = c,
-						      targs = args ()},
-					    instance)
-					end
-			       end
-		      end
-		 | Apat.Wild =>
-		      Cpat.make (Cpat.Wild, Type.new ())
-	     end) arg
-	 val p' = loop p
-	 val xts = Vector.fromList (!xts)
-	 val _ = List.push (others, (p, xts))
+                        end
+               val _ = List.push (xts, (x, x', t))
+               val _ =
+                  if bind
+                     then Env.extendVar (E, x, x', Scheme.fromType t,
+                                         {isRebind = false})
+                  else ()
+            in
+               x'
+            end
+         fun bind (x: Avar.t): Var.t * Type.t =
+            let
+               val t = Type.new ()
+            in
+               (bindToType (x, t), t)
+            end
+         fun loop arg: Cpat.t =
+            Trace.traceInfo' (elabPatInfo, Apat.layout, Cpat.layout)
+            (fn p: Apat.t =>
+             let
+                val region = Apat.region p
+                val unify = fn (t, t', f) => unify (t, t', preError, f)
+                fun unifyPatternConstraint (p, lay, c) =
+                   unify
+                   (p, c, fn (l1, l2) =>
+                    (region,
+                     str "pattern and constraint disagree",
+                     align [seq [str "expects: ", l2],
+                            seq [str "but got: ", l1],
+                            seq [str "in: ", lay ()]]))
+                fun lay () = approximate (Apat.layout p)
+                fun dontCare () =
+                   Cpat.wild (Type.new ())
+             in
+                case Apat.node p of
+                   Apat.App (c, p) =>
+                      let
+                         val (con, s) = Env.lookupLongcon (E, c)
+                      in
+                         case s of
+                            NONE => dontCare ()
+                          | SOME s => 
+                               let
+                                  val {args, instance} = Scheme.instantiate s
+                                  val args = args ()
+                                  val p = loop p
+                                  val argType = Type.new ()
+                                  val resultType = Type.new ()
+                                  val _ =
+                                     unify
+                                     (instance, Type.arrow (argType, resultType),
+                                      fn _ =>
+                                      (region,
+                                       str "constant constructor applied to argument",
+                                       seq [str "in: ", lay ()]))
+                                  val _ =
+                                     unify
+                                     (Cpat.ty p, argType, fn (l, l') =>
+                                      (region,
+                                       str "constructor applied to incorrect argument",
+                                       align [seq [str "expects: ", l'],
+                                              seq [str "but got: ", l],
+                                              seq [str "in: ", lay ()]]))
+                               in
+                                  Cpat.make (Cpat.Con {arg = SOME p,
+                                                       con = con,
+                                                       targs = args},
+                                             resultType)
+                               end
+                      end
+                 | Apat.Const c =>
+                      elabConst
+                      (c,
+                       fn (resolve, ty) => Cpat.make (Cpat.Const resolve, ty),
+                       {false = Cpat.falsee,
+                        true = Cpat.truee})
+                 | Apat.Constraint (p, t) =>
+                      let
+                         val p' = loop p
+                         val _ =
+                            unifyPatternConstraint
+                            (Cpat.ty p', fn () => Apat.layout p,
+                             elaborateType (t, Lookup.fromEnv E))
+                      in
+                         p'
+                      end
+                 | Apat.FlatApp items =>
+                      loop (Parse.parsePat
+                            (items, E, fn () => seq [str "in: ", lay ()]))
+                 | Apat.Layered {var = x, constraint, pat, ...} =>
+                      let
+                         val t =
+                            case constraint of
+                               NONE => Type.new ()
+                             | SOME t => elaborateType (t, Lookup.fromEnv E)
+                         val x = bindToType (x, t)
+                         val pat' = loop pat
+                         val _ =
+                            unifyPatternConstraint (Cpat.ty pat',
+                                                    fn () => Apat.layout pat,
+                                                    t)
+                      in
+                         Cpat.make (Cpat.Layered (x, pat'), t)
+                      end
+                 | Apat.List ps =>
+                      let
+                         val ps' = Vector.map (ps, loop)
+                      in
+                         Cpat.make (Cpat.List ps',
+                                    unifyList
+                                    (Vector.map2 (ps, ps', fn (p, p') =>
+                                                  (Cpat.ty p', Apat.region p)),
+                                     preError,
+                                     fn () => seq [str "in:  ", lay ()]))
+                      end
+                 | Apat.Record {flexible, items} =>
+                      (* rules 36, 38, 39 and Appendix A, p.57 *)
+                      let
+                         val (fs, ps) =
+                            Vector.unzip
+                            (Vector.map
+                             (items,
+                              fn (f, i) =>
+                              (f,
+                               case i of
+                                  Apat.Item.Field p => p
+                                | Apat.Item.Vid (vid, tyo, po) =>
+                                     let
+                                        val p =
+                                           case po of
+                                              NONE =>
+                                                 Apat.longvid (Longvid.short vid)
+                                            | SOME p =>
+                                                 Apat.layered
+                                                 {fixop = Fixop.None,
+                                                  var = Ast.Vid.toVar vid,
+                                                  constraint = NONE,
+                                                  pat = p}
+                                     in
+                                        case tyo of
+                                           NONE => p
+                                         | SOME ty => Apat.constraint (p, ty)
+                                     end)))
+                         val ps = Vector.map (ps, loop)
+                         val r = SortedRecord.zip (fs, Vector.map (ps, Cpat.ty))
+                         val ty =
+                            if flexible
+                               then
+                                  let
+                                     val (t, isResolved) = Type.flexRecord r
+                                     fun resolve () =
+                                        if isResolved ()
+                                           then ()
+                                        else
+                                           Control.error
+                                           (region,
+                                            str "unresolved ... in record pattern",
+                                            seq [str "in: ", lay ()])
+                                     val _ = List.push (overloads, (Priority.default, resolve))
+                                  in
+                                     t
+                                  end
+                            else
+                               Type.record r
+                      in
+                         Cpat.make
+                         (Cpat.Record (Record.fromVector (Vector.zip (fs, ps))),
+                          ty)
+                      end
+                 | Apat.Tuple ps =>
+                      let
+                         val ps = Vector.map (ps, loop)
+                      in
+                         Cpat.make (Cpat.Tuple ps,
+                                    Type.tuple (Vector.map (ps, Cpat.ty)))
+                      end
+                 | Apat.Var {name, ...} =>
+                      let
+                         val (strids, x) = Ast.Longvid.split name
+                         fun var () =
+                            let
+                               val (x, t) = bind (Ast.Vid.toVar x)
+                            in
+                               Cpat.make (Cpat.Var x, t)
+                            end
+                      in
+                         case Env.peekLongcon (E, Ast.Longvid.toLongcon name) of
+                            NONE =>
+                               if List.isEmpty strids
+                                  then var ()
+                               else
+                                  let
+                                     val _ = 
+                                        Control.error
+                                        (region,
+                                         seq [str "undefined constructor: ",
+                                              Ast.Longvid.layout name],
+                                         empty)
+                                  in
+                                     Cpat.make (Cpat.Wild, Type.new ())
+                                  end
+                          | SOME (c, s) =>
+                               let
+                                  val _ =
+                                     if not isRvb
+                                        then ()
+                                     else
+                                        Control.error
+                                        (region,
+                                         seq [str "constructor can not be redefined by val rec: ",
+                                              Ast.Longvid.layout name],
+                                         empty)
+                               in
+                                  case s of
+                                     NONE => dontCare ()
+                                   | SOME s =>
+                                        let 
+                                           val {args, instance} =
+                                              Scheme.instantiate s
+                                        in
+                                           if Type.canUnify
+                                              (instance,
+                                               Type.arrow (Type.new (),
+                                                           Type.new ()))
+                                              then
+                                                 (Control.error
+                                                  (region,
+                                                   seq [str "contructor must be used with argument in pattern: ",
+                                                        Ast.Longvid.layout name],
+                                                   empty)
+                                                  ; dontCare ())
+                                           else
+                                              Cpat.make
+                                              (Cpat.Con {arg = NONE,
+                                                         con = c,
+                                                         targs = args ()},
+                                               instance)
+                                        end
+                               end
+                      end
+                 | Apat.Wild =>
+                      Cpat.make (Cpat.Wild, Type.new ())
+             end) arg
+         val p' = loop p
+         val xts = Vector.fromList (!xts)
+         val _ = List.push (others, (p, xts))
       in
-	 (p', xts)
+         (p', xts)
       end
    end
 
@@ -682,409 +700,640 @@
       val layout = List.layout String.layout
    end
 
-val elabDecInfo = Trace.info "elaborateDec"
-val elabExpInfo = Trace.info "elaborateExp"
+val elabDecInfo = Trace.info "ElaborateCore.elabDec"
+val elabExpInfo = Trace.info "ElaborateCore.elabExp"
 
 structure Type =
    struct
       open Type
 
+      fun layoutPrettyBracket ty =
+         let 
+            open Layout
+         in
+            seq [str "[", layoutPretty ty, str "]"]
+         end
+
       val nullary: (string * CType.t * Tycon.t) list =
-	 let
-	    fun sized (tycon: Bits.t -> Tycon.t, ctypes) =
-	       List.map
-	       (ctypes, fn cty =>
-		let
-		   val c = tycon (Bytes.toBits (CType.size cty))
-		   val s = Tycon.toString c
-		   val s =
-		      CharVector.tabulate
-		      (String.size s, fn i =>
-		       let
-			  val c = String.sub (s, i)
-		       in
-			  if i = 0 then Char.toUpper c else c
-		       end)
-		in
-		   (s, cty, c)
-		end)
-	 in
-	    [("Bool", CType.bool, Tycon.bool),
-	     ("Pointer", CType.pointer, Tycon.pointer),
-	     ("Real32", CType.real RealSize.R32, Tycon.real RealSize.R32),
-	     ("Real64", CType.real RealSize.R64, Tycon.real RealSize.R64),
-	     ("Thread", CType.thread, Tycon.thread)]
-	    @ sized (Tycon.char o CharSize.fromBits,
-		     let
-			open CType
-		     in
-			[Int8, Int16, Int32]
-		     end)
-	    @ sized (Tycon.int o IntSize.I,
-		     let
-			open CType
-		     in
-			[Int8, Int16, Int32, Int64]
-		     end)
-	    @ sized (Tycon.word o WordSize.fromBits,
-		     let
-			open CType
-		     in
-			[Word8, Word16, Word32, Word64]
-		     end)
-	 end
+         let
+            fun sized (tycon: Bits.t -> Tycon.t, ctypes) =
+               List.map
+               (ctypes, fn cty =>
+                let
+                   val c = tycon (Bytes.toBits (CType.size cty))
+                   val s = Tycon.toString c
+                   val s =
+                      CharVector.tabulate
+                      (String.size s, fn i =>
+                       let
+                          val c = String.sub (s, i)
+                       in
+                          if i = 0 then Char.toUpper c else c
+                       end)
+                in
+                   (s, cty, c)
+                end)
+         in
+            [("Bool", CType.bool, Tycon.bool),
+             ("Pointer", CType.pointer, Tycon.pointer),
+             ("Real32", CType.real RealSize.R32, Tycon.real RealSize.R32),
+             ("Real64", CType.real RealSize.R64, Tycon.real RealSize.R64),
+             ("Thread", CType.thread, Tycon.thread)]
+            @ sized (Tycon.char o CharSize.fromBits,
+                     let
+                        open CType
+                     in
+                        [Int8, Int16, Int32]
+                     end)
+            @ sized (Tycon.int o IntSize.I,
+                     let
+                        open CType
+                     in
+                        [Int8, Int16, Int32, Int64]
+                     end)
+            @ sized (Tycon.word o WordSize.fromBits,
+                     let
+                        open CType
+                     in
+                        [Word8, Word16, Word32, Word64]
+                     end)
+         end
 
       val nullary =
-	 List.map (nullary, fn (name, ctype, tycon) =>
-		   {ctype = ctype, name = name, tycon = tycon})
+         List.map (nullary, fn (name, ctype, tycon) =>
+                   {ctype = ctype, name = name, tycon = tycon})
 
       val unary: Tycon.t list =
-	 [Tycon.array, Tycon.reff, Tycon.vector]
+         [Tycon.array, Tycon.reff, Tycon.vector]
 
       fun toCType (t: t): {ctype: CType.t, name: string} option =
-	 case deConOpt t of
-	    NONE => NONE
-	  | SOME (c, ts) =>
-	       case List.peek (nullary, fn {tycon = c', ...} =>
-			       Tycon.equals (c, c')) of
-		  NONE =>
-		     if List.exists (unary, fn c' => Tycon.equals (c, c'))
-			andalso 1 = Vector.length ts
-			andalso isSome (toCType (Vector.sub (ts, 0)))
-			then SOME {ctype = CType.pointer, name = "Pointer"}
-		     else NONE
-		| SOME {ctype, name, ...} => SOME {ctype = ctype, name = name}
+         case deConOpt t of
+            NONE => NONE
+          | SOME (c, ts) =>
+               case List.peek (nullary, fn {tycon = c', ...} =>
+                               Tycon.equals (c, c')) of
+                  NONE =>
+                     if List.exists (unary, fn c' => Tycon.equals (c, c'))
+                        andalso 1 = Vector.length ts
+                        andalso isSome (toCType (Vector.sub (ts, 0)))
+                        then SOME {ctype = CType.pointer, name = "Pointer"}
+                     else NONE
+                | SOME {ctype, name, ...} => SOME {ctype = ctype, name = name}
 
       val toCType =
-	 Trace.trace
-	 ("ElaborateCore.Type.toCType",
-	  layout,
-	  Option.layout (fn {ctype, name} =>
-			 Layout.record
-			 [("ctype", CType.layout ctype),
-			  ("name", String.layout name)]))
-	 toCType
+         Trace.trace
+         ("ElaborateCore.Type.toCType",
+          layout,
+          Option.layout (fn {ctype, name} =>
+                         Layout.record
+                         [("ctype", CType.layout ctype),
+                          ("name", String.layout name)]))
+         toCType
 
       type z = {ctype: CType.t, name: string, ty: t}
 
       fun parse (ty: t): (z vector * z option) option =
-	 case deArrowOpt ty of
-	    NONE => NONE
-	  | SOME (t1, t2) =>
-	       let
-		  fun finish (ts: z vector) =
-		     case toCType t2 of
-			NONE =>
-			   if Type.isUnit t2
-			      then SOME (ts, NONE)
-			   else NONE
-		      | SOME {ctype, name} =>
-			   SOME (ts, SOME {ctype = ctype, name = name, ty = t2})
-	       in
-		  case deTupleOpt t1 of 
-		     NONE =>
-			(case toCType t1 of
-			    NONE => NONE
-			  | SOME {ctype, name} =>
-			       finish (Vector.new1 {ctype = ctype,
-						    name = name,
-						    ty = t1}))
-		   | SOME ts =>
-			let
-			   val cts = Vector.map (ts, toCType)
-			in
-			   if Vector.forall (cts, isSome)
-			      then
-				 finish (Vector.map2
-					 (ts, cts, fn (ty, z) =>
-					  let
-					     val {ctype, name} = valOf z
-					  in
-					     {ctype = ctype,
-					      name = name,
-					      ty = ty}
-					  end))
-			   else NONE
-			end
-	       end
+         case deArrowOpt ty of
+            NONE => NONE
+          | SOME (t1, t2) =>
+               let
+                  fun finish (ts: z vector) =
+                     case toCType t2 of
+                        NONE =>
+                           if Type.isUnit t2
+                              then SOME (ts, NONE)
+                           else NONE
+                      | SOME {ctype, name} =>
+                           SOME (ts, SOME {ctype = ctype, name = name, ty = t2})
+               in
+                  case deTupleOpt t1 of 
+                     NONE =>
+                        (case toCType t1 of
+                            NONE => NONE
+                          | SOME {ctype, name} =>
+                               finish (Vector.new1 {ctype = ctype,
+                                                    name = name,
+                                                    ty = t1}))
+                   | SOME ts =>
+                        let
+                           val cts = Vector.map (ts, toCType)
+                        in
+                           if Vector.forall (cts, isSome)
+                              then
+                                 finish (Vector.map2
+                                         (ts, cts, fn (ty, z) =>
+                                          let
+                                             val {ctype, name} = valOf z
+                                          in
+                                             {ctype = ctype,
+                                              name = name,
+                                              ty = ty}
+                                          end))
+                           else NONE
+                        end
+               end
    end
 
-fun parseAttributes (attributes: Attribute.t list): Convention.t option =
+fun parseIEAttributes (attributes: ImportExportAttribute.t list): Convention.t option =
    case attributes of
       [] => SOME Convention.Cdecl
     | [a] =>
-	 SOME (case a of
-		  Attribute.Cdecl => Convention.Cdecl
-		| Attribute.Stdcall =>
-		     if let
-			   open Control
-			in
-			   case !targetOS of
-			      Cygwin => true
-			    | MinGW => true
-			    | _ => false
-			end
-			then Convention.Stdcall
-		     else Convention.Cdecl)
+         SOME (case a of
+                  ImportExportAttribute.Cdecl => Convention.Cdecl
+                | ImportExportAttribute.Stdcall =>
+                     if let
+                           open Control
+                        in
+                           case !targetOS of
+                              Cygwin => true
+                            | MinGW => true
+                            | _ => false
+                        end
+                        then Convention.Stdcall
+                     else Convention.Cdecl)
     | _ => NONE
 
-fun import {attributes: Attribute.t list,
-	    name: string option,
-	    region: Region.t,
-	    ty: Type.t}: Type.t Prim.t =
+fun import {attributes: ImportExportAttribute.t list,
+            elabedTy: Type.t,
+            expandedTy: Type.t,
+            name: string option,
+            region: Region.t}: Type.t Prim.t =
    let
       fun error l = Control.error (region, l, Layout.empty)
       fun invalidAttributes () =
-	 error (seq [str "invalid attributes for import: ",
-		     List.layout Attribute.layout attributes])
+         error (seq [str "invalid attributes for _import: ",
+                     List.layout ImportExportAttribute.layout attributes])
+      fun invalidType () =
+         Control.error 
+         (region,
+          str "invalid type for _import",
+          Type.layoutPretty elabedTy)
    in
-      case Type.parse ty of
-	 NONE =>
-	    let
-	       val () =
-		  Control.error (region,
-				 str "invalid type for import",
-				 Type.layoutPretty ty)
-	    in
-	       Prim.bogus
-	    end
+      case Type.parse expandedTy of
+         NONE =>
+            let
+               val () = invalidType ()
+            in
+               Prim.bogus
+            end
        | SOME (args, result) =>
-	    let
-	       datatype z = datatype CFunction.Target.t
-	       val convention =
-		  case parseAttributes attributes of
-		     NONE => (invalidAttributes ()
-			      ; Convention.Cdecl)
-		   | SOME c => c
-	       val addrTy = Type.word (WordSize.pointer ())
-	       val func =
-		  CFunction.T {args = let
-					 val args = Vector.map (args, #ty)
-				      in
-					 if isSome name
-					    then args
-					    else Vector.concat
-					         [Vector.new1 addrTy, args]
-				      end,
-			       bytesNeeded = NONE,
-			       convention = convention,
-			       ensuresBytesFree = false,
-			       modifiesFrontier = true,
-			       mayGC = true,
-			       maySwitchThreads = false,
-			       prototype = (Vector.map (args, #ctype),
-					    Option.map (result, #ctype)),
-			       readsStackTop = true,
-			       return = (case result of
-					    NONE => Type.unit
-					  | SOME {ty, ...} => ty),
-			       target = (case name of
-					    NONE => Indirect
-					  | SOME name => Direct name),
-			       writesStackTop = true}
-
-	    in
-	       Prim.ffi func
-	    end
+            let
+               datatype z = datatype CFunction.Target.t
+               val convention =
+                  case parseIEAttributes attributes of
+                     NONE => (invalidAttributes ()
+                              ; Convention.Cdecl)
+                   | SOME c => c
+               val addrTy = Type.word (WordSize.pointer ())
+               val func =
+                  CFunction.T {args = let
+                                         val args = Vector.map (args, #ty)
+                                      in
+                                         if isSome name
+                                            then args
+                                            else Vector.concat
+                                                 [Vector.new1 addrTy, args]
+                                      end,
+                               bytesNeeded = NONE,
+                               convention = convention,
+                               ensuresBytesFree = false,
+                               modifiesFrontier = true,
+                               mayGC = true,
+                               maySwitchThreads = false,
+                               prototype = (Vector.map (args, #ctype),
+                                            Option.map (result, #ctype)),
+                               readsStackTop = true,
+                               return = (case result of
+                                            NONE => Type.unit
+                                          | SOME {ty, ...} => ty),
+                               target = (case name of
+                                            NONE => Indirect
+                                          | SOME name => Direct name),
+                               writesStackTop = true}
+            in
+               Prim.ffi func
+            end
    end
 
-fun fetchSymbol {attributes: Attribute.t list,
-		 name: string,
-		 primApp: {args: Cexp.t vector, 
-			   prim: Type.t Prim.t, 
-			   result: Type.t} -> Cexp.t,
-		 ty: Type.t,
-		 region: Region.t}: Cexp.t =
+fun primApp {args, prim, result: Type.t} =
    let
-      fun error l = Control.error (region, l, Layout.empty)
-      fun invalidAttributes () =
-	 error (seq [str "invalid attributes for import: ",
-		     List.layout Attribute.layout attributes])
-      val bogus = primApp {args = Vector.new0 (), 
-			   prim = Prim.bogus,
-			   result = ty}
+      val targs = Prim.extractTargs (prim,
+                                     {args = Vector.map (args, Cexp.ty),
+                                      deArray = Type.deArray,
+                                      deArrow = Type.deArrow,
+                                      deVector = Type.deVector,
+                                      deWeak = Type.deWeak,
+                                      result = result})
    in
-      case Type.toCType ty of
-	 NONE => 
-	    let
-	       val () =
-		  Control.error 
-		  (region,
-		   str "invalid type for import",
-		   Type.layoutPretty ty)
-	    in
-	       bogus
-	    end
-       | SOME {ctype, ...} => 
-	    (case attributes of
-		[] => 
-		   let
-		      val isBool =
-			 case Type.deConOpt ty of
-			    NONE => false
-			  | SOME (c,_) => Tycon.equals (c, Tycon.bool)
-		      val addrTy = 
-			 Type.word (WordSize.pointer ())
-		      val addrExp = 
-			 primApp
-			 {args = Vector.new0 (),
-			  prim = Prim.ffiSymbol {name = name},
-			  result = addrTy}
-		      val zeroExp =
-			 Cexp.make
-			 (Cexp.Const
-			  (fn () => Const.word (WordX.zero WordSize.default)),
-			  Type.defaultWord)
-		      val fetchTy =
-			 if isBool then Type.defaultWord else ty
-		      val fetchExp = 
-			 primApp 
-			 {args = Vector.new2 (addrExp,zeroExp),
-			  prim = Prim.pointerGet ctype,
-			  result = fetchTy}
-		   in
-		      if isBool 
-			 then Cexp.casee
-			      {kind = "",
-			       lay = fn () => Layout.empty,
-			       noMatch = Cexp.Impossible,
-			       region = Region.bogus,
-			       rules = Vector.new2
-			               ({exp = Cexp.truee,
-					 lay = NONE,
-					 pat = Cpat.falsee},
-					{exp = Cexp.falsee,
-					 lay = NONE,
-					 pat = Cpat.truee}),
-			       test = primApp
-				      {args = Vector.new2 (fetchExp, zeroExp),
-				       prim = Prim.wordEqual WordSize.default,
-				       result = ty},
-				      warnMatch = false}
-			 else fetchExp
-		   end
-	      | _ => 
-		   (invalidAttributes ()
-		    ; bogus))
+      Cexp.make (Cexp.PrimApp {args = args,
+                               prim = prim,
+                               targs = targs},
+                 result)
    end
 
-fun symbol {name: string,
-	    ty: Type.t,
-	    region: Region.t}: Type.t Prim.t =
-   let
-      fun error l = Control.error (region, l, Layout.empty)
-   in
-      case Type.toCType ty of
-	 SOME {ctype = CType.Pointer, ...} =>
-	    Prim.ffiSymbol {name = name}
-       | _ =>
-	    let
-	       val () =
-		  Control.error (region,
-				 str "invalid type for import",
-				 Type.layoutPretty ty)
-	    in
-	       Prim.bogus
-	    end
-   end
+local
+   val zeroExp = Cexp.make (Cexp.Const
+                            (fn () => Const.word (WordX.zero WordSize.default)),
+                            Type.defaultWord)
+   val oneExp = Cexp.make (Cexp.Const
+                           (fn () => Const.word (WordX.one WordSize.default)),
+                           Type.defaultWord)
 
-fun export {attributes, name: string, region: Region.t, ty: Type.t}: Aexp.t =
+   fun mkAddress {expandedPtrTy: Type.t,
+                  name: string}: Cexp.t =
+      primApp {args = Vector.new0 (),
+               prim = Prim.ffiSymbol {name = name},
+               result = expandedPtrTy}
+
+   fun mkFetch {ctypeCbTy, isBool,
+                expandedCbTy,
+                ptrExp: Cexp.t}: Cexp.t =
+      let
+         val fetchExp = 
+            primApp {args = Vector.new2 (ptrExp, zeroExp),
+                     prim = Prim.pointerGet ctypeCbTy,
+                     result = if isBool 
+                                 then Type.defaultWord 
+                                 else expandedCbTy}
+      in
+         if not isBool then fetchExp else
+         Cexp.casee {kind = "",
+                     lay = fn () => Layout.empty,
+                     noMatch = Cexp.Impossible,
+                     nonexhaustiveExnMatch = Control.Elaborate.DiagDI.Default,
+                     nonexhaustiveMatch = Control.Elaborate.DiagEIW.Ignore,
+                     redundantMatch = Control.Elaborate.DiagEIW.Ignore,
+                     region = Region.bogus,
+                     rules = Vector.new2
+                             ({exp = Cexp.truee, lay = NONE, pat = Cpat.falsee},
+                              {exp = Cexp.falsee, lay = NONE, pat = Cpat.truee}),
+                     test = primApp
+                            {args = Vector.new2 (fetchExp, zeroExp),
+                             prim = Prim.wordEqual WordSize.default,
+                             result = expandedCbTy}}
+      end
+
+   fun mkStore {ctypeCbTy, isBool,
+                ptrExp: Cexp.t, valueExp: Cexp.t}: Cexp.t =
+      let
+         val valueExp =
+            if not isBool then valueExp else
+            Cexp.casee {kind = "",
+                        lay = fn () => Layout.empty,
+                        noMatch = Cexp.Impossible,
+                        nonexhaustiveExnMatch = Control.Elaborate.DiagDI.Default,
+                        nonexhaustiveMatch = Control.Elaborate.DiagEIW.Ignore,
+                        redundantMatch = Control.Elaborate.DiagEIW.Ignore,
+                        region = Region.bogus,
+                        rules = Vector.new2 
+                                ({exp = oneExp, lay = NONE, pat = Cpat.truee},
+                                 {exp = zeroExp, lay = NONE, pat = Cpat.falsee}),
+                        test = valueExp}
+      in
+         primApp {args = Vector.new3 (ptrExp, zeroExp, valueExp),
+                  prim = Prim.pointerSet ctypeCbTy,
+                  result = Type.unit}
+      end
+
+   fun mkSymbol {ctypeCbTy: CType.t,
+                 expandedCbTy: Type.t,
+                 ptrExp: Cexp.t}: Cexp.t =
+      let
+         val isBool = Type.isBool expandedCbTy
+         val getArg = Var.newNoname ()
+         val setArg = Var.newNoname ()
+      in
+         (Cexp.tuple o Vector.new2)
+         ((Cexp.lambda o Lambda.make)
+          {arg = getArg,
+           argType = Type.unit,
+           body = mkFetch {ctypeCbTy = ctypeCbTy, 
+                           isBool = isBool,
+                           expandedCbTy = expandedCbTy,
+                           ptrExp = ptrExp},
+           mayInline = true},
+          (Cexp.lambda o Lambda.make)
+          {arg = setArg,
+           argType = expandedCbTy,
+           body = mkStore {ctypeCbTy = ctypeCbTy,
+                           isBool = isBool,
+                           ptrExp = ptrExp,
+                           valueExp = Cexp.var (setArg, expandedCbTy)},
+           mayInline = true})
+      end
+in
+   fun address {elabedTy: Type.t,
+                expandedTy: Type.t,
+                name: string,
+                region: Region.t}: Cexp.t =
+      let
+         fun error () =
+            Control.error
+            (region, str "invalid type for _address",
+             Type.layoutPretty elabedTy)
+         val expandedPtrTy = expandedTy
+         val () =
+            case Type.toCType expandedPtrTy of
+               SOME {ctype = CType.Pointer, ...} => ()
+             | _ => (error (); ())
+         val addrExp =
+            mkAddress {expandedPtrTy = expandedPtrTy,
+                       name = name}
+         fun wrap (e, t) = Cexp.make (Cexp.node e, t)
+      in
+         wrap (addrExp, elabedTy)
+      end
+
+   fun symbolDirect {attributes: SymbolAttribute.t list,
+                     elabedTy: Type.t,
+                     expandedTy: Type.t,
+                     name: string,
+                     region: Region.t}: Cexp.t =
+      let
+         fun error () =
+            Control.error
+            (region, str "invalid type for _symbol",
+             Type.layoutPretty elabedTy)
+         val expandedCbTy =
+            Exn.withEscape
+            (fn escape =>
+             let
+                val error = fn () =>
+                   (error ()
+                    ; ignore (escape Type.defaultWord)
+                    ; Error.bug "ElaborateCore.symbolDirect.escape")
+             in
+                case Type.deTupleOpt expandedTy of
+                   NONE => error ()
+                 | SOME tys => 
+                      if Vector.length tys <> 2
+                         then error ()
+                         else let
+                                 fun doit ty =
+                                    case Type.deArrowOpt ty of
+                                       NONE => error ()
+                                     | SOME tys => tys
+                                 val (getArgTy, getResTy) =
+                                    doit (Vector.sub (tys, 0))
+                                 val (setArgTy, setResTy) =
+                                    doit (Vector.sub (tys, 1))
+                                 val () =
+                                    if Type.isUnit getArgTy 
+                                       then ()
+                                       else error ()
+                                 val () =
+                                    if Type.isUnit setResTy
+                                       then ()
+                                       else error ()
+                                 val () =
+                                    if Type.canUnify (getResTy, setArgTy)
+                                       then ()
+                                       else error ()
+                              in
+                                 getResTy
+                              end
+             end)
+         val ctypeCbTy =
+            case Type.toCType expandedCbTy of
+               SOME {ctype, ...} => ctype
+             | NONE => (error (); CType.word (WordSize.default, {signed = false}))
+         val addrExp =
+            mkAddress {expandedPtrTy = Type.word (WordSize.pointer ()),
+                       name = name}
+         val () =
+            if List.exists (attributes, fn attr =>
+                            attr = SymbolAttribute.Alloc)
+               then Ffi.addSymbol {name = name, ty = ctypeCbTy}
+               else ()
+         val symExp =
+            mkSymbol {ctypeCbTy = ctypeCbTy,
+                      expandedCbTy = expandedCbTy,
+                      ptrExp = addrExp}
+         fun wrap (e, t) = Cexp.make (Cexp.node e, t)
+      in
+         wrap (symExp, elabedTy)
+      end
+
+   fun symbolIndirect {elabedTy: Type.t,
+                       expandedTy: Type.t,
+                       region: Region.t}: Cexp.t =
+      let
+         fun error () =
+            Control.error
+            (region, str "invalid type for _symbol",
+             Type.layoutPretty elabedTy)
+         val (expandedPtrTy, expandedCbTy) =
+            Exn.withEscape
+            (fn escape =>
+             let
+                val error = fn () =>
+                   (error ()
+                    ; ignore (escape (Type.pointer, Type.defaultWord))
+                    ; Error.bug "ElaborateCore.symbolIndirect.escape")
+             in
+                case Type.deArrowOpt expandedTy of
+                   NONE => error ()
+                 | SOME (ptrTy, symTy) =>
+                      (case Type.deTupleOpt symTy of
+                          NONE => error ()
+                        | SOME tys => 
+                             if Vector.length tys <> 2
+                                then error ()
+                                else let
+                                        fun doit ty =
+                                           case Type.deArrowOpt ty of
+                                              NONE => error ()
+                                            | SOME tys => tys
+                                        val (getArgTy, getResTy) =
+                                           doit (Vector.sub (tys, 0))
+                                        val (setArgTy, setResTy) =
+                                           doit (Vector.sub (tys, 1))
+                                        val () =
+                                           if Type.isUnit getArgTy 
+                                              then ()
+                                              else error ()
+                                        val () =
+                                           if Type.isUnit setResTy
+                                              then ()
+                                              else error ()
+                                        val () =
+                                           if Type.canUnify (getResTy, setArgTy)
+                                              then ()
+                                              else error ()
+                                     in
+                                        (ptrTy, getResTy)
+                                     end)
+             end)
+         val ctypeCbTy =
+            case Type.toCType expandedCbTy of
+               SOME {ctype, ...} => ctype
+             | NONE => (error (); CType.word (WordSize.default, {signed = false}))
+         val () =
+            case Type.toCType expandedPtrTy of
+               SOME {ctype = CType.Pointer, ...} => ()
+             | _ => (error (); ())
+         val ptrArg = Var.newNoname ()
+         val ptrExp = Cexp.var (ptrArg, expandedPtrTy)
+         val symExp =
+            mkSymbol {ctypeCbTy = ctypeCbTy,
+                      expandedCbTy = expandedCbTy,
+                      ptrExp = ptrExp}
+         fun wrap (e, t) = Cexp.make (Cexp.node e, t)
+      in
+         wrap ((Cexp.lambda o Lambda.make)
+               {arg = ptrArg,
+                argType = expandedPtrTy,
+                body = symExp,
+                mayInline = true},
+               elabedTy)
+      end
+
+   fun importSymbol {attributes: ImportExportAttribute.t list,
+                     elabedTy: Type.t,
+                     expandedTy: Type.t,
+                     name: string,
+                     region: Region.t}: Cexp.t =
+      let
+         val () =
+            Control.warning 
+            (region,
+             str "_import of non-function is deprecated, use _symbol",
+             empty)
+         fun invalidAttributes () =
+            Control.error 
+            (region, seq [str "invalid attributes for _import: ",
+                          List.layout ImportExportAttribute.layout attributes],
+             Layout.empty)
+         val () =
+            if List.isEmpty attributes
+               then ()
+               else invalidAttributes ()
+         fun error () =
+            Control.error
+            (region, str "invalid type for _import",
+             Type.layoutPretty elabedTy)
+         val expandedCbTy = expandedTy
+         val ctypeCbTy =
+            case Type.toCType expandedCbTy of
+               SOME {ctype, ...} => ctype
+             | NONE => (error (); CType.word (WordSize.default, {signed = false}))
+         val isBool = Type.isBool expandedCbTy
+         val addrExp =
+            mkAddress {expandedPtrTy = Type.word (WordSize.pointer ()),
+                       name = name}
+         fun wrap (e, t) = Cexp.make (Cexp.node e, t)
+      in
+         wrap (mkFetch {ctypeCbTy = ctypeCbTy, 
+                        isBool = isBool,
+                        expandedCbTy = expandedCbTy,
+                        ptrExp = addrExp},
+               elabedTy)
+      end
+end
+
+fun export {attributes: ImportExportAttribute.t list,
+            elabedTy: Type.t,
+            expandedTy: Type.t,
+            name: string, 
+            region: Region.t}: Aexp.t =
    let
       fun error l = Control.error (region, l, Layout.empty)
       fun invalidAttributes () =
-	 error (seq [str "invalid attributes for export: ",
-		     List.layout Attribute.layout attributes])
+         error (seq [str "invalid attributes for _export: ",
+                     List.layout ImportExportAttribute.layout attributes])
+      fun invalidType () =
+         Control.error 
+         (region,
+          str "invalid type for _export",
+          Type.layoutPretty elabedTy)
       val convention =
-	 case parseAttributes attributes of
-	    NONE => (invalidAttributes ()
-		     ; Convention.Cdecl)
-	  | SOME c => c
+         case parseIEAttributes attributes of
+            NONE => (invalidAttributes ()
+                     ; Convention.Cdecl)
+          | SOME c => c
       val (exportId, args, res) =
-	 case Type.parse ty of
-	    NONE =>
-	       (Control.error (region,
-			       seq [str "invalid type for exported function: ",
-				    Type.layoutPretty ty],
-			       Layout.empty)
-		; (0, Vector.new0 (), NONE))
-	  | SOME (args, result) =>
-	       let
-		  val id =
-		     Ffi.addExport {args = Vector.map (args, #ctype),
-				    convention = convention,
-				    name = name,
-				    res = Option.map (result, #ctype)}
-	       in
-		  (id, args, result)
-	       end
+         case Type.parse expandedTy of
+            NONE =>
+               (invalidType ()
+                ; (0, Vector.new0 (), NONE))
+          | SOME (args, result) =>
+               let
+                  val id =
+                     Ffi.addExport {args = Vector.map (args, #ctype),
+                                    convention = convention,
+                                    name = name,
+                                    res = Option.map (result, #ctype)}
+               in
+                  (id, args, result)
+               end
       open Ast
       fun id (name: string) =
-	 Aexp.longvid (Longvid.short
-		       (Vid.fromSymbol (Symbol.fromString name, region)))
+         Aexp.longvid (Longvid.short
+                       (Vid.fromSymbol (Symbol.fromString name, region)))
       fun int (i: int): Aexp.t =
-	 Aexp.const (Aconst.makeRegion (Aconst.Int (IntInf.fromInt i), region))
+         Aexp.const (Aconst.makeRegion (Aconst.Int (IntInf.fromInt i), region))
       val f = Var.fromSymbol (Symbol.fromString "f", region)
    in
       Exp.fnn
       (Vector.new1
        (Pat.var f,
-	Exp.app
-	(id "register",
-	 Exp.tuple
-	 (Vector.new2
-	  (int exportId,
-	   Exp.fnn
-	   (Vector.new1
-	    (Pat.tuple (Vector.new0 ()),
-	     let
-		val map = CType.memo (fn _ => Counter.new 0)
-		val varCounter = Counter.new 0
-		val (args, decs) =
-		   Vector.unzip
-		   (Vector.map
-		    (args, fn {ctype, name, ...} =>
-		     let
-			val x =
-			   Var.fromSymbol
-			   (Symbol.fromString
-			    (concat ["x",
-				     Int.toString (Counter.next varCounter)]),
-			    region)
-			val dec =
-			   Dec.vall (Vector.new0 (),
-				     x,
-				     Exp.app (id (concat ["get", name]),
-					      int (Counter.next (map ctype))))
-		     in
-			(x, dec)
-		     end))
-		val resVar = Var.fromSymbol (Symbol.fromString "res", region)
-		fun newVar () = Var.fromSymbol (Symbol.fromString "none", region)
-	     in
-		Exp.lett
-		(Vector.concat
-		 [decs,
-		  Vector.map 
-		  (Vector.new4
-		   ((newVar (), Exp.app (id "atomicEnd", Exp.unit)),
-		    (resVar, Exp.app (Exp.var f,
-				      Exp.tuple (Vector.map (args, Exp.var)))),
-		    (newVar (), Exp.app (id "atomicBegin", Exp.unit)),
-		    (newVar (),
-		     (case res of
-			 NONE => Exp.constraint (Exp.var resVar, Type.unit)
-		       | SOME {name, ...} => 
-			    Exp.app (id (concat ["set", name]),
-				     Exp.var resVar)))),
-		   fn (x, e) => Dec.vall (Vector.new0 (), x, e))],
-		 Exp.tuple (Vector.new0 ()),
-		 region)
-	     end)))))))
+        Exp.app
+        (id "register",
+         Exp.tuple
+         (Vector.new2
+          (int exportId,
+           Exp.fnn
+           (Vector.new1
+            (Pat.tuple (Vector.new0 ()),
+             let
+                val map = CType.memo (fn _ => Counter.new 0)
+                val varCounter = Counter.new 0
+                val (args, decs) =
+                   Vector.unzip
+                   (Vector.map
+                    (args, fn {ctype, name, ...} =>
+                     let
+                        val x =
+                           Var.fromSymbol
+                           (Symbol.fromString
+                            (concat ["x",
+                                     Int.toString (Counter.next varCounter)]),
+                            region)
+                        val dec =
+                           Dec.vall (Vector.new0 (),
+                                     x,
+                                     Exp.app (id (concat ["get", name]),
+                                              int (Counter.next (map ctype))))
+                     in
+                        (x, dec)
+                     end))
+                val resVar = Var.fromSymbol (Symbol.fromString "res", region)
+                fun newVar () = Var.fromSymbol (Symbol.fromString "none", region)
+             in
+                Exp.lett
+                (Vector.concat
+                 [decs,
+                  Vector.map 
+                  (Vector.new4
+                   ((newVar (), Exp.app (id "atomicEnd", Exp.unit)),
+                    (resVar, Exp.app (Exp.var f,
+                                      Exp.tuple (Vector.map (args, Exp.var)))),
+                    (newVar (), Exp.app (id "atomicBegin", Exp.unit)),
+                    (newVar (),
+                     (case res of
+                         NONE => Exp.constraint (Exp.var resVar, Type.unit)
+                       | SOME {name, ...} => 
+                            Exp.app (id (concat ["set", name]),
+                                     Exp.var resVar)))),
+                   fn (x, e) => Dec.vall (Vector.new0 (), x, e))],
+                 Exp.tuple (Vector.new0 ()),
+                 region)
+             end)))))))
    end
 
 val export =
    Trace.trace
-   ("export",
+   ("ElaborateCore.export",
     fn {name, ...} => String.layout name,
     Aexp.layout)
    export
@@ -1094,20 +1343,20 @@
       open Aexp
 
       local
-	 val x = Symbol.fromString "x"
+         val x = Symbol.fromString "x"
       in
-	 fun selector (f: Field.t, r: Region.t): t =
-	    let
-	       val x = Avar.fromSymbol (x, r)
-	    in
-	       fnn (Vector.new1
-		    (Apat.makeRegion
-		     (Apat.Record {flexible = true,
-				   items = (Vector.new1
-					    (f, Apat.Item.Field (Apat.var x)))},
-		      r),
-		     var x))
-	    end
+         fun selector (f: Field.t, r: Region.t): t =
+            let
+               val x = Avar.fromSymbol (x, r)
+            in
+               fnn (Vector.new1
+                    (Apat.makeRegion
+                     (Apat.Record {flexible = true,
+                                   items = (Vector.new1
+                                            (f, Apat.Item.Field (Apat.var x)))},
+                      r),
+                     var x))
+            end
       end
    end
 
@@ -1123,17 +1372,17 @@
       open Cexp
 
       fun enterLeave (e: t, doit: bool, si): t =
-	 if not doit
-	    (* Don't create the sourceInfo if we're in the middle of elaborating
-	     * a functor body.  Count profiling keeps track of all sourceInfos
-	     * created and would show it with a count of zero, which would be
-	     * bad.
-	     *)
-	    orelse Env.amInsideFunctor ()
-	    (* Don't create the source info if we're profiling some IL. *)
-	    orelse !Control.profileIL <> Control.ProfileSource
-	    then e
-	 else make (EnterLeave (e, si ()), ty e)
+         if not doit
+            (* Don't create the sourceInfo if we're in the middle of elaborating
+             * a functor body.  Count profiling keeps track of all sourceInfos
+             * created and would show it with a count of zero, which would be
+             * bad.
+             *)
+            orelse Env.amInsideFunctor ()
+            (* Don't create the source info if we're profiling some IL. *)
+            orelse !Control.profileIL <> Control.ProfileSource
+            then e
+         else make (EnterLeave (e, si ()), ty e)
    end
 
 (* This property must be outside of elaborateDec, since we don't want it to
@@ -1151,1587 +1400,1744 @@
       then ()
    else
       let
-	 open Layout
+         open Layout
       in
-	 Control.error 
-	 (region,
-	  str (concat (if ElabControl.expert c
-			  then [keyword, " disallowed"]
-			  else [keyword, " disallowed, compile with -default-ann '", 
-				ElabControl.name c, " true'"])),
-	  empty)
+         Control.error 
+         (region,
+          str (concat (if ElabControl.expert c
+                          then [keyword, " disallowed"]
+                          else [keyword, " disallowed, compile with -default-ann '", 
+                                ElabControl.name c, " true'"])),
+          empty)
       end
 
 fun elaborateDec (d, {env = E, nest}) =
    let
       val profileBody =
-	 let
-	    open Control
-	 in
-	    !profile <> ProfileNone
-	 end
+         let
+            open Control
+         in
+            !profile <> ProfileNone
+         end
       fun recursiveFun () =
-	 let
-	    val boundRef: (unit -> Tyvar.t vector) option ref = ref NONE
-	    val targs =
-	       Promise.lazy
-	       (fn () =>
-		case !boundRef of
-		   NONE => Error.bug "boundRef not set"
-		 | SOME f => Vector.map (f (), Type.var))
-	    fun markFunc func = recursiveTargs func := SOME targs
-	    fun unmarkFunc func = recursiveTargs func := NONE
-	    fun setBound b = boundRef := SOME b
-	 in
-	    {markFunc = markFunc,
-	     setBound = setBound,
-	     unmarkFunc = unmarkFunc}
-	 end  
+         let
+            val boundRef: (unit -> Tyvar.t vector) option ref = ref NONE
+            val targs =
+               Promise.lazy
+               (fn () =>
+                case !boundRef of
+                   NONE => Error.bug "ElaborateCore.elaborateDec: boundRef not set"
+                 | SOME f => Vector.map (f (), Type.var))
+            fun markFunc func = recursiveTargs func := SOME targs
+            fun unmarkFunc func = recursiveTargs func := NONE
+            fun setBound b = boundRef := SOME b
+         in
+            {markFunc = markFunc,
+             setBound = setBound,
+             unmarkFunc = unmarkFunc}
+         end  
       fun elabType (t: Atype.t): Type.t =
-	 elaborateType (t, Lookup.fromEnv E)
+         elaborateType (t, Lookup.fromEnv E)
       fun elabTypBind (typBind: TypBind.t) =
-	 let
-	    val TypBind.T types = TypBind.node typBind
-	    val strs =
-	       Vector.map
-	       (types, fn {def, tyvars, ...} =>
-		TypeStr.def (Scheme.make {canGeneralize = true,
-					  ty = elabType def,
-					  tyvars = tyvars},
-			     Kind.Arity (Vector.length tyvars)))
-	 in
-	    Vector.foreach2
-	    (types, strs, fn ({tycon, ...}, str) =>
-	     Env.extendTycon (E, tycon, str, {forceUsed = false,
-					      isRebind = false}))
-	 end
+         let
+            val TypBind.T types = TypBind.node typBind
+            val strs =
+               Vector.map
+               (types, fn {def, tyvars, ...} =>
+                TypeStr.def (Scheme.make {canGeneralize = true,
+                                          ty = elabType def,
+                                          tyvars = tyvars},
+                             Kind.Arity (Vector.length tyvars)))
+         in
+            Vector.foreach2
+            (types, strs, fn ({tycon, ...}, str) =>
+             Env.extendTycon (E, tycon, str, {forceUsed = false,
+                                              isRebind = false}))
+         end
       fun elabDatBind (datBind: DatBind.t, nest: string list)
-	 : Decs.t * {tycon: Ast.Tycon.t,
-		     typeStr: TypeStr.t} vector =
-	 (* rules 28, 29, 81, 82 *)
-	 let
-	    val DatBind.T {datatypes, withtypes} = DatBind.node datBind
-	    (* Build enough of an env so that that the withtypes and the
-	     * constructor argument types can be elaborated.
-	     *)
-	    val datatypes =
-	       Vector.map
-	       (datatypes, fn {cons, tycon = name, tyvars} =>
-		let
-		   val kind = Kind.Arity (Vector.length tyvars)
-		   val tycon =
-		      Env.newTycon
-		      (concat (List.separate
-			       (rev (Ast.Tycon.toString name :: nest),
-				".")),
-		       kind,
-		       AdmitsEquality.Sometimes,
-		       Ast.Tycon.region name)
-		   val _ = Env.extendTycon (E, name, TypeStr.tycon (tycon, kind),
-					    {forceUsed = true,
-					     isRebind = false})
-		   val cons =
-		      Vector.map
-		      (cons, fn (name, arg) =>
-		       {con = Con.fromAst name,
-			name = name,
-			arg = arg})
-		   val makeCons =
-		      Env.newCons (E, Vector.map (cons, fn {con, name, ...} =>
-						  {con = con, name = name}))
-		in
-		   {cons = cons,
-		    makeCons = makeCons,
-		    name = name,
-		    tycon = tycon,
-		    tyvars = tyvars}
-		end)
-	    val change = ref false
-	    fun elabAll () =
-	       (elabTypBind withtypes
-		; (Vector.map
-		   (datatypes,
-		    fn {cons, makeCons, name, tycon, tyvars} =>
-		    let
-		       val resultType: Type.t =
-			  Type.con (tycon, Vector.map (tyvars, Type.var))
-		       val (schemes, datatypeCons) =
-			  Vector.unzip
-			  (Vector.map
-			   (cons, fn {arg, con, ...} =>
-			    let
-			       val (arg, ty) =
-				  case arg of
-				     NONE => (NONE, resultType)
-				   | SOME t =>
-					let
-					   val t = elabType t
-					in
-					   (SOME t, Type.arrow (t, resultType))
-					end
-			       val scheme =
-				  Scheme.make {canGeneralize = true,
-					       ty = ty,
-					       tyvars = tyvars}
-			    in
-			       (scheme, {arg = arg, con = con})
-			    end))
-		       val _ =
-			  let
-			     val r = TypeEnv.tyconAdmitsEquality tycon
-			     datatype z = datatype AdmitsEquality.t
-			  in
-			     case !r of
-				Always => Error.bug "datatype Always"
-			      | Never => ()
-			      | Sometimes =>
-				   if Vector.forall
-				      (datatypeCons, fn {arg, ...} =>
-				       case arg of
-					  NONE => true
-					| SOME ty =>
-					     Scheme.admitsEquality
-					     (Scheme.make {canGeneralize = true,
-							   ty = ty,
-							   tyvars = tyvars}))
-				      then ()
-				   else (r := Never; change := true)
-			  end
-		    val typeStr =
-		       TypeStr.data (tycon,
-				     Kind.Arity (Vector.length tyvars),
-				     makeCons schemes)
-		    val _ =
-		       Env.extendTycon (E, name, typeStr,
-					{forceUsed = false, isRebind = true})
-		 in
-		    ({cons = datatypeCons,
-		      tycon = tycon,
-		      tyvars = tyvars},
-		     {tycon = name,
-		      typeStr = typeStr})
-		 end)))
-	    (* We don't want to re-elaborate the datatypes if there has been a
-	     * type error, because that will cause duplicate error messages.
-	     *)
-	    val numErrors = !Control.numErrors
-	    (* Maximize equality. *)
-	    fun loop () =
-	       let
-		  val res = elabAll ()
-	       in
-		  if !change andalso numErrors = !Control.numErrors
-		     then (change := false; loop ())
-		  else res
-	       end
-	    val (dbs, strs) = Vector.unzip (loop ())
-	 in
-	    (Decs.single (Cdec.Datatype dbs), strs)
-	 end
+         : Decs.t * {tycon: Ast.Tycon.t,
+                     typeStr: TypeStr.t} vector =
+         (* rules 28, 29, 81, 82 *)
+         let
+            val DatBind.T {datatypes, withtypes} = DatBind.node datBind
+            (* Build enough of an env so that that the withtypes and the
+             * constructor argument types can be elaborated.
+             *)
+            val datatypes =
+               Vector.map
+               (datatypes, fn {cons, tycon = name, tyvars} =>
+                let
+                   val kind = Kind.Arity (Vector.length tyvars)
+                   val tycon =
+                      Env.newTycon
+                      (concat (List.separate
+                               (rev (Ast.Tycon.toString name :: nest),
+                                ".")),
+                       kind,
+                       AdmitsEquality.Sometimes,
+                       Ast.Tycon.region name)
+                   val _ = Env.extendTycon (E, name, TypeStr.tycon (tycon, kind),
+                                            {forceUsed = true,
+                                             isRebind = false})
+                   val cons =
+                      Vector.map
+                      (cons, fn (name, arg) =>
+                       {con = Con.fromAst name,
+                        name = name,
+                        arg = arg})
+                   val makeCons =
+                      Env.newCons (E, Vector.map (cons, fn {con, name, ...} =>
+                                                  {con = con, name = name}))
+                in
+                   {cons = cons,
+                    makeCons = makeCons,
+                    name = name,
+                    tycon = tycon,
+                    tyvars = tyvars}
+                end)
+            val change = ref false
+            fun elabAll () =
+               (elabTypBind withtypes
+                ; (Vector.map
+                   (datatypes,
+                    fn {cons, makeCons, name, tycon, tyvars} =>
+                    let
+                       val resultType: Type.t =
+                          Type.con (tycon, Vector.map (tyvars, Type.var))
+                       val (schemes, datatypeCons) =
+                          Vector.unzip
+                          (Vector.map
+                           (cons, fn {arg, con, ...} =>
+                            let
+                               val (arg, ty) =
+                                  case arg of
+                                     NONE => (NONE, resultType)
+                                   | SOME t =>
+                                        let
+                                           val t = elabType t
+                                        in
+                                           (SOME t, Type.arrow (t, resultType))
+                                        end
+                               val scheme =
+                                  Scheme.make {canGeneralize = true,
+                                               ty = ty,
+                                               tyvars = tyvars}
+                            in
+                               (scheme, {arg = arg, con = con})
+                            end))
+                       val _ =
+                          let
+                             val r = TypeEnv.tyconAdmitsEquality tycon
+                             datatype z = datatype AdmitsEquality.t
+                          in
+                             case !r of
+                                Always => Error.bug "ElaborateCore.elaborateDec.elabDatBind: Always"
+                              | Never => ()
+                              | Sometimes =>
+                                   if Vector.forall
+                                      (datatypeCons, fn {arg, ...} =>
+                                       case arg of
+                                          NONE => true
+                                        | SOME ty =>
+                                             Scheme.admitsEquality
+                                             (Scheme.make {canGeneralize = true,
+                                                           ty = ty,
+                                                           tyvars = tyvars}))
+                                      then ()
+                                   else (r := Never; change := true)
+                          end
+                    val typeStr =
+                       TypeStr.data (tycon,
+                                     Kind.Arity (Vector.length tyvars),
+                                     makeCons schemes)
+                    val _ =
+                       Env.extendTycon (E, name, typeStr,
+                                        {forceUsed = false, isRebind = true})
+                 in
+                    ({cons = datatypeCons,
+                      tycon = tycon,
+                      tyvars = tyvars},
+                     {tycon = name,
+                      typeStr = typeStr})
+                 end)))
+            (* We don't want to re-elaborate the datatypes if there has been a
+             * type error, because that will cause duplicate error messages.
+             *)
+            val numErrors = !Control.numErrors
+            (* Maximize equality. *)
+            fun loop () =
+               let
+                  val res = elabAll ()
+               in
+                  if !change andalso numErrors = !Control.numErrors
+                     then (change := false; loop ())
+                  else res
+               end
+            val (dbs, strs) = Vector.unzip (loop ())
+         in
+            (Decs.single (Cdec.Datatype dbs), strs)
+         end
       fun elabDec arg : Decs.t =
-	 Trace.traceInfo
-	 (elabDecInfo,
-	  Layout.tuple3 (Ast.Dec.layout, Nest.layout, Bool.layout),
-	  Decs.layout, Trace.assertTrue)
-	 (fn (d, nest, isTop) =>
-	  let
-	     val region = Adec.region d
-	     fun lay () = seq [str "in: ", approximate (Adec.layout d)]
-	     val preError = Promise.lazy (fn () => Env.setTyconNames E)
-	     fun reportUnable (unable: Tyvar.t vector) =
-	       if 0 = Vector.length unable
-		  then ()
-	       else
-		  let
-		     open Layout
-		  in
-		     Control.error
-		     (region,
-		      seq [str (concat
-				["can't bind type variable",
-				 if Vector.length unable > 1 then "s" else "",
-				 ": "]),
-			   seq (List.separate
-				(Vector.toListMap (unable, Tyvar.layout),
-				 str ", "))],
-		      lay ())
-		  end
-	     fun useBeforeDef (c: Tycon.t) =
-		let
-		   val _ = preError ()
-		   open Layout
-		in
-		   Control.error
-		   (region,
-		    seq [str "type escapes the scope of its definition at ",
-			 str (case ! (TypeEnv.tyconRegion c) of
-				 NONE => "<bogus>"
-			       | SOME r =>
-				    case Region.left r of
-				       NONE => "<bogus>"
-				     | SOME p => SourcePos.toString p)],
-		    align [seq [str "type: ", Tycon.layout c],
-			   lay ()])
-		end
-	     val () = TypeEnv.tick {useBeforeDef = useBeforeDef}
-	     val unify = fn (t, t', f) => unify (t, t', preError, f)
-	     fun checkSchemes (v: (Var.t * Scheme.t) vector): unit =
-		if isTop
-		   then
-		      List.push
-		      (freeTyvarChecks,
-		       fn () =>
-		       Vector.foreach2
-		       (v, Scheme.haveFrees (Vector.map (v, #2)),
-			fn ((x, s), b) =>
-			if b
-			   then
-			      let
-				 val _ = preError ()
-				 open Layout
-			      in
-				 Control.warning
-				 (region,
-				  seq [str "unable to locally determine type of variable: ",
-				       Var.layout x],
-				  align [seq [str "type: ", Scheme.layoutPretty s],
-					 lay ()])
-			      end
-			else ()))
-		else ()
-	     val elabDec = fn (d, isTop) => elabDec (d, nest, isTop)
-	  in
-	     case Adec.node d of
-		Adec.Abstype {datBind, body} => (* rule 19 and p.57 *)
-		   let
-		      val ((decs, strs), decs') =
-			 Env.localCore
-			 (E,
-			  fn () => elabDatBind (datBind, nest),
-			  fn z => (z, elabDec (body, isTop)))
-		      val _ =
-			 Vector.foreach
-			 (strs, fn {tycon, typeStr} =>
-			  Env.extendTycon (E, tycon, TypeStr.abs typeStr,
-					   {forceUsed = true,
-					    isRebind = false}))
-		   in
-		      Decs.append (decs, decs')
-		   end
-	      | Adec.Datatype rhs =>
-		   (case DatatypeRhs.node rhs of
-		       DatatypeRhs.DatBind datBind => (* rule 17 *)
-			  #1 (elabDatBind (datBind, nest))
-		     | DatatypeRhs.Repl {lhs, rhs} => (* rule 18 *)
-			  let
-			     val () =
-				Option.app
-				(Env.lookupLongtycon (E, rhs), fn s =>
-				 let
-				    val forceUsed =
-				       case TypeStr.node s of
-					  TypeStr.Datatype _ => true
-					| _ => false
-				 in
-				    Env.extendTycon (E, lhs, s,
-						     {forceUsed = forceUsed,
-						      isRebind = false})
-				 end)
-			  in
-			     Decs.empty
-			  end)
-	      | Adec.Exception ebs =>
-		   let
-		      val decs =
-			 Vector.fold
-			 (ebs, Decs.empty, fn ((exn, rhs), decs) =>
-			  let
-			     val (decs, exn', scheme) =
-				case EbRhs.node rhs of
-				   EbRhs.Def c =>
-				      let
-					 val (c, s) = Env.lookupLongcon (E, c)
-				      in
-					 (decs, c, s)
-				      end
-				 | EbRhs.Gen arg =>
-				      let
-					 val exn' = Con.fromAst exn
-					 val (arg, ty) =
-					    case arg of
-					       NONE => (NONE, Type.exn)
-					     | SOME t =>
-						  let
-						     val t = elabType t
-						  in
-						     (SOME t,
-						      Type.arrow (t, Type.exn))
-						  end
-					 val scheme = Scheme.fromType ty
-				      in
-					 (Decs.add (decs,
-						    Cdec.Exception {arg = arg,
-								    con = exn'}),
-					  exn',
-					  SOME scheme)
-				      end
-			     val _ = Env.extendExn (E, exn, exn', scheme)
-			  in
-			     decs
-			  end)
-		   in
-		      decs
-		   end
-	      | Adec.Fix {ops, fixity} =>
-		   (Vector.foreach (ops, fn op' =>
-				    Env.extendFix (E, op', fixity))
-		    ; Decs.empty)
-	      | Adec.Fun (tyvars, fbs) =>
-		   let
-		      val fbs =
-			 Vector.map
-			 (fbs, fn clauses =>
-			  Vector.map
-			  (clauses, fn {body, pats, resultType} =>
-			   let
-			      fun lay () =
-				 approximate
-				 (let
-				     open Layout
-				  in
-				     seq [seq (List.separate
-					       (Vector.toListMap
-						(pats, Apat.layoutDelimit),
-						str " ")),
-					  str " = ",
-					  Aexp.layout body]
-				  end)
-			      val {args, func} =
-				 Parse.parseClause (pats, E, region, lay)
-			   in
-			      {args = args,
-			       body = body,
-			       func = func,
-			       lay = lay,
-			       resultType = resultType}
-			   end))
-		      val close =
-			 TypeEnv.close (tyvars, {useBeforeDef = useBeforeDef})
-		      val {markFunc, setBound, unmarkFunc} = recursiveFun ()
-		      val fbs =
-			 Vector.map
-			 (fbs, fn clauses =>
-			  if Vector.isEmpty clauses
-			     then Error.bug "no clauses in fundec"
-			  else
-			     let
-				fun lay () =
-				   let
-				      open Layout
-				   in
-				      seq [str "in: ",
-					   approximate
-					   (seq
-					    (separate
- 					     (Vector.toListMap
-					      (clauses, fn {lay, ...} => lay ()),
-					      " | ")))]
-				   end
-				val {args, func, lay = lay0, ...} =
-				   Vector.sub (clauses, 0)
-				val numArgs = Vector.length args
-				val _ =
-				   Vector.foreach
-				   (clauses, fn {args, lay = layN, ...} =>
-				    if numArgs = Vector.length args
-				       then  ()
-				    else
-				       let
-					  fun one lay =
-					     seq [str "clause: ",
-						  approximate (lay ())]
-				       in
-					  Control.error
-					  (region,
-					   seq [str "function defined with different numbers of arguments"],
-					   align [one lay0, one layN])
-				       end)
-				val diff =
-				   Vector.fold
-				   (clauses, [], fn ({func = func', ...}, ac) =>
-				    if Avar.equals (func, func')
-				       then ac
-				    else func' :: ac)
-				val _ =
-				   case diff of
-				      [] => ()
-				    | _ =>
-					 let
-					    val diff =
-					       List.removeDuplicates
-					       (func :: diff, Avar.equals)
-					 in
-					    Control.error
-					    (region,
-					     seq [str "function defined with multiple names: ",
-						  seq (Layout.separateRight
-						       (List.map (diff,
-								  Avar.layout),
-							", "))],
-					     lay ())
-					 end
-				val var = Var.fromAst func
-				val ty = Type.new ()
-				val _ = Env.extendVar (E, func, var,
-						       Scheme.fromType ty,
-						       {isRebind = false})
-				val _ = markFunc var
-				val _ =
-				   Acon.ensureRedefine
-				   (Avid.toCon (Avid.fromVar func))
-			     in
-				{clauses = clauses,
-				 func = func,
-				 lay = lay,
-				 ty = ty,
-				 var = var}
-			     end)
-		      val _ =
-			 Vector.fold
-			 (fbs, [], fn ({func = f, ...}, ac) =>
-			  if List.exists (ac, fn f' => Avar.equals (f, f'))
-			     then
-				(Control.error
-				 (Avar.region f,
-				  seq [str "function ",
-				       Avar.layout f,
-				       str " defined multiple times: "],
-				  lay ())
-				 ; ac)
-			  else f :: ac)
-		      val decs =
-			 Vector.map
-			 (fbs, fn {clauses,
-				   func: Avar.t,
-				   lay,
-				   ty: Type.t,
-				   var: Var.t} =>
-			  let
-			     val nest = Avar.toString func :: nest
-			     fun sourceInfo () =
-				SourceInfo.function {name = nest,
-						     region = Avar.region func}
-			     val rs =
-				Vector.map
-				(clauses, fn {args: Apat.t vector,
-					      body: Aexp.t,
-					      lay: unit -> Layout.t,
-					      resultType: Atype.t option, ...} =>
-				 Env.scope
-				 (E, fn () =>
-				  let
-				     val elaboratePat = elaboratePat ()
-				     val pats =
-					Vector.map
-					(args, fn p =>
-					 {pat = #1 (elaboratePat
-						    (p, E,
-						     {bind = true,
-						      isRvb = false},
-						     preError)),
-					  region = Apat.region p})
-				     val bodyRegion = Aexp.region body
-				     val body = elabExp (body, nest, NONE)
-				     val body =
-					Cexp.enterLeave
-					(body, !Control.profileBranch,
-					 fn () =>
-					 SourceInfo.function
-					 {name = "<branch>" :: nest,
-					  region = bodyRegion})
-				     val _ =
-					Option.app
-					(resultType, fn t =>
-					 unify
-					 (elabType t, Cexp.ty body,
-					  fn (l1, l2) =>
-					  (Atype.region t,
-					   str "function result type disagrees with expression",
-					   align
-					   [seq [str "result type: ", l1],
-					    seq [str "expression:  ", l2],
-					    lay ()])))
-				  in
-				     {body = body,
-				      bodyRegion = bodyRegion,
-				      lay = lay,
-				      pats = pats}
-				  end))
-			     val numArgs =
-				Vector.length (#pats (Vector.sub (rs, 0)))
-			     val argTypes =
-				Vector.tabulate
-				(numArgs, fn i =>
-				 let
-				    val t =
-				       Cpat.ty
-				       (#pat (Vector.sub
-					      (#pats (Vector.sub (rs, 0)),
-					       i)))
-				    val _ =
-				       Vector.foreach
-				       (rs, fn {pats, ...} =>
-					let
-					   val {pat, region} =
-					      Vector.sub (pats, i)
-					in
-					   unify
-					   (t, Cpat.ty pat, fn (l1, l2) =>
-					    (region,
-					     str "function with argument of different types",
-					     align [seq [str "argument: ", l2],
-						    seq [str "previous: ", l1],
-						    lay ()]))
-					end)
-				 in
-				    t
-				 end)
-			     val t = Cexp.ty (#body (Vector.sub (rs, 0)))
-			     val _ =
-				Vector.foreach
-				(rs, fn {body, bodyRegion, ...} =>
-				 unify
-				 (t, Cexp.ty body, fn (l1, l2) =>
-				  (bodyRegion,
-				   str "function with result of different types",
-				   align [seq [str "result:   ", l2],
-					  seq [str "previous: ", l1],
-					  lay ()])))
-			     val xs =
-				Vector.tabulate (numArgs, fn _ =>
-						 Var.newNoname ())
-			     fun make (i: int): Cexp.t =
-				if i = Vector.length xs
-				   then
-				      let
-					 val e =
-					    Cexp.casee
-					    {kind = "function",
-					     lay = lay,
-					     noMatch = Cexp.RaiseMatch,
-					     region = region,
-					     rules =
-					     Vector.map
-					     (rs, fn {body, lay, pats, ...} =>
-					      let
-						 val pats =
-						    Vector.map (pats, #pat)
-					      in
-						 {exp = body,
-						  lay = SOME lay,
-						  pat =
-						  (Cpat.make
-						   (Cpat.Tuple pats,
-						    Type.tuple
-						    (Vector.map (pats, Cpat.ty))))}
-					      end),
-					     test = 
-					     Cexp.tuple
-					     (Vector.map2
-					      (xs, argTypes, Cexp.var)),
-					     warnMatch = warnMatch ()}
-				      in
-					 Cexp.enterLeave
-					 (e, profileBody, sourceInfo)
-				      end
-				else
-				   let
-				      val body = make (i + 1)
-				      val argType = Vector.sub (argTypes, i)
-				   in
-				      Cexp.make
-				      (Cexp.Lambda
-				       (Lambda.make
-					{arg = Vector.sub (xs, i),
-					 argType = argType,
-					 body = body,
-					 mayInline = true}),
-				       Type.arrow (argType, Cexp.ty body))
-				   end
-			     val lambda = make 0
-			     val _ =
-				unify
-				(Cexp.ty lambda, ty, fn (l1, l2) =>
-				 (Avar.region func,
-				  str "Recursive use of function disagrees with its type",
-				  align [seq [str "expects: ", l1],
-					 seq [str "but got: ", l2],
-					 lay ()]))
-			     val lambda =
-				case Cexp.node lambda of
-				   Cexp.Lambda l => l
-				 | _ => Lambda.bogus
-			  in
-			     {lambda = lambda,
-			      ty = ty,
-			      var = var}
-			  end)
-		      val {bound, schemes, unable} =
-			 close (Vector.map (decs, fn {ty, ...} =>
-					    {isExpansive = false,
-					     ty = ty}))
-		      val () = reportUnable unable
-		      val _ = checkSchemes (Vector.zip
-					    (Vector.map (decs, #var),
-					     schemes))
-		      val _ = setBound bound
-		      val _ =
-			 Vector.foreach3
-			 (fbs, decs, schemes,
-			  fn ({func, ...}, {var, ...}, scheme) =>
-			  (Env.extendVar (E, func, var, scheme,
-					  {isRebind = true})
-			   ; unmarkFunc var))
-		      val decs =
-			 Vector.map (decs, fn {lambda, var, ...} =>
-				     {lambda = lambda, var = var})
-		   in
-		      Decs.single (Cdec.Fun {decs = decs,
-					     tyvars = bound})
-		   end
-	      | Adec.Local (d, d') =>
-		   Env.localCore
-		   (E,
-		    fn () => elabDec (d, false),
-		    fn decs => Decs.append (decs, elabDec (d', isTop)))
-	      | Adec.Open paths =>
-		   let
-		      (* The following code is careful to first lookup all of the
-		       * paths in the current environment, and then extend the
-		       * environment with all of the results.
-		       * See rule 22 of the Definition.
-		       *)
-		      val _ =
-			 Vector.foreach
-			 (Vector.map (paths, fn p => Env.lookupLongstrid (E, p)),
-			  fn so => Option.app (so, fn s =>
-					       Env.openStructure (E, s)))
-		   in
-		      Decs.empty
-		   end
-	      | Adec.Overload (p, x, tyvars, ty, xs) =>
-		   (check (ElabControl.allowOverload, "_overload", region)
-		    ; let
-			 (* Lookup the overloads before extending the var in case
-			  * x appears in the xs.
-			  *)
-			 val ovlds =
-			    Vector.map (xs, fn x => Env.lookupLongvar (E, x))
-			 val _ =
-			    Env.extendOverload
-			    (E, p, x, 
-			     Vector.map (ovlds, fn (x, s) =>
-					 (x, Option.map (s, Scheme.ty))),
-			     Scheme.make {canGeneralize = false,
-					  tyvars = tyvars,
-					  ty = elabType ty})
-		      in
-			 Decs.empty
-		      end)
-	      | Adec.SeqDec ds =>
-		   Vector.fold (ds, Decs.empty, fn (d, decs) =>
-				Decs.append (decs, elabDec (d, isTop)))
-	      | Adec.Type typBind =>
-		   (elabTypBind typBind
-		    ; Decs.empty)
-	      | Adec.Val {tyvars, rvbs, vbs} =>
-		   let
-		      val close =
-			 TypeEnv.close (tyvars, {useBeforeDef = useBeforeDef})
-		      (* Must do all the es and rvbs before the ps because of
-		       * scoping rules.
-		       *)
-		      val vbs =
-			 Vector.map
-			 (vbs, fn {exp, pat, ...} =>
-			  let
-			     fun lay () =
-				let
-				   open Layout
-				in
-				   seq [str "in: ",
-					approximate
-					(seq [Apat.layout pat,
-					      str " = ", Aexp.layout exp])]
-				end
-			  in
-			     {exp = elabExp (exp, nest,
-					     SOME (case Apat.getName pat of
-						      NONE => "anon"
-						    | SOME s => s)),
-			      expRegion = Aexp.region exp,
-			      lay = lay,
-			      pat = pat,
-			      patRegion = Apat.region pat}
-			  end)
-		      val {markFunc, setBound, unmarkFunc} = recursiveFun ()
-		      val elaboratePat = elaboratePat ()
-		      val rvbs =
-			 Vector.map
-			 (rvbs, fn {pat, match} =>
-			  let
-			     val region = Apat.region pat
-			     val (pat, bound) =
-				elaboratePat (pat, E, {bind = false,
-						       isRvb = true},
-					      preError)
-			     val (nest, var, ty) =
-				if 0 = Vector.length bound
-				   then ("anon" :: nest,
-					 Var.newNoname (),
-					 Type.new ())
-				else
-				   let
-				      val (x, x', t) = Vector.sub (bound, 0)
-				   in
-				      (Avar.toString x :: nest, x', t)
-				   end
-			     val _ = markFunc var
-			     val scheme = Scheme.fromType ty
-			     val bound =
-				Vector.map
-				(bound, fn (x, _, _) =>
-				 (Acon.ensureRedefine (Avid.toCon
-						       (Avid.fromVar x))
-				  ; Env.extendVar (E, x, var, scheme,
-						   {isRebind = false})
-				  ; (x, var, ty)))
-			  in
-			     {bound = bound,
-			      match = match,
-			      nest = nest,
-			      pat = pat,
-			      region = region,
-			      var = var}
-			  end)
-		      val rvbs =
-			 Vector.map
-			 (rvbs, fn {bound, match, nest, pat, var, ...} =>
-			  let
-			     val {argType, region, resultType, rules} =
-				elabMatch (match, preError, nest)
-			     val _ =
-				unify
-				(Cpat.ty pat,
-				 Type.arrow (argType, resultType),
-				 fn (l1, l2) =>
-				 (region,
-				  str "function type disagrees with recursive uses",
-				  align [seq [str "function type:  ", l1],
-					 seq [str "recursive uses: ", l2],
-					 lay ()]))
-			     val arg = Var.newNoname ()
-			     val body =
-				Cexp.enterLeave
-				(Cexp.casee {kind = "function",
-					     lay = lay,
-					     noMatch = Cexp.RaiseMatch,
-					     region = region,
-					     rules = rules,
-					     test = Cexp.var (arg, argType),
-					     warnMatch = warnMatch ()},
-				 profileBody,
-				 fn () => SourceInfo.function {name = nest,
-							       region = region})
-			     val lambda =
-				Lambda.make {arg = arg,
-					     argType = argType,
-					     body = body,
-					     mayInline = true}
-			  in
-			     {bound = bound,
-			      lambda = lambda,
-			      var = var}
-			  end)
-		      val boundVars =
-			 Vector.map
-			 (Vector.concatV (Vector.map (rvbs, #bound)),
-			  fn x => (x, {isExpansive = false,
-				       isRebind = true}))
-		      val rvbs =
-			 Vector.map
-			 (rvbs, fn {bound, lambda, var} =>
-			  (Vector.foreach (bound, unmarkFunc o #2)
-			   ; {lambda = lambda,
-			      var = var}))
-		      val vbs =
-			 Vector.map
-			 (vbs,
-			  fn {exp = e, expRegion, lay, pat, patRegion, ...} =>
-			  let
-			     val (p, bound) =
-				elaboratePat (pat, E, {bind = false,
-						       isRvb = false}, preError)
-			     val _ =
-				unify
-				(Cpat.ty p, Cexp.ty e, fn (p, e) =>
-				 (Apat.region pat,
-				  str "pattern and expression disagree",
-				  align [seq [str "pattern:    ", p],
-					 seq [str "expression: ", e],
-					 lay ()]))
-			  in
-			     {bound = bound,
-			      exp = e,
-			      expRegion = expRegion,
-			      lay = lay,
-			      pat = p,
-			      patRegion = patRegion}
-			  end)
-		      val boundVars =
-			 Vector.concat
-			 [boundVars,
-			  Vector.concatV
-			  (Vector.map
-			   (vbs, fn {bound, exp, ...} =>
-			    (Vector.map
-			     (bound, fn z =>
-			      (z, {isExpansive = Cexp.isExpansive exp,
-				   isRebind = false})))))]
-		      val {bound, schemes, unable} =
-			 close
-			 (Vector.map
-			  (boundVars, fn ((_, _, ty), {isExpansive, ...}) =>
-			   {isExpansive = isExpansive, ty = ty}))
-		      val () = reportUnable unable
-		      val () = checkSchemes (Vector.zip
-					    (Vector.map (boundVars, #2 o #1),
-					     schemes))
-		      val () = setBound bound
-		      val () =
-			 Vector.foreach2
-			 (boundVars, schemes,
-			  fn (((x, x', _), {isRebind, ...}), scheme) =>
-			  Env.extendVar (E, x, x', scheme,
-					 {isRebind = isRebind}))
-		      val vbs =
-			 Vector.map (vbs, fn {exp, lay, pat, patRegion, ...} =>
-				     {exp = exp,
-				      lay = lay,
-				      pat = pat,
-				      patRegion = patRegion})
-		      (* According to page 28 of the Definition, we should
-		       * issue warnings for nonexhaustive valdecs only when it's
-		       * not a top level dec.   It seems harmless enough to go
-		       * ahead and always issue them.
-		       *)
-		   in
-		      Decs.single
-		      (Cdec.Val {rvbs = rvbs,
-				 tyvars = bound,
-				 vbs = vbs,
-				 warnMatch = warnMatch ()})
-		   end
-	  end) arg
+         Trace.traceInfo
+         (elabDecInfo,
+          Layout.tuple3 (Ast.Dec.layout, Nest.layout, Bool.layout),
+          Decs.layout, Trace.assertTrue)
+         (fn (d, nest, isTop) =>
+          let
+             val region = Adec.region d
+             fun lay () = seq [str "in: ", approximate (Adec.layout d)]
+             val preError = Promise.lazy (fn () => Env.setTyconNames E)
+             fun reportUnable (unable: Tyvar.t vector) =
+               if 0 = Vector.length unable
+                  then ()
+               else
+                  let
+                     open Layout
+                  in
+                     Control.error
+                     (region,
+                      seq [str (concat
+                                ["can't bind type variable",
+                                 if Vector.length unable > 1 then "s" else "",
+                                 ": "]),
+                           seq (List.separate
+                                (Vector.toListMap (unable, Tyvar.layout),
+                                 str ", "))],
+                      lay ())
+                  end
+             fun useBeforeDef (c: Tycon.t) =
+                let
+                   val _ = preError ()
+                   open Layout
+                in
+                   Control.error
+                   (region,
+                    seq [str "type escapes the scope of its definition at ",
+                         str (case ! (TypeEnv.tyconRegion c) of
+                                 NONE => "<bogus>"
+                               | SOME r =>
+                                    case Region.left r of
+                                       NONE => "<bogus>"
+                                     | SOME p => SourcePos.toString p)],
+                    align [seq [str "type: ", Tycon.layout c],
+                           lay ()])
+                end
+             val () = TypeEnv.tick {useBeforeDef = useBeforeDef}
+             val unify = fn (t, t', f) => unify (t, t', preError, f)
+             fun checkSchemes (v: (Var.t * Scheme.t) vector): unit =
+                if isTop
+                   then
+                      List.push
+                      (freeTyvarChecks,
+                       fn () =>
+                       Vector.foreach2
+                       (v, Scheme.haveFrees (Vector.map (v, #2)),
+                        fn ((x, s), b) =>
+                        if b
+                           then
+                              let
+                                 val _ = preError ()
+                                 open Layout
+                              in
+                                 Control.warning
+                                 (region,
+                                  seq [str "unable to locally determine type of variable: ",
+                                       Var.layout x],
+                                  align [seq [str "type: ", Scheme.layoutPretty s],
+                                         lay ()])
+                              end
+                        else ()))
+                else ()
+             val elabDec = fn (d, isTop) => elabDec (d, nest, isTop)
+          in
+             case Adec.node d of
+                Adec.Abstype {datBind, body} => (* rule 19 and p.57 *)
+                   let
+                      val ((decs, strs), decs') =
+                         Env.localCore
+                         (E,
+                          fn () => elabDatBind (datBind, nest),
+                          fn z => (z, elabDec (body, isTop)))
+                      val _ =
+                         Vector.foreach
+                         (strs, fn {tycon, typeStr} =>
+                          Env.extendTycon (E, tycon, TypeStr.abs typeStr,
+                                           {forceUsed = true,
+                                            isRebind = false}))
+                   in
+                      Decs.append (decs, decs')
+                   end
+              | Adec.Datatype rhs =>
+                   (case DatatypeRhs.node rhs of
+                       DatatypeRhs.DatBind datBind => (* rule 17 *)
+                          #1 (elabDatBind (datBind, nest))
+                     | DatatypeRhs.Repl {lhs, rhs} => (* rule 18 *)
+                          let
+                             val () =
+                                Option.app
+                                (Env.lookupLongtycon (E, rhs), fn s =>
+                                 let
+                                    val forceUsed =
+                                       case TypeStr.node s of
+                                          TypeStr.Datatype _ => true
+                                        | _ => false
+                                 in
+                                    Env.extendTycon (E, lhs, s,
+                                                     {forceUsed = forceUsed,
+                                                      isRebind = false})
+                                 end)
+                          in
+                             Decs.empty
+                          end)
+              | Adec.Exception ebs =>
+                   let
+                      val decs =
+                         Vector.fold
+                         (ebs, Decs.empty, fn ((exn, rhs), decs) =>
+                          let
+                             val (decs, exn', scheme) =
+                                case EbRhs.node rhs of
+                                   EbRhs.Def c =>
+                                      let
+                                         val (c, s) = Env.lookupLongcon (E, c)
+                                      in
+                                         (decs, c, s)
+                                      end
+                                 | EbRhs.Gen arg =>
+                                      let
+                                         val exn' = Con.fromAst exn
+                                         val (arg, ty) =
+                                            case arg of
+                                               NONE => (NONE, Type.exn)
+                                             | SOME t =>
+                                                  let
+                                                     val t = elabType t
+                                                  in
+                                                     (SOME t,
+                                                      Type.arrow (t, Type.exn))
+                                                  end
+                                         val scheme = Scheme.fromType ty
+                                      in
+                                         (Decs.add (decs,
+                                                    Cdec.Exception {arg = arg,
+                                                                    con = exn'}),
+                                          exn',
+                                          SOME scheme)
+                                      end
+                             val _ = Env.extendExn (E, exn, exn', scheme)
+                          in
+                             decs
+                          end)
+                   in
+                      decs
+                   end
+              | Adec.Fix {ops, fixity} =>
+                   (Vector.foreach (ops, fn op' =>
+                                    Env.extendFix (E, op', fixity))
+                    ; Decs.empty)
+              | Adec.Fun (tyvars, fbs) =>
+                   let
+                      val fbs =
+                         Vector.map
+                         (fbs, fn clauses =>
+                          Vector.map
+                          (clauses, fn {body, pats, resultType} =>
+                           let
+                              fun lay () =
+                                 approximate
+                                 (let
+                                     open Layout
+                                  in
+                                     seq [seq (List.separate
+                                               (Vector.toListMap
+                                                (pats, Apat.layoutDelimit),
+                                                str " ")),
+                                          str " = ",
+                                          Aexp.layout body]
+                                  end)
+                              val {args, func} =
+                                 Parse.parseClause (pats, E, region, lay)
+                           in
+                              {args = args,
+                               body = body,
+                               func = func,
+                               lay = lay,
+                               resultType = resultType}
+                           end))
+                      val close =
+                         TypeEnv.close (tyvars, {useBeforeDef = useBeforeDef})
+                      val {markFunc, setBound, unmarkFunc} = recursiveFun ()
+                      val fbs =
+                         Vector.map
+                         (fbs, fn clauses =>
+                          if Vector.isEmpty clauses
+                             then Error.bug "ElaborateCore.elabDec: Fun:no clauses"
+                          else
+                             let
+                                fun lay () =
+                                   let
+                                      open Layout
+                                   in
+                                      seq [str "in: ",
+                                           approximate
+                                           (seq
+                                            (separate
+                                             (Vector.toListMap
+                                              (clauses, fn {lay, ...} => lay ()),
+                                              " | ")))]
+                                   end
+                                val {args, func, lay = lay0, ...} =
+                                   Vector.sub (clauses, 0)
+                                val numArgs = Vector.length args
+                                val _ =
+                                   Vector.foreach
+                                   (clauses, fn {args, lay = layN, ...} =>
+                                    if numArgs = Vector.length args
+                                       then  ()
+                                    else
+                                       let
+                                          fun one lay =
+                                             seq [str "clause: ",
+                                                  approximate (lay ())]
+                                       in
+                                          Control.error
+                                          (region,
+                                           seq [str "function defined with different numbers of arguments"],
+                                           align [one lay0, one layN])
+                                       end)
+                                val diff =
+                                   Vector.fold
+                                   (clauses, [], fn ({func = func', ...}, ac) =>
+                                    if Avar.equals (func, func')
+                                       then ac
+                                    else func' :: ac)
+                                val _ =
+                                   case diff of
+                                      [] => ()
+                                    | _ =>
+                                         let
+                                            val diff =
+                                               List.removeDuplicates
+                                               (func :: diff, Avar.equals)
+                                         in
+                                            Control.error
+                                            (region,
+                                             seq [str "function defined with multiple names: ",
+                                                  seq (Layout.separateRight
+                                                       (List.map (diff,
+                                                                  Avar.layout),
+                                                        ", "))],
+                                             lay ())
+                                         end
+                                val var = Var.fromAst func
+                                val ty = Type.new ()
+                                val _ = Env.extendVar (E, func, var,
+                                                       Scheme.fromType ty,
+                                                       {isRebind = false})
+                                val _ = markFunc var
+                                val _ =
+                                   Acon.ensureRedefine
+                                   (Avid.toCon (Avid.fromVar func))
+                             in
+                                {clauses = clauses,
+                                 func = func,
+                                 lay = lay,
+                                 ty = ty,
+                                 var = var}
+                             end)
+                      val _ =
+                         Vector.fold
+                         (fbs, [], fn ({func = f, ...}, ac) =>
+                          if List.exists (ac, fn f' => Avar.equals (f, f'))
+                             then
+                                (Control.error
+                                 (Avar.region f,
+                                  seq [str "function ",
+                                       Avar.layout f,
+                                       str " defined multiple times: "],
+                                  lay ())
+                                 ; ac)
+                          else f :: ac)
+                      val decs =
+                         Vector.map
+                         (fbs, fn {clauses,
+                                   func: Avar.t,
+                                   lay,
+                                   ty: Type.t,
+                                   var: Var.t} =>
+                          let
+                             val nest = Avar.toString func :: nest
+                             fun sourceInfo () =
+                                SourceInfo.function {name = nest,
+                                                     region = Avar.region func}
+                             val rs =
+                                Vector.map
+                                (clauses, fn {args: Apat.t vector,
+                                              body: Aexp.t,
+                                              lay: unit -> Layout.t,
+                                              resultType: Atype.t option, ...} =>
+                                 Env.scope
+                                 (E, fn () =>
+                                  let
+                                     val elaboratePat = elaboratePat ()
+                                     val pats =
+                                        Vector.map
+                                        (args, fn p =>
+                                         {pat = #1 (elaboratePat
+                                                    (p, E,
+                                                     {bind = true,
+                                                      isRvb = false},
+                                                     preError)),
+                                          region = Apat.region p})
+                                     val bodyRegion = Aexp.region body
+                                     val body = elabExp (body, nest, NONE)
+                                     val body =
+                                        Cexp.enterLeave
+                                        (body, 
+                                         profileBody 
+                                         andalso !Control.profileBranch,
+                                         fn () =>
+                                         SourceInfo.function
+                                         {name = "<branch>" :: nest,
+                                          region = bodyRegion})
+                                     val _ =
+                                        Option.app
+                                        (resultType, fn t =>
+                                         unify
+                                         (elabType t, Cexp.ty body,
+                                          fn (l1, l2) =>
+                                          (Atype.region t,
+                                           str "function result type disagrees with expression",
+                                           align
+                                           [seq [str "result type: ", l1],
+                                            seq [str "expression:  ", l2],
+                                            lay ()])))
+                                  in
+                                     {body = body,
+                                      bodyRegion = bodyRegion,
+                                      lay = lay,
+                                      pats = pats}
+                                  end))
+                             val numArgs =
+                                Vector.length (#pats (Vector.sub (rs, 0)))
+                             val argTypes =
+                                Vector.tabulate
+                                (numArgs, fn i =>
+                                 let
+                                    val t =
+                                       Cpat.ty
+                                       (#pat (Vector.sub
+                                              (#pats (Vector.sub (rs, 0)),
+                                               i)))
+                                    val _ =
+                                       Vector.foreach
+                                       (rs, fn {pats, ...} =>
+                                        let
+                                           val {pat, region} =
+                                              Vector.sub (pats, i)
+                                        in
+                                           unify
+                                           (t, Cpat.ty pat, fn (l1, l2) =>
+                                            (region,
+                                             str "function with argument of different types",
+                                             align [seq [str "argument: ", l2],
+                                                    seq [str "previous: ", l1],
+                                                    lay ()]))
+                                        end)
+                                 in
+                                    t
+                                 end)
+                             val t = Cexp.ty (#body (Vector.sub (rs, 0)))
+                             val _ =
+                                Vector.foreach
+                                (rs, fn {body, bodyRegion, ...} =>
+                                 unify
+                                 (t, Cexp.ty body, fn (l1, l2) =>
+                                  (bodyRegion,
+                                   str "function with result of different types",
+                                   align [seq [str "result:   ", l2],
+                                          seq [str "previous: ", l1],
+                                          lay ()])))
+                             val xs =
+                                Vector.tabulate (numArgs, fn _ =>
+                                                 Var.newNoname ())
+                             fun make (i: int): Cexp.t =
+                                if i = Vector.length xs
+                                   then
+                                      let
+                                         val e =
+                                            Cexp.casee
+                                            {kind = "function",
+                                             lay = lay,
+                                             noMatch = Cexp.RaiseMatch,
+                                             nonexhaustiveExnMatch = nonexhaustiveExnMatch (),
+                                             nonexhaustiveMatch = nonexhaustiveMatch (),
+                                             redundantMatch = redundantMatch (),
+                                             region = region,
+                                             rules =
+                                             Vector.map
+                                             (rs, fn {body, lay, pats, ...} =>
+                                              let
+                                                 val pats =
+                                                    Vector.map (pats, #pat)
+                                              in
+                                                 {exp = body,
+                                                  lay = SOME lay,
+                                                  pat =
+                                                  (Cpat.make
+                                                   (Cpat.Tuple pats,
+                                                    Type.tuple
+                                                    (Vector.map (pats, Cpat.ty))))}
+                                              end),
+                                             test = 
+                                             Cexp.tuple
+                                             (Vector.map2
+                                              (xs, argTypes, Cexp.var))}
+                                      in
+                                         Cexp.enterLeave
+                                         (e, profileBody, sourceInfo)
+                                      end
+                                else
+                                   let
+                                      val body = make (i + 1)
+                                      val argType = Vector.sub (argTypes, i)
+                                   in
+                                      Cexp.make
+                                      (Cexp.Lambda
+                                       (Lambda.make
+                                        {arg = Vector.sub (xs, i),
+                                         argType = argType,
+                                         body = body,
+                                         mayInline = true}),
+                                       Type.arrow (argType, Cexp.ty body))
+                                   end
+                             val lambda = make 0
+                             val _ =
+                                unify
+                                (Cexp.ty lambda, ty, fn (l1, l2) =>
+                                 (Avar.region func,
+                                  str "Recursive use of function disagrees with its type",
+                                  align [seq [str "expects: ", l1],
+                                         seq [str "but got: ", l2],
+                                         lay ()]))
+                             val lambda =
+                                case Cexp.node lambda of
+                                   Cexp.Lambda l => l
+                                 | _ => Lambda.bogus
+                          in
+                             {lambda = lambda,
+                              ty = ty,
+                              var = var}
+                          end)
+                      val {bound, schemes, unable} =
+                         close (Vector.map (decs, fn {ty, ...} =>
+                                            {isExpansive = false,
+                                             ty = ty}))
+                      val () = reportUnable unable
+                      val _ = checkSchemes (Vector.zip
+                                            (Vector.map (decs, #var),
+                                             schemes))
+                      val _ = setBound bound
+                      val _ =
+                         Vector.foreach3
+                         (fbs, decs, schemes,
+                          fn ({func, ...}, {var, ...}, scheme) =>
+                          (Env.extendVar (E, func, var, scheme,
+                                          {isRebind = true})
+                           ; unmarkFunc var))
+                      val decs =
+                         Vector.map (decs, fn {lambda, var, ...} =>
+                                     {lambda = lambda, var = var})
+                   in
+                      Decs.single (Cdec.Fun {decs = decs,
+                                             tyvars = bound})
+                   end
+              | Adec.Local (d, d') =>
+                   Env.localCore
+                   (E,
+                    fn () => elabDec (d, false),
+                    fn decs => Decs.append (decs, elabDec (d', isTop)))
+              | Adec.Open paths =>
+                   let
+                      (* The following code is careful to first lookup all of the
+                       * paths in the current environment, and then extend the
+                       * environment with all of the results.
+                       * See rule 22 of the Definition.
+                       *)
+                      val _ =
+                         Vector.foreach
+                         (Vector.map (paths, fn p => Env.lookupLongstrid (E, p)),
+                          fn so => Option.app (so, fn s =>
+                                               Env.openStructure (E, s)))
+                   in
+                      Decs.empty
+                   end
+              | Adec.Overload (p, x, tyvars, ty, xs) =>
+                   (check (ElabControl.allowOverload, "_overload", region)
+                    ; let
+                         (* Lookup the overloads before extending the var in case
+                          * x appears in the xs.
+                          *)
+                         val ovlds =
+                            Vector.map (xs, fn x => Env.lookupLongvar (E, x))
+                         val _ =
+                            Env.extendOverload
+                            (E, p, x, 
+                             Vector.map (ovlds, fn (x, s) =>
+                                         (x, Option.map (s, Scheme.ty))),
+                             Scheme.make {canGeneralize = false,
+                                          tyvars = tyvars,
+                                          ty = elabType ty})
+                      in
+                         Decs.empty
+                      end)
+              | Adec.SeqDec ds =>
+                   Vector.fold (ds, Decs.empty, fn (d, decs) =>
+                                Decs.append (decs, elabDec (d, isTop)))
+              | Adec.Type typBind =>
+                   (elabTypBind typBind
+                    ; Decs.empty)
+              | Adec.Val {tyvars, rvbs, vbs} =>
+                   let
+                      val close =
+                         TypeEnv.close (tyvars, {useBeforeDef = useBeforeDef})
+                      (* Must do all the es and rvbs before the ps because of
+                       * scoping rules.
+                       *)
+                      val vbs =
+                         Vector.map
+                         (vbs, fn {exp, pat, ...} =>
+                          let
+                             fun lay () =
+                                let
+                                   open Layout
+                                in
+                                   seq [str "in: ",
+                                        approximate
+                                        (seq [Apat.layout pat,
+                                              str " = ", Aexp.layout exp])]
+                                end
+                          in
+                             {exp = elabExp (exp, nest, Apat.getName pat),
+                              expRegion = Aexp.region exp,
+                              lay = lay,
+                              pat = pat,
+                              patRegion = Apat.region pat}
+                          end)
+                      val {markFunc, setBound, unmarkFunc} = recursiveFun ()
+                      val elaboratePat = elaboratePat ()
+                      val rvbs =
+                         Vector.map
+                         (rvbs, fn {pat, match} =>
+                          let
+                             val region = Apat.region pat
+                             val (pat, bound) =
+                                elaboratePat (pat, E, {bind = false,
+                                                       isRvb = true},
+                                              preError)
+                             val (nest, var, ty) =
+                                if 0 = Vector.length bound
+                                   then ("rec" :: nest,
+                                         Var.newNoname (),
+                                         Type.new ())
+                                else
+                                   let
+                                      val (x, x', t) = Vector.sub (bound, 0)
+                                   in
+                                      (Avar.toString x :: nest, x', t)
+                                   end
+                             val _ = markFunc var
+                             val scheme = Scheme.fromType ty
+                             val bound =
+                                Vector.map
+                                (bound, fn (x, _, _) =>
+                                 (Acon.ensureRedefine (Avid.toCon
+                                                       (Avid.fromVar x))
+                                  ; Env.extendVar (E, x, var, scheme,
+                                                   {isRebind = false})
+                                  ; (x, var, ty)))
+                          in
+                             {bound = bound,
+                              match = match,
+                              nest = nest,
+                              pat = pat,
+                              region = region,
+                              var = var}
+                          end)
+                      val rvbs =
+                         Vector.map
+                         (rvbs, fn {bound, match, nest, pat, var, ...} =>
+                          let
+                             val {argType, region, resultType, rules} =
+                                elabMatch (match, preError, nest)
+                             val _ =
+                                unify
+                                (Cpat.ty pat,
+                                 Type.arrow (argType, resultType),
+                                 fn (l1, l2) =>
+                                 (region,
+                                  str "function type disagrees with recursive uses",
+                                  align [seq [str "function type:  ", l1],
+                                         seq [str "recursive uses: ", l2],
+                                         lay ()]))
+                             val arg = Var.newNoname ()
+                             val body =
+                                Cexp.enterLeave
+                                (Cexp.casee {kind = "function",
+                                             lay = lay,
+                                             noMatch = Cexp.RaiseMatch,
+                                             nonexhaustiveExnMatch = nonexhaustiveExnMatch (),
+                                             nonexhaustiveMatch = nonexhaustiveMatch (),
+                                             redundantMatch = redundantMatch (),
+                                             region = region,
+                                             rules = rules,
+                                             test = Cexp.var (arg, argType)},
+                                 profileBody,
+                                 fn () => SourceInfo.function {name = nest,
+                                                               region = region})
+                             val lambda =
+                                Lambda.make {arg = arg,
+                                             argType = argType,
+                                             body = body,
+                                             mayInline = true}
+                          in
+                             {bound = bound,
+                              lambda = lambda,
+                              var = var}
+                          end)
+                      val boundVars =
+                         Vector.map
+                         (Vector.concatV (Vector.map (rvbs, #bound)),
+                          fn x => (x, {isExpansive = false,
+                                       isRebind = true}))
+                      val rvbs =
+                         Vector.map
+                         (rvbs, fn {bound, lambda, var} =>
+                          (Vector.foreach (bound, unmarkFunc o #2)
+                           ; {lambda = lambda,
+                              var = var}))
+                      val vbs =
+                         Vector.map
+                         (vbs,
+                          fn {exp = e, expRegion, lay, pat, patRegion, ...} =>
+                          let
+                             val (p, bound) =
+                                elaboratePat (pat, E, {bind = false,
+                                                       isRvb = false}, preError)
+                             val _ =
+                                unify
+                                (Cpat.ty p, Cexp.ty e, fn (p, e) =>
+                                 (Apat.region pat,
+                                  str "pattern and expression disagree",
+                                  align [seq [str "pattern:    ", p],
+                                         seq [str "expression: ", e],
+                                         lay ()]))
+                          in
+                             {bound = bound,
+                              exp = e,
+                              expRegion = expRegion,
+                              lay = lay,
+                              pat = p,
+                              patRegion = patRegion}
+                          end)
+                      val boundVars =
+                         Vector.concat
+                         [boundVars,
+                          Vector.concatV
+                          (Vector.map
+                           (vbs, fn {bound, exp, ...} =>
+                            (Vector.map
+                             (bound, fn z =>
+                              (z, {isExpansive = Cexp.isExpansive exp,
+                                   isRebind = false})))))]
+                      val {bound, schemes, unable} =
+                         close
+                         (Vector.map
+                          (boundVars, fn ((_, _, ty), {isExpansive, ...}) =>
+                           {isExpansive = isExpansive, ty = ty}))
+                      val () = reportUnable unable
+                      val () = checkSchemes (Vector.zip
+                                            (Vector.map (boundVars, #2 o #1),
+                                             schemes))
+                      val () = setBound bound
+                      val () =
+                         Vector.foreach2
+                         (boundVars, schemes,
+                          fn (((x, x', _), {isRebind, ...}), scheme) =>
+                          Env.extendVar (E, x, x', scheme,
+                                         {isRebind = isRebind}))
+                      val vbs =
+                         Vector.map (vbs, fn {exp, lay, pat, patRegion, ...} =>
+                                     {exp = exp,
+                                      lay = lay,
+                                      pat = pat,
+                                      patRegion = patRegion})
+                      (* According to page 28 of the Definition, we should
+                       * issue warnings for nonexhaustive valdecs only when it's
+                       * not a top level dec.   It seems harmless enough to go
+                       * ahead and always issue them.
+                       *)
+                   in
+                      Decs.single
+                      (Cdec.Val {nonexhaustiveExnMatch = nonexhaustiveExnMatch (),
+                                 nonexhaustiveMatch = nonexhaustiveMatch (),
+                                 rvbs = rvbs,
+                                 tyvars = bound,
+                                 vbs = vbs})
+                   end
+          end) arg
       and elabExp (arg: Aexp.t * Nest.t * string option): Cexp.t =
-	 Trace.traceInfo
-	 (elabExpInfo,
-	  Layout.tuple3 (Aexp.layout, Nest.layout, Layout.ignore),
-	  Cexp.layout,
-	  Trace.assertTrue)
-	 (fn (e: Aexp.t, nest, maybeName) =>
-	  let
-	     val preError = Promise.lazy (fn () => Env.setTyconNames E)
-	     val unify = fn (t, t', f) => unify (t, t', preError, f)
-	     fun lay () = seq [str "in: ", approximate (Aexp.layout e)]
-	     val unify =
-		fn (a, b, f) => unify (a, b, fn z =>
-				       let
-					  val (r, l, l') = f z
-				       in
-					  (r, l, align [l', lay ()])
-				       end)
-	     val region = Aexp.region e
-	     fun elab e = elabExp (e, nest, NONE)
-	  in
-	     case Aexp.node e of
-		Aexp.Andalso (e, e') =>
-		   let
-		      val ce = elab e
-		      val ce' = elab e'
-		      fun doit (ce, br) =
-			 unify
-			 (Cexp.ty ce, Type.bool,
-			  fn (l, _) =>
-			  (Aexp.region e,
-			   str (concat
-				[br, " branch of andalso not of type bool"]),
-			   seq [str " branch: ", l]))
-		      val _ = doit (ce, "left")
-		      val _ = doit (ce', "right")
-		   in
-		      Cexp.andAlso (ce, ce')
-		   end
-	      | Aexp.App (e1, e2) =>
-		   let
-		      val e1 = elab e1
-		      val e2 = elab e2
-		      val argType = Type.new ()
-		      val resultType = Type.new ()
-		      val _ =
-			 unify (Cexp.ty e1, Type.arrow (argType, resultType),
-				fn (l, _) =>
-				(region,
-				 str "function not of arrow type",
-				 seq [str "function: ", l]))
-		      val _ =
-			 unify
-			 (argType, Cexp.ty e2, fn (l1, l2) =>
-			  (region,
-			   str "function applied to incorrect argument",
-			   align [seq [str "expects: ", l1],
-				  seq [str "but got: ", l2]]))
-		   in
-		      Cexp.make (Cexp.App (e1, e2), resultType)
-		   end
-	      | Aexp.Case (e, m) =>
-		   let
-		      val e = elab e
-		      val {argType, rules, ...} = elabMatch (m, preError, nest)
-		      val _ =
-			 unify
-			 (Cexp.ty e, argType, fn (l1, l2) =>
-			  (region,
-			   str "case object and rules disagree",
-			   align [seq [str "object type:  ", l1],
-				  seq [str "rules expect: ", l2]]))
-		   in
-		      Cexp.casee {kind = "case",
-				  lay = lay,
-				  noMatch = Cexp.RaiseMatch,
-				  region = region,
-				  rules = rules,
-				  test = e,
-				  warnMatch = warnMatch ()}
-		   end
-	      | Aexp.Const c =>
-		   elabConst
-		   (c,
-		    fn (resolve, ty) => Cexp.make (Cexp.Const resolve, ty),
-		    {false = Cexp.falsee,
-		     true = Cexp.truee})
-	      | Aexp.Constraint (e, t') =>
-		   let
-		      val e = elab e
-		      val _ =
-			 unify
-			 (Cexp.ty e, elabType t', fn (l1, l2) =>
-			  (region,
-			   str "expression and constraint disagree",
-			   align [seq [str "expects: ", l2],
-				  seq [str "but got: ", l1]]))
-		   in
-		      e
-		   end
-	      | Aexp.FlatApp items => elab (Parse.parseExp (items, E, lay))
-	      | Aexp.Fn m =>
-		   let
-		      val nest =
-			 case maybeName of
-			    NONE => "anon" :: nest
-			  | SOME s => s :: nest
-		      val {arg, argType, body} =
-			 elabMatchFn (m, preError, nest, "function", lay,
-				      Cexp.RaiseMatch)
-		      val body =
-			 Cexp.enterLeave
-			 (body, profileBody,
-			  fn () => SourceInfo.function {name = nest,
-							region = region})
-		   in
-		      Cexp.make (Cexp.Lambda (Lambda.make {arg = arg,
-							   argType = argType,
-							   body = body,
-							   mayInline = true}),
-				 Type.arrow (argType, Cexp.ty body))
-		   end
-	      | Aexp.Handle (try, match) =>
-		   let
-		      val try = elab try
-		      val {arg, argType, body} =
-			 elabMatchFn (match, preError, nest, "handler", lay,
-				      Cexp.RaiseAgain)
-		      val _ =
-			 unify
-			 (Cexp.ty try, Cexp.ty body, fn (l1, l2) =>
-			  (region,
-			   str "expression and handler disagree",
-			   align [seq [str "expression: ", l1],
-				  seq [str "handler:    ", l2]]))
-		      val _ =
-			 unify
-			 (argType, Type.exn, fn (l1, _) =>
-			  (Amatch.region match,
-			   seq [str "handler handles wrong type: ", l1],
-			   empty))
-		   in
-		      Cexp.make (Cexp.Handle {catch = (arg, Type.exn),
-					      handler = body, 
-					      try = try},
-				 Cexp.ty try)
-		   end
-	      | Aexp.If (a, b, c) =>
-		   let
-		      val a' = elab a
-		      val b' = elab b
-		      val c' = elab c
-		      val _ =
-			 unify
-			 (Cexp.ty a', Type.bool, fn (l1, _) =>
-			  (Aexp.region a,
-			   str "if test not of type bool",
-			   seq [str "test type: ", l1]))
-		      val _ =
-			 unify
-			 (Cexp.ty b', Cexp.ty c', fn (l1, l2) =>
-			  (region,
-			   str "then and else branches disagree",
-			   align [seq [str "then: ", l1],
-				  seq [str "else: ", l2]]))
-		      val (b', c') =
-			 if not (!Control.profileBranch)
-			    then (b', c')
-			 else
-			    let
-			       fun wrap (e, e', name) =
-				  Cexp.enterLeave
-				  (e', profileBody, fn () =>
-				   SourceInfo.function
-				   {name = name :: nest,
-				    region = Aexp.region e})
-			    in
-			       (wrap (b, b', "<true>"), wrap (c, c', "<false>"))
-			    end
-		   in
-		      Cexp.iff (a', b', c')
-		   end
-	      | Aexp.Let (d, e) =>
-		   Env.scope
-		   (E, fn () =>
-		    let
-		       val time = Time.now ()
-		       val d = Decs.toVector (elabDec (d, nest, false))
-		       val e = elab e
-		       val ty = Cexp.ty e
-		       val () = Type.minTime (ty, time)
-		    in
-		       Cexp.make (Cexp.Let (d, e), ty)
-		    end)
-	      | Aexp.List es =>
-		   let
-		      val es' = Vector.map (es, elab)
-		   in
-		      Cexp.make (Cexp.List es',
-				 unifyList
-				 (Vector.map2 (es, es', fn (e, e') =>
-					       (Cexp.ty e', Aexp.region e)),
-				  preError, lay))
-		   end
-	      | Aexp.Orelse (e, e') =>
-		   let
-		      val ce = elab e
-		      val ce' = elab e'
-		      fun doit (ce, br) =
-			 unify
-			 (Cexp.ty ce, Type.bool,
-			  fn (l, _) =>
-			  (Aexp.region e,
-			   str (concat
-				[br, " branch of orelse not of type bool"]),
-			   seq [str " branch: ", l]))
-		      val _ = doit (ce, "left")
-		      val _ = doit (ce', "right")
-		   in
-		      Cexp.orElse (ce, ce')
-		   end
-	      | Aexp.Prim {kind, ty} => 
-		   let
-		      val ty = elabType ty
-		      fun expandTy ty =
-			 Type.hom
-			 (ty, {con = Type.con,
-			       expandOpaque = true,
-			       record = Type.record,
-			       replaceSynonyms = false,
-			       var = Type.var})
-		      val expandedTy = expandTy ty
-		      (* We use expandedTy to get the underlying primitive right
-		       * but we use wrap in the end to make the result of the
-		       * final expression be ty, because that is what the rest
-		       * of the code expects to see.
-		       *)
-		      fun wrap (e, t) = Cexp.make (Cexp.node e, t)
-		      fun primApp {args, prim, result: Type.t} =
-			 let
-			    val targs =
-			       Prim.extractTargs
-			       (prim,
-				{args = Vector.map (args, Cexp.ty),
-				 deArray = Type.deArray,
-				 deArrow = Type.deArrow,
-				 deVector = Type.deVector,
-				 deWeak = Type.deWeak,
-				 result = result})
-			 in
-			    Cexp.make (Cexp.PrimApp {args = args,
-						     prim = prim,
-						     targs = targs},
-				       result)
-			 end
-		      fun etaExtra (extra, ty, expandedTy,
-				    p: Type.t Prim.t): Cexp.t =
-			 case Type.deArrowOpt expandedTy of
-			    NONE =>
-			       wrap (primApp {args = extra,
-					      prim = p,
-					      result = ty},
-				     ty)
-			  | SOME (argType, bodyType) =>
-			       let
-				  val arg = Var.newNoname ()
-				  fun app args =
-				     primApp {args = Vector.concat [extra, args],
-					      prim = p,
-					      result = bodyType}
-				  val body =
-				     case Type.deTupleOpt argType of
-					NONE =>
-					   app (Vector.new1
-						(Cexp.var (arg, argType)))
-				      | SOME ts =>
-					   let
-					      val vars =
-						 Vector.map
-						 (ts, fn t =>
-						  (Var.newNoname (), t))
-					   in
-					      Cexp.casee
-					      {kind = "",
-					       lay = fn _ => Layout.empty,
-					       noMatch = Cexp.Impossible,
-					       region = Region.bogus,
-					       rules =
-					       Vector.new1
-					       {exp = app (Vector.map
-							   (vars, Cexp.var)),
-						lay = NONE,
-						pat =
-						(Cpat.tuple
-						 (Vector.map (vars, Cpat.var)))},
-					       test = Cexp.var (arg, argType),
-					       warnMatch = warnMatch ()}
-					   end
-			       in
-				  Cexp.make (Cexp.Lambda
-					     (Lambda.make {arg = arg,
-							   argType = argType,
-							   body = body,
-							   mayInline = true}),
-					     ty)
-			       end
-		      fun eta (p: Type.t Prim.t): Cexp.t =
-			 etaExtra (Vector.new0 (), ty, expandedTy, p)
-		      fun lookConst {default: string option, name: string} =
-			 let
-			    fun bug () =
-			       let
-				  open Layout
-				  val _ =
-				     Control.error
-				     (region,
-				      seq [str "strange constant type: ",
-					   Type.layout expandedTy],
-				      empty)
-			       in
-				  Error.bug "lookConst bug"
-			       end
-			 in
-			    case Type.deConOpt expandedTy of
-			       NONE => bug ()
-			     | SOME (c, ts) =>
-				  let
-				     val ct =
-					if Tycon.equals (c, Tycon.bool)
-					   then ConstType.Bool
-					else if Tycon.isIntX c
-					   then ConstType.Word
-					else if Tycon.isRealX c
-					   then ConstType.Real
-					else if Tycon.isWordX c
-					   then ConstType.Word
-					else if Tycon.equals (c, Tycon.vector)
-					   andalso 1 = Vector.length ts
-					   andalso
-					   (case (Type.deConOpt
-						  (Vector.sub (ts, 0))) of
-					       NONE => false
-					     | SOME (c, _) => 
-						  Tycon.isCharX c)
-					   then ConstType.String
-					else bug ()
-				  val finish =
-				     fn () => ! Const.lookup ({default = default,
-							       name = name}, ct)
-			       in
-				  Cexp.make (Cexp.Const finish, ty)
-			       end
-			 end
-		      val check = fn (c, n) => check (c, n, region)
-		      datatype z = datatype Ast.PrimKind.t
-		   in
-		      case kind of
-			 BuildConst {name} =>
-			    (check (ElabControl.allowConstant, "_build_const")
-			     ; lookConst {default = NONE, name = name})
-		       | CommandLineConst {name, value} =>
-			    let
-			       val () =
-				  check (ElabControl.allowConstant,
-					 "_command_line_const")
-			       val value =
-				  elabConst
-				  (value,
-				   fn (resolve, _) =>
-				   case resolve () of
-				      Const.Word w =>
-					 IntInf.toString (WordX.toIntInf w)
-				    | c => Const.toString c,
-				   {false = "false", true = "true"})
-			    in
-			       lookConst {default = SOME value, name = name}
-			    end
-		       | Const {name} => 
-			    (check (ElabControl.allowConstant, "_const")
-			     ; lookConst {default = NONE, name = name})
-		       | Export {attributes, name} =>
-			    (check (ElabControl.allowExport, "_export")
-			     ; let
-				  val e =
-				     Env.scope
-				     (E, fn () =>
-				      (Env.openStructure
-				       (E, valOf (!Env.Structure.ffi))
-				       ; elab (export {attributes = attributes,
-						       name = name,
-						       region = region,
-						       ty = expandedTy})))
-				  val _ =
-				     unify
-				     (Cexp.ty e,
-				      Type.arrow (expandedTy, Type.unit),
-				      fn (l1, l2) =>
-				      let
-					 open Layout
-				      in
-					 (region,
-					  str "_export unify bug",
-					  align [seq [str "inferred: ", l1],
-						 seq [str "expanded: ", l2]])
-				      end)
-			       in
-				  wrap (e, Type.arrow (ty, Type.unit))
-			       end)
-		       | IImport {attributes} =>
-			    let
-			       val () =
-				  check (ElabControl.allowImport, "_import")
-			    in
-			       case (Type.deArrowOpt ty,
-				     Type.deArrowOpt expandedTy) of
-				  (SOME ty, SOME expandedTy) =>
-				     let
-					val ((fptrTy,ty), 
-					     (fptrExpandedTy,expandedTy)) =
-					   (ty, expandedTy)
-					val () =
-					   case Type.toCType fptrExpandedTy of
-					      SOME {ctype = CType.Pointer, ...} => ()
-					    | _ => 
-						 Control.error
-						 (region,
-						  str "invalid type for import",
-						  Type.layoutPretty fptrExpandedTy)
-					val fptr = Var.newNoname ()
-					val fptrArg = Cexp.var (fptr, fptrTy)
-				     in
-					Cexp.make
-					(Cexp.Lambda
-					 (Lambda.make 
-					  {arg = fptr,
-					   argType = fptrTy,
-					   body = etaExtra (Vector.new1 fptrArg,
-							    ty, expandedTy,
-							    import
-							    {attributes = attributes,
-							     name = NONE,
-							     region = region,
-							     ty = expandedTy}),
-					   mayInline = true}),
-					 Type.arrow (fptrTy, ty))
-				     end
-				| _ => 
-				     (Control.error
-				      (region,
-				       str "invalid type for import",
-				       Type.layoutPretty ty);
-				      eta Prim.bogus)
-			    end
-		       | Import {attributes, name} =>
-			    (check (ElabControl.allowImport, "_import")
-			     ; (case Type.deArrowOpt expandedTy of
-				   NONE => 
-				      wrap (fetchSymbol {attributes = attributes,
-							 name = name,
-							 primApp = primApp,
-							 region = region,
-							 ty = expandedTy}, ty)
-				 | SOME _ =>
-				      eta (import {attributes = attributes,
-						   name = SOME name,
-						   region = region,
-						   ty = expandedTy})))
-		       | Symbol {name} =>
-			    (check (ElabControl.allowImport, "_import")
-			     ; eta (symbol {name = name,
-					    region = region,
-					    ty = expandedTy}))
-		       | Prim {name} => 
-			    (check (ElabControl.allowPrim, "_prim")
-			     ; eta (Prim.fromString name))
-		   end
-	      | Aexp.Raise exn =>
-		   let
-		      val region = Aexp.region exn
-		      val exn = elab exn
-		      val _ =
-			 unify
-			 (Cexp.ty exn, Type.exn, fn (l1, _) =>
-			  (region,
-			   str "raise of non exception",
-			   seq [str "exp type: ", l1]))
-		      val resultType = Type.new ()
-		   in
-		      Cexp.make (Cexp.Raise exn, resultType)
-		   end
-	      | Aexp.Record r =>
-		   let
-		      val r = Record.map (r, elab)
-		      val ty =
-			 Type.record
-			 (SortedRecord.fromVector
-			  (Record.toVector (Record.map (r, Cexp.ty))))
-		   in
-		      Cexp.make (Cexp.Record r, ty)
-		   end
-	      | Aexp.Selector f => elab (Aexp.selector (f, region))
-	      | Aexp.Seq es =>
-		   let
-		      val es' = Vector.map (es, elab)
-		      val last = Vector.length es - 1
-		      (* Error for expressions before a ; that don't return
-		       * unit.
-		       *)
-		      val _ =
-			 if not (sequenceUnit ())
-			    then ()
-			 else
-			    Vector.foreachi
-			    (es', fn (i, e') =>
-			     if i = last
-				then ()
-			     else
-				let
-				   fun error (l, _) =
-				      let
-					 val e = Vector.sub (es, i)
-					 open Layout
-				      in
-					 Control.error
-					 (Aexp.region e,
-					  str "sequence expression not of type unit",
-					  align [seq [str "type: ", l],
-						 seq [str "in: ",
-						      approximate (Aexp.layout e)]])
-				      end
-				in
-				   Type.unify (Cexp.ty e', Type.unit,
-					       {error = error,
-						preError = preError})
-				end)
-		   in
-		      Cexp.make (Cexp.Seq es', Cexp.ty (Vector.sub (es', last)))
-		   end
-	      | Aexp.Var {name = id, ...} =>
-		   let
-		      val (vid, scheme) = Env.lookupLongvid (E, id)
-		      fun dontCare () =
-			 Cexp.var (Var.newNoname (), Type.new ())
-		   in
-		      case scheme of
-			 NONE => dontCare ()
-		       | SOME scheme => 
-			    let
-			       val {args, instance} = Scheme.instantiate scheme
-			       fun con c = Cexp.Con (c, args ())
-			       val e =
-				  case vid of
-				     Vid.Con c => con c
-				   | Vid.Exn c => con c
-				   | Vid.Overload (p, yts) =>
-					let
-					   val resolve =
-					      Promise.lazy
-					      (fn () =>
-					       case (Vector.peek
-						     (yts, fn (_, t) =>
-						      case t of
-							 NONE => false
-						       | SOME t => 
-							    Type.canUnify
-							    (instance, t))) of
-						  NONE =>
-						     let
-							val _ =
-							   Control.error
-							   (region,
-							    seq [str "impossible use of overloaded var: ",
-								 str (Longvid.toString id)],
-							    Type.layoutPretty instance)
-						     in
-							Var.newNoname ()
-						     end
-						| SOME (y, t) =>  
-						     (unify (instance,
-							     valOf t, fn _ =>
-							     Error.bug "overload unify")
-						      ; y))
-					   val _ = 
-					      List.push (overloads, (p, ignore o resolve))
-					in
-					   Cexp.Var (resolve, fn () => Vector.new0 ())
-					end
-				   | Vid.Var x =>
-					Cexp.Var (fn () => x,
-						  case ! (recursiveTargs x) of
-						     NONE => args
-						   | SOME f => f)
-			    in
-			       Cexp.make (e, instance)
-			    end
-		   end
-	      | Aexp.While {expr, test} =>
-		   let
-		      val test' = elab test
-		      val _ =
-			 unify
-			 (Cexp.ty test', Type.bool, fn (l1, _) =>
-			  (Aexp.region test,
-			   str "while test not of type bool",
-			   seq [str "test type: ", l1]))
-		      val expr = elab expr
-		      (* Error if expr is not of type unit. *)
-		      val _ =
-			 if not (sequenceUnit ())
-			    then ()
-			 else
-			    unify (Cexp.ty expr, Type.unit, fn (l, _) =>
-				   (region,
-				    str "while body not of type unit",
-				    seq [str "body type: ", l]))
-		   in
-		      Cexp.whilee {expr = expr, test = test'}
-		   end
-	  end) arg
+         Trace.traceInfo
+         (elabExpInfo,
+          Layout.tuple3 (Aexp.layout, Nest.layout, Layout.ignore),
+          Cexp.layout,
+          Trace.assertTrue)
+         (fn (e: Aexp.t, nest, maybeName) =>
+          let
+             val preError = Promise.lazy (fn () => Env.setTyconNames E)
+             val unify = fn (t, t', f) => unify (t, t', preError, f)
+             fun lay () = seq [str "in: ", approximate (Aexp.layout e)]
+             val unify =
+                fn (a, b, f) => unify (a, b, fn z =>
+                                       let
+                                          val (r, l, l') = f z
+                                       in
+                                          (r, l, align [l', lay ()])
+                                       end)
+             val region = Aexp.region e
+             fun elab e = elabExp (e, nest, NONE)
+          in
+             case Aexp.node e of
+                Aexp.Andalso (e, e') =>
+                   let
+                      val ce = elab e
+                      val ce' = elab e'
+                      fun doit (ce, br) =
+                         unify
+                         (Cexp.ty ce, Type.bool,
+                          fn (l, _) =>
+                          (Aexp.region e,
+                           str (concat
+                                [br, " branch of andalso not of type bool"]),
+                           seq [str " branch: ", l]))
+                      val _ = doit (ce, "left")
+                      val _ = doit (ce', "right")
+                   in
+                      Cexp.andAlso (ce, ce')
+                   end
+              | Aexp.App (e1, e2) =>
+                   let
+                      val e1 = elab e1
+                      val e2 = elab e2
+                      val argType = Type.new ()
+                      val resultType = Type.new ()
+                      val _ =
+                         unify (Cexp.ty e1, Type.arrow (argType, resultType),
+                                fn (l, _) =>
+                                (region,
+                                 str "function not of arrow type",
+                                 seq [str "function: ", l]))
+                      val _ =
+                         unify
+                         (argType, Cexp.ty e2, fn (l1, l2) =>
+                          (region,
+                           str "function applied to incorrect argument",
+                           align [seq [str "expects: ", l1],
+                                  seq [str "but got: ", l2]]))
+                   in
+                      Cexp.make (Cexp.App (e1, e2), resultType)
+                   end
+              | Aexp.Case (e, m) =>
+                   let
+                      val e = elab e
+                      val {argType, rules, ...} = elabMatch (m, preError, nest)
+                      val _ =
+                         unify
+                         (Cexp.ty e, argType, fn (l1, l2) =>
+                          (region,
+                           str "case object and rules disagree",
+                           align [seq [str "object type:  ", l1],
+                                  seq [str "rules expect: ", l2]]))
+                   in
+                      Cexp.casee {kind = "case",
+                                  lay = lay,
+                                  noMatch = Cexp.RaiseMatch,
+                                  nonexhaustiveExnMatch = nonexhaustiveExnMatch (),
+                                  nonexhaustiveMatch = nonexhaustiveMatch (),
+                                  redundantMatch = redundantMatch (),
+                                  region = region,
+                                  rules = rules,
+                                  test = e}
+                   end
+              | Aexp.Const c =>
+                   elabConst
+                   (c,
+                    fn (resolve, ty) => Cexp.make (Cexp.Const resolve, ty),
+                    {false = Cexp.falsee,
+                     true = Cexp.truee})
+              | Aexp.Constraint (e, t') =>
+                   let
+                      val e = elab e
+                      val _ =
+                         unify
+                         (Cexp.ty e, elabType t', fn (l1, l2) =>
+                          (region,
+                           str "expression and constraint disagree",
+                           align [seq [str "expects: ", l2],
+                                  seq [str "but got: ", l1]]))
+                   in
+                      e
+                   end
+              | Aexp.FlatApp items => elab (Parse.parseExp (items, E, lay))
+              | Aexp.Fn m =>
+                   let
+                      val nest =
+                         case maybeName of
+                            NONE => "fn" :: nest
+                          | SOME s => s :: nest
+                      val {arg, argType, body} =
+                         elabMatchFn (m, preError, nest, "function", lay,
+                                      Cexp.RaiseMatch)
+                      val body =
+                         Cexp.enterLeave
+                         (body, 
+                          profileBody,
+                          fn () => SourceInfo.function {name = nest,
+                                                        region = region})
+                   in
+                      Cexp.make (Cexp.Lambda (Lambda.make {arg = arg,
+                                                           argType = argType,
+                                                           body = body,
+                                                           mayInline = true}),
+                                 Type.arrow (argType, Cexp.ty body))
+                   end
+              | Aexp.Handle (try, match) =>
+                   let
+                      val try = elab try
+                      val {arg, argType, body} =
+                         elabMatchFn (match, preError, nest, "handler", lay,
+                                      Cexp.RaiseAgain)
+                      val _ =
+                         unify
+                         (Cexp.ty try, Cexp.ty body, fn (l1, l2) =>
+                          (region,
+                           str "expression and handler disagree",
+                           align [seq [str "expression: ", l1],
+                                  seq [str "handler:    ", l2]]))
+                      val _ =
+                         unify
+                         (argType, Type.exn, fn (l1, _) =>
+                          (Amatch.region match,
+                           seq [str "handler handles wrong type: ", l1],
+                           empty))
+                   in
+                      Cexp.make (Cexp.Handle {catch = (arg, Type.exn),
+                                              handler = body, 
+                                              try = try},
+                                 Cexp.ty try)
+                   end
+              | Aexp.If (a, b, c) =>
+                   let
+                      val a' = elab a
+                      val b' = elab b
+                      val c' = elab c
+                      val _ =
+                         unify
+                         (Cexp.ty a', Type.bool, fn (l1, _) =>
+                          (Aexp.region a,
+                           str "if test not of type bool",
+                           seq [str "test type: ", l1]))
+                      val _ =
+                         unify
+                         (Cexp.ty b', Cexp.ty c', fn (l1, l2) =>
+                          (region,
+                           str "then and else branches disagree",
+                           align [seq [str "then: ", l1],
+                                  seq [str "else: ", l2]]))
+                      val (b', c') =
+                         if not (!Control.profileBranch)
+                            then (b', c')
+                         else
+                            let
+                               fun wrap (e, e', name) =
+                                  Cexp.enterLeave
+                                  (e', profileBody, fn () =>
+                                   SourceInfo.function
+                                   {name = name :: nest,
+                                    region = Aexp.region e})
+                            in
+                               (wrap (b, b', "<true>"), wrap (c, c', "<false>"))
+                            end
+                   in
+                      Cexp.iff (a', b', c')
+                   end
+              | Aexp.Let (d, e) =>
+                   Env.scope
+                   (E, fn () =>
+                    let
+                       val time = Time.now ()
+                       val d = Decs.toVector (elabDec (d, nest, false))
+                       val e = elab e
+                       val ty = Cexp.ty e
+                       val () = Type.minTime (ty, time)
+                    in
+                       Cexp.make (Cexp.Let (d, e), ty)
+                    end)
+              | Aexp.List es =>
+                   let
+                      val es' = Vector.map (es, elab)
+                   in
+                      Cexp.make (Cexp.List es',
+                                 unifyList
+                                 (Vector.map2 (es, es', fn (e, e') =>
+                                               (Cexp.ty e', Aexp.region e)),
+                                  preError, lay))
+                   end
+              | Aexp.Orelse (e, e') =>
+                   let
+                      val ce = elab e
+                      val ce' = elab e'
+                      fun doit (ce, br) =
+                         unify
+                         (Cexp.ty ce, Type.bool,
+                          fn (l, _) =>
+                          (Aexp.region e,
+                           str (concat
+                                [br, " branch of orelse not of type bool"]),
+                           seq [str " branch: ", l]))
+                      val _ = doit (ce, "left")
+                      val _ = doit (ce', "right")
+                   in
+                      Cexp.orElse (ce, ce')
+                   end
+              | Aexp.Prim kind => 
+                   let
+                      fun elabAndExpandTy ty =
+                         let
+                            val elabedTy = elabType ty
+                            val expandedTy =
+                               Type.hom
+                               (elabedTy, {con = Type.con,
+                                           expandOpaque = true,
+                                           record = Type.record,
+                                           replaceSynonyms = false,
+                                           var = Type.var})
+                         in
+                            (elabedTy, expandedTy)
+                         end
+                      (* We use expandedTy to get the underlying primitive right
+                       * but we use wrap in the end to make the result of the
+                       * final expression be ty, because that is what the rest
+                       * of the code expects to see.
+                       *)
+                      fun wrap (e, t) = Cexp.make (Cexp.node e, t)
+                      fun etaExtraNoWrap {expandedTy,
+                                          extra, 
+                                          prim: Type.t Prim.t}: Cexp.t =
+                         case Type.deArrowOpt expandedTy of
+                            NONE => primApp {args = extra,
+                                             prim = prim,
+                                             result = expandedTy}
+                          | SOME (argType, bodyType) =>
+                               let
+                                  val arg = Var.newNoname ()
+                                  fun app args =
+                                     primApp {args = Vector.concat [extra, args],
+                                              prim = prim,
+                                              result = bodyType}
+                                  val body =
+                                     case Type.deTupleOpt argType of
+                                        NONE => 
+                                           app (Vector.new1
+                                                (Cexp.var (arg, argType)))
+                                      | SOME ts =>
+                                           let
+                                              val vars =
+                                                 Vector.map
+                                                 (ts, fn t =>
+                                                  (Var.newNoname (), t))
+                                           in
+                                              Cexp.casee
+                                              {kind = "",
+                                               lay = fn _ => Layout.empty,
+                                               noMatch = Cexp.Impossible,
+                                               nonexhaustiveExnMatch = Control.Elaborate.DiagDI.Default,
+                                               nonexhaustiveMatch = Control.Elaborate.DiagEIW.Ignore,
+                                               redundantMatch = Control.Elaborate.DiagEIW.Ignore,
+                                               region = Region.bogus,
+                                               rules = Vector.new1
+                                                       {exp = app (Vector.map
+                                                                   (vars, Cexp.var)),
+                                                        lay = NONE,
+                                                        pat = Cpat.tuple 
+                                                              (Vector.map 
+                                                               (vars, Cpat.var))},
+                                               test = Cexp.var (arg, argType)}
+                                           end
+                               in
+                                  (Cexp.lambda o Lambda.make)
+                                  {arg = arg,
+                                   argType = argType,
+                                   body = body,
+                                   mayInline = true}
+                               end
+                      fun etaNoWrap {expandedTy, 
+                                     prim: Type.t Prim.t} : Cexp.t =
+                         etaExtraNoWrap {expandedTy = expandedTy,
+                                         extra = Vector.new0 (),
+                                         prim = prim}
+                      fun eta {elabedTy, expandedTy, 
+                               prim: Type.t Prim.t} : Cexp.t =
+                         wrap (etaNoWrap {expandedTy = expandedTy,
+                                          prim = prim},
+                               elabedTy)
+                      fun lookConst {default: string option, 
+                                     elabedTy, expandedTy,
+                                     name: string} =
+                         let
+                            fun bug () =
+                               let
+                                  open Layout
+                                  val _ =
+                                     Control.error
+                                     (region,
+                                      seq [str "strange constant type: ",
+                                           Type.layout expandedTy],
+                                      empty)
+                               in
+                                  Error.bug "ElaborateCore.elabExp.lookConst"
+                               end
+                         in
+                            case Type.deConOpt expandedTy of
+                               NONE => bug ()
+                             | SOME (c, ts) =>
+                                  let
+                                     val ct =
+                                        if Tycon.equals (c, Tycon.bool)
+                                           then ConstType.Bool
+                                        else if Tycon.isIntX c
+                                           then ConstType.Word
+                                        else if Tycon.isRealX c
+                                           then ConstType.Real
+                                        else if Tycon.isWordX c
+                                           then ConstType.Word
+                                        else if Tycon.equals (c, Tycon.vector)
+                                           andalso 1 = Vector.length ts
+                                           andalso
+                                           (case (Type.deConOpt
+                                                  (Vector.sub (ts, 0))) of
+                                               NONE => false
+                                             | SOME (c, _) => 
+                                                  Tycon.isCharX c)
+                                           then ConstType.String
+                                        else bug ()
+                                  val finish =
+                                     fn () => ! Const.lookup ({default = default,
+                                                               name = name}, ct)
+                                  in
+                                     Cexp.make (Cexp.Const finish, elabedTy)
+                                  end
+                         end
+                      val check = fn (c, n) => check (c, n, region)
+                      datatype z = datatype Ast.PrimKind.t
+                   in
+                      case kind of
+                         Address {name, ty} =>
+                            let
+                               val () =
+                                  check (ElabControl.allowFFI, "_address")
+                               val (elabedTy, expandedTy) =
+                                  elabAndExpandTy ty
+                            in
+                               address {elabedTy = elabedTy,
+                                        expandedTy = expandedTy,
+                                        name = name,
+                                        region = region}
+                            end
+                       | BuildConst {name, ty} =>
+                            let
+                               val () =
+                                  check (ElabControl.allowConstant, 
+                                         "_build_const")
+                               val (elabedTy, expandedTy) = 
+                                  elabAndExpandTy ty
+                            in
+                               lookConst {default = NONE,
+                                          elabedTy = elabedTy,
+                                          expandedTy = expandedTy,
+                                          name = name}
+                            end
+                       | CommandLineConst {name, ty, value} =>
+                            let
+                               val () =
+                                  check (ElabControl.allowConstant,
+                                         "_command_line_const")
+                               val (elabedTy, expandedTy) = 
+                                  elabAndExpandTy ty
+                               val value =
+                                  elabConst
+                                  (value,
+                                   fn (resolve, _) =>
+                                   case resolve () of
+                                      Const.Word w =>
+                                         IntInf.toString (WordX.toIntInf w)
+                                    | c => Const.toString c,
+                                   {false = "false", true = "true"})
+                            in
+                               lookConst {default = SOME value, 
+                                          elabedTy = elabedTy,
+                                          expandedTy = expandedTy,
+                                          name = name}
+                            end
+                       | Const {name, ty} => 
+                            let
+                               val () =
+                                  check (ElabControl.allowConstant, 
+                                         "_const")
+                               val (elabedTy, expandedTy) = 
+                                  elabAndExpandTy ty
+                            in
+                               lookConst {default = NONE,
+                                          elabedTy = elabedTy,
+                                          expandedTy = expandedTy,
+                                          name = name}
+                            end
+                       | Export {attributes, name, ty} =>
+                            let
+                               val () =
+                                  check (ElabControl.allowFFI, "_export")
+                               val (elabedTy, expandedTy) = 
+                                  elabAndExpandTy ty
+                               fun error () =
+                                  Control.error 
+                                  (region,
+                                   str "invalid type for _export",
+                                   Type.layoutPretty elabedTy)
+                               val (expandedCfTy, elabedExportTy) =
+                                  Exn.withEscape
+                                  (fn escape =>
+                                   let
+                                      val error = fn () =>
+                                         (error ()
+                                          ; ignore (escape (Type.arrow (Type.unit, Type.unit),
+                                                            elabedTy))
+                                          ; Error.bug "ElaborateCore.elabExp.Export.escape")
+                                   in
+                                      case Type.deArrowOpt expandedTy of
+                                         NONE => error ()
+                                       | SOME (argTy, resTy) =>
+                                            (case Type.deArrowOpt argTy of
+                                                NONE => 
+                                                   let
+                                                      val elabedExportTy =
+                                                         Type.arrow (elabedTy, Type.unit)
+                                                      val () =
+                                                         Control.warning
+                                                         (region,
+                                                          seq [str "_export with partial annotation is deprecated, ",
+                                                               str "use ", 
+                                                               Type.layoutPretty (elabedExportTy)],
+                                                          empty)
+                                                   in
+                                                      (expandedTy, elabedExportTy)
+                                                   end
+                                              | SOME _ => 
+                                                   let
+                                                      val () =
+                                                         if Type.isUnit resTy
+                                                            then ()
+                                                            else error ()
+                                                   in
+                                                      (argTy, elabedTy)
+                                                   end)
+                                   end)
+                               val exp =
+                                  Env.scope
+                                  (E, fn () =>
+                                   (Env.openStructure
+                                    (E, valOf (!Env.Structure.ffi))
+                                    ; elab (export {attributes = attributes,
+                                                    elabedTy = elabedTy,
+                                                    expandedTy = expandedCfTy,
+                                                    name = name,
+                                                    region = region})))
+                               val _ =
+                                  unify
+                                  (Cexp.ty exp,
+                                   Type.arrow (expandedCfTy, Type.unit),
+                                   fn (l1, l2) =>
+                                   let
+                                      open Layout
+                                   in
+                                      (region,
+                                       str "_export unify bug",
+                                       align [seq [str "inferred: ", l1],
+                                              seq [str "expanded: ", l2]])
+                                   end)
+                            in
+                               wrap (exp, elabedExportTy)
+                            end
+                       | IImport {attributes, ty} =>
+                            let
+                               val () =
+                                  check (ElabControl.allowFFI, "_import")
+                               val (elabedTy, expandedTy) =
+                                  elabAndExpandTy ty
+                               fun error () =
+                                  Control.error 
+                                  (region,
+                                   str "invalid type for _import",
+                                   Type.layoutPretty elabedTy)
+                               val (expandedFPtrTy, expandedCfTy) =
+                                  Exn.withEscape
+                                  (fn escape =>
+                                   let
+                                      val error = fn () =>
+                                         (error ()
+                                          ; ignore (escape (Type.pointer, Type.arrow (Type.unit, Type.unit)))
+                                          ; Error.bug "ElaborateCore.elabExp.IImport.escape")
+                                   in
+                                      case Type.deArrowOpt expandedTy of
+                                         NONE => error ()
+                                       | SOME (fptrTy, cfTy) => (fptrTy, cfTy)
+                                   end)
+                               val () =
+                                  case Type.toCType expandedFPtrTy of
+                                     SOME {ctype = CType.Pointer, ...} => ()
+                                   | _ => (error (); ())
+                               val fptr = Var.newNoname ()
+                               val fptrArg = Cexp.var (fptr, expandedFPtrTy)
+                            in
+                               wrap
+                               ((Cexp.lambda o Lambda.make)
+                                {arg = fptr,
+                                 argType = expandedFPtrTy,
+                                 body = etaExtraNoWrap {expandedTy = expandedCfTy,
+                                                        extra = Vector.new1 fptrArg,
+                                                        prim = import
+                                                               {attributes = attributes,
+                                                                name = NONE,
+                                                                region = region,
+                                                                elabedTy = elabedTy,
+                                                                expandedTy = expandedCfTy}},
+                                 mayInline = true},
+                                elabedTy)
+                            end
+                       | Import {attributes, name, ty} =>
+                            let
+                               val () =
+                                  check (ElabControl.allowFFI, "_import")
+                               val (elabedTy, expandedTy) =
+                                  elabAndExpandTy ty
+                            in
+                               case Type.deArrowOpt expandedTy of
+                                  NONE => 
+                                     importSymbol {attributes = attributes,
+                                                   elabedTy = elabedTy,
+                                                   expandedTy = expandedTy,
+                                                   name = name,
+                                                   region = region}
+                                | SOME _ =>
+                                     eta ({elabedTy = elabedTy,
+                                           expandedTy = expandedTy,
+                                           prim = import {attributes = attributes,
+                                                          name = SOME name,
+                                                          region = region,
+                                                          elabedTy = elabedTy,
+                                                          expandedTy = expandedTy}})
+                            end
+                       | ISymbol {ty} =>
+                            let
+                               val () =
+                                  check (ElabControl.allowFFI, "_symbol")
+                               val (elabedTy, expandedTy) =
+                                  elabAndExpandTy ty
+                            in
+                               symbolIndirect {elabedTy = elabedTy,
+                                               expandedTy = expandedTy,
+                                               region = region}
+                            end
+                       | Prim {name, ty} => 
+                            let
+                               val () =
+                                  check (ElabControl.allowPrim, 
+                                         "_prim")
+                               val (elabedTy, expandedTy) = 
+                                  elabAndExpandTy ty
+                               val prim =
+                                  case Prim.fromString name of
+                                     NONE =>
+                                        (Control.error
+                                         (region,
+                                          str (concat ["unknown primitive: ",
+                                                       name]),
+                                          empty)
+                                         ; Prim.bogus)
+                                   | SOME p => p
+                            in
+                               eta {elabedTy = elabedTy,
+                                    expandedTy = expandedTy,
+                                    prim = prim}
+                            end
+                       | Symbol {attributes, name, ty} =>
+                            let
+                               val () =
+                                  check (ElabControl.allowFFI, "_symbol")
+                               val (elabedTy, expandedTy) =
+                                  elabAndExpandTy ty
+                            in
+                               symbolDirect {attributes = attributes,
+                                             elabedTy = elabedTy,
+                                             expandedTy = expandedTy,
+                                             name = name,
+                                             region = region}
+                            end
+                   end
+              | Aexp.Raise exn =>
+                   let
+                      val region = Aexp.region exn
+                      val exn = elab exn
+                      val _ =
+                         unify
+                         (Cexp.ty exn, Type.exn, fn (l1, _) =>
+                          (region,
+                           str "raise of non exception",
+                           seq [str "exp type: ", l1]))
+                      val resultType = Type.new ()
+                   in
+                      Cexp.enterLeave
+                      (Cexp.make (Cexp.Raise exn, resultType),
+                       profileBody andalso !Control.profileRaise,
+                       fn () => SourceInfo.function {name = "raise" :: nest,
+                                                     region = region})
+                   end
+              | Aexp.Record r =>
+                   let
+                      val r = Record.map (r, elab)
+                      val ty =
+                         Type.record
+                         (SortedRecord.fromVector
+                          (Record.toVector (Record.map (r, Cexp.ty))))
+                   in
+                      Cexp.make (Cexp.Record r, ty)
+                   end
+              | Aexp.Selector f => elab (Aexp.selector (f, region))
+              | Aexp.Seq es =>
+                   let
+                      val es' = Vector.map (es, elab)
+                      val last = Vector.length es - 1
+                      (* Diagnose expressions before a ; that don't return unit. *)
+                      val _ =
+                         let
+                            fun doit f =
+                               List.push
+                               (sequenceTypeChecks, fn () =>
+                                Vector.foreachi
+                                (es', fn (i, e') =>
+                                 if i = last 
+                                    then ()
+                                    else let
+                                            val ty = Cexp.ty e'
+                                         in
+                                            if Type.isUnit ty
+                                               then ()
+                                               else let
+                                                       val e = Vector.sub (es, i)
+                                                       open Layout
+                                                    in 
+                                                       f (Aexp.region e,
+                                                          str "sequence expression not of type unit",
+                                                          align [seq [str "type: ", Type.layoutPrettyBracket ty],
+                                                                 seq [str "in: ",
+                                                                      approximate (Aexp.layout e)]])
+                                                    end
+                                         end))
+                         in
+                            case sequenceNonUnit () of
+                               Control.Elaborate.DiagEIW.Error => doit Control.error
+                             | Control.Elaborate.DiagEIW.Ignore => ()
+                             | Control.Elaborate.DiagEIW.Warn => doit Control.warning
+                         end
+                   in
+                      Cexp.make (Cexp.Seq es', Cexp.ty (Vector.sub (es', last)))
+                   end
+              | Aexp.Var {name = id, ...} =>
+                   let
+                      val (vid, scheme) = Env.lookupLongvid (E, id)
+                      fun dontCare () =
+                         Cexp.var (Var.newNoname (), Type.new ())
+                   in
+                      case scheme of
+                         NONE => dontCare ()
+                       | SOME scheme => 
+                            let
+                               val {args, instance} = Scheme.instantiate scheme
+                               fun con c = Cexp.Con (c, args ())
+                               val e =
+                                  case vid of
+                                     Vid.Con c => con c
+                                   | Vid.Exn c => con c
+                                   | Vid.Overload (p, yts) =>
+                                        let
+                                           val resolve =
+                                              Promise.lazy
+                                              (fn () =>
+                                               case (Vector.peek
+                                                     (yts, fn (_, t) =>
+                                                      case t of
+                                                         NONE => false
+                                                       | SOME t => 
+                                                            Type.canUnify
+                                                            (instance, t))) of
+                                                  NONE =>
+                                                     let
+                                                        val _ =
+                                                           Control.error
+                                                           (region,
+                                                            seq [str "impossible use of overloaded var: ",
+                                                                 str (Longvid.toString id)],
+                                                            Type.layoutPretty instance)
+                                                     in
+                                                        Var.newNoname ()
+                                                     end
+                                                | SOME (y, t) =>  
+                                                     (unify (instance,
+                                                             valOf t, fn _ =>
+                                                             Error.bug "ElaborateCore.elabExp: Var:overload unify")
+                                                      ; y))
+                                           val _ = 
+                                              List.push (overloads, (p, ignore o resolve))
+                                        in
+                                           Cexp.Var (resolve, fn () => Vector.new0 ())
+                                        end
+                                   | Vid.Var x =>
+                                        Cexp.Var (fn () => x,
+                                                  case ! (recursiveTargs x) of
+                                                     NONE => args
+                                                   | SOME f => f)
+                            in
+                               Cexp.make (e, instance)
+                            end
+                   end
+              | Aexp.While {expr, test} =>
+                   let
+                      val test' = elab test
+                      val _ =
+                         unify
+                         (Cexp.ty test', Type.bool, fn (l1, _) =>
+                          (Aexp.region test,
+                           str "while test not of type bool",
+                           seq [str "test type: ", l1]))
+                      val expr' = elab expr
+                      (* Diagnose if expr is not of type unit. *)
+                      val _ =
+                         let
+                            fun doit f =
+                               List.push
+                               (sequenceTypeChecks, fn () =>
+                                let
+                                   val ty = Cexp.ty expr'
+                                in
+                                   if Type.isUnit ty 
+                                      then ()
+                                      else f (Aexp.region expr,
+                                              str "while body not of type unit",
+                                              seq [str "body type: ", Type.layoutPrettyBracket ty])
+                                end)
+                         in
+                            case sequenceNonUnit () of
+                               Control.Elaborate.DiagEIW.Error => doit Control.error
+                             | Control.Elaborate.DiagEIW.Ignore => ()
+                             | Control.Elaborate.DiagEIW.Warn => doit Control.warning
+                         end
+                   in
+                      Cexp.whilee {expr = expr', test = test'}
+                   end
+          end) arg
       and elabMatchFn (m: Amatch.t, preError, nest, kind, lay, noMatch) =
-	 let
-	    val arg = Var.newNoname ()
-	    val {argType, region, rules, ...} = elabMatch (m, preError, nest)
-	    val body =
-	       Cexp.casee {kind = kind,
-			   lay = lay,
-			   noMatch = noMatch,
-			   region = region,
-			   rules = rules,
-			   test = Cexp.var (arg, argType),
-			   warnMatch = warnMatch ()}
-	 in
-	   {arg = arg,
-	    argType = argType,
-	    body = body}
-	 end
+         let
+            val arg = Var.newNoname ()
+            val {argType, region, rules, ...} = elabMatch (m, preError, nest)
+            val body =
+               Cexp.casee {kind = kind,
+                           lay = lay,
+                           noMatch = noMatch,
+                           nonexhaustiveExnMatch = nonexhaustiveExnMatch (),
+                           nonexhaustiveMatch = nonexhaustiveMatch (),
+                           redundantMatch = redundantMatch (),
+                           region = region,
+                           rules = rules,
+                           test = Cexp.var (arg, argType)}
+         in
+           {arg = arg,
+            argType = argType,
+            body = body}
+         end
       and elabMatch (m: Amatch.t, preError, nest: Nest.t) =
-	 let
-	    val region = Amatch.region m
-	    val Amatch.T rules = Amatch.node m
-	    val argType = Type.new ()
-	    val resultType = Type.new ()
-	    val rules =
-	       Vector.map
-	       (rules, fn (pat, exp) =>
-		Env.scope
-		(E, fn () =>
-		 let
-		    fun lay () =
-		       let
-			  open Layout
-		       in
-			  approximate
-			  (seq [Apat.layout pat, str " => ", Aexp.layout exp])
-		       end
-		    val (p, _) =
-		       elaboratePat () (pat, E, {bind = true, isRvb = false},
-					preError)
-		    val _ =
-		       unify
-		       (Cpat.ty p, argType, preError, fn (l1, l2) =>
-			(Apat.region pat,
-			 str "rule patterns disagree",
-			 align [seq [str "pattern:  ", l1],
-				seq [str "previous: ", l2],
-				seq [str "in: ", lay ()]]))
-		    val e = elabExp (exp, nest, NONE)
-		    val _ =
-		       unify
-		       (Cexp.ty e, resultType, preError, fn (l1, l2) =>
-			(Aexp.region exp,
-			 str "rule results disagree",
-			 align [seq [str "result:   ", l1],
-				seq [str "previous: ", l2],
-				seq [str "in: ", lay ()]]))
-		    val e =
-		       Cexp.enterLeave
-		       (e, !Control.profileBranch, fn () =>
-			SourceInfo.function {name = "<branch>" :: nest,
-					     region = Aexp.region exp})
-		 in
-		    {exp = e,
-		     lay = SOME lay,
-		     pat = p}
-		 end))
-	 in
-	    {argType = argType,
-	     region = region,
-	     resultType = resultType,
-	     rules = rules}
-	 end
+         let
+            val region = Amatch.region m
+            val Amatch.T rules = Amatch.node m
+            val argType = Type.new ()
+            val resultType = Type.new ()
+            val rules =
+               Vector.map
+               (rules, fn (pat, exp) =>
+                Env.scope
+                (E, fn () =>
+                 let
+                    fun lay () =
+                       let
+                          open Layout
+                       in
+                          approximate
+                          (seq [Apat.layout pat, str " => ", Aexp.layout exp])
+                       end
+                    val (p, _) =
+                       elaboratePat () (pat, E, {bind = true, isRvb = false},
+                                        preError)
+                    val _ =
+                       unify
+                       (Cpat.ty p, argType, preError, fn (l1, l2) =>
+                        (Apat.region pat,
+                         str "rule patterns disagree",
+                         align [seq [str "pattern:  ", l1],
+                                seq [str "previous: ", l2],
+                                seq [str "in: ", lay ()]]))
+                    val e = elabExp (exp, nest, NONE)
+                    val _ =
+                       unify
+                       (Cexp.ty e, resultType, preError, fn (l1, l2) =>
+                        (Aexp.region exp,
+                         str "rule results disagree",
+                         align [seq [str "result:   ", l1],
+                                seq [str "previous: ", l2],
+                                seq [str "in: ", lay ()]]))
+                    val e =
+                       Cexp.enterLeave
+                       (e, 
+                        profileBody andalso !Control.profileBranch, 
+                        fn () =>
+                        SourceInfo.function {name = "<branch>" :: nest,
+                                             region = Aexp.region exp})
+                 in
+                    {exp = e,
+                     lay = SOME lay,
+                     pat = p}
+                 end))
+         in
+            {argType = argType,
+             region = region,
+             resultType = resultType,
+             rules = rules}
+         end
       val ds = elabDec (Scope.scope d, nest, true)
       (* List.insertionSort is anti-stable;
        * hence, it sorts and reverses the overloads. 
        *)
       val _ = List.foreach (List.insertionSort
-			    (!overloads, fn ((x,_),(y,_)) =>
-			     Priority.<= (y, x)),
-			    fn (_,p) => (p (); ()))
+                            (!overloads, fn ((x,_),(y,_)) =>
+                             Priority.<= (y, x)),
+                            fn (_,p) => (p (); ()))
       val _ = overloads := []
    in
       ds
@@ -2741,4 +3147,8 @@
    (List.foreach (rev (!freeTyvarChecks), fn p => p ())
     ; freeTyvarChecks := [])
 
+fun reportSequenceNonUnit () =
+   (List.foreach (rev (!sequenceTypeChecks), fn p => p ())
+    ; sequenceTypeChecks := [])
+
 end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/elaborate/elaborate-core.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/elaborate/elaborate-core.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/elaborate/elaborate-core.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,9 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 type int = Int.t
@@ -26,5 +26,6 @@
 
       (* Elaborate dec in env, returning Core ML decs. *)
       val elaborateDec: Ast.Dec.t * {env: Env.t, nest: string list} -> Decs.t
+      val reportSequenceNonUnit: unit -> unit
       val reportUndeterminedTypes: unit -> unit
    end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/elaborate/elaborate-env.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/elaborate/elaborate-env.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/elaborate/elaborate-env.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 functor ElaborateEnv (S: ELABORATE_ENV_STRUCTS): ELABORATE_ENV =
 struct
 
@@ -15,7 +16,8 @@
 local
    open Control.Elaborate
 in
-   val warnMatch = fn () => current warnMatch
+   val nonexhaustiveExnMatch = fn () => current nonexhaustiveExnMatch
+   val nonexhaustiveMatch = fn () => current nonexhaustiveMatch
    val warnUnused = fn () => current warnUnused
 end
 
@@ -69,88 +71,96 @@
 structure Tycon =
    struct
       open Tycon
-	 
+         
       val admitsEquality = TypeEnv.tyconAdmitsEquality
    end
 
 structure Type =
    struct
       open Type
-	 
+
+      fun bracket l = let open Layout in seq [str "[", l, str "]"] end
+
       fun explainDoesNotAdmitEquality (t: t): Layout.t =
-	 let
-	    open Layout
-	    val wild = (str "_", {isChar = false, needsParen = false})
-	    fun con (c, ts) =
-	       let
-		  fun keep {showInside: bool} =
-		     Tycon.layoutApp
-		     (c, Vector.map (ts, fn t =>
-				     if showInside
-					then
-					   case t of
-					      NONE => wild
-					    | SOME t => t
-				     else wild))
-		  datatype z = datatype AdmitsEquality.t
-	       in
-		  case ! (Tycon.admitsEquality c) of
-		     Always => NONE
-		   | Never => SOME (keep {showInside = false})
-		   | Sometimes =>
-			if Vector.exists (ts, Option.isSome)
-			   then SOME (keep {showInside = true})
-			else NONE
-	       end
-	    fun record r =
-	       if SortedRecord.forall (r, Option.isNone)
-		  then NONE
-	       else
-		  SOME
-		  (case SortedRecord.detupleOpt r of
-		      NONE =>
-			 let
-			    val v = SortedRecord.toVector r
-			 in
-			    (seq
-			     [str "{",
-			      mayAlign
-			      (separateRight
-			       (Vector.foldr
-				(v, [], fn ((f, z), ac) =>
-				 case z of
-				    NONE => ac
-				  | SOME (z, _) =>
-				       seq [Field.layout f, str ": ", z] :: ac),
-				",")),
-			      str "}"],
-			     {isChar = false, needsParen = false})
-			 end
-		    | SOME v =>
-			 Tycon.layoutApp
-			 (Tycon.tuple,
-			  Vector.map (v, fn NONE => wild | SOME t => t)))
-	    val exp =
-	       hom (t, {con = con,
-			expandOpaque = false,
-			record = record,
-			replaceSynonyms = false,
-			var = fn _ => NONE})
-	 in
-	    case exp of
-	       NONE => str "???"
-	     | SOME (exp, _) => exp
-	 end
+         let
+            open Layout
+            val wild = (str "_", {isChar = false, needsParen = false})
+            fun con (c, ts) =
+               let
+                  fun keep {showInside: bool} =
+                     Tycon.layoutApp
+                     (c, Vector.map (ts, fn t =>
+                                     if showInside
+                                        then
+                                           case t of
+                                              NONE => wild
+                                            | SOME t => t
+                                     else wild))
+                  datatype z = datatype AdmitsEquality.t
+               in
+                  case ! (Tycon.admitsEquality c) of
+                     Always => NONE
+                   | Never => SOME (bracket (#1 (keep {showInside = false})),
+                                    {isChar = false, needsParen = false})
+                   | Sometimes =>
+                        if Vector.exists (ts, Option.isSome)
+                           then SOME (keep {showInside = true})
+                        else NONE
+               end
+            fun record r =
+               if SortedRecord.forall (r, Option.isNone)
+                  then NONE
+               else
+                  SOME
+                  (case SortedRecord.detupleOpt r of
+                      NONE =>
+                         let
+                            val v = SortedRecord.toVector r
+                            val ending =
+                               if SortedRecord.exists (r, Option.isNone) then
+                                  ", ...}"
+                               else
+                                  "}"
+                         in
+                            (seq
+                             [str "{",
+                              mayAlign
+                              (separateRight
+                               (Vector.foldr
+                                (v, [], fn ((f, z), ac) =>
+                                 case z of
+                                    NONE => ac
+                                  | SOME (z, _) =>
+                                       seq [Field.layout f, str ": ", z] :: ac),
+                                ",")),
+                              str ending],
+                             {isChar = false, needsParen = false})
+                         end
+                    | SOME v =>
+                         Tycon.layoutApp
+                         (Tycon.tuple,
+                          Vector.map (v, fn NONE => wild | SOME t => t)))
+            val exp =
+               hom (t, {con = con,
+                        expandOpaque = false,
+                        record = record,
+                        replaceSynonyms = false,
+                        var = fn _ => NONE})
+         in
+            case exp of
+               NONE => str "???"
+             | SOME (exp, _) => exp
+         end
    end
 
 structure Scheme =
    struct
       open Scheme
-	 
+         
       fun bogus () = fromType (Type.new ())
 
       fun explainDoesNotAdmitEquality (s: t): Layout.t =
-	 Type.explainDoesNotAdmitEquality (ty s)
+         Type.explainDoesNotAdmitEquality (ty s)
    end
 
 val insideFunctor = ref false
@@ -161,18 +171,18 @@
    struct
       structure Unique = UniqueId ()
       datatype t = T of {isTop: bool,
-			 unique: Unique.t}
+                         unique: Unique.t}
 
       local
-	 fun make f (T r) = f r
+         fun make f (T r) = f r
       in
-	 val isTop = make #isTop
-	 val unique = make #unique
+         val isTop = make #isTop
+         val unique = make #unique
       end
 
       fun new {isTop: bool}: t =
-	 T {isTop = isTop,
-	    unique = Unique.new ()}
+         T {isTop = isTop,
+            unique = Unique.new ()}
 
       fun equals (s, s') = Unique.equals (unique s, unique s')
    end
@@ -191,10 +201,10 @@
    end =
    struct
       datatype 'a t = T of {direct: 'a list ref,
-			    forceUsed: bool ref}
+                            forceUsed: bool ref}
  
       fun new () = T {direct = ref [],
-		      forceUsed = ref false}
+                      forceUsed = ref false}
 
       fun add (T {direct, ...}, a) = List.push (direct, a)
 
@@ -205,10 +215,10 @@
       fun all (T {direct, ...}) = !direct
 
       fun hasUse (T {direct, ...}): bool =
-	 not (List.isEmpty (!direct))
-	 
+         not (List.isEmpty (!direct))
+         
       fun isUsed (u as T {forceUsed, ...}): bool =
-	 !forceUsed orelse hasUse u
+         !forceUsed orelse hasUse u
    end
 
 structure Class =
@@ -216,66 +226,66 @@
       datatype t = Bas | Con | Exn | Fix | Fct | Sig | Str | Typ | Var
 
       val toString =
-	 fn Bas => "basis"
-	  | Con => "constructor"
-	  | Exn => "exception"
-	  | Fix => "fixity"
-	  | Fct => "functor"
-	  | Sig => "signature"
-	  | Str => "structure"
-	  | Typ => "type"
-	  | Var => "variable"
+         fn Bas => "basis"
+          | Con => "constructor"
+          | Exn => "exception"
+          | Fix => "fixity"
+          | Fct => "functor"
+          | Sig => "signature"
+          | Str => "structure"
+          | Typ => "type"
+          | Var => "variable"
    end
 
 structure Vid =
    struct
       datatype t =
-	 Con of Con.t
+         Con of Con.t
        | Exn of Con.t
        | Overload of Priority.t * (Var.t * Type.t option) vector
        | Var of Var.t
 
       val statusPretty =
-	 fn Con _ => "constructor"
-	  | Exn _ => "exception"
-	  | Overload _ => "overload"
-	  | Var _ => "variable"
+         fn Con _ => "constructor"
+          | Exn _ => "exception"
+          | Overload _ => "overload"
+          | Var _ => "variable"
 
       val bogus = Var Var.bogus
 
       fun layout vid =
-	 let
-	    open Layout
-	    val (name, l) =
-	       case vid of
-		  Con c => ("Con", Con.layout c)
-		| Exn c => ("Exn", Con.layout c)
-		| Overload (p,xts) =>
-		     (concat ["Overload (",
-			      Layout.toString (Priority.layout p),
-			      ")"],
-		      Vector.layout (Layout.tuple2 (Var.layout,
-						    Option.layout Type.layout))
-		      xts)
-		| Var v => ("Var", Var.layout v)
-	 in
-	    paren (seq [str name, str " ", l])
-	 end
+         let
+            open Layout
+            val (name, l) =
+               case vid of
+                  Con c => ("Con", Con.layout c)
+                | Exn c => ("Exn", Con.layout c)
+                | Overload (p,xts) =>
+                     (concat ["Overload (",
+                              Layout.toString (Priority.layout p),
+                              ")"],
+                      Vector.layout (Layout.tuple2 (Var.layout,
+                                                    Option.layout Type.layout))
+                      xts)
+                | Var v => ("Var", Var.layout v)
+         in
+            paren (seq [str name, str " ", l])
+         end
 
       val deVar =
-	 fn Var v => SOME v
-	  | _ => NONE
-		
+         fn Var v => SOME v
+          | _ => NONE
+                
       val deCon =
-	 fn Con c => SOME c
-	  | Exn c => SOME c
-	  | _ => NONE
-	  
+         fn Con c => SOME c
+          | Exn c => SOME c
+          | _ => NONE
+          
       val class =
-	 fn Con _ => Class.Con
-	  | Exn _ => Class.Exn
-	  | Overload _ => Class.Var
-	  | Var _ => Class.Var
+         fn Con _ => Class.Con
+          | Exn _ => Class.Exn
+          | Overload _ => Class.Var
+          | Var _ => Class.Var
    end
 
 structure TypeStr =
@@ -285,133 +295,133 @@
       structure Tycon = Tycon
 
       structure Cons =
-	 struct
-	    datatype t = T of {con: Con.t,
-			       name: Ast.Con.t,
-			       scheme: Scheme.t,
-			       uses: Ast.Vid.t Uses.t} vector
-	       
-	    val empty = T (Vector.new0 ())
-	       
-	    fun layout (T v) =
-	       Vector.layout (fn {name, scheme, ...} =>
-			      let
-				 open Layout
-			      in
-				 seq [Ast.Con.layout name,
-				      str ": ", Scheme.layout scheme]
-			      end)
-	       v
-	 end
+         struct
+            datatype t = T of {con: Con.t,
+                               name: Ast.Con.t,
+                               scheme: Scheme.t,
+                               uses: Ast.Vid.t Uses.t} vector
+               
+            val empty = T (Vector.new0 ())
+               
+            fun layout (T v) =
+               Vector.layout (fn {name, scheme, ...} =>
+                              let
+                                 open Layout
+                              in
+                                 seq [Ast.Con.layout name,
+                                      str ": ", Scheme.layout scheme]
+                              end)
+               v
+         end
 
       datatype node =
-	 Datatype of {cons: Cons.t,
-		      tycon: Tycon.t}
+         Datatype of {cons: Cons.t,
+                      tycon: Tycon.t}
        | Scheme of Scheme.t
        | Tycon of Tycon.t
 
       datatype t = T of {kind: Kind.t,
-			 node: node}
+                         node: node}
 
       local
-	 fun make f (T r) = f r
+         fun make f (T r) = f r
       in
-	 val kind = make #kind
-	 val node = make #node
+         val kind = make #kind
+         val node = make #node
       end
 
       fun layout t =
-	 let
-	    open Layout
-	 in
-	    case node t of
-	       Datatype {tycon, cons} =>
-		  seq [str "Datatype ",
-		       record [("tycon", Tycon.layout tycon),
-			       ("cons", Cons.layout cons)]]
-	     | Scheme s => Scheme.layout s
-	     | Tycon t => seq [str "Tycon ", Tycon.layout t]
-	 end
+         let
+            open Layout
+         in
+            case node t of
+               Datatype {tycon, cons} =>
+                  seq [str "Datatype ",
+                       record [("tycon", Tycon.layout tycon),
+                               ("cons", Cons.layout cons)]]
+             | Scheme s => Scheme.layout s
+             | Tycon t => seq [str "Tycon ", Tycon.layout t]
+         end
 
       fun admitsEquality (s: t): AdmitsEquality.t =
-	 case node s of
-	    Datatype {tycon = c, ...} => ! (Tycon.admitsEquality c)
-	  | Scheme s => if Scheme.admitsEquality s
-			   then AdmitsEquality.Sometimes
-			else AdmitsEquality.Never
-	  | Tycon c =>  ! (Tycon.admitsEquality c)
+         case node s of
+            Datatype {tycon = c, ...} => ! (Tycon.admitsEquality c)
+          | Scheme s => if Scheme.admitsEquality s
+                           then AdmitsEquality.Sometimes
+                        else AdmitsEquality.Never
+          | Tycon c =>  ! (Tycon.admitsEquality c)
 
       fun explainDoesNotAdmitEquality (s: t): Layout.t =
-	 let
-	    open Layout
-	 in
-	    case node s of
-	       Datatype {cons = Cons.T v, ...} =>
-		  align
-		  (Vector.toList
-		   (Vector.keepAllMap
-		    (v, fn {name, scheme, ...} =>
-		     case (Type.deArrowOpt
-			   (#instance (Scheme.instantiate scheme))) of
-			NONE => NONE
-		      | SOME (arg, _) =>
-			   if Type.admitsEquality arg
-			      then NONE
-			   else 
-			      SOME (seq [Ast.Con.layout name, str " of ",
-					 Type.explainDoesNotAdmitEquality arg]))))
-	     | Scheme s => Scheme.explainDoesNotAdmitEquality s
-	     | Tycon c => Tycon.layout c
-	 end
+         let
+            open Layout
+         in
+            case node s of
+               Datatype {cons = Cons.T v, ...} =>
+                  align
+                  (Vector.toList
+                   (Vector.keepAllMap
+                    (v, fn {name, scheme, ...} =>
+                     case (Type.deArrowOpt
+                           (#instance (Scheme.instantiate scheme))) of
+                        NONE => NONE
+                      | SOME (arg, _) =>
+                           if Type.admitsEquality arg
+                              then NONE
+                           else 
+                              SOME (seq [Ast.Con.layout name, str " of ",
+                                         Type.explainDoesNotAdmitEquality arg]))))
+             | Scheme s => Scheme.explainDoesNotAdmitEquality s
+             | Tycon c => Tycon.layout c
+         end
 
       fun bogus (k: Kind.t): t =
-	 T {kind = k,
-	    node = Scheme (Scheme.bogus ())}
+         T {kind = k,
+            node = Scheme (Scheme.bogus ())}
 
       fun abs t =
-	 case node t of
-	    Datatype {tycon, ...} => T {kind = kind t,
-					node = Tycon tycon}
-	  | _ => t
+         case node t of
+            Datatype {tycon, ...} => T {kind = kind t,
+                                        node = Tycon tycon}
+          | _ => t
 
       fun apply (t: t, tys: Type.t vector): Type.t =
-	 case node t of
-	    Datatype {tycon, ...} => Type.con (tycon, tys)
-	  | Scheme s => Scheme.apply (s, tys)
-	  | Tycon t => Type.con (t, tys)
+         case node t of
+            Datatype {tycon, ...} => Type.con (tycon, tys)
+          | Scheme s => Scheme.apply (s, tys)
+          | Tycon t => Type.con (t, tys)
 
       fun cons t =
-	 case node t of
-	    Datatype {cons, ...} => cons
-	  | _ => Cons.empty
+         case node t of
+            Datatype {cons, ...} => cons
+          | _ => Cons.empty
 
       fun data (tycon, kind, cons) =
-	 T {kind = kind,
-	    node = Datatype {tycon = tycon, cons = cons}}
+         T {kind = kind,
+            node = Datatype {tycon = tycon, cons = cons}}
    
       fun def (s: Scheme.t, k: Kind.t) =
-	 let
-	    val (tyvars, ty) = Scheme.dest s
-	 in
-	    T {kind = k,
-	       node = (case Type.deEta (ty, tyvars) of
-			  NONE => Scheme s
-			| SOME c => Tycon c)}
-	 end
+         let
+            val (tyvars, ty) = Scheme.dest s
+         in
+            T {kind = k,
+               node = (case Type.deEta (ty, tyvars) of
+                          NONE => Scheme s
+                        | SOME c => Tycon c)}
+         end
 
       fun toTyconOpt s =
-	 case node s of
-	    Datatype {tycon, ...} => SOME tycon
-	  | Scheme _ => NONE
-	  | Tycon c => SOME c
+         case node s of
+            Datatype {tycon, ...} => SOME tycon
+          | Scheme _ => NONE
+          | Tycon c => SOME c
 
       fun tycon (c, kind) = T {kind = kind,
-			       node = Tycon c}
+                               node = Tycon c}
 
       fun ignoreNone (s: t option): t =
-	 case s of
-	    NONE => tycon (Tycon.tuple, Kind.Nary)
-	  | SOME s => s
+         case s of
+            NONE => tycon (Tycon.tuple, Kind.Nary)
+          | SOME s => s
    end
 
 local
@@ -421,7 +431,7 @@
 end
 
 structure Interface = Interface (structure Ast = Ast
-				 structure EnvTypeStr = TypeStr)
+                                 structure EnvTypeStr = TypeStr)
 
 local
    open Interface
@@ -435,167 +445,167 @@
    struct
       structure Econs = Cons
       structure Escheme = Scheme
-      structure Etycon = Tycon
       structure Etype = Type
       structure EtypeStr = TypeStr
       open Interface
 
       fun flexibleTyconToEnv (c: FlexibleTycon.t): EtypeStr.t option =
-	 let
-	    datatype z = datatype FlexibleTycon.realization
-	 in
-	    case FlexibleTycon.realization c of
-	       ETypeStr s => s
-	     | TypeStr s => typeStrToEnv s
-	 end
+         let
+            datatype z = datatype FlexibleTycon.realization
+         in
+            case FlexibleTycon.realization c of
+               ETypeStr s => s
+             | TypeStr s => typeStrToEnv s
+         end
       and tyconToEnv (t: Tycon.t): EtypeStr.t option =
-	 let
-	    open Tycon
-	 in
-	    case t of
-	       Flexible c => flexibleTyconToEnv c
-	     | Rigid (c, k) => SOME (EtypeStr.tycon (c, k))
-	 end
+         let
+            open Tycon
+         in
+            case t of
+               Flexible c => flexibleTyconToEnv c
+             | Rigid (c, k) => SOME (EtypeStr.tycon (c, k))
+         end
       and typeToEnv (t: Type.t): Etype.t option =
-	 DynamicWind.withEscape
-	 (fn escape =>
-	  SOME
-	  (Type.hom (t, {con = fn (c, ts) => (case tyconToEnv c of
-						 NONE => escape NONE
-					       | SOME s => 
-						    EtypeStr.apply (s, ts)),
-			 record = Etype.record,
-			 var = Etype.var})))
+         Exn.withEscape
+         (fn escape =>
+          SOME
+          (Type.hom (t, {con = fn (c, ts) => (case tyconToEnv c of
+                                                 NONE => escape NONE
+                                               | SOME s => 
+                                                    EtypeStr.apply (s, ts)),
+                         record = Etype.record,
+                         var = Etype.var})))
       and schemeToEnv (Scheme.T {ty, tyvars}): Escheme.t option =
-	 DynamicWind.withEscape
-	 (fn escape =>
-	  SOME (Escheme.make {canGeneralize = true,
-			      ty = (case typeToEnv ty of
-				       NONE => escape NONE
-				     | SOME ty => ty),
-			      tyvars = tyvars}))
+         Exn.withEscape
+         (fn escape =>
+          SOME (Escheme.make {canGeneralize = true,
+                              ty = (case typeToEnv ty of
+                                       NONE => escape NONE
+                                     | SOME ty => ty),
+                              tyvars = tyvars}))
       and consToEnv (Cons.T v): Econs.t option =
-	 DynamicWind.withEscape
-	 (fn escape =>
-	  SOME (Econs.T (Vector.map (v, fn {name, scheme} =>
-				     {con = Con.newNoname (),
-				      name = name,
-				      scheme = (case schemeToEnv scheme of
-						   NONE => escape NONE
-						 | SOME s => s),
-				      uses = Uses.new ()}))))
+         Exn.withEscape
+         (fn escape =>
+          SOME (Econs.T (Vector.map (v, fn {name, scheme} =>
+                                     {con = Con.newNoname (),
+                                      name = name,
+                                      scheme = (case schemeToEnv scheme of
+                                                   NONE => escape NONE
+                                                 | SOME s => s),
+                                      uses = Uses.new ()}))))
       and typeStrToEnv (s: TypeStr.t): EtypeStr.t option =
-	 let
-	    val k = TypeStr.kind s
-	    datatype z = datatype TypeStr.node
-	 in
-	    case TypeStr.node s of
-	       Datatype {cons, tycon} =>
-		  let
-		     fun data c =
-			Option.map (consToEnv cons, fn cs =>
-				    EtypeStr.data (c, k, cs))
-		  in
-		     case tycon of
-			Tycon.Flexible c =>
-			   (case flexibleTyconToEnv c of
-			       NONE => NONE
-			     | SOME typeStr =>
-				  case EtypeStr.node typeStr of
-				     EtypeStr.Datatype {tycon, ...} => data tycon
-				   | EtypeStr.Tycon c => data c
-				   | _ =>
-					let
-					   open Layout
-					in
-					   Error.bug
-					   (toString
-					    (seq [str "datatype ",
-						  TypeStr.layout s,
-						  str " realized with scheme ",
-						  EtypeStr.layout typeStr]))
-					end)
-		      | Tycon.Rigid (c, _) => data c
-		  end
-	     | Scheme s =>
-		  Option.map (schemeToEnv s, fn s => EtypeStr.def (s, k))
-	     | Tycon c => Option.map (tyconToEnv c, EtypeStr.abs)
-	 end
+         let
+            val k = TypeStr.kind s
+            datatype z = datatype TypeStr.node
+         in
+            case TypeStr.node s of
+               Datatype {cons, tycon} =>
+                  let
+                     fun data c =
+                        Option.map (consToEnv cons, fn cs =>
+                                    EtypeStr.data (c, k, cs))
+                  in
+                     case tycon of
+                        Tycon.Flexible c =>
+                           (case flexibleTyconToEnv c of
+                               NONE => NONE
+                             | SOME typeStr =>
+                                  case EtypeStr.node typeStr of
+                                     EtypeStr.Datatype {tycon, ...} => data tycon
+                                   | EtypeStr.Tycon c => data c
+                                   | _ =>
+                                        let
+                                           open Layout
+                                        in
+                                           Error.bug
+                                           (toString
+                                            (seq [str "ElaborateEnv.Interface.typeStrToEnv",
+                                                  str "datatype ",
+                                                  TypeStr.layout s,
+                                                  str " realized with scheme ",
+                                                  EtypeStr.layout typeStr]))
+                                        end)
+                      | Tycon.Rigid (c, _) => data c
+                  end
+             | Scheme s =>
+                  Option.map (schemeToEnv s, fn s => EtypeStr.def (s, k))
+             | Tycon c => Option.map (tyconToEnv c, EtypeStr.abs)
+         end
 
       structure Tycon =
-	 struct
-	    open Tycon
+         struct
+            open Tycon
 
-	    val fromEnv = Rigid
-	 end
+            val fromEnv = Rigid
+         end
 
       structure Type =
-	 struct
-	    open Type
+         struct
+            open Type
 
-	    fun fromEnv (t: Etype.t): t =
-	       let
-		  fun con (c, ts) =
-		     Type.con (Tycon.fromEnv (c, Kind.Arity (Vector.length ts)),
-			       ts)
-	       in
-		  Etype.hom (t, {con = con,
-				 expandOpaque = false,
-				 record = record,
-				 replaceSynonyms = false,
-				 var = var})
-	       end
-	 end
+            fun fromEnv (t: Etype.t): t =
+               let
+                  fun con (c, ts) =
+                     Type.con (Tycon.fromEnv (c, Kind.Arity (Vector.length ts)),
+                               ts)
+               in
+                  Etype.hom (t, {con = con,
+                                 expandOpaque = false,
+                                 record = record,
+                                 replaceSynonyms = false,
+                                 var = var})
+               end
+         end
       
       structure Scheme =
-	 struct
-	    open Scheme
+         struct
+            open Scheme
 
-	    val toEnv = schemeToEnv
+            val toEnv = schemeToEnv
 
-	    fun fromEnv (s: Escheme.t): t =
-	       let
-		  val (tyvars, ty) = Escheme.dest s
-	       in
-		  Scheme.T {ty = Type.fromEnv ty,
-			    tyvars = tyvars}
-	       end
-	 end
+            fun fromEnv (s: Escheme.t): t =
+               let
+                  val (tyvars, ty) = Escheme.dest s
+               in
+                  Scheme.T {ty = Type.fromEnv ty,
+                            tyvars = tyvars}
+               end
+         end
 
       structure Cons =
-	 struct
-	    open Cons
-	       
-	    fun fromEnv (Econs.T v): t =
-	       T (Vector.map (v, fn {name, scheme, ...} =>
-			      {name = name,
-			       scheme = Scheme.fromEnv scheme}))
-	 end
+         struct
+            open Cons
+               
+            fun fromEnv (Econs.T v): t =
+               T (Vector.map (v, fn {name, scheme, ...} =>
+                              {name = name,
+                               scheme = Scheme.fromEnv scheme}))
+         end
 
       structure TypeStr =
-	 struct
-	    open TypeStr
+         struct
+            open TypeStr
 
-	    val toEnv = typeStrToEnv
+            val toEnv = typeStrToEnv
 
-	    fun fromEnv (s: EtypeStr.t) =
-	       let
-		  val kind = EtypeStr.kind s
-	       in
-		  case EtypeStr.node s of
-		     EtypeStr.Datatype {cons, tycon} =>
-			data (Tycon.fromEnv (tycon, kind),
-			      kind,
-			      Cons.fromEnv cons)
-		   | EtypeStr.Scheme s => def (Scheme.fromEnv s, kind)
-		   | EtypeStr.Tycon c =>
-			tycon (Tycon.fromEnv (c, kind), kind)
-	       end
+            fun fromEnv (s: EtypeStr.t) =
+               let
+                  val kind = EtypeStr.kind s
+               in
+                  case EtypeStr.node s of
+                     EtypeStr.Datatype {cons, tycon} =>
+                        data (Tycon.fromEnv (tycon, kind),
+                              kind,
+                              Cons.fromEnv cons)
+                   | EtypeStr.Scheme s => def (Scheme.fromEnv s, kind)
+                   | EtypeStr.Tycon c =>
+                        tycon (Tycon.fromEnv (c, kind), kind)
+               end
 
-	    val fromEnv =
-	       Trace.trace ("Interface.TypeStr.fromEnv", EtypeStr.layout, layout)
-	       fromEnv
-	 end
+            val fromEnv =
+               Trace.trace ("ElaborateEnv.Interface.TypeStr.fromEnv", EtypeStr.layout, layout)
+               fromEnv
+         end
    end
 
 structure Status =
@@ -603,9 +613,9 @@
       open Status
 
       val pretty: t -> string =
-	 fn Con => "constructor"
-	  | Exn => "exception"
-	  | Var => "variable"
+         fn Con => "constructor"
+          | Exn => "exception"
+          | Var => "variable"
    end
 
 structure Time:>
@@ -626,53 +636,56 @@
 
       fun next () = Counter.next c
 
-      val next = Trace.trace ("Time.next", Unit.layout, layout) next
+      val next = 
+         Trace.trace 
+         ("ElaborateEnv.Time.next", Unit.layout, layout) 
+         next
    end
 
 structure Info =
    struct
       (* The array is sorted by domain element. *)
       datatype ('a, 'b) t = T of {domain: 'a,
-				  range: 'b,
-				  time: Time.t,
-				  uses: 'a Uses.t} array
-	 
+                                  range: 'b,
+                                  time: Time.t,
+                                  uses: 'a Uses.t} array
+         
       fun layout (layoutDomain, layoutRange) (T a) =
-	 Array.layout (fn {domain, range, ...} =>
-		       Layout.tuple [layoutDomain domain, layoutRange range])
-	 a
+         Array.layout (fn {domain, range, ...} =>
+                       Layout.tuple [layoutDomain domain, layoutRange range])
+         a
 
       fun foreach (T a, f) =
-	 Array.foreach (a, fn {domain, range, ...} => f (domain, range))
+         Array.foreach (a, fn {domain, range, ...} => f (domain, range))
 
       fun peek (T a, domain: 'a, toSymbol: 'a -> Symbol.t) =
-	 Option.map
-	 (BinarySearch.search (a, fn {domain = d, ...} =>
-			       Symbol.compare (toSymbol domain, toSymbol d)),
-	  fn i =>
-	  let
-	     val v as {uses, ...} =  Array.sub (a, i)
-	     val _ = Uses.add (uses, domain)
-	  in
-	     v
-	  end)
+         Option.map
+         (BinarySearch.search (a, fn {domain = d, ...} =>
+                               Symbol.compare (toSymbol domain, toSymbol d)),
+          fn i =>
+          let
+             val v as {uses, ...} =  Array.sub (a, i)
+             val _ = Uses.add (uses, domain)
+          in
+             v
+          end)
 
       val map: ('a, 'b) t * ('b -> 'b) -> ('a, 'b) t =
-	 fn (T a, f) =>
-	 T (Array.map (a, fn {domain, range, time, uses} =>
-		       {domain = domain,
-			range = f range,
-			time = time,
-			uses = uses}))
+         fn (T a, f) =>
+         T (Array.map (a, fn {domain, range, time, uses} =>
+                       {domain = domain,
+                        range = f range,
+                        time = time,
+                        uses = uses}))
 
       val map2: ('a, 'b) t * ('a, 'b) t * ('b * 'b -> 'b) -> ('a, 'b) t =
-	 fn (T a, T a', f) =>
-	 T (Array.map2
-	    (a, a', fn ({domain, range = r, time, uses}, {range = r', ...}) =>
-	     {domain = domain,
-	      range = f (r, r'),
-	      time = time,
-	      uses = uses}))
+         fn (T a, T a', f) =>
+         T (Array.map2
+            (a, a', fn ({domain, range = r, time, uses}, {range = r', ...}) =>
+             {domain = domain,
+              range = f (r, r'),
+              time = time,
+              uses = uses}))
    end
 
 val allTycons: Tycon.t list ref = ref (List.map (Tycon.prims, #1))
@@ -691,31 +704,31 @@
    end
 
 fun foreach2Sorted (abs: ('a * 'b) array,
-		    info: ('a, 'c) Info.t,
-		    equals: ('a * 'a -> bool),
-		    f: ('a * 'b * (int * 'c) option -> unit)): unit =
+                    info: ('a, 'c) Info.t,
+                    equals: ('a * 'a -> bool),
+                    f: ('a * 'b * (int * 'c) option -> unit)): unit =
    let
       val Info.T acs = info
       val _ =
-	 Array.fold
-	 (abs, 0, fn ((a, b), i) =>
-	  let
-	     fun find j =
-		if j = Array.length acs
-		   then (i, NONE)
-		else
-		   let
-		      val {domain = a', range = c, ...} = Array.sub (acs, j)
-		   in
-		      if equals (a, a')
-			 then (j + 1, SOME (j, c))
-		      else find (j + 1)
-		   end
-	     val (i, co) = find i
-	     val () = f (a, b, co)
-	  in
-	     i
-	  end)
+         Array.fold
+         (abs, 0, fn ((a, b), i) =>
+          let
+             fun find j =
+                if j = Array.length acs
+                   then (i, NONE)
+                else
+                   let
+                      val {domain = a', range = c, ...} = Array.sub (acs, j)
+                   in
+                      if equals (a, a')
+                         then (j + 1, SOME (j, c))
+                      else find (j + 1)
+                   end
+             val (i, co) = find i
+             val () = f (a, b, co)
+          in
+             i
+          end)
    in
       ()
    end
@@ -727,27 +740,27 @@
 structure Structure =
    struct
       datatype t = T of {interface: Interface.t option,
-			 plist: PropertyList.t,
-			 strs: (Ast.Strid.t, t) Info.t,
-			 types: (Ast.Tycon.t, TypeStr.t) Info.t,
-			 vals: (Ast.Vid.t, Vid.t * Scheme.t option) Info.t}
+                         plist: PropertyList.t,
+                         strs: (Ast.Strid.t, t) Info.t,
+                         types: (Ast.Tycon.t, TypeStr.t) Info.t,
+                         vals: (Ast.Vid.t, Vid.t * Scheme.t option) Info.t}
 
       local
-	 fun make f (T r) = f r
+         fun make f (T r) = f r
       in
-	 val interface = make #interface
-	 val plist = make #plist
+         val interface = make #interface
+         val plist = make #plist
       end
 
       fun eq (s: t, s': t): bool = PropertyList.equals (plist s, plist s')
 
       local
-	 fun make (field, toSymbol) (T fields, domain) =
-	    Info.peek (field fields, domain, toSymbol)
+         fun make (field, toSymbol) (T fields, domain) =
+            Info.peek (field fields, domain, toSymbol)
       in
-	 val peekStrid' = make (#strs, Ast.Strid.toSymbol)
-	 val peekVid' = make (#vals, Ast.Vid.toSymbol)
-	 val peekTycon' = make (#types, Ast.Tycon.toSymbol)
+         val peekStrid' = make (#strs, Ast.Strid.toSymbol)
+         val peekVid' = make (#vals, Ast.Vid.toSymbol)
+         val peekTycon' = make (#types, Ast.Tycon.toSymbol)
       end
 
       fun peekStrid z = Option.map (peekStrid' z, #range)
@@ -755,282 +768,282 @@
       fun peekVid z = Option.map (peekVid' z, #range)
 
       local
-	 fun make (from, de) (S, x) =
-	    case peekVid (S, from x) of
-	       NONE => NONE
-	     | SOME (vid, s) => Option.map (de vid, fn z => (z, s))
+         fun make (from, de) (S, x) =
+            case peekVid (S, from x) of
+               NONE => NONE
+             | SOME (vid, s) => Option.map (de vid, fn z => (z, s))
       in
-	 val peekCon = make (Ast.Vid.fromCon, Vid.deCon)
-	 val peekVar = make (Ast.Vid.fromVar, Vid.deVar)
+         val peekCon = make (Ast.Vid.fromCon, Vid.deCon)
+         val peekVar = make (Ast.Vid.fromVar, Vid.deVar)
       end
 
       fun layout (T {strs, vals, types, ...}) =
-	 Layout.record
-	 [("types", Info.layout (Ast.Tycon.layout, TypeStr.layout) types),
-	  ("vals", (Info.layout (Ast.Vid.layout,
-				 Layout.tuple2 (Vid.layout,
-						Option.layout Scheme.layout))
-		    vals)),
-	  ("strs", Info.layout (Strid.layout, layout) strs)]
+         Layout.record
+         [("types", Info.layout (Ast.Tycon.layout, TypeStr.layout) types),
+          ("vals", (Info.layout (Ast.Vid.layout,
+                                 Layout.tuple2 (Vid.layout,
+                                                Option.layout Scheme.layout))
+                    vals)),
+          ("strs", Info.layout (Strid.layout, layout) strs)]
 
       local
-	 datatype handleUses = Clear | Force
-	 fun make handleUses =
-	    let
-	       fun loop (T f) =
-		  let
-		     fun doit (sel, forceRange) =
-			let
-			   val Info.T a = sel f
-			in
-			   Array.foreach
-			   (a, fn {range, uses, ...} =>
-			    let
-			       val _ =
-				  case handleUses of
-				     Clear => Uses.clear uses
-				   | Force => Uses.forceUsed uses
-			       val _ = forceRange range
-			    in
-			       ()
-			    end)
-			end
-		     val _ = doit (#strs, loop)
-		     val _ = doit (#types, ignore)
-		     val _ = doit (#vals, ignore)
-		  in
-		     ()
-		  end
-	    in
-	       loop
-	    end
+         datatype handleUses = Clear | Force
+         fun make handleUses =
+            let
+               fun loop (T f) =
+                  let
+                     fun doit (sel, forceRange) =
+                        let
+                           val Info.T a = sel f
+                        in
+                           Array.foreach
+                           (a, fn {range, uses, ...} =>
+                            let
+                               val _ =
+                                  case handleUses of
+                                     Clear => Uses.clear uses
+                                   | Force => Uses.forceUsed uses
+                               val _ = forceRange range
+                            in
+                               ()
+                            end)
+                        end
+                     val _ = doit (#strs, loop)
+                     val _ = doit (#types, ignore)
+                     val _ = doit (#vals, ignore)
+                  in
+                     ()
+                  end
+            in
+               loop
+            end
       in
-	 val forceUsed = make Force
+         val forceUsed = make Force
       end
       
       fun realize (S: t, tm: 'a TyconMap.t,
-		   f: (Ast.Tycon.t
-		       * 'a
-		       * TypeStr.t option
-		       * {nest: Strid.t list}) -> unit): unit =
-	 let
-	    fun allNone (TyconMap.T {strs, types}, nest) =
-	       (Array.foreach (strs, fn (name, tm) => allNone (tm, name :: nest))
-		; Array.foreach (types, fn (name, flex) =>
-				 f (name, flex, NONE, {nest = nest})))
-	    fun loop (TyconMap.T {strs, types},
-		      T {strs = strs', types = types', ...},
-		      nest: Strid.t list) =
-	       let
-		  val () =
-		     foreach2Sorted
-		     (strs, strs', Ast.Strid.equals,
-		      fn (name, tm, S) =>
-		      case S of
-			 NONE => allNone (tm, nest)
-		       | SOME (_, S) => loop (tm, S, name :: nest))
-		  val () =
-		     foreach2Sorted
-		     (types, types', Ast.Tycon.equals,
-		      fn (name, flex, opt) =>
-		      f (name, flex, Option.map (opt, #2), {nest = nest}))
-	       in
-		   ()
-	       end
-	 in
-	    loop (tm, S, [])
-	 end
+                   f: (Ast.Tycon.t
+                       * 'a
+                       * TypeStr.t option
+                       * {nest: Strid.t list}) -> unit): unit =
+         let
+            fun allNone (TyconMap.T {strs, types}, nest) =
+               (Array.foreach (strs, fn (name, tm) => allNone (tm, name :: nest))
+                ; Array.foreach (types, fn (name, flex) =>
+                                 f (name, flex, NONE, {nest = nest})))
+            fun loop (TyconMap.T {strs, types},
+                      T {strs = strs', types = types', ...},
+                      nest: Strid.t list) =
+               let
+                  val () =
+                     foreach2Sorted
+                     (strs, strs', Ast.Strid.equals,
+                      fn (name, tm, S) =>
+                      case S of
+                         NONE => allNone (tm, nest)
+                       | SOME (_, S) => loop (tm, S, name :: nest))
+                  val () =
+                     foreach2Sorted
+                     (types, types', Ast.Tycon.equals,
+                      fn (name, flex, opt) =>
+                      f (name, flex, Option.map (opt, #2), {nest = nest}))
+               in
+                   ()
+               end
+         in
+            loop (tm, S, [])
+         end
 
       local
-	 open Layout
+         open Layout
       in
-	 fun layouts ({showUsed: bool},
-		      interfaceSigid: Interface.t -> Sigid.t option) =
-	    let
-	       fun layoutTypeSpec (n, s) =
-		  layoutTypeSpec' (Ast.Tycon.layout n, s, {isWhere = false})
-	       and layoutTypeSpec' (name: Layout.t, s, {isWhere: bool}) =
-		  let
-		     val {destroy, lay} = Type.makeLayoutPretty ()
-		     val lay = #1 o lay
-		     val tyvars =
-			case TypeStr.kind s of
-			   Kind.Arity n =>
-			      Vector.tabulate
-			      (n, fn _ =>
-			       Type.var (Tyvar.newNoname {equality = false}))
-			 | Kind.Nary => Vector.new0 ()
-		     val args =
-			case Vector.length tyvars of
-			   0 => empty
-			 | 1 => seq [lay (Vector.sub (tyvars, 0)), str " "]
-			 | _ =>
-			      seq
-			      [paren (seq (separateRight
-					   (Vector.toList (Vector.map (tyvars, lay)),
-					    ", "))),
-			       str " "]
-		     val t =
-			case TypeStr.node s of
-			   TypeStr.Datatype _ => "datatype"
-			 | _ =>
-			      if isWhere
-				 then "type"
-			      else
-				 let
-				    datatype z = datatype AdmitsEquality.t
-				 in
-				    case TypeStr.admitsEquality s of
-				       Always => "eqtype"
-				     | Never => "type"
-				     | Sometimes => "eqtype"   
-				 end
+         fun layouts ({showUsed: bool},
+                      interfaceSigid: Interface.t -> Sigid.t option) =
+            let
+               fun layoutTypeSpec (n, s) =
+                  layoutTypeSpec' (Ast.Tycon.layout n, s, {isWhere = false})
+               and layoutTypeSpec' (name: Layout.t, s, {isWhere: bool}) =
+                  let
+                     val {destroy, lay} = Type.makeLayoutPretty ()
+                     val lay = #1 o lay
+                     val tyvars =
+                        case TypeStr.kind s of
+                           Kind.Arity n =>
+                              Vector.tabulate
+                              (n, fn _ =>
+                               Type.var (Tyvar.newNoname {equality = false}))
+                         | Kind.Nary => Vector.new0 ()
+                     val args =
+                        case Vector.length tyvars of
+                           0 => empty
+                         | 1 => seq [lay (Vector.sub (tyvars, 0)), str " "]
+                         | _ =>
+                              seq
+                              [paren (seq (separateRight
+                                           (Vector.toList (Vector.map (tyvars, lay)),
+                                            ", "))),
+                               str " "]
+                     val t =
+                        if isWhere then
+                           "type"
+                        else
+                           (case TypeStr.node s of
+                               TypeStr.Datatype _ => "datatype"
+                             | _ =>
+                                  let
+                                     datatype z = datatype AdmitsEquality.t
+                                  in
+                                     case TypeStr.admitsEquality s of
+                                        Always => "eqtype"
+                                      | Never => "type"
+                                      | Sometimes => "eqtype"   
+                                  end)
                      val def = seq [str t, str " ", args, name, str " = "]
-		     val res = 
-			case TypeStr.node s of
-			   TypeStr.Datatype {cons = Cons.T cs, tycon} =>
-			      if isWhere
-				 then seq [def, lay (Type.con (tycon, tyvars))]
-			      else
-				 let
-				    val cs =
-				       Vector.toListMap
-				       (cs, fn {name, scheme, ...} =>
-					seq [Ast.Con.layout name,
-					     case (Type.deArrowOpt
-						   (Scheme.apply (scheme, tyvars))) of
-						NONE => empty
-					      | SOME (t, _) => seq [str " of ", lay t]])
-				 in
-				    seq [def, alignPrefix (cs, "| ")]
-				 end
-			 | TypeStr.Scheme s =>
-			      seq [def, lay (Scheme.apply (s, tyvars))]
-			 | TypeStr.Tycon c =>
-			      seq [def, lay (Type.con (c, tyvars))]
-		     val _ = destroy ()
-		  in
-		     res
-		  end
-	       fun layoutValSpec (d: Ast.Vid.t, (vid, scheme))= 
-		  let
-		     fun simple s =
-			seq [str s, str " ", Ast.Vid.layout d,
-			     if Ast.Vid.isSymbolic d then str " " else empty,
-				str ": ",
-				case scheme of
-				   NONE => str "<NONE>"
-				 | SOME s => Scheme.layoutPretty s]
-		     datatype z = datatype Vid.t
-		  in
-		     case vid of
-			Con _ => NONE
-		      | Exn c =>
-			   SOME
-			   (seq [str "exception ", Con.layout c,
-				 case scheme of
-				    NONE => str " of <NONE>"
-				  | SOME s => 
-				       case Type.deArrowOpt (Scheme.ty s) of
-					  NONE => empty
-					| SOME (t, _) =>
-					     seq [str " of ", Type.layoutPretty t]])
-		      | Overload  _ => SOME (simple "val")
-		      | Var _ => SOME (simple "val")
-		  end
-	       fun layoutStrSpec (d: Strid.t, r) =
-		  let
-		     val (l, {messy}) = layoutAbbrev r
-		     val bind = seq [str "structure ", Strid.layout d, str ":"]
-		  in
-		     if messy
-			then align [bind, indent (l, 3)]
-		     else seq [bind, str " ", l]
-		  end
-	       and layoutStr (T {strs, vals, types, ...}) =
-		  let
-		     fun doit (Info.T a, layout) =
-			align (Array.foldr
-			       (a, [], fn ({domain, range, uses, ...}, ac) =>
-				if showUsed andalso not (Uses.hasUse uses)
-				   then ac
-				else
-				   case layout (domain, range) of
-				      NONE => ac
-				    | SOME l => l :: ac))
-		  in
-		     align
-		     [str "sig",
-		      indent (align [doit (types, SOME o layoutTypeSpec),
-				     doit (vals, layoutValSpec),
-				     doit (strs, SOME o layoutStrSpec)],
-			      3),
-		      str "end"]
-		  end
+                     val res = 
+                        case TypeStr.node s of
+                           TypeStr.Datatype {cons = Cons.T cs, tycon} =>
+                              if isWhere
+                                 then seq [def, lay (Type.con (tycon, tyvars))]
+                              else
+                                 let
+                                    val cs =
+                                       Vector.toListMap
+                                       (cs, fn {name, scheme, ...} =>
+                                        seq [Ast.Con.layout name,
+                                             case (Type.deArrowOpt
+                                                   (Scheme.apply (scheme, tyvars))) of
+                                                NONE => empty
+                                              | SOME (t, _) => seq [str " of ", lay t]])
+                                 in
+                                    seq [def, alignPrefix (cs, "| ")]
+                                 end
+                         | TypeStr.Scheme s =>
+                              seq [def, lay (Scheme.apply (s, tyvars))]
+                         | TypeStr.Tycon c =>
+                              seq [def, lay (Type.con (c, tyvars))]
+                     val _ = destroy ()
+                  in
+                     res
+                  end
+               fun layoutValSpec (d: Ast.Vid.t, (vid, scheme))= 
+                  let
+                     fun simple s =
+                        seq [str s, str " ", Ast.Vid.layout d,
+                             if Ast.Vid.isSymbolic d then str " " else empty,
+                                str ": ",
+                                case scheme of
+                                   NONE => str "<NONE>"
+                                 | SOME s => Scheme.layoutPretty s]
+                     datatype z = datatype Vid.t
+                  in
+                     case vid of
+                        Con _ => NONE
+                      | Exn c =>
+                           SOME
+                           (seq [str "exception ", Con.layout c,
+                                 case scheme of
+                                    NONE => str " of <NONE>"
+                                  | SOME s => 
+                                       case Type.deArrowOpt (Scheme.ty s) of
+                                          NONE => empty
+                                        | SOME (t, _) =>
+                                             seq [str " of ", Type.layoutPretty t]])
+                      | Overload  _ => SOME (simple "val")
+                      | Var _ => SOME (simple "val")
+                  end
+               fun layoutStrSpec (d: Strid.t, r) =
+                  let
+                     val (l, {messy}) = layoutAbbrev r
+                     val bind = seq [str "structure ", Strid.layout d, str ":"]
+                  in
+                     if messy
+                        then align [bind, indent (l, 3)]
+                     else seq [bind, str " ", l]
+                  end
+               and layoutStr (T {strs, vals, types, ...}) =
+                  let
+                     fun doit (Info.T a, layout) =
+                        align (Array.foldr
+                               (a, [], fn ({domain, range, uses, ...}, ac) =>
+                                if showUsed andalso not (Uses.hasUse uses)
+                                   then ac
+                                else
+                                   case layout (domain, range) of
+                                      NONE => ac
+                                    | SOME l => l :: ac))
+                  in
+                     align
+                     [str "sig",
+                      indent (align [doit (types, SOME o layoutTypeSpec),
+                                     doit (vals, layoutValSpec),
+                                     doit (strs, SOME o layoutStrSpec)],
+                              3),
+                      str "end"]
+                  end
                and layoutAbbrev (S as T {interface, ...}) =
-		  case if showUsed
-			  then NONE
-		       else (case interface of
-				NONE => NONE
-			      | SOME I =>
-				   let
-				      val I = Interface.original I
-				   in
-				      Option.map (interfaceSigid I, fn s =>
-						  (s, I))
-				   end) of
-			  NONE => (layoutStr S, {messy = true})
-			| SOME (s, I) =>
-			     let
-				val wheres = ref []
-				val () =
-				   realize
-				   (S, Interface.flexibleTycons I,
-				    fn (name, _, typeStr, {nest}) =>
-				    case typeStr of
-				       NONE => Error.bug "missing typeStr"
-				     | SOME typeStr =>
-					  List.push
-					  (wheres,
-					   seq [str "where ",
-						layoutTypeSpec'
-						(Ast.Longtycon.layout
-						 (Ast.Longtycon.long (rev nest,
-								      name)),
-						 typeStr,
-						 {isWhere = true})]))
-			     in
-				(align (Sigid.layout s :: (rev (!wheres))),
-				 {messy = false})
-			     end
-	    in
-	       {layoutAbbrev = layoutAbbrev,
-		layoutStr = layoutStr,
-		strSpec = layoutStrSpec,
-		typeSpec = layoutTypeSpec,
-		valSpec = layoutValSpec}
-	    end
+                  case if showUsed
+                          then NONE
+                       else (case interface of
+                                NONE => NONE
+                              | SOME I =>
+                                   let
+                                      val I = Interface.original I
+                                   in
+                                      Option.map (interfaceSigid I, fn s =>
+                                                  (s, I))
+                                   end) of
+                          NONE => (layoutStr S, {messy = true})
+                        | SOME (s, I) =>
+                             let
+                                val wheres = ref []
+                                val () =
+                                   realize
+                                   (S, Interface.flexibleTycons I,
+                                    fn (name, _, typeStr, {nest}) =>
+                                    case typeStr of
+                                       NONE => Error.bug "ElaborateEnv.Structure.layoutAbbrev: missing typeStr"
+                                     | SOME typeStr =>
+                                          List.push
+                                          (wheres,
+                                           seq [str "where ",
+                                                layoutTypeSpec'
+                                                (Ast.Longtycon.layout
+                                                 (Ast.Longtycon.long (rev nest,
+                                                                      name)),
+                                                 typeStr,
+                                                 {isWhere = true})]))
+                             in
+                                (align (Sigid.layout s :: (rev (!wheres))),
+                                 {messy = false})
+                             end
+            in
+               {layoutAbbrev = layoutAbbrev,
+                layoutStr = layoutStr,
+                strSpec = layoutStrSpec,
+                typeSpec = layoutTypeSpec,
+                valSpec = layoutValSpec}
+            end
       end
 
       fun layoutPretty S =
-	 #layoutStr (layouts ({showUsed = false}, fn _ => NONE)) S
+         #layoutStr (layouts ({showUsed = false}, fn _ => NONE)) S
 
       datatype 'a peekResult =
-	 Found of 'a
-	| UndefinedStructure of Strid.t list
-	  
+         Found of 'a
+        | UndefinedStructure of Strid.t list
+          
       fun peekStrids (S, strids) =
-	 let
-	    fun loop (S, strids, ac) =
-	       case strids of
-		  [] => Found S
-		| strid :: strids =>
-		     case peekStrid (S, strid) of
-			NONE => UndefinedStructure (rev (strid :: ac))
-		      | SOME S => loop (S, strids, strid :: ac)
-	 in
-	    loop (S, strids, [])
-	 end
+         let
+            fun loop (S, strids, ac) =
+               case strids of
+                  [] => Found S
+                | strid :: strids =>
+                     case peekStrid (S, strid) of
+                        NONE => UndefinedStructure (rev (strid :: ac))
+                      | SOME S => loop (S, strids, strid :: ac)
+         in
+            loop (S, strids, [])
+         end
 
       val ffi: t option ref = ref NONE
    end
@@ -1042,16 +1055,16 @@
 structure FunctorClosure =
    struct
       datatype t =
-	 T of {apply: Structure.t * string list -> Decs.t * Structure.t option,
-	       argInt: Interface.t,
-	       formal: Structure.t,
-	       result: Structure.t option}
+         T of {apply: Structure.t * string list -> Decs.t * Structure.t option,
+               argInt: Interface.t,
+               formal: Structure.t,
+               result: Structure.t option}
 
       local
-	 fun make f (T r) = f r
+         fun make f (T r) = f r
       in
-	 val argInterface = make #argInt
-	 val result = make #result
+         val argInterface = make #argInt
+         val result = make #result
       end
 
       fun layout _ = Layout.str "<functor closure>"
@@ -1059,12 +1072,12 @@
       fun apply (T {apply, ...}, S, nest) = apply (S, nest)
 
       val apply =
-	 Trace.trace3 ("FunctorClosure.apply",
-		       layout,
-		       Structure.layout,
-		       List.layout String.layout,
-		       (Option.layout Structure.layout) o #2)
-	 apply
+         Trace.trace3 ("ElaborateEnv.FunctorClosure.apply",
+                       layout,
+                       Structure.layout,
+                       List.layout String.layout,
+                       (Option.layout Structure.layout) o #2)
+         apply
    end
 
 (* ------------------------------------------------- *)
@@ -1074,25 +1087,25 @@
 structure Basis =
    struct
       datatype t = T of {plist: PropertyList.t,
-			 bass: (Ast.Basid.t, t) Info.t, 
-			 fcts: (Ast.Fctid.t, FunctorClosure.t) Info.t,
-			 fixs: (Ast.Vid.t, Ast.Fixity.t) Info.t,
-			 sigs: (Ast.Sigid.t, Interface.t) Info.t,
-			 strs: (Ast.Strid.t, Structure.t) Info.t,
-			 types: (Ast.Tycon.t, TypeStr.t) Info.t,
-			 vals: (Ast.Vid.t, Vid.t * Scheme.t option) Info.t}
+                         bass: (Ast.Basid.t, t) Info.t, 
+                         fcts: (Ast.Fctid.t, FunctorClosure.t) Info.t,
+                         fixs: (Ast.Vid.t, Ast.Fixity.t) Info.t,
+                         sigs: (Ast.Sigid.t, Interface.t) Info.t,
+                         strs: (Ast.Strid.t, Structure.t) Info.t,
+                         types: (Ast.Tycon.t, TypeStr.t) Info.t,
+                         vals: (Ast.Vid.t, Vid.t * Scheme.t option) Info.t}
 
       fun layout (T {bass, fcts, sigs, strs, types, vals, ...}) =
-	 Layout.record
-	 [("bass", Info.layout (Ast.Basid.layout, layout) bass),
-	  ("fcts", Info.layout (Ast.Fctid.layout, FunctorClosure.layout) fcts),
-	  ("sigs", Info.layout (Ast.Sigid.layout, Interface.layout) sigs),
-	  ("strs", Info.layout (Ast.Strid.layout, Structure.layout) strs),
-	  ("types", Info.layout (Ast.Tycon.layout, TypeStr.layout) types),
-	  ("vals", (Info.layout (Ast.Vid.layout,
-				 Layout.tuple2 (Vid.layout,
-						Option.layout Scheme.layout))
-		    vals))]
+         Layout.record
+         [("bass", Info.layout (Ast.Basid.layout, layout) bass),
+          ("fcts", Info.layout (Ast.Fctid.layout, FunctorClosure.layout) fcts),
+          ("sigs", Info.layout (Ast.Sigid.layout, Interface.layout) sigs),
+          ("strs", Info.layout (Ast.Strid.layout, Structure.layout) strs),
+          ("types", Info.layout (Ast.Tycon.layout, TypeStr.layout) types),
+          ("vals", (Info.layout (Ast.Vid.layout,
+                                 Layout.tuple2 (Vid.layout,
+                                                Option.layout Scheme.layout))
+                    vals))]
    end
 
 (* ------------------------------------------------- *)
@@ -1102,10 +1115,10 @@
 structure Values =
    struct
       type ('a, 'b) value = {domain: 'a,
-			     range: 'b,
-			     scope: Scope.t,
-			     time: Time.t,
-			     uses: 'a Uses.t}
+                             range: 'b,
+                             scope: Scope.t,
+                             time: Time.t,
+                             uses: 'a Uses.t}
       (* The domains of all elements in a values list have the same symbol. *)
       datatype ('a, 'b) t = T of ('a, 'b) value list ref
 
@@ -1119,72 +1132,72 @@
 structure NameSpace =
    struct
       datatype ('a, 'b) t =
-	 T of {class: 'b -> Class.t,
-	       current: ('a, 'b) Values.t list ref,
-	       defUses: {class: Class.t,
-			 def: 'a,
-			 uses: 'a Uses.t} list ref,
-	       lookup: 'a -> ('a, 'b) Values.t,
-	       region: 'a -> Region.t,
-	       toSymbol: 'a -> Symbol.t}
+         T of {class: 'b -> Class.t,
+               current: ('a, 'b) Values.t list ref,
+               defUses: {class: Class.t,
+                         def: 'a,
+                         uses: 'a Uses.t} list ref,
+               lookup: 'a -> ('a, 'b) Values.t,
+               region: 'a -> Region.t,
+               toSymbol: 'a -> Symbol.t}
 
       fun values (T {lookup, ...}, a) = lookup a
 
       fun new {class, lookup, region, toSymbol} =
-	 T {class = class,
-	    current = ref [],
-	    defUses = ref [],
-	    lookup = lookup,
-	    region = region,
-	    toSymbol = toSymbol}
+         T {class = class,
+            current = ref [],
+            defUses = ref [],
+            lookup = lookup,
+            region = region,
+            toSymbol = toSymbol}
 
       fun newUses (T {defUses, ...}, class, def) =
-	 let
-	    val u = Uses.new ()
-	    val _ = List.push (defUses, {class = class,
-					 def = def,
-					 uses = u})
-	 in
-	    u
-	 end
+         let
+            val u = Uses.new ()
+            val _ = List.push (defUses, {class = class,
+                                         def = def,
+                                         uses = u})
+         in
+            u
+         end
 
       fun ('a, 'b) peek (ns, a: 'a, {markUse: 'b -> bool})
-	 : 'b option =
-	 case Values.! (values (ns, a)) of
-	    [] => NONE
-	  | {range, uses, ...} :: _ => 
-	       (if markUse range then Uses.add (uses, a) else ()
-		; SOME range)
+         : 'b option =
+         case Values.! (values (ns, a)) of
+            [] => NONE
+          | {range, uses, ...} :: _ => 
+               (if markUse range then Uses.add (uses, a) else ()
+                ; SOME range)
 
       fun collect (T {current, toSymbol, ...}: ('a, 'b) t)
-	 : unit -> ('a, 'b) Info.t =
-	 let
-	    val old = !current
-	    val _ = current := []
-	 in
-	    fn () =>
-	    let
-	       val elts =
-		  List.revMap (!current, fn values =>
-			       let
-				  val {domain, range, time, uses, ...} =
-				     Values.pop values
-			       in
-				  {domain = domain,
-				   range = range,
-				   time = time,
-				   uses = uses}
-			       end)
-	       val _ = current := old
-	       val a =
-		  QuickSort.sortArray
-		  (Array.fromList elts,
-		   fn ({domain = d, ...}, {domain = d', ...}) =>
-		   Symbol.<= (toSymbol d, toSymbol d'))
-	    in
-	       Info.T a
-	    end
-	 end
+         : unit -> ('a, 'b) Info.t =
+         let
+            val old = !current
+            val _ = current := []
+         in
+            fn () =>
+            let
+               val elts =
+                  List.revMap (!current, fn values =>
+                               let
+                                  val {domain, range, time, uses, ...} =
+                                     Values.pop values
+                               in
+                                  {domain = domain,
+                                   range = range,
+                                   time = time,
+                                   uses = uses}
+                               end)
+               val _ = current := old
+               val a = Array.fromList elts
+               val () =
+                  QuickSort.sortArray
+                  (a, fn ({domain = d, ...}, {domain = d', ...}) =>
+                   Symbol.<= (toSymbol d, toSymbol d'))
+            in
+               Info.T a
+            end
+         end
    end
 
 (*---------------------------------------------------*)
@@ -1213,22 +1226,22 @@
 
 datatype t =
    T of {currentScope: Scope.t ref,
-	 bass: (Ast.Basid.t, Basis.t) NameSpace.t, 
-	 fcts: (Ast.Fctid.t, FunctorClosure.t) NameSpace.t,
-	 fixs: (Ast.Vid.t, Ast.Fixity.t) NameSpace.t,
-	 interface: {strs: (Ast.Strid.t, Interface.t) NameSpace.t,
-		     types: (Ast.Tycon.t, Interface.TypeStr.t) NameSpace.t,
-		     vals: (Ast.Vid.t, Interface.Status.t * Interface.Scheme.t) NameSpace.t},
-	 lookup: Symbol.t -> All.t list ref,
-	 maybeAddTop: Symbol.t -> unit,
-	 sigs: (Ast.Sigid.t, Interface.t) NameSpace.t,
-	 strs: (Ast.Strid.t, Structure.t) NameSpace.t,
-	 (* topSymbols is a list of all symbols that are defined at
-	  * the top level (in any namespace).
-	  *)
-	 topSymbols: Symbol.t list ref,
-	 types: (Ast.Tycon.t, TypeStr.t) NameSpace.t,
-	 vals: (Ast.Vid.t, Vid.t * Scheme.t option) NameSpace.t}
+         bass: (Ast.Basid.t, Basis.t) NameSpace.t, 
+         fcts: (Ast.Fctid.t, FunctorClosure.t) NameSpace.t,
+         fixs: (Ast.Vid.t, Ast.Fixity.t) NameSpace.t,
+         interface: {strs: (Ast.Strid.t, Interface.t) NameSpace.t,
+                     types: (Ast.Tycon.t, Interface.TypeStr.t) NameSpace.t,
+                     vals: (Ast.Vid.t, Interface.Status.t * Interface.Scheme.t) NameSpace.t},
+         lookup: Symbol.t -> All.t list ref,
+         maybeAddTop: Symbol.t -> unit,
+         sigs: (Ast.Sigid.t, Interface.t) NameSpace.t,
+         strs: (Ast.Strid.t, Structure.t) NameSpace.t,
+         (* topSymbols is a list of all symbols that are defined at
+          * the top level (in any namespace).
+          *)
+         topSymbols: Symbol.t list ref,
+         types: (Ast.Tycon.t, TypeStr.t) NameSpace.t,
+         vals: (Ast.Vid.t, Vid.t * Scheme.t option) NameSpace.t}
 
 fun sizeMessage (E: t): Layout.t =
    let
@@ -1241,90 +1254,90 @@
 fun empty () =
    let
       val {get = lookupAll: Symbol.t -> All.t list ref, ...} = 
-	 Property.get (Symbol.plist, Property.initFun (fn _ => ref []))
+         Property.get (Symbol.plist, Property.initFun (fn _ => ref []))
       val topSymbols = ref []
       val {get = maybeAddTop: Symbol.t -> unit, ...} =
-	 Property.get (Symbol.plist,
-		       Property.initFun (fn s => List.push (topSymbols, s)))
+         Property.get (Symbol.plist,
+                       Property.initFun (fn s => List.push (topSymbols, s)))
       fun ('a, 'b) make (class: 'b -> Class.t,
-			 region: 'a -> Region.t,
-			 toSymbol: 'a -> Symbol.t,
-			 extract: All.t -> ('a, 'b) Values.t option,
-			 make: ('a, 'b) Values.t -> All.t)
-	 : ('a, 'b) NameSpace.t  =
-	 let
-	    fun lookup (a: 'a): ('a, 'b) Values.t =
-	       let
-		  val r = lookupAll (toSymbol a)
-	       in
-		  case List.peekMap (!r, extract) of
-		     NONE =>
-			let
-			   val v = Values.new ()
-			   val _ = List.push (r, make v)
-			in
-			   v
-			end
-		   | SOME v => v
-	       end
-	 in
-	    NameSpace.new {class = class,
-			   lookup = lookup,
-			   region = region,
-			   toSymbol = toSymbol}
-	 end
+                         region: 'a -> Region.t,
+                         toSymbol: 'a -> Symbol.t,
+                         extract: All.t -> ('a, 'b) Values.t option,
+                         make: ('a, 'b) Values.t -> All.t)
+         : ('a, 'b) NameSpace.t  =
+         let
+            fun lookup (a: 'a): ('a, 'b) Values.t =
+               let
+                  val r = lookupAll (toSymbol a)
+               in
+                  case List.peekMap (!r, extract) of
+                     NONE =>
+                        let
+                           val v = Values.new ()
+                           val _ = List.push (r, make v)
+                        in
+                           v
+                        end
+                   | SOME v => v
+               end
+         in
+            NameSpace.new {class = class,
+                           lookup = lookup,
+                           region = region,
+                           toSymbol = toSymbol}
+         end
       val bass = make (fn _ => Class.Bas, Basid.region, Basid.toSymbol,
-		       All.basOpt, All.Bas)
+                       All.basOpt, All.Bas)
       val fcts = make (fn _ => Class.Fct, Fctid.region, Fctid.toSymbol,
-		       All.fctOpt, All.Fct)
+                       All.fctOpt, All.Fct)
       val fixs = make (fn _ => Class.Fix, Ast.Vid.region, Ast.Vid.toSymbol,
-		       All.fixOpt, All.Fix)
+                       All.fixOpt, All.Fix)
       val sigs = make (fn _ => Class.Sig, Sigid.region, Sigid.toSymbol,
-		       All.sigOpt, All.Sig)
+                       All.sigOpt, All.Sig)
       val strs = make (fn _ => Class.Str, Strid.region, Strid.toSymbol,
-		       All.strOpt, All.Str)
+                       All.strOpt, All.Str)
       val types = make (fn _ => Class.Typ, Ast.Tycon.region, Ast.Tycon.toSymbol,
-			All.tycOpt, All.Tyc)
+                        All.tycOpt, All.Tyc)
       val vals = make (Vid.class o #1, Ast.Vid.region, Ast.Vid.toSymbol,
-		       All.valOpt, All.Val)
+                       All.valOpt, All.Val)
       local
-	 val {get =
-	      lookupAll: (Symbol.t
-			  -> {strs: (Strid.t, Interface.t) Values.t,
-			      types: (Ast.Tycon.t, Interface.TypeStr.t) Values.t,
-			      vals: (Ast.Vid.t, Status.t * Interface.Scheme.t) Values.t}),
-	      ...} =
-	    Property.get (Symbol.plist,
-			  Property.initFun
-			  (fn _ => {strs = Values.new (),
-				    types = Values.new (),
-				    vals = Values.new ()}))
-	 fun make (sel, class, region, toSymbol: 'a -> Symbol.t)
-	    : ('a, 'b) NameSpace.t =
-	    NameSpace.new {class = fn _ => class,
-			   lookup = sel o lookupAll o toSymbol,
-			   region = region,
-			   toSymbol = toSymbol}
+         val {get =
+              lookupAll: (Symbol.t
+                          -> {strs: (Strid.t, Interface.t) Values.t,
+                              types: (Ast.Tycon.t, Interface.TypeStr.t) Values.t,
+                              vals: (Ast.Vid.t, Status.t * Interface.Scheme.t) Values.t}),
+              ...} =
+            Property.get (Symbol.plist,
+                          Property.initFun
+                          (fn _ => {strs = Values.new (),
+                                    types = Values.new (),
+                                    vals = Values.new ()}))
+         fun make (sel, class, region, toSymbol: 'a -> Symbol.t)
+            : ('a, 'b) NameSpace.t =
+            NameSpace.new {class = fn _ => class,
+                           lookup = sel o lookupAll o toSymbol,
+                           region = region,
+                           toSymbol = toSymbol}
       in
-	 val interface =
-	    {strs = make (#strs, Class.Str, Strid.region, Strid.toSymbol),
-	     types = make (#types, Class.Typ, Ast.Tycon.region,
-			   Ast.Tycon.toSymbol),
-	     vals = make (#vals, Class.Var, Ast.Vid.region, Ast.Vid.toSymbol)}
+         val interface =
+            {strs = make (#strs, Class.Str, Strid.region, Strid.toSymbol),
+             types = make (#types, Class.Typ, Ast.Tycon.region,
+                           Ast.Tycon.toSymbol),
+             vals = make (#vals, Class.Var, Ast.Vid.region, Ast.Vid.toSymbol)}
       end
    in
       T {currentScope = ref (Scope.new {isTop = true}),
-	 bass = bass,
-	 fcts = fcts,
-	 fixs = fixs,
-	 interface = interface,
-	 lookup = lookupAll,
-	 maybeAddTop = maybeAddTop,
-	 sigs = sigs,
-	 strs = strs,
-	 topSymbols = topSymbols,
-	 types = types,
-	 vals = vals}
+         bass = bass,
+         fcts = fcts,
+         fixs = fixs,
+         interface = interface,
+         lookup = lookupAll,
+         maybeAddTop = maybeAddTop,
+         sigs = sigs,
+         strs = strs,
+         topSymbols = topSymbols,
+         types = types,
+         vals = vals}
    end
 
 local
@@ -1332,16 +1345,16 @@
       List.foreach
       (! (lookup s), fn a =>
        let
-	  datatype z = datatype All.t
+          datatype z = datatype All.t
        in
-	  case a of
-	     Bas vs => bass vs
-	   | Fct vs => fcts vs
-	   | Fix vs => fixs vs
-	   | Sig vs => sigs vs
-	   | Str vs => strs vs
-	   | Tyc vs => types vs
-	   | Val vs => vals vs
+          case a of
+             Bas vs => bass vs
+           | Fct vs => fcts vs
+           | Fix vs => fixs vs
+           | Sig vs => sigs vs
+           | Str vs => strs vs
+           | Tyc vs => types vs
+           | Val vs => vals vs
        end)
 in
    fun foreachDefinedSymbol (E, z) =
@@ -1352,9 +1365,9 @@
 end
 
 fun collect (E,
-	     keep: {hasUse: bool, scope: Scope.t} -> bool,
-	     le: {domain: Symbol.t, time: Time.t}
-	         * {domain: Symbol.t, time: Time.t} -> bool) =
+             keep: {hasUse: bool, scope: Scope.t} -> bool,
+             le: {domain: Symbol.t, time: Time.t}
+                 * {domain: Symbol.t, time: Time.t} -> bool) =
    let
       val bass = ref []
       val fcts = ref []
@@ -1363,27 +1376,32 @@
       val types = ref []
       val vals = ref []
       fun doit ac vs =
-	 case Values.! vs of
-	    [] => ()
-	  | (z as {scope, uses, ...}) :: _ =>
-	       if keep {hasUse = Uses.hasUse uses, scope = scope}
-		  then List.push (ac, z)
-	       else ()
+         case Values.! vs of
+            [] => ()
+          | (z as {scope, uses, ...}) :: _ =>
+               if keep {hasUse = Uses.hasUse uses, scope = scope}
+                  then List.push (ac, z)
+               else ()
       val _ =
-	 foreachDefinedSymbol (E, {bass = doit bass,
-				   fcts = doit fcts,
-				   fixs = fn _ => (),
-				   sigs = doit sigs,
-				   strs = doit strs,
-				   types = doit types,
-				   vals = doit vals})
+         foreachDefinedSymbol (E, {bass = doit bass,
+                                   fcts = doit fcts,
+                                   fixs = fn _ => (),
+                                   sigs = doit sigs,
+                                   strs = doit strs,
+                                   types = doit types,
+                                   vals = doit vals})
       fun ('a, 'b) finish (r, toSymbol: 'a -> Symbol.t) =
-	 QuickSort.sortArray
-	 (Array.fromList (!r),
-	  fn ({domain = d, time = t, ...}: ('a, 'b) Values.value,
-	      {domain = d', time = t',...}: ('a, 'b) Values.value) =>
-	  le ({domain = toSymbol d, time = t},
-	      {domain = toSymbol d', time = t'}))
+         let
+            val a = Array.fromList (!r)
+            val () =
+               QuickSort.sortArray
+               (a, fn ({domain = d, time = t, ...}: ('a, 'b) Values.value,
+                       {domain = d', time = t',...}: ('a, 'b) Values.value) =>
+                le ({domain = toSymbol d, time = t},
+                    {domain = toSymbol d', time = t'}))
+         in
+            a
+         end
    in
       {bass = finish (bass, Basid.toSymbol),
        fcts = finish (fcts, Fctid.toSymbol),
@@ -1396,66 +1414,66 @@
 fun setTyconNames (E: t): unit =
    let
       val {get = shortest: Tycon.t -> int ref, ...} =
-	 Property.get (Tycon.plist, Property.initFun (fn _ => ref Int.maxInt))
+         Property.get (Tycon.plist, Property.initFun (fn _ => ref Int.maxInt))
       fun doType (typeStr: TypeStr.t,
-		  name: Ast.Tycon.t,
-		  length: int,
-		  strids: Strid.t list): unit =
-	 case TypeStr.toTyconOpt typeStr of
-	    NONE => ()
-	  | SOME c => 
-	       let
-		  val r = shortest c
-	       in
-		  if length >= !r
-		     then ()
-		  else
-		     let
-			val _ = r := length
-			val name =
-			   Pretty.longid (List.map (strids, Strid.layout),
-					  Ast.Tycon.layout name)
-		     in
-			Tycon.setPrintName (c, Layout.toString name)
-		     end
-	       end
+                  name: Ast.Tycon.t,
+                  length: int,
+                  strids: Strid.t list): unit =
+         case TypeStr.toTyconOpt typeStr of
+            NONE => ()
+          | SOME c => 
+               let
+                  val r = shortest c
+               in
+                  if length >= !r
+                     then ()
+                  else
+                     let
+                        val _ = r := length
+                        val name =
+                           Pretty.longid (List.map (strids, Strid.layout),
+                                          Ast.Tycon.layout name)
+                     in
+                        Tycon.setPrintName (c, Layout.toString name)
+                     end
+               end
       val {get = strShortest: Structure.t -> int ref, ...} =
-	 Property.get (Structure.plist,
-		       Property.initFun (fn _ => ref Int.maxInt))
+         Property.get (Structure.plist,
+                       Property.initFun (fn _ => ref Int.maxInt))
       fun loopStr (s as Structure.T {strs, types, ...},
-		   length: int,
-		   strids: Strid.t list)
-	 : unit =
-	 let
-	    val r = strShortest s
-	 in
-	    if length >= !r
-	       then ()
-	    else
-	       (r := length
-		; Info.foreach (types, fn (name, typeStr) =>
-				doType (typeStr, name, length, strids))
-		; Info.foreach (strs, fn (strid, str) =>
-				loopStr (str, 1 + length, strids @ [strid])))
-	 end
+                   length: int,
+                   strids: Strid.t list)
+         : unit =
+         let
+            val r = strShortest s
+         in
+            if length >= !r
+               then ()
+            else
+               (r := length
+                ; Info.foreach (types, fn (name, typeStr) =>
+                                doType (typeStr, name, length, strids))
+                ; Info.foreach (strs, fn (strid, str) =>
+                                loopStr (str, 1 + length, strids @ [strid])))
+         end
       (* Sort the declarations in decreasing order of definition time so that
        * later declarations will be processed first, and hence will take
        * precedence.
        *)
       val {strs, types, ...} =
-	 collect (E, fn _ => true,
-		  fn ({time = t, ...}, {time = t', ...}) => Time.>= (t, t'))
+         collect (E, fn _ => true,
+                  fn ({time = t, ...}, {time = t', ...}) => Time.>= (t, t'))
       val _ = Array.foreach (types, fn {domain = name, range = typeStr, ...} =>
-			     doType (typeStr, name, 0, []))
+                             doType (typeStr, name, 0, []))
       val _ = Array.foreach (strs, fn {domain = strid, range = str, ...} =>
-			     loopStr (str, 1, [strid]))
+                             loopStr (str, 1, [strid]))
       val _ =
-	 List.foreach
-	 (!allTycons, fn c =>
-	  if ! (shortest c) < Int.maxInt
-	     then ()
-	  else
-	     Tycon.setPrintName (c, concat ["?.", Tycon.originalName c]))
+         List.foreach
+         (!allTycons, fn c =>
+          if ! (shortest c) < Int.maxInt
+             then ()
+          else
+             Tycon.setPrintName (c, concat ["?.", Tycon.originalName c]))
    in
       ()
    end
@@ -1466,136 +1484,136 @@
       val time = Time.next ()
       val I = Interface.copy I
       fun realize (TyconMap.T {strs, types}, nest) =
-	 let
-	    val strs =
-	       Array.map (strs, fn (name, tm) =>
-			  (name, realize (tm, name :: nest)))
-	    val types =
-	       Array.map
-	       (types, fn (tycon, flex) =>
-		let
-		   val {admitsEquality = a, kind = k, ...} =
-		      FlexibleTycon.dest flex
-		   val name =
-		      concat (prefix
-			      :: (List.fold (nest, [Ast.Tycon.toString tycon],
-					     fn (s, ss) =>
-					     Strid.toString s :: "." :: ss)))
-		   val c = newTycon (name, k, a, Ast.Tycon.region tycon)
-		   val () =
-		      FlexibleTycon.realize (flex, SOME (TypeStr.tycon (c, k)))
-		in
-		   (tycon, c)
-		end)
-	 in
-	    TyconMap.T {strs = strs, types = types}
-	 end
+         let
+            val strs =
+               Array.map (strs, fn (name, tm) =>
+                          (name, realize (tm, name :: nest)))
+            val types =
+               Array.map
+               (types, fn (tycon, flex) =>
+                let
+                   val {admitsEquality = a, kind = k, ...} =
+                      FlexibleTycon.dest flex
+                   val name =
+                      concat (prefix
+                              :: (List.fold (nest, [Ast.Tycon.toString tycon],
+                                             fn (s, ss) =>
+                                             Strid.toString s :: "." :: ss)))
+                   val c = newTycon (name, k, a, Ast.Tycon.region tycon)
+                   val () =
+                      FlexibleTycon.realize (flex, SOME (TypeStr.tycon (c, k)))
+                in
+                   (tycon, c)
+                end)
+         in
+            TyconMap.T {strs = strs, types = types}
+         end
       val flexible = realize (Interface.flexibleTycons I, [])
       val {get, ...} =
-	 Property.get
-	 (Interface.plist,
-	  Property.initRec
-	  (fn (I, get) =>
-	   let
-	      val {strs, types, vals} = Interface.dest I
-	      val strs =
-		 Array.map (strs, fn (name, I) =>
-			    {domain = name,
-			     range = get I,
-			     time = time,
-			     uses = Uses.new ()})
-	      val types =
-		 Array.map (types, fn (name, s) =>
-			    {domain = name,
-			     range = (TypeStr.ignoreNone
-				      (Interface.TypeStr.toEnv s)),
-			     time = time,
-			     uses = Uses.new ()})
-	      val vals =
-		 Array.map
-		 (vals, fn (name, (status, scheme)) =>
-		  let
-		     val con = CoreML.Con.fromString o Ast.Vid.toString
-		     val var = CoreML.Var.fromString o Ast.Vid.toString
-		     val vid =
-			case status of
-			   Status.Con => Vid.Con (con name)
-			 | Status.Exn => Vid.Exn (con name)
-			 | Status.Var => Vid.Var (var name)
-		  in
-		     {domain = name,
-		      range = (vid, Interface.Scheme.toEnv scheme),
-		      time = time,
-		      uses = Uses.new ()}
-		  end)
-	   in
-	      Structure.T {interface = SOME I,
-			   plist = PropertyList.new (),
-			   strs = Info.T strs,
-			   types = Info.T types,
-			   vals = Info.T vals}
-	   end))
+         Property.get
+         (Interface.plist,
+          Property.initRec
+          (fn (I, get) =>
+           let
+              val {strs, types, vals} = Interface.dest I
+              val strs =
+                 Array.map (strs, fn (name, I) =>
+                            {domain = name,
+                             range = get I,
+                             time = time,
+                             uses = Uses.new ()})
+              val types =
+                 Array.map (types, fn (name, s) =>
+                            {domain = name,
+                             range = (TypeStr.ignoreNone
+                                      (Interface.TypeStr.toEnv s)),
+                             time = time,
+                             uses = Uses.new ()})
+              val vals =
+                 Array.map
+                 (vals, fn (name, (status, scheme)) =>
+                  let
+                     val con = CoreML.Con.fromString o Ast.Vid.toString
+                     val var = CoreML.Var.fromString o Ast.Vid.toString
+                     val vid =
+                        case status of
+                           Status.Con => Vid.Con (con name)
+                         | Status.Exn => Vid.Exn (con name)
+                         | Status.Var => Vid.Var (var name)
+                  in
+                     {domain = name,
+                      range = (vid, Interface.Scheme.toEnv scheme),
+                      time = time,
+                      uses = Uses.new ()}
+                  end)
+           in
+              Structure.T {interface = SOME I,
+                           plist = PropertyList.new (),
+                           strs = Info.T strs,
+                           types = Info.T types,
+                           vals = Info.T vals}
+           end))
       val S = get I
       fun instantiate (S, f) =
-	 Structure.realize (S, flexible, fn (_, c, so, _) =>
-			    case so of
-			       NONE => Error.bug "instantiate"
-			     | SOME s => f (c, s))
+         Structure.realize (S, flexible, fn (_, c, so, _) =>
+                            case so of
+                               NONE => Error.bug "ElaborateEnv.dummyStructure.instantiate"
+                             | SOME s => f (c, s))
    in
       (S, instantiate)
    end
 
 val dummyStructure =
-   Trace.trace ("dummyStructure",
-		Interface.layout o #1,
-		Structure.layoutPretty o #1)
+   Trace.trace ("ElaborateEnv.dummyStructure",
+                Interface.layout o #1,
+                Structure.layoutPretty o #1)
    dummyStructure
 
 fun layout' (E: t, keep, showUsed): Layout.t =
    let
       val _ = setTyconNames E
       val {bass, fcts, sigs, strs, types, vals} =
-	 collect (E, keep,
-		  fn ({domain = d, ...}, {domain = d', ...}) =>
-		  Symbol.<= (d, d'))
+         collect (E, keep,
+                  fn ({domain = d, ...}, {domain = d', ...}) =>
+                  Symbol.<= (d, d'))
       open Layout
       fun doit (a, layout) = align (Array.toListMap (a, layout))
       val {get = interfaceSigid: Interface.t -> Sigid.t option,
-	   set = setInterfaceSigid, ...} =
-	 Property.getSet (Interface.plist, Property.initConst NONE)
+           set = setInterfaceSigid, ...} =
+         Property.getSet (Interface.plist, Property.initConst NONE)
       val _ = Array.foreach (sigs, fn {domain = s, range = I, ...} =>
-			     setInterfaceSigid (I, SOME s))
+                             setInterfaceSigid (I, SOME s))
       val {strSpec, typeSpec, valSpec, ...} =
-	 Structure.layouts (showUsed, interfaceSigid)
+         Structure.layouts (showUsed, interfaceSigid)
       val {layoutAbbrev, layoutStr, ...} =
-	 Structure.layouts ({showUsed = false}, interfaceSigid)
+         Structure.layouts ({showUsed = false}, interfaceSigid)
       val bass =
-	 doit (bass, fn {domain = basid, ...} =>
-	       seq [str "basis ", Basid.layout basid, str " = "])
+         doit (bass, fn {domain = basid, ...} =>
+               seq [str "basis ", Basid.layout basid, str " = "])
       val sigs =
-	 doit (sigs, fn {domain = sigid, range = I, ...} =>
-	       let
-		  val (S, _) = dummyStructure (I, {prefix = "?."})
-	       in
-		  align [seq [str "signature ", Sigid.layout sigid, str " = "],
-			 indent (layoutStr S, 3)]
-	       end)
+         doit (sigs, fn {domain = sigid, range = I, ...} =>
+               let
+                  val (S, _) = dummyStructure (I, {prefix = "?."})
+               in
+                  align [seq [str "signature ", Sigid.layout sigid, str " = "],
+                         indent (layoutStr S, 3)]
+               end)
       val fcts =
-	 doit (fcts,
-	       fn {domain,
-		   range = FunctorClosure.T {formal, result, ...}, ...} =>
-	       align [seq [str "functor ", Fctid.layout domain, str " ",
-			   paren (seq [str "S: ", #1 (layoutAbbrev formal)])],
-		      case result of
-			   NONE => empty
-			 | SOME S =>
-			      indent (seq [str ": ", #1 (layoutAbbrev S)], 3)])
+         doit (fcts,
+               fn {domain,
+                   range = FunctorClosure.T {formal, result, ...}, ...} =>
+               align [seq [str "functor ", Fctid.layout domain, str " ",
+                           paren (seq [str "S: ", #1 (layoutAbbrev formal)])],
+                      case result of
+                           NONE => empty
+                         | SOME S =>
+                              indent (seq [str ": ", #1 (layoutAbbrev S)], 3)])
       val vals = align (Array.foldr (vals, [], fn ({domain, range, ...}, ac) =>
-				     case valSpec (domain, range) of
-					NONE => ac
-				      | SOME l => l :: ac))
+                                     case valSpec (domain, range) of
+                                        NONE => ac
+                                      | SOME l => l :: ac))
       val types = doit (types, fn {domain, range, ...} =>
-			typeSpec (domain, range))
+                        typeSpec (domain, range))
       val strs = doit (strs, fn {domain, range, ...} => strSpec (domain, range))
    in
       align [types, vals, strs, fcts, sigs, bass]
@@ -1608,7 +1626,7 @@
       val s = !currentScope
    in
       layout' (E, fn {scope, ...} => Scope.equals (s, scope),
-	       {showUsed = false})
+               {showUsed = false})
    end
 
 fun layoutUsed (E: t): Layout.t = layout' (E, #hasUse, {showUsed = true})
@@ -1617,21 +1635,21 @@
 fun forceUsed E =
    let
       fun doit forceRange (Values.T r) =
-	 case !r of
-	    [] => ()
-	  | {uses, range, ...} :: _ =>
-	       (Uses.forceUsed uses
-		; forceRange range)
+         case !r of
+            [] => ()
+          | {uses, range, ...} :: _ =>
+               (Uses.forceUsed uses
+                ; forceRange range)
       val _ =
-	 foreachDefinedSymbol
-	 (E, {bass = doit ignore,
-	      fcts = doit (fn f => Option.app (FunctorClosure.result f,
-					       Structure.forceUsed)),
-	      fixs = doit ignore,
-	      sigs = doit ignore,
-	      strs = doit Structure.forceUsed,
-	      types = doit ignore,
-	      vals = doit ignore})
+         foreachDefinedSymbol
+         (E, {bass = doit ignore,
+              fcts = doit (fn f => Option.app (FunctorClosure.result f,
+                                               Structure.forceUsed)),
+              fixs = doit ignore,
+              sigs = doit ignore,
+              strs = doit Structure.forceUsed,
+              types = doit ignore,
+              vals = doit ignore})
    in
       ()
    end
@@ -1640,24 +1658,24 @@
    let
       val _ = forceUsed E
       val all: {class: Class.t,
-		def: Layout.t,
-		isUsed: bool,
-		region: Region.t,
-		uses: Region.t list} list ref = ref []
+                def: Layout.t,
+                isUsed: bool,
+                region: Region.t,
+                uses: Region.t list} list ref = ref []
       fun doit sel =
-	 let
-	    val NameSpace.T {defUses, region, toSymbol, ...} = sel f
-	 in
-	    List.foreach
-	    (!defUses, fn {class, def, uses, ...} =>
-	     List.push
-	     (all, {class = class,
-		    def = Symbol.layout (toSymbol def),
-		    isUsed = Uses.isUsed uses,
-		    region = region def,
-		    uses = List.fold (Uses.all uses, [], fn (u, ac) =>
-				      region u :: ac)}))
-	 end
+         let
+            val NameSpace.T {defUses, region, toSymbol, ...} = sel f
+         in
+            List.foreach
+            (!defUses, fn {class, def, uses, ...} =>
+             List.push
+             (all, {class = class,
+                    def = Symbol.layout (toSymbol def),
+                    isUsed = Uses.isUsed uses,
+                    region = region def,
+                    uses = List.fold (Uses.all uses, [], fn (u, ac) =>
+                                      region u :: ac)}))
+         end
       val _ = doit #fcts
       val _ = doit #sigs
       val _ = doit #strs
@@ -1665,78 +1683,78 @@
       val _ = doit #vals
       val a = Array.fromList (!all)
       val _ =
-	 QuickSort.sortArray (a, fn ({region = r, ...}, {region = r', ...}) =>
-			      Region.<= (r, r'))
+         QuickSort.sortArray (a, fn ({region = r, ...}, {region = r', ...}) =>
+                              Region.<= (r, r'))
       val l =
-	 Array.foldr
-	 (a, [], fn (z as {class, def, isUsed, region, uses}, ac) =>
-	  case ac of
-	     [] => [z]
-	   | {isUsed = i', region = r', uses = u', ...} :: ac' =>
-		if Region.equals (region, r')
-		   then {class = class,
-			 def = def,
-			 isUsed = isUsed orelse i',
-			 region = region,
-			 uses = uses @ u'} :: ac'
-		else z :: ac)
+         Array.foldr
+         (a, [], fn (z as {class, def, isUsed, region, uses}, ac) =>
+          case ac of
+             [] => [z]
+           | {isUsed = i', region = r', uses = u', ...} :: ac' =>
+                if Region.equals (region, r')
+                   then {class = class,
+                         def = def,
+                         isUsed = isUsed orelse i',
+                         region = region,
+                         uses = uses @ u'} :: ac'
+                else z :: ac)
       val _ =
-	 List.foreach
-	 (l, fn {class, def, isUsed, region, ...} =>
-	  if isUsed orelse Option.isNone (Region.left region)
-	     then ()
-	  else
-	     let
-		open Layout
-	     in
-		Control.warning
-		(region,
-		 seq [str (concat ["unused ", Class.toString class, ": "]), def],
-		 empty)
-	     end)
+         List.foreach
+         (l, fn {class, def, isUsed, region, ...} =>
+          if isUsed orelse Option.isNone (Region.left region)
+             then ()
+          else
+             let
+                open Layout
+             in
+                Control.warning
+                (region,
+                 seq [str (concat ["unused ", Class.toString class, ": "]), def],
+                 empty)
+             end)
       val _ =
-	 case !Control.showDefUse of
-	    NONE => ()
-	  | SOME f =>
-	       File.withOut
-	       (f, fn out =>
-		List.foreach
-		(l, fn {class, def, region, uses, ...} =>
-		 case Region.left region of
-		    NONE => ()
-		  | SOME p =>
-		       let
-			  val uses = Array.fromList uses
-			  val _ = QuickSort.sortArray (uses, Region.<=)
-			  val uses =
-			     Array.foldr
-			     (uses, [], fn (r, ac) =>
-			      case ac of
-				 [] => [r]
-			       | r' :: _ =>
-				    if Region.equals (r, r')
-				       then ac
-				    else r :: ac)
-			  open Layout
-		       in
-			  outputl
-			  (align [seq [str (Class.toString class),
-				       str " ",
-				       def,
-				       str " ",
-				       str (SourcePos.toString p)],
-				  indent
-				  (align
-				   (List.map
-				    (uses, fn r =>
-				     str (concat [case Region.left r of
-						     NONE => "NONE"
-						   | SOME p =>
-							SourcePos.toString p,
-						  " "]))),
-				   4)],
-			   out)
-		       end))
+         case !Control.showDefUse of
+            NONE => ()
+          | SOME f =>
+               File.withOut
+               (f, fn out =>
+                List.foreach
+                (l, fn {class, def, region, uses, ...} =>
+                 case Region.left region of
+                    NONE => ()
+                  | SOME p =>
+                       let
+                          val uses = Array.fromList uses
+                          val _ = QuickSort.sortArray (uses, Region.<=)
+                          val uses =
+                             Array.foldr
+                             (uses, [], fn (r, ac) =>
+                              case ac of
+                                 [] => [r]
+                               | r' :: _ =>
+                                    if Region.equals (r, r')
+                                       then ac
+                                    else r :: ac)
+                          open Layout
+                       in
+                          outputl
+                          (align [seq [str (Class.toString class),
+                                       str " ",
+                                       def,
+                                       str " ",
+                                       str (SourcePos.toString p)],
+                                  indent
+                                  (align
+                                   (List.map
+                                    (uses, fn r =>
+                                     str (concat [case Region.left r of
+                                                     NONE => "NONE"
+                                                   | SOME p =>
+                                                        SourcePos.toString p,
+                                                  " "]))),
+                                   4)],
+                           out)
+                       end))
    in
       ()
    end
@@ -1745,26 +1763,26 @@
    let
       val forceUsed = 1 = Vector.length v
       val v =
-	 Vector.map (v, fn {con, name} =>
-		     let
-			val uses = NameSpace.newUses (vals, Class.Con,
-						      Ast.Vid.fromCon name)
-			val () = 
-			   if not (warnUnused ()) orelse forceUsed
-			      then Uses.forceUsed uses
-			      else ()
-		     in
-			{con = con,
-			 name = name,
-			 uses = uses}
-		     end)
+         Vector.map (v, fn {con, name} =>
+                     let
+                        val uses = NameSpace.newUses (vals, Class.Con,
+                                                      Ast.Vid.fromCon name)
+                        val () = 
+                           if not (warnUnused ()) orelse forceUsed
+                              then Uses.forceUsed uses
+                              else ()
+                     in
+                        {con = con,
+                         name = name,
+                         uses = uses}
+                     end)
    in
       fn v' => Cons.T (Vector.map2
-		       (v, v', fn ({con, name, uses}, scheme) =>
-			{con = con,
-			 name = name,
-			 scheme = scheme,
-			 uses = uses}))
+                       (v, v', fn ({con, name, uses}, scheme) =>
+                        {con = con,
+                         name = name,
+                         scheme = scheme,
+                         uses = uses}))
    end
 
 (* ------------------------------------------------- *)
@@ -1783,13 +1801,13 @@
    val peekVid = make #vals
    fun peekVar (E, x) =
       case peekVid (E, Ast.Vid.fromVar x) of
-	 NONE => NONE
+         NONE => NONE
        | SOME (vid, s) => Option.map (Vid.deVar vid, fn x => (x, s))
 end
 
 fun peekCon (T {vals, ...}, c: Ast.Con.t): (Con.t * Scheme.t option) option =
    case NameSpace.peek (vals, Ast.Vid.fromCon c,
-			{markUse = fn (vid, _) => isSome (Vid.deCon vid)}) of
+                        {markUse = fn (vid, _) => isSome (Vid.deCon vid)}) of
       NONE => NONE
     | SOME (vid, s) => Option.map (Vid.deCon vid, fn c => (c, s))
 
@@ -1806,44 +1824,44 @@
 structure PeekResult =
    struct
       datatype 'a t =
-	 Found of 'a
+         Found of 'a
        | UndefinedStructure of Strid.t list
        | Undefined
 
       fun map (r: 'a t, f: 'a -> 'b): 'b t =
-	 case r of
-	    Found a => Found (f a)
-	  | UndefinedStructure ss => UndefinedStructure ss
-	  | Undefined => Undefined
-	       
+         case r of
+            Found a => Found (f a)
+          | UndefinedStructure ss => UndefinedStructure ss
+          | Undefined => Undefined
+               
       val toOption: 'a t -> 'a option =
-	 fn Found z => SOME z
-	  | _ => NONE
+         fn Found z => SOME z
+          | _ => NONE
    end
     
 local
    datatype z = datatype PeekResult.t
    fun make (split: 'a -> Strid.t list * 'b,
-	     peek: t * 'b -> 'c option,
-	     strPeek: Structure.t * 'b -> 'c option) (E, x) =
+             peek: t * 'b -> 'c option,
+             strPeek: Structure.t * 'b -> 'c option) (E, x) =
       let
-	 val (strids, x) = split x
+         val (strids, x) = split x
       in
-	 case strids of
-	    [] => (case peek (E, x) of
-		      NONE => Undefined
-		    | SOME z => Found z)
-	  | strid :: strids =>
-	       case peekStrid (E, strid) of
-		  NONE => UndefinedStructure [strid]
-		| SOME S =>
-		     case Structure.peekStrids (S, strids) of
-			Structure.Found S =>
-			   (case strPeek (S, x) of
-			       NONE => Undefined
-			     | SOME z => Found z)
-		      | Structure.UndefinedStructure ss =>
-			   UndefinedStructure (strid :: ss)
+         case strids of
+            [] => (case peek (E, x) of
+                      NONE => Undefined
+                    | SOME z => Found z)
+          | strid :: strids =>
+               case peekStrid (E, strid) of
+                  NONE => UndefinedStructure [strid]
+                | SOME S =>
+                     case Structure.peekStrids (S, strids) of
+                        Structure.Found S =>
+                           (case strPeek (S, x) of
+                               NONE => Undefined
+                             | SOME z => Found z)
+                      | Structure.UndefinedStructure ss =>
+                           UndefinedStructure (strid :: ss)
       end
 in
    val peekLongstrid =
@@ -1870,75 +1888,75 @@
 fun lookupBasid (E, x) =
    case peekBasid (E, x) of
       NONE => (unbound (Ast.Basid.region x, "basis", Ast.Basid.layout x)
-	       ; NONE)
+               ; NONE)
     | SOME f => SOME f
 
 fun lookupFctid (E, x) =
    case peekFctid (E, x) of
       NONE => (unbound (Ast.Fctid.region x, "functor", Ast.Fctid.layout x)
-	       ; NONE)
+               ; NONE)
     | SOME f => SOME f
 
 fun lookupSigid (E, x) =
    case peekSigid (E, x) of
       NONE => (unbound (Ast.Sigid.region x, "signature", Ast.Sigid.layout x)
-	       ; NONE)
+               ; NONE)
     | SOME I => SOME I
 
 fun lookupStrid (E, x) =
    case peekStrid (E, x) of
       NONE => (unbound (Ast.Strid.region x, "structure", Ast.Strid.layout x)
-	       ; NONE)
+               ; NONE)
     | SOME S => SOME S
 
 local
    fun make (peek: t * 'a -> 'b PeekResult.t,
-	     bogus: unit -> 'b,
-	     className: string,
-	     region: 'a -> Region.t,
-	     layout: 'a -> Layout.t)
+             bogus: unit -> 'b,
+             className: string,
+             region: 'a -> Region.t,
+             layout: 'a -> Layout.t)
       (E: t, x: 'a): 'b =
       let
-	 datatype z = datatype PeekResult.t
+         datatype z = datatype PeekResult.t
       in
-	 case peek (E, x) of
-	    Found z => z
-	  | UndefinedStructure ss =>
-	       (unbound (region x, "structure", layoutStrids ss); bogus ())
-	  | Undefined =>
-	       (unbound (region x, className, layout x); bogus ())
+         case peek (E, x) of
+            Found z => z
+          | UndefinedStructure ss =>
+               (unbound (region x, "structure", layoutStrids ss); bogus ())
+          | Undefined =>
+               (unbound (region x, className, layout x); bogus ())
       end
 in
    val lookupLongcon =
       make (peekLongcon,
-	    fn () => (Con.bogus, NONE),
-	    "constructor",
-	    Ast.Longcon.region,
-	    Ast.Longcon.layout)
+            fn () => (Con.bogus, NONE),
+            "constructor",
+            Ast.Longcon.region,
+            Ast.Longcon.layout)
    val lookupLongstrid =
       make (fn (E, x) => PeekResult.map (peekLongstrid (E, x), SOME),
-	    fn () => NONE,
-	    "structure",
-	    Ast.Longstrid.region,
-	    Ast.Longstrid.layout)
+            fn () => NONE,
+            "structure",
+            Ast.Longstrid.region,
+            Ast.Longstrid.layout)
    val lookupLongtycon =
       make (fn z => PeekResult.map (peekLongtycon z, SOME),
-	    fn () => NONE,
-	    "type",
-	    Longtycon.region,
-	    Longtycon.layout)
+            fn () => NONE,
+            "type",
+            Longtycon.region,
+            Longtycon.layout)
    val lookupLongvid =
       make (peekLongvid,
-	    fn () => (Vid.bogus, NONE),
-	    "variable",
-	    Ast.Longvid.region,
-	    Ast.Longvid.layout)
+            fn () => (Vid.bogus, NONE),
+            "variable",
+            Ast.Longvid.region,
+            Ast.Longvid.layout)
    val lookupLongvar =
       make (peekLongvar,
-	    fn () => (Var.bogus, NONE),
-	    "variable",
-	    Ast.Longvar.region,
-	    Ast.Longvar.layout)
+            fn () => (Var.bogus, NONE),
+            "variable",
+            Ast.Longvar.region,
+            Ast.Longvar.layout)
 end
 
 val peekLongcon = PeekResult.toOption o peekLongcon
@@ -1951,7 +1969,7 @@
 structure ExtendUses =
    struct
       datatype 'a t =
-	 New
+         New
        | Old of 'a Uses.t
        | Rebind
 
@@ -1960,88 +1978,88 @@
 
 val extend:
    t * ('a, 'b) NameSpace.t * {domain: 'a,
-			       forceUsed: bool,
-			       range: 'b,
-			       scope: Scope.t,
-			       time: Time.t,
-			       uses: 'a ExtendUses.t} -> unit =
+                               forceUsed: bool,
+                               range: 'b,
+                               scope: Scope.t,
+                               time: Time.t,
+                               uses: 'a ExtendUses.t} -> unit =
    fn (T {maybeAddTop, ...},
        ns as NameSpace.T {class, current, lookup, toSymbol, ...},
        {domain, forceUsed, range, scope, time, uses}) =>
    let
       fun newUses () =
-	 let
-	    val u = NameSpace.newUses (ns, class range, domain)
-	    val () = 
-	       if not (warnUnused ()) orelse forceUsed
-		  then Uses.forceUsed u
-		  else ()
-	 in
-	    u
-	 end
+         let
+            val u = NameSpace.newUses (ns, class range, domain)
+            val () = 
+               if not (warnUnused ()) orelse forceUsed
+                  then Uses.forceUsed u
+                  else ()
+         in
+            u
+         end
       val values as Values.T r = lookup domain
       datatype z = datatype ExtendUses.t
       fun new () =
-	 let
-	    val _ = List.push (current, values)
-	    val uses =
-	       case uses of
-		  New => newUses ()
-		| Old u => u
-		| Rebind => Error.bug "rebind new"
-	 in
-	    {domain = domain,
-	     range = range,
-	     scope = scope,
-	     time = time,
-	     uses = uses}
-	 end
+         let
+            val _ = List.push (current, values)
+            val uses =
+               case uses of
+                  New => newUses ()
+                | Old u => u
+                | Rebind => Error.bug "ElaborateEnv.extend.rebind.new"
+         in
+            {domain = domain,
+             range = range,
+             scope = scope,
+             time = time,
+             uses = uses}
+         end
    in
       case !r of
-	 [] =>
-	    let
-	       val _ =
-		  if Scope.isTop scope
-		     then maybeAddTop (toSymbol domain)
-		  else ()
-	    in
-	       r := [new ()]
-	    end
+         [] =>
+            let
+               val _ =
+                  if Scope.isTop scope
+                     then maybeAddTop (toSymbol domain)
+                  else ()
+            in
+               r := [new ()]
+            end
        | all as ({scope = scope', uses = uses', ...} :: rest) =>
-	    if Scope.equals (scope, scope')
-	       then
-		  let
-		     val uses =
-			case uses of
-			   New => newUses ()
-			 | Old u => u
-			 | Rebind => uses'
-		  in
-		     r := {domain = domain,
-			   range = range,
-			   scope = scope,
-			   time = time,
-			   uses = uses} :: rest
-		  end
-	    else r := new () :: all
+            if Scope.equals (scope, scope')
+               then
+                  let
+                     val uses =
+                        case uses of
+                           New => newUses ()
+                         | Old u => u
+                         | Rebind => uses'
+                  in
+                     r := {domain = domain,
+                           range = range,
+                           scope = scope,
+                           time = time,
+                           uses = uses} :: rest
+                  end
+            else r := new () :: all
    end
 
 local
    val extend =
       fn (E as T (fields as {currentScope, ...}), get,
-	  domain: 'a,
-	  range: 'b,
-	  forceUsed: bool,
-	  uses: 'a ExtendUses.t) =>
+          domain: 'a,
+          range: 'b,
+          forceUsed: bool,
+          uses: 'a ExtendUses.t) =>
       let
-	 val ns = get fields
+         val ns = get fields
       in
-	 extend (E, ns, {domain = domain,
-			 forceUsed = forceUsed,
-			 range = range,
-			 scope = !currentScope,
-			 time = Time.next (),
-			 uses = uses})
+         extend (E, ns, {domain = domain,
+                         forceUsed = forceUsed,
+                         range = range,
+                         scope = !currentScope,
+                         time = Time.next (),
+                         uses = uses})
       end
 in
    fun extendBasid (E, d, r) = extend (E, #bass, d, r, false, ExtendUses.New)
@@ -2052,37 +2070,37 @@
    fun extendVals (E, d, r, eu) = extend (E, #vals, d, r, false, eu)
    fun extendTycon (E, d, s, {forceUsed, isRebind}) =
       let
-	 val () =
-	    let
-	       datatype z = datatype TypeStr.node
-	    in
-	       case TypeStr.node s of
-		  Datatype {cons = Cons.T v , ...} =>
-		     Vector.foreach
-		     (v, fn {con, name, scheme, uses} => 
-		      extendVals (E, Ast.Vid.fromCon name,
-				  (Vid.Con con, SOME scheme),
-				  ExtendUses.Old uses))
-		| _ => ()
-	    end
-	 val _ =
-	    extend (E, #types, d, s, forceUsed,
-		    ExtendUses.fromIsRebind {isRebind = isRebind})
+         val () =
+            let
+               datatype z = datatype TypeStr.node
+            in
+               case TypeStr.node s of
+                  Datatype {cons = Cons.T v , ...} =>
+                     Vector.foreach
+                     (v, fn {con, name, scheme, uses} => 
+                      extendVals (E, Ast.Vid.fromCon name,
+                                  (Vid.Con con, SOME scheme),
+                                  ExtendUses.Old uses))
+                | _ => ()
+            end
+         val _ =
+            extend (E, #types, d, s, forceUsed,
+                    ExtendUses.fromIsRebind {isRebind = isRebind})
       in
-	 ()
+         ()
       end
 end
        
 fun extendExn (E, c, c', s) =
    extendVals (E, Ast.Vid.fromCon c, (Vid.Exn c', s), ExtendUses.New)
-	       
+               
 fun extendVar (E, x, x', s, ir) =
    extendVals (E, Ast.Vid.fromVar x, (Vid.Var x', SOME s),
-	       ExtendUses.fromIsRebind ir)
+               ExtendUses.fromIsRebind ir)
 
 val extendVar =
    Trace.trace
-   ("extendVar",
+   ("ElaborateEnv.extendVar",
     fn (_, x, x', s, _) =>
     Layout.tuple [Ast.Var.layout x, Var.layout x', Scheme.layoutPretty s],
     Unit.layout)
@@ -2090,7 +2108,7 @@
 
 fun extendOverload (E, p, x, yts, s) =
    extendVals (E, Ast.Vid.fromVar x, (Vid.Overload (p, yts), SOME s),
-	       ExtendUses.New)
+               ExtendUses.New)
 
 (* ------------------------------------------------- *)   
 (*                       local                       *)
@@ -2098,82 +2116,82 @@
 local
    fun doit (E: t, ns as NameSpace.T {current, ...}, s0) =
       let
-	 val old = !current
-	 val _ = current := []
+         val old = !current
+         val _ = current := []
       in
-	 fn () =>
-	 let
-	    val c1 = !current
-	    val _ = current := []
-	 in
-	    fn () =>
-	    let
-	       val c2 = !current
-	       val lift = List.revMap (c2, Values.pop)
-	       val _ = List.foreach (c1, fn v => ignore (Values.pop v))
-	       val _ = current := old
-	       val _ =
-		  List.foreach (lift, fn {domain, range, time, uses, ...} =>
-				extend (E, ns, {domain = domain,
-						forceUsed = false,
-						range = range,
-						scope = s0,
-						time = time,
-						uses = ExtendUses.Old uses}))
-	    in
-	       ()
-	    end
-	 end
+         fn () =>
+         let
+            val c1 = !current
+            val _ = current := []
+         in
+            fn () =>
+            let
+               val c2 = !current
+               val lift = List.revMap (c2, Values.pop)
+               val _ = List.foreach (c1, fn v => ignore (Values.pop v))
+               val _ = current := old
+               val _ =
+                  List.foreach (lift, fn {domain, range, time, uses, ...} =>
+                                extend (E, ns, {domain = domain,
+                                                forceUsed = false,
+                                                range = range,
+                                                scope = s0,
+                                                time = time,
+                                                uses = ExtendUses.Old uses}))
+            in
+               ()
+            end
+         end
       end
 in
    fun localAll (E as T {currentScope, bass, fcts, fixs, sigs, strs, types, vals, ...},
-		 f1, f2) =
+                 f1, f2) =
       let
-	 val s0 = !currentScope
-	 val bass = doit (E, bass, s0)
-	 val fcts = doit (E, fcts, s0)
-	 val fixs = doit (E, fixs, s0)
-	 val sigs = doit (E, sigs, s0)
-	 val strs = doit (E, strs, s0)
-	 val types = doit (E, types, s0)
-	 val vals = doit (E, vals, s0)
-	 val _ = currentScope := Scope.new {isTop = true}
-	 val a1 = f1 ()
-	 val bass = bass ()
-	 val fcts = fcts ()
-	 val fixs = fixs ()
-	 val sigs = sigs ()
-	 val strs = strs ()
-	 val types = types ()
-	 val vals = vals ()
-	 val _ = currentScope := Scope.new {isTop = true}
-	 val a2 = f2 a1
-	 val _ = (bass(); fcts (); fixs (); sigs (); strs (); types (); vals ())
-	 val _ = currentScope := s0
+         val s0 = !currentScope
+         val bass = doit (E, bass, s0)
+         val fcts = doit (E, fcts, s0)
+         val fixs = doit (E, fixs, s0)
+         val sigs = doit (E, sigs, s0)
+         val strs = doit (E, strs, s0)
+         val types = doit (E, types, s0)
+         val vals = doit (E, vals, s0)
+         val _ = currentScope := Scope.new {isTop = true}
+         val a1 = f1 ()
+         val bass = bass ()
+         val fcts = fcts ()
+         val fixs = fixs ()
+         val sigs = sigs ()
+         val strs = strs ()
+         val types = types ()
+         val vals = vals ()
+         val _ = currentScope := Scope.new {isTop = true}
+         val a2 = f2 a1
+         val _ = (bass(); fcts (); fixs (); sigs (); strs (); types (); vals ())
+         val _ = currentScope := s0
       in
-	 a2
+         a2
       end
 
    fun localModule (E as T {currentScope, fixs, strs, types, vals, ...},
-		    f1, f2) =
+                    f1, f2) =
       let
-	 val s0 = !currentScope
-	 val fixs = doit (E, fixs, s0)
-	 val strs = doit (E, strs, s0)
-	 val types = doit (E, types, s0)
-	 val vals = doit (E, vals, s0)
-	 val _ = currentScope := Scope.new {isTop = false}
-	 val a1 = f1 ()
-	 val fixs = fixs ()
-	 val strs = strs ()
-	 val types = types ()
-	 val vals = vals ()
-	 val _ = currentScope := Scope.new {isTop = false}
-	 val a2 = f2 a1
-	 val _ = (fixs (); strs (); types (); vals ())
-	 val _ = currentScope := s0
+         val s0 = !currentScope
+         val fixs = doit (E, fixs, s0)
+         val strs = doit (E, strs, s0)
+         val types = doit (E, types, s0)
+         val vals = doit (E, vals, s0)
+         val _ = currentScope := Scope.new {isTop = false}
+         val a1 = f1 ()
+         val fixs = fixs ()
+         val strs = strs ()
+         val types = types ()
+         val vals = vals ()
+         val _ = currentScope := Scope.new {isTop = false}
+         val a2 = f2 a1
+         val _ = (fixs (); strs (); types (); vals ())
+         val _ = currentScope := s0
       in
-	 a2
+         a2
       end
 
    (* Can't eliminate the use of strs in localCore, because openn still modifies
@@ -2183,37 +2201,37 @@
 end
 
 fun forceUsedLocal (E as T {currentScope, bass, fcts, fixs, sigs, strs, types, vals, ...},
-		    th) =
+                    th) =
    let
-      fun doit (forceRange, ns as NameSpace.T {current, ...}, s0) =
-	 let
-	    val old = !current
-	    val _ = current := []
-	 in
-	    fn () =>
-	    let
-	       val c = !current
-	       val lift = List.revMap (c, Values.pop)
-	       val _ = current := old
-	       val _ =
-		  List.foreach 
-		  (lift, fn {domain, range, time, uses, ...} =>
-		   (Uses.forceUsed uses
-		    ; forceRange range
-		    ; extend (E, ns, {domain = domain,
-				      forceUsed = false,
-				      range = range,
-				      scope = s0,
-				      time = time,
-				      uses = ExtendUses.Old uses})))
-	    in
-	       ()
-	    end
-	 end
+      fun doit (forceRange: 'b -> unit, ns as NameSpace.T {current, ...}, s0) =
+         let
+            val old = !current
+            val _ = current := []
+         in
+            fn () =>
+            let
+               val c = !current
+               val lift = List.revMap (c, Values.pop)
+               val _ = current := old
+               val _ =
+                  List.foreach 
+                  (lift, fn {domain, range, time, uses, ...} =>
+                   (Uses.forceUsed uses
+                    ; forceRange range
+                    ; extend (E, ns, {domain = domain,
+                                      forceUsed = false,
+                                      range = range,
+                                      scope = s0,
+                                      time = time,
+                                      uses = ExtendUses.Old uses})))
+            in
+               ()
+            end
+         end
       val s0 = !currentScope
       val bass = doit (ignore, bass, s0)
       val fcts = doit (fn f => Option.app (FunctorClosure.result f,
-					   Structure.forceUsed), fcts, s0)
+                                           Structure.forceUsed), fcts, s0)
       val fixs = doit (ignore, fixs, s0)
       val sigs = doit (ignore, sigs, s0)
       val strs = doit (Structure.forceUsed, strs, s0)
@@ -2238,10 +2256,10 @@
       val res = make ()
       val _ = f ()
       val S = Structure.T {interface = NONE,
-			   plist = PropertyList.new (),
-			   strs = s (),
-			   types = t (),
-			   vals = v ()}
+                           plist = PropertyList.new (),
+                           strs = s (),
+                           types = t (),
+                           vals = v ()}
       val _ = currentScope := s0
    in
       (res, S)
@@ -2260,13 +2278,13 @@
       val _ = currentScope := Scope.new {isTop = true}
       val res = make ()
       val B = Basis.T {plist = PropertyList.new (),
-		       bass = bass (),
-		       fcts = fcts (),
-		       fixs = fixs (),
-		       sigs = sigs (),
-		       strs = strs (),
-		       types = types (),
-		       vals = vals ()}
+                       bass = bass (),
+                       fcts = fcts (),
+                       fixs = fixs (),
+                       sigs = sigs (),
+                       strs = strs (),
+                       types = types (),
+                       vals = vals ()}
       val _ = currentScope := s0
    in
       (res, B)
@@ -2275,12 +2293,12 @@
 fun scope (T {currentScope, fixs, strs, types, vals, ...}, th) =
    let
       fun doit (NameSpace.T {current, ...}) =
-	 let
-	    val old = !current
-	    val _ = current := []
-	 in fn () => (List.foreach (!current, fn v => ignore (Values.pop v))
-		      ; current := old)
-	 end
+         let
+            val old = !current
+            val _ = current := []
+         in fn () => (List.foreach (!current, fn v => ignore (Values.pop v))
+                      ; current := old)
+         end
       val s0 = !currentScope
       val _ = currentScope := Scope.new {isTop = false}
       val f = doit fixs 
@@ -2297,12 +2315,12 @@
 fun scopeAll (T {currentScope, bass, fcts, fixs, sigs, strs, types, vals, ...}, th) =
    let
       fun doit (NameSpace.T {current, ...}) =
-	 let
-	    val old = !current
-	    val _ = current := []
-	 in fn () => (List.foreach (!current, fn v => ignore (Values.pop v))
-		      ; current := old)
-	 end
+         let
+            val old = !current
+            val _ = current := []
+         in fn () => (List.foreach (!current, fn v => ignore (Values.pop v))
+                      ; current := old)
+         end
       val s0 = !currentScope
       val _ = currentScope := Scope.new {isTop = true}
       val b = doit bass
@@ -2320,19 +2338,19 @@
    end
    
 fun openStructure (E as T {currentScope, strs, vals, types, ...},
-		   Structure.T {strs = strs',
-				vals = vals',
-				types = types', ...}): unit =
+                   Structure.T {strs = strs',
+                                vals = vals',
+                                types = types', ...}): unit =
    let
       val scope = !currentScope
       fun doit (ns, Info.T a) =
-	 Array.foreach (a, fn {domain, range, time, uses} =>
-			extend (E, ns, {domain = domain,
-					forceUsed = false,
-					range = range,
-					scope = scope,
-					time = time,
-					uses = ExtendUses.Old uses}))
+         Array.foreach (a, fn {domain, range, time, uses} =>
+                        extend (E, ns, {domain = domain,
+                                        forceUsed = false,
+                                        range = range,
+                                        scope = scope,
+                                        time = time,
+                                        uses = ExtendUses.Old uses}))
       val _ = doit (strs, strs')
       val _ = doit (vals, vals')
       val _ = doit (types, types')
@@ -2341,23 +2359,23 @@
    end
 
 fun openBasis (E as T {currentScope, bass, fcts, fixs, sigs, strs, vals, types, ...},
-	       Basis.T {bass = bass', 
-			fcts = fcts',
-			fixs = fixs',
-			sigs = sigs',
-			strs = strs',
-			vals = vals',
-			types = types', ...}): unit =
+               Basis.T {bass = bass', 
+                        fcts = fcts',
+                        fixs = fixs',
+                        sigs = sigs',
+                        strs = strs',
+                        vals = vals',
+                        types = types', ...}): unit =
    let
       val scope = !currentScope
       fun doit (ns, Info.T a) =
-	 Array.foreach (a, fn {domain, range, time, uses} =>
-			extend (E, ns, {domain = domain,
-					forceUsed = false,
-					range = range,
-					scope = scope,
-					time = time,
-					uses = ExtendUses.Old uses}))
+         Array.foreach (a, fn {domain, range, time, uses} =>
+                        extend (E, ns, {domain = domain,
+                                        forceUsed = false,
+                                        range = range,
+                                        scope = scope,
+                                        time = time,
+                                        uses = ExtendUses.Old uses}))
       val _ = doit (bass, bass')
       val _ = doit (fcts, fcts')
       val _ = doit (fixs, fixs')
@@ -2372,73 +2390,73 @@
 fun makeOpaque (S: Structure.t, I: Interface.t, {prefix: string}) =
    let
       fun fixCons (Cons.T cs, Cons.T cs') =
-	 Cons.T
-	 (Vector.map
-	  (cs', fn {name, scheme, ...} =>
-	   let
-	      val (con, uses) =
-		 case Vector.peek (cs, fn {name = n, ...} =>
-				   Ast.Con.equals (n, name)) of
-		    NONE => (Con.bogus, Uses.new ())
-		  | SOME {con, uses, ...} => (con, uses)
-	   in
-	      {con = con, name = name, scheme = scheme, uses = uses}
-	   end))
+         Cons.T
+         (Vector.map
+          (cs', fn {name, scheme, ...} =>
+           let
+              val (con, uses) =
+                 case Vector.peek (cs, fn {name = n, ...} =>
+                                   Ast.Con.equals (n, name)) of
+                    NONE => (Con.bogus, Uses.new ())
+                  | SOME {con, uses, ...} => (con, uses)
+           in
+              {con = con, name = name, scheme = scheme, uses = uses}
+           end))
       val (S', instantiate) = dummyStructure (I, {prefix = prefix})
       val _ = instantiate (S, fn (c, s) =>
-			   TypeEnv.setOpaqueTyconExpansion
-			   (c, fn ts => TypeStr.apply (s, ts)))
+                           TypeEnv.setOpaqueTyconExpansion
+                           (c, fn ts => TypeStr.apply (s, ts)))
       val {destroy,
-	   get = replacements: (Structure.t
-				-> {formal: Structure.t,
-				    new: Structure.t} list ref), ...} =
-	 Property.destGet (Structure.plist,
-			   Property.initFun (fn _ => ref []))
+           get = replacements: (Structure.t
+                                -> {formal: Structure.t,
+                                    new: Structure.t} list ref), ...} =
+         Property.destGet (Structure.plist,
+                           Property.initFun (fn _ => ref []))
       fun loop (S, S'): Structure.t =
-	 let
-	    val rs = replacements S
-	 in
-	    case List.peek (!rs, fn {formal, ...} =>
-			    Structure.eq (S', formal)) of
-	       NONE =>
-		  let
-		     val Structure.T {strs, types, vals, ...} = S
-		     val Structure.T {strs = strs',
-				      types = types',
-				      vals = vals', ...} = S'
-		     val strs = Info.map2 (strs, strs', loop)
-		     val types =
-			Info.map2
-			(types, types', fn (s, s') =>
-			 let
-			    datatype z = datatype TypeStr.node
-			 in
-			    case TypeStr.node s' of
-			       Datatype {cons = cs', tycon} =>
-				  (case TypeStr.node s of
-				      Datatype {cons = cs, ...} =>
-					 TypeStr.data
-					 (tycon, TypeStr.kind s',
-					  fixCons (cs, cs'))
-				    | _ => s')
-			     | Scheme _ => s'
-			     | Tycon _ => s'
-			 end)
-		     val vals =
-			Info.map2 (vals, vals', fn ((v, _), (_, s)) =>
-				   (v, s))
-		     val new =
-			Structure.T {interface = Structure.interface S',
-				     plist = PropertyList.new (),
-				     strs = strs,
-				     types = types,
-				     vals = vals}
-		     val _ = List.push (rs, {formal = S', new = new})
-		  in
-		     new
-		  end
-	     | SOME {new, ...} => new
-	 end
+         let
+            val rs = replacements S
+         in
+            case List.peek (!rs, fn {formal, ...} =>
+                            Structure.eq (S', formal)) of
+               NONE =>
+                  let
+                     val Structure.T {strs, types, vals, ...} = S
+                     val Structure.T {strs = strs',
+                                      types = types',
+                                      vals = vals', ...} = S'
+                     val strs = Info.map2 (strs, strs', loop)
+                     val types =
+                        Info.map2
+                        (types, types', fn (s, s') =>
+                         let
+                            datatype z = datatype TypeStr.node
+                         in
+                            case TypeStr.node s' of
+                               Datatype {cons = cs', tycon} =>
+                                  (case TypeStr.node s of
+                                      Datatype {cons = cs, ...} =>
+                                         TypeStr.data
+                                         (tycon, TypeStr.kind s',
+                                          fixCons (cs, cs'))
+                                    | _ => s')
+                             | Scheme _ => s'
+                             | Tycon _ => s'
+                         end)
+                     val vals =
+                        Info.map2 (vals, vals', fn ((v, _), (_, s)) =>
+                                   (v, s))
+                     val new =
+                        Structure.T {interface = Structure.interface S',
+                                     plist = PropertyList.new (),
+                                     strs = strs,
+                                     types = types,
+                                     vals = vals}
+                     val _ = List.push (rs, {formal = S', new = new})
+                  in
+                     new
+                  end
+             | SOME {new, ...} => new
+         end
       val S'' = loop (S, S')
       val _ = destroy ()
    in
@@ -2446,533 +2464,544 @@
    end
 
 fun transparentCut (E: t, S: Structure.t, I: Interface.t, {isFunctor: bool},
-		    region: Region.t): Structure.t * Decs.t =
+                    region: Region.t): Structure.t * Decs.t =
    let
       (* This tick is so that the type schemes for any values that need to be
        * instantiated and then re-generalized will be at a new time, so we can
        * check if something should not be generalized.
        *)
-      val () = TypeEnv.tick {useBeforeDef = fn _ => Error.bug "cut tick"}
+      val () = 
+         TypeEnv.tick {useBeforeDef = fn _ => 
+                       Error.bug "ElaborateEnv.transparentCut: cut tick"}
       val sign =
-	 if isFunctor
-	    then "argument signature"
-	 else "signature"
+         if isFunctor
+            then "argument signature"
+         else "signature"
       val preError =
-	 Promise.lazy
-	 (fn () =>
-	  scope (E, fn () =>
-		 (openStructure (E, S)
-		  ; setTyconNames E)))
+         Promise.lazy
+         (fn () =>
+          scope (E, fn () =>
+                 (openStructure (E, S)
+                  ; setTyconNames E)))
       val decs = ref []
       (* pre: arities are equal. *)
       fun equalSchemes (structScheme: Scheme.t,
-			sigScheme: Scheme.t,
-			name: string,
-			thing: string,
-			lay: unit -> Layout.t,
-			r: Region.t): unit =
-	 let
-	    fun error (l1, l2) =
-	       let
-		  open Layout
-	       in
-		  Control.error
-		  (r,
-		   seq [str (concat [thing, " in structure disagrees with ",
-				     sign])],
-		   align [seq [str (concat [name, ": "]), lay ()],
-			  seq [str "structure: ", l1],
-			  seq [str "signature: ", l2]])
-	       end
-	    val (tyvars', ty') = Scheme.dest sigScheme
-	    val tyvars =
-	       Vector.tabulate
-	       (Vector.length tyvars', fn _ =>
-		Type.var (Tyvar.newNoname {equality = false}))
-	 in
-	    Type.unify
-	    (Scheme.apply (structScheme, tyvars),
-	     Scheme.apply (Scheme.make {canGeneralize = true,
-					ty = ty',
-					tyvars = tyvars'},
-			   tyvars),
-	     {error = error,
-	      preError = preError})
-	 end
+                        sigScheme: Scheme.t,
+                        name: string,
+                        thing: string,
+                        lay: unit -> Layout.t,
+                        r: Region.t): unit =
+         let
+            fun error (l1, l2) =
+               let
+                  open Layout
+               in
+                  Control.error
+                  (r,
+                   seq [str (concat [thing, " in structure disagrees with ",
+                                     sign])],
+                   align [seq [str (concat [name, ": "]), lay ()],
+                          seq [str "structure: ", l1],
+                          seq [str "signature: ", l2]])
+               end
+            val (tyvars', ty') = Scheme.dest sigScheme
+            val tyvars =
+               Vector.tabulate
+               (Vector.length tyvars', fn _ =>
+                Type.var (Tyvar.newNoname {equality = false}))
+         in
+            Type.unify
+            (Scheme.apply (structScheme, tyvars),
+             Scheme.apply (Scheme.make {canGeneralize = true,
+                                        ty = ty',
+                                        tyvars = tyvars'},
+                           tyvars),
+             {error = error,
+              preError = preError})
+         end
       val equalSchemes =
-	 Trace.trace
-	 ("equalSchemes",
-	  fn (s, s', _, _, _, _) => Layout.tuple [Scheme.layout s,
-						  Scheme.layout s'],
-	  Unit.layout)
-	 equalSchemes
+         Trace.trace
+         ("ElaborateEnv.transparentCut.equalSchemes",
+          fn (s, s', _, _, _, _) => Layout.tuple [Scheme.layout s,
+                                                  Scheme.layout s'],
+          Unit.layout)
+         equalSchemes
       fun layout (strids, x) =
-	 layoutLong (List.fold (strids, [x], fn (s, ac) => Strid.layout s :: ac))
+         layoutLong (List.fold (strids, [x], fn (s, ac) => Strid.layout s :: ac))
       fun checkCons (Cons.T v, Cons.T v',
-		     strids: Strid.t list,
-		     tycon: Ast.Tycon.t): unit =
-	 let
-	    fun lay (c: Ast.Con.t) = layout (strids, Ast.Con.layout c)
-	    val extraStr =
-	       Vector.keepAllMap
-	       (v, fn {name = n, scheme = s, ...} =>
-		case Vector.peek (v', fn {name = n', ...} =>
-				  Ast.Con.equals (n, n')) of
-		   NONE => SOME n
-		 | SOME {scheme = s', ...} =>
-		      let
-			 val _ =
-			    equalSchemes
-			    (s, s', "constructor", "constructor type",
-			     fn () => lay n, region)
-		      in
-			 NONE
-		      end)
-	    fun extras (v, name) =
-	       if 0 = Vector.length v
-		  then ()
-	       else
-		  let
-		     open Layout
-		  in
-		     Control.error
-		     (region,
-		      seq [str "type ",
-			   layout (strids, Ast.Tycon.layout tycon),
-			   str (concat [" has constructors in ", name,
-					" only: "]),
-			   seq (List.separate (Vector.toListMap (v, lay),
-					       str ", "))],
-		      empty)
-		  end
-	    val _ = extras (extraStr, "structure")
-	    val extraSig =
-	       Vector.keepAllMap
-	       (v', fn {name = n', ...} =>
-		if Vector.exists (v, fn {name = n, ...} =>
-				  Ast.Con.equals (n, n'))
-		   then NONE
-		else SOME n')
-	    val _ = extras (extraSig, "signature")
-	 in
-	    ()
-	 end
+                     strids: Strid.t list,
+                     tycon: Ast.Tycon.t): unit =
+         let
+            fun lay (c: Ast.Con.t) = layout (strids, Ast.Con.layout c)
+            val extraStr =
+               Vector.keepAllMap
+               (v, fn {name = n, scheme = s, ...} =>
+                case Vector.peek (v', fn {name = n', ...} =>
+                                  Ast.Con.equals (n, n')) of
+                   NONE => SOME n
+                 | SOME {scheme = s', ...} =>
+                      let
+                         val _ =
+                            equalSchemes
+                            (s, s', "constructor", "constructor type",
+                             fn () => lay n, region)
+                      in
+                         NONE
+                      end)
+            fun extras (v, name) =
+               if 0 = Vector.length v
+                  then ()
+               else
+                  let
+                     open Layout
+                  in
+                     Control.error
+                     (region,
+                      seq [str "type ",
+                           layout (strids, Ast.Tycon.layout tycon),
+                           str (concat [" has constructors in ", name,
+                                        " only: "]),
+                           seq (List.separate (Vector.toListMap (v, lay),
+                                               str ", "))],
+                      empty)
+                  end
+            val _ = extras (extraStr, "structure")
+            val extraSig =
+               Vector.keepAllMap
+               (v', fn {name = n', ...} =>
+                if Vector.exists (v, fn {name = n, ...} =>
+                                  Ast.Con.equals (n, n'))
+                   then NONE
+                else SOME n')
+            val _ = extras (extraSig, "signature")
+         in
+            ()
+         end
       (* isPlausible checks if a type structure in a structure can plausibly be
        * substituted for a type structure in a signature having the specified
        * equality, arity, and constructors.
        *)
       fun isPlausible (structStr: TypeStr.t, strids, name,
-		       sigAdmits: AdmitsEquality.t,
-		       sigKind: Kind.t,
-		       consMismatch: bool): bool =
-	 if not (AdmitsEquality.<= (sigAdmits, TypeStr.admitsEquality structStr))
-	    then
-	       let
-		  val () = preError ()
-		  open Layout
-		  val () =
-		     Control.error
-		     (region,
-		      seq [str "type ", layout (strids, Ast.Tycon.layout name),
-			   str " admits equality in ", str sign,
-			   str " but not in structure"],
-		      seq [str "not equality: ",
-			   TypeStr.explainDoesNotAdmitEquality structStr])
-	       in
-		  false
-	       end
-	 else
-	    let
-	       val structKind = TypeStr.kind structStr
-	    in
-	       if not (Kind.equals (structKind, sigKind))
-		  then
-		     let
-			open Layout
-			val () =
-			   Control.error
-			   (region,
-			    seq [str "type ",
-				 layout (strids, Ast.Tycon.layout name),
-				 str " has arity ", Kind.layout structKind,
-				 str " in structure but arity ",
-				 Kind.layout sigKind, str " in ", str sign],
-			    empty)
-		     in
-			false
-		     end
-	       else
-		  if consMismatch
-		     then
-			let
-			   open Layout
-			   val () = 
-			      Control.error
-			      (region,
-			       seq [str "type ",
-				    layout (strids, Ast.Tycon.layout name),
-				    str " is a datatype in ", str sign,
-				    str " but not in structure"],
-			       Layout.empty)
-			in
-			   false
-			end
-		  else true
-	    end
+                       sigAdmits: AdmitsEquality.t,
+                       sigKind: Kind.t,
+                       consMismatch: bool): bool =
+         if not (AdmitsEquality.<= (sigAdmits, TypeStr.admitsEquality structStr))
+            then
+               let
+                  val () = preError ()
+                  open Layout
+                  val () =
+                     Control.error
+                     (region,
+                      seq [str "type ", layout (strids, Ast.Tycon.layout name),
+                           str " admits equality in ", str sign,
+                           str " but not in structure"],
+                      seq [str "not equality: ",
+                           TypeStr.explainDoesNotAdmitEquality structStr])
+               in
+                  false
+               end
+         else
+            let
+               val structKind = TypeStr.kind structStr
+            in
+               if not (Kind.equals (structKind, sigKind))
+                  then
+                     let
+                        open Layout
+                        val () =
+                           Control.error
+                           (region,
+                            seq [str "type ",
+                                 layout (strids, Ast.Tycon.layout name),
+                                 str " has arity ", Kind.layout structKind,
+                                 str " in structure but arity ",
+                                 Kind.layout sigKind, str " in ", str sign],
+                            empty)
+                     in
+                        false
+                     end
+               else
+                  if consMismatch
+                     then
+                        let
+                           open Layout
+                           val () = 
+                              Control.error
+                              (region,
+                               seq [str "type ",
+                                    layout (strids, Ast.Tycon.layout name),
+                                    str " is a datatype in ", str sign,
+                                    str " but not in structure"],
+                               Layout.empty)
+                        in
+                           false
+                        end
+                  else true
+            end
       fun handleType (structStr: TypeStr.t,
-		      sigStr: Interface.TypeStr.t,
-		      strids: Strid.t list,
-		      name: Ast.Tycon.t): TypeStr.t =
-	 case Interface.TypeStr.toEnv sigStr of
-	    NONE => structStr
-	  | SOME sigStr => 
-	       let
-		  fun tyconScheme (c: Tycon.t): Scheme.t =
-		     let
-			val tyvars =
-			   case TypeStr.kind structStr of
-			      Kind.Arity n =>
-				 Vector.tabulate
-				 (n, fn _ =>
-				  Tyvar.newNoname {equality = false})
-			    | _ => Error.bug "Nary tycon"
-		     in
-			Scheme.make
-			{canGeneralize = true,
-			 ty = Type.con (c, Vector.map (tyvars, Type.var)),
-			 tyvars = tyvars}
-		     end
-		  datatype z = datatype TypeStr.node
-		  fun checkScheme (sigScheme: Scheme.t) =
-		     let
-			val structScheme =
-			   case TypeStr.node structStr of
-			      Datatype {tycon = c, ...} => tyconScheme c
-			    | Scheme s => s
-			    | Tycon c => tyconScheme c
-		     in
-			equalSchemes
-			(structScheme, sigScheme,
-			 "type", "type definition", fn () =>
-			 layout (strids, Ast.Tycon.layout name), region)
-		     end
-		  val (return, consMismatch) =
-		     case TypeStr.node sigStr of
-			Datatype {cons = sigCons, ...} =>
-			   (case TypeStr.node structStr of
-			       Datatype {cons = structCons, ...} =>
-				  (checkCons (structCons, sigCons, strids, name)
-				   ; (structStr, false))
-			     | _ => (sigStr, true))
-		      | Scheme s => (checkScheme s; (sigStr, false))
-		      | Tycon c => (checkScheme (tyconScheme c); (sigStr, false))
-	       in
-		  if not (isPlausible (structStr, strids, name,
-				       TypeStr.admitsEquality sigStr,
-				       TypeStr.kind sigStr,
-				       consMismatch))
-		     then sigStr
-		  else return
-	       end
+                      sigStr: Interface.TypeStr.t,
+                      strids: Strid.t list,
+                      name: Ast.Tycon.t): TypeStr.t =
+         case Interface.TypeStr.toEnv sigStr of
+            NONE => structStr
+          | SOME sigStr => 
+               let
+                  fun tyconScheme (c: Tycon.t): Scheme.t =
+                     let
+                        val tyvars =
+                           case TypeStr.kind structStr of
+                              Kind.Arity n =>
+                                 Vector.tabulate
+                                 (n, fn _ =>
+                                  Tyvar.newNoname {equality = false})
+                            | _ => Error.bug "ElaborateEnv.transparentCut.handleType: Nary tycon"
+                     in
+                        Scheme.make
+                        {canGeneralize = true,
+                         ty = Type.con (c, Vector.map (tyvars, Type.var)),
+                         tyvars = tyvars}
+                     end
+                  datatype z = datatype TypeStr.node
+                  fun checkScheme (sigScheme: Scheme.t) =
+                     let
+                        val structScheme =
+                           case TypeStr.node structStr of
+                              Datatype {tycon = c, ...} => tyconScheme c
+                            | Scheme s => s
+                            | Tycon c => tyconScheme c
+                     in
+                        equalSchemes
+                        (structScheme, sigScheme,
+                         "type", "type definition", fn () =>
+                         layout (strids, Ast.Tycon.layout name), region)
+                     end
+                  val (return, consMismatch) =
+                     case TypeStr.node sigStr of
+                        Datatype {cons = sigCons, ...} =>
+                           (case TypeStr.node structStr of
+                               Datatype {cons = structCons, ...} =>
+                                  (fn () =>
+                                   (checkCons (structCons, sigCons, strids,
+                                               name)
+                                    ; structStr),
+                                   false)
+                             | _ => (fn () => sigStr, true))
+                      | Scheme s =>
+                           (fn () => (checkScheme s; sigStr),
+                            false)
+                      | Tycon c =>
+                           (fn () => (checkScheme (tyconScheme c); sigStr),
+                            false)
+               in
+                  if isPlausible (structStr, strids, name,
+                                  TypeStr.admitsEquality sigStr,
+                                  TypeStr.kind sigStr,
+                                  consMismatch) then
+                     return ()
+                  else
+                     sigStr
+               end
       fun map (structInfo: ('a, 'b) Info.t,
-	       sigArray: ('a * 'c) array,
-	       strids: Strid.t list,
-	       nameSpace: string,
-	       namesEqual: 'a * 'a -> bool,
-	       layoutName: 'a -> Layout.t,
-	       bogus: 'c -> 'd,
-	       doit: 'a * 'b * 'c -> 'd): ('a, 'd) Info.t =
-	 let
-	    val Info.T structArray = structInfo
-	    val n = Array.length structArray
-	    val r = ref 0
-	    val array =
-	       Array.map
-	       (sigArray, fn (name, c) =>
-		let
-		   fun find i =
-		      if i = n
-			 then
-			    let
-			       open Layout
-			       val _ =
-				  Control.error
-				  (region,
-				   seq [str (concat [nameSpace, " "]),
-					layout (strids, layoutName name),
-					str (concat
-					     [" in ", sign,
-					      " but not in structure"])],
-				   empty)
-			    in
-			       {domain = name,
-				range = bogus c,
-				time = Time.next (),
-				uses = Uses.new ()}
-			    end
-		      else
-			 let
-			    val {domain, range, time, uses} =
-			       Array.sub (structArray, i)
-			 in
-			    if namesEqual (domain, name)
-			       then (r := i + 1
-				     ; {domain = domain,
-					range = doit (name, range, c),
-					time = time,
-					uses = uses})
-			    else find (i + 1)
-			 end
-		in
-		   find (!r)
-		end)
-	 in
-	    Info.T array
-	 end
+               sigArray: ('a * 'c) array,
+               strids: Strid.t list,
+               nameSpace: string,
+               namesEqual: 'a * 'a -> bool,
+               layoutName: 'a -> Layout.t,
+               bogus: 'c -> 'd,
+               doit: 'a * 'b * 'c -> 'd): ('a, 'd) Info.t =
+         let
+            val Info.T structArray = structInfo
+            val n = Array.length structArray
+            val r = ref 0
+            val array =
+               Array.map
+               (sigArray, fn (name, c) =>
+                let
+                   fun find i =
+                      if i = n
+                         then
+                            let
+                               open Layout
+                               val _ =
+                                  Control.error
+                                  (region,
+                                   seq [str (concat [nameSpace, " "]),
+                                        layout (strids, layoutName name),
+                                        str (concat
+                                             [" in ", sign,
+                                              " but not in structure"])],
+                                   empty)
+                            in
+                               {domain = name,
+                                range = bogus c,
+                                time = Time.next (),
+                                uses = Uses.new ()}
+                            end
+                      else
+                         let
+                            val {domain, range, time, uses} =
+                               Array.sub (structArray, i)
+                         in
+                            if namesEqual (domain, name)
+                               then (r := i + 1
+                                     ; {domain = domain,
+                                        range = doit (name, range, c),
+                                        time = time,
+                                        uses = uses})
+                            else find (i + 1)
+                         end
+                in
+                   find (!r)
+                end)
+         in
+            Info.T array
+         end
       fun checkMatch (TyconMap.T {strs, types},
-		      Structure.T {strs = strsS, types = typesS, ...},
-		      I: Interface.t,
-		      strids): unit =
-	 let
-	    val {strs = strsI, types = typesI, ...} = Interface.dest I
-	    val _ =
-	       foreach2Sorted
-	       (strs, strsS, Strid.equals,
-		fn (strid, tm, opt) =>
-		case opt of
-		   NONE => Error.bug "checkMatch str"
-		 | SOME (i, S) => 
-		      checkMatch (tm, S, #2 (Array.sub (strsI, i)),
-				  strid :: strids))
-	    val _ =
-	       foreach2Sorted
-	       (types, typesS, Ast.Tycon.equals,
-		fn (name, _, opt) =>
-		case opt of
-		   NONE => Error.bug "checkMatch type"
-		 | SOME (i, typeStr) =>
-		      ignore (handleType
-			      (typeStr, #2 (Array.sub (typesI, i)),
-			       strids, name)))
-	 in
-	    ()
-	 end
+                      Structure.T {strs = strsS, types = typesS, ...},
+                      I: Interface.t,
+                      strids): unit =
+         let
+            val {strs = strsI, types = typesI, ...} = Interface.dest I
+            val _ =
+               foreach2Sorted
+               (strs, strsS, Strid.equals,
+                fn (strid, tm, opt) =>
+                case opt of
+                   NONE => Error.bug "ElaborateEnv.transparentCut.checkMatch: str"
+                 | SOME (i, S) => 
+                      checkMatch (tm, S, #2 (Array.sub (strsI, i)),
+                                  strid :: strids))
+            val _ =
+               foreach2Sorted
+               (types, typesS, Ast.Tycon.equals,
+                fn (name, _, opt) =>
+                case opt of
+                   NONE => Error.bug "ElaborateEnv.transparentCut.checkMatch: type"
+                 | SOME (i, typeStr) =>
+                      ignore (handleType
+                              (typeStr, #2 (Array.sub (typesI, i)),
+                               strids, name)))
+         in
+            ()
+         end
       val checkMatch =
-	 Trace.trace4 ("checkMatch",
-		       TyconMap.layout FlexibleTycon.layout,
-		       Structure.layout,
-		       Interface.layout,
-		       List.layout Strid.layout,
-		       Unit.layout)
-	 checkMatch
+         Trace.trace4 ("ElaborateEnv.transparentCut.checkMatch",
+                       TyconMap.layout FlexibleTycon.layout,
+                       Structure.layout,
+                       Interface.layout,
+                       List.layout Strid.layout,
+                       Unit.layout)
+         checkMatch
       val {destroy, get: Structure.t -> (Interface.t * Structure.t) list ref,
-	   ...} =
-	 Property.destGet (Structure.plist, Property.initFun (fn _ => ref []))
+           ...} =
+         Property.destGet (Structure.plist, Property.initFun (fn _ => ref []))
       fun cut (S, I, strids): Structure.t =
-	 let
-	    val seen = get S
-	 in
-	    case List.peek (!seen, fn (I', _) => Interface.equals (I, I')) of
-	       NONE =>
-		  let
-		     fun really () = reallyCut (S, I, strids)
-		     val S =
-			case Structure.interface S of
-			   NONE => really ()
-			 | SOME I' =>
-			      let
-				 val I'' = Interface.original I
-			      in
-				 if Interface.equals (I'', Interface.original I')
-				    then (checkMatch
-					  (Interface.flexibleTycons I'',
-					   S, I, strids)
-					  ; S)
-				 else really ()
-			      end
-		     val _ = List.push (seen, (I, S))
-		  in
-		     S
-		  end
-	     | SOME (_, S) => S
-	 end
+         let
+            val seen = get S
+         in
+            case List.peek (!seen, fn (I', _) => Interface.equals (I, I')) of
+               NONE =>
+                  let
+                     fun really () = reallyCut (S, I, strids)
+                     val S =
+                        case Structure.interface S of
+                           NONE => really ()
+                         | SOME I' =>
+                              let
+                                 val I'' = Interface.original I
+                              in
+                                 if Interface.equals (I'', Interface.original I')
+                                    then (checkMatch
+                                          (Interface.flexibleTycons I'',
+                                           S, I, strids)
+                                          ; S)
+                                 else really ()
+                              end
+                     val _ = List.push (seen, (I, S))
+                  in
+                     S
+                  end
+             | SOME (_, S) => S
+         end
       and reallyCut (Structure.T {strs = structStrs,
-				  types = structTypes,
-				  vals = structVals, ...},
-		     I, strids) =
-	 let
-	    val {strs = sigStrs, types = sigTypes, vals = sigVals} =
-	       Interface.dest I
-	    val strs =
-	       map (structStrs, sigStrs, strids,
-		    "structure", Strid.equals, Strid.layout,
-		    fn I => #1 (dummyStructure (I, {prefix = ""})),
-		    fn (name, S, I) => cut (S, I, name :: strids))
-	    val types =
-	       map (structTypes, sigTypes, strids,
-		    "type", Ast.Tycon.equals, Ast.Tycon.layout,
-		    TypeStr.ignoreNone o Interface.TypeStr.toEnv,
-		    fn (name, s, s') => handleType (s, s', strids, name))
-	    val vals =
-	       map
-	       (structVals, sigVals, strids,
-		"variable", Ast.Vid.equals, Ast.Vid.layout,
-		fn (status, sigScheme) =>
-		let
-		   val vid =
-		      case status of
-			 Status.Con => Vid.Con (Con.newNoname ())
-		       | Status.Exn => Vid.Exn (Con.newNoname ())
-		       | Status.Var => Vid.Var (Var.newNoname ())
-		in
-		   (vid, Interface.Scheme.toEnv sigScheme)
-		end,
-		fn (name, (vid, strScheme), (status, sigScheme)) =>
-		case (strScheme, Interface.Scheme.toEnv sigScheme) of
-		   (SOME strScheme, SOME sigScheme) =>
-		      let
-			 val (sigArgs, sigType) = Scheme.dest sigScheme
-			 val generalize = TypeEnv.generalize sigArgs
-			 val {args = strArgs, instance = strType} =
-			    Scheme.instantiate strScheme
-			 fun error rest =
-			    let
-			       open Layout
-			    in
-			       Control.error
-			       (region,
-				seq [str "variable type in structure disagrees with ",
-				     str sign],
-				align [seq [str "variable: ",
-					    Longvid.layout	
-					    (Longvid.long (rev strids, name))],
-				       rest])
-			    end
-			 val _ =
-			    Type.unify
-			    (strType, sigType,
-			     {error = (fn (l, l') =>
-				       let
-					  open Layout
-				       in
-					  error (align
-						 [seq [str "structure: ", l],
-						  seq [str "signature: ", l']])
-				       end),
-			      preError = preError})
-			 (* Now that we've unified, find any type variables that
-			  * can't be generalized because they occur at an earlier
-			  * point.
-			  *)
-			 val {unable} = generalize ()
-			 val () =
-			    if 0 = Vector.length unable
-			       then ()
-			    else
-			       let
-				  val () = preError ()
-				  open Layout
-			       in
-				  error
-				  (align
-				   [seq [str "unable to generalize: ",
-					 seq (List.separate (Vector.toListMap
-							     (unable, Tyvar.layout),
-							     str ", "))],
-				    seq [str "signature: ",
-					 Scheme.layoutPretty sigScheme]])
+                                  types = structTypes,
+                                  vals = structVals, ...},
+                     I, strids) =
+         let
+            val {strs = sigStrs, types = sigTypes, vals = sigVals} =
+               Interface.dest I
+            val strs =
+               map (structStrs, sigStrs, strids,
+                    "structure", Strid.equals, Strid.layout,
+                    fn I => #1 (dummyStructure (I, {prefix = ""})),
+                    fn (name, S, I) => cut (S, I, name :: strids))
+            val types =
+               map (structTypes, sigTypes, strids,
+                    "type", Ast.Tycon.equals, Ast.Tycon.layout,
+                    TypeStr.ignoreNone o Interface.TypeStr.toEnv,
+                    fn (name, s, s') => handleType (s, s', strids, name))
+            val vals =
+               map
+               (structVals, sigVals, strids,
+                "variable", Ast.Vid.equals, Ast.Vid.layout,
+                fn (status, sigScheme) =>
+                let
+                   val vid =
+                      case status of
+                         Status.Con => Vid.Con (Con.newNoname ())
+                       | Status.Exn => Vid.Exn (Con.newNoname ())
+                       | Status.Var => Vid.Var (Var.newNoname ())
+                in
+                   (vid, Interface.Scheme.toEnv sigScheme)
+                end,
+                fn (name, (vid, strScheme), (status, sigScheme)) =>
+                case (strScheme, Interface.Scheme.toEnv sigScheme) of
+                   (SOME strScheme, SOME sigScheme) =>
+                      let
+                         val (sigArgs, sigType) = Scheme.dest sigScheme
+                         val generalize = TypeEnv.generalize sigArgs
+                         val {args = strArgs, instance = strType} =
+                            Scheme.instantiate strScheme
+                         fun error rest =
+                            let
+                               open Layout
+                            in
+                               Control.error
+                               (region,
+                                seq [str "variable type in structure disagrees with ",
+                                     str sign],
+                                align [seq [str "variable: ",
+                                            Longvid.layout      
+                                            (Longvid.long (rev strids, name))],
+                                       rest])
+                            end
+                         val _ =
+                            Type.unify
+                            (strType, sigType,
+                             {error = (fn (l, l') =>
+                                       let
+                                          open Layout
+                                       in
+                                          error (align
+                                                 [seq [str "structure: ", l],
+                                                  seq [str "signature: ", l']])
+                                       end),
+                              preError = preError})
+                         (* Now that we've unified, find any type variables that
+                          * can't be generalized because they occur at an earlier
+                          * point.
+                          *)
+                         val {unable} = generalize ()
+                         val () =
+                            if 0 = Vector.length unable
+                               then ()
+                            else
+                               let
+                                  val () = preError ()
+                                  open Layout
+                               in
+                                  error
+                                  (align
+                                   [seq [str "unable to generalize: ",
+                                         seq (List.separate (Vector.toListMap
+                                                             (unable, Tyvar.layout),
+                                                             str ", "))],
+                                    seq [str "signature: ",
+                                         Scheme.layoutPretty sigScheme]])
 
-			       end
-			 fun addDec (n: Exp.node): Vid.t =
-			    let
-			       val x = Var.newNoname ()
-			       val e = Exp.make (n, strType)
-			       val _ =
-				  List.push
-				  (decs,
-				   Dec.Val {rvbs = Vector.new0 (),
-					    tyvars = fn () => sigArgs,
-					    vbs = (Vector.new1
-						   {exp = e,
-						    lay = fn _ => Layout.empty,
-						    pat = Pat.var (x, strType),
-						    patRegion = region}),
-					    warnMatch = warnMatch ()})
-			    in
-			       Vid.Var x
-			    end
-			 fun con (c: Con.t): Vid.t =
-			    addDec (Exp.Con (c, strArgs ()))
-			 val vid =
-			    case (vid, status) of
-			       (Vid.Con c, Status.Var) => con c
-			     | (Vid.Exn c, Status.Var) => con c
-			     | (Vid.Var x, Status.Var) =>
-				  if 0 < Vector.length sigArgs
-				     orelse 0 < Vector.length (strArgs ())
-				     then addDec (Exp.Var (fn () => x, strArgs))
-				  else vid
-			     | (Vid.Con _, Status.Con) => vid
-			     | (Vid.Exn _, Status.Exn) => vid
-			     | _ =>
-				  let
-				     open Layout
-				     val _ =
-					Control.error
-					(region,
-					 seq [str (concat
-						   [Vid.statusPretty vid,
-						    " in structure but ",
-						    Status.pretty status, " in ",
-						    sign, ": "]),
-					      layout (strids, Ast.Vid.layout name)],
-					 Layout.empty)
-				  in
-				     vid
-				  end
-		      in
-			 (vid, SOME sigScheme)
-		      end
-		 | _ => 
-		      (* We don't want to cause spurious errors by guessing.
-		       * Putting strScheme here would be
-		       * wrong, because it isn't what the signature says --
-		       * it might expose stuff hidden by the signature.
-		       *)
-		      (vid, NONE))
+                               end
+                         fun addDec (n: Exp.node): Vid.t =
+                            let
+                               val x = Var.newNoname ()
+                               val e = Exp.make (n, strType)
+                               val _ =
+                                  List.push
+                                  (decs,
+                                   Dec.Val {nonexhaustiveExnMatch = nonexhaustiveExnMatch (),
+                                            nonexhaustiveMatch = nonexhaustiveMatch (),
+                                            rvbs = Vector.new0 (),
+                                            tyvars = fn () => sigArgs,
+                                            vbs = (Vector.new1
+                                                   {exp = e,
+                                                    lay = fn _ => Layout.empty,
+                                                    pat = Pat.var (x, strType),
+                                                    patRegion = region})})
+                            in
+                               Vid.Var x
+                            end
+                         fun con (c: Con.t): Vid.t =
+                            addDec (Exp.Con (c, strArgs ()))
+                         val vid =
+                            case (vid, status) of
+                               (Vid.Con c, Status.Var) => con c
+                             | (Vid.Exn c, Status.Var) => con c
+                             | (Vid.Var x, Status.Var) =>
+                                  if 0 < Vector.length sigArgs
+                                     orelse 0 < Vector.length (strArgs ())
+                                     then addDec (Exp.Var (fn () => x, strArgs))
+                                  else vid
+                             | (Vid.Con _, Status.Con) => vid
+                             | (Vid.Exn _, Status.Exn) => vid
+                             | _ =>
+                                  let
+                                     open Layout
+                                     val _ =
+                                        Control.error
+                                        (region,
+                                         seq [str (concat
+                                                   [Vid.statusPretty vid,
+                                                    " in structure but ",
+                                                    Status.pretty status, " in ",
+                                                    sign, ": "]),
+                                              layout (strids, Ast.Vid.layout name)],
+                                         Layout.empty)
+                                  in
+                                     vid
+                                  end
+                      in
+                         (vid, SOME sigScheme)
+                      end
+                 | _ => 
+                      (* We don't want to cause spurious errors by guessing.
+                       * Putting strScheme here would be
+                       * wrong, because it isn't what the signature says --
+                       * it might expose stuff hidden by the signature.
+                       *)
+                      (vid, NONE))
 
-	 in
-	    Structure.T {interface = SOME I,
-			 plist = PropertyList.new (),
-			 strs = strs,
-			 types = types,
-			 vals = vals}
-	 end
+         in
+            Structure.T {interface = SOME I,
+                         plist = PropertyList.new (),
+                         strs = strs,
+                         types = types,
+                         vals = vals}
+         end
       val I = Interface.copy I
       val () =
-	 Structure.realize
-	 (S, Interface.flexibleTycons I,
-	  fn (name, flex, typeStr, {nest}) =>
-	  let
-	     val {admitsEquality = a, hasCons, kind = k, ...} =
-		FlexibleTycon.dest flex
-	     val typeStr =
-		case typeStr of
-		   NONE => NONE
-		 | SOME typeStr =>
-		      (* Makes sure we only realize a plausible candidate for
-		       * typeStr.
-		       *)
-		      if isPlausible
-			 (typeStr, nest, name, a, k,
-			  hasCons
-			  andalso Option.isNone (TypeStr.toTyconOpt typeStr))
-			 then SOME typeStr
-		      else NONE
-	     val () = FlexibleTycon.realize (flex, typeStr)
-	  in
-	     ()
-	  end)
+         Structure.realize
+         (S, Interface.flexibleTycons I,
+          fn (name, flex, typeStr, {nest}) =>
+          let
+             val {admitsEquality = a, hasCons, kind = k, ...} =
+                FlexibleTycon.dest flex
+             val typeStr =
+                case typeStr of
+                   NONE => NONE
+                 | SOME typeStr =>
+                      (* Makes sure we only realize a plausible candidate for
+                       * typeStr.
+                       *)
+                      if isPlausible
+                         (typeStr, nest, name, a, k,
+                          hasCons
+                          andalso Option.isNone (TypeStr.toTyconOpt typeStr))
+                         then SOME typeStr
+                      else NONE
+             val () = FlexibleTycon.realize (flex, typeStr)
+          in
+             ()
+          end)
       val S = cut (S, I, [])
       val () = destroy ()
    in
@@ -2981,7 +3010,7 @@
 
 (* section 5.3, 5.5, 5.6 and rules 52, 53 *)
 fun cut (E: t, S: Structure.t, I: Interface.t,
-	 {isFunctor: bool, opaque: bool, prefix: string}, region)
+         {isFunctor: bool, opaque: bool, prefix: string}, region)
    : Structure.t * Decs.t =
    let
       val (S, decs) = transparentCut (E, S, I, {isFunctor = isFunctor}, region)
@@ -2989,18 +3018,18 @@
        * to internal errors that might be confusing to the user.
        *)
       val S = 
-	 if opaque andalso 0 = !Control.numErrors
-	    then makeOpaque (S, I, {prefix = prefix})
-	 else S
+         if opaque andalso 0 = !Control.numErrors
+            then makeOpaque (S, I, {prefix = prefix})
+         else S
    in
       (S, decs)
    end
 
 val cut =
-   Trace.trace ("cut",
-		fn (_, S, I, _, _) =>
-		Layout.tuple [Structure.layoutPretty S, Interface.layout I],
-		Structure.layoutPretty o #1)
+   Trace.trace ("ElaborateEnv.cut",
+                fn (_, S, I, _, _) =>
+                Layout.tuple [Structure.layoutPretty S, Interface.layout I],
+                Structure.layoutPretty o #1)
    cut
 
 (* ------------------------------------------------- *)
@@ -3013,76 +3042,76 @@
       val add: (Scope.t -> unit) list ref = ref []
       (* Push onto add everything currently in scope. *)
       fun doit (NameSpace.T {current, ...}) (v as Values.T vs) =
-	 case ! vs of
-	    [] => ()
-	  | {domain, range, uses, ...} :: _ =>
-	       List.push
-	       (add, fn s0 =>
-		(List.push (vs, {domain = domain,
-				 range = range,
-				 scope = s0,
-				 time = Time.next (),
-				 uses = uses})
-		 ; List.push (current, v)))
+         case ! vs of
+            [] => ()
+          | {domain, range, uses, ...} :: _ =>
+               List.push
+               (add, fn s0 =>
+                (List.push (vs, {domain = domain,
+                                 range = range,
+                                 scope = s0,
+                                 time = Time.next (),
+                                 uses = uses})
+                 ; List.push (current, v)))
       val _ =
-	 foreachTopLevelSymbol (E, {bass = doit bass,
-				    fcts = doit fcts,
-				    fixs = doit fixs,
-				    sigs = doit sigs,
-				    strs = doit strs,
-				    types = doit types,
-				    vals = doit vals})
+         foreachTopLevelSymbol (E, {bass = doit bass,
+                                    fcts = doit fcts,
+                                    fixs = doit fixs,
+                                    sigs = doit sigs,
+                                    strs = doit strs,
+                                    types = doit types,
+                                    vals = doit vals})
    in
       fn th =>
       let
-	 val s0 = Scope.new {isTop = false}
-	 val restore: (unit -> unit) list ref = ref []
-	 fun doit (NameSpace.T {current, ...}) =
-	    let
-	       val current0 = !current
-	       val _ = current := []
-	    in
-	       List.push (restore, fn () =>
-			  (List.foreach (!current, fn v => ignore (Values.pop v))
-			   ; current := current0))
-	    end
-	 val _ = (doit bass; doit fcts; doit fixs; doit sigs
-		  ; doit strs; doit types; doit vals)
-	 val _ = List.foreach (!add, fn f => f s0)
-	 (* Clear out any symbols that weren't available in the old scope. *)
-	 fun doit (Values.T vs) =
-	    let
-	       val cur = !vs
-	    in
-	       case cur of
-		  [] => ()
-		| {scope, ...} :: _ =>
-		     if Scope.equals (s0, scope)
-			then ()
-		     else (vs := []
-			   ; List.push (restore, fn () => vs := cur))
-	    end
-	 val _ =
-	    (* Can't use foreachToplevelSymbol here, because a constructor C may
-	     * have been defined in a local scope but may not have been defined
-	     * at the snapshot point.  This will make the identifier C, which
-	     * originally would have elaborated as a variable instead elaborate
-	     * as a constructor.
-	     *)
-	    foreachDefinedSymbol (E, {bass = doit,
-				      fcts = doit,
-				      fixs = doit,
-				      sigs = doit,
-				      strs = doit,
-				      types = doit,
-				      vals = doit})
-	 val s1 = !currentScope
-	 val _ = currentScope := s0
-	 val res = th ()
-	 val _ = currentScope := s1
-	 val _ = List.foreach (!restore, fn f => f ())
+         val s0 = Scope.new {isTop = false}
+         val restore: (unit -> unit) list ref = ref []
+         fun doit (NameSpace.T {current, ...}) =
+            let
+               val current0 = !current
+               val _ = current := []
+            in
+               List.push (restore, fn () =>
+                          (List.foreach (!current, fn v => ignore (Values.pop v))
+                           ; current := current0))
+            end
+         val _ = (doit bass; doit fcts; doit fixs; doit sigs
+                  ; doit strs; doit types; doit vals)
+         val _ = List.foreach (!add, fn f => f s0)
+         (* Clear out any symbols that weren't available in the old scope. *)
+         fun doit (Values.T vs) =
+            let
+               val cur = !vs
+            in
+               case cur of
+                  [] => ()
+                | {scope, ...} :: _ =>
+                     if Scope.equals (s0, scope)
+                        then ()
+                     else (vs := []
+                           ; List.push (restore, fn () => vs := cur))
+            end
+         val _ =
+            (* Can't use foreachToplevelSymbol here, because a constructor C may
+             * have been defined in a local scope but may not have been defined
+             * at the snapshot point.  This will make the identifier C, which
+             * originally would have elaborated as a variable instead elaborate
+             * as a constructor.
+             *)
+            foreachDefinedSymbol (E, {bass = doit,
+                                      fcts = doit,
+                                      fixs = doit,
+                                      sigs = doit,
+                                      strs = doit,
+                                      types = doit,
+                                      vals = doit})
+         val s1 = !currentScope
+         val _ = currentScope := s0
+         val res = th ()
+         val _ = currentScope := s1
+         val _ = List.foreach (!restore, fn f => f ())
       in
-	 res
+         res
       end
    end
 
@@ -3098,14 +3127,16 @@
        * allTycons up to firstTycon.
        *)
       val firstTycon =
-	 case !allTycons of
-	    [] => Error.bug "no front of allTycons"
-	  | c :: _ => c
+         case !allTycons of
+            [] => Error.bug "ElaborateEnv.functorClosure: firstTycons"
+          | c :: _ => c
       (* Need to tick here so that any tycons created in the dummy structure
        * for the functor formal have a new time, and will therefore report an
        * error if they occur before the functor declaration.
        *)
-      val _ = TypeEnv.tick {useBeforeDef = fn _ => Error.bug "functor tick"}
+      val _ = 
+         TypeEnv.tick {useBeforeDef = fn _ => 
+                       Error.bug "ElaborateEnv.functorClosure: tick"}
       val (formal, instantiate) = dummyStructure (argInt, {prefix = prefix})
       val _ = insideFunctor := true
       (* Keep track of all tycons created during the instantiation of the
@@ -3121,132 +3152,133 @@
       val _ = Option.app (result, Structure.forceUsed)
       val generative = !newTycons
       val _ = allTycons := let
-			      fun loop cs =
-				 case cs of
-				    [] => Error.bug "allTycons missing front"
-				  | c :: cs =>
-				       if Tycon.equals (c, firstTycon)
-					  then cs
-				       else loop cs
-			   in
-			      loop (!allTycons)
-			   end
+                              fun loop cs =
+                                 case cs of
+                                    [] => Error.bug "ElaborateEnv.functorClosure: missing firstTycon"
+                                  | c :: cs' =>
+                                       if Tycon.equals (c, firstTycon) then
+                                          cs
+                                       else
+                                          loop cs'
+                           in
+                              loop (!allTycons)
+                           end
       val _ = newTycons := []
       val _ = insideFunctor := false
       val restore =
-	 if !Control.elaborateOnly
-	    then fn f => f ()
-	 else let 
-		 val withSaved = Control.Elaborate.snapshot ()
-		 val snapshot = snapshot E
-	      in 
-		 fn f => snapshot (fn () => withSaved f)
-	      end
+         if !Control.elaborateOnly
+            then fn f => f ()
+         else let 
+                 val withSaved = Control.Elaborate.snapshot ()
+                 val snapshot = snapshot E
+              in 
+                 fn f => snapshot (fn () => withSaved f)
+              end
       fun apply (actual, nest) =
-	 if not (!insideFunctor) andalso not (!Control.elaborateOnly)
-	    then restore (fn () => makeBody (actual, nest))
-	 else
-	    let
-	       val _ = Structure.forceUsed actual
-	       val {destroy = destroy1,
-		    get = tyconTypeStr: Tycon.t -> TypeStr.t option,
-		    set = setTyconTypeStr, ...} =
-		  Property.destGetSet (Tycon.plist, Property.initConst NONE)
-	       (* Match the actual against the formal, to set the tycons.
-		* Then duplicate the result, replacing tycons.  Want to generate
-		* new tycons just like the functor body did.
-		*)
-	       val _ =
-		  instantiate (actual, fn (c, s) => setTyconTypeStr (c, SOME s))
-	       val _ =
-		  List.foreach
-		  (generative, fn (c, k, r) =>
-		   setTyconTypeStr
-		   (c, SOME (TypeStr.tycon
-			     (newTycon (Tycon.originalName c, k,
-					! (TypeEnv.tyconAdmitsEquality c),
-					r),
-			      k))))
-	       fun replaceType (t: Type.t): Type.t =
-		  let
-		     fun con (c, ts) =
-			case tyconTypeStr c of
-			   NONE => Type.con (c, ts)
-			 | SOME s => TypeStr.apply (s, ts)
-		  in
-		     Type.hom (t, {con = con,
-				   expandOpaque = false,
-				   record = Type.record,
-				   replaceSynonyms = false,
-				   var = Type.var})
-		  end
-	       fun replaceScheme (s: Scheme.t): Scheme.t =
-		  let
-		     val (tyvars, ty) = Scheme.dest s
-		  in
-		     Scheme.make {canGeneralize = true,
-				  ty = replaceType ty,
-				  tyvars = tyvars}
-		  end
-	       fun replaceCons (Cons.T v): Cons.t =
-		  Cons.T
-		  (Vector.map
-		   (v, fn {con, name, scheme, uses} =>
-		    {con = con,
-		     name = name,
-		     scheme = replaceScheme scheme,
-		     uses = uses}))
-	       fun replaceTypeStr (s: TypeStr.t): TypeStr.t =
-		  let
-		     val k = TypeStr.kind s
-		     datatype z = datatype TypeStr.node
-		  in
-		     case TypeStr.node s of
-			Datatype {cons, tycon} =>
-			   let
-			      val tycon =
-				 case tyconTypeStr tycon of
-				    NONE => tycon
-				  | SOME s =>
-				       (case TypeStr.node s of
-					   Datatype {tycon, ...} => tycon
-					 | Scheme _ =>
-					      Error.bug "bad datatype"
-					 | Tycon c => c)
-			   in
-			      TypeStr.data (tycon, k, replaceCons cons)
-			   end
-		      | Scheme s => TypeStr.def (replaceScheme s, k)
-		      | Tycon c =>
-			   (case tyconTypeStr c of
-			       NONE => s
-			     | SOME s' => s')
-		  end
-	       val {destroy = destroy2,
-		    get = replacement: Structure.t -> Structure.t, ...} =
-		  Property.destGet
-		  (Structure.plist,
-		   Property.initRec
-		   (fn (Structure.T {interface, strs, types, vals, ... },
-			replacement) =>
-		    Structure.T
-		    {interface = interface,
-		     plist = PropertyList.new (),
-		     strs = Info.map (strs, replacement),
-		     types = Info.map (types, replaceTypeStr),
-		     vals = Info.map (vals, fn (v, s) =>
-				      (v, Option.map (s, replaceScheme)))}))
-	       val result = Option.map (result, replacement)
-	       val _ = destroy1 ()
-	       val _ = destroy2 ()
-	    in
-	       (Decs.empty, result)
-	    end
+         if not (!insideFunctor) andalso not (!Control.elaborateOnly)
+            then restore (fn () => makeBody (actual, nest))
+         else
+            let
+               val _ = Structure.forceUsed actual
+               val {destroy = destroy1,
+                    get = tyconTypeStr: Tycon.t -> TypeStr.t option,
+                    set = setTyconTypeStr, ...} =
+                  Property.destGetSet (Tycon.plist, Property.initConst NONE)
+               (* Match the actual against the formal, to set the tycons.
+                * Then duplicate the result, replacing tycons.  Want to generate
+                * new tycons just like the functor body did.
+                *)
+               val _ =
+                  instantiate (actual, fn (c, s) => setTyconTypeStr (c, SOME s))
+               val _ =
+                  List.foreach
+                  (generative, fn (c, k, r) =>
+                   setTyconTypeStr
+                   (c, SOME (TypeStr.tycon
+                             (newTycon (Tycon.originalName c, k,
+                                        ! (TypeEnv.tyconAdmitsEquality c),
+                                        r),
+                              k))))
+               fun replaceType (t: Type.t): Type.t =
+                  let
+                     fun con (c, ts) =
+                        case tyconTypeStr c of
+                           NONE => Type.con (c, ts)
+                         | SOME s => TypeStr.apply (s, ts)
+                  in
+                     Type.hom (t, {con = con,
+                                   expandOpaque = false,
+                                   record = Type.record,
+                                   replaceSynonyms = false,
+                                   var = Type.var})
+                  end
+               fun replaceScheme (s: Scheme.t): Scheme.t =
+                  let
+                     val (tyvars, ty) = Scheme.dest s
+                  in
+                     Scheme.make {canGeneralize = true,
+                                  ty = replaceType ty,
+                                  tyvars = tyvars}
+                  end
+               fun replaceCons (Cons.T v): Cons.t =
+                  Cons.T
+                  (Vector.map
+                   (v, fn {con, name, scheme, uses} =>
+                    {con = con,
+                     name = name,
+                     scheme = replaceScheme scheme,
+                     uses = uses}))
+               fun replaceTypeStr (s: TypeStr.t): TypeStr.t =
+                  let
+                     val k = TypeStr.kind s
+                     datatype z = datatype TypeStr.node
+                  in
+                     case TypeStr.node s of
+                        Datatype {cons, tycon} =>
+                           let
+                              val tycon =
+                                 case tyconTypeStr tycon of
+                                    NONE => tycon
+                                  | SOME s =>
+                                       (case TypeStr.node s of
+                                           Datatype {tycon, ...} => tycon
+                                         | Scheme _ =>
+                                              Error.bug "ElaborateEnv.functorClosure.apply: bad datatype"
+                                         | Tycon c => c)
+                           in
+                              TypeStr.data (tycon, k, replaceCons cons)
+                           end
+                      | Scheme s => TypeStr.def (replaceScheme s, k)
+                      | Tycon c =>
+                           (case tyconTypeStr c of
+                               NONE => s
+                             | SOME s' => s')
+                  end
+               val {destroy = destroy2,
+                    get = replacement: Structure.t -> Structure.t, ...} =
+                  Property.destGet
+                  (Structure.plist,
+                   Property.initRec
+                   (fn (Structure.T {interface, strs, types, vals, ... },
+                        replacement) =>
+                    Structure.T
+                    {interface = interface,
+                     plist = PropertyList.new (),
+                     strs = Info.map (strs, replacement),
+                     types = Info.map (types, replaceTypeStr),
+                     vals = Info.map (vals, fn (v, s) =>
+                                      (v, Option.map (s, replaceScheme)))}))
+               val result = Option.map (result, replacement)
+               val _ = destroy1 ()
+               val _ = destroy2 ()
+            in
+               (Decs.empty, result)
+            end
    in
       FunctorClosure.T {apply = apply,
-			argInt = argInt,
-			formal = formal,
-			result = result}
+                        argInt = argInt,
+                        formal = formal,
+                        result = result}
    end
 
 structure Env =
@@ -3257,48 +3289,48 @@
 structure InterfaceEnv =
    struct
       local
-	 open Interface
+         open Interface
       in
-	 structure Scheme = Scheme
-	 structure Status = Status
-	 structure TypeStr = TypeStr
+         structure Scheme = Scheme
+         structure Status = Status
+         structure TypeStr = TypeStr
       end
-	 
+         
       val allowDuplicates = ref false
 
       type t = t
-	 
+         
       fun extend (T {currentScope, interface, ...},
-		  domain, range, kind: string, ns, region): unit =
-	 let
-	    val scope = !currentScope
-	    val NameSpace.T {current, lookup, toSymbol, ...} = ns interface
-	    fun value () = {domain = domain,
-			    range = range,
-			    scope = scope,
-			    time = Time.next (),
-			    uses = Uses.new ()}
-	    val values as Values.T r = lookup domain
-	    fun new () = (List.push (current, values)
-			  ; List.push (r, value ()))
-	 in
-	    case !r of
-	       [] => new ()
-	     | {scope = scope', ...} :: l =>
-		  if Scope.equals (scope, scope')
-		     then if !allowDuplicates
-			     then r := value () :: l
-			  else
-			     Control.error
-			     (region,
-			      Layout.str
-			      (concat ["duplicate ",
-				       kind,
-				       " specification: ",
-				       Symbol.toString (toSymbol domain)]),
-			      Layout.empty)
-		  else new ()
-	 end
+                  domain, range, kind: string, ns, region): unit =
+         let
+            val scope = !currentScope
+            val NameSpace.T {current, lookup, toSymbol, ...} = ns interface
+            fun value () = {domain = domain,
+                            range = range,
+                            scope = scope,
+                            time = Time.next (),
+                            uses = Uses.new ()}
+            val values as Values.T r = lookup domain
+            fun new () = (List.push (current, values)
+                          ; List.push (r, value ()))
+         in
+            case !r of
+               [] => new ()
+             | {scope = scope', ...} :: l =>
+                  if Scope.equals (scope, scope')
+                     then if !allowDuplicates
+                             then r := value () :: l
+                          else
+                             Control.error
+                             (region,
+                              Layout.str
+                              (concat ["duplicate ",
+                                       kind,
+                                       " specification: ",
+                                       Symbol.toString (toSymbol domain)]),
+                              Layout.empty)
+                  else new ()
+         end
 
       fun extendStrid (E, s, I, r) = extend (E, s, I, "structure", #strs, r)
 
@@ -3309,105 +3341,105 @@
       val lookupSigid = lookupSigid
 
       local
-	 fun make sel (T {interface, ...}, a) =
-	    NameSpace.peek (sel interface, a, {markUse = fn _ => true})
+         fun make sel (T {interface, ...}, a) =
+            NameSpace.peek (sel interface, a, {markUse = fn _ => true})
       in
-	 val peekStrid = make #strs
-	 val peekTycon = make #types
+         val peekStrid = make #strs
+         val peekTycon = make #types
       end
 
       fun lookupLongstrid (E: t, s: Longstrid.t): Interface.t option =
-	 let
-	    fun error l =
-	       (unbound (Longstrid.region s, "structure", l)
-		; NONE)
-	    val (strids, strid) = Longstrid.split s
-	 in
-	    case strids of
-	       [] =>
-		  (case peekStrid (E, strid) of
-		      NONE => error (Strid.layout strid)
-		    | SOME I => SOME I)
-	     | s :: ss =>
-		  case peekStrid (E, s) of
-		     NONE => error (Strid.layout s)
-		   | SOME I =>
-			let
-			   datatype z = datatype Interface.peekResult
-			in
-			   case Interface.peekStrids (I, ss @ [strid]) of
-			      Found I => SOME I
-			    | UndefinedStructure ss =>
-				 error (layoutStrids (s :: ss))
-			end
-	 end
+         let
+            fun error l =
+               (unbound (Longstrid.region s, "structure", l)
+                ; NONE)
+            val (strids, strid) = Longstrid.split s
+         in
+            case strids of
+               [] =>
+                  (case peekStrid (E, strid) of
+                      NONE => error (Strid.layout strid)
+                    | SOME I => SOME I)
+             | s :: ss =>
+                  case peekStrid (E, s) of
+                     NONE => error (Strid.layout s)
+                   | SOME I =>
+                        let
+                           datatype z = datatype Interface.peekResult
+                        in
+                           case Interface.peekStrids (I, ss @ [strid]) of
+                              Found I => SOME I
+                            | UndefinedStructure ss =>
+                                 error (layoutStrids (s :: ss))
+                        end
+         end
       
       fun lookupLongtycon (E: t, long: Longtycon.t): TypeStr.t option =
-	 let
-	    fun doit () =
-	       Option.map (Env.lookupLongtycon (E, long), TypeStr.fromEnv)
-	    val (strids, c) = Longtycon.split long
-	 in
-	    case strids of
-	       [] =>
-		  (case peekTycon (E, c) of
-		      NONE => doit ()
-		    | SOME s => SOME s)
-	     | s :: ss =>
-		  case peekStrid (E, s) of
-		     NONE => doit ()
-		   | SOME I =>
-			Interface.lookupLongtycon
-			(I, Longtycon.long (ss, c), Longtycon.region long,
-			 {prefix = [s]})
-	 end
+         let
+            fun doit () =
+               Option.map (Env.lookupLongtycon (E, long), TypeStr.fromEnv)
+            val (strids, c) = Longtycon.split long
+         in
+            case strids of
+               [] =>
+                  (case peekTycon (E, c) of
+                      NONE => doit ()
+                    | SOME s => SOME s)
+             | s :: ss =>
+                  case peekStrid (E, s) of
+                     NONE => doit ()
+                   | SOME I =>
+                        Interface.lookupLongtycon
+                        (I, Longtycon.long (ss, c), Longtycon.region long,
+                         {prefix = [s]})
+         end
 
       fun makeInterface (T {currentScope, interface = {strs, types, vals}, ...},
-			 {isTop}, make) =
-	 let
-	    val s = NameSpace.collect strs
-	    val t = NameSpace.collect types
-	    val v = NameSpace.collect vals
-	    val s0 = !currentScope
-	    val _ = currentScope := Scope.new {isTop = false}
-	    val res = make ()
-	    val Info.T s = s ()
-	    val s = Array.map (s, fn {domain, range, ...} => (domain, range))
-	    val Info.T t = t ()
-	    val t = Array.map (t, fn {domain, range, ...} => (domain, range))
-	    val Info.T v = v ()
-	    val v = Array.map (v, fn {domain, range = (status, scheme), ...} =>
-			       (domain, (status, scheme)))
-	    val I = Interface.new {isClosed = isTop,
-				   strs = s, types = t, vals = v}
-	    val _ = currentScope := s0
-	 in
-	    (I, res)
-	 end
+                         {isTop}, make) =
+         let
+            val s = NameSpace.collect strs
+            val t = NameSpace.collect types
+            val v = NameSpace.collect vals
+            val s0 = !currentScope
+            val _ = currentScope := Scope.new {isTop = false}
+            val res = make ()
+            val Info.T s = s ()
+            val s = Array.map (s, fn {domain, range, ...} => (domain, range))
+            val Info.T t = t ()
+            val t = Array.map (t, fn {domain, range, ...} => (domain, range))
+            val Info.T v = v ()
+            val v = Array.map (v, fn {domain, range = (status, scheme), ...} =>
+                               (domain, (status, scheme)))
+            val I = Interface.new {isClosed = isTop,
+                                   strs = s, types = t, vals = v}
+            val _ = currentScope := s0
+         in
+            (I, res)
+         end
       
       fun openInterface (E, I, r: Region.t) =
-	 let
-	    val {strs, vals, types} = Interface.dest I
-	    val _ = Array.foreach (strs, fn (s, I) => extendStrid (E, s, I, r))
-	    val _ = Array.foreach (types, fn (c, s) => extendTycon (E, c, s, r))
-	    val _ = Array.foreach (vals, fn (x, (s, sc)) =>
-				   extendVid (E, x, s, sc, r))
-	 in
-	    ()
-	 end
+         let
+            val {strs, vals, types} = Interface.dest I
+            val _ = Array.foreach (strs, fn (s, I) => extendStrid (E, s, I, r))
+            val _ = Array.foreach (types, fn (c, s) => extendTycon (E, c, s, r))
+            val _ = Array.foreach (vals, fn (x, (s, sc)) =>
+                                   extendVid (E, x, s, sc, r))
+         in
+            ()
+         end
 
       val extendStrid = fn (E, s, I) => extendStrid (E, s, I, Strid.region s)
 
       val extendTycon = fn (E, c, s) => extendTycon (E, c, s, Ast.Tycon.region c)
 
       val extendVid =
-	 fn (E, v, st, s) => extendVid (E, v, st, s, Ast.Vid.region v)
+         fn (E, v, st, s) => extendVid (E, v, st, s, Ast.Vid.region v)
 
       fun extendCon (E, c, s) =
-	 extendVid (E, Ast.Vid.fromCon c, Status.Con, s)
+         extendVid (E, Ast.Vid.fromCon c, Status.Con, s)
 
       fun extendExn (E, c, s) =
-	 extendVid (E, Ast.Vid.fromCon c, Status.Exn, s)
+         extendVid (E, Ast.Vid.fromCon c, Status.Exn, s)
 end
 
 val makeInterfaceEnv = fn E => E

Modified: mlton/branches/on-20050420-cmm-branch/mlton/elaborate/elaborate-env.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/elaborate/elaborate-env.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/elaborate/elaborate-env.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature ELABORATE_ENV_STRUCTS =
    sig
       structure Ast: AST
@@ -23,134 +24,134 @@
 
       structure AdmitsEquality: ADMITS_EQUALITY
       sharing AdmitsEquality = TypeEnv.Tycon.AdmitsEquality
-	 
+         
       structure Decs: DECS
       sharing CoreML = Decs.CoreML
 
       structure Tycon: TYCON
       sharing Tycon = TypeEnv.Tycon
       structure Type:
-	 sig
-	    type t
-	 end
+         sig
+            type t
+         end
       sharing Type = TypeEnv.Type
       structure Scheme:
-	 sig
-	    type t
-	 end
+         sig
+            type t
+         end
       sharing Scheme = TypeEnv.Scheme
       (* The value of a vid.  This is used to distinguish between vids whose
        * status cannot be determined at parse time.
        *)
       structure Vid:
-	 sig
-	    datatype t =
-	       Con of CoreML.Con.t
-	     | Exn of CoreML.Con.t
-	     | Overload of Ast.Priority.t * (CoreML.Var.t * Type.t option) vector
-	     | Var of CoreML.Var.t
+         sig
+            datatype t =
+               Con of CoreML.Con.t
+             | Exn of CoreML.Con.t
+             | Overload of Ast.Priority.t * (CoreML.Var.t * Type.t option) vector
+             | Var of CoreML.Var.t
 
-	    val layout: t -> Layout.t
-	 end
+            val layout: t -> Layout.t
+         end
       structure TypeStr:
-	 sig
-	    structure Cons:
-	       sig
-		  type t
+         sig
+            structure Cons:
+               sig
+                  type t
 
-		  val empty: t
-		  val layout: t -> Layout.t
-	       end
-	    structure Kind: TYCON_KIND
-	    structure Tycon:
-	       sig
-		  type t
-	       end
-	       
-	    type t
+                  val empty: t
+                  val layout: t -> Layout.t
+               end
+            structure Kind: TYCON_KIND
+            structure Tycon:
+               sig
+                  type t
+               end
+               
+            type t
 
-	    datatype node =
-	       Datatype of {cons: Cons.t,
-			    tycon: Tycon.t}
-	     | Scheme of Scheme.t
-	     | Tycon of Tycon.t
+            datatype node =
+               Datatype of {cons: Cons.t,
+                            tycon: Tycon.t}
+             | Scheme of Scheme.t
+             | Tycon of Tycon.t
 
-	    val abs: t -> t
-	    val admitsEquality: t -> AdmitsEquality.t
-	    val apply: t * Type.t vector -> Type.t
-	    val bogus: Kind.t -> t
-	    val cons: t -> Cons.t
-	    val data: Tycon.t * Kind.t * Cons.t -> t
-	    val def: Scheme.t * Kind.t -> t
-	    val kind: t -> Kind.t
-	    val layout: t -> Layout.t
-	    val node: t -> node
-	    val toTyconOpt: t -> Tycon.t option (* NONE on Scheme *)
-	    val tycon: Tycon.t * Kind.t -> t
-	 end
+            val abs: t -> t
+            val admitsEquality: t -> AdmitsEquality.t
+            val apply: t * Type.t vector -> Type.t
+            val bogus: Kind.t -> t
+            val cons: t -> Cons.t
+            val data: Tycon.t * Kind.t * Cons.t -> t
+            val def: Scheme.t * Kind.t -> t
+            val kind: t -> Kind.t
+            val layout: t -> Layout.t
+            val node: t -> node
+            val toTyconOpt: t -> Tycon.t option (* NONE on Scheme *)
+            val tycon: Tycon.t * Kind.t -> t
+         end
       sharing TypeStr.Kind = Tycon.Kind
       sharing TypeStr.Tycon = CoreML.Tycon
       structure Interface: INTERFACE
       sharing Interface.Ast = Ast
       sharing Interface.EnvTypeStr = TypeStr
       structure Structure:
-	 sig
-	    type t
-	       
-	    (* ffi represents MLtonFFI, which is built by the basis library and
-	     * set via the special _basis_done topdec.
-	     *)
-	    val ffi: t option ref
-	    val forceUsed: t -> unit
-	    val layout: t -> Layout.t
-	 end
+         sig
+            type t
+               
+            (* ffi represents MLtonFFI, which is built by the basis library and
+             * set via the special _basis_done topdec.
+             *)
+            val ffi: t option ref
+            val forceUsed: t -> unit
+            val layout: t -> Layout.t
+         end
       structure FunctorClosure:
-	 sig
-	    type t
+         sig
+            type t
 
-	    val apply: (t * Structure.t * string list
-			-> Decs.t * Structure.t option)
-	    val argInterface: t -> Interface.t
-	 end
+            val apply: (t * Structure.t * string list
+                        -> Decs.t * Structure.t option)
+            val argInterface: t -> Interface.t
+         end
       structure InterfaceEnv:
-	 sig
-	    structure Scheme:
-	       sig
-		  type t
-	       end
-	    structure Status:
-	       sig
-		  type t
-	       end
-	    structure TypeStr:
-	       sig
-		  type t
-	       end
+         sig
+            structure Scheme:
+               sig
+                  type t
+               end
+            structure Status:
+               sig
+                  type t
+               end
+            structure TypeStr:
+               sig
+                  type t
+               end
 
-	    type t
+            type t
 
-	    val allowDuplicates: bool ref
-	    val extendCon: t * Ast.Con.t * Scheme.t -> unit
-	    val extendExn: t * Ast.Con.t * Scheme.t -> unit
-	    val extendStrid: t * Ast.Strid.t * Interface.t -> unit
-	    val extendTycon: t * Ast.Tycon.t * TypeStr.t -> unit
-	    val extendVid: t * Ast.Vid.t * Status.t * Scheme.t -> unit
-	    val lookupLongstrid: t * Ast.Longstrid.t -> Interface.t option
-	    val lookupLongtycon: t * Ast.Longtycon.t -> TypeStr.t option
-	    val lookupSigid: t * Ast.Sigid.t -> Interface.t option
-	    val makeInterface:
-	       t * {isTop: bool} * (unit -> 'a) -> Interface.t * 'a
-	    val openInterface: t * Interface.t * Region.t -> unit
-	 end
+            val allowDuplicates: bool ref
+            val extendCon: t * Ast.Con.t * Scheme.t -> unit
+            val extendExn: t * Ast.Con.t * Scheme.t -> unit
+            val extendStrid: t * Ast.Strid.t * Interface.t -> unit
+            val extendTycon: t * Ast.Tycon.t * TypeStr.t -> unit
+            val extendVid: t * Ast.Vid.t * Status.t * Scheme.t -> unit
+            val lookupLongstrid: t * Ast.Longstrid.t -> Interface.t option
+            val lookupLongtycon: t * Ast.Longtycon.t -> TypeStr.t option
+            val lookupSigid: t * Ast.Sigid.t -> Interface.t option
+            val makeInterface:
+               t * {isTop: bool} * (unit -> 'a) -> Interface.t * 'a
+            val openInterface: t * Interface.t * Region.t -> unit
+         end
       sharing Interface.Scheme = InterfaceEnv.Scheme
       sharing Interface.Status = InterfaceEnv.Status
       sharing Interface.TypeStr = InterfaceEnv.TypeStr
 
       structure Basis:
-	 sig
-	    type t
-	    val layout: t -> Layout.t
-	 end
+         sig
+            type t
+            val layout: t -> Layout.t
+         end
 
       type t
 
@@ -159,9 +160,9 @@
        * in the interface.  It proceeds recursively on substructures.
        *)
       val cut:
-	 t * Structure.t * Interface.t
-	 * {isFunctor: bool, opaque: bool, prefix: string} * Region.t
-	 -> Structure.t * Decs.t
+         t * Structure.t * Interface.t
+         * {isFunctor: bool, opaque: bool, prefix: string} * Region.t
+         -> Structure.t * Decs.t
       val empty: unit -> t
       val extendBasid: t * Ast.Basid.t * Basis.t -> unit
       val extendExn: t * Ast.Con.t * CoreML.Con.t * Scheme.t option -> unit
@@ -170,19 +171,19 @@
       val extendSigid: t * Ast.Sigid.t * Interface.t -> unit
       val extendStrid: t * Ast.Strid.t * Structure.t -> unit
       val extendTycon:
-	 t * Ast.Tycon.t * TypeStr.t * {forceUsed: bool, isRebind: bool} -> unit
+         t * Ast.Tycon.t * TypeStr.t * {forceUsed: bool, isRebind: bool} -> unit
       val extendVar:
-	 t * Ast.Var.t * CoreML.Var.t * Scheme.t * {isRebind: bool} -> unit
+         t * Ast.Var.t * CoreML.Var.t * Scheme.t * {isRebind: bool} -> unit
       val extendOverload:
-	 t * Ast.Priority.t * Ast.Var.t * (CoreML.Var.t * Type.t option) vector
-	 * Scheme.t
-	 -> unit
+         t * Ast.Priority.t * Ast.Var.t * (CoreML.Var.t * Type.t option) vector
+         * Scheme.t
+         -> unit
       val forceUsed: t -> unit
       val forceUsedLocal: t * (unit -> 'a) -> 'a
       val functorClosure:
-	 t * string * Interface.t
-	 * (Structure.t * string list -> Decs.t * Structure.t option)
-	 -> FunctorClosure.t
+         t * string * Interface.t
+         * (Structure.t * string list -> Decs.t * Structure.t option)
+         -> FunctorClosure.t
       val layout: t -> Layout.t
       val layoutCurrentScope: t -> Layout.t
       val layoutUsed: t -> Layout.t
@@ -202,18 +203,18 @@
       val makeInterfaceEnv: t -> InterfaceEnv.t
       val makeStructure: t * (unit -> 'a) -> 'a * Structure.t
       val newCons: ((t * {con: CoreML.Con.t,
-			  name: Ast.Con.t} vector)
-		    -> Scheme.t vector
-		    -> TypeStr.Cons.t)
+                          name: Ast.Con.t} vector)
+                    -> Scheme.t vector
+                    -> TypeStr.Cons.t)
       val newTycon:
-	 string * Tycon.Kind.t * AdmitsEquality.t * Region.t -> Tycon.t
+         string * Tycon.Kind.t * AdmitsEquality.t * Region.t -> Tycon.t
       (* openStructure (E, S) opens S in the environment E. *) 
       val openStructure: t * Structure.t -> unit
       (* openBasis (E, B) opens B in the environment E. *) 
       val openBasis: t * Basis.t -> unit
       val peekFix: t * Ast.Vid.t -> Ast.Fixity.t option
       val peekLongcon:
-	 t * Ast.Longcon.t -> (CoreML.Con.t * Scheme.t option) option
+         t * Ast.Longcon.t -> (CoreML.Con.t * Scheme.t option) option
       val peekLongtycon: t * Ast.Longtycon.t -> TypeStr.t option
       val processDefUse: t -> unit
       (* scope f evaluates f () in a new scope so that extensions that occur

Modified: mlton/branches/on-20050420-cmm-branch/mlton/elaborate/elaborate-mlbs.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/elaborate/elaborate-mlbs.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/elaborate/elaborate-mlbs.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,9 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 functor ElaborateMLBs (S: ELABORATE_MLBS_STRUCTS): ELABORATE_MLBS = 
@@ -24,15 +24,15 @@
       then ()
    else
       let
-	 open Layout
+         open Layout
       in
-	 Control.error 
-	 (region,
-	  str (concat (if ElabControl.expert c
-			  then [keyword, " disallowed"]
-			  else [keyword, " disallowed, compile with -default-ann '", 
-				ElabControl.name c, " true'"])),
-	  empty)
+         Control.error 
+         (region,
+          str (concat (if ElabControl.expert c
+                          then [keyword, " disallowed"]
+                          else [keyword, " disallowed, compile with -default-ann '", 
+                                ElabControl.name c, " true'"])),
+          empty)
       end
 
 local
@@ -51,9 +51,9 @@
 end
 
 structure ElaboratePrograms = ElaboratePrograms (structure Ast = Ast
-						 structure CoreML = CoreML
-						 structure Decs = Decs
-						 structure Env = Env)
+                                                 structure CoreML = CoreML
+                                                 structure Decs = Decs
+                                                 structure Env = Env)
 
 local
    open ElaboratePrograms
@@ -68,175 +68,201 @@
 
       val E = Env.empty ()
       fun withDef f =
-	 ElabControl.withDef 
-	 (fn () =>
-	  if ElabControl.default ElabControl.forceUsed
-	     then Env.forceUsedLocal (E, f)
-	     else f ())
+         ElabControl.withDef 
+         (fn () =>
+          if ElabControl.default ElabControl.forceUsed
+             then Env.forceUsedLocal (E, f)
+             else f ())
 
       val emptySnapshot : (unit -> Env.Basis.t) -> Env.Basis.t = 
-	 Env.snapshot E
+         Env.snapshot E
       val emptySnapshot = fn (f: unit -> Env.Basis.t) =>
-	 emptySnapshot (fn () => withDef f)
-	 
+         emptySnapshot (fn () => withDef f)
+         
       val primBasis =
-	 emptySnapshot
-	 (fn () =>
-	  (#2 o Env.makeBasis)
-	  (E, fn () =>
-	   let val primDecs = addPrim E
-	   in Buffer.add (decs, (primDecs, false))
-	   end))
+         emptySnapshot
+         (fn () =>
+          (#2 o Env.makeBasis)
+          (E, fn () =>
+           let val primDecs = addPrim E
+           in Buffer.add (decs, (primDecs, false))
+           end))
 
       fun elabProg p = ElaboratePrograms.elaborateProgram (p, {env = E})
 
       val psi : (File.t * Env.Basis.t Promise.t) HashSet.t =
-	 HashSet.new {hash = String.hash o #1}
+         HashSet.new {hash = String.hash o #1}
 
-      val elabBasexpInfo = Trace.info "elabBasexp"
-      val elabBasdecInfo = Trace.info "elabBasdec"
+      val elabBasexpInfo = Trace.info "ElaborateMLBs.elabBasexp"
+      val elabBasdecInfo = Trace.info "ElaborateMLBs.elabBasdec"
 
       fun elabBasexp (basexp: Basexp.t) : Env.Basis.t option =
-	 Trace.traceInfo' (elabBasexpInfo,
-			   Basexp.layout,
-			   Layout.ignore)
-	 (fn (basexp: Basexp.t) =>
-	  case Basexp.node basexp of
-	     Basexp.Bas basdec => 
-		let
-		   val ((), B) =
-		      Env.makeBasis (E, fn () => elabBasdec basdec)
-		in
-		   SOME B
-		end
-	   | Basexp.Var basid => Env.lookupBasid (E, basid)
-	   | Basexp.Let (basdec, basexp) => 
-		Env.scopeAll
-		(E, fn () =>
-		 (elabBasdec basdec
-		  ; elabBasexp basexp))) basexp
+         Trace.traceInfo' (elabBasexpInfo,
+                           Basexp.layout,
+                           Layout.ignore)
+         (fn (basexp: Basexp.t) =>
+          case Basexp.node basexp of
+             Basexp.Bas basdec => 
+                let
+                   val ((), B) =
+                      Env.makeBasis (E, fn () => elabBasdec basdec)
+                in
+                   SOME B
+                end
+           | Basexp.Var basid => Env.lookupBasid (E, basid)
+           | Basexp.Let (basdec, basexp) => 
+                Env.scopeAll
+                (E, fn () =>
+                 (elabBasdec basdec
+                  ; elabBasexp basexp))) basexp
       and elabBasdec (basdec: Basdec.t) : unit =
-	 Trace.traceInfo' (elabBasdecInfo,
-			   Basdec.layout,
-			   Layout.ignore)
-	 (fn (basdec: Basdec.t) =>
-	  case Basdec.node basdec of
-	     Basdec.Defs def =>
-		let
-		   fun doit (lookup, extend, bnds) =
-		      Vector.foreach
-		      (Vector.map (bnds, fn {lhs, rhs} =>
-				   {lhs = lhs, rhs = lookup (E, rhs)}), 
-		       fn {lhs, rhs} =>
-		       Option.app (rhs, fn z => extend (E, lhs, z)))
-		in
-		   case ModIdBind.node def of
-		      ModIdBind.Fct bnds => 
-			 doit (Env.lookupFctid, Env.extendFctid, bnds)
-		    | ModIdBind.Sig bnds => 
-			 doit (Env.lookupSigid, Env.extendSigid, bnds)
-		    | ModIdBind.Str bnds => 
-			 doit (Env.lookupStrid, Env.extendStrid, bnds)
-		end
-	   | Basdec.Basis basbinds => 
-		let
-		   val basbinds =
-		      Vector.map
-		      (basbinds, fn {name, def} =>
-		       let val B = elabBasexp def
-		       in {B = B, name = name}
-		       end)
-		in
-		   Vector.foreach
-		   (basbinds, fn {name, B, ...} =>
-		    Option.app (B, fn B => Env.extendBasid (E, name, B)))
-		end
-	   | Basdec.Local (basdec1, basdec2) =>
-		Env.localAll (E, fn () => 
-			      elabBasdec basdec1, fn () => 
-			      elabBasdec basdec2)
-	   | Basdec.Seq basdecs =>
-		List.foreach(basdecs, elabBasdec)
-	   | Basdec.Open basids => 
-		Vector.foreach
-		(Vector.map (basids, fn basid => 
-			     Env.lookupBasid (E, basid)), fn bo => 
-		 Option.app (bo, fn b => Env.openBasis (E, b)))
-	   | Basdec.Prog (_, prog) =>
-		let
-		   val prog = Promise.force prog
-		in
-		   Buffer.add (decs, (Decs.toList (elabProg prog), deadCode ()))
-		end
-	   | Basdec.MLB ({fileAbs, ...}, basdec) =>
-		let
-		   val (_, B) =
-		      HashSet.lookupOrInsert
-		      (psi, String.hash fileAbs, fn (fileAbs', _) => 
-		       String.equals (fileAbs, fileAbs'), fn () =>
-		       let
-			  val basdec = Promise.force basdec
-			  val B =
-			     Promise.delay
-			     (fn () =>
-			      emptySnapshot
-			      (fn () =>
-			       (#2 o Env.makeBasis) 
-			       (E, fn () => elabBasdec basdec)))
-		       in
-			  (fileAbs, B)
-		       end)
-		   val B = Promise.force B
-		in
-		   Env.openBasis (E, B)
-		end
-	   | Basdec.Prim => 
-		(check (ElabControl.allowPrim, "_prim", Basdec.region basdec)
-		 ; Env.openBasis (E, primBasis))
-	   | Basdec.Ann (ann, reg, basdec) =>
-		let
-		   open ElabControl
-		   fun warn () =
-		      if !Control.warnAnn
-			 then let open Layout
-			      in
-				 Control.warning
-				 (reg, seq [str "unrecognized annotation: ", str ann],
-				  empty)
-			      end
-			 else ()
-		in
-		   case parseIdAndArgs ann of
-		      NONE => (warn ()
-			       ; elabBasdec basdec)
-		    | SOME (id, args) =>
-			 let
-			    val restore = Args.processAnn args
-			 in
-			    DynamicWind.wind
-			    (fn () =>
-			     if equalsId (forceUsed, id) andalso enabled forceUsed
-				then Env.forceUsedLocal (E, fn () => elabBasdec basdec)
-			     else if equalsId (ffiStr, id)
-				then let
-					val ffi = valOf (current ffiStr)
-					val ffi = 
-					   Longstrid.fromSymbols 
-					   (List.map (String.split (ffi, #"."), 
-						      Longstrid.Symbol.fromString), 
-					    reg)
-				     in
-					elabBasdec basdec
-					before
-					Option.app
-					(Env.lookupLongstrid (E, ffi), 
-					 fn S => (Env.Structure.ffi := SOME S
-						  ; Env.Structure.forceUsed S))
-				     end
-			     else elabBasdec basdec, 
-			     restore)
-			 end
-		end) basdec
+         Trace.traceInfo' (elabBasdecInfo,
+                           Basdec.layout,
+                           Layout.ignore)
+         (fn (basdec: Basdec.t) =>
+          case Basdec.node basdec of
+             Basdec.Defs def =>
+                let
+                   fun doit (lookup, extend, bnds) =
+                      Vector.foreach
+                      (Vector.map (bnds, fn {lhs, rhs} =>
+                                   {lhs = lhs, rhs = lookup (E, rhs)}), 
+                       fn {lhs, rhs} =>
+                       Option.app (rhs, fn z => extend (E, lhs, z)))
+                in
+                   case ModIdBind.node def of
+                      ModIdBind.Fct bnds => 
+                         doit (Env.lookupFctid, Env.extendFctid, bnds)
+                    | ModIdBind.Sig bnds => 
+                         doit (Env.lookupSigid, Env.extendSigid, bnds)
+                    | ModIdBind.Str bnds => 
+                         doit (Env.lookupStrid, Env.extendStrid, bnds)
+                end
+           | Basdec.Basis basbinds => 
+                let
+                   val basbinds =
+                      Vector.map
+                      (basbinds, fn {name, def} =>
+                       let val B = elabBasexp def
+                       in {B = B, name = name}
+                       end)
+                in
+                   Vector.foreach
+                   (basbinds, fn {name, B, ...} =>
+                    Option.app (B, fn B => Env.extendBasid (E, name, B)))
+                end
+           | Basdec.Local (basdec1, basdec2) =>
+                Env.localAll (E, fn () => 
+                              elabBasdec basdec1, fn () => 
+                              elabBasdec basdec2)
+           | Basdec.Seq basdecs =>
+                List.foreach(basdecs, elabBasdec)
+           | Basdec.Open basids => 
+                Vector.foreach
+                (Vector.map (basids, fn basid => 
+                             Env.lookupBasid (E, basid)), fn bo => 
+                 Option.app (bo, fn b => Env.openBasis (E, b)))
+           | Basdec.Prog (_, prog) =>
+                let
+                   val prog = Promise.force prog
+                in
+                   Buffer.add (decs, (Decs.toList (elabProg prog), deadCode ()))
+                end
+           | Basdec.MLB ({fileAbs, ...}, basdec) =>
+                let
+                   val (_, B) =
+                      HashSet.lookupOrInsert
+                      (psi, String.hash fileAbs, fn (fileAbs', _) => 
+                       String.equals (fileAbs, fileAbs'), fn () =>
+                       let
+                          val basdec = Promise.force basdec
+                          val B =
+                             Promise.delay
+                             (fn () =>
+                              emptySnapshot
+                              (fn () =>
+                               (#2 o Env.makeBasis) 
+                               (E, fn () => elabBasdec basdec)))
+                       in
+                          (fileAbs, B)
+                       end)
+                   val B = Promise.force B
+                           handle Promise.Force =>
+                           (* Basis forms a cycle; 
+                            * force the AST to generate error message.
+                            *)
+                           (ignore (Promise.force basdec)
+                            ; #2 (Env.makeBasis (E, fn () => ())))
+                in
+                   Env.openBasis (E, B)
+                end
+           | Basdec.Prim => 
+                (check (ElabControl.allowPrim, "_prim", Basdec.region basdec)
+                 ; Env.openBasis (E, primBasis))
+           | Basdec.Ann (ann, reg, basdec) =>
+                let
+                   open ElabControl
+                   fun warn () =
+                      if !Control.warnAnn
+                         then let open Layout
+                              in
+                                 Control.warning
+                                 (reg, seq [str "unrecognized annotation: ", str ann],
+                                  empty)
+                              end
+                         else ()
+                in
+                   case parseIdAndArgs ann of
+                      Control.Elaborate.Bad => 
+                         (warn ()
+                          ; elabBasdec basdec)
+                    | Control.Elaborate.Deprecated alts =>
+                         let
+                            val (ids, args) = List.unzip alts
+                            val () =
+                               let open Layout
+                               in
+                                  Control.warning
+                                  (reg, seq [str "deprecated annotation: ", str ann, str ", use ",
+                                             List.layout (str o Control.Elaborate.Id.name) ids],
+                                   empty)
+                               end
+                            val restores =
+                               List.map (args, Args.processAnn)
+                         in
+                            Exn.finally
+                            (fn () => elabBasdec basdec,
+                             fn () => List.foreach (List.rev restores, fn restore => restore ()))
+                         end
+                    | Control.Elaborate.Good (id, args) =>
+                         let
+                            val restore = Args.processAnn args
+                         in
+                            Exn.finally
+                            (fn () =>
+                             if equalsId (forceUsed, id) andalso enabled forceUsed
+                                then Env.forceUsedLocal (E, fn () => elabBasdec basdec)
+                             else if equalsId (ffiStr, id)
+                                then let
+                                        val ffi = valOf (current ffiStr)
+                                        val ffi = 
+                                           Longstrid.fromSymbols 
+                                           (List.map (String.split (ffi, #"."), 
+                                                      Longstrid.Symbol.fromString), 
+                                            reg)
+                                     in
+                                        elabBasdec basdec
+                                        before
+                                        Option.app
+                                        (Env.lookupLongstrid (E, ffi), 
+                                         fn S => (Env.Structure.ffi := SOME S
+                                                  ; Env.Structure.forceUsed S))
+                                     end
+                             else elabBasdec basdec, 
+                             restore)
+                         end
+                    | Other => elabBasdec basdec
+                end) basdec
       val _ = withDef (fn () => elabBasdec mlb)
    in
       (E, Buffer.toVector decs)

Modified: mlton/branches/on-20050420-cmm-branch/mlton/elaborate/elaborate-mlbs.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/elaborate/elaborate-mlbs.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/elaborate/elaborate-mlbs.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature ELABORATE_MLBS_STRUCTS = 
    sig
       structure Ast: AST
@@ -22,6 +23,6 @@
       include ELABORATE_MLBS_STRUCTS
 
       val elaborateMLB:
-	 Ast.Basdec.t * {addPrim: Env.t -> CoreML.Dec.t list}
-	 -> Env.t * (CoreML.Dec.t list * bool) vector
+         Ast.Basdec.t * {addPrim: Env.t -> CoreML.Dec.t list}
+         -> Env.t * (CoreML.Dec.t list * bool) vector
     end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/elaborate/elaborate-modules.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/elaborate/elaborate-modules.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/elaborate/elaborate-modules.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,22 +1,17 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 functor ElaborateModules (S: ELABORATE_MODULES_STRUCTS): ELABORATE_MODULES = 
 struct
 
 open S
 
 local
-   open Control.Elaborate
-in
-   val allowPrim = fn () => current allowPrim
-end
-
-local
    open Ast
 in
    structure FctArg = FctArg
@@ -40,244 +35,245 @@
 end
 
 structure ElaborateSigexp = ElaborateSigexp (structure Ast = Ast
-					     structure Env = Env)
+                                             structure Env = Env)
 
 structure ElaborateCore = ElaborateCore (structure Ast = Ast
-					 structure CoreML = CoreML
-					 structure Decs = Decs
-					 structure Env = Env)
+                                         structure CoreML = CoreML
+                                         structure Decs = Decs
+                                         structure Env = Env)
 
-val elabStrdecInfo = Trace.info "elabStrdec"
-val elabStrexpInfo = Trace.info "elabStrexp"
-val elabTopdecInfo = Trace.info "elabTopdec"
+val elabStrdecInfo = Trace.info "ElaborateModules.elabStrdec"
+val elabStrexpInfo = Trace.info "ElaborateModules.elabStrexp"
+val elabTopdecInfo = Trace.info "ElaborateModules.elabTopdec"
 
 fun elaborateTopdec (topdec, {env = E: Env.t}) =
    let
       fun elabSigexp s = ElaborateSigexp.elaborateSigexp (s, {env = E})
       fun elabSigexpConstraint (cons: SigConst.t,
-				S: Structure.t option,
-				nest: string list)
-	 : Decs.t * Structure.t option =
-	 let
-	    fun s (sigexp, opaque) =
-	       let
-		  val prefix =
-		     case nest of
-			[] => ""
-		      | _ => concat (List.fold (nest, [], fn (s, ac) =>
-						s :: "." :: ac))
-	       in
-		  case S of
-		     NONE => (Decs.empty, NONE)
-		   | SOME S => 
-			let
-			   val (S, decs) =
-			      case elabSigexp sigexp of
-				 NONE => (S, Decs.empty)
-			       | SOME I => 
-				    Env.cut (E, S, I,
-					     {isFunctor = false,
-					      opaque = opaque,
-					      prefix = prefix},
-					     Sigexp.region sigexp)
-			in
-			   (decs, SOME S)
-			end
-	       end
-	 in
-	    case cons of
-	       SigConst.None => (Decs.empty, S)
-	     | SigConst.Opaque sigexp => s (sigexp, true)
-	     | SigConst.Transparent sigexp => s (sigexp, false)
-	 end	 
+                                S: Structure.t option,
+                                nest: string list)
+         : Decs.t * Structure.t option =
+         let
+            fun s (sigexp, opaque) =
+               let
+                  val prefix =
+                     case nest of
+                        [] => ""
+                      | _ => concat (List.fold (nest, [], fn (s, ac) =>
+                                                s :: "." :: ac))
+               in
+                  case S of
+                     NONE => (Decs.empty, NONE)
+                   | SOME S => 
+                        let
+                           val (S, decs) =
+                              case elabSigexp sigexp of
+                                 NONE => (S, Decs.empty)
+                               | SOME I => 
+                                    Env.cut (E, S, I,
+                                             {isFunctor = false,
+                                              opaque = opaque,
+                                              prefix = prefix},
+                                             Sigexp.region sigexp)
+                        in
+                           (decs, SOME S)
+                        end
+               end
+         in
+            case cons of
+               SigConst.None => (Decs.empty, S)
+             | SigConst.Opaque sigexp => s (sigexp, true)
+             | SigConst.Transparent sigexp => s (sigexp, false)
+         end     
       fun elabStrdec (arg: Strdec.t * string list): Decs.t =
-	 Trace.traceInfo' (elabStrdecInfo,
-			   Layout.tuple2 (Strdec.layout,
-					  List.layout String.layout),
-			   Decs.layout)
-	 (fn (d: Strdec.t, nest: string list) =>
-	  let
-	     val d = Strdec.coalesce d
-	     val elabStrdec = fn d => elabStrdec (d, nest)
-	  in
-	     case Strdec.node d of
-		Strdec.Core d => (* rule 56 *)
-		   ElaborateCore.elaborateDec
-		   (d, {env = E, nest = nest})
-	      | Strdec.Local (d, d') => (* rule 58 *)
-		   Env.localModule (E,
-				    fn () => elabStrdec d,
-				    fn d => Decs.append (d, elabStrdec d'))
-	      | Strdec.Seq ds => (* rule 60 *)
-		   List.fold
-		   (ds, Decs.empty, fn (d, decs) =>
-		    Decs.append (decs, elabStrdec d))
-	      | Strdec.Structure strbinds => (* rules 57, 61 *)
-		   let
-		      val strbinds =
-			 Vector.map
-			 (strbinds, fn {name, def, constraint} =>
-			  let
-			     val nest = Strid.toString name :: nest
-			     val (decs', S) = elabStrexp (def, nest)
-			     val (decs'', S) =
-				elabSigexpConstraint (constraint, S, nest)
-			  in
-			     {decs = Decs.append (decs', decs''),
-			      name = name,
-			      S = S}
-			  end)
-		      val () =
-			 Vector.foreach
-			 (strbinds, fn {name, S, ...} =>
-			  Option.app (S, fn S => Env.extendStrid (E, name, S)))
-		    in
-		       Decs.appendsV (Vector.map (strbinds, #decs))
-		    end
-	  end) arg
+         Trace.traceInfo' (elabStrdecInfo,
+                           Layout.tuple2 (Strdec.layout,
+                                          List.layout String.layout),
+                           Decs.layout)
+         (fn (d: Strdec.t, nest: string list) =>
+          let
+             val d = Strdec.coalesce d
+             val elabStrdec = fn d => elabStrdec (d, nest)
+          in
+             case Strdec.node d of
+                Strdec.Core d => (* rule 56 *)
+                   ElaborateCore.elaborateDec
+                   (d, {env = E, nest = nest})
+              | Strdec.Local (d, d') => (* rule 58 *)
+                   Env.localModule (E,
+                                    fn () => elabStrdec d,
+                                    fn d => Decs.append (d, elabStrdec d'))
+              | Strdec.Seq ds => (* rule 60 *)
+                   List.fold
+                   (ds, Decs.empty, fn (d, decs) =>
+                    Decs.append (decs, elabStrdec d))
+              | Strdec.Structure strbinds => (* rules 57, 61 *)
+                   let
+                      val strbinds =
+                         Vector.map
+                         (strbinds, fn {name, def, constraint} =>
+                          let
+                             val nest = Strid.toString name :: nest
+                             val (decs', S) = elabStrexp (def, nest)
+                             val (decs'', S) =
+                                elabSigexpConstraint (constraint, S, nest)
+                          in
+                             {decs = Decs.append (decs', decs''),
+                              name = name,
+                              S = S}
+                          end)
+                      val () =
+                         Vector.foreach
+                         (strbinds, fn {name, S, ...} =>
+                          Option.app (S, fn S => Env.extendStrid (E, name, S)))
+                    in
+                       Decs.appendsV (Vector.map (strbinds, #decs))
+                    end
+          end) arg
       and elabStrexp (arg: Strexp.t * string list): Decs.t * Structure.t option =
-	 Trace.traceInfo' (elabStrexpInfo,
-			   Layout.tuple2 (Strexp.layout,
-					  List.layout String.layout),
-			   Layout.tuple2 (Decs.layout,
-					  Option.layout Structure.layout))
-	 (fn (e: Strexp.t, nest: string list) =>
-	  let
-	     val elabStrexp = fn e => elabStrexp (e, nest)
-	  in
-	     case Strexp.node e of
-		Strexp.App (fctid, strexp) => (* rules 54, 154 *)
-		   let
-		      val (decs, S) = elabStrexp strexp
-		   in
-		      case S of
-			 NONE => (decs, NONE)
-		       | SOME S =>
-			    case Env.lookupFctid (E, fctid) of
-			       NONE => (decs, NONE)
-			     | SOME fct  =>
-				  let
-				     val (S, decs') =
-					Env.cut
-					(E, S,
-					 FunctorClosure.argInterface fct,
-					 {isFunctor = true,
-					  opaque = false,
-					  prefix = ""},
-					 Strexp.region strexp)
-				     val (decs'', S) =
-					FunctorClosure.apply
-					(fct, S, [Fctid.toString fctid])
-				  in
-				     (Decs.appends [decs, decs', decs''], S)
-				  end
-		   end
-	      | Strexp.Constrained (e, c) => (* rules 52, 53 *)
-		   let
-		      val (decs, S) = elabStrexp e
-		      val (decs', S) = elabSigexpConstraint (c, S, nest)
-		   in
-		      (Decs.append (decs, decs'), S)
-		   end
-	      | Strexp.Let (d, e) => (* rule 55 *)
-		   Env.scope
-		   (E, fn () =>
-		    let
-		       val decs = elabStrdec (d, nest)
-		       val (decs', S) = elabStrexp e
-		    in
-		       (Decs.append (decs, decs'), S)
-		    end)
-	      | Strexp.Struct d => (* rule 50 *)
-		   let
-		      val (decs, S) =
-			 Env.makeStructure (E, fn () => elabStrdec (d, nest))
-		   in
-		      (decs, SOME S)
-		   end
-	      | Strexp.Var p => (* rule 51 *)
-		   (Decs.empty, Env.lookupLongstrid (E, p))
-	  end) arg
+         Trace.traceInfo' (elabStrexpInfo,
+                           Layout.tuple2 (Strexp.layout,
+                                          List.layout String.layout),
+                           Layout.tuple2 (Decs.layout,
+                                          Option.layout Structure.layout))
+         (fn (e: Strexp.t, nest: string list) =>
+          let
+             val elabStrexp = fn e => elabStrexp (e, nest)
+          in
+             case Strexp.node e of
+                Strexp.App (fctid, strexp) => (* rules 54, 154 *)
+                   let
+                      val (decs, S) = elabStrexp strexp
+                   in
+                      case S of
+                         NONE => (decs, NONE)
+                       | SOME S =>
+                            case Env.lookupFctid (E, fctid) of
+                               NONE => (decs, NONE)
+                             | SOME fct  =>
+                                  let
+                                     val (S, decs') =
+                                        Env.cut
+                                        (E, S,
+                                         FunctorClosure.argInterface fct,
+                                         {isFunctor = true,
+                                          opaque = false,
+                                          prefix = ""},
+                                         Strexp.region strexp)
+                                     val (decs'', S) =
+                                        FunctorClosure.apply
+                                        (fct, S, [Fctid.toString fctid])
+                                  in
+                                     (Decs.appends [decs, decs', decs''], S)
+                                  end
+                   end
+              | Strexp.Constrained (e, c) => (* rules 52, 53 *)
+                   let
+                      val (decs, S) = elabStrexp e
+                      val (decs', S) = elabSigexpConstraint (c, S, nest)
+                   in
+                      (Decs.append (decs, decs'), S)
+                   end
+              | Strexp.Let (d, e) => (* rule 55 *)
+                   Env.scope
+                   (E, fn () =>
+                    let
+                       val decs = elabStrdec (d, nest)
+                       val (decs', S) = elabStrexp e
+                    in
+                       (Decs.append (decs, decs'), S)
+                    end)
+              | Strexp.Struct d => (* rule 50 *)
+                   let
+                      val (decs, S) =
+                         Env.makeStructure (E, fn () => elabStrdec (d, nest))
+                   in
+                      (decs, SOME S)
+                   end
+              | Strexp.Var p => (* rule 51 *)
+                   (Decs.empty, Env.lookupLongstrid (E, p))
+          end) arg
       fun elabFunctor {arg, result, body}: FunctorClosure.t option =
-	 let
-	    val body = Strexp.constrained (body, result)
-	    val (arg, argSig, body, prefix) =
-	       case FctArg.node arg of
-		  FctArg.Structure (arg, argSig) =>
-		     (arg, argSig, body, concat [Strid.toString arg, "."])
-		| FctArg.Spec spec =>
-		     let
-			val strid =
-			   Strid.fromSymbol (Symbol.fromString "ZZZNewStridZZZ",
-					     Region.bogus)
-		     in
-			(strid,
-			 Sigexp.spec spec,
-			 Strexp.lett (Strdec.openn (Vector.new1
-						    (Longstrid.short strid)),
-				      body),
-			 "")
-		     end
-	 in
-	    Option.map (elabSigexp argSig, fn argInt =>
-			Env.functorClosure
-			(E, prefix, argInt,
-			 fn (formal, nest) =>
-			 Env.scope (E, fn () =>
-				    (Env.extendStrid (E, arg, formal)
-				     ; elabStrexp (body, nest)))))
-	 end
+         let
+            val body = Strexp.constrained (body, result)
+            val (arg, argSig, body, prefix) =
+               case FctArg.node arg of
+                  FctArg.Structure (arg, argSig) =>
+                     (arg, argSig, body, concat [Strid.toString arg, "."])
+                | FctArg.Spec spec =>
+                     let
+                        val strid =
+                           Strid.fromSymbol (Symbol.fromString "ZZZNewStridZZZ",
+                                             Region.bogus)
+                     in
+                        (strid,
+                         Sigexp.spec spec,
+                         Strexp.lett (Strdec.openn (Vector.new1
+                                                    (Longstrid.short strid)),
+                                      body),
+                         "")
+                     end
+         in
+            Option.map (elabSigexp argSig, fn argInt =>
+                        Env.functorClosure
+                        (E, prefix, argInt,
+                         fn (formal, nest) =>
+                         Env.scope (E, fn () =>
+                                    (Env.extendStrid (E, arg, formal)
+                                     ; elabStrexp (body, nest)))))
+         end
       fun elabTopdec arg: Decs.t =
-	 Trace.traceInfo' (elabTopdecInfo, 
-			   Topdec.layout, 
-			   Decs.layout)
-	 (fn (d: Topdec.t) =>
-	  case Topdec.node d of
-	     Topdec.Signature sigbinds =>
-		let
-		   val sigbinds =
-		      Vector.map
-		      (sigbinds, fn (sigid, sigexp) =>
-		       (sigid, elabSigexp sigexp))
-		   val () =
-		      Vector.foreach
-		      (sigbinds, fn (sigid, I) =>
-		       Option.app (I, fn I => Env.extendSigid (E, sigid, I)))
-		in
-		   Decs.empty
-		end
-	   | Topdec.Strdec d => elabStrdec (d, [])
-	   | Topdec.Functor funbinds =>
-		(* Rules 85, 86. Appendix A, p.58 *)
-		let
-		   val funbinds =
-		      Vector.map
-		      (funbinds, fn {arg, body, name, result} =>
-		       {closure = elabFunctor {arg = arg,
-					       body = body,
-					       result = result},
-			name = name})
-		   val () =
-		      Vector.foreach (funbinds, fn {closure, name} =>
-				      Option.app
-				      (closure, fn closure =>
-				       Env.extendFctid (E, name, closure)))
-		   (* Check for errors here so that we don't report duplicate
-		    * errors when re-elaborating the functor body.
-		    *)
-		   val () = Control.checkForErrors "elaborate"
-		in
-		   Decs.empty
-		end
-		) arg
+         Trace.traceInfo' (elabTopdecInfo, 
+                           Topdec.layout, 
+                           Decs.layout)
+         (fn (d: Topdec.t) =>
+          case Topdec.node d of
+             Topdec.Signature sigbinds =>
+                let
+                   val sigbinds =
+                      Vector.map
+                      (sigbinds, fn (sigid, sigexp) =>
+                       (sigid, elabSigexp sigexp))
+                   val () =
+                      Vector.foreach
+                      (sigbinds, fn (sigid, I) =>
+                       Option.app (I, fn I => Env.extendSigid (E, sigid, I)))
+                in
+                   Decs.empty
+                end
+           | Topdec.Strdec d => elabStrdec (d, [])
+           | Topdec.Functor funbinds =>
+                (* Rules 85, 86. Appendix A, p.58 *)
+                let
+                   val funbinds =
+                      Vector.map
+                      (funbinds, fn {arg, body, name, result} =>
+                       {closure = elabFunctor {arg = arg,
+                                               body = body,
+                                               result = result},
+                        name = name})
+                   val () =
+                      Vector.foreach (funbinds, fn {closure, name} =>
+                                      Option.app
+                                      (closure, fn closure =>
+                                       Env.extendFctid (E, name, closure)))
+                   (* Check for errors here so that we don't report duplicate
+                    * errors when re-elaborating the functor body.
+                    *)
+                   val () = Control.checkForErrors "elaborate"
+                in
+                   Decs.empty
+                end
+                ) arg
       val elabTopdec =
-	 fn d =>
-	 let
-	    val res = elabTopdec d
-	    val _ = ElaborateCore.reportUndeterminedTypes ()
-	 in
-	    res
-	 end
+         fn d =>
+         let
+            val res = elabTopdec d
+            val _ = ElaborateCore.reportUndeterminedTypes ()
+            val _ = ElaborateCore.reportSequenceNonUnit ()
+         in
+            res
+         end
    in
       elabTopdec topdec
    end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/elaborate/elaborate-modules.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/elaborate/elaborate-modules.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/elaborate/elaborate-modules.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature ELABORATE_MODULES_STRUCTS = 
    sig
       structure Ast: AST

Modified: mlton/branches/on-20050420-cmm-branch/mlton/elaborate/elaborate-programs.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/elaborate/elaborate-programs.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/elaborate/elaborate-programs.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,19 +1,20 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 functor ElaboratePrograms (S: ELABORATE_PROGRAMS_STRUCTS): ELABORATE_PROGRAMS = 
 struct
 
 open S
 
 structure ElaborateModules = ElaborateModules (structure Ast = Ast
-					       structure CoreML = CoreML
-					       structure Decs = Decs
-					       structure Env = Env)
+                                               structure CoreML = CoreML
+                                               structure Decs = Decs
+                                               structure Env = Env)
 
 fun elaborateProgram (program, {env = E: Env.t}) =
    let
@@ -21,8 +22,8 @@
       fun elabTopdec d = ElaborateModules.elaborateTopdec (d, {env = E})
    in
       List.fold (decs, Decs.empty, fn (ds, decs) =>
-		 List.fold (ds, decs, fn (d, decs) =>
-			    Decs.append (decs, elabTopdec d)))
+                 List.fold (ds, decs, fn (d, decs) =>
+                            Decs.append (decs, elabTopdec d)))
    end
 
 end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/elaborate/elaborate-programs.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/elaborate/elaborate-programs.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/elaborate/elaborate-programs.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature ELABORATE_PROGRAMS_STRUCTS = 
    sig
       structure Ast: AST

Modified: mlton/branches/on-20050420-cmm-branch/mlton/elaborate/elaborate-sigexp.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/elaborate/elaborate-sigexp.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/elaborate/elaborate-sigexp.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 functor ElaborateSigexp (S: ELABORATE_SIGEXP_STRUCTS): ELABORATE_SIGEXP = 
 struct
 
@@ -52,120 +53,129 @@
    let
       val tyvars = ref []
       fun loop (ty: Atype.t): Type.t =
-	 case Atype.node ty of
-	    Atype.Var a => (* rule 44 *)
-	       Type.var
-	       (case List.peek (!tyvars, fn a' => Tyvar.sameName (a, a')) of
-		   NONE => (List.push (tyvars, a); a)
-		 | SOME a => a)
-	  | Atype.Con (c, ts) => (* rules 46, 47 *)
-	       let
-		  val ts = Vector.map (ts, loop)
-		  fun normal () =
-		     case Env.lookupLongtycon (E, c) of
-			NONE => Type.bogus
-		      | SOME s => 
-			   let
-			      val kind = TypeStr.kind s
-			      val numArgs = Vector.length ts
-			   in
-			      if (case kind of
-				     Kind.Arity n => n = numArgs
-				   | Kind.Nary => true)
-				 then TypeStr.apply (s, ts)
-			      else
-				 let
-				    open Layout
-				    val () = 
-				       Control.error
-				       (Atype.region ty,
-					seq [str "type constructor ",
-					     Ast.Longtycon.layout c,
-					     str " given ",
-					     Int.layout numArgs,
-					     str (if numArgs = 1
-						     then " argument"
-						  else " arguments"),
-					     str " but wants ",
-					     Kind.layout kind],
-					empty)
-				 in
-				    Type.bogus
-				 end
-			   end
-	       in
-		  case (Ast.Longtycon.split c, Vector.length ts) of
-		     (([], c), 2) =>
-			if Ast.Tycon.equals (c, Ast.Tycon.arrow)
-			   then Type.arrow (Vector.sub (ts, 0),
-					    Vector.sub (ts, 1))
-			else normal ()
-		   | _ => normal ()
-	       end
-	  | Atype.Record r => (* rules 45, 49 *)
-	       Type.record (SortedRecord.map (r, loop))
+         case Atype.node ty of
+            Atype.Var a => (* rule 44 *)
+               Type.var
+               (case List.peek (!tyvars, fn a' => Tyvar.sameName (a, a')) of
+                   NONE => (List.push (tyvars, a); a)
+                 | SOME a => a)
+          | Atype.Con (c, ts) => (* rules 46, 47 *)
+               let
+                  val ts = Vector.map (ts, loop)
+                  fun normal () =
+                     case Env.lookupLongtycon (E, c) of
+                        NONE => Type.bogus
+                      | SOME s => 
+                           let
+                              val kind = TypeStr.kind s
+                              val numArgs = Vector.length ts
+                           in
+                              if (case kind of
+                                     Kind.Arity n => n = numArgs
+                                   | Kind.Nary => true)
+                                 then TypeStr.apply (s, ts)
+                              else
+                                 let
+                                    open Layout
+                                    val () = 
+                                       Control.error
+                                       (Atype.region ty,
+                                        seq [str "type constructor ",
+                                             Ast.Longtycon.layout c,
+                                             str " given ",
+                                             Int.layout numArgs,
+                                             str (if numArgs = 1
+                                                     then " argument"
+                                                  else " arguments"),
+                                             str " but wants ",
+                                             Kind.layout kind],
+                                        empty)
+                                 in
+                                    Type.bogus
+                                 end
+                           end
+               in
+                  case (Ast.Longtycon.split c, Vector.length ts) of
+                     (([], c), 2) =>
+                        if Ast.Tycon.equals (c, Ast.Tycon.arrow)
+                           then Type.arrow (Vector.sub (ts, 0),
+                                            Vector.sub (ts, 1))
+                        else normal ()
+                   | _ => normal ()
+               end
+          | Atype.Record r => (* rules 45, 49 *)
+               Type.record (SortedRecord.map (r, loop))
       val ty = loop ty
    in
       (Vector.fromList (!tyvars), ty)
    end
 
 val elaborateType =
-   Trace.trace ("elaborateType", Atype.layout o #1, Type.layout o #2)
+   Trace.trace ("ElaborateSigexp.elaborateType", Atype.layout o #1, Type.layout o #2)
    elaborateType
 
 fun elaborateScheme (tyvars: Tyvar.t vector, ty: Atype.t, E): Scheme.t =
    let
       val (tyvars', ty) = elaborateType (ty, E)
       val unbound =
-	 Vector.keepAll
-	 (tyvars', fn a =>
-	  not (Vector.exists (tyvars, fn a' => Tyvar.sameName (a, a'))))
-      val _ =
-	 if 0 = Vector.length unbound
-	    then ()
-	 else
-	    let
-	       open Layout
-	    in
-	       Control.error (Tyvar.region (Vector.sub (tyvars', 0)),
-			      seq [str (concat ["undefined type variable",
-						if Vector.length unbound > 1
-						   then "s"
-						else "",
-						": "]),
-				   seq (separate
-					(Vector.toListMap (unbound,
-							   Tyvar.layout),
-					 ", "))],
-			      empty)
-	    end
+         Vector.keepAll
+         (tyvars', fn a =>
+          not (Vector.exists (tyvars, fn a' => Tyvar.sameName (a, a'))))
+      val ty =
+         if 0 = Vector.length unbound then
+            ty
+         else
+            let
+               open Layout
+               val () =
+                  Control.error (Tyvar.region (Vector.sub (tyvars', 0)),
+                                 seq [str (concat ["undefined type variable",
+                                                   if Vector.length unbound > 1
+                                                      then "s"
+                                                   else "",
+                                                      ": "]),
+                                      seq (separate
+                                           (Vector.toListMap (unbound,
+                                                              Tyvar.layout),
+                                            ", "))],
+                                 empty)
+               fun var a =
+                  if Vector.exists (unbound, fn a' => Tyvar.equals (a, a')) then
+                     Type.bogus
+                  else
+                     Type.var a
+            in
+               Type.hom (ty, {con = Type.con,
+                              record = Type.record,
+                              var = var})
+            end
       (* Need to get the representatives that were chosen when elaborating the
        * type.
        *)
       val tyvars =
-	 Vector.map
-	 (tyvars, fn a =>
-	  case Vector.peek (tyvars', fn a' => Tyvar.sameName (a, a')) of
-	     NONE => a
-	   | SOME a' => a')
+         Vector.map
+         (tyvars, fn a =>
+          case Vector.peek (tyvars', fn a' => Tyvar.sameName (a, a')) of
+             NONE => a
+           | SOME a' => a')
    in
       Scheme.make (tyvars, ty)
    end
 
 fun elaborateTypedescs (typedescs: {tycon: Ast.Tycon.t,
-				    tyvars: Tyvar.t vector} vector,
-			{equality: bool},
-			E): unit =
+                                    tyvars: Tyvar.t vector} vector,
+                        {equality: bool},
+                        E): unit =
    Vector.foreach
    (typedescs, fn {tycon = name, tyvars} =>
     let
        val kind = Kind.Arity (Vector.length tyvars)
        val tycon = Tycon.make {hasCons = false, kind = kind}
        val _ =
-	  Tycon.admitsEquality tycon
-	  := (if equality
-		 then AdmitsEquality.Sometimes
-	      else AdmitsEquality.Never)
+          Tycon.admitsEquality tycon
+          := (if equality
+                 then AdmitsEquality.Sometimes
+              else AdmitsEquality.Never)
     in
        Env.extendTycon (E, name, TypeStr.tycon (tycon, kind))
     end)
@@ -178,83 +188,83 @@
        * types can be elaborated.
        *)
       val tycons =
-	 Vector.map
-	 (datatypes, fn {tycon = name, tyvars, ...} =>
-	  let
-	     val kind = Kind.Arity (Vector.length tyvars)
-	     val tycon = Tycon.make {hasCons = true, kind = kind}
-	     val _ =
-		Env.extendTycon (E, name, TypeStr.data (tycon, kind, Cons.empty))
-	  in
-	     tycon
-	  end)
+         Vector.map
+         (datatypes, fn {tycon = name, tyvars, ...} =>
+          let
+             val kind = Kind.Arity (Vector.length tyvars)
+             val tycon = Tycon.make {hasCons = true, kind = kind}
+             val _ =
+                Env.extendTycon (E, name, TypeStr.data (tycon, kind, Cons.empty))
+          in
+             tycon
+          end)
       fun elabAll (): unit =
-	 Vector.foreach2
-	 (tycons, datatypes, fn (tycon, {cons, tycon = astTycon, tyvars, ...}) =>
-	  let
-	     val resultType: Atype.t =
-		Atype.con (astTycon, Vector.map (tyvars, Atype.var))
-	     val (cons, conArgs) =
-		Vector.unzip
-		(Vector.map
-		 (cons, fn (name, arg) =>
-		  let
-		     val (makeArg, ty) =
-			case arg of
-			   NONE => (fn _ => NONE, resultType)
-			 | SOME t =>
-			      (fn s =>
-			       SOME (#1 (Type.deArrow (Scheme.ty s))),
-			       Atype.arrow (t, resultType))
-		     val scheme = elaborateScheme (tyvars, ty, E)
-		  in
-		     ({name = name,
-		       scheme = scheme},
-		      makeArg scheme)
-		  end))
-	     val _ =
-		let
-		   val r = Tycon.admitsEquality tycon
-		   datatype z = datatype AdmitsEquality.t
-		in
-		   case !r of
-		      Always => Error.bug "datatype Always"
-		    | Never => ()
-		    | Sometimes =>
-			 if Vector.forall
-			    (conArgs, fn arg =>
-			     case arg of
-				NONE => true
-			      | SOME ty =>
-				   Scheme.admitsEquality
-				   (Scheme.make (tyvars, ty)))
-			    then ()
-			 else (r := Never; change := true)
-		end
-	     val _ = Vector.foreach (cons, fn {name, scheme} =>
-				     Env.extendCon (E, name, scheme))
-	     val _ = Env.allowDuplicates := true
-	     val _ =
-		Env.extendTycon
-		(E, astTycon,
-		 TypeStr.data (tycon, Kind.Arity (Vector.length tyvars),
-			       Cons.T cons))
-	  in
-	     ()
-	  end) 
+         Vector.foreach2
+         (tycons, datatypes, fn (tycon, {cons, tycon = astTycon, tyvars, ...}) =>
+          let
+             val resultType: Atype.t =
+                Atype.con (astTycon, Vector.map (tyvars, Atype.var))
+             val (cons, conArgs) =
+                Vector.unzip
+                (Vector.map
+                 (cons, fn (name, arg) =>
+                  let
+                     val (makeArg, ty) =
+                        case arg of
+                           NONE => (fn _ => NONE, resultType)
+                         | SOME t =>
+                              (fn s =>
+                               SOME (#1 (Type.deArrow (Scheme.ty s))),
+                               Atype.arrow (t, resultType))
+                     val scheme = elaborateScheme (tyvars, ty, E)
+                  in
+                     ({name = name,
+                       scheme = scheme},
+                      makeArg scheme)
+                  end))
+             val _ =
+                let
+                   val r = Tycon.admitsEquality tycon
+                   datatype z = datatype AdmitsEquality.t
+                in
+                   case !r of
+                      Always => Error.bug "ElaborateSigexp.elaborateDatBind: Always"
+                    | Never => ()
+                    | Sometimes =>
+                         if Vector.forall
+                            (conArgs, fn arg =>
+                             case arg of
+                                NONE => true
+                              | SOME ty =>
+                                   Scheme.admitsEquality
+                                   (Scheme.make (tyvars, ty)))
+                            then ()
+                         else (r := Never; change := true)
+                end
+             val _ = Vector.foreach (cons, fn {name, scheme} =>
+                                     Env.extendCon (E, name, scheme))
+             val _ = Env.allowDuplicates := true
+             val _ =
+                Env.extendTycon
+                (E, astTycon,
+                 TypeStr.data (tycon, Kind.Arity (Vector.length tyvars),
+                               Cons.T cons))
+          in
+             ()
+          end) 
       (* We don't want to re-elaborate the datatypes if there has been a type
        * error, because that will cause duplicate error messages.
        *)
      val numErrors = !Control.numErrors
       (* Maximize equality. *)
       fun loop (): unit =
-	 let
-	    val _ = elabAll ()
-	 in
-	    if !change andalso numErrors = !Control.numErrors
-	       then (change := false; loop ())
-	    else ()
-	 end
+         let
+            val _ = elabAll ()
+         in
+            if !change andalso numErrors = !Control.numErrors
+               then (change := false; loop ())
+            else ()
+         end
       val _ = loop ()
       val _ = Env.allowDuplicates := false
    in
@@ -262,12 +272,12 @@
    end
 
 val traceElaborateSigexp =
-   Trace.trace2 ("elaborateSigexp",
-		 Sigexp.layout,
-		 fn {isTop} => Layout.record [("isTop", Bool.layout isTop)],
-		 Option.layout Interface.layout)
+   Trace.trace2 ("ElaborateSigexp.elaborateSigexp",
+                 Sigexp.layout,
+                 fn {isTop} => Layout.record [("isTop", Bool.layout isTop)],
+                 Option.layout Interface.layout)
    
-val info' = Trace.info "elaborateSpec"
+val info' = Trace.info "ElaborateSigexp.elaborateSpec"
  
 (* rule 65 *)
 fun elaborateSigexp (sigexp: Sigexp.t, {env = E: StructureEnv.t}): Interface.t option =
@@ -275,186 +285,186 @@
       val _ = Interface.renameTycons := (fn () => StructureEnv.setTyconNames E)
       val E = StructureEnv.makeInterfaceEnv E
       fun elaborateSigexp arg : Interface.t option =
-	 traceElaborateSigexp
-	 (fn (sigexp: Sigexp.t, {isTop}) =>
-	  case Sigexp.node sigexp of
-	     Sigexp.Spec spec =>
-		(* rule 62 *)
-		SOME (#1 (Env.makeInterface (E, {isTop = isTop},
-					     fn () => elaborateSpec spec)))
-	   | Sigexp.Var x =>
-		(* rule 63 *)
-		Option.map (Env.lookupSigid (E, x), Interface.copy)
-	   | Sigexp.Where (sigexp, wheres) =>
-		(* rule 64 *)
-		let
-		   val time = Interface.Time.tick ()
-		in
-		   Option.map
-		   (elaborateSigexp (sigexp, {isTop = false}), fn I =>
-		    let
-		       val _ = 
-			  Vector.foreach
-			  (wheres, fn {longtycon, ty, tyvars} =>
-			   Option.app
-			   (Interface.lookupLongtycon
-			    (I, longtycon, Longtycon.region longtycon,
-			     {prefix = []}),
-			    fn s =>
-			    TypeStr.wheree
-			    (s, Longtycon.region longtycon,
-			     fn () => Longtycon.layout longtycon,
-			     time,
-			     TypeStr.def (elaborateScheme (tyvars, ty, E),
-					  Kind.Arity (Vector.length tyvars)))))
-		    in
-		       I
-		    end)
-		end) arg
+         traceElaborateSigexp
+         (fn (sigexp: Sigexp.t, {isTop}) =>
+          case Sigexp.node sigexp of
+             Sigexp.Spec spec =>
+                (* rule 62 *)
+                SOME (#1 (Env.makeInterface (E, {isTop = isTop},
+                                             fn () => elaborateSpec spec)))
+           | Sigexp.Var x =>
+                (* rule 63 *)
+                Option.map (Env.lookupSigid (E, x), Interface.copy)
+           | Sigexp.Where (sigexp, wheres) =>
+                (* rule 64 *)
+                let
+                   val time = Interface.Time.tick ()
+                in
+                   Option.map
+                   (elaborateSigexp (sigexp, {isTop = false}), fn I =>
+                    let
+                       val _ = 
+                          Vector.foreach
+                          (wheres, fn {longtycon, ty, tyvars} =>
+                           Option.app
+                           (Interface.lookupLongtycon
+                            (I, longtycon, Longtycon.region longtycon,
+                             {prefix = []}),
+                            fn s =>
+                            TypeStr.wheree
+                            (s, Longtycon.region longtycon,
+                             fn () => Longtycon.layout longtycon,
+                             time,
+                             TypeStr.def (elaborateScheme (tyvars, ty, E),
+                                          Kind.Arity (Vector.length tyvars)))))
+                    in
+                       I
+                    end)
+                end) arg
       and elaborateSpec arg : unit =
-	 Trace.traceInfo' (info', Spec.layout, Layout.ignore)
-	 (fn spec: Spec.t =>
-	  case Spec.node spec of
-	     Spec.Datatype rhs =>
-		(* rules 71, 72 *)
-		(case DatatypeRhs.node rhs of
-		    DatatypeRhs.DatBind b => elaborateDatBind (b, E)
-		  | DatatypeRhs.Repl {lhs, rhs} =>
-		       Option.app
-		       (Env.lookupLongtycon (E, rhs), fn s =>
-			let
-			   val _ = Env.extendTycon (E, lhs, s)
-			   val Cons.T v = TypeStr.cons s
-			   val _ =
-			      Vector.foreach
-			      (v, fn {name, scheme} =>
-			       Env.extendCon (E, name, scheme))
-			in
-			   ()
-			end))
-	   | Spec.Empty =>
-		(* rule 76 *)
-		()
-	   | Spec.Eqtype typedescs =>
-		(* rule 70 *)
-		elaborateTypedescs (typedescs, {equality = true}, E)
-	   | Spec.Exception cons =>
-		(* rule 73 *)
-		Vector.foreach
-		(cons, fn (name: Ast.Con.t, arg: Ast.Type.t option) =>
-		 let
-		    val ty =
-		       case arg of
-			  NONE => Type.exn
-			| SOME t =>
-			     let
-				val t = Scheme.ty (elaborateScheme
-						   (Vector.new0 (), t, E))
-			     in
-				Type.arrow (t, Type.exn)
-			     end
-		    val scheme = Scheme.make (Vector.new0 (), ty)
-		    val _ = Env.extendExn (E, name, scheme)
-		 in
-		    ()
-		 end)
-	   | Spec.IncludeSigexp sigexp =>
-		(* rule 75 *)
-		Option.app (elaborateSigexp (sigexp, {isTop = false}), fn I =>
-			    Env.openInterface (E, I, Sigexp.region sigexp))
-	   | Spec.IncludeSigids sigids =>
-		(* Appendix A, p.59 *)
-		Vector.foreach (sigids, fn x =>
-				Option.app
-				(Env.lookupSigid (E, x), fn I =>
-				 Env.openInterface
-				 (E, Interface.copy I, Sigid.region x)))
-	   | Spec.Seq (s, s') =>
-		(* rule 77 *)
-		(elaborateSpec s; elaborateSpec s')
-	   | Spec.Sharing {equations, spec} =>
-		(* rule 78 and section G.3.3 *)
-		let
-		   val time = Interface.Time.tick ()
-		   val () = elaborateSpec spec
-		   val () =
-		      Vector.foreach
-		      (equations, fn eqn =>
-		       case Equation.node eqn of
-			  Equation.Structure ss =>
-			     let
-				(* The following implements the "all pairs"
-				 * sharing as specified in G.3.3.
-				 *)
-				fun loop Is =
-				   case Is of
-				      [] => ()
-				    | (s, I) :: Is =>
-					 List.foreach 
-					 (Is, fn (s', I') =>
-					  Interface.share (I, s, I', s', time))
-			     in
-				loop (List.fold
-				      (ss, [], fn (s, ac) =>
-				       case Env.lookupLongstrid (E, s) of
-					  NONE => ac
-					| SOME I => (s, I) :: ac))
-			     end
-			| Equation.Type cs =>
-			     ignore
-			     (List.fold
-			      (cs, NONE, fn (c', so) =>
-			       case (so, Env.lookupLongtycon (E, c')) of
-				  (NONE, NONE) => NONE
-				| (SOME _, NONE) => so
-				| (NONE, SOME s') => SOME (c', s')
-				| (SOME (c, s), SOME s') =>
-				     let
-					fun doit (c, s) =
-					   (s, Longtycon.region c,
-					    fn () => Longtycon.layout c)
-					val _ =
-					   TypeStr.share (doit (c, s),
-							  doit (c', s'),
-							  time)
-				     in
-					SOME (c', s')
-				     end)))
-		in
-		   ()
-		end
-	   | Spec.Structure ss =>
-		(* rules 74, 84 *)
-		Vector.foreach
-		(ss, fn (strid, sigexp) =>
-		 Env.extendStrid
-		 (E, strid,
-		  case elaborateSigexp (sigexp, {isTop = false}) of
-		     NONE => Interface.empty
-		   | SOME I => I))
-	   | Spec.Type typedescs =>
-		(* rule 69 *)
-		elaborateTypedescs (typedescs, {equality = false}, E)
-	   | Spec.TypeDefs typBind =>
-		(* Abbreviation on page 59 combined with rules 77 and 80. *)
-		let
-		   val TypBind.T ds = TypBind.node typBind
-		in
-		   Vector.foreach
-		   (ds, fn {def, tycon, tyvars} =>
-		    Env.extendTycon
-		    (E, tycon,
-		     TypeStr.def (elaborateScheme (tyvars, def, E),
-				  Kind.Arity (Vector.length tyvars))))
-		end
-	   | Spec.Val xts =>
-		(* rules 68, 79 *)
-		Vector.foreach
-		(xts, fn (x, t) =>
-		 Env.extendVid
-		 (E, Ast.Vid.fromVar x, Status.Var,
-		  Scheme.make (elaborateType (t, E))))
-		) arg
+         Trace.traceInfo' (info', Spec.layout, Layout.ignore)
+         (fn spec: Spec.t =>
+          case Spec.node spec of
+             Spec.Datatype rhs =>
+                (* rules 71, 72 *)
+                (case DatatypeRhs.node rhs of
+                    DatatypeRhs.DatBind b => elaborateDatBind (b, E)
+                  | DatatypeRhs.Repl {lhs, rhs} =>
+                       Option.app
+                       (Env.lookupLongtycon (E, rhs), fn s =>
+                        let
+                           val _ = Env.extendTycon (E, lhs, s)
+                           val Cons.T v = TypeStr.cons s
+                           val _ =
+                              Vector.foreach
+                              (v, fn {name, scheme} =>
+                               Env.extendCon (E, name, scheme))
+                        in
+                           ()
+                        end))
+           | Spec.Empty =>
+                (* rule 76 *)
+                ()
+           | Spec.Eqtype typedescs =>
+                (* rule 70 *)
+                elaborateTypedescs (typedescs, {equality = true}, E)
+           | Spec.Exception cons =>
+                (* rule 73 *)
+                Vector.foreach
+                (cons, fn (name: Ast.Con.t, arg: Ast.Type.t option) =>
+                 let
+                    val ty =
+                       case arg of
+                          NONE => Type.exn
+                        | SOME t =>
+                             let
+                                val t = Scheme.ty (elaborateScheme
+                                                   (Vector.new0 (), t, E))
+                             in
+                                Type.arrow (t, Type.exn)
+                             end
+                    val scheme = Scheme.make (Vector.new0 (), ty)
+                    val _ = Env.extendExn (E, name, scheme)
+                 in
+                    ()
+                 end)
+           | Spec.IncludeSigexp sigexp =>
+                (* rule 75 *)
+                Option.app (elaborateSigexp (sigexp, {isTop = false}), fn I =>
+                            Env.openInterface (E, I, Sigexp.region sigexp))
+           | Spec.IncludeSigids sigids =>
+                (* Appendix A, p.59 *)
+                Vector.foreach (sigids, fn x =>
+                                Option.app
+                                (Env.lookupSigid (E, x), fn I =>
+                                 Env.openInterface
+                                 (E, Interface.copy I, Sigid.region x)))
+           | Spec.Seq (s, s') =>
+                (* rule 77 *)
+                (elaborateSpec s; elaborateSpec s')
+           | Spec.Sharing {equations, spec} =>
+                (* rule 78 and section G.3.3 *)
+                let
+                   val time = Interface.Time.tick ()
+                   val () = elaborateSpec spec
+                   val () =
+                      Vector.foreach
+                      (equations, fn eqn =>
+                       case Equation.node eqn of
+                          Equation.Structure ss =>
+                             let
+                                (* The following implements the "all pairs"
+                                 * sharing as specified in G.3.3.
+                                 *)
+                                fun loop Is =
+                                   case Is of
+                                      [] => ()
+                                    | (s, I) :: Is =>
+                                         List.foreach 
+                                         (Is, fn (s', I') =>
+                                          Interface.share (I, s, I', s', time))
+                             in
+                                loop (List.fold
+                                      (ss, [], fn (s, ac) =>
+                                       case Env.lookupLongstrid (E, s) of
+                                          NONE => ac
+                                        | SOME I => (s, I) :: ac))
+                             end
+                        | Equation.Type cs =>
+                             ignore
+                             (List.fold
+                              (cs, NONE, fn (c', so) =>
+                               case (so, Env.lookupLongtycon (E, c')) of
+                                  (NONE, NONE) => NONE
+                                | (SOME _, NONE) => so
+                                | (NONE, SOME s') => SOME (c', s')
+                                | (SOME (c, s), SOME s') =>
+                                     let
+                                        fun doit (c, s) =
+                                           (s, Longtycon.region c,
+                                            fn () => Longtycon.layout c)
+                                        val _ =
+                                           TypeStr.share (doit (c, s),
+                                                          doit (c', s'),
+                                                          time)
+                                     in
+                                        SOME (c', s')
+                                     end)))
+                in
+                   ()
+                end
+           | Spec.Structure ss =>
+                (* rules 74, 84 *)
+                Vector.foreach
+                (ss, fn (strid, sigexp) =>
+                 Env.extendStrid
+                 (E, strid,
+                  case elaborateSigexp (sigexp, {isTop = false}) of
+                     NONE => Interface.empty
+                   | SOME I => I))
+           | Spec.Type typedescs =>
+                (* rule 69 *)
+                elaborateTypedescs (typedescs, {equality = false}, E)
+           | Spec.TypeDefs typBind =>
+                (* Abbreviation on page 59 combined with rules 77 and 80. *)
+                let
+                   val TypBind.T ds = TypBind.node typBind
+                in
+                   Vector.foreach
+                   (ds, fn {def, tycon, tyvars} =>
+                    Env.extendTycon
+                    (E, tycon,
+                     TypeStr.def (elaborateScheme (tyvars, def, E),
+                                  Kind.Arity (Vector.length tyvars))))
+                end
+           | Spec.Val xts =>
+                (* rules 68, 79 *)
+                Vector.foreach
+                (xts, fn (x, t) =>
+                 Env.extendVid
+                 (E, Ast.Vid.fromVar x, Status.Var,
+                  Scheme.make (elaborateType (t, E))))
+                ) arg
    in
       elaborateSigexp (sigexp, {isTop = true})
    end
@@ -466,10 +476,10 @@
     | _ => elaborateSigexp (sigexp, {env = E})
 
 val elaborateSigexp = 
-   Trace.trace2 ("elaborateSigexp",
-		 Sigexp.layout,
-		 Layout.ignore,
-		 Layout.ignore)
+   Trace.trace2 ("ElaborateSigexp.elaborateSigexp",
+                 Sigexp.layout,
+                 Layout.ignore,
+                 Layout.ignore)
    elaborateSigexp
 
 structure Env = StructureEnv

Modified: mlton/branches/on-20050420-cmm-branch/mlton/elaborate/elaborate-sigexp.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/elaborate/elaborate-sigexp.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/elaborate/elaborate-sigexp.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature ELABORATE_SIGEXP_STRUCTS = 
    sig
       structure Ast: AST
@@ -17,6 +18,6 @@
       include ELABORATE_SIGEXP_STRUCTS
 
       val elaborateSigexp: 
-	 Ast.Sigexp.t * {env: Env.t} 
-	 -> Env.Interface.t option
+         Ast.Sigexp.t * {env: Env.t} 
+         -> Env.Interface.t option
    end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/elaborate/elaborate.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/elaborate/elaborate.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/elaborate/elaborate.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,9 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 functor Elaborate (S: ELABORATE_STRUCTS): ELABORATE = 
@@ -12,8 +12,8 @@
 open S
 
 structure Env = ElaborateEnv (structure Ast = Ast
-			      structure CoreML = CoreML
-			      structure TypeEnv = TypeEnv)
+                              structure CoreML = CoreML
+                              structure TypeEnv = TypeEnv)
 
 local
    open Env
@@ -22,9 +22,9 @@
 end
 
 structure ElaborateMLBs = ElaborateMLBs (structure Ast = Ast
-					 structure CoreML = CoreML
-					 structure Decs = Decs
-					 structure Env = Env)
+                                         structure CoreML = CoreML
+                                         structure Decs = Decs
+                                         structure Env = Env)
 
 open ElaborateMLBs
 end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/elaborate/elaborate.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/elaborate/elaborate.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/elaborate/elaborate.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature ELABORATE_STRUCTS = 
    sig
       structure Ast: AST
@@ -24,6 +25,6 @@
       structure Env: ELABORATE_ENV
 
       val elaborateMLB:
-	 Ast.Basdec.t * {addPrim: Env.t -> CoreML.Dec.t list}
-	 -> Env.t * (CoreML.Dec.t list * bool) vector
+         Ast.Basdec.t * {addPrim: Env.t -> CoreML.Dec.t list}
+         -> Env.t * (CoreML.Dec.t list * bool) vector
   end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/elaborate/interface.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/elaborate/interface.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/elaborate/interface.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 functor Interface (S: INTERFACE_STRUCTS): INTERFACE =
 struct
 
@@ -39,7 +40,7 @@
 structure Status:
    sig
       datatype t = Con | Exn | Var
-	 
+         
       val layout: t -> Layout.t
       val toString: t -> string
    end =
@@ -47,9 +48,9 @@
       datatype t = Con | Exn | Var
 
       val toString =
-	 fn Con => "Con"
-	  | Exn => "Exn"
-	  | Var => "Var"
+         fn Con => "Con"
+          | Exn => "Exn"
+          | Var => "Var"
 
       val layout = Layout.str o toString
    end
@@ -76,7 +77,7 @@
       type t = int
 
       val op < = Int.<
-	 
+         
       val layout = Int.layout
 
       val min = Int.min
@@ -86,12 +87,12 @@
       fun current () = !currentTime
 
       fun tick () =
-	 let
-	    val n = 1 + !currentTime
-	    val _ = currentTime := n
-	 in
-	    n
-	 end
+         let
+            val n = 1 + !currentTime
+            val _ = currentTime := n
+         in
+            n
+         end
    end
 
 structure FlexibleTycon =
@@ -102,92 +103,92 @@
        * when implementing "where type". 
        *)
       datatype t = T of {admitsEquality: AdmitsEquality.t ref,
-			 copy: copy,
-			 creationTime: Time.t,
-			 defn: exn ref,
-			 hasCons: bool,
-			 id: TyconId.t,
-			 kind: Kind.t,
-			 plist: PropertyList.t} Set.t
+                         copy: copy,
+                         creationTime: Time.t,
+                         defn: exn ref,
+                         hasCons: bool,
+                         id: TyconId.t,
+                         kind: Kind.t,
+                         plist: PropertyList.t} Set.t
       withtype copy = t option ref
 
       fun fields (T s) = Set.! s
 
       local
-	 fun make f = f o fields
+         fun make f = f o fields
       in
-	 val admitsEquality = make #admitsEquality
-	 val defn = ! o make #defn
-	 val plist = make #plist
+         val admitsEquality = make #admitsEquality
+         val defn = ! o make #defn
+         val plist = make #plist
       end
 
       fun dest (T s) =
-	 let
-	    val {admitsEquality, hasCons, kind, ...} = Set.! s
-	 in
-	    {admitsEquality = !admitsEquality,
-	     hasCons = hasCons,
-	     kind = kind}
-	 end
+         let
+            val {admitsEquality, hasCons, kind, ...} = Set.! s
+         in
+            {admitsEquality = !admitsEquality,
+             hasCons = hasCons,
+             kind = kind}
+         end
 
       val equals = fn (T s, T s') => Set.equals (s, s')
 
       fun layout (T s) =
-	 let
-	    open Layout
-	    val {admitsEquality, creationTime, hasCons, id, ...} = Set.! s
-	 in
-	    record [("admitsEquality", AdmitsEquality.layout (!admitsEquality)),
-		    ("creationTime", Time.layout creationTime),
-		    ("hasCons", Bool.layout hasCons),
-		    ("id", TyconId.layout id)]
-	 end
+         let
+            open Layout
+            val {admitsEquality, creationTime, hasCons, id, ...} = Set.! s
+         in
+            record [("admitsEquality", AdmitsEquality.layout (!admitsEquality)),
+                    ("creationTime", Time.layout creationTime),
+                    ("hasCons", Bool.layout hasCons),
+                    ("id", TyconId.layout id)]
+         end
 
       fun layoutApp (t, _) = (layout t, {isChar = false, needsParen = false})
 
       val copies: copy list ref = ref []
-	 
+         
       fun new {defn: Defn.t, hasCons: bool, kind: Kind.t}: t =
-	 T (Set.singleton {admitsEquality = ref AdmitsEquality.Sometimes,
-			   copy = ref NONE,
-			   creationTime = Time.current (),
-			   defn = ref defn,
-			   hasCons = hasCons,
-			   id = TyconId.new (),
-			   kind = kind,
-			   plist = PropertyList.new ()})
+         T (Set.singleton {admitsEquality = ref AdmitsEquality.Sometimes,
+                           copy = ref NONE,
+                           creationTime = Time.current (),
+                           defn = ref defn,
+                           hasCons = hasCons,
+                           id = TyconId.new (),
+                           kind = kind,
+                           plist = PropertyList.new ()})
    end
 
 structure Tycon =
    struct
       datatype t =
-	 Flexible of FlexibleTycon.t
+         Flexible of FlexibleTycon.t
        | Rigid of Etycon.t * Kind.t
 
       val fromEnv: Etycon.t * Kind.t -> t = Rigid
 
       fun admitsEquality c =
-	 case c of
-	    Flexible f => FlexibleTycon.admitsEquality f
-	  | Rigid (e, _) => Etycon.admitsEquality e
+         case c of
+            Flexible f => FlexibleTycon.admitsEquality f
+          | Rigid (e, _) => Etycon.admitsEquality e
 
       val arrow = fromEnv (Etycon.arrow, Kind.Arity 2)
 
       val equals =
-	 fn (Flexible f, Flexible f') => FlexibleTycon.equals (f, f')
-	  | (Rigid (c, _), Rigid (c', _)) => Etycon.equals (c, c')
-	  | _ => false
+         fn (Flexible f, Flexible f') => FlexibleTycon.equals (f, f')
+          | (Rigid (c, _), Rigid (c', _)) => Etycon.equals (c, c')
+          | _ => false
 
       val exn = Rigid (Etycon.exn, Kind.Arity 0)
 
       val layout =
-	 fn Flexible c => FlexibleTycon.layout c
-	  | Rigid (c, _) => Etycon.layout c
+         fn Flexible c => FlexibleTycon.layout c
+          | Rigid (c, _) => Etycon.layout c
 
       fun layoutApp (t: t, v) =
-	 case t of
-	    Flexible f => FlexibleTycon.layoutApp (f, v)
-	  | Rigid (c, _) => Etycon.layoutApp (c, v)
+         case t of
+            Flexible f => FlexibleTycon.layoutApp (f, v)
+          | Rigid (c, _) => Etycon.layoutApp (c, v)
 
       val tuple = Rigid (Etycon.tuple, Kind.Nary)
    end
@@ -195,103 +196,103 @@
 structure Type =
    struct
       datatype t =
-	 Con of Tycon.t * t vector
+         Con of Tycon.t * t vector
        | Record of t Record.t
        | Var of Tyvar.t
 
       fun arrow (t1, t2) = Con (Tycon.arrow, Vector.new2 (t1, t2))
 
-      val bogus = Con (Tycon.exn, Vector.new0 ())	 
+      val bogus = Con (Tycon.exn, Vector.new0 ())        
 
       val con = Con
 
       fun deArrowOpt (t: t): (t * t) option =
-	 case t of
-	    Con (c, ts) =>
-	       if Tycon.equals (c, Tycon.arrow)
-		  then SOME (Vector.sub (ts, 0), Vector.sub (ts, 1))
-	       else NONE
-	  | _ => NONE
+         case t of
+            Con (c, ts) =>
+               if Tycon.equals (c, Tycon.arrow)
+                  then SOME (Vector.sub (ts, 0), Vector.sub (ts, 1))
+               else NONE
+          | _ => NONE
 
       fun deArrow t =
-	 case deArrowOpt t of
-	    NONE => Error.bug "Type.deArrow"
-	  | SOME z => z
+         case deArrowOpt t of
+            NONE => Error.bug "Interface.Type.deArrow"
+          | SOME z => z
 
       fun deEta (t: t, tyvars: Tyvar.t vector): Tycon.t option =
-	 case t of
-	    Con (c, ts) =>
-	       if Vector.length ts = Vector.length tyvars
-		  andalso Vector.foralli (ts, fn (i, t) =>
-					  case t of
-					     Var a =>
-						Tyvar.equals
-						(a, Vector.sub (tyvars, i))
-					   | _ => false)
-		  then SOME c
-	       else NONE
+         case t of
+            Con (c, ts) =>
+               if Vector.length ts = Vector.length tyvars
+                  andalso Vector.foralli (ts, fn (i, t) =>
+                                          case t of
+                                             Var a =>
+                                                Tyvar.equals
+                                                (a, Vector.sub (tyvars, i))
+                                           | _ => false)
+                  then SOME c
+               else NONE
            | _ => NONE
 
       val exn = Con (Tycon.exn, Vector.new0 ())
 
       fun hom (t, {con, record, var}) =
-	 let
-	    val rec loop =
-	       fn Con (c, ts) => con (c, Vector.map (ts, loop))
-		| Record r => record (Record.map (r, loop))
-		| Var a => var a
-	 in
-	    loop t
-	 end
-	       
+         let
+            val rec loop =
+               fn Con (c, ts) => con (c, Vector.map (ts, loop))
+                | Record r => record (Record.map (r, loop))
+                | Var a => var a
+         in
+            loop t
+         end
+               
       local
-	 open Layout
-	 fun simple l = (l, {isChar = false, needsParen = false})
-	 fun loop t =
-	    case t of
-	       Con (c, ts) => Tycon.layoutApp (c, Vector.map (ts, loop))
-	     | Record r =>
-		  (case Record.detupleOpt r of
-		      NONE =>
-			 simple
-			 (seq
-			  [str "{",
-			   mayAlign
-			   (separateRight
-			    (Vector.toListMap
-			     (QuickSort.sortVector
-			      (Record.toVector r, fn ((f, _), (f', _)) =>
-			       Field.<= (f, f')),
-			      fn (f, t) =>
-			      seq [Field.layout f, str ": ", #1 (loop t)]),
-			     ",")),
-			   str "}"])
-		    | SOME ts => Tycon.layoutApp (Tycon.tuple,
-						  Vector.map (ts, loop)))
-	     | Var a => simple (Tyvar.layout a)
+         open Layout
+         fun simple l = (l, {isChar = false, needsParen = false})
+         fun loop t =
+            case t of
+               Con (c, ts) => Tycon.layoutApp (c, Vector.map (ts, loop))
+             | Record r =>
+                  (case Record.detupleOpt r of
+                      NONE =>
+                         simple
+                         (seq
+                          [str "{",
+                           mayAlign
+                           (separateRight
+                            (Vector.toListMap
+                             (QuickSort.sortVector
+                              (Record.toVector r, fn ((f, _), (f', _)) =>
+                               Field.<= (f, f')),
+                              fn (f, t) =>
+                              seq [Field.layout f, str ": ", #1 (loop t)]),
+                             ",")),
+                           str "}"])
+                    | SOME ts => Tycon.layoutApp (Tycon.tuple,
+                                                  Vector.map (ts, loop)))
+             | Var a => simple (Tyvar.layout a)
       in
-	 val layout = #1 o loop
+         val layout = #1 o loop
       end
 
       val record = Record
 
       fun substitute (t: t, sub: (Tyvar.t * t) vector): t =
-	 let
-	    fun var a =
-	       case Vector.peek (sub, fn (a', _) => Tyvar.equals (a, a')) of
-		  NONE => Error.bug "substitute"
-		| SOME (_, t) => t
-	 in
-	    hom (t, {con = Con,
-		     record = Record,
-		     var = var})
-	 end
+         let
+            fun var a =
+               case Vector.peek (sub, fn (a', _) => Tyvar.equals (a, a')) of
+                  NONE => Error.bug "Interface.Type.substitute"
+                | SOME (_, t) => t
+         in
+            hom (t, {con = Con,
+                     record = Record,
+                     var = var})
+         end
 
       val var = Var
    end
 
 structure Scheme = GenericScheme (structure Type = Type
-				  structure Tyvar = Tyvar)
+                                  structure Tyvar = Tyvar)
 
 structure Scheme =
    struct
@@ -300,103 +301,103 @@
       fun bogus () = T {ty = Type.bogus, tyvars = Vector.new0 ()}
 
       fun dest (T {ty, tyvars}) = (tyvars, ty)
-	 
+         
       fun make (tyvars, ty) = T {ty = ty, tyvars = tyvars}
    end
 
 structure Cons =
    struct
       datatype t = T of {name: Ast.Con.t,
-			 scheme: Scheme.t} vector
+                         scheme: Scheme.t} vector
 
       val empty = T (Vector.new0 ())
 
       fun layout (T v) =
-	 Vector.layout (fn {name, scheme} =>
-			let
-			   open Layout
-			in
-			   seq [Ast.Con.layout name,
-				str ": ",
-				Scheme.layout scheme]
-			end)
-	 v
+         Vector.layout (fn {name, scheme} =>
+                        let
+                           open Layout
+                        in
+                           seq [Ast.Con.layout name,
+                                str ": ",
+                                Scheme.layout scheme]
+                        end)
+         v
    end
 
 structure TypeStr =
    struct
       datatype node =
-	 Datatype of {cons: Cons.t,
-		      tycon: Tycon.t}
+         Datatype of {cons: Cons.t,
+                      tycon: Tycon.t}
        | Scheme of Scheme.t
        | Tycon of Tycon.t
 
       datatype t = T of {kind: Kind.t,
-			 node: node}
+                         node: node}
 
       local
-	 fun make f (T r) = f r
+         fun make f (T r) = f r
       in
-	 val kind = make #kind
-	 val node = make #node
+         val kind = make #kind
+         val node = make #node
       end
 
       fun layout t =
-	 let
-	    open Layout
-	 in
-	    case node t of
-	       Datatype {tycon, cons} =>
-		  seq [str "Datatype ",
-		       record [("tycon", Tycon.layout tycon),
-			       ("cons", Cons.layout cons)]]
-	     | Scheme s => Scheme.layout s
-	     | Tycon t => seq [str "Tycon ", Tycon.layout t]
-	 end
+         let
+            open Layout
+         in
+            case node t of
+               Datatype {tycon, cons} =>
+                  seq [str "Datatype ",
+                       record [("tycon", Tycon.layout tycon),
+                               ("cons", Cons.layout cons)]]
+             | Scheme s => Scheme.layout s
+             | Tycon t => seq [str "Tycon ", Tycon.layout t]
+         end
 
       fun bogus (k: Kind.t): t =
-	 T {kind = k,
-	    node = Scheme (Scheme.bogus ())}
+         T {kind = k,
+            node = Scheme (Scheme.bogus ())}
 
       fun abs t =
-	 case node t of
-	    Datatype {tycon, ...} => T {kind = kind t,
-					node = Tycon tycon}
-	  | _ => t
+         case node t of
+            Datatype {tycon, ...} => T {kind = kind t,
+                                        node = Tycon tycon}
+          | _ => t
 
       fun apply (t: t, tys: Type.t vector): Type.t =
-	 case node t of
-	    Datatype {tycon, ...} => Type.con (tycon, tys)
-	  | Scheme s => Scheme.apply (s, tys)
-	  | Tycon t => Type.con (t, tys)
+         case node t of
+            Datatype {tycon, ...} => Type.con (tycon, tys)
+          | Scheme s => Scheme.apply (s, tys)
+          | Tycon t => Type.con (t, tys)
 
       fun cons t =
-	 case node t of
-	    Datatype {cons, ...} => cons
-	  | _ => Cons.empty
+         case node t of
+            Datatype {cons, ...} => cons
+          | _ => Cons.empty
 
       fun data (tycon, kind, cons) =
-	 T {kind = kind,
-	    node = Datatype {tycon = tycon, cons = cons}}
+         T {kind = kind,
+            node = Datatype {tycon = tycon, cons = cons}}
    
       fun def (s: Scheme.t, k: Kind.t) =
-	 let
-	    val (tyvars, ty) = Scheme.dest s
-	 in
-	    T {kind = k,
-	       node = (case Type.deEta (ty, tyvars) of
-			  NONE => Scheme s
-			| SOME c => Tycon c)}
-	 end
+         let
+            val (tyvars, ty) = Scheme.dest s
+         in
+            T {kind = k,
+               node = (case Type.deEta (ty, tyvars) of
+                          NONE => Scheme s
+                        | SOME c => Tycon c)}
+         end
 
       fun toTyconOpt s =
-	 case node s of
-	    Datatype {tycon, ...} => SOME tycon
-	  | Scheme _ => NONE
-	  | Tycon c => SOME c
+         case node s of
+            Datatype {tycon, ...} => SOME tycon
+          | Scheme _ => NONE
+          | Tycon c => SOME c
 
       fun tycon (c, kind) = T {kind = kind,
-			       node = Tycon c}
+                               node = Tycon c}
    end
 
 structure Defn =
@@ -404,7 +405,7 @@
       open Defn
 
       datatype dest =
-	 Realized of EtypeStr.t option
+         Realized of EtypeStr.t option
        | TypeStr of TypeStr.t
        | Undefined
 
@@ -415,44 +416,44 @@
       val undefined = U Undefined
 
       fun dest (d: t): dest =
-	 case d of
-	    U u => u
-	  | _ => Error.bug "Defn.dest"
+         case d of
+            U u => u
+          | _ => Error.bug "Interface.Defn.dest"
    end
 
 (* expandTy expands all type definitions in ty *)
 local
    fun con (c, ts) =
       case c of
-	 Tycon.Flexible f =>
-	    (case Defn.dest (FlexibleTycon.defn f) of
-		Defn.Realized _ => Error.bug "expandTy saw Realized"
-	      | Defn.TypeStr s => expandTy (TypeStr.apply (s, ts))
-	      | Defn.Undefined => Type.Con (c, ts))
+         Tycon.Flexible f =>
+            (case Defn.dest (FlexibleTycon.defn f) of
+                Defn.Realized _ => Error.bug "Interface.expandTy: Realized"
+              | Defn.TypeStr s => expandTy (TypeStr.apply (s, ts))
+              | Defn.Undefined => Type.Con (c, ts))
        | Tycon.Rigid _ => Type.Con (c, ts)
    and expandTy (ty: Type.t): Type.t =
       Type.hom (ty, {con = con,
-		     record = Type.Record,
-		     var = Type.Var})
+                     record = Type.Record,
+                     var = Type.Var})
 in
    val expandTy = expandTy
 end
 
 fun copyCons (Cons.T v): Cons.t =
    Cons.T (Vector.map (v, fn {name, scheme} =>
-		       {name = name,
-			scheme = copyScheme scheme}))
+                       {name = name,
+                        scheme = copyScheme scheme}))
 and copyDefn (d: Defn.t): Defn.t =
    let
       open Defn
    in
       case dest d of
-	 Realized _ =>
-	    (* This will never happen in a type-correct program, but it may
-	     * in a type-incorrect one.  So, we return d to avoid terminating
-	     * MLton.
-	     *)
-	    d
+         Realized _ =>
+            (* This will never happen in a type-correct program, but it may
+             * in a type-incorrect one.  So, we return d to avoid terminating
+             * MLton.
+             *)
+            d
        | TypeStr s => Defn.typeStr (copyTypeStr s)
        | Undefined => Defn.undefined
    end
@@ -462,17 +463,17 @@
       val {admitsEquality = a, copy, defn, hasCons, kind, ...} = Set.! s
    in
       case !copy of
-	 NONE => 
-	    let
-	       val c = new {defn = copyDefn (!defn),
-			    hasCons = hasCons,
-			    kind = kind}
-	       val _ = admitsEquality c := !a
-	       val _ = List.push (copies, copy)
-	       val _ = copy := SOME c
-	    in
-	       c
-	    end
+         NONE => 
+            let
+               val c = new {defn = copyDefn (!defn),
+                            hasCons = hasCons,
+                            kind = kind}
+               val _ = admitsEquality c := !a
+               val _ = List.push (copies, copy)
+               val _ = copy := SOME c
+            in
+               c
+            end
        | SOME c => c
    end
 and copyTycon (t: Tycon.t): Tycon.t =
@@ -480,7 +481,7 @@
       open Tycon
    in
       case t of
-	 Flexible c => Flexible (copyFlexibleTycon c)
+         Flexible c => Flexible (copyFlexibleTycon c)
        | Rigid _ => t
    end
 and copyType (t: Type.t): Type.t =
@@ -488,8 +489,8 @@
       open Type
    in
       hom (t, {con = fn (c, ts) => Con (copyTycon c, ts),
-	       record = Record,
-	       var = Var})
+               record = Record,
+               var = Var})
    end
 and copyScheme (Scheme.T {tyvars, ty}): Scheme.t =
    Scheme.T {ty = copyType ty, tyvars = tyvars}
@@ -499,7 +500,7 @@
       val kind = kind s
    in
       case node s of
-	 Datatype {cons, tycon} => data (copyTycon tycon, kind, copyCons cons)
+         Datatype {cons, tycon} => data (copyTycon tycon, kind, copyCons cons)
        | Scheme s => def (copyScheme s, kind)
        | Tycon c => tycon (copyTycon c, kind)
    end
@@ -517,33 +518,33 @@
       datatype z = datatype Defn.dest
    in
       case Defn.dest (!defn) of
-	 Realized _ => Error.bug "flexibleTyconAdmitsEquality Realized"
+         Realized _ => Error.bug "Interface.flexibleTyconAdmitsEquality: Realized"
        | TypeStr s => typeStrAdmitsEquality s
        | Undefined => !admitsEquality
    end
 and schemeAdmitsEquality (s: Scheme.t): bool =
    let
       fun con (c, bs) =
-	 let
-	    datatype z = datatype AdmitsEquality.t
-	 in
-	    case ! (Tycon.admitsEquality c) of
-	       Always => true
-	     | Never => false
-	     | Sometimes => Vector.forall (bs, fn b => b)
-	 end
+         let
+            datatype z = datatype AdmitsEquality.t
+         in
+            case ! (Tycon.admitsEquality c) of
+               Always => true
+             | Never => false
+             | Sometimes => Vector.forall (bs, fn b => b)
+         end
    in
       Type.hom (expandTy (Scheme.ty s),
-		{con = con,
-		 record = fn r => Record.forall (r, fn b => b),
-		 var = fn _ => true})
+                {con = con,
+                 record = fn r => Record.forall (r, fn b => b),
+                 var = fn _ => true})
    end
 and tyconAdmitsEquality (t: Tycon.t): AdmitsEquality.t =
    let
       datatype z = datatype Tycon.t
    in
       case t of
-	 Flexible c => flexibleTyconAdmitsEquality c
+         Flexible c => flexibleTyconAdmitsEquality c
        | Rigid (e, _) => ! (Etycon.admitsEquality e)
    end
 and typeStrAdmitsEquality (s: TypeStr.t): AdmitsEquality.t =
@@ -551,7 +552,7 @@
       datatype z = datatype TypeStr.node
    in
       case TypeStr.node s of
-	 Datatype {tycon = c, ...} => tyconAdmitsEquality c
+         Datatype {tycon = c, ...} => tyconAdmitsEquality c
        | Scheme s => AdmitsEquality.fromBool (schemeAdmitsEquality s)
        | Tycon c => tyconAdmitsEquality c
    end
@@ -561,47 +562,47 @@
       open FlexibleTycon
 
       fun realize (T s, typeStr) =
-	 let
-	    val {defn, ...} = Set.! s
-	 in
-	    case Defn.dest (!defn) of
-	       Defn.Undefined => defn := Defn.realized typeStr
-	     | _ => Error.bug "FlexibleTycon.realize"
-	 end
+         let
+            val {defn, ...} = Set.! s
+         in
+            case Defn.dest (!defn) of
+               Defn.Undefined => defn := Defn.realized typeStr
+             | _ => Error.bug "Interface.FlexibleTycon.realize"
+         end
 
       fun share (T s, T s') =
-	 let
-	    val {admitsEquality = a, creationTime = t, hasCons = h, id, kind,
-		 plist, ...} =
-	       Set.! s
-	    val {admitsEquality = a', creationTime = t', hasCons = h', ...} =
-	       Set.! s'
-	    val _ = Set.union (s, s')
-	    val _ = 
-	       Set.:=
-	       (s, {admitsEquality = ref (AdmitsEquality.or (!a, !a')),
-		    copy = ref NONE,
-		    creationTime = Time.min (t, t'),
-		    defn = ref Defn.undefined,
-		    hasCons = h orelse h',
-		    id = id,
-		    kind = kind,
-		    plist = plist})
-	 in
-	    ()
-	 end
+         let
+            val {admitsEquality = a, creationTime = t, hasCons = h, id, kind,
+                 plist, ...} =
+               Set.! s
+            val {admitsEquality = a', creationTime = t', hasCons = h', ...} =
+               Set.! s'
+            val _ = Set.union (s, s')
+            val _ = 
+               Set.:=
+               (s, {admitsEquality = ref (AdmitsEquality.or (!a, !a')),
+                    copy = ref NONE,
+                    creationTime = Time.min (t, t'),
+                    defn = ref Defn.undefined,
+                    hasCons = h orelse h',
+                    id = id,
+                    kind = kind,
+                    plist = plist})
+         in
+            ()
+         end
 
       type typeStr = TypeStr.t
-	 
+         
       datatype realization =
-	 ETypeStr of EnvTypeStr.t option
-	| TypeStr of typeStr
-	  
+         ETypeStr of EnvTypeStr.t option
+        | TypeStr of typeStr
+          
       fun realization (f: t): realization =
-	 case Defn.dest (defn f) of
-	    Defn.Realized s => ETypeStr s
-	  | Defn.TypeStr s => TypeStr s
-	  | _ => Error.bug "FlexiblTycon.realization"
+         case Defn.dest (defn f) of
+            Defn.Realized s => ETypeStr s
+          | Defn.TypeStr s => TypeStr s
+          | _ => Error.bug "Interface.FlexibleTycon.realization"
    end
 
 structure Tycon =
@@ -609,9 +610,9 @@
       open Tycon
 
       fun make {hasCons, kind} =
-	 Flexible (FlexibleTycon.new {defn = Defn.undefined,
-				      hasCons = hasCons,
-				      kind = kind})
+         Flexible (FlexibleTycon.new {defn = Defn.undefined,
+                                      hasCons = hasCons,
+                                      kind = kind})
    end
 
 structure Scheme =
@@ -628,156 +629,157 @@
 structure TypeStr =
    struct
       open TypeStr
-	 
+         
       val admitsEquality = typeStrAdmitsEquality
-	 
+         
       val copy = copyTypeStr
 
       fun getFlex (s: t, time, oper, reg, lay): FlexibleTycon.t option =
-	 let
-	    fun error what =
-	       let
-		  open Layout
-		  val _ = 
-		     Control.error
-		     (reg,
-		      seq [str "type ", lay (),
-			   str (concat [" is ", what, " and cannot be ", oper])],
-		      empty)
-	       in
-		  NONE
-	       end
-	    fun loop (s: t): FlexibleTycon.t option =
-	       case node s of
-		  Datatype {tycon, ...} => loopTycon tycon
-		| Scheme (Scheme.T {ty, tyvars}) =>
-		     (case Type.deEta (expandTy ty, tyvars) of
-			 NONE => error "a definition"
-		       | SOME c => loopTycon c)
-		| Tycon c => loopTycon c
-	    and loopTycon (c: Tycon.t): FlexibleTycon.t option =
-	       case c of
-		  Tycon.Flexible c =>
-		     let
-			val {creationTime, defn, ...} = FlexibleTycon.fields c
-		     in
-			case Defn.dest (!defn) of
-			   Defn.Realized _ => Error.bug "getFlex of realized"
-			 | Defn.TypeStr s => loop s
-			 | Defn.Undefined =>
-			      if Time.< (creationTime, time)
-				 then error "not local"
-			      else SOME c
-		     end
-		| Tycon.Rigid (c, _) =>
-		     (! renameTycons ()
-		      ; error (concat ["already defined as ",
-				       Layout.toString (Etycon.layout c)]))
-	 in
-	    loop s
-	 end
+         let
+            fun error what =
+               let
+                  open Layout
+                  val _ = 
+                     Control.error
+                     (reg,
+                      seq [str "type ", lay (),
+                           str (concat [" is ", what, " and cannot be ", oper])],
+                      empty)
+               in
+                  NONE
+               end
+            fun loop (s: t): FlexibleTycon.t option =
+               case node s of
+                  Datatype {tycon, ...} => loopTycon tycon
+                | Scheme (Scheme.T {ty, tyvars}) =>
+                     (case Type.deEta (expandTy ty, tyvars) of
+                         NONE => error "a definition"
+                       | SOME c => loopTycon c)
+                | Tycon c => loopTycon c
+            and loopTycon (c: Tycon.t): FlexibleTycon.t option =
+               case c of
+                  Tycon.Flexible c =>
+                     let
+                        val {creationTime, defn, ...} = FlexibleTycon.fields c
+                     in
+                        case Defn.dest (!defn) of
+                           Defn.Realized _ => 
+                              Error.bug "Interface.TypeStr.loopTycon: Realized"
+                         | Defn.TypeStr s => loop s
+                         | Defn.Undefined =>
+                              if Time.< (creationTime, time)
+                                 then error "not local"
+                              else SOME c
+                     end
+                | Tycon.Rigid (c, _) =>
+                     (! renameTycons ()
+                      ; error (concat ["already defined as ",
+                                       Layout.toString (Etycon.layout c)]))
+         in
+            loop s
+         end
 
       fun share ((s: t, reg, lay), (s': t, reg', lay'), time: Time.t): unit =
-	 let
-	    val oper = "shared"
-	    val k = kind s
-	    val k' = kind s'
-	 in
-	    if not (Kind.equals (k, k'))
-	       then
-		  let
-		     open Layout
-		  in
-		     Control.error
-		     (reg,
-		      seq [str "type ", lay (),
-			   str " has arity ", Kind.layout k,
-			   str " and type ", lay' (),
-			   str " has arity ", Kind.layout k',
-			   str " and cannot be shared"],
-		      empty)
-		  end
-	    else
-	       case (getFlex (s, time, oper, reg, lay),
-		     getFlex (s', time, oper, reg', lay')) of
-		  (SOME f, SOME f') => FlexibleTycon.share (f, f')
-		| _ => ()
-	 end
+         let
+            val oper = "shared"
+            val k = kind s
+            val k' = kind s'
+         in
+            if not (Kind.equals (k, k'))
+               then
+                  let
+                     open Layout
+                  in
+                     Control.error
+                     (reg,
+                      seq [str "type ", lay (),
+                           str " has arity ", Kind.layout k,
+                           str " and type ", lay' (),
+                           str " has arity ", Kind.layout k',
+                           str " and cannot be shared"],
+                      empty)
+                  end
+            else
+               case (getFlex (s, time, oper, reg, lay),
+                     getFlex (s', time, oper, reg', lay')) of
+                  (SOME f, SOME f') => FlexibleTycon.share (f, f')
+                | _ => ()
+         end
 
       val share =
-	 Trace.trace
-	 ("TypeStr.share",
-	  fn ((s, _, _), (s', _, _), t) =>
-	  Layout.tuple [layout s, layout s', Time.layout t],
-	  Unit.layout)
-	 share
+         Trace.trace
+         ("Interface.TypeStr.share",
+          fn ((s, _, _), (s', _, _), t) =>
+          Layout.tuple [layout s, layout s', Time.layout t],
+          Unit.layout)
+         share
 
       fun wheree (s': t, r: Region.t, lay, time: Time.t, s: t): unit =
-	 case getFlex (s', time, "redefined", r, lay) of
-	    NONE => ()
-	  | SOME flex =>
-	       let
-		  val k = kind s
-		  val k' = kind s'
-	       in
-		  if not (Kind.equals (k, k'))
-		     then
-			let
-			   open Layout
-			in
-			   Control.error
-			   (r,
-			    seq [str "type ", lay (),
-				 str " has arity ", Kind.layout k',
-				 str " and cannot be defined to have arity ",
-				 Kind.layout k],
-			    empty)
-			end
-		  else if (admitsEquality s' = AdmitsEquality.Sometimes
-			   andalso admitsEquality s = AdmitsEquality.Never)
-			  then
-			     let
-				open Layout
-			     in
-				Control.error
-				(r,
-				 seq [str "eqtype ", lay (),
-				      str " cannot be defined as a non-equality type"],
-				 empty)
-			     end
-		       else
-			  let
-			     val {defn, hasCons, ...} = FlexibleTycon.fields flex
-			  in
-			     if hasCons
-				andalso
-				(case node s of
-				    Scheme (Scheme.T {ty, tyvars}) =>
-				       Option.isNone
-				       (Type.deEta (expandTy ty, tyvars))
-				  | _ => false)
-				then
-				   let
-				      open Layout
-				   in
-				      Control.error
-				      (r,
-				       seq [str "type ", lay (),
-					    str " is a datatype and cannot be redefined as a complex type"],
-				       empty)
-				   end
-			     else
-				defn := Defn.typeStr s
-			  end
-	       end
+         case getFlex (s', time, "redefined", r, lay) of
+            NONE => ()
+          | SOME flex =>
+               let
+                  val k = kind s
+                  val k' = kind s'
+               in
+                  if not (Kind.equals (k, k'))
+                     then
+                        let
+                           open Layout
+                        in
+                           Control.error
+                           (r,
+                            seq [str "type ", lay (),
+                                 str " has arity ", Kind.layout k',
+                                 str " and cannot be defined to have arity ",
+                                 Kind.layout k],
+                            empty)
+                        end
+                  else if (admitsEquality s' = AdmitsEquality.Sometimes
+                           andalso admitsEquality s = AdmitsEquality.Never)
+                          then
+                             let
+                                open Layout
+                             in
+                                Control.error
+                                (r,
+                                 seq [str "eqtype ", lay (),
+                                      str " cannot be defined as a non-equality type"],
+                                 empty)
+                             end
+                       else
+                          let
+                             val {defn, hasCons, ...} = FlexibleTycon.fields flex
+                          in
+                             if hasCons
+                                andalso
+                                (case node s of
+                                    Scheme (Scheme.T {ty, tyvars}) =>
+                                       Option.isNone
+                                       (Type.deEta (expandTy ty, tyvars))
+                                  | _ => false)
+                                then
+                                   let
+                                      open Layout
+                                   in
+                                      Control.error
+                                      (r,
+                                       seq [str "type ", lay (),
+                                            str " is a datatype and cannot be redefined as a complex type"],
+                                       empty)
+                                   end
+                             else
+                                defn := Defn.typeStr s
+                          end
+               end
 
       val wheree =
-	 Trace.trace ("TypeStr.wheree",
-		      fn (s, _, _, t, s') => Layout.tuple [layout s,
-							   Time.layout t,
-							   layout s'],
-		      Unit.layout)
-	 wheree
+         Trace.trace ("Interface.TypeStr.wheree",
+                      fn (s, _, _, t, s') => Layout.tuple [layout s,
+                                                           Time.layout t,
+                                                           layout s'],
+                      Unit.layout)
+         wheree
    end
 
 structure UniqueId = IntUniqueId ()
@@ -785,35 +787,35 @@
    structure TyconMap =
    struct
       datatype 'a t = T of {strs: (Strid.t * 'a t) array,
-			    types: (Ast.Tycon.t * 'a) array}
+                            types: (Ast.Tycon.t * 'a) array}
 
       fun layout layoutA =
-	 let
-	    open Layout
-	    fun loop (T {strs, types}) =
-	       record [("strs",
-			Array.layout (Layout.tuple2 (Strid.layout, loop)) strs),
-		       ("types",
-			Array.layout (Layout.tuple2 (Ast.Tycon.layout, layoutA))
-			types)]
-	 in
-	    loop
-	 end
-	 
+         let
+            open Layout
+            fun loop (T {strs, types}) =
+               record [("strs",
+                        Array.layout (Layout.tuple2 (Strid.layout, loop)) strs),
+                       ("types",
+                        Array.layout (Layout.tuple2 (Ast.Tycon.layout, layoutA))
+                        types)]
+         in
+            loop
+         end
+         
       fun empty (): 'a t = T {strs = Array.new0 (),
-			      types = Array.new0 ()}
+                              types = Array.new0 ()}
 
       fun isEmpty (T {strs, types}) =
-	 0 = Array.length strs andalso 0 = Array.length types
+         0 = Array.length strs andalso 0 = Array.length types
 
       fun map (tm, f) =
-	 let
-	    fun loop (T {strs, types}) =
-	       T {strs = Array.map (strs, fn (s, tm) => (s, loop tm)),
-		  types = Array.map (types, fn (t, a) => (t, f a))}
-	 in
-	    loop tm
-	 end
+         let
+            fun loop (T {strs, types}) =
+               T {strs = Array.map (strs, fn (s, tm) => (s, loop tm)),
+                  types = Array.map (types, fn (t, a) => (t, f a))}
+         in
+            loop tm
+         end
    end
 
 (*---------------------------------------------------*)
@@ -821,14 +823,14 @@
 (*---------------------------------------------------*)
 
 datatype t = T of {copy: copy,
-		   flexible: FlexibleTycon.t TyconMap.t option ref,
-		   isClosed: bool,
-		   original: t option,
-		   plist: PropertyList.t,
-		   strs: (Strid.t * t) array,
-		   types: (Ast.Tycon.t * TypeStr.t) array,
-		   uniqueId: UniqueId.t,
-		   vals: (Ast.Vid.t * (Status.t * Scheme.t)) array} Set.t
+                   flexible: FlexibleTycon.t TyconMap.t option ref,
+                   isClosed: bool,
+                   original: t option,
+                   plist: PropertyList.t,
+                   strs: (Strid.t * t) array,
+                   types: (Ast.Tycon.t * TypeStr.t) array,
+                   uniqueId: UniqueId.t,
+                   vals: (Ast.Vid.t * (Status.t * Scheme.t)) array} Set.t
 withtype copy = t option ref
 
 fun dest (T s) = Set.! s
@@ -843,41 +845,41 @@
    case #original (dest I) of
       NONE => I
     | SOME I => I
-	 
+         
 fun new {isClosed, strs, types, vals} =
    T (Set.singleton {copy = ref NONE,
-		     flexible = ref NONE,
-		     isClosed = isClosed,
-		     original = NONE,
-		     plist = PropertyList.new (),
-		     strs = strs,
-		     types = types,
-		     uniqueId = UniqueId.new (),
-		     vals = vals})
+                     flexible = ref NONE,
+                     isClosed = isClosed,
+                     original = NONE,
+                     plist = PropertyList.new (),
+                     strs = strs,
+                     types = types,
+                     uniqueId = UniqueId.new (),
+                     vals = vals})
 
 val empty = new {isClosed = true,
-		 strs = Array.new0 (),
-		 types = Array.new0 (),
-		 vals = Array.new0 ()}
+                 strs = Array.new0 (),
+                 types = Array.new0 (),
+                 vals = Array.new0 ()}
 
 local
    open Layout
 in
    fun layout (T s) =
       let
-	 val {strs, types, uniqueId = u, vals, ...} = Set.! s
+         val {strs, types, uniqueId = u, vals, ...} = Set.! s
       in
-	 record [("uniqueId", UniqueId.layout u),
-		 ("strs",
-		  Array.layout (Layout.tuple2 (Strid.layout, layout)) strs),
-		 ("types",
-		  Array.layout (Layout.tuple2 (Ast.Tycon.layout, TypeStr.layout))
-		  types),
-		 ("vals",
-		  Array.layout (Layout.tuple2 (Vid.layout,
-					       Layout.tuple2 (Status.layout,
-							      Scheme.layout)))
-		  vals)]
+         record [("uniqueId", UniqueId.layout u),
+                 ("strs",
+                  Array.layout (Layout.tuple2 (Strid.layout, layout)) strs),
+                 ("types",
+                  Array.layout (Layout.tuple2 (Ast.Tycon.layout, TypeStr.layout))
+                  types),
+                 ("vals",
+                  Array.layout (Layout.tuple2 (Vid.layout,
+                                               Layout.tuple2 (Status.layout,
+                                                              Scheme.layout)))
+                  vals)]
       end
 end
 
@@ -896,9 +898,9 @@
       val {strs, ...} = Set.! s
    in
       Array.peekMap (strs, fn (strid', I) =>
-		     if Strid.equals (strid, strid')
-			then SOME I
-		     else NONE)
+                     if Strid.equals (strid, strid')
+                        then SOME I
+                     else NONE)
    end
 
 datatype 'a peekResult =
@@ -908,12 +910,12 @@
 fun peekStrids (I: t, strids: Strid.t list): t peekResult =
    let
       fun loop (I, strids, ac) =
-	 case strids of
-	    [] => Found I
-	  | strid :: strids =>
-	       case peekStrid (I, strid) of
-		  NONE => UndefinedStructure (rev (strid :: ac))
-		| SOME I => loop (I, strids, strid :: ac)
+         case strids of
+            [] => Found I
+          | strid :: strids =>
+               case peekStrid (I, strid) of
+                  NONE => UndefinedStructure (rev (strid :: ac))
+                | SOME I => loop (I, strids, strid :: ac)
    in
       loop (I, strids, [])
    end
@@ -923,9 +925,9 @@
       val {types, ...} = Set.! s
    in
       Array.peekMap (types, fn (name, typeStr) =>
-		     if Ast.Tycon.equals (tycon, name)
-			then SOME typeStr
-		     else NONE)
+                     if Ast.Tycon.equals (tycon, name)
+                        then SOME typeStr
+                     else NONE)
    end
 
 fun unbound (r: Region.t, className, x: Layout.t): unit =
@@ -940,168 +942,168 @@
    Layout.str (concat (List.separate (List.map (ss, Strid.toString), ".")))
 
 fun lookupLongtycon (I: t, long: Longtycon.t, r: Region.t,
-		     {prefix: Strid.t list}) =
+                     {prefix: Strid.t list}) =
    let
       val (ss, c) = Longtycon.split long
    in
       case peekStrids (I, ss) of
-	 Found I =>
-	    (case peekTycon (I, c) of
-		NONE => 
-		   (unbound (r, "type",
-			     Longtycon.layout (Longtycon.long (prefix @ ss, c)))
-		    ; NONE)
-	      | SOME s => SOME s)
+         Found I =>
+            (case peekTycon (I, c) of
+                NONE => 
+                   (unbound (r, "type",
+                             Longtycon.layout (Longtycon.long (prefix @ ss, c)))
+                    ; NONE)
+              | SOME s => SOME s)
        | UndefinedStructure ss =>
-	    (unbound (r, "structure", layoutStrids (prefix @ ss))
-	     ; NONE)
+            (unbound (r, "structure", layoutStrids (prefix @ ss))
+             ; NONE)
    end
 
 fun share (I: t, ls: Longstrid.t, I': t, ls': Longstrid.t, time): unit =
    let
       fun lay (s, ls, strids, name) =
-	 (s, Longstrid.region ls,
-	  fn () =>
-	  let
-	     val (ss, s) = Longstrid.split ls
-	  in
-	     Ast.Longtycon.layout
-	     (Ast.Longtycon.long (List.concat [ss, [s], rev strids],
-				  name))
-	  end)
+         (s, Longstrid.region ls,
+          fn () =>
+          let
+             val (ss, s) = Longstrid.split ls
+          in
+             Ast.Longtycon.layout
+             (Ast.Longtycon.long (List.concat [ss, [s], rev strids],
+                                  name))
+          end)
       fun ensureFlexible (I: t, strids): unit =
-	 let
-	    val {get: t -> bool ref, destroy, ...} =
-	       Property.destGet (plist, Property.initFun (fn _ => ref false))
-	    fun loop (I: t, strids): unit =
-	       let
-		  val r = get I
-	       in
-		  if !r
-		     then ()
-		  else
-		     let
-			val _ = r := true
-			val T s = I
-			val {strs, types, ...} = Set.! s
-			val _ =
-			   Array.foreach
-			   (strs, fn (strid, I) =>
-			    ensureFlexible (I, strid :: strids))
-			val _ =
-			   Array.foreach
-			   (types, fn (name, s) =>
-			    let
-			       val (_, r, lay) = lay (s, ls, strids, name)
-			       val _ =
-				  TypeStr.getFlex (s, time, "shared", r, lay)
-			    in
-			       ()
-			    end)
-		     in
-			()
-		     end
-	       end
-	    val () = loop (I, strids)
-	    val _ = destroy ()
-	 in
-	    ()
-	 end
+         let
+            val {get: t -> bool ref, destroy, ...} =
+               Property.destGet (plist, Property.initFun (fn _ => ref false))
+            fun loop (I: t, strids): unit =
+               let
+                  val r = get I
+               in
+                  if !r
+                     then ()
+                  else
+                     let
+                        val _ = r := true
+                        val T s = I
+                        val {strs, types, ...} = Set.! s
+                        val _ =
+                           Array.foreach
+                           (strs, fn (strid, I) =>
+                            ensureFlexible (I, strid :: strids))
+                        val _ =
+                           Array.foreach
+                           (types, fn (name, s) =>
+                            let
+                               val (_, r, lay) = lay (s, ls, strids, name)
+                               val _ =
+                                  TypeStr.getFlex (s, time, "shared", r, lay)
+                            in
+                               ()
+                            end)
+                     in
+                        ()
+                     end
+               end
+            val () = loop (I, strids)
+            val _ = destroy ()
+         in
+            ()
+         end
       fun share (I, I', strids): unit = 
-	 if equals (I, I')
-	    then ensureFlexible (I, strids)
-	 else if sameShape (I, I')
-	    then
-	       let
-		  fun loop (T s, T s', strids): unit =
-		     let
-			val {isClosed, strs, types, ...} = Set.! s
-			val {strs = strs', types = types', ...} = Set.! s'
-			val _ =
-			   (* Can't always union here.  I and I' may have
-			    * exactly the same shape, but may have free
-			    * flxible tycons defined in other signatures that
-			    * are different.
-			    * However, if the interface is closed, that is, if
-			    * all of the flexible tycons that appear in it are
-			    * also defined in it, then sharing the structures
-			    * implies that the structures are identical.  This
-			    * also relies on the fact that the structures have
-			    * the same shape, which means that they are copies
-			    * of the same interface.  That is sufficient to
-			    * guarantee that all rigid tycons are identical.
-			    *)
-			   if isClosed
-			      then Set.union (s, s')
-			   else ()
-			val _ =
-			   Array.foreach2
-			   (types, types', fn ((name, s), (_, s')) =>
-			    TypeStr.share (lay (s, ls, strids, name),
-					   lay (s', ls', strids, name),
-					   time))
-			val _ =
-			   Array.foreach2
-			   (strs, strs', fn ((name, I), (_, I')) =>
-			    loop (I, I', name :: strids))
-		     in
-			()
-		     end
-	       in
-		  loop (I, I', strids)
-	       end
-	 else (* different shapes -- need to share pointwise *)
-	    let
-	       val T s = I
-	       val T s' = I'
-	       val {strs, types, ...} = Set.! s
-	       val {strs = strs', types = types', ...} = Set.! s'
-	       fun walk2 (a, a', compareNames, f) =
-		  let
-		     val n = Array.length a
-		     val n' = Array.length a'
-		     fun both (i, i') =
-			if i < n andalso i' < n'
-			   then compare (i, Array.sub (a, i),
-					 i', Array.sub (a', i'))
-			else ()
-		     and compare (i, (name, z), i', (name', z')) =
-			case compareNames (name, name') of
-			   GREATER =>
-			      let
-				 val i' = i' + 1
-			      in
-				 if i' < n'
-				    then compare (i, (name, z),
-						  i', Array.sub (a', i'))
-				 else ()
-			      end
-			 | EQUAL => (f (z, z', name)
-				     ; both (i + 1, i' + 1))
-			 | LESS =>
-			      let
-				 val i = i + 1
-			      in
-				 if i < n
-				    then compare (i, Array.sub (a, i),
-						  i', (name', z'))
-				 else ()
-			      end
-		  in
-		     both (0, 0)
-		  end
-	       val _ =
-		  walk2 (strs, strs', Strid.compare,
-			 fn (I, I', name) => share (I, I', name :: strids))
-	       val _ =
-		  walk2 (types, types', Ast.Tycon.compare,
-			 fn (s, s', name) =>
-			 TypeStr.share (lay (s, ls, strids, name),
-					lay (s', ls', strids, name),
-					time))
-	    in
-	       ()
-	    end
+         if equals (I, I')
+            then ensureFlexible (I, strids)
+         else if sameShape (I, I')
+            then
+               let
+                  fun loop (T s, T s', strids): unit =
+                     let
+                        val {isClosed, strs, types, ...} = Set.! s
+                        val {strs = strs', types = types', ...} = Set.! s'
+                        val _ =
+                           (* Can't always union here.  I and I' may have
+                            * exactly the same shape, but may have free
+                            * flxible tycons defined in other signatures that
+                            * are different.
+                            * However, if the interface is closed, that is, if
+                            * all of the flexible tycons that appear in it are
+                            * also defined in it, then sharing the structures
+                            * implies that the structures are identical.  This
+                            * also relies on the fact that the structures have
+                            * the same shape, which means that they are copies
+                            * of the same interface.  That is sufficient to
+                            * guarantee that all rigid tycons are identical.
+                            *)
+                           if isClosed
+                              then Set.union (s, s')
+                           else ()
+                        val _ =
+                           Array.foreach2
+                           (types, types', fn ((name, s), (_, s')) =>
+                            TypeStr.share (lay (s, ls, strids, name),
+                                           lay (s', ls', strids, name),
+                                           time))
+                        val _ =
+                           Array.foreach2
+                           (strs, strs', fn ((name, I), (_, I')) =>
+                            loop (I, I', name :: strids))
+                     in
+                        ()
+                     end
+               in
+                  loop (I, I', strids)
+               end
+         else (* different shapes -- need to share pointwise *)
+            let
+               val T s = I
+               val T s' = I'
+               val {strs, types, ...} = Set.! s
+               val {strs = strs', types = types', ...} = Set.! s'
+               fun walk2 (a, a', compareNames, f: 'a * 'a * 'b -> unit) =
+                  let
+                     val n = Array.length a
+                     val n' = Array.length a'
+                     fun both (i, i') =
+                        if i < n andalso i' < n'
+                           then compare (i, Array.sub (a, i),
+                                         i', Array.sub (a', i'))
+                        else ()
+                     and compare (i, (name, z), i', (name', z')) =
+                        case compareNames (name, name') of
+                           GREATER =>
+                              let
+                                 val i' = i' + 1
+                              in
+                                 if i' < n'
+                                    then compare (i, (name, z),
+                                                  i', Array.sub (a', i'))
+                                 else ()
+                              end
+                         | EQUAL => (f (z, z', name)
+                                     ; both (i + 1, i' + 1))
+                         | LESS =>
+                              let
+                                 val i = i + 1
+                              in
+                                 if i < n
+                                    then compare (i, Array.sub (a, i),
+                                                  i', (name', z'))
+                                 else ()
+                              end
+                  in
+                     both (0, 0)
+                  end
+               val _ =
+                  walk2 (strs, strs', Strid.compare,
+                         fn (I, I', name) => share (I, I', name :: strids))
+               val _ =
+                  walk2 (types, types', Ast.Tycon.compare,
+                         fn (s, s', name) =>
+                         TypeStr.share (lay (s, ls, strids, name),
+                                        lay (s', ls', strids, name),
+                                        time))
+            in
+               ()
+            end
    in
       share (I, I', [])
    end
@@ -1121,41 +1123,41 @@
        *)
       val copies: copy list ref = ref []
       fun loop (I as T s): t =
-	 let
-	    val r as {copy, ...} = Set.! s
-	 in
-	    case !copy of
-	       NONE =>
-		  let
-		     val {isClosed, original, strs, types, vals, ...} = r
-		     val types =
-			Array.map (types, fn (name, typeStr) =>
-				   (name, TypeStr.copy typeStr))
-		     val vals =
-			Array.map (vals, fn (name, (status, scheme)) =>
-				   (name, (status, Scheme.copy scheme)))
-		     val strs =
-			Array.map (strs, fn (name, I) => (name, loop I))
-		     val original =
-			SOME (case original of
-				 NONE => I
-			       | SOME I => I)
-		     val I = T (Set.singleton {copy = ref NONE,
-					       flexible = ref NONE,
-					       isClosed = isClosed,
-					       original = original,
-					       plist = PropertyList.new (),
-					       strs = strs,
-					       types = types,
-					       uniqueId = UniqueId.new (),
-					       vals = vals})
-		     val _ = List.push (copies, copy)
-		     val _ = copy := SOME I
-		  in
-		     I
-		  end
-	     | SOME I => I
-	 end
+         let
+            val r as {copy, ...} = Set.! s
+         in
+            case !copy of
+               NONE =>
+                  let
+                     val {isClosed, original, strs, types, vals, ...} = r
+                     val types =
+                        Array.map (types, fn (name, typeStr) =>
+                                   (name, TypeStr.copy typeStr))
+                     val vals =
+                        Array.map (vals, fn (name, (status, scheme)) =>
+                                   (name, (status, Scheme.copy scheme)))
+                     val strs =
+                        Array.map (strs, fn (name, I) => (name, loop I))
+                     val original =
+                        SOME (case original of
+                                 NONE => I
+                               | SOME I => I)
+                     val I = T (Set.singleton {copy = ref NONE,
+                                               flexible = ref NONE,
+                                               isClosed = isClosed,
+                                               original = original,
+                                               plist = PropertyList.new (),
+                                               strs = strs,
+                                               types = types,
+                                               uniqueId = UniqueId.new (),
+                                               vals = vals})
+                     val _ = List.push (copies, copy)
+                     val _ = copy := SOME I
+                  in
+                     I
+                  end
+             | SOME I => I
+         end
       val I = loop I
       fun clear copies = List.foreach (!copies, fn copy => copy := NONE)
       val _ = clear copies
@@ -1170,79 +1172,79 @@
 fun flexibleTycons (I: t): FlexibleTycon.t TyconMap.t =
    let
       val {destroy = destroy1,
-	   get = tyconShortest: (FlexibleTycon.t
-				 -> {flex: FlexibleTycon.t option ref,
-				     length: int} ref), ...} =
-	 Property.destGet (FlexibleTycon.plist,
-			   Property.initFun (fn _ => ref {flex = ref NONE,
-							  length = Int.maxInt}))
+           get = tyconShortest: (FlexibleTycon.t
+                                 -> {flex: FlexibleTycon.t option ref,
+                                     length: int} ref), ...} =
+         Property.destGet (FlexibleTycon.plist,
+                           Property.initFun (fn _ => ref {flex = ref NONE,
+                                                          length = Int.maxInt}))
       val {destroy = destroy2,
-	   get = interfaceShortest: t -> int ref, ...} =
-	 Property.destGet (plist, Property.initFun (fn _ => ref Int.maxInt))
+           get = interfaceShortest: t -> int ref, ...} =
+         Property.destGet (plist, Property.initFun (fn _ => ref Int.maxInt))
       fun loop (I: t, length: int): FlexibleTycon.t option ref TyconMap.t =
-	 let
-	    val r = interfaceShortest I
-	 in
-	    if length >= !r
-	       then TyconMap.empty ()
-	    else
-	       let
-		  val _ = r := length
-		  val {strs, types, ...} = dest I
-		  val types =
-		     Array.map
-		     (types, fn (tycon, typeStr) =>
-		      (tycon,
-		       case TypeStr.toTyconOpt typeStr of
-			  SOME (Tycon.Flexible (c as FlexibleTycon.T s)) =>
-			     let
-				val {defn, ...} = Set.! s
-			     in
-				case Defn.dest (!defn) of
-				   Defn.Undefined =>
-				      let
-					 val r = tyconShortest c
-				      in
-					 if length >= #length (!r)
-					    then ref NONE
-					 else 
-					    let
-					       val _ = #flex (!r) := NONE
-					       val flex = ref (SOME c)
-					       val _ = r := {flex = flex,
-							     length = length}
-					    in
-					       flex
-					    end
-				      end
-				 | _ => ref NONE
-			     end
-			| _ => ref NONE))
-		  val strs =
-		     Array.map (strs, fn (s, I) => (s, loop (I, 1 + length)))
-	       in
-		  TyconMap.T {strs = strs, types = types}
-	       end
-	 end
+         let
+            val r = interfaceShortest I
+         in
+            if length >= !r
+               then TyconMap.empty ()
+            else
+               let
+                  val _ = r := length
+                  val {strs, types, ...} = dest I
+                  val types =
+                     Array.map
+                     (types, fn (tycon, typeStr) =>
+                      (tycon,
+                       case TypeStr.toTyconOpt typeStr of
+                          SOME (Tycon.Flexible (c as FlexibleTycon.T s)) =>
+                             let
+                                val {defn, ...} = Set.! s
+                             in
+                                case Defn.dest (!defn) of
+                                   Defn.Undefined =>
+                                      let
+                                         val r = tyconShortest c
+                                      in
+                                         if length >= #length (!r)
+                                            then ref NONE
+                                         else 
+                                            let
+                                               val _ = #flex (!r) := NONE
+                                               val flex = ref (SOME c)
+                                               val _ = r := {flex = flex,
+                                                             length = length}
+                                            in
+                                               flex
+                                            end
+                                      end
+                                 | _ => ref NONE
+                             end
+                        | _ => ref NONE))
+                  val strs =
+                     Array.map (strs, fn (s, I) => (s, loop (I, 1 + length)))
+               in
+                  TyconMap.T {strs = strs, types = types}
+               end
+         end
       val tm = loop (I, 0)
       val _ = (destroy1 (); destroy2 ())
       fun collapse (tm: FlexibleTycon.t option ref TyconMap.t)
-	 : FlexibleTycon.t TyconMap.t =
-	 let
-	    val TyconMap.T {strs, types} = tm
-	    val types = Array.keepAllMap (types, fn (c, r) =>
-					  Option.map (!r, fn f => (c, f)))
-	    val strs = Array.keepAllMap (strs, fn (s, m) =>
-					 let
-					    val m = collapse m
-					 in
-					    if TyconMap.isEmpty m
-					       then NONE
-					    else SOME (s, m)
-					 end)
-	 in
-	    TyconMap.T {strs = strs, types = types}
-	 end
+         : FlexibleTycon.t TyconMap.t =
+         let
+            val TyconMap.T {strs, types} = tm
+            val types = Array.keepAllMap (types, fn (c, r) =>
+                                          Option.map (!r, fn f => (c, f)))
+            val strs = Array.keepAllMap (strs, fn (s, m) =>
+                                         let
+                                            val m = collapse m
+                                         in
+                                            if TyconMap.isEmpty m
+                                               then NONE
+                                            else SOME (s, m)
+                                         end)
+         in
+            TyconMap.T {strs = strs, types = types}
+         end
    in
       collapse tm
    end
@@ -1253,19 +1255,19 @@
       val {flexible, ...} = Set.! s
    in
       case !flexible of
-	 NONE =>
-	    let
-	       val f = flexibleTycons I
-	       val _ = flexible := SOME f
-	    in
-	       f
-	    end
+         NONE =>
+            let
+               val f = flexibleTycons I
+               val _ = flexible := SOME f
+            in
+               f
+            end
        | SOME f => f
    end
 
 val flexibleTycons =
    Trace.trace ("Interface.flexibleTycons", layout,
-		TyconMap.layout FlexibleTycon.layout)
+                TyconMap.layout FlexibleTycon.layout)
    flexibleTycons
 
 fun dest (T s) =

Modified: mlton/branches/on-20050420-cmm-branch/mlton/elaborate/interface.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/elaborate/interface.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/elaborate/interface.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,34 +1,35 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature INTERFACE_STRUCTS = 
    sig
       structure Ast: AST
       structure EnvTypeStr:
-	 sig
-	    structure AdmitsEquality: ADMITS_EQUALITY
-	    structure Kind: TYCON_KIND
-	    structure Tycon:
-	       sig
-		  type t
+         sig
+            structure AdmitsEquality: ADMITS_EQUALITY
+            structure Kind: TYCON_KIND
+            structure Tycon:
+               sig
+                  type t
 
-		  val admitsEquality: t -> AdmitsEquality.t ref
-		  val arrow: t
-		  val equals: t * t -> bool
-		  val exn: t
-		  val layout: t -> Layout.t
-		  val layoutApp:
-		     t * (Layout.t * {isChar: bool, needsParen: bool}) vector
-		     -> Layout.t * {isChar: bool, needsParen: bool}
-		  val tuple: t
-	       end
+                  val admitsEquality: t -> AdmitsEquality.t ref
+                  val arrow: t
+                  val equals: t * t -> bool
+                  val exn: t
+                  val layout: t -> Layout.t
+                  val layoutApp:
+                     t * (Layout.t * {isChar: bool, needsParen: bool}) vector
+                     -> Layout.t * {isChar: bool, needsParen: bool}
+                  val tuple: t
+               end
 
-	    type t
-	 end
+            type t
+         end
    end
 
 signature INTERFACE = 
@@ -39,145 +40,145 @@
       sharing AdmitsEquality = EnvTypeStr.AdmitsEquality
       structure Kind: TYCON_KIND
       sharing Kind = EnvTypeStr.Kind
-	 
+         
       structure FlexibleTycon:
-	 sig
-	    type typeStr
-	    type t
+         sig
+            type typeStr
+            type t
 
-	    val dest: t -> {admitsEquality: AdmitsEquality.t,
-			    hasCons: bool,
-			    kind: Kind.t}
-	    val layout: t -> Layout.t
-	    val realize: t * EnvTypeStr.t option -> unit
-	    datatype realization =
-	       ETypeStr of EnvTypeStr.t option
-	     | TypeStr of typeStr
-	    val realization: t -> realization
-	 end
+            val dest: t -> {admitsEquality: AdmitsEquality.t,
+                            hasCons: bool,
+                            kind: Kind.t}
+            val layout: t -> Layout.t
+            val realize: t * EnvTypeStr.t option -> unit
+            datatype realization =
+               ETypeStr of EnvTypeStr.t option
+             | TypeStr of typeStr
+            val realization: t -> realization
+         end
       structure Tycon:
-	 sig
-	    datatype t =
-	       Flexible of FlexibleTycon.t
-	     | Rigid of EnvTypeStr.Tycon.t * Kind.t
+         sig
+            datatype t =
+               Flexible of FlexibleTycon.t
+             | Rigid of EnvTypeStr.Tycon.t * Kind.t
 
-	    val admitsEquality: t -> AdmitsEquality.t ref
-	    val make: {hasCons: bool, kind: Kind.t} -> t
-	 end
+            val admitsEquality: t -> AdmitsEquality.t ref
+            val make: {hasCons: bool, kind: Kind.t} -> t
+         end
       structure Tyvar:
-	 sig
-	    type t
-	 end
+         sig
+            type t
+         end
       sharing Tyvar = Ast.Tyvar
       structure Record: RECORD
       sharing Record = Ast.SortedRecord
       structure Type:
-	 sig
-	    type t
+         sig
+            type t
 
-	    val arrow: t * t -> t
-	    val bogus: t
-	    val con: Tycon.t * t vector -> t
-	    val deArrow: t -> t * t
-	    val deEta: t * Tyvar.t vector -> Tycon.t option
-	    val exn: t
-	    val hom: t * {con: Tycon.t * 'a vector -> 'a,
-			  record: 'a Record.t -> 'a,
-			  var: Tyvar.t -> 'a} -> 'a
-	    val layout: t -> Layout.t
-	    val record: t Record.t -> t
-	    val var: Tyvar.t -> t
-	 end
+            val arrow: t * t -> t
+            val bogus: t
+            val con: Tycon.t * t vector -> t
+            val deArrow: t -> t * t
+            val deEta: t * Tyvar.t vector -> Tycon.t option
+            val exn: t
+            val hom: t * {con: Tycon.t * 'a vector -> 'a,
+                          record: 'a Record.t -> 'a,
+                          var: Tyvar.t -> 'a} -> 'a
+            val layout: t -> Layout.t
+            val record: t Record.t -> t
+            val var: Tyvar.t -> t
+         end
       structure Status:
-	 sig
-	    datatype t = Con | Exn | Var
-	       
-	    val layout: t -> Layout.t
-	    val toString: t -> string
-	 end
+         sig
+            datatype t = Con | Exn | Var
+               
+            val layout: t -> Layout.t
+            val toString: t -> string
+         end
       structure Time:
-	 sig
-	    type t
+         sig
+            type t
 
-	    val tick: unit -> t
-	 end
+            val tick: unit -> t
+         end
       structure Scheme:
-	 sig
-	    datatype t = T of {ty: Type.t,
-			       tyvars: Tyvar.t vector}
+         sig
+            datatype t = T of {ty: Type.t,
+                               tyvars: Tyvar.t vector}
 
-	    val admitsEquality: t -> bool
-	    val make: Tyvar.t vector * Type.t -> t
-	    val ty: t -> Type.t
-	 end
+            val admitsEquality: t -> bool
+            val make: Tyvar.t vector * Type.t -> t
+            val ty: t -> Type.t
+         end
       structure Cons:
-	 sig
-	    datatype t = T of {name: Ast.Con.t,
-			       scheme: Scheme.t} vector
-	       
-	    val empty: t
-	    val layout: t -> Layout.t
-	 end
+         sig
+            datatype t = T of {name: Ast.Con.t,
+                               scheme: Scheme.t} vector
+               
+            val empty: t
+            val layout: t -> Layout.t
+         end
       structure TypeStr:
-	 sig
-	    type t
+         sig
+            type t
 
-	    datatype node =
-	       Datatype of {cons: Cons.t,
-			    tycon: Tycon.t}
-	     | Scheme of Scheme.t
-	     | Tycon of Tycon.t
+            datatype node =
+               Datatype of {cons: Cons.t,
+                            tycon: Tycon.t}
+             | Scheme of Scheme.t
+             | Tycon of Tycon.t
 
-	    val abs: t -> t
-	    val admitsEquality: t -> AdmitsEquality.t
-	    val apply: t * Type.t vector -> Type.t
-	    val bogus: Kind.t -> t
-	    val cons: t -> Cons.t
-	    val data: Tycon.t * Kind.t * Cons.t -> t
-	    val def: Scheme.t * Kind.t -> t
-	    val kind: t -> Kind.t
-	    val layout: t -> Layout.t
-	    val node: t -> node
-	    val toTyconOpt: t -> Tycon.t option (* NONE on Scheme *)
-	    val tycon: Tycon.t * Kind.t -> t
-	    val share:
-	       (t * Region.t * (unit -> Layout.t))
-	       * (t * Region.t * (unit -> Layout.t))
-	       * Time.t
-	       -> unit
-	    val wheree: t * Region.t * (unit -> Layout.t) * Time.t * t -> unit
-	 end
+            val abs: t -> t
+            val admitsEquality: t -> AdmitsEquality.t
+            val apply: t * Type.t vector -> Type.t
+            val bogus: Kind.t -> t
+            val cons: t -> Cons.t
+            val data: Tycon.t * Kind.t * Cons.t -> t
+            val def: Scheme.t * Kind.t -> t
+            val kind: t -> Kind.t
+            val layout: t -> Layout.t
+            val node: t -> node
+            val toTyconOpt: t -> Tycon.t option (* NONE on Scheme *)
+            val tycon: Tycon.t * Kind.t -> t
+            val share:
+               (t * Region.t * (unit -> Layout.t))
+               * (t * Region.t * (unit -> Layout.t))
+               * Time.t
+               -> unit
+            val wheree: t * Region.t * (unit -> Layout.t) * Time.t * t -> unit
+         end
       sharing type FlexibleTycon.typeStr = TypeStr.t
       structure TyconMap:
-	 sig
-	    datatype 'a t = T of {strs: (Ast.Strid.t * 'a t) array,
-				  types: (Ast.Tycon.t * 'a) array}
+         sig
+            datatype 'a t = T of {strs: (Ast.Strid.t * 'a t) array,
+                                  types: (Ast.Tycon.t * 'a) array}
 
-	    val layout: ('a -> Layout.t) -> 'a t -> Layout.t
-	    val map: 'a t * ('a -> 'b) -> 'b t
-	 end
+            val layout: ('a -> Layout.t) -> 'a t -> Layout.t
+            val map: 'a t * ('a -> 'b) -> 'b t
+         end
 
       type t
       
       val copy: t -> t (* copy renames all flexible tycons. *)
       val equals: t * t -> bool
       val dest: t -> {strs: (Ast.Strid.t * t) array,
-		      types: (Ast.Tycon.t * TypeStr.t) array,
-		      vals: (Ast.Vid.t * (Status.t * Scheme.t)) array}
+                      types: (Ast.Tycon.t * TypeStr.t) array,
+                      vals: (Ast.Vid.t * (Status.t * Scheme.t)) array}
       val empty: t
       val flexibleTycons: t -> FlexibleTycon.t TyconMap.t
       val layout: t -> Layout.t
       val lookupLongtycon:
-	 t * Ast.Longtycon.t * Region.t * {prefix: Ast.Strid.t list}
-	 -> TypeStr.t option
+         t * Ast.Longtycon.t * Region.t * {prefix: Ast.Strid.t list}
+         -> TypeStr.t option
       val new: {isClosed: bool,
-		strs: (Ast.Strid.t * t) array,
-		types: (Ast.Tycon.t * TypeStr.t) array,
-		vals: (Ast.Vid.t * (Status.t * Scheme.t)) array} -> t
+                strs: (Ast.Strid.t * t) array,
+                types: (Ast.Tycon.t * TypeStr.t) array,
+                vals: (Ast.Vid.t * (Status.t * Scheme.t)) array} -> t
       val original: t -> t
       val peekStrid: t * Ast.Strid.t -> t option
       datatype 'a peekResult =
-	 Found of 'a
+         Found of 'a
        | UndefinedStructure of Ast.Strid.t list
       val peekStrids: t * Ast.Strid.t list -> t peekResult
       val peekTycon: t * Ast.Tycon.t -> TypeStr.t option

Modified: mlton/branches/on-20050420-cmm-branch/mlton/elaborate/precedence-parse.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/elaborate/precedence-parse.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/elaborate/precedence-parse.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -22,30 +22,30 @@
       datatype t = Nonfix | Infix of int * int
 
       fun eval (f: Fixity.t): t =
-	 case f of
-	    Fixity.Infix NONE => Infix (0, 1)
-	  | Fixity.Infix (SOME n) => Infix (n+n, n+n+1)
-	  | Fixity.Infixr NONE => Infix (1, 0)
-	  | Fixity.Infixr (SOME n) => Infix (n+n+1, n+n)
-	  | Fixity.Nonfix => Nonfix
+         case f of
+            Fixity.Infix NONE => Infix (0, 1)
+          | Fixity.Infix (SOME n) => Infix (n+n, n+n+1)
+          | Fixity.Infixr NONE => Infix (1, 0)
+          | Fixity.Infixr (SOME n) => Infix (n+n+1, n+n)
+          | Fixity.Nonfix => Nonfix
 
       fun make ({name: Longvid.t, fixop: Fixop.t}, E: Env.t): t =
-	 case (fixop, Longvid.split name) of
-	    (Fixop.None, ([], vid)) =>
-	       (case Env.peekFix (E, vid) of
-		   NONE => Nonfix
-		 | SOME f => eval f)
-	  | _ => Nonfix
+         case (fixop, Longvid.split name) of
+            (Fixop.None, ([], vid)) =>
+               (case Env.peekFix (E, vid) of
+                   NONE => Nonfix
+                 | SOME f => eval f)
+          | _ => Nonfix
 
       fun makePat (p: Pat.t, E: Env.t): t =
-	 case Pat.node p of
-	    Pat.Var r => make (r, E)
-	  | _ => Nonfix
+         case Pat.node p of
+            Pat.Var r => make (r, E)
+          | _ => Nonfix
 
       fun makeExp (e: Exp.t, E: Env.t): t =
-	 case Exp.node e of
-	    Exp.Var r => make (r, E)
-	  | _ => Nonfix
+         case Exp.node e of
+            Exp.Var r => make (r, E)
+          | _ => Nonfix
    end
 
 (*---------------------------------------------------*)
@@ -58,125 +58,125 @@
  | NILf
    
 fun 'a parse {apply: 'a * 'a -> 'a,
-	      fixval: 'a -> Fixval.t,
-	      items: 'a vector,
-	      lay: unit -> Layout.t,
-	      name: string,
-	      region: 'a -> Region.t,
-	      toString: 'a -> string,
-	      tuple: 'a vector -> 'a}: 'a =
+              fixval: 'a -> Fixval.t,
+              items: 'a vector,
+              lay: unit -> Layout.t,
+              name: string,
+              region: 'a -> Region.t,
+              toString: 'a -> string,
+              tuple: 'a vector -> 'a}: 'a =
    let
       fun error (r: Region.t, msg: string) =
-	 Control.error (r, Layout.str msg, lay ())
+         Control.error (r, Layout.str msg, lay ())
       fun ensureNONf ((e, f), p) =
-	 let
-	    val _ =
-	       case f of
-		  Fixval.Nonfix => ()
-		| _ =>
-		     Control.error
-		     (region e,
-		      Layout.str (concat ["identifier must be used infix: ",
-					  toString e]),
-		      lay ())
-	 in
-	    NONf (e, p)
-	 end
+         let
+            val _ =
+               case f of
+                  Fixval.Nonfix => ()
+                | _ =>
+                     Control.error
+                     (region e,
+                      Layout.str (concat ["identifier must be used infix: ",
+                                          toString e]),
+                      lay ())
+         in
+            NONf (e, p)
+         end
       fun start token = ensureNONf (token, NILf)
       (* parse an expression *)
       fun parse (stack: 'a precStack, (item: 'a, fixval: Fixval.t)) =
-	 case (stack, (item, fixval)) of
-	    (NONf (e, r), (e', Fixval.Nonfix)) => NONf (apply (e, e'), r)
-	  | (p as INf _, token) => ensureNONf (token, p)
-	  | (p as NONf (e1, INf (bp, e2, NONf (e3, r))),
-	     (e4, f as Fixval.Infix (lbp, rbp))) =>
-	    if lbp > bp then INf (rbp, e4, p)
-	    else (if lbp = bp
-		     then error (region e1,
-				 "operators of same precedence with mixed associativity")
-		  else ();
-		  parse (NONf (apply (e2, tuple (Vector.new2 (e3, e1))),
-			       r),
-			 (e4, f)))
-	   | (p as NONf _, (e', Fixval.Infix (_, rbp))) => INf (rbp, e', p)
-	   | _ => Error.bug "Precedence.parse"
+         case (stack, (item, fixval)) of
+            (NONf (e, r), (e', Fixval.Nonfix)) => NONf (apply (e, e'), r)
+          | (p as INf _, token) => ensureNONf (token, p)
+          | (p as NONf (e1, INf (bp, e2, NONf (e3, r))),
+             (e4, f as Fixval.Infix (lbp, rbp))) =>
+            if lbp > bp then INf (rbp, e4, p)
+            else (if lbp = bp
+                     then error (region e1,
+                                 "operators of same precedence with mixed associativity")
+                  else ();
+                  parse (NONf (apply (e2, tuple (Vector.new2 (e3, e1))),
+                               r),
+                         (e4, f)))
+           | (p as NONf _, (e', Fixval.Infix (_, rbp))) => INf (rbp, e', p)
+           | _ => Error.bug "PrecedenceParse.parse.parse"
       (* clean up the stack *)
       fun finish stack =
-	 case stack of
-	    NONf (e1, INf (_, e2, NONf (e3, r))) =>
-	       finish (NONf (apply (e2, tuple (Vector.new2 (e3, e1))),
-			     r))
-	  | NONf (e1, NILf) => e1
-	  | INf (_, e1, NONf (e2, p)) =>
-	       (error (region e1, concat [name, " ends with infix identifier"])
-		; finish (NONf (apply (e2, e1), p)))
-	  | NILf => Error.bug "Corelang.finish NILf"
-	  | _ => Error.bug "Corelang.finish"
+         case stack of
+            NONf (e1, INf (_, e2, NONf (e3, r))) =>
+               finish (NONf (apply (e2, tuple (Vector.new2 (e3, e1))),
+                             r))
+          | NONf (e1, NILf) => e1
+          | INf (_, e1, NONf (e2, p)) =>
+               (error (region e1, concat [name, " ends with infix identifier"])
+                ; finish (NONf (apply (e2, e1), p)))
+          | NILf => Error.bug "PrecedenceParse.parse.finish: NILf"
+          | _ => Error.bug "PrecedenceParse.parse.finish"
       fun getfix x = (x, fixval x)
    in
       if Vector.isEmpty items
-	 then
-	    Error.bug "parse"
+         then
+            Error.bug "PrecedenceParse.parse"
       else
-	 let
-	    val item = Vector.sub (items, 0)
-	 in
-	    finish (Vector.foldFrom
-		    (items, 1, start (getfix item), fn (item, state) =>
-		     parse (state, getfix item)))
-	 end
+         let
+            val item = Vector.sub (items, 0)
+         in
+            finish (Vector.foldFrom
+                    (items, 1, start (getfix item), fn (item, state) =>
+                     parse (state, getfix item)))
+         end
    end
 
 fun parsePat (ps, E, lay) =
    let
       fun apply (p1, p2) =
-	 case Pat.node p1 of
-	    Pat.Var {name, ...} =>
-	       Pat.makeRegion (Pat.App (Longvid.toLongcon name, p2),
-			       Region.append (Pat.region p1,
-					      Pat.region p2))
-	  | _ =>
-	       let
-		  open Layout
-		  val () =
-		     Control.error
-		     (Pat.region p1,
-		      str "non-constructor applied to argument in pattern",
-		      seq [str "in: ", Pat.layout p1, str " ", Pat.layout p2])
-	       in
-		  Pat.wild
-	       end
+         case Pat.node p1 of
+            Pat.Var {name, ...} =>
+               Pat.makeRegion (Pat.App (Longvid.toLongcon name, p2),
+                               Region.append (Pat.region p1,
+                                              Pat.region p2))
+          | _ =>
+               let
+                  open Layout
+                  val () =
+                     Control.error
+                     (Pat.region p1,
+                      str "non-constructor applied to argument in pattern",
+                      seq [str "in: ", Pat.layout p1, str " ", Pat.layout p2])
+               in
+                  Pat.wild
+               end
    in
       parse {apply = apply,
-	     fixval = fn p => Fixval.makePat (p, E),
-	     items = ps,
-	     lay = lay,
-	     name = "pattern",
-	     region = Pat.region,
-	     toString = Layout.toString o Pat.layout,
-	     tuple = Pat.tuple}
+             fixval = fn p => Fixval.makePat (p, E),
+             items = ps,
+             lay = lay,
+             name = "pattern",
+             region = Pat.region,
+             toString = Layout.toString o Pat.layout,
+             tuple = Pat.tuple}
    end
 
 val parsePat =
-   Trace.trace ("parsePat",
-		fn (ps, _, _) => Vector.layout Pat.layout ps,
-		Ast.Pat.layout)
+   Trace.trace ("PrecedenceParse.parsePat",
+                fn (ps, _, _) => Vector.layout Pat.layout ps,
+                Ast.Pat.layout)
    parsePat
 
 fun parseExp (es, E, lay) =
    parse {apply = Exp.app,
-	  fixval = fn e => Fixval.makeExp (e, E),
-	  items = es,
-	  lay = lay,
-	  name = "expression",
-	  region = Exp.region,
-	  toString = Layout.toString o Exp.layout,
-	  tuple = Exp.tuple}
+          fixval = fn e => Fixval.makeExp (e, E),
+          items = es,
+          lay = lay,
+          name = "expression",
+          region = Exp.region,
+          toString = Layout.toString o Exp.layout,
+          tuple = Exp.tuple}
 
 val parseExp =
-   Trace.trace ("parseExp",
-		fn (es, _, _) => Vector.layout Exp.layout es,
-		Ast.Exp.layout)
+   Trace.trace ("PrecedenceParse.parseExp",
+                fn (es, _, _) => Vector.layout Exp.layout es,
+                Ast.Exp.layout)
    parseExp
 
 (*---------------------------------------------------*)
@@ -187,50 +187,50 @@
    let
       val pats = Vector.toList pats
       fun error msg =
-	 (Control.error (region, msg, lay ())
-	  ; {func = Ast.Var.bogus,
-	     args = Vector.new0 ()})
+         (Control.error (region, msg, lay ())
+          ; {func = Ast.Var.bogus,
+             args = Vector.new0 ()})
       fun done (func: Pat.t, args: Pat.t list) =
-	 let
-	    fun illegal () =
-	       error (Layout.seq [Layout.str "illegal function symbol: ",
-				  Pat.layout func])
-	 in
-	    case Pat.node func of
-	       Pat.Var {name, ...} =>
-		  (case Longvid.split name of
-		      ([], x) => {func = Vid.toVar x,
-				  args = Vector.fromList args}
-		    | _ => illegal ())
-	     | _ => illegal ()
-	 end
+         let
+            fun illegal () =
+               error (Layout.seq [Layout.str "illegal function symbol: ",
+                                  Pat.layout func])
+         in
+            case Pat.node func of
+               Pat.Var {name, ...} =>
+                  (case Longvid.split name of
+                      ([], x) => {func = Vid.toVar x,
+                                  args = Vector.fromList args}
+                    | _ => illegal ())
+             | _ => illegal ()
+         end
       val tuple = Pat.tuple o Vector.new2
       fun parse (ps : Pat.t list) =
-	 case ps of
-	    p :: rest =>
-	       let
-		  fun continue () =
-		     case rest of
-			[] => error (Layout.str "function with no arguments")
-		      | _ => done (p, rest)
-	       in
-		  case Pat.node p of
-		     Pat.FlatApp ps =>
-			if 3 = Vector.length ps
-			   then
-			      let
-				 fun p i = Vector.sub (ps, i)
-			      in done (p 1, tuple (p 0, p 2) :: rest)
-			      end
-			else continue ()
-		   | _ => continue ()
-	       end
-	  | _ => Error.bug "empty clause"
+         case ps of
+            p :: rest =>
+               let
+                  fun continue () =
+                     case rest of
+                        [] => error (Layout.str "function with no arguments")
+                      | _ => done (p, rest)
+               in
+                  case Pat.node p of
+                     Pat.FlatApp ps =>
+                        if 3 = Vector.length ps
+                           then
+                              let
+                                 fun p i = Vector.sub (ps, i)
+                              in done (p 1, tuple (p 0, p 2) :: rest)
+                              end
+                        else continue ()
+                   | _ => continue ()
+               end
+          | _ => Error.bug "PrecedenceParse.parseClause: empty"
    in
       case pats of
-	 [a, b, c] => (case Fixval.makePat (b, E) of
-			  Fixval.Nonfix => parse pats
-			| _ => done (b, [tuple (a, c)]))
+         [a, b, c] => (case Fixval.makePat (b, E) of
+                          Fixval.Nonfix => parse pats
+                        | _ => done (b, [tuple (a, c)]))
        | _ => parse pats
    end
     

Modified: mlton/branches/on-20050420-cmm-branch/mlton/elaborate/precedence-parse.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/elaborate/precedence-parse.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/elaborate/precedence-parse.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 type int = Int.t
    
 signature PRECEDENCE_PARSE_STRUCTS =
@@ -19,9 +20,9 @@
       include PRECEDENCE_PARSE_STRUCTS
 
       val parseClause:
-	 Ast.Pat.t vector * Env.t * Region.t * (unit -> Layout.t)
-	 -> {args: Ast.Pat.t vector,
-	     func: Ast.Var.t}
+         Ast.Pat.t vector * Env.t * Region.t * (unit -> Layout.t)
+         -> {args: Ast.Pat.t vector,
+             func: Ast.Var.t}
       val parseExp: Ast.Exp.t vector * Env.t * (unit -> Layout.t) -> Ast.Exp.t
       val parsePat: Ast.Pat.t vector * Env.t * (unit -> Layout.t) -> Ast.Pat.t
    end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/elaborate/scope.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/elaborate/scope.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/elaborate/scope.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2003 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 functor Scope (S: SCOPE_STRUCTS): SCOPE =
 struct
 
@@ -15,7 +16,7 @@
 structure Env =
    struct
       structure Env = MonoEnv (structure Domain = UseName (Tyvar)
-			       structure Range = Tyvar)
+                               structure Range = Tyvar)
       open Env
 
       (* rename (env, tyvars) extends env by mapping each tyvar to
@@ -23,409 +24,443 @@
        * the extended environment and the list of new tyvars.
        *)
       fun rename (env: t, tyvars: Tyvar.t vector): t * Tyvar.t vector =
-	 let
-	    val (tyvars, env) =
-	       Vector.mapAndFold
-	       (tyvars, env, fn (a, env) =>
-		let
-		   val a' = Tyvar.newLike a
-		in
-		   (a', extend (env, a, a'))
-		end)
-	 in
-	    (env, tyvars)
-	 end
+         let
+            val (tyvars, env) =
+               Vector.mapAndFold
+               (tyvars, env, fn (a, env) =>
+                let
+                   val a' = Tyvar.newLike a
+                in
+                   (a', extend (env, a, a'))
+                end)
+         in
+            (env, tyvars)
+         end
    end
 
 fun ('down, 'up)
    processDec (d: Dec.t,
-	       {(* bindType is used at datatype and type declarations. *)
-		bindType: ('down * Tyvar.t vector
-			   -> 'down * Tyvar.t vector * ('up -> 'up)),
-		(* bindFunVal is used at fun, overload, and val declarations. *)
-		bindFunVal: ('down * Tyvar.t vector
-			     -> ('down * ('up -> Tyvar.t vector * 'up))),
-		combineUp: 'up * 'up -> 'up,
-		initDown: 'down,
-		initUp: 'up,
-		tyvar: Tyvar.t * 'down -> Tyvar.t * 'up
-		}): Dec.t * 'up =
+               {(* bindType is used at datatype and type declarations. *)
+                bindType: ('down * Tyvar.t vector
+                           -> 'down * Tyvar.t vector * ('up -> 'up)),
+                (* bindFunVal is used at fun, overload, and val declarations. *)
+                bindFunVal: ('down * Tyvar.t vector
+                             -> ('down * ('up -> Tyvar.t vector * 'up))),
+                combineUp: 'up * 'up -> 'up,
+                initDown: 'down,
+                initUp: 'up,
+                tyvar: Tyvar.t * 'down -> Tyvar.t * 'up
+                }): Dec.t * 'up =
    let
       fun loops (xs: 'a vector, loopX: 'a -> 'a * 'up): 'a vector * 'up =
-	 Vector.mapAndFold (xs, initUp, fn (x, u) =>
-			    let
-			       val (x, u') = loopX x
-			    in
-			       (x, combineUp (u, u'))
-			    end)
+         Vector.mapAndFold (xs, initUp, fn (x, u) =>
+                            let
+                               val (x, u') = loopX x
+                            in
+                               (x, combineUp (u, u'))
+                            end)
       fun loopTy (t: Type.t, d: 'down): Type.t * 'up =
-	 let
-	    fun loop (t: Type.t): Type.t * 'up =
-	       let
-		  datatype z = datatype Type.node
-		  val (n, u) =
-		     case Type.node t of
-			Con (c, ts) =>
-			   let
-			      val (ts, u) = loops (ts, loop)
-			   in
-			      (Con (c, ts), u)
-			   end
-		      | Record r =>
-			   let
-			      val (r, u) = SortedRecord.change (r, fn ts =>
-								loops (ts, loop))
-			   in
-			      (Record r, u)
-			   end
-		      | Var a =>
-			   let
-			      val (a, u) = tyvar (a, d)
-			   in
-			      (Var a, u)
-			   end
-	       in
-		  (Type.makeRegion (n, Type.region t), u)
-	       end
-	 in
-	    loop t
-	 end
+         let
+            fun loop (t: Type.t): Type.t * 'up =
+               let
+                  datatype z = datatype Type.node
+                  val (n, u) =
+                     case Type.node t of
+                        Con (c, ts) =>
+                           let
+                              val (ts, u) = loops (ts, loop)
+                           in
+                              (Con (c, ts), u)
+                           end
+                      | Record r =>
+                           let
+                              val (r, u) = SortedRecord.change (r, fn ts =>
+                                                                loops (ts, loop))
+                           in
+                              (Record r, u)
+                           end
+                      | Var a =>
+                           let
+                              val (a, u) = tyvar (a, d)
+                           in
+                              (Var a, u)
+                           end
+               in
+                  (Type.makeRegion (n, Type.region t), u)
+               end
+         in
+            loop t
+         end
       fun loopTyOpt (to: Type.t option, d: 'down): Type.t option * 'up =
-	 case to of
-	    NONE => (NONE, initUp)
-	  | SOME t =>
-	       let
-		  val (t, u) = loopTy (t, d)
-	       in
-		  (SOME t, u)
-	       end
+         case to of
+            NONE => (NONE, initUp)
+          | SOME t =>
+               let
+                  val (t, u) = loopTy (t, d)
+               in
+                  (SOME t, u)
+               end
       fun loopTypBind (tb: TypBind.t, d: 'down): TypBind.t * 'up =
-	 let
-	    val TypBind.T tbs = TypBind.node tb
-	    val (tbs, u) =
-	       loops (tbs, fn {def, tycon, tyvars} =>
-		      let
-			 val (d, tyvars, finish) = bindType (d, tyvars)
-			 val (def, u) = loopTy (def, d)
-		      in
-			 ({def = def,
-			   tycon = tycon,
-			   tyvars = tyvars},
-			  finish u)
-		      end)
-	 in
-	    (TypBind.makeRegion (TypBind.T tbs, TypBind.region tb),
-	     u)
-	 end
+         let
+            val TypBind.T tbs = TypBind.node tb
+            val (tbs, u) =
+               loops (tbs, fn {def, tycon, tyvars} =>
+                      let
+                         val (d, tyvars, finish) = bindType (d, tyvars)
+                         val (def, u) = loopTy (def, d)
+                      in
+                         ({def = def,
+                           tycon = tycon,
+                           tyvars = tyvars},
+                          finish u)
+                      end)
+         in
+            (TypBind.makeRegion (TypBind.T tbs, TypBind.region tb),
+             u)
+         end
       fun loopDatBind (db: DatBind.t, d: 'down): DatBind.t * 'up =
-	 let
-	    val DatBind.T {datatypes, withtypes} = DatBind.node db
-	    val (datatypes, u) =
-	       loops
-	       (datatypes, fn {cons, tycon, tyvars} =>
-		let
-		   val (d, tyvars, up) = bindType (d, tyvars)
-		   val (cons, u) =
-		      loops (cons, fn (con, arg) =>
-			     let
-				val (arg, u) = loopTyOpt (arg, d)
-			     in
-				((con, arg), u)
-			     end)
-		in
-		   ({cons = cons, tycon = tycon, tyvars = tyvars}, up u)
-		end)
-	    val (withtypes, u') = loopTypBind (withtypes, d)
-	 in
-	    (DatBind.makeRegion (DatBind.T {datatypes = datatypes,
-					    withtypes = withtypes},
-				 DatBind.region db),
-	     combineUp (u, u'))
-	 end
+         let
+            val DatBind.T {datatypes, withtypes} = DatBind.node db
+            val (datatypes, u) =
+               loops
+               (datatypes, fn {cons, tycon, tyvars} =>
+                let
+                   val (d, tyvars, up) = bindType (d, tyvars)
+                   val (cons, u) =
+                      loops (cons, fn (con, arg) =>
+                             let
+                                val (arg, u) = loopTyOpt (arg, d)
+                             in
+                                ((con, arg), u)
+                             end)
+                in
+                   ({cons = cons, tycon = tycon, tyvars = tyvars}, up u)
+                end)
+            val (withtypes, u') = loopTypBind (withtypes, d)
+         in
+            (DatBind.makeRegion (DatBind.T {datatypes = datatypes,
+                                            withtypes = withtypes},
+                                 DatBind.region db),
+             combineUp (u, u'))
+         end
       fun loopPat (p: Pat.t, d: 'down): Pat.t * 'up =
-	 let
-	    fun loop (p: Pat.t): Pat.t * 'up =
-	       let
-		  fun doit n = Pat.makeRegion (n, Pat.region p)
-		  fun do1 ((a, u), f) = (doit (f a), u)
-		  fun do2 ((a1, u1), (a2, u2), f) =
-		     (doit (f (a1, a2)), combineUp (u1, u2))
-		  datatype z = datatype Pat.node
-	       in
-		  case Pat.node p of
-		     App (c, p) => do1 (loop p, fn p => App (c, p))
-		   | Const _ => (p, initUp)
-		   | Constraint (p, t) =>
-			do2 (loop p, loopTy (t, d), Constraint)
-		   | FlatApp ps => do1 (loops (ps, loop), FlatApp)
-		   | Layered {constraint, fixop, pat, var} =>
-			do2 (loopTyOpt (constraint, d), loop pat,
-			     fn (constraint, pat) =>
-			     Layered {constraint = constraint,
-				      fixop = fixop,
-				      pat = pat,
-				      var = var})
-		   | List ps => do1 (loops (ps, loop), List)
-		   | Record {flexible, items} =>
-			let
-			   val (items, u) =
-			      Vector.mapAndFold
-			      (items, initUp, fn ((f, i), u) =>
-			       let
-				  datatype z = datatype Pat.Item.t
-				  val (i, u') =
-				     case i of
-					Field p =>
-					   let
-					      val (p, u) = loop p
-					   in
-					      (Field p, u)
-					   end
-				      | Vid (v, to, po) =>
-					   let
-					      val (to, u) = loopTyOpt (to, d)
-					      val (po, u') = loopOpt po
-					   in
-					      (Vid (v, to, po),
-					       combineUp (u, u'))
-					   end
-			       in
-				  ((f, i), combineUp (u, u'))
-			       end)
-			in
-			   (doit (Record {flexible = flexible,
-					  items = items}),
-			    u)
-			end
-		   | Tuple ps => do1 (loops (ps, loop), Tuple)
-		   | Var _ => (p, initUp)
-		   | Wild => (p, initUp)
+         let
+            fun loop (p: Pat.t): Pat.t * 'up =
+               let
+                  fun doit n = Pat.makeRegion (n, Pat.region p)
+                  fun do1 ((a, u), f) = (doit (f a), u)
+                  fun do2 ((a1, u1), (a2, u2), f) =
+                     (doit (f (a1, a2)), combineUp (u1, u2))
+                  datatype z = datatype Pat.node
+               in
+                  case Pat.node p of
+                     App (c, p) => do1 (loop p, fn p => App (c, p))
+                   | Const _ => (p, initUp)
+                   | Constraint (p, t) =>
+                        do2 (loop p, loopTy (t, d), Constraint)
+                   | FlatApp ps => do1 (loops (ps, loop), FlatApp)
+                   | Layered {constraint, fixop, pat, var} =>
+                        do2 (loopTyOpt (constraint, d), loop pat,
+                             fn (constraint, pat) =>
+                             Layered {constraint = constraint,
+                                      fixop = fixop,
+                                      pat = pat,
+                                      var = var})
+                   | List ps => do1 (loops (ps, loop), List)
+                   | Record {flexible, items} =>
+                        let
+                           val (items, u) =
+                              Vector.mapAndFold
+                              (items, initUp, fn ((f, i), u) =>
+                               let
+                                  datatype z = datatype Pat.Item.t
+                                  val (i, u') =
+                                     case i of
+                                        Field p =>
+                                           let
+                                              val (p, u) = loop p
+                                           in
+                                              (Field p, u)
+                                           end
+                                      | Vid (v, to, po) =>
+                                           let
+                                              val (to, u) = loopTyOpt (to, d)
+                                              val (po, u') = loopOpt po
+                                           in
+                                              (Vid (v, to, po),
+                                               combineUp (u, u'))
+                                           end
+                               in
+                                  ((f, i), combineUp (u, u'))
+                               end)
+                        in
+                           (doit (Record {flexible = flexible,
+                                          items = items}),
+                            u)
+                        end
+                   | Tuple ps => do1 (loops (ps, loop), Tuple)
+                   | Var _ => (p, initUp)
+                   | Wild => (p, initUp)
 
-	       end
-	    and loopOpt opt =
-	       case opt of
-		  NONE =>
-		     (NONE, initUp)
-		| SOME p =>
-		     let
-			val (p, u) = loop p
-		     in
-			(SOME p, u)
-		     end
-	 in
-	    loop p
-	 end
+               end
+            and loopOpt opt =
+               case opt of
+                  NONE =>
+                     (NONE, initUp)
+                | SOME p =>
+                     let
+                        val (p, u) = loop p
+                     in
+                        (SOME p, u)
+                     end
+         in
+            loop p
+         end
+      fun loopPrimKind (kind: PrimKind.t, d: 'down): PrimKind.t * 'up =
+         let
+            datatype z = datatype PrimKind.t
+            fun do1 ((a, u), f) = (f a, u)
+         in
+            case kind of
+               Address {name, ty} =>
+                  do1 (loopTy (ty, d), fn ty =>
+                       Address {name = name, ty = ty})
+             | BuildConst {name, ty} =>
+                  do1 (loopTy (ty, d), fn ty =>
+                       BuildConst {name = name, ty = ty})
+             | CommandLineConst {name, ty, value} =>
+                  do1 (loopTy (ty, d), fn ty =>
+                       CommandLineConst {name = name, ty = ty, value = value})
+             | Const {name, ty} =>
+                  do1 (loopTy (ty, d), fn ty =>
+                       Const {name = name, ty = ty})
+             | Export {attributes, name, ty} =>
+                  do1 (loopTy (ty, d), fn ty =>
+                       Export {attributes = attributes, name = name, ty = ty})
+             | IImport {attributes, ty} =>
+                  do1 (loopTy (ty, d), fn ty =>
+                       IImport {attributes = attributes, ty = ty})
+             | Import {attributes, name, ty} =>
+                  do1 (loopTy (ty, d), fn ty =>
+                       Import {attributes = attributes, name = name, ty = ty})
+             | ISymbol {ty} =>
+                  do1 (loopTy (ty, d), fn ty =>
+                       ISymbol {ty = ty})
+             | Prim {name, ty} =>
+                  do1 (loopTy (ty, d), fn ty =>
+                       Prim {name = name, ty = ty})
+             | Symbol {attributes, name, ty} =>
+                  do1 (loopTy (ty, d), fn ty =>
+                       Symbol {attributes = attributes, name = name, ty = ty})
+         end
       fun loopDec (d: Dec.t, down: 'down): Dec.t * 'up =
-	 let
-	    fun doit n = Dec.makeRegion (n, Dec.region d)
-	    fun do1 ((a, u), f) = (doit (f a), u)
-	    fun do2 ((a1, u1), (a2, u2), f) =
-	       (doit (f (a1, a2)), combineUp (u1, u2))
-	    fun doVec (ds: Dec.t vector, f: Dec.t vector -> Dec.node)
-	       : Dec.t * 'up =
-	       let
-		  val (ds, u) = loops (ds, fn d => loopDec (d, down))
-	       in
-		  (doit (f ds), u)
-	       end
-	    fun empty () = (d, initUp)
-	    datatype z = datatype Dec.node
-	 in
-	    case Dec.node d of
-	       Abstype {body, datBind} =>
-		  let
-		     val (body, u) = loopDec (body, down)
-		     val (db, u') = loopDatBind (datBind, down)
-		  in
-		     (doit (Abstype {body = body, datBind = db}),
-		      combineUp (u, u'))
-		  end
-	     | Datatype rhs =>
-		  let
-		     datatype z = datatype DatatypeRhs.node
-		     val (rhs, u) =
-			case DatatypeRhs.node rhs of
-			   DatBind db =>
-			      let
-				 val (db, u) = loopDatBind (db, down)
-			      in
-				 (DatatypeRhs.makeRegion
-				  (DatBind db, DatatypeRhs.region rhs),
-				  u)
-			      end
-			 | Repl _ => (rhs, initUp)
-		  in
-		     (doit (Datatype rhs), u)
-		  end
-	     | Exception ebs =>
-		  let
-		     val (ebs, u) =
-			loops (ebs, fn (c, rhs) =>
-			       let
-				  datatype z = datatype EbRhs.node
-				  val (rhs, u) =
-				     case EbRhs.node rhs of
-					Def _ => (rhs, initUp)
-				      | Gen to =>
-					   let
-					      val (to, u) = loopTyOpt (to, down)
-					   in
-					      (EbRhs.makeRegion
-					       (Gen to, EbRhs.region rhs),
-					       u)
-					   end
-			       in
-				  ((c, rhs), u)
-			       end)
-		  in
-		     (doit (Exception ebs), u)
-		  end
-	     | Fix _ => (d, initUp)
-	     | Fun (tyvars, decs) =>
-		  let
-		     val (down, finish) = bindFunVal (down, tyvars)
-		     val (decs, u) =
-			loops (decs, fn clauses =>
-			       let
-				  val (clauses, u) =
-				     loops
-				     (clauses, fn {body, pats, resultType} =>
-				      let
-					 val (body, u) = loopExp (body, down)
-					 val (pats, u') =
-					    loops (pats, fn p =>
-						   loopPat (p, down))
-					 val (resultType, u'') =
-					    loopTyOpt (resultType, down)
-				      in
-					 ({body = body,
-					   pats = pats,
-					   resultType = resultType},
-					  combineUp (u, combineUp (u', u'')))
-				      end)
-				 in
-				    (clauses, u)
-				 end)
-		     val (tyvars, u) = finish u
-		  in
-		     (doit (Fun (tyvars, decs)), u)
-		  end
-	     | Local (d, d') =>
-		  do2 (loopDec (d, down), loopDec (d', down), Local)
-	     | Open _ => empty ()
-	     | Overload (i, x, tyvars, ty, ys) =>
-		  let
-		     val (down, finish) = bindFunVal (down, tyvars)
-		     val (ty, up) = loopTy (ty, down)
-		     val (tyvars, up) = finish up
-		  in
-		     (doit (Overload (i, x, tyvars, ty, ys)), up)
-		  end
-	     | SeqDec ds => doVec (ds, SeqDec)
-	     | Type tb => do1 (loopTypBind (tb, down), Type)
-	     | Val {rvbs, tyvars, vbs} =>
-		  let
-		     val (down, finish) = bindFunVal (down, tyvars)
-		     val (rvbs, u) =
-			loops (rvbs, fn {match, pat} =>
-			       let
-				  val (match, u) = loopMatch (match, down)
-				  val (pat, u') = loopPat (pat, down)
-			       in
-				  ({match = match,
-				    pat = pat},
-				   combineUp (u, u'))
-			       end)
-		     val (vbs, u') =
-			loops (vbs, fn {exp, pat} =>
-			       let
-				  val (exp, u) = loopExp (exp, down)
-				  val (pat, u') = loopPat (pat, down)
-			       in
-				  ({exp = exp,
-				    pat = pat},
-				   combineUp (u, u'))
-			       end)
-		     val (tyvars, u) = finish (combineUp (u, u'))
-		  in
-		     (doit (Val {rvbs = rvbs,
-				 tyvars = tyvars,
-				 vbs = vbs}),
-		      u)
-		  end
-	 end
+         let
+            fun doit n = Dec.makeRegion (n, Dec.region d)
+            fun do1 ((a, u), f) = (doit (f a), u)
+            fun do2 ((a1, u1), (a2, u2), f) =
+               (doit (f (a1, a2)), combineUp (u1, u2))
+            fun doVec (ds: Dec.t vector, f: Dec.t vector -> Dec.node)
+               : Dec.t * 'up =
+               let
+                  val (ds, u) = loops (ds, fn d => loopDec (d, down))
+               in
+                  (doit (f ds), u)
+               end
+            fun empty () = (d, initUp)
+            datatype z = datatype Dec.node
+         in
+            case Dec.node d of
+               Abstype {body, datBind} =>
+                  let
+                     val (body, u) = loopDec (body, down)
+                     val (db, u') = loopDatBind (datBind, down)
+                  in
+                     (doit (Abstype {body = body, datBind = db}),
+                      combineUp (u, u'))
+                  end
+             | Datatype rhs =>
+                  let
+                     datatype z = datatype DatatypeRhs.node
+                     val (rhs, u) =
+                        case DatatypeRhs.node rhs of
+                           DatBind db =>
+                              let
+                                 val (db, u) = loopDatBind (db, down)
+                              in
+                                 (DatatypeRhs.makeRegion
+                                  (DatBind db, DatatypeRhs.region rhs),
+                                  u)
+                              end
+                         | Repl _ => (rhs, initUp)
+                  in
+                     (doit (Datatype rhs), u)
+                  end
+             | Exception ebs =>
+                  let
+                     val (ebs, u) =
+                        loops (ebs, fn (c, rhs) =>
+                               let
+                                  datatype z = datatype EbRhs.node
+                                  val (rhs, u) =
+                                     case EbRhs.node rhs of
+                                        Def _ => (rhs, initUp)
+                                      | Gen to =>
+                                           let
+                                              val (to, u) = loopTyOpt (to, down)
+                                           in
+                                              (EbRhs.makeRegion
+                                               (Gen to, EbRhs.region rhs),
+                                               u)
+                                           end
+                               in
+                                  ((c, rhs), u)
+                               end)
+                  in
+                     (doit (Exception ebs), u)
+                  end
+             | Fix _ => (d, initUp)
+             | Fun (tyvars, decs) =>
+                  let
+                     val (down, finish) = bindFunVal (down, tyvars)
+                     val (decs, u) =
+                        loops (decs, fn clauses =>
+                               let
+                                  val (clauses, u) =
+                                     loops
+                                     (clauses, fn {body, pats, resultType} =>
+                                      let
+                                         val (body, u) = loopExp (body, down)
+                                         val (pats, u') =
+                                            loops (pats, fn p =>
+                                                   loopPat (p, down))
+                                         val (resultType, u'') =
+                                            loopTyOpt (resultType, down)
+                                      in
+                                         ({body = body,
+                                           pats = pats,
+                                           resultType = resultType},
+                                          combineUp (u, combineUp (u', u'')))
+                                      end)
+                                 in
+                                    (clauses, u)
+                                 end)
+                     val (tyvars, u) = finish u
+                  in
+                     (doit (Fun (tyvars, decs)), u)
+                  end
+             | Local (d, d') =>
+                  do2 (loopDec (d, down), loopDec (d', down), Local)
+             | Open _ => empty ()
+             | Overload (i, x, tyvars, ty, ys) =>
+                  let
+                     val (down, finish) = bindFunVal (down, tyvars)
+                     val (ty, up) = loopTy (ty, down)
+                     val (tyvars, up) = finish up
+                  in
+                     (doit (Overload (i, x, tyvars, ty, ys)), up)
+                  end
+             | SeqDec ds => doVec (ds, SeqDec)
+             | Type tb => do1 (loopTypBind (tb, down), Type)
+             | Val {rvbs, tyvars, vbs} =>
+                  let
+                     val (down, finish) = bindFunVal (down, tyvars)
+                     val (rvbs, u) =
+                        loops (rvbs, fn {match, pat} =>
+                               let
+                                  val (match, u) = loopMatch (match, down)
+                                  val (pat, u') = loopPat (pat, down)
+                               in
+                                  ({match = match,
+                                    pat = pat},
+                                   combineUp (u, u'))
+                               end)
+                     val (vbs, u') =
+                        loops (vbs, fn {exp, pat} =>
+                               let
+                                  val (exp, u) = loopExp (exp, down)
+                                  val (pat, u') = loopPat (pat, down)
+                               in
+                                  ({exp = exp,
+                                    pat = pat},
+                                   combineUp (u, u'))
+                               end)
+                     val (tyvars, u) = finish (combineUp (u, u'))
+                  in
+                     (doit (Val {rvbs = rvbs,
+                                 tyvars = tyvars,
+                                 vbs = vbs}),
+                      u)
+                  end
+         end
       and loopExp (e: Exp.t, d: 'down): Exp.t * 'up =
-	 let
-	    val loopMatch = fn m => loopMatch (m, d)
-	    fun loop (e: Exp.t): Exp.t * 'up =
-	       let
-		  fun empty () = (e, initUp)
-		  val region = Exp.region e
-		  fun doit n = Exp.makeRegion (n, region)
-		  datatype z = datatype Exp.node
-		  fun do1 ((a, u), f) = (doit (f a), u)
-		  fun do2 ((a1, u1), (a2, u2), f) =
-		     (doit (f (a1, a2)), combineUp (u1, u2))
-		  fun do3 ((a1, u1), (a2, u2), (a3, u3), f) =
-		     (doit (f (a1, a2, a3)), combineUp (u1, combineUp (u2, u3)))
-		  fun doVec (es: Exp.t vector, f: Exp.t vector -> Exp.node)
-		     : Exp.t * 'up =
-		     let
-			val (es, u) = loops (es, loop)
-		     in
-			(doit (f es), u)
-		     end
-	       in
-		  case Exp.node e of
-		     Andalso (e1, e2) => do2 (loop e1, loop e2, Andalso)
-		   | App (e1, e2) => do2 (loop e1, loop e2, App)
-		   | Case (e, m) => do2 (loop e, loopMatch m, Case)
-		   | Const _ => empty ()
-		   | Constraint (e, t) => do2 (loop e, loopTy (t, d), Constraint)
-		   | FlatApp es => doVec (es, FlatApp)
-		   | Fn m => do1 (loopMatch m, Fn)
-		   | Handle (e, m) => do2 (loop e, loopMatch m, Handle)
-		   | If (e1, e2, e3) => do3 (loop e1, loop e2, loop e3, If)
-		   | Let (dec, e) => do2 (loopDec (dec, d), loop e, Let)
-		   | List ts => doVec (ts, List)
-		   | Orelse (e1, e2) => do2 (loop e1, loop e2, Orelse)
-		   | Prim {kind, ty} =>
-			do1 (loopTy (ty, d), fn ty =>
-			     Prim {kind = kind,
-				   ty = ty})
-		   | Raise exn => do1 (loop exn, Raise)
-		   | Record r =>
-			let
-			   val (r, u) = Record.change (r, fn es =>
-						       loops (es, loop))
-			in
-			   (doit (Record r), u)
-			end
-		   | Selector _ => empty ()
-		   | Seq es => doVec (es, Seq)
-		   | Var _ => empty ()
-		   | While {expr, test} =>
-			do2 (loop expr, loop test, fn (expr, test) =>
-			     While {expr = expr, test = test})
-	       end
-	 in
-	    loop e
-	 end
+         let
+            val loopMatch = fn m => loopMatch (m, d)
+            fun loop (e: Exp.t): Exp.t * 'up =
+               let
+                  fun empty () = (e, initUp)
+                  val region = Exp.region e
+                  fun doit n = Exp.makeRegion (n, region)
+                  datatype z = datatype Exp.node
+                  fun do1 ((a, u), f) = (doit (f a), u)
+                  fun do2 ((a1, u1), (a2, u2), f) =
+                     (doit (f (a1, a2)), combineUp (u1, u2))
+                  fun do3 ((a1, u1), (a2, u2), (a3, u3), f) =
+                     (doit (f (a1, a2, a3)), combineUp (u1, combineUp (u2, u3)))
+                  fun doVec (es: Exp.t vector, f: Exp.t vector -> Exp.node)
+                     : Exp.t * 'up =
+                     let
+                        val (es, u) = loops (es, loop)
+                     in
+                        (doit (f es), u)
+                     end
+               in
+                  case Exp.node e of
+                     Andalso (e1, e2) => do2 (loop e1, loop e2, Andalso)
+                   | App (e1, e2) => do2 (loop e1, loop e2, App)
+                   | Case (e, m) => do2 (loop e, loopMatch m, Case)
+                   | Const _ => empty ()
+                   | Constraint (e, t) => do2 (loop e, loopTy (t, d), Constraint)
+                   | FlatApp es => doVec (es, FlatApp)
+                   | Fn m => do1 (loopMatch m, Fn)
+                   | Handle (e, m) => do2 (loop e, loopMatch m, Handle)
+                   | If (e1, e2, e3) => do3 (loop e1, loop e2, loop e3, If)
+                   | Let (dec, e) => do2 (loopDec (dec, d), loop e, Let)
+                   | List ts => doVec (ts, List)
+                   | Orelse (e1, e2) => do2 (loop e1, loop e2, Orelse)
+                   | Prim kind => do1 (loopPrimKind (kind, d), Prim)
+                   | Raise exn => do1 (loop exn, Raise)
+                   | Record r =>
+                        let
+                           val (r, u) = Record.change (r, fn es =>
+                                                       loops (es, loop))
+                        in
+                           (doit (Record r), u)
+                        end
+                   | Selector _ => empty ()
+                   | Seq es => doVec (es, Seq)
+                   | Var _ => empty ()
+                   | While {expr, test} =>
+                        do2 (loop expr, loop test, fn (expr, test) =>
+                             While {expr = expr, test = test})
+               end
+         in
+            loop e
+         end
       and loopMatch (m, d) =
-	 let
-	    val (Match.T rules, region) = Match.dest m
-	    val (rules, u) =
-	       loops (rules, fn (p, e) =>
-		      let
-			 val (p, u) = loopPat (p, d)
-			 val (e, u') = loopExp (e, d)
-		      in
-			 ((p, e), combineUp (u, u'))
-		      end)
-	 in
-	    (Match.makeRegion (Match.T rules, region),
-	     u)
-	 end
+         let
+            val (Match.T rules, region) = Match.dest m
+            val (rules, u) =
+               loops (rules, fn (p, e) =>
+                      let
+                         val (p, u) = loopPat (p, d)
+                         val (e, u') = loopExp (e, d)
+                      in
+                         ((p, e), combineUp (u, u'))
+                      end)
+         in
+            (Match.makeRegion (Match.T rules, region),
+             u)
+         end
    in
       loopDec (d, initDown)
    end
@@ -433,126 +468,126 @@
 fun scope (dec: Dec.t): Dec.t =
    let
       fun bindFunVal (env, tyvars) =
-	 let
-	    val (env, tyvars) = Env.rename (env, tyvars)
-	    fun finish {free, mayNotBind} =
-	       let
-		  val bound =
-		     Vector.fromList
-		     (Tyvars.toList
-		      (Tyvars.+ (free, Tyvars.fromList (Vector.toList tyvars))))
-		  val mayNotBind =
-		     List.keepAll
-		     (mayNotBind, fn a =>
-		      not (Vector.exists (bound, fn a' =>
-					  Tyvar.sameName (a, a')))
-		      orelse
-		      let
-			 open Layout
-			 val _ =
-			    Control.error
-			    (Tyvar.region a,
-			     seq [str "type variable ",
-				  Tyvar.layout a,
-				  str " scoped at an outer declaration"],
-			     empty)
-		      in
-			 false
-		      end)
-	       in
-		  (bound,
-		   {free = Tyvars.empty,
-		    mayNotBind = List.append (Vector.toList tyvars, mayNotBind)})
-	       end
-	 in
-	    (env, finish)
-	 end
+         let
+            val (env, tyvars) = Env.rename (env, tyvars)
+            fun finish {free, mayNotBind} =
+               let
+                  val bound =
+                     Vector.fromList
+                     (Tyvars.toList
+                      (Tyvars.+ (free, Tyvars.fromList (Vector.toList tyvars))))
+                  val mayNotBind =
+                     List.keepAll
+                     (mayNotBind, fn a =>
+                      not (Vector.exists (bound, fn a' =>
+                                          Tyvar.sameName (a, a')))
+                      orelse
+                      let
+                         open Layout
+                         val _ =
+                            Control.error
+                            (Tyvar.region a,
+                             seq [str "type variable ",
+                                  Tyvar.layout a,
+                                  str " scoped at an outer declaration"],
+                             empty)
+                      in
+                         false
+                      end)
+               in
+                  (bound,
+                   {free = Tyvars.empty,
+                    mayNotBind = List.append (Vector.toList tyvars, mayNotBind)})
+               end
+         in
+            (env, finish)
+         end
       fun bindType (env, tyvars) =
-	 let
-	    val (env, tyvars) = Env.rename (env, tyvars)
-	    fun finish {free, mayNotBind = _} =
-	       {free = Tyvars.- (free, Tyvars.fromList (Vector.toList tyvars)),
-		mayNotBind = []}
-	 in
-	    (env, tyvars, finish)
-	 end
+         let
+            val (env, tyvars) = Env.rename (env, tyvars)
+            fun finish {free, mayNotBind = _} =
+               {free = Tyvars.- (free, Tyvars.fromList (Vector.toList tyvars)),
+                mayNotBind = []}
+         in
+            (env, tyvars, finish)
+         end
       fun tyvar (a, env) =
-	 let
-	    val a =
-	       case Env.peek (env, a) of
-		  NONE => a
-		| SOME a => a
-	 in
-	    (a, {free = Tyvars.singleton a,
-		 mayNotBind = []})
-	 end
+         let
+            val a =
+               case Env.peek (env, a) of
+                  NONE => a
+                | SOME a => a
+         in
+            (a, {free = Tyvars.singleton a,
+                 mayNotBind = []})
+         end
       fun combineUp ({free = f, mayNotBind = m}, {free = f', mayNotBind = m'}) =
-	 {free = Tyvars.+ (f, f'),
-	  mayNotBind = List.append (m, m')}
+         {free = Tyvars.+ (f, f'),
+          mayNotBind = List.append (m, m')}
       val (dec, {free = unguarded, ...}) =
-	 processDec (dec, {bindFunVal = bindFunVal,
-			   bindType = bindType,
-			   combineUp = combineUp,
-			   initDown = Env.empty,
-			   initUp = {free = Tyvars.empty, mayNotBind = []},
-			   tyvar = tyvar})
+         processDec (dec, {bindFunVal = bindFunVal,
+                           bindType = bindType,
+                           combineUp = combineUp,
+                           initDown = Env.empty,
+                           initUp = {free = Tyvars.empty, mayNotBind = []},
+                           tyvar = tyvar})
    in
       if Tyvars.isEmpty unguarded
-	 then
-	    let
-	       (* Walk down and bind a tyvar as soon as you sees it, removing
-		* all lower binding occurrences of the tyvar.  Also, rename all
-		* lower free occurrences of the tyvar to be the same as the
-		* binding occurrence (so that they can share info).
-		*)
-	       fun bindFunVal (env, tyvars: Tyvar.t vector) =
-		  let
-		     val domain = Env.domain env
-		     val (env, tyvars) =
-			Env.rename
-			(env,
-			 Vector.keepAll
-			 (tyvars, fn a =>
-			  not (List.exists
-			       (domain, fn a' => Tyvar.sameName (a, a')))))
-		  in
-		     (env, fn () => (tyvars, ()))
-		  end
-	       fun bindType (env, tyvars) =
-		  let
-		     val (env, tyvars) = Env.rename (env, tyvars)
-		  in
-		     (env, tyvars, fn () => ())
-		  end
-	       fun tyvar (a, env) = (Env.lookup (env, a), ())
-	       val (dec, ()) =
-		  processDec (dec, {bindFunVal = bindFunVal,
-				    bindType = bindType,
-				    combineUp = fn ((), ()) => (),
-				    initDown = Env.empty,
-				    initUp = (),
-				    tyvar = tyvar})
-	    in
-	       dec
-	    end
+         then
+            let
+               (* Walk down and bind a tyvar as soon as you sees it, removing
+                * all lower binding occurrences of the tyvar.  Also, rename all
+                * lower free occurrences of the tyvar to be the same as the
+                * binding occurrence (so that they can share info).
+                *)
+               fun bindFunVal (env, tyvars: Tyvar.t vector) =
+                  let
+                     val domain = Env.domain env
+                     val (env, tyvars) =
+                        Env.rename
+                        (env,
+                         Vector.keepAll
+                         (tyvars, fn a =>
+                          not (List.exists
+                               (domain, fn a' => Tyvar.sameName (a, a')))))
+                  in
+                     (env, fn () => (tyvars, ()))
+                  end
+               fun bindType (env, tyvars) =
+                  let
+                     val (env, tyvars) = Env.rename (env, tyvars)
+                  in
+                     (env, tyvars, fn () => ())
+                  end
+               fun tyvar (a, env) = (Env.lookup (env, a), ())
+               val (dec, ()) =
+                  processDec (dec, {bindFunVal = bindFunVal,
+                                    bindType = bindType,
+                                    combineUp = fn ((), ()) => (),
+                                    initDown = Env.empty,
+                                    initUp = (),
+                                    tyvar = tyvar})
+            in
+               dec
+            end
       else
-	 let
-	    val _ =
-	       List.foreach
-	       (Tyvars.toList unguarded, fn a =>
-		let
-		   open Layout
-		in
-		   Control.error (Tyvar.region a,
-				  seq [str "undefined type variable: ",
-				       Tyvar.layout a],
-				  empty)
-		end)
-	 in
-	    dec
-	 end
+         let
+            val _ =
+               List.foreach
+               (Tyvars.toList unguarded, fn a =>
+                let
+                   open Layout
+                in
+                   Control.error (Tyvar.region a,
+                                  seq [str "undefined type variable: ",
+                                       Tyvar.layout a],
+                                  empty)
+                end)
+         in
+            dec
+         end
    end
 
-val scope = Trace.trace ("scope", Dec.layout, Dec.layout) scope
+val scope = Trace.trace ("Scope.scope", Dec.layout, Dec.layout) scope
 
 end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/elaborate/scope.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/elaborate/scope.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/elaborate/scope.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2003 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature SCOPE_STRUCTS =
    sig
       structure Ast: AST

Modified: mlton/branches/on-20050420-cmm-branch/mlton/elaborate/sources.cm
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/elaborate/sources.cm	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/elaborate/sources.cm	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 Group
 
 signature ELABORATE

Modified: mlton/branches/on-20050420-cmm-branch/mlton/elaborate/sources.mlb
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/elaborate/sources.mlb	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/elaborate/sources.mlb	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,44 +1,44 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 local
-    ../../lib/mlton/sources.mlb
-    ../ast/sources.mlb
-    ../atoms/sources.mlb
-    ../control/sources.mlb
-    ../core-ml/sources.mlb
+   ../../lib/mlton/sources.mlb
+   ../ast/sources.mlb
+   ../atoms/sources.mlb
+   ../control/sources.mlb
+   ../core-ml/sources.mlb
 
-    decs.sig
-    decs.fun
-    type-env.sig
-    type-env.fun
-    interface.sig
-    interface.fun
-    elaborate-env.sig
-    elaborate-env.fun
-    precedence-parse.sig
-    precedence-parse.fun
-    scope.sig
-    scope.fun
-    elaborate-core.sig
-    elaborate-core.fun
-    elaborate-sigexp.sig
-    elaborate-sigexp.fun
-    elaborate-modules.sig
-    elaborate-modules.fun
-    elaborate-programs.sig
-    elaborate-programs.fun
-    elaborate-mlbs.sig
-    elaborate-mlbs.fun
-    elaborate.sig
-    elaborate.fun
+   decs.sig
+   decs.fun
+   type-env.sig
+   type-env.fun
+   interface.sig
+   interface.fun
+   elaborate-env.sig
+   elaborate-env.fun
+   precedence-parse.sig
+   precedence-parse.fun
+   scope.sig
+   scope.fun
+   elaborate-core.sig
+   elaborate-core.fun
+   elaborate-sigexp.sig
+   elaborate-sigexp.fun
+   elaborate-modules.sig
+   elaborate-modules.fun
+   elaborate-programs.sig
+   elaborate-programs.fun
+   elaborate-mlbs.sig
+   elaborate-mlbs.fun
+   elaborate.sig
+   elaborate.fun
 in
-    signature CONST_TYPE
-    signature ELABORATE
-    functor Elaborate
-    functor TypeEnv
+   signature CONST_TYPE
+   functor Elaborate
+   functor TypeEnv
 end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/elaborate/type-env.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/elaborate/type-env.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/elaborate/type-env.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 functor TypeEnv (S: TYPE_ENV_STRUCTS): TYPE_ENV =
 struct
 
@@ -51,12 +52,12 @@
    end =
    struct
       datatype t = T of {clock: int,
-			 useBeforeDef: Tycon.t -> unit}
+                         useBeforeDef: Tycon.t -> unit}
 
       local
-	 fun make f (T r) = f r
+         fun make f (T r) = f r
       in
-	 val clock = make #clock
+         val clock = make #clock
       end
 
       fun useBeforeDef (T {useBeforeDef = f, ...}, c) = f c
@@ -66,17 +67,17 @@
       fun t <= t' = Int.<= (clock t, clock t')
 
       local
-	 val current: t ref =
-	    ref (T {clock = 0,
-		    useBeforeDef = fn _ => Error.bug "useBeforeDef clock 0"})
+         val current: t ref =
+            ref (T {clock = 0,
+                    useBeforeDef = fn _ => Error.bug "TypeEnv.Time: useBeforeDef clock 0"})
       in
-	 fun now () = !current
-	 fun tick {useBeforeDef} =
-	    current := T {clock = 1 + clock (!current),
-			  useBeforeDef = useBeforeDef}
+         fun now () = !current
+         fun tick {useBeforeDef} =
+            current := T {clock = 1 + clock (!current),
+                          useBeforeDef = useBeforeDef}
       end
 
-      val tick = Trace.trace ("Time.tick", Layout.ignore, Unit.layout) tick
+      val tick = Trace.trace ("TypeEnv.Time.tick", Layout.ignore, Unit.layout) tick
    end
 
 val tick = Time.tick
@@ -86,27 +87,27 @@
       type t = Layout.t * {isChar: bool, needsParen: bool}
 
       fun simple (l: Layout.t): t =
-	 (l, {isChar = false, needsParen = false})
+         (l, {isChar = false, needsParen = false})
    end
       
 structure UnifyResult =
    struct
       datatype t =
-	 NotUnifiable of Lay.t * Lay.t
+         NotUnifiable of Lay.t * Lay.t
        | Unified
 
       val layout =
-	 let
-	    open Layout
-	 in
-	    fn NotUnifiable _ => str "NotUnifiable"
-	     | Unified => str "Unified"
-	 end
+         let
+            open Layout
+         in
+            fn NotUnifiable _ => str "NotUnifiable"
+             | Unified => str "Unified"
+         end
    end
 
 val {get = tyconInfo: Tycon.t -> {admitsEquality: AdmitsEquality.t ref,
-				  region: Region.t option ref,
-				  time: Time.t ref},
+                                  region: Region.t option ref,
+                                  time: Time.t ref},
      set = setTyconInfo, ...} =
    Property.getSet (Tycon.plist, Property.initRaise ("info", Tycon.layout))
 
@@ -120,8 +121,8 @@
 
 fun initAdmitsEquality (c, a) =
    setTyconInfo (c, {admitsEquality = ref a,
-		     region = ref NONE,
-		     time = ref (Time.now ())})
+                     region = ref NONE,
+                     time = ref (Time.now ())})
    
 val _ = List.foreach (Tycon.prims, fn (c, _, a) => initAdmitsEquality (c, a))
 
@@ -141,157 +142,157 @@
    end =
    struct
       datatype maybe =
-	 Known of bool
+         Known of bool
        | Unknown of {whenKnown: (bool -> bool) list ref}
       datatype t =
-	 False
+         False
        | Maybe of maybe ref
        | True
 
       fun unknown () = Maybe (ref (Unknown {whenKnown = ref []}))
 
       fun set (e: t, b: bool): bool =
-	 case e of
-	    False => b = false
-	  | Maybe r =>
-	       (case !r of
-		   Known b' => b = b'
-		 | Unknown {whenKnown} =>
-		      (r := Known b; List.forall (!whenKnown, fn f => f b)))
-	  | True => b = true
+         case e of
+            False => b = false
+          | Maybe r =>
+               (case !r of
+                   Known b' => b = b'
+                 | Unknown {whenKnown} =>
+                      (r := Known b; List.forall (!whenKnown, fn f => f b)))
+          | True => b = true
 
       fun when (e: t, f: bool -> bool): bool =
-	 case e of
-	    False => f false
-	  | Maybe r =>
-	       (case !r of
-		   Known b => f b
-		 | Unknown {whenKnown} => (List.push (whenKnown, f); true))
-	  | True => f true
+         case e of
+            False => f false
+          | Maybe r =>
+               (case !r of
+                   Known b => f b
+                 | Unknown {whenKnown} => (List.push (whenKnown, f); true))
+          | True => f true
 
       fun unify (e: t, e': t): bool =
-	 when (e, fn b => set (e', b))
-	 andalso when (e', fn b => set (e, b))
+         when (e, fn b => set (e', b))
+         andalso when (e', fn b => set (e, b))
 
       fun and2 (e, e') =
-	 case (e, e') of
-	    (False, _) => False
-	  | (_, False) => False
-	  | (True, _) => e'
-	  | (_, True) => e
-	  | (Maybe r, Maybe r') =>
-	       (case (!r, !r') of
-		   (Known false, _) => False
-		 | (_, Known false) => False
-		 | (Known true, _) => e'
-		 | (_, Known true) => e
-		 | (Unknown _, Unknown _) =>
-		      let
-			 val e'' = unknown ()
-			 val _ =
-			    when
-			    (e'', fn b =>
-			     if b
-				then set (e, true) andalso set (e', true)
-			     else
-				let
-				   fun dep (e, e') =
-				      when (e, fn b =>
-					    not b orelse set (e', false))
-				in
-				   dep (e, e') andalso dep (e', e)
-				end)
-			 fun dep (e, e') =
-			    when (e, fn b =>
-				  if b then unify (e', e'')
-				  else set (e'', false))
-			 val _ = dep (e, e')
-			 val _ = dep (e', e)
-		      in
-			 e''
-		      end)
-	    
+         case (e, e') of
+            (False, _) => False
+          | (_, False) => False
+          | (True, _) => e'
+          | (_, True) => e
+          | (Maybe r, Maybe r') =>
+               (case (!r, !r') of
+                   (Known false, _) => False
+                 | (_, Known false) => False
+                 | (Known true, _) => e'
+                 | (_, Known true) => e
+                 | (Unknown _, Unknown _) =>
+                      let
+                         val e'' = unknown ()
+                         val _ =
+                            when
+                            (e'', fn b =>
+                             if b
+                                then set (e, true) andalso set (e', true)
+                             else
+                                let
+                                   fun dep (e, e') =
+                                      when (e, fn b =>
+                                            not b orelse set (e', false))
+                                in
+                                   dep (e, e') andalso dep (e', e)
+                                end)
+                         fun dep (e, e') =
+                            when (e, fn b =>
+                                  if b then unify (e', e'')
+                                  else set (e'', false))
+                         val _ = dep (e, e')
+                         val _ = dep (e', e)
+                      in
+                         e''
+                      end)
+            
       val falsee = False
       val truee = True
 
       val fromBool = fn false => False | true => True
 
       fun toBoolOpt (e: t): bool option =
-	 case e of
-	    False => SOME false
-	  | Maybe r =>
-	       (case !r of
-		   Known b => SOME b
-		 | Unknown _ => NONE)
-	  | True => SOME true
+         case e of
+            False => SOME false
+          | Maybe r =>
+               (case !r of
+                   Known b => SOME b
+                 | Unknown _ => NONE)
+          | True => SOME true
 
       fun andd (es: t vector): t = Vector.fold (es, truee, and2)
 
       val applyTycon: Tycon.t * t vector -> t =
-	 fn (c, es) =>
-	 let
-	    datatype z = datatype AdmitsEquality.t
-	 in
-	    case !(tyconAdmitsEquality c) of
-	       Always => truee
-	     | Sometimes => andd es
-	     | Never => falsee
-	 end
-	 
+         fn (c, es) =>
+         let
+            datatype z = datatype AdmitsEquality.t
+         in
+            case !(tyconAdmitsEquality c) of
+               Always => truee
+             | Sometimes => andd es
+             | Never => falsee
+         end
+         
       val unify: t * t -> UnifyResult.t =
-	 fn (e, e') =>
-	 if unify (e, e')
-	    then UnifyResult.Unified
-	 else
-	    let
-	       fun lay e =
-		  Lay.simple
-		  (Layout.str (case toBoolOpt e of
-				  NONE => Error.bug "Equality.unify"
-				| SOME b =>
-				     if b
-					then "[<equality>]"
-				     else "[<non-equality>]"))
-	    in
-	       UnifyResult.NotUnifiable (lay e, lay e')
-	    end
+         fn (e, e') =>
+         if unify (e, e')
+            then UnifyResult.Unified
+         else
+            let
+               fun lay e =
+                  Lay.simple
+                  (Layout.str (case toBoolOpt e of
+                                  NONE => Error.bug "TypeEnv.Equality.unify"
+                                | SOME b =>
+                                     if b
+                                        then "[<equality>]"
+                                     else "[<non-equality>]"))
+            in
+               UnifyResult.NotUnifiable (lay e, lay e')
+            end
    end
    
 structure Unknown =
    struct
       datatype t = T of {canGeneralize: bool,
-			 id: int}
+                         id: int}
 
       local
-	 fun make f (T r) = f r
+         fun make f (T r) = f r
       in
-	 val id = make #id
+         val id = make #id
       end
 
       fun layout (T {canGeneralize, id, ...}) =
-	 let
-	    open Layout
-	 in
-	    seq [str "Unknown ",
-		 record [("canGeneralize", Bool.layout canGeneralize),
-			 ("id", Int.layout id)]]
-	 end
+         let
+            open Layout
+         in
+            seq [str "Unknown ",
+                 record [("canGeneralize", Bool.layout canGeneralize),
+                         ("id", Int.layout id)]]
+         end
 
       fun equals (u, u') = id u = id u'
 
       local
-	 val r: int ref = ref 0
+         val r: int ref = ref 0
       in
-	 fun newId () = (Int.inc r; !r)
+         fun newId () = (Int.inc r; !r)
       end
 
       fun new {canGeneralize} =
-	 T {canGeneralize = canGeneralize,
-	    id = newId ()}
+         T {canGeneralize = canGeneralize,
+            id = newId ()}
 
       fun join (T r, T r'): t =
-	 T {canGeneralize = #canGeneralize r andalso #canGeneralize r',
-	    id = newId ()}
+         T {canGeneralize = #canGeneralize r andalso #canGeneralize r',
+            id = newId ()}
    end
 
 (* Flexible record spine, i.e. a possibly extensible list of fields. *)
@@ -317,55 +318,55 @@
    end =
    struct
       datatype t = T of {fields: Field.t list ref,
-			 more: bool ref} Set.t
+                         more: bool ref} Set.t
 
       fun new fields = T (Set.singleton {fields = ref fields,
-					 more = ref true})
+                                         more = ref true})
 
       fun equals (T s, T s') = Set.equals (s, s')
 
       fun layout (T s) =
-	 let
-	    val {fields, more} = Set.! s
-	 in
-	    Layout.record [("fields", List.layout Field.layout (!fields)),
-			   ("more", Bool.layout (!more))]
-	 end
+         let
+            val {fields, more} = Set.! s
+         in
+            Layout.record [("fields", List.layout Field.layout (!fields)),
+                           ("more", Bool.layout (!more))]
+         end
 
       fun canAddFields (T s) = ! (#more (Set.! s))
       fun fields (T s) = ! (#fields (Set.! s))
 
       fun ensureFieldValue ({fields, more}, f) =
-	 List.contains (!fields, f, Field.equals)
-	 orelse (!more andalso (List.push (fields, f); true))
+         List.contains (!fields, f, Field.equals)
+         orelse (!more andalso (List.push (fields, f); true))
 
       fun ensureField (T s, f) = ensureFieldValue (Set.! s, f)
 
       fun noMoreFields (T s) = #more (Set.! s) := false
 
       fun unify (T s, T s') =
-	 let
-	    val {fields = fs, more = m} = Set.! s
-	    val {more = m', ...} = Set.! s'
-	    val _ = Set.union (s, s')
-	    val _ = Set.:= (s, {fields = fs, more = ref (!m andalso !m')})
-	 in
-	    ()
-	 end
+         let
+            val {fields = fs, more = m} = Set.! s
+            val {more = m', ...} = Set.! s'
+            val _ = Set.union (s, s')
+            val _ = Set.:= (s, {fields = fs, more = ref (!m andalso !m')})
+         in
+            ()
+         end
 
       fun foldOverNew (spine: t, fs, ac, g) =
-	 List.fold
-	 (fields spine, ac, fn (f, ac) =>
-	  if List.exists (fs, fn (f', _) => Field.equals (f, f'))
-	     then ac
-	  else g (f, ac))
+         List.fold
+         (fields spine, ac, fn (f, ac) =>
+          if List.exists (fs, fn (f', _) => Field.equals (f, f'))
+             then ac
+          else g (f, ac))
    end
 
 val {get = tyvarTime: Tyvar.t -> Time.t ref, ...} =
    Property.get (Tyvar.plist, Property.initFun (fn _ => ref (Time.now ())))
 
 val tyvarTime =
-   Trace.trace ("tyvarTime", Tyvar.layout, Ref.layout Time.layout) tyvarTime
+   Trace.trace ("TypeEnv.tyvarTime", Tyvar.layout, Ref.layout Time.layout) tyvarTime
 
 local
    type z = Layout.t * {isChar: bool, needsParen: bool}
@@ -377,25 +378,25 @@
    fun bracket l = seq [str "[", l, str "]"]
    fun layoutRecord (ds: (Field.t * bool * z) list, flexible: bool) =
       simple (case ds of
-		 [] => str "{...}"
-	       | _ => 
-		    seq [str "{",
-			 mayAlign
-			 (separateRight
-			  (List.map
-			   (QuickSort.sortList (ds, fn ((f, _, _), (f', _, _)) =>
-						Field.<= (f, f')),
-			    fn (f, b, (l, _)) =>
-			    let
-			       val f = Field.layout f
-			       val f = if b then bracket f else f
-			    in
-			       seq [f, str ": ", l]
-			    end),
-			   ",")),
-			 str (if flexible
-				 then ", ...}"
-			      else "}")])
+                 [] => str "{...}"
+               | _ => 
+                    seq [str "{",
+                         mayAlign
+                         (separateRight
+                          (List.map
+                           (QuickSort.sortList (ds, fn ((f, _, _), (f', _, _)) =>
+                                                Field.<= (f, f')),
+                            fn (f, b, (l, _)) =>
+                            let
+                               val f = Field.layout f
+                               val f = if b then bracket f else f
+                            in
+                               seq [f, str ": ", l]
+                            end),
+                           ",")),
+                         str (if flexible
+                                 then ", ...}"
+                              else "}")])
    fun layoutTuple (zs: z vector): z =
       Tycon.layoutApp (Tycon.tuple, zs)
 end
@@ -403,348 +404,355 @@
 structure Type =
    struct
       structure Overload =
-	 struct
-	    datatype t = Char | Int | Real | Word
+         struct
+            datatype t = Char | Int | Real | Word
 
-	    val equals: t * t -> bool = op =
+            val equals: t * t -> bool = op =
 
-	    val toString =
-	       fn Char => "Char"
-		| Int => "Int"
-		| Real => "Real"
-		| Word => "Word"
+            val toString =
+               fn Char => "Char"
+                | Int => "Int"
+                | Real => "Real"
+                | Word => "Word"
 
-	    val layout = Layout.str o toString
+            val layout = Layout.str o toString
 
-	    val matchesTycon: t * Tycon.t -> bool =
-	       fn (ov, c) =>
-	       case ov of
-		  Char => Tycon.isCharX c
-		| Int => Tycon.isIntX c
-		| Real => Tycon.isRealX c
-		| Word => Tycon.isWordX c
+            val matchesTycon: t * Tycon.t -> bool =
+               fn (ov, c) =>
+               case ov of
+                  Char => Tycon.isCharX c
+                | Int => Tycon.isIntX c
+                | Real => Tycon.isRealX c
+                | Word => Tycon.isWordX c
 
-	    val defaultTycon: t -> Tycon.t =
-	       fn Char => Tycon.defaultChar
-		| Int => Tycon.defaultInt
-		| Real => Tycon.defaultReal
-		| Word => Tycon.defaultWord
-	 end
+            val defaultTycon: t -> Tycon.t =
+               fn Char => Tycon.defaultChar
+                | Int => Tycon.defaultInt
+                | Real => Tycon.defaultReal
+                | Word => Tycon.defaultWord
+         end
       
       (* Tuples of length <> 1 are always represented as records.
        * There will never be tuples of length one.
        *)
       datatype t = T of {equality: Equality.t,
-			 plist: PropertyList.t,
-			 time: Time.t ref,
-			 ty: ty} Set.t
+                         plist: PropertyList.t,
+                         time: Time.t ref,
+                         ty: ty} Set.t
       and ty =
-	 Con of Tycon.t * t vector
-	| FlexRecord of {fields: fields,
-			 spine: Spine.t}
-	(* GenFlexRecord only appears in type schemes.
-	 * It will never be unified.
-	 * The fields that are filled in after generalization are stored in
-	 * extra.
-	 *)
-	| GenFlexRecord of genFlexRecord
-	| Overload of Overload.t
-	| Record of t Srecord.t
-	| Unknown of Unknown.t
-	| Var of Tyvar.t
+         Con of Tycon.t * t vector
+        | FlexRecord of {fields: fields,
+                         spine: Spine.t}
+        (* GenFlexRecord only appears in type schemes.
+         * It will never be unified.
+         * The fields that are filled in after generalization are stored in
+         * extra.
+         *)
+        | GenFlexRecord of genFlexRecord
+        | Overload of Overload.t
+        | Record of t Srecord.t
+        | Unknown of Unknown.t
+        | Var of Tyvar.t
       withtype fields = (Field.t * t) list
       and genFlexRecord =
-	 {extra: unit -> {field: Field.t,
-			  tyvar: Tyvar.t} list,
-	  fields: (Field.t * t) list,
-	  spine: Spine.t}
+         {extra: unit -> {field: Field.t,
+                          tyvar: Tyvar.t} list,
+          fields: (Field.t * t) list,
+          spine: Spine.t}
  
       val newCloses: t list ref = ref []
 
       local
-	 fun make f (T s) = f (Set.! s)
+         fun make f (T s) = f (Set.! s)
       in
-	 val equality = make #equality
-	 val plist: t -> PropertyList.t = make #plist
-	 val toType: t -> ty = make #ty
+         val equality = make #equality
+         val plist: t -> PropertyList.t = make #plist
+         val toType: t -> ty = make #ty
       end
 
       local
-	 open Layout
+         open Layout
       in
-	 fun layoutFields fs =
-	    List.layout (Layout.tuple2 (Field.layout, layout)) fs
-	 and layout (T s) =
-	    let
-	       val {time, ty, ...} = Set.! s
-	    in
-	       record
-	       [("time", Time.layout (!time)),
-		("ty",
-		 case ty of
-		    Con (c, ts) =>
-		       paren (align [seq [str "Con ", Tycon.layout c],
-				     Vector.layout layout ts])
-		  | FlexRecord {fields, spine} =>
-		       seq [str "Flex ",
-			    record [("fields", layoutFields fields),
-				    ("spine", Spine.layout spine)]]
-		  | GenFlexRecord {fields, spine, ...} =>
-		       seq [str "GenFlex ",
-			    record [("fields", layoutFields fields),
-				    ("spine", Spine.layout spine)]]
-		  | Overload ov => Overload.layout ov
-		  | Record r => Srecord.layout {record = r,
-						separator = ": ",
-						extra = "",
-						layoutTuple = Vector.layout layout,
-						layoutElt = layout}
-		  | Unknown u => Unknown.layout u
-		  | Var a => paren (seq [str "Var ", Tyvar.layout a]))]
-	    end
+         fun layoutFields fs =
+            List.layout (Layout.tuple2 (Field.layout, layout)) fs
+         and layout (T s) =
+            let
+               val {time, ty, ...} = Set.! s
+            in
+               record
+               [("time", Time.layout (!time)),
+                ("ty",
+                 case ty of
+                    Con (c, ts) =>
+                       paren (align [seq [str "Con ", Tycon.layout c],
+                                     Vector.layout layout ts])
+                  | FlexRecord {fields, spine} =>
+                       seq [str "Flex ",
+                            record [("fields", layoutFields fields),
+                                    ("spine", Spine.layout spine)]]
+                  | GenFlexRecord {fields, spine, ...} =>
+                       seq [str "GenFlex ",
+                            record [("fields", layoutFields fields),
+                                    ("spine", Spine.layout spine)]]
+                  | Overload ov => Overload.layout ov
+                  | Record r => Srecord.layout {record = r,
+                                                separator = ": ",
+                                                extra = "",
+                                                layoutTuple = Vector.layout layout,
+                                                layoutElt = layout}
+                  | Unknown u => Unknown.layout u
+                  | Var a => paren (seq [str "Var ", Tyvar.layout a]))]
+            end
       end
 
       val toString = Layout.toString o layout
 
       fun admitsEquality t =
-	 case Equality.toBoolOpt (equality t) of
-	    NONE =>
-	       (* Could report an error here, but sometimes in a type-incorrect
-		* program, there will be unknown equalities.  So it is better
-		* to conservatively return equality true, which will cause fewer
-		* spurious errors.
-		*)
-	       true
-	  | SOME b => b
+         case Equality.toBoolOpt (equality t) of
+            NONE =>
+               (* Could report an error here, but sometimes in a type-incorrect
+                * program, there will be unknown equalities.  So it is better
+                * to conservatively return equality true, which will cause fewer
+                * spurious errors.
+                *)
+               true
+          | SOME b => b
 
       val admitsEquality =
-	 Trace.trace ("admitsEquality", layout, Bool.layout) admitsEquality
+         Trace.trace 
+         ("TypeEnv.Type.admitsEquality", layout, Bool.layout) 
+         admitsEquality
 
       val {get = opaqueTyconExpansion: Tycon.t -> (t vector -> t) option,
-	   set = setOpaqueTyconExpansion, ...} =
-	 Property.getSet (Tycon.plist, Property.initConst NONE)
+           set = setOpaqueTyconExpansion, ...} =
+         Property.getSet (Tycon.plist, Property.initConst NONE)
 
       val opaqueTyconExpansion =
-	 Trace.trace ("opaqueTyconExpansion",
-		      Tycon.layout,
-		      Layout.ignore)
-	 opaqueTyconExpansion
+         Trace.trace 
+         ("TypeEnv.Type.opaqueTyconExpansion", Tycon.layout, Layout.ignore)
+         opaqueTyconExpansion
 
       fun makeHom {con, expandOpaque, flexRecord, genFlexRecord, overload,
-		   record, recursive, unknown, var} =
-	 let
-	    datatype status = Processing | Seen | Unseen
-	    val {destroy = destroyStatus, get = status, ...} =
-	       Property.destGet (plist, Property.initFun (fn _ => ref Unseen))
-	    val {get, destroy = destroyProp} =
-	       Property.destGet
-	       (plist,
-		Property.initRec
-		(fn (t, get) =>
-		 let
-		    val r = status t
-		 in
-		    case !r of
-		       Seen => Error.bug "impossible"
-		     | Processing => recursive t
-		     | Unseen =>
-			  let
-			     val _ = r := Processing
-			     fun loopFields fields =
-				List.revMap (fields, fn (f, t) => (f, get t))
-			     val res = 
-				case toType t of
-				   Con (c, ts) =>
-				      let
-					 fun no () =
-					    con (t, c, Vector.map (ts, get))
-					 fun yes () =
-					    (case opaqueTyconExpansion c of
-						NONE => no ()
-					      | SOME f => get (f ts))
-				      in
-					 if expandOpaque then yes () else no ()
-				      end
-				 | FlexRecord {fields, spine} =>
-				      flexRecord (t, {fields = loopFields fields,
-						      spine = spine})
-				 | GenFlexRecord {extra, fields, spine} =>
-				      genFlexRecord
-				      (t, {extra = extra,
-					   fields = loopFields fields,
-					   spine = spine})
-				 | Overload ov => overload (t, ov)
-				 | Record r => record (t, Srecord.map (r, get))
-				 | Unknown u => unknown (t, u)
-				 | Var a => var (t, a)
-			     val _ = r := Seen
-			  in
-			     res
-			  end
-		 end))
-	    fun destroy () =
-	       (destroyStatus ()
-		; destroyProp ())
-	 in
-	    {hom = get, destroy = destroy}
-	 end
+                   record, recursive, unknown, var} =
+         let
+            datatype status = Processing | Seen | Unseen
+            val {destroy = destroyStatus, get = status, ...} =
+               Property.destGet (plist, Property.initFun (fn _ => ref Unseen))
+            val {get, destroy = destroyProp} =
+               Property.destGet
+               (plist,
+                Property.initRec
+                (fn (t, get) =>
+                 let
+                    val r = status t
+                 in
+                    case !r of
+                       Seen => Error.bug "TypeEnv.Type.makeHom: impossible"
+                     | Processing => recursive t
+                     | Unseen =>
+                          let
+                             val _ = r := Processing
+                             fun loopFields fields =
+                                List.revMap (fields, fn (f, t) => (f, get t))
+                             val res = 
+                                case toType t of
+                                   Con (c, ts) =>
+                                      let
+                                         fun no () =
+                                            con (t, c, Vector.map (ts, get))
+                                         fun yes () =
+                                            (case opaqueTyconExpansion c of
+                                                NONE => no ()
+                                              | SOME f => get (f ts))
+                                      in
+                                         if expandOpaque then yes () else no ()
+                                      end
+                                 | FlexRecord {fields, spine} =>
+                                      flexRecord (t, {fields = loopFields fields,
+                                                      spine = spine})
+                                 | GenFlexRecord {extra, fields, spine} =>
+                                      genFlexRecord
+                                      (t, {extra = extra,
+                                           fields = loopFields fields,
+                                           spine = spine})
+                                 | Overload ov => overload (t, ov)
+                                 | Record r => record (t, Srecord.map (r, get))
+                                 | Unknown u => unknown (t, u)
+                                 | Var a => var (t, a)
+                             val _ = r := Seen
+                          in
+                             res
+                          end
+                 end))
+            fun destroy () =
+               (destroyStatus ()
+                ; destroyProp ())
+         in
+            {hom = get, destroy = destroy}
+         end
 
       fun hom (ty, z) =
-	 let
-	    val {hom, destroy} = makeHom z
-	 in
-	    DynamicWind.wind (fn () => hom ty, destroy)
-	 end
+         let
+            val {hom, destroy} = makeHom z
+         in
+            Exn.finally (fn () => hom ty, destroy)
+         end
 
       fun makeLayoutPretty (): {destroy: unit -> unit,
-				lay: t -> Layout.t * {isChar: bool,
-						      needsParen: bool}} =
-	 let
-	    val str = Layout.str
-	    fun con (_, c, ts) = Tycon.layoutApp (c, ts)
-	    fun con0 c = Tycon.layoutApp (c, Vector.new0 ())
-	    fun flexRecord (_, {fields, spine}) =
-	       layoutRecord
-	       (List.fold
-		(fields,
-		 Spine.foldOverNew (spine, fields, [], fn (f, ac) =>
-				    (f, false, simple (str "unit"))
-				    :: ac),
-		 fn ((f, t), ac) => (f, false, t) :: ac),
-		Spine.canAddFields spine)
-	    fun genFlexRecord (_, {extra, fields, spine}) =
-	       layoutRecord
-	       (List.fold
-		(fields,
-		 List.revMap (extra (), fn {field, tyvar} =>
-			      (field, false, simple (Tyvar.layout tyvar))),
-		 fn ((f, t), ac) => (f, false, t) :: ac),
-		Spine.canAddFields spine)
-	    fun overload (_, ov) = con0 (Overload.defaultTycon ov)
-	    fun record (_, r) =
-	       case Srecord.detupleOpt r of
-		  NONE =>
-		     layoutRecord (Vector.toListMap (Srecord.toVector r,
-						     fn (f, t) => (f, false, t)),
-				   false)
-		| SOME ts => Tycon.layoutApp (Tycon.tuple, ts)
-	    fun recursive _ = simple (str "<recur>")
-	    fun unknown _ = simple (str "???")
-	    val {destroy, get = prettyTyvar, ...} =
-	       Property.destGet
-	       (Tyvar.plist,
-		Property.initFun
-		(let
-		    val r = ref (Char.toInt #"a")
-		 in
-		    fn _ =>
-		    let
-		       val n = !r
-		       val l =
-			  simple
-			  (str (concat ["'", Char.toString (Char.fromInt n)]))
-		       val _ = r := 1 + n
-		    in
-		       l
-		    end
-		 end))
-	    fun var (_, a) = prettyTyvar a
-	    fun lay t =
-	       hom (t, {con = con,
-			expandOpaque = false,
-			flexRecord = flexRecord,
-			genFlexRecord = genFlexRecord,
-			overload = overload,
-			record = record,
-			recursive = recursive,
-			unknown = unknown,
-			var = var})
-	 in
-	    {destroy = destroy,
-	     lay = lay}
-	 end
+                                lay: t -> Layout.t * {isChar: bool,
+                                                      needsParen: bool}} =
+         let
+            val str = Layout.str
+            fun con (_, c, ts) = Tycon.layoutApp (c, ts)
+            fun con0 c = Tycon.layoutApp (c, Vector.new0 ())
+            fun flexRecord (_, {fields, spine}) =
+               layoutRecord
+               (List.fold
+                (fields,
+                 Spine.foldOverNew (spine, fields, [], fn (f, ac) =>
+                                    (f, false, simple (str "unit"))
+                                    :: ac),
+                 fn ((f, t), ac) => (f, false, t) :: ac),
+                Spine.canAddFields spine)
+            fun genFlexRecord (_, {extra, fields, spine}) =
+               layoutRecord
+               (List.fold
+                (fields,
+                 List.revMap (extra (), fn {field, tyvar} =>
+                              (field, false, simple (Tyvar.layout tyvar))),
+                 fn ((f, t), ac) => (f, false, t) :: ac),
+                Spine.canAddFields spine)
+            fun overload (_, ov) = con0 (Overload.defaultTycon ov)
+            fun record (_, r) =
+               case Srecord.detupleOpt r of
+                  NONE =>
+                     layoutRecord (Vector.toListMap (Srecord.toVector r,
+                                                     fn (f, t) => (f, false, t)),
+                                   false)
+                | SOME ts => Tycon.layoutApp (Tycon.tuple, ts)
+            fun recursive _ = simple (str "<recur>")
+            fun unknown _ = simple (str "???")
+            val {destroy, get = prettyTyvar, ...} =
+               Property.destGet
+               (Tyvar.plist,
+                Property.initFun
+                (let
+                    val r = ref (Char.toInt #"a")
+                 in
+                    fn _ =>
+                    let
+                       val n = !r
+                       val l =
+                          simple
+                          (str (concat
+                                ["'",
+                                 if n > Char.toInt #"z" then
+                                    concat ["a",
+                                            Int.toString (n - Char.toInt #"z")]
+                                 else
+                                    Char.toString (Char.fromInt n )]))
+                       val _ = r := 1 + n
+                    in
+                       l
+                    end
+                 end))
+            fun var (_, a) = prettyTyvar a
+            fun lay t =
+               hom (t, {con = con,
+                        expandOpaque = false,
+                        flexRecord = flexRecord,
+                        genFlexRecord = genFlexRecord,
+                        overload = overload,
+                        record = record,
+                        recursive = recursive,
+                        unknown = unknown,
+                        var = var})
+         in
+            {destroy = destroy,
+             lay = lay}
+         end
 
       fun layoutPretty t =
-	 let
-	    val {destroy, lay} = makeLayoutPretty ()
-	    val res = #1 (lay t)
-	    val _ = destroy ()
-	 in
-	    res
-	 end
+         let
+            val {destroy, lay} = makeLayoutPretty ()
+            val res = #1 (lay t)
+            val _ = destroy ()
+         in
+            res
+         end
 
       fun deConOpt t =
-	 case toType t of
-	    Con x => SOME x
-	  | _ => NONE
+         case toType t of
+            Con x => SOME x
+          | _ => NONE
 
       fun deEta (t: t, tyvars: Tyvar.t vector): Tycon.t option =
-	 case deConOpt t of
-	    SOME (c, ts) =>
-	       if Vector.length ts = Vector.length tyvars
-		  andalso Vector.foralli (ts, fn (i, t) =>
-					  case toType t of
-					     Var a =>
-						Tyvar.equals
-						(a, Vector.sub (tyvars, i))
-					   | _ => false)
-		  then SOME c
-	       else NONE
+         case deConOpt t of
+            SOME (c, ts) =>
+               if Vector.length ts = Vector.length tyvars
+                  andalso Vector.foralli (ts, fn (i, t) =>
+                                          case toType t of
+                                             Var a =>
+                                                Tyvar.equals
+                                                (a, Vector.sub (tyvars, i))
+                                           | _ => false)
+                  then SOME c
+               else NONE
            | _ => NONE
 
 
       fun newTy (ty: ty, eq: Equality.t): t =
-	 T (Set.singleton {equality = eq,
-			   plist = PropertyList.new (),
-			   time = ref (Time.now ()),
-			   ty = ty})
+         T (Set.singleton {equality = eq,
+                           plist = PropertyList.new (),
+                           time = ref (Time.now ()),
+                           ty = ty})
 
       fun unknown {canGeneralize, equality} =
-	 let
-	    val t = newTy (Unknown (Unknown.new {canGeneralize = canGeneralize}),
-			   equality)
-	    val _ = List.push (newCloses, t)
-	 in
-	    t
-	 end
+         let
+            val t = newTy (Unknown (Unknown.new {canGeneralize = canGeneralize}),
+                           equality)
+            val _ = List.push (newCloses, t)
+         in
+            t
+         end
 
       fun new () = unknown {canGeneralize = true,
-			    equality = Equality.unknown ()}
+                            equality = Equality.unknown ()}
 
       fun newFlex {fields, spine} =
-	 newTy (FlexRecord {fields = fields,
-			    spine = spine},
-		Equality.and2
-		(Equality.andd (Vector.fromListMap (fields, equality o #2)),
-		 Equality.unknown ()))
+         newTy (FlexRecord {fields = fields,
+                            spine = spine},
+                Equality.and2
+                (Equality.andd (Vector.fromListMap (fields, equality o #2)),
+                 Equality.unknown ()))
 
       fun flexRecord record =
-	 let
-	    val v = Srecord.toVector record
-	    val spine = Spine.new (Vector.toListMap (v, #1))
-	    fun isResolved (): bool = not (Spine.canAddFields spine)
-	    val t = newFlex {fields = Vector.toList v,
-			     spine = spine}
-	    val _ = List.push (newCloses, t)
-	 in
-	    (t, isResolved)
-	 end
-	 
+         let
+            val v = Srecord.toVector record
+            val spine = Spine.new (Vector.toListMap (v, #1))
+            fun isResolved (): bool = not (Spine.canAddFields spine)
+            val t = newFlex {fields = Vector.toList v,
+                             spine = spine}
+            val _ = List.push (newCloses, t)
+         in
+            (t, isResolved)
+         end
+         
       fun record r =
-	 newTy (Record r,
-		Equality.andd (Vector.map (Srecord.range r, equality)))
+         newTy (Record r,
+                Equality.andd (Vector.map (Srecord.range r, equality)))
 
       fun tuple ts =
-	 if 1 = Vector.length ts
-	    then Vector.sub (ts, 0)
-	 else newTy (Record (Srecord.tuple ts),
-		     Equality.andd (Vector.map (ts, equality)))
+         if 1 = Vector.length ts
+            then Vector.sub (ts, 0)
+         else newTy (Record (Srecord.tuple ts),
+                     Equality.andd (Vector.map (ts, equality)))
 
       fun con (tycon, ts) =
-	 if Tycon.equals (tycon, Tycon.tuple)
-	    then tuple ts
-	 else newTy (Con (tycon, ts),
-		     Equality.applyTycon (tycon, Vector.map (ts, equality)))
+         if Tycon.equals (tycon, Tycon.tuple)
+            then tuple ts
+         else newTy (Con (tycon, ts),
+                     Equality.applyTycon (tycon, Vector.map (ts, equality)))
 
       fun var a = newTy (Var a, Equality.fromBool (Tyvar.isEquality a))
    end
@@ -753,7 +761,7 @@
    Type.setOpaqueTyconExpansion (c, SOME f)
 
 structure Ops = TypeOps (structure Tycon = Tycon
-			 open Type)
+                         open Type)
    
 structure Type =
    struct
@@ -764,510 +772,515 @@
 
       fun char s = con (Tycon.char s, Vector.new0 ())
       val string = con (Tycon.vector, Vector.new1 (char CharSize.C1))
-	 
+         
       val unit = tuple (Vector.new0 ())
 
+      fun isBool t =
+         case toType t of
+            Con (c, _) => Tycon.isBool c
+          | _ => false
+
       fun isCharX t =
-	 case toType t of
- 	    Con (c, _) => Tycon.isCharX c
-	  | Overload Overload.Char => true
- 	  | _ => false
+         case toType t of
+            Con (c, _) => Tycon.isCharX c
+          | Overload Overload.Char => true
+          | _ => false
 
+      fun isExn t =
+         case toType t of
+            Con (c, _) => Tycon.isExn c
+          | _ => false
+
       fun isInt t =
-	 case toType t of
-	    Con (c, _) => Tycon.isIntX c
-	  | Overload Overload.Int => true
-	  | _ => false
-	       
+         case toType t of
+            Con (c, _) => Tycon.isIntX c
+          | Overload Overload.Int => true
+          | _ => false
+               
       fun isUnit t =
-	 case toType t of
-	    Record r =>
-	       (case Srecord.detupleOpt r of
-		   NONE => false
-		 | SOME v => 0 = Vector.length v)
-	  | _ => false
+         case toType t of
+            Record r =>
+               (case Srecord.detupleOpt r of
+                   NONE => false
+                 | SOME v => 0 = Vector.length v)
+          | _ => false
 
       local
-	 fun make (ov, eq) () = newTy (Overload ov, eq)
-	 datatype z = datatype Overload.t
+         fun make (ov, eq) () = newTy (Overload ov, eq)
+         datatype z = datatype Overload.t
       in
-	 val unresolvedChar = make (Char, Equality.truee)
-	 val unresolvedInt = make (Int, Equality.truee)
-	 val unresolvedReal = make (Real, Equality.falsee)
-	 val unresolvedWord = make (Word, Equality.truee)
+         val unresolvedChar = make (Char, Equality.truee)
+         val unresolvedInt = make (Int, Equality.truee)
+         val unresolvedReal = make (Real, Equality.falsee)
+         val unresolvedWord = make (Word, Equality.truee)
       end
 
       fun unresolvedString () = vector (unresolvedChar ())
    
       val traceCanUnify =
-	 Trace.trace2 ("canUnify", layout, layout, Bool.layout)
+         Trace.trace2 
+         ("TypeEnv.Type.canUnify", layout, layout, Bool.layout)
 
       fun canUnify arg = 
-	 traceCanUnify
-	 (fn (t, t') =>
-	  case (toType t, toType t') of
-	     (Unknown _,  _) => true
-	   | (_, Unknown _) => true
-	   | (Con (c, ts), t') => conAnd (c, ts, t')
-	   | (t', Con (c, ts)) => conAnd (c, ts, t')
-	   | (Overload o1, Overload o2) => Overload.equals (o1, o2)
-	   | (Record r, Record r') =>
-		let
-		   val fs = Srecord.toVector r
-		   val fs' = Srecord.toVector r'
-		in Vector.length fs = Vector.length fs'
-		   andalso Vector.forall2 (fs, fs', fn ((f, t), (f', t')) =>
-					   Field.equals (f, f')
-					   andalso canUnify (t, t'))
-		end
-	   | (Var a, Var a') => Tyvar.equals (a, a')
-	   | _ => false) arg
+         traceCanUnify
+         (fn (t, t') =>
+          case (toType t, toType t') of
+             (Unknown _,  _) => true
+           | (_, Unknown _) => true
+           | (Con (c, ts), t') => conAnd (c, ts, t')
+           | (t', Con (c, ts)) => conAnd (c, ts, t')
+           | (Overload o1, Overload o2) => Overload.equals (o1, o2)
+           | (Record r, Record r') =>
+                let
+                   val fs = Srecord.toVector r
+                   val fs' = Srecord.toVector r'
+                in Vector.length fs = Vector.length fs'
+                   andalso Vector.forall2 (fs, fs', fn ((f, t), (f', t')) =>
+                                           Field.equals (f, f')
+                                           andalso canUnify (t, t'))
+                end
+           | (Var a, Var a') => Tyvar.equals (a, a')
+           | _ => false) arg
       and conAnd (c, ts, t') =
-	 case t' of
-	    Con (c', ts') =>
-	       Tycon.equals (c, c')
-	       andalso Vector.forall2 (ts, ts', canUnify)
-	  | Overload ov =>
-	       0 = Vector.length ts andalso Overload.matchesTycon (ov, c)
-	  | _ => false
+         case t' of
+            Con (c', ts') =>
+               Tycon.equals (c, c')
+               andalso Vector.forall2 (ts, ts', canUnify)
+          | Overload ov =>
+               0 = Vector.length ts andalso Overload.matchesTycon (ov, c)
+          | _ => false
 
       (* minTime (t, bound) ensures that all components of t have times no larger
        * than bound.  It calls the appropriate error function when it encounters
        * a tycon that is used before it defined.
        *)
       fun minTime (t, bound: Time.t): unit =
-	 let
-	    fun loop (T s): unit =
-	       let
-		  val {time, ty, ...} = Set.! s
-	       in
-		  if Time.<= (!time, bound)
-		     then ()
-		  else
-		     let
-			val _ = time := bound
-		     in
-			case ty of
-			   Con (c, ts) =>
-			      let
-				 val r = tyconTime c
-				 val _ =
-				    if Time.<= (!r, bound)
-				       then ()
-				    else
-				       let
-					  val _ = r := bound
-					  val _ = Time.useBeforeDef (bound, c)
-				       in
-					  ()
-				       end
-				 val _ = Vector.foreach (ts, loop)
-			      in
-				 ()
-			      end
-			 | FlexRecord {fields, ...} => loopFields fields
-			 | GenFlexRecord {fields, ...} => loopFields fields
-			 | Overload _ => ()
-			 | Record r => Srecord.foreach (r, loop)
-			 | Unknown _ => ()
-			 | Var a =>
-			      let
-				 val r = tyvarTime a
-			      in
-				 if Time.<= (!r, bound)
-				    then ()
-				 else r := bound
-			      end
-		     end
-	       end
-	    and loopFields (fs: (Field.t * t) list) =
-	       List.foreach (fs, loop o #2)
-	    val _ = loop t
-	 in
-	    ()
-	 end
+         let
+            fun loop (T s): unit =
+               let
+                  val {time, ty, ...} = Set.! s
+               in
+                  if Time.<= (!time, bound)
+                     then ()
+                  else
+                     let
+                        val _ = time := bound
+                     in
+                        case ty of
+                           Con (c, ts) =>
+                              let
+                                 val r = tyconTime c
+                                 val _ =
+                                    if Time.<= (!r, bound)
+                                       then ()
+                                    else
+                                       let
+                                          val _ = r := bound
+                                          val _ = Time.useBeforeDef (bound, c)
+                                       in
+                                          ()
+                                       end
+                                 val _ = Vector.foreach (ts, loop)
+                              in
+                                 ()
+                              end
+                         | FlexRecord {fields, ...} => loopFields fields
+                         | GenFlexRecord {fields, ...} => loopFields fields
+                         | Overload _ => ()
+                         | Record r => Srecord.foreach (r, loop)
+                         | Unknown _ => ()
+                         | Var a =>
+                              let
+                                 val r = tyvarTime a
+                              in
+                                 if Time.<= (!r, bound)
+                                    then ()
+                                 else r := bound
+                              end
+                     end
+               end
+            and loopFields (fs: (Field.t * t) list) =
+               List.foreach (fs, loop o #2)
+            val _ = loop t
+         in
+            ()
+         end
 
       val minTime =
-	 Trace.trace2 ("minTime", layout, Time.layout, Unit.layout) minTime
+         Trace.trace2 
+         ("TypeEnv.Type.minTime", layout, Time.layout, Unit.layout) 
+         minTime
 
       datatype z = datatype UnifyResult.t
 
-      val traceUnify = Trace.trace2 ("unify", layout, layout, UnifyResult.layout)
+      val traceUnify = 
+         Trace.trace2 
+         ("TypeEnv.Type.unify", layout, layout, UnifyResult.layout)
 
-      fun unify (t, t', {preError}): UnifyResult.t =
-	 let
-	    val {destroy, lay = layoutPretty} = makeLayoutPretty ()
-	    val dontCare' =
-	       case !Control.typeError of
-		  Control.Concise => (fn _ => dontCare)
-		| Control.Full => layoutPretty
-	    val layoutRecord =
-	       fn z => layoutRecord (z,
-				     case !Control.typeError of
-					Control.Concise => true
-				      | Control.Full => false)
-	    fun unify arg =
-	       traceUnify
-	       (fn (outer as T s, outer' as T s') =>
-		if Set.equals (s, s')
-		   then Unified
-		else
-		   let
-		      fun notUnifiable (l: Lay.t, l': Lay.t) =
-			 (NotUnifiable (l, l'),
-			  Unknown (Unknown.new {canGeneralize = true}))
-		      val bracket =
-			 fn (l, {isChar, needsParen = _}) =>
-			 (bracket l,
-			  {isChar = isChar,
-			   needsParen = false})
-		      fun notUnifiableBracket (l, l') =
-			 notUnifiable (bracket l, bracket l')
-		      fun flexToRecord (fields, spine) =
-			 (Vector.fromList fields,
-			  Vector.fromList
-			  (List.fold
-			   (Spine.fields spine, [], fn (f, ac) =>
-			    if List.exists (fields, fn (f', _) =>
-					    Field.equals (f, f'))
-			       then ac
-			    else f :: ac)),
-			  fn f => Spine.ensureField (spine, f))
-		      fun rigidToRecord r =
-			 (Srecord.toVector r,
-			  Vector.new0 (),
-			  fn f => isSome (Srecord.peek (r, f)))
-		      fun oneFlex ({fields, spine}, time, r, outer, swap) =
-			 unifyRecords
-			 (flexToRecord (fields, spine),
-			  rigidToRecord r,
-			  fn () => (minTime (outer, time)
-				    ; Spine.noMoreFields spine
-				    ; (Unified, Record r)),
-			  fn (l, l') => notUnifiable (if swap
-							 then (l', l)
-						      else (l, l')))
-		      fun genFlexError () =
-			 Error.bug "GenFlexRecord seen in unify"
-		      val {equality = e, time, ty = t, plist} = Set.! s
-		      val {equality = e', time = time', ty = t', ...} =
-			 Set.! s'
-		      fun not () =
-			 (preError ()
-			  ; notUnifiableBracket (layoutPretty outer,
-						 layoutPretty outer'))
-		      fun unifys (ts, ts', yes, no) =
-			 let
-			    val us = Vector.map2 (ts, ts', unify)
-			 in
-			    if Vector.forall
-			       (us, fn Unified => true | _ => false)
-			       then yes ()
-			    else
-			       let
-				  val (ls, ls') =
-				     Vector.unzip
-				     (Vector.mapi
-				      (us, fn (i, u) =>
-				       case u of
-					  Unified =>
-					     let
-						val z =
-						   dontCare' (Vector.sub (ts, i))
-					     in
-						(z, z)
-					     end
-					| NotUnifiable (l, l') => (l, l')))
-			       in
-				  no (ls, ls')
-			       end
-			 end
-		      fun conAnd (c, ts, t, t', swap) =
-			 let
-			    fun maybe (z, z') =
-			       if swap then (z', z) else (z, z')
-			 in
-			    case t of
-			       Con (c', ts') =>
-				  if Tycon.equals (c, c')
-				     then
-					if Vector.length ts <> Vector.length ts'
-					   then
-					      let
-						 fun lay ts =
-						    simple
-						    (Layout.seq
-						     [Layout.str
-						      (concat ["<",
-							       Int.toString
-							       (Vector.length ts),
-							       " args> "]),
-						      Tycon.layout c])
-						 val _ = preError ()
-					      in
-						 notUnifiableBracket
-						 (maybe (lay ts, lay ts'))
-					      end
-					else
-					   unifys
-					   (ts, ts',
-					    fn () => (Unified, t),
-					    fn (ls, ls') =>
-					    let 
-					       fun lay ls =
-						  Tycon.layoutApp (c, ls)
-					    in
-					       notUnifiable
-					       (maybe (lay ls, lay ls'))
-					    end)
-				  else not ()
+      fun unify (t, t', {preError: unit -> unit}): UnifyResult.t =
+         let
+            val {destroy, lay = layoutPretty} = makeLayoutPretty ()
+            val dontCare' = fn _ => dontCare
+            val layoutRecord = fn z => layoutRecord (z, true)
+            fun unify arg =
+               traceUnify
+               (fn (outer as T s, outer' as T s') =>
+                if Set.equals (s, s')
+                   then Unified
+                else
+                   let
+                      fun notUnifiable (l: Lay.t, l': Lay.t) =
+                         (NotUnifiable (l, l'),
+                          Unknown (Unknown.new {canGeneralize = true}))
+                      val bracket =
+                         fn (l, {isChar, needsParen = _}) =>
+                         (bracket l,
+                          {isChar = isChar,
+                           needsParen = false})
+                      fun notUnifiableBracket (l, l') =
+                         notUnifiable (bracket l, bracket l')
+                      fun flexToRecord (fields, spine) =
+                         (Vector.fromList fields,
+                          Vector.fromList
+                          (List.fold
+                           (Spine.fields spine, [], fn (f, ac) =>
+                            if List.exists (fields, fn (f', _) =>
+                                            Field.equals (f, f'))
+                               then ac
+                            else f :: ac)),
+                          fn f => Spine.ensureField (spine, f))
+                      fun rigidToRecord r =
+                         (Srecord.toVector r,
+                          Vector.new0 (),
+                          fn f => isSome (Srecord.peek (r, f)))
+                      fun oneFlex ({fields, spine}, time, r, outer, swap) =
+                         unifyRecords
+                         (flexToRecord (fields, spine),
+                          rigidToRecord r,
+                          fn () => (minTime (outer, time)
+                                    ; Spine.noMoreFields spine
+                                    ; (Unified, Record r)),
+                          fn (l, l') => notUnifiable (if swap
+                                                         then (l', l)
+                                                      else (l, l')))
+                      fun genFlexError () =
+                         Error.bug "TypeEnv.Type.unify: GenFlexRecord"
+                      val {equality = e, time, ty = t, plist} = Set.! s
+                      val {equality = e', time = time', ty = t', ...} =
+                         Set.! s'
+                      fun not () =
+                         (preError ()
+                          ; notUnifiableBracket (layoutPretty outer,
+                                                 layoutPretty outer'))
+                      fun unifys (ts, ts', yes, no) =
+                         let
+                            val us = Vector.map2 (ts, ts', unify)
+                         in
+                            if Vector.forall
+                               (us, fn Unified => true | _ => false)
+                               then yes ()
+                            else
+                               let
+                                  val (ls, ls') =
+                                     Vector.unzip
+                                     (Vector.mapi
+                                      (us, fn (i, u) =>
+                                       case u of
+                                          Unified =>
+                                             let
+                                                val z =
+                                                   dontCare' (Vector.sub (ts, i))
+                                             in
+                                                (z, z)
+                                             end
+                                        | NotUnifiable (l, l') => (l, l')))
+                               in
+                                  no (ls, ls')
+                               end
+                         end
+                      fun conAnd (c, ts, t, t', swap) =
+                         let
+                            fun maybe (z, z') =
+                               if swap then (z', z) else (z, z')
+                         in
+                            case t of
+                               Con (c', ts') =>
+                                  if Tycon.equals (c, c')
+                                     then
+                                        if Vector.length ts <> Vector.length ts'
+                                           then
+                                              let
+                                                 fun lay ts =
+                                                    simple
+                                                    (Layout.seq
+                                                     [Layout.str
+                                                      (concat ["<",
+                                                               Int.toString
+                                                               (Vector.length ts),
+                                                               " args> "]),
+                                                      Tycon.layout c])
+                                                 val _ = preError ()
+                                              in
+                                                 notUnifiableBracket
+                                                 (maybe (lay ts, lay ts'))
+                                              end
+                                        else
+                                           unifys
+                                           (ts, ts',
+                                            fn () => (Unified, t),
+                                            fn (ls, ls') =>
+                                            let 
+                                               fun lay ls =
+                                                  Tycon.layoutApp (c, ls)
+                                            in
+                                               notUnifiable
+                                               (maybe (lay ls, lay ls'))
+                                            end)
+                                  else not ()
                              | Overload ov =>
-				  if Vector.isEmpty ts
-				     andalso Overload.matchesTycon (ov, c)
-				     then (Unified, t')
-				  else not ()
-			     | _ => not ()
-			 end
-		      fun oneUnknown (u: Unknown.t, time,
-				      t: Type.ty,
-				      outer: Type.t,
-				      _: bool) =
-			 let
-			    (* This should fail if the unknown occurs in t.
-			     *)
-			    fun con (_, _, ts) =
-			       Vector.exists (ts, fn b => b)
-			    fun doFields fields =
-			       List.exists (fields, fn (_, b) => b)
-			    fun flexRecord (_, {fields, spine = _}) =
-			       doFields fields
-			    fun genFlexRecord (_, {extra = _, fields,
-						   spine = _}) =
-			       doFields fields
-			    fun record (_, r) = Srecord.exists (r, fn b => b)
-			    fun unknown (_, u') = Unknown.equals (u, u')
-			    fun no _ = false
-			    val isCircular =
-			       hom (outer,
-				    {con = con,
-				     expandOpaque = false,
-				     flexRecord = flexRecord,
-				     genFlexRecord = genFlexRecord,
-				     overload = no,
-				     record = record,
-				     recursive = fn _ => Error.bug "oneUnknown recursive",
-				     unknown = unknown,
-				     var = no})
-			 in
-			    if isCircular
-			       then not ()
-			    else
-			       let
-				  val () = minTime (outer, time)
-			       in
-				  (Unified, t)
-			       end
-			 end
-		      val (res, t) =
-			 case (t, t') of
-			    (Unknown r, Unknown r') =>
-			       (Unified, Unknown (Unknown.join (r, r')))
-			  | (Unknown u, _) =>
-			       oneUnknown (u, !time, t', outer', false)
-			  | (_, Unknown u') =>
-			       oneUnknown (u', !time', t, outer, true)
-			  | (Con (c, ts), _) => conAnd (c, ts, t', t, false)
-			  | (_, Con (c, ts)) => conAnd (c, ts, t, t', true)
-			  | (FlexRecord f, Record r') =>
-			       oneFlex (f, !time, r', outer', false)
-			  | (Record r, FlexRecord f') =>
-			       oneFlex (f', !time', r, outer, true)
-			  | (FlexRecord {fields = fields, spine = s},
-			     FlexRecord {fields = fields', spine = s'}) =>
-			    let
-			       fun yes () =
-				  let
-				     val () = Spine.unify (s, s')
-				     val () = minTime (outer, !time')
-				     val () = minTime (outer', !time)
-				     val fields =
-					List.fold
-					(fields, fields', fn ((f, t), ac) =>
-					 if List.exists (fields', fn (f', _) =>
-							 Field.equals (f, f'))
-					    then ac
-					 else (f, t) :: ac)
-				  in
-				     (Unified,
-				      FlexRecord {fields = fields,
-						  spine = s})
-				  end
-			    in
-			       unifyRecords
-			       (flexToRecord (fields, s),
-				flexToRecord (fields', s'),
-				yes, notUnifiable)
-			    end
-			  | (GenFlexRecord _, _) => genFlexError ()
-			  | (_, GenFlexRecord _) => genFlexError ()
-			  | (Overload o1, Overload o2) =>
-			       if Overload.equals (o1, o2)
-				  then (Unified, t)
-			       else not ()
-			  | (Record r, Record r') =>
-			       (case (Srecord.detupleOpt r,
-				      Srecord.detupleOpt r') of
-				   (NONE, NONE) =>
-				      unifyRecords
-				      (rigidToRecord r, rigidToRecord r',
-				       fn () => (Unified, Record r),
-				       notUnifiable)
-				 | (SOME ts, SOME ts') =>
-				      if Vector.length ts = Vector.length ts'
-					 then
-					    unifys
-					    (ts, ts',
-					     fn () => (Unified, Record r),
-					     fn (ls, ls') =>
-					     notUnifiable (layoutTuple ls,
-							   layoutTuple ls'))
-				      else not ()
-				 | _ => not ())
-			  | (Var a, Var a') =>
-			       if Tyvar.equals (a, a')
-				  then (Unified, t)
-			       else not ()
-			  | _ => not ()
-		      val res =
-			 case res of
-			    NotUnifiable _ => res
-			  | Unified =>
-			       let
-				  val res = Equality.unify (e, e')
-				  val () =
-				     case res of
-					NotUnifiable _ => ()
-				      | Unified =>
-					   let
-					      val () = Set.union (s, s')
-					      val () =
-						 if Time.<= (!time, !time')
-						    then ()
-						 else time := !time'
-					      val () =
-						 Set.:= (s, {equality = e,
-							     plist = plist,
-							     time = time,
-							     ty = t})
-					   in
-					      ()
-					   end
-			       in
-				  res
-			       end
-		   in
-		      res
-		   end) arg
-	    and unifyRecords ((fields: (Field.t * t) vector,
-			       extra: Field.t vector,
-			       ensureField: Field.t -> bool),
-			      (fields': (Field.t * t) vector,
-			       extra': Field.t vector,
-			       ensureField': Field.t -> bool),
-			      yes, no) =
-	       let
-		  fun extras (extra, ensureField') =
-		     Vector.fold
-		     (extra, [], fn (f, ac) =>
-		      if ensureField' f
-			 then ac
-		      else (preError (); (f, true, dontCare) :: ac))
-		  val ac = extras (extra, ensureField')
-		  val ac' = extras (extra', ensureField)
-		  fun subset (fields, fields', ensureField', ac, ac',
-			      both, skipBoth) =
-		     Vector.fold
-		     (fields, (ac, ac', both), fn ((f, t), (ac, ac', both)) =>
-		      case Vector.peek (fields', fn (f', _) =>
-					Field.equals (f, f')) of
-			 NONE =>
-			    if ensureField' f
-			       then (ac, ac', both)
-			    else (preError ()
-				  ; ((f, true, dontCare' t) :: ac, ac', both))
-		       | SOME (_, t') =>
-			    if skipBoth
-			       then (ac, ac', both)
-			    else
-			       case unify (t, t') of
-				  NotUnifiable (l, l') =>
-				     ((f, false, l) :: ac,
-				      (f, false, l') :: ac',
-				      both)
-				| Unified =>
-				     (ac, ac',
-				      case !Control.typeError of
-					 Control.Concise => []
-				       | Control.Full => (f, t) :: both))
-		  val (ac, ac', both) =
-		     subset (fields, fields', ensureField', ac, ac', [], false)
-		  val (ac', ac, both) =
-		     subset (fields', fields, ensureField, ac', ac, both, true)
-	       in
-		  case (ac, ac') of
-		     ([], []) => yes ()
-		   | _ =>
-			let
-			   val _ = preError ()
-			   fun doit ac =
-			      layoutRecord (List.fold
-					    (both, ac, fn ((f, t), ac) =>
-					     (f, false, layoutPretty t) :: ac))
-			in
-			   no (doit ac, doit ac')
-			end
-	       end
-	    val _ = destroy ()
-	 in
-	    unify (t, t')
-	 end
+                                  if Vector.isEmpty ts
+                                     andalso Overload.matchesTycon (ov, c)
+                                     then (Unified, t')
+                                  else not ()
+                             | _ => not ()
+                         end
+                      fun oneUnknown (u: Unknown.t, time,
+                                      t: Type.ty,
+                                      outer: Type.t,
+                                      _: bool) =
+                         let
+                            (* This should fail if the unknown occurs in t.
+                             *)
+                            fun con (_, _, ts) =
+                               Vector.exists (ts, fn b => b)
+                            fun doFields fields =
+                               List.exists (fields, fn (_, b) => b)
+                            fun flexRecord (_, {fields, spine = _}) =
+                               doFields fields
+                            fun genFlexRecord (_, {extra = _, fields,
+                                                   spine = _}) =
+                               doFields fields
+                            fun record (_, r) = Srecord.exists (r, fn b => b)
+                            fun unknown (_, u') = Unknown.equals (u, u')
+                            fun no _ = false
+                            val isCircular =
+                               hom (outer,
+                                    {con = con,
+                                     expandOpaque = false,
+                                     flexRecord = flexRecord,
+                                     genFlexRecord = genFlexRecord,
+                                     overload = no,
+                                     record = record,
+                                     recursive = fn _ => 
+                                     Error.bug "TypeEnv.Type.unify.oneUnknown: recursive",
+                                     unknown = unknown,
+                                     var = no})
+                         in
+                            if isCircular
+                               then not ()
+                            else
+                               let
+                                  val () = minTime (outer, time)
+                               in
+                                  (Unified, t)
+                               end
+                         end
+                      val (res, t) =
+                         case (t, t') of
+                            (Unknown r, Unknown r') =>
+                               (Unified, Unknown (Unknown.join (r, r')))
+                          | (Unknown u, _) =>
+                               oneUnknown (u, !time, t', outer', false)
+                          | (_, Unknown u') =>
+                               oneUnknown (u', !time', t, outer, true)
+                          | (Con (c, ts), _) => conAnd (c, ts, t', t, false)
+                          | (_, Con (c, ts)) => conAnd (c, ts, t, t', true)
+                          | (FlexRecord f, Record r') =>
+                               oneFlex (f, !time, r', outer', false)
+                          | (Record r, FlexRecord f') =>
+                               oneFlex (f', !time', r, outer, true)
+                          | (FlexRecord {fields = fields, spine = s},
+                             FlexRecord {fields = fields', spine = s'}) =>
+                            let
+                               fun yes () =
+                                  let
+                                     val () = Spine.unify (s, s')
+                                     val () = minTime (outer, !time')
+                                     val () = minTime (outer', !time)
+                                     val fields =
+                                        List.fold
+                                        (fields, fields', fn ((f, t), ac) =>
+                                         if List.exists (fields', fn (f', _) =>
+                                                         Field.equals (f, f'))
+                                            then ac
+                                         else (f, t) :: ac)
+                                  in
+                                     (Unified,
+                                      FlexRecord {fields = fields,
+                                                  spine = s})
+                                  end
+                            in
+                               unifyRecords
+                               (flexToRecord (fields, s),
+                                flexToRecord (fields', s'),
+                                yes, notUnifiable)
+                            end
+                          | (GenFlexRecord _, _) => genFlexError ()
+                          | (_, GenFlexRecord _) => genFlexError ()
+                          | (Overload o1, Overload o2) =>
+                               if Overload.equals (o1, o2)
+                                  then (Unified, t)
+                               else not ()
+                          | (Record r, Record r') =>
+                               (case (Srecord.detupleOpt r,
+                                      Srecord.detupleOpt r') of
+                                   (NONE, NONE) =>
+                                      unifyRecords
+                                      (rigidToRecord r, rigidToRecord r',
+                                       fn () => (Unified, Record r),
+                                       notUnifiable)
+                                 | (SOME ts, SOME ts') =>
+                                      if Vector.length ts = Vector.length ts'
+                                         then
+                                            unifys
+                                            (ts, ts',
+                                             fn () => (Unified, Record r),
+                                             fn (ls, ls') =>
+                                             notUnifiable (layoutTuple ls,
+                                                           layoutTuple ls'))
+                                      else not ()
+                                 | _ => not ())
+                          | (Var a, Var a') =>
+                               if Tyvar.equals (a, a')
+                                  then (Unified, t)
+                               else not ()
+                          | _ => not ()
+                      val res =
+                         case res of
+                            NotUnifiable _ => res
+                          | Unified =>
+                               let
+                                  val res = Equality.unify (e, e')
+                                  val () =
+                                     case res of
+                                        NotUnifiable _ => ()
+                                      | Unified =>
+                                           let
+                                              val () = Set.union (s, s')
+                                              val () =
+                                                 if Time.<= (!time, !time')
+                                                    then ()
+                                                 else time := !time'
+                                              val () =
+                                                 Set.:= (s, {equality = e,
+                                                             plist = plist,
+                                                             time = time,
+                                                             ty = t})
+                                           in
+                                              ()
+                                           end
+                               in
+                                  res
+                               end
+                   in
+                      res
+                   end) arg
+            and unifyRecords ((fields: (Field.t * t) vector,
+                               extra: Field.t vector,
+                               ensureField: Field.t -> bool),
+                              (fields': (Field.t * t) vector,
+                               extra': Field.t vector,
+                               ensureField': Field.t -> bool),
+                              yes, no) =
+               let
+                  fun extras (extra, ensureField') =
+                     Vector.fold
+                     (extra, [], fn (f, ac) =>
+                      if ensureField' f
+                         then ac
+                      else (preError (); (f, true, dontCare) :: ac))
+                  val ac = extras (extra, ensureField')
+                  val ac' = extras (extra', ensureField)
+                  fun subset (fields, fields', ensureField', ac, ac',
+                              both, skipBoth) =
+                     Vector.fold
+                     (fields, (ac, ac', both), fn ((f, t), (ac, ac', both)) =>
+                      case Vector.peek (fields', fn (f', _) =>
+                                        Field.equals (f, f')) of
+                         NONE =>
+                            if ensureField' f
+                               then (ac, ac', both)
+                            else (preError ()
+                                  ; ((f, true, dontCare' t) :: ac, ac', both))
+                       | SOME (_, t') =>
+                            if skipBoth
+                               then (ac, ac', both)
+                            else
+                               case unify (t, t') of
+                                  NotUnifiable (l, l') =>
+                                     ((f, false, l) :: ac,
+                                      (f, false, l') :: ac',
+                                      both)
+                                | Unified => (ac, ac', []))
+                  val (ac, ac', both) =
+                     subset (fields, fields', ensureField', ac, ac', [], false)
+                  val (ac', ac, both) =
+                     subset (fields', fields, ensureField, ac', ac, both, true)
+               in
+                  case (ac, ac') of
+                     ([], []) => yes ()
+                   | _ =>
+                        let
+                           val _ = preError ()
+                           fun doit ac =
+                              layoutRecord (List.fold
+                                            (both, ac, fn ((f, t), ac) =>
+                                             (f, false, layoutPretty t) :: ac))
+                        in
+                           no (doit ac, doit ac')
+                        end
+               end
+            val _ = destroy ()
+         in
+            unify (t, t')
+         end
 
       structure UnifyResult' =
-	 struct
-	    datatype t =
-	       NotUnifiable of Layout.t * Layout.t
-	     | Unified
-	 end
+         struct
+            datatype t =
+               NotUnifiable of Layout.t * Layout.t
+             | Unified
+         end
 
       datatype unifyResult = datatype UnifyResult'.t
 
       val unify =
-	 fn (t, t', z) =>
-	 case unify (t, t', z) of
-	    UnifyResult.NotUnifiable ((l, _), (l', _)) => NotUnifiable (l, l')
-	  | UnifyResult.Unified => Unified
+         fn (t, t', z) =>
+         case unify (t, t', z) of
+            UnifyResult.NotUnifiable ((l, _), (l', _)) => NotUnifiable (l, l')
+          | UnifyResult.Unified => Unified
 
       val word8 = word WordSize.byte
 
       local
-	 val {get: Tycon.t -> (t * Tycon.t) option, set, ...} =
-	    Property.getSetOnce (Tycon.plist, Property.initConst NONE)
+         val {get: Tycon.t -> (t * Tycon.t) option, set, ...} =
+            Property.getSetOnce (Tycon.plist, Property.initConst NONE)
       in
-	 fun setSynonym (c, c') = set (c, SOME (con (c, Vector.new0 ()), c'))
-	 val synonym = get
+         fun setSynonym (c, c') = set (c, SOME (con (c, Vector.new0 ()), c'))
+         val synonym = get
       end
 
       val () =
-	 List.foreach
-	 (CharSize.all, fn s =>
-	  setSynonym (Tycon.char s,
-		      Tycon.word (WordSize.fromBits (CharSize.bits s))))
+         List.foreach
+         (CharSize.all, fn s =>
+          setSynonym (Tycon.char s,
+                      Tycon.word (WordSize.fromBits (CharSize.bits s))))
 
       val () =
-	 List.foreach
-	 (IntSize.all, fn s =>
-	  setSynonym (Tycon.int s,
-		      Tycon.word (WordSize.fromBits (IntSize.bits s))))
+         List.foreach
+         (IntSize.all, fn s =>
+          setSynonym (Tycon.int s,
+                      Tycon.word (WordSize.fromBits (IntSize.bits s))))
 
       val () = setSynonym (Tycon.pointer, Tycon.word (WordSize.pointer ()))
 
@@ -1275,304 +1288,305 @@
       val defaultInt = con (Tycon.int IntSize.default, Vector.new0 ())
 
       structure Overload =
-	 struct
-	    open Overload
-	       
-	    val defaultType =
-	       fn Char => defaultChar
-		| Int => defaultInt
-		| Real => defaultReal
-		| Word => defaultWord
-	 end
-	 
+         struct
+            open Overload
+               
+            val defaultType =
+               fn Char => defaultChar
+                | Int => defaultInt
+                | Real => defaultReal
+                | Word => defaultWord
+         end
+         
       fun 'a simpleHom {con: t * Tycon.t * 'a vector -> 'a,
-			expandOpaque: bool,
-			record: t * (Field.t * 'a) vector -> 'a,
-			replaceSynonyms: bool,
-			var: t * Tyvar.t -> 'a} =
-	 let
-	    val unit = con (unit, Tycon.tuple, Vector.new0 ())
-	    val unknown = unit
-	    fun sortFields (fields: (Field.t * 'a) list) =
-	       Array.toVector
-	       (QuickSort.sortArray
-		(Array.fromList fields, fn ((f, _), (f', _)) =>
-		 Field.<= (f, f')))
-	    fun unsorted (t, fields: (Field.t *  'a) list) =
-	       let
-		  val v = sortFields fields
-	       in
-		  record (t, v)
-	       end
-	    fun genFlexRecord (t, {extra, fields, spine = _}) =
-	       unsorted (t,
-			 List.fold
-			 (extra (), fields, fn ({field, tyvar}, ac) =>
-			  (field, var (Type.var tyvar, tyvar)) :: ac))
-	    fun flexRecord (t, {fields, spine}) =
-	       if Spine.canAddFields spine
-		  then Error.bug "Type.hom flexRecord"
-	       else unsorted (t,
-			      Spine.foldOverNew
-			      (spine, fields, fields, fn (f, ac) =>
-			       (f, unit) :: ac))
-	    fun recursive _ = Error.bug "Type.hom recursive"
-	    val con =
-	       if not replaceSynonyms
-		  then con
-	       else
-		  fn (t, c, ts) =>
-		  let
-		     val (t, c) =
-			case synonym c of
-			   NONE => (t, c)
-			 | SOME (t, c) => (t, c)
-		  in
-		     con (t, c, ts)
-		  end
-	    fun default (t, tycon) =
-	       fn t' =>
-	       let
-		  val _ = unify (t, t',
-				 {preError = fn _ => Error.bug "default unify"})
-	       in
-		  con (t, tycon, Vector.new0 ())
-	       end
-	    fun overload (t', ov) =
-	       let
-		  val t = Overload.defaultType ov
-		  val _ = unify (t, t',
-				 {preError = fn _ => Error.bug "default unify"})
-	       in
-		  con (t, Overload.defaultTycon ov, Vector.new0 ())
-	       end
-	 in
-	    makeHom {con = con,
-		     expandOpaque = expandOpaque,
-		     flexRecord = flexRecord,
-		     genFlexRecord = genFlexRecord,
-		     overload = overload,
-		     record = fn (t, r) => record (t, Srecord.toVector r),
-		     recursive = recursive,
-		     unknown = fn _ => unknown,
-		     var = var}
-	 end
+                        expandOpaque: bool,
+                        record: t * (Field.t * 'a) vector -> 'a,
+                        replaceSynonyms: bool,
+                        var: t * Tyvar.t -> 'a} =
+         let
+            val unit = con (unit, Tycon.tuple, Vector.new0 ())
+            val unknown = unit
+            fun sortFields (fields: (Field.t * 'a) list) =
+               let
+                  val a = Array.fromList fields
+                  val () =
+                     QuickSort.sortArray (a, fn ((f, _), (f', _)) =>
+                                          Field.<= (f, f'))
+               in
+                  Array.toVector a
+               end
+            fun unsorted (t, fields: (Field.t *  'a) list) =
+               let
+                  val v = sortFields fields
+               in
+                  record (t, v)
+               end
+            fun genFlexRecord (t, {extra, fields, spine = _}) =
+               unsorted (t,
+                         List.fold
+                         (extra (), fields, fn ({field, tyvar}, ac) =>
+                          (field, var (Type.var tyvar, tyvar)) :: ac))
+            fun flexRecord (t, {fields, spine}) =
+               if Spine.canAddFields spine
+                  then Error.bug "TypeEnv.Type.simpleHom: flexRecord"
+               else unsorted (t,
+                              Spine.foldOverNew
+                              (spine, fields, fields, fn (f, ac) =>
+                               (f, unit) :: ac))
+            fun recursive _ = Error.bug "TypeEnv.Type.simpleHom.recursive"
+            val con =
+               if not replaceSynonyms
+                  then con
+               else
+                  fn (t, c, ts) =>
+                  let
+                     val (t, c) =
+                        case synonym c of
+                           NONE => (t, c)
+                         | SOME (t, c) => (t, c)
+                  in
+                     con (t, c, ts)
+                  end
+            fun overload (t', ov) =
+               let
+                  val t = Overload.defaultType ov
+                  val _ = unify (t, t',
+                                 {preError = fn _ => 
+                                  Error.bug "TypeEnv.Type.simpleHom.overload"})
+               in
+                  con (t, Overload.defaultTycon ov, Vector.new0 ())
+               end
+         in
+            makeHom {con = con,
+                     expandOpaque = expandOpaque,
+                     flexRecord = flexRecord,
+                     genFlexRecord = genFlexRecord,
+                     overload = overload,
+                     record = fn (t, r) => record (t, Srecord.toVector r),
+                     recursive = recursive,
+                     unknown = fn _ => unknown,
+                     var = var}
+         end
    end
 
 structure Scheme =
    struct
       datatype t =
-	 General of {bound: unit -> Tyvar.t vector,
-		     canGeneralize: bool,
-		     flexes: Type.genFlexRecord list,
-		     tyvars: Tyvar.t vector,
-		     ty: Type.t}
+         General of {bound: unit -> Tyvar.t vector,
+                     canGeneralize: bool,
+                     flexes: Type.genFlexRecord list,
+                     tyvars: Tyvar.t vector,
+                     ty: Type.t}
        | Type of Type.t
       
       fun layout s =
-	 case s of
-	    Type t => Type.layout t
-	  | General {canGeneralize, tyvars, ty, ...} =>
-	       Layout.record [("canGeneralize", Bool.layout canGeneralize),
-			      ("tyvars", Vector.layout Tyvar.layout tyvars),
-			      ("ty", Type.layout ty)]
+         case s of
+            Type t => Type.layout t
+          | General {canGeneralize, tyvars, ty, ...} =>
+               Layout.record [("canGeneralize", Bool.layout canGeneralize),
+                              ("tyvars", Vector.layout Tyvar.layout tyvars),
+                              ("ty", Type.layout ty)]
 
       fun layoutPretty s =
-	 case s of
-	    Type t => Type.layoutPretty t
-	  | General {ty, ...} => Type.layoutPretty ty
+         case s of
+            Type t => Type.layoutPretty t
+          | General {ty, ...} => Type.layoutPretty ty
 
       val bound =
-	 fn General {bound, ...} => bound ()
-	  | Type _ => Vector.new0 ()
+         fn General {bound, ...} => bound ()
+          | Type _ => Vector.new0 ()
 
       val bound =
-	 Trace.trace ("Scheme.bound", layout, Vector.layout Tyvar.layout)
-	 bound
+         Trace.trace ("TypeEnv.Scheme.bound", layout, Vector.layout Tyvar.layout)
+         bound
 
       val ty =
-	 fn General {ty, ...} => ty
-	  | Type ty => ty
+         fn General {ty, ...} => ty
+          | Type ty => ty
 
       fun dest s = (bound s, ty s)
 
       fun make {canGeneralize, tyvars, ty} =
-	 if 0 = Vector.length tyvars
-	    then Type ty
-	 else General {bound = fn () => tyvars,
-		       canGeneralize = canGeneralize,
-		       flexes = [],
-		       tyvars = tyvars,
-		       ty = ty}
+         if 0 = Vector.length tyvars
+            then Type ty
+         else General {bound = fn () => tyvars,
+                       canGeneralize = canGeneralize,
+                       flexes = [],
+                       tyvars = tyvars,
+                       ty = ty}
 
       val fromType = Type
 
       fun instantiate' (t: t, subst) =
-	 case t of
-	    Type ty => {args = fn () => Vector.new0 (),
-			instance = ty}
-	  | General {canGeneralize, flexes, tyvars, ty, ...} =>
-	       let
-		  open Type
-		  val {destroy = destroyTyvarInst,
-		       get = tyvarInst: Tyvar.t -> Type.t option,
-		       set = setTyvarInst} =
-		     Property.destGetSetOnce (Tyvar.plist,
-					      Property.initConst NONE)
-		  val types =
-		     Vector.mapi
-		     (tyvars, fn (i, a) =>
-		      let
-			 val t = subst {canGeneralize = canGeneralize,
-					equality = Tyvar.isEquality a,
-					index = i}
-			 val _ = setTyvarInst (a, SOME t)
-		      in
-			 t
-		      end)
-		  type z = {isNew: bool, ty: Type.t}
-		  fun isNew {isNew = b, ty = _} = b
-		  fun keep ty = {isNew = false, ty = ty}
-		  fun con (ty, c, zs) =
-		     if Vector.exists (zs, isNew)
-			then {isNew = true,
-			      ty = Type.con (c, Vector.map (zs, #ty))}
-		     else keep ty
-		  val flexInsts = ref []
-		  fun genFlexRecord (_, {extra = _, fields, spine}) =
-		     let
-			val fields = List.revMap (fields, fn (f, t: z) =>
-						  (f, #ty t))
-			val flex = newFlex {fields = fields,
-					    spine = spine}
-			val _ = List.push (flexInsts, {flex = flex,
-						       spine = spine})
-		     in
-			{isNew = true,
-			 ty = flex}
-		     end
-		  fun record (t, r) =
-		     if Srecord.exists (r, isNew)
-			then {isNew = true,
-			      ty = Type.record (Srecord.map (r, #ty))}
-		     else keep t
-		  fun recursive _ =
-		     (* If we get here, there has already been a type error
-		      * in the user's program, so we return a new type to avoid
-		      * compounding the error.
-		      *)
-		     {isNew = true,
-		      ty = Type.new ()}
-		  fun var (ty, a) =
-		     case tyvarInst a of
-			NONE => {isNew = false, ty = ty}
-		      | SOME ty => {isNew = true, ty = ty}
-		  val {ty: Type.t, ...} =
-		     Type.hom (ty, {con = con,
-				    expandOpaque = false,
-				    flexRecord = keep o #1,
-				    genFlexRecord = genFlexRecord,
-				    overload = keep o #1,
-				    record = record,
-				    recursive = recursive,
-				    unknown = keep o #1,
-				    var = var})
-		  val _ = destroyTyvarInst ()
-		  val flexInsts = !flexInsts
-		  fun args (): Type.t vector =
-		     Vector.fromList
-		     (List.fold
-		      (flexes, Vector.toList types,
-		       fn ({fields, spine, ...}, ac) =>
-		       DynamicWind.withEscape (fn escape =>
-		       let
-			  val flex =
-			     case List.peek (flexInsts,
-					     fn {spine = spine', ...} =>
-					     Spine.equals (spine, spine')) of
-				NONE => escape ac (* Error.bug "missing flexInst" *)
-			      | SOME {flex, ...} => flex
-			  fun peekFields (fields, f) =
-			     Option.map
-			     (List.peek (fields, fn (f', _) =>
-					 Field.equals (f, f')),
-			      #2)
-			  val peek =
-			     case Type.toType flex of
-				FlexRecord {fields, ...} =>
-				   (fn f => peekFields (fields, f))
-			      | GenFlexRecord {extra, fields, ...} =>
-				   (fn f =>
-				    case peekFields (fields, f) of
-				       NONE =>
-					  Option.map
-					  (List.peek
-					   (extra (), fn {field, ...} =>
-					    Field.equals (f, field)),
-					   Type.var o #tyvar)
-				     | SOME t => SOME t)
-			      | Record r => (fn f => Srecord.peek (r, f))
-			      | _ => Error.bug "strange flexInst"
-		       in
-			  Spine.foldOverNew
-			  (spine, fields, ac, fn (f, ac) =>
-			   (case peek f of
-			       NONE => Type.unit
-			     | SOME t => t) :: ac)
-		       end)))
-	       in
-		  {args = args,
-		   instance = ty}
-	       end
+         case t of
+            Type ty => {args = fn () => Vector.new0 (),
+                        instance = ty}
+          | General {canGeneralize, flexes, tyvars, ty, ...} =>
+               let
+                  open Type
+                  val {destroy = destroyTyvarInst,
+                       get = tyvarInst: Tyvar.t -> Type.t option,
+                       set = setTyvarInst} =
+                     Property.destGetSetOnce (Tyvar.plist,
+                                              Property.initConst NONE)
+                  val types =
+                     Vector.mapi
+                     (tyvars, fn (i, a) =>
+                      let
+                         val t = subst {canGeneralize = canGeneralize,
+                                        equality = Tyvar.isEquality a,
+                                        index = i}
+                         val _ = setTyvarInst (a, SOME t)
+                      in
+                         t
+                      end)
+                  type z = {isNew: bool, ty: Type.t}
+                  fun isNew {isNew = b, ty = _} = b
+                  fun keep ty = {isNew = false, ty = ty}
+                  fun con (ty, c, zs) =
+                     if Vector.exists (zs, isNew)
+                        then {isNew = true,
+                              ty = Type.con (c, Vector.map (zs, #ty))}
+                     else keep ty
+                  val flexInsts = ref []
+                  fun genFlexRecord (_, {extra = _, fields, spine}) =
+                     let
+                        val fields = List.revMap (fields, fn (f, t: z) =>
+                                                  (f, #ty t))
+                        val flex = newFlex {fields = fields,
+                                            spine = spine}
+                        val _ = List.push (flexInsts, {flex = flex,
+                                                       spine = spine})
+                     in
+                        {isNew = true,
+                         ty = flex}
+                     end
+                  fun record (t, r) =
+                     if Srecord.exists (r, isNew)
+                        then {isNew = true,
+                              ty = Type.record (Srecord.map (r, #ty))}
+                     else keep t
+                  fun recursive _ =
+                     (* If we get here, there has already been a type error
+                      * in the user's program, so we return a new type to avoid
+                      * compounding the error.
+                      *)
+                     {isNew = true,
+                      ty = Type.new ()}
+                  fun var (ty, a) =
+                     case tyvarInst a of
+                        NONE => {isNew = false, ty = ty}
+                      | SOME ty => {isNew = true, ty = ty}
+                  val {ty: Type.t, ...} =
+                     Type.hom (ty, {con = con,
+                                    expandOpaque = false,
+                                    flexRecord = keep o #1,
+                                    genFlexRecord = genFlexRecord,
+                                    overload = keep o #1,
+                                    record = record,
+                                    recursive = recursive,
+                                    unknown = keep o #1,
+                                    var = var})
+                  val _ = destroyTyvarInst ()
+                  val flexInsts = !flexInsts
+                  fun args (): Type.t vector =
+                     Vector.fromList
+                     (List.fold
+                      (flexes, Vector.toList types,
+                       fn ({fields, spine, ...}, ac) =>
+                       let
+                          fun done peek =
+                             Spine.foldOverNew
+                             (spine, fields, ac, fn (f, ac) =>
+                              (case peek f of
+                                  NONE => Type.unit
+                                | SOME t => t) :: ac)
+                       in
+                          case List.peek (flexInsts,
+                                          fn {spine = spine', ...} =>
+                                          Spine.equals (spine, spine')) of
+                             NONE => done (fn _ => NONE)
+                           | SOME {flex, ...} =>
+                                let
+                                   fun peekFields (fields, f) =
+                                      Option.map
+                                      (List.peek (fields, fn (f', _) =>
+                                                  Field.equals (f, f')),
+                                       #2)
+                                in
+                                   done
+                                   (case Type.toType flex of
+                                      FlexRecord {fields, ...} =>
+                                         (fn f => peekFields (fields, f))
+                                    | GenFlexRecord {extra, fields, ...} =>
+                                         (fn f =>
+                                          case peekFields (fields, f) of
+                                             NONE =>
+                                                Option.map
+                                                (List.peek
+                                                 (extra (),
+                                                  fn {field, ...} =>
+                                                  Field.equals (f, field)),
+                                                 Type.var o #tyvar)
+                                           | SOME t => SOME t)
+                                    | Record r =>
+                                         (fn f => Srecord.peek (r, f))
+                                    | _ => Error.bug "TypeEnv.instantiate': General:strange flexInst")
+                                end
+                       end))
+               in
+                  {args = args,
+                   instance = ty}
+               end
 
       fun apply (s, ts) =
-	 #instance (instantiate' (s, fn {index, ...} => Vector.sub (ts, index)))
-	 
+         #instance (instantiate' (s, fn {index, ...} => Vector.sub (ts, index)))
+         
       fun instantiate s =
-	 instantiate'
-	 (s, fn {canGeneralize, equality, ...} =>
-	  Type.unknown {canGeneralize = canGeneralize,
-			equality = if equality
-				      then Equality.truee
-				   else Equality.unknown ()})
+         instantiate'
+         (s, fn {canGeneralize, equality, ...} =>
+          Type.unknown {canGeneralize = canGeneralize,
+                        equality = if equality
+                                      then Equality.truee
+                                   else Equality.unknown ()})
 
       val instantiate =
-	 Trace.trace ("Scheme.instantiate", layout, Type.layout o #instance)
-	 instantiate
+         Trace.trace ("TypeEnv.Scheme.instantiate", layout, Type.layout o #instance)
+         instantiate
 
       fun admitsEquality s =
-	 Type.admitsEquality
-	 (#instance
-	  (instantiate'
-	   (s, fn {canGeneralize, ...} =>
-	    Type.unknown {canGeneralize = canGeneralize,
-			  equality = Equality.truee})))
+         Type.admitsEquality
+         (#instance
+          (instantiate'
+           (s, fn {canGeneralize, ...} =>
+            Type.unknown {canGeneralize = canGeneralize,
+                          equality = Equality.truee})))
 
       fun haveFrees (v: t vector): bool vector =
-	 let
-	    fun con (_, _, bs) = Vector.exists (bs, fn b => b)
-	    fun no _ = false
-	    val {destroy, hom} =
-	       Type.makeHom
-	       {con = con,
-		expandOpaque = false,
-		flexRecord = fn (_, {fields, ...}) => List.exists (fields, #2),
-		genFlexRecord = (fn (_, {fields, ...}) =>
-				 List.exists (fields, #2)),
-		overload = no,
-		record = fn (_, r) => Srecord.exists (r, fn b => b),
-		recursive = no,
-		unknown = fn _ => true,
-		var = no}
-	    val res =
-	       Vector.map (v, fn s =>
-			   case s of
-			      General {ty, ...} => hom ty
-			    | Type ty => hom ty)
-	    val _ = destroy ()
-	 in
-	    res
-	 end
+         let
+            fun con (_, _, bs) = Vector.exists (bs, fn b => b)
+            fun no _ = false
+            val {destroy, hom} =
+               Type.makeHom
+               {con = con,
+                expandOpaque = false,
+                flexRecord = fn (_, {fields, ...}) => List.exists (fields, #2),
+                genFlexRecord = (fn (_, {fields, ...}) =>
+                                 List.exists (fields, #2)),
+                overload = no,
+                record = fn (_, r) => Srecord.exists (r, fn b => b),
+                recursive = no,
+                unknown = fn _ => true,
+                var = no}
+            val res =
+               Vector.map (v, fn s =>
+                           case s of
+                              General {ty, ...} => hom ty
+                            | Type ty => hom ty)
+            val _ = destroy ()
+         in
+            res
+         end
    end
 
 fun generalize (tyvars: Tyvar.t vector) =
@@ -1581,8 +1595,8 @@
       val () = Vector.foreach (tyvars, fn a => tyvarTime a := genTime)
    in
       fn () => {unable = (Vector.keepAll
-			  (tyvars, fn a =>
-			   not (Time.<= (genTime, !(tyvarTime a)))))}
+                          (tyvars, fn a =>
+                           not (Time.<= (genTime, !(tyvarTime a)))))}
    end
 
 fun close (ensure: Tyvar.t vector, ubd) =
@@ -1595,140 +1609,140 @@
       val () = Type.newCloses := []
    in
       Trace.trace
-      ("close",
+      ("TypeEnv.close",
        let
-	  open Layout
+          open Layout
        in
-	  Vector.layout
-	  (fn {isExpansive, ty} =>
-	   Layout.record [("isExpansive", Bool.layout isExpansive),
-			  ("ty", Type.layout ty)])
+          Vector.layout
+          (fn {isExpansive, ty} =>
+           Layout.record [("isExpansive", Bool.layout isExpansive),
+                          ("ty", Type.layout ty)])
        end,
        Layout.ignore)
       (fn varTypes =>
       let
-	 val () =
-	    Vector.foreach
-	    (varTypes, fn {isExpansive, ty} =>
-	     if isExpansive
-		then Type.minTime (ty, beforeGen)
-	     else ())
-	 val unable = Vector.keepAll (ensure, fn a =>
-				      not (Time.<= (genTime, !(tyvarTime a))))
-	 val flexes = ref []
-	 val tyvars = ref (Vector.toList ensure)
-	 (* Convert all the unknown types bound at this level into tyvars.
-	  * Convert all the FlexRecords bound at this level into
-	  * GenFlexRecords.
-	  *)
-	 val newCloses =
-	    List.fold
-	    (!Type.newCloses, savedCloses, fn (t as Type.T s, ac) =>
-	     let
-		val {equality, plist, time, ty, ...} = Set.! s
-		val _ =
-		   if true then () else
-		      let
-			 open Layout
-		      in
-			 outputl (seq [str "considering ",
-				       Type.layout t,
-				       str " with time ",
-				       Time.layout (!time),
-				       str " where getTime is ",
-				       Time.layout genTime],
-				  Out.standard)
-		      end
-	     in
-		if not (Time.<= (genTime, !time))
-		   then t :: ac
-		else
-		   case ty of
-		      Type.FlexRecord {fields, spine, ...} =>
-			 let
-			    val extra =
-			       Promise.lazy
-			       (fn () =>
-				Spine.foldOverNew
-				(spine, fields, [], fn (f, ac) =>
-				 {field = f,
-				  tyvar = Tyvar.newNoname {equality = false}}
-				 :: ac))
-			    val gfr = {extra = extra,
-				       fields = fields,
-				       spine = spine}
-			    val _ = List.push (flexes, gfr)
-			    val _ = 
-			       Set.:=
-			       (s, {equality = equality,
-				    plist = plist,
-				    time = time,
-				    ty = Type.GenFlexRecord gfr})
-			 in
-			    ac
-			 end
-		    | Type.Unknown (Unknown.T {canGeneralize, ...}) =>
-			 if not canGeneralize
-			    then t :: ac
-			 else
-			    let
-			       val b =
-				  case Equality.toBoolOpt equality of
-				     NONE =>
-					let
-					   val _ =
-					      Equality.unify
-					      (equality, Equality.falsee)
-					in
-					   false
-					end
-				   | SOME b => b
-			       val a = Tyvar.newNoname {equality = b}
-			       val _ = List.push (tyvars, a)
-			       val _ =
-				  Set.:= (s, {equality = equality,
-					      plist = PropertyList.new (),
-					      time = time,
-					      ty = Type.Var a})
-			    in
-			       ac
-			    end
-		    | _ => ac
-	     end)
-	 val _ = Type.newCloses := newCloses
-	 val flexes = !flexes
-	 val tyvars = !tyvars
-	 (* For all fields that were added to the generalized flex records,
-	  * add a type variable.
-	  *)
-	 fun bound () =
-	    Vector.fromList
-	    (List.fold
-	     (flexes, tyvars, fn ({extra, fields, spine}, ac) =>
-	      let
-		 val extra = extra ()
-	      in
-		 Spine.foldOverNew
-		 (spine, fields, ac, fn (f, ac) =>
-		  case List.peek (extra, fn {field, ...} =>
-				  Field.equals (f, field)) of
-		     NONE => Error.bug "GenFlex missing field"
-		   | SOME {tyvar, ...} => tyvar :: ac)
-	      end))
-	 val schemes =
-	    Vector.map
-	    (varTypes, fn {isExpansive, ty} =>
-	     if isExpansive
-		then Scheme.Type ty
-	     else Scheme.General {bound = bound,
-				  canGeneralize = true,
-				  flexes = flexes,
-				  tyvars = Vector.fromList tyvars,
-				  ty = ty})
+         val () =
+            Vector.foreach
+            (varTypes, fn {isExpansive, ty} =>
+             if isExpansive
+                then Type.minTime (ty, beforeGen)
+             else ())
+         val unable = Vector.keepAll (ensure, fn a =>
+                                      not (Time.<= (genTime, !(tyvarTime a))))
+         val flexes = ref []
+         val tyvars = ref (Vector.toList ensure)
+         (* Convert all the unknown types bound at this level into tyvars.
+          * Convert all the FlexRecords bound at this level into
+          * GenFlexRecords.
+          *)
+         val newCloses =
+            List.fold
+            (!Type.newCloses, savedCloses, fn (t as Type.T s, ac) =>
+             let
+                val {equality, plist, time, ty, ...} = Set.! s
+                val _ =
+                   if true then () else
+                      let
+                         open Layout
+                      in
+                         outputl (seq [str "considering ",
+                                       Type.layout t,
+                                       str " with time ",
+                                       Time.layout (!time),
+                                       str " where getTime is ",
+                                       Time.layout genTime],
+                                  Out.standard)
+                      end
+             in
+                if not (Time.<= (genTime, !time))
+                   then t :: ac
+                else
+                   case ty of
+                      Type.FlexRecord {fields, spine, ...} =>
+                         let
+                            val extra =
+                               Promise.lazy
+                               (fn () =>
+                                Spine.foldOverNew
+                                (spine, fields, [], fn (f, ac) =>
+                                 {field = f,
+                                  tyvar = Tyvar.newNoname {equality = false}}
+                                 :: ac))
+                            val gfr = {extra = extra,
+                                       fields = fields,
+                                       spine = spine}
+                            val _ = List.push (flexes, gfr)
+                            val _ = 
+                               Set.:=
+                               (s, {equality = equality,
+                                    plist = plist,
+                                    time = time,
+                                    ty = Type.GenFlexRecord gfr})
+                         in
+                            ac
+                         end
+                    | Type.Unknown (Unknown.T {canGeneralize, ...}) =>
+                         if not canGeneralize
+                            then t :: ac
+                         else
+                            let
+                               val b =
+                                  case Equality.toBoolOpt equality of
+                                     NONE =>
+                                        let
+                                           val _ =
+                                              Equality.unify
+                                              (equality, Equality.falsee)
+                                        in
+                                           false
+                                        end
+                                   | SOME b => b
+                               val a = Tyvar.newNoname {equality = b}
+                               val _ = List.push (tyvars, a)
+                               val _ =
+                                  Set.:= (s, {equality = equality,
+                                              plist = PropertyList.new (),
+                                              time = time,
+                                              ty = Type.Var a})
+                            in
+                               ac
+                            end
+                    | _ => ac
+             end)
+         val _ = Type.newCloses := newCloses
+         val flexes = !flexes
+         val tyvars = !tyvars
+         (* For all fields that were added to the generalized flex records,
+          * add a type variable.
+          *)
+         fun bound () =
+            Vector.fromList
+            (List.fold
+             (flexes, tyvars, fn ({extra, fields, spine}, ac) =>
+              let
+                 val extra = extra ()
+              in
+                 Spine.foldOverNew
+                 (spine, fields, ac, fn (f, ac) =>
+                  case List.peek (extra, fn {field, ...} =>
+                                  Field.equals (f, field)) of
+                     NONE => Error.bug "TypeEnv.close.bound: GenFlex missing field"
+                   | SOME {tyvar, ...} => tyvar :: ac)
+              end))
+         val schemes =
+            Vector.map
+            (varTypes, fn {isExpansive, ty} =>
+             if isExpansive
+                then Scheme.Type ty
+             else Scheme.General {bound = bound,
+                                  canGeneralize = true,
+                                  flexes = flexes,
+                                  tyvars = Vector.fromList tyvars,
+                                  ty = ty})
       in
-	 {bound = bound,
-	  schemes = schemes,
-	  unable = unable}
+         {bound = bound,
+          schemes = schemes,
+          unable = unable}
       end
    )
    end
@@ -1738,88 +1752,88 @@
       open Type
 
       fun homConVar {con, expandOpaque, var} =
-	 let
-	    fun tuple (t, ts) =
-	       if 1 = Vector.length ts
-		  then Vector.sub (ts, 0)
-	       else con (t, Tycon.tuple, ts)
-	 in
-	    simpleHom {con = con,
-		       expandOpaque = expandOpaque,
-		       record = fn (t, fs) => tuple (t, Vector.map (fs, #2)),
-		       replaceSynonyms = true,
-		       var = var}
-	 end
+         let
+            fun tuple (t, ts) =
+               if 1 = Vector.length ts
+                  then Vector.sub (ts, 0)
+               else con (t, Tycon.tuple, ts)
+         in
+            simpleHom {con = con,
+                       expandOpaque = expandOpaque,
+                       record = fn (t, fs) => tuple (t, Vector.map (fs, #2)),
+                       replaceSynonyms = true,
+                       var = var}
+         end
 
       fun makeHom {con, expandOpaque, var} =
-	 homConVar {con = fn (_, c, ts) => con (c, ts),
-		    expandOpaque = expandOpaque,
-		    var = fn (_, a) => var a}
-	 
+         homConVar {con = fn (_, c, ts) => con (c, ts),
+                    expandOpaque = expandOpaque,
+                    var = fn (_, a) => var a}
+         
       fun deRecord t =
-	 let
-	    val {hom, destroy} =
-	       simpleHom
-	       {con = fn (t, _, _) => (t, NONE),
-		expandOpaque = false,
-		record = fn (t, fs) => (t,
-					SOME (Vector.map (fs, fn (f, (t, _)) =>
-							  (f, t)))),
-		replaceSynonyms = true,
-		var = fn (t, _) => (t, NONE)}
-	    val res =
-	       case #2 (hom t) of
-		  NONE => Error.bug "Type.deRecord"
-		| SOME fs => fs
-	    val _ = destroy ()
-	 in
-	    res
-	 end
+         let
+            val {hom, destroy} =
+               simpleHom
+               {con = fn (t, _, _) => (t, NONE),
+                expandOpaque = false,
+                record = fn (t, fs) => (t,
+                                        SOME (Vector.map (fs, fn (f, (t, _)) =>
+                                                          (f, t)))),
+                replaceSynonyms = true,
+                var = fn (t, _) => (t, NONE)}
+            val res =
+               case #2 (hom t) of
+                  NONE => Error.bug "TypeEnv.Type.deRecord"
+                | SOME fs => fs
+            val _ = destroy ()
+         in
+            res
+         end
 
       fun deTupleOpt t =
-	 let
-	    val {destroy, hom} =
-	       homConVar
-	       {con = fn (t, c, ts) => (t,
-					if Tycon.equals (c, Tycon.tuple)
-					   then SOME (Vector.map (ts, #1))
-					else NONE),
-		expandOpaque = false,
+         let
+            val {destroy, hom} =
+               homConVar
+               {con = fn (t, c, ts) => (t,
+                                        if Tycon.equals (c, Tycon.tuple)
+                                           then SOME (Vector.map (ts, #1))
+                                        else NONE),
+                expandOpaque = false,
                 var = fn (t, _) => (t, NONE)}
-	    val res = #2 (hom t)
-	    val _ = destroy ()
-	 in
-	    res
-	 end
+            val res = #2 (hom t)
+            val _ = destroy ()
+         in
+            res
+         end
 
       val deTupleOpt =
-	 Trace.trace ("Type.deTupleOpt", layout,
-		      Option.layout (Vector.layout layout))
-	 deTupleOpt
+         Trace.trace ("TypeEnv.Type.deTupleOpt", layout,
+                      Option.layout (Vector.layout layout))
+         deTupleOpt
 
       val deTuple = valOf o deTupleOpt
 
       fun hom (t, {con, expandOpaque = e, record, replaceSynonyms = r,
-		   var}) =
-	 let
-	    val {hom, destroy} =
-	       simpleHom {con = fn (_, c, v) => con (c, v),
-			  expandOpaque = e,
-			  record = fn (_, fs) => record (Srecord.fromVector fs),
-			  replaceSynonyms = r,
-			  var = fn (_, a) => var a}
-	    val res = hom t
-	    val _ = destroy ()
-	 in
-	    res
-	 end
+                   var}) =
+         let
+            val {hom, destroy} =
+               simpleHom {con = fn (_, c, v) => con (c, v),
+                          expandOpaque = e,
+                          record = fn (_, fs) => record (Srecord.fromVector fs),
+                          replaceSynonyms = r,
+                          var = fn (_, a) => var a}
+            val res = hom t
+            val _ = destroy ()
+         in
+            res
+         end
 
       val unify =
-	 fn (t1: t, t2: t, {error: Layout.t * Layout.t -> unit,
-			    preError: unit -> unit}) =>
-	 case unify (t1, t2, {preError = preError}) of
-	    NotUnifiable z => error z
-	  | Unified => ()
+         fn (t1: t, t2: t, {error: Layout.t * Layout.t -> unit,
+                            preError: unit -> unit}) =>
+         case unify (t1, t2, {preError = preError}) of
+            NotUnifiable z => error z
+          | Unified => ()
    end
 
 end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/elaborate/type-env.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/elaborate/type-env.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/elaborate/type-env.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature TYPE_ENV_STRUCTS = 
    sig
       include ATOMS
@@ -15,91 +16,93 @@
       include TYPE_ENV_STRUCTS
 
       structure Time:
-	 sig
-	    type t
+         sig
+            type t
 
-	    val now: unit -> t
-	 end
+            val now: unit -> t
+         end
 
       structure Type:
-	 sig
-	    include TYPE_OPS
+         sig
+            include TYPE_OPS
 
-	    val admitsEquality: t -> bool
+            val admitsEquality: t -> bool
             (* can two types be unified?  not side-effecting. *)
             val canUnify: t * t -> bool
-	    val char: CharSize.t -> t
-	    val deEta: t * Tyvar.t vector -> Tycon.t option
-	    val deRecord: t -> (Record.Field.t * t) vector
-	    val flexRecord: t SortedRecord.t -> t * (unit -> bool)
-	    val hom: t * {con: Tycon.t * 'a vector -> 'a,
-			  expandOpaque: bool,
-			  record: 'a SortedRecord.t -> 'a,
-			  replaceSynonyms: bool,
-			  var: Tyvar.t -> 'a} -> 'a
-	    val isCharX: t -> bool
-	    val isInt: t -> bool
-	    val isUnit: t -> bool
-	    val layout: t -> Layout.t
-	    val layoutPretty: t -> Layout.t
-	    val makeHom: {con: Tycon.t * 'a vector -> 'a,
-			  expandOpaque: bool,
-			  var: Tyvar.t -> 'a} -> {destroy: unit -> unit,
-						  hom: t -> 'a}
-	    val makeLayoutPretty:
-	       unit -> {destroy: unit -> unit,
-			lay: t -> Layout.t * {isChar: bool,
-					      needsParen: bool}}
-	    (* minTime (t, time) makes every component of t occur no later than
-	     * time.  This will display a type error message if time is before
-	     * the definition time of some component of t.
-	     *)
-	    val minTime: t * Time.t -> unit
-	    val new: unit -> t
-	    val record: t SortedRecord.t -> t
-	    val string: t
-	    val toString: t -> string
-	    (* make two types identical (recursively).  side-effecting. *)
-	    val unify:
-	       t * t * {error: Layout.t * Layout.t -> unit,
-			preError: unit -> unit} -> unit
-	    val unresolvedChar: unit -> t
-	    val unresolvedInt: unit -> t
-	    val unresolvedReal: unit -> t
-	    val unresolvedString: unit -> t
-	    val unresolvedWord: unit -> t
-	    val var: Tyvar.t -> t
-	 end
+            val char: CharSize.t -> t
+            val deEta: t * Tyvar.t vector -> Tycon.t option
+            val deRecord: t -> (Record.Field.t * t) vector
+            val flexRecord: t SortedRecord.t -> t * (unit -> bool)
+            val hom: t * {con: Tycon.t * 'a vector -> 'a,
+                          expandOpaque: bool,
+                          record: 'a SortedRecord.t -> 'a,
+                          replaceSynonyms: bool,
+                          var: Tyvar.t -> 'a} -> 'a
+            val isBool: t -> bool
+            val isCharX: t -> bool
+            val isExn: t -> bool
+            val isInt: t -> bool
+            val isUnit: t -> bool
+            val layout: t -> Layout.t
+            val layoutPretty: t -> Layout.t
+            val makeHom: {con: Tycon.t * 'a vector -> 'a,
+                          expandOpaque: bool,
+                          var: Tyvar.t -> 'a} -> {destroy: unit -> unit,
+                                                  hom: t -> 'a}
+            val makeLayoutPretty:
+               unit -> {destroy: unit -> unit,
+                        lay: t -> Layout.t * {isChar: bool,
+                                              needsParen: bool}}
+            (* minTime (t, time) makes every component of t occur no later than
+             * time.  This will display a type error message if time is before
+             * the definition time of some component of t.
+             *)
+            val minTime: t * Time.t -> unit
+            val new: unit -> t
+            val record: t SortedRecord.t -> t
+            val string: t
+            val toString: t -> string
+            (* make two types identical (recursively).  side-effecting. *)
+            val unify:
+               t * t * {error: Layout.t * Layout.t -> unit,
+                        preError: unit -> unit} -> unit
+            val unresolvedChar: unit -> t
+            val unresolvedInt: unit -> t
+            val unresolvedReal: unit -> t
+            val unresolvedString: unit -> t
+            val unresolvedWord: unit -> t
+            val var: Tyvar.t -> t
+         end
 (*      sharing type Type.intSize = IntSize.t *)
       sharing type Type.realSize = RealSize.t
       sharing type Type.wordSize = WordSize.t
       sharing type Type.tycon = Tycon.t
       structure Scheme:
-	 sig
-	    type t
+         sig
+            type t
 
-	    val admitsEquality: t -> bool
-	    val apply: t * Type.t vector -> Type.t
-	    val bound: t -> Tyvar.t vector
-	    val dest: t -> Tyvar.t vector * Type.t
-	    val fromType: Type.t -> t
-	    val haveFrees: t vector -> bool vector
-	    val instantiate: t -> {args: unit -> Type.t vector,
-				   instance: Type.t}
-	    val layout: t -> Layout.t
-	    val layoutPretty: t -> Layout.t
-	    val make: {canGeneralize: bool,
-		       ty: Type.t,
-		       tyvars: Tyvar.t vector} -> t
-	    val ty: t -> Type.t
-	 end
+            val admitsEquality: t -> bool
+            val apply: t * Type.t vector -> Type.t
+            val bound: t -> Tyvar.t vector
+            val dest: t -> Tyvar.t vector * Type.t
+            val fromType: Type.t -> t
+            val haveFrees: t vector -> bool vector
+            val instantiate: t -> {args: unit -> Type.t vector,
+                                   instance: Type.t}
+            val layout: t -> Layout.t
+            val layoutPretty: t -> Layout.t
+            val make: {canGeneralize: bool,
+                       ty: Type.t,
+                       tyvars: Tyvar.t vector} -> t
+            val ty: t -> Type.t
+         end
 
       val close:
-	 Tyvar.t vector * {useBeforeDef: Tycon.t -> unit}
-	 -> {isExpansive: bool, ty: Type.t} vector
-	 -> {bound: unit -> Tyvar.t vector,
-	     schemes: Scheme.t vector,
-	     unable: Tyvar.t vector}
+         Tyvar.t vector * {useBeforeDef: Tycon.t -> unit}
+         -> {isExpansive: bool, ty: Type.t} vector
+         -> {bound: unit -> Tyvar.t vector,
+             schemes: Scheme.t vector,
+             unable: Tyvar.t vector}
       val generalize: Tyvar.t vector -> unit -> {unable: Tyvar.t vector}
       val initAdmitsEquality: Tycon.t * Tycon.AdmitsEquality.t -> unit
       val setOpaqueTyconExpansion: Tycon.t * (Type.t vector -> Type.t) -> unit
@@ -107,5 +110,3 @@
       val tyconAdmitsEquality: Tycon.t -> Tycon.AdmitsEquality.t ref
       val tyconRegion: Tycon.t -> Region.t option ref
    end
-
-signature INFER_TYPE_ENV = TYPE_ENV


Property changes on: mlton/branches/on-20050420-cmm-branch/mlton/front-end
___________________________________________________________________
Name: svn:ignore
   - ml.grm.desc
ml.grm.sig
ml.grm.sml
ml.lex.sml
mlb.grm.desc
mlb.grm.sig
mlb.grm.sml
mlb.lex.sml
   + ml.grm.desc
ml.grm.sig
ml.grm.sml
ml.lex.sml
mlb.grm.desc
mlb.grm.sig
mlb.grm.sml
mlb.lex.sml


Deleted: mlton/branches/on-20050420-cmm-branch/mlton/front-end/.cvsignore
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/front-end/.cvsignore	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/front-end/.cvsignore	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,8 +0,0 @@
-ml.grm.desc
-ml.grm.sig
-ml.grm.sml
-ml.lex.sml
-mlb.grm.desc
-mlb.grm.sig
-mlb.grm.sml
-mlb.lex.sml

Copied: mlton/branches/on-20050420-cmm-branch/mlton/front-end/.ignore (from rev 4358, mlton/trunk/mlton/front-end/.ignore)

Modified: mlton/branches/on-20050420-cmm-branch/mlton/front-end/Makefile
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/front-end/Makefile	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/front-end/Makefile	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,16 @@
+## Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ #    Jagannathan, and Stephen Weeks.
+ # Copyright (C) 1997-2000 NEC Research Institute.
+ #
+ # MLton is released under a BSD-style license.
+ # See the file MLton-LICENSE for details.
+ ##
+
+SRC = $(shell cd ../.. && pwd)
+BUILD = $(SRC)/build
+BIN = $(BUILD)/bin
+PATH = $(BIN):$(shell echo $$PATH)
+
 .PHONY: all
 all: ml.lex.sml ml.grm.sig ml.grm.sml mlb.lex.sml mlb.grm.sig mlb.grm.sml
 

Modified: mlton/branches/on-20050420-cmm-branch/mlton/front-end/front-end.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/front-end/front-end.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/front-end/front-end.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,43 +1,44 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 functor FrontEnd (S: FRONT_END_STRUCTS): FRONT_END = 
 struct
 
 open S
 
 structure LrVals = MLLrValsFun (structure Token = LrParser.Token
-				structure Ast = Ast)
+                                structure Ast = Ast)
 structure Lex = MLLexFun (structure Tokens = LrVals.Tokens)
 structure Parse = JoinWithArg (structure ParserData = LrVals.ParserData
-			       structure Lex = Lex
-			       structure LrParser = LrParser)
+                               structure Lex = Lex
+                               structure LrParser = LrParser)
    
 fun lexAndParse (source: Source.t, ins: In.t): Ast.Program.t =
    let
       val stream =
-	 Parse.makeLexer (fn n => In.inputN (ins, n))
-	 {source = source}
+         Parse.makeLexer (fn n => In.inputN (ins, n))
+         {source = source}
       val lookahead = 30
       val result =
-	 (#1 (Parse.parse (lookahead, stream, fn (s, left, right) =>
-			   Control.errorStr (Region.make {left = left,
-							  right = right},
-					     s),
-			   ())))
-	 handle _ =>
-	    let
-	       val i = Source.lineStart source
-	       val _ = 
-		  Control.errorStr (Region.make {left = i, right = i},
-				    "parse error")
-	    in
-	       Ast.Program.T []
-	    end
+         (#1 (Parse.parse (lookahead, stream, fn (s, left, right) =>
+                           Control.errorStr (Region.make {left = left,
+                                                          right = right},
+                                             s),
+                           ())))
+         handle _ =>
+            let
+               val i = Source.lineStart source
+               val _ = 
+                  Control.errorStr (Region.make {left = i, right = i},
+                                    "parse error")
+            in
+               Ast.Program.T []
+            end
       val () = Ast.Program.checkSyntax result
    in
       result

Modified: mlton/branches/on-20050420-cmm-branch/mlton/front-end/front-end.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/front-end/front-end.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/front-end/front-end.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature FRONT_END_STRUCTS = 
    sig
       structure Ast: AST
@@ -13,6 +14,6 @@
 signature FRONT_END = 
    sig
       include FRONT_END_STRUCTS
-	 
+         
       val lexAndParseFile: File.t -> Ast.Program.t
    end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/front-end/import.cm
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/front-end/import.cm	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/front-end/import.cm	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 Group
 
 structure Array
@@ -21,6 +22,7 @@
 structure IntInf
 structure Layout
 structure List
+structure MLton
 structure Option
 structure OS
 structure Out

Modified: mlton/branches/on-20050420-cmm-branch/mlton/front-end/ml.grm
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/front-end/ml.grm	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/front-end/ml.grm	2006-02-16 19:34:54 UTC (rev 4361)
@@ -30,8 +30,8 @@
       open DatBind
 
       fun make (dbs, withtypes, left, right) =
-	 makeRegion' (T {datatypes = dbs, withtypes = withtypes},
-		      left, right)
+         makeRegion' (T {datatypes = dbs, withtypes = withtypes},
+                      left, right)
    end
 
 structure Pat =
@@ -39,53 +39,53 @@
       open Pat
 
       fun tuple ps =
-	 if 1 = Vector.length ps
-	    then node (Vector.sub (ps, 0))
-	 else Tuple ps
+         if 1 = Vector.length ps
+            then node (Vector.sub (ps, 0))
+         else Tuple ps
 
       val unit = tuple (Vector.new0 ())
 
       val bogus = unit
 
       fun makeAs (p1: t, p2: t): node =
-	 let
-	    fun err () =
-	       error (Pat.region p1, "must have variable to left in as pattern")
-	    fun fixopVar (p : t) =
-	       case node p of
-		  FlatApp ps =>
-		     if 1 = Vector.length ps
-			then (case node (Vector.sub (ps, 0)) of
-				 Var {fixop,name} =>
-				    (case Longvid.split name of
-					([], vid) =>
-					   SOME (fixop, Vid.toVar vid)
-				      | _ =>
-					   let
-					      val () = err ()
-					   in
-					      SOME (Fixop.None, Var.bogus)
-					   end)
-			       | _ => NONE)
-		     else NONE
+         let
+            fun err () =
+               error (Pat.region p1, "must have variable to left in as pattern")
+            fun fixopVar (p : t) =
+               case node p of
+                  FlatApp ps =>
+                     if 1 = Vector.length ps
+                        then (case node (Vector.sub (ps, 0)) of
+                                 Var {fixop,name} =>
+                                    (case Longvid.split name of
+                                        ([], vid) =>
+                                           SOME (fixop, Vid.toVar vid)
+                                      | _ =>
+                                           let
+                                              val () = err ()
+                                           in
+                                              SOME (Fixop.None, Var.bogus)
+                                           end)
+                               | _ => NONE)
+                     else NONE
                 | _ => NONE
-	 in
-	    case fixopVar p1 of
-	       SOME (fixop, var) =>
-		  Layered {fixop = fixop, var = var,
-			   constraint = NONE,
-			   pat = p2}
-	     | NONE =>
-		  case node p1 of
-		     Pat.Constraint (p, t) =>
-			(case fixopVar p of
-			    SOME (fixop, var) =>
-			       Layered {fixop = fixop, var = var,
-					constraint = SOME t,
-					pat = p2}
-			  | _ => (err (); bogus))
-		   | _ => (err (); bogus)
-	 end
+         in
+            case fixopVar p1 of
+               SOME (fixop, var) =>
+                  Layered {fixop = fixop, var = var,
+                           constraint = NONE,
+                           pat = p2}
+             | NONE =>
+                  case node p1 of
+                     Pat.Constraint (p, t) =>
+                        (case fixopVar p of
+                            SOME (fixop, var) =>
+                               Layered {fixop = fixop, var = var,
+                                        constraint = SOME t,
+                                        pat = p2}
+                          | _ => (err (); bogus))
+                   | _ => (err (); bogus)
+         end
    end
 
 structure Exp =
@@ -93,26 +93,26 @@
       open Exp
 
       fun tuple es =
-	 if 1 = Vector.length es
-	    then node (Vector.sub (es, 0))
-	 else Record (Record.tuple es)
-	    
+         if 1 = Vector.length es
+            then node (Vector.sub (es, 0))
+         else Record (Record.tuple es)
+            
       val unit = tuple (Vector.new0 ())
    end
 
 structure Dec =
    struct
       open Dec
-	 
+         
       fun sequence (d1: t, d2: t): t =
-	 makeRegion (case (node d1, node d2) of
-			(SeqDec d1, SeqDec d2) => SeqDec (Vector.concat [d1, d2])
-		      | (SeqDec d1, _) =>
-			   SeqDec (Vector.concat [d1, Vector.new1 d2])
-		      | (_, SeqDec d2) =>
-			   SeqDec (Vector.concat [Vector.new1 d1, d2])
-		      | _ => SeqDec (Vector.new2 (d1, d2)),
-	             Region.append (region d1, region d2))
+         makeRegion (case (node d1, node d2) of
+                        (SeqDec d1, SeqDec d2) => SeqDec (Vector.concat [d1, d2])
+                      | (SeqDec d1, _) =>
+                           SeqDec (Vector.concat [d1, Vector.new1 d2])
+                      | (_, SeqDec d2) =>
+                           SeqDec (Vector.concat [Vector.new1 d1, d2])
+                      | _ => SeqDec (Vector.new2 (d1, d2)),
+                     Region.append (region d1, region d2))
    end
 
 structure Spec =
@@ -123,17 +123,17 @@
        * many specs as possible in its scope.
        *)
       fun seq (s: t, s': t): t =
-	 let
-	    fun reg s'' = makeRegion (s'', Region.append (region s, region s'))
-	 in
-	    case (node s, node s') of
-	       (Empty, _) => s'
-	     | (_, Empty) => s
-	     | (_, Seq (s1, s2)) => reg (Seq (seq (s, s1), s2))
-	     | (_, Sharing {spec, equations}) =>
-		  reg (Sharing {spec = seq (s, spec), equations = equations})
-	     | _ => reg (Seq (s, s'))
-	 end
+         let
+            fun reg s'' = makeRegion (s'', Region.append (region s, region s'))
+         in
+            case (node s, node s') of
+               (Empty, _) => s'
+             | (_, Empty) => s
+             | (_, Seq (s1, s2)) => reg (Seq (seq (s, s1), s2))
+             | (_, Sharing {spec, equations}) =>
+                  reg (Sharing {spec = seq (s, spec), equations = equations})
+             | _ => reg (Seq (s, s'))
+         end
 
 (*      val seq = Trace.trace2 ("Spec.seq", layout, layout, layout) seq *)
    end
@@ -145,68 +145,68 @@
 
 type rule = Pat.t * Exp.t
 type clause = {pats : Pat.t vector,
-	       resultType : Type.t option,
-	       body : Exp.t}
+               resultType : Type.t option,
+               body : Exp.t}
 type clauses = clause vector
 type eb = Con.t * EbRhs.t
 type db = {tyvars: Tyvar.t vector,
-	   tycon: Tycon.t,
-	   cons: (Con.t * Type.t option) vector}
+           tycon: Tycon.t,
+           cons: (Con.t * Type.t option) vector}
 
 type strdesc = Strid.t * Sigexp.t
 
 type wherespec = {tyvars: Tyvar.t vector,
-		  longtycon: Longtycon.t,
-		  ty: Type.t}
+                  longtycon: Longtycon.t,
+                  ty: Type.t}
 
 type typdesc =  {tyvars: Tyvar.t vector,
-		 tycon: Tycon.t}
+                 tycon: Tycon.t}
 
 type valdesc = Var.t * Type.t
 
 type exndesc = Con.t * Type.t option
 
 type strbind = {name: Strid.t,
-		def: Strexp.t,
-		constraint: SigConst.t}
+                def: Strexp.t,
+                constraint: SigConst.t}
    
 type sigbind = Sigid.t * Sigexp.t
 
 type funbind = {name : Fctid.t,
-		arg : FctArg.t,
-		result : SigConst.t,
-		body : Strexp.t}
+                arg : FctArg.t,
+                result : SigConst.t,
+                body : Strexp.t}
 
 type vb = {pat: Pat.t,
-	   exp: Exp.t}
+           exp: Exp.t}
    
 type rvb = {pat: Pat.t,
-	    match: Match.t}
+            match: Match.t}
    
 fun ensureNonqualified (ss: Symbol.t list, r: Region.t): Symbol.t * Region.t =
    case ss of
       [s] => (s, r)
     | _ => (error (r, "expected nonqualified id")
-	    ; (Symbol.bogus, r))
+            ; (Symbol.bogus, r))
 
 fun cons1 (x, (l, r, y)) = (x :: l, r, y)
 
 fun augment (id, sigexp, (wherespecs, right, binds)) =
    (id, Sigexp.wheree (sigexp, Vector.fromList wherespecs,
-		       Region.extendRight (Sigexp.region sigexp, right)))
+                       Region.extendRight (Sigexp.region sigexp, right)))
    :: binds
 
 fun 'a augment1 ((strexp: Strexp.t,
-		  makesigconst: Sigexp.t -> SigConst.t,
-		  sigexp: Sigexp.t),
-		 (wherespecs: wherespec list,
-		  right: SourcePos.t,
-		  z: 'a)): Strexp.t * 'a =
+                  makesigconst: Sigexp.t -> SigConst.t,
+                  sigexp: Sigexp.t),
+                 (wherespecs: wherespec list,
+                  right: SourcePos.t,
+                  z: 'a)): Strexp.t * 'a =
    (Strexp.makeRegion
     (Strexp.Constrained
      (strexp, makesigconst (Sigexp.wheree
-			    (sigexp, Vector.fromList wherespecs,
-			     Region.extendRight (Sigexp.region sigexp, right)))),
+                            (sigexp, Vector.fromList wherespecs,
+                             Region.extendRight (Sigexp.region sigexp, right)))),
      Region.extendRight (Strexp.region strexp, right)),
     z)
 
@@ -216,14 +216,14 @@
   %term
       CHAR of IntInf.t
     | INT of {digits: string,
-	      negate: bool,
-	      radix: StringCvt.radix}
+              negate: bool,
+              radix: StringCvt.radix}
     | LONGID of string
     | REAL of string
     | STRING of IntInf.t vector
     | TYVAR of string
     | WORD of {digits: string,
-	       radix: StringCvt.radix}
+               radix: StringCvt.radix}
     | ABSTYPE | AND | ANDALSO | ARROW | AS | ASTERISK | BAR | CASE | COLON
     | COLONGT | COMMA | DATATYPE | DOTDOTDOT | ELSE | END | EOF | EQUALOP
     | EQTYPE | EXCEPTION | DO | DARROW | FN | FUN | FUNCTOR | HANDLE | HASH
@@ -232,8 +232,9 @@
     | RBRACKET | REC | RPAREN | SEMICOLON | SHARING | SIG | SIGNATURE | STRUCT
     | STRUCTURE | THEN | TYPE | VAL | WHERE | WHILE | WILD | WITH | WITHTYPE
       (* Extensions *)
-    | BUILD_CONST | COMMAND_LINE_CONST | CONST | EXPORT | FFI
-    | IMPORT | PRIM
+    | BUILD_CONST | COMMAND_LINE_CONST | CONST 
+    | ADDRESS | EXPORT | IMPORT | SYMBOL 
+    | PRIM
 
 %nonterm
          aexp of Exp.node
@@ -245,7 +246,7 @@
        | app_exp of Exp.t list
        | app_exp1 of Exp.t list
        | arg_fct of Strexp.t
-       | attributes of PrimKind.Attribute.t list
+       | ieattributes of PrimKind.ImportExportAttribute.t list
        | clause of clause
        | clauses of clause list
        | clausesTop of clauses
@@ -366,6 +367,7 @@
        | strexpnode of Strexp.node
        | strid of Strid.t
        | string of string
+       | symattributes of PrimKind.SymbolAttribute.t list
        | tlabel of (Field.t * Type.t)
        | tlabels  of (Field.t * Type.t) list
        | topdec of Topdec.t
@@ -382,11 +384,11 @@
        | tynode of Type.node
        | typBind of TypBind.t
        | typBind' of {def: Type.t,
-		      tycon: Tycon.t,
-		      tyvars: Tyvar.t vector} list
+                      tycon: Tycon.t,
+                      tyvars: Tyvar.t vector} list
        | typBind'' of {def: Type.t,
-		       tycon: Tycon.t,
-		       tyvars: Tyvar.t vector} list
+                       tycon: Tycon.t,
+                       tyvars: Tyvar.t vector} list
        | typdesc of typdesc
        | typdescs of typdesc list
        | tyvar of Tyvar.t
@@ -465,18 +467,18 @@
   | SEMICOLON expsAndTopdecs ([] :: expsAndTopdecs)
 
 topdec : topdecnode (Topdec.makeRegion' (topdecnode,
-					 topdecnodeleft,
-					 topdecnoderight))
+                                         topdecnodeleft,
+                                         topdecnoderight))
 
 topdecnode
    : strdec
      (Topdec.Strdec strdec)
    | SIGNATURE sigbinds
      (let
-	 val sigbinds = Vector.fromList sigbinds
-	 val d = Topdec.Signature sigbinds
+         val sigbinds = Vector.fromList sigbinds
+         val d = Topdec.Signature sigbinds
       in
-	 d
+         d
       end)
    | FUNCTOR funbinds
      (Topdec.Functor (Vector.fromList funbinds))
@@ -486,36 +488,36 @@
 (*---------------------------------------------------*)
 
 strdecs : strdecsnode (Strdec.makeRegion'
-		       (strdecsnode, strdecsnodeleft, strdecsnoderight))
+                       (strdecsnode, strdecsnodeleft, strdecsnoderight))
 
 strdecsnode :                    (Strdec.Seq [])
             | SEMICOLON strdecs  (Strdec.Seq [strdecs])
             | strdec strdecs     (Strdec.Seq [strdec, strdecs])
 
 strdec : strdecnode (Strdec.makeRegion' (strdecnode,
-					 strdecnodeleft, strdecnoderight))
+                                         strdecnodeleft, strdecnoderight))
 
 strdecnode
    : STRUCTURE strbinds
      (let
-	 val strbinds = Vector.fromList strbinds
-	 val d = Strdec.Structure strbinds
+         val strbinds = Vector.fromList strbinds
+         val d = Strdec.Structure strbinds
 
 
 
       in
-	 d
+         d
       end)
    | LOCAL strdecs IN strdecs END  (Strdec.Local (strdecs1, strdecs2))
    | decnolocal
      (Strdec.Core (Dec.makeRegion' (decnolocal,
-				    decnolocalleft, decnolocalright)))
+                                    decnolocalleft, decnolocalright)))
 
 strbinds : strid sigconst EQUALOP strbinds'
            (let val (def,strbinds) = strbinds'
-	    in {name = strid, def = def, constraint = sigconst}
-	       :: strbinds
-	    end)
+            in {name = strid, def = def, constraint = sigconst}
+               :: strbinds
+            end)
 
 strbinds' : strexp1 strbinds'1    (augment1 (strexp1, strbinds'1))
           | strexp2 strbinds'2    ((strexp2,strbinds'2))
@@ -530,25 +532,25 @@
            | AND strbinds  (strbinds)
 
 strexp : strexpnode (Strexp.makeRegion' (strexpnode,
-					strexpnodeleft, strexpnoderight))
+                                        strexpnodeleft, strexpnoderight))
 
 strexpnode
   : strexp1
     (let
-	val (strexp, sigconst, sigexp) = strexp1
+        val (strexp, sigconst, sigexp) = strexp1
      in
-	Strexp.Constrained (strexp, sigconst sigexp)
+        Strexp.Constrained (strexp, sigconst sigexp)
      end)
   | strexp1 wherespecs
     (let
-	val (strexp,sigconst,sigexp) = strexp1
+        val (strexp,sigconst,sigexp) = strexp1
      in
-	Strexp.Constrained
-	(strexp,
-	 sigconst (Sigexp.wheree
-		   (sigexp, wherespecs,
-		    Region.extendRight (Sigexp.region sigexp,
-					wherespecsright))))
+        Strexp.Constrained
+        (strexp,
+         sigconst (Sigexp.wheree
+                   (sigexp, wherespecs,
+                    Region.extendRight (Sigexp.region sigexp,
+                                        wherespecsright))))
      end)
   | strexp2node
     (strexp2node)
@@ -557,19 +559,19 @@
         | strexp COLONGT sigexp'  ((strexp,SigConst.Opaque,sigexp'))
 
 strexp2 : strexp2node (Strexp.makeRegion'
-		       (strexp2node, strexp2nodeleft, strexp2noderight))
+                       (strexp2node, strexp2nodeleft, strexp2noderight))
 
 strexp2node
-        : longid	             (Strexp.Var (Longstrid.fromSymbols longid))
+        : longid                     (Strexp.Var (Longstrid.fromSymbols longid))
         | STRUCT strdecs END         (Strexp.Struct strdecs)
-	| longid arg_fct
-	  (Strexp.App (Fctid.fromSymbol (ensureNonqualified longid), arg_fct))
-	| LET strdecs IN strexp END  (Strexp.Let (strdecs,strexp))
+        | longid arg_fct
+          (Strexp.App (Fctid.fromSymbol (ensureNonqualified longid), arg_fct))
+        | LET strdecs IN strexp END  (Strexp.Let (strdecs,strexp))
 
 arg_fct : LPAREN strexp RPAREN   (strexp)
-	| LPAREN strdecs RPAREN  (Strexp.makeRegion'
-				  (Strexp.Struct strdecs,
-				   strdecsleft, strdecsright))
+        | LPAREN strdecs RPAREN  (Strexp.makeRegion'
+                                  (Strexp.Struct strdecs,
+                                   strdecsleft, strdecsright))
 
 (*---------------------------------------------------*)
 (*                    Signatures                     *)
@@ -596,22 +598,22 @@
 sigbinds: sigid EQUALOP sigexp' sigbinds'  (augment (sigid, sigexp', sigbinds'))
 
 sigexp' : sigexp'node (Sigexp.makeRegion' (sigexp'node,
-					  sigexp'nodeleft,
-					  sigexp'noderight))
+                                          sigexp'nodeleft,
+                                          sigexp'noderight))
 
-sigexp'node : sigid			 (Sigexp.Var sigid)
-            | SIG specs END	         (Sigexp.Spec specs)
+sigexp'node : sigid                      (Sigexp.Var sigid)
+            | SIG specs END              (Sigexp.Spec specs)
 
 sigbinds':                             (([], defaultPos, []))
          | AND sigbinds                (([], defaultPos, sigbinds))
          | WHERE wherespec sigbinds''  (cons1 (wherespec,sigbinds''))
 
 sigbinds'' : sigbinds'                 (sigbinds')
-	   | AND wherespec sigbinds''  (cons1 (wherespec,sigbinds''))
+           | AND wherespec sigbinds''  (cons1 (wherespec,sigbinds''))
 
 wherespec  : TYPE tyvars longtycon EQUALOP ty  ({tyvars = tyvars,
-						 longtycon = longtycon,
-						 ty = ty})
+                                                 longtycon = longtycon,
+                                                 ty = ty})
 
 sigconst :                 (SigConst.None)
          | COLON sigexp    (SigConst.Transparent sigexp)
@@ -620,31 +622,31 @@
 specs  :                   (Spec.makeRegion (Spec.Empty, Region.bogus))
        | SEMICOLON specs   (specs)
        | spec specs        (Spec.seq (spec, specs))
-				
+                                
 spec : specnode (Spec.makeRegion' (specnode, specnodeleft, specnoderight))
 
-specnode : VAL valdescs		(Spec.Val (Vector.fromList valdescs))
-         | TYPE typdescs	(Spec.Type (Vector.fromList typdescs))
-         | TYPE typBind   	(Spec.TypeDefs typBind)
-         | EQTYPE typdescs	(Spec.Eqtype (Vector.fromList typdescs))
+specnode : VAL valdescs         (Spec.Val (Vector.fromList valdescs))
+         | TYPE typdescs        (Spec.Type (Vector.fromList typdescs))
+         | TYPE typBind         (Spec.TypeDefs typBind)
+         | EQTYPE typdescs      (Spec.Eqtype (Vector.fromList typdescs))
          | DATATYPE datatypeRhsNoWithtype (Spec.Datatype datatypeRhsNoWithtype)
-         | EXCEPTION exndescs	(Spec.Exception (Vector.fromList exndescs))
-         | STRUCTURE strdescs	(Spec.Structure (Vector.fromList strdescs))
+         | EXCEPTION exndescs   (Spec.Exception (Vector.fromList exndescs))
+         | STRUCTURE strdescs   (Spec.Structure (Vector.fromList strdescs))
          | INCLUDE sigexp       (Spec.IncludeSigexp sigexp)
          | INCLUDE sigid sigids (* p. 59 *)
-	   (Spec.IncludeSigids (Vector.fromList (sigid :: sigids)) )
-	 | sharespec
-	   (Spec.Sharing {spec = Spec.makeRegion' (Spec.Empty,
-						   sharespecleft,
-						   sharespecright),
-			  equations = (Vector.new1
-				       (Equation.makeRegion' (sharespec,
-							      sharespecleft,
-							      sharespecright)))})
-	   
+           (Spec.IncludeSigids (Vector.fromList (sigid :: sigids)) )
+         | sharespec
+           (Spec.Sharing {spec = Spec.makeRegion' (Spec.Empty,
+                                                   sharespecleft,
+                                                   sharespecright),
+                          equations = (Vector.new1
+                                       (Equation.makeRegion' (sharespec,
+                                                              sharespecleft,
+                                                              sharespecright)))})
+           
 sharespec : SHARING TYPE longtyconeqns (Equation.Type longtyconeqns)
           | SHARING longstrideqns      (Equation.Structure longstrideqns)
-	
+        
 longstrideqns : longstrid EQUALOP longstrid ([longstrid1,longstrid2])
               | longstrid EQUALOP longstrideqns (longstrid :: longstrideqns)
 
@@ -662,18 +664,18 @@
 
 typdescs : typdesc               ([typdesc])
          | typdesc AND typdescs  (typdesc :: typdescs)
-	   
-typdesc	: tyvars tycon ({tyvars = tyvars,
-			 tycon = tycon})
+           
+typdesc : tyvars tycon ({tyvars = tyvars,
+                         tycon = tycon})
 
 valdescs : valdesc                ([valdesc])
-         | valdesc AND valdescs	  (valdesc :: valdescs)
-	     
-valdesc	: var COLON ty  (Con.ensureSpecify (Vid.toCon (Vid.fromVar var))
-			 ; (var, ty))
+         | valdesc AND valdescs   (valdesc :: valdescs)
+             
+valdesc : var COLON ty  (Con.ensureSpecify (Vid.toCon (Vid.fromVar var))
+                         ; (var, ty))
 
 exndescs : exndesc                ([exndesc])
-         | exndesc AND exndescs	  (exndesc :: exndescs)
+         | exndesc AND exndescs   (exndesc :: exndescs)
 
 exndesc : con tyOpt  (Con.ensureSpecify con; (con, tyOpt))
 
@@ -686,15 +688,15 @@
 
 funbinds : fctid LPAREN fctarg RPAREN sigconst EQUALOP funbinds'
            (let val (strexp,funbinds) = funbinds'
-	    in {name = fctid,
-		arg = FctArg.makeRegion' (fctarg, fctargleft, fctargright),
-		result = sigconst,
-		body = strexp}
-	       :: funbinds
-	    end)
+            in {name = fctid,
+                arg = FctArg.makeRegion' (fctarg, fctargleft, fctargright),
+                result = sigconst,
+                body = strexp}
+               :: funbinds
+            end)
 
 funbinds' : strexp1 funbinds'1  (augment1 (strexp1, funbinds'1))
-	  | strexp2 funbinds'2  ((strexp2, funbinds'2))
+          | strexp2 funbinds'2  ((strexp2, funbinds'2))
 
 funbinds'1 : funbinds'2                   ([], funbinds'2left, funbinds'2)
            | WHERE wherespec funbinds'1'  (cons1 (wherespec,funbinds'1'))
@@ -711,11 +713,11 @@
 (*---------------------------------------------------*)
 (*                   Declarations                    *)
 (*---------------------------------------------------*)
-	  
-decs : 			(Dec.makeRegion' (Dec.SeqDec (Vector.new0 ()),
-					  defaultPos, defaultPos))
+          
+decs :                  (Dec.makeRegion' (Dec.SeqDec (Vector.new0 ()),
+                                          defaultPos, defaultPos))
      | dec decs         (Dec.sequence (dec,decs))
-     | SEMICOLON decs	(decs)
+     | SEMICOLON decs   (decs)
 
 dec : decnode (Dec.makeRegion' (decnode, decnodeleft, decnoderight))
 
@@ -723,49 +725,49 @@
         | LOCAL decs IN decs END  (Dec.Local (decs1,decs2))
 
 decnolocal
-        : VAL valbindTop	  (Dec.Val {tyvars = Vector.new0 (),
-					    vbs = #1 valbindTop,
-					    rvbs = #2 valbindTop})
+        : VAL valbindTop          (Dec.Val {tyvars = Vector.new0 (),
+                                            vbs = #1 valbindTop,
+                                            rvbs = #2 valbindTop})
         | VAL tyvarseq valbindTop  (Dec.Val {tyvars = tyvarseq,
-					     vbs = #1 valbindTop,
-					     rvbs = #2 valbindTop})
-	| FUN funs		(Dec.Fun (Vector.new0 (), Vector.fromList funs))
-	| FUN tyvarseq funs	(Dec.Fun (tyvarseq, Vector.fromList funs))
-	| TYPE typBind		(Dec.Type typBind)
+                                             vbs = #1 valbindTop,
+                                             rvbs = #2 valbindTop})
+        | FUN funs              (Dec.Fun (Vector.new0 (), Vector.fromList funs))
+        | FUN tyvarseq funs     (Dec.Fun (tyvarseq, Vector.fromList funs))
+        | TYPE typBind          (Dec.Type typBind)
         | DATATYPE datatypeRhs  (Dec.Datatype datatypeRhs)
-	| ABSTYPE datBind WITH decs END   (Dec.Abstype {datBind = datBind,
-							body = decs})
-	| EXCEPTION ebs
-	  (Dec.Exception (Vector.fromList ebs))
-	| OPEN longstrids	(Dec.Open (Vector.fromList longstrids))
-	| fixity vids		(Dec.Fix {fixity = fixity,
-					  ops = Vector.fromList vids})
-	| OVERLOAD priority var COLON ty AS longvarands
-	                        (Dec.Overload (priority, 
+        | ABSTYPE datBind WITH decs END   (Dec.Abstype {datBind = datBind,
+                                                        body = decs})
+        | EXCEPTION ebs
+          (Dec.Exception (Vector.fromList ebs))
+        | OPEN longstrids       (Dec.Open (Vector.fromList longstrids))
+        | fixity vids           (Dec.Fix {fixity = fixity,
+                                          ops = Vector.fromList vids})
+        | OVERLOAD priority var COLON ty AS longvarands
+                                (Dec.Overload (priority, 
                                                var,
-					       Vector.new0 (),
-					       ty,
-					       Vector.fromList longvarands))
+                                               Vector.new0 (),
+                                               ty,
+                                               Vector.fromList longvarands))
 
 valbindTop : valbind (let
-			 val (vbs, rvbs) = valbind
-		      in
-			 (Vector.fromList vbs,
-			  Vector.fromList rvbs)
-		      end)
+                         val (vbs, rvbs) = valbind
+                      in
+                         (Vector.fromList vbs,
+                          Vector.fromList rvbs)
+                      end)
 
-valbind	: pat EQUALOP exp valbindRest
+valbind : pat EQUALOP exp valbindRest
           (let
-	      val (vbs, rvbs) = valbindRest
-	   in
-	      ({pat = pat, exp = exp} :: vbs,
-	       rvbs)
-	   end)
+              val (vbs, rvbs) = valbindRest
+           in
+              ({pat = pat, exp = exp} :: vbs,
+               rvbs)
+           end)
         | REC rvalbind                 (([], rvalbind))
 
 
 valbindRest :                          (([], []))
-	    | AND valbind              (valbind)
+            | AND valbind              (valbind)
 
 rvalbind : REC rvalbind                (rvalbind)
          | pat EQUALOP FN match rvalbindRest
@@ -774,30 +776,30 @@
 rvalbindRest :               ([])
              | AND rvalbind  (rvalbind)
 
-constraint :	 		(NONE)
-	   | COLON ty	 	(SOME ty)
+constraint :                    (NONE)
+           | COLON ty           (SOME ty)
 
-funs	: clausesTop               ([clausesTop])
-	| clausesTop AND funs	   (clausesTop :: funs)
+funs    : clausesTop               ([clausesTop])
+        | clausesTop AND funs      (clausesTop :: funs)
 
 clausesTop: clauses (Vector.fromList clauses)
 
-clauses	: clause		([clause])
-	| clause BAR clauses	(clause :: clauses)
+clauses : clause                ([clause])
+        | clause BAR clauses    (clause :: clauses)
 
-clause	: apats constraint EQUALOP exp  ({pats = Vector.fromList apats,
-					  resultType = constraint,
-					  body = exp})
+clause  : apats constraint EQUALOP exp  ({pats = Vector.fromList apats,
+                                          resultType = constraint,
+                                          body = exp})
 
 typBind : typBind'
           (let
-	      val typBind = Vector.fromList typBind'
-	      val b =
-		 TypBind.makeRegion'
-		 (TypBind.T typBind, typBind'left, typBind'right)
-	   in
-	      b
-	   end)
+              val typBind = Vector.fromList typBind'
+              val b =
+                 TypBind.makeRegion'
+                 (TypBind.T typBind, typBind'left, typBind'right)
+           in
+              b
+           end)
 
 typBind' : tyvars tycon EQUALOP ty typBind''
            ({def = ty, tycon = tycon, tyvars = tyvars} :: typBind'')
@@ -806,33 +808,33 @@
           | AND typBind'  (typBind')
 
 
-tyvars	: tyvarseq (tyvarseq)
-	|          (Vector.new0 ())
+tyvars  : tyvarseq (tyvarseq)
+        |          (Vector.new0 ())
 
-tyvarseq: tyvar			  (Vector.new1 tyvar)
-	| LPAREN tyvar_pc RPAREN
-	  (let
-	      val v = Vector.fromList tyvar_pc
-	      val () =
-		 reportDuplicates
-		 (v, {equals = Tyvar.sameName,
-		      layout = Tyvar.layout,
-		      name = "type variable",
-		      region = Tyvar.region,
-		      term = fn () => Layout.tuple (Vector.toListMap
-						    (v, Tyvar.layout))})
-	   in
-	      v
-	   end)
+tyvarseq: tyvar                   (Vector.new1 tyvar)
+        | LPAREN tyvar_pc RPAREN
+          (let
+              val v = Vector.fromList tyvar_pc
+              val () =
+                 reportDuplicates
+                 (v, {equals = Tyvar.sameName,
+                      layout = Tyvar.layout,
+                      name = "type variable",
+                      region = Tyvar.region,
+                      term = fn () => Layout.tuple (Vector.toListMap
+                                                    (v, Tyvar.layout))})
+           in
+              v
+           end)
 
 tyvar_pc: tyvar                ([tyvar])
-	| tyvar COMMA tyvar_pc (tyvar :: tyvar_pc)
+        | tyvar COMMA tyvar_pc (tyvar :: tyvar_pc)
 
-constrs : constr		([constr])
-	| constr BAR constrs	(constr :: constrs)
+constrs : constr                ([constr])
+        | constr BAR constrs    (constr :: constrs)
 
-constr	: opcon		(opcon, NONE)
-	| opcon OF ty	(opcon, SOME ty)
+constr  : opcon         (opcon, NONE)
+        | opcon OF ty   (opcon, SOME ty)
 
 opcon   : con           (con)
         | OP con        (con)
@@ -840,32 +842,32 @@
 ebs     : eb              ([eb])
         | eb AND ebs      (eb::ebs)
 
-eb	: opcon ebrhs	  (Con.ensureRedefine opcon; (opcon, ebrhs))
+eb      : opcon ebrhs     (Con.ensureRedefine opcon; (opcon, ebrhs))
 
 ebrhs : ebrhsnode (EbRhs.makeRegion' (ebrhsnode,
-				     ebrhsnodeleft, ebrhsnoderight))
+                                     ebrhsnodeleft, ebrhsnoderight))
 
 ebrhsnode   :                    (EbRhs.Gen NONE)
             | OF ty              (EbRhs.Gen (SOME ty))
-	    | EQUALOP longcon    (EbRhs.Def longcon)
-	    | EQUALOP OP longcon (EbRhs.Def longcon)
+            | EQUALOP longcon    (EbRhs.Def longcon)
+            | EQUALOP OP longcon (EbRhs.Def longcon)
 
-fixity	: INFIX			(Fixity.Infix NONE)
-	| INFIX digit		(Fixity.Infix (SOME digit))
-	| INFIXR		(Fixity.Infixr NONE)
-	| INFIXR digit		(Fixity.Infixr (SOME digit))
-	| NONFIX		(Fixity.Nonfix)
+fixity  : INFIX                 (Fixity.Infix NONE)
+        | INFIX digit           (Fixity.Infix (SOME digit))
+        | INFIXR                (Fixity.Infixr NONE)
+        | INFIXR digit          (Fixity.Infixr (SOME digit))
+        | NONFIX                (Fixity.Nonfix)
 
-priority :			(Priority.T NONE)
-         | digit		(Priority.T (SOME digit))
+priority :                      (Priority.T NONE)
+         | digit                (Priority.T (SOME digit))
 
 int : INT
    (let
        val {digits, negate, radix} = INT
     in
        case StringCvt.scanString (fn r => IntInf.scan (radix, r)) digits of
-	  NONE => Error.bug "parser saw invalid int"
-	| SOME i => if negate then ~ i else i
+          NONE => Error.bug "parser saw invalid int"
+        | SOME i => if negate then ~ i else i
     end)
 
 word : WORD
@@ -873,8 +875,8 @@
        val {digits, radix} = WORD
     in
        case StringCvt.scanString (fn r => IntInf.scan (radix, r)) digits of
-	  NONE => Error.bug "parser saw invalid word"
-	| SOME i => i
+          NONE => Error.bug "parser saw invalid word"
+        | SOME i => i
     end)
 
 digit : INT
@@ -882,28 +884,28 @@
        val {digits, negate, radix} = INT
     in
        if 1 = String.size digits andalso not negate andalso radix = StringCvt.DEC
-	  then valOf (Int.fromString digits)
+          then valOf (Int.fromString digits)
        else let
-	       open Layout
-	       val _ = 
-		  Control.error (reg (INTleft, INTright),
-				 str "invalid digit in infix declaration",
-				 empty)
-	    in
-	       0
-	    end
+               open Layout
+               val _ = 
+                  Control.error (reg (INTleft, INTright),
+                                 str "invalid digit in infix declaration",
+                                 empty)
+            in
+               0
+            end
     end)
 
 datatypeRhs
    : datatypeRhsnode
      (DatatypeRhs.makeRegion' (datatypeRhsnode,
-			       datatypeRhsnodeleft, datatypeRhsnoderight))
+                               datatypeRhsnodeleft, datatypeRhsnoderight))
 
 datatypeRhsNoWithtype
    : datatypeRhsnodeNoWithtype
      (DatatypeRhs.makeRegion' (datatypeRhsnodeNoWithtype,
-			       datatypeRhsnodeNoWithtypeleft,
-			       datatypeRhsnodeNoWithtyperight))
+                               datatypeRhsnodeNoWithtypeleft,
+                               datatypeRhsnodeNoWithtyperight))
 
 datatypeRhsnode
    : repl              (repl)
@@ -915,10 +917,10 @@
 
 repl : tyvars tycon EQUALOP DATATYPE longtycon
        (if Vector.isEmpty tyvars
-	   then ()
-	else error (reg (tyvarsleft, tyvarsright),
-		    "nonempty tyvars in datatype repl")
-	; DatatypeRhs.Repl {lhs = tycon, rhs = longtycon})
+           then ()
+        else error (reg (tyvarsleft, tyvarsright),
+                    "nonempty tyvars in datatype repl")
+        ; DatatypeRhs.Repl {lhs = tycon, rhs = longtycon})
 
 datBind
    : dbs withtypes
@@ -951,166 +953,175 @@
             | longvar AND longvarands (longvar :: longvarands)
 
 match : rules           (Match.makeRegion' (Match.T (Vector.fromList rules),
-					    rulesleft, rulesright))
+                                            rulesleft, rulesright))
 
 rules : rule            ([rule])
       | rule BAR rules  (rule :: rules)
 
-rule	: pat DARROW exp        ((pat,exp))
+rule    : pat DARROW exp        ((pat,exp))
 
-elabel	: field EQUALOP exp	(field,exp)
+elabel  : field EQUALOP exp     (field,exp)
 
-elabels : elabel COMMA elabels	(elabel :: elabels)
-	| elabel	        ([elabel])
+elabels : elabel COMMA elabels  (elabel :: elabels)
+        | elabel                ([elabel])
 
-exp_ps	: exp SEMICOLON exp     ([exp1, exp2])
-	| exp SEMICOLON exp_ps	(exp :: exp_ps)
+exp_ps  : exp SEMICOLON exp     ([exp1, exp2])
+        | exp SEMICOLON exp_ps  (exp :: exp_ps)
 
 exp : expnode (Exp.makeRegion' (expnode, expnodeleft, expnoderight))
 
-expnode	: exp HANDLE match	(Exp.Handle (exp, match))
+expnode : exp HANDLE match      (Exp.Handle (exp, match))
         | exp ORELSE exp        (Exp.Orelse (exp1, exp2))
-	| exp ANDALSO exp       (Exp.Andalso (exp1, exp2))
-        | exp COLON ty	        (Exp.Constraint (exp, ty))
-	| app_exp	        (Exp.FlatApp (Vector.fromList app_exp))
-	| FN match	        (Exp.Fn match)
-	| CASE exp OF match	(Exp.Case (exp, match))
-	| WHILE exp DO exp	(Exp.While {test = exp1, expr = exp2})
-	| IF exp THEN exp ELSE exp (Exp.If (exp1, exp2, exp3))
-	| RAISE exp	        (Exp.Raise exp)
+        | exp ANDALSO exp       (Exp.Andalso (exp1, exp2))
+        | exp COLON ty          (Exp.Constraint (exp, ty))
+        | app_exp               (Exp.FlatApp (Vector.fromList app_exp))
+        | FN match              (Exp.Fn match)
+        | CASE exp OF match     (Exp.Case (exp, match))
+        | WHILE exp DO exp      (Exp.While {test = exp1, expr = exp2})
+        | IF exp THEN exp ELSE exp (Exp.If (exp1, exp2, exp3))
+        | RAISE exp             (Exp.Raise exp)
 
-app_exp	: aexp app_exp1     (Exp.makeRegion' (aexp, aexpleft, aexpright)
-			     :: app_exp1)
+app_exp : aexp app_exp1     (Exp.makeRegion' (aexp, aexpleft, aexpright)
+                             :: app_exp1)
         | longvid app_exp1  (Exp.makeRegion' (Exp.Var {name = longvid,
-						       fixop = Fixop.None},
-					     longvidleft, longvidright)
-			     :: app_exp1)
+                                                       fixop = Fixop.None},
+                                             longvidleft, longvidright)
+                             :: app_exp1)
 
 app_exp1 :         ([])
          | app_exp (app_exp)
 
-aexp	: OP vid		(Exp.Var {name = Longvid.short vid,
-					 fixop = Fixop.Op})
-	| const                 (Exp.Const const)
-	| HASH field		(Exp.Selector field)
-	| LBRACE elabels RBRACE
-	  (Exp.Record (Record.fromVector (Vector.fromList elabels)))
-	| LBRACE RBRACE		(Exp.unit)
-	| LPAREN RPAREN		(Exp.unit)
-	| LPAREN expnode RPAREN (expnode)
-	| LPAREN exp_ps RPAREN	(Exp.Seq (Vector.fromList exp_ps))
-	| LPAREN exp_2c RPAREN	(Exp.tuple (Vector.fromList exp_2c))
-	| LBRACKET exp_list RBRACKET  (Exp.List (Vector.fromList exp_list))
-	| LBRACKET RBRACKET           (Exp.List (Vector.new0 ()))
-	| LET decs IN exp END   (Exp.Let (decs, exp))
-	| LET decs IN exp_ps END
-	    (Exp.Let (decs, Exp.makeRegion' (Exp.Seq (Vector.fromList exp_ps),
-					     exp_psleft,
-					     exp_psright)))
+aexp    : OP vid                (Exp.Var {name = Longvid.short vid,
+                                         fixop = Fixop.Op})
+        | const                 (Exp.Const const)
+        | HASH field            (Exp.Selector field)
+        | LBRACE elabels RBRACE
+          (Exp.Record (Record.fromVector (Vector.fromList elabels)))
+        | LBRACE RBRACE         (Exp.unit)
+        | LPAREN RPAREN         (Exp.unit)
+        | LPAREN expnode RPAREN (expnode)
+        | LPAREN exp_ps RPAREN  (Exp.Seq (Vector.fromList exp_ps))
+        | LPAREN exp_2c RPAREN  (Exp.tuple (Vector.fromList exp_2c))
+        | LBRACKET exp_list RBRACKET  (Exp.List (Vector.fromList exp_list))
+        | LBRACKET RBRACKET           (Exp.List (Vector.new0 ()))
+        | LET decs IN exp END   (Exp.Let (decs, exp))
+        | LET decs IN exp_ps END
+            (Exp.Let (decs, Exp.makeRegion' (Exp.Seq (Vector.fromList exp_ps),
+                                             exp_psleft,
+                                             exp_psright)))
+        | ADDRESS string COLON ty SEMICOLON
+          (Exp.Prim (PrimKind.Address {name = string,
+                                       ty = ty}))
         | BUILD_CONST string COLON ty SEMICOLON
-	  (Exp.Prim {kind = PrimKind.BuildConst {name = string}, 
-                     ty = ty})
-	| COMMAND_LINE_CONST string COLON ty EQUALOP constOrBool SEMICOLON
-	  (Exp.Prim {kind = PrimKind.CommandLineConst {name = string,
-                                                       value = constOrBool},
-		     ty = ty})
+          (Exp.Prim (PrimKind.BuildConst {name = string, ty = ty}))
+        | COMMAND_LINE_CONST string COLON ty EQUALOP constOrBool SEMICOLON
+          (Exp.Prim (PrimKind.CommandLineConst {name = string,
+                                                ty = ty,
+                                                value = constOrBool}))
         | CONST string COLON ty SEMICOLON
-	  (Exp.Prim {kind = PrimKind.Const {name = string}, 
-                     ty = ty})
-        | FFI string COLON ty SEMICOLON
-	  (Control.warning
-	   (reg (FFIleft, SEMICOLONright),
-	    Layout.str "_ffi is deprecated.  Use _import.",
-	    Layout.empty)
-	   ; Exp.Prim {kind = PrimKind.Import {attributes = [], 
-                                               name = string}, 
-                       ty = ty})
-	| EXPORT string attributes COLON ty SEMICOLON
-          (Exp.Prim {kind = PrimKind.Export {attributes = attributes,
-                                             name = string},
-		     ty = ty})
-	| IMPORT string attributes COLON ty SEMICOLON
-	  (Exp.Prim {kind = PrimKind.Import {attributes = attributes,
-                                             name = string},
-		     ty = ty})
-	| IMPORT ASTERISK attributes COLON ty SEMICOLON
-	  (Exp.Prim {kind = PrimKind.IImport {attributes = attributes},
-		     ty = ty})
-	| IMPORT HASH string COLON ty SEMICOLON
-	  (Exp.Prim {kind = PrimKind.Symbol {name = string},
-		     ty = ty})
+          (Exp.Prim (PrimKind.Const {name = string, ty = ty}))
+        | EXPORT string ieattributes COLON ty SEMICOLON
+          (Exp.Prim (PrimKind.Export {attributes = ieattributes,
+                                      name = string,
+                                      ty = ty}))
+        | IMPORT string ieattributes COLON ty SEMICOLON
+          (Exp.Prim (PrimKind.Import {attributes = ieattributes,
+                                      name = string,
+                                      ty = ty}))
+        | IMPORT ASTERISK ieattributes COLON ty SEMICOLON
+          (Exp.Prim (PrimKind.IImport {attributes = ieattributes,
+                                       ty = ty}))
         | PRIM string COLON ty SEMICOLON
-	  (Exp.Prim {kind = PrimKind.Prim {name = string}, 
-                     ty = ty})
+          (Exp.Prim (PrimKind.Prim {name = string,
+                                    ty = ty}))
+        | SYMBOL string symattributes COLON ty SEMICOLON
+          (Exp.Prim (PrimKind.Symbol {attributes = symattributes,
+                                      name = string,
+                                      ty = ty}))
+        | SYMBOL ASTERISK COLON ty SEMICOLON
+          (Exp.Prim (PrimKind.ISymbol {ty = ty}))
 
-attributes
+ieattributes
    :
      ([])
-   | id attributes
+   | id ieattributes
      (let
-	 val id = Symbol.toString (#1 id)
+         val id = Symbol.toString (#1 id)
       in
-	 case id of
-	    "cdecl" => PrimKind.Attribute.Cdecl :: attributes
-	  | "stdcall" => PrimKind.Attribute.Stdcall :: attributes
-	  | _ => (error (reg (idleft, idright), concat ["invalid attribute", id])
-		  ; attributes)
+         case id of
+            "cdecl" => PrimKind.ImportExportAttribute.Cdecl :: ieattributes
+          | "stdcall" => PrimKind.ImportExportAttribute.Stdcall :: ieattributes
+          | _ => (error (reg (idleft, idright), concat ["invalid attribute", id])
+                  ; ieattributes)
       end)
 
-exp_2c	: exp COMMA exp_2c	(exp :: exp_2c)
-	| exp COMMA exp		([exp1, exp2])
+symattributes
+   :
+     ([])
+   | id symattributes
+     (let
+         val id = Symbol.toString (#1 id)
+      in
+         case id of
+            "alloc" => PrimKind.SymbolAttribute.Alloc :: symattributes
+          | _ => (error (reg (idleft, idright), concat ["invalid attribute", id])
+                  ; symattributes)
+      end)
 
-exp_list : exp			([exp])
-	 | exp COMMA exp_list	(exp :: exp_list)
+exp_2c  : exp COMMA exp_2c      (exp :: exp_2c)
+        | exp COMMA exp         ([exp1, exp2])
 
+exp_list : exp                  ([exp])
+         | exp COMMA exp_list   (exp :: exp_list)
+
 (*---------------------------------------------------*)
 (*                     Patterns                      *)
 (*---------------------------------------------------*)
 
 pat : patnode (Pat.makeRegion' (patnode, patnodeleft, patnoderight))
 
-patnode	: pat AS pat    (Pat.makeAs (pat1, pat2))
-	| pat COLON ty  (Pat.Constraint (pat, ty))
-	| apats         (Pat.FlatApp (Vector.fromList apats))
+patnode : pat AS pat    (Pat.makeAs (pat1, pat2))
+        | pat COLON ty  (Pat.Constraint (pat, ty))
+        | apats         (Pat.FlatApp (Vector.fromList apats))
 
-apats	: apat			([apat])
-        | apat apats		(apat :: apats)
+apats   : apat                  ([apat])
+        | apat apats            (apat :: apats)
 
 apat : apatnode (Pat.makeRegion' (apatnode, apatnodeleft, apatnoderight))
 
 apatnode : longvidNoEqual        (Pat.Var {name = longvidNoEqual,
-					   fixop = Fixop.None})
+                                           fixop = Fixop.None})
         | OP vid                 (Pat.Var {name = Longvid.short vid,
-					   fixop = Fixop.Op})
-	| const
+                                           fixop = Fixop.Op})
+        | const
           (let
-	      val _ =
-		 case Const.node const of
-		    Const.Real r =>
-		       let
-			  open Layout
-		       in
-			  Control.error
-			  (Const.region const,
-			   seq [str "real constants are not allowed in patterns: ",
-				Const.layout const],
-			   empty)
-		       end
-		    | _ => ()
-	   in
-	      Pat.Const const
-	   end)
-	| WILD			 (Pat.Wild)
-	| LPAREN pats RPAREN     (Pat.tuple (Vector.fromList pats))
-	| LBRACKET pats RBRACKET (Pat.List (Vector.fromList pats))
-	| LBRACE RBRACE          (Pat.unit)
-	| LBRACE patitems RBRACE
-	  (let
-	      val (items, flexible) = patitems
-	   in
-	      Pat.Record {flexible = flexible,
-			  items = Vector.fromList items}
-	   end)
+              val _ =
+                 case Const.node const of
+                    Const.Real r =>
+                       let
+                          open Layout
+                       in
+                          Control.error
+                          (Const.region const,
+                           seq [str "real constants are not allowed in patterns: ",
+                                Const.layout const],
+                           empty)
+                       end
+                    | _ => ()
+           in
+              Pat.Const const
+           end)
+        | WILD                   (Pat.Wild)
+        | LPAREN pats RPAREN     (Pat.tuple (Vector.fromList pats))
+        | LBRACKET pats RBRACKET (Pat.List (Vector.fromList pats))
+        | LBRACE RBRACE          (Pat.unit)
+        | LBRACE patitems RBRACE
+          (let
+              val (items, flexible) = patitems
+           in
+              Pat.Record {flexible = flexible,
+                          items = Vector.fromList items}
+           end)
 
 pats: ([])
     | pat commapats (pat :: commapats)
@@ -1119,10 +1130,10 @@
           | COMMA pat commapats (pat :: commapats)
 
 patitems : patitem COMMA patitems  (let val (items, f) = patitems
-				    in (patitem :: items, f)
-				    end)
-         | patitem		([patitem], false)
-	 | DOTDOTDOT		([], true)
+                                    in (patitem :: items, f)
+                                    end)
+         | patitem              ([patitem], false)
+         | DOTDOTDOT            ([], true)
 
 patitem
    : field EQUALOP pat
@@ -1133,41 +1144,41 @@
 
 opaspat :         (NONE)
         | AS pat  (SOME pat)
-					      
+                                              
 (*---------------------------------------------------*)
 (*                       Types                       *)
 (*---------------------------------------------------*)
 
 ty : tynode (Type.makeRegion' (tynode, tynodeleft, tynoderight))
 
-tynode	: tuple_ty	(Type.tuple (Vector.fromList tuple_ty))
-	| ty ARROW ty	(Type.arrow (ty1, ty2))
-	| ty'node       (ty'node)
+tynode  : tuple_ty      (Type.tuple (Vector.fromList tuple_ty))
+        | ty ARROW ty   (Type.arrow (ty1, ty2))
+        | ty'node       (ty'node)
 
 ty' : ty'node (Type.makeRegion' (ty'node, ty'nodeleft, ty'noderight))
 
-ty'node	: tyvar		                  (Type.Var tyvar)
-	| LBRACE tlabels RBRACE
-	  (Type.Record (Srecord.fromVector (Vector.fromList tlabels)))
-	| LBRACE RBRACE	                  (Type.unit)
-	| LPAREN ty0_pc RPAREN longtycon  (Type.Con (longtycon,
-						     Vector.fromList ty0_pc))
-	| LPAREN ty RPAREN	          (Type.node ty)
-	| ty' longtycon	                  (Type.Con (longtycon,
-						     Vector.new1 ty'))
+ty'node : tyvar                           (Type.Var tyvar)
+        | LBRACE tlabels RBRACE
+          (Type.Record (Srecord.fromVector (Vector.fromList tlabels)))
+        | LBRACE RBRACE                   (Type.unit)
+        | LPAREN ty0_pc RPAREN longtycon  (Type.Con (longtycon,
+                                                     Vector.fromList ty0_pc))
+        | LPAREN ty RPAREN                (Type.node ty)
+        | ty' longtycon                   (Type.Con (longtycon,
+                                                     Vector.new1 ty'))
         | longtycon                       (Type.Con (longtycon,
-						     Vector.new0 ()))
+                                                     Vector.new0 ()))
 
-tlabel	: field COLON ty	(field, ty)
+tlabel  : field COLON ty        (field, ty)
 
-tlabels : tlabel COMMA tlabels	(tlabel :: tlabels)
-	| tlabel		([tlabel])
-	  
-tuple_ty : ty' ASTERISK tuple_ty 	(ty' :: tuple_ty)
-	 | ty' ASTERISK ty'	 	([ty'1, ty'2])
+tlabels : tlabel COMMA tlabels  (tlabel :: tlabels)
+        | tlabel                ([tlabel])
+          
+tuple_ty : ty' ASTERISK tuple_ty        (ty' :: tuple_ty)
+         | ty' ASTERISK ty'             ([ty'1, ty'2])
 
-ty0_pc	: ty COMMA ty		([ty1, ty2])
-	| ty COMMA ty0_pc 	(ty :: ty0_pc)
+ty0_pc  : ty COMMA ty           ([ty1, ty2])
+        | ty COMMA ty0_pc       (ty :: ty0_pc)
 
 (*---------------------------------------------------*)
 (*                       Atoms                       *)
@@ -1176,28 +1187,28 @@
 constOrBool
    : const (const)
    | id (let
-	    fun ok b = Const.makeRegion (Const.Bool b, reg (idleft, idright))
-	 in	       
-	    case Symbol.toString (#1 id) of
-	       "false" => ok false
-	     | "true" => ok true
-	     | s => (error (#2 id, concat ["unknown boolean constant: ", s])
-		     ; ok false)
-	 end)
-	  
-const	: const'                (Const.makeRegion
-				 (const', reg (const'left, const'right)))
+            fun ok b = Const.makeRegion (Const.Bool b, reg (idleft, idright))
+         in            
+            case Symbol.toString (#1 id) of
+               "false" => ok false
+             | "true" => ok true
+             | s => (error (#2 id, concat ["unknown boolean constant: ", s])
+                     ; ok false)
+         end)
+          
+const   : const'                (Const.makeRegion
+                                 (const', reg (const'left, const'right)))
 
-const'  : int			(Const.Int int)
-	| word			(Const.Word word)
-	| REAL			(Const.Real REAL)
-	| STRING		(Const.String STRING)
-	| CHAR 		        (Const.Char CHAR)
+const'  : int                   (Const.Int int)
+        | word                  (Const.Word word)
+        | REAL                  (Const.Real REAL)
+        | STRING                (Const.String STRING)
+        | CHAR                  (Const.Char CHAR)
 
 string : STRING  (CharVector.tabulate
-		  (Vector.length STRING, fn i =>
-		   Char.fromInt (Int.fromIntInf (Vector.sub (STRING, i)))))
-	  
+                  (Vector.length STRING, fn i =>
+                   Char.fromInt (Int.fromIntInf (Vector.sub (STRING, i)))))
+          
 idNoAsterisk : longidNoAsterisk (ensureNonqualified longidNoAsterisk)
 
 id : idNoAsterisk  (idNoAsterisk)
@@ -1213,46 +1224,46 @@
 longidNoAsterisk
    : LONGID
      (let
-	 val syms = List.map (String.split (LONGID, #"."), Symbol.fromString)
+         val syms = List.map (String.split (LONGID, #"."), Symbol.fromString)
       in
-	 (syms, reg (LONGIDleft, LONGIDright))
+         (syms, reg (LONGIDleft, LONGIDright))
       end)
 
 longidEqual : longid   (longid)
             | EQUALOP  (([Symbol.equal], reg (EQUALOPleft, EQUALOPright)))
-	      
+              
 vid : idEqual                  (Vid.fromSymbol idEqual)
 vidNoEqual : id                (Vid.fromSymbol id)
 vids : vid                     ([vid])
      | vid vids                (vid::vids)
 var : idEqual                  (Var.fromSymbol idEqual)
-con : id 		       (Con.fromSymbol id)
-tycon : idNoAsterisk 	       (Tycon.fromSymbol idNoAsterisk)
-tyvar : TYVAR 		       (Tyvar.newString (TYVAR, {left = TYVARleft,
-							 right = TYVARright}))
-field : id  		       (Field.Symbol (#1 id))
-      | int 		       (let
-				   val int =
-				      IntInf.toInt int
-				      handle Exn.Overflow =>
-					 (error (reg (intleft, intright),
-						 "field too huge")
-					  ; 0)
-				in
-				   Field.Int
-				   (if int <= 0
-				       then (error (reg (intleft, intright),
-						    "nonpositive field")
-					     ; ~1)
-				    else
-				       int - 1)
-				end) (* int - 1 because fields are 0-based *)
+con : id                       (Con.fromSymbol id)
+tycon : idNoAsterisk           (Tycon.fromSymbol idNoAsterisk)
+tyvar : TYVAR                  (Tyvar.newString (TYVAR, {left = TYVARleft,
+                                                         right = TYVARright}))
+field : id                     (Field.Symbol (#1 id))
+      | int                    (let
+                                   val int =
+                                      IntInf.toInt int
+                                      handle Exn.Overflow =>
+                                         (error (reg (intleft, intright),
+                                                 "field too huge")
+                                          ; 0)
+                                in
+                                   Field.Int
+                                   (if int <= 0
+                                       then (error (reg (intleft, intright),
+                                                    "nonpositive field")
+                                             ; ~1)
+                                    else
+                                       int - 1)
+                                end) (* int - 1 because fields are 0-based *)
 
-strid : id 		       (Strid.fromSymbol id)
-sigid : id 		       (Sigid.fromSymbol id)
-sigids : sigid         	       ([sigid])
-       | sigid sigids  	       (sigid :: sigids)
-fctid : id 		       (Fctid.fromSymbol id)
+strid : id                     (Strid.fromSymbol id)
+sigid : id                     (Sigid.fromSymbol id)
+sigids : sigid                 ([sigid])
+       | sigid sigids          (sigid :: sigids)
+fctid : id                     (Fctid.fromSymbol id)
 
 longtycon : longidNoAsterisk (Longtycon.fromSymbols longidNoAsterisk)
 longvar : longidEqual      (Longvar.fromSymbols longidEqual)

Modified: mlton/branches/on-20050420-cmm-branch/mlton/front-end/ml.lex
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/front-end/ml.lex	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/front-end/ml.lex	2006-02-16 19:34:54 UTC (rev 4361)
@@ -34,8 +34,8 @@
 
 fun lineDirective (source, file, yypos) =
    Source.lineDirective (source, file,
-			 {lineNum = !lineNum,
-			  lineStart = yypos - !colNum})
+                         {lineNum = !lineNum,
+                          lineStart = yypos - !colNum})
 
 fun addString (s: string) =
    charlist :=
@@ -49,13 +49,13 @@
 
 fun error (source, left, right, msg) = 
    Control.errorStr (Region.make {left = Source.getPos (source, left),
-				  right = Source.getPos (source, right)},
-		     msg)
+                                  right = Source.getPos (source, right)},
+                     msg)
 
 fun stringError (source, right, msg) =
    Control.errorStr (Region.make {left = !stringStart,
-				  right = Source.getPos (source, right)},
-		     msg)
+                                  right = Source.getPos (source, right)},
+                     msg)
 
 fun addOrd (i: IntInf.t): unit = List.push (charlist, i)
 
@@ -69,11 +69,11 @@
    let
       val pos = Source.lineStart source
       val _ =
-	 if !commentLevel > 0
-	    then Control.errorStr (Region.make {left = !commentStart,
-						right = pos},
-				   "unclosed comment")
-	 else ()
+         if !commentLevel > 0
+            then Control.errorStr (Region.make {left = !commentStart,
+                                                right = pos},
+                                   "unclosed comment")
+         else ()
    in
       Tokens.EOF (pos, pos)
    end
@@ -85,14 +85,14 @@
       val l = Source.getPos (s, l)
       val r = Source.getPos (s, r)
       val _ =
-	 if true
-	    then ()
-	 else
-	    print (concat ["tok (",
-			   SourcePos.toString l,
-			   ", " ,
-			   SourcePos.toString r,
-			   ")\n"])
+         if true
+            then ()
+         else
+            print (concat ["tok (",
+                           SourcePos.toString l,
+                           ", " ,
+                           SourcePos.toString r,
+                           ")\n"])
    in
       t (l, r)
    end
@@ -101,16 +101,16 @@
 
 fun int (yytext, drop, source, yypos, {negate: bool}, radix) =
    Tokens.INT ({digits = String.dropPrefix (yytext, drop),
-		negate = negate,
-		radix = radix},
-	       Source.getPos (source, yypos),
-	       Source.getPos (source, yypos + size yytext))
+                negate = negate,
+                radix = radix},
+               Source.getPos (source, yypos),
+               Source.getPos (source, yypos + size yytext))
 
 fun word (yytext, drop, source, yypos, radix) =
    Tokens.WORD ({digits = String.dropPrefix (yytext, drop),
-		 radix = radix},
-		Source.getPos (source, yypos),
-		Source.getPos (source, yypos + size yytext))
+                 radix = radix},
+                Source.getPos (source, yypos),
+                Source.getPos (source, yypos + size yytext))
 
 
 %% 
@@ -137,8 +137,10 @@
 hexnum={hexDigit}+;
 
 %%
-<INITIAL>{ws}	=> (continue ());
-<INITIAL>{eol}	=> (Source.newline (source, yypos); continue ());
+<INITIAL>{ws}   => (continue ());
+<INITIAL>{eol}  => (Source.newline (source, yypos); continue ());
+<INITIAL>"_address" =>
+   (tok (Tokens.ADDRESS, source, yypos, yypos + size yytext));
 <INITIAL>"_build_const" =>
    (tok (Tokens.BUILD_CONST, source, yypos, yypos + size yytext));
 <INITIAL>"_command_line_const" =>
@@ -147,23 +149,23 @@
    (tok (Tokens.CONST, source, yypos, yypos + size yytext));
 <INITIAL>"_export" =>
    (tok (Tokens.EXPORT, source, yypos, yypos + size yytext));
-<INITIAL>"_ffi" =>
-   (tok (Tokens.FFI, source, yypos, yypos + size yytext));
 <INITIAL>"_import" =>
    (tok (Tokens.IMPORT, source, yypos, yypos + size yytext));
 <INITIAL>"_overload" =>
    (tok (Tokens.OVERLOAD, source, yypos, yypos + size yytext));
+<INITIAL>"_symbol" =>
+   (tok (Tokens.SYMBOL, source, yypos, yypos + size yytext));
 <INITIAL>"_prim" =>
    (tok (Tokens.PRIM, source, yypos, yypos + size yytext));
-<INITIAL>"_"	=> (tok (Tokens.WILD, source, yypos, yypos + 1));
-<INITIAL>","	=> (tok (Tokens.COMMA, source, yypos, yypos + 1));
-<INITIAL>"{"	=> (tok (Tokens.LBRACE, source, yypos, yypos + 1));
-<INITIAL>"}"	=> (tok (Tokens.RBRACE, source, yypos, yypos + 1));
-<INITIAL>"["	=> (tok (Tokens.LBRACKET, source, yypos, yypos + 1));
-<INITIAL>"]"	=> (tok (Tokens.RBRACKET, source, yypos, yypos + 1));
-<INITIAL>";"	=> (tok (Tokens.SEMICOLON, source, yypos, yypos + 1));
-<INITIAL>"("	=> (tok (Tokens.LPAREN, source, yypos, yypos + 1));
-<INITIAL>")"	=> (tok (Tokens.RPAREN, source, yypos, yypos + 1));
+<INITIAL>"_"    => (tok (Tokens.WILD, source, yypos, yypos + 1));
+<INITIAL>","    => (tok (Tokens.COMMA, source, yypos, yypos + 1));
+<INITIAL>"{"    => (tok (Tokens.LBRACE, source, yypos, yypos + 1));
+<INITIAL>"}"    => (tok (Tokens.RBRACE, source, yypos, yypos + 1));
+<INITIAL>"["    => (tok (Tokens.LBRACKET, source, yypos, yypos + 1));
+<INITIAL>"]"    => (tok (Tokens.RBRACKET, source, yypos, yypos + 1));
+<INITIAL>";"    => (tok (Tokens.SEMICOLON, source, yypos, yypos + 1));
+<INITIAL>"("    => (tok (Tokens.LPAREN, source, yypos, yypos + 1));
+<INITIAL>")"    => (tok (Tokens.RPAREN, source, yypos, yypos + 1));
 <INITIAL>"..."  => (tok (Tokens.DOTDOTDOT, source, yypos, yypos + 3));
 <INITIAL>"|" => (tok (Tokens.BAR, source, yypos, yypos + 1));
 <INITIAL>":" => (tok (Tokens.COLON, source, yypos, yypos + 1));
@@ -218,7 +220,7 @@
    (case yytext of
        "*" => tok (Tokens.ASTERISK, source, yypos, yypos + 1)
      | _ => tok' (Tokens.LONGID, yytext, source, yypos));
-<INITIAL>{real}	=> (tok' (Tokens.REAL, yytext, source, yypos));
+<INITIAL>{real} => (tok' (Tokens.REAL, yytext, source, yypos));
 <INITIAL>{num} =>
    (int (yytext, 0, source, yypos, {negate = false}, StringCvt.DEC));
 <INITIAL>"~"{num} =>
@@ -231,27 +233,27 @@
    (word (yytext, 2, source, yypos, StringCvt.DEC));
 <INITIAL>"0wx"{hexnum} =>
    (word (yytext, 3, source, yypos, StringCvt.HEX));
-<INITIAL>\"	=> (charlist := []
+<INITIAL>\"     => (charlist := []
                     ; stringStart := Source.getPos (source, yypos)
                     ; stringtype := true
                     ; YYBEGIN S
                     ; continue ());
-<INITIAL>\#\"	=> (charlist := []
+<INITIAL>\#\"   => (charlist := []
                     ; stringStart := Source.getPos (source, yypos)
                     ; stringtype := false
                     ; YYBEGIN S
                     ; continue ());
 <INITIAL>"(*#line"{nrws}
                 => (YYBEGIN L
-		    ; commentStart := Source.getPos (source, yypos)
-		    ; commentLevel := 1
-		    ; continue ());
-<INITIAL>"(*"	=> (YYBEGIN A
+                    ; commentStart := Source.getPos (source, yypos)
                     ; commentLevel := 1
+                    ; continue ());
+<INITIAL>"(*"   => (YYBEGIN A
+                    ; commentLevel := 1
                     ; commentStart := Source.getPos (source, yypos)
                     ; continue ());
-<INITIAL>.	=> (error (source, yypos, yypos + 1, "illegal token") ;
-		    continue ());
+<INITIAL>.      => (error (source, yypos, yypos + 1, "illegal token") ;
+                    continue ());
 
 <L>[0-9]+       => (YYBEGIN LL
                     ; (lineNum := valOf (Int.fromString yytext)
@@ -260,15 +262,15 @@
                     ; continue ());
 <LL>\.          => ((* cheat: take n > 0 dots *) continue ());
 <LL>[0-9]+      => (YYBEGIN LLC
-		    ; (colNum := valOf (Int.fromString yytext))
-		      handle Overflow => YYBEGIN A
-	            ; continue ());
+                    ; (colNum := valOf (Int.fromString yytext))
+                      handle Overflow => YYBEGIN A
+                    ; continue ());
 <LL>.          => (YYBEGIN LLC; continue ()
-		(* note hack, since ml-lex chokes on the empty string for 0* *));
+                (* note hack, since ml-lex chokes on the empty string for 0* *));
 <LLC>"*)"       => (YYBEGIN INITIAL
-		    ; lineDirective (source, NONE, yypos + 2)
-		    ; commentLevel := 0; charlist := []; continue ());
-<LLC>{ws}\"	=> (YYBEGIN LLCQ; continue ());
+                    ; lineDirective (source, NONE, yypos + 2)
+                    ; commentLevel := 0; charlist := []; continue ());
+<LLC>{ws}\"     => (YYBEGIN LLCQ; continue ());
 <LLCQ>[^\"]*    => (lineFile := yytext; continue ());
 <LLCQ>\""*)"    => (YYBEGIN INITIAL
                     ; lineDirective (source, SOME (!lineFile), yypos + 3)
@@ -276,78 +278,78 @@
 <L,LLC,LLCQ>"*)" => (YYBEGIN INITIAL; commentLevel := 0; charlist := []; continue ());
 <L,LLC,LLCQ>.   => (YYBEGIN A; continue ());
 
-<A>"(*"		=> (inc commentLevel; continue ());
-<A>\n		=> (Source.newline (source, yypos) ; continue ());
+<A>"(*"         => (inc commentLevel; continue ());
+<A>\n           => (Source.newline (source, yypos) ; continue ());
 <A>"*)"         => (dec commentLevel
-		    ; if 0 = !commentLevel then YYBEGIN INITIAL else ()
-		    ; continue ());
-<A>.		=> (continue ());
+                    ; if 0 = !commentLevel then YYBEGIN INITIAL else ()
+                    ; continue ());
+<A>.            => (continue ());
 
-<S>\"	        => (let
-		       val s = Vector.fromListRev (!charlist)
-		       val _ = charlist := nil
-		       fun make (t, v) =
-			  t (v, !stringStart, Source.getPos (source, yypos + 1))
-		       val () = YYBEGIN INITIAL
-		    in
-		       if !stringtype
-			  then make (Tokens.STRING, s)
-		       else
-			  make (Tokens.CHAR,
-				if 1 <> Vector.length s
-				   then (error
-					 (source, yypos, yypos + 1,
-					  "character constant not length 1")
-					 ; 0)
-				else Vector.sub (s, 0))
+<S>\"           => (let
+                       val s = Vector.fromListRev (!charlist)
+                       val _ = charlist := nil
+                       fun make (t, v) =
+                          t (v, !stringStart, Source.getPos (source, yypos + 1))
+                       val () = YYBEGIN INITIAL
+                    in
+                       if !stringtype
+                          then make (Tokens.STRING, s)
+                       else
+                          make (Tokens.CHAR,
+                                if 1 <> Vector.length s
+                                   then (error
+                                         (source, yypos, yypos + 1,
+                                          "character constant not length 1")
+                                         ; 0)
+                                else Vector.sub (s, 0))
                     end);
-<S>\\a		=> (addChar #"\a"; continue ());
-<S>\\b		=> (addChar #"\b"; continue ());
-<S>\\f		=> (addChar #"\f"; continue ());
-<S>\\n		=> (addChar #"\n"; continue ());
-<S>\\r		=> (addChar #"\r"; continue ());
-<S>\\t		=> (addChar #"\t"; continue ());
-<S>\\v		=> (addChar #"\v"; continue ());
-<S>\\\^[@-_]	=> (addChar (Char.chr(Char.ord(String.sub(yytext, 2))
-				      -Char.ord #"@"));
-		    continue ());
-<S>\\\^.	=>
-	(error (source, yypos, yypos + 2,
-		"illegal control escape; must be one of @ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_");
-	continue ());
-<S>\\[0-9]{3}	=> (let
-		       fun c (i, scale) =
-			  scale * (Char.ord (String.sub (yytext, i))
-				   - Char.ord #"0")
-		       val () = addOrd (IntInf.fromInt
-					(c (1, 100) + c (2, 10) + c (3, 1)))
-		    in
-		       continue ()
-		    end);
+<S>\\a          => (addChar #"\a"; continue ());
+<S>\\b          => (addChar #"\b"; continue ());
+<S>\\f          => (addChar #"\f"; continue ());
+<S>\\n          => (addChar #"\n"; continue ());
+<S>\\r          => (addChar #"\r"; continue ());
+<S>\\t          => (addChar #"\t"; continue ());
+<S>\\v          => (addChar #"\v"; continue ());
+<S>\\\^[@-_]    => (addChar (Char.chr(Char.ord(String.sub(yytext, 2))
+                                      -Char.ord #"@"));
+                    continue ());
+<S>\\\^.        =>
+        (error (source, yypos, yypos + 2,
+                "illegal control escape; must be one of @ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_");
+        continue ());
+<S>\\[0-9]{3}   => (let
+                       fun c (i, scale) =
+                          scale * (Char.ord (String.sub (yytext, i))
+                                   - Char.ord #"0")
+                       val () = addOrd (IntInf.fromInt
+                                        (c (1, 100) + c (2, 10) + c (3, 1)))
+                    in
+                       continue ()
+                    end);
 <S>\\u{hexDigit}{4} => (addHexEscape (String.substring (yytext, 2, 4),
-				      source, yypos)
-			; continue ());
+                                      source, yypos)
+                        ; continue ());
 <S>\\U{hexDigit}{8} => (addHexEscape (String.substring (yytext, 2, 8),
-				      source, yypos)
-			; continue ());
-<S>\\\"		=> (addString "\""; continue ());
-<S>\\\\		=> (addString "\\"; continue ());
-<S>\\{nrws}   	=> (YYBEGIN F; continue ());
+                                      source, yypos)
+                        ; continue ());
+<S>\\\"         => (addString "\""; continue ());
+<S>\\\\         => (addString "\\"; continue ());
+<S>\\{nrws}     => (YYBEGIN F; continue ());
 <S>\\{eol}      => (Source.newline (source, yypos) ; YYBEGIN F ; continue ());   
-<S>\\		=> (stringError (source, yypos, "illegal string escape")
-		    ; continue ());
-<S>{eol}	=> (Source.newline (source, yypos)
-		    ; stringError (source, yypos, "unclosed string")
-		    ; continue ());
+<S>\\           => (stringError (source, yypos, "illegal string escape")
+                    ; continue ());
+<S>{eol}        => (Source.newline (source, yypos)
+                    ; stringError (source, yypos, "unclosed string")
+                    ; continue ());
 <S>" "|[\033-\126]  => (addString yytext; continue ());
 <S>. =>  (stringError (source, yypos + 1, "illegal character in string")
-	  ; continue ());
+          ; continue ());
 
 <F>{eol}        => (Source.newline (source, yypos) ; continue ());
-<F>{ws}		=> (continue ());
-<F>\\		=> (YYBEGIN S
-		    ; stringStart := Source.getPos (source, yypos)
-		    ; continue ());
-<F>.		=> (stringError (source, yypos, "unclosed string")
-		    ; continue ());
+<F>{ws}         => (continue ());
+<F>\\           => (YYBEGIN S
+                    ; stringStart := Source.getPos (source, yypos)
+                    ; continue ());
+<F>.            => (stringError (source, yypos, "unclosed string")
+                    ; continue ());
    

Modified: mlton/branches/on-20050420-cmm-branch/mlton/front-end/mlb-front-end.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/front-end/mlb-front-end.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/front-end/mlb-front-end.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,9 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 functor MLBFrontEnd (S: MLB_FRONT_END_STRUCTS): MLB_FRONT_END = 
@@ -17,39 +17,39 @@
  *)
 
 val lexAndParseProgOrMLBRef: (File.t * Region.t -> Ast.Basdec.node) ref =
-   ref (fn _ => Error.bug "lexAndParseProgOrMLB")
+   ref (fn _ => Error.bug "MLBFrontEnd.lexAndParseProgOrMLB")
 
 val lexAndParseProgOrMLB = fn f => !lexAndParseProgOrMLBRef f
 
 structure LrVals = MLBLrValsFun (structure Token = LrParser.Token
-			 	 structure Ast = Ast
-				 val lexAndParseProgOrMLB = lexAndParseProgOrMLB)
+                                 structure Ast = Ast
+                                 val lexAndParseProgOrMLB = lexAndParseProgOrMLB)
 structure Lex = MLBLexFun (structure Tokens = LrVals.Tokens)
 structure Parse = JoinWithArg (structure ParserData = LrVals.ParserData
-			       structure Lex = Lex
-			       structure LrParser = LrParser)
+                               structure Lex = Lex
+                               structure LrParser = LrParser)
 
 fun lexAndParse (source: Source.t, ins: In.t) =
    let
       val stream =
-	 Parse.makeLexer (fn n => In.inputN (ins, n))
-	 {source = source}
+         Parse.makeLexer (fn n => In.inputN (ins, n))
+         {source = source}
       val lookahead = 30
       val result =
-	 (#1 (Parse.parse (lookahead, stream, fn (s, left, right) =>
-			   Control.errorStr (Region.make {left = left,
-							  right = right},
-					     s),
-			   ())))
-	 handle _ =>
-	    let
-	       val i = Source.lineStart source
-	       val _ = 
-		  Control.errorStr (Region.make {left = i, right = i},
-				    "parse error")
-	    in
-	       Ast.Basdec.empty
-	    end
+         (#1 (Parse.parse (lookahead, stream, fn (s, left, right) =>
+                           Control.errorStr (Region.make {left = left,
+                                                          right = right},
+                                             s),
+                           ())))
+         handle _ =>
+            let
+               val i = Source.lineStart source
+               val _ = 
+                  Control.errorStr (Region.make {left = i, right = i},
+                                    "parse error")
+            in
+               Ast.Basdec.empty
+            end
       val () = Ast.Basdec.checkSyntax result
    in 
       result
@@ -72,7 +72,7 @@
 
 val lexAndParseString =
     Trace.trace ("MLBFrontEnd.lexAndParseString", String.layout,
-		 Ast.Basdec.layout)
+                 Ast.Basdec.layout)
     lexAndParseString
 
 val lexAndParseString =
@@ -82,192 +82,220 @@
       val relativize = SOME cwd
       val state = {cwd = cwd, relativize = relativize, seen = []}
       val psi : (File.t * Ast.Basdec.t Promise.t) HashSet.t =
-	 HashSet.new {hash = String.hash o #1}
+         HashSet.new {hash = String.hash o #1}
       local
-	 fun make (file: File.t) =
-	    if File.canRead file
-	       then
-		  List.keepAllMap
-		  (File.lines file, fn line =>
-		   if String.forall (line, Char.isSpace)
-		      then NONE
-		   else 
-		      case String.tokens (line, Char.isSpace) of
-			 [var, path] => SOME {var = var, path = path}
-		       | _ => Error.bug (concat ["strange mlb path mapping: ", 
-						 file, ":: ", line]))
-	    else []
-	 val pathMap =
-	    (List.rev o List.concat)
-	    [make (concat [!Control.libDir, "/mlb-path-map"]),
-	     case OS.Process.getEnv "HOME" of
-		NONE => []
-	      | SOME path => make (concat [path, "/.mlton/mlb-path-map"]),
-	     [{var = "LIB_MLTON_DIR", 
-	       path = OS.Path.mkAbsolute {path = !Control.libDir,
-					  relativeTo = cwd}}]]
-	 fun peekPathMap var' =
-	    case List.peek (pathMap, fn {var,...} =>
-			    var = var') of
-	       NONE => NONE
-	     | SOME {path, ...} => SOME path
+         fun make (file: File.t) =
+            if not (File.canRead file) then
+               Error.bug (concat ["can't read MLB path map file: ", file])
+            else
+               List.keepAllMap
+               (File.lines file, fn line =>
+                if String.forall (line, Char.isSpace)
+                   then NONE
+                else 
+                   case String.tokens (line, Char.isSpace) of
+                      [var, path] => SOME {var = var, path = path}
+                    | _ => Error.bug (concat ["strange mlb path mapping: ", 
+                                              file, ":: ", line]))
+         val pathMap =
+            List.rev
+            (List.concat
+             [List.concat (List.map (!Control.mlbPathMaps, make)),
+              [{var = "LIB_MLTON_DIR", 
+                path = !Control.libDir},
+               {var = "TARGET_ARCH",
+                path = String.toLower (MLton.Platform.Arch.toString
+                                       (!Control.targetArch))},
+               {var = "TARGET_OS",
+                path = String.toLower (MLton.Platform.OS.toString
+                                       (!Control.targetOS))}]])
+         fun peekPathMap var' =
+            case List.peek (pathMap, fn {var,...} =>
+                            var = var') of
+               NONE => NONE
+             | SOME {path, ...} => SOME path
       in
-	 val peekPathMap =
-	    Trace.trace ("MLBFrontEnd.peekPathMap", 
-			 String.layout,
-			 Option.layout Dir.layout)
-	    peekPathMap
+         val peekPathMap =
+            Trace.trace ("MLBFrontEnd.peekPathMap", 
+                         String.layout,
+                         Option.layout Dir.layout)
+            peekPathMap
       end
-      fun regularize {fileOrig, cwd, relativize} =
-	 let
-	    val fileExp = 
-	       let
-		  fun loop (s, acc, accs) =
-		     case s of
-			[] => String.concat (List.rev
-					     (String.fromListRev acc :: accs))
-		      | (#"$")::(#"(")::s => 
-			   let
-			      val accs = (String.fromListRev acc)::accs
-			      fun loopVar (s, acc) =
-				 case s of
-				    [] => Error.bug "regularize"
-				  | (#")")::s => (s, String.fromListRev acc)
-				  | c::s => loopVar (s, c::acc)
-			      val (s, var) = loopVar (s, [])
-			   in
-			      case peekPathMap var of
-				 NONE => loop (s, [], accs)
-			       | SOME path => 
-				    loop ((String.explode path) @ s, [], accs)
-			   end
-		      | c::s => loop (s, c::acc, accs)
-	       in
-		  loop (String.explode fileOrig, [], [])
-	       end
-	    val fileAbs = OS.Path.mkAbsolute {path = fileExp, relativeTo = cwd}
-	    val fileAbs = OS.Path.mkCanonical fileAbs
-	    val relativize =
-	       if OS.Path.isAbsolute fileExp
-		  then NONE
-		  else relativize
-	    val fileUse =
-	       case relativize of
-		  NONE => fileAbs
-		| SOME d => OS.Path.mkRelative {path = fileAbs, relativeTo = d}
-	 in
-	    {fileAbs = fileAbs,
-	     fileUse = fileUse,
-	     relativize = relativize}
-	 end
+      fun expandPathVars (path, seen, region) =
+         let
+            fun loop (s, acc, accs) =
+               case s of
+                  [] => String.concat (List.rev
+                                       (String.fromListRev acc :: accs))
+                | #"$" :: #"(" :: s => 
+                     let
+                        val accs = String.fromListRev acc :: accs
+                        fun loopVar (s, acc) =
+                           case s of
+                              [] => Error.bug "MLBFrontEnd.lexAndParseString.expandPathVars"
+                            | #")" :: s => (s, String.fromListRev acc)
+                            | c :: s => loopVar (s, c :: acc)
+                        val (s, var) = loopVar (s, [])
+                     in
+                        if List.exists (seen, fn x => x = var)
+                           then
+                              let
+                                 open Layout
+                              in
+                                 Control.error
+                                 (region,
+                                  str "Cyclic MLB path variables",
+                                  List.layout Layout.str (var :: seen))
+                                 ; loop (s, [], accs)
+                              end
+                        else
+                           case peekPathMap var of
+                              NONE =>
+                                 let
+                                    open Layout
+                                 in
+                                    Control.error
+                                    (region,
+                                     seq [str "Undefined MLB path variable: ",
+                                          str var],
+                                     empty)
+                                    ; loop (s, [], accs)
+                                 end
+                            | SOME path => 
+                                 loop (s, [],
+                                       expandPathVars (path, var :: seen, region)
+                                       :: accs)
+                     end
+                | c :: s => loop (s, c :: acc, accs)
+         in
+            loop (String.explode path, [], [])
+         end
+      fun regularize {fileOrig, cwd, region, relativize} =
+         let
+            val fileExp = expandPathVars (fileOrig, [], region)
+            val fileAbs = OS.Path.mkAbsolute {path = fileExp, relativeTo = cwd}
+            val fileAbs = OS.Path.mkCanonical fileAbs
+            val relativize =
+               if OS.Path.isAbsolute fileExp
+                  then NONE
+                  else relativize
+            val fileUse =
+               case relativize of
+                  NONE => fileAbs
+                | SOME d => OS.Path.mkRelative {path = fileAbs, relativeTo = d}
+         in
+            {fileAbs = fileAbs,
+             fileUse = fileUse,
+             relativize = relativize}
+         end
       val regularize =
-	 Trace.trace ("MLBFrontEnd.regularize", 
-		      fn {fileOrig, cwd, relativize} =>
-		      Layout.record
-		      [("fileOrig", File.layout fileOrig),
-		       ("cwd", Dir.layout cwd),
-		       ("relativize", Option.layout Dir.layout relativize)],
-		      fn {fileAbs, fileUse, relativize} =>
-		      Layout.record
-		      [("fileAbs", File.layout fileAbs),
-		       ("fileUse", File.layout fileUse),
-		       ("relativize", Option.layout Dir.layout relativize)])
-	 regularize
+         Trace.trace ("MLBFrontEnd.lexAndParseString.regularize", 
+                      fn {fileOrig, cwd, relativize, ...} =>
+                      Layout.record
+                      [("fileOrig", File.layout fileOrig),
+                       ("cwd", Dir.layout cwd),
+                       ("relativize", Option.layout Dir.layout relativize)],
+                      fn {fileAbs, fileUse, relativize} =>
+                      Layout.record
+                      [("fileAbs", File.layout fileAbs),
+                       ("fileUse", File.layout fileUse),
+                       ("relativize", Option.layout Dir.layout relativize)])
+         regularize
       fun lexAndParseProg {fileAbs: File.t, fileUse: File.t, 
-			   fail: String.t -> Ast.Program.t} =
-	 Ast.Basdec.Prog
-	 ({fileAbs = fileAbs, fileUse = fileUse},
-	  Promise.delay
-	  (fn () =>
-	   Control.checkFile
-	   (fileUse, fail, fn () => FrontEnd.lexAndParseFile fileUse)))
-      and lexAndParseMLB {cwd: Dir.t, relativize: Dir.t option,
-			  seen: (File.t * File.t * Region.t) list,
-			  fileAbs: File.t, fileUse: File.t,
-			  fail: String.t -> Ast.Basdec.t, reg: Region.t} =
-	 Ast.Basdec.MLB
-	 ({fileAbs = fileAbs, fileUse = fileUse},
-	  Promise.delay
-	  (fn () =>
-	   Control.checkFile
-	   (fileUse, fail, fn () =>
-	    let
-	       val seen' = (fileAbs, fileUse, reg) :: seen
-	    in
-	       if List.exists (seen, fn (fileAbs', _, _) => 
-			       String.equals (fileAbs, fileAbs'))
-		  then (let open Layout
-			in 
-			   Control.error 
-			   (reg, seq [str "Basis forms a cycle with ", 
-				      File.layout fileUse],
-			    align (List.map (seen', fn (_, f, r) => 
-					     seq [Region.layout r, 
-						  str ": ", 
-						  File.layout f])))
-			   ; Ast.Basdec.empty
-			end)
-	       else 
-		  let
-		     val (_, basdec) =
-			HashSet.lookupOrInsert
-			(psi, String.hash fileAbs, fn (fileAbs', _) =>
-			 String.equals (fileAbs, fileAbs'), fn () =>
-			 let
-			    val cwd = OS.Path.dir fileAbs
-			    val basdec =
-			       Promise.delay
-			       (fn () =>
-				wrapLexAndParse
-				({cwd = cwd,
-				  relativize = relativize,
-				  seen = seen'},
-				 lexAndParseFile, fileUse))
-			 in
-			    (fileAbs, basdec)
-			 end)
-		  in
-		     Promise.force basdec
-		  end
-	    end)))
+                           fail: String.t -> Ast.Program.t} =
+         Ast.Basdec.Prog
+         ({fileAbs = fileAbs, fileUse = fileUse},
+          Promise.delay
+          (fn () =>
+           Control.checkFile
+           (fileUse, fail, fn () => FrontEnd.lexAndParseFile fileUse)))
+      and lexAndParseMLB {relativize: Dir.t option,
+                          seen: (File.t * File.t * Region.t) list,
+                          fileAbs: File.t, fileUse: File.t,
+                          fail: String.t -> Ast.Basdec.t, reg: Region.t} =
+         Ast.Basdec.MLB
+         ({fileAbs = fileAbs, fileUse = fileUse},
+          Promise.delay
+          (fn () =>
+           Control.checkFile
+           (fileUse, fail, fn () =>
+            let
+               val seen' = (fileAbs, fileUse, reg) :: seen
+            in
+               if List.exists (seen, fn (fileAbs', _, _) => 
+                               String.equals (fileAbs, fileAbs'))
+                  then (let open Layout
+                        in 
+                           Control.error 
+                           (reg, seq [str "Basis forms a cycle with ", 
+                                      File.layout fileUse],
+                            align (List.map (seen', fn (_, f, r) => 
+                                             seq [Region.layout r, 
+                                                  str ": ", 
+                                                  File.layout f])))
+                           ; Ast.Basdec.empty
+                        end)
+               else 
+                  let
+                     val (_, basdec) =
+                        HashSet.lookupOrInsert
+                        (psi, String.hash fileAbs, fn (fileAbs', _) =>
+                         String.equals (fileAbs, fileAbs'), fn () =>
+                         let
+                            val cwd = OS.Path.dir fileAbs
+                            val basdec =
+                               Promise.delay
+                               (fn () =>
+                                wrapLexAndParse
+                                ({cwd = cwd,
+                                  relativize = relativize,
+                                  seen = seen'},
+                                 lexAndParseFile, fileUse))
+                         in
+                            (fileAbs, basdec)
+                         end)
+                  in
+                     Promise.force basdec
+                  end
+            end)))
       and lexAndParseProgOrMLB {cwd, relativize, seen}
-	                       (fileOrig: File.t, reg: Region.t) =
-	 let
-	    val {fileAbs, fileUse, relativize, ...} = 
-	       regularize {cwd = cwd,
-			   fileOrig = fileOrig,
-			   relativize = relativize}
-	    fun fail default msg =
-	       let
-		  val () = Control.error (reg, Layout.str msg, Layout.empty)
-	       in
-		  default
-	       end
-	    val mlbExts = ["mlb"]
-	    val progExts = ["ML","fun","sig","sml"]
-	    fun err () = fail (Ast.Basdec.Seq []) "has an unknown extension"
-	 in
-	    case File.extension fileUse of
-	       NONE => err ()
-	     | SOME s =>
-		  if List.contains (mlbExts, s, String.equals)
-		     then lexAndParseMLB {cwd = cwd,
-					  relativize = relativize,
-					  seen = seen,
-					  fileAbs = fileAbs,
-					  fileUse = fileUse,
-					  fail = fail Ast.Basdec.empty,
-					  reg = reg}
-		  else if List.contains (progExts, s, String.equals)
-		     then lexAndParseProg {fileAbs = fileAbs,
-					   fileUse = fileUse,
-					   fail = fail Ast.Program.empty}
-		  else err ()
-	 end
+                               (fileOrig: File.t, reg: Region.t) =
+         let
+            val {fileAbs, fileUse, relativize, ...} = 
+               regularize {cwd = cwd,
+                           fileOrig = fileOrig,
+                           region = reg,
+                           relativize = relativize}
+            fun fail default msg =
+               let
+                  val () = Control.error (reg, Layout.str msg, Layout.empty)
+               in
+                  default
+               end
+            val mlbExts = ["mlb"]
+            val progExts = ["ML","fun","sig","sml"]
+            fun err () = fail (Ast.Basdec.Seq []) "has an unknown extension"
+         in
+            case File.extension fileUse of
+               NONE => err ()
+             | SOME s =>
+                  if List.contains (mlbExts, s, String.equals)
+                     then lexAndParseMLB {relativize = relativize,
+                                          seen = seen,
+                                          fileAbs = fileAbs,
+                                          fileUse = fileUse,
+                                          fail = fail Ast.Basdec.empty,
+                                          reg = reg}
+                  else if List.contains (progExts, s, String.equals)
+                     then lexAndParseProg {fileAbs = fileAbs,
+                                           fileUse = fileUse,
+                                           fail = fail Ast.Program.empty}
+                  else err ()
+         end
       and wrapLexAndParse (state, lexAndParse, arg) =
-	 Ref.fluidLet
-	 (lexAndParseProgOrMLBRef, lexAndParseProgOrMLB state, fn () =>
-	  lexAndParse arg)
+         Ref.fluidLet
+         (lexAndParseProgOrMLBRef, lexAndParseProgOrMLB state, fn () =>
+          lexAndParse arg)
       val dec = wrapLexAndParse (state, lexAndParseString, s)
    in
       dec

Modified: mlton/branches/on-20050420-cmm-branch/mlton/front-end/mlb-front-end.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/front-end/mlb-front-end.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/front-end/mlb-front-end.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature MLB_FRONT_END_STRUCTS = 
    sig
       structure Ast: AST
@@ -15,6 +16,6 @@
 signature MLB_FRONT_END = 
    sig
       include MLB_FRONT_END_STRUCTS
-	 
+         
       val lexAndParseString: String.t -> Ast.Basdec.t 
    end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/front-end/mlb.grm
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/front-end/mlb.grm	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/front-end/mlb.grm	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,9 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 type int = Int.t
@@ -27,7 +27,7 @@
     | ANN | PRIM | FILE of string | STRING of string
 
 %nonterm
-	 ann of string * Region.t
+         ann of string * Region.t
        | annPlus of (string * Region.t) list
        | annStar of (string * Region.t) list
        | basbinds of basbinds
@@ -132,10 +132,10 @@
         val extendRight = 
           let val right = valOf (Region.right (Basdec.region basdecs))
           in fn reg => Region.extendRight (reg, right)
-	  end
+          end
         fun mkAnn' ((ann,reg), basdecs) = Basdec.Ann (ann, reg, basdecs)
         fun mkAnn ((ann,reg), basdecsnode) : Basdec.node =
-	  mkAnn' ((ann,reg), Basdec.makeRegion (basdecsnode, extendRight reg))
+          mkAnn' ((ann,reg), Basdec.makeRegion (basdecsnode, extendRight reg))
         val (anns,ann) = List.splitLast annPlus
       in
         List.fold(anns, mkAnn'(ann, basdecs), mkAnn)

Modified: mlton/branches/on-20050420-cmm-branch/mlton/front-end/mlb.lex
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/front-end/mlb.lex	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/front-end/mlb.lex	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,10 @@
+(* Copyright (C) 2004-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 type int = Int.t
    
 type svalue = Tokens.svalue
@@ -17,8 +24,8 @@
 
 fun lineDirective (source, file, yypos) =
    Source.lineDirective (source, file,
-			 {lineNum = !lineNum,
-			  lineStart = yypos - !colNum})
+                         {lineNum = !lineNum,
+                          lineStart = yypos - !colNum})
 fun addString (s: string) = charlist := s :: (!charlist)
 fun addChar (c: char) = addString (String.fromChar c)
 
@@ -27,24 +34,24 @@
 
 fun error (source, left, right, msg) = 
    Control.errorStr (Region.make {left = Source.getPos (source, left),
-				  right = Source.getPos (source, right)},
-		     msg)
+                                  right = Source.getPos (source, right)},
+                     msg)
 
 fun stringError (source, right, msg) =
    Control.errorStr (Region.make {left = !stringStart,
-				  right = Source.getPos (source, right)},
-		     msg)
+                                  right = Source.getPos (source, right)},
+                     msg)
 
 val eof: lexarg -> lexresult =
    fn {source, ...} =>
    let
       val pos = Source.lineStart source
       val _ =
-	 if !commentLevel > 0
-	    then Control.errorStr (Region.make {left = !commentStart,
-						right = pos},
-				   "unclosed comment")
-	 else ()
+         if !commentLevel > 0
+            then Control.errorStr (Region.make {left = !commentStart,
+                                                right = pos},
+                                   "unclosed comment")
+         else ()
    in
       Tokens.EOF (pos, pos)
    end
@@ -56,14 +63,14 @@
       val l = Source.getPos (s, l)
       val r = Source.getPos (s, r)
       val _ =
-	 if true
-	    then ()
-	 else
-	    print (concat ["tok (",
-			   SourcePos.toString l,
-			   ", " ,
-			   SourcePos.toString r,
-			   ")\n"])
+         if true
+            then ()
+         else
+            print (concat ["tok (",
+                           SourcePos.toString l,
+                           ", " ,
+                           SourcePos.toString r,
+                           ")\n"])
    in
       t (l, r)
    end
@@ -80,8 +87,8 @@
 id={alphanumId};
 
 pathvar="$("([A-Z_]+)")";
-filebase=[-A-Za-z_0-9]+;
-fileext=[-A-Za-z_0-9]+;
+filebase=({pathvar}|[-A-Za-z_0-9])+;
+fileext=({pathvar}|[-A-Za-z_0-9])+;
 filename={filebase}("."{fileext})*;
 arc=({pathvar}|{filename}|"."|"..");
 relpath=({arc}"/")*;
@@ -98,12 +105,12 @@
 hexDigit=[0-9a-fA-F];
 
 %%
-<INITIAL>{ws}	=> (continue ());
-<INITIAL>{eol}	=> (Source.newline (source, yypos); continue ());
+<INITIAL>{ws}   => (continue ());
+<INITIAL>{eol}  => (Source.newline (source, yypos); continue ());
 <INITIAL>"_prim" 
                 => (tok (Tokens.PRIM, source, yypos, yypos + 4));
-<INITIAL>","	=> (tok (Tokens.COMMA, source, yypos, yypos + 1));
-<INITIAL>";"	=> (tok (Tokens.SEMICOLON, source, yypos, yypos + 1));
+<INITIAL>","    => (tok (Tokens.COMMA, source, yypos, yypos + 1));
+<INITIAL>";"    => (tok (Tokens.SEMICOLON, source, yypos, yypos + 1));
 <INITIAL>"="    => (tok (Tokens.EQUALOP, source, yypos, yypos + 1));
 <INITIAL>"ann"  => (tok (Tokens.ANN, source, yypos, yypos + 3));
 <INITIAL>"and"  => (tok (Tokens.AND, source, yypos, yypos + 3));
@@ -131,15 +138,15 @@
                     ; continue ());
 <INITIAL>"(*#line"{nrws}
                 => (YYBEGIN L
-		    ; commentStart := Source.getPos (source, yypos)
-		    ; commentLevel := 1
-		    ; continue ());
-<INITIAL>"(*"	=> (YYBEGIN A
+                    ; commentStart := Source.getPos (source, yypos)
                     ; commentLevel := 1
+                    ; continue ());
+<INITIAL>"(*"   => (YYBEGIN A
+                    ; commentLevel := 1
                     ; commentStart := Source.getPos (source, yypos)
                     ; continue ());
-<INITIAL>.	=> (error (source, yypos, yypos + 1, "illegal token") ;
-		    continue ());
+<INITIAL>.      => (error (source, yypos, yypos + 1, "illegal token") ;
+                    continue ());
 
 <L>[0-9]+       => (YYBEGIN LL
                     ; (lineNum := valOf (Int.fromString yytext)
@@ -148,15 +155,15 @@
                     ; continue ());
 <LL>\.          => ((* cheat: take n > 0 dots *) continue ());
 <LL>[0-9]+      => (YYBEGIN LLC
-		    ; (colNum := valOf (Int.fromString yytext))
-		      handle Overflow => YYBEGIN A
-	            ; continue ());
+                    ; (colNum := valOf (Int.fromString yytext))
+                      handle Overflow => YYBEGIN A
+                    ; continue ());
 <LL>.           => (YYBEGIN LLC; continue ()
-		(* note hack, since ml-lex chokes on the empty string for 0* *));
+                (* note hack, since ml-lex chokes on the empty string for 0* *));
 <LLC>"*)"       => (YYBEGIN INITIAL
-		    ; lineDirective (source, NONE, yypos + 2)
-		    ; commentLevel := 0; charlist := []; continue ());
-<LLC>{ws}\"	=> (YYBEGIN LLCQ; continue ());
+                    ; lineDirective (source, NONE, yypos + 2)
+                    ; commentLevel := 0; charlist := []; continue ());
+<LLC>{ws}\"     => (YYBEGIN LLCQ; continue ());
 <LLCQ>[^\"]*    => (lineFile := yytext; continue ());
 <LLCQ>\""*)"    => (YYBEGIN INITIAL
                     ; lineDirective (source, SOME (!lineFile), yypos + 3)
@@ -165,80 +172,80 @@
                 => (YYBEGIN INITIAL; commentLevel := 0; charlist := []; continue ());
 <L,LLC,LLCQ>.   => (YYBEGIN A; continue ());
 
-<A>"(*"		=> (inc commentLevel; continue ());
-<A>\n		=> (Source.newline (source, yypos) ; continue ());
+<A>"(*"         => (inc commentLevel; continue ());
+<A>\n           => (Source.newline (source, yypos) ; continue ());
 <A>"*)"         => (dec commentLevel
-		    ; if 0 = !commentLevel then YYBEGIN INITIAL else ()
-		    ; continue ());
-<A>.		=> (continue ());
+                    ; if 0 = !commentLevel then YYBEGIN INITIAL else ()
+                    ; continue ());
+<A>.            => (continue ());
 
-<S>\"	        => (let
-		       val s = concat (rev (!charlist))
-		       val _ = charlist := nil
-		       fun make (t, v) =
-			  t (v, !stringStart, Source.getPos (source, yypos + 1))
+<S>\"           => (let
+                       val s = concat (rev (!charlist))
+                       val _ = charlist := nil
+                       fun make (t, v) =
+                          t (v, !stringStart, Source.getPos (source, yypos + 1))
                     in YYBEGIN INITIAL
-		       ; make (Tokens.STRING, s)
+                       ; make (Tokens.STRING, s)
                     end);
-<S>\\a		=> (addChar #"\a"; continue ());
-<S>\\b		=> (addChar #"\b"; continue ());
-<S>\\f		=> (addChar #"\f"; continue ());
-<S>\\n		=> (addChar #"\n"; continue ());
-<S>\\r		=> (addChar #"\r"; continue ());
-<S>\\t		=> (addChar #"\t"; continue ());
-<S>\\v		=> (addChar #"\v"; continue ());
-<S>\\\^[@-_]	=> (addChar (Char.chr(Char.ord(String.sub(yytext, 2))
-				      -Char.ord #"@"))
+<S>\\a          => (addChar #"\a"; continue ());
+<S>\\b          => (addChar #"\b"; continue ());
+<S>\\f          => (addChar #"\f"; continue ());
+<S>\\n          => (addChar #"\n"; continue ());
+<S>\\r          => (addChar #"\r"; continue ());
+<S>\\t          => (addChar #"\t"; continue ());
+<S>\\v          => (addChar #"\v"; continue ());
+<S>\\\^[@-_]    => (addChar (Char.chr(Char.ord(String.sub(yytext, 2))
+                                      -Char.ord #"@"))
                     ; continue ());
-<S>\\\^.	=> (error (source, yypos, yypos + 2,
-		           "illegal control escape; must be one of @ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_")
-	            ; continue ());
-<S>\\[0-9]{3}	=> (let
-		       val x =
-			  Char.ord(String.sub(yytext, 1)) * 100
-			  + Char.ord(String.sub(yytext, 2)) * 10
-			  + Char.ord(String.sub(yytext, 3))
-			  - (Char.ord #"0") * 111
-		    in (if x > 255
-			   then stringError (source, yypos,
-					     "illegal ascii escape")
-			else addChar(Char.chr x);
-			   continue ())
-		    end);
+<S>\\\^.        => (error (source, yypos, yypos + 2,
+                           "illegal control escape; must be one of @ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_")
+                    ; continue ());
+<S>\\[0-9]{3}   => (let
+                       val x =
+                          Char.ord(String.sub(yytext, 1)) * 100
+                          + Char.ord(String.sub(yytext, 2)) * 10
+                          + Char.ord(String.sub(yytext, 3))
+                          - (Char.ord #"0") * 111
+                    in (if x > 255
+                           then stringError (source, yypos,
+                                             "illegal ascii escape")
+                        else addChar(Char.chr x);
+                           continue ())
+                    end);
 <S>\\u{hexDigit}{4} 
                 => (let
-		       val x = 
-			  StringCvt.scanString
-			  (Pervasive.Int.scan StringCvt.HEX)
-			  (String.substring (yytext, 2, 4))
-		       fun err () =
-			  stringError (source, yypos,
-				       "illegal unicode escape")
-		    in (case x of
-			  SOME x => if x > 255
-				       then err()
-				    else addChar(Char.chr x)
-			| _ => err())
-			; continue ()
-		    end);
-<S>\\\"		=> (addString "\""; continue ());
-<S>\\\\		=> (addString "\\"; continue ());
-<S>\\{nrws}   	=> (YYBEGIN F; continue ());
+                       val x = 
+                          StringCvt.scanString
+                          (Pervasive.Int.scan StringCvt.HEX)
+                          (String.substring (yytext, 2, 4))
+                       fun err () =
+                          stringError (source, yypos,
+                                       "illegal unicode escape")
+                    in (case x of
+                          SOME x => if x > 255
+                                       then err()
+                                    else addChar(Char.chr x)
+                        | _ => err())
+                        ; continue ()
+                    end);
+<S>\\\"         => (addString "\""; continue ());
+<S>\\\\         => (addString "\\"; continue ());
+<S>\\{nrws}     => (YYBEGIN F; continue ());
 <S>\\{eol}      => (Source.newline (source, yypos) ; YYBEGIN F ; continue ());   
-<S>\\		=> (stringError (source, yypos, "illegal string escape")
-		    ; continue ());
-<S>{eol}	=> (Source.newline (source, yypos)
-		    ; stringError (source, yypos, "unclosed string")
-		    ; continue ());
+<S>\\           => (stringError (source, yypos, "illegal string escape")
+                    ; continue ());
+<S>{eol}        => (Source.newline (source, yypos)
+                    ; stringError (source, yypos, "unclosed string")
+                    ; continue ());
 <S>" "|[\033-\126]  
                 => (addString yytext; continue ());
 <S>.            => (stringError (source, yypos + 1, "illegal character in string")
-	            ; continue ());
+                    ; continue ());
 
 <F>{eol}        => (Source.newline (source, yypos) ; continue ());
-<F>{ws}		=> (continue ());
-<F>\\		=> (YYBEGIN S
-		    ; stringStart := Source.getPos (source, yypos)
-		    ; continue ());
-<F>.		=> (stringError (source, yypos, "unclosed string")
-		    ; continue ());
+<F>{ws}         => (continue ());
+<F>\\           => (YYBEGIN S
+                    ; stringStart := Source.getPos (source, yypos)
+                    ; continue ());
+<F>.            => (stringError (source, yypos, "unclosed string")
+                    ; continue ());

Modified: mlton/branches/on-20050420-cmm-branch/mlton/front-end/sources.cm
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/front-end/sources.cm	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/front-end/sources.cm	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 Group
 
 functor FrontEnd
@@ -13,9 +14,9 @@
 is
 
 import.cm (* Have to do this because code generated by mlyacc relies on the
-	   * basis library being available, and lib/mlton overrides a lot of
-	   * basis library structures.
-	   *)
+           * basis library being available, and lib/mlton overrides a lot of
+           * basis library structures.
+           *)
 ../../lib/mlyacc/sources.cm
 ../ast/sources.cm
 ../control/sources.cm

Modified: mlton/branches/on-20050420-cmm-branch/mlton/front-end/sources.mlb
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/front-end/sources.mlb	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/front-end/sources.mlb	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,29 +1,40 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 local
    ../../lib/mlton/sources.mlb
    ../../lib/mlyacc/mlyacc-lib.mlb
    ../ast/sources.mlb
    ../control/sources.mlb
-   (* import Unsafe in case {ml,mlb}.lex.sml is generated by an old version of
-    * mllex that creates references to Unsafe.
-    *)
-   $(SML_LIB)/basis/unsafe.mlb
    
-   ml.grm.sig
-   ml.grm.sml
-   ml.lex.sml
+   ann "warnUnused false"
+   in
+      ml.grm.sig
+      ml.grm.sml 
+      local
+         (* import Unsafe in case {ml,mlb}.lex.sml is generated by an old
+          * version of mllex that creates references to Unsafe.
+          *)
+         $(SML_LIB)/basis/unsafe.mlb
+      in
+         ml.lex.sml
+      end
+   end
    front-end.sig
    front-end.fun
 
-   mlb.grm.sig
-   mlb.grm.sml
-   mlb.lex.sml
+   ann
+      "warnUnused false"
+   in
+      mlb.grm.sig
+      mlb.grm.sml
+      mlb.lex.sml
+   end
    mlb-front-end.sig
    mlb-front-end.fun
 in

Modified: mlton/branches/on-20050420-cmm-branch/mlton/main/compile.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/main/compile.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/main/compile.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,9 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 functor Compile (S: COMPILE_STRUCTS): COMPILE =
@@ -18,14 +18,14 @@
 structure Symbol = Symbol ()
 structure Field = Field (structure Symbol = Symbol)
 structure Record = Record (val isSorted = false
-			   structure Field = Field)
+                           structure Field = Field)
 structure SortedRecord = Record (val isSorted = true
-				 structure Field = Field)
+                                 structure Field = Field)
 structure Tyvar = Tyvar ()
 structure Ast = Ast (structure Record = Record
-		     structure SortedRecord = SortedRecord
-		     structure Symbol = Symbol
-		     structure Tyvar = Tyvar)
+                     structure SortedRecord = SortedRecord
+                     structure Symbol = Symbol
+                     structure Tyvar = Tyvar)
 local
    open Ast.Tycon
 in
@@ -35,13 +35,13 @@
    structure WordSize = WordSize
 end
 structure Atoms = Atoms (structure CharSize = CharSize
-			 structure Field = Field
-			 structure IntSize = IntSize
-			 structure RealSize = RealSize
-			 structure Record = Record
-			 structure SortedRecord = SortedRecord
-			 structure Tyvar = Tyvar
-			 structure WordSize = WordSize)
+                         structure Field = Field
+                         structure IntSize = IntSize
+                         structure RealSize = RealSize
+                         structure Record = Record
+                         structure SortedRecord = SortedRecord
+                         structure Tyvar = Tyvar
+                         structure WordSize = WordSize)
 local
    open Atoms
 in
@@ -52,24 +52,24 @@
 end
 structure TypeEnv = TypeEnv (Atoms)
 structure CoreML = CoreML (open Atoms
-			   structure Type =
-			      struct
-				 open TypeEnv.Type
+                           structure Type =
+                              struct
+                                 open TypeEnv.Type
 
-				 val makeHom =
-				    fn {con, var} =>
-				    makeHom {con = con,
-					     expandOpaque = true,
-					     var = var}
-				    
-				 val layout = layoutPretty
-			      end)
+                                 val makeHom =
+                                    fn {con, var} =>
+                                    makeHom {con = con,
+                                             expandOpaque = true,
+                                             var = var}
+                                    
+                                 val layout = layoutPretty
+                              end)
 structure Xml = Xml (open Atoms)
 structure Sxml = Sxml (open Xml)
 structure Ssa = Ssa (open Atoms)
 structure Ssa2 = Ssa2 (open Atoms)
 structure Machine = Machine (open Atoms
-			     structure Label = Ssa.Label)
+                             structure Label = Ssa.Label)
 local
    open Machine
 in
@@ -82,38 +82,38 @@
 
 structure FrontEnd = FrontEnd (structure Ast = Ast)
 structure MLBFrontEnd = MLBFrontEnd (structure Ast = Ast
-				     structure FrontEnd = FrontEnd)
+                                     structure FrontEnd = FrontEnd)
 structure DeadCode = DeadCode (structure CoreML = CoreML)
 structure Defunctorize = Defunctorize (structure CoreML = CoreML
-				       structure Xml = Xml)
+                                       structure Xml = Xml)
 structure Elaborate = Elaborate (structure Ast = Ast
-				 structure CoreML = CoreML
-				 structure TypeEnv = TypeEnv)
+                                 structure CoreML = CoreML
+                                 structure TypeEnv = TypeEnv)
 local
    open Elaborate
 in
    structure Env = Env
 end
 structure LookupConstant = LookupConstant (structure Const = Const
-					   structure ConstType = ConstType
-					   structure Ffi = Ffi)
+                                           structure ConstType = ConstType
+                                           structure Ffi = Ffi)
 structure Monomorphise = Monomorphise (structure Xml = Xml
-				       structure Sxml = Sxml)
+                                       structure Sxml = Sxml)
 structure ClosureConvert = ClosureConvert (structure Ssa = Ssa
-					   structure Sxml = Sxml)
+                                           structure Sxml = Sxml)
 structure SsaToSsa2 = SsaToSsa2 (structure Ssa = Ssa
-				 structure Ssa2 = Ssa2)
+                                 structure Ssa2 = Ssa2)
 structure Backend = Backend (structure Ssa = Ssa2
-			     structure Machine = Machine
-			     fun funcToLabel f = f)
+                             structure Machine = Machine
+                             fun funcToLabel f = f)
 structure CCodegen = CCodegen (structure Ffi = Ffi
-			       structure Machine = Machine)
+                               structure Machine = Machine)
 structure Bytecode = Bytecode (structure CCodegen = CCodegen
-			       structure Machine = Machine)
+                               structure Machine = Machine)
 structure CmmCodegen = CmmCodegen (structure CCodegen = CCodegen
-				   structure Machine = Machine)
+                                   structure Machine = Machine)
 structure x86Codegen = x86Codegen (structure CCodegen = CCodegen
-				   structure Machine = Machine)
+                                   structure Machine = Machine)
 
 
 (* ------------------------------------------------- *)
@@ -123,14 +123,21 @@
 val commandLineConstants: {name: string, value: string} list ref = ref []
 fun setCommandLineConstant (c as {name, value}) =
    let
+      fun make (fromString, control) =
+         let
+            fun set () =
+               case fromString value of
+                  NONE => Error.bug (concat ["bad value for ", name])
+                | SOME v => control := v
+         in
+            set
+         end
       val () =
-	 case List.peek ([("Exn.keepHistory", Control.exnHistory)],
-			 fn (s, _) => s = name) of
-	    NONE => ()
-	  | SOME (_, r) =>
-	       (case Bool.fromString value of
-		   NONE => Error.bug (concat ["bad value for ", name])
-		 | SOME b => r := b)
+         case List.peek ([("Exn.keepHistory", 
+                           make (Bool.fromString, Control.exnHistory))],
+                         fn (s, _) => s = name) of
+            NONE => ()
+          | SOME (_,set) => set ()
    in
       List.push (commandLineConstants, c)
    end
@@ -142,26 +149,26 @@
    let
       val zero = Const.word (WordX.fromIntInf (0, WordSize.default))
       val f =
-	 Promise.lazy
-	 (fn () =>
-	  if !amBuildingConstants
-	     then (fn ({name, default, ...}, t) =>
-		   let
-		      (* Don't keep constants that already have a default value.
-		       * These are defined by _command_line_const and set by
-		       * -const, and shouldn't be looked up.
-		       *)
-		      val () =
-			 if isSome default
-			    then ()
-			 else List.push (allConstants, (name, t))
-		   in
-		      zero
-		   end)
-	  else
-	     File.withIn
-	     (concat [!Control.libTargetDir, "/constants"], fn ins =>
-	      LookupConstant.load (ins, !commandLineConstants)))
+         Promise.lazy
+         (fn () =>
+          if !amBuildingConstants
+             then (fn ({name, default, ...}, t) =>
+                   let
+                      (* Don't keep constants that already have a default value.
+                       * These are defined by _command_line_const and set by
+                       * -const, and shouldn't be looked up.
+                       *)
+                      val () =
+                         if isSome default
+                            then ()
+                         else List.push (allConstants, (name, t))
+                   in
+                      zero
+                   end)
+          else
+             File.withIn
+             (concat [!Control.libTargetDir, "/constants"], fn ins =>
+              LookupConstant.load (ins, !commandLineConstants)))
    in
       fn z => f () z
    end
@@ -179,122 +186,122 @@
    val primitiveDatatypes =
       Vector.new3
       ({tycon = Tycon.bool,
-	tyvars = Vector.new0 (),
-	cons = Vector.new2 ({con = Con.falsee, arg = NONE},
-			    {con = Con.truee, arg = NONE})},
+        tyvars = Vector.new0 (),
+        cons = Vector.new2 ({con = Con.falsee, arg = NONE},
+                            {con = Con.truee, arg = NONE})},
        let
-	  val a = Tyvar.newNoname {equality = false}
+          val a = Tyvar.newNoname {equality = false}
        in
-	  {tycon = Tycon.list,
-	   tyvars = Vector.new1 a,
-	   cons = Vector.new2 ({con = Con.nill, arg = NONE},
-			       {con = Con.cons,
-				arg = SOME (Type.tuple
-					    (Vector.new2
-					     (Type.var a,
-					      Type.list (Type.var a))))})}
+          {tycon = Tycon.list,
+           tyvars = Vector.new1 a,
+           cons = Vector.new2 ({con = Con.nill, arg = NONE},
+                               {con = Con.cons,
+                                arg = SOME (Type.tuple
+                                            (Vector.new2
+                                             (Type.var a,
+                                              Type.list (Type.var a))))})}
        end,
        let
-	  val a = Tyvar.newNoname {equality = false}
+          val a = Tyvar.newNoname {equality = false}
        in
-	  {tycon = Tycon.reff,
-	   tyvars = Vector.new1 a,
-	   cons = Vector.new1 {con = Con.reff, arg = SOME (Type.var a)}}
+          {tycon = Tycon.reff,
+           tyvars = Vector.new1 a,
+           cons = Vector.new1 {con = Con.reff, arg = SOME (Type.var a)}}
        end)
 
    val primitiveExcons =
       let
-	 open CoreML.Con
+         open CoreML.Con
       in
-	 [bind, match, overflow]
+         [bind, match, overflow]
       end
 
    structure Con =
       struct
-	 open Con
+         open Con
 
-	 fun toAst c =
-	    Ast.Con.fromSymbol (Symbol.fromString (Con.toString c),
-				Region.bogus)
+         fun toAst c =
+            Ast.Con.fromSymbol (Symbol.fromString (Con.toString c),
+                                Region.bogus)
       end
 
    structure Env =
       struct
-	 open Env 
+         open Env 
 
-	 structure Tycon =
-	    struct
-	       open Tycon
+         structure Tycon =
+            struct
+               open Tycon
 
-	       fun toAst c =
-		  Ast.Tycon.fromSymbol (Symbol.fromString (Tycon.toString c),
-					Region.bogus)
-	    end
-	 structure Type = TypeEnv.Type
-	 structure Scheme = TypeEnv.Scheme
+               fun toAst c =
+                  Ast.Tycon.fromSymbol (Symbol.fromString (Tycon.toString c),
+                                        Region.bogus)
+            end
+         structure Type = TypeEnv.Type
+         structure Scheme = TypeEnv.Scheme
 
-	 fun addPrim (E: t): unit =
-	    let
-	       val _ =
-		  List.foreach
-		  (Tycon.prims, fn (tycon, kind, _) =>
-		   extendTycon
-		   (E, Ast.Tycon.fromSymbol (Symbol.fromString
-					     (Tycon.originalName tycon),
-					     Region.bogus),
-		    TypeStr.tycon (tycon, kind),
-		    {forceUsed = false, isRebind = false}))
-	       val _ =
-		  Vector.foreach
-		  (primitiveDatatypes, fn {tyvars, tycon, cons} =>
-		   let
-		      val cons =
-			 Env.newCons
-			 (E, Vector.map (cons, fn {con, ...} =>
-					 {con = con, name = Con.toAst con}))
-			 (Vector.map
-			  (cons, fn {arg, ...} =>
-			   let
-			      val resultType =
-				 Type.con (tycon, Vector.map (tyvars, Type.var))
-			   in
-			      Scheme.make
-			      {canGeneralize = true,
-			       ty = (case arg of
-					NONE => resultType
-				      | SOME t => Type.arrow (t, resultType)),
-			       tyvars = tyvars}
-			   end))
-		   in
-		      extendTycon
-		      (E, Tycon.toAst tycon,
-		       TypeStr.data (tycon,
-				     TypeStr.Kind.Arity (Vector.length tyvars),
-				     cons),
-		       {forceUsed = false, isRebind = false})
-		   end)
-	       val _ =
-		  extendTycon (E,
-			       Ast.Tycon.fromSymbol (Symbol.unit, Region.bogus),
-			       TypeStr.def (Scheme.fromType Type.unit,
-					    TypeStr.Kind.Arity 0),
-			       {forceUsed = false, isRebind = false})
-	       val scheme = Scheme.fromType Type.exn
-	       val _ = List.foreach (primitiveExcons, fn c =>
-				     extendExn (E, Con.toAst c, c, SOME scheme))
-	    in
-	       ()
-	    end
+         fun addPrim (E: t): unit =
+            let
+               val _ =
+                  List.foreach
+                  (Tycon.prims, fn (tycon, kind, _) =>
+                   extendTycon
+                   (E, Ast.Tycon.fromSymbol (Symbol.fromString
+                                             (Tycon.originalName tycon),
+                                             Region.bogus),
+                    TypeStr.tycon (tycon, kind),
+                    {forceUsed = false, isRebind = false}))
+               val _ =
+                  Vector.foreach
+                  (primitiveDatatypes, fn {tyvars, tycon, cons} =>
+                   let
+                      val cons =
+                         Env.newCons
+                         (E, Vector.map (cons, fn {con, ...} =>
+                                         {con = con, name = Con.toAst con}))
+                         (Vector.map
+                          (cons, fn {arg, ...} =>
+                           let
+                              val resultType =
+                                 Type.con (tycon, Vector.map (tyvars, Type.var))
+                           in
+                              Scheme.make
+                              {canGeneralize = true,
+                               ty = (case arg of
+                                        NONE => resultType
+                                      | SOME t => Type.arrow (t, resultType)),
+                               tyvars = tyvars}
+                           end))
+                   in
+                      extendTycon
+                      (E, Tycon.toAst tycon,
+                       TypeStr.data (tycon,
+                                     TypeStr.Kind.Arity (Vector.length tyvars),
+                                     cons),
+                       {forceUsed = false, isRebind = false})
+                   end)
+               val _ =
+                  extendTycon (E,
+                               Ast.Tycon.fromSymbol (Symbol.unit, Region.bogus),
+                               TypeStr.def (Scheme.fromType Type.unit,
+                                            TypeStr.Kind.Arity 0),
+                               {forceUsed = false, isRebind = false})
+               val scheme = Scheme.fromType Type.exn
+               val _ = List.foreach (primitiveExcons, fn c =>
+                                     extendExn (E, Con.toAst c, c, SOME scheme))
+            in
+               ()
+            end
       end
 
    val primitiveDecs: CoreML.Dec.t list =
       let
-	 open CoreML.Dec
+         open CoreML.Dec
       in
-	 List.concat [[Datatype primitiveDatatypes],
-		      List.map
-		      (primitiveExcons, fn c =>
-		       Exception {con = c, arg = NONE})]
+         List.concat [[Datatype primitiveDatatypes],
+                      List.map
+                      (primitiveExcons, fn c =>
+                       Exception {con = c, arg = NONE})]
       end
 
 in
@@ -309,9 +316,29 @@
 (*                 parseAndElaborateMLB              *)
 (* ------------------------------------------------- *)
 
-val lexAndParseMLB = MLBFrontEnd.lexAndParseString
+fun quoteFile s = concat ["\"", String.escapeSML s, "\""]
 
-val lexAndParseMLB : String.t -> Ast.Basdec.t = 
+structure MLBString:>
+   sig
+      type t
+
+      val fromFile: File.t -> t
+      val fromString: string -> t
+      val lexAndParseMLB: t -> Ast.Basdec.t
+   end =
+   struct
+      type t = string
+
+      val fromFile = quoteFile
+
+      val fromString = fn s => s
+         
+      val lexAndParseMLB = MLBFrontEnd.lexAndParseString
+   end
+
+val lexAndParseMLB = MLBString.lexAndParseMLB
+
+val lexAndParseMLB: MLBString.t -> Ast.Basdec.t = 
    fn input =>
    let
       val ast = lexAndParseMLB input
@@ -321,7 +348,7 @@
    end
 
 fun sourceFilesMLB {input} =
-   Ast.Basdec.sourceFiles (lexAndParseMLB input)
+   Ast.Basdec.sourceFiles (lexAndParseMLB (MLBString.fromFile input))
 
 val elaborateMLB = Elaborate.elaborateMLB
 
@@ -335,14 +362,15 @@
       ("decs", List.layout CoreML.Dec.layout d)])
     ds)
 
-fun parseAndElaborateMLB (input: String.t): Env.t * (CoreML.Dec.t list * bool) vector =
+fun parseAndElaborateMLB (input: MLBString.t)
+   : Env.t * (CoreML.Dec.t list * bool) vector =
    Control.pass
    {name = "parseAndElaborate",
     suffix = "core-ml",
     style = Control.ML,
     thunk = (fn () =>
-	     (Const.lookup := lookupConstant
-	      ; elaborateMLB (lexAndParseMLB input, {addPrim = addPrim}))),
+             (Const.lookup := lookupConstant
+              ; elaborateMLB (lexAndParseMLB input, {addPrim = addPrim}))),
     display = displayEnvDecs}
    
 (* ------------------------------------------------- *)
@@ -353,7 +381,7 @@
    let
       val _ = amBuildingConstants := true
       val (_, decs) =
-	 parseAndElaborateMLB "$(SML_LIB)/basis/libs/primitive.mlb"
+         parseAndElaborateMLB (MLBString.fromFile "$(SML_LIB)/basis/libs/primitive.mlb")
       val decs = Vector.concatV (Vector.map (decs, Vector.fromList o #1))
       (* Need to defunctorize so the constants are forced. *)
       val _ = Defunctorize.defunctorize (CoreML.Program.T {decs = decs})
@@ -368,254 +396,254 @@
 
 exception Done
 
-fun elaborate {input: String.t}: Xml.Program.t =
+fun elaborate {input: MLBString.t}: Xml.Program.t =
    let
       val (E, decs) = parseAndElaborateMLB input
       val _ =
-	 case !Control.showBasis of
-	    NONE => ()
-	  | SOME f =>
-	       File.withOut
-	       (f, fn out =>
-		Layout.outputl (Env.layoutCurrentScope E, out))
+         case !Control.showBasis of
+            NONE => ()
+          | SOME f =>
+               File.withOut
+               (f, fn out =>
+                Layout.outputl (Env.layoutCurrentScope E, out))
       val _ = Env.processDefUse E
       val _ =
-	 case !Control.exportHeader of
-	    NONE => ()
-	  | SOME f => 
-	       File.withOut
-	       (f, fn out =>
-		let
-		   val _ =
-		      File.outputContents
-		      (concat [!Control.libDir, "/include/types.h"], out)
-		   fun print s = Out.output (out, s)
-		   val _ = print "\n"
-		   val _ = Ffi.declareHeaders {print = print}
-		in
-		   ()
-		end)
+         case !Control.exportHeader of
+            NONE => ()
+          | SOME f => 
+               File.withOut
+               (f, fn out =>
+                let
+                   val _ =
+                      File.outputContents
+                      (concat [!Control.libDir, "/include/types.h"], out)
+                   fun print s = Out.output (out, s)
+                   val _ = print "\n"
+                   val _ = Ffi.declareHeaders {print = print}
+                in
+                   ()
+                end)
       val _ = if !Control.elaborateOnly then raise Done else ()
-
       val decs =
-	 Control.pass
-	 {name = "deadCode",
-	  suffix = "core-ml",
-	  style = Control.ML,
-	  thunk = fn () => let
-			      val {prog = decs} =
-				 DeadCode.deadCode {prog = decs}
-			   in
-			      decs
-			   end,
-	  display = Control.Layout (Vector.layout (List.layout CoreML.Dec.layout))}
+         Control.pass
+         {name = "deadCode",
+          suffix = "core-ml",
+          style = Control.ML,
+          thunk = fn () => let
+                              val {prog = decs} =
+                                 DeadCode.deadCode {prog = decs}
+                           in
+                              decs
+                           end,
+          display = Control.Layout (Vector.layout (List.layout CoreML.Dec.layout))}
       val decs = Vector.concatV (Vector.map (decs, Vector.fromList))
       val coreML = CoreML.Program.T {decs = decs}
 (*
       val _ = Control.message (Control.Detail, fn () =>
- 			       CoreML.Program.layoutStats coreML)
+                               CoreML.Program.layoutStats coreML)
 *)
       (* Set GC_state offsets. *)
       val _ =
-	 let
-	    fun get (name: string): Bytes.t =
-	       case lookupConstant ({default = NONE, name = name},
-				    ConstType.Word) of
-		  Const.Word w => Bytes.fromInt (WordX.toInt w)
-		| _ => Error.bug "GC_state offset must be an int"
-	 in
-	    Runtime.GCField.setOffsets
-	    {
-	     canHandle = get "canHandle",
-	     cardMap = get "cardMapForMutator",
-	     currentThread = get "currentThread",
-	     exnStack = get "exnStack",
-	     frontier = get "frontier",
-	     limit = get "limit",
-	     limitPlusSlop = get "limitPlusSlop",
-	     maxFrameSize = get "maxFrameSize",
-	     signalIsPending = get "signalIsPending",
-	     stackBottom = get "stackBottom",
-	     stackLimit = get "stackLimit",
-	     stackTop = get "stackTop"
-	     }
-	 end
+         let
+            fun get (name: string): Bytes.t =
+               case lookupConstant ({default = NONE, name = name},
+                                    ConstType.Word) of
+                  Const.Word w => Bytes.fromInt (WordX.toInt w)
+                | _ => Error.bug "Compile.elaborate: GC_state offset must be an int"
+         in
+            Runtime.GCField.setOffsets
+            {
+             canHandle = get "canHandle",
+             cardMap = get "cardMapForMutator",
+             currentThread = get "currentThread",
+             curSourceSeqsIndex = get "curSourceSeqsIndex",
+             exnStack = get "exnStack",
+             frontier = get "frontier",
+             limit = get "limit",
+             limitPlusSlop = get "limitPlusSlop",
+             maxFrameSize = get "maxFrameSize",
+             signalIsPending = get "signalIsPending",
+             stackBottom = get "stackBottom",
+             stackLimit = get "stackLimit",
+             stackTop = get "stackTop"
+             }
+         end
       (* Setup endianness *)
       val _ =
-	 let
-	    fun get (name:string): bool =
-	        case lookupConstant ({default = NONE, name = name},
-				     ConstType.Bool) of
-		   Const.Word w => 1 = WordX.toInt w
-		 | _ => Error.bug "endian unknown"
-	 in
-	    Control.setTargetBigEndian (get "MLton_Platform_Arch_bigendian")
-	 end
+         let
+            fun get (name:string): bool =
+                case lookupConstant ({default = NONE, name = name},
+                                     ConstType.Bool) of
+                   Const.Word w => 1 = WordX.toInt w
+                 | _ => Error.bug "Compile.elaborate: endian unknown"
+         in
+            Control.setTargetBigEndian (get "MLton_Platform_Arch_bigendian")
+         end
       val xml =
-	 Control.passTypeCheck
-	 {name = "defunctorize",
-	  suffix = "xml",
-	  style = Control.ML,
-	  thunk = fn () => Defunctorize.defunctorize coreML,
-	  display = Control.Layout Xml.Program.layout,
-	  typeCheck = Xml.typeCheck}
+         Control.passTypeCheck
+         {name = "defunctorize",
+          suffix = "xml",
+          style = Control.ML,
+          thunk = fn () => Defunctorize.defunctorize coreML,
+          display = Control.Layout Xml.Program.layout,
+          typeCheck = Xml.typeCheck}
    in
       xml
    end
       
-fun preCodegen {input}: Machine.Program.t =
+fun preCodegen {input: MLBString.t}: Machine.Program.t =
    let
       val xml = elaborate {input = input}
       val _ = Control.message (Control.Detail, fn () =>
-			       Xml.Program.layoutStats xml)
+                               Xml.Program.layoutStats xml)
       val xml =
-	  Control.passTypeCheck
-	  {name = "xmlSimplify",
-	   suffix = "xml",
-	   style = Control.ML,
-	   thunk = fn () => Xml.simplify xml,
-	   display = Control.Layout Xml.Program.layout,
-	   typeCheck = Xml.typeCheck}
+          Control.passTypeCheck
+          {name = "xmlSimplify",
+           suffix = "xml",
+           style = Control.ML,
+           thunk = fn () => Xml.simplify xml,
+           display = Control.Layout Xml.Program.layout,
+           typeCheck = Xml.typeCheck}
       val _ = Control.message (Control.Detail, fn () =>
-			       Xml.Program.layoutStats xml)
+                               Xml.Program.layoutStats xml)
       val sxml =
-	 Control.passTypeCheck
-	 {name = "monomorphise",
-	  suffix = "sxml",
-	  style = Control.ML,
-	  thunk = fn () => Monomorphise.monomorphise xml,
-	  display = Control.Layout Sxml.Program.layout,
-	  typeCheck = Sxml.typeCheck}
+         Control.passTypeCheck
+         {name = "monomorphise",
+          suffix = "sxml",
+          style = Control.ML,
+          thunk = fn () => Monomorphise.monomorphise xml,
+          display = Control.Layout Sxml.Program.layout,
+          typeCheck = Sxml.typeCheck}
       val _ = Control.message (Control.Detail, fn () =>
-			       Sxml.Program.layoutStats sxml)
+                               Sxml.Program.layoutStats sxml)
       val sxml =
-	 Control.passTypeCheck
-	 {name = "sxmlSimplify",
-	  suffix = "sxml",
-	  style = Control.ML,
-	  thunk = fn () => Sxml.simplify sxml,
-	  display = Control.Layout Sxml.Program.layout,
-	  typeCheck = Sxml.typeCheck}
+         Control.passTypeCheck
+         {name = "sxmlSimplify",
+          suffix = "sxml",
+          style = Control.ML,
+          thunk = fn () => Sxml.simplify sxml,
+          display = Control.Layout Sxml.Program.layout,
+          typeCheck = Sxml.typeCheck}
       val _ = Control.message (Control.Detail, fn () =>
-			       Sxml.Program.layoutStats sxml)
+                               Sxml.Program.layoutStats sxml)
       val ssa =
-	 Control.passTypeCheck
-	 {name = "closureConvert",
-	  suffix = "ssa",
-	  style = Control.No,
-	  thunk = fn () => ClosureConvert.closureConvert sxml,
-	  typeCheck = Ssa.typeCheck,
-	  display = Control.Layouts Ssa.Program.layouts}
+         Control.passTypeCheck
+         {name = "closureConvert",
+          suffix = "ssa",
+          style = Control.No,
+          thunk = fn () => ClosureConvert.closureConvert sxml,
+          typeCheck = Ssa.typeCheck,
+          display = Control.Layouts Ssa.Program.layouts}
       val ssa =
-	 Control.passTypeCheck
-	 {name = "ssaSimplify",
-	  suffix = "ssa",
-	  style = Control.No,
-	  thunk = fn () => Ssa.simplify ssa,
-	  typeCheck = Ssa.typeCheck,
-	  display = Control.Layouts Ssa.Program.layouts}
+         Control.passTypeCheck
+         {name = "ssaSimplify",
+          suffix = "ssa",
+          style = Control.No,
+          thunk = fn () => Ssa.simplify ssa,
+          typeCheck = Ssa.typeCheck,
+          display = Control.Layouts Ssa.Program.layouts}
       val _ =
-	 let
-	    open Control
-	 in
-	    if !keepSSA
-	       then saveToFile ({suffix = "ssa"}, No, ssa,
-				 Layouts Ssa.Program.layouts)
-	    else ()
-	 end
+         let
+            open Control
+         in
+            if !keepSSA
+               then saveToFile ({suffix = "ssa"}, No, ssa,
+                                 Layouts Ssa.Program.layouts)
+            else ()
+         end
       val ssa2 =
-	 Control.passTypeCheck
-	 {name = "toSsa2",
-	  suffix = "ssa2",
-	  style = Control.No,
-	  thunk = fn () => SsaToSsa2.convert ssa,
-	  typeCheck = Ssa2.typeCheck,
-	  display = Control.Layouts Ssa2.Program.layouts}
+         Control.passTypeCheck
+         {name = "toSsa2",
+          suffix = "ssa2",
+          style = Control.No,
+          thunk = fn () => SsaToSsa2.convert ssa,
+          typeCheck = Ssa2.typeCheck,
+          display = Control.Layouts Ssa2.Program.layouts}
       val ssa2 =
-	 Control.passTypeCheck
-	 {name = "ssa2Simplify",
-	  suffix = "ssa2",
-	  style = Control.No,
-	  thunk = fn () => Ssa2.simplify ssa2,
-	  typeCheck = Ssa2.typeCheck,
-	  display = Control.Layouts Ssa2.Program.layouts}
+         Control.passTypeCheck
+         {name = "ssa2Simplify",
+          suffix = "ssa2",
+          style = Control.No,
+          thunk = fn () => Ssa2.simplify ssa2,
+          typeCheck = Ssa2.typeCheck,
+          display = Control.Layouts Ssa2.Program.layouts}
       val _ =
-	 let
-	    open Control
-	 in
-	    if !keepSSA2
-	       then saveToFile ({suffix = "ssa2"}, No, ssa2,
-				 Layouts Ssa2.Program.layouts)
-	    else ()
-	 end
+         let
+            open Control
+         in
+            if !keepSSA2
+               then saveToFile ({suffix = "ssa2"}, No, ssa2,
+                                 Layouts Ssa2.Program.layouts)
+            else ()
+         end
       val codegenImplementsPrim =
-	 case !Control.codegen of
-	    Control.Bytecode => Bytecode.implementsPrim
-	  | Control.CCodegen => CCodegen.implementsPrim
-	  | Control.CmmCodegen => CmmCodegen.implementsPrim
-	  | Control.Native => x86Codegen.implementsPrim
+         case !Control.codegen of
+            Control.Bytecode => Bytecode.implementsPrim
+          | Control.CCodegen => CCodegen.implementsPrim
+          | Control.CmmCodegen => CmmCodegen.implementsPrim
+          | Control.Native => x86Codegen.implementsPrim
       val machine =
-	 Control.pass
-	 {name = "backend",
-	  suffix = "machine",
-	  style = Control.No,
-	  thunk = fn () => (Backend.toMachine
-			    (ssa2,
-			     {codegenImplementsPrim = codegenImplementsPrim})),
-	  display = Control.Layouts Machine.Program.layouts}
+         Control.pass
+         {name = "backend",
+          suffix = "machine",
+          style = Control.No,
+          thunk = fn () => (Backend.toMachine
+                            (ssa2,
+                             {codegenImplementsPrim = codegenImplementsPrim})),
+          display = Control.Layouts Machine.Program.layouts}
       val _ =
-	 let
-	    open Control
-	 in
-	    if !keepMachine
-	       then saveToFile ({suffix = "machine"}, No, machine,
-				 Layouts Machine.Program.layouts)
-	    else ()
-	 end
+         let
+            open Control
+         in
+            if !keepMachine
+               then saveToFile ({suffix = "machine"}, No, machine,
+                                 Layouts Machine.Program.layouts)
+            else ()
+         end
       val _ =
-	 (*
-	  * For now, machine type check is too slow to run.
-	  *)
-	 if !Control.typeCheck
-	    then
-	       Control.trace (Control.Pass, "machine type check")
-	       Machine.Program.typeCheck machine
-	 else ()
+         (*
+          * For now, machine type check is too slow to run.
+          *)
+         if !Control.typeCheck
+            then
+               Control.trace (Control.Pass, "machine type check")
+               Machine.Program.typeCheck machine
+         else ()
    in
       machine
    end
  
-fun compile {input: String.t, outputC, outputCmm, outputS}: unit =
+fun compile {input: MLBString.t, outputC, outputCmm, outputS}: unit =
    let
       val machine =
-	 Control.trace (Control.Top, "pre codegen")
-	 preCodegen {input = input}
+         Control.trace (Control.Top, "pre codegen")
+         preCodegen {input = input}
       fun clearNames () =
-	 (Machine.Program.clearLabelNames machine
-	  ; Machine.Label.printNameAlphaNumeric := true)
+         (Machine.Program.clearLabelNames machine
+          ; Machine.Label.printNameAlphaNumeric := true)
       val () =
-	 case !Control.codegen of
-	    Control.Bytecode =>
-	       Control.trace (Control.Top, "bytecode gen")
-	       Bytecode.output {program = machine,
-				outputC = outputC}
-	  | Control.CCodegen =>
-	       (clearNames ()
-		; (Control.trace (Control.Top, "C code gen")
-		   CCodegen.output {program = machine,
-				    outputC = outputC}))
-	  | Control.CmmCodegen =>
-	       (clearNames ()
-		; (Control.trace (Control.Top, "C-- code gen")
-		   CmmCodegen.output {program = machine,
-				      outputC = outputC,
-				      outputCmm = outputCmm}))
-	  | Control.Native =>
-	       (clearNames ()
-		; (Control.trace (Control.Top, "x86 code gen")
-		   x86Codegen.output {program = machine,
-				      outputC = outputC,
-				      outputS = outputS}))
+         case !Control.codegen of
+            Control.Bytecode =>
+               Control.trace (Control.Top, "bytecode gen")
+               Bytecode.output {program = machine,
+                                outputC = outputC}
+          | Control.CCodegen =>
+               (clearNames ()
+                ; (Control.trace (Control.Top, "C code gen")
+                   CCodegen.output {program = machine,
+                                    outputC = outputC}))
+          | Control.CmmCodegen =>
+               (clearNames ()
+                ; (Control.trace (Control.Top, "C-- code gen")
+                   CmmCodegen.output {program = machine,
+                                      outputC = outputC,
+                                      outputCmm = outputCmm}))
+          | Control.Native =>
+               (clearNames ()
+                ; (Control.trace (Control.Top, "x86 code gen")
+                   x86Codegen.output {program = machine,
+                                      outputC = outputC,
+                                      outputS = outputS}))
       val _ = Control.message (Control.Detail, PropertyList.stats)
       val _ = Control.message (Control.Detail, HashSet.stats)
    in
@@ -623,39 +651,42 @@
    end handle Done => ()
 
 fun compileMLB {input: File.t, outputC, outputCmm, outputS}: unit =
-   compile {input = input,
-	    outputC = outputC,
-	    outputCmm = outputCmm,
-	    outputS = outputS}
+   compile {input = MLBString.fromFile input,
+            outputC = outputC,
+            outputCmm = outputCmm,
+            outputS = outputS}
 
 val elaborateMLB =
    fn {input: File.t} =>
-   (ignore (elaborate {input = input}))
+   (ignore (elaborate {input = MLBString.fromFile input}))
    handle Done => ()
 
 local
-   fun genMLB {input: File.t list}: string =
+   fun genMLB {input: File.t list}: MLBString.t =
       let
-	 val basis =
-	    String.concat
-	    (List.map ([!Control.basisLibrary, "mlton", "sml-nj", "unsafe"],
-		       fn s => concat ["$(SML_LIB)/basis/", s, ".mlb\n"]))
+         val basis = "$(SML_LIB)/basis/default.mlb"
       in
-	 case input of
-	    [] => basis
-	  | _ => 
-	       String.concat ["local\n",
-			      basis,
-			      "in\n",
-			      String.concat (List.separate (input, "\n")), "\n",
-			      "end\n"]
+         MLBString.fromString
+         (case input of
+             [] => basis
+           | _ =>
+                let
+                   val input = List.map (input, quoteFile)
+                in
+                   String.concat
+                   ["local\n",
+                    basis, "\n",
+                    "in\n",
+                    String.concat (List.separate (input, "\n")), "\n",
+                    "end\n"]
+                end)
       end
 in
    fun compileSML {input: File.t list, outputC, outputCmm, outputS}: unit =
       compile {input = genMLB {input = input},
-	       outputC = outputC,
-	       outputCmm = outputCmm,
-	       outputS = outputS}
+               outputC = outputC,
+               outputCmm = outputCmm,
+               outputS = outputS}
    val elaborateSML =
       fn {input: File.t list} =>
       (ignore (elaborate {input = genMLB {input = input}}))

Modified: mlton/branches/on-20050420-cmm-branch/mlton/main/compile.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/main/compile.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/main/compile.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,9 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 signature COMPILE_STRUCTS =
@@ -15,25 +15,25 @@
       include COMPILE_STRUCTS
 
       val compileMLB: {input: File.t,
-		       outputC: unit -> {file: File.t,
-					 print: string -> unit,
-					 done: unit -> unit},
-		       outputCmm: unit -> {file: File.t,
-					   print: string -> unit,
-					   done: unit -> unit},
-		       outputS: unit -> {file: File.t,
-					 print: string -> unit,
-					 done: unit -> unit}} -> unit
+                       outputC: unit -> {file: File.t,
+                                         print: string -> unit,
+                                         done: unit -> unit},
+                       outputCmm: unit -> {file: File.t,
+                                           print: string -> unit,
+                                           done: unit -> unit},
+                       outputS: unit -> {file: File.t,
+                                         print: string -> unit,
+                                         done: unit -> unit}} -> unit
       val compileSML: {input: File.t list,
-		       outputC: unit -> {file: File.t,
-					 print: string -> unit,
-					 done: unit -> unit},
-		       outputCmm: unit -> {file: File.t,
-					   print: string -> unit,
-					   done: unit -> unit},
-		       outputS: unit -> {file: File.t,
-					 print: string -> unit,
-					 done: unit -> unit}} -> unit
+                       outputC: unit -> {file: File.t,
+                                         print: string -> unit,
+                                         done: unit -> unit},
+                       outputCmm: unit -> {file: File.t,
+                                           print: string -> unit,
+                                           done: unit -> unit},
+                       outputS: unit -> {file: File.t,
+                                         print: string -> unit,
+                                         done: unit -> unit}} -> unit
       val elaborateMLB: {input: File.t} -> unit
       val elaborateSML: {input: File.t list} -> unit
       val setCommandLineConstant: {name: string, value: string} -> unit

Modified: mlton/branches/on-20050420-cmm-branch/mlton/main/lookup-constant.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/main/lookup-constant.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/main/lookup-constant.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,9 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 functor LookupConstant (S: LOOKUP_CONSTANT_STRUCTS): LOOKUP_CONSTANT = 
@@ -25,52 +25,27 @@
       val int = Int.toString
       open Control
    in
-      [("MLton_codegen", fn () => int (case !codegen of
-					  Bytecode => 0
-					| CCodegen => 1
-					| CmmCodegen => 2
-					| Native => 3)),
-       ("MLton_profile_isOn", fn () => bool (case !profile of
-						ProfileNone => false
-					      | ProfileCallStack => false
-					      | ProfileMark => false
-					      | _ => true)),
-       ("MLton_FFI_numExports", fn () => int (Ffi.numExports ()))]
+      [("MLton_Codegen_codegen", fn () => int (case !codegen of
+                                                  Bytecode => 0
+                                                | CCodegen => 1
+                                                | CmmCodegen => 2
+                                                | Native => 3)),
+       ("MLton_FFI_numExports", fn () => int (Ffi.numExports ())),
+       ("MLton_Profile_isOn", fn () => bool (case !profile of
+                                                ProfileNone => false
+                                              | ProfileCallStack => false
+                                              | ProfileDrop => false
+                                              | ProfileLabel => false
+                                              | _ => true))]
    end
 
 datatype z = datatype ConstType.t
 
-fun escape s =
-   String.translate (s, fn c =>
-		     let
-			val i = Char.ord c
-			fun dig j =
-			   Char.chr
-			   (Char.ord #"0" + Int.rem (Int.quot (i, j), 10))
-		     in
-			implode [dig 100, dig 10, dig 1]
-		     end)
-
-fun unescape s =
-   let
-      fun sub i = Char.toInt (String.sub (s, i)) - Char.toInt #"0"
-      fun loop (i, ac) =
-	 if i < 0
-	    then ac
-	 else
-	    loop (i - 3,
-		  Char.fromInt ((sub (i - 2) * 10 + sub (i - 1)) * 10 + sub i)
-		  :: ac)
-   in
-      implode (loop (String.size s - 1, []))
-   end
-
-val unescape = Trace.trace ("unescape", String.layout, String.layout) unescape
-
 val gcFields =
    [
     "canHandle",
     "currentThread",
+    "curSourceSeqsIndex",
     "exnStack",
     "frontier",
     "cardMapForMutator",
@@ -85,42 +60,39 @@
 
 val gcFields =
    List.map (gcFields, fn s =>
-	     {name = s,
-	      value = concat ["offsetof (struct GC_state, ", s, ")"],
-	      ty = ConstType.Word})
+             {name = s,
+              value = concat ["offsetof (struct GC_state, ", s, ")"],
+              ty = ConstType.Word})
 
 fun build (constants, out) =
    let
       val constants =
-	 List.fold
-	 (constants, gcFields, fn ((name, ty), ac) =>
-	  if List.exists (buildConstants, fn (name', _) => name = name')
-	     then ac
-	  else {name = name, value = name, ty = ty} :: ac)
+         List.fold
+         (constants, gcFields, fn ((name, ty), ac) =>
+          if List.exists (buildConstants, fn (name', _) => name = name')
+             then ac
+          else {name = name, value = name, ty = ty} :: ac)
    in
       List.foreach
       (List.concat
-       [["#define _ISOC99_SOURCE",
-	 "#define _POSIX_C_SOURCE 200112L",
-	 "",
-	 "#include \"platform.h\"",
-	 "struct GC_state gcState;",
-	 "",
-	 "int main (int argc, char **argv) {"],
-	List.revMap
-	(constants, fn {name, value, ty} =>
-	 let
-	    val (format, value) =
-	       case ty of
-		  Bool => ("%s", concat [value, "? \"true\" : \"false\""])
-		| Real => ("%.20f", value)
-		| String => ("%s", value)
-		| Word => ("%u", value)
-	 in
-	    concat ["fprintf (stdout, \"", name, " = ", format, "\\n\", ",
-		    value, ");"]
-	 end),
-	["return 0;}"]],
+       [["#include \"platform.h\"",
+         "struct GC_state gcState;",
+         "",
+         "int main (int argc, char **argv) {"],
+        List.revMap
+        (constants, fn {name, value, ty} =>
+         let
+            val (format, value) =
+               case ty of
+                  Bool => ("%s", concat [value, "? \"true\" : \"false\""])
+                | Real => ("%.20f", value)
+                | String => ("%s", value)
+                | Word => ("%u", value)
+         in
+            concat ["fprintf (stdout, \"", name, " = ", format, "\\n\", ",
+                    value, ");"]
+         end),
+        ["return 0;}"]],
        fn l => (Out.output (out, l); Out.newline out))
    end
 
@@ -128,73 +100,78 @@
    : {default: string option, name: string} * ConstType.t -> Const.t =
    let
       val table: {hash: word, name: string, value: string} HashSet.t =
-	 HashSet.new {hash = #hash}
+         HashSet.new {hash = #hash}
       fun add {name, value} =
-	 let
-	    val hash = String.hash name
-	    val _ = 
-	       HashSet.lookupOrInsert
-	       (table, hash,
-		fn {name = name', ...} => name = name',
-		fn () => {hash = hash, name = name, value = value})
-	 in
-	    ()
-	 end
+         let
+            val hash = String.hash name
+            val _ = 
+               HashSet.lookupOrInsert
+               (table, hash,
+                fn {name = name', ...} => name = name',
+                fn () => {hash = hash, name = name, value = value})
+         in
+            ()
+         end
       val () =
-	 List.foreach (buildConstants, fn (name, f) =>
-		       add {name = name, value = f ()})
+         List.foreach (buildConstants, fn (name, f) =>
+                       add {name = name, value = f ()})
       val () =
-	 List.foreach
-	 (commandLineConstants, fn {name, value} =>
-	  let
-	  in
-	     add {name = name, value = value}
-	  end)
+         List.foreach
+         (commandLineConstants, fn {name, value} =>
+          let
+          in
+             add {name = name, value = value}
+          end)
       val _ = 
-	 In.foreachLine
-	 (ins, fn l =>
-	  case String.tokens (l, Char.isSpace) of
-	     [name, "=", value] => add {name = name, value = value}
-	   | _ => Error.bug (concat ["strange constants line: ", l]))
+         In.foreachLine
+         (ins, fn l =>
+          case String.tokens (l, Char.isSpace) of
+             [name, "=", value] => add {name = name, value = value}
+           | _ => Error.bug 
+                  (concat ["LookupConstants.load: strange constants line: ", l]))
       fun lookupConstant ({default, name}, ty: ConstType.t): Const.t =
-	 let
- 	    val {value, ...} =
-	       let
-		  val hash = String.hash name
-	       in
-		  HashSet.lookupOrInsert
-		  (table, hash,
-		   fn {name = name', ...} => name = name',
-		   fn () =>
-		   case default of
-		      NONE => Error.bug (concat ["constant not found: ", name])
-		    | SOME value =>
-			 {hash = hash,
-			  name = name,
-			  value = value})
-	       end
-	    fun error (t: string) =
-	       Error.bug (concat ["constant ", name, " expects a ", t,
-				  " but got ", value, "."])
-	 in
-	    case ty of
-	       Bool =>
-		  (case Bool.fromString value of
-		      NONE => error "bool"
-		    | SOME b =>
-			 Const.Word (WordX.fromIntInf
-				     (if b then 1 else 0, WordSize.default)))
-	     | Real =>
-		  (case RealX.make (value, RealSize.default) of
-		      NONE => error "real"
-		    | SOME r => Const.Real r)
-	     | String => Const.string value
-	     | Word =>
-		  (case IntInf.fromString value of
-		      NONE => error "int"
-		    | SOME i =>
-			 Const.Word (WordX.fromIntInf (i, WordSize.default)))
-	 end
+         let
+            val {value, ...} =
+               let
+                  val hash = String.hash name
+               in
+                  HashSet.lookupOrInsert
+                  (table, hash,
+                   fn {name = name', ...} => name = name',
+                   fn () =>
+                   case default of
+                      NONE => Error.bug 
+                              (concat ["LookupConstants.load.lookupConstant: ",
+                                       "constant not found: ", 
+                                       name])
+                    | SOME value =>
+                         {hash = hash,
+                          name = name,
+                          value = value})
+               end
+            fun error (t: string) =
+               Error.bug (concat ["LookupConstants.load.lookupConstant: ",
+                                  "constant ", name, " expects a ", t,
+                                  " but got ", value, "."])
+         in
+            case ty of
+               Bool =>
+                  (case Bool.fromString value of
+                      NONE => error "bool"
+                    | SOME b =>
+                         Const.Word (WordX.fromIntInf
+                                     (if b then 1 else 0, WordSize.default)))
+             | Real =>
+                  (case RealX.make (value, RealSize.default) of
+                      NONE => error "real"
+                    | SOME r => Const.Real r)
+             | String => Const.string value
+             | Word =>
+                  (case IntInf.fromString value of
+                      NONE => error "int"
+                    | SOME i =>
+                         Const.Word (WordX.fromIntInf (i, WordSize.default)))
+         end
    in
       lookupConstant
    end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/main/lookup-constant.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/main/lookup-constant.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/main/lookup-constant.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,9 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 type word = Word.t
@@ -22,6 +22,6 @@
 
       val build: (string * ConstType.t) list * Out.t -> unit
       val load:
-	 In.t * {name: string, value: string} list
-	 -> {default: string option, name: string} * ConstType.t -> Const.t
+         In.t * {name: string, value: string} list
+         -> {default: string option, name: string} * ConstType.t -> Const.t
    end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/main/main.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/main/main.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/main/main.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,9 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 functor Main (S: MAIN_STRUCTS): MAIN =
@@ -18,24 +18,24 @@
       datatype t = CM | Files | Generated | MLB | O | OUT | SML | TypeCheck
 
       val toInt: t -> int =
-	 fn MLB => 1
-	  | CM => 1
-	  | Files => 2
-	  | SML => 3
-	  | TypeCheck => 4
-	  | Generated => 5
-	  | O => 6
-	  | OUT => 7
+         fn MLB => 1
+          | CM => 1
+          | Files => 2
+          | SML => 3
+          | TypeCheck => 4
+          | Generated => 5
+          | O => 6
+          | OUT => 7
 
       val toString =
-	 fn CM => "cm"
-	  | Files => "files"
-	  | SML => "sml"
-	  | MLB => "mlb"
-	  | Generated => "g"
-	  | O => "o"
-	  | OUT => "out"
-	  | TypeCheck => "tc"
+         fn CM => "cm"
+          | Files => "files"
+          | SML => "sml"
+          | MLB => "mlb"
+          | Generated => "g"
+          | O => "o"
+          | OUT => "out"
+          | TypeCheck => "tc"
 
       fun compare (p, p') = Int.compare (toInt p, toInt p')
    end
@@ -43,15 +43,18 @@
 structure OptPred =
    struct
       datatype t =
-	 Target of string
+         Target of string
        | Yes 
    end
 
+val asOpts: {opt: string, pred: OptPred.t} list ref = ref []
 val buildConstants: bool ref = ref false
 val ccOpts: {opt: string, pred: OptPred.t} list ref = ref []
-val cmmcOpts: string list ref = ref []
+val cmmcOpts: {opt:string, pred: OptPred.t} list ref = ref []
 val coalesce: int option ref = ref NONE
 val expert: bool ref = ref false
+val explicitAlign: Control.align option ref = ref NONE
+val explicitCodegen: Control.codegen option ref = ref NONE
 val gcc: string ref = ref "<unset>"
 val keepGenerated = ref false
 val keepO = ref false
@@ -59,70 +62,73 @@
 val linkOpts: {opt: string, pred: OptPred.t} list ref = ref []
 val output: string option ref = ref NONE
 val profileSet: bool ref = ref false
+val profileTimeSet: bool ref = ref false
 val qcmm: string ref = ref "<unset>"
 val runtimeArgs: string list ref = ref ["@MLton"]
+val showAnns: bool ref = ref false
 val stop = ref Place.OUT
 
 val targetMap: unit -> {arch: MLton.Platform.Arch.t,
-			os: MLton.Platform.OS.t,
-			target: string} list =
+                        os: MLton.Platform.OS.t,
+                        target: string} list =
    Promise.lazy
    (fn () =>
     List.map
-    (File.lines (concat [!Control.libDir, "/target-map"]), fn line =>
+    (File.lines (OS.Path.joinDirFile {dir = !Control.libDir,
+                                      file = "target-map"}),
+     fn line =>
      case String.tokens (line, Char.isSpace) of
-	[target, arch, os] =>
-	   let
-	      val arch =
-		 case MLton.Platform.Arch.fromString arch of
-		    NONE => Error.bug (concat ["strange arch: ", arch])
-		  | SOME a => a
-	      val os =
-		 case MLton.Platform.OS.fromString os of
-		    NONE => Error.bug (concat ["strange os: ", os])
-		  | SOME os => os
-	   in
-	      {arch = arch, os = os, target = target}
-	   end
+        [target, arch, os] =>
+           let
+              val arch =
+                 case MLton.Platform.Arch.fromString arch of
+                    NONE => Error.bug (concat ["strange arch: ", arch])
+                  | SOME a => a
+              val os =
+                 case MLton.Platform.OS.fromString os of
+                    NONE => Error.bug (concat ["strange os: ", os])
+                  | SOME os => os
+           in
+              {arch = arch, os = os, target = target}
+           end
       | _ => Error.bug (concat ["strange target mapping: ", line])))
 
 fun setTargetType (target: string, usage): unit =
-   case List.peek (targetMap (), fn {target = t, ...} => t = target) of
+   case List.peek (targetMap (), fn {target = t, ...} => target = t) of
       NONE => usage (concat ["invalid target: ", target])
     | SOME {arch, os, ...} =>
-	 let
-	    datatype z = datatype MLton.Platform.Arch.t
-	    open Control
-	 in
-	    targetArch := arch
-	    ; targetOS := os
-	    ; (case arch of
-		  Sparc => (align := Align8; codegen := CCodegen)
-		| X86 => codegen := Native
-		| _ => codegen := CCodegen)
-	 end
+         let 
+            open Control
+         in
+            targetArch := arch
+            ; targetOS := os
+         end
 
-fun warnDeprecated (flag, use) =
-   Out.output (Out.error,
-	       concat ["Warning: -", flag, " is deprecated.  ",
-		       "Use ", use, ".\n"])
-
-fun setConst (flag: string, name: string, value: string) =
-   (warnDeprecated (flag, concat ["-const '", name, " <value>'"])
-    ; Compile.setCommandLineConstant {name = name, value = value})
-
 fun hasNative () =
    let
       datatype z = datatype Control.arch
    in
       case !Control.targetArch of
-         X86 => true
+         AMD64 => true
+       | X86 => true
        | _ => false
    end
 
 fun makeOptions {usage} = 
    let
-      val usage = fn s => (usage s; raise Fail "unreachable")
+      val usage = fn s => (ignore (usage s); raise Fail "unreachable")
+      fun reportAnnotation (s, flag, e) =
+         case e of
+            Control.Elaborate.Bad => 
+               usage (concat ["invalid -", flag, " flag: ", s])
+          | Control.Elaborate.Deprecated ids =>
+               Out.output 
+               (Out.error,
+                concat ["Warning: ", "deprecated annotation: ", s, ".  Use ",
+                        List.toString Control.Elaborate.Id.name ids, ".\n"])
+          | Control.Elaborate.Good () => ()
+          | Control.Elaborate.Other =>
+               usage (concat ["invalid -", flag, " flag: ", s])
       open Control Popt
       fun push r = SpaceString (fn s => List.push (r, s))
       datatype z = datatype MLton.Platform.Arch.t
@@ -131,414 +137,383 @@
       (
        [
        (Normal, "align",
-	case !targetArch of
-	   Sparc => " {8|4}"
-	 | _ => " {4|8}",
-	"object alignment",
-	(SpaceString (fn s =>
-		      align
-		      := (case s of
-			     "4" => Align4
-			   | "8" => Align8
-			   | _ => usage (concat ["invalid -align flag: ",
-						 s]))))),
-       (Expert, "allow-export", " {false|true}",
-	"allow _export expression in program",
-	Bool (fn b =>
-	      (warnDeprecated ("allow-export", "-default-ann")
-	       ; Control.Elaborate.setDefault(Control.Elaborate.allowExport, b)))),
-       (Expert, "allow-import", " {false|true}",
-	"allow _import expression in program",
-	Bool (fn b =>
-	      (warnDeprecated ("allow-import", "-default-ann")
-	       ; Control.Elaborate.setDefault(Control.Elaborate.allowImport, b)))),
-       (Expert, "basis", " {2002|1997|...}",
-	"select Basis Library revision to prefix to the program",
-	SpaceString (fn s =>
-		     let
-			val () = warnDeprecated ("basis", "mlb files")
-			val s' = concat ["basis-", s]
-		     in
-			if List.contains (basisLibs, s', String.equals)
-			   then basisLibrary := s'
-			else usage (concat ["invalid -basis flag: ", s])
-		     end)),
+        case !targetArch of
+           Sparc => " {8|4}"
+         | _ => " {4|8}",
+        "object alignment",
+        (SpaceString (fn s =>
+                      explicitAlign
+                      := SOME (case s of
+                                  "4" => Align4
+                                | "8" => Align8
+                                | _ => usage (concat ["invalid -align flag: ",
+                                                      s]))))),
+       (Normal, "as-opt", " <opt>", "pass option to assembler",
+        SpaceString (fn s =>
+                     List.push (asOpts, {opt = s, pred = OptPred.Yes}))),
        (Expert, "build-constants", " {false|true}",
-	"output C file that prints basis constants",
-	boolRef buildConstants),
-       (Expert, "card-size-log2", " <n>",
-	"log (base 2) of card size used by GC",
-	intRef cardSizeLog2),
+        "output C file that prints basis constants",
+        boolRef buildConstants),
        (Expert, "cc", " <gcc>", "path to gcc executable",
-	SpaceString (fn s => gcc := s)),
+        SpaceString (fn s => gcc := s)),
        (Normal, "cc-opt", " <opt>", "pass option to C compiler",
-	SpaceString (fn s =>
-		     List.push (ccOpts, {opt = s, pred = OptPred.Yes}))),
+        SpaceString (fn s =>
+                     List.push (ccOpts, {opt = s, pred = OptPred.Yes}))),
        (Expert, "cmm-debug", " {false|true}", "debug C-- codegen",
-	boolRef Cmm.debug),
+        boolRef Cmm.debug),
        (Expert, "cmm-non-tail", " {cutTo|cutToNR|return}", 
-	"how to implement non-tail transfers",
-	SpaceString (fn s =>
-		     case s of
-		        "cutTo" => Cmm.nonTail := Cmm.CutTo {neverReturns = false}
-		      | "cutToNR" => Cmm.nonTail := Cmm.CutTo {neverReturns = true}
-		      | "return" => Cmm.nonTail := Cmm.Return
-		      | _ => usage (concat ["invalid -cmm-non-tail flag: ", s]))),
+        "how to implement non-tail transfers",
+        SpaceString (fn s =>
+                     case s of
+                        "cutTo" => Cmm.nonTail := Cmm.CutTo {neverReturns = false}
+                      | "cutToNR" => Cmm.nonTail := Cmm.CutTo {neverReturns = true}
+                      | "return" => Cmm.nonTail := Cmm.Return
+                      | _ => usage (concat ["invalid -cmm-non-tail flag: ", s]))),
        (Expert, "cmmc", " <qc-->", "path to qc-- executable",
-	SpaceString (fn s => qcmm := s)),
+        SpaceString (fn s => qcmm := s)),
        (Normal, "cmmc-opt", " <opt>", "pass option to C-- compiler",
-	SpaceString (fn s => List.push (cmmcOpts, s))),
+        SpaceString (fn s =>
+                     List.push (cmmcOpts, {opt = s, pred = OptPred.Yes}))),
        (Expert, "coalesce", " <n>", "coalesce chunk size for C codegen",
-	Int (fn n => coalesce := SOME n)),
+        Int (fn n => coalesce := SOME n)),
        (Normal, "codegen",
-	concat [" {", if hasNative () then "native|" else "", "bytecode|c}"],
-	"which code generator to use",
-	SpaceString (fn s =>
-		     case s of
-			"bytecode" => codegen := Bytecode
-		      | "c" => codegen := CCodegen
-		      | "cmm" => codegen := CmmCodegen
-		      | "native" => codegen := Native
-		      | _ => usage (concat ["invalid -codegen flag: ", s]))),
+        concat [" {", if hasNative () then "native|" else "", "bytecode|c}"],
+        "which code generator to use",
+        SpaceString (fn s =>
+                     explicitCodegen
+                     := SOME (case s of
+                                 "bytecode" => Bytecode
+                               | "c" => CCodegen
+                               | "cmm" => CmmCodegen
+                               | "native" => Native
+                               | _ => usage (concat
+                                             ["invalid -codegen flag: ", s])))),
        (Normal, "const", " '<name> <value>'", "set compile-time constant",
-	SpaceString (fn s =>
-		     case String.tokens (s, Char.isSpace) of
-			[name, value] =>
-			   Compile.setCommandLineConstant {name = name,
-							   value = value}
-		      | _ => usage (concat ["invalid -const flag: ", s]))),
+        SpaceString (fn s =>
+                     case String.tokens (s, Char.isSpace) of
+                        [name, value] =>
+                           Compile.setCommandLineConstant {name = name,
+                                                           value = value}
+                      | _ => usage (concat ["invalid -const flag: ", s]))),
        (Expert, "contify-into-main", " {false|true}",
-	"contify functions into main",
-	boolRef contifyIntoMain),
-       (Expert, "dead-code", " {true|false}",
-	"annotated dead code elimination",
-	Bool (fn b =>
-	      (warnDeprecated ("dead-code", "-default-ann")
-	       ; ignore (Control.Elaborate.setEnabled 
-			 (Control.Elaborate.deadCode, b))))),
+        "contify functions into main",
+        boolRef contifyIntoMain),
        (Expert, "debug", " {false|true}", "produce executable with debug info",
-	boolRef debug),
-       (Expert, "deep-flatten-delay", " {true|false}",
-	"delay coercions during deepFlatten",
-	boolRef deepFlattenDelay),
-       (Expert, "deep-flatten-unify", " {false|true}",
-	"unify (instead of coerce) during deepFlatten",
-	boolRef deepFlattenUnify),
-       (Normal, "default-ann", " <ann>", "set annotation default for mlb files",
-	SpaceString 
-	(fn s =>
-	 if Control.Elaborate.processDefault s
-	    then ()
-	    else usage (concat ["invalid -default-ann flag: ", s]))),
-       (Expert, "detect-overflow", " {true|false}",
-	"overflow checking on integer arithmetic",
-	Bool (fn b => setConst ("detect-overflow",
-				"MLton.detectOverflow",
-				Bool.toString b))),
+        boolRef debug),
+       let
+          val flag = "default-ann"
+       in
+          (Normal, flag, " <ann>", "set annotation default for mlb files",
+           SpaceString
+           (fn s => reportAnnotation (s, flag,
+                                      Control.Elaborate.processDefault s)))
+       end,
        (Expert, "diag-pass", " <pass>", "keep diagnostic info for pass",
-	SpaceString 
-	(fn s =>
-	 (case Regexp.fromString s of
-	     SOME (re,_) => let val re = Regexp.compileDFA re
-			    in 
-			       List.push (diagPasses, re)
-			       ; List.push (keepPasses, re)
-			    end
-	   | NONE => usage (concat ["invalid -diag-pass flag: ", s])))),
-       (Normal, "disable-ann", " <ann>", "disable annotation in mlb files",
-	SpaceString 
-	(fn s =>
-	 if Control.Elaborate.processEnabled (s, false)
-	    then ()
-	    else usage (concat ["invalid -disable-ann flag: ", s]))),
+        SpaceString 
+        (fn s =>
+         (case Regexp.fromString s of
+             SOME (re,_) => let val re = Regexp.compileDFA re
+                            in 
+                               List.push (diagPasses, re)
+                               ; List.push (keepPasses, re)
+                            end
+           | NONE => usage (concat ["invalid -diag-pass flag: ", s])))),
+       let
+          val flag = "disable-ann"
+       in
+          (Normal, flag, " <ann>", "disable annotation in mlb files",
+           SpaceString 
+           (fn s =>
+            reportAnnotation (s, flag,
+                              Control.Elaborate.processEnabled (s, false))))
+       end,
        (Expert, "drop-pass", " <pass>", "omit optimization pass",
-	SpaceString
-	(fn s => (case Regexp.fromString s of
-		     SOME (re,_) => let val re = Regexp.compileDFA re
-				    in List.push (dropPasses, re)
-				    end
-		   | NONE => usage (concat ["invalid -drop-pass flag: ", s])))),
-       (Expert, "eliminate-overflow", " {true|false}",
-	"eliminate useless overflow tests",
-	boolRef eliminateOverflow),
-       (Expert, "enable-ann", " <ann>", "globally enable annotation",
-	SpaceString 
-	(fn s =>
-	 if Control.Elaborate.processEnabled (s, true)
-	    then ()
-	    else usage (concat ["invalid -enable-ann flag: ", s]))),
+        SpaceString
+        (fn s => (case Regexp.fromString s of
+                     SOME (re,_) => let val re = Regexp.compileDFA re
+                                    in List.push (dropPasses, re)
+                                    end
+                   | NONE => usage (concat ["invalid -drop-pass flag: ", s])))),
+       let
+          val flag = "enable-ann"
+       in
+          (Expert, flag, " <ann>", "globally enable annotation",
+           SpaceString 
+           (fn s =>
+            reportAnnotation (s, flag,
+                              Control.Elaborate.processEnabled (s, true))))
+       end,
        (Expert, "error-threshhold", " 20", "error threshhold",
-	intRef errorThreshhold),
+        intRef errorThreshhold),
        (Expert, "expert", " {false|true}", "enable expert status",
-	boolRef expert),
+        boolRef expert),
        (Normal, "export-header", " <file>", "write C header file for _export's",
-	SpaceString (fn s => exportHeader := SOME s)),
+        SpaceString (fn s => exportHeader := SOME s)),
        (Expert, "gc-check", " {limit|first|every}", "force GCs",
-	SpaceString (fn s =>
-		     gcCheck :=
-		     (case s of
-			 "limit" => Limit
-		       | "first" => First
-		       | "every" => Every
-		       | _ => usage (concat ["invalid -gc-check flag: ", s])))),
-       (Expert, "handlers", " {flow|simple}",
-	"how to implement handlers",
-	SpaceString (fn s =>
-		     case s of
-			"flow" => handlers := Flow
-		      | "simple" => handlers := Simple
-		      | _ => usage (concat ["invalid -handlers flag: ", s]))),
+        SpaceString (fn s =>
+                     gcCheck :=
+                     (case s of
+                         "limit" => Limit
+                       | "first" => First
+                       | "every" => Every
+                       | _ => usage (concat ["invalid -gc-check flag: ", s])))),
        (Normal, "ieee-fp", " {false|true}", "use strict IEEE floating-point",
-	boolRef Native.IEEEFP),
+        boolRef Native.IEEEFP),
        (Expert, "indentation", " <n>", "indentation level in ILs",
-	intRef indentation),
+        intRef indentation),
        (Normal, "inline", " <n>", "set inlining threshold", Int setInlineSize),
        (Expert, "inline-into-main", " {true|false}",
-	"inline functions into main",
-	boolRef inlineIntoMain),
+        "inline functions into main",
+        boolRef inlineIntoMain),
        (Normal, "keep", " {g|o|sml}", "save intermediate files",
-	SpaceString (fn s =>
-		     case s of
-			"dot" => keepDot := true
-		      | "g" => keepGenerated := true
-		      | "machine" => keepMachine := true
-		      | "o" => keepO := true
-		      | "sml" => keepSML := true
-		      | "rssa" => keepRSSA := true
-		      | "ssa" => keepSSA := true
-		      | "ssa2" => keepSSA2 := true
-		      | _ => usage (concat ["invalid -keep flag: ", s]))),
+        SpaceString (fn s =>
+                     case s of
+                        "dot" => keepDot := true
+                      | "g" => keepGenerated := true
+                      | "machine" => keepMachine := true
+                      | "o" => keepO := true
+                      | "sml" => keepSML := true
+                      | "rssa" => keepRSSA := true
+                      | "ssa" => keepSSA := true
+                      | "ssa2" => keepSSA2 := true
+                      | _ => usage (concat ["invalid -keep flag: ", s]))),
        (Expert, "keep-pass", " <pass>", "keep the results of pass",
-	SpaceString
-	(fn s => (case Regexp.fromString s of
-		     SOME (re,_) => let val re = Regexp.compileDFA re
-				    in List.push (keepPasses, re)
-				    end
-		   | NONE => usage (concat ["invalid -keep-pass flag: ", s])))),
-       (Expert, "limit-check", " {lhle|pb|ebb|lh|lhf|lhfle}",
-	"limit check insertion algorithm",
-	SpaceString (fn s =>
-		     case s of
-		        "pb" => limitCheck := PerBlock
-		      | "ebb" => limitCheck := ExtBasicBlocks
-		      | "lh" => limitCheck := LoopHeaders {fullCFG = false,
-							   loopExits = false}
-		      | "lhf" => limitCheck := LoopHeaders {fullCFG = true,
-							    loopExits = false}
-		      | "lhle" => limitCheck := LoopHeaders {fullCFG = false,
-							     loopExits = true}
-		      | "lhfle" => limitCheck := LoopHeaders {fullCFG = true,
-							      loopExits = true}
-		      | _ => usage (concat ["invalid -limit-check flag: ", s]))),
-       (Expert, "limit-check-counts", " {false|true}",
-	"compute dynamic counts of limit checks",
-	boolRef limitCheckCounts),
+        SpaceString
+        (fn s => (case Regexp.fromString s of
+                     SOME (re,_) => let val re = Regexp.compileDFA re
+                                    in List.push (keepPasses, re)
+                                    end
+                   | NONE => usage (concat ["invalid -keep-pass flag: ", s])))),
        (Normal, "link-opt", " <opt>", "pass option to linker",
-	SpaceString (fn s =>
-		     List.push (linkOpts, {opt = s, pred = OptPred.Yes}))),
+        SpaceString (fn s =>
+                     List.push (linkOpts, {opt = s, pred = OptPred.Yes}))),
        (Expert, "loop-passes", " <n>", "loop optimization passes (1)",
-	Int 
-	(fn i => 
-	 if i >= 1
-	    then loopPasses := i
-	    else usage (concat ["invalid -loop-passes arg: ", Int.toString i]))),
+        Int 
+        (fn i => 
+         if i >= 1
+            then loopPasses := i
+            else usage (concat ["invalid -loop-passes arg: ", Int.toString i]))),
        (Expert, "mark-cards", " {true|false}", "mutator marks cards",
-	boolRef markCards),
+        boolRef markCards),
        (Expert, "max-function-size", " <n>", "max function size (blocks)",
-	intRef maxFunctionSize),
-       (Expert, "native", if hasNative () then " {true|false}" else " {false}",
-	"use native code generator",
-	Bool (fn b =>
-	      (warnDeprecated ("native", "-codegen")
-	       ; Control.codegen := (if b then Native else CCodegen)))),
+        intRef maxFunctionSize),
+       (Normal, "mlb-path-map", " <file>", "additional MLB path map",
+        SpaceString (fn s => mlbPathMaps := !mlbPathMaps @ [s])),
        (Expert, "native-commented", " <n>", "level of comments  (0)",
-	intRef Native.commented),
+        intRef Native.commented),
        (Expert, "native-copy-prop", " {true|false}", 
-	"use copy propagation",
-	boolRef Native.copyProp),
+        "use copy propagation",
+        boolRef Native.copyProp),
        (Expert, "native-cutoff", " <n>", 
-	"live transfer cutoff distance",
-	intRef Native.cutoff),
+        "live transfer cutoff distance",
+        intRef Native.cutoff),
        (Expert, "native-live-transfer", " {0,...,8}",
-	"use live transfer",
-	intRef Native.liveTransfer),
+        "use live transfer",
+        intRef Native.liveTransfer),
        (Expert, "native-live-stack", " {false|true}",
-	"track liveness of stack slots",
-	boolRef Native.liveStack),
+        "track liveness of stack slots",
+        boolRef Native.liveStack),
        (Expert, "native-move-hoist", " {true|false}",
-	"use move hoisting",
-	boolRef Native.moveHoist),
+        "use move hoisting",
+        boolRef Native.moveHoist),
        (Expert, "native-optimize", " <n>", "level of optimizations",
         intRef Native.optimize),
        (Expert, "native-split", " <n>", "split assembly files at ~n lines",
-	Int (fn i => Native.split := SOME i)),
+        Int (fn i => Native.split := SOME i)),
        (Expert, "native-shuffle", " {true|false}",
-	"shuffle registers at C-calls",
-	Bool (fn b => Native.shuffle := b)),
-       (Expert, "new-return", " {false|true}", "non-tail call return convention",
-	boolRef newReturn),
+        "shuffle registers at C-calls",
+        Bool (fn b => Native.shuffle := b)),
+       (Expert, "opt-passes", " {default|minimal}", "level of optimizations",
+        SpaceString (fn s =>
+                     let
+                        fun err s =
+                           usage (concat ["invalid -opt-passes flag: ", s])
+                        fun doit optPasses =
+                           List.foreach
+                           (!optimizationPassesSet, fn (_,optPassesSet) =>
+                            case optPassesSet optPasses of
+                               Result.Yes () => ()
+                             | Result.No s' => err ("il :: " ^ s')) 
+                     in
+                        case s of
+                           "default" => doit OptPassesDefault
+                         | "minimal" => doit OptPassesMinimal
+                         | _ => err s
+                     end)),
        (Normal, "output", " <file>", "name of output file",
-	SpaceString (fn s => output := SOME s)),
+        SpaceString (fn s => output := SOME s)),
        (Expert, "polyvariance", " {true|false}", "use polyvariance",
-	Bool (fn b => if b then () else polyvariance := NONE)),
+        Bool (fn b => if b then () else polyvariance := NONE)),
        (Expert, "prof-pass", " <pass>", "keep profile info for pass",
-	SpaceString (fn s =>
-		     (case Regexp.fromString s of
-			 SOME (re,_) => let val re = Regexp.compileDFA re
-					in 
-					   List.push (profPasses, re)
-					end
-		       | NONE => usage (concat ["invalid -diag-pass flag: ", s])))),
+        SpaceString (fn s =>
+                     (case Regexp.fromString s of
+                         SOME (re,_) => let val re = Regexp.compileDFA re
+                                        in 
+                                           List.push (profPasses, re)
+                                        end
+                       | NONE => usage (concat ["invalid -diag-pass flag: ", s])))),
        (Normal, "profile", " {no|alloc|count|time}",
-	"produce executable suitable for profiling",
-	SpaceString
-	(fn s =>
-	 if !profileSet
-	    then usage "can't have multiple -profile switches"
-	 else
-	    (profileSet := true
-	     ; profile := (case s of
-			      "no" => ProfileNone
-			    | "alloc" => ProfileAlloc
-			    | "call" => ProfileCallStack
-			    | "count" => ProfileCount
-			    | "mark" => ProfileMark
-			    | "time" => ProfileTime
-			    | _ => usage (concat
-					  ["invalid -profile arg: ", s]))))),
-       (Expert, "profile-basis", " {false|true}",
-	"profile the basis implementation",
-	boolRef profileBasis),
+        "produce executable suitable for profiling",
+        SpaceString
+        (fn s =>
+         if !profileSet
+            then usage "can't have multiple -profile switches"
+         else
+            (profileSet := true
+             ; profile := (case s of
+                              "no" => ProfileNone
+                            | "alloc" => ProfileAlloc
+                            | "call" => ProfileCallStack
+                            | "count" => ProfileCount
+                            | "drop" => ProfileDrop
+                            | "label" => ProfileLabel
+                            | "time" => (profileTimeSet := true
+                                         ; ProfileTimeLabel)
+                            | "time-field" => ProfileTimeField
+                            | "time-label" => ProfileTimeLabel
+                            | _ => usage (concat
+                                          ["invalid -profile arg: ", s]))))),
        (Normal, "profile-branch", " {false|true}",
-	"profile branches in addition to functions",
-	boolRef profileBranch),
+        "profile branches in addition to functions",
+        boolRef profileBranch),
+       (Expert, "profile-c", " <regexp>", 
+        "include C-calls in files matching <regexp> in profile",
+        SpaceString
+        (fn s =>
+         (case Regexp.fromString s of
+             SOME (re,_) => let
+                               open Regexp
+                               val re = seq [anys, re, anys]
+                               val re = compileDFA re
+                            in List.push (profileC, re)
+                            end
+           | NONE => usage (concat ["invalid -profile-c flag: ", s])))),
+       (Expert, "profile-exclude", " <regexp>", 
+        "exclude files matching <regexp> from profile",
+        SpaceString
+        (fn s =>
+         (case Regexp.fromString s of
+             SOME (re,_) => let
+                               open Regexp
+                               val re = seq [anys, re, anys]
+                               val re = compileDFA re
+                            in List.push (profileInclExcl, (re, false))
+                            end
+           | NONE => usage (concat ["invalid -profile-exclude flag: ", s])))),
        (Expert, "profile-il", " {source}", "where to insert profile exps",
-	SpaceString
-	(fn s =>
-	 case s of
-	    "source" => profileIL := ProfileSource
-	  | "ssa" => profileIL := ProfileSSA
-	  | "ssa2" => profileIL := ProfileSSA2
-	  | _ => usage (concat ["invalid -profile-il arg: ", s]))),
+        SpaceString
+        (fn s =>
+         case s of
+            "source" => profileIL := ProfileSource
+          | "ssa" => profileIL := ProfileSSA
+          | "ssa2" => profileIL := ProfileSSA2
+          | _ => usage (concat ["invalid -profile-il arg: ", s]))),
+       (Expert, "profile-include", " <regexp>", 
+        "include files matching <regexp> from profile",
+        SpaceString
+        (fn s =>
+         (case Regexp.fromString s of
+             SOME (re,_) => let
+                               open Regexp
+                               val re = seq [anys, re, anys]
+                               val re = compileDFA re
+                            in List.push (profileInclExcl, (re, true))
+                            end
+           | NONE => usage (concat ["invalid -profile-include flag: ", s])))),
+       (Expert, "profile-raise", " {false|true}",
+        "profile raises in addition to functions",
+        boolRef profileRaise),
        (Normal, "profile-stack", " {false|true}", "profile the stack",
-	boolRef profileStack),
-       (Expert, "reserve-esp", " {false|true}", "reserve %ESP on x86",
-	SpaceString
-	(fn s =>
-	 case Bool.fromString s of
-	    NONE => usage (concat ["invalid -reserve-esp arg: ", s])
-	  | SOME b => reserveEsp := SOME b)),
+        boolRef profileStack),
        (Normal, "runtime", " <arg>", "pass arg to runtime via @MLton",
-	push runtimeArgs),
-       (Expert, "safe", " {true|false}", "bounds checking and other checks",
-	Bool (fn b => setConst ("safe", "MLton.safe", Bool.toString b))),
-       (Expert, "sequence-unit", " {false|true}",
-	"in (e1; e2), require e1: unit",
-	Bool (fn b =>
-	      (warnDeprecated ("sequence-unit", "-default-ann")
-	       ; Control.Elaborate.setDefault(Control.Elaborate.sequenceUnit, b)))),
+        push runtimeArgs),
+       (Expert, "show-anns", " {false|true}", "show annotations",
+        boolRef showAnns),
        (Normal, "show-basis", " <file>", "write out the final basis environment",
-	SpaceString (fn s => showBasis := SOME s)),
+        SpaceString (fn s => showBasis := SOME s)),
        (Normal, "show-def-use", " <file>", "write def-use information",
-	SpaceString (fn s => showDefUse := SOME s)),
+        SpaceString (fn s => showDefUse := SOME s)),
        (Expert, "show-types", " {false|true}", "show types in ILs",
-	boolRef showTypes),
+        boolRef showTypes),
        (Expert, "ssa-passes", " <passes>", "ssa optimization passes",
-	SpaceString
-	(fn s =>
-	 case !Control.ssaPassesSet s of
-	    Result.Yes ss => Control.ssaPasses := ss
-	  | Result.No s' => usage (concat ["invalid -ssa-pass arg: ", s']))),
+        SpaceString
+        (fn s =>
+         case !Control.ssaPassesSet (OptPassesCustom s) of
+            Result.Yes () => ()
+          | Result.No s' => usage (concat ["invalid -ssa-pass arg: ", s']))),
        (Expert, "ssa2-passes", " <passes>", "ssa2 optimization passes",
-	SpaceString
-	(fn s =>
-	 case !Control.ssa2PassesSet s of
-	    Result.Yes ss => Control.ssa2Passes := ss
-	  | Result.No s' => usage (concat ["invalid -ssa2-pass arg: ", s']))),
-       (Expert, "stack-cont", " {false|true}",
-	"force continuation formals to stack",
-	boolRef stackCont),
-       (Normal, "stop", " {f|g|o|sml|tc}", "where to stop",
-	SpaceString
-	(fn s =>
-	 stop := (case s of
-		     "f" => Place.Files
-		   | "g" => Place.Generated	
-		   | "o" => Place.O
-		   | "sml" => Place.SML
-		   | "tc" => Place.TypeCheck
-		   | _ => usage (concat ["invalid -stop arg: ", s])))),
+        SpaceString
+        (fn s =>
+         case !Control.ssa2PassesSet (OptPassesCustom s) of
+            Result.Yes () => ()
+          | Result.No s' => usage (concat ["invalid -ssa2-pass arg: ", s']))),
+       (Normal, "stop", " {f|g|o|sml|tc}", "when to stop",
+        SpaceString
+        (fn s =>
+         stop := (case s of
+                     "f" => Place.Files
+                   | "g" => Place.Generated     
+                   | "o" => Place.O
+                   | "sml" => Place.SML
+                   | "tc" => Place.TypeCheck
+                   | _ => usage (concat ["invalid -stop arg: ", s])))),
        (Expert, "sxml-passes", " <passes>", "sxml optimization passes",
-	SpaceString
-	(fn s =>
-	 case !Control.sxmlPassesSet s of
-	    Result.Yes ss => Control.sxmlPasses := ss
-	  | Result.No s' => usage (concat ["invalid -sxml-pass arg: ", s']))),
+        SpaceString
+        (fn s =>
+         case !Control.sxmlPassesSet (OptPassesCustom s) of
+            Result.Yes () => ()
+          | Result.No s' => usage (concat ["invalid -sxml-pass arg: ", s']))),
        (Normal, "target",
-	concat [" {",
-		(case targetMap () of
-		    [] => ""
-		  | [x] => #target x
-		  | x :: _ => concat [#target x, "|..."]),
-		"}"],
-	"platform that executable will run on",
-	SpaceString (fn s =>
-		     (setTargetType (s, usage)
-		      ; target := (if s = "self" then Self else Cross s)))),
-       (Expert, "target-cc-opt", " <target> <opt>", "target-dependent CC option",
-	(SpaceString2
-	 (fn (target, opt) =>
-	  List.push (ccOpts, {opt = opt, pred = OptPred.Target target})))),
-       (Normal, "target-link-opt", " <os> <opt>",
-	"target-dependent link option",
-	(SpaceString2
-	 (fn (target, opt) =>
-	  List.push (linkOpts, {opt = opt, pred = OptPred.Target target})))),
+        concat [" {",
+                (case targetMap () of
+                    [] => ""
+                  | [x] => #target x
+                  | x :: _ => concat [#target x, "|..."]),
+                "}"],
+        "platform that executable will run on",
+        SpaceString
+        (fn t =>
+         (target := (if t = "self" then Self else Cross t);
+          setTargetType (t, usage)))),
+       (Normal, "target-as-opt", " <target> <opt>", "target-dependent assembler option",
+        (SpaceString2
+         (fn (target, opt) =>
+          List.push (asOpts, {opt = opt, pred = OptPred.Target target})))),
+       (Normal, "target-cc-opt", " <target> <opt>", "target-dependent C compiler option",
+        (SpaceString2
+         (fn (target, opt) =>
+          List.push (ccOpts, {opt = opt, pred = OptPred.Target target})))),
+       (Normal, "target-cmmc-opt", " <target> <opt>", "target-dependent C-- compiler option",
+        (SpaceString2
+         (fn (target, opt) =>
+          List.push (cmmcOpts, {opt = opt, pred = OptPred.Target target})))),
+       (Normal, "target-link-opt", " <target> <opt>", "target-dependent linker option",
+        (SpaceString2
+         (fn (target, opt) =>
+          List.push (linkOpts, {opt = opt, pred = OptPred.Target target})))),
        (Expert, #1 trace, " name1,...", "trace compiler internals", #2 trace),
-       (Expert, "text-io-buf-size", " <n>", "TextIO buffer size",
-	Int (fn i => setConst ("text-io-buf-size",
-			       "TextIO.bufSize",
-			       Int.toString i))),
        (Expert, "type-check", " {false|true}", "type check ILs",
-	boolRef typeCheck),
-       (Expert, "type-error", " {concise|full}", "type error verbosity",
-	SpaceString
-	(fn s =>
-	 typeError := (case s of
-			  "concise" => Concise
-			| "full" => Full
-			| _ => usage (concat
-				      ["invalid -type-error arg: ", s])))),
+        boolRef typeCheck),
        (Normal, "verbose", " {0|1|2|3}", "how verbose to be",
-	SpaceString
-	(fn s =>
-	 verbosity := (case s of
-			  "0" => Silent
-			| "1" => Top
-			| "2" => Pass
-			| "3" =>  Detail
-			| _ => usage (concat ["invalid -verbose arg: ", s])))),
+        SpaceString
+        (fn s =>
+         verbosity := (case s of
+                          "0" => Silent
+                        | "1" => Top
+                        | "2" => Pass
+                        | "3" => Detail
+                        | _ => usage (concat ["invalid -verbose arg: ", s])))),
        (Expert, "warn-ann", " {true|false}",
-	"unrecognized annotation warnings",
-	boolRef warnAnn),
-       (Expert, "warn-match", " {true|false}",
-	"nonexhaustive and redundant match warnings",
-	Bool (fn b =>
-	      (warnDeprecated ("warn-match", "-default-ann")
-	       ; Control.Elaborate.setDefault(Control.Elaborate.warnMatch, b)))),
-       (Expert, "warn-unused", " {false|true}",
-	"unused identifier warnings",
-	Bool (fn b =>
-	      (warnDeprecated ("warn-unused", "-default-ann")
-	       ; Control.Elaborate.setDefault(Control.Elaborate.warnUnused, b)))),
+        "unrecognized annotation warnings",
+        boolRef warnAnn),
        (Expert, "xml-passes", " <passes>", "xml optimization passes",
-	SpaceString
-	(fn s =>
-	 case !Control.xmlPassesSet s of
-	    Result.Yes ss => Control.xmlPasses := ss
-	  | Result.No s' => usage (concat ["invalid -xml-pass arg: ", s']))),
+        SpaceString
+        (fn s =>
+         case !Control.xmlPassesSet (OptPassesCustom s) of
+            Result.Yes () => ()
+          | Result.No s' => usage (concat ["invalid -xml-pass arg: ", s']))),
        (Expert, "zone-cut-depth", " <n>", "zone cut depth",
-	intRef zoneCutDepth)
+        intRef zoneCutDepth)
        ],
        fn (style, name, arg, desc, opt) =>
        {arg = arg, desc = desc, name = name, opt = opt, style = style})
@@ -549,8 +524,8 @@
 
 val {parse, usage} =
    Popt.makeUsage {mainUsage = mainUsage,
-		   makeOptions = makeOptions,
-		   showExpert = fn () => !expert}
+                   makeOptions = makeOptions,
+                   showExpert = fn () => !expert}
 
 val usage = fn s => (usage s; raise Fail "unreachable")
    
@@ -558,579 +533,586 @@
    let
       open Control
       val args =
-	 case args of
-	    lib :: args =>
-	       (libDir := lib
-		; args)
-	  | _ => Error.bug "incorrect args from shell script"
-      val _ = setTargetType ("self", usage)
+         case args of
+            lib :: args =>
+               (libDir := OS.Path.mkCanonical lib
+                ; args)
+          | _ => Error.bug "incorrect args from shell script"
+      val () = setTargetType ("self", usage)
       val result = parse args
+      val targetArch = !targetArch
+      val () =
+         align := (case !explicitAlign of
+                      NONE => (case targetArch of
+                                  Sparc => Align8
+                                | HPPA => Align8
+                                | _ => Align4)
+                    | SOME a => a)
+      val () =
+         codegen := (case !explicitCodegen of
+                        NONE => if hasNative () then Native else CCodegen
+                      | SOME c => c)
+      val () = MLton.Rusage.measureGC (!verbosity <> Silent)
+      val () =
+         if !showAnns then
+            (Layout.outputl (Control.Elaborate.document {expert = !expert}, 
+                             Out.standard)
+             ; let open OS.Process in exit success end)
+         else ()
+      val () = if !profileTimeSet
+                  then (case !codegen of
+                           Native => profile := ProfileTimeLabel
+                         | _ => profile := ProfileTimeField)
+                  else ()
       val () = if !exnHistory
-		  then (case !profile of
-			   ProfileNone => profile := ProfileCallStack
-			 | ProfileCallStack => ()
-			 | _ => usage "can't use -profile with Exn.keepHistory")
-	       else ()
+                  then (case !profile of
+                           ProfileNone => profile := ProfileCallStack
+                         | ProfileCallStack => ()
+                         | _ => usage "can't use -profile with Exn.keepHistory"
+                        ; profileRaise := true)
+               else ()
       val () =
-	 Compile.setCommandLineConstant
-	 {name = "CallStack.keep",
-	  value = Bool.toString (!Control.profile = Control.ProfileCallStack)}
+         Compile.setCommandLineConstant
+         {name = "CallStack.keep",
+          value = Bool.toString (!Control.profile = Control.ProfileCallStack)}
       val gcc = !gcc
       val qcmm = !qcmm
       val stop = !stop
       val target = !target
       val targetStr =
-	 case target of
-	    Cross s => s
-	  | Self => "self"
-      val _ = libTargetDir := concat [!libDir, "/", targetStr]
-      val targetArch = !targetArch
+         case target of
+            Cross s => s
+          | Self => "self"
+      val _ = libTargetDir := OS.Path.concat (!libDir, targetStr)
       val archStr = String.toLower (MLton.Platform.Arch.toString targetArch)
       val targetOS = !targetOS
       val () =
-	 Control.labelsHaveExtra_ := (case targetOS of
-					 Cygwin => true
-				       | MinGW => true
-				       | _ => false)
+         Control.labelsHaveExtra_ := (case targetOS of
+                                         Cygwin => true
+                                       | MinGW => true
+                                       | _ => false)
       val OSStr = String.toLower (MLton.Platform.OS.toString targetOS)
       fun tokenize l =
-	 String.tokens (concat (List.separate (l, " ")), Char.isSpace)
+         String.tokens (concat (List.separate (l, " ")), Char.isSpace)
       fun addTargetOpts opts =
-	 tokenize
-	 (List.fold
-	  (!opts, [], fn ({opt, pred}, ac) =>
-	   if (case pred of
-		  OptPred.Target s =>
-		     let
-			val s = String.toLower s
-		     in
-			s = archStr orelse s = OSStr
-		     end
-		| OptPred.Yes => true)
-	      then opt :: ac
-	   else ac))
+         tokenize
+         (List.fold
+          (!opts, [], fn ({opt, pred}, ac) =>
+           if (case pred of
+                  OptPred.Target s =>
+                     let
+                        val s = String.toLower s
+                     in
+                        s = archStr orelse s = OSStr
+                     end
+                | OptPred.Yes => true)
+              then opt :: ac
+           else ac))
+      val asOpts = addTargetOpts asOpts
       val ccOpts = addTargetOpts ccOpts
-      val cmmcOpts = !cmmcOpts
+      val cmmcOpts = addTargetOpts cmmcOpts
       val linkOpts =
-	 List.concat [[concat ["-L", !libTargetDir],
-		       if !debug then "-lmlton-gdb" else "-lmlton"] @
-		      (if !codegen = CmmCodegen then ["-lqc--"] else []),
-		      addTargetOpts linkOpts]
+         List.concat [[concat ["-L", !libTargetDir]],
+                      if !debug then ["-lmlton-gdb"] else ["-lmlton"],
+                      if !codegen = CmmCodegen then ["-lqc--"] else [],
+                      addTargetOpts linkOpts]
       (* With gcc 3.4, the '-b <arch>' must be the first argument. *)
       val targetOpts =
-	 case target of
-	    Cross s =>
-	       if Cygwin = MLton.Platform.OS.host
-		  andalso String.hasSubstring (s, {substring = "mingw"})
-		  then ["-mno-cygwin"]
-	       else ["-b", s]
-	  | Self => []
+         case target of
+            Cross s =>
+               if Cygwin = MLton.Platform.OS.host
+                  andalso String.hasSubstring (s, {substring = "mingw"})
+                  then ["-mno-cygwin"]
+               else ["-b", s]
+          | Self => []
       val _ =
-	 if !codegen = Native andalso not (hasNative ())
-	    then usage (concat ["can't use native codegen on ",
-				MLton.Platform.Arch.toString targetArch])
-	 else ()
+         if !codegen = Native andalso not (hasNative ())
+            then usage (concat ["can't use native codegen on ",
+                                MLton.Platform.Arch.toString targetArch])
+         else ()
       val _ =
-	 chunk :=
-	 (case !codegen of
-	     Bytecode => OneChunk
-	   | CCodegen => Coalesce {limit = (case !coalesce of
-					       NONE => 4096
-					     | SOME n => n)}
-	   | CmmCodegen =>
-		if isSome (!coalesce)
-		   then usage "can't use -coalesce and -codegen cmm"
-		else ChunkPerFunc
-	   | Native =>
-		if isSome (!coalesce)
-		   then usage "can't use -coalesce and -codegen native"
-		else ChunkPerFunc)
+         chunk :=
+         (case !codegen of
+             Bytecode => OneChunk
+           | CCodegen => Coalesce {limit = (case !coalesce of
+                                               NONE => 4096
+                                             | SOME n => n)}
+           | CmmCodegen =>
+                if isSome (!coalesce)
+                   then usage "can't use -coalesce and -codegen cmm"
+                else ChunkPerFunc
+           | Native =>
+                if isSome (!coalesce)
+                   then usage "can't use -coalesce and -codegen native"
+                else ChunkPerFunc)
       val _ = if not (!Control.codegen = Native) andalso !Native.IEEEFP
-		 then usage "must use native codegen with -ieee-fp true"
-	      else ()
+                 then usage "must use native codegen with -ieee-fp true"
+              else ()
       val _ =
-	 if !keepDot andalso List.isEmpty (!keepPasses)
-	    then keepSSA := true
-	 else ()
+         if !keepDot andalso List.isEmpty (!keepPasses)
+            then keepSSA := true
+         else ()
       val keepDefUse = 
-	 isSome (!showDefUse)
-	 orelse (Control.Elaborate.enabled Control.Elaborate.warnUnused)
-	 orelse (Control.Elaborate.default Control.Elaborate.warnUnused)
+         isSome (!showDefUse)
+         orelse (Control.Elaborate.enabled Control.Elaborate.warnUnused)
+         orelse (Control.Elaborate.default Control.Elaborate.warnUnused)
       val warnMatch =
-	 (Control.Elaborate.enabled Control.Elaborate.warnMatch)
-	 orelse (Control.Elaborate.default Control.Elaborate.warnMatch)
+          (Control.Elaborate.enabled Control.Elaborate.nonexhaustiveMatch)
+          orelse (Control.Elaborate.enabled Control.Elaborate.redundantMatch)
+          orelse (Control.Elaborate.default Control.Elaborate.nonexhaustiveMatch <>
+                  Control.Elaborate.DiagEIW.Ignore)
+          orelse (Control.Elaborate.default Control.Elaborate.redundantMatch <>
+                  Control.Elaborate.DiagEIW.Ignore)
       val _ = elaborateOnly := (stop = Place.TypeCheck
-				andalso not (warnMatch)
-				andalso not (keepDefUse))
+                                andalso not (warnMatch)
+                                andalso not (keepDefUse))
       val _ =
-	 if !codegen = Bytecode andalso !profile <> ProfileNone
-	    then usage (concat ["bytecode doesn't support profiling\n"])
-	 else ()
+         if !codegen = Bytecode andalso !profile <> ProfileNone
+            then usage (concat ["bytecode doesn't support profiling\n"])
+         else ()
       val _ =
-	 case targetOS of
-	    Darwin => ()
-	  | FreeBSD => ()
-	  | Linux => ()
-	  | NetBSD => ()
-	  | OpenBSD => ()
-	  | Solaris => ()
-	  | _ =>
-	       if !profile = ProfileTime
-		  then usage (concat ["can't use -profile time on ",
-				      MLton.Platform.OS.toString targetOS])
-	       else ()
+         case targetOS of
+            Darwin => ()
+          | FreeBSD => ()
+          | Linux => ()
+          | NetBSD => ()
+          | OpenBSD => ()
+          | Solaris => ()
+          | _ =>
+               if !profile = ProfileTimeField 
+                  orelse !profile = ProfileTimeLabel
+                  then usage (concat ["can't use -profile time on ",
+                                      MLton.Platform.OS.toString targetOS])
+               else ()
       fun printVersion (out: Out.t): unit =
-	 Out.output (out, concat [version, " ", build, "\n"])
+         Out.output (out, concat [version, " ", build, "\n"])
    in
       case result of
       Result.No msg => usage msg
     | Result.Yes [] =>
-	 (inputFile := "<none>"
-	  ; if isSome (!showBasis)
-	       then (trace (Top, "Type Check SML")
-		     Compile.elaborateSML {input = []})
-	    else if !buildConstants
+         (inputFile := "<none>"
+          ; if isSome (!showBasis)
+               then (trace (Top, "Type Check SML")
+                     Compile.elaborateSML {input = []})
+            else if !buildConstants
                then Compile.outputBasisConstants Out.standard
-	    else if !verbosity = Silent orelse !verbosity = Top
+            else if !verbosity = Silent orelse !verbosity = Top
                then printVersion Out.standard
-	    else outputHeader' (No, Out.standard))
+            else outputHeader' (No, Out.standard))
     | Result.Yes (input :: rest) =>
-	 let
-	    val _ = inputFile := File.base (File.fileOf input)
-	    val (start, base) =
-	       let
-		  val rec loop =
-		     fn [] => usage (concat ["invalid file suffix on ", input])
-		      | (suf, start, hasNum) :: sufs =>
-			   if String.hasSuffix (input, {suffix = suf})
-			      then (start,
-				    let
-				       val f = File.base input
-				    in
-				       if hasNum
-					  then File.base f
-				       else f
-				    end)
-			   else loop sufs
-		  datatype z = datatype Place.t
-	       in
-		  loop [(".mlb", MLB, false),
-			(".cm", CM, false),
-			(".sml", SML, false),
-			(".c", Generated, true),
-			(".o", O, true)]
-	       end
-	    val _ =
-	       List.foreach
-	       (rest, fn f =>
-		if List.exists ([".c", ".cmm", ".o", ".s", ".S"], fn suffix =>
-				String.hasSuffix (f, {suffix = suffix}))
-		   then File.withIn (f, fn _ => ())
-		else usage (concat ["invalid file suffix: ", f]))
-	    val csoFiles = rest
-	 in
-	    case Place.compare (start, stop) of
-	       GREATER => usage (concat ["cannot go from ", Place.toString start,
-					 " to ", Place.toString stop])
-	     | EQUAL => usage "nothing to do"
-	     | LESS =>
-		  let
-		     val _ =
-			if !verbosity = Top
-			   then printVersion Out.error
-			else ()
-		     val tempFiles: File.t list ref = ref []
-		     val tmpDir =
-			let
-			   val (tmpVar, default) =
-			      case MLton.Platform.OS.host of
-				 MinGW => ("TEMP", "C:/WINNT/TEMP")
-			       | _ => ("TMPDIR", "/tmp")
-			in
-			   case Process.getEnv tmpVar of
-			      NONE => default
-			    | SOME d => d
-			end
-		     fun temp (suf: string): File.t =
-			let
-			   val (f, out) =
-			      File.temp {prefix = concat [tmpDir, "/file"],
-					 suffix = suf}
-			   val _ = Out.close out
-			   val _ = List.push (tempFiles, f)
-			in
-			   f
-			end
-		     fun suffix s = concat [base, s]
-		     fun maybeOut suf =
-			case !output of
-			   NONE => suffix suf
-			 | SOME f => f
-		     val _ =
-			atMLtons :=
-			Vector.fromList
-			(maybeOut "" :: tokenize (rev ("--" :: (!runtimeArgs))))
-		     datatype debugFormat =
-			Dwarf | DwarfPlus | Dwarf2 | Stabs | StabsPlus
-		     (* The -Wa,--gstabs says to pass the --gstabs option to the
-		      * assembler. This tells the assembler to generate stabs
-		      * debugging information for each assembler line.
-		      *)
-		     val debugFormat = StabsPlus
-		     val (gccDebug, asDebug) =
-			case debugFormat of
-			   Dwarf => (["-gdwarf", "-g2"], "-Wa,--gdwarf2")
-			 | DwarfPlus => (["-gdwarf+", "-g2"], "-Wa,--gdwarf2")
-			 | Dwarf2 => (["-gdwarf-2", "-g2"], "-Wa,--gdwarf2")
-			 | Stabs => (["-gstabs", "-g2"], "-Wa,--gstabs")
-			 | StabsPlus => (["-gstabs+", "-g2"], "-Wa,--gstabs")
-		     val qcmmDebug = []
-		     fun compileO (inputs: File.t list): unit =
-			let
-			   val output = maybeOut ""
-			   val _ =
-			      trace (Top, "Link")
-			      (fn () =>
-			       System.system
-			       (gcc,
-				List.concat
-				[targetOpts, 
-				 ["-std=c99"],
-				 ["-o", output],
-				 if !debug then gccDebug else [],
-				 if !codegen = CmmCodegen
-				    then inputs @
-				         [concat [!Control.libTargetDir, "/pcmap.ld"]]
-				    else inputs,
-				 linkOpts]))
-			      ()
-			   (* gcc on Cygwin appends .exe, which I don't want, so
-			    * move the output file to it's rightful place.
-			    * Notice that we do not use targetOS here, since we
-			    * care about the platform we're running on, not the
-			    * platform we're generating for.
-			    *
-			    * We want to keep the .exe as is for MinGW/Win32.
-			    *)
-			   val _ =
-			      if MLton.Platform.OS.host = Cygwin
-				 then
-				    if String.contains (output, #".")
-				       then ()
-				    else
-				       File.move {from = concat [output, ".exe"],
-						  to = output}
-			      else ()
-			in
-			   ()
-			end
-		  fun compileC (c: Counter.t, input: File.t): File.t =
-		     let
-			val (debugSwitches, switches) =
-			   (gccDebug @ ["-DASSERT=1"], ccOpts)
-			val switches =
-			   if !debug
-			      then debugSwitches @ switches
-			      else switches
-			val switches =
-			   targetOpts @ ("-std=c99" :: "-c" :: switches)
-			val output =
-			   if stop = Place.O orelse !keepO
-			      then
-				 if !keepGenerated 
-				    orelse start = Place.Generated
-				    then
-				       concat [File.base input,
-					       ".o"]
-				    else 
-				       suffix
-				       (concat [".",
-						Int.toString
-						(Counter.next c),
-						".o"])
-			      else temp ".o"
-			val _ =
-			   System.system
-			   (gcc,
-			    List.concat [switches,
-					 ["-o", output, input]])
-		     in
-			output
-		     end
-		  local val qcmmGlobals = ref true in
-		  fun compileCmm (c: Counter.t, input: File.t): File.t =
-		     let
-			val switches = cmmcOpts
-			val switches =
-			   if !qcmmGlobals
-			      then (qcmmGlobals := false
-				    ; "-globals" :: switches)
-			      else switches
-			val switches =
-			   "-c" :: switches
-			val output =
-			   if stop = Place.O orelse !keepO
-			      then
-				 if !keepGenerated 
-				    orelse start = Place.Generated
-				    then
-				       concat [File.base input,
-					       ".o"]
-				    else 
-				       suffix
-				       (concat [".",
-						Int.toString
-						(Counter.next c),
-						".o"])
-			      else temp ".o"
-			val _ =
-			   System.system
-			   (qcmm,
-			    List.concat [switches,
-					 ["-o", output, input]])
-		     in
-			output
-		     end
-		  end
-		  fun compileS (c: Counter.t, input: File.t): File.t =
-		     let
-			val (debugSwitches, switches) =
-			   ([asDebug], [])
-			val switches =
-			   if !debug
-			      then debugSwitches @ switches
-			      else switches
-			val switches =
-			   targetOpts @ ("-std=c99" :: "-c" :: switches)
-			val output =
-			   if stop = Place.O orelse !keepO
-			      then
-				 if !keepGenerated 
-				    orelse start = Place.Generated
-				    then
-				       concat [File.base input,
-					       ".o"]
-				    else 
-				       suffix
-				       (concat [".",
-						Int.toString
-						(Counter.next c),
-						".o"])
-			      else temp ".o"
-			val _ =
-			   System.system
-			   (gcc,
-			    List.concat [switches,
-					 ["-o", output, input]])
-		     in
-			output
-		     end
-		  fun compileCSO (inputs: File.t list): unit =
-		     if List.forall (inputs, fn f =>
-				     SOME "o" = File.extension f)
-			then compileO inputs
-		     else
-		     let
-			val c = Counter.new 0
-			val oFiles =
-			   trace (Top, "Compile and Assemble")
-			   (fn () =>
-			    List.fold
-			    (inputs, [], fn (input, ac) =>
-			     let
-				val extension = File.extension input
-			     in
-				if SOME "o" = extension
-				   then input :: ac
-				else if SOME "c" = extension
-				   then (compileC (c, input)) :: ac
-				else if SOME "cmm" = extension
-				   then (compileCmm (c, input)) :: ac
-				else if SOME "s" = extension 
-				        orelse SOME "S" = extension
-				   then (compileS (c, input)) :: ac
-				else Error.bug 
-				     (concat
-				      ["invalid extension: ",
-				       Option.toString (fn s => s) extension])
-			     end))
-			   ()
-		     in
-			case stop of
-			   Place.O => ()
-			 | _ => compileO (rev oFiles)
-		     end
-		  fun compileSml (files: File.t list) =
-		     let
-			val outputs: File.t list ref = ref []
-			val r = ref 0
-			fun make (style: style, suf: string) () =
-			   let
-			      val suf = concat [".", Int.toString (!r), suf]
-			      val _ = Int.inc r
-			      val file = (if !keepGenerated
-					     orelse stop = Place.Generated
-					     then suffix
-					  else temp) suf
-			      val _ = List.push (outputs, file)
-			      val out = Out.openOut file
-			      fun print s = Out.output (out, s)
-			      val _ = outputHeader' (style, out)
-			      fun done () = Out.close out
-			   in
-			      {file = file,
-			       print = print,
-			       done = done}
-			   end
-			val _ =
-			   case !verbosity of
-			      Silent => ()
-			    | Top => ()
-			    | _ => 
-				 outputHeader
-				 (Control.No, fn l =>
-				  let val out = Out.error
-				  in Layout.output (l, out)
-				     ; Out.newline out
-				  end)
-			val _ =
-			   case stop of
-			      Place.TypeCheck =>
-				 trace (Top, "Type Check SML")
-				 Compile.elaborateSML {input = files}
-			    | _ => 
-				 trace (Top, "Compile SML")
-				 Compile.compileSML
-				 {input = files,
-				  outputC = make (Control.C, ".c"),
-				  outputCmm = make (Control.C, ".cmm"),
-				  outputS = make (Control.Assembly,
-						  if !debug then ".s" else ".S")}
-		     in
-			case stop of
-			   Place.Generated => ()
-			 | Place.TypeCheck => ()
-			 | _ =>
-			      (* Shrink the heap before calling gcc. *)
-			      (MLton.GC.pack ()
-			       ; compileCSO (List.concat [!outputs, csoFiles]))
-		     end
-		  fun compileCM input =
-		     let
-			val files = CM.cm {cmfile = input}
-			fun saveSML smlFile =
-			   File.withOut
-			   (smlFile, fn out =>
-			    (outputHeader' (ML, out)
-			     ; (List.foreach
-				(files, fn f =>
-				 (Out.output
-				  (out, concat ["(*#line 0.0 \"", f, "\"*)\n"])
-				  ; File.outputContents (f, out))))))
-		     in
-			case stop of
-			   Place.Files =>
-			      List.foreach
-			      (files, fn f => print (concat [f, "\n"]))
-			 | Place.SML => saveSML (maybeOut ".sml")
-			 | _ =>
-			      (if !keepSML
-				  then saveSML (suffix ".sml")
-			       else ()
-			       ; compileSml files)
-		     end
-		  fun compileMLB file =
-		     let
-			val outputs: File.t list ref = ref []
-			val r = ref 0
-			fun make (style: style, suf: string) () =
-			   let
-			      val suf = concat [".", Int.toString (!r), suf]
-			      val _ = Int.inc r
-			      val file = (if !keepGenerated
-					     orelse stop = Place.Generated
-					     then suffix
-					  else temp) suf
-			      val _ = List.push (outputs, file)
-			      val out = Out.openOut file
-			      fun print s = Out.output (out, s)
-			      val _ = outputHeader' (style, out)
-			      fun done () = Out.close out
-			   in
-			      {file = file,
-			       print = print,
-			       done = done}
-			   end
-			val _ =
-			   case !verbosity of
-			      Silent => ()
-			    | Top => ()
-			    | _ => 
-				 outputHeader
-				 (Control.No, fn l =>
-				  let val out = Out.error
-				  in Layout.output (l, out)
-				     ; Out.newline out
-				  end)
-			fun saveSML smlFile =
-			   File.withOut
-			   (smlFile, fn out =>
-			    (outputHeader' (ML, out)
-			     ; (Vector.foreach
-				(Compile.sourceFilesMLB {input = file}, fn f =>
-				 (Out.output
-				  (out, concat ["(*#line 0.0 \"", f, "\"*)\n"])
-				  ; File.outputContents (f, out))))))
-			val _ =
-			   case stop of
-			      Place.Files =>
-				 Vector.foreach
-				 (Compile.sourceFilesMLB {input = file}, fn f => 
-				  print (concat [f, "\n"]))
-			    | Place.SML => saveSML (maybeOut ".sml")
-			    | Place.TypeCheck =>
-				 trace (Top, "Type Check SML")
-				 Compile.elaborateMLB {input = file}
-			    | _ => 
-				 trace (Top, "Compile SML")
-				 Compile.compileMLB
-				 {input = file,
-				  outputC = make (Control.C, ".c"),
-				  outputCmm = make (Control.C, ".cmm"),
-				  outputS = make (Control.Assembly,
-						  if !debug then ".s" else ".S")}
-		     in
-			case stop of
-			   Place.Files => ()
-			 | Place.SML => ()
-			 | Place.TypeCheck => ()
-			 | Place.Generated => ()
-			 | _ =>
-			      (* Shrink the heap before calling gcc. *)
-			      (MLton.GC.pack ()
-			       ; compileCSO (List.concat [!outputs, csoFiles]))
-		     end
-		  fun compile () =
-		     case start of
-			Place.CM => compileCM input
-		      | Place.SML =>
-			   Control.checkFile
-			   (input, fn s => raise Fail s,
-			    fn () => compileSml [input])
-		      | Place.MLB => compileMLB input
-		      | Place.Generated => compileCSO (input :: csoFiles)
-		      | Place.O => compileCSO (input :: csoFiles)
-		      | _ => Error.bug "invalid start"
-		  val doit 
-		    = trace (Top, "MLton")
-		      (fn () => 
-		       DynamicWind.wind
-		       (compile, fn () =>
-			List.foreach (!tempFiles, File.remove)))
-	       in
-		  doit ()
-	       end
-	 end
+         let
+            val _ = inputFile := File.base (File.fileOf input)
+            val (start, base) =
+               let
+                  val rec loop =
+                     fn [] => usage (concat ["invalid file suffix on ", input])
+                      | (suf, start, hasNum) :: sufs =>
+                           if String.hasSuffix (input, {suffix = suf})
+                              then (start,
+                                    let
+                                       val f = File.base input
+                                    in
+                                       if hasNum
+                                          then File.base f
+                                       else f
+                                    end)
+                           else loop sufs
+                  datatype z = datatype Place.t
+               in
+                  loop [(".mlb", MLB, false),
+                        (".cm", CM, false),
+                        (".sml", SML, false),
+                        (".c", Generated, true),
+                        (".o", O, true)]
+               end
+            val _ =
+               List.foreach
+               (rest, fn f =>
+                if List.exists ([".c", ".cmm", ".o", ".s", ".S"], fn suffix =>
+                                String.hasSuffix (f, {suffix = suffix}))
+                   then File.withIn (f, fn _ => ())
+                else usage (concat ["invalid file suffix: ", f]))
+            val csoFiles = rest
+         in
+            case Place.compare (start, stop) of
+               GREATER => usage (concat ["cannot go from ", Place.toString start,
+                                         " to ", Place.toString stop])
+             | EQUAL => usage "nothing to do"
+             | LESS =>
+                  let
+                     val _ =
+                        if !verbosity = Top
+                           then printVersion Out.error
+                        else ()
+                     val tempFiles: File.t list ref = ref []
+                     val tmpDir =
+                        let
+                           val (tmpVar, default) =
+                              case MLton.Platform.OS.host of
+                                 MinGW => ("TEMP", "C:/WINDOWS/TEMP")
+                               | _ => ("TMPDIR", "/tmp")
+                        in
+                           case Process.getEnv tmpVar of
+                              NONE => default
+                            | SOME d => d
+                        end
+                     fun temp (suf: string): File.t =
+                        let
+                           val (f, out) =
+                              File.temp {prefix = OS.Path.concat (tmpDir, "file"),
+                                         suffix = suf}
+                           val _ = Out.close out
+                           val _ = List.push (tempFiles, f)
+                        in
+                           f
+                        end
+                     fun suffix s = concat [base, s]
+                     fun maybeOut suf =
+                        case !output of
+                           NONE => suffix suf
+                         | SOME f => f
+                     val _ =
+                        atMLtons :=
+                        Vector.fromList
+                        (maybeOut "" :: tokenize (rev ("--" :: (!runtimeArgs))))
+                     datatype debugFormat =
+                        Dwarf | DwarfPlus | Dwarf2 | Stabs | StabsPlus
+                     (* The -Wa,--gstabs says to pass the --gstabs option to the
+                      * assembler. This tells the assembler to generate stabs
+                      * debugging information for each assembler line.
+                      *)
+                     val debugFormat = StabsPlus
+                     val (gccDebug, asDebug) =
+                        case debugFormat of
+                           Dwarf => (["-gdwarf", "-g2"], "-Wa,--gdwarf2")
+                         | DwarfPlus => (["-gdwarf+", "-g2"], "-Wa,--gdwarf2")
+                         | Dwarf2 => (["-gdwarf-2", "-g2"], "-Wa,--gdwarf2")
+                         | Stabs => (["-gstabs", "-g2"], "-Wa,--gstabs")
+                         | StabsPlus => (["-gstabs+", "-g2"], "-Wa,--gstabs")
+                     val qcmmDebug = []
+                     fun compileO (inputs: File.t list): unit =
+                        let
+                           val output = maybeOut ""
+                           val _ =
+                              trace (Top, "Link")
+                              (fn () =>
+                               System.system
+                               (gcc,
+                                List.concat
+                                [targetOpts, 
+                                 ["-o", output],
+                                 if !debug then gccDebug else [],
+                                 inputs, 
+                                 if !codegen = CmmCodegen
+                                    then [concat [!Control.libTargetDir, "/pcmap.ld"]]
+                                    else [],
+                                 linkOpts]))
+                              ()
+                           (* gcc on Cygwin appends .exe, which I don't want, so
+                            * move the output file to it's rightful place.
+                            * Notice that we do not use targetOS here, since we
+                            * care about the platform we're running on, not the
+                            * platform we're generating for.
+                            *
+                            * We want to keep the .exe as is for MinGW/Win32.
+                            *)
+                           val _ =
+                              if MLton.Platform.OS.host = Cygwin
+                                 then
+                                    if String.contains (output, #".")
+                                       then ()
+                                    else
+                                       File.move {from = concat [output, ".exe"],
+                                                  to = output}
+                              else ()
+                        in
+                           ()
+                        end
+                  fun mkOutputO (c: Counter.t, input: File.t): File.t =
+                     if stop = Place.O orelse !keepO
+                        then
+                           if !keepGenerated 
+                              orelse start = Place.Generated
+                              then
+                                 concat [File.base input,
+                                         ".o"]
+                              else 
+                                 suffix
+                                 (concat [".",
+                                          Int.toString
+                                          (Counter.next c),
+                                          ".o"])
+                        else temp ".o"
+                  fun compileC (c: Counter.t, input: File.t): File.t =
+                     let
+                        val (debugSwitches, switches) =
+                           (gccDebug @ ["-DASSERT=1"], ccOpts)
+                        val switches =
+                           if !debug
+                              then debugSwitches @ switches
+                              else switches
+                        val switches =
+                           targetOpts @ ("-std=gnu99" :: "-c" :: switches)
+                        val output = mkOutputO (c, input)
+                        val _ =
+                           System.system
+                           (gcc,
+                            List.concat [switches,
+                                         ["-o", output, input]])
+                     in
+                        output
+                     end
+                  local val qcmmGlobals = ref true in
+                  fun compileCmm (c: Counter.t, input: File.t): File.t =
+                     let
+                        val switches = cmmcOpts
+                        val switches =
+                           if !qcmmGlobals
+                              then (qcmmGlobals := false
+                                    ; "-globals" :: switches)
+                              else switches
+                        val switches =
+                           "-c" :: switches
+                        val output = mkOutputO (c, input)
+                        val _ =
+                           System.system
+                           (qcmm,
+                            List.concat [switches,
+                                         ["-o", output, input]])
+                     in
+                        output
+                     end
+                  end
+                  fun compileS (c: Counter.t, input: File.t): File.t =
+                     let
+                        val (debugSwitches, switches) =
+                           ([asDebug], asOpts)
+                        val switches =
+                           if !debug
+                              then debugSwitches @ switches
+                              else switches
+                        val switches =
+                           targetOpts @ ("-c" :: switches)
+                        val output = mkOutputO (c, input)
+                        val _ =
+                           System.system
+                           (gcc,
+                            List.concat [switches,
+                                         ["-o", output, input]])
+                     in
+                        output
+                     end
+                  fun compileCSO (inputs: File.t list): unit =
+                     if List.forall (inputs, fn f =>
+                                     SOME "o" = File.extension f)
+                        then compileO inputs
+                     else
+                     let
+                        val c = Counter.new 0
+                        val oFiles =
+                           trace (Top, "Compile and Assemble")
+                           (fn () =>
+                            List.fold
+                            (inputs, [], fn (input, ac) =>
+                             let
+                                val extension = File.extension input
+                             in
+                                if SOME "o" = extension
+                                   then input :: ac
+                                else if SOME "c" = extension
+                                   then (compileC (c, input)) :: ac
+                                else if SOME "cmm" = extension
+                                   then (compileCmm (c, input)) :: ac
+                                else if SOME "s" = extension 
+                                        orelse SOME "S" = extension
+                                   then (compileS (c, input)) :: ac
+                                else Error.bug 
+                                     (concat
+                                      ["invalid extension: ",
+                                       Option.toString (fn s => s) extension])
+                             end))
+                           ()
+                     in
+                        case stop of
+                           Place.O => ()
+                         | _ => compileO (rev oFiles)
+                     end
+                  fun compileSml (files: File.t list) =
+                     let
+                        val outputs: File.t list ref = ref []
+                        val r = ref 0
+                        fun make (style: style, suf: string) () =
+                           let
+                              val suf = concat [".", Int.toString (!r), suf]
+                              val _ = Int.inc r
+                              val file = (if !keepGenerated
+                                             orelse stop = Place.Generated
+                                             then suffix
+                                          else temp) suf
+                              val _ = List.push (outputs, file)
+                              val out = Out.openOut file
+                              fun print s = Out.output (out, s)
+                              val _ = outputHeader' (style, out)
+                              fun done () = Out.close out
+                           in
+                              {file = file,
+                               print = print,
+                               done = done}
+                           end
+                        val _ =
+                           case !verbosity of
+                              Silent => ()
+                            | Top => ()
+                            | _ => 
+                                 outputHeader
+                                 (Control.No, fn l =>
+                                  let val out = Out.error
+                                  in Layout.output (l, out)
+                                     ; Out.newline out
+                                  end)
+                        val _ =
+                           case stop of
+                              Place.TypeCheck =>
+                                 trace (Top, "Type Check SML")
+                                 Compile.elaborateSML {input = files}
+                            | _ => 
+                                 trace (Top, "Compile SML")
+                                 Compile.compileSML
+                                 {input = files,
+                                  outputC = make (Control.C, ".c"),
+                                  outputCmm = make (Control.C, ".cmm"),
+                                  outputS = make (Control.Assembly,
+                                                  if !debug then ".s" else ".S")}
+                     in
+                        case stop of
+                           Place.Generated => ()
+                         | Place.TypeCheck => ()
+                         | _ =>
+                              (* Shrink the heap before calling gcc. *)
+                              (MLton.GC.pack ()
+                               ; compileCSO (List.concat [!outputs, csoFiles]))
+                     end
+                  fun showFiles (fs: File.t vector) =
+                     Vector.foreach
+                     (fs, fn f =>
+                      print (concat [String.translate
+                                     (f, fn #"\\" => "/"
+                                          | c => str c),
+                                     "\n"]))
+                  fun compileCM input =
+                     let
+                        val files = CM.cm {cmfile = input}
+                        fun saveSML smlFile =
+                           File.withOut
+                           (smlFile, fn out =>
+                            (outputHeader' (ML, out)
+                             ; (List.foreach
+                                (files, fn f =>
+                                 (Out.output
+                                  (out, concat ["(*#line 0.0 \"", f, "\"*)\n"])
+                                  ; File.outputContents (f, out))))))
+                     in
+                        case stop of
+                           Place.Files =>
+                              showFiles (Vector.fromList files)
+                         | Place.SML => saveSML (maybeOut ".sml")
+                         | _ =>
+                              (if !keepSML
+                                  then saveSML (suffix ".sml")
+                               else ()
+                               ; compileSml files)
+                     end
+                  fun compileMLB file =
+                     let
+                        val outputs: File.t list ref = ref []
+                        val r = ref 0
+                        fun make (style: style, suf: string) () =
+                           let
+                              val suf = concat [".", Int.toString (!r), suf]
+                              val _ = Int.inc r
+                              val file = (if !keepGenerated
+                                             orelse stop = Place.Generated
+                                             then suffix
+                                          else temp) suf
+                              val _ = List.push (outputs, file)
+                              val out = Out.openOut file
+                              fun print s = Out.output (out, s)
+                              val _ = outputHeader' (style, out)
+                              fun done () = Out.close out
+                           in
+                              {file = file,
+                               print = print,
+                               done = done}
+                           end
+                        val _ =
+                           case !verbosity of
+                              Silent => ()
+                            | Top => ()
+                            | _ => 
+                                 outputHeader
+                                 (Control.No, fn l =>
+                                  let val out = Out.error
+                                  in Layout.output (l, out)
+                                     ; Out.newline out
+                                  end)
+                        fun saveSML smlFile =
+                           File.withOut
+                           (smlFile, fn out =>
+                            (outputHeader' (ML, out)
+                             ; (Vector.foreach
+                                (Compile.sourceFilesMLB {input = file}, fn f =>
+                                 (Out.output
+                                  (out, concat ["(*#line 0.0 \"", f, "\"*)\n"])
+                                  ; File.outputContents (f, out))))))
+                        val _ =
+                           case stop of
+                              Place.Files =>
+                                 showFiles
+                                 (Compile.sourceFilesMLB {input = file})
+                            | Place.SML => saveSML (maybeOut ".sml")
+                            | Place.TypeCheck =>
+                                 trace (Top, "Type Check SML")
+                                 Compile.elaborateMLB {input = file}
+                            | _ => 
+                                 trace (Top, "Compile SML")
+                                 Compile.compileMLB
+                                 {input = file,
+                                  outputC = make (Control.C, ".c"),
+                                  outputCmm = make (Control.C, ".cmm"),
+                                  outputS = make (Control.Assembly,
+                                                  if !debug then ".s" else ".S")}
+                     in
+                        case stop of
+                           Place.Files => ()
+                         | Place.SML => ()
+                         | Place.TypeCheck => ()
+                         | Place.Generated => ()
+                         | _ =>
+                              (* Shrink the heap before calling gcc. *)
+                              (MLton.GC.pack ()
+                               ; compileCSO (List.concat [!outputs, csoFiles]))
+                     end
+                  fun compile () =
+                     case start of
+                        Place.CM => compileCM input
+                      | Place.SML =>
+                           Control.checkFile
+                           (input, fn s => raise Fail s,
+                            fn () => compileSml [input])
+                      | Place.MLB => compileMLB input
+                      | Place.Generated => compileCSO (input :: csoFiles)
+                      | Place.O => compileCSO (input :: csoFiles)
+                      | _ => Error.bug "invalid start"
+                  val doit 
+                    = trace (Top, "MLton")
+                      (fn () => 
+                       Exn.finally
+                       (compile, fn () =>
+                        List.foreach (!tempFiles, File.remove)))
+               in
+                  doit ()
+               end
+         end
    end
 
 val commandLine = Process.makeCommandLine commandLine
@@ -1141,7 +1123,7 @@
 fun exportMLton (): unit =
    case CommandLine.arguments () of
       [worldFile] =>
-	 SMLofNJ.exportFn (worldFile, fn (_, args) => commandLine args)
+         SMLofNJ.exportFn (worldFile, fn (_, args) => commandLine args)
     | _ => Error.bug "usage: exportMLton worldFile"
 
 end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/main/main.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/main/main.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/main/main.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,9 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 type int = Int.t
@@ -15,7 +15,7 @@
 signature MAIN =
    sig
       include MAIN_STRUCTS
-	 
+         
       val commandLine: string list -> OS.Process.status
       val exportMLton: unit -> unit
       val exportNJ: File.t -> unit

Modified: mlton/branches/on-20050420-cmm-branch/mlton/main/main.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/main/main.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/main/main.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,11 @@
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 structure Main = Main ()
 
 val _ =

Modified: mlton/branches/on-20050420-cmm-branch/mlton/main/sources.cm
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/main/sources.cm	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/main/sources.cm	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 Group
 
 structure Char

Modified: mlton/branches/on-20050420-cmm-branch/mlton/main/sources.mlb
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/main/sources.mlb	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/main/sources.mlb	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,33 +1,34 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 local
-    ../../lib/mlton/sources.mlb
-    ../ast/sources.mlb
-    ../atoms/sources.mlb
-    ../backend/sources.mlb
-    ../closure-convert/sources.mlb
-    ../cm/sources.mlb
-    ../codegen/sources.mlb
-    ../control/sources.mlb
-    ../core-ml/sources.mlb
-    ../defunctorize/sources.mlb
-    ../elaborate/sources.mlb
-    ../front-end/sources.mlb
-    ../ssa/sources.mlb
-    ../xml/sources.mlb
+   ../../lib/mlton/sources.mlb
+   ../ast/sources.mlb
+   ../atoms/sources.mlb
+   ../backend/sources.mlb
+   ../closure-convert/sources.mlb
+   ../cm/sources.mlb
+   ../codegen/sources.mlb
+   ../control/sources.mlb
+   ../core-ml/sources.mlb
+   ../defunctorize/sources.mlb
+   ../elaborate/sources.mlb
+   ../front-end/sources.mlb
+   ../ssa/sources.mlb
+   ../xml/sources.mlb
 
-    lookup-constant.sig
-    lookup-constant.fun
-    compile.sig
-    compile.fun
-    main.sig
-    main.fun
-    main.sml
+   lookup-constant.sig
+   lookup-constant.fun
+   compile.sig
+   compile.fun
+   main.sig
+   main.fun
+   main.sml
 in
-    structure Main
-end
\ No newline at end of file
+   structure Main
+end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/match-compile/match-compile.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/match-compile/match-compile.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/match-compile/match-compile.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,9 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 functor MatchCompile (S: MATCH_COMPILE_STRUCTS): MATCH_COMPILE =
@@ -18,191 +18,196 @@
 
    fun conApp (c, p) =
       let
-	 val c = Con.layout c
+         val c = Con.layout c
       in
-	 case p of
-	    NONE => c
-	  | SOME p => paren (seq [c, str " ", p])
+         case p of
+            NONE => c
+          | SOME p => paren (seq [c, str " ", p])
       end
 end
 
 structure Env = MonoEnv (structure Domain = Var
-			 structure Range = Var)
+                         structure Range = Var)
 
 structure Fact =
    struct
       datatype t =
-	 Con of {arg: Var.t option,
-		 con: Con.t}
+         Con of {arg: Var.t option,
+                 con: Con.t}
        | Tuple of Var.t vector
 
       fun layout (f: t): Layout.t =
-	 let
-	    open Layout
-	 in
-	    case f of
-	       Con {arg, con} =>
-		  seq [Con.layout con,
-		       case arg of
-			  NONE => empty
-			| SOME x => seq [str " ", Var.layout x]]
-	     | Tuple xs => tuple (Vector.toListMap (xs, Var.layout))
-	 end
+         let
+            open Layout
+         in
+            case f of
+               Con {arg, con} =>
+                  seq [Con.layout con,
+                       case arg of
+                          NONE => empty
+                        | SOME x => seq [str " ", Var.layout x]]
+             | Tuple xs => tuple (Vector.toListMap (xs, Var.layout))
+         end
    end
 
 structure Examples =
    struct
-      datatype t = T of (Var.t * Layout.t) list
+      datatype t = T of {es: (Var.t * Layout.t) list,
+                         isOnlyExns: bool}
 
-      fun layout (T l) = List.layout (Layout.tuple2 (Var.layout, fn l => l)) l
+      fun layout (T {es, ...}) =
+         List.layout (Layout.tuple2 (Var.layout, fn l => l)) es
 
-      val empty = T []
-	 
-      fun add (T es, x, l) = T ((x, l) :: es)
+      val empty = T {es = [], isOnlyExns = true}
+         
+      fun add (T {es, isOnlyExns = is}, x, l, {isOnlyExns: bool}) =
+         T {es = (x, l) :: es,
+            isOnlyExns = is andalso isOnlyExns}
    end
 
 structure Facts =
    struct
       datatype t = T of {fact: Fact.t,
-			 var: Var.t} list
+                         var: Var.t} list
 
       fun layout (T fs) =
-	 let
-	    open Layout
-	 in
-	    List.layout (fn {fact, var} =>
-			 seq [Var.layout var, str " = ", Fact.layout fact])
-	    fs
-	 end
+         let
+            open Layout
+         in
+            List.layout (fn {fact, var} =>
+                         seq [Var.layout var, str " = ", Fact.layout fact])
+            fs
+         end
 
       val empty: t = T []
 
       fun add (T fs, x, f) = T ({fact = f, var = x} :: fs)
 
       fun bind (T facts, x: Var.t, p: NestedPat.t): Env.t =
-	 let
-	    val {destroy, get = fact: Var.t -> Fact.t, set = setFact, ...} =
-	       Property.destGetSetOnce
-	       (Var.plist, Property.initRaise ("fact", Var.layout))
-	    val () = List.foreach (facts, fn {fact, var} => setFact (var, fact))
-	    fun loop (p: NestedPat.t, x: Var.t, env: Env.t): Env.t =
-	       let
-		  datatype z = datatype NestedPat.node
-	       in
-		  case NestedPat.node p of
-		     Con {arg, ...} =>
-			(case arg of
-			    NONE => env
-			  | SOME p => 
-			       (case fact x of
-				   Fact.Con {arg = SOME x, ...} =>
-				      loop (p, x, env)
-				 | _ => Error.bug "wrong fact"))
-		   | Const _ => env
-		   | Layered (y, p) => loop (p, x, Env.extend (env, y, x))
-		   | Tuple ps =>
-			if 0 = Vector.length ps
-			   then env
-			else (case fact x of
-				 Fact.Tuple xs =>
-				    Vector.fold2 (ps, xs, env, loop)
-			       | _ => Error.bug "wrong fact")
-		   | Var y => Env.extend (env, y, x)
-		   | Wild => env
-	       end
-	    val env = loop (p, x, Env.empty)
-	    val () = destroy ()
-	 in
-	    env
-	 end
+         let
+            val {destroy, get = fact: Var.t -> Fact.t, set = setFact, ...} =
+               Property.destGetSetOnce
+               (Var.plist, Property.initRaise ("fact", Var.layout))
+            val () = List.foreach (facts, fn {fact, var} => setFact (var, fact))
+            fun loop (p: NestedPat.t, x: Var.t, env: Env.t): Env.t =
+               let
+                  datatype z = datatype NestedPat.node
+               in
+                  case NestedPat.node p of
+                     Con {arg, ...} =>
+                        (case arg of
+                            NONE => env
+                          | SOME p => 
+                               (case fact x of
+                                   Fact.Con {arg = SOME x, ...} =>
+                                      loop (p, x, env)
+                                 | _ => Error.bug "MatchCompile.Facts.bind: Con:wrong fact"))
+                   | Const _ => env
+                   | Layered (y, p) => loop (p, x, Env.extend (env, y, x))
+                   | Tuple ps =>
+                        if 0 = Vector.length ps
+                           then env
+                        else (case fact x of
+                                 Fact.Tuple xs =>
+                                    Vector.fold2 (ps, xs, env, loop)
+                               | _ => Error.bug "MatchCompile.Facts.bind: Tuple:wrong fact")
+                   | Var y => Env.extend (env, y, x)
+                   | Wild => env
+               end
+            val env = loop (p, x, Env.empty)
+            val () = destroy ()
+         in
+            env
+         end
 
       val bind =
-	 Trace.trace3 ("Facts.bind",
-		       layout, Var.layout, NestedPat.layout, Env.layout)
-	 bind
+         Trace.trace3 ("MatchCompile.Facts.bind",
+                       layout, Var.layout, NestedPat.layout, Env.layout)
+         bind
 
-      fun example (T facts, Examples.T es, x: Var.t): Layout.t =
-	 let
-	    val {destroy,
-		 get = fact: Var.t -> Fact.t option,
-		 set = setFact, ...} =
-	       Property.destGetSetOnce (Var.plist, Property.initConst NONE)
-	    val () = List.foreach (facts, fn {fact, var} =>
-				   setFact (var, SOME fact))
-	    fun loop (x: Var.t): Layout.t =
-	       case fact x of
-		  NONE =>
-		     (case List.peek (es, fn (x', _) => Var.equals (x, x')) of
-			 NONE => wild
-		       | SOME (_, l) => l)
-		| SOME f =>
-		     case f of
-			Fact.Con {arg, con} =>
-			   conApp (con, Option.map (arg, loop))
-		      | Fact.Tuple xs =>
-			   Layout.tuple (Vector.toListMap (xs, loop))
-	    val res = loop x
-	    val () = destroy ()
-	 in
-	    res
-	 end
+      fun example (T facts, Examples.T {es, ...}, x: Var.t): Layout.t =
+         let
+            val {destroy,
+                 get = fact: Var.t -> Fact.t option,
+                 set = setFact, ...} =
+               Property.destGetSetOnce (Var.plist, Property.initConst NONE)
+            val () = List.foreach (facts, fn {fact, var} =>
+                                   setFact (var, SOME fact))
+            fun loop (x: Var.t): Layout.t =
+               case fact x of
+                  NONE =>
+                     (case List.peek (es, fn (x', _) => Var.equals (x, x')) of
+                         NONE => wild
+                       | SOME (_, l) => l)
+                | SOME f =>
+                     case f of
+                        Fact.Con {arg, con} =>
+                           conApp (con, Option.map (arg, loop))
+                      | Fact.Tuple xs =>
+                           Layout.tuple (Vector.toListMap (xs, loop))
+            val res = loop x
+            val () = destroy ()
+         in
+            res
+         end
 
       val example =
-	 Trace.trace3 ("Facts.example", layout, Examples.layout, Var.layout,
-		       fn l => l)
-	 example
+         Trace.trace3 
+         ("MatchCompile.Facts.example", 
+          layout, Examples.layout, Var.layout, fn l => l)
+         example
    end
    
 structure Pat =
    struct
       datatype t =
-	 Const of {const: Const.t,
-		   isChar: bool,
-		   isInt: bool}
+         Const of {const: Const.t,
+                   isChar: bool,
+                   isInt: bool}
        | Con of {arg: (t * Type.t) option,
-		 con: Con.t,
-		 targs: Type.t vector}
+                 con: Con.t,
+                 targs: Type.t vector}
        | Tuple of t vector
        | Wild
 
       fun layout (p: t): Layout.t =
-	 let
-	    open Layout
-	 in
-	    case p of
-	       Const {const, ...} => Const.layout const
-	     | Con {arg, con, ...} =>
-		  seq [Con.layout con,
-		       case arg of
-			  NONE => empty
-			| SOME (p, _) => seq [str " ", layout p]]
-	     | Tuple ps => tuple (Vector.toListMap (ps, layout))
-	     | Wild => str "_"
-	 end
+         let
+            open Layout
+         in
+            case p of
+               Const {const, ...} => Const.layout const
+             | Con {arg, con, ...} =>
+                  seq [Con.layout con,
+                       case arg of
+                          NONE => empty
+                        | SOME (p, _) => seq [str " ", layout p]]
+             | Tuple ps => tuple (Vector.toListMap (ps, layout))
+             | Wild => str "_"
+         end
 
       val isWild: t -> bool =
-	 fn Wild => true
-	  | _ => false
+         fn Wild => true
+          | _ => false
 
       val fromNestedPat: NestedPat.t -> t =
-	 let
-	    fun loop (p: NestedPat.t): t =
-	       case NestedPat.node p of
-		  NestedPat.Con {arg, con, targs} =>
-		     let
-			val arg =
-			   Option.map (arg, fn p => (loop p, NestedPat.ty p))
-		     in
-			Con {arg = arg, con = con, targs = targs}
-		     end
-		| NestedPat.Const r => Const r
-		| NestedPat.Layered (_, p) => loop p
-		| NestedPat.Tuple ps => Tuple (Vector.map (ps, loop))
-		| NestedPat.Var _ => Wild
-		| NestedPat.Wild => Wild
-	 in
-	    loop
-	 end
+         let
+            fun loop (p: NestedPat.t): t =
+               case NestedPat.node p of
+                  NestedPat.Con {arg, con, targs} =>
+                     let
+                        val arg =
+                           Option.map (arg, fn p => (loop p, NestedPat.ty p))
+                     in
+                        Con {arg = arg, con = con, targs = targs}
+                     end
+                | NestedPat.Const r => Const r
+                | NestedPat.Layered (_, p) => loop p
+                | NestedPat.Tuple ps => Tuple (Vector.map (ps, loop))
+                | NestedPat.Var _ => Wild
+                | NestedPat.Wild => Wild
+         in
+            loop
+         end
    end
 
 structure Vector =
@@ -210,25 +215,26 @@
       open Vector
 
       fun dropNth (v: 'a t, n: int): 'a t =
-	 keepAllMapi (v, fn (i, a) => if i = n then NONE else SOME a)
+         keepAllMapi (v, fn (i, a) => if i = n then NONE else SOME a)
    end
 
 structure Rule =
    struct
-      datatype t = T of {pats: Pat.t vector,
-			 rest: {examples: Layout.t list ref,
-				finish: (Var.t -> Var.t) -> Exp.t,
-				nestedPat: NestedPat.t}}
+      datatype t =
+         T of {pats: Pat.t vector,
+               rest: {examples: (Layout.t * {isOnlyExns: bool}) list ref,
+                      finish: (Var.t -> Var.t) -> Exp.t,
+                      nestedPat: NestedPat.t}}
 
 
       fun layout (T {pats, ...}) =
-	 Layout.tuple (Vector.toListMap (pats, Pat.layout))
+         Layout.tuple (Vector.toListMap (pats, Pat.layout))
 
       fun allWild (T {pats, ...}) = Vector.forall (pats, Pat.isWild)
 
       fun dropNth (T {pats, rest}, n) =
-	 T {pats = Vector.dropNth (pats, n),
-	    rest = rest}
+         T {pats = Vector.dropNth (pats, n),
+            rest = rest}
    end
 
 structure Rules =
@@ -236,9 +242,9 @@
       type t = Rule.t vector
 
       fun layout (rs: t) = Layout.align (Vector.toListMap (rs, Rule.layout))
-	 
+         
       fun dropNth (rs: t, n: int): t =
-	 Vector.map (rs, fn r => Rule.dropNth (r, n))
+         Vector.map (rs, fn r => Rule.dropNth (r, n))
    end
 
 structure Vars =
@@ -250,89 +256,89 @@
 
 val directCases =
    List.keepAllMap (WordSize.all, fn s =>
-		    if WordSize.equals (s, WordSize.fromBits (Bits.fromInt 64))
-		       then NONE
-		    else SOME {size = s, ty = Type.word s})
+                    if WordSize.equals (s, WordSize.fromBits (Bits.fromInt 64))
+                       then NONE
+                    else SOME {size = s, ty = Type.word s})
 
 (* unhandledConst cs returns a constant (of the appropriate type) not in cs. *)
 fun unhandledConst (cs: Const.t vector): Const.t =
    let
       fun search {<= : 'a * 'a -> bool,
-		  equals: 'a * 'a -> bool,
-		  extract: Const.t -> 'a,
-		  isMin: 'a -> bool,
-		  make: 'a -> Const.t,
-		  next: 'a -> 'a,
-		  prev: 'a -> 'a} =
-	 let
-	    val cs = QuickSort.sortVector (Vector.map (cs, extract), op <=)
-	    val c = Vector.sub (cs, 0)
-	 in
-	    if not (isMin c)
-	       then make (prev c)
-	    else
-	       let
-		  val n = Vector.length cs
-		  fun loop (i, c) =
-		     if i = n orelse not (equals (c, Vector.sub (cs, i)))
-			then make c
-		     else loop (i + 1, next c)
-	       in
-		  loop (0, c)
-	       end
-	 end
+                  equals: 'a * 'a -> bool,
+                  extract: Const.t -> 'a,
+                  isMin: 'a -> bool,
+                  make: 'a -> Const.t,
+                  next: 'a -> 'a,
+                  prev: 'a -> 'a} =
+         let
+            val cs = QuickSort.sortVector (Vector.map (cs, extract), op <=)
+            val c = Vector.sub (cs, 0)
+         in
+            if not (isMin c)
+               then make (prev c)
+            else
+               let
+                  val n = Vector.length cs
+                  fun loop (i, c) =
+                     if i = n orelse not (equals (c, Vector.sub (cs, i)))
+                        then make c
+                     else loop (i + 1, next c)
+               in
+                  loop (0, c)
+               end
+         end
       val c = Vector.sub (cs, 0)
       datatype z = datatype Const.t
    in
       case c of
-	 IntInf _ =>
-	    let
-	       fun extract c =
-		  case c of
-		     IntInf i => i
-		   | _ => Error.bug "expected IntInf"
-	    in
-	       search {<= = op <=,
-		       equals = op =,
-		       extract = extract,
-		       isMin = fn _ => false,
-		       make = Const.IntInf,
-		       next = fn i => i + 1,
-		       prev = fn i => i - 1}
-	    end
-       | Real _ => Error.bug "match on real is not allowed"
+         IntInf _ =>
+            let
+               fun extract c =
+                  case c of
+                     IntInf i => i
+                   | _ => Error.bug "MatchCompile.unhandledConst: expected IntInf"
+            in
+               search {<= = op <=,
+                       equals = op =,
+                       extract = extract,
+                       isMin = fn _ => false,
+                       make = Const.IntInf,
+                       next = fn i => i + 1,
+                       prev = fn i => i - 1}
+            end
+       | Real _ => Error.bug "MatchCompile.unhandledConst: match on real is not allowed"
        | Word w =>
-	    let
-	       val s = WordX.size w
-	       fun extract c =
-		  case c of
-		     Word w => WordX.toIntInf w
-		   | _ => Error.bug "expected Word"
-	    in
-	       search {<= = op <=,
-		       equals = op =,
-		       extract = extract,
-		       isMin = fn w => w = 0,
-		       make = fn w => Const.word (WordX.fromIntInf (w, s)),
-		       next = fn w => w + 1,
-		       prev = fn w => w - 1}
-	    end
+            let
+               val s = WordX.size w
+               fun extract c =
+                  case c of
+                     Word w => WordX.toIntInf w
+                   | _ => Error.bug "MatchCompile.unhandledConst: expected Word"
+            in
+               search {<= = op <=,
+                       equals = op =,
+                       extract = extract,
+                       isMin = fn w => w = 0,
+                       make = fn w => Const.word (WordX.fromIntInf (w, s)),
+                       next = fn w => w + 1,
+                       prev = fn w => w - 1}
+            end
        | WordVector v =>
-	    let
-	       val max =
-		  Vector.fold
-		  (cs, ~1, fn (c, max) =>
-		   case c of
-		      WordVector v => Int.max (max, WordXVector.length v)
-		    | _ => Error.bug "expected Word8Vector")
-	       val elementSize = WordXVector.elementSize v
-	       val w = WordX.fromIntInf (IntInf.fromInt (Char.ord #"a"),
-					 elementSize)
-	    in
-	       Const.WordVector (WordXVector.tabulate
-				 ({elementSize = elementSize}, max + 1,
-				  fn _ => w))
-	    end
+            let
+               val max =
+                  Vector.fold
+                  (cs, ~1, fn (c, max) =>
+                   case c of
+                      WordVector v => Int.max (max, WordXVector.length v)
+                    | _ => Error.bug "MatchCompile.unhandledConst: expected Word8Vector")
+               val elementSize = WordXVector.elementSize v
+               val w = WordX.fromIntInf (IntInf.fromInt (Char.ord #"a"),
+                                         elementSize)
+            in
+               Const.WordVector (WordXVector.tabulate
+                                 ({elementSize = elementSize}, max + 1,
+                                  fn _ => w))
+            end
    end
 
 structure Exp =
@@ -344,402 +350,421 @@
 
 val traceMatch =
    Trace.trace4 ("MatchCompile.match",
-		 Vars.layout, Rules.layout, Facts.layout, Examples.layout,
-		 Exp.layout)
+                 Vars.layout, Rules.layout, Facts.layout, Examples.layout,
+                 Exp.layout)
 val traceConst =
    Trace.trace ("MatchCompile.const",
-		fn (vars, rules, facts, es, _: Int.t, _: Exp.t) =>
-		Layout.tuple [Vars.layout vars,
-			      Rules.layout rules,
-			      Facts.layout facts,
-			      Examples.layout es],
-		Exp.layout)
+                fn (vars, rules, facts, es, _: Int.t, _: Exp.t) =>
+                Layout.tuple [Vars.layout vars,
+                              Rules.layout rules,
+                              Facts.layout facts,
+                              Examples.layout es],
+                Exp.layout)
 val traceSum =
    Trace.trace ("MatchCompile.sum",
-		fn (vars, rules, facts, es, _: Int.t, _: Exp.t, _: Tycon.t) =>
-		Layout.tuple [Vars.layout vars,
-			      Rules.layout rules,
-			      Facts.layout facts,
-			      Examples.layout es],
-		Exp.layout)
+                fn (vars, rules, facts, es, _: Int.t, _: Exp.t, _: Tycon.t) =>
+                Layout.tuple [Vars.layout vars,
+                              Rules.layout rules,
+                              Facts.layout facts,
+                              Examples.layout es],
+                Exp.layout)
 val traceTuple =
    Trace.trace ("MatchCompile.tuple",
-		fn (vars, rules, facts, es, _: Int.t, _: Exp.t) =>
-		Layout.tuple [Vars.layout vars,
-			      Rules.layout rules,
-			      Facts.layout facts,
-			      Examples.layout es],
-		Exp.layout)
+                fn (vars, rules, facts, es, _: Int.t, _: Exp.t) =>
+                Layout.tuple [Vars.layout vars,
+                              Rules.layout rules,
+                              Facts.layout facts,
+                              Examples.layout es],
+                Exp.layout)
 
 (*---------------------------------------------------*)
 (*                   matchCompile                    *)
 (*---------------------------------------------------*)
 
 fun matchCompile {caseType: Type.t,
-		  cases: (NestedPat.t * ((Var.t -> Var.t) -> Exp.t)) vector,
-		  conTycon: Con.t -> Tycon.t,
-		  region: Region.t,
-		  test: Var.t,
-		  testType: Type.t,
-		  tyconCons: Tycon.t -> {con: Con.t,
-					 hasArg: bool} vector} =
+                  cases: (NestedPat.t * ((Var.t -> Var.t) -> Exp.t)) vector,
+                  conTycon: Con.t -> Tycon.t,
+                  region: Region.t,
+                  test: Var.t,
+                  testType: Type.t,
+                  tyconCons: Tycon.t -> {con: Con.t,
+                                         hasArg: bool} vector} =
    let
       fun chooseColumn _ = 0
       fun match arg : Exp.t =
-	 traceMatch
-	 (fn (vars: Vars.t, rules: Rules.t, facts: Facts.t, es) =>
-	 if 0 = Vector.length rules
-	    then Error.bug "match with no rules"
-	 else if Rule.allWild (Vector.sub (rules, 0))
-	    then (* The first rule matches. *)
-	       let
-		  val Rule.T {rest = {examples, finish, nestedPat, ...}, ...} =
-		     Vector.sub (rules, 0)
-		  val env = Facts.bind (facts, test, nestedPat)
-		  val () = List.push (examples, Facts.example (facts, es, test))
-	       in
-		  finish (fn x => Env.lookup (env, x))
-	       end
-	 else
-	    let
-	       val i = chooseColumn rules
-	    in
-	       case Vector.peek (rules, fn Rule.T {pats, ...} =>
-				 not (Pat.isWild (Vector.sub (pats, i)))) of
-		  NONE => match (Vector.dropNth (vars, i),
-				 Rules.dropNth (rules, i),
-				 facts, es)
-		| SOME (Rule.T {pats, ...}) =>
-		     let
-			datatype z = datatype Pat.t
-			val test = Exp.var (Vector.sub (vars, i))
-		     in
-			case Vector.sub (pats, i) of
-			   Const _ => const (vars, rules, facts, es, i, test)
-			 | Con {con, ...} =>
-			      sum (vars, rules, facts, es, i, test, conTycon con)
-			 | Tuple _ => tuple (vars, rules, facts, es, i, test)
-			 | Wild => Error.bug "matches Wild"
-		     end
-	    end) arg
+         traceMatch
+         (fn (vars: Vars.t, rules: Rules.t, facts: Facts.t, es) =>
+         if 0 = Vector.length rules
+            then Error.bug "MatchCompile.match: no rules"
+         else if Rule.allWild (Vector.sub (rules, 0))
+            then (* The first rule matches. *)
+               let
+                  val Rule.T {rest = {examples, finish, nestedPat, ...}, ...} =
+                     Vector.sub (rules, 0)
+                  val env = Facts.bind (facts, test, nestedPat)
+                  val Examples.T {isOnlyExns, ...} = es
+                  val () =
+                     List.push (examples,
+                                (Facts.example (facts, es, test),
+                                 {isOnlyExns = isOnlyExns}))
+               in
+                  finish (fn x => Env.lookup (env, x))
+               end
+         else
+            let
+               val i = chooseColumn rules
+            in
+               case Vector.peek (rules, fn Rule.T {pats, ...} =>
+                                 not (Pat.isWild (Vector.sub (pats, i)))) of
+                  NONE => match (Vector.dropNth (vars, i),
+                                 Rules.dropNth (rules, i),
+                                 facts, es)
+                | SOME (Rule.T {pats, ...}) =>
+                     let
+                        datatype z = datatype Pat.t
+                        val test = Exp.var (Vector.sub (vars, i))
+                     in
+                        case Vector.sub (pats, i) of
+                           Const _ => const (vars, rules, facts, es, i, test)
+                         | Con {con, ...} =>
+                              sum (vars, rules, facts, es, i, test,
+                                   conTycon con)
+                         | Tuple _ => tuple (vars, rules, facts, es, i, test)
+                         | Wild => Error.bug "MatchCompile.match: Wild"
+                     end
+            end) arg
       and const arg =
-	 traceConst
-	 (fn (vars, rules, facts, es, i, test) =>
-	 let
-	    val (var, ty) = Vector.sub (vars, i)
-	    val {isChar, isInt} =
-	       case Vector.peekMap (rules, fn Rule.T {pats, ...} =>
-				    case Vector.sub (pats, i) of
-				       Pat.Const {isChar, isInt, ...} =>
-					  SOME {isChar = isChar, isInt = isInt}
-				     | _ => NONE) of
-		  NONE => {isChar = false, isInt = false}
-		| SOME z => z
-	    fun layoutConst c =
-	       if isChar
-		  then
-		     case c of
-			Const.Word w =>
-			   let
-			      open Layout
-			   in
-			      seq [str "#\"",
-				   Char.layout (WordX.toChar w),
-				   str String.dquote]
-			   end
-		      | _ => Error.bug (concat ["strange char: ", Layout.toString (Const.layout c)])
-	       else if isInt
-		  then
-		     case c of
-			Const.IntInf i => IntInf.layout i
-		      | Const.Word w =>
-			   IntInf.layout (WordX.toIntInfX w)
-		      | _ => Error.bug (concat ["strange int: ", Layout.toString (Const.layout c)])
-	       else Const.layout c
-	    val (cases, defaults) =
-	       Vector.foldr
-	       (rules, ([], []),
-		fn (rule as Rule.T {pats, rest}, (cases, defaults)) =>
-		let
-		   val rule = Rule.dropNth (rule, i)
-		in
-		   case Vector.sub (pats, i) of
-		      Pat.Const {const = c, ...} =>
-			 let
-			    fun insert (cases, ac) =
-			       case cases of
-				  [] =>
-				     {const = c, rules = rule :: defaults} :: ac
-				| (casee as {const, rules}) :: cases =>
-				     if Const.equals (c, const)
-					then
-					   {const = c, rules = rule :: rules}
-					   :: List.appendRev (ac, cases)
-				     else insert (cases, casee :: ac)
-			 in
-			    (insert (cases, []), defaults)
-			 end
-		    | Pat.Wild =>
-			 (List.map (cases, fn {const, rules} =>
-				    {const = const, rules = rule :: rules}),
-			  rule :: defaults)
-		    | _ => Error.bug "expected Const pat"
-		end)
-	    val cases = Vector.fromListMap (cases, fn {const, rules} =>
-					    {const = const,
-					     rules = Vector.fromList rules})
-	    val defaults = Vector.fromList defaults
-	    val vars = Vector.dropNth (vars, i)
-	    fun finish (rules: Rule.t vector, e): Exp.t =
-	       match (vars, rules, facts, Examples.add (es, var, e))
-	    fun default (): Exp.t =
-	       finish (defaults,
-		       if 0 = Vector.length cases
-			  then wild
-		       else layoutConst (unhandledConst
-					 (Vector.map (cases, #const))))
-	 in
-	    case List.peek (directCases, fn {ty = ty', ...} =>
-			    Type.equals (ty, ty')) of
-	       NONE => 
-		  Vector.fold
-		  (cases, default (), fn ({const, rules}, rest) =>
-		   Exp.iff {test = Exp.equal (test, Exp.const const),
-			    thenn = finish (rules, Const.layout const),
-			    elsee = rest,
-			    ty = caseType})
-	     | SOME {size, ...} =>
-		  let
-		     val default =
-			if WordSize.cardinality size
-			   = IntInf.fromInt (Vector.length cases)
-			   then NONE
-			else SOME (default (), region)
-		     val cases =
-			Vector.map
-			(cases, fn {const, rules} =>
-			 let
-			    val w = 
-			       case const of
-				  Const.Word w => w
-				| _ => Error.bug "caseWord type error"
-			 in
-			    (w, finish (rules, layoutConst const))
-			 end)
-		  in
-		     Exp.casee {cases = Cases.word (size, cases),
-				default = default,
-				test = test,
-				ty = caseType}
-		  end
-	 end) arg
+         traceConst
+         (fn (vars, rules, facts, es, i, test) =>
+         let
+            val (var, ty) = Vector.sub (vars, i)
+            val {isChar, isInt} =
+               case Vector.peekMap (rules, fn Rule.T {pats, ...} =>
+                                    case Vector.sub (pats, i) of
+                                       Pat.Const {isChar, isInt, ...} =>
+                                          SOME {isChar = isChar, isInt = isInt}
+                                     | _ => NONE) of
+                  NONE => {isChar = false, isInt = false}
+                | SOME z => z
+            fun layoutConst c =
+               if isChar
+                  then
+                     case c of
+                        Const.Word w =>
+                           let
+                              open Layout
+                           in
+                              seq [str "#\"",
+                                   Char.layout (WordX.toChar w),
+                                   str String.dquote]
+                           end
+                      | _ => Error.bug (concat
+                                        ["MatchCompile.const.layoutConst: ",
+                                         "strange char: ", 
+                                         Layout.toString (Const.layout c)])
+               else if isInt
+                  then
+                     case c of
+                        Const.IntInf i => IntInf.layout i
+                      | Const.Word w =>
+                           IntInf.layout (WordX.toIntInfX w)
+                      | _ => Error.bug (concat
+                                        ["MatchCompile.const.layoutConst: ",
+                                         "strange int: ", 
+                                         Layout.toString (Const.layout c)])
+               else Const.layout c
+            val (cases, defaults) =
+               Vector.foldr
+               (rules, ([], []),
+                fn (rule as Rule.T {pats, ...}, (cases, defaults)) =>
+                let
+                   val rule = Rule.dropNth (rule, i)
+                in
+                   case Vector.sub (pats, i) of
+                      Pat.Const {const = c, ...} =>
+                         let
+                            fun insert (cases, ac) =
+                               case cases of
+                                  [] =>
+                                     {const = c, rules = rule :: defaults} :: ac
+                                | (casee as {const, rules}) :: cases =>
+                                     if Const.equals (c, const)
+                                        then
+                                           {const = c, rules = rule :: rules}
+                                           :: List.appendRev (ac, cases)
+                                     else insert (cases, casee :: ac)
+                         in
+                            (insert (cases, []), defaults)
+                         end
+                    | Pat.Wild =>
+                         (List.map (cases, fn {const, rules} =>
+                                    {const = const, rules = rule :: rules}),
+                          rule :: defaults)
+                    | _ => Error.bug "MatchCompile.const: expected Const pat"
+                end)
+            val cases = Vector.fromListMap (cases, fn {const, rules} =>
+                                            {const = const,
+                                             rules = Vector.fromList rules})
+            val defaults = Vector.fromList defaults
+            val vars = Vector.dropNth (vars, i)
+            fun finish (rules: Rule.t vector, e, isOnlyExns): Exp.t =
+               match (vars, rules, facts,
+                      Examples.add (es, var, e, {isOnlyExns = isOnlyExns}))
+            fun default (): Exp.t =
+               let
+                  val (e, ioe) =
+                     if 0 = Vector.length cases
+                        then (wild, true)
+                     else (layoutConst (unhandledConst
+                                        (Vector.map (cases, #const))),
+                           false)
+               in
+                  finish (defaults, e, ioe)
+               end
+         in
+            case List.peek (directCases, fn {ty = ty', ...} =>
+                            Type.equals (ty, ty')) of
+               NONE => 
+                  Vector.fold
+                  (cases, default (), fn ({const, rules}, rest) =>
+                   Exp.iff {test = Exp.equal (test, Exp.const const),
+                            thenn = finish (rules, Const.layout const, true),
+                            elsee = rest,
+                            ty = caseType})
+             | SOME {size, ...} =>
+                  let
+                     val default =
+                        if WordSize.cardinality size
+                           = IntInf.fromInt (Vector.length cases)
+                           then NONE
+                        else SOME (default (), region)
+                     val cases =
+                        Vector.map
+                        (cases, fn {const, rules} =>
+                         let
+                            val w = 
+                               case const of
+                                  Const.Word w => w
+                                | _ => Error.bug "MatchCompile.const: caseWord type error"
+                         in
+                            (w, finish (rules, layoutConst const, true))
+                         end)
+                  in
+                     Exp.casee {cases = Cases.word (size, cases),
+                                default = default,
+                                test = test,
+                                ty = caseType}
+                  end
+         end) arg
       and sum arg =
-	 traceSum
-	 (fn (vars: Vars.t, rules: Rules.t, facts: Facts.t, es,
-	      i, test, tycon) =>
-	 let
-	    val (var, _) = Vector.sub (vars, i)
-	    val (cases, defaults) =
-	       Vector.foldr
-	       (rules, ([], []),
-		fn (rule as Rule.T {pats, ...}, (cases, defaults)) =>
-		case Vector.sub (pats, i) of
-		   Pat.Con {arg, con, targs} =>
-		      let
-			 fun oneCase () =
-			    let
-			       val (arg, vars) =
-				  case arg of
-				     NONE =>
-					(NONE,
-					 Vector.keepAllMapi
-					 (vars, fn (i', x) =>
-					  if i = i' then NONE else SOME x))
-				   | SOME (_, ty) => 
-					let
-					   val arg = Var.newNoname ()
-					in
-					   (SOME (arg, ty),
-					    Vector.mapi
-					    (vars, fn (i', x) =>
-					     if i = i' then (arg, ty) else x))
-					end
-			    in
-			       {rest = {arg = arg,
-					con = con,
-					targs = targs,
-					vars = vars},
-				rules = rule :: defaults}
-			    end
-			 fun insert (cases, ac) =
-			    case cases of
-			       [] => oneCase () :: ac
-			   | ((casee as {rest as {con = con', ...}, rules})
-			      :: cases) =>
-			     if Con.equals (con, con')
-				then
-				   {rest = rest, rules = rule :: rules}
-				   :: List.appendRev (ac, cases)
-			     else insert (cases, casee :: ac)
-		      in
-			 (insert (cases, []), defaults)
-		      end
-		 | Pat.Wild =>
-		      (List.map (cases, fn {rest, rules} =>
-				 {rest = rest, rules = rule :: rules}),
-		       rule :: defaults)
-		 | _ => Error.bug "expected Con pat")
-	    val cases =
-	       Vector.fromListMap
-	       (cases, fn {rest = {arg, con, targs, vars}, rules} =>
-		let
-		   val rules =
-		      Vector.fromListMap
-		      (rules, fn Rule.T {pats, rest} =>
-		       let
-			  val pats =
-			     Vector.keepAllMapi
-			     (pats, fn (i', p') =>
-			      if i <> i' then SOME p'
-			      else
-				 case p' of
-				    Pat.Con {arg, ...} => Option.map (arg, #1)
-				  | Pat.Wild =>
-				       Option.map (arg, fn _ => Pat.Wild)
-				  | _ => Error.bug "decon got strange pattern")
-		       in
-			  Rule.T {pats = pats, rest = rest}
-		       end)
-		   val facts =
-		      Facts.add
-		      (facts, var,
-		       Fact.Con {arg = Option.map (arg, #1), con = con})
-		in
-		   {arg = arg,
-		    con = con,
-		    rhs = match (vars, rules, facts, es),
-		    targs = targs}
-		end)
-	    fun done e =
-	       SOME (match (Vector.dropNth (vars, i),
-			    Rules.dropNth (Vector.fromList defaults, i),
-			    facts,
-			    Examples.add (es, var, e)))
-	    val default =
-	       if Vector.isEmpty cases
-		  then done wild
-	       else if Tycon.equals (tycon, Tycon.exn)
-		  then done (Layout.str "e")
-	       else
-		  let
-		     val cons = tyconCons tycon
-		  in
-		     if Vector.length cases = Vector.length cons
-			then NONE
-		     else
-			let
-			   val unhandled =
-			      Vector.keepAllMap
-			      (cons, fn {con, hasArg, ...} =>
-			       if Vector.exists (cases, fn {con = con', ...} =>
-						 Con.equals (con, con'))
-				  then NONE
-			       else SOME (conApp
-					  (con,
-					   if hasArg then SOME wild else NONE)))
-			   open Layout
-			in
-			   done (seq (separate (Vector.toList unhandled, " | ")))
-			end
-		  end
-	    fun normal () =
-	       Exp.casee {cases = Cases.con cases,
-			  default = Option.map (default, fn e => (e, region)),
-			  test = test,
-			  ty = caseType}
-	 in
-	    if 1 <> Vector.length cases
-	       then normal ()
-	    else
-	       let
-		  val {arg, con, rhs, ...} = Vector.sub (cases, 0)
-	       in
-		  if not (Con.equals (con, Con.reff))
-		     then normal ()
-		  else 
-		     case arg of
-			NONE => Error.bug "ref missing arg"
-		      | SOME (var, _) => 
-			   Exp.lett {body = rhs,
-				     exp = Exp.deref test,
-				     var = var}
-	       end
-	 end) arg
+         traceSum
+         (fn (vars: Vars.t, rules: Rules.t, facts: Facts.t, es,
+              i, test, tycon) =>
+         let
+            val (var, _) = Vector.sub (vars, i)
+            val (cases, defaults) =
+               Vector.foldr
+               (rules, ([], []),
+                fn (rule as Rule.T {pats, ...}, (cases, defaults)) =>
+                case Vector.sub (pats, i) of
+                   Pat.Con {arg, con, targs} =>
+                      let
+                         fun oneCase () =
+                            let
+                               val (arg, vars) =
+                                  case arg of
+                                     NONE =>
+                                        (NONE,
+                                         Vector.keepAllMapi
+                                         (vars, fn (i', x) =>
+                                          if i = i' then NONE else SOME x))
+                                   | SOME (_, ty) => 
+                                        let
+                                           val arg = Var.newNoname ()
+                                        in
+                                           (SOME (arg, ty),
+                                            Vector.mapi
+                                            (vars, fn (i', x) =>
+                                             if i = i' then (arg, ty) else x))
+                                        end
+                            in
+                               {rest = {arg = arg,
+                                        con = con,
+                                        targs = targs,
+                                        vars = vars},
+                                rules = rule :: defaults}
+                            end
+                         fun insert (cases, ac) =
+                            case cases of
+                               [] => oneCase () :: ac
+                           | ((casee as {rest as {con = con', ...}, rules})
+                              :: cases) =>
+                             if Con.equals (con, con')
+                                then
+                                   {rest = rest, rules = rule :: rules}
+                                   :: List.appendRev (ac, cases)
+                             else insert (cases, casee :: ac)
+                      in
+                         (insert (cases, []), defaults)
+                      end
+                 | Pat.Wild =>
+                      (List.map (cases, fn {rest, rules} =>
+                                 {rest = rest, rules = rule :: rules}),
+                       rule :: defaults)
+                 | _ => Error.bug "MatchCompile.sum: expected Con pat")
+            val cases =
+               Vector.fromListMap
+               (cases, fn {rest = {arg, con, targs, vars}, rules} =>
+                let
+                   val rules =
+                      Vector.fromListMap
+                      (rules, fn Rule.T {pats, rest} =>
+                       let
+                          val pats =
+                             Vector.keepAllMapi
+                             (pats, fn (i', p') =>
+                              if i <> i' then SOME p'
+                              else
+                                 case p' of
+                                    Pat.Con {arg, ...} => Option.map (arg, #1)
+                                  | Pat.Wild =>
+                                       Option.map (arg, fn _ => Pat.Wild)
+                                  | _ => Error.bug "MatchCompile.sum: decon got strange pattern")
+                       in
+                          Rule.T {pats = pats, rest = rest}
+                       end)
+                   val facts =
+                      Facts.add
+                      (facts, var,
+                       Fact.Con {arg = Option.map (arg, #1), con = con})
+                in
+                   {arg = arg,
+                    con = con,
+                    rhs = match (vars, rules, facts, es),
+                    targs = targs}
+                end)
+            fun done (e, isOnlyExns) =
+               SOME (match (Vector.dropNth (vars, i),
+                            Rules.dropNth (Vector.fromList defaults, i),
+                            facts,
+                            Examples.add (es, var, e,
+                                          {isOnlyExns = isOnlyExns})))
+            val default =
+               if Vector.isEmpty cases
+                  then done (wild, true)
+               else if Tycon.equals (tycon, Tycon.exn)
+                  then done (Layout.str "e", true)
+               else
+                  let
+                     val cons = tyconCons tycon
+                  in
+                     if Vector.length cases = Vector.length cons
+                        then NONE
+                     else
+                        let
+                           val unhandled =
+                              Vector.keepAllMap
+                              (cons, fn {con, hasArg, ...} =>
+                               if Vector.exists (cases, fn {con = con', ...} =>
+                                                 Con.equals (con, con'))
+                                  then NONE
+                               else SOME (conApp
+                                          (con,
+                                           if hasArg then SOME wild else NONE)))
+                           open Layout
+                        in
+                           done
+                           (seq (separate (Vector.toList unhandled, " | ")),
+                            false)
+                        end
+                  end
+            fun normal () =
+               Exp.casee {cases = Cases.con cases,
+                          default = Option.map (default, fn e => (e, region)),
+                          test = test,
+                          ty = caseType}
+         in
+            if 1 <> Vector.length cases
+               then normal ()
+            else
+               let
+                  val {arg, con, rhs, ...} = Vector.sub (cases, 0)
+               in
+                  if not (Con.equals (con, Con.reff))
+                     then normal ()
+                  else 
+                     case arg of
+                        NONE => Error.bug "MatchCompile.sum: ref missing arg"
+                      | SOME (var, _) => 
+                           Exp.lett {body = rhs,
+                                     exp = Exp.deref test,
+                                     var = var}
+               end
+         end) arg
       and tuple arg =
-	 traceTuple
-	 (fn (vars: Vars.t, rules: Rules.t, facts: Facts.t, es, i, test) =>
-	 let
-	    val (var, _) = Vector.sub (vars, i)
-	    fun body vars' =
-	       let
-		  val n = Vector.length vars'
-		  val vars =
-		     Vector.concatV
-		     (Vector.mapi
-		      (vars, fn (i', x) =>
-		       if i = i'
-			  then vars'
-		       else Vector.new1 x))
-		  val rules =
-		     Vector.map
-		     (rules, fn Rule.T {pats, rest} =>
-		      let
-			 val pats =
-			    Vector.concatV
-			    (Vector.mapi
-			     (pats, fn (i', p) =>
-			      if i <> i'
-				 then Vector.new1 p
-			      else (case p of
-				       Pat.Tuple ps => ps
-				     | Pat.Wild =>
-					  Vector.tabulate (n, fn _ => Pat.Wild)
-				     | _ => Error.bug "Rule.detuple")))
-		      in
-			 Rule.T {pats = pats, rest = rest}
-		      end)
-	       in
-		  match (vars, rules,
-			 Facts.add (facts, var,
-				    Fact.Tuple (Vector.map (vars', #1))),
-			 es)
-	       end
-	 in
-	    Exp.detuple {body = body, tuple = test}
-	 end) arg
+         traceTuple
+         (fn (vars: Vars.t, rules: Rules.t, facts: Facts.t, es, i, test) =>
+         let
+            val (var, _) = Vector.sub (vars, i)
+            fun body vars' =
+               let
+                  val n = Vector.length vars'
+                  val vars =
+                     Vector.concatV
+                     (Vector.mapi
+                      (vars, fn (i', x) =>
+                       if i = i'
+                          then vars'
+                       else Vector.new1 x))
+                  val rules =
+                     Vector.map
+                     (rules, fn Rule.T {pats, rest} =>
+                      let
+                         val pats =
+                            Vector.concatV
+                            (Vector.mapi
+                             (pats, fn (i', p) =>
+                              if i <> i'
+                                 then Vector.new1 p
+                              else (case p of
+                                       Pat.Tuple ps => ps
+                                     | Pat.Wild =>
+                                          Vector.tabulate (n, fn _ => Pat.Wild)
+                                     | _ => Error.bug "MatchCompile.tuple: detuple")))
+                      in
+                         Rule.T {pats = pats, rest = rest}
+                      end)
+               in
+                  match (vars, rules,
+                         Facts.add (facts, var,
+                                    Fact.Tuple (Vector.map (vars', #1))),
+                         es)
+               end
+         in
+            Exp.detuple {body = body, tuple = test}
+         end) arg
       val examples = Vector.tabulate (Vector.length cases, fn _ => ref [])
       val res =
-	 match (Vector.new1 (test, testType),
-		Vector.map2 (cases, examples, fn ((p, f), r) =>
-			     Rule.T {pats = Vector.new1 (Pat.fromNestedPat p),
-				     rest = {examples = r,
-					     finish = f,
-					     nestedPat = p}}),
-		Facts.empty,
-		Examples.empty)
+         match (Vector.new1 (test, testType),
+                Vector.map2 (cases, examples, fn ((p, f), r) =>
+                             Rule.T {pats = Vector.new1 (Pat.fromNestedPat p),
+                                     rest = {examples = r,
+                                             finish = f,
+                                             nestedPat = p}}),
+                Facts.empty,
+                Examples.empty)
    in
-      (res,
-       fn () => Vector.map (examples, fn r => Layout.alignPrefix (! r, "| ")))
+      (res, fn () => Vector.map (examples, fn r => Vector.fromList (!r)))
    end
 
 val matchCompile =
    Trace.trace
-   ("matchCompile",
+   ("MatchCompile.matchCompile",
     fn {caseType, cases, test, testType, ...} =>
     Layout.record [("caseType", Type.layout caseType),
-		   ("cases", Vector.layout (NestedPat.layout o #1) cases),
-		   ("test", Var.layout test),
-		   ("testType", Type.layout testType)],
+                   ("cases", Vector.layout (NestedPat.layout o #1) cases),
+                   ("test", Var.layout test),
+                   ("testType", Type.layout testType)],
     Exp.layout o #1)
    matchCompile
 

Modified: mlton/branches/on-20050420-cmm-branch/mlton/match-compile/match-compile.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/match-compile/match-compile.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/match-compile/match-compile.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,9 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 type int = Int.t
@@ -12,46 +12,46 @@
    sig
       include ATOMS
       structure Type:
-	 sig
-	    type t
+         sig
+            type t
 
-	    val deTuple: t -> t vector
-	    val equals: t * t -> bool
-	    val layout: t -> Layout.t
-	    val unit: t
-	    val word: WordSize.t -> t
-	 end
+            val deTuple: t -> t vector
+            val equals: t * t -> bool
+            val layout: t -> Layout.t
+            val unit: t
+            val word: WordSize.t -> t
+         end
       structure Cases:
-	 sig
-	    type exp
-	    type t
+         sig
+            type exp
+            type t
 
-	    val con: {arg: (Var.t * Type.t) option,
-		      con: Con.t,
-		      rhs: exp,
-		      targs: Type.t vector} vector -> t
-	    val word: WordSize.t * (WordX.t * exp) vector -> t
-	 end
+            val con: {arg: (Var.t * Type.t) option,
+                      con: Con.t,
+                      rhs: exp,
+                      targs: Type.t vector} vector -> t
+            val word: WordSize.t * (WordX.t * exp) vector -> t
+         end
       structure Exp:
-	 sig
-	    type t
-	       
-	    val casee:
-	       {cases: Cases.t,
-		default: (t * Region.t) option,
-		test: t,
-		ty: Type.t}  (* type of entire case expression *)
-	       -> t
-	    val const: Const.t -> t
-	    val deref: t -> t
-	    val detuple: {tuple: t,
-			  body: (Var.t * Type.t) vector -> t} -> t
-	    val equal: t * t -> t
-	    val iff: {test: t, thenn: t, elsee: t, ty: Type.t} -> t
-	    val layout: t -> Layout.t
-	    val lett: {var: Var.t, exp: t, body: t} -> t
-	    val var: Var.t * Type.t -> t
-	 end
+         sig
+            type t
+               
+            val casee:
+               {cases: Cases.t,
+                default: (t * Region.t) option,
+                test: t,
+                ty: Type.t}  (* type of entire case expression *)
+               -> t
+            val const: Const.t -> t
+            val deref: t -> t
+            val detuple: {tuple: t,
+                          body: (Var.t * Type.t) vector -> t} -> t
+            val equal: t * t -> t
+            val iff: {test: t, thenn: t, elsee: t, ty: Type.t} -> t
+            val layout: t -> Layout.t
+            val lett: {var: Var.t, exp: t, body: t} -> t
+            val var: Var.t * Type.t -> t
+         end
       sharing type Cases.exp = Exp.t
       structure NestedPat: NESTED_PAT
       sharing Atoms = NestedPat.Atoms
@@ -63,12 +63,12 @@
       include MATCH_COMPILE_STRUCTS
 
       val matchCompile:
-	 {caseType: Type.t, (* type of entire expression *)
-	  cases: (NestedPat.t * ((Var.t -> Var.t) -> Exp.t)) vector,
-	  conTycon: Con.t -> Tycon.t,
-	  region: Region.t,
-	  test: Var.t,
-	  testType: Type.t,
-	  tyconCons: Tycon.t -> {con: Con.t, hasArg: bool} vector}
-	 -> Exp.t * (unit -> Layout.t vector)
+         {caseType: Type.t, (* type of entire expression *)
+          cases: (NestedPat.t * ((Var.t -> Var.t) -> Exp.t)) vector,
+          conTycon: Con.t -> Tycon.t,
+          region: Region.t,
+          test: Var.t,
+          testType: Type.t,
+          tyconCons: Tycon.t -> {con: Con.t, hasArg: bool} vector}
+         -> Exp.t * (unit -> ((Layout.t * {isOnlyExns: bool}) vector) vector)
    end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/match-compile/nested-pat.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/match-compile/nested-pat.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/match-compile/nested-pat.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 functor NestedPat (S: NESTED_PAT_STRUCTS): NESTED_PAT = 
 struct
 
@@ -13,11 +14,11 @@
 datatype t = T of {pat: node, ty: Type.t}
 and node =
    Con of {arg: t option,
-	   con: Con.t,
-	   targs: Type.t vector}
+           con: Con.t,
+           targs: Type.t vector}
   | Const of {const: Const.t,
-	      isChar: bool,
-	      isInt: bool}
+              isChar: bool,
+              isInt: bool}
   | Layered of Var.t * t
   | Tuple of t vector
   | Var of Var.t
@@ -34,22 +35,22 @@
    if 1 = Vector.length ps
       then Vector.sub (ps, 0)
    else T {pat = Tuple ps,
-	   ty = Type.tuple (Vector.map (ps, ty))}
+           ty = Type.tuple (Vector.map (ps, ty))}
 
 fun layout p =
    let
       open Layout
    in
       case node p of
-	 Con {arg, con, targs} =>
-	    let
-	       val z =
-		  Pretty.conApp {arg = Option.map (arg, layout),
-				 con = Con.layout con,
-				 targs = Vector.map (targs, Type.layout)}
-	    in
-	       if isSome arg then paren z else z
-	    end
+         Con {arg, con, targs} =>
+            let
+               val z =
+                  Pretty.conApp {arg = Option.map (arg, layout),
+                                 con = Con.layout con,
+                                 targs = Vector.map (targs, Type.layout)}
+            in
+               if isSome arg then paren z else z
+            end
        | Const {const = c, ...} => Const.layout c
        | Layered (x, p) => paren (seq [Var.layout x, str " as ", layout p])
        | Tuple ps => tuple (Vector.toListMap (ps, layout))
@@ -60,9 +61,9 @@
 fun make (p, t) =
    case p of
       Tuple ps =>
-	 if 1 = Vector.length ps
-	    then Vector.sub (ps, 0)
-	 else T {pat = p, ty = t}
+         if 1 = Vector.length ps
+            then Vector.sub (ps, 0)
+         else T {pat = p, ty = t}
     | _ => T {pat = p, ty = t}
 
 fun wild t = make (Wild, t)
@@ -88,31 +89,31 @@
 fun removeOthersReplace (p, {new, old}) =
    let
       fun loop (T {pat, ty}) =
-	 let
-	    val pat =
-	       case pat of
-		  Con {arg, con, targs} =>
-		     Con {arg = Option.map (arg, loop),
-			  con = con,
-			  targs = targs}
-		| Const _ => pat
-		| Layered (x, p) =>
-		     let
-			val p = loop p
-		     in
-			if Var.equals (x, old)
-			   then Layered (new, p)
-			else node p
-		     end
-		| Tuple ps => Tuple (Vector.map (ps, loop))
-		| Var x =>
-		     if Var.equals (x, old)
-			then Var new
-		     else Wild
-		| Wild => Wild
-	 in
-	    T {pat = pat, ty = ty}
-	 end
+         let
+            val pat =
+               case pat of
+                  Con {arg, con, targs} =>
+                     Con {arg = Option.map (arg, loop),
+                          con = con,
+                          targs = targs}
+                | Const _ => pat
+                | Layered (x, p) =>
+                     let
+                        val p = loop p
+                     in
+                        if Var.equals (x, old)
+                           then Layered (new, p)
+                        else node p
+                     end
+                | Tuple ps => Tuple (Vector.map (ps, loop))
+                | Var x =>
+                     if Var.equals (x, old)
+                        then Var new
+                     else Wild
+                | Wild => Wild
+         in
+            T {pat = pat, ty = ty}
+         end
    in
       loop p
    end
@@ -131,21 +132,21 @@
 fun replaceTypes (p: t, f: Type.t -> Type.t): t =
    let
       fun loop (T {pat, ty}) =
-	 let
-	    val pat =
-	       case pat of
-		  Con {arg, con, targs} =>
-		     Con {arg = Option.map (arg, loop),
-			  con = con,
-			  targs = Vector.map (targs, f)}
-		| Const _ => pat
-		| Layered (x, p) => Layered (x, loop p)
-		| Tuple ps => Tuple (Vector.map (ps, loop))
-		| Var _ => pat
-		| Wild => pat
-	 in
-	    T {pat = pat, ty = f ty}
-	 end
+         let
+            val pat =
+               case pat of
+                  Con {arg, con, targs} =>
+                     Con {arg = Option.map (arg, loop),
+                          con = con,
+                          targs = Vector.map (targs, f)}
+                | Const _ => pat
+                | Layered (x, p) => Layered (x, loop p)
+                | Tuple ps => Tuple (Vector.map (ps, loop))
+                | Var _ => pat
+                | Wild => pat
+         in
+            T {pat = pat, ty = f ty}
+         end
    in
       loop p
    end
@@ -153,15 +154,15 @@
 fun varsAndTypes (p: t): (Var.t * Type.t) list =
    let
       fun loop (p: t, accum: (Var.t * Type.t) list) =
-	 case node p of
-	    Wild => accum
-	  | Const _ => accum
-	  | Var x => (x, ty p) :: accum
-	  | Tuple ps => Vector.fold (ps, accum, loop)
-	  | Con {arg, ...} => (case arg of
-				NONE => accum
-			      | SOME p => loop (p, accum))
-	  | Layered (x, p) => loop (p, (x, ty p) :: accum)
+         case node p of
+            Wild => accum
+          | Const _ => accum
+          | Var x => (x, ty p) :: accum
+          | Tuple ps => Vector.fold (ps, accum, loop)
+          | Con {arg, ...} => (case arg of
+                                NONE => accum
+                              | SOME p => loop (p, accum))
+          | Layered (x, p) => loop (p, (x, ty p) :: accum)
    in loop (p, [])
    end
 

Modified: mlton/branches/on-20050420-cmm-branch/mlton/match-compile/nested-pat.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/match-compile/nested-pat.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/match-compile/nested-pat.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,20 +1,21 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature NESTED_PAT_STRUCTS = 
    sig
       include ATOMS
       structure Type:
-	 sig
-	    type t
+         sig
+            type t
 
-	    val layout: t -> Layout.t
-	    val tuple: t vector -> t
-	 end
+            val layout: t -> Layout.t
+            val tuple: t vector -> t
+         end
    end
 
 signature NESTED_PAT = 
@@ -23,16 +24,16 @@
       
       datatype t = T of {pat: node, ty: Type.t}
       and node =
-	 Con of {arg: t option,
-		 con: Con.t,
-		 targs: Type.t vector}
-	| Const of {const: Const.t,
-		    isChar: bool,
-		    isInt: bool}
-	| Layered of Var.t * t
-	| Tuple of t vector
-	| Var of Var.t
-	| Wild
+         Con of {arg: t option,
+                 con: Con.t,
+                 targs: Type.t vector}
+        | Const of {const: Const.t,
+                    isChar: bool,
+                    isInt: bool}
+        | Layered of Var.t * t
+        | Tuple of t vector
+        | Var of Var.t
+        | Wild
 
       (* isRefutable p iff p contains a constant, constructor or variable. *)
       val isRefutable: t -> bool

Modified: mlton/branches/on-20050420-cmm-branch/mlton/match-compile/sources.cm
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/match-compile/sources.cm	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/match-compile/sources.cm	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,11 @@
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 Group
 
 functor MatchCompile

Modified: mlton/branches/on-20050420-cmm-branch/mlton/match-compile/sources.mlb
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/match-compile/sources.mlb	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/match-compile/sources.mlb	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,20 +1,21 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 local
-    ../../lib/mlton/sources.mlb
-    ../atoms/sources.mlb
-    ../control/sources.mlb
+   ../../lib/mlton/sources.mlb
+   ../atoms/sources.mlb
+   ../control/sources.mlb
 
-    nested-pat.sig
-    nested-pat.fun
-    match-compile.sig
-    match-compile.fun
+   nested-pat.sig
+   nested-pat.fun
+   match-compile.sig
+   match-compile.fun
 in
-    functor MatchCompile
-    functor NestedPat
-end
\ No newline at end of file
+   functor MatchCompile
+   functor NestedPat
+end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/mlton-stubs.cm
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/mlton-stubs.cm	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/mlton-stubs.cm	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,10 @@
+(* Copyright (C) 2004-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 Group is
 
 ../lib/mlton-stubs/sources.cm

Modified: mlton/branches/on-20050420-cmm-branch/mlton/mlton.cm
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/mlton.cm	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/mlton.cm	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,10 @@
+(* Copyright (C) 2004-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 Group is
 
 upgrade-basis.sml

Modified: mlton/branches/on-20050420-cmm-branch/mlton/mlton.mlb
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/mlton.mlb	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/mlton.mlb	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,5 +1,12 @@
+(* Copyright (C) 2004-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 local
-    sources.mlb
+   sources.mlb
 in
-    call-main.sml
+   call-main.sml
 end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/sources.cm
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/sources.cm	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/sources.cm	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,12 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 Group is
 
 main/sources.cm
+

Modified: mlton/branches/on-20050420-cmm-branch/mlton/sources.mlb
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/sources.mlb	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/sources.mlb	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,12 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
-local in
-    main/sources.mlb
-end
\ No newline at end of file
+
+local 
+in
+   main/sources.mlb
+end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ssa/analyze.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ssa/analyze.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ssa/analyze.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 functor Analyze (S: ANALYZE_STRUCTS): ANALYZE = 
 struct
 
@@ -21,260 +22,241 @@
    let
       val unit = fromType Type.unit
       fun coerces (msg, from, to) =
-	 if Vector.length from = Vector.length to
-	    then Vector.foreach2 (from, to, fn (from, to) =>
-				  coerce {from = from, to = to})
-	 else Error.bug (concat ["coerces length mismatch: ", msg])
+         if Vector.length from = Vector.length to
+            then Vector.foreach2 (from, to, fn (from, to) =>
+                                  coerce {from = from, to = to})
+         else Error.bug (concat ["Analyze.coerces length mismatch: ", msg])
       val {get = value: Var.t -> 'a, set = setValue, ...} =
-	 Property.getSetOnce
-	 (Var.plist,
-	  Property.initRaise ("analyze var value", Var.layout))
+         Property.getSetOnce
+         (Var.plist,
+          Property.initRaise ("analyze var value", Var.layout))
       val value = Trace.trace ("Analyze.value", Var.layout, layout) value
       fun values xs = Vector.map (xs, value)
       val {get = func, set = setFunc, ...} =
-	 Property.getSetOnce
-	 (Func.plist, Property.initRaise ("analyze func name", Func.layout))
+         Property.getSetOnce
+         (Func.plist, Property.initRaise ("analyze func name", Func.layout))
       val {get = labelInfo, set = setLabelInfo, ...} =
-	 Property.getSetOnce
-	 (Label.plist, Property.initRaise ("analyze label", Label.layout))
+         Property.getSetOnce
+         (Label.plist, Property.initRaise ("analyze label", Label.layout))
       val labelArgs = #args o labelInfo
       val labelValues = #values o labelInfo
       fun loopArgs args =
-	 Vector.map (args, fn (x, t) =>
-		     let val v = fromType t
-		     in setValue (x, v)
-			; v
-		     end)
+         Vector.map (args, fn (x, t) =>
+                     let val v = fromType t
+                     in setValue (x, v)
+                        ; v
+                     end)
       val _ =
-	 List.foreach
-	 (functions, fn f =>
-	  let
-	     val {args, name, raises, returns, ...} = Function.dest f
-	  in
-	     setFunc (name, {args = loopArgs args,
-			     raises = Option.map (raises, fn ts =>
-						  Vector.map (ts, fromType)),
-			     returns = Option.map (returns, fn ts =>
-						   Vector.map (ts, fromType))})
-	  end)
+         List.foreach
+         (functions, fn f =>
+          let
+             val {args, name, raises, returns, ...} = Function.dest f
+          in
+             setFunc (name, {args = loopArgs args,
+                             raises = Option.map (raises, fn ts =>
+                                                  Vector.map (ts, fromType)),
+                             returns = Option.map (returns, fn ts =>
+                                                   Vector.map (ts, fromType))})
+          end)
       fun loopTransfer (t: Transfer.t,
-			shouldReturns: 'a vector option,
-			shouldRaises: 'a vector option): unit =
-	(case t of
-	    Arith {prim, args, overflow, success, ty} =>
-	       (coerces ("arith", Vector.new0 (), labelValues overflow)
-		; coerce {from = primApp {prim = prim,
-					  targs = Vector.new0 (),
-					  args = values args,
-					  resultType = ty,
-					  resultVar = NONE},
-			  to = Vector.sub (labelValues success, 0)})
-	  | Bug => ()
-	  | Call {func = f, args, return, ...} =>
-	       let
-		  val {args = formals, raises, returns} = func f
-		  val _ = coerces ("formals", values args, formals)
-		  fun noHandler () =
-		     case (raises, shouldRaises) of
-			(NONE, NONE) => ()
-		      | (NONE, SOME _) => ()
-		      | (SOME _, NONE) => 
-			   Error.bug "raise mismatch"
-		      | (SOME vs, SOME vs') => coerces ("noHandler", vs, vs')
-		  datatype z = datatype Return.t
-	       in
-		  case return of
-		     Dead =>
-			if isSome returns orelse isSome raises
-			   then Error.bug "return mismatch at Dead"
-			else ()
-		   | NonTail {cont, handler} => 
-		        (Option.app (returns, fn vs =>
-				     coerces ("returns", vs, labelValues cont))
-			 ; (case handler of
-			       Handler.Caller => noHandler ()
-			     | Handler.Dead =>
-				  if isSome raises
-				     then Error.bug "raise mismatch at nontail"
-				  else ()
-			     | Handler.Handle h =>
-				  let
-				     val _ =
-				        case raises of
-					   NONE => ()
-					 | SOME vs =>
-					      coerces ("handle", vs,
-						       labelValues h)
-				  in
-				     ()
-				  end))
-		   | Tail =>
-			let
-			   val _ = noHandler ()
-			   val _ =
-			      case (returns, shouldReturns) of
-				 (NONE, NONE) => ()
-			       | (NONE, SOME _) => ()
-			       | (SOME _, NONE) =>
-				    Error.bug "return mismatch at Tail"
-			       | (SOME vs, SOME vs') =>
-				    coerces ("tail", vs, vs')
-			in
-			   ()
-			end
+                        shouldReturns: 'a vector option,
+                        shouldRaises: 'a vector option): unit =
+        (case t of
+            Arith {prim, args, overflow, success, ty} =>
+               (coerces ("arith", Vector.new0 (), labelValues overflow)
+                ; coerce {from = primApp {prim = prim,
+                                          targs = Vector.new0 (),
+                                          args = values args,
+                                          resultType = ty,
+                                          resultVar = NONE},
+                          to = Vector.sub (labelValues success, 0)})
+          | Bug => ()
+          | Call {func = f, args, return, ...} =>
+               let
+                  val {args = formals, raises, returns} = func f
+                  val _ = coerces ("formals", values args, formals)
+                  fun noHandler () =
+                     case (raises, shouldRaises) of
+                        (NONE, NONE) => ()
+                      | (NONE, SOME _) => ()
+                      | (SOME _, NONE) => 
+                           Error.bug "Analyze.loopTransfer: raise mismatch"
+                      | (SOME vs, SOME vs') => coerces ("noHandler", vs, vs')
+                  datatype z = datatype Return.t
+               in
+                  case return of
+                     Dead =>
+                        if isSome returns orelse isSome raises
+                           then Error.bug "Analyze.loopTransfer: return mismatch at Dead"
+                        else ()
+                   | NonTail {cont, handler} => 
+                        (Option.app (returns, fn vs =>
+                                     coerces ("returns", vs, labelValues cont))
+                         ; (case handler of
+                               Handler.Caller => noHandler ()
+                             | Handler.Dead =>
+                                  if isSome raises
+                                     then Error.bug "Analyze.loopTransfer: raise mismatch at NonTail"
+                                  else ()
+                             | Handler.Handle h =>
+                                  let
+                                     val _ =
+                                        case raises of
+                                           NONE => ()
+                                         | SOME vs =>
+                                              coerces ("handle", vs,
+                                                       labelValues h)
+                                  in
+                                     ()
+                                  end))
+                   | Tail =>
+                        let
+                           val _ = noHandler ()
+                           val _ =
+                              case (returns, shouldReturns) of
+                                 (NONE, NONE) => ()
+                               | (NONE, SOME _) => ()
+                               | (SOME _, NONE) =>
+                                    Error.bug "Analyze.loopTransfer: return mismatch at Tail"
+                               | (SOME vs, SOME vs') =>
+                                    coerces ("tail", vs, vs')
+                        in
+                           ()
+                        end
 
-	       end
-	  | Case {test, cases, default, ...} =>
-	       let val test = value test
-		  fun ensureNullary j =
-		     if 0 = Vector.length (labelValues j)
-			then ()
-		     else Error.bug (concat [Label.toString j,
-					     " must be nullary"])
-		  fun doit (s, cs, filter) =
-		     (filter (test, s)
-		      ; Vector.foreach (cs, fn (_, j) => ensureNullary j))
-		  datatype z = datatype Cases.t
-		  val _ =
-		     case cases of
-			Con cases =>
-			   Vector.foreach (cases, fn (c, j) =>
-					   filter (test, c, labelValues j))
-		      | Word (s, cs) => doit (s, cs, filterWord)
-		  val _ = Option.app (default, ensureNullary)
-	       in ()
-	       end
-	  | Goto {dst, args} => coerces ("goto", values args, labelValues dst)
-	  | Raise xs =>
-	       (case shouldRaises of
-		   NONE => raise Fail "raise mismatch at raise"
-		 | SOME vs => coerces ("raise", values xs, vs))
-	  | Return xs =>
-	       (case shouldReturns of
-		   NONE => raise Fail "return mismatch at return"
-		 | SOME vs => coerces ("return", values xs, vs))
-	  | Runtime {prim, args, return} =>
-	       let
-		  val xts = labelArgs return
-		  val (resultVar, resultType) =
-		     if 0 = Vector.length xts
-			then (NONE, Type.unit)
-		     else
-			let
-			   val (x, t) = Vector.sub (xts, 0)
-			in
-			   (SOME x, t)
-			end
-		  val _ =
-		     primApp {prim = prim,
-			      targs = Vector.new0 (),
-			      args = values args,
-			      resultType = resultType,
-			      resultVar = resultVar}
-	       in 
-		  ()
-	       end)
-	handle exn => 
-	   Error.bug (concat ["loopTransfer: ", 
-			      Layout.toString (Transfer.layout t),
-			      ": ",
-			      (case exn of 
-				  Fail msg => msg
-				| _ => "")])
+               end
+          | Case {test, cases, default, ...} =>
+               let val test = value test
+                  fun ensureNullary j =
+                     if 0 = Vector.length (labelValues j)
+                        then ()
+                     else Error.bug (concat ["Analyze.loopTransfer: Case:",
+                                             Label.toString j,
+                                             " must be nullary"])
+                  fun doit (s, cs, filter: 'a * 'b -> unit) =
+                     (filter (test, s)
+                      ; Vector.foreach (cs, fn (_, j) => ensureNullary j))
+                  datatype z = datatype Cases.t
+                  val _ =
+                     case cases of
+                        Con cases =>
+                           Vector.foreach (cases, fn (c, j) =>
+                                           filter (test, c, labelValues j))
+                      | Word (s, cs) => doit (s, cs, filterWord)
+                  val _ = Option.app (default, ensureNullary)
+               in ()
+               end
+          | Goto {dst, args} => coerces ("goto", values args, labelValues dst)
+          | Raise xs =>
+               (case shouldRaises of
+                   NONE => Error.bug "Analyze.loopTransfer: raise mismatch at Raise"
+                 | SOME vs => coerces ("raise", values xs, vs))
+          | Return xs =>
+               (case shouldReturns of
+                   NONE => Error.bug "Analyze.loopTransfer: return mismatch at Return"
+                 | SOME vs => coerces ("return", values xs, vs))
+          | Runtime {prim, args, return} =>
+               let
+                  val xts = labelArgs return
+                  val (resultVar, resultType) =
+                     if 0 = Vector.length xts
+                        then (NONE, Type.unit)
+                     else
+                        let
+                           val (x, t) = Vector.sub (xts, 0)
+                        in
+                           (SOME x, t)
+                        end
+                  val _ =
+                     primApp {prim = prim,
+                              targs = Vector.new0 (),
+                              args = values args,
+                              resultType = resultType,
+                              resultVar = resultVar}
+               in 
+                  ()
+               end)
       val loopTransfer =
-	 Trace.trace3
-	 ("Analyze.loopTransfer",
-	  Transfer.layout, 
-	  Option.layout (Vector.layout layout),
-	  Option.layout (Vector.layout layout),
-	  Layout.ignore)
-	 loopTransfer
-      fun loopStatement (s as Statement.T {var, exp, ty}): unit =
-	 let
-	    val v =
-	       case exp of
-		  ConApp {con, args} => conApp {con = con, args = values args}
-		| Const c => const c
-		| PrimApp {prim, targs, args, ...} =>
-		     primApp {prim = prim,
-			      targs = targs,
-			      args = values args,
-			      resultType = ty,
-			      resultVar = var}
-		| Profile _ => unit
-		| Select {tuple, offset} =>
-		     select {tuple = value tuple,
-			     offset = offset,
-			     resultType = ty}
-		| Tuple xs =>
-		     if 1 = Vector.length xs
-			then Error.bug "unary tuple"
-		     else tuple (values xs)
-		| Var x => value x
-	 in
-	    Option.app
-	    (var, fn var =>
-	     if useFromTypeOnBinds
-		then let
-			val v' = fromType ty
-			val _ = coerce {from = v, to = v'}
-			val _ = setValue (var, v')
-		     in
-			()
-		     end
-	     else setValue (var, v))
-	 end
-         handle exn =>
-	    Error.bug (concat ["loopStatement: ",
-			       Layout.toString (Statement.layout s),
-			       ": ",
-			       (case exn of 
-				   Fail msg => msg
-				 | _ => "")])
+         Trace.trace3
+         ("Analyze.loopTransfer",
+          Transfer.layout, 
+          Option.layout (Vector.layout layout),
+          Option.layout (Vector.layout layout),
+          Layout.ignore)
+         loopTransfer
+      fun loopStatement (Statement.T {var, exp, ty}): unit =
+         let
+            val v =
+               case exp of
+                  ConApp {con, args} => conApp {con = con, args = values args}
+                | Const c => const c
+                | PrimApp {prim, targs, args, ...} =>
+                     primApp {prim = prim,
+                              targs = targs,
+                              args = values args,
+                              resultType = ty,
+                              resultVar = var}
+                | Profile _ => unit
+                | Select {tuple, offset} =>
+                     select {tuple = value tuple,
+                             offset = offset,
+                             resultType = ty}
+                | Tuple xs =>
+                     if 1 = Vector.length xs
+                        then Error.bug "Analyze.loopStatement: unary tuple"
+                     else tuple (values xs)
+                | Var x => value x
+         in
+            Option.app
+            (var, fn var =>
+             if useFromTypeOnBinds
+                then let
+                        val v' = fromType ty
+                        val _ = coerce {from = v, to = v'}
+                        val _ = setValue (var, v')
+                     in
+                        ()
+                     end
+             else setValue (var, v))
+         end
       val loopStatement =
-	 Trace.trace ("Analyze.loopStatement", Statement.layout, Unit.layout)
-	 loopStatement
+         Trace.trace ("Analyze.loopStatement", Statement.layout, Unit.layout)
+         loopStatement
       val _ = coerces ("main", Vector.new0 (), #args (func main))
       val _ = Vector.foreach (globals, loopStatement)
       val _ =
-	 List.foreach
-	 (functions, fn f =>
-	  let
-	     val {blocks, name, start, ...} = Function.dest f
-	     val _ =
-		Vector.foreach
-		(blocks, fn b as Block.T {label, args, ...} =>
-		 setLabelInfo (label, {args = args,
-				       block = b,
-				       values = loopArgs args,
-				       visited = ref false}))
-	     val {returns, raises, ...} = func name
-	     fun visit (l: Label.t) =
-		let
-		   val {block, visited, ...} = labelInfo l
-		in
-		   if !visited
-		      then ()
-		   else
-		      let
-			 val _ = visited := true
-			 val Block.T {statements, transfer, ...} = block
-		      in
-			 Vector.foreach (statements, loopStatement)
-			 ; loopTransfer (transfer, returns, raises)
-			 ; Transfer.foreachLabel (transfer, visit)
-		      end
-		end
-	     val _ = visit start
-	             handle exn => 
-		        Error.bug (concat [Func.toString name,
-					   ": ",
-					   (case exn of 
-					       Fail msg => msg
-					     | _ => "")])
-	  in
-	     ()
-	  end)
+         List.foreach
+         (functions, fn f =>
+          let
+             val {blocks, name, start, ...} = Function.dest f
+             val _ =
+                Vector.foreach
+                (blocks, fn b as Block.T {label, args, ...} =>
+                 setLabelInfo (label, {args = args,
+                                       block = b,
+                                       values = loopArgs args,
+                                       visited = ref false}))
+             val {returns, raises, ...} = func name
+             fun visit (l: Label.t) =
+                let
+                   val {block, visited, ...} = labelInfo l
+                in
+                   if !visited
+                      then ()
+                   else
+                      let
+                         val _ = visited := true
+                         val Block.T {statements, transfer, ...} = block
+                      in
+                         Vector.foreach (statements, loopStatement)
+                         ; loopTransfer (transfer, returns, raises)
+                         ; Transfer.foreachLabel (transfer, visit)
+                      end
+                end
+             val _ = visit start
+          in
+             ()
+          end)
    in
       {func = func,
        label = labelValues,

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ssa/analyze.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ssa/analyze.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ssa/analyze.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 type int = Int.t
    
 signature ANALYZE_STRUCTS = 
@@ -17,32 +18,32 @@
       include ANALYZE_STRUCTS
       
       val analyze:
-	 {coerce: {from: 'a,
-		   to: 'a} -> unit,
-	  conApp: {args: 'a vector,
-		   con: Con.t} -> 'a,
-	  const: Const.t -> 'a,
-	  filter: 'a * Con.t * 'a vector -> unit,
-	  filterWord: 'a * WordSize.t -> unit,
-	  fromType: Type.t -> 'a,
-	  layout: 'a -> Layout.t,
-	  primApp: {args: 'a vector,
-		    prim: Type.t Prim.t,
-		    resultType: Type.t,
-		    resultVar: Var.t option,
-		    targs: Type.t vector} -> 'a,
-	  program: Program.t,
-	  select: {offset: int,
-		   resultType: Type.t,
-		   tuple: 'a} -> 'a,
-	  tuple: 'a vector -> 'a,
-	  useFromTypeOnBinds: bool
-	 }
-	 -> {
-	     value: Var.t -> 'a,
-	     func: Func.t -> {args: 'a vector,
-			      raises: 'a vector option,
-			      returns: 'a vector option},
-	     label: Label.t -> 'a vector
-	    }
+         {coerce: {from: 'a,
+                   to: 'a} -> unit,
+          conApp: {args: 'a vector,
+                   con: Con.t} -> 'a,
+          const: Const.t -> 'a,
+          filter: 'a * Con.t * 'a vector -> unit,
+          filterWord: 'a * WordSize.t -> unit,
+          fromType: Type.t -> 'a,
+          layout: 'a -> Layout.t,
+          primApp: {args: 'a vector,
+                    prim: Type.t Prim.t,
+                    resultType: Type.t,
+                    resultVar: Var.t option,
+                    targs: Type.t vector} -> 'a,
+          program: Program.t,
+          select: {offset: int,
+                   resultType: Type.t,
+                   tuple: 'a} -> 'a,
+          tuple: 'a vector -> 'a,
+          useFromTypeOnBinds: bool
+         }
+         -> {
+             value: Var.t -> 'a,
+             func: Func.t -> {args: 'a vector,
+                              raises: 'a vector option,
+                              returns: 'a vector option},
+             label: Label.t -> 'a vector
+            }
    end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ssa/analyze2.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ssa/analyze2.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ssa/analyze2.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,9 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 functor Analyze2 (S: ANALYZE2_STRUCTS): ANALYZE2 = 
@@ -20,297 +20,278 @@
     select, update, useFromTypeOnBinds} =
    let
       fun coerces (msg, from, to) =
-	 if Vector.length from = Vector.length to
-	    then Vector.foreach2 (from, to, fn (from, to) =>
-				  coerce {from = from, to = to})
-	 else Error.bug (concat ["coerces length mismatch: ", msg])
+         if Vector.length from = Vector.length to
+            then Vector.foreach2 (from, to, fn (from, to) =>
+                                  coerce {from = from, to = to})
+         else Error.bug (concat ["Analyze2.coerces: length mismatch: ", msg])
       val {get = value: Var.t -> 'a, set = setValue, ...} =
-	 Property.getSetOnce
-	 (Var.plist,
-	  Property.initRaise ("analyze var value", Var.layout))
+         Property.getSetOnce
+         (Var.plist,
+          Property.initRaise ("analyze var value", Var.layout))
       val value = Trace.trace ("Analyze2.value", Var.layout, layout) value
       fun values xs = Vector.map (xs, value)
       val {get = func, set = setFunc, ...} =
-	 Property.getSetOnce
-	 (Func.plist, Property.initRaise ("analyze func name", Func.layout))
+         Property.getSetOnce
+         (Func.plist, Property.initRaise ("analyze func name", Func.layout))
       val {get = labelInfo, set = setLabelInfo, ...} =
-	 Property.getSetOnce
-	 (Label.plist, Property.initRaise ("analyze label", Label.layout))
+         Property.getSetOnce
+         (Label.plist, Property.initRaise ("analyze label", Label.layout))
       val labelArgs = #args o labelInfo
       val labelValues = #values o labelInfo
       fun loopArgs args =
-	 Vector.map (args, fn (x, t) =>
-		     let val v = fromType t
-		     in setValue (x, v)
-			; v
-		     end)
+         Vector.map (args, fn (x, t) =>
+                     let val v = fromType t
+                     in setValue (x, v)
+                        ; v
+                     end)
       val _ =
-	 List.foreach
-	 (functions, fn f =>
-	  let
-	     val {args, name, raises, returns, ...} = Function.dest f
-	  in
-	     setFunc (name, {args = loopArgs args,
-			     raises = Option.map (raises, fn ts =>
-						  Vector.map (ts, fromType)),
-			     returns = Option.map (returns, fn ts =>
-						   Vector.map (ts, fromType))})
-	  end)
+         List.foreach
+         (functions, fn f =>
+          let
+             val {args, name, raises, returns, ...} = Function.dest f
+          in
+             setFunc (name, {args = loopArgs args,
+                             raises = Option.map (raises, fn ts =>
+                                                  Vector.map (ts, fromType)),
+                             returns = Option.map (returns, fn ts =>
+                                                   Vector.map (ts, fromType))})
+          end)
       fun loopTransfer (t: Transfer.t,
-			shouldReturns: 'a vector option,
-			shouldRaises: 'a vector option): unit =
-	(case t of
-	    Arith {prim, args, overflow, success, ty} =>
-	       (coerces ("arith", Vector.new0 (), labelValues overflow)
-		; coerce {from = primApp {prim = prim,
-					  args = values args,
-					  resultType = ty,
-					  resultVar = NONE},
-			  to = Vector.sub (labelValues success, 0)})
-	  | Bug => ()
-	  | Call {func = f, args, return, ...} =>
-	       let
-		  val {args = formals, raises, returns} = func f
-		  val _ = coerces ("formals", values args, formals)
-		  fun noHandler () =
-		     case (raises, shouldRaises) of
-			(NONE, NONE) => ()
-		      | (NONE, SOME _) => ()
-		      | (SOME _, NONE) => 
-			   Error.bug "raise mismatch"
-		      | (SOME vs, SOME vs') => coerces ("noHandler", vs, vs')
-		  datatype z = datatype Return.t
-	       in
-		  case return of
-		     Dead =>
-			if isSome returns orelse isSome raises
-			   then Error.bug "return mismatch at Dead"
-			else ()
-		   | NonTail {cont, handler} => 
-		        (Option.app (returns, fn vs =>
-				     coerces ("returns", vs, labelValues cont))
-			 ; (case handler of
-			       Handler.Caller => noHandler ()
-			     | Handler.Dead =>
-				  if isSome raises
-				     then Error.bug "raise mismatch at nontail"
-				  else ()
-			     | Handler.Handle h =>
-				  let
-				     val _ =
-				        case raises of
-					   NONE => ()
-					 | SOME vs =>
-					      coerces ("handle", vs,
-						       labelValues h)
-				  in
-				     ()
-				  end))
-		   | Tail =>
-			let
-			   val _ = noHandler ()
-			   val _ =
-			      case (returns, shouldReturns) of
-				 (NONE, NONE) => ()
-			       | (NONE, SOME _) => ()
-			       | (SOME _, NONE) =>
-				    Error.bug "return mismatch at Tail"
-			       | (SOME vs, SOME vs') =>
-				    coerces ("tail", vs, vs')
-			in
-			   ()
-			end
+                        shouldReturns: 'a vector option,
+                        shouldRaises: 'a vector option): unit =
+        (case t of
+            Arith {prim, args, overflow, success, ty} =>
+               (coerces ("arith", Vector.new0 (), labelValues overflow)
+                ; coerce {from = primApp {prim = prim,
+                                          args = values args,
+                                          resultType = ty,
+                                          resultVar = NONE},
+                          to = Vector.sub (labelValues success, 0)})
+          | Bug => ()
+          | Call {func = f, args, return, ...} =>
+               let
+                  val {args = formals, raises, returns} = func f
+                  val _ = coerces ("formals", values args, formals)
+                  fun noHandler () =
+                     case (raises, shouldRaises) of
+                        (NONE, NONE) => ()
+                      | (NONE, SOME _) => ()
+                      | (SOME _, NONE) => 
+                           Error.bug "Analyze2.loopTransfer: raise mismatch"
+                      | (SOME vs, SOME vs') => coerces ("noHandler", vs, vs')
+                  datatype z = datatype Return.t
+               in
+                  case return of
+                     Dead =>
+                        if isSome returns orelse isSome raises
+                           then Error.bug "Analyze2.loopTransfer: return mismatch at Dead"
+                        else ()
+                   | NonTail {cont, handler} => 
+                        (Option.app (returns, fn vs =>
+                                     coerces ("returns", vs, labelValues cont))
+                         ; (case handler of
+                               Handler.Caller => noHandler ()
+                             | Handler.Dead =>
+                                  if isSome raises
+                                     then Error.bug "Analyze2.loopTransfer: raise mismatch at NonTail"
+                                  else ()
+                             | Handler.Handle h =>
+                                  let
+                                     val _ =
+                                        case raises of
+                                           NONE => ()
+                                         | SOME vs =>
+                                              coerces ("handle", vs,
+                                                       labelValues h)
+                                  in
+                                     ()
+                                  end))
+                   | Tail =>
+                        let
+                           val _ = noHandler ()
+                           val _ =
+                              case (returns, shouldReturns) of
+                                 (NONE, NONE) => ()
+                               | (NONE, SOME _) => ()
+                               | (SOME _, NONE) =>
+                                    Error.bug "Analyze2.loopTransfer: return mismatch at Tail"
+                               | (SOME vs, SOME vs') =>
+                                    coerces ("tail", vs, vs')
+                        in
+                           ()
+                        end
 
-	       end
-	  | Case {test, cases, default, ...} =>
-	       let val test = value test
-		  fun ensureNullary j =
-		     if 0 = Vector.length (labelValues j)
-			then ()
-		     else Error.bug (concat [Label.toString j,
-					     " must be nullary"])
-		  fun doit (s, cs, filter) =
-		     (filter (test, s)
-		      ; Vector.foreach (cs, fn (_, j) => ensureNullary j))
-		  datatype z = datatype Cases.t
-		  val _ =
-		     case cases of
-			Con cases =>
-			   Vector.foreach
-			   (cases, fn (c, j) =>
-			    let
-			       val v = labelValues j
-			       val variant =
-				  case Vector.length v of
-				     0 => NONE
-				   | 1 => SOME (Vector.sub (v, 0))
-				   | _ => Error.bug "conApp with >1 arg"
-			    in
-			       filter {con = c,
-				       test = test,
-				       variant = variant}
-			    end)
-		      | Word (s, cs) => doit (s, cs, filterWord)
-		  val _ = Option.app (default, ensureNullary)
-	       in ()
-	       end
-	  | Goto {dst, args} => coerces ("goto", values args, labelValues dst)
-	  | Raise xs =>
-	       (case shouldRaises of
-		   NONE => raise Fail "raise mismatch at raise"
-		 | SOME vs => coerces ("raise", values xs, vs))
-	  | Return xs =>
-	       (case shouldReturns of
-		   NONE => raise Fail "return mismatch at return"
-		 | SOME vs => coerces ("return", values xs, vs))
-	  | Runtime {prim, args, return} =>
-	       let
-		  val xts = labelArgs return
-		  val (resultVar, resultType) =
-		     if 0 = Vector.length xts
-			then (NONE, Type.unit)
-		     else
-			let
-			   val (x, t) = Vector.sub (xts, 0)
-			in
-			   (SOME x, t)
-			end
-		  val _ =
-		     primApp {prim = prim,
-			      args = values args,
-			      resultType = resultType,
-			      resultVar = resultVar}
-	       in 
-		  ()
-	       end)
-	handle exn => 
-	   Error.bug (concat ["loopTransfer: ", 
-			      Layout.toString (Transfer.layout t),
-			      ": ",
-			      (case exn of 
-				  Fail msg => msg
-				| _ => "")])
+               end
+          | Case {test, cases, default, ...} =>
+               let val test = value test
+                  fun ensureNullary j =
+                     if 0 = Vector.length (labelValues j)
+                        then ()
+                     else Error.bug (concat ["Analyze2.loopTransfer: Case:",
+                                             Label.toString j,
+                                             " must be nullary"])
+                  fun doit (s, cs, filter: 'a * 'b -> unit) =
+                     (filter (test, s)
+                      ; Vector.foreach (cs, fn (_, j) => ensureNullary j))
+                  datatype z = datatype Cases.t
+                  val _ =
+                     case cases of
+                        Con cases =>
+                           Vector.foreach
+                           (cases, fn (c, j) =>
+                            let
+                               val v = labelValues j
+                               val variant =
+                                  case Vector.length v of
+                                     0 => NONE
+                                   | 1 => SOME (Vector.sub (v, 0))
+                                   | _ => Error.bug "Analyze2.loopTransfer: Case:conApp with >1 arg"
+                            in
+                               filter {con = c,
+                                       test = test,
+                                       variant = variant}
+                            end)
+                      | Word (s, cs) => doit (s, cs, filterWord)
+                  val _ = Option.app (default, ensureNullary)
+               in ()
+               end
+          | Goto {dst, args} => coerces ("goto", values args, labelValues dst)
+          | Raise xs =>
+               (case shouldRaises of
+                   NONE => Error.bug "Analyze2.loopTransfer: raise mismatch at Raise"
+                 | SOME vs => coerces ("raise", values xs, vs))
+          | Return xs =>
+               (case shouldReturns of
+                   NONE => Error.bug "Analyze2.loopTransfer: return mismatch at Return"
+                 | SOME vs => coerces ("return", values xs, vs))
+          | Runtime {prim, args, return} =>
+               let
+                  val xts = labelArgs return
+                  val (resultVar, resultType) =
+                     if 0 = Vector.length xts
+                        then (NONE, Type.unit)
+                     else
+                        let
+                           val (x, t) = Vector.sub (xts, 0)
+                        in
+                           (SOME x, t)
+                        end
+                  val _ =
+                     primApp {prim = prim,
+                              args = values args,
+                              resultType = resultType,
+                              resultVar = resultVar}
+               in 
+                  ()
+               end)
       val loopTransfer =
-	 Trace.trace3
-	 ("Analyze2.loopTransfer",
-	  Transfer.layout, 
-	  Option.layout (Vector.layout layout),
-	  Option.layout (Vector.layout layout),
-	  Layout.ignore)
-	 loopTransfer
+         Trace.trace3
+         ("Analyze2.loopTransfer",
+          Transfer.layout, 
+          Option.layout (Vector.layout layout),
+          Option.layout (Vector.layout layout),
+          Layout.ignore)
+         loopTransfer
       fun baseValue b =
-	 case b of
-	    Base.Object x => value x
-	  | Base.VectorSub {vector, ...} => value vector
+         case b of
+            Base.Object x => value x
+          | Base.VectorSub {vector, ...} => value vector
       fun loopBind {exp, ty, var}: 'a =
-	 case exp of
-	    Const c => const c
-	  | Inject {sum, variant} =>
-	       inject {sum = sum,
-		       variant = value variant}
-	  | Object {args, con} =>
-	       let
-		  val args =
-		     case Type.dest ty of
-			Type.Object {args = ts, ...} =>
-			   Prod.make
-			   (Vector.map2
-			    (args, Prod.dest ts,
-			     fn (x, {isMutable, ...}) =>
-			     {elt = value x,
-			      isMutable = isMutable}))
-		      | _ => Error.bug "analyze saw strange object"
-	       in
-		  object {args = args,
-			  con = con,
-			  resultType = ty}
-	       end
-	  | PrimApp {prim, args, ...} =>
-	       primApp {prim = prim,
-			args = values args,
-			resultType = ty,
-			resultVar = var}
-	  | Select {base, offset} =>
-	       select {base = baseValue base,
-		       offset = offset,
-		       resultType = ty}
-	  | Var x => value x
+         case exp of
+            Const c => const c
+          | Inject {sum, variant} =>
+               inject {sum = sum,
+                       variant = value variant}
+          | Object {args, con} =>
+               let
+                  val args =
+                     case Type.dest ty of
+                        Type.Object {args = ts, ...} =>
+                           Prod.make
+                           (Vector.map2
+                            (args, Prod.dest ts,
+                             fn (x, {isMutable, ...}) =>
+                             {elt = value x,
+                              isMutable = isMutable}))
+                      | _ => Error.bug "Analyze2.loopBind: strange object"
+               in
+                  object {args = args,
+                          con = con,
+                          resultType = ty}
+               end
+          | PrimApp {prim, args, ...} =>
+               primApp {prim = prim,
+                        args = values args,
+                        resultType = ty,
+                        resultVar = var}
+          | Select {base, offset} =>
+               select {base = baseValue base,
+                       offset = offset,
+                       resultType = ty}
+          | Var x => value x
       fun loopStatement (s: Statement.t): unit =
-	 (case s of
-	     Bind (b as {ty, var, ...}) =>
-		let
-		   val v = loopBind b
-		in
-		   Option.app
-		   (var, fn var =>
-		    if useFromTypeOnBinds
-		       then let
-			       val v' = fromType ty
-			       val _ = coerce {from = v, to = v'}
-			       val _ = setValue (var, v')
-			    in
-			       ()
-			    end
-		    else setValue (var, v))
-		end
-	  | Profile _ => ()
-	  | Update {base, offset, value = v} =>
-	     update {base = baseValue base,
-		     offset = offset,
-		     value = value v})
-	     handle exn =>
-		Error.bug (concat ["loopStatement: ",
-				   Layout.toString (Statement.layout s),
-				   ": ",
-				   (case exn of 
-				       Fail msg => msg
-				     | _ => "")])
+         (case s of
+             Bind (b as {ty, var, ...}) =>
+                let
+                   val v = loopBind b
+                in
+                   Option.app
+                   (var, fn var =>
+                    if useFromTypeOnBinds
+                       then let
+                               val v' = fromType ty
+                               val _ = coerce {from = v, to = v'}
+                               val _ = setValue (var, v')
+                            in
+                               ()
+                            end
+                    else setValue (var, v))
+                end
+          | Profile _ => ()
+          | Update {base, offset, value = v} =>
+             update {base = baseValue base,
+                     offset = offset,
+                     value = value v})
       val loopStatement =
-	 Trace.trace ("Analyze2.loopStatement",
-		      Statement.layout,
-		      Unit.layout)
-	 loopStatement
+         Trace.trace ("Analyze2.loopStatement",
+                      Statement.layout,
+                      Unit.layout)
+         loopStatement
       val _ = coerces ("main", Vector.new0 (), #args (func main))
       val _ = Vector.foreach (globals, loopStatement)
       val _ =
-	 List.foreach
-	 (functions, fn f =>
-	  let
-	     val {blocks, name, start, ...} = Function.dest f
-	     val _ =
-		Vector.foreach
-		(blocks, fn b as Block.T {label, args, ...} =>
-		 setLabelInfo (label, {args = args,
-				       block = b,
-				       values = loopArgs args,
-				       visited = ref false}))
-	     val {returns, raises, ...} = func name
-	     fun visit (l: Label.t) =
-		let
-		   val {block, visited, ...} = labelInfo l
-		in
-		   if !visited
-		      then ()
-		   else
-		      let
-			 val _ = visited := true
-			 val Block.T {statements, transfer, ...} = block
-		      in
-			 Vector.foreach (statements, loopStatement)
-			 ; loopTransfer (transfer, returns, raises)
-			 ; Transfer.foreachLabel (transfer, visit)
-		      end
-		end
-	     val _ = visit start
-	             handle exn => 
-		        Error.bug (concat [Func.toString name,
-					   ": ",
-					   (case exn of 
-					       Fail msg => msg
-					     | _ => "")])
-	  in
-	     ()
-	  end)
+         List.foreach
+         (functions, fn f =>
+          let
+             val {blocks, name, start, ...} = Function.dest f
+             val _ =
+                Vector.foreach
+                (blocks, fn b as Block.T {label, args, ...} =>
+                 setLabelInfo (label, {args = args,
+                                       block = b,
+                                       values = loopArgs args,
+                                       visited = ref false}))
+             val {returns, raises, ...} = func name
+             fun visit (l: Label.t) =
+                let
+                   val {block, visited, ...} = labelInfo l
+                in
+                   if !visited
+                      then ()
+                   else
+                      let
+                         val _ = visited := true
+                         val Block.T {statements, transfer, ...} = block
+                      in
+                         Vector.foreach (statements, loopStatement)
+                         ; loopTransfer (transfer, returns, raises)
+                         ; Transfer.foreachLabel (transfer, visit)
+                      end
+                end
+             val _ = visit start
+          in
+             ()
+          end)
    in
       {func = func,
        label = labelValues,

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ssa/analyze2.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ssa/analyze2.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ssa/analyze2.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 type int = Int.t
    
 signature ANALYZE2_STRUCTS = 
@@ -17,37 +18,37 @@
       include ANALYZE2_STRUCTS
       
       val analyze:
-	 {coerce: {from: 'a,
-		   to: 'a} -> unit,
-	  const: Const.t -> 'a,
-	  (* In filter, the variant is an 'a option because the targets of Case
-	   * branches may ignore the test (by taking 0 args).
-	   *)
-	  filter: {con: Con.t,
-		   test: 'a,
-		   variant: 'a option} -> unit,
-	  filterWord: 'a * WordSize.t -> unit,
-	  fromType: Type.t -> 'a,
-	  inject: {sum: Tycon.t, variant: 'a} -> 'a,
-	  layout: 'a -> Layout.t,
-	  object: {args: 'a Prod.t,
-		   con: Con.t option,
-		   resultType: Type.t} -> 'a,
-	  primApp: {args: 'a vector,
-		    prim: Type.t Prim.t,
-		    resultType: Type.t,
-		    resultVar: Var.t option} -> 'a,
-	  program: Program.t,
-	  select: {base: 'a,
-		   offset: int,
-		   resultType: Type.t} -> 'a,
-	  update: {base: 'a,
-		   offset: int,
-		   value: 'a} -> unit,
-	  useFromTypeOnBinds: bool}
-	 -> {func: Func.t -> {args: 'a vector,
-			      raises: 'a vector option,
-			      returns: 'a vector option},
-	     label: Label.t -> 'a vector,
-	     value: Var.t -> 'a}
+         {coerce: {from: 'a,
+                   to: 'a} -> unit,
+          const: Const.t -> 'a,
+          (* In filter, the variant is an 'a option because the targets of Case
+           * branches may ignore the test (by taking 0 args).
+           *)
+          filter: {con: Con.t,
+                   test: 'a,
+                   variant: 'a option} -> unit,
+          filterWord: 'a * WordSize.t -> unit,
+          fromType: Type.t -> 'a,
+          inject: {sum: Tycon.t, variant: 'a} -> 'a,
+          layout: 'a -> Layout.t,
+          object: {args: 'a Prod.t,
+                   con: Con.t option,
+                   resultType: Type.t} -> 'a,
+          primApp: {args: 'a vector,
+                    prim: Type.t Prim.t,
+                    resultType: Type.t,
+                    resultVar: Var.t option} -> 'a,
+          program: Program.t,
+          select: {base: 'a,
+                   offset: int,
+                   resultType: Type.t} -> 'a,
+          update: {base: 'a,
+                   offset: int,
+                   value: 'a} -> unit,
+          useFromTypeOnBinds: bool}
+         -> {func: Func.t -> {args: 'a vector,
+                              raises: 'a vector option,
+                              returns: 'a vector option},
+             label: Label.t -> 'a vector,
+             value: Var.t -> 'a}
    end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ssa/common-arg.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ssa/common-arg.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ssa/common-arg.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,9 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 functor CommonArg (S: COMMON_ARG_STRUCTS): COMMON_ARG = 
@@ -49,194 +49,194 @@
 fun eliminate (Program.T {datatypes, globals, functions, main}) =
    let
       val {get = nodeInfo: unit Node.t -> NodeInfo.t, 
-	   set = setNodeInfo, ...} =
-	 Property.getSetOnce
-	 (Node.plist,
-	  Property.initRaise ("CommonArg.nodeInfo", Node.layout))
+           set = setNodeInfo, ...} =
+         Property.getSetOnce
+         (Node.plist,
+          Property.initRaise ("CommonArg.nodeInfo", Node.layout))
       val nodeInfo =
-	 Trace.trace ("CommonArg.nodeInfo", Layout.ignore, Layout.ignore)
-	 nodeInfo
+         Trace.trace ("CommonArg.nodeInfo", Layout.ignore, Layout.ignore)
+         nodeInfo
       val {get = labelArgs: Label.t -> (Var.t * Type.t) vector, 
-	   set = setLabelArgs, ...} =
-	 Property.getSetOnce
-	 (Label.plist, 
-	  Property.initRaise ("CommonArg.labelArgs", Label.layout))
+           set = setLabelArgs, ...} =
+         Property.getSetOnce
+         (Label.plist, 
+          Property.initRaise ("CommonArg.labelArgs", Label.layout))
       val labelArgs =
-	 Trace.trace ("CommonArg.labelArgs", Layout.ignore, Layout.ignore)
-	 labelArgs
+         Trace.trace ("CommonArg.labelArgs", Layout.ignore, Layout.ignore)
+         labelArgs
       (* Argument flow graph. *)
       val G = Graph.new ()
       val root = Graph.newNode G
       fun newNode (v: Var.t): unit Node.t =
-	 let
-	    val node = Graph.newNode G
-	    val () = setNodeInfo (node, NodeInfo.new v)
-	 in
-	    node
-	 end
+         let
+            val node = Graph.newNode G
+            val () = setNodeInfo (node, NodeInfo.new v)
+         in
+            node
+         end
       fun newRootedNode v =
-	 let
-	    val node = newNode v
-	    val _ = Graph.addEdge (G, {from = root, to = node})
-	 in
-	    node
-	 end
+         let
+            val node = newNode v
+            val _ = Graph.addEdge (G, {from = root, to = node})
+         in
+            node
+         end
       val {get = varInfo: Var.t -> VarInfo.t, 
-	   set = setVarInfo, ...} =
-	 Property.getSetOnce (Var.plist,
-			      Property.initFun (VarInfo.new o newRootedNode))
+           set = setVarInfo, ...} =
+         Property.getSetOnce (Var.plist,
+                              Property.initFun (VarInfo.new o newRootedNode))
       val varInfo =
-	 Trace.trace ("CommonArg.varInfo", Layout.ignore, Layout.ignore)
-	 varInfo
+         Trace.trace ("CommonArg.varInfo", Layout.ignore, Layout.ignore)
+         varInfo
       val varNode = VarInfo.node o varInfo
       (* Analyze *)
       val () =
-	 List.foreach
-	 (functions, fn f =>
-	  let
-	     val {blocks, ...} = Function.dest f
-	     val () = 
-		Vector.foreach
-		(blocks, fn Block.T {label, args, ...} =>
-		 (setLabelArgs (label, args)
-		  ; Vector.foreach (args, fn (v, _) =>
-				    setVarInfo (v, VarInfo.new (newNode v)))))
-	    (* Flow Transfer.Goto arguments. *)
-	    fun flowVarVar (v, v'): unit = 
-	       ignore (Graph.addEdge (G, {from = varNode v, to = varNode v'}))
-	    fun flowVarVarTy (v, (v', _)) = flowVarVar (v, v')
-	    fun flowVarsVarTys (vs, vts') =
-	       Vector.foreach2 (vs, vts', flowVarVarTy)
-	    fun flowVarsLabelArgs (vs, l) = flowVarsVarTys (vs, labelArgs l)
-	    (* Visit in unknown contexts. *)
-	    fun visitVar v =
-	       ignore (Graph.addEdge (G, {from = root, to = varNode v}))
-	    fun visitVarTy (v, _) = visitVar v
-	    fun visitArgs args = Vector.foreach (args, visitVarTy)
-	    fun visitLabelArgs l = visitArgs (labelArgs l)
-	  in
-	     Vector.foreach
-	     (blocks, fn Block.T {transfer, ...} =>
-	      case transfer of
-		 Arith {overflow, success, ...} =>
-		    (visitLabelArgs overflow; visitLabelArgs success)
-	       | Bug => ()
-	       | Call {return, ...} =>
-		    (case return of
-			Return.NonTail {cont, handler} =>
-			   (visitLabelArgs cont
-			    ; (case handler of
-				  Handler.Handle hand => visitLabelArgs hand
-				| _ => ()))
-		      | _ => ())
-	       | Case {cases, default, ...} =>
-		    (Cases.foreach (cases, visitLabelArgs)
-		     ; Option.app (default, visitLabelArgs))
-	       | Goto {dst, args} => flowVarsLabelArgs (args, dst)
-	       | Raise _ => ()
-	       | Return _ => ()
-	       | Runtime {return, ...} => visitLabelArgs return)
-	  end)
+         List.foreach
+         (functions, fn f =>
+          let
+             val {blocks, ...} = Function.dest f
+             val () = 
+                Vector.foreach
+                (blocks, fn Block.T {label, args, ...} =>
+                 (setLabelArgs (label, args)
+                  ; Vector.foreach (args, fn (v, _) =>
+                                    setVarInfo (v, VarInfo.new (newNode v)))))
+            (* Flow Transfer.Goto arguments. *)
+            fun flowVarVar (v, v'): unit = 
+               ignore (Graph.addEdge (G, {from = varNode v, to = varNode v'}))
+            fun flowVarVarTy (v, (v', _)) = flowVarVar (v, v')
+            fun flowVarsVarTys (vs, vts') =
+               Vector.foreach2 (vs, vts', flowVarVarTy)
+            fun flowVarsLabelArgs (vs, l) = flowVarsVarTys (vs, labelArgs l)
+            (* Visit in unknown contexts. *)
+            fun visitVar v =
+               ignore (Graph.addEdge (G, {from = root, to = varNode v}))
+            fun visitVarTy (v, _) = visitVar v
+            fun visitArgs args = Vector.foreach (args, visitVarTy)
+            fun visitLabelArgs l = visitArgs (labelArgs l)
+          in
+             Vector.foreach
+             (blocks, fn Block.T {transfer, ...} =>
+              case transfer of
+                 Arith {overflow, success, ...} =>
+                    (visitLabelArgs overflow; visitLabelArgs success)
+               | Bug => ()
+               | Call {return, ...} =>
+                    (case return of
+                        Return.NonTail {cont, handler} =>
+                           (visitLabelArgs cont
+                            ; (case handler of
+                                  Handler.Handle hand => visitLabelArgs hand
+                                | _ => ()))
+                      | _ => ())
+               | Case {cases, default, ...} =>
+                    (Cases.foreach (cases, visitLabelArgs)
+                     ; Option.app (default, visitLabelArgs))
+               | Goto {dst, args} => flowVarsLabelArgs (args, dst)
+               | Raise _ => ()
+               | Return _ => ()
+               | Runtime {return, ...} => visitLabelArgs return)
+          end)
       val () = Graph.removeDuplicateEdges G
       val {idom} = Graph.dominators (G, {root = root})
       fun getVar (v: Var.t): Var.t =
-	 case idom (varNode v) of
-	    Graph.Idom parent => if Node.equals (parent, root)
-				    then v
-				 else NodeInfo.var (nodeInfo parent)
-	  | Graph.Unreachable => v
-	  | Graph.Root => v
+         case idom (varNode v) of
+            Graph.Idom parent => if Node.equals (parent, root)
+                                    then v
+                                 else NodeInfo.var (nodeInfo parent)
+          | Graph.Unreachable => v
+          | Graph.Root => v
       fun keepVar v = Var.equals (v, getVar v)
       (* Diagnostics *)
       val () = 
-	 Control.diagnostics
-	 (fn display =>
-	  List.foreach
-	  (functions, fn f =>
-	   let
-	      val {blocks, name, ...} = Function.dest f
-	      open Layout
-	      fun lNode n = 
-		 record [("idom", case idom n of
-			  Graph.Idom parent => 
-			     if Node.equals (parent, root)
-				then str "root"
-			     else Var.layout (NodeInfo.var (nodeInfo parent))
-			| _ => str "???")]
-	   in
-	      display (seq [str "\n", Func.layout name])
-	      ; (Vector.foreach
-		 (blocks, fn Block.T {args, label, ...} =>
-		  if Vector.exists (args, not o keepVar o #1)
-		     then
-			display
-			(seq [Label.layout label,
-			      str " ",
-			      Vector.layout
-			      (fn (v, _) =>
-			       seq [Var.layout v,
-				    str ": ",
-				    VarInfo.layout lNode (varInfo v)])
-			      args])
-		  else ()))
-	   end))
+         Control.diagnostics
+         (fn display =>
+          List.foreach
+          (functions, fn f =>
+           let
+              val {blocks, name, ...} = Function.dest f
+              open Layout
+              fun lNode n = 
+                 record [("idom", case idom n of
+                          Graph.Idom parent => 
+                             if Node.equals (parent, root)
+                                then str "root"
+                             else Var.layout (NodeInfo.var (nodeInfo parent))
+                        | _ => str "???")]
+           in
+              display (seq [str "\n", Func.layout name])
+              ; (Vector.foreach
+                 (blocks, fn Block.T {args, label, ...} =>
+                  if Vector.exists (args, not o keepVar o #1)
+                     then
+                        display
+                        (seq [Label.layout label,
+                              str " ",
+                              Vector.layout
+                              (fn (v, _) =>
+                               seq [Var.layout v,
+                                    str ": ",
+                                    VarInfo.layout lNode (varInfo v)])
+                              args])
+                  else ()))
+           end))
       (* Transform *)
       val shrink = shrinkFunction {globals = globals}
       val functions =
-	 List.revMap
-	 (functions, fn f =>
-	  let
-	     val {args, blocks, mayInline, name, start, raises, returns} =
-		Function.dest f
-	     val blocks = 
-		Vector.map
-		(blocks, fn Block.T {args, label, statements, transfer} =>
-		 let
-		    val {yes = args, no = rems} = 
-		       Vector.partition (args, keepVar o #1)
-		    val statements =
-		       if Vector.isEmpty rems
-			  then statements
-		       else Vector.concat [Vector.map
-					   (rems, fn (v, ty) =>
-					    Statement.T {var = SOME v,
-							 ty = ty,
-							 exp = Var (getVar v)}),
-					   statements]
-		    val transfer =
-		       case transfer of
-			  Goto {args, dst} => 
-			     let
-				val args =
-				   Vector.keepAllMap2
-				   (args, labelArgs dst, fn (arg, (v, _)) =>
-				    if keepVar v
-				       then SOME arg
-				    else NONE)
-			     in
-				Goto {args = args, dst = dst}
-			     end
-			| _ => transfer 
-		 in
-		    Block.T {args = args,
-			     label = label, 
-			     statements = statements,
-			     transfer = transfer}
-		 end)
-	  in
-	     shrink (Function.new {args = args,
-				   blocks = blocks,
-				   mayInline = mayInline,
-				   name = name,
-				   start = start,
-				   raises = raises,
-				   returns = returns})
-	  end)
+         List.revMap
+         (functions, fn f =>
+          let
+             val {args, blocks, mayInline, name, start, raises, returns} =
+                Function.dest f
+             val blocks = 
+                Vector.map
+                (blocks, fn Block.T {args, label, statements, transfer} =>
+                 let
+                    val {yes = args, no = rems} = 
+                       Vector.partition (args, keepVar o #1)
+                    val statements =
+                       if Vector.isEmpty rems
+                          then statements
+                       else Vector.concat [Vector.map
+                                           (rems, fn (v, ty) =>
+                                            Statement.T {var = SOME v,
+                                                         ty = ty,
+                                                         exp = Var (getVar v)}),
+                                           statements]
+                    val transfer =
+                       case transfer of
+                          Goto {args, dst} => 
+                             let
+                                val args =
+                                   Vector.keepAllMap2
+                                   (args, labelArgs dst, fn (arg, (v, _)) =>
+                                    if keepVar v
+                                       then SOME arg
+                                    else NONE)
+                             in
+                                Goto {args = args, dst = dst}
+                             end
+                        | _ => transfer 
+                 in
+                    Block.T {args = args,
+                             label = label, 
+                             statements = statements,
+                             transfer = transfer}
+                 end)
+          in
+             shrink (Function.new {args = args,
+                                   blocks = blocks,
+                                   mayInline = mayInline,
+                                   name = name,
+                                   start = start,
+                                   raises = raises,
+                                   returns = returns})
+          end)
       val program =
-	 Program.T {datatypes = datatypes,
-		    globals = globals,
-		    functions = functions,
-		    main = main}
+         Program.T {datatypes = datatypes,
+                    globals = globals,
+                    functions = functions,
+                    main = main}
       val () = Program.clearTop program
    in
       program

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ssa/common-arg.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ssa/common-arg.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ssa/common-arg.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature COMMON_ARG_STRUCTS = 
    sig
       include SHRINK

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ssa/common-block.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ssa/common-block.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ssa/common-block.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 functor CommonBlock (S: COMMON_BLOCK_STRUCTS): COMMON_BLOCK = 
 struct
 
@@ -14,153 +15,153 @@
 fun eliminate (Program.T {globals, datatypes, functions, main}) = 
    let
       val shrink = shrinkFunction {globals = globals}
-	 
+         
       local 
-	 fun make transfer = let
-				val l = Label.newNoname ()
-			     in
-				Block.T {label = l,
-					 args = Vector.new0 (),
-					 statements = Vector.new0 (),
-					 transfer = transfer}
-			     end
+         fun make transfer = let
+                                val l = Label.newNoname ()
+                             in
+                                Block.T {label = l,
+                                         args = Vector.new0 (),
+                                         statements = Vector.new0 (),
+                                         transfer = transfer}
+                             end
       in
-	 fun makeRaise var = make (Raise (Vector.new1 var))
-	 fun makeReturn var = make (Return (Vector.new1 var))
-	 fun makeGoto (dst, var) = make (Goto {dst = dst, args = Vector.new1 var})
+         fun makeRaise var = make (Raise (Vector.new1 var))
+         fun makeReturn var = make (Return (Vector.new1 var))
+         fun makeGoto (dst, var) = make (Goto {dst = dst, args = Vector.new1 var})
       end
       fun makeNullaryGoto dst = Goto {dst = dst, args = Vector.new0 ()}
-	 
+         
       val {get = varInfo: 
-	   Var.t -> {returner: (Func.t * Label.t) option ref,
-		     raiser: (Func.t * Label.t) option ref,
-		     gotoers: (Func.t * (Label.t * Label.t) list ref) option ref} option,
-	   set = setVarInfo, ...} =
-	 Property.getSetOnce
-	 (Var.plist, Property.initConst NONE)
+           Var.t -> {returner: (Func.t * Label.t) option ref,
+                     raiser: (Func.t * Label.t) option ref,
+                     gotoers: (Func.t * (Label.t * Label.t) list ref) option ref} option,
+           set = setVarInfo, ...} =
+         Property.getSetOnce
+         (Var.plist, Property.initConst NONE)
 
       val _ = 
-	 Vector.foreach
-	 (globals, fn Statement.T {var, ...} => 
-	  setVarInfo(valOf var, SOME {returner = ref NONE, 
-				      raiser = ref NONE,
-				      gotoers = ref NONE}))
+         Vector.foreach
+         (globals, fn Statement.T {var, ...} => 
+          setVarInfo(valOf var, SOME {returner = ref NONE, 
+                                      raiser = ref NONE,
+                                      gotoers = ref NONE}))
 
       fun eliminateFunction f = 
-	 let
-	    val {args, blocks, mayInline, name, returns, raises, start} =
-	       Function.dest f
-	    val newBlocks = ref []
-	    local
-	       fun common (sel, make) var = 
-		  case varInfo var of 
-		     NONE => NONE
-		   | SOME varInfo => 
-			let
-			   val c = sel varInfo
-			      
-			   fun install () = 
-			      let
-				 val b = make var
-				 val l = Block.label b
-			      in
-				 List.push(newBlocks, b) ;
-				 c := SOME (name, l) ;
-				 SOME l
-			      end
-			in
-			   case !c of 
-			      NONE => install ()
-			    | SOME (name', l') => 
-				 if Func.equals(name, name')
-				    then SOME l'
-				    else install ()
-			end
-	    in
-	       val commonReturner = common (#returner, makeReturn)
-	       val commonRaiser = common (#raiser, makeRaise)
-	    end
-	    fun commonGotoers (k, var) = 
-	       case varInfo var of 
-		  NONE => NONE
-		| SOME {gotoers, ...} => 
-		     let
-			fun install info = 
-			   let
-			      val b = makeGoto (k, var)
-			      val l = Block.label b
-			   in
-			      List.push(newBlocks, b) ;
-			      List.push(info, (k, l)) ;
-			      SOME l
-			   end
-			fun install' () = 
-			   let
-			      val info = ref []
-			   in 
-			      gotoers := SOME (name, info);
-			      install info
-			   end
-		     in
-			case !gotoers of 
-			   NONE => install' ()
-			 | SOME (name', info') => 
-			      if Func.equals(name, name')
-				 then case List.peek (!info', fn (k', _) => 
-						      Label.equals(k', k)) of 
-				         NONE => install info'
-				       | SOME (_, l') => SOME l'
-				 else install' ()
-		     end
-		  
-	    val blocks = 
-	       Vector.map
-	       (blocks, fn Block.T {label, args, statements, transfer} =>
-		let
-		   val doit = fn SOME l => makeNullaryGoto l
-		               | NONE => transfer
-		   val transfer = 
-		      if Vector.length statements = 0
-			 then case transfer of 
-			         Goto {dst, args = xs} => 
-				    if Vector.length xs = 1
-				       then doit (commonGotoers 
-						  (dst, Vector.sub(xs, 0)))
-				       else transfer
-			       | Return xs => 
-				    if Vector.length xs = 1
-				       then doit (commonReturner 
-						  (Vector.sub(xs, 0)))
-				       else transfer
-			       | Raise xs => 
-				    if Vector.length xs = 1
-				       then doit (commonRaiser
-						  (Vector.sub (xs, 0)))
-				       else transfer
-			       | _ => transfer
-			 else transfer
-		in
-		   Block.T {label = label,
-			    args = args,
-			    statements = statements,
-			    transfer = transfer}
-		end)
-	    val blocks = Vector.concat [Vector.fromList (!newBlocks), blocks]
-	 in
-	    shrink (Function.new {args = args,
-				  blocks = blocks,
-				  mayInline = mayInline,
-				  name = name,
-				  raises = raises,
-				  returns = returns,
-				  start = start})
-	 end
+         let
+            val {args, blocks, mayInline, name, returns, raises, start} =
+               Function.dest f
+            val newBlocks = ref []
+            local
+               fun common (sel, make) var = 
+                  case varInfo var of 
+                     NONE => NONE
+                   | SOME varInfo => 
+                        let
+                           val c = sel varInfo
+                              
+                           fun install () = 
+                              let
+                                 val b = make var
+                                 val l = Block.label b
+                              in
+                                 List.push(newBlocks, b) ;
+                                 c := SOME (name, l) ;
+                                 SOME l
+                              end
+                        in
+                           case !c of 
+                              NONE => install ()
+                            | SOME (name', l') => 
+                                 if Func.equals(name, name')
+                                    then SOME l'
+                                    else install ()
+                        end
+            in
+               val commonReturner = common (#returner, makeReturn)
+               val commonRaiser = common (#raiser, makeRaise)
+            end
+            fun commonGotoers (k, var) = 
+               case varInfo var of 
+                  NONE => NONE
+                | SOME {gotoers, ...} => 
+                     let
+                        fun install info = 
+                           let
+                              val b = makeGoto (k, var)
+                              val l = Block.label b
+                           in
+                              List.push(newBlocks, b) ;
+                              List.push(info, (k, l)) ;
+                              SOME l
+                           end
+                        fun install' () = 
+                           let
+                              val info = ref []
+                           in 
+                              gotoers := SOME (name, info);
+                              install info
+                           end
+                     in
+                        case !gotoers of 
+                           NONE => install' ()
+                         | SOME (name', info') => 
+                              if Func.equals(name, name')
+                                 then case List.peek (!info', fn (k', _) => 
+                                                      Label.equals(k', k)) of 
+                                         NONE => install info'
+                                       | SOME (_, l') => SOME l'
+                                 else install' ()
+                     end
+                  
+            val blocks = 
+               Vector.map
+               (blocks, fn Block.T {label, args, statements, transfer} =>
+                let
+                   val doit = fn SOME l => makeNullaryGoto l
+                               | NONE => transfer
+                   val transfer = 
+                      if Vector.length statements = 0
+                         then case transfer of 
+                                 Goto {dst, args = xs} => 
+                                    if Vector.length xs = 1
+                                       then doit (commonGotoers 
+                                                  (dst, Vector.sub(xs, 0)))
+                                       else transfer
+                               | Return xs => 
+                                    if Vector.length xs = 1
+                                       then doit (commonReturner 
+                                                  (Vector.sub(xs, 0)))
+                                       else transfer
+                               | Raise xs => 
+                                    if Vector.length xs = 1
+                                       then doit (commonRaiser
+                                                  (Vector.sub (xs, 0)))
+                                       else transfer
+                               | _ => transfer
+                         else transfer
+                in
+                   Block.T {label = label,
+                            args = args,
+                            statements = statements,
+                            transfer = transfer}
+                end)
+            val blocks = Vector.concat [Vector.fromList (!newBlocks), blocks]
+         in
+            shrink (Function.new {args = args,
+                                  blocks = blocks,
+                                  mayInline = mayInline,
+                                  name = name,
+                                  raises = raises,
+                                  returns = returns,
+                                  start = start})
+         end
       
       val program = 
-	 Program.T {datatypes = datatypes,
-		    globals = globals,
-		    functions = List.revMap (functions, eliminateFunction),
-		    main = main}
+         Program.T {datatypes = datatypes,
+                    globals = globals,
+                    functions = List.revMap (functions, eliminateFunction),
+                    main = main}
       val _ = Program.clearTop program
    in
       program

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ssa/common-block.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ssa/common-block.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ssa/common-block.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature COMMON_BLOCK_STRUCTS = 
    sig
       include SHRINK

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ssa/common-subexp.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ssa/common-subexp.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ssa/common-subexp.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 functor CommonSubexp (S: COMMON_SUBEXP_STRUCTS): COMMON_SUBEXP = 
 struct
 
@@ -21,342 +22,342 @@
        * arguments, and in-degree of blocks. 
        *)
       val {get = labelInfo: Label.t -> {add: (Var.t * Exp.t) list ref,
-					args: (Var.t * Type.t) vector,
-					inDeg: int ref},
-	   set = setLabelInfo, ...} =
-	 Property.getSetOnce (Label.plist,
-			      Property.initRaise ("info", Label.layout))
+                                        args: (Var.t * Type.t) vector,
+                                        inDeg: int ref},
+           set = setLabelInfo, ...} =
+         Property.getSetOnce (Label.plist,
+                              Property.initRaise ("info", Label.layout))
       (* Keep track of variables used as overflow variables. *)
       val {get = overflowVar: Var.t -> bool, set = setOverflowVar, ...} =
-	 Property.getSetOnce (Var.plist, Property.initConst false)
+         Property.getSetOnce (Var.plist, Property.initConst false)
       (* Keep track of the replacements of variables. *)
       val {get = replace: Var.t -> Var.t option, set = setReplace, ...} =
-	 Property.getSetOnce (Var.plist, Property.initConst NONE)
+         Property.getSetOnce (Var.plist, Property.initConst NONE)
       (* Keep track of the variable that holds the length of arrays (and
        * vectors and strings).
        *) 
       val {get = getLength: Var.t -> Var.t option, set = setLength, ...} =
-	 Property.getSetOnce (Var.plist, Property.initConst NONE)
+         Property.getSetOnce (Var.plist, Property.initConst NONE)
       fun canonVar x =
-	 case replace x of
-	    NONE => x
-	  | SOME y => y
+         case replace x of
+            NONE => x
+          | SOME y => y
       fun canonVars xs = Vector.map (xs, canonVar)
       (* Canonicalize an Exp.
        * Replace vars with their replacements.
        * Put commutative arguments in canonical order.
        *)
       fun canon (e: Exp.t): Exp.t =
-	 case e of
-	    ConApp {con, args} =>
-	       ConApp {con = con, args = canonVars args}
-	  | Const _ => e
-	  | PrimApp {prim, targs, args} =>
-	       let
-		  fun doit args = 
-		     PrimApp {prim = prim, 
-			      targs = targs,
-			      args = args}
-		  val args = canonVars args
-		  fun arg i = Vector.sub (args, i)
-		  fun canon2 () =
-		     let
-			val a0 = arg 0
-			val a1 = arg 1
-		     in
-			(* What we really want is a total orderning on
-			 * variables.  Since we don't have one, we just use
-			 * the total ordering on hashes, which means that
-			 * we may miss a few cse's but we won't be wrong.
-			 *)
-			if Var.hash a0 <= Var.hash a1
-			   then (a0, a1)
-			else (a1, a0)
-		     end
-		  datatype z = datatype Prim.Name.t
-	       in
-		  if Prim.isCommutative prim
-		     then doit (Vector.new2 (canon2 ()))
-		  else
-		     if (case Prim.name prim of
-			    IntInf_add => true
-			  | IntInf_andb => true
-			  | IntInf_mul => true
-			  | IntInf_orb => true
-			  | IntInf_xorb => true
-			  | _ => false)
-			then
-			   let 
-			      val (a0, a1) = canon2 ()
-			   in doit (Vector.new3 (a0, a1, arg 2))
-			   end
-		     else doit args
-	       end
-	  | Select {tuple, offset} => Select {tuple = canonVar tuple,
-					      offset = offset}
-	  | Tuple xs => Tuple (canonVars xs)
-	  | Var x => Var (canonVar x)
-	  | _ => e
+         case e of
+            ConApp {con, args} =>
+               ConApp {con = con, args = canonVars args}
+          | Const _ => e
+          | PrimApp {prim, targs, args} =>
+               let
+                  fun doit args = 
+                     PrimApp {prim = prim, 
+                              targs = targs,
+                              args = args}
+                  val args = canonVars args
+                  fun arg i = Vector.sub (args, i)
+                  fun canon2 () =
+                     let
+                        val a0 = arg 0
+                        val a1 = arg 1
+                     in
+                        (* What we really want is a total orderning on
+                         * variables.  Since we don't have one, we just use
+                         * the total ordering on hashes, which means that
+                         * we may miss a few cse's but we won't be wrong.
+                         *)
+                        if Var.hash a0 <= Var.hash a1
+                           then (a0, a1)
+                        else (a1, a0)
+                     end
+                  datatype z = datatype Prim.Name.t
+               in
+                  if Prim.isCommutative prim
+                     then doit (Vector.new2 (canon2 ()))
+                  else
+                     if (case Prim.name prim of
+                            IntInf_add => true
+                          | IntInf_andb => true
+                          | IntInf_mul => true
+                          | IntInf_orb => true
+                          | IntInf_xorb => true
+                          | _ => false)
+                        then
+                           let 
+                              val (a0, a1) = canon2 ()
+                           in doit (Vector.new3 (a0, a1, arg 2))
+                           end
+                     else doit args
+               end
+          | Select {tuple, offset} => Select {tuple = canonVar tuple,
+                                              offset = offset}
+          | Tuple xs => Tuple (canonVars xs)
+          | Var x => Var (canonVar x)
+          | _ => e
 
       (* Keep a hash table of canonicalized Exps that are in scope. *)
       val table: {hash: word, exp: Exp.t, var: Var.t} HashSet.t =
-	 HashSet.new {hash = #hash}
+         HashSet.new {hash = #hash}
       fun lookup (var, exp, hash) =
-	 HashSet.lookupOrInsert
-	 (table, hash, 
-	  fn {exp = exp', ...} => Exp.equals (exp, exp'),
-	  fn () => {exp = exp,
-		    hash = hash,
-		    var = var})
-	 
+         HashSet.lookupOrInsert
+         (table, hash, 
+          fn {exp = exp', ...} => Exp.equals (exp, exp'),
+          fn () => {exp = exp,
+                    hash = hash,
+                    var = var})
+         
       (* All of the globals are in scope, and never go out of scope. *)
       (* The hash-cons'ing of globals in ConstantPropagation ensures
        *  that each global is unique.
        *)
       val _ = 
-	 Vector.foreach
-	 (globals, fn Statement.T {var, exp, ...} => 
-	  let
-	     val exp = canon exp
-	     val _ = lookup (valOf var, exp, Exp.hash exp)
-	  in
-	     ()
-	  end)
+         Vector.foreach
+         (globals, fn Statement.T {var, exp, ...} => 
+          let
+             val exp = canon exp
+             val _ = lookup (valOf var, exp, Exp.hash exp)
+          in
+             ()
+          end)
 
       fun doitTree tree =
-	 let
-	    val blocks = ref []
-	    fun loop (Tree.T (Block.T {args, label,
-				       statements, transfer},
-			      children)): unit =
-	       let
-		 fun diag s =
-		   Control.diagnostics
-		   (fn display =>
-		    let open Layout
-		    in
-		      display (seq [Label.layout label, str ": ", str s])
-		    end)
-		  val _ = diag "started"
-		  val removes = ref []
-		  val {add, ...} = labelInfo label
-		  val _ = List.foreach
-		          (!add, fn (var, exp) =>
-			   let
-			     val hash = Exp.hash exp
-			     val elem as {var = var', ...} = lookup (var, exp, hash)
-			     val _ = if Var.equals(var, var')
-				       then List.push (removes, elem)
-				       else ()
-			   in
-			     ()
-			   end)
-		  val _ = diag "added"
+         let
+            val blocks = ref []
+            fun loop (Tree.T (Block.T {args, label,
+                                       statements, transfer},
+                              children)): unit =
+               let
+                 fun diag s =
+                   Control.diagnostics
+                   (fn display =>
+                    let open Layout
+                    in
+                      display (seq [Label.layout label, str ": ", str s])
+                    end)
+                  val _ = diag "started"
+                  val removes = ref []
+                  val {add, ...} = labelInfo label
+                  val _ = List.foreach
+                          (!add, fn (var, exp) =>
+                           let
+                             val hash = Exp.hash exp
+                             val elem as {var = var', ...} = lookup (var, exp, hash)
+                             val _ = if Var.equals(var, var')
+                                       then List.push (removes, elem)
+                                       else ()
+                           in
+                             ()
+                           end)
+                  val _ = diag "added"
 
-		  val statements =
-		     Vector.keepAllMap
-		     (statements,
-		      fn Statement.T {var, ty, exp} =>
-		      let
-			 val exp = canon exp
-			 fun keep () = SOME (Statement.T {var = var,
-							  ty = ty,
-							  exp = exp})
-		      in
-			 case var of
-			    NONE => keep ()
-			  | SOME var => 
-			       let
-				  fun replace var' =
-				     (setReplace (var, SOME var'); NONE)
-				  fun doit () =
-				     let
-				        val hash = Exp.hash exp
-					val elem as {var = var', ...} = 
-					   lookup (var, exp, hash)
-				     in
-				        if Var.equals(var, var')
-					  then (List.push (removes, elem)
-						; keep ())
-					  else replace var'
-				     end
-			       in
-				  case exp of
-				     PrimApp ({args, prim, ...}) =>
-				        let
-					   fun arg () = Vector.sub (args, 0)
-					   fun knownLength var' =
-					      let
-						 val _ = setLength (var, SOME var')
-					      in
-						 keep ()
-					      end
-					   fun conv () =
-					      case getLength (arg ()) of
-						 NONE => keep ()
-					       | SOME var' => knownLength var'
-					   fun length () =
-					      case getLength (arg ()) of
-						 NONE => doit ()
-					       | SOME var' => replace var'
-					   datatype z = datatype Prim.Name.t
-					in
-					   case Prim.name prim of
-					      Array_array => knownLength (arg ())
-					    | Array_length => length ()
-					    | Array_toVector => conv ()
-					    | Vector_length => length ()
-					    | _ => if Prim.isFunctional prim
-						      then doit ()
-						   else keep ()
-					end
-				   | _ => doit ()
-			       end
-		      end)
-		  val _ = diag "statements"
-		  val transfer = Transfer.replaceVar (transfer, canonVar)
-		  val transfer =
-		     case transfer of 
-		        Arith {prim, args, overflow, success, ...} =>
+                  val statements =
+                     Vector.keepAllMap
+                     (statements,
+                      fn Statement.T {var, ty, exp} =>
+                      let
+                         val exp = canon exp
+                         fun keep () = SOME (Statement.T {var = var,
+                                                          ty = ty,
+                                                          exp = exp})
+                      in
+                         case var of
+                            NONE => keep ()
+                          | SOME var => 
+                               let
+                                  fun replace var' =
+                                     (setReplace (var, SOME var'); NONE)
+                                  fun doit () =
+                                     let
+                                        val hash = Exp.hash exp
+                                        val elem as {var = var', ...} = 
+                                           lookup (var, exp, hash)
+                                     in
+                                        if Var.equals(var, var')
+                                          then (List.push (removes, elem)
+                                                ; keep ())
+                                          else replace var'
+                                     end
+                               in
+                                  case exp of
+                                     PrimApp ({args, prim, ...}) =>
+                                        let
+                                           fun arg () = Vector.sub (args, 0)
+                                           fun knownLength var' =
+                                              let
+                                                 val _ = setLength (var, SOME var')
+                                              in
+                                                 keep ()
+                                              end
+                                           fun conv () =
+                                              case getLength (arg ()) of
+                                                 NONE => keep ()
+                                               | SOME var' => knownLength var'
+                                           fun length () =
+                                              case getLength (arg ()) of
+                                                 NONE => doit ()
+                                               | SOME var' => replace var'
+                                           datatype z = datatype Prim.Name.t
+                                        in
+                                           case Prim.name prim of
+                                              Array_array => knownLength (arg ())
+                                            | Array_length => length ()
+                                            | Array_toVector => conv ()
+                                            | Vector_length => length ()
+                                            | _ => if Prim.isFunctional prim
+                                                      then doit ()
+                                                   else keep ()
+                                        end
+                                   | _ => doit ()
+                               end
+                      end)
+                  val _ = diag "statements"
+                  val transfer = Transfer.replaceVar (transfer, canonVar)
+                  val transfer =
+                     case transfer of 
+                        Arith {prim, args, overflow, success, ...} =>
                            let
-			      val {args = succArgs,
-				   inDeg = succInDeg,
-				   add = succAdd, ...} = 
-				 labelInfo success
-			      val {inDeg = overInDeg, add = overAdd, ...} =
-				 labelInfo overflow
-			      val exp = canon (PrimApp {prim = prim,
-							targs = Vector.new0 (),
-							args = args})
-			      val hash = Exp.hash exp
-			   in
-			      case HashSet.peek
-				   (table, hash,
-				    fn {exp = exp', ...} => Exp.equals (exp, exp')) of
-				 SOME {var, ...} =>
-				    if overflowVar var
-				       then Goto {dst = overflow,
-						  args = Vector.new0 ()}
-				    else (if !succInDeg = 1
-					     then let
-						     val (var', _) =
-						        Vector.sub (succArgs, 0)
-						  in 
-						     setReplace (var', SOME var)
-						  end
-					  else ()
-					  ; Goto {dst = success,
-						  args = Vector.new1 var})
-			       | NONE => (if !succInDeg = 1
-					     then let
-						     val (var, _) =
-						        Vector.sub (succArgs, 0)
-						  in 
-						     List.push
-						     (succAdd, (var, exp))
-						  end
-					  else () ;
-					  if !overInDeg = 1
-					     then let
-						     val var = Var.newNoname ()
-						     val _ = setOverflowVar (var, true)
-						  in
-						     List.push
-						     (overAdd, (var, exp))
-						  end
-					  else () ;
-					  transfer)
-			   end
-		      | Goto {dst, args} =>
-			   let
-			      val {args = args', inDeg, ...} = labelInfo dst
-			   in
-			      if !inDeg = 1
-				 then (Vector.foreach2
-				       (args, args', fn (var, (var', _)) =>
-					setReplace (var', SOME var))
-				       ; transfer)
-			      else transfer
-			   end
-		      | _ => transfer
-		  val _ = diag "transfer"
-		  val block = Block.T {args = args,
-				       label = label,
-				       statements = statements,
-				       transfer = transfer}
-	       in
-		  List.push (blocks, block) ;
-		  Vector.foreach (children, loop) ;
-		  diag "children";
-		  Control.diagnostics
-		  (fn display =>
-		   let open Layout
-		   in
-		     display (seq [str "removes: ",
-				   List.layout (fn {var,exp,...} => 
-						seq [Var.layout var,
-						     str ": ",
-						     Exp.layout exp]) (!removes)])
-		   end);
-		  List.foreach 
-		  (!removes, fn {var, exp, hash} =>
-		   HashSet.remove
-		   (table, hash, fn {var = var', exp = exp', ...} =>
-		    Var.equals (var, var') andalso 
-		    Exp.equals (exp, exp')));
-		  diag "removed"
-	       end
-	    val _ =
-	      Control.diagnostics
-	      (fn display =>
-	       let open Layout
-	       in
-		 display (seq [str "starting loop"])
-	       end)
-	    val _ = loop tree
-	    val _ =
-	      Control.diagnostics
-	      (fn display =>
-	       let open Layout
-	       in
-		 display (seq [str "finished loop"])
-	       end)
-	 in
-	    Vector.fromList (!blocks)
-	 end
+                              val {args = succArgs,
+                                   inDeg = succInDeg,
+                                   add = succAdd, ...} = 
+                                 labelInfo success
+                              val {inDeg = overInDeg, add = overAdd, ...} =
+                                 labelInfo overflow
+                              val exp = canon (PrimApp {prim = prim,
+                                                        targs = Vector.new0 (),
+                                                        args = args})
+                              val hash = Exp.hash exp
+                           in
+                              case HashSet.peek
+                                   (table, hash,
+                                    fn {exp = exp', ...} => Exp.equals (exp, exp')) of
+                                 SOME {var, ...} =>
+                                    if overflowVar var
+                                       then Goto {dst = overflow,
+                                                  args = Vector.new0 ()}
+                                    else (if !succInDeg = 1
+                                             then let
+                                                     val (var', _) =
+                                                        Vector.sub (succArgs, 0)
+                                                  in 
+                                                     setReplace (var', SOME var)
+                                                  end
+                                          else ()
+                                          ; Goto {dst = success,
+                                                  args = Vector.new1 var})
+                               | NONE => (if !succInDeg = 1
+                                             then let
+                                                     val (var, _) =
+                                                        Vector.sub (succArgs, 0)
+                                                  in 
+                                                     List.push
+                                                     (succAdd, (var, exp))
+                                                  end
+                                          else () ;
+                                          if !overInDeg = 1
+                                             then let
+                                                     val var = Var.newNoname ()
+                                                     val _ = setOverflowVar (var, true)
+                                                  in
+                                                     List.push
+                                                     (overAdd, (var, exp))
+                                                  end
+                                          else () ;
+                                          transfer)
+                           end
+                      | Goto {dst, args} =>
+                           let
+                              val {args = args', inDeg, ...} = labelInfo dst
+                           in
+                              if !inDeg = 1
+                                 then (Vector.foreach2
+                                       (args, args', fn (var, (var', _)) =>
+                                        setReplace (var', SOME var))
+                                       ; transfer)
+                              else transfer
+                           end
+                      | _ => transfer
+                  val _ = diag "transfer"
+                  val block = Block.T {args = args,
+                                       label = label,
+                                       statements = statements,
+                                       transfer = transfer}
+               in
+                  List.push (blocks, block) ;
+                  Vector.foreach (children, loop) ;
+                  diag "children";
+                  Control.diagnostics
+                  (fn display =>
+                   let open Layout
+                   in
+                     display (seq [str "removes: ",
+                                   List.layout (fn {var,exp,...} => 
+                                                seq [Var.layout var,
+                                                     str ": ",
+                                                     Exp.layout exp]) (!removes)])
+                   end);
+                  List.foreach 
+                  (!removes, fn {var, exp, hash} =>
+                   HashSet.remove
+                   (table, hash, fn {var = var', exp = exp', ...} =>
+                    Var.equals (var, var') andalso 
+                    Exp.equals (exp, exp')));
+                  diag "removed"
+               end
+            val _ =
+              Control.diagnostics
+              (fn display =>
+               let open Layout
+               in
+                 display (seq [str "starting loop"])
+               end)
+            val _ = loop tree
+            val _ =
+              Control.diagnostics
+              (fn display =>
+               let open Layout
+               in
+                 display (seq [str "finished loop"])
+               end)
+         in
+            Vector.fromList (!blocks)
+         end
       val shrink = shrinkFunction {globals = globals}
       val functions =
-	 List.revMap
-	 (functions, fn f => 
-	  let
-	     val {args, blocks, mayInline, name, raises, returns, start} =
-		Function.dest f
-	     val _ =
-		Vector.foreach
-		(blocks, fn Block.T {label, args, ...} =>
-		 (setLabelInfo (label, {add = ref [],
-					args = args,
-					inDeg = ref 0})))
-	     val _ =
-		Vector.foreach
-		(blocks, fn Block.T {transfer, ...} =>
-		 Transfer.foreachLabel (transfer, fn label' => 
-					Int.inc (#inDeg (labelInfo label'))))
-	     val blocks = doitTree (Function.dominatorTree f)
-	  in
-	     shrink (Function.new {args = args,
-				   blocks = blocks,
-				   mayInline = mayInline,
-				   name = name,
-				   raises = raises,
-				   returns = returns,
-				   start = start})
-	  end)
+         List.revMap
+         (functions, fn f => 
+          let
+             val {args, blocks, mayInline, name, raises, returns, start} =
+                Function.dest f
+             val _ =
+                Vector.foreach
+                (blocks, fn Block.T {label, args, ...} =>
+                 (setLabelInfo (label, {add = ref [],
+                                        args = args,
+                                        inDeg = ref 0})))
+             val _ =
+                Vector.foreach
+                (blocks, fn Block.T {transfer, ...} =>
+                 Transfer.foreachLabel (transfer, fn label' => 
+                                        Int.inc (#inDeg (labelInfo label'))))
+             val blocks = doitTree (Function.dominatorTree f)
+          in
+             shrink (Function.new {args = args,
+                                   blocks = blocks,
+                                   mayInline = mayInline,
+                                   name = name,
+                                   raises = raises,
+                                   returns = returns,
+                                   start = start})
+          end)
       val program = 
-	 Program.T {datatypes = datatypes,
-		    globals = globals,
-		    functions = functions,
-		    main = main}
+         Program.T {datatypes = datatypes,
+                    globals = globals,
+                    functions = functions,
+                    main = main}
       val _ = Program.clearTop program
    in
       program

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ssa/common-subexp.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ssa/common-subexp.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ssa/common-subexp.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature COMMON_SUBEXP_STRUCTS = 
    sig
       include SHRINK

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ssa/constant-propagation.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ssa/constant-propagation.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ssa/constant-propagation.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 (*
  * Invariant: Created globals only refer to other globals.
  *            Hence, the newly created globals may appear at the
@@ -31,13 +32,13 @@
       open Type
 
       fun isSmall t =
-	 case dest t of
-	    Array _ => false
-	  | Datatype _ => false
-	  | Ref t => isSmall t
-	  | Tuple ts => Vector.forall (ts, isSmall)
-	  | Vector _ => false
-	  | _ => true
+         case dest t of
+            Array _ => false
+          | Datatype _ => false
+          | Ref t => isSmall t
+          | Tuple ts => Vector.forall (ts, isSmall)
+          | Vector _ => false
+          | _ => true
    end
 
 structure Sconst = Const
@@ -46,552 +47,579 @@
 structure Value =
    struct
       datatype global =
-	 NotComputed
+         NotComputed
        | No
        | Yes of Var.t
 
       structure Const =
-	 struct
-	    datatype t = T of {const: const ref,
-			       coercedTo: t list ref}
-	    and const =
-	       Const of Const.t
-	      | Undefined (* no possible value *)
-	      | Unknown (* many possible values *)
+         struct
+            datatype t = T of {const: const ref,
+                               coercedTo: t list ref}
+            and const =
+               Const of Const.t
+              | Undefined (* no possible value *)
+              | Unknown (* many possible values *)
 
-	    fun layout (T {const, ...}) = layoutConst (!const)
-	    and layoutConst c =
-	       let
-		  open Layout
-	       in
-		  case c of
-		     Const c => Const.layout c
-		   | Undefined => str "undefined constant"
-		   | Unknown => str "unknown constant"
-	       end
+            fun layout (T {const, ...}) = layoutConst (!const)
+            and layoutConst c =
+               let
+                  open Layout
+               in
+                  case c of
+                     Const c => Const.layout c
+                   | Undefined => str "undefined constant"
+                   | Unknown => str "unknown constant"
+               end
 
-	    fun new c = T {const = ref c,
-			   coercedTo = ref []}
+            fun new c = T {const = ref c,
+                           coercedTo = ref []}
 
-	    fun equals (T {const = r, ...}, T {const = r', ...}) = r = r'
+            fun equals (T {const = r, ...}, T {const = r', ...}) = r = r'
 
-	    val equals =
-	       Trace.trace2 ("Const.equals", layout, layout, Bool.layout) equals
+            val equals =
+               Trace.trace2 
+               ("ConstantPropagation.Value.Const.equals", 
+                layout, layout, Bool.layout) 
+               equals
 
-	    val const = new o Const
+            val const = new o Const
 
-	    fun undefined () = new Undefined
+            fun undefined () = new Undefined
 
-	    fun unknown () = new Unknown
+            fun unknown () = new Unknown
     
-	    fun makeUnknown (T {const, coercedTo}): unit =
-	       case !const of
-		  Unknown => ()
-		| _ => (const := Unknown
-			; List.foreach (!coercedTo, makeUnknown)
-			; coercedTo := [])
+            fun makeUnknown (T {const, coercedTo}): unit =
+               case !const of
+                  Unknown => ()
+                | _ => (const := Unknown
+                        ; List.foreach (!coercedTo, makeUnknown)
+                        ; coercedTo := [])
 
-	    val makeUnknown =
-	       Trace.trace ("Const.makeUnknown", layout, Unit.layout) makeUnknown
+            val makeUnknown =
+               Trace.trace 
+               ("ConstantPropagation.Value.Const.makeUnknown", 
+                layout, Unit.layout) 
+               makeUnknown
 
-	    fun send (c: t, c': const): unit =
-	       let
-		  fun loop (c as T {const, coercedTo}) =
-		     case (c', !const) of
-			(_, Unknown) => ()
-		      | (_, Undefined) => (const := c'
-					   ; List.foreach (!coercedTo, loop))
-		      | (Const c', Const c'') =>
-			   if Const.equals (c', c'')
-			      then ()
-			   else makeUnknown c
-		      | _ => makeUnknown c
-	       in
-		  loop c
-	       end
+            fun send (c: t, c': const): unit =
+               let
+                  fun loop (c as T {const, coercedTo}) =
+                     case (c', !const) of
+                        (_, Unknown) => ()
+                      | (_, Undefined) => (const := c'
+                                           ; List.foreach (!coercedTo, loop))
+                      | (Const c', Const c'') =>
+                           if Const.equals (c', c'')
+                              then ()
+                           else makeUnknown c
+                      | _ => makeUnknown c
+               in
+                  loop c
+               end
 
-	    val send =
-	       Trace.trace2 ("Const.send", layout, layoutConst, Unit.layout) send
+            val send =
+               Trace.trace2 
+               ("ConstantPropagation.Value.Const.send", 
+                layout, layoutConst, Unit.layout) 
+               send
 
-	    fun coerce {from = from as T {const, coercedTo}, to: t}: unit =
-	       if equals (from, to)
-		  then ()
-	       else
-		  let
-		     fun push () = List.push (coercedTo, to)
-		  in
-		     case !const of
-			c as Const _ => (push (); send (to, c))
-		      | Undefined => push ()
-		      | Unknown => makeUnknown to
-		  end
+            fun coerce {from = from as T {const, coercedTo}, to: t}: unit =
+               if equals (from, to)
+                  then ()
+               else
+                  let
+                     fun push () = List.push (coercedTo, to)
+                  in
+                     case !const of
+                        c as Const _ => (push (); send (to, c))
+                      | Undefined => push ()
+                      | Unknown => makeUnknown to
+                  end
 
-	    val coerce =
-	       Trace.trace
-	       ("Const.coerce",
-		fn {from, to} => Layout.record [("from", layout from),
-						("to", layout to)],
-		Unit.layout)
-	       coerce
+            val coerce =
+               Trace.trace
+               ("ConstantPropagation.Value.Const.coerce",
+                fn {from, to} => Layout.record [("from", layout from),
+                                                ("to", layout to)],
+                Unit.layout)
+               coerce
 
-	    fun unify (c, c') =
-	       (coerce {from = c, to = c'}
-		; coerce {from = c', to = c})
+            fun unify (c, c') =
+               (coerce {from = c, to = c'}
+                ; coerce {from = c', to = c})
 
-	    val unify =
-	       Trace.trace2 ("Const.unify", layout, layout, Unit.layout) unify
-	 end
+            val unify =
+               Trace.trace2 
+               ("ConstantPropagation.Value.Const.unify", 
+                layout, layout, Unit.layout) 
+               unify
+         end
 
       structure One =
-	 struct
-	    datatype 'a t = T of {extra: 'a,
-				  global: Var.t option ref}
+         struct
+            datatype 'a t = T of {extra: 'a,
+                                  global: Var.t option ref}
 
-	    local
-	       fun make f (T r) = f r
-	    in
-	       val global = fn z => make #global z
-	    end
+            local
+               fun make f (T r) = f r
+            in
+               val global = fn z => make #global z
+            end
 
-	    fun layout (one: 'a t): Layout.t =
-	       Layout.record
-	       [("global", Option.layout Var.layout (! (global one)))]
+            fun layout (one: 'a t): Layout.t =
+               Layout.record
+               [("global", Option.layout Var.layout (! (global one)))]
 
-	    fun new (a: 'a): 'a t = T {extra = a,
-				       global = ref NONE}
+            fun new (a: 'a): 'a t = T {extra = a,
+                                       global = ref NONE}
 
-	    val equals: 'a t * 'a t -> bool = 
-	       fn (n, n') => global n = global n'
-	 end
+            val equals: 'a t * 'a t -> bool = 
+               fn (n, n') => global n = global n'
+         end
       
       structure Place =
-	 struct
-	    datatype 'a t =
-	       One of 'a One.t
-	     | Undefined
-	     | Unknown
+         struct
+            datatype 'a t =
+               One of 'a One.t
+             | Undefined
+             | Unknown
 
-	    val toString =
-	       fn One _ => "One"
-		| Undefined => "Undefined"
-		| Unknown => "Unknown"
+            val toString =
+               fn One _ => "One"
+                | Undefined => "Undefined"
+                | Unknown => "Unknown"
 
-	    fun layout b = Layout.str (toString b)
-	 end
+            fun layout b = Layout.str (toString b)
+         end
 
       structure Birth =
-	 struct
-	    datatype 'a t = T of {coercedTo: 'a t list ref,
-				  place: 'a Place.t ref}
+         struct
+            datatype 'a t = T of {coercedTo: 'a t list ref,
+                                  place: 'a Place.t ref}
 
-	    fun layout (T {place, ...}) = Place.layout (!place)
+            fun layout (T {place, ...}) = Place.layout (!place)
 
-	    fun equals (T {place = r, ...}, T {place = r', ...}) = r = r'
+            fun equals (T {place = r, ...}, T {place = r', ...}) = r = r'
 
-	    fun new p = T {place = ref p,
-			   coercedTo = ref []}
+            fun new p = T {place = ref p,
+                           coercedTo = ref []}
 
-	    fun undefined (): 'a t = new Place.Undefined
-	    fun unknown (): 'a t = new Place.Unknown
-	    fun here (a: 'a): 'a t = new (Place.One (One.new a))
+            fun undefined (): 'a t = new Place.Undefined
+            fun unknown (): 'a t = new Place.Unknown
+            fun here (a: 'a): 'a t = new (Place.One (One.new a))
 
-	    val traceMakeUnknown = Trace.info "Birth.makeUnknown"
-	       
-	    fun makeUnknown arg =
-	       Trace.traceInfo'
-	       (traceMakeUnknown, layout, Unit.layout)
-	       (fn T {place, coercedTo, ...} =>
-		case !place of
-		   Place.Unknown => ()
-		 | _ => (place := Place.Unknown
-			 ; List.foreach (!coercedTo, makeUnknown)
-			 ; coercedTo := [])) arg
+            val traceMakeUnknown = 
+               Trace.info 
+               "ConstantPropagation.Value.Birth.makeUnknown"
+               
+            fun makeUnknown arg =
+               Trace.traceInfo'
+               (traceMakeUnknown, layout, Unit.layout)
+               (fn T {place, coercedTo, ...} =>
+                case !place of
+                   Place.Unknown => ()
+                 | _ => (place := Place.Unknown
+                         ; List.foreach (!coercedTo, makeUnknown)
+                         ; coercedTo := [])) arg
 
-	    val traceSend = Trace.info "Birth.send"
-	       
-	    fun send arg =
-	       Trace.traceInfo'
-	       (traceSend, Layout.tuple2 (layout, One.layout), Unit.layout)
-	       (fn (b, one) =>
-		let
-		   fun loop (b as T {place, coercedTo, ...}) =
-		      case !place of
-			 Place.Undefined => (place := Place.One one
-					     ; List.foreach (!coercedTo, loop))
-		       | Place.One one' => if One.equals (one, one')
-					      then ()
-					   else makeUnknown b
-		       | Place.Unknown => ()
-		in
-		   loop b
-		end) arg
-	
-	    val traceCoerce = Trace.info "Birth.coerce"
-	    fun coerce arg =
-	       Trace.traceInfo'
-	       (traceCoerce,
-		fn {from, to} => Layout.record [("from", layout from),
-						("to", layout to)],
-		Unit.layout)
-	       (fn {from = from as T {place, coercedTo, ...}, to} =>
-		if equals (from, to)
-		   then ()
-		else
-		   let
-		      fun push () = List.push (coercedTo, to)
-		   in
-		      case !place of
-			 Place.Unknown => makeUnknown to
-		       | Place.One one => (push (); send (to, one))
-		       | Place.Undefined => push ()
-		   end) arg
+            val traceSend = 
+               Trace.info 
+               "ConstantPropagation.Value.Birth.send"
+               
+            fun send arg =
+               Trace.traceInfo'
+               (traceSend, Layout.tuple2 (layout, One.layout), Unit.layout)
+               (fn (b, one) =>
+                let
+                   fun loop (b as T {place, coercedTo, ...}) =
+                      case !place of
+                         Place.Undefined => (place := Place.One one
+                                             ; List.foreach (!coercedTo, loop))
+                       | Place.One one' => if One.equals (one, one')
+                                              then ()
+                                           else makeUnknown b
+                       | Place.Unknown => ()
+                in
+                   loop b
+                end) arg
+        
+            val traceCoerce = 
+               Trace.info 
+               "ConstantPropagation.Value.Birth.coerce"
+            fun coerce arg =
+               Trace.traceInfo'
+               (traceCoerce,
+                fn {from, to} => Layout.record [("from", layout from),
+                                                ("to", layout to)],
+                Unit.layout)
+               (fn {from = from as T {place, coercedTo, ...}, to} =>
+                if equals (from, to)
+                   then ()
+                else
+                   let
+                      fun push () = List.push (coercedTo, to)
+                   in
+                      case !place of
+                         Place.Unknown => makeUnknown to
+                       | Place.One one => (push (); send (to, one))
+                       | Place.Undefined => push ()
+                   end) arg
 
-	    val traceUnify = Trace.info "Birth.unify"
-	       
-	    fun unify arg =
-	       Trace.traceInfo'
-	       (traceUnify, Layout.tuple2 (layout, layout), Unit.layout)
-	       (fn (c, c') =>
-		(coerce {from = c, to = c'}
-		 ; coerce {from = c', to = c})) arg
-	 end
+            val traceUnify = 
+               Trace.info 
+               "ConstantPropagation.Value.Birth.unify"
+               
+            fun unify arg =
+               Trace.traceInfo'
+               (traceUnify, Layout.tuple2 (layout, layout), Unit.layout)
+               (fn (c, c') =>
+                (coerce {from = c, to = c'}
+                 ; coerce {from = c', to = c})) arg
+         end
 
       structure Set = DisjointSet
       structure Unique = UniqueId ()
 
       datatype t =
-	 T of {global: global ref,
-	       ty: Type.t,
-	       value: value} Set.t
+         T of {global: global ref,
+               ty: Type.t,
+               value: value} Set.t
       and value =
-	 Array of {birth: unit Birth.t,
-		   elt: t,
-		   length: t}
-	| Const of Const.t
-	| Datatype of data
-	| Ref of {arg: t,
-		  birth: {init: t} Birth.t}
-	| Tuple of t vector
-	| Vector of {elt: t,
-		     length: t}
-	| Weak of t
+         Array of {birth: unit Birth.t,
+                   elt: t,
+                   length: t}
+        | Const of Const.t
+        | Datatype of data
+        | Ref of {arg: t,
+                  birth: {init: t} Birth.t}
+        | Tuple of t vector
+        | Vector of {elt: t,
+                     length: t}
+        | Weak of t
       and data =
-	 Data of {coercedTo: data list ref,
-		  filters: {args: t vector,
-			    con: Con.t} list ref,
-		  value: dataVal ref}
+         Data of {coercedTo: data list ref,
+                  filters: {args: t vector,
+                            con: Con.t} list ref,
+                  value: dataVal ref}
       and dataVal =
-	 ConApp of {args: t vector,
-		    con: Con.t,
-		    uniq: Unique.t}
-	| Undefined
-	| Unknown
+         ConApp of {args: t vector,
+                    con: Con.t,
+                    uniq: Unique.t}
+        | Undefined
+        | Unknown
 
       local
-	 fun make sel (T s) = sel (Set.! s)
+         fun make sel (T s) = sel (Set.! s)
       in
-	 val value = make #value
-	 val ty = make #ty
+         val value = make #value
+         val ty = make #ty
       end
 
       local
-	 open Layout
+         open Layout
       in
-	 fun layout v =
-	    case value v of
-	       Array {birth, elt, length, ...} =>
-		  seq [str "array", tuple [Birth.layout birth,
-					   layout length,
-					   layout elt]]
-	     | Const c => Const.layout c
-	     | Datatype d => layoutData d
-	     | Ref {arg, birth, ...} =>
-		  seq [str "ref ", tuple [layout arg, Birth.layout birth]]
-	     | Tuple vs => Vector.layout layout vs
-	     | Vector {elt, length, ...} => seq [str "vector ",
-						 tuple [layout elt,
-							layout length]]
-	     | Weak v => seq [str "weak ", layout v]
-	 and layoutData (Data {value, ...}) =
-	    case !value of
-	       Undefined => str "undefined datatype"
-	     | ConApp {con, uniq, ...} =>
-		  record [("con", Con.layout con),
-			  ("uniq", Unique.layout uniq)]
-	          (* Can't layout the args because there may be a circularity *)
-	     | Unknown => str "unknown datatype"
+         fun layout v =
+            case value v of
+               Array {birth, elt, length, ...} =>
+                  seq [str "array", tuple [Birth.layout birth,
+                                           layout length,
+                                           layout elt]]
+             | Const c => Const.layout c
+             | Datatype d => layoutData d
+             | Ref {arg, birth, ...} =>
+                  seq [str "ref ", tuple [layout arg, Birth.layout birth]]
+             | Tuple vs => Vector.layout layout vs
+             | Vector {elt, length, ...} => seq [str "vector ",
+                                                 tuple [layout elt,
+                                                        layout length]]
+             | Weak v => seq [str "weak ", layout v]
+         and layoutData (Data {value, ...}) =
+            case !value of
+               Undefined => str "undefined datatype"
+             | ConApp {con, uniq, ...} =>
+                  record [("con", Con.layout con),
+                          ("uniq", Unique.layout uniq)]
+                  (* Can't layout the args because there may be a circularity *)
+             | Unknown => str "unknown datatype"
       end
 
       fun equals (T s, T s') = Set.equals (s, s')
 
       val equals =
- 	 Trace.trace2 ("Value.equals", layout, layout, Bool.layout) equals
+         Trace.trace2 
+         ("ConstantPropagation.Value.equals", 
+          layout, layout, Bool.layout) 
+         equals
 
-      val globalsInfo = Trace.info "Value.globals"
-      val globalInfo = Trace.info "Value.global"
+      val globalsInfo = Trace.info "ConstantPropagation.Value.globals"
+      val globalInfo = Trace.info "ConstantPropagation.Value.global"
 
       fun globals arg: (Var.t * Type.t) vector option =
-	 Trace.traceInfo
-	 (globalsInfo,
-	  (Vector.layout layout) o #1,
-	  Option.layout (Vector.layout
-			 (Layout.tuple2 (Var.layout, Type.layout))),
-	  Trace.assertTrue)
-	 (fn (vs: t vector, newGlobal) =>
-	  DynamicWind.withEscape
-	  (fn escape =>
-	   SOME (Vector.map
-		 (vs, fn v =>
-		  case global (v, newGlobal) of
-		     NONE => escape NONE
-		   | SOME g => g)))) arg
+         Trace.traceInfo
+         (globalsInfo,
+          (Vector.layout layout) o #1,
+          Option.layout (Vector.layout
+                         (Layout.tuple2 (Var.layout, Type.layout))),
+          Trace.assertTrue)
+         (fn (vs: t vector, newGlobal) =>
+          Exn.withEscape
+          (fn escape =>
+           SOME (Vector.map
+                 (vs, fn v =>
+                  case global (v, newGlobal) of
+                     NONE => escape NONE
+                   | SOME g => g)))) arg
       and global arg: (Var.t * Type.t) option =
-	 Trace.traceInfo (globalInfo,
-			  layout o #1,
-			  Option.layout (Var.layout o #1),
-			  Trace.assertTrue)
-	 (fn (v as T s, newGlobal) =>
-	  let val {global = r, ty, value} = Set.! s
-	  in case !r of
-	        No => NONE
-	      | Yes g => SOME (g, ty)
-	      | NotComputed =>
-		   let
-		      (* avoid globalizing circular abstract values *)
-		      val _ = r := No
-		      fun yes e = Yes (newGlobal (ty, e))
-		      fun unary (Birth.T {place, ...},
-				 makeInit: 'a -> t,
-				 primApp: {targs: Type.t vector,
-					   args: Var.t vector} -> Exp.t,
-				 targ: Type.t) =
-			 case !place of
-			    Place.One (One.T {global = glob, extra, ...}) =>
-			       let
-				  val init = makeInit extra
-			       in
-				  case global (init, newGlobal) of
-				     SOME (x, _) =>
-				        Yes
-					(case !glob of
-					    NONE => 
-					       let
-						  val exp =
-						     primApp
-						     {targs = Vector.new1 targ,
-						      args = Vector.new1 x}
-						  val g = newGlobal (ty, exp)
-					       in
-						  glob := SOME g; g
-					       end
-					      | SOME g => g)
-				   | _ => No
-			       end
-			  | _ => No
-		      val g =
-			 case value of
-			    Array {birth, length, ...} =>
-			       unary (birth, fn _ => length,
-				      fn {args, targs} =>
-				      Exp.PrimApp {args = args,
-						   prim = Prim.array,
-						   targs = targs},
-				      Type.deArray ty)
-			  | Const (Const.T {const, ...}) =>
-			       (case !const of
-				   Const.Const c => yes (Exp.Const c)
-				 | _ => No)
-			  | Datatype (Data {value, ...}) =>
-			       (case !value of
-				   ConApp {args, con, ...} =>
-				      (case globals (args, newGlobal) of
-					  NONE => No
-					| SOME args =>
-					     yes (Exp.ConApp
-						  {con = con,
-						   args = Vector.map (args, #1)}))
-				 | _ => No)
-			  | Ref {birth, ...} =>
-			       unary (birth, fn {init} => init,
-				      fn {args, targs} =>
-				      Exp.PrimApp {args = args,
-						   prim = Prim.reff,
-						   targs = targs},
-				      Type.deRef ty)
-			  | Tuple vs =>
-			       (case globals (vs, newGlobal) of
-				   NONE => No
-				 | SOME xts =>
-				      yes (Exp.Tuple (Vector.map (xts, #1))))
-			  | Vector _ => No
-			  | Weak _ => No
-		      val _ = r := g
-		   in
-		      global (v, newGlobal)
-		   end
-	  end) arg
-	 
+         Trace.traceInfo (globalInfo,
+                          layout o #1,
+                          Option.layout (Var.layout o #1),
+                          Trace.assertTrue)
+         (fn (v as T s, newGlobal) =>
+          let val {global = r, ty, value} = Set.! s
+          in case !r of
+                No => NONE
+              | Yes g => SOME (g, ty)
+              | NotComputed =>
+                   let
+                      (* avoid globalizing circular abstract values *)
+                      val _ = r := No
+                      fun yes e = Yes (newGlobal (ty, e))
+                      fun unary (Birth.T {place, ...},
+                                 makeInit: 'a -> t,
+                                 primApp: {targs: Type.t vector,
+                                           args: Var.t vector} -> Exp.t,
+                                 targ: Type.t) =
+                         case !place of
+                            Place.One (One.T {global = glob, extra, ...}) =>
+                               let
+                                  val init = makeInit extra
+                               in
+                                  case global (init, newGlobal) of
+                                     SOME (x, _) =>
+                                        Yes
+                                        (case !glob of
+                                            NONE => 
+                                               let
+                                                  val exp =
+                                                     primApp
+                                                     {targs = Vector.new1 targ,
+                                                      args = Vector.new1 x}
+                                                  val g = newGlobal (ty, exp)
+                                               in
+                                                  glob := SOME g; g
+                                               end
+                                              | SOME g => g)
+                                   | _ => No
+                               end
+                          | _ => No
+                      val g =
+                         case value of
+                            Array {birth, length, ...} =>
+                               unary (birth, fn _ => length,
+                                      fn {args, targs} =>
+                                      Exp.PrimApp {args = args,
+                                                   prim = Prim.array,
+                                                   targs = targs},
+                                      Type.deArray ty)
+                          | Const (Const.T {const, ...}) =>
+                               (case !const of
+                                   Const.Const c => yes (Exp.Const c)
+                                 | _ => No)
+                          | Datatype (Data {value, ...}) =>
+                               (case !value of
+                                   ConApp {args, con, ...} =>
+                                      (case globals (args, newGlobal) of
+                                          NONE => No
+                                        | SOME args =>
+                                             yes (Exp.ConApp
+                                                  {con = con,
+                                                   args = Vector.map (args, #1)}))
+                                 | _ => No)
+                          | Ref {birth, ...} =>
+                               unary (birth, fn {init} => init,
+                                      fn {args, targs} =>
+                                      Exp.PrimApp {args = args,
+                                                   prim = Prim.reff,
+                                                   targs = targs},
+                                      Type.deRef ty)
+                          | Tuple vs =>
+                               (case globals (vs, newGlobal) of
+                                   NONE => No
+                                 | SOME xts =>
+                                      yes (Exp.Tuple (Vector.map (xts, #1))))
+                          | Vector _ => No
+                          | Weak _ => No
+                      val _ = r := g
+                   in
+                      global (v, newGlobal)
+                   end
+          end) arg
+         
       fun new (v: value, ty: Type.t): t =
-	 T (Set.singleton {value = v,
-			   ty = ty,
-			   global = ref NotComputed})
+         T (Set.singleton {value = v,
+                           ty = ty,
+                           global = ref NotComputed})
 
       fun tuple vs =
-	 new (Tuple vs, Type.tuple (Vector.map (vs, ty)))
+         new (Tuple vs, Type.tuple (Vector.map (vs, ty)))
 
       fun const' (c, ty) = new (Const c, ty)
 
       fun const c = let val c' = Const.const c
-		    in new (Const c', Type.ofConst c)
-		    end
+                    in new (Const c', Type.ofConst c)
+                    end
 
       val zero = WordSize.memoize (fn s => const (S.Const.word (WordX.zero s)))
 
       fun constToEltLength (c, err) =
-	 let
-	    val v =
-	       case c of
-		  Sconst.WordVector v => v
-		| _ => Error.bug err 
-	    val length = WordXVector.length v
-	    val elt =
-	       if 0 = length
-		  then const' (Const.unknown (), Type.word8)
-	       else let
-		       val w = WordXVector.sub (v, 0)
-		    in
-		       if WordXVector.forall (v, fn w' =>
-					      WordX.equals (w, w'))
-			  then const (Sconst.word w)
-		       else const' (Const.unknown (), Type.word8)
-		    end
-	    val length =
-	       const (Sconst.Word (WordX.fromIntInf (IntInf.fromInt length,
-						     WordSize.default)))
-	 in
-	    {elt = elt, length = length}
-	 end
-	       
+         let
+            val v =
+               case c of
+                  Sconst.WordVector v => v
+                | _ => Error.bug err 
+            val length = WordXVector.length v
+            val elt =
+               if 0 = length
+                  then const' (Const.unknown (), Type.word8)
+               else let
+                       val w = WordXVector.sub (v, 0)
+                    in
+                       if WordXVector.forall (v, fn w' =>
+                                              WordX.equals (w, w'))
+                          then const (Sconst.word w)
+                       else const' (Const.unknown (), Type.word8)
+                    end
+            val length =
+               const (Sconst.Word (WordX.fromIntInf (IntInf.fromInt length,
+                                                     WordSize.default)))
+         in
+            {elt = elt, length = length}
+         end
+               
       local
-	 fun make (err, sel) v =
-	    case value v of
-	       Vector fs => sel fs
-	     | Const (Const.T {const = ref (Const.Const c), ...}) =>
-		  sel (constToEltLength (c, err))
-	     | _ => Error.bug err
+         fun make (err, sel) v =
+            case value v of
+               Vector fs => sel fs
+             | Const (Const.T {const = ref (Const.Const c), ...}) =>
+                  sel (constToEltLength (c, err))
+             | _ => Error.bug err
       in
-	 val devector = make ("devector", #elt)
-	 val vectorLength = make ("vectorLength", #length)
+         val devector = make ("ConstantPropagation.Value.devector", #elt)
+         val vectorLength = make ("ConstantPropagation.Value.vectorLength", #length)
       end
 
       local
-	 fun make (err, sel) v =
-	    case value v of
-	       Array fs => sel fs
-	     | _ => Error.bug err
-      in val dearray = make ("dearray", #elt)
-	 val arrayLength = make ("arrayLength", #length)
-	 val arrayBirth = make ("arrayBirth", #birth)
+         fun make (err, sel) v =
+            case value v of
+               Array fs => sel fs
+             | _ => Error.bug err
+      in val dearray = make ("ConstantPropagation.Value.dearray", #elt)
+         val arrayLength = make ("ConstantPropagation.Value.arrayLength", #length)
+         val arrayBirth = make ("ConstantPropagation.Value.arrayBirth", #birth)
       end
 
       fun vectorFromArray (T s: t): t =
-	 let
-	    val {value, ty, ...} = Set.! s
-	 in case value of
-	    Array {elt, length, ...} =>
-	       new (Vector {elt = elt, length = length}, ty)
-	  | _ => Error.bug "Value.vectorFromArray"
-	 end
+         let
+            val {value, ty, ...} = Set.! s
+         in case value of
+            Array {elt, length, ...} =>
+               new (Vector {elt = elt, length = length}, ty)
+          | _ => Error.bug "ConstantPropagation.Value.vectorFromArray"
+         end
 
       local
-	 fun make (err, sel) v =
-	    case value v of
-	       Ref fs => sel fs
-	     | _ => Error.bug err
+         fun make (err, sel) v =
+            case value v of
+               Ref fs => sel fs
+             | _ => Error.bug err
       in
-	 val deref = make ("deref", #arg)
-	 val refBirth = make ("refBirth", #birth)
+         val deref = make ("ConstantPropagation.Value.deref", #arg)
+         val refBirth = make ("ConstantPropagation.Value.refBirth", #birth)
       end
 
       fun deweak v =
-	 case value v of
-	    Weak v => v
-	  | _ => Error.bug "deweak"
+         case value v of
+            Weak v => v
+          | _ => Error.bug "ConstantPropagation.Value.deweak"
 
       structure Data =
-	 struct
-	    datatype t = datatype data
+         struct
+            datatype t = datatype data
 
-	    val layout = layoutData
+            val layout = layoutData
 
-	    local
-	       fun make v () = Data {value = ref v,
-				     coercedTo = ref [],
-				     filters = ref []}
-	    in
-	       val undefined = make Undefined
-	       val unknown = make Unknown
-	    end
-	 end
+            local
+               fun make v () = Data {value = ref v,
+                                     coercedTo = ref [],
+                                     filters = ref []}
+            in
+               val undefined = make Undefined
+               val unknown = make Unknown
+            end
+         end
       
       local
-	 (* The extra birth is because of let-style polymorphism.
-	  * arrayBirth is really the same as refBirth.
-	  *)
-	 fun make (const, data, refBirth, arrayBirth) =
-	    let
-	       fun loop (t: Type.t): t =
-		  new
-		  (case Type.dest t of
-		      Type.Array t => Array {birth = arrayBirth (),
-					     elt = loop t,
-					     length = loop Type.defaultWord}
-		    | Type.Datatype _ => Datatype (data ())
-		    | Type.Ref t => Ref {arg = loop t,
-					 birth = refBirth ()}
-		    | Type.Tuple ts => Tuple (Vector.map (ts, loop))
-		    | Type.Vector t => Vector {elt = loop t,
-					       length = loop Type.defaultWord}
-		    | Type.Weak t => Weak (loop t)
-		    | _ => Const (const ()), 
-		   t)
-	    in loop
-	    end
+         (* The extra birth is because of let-style polymorphism.
+          * arrayBirth is really the same as refBirth.
+          *)
+         fun make (const, data, refBirth, arrayBirth) =
+            let
+               fun loop (t: Type.t): t =
+                  new
+                  (case Type.dest t of
+                      Type.Array t => Array {birth = arrayBirth (),
+                                             elt = loop t,
+                                             length = loop Type.defaultWord}
+                    | Type.Datatype _ => Datatype (data ())
+                    | Type.Ref t => Ref {arg = loop t,
+                                         birth = refBirth ()}
+                    | Type.Tuple ts => Tuple (Vector.map (ts, loop))
+                    | Type.Vector t => Vector {elt = loop t,
+                                               length = loop Type.defaultWord}
+                    | Type.Weak t => Weak (loop t)
+                    | _ => Const (const ()), 
+                   t)
+            in loop
+            end
       in
-	 val fromType =
-	    make (Const.undefined,
-		  Data.undefined,
-		  Birth.undefined,
-		  Birth.undefined)
-	 val unknown =
-	    make (Const.unknown,
-		  Data.unknown,
-		  Birth.unknown,
-		  Birth.unknown)
+         val fromType =
+            make (Const.undefined,
+                  Data.undefined,
+                  Birth.undefined,
+                  Birth.undefined)
+         val unknown =
+            make (Const.unknown,
+                  Data.unknown,
+                  Birth.unknown,
+                  Birth.unknown)
       end
 
       fun select {tuple, offset, resultType = _} =
-	 case value tuple of
-	    Tuple vs => Vector.sub (vs, offset)
-	  | _ => Error.bug "select of non-tuple" 
+         case value tuple of
+            Tuple vs => Vector.sub (vs, offset)
+          | _ => Error.bug "ConstantPropagation.Value.select: non-tuple" 
 
       fun unit () = tuple (Vector.new0 ())
    end
 
 val traceSendConApp =
    Trace.trace2
-   ("sendConApp", Value.Data.layout,
+   ("ConstantPropagation.sendConApp", Value.Data.layout,
     fn {con, args, uniq} =>
     Layout.record [("con", Con.layout con),
-		   ("args", Vector.layout Value.layout args),
-		   ("uniq", Value.Unique.layout uniq)],
+                   ("args", Vector.layout Value.layout args),
+                   ("uniq", Value.Unique.layout uniq)],
     Unit.layout)
 
 val traceSendConAppLoop =
-   Trace.trace ("sendConAppLoop", Value.Data.layout, Unit.layout)
+   Trace.trace 
+   ("ConstantPropagation.sendConAppLoop", 
+    Value.Data.layout, Unit.layout)
 
 val traceMakeDataUnknown =
-   Trace.trace ("makeDataUnknown", Value.Data.layout, Unit.layout)
+   Trace.trace 
+   ("ConstantPropagation.makeDataUnknown", 
+    Value.Data.layout, Unit.layout)
 
 (* ------------------------------------------------- *)
 (*                     simplify                      *)
@@ -600,316 +628,316 @@
 fun simplify (program: Program.t): Program.t =
    let
       val program as Program.T {datatypes, globals, functions, main} =
-	 eliminateDeadBlocks program
+         eliminateDeadBlocks program
       val {varIsMultiDefed, ...} = Multi.multi program
       val once = not o varIsMultiDefed
       val {get = conInfo: Con.t -> {result: Type.t,
-				    types: Type.t vector,
-				    values: Value.t vector},
-	   set = setConInfo, ...} =
-	 Property.getSetOnce
-	 (Con.plist, Property.initRaise ("conInfo", Con.layout))
+                                    types: Type.t vector,
+                                    values: Value.t vector},
+           set = setConInfo, ...} =
+         Property.getSetOnce
+         (Con.plist, Property.initRaise ("conInfo", Con.layout))
       val conValues = #values o conInfo
       val _ =
-	 Vector.foreach
-	 (datatypes, fn Datatype.T {tycon, cons} =>
-	  let
-	     val result = Type.con (tycon, Vector.new0 ())
-	  in
-	     Vector.foreach
-	     (cons, fn {con, args} =>
-	      setConInfo (con,
-			  {result = result,
-			   types = args,
-			   values = Vector.map (args, Value.fromType)}))
-	  end)
+         Vector.foreach
+         (datatypes, fn Datatype.T {tycon, cons} =>
+          let
+             val result = Type.con (tycon, Vector.new0 ())
+          in
+             Vector.foreach
+             (cons, fn {con, args} =>
+              setConInfo (con,
+                          {result = result,
+                           types = args,
+                           values = Vector.map (args, Value.fromType)}))
+          end)
       local
-	 open Value
+         open Value
       in
- 	 val traceCoerce =
- 	    Trace.trace ("Value.coerce",
-			 fn {from, to} => Layout.record [("from", layout from),
-							 ("to", layout to)],
-			 Unit.layout)
-	 fun makeDataUnknown arg: unit =
-	    traceMakeDataUnknown
-	    (fn Data {value, coercedTo, filters, ...} =>
-	     let
-		fun doit () =
-		   (value := Unknown
-		    ; List.foreach (!coercedTo, makeDataUnknown)
-		    ; coercedTo := []
-		    ; (List.foreach
-		       (!filters, fn {con, args} =>
-			coerces {froms = conValues con,
-				 tos = args})))
-	     in
-		case !value of
-		   ConApp _ => doit ()
-		 | Undefined => doit ()
-		 | Unknown => ()
-	     end) arg
-	 and sendConApp arg: unit =
-	    traceSendConApp
-	    (fn (d: data, ca as {con, args, uniq}) =>
-	     let
-		val v = ConApp ca
-		fun loop arg: unit =
-		   traceSendConAppLoop
-		   (fn Data {value, coercedTo, filters, ...} =>
-		    case !value of
-		       Unknown => ()
-		     | Undefined =>
-			  (value := v
-			   ; List.foreach (!coercedTo, loop)
-			   ; (List.foreach
-			      (!filters, fn {con = con', args = args'} =>
-			       if Con.equals (con, con')
-				  then coerces {froms = args, tos = args'}
-			       else ())))
-		     | ConApp {con = con', uniq = uniq', ...} =>
-			  if Unique.equals (uniq, uniq')
-			     orelse (Con.equals (con, con')
-				     andalso 0 = Vector.length args)
-			     then ()
-			  else makeDataUnknown d) arg
-	     in loop d
-	     end) arg
-	 and coerces {froms: Value.t vector, tos: Value.t vector} =
-	    Vector.foreach2 (froms, tos, fn (from, to) =>
-			    coerce {from = from, to = to})
-	 and coerce arg =
-	    traceCoerce
-	    (fn {from, to} =>
-	     if equals (from, to)
-		then ()
-	     else
-	        let 
-		   fun error () = 
-		      Error.bug
-		      (concat ["strange coerce: from: ",
-			       Layout.toString (Value.layout from),
-			       " to: ", Layout.toString (Value.layout to)])
-		in
-		  case (value from, value to) of
-		     (Const from, Const to) =>
-			Const.coerce {from = from, to = to}
-		   | (Datatype from, Datatype to) =>
-		        coerceData {from = from, to = to}
-		   | (Ref {birth, arg}, Ref {birth = b', arg = a'}) =>
-			(Birth.coerce {from = birth, to = b'}
-			 ; unify (arg, a'))
-		   | (Array {birth = b, length = n, elt = x},
-			Array {birth = b', length = n', elt = x'}) =>
-		        (Birth.coerce {from = b, to = b'}
-			 ; coerce {from = n, to = n'}
-			 ; unify (x, x'))
-	           | (Vector {length = n, elt = x},
-		      Vector {length = n', elt = x'}) =>
-			(coerce {from = n, to = n'}
-			 ; coerce {from = x, to = x'})
-		   | (Tuple vs, Tuple vs') => coerces {froms = vs, tos = vs'}
-		   | (Weak v, Weak v') => unify (v, v')
-		   | (Const (Const.T {const = ref (Const.Const c), ...}),
-		      Vector {elt, length}) =>
-			let
-			   val {elt = elt', length = length'} =
-			      Value.constToEltLength (c, "coerce")
-			in
-			   coerce {from = elt', to = elt}
-			   ; coerce {from = length', to = length}
-			end
-		   | (_, _) => error ()
-		end) arg
-	 and unify (T s: t, T s': t): unit =
-	    if Set.equals (s, s')
-	       then ()
-	    else
-	       let 
-		  val {value, ...} = Set.! s
-		  val {value = value', ...} = Set.! s'
-	       in Set.union (s, s')
-		  ; case (value, value') of
-		       (Const c, Const c') => Const.unify (c, c')
-		     | (Datatype d, Datatype d') => unifyData (d, d')
-		     | (Ref {birth, arg}, Ref {birth = b', arg = a'}) =>
-			  (Birth.unify (birth, b')
-			   ; unify (arg, a'))
-		     | (Array {birth = b, length = n, elt = x},
-		        Array {birth = b', length = n', elt = x'}) =>
-		          (Birth.unify (b, b')
-			   ; unify (n, n')
-			   ; unify (x, x'))
-		     | (Vector {length = n, elt = x},
-		        Vector {length = n', elt = x'}) =>
-		          (unify (n, n')
-			   ; unify (x, x'))
-		     | (Tuple vs, Tuple vs') => Vector.foreach2 (vs, vs', unify)
-		     | (Weak v, Weak v') => unify (v, v')
-		     | _ => Error.bug "strange unify"
-	       end
-	 and unifyData (d, d') =
-	    (coerceData {from = d, to = d'}
-	     ; coerceData {from = d', to = d})
-	 and coerceData {from = Data {value, coercedTo, ...}, to} =
-	    case !value of
-	       ConApp ca => (List.push (coercedTo, to)
-			     ; sendConApp (to, ca))
-	     | Undefined => List.push (coercedTo, to)
-	     | Unknown => makeDataUnknown to
-	 fun conApp {con: Con.t, args: t vector}: t =
-	    let
-	       val {values = tos, result, ...} = conInfo con
-	    in
-	       coerces {froms = args, tos = tos}
-	       ; new (Datatype
-		      (Data {value = ref (ConApp {con = con, args = args,
-						  uniq = Unique.new ()}),
-			     coercedTo = ref [],
-			     filters = ref []}),
-		      result)
-	    end
-	 fun makeUnknown (v: t): unit =
-	    case value v of
-	       Array {length, elt, ...} => (makeUnknown length
-					    ; makeUnknown elt)
-	     | Const c => Const.makeUnknown c
-	     | Datatype d => makeDataUnknown d
-	     | Ref {arg, ...} => makeUnknown arg
-	     | Tuple vs => Vector.foreach (vs, makeUnknown)
-	     | Vector {length, elt} => (makeUnknown length
-					; makeUnknown elt)
-	     | Weak v => makeUnknown v
-	 fun sideEffect (v: t): unit =
-	    case value v of
-	       Array {elt, ...} => makeUnknown elt
-	     | Const _ => ()
-	     | Datatype _ => ()
-	     | Ref {arg, ...} => makeUnknown arg
-	     | Vector {elt, ...} => makeUnknown elt
-	     | Tuple vs => Vector.foreach (vs, sideEffect)
-	     | Weak v => makeUnknown v
-	 fun primApp {prim,
-		      targs = _,
-		      args: Value.t vector,
-		      resultVar,
-		      resultType}: t =
-	    let
-	       fun bear z =
-		  case resultVar of
-		     SOME resultVar => if once resultVar 
-		                          andalso 
-					  Type.isSmall resultType
-					  then Birth.here z
-				       else Birth.unknown ()
-		   | _ => Error.bug "bear"
-	       fun update (a, v) =
-		  (coerce {from = v, to = dearray a}
-		   ; unit ())
-	       fun arg i = Vector.sub (args, i)
-	       datatype z = datatype Prim.Name.t
-	       fun array (length, birth) =
-		  let
-		     val a = fromType resultType
-		     val _ = coerce {from = length, to = arrayLength a}
-		     val _ = Birth.coerce {from = birth, to = arrayBirth a}
-		  in
-		     a
-		  end
-	    in
-	       case Prim.name prim of
-		  Array_array => array (arg 0, bear ())
-		| Array_array0Const =>
-		     array (zero WordSize.default, Birth.here ())
-		| Array_length => arrayLength (arg 0)
-		| Array_sub => dearray (arg 0)
-		| Array_toVector => vectorFromArray (arg 0)
-		| Array_update => update (arg 0, arg 2)
-		| Ref_assign =>
-		     (coerce {from = arg 1, to = deref (arg 0)}; unit ())
-		| Ref_deref => deref (arg 0)
-		| Ref_ref =>
-		     let
-			val v = arg 0
-			val r = fromType resultType
-			val _ = coerce {from = v, to = deref r}
-			val _ = Birth.coerce {from = bear {init = v},
-					      to = refBirth r}
-		     in
-			r
-		     end
-		| Vector_length => vectorLength (arg 0)
-		| Vector_sub => devector (arg 0)
-		| Weak_get => deweak (arg 0)
-		| Weak_new =>
-		     let
-			val w = fromType resultType
-			val _ = coerce {from = arg 0, to = deweak w}
-		     in
-			w
-		     end
-		| _ => (if Prim.maySideEffect prim
-			   then Vector.foreach (args, sideEffect)
-			else ()
-			   ; unknown resultType)
-	    end
-	 fun filter (variant, con, args) =
-	    case value variant of
-	       Datatype (Data {value, filters, ...}) =>
-		  let
-		     fun save () = List.push (filters, {con = con, args = args})
-		  in case !value of
-		     Undefined => save ()
-		   | Unknown => coerces {froms = conValues con, tos = args}
-		   | ConApp {con = con', args = args', ...} =>
-			((* The save () has to happen before the coerces because
-			  * they may loop back and change the variant, which
-			  * would need to then change this value.
-			  *)
-			 save ()
-			 ; if Con.equals (con, con')
-			      then coerces {froms = args', tos = args}
-			   else ())
-		  end
-	     | _ => Error.bug "conSelect of non-datatype"
+         val traceCoerce =
+            Trace.trace ("ConstantPropagation.Value.coerce",
+                         fn {from, to} => Layout.record [("from", layout from),
+                                                         ("to", layout to)],
+                         Unit.layout)
+         fun makeDataUnknown arg: unit =
+            traceMakeDataUnknown
+            (fn Data {value, coercedTo, filters, ...} =>
+             let
+                fun doit () =
+                   (value := Unknown
+                    ; List.foreach (!coercedTo, makeDataUnknown)
+                    ; coercedTo := []
+                    ; (List.foreach
+                       (!filters, fn {con, args} =>
+                        coerces {froms = conValues con,
+                                 tos = args})))
+             in
+                case !value of
+                   ConApp _ => doit ()
+                 | Undefined => doit ()
+                 | Unknown => ()
+             end) arg
+         and sendConApp arg: unit =
+            traceSendConApp
+            (fn (d: data, ca as {con, args, uniq}) =>
+             let
+                val v = ConApp ca
+                fun loop arg: unit =
+                   traceSendConAppLoop
+                   (fn Data {value, coercedTo, filters, ...} =>
+                    case !value of
+                       Unknown => ()
+                     | Undefined =>
+                          (value := v
+                           ; List.foreach (!coercedTo, loop)
+                           ; (List.foreach
+                              (!filters, fn {con = con', args = args'} =>
+                               if Con.equals (con, con')
+                                  then coerces {froms = args, tos = args'}
+                               else ())))
+                     | ConApp {con = con', uniq = uniq', ...} =>
+                          if Unique.equals (uniq, uniq')
+                             orelse (Con.equals (con, con')
+                                     andalso 0 = Vector.length args)
+                             then ()
+                          else makeDataUnknown d) arg
+             in loop d
+             end) arg
+         and coerces {froms: Value.t vector, tos: Value.t vector} =
+            Vector.foreach2 (froms, tos, fn (from, to) =>
+                            coerce {from = from, to = to})
+         and coerce arg =
+            traceCoerce
+            (fn {from, to} =>
+             if equals (from, to)
+                then ()
+             else
+                let 
+                   fun error () = 
+                      Error.bug
+                      (concat ["ConstantPropagation.Value.coerce: strange: from: ",
+                               Layout.toString (Value.layout from),
+                               " to: ", Layout.toString (Value.layout to)])
+                in
+                  case (value from, value to) of
+                     (Const from, Const to) =>
+                        Const.coerce {from = from, to = to}
+                   | (Datatype from, Datatype to) =>
+                        coerceData {from = from, to = to}
+                   | (Ref {birth, arg}, Ref {birth = b', arg = a'}) =>
+                        (Birth.coerce {from = birth, to = b'}
+                         ; unify (arg, a'))
+                   | (Array {birth = b, length = n, elt = x},
+                        Array {birth = b', length = n', elt = x'}) =>
+                        (Birth.coerce {from = b, to = b'}
+                         ; coerce {from = n, to = n'}
+                         ; unify (x, x'))
+                   | (Vector {length = n, elt = x},
+                      Vector {length = n', elt = x'}) =>
+                        (coerce {from = n, to = n'}
+                         ; coerce {from = x, to = x'})
+                   | (Tuple vs, Tuple vs') => coerces {froms = vs, tos = vs'}
+                   | (Weak v, Weak v') => unify (v, v')
+                   | (Const (Const.T {const = ref (Const.Const c), ...}),
+                      Vector {elt, length}) =>
+                        let
+                           val {elt = elt', length = length'} =
+                              Value.constToEltLength (c, "coerce")
+                        in
+                           coerce {from = elt', to = elt}
+                           ; coerce {from = length', to = length}
+                        end
+                   | (_, _) => error ()
+                end) arg
+         and unify (T s: t, T s': t): unit =
+            if Set.equals (s, s')
+               then ()
+            else
+               let 
+                  val {value, ...} = Set.! s
+                  val {value = value', ...} = Set.! s'
+               in Set.union (s, s')
+                  ; case (value, value') of
+                       (Const c, Const c') => Const.unify (c, c')
+                     | (Datatype d, Datatype d') => unifyData (d, d')
+                     | (Ref {birth, arg}, Ref {birth = b', arg = a'}) =>
+                          (Birth.unify (birth, b')
+                           ; unify (arg, a'))
+                     | (Array {birth = b, length = n, elt = x},
+                        Array {birth = b', length = n', elt = x'}) =>
+                          (Birth.unify (b, b')
+                           ; unify (n, n')
+                           ; unify (x, x'))
+                     | (Vector {length = n, elt = x},
+                        Vector {length = n', elt = x'}) =>
+                          (unify (n, n')
+                           ; unify (x, x'))
+                     | (Tuple vs, Tuple vs') => Vector.foreach2 (vs, vs', unify)
+                     | (Weak v, Weak v') => unify (v, v')
+                     | _ => Error.bug "ConstantPropagation.Value.unify: strange"
+               end
+         and unifyData (d, d') =
+            (coerceData {from = d, to = d'}
+             ; coerceData {from = d', to = d})
+         and coerceData {from = Data {value, coercedTo, ...}, to} =
+            case !value of
+               ConApp ca => (List.push (coercedTo, to)
+                             ; sendConApp (to, ca))
+             | Undefined => List.push (coercedTo, to)
+             | Unknown => makeDataUnknown to
+         fun conApp {con: Con.t, args: t vector}: t =
+            let
+               val {values = tos, result, ...} = conInfo con
+            in
+               coerces {froms = args, tos = tos}
+               ; new (Datatype
+                      (Data {value = ref (ConApp {con = con, args = args,
+                                                  uniq = Unique.new ()}),
+                             coercedTo = ref [],
+                             filters = ref []}),
+                      result)
+            end
+         fun makeUnknown (v: t): unit =
+            case value v of
+               Array {length, elt, ...} => (makeUnknown length
+                                            ; makeUnknown elt)
+             | Const c => Const.makeUnknown c
+             | Datatype d => makeDataUnknown d
+             | Ref {arg, ...} => makeUnknown arg
+             | Tuple vs => Vector.foreach (vs, makeUnknown)
+             | Vector {length, elt} => (makeUnknown length
+                                        ; makeUnknown elt)
+             | Weak v => makeUnknown v
+         fun sideEffect (v: t): unit =
+            case value v of
+               Array {elt, ...} => makeUnknown elt
+             | Const _ => ()
+             | Datatype _ => ()
+             | Ref {arg, ...} => makeUnknown arg
+             | Vector {elt, ...} => makeUnknown elt
+             | Tuple vs => Vector.foreach (vs, sideEffect)
+             | Weak v => makeUnknown v
+         fun primApp {prim,
+                      targs = _,
+                      args: Value.t vector,
+                      resultVar,
+                      resultType}: t =
+            let
+               fun bear z =
+                  case resultVar of
+                     SOME resultVar => if once resultVar 
+                                          andalso 
+                                          Type.isSmall resultType
+                                          then Birth.here z
+                                       else Birth.unknown ()
+                   | _ => Error.bug "ConstantPropagation.Value.primApp.bear"
+               fun update (a, v) =
+                  (coerce {from = v, to = dearray a}
+                   ; unit ())
+               fun arg i = Vector.sub (args, i)
+               datatype z = datatype Prim.Name.t
+               fun array (length, birth) =
+                  let
+                     val a = fromType resultType
+                     val _ = coerce {from = length, to = arrayLength a}
+                     val _ = Birth.coerce {from = birth, to = arrayBirth a}
+                  in
+                     a
+                  end
+            in
+               case Prim.name prim of
+                  Array_array => array (arg 0, bear ())
+                | Array_array0Const =>
+                     array (zero WordSize.default, Birth.here ())
+                | Array_length => arrayLength (arg 0)
+                | Array_sub => dearray (arg 0)
+                | Array_toVector => vectorFromArray (arg 0)
+                | Array_update => update (arg 0, arg 2)
+                | Ref_assign =>
+                     (coerce {from = arg 1, to = deref (arg 0)}; unit ())
+                | Ref_deref => deref (arg 0)
+                | Ref_ref =>
+                     let
+                        val v = arg 0
+                        val r = fromType resultType
+                        val _ = coerce {from = v, to = deref r}
+                        val _ = Birth.coerce {from = bear {init = v},
+                                              to = refBirth r}
+                     in
+                        r
+                     end
+                | Vector_length => vectorLength (arg 0)
+                | Vector_sub => devector (arg 0)
+                | Weak_get => deweak (arg 0)
+                | Weak_new =>
+                     let
+                        val w = fromType resultType
+                        val _ = coerce {from = arg 0, to = deweak w}
+                     in
+                        w
+                     end
+                | _ => (if Prim.maySideEffect prim
+                           then Vector.foreach (args, sideEffect)
+                        else ()
+                           ; unknown resultType)
+            end
+         fun filter (variant, con, args) =
+            case value variant of
+               Datatype (Data {value, filters, ...}) =>
+                  let
+                     fun save () = List.push (filters, {con = con, args = args})
+                  in case !value of
+                     Undefined => save ()
+                   | Unknown => coerces {froms = conValues con, tos = args}
+                   | ConApp {con = con', args = args', ...} =>
+                        ((* The save () has to happen before the coerces because
+                          * they may loop back and change the variant, which
+                          * would need to then change this value.
+                          *)
+                         save ()
+                         ; if Con.equals (con, con')
+                              then coerces {froms = args', tos = args}
+                           else ())
+                  end
+             | _ => Error.bug "ConstantPropagation.Value.filter: non-datatype"
       end
       fun filterIgnore _ = ()
       val {value, ...} =
-	 Control.trace (Control.Detail, "fixed point")
-	 analyze {
-		  coerce = coerce,
-		  conApp = conApp,
-		  const = Value.const,
-		  filter = filter,
-		  filterWord = filterIgnore,
-		  fromType = Value.fromType,
-		  layout = Value.layout,
-		  primApp = primApp,
-		  program = program,
-		  select = Value.select,
-		  tuple = Value.tuple,
-		  useFromTypeOnBinds = false
-		  }
+         Control.trace (Control.Detail, "fixed point")
+         analyze {
+                  coerce = coerce,
+                  conApp = conApp,
+                  const = Value.const,
+                  filter = filter,
+                  filterWord = filterIgnore,
+                  fromType = Value.fromType,
+                  layout = Value.layout,
+                  primApp = primApp,
+                  program = program,
+                  select = Value.select,
+                  tuple = Value.tuple,
+                  useFromTypeOnBinds = false
+                  }
       val _ =
-	 Control.diagnostics
-	 (fn display =>
-	  let open Layout
-	  in 
-	     display (str "\n\nConstructors:")
-	     ; (Vector.foreach
-		(datatypes, fn Datatype.T {tycon, cons} =>
-		 (display (seq [Tycon.layout tycon, str ": "])
-		  ; Vector.foreach
-		    (cons, fn {con, ...} =>
-		     display
-		     (seq [Con.layout con, str ": ",
-			   Vector.layout Value.layout (conValues con)])))))
-	     ; display (str "\n\nConstants:")
-	     ; (Program.foreachVar
-		(program, fn (x, _) => display (seq [Var.layout x,
-						     str " ",
-						     Value.layout (value x)])))
-	  end)
+         Control.diagnostics
+         (fn display =>
+          let open Layout
+          in 
+             display (str "\n\nConstructors:")
+             ; (Vector.foreach
+                (datatypes, fn Datatype.T {tycon, cons} =>
+                 (display (seq [Tycon.layout tycon, str ": "])
+                  ; Vector.foreach
+                    (cons, fn {con, ...} =>
+                     display
+                     (seq [Con.layout con, str ": ",
+                           Vector.layout Value.layout (conValues con)])))))
+             ; display (str "\n\nConstants:")
+             ; (Program.foreachVar
+                (program, fn (x, _) => display (seq [Var.layout x,
+                                                     str " ",
+                                                     Value.layout (value x)])))
+          end)
       (* Walk through the program
        *  - removing declarations whose rhs is constant
        *  - replacing variables whose value is constant with globals
@@ -917,55 +945,55 @@
        *)
       val {new = newGlobal, all = allGlobals} = Global.make ()
       fun replaceVar x =
-	 case Value.global (value x, newGlobal) of
-	    NONE => x
-	  | SOME (g, _) => g
+         case Value.global (value x, newGlobal) of
+            NONE => x
+          | SOME (g, _) => g
       fun doitStatement (Statement.T {var, ty, exp}) =
-	 let
-	    fun keep () =
-	       SOME (Statement.T {var = var,
-				  ty = ty,
-				  exp = Exp.replaceVar (exp, replaceVar)})
-	 in
-	    case var of
-	       NONE => keep ()
-	     | SOME var => 
-		  (case (Value.global (value var, newGlobal), exp) of
-		      (NONE, _) => keep ()
-		    | (SOME _, PrimApp {prim, ...}) =>
-			 if Prim.maySideEffect prim
-			    then keep ()
-			 else NONE
-		    | _ => NONE)
-	 end
+         let
+            fun keep () =
+               SOME (Statement.T {var = var,
+                                  ty = ty,
+                                  exp = Exp.replaceVar (exp, replaceVar)})
+         in
+            case var of
+               NONE => keep ()
+             | SOME var => 
+                  (case (Value.global (value var, newGlobal), exp) of
+                      (NONE, _) => keep ()
+                    | (SOME _, PrimApp {prim, ...}) =>
+                         if Prim.maySideEffect prim
+                            then keep ()
+                         else NONE
+                    | _ => NONE)
+         end
       fun doitTransfer transfer =
-	 Transfer.replaceVar (transfer, replaceVar)
+         Transfer.replaceVar (transfer, replaceVar)
       fun doitBlock (Block.T {label, args, statements, transfer}) =
-	 Block.T {label = label,
-		  args = args,
-		  statements = Vector.keepAllMap (statements, doitStatement),
-		  transfer = doitTransfer transfer}
+         Block.T {label = label,
+                  args = args,
+                  statements = Vector.keepAllMap (statements, doitStatement),
+                  transfer = doitTransfer transfer}
       fun doitFunction f =
-	 let
-	    val {args, blocks, mayInline, name, raises, returns, start} =
-	       Function.dest f
-	 in
-	    Function.new {args = args,
-			  blocks = Vector.map (blocks, doitBlock),
-			  mayInline = mayInline,
-			  name = name,
-			  raises = raises,
-			  returns = returns,
-			  start = start}
-	 end
+         let
+            val {args, blocks, mayInline, name, raises, returns, start} =
+               Function.dest f
+         in
+            Function.new {args = args,
+                          blocks = Vector.map (blocks, doitBlock),
+                          mayInline = mayInline,
+                          name = name,
+                          raises = raises,
+                          returns = returns,
+                          start = start}
+         end
       val functions = List.revMap (functions, doitFunction)
       val globals = Vector.keepAllMap (globals, doitStatement)
       val globals = Vector.concat [allGlobals (), globals]
       val shrink = shrinkFunction {globals = globals}
       val program = Program.T {datatypes = datatypes,
-			       globals = globals,
-			       functions = List.revMap (functions, shrink),
-			       main = main}
+                               globals = globals,
+                               functions = List.revMap (functions, shrink),
+                               main = main}
       val _ = Program.clearTop program
    in
       program

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ssa/constant-propagation.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ssa/constant-propagation.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ssa/constant-propagation.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature CONSTANT_PROPAGATION_STRUCTS = 
    sig
       include SHRINK

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ssa/contify.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ssa/contify.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ssa/contify.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 (*
  * This pass is based on
  * Contification Using Dominators, by Fluet and Weeks.  ICFP 2001.
@@ -22,10 +23,10 @@
 
     fun layout {cont, handler}
       = let
-	  open Layout
-	in
-	  tuple2 (Label.layout, Handler.layout) (cont, handler)
-	end
+          open Layout
+        in
+          tuple2 (Label.layout, Handler.layout) (cont, handler)
+        end
   end
 
 (* Return = {Uncalled, Unknown} U Cont U Func
@@ -40,33 +41,33 @@
 
     fun layout r
       = let 
-	  open Layout
-	in
-	  case r
-	    of Uncalled => str "Uncalled"
-	     | Unknown => str "Unknown"
-	     | Cont c => Cont.layout c
-	     | Func f => Func.layout f
-	end
+          open Layout
+        in
+          case r
+            of Uncalled => str "Uncalled"
+             | Unknown => str "Unknown"
+             | Cont c => Cont.layout c
+             | Func f => Func.layout f
+        end
   end
 
 structure ContData =
   struct
     datatype t = T of {node: unit DirectedGraph.Node.t option ref,
-		       rootEdge: bool ref,
-		       prefixes: Func.t list ref}
+                       rootEdge: bool ref,
+                       prefixes: Func.t list ref}
       
     fun new () = T {node = ref NONE,
-		    rootEdge = ref false,
-		    prefixes = ref []}
+                    rootEdge = ref false,
+                    prefixes = ref []}
 
     local
       fun make s = let
-		     fun S' (T r) = s r
-		     val S = ! o S'
-		   in
-		     (S', S)
-		   end
+                     fun S' (T r) = s r
+                     val S = ! o S'
+                   in
+                     (S', S)
+                   end
     in
       val (node', _) = make #node
       val (rootEdge', _) = make #rootEdge
@@ -78,40 +79,40 @@
 structure FuncData =
   struct
     datatype t = T of {node: unit DirectedGraph.Node.t option ref,
-		       reach: bool ref,
-		       callers: {nontail: (Func.t * Cont.t) list ref,
-				 tail: Func.t list ref},
-		       callees: {nontail: (Func.t * Cont.t) list ref,
-				 tail: Func.t list ref},
-		       A: Areturn.t ref,
-		       prefixes: Func.t list ref,
-		       finished: bool ref,
-		       replace: {label: Label.t,
-				 blocks: Block.t list} option ref,
-		       contified: Block.t list list ref}
+                       reach: bool ref,
+                       callers: {nontail: (Func.t * Cont.t) list ref,
+                                 tail: Func.t list ref},
+                       callees: {nontail: (Func.t * Cont.t) list ref,
+                                 tail: Func.t list ref},
+                       A: Areturn.t ref,
+                       prefixes: Func.t list ref,
+                       finished: bool ref,
+                       replace: {label: Label.t,
+                                 blocks: Block.t list} option ref,
+                       contified: Block.t list list ref}
 
     fun new () = T {node = ref NONE,
-		    reach = ref false,
-		    callers = {nontail = ref [], tail = ref []},
-		    callees = {nontail = ref [], tail = ref []},
-		    A = ref Areturn.Uncalled,
-		    prefixes = ref [],
-		    finished = ref false,
-		    replace = ref NONE,
-		    contified = ref []}
+                    reach = ref false,
+                    callers = {nontail = ref [], tail = ref []},
+                    callees = {nontail = ref [], tail = ref []},
+                    A = ref Areturn.Uncalled,
+                    prefixes = ref [],
+                    finished = ref false,
+                    replace = ref NONE,
+                    contified = ref []}
       
     local
       fun make s = let
-		     fun S' (T r) = s r
-		     val S = ! o S'
-		   in
-		     (S', S)
-		   end
+                     fun S' (T r) = s r
+                     val S = ! o S'
+                   in
+                     (S', S)
+                   end
       fun make' s = let
-		      fun S' (T r) = s r
-		    in
-		      S'
-		    end
+                      fun S' (T r) = s r
+                    in
+                      S'
+                    end
     in
       val (node', _) = make #node
       val (reach', reach) = make #reach
@@ -134,78 +135,78 @@
     datatype t = ContNode of Cont.t
                | FuncNode of Func.t
     fun newContFuncGraph {getContData: Cont.t -> ContData.t,
-			  getFuncData: Func.t -> FuncData.t}
+                          getFuncData: Func.t -> FuncData.t}
       = let
-	  val G = Graph.new ()
-	  fun addEdge edge
-	    = ignore (Graph.addEdge (G, edge))
-	  val {get = getNodeInfo : unit Node.t -> t, 
-	       set = setNodeInfo, ...}
-	    = Property.getSetOnce
-	      (Node.plist,
-	       Property.initRaise ("nodeInfo", Node.layout))
-	  fun getFuncNode f
-	    = let
-		val node = FuncData.node' (getFuncData f)
-	      in
-		case !node
-		  of SOME n => n
-		   | NONE => let
-			       val n = Graph.newNode G
-			     in
-			       setNodeInfo (n, FuncNode f);
-			       node := SOME n;
-			       n
-			     end
-	      end
+          val G = Graph.new ()
+          fun addEdge edge
+            = ignore (Graph.addEdge (G, edge))
+          val {get = getNodeInfo : unit Node.t -> t, 
+               set = setNodeInfo, ...}
+            = Property.getSetOnce
+              (Node.plist,
+               Property.initRaise ("nodeInfo", Node.layout))
+          fun getFuncNode f
+            = let
+                val node = FuncData.node' (getFuncData f)
+              in
+                case !node
+                  of SOME n => n
+                   | NONE => let
+                               val n = Graph.newNode G
+                             in
+                               setNodeInfo (n, FuncNode f);
+                               node := SOME n;
+                               n
+                             end
+              end
 
-	  fun getContNode c
-	    = let
-		val node = ContData.node' (getContData c)
-	      in
-		case !node
-		  of SOME n => n
-		   | NONE => let
-			       val n = Graph.newNode G
-			     in
-			       setNodeInfo (n, ContNode c);
-			       node := SOME n;
-			       n
-			     end
-	      end
+          fun getContNode c
+            = let
+                val node = ContData.node' (getContData c)
+              in
+                case !node
+                  of SOME n => n
+                   | NONE => let
+                               val n = Graph.newNode G
+                             in
+                               setNodeInfo (n, ContNode c);
+                               node := SOME n;
+                               n
+                             end
+              end
 
-	  fun reset p
-	    = Graph.foreachNode
-	      (G,
-	       fn n => if p n
-			 then case getNodeInfo n
-				of ContNode c
-				 => ContData.nodeReset (getContData c)
-		                 | FuncNode f 
-			         => FuncData.nodeReset (getFuncData f)
-			 else ())
-	in
-	  {G = G, 
-	   addEdge = addEdge, 
-	   getNodeInfo = getNodeInfo, 
-	   getContNode = getContNode, 
-	   getFuncNode = getFuncNode,
-	   reset = reset}
-	end
+          fun reset p
+            = Graph.foreachNode
+              (G,
+               fn n => if p n
+                         then case getNodeInfo n
+                                of ContNode c
+                                 => ContData.nodeReset (getContData c)
+                                 | FuncNode f 
+                                 => FuncData.nodeReset (getFuncData f)
+                         else ())
+        in
+          {G = G, 
+           addEdge = addEdge, 
+           getNodeInfo = getNodeInfo, 
+           getContNode = getContNode, 
+           getFuncNode = getFuncNode,
+           reset = reset}
+        end
     fun newFuncGraph {getFuncData: Func.t -> FuncData.t}
       = let
-	  val {G, addEdge, getNodeInfo, getFuncNode, reset, ...}
-	    = newContFuncGraph {getContData = fn _ => Error.bug "newFuncGraph",
-				getFuncData = getFuncData}
-	in
-	  {G = G,
-	   addEdge = addEdge,
-	   getNodeInfo = fn n => case getNodeInfo n
-				   of FuncNode f => f
-				    | ContNode _ => Error.bug "newFuncGraph",
-	   getFuncNode = getFuncNode,
-	   reset = reset}
-	end
+          val {G, addEdge, getNodeInfo, getFuncNode, reset, ...}
+            = newContFuncGraph {getContData = fn _ => Error.bug "Contify.ContFuncGraph.newFuncGraph",
+                                getFuncData = getFuncData}
+        in
+          {G = G,
+           addEdge = addEdge,
+           getNodeInfo = fn n => case getNodeInfo n
+                                   of FuncNode f => f
+                                    | ContNode _ => Error.bug "Contify.ContFuncGraph.newFuncGraph",
+           getFuncNode = getFuncNode,
+           reset = reset}
+        end
   end
 
 structure InitReachCallersCallees =
@@ -242,48 +243,48 @@
      *)
     fun initReachCallersCallees 
         {program = Program.T {functions, main = fm, ...},
-	 getFuncData: Func.t -> FuncData.t} : unit
+         getFuncData: Func.t -> FuncData.t} : unit
       = let
-	  val {G, addEdge, getNodeInfo, getFuncNode, reset, ...}
-	    = ContFuncGraph.newFuncGraph {getFuncData = getFuncData}
+          val {G, addEdge, getNodeInfo, getFuncNode, reset, ...}
+            = ContFuncGraph.newFuncGraph {getFuncData = getFuncData}
 
-	  val _ 
-	    = List.foreach
-	      (functions,
-	       fn func
-	        => let
-		     val {name = f, blocks, ...} = Function.dest func
-		     val callees = FuncData.callees' (getFuncData f)
-		     val f_node = getFuncNode f
-		   in
-		     Vector.foreach
-		     (blocks,
-		      fn Block.T {transfer = Call {func = g, return, ...}, ...}
-		       => let
-			    val callers = FuncData.callers' (getFuncData g)
-			    val g_node = getFuncNode g
-			    val _ =
-			       case return of
-				  Return.NonTail c =>
-				     (List.push (#nontail callees, (g, c));
-				      List.push (#nontail callers, (f, c)))
-				| _ => (List.push (#tail callees, g);
-					List.push (#tail callers, f))
-			  in
-			    addEdge {from = f_node,
-				     to = g_node}
-			  end
+          val _ 
+            = List.foreach
+              (functions,
+               fn func
+                => let
+                     val {name = f, blocks, ...} = Function.dest func
+                     val callees = FuncData.callees' (getFuncData f)
+                     val f_node = getFuncNode f
+                   in
+                     Vector.foreach
+                     (blocks,
+                      fn Block.T {transfer = Call {func = g, return, ...}, ...}
+                       => let
+                            val callers = FuncData.callers' (getFuncData g)
+                            val g_node = getFuncNode g
+                            val _ =
+                               case return of
+                                  Return.NonTail c =>
+                                     (List.push (#nontail callees, (g, c));
+                                      List.push (#nontail callers, (f, c)))
+                                | _ => (List.push (#tail callees, g);
+                                        List.push (#tail callers, f))
+                          in
+                            addEdge {from = f_node,
+                                     to = g_node}
+                          end
                        | _ => ())
-		   end)
-	      
-	  val dfs_param
-	    = DfsParam.finishNode
-	      (fn n => FuncData.reach' (getFuncData (getNodeInfo n)) := true)
-	  val fm_node = getFuncNode fm
-	in
-	  Graph.dfsNodes (G, [fm_node], dfs_param);
-	  reset (fn _ => true)
-	end
+                   end)
+              
+          val dfs_param
+            = DfsParam.finishNode
+              (fn n => FuncData.reach' (getFuncData (getNodeInfo n)) := true)
+          val fm_node = getFuncNode fm
+        in
+          Graph.dfsNodes (G, [fm_node], dfs_param);
+          reset (fn _ => true)
+        end
     val initReachCallersCallees
        = Control.trace (Control.Detail, "initReachCallerCallees") 
                        initReachCallersCallees 
@@ -320,155 +321,155 @@
      *                forall f in Func. (FuncData.node o getFuncData) f = NONE
      *)
     fun analyzeDom {program as Program.T {functions, main = fm, ...},
-		    getContData: Cont.t -> ContData.t,
-		    getFuncData: Func.t -> FuncData.t} : unit
+                    getContData: Cont.t -> ContData.t,
+                    getFuncData: Func.t -> FuncData.t} : unit
       = let
-	  datatype z = datatype Areturn.t
+          datatype z = datatype Areturn.t
 
-	  val {G, addEdge, getNodeInfo, getContNode, getFuncNode, reset, ...}
-	    = ContFuncGraph.newContFuncGraph {getContData = getContData,
-					      getFuncData = getFuncData}
-	  val Root = DirectedGraph.newNode G
+          val {G, addEdge, getNodeInfo, getContNode, getFuncNode, reset, ...}
+            = ContFuncGraph.newContFuncGraph {getContData = getContData,
+                                              getFuncData = getFuncData}
+          val Root = DirectedGraph.newNode G
 
-	  fun buildGraph () = let
-	  val fm_node = getFuncNode fm
-	  (* {(Root, fm)} *)
-	  val _ = addEdge {from = Root, to = fm_node}
-	  (* { (Root, f) | fm calls f } *)
-	  val () =
-	     if !Control.contifyIntoMain
-		then ()
-	     else
-		let
-		   val {blocks, ...} =
-		      Function.dest (Program.mainFunction program)
-		in
-		   Vector.foreach
-		   (blocks, fn Block.T {transfer, ...} =>
-		    case transfer of
-		       Call {func, ...} =>
-			  addEdge {from = Root, to = getFuncNode func}
-		     | _ => ())
-		end
-	  val _
-	    = List.foreach
-	      (functions,
-	       fn func
-	        => let
-		     val {name = f, blocks, ...} = Function.dest func
-		     val f_reach = FuncData.reach (getFuncData f)
-		     val f_node = getFuncNode f
-		   in
-		     if f_reach
-		       then Vector.foreach
-			    (blocks,
-			     fn Block.T {transfer = Call {func = g, return, ...}, ...}
-			      => if FuncData.reach (getFuncData g)
-				   then let
-					  val g_node = getFuncNode g
-					in
-					  case return of
-					     Return.Dead =>
-						(* When compiling with profiling,
-						 * Dead returns are allowed to
-						 * have nonempty source stacks
-						 * (see type-check.fun).  So, we
-						 * can't contify functions that
-						 * are called with a Dead cont.
-						 *)
-						addEdge {from = Root,
-							 to = g_node}
-					   | Return.NonTail c =>
-						let
-						   val c_node = getContNode c
-						   val rootEdge 
-						      = ContData.rootEdge'
-						      (getContData c)
-						in
-						   if !rootEdge
-						      then ()
-						   else ((* {(Root, c) | c in Cont} *)
-							 addEdge {from = Root,
-								  to = c_node};
-							 rootEdge := true);
-						      (* {(c, g) | (f, g, c) in N
-						       *       and Reach (f)} *)
-						      addEdge {from = c_node,
-							       to = g_node}
-						end
-					   | _ =>
-						(* {(f, g) | (f, g) in T 
-						 *       and Reach (f)} *)
-						addEdge {from = f_node,
-							 to = g_node}
-					end
-				   else ()
-			      | _ => ())
-		       else (* {(Root, f) | not (Reach (f))} *)
-			    addEdge {from = Root,
-				     to = f_node}
-		   end)
+          fun buildGraph () = let
+          val fm_node = getFuncNode fm
+          (* {(Root, fm)} *)
+          val _ = addEdge {from = Root, to = fm_node}
+          (* { (Root, f) | fm calls f } *)
+          val () =
+             if !Control.contifyIntoMain
+                then ()
+             else
+                let
+                   val {blocks, ...} =
+                      Function.dest (Program.mainFunction program)
+                in
+                   Vector.foreach
+                   (blocks, fn Block.T {transfer, ...} =>
+                    case transfer of
+                       Call {func, ...} =>
+                          addEdge {from = Root, to = getFuncNode func}
+                     | _ => ())
+                end
+          val _
+            = List.foreach
+              (functions,
+               fn func
+                => let
+                     val {name = f, blocks, ...} = Function.dest func
+                     val f_reach = FuncData.reach (getFuncData f)
+                     val f_node = getFuncNode f
+                   in
+                     if f_reach
+                       then Vector.foreach
+                            (blocks,
+                             fn Block.T {transfer = Call {func = g, return, ...}, ...}
+                              => if FuncData.reach (getFuncData g)
+                                   then let
+                                          val g_node = getFuncNode g
+                                        in
+                                          case return of
+                                             Return.Dead =>
+                                                (* When compiling with profiling,
+                                                 * Dead returns are allowed to
+                                                 * have nonempty source stacks
+                                                 * (see type-check.fun).  So, we
+                                                 * can't contify functions that
+                                                 * are called with a Dead cont.
+                                                 *)
+                                                addEdge {from = Root,
+                                                         to = g_node}
+                                           | Return.NonTail c =>
+                                                let
+                                                   val c_node = getContNode c
+                                                   val rootEdge 
+                                                      = ContData.rootEdge'
+                                                      (getContData c)
+                                                in
+                                                   if !rootEdge
+                                                      then ()
+                                                   else ((* {(Root, c) | c in Cont} *)
+                                                         addEdge {from = Root,
+                                                                  to = c_node};
+                                                         rootEdge := true);
+                                                      (* {(c, g) | (f, g, c) in N
+                                                       *       and Reach (f)} *)
+                                                      addEdge {from = c_node,
+                                                               to = g_node}
+                                                end
+                                           | _ =>
+                                                (* {(f, g) | (f, g) in T 
+                                                 *       and Reach (f)} *)
+                                                addEdge {from = f_node,
+                                                         to = g_node}
+                                        end
+                                   else ()
+                              | _ => ())
+                       else (* {(Root, f) | not (Reach (f))} *)
+                            addEdge {from = Root,
+                                     to = f_node}
+                   end)
           in () end
-	  val buildGraph 
-	    = Control.trace (Control.Detail, "buildGraph") buildGraph
-	  val _ = buildGraph ()
+          val buildGraph 
+            = Control.trace (Control.Detail, "buildGraph") buildGraph
+          val _ = buildGraph ()
 
-	  fun computeDominators () = let
-	  val {idom} = Graph.dominators (G, {root = Root})
+          fun computeDominators () = let
+          val {idom} = Graph.dominators (G, {root = Root})
           in idom end
-	  val computeDominators 
-	    = Control.trace (Control.Detail, "computeDominators") computeDominators
-	  val idom = computeDominators ()
+          val computeDominators 
+            = Control.trace (Control.Detail, "computeDominators") computeDominators
+          val idom = computeDominators ()
 
-	  fun computeADom () = let
+          fun computeADom () = let
           fun ancestor node =
-	     case idom node of
-		Graph.Idom parent =>
-		   if Node.equals (parent, Root)
-		      then node
-		   else ancestor parent
-	      | Graph.Root => node
-	      | Graph.Unreachable => Error.bug "unreachable"
+             case idom node of
+                Graph.Idom parent =>
+                   if Node.equals (parent, Root)
+                      then node
+                   else ancestor parent
+              | Graph.Root => node
+              | Graph.Unreachable => Error.bug "Contify.AnalyzeDom.ancestor: unreachable"
 
           val _
-	    = List.foreach
-	      (functions,
-	       fn func
-	        => let
-		     val {name = f, ...} = Function.dest func
-		     val FuncData.T {A, reach, node, ...} = getFuncData f
-		     val f_ADom = A
-		     val f_reach = !reach
-		     val f_node = valOf (!node)
-		     datatype z = datatype ContFuncGraph.t
-		   in
-		     if (case idom f_node of
-			    Graph.Idom n => Node.equals (n, Root)
-			  | Graph.Root => true
-			  | Graph.Unreachable => Error.bug "unreachable")
-		       then if f_reach
-			      then f_ADom := Unknown
-			      else f_ADom := Uncalled
-		       else let
-			      (* Use this for the ancestor version *)
+            = List.foreach
+              (functions,
+               fn func
+                => let
+                     val {name = f, ...} = Function.dest func
+                     val FuncData.T {A, reach, node, ...} = getFuncData f
+                     val f_ADom = A
+                     val f_reach = !reach
+                     val f_node = valOf (!node)
+                     datatype z = datatype ContFuncGraph.t
+                   in
+                     if (case idom f_node of
+                            Graph.Idom n => Node.equals (n, Root)
+                          | Graph.Root => true
+                          | Graph.Unreachable => Error.bug "Contify.AnalyzeDom.idom: unreachable")
+                       then if f_reach
+                              then f_ADom := Unknown
+                              else f_ADom := Uncalled
+                       else let
+                              (* Use this for the ancestor version *)
                               val l_node = ancestor f_node
-			      (* Use this for the parent version *)
-			      (* val l_node = idom f_node *)
-			    in
-			      case getNodeInfo l_node
-				of FuncNode g => f_ADom := Func g
-				 | ContNode c => f_ADom := Cont c
-			    end
-		   end)
-	  in () end
-	  val computeADom 
-	    = Control.trace (Control.Detail, "compute ADom") computeADom
-	  val _ = computeADom ()
+                              (* Use this for the parent version *)
+                              (* val l_node = idom f_node *)
+                            in
+                              case getNodeInfo l_node
+                                of FuncNode g => f_ADom := Func g
+                                 | ContNode c => f_ADom := Cont c
+                            end
+                   end)
+          in () end
+          val computeADom 
+            = Control.trace (Control.Detail, "compute ADom") computeADom
+          val _ = computeADom ()
 
-	  val _ = reset (fn n => not (Node.equals (n, Root)))
-	in
-	  ()
-	end
+          val _ = reset (fn n => not (Node.equals (n, Root)))
+        in
+          ()
+        end
     val analyzeDom 
       = Control.trace (Control.Detail, "analyzeDom") analyzeDom
 end
@@ -492,236 +493,236 @@
      *                forall f in Func. (FuncData.node o getFuncData) f = NONE
      *)
     fun transform {program = Program.T {datatypes, globals, functions, main},
-		   getFuncData: Func.t -> FuncData.t,
-		   getContData: Cont.t -> ContData.t} : Program.t
+                   getFuncData: Func.t -> FuncData.t,
+                   getContData: Cont.t -> ContData.t} : Program.t
       = let
-	  datatype z = datatype Areturn.t
+          datatype z = datatype Areturn.t
 
-    	  (* For functions turned into continuations,
-	   *  record their args, blocks, and new name.
-	   *)
-	  val _ 
-	    = List.foreach
-	      (functions,
-	       fn func
-	        => let
-		     val {name = f, 
-			  args = f_args, 
-			  blocks = f_blocks, 
-			  start = f_start,
-			  ...} = Function.dest func
-		     val FuncData.T {A, replace, ...} = getFuncData f
+          (* For functions turned into continuations,
+           *  record their args, blocks, and new name.
+           *)
+          val _ 
+            = List.foreach
+              (functions,
+               fn func
+                => let
+                     val {name = f, 
+                          args = f_args, 
+                          blocks = f_blocks, 
+                          start = f_start,
+                          ...} = Function.dest func
+                     val FuncData.T {A, replace, ...} = getFuncData f
 
-		     val _ = Control.diagnostics
-		             (fn display
-			       => let open Layout
-				  in display (seq [str "A(", 
-						   Func.layout f,
-						   str ") = ",
-						   Areturn.layout (!A)])
-				  end)
-						   
+                     val _ = Control.diagnostics
+                             (fn display
+                               => let open Layout
+                                  in display (seq [str "A(", 
+                                                   Func.layout f,
+                                                   str ") = ",
+                                                   Areturn.layout (!A)])
+                                  end)
+                                                   
 
-		     fun contify prefixes
-		       = let
-			   val f_label = Label.newString (Func.originalName f)
-			   val _ = Control.diagnostics
-			           (fn display 
-				     => let open Layout
-					in display (seq [Func.layout f,
-							 str " -> ",
-							 Label.layout f_label])
-					end)
-			   val f_blocks 
-			     = (Block.T {label = f_label,
-					 args = f_args,
-					 statements = Vector.new0 (),
-					 transfer = Goto {dst = f_start,
-							  args = Vector.new0 ()}})::
-			       (Vector.toList f_blocks)
-			 in 
-			   replace := SOME {label = f_label,
-					    blocks = f_blocks} ;
-			   List.push(prefixes, f)
-			 end
-		   in
-		     case !A
-		       of Uncalled => ()
-			| Unknown => ()
-			| Cont c => contify (ContData.prefixes' (getContData c))
-			| Func g => contify (FuncData.prefixes' (getFuncData g))
-		   end)
+                     fun contify prefixes
+                       = let
+                           val f_label = Label.newString (Func.originalName f)
+                           val _ = Control.diagnostics
+                                   (fn display 
+                                     => let open Layout
+                                        in display (seq [Func.layout f,
+                                                         str " -> ",
+                                                         Label.layout f_label])
+                                        end)
+                           val f_blocks 
+                             = (Block.T {label = f_label,
+                                         args = f_args,
+                                         statements = Vector.new0 (),
+                                         transfer = Goto {dst = f_start,
+                                                          args = Vector.new0 ()}})::
+                               (Vector.toList f_blocks)
+                         in 
+                           replace := SOME {label = f_label,
+                                            blocks = f_blocks} ;
+                           List.push(prefixes, f)
+                         end
+                   in
+                     case !A
+                       of Uncalled => ()
+                        | Unknown => ()
+                        | Cont c => contify (ContData.prefixes' (getContData c))
+                        | Func g => contify (FuncData.prefixes' (getFuncData g))
+                   end)
 
-	  val traceAddFuncs =
-	     Trace.trace3 ("addFuncs",
-			   Func.layout,
-			   List.layout Func.layout,
-			   Return.layout,
-			   Unit.layout)
-	  val traceTransBlock =
-	     Trace.trace3 ("transBlock",
-			   Func.layout,
-			   Label.layout o Block.label,
-			   Return.layout,
-			   Layout.ignore)
-	  (* Walk over all functions, removing those that aren't top level,
-	   *  and descening those that are, inserting local functions
-	   *  where necessary.
-	   * - turn tail calls into nontail calls
-	   * - turn returns into gotos
-	   * - turn raises into gotos
-	   *)
-	  fun addFuncPrefixes (f: Func.t,
-			       g: Func.t,
-			       c: Return.t) : unit
-	    = let
-		val prefixes = FuncData.prefixes (getFuncData g)
-		val _ = Control.diagnostics
-		        (fn display
-			  => let open Layout
-			     in display (seq [str "addFuncPrefixes: ",
-					      Func.layout f,
-					      str " ",
-					      Func.layout g,
-					      str " ",
-					      List.layout Func.layout prefixes])
-			     end)
-	      in 
-		addFuncs (f, prefixes, c)
-	      end
-	  and addContPrefixes (f: Func.t,
-			       r: Cont.t,
-			       c: Return.t): unit
-	    = let
-		val prefixes = ContData.prefixes (getContData r)
-		val _ = Control.diagnostics
-		        (fn display
-			  => let open Layout
-			     in display (seq [str "addContPrefixes: ",
-					      Func.layout f,
-					      str " ",
-					      Cont.layout r,
-					      str " ",
-					      List.layout Func.layout prefixes])
-			     end)
+          val traceAddFuncs =
+             Trace.trace3 ("Contify.Transform.addFuncs",
+                           Func.layout,
+                           List.layout Func.layout,
+                           Return.layout,
+                           Unit.layout)
+          val traceTransBlock =
+             Trace.trace3 ("Contify.Transform.transBlock",
+                           Func.layout,
+                           Label.layout o Block.label,
+                           Return.layout,
+                           Layout.ignore)
+          (* Walk over all functions, removing those that aren't top level,
+           *  and descening those that are, inserting local functions
+           *  where necessary.
+           * - turn tail calls into nontail calls
+           * - turn returns into gotos
+           * - turn raises into gotos
+           *)
+          fun addFuncPrefixes (f: Func.t,
+                               g: Func.t,
+                               c: Return.t) : unit
+            = let
+                val prefixes = FuncData.prefixes (getFuncData g)
+                val _ = Control.diagnostics
+                        (fn display
+                          => let open Layout
+                             in display (seq [str "addFuncPrefixes: ",
+                                              Func.layout f,
+                                              str " ",
+                                              Func.layout g,
+                                              str " ",
+                                              List.layout Func.layout prefixes])
+                             end)
+              in 
+                addFuncs (f, prefixes, c)
+              end
+          and addContPrefixes (f: Func.t,
+                               r: Cont.t,
+                               c: Return.t): unit
+            = let
+                val prefixes = ContData.prefixes (getContData r)
+                val _ = Control.diagnostics
+                        (fn display
+                          => let open Layout
+                             in display (seq [str "addContPrefixes: ",
+                                              Func.layout f,
+                                              str " ",
+                                              Cont.layout r,
+                                              str " ",
+                                              List.layout Func.layout prefixes])
+                             end)
 
-	      in 
-		addFuncs (f, prefixes, Return.compose (c, Return.NonTail r))
-	      end
-	  and addFuncs arg : unit =
-	     traceAddFuncs
-	     (fn (f: Func.t,
-		  gs: Func.t list,
-		  c: Return.t) =>
-	     List.foreach
-	      (gs,
-	       fn g => let
-			 val finished = FuncData.finished' (getFuncData g)
-		       in
-			 if !finished
-			   then ()
-			   else (addFuncPrefixes(f, g, c);
-				 addBlocks
-				 (f,
-				  #blocks (valOf (FuncData.replace (getFuncData g))),
-				  c);
-				 finished := true)
-		       end)
-	      ) arg
-	  and addBlocks (f: Func.t,
-			 blocks: Block.t list,
-			 c: Return.t) : unit
-	    = let
-		val contified' = List.map(blocks, 
-					  fn block => transBlock (f, block, c))
-		val contified = FuncData.contified' (getFuncData f)
-	      in
-		List.push(contified, contified')
-	      end
-	  and transBlock arg: Block.t =
-	     traceTransBlock
-	     (fn (f: Func.t, 
-		  Block.T {label, args, statements, transfer},
-		  c: Return.t) =>
-	     let
-		val transfer
-		  = case transfer
-		      of Call {func, args, return}
-		       => ((case return of
-			       Return.NonTail r => addContPrefixes (f, r, c)
-			     | _ => ());
-			   case FuncData.replace (getFuncData func) of
-			      NONE => Call {func = func,
-					    args = args,
-					    return = Return.compose (c, return)}
-			    | SOME {label, ...} =>
-				 Goto {dst = label, args = args})
-		       | Return xs
-		       => (case c
-			     of Return.NonTail {cont, ...}
-			      => Goto {dst = cont, args = xs}
-			      | _ => transfer)
-		       | Raise xs
-		       => (case c
-			     of Return.NonTail {handler = Handler.Handle handler, ...} 
-			      => Goto {dst = handler, args = xs}
-			      | _ => transfer)
-		       | _ => transfer
-	      in
-		Block.T {label = label,
-			 args = args,
-			 statements = statements,
-			 transfer = transfer}
-	      end) arg
+              in 
+                addFuncs (f, prefixes, Return.compose (c, Return.NonTail r))
+              end
+          and addFuncs arg : unit =
+             traceAddFuncs
+             (fn (f: Func.t,
+                  gs: Func.t list,
+                  c: Return.t) =>
+             List.foreach
+              (gs,
+               fn g => let
+                         val finished = FuncData.finished' (getFuncData g)
+                       in
+                         if !finished
+                           then ()
+                           else (addFuncPrefixes(f, g, c);
+                                 addBlocks
+                                 (f,
+                                  #blocks (valOf (FuncData.replace (getFuncData g))),
+                                  c);
+                                 finished := true)
+                       end)
+              ) arg
+          and addBlocks (f: Func.t,
+                         blocks: Block.t list,
+                         c: Return.t) : unit
+            = let
+                val contified' = List.map(blocks, 
+                                          fn block => transBlock (f, block, c))
+                val contified = FuncData.contified' (getFuncData f)
+              in
+                List.push(contified, contified')
+              end
+          and transBlock arg: Block.t =
+             traceTransBlock
+             (fn (f: Func.t, 
+                  Block.T {label, args, statements, transfer},
+                  c: Return.t) =>
+             let
+                val transfer
+                  = case transfer
+                      of Call {func, args, return}
+                       => ((case return of
+                               Return.NonTail r => addContPrefixes (f, r, c)
+                             | _ => ());
+                           case FuncData.replace (getFuncData func) of
+                              NONE => Call {func = func,
+                                            args = args,
+                                            return = Return.compose (c, return)}
+                            | SOME {label, ...} =>
+                                 Goto {dst = label, args = args})
+                       | Return xs
+                       => (case c
+                             of Return.NonTail {cont, ...}
+                              => Goto {dst = cont, args = xs}
+                              | _ => transfer)
+                       | Raise xs
+                       => (case c
+                             of Return.NonTail {handler = Handler.Handle handler, ...} 
+                              => Goto {dst = handler, args = xs}
+                              | _ => transfer)
+                       | _ => transfer
+              in
+                Block.T {label = label,
+                         args = args,
+                         statements = statements,
+                         transfer = transfer}
+              end) arg
 
-	  val shrink = shrinkFunction {globals = globals}
+          val shrink = shrinkFunction {globals = globals}
 
-	  val functions
-	    = List.fold
-	      (functions, [], fn (func, ac) =>
-	       let
-		  val {args = f_args, 
-		       blocks = f_blocks,
-		       mayInline = f_mayInline,
-		       name = f, 
-		       raises = f_raises,
-		       returns = f_returns,
-		       start = f_start} = Function.dest func
-	       in
-		  case FuncData.A (getFuncData f)
-		     of Unknown
-			=> let
-			      val _ = addFuncPrefixes (f, f, Return.Tail)
-			      val f_blocks =
-				 Vector.toListMap
-				 (f_blocks, fn block =>
-				  transBlock (f, block, Return.Tail))
-			      val f_blocks
-				 = f_blocks::
-			         (FuncData.contified (getFuncData f))
-			      val f_blocks
-				 = Vector.fromList (List.concat f_blocks)
-			   in 
-			      shrink (Function.new {args = f_args,
-						    blocks = f_blocks,
-						    mayInline = f_mayInline,
-						    name = f,
-						    raises = f_raises,
-						    returns = f_returns,
-						    start = f_start})
-			      :: ac
-			   end
-		      | _ => ac
-	       end)
+          val functions
+            = List.fold
+              (functions, [], fn (func, ac) =>
+               let
+                  val {args = f_args, 
+                       blocks = f_blocks,
+                       mayInline = f_mayInline,
+                       name = f, 
+                       raises = f_raises,
+                       returns = f_returns,
+                       start = f_start} = Function.dest func
+               in
+                  case FuncData.A (getFuncData f)
+                     of Unknown
+                        => let
+                              val _ = addFuncPrefixes (f, f, Return.Tail)
+                              val f_blocks =
+                                 Vector.toListMap
+                                 (f_blocks, fn block =>
+                                  transBlock (f, block, Return.Tail))
+                              val f_blocks
+                                 = f_blocks::
+                                 (FuncData.contified (getFuncData f))
+                              val f_blocks
+                                 = Vector.fromList (List.concat f_blocks)
+                           in 
+                              shrink (Function.new {args = f_args,
+                                                    blocks = f_blocks,
+                                                    mayInline = f_mayInline,
+                                                    name = f,
+                                                    raises = f_raises,
+                                                    returns = f_returns,
+                                                    start = f_start})
+                              :: ac
+                           end
+                      | _ => ac
+               end)
 
-	  val program 
-	    = Program.T {datatypes = datatypes,
-			 globals = globals,
-			 functions = functions,
-			 main = main}
-	in
-	  program
-	end
+          val program 
+            = Program.T {datatypes = datatypes,
+                         globals = globals,
+                         functions = functions,
+                         main = main}
+        in
+          program
+        end
     val transform 
       = Control.trace (Control.Detail, "transform") transform
   end
@@ -729,40 +730,40 @@
 fun contify (program as Program.T _)
   = let
       val {get = getLabelInfo : Label.t -> (Handler.t * ContData.t) list ref,
-	   ...}
-	= Property.get 
-	  (Label.plist, Property.initFun (fn _ => ref []))
+           ...}
+        = Property.get 
+          (Label.plist, Property.initFun (fn _ => ref []))
       val getContData : Cont.t -> ContData.t
-	= fn {cont, handler}
-	   => let 
-		val l = getLabelInfo cont
-	      in 
-		case List.peek (!l, fn (handler', _) =>
-				Handler.equals (handler, handler'))
-		  of SOME (_, cd) => cd
-		   | NONE => let
-			       val cd = ContData.new ()
-			       val _ = List.push(l, (handler, cd))
-			     in
-			       cd
-			     end
-	      end
+        = fn {cont, handler}
+           => let 
+                val l = getLabelInfo cont
+              in 
+                case List.peek (!l, fn (handler', _) =>
+                                Handler.equals (handler, handler'))
+                  of SOME (_, cd) => cd
+                   | NONE => let
+                               val cd = ContData.new ()
+                               val _ = List.push(l, (handler, cd))
+                             in
+                               cd
+                             end
+              end
       val {get = getFuncData : Func.t -> FuncData.t, ...}
-	= Property.get (Func.plist,
-			Property.initFun
-			(fn _ => FuncData.new ()))
+        = Property.get (Func.plist,
+                        Property.initFun
+                        (fn _ => FuncData.new ()))
 
       val _ = InitReachCallersCallees.initReachCallersCallees 
-	      {program = program,
-	       getFuncData = getFuncData}
+              {program = program,
+               getFuncData = getFuncData}
       val _ = AnalyzeDom.analyzeDom 
-	      {program = program,
-	       getContData = getContData,
-	       getFuncData = getFuncData}
+              {program = program,
+               getContData = getContData,
+               getFuncData = getFuncData}
       val program = Transform.transform 
-	            {program = program,
-		     getContData = getContData,
-		     getFuncData = getFuncData}
+                    {program = program,
+                     getContData = getContData,
+                     getFuncData = getFuncData}
       val _ = Program.clearTop program
     in
       program

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ssa/contify.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ssa/contify.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ssa/contify.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature CONTIFY_STRUCTS = 
    sig
       include SHRINK
@@ -16,12 +17,3 @@
       
       val contify: Program.t -> Program.t
    end
-
-functor TestContify(S: CONTIFY) =
-struct
-
-open S
-
-val _ = Assert.assert("Contify", fn () => true)
-
-end
\ No newline at end of file

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ssa/deep-flatten.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ssa/deep-flatten.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ssa/deep-flatten.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,8 +1,8 @@
-(* Copyright (C) 2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 2004-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 functor DeepFlatten (S: DEEP_FLATTEN_STRUCTS): DEEP_FLATTEN = 
@@ -21,32 +21,32 @@
 structure TypeTree =
    struct
       datatype t = datatype Tree.t
-	 
+         
       datatype info =
-	 Flat
+         Flat
        | NotFlat of {ty: Type.t,
-		     var: Var.t option}
+                     var: Var.t option}
 
       type t = info Tree.t
 
       fun layout (t: t): Layout.t =
-	 Tree.layout
-	 (t,
-	  let
-	     open Layout
-	  in
-	     fn Flat => str "Flat"
-	      | NotFlat {ty, var} =>
-		   seq [str "NotFlat ",
-			record [("ty", Type.layout ty),
-				("var", Option.layout Var.layout var)]]
-	  end)
+         Tree.layout
+         (t,
+          let
+             open Layout
+          in
+             fn Flat => str "Flat"
+              | NotFlat {ty, var} =>
+                   seq [str "NotFlat ",
+                        record [("ty", Type.layout ty),
+                                ("var", Option.layout Var.layout var)]]
+          end)
 
       val isFlat: t -> bool =
-	 fn T (i, _) =>
-	 case i of
-	    Flat => true
-	  | NotFlat _ => false
+         fn T (i, _) =>
+         case i of
+            Flat => true
+          | NotFlat _ => false
    end
 
 structure VarTree =
@@ -54,174 +54,174 @@
       open TypeTree
 
       val labelRoot: t * Var.t -> t =
-	 fn (t as T (info, ts), x) =>
-	 case info of
-	    Flat => t
-	  | NotFlat {ty, ...} => T (NotFlat {ty = ty, var = SOME x}, ts)
+         fn (t as T (info, ts), x) =>
+         case info of
+            Flat => t
+          | NotFlat {ty, ...} => T (NotFlat {ty = ty, var = SOME x}, ts)
 
       val fromTypeTree: TypeTree.t -> t = fn t => t
 
       val foldRoots: t * 'a * (Var.t * 'a -> 'a) -> 'a =
-	 fn (t, a, f) =>
-	 let
-	    fun loop (T (info, children), a: 'a): 'a =
-	       case info of
-		  Flat => Prod.fold (children, a, loop)
-		| NotFlat {var, ...} =>
-		     case var of
-			NONE => Error.bug "foldRoots"
-		      | SOME x => f (x, a)
-	 in
-	    loop (t, a)
-	 end
+         fn (t, a, f) =>
+         let
+            fun loop (T (info, children), a: 'a): 'a =
+               case info of
+                  Flat => Prod.fold (children, a, loop)
+                | NotFlat {var, ...} =>
+                     case var of
+                        NONE => Error.bug "DeepFlatten.VarTree.foldRoots"
+                      | SOME x => f (x, a)
+         in
+            loop (t, a)
+         end
 
       fun foreachRoot (t, f) = foldRoots (t, (), f o #1)
 
       val rootsOnto: t * Var.t list -> Var.t list =
-	 fn (t, ac) =>
-	 List.appendRev (foldRoots (t, [], op ::), ac)
+         fn (t, ac) =>
+         List.appendRev (foldRoots (t, [], op ::), ac)
 
       val rec dropVars: t -> t =
-	 fn T (info, ts) =>
-	 let
-	    val info =
-	       case info of
-		  Flat => Flat
-		| NotFlat {ty, ...} => NotFlat {ty = ty, var = NONE}
-	 in
-	    T (info, Prod.map (ts, dropVars))
-	 end
-	 
+         fn T (info, ts) =>
+         let
+            val info =
+               case info of
+                  Flat => Flat
+                | NotFlat {ty, ...} => NotFlat {ty = ty, var = NONE}
+         in
+            T (info, Prod.map (ts, dropVars))
+         end
+         
       fun fillInRoots (t: t, {base: Var.t Base.t, offset: int})
-	 : t * Statement.t list =
-	 let
-	    fun loop (t as T (info, ts), offset, ac) =
-	       case info of
-		  Flat =>
-		     let
-			val (ts, (offset, ac)) =
-			   Vector.mapAndFold
-			   (Prod.dest ts, (offset, ac),
-			    fn ({elt = t, isMutable}, (offset, ac)) =>
-			    let
-			       val (t, offset, ac) = loop (t, offset, ac)
-			    in
-			       ({elt = t, isMutable = isMutable},
-				(offset, ac))
-			    end)
-		     in
-			(T (Flat, Prod.make ts), offset, ac)
-		     end
-		| NotFlat {ty, var} =>
-		     let
-			val (t, ac) =
-			   case var of
-			      NONE =>
-				 let
-				    val var = Var.newNoname ()
-				 in
-				    (T (NotFlat {ty = ty, var = SOME var}, ts),
-				     Bind
-				     {exp = Select {base = base,
-						    offset = offset},
-				      ty = ty,
-				      var = SOME var} :: ac)
-				 end
-			    | SOME _ => (t, ac)
-		     in
-			(t, offset + 1, ac)
-		     end
-	    val (t, _, ac) = loop (t, offset, [])
-	 in
-	    (t, ac)
-	 end
+         : t * Statement.t list =
+         let
+            fun loop (t as T (info, ts), offset, ac) =
+               case info of
+                  Flat =>
+                     let
+                        val (ts, (offset, ac)) =
+                           Vector.mapAndFold
+                           (Prod.dest ts, (offset, ac),
+                            fn ({elt = t, isMutable}, (offset, ac)) =>
+                            let
+                               val (t, offset, ac) = loop (t, offset, ac)
+                            in
+                               ({elt = t, isMutable = isMutable},
+                                (offset, ac))
+                            end)
+                     in
+                        (T (Flat, Prod.make ts), offset, ac)
+                     end
+                | NotFlat {ty, var} =>
+                     let
+                        val (t, ac) =
+                           case var of
+                              NONE =>
+                                 let
+                                    val var = Var.newNoname ()
+                                 in
+                                    (T (NotFlat {ty = ty, var = SOME var}, ts),
+                                     Bind
+                                     {exp = Select {base = base,
+                                                    offset = offset},
+                                      ty = ty,
+                                      var = SOME var} :: ac)
+                                 end
+                            | SOME _ => (t, ac)
+                     in
+                        (t, offset + 1, ac)
+                     end
+            val (t, _, ac) = loop (t, offset, [])
+         in
+            (t, ac)
+         end
 
       val fillInRoots =
-	 Trace.trace2 ("DeepFlatten.VarTree.fillInRoots",
-		       layout,
-		       fn {base, offset} =>
-		       Layout.record [("base", Base.layout (base, Var.layout)),
-				      ("offset", Int.layout offset)],
-		       Layout.tuple2 (layout, List.layout Statement.layout))
-	 fillInRoots
+         Trace.trace2 ("DeepFlatten.VarTree.fillInRoots",
+                       layout,
+                       fn {base, offset} =>
+                       Layout.record [("base", Base.layout (base, Var.layout)),
+                                      ("offset", Int.layout offset)],
+                       Layout.tuple2 (layout, List.layout Statement.layout))
+         fillInRoots
    end
 
 fun flatten {base: Var.t Base.t option,
-	     from: VarTree.t,
-	     offset: int,
-	     to: TypeTree.t}: {offset: int} * VarTree.t * Statement.t list =
+             from: VarTree.t,
+             offset: int,
+             to: TypeTree.t}: {offset: int} * VarTree.t * Statement.t list =
    let
       val Tree.T (from, fs) = from
    in
       case from of
-	 VarTree.Flat =>
-	    if TypeTree.isFlat to
-	       then flattensAt {base = base,
-				froms = fs,
-				offset = offset,
-				tos = Tree.children to}
-	    else Error.bug "cannot flatten from Flat to NotFlat"
+         VarTree.Flat =>
+            if TypeTree.isFlat to
+               then flattensAt {base = base,
+                                froms = fs,
+                                offset = offset,
+                                tos = Tree.children to}
+            else Error.bug "DeepFlatten.flatten: cannot flatten from Flat to NotFlat"
        | VarTree.NotFlat {ty, var} =>
-	    let
-	       val (var, ss) =
-		  case var of
-		     NONE =>
-			let
-			   val base =
-			      case base of
-				 NONE => Error.bug "flatten missing base"
-			       | SOME base => base
-			   val result = Var.newNoname ()
-			in
-			   (result,
-			    [Bind {exp = Select {base = base,
-						 offset = offset},
-				   ty = ty,
-				   var = SOME result}])
-			end
-		   | SOME var => (var, [])
-	       val (r, ss) =
-		  if TypeTree.isFlat to
-		     then
-			let
-			   val (_, r, ss') =
-			      flattensAt {base = SOME (Base.Object var),
-					  froms = fs,
-					  offset = 0,
-					  tos = Tree.children to}
-			in
-			   (r, ss @ ss')
-			end
-		  else (Tree.T (VarTree.NotFlat {ty = ty, var = SOME var},
-				fs),
-			ss)
-	    in
-	       ({offset = 1 + offset}, r, ss)
-	    end
+            let
+               val (var, ss) =
+                  case var of
+                     NONE =>
+                        let
+                           val base =
+                              case base of
+                                 NONE => Error.bug "DeepFlatten.flatten: flatten missing base"
+                               | SOME base => base
+                           val result = Var.newNoname ()
+                        in
+                           (result,
+                            [Bind {exp = Select {base = base,
+                                                 offset = offset},
+                                   ty = ty,
+                                   var = SOME result}])
+                        end
+                   | SOME var => (var, [])
+               val (r, ss) =
+                  if TypeTree.isFlat to
+                     then
+                        let
+                           val (_, r, ss') =
+                              flattensAt {base = SOME (Base.Object var),
+                                          froms = fs,
+                                          offset = 0,
+                                          tos = Tree.children to}
+                        in
+                           (r, ss @ ss')
+                        end
+                  else (Tree.T (VarTree.NotFlat {ty = ty, var = SOME var},
+                                fs),
+                        ss)
+            in
+               ({offset = 1 + offset}, r, ss)
+            end
    end
 and flattensAt {base: Var.t Base.t option,
-		froms: VarTree.t Prod.t,
-		offset: int,
-		tos: TypeTree.t Prod.t} =
+                froms: VarTree.t Prod.t,
+                offset: int,
+                tos: TypeTree.t Prod.t} =
    let
       val (ts, (off, ss)) =
-	 Vector.map2AndFold
-	 (Prod.dest froms, Prod.dest tos, ({offset = offset}, []),
-	  fn ({elt = f, isMutable}, {elt = t, ...}, ({offset}, ss)) =>
-	  let
-	     val () =
-		if isMutable
-		   then Error.bug "flattensAt mutable"
-		else ()
-	     val ({offset}, t, ss') =
-		flatten {base = base,
-			 from = f,
-			 offset = offset,
-			 to = t}
-	  in
-	     ({elt = t, isMutable = false},
-	      ({offset = offset}, ss' @ ss))
-	  end)
+         Vector.map2AndFold
+         (Prod.dest froms, Prod.dest tos, ({offset = offset}, []),
+          fn ({elt = f, isMutable}, {elt = t, ...}, ({offset}, ss)) =>
+          let
+             val () =
+                if isMutable
+                   then Error.bug "DeepFlatten.flattensAt: mutable"
+                else ()
+             val ({offset}, t, ss') =
+                flatten {base = base,
+                         from = f,
+                         offset = offset,
+                         to = t}
+          in
+             ({elt = t, isMutable = false},
+              ({offset = offset}, ss' @ ss))
+          end)
    in
       (off, Tree.T (VarTree.Flat, Prod.make ts), ss)
    end
@@ -229,10 +229,10 @@
 fun coerceTree {from: VarTree.t, to: TypeTree.t}: VarTree.t * Statement.t list =
    let
       val (_, r, ss) =
-	 flatten {base = NONE,
-		  from = from,
-		  offset = 0,
-		  to = to}
+         flatten {base = NONE,
+                  from = from,
+                  offset = 0,
+                  to = to}
    in
       (r, ss)
    end
@@ -242,12 +242,12 @@
       open Layout
    in
       Trace.trace ("DeepFlatten.coerceTree",
-		   fn {from, to} =>
-		   record [("from", VarTree.layout from),
-			   ("to", TypeTree.layout to)],
-		   fn (vt, ss) =>
-		   tuple [VarTree.layout vt,
-			  List.layout Statement.layout ss])
+                   fn {from, to} =>
+                   record [("from", VarTree.layout from),
+                           ("to", TypeTree.layout to)],
+                   fn (vt, ss) =>
+                   tuple [VarTree.layout vt,
+                          List.layout Statement.layout ss])
       coerceTree
    end
 
@@ -256,8 +256,8 @@
       datatype t = Flat | NotFlat
 
       val toString: t -> string =
-	 fn Flat => "Flat"
-	  | NotFlat => "NotFlat"
+         fn Flat => "Flat"
+          | NotFlat => "NotFlat"
 
       val layout = Layout.str o toString
    end
@@ -267,269 +267,269 @@
 structure Value =
    struct
       datatype t =
-	 Ground of Type.t
+         Ground of Type.t
        | Object of object Equatable.t
        | Weak of {arg: t}
       withtype object = {args: t Prod.t,
-			 coercedFrom: t AppendList.t ref,
-			 con: ObjectCon.t,
-			 finalOffsets: int vector option ref,
-			 finalTree: TypeTree.t option ref,
-			 finalType: Type.t option ref,
-			 finalTypes: Type.t Prod.t option ref,
-			 flat: Flat.t ref}
+                         coercedFrom: t AppendList.t ref,
+                         con: ObjectCon.t,
+                         finalOffsets: int vector option ref,
+                         finalTree: TypeTree.t option ref,
+                         finalType: Type.t option ref,
+                         finalTypes: Type.t Prod.t option ref,
+                         flat: Flat.t ref}
 
       fun layout (v: t): Layout.t =
-	 let
-	    open Layout
-	 in
-	    case v of
-	       Ground t => Type.layout t
-	     | Object e =>
-		  Equatable.layout
-		  (e, fn {args, con, flat, ...} => 
-		   seq [str "Object ",
-			record [("args", Prod.layout (args, layout)),
-				("con", ObjectCon.layout con),
-				("flat", Flat.layout (! flat))]])
-	     | Weak {arg, ...} => seq [str "Weak ", layout arg]
-	 end
+         let
+            open Layout
+         in
+            case v of
+               Ground t => Type.layout t
+             | Object e =>
+                  Equatable.layout
+                  (e, fn {args, con, flat, ...} => 
+                   seq [str "Object ",
+                        record [("args", Prod.layout (args, layout)),
+                                ("con", ObjectCon.layout con),
+                                ("flat", Flat.layout (! flat))]])
+             | Weak {arg, ...} => seq [str "Weak ", layout arg]
+         end
 
       val ground = Ground
 
       val traceCoerce =
-	 Trace.trace ("DeepFlatten.Value.coerce",
-		      fn {from, to} =>
-		      Layout.record [("from", layout from),
-				     ("to", layout to)],
-		      Unit.layout)
+         Trace.trace ("DeepFlatten.Value.coerce",
+                      fn {from, to} =>
+                      Layout.record [("from", layout from),
+                                     ("to", layout to)],
+                      Unit.layout)
 
       val traceUnify =
-	 Trace.trace2 ("DeepFlatten.Value.unify", layout, layout, Unit.layout)
+         Trace.trace2 ("DeepFlatten.Value.unify", layout, layout, Unit.layout)
 
       val rec unify: t * t -> unit =
-	 fn arg =>
-	 traceUnify
-	 (fn (v, v') =>
-	  case (v, v') of
-	     (Ground _, Ground _) => ()
-	   | (Object e, Object e') =>
-		let
-		   val callDont = ref false
-		   val () =
-		      Equatable.equate
-		      (e, e',
-		       fn (z as {args = a, coercedFrom = c, flat = f, ...},
-			   z' as {args = a', coercedFrom = c', flat = f', ...}) =>
-		       let
-			  val () = unifyProd (a, a')
-		       in
-			  case (!f, !f') of
-			     (Flat, Flat) =>
-				(c := AppendList.append (!c', !c); z)
-			   | (Flat, NotFlat) =>
-				(callDont := true; z)
-			   | (NotFlat, Flat) =>
-				(callDont := true; z')
-			   | (NotFlat, NotFlat) => z
-		       end)
-		in
-		   if !callDont
-		      then dontFlatten v
-		   else ()
-		end
-	   | (Weak {arg = a, ...}, Weak {arg = a', ...}) =>
-		unify (a, a')
-	   | _ => Error.bug "strange unify") arg
+         fn arg =>
+         traceUnify
+         (fn (v, v') =>
+          case (v, v') of
+             (Ground _, Ground _) => ()
+           | (Object e, Object e') =>
+                let
+                   val callDont = ref false
+                   val () =
+                      Equatable.equate
+                      (e, e',
+                       fn (z as {args = a, coercedFrom = c, flat = f, ...},
+                           z' as {args = a', coercedFrom = c', flat = f', ...}) =>
+                       let
+                          val () = unifyProd (a, a')
+                       in
+                          case (!f, !f') of
+                             (Flat, Flat) =>
+                                (c := AppendList.append (!c', !c); z)
+                           | (Flat, NotFlat) =>
+                                (callDont := true; z)
+                           | (NotFlat, Flat) =>
+                                (callDont := true; z')
+                           | (NotFlat, NotFlat) => z
+                       end)
+                in
+                   if !callDont
+                      then dontFlatten v
+                   else ()
+                end
+           | (Weak {arg = a, ...}, Weak {arg = a', ...}) =>
+                unify (a, a')
+           | _ => Error.bug "DeepFlatten.unify: strange") arg
       and unifyProd =
-	 fn (p, p') =>
-	 Vector.foreach2
-	 (Prod.dest p, Prod.dest p',
-	  fn ({elt = e, ...}, {elt = e', ...}) => unify (e, e'))
+         fn (p, p') =>
+         Vector.foreach2
+         (Prod.dest p, Prod.dest p',
+          fn ({elt = e, ...}, {elt = e', ...}) => unify (e, e'))
       and dontFlatten: t -> unit =
-	 fn v =>
-	 case v of
-	    Object e =>
-	       let
-		  val {coercedFrom, flat, ...} = Equatable.value e
-	       in
-		  case ! flat of
-		     Flat =>
-			let
-			   val () = flat := NotFlat
-			   val from = !coercedFrom
-			   val () = coercedFrom := AppendList.empty
-			in
-			   AppendList.foreach (from, fn v' => unify (v, v'))
-			end
-		   | NotFlat => ()
-	       end
-	  | _ => ()
+         fn v =>
+         case v of
+            Object e =>
+               let
+                  val {coercedFrom, flat, ...} = Equatable.value e
+               in
+                  case ! flat of
+                     Flat =>
+                        let
+                           val () = flat := NotFlat
+                           val from = !coercedFrom
+                           val () = coercedFrom := AppendList.empty
+                        in
+                           AppendList.foreach (from, fn v' => unify (v, v'))
+                        end
+                   | NotFlat => ()
+               end
+          | _ => ()
 
       val rec coerce =
-	 fn arg as {from, to} =>
-	 traceCoerce
-	 (fn _ =>
-	  case (from, to) of
-	     (Ground _, Ground _) => ()
-	   | (Object e, Object e') =>
-		if Equatable.equals (e, e')
-		   then ()
-		else
-		   Equatable.whenComputed
-		   (e', fn {args = a', coercedFrom = c', flat = f', ...} =>
-		    let
-		       val {args = a, con, ...} = Equatable.value e
-		    in
-		       if Prod.isMutable a orelse ObjectCon.isVector con
-			  then unify (from, to)
-		       else
-			  case !f' of
-			     Flat => (AppendList.push (c', from)
-				      ; coerceProd {from = a, to = a'})
-			   | NotFlat => unify (from, to)
-		    end)
-	   | (Weak _, Weak _) => unify (from, to)
-	   | _ => Error.bug "strange coerce") arg
+         fn arg as {from, to} =>
+         traceCoerce
+         (fn _ =>
+          case (from, to) of
+             (Ground _, Ground _) => ()
+           | (Object e, Object e') =>
+                if Equatable.equals (e, e')
+                   then ()
+                else
+                   Equatable.whenComputed
+                   (e', fn {args = a', coercedFrom = c', flat = f', ...} =>
+                    let
+                       val {args = a, con, ...} = Equatable.value e
+                    in
+                       if Prod.isMutable a orelse ObjectCon.isVector con
+                          then unify (from, to)
+                       else
+                          case !f' of
+                             Flat => (AppendList.push (c', from)
+                                      ; coerceProd {from = a, to = a'})
+                           | NotFlat => unify (from, to)
+                    end)
+           | (Weak _, Weak _) => unify (from, to)
+           | _ => Error.bug "DeepFlatten.coerce: strange") arg
       and coerceProd =
-	 fn {from = p, to = p'} =>
-	 Vector.foreach2
-	 (Prod.dest p, Prod.dest p', fn ({elt = e, ...}, {elt = e', ...}) =>
-	  coerce {from = e, to = e'})
+         fn {from = p, to = p'} =>
+         Vector.foreach2
+         (Prod.dest p, Prod.dest p', fn ({elt = e, ...}, {elt = e', ...}) =>
+          coerce {from = e, to = e'})
 
       fun mayFlatten {args, con}: bool =
-	 (* Don't flatten constructors, since they are part of a sum type.
-	  * Don't flatten unit.
-	  * Don't flatten vectors (of course their components can be
-	  * flattened).
-	  * Don't flatten objects with mutable fields, since sharing must be
-	  * preserved.
-	  *)
-	 not (Prod.isEmpty args)
-	 andalso not (Prod.isMutable args)
-	 andalso (case con of
-		     ObjectCon.Con _ => false
-		   | ObjectCon.Tuple => true
-		   | ObjectCon.Vector => false)
+         (* Don't flatten constructors, since they are part of a sum type.
+          * Don't flatten unit.
+          * Don't flatten vectors (of course their components can be
+          * flattened).
+          * Don't flatten objects with mutable fields, since sharing must be
+          * preserved.
+          *)
+         not (Prod.isEmpty args)
+         andalso not (Prod.isMutable args)
+         andalso (case con of
+                     ObjectCon.Con _ => false
+                   | ObjectCon.Tuple => true
+                   | ObjectCon.Vector => false)
 
       fun objectFields {args, con} =
-	 let
-	    (* Don't flatten object components that are immutable fields.  Those
-	     * have already had a chance to be flattened by other passes.
-	     *)
-	    val _  =
-	       if (case con  of
-		      ObjectCon.Con _ => true
-		    | ObjectCon.Tuple => true
-		    | ObjectCon.Vector => false)
-		  then Vector.foreach (Prod.dest args, fn {elt, isMutable} =>
-				       if isMutable
-					  then ()
-				       else dontFlatten elt)
-	       else ()
-	    val flat =
-	       if mayFlatten {args = args, con = con}
-		  then Flat.Flat
-	       else Flat.NotFlat
-	 in
-	    {args = args,
-	     coercedFrom = ref AppendList.empty,
-	     con = con,
-	     finalOffsets = ref NONE,
-	     finalTree = ref NONE,
-	     finalType = ref NONE,
-	     finalTypes = ref NONE,
-	     flat = ref flat}
-	 end
+         let
+            (* Don't flatten object components that are immutable fields.  Those
+             * have already had a chance to be flattened by other passes.
+             *)
+            val _  =
+               if (case con  of
+                      ObjectCon.Con _ => true
+                    | ObjectCon.Tuple => true
+                    | ObjectCon.Vector => false)
+                  then Vector.foreach (Prod.dest args, fn {elt, isMutable} =>
+                                       if isMutable
+                                          then ()
+                                       else dontFlatten elt)
+               else ()
+            val flat =
+               if mayFlatten {args = args, con = con}
+                  then Flat.Flat
+               else Flat.NotFlat
+         in
+            {args = args,
+             coercedFrom = ref AppendList.empty,
+             con = con,
+             finalOffsets = ref NONE,
+             finalTree = ref NONE,
+             finalType = ref NONE,
+             finalTypes = ref NONE,
+             flat = ref flat}
+         end
 
       fun object f =
-	 Object (Equatable.delay (fn () => objectFields (f ())))
-	    
+         Object (Equatable.delay (fn () => objectFields (f ())))
+            
       val tuple: t Prod.t -> t =
-	 fn vs =>
-	 Object (Equatable.new (objectFields {args = vs, con = ObjectCon.Tuple}))
+         fn vs =>
+         Object (Equatable.new (objectFields {args = vs, con = ObjectCon.Tuple}))
 
       val tuple =
-	 Trace.trace ("DeepFlatten.Value.tuple",
-		      fn p => Prod.layout (p, layout),
-		      layout)
-	 tuple
+         Trace.trace ("DeepFlatten.Value.tuple",
+                      fn p => Prod.layout (p, layout),
+                      layout)
+         tuple
 
       fun weak (arg: t) = Weak {arg = arg}
 
       val deObject: t -> object option =
-	 fn v =>
-	 case v of
-	    Object e => SOME (Equatable.value e)
-	  | _ => NONE
+         fn v =>
+         case v of
+            Object e => SOME (Equatable.value e)
+          | _ => NONE
 
       val traceFinalType =
-	 Trace.trace ("DeepFlatten.Value.finalType", layout, Type.layout)
+         Trace.trace ("DeepFlatten.Value.finalType", layout, Type.layout)
       val traceFinalTypes =
-	 Trace.trace ("DeepFlatten.Value.finalTypes",
-		      layout,
-		      fn p => Prod.layout (p, Type.layout))
+         Trace.trace ("DeepFlatten.Value.finalTypes",
+                      layout,
+                      fn p => Prod.layout (p, Type.layout))
 
       fun finalTree (v: t): TypeTree.t =
-	 let
-	    fun notFlat (): TypeTree.info =
-	       TypeTree.NotFlat {ty = finalType v, var = NONE}
-	 in
-	    case deObject v of
-	       NONE => Tree.T (notFlat (), Prod.empty ())
-	     | SOME {args, finalTree = r, flat, ...} =>
-		  Ref.memoize
-		  (r, fn () =>
-		   let
-		      val info =
-			 case !flat of
-			    Flat => TypeTree.Flat
-			  | NotFlat => notFlat ()
-		   in
-		      Tree.T (info, Prod.map (args, finalTree))
-		   end)
-	 end
+         let
+            fun notFlat (): TypeTree.info =
+               TypeTree.NotFlat {ty = finalType v, var = NONE}
+         in
+            case deObject v of
+               NONE => Tree.T (notFlat (), Prod.empty ())
+             | SOME {args, finalTree = r, flat, ...} =>
+                  Ref.memoize
+                  (r, fn () =>
+                   let
+                      val info =
+                         case !flat of
+                            Flat => TypeTree.Flat
+                          | NotFlat => notFlat ()
+                   in
+                      Tree.T (info, Prod.map (args, finalTree))
+                   end)
+         end
       and finalType arg: Type.t =
-	 traceFinalType
-	 (fn v =>
-	  case v of
-	     Ground t => t
-	   | Object e =>
-		let
-		   val {finalType = r, ...} = Equatable.value e
-		in
-		   Ref.memoize (r, fn () => Prod.elt (finalTypes v, 0))
-		end
-	   | Weak {arg, ...} => Type.weak (finalType arg)) arg
+         traceFinalType
+         (fn v =>
+          case v of
+             Ground t => t
+           | Object e =>
+                let
+                   val {finalType = r, ...} = Equatable.value e
+                in
+                   Ref.memoize (r, fn () => Prod.elt (finalTypes v, 0))
+                end
+           | Weak {arg, ...} => Type.weak (finalType arg)) arg
       and finalTypes arg: Type.t Prod.t =
-	 traceFinalTypes
-	 (fn v =>
-	  case deObject v of
-	     NONE =>
-		Prod.make (Vector.new1 {elt = finalType v,
-					isMutable = false})
-	   | SOME {args, con, finalTypes, flat, ...} =>
-		Ref.memoize
-		(finalTypes, fn () =>
-		 let
-		    val args = prodFinalTypes args
-		 in
-		    case !flat of
-		       Flat => args
-		     | NotFlat =>
-			  Prod.make
-			  (Vector.new1
-			   {elt = Type.object {args = args, con = con},
-			    isMutable = false})
-		 end)) arg
+         traceFinalTypes
+         (fn v =>
+          case deObject v of
+             NONE =>
+                Prod.make (Vector.new1 {elt = finalType v,
+                                        isMutable = false})
+           | SOME {args, con, finalTypes, flat, ...} =>
+                Ref.memoize
+                (finalTypes, fn () =>
+                 let
+                    val args = prodFinalTypes args
+                 in
+                    case !flat of
+                       Flat => args
+                     | NotFlat =>
+                          Prod.make
+                          (Vector.new1
+                           {elt = Type.object {args = args, con = con},
+                            isMutable = false})
+                 end)) arg
       and prodFinalTypes (p: t Prod.t): Type.t Prod.t =
-	 Prod.make
-	 (Vector.fromList
-	  (Vector.foldr
-	   (Prod.dest p, [], fn ({elt, isMutable = i}, ac) =>
-	    Vector.foldr
-	    (Prod.dest (finalTypes elt), ac, fn ({elt, isMutable = i'}, ac) =>
-	     {elt = elt, isMutable = i orelse i'} :: ac))))
+         Prod.make
+         (Vector.fromList
+          (Vector.foldr
+           (Prod.dest p, [], fn ({elt, isMutable = i}, ac) =>
+            Vector.foldr
+            (Prod.dest (finalTypes elt), ac, fn ({elt, isMutable = i'}, ac) =>
+             {elt = elt, isMutable = i orelse i'} :: ac))))
    end
 
 structure Object =
@@ -537,536 +537,532 @@
       type t = Value.object
 
       fun select ({args, ...}: t, offset): Value.t =
-	 Prod.elt (args, offset)
+         Prod.elt (args, offset)
 
       fun finalOffsets ({args, finalOffsets = r, ...}: t): int vector =
-	 Ref.memoize
-	 (r, fn () =>
-	  Vector.fromListRev
-	  (#2 (Prod.fold
-	       (args, (0, []), fn (elt, (offset, offsets)) =>
-		(offset + Prod.length (Value.finalTypes elt),
-		 offset :: offsets)))))
+         Ref.memoize
+         (r, fn () =>
+          Vector.fromListRev
+          (#2 (Prod.fold
+               (args, (0, []), fn (elt, (offset, offsets)) =>
+                (offset + Prod.length (Value.finalTypes elt),
+                 offset :: offsets)))))
 
       fun finalOffset (object, offset) =
-	 Vector.sub (finalOffsets object, offset)
+         Vector.sub (finalOffsets object, offset)
    end
 
 fun flatten (program as Program.T {datatypes, functions, globals, main}) =
    let
       val {get = conValue: Con.t -> Value.t option ref, ...} =
-	 Property.get (Con.plist, Property.initFun (fn _ => ref NONE))
+         Property.get (Con.plist, Property.initFun (fn _ => ref NONE))
       val conValue =
-	 Trace.trace ("DeepFlatten.conValue",
-		      Con.layout, Ref.layout (Option.layout Value.layout))
-	 conValue
+         Trace.trace ("DeepFlatten.conValue",
+                      Con.layout, Ref.layout (Option.layout Value.layout))
+         conValue
       datatype 'a make =
-	 Const of 'a
+         Const of 'a
        | Make of unit -> 'a
       val traceMakeTypeValue =
-	 Trace.trace ("DeepFlatten.makeTypeValue",
-		      Type.layout o #1,
-		      Layout.ignore)
+         Trace.trace ("DeepFlatten.makeTypeValue",
+                      Type.layout o #1,
+                      Layout.ignore)
       fun makeValue m =
-	 case m of
-	    Const v => v
-	  | Make f => f ()
+         case m of
+            Const v => v
+          | Make f => f ()
       fun needToMakeProd p =
-	 Vector.exists (Prod.dest p, fn {elt, ...} =>
-			case elt of
-			   Const _ => false
-			 | Make _ => true)
+         Vector.exists (Prod.dest p, fn {elt, ...} =>
+                        case elt of
+                           Const _ => false
+                         | Make _ => true)
       fun makeProd p =
-	 Prod.map (p, fn m =>
-		   case m of
-		      Const v => v
-		    | Make f => f ())
+         Prod.map (p, fn m =>
+                   case m of
+                      Const v => v
+                    | Make f => f ())
       val {get = makeTypeValue: Type.t -> Value.t make, ...} =
-	 Property.get
-	 (Type.plist,
-	  Property.initRec
-	  (traceMakeTypeValue
-	   (fn (t, makeTypeValue) =>
-	    let
-	       fun const () = Const (Value.ground t)
-	       datatype z = datatype Type.dest
-	    in
-	       case Type.dest t of
-		  Object {args, con} =>
-		     let
-			val args = Prod.map (args, makeTypeValue)
-			fun doit () =
-			   if needToMakeProd args
-			      orelse Value.mayFlatten {args = args, con = con}
-			      then
-				 Make
-				 (fn () =>
-				  Value.object (fn () => {args = makeProd args,
-							  con = con}))
-			   else const ()
-			datatype z = datatype ObjectCon.t
-		     in
-			case con of
-			   Con c =>
-			      Const (Ref.memoize
-				     (conValue c, fn () =>
-				      makeValue (doit ())))
-			 | Tuple => doit ()
-			 | Vector => doit ()
-		     end
-		| Weak t =>
-		     (case makeTypeValue t of
-			 Const _ => const ()
-		       | Make f => Make (fn () => Value.weak (f ())))
-		| _ => const ()
-	    end)))
+         Property.get
+         (Type.plist,
+          Property.initRec
+          (traceMakeTypeValue
+           (fn (t, makeTypeValue) =>
+            let
+               fun const () = Const (Value.ground t)
+               datatype z = datatype Type.dest
+            in
+               case Type.dest t of
+                  Object {args, con} =>
+                     let
+                        val args = Prod.map (args, makeTypeValue)
+                        fun doit () =
+                           if needToMakeProd args
+                              orelse Value.mayFlatten {args = args, con = con}
+                              then
+                                 Make
+                                 (fn () =>
+                                  Value.object (fn () => {args = makeProd args,
+                                                          con = con}))
+                           else const ()
+                        datatype z = datatype ObjectCon.t
+                     in
+                        case con of
+                           Con c =>
+                              Const (Ref.memoize
+                                     (conValue c, fn () =>
+                                      makeValue (doit ())))
+                         | Tuple => doit ()
+                         | Vector => doit ()
+                     end
+                | Weak t =>
+                     (case makeTypeValue t of
+                         Const _ => const ()
+                       | Make f => Make (fn () => Value.weak (f ())))
+                | _ => const ()
+            end)))
       fun typeValue (t: Type.t): Value.t =
-	 makeValue (makeTypeValue t)
+         makeValue (makeTypeValue t)
       val typeValue =
-	 Trace.trace ("DeepFlatten.typeValue", Type.layout, Value.layout)
-	 typeValue
-      val (coerce, coerceProd) =
-	 if !Control.deepFlattenUnify
-	    then (fn {from, to} => Value.unify (from, to),
-		  fn {from, to} => Value.unifyProd (from, to))
-	 else (Value.coerce, Value.coerceProd)
+         Trace.trace ("DeepFlatten.typeValue", Type.layout, Value.layout)
+         typeValue
+      val (coerce, coerceProd) = (Value.coerce, Value.coerceProd)
       fun inject {sum, variant = _} = typeValue (Type.datatypee sum)
       fun object {args, con, resultType} =
-	 let
-	    val m = makeTypeValue resultType
-	 in
-	    case con of
-	       NONE =>
-		  (case m of
-		      Const v => v
-		    | Make _ => Value.tuple args)
-	     | SOME _ =>
-		  (case m of
-		      Const v =>
-			 let
-			    val () =
-			       case Value.deObject v of
-				  NONE => ()
-				| SOME {args = args', ...} =>
-				     coerceProd {from = args, to = args'}
-			 in
-			    v
-			 end
-		    | _ => Error.bug "strangs con value")
-	 end
+         let
+            val m = makeTypeValue resultType
+         in
+            case con of
+               NONE =>
+                  (case m of
+                      Const v => v
+                    | Make _ => Value.tuple args)
+             | SOME _ =>
+                  (case m of
+                      Const v =>
+                         let
+                            val () =
+                               case Value.deObject v of
+                                  NONE => ()
+                                | SOME {args = args', ...} =>
+                                     coerceProd {from = args, to = args'}
+                         in
+                            v
+                         end
+                    | _ => Error.bug "DeepFlatten.object: strange con value")
+         end
       val object =
-	 Trace.trace
-	 ("DeepFlatten.object",
-	  fn {args, con, ...} =>
-	  Layout.record [("args", Prod.layout (args, Value.layout)),
-			 ("con", Option.layout Con.layout con)],
-	  Value.layout)
-	 object
+         Trace.trace
+         ("DeepFlatten.object",
+          fn {args, con, ...} =>
+          Layout.record [("args", Prod.layout (args, Value.layout)),
+                         ("con", Option.layout Con.layout con)],
+          Value.layout)
+         object
       fun primApp {args, prim, resultVar = _, resultType} =
-	 let
-	    fun arg i = Vector.sub (args, i)
-	    fun result () = typeValue resultType
-	    datatype z = datatype Prim.Name.t
-	    fun dontFlatten () =
-	       (Vector.foreach (args, Value.dontFlatten)
-		; result ())
-	    fun equal () =
-	       (Value.unify (arg 0, arg 1)
-		; result ())
-	 in
-	    case Prim.name prim of
-	       Array_toVector =>
-		  let
-		     val res = result ()
-		     val () =
-			case (Value.deObject (arg 0), Value.deObject res) of
-			   (NONE, NONE) => ()
-			 | (SOME {args = a, ...}, SOME {args = a', ...}) =>
-			      Vector.foreach2
-			      (Prod.dest a, Prod.dest a',
-			       fn ({elt = v, ...}, {elt = v', ...}) =>
-			       Value.unify (v, v'))
-			 | _ => Error.bug "Array_toVector"
-		  in
-		     res
-		  end
-	     | FFI _ =>
-		  (* Some imports, like Real64.modf, take ref cells that can not
-		   * be flattened.
-		   *)
-		  dontFlatten ()
-	     | MLton_eq => equal ()
-	     | MLton_equal => equal ()
-	     | MLton_size => dontFlatten ()
-	     | MLton_share => dontFlatten ()
-	     | Weak_get =>
-		  (case arg 0 of
-		      Value.Ground t =>
-			 typeValue (case Type.dest t of
-				       Type.Weak t => t
-				     | _ => Error.bug "deWeak")
-		    | Value.Weak {arg, ...} => arg
-		    | _ => Error.bug "Value.deWeak")
-	     | Weak_new =>
-		  (case makeTypeValue resultType of
-		      Const v => v
-		    | Make _ => Value.weak (arg 0))
-	     | _ => result ()
-	 end
+         let
+            fun arg i = Vector.sub (args, i)
+            fun result () = typeValue resultType
+            datatype z = datatype Prim.Name.t
+            fun dontFlatten () =
+               (Vector.foreach (args, Value.dontFlatten)
+                ; result ())
+            fun equal () =
+               (Value.unify (arg 0, arg 1)
+                ; result ())
+         in
+            case Prim.name prim of
+               Array_toVector =>
+                  let
+                     val res = result ()
+                     val () =
+                        case (Value.deObject (arg 0), Value.deObject res) of
+                           (NONE, NONE) => ()
+                         | (SOME {args = a, ...}, SOME {args = a', ...}) =>
+                              Vector.foreach2
+                              (Prod.dest a, Prod.dest a',
+                               fn ({elt = v, ...}, {elt = v', ...}) =>
+                               Value.unify (v, v'))
+                         | _ => Error.bug "DeepFlatten.primApp: Array_toVector"
+                  in
+                     res
+                  end
+             | FFI _ =>
+                  (* Some imports, like Real64.modf, take ref cells that can not
+                   * be flattened.
+                   *)
+                  dontFlatten ()
+             | MLton_eq => equal ()
+             | MLton_equal => equal ()
+             | MLton_size => dontFlatten ()
+             | MLton_share => dontFlatten ()
+             | Weak_get =>
+                  (case arg 0 of
+                      Value.Ground t =>
+                         typeValue (case Type.dest t of
+                                       Type.Weak t => t
+                                     | _ => Error.bug "DeepFlatten.primApp: deWeak")
+                    | Value.Weak {arg, ...} => arg
+                    | _ => Error.bug "DeepFlatten.primApp: Value.deWeak")
+             | Weak_new =>
+                  (case makeTypeValue resultType of
+                      Const v => v
+                    | Make _ => Value.weak (arg 0))
+             | _ => result ()
+         end
       fun select {base, offset} =
-	 let
-	    datatype z = datatype Value.t
-	 in
-	    case base of
-	       Ground t =>
-		  (case Type.dest t of
-		      Type.Object {args, ...} =>
-			 typeValue (Prod.elt (args, offset))
-		    | _ => Error.bug "select Ground")
-	     | Object e => Object.select (Equatable.value e, offset)
-	     | _ => Error.bug "select"
-	 end
+         let
+            datatype z = datatype Value.t
+         in
+            case base of
+               Ground t =>
+                  (case Type.dest t of
+                      Type.Object {args, ...} =>
+                         typeValue (Prod.elt (args, offset))
+                    | _ => Error.bug "DeepFlatten.select: Ground")
+             | Object e => Object.select (Equatable.value e, offset)
+             | _ => Error.bug "DeepFlatten.select:"
+         end
       fun update {base, offset, value} =
-	 coerce {from = value,
-		 to = select {base = base, offset = offset}}
+         coerce {from = value,
+                 to = select {base = base, offset = offset}}
       fun const c = typeValue (Type.ofConst c)
       val {func, value = varValue, ...} =
-	 analyze {coerce = coerce,
-		  const = const,
-		  filter = fn _ => (),
-		  filterWord = fn _ => (),
-		  fromType = typeValue,
-		  inject = inject,
-		  layout = Value.layout,
-		  object = object,
-		  primApp = primApp,
-		  program = program,
-		  select = fn {base, offset, ...} => select {base = base,
-							     offset = offset},
-		  update = update,
-		  useFromTypeOnBinds = false}
+         analyze {coerce = coerce,
+                  const = const,
+                  filter = fn _ => (),
+                  filterWord = fn _ => (),
+                  fromType = typeValue,
+                  inject = inject,
+                  layout = Value.layout,
+                  object = object,
+                  primApp = primApp,
+                  program = program,
+                  select = fn {base, offset, ...} => select {base = base,
+                                                             offset = offset},
+                  update = update,
+                  useFromTypeOnBinds = false}
       (* Don't flatten outermost part of formal parameters. *)
       fun dontFlattenFormals (xts: (Var.t * Type.t) vector): unit =
-	 Vector.foreach (xts, fn (x, _) => Value.dontFlatten (varValue x))
+         Vector.foreach (xts, fn (x, _) => Value.dontFlatten (varValue x))
       val () =
-	 List.foreach
-	 (functions, fn f =>
-	  let
-	     val {args, blocks, ...} = Function.dest f
-	     val () = dontFlattenFormals args
-	     val () = Vector.foreach (blocks, fn Block.T {args, ...} =>
-				      dontFlattenFormals args)
-	  in
-	     ()
-	  end)
+         List.foreach
+         (functions, fn f =>
+          let
+             val {args, blocks, ...} = Function.dest f
+             val () = dontFlattenFormals args
+             val () = Vector.foreach (blocks, fn Block.T {args, ...} =>
+                                      dontFlattenFormals args)
+          in
+             ()
+          end)
       val () =
-	 Control.diagnostics
-	 (fn display =>
-	  let
-	     open Layout
-	     val () =
-		Vector.foreach
-		(datatypes, fn Datatype.T {cons, ...} =>
-		 Vector.foreach
-		 (cons, fn {con, ...} =>
-		  display (Option.layout Value.layout (! (conValue con)))))
-	     val () =
-		Program.foreachVar
-		(program, fn (x, _) =>
-		 display
-		 (seq [Var.layout x, str " ", Value.layout (varValue x)]))
-	  in
-	     ()
-	  end)
+         Control.diagnostics
+         (fn display =>
+          let
+             open Layout
+             val () =
+                Vector.foreach
+                (datatypes, fn Datatype.T {cons, ...} =>
+                 Vector.foreach
+                 (cons, fn {con, ...} =>
+                  display (Option.layout Value.layout (! (conValue con)))))
+             val () =
+                Program.foreachVar
+                (program, fn (x, _) =>
+                 display
+                 (seq [Var.layout x, str " ", Value.layout (varValue x)]))
+          in
+             ()
+          end)
       (* Transform the program. *)
       val datatypes =
-	 Vector.map
-	 (datatypes, fn Datatype.T {cons, tycon} =>
-	  let
-	     val cons =
-		Vector.map
-		(cons, fn {con, args} =>
-		 let
-		    val args =
-		       case ! (conValue con) of
-			  NONE => args
-			| SOME v => 
-			     case Type.dest (Value.finalType v) of
-				Type.Object {args, ...} => args
-			      | _ => Error.bug "strange con"
-		 in
-		    {args = args, con = con}
-		 end)
-	  in
-	     Datatype.T {cons = cons, tycon = tycon}
-	  end)
+         Vector.map
+         (datatypes, fn Datatype.T {cons, tycon} =>
+          let
+             val cons =
+                Vector.map
+                (cons, fn {con, args} =>
+                 let
+                    val args =
+                       case ! (conValue con) of
+                          NONE => args
+                        | SOME v => 
+                             case Type.dest (Value.finalType v) of
+                                Type.Object {args, ...} => args
+                              | _ => Error.bug "DeepFlatten.datatypes: strange con"
+                 in
+                    {args = args, con = con}
+                 end)
+          in
+             Datatype.T {cons = cons, tycon = tycon}
+          end)
       val valueType = Value.finalType
       fun valuesTypes vs = Vector.map (vs, Value.finalType)
       val {get = varTree: Var.t -> VarTree.t, set = setVarTree, ...} =
-	 Property.getSetOnce (Var.plist,
-			      Property.initRaise ("tree", Var.layout))
+         Property.getSetOnce (Var.plist,
+                              Property.initRaise ("tree", Var.layout))
       val setVarTree =
-	 Trace.trace2 ("DeepFlatten.setVarTree",
-		       Var.layout, VarTree.layout, Unit.layout)
-	 setVarTree
+         Trace.trace2 ("DeepFlatten.setVarTree",
+                       Var.layout, VarTree.layout, Unit.layout)
+         setVarTree
       fun simpleVarTree (x: Var.t): unit =
-	 setVarTree
-	 (x, VarTree.labelRoot (VarTree.fromTypeTree
-				(Value.finalTree (varValue x)),
-				x))
+         setVarTree
+         (x, VarTree.labelRoot (VarTree.fromTypeTree
+                                (Value.finalTree (varValue x)),
+                                x))
       fun transformFormals xts =
-	 Vector.map (xts, fn (x, _) =>
-		     let
-			val () = simpleVarTree x
-		     in
-			(x, Value.finalType (varValue x))
-		     end)
+         Vector.map (xts, fn (x, _) =>
+                     let
+                        val () = simpleVarTree x
+                     in
+                        (x, Value.finalType (varValue x))
+                     end)
       fun replaceVar (x: Var.t): Var.t =
-	 let
-	    fun bug () = Error.bug (concat ["replaceVar ", Var.toString x])
-	    val Tree.T (info, _) = varTree x
-	 in
-	    case info of
-	       VarTree.Flat => bug ()
-	     | VarTree.NotFlat {var, ...} =>
-		  case var of
-		     NONE => bug ()
-		   | SOME y => y
-	 end
+         let
+            fun bug () = Error.bug (concat ["DeepFlatten.replaceVar ", Var.toString x])
+            val Tree.T (info, _) = varTree x
+         in
+            case info of
+               VarTree.Flat => bug ()
+             | VarTree.NotFlat {var, ...} =>
+                  case var of
+                     NONE => bug ()
+                   | SOME y => y
+         end
       fun replaceVars xs = Vector.map (xs, replaceVar)
       fun transformBind {exp, ty, var}: Statement.t list =
-	 let
-	    fun simpleTree () = Option.app (var, simpleVarTree)
-	    fun doit (e: Exp.t) =
-	       let
-		  val ty =
-		     case var of
-			NONE => ty
-		      | SOME var => valueType (varValue var)
-	       in
-		  [Bind {exp = e, ty = ty, var = var}]
-	       end
-	    fun simple () =
-	       (simpleTree ()
-		; doit (Exp.replaceVar (exp, replaceVar)))
-	    fun none () = []
-	 in
-	    case exp of
-	       Exp.Const _ => simple ()
-	     | Inject _ => simple ()
-	     | Object {args, con} =>
-		  (case var of
-		      NONE => none ()
-		    | SOME var =>
-			 let
-			    val v = varValue var
-			 in
-			    case Value.deObject v of
-			       NONE => simple ()
-			     | SOME {args = expects, flat, ...} =>
-				  let
-				     val z =
-					Vector.map2
-					(args, Prod.dest expects,
-					 fn (arg, {elt, isMutable}) =>
-					 let
-					    val (vt, ss) =
-					       coerceTree
-					       {from = varTree arg,
-						to = Value.finalTree elt}
-					 in
-					    ({elt = vt,
-					      isMutable = isMutable},
-					     ss)
-					 end)
-				     val vts = Vector.map (z, #1)
-				     fun set info =
-					setVarTree (var,
-						    Tree.T (info,
-							    Prod.make vts))
-				  in
-				     case !flat of
-					Flat => (set VarTree.Flat; none ())
-				      | NotFlat =>
-					   let
-					      val ty = Value.finalType v
-					      val () =
-						 set (VarTree.NotFlat
-						      {ty = ty,
-						       var = SOME var})
-					      val args =
-						 Vector.fromList
-						 (Vector.foldr
-						  (vts, [],
-						   fn ({elt = vt, ...}, ac) =>
-						   VarTree.rootsOnto (vt, ac)))
-					      val obj =
-						 Bind
-						 {exp = Object {args = args,
-								con = con},
-						  ty = ty,
-						  var = SOME var}
-					   in
-					      Vector.foldr
-					      (z, [obj],
-					       fn ((_, ss), ac) => ss @ ac)
-					   end
-				  end
-			 end)
-	     | PrimApp {args, prim} =>
-		  let
-		     val () = simpleTree ()
-		  in
-		     doit (PrimApp {args = replaceVars args,
-				    prim = prim})
-		  end
-	     | Select {base, offset} =>
-		  (case var of
-		      NONE => none ()
-		    | SOME var =>
-			 let
-			    val baseVar = Base.object base
-			 in
-			    case Value.deObject (varValue baseVar) of
-			       NONE => simple ()
-			     | SOME obj => 
-				  let
-				     val Tree.T (info, children) =
-					varTree baseVar
-				     val {elt = child, isMutable} =
-					Prod.sub (children, offset)
-				     val (child, ss) =
-					case info of
-					   VarTree.Flat => (child, [])
-					 | VarTree.NotFlat _ =>
-					      let
-						 val child =
-						    (* Don't simplify a select out
-						     * of a mutable field.
-						     * Something may have mutated
-						     * it.
-						     *)
-						    if isMutable
-						       then VarTree.dropVars child
-						    else child
-					      in
-						 VarTree.fillInRoots
-						 (child,
-						  {base = Base.map (base, replaceVar),
-						   offset = (Object.finalOffset
-							     (obj, offset))})
-					      end
-				     val () = setVarTree (var, child)
-				  in
-				     ss
-				  end
-			 end)
-	     | Var x =>
-		  (Option.app (var, fn y => setVarTree (y, varTree x))
-		   ; none ())
-	 end
+         let
+            fun simpleTree () = Option.app (var, simpleVarTree)
+            fun doit (e: Exp.t) =
+               let
+                  val ty =
+                     case var of
+                        NONE => ty
+                      | SOME var => valueType (varValue var)
+               in
+                  [Bind {exp = e, ty = ty, var = var}]
+               end
+            fun simple () =
+               (simpleTree ()
+                ; doit (Exp.replaceVar (exp, replaceVar)))
+            fun none () = []
+         in
+            case exp of
+               Exp.Const _ => simple ()
+             | Inject _ => simple ()
+             | Object {args, con} =>
+                  (case var of
+                      NONE => none ()
+                    | SOME var =>
+                         let
+                            val v = varValue var
+                         in
+                            case Value.deObject v of
+                               NONE => simple ()
+                             | SOME {args = expects, flat, ...} =>
+                                  let
+                                     val z =
+                                        Vector.map2
+                                        (args, Prod.dest expects,
+                                         fn (arg, {elt, isMutable}) =>
+                                         let
+                                            val (vt, ss) =
+                                               coerceTree
+                                               {from = varTree arg,
+                                                to = Value.finalTree elt}
+                                         in
+                                            ({elt = vt,
+                                              isMutable = isMutable},
+                                             ss)
+                                         end)
+                                     val vts = Vector.map (z, #1)
+                                     fun set info =
+                                        setVarTree (var,
+                                                    Tree.T (info,
+                                                            Prod.make vts))
+                                  in
+                                     case !flat of
+                                        Flat => (set VarTree.Flat; none ())
+                                      | NotFlat =>
+                                           let
+                                              val ty = Value.finalType v
+                                              val () =
+                                                 set (VarTree.NotFlat
+                                                      {ty = ty,
+                                                       var = SOME var})
+                                              val args =
+                                                 Vector.fromList
+                                                 (Vector.foldr
+                                                  (vts, [],
+                                                   fn ({elt = vt, ...}, ac) =>
+                                                   VarTree.rootsOnto (vt, ac)))
+                                              val obj =
+                                                 Bind
+                                                 {exp = Object {args = args,
+                                                                con = con},
+                                                  ty = ty,
+                                                  var = SOME var}
+                                           in
+                                              Vector.foldr
+                                              (z, [obj],
+                                               fn ((_, ss), ac) => ss @ ac)
+                                           end
+                                  end
+                         end)
+             | PrimApp {args, prim} =>
+                  let
+                     val () = simpleTree ()
+                  in
+                     doit (PrimApp {args = replaceVars args,
+                                    prim = prim})
+                  end
+             | Select {base, offset} =>
+                  (case var of
+                      NONE => none ()
+                    | SOME var =>
+                         let
+                            val baseVar = Base.object base
+                         in
+                            case Value.deObject (varValue baseVar) of
+                               NONE => simple ()
+                             | SOME obj => 
+                                  let
+                                     val Tree.T (info, children) =
+                                        varTree baseVar
+                                     val {elt = child, isMutable} =
+                                        Prod.sub (children, offset)
+                                     val (child, ss) =
+                                        case info of
+                                           VarTree.Flat => (child, [])
+                                         | VarTree.NotFlat _ =>
+                                              let
+                                                 val child =
+                                                    (* Don't simplify a select out
+                                                     * of a mutable field.
+                                                     * Something may have mutated
+                                                     * it.
+                                                     *)
+                                                    if isMutable
+                                                       then VarTree.dropVars child
+                                                    else child
+                                              in
+                                                 VarTree.fillInRoots
+                                                 (child,
+                                                  {base = Base.map (base, replaceVar),
+                                                   offset = (Object.finalOffset
+                                                             (obj, offset))})
+                                              end
+                                     val () = setVarTree (var, child)
+                                  in
+                                     ss
+                                  end
+                         end)
+             | Var x =>
+                  (Option.app (var, fn y => setVarTree (y, varTree x))
+                   ; none ())
+         end
       fun transformStatement (s: Statement.t): Statement.t list =
-	 let
-	    fun simple () = [Statement.replaceUses (s, replaceVar)]
-	 in
-	    case s of
-	       Bind b => transformBind b
-	     | Profile _ => simple ()
-	     | Update {base, offset, value} =>
-		  let
-		     val baseVar =
-			case base of
-			   Base.Object x => x
-			 | Base.VectorSub {vector = x, ...} => x
-		  in
-		     case Value.deObject (varValue baseVar) of
-			NONE => simple ()
-		      | SOME object => 
-			   let
-			      val ss = ref []
-			      val child =
-				 Value.finalTree (Object.select (object, offset))
-			      val offset = Object.finalOffset (object, offset)
-			      val base = Base.map (base, replaceVar)
-			      val us =
-				 if not (TypeTree.isFlat child)
-				    then [Update {base = base,
-						  offset = offset,
-						  value = replaceVar value}]
-				 else
-				    let
-				       val (vt, ss') =
-					  coerceTree {from = varTree value,
-						      to = child}
-				       val () = ss := ss' @ (!ss)
-				       val r = ref offset
-				       val us = ref []
-				       val () =
-					  VarTree.foreachRoot
-					  (vt, fn var =>
-					   let
-					      val offset = !r
-					      val () = r := 1 + !r
-					   in
-					      List.push (us,
-							 Update {base = base,
-								 offset = offset,
-								 value = var})
-					   end)
-				    in
-				       !us
-				    end
-			   in
-			      !ss @ us
-			   end
-		  end
-	 end
+         let
+            fun simple () = [Statement.replaceUses (s, replaceVar)]
+         in
+            case s of
+               Bind b => transformBind b
+             | Profile _ => simple ()
+             | Update {base, offset, value} =>
+                  let
+                     val baseVar =
+                        case base of
+                           Base.Object x => x
+                         | Base.VectorSub {vector = x, ...} => x
+                  in
+                     case Value.deObject (varValue baseVar) of
+                        NONE => simple ()
+                      | SOME object => 
+                           let
+                              val ss = ref []
+                              val child =
+                                 Value.finalTree (Object.select (object, offset))
+                              val offset = Object.finalOffset (object, offset)
+                              val base = Base.map (base, replaceVar)
+                              val us =
+                                 if not (TypeTree.isFlat child)
+                                    then [Update {base = base,
+                                                  offset = offset,
+                                                  value = replaceVar value}]
+                                 else
+                                    let
+                                       val (vt, ss') =
+                                          coerceTree {from = varTree value,
+                                                      to = child}
+                                       val () = ss := ss' @ (!ss)
+                                       val r = ref offset
+                                       val us = ref []
+                                       val () =
+                                          VarTree.foreachRoot
+                                          (vt, fn var =>
+                                           let
+                                              val offset = !r
+                                              val () = r := 1 + !r
+                                           in
+                                              List.push (us,
+                                                         Update {base = base,
+                                                                 offset = offset,
+                                                                 value = var})
+                                           end)
+                                    in
+                                       !us
+                                    end
+                           in
+                              !ss @ us
+                           end
+                  end
+         end
       val transformStatement =
-	 Trace.trace ("DeepFlatten.transformStatement",
-		      Statement.layout,
-		      List.layout Statement.layout)
-	 transformStatement
+         Trace.trace ("DeepFlatten.transformStatement",
+                      Statement.layout,
+                      List.layout Statement.layout)
+         transformStatement
       fun transformStatements ss =
-	 Vector.concatV
-	 (Vector.map (ss, Vector.fromList o transformStatement))
+         Vector.concatV
+         (Vector.map (ss, Vector.fromList o transformStatement))
       fun transformTransfer t = Transfer.replaceVar (t, replaceVar)
       val transformTransfer =
-	 Trace.trace ("DeepFlatten.transformTransfer",
-		      Transfer.layout, Transfer.layout)
-	 transformTransfer
+         Trace.trace ("DeepFlatten.transformTransfer",
+                      Transfer.layout, Transfer.layout)
+         transformTransfer
       fun transformBlock (Block.T {args, label, statements, transfer}) =
-	 Block.T {args = transformFormals args,
-		  label = label,
-		  statements = transformStatements statements,
-		  transfer = transformTransfer transfer}
+         Block.T {args = transformFormals args,
+                  label = label,
+                  statements = transformStatements statements,
+                  transfer = transformTransfer transfer}
       fun transformFunction (f: Function.t): Function.t =
-	  let
-	     val {args, mayInline, name, start, ...} = Function.dest f
-	     val {raises, returns, ...} = func name
-	     val args = transformFormals args
-	     val raises = Option.map (raises, valuesTypes)
-	     val returns = Option.map (returns, valuesTypes)
-	     val blocks = ref []
-	     val () =
-		Function.dfs (f, fn b =>
-			      (List.push (blocks, transformBlock b)
-			       ; fn () => ()))
-	  in
-	     Function.new {args = args,
-			   blocks = Vector.fromList (!blocks),
-			   mayInline = mayInline,
-			   name = name,
-			   raises = raises,
-			   returns = returns,
-			   start = start}
-	  end
+          let
+             val {args, mayInline, name, start, ...} = Function.dest f
+             val {raises, returns, ...} = func name
+             val args = transformFormals args
+             val raises = Option.map (raises, valuesTypes)
+             val returns = Option.map (returns, valuesTypes)
+             val blocks = ref []
+             val () =
+                Function.dfs (f, fn b =>
+                              (List.push (blocks, transformBlock b)
+                               ; fn () => ()))
+          in
+             Function.new {args = args,
+                           blocks = Vector.fromList (!blocks),
+                           mayInline = mayInline,
+                           name = name,
+                           raises = raises,
+                           returns = returns,
+                           start = start}
+          end
       val globals = transformStatements globals
       val functions = List.revMap (functions, transformFunction)
       val program =
-	 Program.T {datatypes = datatypes,
-		    functions = functions,
-		    globals = globals,
-		    main = main}
+         Program.T {datatypes = datatypes,
+                    functions = functions,
+                    globals = globals,
+                    main = main}
       val () = Program.clear program
    in
       shrink program

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ssa/deep-flatten.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ssa/deep-flatten.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ssa/deep-flatten.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,8 +1,8 @@
-(* Copyright (C) 2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 2004-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 signature DEEP_FLATTEN_STRUCTS = 

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ssa/direct-exp.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ssa/direct-exp.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ssa/direct-exp.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 functor DirectExp (S: DIRECT_EXP_STRUCTS): DIRECT_EXP =
 struct
   
@@ -15,54 +16,54 @@
    
 datatype t =
    Arith of {prim: Type.t Prim.t,
-	     args: t vector,
-	     overflow: t,
-	     ty: Type.t}
+             args: t vector,
+             overflow: t,
+             ty: Type.t}
  | Call of {func: Func.t,
-	    args: t vector,
-	    ty: Type.t}
+            args: t vector,
+            ty: Type.t}
  | Case of {cases: cases,
-	    default: t option,
-	    test: t,
-	    ty: Type.t}
+            default: t option,
+            test: t,
+            ty: Type.t}
  | ConApp of {con: Con.t,
-	      args: t vector,
-	      ty: Type.t}
+              args: t vector,
+              ty: Type.t}
  | Const of Const.t
  | Detuple of {body: Var.t vector -> t,
-	       length: int,
-	       tuple: t}
+               length: int,
+               tuple: t}
  | DetupleBind of {body: t,
-		   components: Var.t vector,
-		   tuple: Var.t,
-		   tupleTy: Type.t}
+                   components: Var.t vector,
+                   tuple: Var.t,
+                   tupleTy: Type.t}
  | Handle of {try: t,
-	      catch: Var.t * Type.t,
-	      handler: t,
-	      ty: Type.t}
+              catch: Var.t * Type.t,
+              handler: t,
+              ty: Type.t}
  | Let of {decs: {var: Var.t, exp: t} list,
-	   body: t}
+           body: t}
  | Name of t * (Var.t -> t)
  | PrimApp of {prim: Type.t Prim.t,
-	       targs: Type.t vector,
-	       args: t vector,
-	       ty: Type.t}
+               targs: Type.t vector,
+               args: t vector,
+               ty: Type.t}
  | Profile of ProfileExp.t
  | Raise of t
  | Runtime of {args: t vector,
-	       prim: Type.t Prim.t,
-	       ty: Type.t}
+               prim: Type.t Prim.t,
+               ty: Type.t}
  | Select of {tuple: t,
-	      offset: int,
-	      ty: Type.t}
+              offset: int,
+              ty: Type.t}
  | Seq of t * t
  | Tuple of {exps: t vector,
-	     ty: Type.t}
+             ty: Type.t}
  | Var of Var.t * Type.t
 and cases =
    Con of {con: Con.t,
-	   args: (Var.t * Type.t) vector,
-	   body: t} vector
+           args: (Var.t * Type.t) vector,
+           body: t} vector
  | Word of WordSize.t * (WordX.t * t) vector
 
 val arith = Arith
@@ -91,17 +92,17 @@
 fun primApp {args, prim, targs, ty} =
    let
       fun runtime () =
-	 Runtime {args = args,
-		  prim = prim,
-		  ty = ty}
+         Runtime {args = args,
+                  prim = prim,
+                  ty = ty}
    in
       case Prim.name prim of
-	 Prim.Name.MLton_halt => runtime ()
+         Prim.Name.MLton_halt => runtime ()
        | Prim.Name.Thread_copyCurrent => runtime ()
        | _ => PrimApp {args = args,
-		       prim = prim,
-		       targs = targs,
-		       ty = ty}
+                       prim = prim,
+                       targs = targs,
+                       ty = ty}
    end
 
 local
@@ -113,104 +114,104 @@
 
 fun eq (e1, e2, ty) =
    primApp {prim = Prim.eq,
-	    targs = Vector.new1 ty,
-	    args = Vector.new2 (e1, e2),
-	    ty = Type.bool}
+            targs = Vector.new1 ty,
+            args = Vector.new2 (e1, e2),
+            ty = Type.bool}
 
 local
    open Layout
    fun lett (decs, body) =
       align [seq [str "let ", decs],
-	     seq [str "in ", body],
-	     str "end"]
+             seq [str "in ", body],
+             str "end"]
 in
    fun layout e : Layout.t =
       case e of
          Arith {prim, args, overflow, ...} =>
-	    align [Prim.layoutApp (prim, args, layout),
-		   seq [str "Overflow => ", layout overflow]]
+            align [Prim.layoutApp (prim, args, layout),
+                   seq [str "Overflow => ", layout overflow]]
        | Call {func, args, ty} =>
-	    seq [Func.layout func, str " ", layouts args,
-		 str ": ", Type.layout ty]
+            seq [Func.layout func, str " ", layouts args,
+                 str ": ", Type.layout ty]
        | Case {cases, default, test, ...} =>
-	    align
-	    [seq [str "case ", layout test, str " of"],
-	     indent
-	     (align [let
-			fun doit (v, f) =
-			   Vector.layout
-			   (fn z =>
-			    let
-			       val (x, e) = f z
-			    in
-			       seq [str "| ", x, str " => ", layout e]
-			    end)
-			   v
-			fun simple (v, f) =
-			   doit (v, (fn (x, e) => (f x, e)))
-		     in
-			case cases of
-			   Con v =>
-			      doit (v, fn {con, args, body} =>
-				    (seq [Con.layout con,
-					  Vector.layout (Var.layout o #1) args],
-				     body))
-			 | Word (_, v) => simple (v, WordX.layout)
-		     end,
-			case default of
-			   NONE => empty
-			 | SOME e => seq [str "  _ => ", layout e]],
-	      2)]
+            align
+            [seq [str "case ", layout test, str " of"],
+             indent
+             (align [let
+                        fun doit (v, f) =
+                           Vector.layout
+                           (fn z =>
+                            let
+                               val (x, e) = f z
+                            in
+                               seq [str "| ", x, str " => ", layout e]
+                            end)
+                           v
+                        fun simple (v, f) =
+                           doit (v, (fn (x, e) => (f x, e)))
+                     in
+                        case cases of
+                           Con v =>
+                              doit (v, fn {con, args, body} =>
+                                    (seq [Con.layout con,
+                                          Vector.layout (Var.layout o #1) args],
+                                     body))
+                         | Word (_, v) => simple (v, WordX.layout)
+                     end,
+                        case default of
+                           NONE => empty
+                         | SOME e => seq [str "  _ => ", layout e]],
+              2)]
        | ConApp {con, args, ty} =>
-	    seq [Con.layout con, layouts args, str ": ", Type.layout ty]
+            seq [Con.layout con, layouts args, str ": ", Type.layout ty]
        | Const c => Const.layout c
        | Detuple {tuple, ...} => seq [str "detuple ", layout tuple]
        | DetupleBind {body, components, tuple, ...} =>
-	    lett (seq [Vector.layout Var.layout components,
-		       str " = ", Var.layout tuple],
-		  layout body)
+            lett (seq [Vector.layout Var.layout components,
+                       str " = ", Var.layout tuple],
+                  layout body)
        | Handle {try, catch, handler, ...} =>
-	    align [layout try,
-		   seq [str "handle ", Var.layout (#1 catch),
-			str " => ", layout handler]]
+            align [layout try,
+                   seq [str "handle ", Var.layout (#1 catch),
+                        str " => ", layout handler]]
        | Let {decs, body} =>
-	    lett (align
-		  (List.map (decs, fn {var, exp} =>
-			     seq [Var.layout var, str " = ", layout exp])),
-		     layout body)
+            lett (align
+                  (List.map (decs, fn {var, exp} =>
+                             seq [Var.layout var, str " = ", layout exp])),
+                     layout body)
        | Name _ => str "Name"
        | PrimApp {args, prim, ...} =>
-	    Prim.layoutApp (prim, args, layout)
+            Prim.layoutApp (prim, args, layout)
        | Profile e => ProfileExp.layout e
        | Raise e => seq [str "raise ", layout e]
        | Runtime {args, prim, ...} =>
-	    Prim.layoutApp (prim, args, layout)
+            Prim.layoutApp (prim, args, layout)
        | Select {tuple, offset, ...} =>
-	    seq [str "#", str (Int.toString (1 + offset)), str " ",
-		 layout tuple]
+            seq [str "#", str (Int.toString (1 + offset)), str " ",
+                 layout tuple]
        | Seq (e1, e2) => seq [layout e1, str "; ", layout e2]
        | Tuple {exps, ...} => layouts exps
        | Var (x, t) =>
-	    seq [Var.layout x, str ": ", Type.layout t]
+            seq [Var.layout x, str ": ", Type.layout t]
    and layouts es = Vector.layout layout es
 end
 
 structure Res =
    struct
       type t = {statements: Statement.t list,
-		transfer: Transfer.t}
+                transfer: Transfer.t}
 
       fun layout {statements, transfer} =
-	 let
-	    open Layout
-	 in
-	    align [align (List.map (statements, Statement.layout)),
-		   Transfer.layout transfer]
-	 end
+         let
+            open Layout
+         in
+            align [align (List.map (statements, Statement.layout)),
+                   Transfer.layout transfer]
+         end
 
       fun prefix ({statements, transfer}: t, s: Statement.t): t =
-	 {statements = s :: statements,
-	  transfer = transfer}
+         {statements = s :: statements,
+          transfer = transfer}
    end
 
 structure Cont:
@@ -229,11 +230,11 @@
    end =
    struct
       type bind = {arg: Var.t,
-		   statements: Statement.t list,
-		   transfer: Transfer.t}
+                   statements: Statement.t list,
+                   transfer: Transfer.t}
 
       datatype t =
-	 Bind of bind
+         Bind of bind
        | Goto of Label.t
        | Prefix of t * Statement.t
        | ReceiveExp of Exp.t * Type.t -> Res.t
@@ -241,28 +242,28 @@
        | Return
 
       fun layout (k: t): Layout.t =
-	 let
-	    open Layout
-	 in
-	    case k of
-	       Bind {arg, statements, transfer} =>
-		  seq [str "Bind ",
-		       record [("arg", Var.layout arg),
-			       ("statements",
-				List.layout Statement.layout statements),
-			       ("transfer", Transfer.layout transfer)]]
-	     | Goto l => seq [str "Goto ", Label.layout l]
-	     | Prefix (k, s) => seq [str "Prefix ",
-				     tuple [layout k, Statement.layout s]]
-	     | ReceiveExp _ => str "ReceiveExp"
-	     | ReceiveVar _ => str "ReceiveVar"
-	     | Return => str "Return"
-	 end
+         let
+            open Layout
+         in
+            case k of
+               Bind {arg, statements, transfer} =>
+                  seq [str "Bind ",
+                       record [("arg", Var.layout arg),
+                               ("statements",
+                                List.layout Statement.layout statements),
+                               ("transfer", Transfer.layout transfer)]]
+             | Goto l => seq [str "Goto ", Label.layout l]
+             | Prefix (k, s) => seq [str "Prefix ",
+                                     tuple [layout k, Statement.layout s]]
+             | ReceiveExp _ => str "ReceiveExp"
+             | ReceiveVar _ => str "ReceiveVar"
+             | Return => str "Return"
+         end
 
       fun bind (arg, {statements, transfer}) =
-	 Bind {arg = arg,
-	       statements = statements,
-	       transfer = transfer}
+         Bind {arg = arg,
+               statements = statements,
+               transfer = transfer}
 
       val goto = Goto
       val receiveExp = ReceiveExp
@@ -270,64 +271,64 @@
       val return = Return
       
       fun toBind (k: t, ty: Type.t): bind =
-	 case k of
-	    Bind b => b
-	  | _ =>
-	       let
-		  val arg = Var.newNoname ()
-		  val {statements, transfer} = sendVar (k, ty, arg)
-	       in
-		  {arg = arg,
-		   statements = statements,
-		   transfer = transfer}
-	       end
+         case k of
+            Bind b => b
+          | _ =>
+               let
+                  val arg = Var.newNoname ()
+                  val {statements, transfer} = sendVar (k, ty, arg)
+               in
+                  {arg = arg,
+                   statements = statements,
+                   transfer = transfer}
+               end
       and sendVar (k: t, ty: Type.t, x: Var.t): Res.t =
-	 case k of
-	    Bind b => sendBindExp (b, ty, Exp.Var x)
-	  | Goto dst => {statements = [],
-			 transfer = Transfer.Goto {dst = dst,
-						   args = Vector.new1 x}}
-	  | ReceiveExp f => f (Exp.Var x, ty)
-	  | ReceiveVar f => f (x, ty)
-	  | Prefix (k, s) => Res.prefix (sendVar (k, ty, x), s)
-	  | Return => {statements = [],
-		       transfer = Transfer.Return (Vector.new1 x)}
+         case k of
+            Bind b => sendBindExp (b, ty, Exp.Var x)
+          | Goto dst => {statements = [],
+                         transfer = Transfer.Goto {dst = dst,
+                                                   args = Vector.new1 x}}
+          | ReceiveExp f => f (Exp.Var x, ty)
+          | ReceiveVar f => f (x, ty)
+          | Prefix (k, s) => Res.prefix (sendVar (k, ty, x), s)
+          | Return => {statements = [],
+                       transfer = Transfer.Return (Vector.new1 x)}
       and sendBindExp ({arg, statements, transfer}, ty, e: Exp.t) = 
-	 {statements = Statement.T {var = SOME arg,
-				    ty = ty,
-				    exp = e} :: statements,
-	  transfer = transfer}
+         {statements = Statement.T {var = SOME arg,
+                                    ty = ty,
+                                    exp = e} :: statements,
+          transfer = transfer}
 
       val sendVar =
-	 Trace.trace3 ("Cont.sendVar", layout, Type.layout, Var.layout,
-		       Res.layout)
-	 sendVar
+         Trace.trace3 ("DirectExp.Cont.sendVar", layout, Type.layout, Var.layout,
+                       Res.layout)
+         sendVar
 
       val sendExp: t * Type.t * Exp.t -> Res.t =
-	 fn (k, ty, e) =>
-	 case k of
-	    ReceiveExp f => f (e, ty)
-	  | _ => sendBindExp (toBind (k, ty), ty, e)
+         fn (k, ty, e) =>
+         case k of
+            ReceiveExp f => f (e, ty)
+          | _ => sendBindExp (toBind (k, ty), ty, e)
 
       val sendExp =
-	 Trace.trace3 ("Cont.sendExp", layout, Type.layout, Exp.layout,
-		       Res.layout)
-	 sendExp
+         Trace.trace3 ("DirectExp.Cont.sendExp", layout, Type.layout, Exp.layout,
+                       Res.layout)
+         sendExp
 
       fun toBlock (k: t, ty: Type.t): Block.t =
-	 let
-	    val {arg, statements, transfer} = toBind (k, ty)
-	    val label = Label.newNoname ()
-	 in
-	    Block.T {label = label,
-		     args = Vector.new1 (arg, ty),
-		     statements = Vector.fromList statements,
-		     transfer = transfer}
-	 end
+         let
+            val {arg, statements, transfer} = toBind (k, ty)
+            val label = Label.newNoname ()
+         in
+            Block.T {label = label,
+                     args = Vector.new1 (arg, ty),
+                     statements = Vector.fromList statements,
+                     transfer = transfer}
+         end
 
       val toBlock =
-	 Trace.trace2 ("Cont.toBlock", layout, Type.layout, Block.layout)
-	 toBlock
+         Trace.trace2 ("DirectExp.Cont.toBlock", layout, Type.layout, Block.layout)
+         toBlock
    end
 
 fun selects (tuple: Var.t, ty: Type.t, components: Var.t vector)
@@ -338,251 +339,251 @@
       Vector.foldi
       (ts, [], fn (i, t, ss) =>
        Statement.T {var = SOME (Vector.sub (components, i)),
-		    ty = t,
-		    exp = Exp.Select {tuple = tuple,
-				      offset = i}}
+                    ty = t,
+                    exp = Exp.Select {tuple = tuple,
+                                      offset = i}}
        :: ss)
    end
 
 fun linearize' (e: t, h: Handler.t, k: Cont.t): Label.t * Block.t list =
    let
       val traceLinearizeLoop =
-	 Trace.trace3 ("Linearize.loop", layout, Handler.layout, Cont.layout,
-		       Res.layout)
+         Trace.trace3 ("DirectExp.linearize'.loop", layout, Handler.layout, Cont.layout,
+                       Res.layout)
       val blocks: Block.t list ref = ref []
       fun newBlock (args: (Var.t * Type.t) vector,
-		    {statements: Statement.t list,
-		     transfer: Transfer.t}): Label.t =
-	 let 
-	    val label = Label.newNoname ()
-	    val _ = List.push (blocks,
-			       Block.T {label = label,
-					args = args,
-					statements = Vector.fromList statements,
-					transfer = transfer})
-	 in
-	    label
-	 end
+                    {statements: Statement.t list,
+                     transfer: Transfer.t}): Label.t =
+         let 
+            val label = Label.newNoname ()
+            val _ = List.push (blocks,
+                               Block.T {label = label,
+                                        args = args,
+                                        statements = Vector.fromList statements,
+                                        transfer = transfer})
+         in
+            label
+         end
       fun reify (k: Cont.t, ty: Type.t): Label.t =
-	 let
-	    val b = Cont.toBlock (k, ty)
-	    val _ = List.push (blocks, b)
-	 in
-	    Block.label b
-	 end
+         let
+            val b = Cont.toBlock (k, ty)
+            val _ = List.push (blocks, b)
+         in
+            Block.label b
+         end
       fun newLabel (args: (Var.t * Type.t) vector,
-		    e: t,
-		    h: Handler.t,
-		    k: Cont.t): Label.t =
-	 newBlock (args, loop (e, h, k))
+                    e: t,
+                    h: Handler.t,
+                    k: Cont.t): Label.t =
+         newBlock (args, loop (e, h, k))
       and newLabel0 (e, h, k) = newLabel (Vector.new0 (), e, h, k)
       and loopf (e: t, h: Handler.t, f: Var.t * Type.t -> Res.t) =
-	 loop (e, h, Cont.receiveVar f)
+         loop (e, h, Cont.receiveVar f)
       and loop arg : Res.t =
-	 traceLinearizeLoop
-	 (fn (e: t, h: Handler.t, k: Cont.t) =>
-	 case e of
-	    Arith {prim, args, overflow, ty} =>
-	       loops
-	       (args, h, fn xs =>
-		let
-		   val l = reify (k, ty)
-		   val k = Cont.goto l
-		in
-		   {statements = [],
-		    transfer =
-		    Transfer.Arith {prim = prim,
-				    args = xs,
-				    overflow = newLabel0 (overflow, h, k),
-				    success = l,
-				    ty = ty}}
-		end)
-	  | Call {func, args, ty} =>
-	       loops
-	       (args, h, fn xs =>
-		{statements = [],
-		 transfer = (Transfer.Call
-			     {func = func,
-			      args = xs,
-			      return = Return.NonTail {cont = reify (k, ty),
-						       handler = h}})})
-	  | Case {cases, default, test, ty} =>
-	       let
-		  val k = Cont.goto (reify (k, ty))
-	       in
-		  loopf (test, h, fn (x, _) =>
-			 {statements = [],
-			  transfer =
-			  Transfer.Case
-			  {test = x,
-			   default = Option.map (default, fn e =>
-						 newLabel0 (e, h, k)),
-			   cases =
-			   let
-			      fun doit v = 
-				 Vector.map (v, fn (c, e) =>
-					     (c, newLabel0 (e, h, k)))
-			   in
-			      case cases of
-				 Con v =>
-				    Cases.Con
-				    (Vector.map
-				     (v, fn {con, args, body} =>
-				      (con,
-				       newLabel (args, body, h, k))))
-			       | Word (s, v) => Cases.Word (s, doit v)
-			   end}})
-	       end
-	  | ConApp {con, args, ty} =>
-	       loops (args, h, fn xs =>
-		      Cont.sendExp (k, ty, Exp.ConApp {con = con, args = xs}))
-	  | Const c => Cont.sendExp (k, Type.ofConst c, Exp.Const c)
-	  | Detuple {tuple, length, body} =>
-	       loop (tuple, h,
-		     Cont.receiveExp
-		     (fn (e, ty) =>
-		      let
-			 fun doit (tuple: Var.t): Res.t =
-			    let
-			       val (ss, xs) = 
-				  case length of
-				     0 => ([], Vector.new0 ())
-				   | 1 => ([], Vector.new1 tuple)
-				   | _ =>
-					let
-					   val xs = 
-					      Vector.tabulate
-					      (length, fn _ => Var.newNoname ())
-					in (selects (tuple, ty, xs), xs)
-					end
-			       val {statements, transfer} = loop (body xs, h, k)
-			    in
-			       {statements = List.appendRev (ss, statements),
-				transfer = transfer}
-			    end
-		      in
-			 case e of
-			    Exp.Tuple xs => loop (body xs, h, k)
-			  | Exp.Var x => doit x
-			  | _ => 
-			       let
-				  val tuple = Var.newNoname ()
-			       in
-				  Res.prefix (doit tuple,
-					      Statement.T {var = SOME tuple,
-							   ty = ty,
-							   exp = e})
-			       end
-		      end))
-	  | DetupleBind {body, components, tuple, tupleTy} =>
-	       let
-		  val {statements, transfer} = loop (body, h, k)
-		  val ss =
-		     case Vector.length components of
-			0 => []
-		      | 1 => [Statement.T
-			      {var = SOME (Vector.sub (components, 0)),
-			       ty = tupleTy,
-			       exp = Exp.Var tuple}]
-		      | _ => selects (tuple, tupleTy, components)
-	       in
-		  {statements = List.appendRev (ss, statements),
-		   transfer = transfer}
-	       end
-	  | Handle {try, catch, handler, ty} =>
-	       let
-		  val k = Cont.goto (reify (k, ty))
-		  val hl = Label.newNoname ()
-		  val {statements, transfer} = loop (handler, h, k)
-		  val _ =
-		     List.push (blocks,
-				Block.T {label = hl,
-					 args = Vector.new1 catch,
-					 statements = Vector.fromList statements,
-					 transfer = transfer})
-	       in
-		  loop (try, Handler.Handle hl, k)
-	       end
-	  | Let {decs, body} =>
-	       let
-		  fun each decs =
-		     case decs of
-			[] => loop (body, h, k)
-		      | {var, exp} :: decs =>
-			   loop (exp, h, Cont.bind (var, each decs))
-	       in
-		  each decs
-	       end
-	  | Name (e, f) => loopf (e, h, fn (x, _) => loop (f x, h, k))
-	  | PrimApp {prim, targs, args, ty} =>
-	       loops
-	       (args, h, fn xs =>
-		Cont.sendExp (k, ty, Exp.PrimApp {prim = prim,
-						  targs = targs,
-						  args = xs}))
-	  | Profile e => Cont.sendExp (k, Type.unit, Exp.Profile e)
-	  | Raise e =>
-	       loopf (e, h, fn (x, _) =>
-		      {statements = [],
-		       transfer =
-		       (case h of
-			   Handler.Caller => Transfer.Raise (Vector.new1 x)
-			 | Handler.Dead => Error.bug "raise to dead handler"
-			 | Handler.Handle l =>
-			      Transfer.Goto {args = Vector.new1 x,
-					     dst = l})})
-	  | Runtime {args, prim, ty} =>
-	       loops
-	       (args, h, fn xs =>
-		let
-		   val l = reify (k, ty)
-		   val k = Cont.goto l
-		   val (args, exps) =
-		      case Type.deTupleOpt ty of
-			 NONE =>
-			    let
-			       val res = Var.newNoname ()
-			    in
-			       (Vector.new1 (res, ty),
-				Vector.new1 (Var (res, ty)))
-			    end
-		       | SOME ts =>
-			    if 0 = Vector.length ts
-			       then (Vector.new0 (), Vector.new0 ())
-			    else
-			       Error.bug
-			       (concat ["prim with multiple return values: ",
-					Prim.toString prim])
-		in
-		   {statements = [],
-		    transfer =
-		    Transfer.Runtime
-		    {prim = prim,
-		     args = xs,
-		     return = newLabel (args,
-					tuple {exps = exps,
-					       ty = ty},
-					h, k)}}
-		end)
-	  | Select {tuple, offset, ty} =>
-	       loopf (tuple, h, fn (tuple, _) =>
-		      Cont.sendExp (k, ty, Exp.Select {tuple = tuple,
-						       offset = offset}))
-	  | Seq (e1, e2) => loopf (e1, h, fn _ => loop (e2, h, k))
-	  | Tuple {exps, ty} =>
-	       loops (exps, h, fn xs => Cont.sendExp (k, ty, Exp.Tuple xs))
-	  | Var (x, ty) => Cont.sendVar (k, ty, x)) arg
+         traceLinearizeLoop
+         (fn (e: t, h: Handler.t, k: Cont.t) =>
+         case e of
+            Arith {prim, args, overflow, ty} =>
+               loops
+               (args, h, fn xs =>
+                let
+                   val l = reify (k, ty)
+                   val k = Cont.goto l
+                in
+                   {statements = [],
+                    transfer =
+                    Transfer.Arith {prim = prim,
+                                    args = xs,
+                                    overflow = newLabel0 (overflow, h, k),
+                                    success = l,
+                                    ty = ty}}
+                end)
+          | Call {func, args, ty} =>
+               loops
+               (args, h, fn xs =>
+                {statements = [],
+                 transfer = (Transfer.Call
+                             {func = func,
+                              args = xs,
+                              return = Return.NonTail {cont = reify (k, ty),
+                                                       handler = h}})})
+          | Case {cases, default, test, ty} =>
+               let
+                  val k = Cont.goto (reify (k, ty))
+               in
+                  loopf (test, h, fn (x, _) =>
+                         {statements = [],
+                          transfer =
+                          Transfer.Case
+                          {test = x,
+                           default = Option.map (default, fn e =>
+                                                 newLabel0 (e, h, k)),
+                           cases =
+                           let
+                              fun doit v = 
+                                 Vector.map (v, fn (c, e) =>
+                                             (c, newLabel0 (e, h, k)))
+                           in
+                              case cases of
+                                 Con v =>
+                                    Cases.Con
+                                    (Vector.map
+                                     (v, fn {con, args, body} =>
+                                      (con,
+                                       newLabel (args, body, h, k))))
+                               | Word (s, v) => Cases.Word (s, doit v)
+                           end}})
+               end
+          | ConApp {con, args, ty} =>
+               loops (args, h, fn xs =>
+                      Cont.sendExp (k, ty, Exp.ConApp {con = con, args = xs}))
+          | Const c => Cont.sendExp (k, Type.ofConst c, Exp.Const c)
+          | Detuple {tuple, length, body} =>
+               loop (tuple, h,
+                     Cont.receiveExp
+                     (fn (e, ty) =>
+                      let
+                         fun doit (tuple: Var.t): Res.t =
+                            let
+                               val (ss, xs) = 
+                                  case length of
+                                     0 => ([], Vector.new0 ())
+                                   | 1 => ([], Vector.new1 tuple)
+                                   | _ =>
+                                        let
+                                           val xs = 
+                                              Vector.tabulate
+                                              (length, fn _ => Var.newNoname ())
+                                        in (selects (tuple, ty, xs), xs)
+                                        end
+                               val {statements, transfer} = loop (body xs, h, k)
+                            in
+                               {statements = List.appendRev (ss, statements),
+                                transfer = transfer}
+                            end
+                      in
+                         case e of
+                            Exp.Tuple xs => loop (body xs, h, k)
+                          | Exp.Var x => doit x
+                          | _ => 
+                               let
+                                  val tuple = Var.newNoname ()
+                               in
+                                  Res.prefix (doit tuple,
+                                              Statement.T {var = SOME tuple,
+                                                           ty = ty,
+                                                           exp = e})
+                               end
+                      end))
+          | DetupleBind {body, components, tuple, tupleTy} =>
+               let
+                  val {statements, transfer} = loop (body, h, k)
+                  val ss =
+                     case Vector.length components of
+                        0 => []
+                      | 1 => [Statement.T
+                              {var = SOME (Vector.sub (components, 0)),
+                               ty = tupleTy,
+                               exp = Exp.Var tuple}]
+                      | _ => selects (tuple, tupleTy, components)
+               in
+                  {statements = List.appendRev (ss, statements),
+                   transfer = transfer}
+               end
+          | Handle {try, catch, handler, ty} =>
+               let
+                  val k = Cont.goto (reify (k, ty))
+                  val hl = Label.newNoname ()
+                  val {statements, transfer} = loop (handler, h, k)
+                  val _ =
+                     List.push (blocks,
+                                Block.T {label = hl,
+                                         args = Vector.new1 catch,
+                                         statements = Vector.fromList statements,
+                                         transfer = transfer})
+               in
+                  loop (try, Handler.Handle hl, k)
+               end
+          | Let {decs, body} =>
+               let
+                  fun each decs =
+                     case decs of
+                        [] => loop (body, h, k)
+                      | {var, exp} :: decs =>
+                           loop (exp, h, Cont.bind (var, each decs))
+               in
+                  each decs
+               end
+          | Name (e, f) => loopf (e, h, fn (x, _) => loop (f x, h, k))
+          | PrimApp {prim, targs, args, ty} =>
+               loops
+               (args, h, fn xs =>
+                Cont.sendExp (k, ty, Exp.PrimApp {prim = prim,
+                                                  targs = targs,
+                                                  args = xs}))
+          | Profile e => Cont.sendExp (k, Type.unit, Exp.Profile e)
+          | Raise e =>
+               loopf (e, h, fn (x, _) =>
+                      {statements = [],
+                       transfer =
+                       (case h of
+                           Handler.Caller => Transfer.Raise (Vector.new1 x)
+                         | Handler.Dead => Error.bug "DirectExp.linearize'.loop: Raise:to dead handler"
+                         | Handler.Handle l =>
+                              Transfer.Goto {args = Vector.new1 x,
+                                             dst = l})})
+          | Runtime {args, prim, ty} =>
+               loops
+               (args, h, fn xs =>
+                let
+                   val l = reify (k, ty)
+                   val k = Cont.goto l
+                   val (args, exps) =
+                      case Type.deTupleOpt ty of
+                         NONE =>
+                            let
+                               val res = Var.newNoname ()
+                            in
+                               (Vector.new1 (res, ty),
+                                Vector.new1 (Var (res, ty)))
+                            end
+                       | SOME ts =>
+                            if 0 = Vector.length ts
+                               then (Vector.new0 (), Vector.new0 ())
+                            else
+                               Error.bug
+                               (concat ["DirectExp.linearize'.loop: Runtime:with multiple return values: ",
+                                        Prim.toString prim])
+                in
+                   {statements = [],
+                    transfer =
+                    Transfer.Runtime
+                    {prim = prim,
+                     args = xs,
+                     return = newLabel (args,
+                                        tuple {exps = exps,
+                                               ty = ty},
+                                        h, k)}}
+                end)
+          | Select {tuple, offset, ty} =>
+               loopf (tuple, h, fn (tuple, _) =>
+                      Cont.sendExp (k, ty, Exp.Select {tuple = tuple,
+                                                       offset = offset}))
+          | Seq (e1, e2) => loopf (e1, h, fn _ => loop (e2, h, k))
+          | Tuple {exps, ty} =>
+               loops (exps, h, fn xs => Cont.sendExp (k, ty, Exp.Tuple xs))
+          | Var (x, ty) => Cont.sendVar (k, ty, x)) arg
       and loops (es: t vector, h: Handler.t, k: Var.t vector -> Res.t): Res.t =
-	 let
-	    val n = Vector.length es
-	    fun each (i, ac) =
-	       if i = n
-		  then k (Vector.fromListRev ac)
-	       else loopf (Vector.sub (es, i), h, fn (x, _) =>
-			   each (i + 1, x :: ac))
-	 in
-	    each (0, [])
-	 end
+         let
+            val n = Vector.length es
+            fun each (i, ac) =
+               if i = n
+                  then k (Vector.fromListRev ac)
+               else loopf (Vector.sub (es, i), h, fn (x, _) =>
+                           each (i + 1, x :: ac))
+         in
+            each (0, [])
+         end
       val l = newLabel0 (e, h, k)
    in
       (l, !blocks)
@@ -591,9 +592,9 @@
 fun linearize (e: t, h) = linearize' (e, h, Cont.return)
 
 val linearize =
-   Trace.trace2 ("Linearize.linearize", layout, Handler.layout,
-		Layout.tuple2 (Label.layout,
-			       List.layout (Label.layout o Block.label)))
+   Trace.trace2 ("DirectExp.linearize", layout, Handler.layout,
+                Layout.tuple2 (Label.layout,
+                               List.layout (Label.layout o Block.label)))
    linearize
 
 fun linearizeGoto (e: t, h, l) = linearize' (e, h, Cont.goto l)

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ssa/direct-exp.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ssa/direct-exp.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ssa/direct-exp.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 type int = Int.t
 
 signature DIRECT_EXP_STRUCTS =
@@ -17,65 +18,65 @@
      include DIRECT_EXP_STRUCTS
 
      structure DirectExp:
-	sig
-	   type t
+        sig
+           type t
 
-	   datatype cases =
-	      Con of {con: Con.t,
-		      args: (Var.t * Type.t) vector,
-		      body: t} vector
-	    | Word of WordSize.t * (WordX.t * t) vector
+           datatype cases =
+              Con of {con: Con.t,
+                      args: (Var.t * Type.t) vector,
+                      body: t} vector
+            | Word of WordSize.t * (WordX.t * t) vector
 
-	   val arith: {prim: Type.t Prim.t,
-		       args: t vector,
-		       overflow: t,
-		       ty: Type.t} -> t
-	   (* For now, call always uses Handler.None.  This means it should only
-	    * be used for functions that cannot raise.
-	    *)
-	   val call: {func: Func.t, args: t vector, ty: Type.t} -> t
-	   val casee: {test: t, 
-		       cases: cases,
-		       default: t option,
-		       ty: Type.t} -> t
-	   val conApp: {con: Con.t, 
-			args: t vector,
-			ty: Type.t} -> t
-	   val const: Const.t -> t
-	   val detuple: {body: Var.t vector -> t,
-			 length: int,
-			 tuple: t} -> t
-	   val detupleBind: {body: t,
-			     components: Var.t vector,
-			     tuple: Var.t,
-			     tupleTy: Type.t} -> t
-	   val eq: t * t * Type.t -> t
-	   val falsee: t
-	   val handlee: {try: t,
-			 ty: Type.t,
-			 catch: Var.t * Type.t,
-			 handler: t} -> t
-	   val layout: t -> Layout.t
-	   val lett: {decs: {var: Var.t, exp: t} list,
-		      body: t} -> t
-	   val linearize:
-	      t * Return.Handler.t -> Label.t * Block.t list
-	   val linearizeGoto:
-	      t * Return.Handler.t * Label.t -> Label.t * Block.t list
-	   val name: t * (Var.t -> t) -> t
-	   val primApp: {args: t vector,
-			 prim: Type.t Prim.t,
-			 targs: Type.t vector, 
-			 ty: Type.t} -> t
-	   val profile: ProfileExp.t -> t
-	   val raisee: t -> t
-	   val select: {tuple: t, 
-			offset: int, 
-			ty: Type.t} -> t
-	   val seq: t * t -> t
-	   val truee: t
-	   val tuple: {exps: t vector, ty: Type.t} -> t
-	   val var: Var.t * Type.t -> t
-	   val word: WordX.t -> t
-	end
+           val arith: {prim: Type.t Prim.t,
+                       args: t vector,
+                       overflow: t,
+                       ty: Type.t} -> t
+           (* For now, call always uses Handler.None.  This means it should only
+            * be used for functions that cannot raise.
+            *)
+           val call: {func: Func.t, args: t vector, ty: Type.t} -> t
+           val casee: {test: t, 
+                       cases: cases,
+                       default: t option,
+                       ty: Type.t} -> t
+           val conApp: {con: Con.t, 
+                        args: t vector,
+                        ty: Type.t} -> t
+           val const: Const.t -> t
+           val detuple: {body: Var.t vector -> t,
+                         length: int,
+                         tuple: t} -> t
+           val detupleBind: {body: t,
+                             components: Var.t vector,
+                             tuple: Var.t,
+                             tupleTy: Type.t} -> t
+           val eq: t * t * Type.t -> t
+           val falsee: t
+           val handlee: {try: t,
+                         ty: Type.t,
+                         catch: Var.t * Type.t,
+                         handler: t} -> t
+           val layout: t -> Layout.t
+           val lett: {decs: {var: Var.t, exp: t} list,
+                      body: t} -> t
+           val linearize:
+              t * Return.Handler.t -> Label.t * Block.t list
+           val linearizeGoto:
+              t * Return.Handler.t * Label.t -> Label.t * Block.t list
+           val name: t * (Var.t -> t) -> t
+           val primApp: {args: t vector,
+                         prim: Type.t Prim.t,
+                         targs: Type.t vector, 
+                         ty: Type.t} -> t
+           val profile: ProfileExp.t -> t
+           val raisee: t -> t
+           val select: {tuple: t, 
+                        offset: int, 
+                        ty: Type.t} -> t
+           val seq: t * t -> t
+           val truee: t
+           val tuple: {exps: t vector, ty: Type.t} -> t
+           val var: Var.t * Type.t -> t
+           val word: WordX.t -> t
+        end
   end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ssa/direct-exp2.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ssa/direct-exp2.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ssa/direct-exp2.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,9 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 functor DirectExp2 (S: DIRECT_EXP2_STRUCTS): DIRECT_EXP2 =
@@ -16,54 +16,54 @@
    
 datatype t =
    Arith of {prim: Type.t Prim.t,
-	     args: t vector,
-	     overflow: t,
-	     ty: Type.t}
+             args: t vector,
+             overflow: t,
+             ty: Type.t}
  | Call of {func: Func.t,
-	    args: t vector,
-	    ty: Type.t}
+            args: t vector,
+            ty: Type.t}
  | Case of {cases: cases,
-	    default: t option,
-	    test: t,
-	    ty: Type.t}
+            default: t option,
+            test: t,
+            ty: Type.t}
  | ConApp of {con: Con.t,
-	      args: t vector,
-	      ty: Type.t}
+              args: t vector,
+              ty: Type.t}
  | Const of Const.t
  | Detuple of {body: Var.t vector -> t,
-	       length: int,
-	       tuple: t}
+               length: int,
+               tuple: t}
  | DetupleBind of {body: t,
-		   components: Var.t vector,
-		   tuple: Var.t,
-		   tupleTy: Type.t}
+                   components: Var.t vector,
+                   tuple: Var.t,
+                   tupleTy: Type.t}
  | Handle of {try: t,
-	      catch: Var.t * Type.t,
-	      handler: t,
-	      ty: Type.t}
+              catch: Var.t * Type.t,
+              handler: t,
+              ty: Type.t}
  | Let of {decs: {var: Var.t, exp: t} list,
-	   body: t}
+           body: t}
  | Name of t * (Var.t -> t)
  | PrimApp of {prim: Type.t Prim.t,
-	       targs: Type.t vector,
-	       args: t vector,
-	       ty: Type.t}
+               targs: Type.t vector,
+               args: t vector,
+               ty: Type.t}
  | Profile of ProfileExp.t
  | Raise of t
  | Runtime of {args: t vector,
-	       prim: Type.t Prim.t,
-	       ty: Type.t}
+               prim: Type.t Prim.t,
+               ty: Type.t}
  | Select of {tuple: t,
-	      offset: int,
-	      ty: Type.t}
+              offset: int,
+              ty: Type.t}
  | Seq of t * t
  | Tuple of {exps: t vector,
-	     ty: Type.t}
+             ty: Type.t}
  | Var of Var.t * Type.t
 and cases =
    Con of {con: Con.t,
-	   args: (Var.t * Type.t) vector,
-	   body: t} vector
+           args: (Var.t * Type.t) vector,
+           body: t} vector
  | Word of WordSize.t * (WordX.t * t) vector
 
 val arith = Arith
@@ -92,17 +92,17 @@
 fun primApp {args, prim, targs, ty} =
    let
       fun runtime () =
-	 Runtime {args = args,
-		  prim = prim,
-		  ty = ty}
+         Runtime {args = args,
+                  prim = prim,
+                  ty = ty}
    in
       case Prim.name prim of
-	 Prim.Name.MLton_halt => runtime ()
+         Prim.Name.MLton_halt => runtime ()
        | Prim.Name.Thread_copyCurrent => runtime ()
        | _ => PrimApp {args = args,
-		       prim = prim,
-		       targs = targs,
-		       ty = ty}
+                       prim = prim,
+                       targs = targs,
+                       ty = ty}
    end
 
 local
@@ -114,104 +114,104 @@
 
 fun eq (e1, e2, ty) =
    primApp {prim = Prim.eq,
-	    targs = Vector.new1 ty,
-	    args = Vector.new2 (e1, e2),
-	    ty = Type.bool}
+            targs = Vector.new1 ty,
+            args = Vector.new2 (e1, e2),
+            ty = Type.bool}
 
 local
    open Layout
    fun lett (decs, body) =
       align [seq [str "let ", decs],
-	     seq [str "in ", body],
-	     str "end"]
+             seq [str "in ", body],
+             str "end"]
 in
    fun layout e : Layout.t =
       case e of
          Arith {prim, args, overflow, ...} =>
-	    align [Prim.layoutApp (prim, args, layout),
-		   seq [str "Overflow => ", layout overflow]]
+            align [Prim.layoutApp (prim, args, layout),
+                   seq [str "Overflow => ", layout overflow]]
        | Call {func, args, ty} =>
-	    seq [Func.layout func, str " ", layouts args,
-		 str ": ", Type.layout ty]
+            seq [Func.layout func, str " ", layouts args,
+                 str ": ", Type.layout ty]
        | Case {cases, default, test, ...} =>
-	    align
-	    [seq [str "case ", layout test, str " of"],
-	     indent
-	     (align [let
-			fun doit (v, f) =
-			   Vector.layout
-			   (fn z =>
-			    let
-			       val (x, e) = f z
-			    in
-			       seq [str "| ", x, str " => ", layout e]
-			    end)
-			   v
-			fun simple (v, f) =
-			   doit (v, (fn (x, e) => (f x, e)))
-		     in
-			case cases of
-			   Con v =>
-			      doit (v, fn {con, args, body} =>
-				    (seq [Con.layout con,
-					  Vector.layout (Var.layout o #1) args],
-				     body))
-			 | Word (_, v) => simple (v, WordX.layout)
-		     end,
-			case default of
-			   NONE => empty
-			 | SOME e => seq [str "  _ => ", layout e]],
-	      2)]
+            align
+            [seq [str "case ", layout test, str " of"],
+             indent
+             (align [let
+                        fun doit (v, f) =
+                           Vector.layout
+                           (fn z =>
+                            let
+                               val (x, e) = f z
+                            in
+                               seq [str "| ", x, str " => ", layout e]
+                            end)
+                           v
+                        fun simple (v, f) =
+                           doit (v, (fn (x, e) => (f x, e)))
+                     in
+                        case cases of
+                           Con v =>
+                              doit (v, fn {con, args, body} =>
+                                    (seq [Con.layout con,
+                                          Vector.layout (Var.layout o #1) args],
+                                     body))
+                         | Word (_, v) => simple (v, WordX.layout)
+                     end,
+                        case default of
+                           NONE => empty
+                         | SOME e => seq [str "  _ => ", layout e]],
+              2)]
        | ConApp {con, args, ty} =>
-	    seq [Con.layout con, layouts args, str ": ", Type.layout ty]
+            seq [Con.layout con, layouts args, str ": ", Type.layout ty]
        | Const c => Const.layout c
        | Detuple {tuple, ...} => seq [str "detuple ", layout tuple]
        | DetupleBind {body, components, tuple, ...} =>
-	    lett (seq [Vector.layout Var.layout components,
-		       str " = ", Var.layout tuple],
-		  layout body)
+            lett (seq [Vector.layout Var.layout components,
+                       str " = ", Var.layout tuple],
+                  layout body)
        | Handle {try, catch, handler, ...} =>
-	    align [layout try,
-		   seq [str "handle ", Var.layout (#1 catch),
-			str " => ", layout handler]]
+            align [layout try,
+                   seq [str "handle ", Var.layout (#1 catch),
+                        str " => ", layout handler]]
        | Let {decs, body} =>
-	    lett (align
-		  (List.map (decs, fn {var, exp} =>
-			     seq [Var.layout var, str " = ", layout exp])),
-		     layout body)
+            lett (align
+                  (List.map (decs, fn {var, exp} =>
+                             seq [Var.layout var, str " = ", layout exp])),
+                     layout body)
        | Name _ => str "Name"
        | PrimApp {args, prim, ...} =>
-	    Prim.layoutApp (prim, args, layout)
+            Prim.layoutApp (prim, args, layout)
        | Profile e => ProfileExp.layout e
        | Raise e => seq [str "raise ", layout e]
        | Runtime {args, prim, ...} =>
-	    Prim.layoutApp (prim, args, layout)
+            Prim.layoutApp (prim, args, layout)
        | Select {tuple, offset, ...} =>
-	    seq [str "#", str (Int.toString (1 + offset)), str " ",
-		 layout tuple]
+            seq [str "#", str (Int.toString (1 + offset)), str " ",
+                 layout tuple]
        | Seq (e1, e2) => seq [layout e1, str "; ", layout e2]
        | Tuple {exps, ...} => layouts exps
        | Var (x, t) =>
-	    seq [Var.layout x, str ": ", Type.layout t]
+            seq [Var.layout x, str ": ", Type.layout t]
    and layouts es = Vector.layout layout es
 end
 
 structure Res =
    struct
       type t = {statements: Statement.t list,
-		transfer: Transfer.t}
+                transfer: Transfer.t}
 
       fun layout {statements, transfer} =
-	 let
-	    open Layout
-	 in
-	    align [align (List.map (statements, Statement.layout)),
-		   Transfer.layout transfer]
-	 end
+         let
+            open Layout
+         in
+            align [align (List.map (statements, Statement.layout)),
+                   Transfer.layout transfer]
+         end
 
       fun prefix ({statements, transfer}: t, s: Statement.t): t =
-	 {statements = s :: statements,
-	  transfer = transfer}
+         {statements = s :: statements,
+          transfer = transfer}
    end
 
 structure Cont:
@@ -230,11 +230,11 @@
    end =
    struct
       type bind = {arg: Var.t,
-		   statements: Statement.t list,
-		   transfer: Transfer.t}
+                   statements: Statement.t list,
+                   transfer: Transfer.t}
 
       datatype t =
-	 Bind of bind
+         Bind of bind
        | Goto of Label.t
        | Prefix of t * Statement.t
        | ReceiveExp of Exp.t * Type.t -> Res.t
@@ -242,28 +242,28 @@
        | Return
 
       fun layout (k: t): Layout.t =
-	 let
-	    open Layout
-	 in
-	    case k of
-	       Bind {arg, statements, transfer} =>
-		  seq [str "Bind ",
-		       record [("arg", Var.layout arg),
-			       ("statements",
-				List.layout Statement.layout statements),
-			       ("transfer", Transfer.layout transfer)]]
-	     | Goto l => seq [str "Goto ", Label.layout l]
-	     | Prefix (k, s) => seq [str "Prefix ",
-				     tuple [layout k, Statement.layout s]]
-	     | ReceiveExp _ => str "ReceiveExp"
-	     | ReceiveVar _ => str "ReceiveVar"
-	     | Return => str "Return"
-	 end
+         let
+            open Layout
+         in
+            case k of
+               Bind {arg, statements, transfer} =>
+                  seq [str "Bind ",
+                       record [("arg", Var.layout arg),
+                               ("statements",
+                                List.layout Statement.layout statements),
+                               ("transfer", Transfer.layout transfer)]]
+             | Goto l => seq [str "Goto ", Label.layout l]
+             | Prefix (k, s) => seq [str "Prefix ",
+                                     tuple [layout k, Statement.layout s]]
+             | ReceiveExp _ => str "ReceiveExp"
+             | ReceiveVar _ => str "ReceiveVar"
+             | Return => str "Return"
+         end
 
       fun bind (arg, {statements, transfer}) =
-	 Bind {arg = arg,
-	       statements = statements,
-	       transfer = transfer}
+         Bind {arg = arg,
+               statements = statements,
+               transfer = transfer}
 
       val goto = Goto
       val receiveExp = ReceiveExp
@@ -271,64 +271,64 @@
       val return = Return
       
       fun toBind (k: t, ty: Type.t): bind =
-	 case k of
-	    Bind b => b
-	  | _ =>
-	       let
-		  val arg = Var.newNoname ()
-		  val {statements, transfer} = sendVar (k, ty, arg)
-	       in
-		  {arg = arg,
-		   statements = statements,
-		   transfer = transfer}
-	       end
+         case k of
+            Bind b => b
+          | _ =>
+               let
+                  val arg = Var.newNoname ()
+                  val {statements, transfer} = sendVar (k, ty, arg)
+               in
+                  {arg = arg,
+                   statements = statements,
+                   transfer = transfer}
+               end
       and sendVar (k: t, ty: Type.t, x: Var.t): Res.t =
-	 case k of
-	    Bind b => sendBindExp (b, ty, Exp.Var x)
-	  | Goto dst => {statements = [],
-			 transfer = Transfer.Goto {dst = dst,
-						   args = Vector.new1 x}}
-	  | ReceiveExp f => f (Exp.Var x, ty)
-	  | ReceiveVar f => f (x, ty)
-	  | Prefix (k, s) => Res.prefix (sendVar (k, ty, x), s)
-	  | Return => {statements = [],
-		       transfer = Transfer.Return (Vector.new1 x)}
+         case k of
+            Bind b => sendBindExp (b, ty, Exp.Var x)
+          | Goto dst => {statements = [],
+                         transfer = Transfer.Goto {dst = dst,
+                                                   args = Vector.new1 x}}
+          | ReceiveExp f => f (Exp.Var x, ty)
+          | ReceiveVar f => f (x, ty)
+          | Prefix (k, s) => Res.prefix (sendVar (k, ty, x), s)
+          | Return => {statements = [],
+                       transfer = Transfer.Return (Vector.new1 x)}
       and sendBindExp ({arg, statements, transfer}, ty, e: Exp.t) = 
-	 {statements = Statement.T {var = SOME arg,
-				    ty = ty,
-				    exp = e} :: statements,
-	  transfer = transfer}
+         {statements = Statement.T {var = SOME arg,
+                                    ty = ty,
+                                    exp = e} :: statements,
+          transfer = transfer}
 
       val sendVar =
-	 Trace.trace3 ("Cont.sendVar", layout, Type.layout, Var.layout,
-		       Res.layout)
-	 sendVar
+         Trace.trace3 ("DirectExp2.Cont.sendVar", layout, Type.layout, Var.layout,
+                       Res.layout)
+         sendVar
 
       val sendExp: t * Type.t * Exp.t -> Res.t =
-	 fn (k, ty, e) =>
-	 case k of
-	    ReceiveExp f => f (e, ty)
-	  | _ => sendBindExp (toBind (k, ty), ty, e)
+         fn (k, ty, e) =>
+         case k of
+            ReceiveExp f => f (e, ty)
+          | _ => sendBindExp (toBind (k, ty), ty, e)
 
       val sendExp =
-	 Trace.trace3 ("Cont.sendExp", layout, Type.layout, Exp.layout,
-		       Res.layout)
-	 sendExp
+         Trace.trace3 ("DirectExp2.Cont.sendExp", layout, Type.layout, Exp.layout,
+                       Res.layout)
+         sendExp
 
       fun toBlock (k: t, ty: Type.t): Block.t =
-	 let
-	    val {arg, statements, transfer} = toBind (k, ty)
-	    val label = Label.newNoname ()
-	 in
-	    Block.T {label = label,
-		     args = Vector.new1 (arg, ty),
-		     statements = Vector.fromList statements,
-		     transfer = transfer}
-	 end
+         let
+            val {arg, statements, transfer} = toBind (k, ty)
+            val label = Label.newNoname ()
+         in
+            Block.T {label = label,
+                     args = Vector.new1 (arg, ty),
+                     statements = Vector.fromList statements,
+                     transfer = transfer}
+         end
 
       val toBlock =
-	 Trace.trace2 ("Cont.toBlock", layout, Type.layout, Block.layout)
-	 toBlock
+         Trace.trace2 ("DirectExp2.Cont.toBlock", layout, Type.layout, Block.layout)
+         toBlock
    end
 
 fun selects (tuple: Var.t, ty: Type.t, components: Var.t vector)
@@ -339,251 +339,251 @@
       Vector.foldi
       (ts, [], fn (i, t, ss) =>
        Statement.T {var = SOME (Vector.sub (components, i)),
-		    ty = t,
-		    exp = Exp.Select {tuple = tuple,
-				      offset = i}}
+                    ty = t,
+                    exp = Exp.Select {tuple = tuple,
+                                      offset = i}}
        :: ss)
    end
 
 fun linearize' (e: t, h: Handler.t, k: Cont.t): Label.t * Block.t list =
    let
       val traceLinearizeLoop =
-	 Trace.trace3 ("Linearize.loop", layout, Handler.layout, Cont.layout,
-		       Res.layout)
+         Trace.trace3 ("DirectExp.linearize'.loop", layout, Handler.layout, Cont.layout,
+                       Res.layout)
       val blocks: Block.t list ref = ref []
       fun newBlock (args: (Var.t * Type.t) vector,
-		    {statements: Statement.t list,
-		     transfer: Transfer.t}): Label.t =
-	 let 
-	    val label = Label.newNoname ()
-	    val _ = List.push (blocks,
-			       Block.T {label = label,
-					args = args,
-					statements = Vector.fromList statements,
-					transfer = transfer})
-	 in
-	    label
-	 end
+                    {statements: Statement.t list,
+                     transfer: Transfer.t}): Label.t =
+         let 
+            val label = Label.newNoname ()
+            val _ = List.push (blocks,
+                               Block.T {label = label,
+                                        args = args,
+                                        statements = Vector.fromList statements,
+                                        transfer = transfer})
+         in
+            label
+         end
       fun reify (k: Cont.t, ty: Type.t): Label.t =
-	 let
-	    val b = Cont.toBlock (k, ty)
-	    val _ = List.push (blocks, b)
-	 in
-	    Block.label b
-	 end
+         let
+            val b = Cont.toBlock (k, ty)
+            val _ = List.push (blocks, b)
+         in
+            Block.label b
+         end
       fun newLabel (args: (Var.t * Type.t) vector,
-		    e: t,
-		    h: Handler.t,
-		    k: Cont.t): Label.t =
-	 newBlock (args, loop (e, h, k))
+                    e: t,
+                    h: Handler.t,
+                    k: Cont.t): Label.t =
+         newBlock (args, loop (e, h, k))
       and newLabel0 (e, h, k) = newLabel (Vector.new0 (), e, h, k)
       and loopf (e: t, h: Handler.t, f: Var.t * Type.t -> Res.t) =
-	 loop (e, h, Cont.receiveVar f)
+         loop (e, h, Cont.receiveVar f)
       and loop arg : Res.t =
-	 traceLinearizeLoop
-	 (fn (e: t, h: Handler.t, k: Cont.t) =>
-	 case e of
-	    Arith {prim, args, overflow, ty} =>
-	       loops
-	       (args, h, fn xs =>
-		let
-		   val l = reify (k, ty)
-		   val k = Cont.goto l
-		in
-		   {statements = [],
-		    transfer =
-		    Transfer.Arith {prim = prim,
-				    args = xs,
-				    overflow = newLabel0 (overflow, h, k),
-				    success = l,
-				    ty = ty}}
-		end)
-	  | Call {func, args, ty} =>
-	       loops
-	       (args, h, fn xs =>
-		{statements = [],
-		 transfer = (Transfer.Call
-			     {func = func,
-			      args = xs,
-			      return = Return.NonTail {cont = reify (k, ty),
-						       handler = h}})})
-	  | Case {cases, default, test, ty} =>
-	       let
-		  val k = Cont.goto (reify (k, ty))
-	       in
-		  loopf (test, h, fn (x, _) =>
-			 {statements = [],
-			  transfer =
-			  Transfer.Case
-			  {test = x,
-			   default = Option.map (default, fn e =>
-						 newLabel0 (e, h, k)),
-			   cases =
-			   let
-			      fun doit v = 
-				 Vector.map (v, fn (c, e) =>
-					     (c, newLabel0 (e, h, k)))
-			   in
-			      case cases of
-				 Con v =>
-				    Cases.Con
-				    (Vector.map
-				     (v, fn {con, args, body} =>
-				      (con,
-				       newLabel (args, body, h, k))))
-			       | Word (s, v) => Cases.Word (s, doit v)
-			   end}})
-	       end
-	  | ConApp {con, args, ty} =>
-	       loops (args, h, fn xs =>
-		      Cont.sendExp (k, ty, Exp.ConApp {con = con, args = xs}))
-	  | Const c => Cont.sendExp (k, Type.ofConst c, Exp.Const c)
-	  | Detuple {tuple, length, body} =>
-	       loop (tuple, h,
-		     Cont.receiveExp
-		     (fn (e, ty) =>
-		      let
-			 fun doit (tuple: Var.t): Res.t =
-			    let
-			       val (ss, xs) = 
-				  case length of
-				     0 => ([], Vector.new0 ())
-				   | 1 => ([], Vector.new1 tuple)
-				   | _ =>
-					let
-					   val xs = 
-					      Vector.tabulate
-					      (length, fn _ => Var.newNoname ())
-					in (selects (tuple, ty, xs), xs)
-					end
-			       val {statements, transfer} = loop (body xs, h, k)
-			    in
-			       {statements = List.appendRev (ss, statements),
-				transfer = transfer}
-			    end
-		      in
-			 case e of
-			    Exp.Tuple xs => loop (body xs, h, k)
-			  | Exp.Var x => doit x
-			  | _ => 
-			       let
-				  val tuple = Var.newNoname ()
-			       in
-				  Res.prefix (doit tuple,
-					      Statement.T {var = SOME tuple,
-							   ty = ty,
-							   exp = e})
-			       end
-		      end))
-	  | DetupleBind {body, components, tuple, tupleTy} =>
-	       let
-		  val {statements, transfer} = loop (body, h, k)
-		  val ss =
-		     case Vector.length components of
-			0 => []
-		      | 1 => [Statement.T
-			      {var = SOME (Vector.sub (components, 0)),
-			       ty = tupleTy,
-			       exp = Exp.Var tuple}]
-		      | _ => selects (tuple, tupleTy, components)
-	       in
-		  {statements = List.appendRev (ss, statements),
-		   transfer = transfer}
-	       end
-	  | Handle {try, catch, handler, ty} =>
-	       let
-		  val k = Cont.goto (reify (k, ty))
-		  val hl = Label.newNoname ()
-		  val {statements, transfer} = loop (handler, h, k)
-		  val _ =
-		     List.push (blocks,
-				Block.T {label = hl,
-					 args = Vector.new1 catch,
-					 statements = Vector.fromList statements,
-					 transfer = transfer})
-	       in
-		  loop (try, Handler.Handle hl, k)
-	       end
-	  | Let {decs, body} =>
-	       let
-		  fun each decs =
-		     case decs of
-			[] => loop (body, h, k)
-		      | {var, exp} :: decs =>
-			   loop (exp, h, Cont.bind (var, each decs))
-	       in
-		  each decs
-	       end
-	  | Name (e, f) => loopf (e, h, fn (x, _) => loop (f x, h, k))
-	  | PrimApp {prim, targs, args, ty} =>
-	       loops
-	       (args, h, fn xs =>
-		Cont.sendExp (k, ty, Exp.PrimApp {prim = prim,
-						  targs = targs,
-						  args = xs}))
-	  | Profile e => Cont.sendExp (k, Type.unit, Exp.Profile e)
-	  | Raise e =>
-	       loopf (e, h, fn (x, _) =>
-		      {statements = [],
-		       transfer =
-		       (case h of
-			   Handler.Caller => Transfer.Raise (Vector.new1 x)
-			 | Handler.Dead => Error.bug "raise to dead handler"
-			 | Handler.Handle l =>
-			      Transfer.Goto {args = Vector.new1 x,
-					     dst = l})})
-	  | Runtime {args, prim, ty} =>
-	       loops
-	       (args, h, fn xs =>
-		let
-		   val l = reify (k, ty)
-		   val k = Cont.goto l
-		   val (args, exps) =
-		      case Type.deTupleOpt ty of
-			 NONE =>
-			    let
-			       val res = Var.newNoname ()
-			    in
-			       (Vector.new1 (res, ty),
-				Vector.new1 (Var (res, ty)))
-			    end
-		       | SOME ts =>
-			    if 0 = Vector.length ts
-			       then (Vector.new0 (), Vector.new0 ())
-			    else
-			       Error.bug
-			       (concat ["prim with multiple return values: ",
-					Prim.toString prim])
-		in
-		   {statements = [],
-		    transfer =
-		    Transfer.Runtime
-		    {prim = prim,
-		     args = xs,
-		     return = newLabel (args,
-					tuple {exps = exps,
-					       ty = ty},
-					h, k)}}
-		end)
-	  | Select {tuple, offset, ty} =>
-	       loopf (tuple, h, fn (tuple, _) =>
-		      Cont.sendExp (k, ty, Exp.Select {tuple = tuple,
-						       offset = offset}))
-	  | Seq (e1, e2) => loopf (e1, h, fn _ => loop (e2, h, k))
-	  | Tuple {exps, ty} =>
-	       loops (exps, h, fn xs => Cont.sendExp (k, ty, Exp.Tuple xs))
-	  | Var (x, ty) => Cont.sendVar (k, ty, x)) arg
+         traceLinearizeLoop
+         (fn (e: t, h: Handler.t, k: Cont.t) =>
+         case e of
+            Arith {prim, args, overflow, ty} =>
+               loops
+               (args, h, fn xs =>
+                let
+                   val l = reify (k, ty)
+                   val k = Cont.goto l
+                in
+                   {statements = [],
+                    transfer =
+                    Transfer.Arith {prim = prim,
+                                    args = xs,
+                                    overflow = newLabel0 (overflow, h, k),
+                                    success = l,
+                                    ty = ty}}
+                end)
+          | Call {func, args, ty} =>
+               loops
+               (args, h, fn xs =>
+                {statements = [],
+                 transfer = (Transfer.Call
+                             {func = func,
+                              args = xs,
+                              return = Return.NonTail {cont = reify (k, ty),
+                                                       handler = h}})})
+          | Case {cases, default, test, ty} =>
+               let
+                  val k = Cont.goto (reify (k, ty))
+               in
+                  loopf (test, h, fn (x, _) =>
+                         {statements = [],
+                          transfer =
+                          Transfer.Case
+                          {test = x,
+                           default = Option.map (default, fn e =>
+                                                 newLabel0 (e, h, k)),
+                           cases =
+                           let
+                              fun doit v = 
+                                 Vector.map (v, fn (c, e) =>
+                                             (c, newLabel0 (e, h, k)))
+                           in
+                              case cases of
+                                 Con v =>
+                                    Cases.Con
+                                    (Vector.map
+                                     (v, fn {con, args, body} =>
+                                      (con,
+                                       newLabel (args, body, h, k))))
+                               | Word (s, v) => Cases.Word (s, doit v)
+                           end}})
+               end
+          | ConApp {con, args, ty} =>
+               loops (args, h, fn xs =>
+                      Cont.sendExp (k, ty, Exp.ConApp {con = con, args = xs}))
+          | Const c => Cont.sendExp (k, Type.ofConst c, Exp.Const c)
+          | Detuple {tuple, length, body} =>
+               loop (tuple, h,
+                     Cont.receiveExp
+                     (fn (e, ty) =>
+                      let
+                         fun doit (tuple: Var.t): Res.t =
+                            let
+                               val (ss, xs) = 
+                                  case length of
+                                     0 => ([], Vector.new0 ())
+                                   | 1 => ([], Vector.new1 tuple)
+                                   | _ =>
+                                        let
+                                           val xs = 
+                                              Vector.tabulate
+                                              (length, fn _ => Var.newNoname ())
+                                        in (selects (tuple, ty, xs), xs)
+                                        end
+                               val {statements, transfer} = loop (body xs, h, k)
+                            in
+                               {statements = List.appendRev (ss, statements),
+                                transfer = transfer}
+                            end
+                      in
+                         case e of
+                            Exp.Tuple xs => loop (body xs, h, k)
+                          | Exp.Var x => doit x
+                          | _ => 
+                               let
+                                  val tuple = Var.newNoname ()
+                               in
+                                  Res.prefix (doit tuple,
+                                              Statement.T {var = SOME tuple,
+                                                           ty = ty,
+                                                           exp = e})
+                               end
+                      end))
+          | DetupleBind {body, components, tuple, tupleTy} =>
+               let
+                  val {statements, transfer} = loop (body, h, k)
+                  val ss =
+                     case Vector.length components of
+                        0 => []
+                      | 1 => [Statement.T
+                              {var = SOME (Vector.sub (components, 0)),
+                               ty = tupleTy,
+                               exp = Exp.Var tuple}]
+                      | _ => selects (tuple, tupleTy, components)
+               in
+                  {statements = List.appendRev (ss, statements),
+                   transfer = transfer}
+               end
+          | Handle {try, catch, handler, ty} =>
+               let
+                  val k = Cont.goto (reify (k, ty))
+                  val hl = Label.newNoname ()
+                  val {statements, transfer} = loop (handler, h, k)
+                  val _ =
+                     List.push (blocks,
+                                Block.T {label = hl,
+                                         args = Vector.new1 catch,
+                                         statements = Vector.fromList statements,
+                                         transfer = transfer})
+               in
+                  loop (try, Handler.Handle hl, k)
+               end
+          | Let {decs, body} =>
+               let
+                  fun each decs =
+                     case decs of
+                        [] => loop (body, h, k)
+                      | {var, exp} :: decs =>
+                           loop (exp, h, Cont.bind (var, each decs))
+               in
+                  each decs
+               end
+          | Name (e, f) => loopf (e, h, fn (x, _) => loop (f x, h, k))
+          | PrimApp {prim, targs, args, ty} =>
+               loops
+               (args, h, fn xs =>
+                Cont.sendExp (k, ty, Exp.PrimApp {prim = prim,
+                                                  targs = targs,
+                                                  args = xs}))
+          | Profile e => Cont.sendExp (k, Type.unit, Exp.Profile e)
+          | Raise e =>
+               loopf (e, h, fn (x, _) =>
+                      {statements = [],
+                       transfer =
+                       (case h of
+                           Handler.Caller => Transfer.Raise (Vector.new1 x)
+                         | Handler.Dead => Error.bug "DirectExp2.linearize'.loop:  Raise:to dead handler"
+                         | Handler.Handle l =>
+                              Transfer.Goto {args = Vector.new1 x,
+                                             dst = l})})
+          | Runtime {args, prim, ty} =>
+               loops
+               (args, h, fn xs =>
+                let
+                   val l = reify (k, ty)
+                   val k = Cont.goto l
+                   val (args, exps) =
+                      case Type.deTupleOpt ty of
+                         NONE =>
+                            let
+                               val res = Var.newNoname ()
+                            in
+                               (Vector.new1 (res, ty),
+                                Vector.new1 (Var (res, ty)))
+                            end
+                       | SOME ts =>
+                            if 0 = Vector.length ts
+                               then (Vector.new0 (), Vector.new0 ())
+                            else
+                               Error.bug
+                               (concat ["DirectExp2.linearlize'.loop: Runtime:with multiple return values: ",
+                                        Prim.toString prim])
+                in
+                   {statements = [],
+                    transfer =
+                    Transfer.Runtime
+                    {prim = prim,
+                     args = xs,
+                     return = newLabel (args,
+                                        tuple {exps = exps,
+                                               ty = ty},
+                                        h, k)}}
+                end)
+          | Select {tuple, offset, ty} =>
+               loopf (tuple, h, fn (tuple, _) =>
+                      Cont.sendExp (k, ty, Exp.Select {tuple = tuple,
+                                                       offset = offset}))
+          | Seq (e1, e2) => loopf (e1, h, fn _ => loop (e2, h, k))
+          | Tuple {exps, ty} =>
+               loops (exps, h, fn xs => Cont.sendExp (k, ty, Exp.Tuple xs))
+          | Var (x, ty) => Cont.sendVar (k, ty, x)) arg
       and loops (es: t vector, h: Handler.t, k: Var.t vector -> Res.t): Res.t =
-	 let
-	    val n = Vector.length es
-	    fun each (i, ac) =
-	       if i = n
-		  then k (Vector.fromListRev ac)
-	       else loopf (Vector.sub (es, i), h, fn (x, _) =>
-			   each (i + 1, x :: ac))
-	 in
-	    each (0, [])
-	 end
+         let
+            val n = Vector.length es
+            fun each (i, ac) =
+               if i = n
+                  then k (Vector.fromListRev ac)
+               else loopf (Vector.sub (es, i), h, fn (x, _) =>
+                           each (i + 1, x :: ac))
+         in
+            each (0, [])
+         end
       val l = newLabel0 (e, h, k)
    in
       (l, !blocks)
@@ -592,9 +592,9 @@
 fun linearize (e: t, h) = linearize' (e, h, Cont.return)
 
 val linearize =
-   Trace.trace2 ("Linearize.linearize", layout, Handler.layout,
-		Layout.tuple2 (Label.layout,
-			       List.layout (Label.layout o Block.label)))
+   Trace.trace2 ("DirectExp2.linearize", layout, Handler.layout,
+                Layout.tuple2 (Label.layout,
+                               List.layout (Label.layout o Block.label)))
    linearize
 
 fun linearizeGoto (e: t, h, l) = linearize' (e, h, Cont.goto l)

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ssa/direct-exp2.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ssa/direct-exp2.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ssa/direct-exp2.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 type int = Int.t
 
 signature DIRECT_EXP2_STRUCTS =
@@ -17,65 +18,65 @@
      include DIRECT_EXP2_STRUCTS
 
      structure DirectExp:
-	sig
-	   type t
+        sig
+           type t
 
-	   datatype cases =
-	      Con of {con: Con.t,
-		      args: (Var.t * Type.t) vector,
-		      body: t} vector
-	    | Word of WordSize.t * (WordX.t * t) vector
+           datatype cases =
+              Con of {con: Con.t,
+                      args: (Var.t * Type.t) vector,
+                      body: t} vector
+            | Word of WordSize.t * (WordX.t * t) vector
 
-	   val arith: {prim: Type.t Prim.t,
-		       args: t vector,
-		       overflow: t,
-		       ty: Type.t} -> t
-	   (* For now, call always uses Handler.None.  This means it should only
-	    * be used for functions that cannot raise.
-	    *)
-	   val call: {func: Func.t, args: t vector, ty: Type.t} -> t
-	   val casee: {test: t, 
-		       cases: cases,
-		       default: t option,
-		       ty: Type.t} -> t
-	   val conApp: {con: Con.t, 
-			args: t vector,
-			ty: Type.t} -> t
-	   val const: Const.t -> t
-	   val detuple: {body: Var.t vector -> t,
-			 length: int,
-			 tuple: t} -> t
-	   val detupleBind: {body: t,
-			     components: Var.t vector,
-			     tuple: Var.t,
-			     tupleTy: Type.t} -> t
-	   val eq: t * t * Type.t -> t
-	   val falsee: t
-	   val handlee: {try: t,
-			 ty: Type.t,
-			 catch: Var.t * Type.t,
-			 handler: t} -> t
-	   val layout: t -> Layout.t
-	   val lett: {decs: {var: Var.t, exp: t} list,
-		      body: t} -> t
-	   val linearize:
-	      t * Return.Handler.t -> Label.t * Block.t list
-	   val linearizeGoto:
-	      t * Return.Handler.t * Label.t -> Label.t * Block.t list
-	   val name: t * (Var.t -> t) -> t
-	   val primApp: {args: t vector,
-			 prim: Type.t Prim.t,
-			 targs: Type.t vector, 
-			 ty: Type.t} -> t
-	   val profile: ProfileExp.t -> t
-	   val raisee: t -> t
-	   val select: {tuple: t, 
-			offset: int, 
-			ty: Type.t} -> t
-	   val seq: t * t -> t
-	   val truee: t
-	   val tuple: {exps: t vector, ty: Type.t} -> t
-	   val var: Var.t * Type.t -> t
-	   val word: WordX.t -> t
-	end
+           val arith: {prim: Type.t Prim.t,
+                       args: t vector,
+                       overflow: t,
+                       ty: Type.t} -> t
+           (* For now, call always uses Handler.None.  This means it should only
+            * be used for functions that cannot raise.
+            *)
+           val call: {func: Func.t, args: t vector, ty: Type.t} -> t
+           val casee: {test: t, 
+                       cases: cases,
+                       default: t option,
+                       ty: Type.t} -> t
+           val conApp: {con: Con.t, 
+                        args: t vector,
+                        ty: Type.t} -> t
+           val const: Const.t -> t
+           val detuple: {body: Var.t vector -> t,
+                         length: int,
+                         tuple: t} -> t
+           val detupleBind: {body: t,
+                             components: Var.t vector,
+                             tuple: Var.t,
+                             tupleTy: Type.t} -> t
+           val eq: t * t * Type.t -> t
+           val falsee: t
+           val handlee: {try: t,
+                         ty: Type.t,
+                         catch: Var.t * Type.t,
+                         handler: t} -> t
+           val layout: t -> Layout.t
+           val lett: {decs: {var: Var.t, exp: t} list,
+                      body: t} -> t
+           val linearize:
+              t * Return.Handler.t -> Label.t * Block.t list
+           val linearizeGoto:
+              t * Return.Handler.t * Label.t -> Label.t * Block.t list
+           val name: t * (Var.t -> t) -> t
+           val primApp: {args: t vector,
+                         prim: Type.t Prim.t,
+                         targs: Type.t vector, 
+                         ty: Type.t} -> t
+           val profile: ProfileExp.t -> t
+           val raisee: t -> t
+           val select: {tuple: t, 
+                        offset: int, 
+                        ty: Type.t} -> t
+           val seq: t * t -> t
+           val truee: t
+           val tuple: {exps: t vector, ty: Type.t} -> t
+           val var: Var.t * Type.t -> t
+           val word: WordX.t -> t
+        end
   end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ssa/equatable.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ssa/equatable.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ssa/equatable.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,8 +1,8 @@
-(* Copyright (C) 2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 2004-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 (*

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ssa/equatable.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ssa/equatable.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ssa/equatable.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,21 +1,19 @@
-(* Copyright (C) 2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 2004-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 structure Equatable: EQUATABLE =
 struct
 
-type int = Int.t
-   
 structure Set = DisjointSet
 
 datatype 'a delay =
    Computed of 'a
  | Uncomputed of {compute: unit -> 'a,
-		  whenComputed: ('a -> unit) AppendList.t ref}
+                  whenComputed: ('a -> unit) AppendList.t ref}
 
 datatype 'a t = T of 'a delay Set.t
 
@@ -26,8 +24,8 @@
 
 fun delay f =
    T (Set.singleton (Uncomputed {compute = f,
-				 whenComputed = ref AppendList.empty}))
-					    
+                                 whenComputed = ref AppendList.empty}))
+                                            
 fun new a = T (Set.singleton (Computed a))
 
 fun equals (T s, T s') = Set.equals (s, s')
@@ -36,48 +34,45 @@
    case Set.! s of
       Computed a => a
     | Uncomputed {compute, whenComputed} =>
-	 let
-	    val a = compute ()
-	    val () = Set.:= (s, Computed a)
-	    val () = AppendList.foreach (!whenComputed, fn f => f a)
-	 in
-	    a
-	 end
-	    
+         let
+            val a = compute ()
+            val () = Set.:= (s, Computed a)
+            val () = AppendList.foreach (!whenComputed, fn f => f a)
+         in
+            a
+         end
+            
 fun equate (T s, T s', combine) =
    if Set.equals (s, s')
       then ()
    else
       let
-	 val d = Set.! s
-	 val d' = Set.! s'
-	 val () = Set.union (s, s')
-	 fun one (a, {compute = _, whenComputed}) =
-	    (* Must set the value before calling the whenComputed, because
-	     * those may look at the value (which would cause it to be set,
-	     * which would then be overwritten).
-	     *)
-	    (Set.:= (s, Computed a)
-	     ; AppendList.foreach (!whenComputed, fn f => f a))
+         val d = Set.! s
+         val d' = Set.! s'
+         val () = Set.union (s, s')
+         fun one (a, {compute = _, whenComputed}) =
+            (* Must set the value before calling the whenComputed, because
+             * those may look at the value (which would cause it to be set,
+             * which would then be overwritten).
+             *)
+            (Set.:= (s, Computed a)
+             ; AppendList.foreach (!whenComputed, fn f => f a))
       in
-	 case (d, d') of
-	    (Computed a, Computed a') =>
-	       Set.:= (s, Computed (combine (a, a')))
-	  | (Computed a, Uncomputed u) => one (a, u)
-	  | (Uncomputed u, Computed a) => one (a, u)
-	  | (Uncomputed {compute, whenComputed = w},
-	     Uncomputed {whenComputed = w', ...}) =>
-	       Set.:=
-	       (s, Uncomputed {compute = compute,
-			       whenComputed = ref (AppendList.append (!w, !w'))})
+         case (d, d') of
+            (Computed a, Computed a') =>
+               Set.:= (s, Computed (combine (a, a')))
+          | (Computed a, Uncomputed u) => one (a, u)
+          | (Uncomputed u, Computed a) => one (a, u)
+          | (Uncomputed {compute, whenComputed = w},
+             Uncomputed {whenComputed = w', ...}) =>
+               Set.:=
+               (s, Uncomputed {compute = compute,
+                               whenComputed = ref (AppendList.append (!w, !w'))})
       end
 
-fun whenComputed (e as T s, f): unit =
-   (if !Control.deepFlattenDelay
-      then (case Set.! s of
-	       Computed a => f a
-	     | Uncomputed {whenComputed = w, ...} =>
-		  AppendList.push (w, f))
-   else f (value e))
+fun whenComputed (T s, f): unit =
+   case Set.! s of
+      Computed a => f a
+    | Uncomputed {whenComputed = w, ...} => AppendList.push (w, f)
 
 end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ssa/flat-lattice.fun
===================================================================
(Binary files differ)

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ssa/flat-lattice.sig
===================================================================
(Binary files differ)

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ssa/flatten.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ssa/flatten.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ssa/flatten.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 (*
  * Flatten arguments to jumps, constructors, and functions.
  * If a tuple is explicitly available at all uses of a jump (resp. function)
@@ -28,427 +29,425 @@
 structure Rep =
    struct
       structure L = TwoPointLattice (val bottom = "flatten"
-				     val top = "don't flatten")
+                                     val top = "don't flatten")
 
       open L
 
       val isFlat = not o isTop
 
       fun fromType t =
-	 case Type.deTupleOpt t of
-	    NONE => let val r = new () in makeTop r; r end
-	  | SOME _ => new ()
+         case Type.deTupleOpt t of
+            NONE => let val r = new () in makeTop r; r end
+          | SOME _ => new ()
 
       fun fromTypes (ts: Type.t vector): t vector =
-	 Vector.map (ts, fromType)
+         Vector.map (ts, fromType)
 
       val tuplize: t -> unit = makeTop
-	
+        
       val coerce = op <=
 
       fun coerces (rs, rs') = Vector.foreach2 (rs, rs', coerce)
 
       val unify = op ==
-	
+        
       fun unifys (rs, rs') = Vector.foreach2 (rs, rs', unify)
    end
 
 fun flatten (Program.T {datatypes, globals, functions, main}) =
    let
       val {get = conInfo: Con.t -> {argsTypes: Type.t vector,
-				    args: Rep.t vector},
-	   set = setConInfo, ...} =
-	 Property.getSetOnce
-	 (Con.plist, Property.initRaise ("Flatten.conInfo", Con.layout))
+                                    args: Rep.t vector},
+           set = setConInfo, ...} =
+         Property.getSetOnce
+         (Con.plist, Property.initRaise ("Flatten.conInfo", Con.layout))
       val conArgs = #args o conInfo
       val {get = funcInfo: Func.t -> {args: Rep.t vector,
-				      returns: Rep.t vector option,
-				      raises: Rep.t vector option},
-	   set = setFuncInfo, ...} =
-	 Property.getSetOnce
-	 (Func.plist, Property.initRaise ("Flatten.funcInfo", Func.layout))
+                                      returns: Rep.t vector option,
+                                      raises: Rep.t vector option},
+           set = setFuncInfo, ...} =
+         Property.getSetOnce
+         (Func.plist, Property.initRaise ("Flatten.funcInfo", Func.layout))
       val funcArgs = #args o funcInfo
       val {get = labelInfo: Label.t -> {args: Rep.t vector},
-	   set = setLabelInfo, ...} =
-	 Property.getSetOnce
-	 (Label.plist, Property.initRaise ("Flatten.labelInfo", Label.layout))
+           set = setLabelInfo, ...} =
+         Property.getSetOnce
+         (Label.plist, Property.initRaise ("Flatten.labelInfo", Label.layout))
       val labelArgs = #args o labelInfo
       val {get = varInfo: Var.t -> {rep: Rep.t, 
-				    tuple: Var.t vector option ref},
-	   set = setVarInfo, ...} =
-	 Property.getSetOnce
-	 (Var.plist, Property.initFun 
-	             (fn _ => {rep = let val r = Rep.new ()
-				     in Rep.tuplize r; r 
-				     end,
-			       tuple = ref NONE}))
+                                    tuple: Var.t vector option ref},
+           set = setVarInfo, ...} =
+         Property.getSetOnce
+         (Var.plist, Property.initFun 
+                     (fn _ => {rep = let val r = Rep.new ()
+                                     in Rep.tuplize r; r 
+                                     end,
+                               tuple = ref NONE}))
       val fromFormal = fn (x, ty) => let val r = Rep.fromType ty
-				     in
-				       setVarInfo (x, {rep = r,
-						       tuple = ref NONE})
-				       ; r
-				     end
+                                     in
+                                       setVarInfo (x, {rep = r,
+                                                       tuple = ref NONE})
+                                       ; r
+                                     end
       val fromFormals = fn xtys => Vector.map (xtys, fromFormal)
       val varRep = #rep o varInfo
       val varTuple = #tuple o varInfo
       fun coerce (x: Var.t, r: Rep.t) =
-	 Rep.coerce (varRep x, r)
+         Rep.coerce (varRep x, r)
       fun coerces (xs: Var.t vector, rs: Rep.t vector) =
-	 Vector.foreach2 (xs, rs, coerce)
+         Vector.foreach2 (xs, rs, coerce)
 
       val _ =
-	 Vector.foreach
-	 (datatypes, fn Datatype.T {cons, ...} =>
-	  Vector.foreach
-	  (cons, fn {con, args} =>
-	   setConInfo (con, {argsTypes = args,
-			     args = Vector.map (args, Rep.fromType)})))
+         Vector.foreach
+         (datatypes, fn Datatype.T {cons, ...} =>
+          Vector.foreach
+          (cons, fn {con, args} =>
+           setConInfo (con, {argsTypes = args,
+                             args = Vector.map (args, Rep.fromType)})))
       val _ = 
-	 List.foreach
-	 (functions, fn f =>
-	  let val {args, name, raises, returns, ...} = Function.dest f
-	  in 
-	    setFuncInfo (name, {args = fromFormals args,
-				returns = Option.map (returns, Rep.fromTypes),
-				raises = Option.map (raises, Rep.fromTypes)})
-	  end)
+         List.foreach
+         (functions, fn f =>
+          let val {args, name, raises, returns, ...} = Function.dest f
+          in 
+            setFuncInfo (name, {args = fromFormals args,
+                                returns = Option.map (returns, Rep.fromTypes),
+                                raises = Option.map (raises, Rep.fromTypes)})
+          end)
 
       fun doitStatement (Statement.T {exp, var, ...}) =
-	 case exp of
-	    Tuple xs =>
-	       Option.app
-	       (var, fn var =>
-		setVarInfo (var, {rep = Rep.new (),
-				  tuple = ref (SOME xs)}))
-	  | ConApp {con, args} => coerces (args, conArgs con)
-	  | Var x => setVarInfo (valOf var, varInfo x)
-	  | _ => ()
+         case exp of
+            Tuple xs =>
+               Option.app
+               (var, fn var =>
+                setVarInfo (var, {rep = Rep.new (),
+                                  tuple = ref (SOME xs)}))
+          | ConApp {con, args} => coerces (args, conArgs con)
+          | Var x => setVarInfo (valOf var, varInfo x)
+          | _ => ()
       val _ = Vector.foreach (globals, doitStatement)
       val _ =
-	 List.foreach
-	 (functions, fn f =>
-	  let
-	     val {blocks, name, ...} = Function.dest f
-	     val {raises, returns, ...} = funcInfo name
-	  in
-	     Vector.foreach
-	     (blocks, fn Block.T {label, args, statements, ...} =>
-	      (setLabelInfo (label, {args = fromFormals args})
-	       ; Vector.foreach (statements, doitStatement)))
-	     ; Vector.foreach
-	       (blocks, fn Block.T {transfer, ...} =>
-		case transfer of
-		   Return xs =>
-		      (case returns of
-			  NONE => Error.bug "return mismatch"
-			| SOME rs => coerces (xs, rs))
-		 | Raise xs =>
-		      (case raises of
-			  NONE => Error.bug "raise mismatch"
-			| SOME rs => coerces (xs, rs))
-		 | Call {func, args, return} =>
-		      let
-			val {args = funcArgs, 
-			     returns = funcReturns,
-			     raises = funcRaises} =
-			  funcInfo func
-			val _ = coerces (args, funcArgs)
-			fun unifyReturns () =
-			   case (funcReturns, returns) of
-			      (SOME rs, SOME rs') => Rep.unifys (rs, rs')
-			    | _ => ()		
-			fun unifyRaises () =
-			   case (funcRaises, raises) of
-			      (SOME rs, SOME rs') => Rep.unifys (rs, rs')
-			    | _ => ()
-		      in
-			case return of
-			   Return.Dead => ()
-			 | Return.NonTail {cont, handler} =>
-			      (Option.app 
-			       (funcReturns, fn rs =>
-				Rep.unifys (rs, labelArgs cont))
-			       ; case handler of
-			            Handler.Caller => unifyRaises ()
-				  | Handler.Dead => ()
-				  | Handler.Handle handler =>
-				       Option.app
-				       (funcRaises, fn rs =>
-					Rep.unifys (rs, labelArgs handler)))
-			 | Return.Tail => (unifyReturns (); unifyRaises ())
-		      end
-		 | Goto {dst, args} => coerces (args, labelArgs dst)
-		 | Case {cases = Cases.Con cases, ...} =>
-		      Vector.foreach
-		      (cases, fn (con, label) =>
-		       Rep.coerces (conArgs con, labelArgs label))
-		 | _ => ())
-	  end)
+         List.foreach
+         (functions, fn f =>
+          let
+             val {blocks, name, ...} = Function.dest f
+             val {raises, returns, ...} = funcInfo name
+          in
+             Vector.foreach
+             (blocks, fn Block.T {label, args, statements, ...} =>
+              (setLabelInfo (label, {args = fromFormals args})
+               ; Vector.foreach (statements, doitStatement)))
+             ; Vector.foreach
+               (blocks, fn Block.T {transfer, ...} =>
+                case transfer of
+                   Return xs =>
+                      (case returns of
+                          NONE => Error.bug "Flatten.flatten: return mismatch"
+                        | SOME rs => coerces (xs, rs))
+                 | Raise xs =>
+                      (case raises of
+                          NONE => Error.bug "Flatten.flatten: raise mismatch"
+                        | SOME rs => coerces (xs, rs))
+                 | Call {func, args, return} =>
+                      let
+                        val {args = funcArgs, 
+                             returns = funcReturns,
+                             raises = funcRaises} =
+                          funcInfo func
+                        val _ = coerces (args, funcArgs)
+                        fun unifyReturns () =
+                           case (funcReturns, returns) of
+                              (SOME rs, SOME rs') => Rep.unifys (rs, rs')
+                            | _ => ()           
+                        fun unifyRaises () =
+                           case (funcRaises, raises) of
+                              (SOME rs, SOME rs') => Rep.unifys (rs, rs')
+                            | _ => ()
+                      in
+                        case return of
+                           Return.Dead => ()
+                         | Return.NonTail {cont, handler} =>
+                              (Option.app 
+                               (funcReturns, fn rs =>
+                                Rep.unifys (rs, labelArgs cont))
+                               ; case handler of
+                                    Handler.Caller => unifyRaises ()
+                                  | Handler.Dead => ()
+                                  | Handler.Handle handler =>
+                                       Option.app
+                                       (funcRaises, fn rs =>
+                                        Rep.unifys (rs, labelArgs handler)))
+                         | Return.Tail => (unifyReturns (); unifyRaises ())
+                      end
+                 | Goto {dst, args} => coerces (args, labelArgs dst)
+                 | Case {cases = Cases.Con cases, ...} =>
+                      Vector.foreach
+                      (cases, fn (con, label) =>
+                       Rep.coerces (conArgs con, labelArgs label))
+                 | _ => ())
+          end)
       val _ =
-	 Control.diagnostics
-	 (fn display =>
-	  List.foreach
-	  (functions, fn f => 
-	   let 
-	      val name = Function.name f
-	      val {args, raises, returns} = funcInfo name
-	      open Layout
-	   in 
-	      display
-	      (seq [Func.layout name,
-		    str " ",
-		    record
-		    [("args", Vector.layout Rep.layout args),
-		     ("returns", Option.layout (Vector.layout Rep.layout) returns),
-		     ("raises", Option.layout (Vector.layout Rep.layout) raises)]])
-	   end))
+         Control.diagnostics
+         (fn display =>
+          List.foreach
+          (functions, fn f => 
+           let 
+              val name = Function.name f
+              val {args, raises, returns} = funcInfo name
+              open Layout
+           in 
+              display
+              (seq [Func.layout name,
+                    str " ",
+                    record
+                    [("args", Vector.layout Rep.layout args),
+                     ("returns", Option.layout (Vector.layout Rep.layout) returns),
+                     ("raises", Option.layout (Vector.layout Rep.layout) raises)]])
+           end))
       fun flattenTypes (ts: Type.t vector, rs: Rep.t vector): Type.t vector =
-	 Vector.fromList
-	 (Vector.fold2 (ts, rs, [], fn (t, r, ts) =>
-			if Rep.isFlat r
-			   then Vector.fold (Type.deTuple t, ts, op ::)
-			else t :: ts))
+         Vector.fromList
+         (Vector.fold2 (ts, rs, [], fn (t, r, ts) =>
+                        if Rep.isFlat r
+                           then Vector.fold (Type.deTuple t, ts, op ::)
+                        else t :: ts))
       val datatypes =
-	 Vector.map
-	 (datatypes, fn Datatype.T {tycon, cons} =>
-	  Datatype.T {tycon = tycon,
-		      cons = (Vector.map
-			      (cons, fn {con, args} =>
-			       {con = con,
-				args = flattenTypes (args, conArgs con)}))})
+         Vector.map
+         (datatypes, fn Datatype.T {tycon, cons} =>
+          Datatype.T {tycon = tycon,
+                      cons = (Vector.map
+                              (cons, fn {con, args} =>
+                               {con = con,
+                                args = flattenTypes (args, conArgs con)}))})
       fun flattens (xs as xsX: Var.t vector, rs: Rep.t vector) =
-	 Vector.fromList
-	 (Vector.fold2 (xs, rs, [],
-			fn (x, r, xs) =>
-			if Rep.isFlat r
-			   then (case !(varTuple x) of
-				    SOME ys => Vector.fold (ys, xs, op ::)
-				  | _ => (Error.bug 
-					  (concat
-					   ["tuple unavailable: ",
-					    (Var.toString x), " ",
-					    (Layout.toString
-					     (Vector.layout Var.layout xsX))])))
-(*				  | _ => []) *)
-(*			          | _ => Error.bug "tuple unavailable") *)
-			else x :: xs))
+         Vector.fromList
+         (Vector.fold2 (xs, rs, [],
+                        fn (x, r, xs) =>
+                        if Rep.isFlat r
+                           then (case !(varTuple x) of
+                                    SOME ys => Vector.fold (ys, xs, op ::)
+                                  | _ => (Error.bug 
+                                          (concat
+                                           ["Flatten.flattens: tuple unavailable: ",
+                                            (Var.toString x), " ",
+                                            (Layout.toString
+                                             (Vector.layout Var.layout xsX))])))
+                        else x :: xs))
       fun doitStatement (stmt as Statement.T {var, ty, exp}) =
-	 case exp of
-	    ConApp {con, args} =>
-	       Statement.T {var = var,
-			    ty = ty,
-			    exp = ConApp {con = con,
-					  args = flattens (args, conArgs con)}}
-	  | _ => stmt
+         case exp of
+            ConApp {con, args} =>
+               Statement.T {var = var,
+                            ty = ty,
+                            exp = ConApp {con = con,
+                                          args = flattens (args, conArgs con)}}
+          | _ => stmt
       val globals = Vector.map (globals, doitStatement)
       fun doitFunction f =
-	 let
-	    val {args, mayInline, name, raises, returns, start, ...} =
-	       Function.dest f
-	    val {args = argsReps, returns = returnsReps, raises = raisesReps} = 
-	      funcInfo name
+         let
+            val {args, mayInline, name, raises, returns, start, ...} =
+               Function.dest f
+            val {args = argsReps, returns = returnsReps, raises = raisesReps} = 
+              funcInfo name
 
-	    val newBlocks = ref []
+            val newBlocks = ref []
 
-	    fun doitArgs (args, reps) =
-	       let
-		  val (args, stmts) =
-		     Vector.fold2
-		     (args, reps, ([], []), fn ((x, ty), r, (args, stmts)) =>
-		      if Rep.isFlat r
-			 then let
-			         val tys = Type.deTuple ty
-				 val xs = Vector.map (tys, fn _ => Var.newNoname ())
-				 val _ = varTuple x := SOME xs
-				 val args =
-				    Vector.fold2
-				    (xs, tys, args, fn (x, ty, args) =>
-				     (x, ty) :: args)
-			      in 
-				 (args,
-				  Statement.T {var = SOME x,
-					       ty = ty,
-					       exp = Tuple xs}
-				  :: stmts)
-			      end
-		      else ((x, ty) :: args, stmts))
-	       in
-		 (Vector.fromList args, Vector.fromList stmts)
-	       end
+            fun doitArgs (args, reps) =
+               let
+                  val (args, stmts) =
+                     Vector.fold2
+                     (args, reps, ([], []), fn ((x, ty), r, (args, stmts)) =>
+                      if Rep.isFlat r
+                         then let
+                                 val tys = Type.deTuple ty
+                                 val xs = Vector.map (tys, fn _ => Var.newNoname ())
+                                 val _ = varTuple x := SOME xs
+                                 val args =
+                                    Vector.fold2
+                                    (xs, tys, args, fn (x, ty, args) =>
+                                     (x, ty) :: args)
+                              in 
+                                 (args,
+                                  Statement.T {var = SOME x,
+                                               ty = ty,
+                                               exp = Tuple xs}
+                                  :: stmts)
+                              end
+                      else ((x, ty) :: args, stmts))
+               in
+                 (Vector.fromList args, Vector.fromList stmts)
+               end
 
-	    fun doitCaseCon {test, cases, default} =
-	       let
-		  val cases =
-		     Vector.map
-		     (cases, fn (c, l) =>
-		      let
-			 val {args, argsTypes} = conInfo c
-			 val actualReps = labelArgs l
-		      in if Vector.forall2
-			    (args, actualReps, fn (r, r') =>
-			     Rep.isFlat r = Rep.isFlat r')
-			    then (c, l)
-			 else 
-			 (* Coerce from the constructor representation to the
-			  * formals the jump expects.
-			  *)
-			 let
-			    val l' = Label.newNoname ()
-			    (* The formals need to match the type of the con.
-			     * The actuals need to match the type of l.
-			     *)
-			    val (stmts, formals, actuals) =
-			       Vector.fold3
-			       (args, actualReps, argsTypes,
-				([], [], []),
-				fn (r, r', ty, (stmts, formals, actuals)) =>
-				if Rep.isFlat r
-				   then
-				   (* The con is flat *)
-				   let
-				      val xts =
-					 Vector.map
-					 (Type.deTuple ty, fn ty =>
-					  (Var.newNoname (), ty))
-				      val xs = Vector.map (xts, #1)
-				      val formals =
-					 Vector.fold (xts, formals, op ::)
-				      val (stmts, actuals) =
-					 if Rep.isFlat r'
-					    then (stmts,
-						  Vector.fold 
-						  (xs, actuals, op ::))
-					 else
-					 let
-					    val x = Var.newNoname ()
-					 in
-					   (Statement.T {var = SOME x,
-							 ty = ty,
-							 exp = Tuple xs}
-					    :: stmts,
-					    x :: actuals)
-					 end
-				   in (stmts, formals, actuals)
-				   end
-				else
-			        (* The con is tupled *)
-				let
-				   val tuple = Var.newNoname ()
-				   val formals = (tuple, ty) :: formals
-				   val (stmts, actuals) =
-				      if Rep.isFlat r'
-					 then
-					 let
-					    val xts =
-					       Vector.map
-					       (Type.deTuple ty, fn ty =>
-						(Var.newNoname (), ty))
-					    val xs = Vector.map (xts, #1)
-					    val actuals =
-					       Vector.fold
-					       (xs, actuals, op ::)
-					    val stmts =
-					       Vector.foldi
-					       (xts, stmts,
-						fn (i, (x, ty), stmts) =>
-						Statement.T 
-						{var = SOME x,
-						 ty = ty,
-						 exp = Select {tuple = tuple,
-							       offset = i}}
-						:: stmts)
-					 in (stmts, actuals)
-					 end
-				      else (stmts, tuple :: actuals)
-				in (stmts, formals, actuals)
-				end)
-			    val _ =
-			       List.push
-			       (newBlocks,
-				Block.T
-				{label = l',
-				 args = Vector.fromList formals,
-				 statements = Vector.fromList stmts,
-				 transfer = Goto {dst = l,
-						  args = Vector.fromList actuals}})
-			 in
-			   (c, l')
-			 end
-		      end)
-	       in Case {test = test,
-			cases = Cases.Con cases,
-			default = default}
-	       end 
-	    fun doitTransfer transfer =
-	       case transfer of
-		  Call {func, args, return} =>
-		     Call {func = func, 
-			   args = flattens (args, funcArgs func),
-			   return = return}
-		| Case {test, cases = Cases.Con cases, default} =>
-		     doitCaseCon {test = test, 
-				  cases = cases, 
-				  default = default}
-		| Goto {dst, args} =>
-		     Goto {dst = dst,
-			   args = flattens (args, labelArgs dst)}
-		| Raise xs => Raise (flattens (xs, valOf raisesReps))
-		| Return xs => Return (flattens (xs, valOf returnsReps))
-		| _ => transfer
+            fun doitCaseCon {test, cases, default} =
+               let
+                  val cases =
+                     Vector.map
+                     (cases, fn (c, l) =>
+                      let
+                         val {args, argsTypes} = conInfo c
+                         val actualReps = labelArgs l
+                      in if Vector.forall2
+                            (args, actualReps, fn (r, r') =>
+                             Rep.isFlat r = Rep.isFlat r')
+                            then (c, l)
+                         else 
+                         (* Coerce from the constructor representation to the
+                          * formals the jump expects.
+                          *)
+                         let
+                            val l' = Label.newNoname ()
+                            (* The formals need to match the type of the con.
+                             * The actuals need to match the type of l.
+                             *)
+                            val (stmts, formals, actuals) =
+                               Vector.fold3
+                               (args, actualReps, argsTypes,
+                                ([], [], []),
+                                fn (r, r', ty, (stmts, formals, actuals)) =>
+                                if Rep.isFlat r
+                                   then
+                                   (* The con is flat *)
+                                   let
+                                      val xts =
+                                         Vector.map
+                                         (Type.deTuple ty, fn ty =>
+                                          (Var.newNoname (), ty))
+                                      val xs = Vector.map (xts, #1)
+                                      val formals =
+                                         Vector.fold (xts, formals, op ::)
+                                      val (stmts, actuals) =
+                                         if Rep.isFlat r'
+                                            then (stmts,
+                                                  Vector.fold 
+                                                  (xs, actuals, op ::))
+                                         else
+                                         let
+                                            val x = Var.newNoname ()
+                                         in
+                                           (Statement.T {var = SOME x,
+                                                         ty = ty,
+                                                         exp = Tuple xs}
+                                            :: stmts,
+                                            x :: actuals)
+                                         end
+                                   in (stmts, formals, actuals)
+                                   end
+                                else
+                                (* The con is tupled *)
+                                let
+                                   val tuple = Var.newNoname ()
+                                   val formals = (tuple, ty) :: formals
+                                   val (stmts, actuals) =
+                                      if Rep.isFlat r'
+                                         then
+                                         let
+                                            val xts =
+                                               Vector.map
+                                               (Type.deTuple ty, fn ty =>
+                                                (Var.newNoname (), ty))
+                                            val xs = Vector.map (xts, #1)
+                                            val actuals =
+                                               Vector.fold
+                                               (xs, actuals, op ::)
+                                            val stmts =
+                                               Vector.foldi
+                                               (xts, stmts,
+                                                fn (i, (x, ty), stmts) =>
+                                                Statement.T 
+                                                {var = SOME x,
+                                                 ty = ty,
+                                                 exp = Select {tuple = tuple,
+                                                               offset = i}}
+                                                :: stmts)
+                                         in (stmts, actuals)
+                                         end
+                                      else (stmts, tuple :: actuals)
+                                in (stmts, formals, actuals)
+                                end)
+                            val _ =
+                               List.push
+                               (newBlocks,
+                                Block.T
+                                {label = l',
+                                 args = Vector.fromList formals,
+                                 statements = Vector.fromList stmts,
+                                 transfer = Goto {dst = l,
+                                                  args = Vector.fromList actuals}})
+                         in
+                           (c, l')
+                         end
+                      end)
+               in Case {test = test,
+                        cases = Cases.Con cases,
+                        default = default}
+               end 
+            fun doitTransfer transfer =
+               case transfer of
+                  Call {func, args, return} =>
+                     Call {func = func, 
+                           args = flattens (args, funcArgs func),
+                           return = return}
+                | Case {test, cases = Cases.Con cases, default} =>
+                     doitCaseCon {test = test, 
+                                  cases = cases, 
+                                  default = default}
+                | Goto {dst, args} =>
+                     Goto {dst = dst,
+                           args = flattens (args, labelArgs dst)}
+                | Raise xs => Raise (flattens (xs, valOf raisesReps))
+                | Return xs => Return (flattens (xs, valOf returnsReps))
+                | _ => transfer
 
-	    fun doitBlock (Block.T {label, args, statements, transfer}) =
-	       let
-		 val (args, stmts) = doitArgs (args, labelArgs label)
-		 val statements = Vector.map (statements, doitStatement)
-		 val statements = Vector.concat [stmts, statements]
-		 val transfer = doitTransfer transfer
-	       in
-		  Block.T {label = label,
-			   args = args,
-			   statements = statements,
-			   transfer = transfer}
-	       end
+            fun doitBlock (Block.T {label, args, statements, transfer}) =
+               let
+                 val (args, stmts) = doitArgs (args, labelArgs label)
+                 val statements = Vector.map (statements, doitStatement)
+                 val statements = Vector.concat [stmts, statements]
+                 val transfer = doitTransfer transfer
+               in
+                  Block.T {label = label,
+                           args = args,
+                           statements = statements,
+                           transfer = transfer}
+               end
 
-	    val (args, stmts) = doitArgs (args, argsReps)
-	    val start' = Label.newNoname ()
-	    val _ = List.push
-	            (newBlocks,
-		     Block.T {label = start',
-			      args = Vector.new0 (),
-			      statements = stmts,
-			      transfer = Goto {dst = start, 
-					       args = Vector.new0 ()}})
-	    val start = start'
-	    val _ = Function.dfs 
-	            (f, fn b => let val _ = List.push (newBlocks, doitBlock b)
-				in fn () => ()
-				end)
-	    val blocks = Vector.fromList (!newBlocks)
-	    val returns =
-	       Option.map
-	       (returns, fn ts =>
-		flattenTypes (ts, valOf returnsReps))
-	    val raises =
-	       Option.map
-	       (raises, fn ts =>
-		flattenTypes (ts, valOf raisesReps))
-	 in
-	    Function.new {args = args,
-			  blocks = blocks,
-			  mayInline = mayInline,
-			  name = name,
-			  raises = raises,
-			  returns = returns,
-			  start = start}
-	 end
+            val (args, stmts) = doitArgs (args, argsReps)
+            val start' = Label.newNoname ()
+            val _ = List.push
+                    (newBlocks,
+                     Block.T {label = start',
+                              args = Vector.new0 (),
+                              statements = stmts,
+                              transfer = Goto {dst = start, 
+                                               args = Vector.new0 ()}})
+            val start = start'
+            val _ = Function.dfs 
+                    (f, fn b => let val _ = List.push (newBlocks, doitBlock b)
+                                in fn () => ()
+                                end)
+            val blocks = Vector.fromList (!newBlocks)
+            val returns =
+               Option.map
+               (returns, fn ts =>
+                flattenTypes (ts, valOf returnsReps))
+            val raises =
+               Option.map
+               (raises, fn ts =>
+                flattenTypes (ts, valOf raisesReps))
+         in
+            Function.new {args = args,
+                          blocks = blocks,
+                          mayInline = mayInline,
+                          name = name,
+                          raises = raises,
+                          returns = returns,
+                          start = start}
+         end
 
       val shrink = shrinkFunction {globals = globals}
       val functions = List.revMap (functions, shrink o doitFunction)
       val program =
-	 Program.T {datatypes = datatypes,
-		    globals = globals,
-		    functions = functions,
-		    main = main}
+         Program.T {datatypes = datatypes,
+                    globals = globals,
+                    functions = functions,
+                    main = main}
       val _ = Program.clearTop program
    in
       program

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ssa/flatten.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ssa/flatten.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ssa/flatten.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature FLATTEN_STRUCTS = 
    sig
       include SHRINK

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ssa/global.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ssa/global.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ssa/global.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 functor Global (S: GLOBAL_STRUCTS): GLOBAL = 
 struct
 
@@ -18,16 +19,16 @@
          Con.equals (c, c') andalso equalss (args, args')
     | (Const c, Const c') => Const.equals (c, c')
     | (PrimApp {prim = p, targs = t, ...}, PrimApp {prim = p', targs = t', ...}) =>
-	 let
-	    datatype z = datatype Prim.Name.t
-	    val n = Prim.name p
-	    val n' = Prim.name p'
-	 in
-	    case (n, n') of
-	       (Array_array0Const, Array_array0Const) =>
-		  Vector.equals (t, t', Type.equals)
-	     | _ => false
-	 end
+         let
+            datatype z = datatype Prim.Name.t
+            val n = Prim.name p
+            val n' = Prim.name p'
+         in
+            case (n, n') of
+               (Array_array0Const, Array_array0Const) =>
+                  Vector.equals (t, t', Type.equals)
+             | _ => false
+         end
     | (Tuple xs, Tuple xs') => equalss (xs, xs')
     | _ => false
 
@@ -36,28 +37,28 @@
       type bind = {var: Var.t, ty: Type.t, exp: Exp.t}
       val binds: bind list ref = ref []
       fun all () = Vector.fromList
-	           (List.revMap
-		    (!binds, fn {var, ty, exp} =>
-		     Statement.T {var = SOME var, ty = ty, exp = exp}))
-		   before binds := []
+                   (List.revMap
+                    (!binds, fn {var, ty, exp} =>
+                     Statement.T {var = SOME var, ty = ty, exp = exp}))
+                   before binds := []
       val set: (word * bind) HashSet.t = HashSet.new {hash = #1}
       fun new (ty: Type.t, exp: Exp.t): Var.t =
-	 let
-	    val hash = hash exp
-	 in
-	    #var
-	    (#2
-	     (HashSet.lookupOrInsert
-	      (set, hash,
-	       fn (_, {exp = exp', ...}) => expEquals (exp, exp'),
-	       fn () => 
-	       let
-		  val x = Var.newString "global"
-		  val bind = {var = x, ty = ty, exp = exp}
-	       in List.push (binds, bind)
-		  ; (hash, bind)
-	       end)))
-	 end
+         let
+            val hash = hash exp
+         in
+            #var
+            (#2
+             (HashSet.lookupOrInsert
+              (set, hash,
+               fn (_, {exp = exp', ...}) => expEquals (exp, exp'),
+               fn () => 
+               let
+                  val x = Var.newString "global"
+                  val bind = {var = x, ty = ty, exp = exp}
+               in List.push (binds, bind)
+                  ; (hash, bind)
+               end)))
+         end
    in {new = new, all = all}
    end
 end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ssa/global.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ssa/global.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ssa/global.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 type word = Word.t
    
 signature GLOBAL_STRUCTS = 
@@ -17,8 +18,8 @@
       include GLOBAL_STRUCTS
       
       val make:
-	 unit -> {
-		  new: Type.t * Exp.t -> Var.t,
-		  all: unit -> Statement.t vector
-		 }
+         unit -> {
+                  new: Type.t * Exp.t -> Var.t,
+                  all: unit -> Statement.t vector
+                 }
    end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ssa/inline.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ssa/inline.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ssa/inline.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,9 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 functor Inline (S: INLINE_STRUCTS): INLINE = 
@@ -17,65 +17,65 @@
 structure Size =
    struct
       val check : (int * int option) -> bool =
-	 fn (_, NONE) => false
-	  | (size, SOME size') => size > size'
+         fn (_, NONE) => false
+          | (size, SOME size') => size > size'
 
       val defaultExpSize : Exp.t -> int = 
-	 fn ConApp {args, ...} => 1 + Vector.length args
-	  | Const _ => 0
-	  | PrimApp {args, ...} => 1 + Vector.length args
-	  | Profile _ => 0
-	  | Select _ => 1 + 1
-	  | Tuple xs => 1 + Vector.length xs
-	  | Var _ => 0
+         fn ConApp {args, ...} => 1 + Vector.length args
+          | Const _ => 0
+          | PrimApp {args, ...} => 1 + Vector.length args
+          | Profile _ => 0
+          | Select _ => 1 + 1
+          | Tuple xs => 1 + Vector.length xs
+          | Var _ => 0
       fun expSize (size, max) (doExp, _) exp =
-	 let
-	    val size' = doExp exp
-	    val size = size + size'
-	 in
-	    (size, check (size, max))
-	 end
+         let
+            val size' = doExp exp
+            val size = size + size'
+         in
+            (size, check (size, max))
+         end
       fun statementSize (size, max) (doExp, doTransfer) =
-	 fn Statement.T {exp, ...} => expSize (size, max) (doExp, doTransfer) exp
+         fn Statement.T {exp, ...} => expSize (size, max) (doExp, doTransfer) exp
       fun statementsSize (size, max) (doExp, doTransfer) statements =
-	 DynamicWind.withEscape
-	 (fn escape =>
-	  Vector.fold
-	  (statements, (size, false), fn (statement, (size, check)) =>
-	   if check
-	      then escape (size, check)
-	   else statementSize (size, max) (doExp, doTransfer) statement))
+         Exn.withEscape
+         (fn escape =>
+          Vector.fold
+          (statements, (size, false), fn (statement, (size, check)) =>
+           if check
+              then escape (size, check)
+           else statementSize (size, max) (doExp, doTransfer) statement))
       val defaultTransferSize =
-	 fn Arith {args, ...} => 1 + Vector.length args
-	  | Bug => 1
-	  | Call {args, ...} => 1 + Vector.length args
-	  | Case {cases, ...} => 1 + Cases.length cases
-	  | Goto {args, ...} => 1 + Vector.length args
-	  | Raise xs => 1 + Vector.length xs
-	  | Return xs => 1 + Vector.length xs
-	  | Runtime {args, ...} => 1 + Vector.length args
+         fn Arith {args, ...} => 1 + Vector.length args
+          | Bug => 1
+          | Call {args, ...} => 1 + Vector.length args
+          | Case {cases, ...} => 1 + Cases.length cases
+          | Goto {args, ...} => 1 + Vector.length args
+          | Raise xs => 1 + Vector.length xs
+          | Return xs => 1 + Vector.length xs
+          | Runtime {args, ...} => 1 + Vector.length args
       fun transferSize (size, max) (_, doTransfer) transfer =
-	 let
-	    val size' = doTransfer transfer
-	    val size = size + size'
-	 in
-	    (size, check (size, max))
-	 end
+         let
+            val size' = doTransfer transfer
+            val size = size + size'
+         in
+            (size, check (size, max))
+         end
       fun blockSize (size, max) (doExp, doTransfer) =
-	 fn Block.T {statements, transfer, ...} =>
-	 case statementsSize (size, max) (doExp, doTransfer) statements of
-	    (size, true) => (size, true)
-	  | (size, false) => transferSize (size, max) (doExp, doTransfer) transfer
+         fn Block.T {statements, transfer, ...} =>
+         case statementsSize (size, max) (doExp, doTransfer) statements of
+            (size, true) => (size, true)
+          | (size, false) => transferSize (size, max) (doExp, doTransfer) transfer
       fun blocksSize (size, max) (doExp, doTransfer) blocks =
-	 DynamicWind.withEscape
-	 (fn escape =>
-	  Vector.fold
-	  (blocks, (size, false), fn (block, (size, check)) =>
-	   if check
-	      then escape (size, check)
-	   else blockSize (size, max) (doExp, doTransfer) block))
+         Exn.withEscape
+         (fn escape =>
+          Vector.fold
+          (blocks, (size, false), fn (block, (size, check)) =>
+           if check
+              then escape (size, check)
+           else blockSize (size, max) (doExp, doTransfer) block))
       fun functionSize (size, max) (doExp, doTransfer) f =
-	 blocksSize (size, max) (doExp, doTransfer) (#blocks (Function.dest f))
+         blocksSize (size, max) (doExp, doTransfer) (#blocks (Function.dest f))
 
       val default = (defaultExpSize, defaultTransferSize)
       fun functionGT max = #2 o (functionSize (0, max) default)
@@ -85,69 +85,69 @@
    fun 'a make (dontInlineFunc: Function.t * 'a -> bool)
       (Program.T {functions, ...}, a: 'a): Func.t -> bool =
       let
-	 val {get = shouldInline: Func.t -> bool, 
-	      set = setShouldInline, ...} =
-	    Property.getSetOnce (Func.plist, Property.initConst false)
+         val {get = shouldInline: Func.t -> bool, 
+              set = setShouldInline, ...} =
+            Property.getSetOnce (Func.plist, Property.initConst false)
       in
-	 List.foreach
-	 (functions, fn f =>
-	  if not (Function.mayInline f) orelse dontInlineFunc (f, a)
-	     then ()
-	  else setShouldInline (Function.name f, true))
-	 ; Control.diagnostics
-	   (fn display =>
-	    let open Layout
-	    in List.foreach
-	       (functions, fn f => 
-		let 
-		   val name = Function.name f
-		   val shouldInline = shouldInline name
-		in 
-		   display
-		   (seq [Func.layout name, str ": ",
-			 record [("shouldInline", Bool.layout shouldInline)]])
-		end)
-	    end)
-	 ; shouldInline
+         List.foreach
+         (functions, fn f =>
+          if not (Function.mayInline f) orelse dontInlineFunc (f, a)
+             then ()
+          else setShouldInline (Function.name f, true))
+         ; Control.diagnostics
+           (fn display =>
+            let open Layout
+            in List.foreach
+               (functions, fn f => 
+                let 
+                   val name = Function.name f
+                   val shouldInline = shouldInline name
+                in 
+                   display
+                   (seq [Func.layout name, str ": ",
+                         record [("shouldInline", Bool.layout shouldInline)]])
+                end)
+            end)
+         ; shouldInline
       end
    fun containsCall (f: Function.t): bool =
-      DynamicWind.withEscape
+      Exn.withEscape
       (fn escape =>
        (Vector.foreach
-	(Function.blocks f, fn Block.T {transfer, ...} =>
-	 case transfer of
-	    Call _ => escape true
-	  | _ => ())
-	; false))
+        (Function.blocks f, fn Block.T {transfer, ...} =>
+         case transfer of
+            Call _ => escape true
+          | _ => ())
+        ; false))
    fun containsLoop (f: Function.t): bool =
       let
-	 val {get, set, destroy} =
-	    Property.destGetSet (Label.plist, Property.initConst false)
+         val {get, set, destroy} =
+            Property.destGetSet (Label.plist, Property.initConst false)
       in
-	 DynamicWind.withEscape
-	 (fn escape =>
-	  let
-	     val _ =
-		Function.dfs
-		(f, fn (Block.T {label, transfer, ...}) =>
-		 (set (label, true)
-		  ; (case transfer of
-			Goto {dst, ...} => if get dst then escape true else ()
-		      | _ => ())
-		  ; fn () => set (label, false)))
-	  in
-	     false
-	  end)
-	 before (destroy ())
+         Exn.withEscape
+         (fn escape =>
+          let
+             val _ =
+                Function.dfs
+                (f, fn (Block.T {label, transfer, ...}) =>
+                 (set (label, true)
+                  ; (case transfer of
+                        Goto {dst, ...} => if get dst then escape true else ()
+                      | _ => ())
+                  ; fn () => set (label, false)))
+          in
+             false
+          end)
+         before (destroy ())
       end
 in
    val leaf = make (fn (f, {size}) =>
-		    Size.functionGT size f
-		    orelse containsCall f)
+                    Size.functionGT size f
+                    orelse containsCall f)
    val leafNoLoop = make (fn (f, {size}) =>
-			  Size.functionGT size f
-			  orelse containsCall f
-			  orelse containsLoop f)
+                          Size.functionGT size f
+                          orelse containsCall f
+                          orelse containsLoop f)
 end
 
 structure Graph = DirectedGraph
@@ -156,134 +156,134 @@
 fun product (Program.T {functions, ...}, {small: int, product: int}) =
    let
       type info = {doesCallSelf: bool ref,
-		   function: Function.t,
-		   node: unit Node.t,
-		   numCalls: int ref,
-		   shouldInline: bool ref,
-		   size: int ref}
+                   function: Function.t,
+                   node: unit Node.t,
+                   numCalls: int ref,
+                   shouldInline: bool ref,
+                   size: int ref}
       val {get = funcInfo: Func.t -> info,
-	   set = setFuncInfo, ...} =
-	 Property.getSetOnce
-	 (Func.plist, Property.initRaise ("funcInfo", Func.layout))
+           set = setFuncInfo, ...} =
+         Property.getSetOnce
+         (Func.plist, Property.initRaise ("funcInfo", Func.layout))
       val {get = nodeFunc: unit Node.t -> Func.t,
-	   set = setNodeFunc, ...} = 
-	 Property.getSetOnce 
-	 (Node.plist, Property.initRaise ("nodeFunc", Node.layout))
+           set = setNodeFunc, ...} = 
+         Property.getSetOnce 
+         (Node.plist, Property.initRaise ("nodeFunc", Node.layout))
       val graph = Graph.new ()
       (* initialize the info for each func *)
       val _ = 
-	 List.foreach
-	 (functions, fn f =>
-	  let 
-	     val name = Function.name f
-	     val n = Graph.newNode graph
-	  in
-	     setNodeFunc (n, name)
-	     ; setFuncInfo (name, {doesCallSelf = ref false,
-				   function = f,
-				   node = n,
-				   numCalls = ref 0,
-				   shouldInline = ref false,
-				   size = ref 0})
-	  end)
+         List.foreach
+         (functions, fn f =>
+          let 
+             val name = Function.name f
+             val n = Graph.newNode graph
+          in
+             setNodeFunc (n, name)
+             ; setFuncInfo (name, {doesCallSelf = ref false,
+                                   function = f,
+                                   node = n,
+                                   numCalls = ref 0,
+                                   shouldInline = ref false,
+                                   size = ref 0})
+          end)
       (* Update call counts. *)
       val _ = 
-	 List.foreach
-	 (functions, fn f =>
-	  let 
-	     val {name, blocks, ...} = Function.dest f
-	     val {doesCallSelf, ...} = funcInfo name
-	  in
-	     Vector.foreach
-	     (blocks, fn Block.T {transfer, ...} =>
-	      case transfer of
-		 Call {func, ...} =>
-		    let
-		       val {numCalls, ...} = funcInfo func
-		    in
-		       if Func.equals (name, func)
-			  then doesCallSelf := true
-		       else Int.inc numCalls
-		    end
-	       | _ => ())
-	  end)
+         List.foreach
+         (functions, fn f =>
+          let 
+             val {name, blocks, ...} = Function.dest f
+             val {doesCallSelf, ...} = funcInfo name
+          in
+             Vector.foreach
+             (blocks, fn Block.T {transfer, ...} =>
+              case transfer of
+                 Call {func, ...} =>
+                    let
+                       val {numCalls, ...} = funcInfo func
+                    in
+                       if Func.equals (name, func)
+                          then doesCallSelf := true
+                       else Int.inc numCalls
+                    end
+               | _ => ())
+          end)
       fun mayInline (setSize: bool,
-		     {function, doesCallSelf, numCalls, size, ...}: info): bool =
-	 Function.mayInline function
-	 andalso not (!doesCallSelf)
-	 andalso let
-		    val (n, _) = 
-		       Size.functionSize
-		       (0, NONE)
-		       (Size.defaultExpSize,
-			fn t as Call {func, ...} =>
-			      let
-				val {shouldInline, size, ...} = funcInfo func
-			      in
-				if !shouldInline
-				   then !size
-				else Size.defaultTransferSize t
-			      end
-			 | t => Size.defaultTransferSize t)
-		       function
-		 in
-		    if setSize
-		       then size := n
-		    else ()
-		    ; (!numCalls - 1) * (n - small) <= product
-		 end
+                     {function, doesCallSelf, numCalls, size, ...}: info): bool =
+         Function.mayInline function
+         andalso not (!doesCallSelf)
+         andalso let
+                    val (n, _) = 
+                       Size.functionSize
+                       (0, NONE)
+                       (Size.defaultExpSize,
+                        fn t as Call {func, ...} =>
+                              let
+                                val {shouldInline, size, ...} = funcInfo func
+                              in
+                                if !shouldInline
+                                   then !size
+                                else Size.defaultTransferSize t
+                              end
+                         | t => Size.defaultTransferSize t)
+                       function
+                 in
+                    if setSize
+                       then size := n
+                    else ()
+                    ; (!numCalls - 1) * (n - small) <= product
+                 end
       (* Build the call graph.  Do not include functions that we already know
        * will not be inlined.
        *)
       val _ =
-	 List.foreach
-	 (functions, fn f => 
-	  let 
-	     val {name, blocks, ...} = Function.dest f
-	     val info as {node, ...} = funcInfo name
-	  in
-	     if mayInline (false, info)
-	        then Vector.foreach
-		     (blocks, fn Block.T {transfer, ...} =>
-		      case transfer of
-			 Call {func, ...} =>
-			    if Func.equals (name, func)
-			       then ()
-			    else (ignore o Graph.addEdge)
-			         (graph, {from = node, to = #node (funcInfo func)})
-		       | _ => ())
-	     else ()
-	  end)
+         List.foreach
+         (functions, fn f => 
+          let 
+             val {name, blocks, ...} = Function.dest f
+             val info as {node, ...} = funcInfo name
+          in
+             if mayInline (false, info)
+                then Vector.foreach
+                     (blocks, fn Block.T {transfer, ...} =>
+                      case transfer of
+                         Call {func, ...} =>
+                            if Func.equals (name, func)
+                               then ()
+                            else (ignore o Graph.addEdge)
+                                 (graph, {from = node, to = #node (funcInfo func)})
+                       | _ => ())
+             else ()
+          end)
       (* Compute strongly-connected components.
        * Then start at the leaves of the call graph and work up.
        *)
       val _ = 
-	 List.foreach
-	 (rev (Graph.stronglyConnectedComponents graph),
-	  fn [n] => let val info as {shouldInline, ...} = funcInfo (nodeFunc n)
-		    in shouldInline := mayInline (true, info)
-		    end
-	   | _ => ())
+         List.foreach
+         (rev (Graph.stronglyConnectedComponents graph),
+          fn [n] => let val info as {shouldInline, ...} = funcInfo (nodeFunc n)
+                    in shouldInline := mayInline (true, info)
+                    end
+           | _ => ())
       val _ =
-	 Control.diagnostics
-	 (fn display =>
-	  let open Layout
-	  in List.foreach
-	     (functions, fn f => 
-	      let 
-	         val name = Function.name f
-		 val {numCalls, shouldInline, size, ...} = funcInfo name
-		 val numCalls = !numCalls
-		 val shouldInline = !shouldInline
-		 val size = !size
-	      in 
-		 display
-		 (seq [Func.layout name, str ": ",
-		       record [("numCalls", Int.layout numCalls),
-			       ("size", Int.layout size),
-			       ("shouldInline", Bool.layout shouldInline)]])
-	      end)
-	  end)
+         Control.diagnostics
+         (fn display =>
+          let open Layout
+          in List.foreach
+             (functions, fn f => 
+              let 
+                 val name = Function.name f
+                 val {numCalls, shouldInline, size, ...} = funcInfo name
+                 val numCalls = !numCalls
+                 val shouldInline = !shouldInline
+                 val size = !size
+              in 
+                 display
+                 (seq [Func.layout name, str ": ",
+                       record [("numCalls", Int.layout numCalls),
+                               ("size", Int.layout size),
+                               ("shouldInline", Bool.layout shouldInline)]])
+              end)
+          end)
    in
       ! o #shouldInline o funcInfo
    end
@@ -291,137 +291,137 @@
 fun inline (program as Program.T {datatypes, globals, functions, main}) =
    let
       val shouldInline: Func.t -> bool =
-	 let open Control
-	 in case !inline of
-	    NonRecursive r => product (program, r)
-	  | Leaf r => leaf (program, r)
-	  | LeafNoLoop r => leafNoLoop (program, r)
-	 end
+         let open Control
+         in case !inline of
+            NonRecursive r => product (program, r)
+          | Leaf r => leaf (program, r)
+          | LeafNoLoop r => leafNoLoop (program, r)
+         end
       val {get = funcInfo: Func.t -> {function: Function.t,
-				      isCalledByMain: bool ref},
-	   set = setFuncInfo, ...} =
-	 Property.getSetOnce
-	 (Func.plist, Property.initRaise ("Inline.funcInfo", Func.layout))
+                                      isCalledByMain: bool ref},
+           set = setFuncInfo, ...} =
+         Property.getSetOnce
+         (Func.plist, Property.initRaise ("Inline.funcInfo", Func.layout))
       val () = List.foreach (functions, fn f =>
-			     setFuncInfo (Function.name f,
-					  {function = f,
-					   isCalledByMain = ref false}))
+                             setFuncInfo (Function.name f,
+                                          {function = f,
+                                           isCalledByMain = ref false}))
       val () =
-	 Vector.foreach (#blocks (Function.dest (Program.mainFunction program)),
-			 fn Block.T {transfer, ...} =>
-			 case transfer of
-			    Transfer.Call {func, ...} =>
-			       #isCalledByMain (funcInfo func) := true
-			  | _ => ())
+         Vector.foreach (#blocks (Function.dest (Program.mainFunction program)),
+                         fn Block.T {transfer, ...} =>
+                         case transfer of
+                            Transfer.Call {func, ...} =>
+                               #isCalledByMain (funcInfo func) := true
+                          | _ => ())
       fun doit (blocks: Block.t vector,
-		return: Return.t) : Block.t vector =
-	 let
-	    val newBlocks = ref []
-	    val blocks =
-	       Vector.map
-	       (blocks,
-		fn block as Block.T {label, args, statements, transfer} =>
-		let
-		   fun new transfer =
-		      Block.T {label = label,
-			       args = args,
-			       statements = statements,
-			       transfer = transfer}
-		in
-		  case transfer of
-		     Call {func, args, return = return'} =>
-		        let
-			   val return = Return.compose (return, return')
-			in
-			   if shouldInline func
-			      then 
-			      let
-				 local
-				    val {name, args, start, blocks, ...} =
-				       (Function.dest o Function.alphaRename) 
-				       (#function (funcInfo func))
-				    val blocks = doit (blocks, return)
-				    val _ = List.push (newBlocks, blocks)
-				    val name =
-				       Label.newString (Func.originalName name)
-				    val _ = 
-				       List.push 
-				       (newBlocks,
-					Vector.new1
-					(Block.T
-					 {label = name,
-					  args = args,
-					  statements = Vector.new0 (),
-					  transfer = Goto {dst = start,
-							   args = Vector.new0 ()}}))
-				 in
-				    val name = name
-				 end
-			      in
-				 new (Goto {dst = name, 
-					    args = args})
-			      end
-			   else new (Call {func = func,
-					   args = args,
-					   return = return})
-			end
-	           | Raise xs =>
-			(case return of
-			    Return.NonTail
-			    {handler = Handler.Handle handler, ...} =>
-			       new (Goto {dst = handler,
-					  args = xs})
-			  | _ => block)
-		   | Return xs =>
-			(case return of
-			    Return.NonTail {cont, ...} =>
-			       new (Goto {dst = cont, args = xs})
-			  | _ => block)
-		   | _ => block
-		end)
-	 in
-	    Vector.concat (blocks::(!newBlocks))
-	 end
+                return: Return.t) : Block.t vector =
+         let
+            val newBlocks = ref []
+            val blocks =
+               Vector.map
+               (blocks,
+                fn block as Block.T {label, args, statements, transfer} =>
+                let
+                   fun new transfer =
+                      Block.T {label = label,
+                               args = args,
+                               statements = statements,
+                               transfer = transfer}
+                in
+                  case transfer of
+                     Call {func, args, return = return'} =>
+                        let
+                           val return = Return.compose (return, return')
+                        in
+                           if shouldInline func
+                              then 
+                              let
+                                 local
+                                    val {name, args, start, blocks, ...} =
+                                       (Function.dest o Function.alphaRename) 
+                                       (#function (funcInfo func))
+                                    val blocks = doit (blocks, return)
+                                    val _ = List.push (newBlocks, blocks)
+                                    val name =
+                                       Label.newString (Func.originalName name)
+                                    val _ = 
+                                       List.push 
+                                       (newBlocks,
+                                        Vector.new1
+                                        (Block.T
+                                         {label = name,
+                                          args = args,
+                                          statements = Vector.new0 (),
+                                          transfer = Goto {dst = start,
+                                                           args = Vector.new0 ()}}))
+                                 in
+                                    val name = name
+                                 end
+                              in
+                                 new (Goto {dst = name, 
+                                            args = args})
+                              end
+                           else new (Call {func = func,
+                                           args = args,
+                                           return = return})
+                        end
+                   | Raise xs =>
+                        (case return of
+                            Return.NonTail
+                            {handler = Handler.Handle handler, ...} =>
+                               new (Goto {dst = handler,
+                                          args = xs})
+                          | _ => block)
+                   | Return xs =>
+                        (case return of
+                            Return.NonTail {cont, ...} =>
+                               new (Goto {dst = cont, args = xs})
+                          | _ => block)
+                   | _ => block
+                end)
+         in
+            Vector.concat (blocks::(!newBlocks))
+         end
       val shrink = shrinkFunction {globals = globals}
       val inlineIntoMain = !Control.inlineIntoMain
       val functions =
-	 List.fold
-	 (functions, [], fn (f, ac) =>
-	  let
-	     val {args, blocks, mayInline, name, raises, returns, start} =
-		Function.dest f
-	     fun keep () =
-		let
-		   val blocks = doit (blocks, Return.Tail)
-		in
-		   shrink (Function.new {args = args,
-					 blocks = blocks,
-					 mayInline = mayInline,
-					 name = name,
-					 raises = raises,
-					 returns = returns,
-					 start = start})
-		   :: ac
-		end
-	  in
-	     if Func.equals (name, main)
-		then if inlineIntoMain
-			then keep ()
-		     else f :: ac
-	     else
-		if shouldInline name
-		   then
-		      if inlineIntoMain
-			 orelse not (! (#isCalledByMain (funcInfo name)))
-			 then ac
-		      else keep ()
-		else keep ()
-	  end)
+         List.fold
+         (functions, [], fn (f, ac) =>
+          let
+             val {args, blocks, mayInline, name, raises, returns, start} =
+                Function.dest f
+             fun keep () =
+                let
+                   val blocks = doit (blocks, Return.Tail)
+                in
+                   shrink (Function.new {args = args,
+                                         blocks = blocks,
+                                         mayInline = mayInline,
+                                         name = name,
+                                         raises = raises,
+                                         returns = returns,
+                                         start = start})
+                   :: ac
+                end
+          in
+             if Func.equals (name, main)
+                then if inlineIntoMain
+                        then keep ()
+                     else f :: ac
+             else
+                if shouldInline name
+                   then
+                      if inlineIntoMain
+                         orelse not (! (#isCalledByMain (funcInfo name)))
+                         then ac
+                      else keep ()
+                else keep ()
+          end)
       val program =
-	 Program.T {datatypes = datatypes,
-		    globals = globals,
-		    functions = functions,
-		    main = main}
+         Program.T {datatypes = datatypes,
+                    globals = globals,
+                    functions = functions,
+                    main = main}
       val _ = Program.clearTop program
    in
       program

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ssa/inline.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ssa/inline.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ssa/inline.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature INLINE_STRUCTS = 
    sig
       include SHRINK

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ssa/introduce-loops.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ssa/introduce-loops.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ssa/introduce-loops.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 (* Change any toplevel function that only calls itself in tail position
  * into one with a local loop and no self calls.
  *)
@@ -20,100 +21,100 @@
       open Return
 
       fun isTail (z: t): bool =
-	 case z of
-	    Dead => false
-	  | NonTail _ => false
-	  | Tail => true
+         case z of
+            Dead => false
+          | NonTail _ => false
+          | Tail => true
    end
 
 fun introduceLoops (Program.T {datatypes, globals, functions, main}) =
    let
       val functions =
-	 List.map
-	 (functions, fn f =>
-	  let
-	     val {args, blocks, mayInline, name, raises, returns, start} =
-		Function.dest f
-	     val tailCallsItself = ref false
-	     val _ =
-		Vector.foreach
-		(blocks, fn Block.T {transfer, ...} =>
-		 case transfer of
-		    Call {func, return, ...} =>
-		       if Func.equals (name, func)
-			  andalso Return.isTail return
-			  then tailCallsItself := true
-		       else ()
-		  | _ => ())
-	     val (args, start, blocks) =
-		if !tailCallsItself
-		   then
-		      let
-			 val _ = Control.diagnostics
-			    (fn display =>
-			     let open Layout
-			     in
-				display (Func.layout name)
-			     end)
-			 val newArgs =
-			    Vector.map (args, fn (x, t) => (Var.new x, t))
-			 val loopName = Label.newString "loop"
-			 val loopSName = Label.newString "loopS"
-			 val blocks = 
-			    Vector.toListMap
-			    (blocks,
-			     fn Block.T {label, args, statements, transfer} =>
-			     let
-				val transfer =
-				   case transfer of
-				      Call {func, args, return} =>
-					 if Func.equals (name, func)
-					    andalso Return.isTail return
-					    then Goto {dst = loopName, 
-						       args = args}
-					 else transfer
-				    | _ => transfer
-			     in
-				Block.T {label = label,
-					 args = args,
-					 statements = statements,
-					 transfer = transfer}
-			     end)
-			 val blocks = 
-			    Vector.fromList
-			    (Block.T 
-			     {label = loopSName,
-			      args = Vector.new0 (),
-			      statements = Vector.new0 (),
-			      transfer = Goto {dst = loopName,
-					       args = Vector.map (newArgs, #1)}} ::
-			     Block.T 
-			     {label = loopName,
-			      args = args,
-			      statements = Vector.new0 (),
-			      transfer = Goto {dst = start,
-					       args = Vector.new0 ()}} ::
-			     blocks)
-		      in
-			 (newArgs,
-			  loopSName,
-			  blocks)
-		      end
-		else (args, start, blocks)
-	  in
-	     Function.new {args = args,
-			   blocks = blocks,
-			   mayInline = mayInline,
-			   name = name,
-			   raises = raises,
-			   returns = returns,
-			   start = start}
-	  end)
+         List.map
+         (functions, fn f =>
+          let
+             val {args, blocks, mayInline, name, raises, returns, start} =
+                Function.dest f
+             val tailCallsItself = ref false
+             val _ =
+                Vector.foreach
+                (blocks, fn Block.T {transfer, ...} =>
+                 case transfer of
+                    Call {func, return, ...} =>
+                       if Func.equals (name, func)
+                          andalso Return.isTail return
+                          then tailCallsItself := true
+                       else ()
+                  | _ => ())
+             val (args, start, blocks) =
+                if !tailCallsItself
+                   then
+                      let
+                         val _ = Control.diagnostics
+                            (fn display =>
+                             let open Layout
+                             in
+                                display (Func.layout name)
+                             end)
+                         val newArgs =
+                            Vector.map (args, fn (x, t) => (Var.new x, t))
+                         val loopName = Label.newString "loop"
+                         val loopSName = Label.newString "loopS"
+                         val blocks = 
+                            Vector.toListMap
+                            (blocks,
+                             fn Block.T {label, args, statements, transfer} =>
+                             let
+                                val transfer =
+                                   case transfer of
+                                      Call {func, args, return} =>
+                                         if Func.equals (name, func)
+                                            andalso Return.isTail return
+                                            then Goto {dst = loopName, 
+                                                       args = args}
+                                         else transfer
+                                    | _ => transfer
+                             in
+                                Block.T {label = label,
+                                         args = args,
+                                         statements = statements,
+                                         transfer = transfer}
+                             end)
+                         val blocks = 
+                            Vector.fromList
+                            (Block.T 
+                             {label = loopSName,
+                              args = Vector.new0 (),
+                              statements = Vector.new0 (),
+                              transfer = Goto {dst = loopName,
+                                               args = Vector.map (newArgs, #1)}} ::
+                             Block.T 
+                             {label = loopName,
+                              args = args,
+                              statements = Vector.new0 (),
+                              transfer = Goto {dst = start,
+                                               args = Vector.new0 ()}} ::
+                             blocks)
+                      in
+                         (newArgs,
+                          loopSName,
+                          blocks)
+                      end
+                else (args, start, blocks)
+          in
+             Function.new {args = args,
+                           blocks = blocks,
+                           mayInline = mayInline,
+                           name = name,
+                           raises = raises,
+                           returns = returns,
+                           start = start}
+          end)
    in
       Program.T {datatypes = datatypes,
-		 globals = globals,
-		 functions = functions,
-		 main = main}
+                 globals = globals,
+                 functions = functions,
+                 main = main}
    end
 
 end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ssa/introduce-loops.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ssa/introduce-loops.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ssa/introduce-loops.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature INTRODUCE_LOOPS_STRUCTS = 
    sig
       include SHRINK

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ssa/known-case.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ssa/known-case.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ssa/known-case.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 functor KnownCase (S: KNOWN_CASE_STRUCTS): KNOWN_CASE =
 struct
 
@@ -39,8 +40,8 @@
 structure ConInfo =
   struct
     datatype t = T of {args: Type.t vector,
-		       index: int, 
-		       tycon: Tycon.t}
+                       index: int, 
+                       tycon: Tycon.t}
 
     local 
       fun make f (T r) = f r
@@ -71,10 +72,10 @@
     val joinV : v * v -> v
       = fn (SOME x, SOME y) 
          => if equalsW (x, y)
-	      then SOME x
-	      else NONE
-	 | (NONE, _) => NONE
-	 | (_, NONE) => NONE
+              then SOME x
+              else NONE
+         | (NONE, _) => NONE
+         | (_, NONE) => NONE
     val joinU : u * u -> u
       = fn (SOME x, SOME y) => SOME (joinV (x, y))
          | (NONE, y) => y
@@ -82,8 +83,8 @@
     val join : t * t -> t
       = fn ((conx, x), (cony, y)) => 
         if Con.equals (conx, cony)
-	  then (conx, joinU (x, y))
-	  else Error.bug "KnownCase.ConValue.join"
+          then (conx, joinU (x, y))
+          else Error.bug "KnownCase.ConValue.join"
 
     fun newKnown (con, args) : t = (con, SOME (SOME args))
     fun newUnknown con : t = (con, SOME NONE)
@@ -106,9 +107,9 @@
     fun newKnown (cons, con, args)
       = Vector.map
         (cons, fn con' =>
-	 if Con.equals (con, con')
-	   then ConValue.newKnown (con, args)
-	   else ConValue.new con')
+         if Con.equals (con, con')
+           then ConValue.newKnown (con, args)
+           else ConValue.new con')
 
     fun newUnknown cons = Vector.map (cons, ConValue.newUnknown)
 
@@ -119,8 +120,8 @@
 structure VarInfo =
   struct
     datatype t = T of {active: bool ref,
-		       tyconValues: TyconValue.t list ref,
-		       var: Var.t}
+                       tyconValues: TyconValue.t list ref,
+                       var: Var.t}
 
     local 
       fun make f (T r) = f r
@@ -131,18 +132,18 @@
 
     fun layout (T {active, tyconValues, var, ...}) 
       = Layout.record [("active", Bool.layout (!active)),
-		       ("tyconValues", List.layout TyconValue.layout (!tyconValues)),
-		       ("var", Var.layout var)]
+                       ("tyconValues", List.layout TyconValue.layout (!tyconValues)),
+                       ("var", Var.layout var)]
 
     fun new var = T {active = ref false,
-		     tyconValues = ref [],
-		     var = var}
+                     tyconValues = ref [],
+                     var = var}
 
     fun deactivate (T {active, ...}) = active := false
     fun activate (T {active, ...}) = active := true
-    fun activate' (vi, addPost)
+    fun activate' (vi, addPost: (unit -> unit) -> unit)
       = (addPost (fn () => deactivate vi);
-	 activate vi)
+         activate vi)
     val active = active'
 
     fun tyconValue (T {tyconValues, ...})
@@ -151,20 +152,20 @@
     fun pushTyconValue (T {tyconValues, ...}, tcv) = List.push (tyconValues, tcv)
     fun pushTyconValue' (vi, tcv, addPost)
       = let
-	  val _ = pushTyconValue (vi, tcv)
-	  val _ = addPost (fn () => popTyconValue vi)
-	in
-	  ()
-	end
+          val _ = pushTyconValue (vi, tcv)
+          val _ = addPost (fn () => popTyconValue vi)
+        in
+          ()
+        end
     fun joinActiveTyconValue (vi, tcv, addPost, addPost')
       = if active vi
-	  then let val tcv' = valOf (tyconValue vi)
-	       in 
-		 popTyconValue vi;
-		 pushTyconValue (vi, TyconValue.join (tcv, tcv'))
-	       end
-	  else (activate' (vi, addPost');
-		pushTyconValue' (vi, tcv, addPost))
+          then let val tcv' = valOf (tyconValue vi)
+               in 
+                 popTyconValue vi;
+                 pushTyconValue (vi, TyconValue.join (tcv, tcv'))
+               end
+          else (activate' (vi, addPost');
+                pushTyconValue' (vi, tcv, addPost))
   end
 
 structure ReplaceInfo =
@@ -179,37 +180,37 @@
     fun pushReplace (T {replaces, ...}, rep) = List.push (replaces, ref rep)
     fun pushReplace' (vi, rep, addPost)
       = let
-	  val _ = pushReplace (vi, rep)
-	  val _ = addPost (fn () => popReplace vi)
-	in
-	  ()
-	end
+          val _ = pushReplace (vi, rep)
+          val _ = addPost (fn () => popReplace vi)
+        in
+          ()
+        end
     fun flipReplace (vi, rep) 
       = let val r = replace vi 
-	in !r before (r := rep) 
-	end
+        in !r before (r := rep) 
+        end
     fun flipReplace' (vi, rep, addPost)
       = let 
-	  val rep = flipReplace (vi, rep)
-	  val _ = addPost (fn () => ignore (flipReplace (vi, rep)))
-	in 
-	  rep
-	end
+          val rep = flipReplace (vi, rep)
+          val _ = addPost (fn () => ignore (flipReplace (vi, rep)))
+        in 
+          rep
+        end
     fun nextReplace' (vi, rep, addPost)
       = let 
-	  val rep = flipReplace' (vi, rep, addPost)
-	  val _ = pushReplace' (vi, rep, addPost)
-	in
-	  ()
-	end
+          val rep = flipReplace' (vi, rep, addPost)
+          val _ = pushReplace' (vi, rep, addPost)
+        in
+          ()
+        end
   end
 
 structure LabelInfo =
   struct
     datatype t = T of {activations: (VarInfo.t * TyconValue.t) list ref,
-		       block: Block.t, 
-		       depth: int ref,
-		       pred: Label.t option option ref}
+                       block: Block.t, 
+                       depth: int ref,
+                       pred: Label.t option option ref}
 
     local 
       fun make f (T r) = f r
@@ -224,57 +225,57 @@
         [("pred", Option.layout (Option.layout Label.layout) (!pred))]
 
     fun new block = T {activations = ref [],
-		       block = block,
-		       depth = ref 0,
-		       pred = ref NONE}
+                       block = block,
+                       depth = ref 0,
+                       pred = ref NONE}
 
     fun popDepth (T {depth, ...}) = Int.dec depth
     fun pushDepth (T {depth, ...}) = Int.inc depth
     fun pushDepth' (li, addPost)
       = let
-	  val _ = pushDepth li
-	  val _ = addPost (fn () => popDepth li)
-	in
-	  ()
-	end
+          val _ = pushDepth li
+          val _ = addPost (fn () => popDepth li)
+        in
+          ()
+        end
 
     fun addPred (T {pred, ...}, l)
       = case !pred
-	  of NONE => pred := SOME (SOME l)
-	   | SOME NONE => ()
-	   | SOME (SOME l') => if Label.equals (l, l')
-				 then ()
-				 else pred := SOME NONE
+          of NONE => pred := SOME (SOME l)
+           | SOME NONE => ()
+           | SOME (SOME l') => if Label.equals (l, l')
+                                 then ()
+                                 else pred := SOME NONE
     fun onePred (T {pred, ...})
       = case !pred
-	  of SOME (SOME _) => true
-	   | _ => false
+          of SOME (SOME _) => true
+           | _ => false
 
     fun addActivation (T {activations, ...}, activation)
       = List.push (activations, activation)
     fun activate (T {activations, ...}, addPost)
       = let
-	  val {addPost = addPost', post = post'} = mkPost ()
-	in 
-	  List.foreach
-	  (!activations, fn (vi, tcv) =>
-	   VarInfo.joinActiveTyconValue (vi, tcv, addPost, addPost'));
-	  post' ()
-	end
+          val {addPost = addPost', post = post'} = mkPost ()
+        in 
+          List.foreach
+          (!activations, fn (vi, tcv) =>
+           VarInfo.joinActiveTyconValue (vi, tcv, addPost, addPost'));
+          post' ()
+        end
     val activate : t * ((unit -> unit) -> unit) -> unit
       = Trace.trace
-        ("KnownCase.activate",
-	 fn (T {activations, block = Block.T {label, ...}, ...}, _) =>
-	 let open Layout
-	 in
-	   seq [Label.layout label,
-		str " ",
-		(List.layout (tuple2 (VarInfo.layout,
-				      TyconValue.layout))
-		             (!activations))]
-	 end,
-	 Layout.ignore)
-	activate
+        ("KnownCase.LabelInfo.activate",
+         fn (T {activations, block = Block.T {label, ...}, ...}, _) =>
+         let open Layout
+         in
+           seq [Label.layout label,
+                str " ",
+                (List.layout (tuple2 (VarInfo.layout,
+                                      TyconValue.layout))
+                             (!activations))]
+         end,
+         Layout.ignore)
+        activate
   end
 
 fun simplify (Program.T {globals, datatypes, functions, main})
@@ -285,441 +286,441 @@
 
       (* tyconInfo and conInfo *)
       val {get = tyconInfo: Tycon.t -> TyconInfo.t,
-	   set = setTyconInfo, ...}
-	= Property.getSetOnce
-	  (Tycon.plist, Property.initRaise ("knownCase.tyconInfo", Tycon.layout))
+           set = setTyconInfo, ...}
+        = Property.getSetOnce
+          (Tycon.plist, Property.initRaise ("knownCase.tyconInfo", Tycon.layout))
       val {get = conInfo: Con.t -> ConInfo.t,
-	   set = setConInfo, ...}
-	= Property.getSetOnce
-	  (Con.plist, Property.initRaise ("knownCase.conInfo", Con.layout))
+           set = setConInfo, ...}
+        = Property.getSetOnce
+          (Con.plist, Property.initRaise ("knownCase.conInfo", Con.layout))
       val _ = Vector.foreach
-	      (datatypes, fn Datatype.T {tycon, cons} =>
-	       (setTyconInfo (tycon, TyconInfo.T {cons = Vector.map (cons, #con)});
-		Vector.foreachi
-		(cons, fn (i, {con, args}) =>
-		 setConInfo (con, ConInfo.T {args = args,
-					     index = i, 
-					     tycon = tycon}))))
+              (datatypes, fn Datatype.T {tycon, cons} =>
+               (setTyconInfo (tycon, TyconInfo.T {cons = Vector.map (cons, #con)});
+                Vector.foreachi
+                (cons, fn (i, {con, args}) =>
+                 setConInfo (con, ConInfo.T {args = args,
+                                             index = i, 
+                                             tycon = tycon}))))
       (* Diagnostics *)
       val _ = Control.diagnostics
-	      (fn display =>
-	       let open Layout
-	       in
-		 Vector.foreach
-		 (datatypes, fn Datatype.T {tycon, cons} =>
-		  let val tci = tyconInfo tycon
-		  in
-		    display (seq [Tycon.layout tycon, str " ",
-				  TyconInfo.layout tci,
-				  Vector.layout 
-				  (fn {con, ...} =>
-				   let val ci = conInfo con
-				   in
-				     seq [Con.layout con, str " ",
-					  ConInfo.layout ci]
-				   end)
-				  cons])
-		  end)
-	       end)
+              (fn display =>
+               let open Layout
+               in
+                 Vector.foreach
+                 (datatypes, fn Datatype.T {tycon, cons} =>
+                  let val tci = tyconInfo tycon
+                  in
+                    display (seq [Tycon.layout tycon, str " ",
+                                  TyconInfo.layout tci,
+                                  Vector.layout 
+                                  (fn {con, ...} =>
+                                   let val ci = conInfo con
+                                   in
+                                     seq [Con.layout con, str " ",
+                                          ConInfo.layout ci]
+                                   end)
+                                  cons])
+                  end)
+               end)
       fun optimizeTycon _ = true
       fun optimizeType ty = case Type.dest ty
-			      of Type.Datatype tycon => optimizeTycon tycon
-			       | _ => false
+                              of Type.Datatype tycon => optimizeTycon tycon
+                               | _ => false
 
       (* varInfo *)
       val {get = varInfo: Var.t -> VarInfo.t, ...}
-	= Property.getSetOnce
-	  (Var.plist, Property.initFun (fn x => VarInfo.new x))
+        = Property.getSetOnce
+          (Var.plist, Property.initFun (fn x => VarInfo.new x))
       (* replaceInfo *)
       val {get = replaceInfo: Var.t -> ReplaceInfo.t, ...}
-	= Property.get
-	  (Var.plist, Property.initFun (fn x => ReplaceInfo.new x))
+        = Property.get
+          (Var.plist, Property.initFun (fn x => ReplaceInfo.new x))
 
 
       fun bindVar' (x, ty, exp, addPost)
-	= case Type.dest ty
-	    of Type.Datatype tycon
-	     => if optimizeTycon tycon
-		  then let
-			 val cons = TyconInfo.cons (tyconInfo tycon)
-			 val tyconValue
-			   = case exp
-			       of SOME (ConApp {con, args})
-				=> TyconValue.newKnown 
-				   (cons, con, 
-				    Vector.map 
-				    (args, ReplaceInfo.replace o replaceInfo))
-			        | _ => TyconValue.newUnknown cons
-		       in
-			 VarInfo.pushTyconValue'
-			 (varInfo x, tyconValue, addPost)
-		       end
-		  else ()
-	     | _ => ()
+        = case Type.dest ty
+            of Type.Datatype tycon
+             => if optimizeTycon tycon
+                  then let
+                         val cons = TyconInfo.cons (tyconInfo tycon)
+                         val tyconValue
+                           = case exp
+                               of SOME (ConApp {con, args})
+                                => TyconValue.newKnown 
+                                   (cons, con, 
+                                    Vector.map 
+                                    (args, ReplaceInfo.replace o replaceInfo))
+                                | _ => TyconValue.newUnknown cons
+                       in
+                         VarInfo.pushTyconValue'
+                         (varInfo x, tyconValue, addPost)
+                       end
+                  else ()
+             | _ => ()
 
       fun bindVarArgs' (args, addPost)
-	= Vector.foreach 
-	  (args, fn (x, ty) =>
-	   bindVar' (x, ty, NONE, addPost))
+        = Vector.foreach 
+          (args, fn (x, ty) =>
+           bindVar' (x, ty, NONE, addPost))
       fun bindVarArgs args = bindVarArgs' (args, ignore)
       fun bindVarStatement' (Statement.T {var, ty, exp}, addPost)
-	= Option.app 
-	  (var, fn x => 
-	   bindVar' (x, ty, SOME exp, addPost))
+        = Option.app 
+          (var, fn x => 
+           bindVar' (x, ty, SOME exp, addPost))
       fun bindVarStatements' (statements, addPost)
-	= Vector.foreach 
-	  (statements, fn statement => 
-	   bindVarStatement' (statement, addPost))
+        = Vector.foreach 
+          (statements, fn statement => 
+           bindVarStatement' (statement, addPost))
       fun bindVarStatements statements = bindVarStatements' (statements, ignore)
 
       val _ = bindVarStatements globals
       (* Diagnostics *)
       val _ = Control.diagnostics
-	      (fn display =>
-	       let open Layout
-	       in
-		 Vector.foreach
-		 (globals, fn Statement.T {var, ...} => 
-		  Option.app
-		  (var, fn x =>
-		   let val vi = varInfo x
-		   in 
-		     display (seq [Var.layout x, str " ",
-				   VarInfo.layout vi])
-		   end))
-	       end)
+              (fn display =>
+               let open Layout
+               in
+                 Vector.foreach
+                 (globals, fn Statement.T {var, ...} => 
+                  Option.app
+                  (var, fn x =>
+                   let val vi = varInfo x
+                   in 
+                     display (seq [Var.layout x, str " ",
+                                   VarInfo.layout vi])
+                   end))
+               end)
 
       (* labelInfo *)
       val {get = labelInfo: Label.t -> LabelInfo.t, 
-	   set = setLabelInfo, ...}
-	= Property.getSetOnce
-	  (Label.plist, Property.initRaise ("knownCase.labelInfo", Label.layout))
+           set = setLabelInfo, ...}
+        = Property.getSetOnce
+          (Label.plist, Property.initRaise ("knownCase.labelInfo", Label.layout))
 
       val functions
-	= List.revMap
-	  (functions, fn f =>
-	   let
-	     val {args, blocks, mayInline, name, raises, returns, start} =
-		Function.dest f
-	     val _ = Vector.foreach
-	             (blocks, fn block as Block.T {label, ...} =>
-		      setLabelInfo (label, LabelInfo.new block))
-	     val _ = Vector.foreach
-	             (blocks, fn Block.T {label, transfer, ...} =>
-		      Transfer.foreachLabel
-		      (transfer, fn l =>
-		       let val li = labelInfo l
-		       in LabelInfo.addPred (li, label)
-		       end))
-	     (* Diagnostics *)
-	     val _ = Control.diagnostics
-	             (fn display =>
-		      let open Layout
-		      in
-			Vector.foreach
-			(blocks, fn Block.T {label, ...} =>
-			 let val li = labelInfo label
-			 in 
-			   display (seq [Label.layout label, str " ",
-					 LabelInfo.layout li])
-			 end)
-		      end)
+        = List.revMap
+          (functions, fn f =>
+           let
+             val {args, blocks, mayInline, name, raises, returns, start} =
+                Function.dest f
+             val _ = Vector.foreach
+                     (blocks, fn block as Block.T {label, ...} =>
+                      setLabelInfo (label, LabelInfo.new block))
+             val _ = Vector.foreach
+                     (blocks, fn Block.T {label, transfer, ...} =>
+                      Transfer.foreachLabel
+                      (transfer, fn l =>
+                       let val li = labelInfo l
+                       in LabelInfo.addPred (li, label)
+                       end))
+             (* Diagnostics *)
+             val _ = Control.diagnostics
+                     (fn display =>
+                      let open Layout
+                      in
+                        Vector.foreach
+                        (blocks, fn Block.T {label, ...} =>
+                         let val li = labelInfo label
+                         in 
+                           display (seq [Label.layout label, str " ",
+                                         LabelInfo.layout li])
+                         end)
+                      end)
 
-	     val newBlocks = ref []
-	     fun addBlock block = List.push (newBlocks, block)
-	     fun addNewBlock (block as Block.T {label, ...}) 
-	       = (setLabelInfo (label, LabelInfo.new block); 
-		  addBlock block)
-	     local 
-	       val table: {hash: word,
-			   transfer: Transfer.t,
-			   label: Label.t} HashSet.t
-		 = HashSet.new {hash = #hash}
-	     in
-		fun newBlock transfer =
-		   let
-		      val label = Label.newNoname ()
-		      val block = Block.T {label = label,
-					   args = Vector.new0 (),
-					   statements = Vector.new0 (),
-					   transfer = transfer}
-		      val _ = addNewBlock block
-		   in
-		      label
-		   end
-		(* newBlock' isn't used, because it shares blocks that causes
-		 * violation of the requirements for profiling information --
-		 * namely that each block correspond to a unique sequence of
-		 * source infos at it' start.
-		 *
-		 * I left the code in case we want to enable it when compiling
-		 * without profiling.
-		 *)
-		fun newBlock' transfer
-		 = let
-		     val hash = Transfer.hash transfer
-		     val {label, ...}
-		       = HashSet.lookupOrInsert
-		         (table, hash,
-			  fn {transfer = transfer', ...} =>
-			  Transfer.equals (transfer, transfer'),
-			  fn () => {hash = hash,
-				    label = newBlock transfer,
-				    transfer = transfer})
-		   in
-		     label
-		   end
-		val _ = newBlock' (* quell unused variable warning *)
-	       fun bugBlock () = newBlock Bug
-	     end
+             val newBlocks = ref []
+             fun addBlock block = List.push (newBlocks, block)
+             fun addNewBlock (block as Block.T {label, ...}) 
+               = (setLabelInfo (label, LabelInfo.new block); 
+                  addBlock block)
+             local 
+               val table: {hash: word,
+                           transfer: Transfer.t,
+                           label: Label.t} HashSet.t
+                 = HashSet.new {hash = #hash}
+             in
+                fun newBlock transfer =
+                   let
+                      val label = Label.newNoname ()
+                      val block = Block.T {label = label,
+                                           args = Vector.new0 (),
+                                           statements = Vector.new0 (),
+                                           transfer = transfer}
+                      val _ = addNewBlock block
+                   in
+                      label
+                   end
+                (* newBlock' isn't used, because it shares blocks that causes
+                 * violation of the requirements for profiling information --
+                 * namely that each block correspond to a unique sequence of
+                 * source infos at it' start.
+                 *
+                 * I left the code in case we want to enable it when compiling
+                 * without profiling.
+                 *)
+                fun newBlock' transfer
+                 = let
+                     val hash = Transfer.hash transfer
+                     val {label, ...}
+                       = HashSet.lookupOrInsert
+                         (table, hash,
+                          fn {transfer = transfer', ...} =>
+                          Transfer.equals (transfer, transfer'),
+                          fn () => {hash = hash,
+                                    label = newBlock transfer,
+                                    transfer = transfer})
+                   in
+                     label
+                   end
+                val _ = newBlock' (* quell unused variable warning *)
+               fun bugBlock () = newBlock Bug
+             end
 
-	     val traceRewriteGoto
-	       = Trace.trace
-	         ("KnownCase.rewriteGoto",
-		  fn {dst, args} =>
-		  Layout.record
-		  [("dst", Label.layout dst),
-		   ("args", Vector.layout Var.layout args)],
-		  Option.layout
-		  (Layout.tuple2
-		   (Vector.layout Statement.layout,
-		    Transfer.layout)))
-	     val traceRewriteCase
-	       = Trace.trace
-	         ("KnownCase.rewriteCase",
-		  fn {test, cases, default} =>
-		  Layout.record
-		  [("test", Var.layout test),
-		   ("cases", Vector.layout 
-		             (Layout.tuple2 (Con.layout, Label.layout))
-			     cases),
-		   ("default", Option.layout Label.layout default)],
-		  Option.layout
-		  (Layout.tuple2
-		   (Vector.layout Statement.layout,
-		    Transfer.layout)))
-	     val traceRewriteTransfer
-	       = Trace.trace
-	         ("KnownCase.rewriteTransfer",
-		  Transfer.layout,
-		  Option.layout
-		  (Layout.tuple2
-		   (Vector.layout Statement.layout,
-		    Transfer.layout)))
+             val traceRewriteGoto
+               = Trace.trace
+                 ("KnownCase.rewriteGoto",
+                  fn {dst, args} =>
+                  Layout.record
+                  [("dst", Label.layout dst),
+                   ("args", Vector.layout Var.layout args)],
+                  Option.layout
+                  (Layout.tuple2
+                   (Vector.layout Statement.layout,
+                    Transfer.layout)))
+             val traceRewriteCase
+               = Trace.trace
+                 ("KnownCase.rewriteCase",
+                  fn {test, cases, default} =>
+                  Layout.record
+                  [("test", Var.layout test),
+                   ("cases", Vector.layout 
+                             (Layout.tuple2 (Con.layout, Label.layout))
+                             cases),
+                   ("default", Option.layout Label.layout default)],
+                  Option.layout
+                  (Layout.tuple2
+                   (Vector.layout Statement.layout,
+                    Transfer.layout)))
+             val traceRewriteTransfer
+               = Trace.trace
+                 ("KnownCase.rewriteTransfer",
+                  Transfer.layout,
+                  Option.layout
+                  (Layout.tuple2
+                   (Vector.layout Statement.layout,
+                    Transfer.layout)))
 
-	     fun rewriteGoto' {dst, args} :
+             fun rewriteGoto' {dst, args} :
                               (Statement.t vector * Transfer.t) option
-	       = let
-		   val li = labelInfo dst
-		   val Block.T {args = argsDst,
-				statements = statementsDst,
-				transfer = transferDst, ...}
-		     = LabelInfo.block li
-		   val depthDst = LabelInfo.depth' li
-		 in
-		   if depthDst <= 2
-		      andalso
-		      Vector.fold
-		      (statementsDst, 0,
-		       fn (Statement.T {exp = Profile _, ...}, i) => i
-		        | (_, i) => i + 1) <= 0
-		     then let
-			    val {addPost, post} = mkPost ()
-			    val _ = LabelInfo.pushDepth' (li, addPost)
+               = let
+                   val li = labelInfo dst
+                   val Block.T {args = argsDst,
+                                statements = statementsDst,
+                                transfer = transferDst, ...}
+                     = LabelInfo.block li
+                   val depthDst = LabelInfo.depth' li
+                 in
+                   if depthDst <= 2
+                      andalso
+                      Vector.fold
+                      (statementsDst, 0,
+                       fn (Statement.T {exp = Profile _, ...}, i) => i
+                        | (_, i) => i + 1) <= 0
+                     then let
+                            val {addPost, post} = mkPost ()
+                            val _ = LabelInfo.pushDepth' (li, addPost)
 
-			    val vars = Vector.map2
-			               (args, argsDst,
-					fn (x, (z, ty)) =>
-					(x, Var.newNoname (), 
-					 z, Var.newNoname (), ty))
+                            val vars = Vector.map2
+                                       (args, argsDst,
+                                        fn (x, (z, ty)) =>
+                                        (x, Var.newNoname (), 
+                                         z, Var.newNoname (), ty))
 
-			    val moves1
-			      = if depthDst > 0
-				  then Vector.map
-				       (vars, fn (_, _, z, t, ty) =>
-					(if optimizeType ty
-					   then let
-						  val zvi = varInfo z
-						  val tvi = varInfo t
-						in
-						  VarInfo.pushTyconValue'
-						  (tvi,
-						   valOf (VarInfo.tyconValue zvi),
-						   addPost)
-						end
-					   else ();
-					 ReplaceInfo.nextReplace'
-					 (replaceInfo z, t, addPost);
-					 Statement.T {var = SOME t,
-						      ty = ty,
-						      exp = Var z}))
-				  else Vector.new0 ()
-			    val moves2
-			      = Vector.map
-			        (vars, fn (x, t, _, _, ty) =>
-				 (if optimizeType ty
-				    then let
-					   val xvi = varInfo x
-					   val tvi = varInfo t
-					 in
-					   VarInfo.pushTyconValue'
-					   (tvi,
-					    valOf (VarInfo.tyconValue xvi),
-					    addPost)
-					 end
-				    else ();
-				  Statement.T {var = SOME t,
-					       ty = ty,
-					       exp = Var x}))
-			    val moves3
-			      = Vector.map
-			        (vars, fn (_, t, z, _, ty) =>
-				 (if optimizeType ty
-				    then let
-					   val tvi = varInfo t
-					   val zvi = varInfo z
-					 in
-					   VarInfo.pushTyconValue'
-					   (zvi,
-					    valOf (VarInfo.tyconValue tvi),
-					    addPost)
-					 end
-				    else ();
-				  Statement.T {var = SOME z,
-					       ty = ty,
-					       exp = Var t}))
-			    val _ = bindVarStatements' (statementsDst, addPost)
-			  in
-			    (case rewriteTransfer transferDst
-			       of NONE => NONE
-			        | SOME (newStatements, newTransfer)
-				=> SOME (Vector.concat [moves1, moves2, moves3, 
-							statementsDst,
-							newStatements],
-					 newTransfer))
-			    before (post ())
-			  end
-		     else NONE
-		 end
-	     and rewriteGoto goto = traceRewriteGoto
-	                            rewriteGoto'
-				    goto
+                            val moves1
+                              = if depthDst > 0
+                                  then Vector.map
+                                       (vars, fn (_, _, z, t, ty) =>
+                                        (if optimizeType ty
+                                           then let
+                                                  val zvi = varInfo z
+                                                  val tvi = varInfo t
+                                                in
+                                                  VarInfo.pushTyconValue'
+                                                  (tvi,
+                                                   valOf (VarInfo.tyconValue zvi),
+                                                   addPost)
+                                                end
+                                           else ();
+                                         ReplaceInfo.nextReplace'
+                                         (replaceInfo z, t, addPost);
+                                         Statement.T {var = SOME t,
+                                                      ty = ty,
+                                                      exp = Var z}))
+                                  else Vector.new0 ()
+                            val moves2
+                              = Vector.map
+                                (vars, fn (x, t, _, _, ty) =>
+                                 (if optimizeType ty
+                                    then let
+                                           val xvi = varInfo x
+                                           val tvi = varInfo t
+                                         in
+                                           VarInfo.pushTyconValue'
+                                           (tvi,
+                                            valOf (VarInfo.tyconValue xvi),
+                                            addPost)
+                                         end
+                                    else ();
+                                  Statement.T {var = SOME t,
+                                               ty = ty,
+                                               exp = Var x}))
+                            val moves3
+                              = Vector.map
+                                (vars, fn (_, t, z, _, ty) =>
+                                 (if optimizeType ty
+                                    then let
+                                           val tvi = varInfo t
+                                           val zvi = varInfo z
+                                         in
+                                           VarInfo.pushTyconValue'
+                                           (zvi,
+                                            valOf (VarInfo.tyconValue tvi),
+                                            addPost)
+                                         end
+                                    else ();
+                                  Statement.T {var = SOME z,
+                                               ty = ty,
+                                               exp = Var t}))
+                            val _ = bindVarStatements' (statementsDst, addPost)
+                          in
+                            (case rewriteTransfer transferDst
+                               of NONE => NONE
+                                | SOME (newStatements, newTransfer)
+                                => SOME (Vector.concat [moves1, moves2, moves3, 
+                                                        statementsDst,
+                                                        newStatements],
+                                         newTransfer))
+                            before (post ())
+                          end
+                     else NONE
+                 end
+             and rewriteGoto goto = traceRewriteGoto
+                                    rewriteGoto'
+                                    goto
 
-	     and rewriteCase' {test, cases, default} :
+             and rewriteCase' {test, cases, default} :
                               (Statement.t vector * Transfer.t) option
 
-	       = let
-		   val {addPost, post} = mkPost ()
+               = let
+                   val {addPost, post} = mkPost ()
 
-		   val testvi = varInfo test
-		   val tyconValue as conValues
-		     = case VarInfo.tyconValue testvi
-			 of SOME tyconValue => tyconValue
-			  | _ => Error.bug "KnownCase.rewriteCase:tyconValue"
-		    val cons = TyconValue.cons tyconValue
-		    val numCons = Vector.length cons
-		      
-		    datatype z = None
-		               | One of (Con.t * ConValue.v)
-		               | Many
+                   val testvi = varInfo test
+                   val tyconValue as conValues
+                     = case VarInfo.tyconValue testvi
+                         of SOME tyconValue => tyconValue
+                          | _ => Error.bug "KnownCase.rewriteCase: tyconValue"
+                    val cons = TyconValue.cons tyconValue
+                    val numCons = Vector.length cons
+                      
+                    datatype z = None
+                               | One of (Con.t * ConValue.v)
+                               | Many
 
-		    fun doOneSome (con, args)
-		      = let
-			  val goto
-			    = case Vector.peek
-			           (cases, fn (con', _) =>
-				    Con.equals (con, con'))
-				of SOME (_, dst)
-				 => {dst = dst, args = Vector.map (args, !)}
-				 | NONE
-				 => {dst = valOf default,
-				     args = Vector.new0 ()}
-			in
-			  case rewriteGoto goto
-			    of NONE => SOME (Vector.new0 (), Transfer.Goto goto)
-			     | sst => sst
-			end
-		    val doOneSome
-		      = Trace.trace
-		        ("KnownCase.doOneSome",
-			 Layout.ignore, Layout.ignore)
-			doOneSome
+                    fun doOneSome (con, args)
+                      = let
+                          val goto
+                            = case Vector.peek
+                                   (cases, fn (con', _) =>
+                                    Con.equals (con, con'))
+                                of SOME (_, dst)
+                                 => {dst = dst, args = Vector.map (args, !)}
+                                 | NONE
+                                 => {dst = valOf default,
+                                     args = Vector.new0 ()}
+                        in
+                          case rewriteGoto goto
+                            of NONE => SOME (Vector.new0 (), Transfer.Goto goto)
+                             | sst => sst
+                        end
+                    val doOneSome
+                      = Trace.trace
+                        ("KnownCase.doOneSome",
+                         Layout.ignore, Layout.ignore)
+                        doOneSome
 
-		    fun rewriteDefault conValues'
-		      = let
-			  val _ = VarInfo.pushTyconValue'
-			          (testvi, conValues', addPost)
-			in
-			  rewriteGoto {dst = valOf default, args = Vector.new0 ()}
-			end
-		    val rewriteDefault
-		      = Trace.trace
-		        ("KnownCase.rewriteDefault",
-			 Layout.ignore, Layout.ignore)
-			rewriteDefault
+                    fun rewriteDefault conValues'
+                      = let
+                          val _ = VarInfo.pushTyconValue'
+                                  (testvi, conValues', addPost)
+                        in
+                          rewriteGoto {dst = valOf default, args = Vector.new0 ()}
+                        end
+                    val rewriteDefault
+                      = Trace.trace
+                        ("KnownCase.rewriteCase.rewriteDefault",
+                         Layout.ignore, Layout.ignore)
+                        rewriteDefault
 
 fun doOneNone con
   = let
       fun doit dst
-	= SOME (Vector.new0 (),
-		Case
-		{test = test,
-		 cases = Cases.Con (Vector.new1 (con, dst)),
-		 default = if numCons = 1
-			     then NONE
-			     else SOME (bugBlock ())})
+        = SOME (Vector.new0 (),
+                Case
+                {test = test,
+                 cases = Cases.Con (Vector.new1 (con, dst)),
+                 default = if numCons = 1
+                             then NONE
+                             else SOME (bugBlock ())})
     in
       case Vector.peek
-	   (cases, fn (con', _) =>
-	    Con.equals (con, con'))
-	of SOME (_, dst) => doit dst
+           (cases, fn (con', _) =>
+            Con.equals (con, con'))
+        of SOME (_, dst) => doit dst
          | NONE
-	 => let
-	      val args 
-		= Vector.map
-		  (ConInfo.args (conInfo con),
-		   fn ty => 
-		   let
-		     val x = Var.newNoname ()
-		     val xvi = varInfo x
-		     val _ = case Type.dest ty
-			       of Type.Datatype tycon
-				=> if optimizeTycon tycon
-				     then VarInfo.pushTyconValue'
-				          (xvi,
-					   TyconValue.newUnknown
-					   (TyconInfo.cons (tyconInfo tycon)),
-					   addPost)
-				     else ()
-				| _ => ()
-		   in
-		     (x, ty)
-		   end)
-	      val (xs, _) = Vector.unzip args
-	      val conValues' = TyconValue.newKnown 
-		               (cons, con,
-				Vector.map 
-				(xs, ReplaceInfo.replace o replaceInfo))
-	      val label = Label.newNoname ()
-	      val (statements, transfer)
-		= case rewriteDefault conValues'
-		    of SOME sst => sst
-		     | NONE => (Vector.new0 (),
-				Goto {dst = valOf default,
-				      args = Vector.new0 ()})
-	      val block = Block.T
-		          {label = label,
-			   args = args,
-			   statements = statements,
-			   transfer = transfer}
-	      val _ = addNewBlock block
-	    in
-	      doit label
-	    end
+         => let
+              val args 
+                = Vector.map
+                  (ConInfo.args (conInfo con),
+                   fn ty => 
+                   let
+                     val x = Var.newNoname ()
+                     val xvi = varInfo x
+                     val _ = case Type.dest ty
+                               of Type.Datatype tycon
+                                => if optimizeTycon tycon
+                                     then VarInfo.pushTyconValue'
+                                          (xvi,
+                                           TyconValue.newUnknown
+                                           (TyconInfo.cons (tyconInfo tycon)),
+                                           addPost)
+                                     else ()
+                                | _ => ()
+                   in
+                     (x, ty)
+                   end)
+              val (xs, _) = Vector.unzip args
+              val conValues' = TyconValue.newKnown 
+                               (cons, con,
+                                Vector.map 
+                                (xs, ReplaceInfo.replace o replaceInfo))
+              val label = Label.newNoname ()
+              val (statements, transfer)
+                = case rewriteDefault conValues'
+                    of SOME sst => sst
+                     | NONE => (Vector.new0 (),
+                                Goto {dst = valOf default,
+                                      args = Vector.new0 ()})
+              val block = Block.T
+                          {label = label,
+                           args = args,
+                           statements = statements,
+                           transfer = transfer}
+              val _ = addNewBlock block
+            in
+              doit label
+            end
     end
 val doOneNone
   = Trace.trace
-    ("KnownCase.doOneNone",
+    ("KnownCase.rewriteCase.doOneNone",
      Layout.ignore, Layout.ignore)
     doOneNone
 
@@ -727,313 +728,313 @@
   = let
       val usedCons = Array.new (numCons, false)
       val cases = Vector.keepAllMap
-	          (cases, fn (con, dst) =>
-		   let
-		     val conIndex = ConInfo.index (conInfo con)
-		     val _ = Array.update (usedCons, conIndex, true)
-		   in
-		     if ConValue.isTop (Vector.sub (conValues, conIndex))
-		       then SOME (con, dst)
-		       else NONE
-		   end)
+                  (cases, fn (con, dst) =>
+                   let
+                     val conIndex = ConInfo.index (conInfo con)
+                     val _ = Array.update (usedCons, conIndex, true)
+                   in
+                     if ConValue.isTop (Vector.sub (conValues, conIndex))
+                       then SOME (con, dst)
+                       else NONE
+                   end)
       val (cases, default)
-	= case default
-	    of NONE => (cases, NONE)
-	     | SOME dst
-	     => let
-		  val conValues' = Vector.mapi
-		                   (cons, fn (i, con) =>
-				    if Array.sub (usedCons, i)
-				      then ConValue.new con
-				      else Vector.sub (conValues, i))
+        = case default
+            of NONE => (cases, NONE)
+             | SOME dst
+             => let
+                  val conValues' = Vector.mapi
+                                   (cons, fn (i, con) =>
+                                    if Array.sub (usedCons, i)
+                                      then ConValue.new con
+                                      else Vector.sub (conValues, i))
 
-		  fun route (statements, (cases, default))
-		    = if Vector.length statements = 0
-			then (cases, default)
-			else let
-			       fun route' dst
-				 = let
-				     val Block.T {args, ...} 
-				       = LabelInfo.block (labelInfo dst)
-				       
-				     val label = Label.newNoname ()
-				     val args = Vector.map
-				                (args, fn (_, ty) => 
-						 (Var.newNoname (), ty))
-				     val xs = Vector.map (args, #1)
-				     val block = Block.T
-				                 {label = label,
-						  args = args,
-						  statements = statements,
-						  transfer = Goto {dst = dst,
-								   args = xs}}
-				     val _ = addNewBlock block
-				   in
-				     label
-				   end
-			     in
-			       (Vector.map (cases, fn (con, dst) => (con, route' dst)),
-				Option.map (default, route'))
-			     end
+                  fun route (statements, (cases, default))
+                    = if Vector.length statements = 0
+                        then (cases, default)
+                        else let
+                               fun route' dst
+                                 = let
+                                     val Block.T {args, ...} 
+                                       = LabelInfo.block (labelInfo dst)
+                                       
+                                     val label = Label.newNoname ()
+                                     val args = Vector.map
+                                                (args, fn (_, ty) => 
+                                                 (Var.newNoname (), ty))
+                                     val xs = Vector.map (args, #1)
+                                     val block = Block.T
+                                                 {label = label,
+                                                  args = args,
+                                                  statements = statements,
+                                                  transfer = Goto {dst = dst,
+                                                                   args = xs}}
+                                     val _ = addNewBlock block
+                                   in
+                                     label
+                                   end
+                             in
+                               (Vector.map (cases, fn (con, dst) => (con, route' dst)),
+                                Option.map (default, route'))
+                             end
 
-		in
-		  case rewriteDefault conValues'
-		    of SOME (statements, 
-			     Case {test = test', 
-				   cases = Cases.Con cases',
-				   default = default'})
-		     => if Option.equals
-		           (SOME test,
-			    Vector.foldr
-			    (statements, SOME test',
-			     fn (Statement.T _, NONE) => NONE
-			      | (Statement.T {var, exp, ...}, SOME test') =>
-			     if Option.equals (var, SOME test', Var.equals)
-			       then case exp
-				      of Var test' => SOME test'
-				       | _ => NONE
-			       else SOME test'),
-			    Var.equals)
-			  then let
-				 val (cases', default') 
-				   = route (statements, (cases', default'))
-			       in
-				 (Vector.concat [cases, cases'], default')
-			       end
-			  else (cases, SOME dst)
-		     | SOME (statements, transfer)
-		     => let
-			  val label
-			    = if Vector.length statements = 0
-				then newBlock transfer
-				else let
-				       val label = Label.newNoname ()
-				       val block = Block.T
-					           {label = label,
-						    args = Vector.new0 (),
-						    statements = statements,
-						    transfer = transfer}
-				       val _ = addNewBlock block
-				     in
-				       label
-				     end
-			in
-			  (cases, SOME label)
-			end
-		     | NONE => (cases, SOME dst)
-		end
+                in
+                  case rewriteDefault conValues'
+                    of SOME (statements, 
+                             Case {test = test', 
+                                   cases = Cases.Con cases',
+                                   default = default'})
+                     => if Option.equals
+                           (SOME test,
+                            Vector.foldr
+                            (statements, SOME test',
+                             fn (Statement.T _, NONE) => NONE
+                              | (Statement.T {var, exp, ...}, SOME test') =>
+                             if Option.equals (var, SOME test', Var.equals)
+                               then case exp
+                                      of Var test' => SOME test'
+                                       | _ => NONE
+                               else SOME test'),
+                            Var.equals)
+                          then let
+                                 val (cases', default') 
+                                   = route (statements, (cases', default'))
+                               in
+                                 (Vector.concat [cases, cases'], default')
+                               end
+                          else (cases, SOME dst)
+                     | SOME (statements, transfer)
+                     => let
+                          val label
+                            = if Vector.length statements = 0
+                                then newBlock transfer
+                                else let
+                                       val label = Label.newNoname ()
+                                       val block = Block.T
+                                                   {label = label,
+                                                    args = Vector.new0 (),
+                                                    statements = statements,
+                                                    transfer = transfer}
+                                       val _ = addNewBlock block
+                                     in
+                                       label
+                                     end
+                        in
+                          (cases, SOME label)
+                        end
+                     | NONE => (cases, SOME dst)
+                end
       val numCases = Vector.length cases
       fun doit (cases, default)
-	= SOME (Vector.new0 (),
-		Case {test = test,
-		      cases = Cases.Con cases,
-		      default = default})
+        = SOME (Vector.new0 (),
+                Case {test = test,
+                      cases = Cases.Con cases,
+                      default = default})
     in
       if numCases = numCons
-	then doit (cases, NONE)
-	else doit (cases,
-		   case default
-		     of SOME _ => default
-		      | NONE => SOME (bugBlock ()))
+        then doit (cases, NONE)
+        else doit (cases,
+                   case default
+                     of SOME _ => default
+                      | NONE => SOME (bugBlock ()))
     end
 val doMany
   = Trace.trace
-    ("KnownCase.doMany",
+    ("KnownCase.rewriteCase.doMany",
      Layout.ignore, Layout.ignore)
     doMany
 
-		 in
+                 in
 (*
-		   (if Vector.forall
-		       (conValues, ConValue.isTop)
+                   (if Vector.forall
+                       (conValues, ConValue.isTop)
 *)
-		   (if false
-		      then NONE
-		      else case Vector.foldi
-			        (conValues, None, 
-				 fn (_, _, Many) => Many
-				  | (_, conValue, One ccv)
-				  => (case conValue
-					of (_, NONE) => One ccv
-					 | (_, SOME _) => Many)
-				  | (_, conValue, None)
-				  => (case conValue
-					of (_, NONE) => None
-					 | (con, SOME cv) => One (con, cv)))
-			     of None => SOME (Vector.new0 (), Bug)
-			      | One (con, SOME args) => doOneSome (con, args)
-			      | One (con, NONE) => doOneNone con
-			      | Many => doMany ())
-		   before (post ())
-		 end
-	     and rewriteCase casee = traceRewriteCase
-	                             rewriteCase'
-				     casee
+                   (if false
+                      then NONE
+                      else case Vector.foldi
+                                (conValues, None, 
+                                 fn (_, _, Many) => Many
+                                  | (_, conValue, One ccv)
+                                  => (case conValue
+                                        of (_, NONE) => One ccv
+                                         | (_, SOME _) => Many)
+                                  | (_, conValue, None)
+                                  => (case conValue
+                                        of (_, NONE) => None
+                                         | (con, SOME cv) => One (con, cv)))
+                             of None => SOME (Vector.new0 (), Bug)
+                              | One (con, SOME args) => doOneSome (con, args)
+                              | One (con, NONE) => doOneNone con
+                              | Many => doMany ())
+                   before (post ())
+                 end
+             and rewriteCase casee = traceRewriteCase
+                                     rewriteCase'
+                                     casee
 
-	     and rewriteTransfer' (transfer: Transfer.t) : 
-	                          (Statement.t vector * Transfer.t) option
-	       = case transfer
-		   of Goto {dst, args} => rewriteGoto {dst = dst, args = args}
-	            | Case {test, cases = Cases.Con cases, default}
-		    => rewriteCase {test = test, cases = cases, default = default}
-		    | _ => NONE
-	     and rewriteTransfer transfer = traceRewriteTransfer
-	                                    rewriteTransfer'
-					    transfer
+             and rewriteTransfer' (transfer: Transfer.t) : 
+                                  (Statement.t vector * Transfer.t) option
+               = case transfer
+                   of Goto {dst, args} => rewriteGoto {dst = dst, args = args}
+                    | Case {test, cases = Cases.Con cases, default}
+                    => rewriteCase {test = test, cases = cases, default = default}
+                    | _ => NONE
+             and rewriteTransfer transfer = traceRewriteTransfer
+                                            rewriteTransfer'
+                                            transfer
 
-	     fun activateGoto {dst, args}
-	       = let
-		   val liDst = labelInfo dst
-		   val Block.T {args = argsDst, ...}
-		     = LabelInfo.block liDst
-		 in
-		   if LabelInfo.onePred liDst
-		     then Vector.foreach2
-		          (args, argsDst, fn (x, (y, ty)) =>
-			   if optimizeType ty
-			     then let
-				    val xvi = varInfo x
-				    val yvi = varInfo y
-				    val conValues' 
-				      = valOf (VarInfo.tyconValue xvi)
-				  in
-				    LabelInfo.addActivation
-				    (liDst, (yvi, conValues'))
-				  end
-			     else ())
-		     else ()
-		 end
-	     fun activateCase {test, cases, default}
-	       = let
-		   val testvi = varInfo test
-		   val tyconValue as conValues
-		     = case VarInfo.tyconValue testvi
-			 of NONE => Error.bug "KnownCase.activateTransfer:tyconValue"
-			  | SOME tyconValue => tyconValue
-		   val cons = TyconValue.cons tyconValue
-		   val numCons = Vector.length cons
-		     
-		   val usedCons = Array.new (numCons, false)
-		 in
-		   Vector.foreach
-		   (cases, fn (con, dst) =>
-		    let
-		      val conIndex = ConInfo.index (conInfo con)
-		      val _ = Array.update (usedCons, conIndex, true)
-		      val liDst = labelInfo dst
-		      val Block.T {args = argsDst, ...}
-			= LabelInfo.block liDst
-		      val conValues' 
-			= TyconValue.newKnown 
-			  (cons, con, 
-			   Vector.map 
-			   (argsDst, ReplaceInfo.replace o replaceInfo o #1))
-		    in
-		      if LabelInfo.onePred liDst
-			then LabelInfo.addActivation
-			     (liDst, (testvi, conValues'))
-			else ()
-		    end);
-		   Option.app
-		   (default, fn dst =>
-		    let
-		      val liDst = labelInfo dst
-		      val conValues' = Vector.mapi
-			               (cons, fn (i, con) =>
-					if Array.sub (usedCons, i)
-					  then ConValue.new con
-					  else Vector.sub (conValues, i))
-		    in
-		      if LabelInfo.onePred liDst
-			then LabelInfo.addActivation
-			     (liDst, (testvi, conValues'))
-			else ()
-		    end)
-		 end
-	     fun activateTransfer transfer
-	       = case transfer
-		   of Goto {dst, args}
-		    => activateGoto {dst = dst, args = args}
-	            | Case {test, cases = Cases.Con cases, default}
-		    => activateCase {test = test, cases = cases, default = default}
-		    | _ => ()
+             fun activateGoto {dst, args}
+               = let
+                   val liDst = labelInfo dst
+                   val Block.T {args = argsDst, ...}
+                     = LabelInfo.block liDst
+                 in
+                   if LabelInfo.onePred liDst
+                     then Vector.foreach2
+                          (args, argsDst, fn (x, (y, ty)) =>
+                           if optimizeType ty
+                             then let
+                                    val xvi = varInfo x
+                                    val yvi = varInfo y
+                                    val conValues' 
+                                      = valOf (VarInfo.tyconValue xvi)
+                                  in
+                                    LabelInfo.addActivation
+                                    (liDst, (yvi, conValues'))
+                                  end
+                             else ())
+                     else ()
+                 end
+             fun activateCase {test, cases, default}
+               = let
+                   val testvi = varInfo test
+                   val tyconValue as conValues
+                     = case VarInfo.tyconValue testvi
+                         of NONE => Error.bug "KnownCase.activateCase: tyconValue"
+                          | SOME tyconValue => tyconValue
+                   val cons = TyconValue.cons tyconValue
+                   val numCons = Vector.length cons
+                     
+                   val usedCons = Array.new (numCons, false)
+                 in
+                   Vector.foreach
+                   (cases, fn (con, dst) =>
+                    let
+                      val conIndex = ConInfo.index (conInfo con)
+                      val _ = Array.update (usedCons, conIndex, true)
+                      val liDst = labelInfo dst
+                      val Block.T {args = argsDst, ...}
+                        = LabelInfo.block liDst
+                      val conValues' 
+                        = TyconValue.newKnown 
+                          (cons, con, 
+                           Vector.map 
+                           (argsDst, ReplaceInfo.replace o replaceInfo o #1))
+                    in
+                      if LabelInfo.onePred liDst
+                        then LabelInfo.addActivation
+                             (liDst, (testvi, conValues'))
+                        else ()
+                    end);
+                   Option.app
+                   (default, fn dst =>
+                    let
+                      val liDst = labelInfo dst
+                      val conValues' = Vector.mapi
+                                       (cons, fn (i, con) =>
+                                        if Array.sub (usedCons, i)
+                                          then ConValue.new con
+                                          else Vector.sub (conValues, i))
+                    in
+                      if LabelInfo.onePred liDst
+                        then LabelInfo.addActivation
+                             (liDst, (testvi, conValues'))
+                        else ()
+                    end)
+                 end
+             fun activateTransfer transfer
+               = case transfer
+                   of Goto {dst, args}
+                    => activateGoto {dst = dst, args = args}
+                    | Case {test, cases = Cases.Con cases, default}
+                    => activateCase {test = test, cases = cases, default = default}
+                    | _ => ()
 
-	     fun rewriteBlock (Block.T {label, args, statements, transfer},
-			       addPost)
-	       = let
-		   val li = labelInfo label
-		   val _ = LabelInfo.pushDepth' (li, addPost)
-		   val _ = bindVarArgs' (args, addPost)
-		   val _ = LabelInfo.activate (li, addPost)
-		   val _ = bindVarStatements' (statements, addPost)
-		   val _ = activateTransfer transfer
-		   val (statements, transfer)
-		     = case rewriteTransfer transfer
-			 of NONE => (statements, transfer)
-			  | SOME (newStatements, newTransfer)
-			  => (Vector.concat [statements,newStatements],
-			      newTransfer)
-		 in
-		    Block.T {label = label,
-			     args = args,
-			     statements = statements,
-			     transfer = transfer}
-		 end
-	     val rewriteBlock
-	       = Trace.trace
-	         ("KnownCase.rewriteBlock",
-		  Layout.tuple2 (Block.layout, Layout.ignore),
-		  Block.layout)
-		 rewriteBlock
+             fun rewriteBlock (Block.T {label, args, statements, transfer},
+                               addPost)
+               = let
+                   val li = labelInfo label
+                   val _ = LabelInfo.pushDepth' (li, addPost)
+                   val _ = bindVarArgs' (args, addPost)
+                   val _ = LabelInfo.activate (li, addPost)
+                   val _ = bindVarStatements' (statements, addPost)
+                   val _ = activateTransfer transfer
+                   val (statements, transfer)
+                     = case rewriteTransfer transfer
+                         of NONE => (statements, transfer)
+                          | SOME (newStatements, newTransfer)
+                          => (Vector.concat [statements,newStatements],
+                              newTransfer)
+                 in
+                    Block.T {label = label,
+                             args = args,
+                             statements = statements,
+                             transfer = transfer}
+                 end
+             val rewriteBlock
+               = Trace.trace
+                 ("KnownCase.rewriteBlock",
+                  Layout.tuple2 (Block.layout, Layout.ignore),
+                  Block.layout)
+                 rewriteBlock
 
-	     fun doitTree tree
-	       = let
-		   fun loop (Tree.T (block, children))
-		     = let
-			 val {addPost, post} = mkPost ()
-			 val block = rewriteBlock (block, addPost)
-		       in
-			 addBlock block ;
-			 Vector.foreach (children, loop) ;
-			 post ()
-		       end
-		   val _ = loop tree
-		 in
-		   Vector.fromListRev (!newBlocks)
-		 end
-	     val _ = bindVarArgs args
-	     val blocks = doitTree (Function.dominatorTree f)
+             fun doitTree tree
+               = let
+                   fun loop (Tree.T (block, children))
+                     = let
+                         val {addPost, post} = mkPost ()
+                         val block = rewriteBlock (block, addPost)
+                       in
+                         addBlock block ;
+                         Vector.foreach (children, loop) ;
+                         post ()
+                       end
+                   val _ = loop tree
+                 in
+                   Vector.fromListRev (!newBlocks)
+                 end
+             val _ = bindVarArgs args
+             val blocks = doitTree (Function.dominatorTree f)
 
-	     val f = Function.new {args = args,
-				   blocks = blocks,
-				   mayInline = mayInline,
-				   name = name,
-				   raises = raises,
-				   returns = returns,
-				   start = start}
-	     val _ = Control.diagnostics
-	             (fn display =>
-		      display (Function.layout f))
-	     val f = eliminateDeadBlocksFunction f
-	     val _ = Control.diagnostics
-	             (fn display =>
-		      display (Function.layout f))
-	     val f = restore f
-	     val _ = Control.diagnostics
-	             (fn display =>
-		      display (Function.layout f))
-	     val f = shrink f
-	     val _ = Control.diagnostics
-	             (fn display =>
-		      display (Function.layout f))
-	     val _ = Function.clear f
-	   in
-	     f
-	   end)
+             val f = Function.new {args = args,
+                                   blocks = blocks,
+                                   mayInline = mayInline,
+                                   name = name,
+                                   raises = raises,
+                                   returns = returns,
+                                   start = start}
+             val _ = Control.diagnostics
+                     (fn display =>
+                      display (Function.layout f))
+             val f = eliminateDeadBlocksFunction f
+             val _ = Control.diagnostics
+                     (fn display =>
+                      display (Function.layout f))
+             val f = restore f
+             val _ = Control.diagnostics
+                     (fn display =>
+                      display (Function.layout f))
+             val f = shrink f
+             val _ = Control.diagnostics
+                     (fn display =>
+                      display (Function.layout f))
+             val _ = Function.clear f
+           in
+             f
+           end)
       val program = Program.T {datatypes = datatypes,
-			       globals = globals,
-			       functions = functions,
-			       main = main}
+                               globals = globals,
+                               functions = functions,
+                               main = main}
       val _ = Program.clearTop program
     in
       program

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ssa/known-case.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ssa/known-case.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ssa/known-case.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature KNOWN_CASE_STRUCTS = 
   sig
     include RESTORE

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ssa/local-flatten.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ssa/local-flatten.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ssa/local-flatten.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 functor LocalFlatten (S: LOCAL_FLATTEN_STRUCTS): LOCAL_FLATTEN = 
 struct
 
@@ -18,54 +19,54 @@
 structure ArgInfo =
    struct
       datatype t = T of {fromTuple: bool ref,
-			 fromForce: t list ref,
-			 toSelect: bool ref,
-			 toForce: t list ref}
+                         fromForce: t list ref,
+                         toSelect: bool ref,
+                         toForce: t list ref}
 
       fun isFlat (T {fromTuple, toSelect, ...}) =
-	 !fromTuple andalso !toSelect
+         !fromTuple andalso !toSelect
 
       val isTupled = not o isFlat
 
       fun layout (i: t): Layout.t =
-	 Layout.str (if isFlat i then "flat" else "tupled")
+         Layout.str (if isFlat i then "flat" else "tupled")
 
       fun new () = T {fromTuple = ref false,
-		      fromForce = ref [],
-		      toSelect = ref true,
-		      toForce = ref []}
+                      fromForce = ref [],
+                      toSelect = ref true,
+                      toForce = ref []}
 
       fun tuple (T {fromTuple = f, fromForce, ...}) =
-	 if !f
-	    then ()
-	 else (f := true; List.foreach (!fromForce, tuple))
+         if !f
+            then ()
+         else (f := true; List.foreach (!fromForce, tuple))
 
       fun nonSelect (T {toSelect = t, toForce, ...}) =
-	 if !t
-	    then (t := false; List.foreach (!toForce, nonSelect))
-	 else ()
-	    
+         if !t
+            then (t := false; List.foreach (!toForce, nonSelect))
+         else ()
+            
       val op <= =
-	 fn (lhs as T {fromTuple = f, fromForce, ...},
-	     rhs as T {toSelect = t, toForce, ...}) =>
-	 let
-	    val _ =
-	       if !f
-		  then tuple rhs
-	       else List.push (fromForce, rhs)
-	    val _ =
-	       if !t
-		  then List.push (toForce, lhs)
-	       else nonSelect lhs
-	 in
-	    ()
-	 end
+         fn (lhs as T {fromTuple = f, fromForce, ...},
+             rhs as T {toSelect = t, toForce, ...}) =>
+         let
+            val _ =
+               if !f
+                  then tuple rhs
+               else List.push (fromForce, rhs)
+            val _ =
+               if !t
+                  then List.push (toForce, lhs)
+               else nonSelect lhs
+         in
+            ()
+         end
    end
 
 structure VarInfo =
    struct
       datatype t =
-	 None
+         None
        | Arg of ArgInfo.t
        | Tuple
    end
@@ -73,225 +74,225 @@
 fun flatten (Program.T {globals, datatypes, functions, main}) =
    let
       val {get = varInfo: Var.t -> VarInfo.t,
-	   set = setVarInfo, ...} =
-	 Property.getSetOnce (Var.plist, Property.initConst VarInfo.None)
+           set = setVarInfo, ...} =
+         Property.getSetOnce (Var.plist, Property.initConst VarInfo.None)
       type argsInfo = (ArgInfo.t * Type.t) option vector
       val {get = labelArgs: Label.t -> argsInfo,
-	   set = setLabelArgs, ...} =
-	 Property.getSetOnce (Label.plist,
-			      Property.initRaise ("args", Label.layout))
+           set = setLabelArgs, ...} =
+         Property.getSetOnce (Label.plist,
+                              Property.initRaise ("args", Label.layout))
       val shrink = shrinkFunction {globals = globals}
       val functions =
-	 List.revMap
-	 (functions, fn f =>
-	  let
-	     val {args, blocks, mayInline, name, raises, returns, start} =
-		Function.dest f
-	     val _ =
-	        Vector.foreach
-		(blocks, fn Block.T {label, args, ...} =>
-		 setLabelArgs (label,
-			       Vector.map
-			       (args, fn (x, t) =>
-				if Type.isTuple t
-				   then
-				      let
-				         val i = ArgInfo.new ()
-					 val _ = setVarInfo (x, VarInfo.Arg i)
-				      in
-				         SOME (i, t)
-				      end
-			        else NONE)))
+         List.revMap
+         (functions, fn f =>
+          let
+             val {args, blocks, mayInline, name, raises, returns, start} =
+                Function.dest f
+             val _ =
+                Vector.foreach
+                (blocks, fn Block.T {label, args, ...} =>
+                 setLabelArgs (label,
+                               Vector.map
+                               (args, fn (x, t) =>
+                                if Type.isTuple t
+                                   then
+                                      let
+                                         val i = ArgInfo.new ()
+                                         val _ = setVarInfo (x, VarInfo.Arg i)
+                                      in
+                                         SOME (i, t)
+                                      end
+                                else NONE)))
 
-	     fun force (x: Var.t): unit =
-	        case varInfo x of
-		   VarInfo.Arg i => ArgInfo.nonSelect i
-		 | _ => ()
-	     fun forces (xs: Var.t vector): unit =
-	        Vector.foreach (xs, force)
-	     fun forceArgs (l: Label.t): unit =
-	        Vector.foreach (labelArgs l,
-				fn NONE => ()
-				 | SOME (i, _) => ArgInfo.nonSelect i)
+             fun force (x: Var.t): unit =
+                case varInfo x of
+                   VarInfo.Arg i => ArgInfo.nonSelect i
+                 | _ => ()
+             fun forces (xs: Var.t vector): unit =
+                Vector.foreach (xs, force)
+             fun forceArgs (l: Label.t): unit =
+                Vector.foreach (labelArgs l,
+                                fn NONE => ()
+                                 | SOME (i, _) => ArgInfo.nonSelect i)
 
-	     fun visit (Block.T {statements, transfer, ...}): unit -> unit =
-	        let
-		   val _ = 
-		      Vector.foreach
-		      (statements, fn Statement.T {var, exp, ...} =>
-		       case exp of
-			  ConApp {args, ...} => forces args
-			| PrimApp {args, ...} => forces args
-			| Tuple args => (setVarInfo (valOf var, VarInfo.Tuple)
-					 ; forces args)
-			| Var x => force x
-			| _ => ())
-		   val _ =
-		      case transfer of
-		         Arith {args, overflow, success, ...} =>
-			    (forces args
-			     ; forceArgs overflow
-			     ; forceArgs success) 
-		       | Bug => ()
-		       | Call {args, return, ...} =>
-			    (forces args
-			     ; Return.foreachLabel (return, forceArgs))
-		       | Case {cases, default, ...} =>
-			    (Cases.foreach (cases, forceArgs)
-			     ; Option.app (default, forceArgs))
-		       | Goto {dst, args} =>
-			    Vector.foreach2
-			    (args, labelArgs dst,
-			     fn (_, NONE) => ()
-			      | (x, SOME (i, _)) =>
-			           (case varInfo x of
-				       VarInfo.Arg i' => ArgInfo.<= (i', i)
-				     | VarInfo.None => ()
-				     | VarInfo.Tuple => ArgInfo.tuple i))
-		       | Raise xs => forces xs
-		       | Return xs => forces xs
-		       | Runtime {args, return, ...} =>
-			    (forces args
-			     ; forceArgs return)
-		in
-		   fn () => ()
-		end
-	     val _ = Function.dfs (f, visit)
-	     val _ = 
-	        Control.diagnostics
-		(fn display =>
-		 let
-		    fun doit x = 
-		       case varInfo x of
-			  VarInfo.Arg i => display (let open Layout
-						    in seq [Var.layout x,
-							    str " ",
-							    ArgInfo.layout i]
-						    end)
-			| _ => ()
-		 in
-		    Vector.foreach
-		    (blocks, fn Block.T {args, statements, ...} =>
-		     (Vector.foreach(args, doit o #1);
-		      Vector.foreach(statements, fn Statement.T {var, ...} =>
-				     Option.app(var, doit))))
-		 end)
+             fun visit (Block.T {statements, transfer, ...}): unit -> unit =
+                let
+                   val _ = 
+                      Vector.foreach
+                      (statements, fn Statement.T {var, exp, ...} =>
+                       case exp of
+                          ConApp {args, ...} => forces args
+                        | PrimApp {args, ...} => forces args
+                        | Tuple args => (setVarInfo (valOf var, VarInfo.Tuple)
+                                         ; forces args)
+                        | Var x => force x
+                        | _ => ())
+                   val _ =
+                      case transfer of
+                         Arith {args, overflow, success, ...} =>
+                            (forces args
+                             ; forceArgs overflow
+                             ; forceArgs success) 
+                       | Bug => ()
+                       | Call {args, return, ...} =>
+                            (forces args
+                             ; Return.foreachLabel (return, forceArgs))
+                       | Case {cases, default, ...} =>
+                            (Cases.foreach (cases, forceArgs)
+                             ; Option.app (default, forceArgs))
+                       | Goto {dst, args} =>
+                            Vector.foreach2
+                            (args, labelArgs dst,
+                             fn (_, NONE) => ()
+                              | (x, SOME (i, _)) =>
+                                   (case varInfo x of
+                                       VarInfo.Arg i' => ArgInfo.<= (i', i)
+                                     | VarInfo.None => ()
+                                     | VarInfo.Tuple => ArgInfo.tuple i))
+                       | Raise xs => forces xs
+                       | Return xs => forces xs
+                       | Runtime {args, return, ...} =>
+                            (forces args
+                             ; forceArgs return)
+                in
+                   fn () => ()
+                end
+             val _ = Function.dfs (f, visit)
+             val _ = 
+                Control.diagnostics
+                (fn display =>
+                 let
+                    fun doit x = 
+                       case varInfo x of
+                          VarInfo.Arg i => display (let open Layout
+                                                    in seq [Var.layout x,
+                                                            str " ",
+                                                            ArgInfo.layout i]
+                                                    end)
+                        | _ => ()
+                 in
+                    Vector.foreach
+                    (blocks, fn Block.T {args, statements, ...} =>
+                     (Vector.foreach(args, doit o #1);
+                      Vector.foreach(statements, fn Statement.T {var, ...} =>
+                                     Option.app(var, doit))))
+                 end)
 
-	     fun makeTuple (formals: (Var.t * Type.t) vector,
-			    reps: argsInfo)
-	       : (Var.t * Type.t) vector * Statement.t list =
-	       let
-		  val (argss, stmts) =
-		     Vector.map2AndFold
-		     (formals, reps, [], fn ((x, ty), rep, stmts) =>
-		      case rep of
-			 NONE => (Vector.new1 (x, ty), stmts)
-		       | SOME (i, _) =>
-			    if ArgInfo.isTupled i
-			       then (Vector.new1 (x, ty), stmts)
-			    else
-			       let
-				  val vars = Vector.map
-				             (Type.deTuple ty, fn ty =>
-					      (Var.newNoname (), ty))
-			       in
-				  (vars,
-				   Statement.T 
-				   {var = SOME x,
-				    ty = ty,
-				    exp = Tuple (Vector.map (vars, #1))}
-				   :: stmts)
-			       end)
-	       in (Vector.concatV argss, stmts)
-	       end
-	     fun makeSelects (args: Var.t vector,
-			      formals: argsInfo)
-	       : Var.t vector * Statement.t list =
-	       let
-		  val (argss, stmts) =
-		     Vector.map2AndFold
-		     (args, formals, [], fn (x, formal, stmts) =>
-		      case formal of
-			 NONE => (Vector.new1 x, stmts)
-		       | SOME (i, t) =>
-			    if ArgInfo.isTupled i
-			       then (Vector.new1 x, stmts)
-			    else 
-			       let
-				  val (vars, stmts) =
-				     Vector.foldi
-				     (Type.deTuple t, ([], stmts),
-				      fn (i, ty, (vars, stmts)) =>
-				      let val var = Var.newNoname ()
-				      in (var :: vars,
-					  Statement.T
-					  {var = SOME var,
-					   ty = ty,
-					   exp = Select {tuple = x,
-							 offset = i}}
-					  :: stmts)
-				      end)
-			       in (Vector.fromListRev vars, stmts)
-			       end)
-	       in (Vector.concatV argss, stmts)
-	       end
-	     fun anyFlat (v: argsInfo): bool =
-	        Vector.exists (v,
-			       fn NONE => false
-			        | SOME (i, _) => ArgInfo.isFlat i)
-	     val blocks =
-	        Vector.map
-		(blocks, fn Block.T {label, args, statements, transfer} =>
-		 let
-		    val (args, pre) =
-		       let
-			  val formals = labelArgs label
-		       in
-			  if anyFlat formals
-			     then makeTuple (args, formals)
-			     else (args, [])
-		       end
-		    val (post, transfer) =
-		       case transfer of
-			  Goto {dst, args} =>
-			     let
-			        val formals = labelArgs dst
-			     in
-			        if anyFlat formals
-				   then 
-				      let
-					 val (args, stmts) =
-					    makeSelects (args, formals)
-				      in
-					 (stmts, Goto {dst = dst, args = args})
-				      end
-				else ([], transfer)
-			     end
-			| _ => ([], transfer)
-		    val statements =
-		      Vector.concatV
-		      (Vector.new3 (Vector.fromList pre,
-				    statements,
-				    Vector.fromList post))
-		 in
-		    Block.T {label = label,
-			     args = args,
-			     statements = statements,
-			     transfer = transfer}
-		 end)
-	  in
-	     shrink (Function.new {args = args,
-				   blocks = blocks,
-				   mayInline = mayInline,
-				   name = name,
-				   raises = raises,
-				   returns = returns,
-				   start = start})
-	  end)
+             fun makeTuple (formals: (Var.t * Type.t) vector,
+                            reps: argsInfo)
+               : (Var.t * Type.t) vector * Statement.t list =
+               let
+                  val (argss, stmts) =
+                     Vector.map2AndFold
+                     (formals, reps, [], fn ((x, ty), rep, stmts) =>
+                      case rep of
+                         NONE => (Vector.new1 (x, ty), stmts)
+                       | SOME (i, _) =>
+                            if ArgInfo.isTupled i
+                               then (Vector.new1 (x, ty), stmts)
+                            else
+                               let
+                                  val vars = Vector.map
+                                             (Type.deTuple ty, fn ty =>
+                                              (Var.newNoname (), ty))
+                               in
+                                  (vars,
+                                   Statement.T 
+                                   {var = SOME x,
+                                    ty = ty,
+                                    exp = Tuple (Vector.map (vars, #1))}
+                                   :: stmts)
+                               end)
+               in (Vector.concatV argss, stmts)
+               end
+             fun makeSelects (args: Var.t vector,
+                              formals: argsInfo)
+               : Var.t vector * Statement.t list =
+               let
+                  val (argss, stmts) =
+                     Vector.map2AndFold
+                     (args, formals, [], fn (x, formal, stmts) =>
+                      case formal of
+                         NONE => (Vector.new1 x, stmts)
+                       | SOME (i, t) =>
+                            if ArgInfo.isTupled i
+                               then (Vector.new1 x, stmts)
+                            else 
+                               let
+                                  val (vars, stmts) =
+                                     Vector.foldi
+                                     (Type.deTuple t, ([], stmts),
+                                      fn (i, ty, (vars, stmts)) =>
+                                      let val var = Var.newNoname ()
+                                      in (var :: vars,
+                                          Statement.T
+                                          {var = SOME var,
+                                           ty = ty,
+                                           exp = Select {tuple = x,
+                                                         offset = i}}
+                                          :: stmts)
+                                      end)
+                               in (Vector.fromListRev vars, stmts)
+                               end)
+               in (Vector.concatV argss, stmts)
+               end
+             fun anyFlat (v: argsInfo): bool =
+                Vector.exists (v,
+                               fn NONE => false
+                                | SOME (i, _) => ArgInfo.isFlat i)
+             val blocks =
+                Vector.map
+                (blocks, fn Block.T {label, args, statements, transfer} =>
+                 let
+                    val (args, pre) =
+                       let
+                          val formals = labelArgs label
+                       in
+                          if anyFlat formals
+                             then makeTuple (args, formals)
+                             else (args, [])
+                       end
+                    val (post, transfer) =
+                       case transfer of
+                          Goto {dst, args} =>
+                             let
+                                val formals = labelArgs dst
+                             in
+                                if anyFlat formals
+                                   then 
+                                      let
+                                         val (args, stmts) =
+                                            makeSelects (args, formals)
+                                      in
+                                         (stmts, Goto {dst = dst, args = args})
+                                      end
+                                else ([], transfer)
+                             end
+                        | _ => ([], transfer)
+                    val statements =
+                      Vector.concatV
+                      (Vector.new3 (Vector.fromList pre,
+                                    statements,
+                                    Vector.fromList post))
+                 in
+                    Block.T {label = label,
+                             args = args,
+                             statements = statements,
+                             transfer = transfer}
+                 end)
+          in
+             shrink (Function.new {args = args,
+                                   blocks = blocks,
+                                   mayInline = mayInline,
+                                   name = name,
+                                   raises = raises,
+                                   returns = returns,
+                                   start = start})
+          end)
       val program = Program.T {datatypes = datatypes,
-			       globals = globals,
-			       functions = functions, 
-			       main = main}
+                               globals = globals,
+                               functions = functions, 
+                               main = main}
       val _ = Program.clearTop program
    in
       program

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ssa/local-flatten.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ssa/local-flatten.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ssa/local-flatten.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature LOCAL_FLATTEN_STRUCTS = 
    sig
       include SHRINK
@@ -17,15 +18,3 @@
       (* Intraprocedural flattening. *)
       val flatten: Program.t -> Program.t
    end
-
-
-functor TestLocalFlatten (S: LOCAL_FLATTEN): sig end = 
-struct
-
-val _ = print "TestLocalFlatten\n"
-
-open S
-
-val _ = Assert.assert ("LocalFlatten", fn () => true)
-
-end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ssa/local-ref.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ssa/local-ref.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ssa/local-ref.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,9 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 functor LocalRef (S: LOCAL_REF_STRUCTS): LOCAL_REF = 
@@ -17,10 +17,10 @@
       open Prim
 
       val isReff: 'a t -> bool =
-	 fn p =>
-	 case name p of
-	    Name.Ref_ref => true
-	  | _ => false
+         fn p =>
+         case name p of
+            Name.Ref_ref => true
+          | _ => false
    end
 
 structure FuncLattice = FlatLattice (structure Point = Func)
@@ -28,13 +28,13 @@
 structure GlobalInfo =
   struct
     datatype t = T of {isGlobalRef: bool,
-		       funcUses: FuncLattice.t}
+                       funcUses: FuncLattice.t}
 
     fun layout (T {isGlobalRef, funcUses, ...})
       = let open Layout
-	in record [("isGlobalRef", Bool.layout isGlobalRef),
-		   ("funcUses", FuncLattice.layout funcUses)]
-	end
+        in record [("isGlobalRef", Bool.layout isGlobalRef),
+                   ("funcUses", FuncLattice.layout funcUses)]
+        end
 
     local 
       fun make f (T r) = f r
@@ -44,13 +44,13 @@
     end
 
     fun new isGlobalRef = T {isGlobalRef = isGlobalRef, 
-			     funcUses = FuncLattice.new ()}
+                             funcUses = FuncLattice.new ()}
   end
 
 structure Local =
   struct
     structure L = TwoPointLattice (val bottom = "local"
-				   val top = "non local")
+                                   val top = "non local")
     open L
     val isLocal = isBottom
     val nonLocal = makeTop
@@ -59,22 +59,22 @@
 structure VarInfo =
   struct
     datatype t = T of {reff: (Label.t * Type.t) option,
-		       assigns: Label.t list ref,
-		       derefs: Label.t list ref,
-		       locall: Local.t, 
-		       threadCopyCurrent: {assign: bool ref,
-					   deref: bool ref}}
+                       assigns: Label.t list ref,
+                       derefs: Label.t list ref,
+                       locall: Local.t, 
+                       threadCopyCurrent: {assign: bool ref,
+                                           deref: bool ref}}
 
     fun layout (T {reff, assigns, derefs, locall, 
-		   threadCopyCurrent = {assign, deref, ...}, ...})
+                   threadCopyCurrent = {assign, deref, ...}, ...})
       = let open Layout
-	in record [("reff", Option.layout (tuple2 (Label.layout, Type.layout)) reff),
-		   ("assigns", List.layout Label.layout (!assigns)),
-		   ("derefs", List.layout Label.layout (!derefs)),
-		   ("locall", Local.layout locall),
-		   ("threadCopyCurrent", record [("assign", Bool.layout (!assign)),
-						 ("deref", Bool.layout (!deref))])]
-	end
+        in record [("reff", Option.layout (tuple2 (Label.layout, Type.layout)) reff),
+                   ("assigns", List.layout Label.layout (!assigns)),
+                   ("derefs", List.layout Label.layout (!derefs)),
+                   ("locall", Local.layout locall),
+                   ("threadCopyCurrent", record [("assign", Bool.layout (!assign)),
+                                                 ("deref", Bool.layout (!deref))])]
+        end
 
     local 
       fun make f (T r) = f r
@@ -97,27 +97,27 @@
     end
 
     fun new reff: t = T {reff = reff, 
-			 assigns = ref [],
-			 derefs = ref [],
-			 locall = let
-				    val locall = Local.new ()
-				    val _ = if isSome reff
-					      then ()
-					      else Local.nonLocal locall
-				  in
-				    locall
-				  end,
-			 threadCopyCurrent = {assign = ref false,
-					      deref = ref false}}
+                         assigns = ref [],
+                         derefs = ref [],
+                         locall = let
+                                    val locall = Local.new ()
+                                    val _ = if isSome reff
+                                              then ()
+                                              else Local.nonLocal locall
+                                  in
+                                    locall
+                                  end,
+                         threadCopyCurrent = {assign = ref false,
+                                              deref = ref false}}
   end
 
 structure LabelInfo =
   struct
     datatype t = T of {reffs: Var.t list ref,
-		       assigns: Var.t list ref,
-		       derefs: Var.t list ref,
-		       preds: Label.t list ref,
-		       visited: bool ref}
+                       assigns: Var.t list ref,
+                       derefs: Var.t list ref,
+                       preds: Label.t list ref,
+                       visited: bool ref}
 
     local 
       fun make f (T r) = f r
@@ -131,10 +131,10 @@
     end
 
     fun new (): t = T {reffs = ref [],
-		       assigns = ref [],
-		       derefs = ref [],
-		       preds = ref [],
-		       visited = ref false}
+                       assigns = ref [],
+                       derefs = ref [],
+                       preds = ref [],
+                       visited = ref false}
   end
 
 structure Multi = Multi (S)
@@ -142,383 +142,383 @@
 fun eliminate (program: Program.t): Program.t =
    let
       val program as Program.T {datatypes, globals, functions, main} =
-	 eliminateDeadBlocks program
+         eliminateDeadBlocks program
       (* Compute multi *)
       val multi = Control.trace (Control.Detail, "multi") Multi.multi
       val {usesThreadsOrConts: bool,
-	   funcIsMultiUsed: Func.t -> bool, 
-	   labelDoesThreadCopyCurrent: Label.t -> bool, ...} = multi program
+           funcIsMultiUsed: Func.t -> bool, 
+           labelDoesThreadCopyCurrent: Label.t -> bool, ...} = multi program
       (* Initialize globalInfo *)
       val {get = globalInfo: Var.t -> GlobalInfo.t,
-	   set = setGlobalInfo, ...} =
-	 Property.getSetOnce
-	 (Var.plist, Property.initFun (fn _ => GlobalInfo.new false))
+           set = setGlobalInfo, ...} =
+         Property.getSetOnce
+         (Var.plist, Property.initFun (fn _ => GlobalInfo.new false))
       val varFuncUses = GlobalInfo.funcUses o globalInfo
       val _ =
-	 Vector.foreach
-	 (globals, fn Statement.T {var, exp, ...} =>
-	  Option.app (var, fn var => 
-		      case exp of
-			 PrimApp {prim, ...} =>
-			    if Prim.isReff prim
-			       then setGlobalInfo (var, GlobalInfo.new true)
-			    else ()
-		       | _ => ()))
+         Vector.foreach
+         (globals, fn Statement.T {var, exp, ...} =>
+          Option.app (var, fn var => 
+                      case exp of
+                         PrimApp {prim, ...} =>
+                            if Prim.isReff prim
+                               then setGlobalInfo (var, GlobalInfo.new true)
+                            else ()
+                       | _ => ()))
       (* Compute funcUses *)
       fun addFunc f x =
-	 let 
-	    val gi = globalInfo x
-	 in 
-	    if GlobalInfo.isGlobalRef gi
-	       then ignore (FuncLattice.lowerBound (GlobalInfo.funcUses gi, f))
-	    else ()
-	 end
+         let 
+            val gi = globalInfo x
+         in 
+            if GlobalInfo.isGlobalRef gi
+               then ignore (FuncLattice.lowerBound (GlobalInfo.funcUses gi, f))
+            else ()
+         end
       val dummy = Func.newNoname ()
       val _ =
-	 Vector.foreach
-	 (globals, fn Statement.T {var, exp, ...} =>
-	  let
-	     fun default () = Exp.foreachVar (exp, addFunc dummy)
-	  in
-	     case exp of
-		PrimApp {prim, args, ...} =>
-		   if Prim.isReff prim
-		      then
-			 ignore
-			 (FuncLattice.<= (varFuncUses (valOf var),
-					  varFuncUses (Vector.sub (args, 0))))
-		   else default ()
-	      | _ => default ()
-	  end)
+         Vector.foreach
+         (globals, fn Statement.T {var, exp, ...} =>
+          let
+             fun default () = Exp.foreachVar (exp, addFunc dummy)
+          in
+             case exp of
+                PrimApp {prim, args, ...} =>
+                   if Prim.isReff prim
+                      then
+                         ignore
+                         (FuncLattice.<= (varFuncUses (valOf var),
+                                          varFuncUses (Vector.sub (args, 0))))
+                   else default ()
+              | _ => default ()
+          end)
       val _ =
-	 List.foreach
-	 (functions, fn f =>
-	  let
-	     val {name, blocks, ...} = Function.dest f
-	  in
-	     Vector.foreach
-	     (blocks, fn Block.T {statements, transfer, ...} =>
-	      (Vector.foreach (statements, fn Statement.T {exp, ...} =>
-			       Exp.foreachVar (exp, addFunc name))
-	       ; Transfer.foreachVar (transfer, addFunc name)))
-	  end)
+         List.foreach
+         (functions, fn f =>
+          let
+             val {name, blocks, ...} = Function.dest f
+          in
+             Vector.foreach
+             (blocks, fn Block.T {statements, transfer, ...} =>
+              (Vector.foreach (statements, fn Statement.T {exp, ...} =>
+                               Exp.foreachVar (exp, addFunc name))
+               ; Transfer.foreachVar (transfer, addFunc name)))
+          end)
       (* Diagnostics *)
       val _ =
-	 Control.diagnostics
-	 (fn display =>
-	  let
-	     open Layout
-	  in
-	     display (str "\n\nGlobals:")
-	     ; (Vector.foreach
-		(globals, fn Statement.T {var, ...} =>
-		 Option.app 
-		 (var, fn x =>
-		  if GlobalInfo.isGlobalRef (globalInfo x)
-		     then display (seq [Var.layout x,
-					str ": ",
-					GlobalInfo.layout (globalInfo x)])
-		  else ())))
-	  end)
+         Control.diagnostics
+         (fn display =>
+          let
+             open Layout
+          in
+             display (str "\n\nGlobals:")
+             ; (Vector.foreach
+                (globals, fn Statement.T {var, ...} =>
+                 Option.app 
+                 (var, fn x =>
+                  if GlobalInfo.isGlobalRef (globalInfo x)
+                     then display (seq [Var.layout x,
+                                        str ": ",
+                                        GlobalInfo.layout (globalInfo x)])
+                  else ())))
+          end)
       (* Localize global refs *)
       val {get = funcInfo: Func.t -> {locals: Statement.t list ref}, ...} =
-	 Property.get (Func.plist,
-		       Property.initFun (fn _ => {locals = ref []}))
+         Property.get (Func.plist,
+                       Property.initFun (fn _ => {locals = ref []}))
       val globals =
-	 Vector.keepAllMap
-	 (globals, fn (s as Statement.T {var, ...}) =>
-	  case var of
-	     NONE => SOME s
-	   | SOME x =>
-		let
-		   val GlobalInfo.T {isGlobalRef, funcUses} = globalInfo x
-		in 
-		   if not isGlobalRef
-		      then SOME s
-		   else
-		      (case FuncLattice.getPoint funcUses of
-			  NONE => SOME s
-			| SOME f =>
-			     if funcIsMultiUsed f
-				orelse Func.equals (f, dummy)
-				then SOME s
-			     else
-				(List.push (#locals (funcInfo f), s)
-				 ; NONE))
-		end)
+         Vector.keepAllMap
+         (globals, fn (s as Statement.T {var, ...}) =>
+          case var of
+             NONE => SOME s
+           | SOME x =>
+                let
+                   val GlobalInfo.T {isGlobalRef, funcUses} = globalInfo x
+                in 
+                   if not isGlobalRef
+                      then SOME s
+                   else
+                      (case FuncLattice.getPoint funcUses of
+                          NONE => SOME s
+                        | SOME f =>
+                             if funcIsMultiUsed f
+                                orelse Func.equals (f, dummy)
+                                then SOME s
+                             else
+                                (List.push (#locals (funcInfo f), s)
+                                 ; NONE))
+                end)
       (* restore and shrink *)
       val restore = restoreFunction {globals = globals}
       val shrink = shrinkFunction {globals = globals}
       (* varInfo *)
       val {get = varInfo: Var.t -> VarInfo.t,
-	   set = setVarInfo, ...} 
-	= Property.getSetOnce
-	  (Var.plist, Property.initFun (fn _ => VarInfo.new NONE))
+           set = setVarInfo, ...} 
+        = Property.getSetOnce
+          (Var.plist, Property.initFun (fn _ => VarInfo.new NONE))
       fun nonLocal x = VarInfo.nonLocal (varInfo x)
       fun isLocal x = VarInfo.isLocal (varInfo x)
       (* labelInfo *)
       val {get = labelInfo: Label.t -> LabelInfo.t, 
-	   set = setLabelInfo, ...}
-	= Property.getSetOnce
-	  (Label.plist, Property.initRaise ("localRef.labelInfo", Label.layout))
+           set = setLabelInfo, ...}
+        = Property.getSetOnce
+          (Label.plist, Property.initRaise ("localRef.labelInfo", Label.layout))
       fun rewrite (f: Function.t, refs): Function.t =
-	 let
-	    val {args, blocks, mayInline, name, raises, returns, start} =
-	       Function.dest f
-	    (* Diagnostics *)
-	    val _ =
-	       Control.diagnostics
-	       (fn display =>
-		let
-		   open Layout
-		in
-		   display (seq [Func.layout name,
-				 str " LocalRefs: ",
-				 List.layout 
-				 (fn x =>
-				  seq [Var.layout x,
-				       str ": ",
-				       VarInfo.layout (varInfo x)])
-				 refs])
-		end)
-	    (* Rewrite. *)
-	    fun rewriteStatement (s: Statement.t as Statement.T {exp, var, ...})
-	       = let
-		    datatype z = datatype Prim.Name.t
-		 in
-		    case exp
-		       of PrimApp {prim, args, ...}
-			  => let
-				fun arg n = Vector.sub (args, n)
+         let
+            val {args, blocks, mayInline, name, raises, returns, start} =
+               Function.dest f
+            (* Diagnostics *)
+            val _ =
+               Control.diagnostics
+               (fn display =>
+                let
+                   open Layout
+                in
+                   display (seq [Func.layout name,
+                                 str " LocalRefs: ",
+                                 List.layout 
+                                 (fn x =>
+                                  seq [Var.layout x,
+                                       str ": ",
+                                       VarInfo.layout (varInfo x)])
+                                 refs])
+                end)
+            (* Rewrite. *)
+            fun rewriteStatement (s: Statement.t as Statement.T {exp, var, ...})
+               = let
+                    datatype z = datatype Prim.Name.t
+                 in
+                    case exp
+                       of PrimApp {prim, args, ...}
+                          => let
+                                fun arg n = Vector.sub (args, n)
 
-				fun rewriteReffAssign rvar var
-				   = let
-					val vi = varInfo rvar
-				     in
-					if VarInfo.isLocal vi
-					   then Statement.T
-					      {var = SOME rvar,
-					       ty = #2 (valOf (VarInfo.reff vi)),
-					       exp = Var var}
-					else s
-				     end
-				fun rewriteReff ()
-				   = case var 
-				   of NONE => s
-				 | SOME var => rewriteReffAssign var (arg 0)
-				fun rewriteAssign () = rewriteReffAssign (arg 0) (arg 1)
-				fun rewriteDeref rvar
-				   = let
-					val vi = varInfo rvar
-				     in
-					if VarInfo.isLocal vi
-					   then let
-						in
-						   Statement.T
-						   {var = var,
-						    ty = #2 (valOf (VarInfo.reff vi)),
-						    exp = Var rvar}
-						end
-					else s
-				     end
-				val rewriteDeref
-				   = fn () => rewriteDeref (arg 0)
-			     in
-				case Prim.name prim
-				   of Ref_ref => rewriteReff ()
-				 | Ref_assign => rewriteAssign ()
-				 | Ref_deref => rewriteDeref ()
-				 | _ => s
-			     end
-			| _ => s
-		 end
-	    fun rewriteBlock (Block.T {label, args, statements, transfer})
-	       = let
-		    val li = labelInfo label
-		    (* Don't need to rewrite the statements
-		     * if this block doesn't mention localizable refs.
-		     *)
-		    val statements
-		       = if List.exists (LabelInfo.reffs' li, isLocal)
-		       orelse
-		       List.exists (LabelInfo.assigns' li, isLocal)
-		       orelse
-		       List.exists (LabelInfo.derefs' li, isLocal)
-			    then Vector.map (statements, rewriteStatement)
-			 else statements
-		 in
-		    Block.T {label = label,
-			     args = args,
-			     statements = statements,
-			     transfer = transfer}
-		 end
-	    val blocks = Vector.map (blocks, rewriteBlock)
-	    val f = Function.new {args = args,
-				  blocks = blocks,
-				  mayInline = mayInline,
-				  name = name,
-				  raises = raises,
-				  returns = returns,
-				  start = start}
-	    val f = restore f
-	    val f = shrink f
-	 in
-	    f
-	 end
+                                fun rewriteReffAssign rvar var
+                                   = let
+                                        val vi = varInfo rvar
+                                     in
+                                        if VarInfo.isLocal vi
+                                           then Statement.T
+                                              {var = SOME rvar,
+                                               ty = #2 (valOf (VarInfo.reff vi)),
+                                               exp = Var var}
+                                        else s
+                                     end
+                                fun rewriteReff ()
+                                   = case var 
+                                   of NONE => s
+                                 | SOME var => rewriteReffAssign var (arg 0)
+                                fun rewriteAssign () = rewriteReffAssign (arg 0) (arg 1)
+                                fun rewriteDeref rvar
+                                   = let
+                                        val vi = varInfo rvar
+                                     in
+                                        if VarInfo.isLocal vi
+                                           then let
+                                                in
+                                                   Statement.T
+                                                   {var = var,
+                                                    ty = #2 (valOf (VarInfo.reff vi)),
+                                                    exp = Var rvar}
+                                                end
+                                        else s
+                                     end
+                                val rewriteDeref
+                                   = fn () => rewriteDeref (arg 0)
+                             in
+                                case Prim.name prim
+                                   of Ref_ref => rewriteReff ()
+                                 | Ref_assign => rewriteAssign ()
+                                 | Ref_deref => rewriteDeref ()
+                                 | _ => s
+                             end
+                        | _ => s
+                 end
+            fun rewriteBlock (Block.T {label, args, statements, transfer})
+               = let
+                    val li = labelInfo label
+                    (* Don't need to rewrite the statements
+                     * if this block doesn't mention localizable refs.
+                     *)
+                    val statements
+                       = if List.exists (LabelInfo.reffs' li, isLocal)
+                       orelse
+                       List.exists (LabelInfo.assigns' li, isLocal)
+                       orelse
+                       List.exists (LabelInfo.derefs' li, isLocal)
+                            then Vector.map (statements, rewriteStatement)
+                         else statements
+                 in
+                    Block.T {label = label,
+                             args = args,
+                             statements = statements,
+                             transfer = transfer}
+                 end
+            val blocks = Vector.map (blocks, rewriteBlock)
+            val f = Function.new {args = args,
+                                  blocks = blocks,
+                                  mayInline = mayInline,
+                                  name = name,
+                                  raises = raises,
+                                  returns = returns,
+                                  start = start}
+            val f = restore f
+            val f = shrink f
+         in
+            f
+         end
       val functions =
-	 List.revMap
-	 (functions, fn f =>
-	  let
-	     val {name, ...} = Function.dest f
-	     val {locals, ...} = funcInfo name
-	     val locals = !locals
-	     val f =
-		if List.isEmpty locals
-		   then f
-		else
-		   let
-		      val {args, blocks, mayInline, name, raises, returns,
-			   start} = Function.dest f
-		      val locals = Vector.fromListRev locals
-		      val localsLabel = Label.newNoname ()
-		      val localsBlock =
-			 Block.T {label = localsLabel,
-				  args = Vector.new0 (),
-				  statements = locals,
-				  transfer = Goto {dst = start,
-						   args = Vector.new0 ()}}
-		      val blocks =
-			 Vector.concat [Vector.new1 localsBlock, blocks]
-		   in
-		      Function.new {args = args,
-				    blocks = blocks,
-				    mayInline = mayInline,
-				    name = name,
-				    raises = raises,
-				    returns = returns,
-				    start = localsLabel}
-		   end
-	     (* Find all localizable refs. *)
-	     val refs = ref []
-	     fun visitStatement label (Statement.T {var, ty, exp})
-	       = let
-		   val li = labelInfo label
-		   fun setReff ()
-		     = Option.app
-		       (var, fn var =>
-			let
-			  val vi = VarInfo.new (SOME (label, Type.deRef ty))
-			  val _ = setVarInfo (var, vi)
-			in
-			  List.push (refs, var) ;
-			  List.push (LabelInfo.reffs li, var)
-			end)
-		   fun setAssign var
-		     = (List.push (VarInfo.assigns (varInfo var), label) ;
-			List.push (LabelInfo.assigns li, var))
-		   fun setDeref var
-		     = (List.push (VarInfo.derefs (varInfo var), label) ;
-			List.push (LabelInfo.derefs li, var))
-		   fun default () = Exp.foreachVar (exp, nonLocal)
-		   datatype z = datatype Prim.Name.t
-		 in
-		   case exp
-		     of PrimApp {prim, args, ...}
-		      => let
-			   fun arg n = Vector.sub (args, n)
-			 in
-			   case Prim.name prim
-			     of Ref_ref => (setReff (); default ())
-			      | Ref_assign => (setAssign (arg 0); 
-					       nonLocal (arg 1))
-			      | Ref_deref => setDeref (arg 0)
-			      | _ => default ()
-			 end
-		      | _ => default ()
-		 end
-	     fun visitBlock (Block.T {label, statements, transfer, ...})
-	       = let
-		   val li = LabelInfo.new ()
-		   val _ = setLabelInfo (label, li)
-		   val _ = Vector.foreach (statements, visitStatement label)
-		   val _ = Transfer.foreachVar (transfer, nonLocal)
-		 in
-		   if usesThreadsOrConts
-		     then fn () => Transfer.foreachLabel
-		                   (transfer, fn l =>
-				    List.push (LabelInfo.preds (labelInfo l), label))
-		     else fn () => ()
-		 end
-	     val _ = Function.dfs (f, visitBlock)
-	     val refs = List.keepAll (!refs, isLocal)
-	     (* Thread criteria *)
-	     val refs
-	       = if usesThreadsOrConts
-		   then (List.foreach
-			 (refs, fn x =>
-			  let
-			    val vi = varInfo x
-			    val def = #1 (valOf (VarInfo.reff vi))
-			    fun doit (threadCopyCurrent, uses)
-			      = let
-				  val visited = ref []
-				  fun doit' l
-				    = let
-					val li = labelInfo l
-				      in
-					if LabelInfo.visited' li
-					  then ()
-					  else (List.push (visited, l);
-						LabelInfo.visited li := true;
-						if labelDoesThreadCopyCurrent l
-						  then threadCopyCurrent := true
-						  else ();
-						if Label.equals (def, l)
-						  then ()
-						  else List.foreach
-						       (LabelInfo.preds' li, doit'))
-				      end
-				in
-				  List.foreach 
-				  (uses, fn l =>
-				   List.foreach
-				   (LabelInfo.preds' (labelInfo l), doit')) ;
-				  List.foreach
-				  (!visited, fn l =>
-				   LabelInfo.visited (labelInfo l) := false)
-				end
-			    val _ = doit (VarInfo.threadCopyCurrentAssign vi,
-					  !(VarInfo.assigns vi))
-			    val _ = doit (VarInfo.threadCopyCurrentDeref vi,
-					  !(VarInfo.derefs vi))
-			  in
-			    if VarInfo.threadCopyCurrentAssign' vi
-			       andalso
-			       VarInfo.threadCopyCurrentDeref' vi
-			      then VarInfo.nonLocal vi
-			      else ()
-			  end);
-			 List.keepAll (refs, isLocal))
-		   else refs
-	  in
-	     if 0 < List.length refs
-		then rewrite (f, refs)
-	     else
-		(Function.clear f
-		 ; (Control.diagnostics
-		    (fn display =>
-		     let
-			open Layout
-		     in
-			display (seq [Func.layout name,
-				      str " NoLocalRefs"])
-		     end))
-		 ; f)
-	  end)
+         List.revMap
+         (functions, fn f =>
+          let
+             val {name, ...} = Function.dest f
+             val {locals, ...} = funcInfo name
+             val locals = !locals
+             val f =
+                if List.isEmpty locals
+                   then f
+                else
+                   let
+                      val {args, blocks, mayInline, name, raises, returns,
+                           start} = Function.dest f
+                      val locals = Vector.fromListRev locals
+                      val localsLabel = Label.newNoname ()
+                      val localsBlock =
+                         Block.T {label = localsLabel,
+                                  args = Vector.new0 (),
+                                  statements = locals,
+                                  transfer = Goto {dst = start,
+                                                   args = Vector.new0 ()}}
+                      val blocks =
+                         Vector.concat [Vector.new1 localsBlock, blocks]
+                   in
+                      Function.new {args = args,
+                                    blocks = blocks,
+                                    mayInline = mayInline,
+                                    name = name,
+                                    raises = raises,
+                                    returns = returns,
+                                    start = localsLabel}
+                   end
+             (* Find all localizable refs. *)
+             val refs = ref []
+             fun visitStatement label (Statement.T {var, ty, exp})
+               = let
+                   val li = labelInfo label
+                   fun setReff ()
+                     = Option.app
+                       (var, fn var =>
+                        let
+                          val vi = VarInfo.new (SOME (label, Type.deRef ty))
+                          val _ = setVarInfo (var, vi)
+                        in
+                          List.push (refs, var) ;
+                          List.push (LabelInfo.reffs li, var)
+                        end)
+                   fun setAssign var
+                     = (List.push (VarInfo.assigns (varInfo var), label) ;
+                        List.push (LabelInfo.assigns li, var))
+                   fun setDeref var
+                     = (List.push (VarInfo.derefs (varInfo var), label) ;
+                        List.push (LabelInfo.derefs li, var))
+                   fun default () = Exp.foreachVar (exp, nonLocal)
+                   datatype z = datatype Prim.Name.t
+                 in
+                   case exp
+                     of PrimApp {prim, args, ...}
+                      => let
+                           fun arg n = Vector.sub (args, n)
+                         in
+                           case Prim.name prim
+                             of Ref_ref => (setReff (); default ())
+                              | Ref_assign => (setAssign (arg 0); 
+                                               nonLocal (arg 1))
+                              | Ref_deref => setDeref (arg 0)
+                              | _ => default ()
+                         end
+                      | _ => default ()
+                 end
+             fun visitBlock (Block.T {label, statements, transfer, ...})
+               = let
+                   val li = LabelInfo.new ()
+                   val _ = setLabelInfo (label, li)
+                   val _ = Vector.foreach (statements, visitStatement label)
+                   val _ = Transfer.foreachVar (transfer, nonLocal)
+                 in
+                   if usesThreadsOrConts
+                     then fn () => Transfer.foreachLabel
+                                   (transfer, fn l =>
+                                    List.push (LabelInfo.preds (labelInfo l), label))
+                     else fn () => ()
+                 end
+             val _ = Function.dfs (f, visitBlock)
+             val refs = List.keepAll (!refs, isLocal)
+             (* Thread criteria *)
+             val refs
+               = if usesThreadsOrConts
+                   then (List.foreach
+                         (refs, fn x =>
+                          let
+                            val vi = varInfo x
+                            val def = #1 (valOf (VarInfo.reff vi))
+                            fun doit (threadCopyCurrent, uses)
+                              = let
+                                  val visited = ref []
+                                  fun doit' l
+                                    = let
+                                        val li = labelInfo l
+                                      in
+                                        if LabelInfo.visited' li
+                                          then ()
+                                          else (List.push (visited, l);
+                                                LabelInfo.visited li := true;
+                                                if labelDoesThreadCopyCurrent l
+                                                  then threadCopyCurrent := true
+                                                  else ();
+                                                if Label.equals (def, l)
+                                                  then ()
+                                                  else List.foreach
+                                                       (LabelInfo.preds' li, doit'))
+                                      end
+                                in
+                                  List.foreach 
+                                  (uses, fn l =>
+                                   List.foreach
+                                   (LabelInfo.preds' (labelInfo l), doit')) ;
+                                  List.foreach
+                                  (!visited, fn l =>
+                                   LabelInfo.visited (labelInfo l) := false)
+                                end
+                            val _ = doit (VarInfo.threadCopyCurrentAssign vi,
+                                          !(VarInfo.assigns vi))
+                            val _ = doit (VarInfo.threadCopyCurrentDeref vi,
+                                          !(VarInfo.derefs vi))
+                          in
+                            if VarInfo.threadCopyCurrentAssign' vi
+                               andalso
+                               VarInfo.threadCopyCurrentDeref' vi
+                              then VarInfo.nonLocal vi
+                              else ()
+                          end);
+                         List.keepAll (refs, isLocal))
+                   else refs
+          in
+             if 0 < List.length refs
+                then rewrite (f, refs)
+             else
+                (Function.clear f
+                 ; (Control.diagnostics
+                    (fn display =>
+                     let
+                        open Layout
+                     in
+                        display (seq [Func.layout name,
+                                      str " NoLocalRefs"])
+                     end))
+                 ; f)
+          end)
       val program = Program.T {datatypes = datatypes,
-			       globals = globals,
-			       functions = functions,
-			       main = main}
+                               globals = globals,
+                               functions = functions,
+                               main = main}
       val _ = Program.clearTop program
     in
       program

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ssa/local-ref.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ssa/local-ref.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ssa/local-ref.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature LOCAL_REF_STRUCTS =
    sig
       include RESTORE

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ssa/loop-invariant.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ssa/loop-invariant.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ssa/loop-invariant.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 (*
  * Remove loop invariant args to local loops.
  * fun loop (x, y) = ... loop (x, z) ...
@@ -28,143 +29,143 @@
       val shrink = shrinkFunction {globals = globals}
 
       fun simplifyFunction f =
-	 let
-	    val {args, blocks, mayInline, name, raises, returns, start} =
-	       Function.dest f
-	    val {get = labelInfo: Label.t -> {callsSelf: bool ref,
-					      visited: bool ref,
-					      invariant: (Var.t * bool ref) vector,
-					      newLabel: Label.t option ref},
-		 set = setLabelInfo, ...} =
-	       Property.getSetOnce
-	       (Label.plist, 
-		Property.initRaise ("LoopInvariant.labelInfo", Label.layout))
+         let
+            val {args, blocks, mayInline, name, raises, returns, start} =
+               Function.dest f
+            val {get = labelInfo: Label.t -> {callsSelf: bool ref,
+                                              visited: bool ref,
+                                              invariant: (Var.t * bool ref) vector,
+                                              newLabel: Label.t option ref},
+                 set = setLabelInfo, ...} =
+               Property.getSetOnce
+               (Label.plist, 
+                Property.initRaise ("LoopInvariant.labelInfo", Label.layout))
 
-	    val _ =
-	       Vector.foreach
-	       (blocks, fn Block.T {label, args, ...} =>
-		setLabelInfo (label,
-			      {callsSelf = ref false,
-			       visited = ref false,
-			       invariant = Vector.map (args, fn (x, _) => 
-						       (x, ref true)),
-			       newLabel = ref NONE}))
+            val _ =
+               Vector.foreach
+               (blocks, fn Block.T {label, args, ...} =>
+                setLabelInfo (label,
+                              {callsSelf = ref false,
+                               visited = ref false,
+                               invariant = Vector.map (args, fn (x, _) => 
+                                                       (x, ref true)),
+                               newLabel = ref NONE}))
 
-	    fun visit (Block.T {label, transfer, ...}): unit -> unit =
-	       let
-		  val {visited, ...} = labelInfo label
-		  val _ = visited := true
-		  val _ =
-		     case transfer of
-			Goto {dst, args} =>
-			   let
-			      val {callsSelf, visited, invariant, ...} = labelInfo dst
-			   in
-			      if !visited
-				 then (callsSelf := true
-				       ; Vector.foreach2
-				       (args, invariant, fn (x, (y, b)) =>
-					if !b andalso not (Var.equals (x, y))
-					   then b := false
-					else ()))
-			      else ()
-			   end
-		      | _ => ()
-	       in
-		  fn () => visited := false
-	       end
-	    val _ = Function.dfs (f, visit)
-	    fun remove (xs: 'a vector, invariant: ('b * bool ref) vector)
-	       : 'a vector =
-	       Vector.keepAllMap2 (xs, invariant, fn (x, (_, b)) =>
-				   if !b then NONE else SOME x)
+            fun visit (Block.T {label, transfer, ...}): unit -> unit =
+               let
+                  val {visited, ...} = labelInfo label
+                  val _ = visited := true
+                  val _ =
+                     case transfer of
+                        Goto {dst, args} =>
+                           let
+                              val {callsSelf, visited, invariant, ...} = labelInfo dst
+                           in
+                              if !visited
+                                 then (callsSelf := true
+                                       ; Vector.foreach2
+                                       (args, invariant, fn (x, (y, b)) =>
+                                        if !b andalso not (Var.equals (x, y))
+                                           then b := false
+                                        else ()))
+                              else ()
+                           end
+                      | _ => ()
+               in
+                  fn () => visited := false
+               end
+            val _ = Function.dfs (f, visit)
+            fun remove (xs: 'a vector, invariant: ('b * bool ref) vector)
+               : 'a vector =
+               Vector.keepAllMap2 (xs, invariant, fn (x, (_, b)) =>
+                                   if !b then NONE else SOME x)
 
-	    val newBlocks = ref []
-	    fun visit (Block.T {label, args, statements, transfer})
-	       : unit -> unit =
-	       let
-		  val {callsSelf, invariant, newLabel, ...} = labelInfo label
-		  val _ =
-		     if !callsSelf
-		        andalso Vector.exists (invariant, ! o #2)
-		        then newLabel := SOME (Label.new label)
-		     else ()
-		  val transfer = 
-		     case transfer of
-		        Goto {dst, args} =>
-			   let
-			      val {invariant, newLabel, ...} = labelInfo dst
-			   in
-			      case !newLabel of
-				 NONE => transfer
-			       | SOME dst' =>
-				    Goto {dst = dst',
-					  args = remove (args, invariant)}
-			   end
-		      | _ => transfer
-		  val (args, statements, transfer) =
-		     case !newLabel of
-		        NONE => (args, statements, transfer)
-		      | SOME label' =>
-			   let
-			      val _ =
-				 Control.diagnostic
-				 (fn () =>
-				  let open Layout
-				  in seq [Label.layout label,
-					  str " -> ",
-					  Label.layout label']
-				  end)
-			      val (outerFormals,
-				   innerFormals,
-				   innerActuals) =
-				 Vector.foldr2
-				 (args, invariant, ([], [], []),
-				  fn ((x, t), (_, b), (ofs, ifs, ias)) =>
-				  if !b
-				     then ((x, t) :: ofs, ifs, ias)
-				  else let val x' = Var.new x
-				       in ((x', t) :: ofs,
-					   (x, t) :: ifs,
-					   x' :: ias)
-				       end)
-			   in
-			      List.push
-			      (newBlocks, 
-			       Block.T {label = label',
-					args = Vector.fromList innerFormals,
-					statements = statements,
-					transfer = transfer})
-			      ; (Vector.fromList outerFormals, 
-				 Vector.new0 (),
-				 Goto {dst = label',
-				       args = Vector.fromList innerActuals})
-			   end
-		  val _ = List.push
-		          (newBlocks,
-			   Block.T {label = label,
-				    args = args,
-				    statements = statements,
-				    transfer = transfer})
-	       in
-		  fn () => newLabel := NONE
-	       end
-	    val _ = Function.dfs (f, visit)
-	    val blocks = Vector.fromList (!newBlocks)
-	 in
-	    shrink (Function.new {args = args,
-				  blocks = blocks,
-				  mayInline = mayInline,
-				  name = name,
-				  raises = raises,
-				  returns = returns,
-				  start = start})
-	 end
+            val newBlocks = ref []
+            fun visit (Block.T {label, args, statements, transfer})
+               : unit -> unit =
+               let
+                  val {callsSelf, invariant, newLabel, ...} = labelInfo label
+                  val _ =
+                     if !callsSelf
+                        andalso Vector.exists (invariant, ! o #2)
+                        then newLabel := SOME (Label.new label)
+                     else ()
+                  val transfer = 
+                     case transfer of
+                        Goto {dst, args} =>
+                           let
+                              val {invariant, newLabel, ...} = labelInfo dst
+                           in
+                              case !newLabel of
+                                 NONE => transfer
+                               | SOME dst' =>
+                                    Goto {dst = dst',
+                                          args = remove (args, invariant)}
+                           end
+                      | _ => transfer
+                  val (args, statements, transfer) =
+                     case !newLabel of
+                        NONE => (args, statements, transfer)
+                      | SOME label' =>
+                           let
+                              val _ =
+                                 Control.diagnostic
+                                 (fn () =>
+                                  let open Layout
+                                  in seq [Label.layout label,
+                                          str " -> ",
+                                          Label.layout label']
+                                  end)
+                              val (outerFormals,
+                                   innerFormals,
+                                   innerActuals) =
+                                 Vector.foldr2
+                                 (args, invariant, ([], [], []),
+                                  fn ((x, t), (_, b), (ofs, ifs, ias)) =>
+                                  if !b
+                                     then ((x, t) :: ofs, ifs, ias)
+                                  else let val x' = Var.new x
+                                       in ((x', t) :: ofs,
+                                           (x, t) :: ifs,
+                                           x' :: ias)
+                                       end)
+                           in
+                              List.push
+                              (newBlocks, 
+                               Block.T {label = label',
+                                        args = Vector.fromList innerFormals,
+                                        statements = statements,
+                                        transfer = transfer})
+                              ; (Vector.fromList outerFormals, 
+                                 Vector.new0 (),
+                                 Goto {dst = label',
+                                       args = Vector.fromList innerActuals})
+                           end
+                  val _ = List.push
+                          (newBlocks,
+                           Block.T {label = label,
+                                    args = args,
+                                    statements = statements,
+                                    transfer = transfer})
+               in
+                  fn () => newLabel := NONE
+               end
+            val _ = Function.dfs (f, visit)
+            val blocks = Vector.fromList (!newBlocks)
+         in
+            shrink (Function.new {args = args,
+                                  blocks = blocks,
+                                  mayInline = mayInline,
+                                  name = name,
+                                  raises = raises,
+                                  returns = returns,
+                                  start = start})
+         end
       val program = 
-	 Program.T {datatypes = datatypes,
-		    globals = globals,
-		    functions = List.revMap(functions, simplifyFunction), 
-		    main = main}
+         Program.T {datatypes = datatypes,
+                    globals = globals,
+                    functions = List.revMap(functions, simplifyFunction), 
+                    main = main}
       val _ = Program.clearTop program
    in
       program

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ssa/loop-invariant.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ssa/loop-invariant.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ssa/loop-invariant.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature LOOP_INVARIANT_STRUCTS = 
    sig
       include SHRINK

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ssa/multi.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ssa/multi.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ssa/multi.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,9 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 (*
@@ -36,8 +36,8 @@
     fun new (): t = T (ref Zero)
     fun inc (T r)
       = case !r 
-	  of Zero => r := One
-	   | _ => r := Many
+          of Zero => r := One
+           | _ => r := Many
     val isMany
       = fn (T (ref Many)) => true
          | _ => false
@@ -46,7 +46,7 @@
 structure ThreadCopyCurrent =
   struct
     structure L = TwoPointLattice (val bottom = "false"
-				   val top = "true")
+                                   val top = "true")
     open L
     val force = makeTop
     val does = isTop
@@ -56,7 +56,7 @@
 structure MultiThreaded =
   struct
     structure L = TwoPointLattice (val bottom = "false"
-				   val top = "true")
+                                   val top = "true")
     open L
     val force = makeTop
     val is = isTop
@@ -66,7 +66,7 @@
 structure MultiUsed =
   struct
     structure L = TwoPointLattice (val bottom = "false"
-				   val top = "true")
+                                   val top = "true")
     open L
     val force = makeTop
     val is = isTop
@@ -77,9 +77,9 @@
 structure FuncInfo =
   struct
     datatype t = T of {calls: Calls.t,
-		       threadCopyCurrent: ThreadCopyCurrent.t,
-		       multiThreaded: MultiThreaded.t,
-		       multiUsed: MultiUsed.t}
+                       threadCopyCurrent: ThreadCopyCurrent.t,
+                       multiThreaded: MultiThreaded.t,
+                       multiUsed: MultiUsed.t}
 
     local
        fun make f (T r) = f r
@@ -91,16 +91,16 @@
     end
    
     fun new (): t = T {calls = Calls.new (),
-		       threadCopyCurrent = ThreadCopyCurrent.new (),
-		       multiUsed = MultiUsed.new (),
-		       multiThreaded = MultiThreaded.new ()}
+                       threadCopyCurrent = ThreadCopyCurrent.new (),
+                       multiUsed = MultiUsed.new (),
+                       multiThreaded = MultiThreaded.new ()}
   end
 
 structure LabelInfo =
   struct
     datatype t = T of {threadCopyCurrent: ThreadCopyCurrent.t,
-		       multiThreaded: MultiThreaded.t,
-		       multiUsed: MultiUsed.t}
+                       multiThreaded: MultiThreaded.t,
+                       multiUsed: MultiUsed.t}
 
     local
        fun make f (T r) = f r
@@ -111,14 +111,14 @@
      end
    
      fun new (): t = T {threadCopyCurrent = ThreadCopyCurrent.new (),
-			multiThreaded = MultiThreaded.new (),
-			multiUsed = MultiUsed.new ()}
+                        multiThreaded = MultiThreaded.new (),
+                        multiUsed = MultiUsed.new ()}
    end
 
 structure VarInfo =
   struct
     datatype t = T of {multiThreaded: MultiThreaded.t,
-		       multiUsed: MultiUsed.t}
+                       multiUsed: MultiUsed.t}
 
     local
        fun make f (T r) = f r
@@ -128,44 +128,44 @@
      end
    
      fun new (): t = T {multiThreaded = MultiThreaded.new (),
-			multiUsed = MultiUsed.new ()}
+                        multiUsed = MultiUsed.new ()}
    end
 
 fun multi (p as Program.T {functions, main, ...})
   = let
       val usesThreadsOrConts 
-	= Program.hasPrim (p, fn p =>
-			   case Prim.name p of
-			      Prim.Name.Thread_switchTo => true
-			    | _ => false)
+        = Program.hasPrim (p, fn p =>
+                           case Prim.name p of
+                              Prim.Name.Thread_switchTo => true
+                            | _ => false)
 
       (* funcNode *)
       val {get = funcNode: Func.t -> unit Node.t,
-	   set = setFuncNode, 
-	   rem = remFuncNode, ...}
-	= Property.getSetOnce
-	  (Func.plist, Property.initRaise ("Multi.funcNode", Func.layout))
+           set = setFuncNode, 
+           rem = remFuncNode, ...}
+        = Property.getSetOnce
+          (Func.plist, Property.initRaise ("Multi.funcNode", Func.layout))
 
       (* nodeFunction *)
       val {get = nodeFunction: unit Node.t -> Function.t,
-	   set = setNodeFunction, ...}
-	= Property.getSetOnce 
-	  (Node.plist, Property.initRaise ("Multi.nodeFunc", Node.layout))
+           set = setNodeFunction, ...}
+        = Property.getSetOnce 
+          (Node.plist, Property.initRaise ("Multi.nodeFunc", Node.layout))
 
       (* funcInfo *)
       val {get = funcInfo: Func.t -> FuncInfo.t, ...}
-	= Property.get
-	  (Func.plist, Property.initFun (fn _ => FuncInfo.new ()))
+        = Property.get
+          (Func.plist, Property.initFun (fn _ => FuncInfo.new ()))
 
       (* labelInfo *)
       val {get = labelInfo: Label.t -> LabelInfo.t, ...}
-	= Property.get
-	  (Label.plist, Property.initFun (fn _ => LabelInfo.new ()))
+        = Property.get
+          (Label.plist, Property.initFun (fn _ => LabelInfo.new ()))
 
       (* varInfo *)
       val {get = varInfo: Var.t -> VarInfo.t, ...}
-	= Property.get
-	  (Var.plist, Property.initFun (fn _ => VarInfo.new ()))
+        = Property.get
+          (Var.plist, Property.initFun (fn _ => VarInfo.new ()))
 
       (* construct call graph
        * compute calls
@@ -175,269 +175,269 @@
       fun newNode () = Graph.newNode G
       fun addEdge edge = ignore (Graph.addEdge (G, edge))
       val _ = List.foreach
-	      (functions, fn f =>
-	       let
-		 val n = newNode ()
-	       in 
-		 setFuncNode (Function.name f, n) ;
-		 setNodeFunction (n, f)
-	       end)
+              (functions, fn f =>
+               let
+                 val n = newNode ()
+               in 
+                 setFuncNode (Function.name f, n) ;
+                 setNodeFunction (n, f)
+               end)
       val _ = Calls.inc (FuncInfo.calls (funcInfo main))
       val _ = List.foreach
-	      (functions, fn f =>
-	       let
-		 val {name = f, blocks, ...} = Function.dest f
-		 val fi = funcInfo f
-	       in
-		 Vector.foreach
-		 (blocks, fn Block.T {label, transfer, ...} =>
-		  let
-		    val li = labelInfo label
-		  in
-		    case transfer
-		      of Call {func = g, ...}
-		       => let
-			    val gi = funcInfo g
-			  in 
-			    Calls.inc (FuncInfo.calls gi) ;
-			    addEdge {from = funcNode f,
-				     to = funcNode g} ;
-			    if usesThreadsOrConts
-			      then ThreadCopyCurrent.when
-				   (FuncInfo.threadCopyCurrent gi,
-				    fn () =>
-				    (ThreadCopyCurrent.force
-				     (LabelInfo.threadCopyCurrent li) ;
-				     ThreadCopyCurrent.force
-				     (FuncInfo.threadCopyCurrent fi)))
-			      else ()
-			  end
-		      | Runtime {prim, ...}
-		      => if usesThreadsOrConts
-			    andalso
-			    (case Prim.name prim of
-				Prim.Name.Thread_copyCurrent => true
-			      | _ => false)
-			   then (ThreadCopyCurrent.force
-				 (LabelInfo.threadCopyCurrent li) ;
-				 ThreadCopyCurrent.force
-				 (FuncInfo.threadCopyCurrent fi))
-			   else ()
-		      | _ => ()
-		  end)
-	       end)
+              (functions, fn f =>
+               let
+                 val {name = f, blocks, ...} = Function.dest f
+                 val fi = funcInfo f
+               in
+                 Vector.foreach
+                 (blocks, fn Block.T {label, transfer, ...} =>
+                  let
+                    val li = labelInfo label
+                  in
+                    case transfer
+                      of Call {func = g, ...}
+                       => let
+                            val gi = funcInfo g
+                          in 
+                            Calls.inc (FuncInfo.calls gi) ;
+                            addEdge {from = funcNode f,
+                                     to = funcNode g} ;
+                            if usesThreadsOrConts
+                              then ThreadCopyCurrent.when
+                                   (FuncInfo.threadCopyCurrent gi,
+                                    fn () =>
+                                    (ThreadCopyCurrent.force
+                                     (LabelInfo.threadCopyCurrent li) ;
+                                     ThreadCopyCurrent.force
+                                     (FuncInfo.threadCopyCurrent fi)))
+                              else ()
+                          end
+                      | Runtime {prim, ...}
+                      => if usesThreadsOrConts
+                            andalso
+                            (case Prim.name prim of
+                                Prim.Name.Thread_copyCurrent => true
+                              | _ => false)
+                           then (ThreadCopyCurrent.force
+                                 (LabelInfo.threadCopyCurrent li) ;
+                                 ThreadCopyCurrent.force
+                                 (FuncInfo.threadCopyCurrent fi))
+                           else ()
+                      | _ => ()
+                  end)
+               end)
       val () = Graph.removeDuplicateEdges G
       val rec forceMultiThreadedVar
-	= fn x =>
-	  let
-	    val vi = varInfo x
-	  in
-	    MultiThreaded.force (VarInfo.multiThreaded vi) ;
-	    MultiUsed.force (VarInfo.multiUsed vi)
-	  end
+        = fn x =>
+          let
+            val vi = varInfo x
+          in
+            MultiThreaded.force (VarInfo.multiThreaded vi) ;
+            MultiUsed.force (VarInfo.multiUsed vi)
+          end
       val rec forceMultiUsedVar
-	= fn x =>
-	  let
-	    val vi = varInfo x
-	  in
-	    MultiUsed.force (VarInfo.multiUsed vi)
-	  end
+        = fn x =>
+          let
+            val vi = varInfo x
+          in
+            MultiUsed.force (VarInfo.multiUsed vi)
+          end
       val rec forceMultiThreadedFunc
-	= fn f =>
-	  let
-	    val fi = funcInfo f
-	  in
-	    MultiThreaded.force (FuncInfo.multiThreaded fi) ;
-	    MultiUsed.force (FuncInfo.multiUsed fi)
-	  end
+        = fn f =>
+          let
+            val fi = funcInfo f
+          in
+            MultiThreaded.force (FuncInfo.multiThreaded fi) ;
+            MultiUsed.force (FuncInfo.multiUsed fi)
+          end
       val rec forceMultiUsedFunc
-	= fn f =>
-	  let
-	    val fi = funcInfo f
-	  in
-	    MultiUsed.force (FuncInfo.multiUsed fi)
-	  end
+        = fn f =>
+          let
+            val fi = funcInfo f
+          in
+            MultiUsed.force (FuncInfo.multiUsed fi)
+          end
       val rec forceMultiThreadedBlock
-	= fn Block.T {label, args, statements, transfer} =>
-	  let
-	    val li = labelInfo label
-	  in
-	    if MultiThreaded.is (LabelInfo.multiThreaded li)
-	      then ()
-	      else (MultiThreaded.force (LabelInfo.multiThreaded li) ;
-		    MultiUsed.force (LabelInfo.multiUsed li) ;
-		    Vector.foreach (args, forceMultiThreadedVar o #1) ;
-		    Vector.foreach 
-		    (statements, fn Statement.T {var, ...} =>
-		     Option.app (var, forceMultiThreadedVar)) ;
-		    Transfer.foreachFunc
-		    (transfer, forceMultiThreadedFunc))
-	  end
+        = fn Block.T {label, args, statements, transfer} =>
+          let
+            val li = labelInfo label
+          in
+            if MultiThreaded.is (LabelInfo.multiThreaded li)
+              then ()
+              else (MultiThreaded.force (LabelInfo.multiThreaded li) ;
+                    MultiUsed.force (LabelInfo.multiUsed li) ;
+                    Vector.foreach (args, forceMultiThreadedVar o #1) ;
+                    Vector.foreach 
+                    (statements, fn Statement.T {var, ...} =>
+                     Option.app (var, forceMultiThreadedVar)) ;
+                    Transfer.foreachFunc
+                    (transfer, forceMultiThreadedFunc))
+          end
       val rec forceMultiThreadedBlockDFS
-	= fn controlFlow as {graph = _, labelNode, nodeBlock} =>
-	  fn block as Block.T {label, transfer, ...} =>
-	  let
-	    val li = labelInfo label
-	  in
-	    if MultiThreaded.is (LabelInfo.multiThreaded li)
-	      then ()
-	      else (forceMultiThreadedBlock block ;
-		    Transfer.foreachLabel
-		    (transfer, fn l =>
-		     forceMultiThreadedBlockDFS controlFlow 
-		     (nodeBlock (labelNode l))))
-	  end
+        = fn controlFlow as {graph = _, labelNode, nodeBlock} =>
+          fn block as Block.T {label, transfer, ...} =>
+          let
+            val li = labelInfo label
+          in
+            if MultiThreaded.is (LabelInfo.multiThreaded li)
+              then ()
+              else (forceMultiThreadedBlock block ;
+                    Transfer.foreachLabel
+                    (transfer, fn l =>
+                     forceMultiThreadedBlockDFS controlFlow 
+                     (nodeBlock (labelNode l))))
+          end
       val rec forceMultiUsedBlock
-	= fn Block.T {label, args, statements, transfer} =>
-	  let
-	    val li = labelInfo label
-	  in
-	    if MultiUsed.is (LabelInfo.multiUsed li)
-	      then ()
-	      else (MultiUsed.force (LabelInfo.multiUsed li) ;
-		    Vector.foreach (args, forceMultiUsedVar o #1) ;
-		    Vector.foreach 
-		    (statements, fn Statement.T {var, ...} =>
-		     Option.app (var, forceMultiUsedVar)) ;
-		    Transfer.foreachFunc
-		    (transfer, forceMultiUsedFunc))
-	  end
+        = fn Block.T {label, args, statements, transfer} =>
+          let
+            val li = labelInfo label
+          in
+            if MultiUsed.is (LabelInfo.multiUsed li)
+              then ()
+              else (MultiUsed.force (LabelInfo.multiUsed li) ;
+                    Vector.foreach (args, forceMultiUsedVar o #1) ;
+                    Vector.foreach 
+                    (statements, fn Statement.T {var, ...} =>
+                     Option.app (var, forceMultiUsedVar)) ;
+                    Transfer.foreachFunc
+                    (transfer, forceMultiUsedFunc))
+          end
       val rec visitBlock
-	= fn controlFlow as {graph = _, labelNode, nodeBlock} =>
-	  fn Block.T {label, transfer, ...} =>
-	  if ThreadCopyCurrent.does (LabelInfo.threadCopyCurrent (labelInfo label))
-	    then Transfer.foreachLabel
-	         (transfer, fn l =>
-		  forceMultiThreadedBlockDFS controlFlow 
-		  (nodeBlock (labelNode l)))
-	    else ()
+        = fn controlFlow as {graph = _, labelNode, nodeBlock} =>
+          fn Block.T {label, transfer, ...} =>
+          if ThreadCopyCurrent.does (LabelInfo.threadCopyCurrent (labelInfo label))
+            then Transfer.foreachLabel
+                 (transfer, fn l =>
+                  forceMultiThreadedBlockDFS controlFlow 
+                  (nodeBlock (labelNode l)))
+            else ()
       val rec visitForceMultiUsedBlock
-	= fn controlFlow =>
-	  fn block =>
-	  (forceMultiUsedBlock block ;
-	   visitBlock controlFlow block)
+        = fn controlFlow =>
+          fn block =>
+          (forceMultiUsedBlock block ;
+           visitBlock controlFlow block)
 
       val rec forceMultiThreadedFunc
-	= fn f =>
-	  let
-	    val {args, blocks, ...} = Function.dest f
-	  in
-	    Vector.foreach
-	    (args, forceMultiThreadedVar o #1) ;
-	    Vector.foreach
-	    (blocks, forceMultiThreadedBlock)
-	  end
+        = fn f =>
+          let
+            val {args, blocks, ...} = Function.dest f
+          in
+            Vector.foreach
+            (args, forceMultiThreadedVar o #1) ;
+            Vector.foreach
+            (blocks, forceMultiThreadedBlock)
+          end
       val rec forceMultiUsedFunc
-	= fn f =>
-	  let
-	    val {args, blocks, ...} = Function.dest f
-	  in
-	    Vector.foreach
-	    (args, forceMultiUsedVar o #1) ;
-	    Vector.foreach
-	    (blocks, forceMultiUsedBlock)
-	  end
+        = fn f =>
+          let
+            val {args, blocks, ...} = Function.dest f
+          in
+            Vector.foreach
+            (args, forceMultiUsedVar o #1) ;
+            Vector.foreach
+            (blocks, forceMultiUsedBlock)
+          end
 
       fun visitFunc multiUsed f
-	= let
-	    val _ = remFuncNode (Function.name f)
+        = let
+            val _ = remFuncNode (Function.name f)
 
-	    val fi = funcInfo (Function.name f)
-	    val _ = if multiUsed
-	               orelse
-		       Calls.isMany (FuncInfo.calls fi)
-		      then MultiUsed.force (FuncInfo.multiUsed fi)
-		      else ()
-	  in
-	    if MultiThreaded.is (FuncInfo.multiThreaded fi)
-	      then forceMultiThreadedFunc f
-	    else if MultiUsed.is (FuncInfo.multiUsed fi)
-	      then (forceMultiUsedFunc f ;
-		    if usesThreadsOrConts
-		      then let
-			     val _ = MultiThreaded.when
-			             (FuncInfo.multiThreaded fi,
-				      fn () => forceMultiThreadedFunc f)
-			     val controlFlow = Function.controlFlow f
-			   in
-			     Vector.foreach
-			     (Function.blocks f, visitBlock controlFlow)
-			   end
-		      else ())
-	      else if usesThreadsOrConts
-		     then let	
-			    val _ = MultiThreaded.when
-			            (FuncInfo.multiThreaded fi,
-				     fn () => forceMultiThreadedFunc f)
-			    val _ = MultiUsed.when
-			            (FuncInfo.multiUsed fi,
-				     fn () => forceMultiUsedFunc f)
-			    val controlFlow as {graph, nodeBlock, ...}
-			      = Function.controlFlow f
-			  in
-			    List.foreach
-			    (Graph.stronglyConnectedComponents graph,
-			     fn [] => ()
-			      | [n] => if Node.hasEdge {from = n, to = n}
-					 then visitForceMultiUsedBlock controlFlow
-					      (nodeBlock n)
-					 else visitBlock controlFlow
-					      (nodeBlock n)
-			      | ns => List.foreach
-				      (ns, fn n =>
-				       visitForceMultiUsedBlock controlFlow
-				       (nodeBlock n)))
-			  end
-		     else let	
-			    val _ = MultiUsed.when
-			            (FuncInfo.multiUsed fi,
-				     fn () => forceMultiUsedFunc f)
-			    val {graph, nodeBlock, ...} = Function.controlFlow f
-			  in
-			    List.foreach
-			    (Graph.stronglyConnectedComponents graph,
-			     fn [] => ()
-			      | [n] => if Node.hasEdge {from = n, to = n}
-					 then forceMultiUsedBlock (nodeBlock n)
-					 else ()
-			      | ns => List.foreach 
-				      (ns, fn n =>
-				       forceMultiUsedBlock (nodeBlock n)))
-			  end
-	  end
+            val fi = funcInfo (Function.name f)
+            val _ = if multiUsed
+                       orelse
+                       Calls.isMany (FuncInfo.calls fi)
+                      then MultiUsed.force (FuncInfo.multiUsed fi)
+                      else ()
+          in
+            if MultiThreaded.is (FuncInfo.multiThreaded fi)
+              then forceMultiThreadedFunc f
+            else if MultiUsed.is (FuncInfo.multiUsed fi)
+              then (forceMultiUsedFunc f ;
+                    if usesThreadsOrConts
+                      then let
+                             val _ = MultiThreaded.when
+                                     (FuncInfo.multiThreaded fi,
+                                      fn () => forceMultiThreadedFunc f)
+                             val controlFlow = Function.controlFlow f
+                           in
+                             Vector.foreach
+                             (Function.blocks f, visitBlock controlFlow)
+                           end
+                      else ())
+              else if usesThreadsOrConts
+                     then let   
+                            val _ = MultiThreaded.when
+                                    (FuncInfo.multiThreaded fi,
+                                     fn () => forceMultiThreadedFunc f)
+                            val _ = MultiUsed.when
+                                    (FuncInfo.multiUsed fi,
+                                     fn () => forceMultiUsedFunc f)
+                            val controlFlow as {graph, nodeBlock, ...}
+                              = Function.controlFlow f
+                          in
+                            List.foreach
+                            (Graph.stronglyConnectedComponents graph,
+                             fn [] => ()
+                              | [n] => if Node.hasEdge {from = n, to = n}
+                                         then visitForceMultiUsedBlock controlFlow
+                                              (nodeBlock n)
+                                         else visitBlock controlFlow
+                                              (nodeBlock n)
+                              | ns => List.foreach
+                                      (ns, fn n =>
+                                       visitForceMultiUsedBlock controlFlow
+                                       (nodeBlock n)))
+                          end
+                     else let   
+                            val _ = MultiUsed.when
+                                    (FuncInfo.multiUsed fi,
+                                     fn () => forceMultiUsedFunc f)
+                            val {graph, nodeBlock, ...} = Function.controlFlow f
+                          in
+                            List.foreach
+                            (Graph.stronglyConnectedComponents graph,
+                             fn [] => ()
+                              | [n] => if Node.hasEdge {from = n, to = n}
+                                         then forceMultiUsedBlock (nodeBlock n)
+                                         else ()
+                              | ns => List.foreach 
+                                      (ns, fn n =>
+                                       forceMultiUsedBlock (nodeBlock n)))
+                          end
+          end
 
       val _ = List.foreach
-	      (Graph.stronglyConnectedComponents G,
-	       fn [] => ()
-	        | [n] =>
-		     visitFunc (Node.hasEdge {from = n, to = n}) (nodeFunction n)
-		| ns => List.foreach 
-			(ns, fn n =>
-			 visitFunc true (nodeFunction n)))
+              (Graph.stronglyConnectedComponents G,
+               fn [] => ()
+                | [n] =>
+                     visitFunc (Node.hasEdge {from = n, to = n}) (nodeFunction n)
+                | ns => List.foreach 
+                        (ns, fn n =>
+                         visitFunc true (nodeFunction n)))
 
 (*
       val _ = Control.diagnostics
-	      (fn display =>
-	       let open Layout
-	       in 
-		 display (Layout.str "\n\nMulti:") ;
-		 display (seq [Layout.str "usesThreadsOrConts: ",
-			       Bool.layout usesThreadsOrConts]) ;
-		 List.foreach
-		 (functions, fn f =>
-		  let 
-		    val {name = f, blocks, ...} = Function.dest f
-		  in 
-		    display (seq [Func.layout f,
-				  str ": ",
-				  FuncInfo.layout (funcInfo f)]) ;
-		    Vector.foreach
-		    (blocks, fn Block.T {label, ...} =>
-		     display (seq [Label.layout label,
-				   str ": ",
-				   LabelInfo.layout (labelInfo label)]))
-		  end)
-	       end)
+              (fn display =>
+               let open Layout
+               in 
+                 display (Layout.str "\n\nMulti:") ;
+                 display (seq [Layout.str "usesThreadsOrConts: ",
+                               Bool.layout usesThreadsOrConts]) ;
+                 List.foreach
+                 (functions, fn f =>
+                  let 
+                    val {name = f, blocks, ...} = Function.dest f
+                  in 
+                    display (seq [Func.layout f,
+                                  str ": ",
+                                  FuncInfo.layout (funcInfo f)]) ;
+                    Vector.foreach
+                    (blocks, fn Block.T {label, ...} =>
+                     display (seq [Label.layout label,
+                                   str ": ",
+                                   LabelInfo.layout (labelInfo label)]))
+                  end)
+               end)
 *)
     in
       {

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ssa/multi.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ssa/multi.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ssa/multi.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature MULTI_STRUCTS = 
    sig
       include SSA_TREE
@@ -15,46 +16,46 @@
       include MULTI_STRUCTS
 
       val multi: Program.t -> 
-	         {(* Program has an occurence of Thread_switchTo. *)
-		  usesThreadsOrConts: bool,
-		  (* usesThreadsOrConts == true
-		   * and the func directly or indirectly invokes
-		   * Thread_copyCurrent. 
-		   *)
-		  funcDoesThreadCopyCurrent: Func.t -> bool,
-		  (* usesThreadsOrConts == true
-		   * and the func may be called by two
-		   * different threads during some run of the 
-		   * program.
-		   *)
-		  funcIsMultiThreaded: Func.t -> bool,
-		  (* The func may be called more than once
-		   * during some run of the program.
-		   *)
-		  funcIsMultiUsed: Func.t -> bool,
-		  (* usesThreadsOrConts == true
-		   * and the label's block's transfer is
-		   * either Runtime {prim, ...}
-		   * with prim = Thread_copyCurrent
-		   * or Call {func, ...}
-		   * with funcDoesThreadCopyCurrent(func) == true.
-		   *)
-		  labelDoesThreadCopyCurrent: Label.t -> bool,
-		  (* usesTheadsOrConts == true
-		   * and the label may be executed by two
-		   * different threads during some run of the
-		   * program.
-		   *)
-		  labelIsMultiThreaded: Label.t -> bool,
-		  (* The label may be executed more than once
-		   * during some run of the program.
-		   *)
-		  labelIsMultiUsed: Label.t -> bool,
-		  (* The var may be defined more than once
-		   * during some run of the program;
-		   * i.e., varIsMultiDefed(x) = 
-		   * labelIsMultiUsed(label of x's def)
-		   * when x is defined in a block;
-		   *)
-		  varIsMultiDefed: Var.t -> bool}
+                 {(* Program has an occurence of Thread_switchTo. *)
+                  usesThreadsOrConts: bool,
+                  (* usesThreadsOrConts == true
+                   * and the func directly or indirectly invokes
+                   * Thread_copyCurrent. 
+                   *)
+                  funcDoesThreadCopyCurrent: Func.t -> bool,
+                  (* usesThreadsOrConts == true
+                   * and the func may be called by two
+                   * different threads during some run of the 
+                   * program.
+                   *)
+                  funcIsMultiThreaded: Func.t -> bool,
+                  (* The func may be called more than once
+                   * during some run of the program.
+                   *)
+                  funcIsMultiUsed: Func.t -> bool,
+                  (* usesThreadsOrConts == true
+                   * and the label's block's transfer is
+                   * either Runtime {prim, ...}
+                   * with prim = Thread_copyCurrent
+                   * or Call {func, ...}
+                   * with funcDoesThreadCopyCurrent(func) == true.
+                   *)
+                  labelDoesThreadCopyCurrent: Label.t -> bool,
+                  (* usesTheadsOrConts == true
+                   * and the label may be executed by two
+                   * different threads during some run of the
+                   * program.
+                   *)
+                  labelIsMultiThreaded: Label.t -> bool,
+                  (* The label may be executed more than once
+                   * during some run of the program.
+                   *)
+                  labelIsMultiUsed: Label.t -> bool,
+                  (* The var may be defined more than once
+                   * during some run of the program;
+                   * i.e., varIsMultiDefed(x) = 
+                   * labelIsMultiUsed(label of x's def)
+                   * when x is defined in a block;
+                   *)
+                  varIsMultiDefed: Var.t -> bool}
    end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ssa/n-point-lattice.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ssa/n-point-lattice.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ssa/n-point-lattice.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 functor NPointLattice (S: N_POINT_LATTICE_STRUCTS): N_POINT_LATTICE = 
 struct
 
@@ -33,84 +34,84 @@
 fun whenN (s, n', h') =
    case value s of
       (n, hss) => if n' < 0 orelse n' > N
-		     then Error.bug "NPointLattice:whenN"
-		  else if n >= n'
-		     then h' ()
-		  else let
-			 val hs = List.nth (hss, n' - n - 1)
-		       in
-			 hs := AppendList.cons (h', !hs)
-		       end
+                     then Error.bug "NPointLattice.whenN"
+                  else if n >= n'
+                     then h' ()
+                  else let
+                         val hs = List.nth (hss, n' - n - 1)
+                       in
+                         hs := AppendList.cons (h', !hs)
+                       end
 
 fun isN (s, n') =
    case value s of
       (n, _) => if n' < 0 orelse n' > N
-	           then Error.bug "NPointLattice:isN"
-		else n = n'
+                   then Error.bug "NPointLattice.isN"
+                else n = n'
 
 fun up (T s) =
    case Set.! s of
       (n, hss) => if n = N
-	             then ()
-		  else (Set.:= (s, (n + 1, tl hss)) ;
-			AppendList.foreach (!(hd hss), fn h => h ()))
+                     then ()
+                  else (Set.:= (s, (n + 1, tl hss)) ;
+                        AppendList.foreach (!(hd hss), fn h => h ()))
 
 fun makeN (s, n') =
    case value s of
       (n, _) => if n' < 0 orelse n' > N
-	           then Error.bug "NPointLattice:makeN"
-		else if n >= n'
-		   then ()
-		else (up s ; makeN (s, n'))
+                   then Error.bug "NPointLattice.makeN"
+                else if n >= n'
+                   then ()
+                else (up s ; makeN (s, n'))
 
 fun from <= to =
    if equals (from, to)
       then ()
    else
       case (value from, value to) of
-	 ((n,hss), (n',_)) => 
-	    (makeN (to, n) ;
-	     List.foreachi
-	     (hss, fn (i,hs) =>
-	      if n + i + 1 > n'
-		then hs := AppendList.cons (fn () => makeN (to, n + i + 1), !hs)
-		else ()))
+         ((n,hss), (n',_)) => 
+            (makeN (to, n) ;
+             List.foreachi
+             (hss, fn (i,hs) =>
+              if n + i + 1 > n'
+                then hs := AppendList.cons (fn () => makeN (to, n + i + 1), !hs)
+                else ()))
 
 fun == (T s, T s') =
    if Set.equals (s, s')
       then ()
    else
       let 
-	 val e = Set.! s
-	 val e' = Set.! s'
-	 val _ = Set.union (s, s')
+         val e = Set.! s
+         val e' = Set.! s'
+         val _ = Set.union (s, s')
       in
-	 case (e, e') of
-	    ((n,hss), (n',hss')) =>
-	       let
-		 val n'' = Int.max (n, n')
+         case (e, e') of
+            ((n,hss), (n',hss')) =>
+               let
+                 val n'' = Int.max (n, n')
 
-		 fun doit (n, hss) =
-		    let
-		      val rec drop
-			= fn (hss, 0: Int.t) => hss
-		           | (hs::hss, n) =>
-			     (AppendList.foreach
-			      (!hs, fn h => h ()) ;
-			      drop (hss, n - 1))
-			   | ([], _) => Error.bug "NPointLattice:=="
-		    in
-		      drop (hss, n'' - n)
-		    end
-		 val hss = doit (n, hss)
-		 val hss' = doit (n', hss')
-		 val hss''
-		   = List.map2
-		     (hss, hss', fn (hs, hs') =>
-		      ref (AppendList.append (!hs, !hs')))
-	       in
-		  Set.:= (s, (n'', hss''))
-	       end
+                 fun doit (n, hss) =
+                    let
+                      val rec drop
+                        = fn (hss, 0: Int.t) => hss
+                           | (hs::hss, n) =>
+                             (AppendList.foreach
+                              (!hs, fn h => h ()) ;
+                              drop (hss, n - 1))
+                           | ([], _) => Error.bug "NPointLattice.=="
+                    in
+                      drop (hss, n'' - n)
+                    end
+                 val hss = doit (n, hss)
+                 val hss' = doit (n', hss')
+                 val hss''
+                   = List.map2
+                     (hss, hss', fn (hs, hs') =>
+                      ref (AppendList.append (!hs, !hs')))
+               in
+                  Set.:= (s, (n'', hss''))
+               end
       end
 
 end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ssa/n-point-lattice.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ssa/n-point-lattice.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ssa/n-point-lattice.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,9 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 type int = Int.t

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ssa/poly-equal.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ssa/poly-equal.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ssa/poly-equal.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 functor PolyEqual (S: POLY_EQUAL_STRUCTS): POLY_EQUAL = 
 struct
 
@@ -43,388 +44,388 @@
       open DirectExp
 
       fun add (e1: t, e2: t): t =
-	 primApp {prim = Prim.wordAdd WordSize.default,
-		  targs = Vector.new0 (),
-		  args = Vector.new2 (e1, e2),
-		  ty = Type.defaultWord}
+         primApp {prim = Prim.wordAdd WordSize.default,
+                  targs = Vector.new0 (),
+                  args = Vector.new2 (e1, e2),
+                  ty = Type.defaultWord}
 
       fun conjoin (e1: t, e2: t): t =
-	 casee {test = e1,
-		cases = Con (Vector.new2 ({con = Con.truee,
-					   args = Vector.new0 (),
-					   body = e2},
-					  {con = Con.falsee,
-					   args = Vector.new0 (),
-					   body = falsee})),
-		default = NONE,
-		ty = Type.bool}
+         casee {test = e1,
+                cases = Con (Vector.new2 ({con = Con.truee,
+                                           args = Vector.new0 (),
+                                           body = e2},
+                                          {con = Con.falsee,
+                                           args = Vector.new0 (),
+                                           body = falsee})),
+                default = NONE,
+                ty = Type.bool}
 
       fun disjoin (e1: t, e2:t ): t =
-	 casee {test = e1,
-		cases = Con (Vector.new2 ({con = Con.truee,
-					   args = Vector.new0 (),
-					   body = truee},
-					  {con = Con.falsee,
-					   args = Vector.new0 (),
-					   body = e2})),
-		default = NONE,
-		ty = Type.bool}
+         casee {test = e1,
+                cases = Con (Vector.new2 ({con = Con.truee,
+                                           args = Vector.new0 (),
+                                           body = truee},
+                                          {con = Con.falsee,
+                                           args = Vector.new0 (),
+                                           body = e2})),
+                default = NONE,
+                ty = Type.bool}
    end
 
 fun polyEqual (Program.T {datatypes, globals, functions, main}) =
    let
       val shrink = shrinkFunction {globals = globals}
       val {get = tyconInfo: Tycon.t -> {isEnum: bool,
-					cons: {con: Con.t,
-					       args: Type.t vector} vector},
-	   set = setTyconInfo, ...} =
-	 Property.getSetOnce
-	 (Tycon.plist, Property.initRaise ("PolyEqual.info", Tycon.layout))
+                                        cons: {con: Con.t,
+                                               args: Type.t vector} vector},
+           set = setTyconInfo, ...} =
+         Property.getSetOnce
+         (Tycon.plist, Property.initRaise ("PolyEqual.info", Tycon.layout))
       val isEnum = #isEnum o tyconInfo
       val tyconCons = #cons o tyconInfo
       val {get = varInfo: Var.t -> {isConst: bool},
-	   set = setVarInfo, ...} =
-	 Property.getSetOnce (Var.plist, Property.initConst {isConst = false})
+           set = setVarInfo, ...} =
+         Property.getSetOnce (Var.plist, Property.initConst {isConst = false})
       val _ =
-	 Vector.foreach
-	 (datatypes, fn Datatype.T {tycon, cons} =>
-	  setTyconInfo (tycon,
-			{isEnum = Vector.forall (cons, fn {args, ...} =>
-						 Vector.isEmpty args),
-			 cons = cons}))
+         Vector.foreach
+         (datatypes, fn Datatype.T {tycon, cons} =>
+          setTyconInfo (tycon,
+                        {isEnum = Vector.forall (cons, fn {args, ...} =>
+                                                 Vector.isEmpty args),
+                         cons = cons}))
       val newFunctions: Function.t list ref = ref []
       val {get = getEqualFunc: Tycon.t -> Func.t option, 
-	   set = setEqualFunc, ...} =
-	 Property.getSet (Tycon.plist, Property.initConst NONE)
+           set = setEqualFunc, ...} =
+         Property.getSet (Tycon.plist, Property.initConst NONE)
       val {get = getVectorEqualFunc: Type.t -> Func.t option, 
-	   set = setVectorEqualFunc,
-	   destroy = destroyType} =
-	 Property.destGetSet (Type.plist, Property.initConst NONE)
+           set = setVectorEqualFunc,
+           destroy = destroyType} =
+         Property.destGetSet (Type.plist, Property.initConst NONE)
       val returns = SOME (Vector.new1 Type.bool)
       fun newFunction z =
-	 List.push (newFunctions,
-		    Function.profile (shrink (Function.new z),
-				      SourceInfo.polyEqual))
+         List.push (newFunctions,
+                    Function.profile (shrink (Function.new z),
+                                      SourceInfo.polyEqual))
       fun equalFunc (tycon: Tycon.t): Func.t =
-	 case getEqualFunc tycon of
-	    SOME f => f
-	  | NONE =>
-	       let
-		  val name =
-		     Func.newString (concat ["equal_", Tycon.originalName tycon])
-		  val _ = setEqualFunc (tycon, SOME name)
-		  val ty = Type.con (tycon, Vector.new0 ())
-		  val arg1 = (Var.newNoname (), ty)
-		  val arg2 = (Var.newNoname (), ty)
-		  val args = Vector.new2 (arg1, arg2)
-		  val darg1 = Dexp.var arg1
-		  val darg2 = Dexp.var arg2
-		  val cons = tyconCons tycon
-		  val body =
-		     Dexp.disjoin
-		     (Dexp.eq (Dexp.var arg1, Dexp.var arg2, ty),
-		      Dexp.casee
-		      {test = darg1,
-		       ty = Type.bool,
-		       default = (if Vector.exists (cons, fn {args, ...} =>
-						    0 = Vector.length args)
-				     then SOME Dexp.falsee
-				  else NONE),
-		       cases =
-		       Dexp.Con
-		       (Vector.keepAllMap
-			(cons, fn {con, args} =>
-			 if 0 = Vector.length args
-			    then NONE
-			 else
-			    let
-			       fun makeArgs () =
-				  Vector.map (args, fn ty =>
-					      (Var.newNoname (), ty))
-			       val xs = makeArgs ()
-			       val ys = makeArgs ()
-			    in
-			       SOME
-			       {con = con,
-				args = xs,
-				body = 
-				Dexp.casee
-				{test = darg2,
-				 ty = Type.bool,
-				 default = if 1 = Vector.length cons
-					      then NONE
-					   else SOME Dexp.falsee,
-					      cases =
-					      Dexp.Con
-					      (Vector.new1
-					       {con = con,
-						args = ys,
-						body =
-						Vector.fold2
-						(xs, ys, Dexp.truee,
-						 fn ((x, ty), (y, _), de) =>
-						 Dexp.conjoin (de, equal (x, y, ty)))})}}
-			    end))})
-		  val (start, blocks) = Dexp.linearize (body, Handler.Caller)
-		  val blocks = Vector.fromList blocks
-		  val _ =
-		     newFunction {args = args,
-				  blocks = blocks,
-				  mayInline = true,
-				  name = name,
-				  raises = NONE,
-				  returns = returns,
-				  start = start}
-	       in
-		  name
-	       end
+         case getEqualFunc tycon of
+            SOME f => f
+          | NONE =>
+               let
+                  val name =
+                     Func.newString (concat ["equal_", Tycon.originalName tycon])
+                  val _ = setEqualFunc (tycon, SOME name)
+                  val ty = Type.con (tycon, Vector.new0 ())
+                  val arg1 = (Var.newNoname (), ty)
+                  val arg2 = (Var.newNoname (), ty)
+                  val args = Vector.new2 (arg1, arg2)
+                  val darg1 = Dexp.var arg1
+                  val darg2 = Dexp.var arg2
+                  val cons = tyconCons tycon
+                  val body =
+                     Dexp.disjoin
+                     (Dexp.eq (Dexp.var arg1, Dexp.var arg2, ty),
+                      Dexp.casee
+                      {test = darg1,
+                       ty = Type.bool,
+                       default = (if Vector.exists (cons, fn {args, ...} =>
+                                                    0 = Vector.length args)
+                                     then SOME Dexp.falsee
+                                  else NONE),
+                       cases =
+                       Dexp.Con
+                       (Vector.keepAllMap
+                        (cons, fn {con, args} =>
+                         if 0 = Vector.length args
+                            then NONE
+                         else
+                            let
+                               fun makeArgs () =
+                                  Vector.map (args, fn ty =>
+                                              (Var.newNoname (), ty))
+                               val xs = makeArgs ()
+                               val ys = makeArgs ()
+                            in
+                               SOME
+                               {con = con,
+                                args = xs,
+                                body = 
+                                Dexp.casee
+                                {test = darg2,
+                                 ty = Type.bool,
+                                 default = if 1 = Vector.length cons
+                                              then NONE
+                                           else SOME Dexp.falsee,
+                                              cases =
+                                              Dexp.Con
+                                              (Vector.new1
+                                               {con = con,
+                                                args = ys,
+                                                body =
+                                                Vector.fold2
+                                                (xs, ys, Dexp.truee,
+                                                 fn ((x, ty), (y, _), de) =>
+                                                 Dexp.conjoin (de, equal (x, y, ty)))})}}
+                            end))})
+                  val (start, blocks) = Dexp.linearize (body, Handler.Caller)
+                  val blocks = Vector.fromList blocks
+                  val _ =
+                     newFunction {args = args,
+                                  blocks = blocks,
+                                  mayInline = true,
+                                  name = name,
+                                  raises = NONE,
+                                  returns = returns,
+                                  start = start}
+               in
+                  name
+               end
       and vectorEqualFunc (ty: Type.t): Func.t =
-	 case getVectorEqualFunc ty of
-	    SOME f => f
-	  | NONE =>
-	       let
-		  (* Build two functions, one that checks the lengths and the
-		   * other that loops.
-		   *)
-		  val name = Func.newString "vectorEqual"
-		  val _ = setVectorEqualFunc (ty, SOME name)
-		  val loop = Func.newString "vectorEqualLoop"
-		  val vty = Type.vector ty
-		  local
-		     val v1 = (Var.newNoname (), vty)
-		     val v2 = (Var.newNoname (), vty)
-		     val args = Vector.new2 (v1, v2)
-		     val dv1 = Dexp.var v1
-		     val dv2 = Dexp.var v2
-		     val body =
-		        let
-			  fun length x =
-			     Dexp.primApp {prim = Prim.vectorLength,
-					   targs = Vector.new1 ty,
-					   args = Vector.new1 x,
-					   ty = Type.defaultWord}
-			in
-			   Dexp.disjoin
-			   (Dexp.eq (Dexp.var v1, Dexp.var v2, vty),
-			    Dexp.conjoin
-			    (Dexp.eq (length dv1, length dv2, Type.defaultWord),
-			     Dexp.call
-			     {func = loop,
-			      args = (Vector.new4 
-				      (Dexp.word (WordX.zero WordSize.default),
-				       length dv1, dv1, dv2)),
-			      ty = Type.bool}))
-			end
-		     val (start, blocks) = Dexp.linearize (body, Handler.Caller)
-		     val blocks = Vector.fromList blocks
-		  in
-		     val _ =
-			newFunction {args = args,
-				     blocks = blocks,
-				     mayInline = true,
-				     name = name,
-				     raises = NONE,
-				     returns = returns,
-				     start = start}
-		  end
-		  local
-		     val i = (Var.newNoname (), Type.defaultWord)
-		     val len = (Var.newNoname (), Type.defaultWord)
-		     val v1 = (Var.newNoname (), vty)
-		     val v2 = (Var.newNoname (), vty)
-		     val args = Vector.new4 (i, len, v1, v2)
-		     val di = Dexp.var i
-		     val dlen = Dexp.var len
-		     val dv1 = Dexp.var v1
-		     val dv2 = Dexp.var v2
-		     val body =
-		        let
-			   fun sub (v, i) =
-			      Dexp.primApp {prim = Prim.vectorSub,
-					    targs = Vector.new1 ty,
-					    args = Vector.new2 (v, i),
-					    ty = ty}
-			   val args =
-			      Vector.new4 
-			      (Dexp.add
-			       (di, Dexp.word (WordX.one WordSize.default)),
-			       dlen, dv1, dv2)
-			in
-			   Dexp.disjoin 
-			   (Dexp.eq (di, dlen, Type.defaultWord),
-			    Dexp.conjoin
-			    (equalExp (sub (dv1, di), sub (dv2, di), ty),
-			     Dexp.call {args = args,
-					func = loop,
-					ty = Type.bool}))
-			end
-		     val (start, blocks) = Dexp.linearize (body, Handler.Caller)
-		     val blocks = Vector.fromList blocks
-		  in
-		     val _ =
-			newFunction {args = args,
-				     blocks = blocks,
-				     mayInline = true,
-				     name = loop,
-				     raises = NONE,
-				     returns = returns,
-				     start = start}
-		  end
-	       in
-		  name
-	       end
+         case getVectorEqualFunc ty of
+            SOME f => f
+          | NONE =>
+               let
+                  (* Build two functions, one that checks the lengths and the
+                   * other that loops.
+                   *)
+                  val name = Func.newString "vectorEqual"
+                  val _ = setVectorEqualFunc (ty, SOME name)
+                  val loop = Func.newString "vectorEqualLoop"
+                  val vty = Type.vector ty
+                  local
+                     val v1 = (Var.newNoname (), vty)
+                     val v2 = (Var.newNoname (), vty)
+                     val args = Vector.new2 (v1, v2)
+                     val dv1 = Dexp.var v1
+                     val dv2 = Dexp.var v2
+                     val body =
+                        let
+                          fun length x =
+                             Dexp.primApp {prim = Prim.vectorLength,
+                                           targs = Vector.new1 ty,
+                                           args = Vector.new1 x,
+                                           ty = Type.defaultWord}
+                        in
+                           Dexp.disjoin
+                           (Dexp.eq (Dexp.var v1, Dexp.var v2, vty),
+                            Dexp.conjoin
+                            (Dexp.eq (length dv1, length dv2, Type.defaultWord),
+                             Dexp.call
+                             {func = loop,
+                              args = (Vector.new4 
+                                      (Dexp.word (WordX.zero WordSize.default),
+                                       length dv1, dv1, dv2)),
+                              ty = Type.bool}))
+                        end
+                     val (start, blocks) = Dexp.linearize (body, Handler.Caller)
+                     val blocks = Vector.fromList blocks
+                  in
+                     val _ =
+                        newFunction {args = args,
+                                     blocks = blocks,
+                                     mayInline = true,
+                                     name = name,
+                                     raises = NONE,
+                                     returns = returns,
+                                     start = start}
+                  end
+                  local
+                     val i = (Var.newNoname (), Type.defaultWord)
+                     val len = (Var.newNoname (), Type.defaultWord)
+                     val v1 = (Var.newNoname (), vty)
+                     val v2 = (Var.newNoname (), vty)
+                     val args = Vector.new4 (i, len, v1, v2)
+                     val di = Dexp.var i
+                     val dlen = Dexp.var len
+                     val dv1 = Dexp.var v1
+                     val dv2 = Dexp.var v2
+                     val body =
+                        let
+                           fun sub (v, i) =
+                              Dexp.primApp {prim = Prim.vectorSub,
+                                            targs = Vector.new1 ty,
+                                            args = Vector.new2 (v, i),
+                                            ty = ty}
+                           val args =
+                              Vector.new4 
+                              (Dexp.add
+                               (di, Dexp.word (WordX.one WordSize.default)),
+                               dlen, dv1, dv2)
+                        in
+                           Dexp.disjoin 
+                           (Dexp.eq (di, dlen, Type.defaultWord),
+                            Dexp.conjoin
+                            (equalExp (sub (dv1, di), sub (dv2, di), ty),
+                             Dexp.call {args = args,
+                                        func = loop,
+                                        ty = Type.bool}))
+                        end
+                     val (start, blocks) = Dexp.linearize (body, Handler.Caller)
+                     val blocks = Vector.fromList blocks
+                  in
+                     val _ =
+                        newFunction {args = args,
+                                     blocks = blocks,
+                                     mayInline = true,
+                                     name = loop,
+                                     raises = NONE,
+                                     returns = returns,
+                                     start = start}
+                  end
+               in
+                  name
+               end
       and equalExp (e1: Dexp.t, e2: Dexp.t, ty: Type.t): Dexp.t =
-	 Dexp.name (e1, fn x1 => Dexp.name (e2, fn x2 => equal (x1, x2, ty)))
+         Dexp.name (e1, fn x1 => Dexp.name (e2, fn x2 => equal (x1, x2, ty)))
       and equal (x1: Var.t, x2: Var.t, ty: Type.t): Dexp.t =
-	 let
-	    val dx1 = Dexp.var (x1, ty)
-	    val dx2 = Dexp.var (x2, ty)
-	    fun prim (p, targs) =
-	       Dexp.primApp {prim = p,
-			     targs = targs, 
-			     args = Vector.new2 (dx1, dx2),
-			     ty = Type.bool}
-	    fun eq () = prim (Prim.eq, Vector.new1 ty)
-	    fun hasConstArg () = #isConst (varInfo x1) orelse #isConst (varInfo x2)
-	 in
-	    case Type.dest ty of
-	       Type.Array _ => eq ()
-	     | Type.Datatype tycon =>
-		  if isEnum tycon orelse hasConstArg ()
-		     then eq ()
-		  else Dexp.call {func = equalFunc tycon,
-				  args = Vector.new2 (dx1, dx2),
-				  ty = Type.bool}
-	     | Type.IntInf => if hasConstArg ()
-				 then eq ()
-			      else prim (Prim.intInfEqual, Vector.new0 ())
-	     | Type.Ref _ => eq ()
-	     | Type.Tuple tys =>
-		  let
-		     val max = Vector.length tys - 1
-		     (* test components i, i+1, ... *)
-		     fun loop (i: int): Dexp.t =
-			if i > max
-			   then Dexp.truee
-			else let
-				val ty = Vector.sub (tys, i)
-				fun select tuple =
-				   Dexp.select {tuple = tuple,
-						offset = i,
-						ty = ty}
-			     in
-				Dexp.conjoin
-				(equalExp (select dx1, select dx2, ty),
-				 loop (i + 1))
-			     end
-		  in
-		     loop 0
-		  end
-	     | Type.Vector ty =>
-		  Dexp.call {func = vectorEqualFunc ty,
-			     args = Vector.new2 (dx1, dx2),
-			     ty = Type.bool}
-	     | Type.Word s => prim (Prim.wordEqual s, Vector.new0 ())
-	     | _ => Error.bug "equal of strange type"
-	 end
+         let
+            val dx1 = Dexp.var (x1, ty)
+            val dx2 = Dexp.var (x2, ty)
+            fun prim (p, targs) =
+               Dexp.primApp {prim = p,
+                             targs = targs, 
+                             args = Vector.new2 (dx1, dx2),
+                             ty = Type.bool}
+            fun eq () = prim (Prim.eq, Vector.new1 ty)
+            fun hasConstArg () = #isConst (varInfo x1) orelse #isConst (varInfo x2)
+         in
+            case Type.dest ty of
+               Type.Array _ => eq ()
+             | Type.Datatype tycon =>
+                  if isEnum tycon orelse hasConstArg ()
+                     then eq ()
+                  else Dexp.call {func = equalFunc tycon,
+                                  args = Vector.new2 (dx1, dx2),
+                                  ty = Type.bool}
+             | Type.IntInf => if hasConstArg ()
+                                 then eq ()
+                              else prim (Prim.intInfEqual, Vector.new0 ())
+             | Type.Ref _ => eq ()
+             | Type.Tuple tys =>
+                  let
+                     val max = Vector.length tys - 1
+                     (* test components i, i+1, ... *)
+                     fun loop (i: int): Dexp.t =
+                        if i > max
+                           then Dexp.truee
+                        else let
+                                val ty = Vector.sub (tys, i)
+                                fun select tuple =
+                                   Dexp.select {tuple = tuple,
+                                                offset = i,
+                                                ty = ty}
+                             in
+                                Dexp.conjoin
+                                (equalExp (select dx1, select dx2, ty),
+                                 loop (i + 1))
+                             end
+                  in
+                     loop 0
+                  end
+             | Type.Vector ty =>
+                  Dexp.call {func = vectorEqualFunc ty,
+                             args = Vector.new2 (dx1, dx2),
+                             ty = Type.bool}
+             | Type.Word s => prim (Prim.wordEqual s, Vector.new0 ())
+             | _ => Error.bug "PolyEqual.equal: strange type"
+         end
       fun loopBind (Statement.T {exp, var, ...}) =
-	 let
-	    fun const () = setVarInfo (valOf var, {isConst = true})
-	 in
-	    case exp of
-	       Const c =>
-		  (case c of
-		      Const.IntInf i =>
-			 if Const.SmallIntInf.isSmall i
-			    then const ()
-			 else ()
-		    | Const.Word _ => const ()
-		    | _ => ())
-	     | ConApp {args, ...} =>
-		  if Vector.isEmpty args then const () else ()
-	     | _ => ()
-	 end
+         let
+            fun const () = setVarInfo (valOf var, {isConst = true})
+         in
+            case exp of
+               Const c =>
+                  (case c of
+                      Const.IntInf i =>
+                         if Const.SmallIntInf.isSmall i
+                            then const ()
+                         else ()
+                    | Const.Word _ => const ()
+                    | _ => ())
+             | ConApp {args, ...} =>
+                  if Vector.isEmpty args then const () else ()
+             | _ => ()
+         end
       val _ = Vector.foreach (globals, loopBind)
       fun doit blocks =
-	 let
-	    val _ =
-	       Vector.foreach
-	       (blocks, fn Block.T {statements, ...} =>
-		Vector.foreach (statements, loopBind))
-	    val blocks = 
-	       Vector.fold
-	       (blocks, [], 
-		fn (Block.T {label, args, statements, transfer}, blocks) =>
-		let
-		   fun finish ({label, args, statements}, transfer) =
-		      Block.T {label = label,
-			       args = args,
-			       statements = Vector.fromListRev statements,
-			       transfer = transfer}
-		   val (blocks, las) =
-		      Vector.fold
-		      (statements, 
-		       (blocks, {label = label, args = args, statements = []}),
-		       fn (stmt as Statement.T {exp, var, ...}, 
-			   (blocks, las as {label, args, statements})) =>
-		       let
-			 fun normal () = (blocks,
-					  {label = label,
-					   args = args,
-					   statements = stmt::statements})
-		       in
-			 case exp of
-			    PrimApp {prim, targs, args, ...} =>
-			       (case (Prim.name prim, Vector.length targs) of
-				   (Prim.Name.MLton_equal, 1) =>
-				      let
-					 val ty = Vector.sub (targs, 0)
-					 fun arg i = Vector.sub (args, i)
-					 val l = Label.newNoname ()
-					 val (start',bs') =
-					    Dexp.linearizeGoto
-					    (equal (arg 0, arg 1, ty),
-					     Handler.Dead,
-					     l)
-				      in
-					(finish (las, 
-						 Goto {dst = start',
-						       args = Vector.new0 ()})
-					 :: (bs' @ blocks),
-					 {label = l,
-					  args = Vector.new1 (valOf var, Type.bool),
-					  statements = []})
-				      end
-				 | _ => normal ())
-			  | _ => normal ()
-		       end)
-		in
-		   finish (las, transfer)
-		   :: blocks
-		end)
-	 in
-	    Vector.fromList blocks
-	 end
+         let
+            val _ =
+               Vector.foreach
+               (blocks, fn Block.T {statements, ...} =>
+                Vector.foreach (statements, loopBind))
+            val blocks = 
+               Vector.fold
+               (blocks, [], 
+                fn (Block.T {label, args, statements, transfer}, blocks) =>
+                let
+                   fun finish ({label, args, statements}, transfer) =
+                      Block.T {label = label,
+                               args = args,
+                               statements = Vector.fromListRev statements,
+                               transfer = transfer}
+                   val (blocks, las) =
+                      Vector.fold
+                      (statements, 
+                       (blocks, {label = label, args = args, statements = []}),
+                       fn (stmt as Statement.T {exp, var, ...}, 
+                           (blocks, las as {label, args, statements})) =>
+                       let
+                         fun normal () = (blocks,
+                                          {label = label,
+                                           args = args,
+                                           statements = stmt::statements})
+                       in
+                         case exp of
+                            PrimApp {prim, targs, args, ...} =>
+                               (case (Prim.name prim, Vector.length targs) of
+                                   (Prim.Name.MLton_equal, 1) =>
+                                      let
+                                         val ty = Vector.sub (targs, 0)
+                                         fun arg i = Vector.sub (args, i)
+                                         val l = Label.newNoname ()
+                                         val (start',bs') =
+                                            Dexp.linearizeGoto
+                                            (equal (arg 0, arg 1, ty),
+                                             Handler.Dead,
+                                             l)
+                                      in
+                                        (finish (las, 
+                                                 Goto {dst = start',
+                                                       args = Vector.new0 ()})
+                                         :: (bs' @ blocks),
+                                         {label = l,
+                                          args = Vector.new1 (valOf var, Type.bool),
+                                          statements = []})
+                                      end
+                                 | _ => normal ())
+                          | _ => normal ()
+                       end)
+                in
+                   finish (las, transfer)
+                   :: blocks
+                end)
+         in
+            Vector.fromList blocks
+         end
       val functions =
-	 List.revMap 
-	 (functions, fn f =>
-	  let
-	     val {args, blocks, mayInline, name, raises, returns, start} =
-		Function.dest f
-	  in
-	     shrink (Function.new {args = args,
-				   blocks = doit blocks,
-				   mayInline = mayInline,
-				   name = name,
-				   raises = raises,
-				   returns = returns,
-				   start = start})
-	  end)
+         List.revMap 
+         (functions, fn f =>
+          let
+             val {args, blocks, mayInline, name, raises, returns, start} =
+                Function.dest f
+          in
+             shrink (Function.new {args = args,
+                                   blocks = doit blocks,
+                                   mayInline = mayInline,
+                                   name = name,
+                                   raises = raises,
+                                   returns = returns,
+                                   start = start})
+          end)
       val program =
-	 Program.T {datatypes = datatypes,
-		    globals = globals,
-		    functions = (!newFunctions) @ functions,
-		    main = main}
+         Program.T {datatypes = datatypes,
+                    globals = globals,
+                    functions = (!newFunctions) @ functions,
+                    main = main}
       val _ = destroyType ()
       val _ = Program.clearTop program
    in

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ssa/poly-equal.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ssa/poly-equal.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ssa/poly-equal.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
    
 signature POLY_EQUAL_STRUCTS = 
    sig

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ssa/prepasses.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ssa/prepasses.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ssa/prepasses.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,16 +1,16 @@
-(* Copyright (C) 2005 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 2005-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 functor PrePasses (S: PREPASSES_STRUCTS): PREPASSES = 
 struct
 
 open S
 
 type int = Int.t
-type word = Word.t
 
 open Exp Transfer
 
@@ -32,32 +32,32 @@
 structure LabelInfo =
    struct
       datatype t = T of {args: (Var.t * Type.t) vector,
-			 inDeg: int ref,
-			 mustBreak: bool,
-			 outDeg: int ref}
+                         inDeg: int ref,
+                         mustBreak: bool,
+                         outDeg: int ref}
 
       local
-	 fun make f (T r) = f r
-	 fun make' f = (make f, ! o (make f))
+         fun make f (T r) = f r
+         fun make' f = (make f, ! o (make f))
       in
-	 val args = make #args
-	 val (inDeg', inDeg) = make' #inDeg
-	 val mustBreak = make #mustBreak
-	 val (outDeg', outDeg) = make' #outDeg
+         val args = make #args
+         val (inDeg', inDeg) = make' #inDeg
+         val mustBreak = make #mustBreak
+         val (outDeg', outDeg) = make' #outDeg
       end
 
       fun new (args, mustBreak): t = T {args = args, 
-					inDeg = ref 0, 
-					mustBreak = mustBreak,
-					outDeg = ref 0}
+                                        inDeg = ref 0, 
+                                        mustBreak = mustBreak,
+                                        outDeg = ref 0}
    end
 
 fun breakFunction (f, {codeMotion: bool}) =
    let
       val {get = labelInfo: Label.t -> LabelInfo.t, 
-	   set = setLabelInfo, ...} =
-	 Property.getSetOnce
-	 (Label.plist, Property.initRaise ("CriticalEdges.labelInfo", Label.layout))
+           set = setLabelInfo, ...} =
+         Property.getSetOnce
+         (Label.plist, Property.initRaise ("CriticalEdges.labelInfo", Label.layout))
       val argsLabel = LabelInfo.args o labelInfo
       val inDeg = LabelInfo.inDeg o labelInfo
       val inDeg' = LabelInfo.inDeg' o labelInfo
@@ -66,92 +66,92 @@
       val outDeg' = LabelInfo.outDeg' o labelInfo
 
       val {args, blocks, mayInline,
-	   name, raises, returns, start} = Function.dest f
+           name, raises, returns, start} = Function.dest f
 
       val _ = 
-	 Vector.foreach
-	 (blocks, fn Block.T {args, label, transfer, ...} =>
-	  let
-	     val mustBreak =
-		case transfer of
-		   Arith _ => true
-		 | Call _ => true
-		 | Runtime _ => true
-		 | _ => false
-	  in
-	     setLabelInfo (label, LabelInfo.new (args, mustBreak))
-	  end)
+         Vector.foreach
+         (blocks, fn Block.T {args, label, transfer, ...} =>
+          let
+             val mustBreak =
+                case transfer of
+                   Arith _ => true
+                 | Call _ => true
+                 | Runtime _ => true
+                 | _ => false
+          in
+             setLabelInfo (label, LabelInfo.new (args, mustBreak))
+          end)
       val _ =
-	 Vector.foreach
-	 (blocks, fn Block.T {label, transfer, ...} =>
-	  let
-	     val outDeg' = outDeg' label
-	     fun doit l =
-		(Int.inc outDeg'
-		 ; Int.inc (inDeg' l))
-	  in
-	     Transfer.foreachLabel
-	     (transfer, doit)
-	  end)
-	 
+         Vector.foreach
+         (blocks, fn Block.T {label, transfer, ...} =>
+          let
+             val outDeg' = outDeg' label
+             fun doit l =
+                (Int.inc outDeg'
+                 ; Int.inc (inDeg' l))
+          in
+             Transfer.foreachLabel
+             (transfer, doit)
+          end)
+         
       val newBlocks = ref []
       fun newBlock l =
-	 let
-	    val l' = Label.newString "L_crit"
-	    val args =
-	       Vector.map
-	       (argsLabel l, fn (x, ty) =>
-		(Var.new x, ty))
-	    val _ =
-	       List.push
-	       (newBlocks,
-		Block.T {args = args,
-			 label = l',
-			 statements = Vector.new0 (),
-			 transfer = Goto {dst = l,
-					  args = Vector.map(args, #1)}})
-	 in
-	    l'
-	 end
+         let
+            val l' = Label.newString "L_crit"
+            val args =
+               Vector.map
+               (argsLabel l, fn (x, ty) =>
+                (Var.new x, ty))
+            val _ =
+               List.push
+               (newBlocks,
+                Block.T {args = args,
+                         label = l',
+                         statements = Vector.new0 (),
+                         transfer = Goto {dst = l,
+                                          args = Vector.map(args, #1)}})
+         in
+            l'
+         end
       val blocks =
-	 Vector.map
-	 (blocks, fn b as Block.T {args, label, statements, transfer} =>
-	  if (codeMotion andalso mustBreak label) 
-	     orelse outDeg label >= 2
-	     then let
-		     fun doit t =
-			Transfer.replaceLabel
-			(t, fn l =>
-			 if inDeg l > 1 
-			    then newBlock l
-			    else l)
-		  in
-		     Block.T {args = args,
-			      label = label,
-			      statements = statements,
-			      transfer = doit transfer}
-		  end
-	     else b)
+         Vector.map
+         (blocks, fn b as Block.T {args, label, statements, transfer} =>
+          if (codeMotion andalso mustBreak label) 
+             orelse outDeg label >= 2
+             then let
+                     fun doit t =
+                        Transfer.replaceLabel
+                        (t, fn l =>
+                         if inDeg l > 1 
+                            then newBlock l
+                            else l)
+                  in
+                     Block.T {args = args,
+                              label = label,
+                              statements = statements,
+                              transfer = doit transfer}
+                  end
+             else b)
    in
       Function.new {args = args,
-		    blocks = Vector.concat [blocks, Vector.fromList (!newBlocks)],
-		    mayInline = mayInline,
-		    name = name,
-		    raises = raises,
-		    returns = returns,
-		    start = start}
+                    blocks = Vector.concat [blocks, Vector.fromList (!newBlocks)],
+                    mayInline = mayInline,
+                    name = name,
+                    raises = raises,
+                    returns = returns,
+                    start = start}
    end
 
 fun break (Program.T {datatypes, globals, functions, main}, codeMotion) =
    let
       val functions = 
-	 List.revMap (functions, fn f => 
-		      breakFunction (f, codeMotion))
+         List.revMap (functions, fn f => 
+                      breakFunction (f, codeMotion))
    in
       Program.T {datatypes = datatypes,
-		 globals = globals,
-		 functions = functions,
-		 main = main}
+                 globals = globals,
+                 functions = functions,
+                 main = main}
    end
 end
 
@@ -165,64 +165,93 @@
 fun eliminateFunction f =
    let
       val {args, blocks, mayInline, name, raises, returns, start} =
-	 Function.dest f
+         Function.dest f
       val {get = isLive, set = setLive, rem} =
-	 Property.getSetOnce (Label.plist, Property.initConst false)
+         Property.getSetOnce (Label.plist, Property.initConst false)
       val _ = Function.dfs (f, fn Block.T {label, ...} =>
-			    (setLive (label, true)
-			     ; fn () => ()))
+                            (setLive (label, true)
+                             ; fn () => ()))
       val f =
-	 if Vector.forall (blocks, isLive o Block.label)
-	    then f
-	 else
-	    let 
-	       val blocks =
-		  Vector.keepAll
-		  (blocks, isLive o Block.label)
-	    in
-	       Function.new {args = args,
-			     blocks = blocks,
-			     mayInline = mayInline,
-			     name = name,
-			     raises = raises,
-			     returns = returns,
-			     start = start}
-	    end
+         if Vector.forall (blocks, isLive o Block.label)
+            then f
+         else
+            let 
+               val blocks =
+                  Vector.keepAll
+                  (blocks, isLive o Block.label)
+            in
+               Function.new {args = args,
+                             blocks = blocks,
+                             mayInline = mayInline,
+                             name = name,
+                             raises = raises,
+                             returns = returns,
+                             start = start}
+            end
        val _ = Vector.foreach (blocks, rem o Block.label)
    in
      f
    end
 
 fun eliminate (Program.T {datatypes, globals, functions, main}) =
-   let
-      val functions = List.revMap (functions, eliminateFunction)
-   in
-      Program.T {datatypes = datatypes,
-		 globals = globals,
-		 functions = functions,
-		 main = main}
-   end
+   Program.T {datatypes = datatypes,
+              globals = globals,
+              functions = List.revMap (functions, eliminateFunction),
+              main = main}
 end
 
 val eliminateDeadBlocksFunction = DeadBlocks.eliminateFunction
 val eliminateDeadBlocks = DeadBlocks.eliminate
 
+
 structure Reverse =
 struct
 
-fun reverseFunctions (program as Program.T {globals, datatypes, functions, main}) =
+fun reverseFunctions (Program.T {globals, datatypes, functions, main}) =
+   Program.T {datatypes = datatypes,
+              globals = globals,
+              functions = List.rev functions,
+              main = main}
+end
+
+val reverseFunctions = Reverse.reverseFunctions
+
+
+structure DropProfile =
+struct
+
+fun dropFunction f =
    let
-      val program =
-	 Program.T {datatypes = datatypes,
-		    globals = globals,
-		    functions = List.rev functions,
-		    main = main}
+      val {args, blocks, mayInline, name, raises, returns, start} =
+         Function.dest f
+      val blocks =
+         Vector.map
+         (blocks, fn Block.T {args, label, statements, transfer} =>
+          Block.T {args = args,
+                   label = label,
+                   statements = Vector.keepAll
+                                (statements, 
+                                 fn Statement.T {exp = Exp.Profile _, ...} => false
+                                  | _ => true),
+                   transfer = transfer})
    in
-      program
+      Function.new {args = args,
+                    blocks = blocks,
+                    mayInline = mayInline,
+                    name = name,
+                    raises = raises,
+                    returns = returns,
+                    start = start}
    end
 
+fun drop (Program.T {datatypes, globals, functions, main}) =
+   (Control.profile := Control.ProfileNone
+    ; Program.T {datatypes = datatypes,
+                 globals = globals,
+                 functions = List.map (functions, dropFunction),
+                 main = main})
 end
 
-val reverseFunctions = Reverse.reverseFunctions
+val dropProfile = DropProfile.drop
 
-end
\ No newline at end of file
+end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ssa/prepasses.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ssa/prepasses.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ssa/prepasses.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 2005 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 2005-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature PREPASSES_STRUCTS = 
    sig
       include TYPE_CHECK
@@ -26,9 +27,10 @@
        * one with two or more predecessors.
        *)
       val breakCriticalEdgesFunction: 
-	 Function.t * {codeMotion: bool} -> Function.t
+         Function.t * {codeMotion: bool} -> Function.t
       val breakCriticalEdges: 
-	 Program.t * {codeMotion: bool} -> Program.t
+         Program.t * {codeMotion: bool} -> Program.t
+      val dropProfile: Program.t -> Program.t
       val eliminateDeadBlocksFunction: Function.t -> Function.t
       val eliminateDeadBlocks: Program.t -> Program.t
       val reverseFunctions: Program.t -> Program.t

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ssa/prepasses2.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ssa/prepasses2.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ssa/prepasses2.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 2005 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 2005-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 functor PrePasses2 (S: PREPASSES2_STRUCTS): PREPASSES2 = 
 struct
 
@@ -15,64 +16,93 @@
 fun eliminateFunction f =
    let
       val {args, blocks, mayInline, name, raises, returns, start} =
-	 Function.dest f
+         Function.dest f
       val {get = isLive, set = setLive, rem} =
-	 Property.getSetOnce (Label.plist, Property.initConst false)
+         Property.getSetOnce (Label.plist, Property.initConst false)
       val _ = Function.dfs (f, fn Block.T {label, ...} =>
-			    (setLive (label, true)
-			     ; fn () => ()))
+                            (setLive (label, true)
+                             ; fn () => ()))
       val f =
-	 if Vector.forall (blocks, isLive o Block.label)
-	    then f
-	 else
-	    let 
-	       val blocks =
-		  Vector.keepAll
-		  (blocks, isLive o Block.label)
-	    in
-	       Function.new {args = args,
-			     blocks = blocks,
-			     mayInline = mayInline,
-			     name = name,
-			     raises = raises,
-			     returns = returns,
-			     start = start}
-	    end
+         if Vector.forall (blocks, isLive o Block.label)
+            then f
+         else
+            let 
+               val blocks =
+                  Vector.keepAll
+                  (blocks, isLive o Block.label)
+            in
+               Function.new {args = args,
+                             blocks = blocks,
+                             mayInline = mayInline,
+                             name = name,
+                             raises = raises,
+                             returns = returns,
+                             start = start}
+            end
        val _ = Vector.foreach (blocks, rem o Block.label)
    in
      f
    end
 
 fun eliminate (Program.T {datatypes, globals, functions, main}) =
-   let
-      val functions = List.revMap (functions, eliminateFunction)
-   in
-      Program.T {datatypes = datatypes,
-		 globals = globals,
-		 functions = functions,
-		 main = main}
-   end
+   Program.T {datatypes = datatypes,
+              globals = globals,
+              functions = List.revMap (functions, eliminateFunction),
+              main = main}
 end
 
 val eliminateDeadBlocksFunction = DeadBlocks.eliminateFunction
 val eliminateDeadBlocks = DeadBlocks.eliminate
 
+
 structure Reverse =
 struct
 
-fun reverseFunctions (program as Program.T {globals, datatypes, functions, main}) =
+fun reverseFunctions (Program.T {globals, datatypes, functions, main}) =
+   Program.T {datatypes = datatypes,
+              globals = globals,
+              functions = List.rev functions,
+              main = main}
+end
+
+val reverseFunctions = Reverse.reverseFunctions
+
+
+structure DropProfile =
+struct
+
+fun dropFunction f =
    let
-      val program =
-	 Program.T {datatypes = datatypes,
-		    globals = globals,
-		    functions = List.rev functions,
-		    main = main}
+      val {args, blocks, mayInline, name, raises, returns, start} =
+         Function.dest f
+      val blocks =
+         Vector.map
+         (blocks, fn Block.T {args, label, statements, transfer} =>
+          Block.T {args = args,
+                   label = label,
+                   statements = Vector.keepAll
+                                (statements, 
+                                 fn Statement.Profile _ => false
+                                  | _ => true),
+                   transfer = transfer})
    in
-      program
+      Function.new {args = args,
+                    blocks = blocks,
+                    mayInline = mayInline,
+                    name = name,
+                    raises = raises,
+                    returns = returns,
+                    start = start}
    end
 
+fun drop (Program.T {datatypes, globals, functions, main}) =
+   (Control.profile := Control.ProfileNone
+    ; Program.T {datatypes = datatypes,
+                 globals = globals,
+                 functions = List.revMap (functions, dropFunction),
+                 main = main})
 end
 
-val reverseFunctions = Reverse.reverseFunctions
+val dropProfile = DropProfile.drop
 
 end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ssa/prepasses2.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ssa/prepasses2.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ssa/prepasses2.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 2005 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 2005-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature PREPASSES2_STRUCTS = 
    sig
       include TYPE_CHECK2
@@ -13,6 +14,7 @@
    sig
       include PREPASSES2_STRUCTS
 
+      val dropProfile: Program.t -> Program.t
       val eliminateDeadBlocksFunction: Function.t -> Function.t
       val eliminateDeadBlocks: Program.t -> Program.t
       val reverseFunctions: Program.t -> Program.t

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ssa/redundant-tests.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ssa/redundant-tests.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ssa/redundant-tests.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 functor RedundantTests (S: REDUNDANT_TESTS_STRUCTS): REDUNDANT_TESTS = 
 struct
 
@@ -15,7 +16,7 @@
 structure Rel =
    struct
       datatype t =
-	 EQ
+         EQ
        | LT of {signed: bool}
        | LE of {signed: bool}
        | NE
@@ -23,10 +24,10 @@
       val equals: t * t -> bool = op =
 
       val toString =
-	 fn EQ => "="
-	  | LT _ => "<"
-	  | LE _ => "<="
-	  | NE => "<>"
+         fn EQ => "="
+          | LT _ => "<"
+          | LE _ => "<="
+          | NE => "<>"
 
       val layout = Layout.str o toString
    end
@@ -34,58 +35,58 @@
 structure Oper =
    struct
       datatype t =
-	 Const of Const.t
+         Const of Const.t
        | Var of Var.t
 
       val layout =
-	 fn Const c => Const.layout c
-	  | Var x => Var.layout x
+         fn Const c => Const.layout c
+          | Var x => Var.layout x
 
       val equals =
-	 fn (Const c, Const c') => Const.equals (c, c')
-	  | (Var x, Var x') => Var.equals (x, x')
-	  | _ => false
+         fn (Const c, Const c') => Const.equals (c, c')
+          | (Var x, Var x') => Var.equals (x, x')
+          | _ => false
    end
 
 structure Fact =
    struct
       datatype t = T of {rel: Rel.t,
-			 lhs: Oper.t,
-			 rhs: Oper.t}
+                         lhs: Oper.t,
+                         rhs: Oper.t}
 
       fun layout (T {rel, lhs, rhs}) =
-	 let open Layout
-	 in seq [Oper.layout lhs, str " ", Rel.layout rel,
-		 str " ", Oper.layout rhs]
-	 end
+         let open Layout
+         in seq [Oper.layout lhs, str " ", Rel.layout rel,
+                 str " ", Oper.layout rhs]
+         end
 
       fun equals (T {rel, lhs = l, rhs = r},
-		  T {rel = rel', lhs = l', rhs = r'}) =
-	 Rel.equals (rel, rel')
-	 andalso Oper.equals (l, l')
-	 andalso Oper.equals (r, r')
+                  T {rel = rel', lhs = l', rhs = r'}) =
+         Rel.equals (rel, rel')
+         andalso Oper.equals (l, l')
+         andalso Oper.equals (r, r')
 
       fun negate (T {rel, lhs, rhs}): t =
-	 let
-	    datatype z = datatype Rel.t
-	    val rel =
-	       case rel of
-		  EQ => NE
-		| LT s => LE s
-		| LE s => LT s
-		| NE => EQ
-	 in
-	    T {rel = rel, lhs = rhs, rhs = lhs}
-	 end
+         let
+            datatype z = datatype Rel.t
+            val rel =
+               case rel of
+                  EQ => NE
+                | LT s => LE s
+                | LE s => LT s
+                | NE => EQ
+         in
+            T {rel = rel, lhs = rhs, rhs = lhs}
+         end
 
       datatype result = False | True | Unknown
-	 
+         
       fun determine (facts: t list, f: t): result =
-	 if List.contains (facts, f, equals)
-	    then True
-	 else if List.contains (facts, negate f, equals)
-		 then False
-	      else Unknown
+         if List.contains (facts, f, equals)
+            then True
+         else if List.contains (facts, negate f, equals)
+                 then False
+              else Unknown
    end
 
 open Exp Transfer
@@ -93,417 +94,414 @@
 fun simplify (Program.T {globals, datatypes, functions, main}) =
    let
       datatype varInfo =
-	 Const of Const.t
+         Const of Const.t
        | Fact of Fact.t
        | None
        | Or of Fact.t * Fact.t
       val {get = varInfo: Var.t -> varInfo, set = setVarInfo, ...} =
-	 Property.getSetOnce (Var.plist, Property.initConst None)
+         Property.getSetOnce (Var.plist, Property.initConst None)
       val setVarInfo =
-	 Trace.trace ("RedundantTests.setVarInfo",
-		      Var.layout o #1,
-		      Unit.layout)
-	 setVarInfo
+         Trace.trace ("RedundantTests.setVarInfo",
+                      Var.layout o #1,
+                      Unit.layout)
+         setVarInfo
       datatype z = datatype Fact.result
       datatype z = datatype Rel.t
       fun makeVarInfo {args, prim, targs = _}: varInfo =
-	 let
-	    fun arg i =
-	       let
-		  val x = Vector.sub (args, i)
-	       in
-		  case varInfo x of
-		     Const c => Oper.Const c
-		   | _ => Oper.Var x
-	       end
-	    fun z (r, a, b) =
-	       Fact (Fact.T {rel = r,
-			     lhs = arg a,
-			     rhs = arg b})
-	    fun doit rel = z (rel, 0, 1)
-	    datatype z = datatype Prim.Name.t
-	 in
-	    case Prim.name prim of
-	       MLton_eq => doit EQ
-	     | Word_equal _ => doit EQ
-	     | Word_lt (_, sg) => doit (LT sg)
-	     | _ => None
-	 end
+         let
+            fun arg i =
+               let
+                  val x = Vector.sub (args, i)
+               in
+                  case varInfo x of
+                     Const c => Oper.Const c
+                   | _ => Oper.Var x
+               end
+            fun z (r, a, b) =
+               Fact (Fact.T {rel = r,
+                             lhs = arg a,
+                             rhs = arg b})
+            fun doit rel = z (rel, 0, 1)
+            datatype z = datatype Prim.Name.t
+         in
+            case Prim.name prim of
+               MLton_eq => doit EQ
+             | Word_equal _ => doit EQ
+             | Word_lt (_, sg) => doit (LT sg)
+             | _ => None
+         end
       fun setConst (x, c) = setVarInfo (x, Const c)
       val _ =
-	 Vector.foreach
-	 (globals, fn Statement.T {var, exp, ...} =>
-	  case exp of
-	     Exp.Const c => Option.app (var, fn x => setConst (x, c))
-	   | _ => ())
+         Vector.foreach
+         (globals, fn Statement.T {var, exp, ...} =>
+          case exp of
+             Exp.Const c => Option.app (var, fn x => setConst (x, c))
+           | _ => ())
       local
-	 fun make c =
-	    let
-	       val x = Var.newNoname ()
-	    in
-	       (x,
-		Statement.T {var = SOME x, 
-			     ty = Type.bool,
-			     exp = ConApp {con = c, args = Vector.new0 ()}})
-	    end
+         fun make c =
+            let
+               val x = Var.newNoname ()
+            in
+               (x,
+                Statement.T {var = SOME x, 
+                             ty = Type.bool,
+                             exp = ConApp {con = c, args = Vector.new0 ()}})
+            end
       in
-	 val (trueVar, t) = make Con.truee
-	 val (falseVar, f) = make Con.falsee
+         val (trueVar, t) = make Con.truee
+         val (falseVar, f) = make Con.falsee
       end
       local
-	 val statements = ref []
+         val statements = ref []
       in
-	 val one =
-	    WordSize.memoize
-	    (fn s =>
-	     let
-		val one = Var.newNoname ()
-		val () =
-		   List.push
-		   (statements,
-		    Statement.T {exp = Exp.Const (Const.word (WordX.one s)),
-				 ty = Type.word s,
-				 var = SOME one})
-	     in
-		one
-	     end)
-	 val ones = Vector.fromList (!statements)
+         val one =
+            WordSize.memoize
+            (fn s =>
+             let
+                val one = Var.newNoname ()
+                val () =
+                   List.push
+                   (statements,
+                    Statement.T {exp = Exp.Const (Const.word (WordX.one s)),
+                                 ty = Type.word s,
+                                 var = SOME one})
+             in
+                one
+             end)
+         val ones = Vector.fromList (!statements)
       end
       val globals = Vector.concat [Vector.new2 (t, f), ones, globals]
       val shrink = shrinkFunction {globals = globals}
       val numSimplified = ref 0
       fun simplifyFunction f =
-	  let
-	     val {args, blocks, mayInline, name, raises, returns, start} =
-		Function.dest f
-	     val _ =
-		Control.diagnostic
-		(fn () => 
-		 let open Layout
-		 in seq [str "processing ", Func.layout name]
-		 end)
-	     val {get = labelInfo: Label.t -> {ancestor: Label.t option ref,
-					       facts: Fact.t list ref,
-					       inDeg: int ref},
-		  ...} =
-		Property.get
-		(Label.plist, Property.initFun (fn _ => {ancestor = ref NONE,
-							 facts = ref [],
-							 inDeg = ref 0}))
-	     (* Set up inDeg. *)
-	     val _ =
-		Vector.foreach
-		(blocks, fn Block.T {transfer, ...} =>
-		 Transfer.foreachLabel
-		 (transfer, Int.inc o #inDeg o labelInfo))
-	     (* Perform analysis, set up facts, and set up ancestor. *)
-	     fun loop (Tree.T (Block.T {label, statements, transfer, ...},
-			       children),
-		       ancestor') =
-	        let
-		   val _ = 
-		      Vector.foreach
-		      (statements, fn Statement.T {var, exp, ...} =>
-		       case exp of
-			  Exp.Const c =>
-			     Option.app (var, fn x => setConst (x, c))
-			| Exp.PrimApp pa =>
-			     Option.app (var, fn x =>
-					 setVarInfo (x, makeVarInfo pa))
-			| _ => ())
-		   val _ = 
-		      case transfer of
-			 Case {test, cases, default, ...} =>
-			    let
-			       fun add (l, f) =
-				  let
-				     val {facts, inDeg, ...} = labelInfo l
-				  in
-				     if !inDeg = 1
-				        then List.push (facts, f)
-				     else ()
-				  end		
-			       fun falseTrue () =
-				  case cases of
-				     Cases.Con v =>
-				        let
-					   fun ca i = Vector.sub (v, i)
-					in
-					   case (Vector.length v, default) of
-					      (1, SOME l') =>
-						 let
-						    val (c, l) = ca 0
-						 in
-						    if Con.equals (c, Con.truee)
-						       then (l', l)
-						    else (l, l')
-						 end
-					    | (2, _) =>
-						 let
-						    val (c, l) = ca 0
-						    val (_, l') = ca 1
-						 in
-						    if Con.equals (c, Con.truee)
-						       then (l', l)
-						    else (l, l')
-						 end
-					    | _ => Error.bug "redundant expected two branches"
-					end
-				   | _ => Error.bug "redundant expected con"
-			    in
-			       case varInfo test of
-				  Fact f =>
-				     let
-				        val (l, l') = falseTrue ()
-				     in
-				       add (l, Fact.negate f)
-				       ; add (l', f)
-				     end
-				| Or (f, f') =>
-				     let
-				        val (l, _) = falseTrue ()
-				     in
-				        add (l, Fact.negate f) 
-					; add (l, Fact.negate f')
-				     end
-				| _ => ()
-			    end
-		       | _ => ()
+          let
+             val {args, blocks, mayInline, name, raises, returns, start} =
+                Function.dest f
+             val _ =
+                Control.diagnostic
+                (fn () => 
+                 let open Layout
+                 in seq [str "processing ", Func.layout name]
+                 end)
+             val {get = labelInfo: Label.t -> {ancestor: Label.t option ref,
+                                               facts: Fact.t list ref,
+                                               inDeg: int ref},
+                  ...} =
+                Property.get
+                (Label.plist, Property.initFun (fn _ => {ancestor = ref NONE,
+                                                         facts = ref [],
+                                                         inDeg = ref 0}))
+             (* Set up inDeg. *)
+             val _ =
+                Vector.foreach
+                (blocks, fn Block.T {transfer, ...} =>
+                 Transfer.foreachLabel
+                 (transfer, Int.inc o #inDeg o labelInfo))
+             (* Perform analysis, set up facts, and set up ancestor. *)
+             fun loop (Tree.T (Block.T {label, statements, transfer, ...},
+                               children),
+                       ancestor') =
+                let
+                   val _ = 
+                      Vector.foreach
+                      (statements, fn Statement.T {var, exp, ...} =>
+                       case exp of
+                          Exp.Const c =>
+                             Option.app (var, fn x => setConst (x, c))
+                        | Exp.PrimApp pa =>
+                             Option.app (var, fn x =>
+                                         setVarInfo (x, makeVarInfo pa))
+                        | _ => ())
+                   val _ = 
+                      case transfer of
+                         Case {test, cases, default, ...} =>
+                            let
+                               fun add (l, f) =
+                                  let
+                                     val {facts, inDeg, ...} = labelInfo l
+                                  in
+                                     if !inDeg = 1
+                                        then List.push (facts, f)
+                                     else ()
+                                  end           
+                               fun falseTrue () =
+                                  case cases of
+                                     Cases.Con v =>
+                                        let
+                                           fun ca i = Vector.sub (v, i)
+                                        in
+                                           case (Vector.length v, default) of
+                                              (1, SOME l') =>
+                                                 let
+                                                    val (c, l) = ca 0
+                                                 in
+                                                    if Con.equals (c, Con.truee)
+                                                       then (l', l)
+                                                    else (l, l')
+                                                 end
+                                            | (2, _) =>
+                                                 let
+                                                    val (c, l) = ca 0
+                                                    val (_, l') = ca 1
+                                                 in
+                                                    if Con.equals (c, Con.truee)
+                                                       then (l', l)
+                                                    else (l, l')
+                                                 end
+                                            | _ => Error.bug "RedundantTests.simplifyFunction: expected two branches"
+                                        end
+                                   | _ => Error.bug "RedundantTests.simplifyFunction: expected con"
+                            in
+                               case varInfo test of
+                                  Fact f =>
+                                     let
+                                        val (l, l') = falseTrue ()
+                                     in
+                                       add (l, Fact.negate f)
+                                       ; add (l', f)
+                                     end
+                                | Or (f, f') =>
+                                     let
+                                        val (l, _) = falseTrue ()
+                                     in
+                                        add (l, Fact.negate f) 
+                                        ; add (l, Fact.negate f')
+                                     end
+                                | _ => ()
+                            end
+                       | _ => ()
 
-		   val {ancestor, facts, ...} = labelInfo label
-		   val _ = ancestor := ancestor'
-		   val ancestor' = if List.isEmpty (!facts)
-				      then ancestor'
-				   else SOME label
-		in
-		   Vector.foreach 
-		   (children, fn tree => loop (tree, ancestor'))
-		end
-	     val _ = loop (Function.dominatorTree f, NONE)
-	     (* Diagnostic. *)
-	     val _ = 
-		Control.diagnostics
-		(fn display =>
-		 Vector.foreach
-		 (blocks, fn Block.T {label, ...} =>
-		  let open Layout
-		  in display (seq [Label.layout label,
-				   str " ",
-				   List.layout Fact.layout
-				   (! (#facts (labelInfo label)))])
-		  end))
+                   val {ancestor, facts, ...} = labelInfo label
+                   val _ = ancestor := ancestor'
+                   val ancestor' = if List.isEmpty (!facts)
+                                      then ancestor'
+                                   else SOME label
+                in
+                   Vector.foreach 
+                   (children, fn tree => loop (tree, ancestor'))
+                end
+             val _ = loop (Function.dominatorTree f, NONE)
+             (* Diagnostic. *)
+             val _ = 
+                Control.diagnostics
+                (fn display =>
+                 Vector.foreach
+                 (blocks, fn Block.T {label, ...} =>
+                  let open Layout
+                  in display (seq [Label.layout label,
+                                   str " ",
+                                   List.layout Fact.layout
+                                   (! (#facts (labelInfo label)))])
+                  end))
              (* Transformation. *)
-	     fun isFact (l: Label.t, p: Fact.t -> bool): bool =
-		let
-		   fun loop (l: Label.t) =
-		      let
-			 val {ancestor, facts, ...} = labelInfo l
-		      in
-			 List.exists (!facts, p)
-			 orelse (case !ancestor of
-				    NONE => false
-				  | SOME l => loop l)
-		      end
-		in
-		   loop l
-		end
-	     fun determine (l: Label.t, f: Fact.t) =
-	        let
-		   fun loop {ancestor, facts, ...} =
-		      case Fact.determine (!facts, f) of
-		         Unknown =>
-			    (case !ancestor of
-			        NONE => Unknown
-			      | SOME l => loop (labelInfo l))
-		     | r => r
-		in
-		   loop (labelInfo l)
-		end
-	     val blocks =
-	        Vector.map
-		(blocks, fn Block.T {label, args, statements, transfer} =>
-		 let
-		    val statements =
-		       Vector.map
-		       (statements, fn statement as Statement.T {ty, var, ...} =>
-			let
-			   fun doit x =
-			      (Int.inc numSimplified
-			       ; Control.diagnostic
-			         (fn () =>
-				  let open Layout
-				  in seq [Option.layout Var.layout var,
-					  str " -> ",
-					  Var.layout x]
-				  end)
-			       ; Statement.T {var = var, 
-					      ty = ty,
-					      exp = Var x})
-			   fun falsee () = doit falseVar
-			   fun truee () = doit trueVar
-			in
-			   case var of
-			      NONE => statement
-			    | SOME var =>
-				 (case varInfo var of
-				     Or (f, f') =>
-				        (case determine (label, f) of
-					    False =>
-					       (case determine (label, f') of
-						   False => falsee ()
-						 | True => truee ()
-						 | Unknown => statement)
-					  | True => truee ()
-					  | Unknown => statement)
-				   | Fact f => 
-				        (case determine (label, f) of
-					    False => falsee ()
-					  | True => truee () 
-					  | Unknown => statement)
-				   | _ => statement)
-			end)
-		    val noChange = (statements, transfer)
-		    fun arith (args: Var.t vector,
-			       prim: Type.t Prim.t,
-			       success: Label.t)
-		       : Statement.t vector * Transfer.t =
-		       let
-			  fun simplify (prim: Type.t Prim.t,
-					x: Var.t,
-					s: WordSize.t) =
-			     let
-				val res = Var.newNoname ()
-			     in
-				(Vector.concat
-				 [statements,
-				  Vector.new1
-				  (Statement.T
-				   {exp = PrimApp {args = Vector.new2 (x, one s),
-						   prim = prim,
-						   targs = Vector.new0 ()},
-				    ty = Type.word s,
-				    var = SOME res})],
-				 Goto {args = Vector.new1 res,
-				       dst = success})
-			     end
-			  fun add1 (x: Var.t, s: WordSize.t, sg) =
-			     if isFact (label, fn Fact.T {lhs, rel, rhs} =>
-					case (lhs, rel, rhs) of
-					   (Oper.Var x', Rel.LT sg', _) =>
-					      Var.equals (x, x')
-					      andalso sg = sg'
-					 | (Oper.Var x', Rel.LE sg',
-					    Oper.Const c) =>
-					      Var.equals (x, x')
-					      andalso sg = sg'
-					      andalso
-					      (case c of
-						  Const.Word w =>
-						     WordX.lt
-						     (w, WordX.max (s, sg), sg)
-						| _ => Error.bug "strange fact")
-					 | _ => false)
-				then simplify (Prim.wordAdd s, x, s)
-			     else noChange
-			  fun sub1 (x: Var.t, s: WordSize.t, sg) =
-			     if isFact (label, fn Fact.T {lhs, rel, rhs} =>
-					case (lhs, rel, rhs) of
-					   (_, Rel.LT sg', Oper.Var x') =>
-					      Var.equals (x, x')
-					      andalso sg = sg'
-					 | (Oper.Const c, Rel.LE sg',
-					    Oper.Var x') =>
-					      Var.equals (x, x')
-					      andalso sg = sg'
-					      andalso
-					      (case c of
-						  Const.Word w =>
-						     WordX.gt
-						     (w, WordX.min (s, sg), sg)
-						| _ => Error.bug "strange fact")
-					 | _ => false)
-				then simplify (Prim.wordSub s, x, s)
-			     else noChange
-			  fun add (c: Const.t, x: Var.t, (s, sg as {signed})) =
-			     case c of
-				Const.Word i =>
-				   if WordX.isOne i
-				      then add1 (x, s, sg)
-				   else if signed andalso WordX.isNegOne i
-					   then sub1 (x, s, sg)
-					else noChange
-			      | _ => Error.bug "add of strange const"
-			  datatype z = datatype Prim.Name.t
-		       in
-			  case Prim.name prim of
-			     Word_addCheck s =>
-				let
-				   val x1 = Vector.sub (args, 0)
-				   val x2 = Vector.sub (args, 1)
-				in
-				   case varInfo x1 of
-				      Const c => add (c, x2, s)
-				    | _ => (case varInfo x2 of
-					       Const c => add (c, x1, s)
-					     | _ => noChange)
-				end
-			   | Word_subCheck (s, sg as {signed}) =>
-				let
-				   val x1 = Vector.sub (args, 0)
-				   val x2 = Vector.sub (args, 1)
-				in
-				   case varInfo x2 of
-				      Const c =>
-					 (case c of
-					     Const.Word w =>
-						if WordX.isOne w
-						   then sub1 (x1, s, sg)
-						else
-						   if (signed
-						       andalso WordX.isNegOne w)
-						      then add1 (x1, s, sg)
-						   else noChange
-					   | _ =>
-						Error.bug "sub of strage const")
-				    | _ => noChange
-				end
-			   | _ => noChange
-		       end
-		    val (statements, transfer) =
-		       if !Control.eliminateOverflow
-			  then
-			     case transfer of
-				Arith {args, prim, success, ...} =>
-				   arith (args, prim, success)
-			      | _ => noChange
-		       else noChange
-		 in
-		   Block.T {label = label,
-			    args = args,
-			    statements = statements,
-			    transfer = transfer}
-		 end)
-	  in
-	     shrink (Function.new {args = args,
-				   blocks = blocks,
-				   mayInline = mayInline,
-				   name = name,
-				   raises = raises,
-				   returns = returns,
-				   start = start})
-	  end
+             fun isFact (l: Label.t, p: Fact.t -> bool): bool =
+                let
+                   fun loop (l: Label.t) =
+                      let
+                         val {ancestor, facts, ...} = labelInfo l
+                      in
+                         List.exists (!facts, p)
+                         orelse (case !ancestor of
+                                    NONE => false
+                                  | SOME l => loop l)
+                      end
+                in
+                   loop l
+                end
+             fun determine (l: Label.t, f: Fact.t) =
+                let
+                   fun loop {ancestor, facts, ...} =
+                      case Fact.determine (!facts, f) of
+                         Unknown =>
+                            (case !ancestor of
+                                NONE => Unknown
+                              | SOME l => loop (labelInfo l))
+                     | r => r
+                in
+                   loop (labelInfo l)
+                end
+             val blocks =
+                Vector.map
+                (blocks, fn Block.T {label, args, statements, transfer} =>
+                 let
+                    val statements =
+                       Vector.map
+                       (statements, fn statement as Statement.T {ty, var, ...} =>
+                        let
+                           fun doit x =
+                              (Int.inc numSimplified
+                               ; Control.diagnostic
+                                 (fn () =>
+                                  let open Layout
+                                  in seq [Option.layout Var.layout var,
+                                          str " -> ",
+                                          Var.layout x]
+                                  end)
+                               ; Statement.T {var = var, 
+                                              ty = ty,
+                                              exp = Var x})
+                           fun falsee () = doit falseVar
+                           fun truee () = doit trueVar
+                        in
+                           case var of
+                              NONE => statement
+                            | SOME var =>
+                                 (case varInfo var of
+                                     Or (f, f') =>
+                                        (case determine (label, f) of
+                                            False =>
+                                               (case determine (label, f') of
+                                                   False => falsee ()
+                                                 | True => truee ()
+                                                 | Unknown => statement)
+                                          | True => truee ()
+                                          | Unknown => statement)
+                                   | Fact f => 
+                                        (case determine (label, f) of
+                                            False => falsee ()
+                                          | True => truee () 
+                                          | Unknown => statement)
+                                   | _ => statement)
+                        end)
+                    val noChange = (statements, transfer)
+                    fun arith (args: Var.t vector,
+                               prim: Type.t Prim.t,
+                               success: Label.t)
+                       : Statement.t vector * Transfer.t =
+                       let
+                          fun simplify (prim: Type.t Prim.t,
+                                        x: Var.t,
+                                        s: WordSize.t) =
+                             let
+                                val res = Var.newNoname ()
+                             in
+                                (Vector.concat
+                                 [statements,
+                                  Vector.new1
+                                  (Statement.T
+                                   {exp = PrimApp {args = Vector.new2 (x, one s),
+                                                   prim = prim,
+                                                   targs = Vector.new0 ()},
+                                    ty = Type.word s,
+                                    var = SOME res})],
+                                 Goto {args = Vector.new1 res,
+                                       dst = success})
+                             end
+                          fun add1 (x: Var.t, s: WordSize.t, sg) =
+                             if isFact (label, fn Fact.T {lhs, rel, rhs} =>
+                                        case (lhs, rel, rhs) of
+                                           (Oper.Var x', Rel.LT sg', _) =>
+                                              Var.equals (x, x')
+                                              andalso sg = sg'
+                                         | (Oper.Var x', Rel.LE sg',
+                                            Oper.Const c) =>
+                                              Var.equals (x, x')
+                                              andalso sg = sg'
+                                              andalso
+                                              (case c of
+                                                  Const.Word w =>
+                                                     WordX.lt
+                                                     (w, WordX.max (s, sg), sg)
+                                                | _ => Error.bug "RedundantTests.add1: strange fact")
+                                         | _ => false)
+                                then simplify (Prim.wordAdd s, x, s)
+                             else noChange
+                          fun sub1 (x: Var.t, s: WordSize.t, sg) =
+                             if isFact (label, fn Fact.T {lhs, rel, rhs} =>
+                                        case (lhs, rel, rhs) of
+                                           (_, Rel.LT sg', Oper.Var x') =>
+                                              Var.equals (x, x')
+                                              andalso sg = sg'
+                                         | (Oper.Const c, Rel.LE sg',
+                                            Oper.Var x') =>
+                                              Var.equals (x, x')
+                                              andalso sg = sg'
+                                              andalso
+                                              (case c of
+                                                  Const.Word w =>
+                                                     WordX.gt
+                                                     (w, WordX.min (s, sg), sg)
+                                                | _ => Error.bug "RedundantTests.sub1: strange fact")
+                                         | _ => false)
+                                then simplify (Prim.wordSub s, x, s)
+                             else noChange
+                          fun add (c: Const.t, x: Var.t, (s, sg as {signed})) =
+                             case c of
+                                Const.Word i =>
+                                   if WordX.isOne i
+                                      then add1 (x, s, sg)
+                                   else if signed andalso WordX.isNegOne i
+                                           then sub1 (x, s, sg)
+                                        else noChange
+                              | _ => Error.bug "RedundantTests.add: strange const"
+                          datatype z = datatype Prim.Name.t
+                       in
+                          case Prim.name prim of
+                             Word_addCheck s =>
+                                let
+                                   val x1 = Vector.sub (args, 0)
+                                   val x2 = Vector.sub (args, 1)
+                                in
+                                   case varInfo x1 of
+                                      Const c => add (c, x2, s)
+                                    | _ => (case varInfo x2 of
+                                               Const c => add (c, x1, s)
+                                             | _ => noChange)
+                                end
+                           | Word_subCheck (s, sg as {signed}) =>
+                                let
+                                   val x1 = Vector.sub (args, 0)
+                                   val x2 = Vector.sub (args, 1)
+                                in
+                                   case varInfo x2 of
+                                      Const c =>
+                                         (case c of
+                                             Const.Word w =>
+                                                if WordX.isOne w
+                                                   then sub1 (x1, s, sg)
+                                                else
+                                                   if (signed
+                                                       andalso WordX.isNegOne w)
+                                                      then add1 (x1, s, sg)
+                                                   else noChange
+                                           | _ =>
+                                                Error.bug "RedundantTests.sub: strage const")
+                                    | _ => noChange
+                                end
+                           | _ => noChange
+                       end
+                    val (statements, transfer) =
+                       case transfer of
+                          Arith {args, prim, success, ...} =>
+                             arith (args, prim, success)
+                        | _ => noChange
+                 in
+                   Block.T {label = label,
+                            args = args,
+                            statements = statements,
+                            transfer = transfer}
+                 end)
+          in
+             shrink (Function.new {args = args,
+                                   blocks = blocks,
+                                   mayInline = mayInline,
+                                   name = name,
+                                   raises = raises,
+                                   returns = returns,
+                                   start = start})
+          end
       val _ =
-	 Control.diagnostic
-	 (fn () =>
-	  let open Layout
-	  in seq [str "numSimplified = ", Int.layout (!numSimplified)]
-	  end)
+         Control.diagnostic
+         (fn () =>
+          let open Layout
+          in seq [str "numSimplified = ", Int.layout (!numSimplified)]
+          end)
       val functions = List.revMap (functions, simplifyFunction)
       val program = 
-	 Program.T {datatypes = datatypes,
-		    globals = globals,
-		    functions = functions,
-		    main = main}
+         Program.T {datatypes = datatypes,
+                    globals = globals,
+                    functions = functions,
+                    main = main}
       val _ = Program.clearTop program
    in
       program

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ssa/redundant-tests.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ssa/redundant-tests.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ssa/redundant-tests.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature REDUNDANT_TESTS_STRUCTS = 
    sig
       include SHRINK

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ssa/redundant.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ssa/redundant.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ssa/redundant.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 functor Redundant (S: REDUNDANT_STRUCTS): REDUNDANT = 
 struct
 
@@ -18,11 +19,11 @@
 structure Element:
    sig
       structure Class:
-	 sig
-	    type t
-	       
-	    val plist: t -> PropertyList.t
-	 end
+         sig
+            type t
+               
+            val plist: t -> PropertyList.t
+         end
 
       type t
 
@@ -36,173 +37,173 @@
    struct
       datatype t = T of {class: class ref}
       and class = Class of {coarserThan: refinement list ref,
-			    elements: t vector,
-			    plist: PropertyList.t}
+                            elements: t vector,
+                            plist: PropertyList.t}
       withtype refinement = {coarse: t, fine: t} vector
 
       structure Element =
-	 struct
-	    datatype t = datatype t
-	 end
+         struct
+            datatype t = datatype t
+         end
 
       structure Class =
-	 struct
-	    datatype t = datatype class
+         struct
+            datatype t = datatype class
 
-	    local
-	       fun make f (Class r) = f r
-	    in
-	       val coarserThan = make #coarserThan
-	       val plist = make #plist
-	    end
+            local
+               fun make f (Class r) = f r
+            in
+               val coarserThan = make #coarserThan
+               val plist = make #plist
+            end
 
-	    fun new elements =
-	       Class {coarserThan = ref [],
-		      elements = elements,
-		      plist = PropertyList.new ()}
+            fun new elements =
+               Class {coarserThan = ref [],
+                      elements = elements,
+                      plist = PropertyList.new ()}
 
-	    val bogus = new (Vector.new0 ())
-	 end
+            val bogus = new (Vector.new0 ())
+         end
 
       local
-	 fun make f (T r) = f r
+         fun make f (T r) = f r
       in
-	 val class = ! o make #class
+         val class = ! o make #class
       end
 
       fun setClass (T {class, ...}, c) = class := c
 
       fun 'a new (elements: 'a vector, plist: 'a -> PropertyList.t): t vector =
-	 let
-	    val classes: t list ref list ref = ref []
-	    val {destroy, get = class: 'a -> t list ref, ...} =
-	       Property.destGet
-	       (plist, Property.initFun (fn _ =>
-					 let
-					    val class = ref []
-					    val () = List.push (classes, class)
-					 in
-					    class
-					 end))
-	    val elements =
-	       Vector.map (elements, fn a =>
-			   let
-			      val elt = T {class = ref Class.bogus}
-			      val () = List.push (class a, elt)
-			   in
-			      elt
-			   end)
-	    val () = destroy ()
-	    val () = List.foreach (!classes, fn r =>
-				   let
-				      val elements = Vector.fromList (!r)
-				      val class = Class.new elements
-				      val () =
-					 Vector.foreach
-					 (elements, fn e => setClass (e, class))
-				   in
-				      ()
-				   end)
-	 in
-	    elements
-	 end
+         let
+            val classes: t list ref list ref = ref []
+            val {destroy, get = class: 'a -> t list ref, ...} =
+               Property.destGet
+               (plist, Property.initFun (fn _ =>
+                                         let
+                                            val class = ref []
+                                            val () = List.push (classes, class)
+                                         in
+                                            class
+                                         end))
+            val elements =
+               Vector.map (elements, fn a =>
+                           let
+                              val elt = T {class = ref Class.bogus}
+                              val () = List.push (class a, elt)
+                           in
+                              elt
+                           end)
+            val () = destroy ()
+            val () = List.foreach (!classes, fn r =>
+                                   let
+                                      val elements = Vector.fromList (!r)
+                                      val class = Class.new elements
+                                      val () =
+                                         Vector.foreach
+                                         (elements, fn e => setClass (e, class))
+                                   in
+                                      ()
+                                   end)
+         in
+            elements
+         end
 
       fun new1 () =
-	 let
-	    val e = T {class = ref Class.bogus}
-	    val c = Class.new (Vector.new1 e)
-	    val () = setClass (e, c)
-	 in
-	    e
-	 end
+         let
+            val e = T {class = ref Class.bogus}
+            val c = Class.new (Vector.new1 e)
+            val () = setClass (e, c)
+         in
+            e
+         end
 
       fun forceDistinct (es: t vector): unit =
-	 Vector.foreach
-	 (es, fn e =>
-	  let
-	     val c = Class.new (Vector.new1 e)
-	     val () = setClass (e, c)
-	  in
-	     ()
-	  end)
+         Vector.foreach
+         (es, fn e =>
+          let
+             val c = Class.new (Vector.new1 e)
+             val () = setClass (e, c)
+          in
+             ()
+          end)
 
       structure Refinement =
-	 struct
-	    type t = refinement
-	       
-	    fun group (v: t, sel): t list =
-	       let
-		  val classes = ref []
-		  val {destroy, get: Class.t -> {coarse: Element.t,
-						 fine: Element.t} list ref,
-		       ...} =
-		     Property.destGet
-		     (Class.plist,
-		      Property.initFun (fn _ =>
-					let
-					   val r = ref []
-					   val () = List.push (classes, r)
-					in
-					   r
-					end))
-		  val () =
-		     Vector.foreach
-		     (v, fn cf => List.push (get (class (sel cf)), cf))
-		  val () = destroy ()
-	       in 
-		  List.fold (!classes, [], fn (r, ac) =>
-			     Vector.fromList (!r) :: ac)
-	       end
+         struct
+            type t = refinement
+               
+            fun group (v: t, sel): t list =
+               let
+                  val classes = ref []
+                  val {destroy, get: Class.t -> {coarse: Element.t,
+                                                 fine: Element.t} list ref,
+                       ...} =
+                     Property.destGet
+                     (Class.plist,
+                      Property.initFun (fn _ =>
+                                        let
+                                           val r = ref []
+                                           val () = List.push (classes, r)
+                                        in
+                                           r
+                                        end))
+                  val () =
+                     Vector.foreach
+                     (v, fn cf => List.push (get (class (sel cf)), cf))
+                  val () = destroy ()
+               in 
+                  List.fold (!classes, [], fn (r, ac) =>
+                             Vector.fromList (!r) :: ac)
+               end
 
-	    fun store (v: t): unit =
-	       List.push (Class.coarserThan
-			  (class (#coarse (Vector.sub (v, 0)))),
-			  v)
-	 end
+            fun store (v: t): unit =
+               List.push (Class.coarserThan
+                          (class (#coarse (Vector.sub (v, 0)))),
+                          v)
+         end
       
       val todo: Refinement.t list ref = ref []
-	 
+         
       fun refine (v: Refinement.t): unit =
-	 List.foreach
-	 (Refinement.group (v, #fine), fn v =>
-	  let
-	     val oldClass = class (#fine (Vector.sub (v, 0)))
-	     val classes = Refinement.group (v, #coarse)
-	  in
-	     case classes of
-		[_] => Refinement.store v
-	      | _ =>
-		   let
-		      val () =
-			 todo
-			 := (List.fold
-			     (! (Class.coarserThan oldClass), !todo, op ::))
-		   in
-		      List.foreach
-		      (classes, fn v =>
-		       let
-			  val () = Refinement.store v
-			  val elements = Vector.map (v, #fine)
-			  val c = Class.new elements
-			  val () = Vector.foreach (elements, fn e =>
-						   setClass (e, c))
-		       in
-			  ()
-		       end)
-		   end
-	  end)
+         List.foreach
+         (Refinement.group (v, #fine), fn v =>
+          let
+             val oldClass = class (#fine (Vector.sub (v, 0)))
+             val classes = Refinement.group (v, #coarse)
+          in
+             case classes of
+                [_] => Refinement.store v
+              | _ =>
+                   let
+                      val () =
+                         todo
+                         := (List.fold
+                             (! (Class.coarserThan oldClass), !todo, op ::))
+                   in
+                      List.foreach
+                      (classes, fn v =>
+                       let
+                          val () = Refinement.store v
+                          val elements = Vector.map (v, #fine)
+                          val c = Class.new elements
+                          val () = Vector.foreach (elements, fn e =>
+                                                   setClass (e, c))
+                       in
+                          ()
+                       end)
+                   end
+          end)
 
       fun fixedPoint () =
-	 let
-	    fun loop () =
-	       case !todo of
-		  [] => ()
-		| r :: rs => (todo := rs
-			      ; refine r
-			      ; loop ())
-	 in
-	    loop ()
-	 end
+         let
+            fun loop () =
+               case !todo of
+                  [] => ()
+                | r :: rs => (todo := rs
+                              ; refine r
+                              ; loop ())
+         in
+            loop ()
+         end
    end
 
 structure Class = Element.Class
@@ -210,7 +211,7 @@
 structure Eqrel:>
    sig
       type t
-	 
+         
       val classes: t -> int list list
       val element: t * int -> Element.t
       val elements: t -> Element.t vector
@@ -227,7 +228,7 @@
       val make = T
 
       fun elements (T v) = v
-	 
+         
       fun element (r, i) = Vector.sub (elements r, i)
 
       fun forceDistinct (T v) = Element.forceDistinct v
@@ -235,34 +236,34 @@
       fun fromTypes ts = T (Element.new (ts, Type.plist))
 
       fun refine {coarse = T cv, fine = T fv} =
-	 Element.refine
-	 (Vector.map2 (cv, fv, fn (c, f) => {coarse = c, fine = f}))
+         Element.refine
+         (Vector.map2 (cv, fv, fn (c, f) => {coarse = c, fine = f}))
 
       fun unify (r, r') =
-	 (refine {coarse = r, fine = r'}
-	  ; refine {coarse = r', fine = r})
-	 
+         (refine {coarse = r, fine = r'}
+          ; refine {coarse = r', fine = r})
+         
       fun classes (T v) =
-	 let
-	    val classes = ref []
-	    val {get = classIndices: Class.t -> int list ref, destroy, ...} =
-	       Property.destGet (Class.plist,
-				 Property.initFun
-				 (fn _ =>
-				  let
-				     val r = ref []
-				     val () = List.push (classes, r)
-				  in
-				     r
-				  end))
-	    val () =
-	       Vector.foreachi
-	       (v, fn (i, e) =>
-		List.push (classIndices (Element.class e), i))
-	    val () = destroy ()
-	 in
-	    List.fold (!classes, [], fn (r, ac) => !r :: ac)
-	 end
+         let
+            val classes = ref []
+            val {get = classIndices: Class.t -> int list ref, destroy, ...} =
+               Property.destGet (Class.plist,
+                                 Property.initFun
+                                 (fn _ =>
+                                  let
+                                     val r = ref []
+                                     val () = List.push (classes, r)
+                                  in
+                                     r
+                                  end))
+            val () =
+               Vector.foreachi
+               (v, fn (i, e) =>
+                List.push (classIndices (Element.class e), i))
+            val () = destroy ()
+         in
+            List.fold (!classes, [], fn (r, ac) => !r :: ac)
+         end
 
       val layout = (List.layout (List.layout Int.layout)) o classes
    end
@@ -270,285 +271,285 @@
 fun redundant (Program.T {datatypes, globals, functions, main}) =
    let
       val {get = funcInfo: Func.t -> {arg: Eqrel.t, return: Eqrel.t option},
-	   set = setFuncInfo, ...} =
-	 Property.getSetOnce
-	 (Func.plist, Property.initRaise ("Redundant.info", Func.layout))
+           set = setFuncInfo, ...} =
+         Property.getSetOnce
+         (Func.plist, Property.initRaise ("Redundant.info", Func.layout))
       val {get = labelInfo: Label.t -> Eqrel.t,
-	   set = setLabelInfo, ...} =
-	 Property.getSetOnce
-	 (Label.plist, Property.initRaise ("Redundant.info", Label.layout))
+           set = setLabelInfo, ...} =
+         Property.getSetOnce
+         (Label.plist, Property.initRaise ("Redundant.info", Label.layout))
       val {get = varInfo : Var.t -> Element.t,
-	   set = setVarInfo, ...} =
-	 Property.getSetOnce
-	 (Var.plist, Property.initFun (fn _ => Element.new1 ()))
+           set = setVarInfo, ...} =
+         Property.getSetOnce
+         (Var.plist, Property.initFun (fn _ => Element.new1 ()))
       fun varEquiv xs = Eqrel.make (Vector.map (xs, varInfo))
       (* compute the fixed point *)
       val () =
-	 let
-	    fun makeFormalsRel (xs: (Var.t * Type.t) vector): Eqrel.t =
-	       let
-		  val eqrel = Eqrel.fromTypes (Vector.map (xs, #2))
-		  val () =
-		     Vector.foreachi
-		     (xs, fn (i, (x, _)) =>
-		      setVarInfo (x, Eqrel.element (eqrel, i)))
-	       in
-		  eqrel
-	       end
-	    (* initialize all varInfo and funcInfo *)
-	    val () =
-	       List.foreach
-	       (functions, fn f =>
-		let
-		   val {name, args, returns, ...} = Function.dest f
-		in
-		   setFuncInfo (name, {arg = makeFormalsRel args,
-				       return = Option.map (returns,
-							    Eqrel.fromTypes)})
-		end)
-	    (* Add the calls to all the funcInfos *)
-	    val () =
-	       List.foreach
-	       (functions, fn f =>
-		let 
-		   val {name, blocks, ...} = Function.dest f
-		   val {return, ...} = funcInfo name
-		   val _ =
-		      Vector.foreach (blocks, fn Block.T {label, args, ...} =>
-				      setLabelInfo (label, makeFormalsRel args))
-		in
-		   Vector.foreach
-		   (blocks, fn Block.T {transfer, ...} =>
-		    case transfer of
-		       Call {func, args, return = ret, ...} =>
-		          let
-			     val {arg = arg', return = return'} = funcInfo func
-			     val _ = Eqrel.refine {coarse = varEquiv args,
-						   fine = arg'}
-			  in
-			     case ret of
-				Return.Dead => ()
-			      | Return.NonTail {cont, ...} =>
-				   Option.app (return', fn e =>
-					       Eqrel.unify (e, labelInfo cont))
-			      | Return.Tail =>
-				   (case (return, return') of
-				       (SOME e, SOME e') => Eqrel.unify (e, e')
-				     | _ => ())
-			  end
-		      | Case {cases = Cases.Con cases, ...} =>
-			   (* For now, assume that constructor arguments
-			    * are never redundant.  Thus all case branches
-			    * need to have trivial equivalence relations.
-			    *)
-			   Vector.foreach (cases, fn (_, l) =>
-					   Eqrel.forceDistinct (labelInfo l))
-							
-		      | Goto {dst, args, ...} =>
-			   Eqrel.refine {coarse = varEquiv args,
-					 fine = labelInfo dst}
-		      | Return xs =>
-			   Eqrel.refine {coarse = varEquiv xs,
-					 fine = valOf return}
-		      | _ => ())
-		end)
-	    val _ = Element.fixedPoint ()
-	 in ()
-	 end
+         let
+            fun makeFormalsRel (xs: (Var.t * Type.t) vector): Eqrel.t =
+               let
+                  val eqrel = Eqrel.fromTypes (Vector.map (xs, #2))
+                  val () =
+                     Vector.foreachi
+                     (xs, fn (i, (x, _)) =>
+                      setVarInfo (x, Eqrel.element (eqrel, i)))
+               in
+                  eqrel
+               end
+            (* initialize all varInfo and funcInfo *)
+            val () =
+               List.foreach
+               (functions, fn f =>
+                let
+                   val {name, args, returns, ...} = Function.dest f
+                in
+                   setFuncInfo (name, {arg = makeFormalsRel args,
+                                       return = Option.map (returns,
+                                                            Eqrel.fromTypes)})
+                end)
+            (* Add the calls to all the funcInfos *)
+            val () =
+               List.foreach
+               (functions, fn f =>
+                let 
+                   val {name, blocks, ...} = Function.dest f
+                   val {return, ...} = funcInfo name
+                   val _ =
+                      Vector.foreach (blocks, fn Block.T {label, args, ...} =>
+                                      setLabelInfo (label, makeFormalsRel args))
+                in
+                   Vector.foreach
+                   (blocks, fn Block.T {transfer, ...} =>
+                    case transfer of
+                       Call {func, args, return = ret, ...} =>
+                          let
+                             val {arg = arg', return = return'} = funcInfo func
+                             val _ = Eqrel.refine {coarse = varEquiv args,
+                                                   fine = arg'}
+                          in
+                             case ret of
+                                Return.Dead => ()
+                              | Return.NonTail {cont, ...} =>
+                                   Option.app (return', fn e =>
+                                               Eqrel.unify (e, labelInfo cont))
+                              | Return.Tail =>
+                                   (case (return, return') of
+                                       (SOME e, SOME e') => Eqrel.unify (e, e')
+                                     | _ => ())
+                          end
+                      | Case {cases = Cases.Con cases, ...} =>
+                           (* For now, assume that constructor arguments
+                            * are never redundant.  Thus all case branches
+                            * need to have trivial equivalence relations.
+                            *)
+                           Vector.foreach (cases, fn (_, l) =>
+                                           Eqrel.forceDistinct (labelInfo l))
+                                                        
+                      | Goto {dst, args, ...} =>
+                           Eqrel.refine {coarse = varEquiv args,
+                                         fine = labelInfo dst}
+                      | Return xs =>
+                           Eqrel.refine {coarse = varEquiv xs,
+                                         fine = valOf return}
+                      | _ => ())
+                end)
+            val _ = Element.fixedPoint ()
+         in ()
+         end
       val _ = 
-	 Control.diagnostics
-	 (fn display =>
-	  List.foreach
-	  (functions, fn f => 
-	   let
-	      open Layout
-	       val {name, blocks, ...} = Function.dest f
-	       val {arg, return} = funcInfo name
-	       val () =
-		  display (seq [Func.layout name,
-				str "  ",
-				Eqrel.layout arg,
-				Option.layout Eqrel.layout return])
-	       val () =
-		  Vector.foreach
-		  (blocks, fn Block.T {label, ...} =>
-		   let
-		      val arg = labelInfo label
-		   in
-		      display (seq [str "\t",
-				    Label.layout label,
-				    str " ",
-				    Eqrel.layout arg])
-		   end)
-	   in
-	      ()
-	   end))
+         Control.diagnostics
+         (fn display =>
+          List.foreach
+          (functions, fn f => 
+           let
+              open Layout
+               val {name, blocks, ...} = Function.dest f
+               val {arg, return} = funcInfo name
+               val () =
+                  display (seq [Func.layout name,
+                                str "  ",
+                                Eqrel.layout arg,
+                                Option.layout Eqrel.layout return])
+               val () =
+                  Vector.foreach
+                  (blocks, fn Block.T {label, ...} =>
+                   let
+                      val arg = labelInfo label
+                   in
+                      display (seq [str "\t",
+                                    Label.layout label,
+                                    str " ",
+                                    Eqrel.layout arg])
+                   end)
+           in
+              ()
+           end))
       val {get = replacement : Var.t -> Var.t option,
-	   set = setReplacement, ...} =
-	 Property.getSetOnce (Var.plist, Property.initConst NONE)
+           set = setReplacement, ...} =
+         Property.getSetOnce (Var.plist, Property.initConst NONE)
       datatype red =
-	 Useful
+         Useful
        | Redundant of int (* the index it is the same as *)
       (* Turn an equivalence relation on 0 ... n - 1 into a red vector by
        * choosing a representative of each class.
        *)
       fun makeReds (r: Eqrel.t): red vector =
-	 let
-	    val {get = rep: Class.t -> int option ref, destroy, ...} =
-	       Property.destGet (Class.plist,
-				 Property.initFun (fn _ => ref NONE))
-	    val reds =
-	       Vector.mapi
-	       (Eqrel.elements r, fn (i, e) =>
-		let
-		   val r = rep (Element.class e)
-		in
-		   case !r of
-		      NONE => (r := SOME i; Useful)
-		    | SOME i => Redundant i
-		end)
-	    val () = destroy ()
-	 in
-	    reds
-	 end
+         let
+            val {get = rep: Class.t -> int option ref, destroy, ...} =
+               Property.destGet (Class.plist,
+                                 Property.initFun (fn _ => ref NONE))
+            val reds =
+               Vector.mapi
+               (Eqrel.elements r, fn (i, e) =>
+                let
+                   val r = rep (Element.class e)
+                in
+                   case !r of
+                      NONE => (r := SOME i; Useful)
+                    | SOME i => Redundant i
+                end)
+            val () = destroy ()
+         in
+            reds
+         end
       fun redundantFormals (xs: (Var.t * Type.t) vector, r: Eqrel.t)
-	 : red vector * (Var.t * Type.t) vector =
-	 let
-	    val reds = makeReds r
-	    val xs =
-	       Vector.keepAllMap2
-	       (xs, reds, fn (x, red) =>
-		case red of
-		   Useful => SOME x
-		 | Redundant i =>
-		      (setReplacement (#1 x, SOME (#1 (Vector.sub (xs, i))))
-		       ; NONE))
-	 in
-	    (reds, xs)
-	 end
+         : red vector * (Var.t * Type.t) vector =
+         let
+            val reds = makeReds r
+            val xs =
+               Vector.keepAllMap2
+               (xs, reds, fn (x, red) =>
+                case red of
+                   Useful => SOME x
+                 | Redundant i =>
+                      (setReplacement (#1 x, SOME (#1 (Vector.sub (xs, i))))
+                       ; NONE))
+         in
+            (reds, xs)
+         end
       fun keepUseful (reds: red vector, xs: 'a vector): 'a vector =
-	 Vector.keepAllMap2 (reds, xs, fn (r, x) =>
-			     case r of
-				Useful => SOME x
-			      | _ => NONE)
+         Vector.keepAllMap2 (reds, xs, fn (r, x) =>
+                             case r of
+                                Useful => SOME x
+                              | _ => NONE)
       val {get = funcReds : Func.t -> {argsRed: red vector,
-				       args: (Var.t * Type.t) vector,
-				       returnsRed: red vector option,
-				       returns: Type.t vector option},
-	   set = setFuncReds, ...} =
-	 Property.getSetOnce (Func.plist,
-			      Property.initRaise ("funcReds", Func.layout))
+                                       args: (Var.t * Type.t) vector,
+                                       returnsRed: red vector option,
+                                       returns: Type.t vector option},
+           set = setFuncReds, ...} =
+         Property.getSetOnce (Func.plist,
+                              Property.initRaise ("funcReds", Func.layout))
       val {get = labelReds: Label.t -> {argsRed: red vector,
-					args: (Var.t * Type.t) vector},
-	   set = setLabelReds, ...} =
-	 Property.getSetOnce (Label.plist,
-			      Property.initRaise ("labelReds", Label.layout))
+                                        args: (Var.t * Type.t) vector},
+           set = setLabelReds, ...} =
+         Property.getSetOnce (Label.plist,
+                              Property.initRaise ("labelReds", Label.layout))
       val _ =
-	 List.foreach
-	 (functions, fn f =>
-	  let
-	     val {name, args, blocks, returns, ...} = Function.dest f
-	     val {arg, return} = funcInfo name
-	     val (returnsRed, returns) =
-		(case (returns, return) of
-		    (SOME r, SOME r') =>
-		       let
-			  val returnsRed = makeReds r'
-			  val returns = keepUseful (returnsRed, r)
-		       in
-			  (SOME returnsRed, SOME returns)
-		       end
-		  | _ => (NONE, NONE))
-	     val (argsRed, args) = redundantFormals (args, arg)
-	  in
-	     setFuncReds (name, {args = args,
-				 argsRed = argsRed,
-				 returns = returns,
-				 returnsRed = returnsRed}) ;
-	     Vector.foreach
-	     (blocks, fn Block.T {label, args, ...} =>
-	      let
-		 val (argsRed, args) = redundantFormals (args, labelInfo label)
-	      in
-		 setLabelReds (label, {args = args,
-				       argsRed = argsRed})
-	      end)
-	  end)
+         List.foreach
+         (functions, fn f =>
+          let
+             val {name, args, blocks, returns, ...} = Function.dest f
+             val {arg, return} = funcInfo name
+             val (returnsRed, returns) =
+                (case (returns, return) of
+                    (SOME r, SOME r') =>
+                       let
+                          val returnsRed = makeReds r'
+                          val returns = keepUseful (returnsRed, r)
+                       in
+                          (SOME returnsRed, SOME returns)
+                       end
+                  | _ => (NONE, NONE))
+             val (argsRed, args) = redundantFormals (args, arg)
+          in
+             setFuncReds (name, {args = args,
+                                 argsRed = argsRed,
+                                 returns = returns,
+                                 returnsRed = returnsRed}) ;
+             Vector.foreach
+             (blocks, fn Block.T {label, args, ...} =>
+              let
+                 val (argsRed, args) = redundantFormals (args, labelInfo label)
+              in
+                 setLabelReds (label, {args = args,
+                                       argsRed = argsRed})
+              end)
+          end)
       fun loopVar x =
-	 case replacement x of
-	    NONE => x
-	  | SOME y => y
+         case replacement x of
+            NONE => x
+          | SOME y => y
       fun loopVars xs = Vector.map (xs, loopVar)
       val functions =
-	 List.revMap
-	 (functions, fn f =>
-	  let
-	     val {blocks, mayInline, name, raises, start, ...} = Function.dest f
-	     val {args, returns, returnsRed, ...} = funcReds name
-	     val blocks =
-	        Vector.map
-		(blocks, fn Block.T {label, statements, transfer, ...} =>
-		 let
-		    val {args, ...} = labelReds label
-		    val statements =
-		       Vector.map
-		       (statements, fn Statement.T {var, ty, exp} =>
-			Statement.T {var = var,
-				     ty = ty,
-				     exp = Exp.replaceVar (exp, loopVar)})
-		    val transfer =
-		       case transfer of
-			  Arith {prim, args, overflow, success, ty} =>
-			     Arith {prim = prim,
-				    args = loopVars args,
-				    overflow = overflow,
-				    success = success,
-				    ty = ty}
-			| Bug => Bug
-			| Call {func, args, return} =>
-			     Call {func = func, 
-				   args = loopVars (keepUseful 
-						    (#argsRed (funcReds func),
-						     args)),
-				   return = return}
-			| Case {test, cases, default} =>
-			     Case {test = loopVar test, 
-				   cases = cases,
-				   default = default}
-			| Goto {dst, args} =>
-			     Goto {dst = dst,
-				   args = loopVars (keepUseful 
-						    (#argsRed (labelReds dst), 
-						     args))}
-			| Raise xs => Raise (loopVars xs)
-			| Return xs =>
-			     Return (loopVars
-				     (keepUseful (valOf returnsRed, xs)))
-			| Runtime {prim, args, return} =>
-			     Runtime {prim = prim,
-				      args = loopVars args,
-				      return = return}
-		 in
-		    Block.T {label = label,
-			     args = args,
-			     statements = statements,
-			     transfer = transfer}
-		 end)
-	     val f = Function.new {args = args,
-				   blocks = blocks,
-				   mayInline = mayInline,
-				   name = name,
-				   raises = raises,
-				   returns = returns,
-				   start = start}
-	     val _ = Function.clear f
-	  in
-	     f
-	  end)
+         List.revMap
+         (functions, fn f =>
+          let
+             val {blocks, mayInline, name, raises, start, ...} = Function.dest f
+             val {args, returns, returnsRed, ...} = funcReds name
+             val blocks =
+                Vector.map
+                (blocks, fn Block.T {label, statements, transfer, ...} =>
+                 let
+                    val {args, ...} = labelReds label
+                    val statements =
+                       Vector.map
+                       (statements, fn Statement.T {var, ty, exp} =>
+                        Statement.T {var = var,
+                                     ty = ty,
+                                     exp = Exp.replaceVar (exp, loopVar)})
+                    val transfer =
+                       case transfer of
+                          Arith {prim, args, overflow, success, ty} =>
+                             Arith {prim = prim,
+                                    args = loopVars args,
+                                    overflow = overflow,
+                                    success = success,
+                                    ty = ty}
+                        | Bug => Bug
+                        | Call {func, args, return} =>
+                             Call {func = func, 
+                                   args = loopVars (keepUseful 
+                                                    (#argsRed (funcReds func),
+                                                     args)),
+                                   return = return}
+                        | Case {test, cases, default} =>
+                             Case {test = loopVar test, 
+                                   cases = cases,
+                                   default = default}
+                        | Goto {dst, args} =>
+                             Goto {dst = dst,
+                                   args = loopVars (keepUseful 
+                                                    (#argsRed (labelReds dst), 
+                                                     args))}
+                        | Raise xs => Raise (loopVars xs)
+                        | Return xs =>
+                             Return (loopVars
+                                     (keepUseful (valOf returnsRed, xs)))
+                        | Runtime {prim, args, return} =>
+                             Runtime {prim = prim,
+                                      args = loopVars args,
+                                      return = return}
+                 in
+                    Block.T {label = label,
+                             args = args,
+                             statements = statements,
+                             transfer = transfer}
+                 end)
+             val f = Function.new {args = args,
+                                   blocks = blocks,
+                                   mayInline = mayInline,
+                                   name = name,
+                                   raises = raises,
+                                   returns = returns,
+                                   start = start}
+             val _ = Function.clear f
+          in
+             f
+          end)
       val p = Program.T {datatypes = datatypes,
-			 globals = globals,
-			 functions = functions,
-			 main = main}
+                         globals = globals,
+                         functions = functions,
+                         main = main}
       val _ = Program.clearTop p
    in
       p

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ssa/redundant.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ssa/redundant.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ssa/redundant.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature REDUNDANT_STRUCTS = 
    sig
       include SHRINK

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ssa/ref-flatten.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ssa/ref-flatten.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ssa/ref-flatten.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,8 +1,8 @@
-(* Copyright (C) 2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 2004-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 functor RefFlatten (S: REF_FLATTEN_STRUCTS): REF_FLATTEN = 
@@ -19,96 +19,94 @@
 structure Finish =
    struct
       datatype t = T of {flat: Type.t Prod.t option, 
-			 ty: Type.t}
+                         ty: Type.t}
 
       val _: t -> Layout.t =
-	 fn T {flat, ty} =>
-	 let
-	    open Layout
-	 in
-	    record [("flat",
-		     Option.layout (fn p => Prod.layout (p, Type.layout)) flat),
-		    ("ty", Type.layout ty)]
-	 end
+         fn T {flat, ty} =>
+         let
+            open Layout
+         in
+            record [("flat",
+                     Option.layout (fn p => Prod.layout (p, Type.layout)) flat),
+                    ("ty", Type.layout ty)]
+         end
    end
 
 structure Value =
    struct
       datatype t =
-	 GroundV of Type.t
+         GroundV of Type.t
        | Complex of computed Equatable.t
       and computed =
-	 ObjectC of object
+         ObjectC of object
        | WeakC of {arg: t,
-		   finalType: Type.t option ref,
-		   originalType: Type.t}
+                   finalType: Type.t option ref,
+                   originalType: Type.t}
       and object =
-	 Obj of {args: t Prod.t,
-		 con: ObjectCon.t,
-		 finalComponents: Type.t Prod.t option ref,
-		 finalOffsets: int vector option ref,
-		 finalType: Type.t option ref,
-		 flat: flat ref,
-		 originalType: Type.t}
+         Obj of {args: t Prod.t,
+                 con: ObjectCon.t,
+                 finalComponents: Type.t Prod.t option ref,
+                 finalOffsets: int vector option ref,
+                 finalType: Type.t option ref,
+                 flat: flat ref,
+                 originalType: Type.t}
       and flat =
-	 NotFlat
+         NotFlat
        | Offset of {object: object,
-		    offset: int}
+                    offset: int}
        | Unknown
 
       fun delay (f: unit -> computed): t = Complex (Equatable.delay f)
 
       datatype value =
-	 Ground of Type.t
+         Ground of Type.t
        | Object of object
        | Weak of {arg: t,
-		  finalType: Type.t option ref,
-		  originalType: Type.t}
+                  finalType: Type.t option ref,
+                  originalType: Type.t}
 
       val value: t -> value =
-	 fn GroundV t => Ground t
-	  | Complex e =>
-	       case Equatable.value e of
-		  ObjectC obj => Object obj
-		| WeakC w => Weak w
+         fn GroundV t => Ground t
+          | Complex e =>
+               case Equatable.value e of
+                  ObjectC obj => Object obj
+                | WeakC w => Weak w
 
       local
-	 open Layout
+         open Layout
       in
-	 fun layout v: Layout.t =
-	    case v of
-	       GroundV t => Type.layout t
-	     | Complex e =>
-		  Equatable.layout 
-		  (e,
-		   fn ObjectC ob => layoutObject ob
-		    | WeakC {arg, ...} => seq [str "Weak ", layout arg])
-	 and layoutFlat (f: flat): Layout.t =
-	    case f of
-	       NotFlat => str "NotFlat"
-	     | Offset {offset, ...} =>
-		  seq [str "Offset ",
-		       record [("offset", Int.layout offset)]]
-	     | Unknown => str "Unknown"
-	 and layoutObject (Obj {args, con, flat, ...}) =
-	    seq [str "Object ",
-		 record [("args", Prod.layout (args, layout)),
-			 ("con", ObjectCon.layout con),
-			 ("flat", layoutFlat (! flat))]]
+         fun layout v: Layout.t =
+            case v of
+               GroundV t => Type.layout t
+             | Complex e =>
+                  Equatable.layout 
+                  (e,
+                   fn ObjectC ob => layoutObject ob
+                    | WeakC {arg, ...} => seq [str "Weak ", layout arg])
+         and layoutFlat (f: flat): Layout.t =
+            case f of
+               NotFlat => str "NotFlat"
+             | Offset {offset, ...} =>
+                  seq [str "Offset ",
+                       record [("offset", Int.layout offset)]]
+             | Unknown => str "Unknown"
+         and layoutObject (Obj {args, con, flat, ...}) =
+            seq [str "Object ",
+                 record [("args", Prod.layout (args, layout)),
+                         ("con", ObjectCon.layout con),
+                         ("flat", layoutFlat (! flat))]]
       end
 
       fun originalType (v: t) =
-	 case value v of
-	    Ground t => t
-	  | Object (Obj {originalType = t, ...}) => t
-	  | Weak {originalType = t, ...} => t
+         case value v of
+            Ground t => t
+          | Object (Obj {originalType = t, ...}) => t
+          | Weak {originalType = t, ...} => t
    end
 
 structure Flat =
    struct
       datatype t = datatype Value.flat
-
-      val layout = Value.layoutFlat
    end
 
 structure Object =
@@ -120,8 +118,8 @@
       fun equals (Obj {flat = f, ...}, Obj {flat = f', ...}) = f = f'
 
       val select: t * int -> Value.t =
-	 fn (Obj {args, ...}, offset) =>
-	 Prod.elt (args, offset)
+         fn (Obj {args, ...}, offset) =>
+         Prod.elt (args, offset)
    end
 
 datatype z = datatype Object.t
@@ -133,373 +131,377 @@
       val ground = GroundV
 
       val deObject: t -> Object.t option =
-	 fn v =>
-	 case value v of
-	    Object ob => SOME ob
-	  | _ => NONE
+         fn v =>
+         case value v of
+            Object ob => SOME ob
+          | _ => NONE
 
       fun deFlat {inner: t, outer: Object.t}: Object.t option =
-	 case value inner of
-	    Object (z as Obj {flat, ...}) =>
-	       (case ! flat of
-		   Flat.Offset {object, ...} =>
-		      if Object.equals (object, outer) then SOME z else NONE
-		 | _ => NONE)
-	  | _ => NONE
-	       
+         case value inner of
+            Object (z as Obj {flat, ...}) =>
+               (case ! flat of
+                   Flat.Offset {object, ...} =>
+                      if Object.equals (object, outer) then SOME z else NONE
+                 | _ => NONE)
+          | _ => NONE
+               
       fun dontFlatten (v: t): unit =
-	 case value v of
-	    Object (Obj {flat, ...}) => flat := NotFlat
-	  | _ => ()
+         case value v of
+            Object (Obj {flat, ...}) => flat := NotFlat
+          | _ => ()
 
       fun isUnit v =
-	 case v of
-	    GroundV t => Type.isUnit t
-	  | _ => false
-	       
+         case v of
+            GroundV t => Type.isUnit t
+          | _ => false
+               
       fun objectC {args: t Prod.t, con: ObjectCon.t, originalType}
-	 : computed =
-	 let
-	     (* Only may flatten objects with mutable fields, and where the field
-	      * isn't unit.  Flattening a unit field could lead to a problem
-	      * because the containing object might be otherwise immutable, and
-	      * hence the unit ref would lose its identity.  We can fix this
-	      * once objects have a notion of identity independent of mutability.
-	      *)
-	     val flat =
-		ref
-		(if Vector.exists (Prod.dest args, fn {elt, isMutable} =>
-				   isMutable andalso not (isUnit elt))
-		    andalso not (ObjectCon.isVector con)
-		    then Unknown
-		 else NotFlat)
-	  in
-	     ObjectC (Obj {args = args,
-			   con = con,
-			   finalComponents = ref NONE,
-			   finalOffsets = ref NONE,
-			   finalType = ref NONE,
-			   flat = flat,
-			   originalType = originalType})
-	  end
+         : computed =
+         let
+             (* Only may flatten objects with mutable fields, and where the field
+              * isn't unit.  Flattening a unit field could lead to a problem
+              * because the containing object might be otherwise immutable, and
+              * hence the unit ref would lose its identity.  We can fix this
+              * once objects have a notion of identity independent of mutability.
+              *)
+             val flat =
+                ref
+                (if Vector.exists (Prod.dest args, fn {elt, isMutable} =>
+                                   isMutable andalso not (isUnit elt))
+                    andalso not (ObjectCon.isVector con)
+                    then Unknown
+                 else NotFlat)
+          in
+             ObjectC (Obj {args = args,
+                           con = con,
+                           finalComponents = ref NONE,
+                           finalOffsets = ref NONE,
+                           finalType = ref NONE,
+                           flat = flat,
+                           originalType = originalType})
+          end
 
       val computed: computed -> t =
-	 fn c => Complex (Equatable.new c)
+         fn c => Complex (Equatable.new c)
 
       fun weakC (a: t): computed =
-	 WeakC {arg = a,
-		finalType = ref NONE,
-		originalType = Type.weak (originalType a)}
+         WeakC {arg = a,
+                finalType = ref NONE,
+                originalType = Type.weak (originalType a)}
 
       val weak = computed o weakC
 
       fun tuple (args: t Prod.t, originalType: Type.t): t =
-	 computed (objectC {args = args,
-			    con = ObjectCon.Tuple,
-			    originalType = originalType})
+         computed (objectC {args = args,
+                            con = ObjectCon.Tuple,
+                            originalType = originalType})
 
       val tuple =
-	 Trace.trace ("RefFlatten.Value.tuple", fn (p, _) => Prod.layout (p, layout),
-		      layout)
-	 tuple
+         Trace.trace ("RefFlatten.Value.tuple", fn (p, _) => Prod.layout (p, layout),
+                      layout)
+         tuple
 
       val rec unify: t * t -> unit =
-	 fn z =>
-	 case z of
-	    (GroundV t, GroundV t') =>
-	       if Type.equals (t, t') then ()
-	       else Error.bug "unify of unequal Grounds"
-	  | (Complex e, Complex e') =>
-	       Equatable.equate
-	       (e, e', fn (c, c') =>
-		case (c, c') of
-		   (ObjectC (Obj {args = a, flat = f, ...}), 
-		    ObjectC (Obj {args = a', flat = f', ...})) =>
-		      let
-			 val () = unifyProd (a, a')
-			 val () =
-			    case (!f, !f') of
-			       (_, NotFlat) => f := NotFlat
-			     | (NotFlat, _) => f' := NotFlat
-			     | (Offset _, _) =>
-				  Error.bug "unify saw Offset"
-			     | (_, Offset _) =>
-				  Error.bug "unify saw Offset"
-			     | _ => ()
-		      in
-			 c
-		      end
-		 | (WeakC {arg = a, ...}, WeakC {arg = a', ...}) =>
-		      (unify (a, a'); c)
-		 | _ => Error.bug "strange unify")
-	  | _ => Error.bug "unify Complex with Ground"
+         fn z =>
+         case z of
+            (GroundV t, GroundV t') =>
+               if Type.equals (t, t') then ()
+               else Error.bug "RefFlatten.Value.unify: unequal Grounds"
+          | (Complex e, Complex e') =>
+               Equatable.equate
+               (e, e', fn (c, c') =>
+                case (c, c') of
+                   (ObjectC (Obj {args = a, flat = f, ...}), 
+                    ObjectC (Obj {args = a', flat = f', ...})) =>
+                      let
+                         val () = unifyProd (a, a')
+                         val () =
+                            case (!f, !f') of
+                               (_, NotFlat) => f := NotFlat
+                             | (NotFlat, _) => f' := NotFlat
+                             | (Offset _, _) =>
+                                  Error.bug "RefFlatten.Value.unify: Offset"
+                             | (_, Offset _) =>
+                                  Error.bug "RefFlatten.Value.unify: Offset"
+                             | _ => ()
+                      in
+                         c
+                      end
+                 | (WeakC {arg = a, ...}, WeakC {arg = a', ...}) =>
+                      (unify (a, a'); c)
+                 | _ => Error.bug "RefFlatten.Value.unify: strange Complex")
+          | _ => Error.bug "RefFlatten.Value.unify: Complex with Ground"
       and unifyProd =
-	 fn (p, p') =>
-	 Vector.foreach2
-	 (Prod.dest p, Prod.dest p',
-	  fn ({elt = e, ...}, {elt = e', ...}) => unify (e, e'))
+         fn (p, p') =>
+         Vector.foreach2
+         (Prod.dest p, Prod.dest p',
+          fn ({elt = e, ...}, {elt = e', ...}) => unify (e, e'))
 
       fun coerce {from, to} = unify (from, to)
 
       val coerce =
-	 Trace.trace ("RefFlatten.Value.coerce",
-		      fn {from, to} =>
-		      Layout.record [("from", layout from),
-				     ("to", layout to)],
-		      Unit.layout)
-	 coerce
+         Trace.trace ("RefFlatten.Value.coerce",
+                      fn {from, to} =>
+                      Layout.record [("from", layout from),
+                                     ("to", layout to)],
+                      Unit.layout)
+         coerce
    end
 
 structure Size = TwoPointLattice (val bottom = "small"
-				  val top = "large")
+                                  val top = "large")
 
 structure VarInfo =
    struct
       datatype useStatus =
-	 InTuple of {object: Object.t,
-		     objectVar: Var.t,
-		     offset: int}
+         InTuple of {object: Object.t,
+                     objectVar: Var.t,
+                     offset: int}
        | Unused
-	 
+         
       datatype t =
-	 Flattenable of {components: Var.t vector,
-			 defBlock: Label.t,
-			 useStatus: useStatus ref}
+         Flattenable of {components: Var.t vector,
+                         defBlock: Label.t,
+                         useStatus: useStatus ref}
        | Unflattenable
 
       fun layout (i: t): Layout.t =
-	 let
-	    open Layout
-	 in
-	    case i of
-	       Flattenable {components, defBlock, useStatus} =>
-		  seq [str "Flattenable ",
-		       record [("components",
-				Vector.layout Var.layout components),
-			       ("defBlock", Label.layout defBlock),
-			       ("useStatus",
-				(case !useStatus of
-				    InTuple {object, objectVar, offset} =>
-				       seq [str "InTuple ",
-					    record [("object",
-						     Object.layout object),
-						    ("objectVar",
-						     Var.layout objectVar),
-						    ("offset",
-						     Int.layout offset)]]
-				  | Unused => str "Unused"))]]
-	     | Unflattenable => str "Unflattenable"
-	 end
+         let
+            open Layout
+         in
+            case i of
+               Flattenable {components, defBlock, useStatus} =>
+                  seq [str "Flattenable ",
+                       record [("components",
+                                Vector.layout Var.layout components),
+                               ("defBlock", Label.layout defBlock),
+                               ("useStatus",
+                                (case !useStatus of
+                                    InTuple {object, objectVar, offset} =>
+                                       seq [str "InTuple ",
+                                            record [("object",
+                                                     Object.layout object),
+                                                    ("objectVar",
+                                                     Var.layout objectVar),
+                                                    ("offset",
+                                                     Int.layout offset)]]
+                                  | Unused => str "Unused"))]]
+             | Unflattenable => str "Unflattenable"
+         end
    end
 
 fun flatten (program as Program.T {datatypes, functions, globals, main}) =
    let
       val {get = conValue: Con.t -> Value.t option ref, ...} =
-	 Property.get (Con.plist, Property.initFun (fn _ => ref NONE))
+         Property.get (Con.plist, Property.initFun (fn _ => ref NONE))
       val conValue =
-	 Trace.trace ("RefFlatten.conValue",
-		      Con.layout, Ref.layout (Option.layout Value.layout))
-	 conValue
+         Trace.trace ("RefFlatten.conValue",
+                      Con.layout, Ref.layout (Option.layout Value.layout))
+         conValue
       datatype 'a make =
-	 Const of 'a
+         Const of 'a
        | Make of unit -> 'a
       fun needToMakeProd p =
-	 Vector.exists (Prod.dest p, fn {elt, ...} =>
-			case elt of
-			   Const _ => false
-			 | Make _ => true)
+         Vector.exists (Prod.dest p, fn {elt, ...} =>
+                        case elt of
+                           Const _ => false
+                         | Make _ => true)
       fun makeProd p =
-	 Prod.map (p, fn m =>
-		   case m of
-		      Const v => v
-		    | Make f => f ())
+         Prod.map (p, fn m =>
+                   case m of
+                      Const v => v
+                    | Make f => f ())
       val {get = makeTypeValue: Type.t -> Value.t make, ...} =
-	 Property.get
-	 (Type.plist,
-	  Property.initRec
-	  (fn (t, makeTypeValue) =>
-	   let
-	      fun const () = Const (Value.ground t)
-	      datatype z = datatype Type.dest
-	   in
-	      case Type.dest t of
-		 Object {args, con} =>
-		    let
-		       fun doit () =
-			  let
-			     val args = Prod.map (args, makeTypeValue)
-			     val mayFlatten =
-				Vector.exists (Prod.dest args, #isMutable)
-				andalso not (ObjectCon.isVector con)
-			  in
-			     if mayFlatten orelse needToMakeProd args
-				then Make (fn () =>
-					   Value.delay
-					   (fn () =>
-					    Value.objectC {args = makeProd args,
-							   con = con,
-							   originalType = t}))
-			     else const ()
-			  end
-		       datatype z = datatype ObjectCon.t
-		    in
-		       case con of
-			  Con c =>
-			     Const
-			     (Ref.memoize
-			      (conValue c, fn () =>
-			       case doit () of
-				  Const v => v
-				| Make f =>
-				     let
-					val v = f ()
-					(* Constructors can never be
-					 * flattened into other objects.
-					 *)
-					val () = Value.dontFlatten v
-				     in
-					v
-				     end))
-			| Tuple => doit ()
-			| Vector => doit ()
-		    end
-	       | Weak t =>
-		    (case makeTypeValue t of
-			Const _ => const ()
-		      | Make f =>
-			   Make (fn () =>
-				 Value.delay (fn () => Value.weakC (f ()))))
-	       | _ => const ()
-	   end))
+         Property.get
+         (Type.plist,
+          Property.initRec
+          (fn (t, makeTypeValue) =>
+           let
+              fun const () = Const (Value.ground t)
+              datatype z = datatype Type.dest
+           in
+              case Type.dest t of
+                 Object {args, con} =>
+                    let
+                       fun doit () =
+                          let
+                             val args = Prod.map (args, makeTypeValue)
+                             val mayFlatten =
+                                Vector.exists (Prod.dest args, #isMutable)
+                                andalso not (ObjectCon.isVector con)
+                          in
+                             if mayFlatten orelse needToMakeProd args
+                                then Make (fn () =>
+                                           Value.delay
+                                           (fn () =>
+                                            Value.objectC {args = makeProd args,
+                                                           con = con,
+                                                           originalType = t}))
+                             else const ()
+                          end
+                       datatype z = datatype ObjectCon.t
+                    in
+                       case con of
+                          Con c =>
+                             Const
+                             (Ref.memoize
+                              (conValue c, fn () =>
+                               case doit () of
+                                  Const v => v
+                                | Make f =>
+                                     let
+                                        val v = f ()
+                                        (* Constructors can never be
+                                         * flattened into other objects.
+                                         *)
+                                        val () = Value.dontFlatten v
+                                     in
+                                        v
+                                     end))
+                        | Tuple => doit ()
+                        | Vector => doit ()
+                    end
+               | Weak t =>
+                    (case makeTypeValue t of
+                        Const _ => const ()
+                      | Make f =>
+                           Make (fn () =>
+                                 Value.delay (fn () => Value.weakC (f ()))))
+               | _ => const ()
+           end))
       fun typeValue (t: Type.t): Value.t =
-	  case makeTypeValue t of
-	     Const v => v
-	   | Make f => f ()
+          case makeTypeValue t of
+             Const v => v
+           | Make f => f ()
       val typeValue =
-	 Trace.trace ("RefFlatten.typeValue", Type.layout, Value.layout) typeValue
+         Trace.trace ("RefFlatten.typeValue", Type.layout, Value.layout) typeValue
       val coerce = Value.coerce
       fun inject {sum, variant = _} = typeValue (Type.datatypee sum)
       fun object {args, con, resultType} =
-	 let
-	    val m = makeTypeValue resultType
-	 in
-	    case con of
-	       NONE =>
-		  (case m of
-		      Const v => v
-		    | Make _ => Value.tuple (args, resultType))
-	     | SOME _ =>
-		  (case m of
-		      Const v =>
-			 let
-			    val () =
-			       case Value.deObject v of
-				  NONE => ()
-				| SOME (Obj {args = args', ...}) =>
-				     Vector.foreach2
-				     (Prod.dest args, Prod.dest args',
-				      fn ({elt = a, ...}, {elt = a', ...}) =>
-				      coerce {from = a, to = a'})
-			 in
-			    v
-			 end
-		    | _ => Error.bug "strange con value")
-	 end
+         let
+            val m = makeTypeValue resultType
+         in
+            case con of
+               NONE =>
+                  (case m of
+                      Const v => v
+                    | Make _ => Value.tuple (args, resultType))
+             | SOME _ =>
+                  (case m of
+                      Const v =>
+                         let
+                            val () =
+                               case Value.deObject v of
+                                  NONE => ()
+                                | SOME (Obj {args = args', ...}) =>
+                                     Vector.foreach2
+                                     (Prod.dest args, Prod.dest args',
+                                      fn ({elt = a, ...}, {elt = a', ...}) =>
+                                      coerce {from = a, to = a'})
+                         in
+                            v
+                         end
+                    | _ => Error.bug "RefFlatten.object: strange con value")
+         end
       val object =
-	 Trace.trace
-	 ("RefFlatten.object",
-	  fn {args, con, ...} =>
-	  Layout.record [("args", Prod.layout (args, Value.layout)),
-			 ("con", Option.layout Con.layout con)],
-	  Value.layout)
-	 object
+         Trace.trace
+         ("RefFlatten.object",
+          fn {args, con, ...} =>
+          Layout.record [("args", Prod.layout (args, Value.layout)),
+                         ("con", Option.layout Con.layout con)],
+          Value.layout)
+         object
       val deWeak: Value.t -> Value.t =
-	 fn v =>
-	 case Value.value v of
-	    Value.Ground t =>
-	       typeValue (case Type.dest t of
-			     Type.Weak t => t
-			   | _ => Error.bug "deWeak")
-	  | Value.Weak {arg, ...} => arg
-	  | _ => Error.bug "deWeak"
+         fn v =>
+         case Value.value v of
+            Value.Ground t =>
+               typeValue (case Type.dest t of
+                             Type.Weak t => t
+                           | _ => Error.bug "RefFlatten.deWeak")
+          | Value.Weak {arg, ...} => arg
+          | _ => Error.bug "RefFlatten.deWeak"
       fun primApp {args, prim, resultVar = _, resultType} =
-	 let
-	    fun weak v =
-	       case makeTypeValue resultType of
-		  Const v => v
-		| Make _ => Value.weak v
-	    fun arg i = Vector.sub (args, i)
-	    fun result () = typeValue resultType
-	    datatype z = datatype Prim.Name.t
-	    fun dontFlatten () =
-	       (Vector.foreach (args, Value.dontFlatten)
-		; result ())
-	    fun equal () =
-	       (Value.unify (arg 0, arg 1)
-		; result ())
-	 in
-	    case Prim.name prim of
-	       Array_toVector =>
-		  let
-		     val res = result ()
-		     datatype z = datatype Value.value
-		     val () =
-			case (Value.value (arg 0), Value.value res) of
-			   (Ground _, Ground _) => ()
-			 | (Object (Obj {args = a, ...}),
-			    Object (Obj {args = a', ...})) =>
-			      Vector.foreach2
-			      (Prod.dest a, Prod.dest a',
-			       fn ({elt = v, ...}, {elt = v', ...}) =>
-			       Value.unify (v, v'))
-			 | _ => Error.bug "Array_toVector"
-		  in
-		     res
-		  end
-	     | FFI _ =>
-		  (* Some imports, like Real64.modf, take ref cells that can not
-		   * be flattened.
-		   *)
-		  dontFlatten ()
-	     | MLton_eq => equal ()
-	     | MLton_equal => equal ()
-	     | MLton_size => dontFlatten ()
-	     | Weak_get => deWeak (arg 0)
-	     | Weak_new => weak (arg 0)
-	     | _ => result ()
-	 end
+         let
+            fun weak v =
+               case makeTypeValue resultType of
+                  Const v => v
+                | Make _ => Value.weak v
+            fun arg i = Vector.sub (args, i)
+            fun result () = typeValue resultType
+            datatype z = datatype Prim.Name.t
+            fun dontFlatten () =
+               (Vector.foreach (args, Value.dontFlatten)
+                ; result ())
+            fun equal () =
+               (Value.unify (arg 0, arg 1)
+                ; result ())
+         in
+            case Prim.name prim of
+               Array_toVector =>
+                  let
+                     val res = result ()
+                     datatype z = datatype Value.value
+                     val () =
+                        case (Value.value (arg 0), Value.value res) of
+                           (Ground _, Ground _) => ()
+                         | (Object (Obj {args = a, ...}),
+                            Object (Obj {args = a', ...})) =>
+                              Vector.foreach2
+                              (Prod.dest a, Prod.dest a',
+                               fn ({elt = v, ...}, {elt = v', ...}) =>
+                               Value.unify (v, v'))
+                         | _ => Error.bug "RefFlatten.primApp: Array_toVector"
+                  in
+                     res
+                  end
+             | FFI _ =>
+                  (* Some imports, like Real64.modf, take ref cells that can not
+                   * be flattened.
+                   *)
+                  dontFlatten ()
+             | MLton_eq => equal ()
+             | MLton_equal => equal ()
+             | MLton_size => dontFlatten ()
+             | Weak_get => deWeak (arg 0)
+             | Weak_new => weak (arg 0)
+             | _ => result ()
+         end
       fun select {base, offset} =
-	 let
-	    datatype z = datatype Value.value
-	 in
-	    case Value.value base of
-	       Ground t =>
-		  (case Type.dest t of
-		      Type.Object {args, ...} =>
-			 typeValue (Prod.elt (args, offset))
-		    | _ => Error.bug "select Ground")
-	     | Object ob => Object.select (ob, offset)
-	     | _ => Error.bug "select"
-	 end
+         let
+            datatype z = datatype Value.value
+         in
+            case Value.value base of
+               Ground t =>
+                  (case Type.dest t of
+                      Type.Object {args, ...} =>
+                         typeValue (Prod.elt (args, offset))
+                    | _ => Error.bug "RefFlatten.select: Ground")
+             | Object ob => Object.select (ob, offset)
+             | _ => Error.bug "RefFlatten.select"
+         end
       fun update {base, offset, value} =
-	 coerce {from = value,
-		 to = select {base = base, offset = offset}}
+         (coerce {from = value,
+                  to = select {base = base, offset = offset}}
+          (* Don't flatten the component of the update, 
+           * else sharing will be broken.
+           *)
+          ; Value.dontFlatten value)
       fun const c = typeValue (Type.ofConst c)
       val {func, value = varValue, ...} =
-	 analyze {coerce = coerce,
-		  const = const,
-		  filter = fn _ => (),
-		  filterWord = fn _ => (),
-		  fromType = typeValue,
-		  inject = inject,
-		  layout = Value.layout,
-		  object = object,
-		  primApp = primApp,
-		  program = program,
-		  select = fn {base, offset, ...} => select {base = base,
-							     offset = offset},
-		  update = update,
-		  useFromTypeOnBinds = false}
+         analyze {coerce = coerce,
+                  const = const,
+                  filter = fn _ => (),
+                  filterWord = fn _ => (),
+                  fromType = typeValue,
+                  inject = inject,
+                  layout = Value.layout,
+                  object = object,
+                  primApp = primApp,
+                  program = program,
+                  select = fn {base, offset, ...} => select {base = base,
+                                                             offset = offset},
+                  update = update,
+                  useFromTypeOnBinds = false}
       val varObject = Value.deObject o varValue
       (* Mark a variable as Flattenable if all its uses are contained in a single
        * basic block, there is a single use in an object construction, and
@@ -515,160 +517,162 @@
       datatype z = datatype VarInfo.t
       datatype z = datatype VarInfo.useStatus
       val {get = varInfo: Var.t -> VarInfo.t ref, ...} =
-	 Property.get (Var.plist,
-		       Property.initFun (fn _ => ref VarInfo.Unflattenable))
+         Property.get (Var.plist,
+                       Property.initFun (fn _ => ref VarInfo.Unflattenable))
       val varInfo =
-	 Trace.trace ("RefFlatten.varInfo",
-		      Var.layout, Ref.layout VarInfo.layout)
-	 varInfo
+         Trace.trace ("RefFlatten.varInfo",
+                      Var.layout, Ref.layout VarInfo.layout)
+         varInfo
       fun use x = varInfo x := Unflattenable
       val use = Trace.trace ("RefFlatten.use", Var.layout, Unit.layout) use
       fun uses xs = Vector.foreach (xs, use)
       fun loopStatement (s: Statement.t, current: Label.t): unit =
-	 case s of
-	    Bind {exp = Exp.Object {args, ...}, var, ...} =>
-	       (case var of
-		   NONE => uses args
-		 | SOME var =>
-		      case Value.deObject (varValue var) of
-			 NONE => uses args
-		       | SOME object =>
-			    let
-			       val () =
-				  varInfo var
-				  := Flattenable {components = args,
-						  defBlock = current,
-						  useStatus = ref Unused}
-			    in
-			       Vector.foreachi
-			       (args, fn (offset, x) =>
-				let
-				   val r = varInfo x
-				in
-				   case !r of
-				      Flattenable {defBlock, useStatus, ...} =>
-					 (if Label.equals (current, defBlock)
-					     andalso (case !useStatus of
-							 InTuple _ => false
-						       | Unused => true)
-					     then (useStatus
-						   := (InTuple
-						       {object = object,
-							objectVar = var,
-							offset = offset}))
-					  else r := Unflattenable)
-				    | Unflattenable => ()
-				end)
-			    end)
-	  | Statement.Update {base, value, ...} =>
-	       (use value
-		; (case base of
-		      Base.Object r =>
-			 let
-			    val i = varInfo r
-			 in
-			    case ! i of
-			       Flattenable {defBlock, useStatus, ...} =>
-				  if Label.equals (current, defBlock)
-				     andalso (case !useStatus of
-						 InTuple _ => true
-					       | Unused => false)
-				     then ()
-				  else i := Unflattenable
-			     | Unflattenable => ()
-			 end
-		    | Base.VectorSub _ => ()))
-	  | _ => Statement.foreachUse (s, use)
+         case s of
+            Bind {exp = Exp.Object {args, ...}, var, ...} =>
+               (case var of
+                   NONE => uses args
+                 | SOME var =>
+                      case Value.deObject (varValue var) of
+                         NONE => uses args
+                       | SOME object =>
+                            let
+                               val () =
+                                  varInfo var
+                                  := Flattenable {components = args,
+                                                  defBlock = current,
+                                                  useStatus = ref Unused}
+                            in
+                               Vector.foreachi
+                               (args, fn (offset, x) =>
+                                let
+                                   val r = varInfo x
+                                in
+                                   case !r of
+                                      Flattenable {defBlock, useStatus, ...} =>
+                                         (if Label.equals (current, defBlock)
+                                             andalso (case !useStatus of
+                                                         InTuple _ => false
+                                                       | Unused => true)
+                                             then (useStatus
+                                                   := (InTuple
+                                                       {object = object,
+                                                        objectVar = var,
+                                                        offset = offset}))
+                                          else r := Unflattenable)
+                                    | Unflattenable => ()
+                                end)
+                            end)
+          | Statement.Update {base, value, ...} =>
+               (use value
+                ; (case base of
+                      Base.Object r =>
+                         let
+                            val i = varInfo r
+                         in
+                            case ! i of
+                               Flattenable {defBlock, useStatus, ...} =>
+                                  if Label.equals (current, defBlock)
+                                     andalso (case !useStatus of
+                                                 InTuple _ => true
+                                               | Unused => false)
+                                     then ()
+                                  else i := Unflattenable
+                             | Unflattenable => ()
+                         end
+                    | Base.VectorSub _ => ()))
+          | _ => Statement.foreachUse (s, use)
       val loopStatement =
-	 Trace.trace2
-	 ("RefFlatten.loopStatement", Statement.layout, Label.layout,
-	  Unit.layout)
-	 loopStatement
+         Trace.trace2
+         ("RefFlatten.loopStatement", Statement.layout, Label.layout,
+          Unit.layout)
+         loopStatement
       fun loopStatements (ss, label) =
-	 Vector.foreach (ss, fn s => loopStatement (s, label))
+         Vector.foreach (ss, fn s => loopStatement (s, label))
       fun loopTransfer t = Transfer.foreachVar (t, use)
       val globalLabel = Label.newNoname ()
       val () = loopStatements (globals, globalLabel)
       val () =
-	 List.foreach
-	 (functions, fn f =>
-	  Function.dfs
-	  (f, fn Block.T {label, statements, transfer, ...} =>
-	   (loopStatements (statements, label)
-	    ; loopTransfer transfer
-	    ; fn () => ())))
+         List.foreach
+         (functions, fn f =>
+          Function.dfs
+          (f, fn Block.T {label, statements, transfer, ...} =>
+           (loopStatements (statements, label)
+            ; loopTransfer transfer
+            ; fn () => ())))
       fun foreachObject (f): unit =
-	 let
-	    fun loopStatement s =
-	       case s of
-		  Bind {exp = Exp.Object {args, ...}, var, ...} =>
-		     Option.app
-		     (var, fn var =>
-		      case Value.value (varValue var) of
-			 Value.Ground _ => ()
-		       | Value.Object obj => f (var, args, obj)
-		       | _ => Error.bug "Object with strange value")
-		| _ => ()
-	    val () = Vector.foreach (globals, loopStatement)
-	    val () =
-	       List.foreach
-	       (functions, fn f =>
-		let
-		   val {blocks, ...} = Function.dest f
-		in
-		   Vector.foreach
-		   (blocks, fn Block.T {statements, ...} =>
-		    Vector.foreach (statements, loopStatement))
-		end)
-	 in
-	    ()
-	 end
+         let
+            fun loopStatement s =
+               case s of
+                  Bind {exp = Exp.Object {args, ...}, var, ...} =>
+                     Option.app
+                     (var, fn var =>
+                      case Value.value (varValue var) of
+                         Value.Ground _ => ()
+                       | Value.Object obj => f (var, args, obj)
+                       | _ => 
+                            Error.bug 
+                            "RefFlatten.foreachObject: Object with strange value")
+                | _ => ()
+            val () = Vector.foreach (globals, loopStatement)
+            val () =
+               List.foreach
+               (functions, fn f =>
+                let
+                   val {blocks, ...} = Function.dest f
+                in
+                   Vector.foreach
+                   (blocks, fn Block.T {statements, ...} =>
+                    Vector.foreach (statements, loopStatement))
+                end)
+         in
+            ()
+         end
       (* Try to flatten each ref. *)
       val () =
-	 foreachObject
-	 (fn (var, _, obj as Obj {flat, ...}) =>
-	  let
-	     datatype z = datatype Flat.t
-	     fun notFlat () = flat := NotFlat
-	     val () =
-		case ! (varInfo var) of
-		   Flattenable {useStatus, ...} =>
-		      (case !useStatus of
-			  InTuple {object = obj', offset = i', ...} =>
-			     (case ! flat of
-				 NotFlat => ()
-			       | Offset {object = obj'', offset = i''} =>
-				    if i' = i'' andalso Object.equals (obj', obj'')
-				       then ()
-				       else notFlat ()
-			       | Unknown => flat := Offset {object = obj',
-							    offset = i'})
-			| Unused => notFlat ())
-		 | Unflattenable => notFlat ()
-	  in
-	     ()
-	  end)
+         foreachObject
+         (fn (var, _, Obj {flat, ...}) =>
+          let
+             datatype z = datatype Flat.t
+             fun notFlat () = flat := NotFlat
+             val () =
+                case ! (varInfo var) of
+                   Flattenable {useStatus, ...} =>
+                      (case !useStatus of
+                          InTuple {object = obj', offset = i', ...} =>
+                             (case ! flat of
+                                 NotFlat => ()
+                               | Offset {object = obj'', offset = i''} =>
+                                    if i' = i'' andalso Object.equals (obj', obj'')
+                                       then ()
+                                       else notFlat ()
+                               | Unknown => flat := Offset {object = obj',
+                                                            offset = i'})
+                        | Unused => notFlat ())
+                 | Unflattenable => notFlat ()
+          in
+             ()
+          end)
       val () =
-	 foreachObject
-	 (fn (_, args, obj as Obj {flat, ...}) =>
-	  let
-	     datatype z = datatype Flat.t
-	     (* Check that all arguments that are represented by flattening them
-	      * into the object are available as an explicit allocation.
-	      *)
-	     val () =
-		Vector.foreach
-		(args, fn a =>
-		 case Value.deFlat {inner = varValue a, outer = obj} of
-		    NONE => ()
-		  | SOME (Obj {flat, ...}) =>
-		       case ! (varInfo a) of
-			  Flattenable _ => ()
-			| Unflattenable =>
-			     flat := NotFlat)
-	  in
-	     ()
-	  end)
+         foreachObject
+         (fn (_, args, obj) =>
+          let
+             datatype z = datatype Flat.t
+             (* Check that all arguments that are represented by flattening them
+              * into the object are available as an explicit allocation.
+              *)
+             val () =
+                Vector.foreach
+                (args, fn a =>
+                 case Value.deFlat {inner = varValue a, outer = obj} of
+                    NONE => ()
+                  | SOME (Obj {flat, ...}) =>
+                       case ! (varInfo a) of
+                          Flattenable _ => ()
+                        | Unflattenable =>
+                             flat := NotFlat)
+          in
+             ()
+          end)
       (*
        * The following code disables flattening of some refs to ensure
        * space safety.  Flattening a ref into an object that has
@@ -683,369 +687,370 @@
        * happen.
        *)
       val {get = tyconSize: Tycon.t -> Size.t, ...} =
-	 Property.get (Tycon.plist, Property.initFun (fn _ => Size.new ()))
+         Property.get (Tycon.plist, Property.initFun (fn _ => Size.new ()))
       val {get = typeSize: Type.t -> Size.t, ...} =
-	 Property.get (Type.plist,
-		       Property.initRec
-		       (fn (t, typeSize) =>
-			let
-			   val s = Size.new ()
-			   fun dependsOn (t: Type.t): unit =
-			      Size.<= (typeSize t, s)
-			   datatype z = datatype Type.dest
-			   val () =
-			      case Type.dest t of
-				 Datatype c => Size.<= (tyconSize c, s)
-			       | IntInf => Size.makeTop s
-			       | Object {args, ...} =>
-				    Prod.foreach (args, dependsOn)
-			       | Real _ => ()
-			       | Thread => Size.makeTop s
-			       | Weak t => dependsOn t
-			       | Word _ => ()
-			in
-			   s
-			end))
+         Property.get (Type.plist,
+                       Property.initRec
+                       (fn (t, typeSize) =>
+                        let
+                           val s = Size.new ()
+                           fun dependsOn (t: Type.t): unit =
+                              Size.<= (typeSize t, s)
+                           datatype z = datatype Type.dest
+                           val () =
+                              case Type.dest t of
+                                 Datatype c => Size.<= (tyconSize c, s)
+                               | IntInf => Size.makeTop s
+                               | Object {args, ...} =>
+                                    Prod.foreach (args, dependsOn)
+                               | Real _ => ()
+                               | Thread => Size.makeTop s
+                               | Weak t => dependsOn t
+                               | Word _ => ()
+                        in
+                           s
+                        end))
       val () =
-	 Vector.foreach
-	 (datatypes, fn Datatype.T {cons, tycon} =>
-	  let
-	     val s = tyconSize tycon
-	     fun dependsOn (t: Type.t): unit = Size.<= (typeSize t, s)
-	     val () = Vector.foreach (cons, fn {args, ...} =>
-				      Prod.foreach (args, dependsOn))
-	  in
-	     ()
-	  end)
+         Vector.foreach
+         (datatypes, fn Datatype.T {cons, tycon} =>
+          let
+             val s = tyconSize tycon
+             fun dependsOn (t: Type.t): unit = Size.<= (typeSize t, s)
+             val () = Vector.foreach (cons, fn {args, ...} =>
+                                      Prod.foreach (args, dependsOn))
+          in
+             ()
+          end)
       fun typeIsLarge (t: Type.t): bool =
-	 Size.isTop (typeSize t)
+         Size.isTop (typeSize t)
       fun objectHasAnotherLarge (Object.Obj {args, ...}, {offset: int}) =
-	 Vector.existsi (Prod.dest args, fn (i, {elt, ...}) =>
-			 i <> offset
-			 andalso typeIsLarge (Value.originalType elt))
+         Vector.existsi (Prod.dest args, fn (i, {elt, ...}) =>
+                         i <> offset
+                         andalso typeIsLarge (Value.originalType elt))
       val () =
-	 List.foreach
-	 (functions, fn f =>
-	  let
-	     val {args, blocks, ...} = Function.dest f
-	  in
-	     Vector.foreach
-	     (blocks, fn Block.T {statements, transfer, ...} =>
-	      let
-		 fun containerIsLive (x: Var.t) =
-		    Vector.exists
-		    (statements, fn s =>
-		     case s of
-			Bind {exp, var = SOME x', ...} =>
-			   Var.equals (x, x')
-			   andalso (case exp of
-				       Exp.Select _ => true
-				     | _ => false)
-		      | _ => false)
-		 fun use (x: Var.t) =
-		    case Value.value (varValue x) of
-		       Value.Object (Obj {flat, ...}) =>
-			  (case !flat of
-			      Flat.Offset {object, offset} =>
-				 if objectHasAnotherLarge (object,
-							   {offset = offset})
-				    andalso not (containerIsLive x)
-				    then flat := Flat.NotFlat
-				 else ()
-			    | _ => ())
-		     | _ => ()
-		 val () = Vector.foreach (statements, fn s =>
-					  Statement.foreachUse (s, use))
-		 val () = Transfer.foreachVar (transfer, use)
-	      in
-		 ()
-	      end)
-	  end)
+         List.foreach
+         (functions, fn f =>
+          let
+             val {blocks, ...} = Function.dest f
+          in
+             Vector.foreach
+             (blocks, fn Block.T {statements, transfer, ...} =>
+              let
+                 fun containerIsLive (x: Var.t) =
+                    Vector.exists
+                    (statements, fn s =>
+                     case s of
+                        Bind {exp, var = SOME x', ...} =>
+                           Var.equals (x, x')
+                           andalso (case exp of
+                                       Exp.Select _ => true
+                                     | _ => false)
+                      | _ => false)
+                 fun use (x: Var.t) =
+                    case Value.value (varValue x) of
+                       Value.Object (Obj {flat, ...}) =>
+                          (case !flat of
+                              Flat.Offset {object, offset} =>
+                                 if objectHasAnotherLarge (object,
+                                                           {offset = offset})
+                                    andalso not (containerIsLive x)
+                                    then flat := Flat.NotFlat
+                                 else ()
+                            | _ => ())
+                     | _ => ()
+                 val () = Vector.foreach (statements, fn s =>
+                                          Statement.foreachUse (s, use))
+                 val () = Transfer.foreachVar (transfer, use)
+              in
+                 ()
+              end)
+          end)
       (* Mark varInfo as Unflattenable if varValue is.  This done after all the
        * other parts of the analysis so that varInfo is consistent with the
        * varValue.
        *)
       val () =
-	 Program.foreachVar
-	 (program, fn (x, _) =>
-	  let
-	     val r = varInfo x
-	  in
-	     case !r of
-		Flattenable _ =>
-		   (case Value.deObject (varValue x) of
-		       NONE => ()
-		     | SOME (Obj {flat, ...}) =>
-			  (case !flat of
-			      Flat.NotFlat => r := Unflattenable
-			    | _ => ()))
-	      | Unflattenable => ()
-	  end)
+         Program.foreachVar
+         (program, fn (x, _) =>
+          let
+             val r = varInfo x
+          in
+             case !r of
+                Flattenable _ =>
+                   (case Value.deObject (varValue x) of
+                       NONE => ()
+                     | SOME (Obj {flat, ...}) =>
+                          (case !flat of
+                              Flat.NotFlat => r := Unflattenable
+                            | _ => ()))
+              | Unflattenable => ()
+          end)
       val () =
-	 Control.diagnostics
-	 (fn display =>
-	  let
-	     open Layout
-	     val () =
-		Vector.foreach
-		(datatypes, fn Datatype.T {cons, ...} =>
-		 Vector.foreach
-		 (cons, fn {con, ...} =>
-		  display (Option.layout Value.layout (! (conValue con)))))
-	     val () =
-		Program.foreachVar
-		(program, fn (x, _) =>
-		 display
-		 (seq [Var.layout x, str " ",
-		       record [("value", Value.layout (varValue x)),
-			       ("varInfo", VarInfo.layout (! (varInfo x)))]]))
-	  in
-	     ()
-	  end)
+         Control.diagnostics
+         (fn display =>
+          let
+             open Layout
+             val () =
+                Vector.foreach
+                (datatypes, fn Datatype.T {cons, ...} =>
+                 Vector.foreach
+                 (cons, fn {con, ...} =>
+                  display (Option.layout Value.layout (! (conValue con)))))
+             val () =
+                Program.foreachVar
+                (program, fn (x, _) =>
+                 display
+                 (seq [Var.layout x, str " ",
+                       record [("value", Value.layout (varValue x)),
+                               ("varInfo", VarInfo.layout (! (varInfo x)))]]))
+          in
+             ()
+          end)
       (* Conversion from values to types. *)
       datatype z = datatype Finish.t
-      val traceValueType = Trace.trace ("RefFlatten.valueType", Value.layout, Type.layout)
+      val traceValueType = 
+         Trace.trace ("RefFlatten.valueType", Value.layout, Type.layout)
       fun valueType arg: Type.t =
-	 traceValueType
-	 (fn (v: Value.t) =>
-	 let
-	    datatype z = datatype Value.value
-	 in
-	    case Value.value v of
-	       Ground t => t
-	     | Object z => objectType z
-	     | Weak {arg, finalType, ...} =>
-		  Ref.memoize (finalType, fn () => Type.weak (valueType arg))
-	 end) arg
+         traceValueType
+         (fn (v: Value.t) =>
+         let
+            datatype z = datatype Value.value
+         in
+            case Value.value v of
+               Ground t => t
+             | Object z => objectType z
+             | Weak {arg, finalType, ...} =>
+                  Ref.memoize (finalType, fn () => Type.weak (valueType arg))
+         end) arg
       and objectFinalComponents (obj as Obj {args, finalComponents, ...}) =
-	 Ref.memoize
-	 (finalComponents, fn () =>
-	  Prod.make
-	  (Vector.fromList
-	   (Vector.foldr
-	    (Prod.dest args, [], fn ({elt, isMutable = i}, ac) =>
-	     case Value.deFlat {inner = elt, outer = obj} of
-		NONE => {elt = valueType elt, isMutable = i} :: ac
-	      | SOME z => 
-		   Vector.foldr
-		   (Prod.dest (objectFinalComponents z), ac,
-		    fn ({elt, isMutable = i'}, ac) =>
-		    {elt = elt, isMutable = i orelse i'} :: ac)))))
+         Ref.memoize
+         (finalComponents, fn () =>
+          Prod.make
+          (Vector.fromList
+           (Vector.foldr
+            (Prod.dest args, [], fn ({elt, isMutable = i}, ac) =>
+             case Value.deFlat {inner = elt, outer = obj} of
+                NONE => {elt = valueType elt, isMutable = i} :: ac
+              | SOME z => 
+                   Vector.foldr
+                   (Prod.dest (objectFinalComponents z), ac,
+                    fn ({elt, isMutable = i'}, ac) =>
+                    {elt = elt, isMutable = i orelse i'} :: ac)))))
       and objectFinalOffsets (z as Obj {args, finalOffsets, flat, ...}) =
-	 Ref.memoize
-	 (finalOffsets, fn () =>
-	  let
-	     val initial =
-		case ! flat of
-		   Flat.Offset {object, offset} => objectOffset (object, offset)
-		 | _ => 0
-	     val (_, offsets) =
-		Vector.fold
-		(Prod.dest args, (initial, []), fn ({elt, ...}, (offset, ac)) =>
-		 let
-		    val width =
-		       case Value.deFlat {inner = elt, outer = z} of
-			  NONE => 1
-			| SOME z => Prod.length (objectFinalComponents z)
-		 in
-		    (offset + width, offset :: ac)
-		 end)
-	  in
-	     Vector.fromListRev offsets
-	  end)
+         Ref.memoize
+         (finalOffsets, fn () =>
+          let
+             val initial =
+                case ! flat of
+                   Flat.Offset {object, offset} => objectOffset (object, offset)
+                 | _ => 0
+             val (_, offsets) =
+                Vector.fold
+                (Prod.dest args, (initial, []), fn ({elt, ...}, (offset, ac)) =>
+                 let
+                    val width =
+                       case Value.deFlat {inner = elt, outer = z} of
+                          NONE => 1
+                        | SOME z => Prod.length (objectFinalComponents z)
+                 in
+                    (offset + width, offset :: ac)
+                 end)
+          in
+             Vector.fromListRev offsets
+          end)
       and objectOffset (z: Object.t, offset: int): int =
-	 Vector.sub (objectFinalOffsets z, offset)
+         Vector.sub (objectFinalOffsets z, offset)
       and objectType (z as Obj {con, finalType, flat, ...}): Type.t =
-	 Ref.memoize
-	 (finalType, fn () =>
-	  case ! flat of
-	     Flat.Offset {object, ...} => objectType object
-	   | _ => Type.object {args = objectFinalComponents z,
-			       con = con})
+         Ref.memoize
+         (finalType, fn () =>
+          case ! flat of
+             Flat.Offset {object, ...} => objectType object
+           | _ => Type.object {args = objectFinalComponents z,
+                               con = con})
       (* Transform the program. *)
       fun transformFormals (xts: (Var.t * Type.t) vector)
-	 : (Var.t * Type.t) vector =
-	 Vector.map (xts, fn (x, _) => (x, valueType (varValue x)))
+         : (Var.t * Type.t) vector =
+         Vector.map (xts, fn (x, _) => (x, valueType (varValue x)))
       val extraSelects: Statement.t list ref = ref []
       fun flattenValues (object: Var.t,
-			 obj as Obj {args, ...},
-			 ac: Var.t list): Var.t list =
-	 Vector.foldri
-	 (Prod.dest args, ac, fn (i, {elt, ...}, ac) =>
-	  case Value.deFlat {inner = elt, outer = obj} of
-	     NONE => 
-		let
-		   val var = Var.newNoname ()
-		   val () =
-		      List.push
-		      (extraSelects,
-		       Bind
-		       {exp = Select {base = Base.Object object,
-				      offset = objectOffset (obj, i)},
-			ty = valueType elt,
-			var = SOME var})
-		in
-		   var :: ac
-		end
-	   | SOME obj => flattenValues (object, obj, ac))
+                         obj as Obj {args, ...},
+                         ac: Var.t list): Var.t list =
+         Vector.foldri
+         (Prod.dest args, ac, fn (i, {elt, ...}, ac) =>
+          case Value.deFlat {inner = elt, outer = obj} of
+             NONE => 
+                let
+                   val var = Var.newNoname ()
+                   val () =
+                      List.push
+                      (extraSelects,
+                       Bind
+                       {exp = Select {base = Base.Object object,
+                                      offset = objectOffset (obj, i)},
+                        ty = valueType elt,
+                        var = SOME var})
+                in
+                   var :: ac
+                end
+           | SOME obj => flattenValues (object, obj, ac))
       fun flattenArgs (xs: Var.t vector, outer: Object.t, ac): Var.t list =
-	 Vector.foldr
-	 (xs, ac, fn (x, ac) =>
-	  let
-	     val v = varValue x
-	  in
-	     case Value.deFlat {inner = v, outer = outer} of
-		NONE => x :: ac
-	      | SOME obj =>
-		   (case ! (varInfo x) of
-		       Flattenable {components, ...} =>
-			  flattenArgs (components, obj, ac)
-		     | Unflattenable => flattenValues (x, obj, ac))
-	  end)
+         Vector.foldr
+         (xs, ac, fn (x, ac) =>
+          let
+             val v = varValue x
+          in
+             case Value.deFlat {inner = v, outer = outer} of
+                NONE => x :: ac
+              | SOME obj =>
+                   (case ! (varInfo x) of
+                       Flattenable {components, ...} =>
+                          flattenArgs (components, obj, ac)
+                     | Unflattenable => flattenValues (x, obj, ac))
+          end)
       val flattenArgs =
-	 Trace.trace3 ("RefFlatten.flattenArgs",
-		       Vector.layout Var.layout,
-		       Object.layout,
-		       List.layout Var.layout,
-		       List.layout Var.layout)
-	 flattenArgs
+         Trace.trace3 ("RefFlatten.flattenArgs",
+                       Vector.layout Var.layout,
+                       Object.layout,
+                       List.layout Var.layout,
+                       List.layout Var.layout)
+         flattenArgs
       fun transformBind {exp, ty, var}: Statement.t vector =
-	 let
-	    fun make e =
-	       Vector.new1
-	       (Bind {exp = e,
-		      ty = (case var of
-			       NONE => ty
-			     | SOME var => valueType (varValue var)),
-		      var = var})
-	    fun none () = Vector.new0 ()
-	 in
-	    case exp of
-	       Exp.Object {args, con} =>
-		  (case var of
-		      NONE => none ()
-		    | SOME var =>
-			 (case varObject var of
-			     NONE => make exp
-			   | SOME (z as Obj {flat, ...}) =>
-				case ! flat of
-				   Flat.Offset _ => none ()
-				 | _ =>
-				      let
-					 val args =
-					    Vector.fromList
-					    (flattenArgs (args, z, []))
-					 val extra = !extraSelects
-					 val () = extraSelects := []
-				      in
-					 Vector.concat
-					 [Vector.fromList extra,
-					  make (Exp.Object
-						{args = args, con = con})]
-				      end))
-	     | PrimApp {args, prim} =>
-		  make (PrimApp {args = args, prim = prim})
-	     | Select {base, offset} =>
-		  (case var of
-		      NONE => none ()
-		    | SOME var =>
-			 (case base of
-			     Base.Object object =>
-				(case varObject object of
-				    NONE => make exp
-				  | SOME obj => 
-				       make
-				       (if isSome (Value.deFlat
-						   {inner = varValue var,
-						    outer = obj})
-					   then Var object
-					else (Select
-					      {base = base,
-					       offset = (objectOffset
-							 (obj, offset))})))
-			   | Base.VectorSub _ => make exp))
-	     | _ => make exp
-	 end
+         let
+            fun make e =
+               Vector.new1
+               (Bind {exp = e,
+                      ty = (case var of
+                               NONE => ty
+                             | SOME var => valueType (varValue var)),
+                      var = var})
+            fun none () = Vector.new0 ()
+         in
+            case exp of
+               Exp.Object {args, con} =>
+                  (case var of
+                      NONE => none ()
+                    | SOME var =>
+                         (case varObject var of
+                             NONE => make exp
+                           | SOME (z as Obj {flat, ...}) =>
+                                case ! flat of
+                                   Flat.Offset _ => none ()
+                                 | _ =>
+                                      let
+                                         val args =
+                                            Vector.fromList
+                                            (flattenArgs (args, z, []))
+                                         val extra = !extraSelects
+                                         val () = extraSelects := []
+                                      in
+                                         Vector.concat
+                                         [Vector.fromList extra,
+                                          make (Exp.Object
+                                                {args = args, con = con})]
+                                      end))
+             | PrimApp {args, prim} =>
+                  make (PrimApp {args = args, prim = prim})
+             | Select {base, offset} =>
+                  (case var of
+                      NONE => none ()
+                    | SOME var =>
+                         (case base of
+                             Base.Object object =>
+                                (case varObject object of
+                                    NONE => make exp
+                                  | SOME obj => 
+                                       make
+                                       (if isSome (Value.deFlat
+                                                   {inner = varValue var,
+                                                    outer = obj})
+                                           then Var object
+                                        else (Select
+                                              {base = base,
+                                               offset = (objectOffset
+                                                         (obj, offset))})))
+                           | Base.VectorSub _ => make exp))
+             | _ => make exp
+         end
       fun transformStatement (s: Statement.t): Statement.t vector =
-	 case s of
-	    Bind b => transformBind b
-	  | Profile _ => Vector.new1 s
-	  | Update {base, offset, value} =>
-	       (case base of
-		   Base.Object object =>
-		      Vector.new1
-		      (case varObject object of
-			  NONE => s
-			| SOME obj =>
-			     let
-				val base =
-				   case ! (varInfo object) of
-				      Flattenable {useStatus, ...} =>
-					 (case ! useStatus of
-					     InTuple {objectVar, ...} =>
-						Base.Object objectVar
-					   | _ => base)
-				    | Unflattenable => base
-			     in
-				Update {base = base,
-					offset = objectOffset (obj, offset),
-					value = value}
-			     end)
-		 | Base.VectorSub _ => Vector.new1 s)
+         case s of
+            Bind b => transformBind b
+          | Profile _ => Vector.new1 s
+          | Update {base, offset, value} =>
+               Vector.new1
+               (case base of
+                   Base.Object object =>
+                      (case varObject object of
+                          NONE => s
+                        | SOME obj =>
+                             let
+                                val base =
+                                   case ! (varInfo object) of
+                                      Flattenable {useStatus, ...} =>
+                                         (case ! useStatus of
+                                             InTuple {objectVar, ...} =>
+                                                Base.Object objectVar
+                                           | _ => base)
+                                    | Unflattenable => base
+                             in
+                                Update {base = base,
+                                        offset = objectOffset (obj, offset),
+                                        value = value}
+                             end)
+                 | Base.VectorSub _ => s)
       val transformStatement =
-	 Trace.trace ("RefFlatten.transformStatement",
-		      Statement.layout,
-		      Vector.layout Statement.layout)
-	 transformStatement
+         Trace.trace ("RefFlatten.transformStatement",
+                      Statement.layout,
+                      Vector.layout Statement.layout)
+         transformStatement
       fun transformStatements ss =
-	 Vector.concatV (Vector.map (ss, transformStatement))
+         Vector.concatV (Vector.map (ss, transformStatement))
       fun transformBlock (Block.T {args, label, statements, transfer}) =
-	    Block.T {args = transformFormals args,
-		     label = label,
-		     statements = transformStatements statements,
-		     transfer = transfer}
+            Block.T {args = transformFormals args,
+                     label = label,
+                     statements = transformStatements statements,
+                     transfer = transfer}
       fun valuesTypes vs = Vector.map (vs, valueType)
       val datatypes =
-	 Vector.map
-	 (datatypes, fn Datatype.T {cons, tycon} =>
-	  let
-	     val cons =
-		Vector.map
-		(cons, fn {con, args} =>
-		 let
-		    val args =
-		       case ! (conValue con) of
-			  NONE => args
-			| SOME v => 
-			     case Type.dest (valueType v) of
-				Type.Object {args, ...} => args
-			      | _ => Error.bug "strange con"
-		 in
-		    {args = args, con = con}
-		 end)
-	  in
-	     Datatype.T {cons = cons, tycon = tycon}
-	  end)
+         Vector.map
+         (datatypes, fn Datatype.T {cons, tycon} =>
+          let
+             val cons =
+                Vector.map
+                (cons, fn {con, args} =>
+                 let
+                    val args =
+                       case ! (conValue con) of
+                          NONE => args
+                        | SOME v => 
+                             case Type.dest (valueType v) of
+                                Type.Object {args, ...} => args
+                              | _ => Error.bug "RefFlatten.datatypes: strange con"
+                 in
+                    {args = args, con = con}
+                 end)
+          in
+             Datatype.T {cons = cons, tycon = tycon}
+          end)
       fun transformFunction (f: Function.t): Function.t =
-	  let
-	     val {args, blocks, mayInline, name, start, ...} = Function.dest f
-	     val {raises, returns, ...} = func name
-	     val raises = Option.map (raises, valuesTypes)
-	     val returns = Option.map (returns, valuesTypes)
-	  in
-	     Function.new {args = transformFormals args,
-			   blocks = Vector.map (blocks, transformBlock),
-			   mayInline = mayInline,
-			   name = name,
-			   raises = raises,
-			   returns = returns,
-			   start = start}
-	  end
+          let
+             val {args, blocks, mayInline, name, start, ...} = Function.dest f
+             val {raises, returns, ...} = func name
+             val raises = Option.map (raises, valuesTypes)
+             val returns = Option.map (returns, valuesTypes)
+          in
+             Function.new {args = transformFormals args,
+                           blocks = Vector.map (blocks, transformBlock),
+                           mayInline = mayInline,
+                           name = name,
+                           raises = raises,
+                           returns = returns,
+                           start = start}
+          end
       val program =
-	 Program.T {datatypes = datatypes,
-		    functions = List.revMap (functions, transformFunction),
-		    globals = transformStatements globals,
-		    main = main}
+         Program.T {datatypes = datatypes,
+                    functions = List.revMap (functions, transformFunction),
+                    globals = transformStatements globals,
+                    main = main}
       val () = Program.clear program
    in
       shrink program

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ssa/ref-flatten.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ssa/ref-flatten.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ssa/ref-flatten.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,8 +1,8 @@
-(* Copyright (C) 2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 2004-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 signature REF_FLATTEN_STRUCTS = 

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ssa/remove-unused.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ssa/remove-unused.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ssa/remove-unused.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,20 +1,23 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 functor RemoveUnused (S: REMOVE_UNUSED_STRUCTS): REMOVE_UNUSED = 
 struct
 
 open S
 open Exp Transfer
 
+type int = Int.t
+
 structure Used =
   struct
     structure L = TwoPointLattice (val bottom = "unused"
-				   val top = "used")
+                                   val top = "used")
     open L
     val use = makeTop
     val isUsed = isTop
@@ -24,7 +27,7 @@
 structure Coned =
   struct
     structure L = TwoPointLattice (val bottom = "not coned"
-				   val top = "coned")
+                                   val top = "coned")
     open L
     val con = makeTop
     val isConed = isTop
@@ -34,7 +37,7 @@
 structure Deconed =
   struct
     structure L = TwoPointLattice (val bottom = "not deconed"
-				   val top = "deconed")
+                                   val top = "deconed")
     open L
     val decon = makeTop
     val isDeconed = isTop
@@ -43,7 +46,7 @@
 structure SideEffects =
   struct
     structure L = TwoPointLattice (val bottom = "does not side effect"
-				   val top = "side effects")
+                                   val top = "side effects")
     open L
     val sideEffect = makeTop
   end
@@ -51,7 +54,7 @@
 structure MayReturn =
   struct
     structure L = TwoPointLattice (val bottom = "does not return"
-				   val top = "may return")
+                                   val top = "may return")
     open L
     val return = makeTop
     val mayReturn = isTop
@@ -61,7 +64,7 @@
 structure MayRaise =
   struct
     structure L = TwoPointLattice (val bottom = "does not raise"
-				   val top = "may raise")
+                                   val top = "may raise")
     open L
     val raisee = makeTop
     val mayRaise = isTop
@@ -105,7 +108,7 @@
 structure TyconInfo =
   struct
     datatype t = T of {cons: {con: Con.t, args: Type.t vector} vector,
-		       numCons: int ref}
+                       numCons: int ref}
 
     local
       fun make f (T r) = f r
@@ -117,21 +120,21 @@
 
     fun new {cons: {con: Con.t, args: Type.t vector} vector}: t
       = T {cons = cons,
-	   numCons = ref ~1}
+           numCons = ref ~1}
   end
 
 structure ConInfo =
   struct
     datatype t = T of {args: (VarInfo.t * Type.t) vector,
-		       coned: Coned.t,
-		       deconed: Deconed.t,
-		       dummy: Exp.t option ref,
-		       tycon: Tycon.t}
+                       coned: Coned.t,
+                       deconed: Deconed.t,
+                       dummy: Exp.t option ref,
+                       tycon: Tycon.t}
 
     fun layout (T {args, coned, deconed, ...}) 
       = Layout.record [("args", Vector.layout (VarInfo.layout o #1) args),
-		       ("coned", Coned.layout coned),
-		       ("deconed", Deconed.layout deconed)]
+                       ("coned", Coned.layout coned),
+                       ("deconed", Deconed.layout deconed)]
       
     local
       fun make f (T r) = f r
@@ -152,46 +155,46 @@
       
     fun new {args: Type.t vector, tycon: Tycon.t}: t
       = T {args = Vector.map (args, fn t => (VarInfo.new (), t)),
-	   coned = Coned.new (),
-	   deconed = Deconed.new (),
-	   dummy = ref NONE,
-	   tycon = tycon}
+           coned = Coned.new (),
+           deconed = Deconed.new (),
+           dummy = ref NONE,
+           tycon = tycon}
   end
 
 structure FuncInfo =
   struct
     datatype t = T of {args: (VarInfo.t * Type.t) vector,
-		       bugLabel: Label.t option ref,
-		       mayRaise: MayRaise.t,
-		       mayReturn: MayReturn.t,
-		       raiseLabel: Label.t option ref,
-		       raises: (VarInfo.t * Type.t) vector option,
-		       returnLabel: Label.t option ref,
-		       returns: (VarInfo.t * Type.t) vector option,
-		       sideEffects: SideEffects.t,
-		       used: Used.t,
-		       wrappers: Block.t list ref}
+                       bugLabel: Label.t option ref,
+                       mayRaise: MayRaise.t,
+                       mayReturn: MayReturn.t,
+                       raiseLabel: Label.t option ref,
+                       raises: (VarInfo.t * Type.t) vector option,
+                       returnLabel: Label.t option ref,
+                       returns: (VarInfo.t * Type.t) vector option,
+                       sideEffects: SideEffects.t,
+                       used: Used.t,
+                       wrappers: Block.t list ref}
       
     fun layout (T {args, 
-		   mayRaise, mayReturn, 
-		   raises, returns, 
-		   sideEffects, used,
-		   ...}) 
+                   mayRaise, mayReturn, 
+                   raises, returns, 
+                   sideEffects, used,
+                   ...}) 
       = Layout.record [("args", Vector.layout 
-			        (Layout.tuple2 (VarInfo.layout, Type.layout)) 
-				args),
-		       ("mayRaise", MayRaise.layout mayRaise),
-		       ("mayReturn", MayReturn.layout mayReturn),
-		       ("raises", Option.layout
-				  (Vector.layout 
-				   (Layout.tuple2 (VarInfo.layout, Type.layout)))
-				  raises),
-		       ("returns", Option.layout
-			           (Vector.layout 
-				    (Layout.tuple2 (VarInfo.layout, Type.layout)))
-				   returns),
-		       ("sideEffects", SideEffects.layout sideEffects),
-		       ("used", Used.layout used)]
+                                (Layout.tuple2 (VarInfo.layout, Type.layout)) 
+                                args),
+                       ("mayRaise", MayRaise.layout mayRaise),
+                       ("mayReturn", MayReturn.layout mayReturn),
+                       ("raises", Option.layout
+                                  (Vector.layout 
+                                   (Layout.tuple2 (VarInfo.layout, Type.layout)))
+                                  raises),
+                       ("returns", Option.layout
+                                   (Vector.layout 
+                                    (Layout.tuple2 (VarInfo.layout, Type.layout)))
+                                   returns),
+                       ("sideEffects", SideEffects.layout sideEffects),
+                       ("used", Used.layout used)]
 
     local
       fun make f (T r) = f r
@@ -227,37 +230,37 @@
     fun flowSideEffects (fi, fi') = SideEffects.<= (sideEffects fi, sideEffects fi')
 
     fun new {args: (VarInfo.t * Type.t) vector, 
-	     raises: (VarInfo.t * Type.t) vector option, 
-	     returns: (VarInfo.t * Type.t) vector option}: t
+             raises: (VarInfo.t * Type.t) vector option, 
+             returns: (VarInfo.t * Type.t) vector option}: t
       = T {args = args,
-	   bugLabel = ref NONE,
-	   mayRaise = MayRaise.new (),
-	   mayReturn = MayReturn.new (),
-	   raiseLabel = ref NONE,
-	   raises = raises,
-	   returnLabel = ref NONE,
-	   returns = returns,
-	   sideEffects = SideEffects.new (),
-	   used = Used.new (),
-	   wrappers = ref []}
+           bugLabel = ref NONE,
+           mayRaise = MayRaise.new (),
+           mayReturn = MayReturn.new (),
+           raiseLabel = ref NONE,
+           raises = raises,
+           returnLabel = ref NONE,
+           returns = returns,
+           sideEffects = SideEffects.new (),
+           used = Used.new (),
+           wrappers = ref []}
   end
 
 structure LabelInfo =
   struct
     datatype t = T of {args: (VarInfo.t * Type.t) vector,
-		       func: FuncInfo.t,
-		       used: Used.t,
-		       wrappers: (Type.t vector * Label.t) list ref}
+                       func: FuncInfo.t,
+                       used: Used.t,
+                       wrappers: (Type.t vector * Label.t) list ref}
 
     fun layout (T {args, used, ...}) 
       = Layout.record [("args", Vector.layout (VarInfo.layout o #1) args),
-		       ("used", Used.layout used)]
-				  
+                       ("used", Used.layout used)]
+                                  
     fun new {args: (VarInfo.t * Type.t) vector, func: FuncInfo.t}: t 
       = T {args = args,
-	   func = func,
-	   used = Used.new (),
-	   wrappers = ref []}
+           func = func,
+           used = Used.new (),
+           wrappers = ref []}
 
     local
       fun make f (T r) = f r
@@ -277,52 +280,52 @@
 fun remove (Program.T {datatypes, globals, functions, main})
   = let
       val {get = varInfo: Var.t -> VarInfo.t, ...}
-	= Property.get 
-	  (Var.plist, 
-	   Property.initFun (fn _ => VarInfo.new ()))
+        = Property.get 
+          (Var.plist, 
+           Property.initFun (fn _ => VarInfo.new ()))
 
       val {get = typeInfo: Type.t -> TypeInfo.t, 
-	   destroy, ...} 
-	= Property.destGet 
-	  (Type.plist, 
-	   Property.initFun (fn _ => TypeInfo.new ()))
+           destroy, ...} 
+        = Property.destGet 
+          (Type.plist, 
+           Property.initFun (fn _ => TypeInfo.new ()))
 
       val {get = tyconInfo: Tycon.t -> TyconInfo.t,
-	   set = setTyconInfo, ...}
-	= Property.getSetOnce
-	  (Tycon.plist, 
-	   Property.initRaise ("RemovedUnused.tyconInfo", Tycon.layout))
+           set = setTyconInfo, ...}
+        = Property.getSetOnce
+          (Tycon.plist, 
+           Property.initRaise ("RemovedUnused.tyconInfo", Tycon.layout))
 
       val {get = conInfo: Con.t -> ConInfo.t, 
-	   set = setConInfo, ...}
-	= Property.getSetOnce
-	  (Con.plist, 
-	   Property.initRaise ("RemoveUnused.conInfo", Con.layout))
+           set = setConInfo, ...}
+        = Property.getSetOnce
+          (Con.plist, 
+           Property.initRaise ("RemoveUnused.conInfo", Con.layout))
       fun newConInfo (con, args, tycon)
-	= setConInfo (con, ConInfo.new {args = args, tycon = tycon})
+        = setConInfo (con, ConInfo.new {args = args, tycon = tycon})
 
       val {get = labelInfo: Label.t -> LabelInfo.t, 
-	   set = setLabelInfo, ...}
-	= Property.getSetOnce
-	  (Label.plist,
-	   Property.initRaise ("RemoveUnused.labelInfo", Label.layout))
+           set = setLabelInfo, ...}
+        = Property.getSetOnce
+          (Label.plist,
+           Property.initRaise ("RemoveUnused.labelInfo", Label.layout))
 
       val {get = funcInfo: Func.t -> FuncInfo.t, 
-	   set = setFuncInfo, ...}
-	 = Property.getSetOnce
-	  (Func.plist,
-	   Property.initRaise ("RemoveUnused.funcInfo", Func.layout))
+           set = setFuncInfo, ...}
+         = Property.getSetOnce
+          (Func.plist,
+           Property.initRaise ("RemoveUnused.funcInfo", Func.layout))
 
       val usedVar = VarInfo.used o varInfo
       val useVar = Used.use o usedVar
       fun flowVarInfoTyVarInfoTy ((vi, _), (vi', _))
-	= Used.<= (VarInfo.used vi, VarInfo.used vi')
+        = Used.<= (VarInfo.used vi, VarInfo.used vi')
       fun flowVarInfoTysVarInfoTys (xs, ys)
-	= Vector.foreach2 (xs, ys, flowVarInfoTyVarInfoTy)
+        = Vector.foreach2 (xs, ys, flowVarInfoTyVarInfoTy)
       fun flowVarInfoTyVar ((vi, _), x) 
-	= Used.<= (VarInfo.used vi, usedVar x)
+        = Used.<= (VarInfo.used vi, usedVar x)
       fun flowVarInfoTysVars (xs, ys)
-	= Vector.foreach2 (xs, ys, flowVarInfoTyVar)
+        = Vector.foreach2 (xs, ys, flowVarInfoTyVar)
       val isUsedVar = Used.isUsed o usedVar
 
       val visitLabelInfo = LabelInfo.use
@@ -335,816 +338,816 @@
       fun visitVar (x: Var.t) = useVar x
       fun visitVars (xs: Var.t Vector.t) = Vector.foreach (xs, visitVar)
       fun visitExp (e: Exp.t)
-	= case e 
-	    of ConApp {con, args}
-	     => let
-		  val ci = conInfo con
-		  val _ = ConInfo.con ci
-		  val _ = flowVarInfoTysVars (ConInfo.args ci, args)
-		in
-		  ()
-		end
-	     | PrimApp {prim, targs, args} 
-	     => let
-		  val _ = visitVars args
-		  datatype z = datatype Type.dest
-		  fun decon t
-		    = let
-		        val ti = typeInfo t
-			val deconed = TypeInfo.deconed' ti
-		      in
-			if !deconed
-			  then ()
-			  else (deconed := true;
-				case Type.dest t
-				  of Datatype t
-				   => Vector.foreach
-				      (TyconInfo.cons (tyconInfo t), 
-				       fn {con, ...} => 
-				       let
-					 val ci = conInfo con
-					 val _ = ConInfo.decon ci
-					 val _
-					   = Vector.foreach
-					     (ConInfo.args ci, fn (x, t) => 
-					      (VarInfo.use x; decon t))
-				       in
-					 ()
-				       end)
-				   | Tuple ts => Vector.foreach (ts, decon)
-				   | Vector t => decon t
-				   | _ => ())
-		      end
-		in
-		  case (Prim.name prim, Vector.length targs)
-		    of (Prim.Name.MLton_eq, 1)
-		     (* MLton_eq may be used on datatypes used as enums. *)
-		     => decon (Vector.sub (targs, 0))
-		     | (Prim.Name.MLton_equal, 1)
-		     (* MLton_equal will be expanded by poly-equal into uses
-		      * of constructors as patterns.
-		      *)
-		     => decon (Vector.sub (targs, 0))
-(*		     | (Prim.Name.MLton_size, 1) => decon (Vector.sub (targs, 0)) *)
-		     | _ => ()
-		end
-	     | Select {tuple, ...} => visitVar tuple
-	     | Tuple xs => visitVars xs
-	     | Var x => visitVar x
-	     | _ => ()
+        = case e 
+            of ConApp {con, args}
+             => let
+                  val ci = conInfo con
+                  val _ = ConInfo.con ci
+                  val _ = flowVarInfoTysVars (ConInfo.args ci, args)
+                in
+                  ()
+                end
+             | PrimApp {prim, targs, args} 
+             => let
+                  val _ = visitVars args
+                  datatype z = datatype Type.dest
+                  fun decon t
+                    = let
+                        val ti = typeInfo t
+                        val deconed = TypeInfo.deconed' ti
+                      in
+                        if !deconed
+                          then ()
+                          else (deconed := true;
+                                case Type.dest t
+                                  of Datatype t
+                                   => Vector.foreach
+                                      (TyconInfo.cons (tyconInfo t), 
+                                       fn {con, ...} => 
+                                       let
+                                         val ci = conInfo con
+                                         val _ = ConInfo.decon ci
+                                         val _
+                                           = Vector.foreach
+                                             (ConInfo.args ci, fn (x, t) => 
+                                              (VarInfo.use x; decon t))
+                                       in
+                                         ()
+                                       end)
+                                   | Tuple ts => Vector.foreach (ts, decon)
+                                   | Vector t => decon t
+                                   | _ => ())
+                      end
+                in
+                  case (Prim.name prim, Vector.length targs)
+                    of (Prim.Name.MLton_eq, 1)
+                     (* MLton_eq may be used on datatypes used as enums. *)
+                     => decon (Vector.sub (targs, 0))
+                     | (Prim.Name.MLton_equal, 1)
+                     (* MLton_equal will be expanded by poly-equal into uses
+                      * of constructors as patterns.
+                      *)
+                     => decon (Vector.sub (targs, 0))
+(*                   | (Prim.Name.MLton_size, 1) => decon (Vector.sub (targs, 0)) *)
+                     | _ => ()
+                end
+             | Select {tuple, ...} => visitVar tuple
+             | Tuple xs => visitVars xs
+             | Var x => visitVar x
+             | _ => ()
       val visitExpTh = fn e => fn () => visitExp e
       fun maybeVisitVarExp (var, exp)
-	= Option.app (var, fn var => VarInfo.whenUsed (varInfo var, visitExpTh exp))
+        = Option.app (var, fn var => VarInfo.whenUsed (varInfo var, visitExpTh exp))
       fun visitStatement (Statement.T {exp, var, ...}, fi: FuncInfo.t)
-	= if Exp.maySideEffect exp
-	    then (FuncInfo.sideEffect fi
-		  ; visitExp exp)
-	    else maybeVisitVarExp (var, exp)
+        = if Exp.maySideEffect exp
+            then (FuncInfo.sideEffect fi
+                  ; visitExp exp)
+            else maybeVisitVarExp (var, exp)
       fun visitTransfer (t: Transfer.t, fi: FuncInfo.t)
-	= case t
-	    of Arith {args, overflow, success, ...} 
-	     => (FuncInfo.sideEffect fi;
-		 visitVars args;
-		 visitLabel overflow;
-		 visitLabel success)
-	     | Bug => ()
-	     | Call {func, args, return}
-	     => let
-		  datatype u = None
-		             | Caller
-		             | Some of Label.t
-		  val (cont, handler)
-		    = case return
-			of Return.Dead => (None, None)
-			 | Return.NonTail {cont, handler}
-			 => (Some cont,
-			     case handler of
-				Handler.Caller => Caller
-			      | Handler.Dead => None
-			      | Handler.Handle h => Some h)
-		         | Return.Tail => (Caller, Caller)
-		  val fi' = funcInfo func
-		in
-		  flowVarInfoTysVars (FuncInfo.args fi', args);
-		  FuncInfo.flowSideEffects (fi', fi);
-		  case cont
-		    of None => ()
-		     | Caller 
-		     => (case (FuncInfo.returns fi, FuncInfo.returns fi')
-			   of (SOME xts, SOME xts')
-			    => flowVarInfoTysVarInfoTys (xts, xts')
-			    | _ => ();
-			 FuncInfo.flowReturns (fi', fi))
-		     | Some l
-		     => let
-			  val li = labelInfo l
-			in
-			  Option.app
-			  (FuncInfo.returns fi', fn xts =>
-			   flowVarInfoTysVarInfoTys
-			   (LabelInfo.args li, xts));
-			  FuncInfo.whenReturns (fi', visitLabelInfoTh li)
-			end;
-		  case handler
-		    of None => ()
-		     | Caller 
-		     => (case (FuncInfo.raises fi, FuncInfo.raises fi')
-			   of (SOME xts, SOME xts')
-			    => flowVarInfoTysVarInfoTys (xts, xts')
-			    | _ => ();
-			 FuncInfo.flowRaises (fi', fi))
-		     | Some l
-		     => let
-			  val li = labelInfo l
-			in
-			  Option.app
-			  (FuncInfo.raises fi', fn xts =>
-			   flowVarInfoTysVarInfoTys
-			   (LabelInfo.args li, xts));
-			  FuncInfo.whenRaises (fi', visitLabelInfoTh li)
-			end;
-		  visitFuncInfo fi'
-		end
-	     | Case {test, cases, default}
-	     => let
-		  val _ = visitVar test
-		in
-		  case cases of
-		     Cases.Word (_, cs) =>
-			(Vector.foreach (cs, visitLabel o #2)
-			 ; Option.app (default, visitLabel))
-		   | Cases.Con cases
-		     => if Vector.length cases = 0
-			  then Option.app (default, visitLabel)
-			  else let
-				 val _
-				   = Vector.foreach
-				     (cases, fn (con, l) =>
-				      let
-					val ci = conInfo con
-					val _ = ConInfo.decon ci
-					val li = labelInfo l
-					val _
-					  = flowVarInfoTysVarInfoTys
-					    (LabelInfo.args li, ConInfo.args ci)
-					val _ 
-					  = ConInfo.whenConed
-					    (ci, fn () => visitLabelInfo li)
-				      in
-					()
-				      end)
-				 val cons 
-				   = TyconInfo.cons
-				     (tyconInfo
-				      (ConInfo.tycon 
-				       (conInfo (#1 (Vector.sub (cases, 0))))))
-			       in
-				 case default
-				   of NONE => ()
-				    | SOME l
-				    => let
-					 val li = labelInfo l
-				       in
-					 Vector.foreach
-					 (cons, fn {con, ...} =>
-					  if Vector.exists
-					      (cases, fn (c, _) => 
-					       Con.equals(c, con))
-					    then ()
-					    else ConInfo.whenConed
-					         (conInfo con, fn () => 
-						  visitLabelInfo li))
-				       end
-			       end
-		end
-	     | Goto {dst, args} =>
-		  let
-		     val li = labelInfo dst
-		     val _ = flowVarInfoTysVars (LabelInfo.args li, args)
-		     val _ = visitLabelInfo li
-		  in
-		     ()
-		  end
-	     | Raise xs 
-	     => (FuncInfo.raisee fi;
-		 flowVarInfoTysVars (valOf (FuncInfo.raises fi), xs))
-	     | Return xs 
-	     => (FuncInfo.return fi;
-		 flowVarInfoTysVars (valOf (FuncInfo.returns fi), xs))
-	     | Runtime {args, return, ...} 
-	     => (FuncInfo.sideEffect fi;
-		 visitVars args;
-		 visitLabel return)
+        = case t
+            of Arith {args, overflow, success, ...} 
+             => (FuncInfo.sideEffect fi;
+                 visitVars args;
+                 visitLabel overflow;
+                 visitLabel success)
+             | Bug => ()
+             | Call {func, args, return}
+             => let
+                  datatype u = None
+                             | Caller
+                             | Some of Label.t
+                  val (cont, handler)
+                    = case return
+                        of Return.Dead => (None, None)
+                         | Return.NonTail {cont, handler}
+                         => (Some cont,
+                             case handler of
+                                Handler.Caller => Caller
+                              | Handler.Dead => None
+                              | Handler.Handle h => Some h)
+                         | Return.Tail => (Caller, Caller)
+                  val fi' = funcInfo func
+                in
+                  flowVarInfoTysVars (FuncInfo.args fi', args);
+                  FuncInfo.flowSideEffects (fi', fi);
+                  case cont
+                    of None => ()
+                     | Caller 
+                     => (case (FuncInfo.returns fi, FuncInfo.returns fi')
+                           of (SOME xts, SOME xts')
+                            => flowVarInfoTysVarInfoTys (xts, xts')
+                            | _ => ();
+                         FuncInfo.flowReturns (fi', fi))
+                     | Some l
+                     => let
+                          val li = labelInfo l
+                        in
+                          Option.app
+                          (FuncInfo.returns fi', fn xts =>
+                           flowVarInfoTysVarInfoTys
+                           (LabelInfo.args li, xts));
+                          FuncInfo.whenReturns (fi', visitLabelInfoTh li)
+                        end;
+                  case handler
+                    of None => ()
+                     | Caller 
+                     => (case (FuncInfo.raises fi, FuncInfo.raises fi')
+                           of (SOME xts, SOME xts')
+                            => flowVarInfoTysVarInfoTys (xts, xts')
+                            | _ => ();
+                         FuncInfo.flowRaises (fi', fi))
+                     | Some l
+                     => let
+                          val li = labelInfo l
+                        in
+                          Option.app
+                          (FuncInfo.raises fi', fn xts =>
+                           flowVarInfoTysVarInfoTys
+                           (LabelInfo.args li, xts));
+                          FuncInfo.whenRaises (fi', visitLabelInfoTh li)
+                        end;
+                  visitFuncInfo fi'
+                end
+             | Case {test, cases, default}
+             => let
+                  val _ = visitVar test
+                in
+                  case cases of
+                     Cases.Word (_, cs) =>
+                        (Vector.foreach (cs, visitLabel o #2)
+                         ; Option.app (default, visitLabel))
+                   | Cases.Con cases
+                     => if Vector.length cases = 0
+                          then Option.app (default, visitLabel)
+                          else let
+                                 val _
+                                   = Vector.foreach
+                                     (cases, fn (con, l) =>
+                                      let
+                                        val ci = conInfo con
+                                        val _ = ConInfo.decon ci
+                                        val li = labelInfo l
+                                        val _
+                                          = flowVarInfoTysVarInfoTys
+                                            (LabelInfo.args li, ConInfo.args ci)
+                                        val _ 
+                                          = ConInfo.whenConed
+                                            (ci, fn () => visitLabelInfo li)
+                                      in
+                                        ()
+                                      end)
+                                 val cons 
+                                   = TyconInfo.cons
+                                     (tyconInfo
+                                      (ConInfo.tycon 
+                                       (conInfo (#1 (Vector.sub (cases, 0))))))
+                               in
+                                 case default
+                                   of NONE => ()
+                                    | SOME l
+                                    => let
+                                         val li = labelInfo l
+                                       in
+                                         Vector.foreach
+                                         (cons, fn {con, ...} =>
+                                          if Vector.exists
+                                              (cases, fn (c, _) => 
+                                               Con.equals(c, con))
+                                            then ()
+                                            else ConInfo.whenConed
+                                                 (conInfo con, fn () => 
+                                                  visitLabelInfo li))
+                                       end
+                               end
+                end
+             | Goto {dst, args} =>
+                  let
+                     val li = labelInfo dst
+                     val _ = flowVarInfoTysVars (LabelInfo.args li, args)
+                     val _ = visitLabelInfo li
+                  in
+                     ()
+                  end
+             | Raise xs 
+             => (FuncInfo.raisee fi;
+                 flowVarInfoTysVars (valOf (FuncInfo.raises fi), xs))
+             | Return xs 
+             => (FuncInfo.return fi;
+                 flowVarInfoTysVars (valOf (FuncInfo.returns fi), xs))
+             | Runtime {args, return, ...} 
+             => (FuncInfo.sideEffect fi;
+                 visitVars args;
+                 visitLabel return)
 
       val visitTransfer
-	= Trace.trace ("RemoveUnused.visitTransfer",
-		       Layout.tuple2 (Transfer.layout, FuncInfo.layout),
-		       Unit.layout)
-	              visitTransfer
+        = Trace.trace ("RemoveUnused.visitTransfer",
+                       Layout.tuple2 (Transfer.layout, FuncInfo.layout),
+                       Unit.layout)
+                      visitTransfer
       fun visitBlock (Block.T {statements, transfer, ...}, fi: FuncInfo.t) =
-	 (Vector.foreach (statements, fn s => visitStatement (s, fi))
-	  ; visitTransfer (transfer, fi))
+         (Vector.foreach (statements, fn s => visitStatement (s, fi))
+          ; visitTransfer (transfer, fi))
       (* Visit all reachable expressions. *)
       val _ = Vector.foreach
-	      (datatypes, fn Datatype.T {tycon, cons} =>
-	       (setTyconInfo (tycon, TyconInfo.new {cons = cons});
-		Vector.foreach (cons, fn {con, args} => 
-				newConInfo (con, args, tycon))))
+              (datatypes, fn Datatype.T {tycon, cons} =>
+               (setTyconInfo (tycon, TyconInfo.new {cons = cons});
+                Vector.foreach (cons, fn {con, args} => 
+                                newConInfo (con, args, tycon))))
       val _ = let
-		fun doit c
-		  = let
-		      val ci = conInfo c
-		      val _ = ConInfo.con ci
-		      val _ = ConInfo.decon ci
-		    in
-		      ()
-		    end
-	      in
-		doit Con.truee ; doit Con.falsee 
-	      end
+                fun doit c
+                  = let
+                      val ci = conInfo c
+                      val _ = ConInfo.con ci
+                      val _ = ConInfo.decon ci
+                    in
+                      ()
+                    end
+              in
+                doit Con.truee ; doit Con.falsee 
+              end
       val _ = Vector.foreach 
-	      (globals, fn Statement.T {var, exp, ...} => 
-	       maybeVisitVarExp (var, exp))
+              (globals, fn Statement.T {var, exp, ...} => 
+               maybeVisitVarExp (var, exp))
       val _ = List.foreach
-	      (functions, fn function =>
-	       let
-		 val {name, args, raises, returns, start, blocks, ...}
-		   = Function.dest function
-		 local
-		   fun doitVarTys vts
-		     = Vector.map (vts, fn (x, t) => (varInfo x, t))
-		   fun doitTys ts
-		     = Vector.map (ts, fn t => (VarInfo.new (), t))
-		   fun doitTys' ts
-		     = Option.map (ts, doitTys)
-		 in
-		   val fi = FuncInfo.new
-		            {args = doitVarTys args,
-			     raises = doitTys' raises,
-			     returns = doitTys' returns}
-		 end
-		 val _ = setFuncInfo (name, fi)
-		 val _ = FuncInfo.whenUsed 
-		         (fi, visitLabelTh start)
-		 val _
-		   = Vector.foreach
-		     (blocks, fn block as Block.T {label, args, ...} => 
-		      let
-			local
-			  fun doitVarTys vts
-			    = Vector.map (vts, fn (x, t) => (varInfo x, t))
-			in
-			  val li
-			    = LabelInfo.new 
-			      {args = doitVarTys args,
-			       func = fi}
-			end
-			val _ = setLabelInfo (label, li)
-			val _ = LabelInfo.whenUsed 
-			        (li, fn () => visitBlock (block, fi))
-		      in
-			()
-		      end)
-	       in
-		 ()
-	       end)
+              (functions, fn function =>
+               let
+                 val {name, args, raises, returns, start, blocks, ...}
+                   = Function.dest function
+                 local
+                   fun doitVarTys vts
+                     = Vector.map (vts, fn (x, t) => (varInfo x, t))
+                   fun doitTys ts
+                     = Vector.map (ts, fn t => (VarInfo.new (), t))
+                   fun doitTys' ts
+                     = Option.map (ts, doitTys)
+                 in
+                   val fi = FuncInfo.new
+                            {args = doitVarTys args,
+                             raises = doitTys' raises,
+                             returns = doitTys' returns}
+                 end
+                 val _ = setFuncInfo (name, fi)
+                 val _ = FuncInfo.whenUsed 
+                         (fi, visitLabelTh start)
+                 val _
+                   = Vector.foreach
+                     (blocks, fn block as Block.T {label, args, ...} => 
+                      let
+                        local
+                          fun doitVarTys vts
+                            = Vector.map (vts, fn (x, t) => (varInfo x, t))
+                        in
+                          val li
+                            = LabelInfo.new 
+                              {args = doitVarTys args,
+                               func = fi}
+                        end
+                        val _ = setLabelInfo (label, li)
+                        val _ = LabelInfo.whenUsed 
+                                (li, fn () => visitBlock (block, fi))
+                      in
+                        ()
+                      end)
+               in
+                 ()
+               end)
       val _ = visitFunc main
 
       (* Diagnostics *)
       val _ = Control.diagnostics
-	      (fn display =>
-	       let open Layout
-	       in 
-		 Vector.foreach
-		 (datatypes, fn Datatype.T {tycon, cons} =>
-		  display (seq [Tycon.layout tycon,
-				str ": ",
-				Vector.layout
-				(fn {con, ...} =>
-				 seq [Con.layout con,
-				      str " ",
-				      ConInfo.layout (conInfo con)])
-				cons]));
-		 display (str "\n");
-		 List.foreach
-		 (functions, fn f =>
-		  let
-		    val {name, blocks, ...} = Function.dest f
-		  in
-		    display (seq [Func.layout name,
-				  str ": ",
-				  FuncInfo.layout (funcInfo name)]);
-		    Vector.foreach
-		    (blocks, fn Block.T {label, ...} =>
-		     display (seq [Label.layout label,
-				   str ": ",
-				   LabelInfo.layout (labelInfo label)]));
-		    display (str "\n")
-		  end)
-	       end)
+              (fn display =>
+               let open Layout
+               in 
+                 Vector.foreach
+                 (datatypes, fn Datatype.T {tycon, cons} =>
+                  display (seq [Tycon.layout tycon,
+                                str ": ",
+                                Vector.layout
+                                (fn {con, ...} =>
+                                 seq [Con.layout con,
+                                      str " ",
+                                      ConInfo.layout (conInfo con)])
+                                cons]));
+                 display (str "\n");
+                 List.foreach
+                 (functions, fn f =>
+                  let
+                    val {name, blocks, ...} = Function.dest f
+                  in
+                    display (seq [Func.layout name,
+                                  str ": ",
+                                  FuncInfo.layout (funcInfo name)]);
+                    Vector.foreach
+                    (blocks, fn Block.T {label, ...} =>
+                     display (seq [Label.layout label,
+                                   str ": ",
+                                   LabelInfo.layout (labelInfo label)]));
+                    display (str "\n")
+                  end)
+               end)
 
       (* Analysis is done,  Now build the resulting program. *)
       val datatypes
-	= Vector.map
-	  (datatypes, fn Datatype.T {tycon, cons} =>
-	   let
-	     val r: Exp.t option ref = ref NONE
-	     val cons 
-	       = Vector.keepAllMap
-	         (cons, fn {con, ...} =>
-		  let
-		    val c = conInfo con
-		  in
-		    case (ConInfo.isConed c, ConInfo.isDeconed c)
-		      of (false, _) => NONE
-		       | (true, true)
-		       => SOME {con = con,
-				args = Vector.keepAllMap
-				       (ConInfo.args c, fn (x, t) =>
-					if VarInfo.isUsed x
-					  then SOME t
-					  else NONE)}
-		       | (true, false)
-		       => let
-			    val (e, res)
-			      = case !r
-				  of NONE 
-				   => let
-					val c = Con.newString "dummy"
-					val targs = Vector.new0 ()
-					val args = Vector.new0 ()
-					val e = ConApp {con = c,
-							args = args}
-				      in
-					r := SOME e ;
-					newConInfo (c, targs, tycon) ;
-					(e, SOME {con = c, 
-						  args = targs})
-				      end
-				   | SOME e => (e, NONE)
-			    val _ = ConInfo.dummy c := SOME e
-			  in
-			    res
-			  end
-		  end)
-	     val num = Vector.length cons
-	     val _ = TyconInfo.numCons' (tyconInfo tycon) := num
-	     (* If there are no constructors used, we still need to keep around
-	      * the type, which may appear in places.  Do so with a single
-	      * bogus nullary constructor.
-	      *)
-	     val cons =
-		if 0 = num
-		   then Vector.new1 {args = Vector.new0 (),
-				     con = Con.newNoname ()}
-		else cons
-	   in
-	      Datatype.T {tycon = tycon, cons = cons}
-	   end)
+        = Vector.map
+          (datatypes, fn Datatype.T {tycon, cons} =>
+           let
+             val r: Exp.t option ref = ref NONE
+             val cons 
+               = Vector.keepAllMap
+                 (cons, fn {con, ...} =>
+                  let
+                    val c = conInfo con
+                  in
+                    case (ConInfo.isConed c, ConInfo.isDeconed c)
+                      of (false, _) => NONE
+                       | (true, true)
+                       => SOME {con = con,
+                                args = Vector.keepAllMap
+                                       (ConInfo.args c, fn (x, t) =>
+                                        if VarInfo.isUsed x
+                                          then SOME t
+                                          else NONE)}
+                       | (true, false)
+                       => let
+                            val (e, res)
+                              = case !r
+                                  of NONE 
+                                   => let
+                                        val c = Con.newString "dummy"
+                                        val targs = Vector.new0 ()
+                                        val args = Vector.new0 ()
+                                        val e = ConApp {con = c,
+                                                        args = args}
+                                      in
+                                        r := SOME e ;
+                                        newConInfo (c, targs, tycon) ;
+                                        (e, SOME {con = c, 
+                                                  args = targs})
+                                      end
+                                   | SOME e => (e, NONE)
+                            val _ = ConInfo.dummy c := SOME e
+                          in
+                            res
+                          end
+                  end)
+             val num = Vector.length cons
+             val _ = TyconInfo.numCons' (tyconInfo tycon) := num
+             (* If there are no constructors used, we still need to keep around
+              * the type, which may appear in places.  Do so with a single
+              * bogus nullary constructor.
+              *)
+             val cons =
+                if 0 = num
+                   then Vector.new1 {args = Vector.new0 (),
+                                     con = Con.newNoname ()}
+                else cons
+           in
+              Datatype.T {tycon = tycon, cons = cons}
+           end)
 
       fun getWrapperLabel (l: Label.t,
-			   args: (VarInfo.t * Type.t) vector)
-	= let
-	    val li = labelInfo l
-	  in
-	    if Vector.forall2 (args, LabelInfo.args li, fn ((x, _), (y, _)) =>
-			       VarInfo.isUsed x = VarInfo.isUsed y)
-	      then l
-	      else let
-		     val tys
-		       = Vector.keepAllMap (args, fn (x, ty) =>
-					    if VarInfo.isUsed x
-					      then SOME ty
-					      else NONE)
-		   in 
-		     case List.peek 
-		          (LabelInfo.wrappers li, fn (args', _) =>
-			   Vector.length args' = Vector.length tys
-			   andalso
-			   Vector.forall2 (args', tys, fn (ty', ty) =>
-					   Type.equals (ty', ty)))
-		       of SOME (_, l') => l'
-			| NONE
-			=> let
-			     val l' = Label.newNoname ()
-			     val (args', args'')
-			       = Vector.unzip
-			         (Vector.map2
-				  (args, LabelInfo.args li, fn ((x, ty), (y, _)) =>
-				   let
-				     val z = Var.newNoname ()
-				   in
-				     (if VarInfo.isUsed x then SOME (z, ty) else NONE,
-				      if VarInfo.isUsed y then SOME z else NONE)
-				   end))
-			     val args' = Vector.keepAllMap (args', fn x => x)
-			     val (_, tys') = Vector.unzip args'
-			     val args'' = Vector.keepAllMap (args'', fn x => x)
-			     val block = Block.T {label = l',
-						  args =  args',
-						  statements = Vector.new0 (),
-						  transfer = Goto {dst = l,
-								   args = args''}}
-			     val _ = List.push (LabelInfo.wrappers' li, (tys', l'))
-			     val _ = List.push (FuncInfo.wrappers' (LabelInfo.func li),
-						block)
-			   in
-			     l'
-			   end
-		   end
-	  end
+                           args: (VarInfo.t * Type.t) vector)
+        = let
+            val li = labelInfo l
+          in
+            if Vector.forall2 (args, LabelInfo.args li, fn ((x, _), (y, _)) =>
+                               VarInfo.isUsed x = VarInfo.isUsed y)
+              then l
+              else let
+                     val tys
+                       = Vector.keepAllMap (args, fn (x, ty) =>
+                                            if VarInfo.isUsed x
+                                              then SOME ty
+                                              else NONE)
+                   in 
+                     case List.peek 
+                          (LabelInfo.wrappers li, fn (args', _) =>
+                           Vector.length args' = Vector.length tys
+                           andalso
+                           Vector.forall2 (args', tys, fn (ty', ty) =>
+                                           Type.equals (ty', ty)))
+                       of SOME (_, l') => l'
+                        | NONE
+                        => let
+                             val l' = Label.newNoname ()
+                             val (args', args'')
+                               = Vector.unzip
+                                 (Vector.map2
+                                  (args, LabelInfo.args li, fn ((x, ty), (y, _)) =>
+                                   let
+                                     val z = Var.newNoname ()
+                                   in
+                                     (if VarInfo.isUsed x then SOME (z, ty) else NONE,
+                                      if VarInfo.isUsed y then SOME z else NONE)
+                                   end))
+                             val args' = Vector.keepAllMap (args', fn x => x)
+                             val (_, tys') = Vector.unzip args'
+                             val args'' = Vector.keepAllMap (args'', fn x => x)
+                             val block = Block.T {label = l',
+                                                  args =  args',
+                                                  statements = Vector.new0 (),
+                                                  transfer = Goto {dst = l,
+                                                                   args = args''}}
+                             val _ = List.push (LabelInfo.wrappers' li, (tys', l'))
+                             val _ = List.push (FuncInfo.wrappers' (LabelInfo.func li),
+                                                block)
+                           in
+                             l'
+                           end
+                   end
+          end
       val getConWrapperLabel = getWrapperLabel
       val getContWrapperLabel = getWrapperLabel
       val getHandlerWrapperLabel = getWrapperLabel
       fun getOriginalWrapperLabel l 
-	= getWrapperLabel 
-	  (l, Vector.map (LabelInfo.args (labelInfo l), fn (_, t) =>
-			  let 
-			    val x = VarInfo.new ()
-			    val _ = VarInfo.use x
-			  in
-			    (x, t)
-			  end))
+        = getWrapperLabel 
+          (l, Vector.map (LabelInfo.args (labelInfo l), fn (_, t) =>
+                          let 
+                            val x = VarInfo.new ()
+                            val _ = VarInfo.use x
+                          in
+                            (x, t)
+                          end))
       val getArithOverflowWrapperLabel = getOriginalWrapperLabel
       val getArithSuccessWrapperLabel = getOriginalWrapperLabel
       val getRuntimeWrapperLabel = getOriginalWrapperLabel
       fun getBugFunc (fi: FuncInfo.t): Label.t =
-	 (* Can't share the Bug block across different places because the
-	  * profile sourceInfo stack might be different.
-	  *)
-	 let
-	    val l = Label.newNoname ()
-	    val block = Block.T {label = l,
-				 args = Vector.new0 (),
-				 statements = Vector.new0 (),
-				 transfer = Bug}
-	    val _ = List.push (FuncInfo.wrappers' fi, block)
-	 in
-	    l
-	 end
+         (* Can't share the Bug block across different places because the
+          * profile sourceInfo stack might be different.
+          *)
+         let
+            val l = Label.newNoname ()
+            val block = Block.T {label = l,
+                                 args = Vector.new0 (),
+                                 statements = Vector.new0 (),
+                                 transfer = Bug}
+            val _ = List.push (FuncInfo.wrappers' fi, block)
+         in
+            l
+         end
       fun getReturnFunc (fi: FuncInfo.t): Label.t 
-	= let
-	    val r = FuncInfo.returnLabel fi
-	  in
-	    case !r
-	      of SOME l => l
-	       | NONE 
-	       => let
-		    val l = Label.newNoname ()
-		    val returns = valOf (FuncInfo.returns fi)
-		    val args
-		      = Vector.keepAllMap
-		        (returns, fn (vi, ty) =>
-			 if VarInfo.isUsed vi
-			   then SOME (Var.newNoname (), ty)
-			   else NONE)
-		    val xs = Vector.map (args, #1)
-		    val block = Block.T {label = l,
-					 args = args,
-					 statements = Vector.new0 (),
-					 transfer = Return xs}
-		    val _ = r := SOME l
-		    val _ = List.push (FuncInfo.wrappers' fi, block)
-		    val _ = setLabelInfo (l, LabelInfo.new {func = fi,
-							    args = returns})
-		  in
-		    l
-		  end
-	  end
+        = let
+            val r = FuncInfo.returnLabel fi
+          in
+            case !r
+              of SOME l => l
+               | NONE 
+               => let
+                    val l = Label.newNoname ()
+                    val returns = valOf (FuncInfo.returns fi)
+                    val args
+                      = Vector.keepAllMap
+                        (returns, fn (vi, ty) =>
+                         if VarInfo.isUsed vi
+                           then SOME (Var.newNoname (), ty)
+                           else NONE)
+                    val xs = Vector.map (args, #1)
+                    val block = Block.T {label = l,
+                                         args = args,
+                                         statements = Vector.new0 (),
+                                         transfer = Return xs}
+                    val _ = r := SOME l
+                    val _ = List.push (FuncInfo.wrappers' fi, block)
+                    val _ = setLabelInfo (l, LabelInfo.new {func = fi,
+                                                            args = returns})
+                  in
+                    l
+                  end
+          end
       fun getReturnContFunc (fi, args) = getWrapperLabel (getReturnFunc fi, args)
       fun getRaiseFunc (fi: FuncInfo.t): Label.t
-	= let
-	    val r = FuncInfo.raiseLabel fi
-	  in
-	    case !r 
-	      of SOME l => l
-	       | NONE 
-	       => let
-		    val l = Label.newNoname ()
-		    val raises = valOf (FuncInfo.raises fi)
-		    val args
-		      = Vector.keepAllMap
-		        (raises, fn (vi, ty) =>
-			 if VarInfo.isUsed vi
-			   then SOME (Var.newNoname (), ty)
-			   else NONE)
-		    val xs = Vector.map (args, #1)
-		    val block = Block.T {label = l,
-					 args = args,
-					 statements = Vector.new0 (),
-					 transfer = Raise xs}
-		    val _ = r := SOME l
-		    val _ = List.push (FuncInfo.wrappers' fi, block)
-		    val _ = setLabelInfo (l, LabelInfo.new {func = fi,
-							    args = raises})
-		  in
-		    l
-		  end
-	  end
+        = let
+            val r = FuncInfo.raiseLabel fi
+          in
+            case !r 
+              of SOME l => l
+               | NONE 
+               => let
+                    val l = Label.newNoname ()
+                    val raises = valOf (FuncInfo.raises fi)
+                    val args
+                      = Vector.keepAllMap
+                        (raises, fn (vi, ty) =>
+                         if VarInfo.isUsed vi
+                           then SOME (Var.newNoname (), ty)
+                           else NONE)
+                    val xs = Vector.map (args, #1)
+                    val block = Block.T {label = l,
+                                         args = args,
+                                         statements = Vector.new0 (),
+                                         transfer = Raise xs}
+                    val _ = r := SOME l
+                    val _ = List.push (FuncInfo.wrappers' fi, block)
+                    val _ = setLabelInfo (l, LabelInfo.new {func = fi,
+                                                            args = raises})
+                  in
+                    l
+                  end
+          end
       fun getRaiseHandlerFunc (fi, args) = getWrapperLabel (getRaiseFunc fi, args)
 
       fun simplifyExp (e: Exp.t): Exp.t
-	= case e 
-	    of ConApp {con, args}
-	     => let
-		  val c = conInfo con
-		in
-		  if ConInfo.isDeconed c
-		    then ConApp {con = con,
-				 args = (Vector.keepAllMap2
-					 (args, ConInfo.args c,
-					  fn (x, (y, _)) =>
-					  if VarInfo.isUsed y
-					    then SOME x
-					    else NONE))}
-		    else valOf (! (ConInfo.dummy c))
-		end
-	     | _ => e
+        = case e 
+            of ConApp {con, args}
+             => let
+                  val c = conInfo con
+                in
+                  if ConInfo.isDeconed c
+                    then ConApp {con = con,
+                                 args = (Vector.keepAllMap2
+                                         (args, ConInfo.args c,
+                                          fn (x, (y, _)) =>
+                                          if VarInfo.isUsed y
+                                            then SOME x
+                                            else NONE))}
+                    else valOf (! (ConInfo.dummy c))
+                end
+             | _ => e
       val simplifyExp 
-	= Trace.trace ("RemoveUnused.simplifyExp", 
-		       Exp.layout, 
-		       Exp.layout)
-	              simplifyExp
+        = Trace.trace ("RemoveUnused.simplifyExp", 
+                       Exp.layout, 
+                       Exp.layout)
+                      simplifyExp
       fun simplifyStatement (s as Statement.T {var, ty, exp})
-	 : Statement.t option 
-	= case exp 
-	    of Profile _ => SOME s
-	     | _ => let
-		      fun doit' var
-			= SOME (Statement.T {var = var,
-					     ty = ty,
-					     exp = simplifyExp exp})
-		      fun doit var'
-			= if Exp.maySideEffect exp
-			    then doit' var
-			    else if isSome var'
-				   then doit' var'
-				   else NONE
-		    in
-		      case var
-			of SOME var => if isUsedVar var
-					 then doit (SOME var)
-					 else doit NONE
-			 | NONE => doit NONE
-		    end
+         : Statement.t option 
+        = case exp 
+            of Profile _ => SOME s
+             | _ => let
+                      fun doit' var
+                        = SOME (Statement.T {var = var,
+                                             ty = ty,
+                                             exp = simplifyExp exp})
+                      fun doit var'
+                        = if Exp.maySideEffect exp
+                            then doit' var
+                            else if isSome var'
+                                   then doit' var'
+                                   else NONE
+                    in
+                      case var
+                        of SOME var => if isUsedVar var
+                                         then doit (SOME var)
+                                         else doit NONE
+                         | NONE => doit NONE
+                    end
       fun simplifyStatements (ss: Statement.t Vector.t) : Statement.t Vector.t
-	= Vector.keepAllMap (ss, simplifyStatement)
+        = Vector.keepAllMap (ss, simplifyStatement)
       fun simplifyTransfer (t: Transfer.t, fi: FuncInfo.t): Transfer.t
-	= case t
-	    of Arith {prim, args, overflow, success, ty} 
-	     => Arith {prim = prim,
-		       args = args,
-		       overflow = getArithOverflowWrapperLabel overflow,
-		       success = getArithSuccessWrapperLabel success,
-		       ty = ty}
-	     | Bug => Bug
-	     | Call {func, args, return}
-	     => let
-		  val fi' = funcInfo func
-		  datatype u = None
-		             | Caller
-		             | Some of Label.t
-		  val (cont, handler)
-		    = case return
-			of Return.Dead => (None, None)
-			 | Return.NonTail {cont, handler}
-			 => (Some cont,
-			     case handler of
-				Handler.Caller => Caller
-			      | Handler.Dead => None
-			      | Handler.Handle h => Some h)
-		         | Return.Tail => (Caller, Caller)
-		  val cont 
-		    = if FuncInfo.mayReturn fi'
-			then case cont 
-			       of None => Error.bug "cont:None"
-				| Caller
-				=> if (case (FuncInfo.returns fi,
-					     FuncInfo.returns fi')
-					 of (SOME xts, SOME yts)
-					  => Vector.forall2
-					     (xts, yts, fn ((x, _), (y, _)) =>
-					      VarInfo.isUsed x = VarInfo.isUsed y)
-					  | _ => Error.bug "cont:Caller")
-				     then Caller
-				     else Some (getReturnContFunc
-						(fi, valOf (FuncInfo.returns fi')))
-				| Some l
-			        => Some (getContWrapperLabel
-					 (l, valOf (FuncInfo.returns fi')))
-			else None
+        = case t
+            of Arith {prim, args, overflow, success, ty} 
+             => Arith {prim = prim,
+                       args = args,
+                       overflow = getArithOverflowWrapperLabel overflow,
+                       success = getArithSuccessWrapperLabel success,
+                       ty = ty}
+             | Bug => Bug
+             | Call {func, args, return}
+             => let
+                  val fi' = funcInfo func
+                  datatype u = None
+                             | Caller
+                             | Some of Label.t
+                  val (cont, handler)
+                    = case return
+                        of Return.Dead => (None, None)
+                         | Return.NonTail {cont, handler}
+                         => (Some cont,
+                             case handler of
+                                Handler.Caller => Caller
+                              | Handler.Dead => None
+                              | Handler.Handle h => Some h)
+                         | Return.Tail => (Caller, Caller)
+                  val cont 
+                    = if FuncInfo.mayReturn fi'
+                        then case cont 
+                               of None => Error.bug "RemoveUnused.simplifyTransfer: cont:None"
+                                | Caller
+                                => if (case (FuncInfo.returns fi,
+                                             FuncInfo.returns fi')
+                                         of (SOME xts, SOME yts)
+                                          => Vector.forall2
+                                             (xts, yts, fn ((x, _), (y, _)) =>
+                                              VarInfo.isUsed x = VarInfo.isUsed y)
+                                          | _ => Error.bug "RemoveUnused.simplifyTransfer: cont:Caller")
+                                     then Caller
+                                     else Some (getReturnContFunc
+                                                (fi, valOf (FuncInfo.returns fi')))
+                                | Some l
+                                => Some (getContWrapperLabel
+                                         (l, valOf (FuncInfo.returns fi')))
+                        else None
 
-		  val handler
-		    = if FuncInfo.mayRaise fi'
-			then case handler
-			       of None => Error.bug "handler:None"
-				| Caller
-				=> if (case (FuncInfo.raises fi,
-					     FuncInfo.raises fi')
-					 of (SOME xts, SOME yts)
-					  => Vector.forall2
-					     (xts, yts, fn ((x, _), (y, _)) =>
-					      VarInfo.isUsed x = VarInfo.isUsed y)
-					  | _ => Error.bug "handler:Caller")
-				     then Caller
-				     else Some (getRaiseHandlerFunc
-						(fi, valOf (FuncInfo.raises fi')))
-				| Some l
-			        => Some (getHandlerWrapperLabel
-					 (l, valOf (FuncInfo.raises fi')))
-			else None
+                  val handler
+                    = if FuncInfo.mayRaise fi'
+                        then case handler
+                               of None => Error.bug "RemoveUnused.simplifyTransfer: handler:None"
+                                | Caller
+                                => if (case (FuncInfo.raises fi,
+                                             FuncInfo.raises fi')
+                                         of (SOME xts, SOME yts)
+                                          => Vector.forall2
+                                             (xts, yts, fn ((x, _), (y, _)) =>
+                                              VarInfo.isUsed x = VarInfo.isUsed y)
+                                          | _ => Error.bug "RemoveUnused.simplifyTransfer: handler:Caller")
+                                     then Caller
+                                     else Some (getRaiseHandlerFunc
+                                                (fi, valOf (FuncInfo.raises fi')))
+                                | Some l
+                                => Some (getHandlerWrapperLabel
+                                         (l, valOf (FuncInfo.raises fi')))
+                        else None
 
-		  val return
-		    = case (cont, handler)
-			of (None, None) => Return.Dead
-			 | (None, Caller) => Return.Tail
-			 | (None, Some h)
-			 => Return.NonTail
-			    {cont = getBugFunc fi,
-			     handler = Handler.Handle h}
-			 | (Caller, None) => Return.Tail
-			 | (Caller, Caller) => Return.Tail
-			 | (Caller, Some h)
-			 => Return.NonTail
-			    {cont = getReturnContFunc
-			            (fi, valOf (FuncInfo.returns fi')),
-			     handler = Handler.Handle h}
-			 | (Some c, None)
-			 => Return.NonTail
-			    {cont = c,
-			     handler = Handler.Dead}
-			 | (Some c, Caller)
-			 => Return.NonTail
-			    {cont = c,
-			     handler = Handler.Caller}
-			 | (Some c, Some h)
-			 => Return.NonTail 
-			    {cont = c,
-			     handler = Handler.Handle h}
+                  val return
+                    = case (cont, handler)
+                        of (None, None) => Return.Dead
+                         | (None, Caller) => Return.Tail
+                         | (None, Some h)
+                         => Return.NonTail
+                            {cont = getBugFunc fi,
+                             handler = Handler.Handle h}
+                         | (Caller, None) => Return.Tail
+                         | (Caller, Caller) => Return.Tail
+                         | (Caller, Some h)
+                         => Return.NonTail
+                            {cont = getReturnContFunc
+                                    (fi, valOf (FuncInfo.returns fi')),
+                             handler = Handler.Handle h}
+                         | (Some c, None)
+                         => Return.NonTail
+                            {cont = c,
+                             handler = Handler.Dead}
+                         | (Some c, Caller)
+                         => Return.NonTail
+                            {cont = c,
+                             handler = Handler.Caller}
+                         | (Some c, Some h)
+                         => Return.NonTail 
+                            {cont = c,
+                             handler = Handler.Handle h}
 
-		  val args
-		    = Vector.keepAllMap2
-		      (args, FuncInfo.args fi', fn (x, (y, _)) =>
-		       if VarInfo.isUsed y
-			 then SOME x
-			 else NONE)
-		in 
-		  Call {func = func,
-			args = args,
-			return = return}
-		end 
-	     | Case {test, cases = Cases.Con cases, default}
-	     => let
-		  val cases
-		    = Vector.keepAllMap
-		      (cases, fn (con, l) =>
-		       let
-			 val ci = conInfo con
-		       in
-			 if ConInfo.isConed ci
-			   then SOME (con, getConWrapperLabel (l, ConInfo.args ci))
-			   else NONE
-		       end)
-		  fun keep default = Case {test = test,
-					   cases = Cases.Con cases,
-					   default = default}
-		  fun none () = keep NONE
-		in
-		  case default
-		    of NONE => none ()
-		     | SOME l => if Vector.length cases = 0
-				   then if LabelInfo.isUsed (labelInfo l)
-					  then Goto {dst = l, args = Vector.new0 ()}
-					  else Bug
-				   else let
-					  val numCons
-					    = TyconInfo.numCons
-					      (tyconInfo
-					       (ConInfo.tycon
-						(conInfo
-						 (#1 (Vector.sub (cases, 0))))))
-					in 
-					  if Vector.length cases = numCons
-					    then none ()
-					    else keep (SOME l)
-					end
-		end
-	     | Case {test, cases, default}
-	     => Case {test = test,
-		      cases = cases,
-		      default = default}
-	     | Goto {dst, args}
-	     => Goto {dst = dst, 
-		      args = (Vector.keepAllMap2
-			      (args, LabelInfo.args (labelInfo dst),
-			       fn (x, (y, _)) => if VarInfo.isUsed y
-						   then SOME x
-						   else NONE))}
-	     | Raise xs
-	     => Raise (Vector.keepAllMap2
-		       (xs, valOf (FuncInfo.raises fi),
-			fn (x, (y, _)) => if VarInfo.isUsed y
-					    then SOME x
-					    else NONE))
-	     | Return xs 
-	     => Return (Vector.keepAllMap2
-			(xs, valOf (FuncInfo.returns fi),
-			 fn (x, (y, _)) => if VarInfo.isUsed y
-					     then SOME x
-					     else NONE))
-	     | Runtime {prim, args, return}
-	     => Runtime {prim = prim,
-			 args = args,
-			 return = getRuntimeWrapperLabel return}
+                  val args
+                    = Vector.keepAllMap2
+                      (args, FuncInfo.args fi', fn (x, (y, _)) =>
+                       if VarInfo.isUsed y
+                         then SOME x
+                         else NONE)
+                in 
+                  Call {func = func,
+                        args = args,
+                        return = return}
+                end 
+             | Case {test, cases = Cases.Con cases, default}
+             => let
+                  val cases
+                    = Vector.keepAllMap
+                      (cases, fn (con, l) =>
+                       let
+                         val ci = conInfo con
+                       in
+                         if ConInfo.isConed ci
+                           then SOME (con, getConWrapperLabel (l, ConInfo.args ci))
+                           else NONE
+                       end)
+                  fun keep default = Case {test = test,
+                                           cases = Cases.Con cases,
+                                           default = default}
+                  fun none () = keep NONE
+                in
+                  case default
+                    of NONE => none ()
+                     | SOME l => if Vector.length cases = 0
+                                   then if LabelInfo.isUsed (labelInfo l)
+                                          then Goto {dst = l, args = Vector.new0 ()}
+                                          else Bug
+                                   else let
+                                          val numCons
+                                            = TyconInfo.numCons
+                                              (tyconInfo
+                                               (ConInfo.tycon
+                                                (conInfo
+                                                 (#1 (Vector.sub (cases, 0))))))
+                                        in 
+                                          if Vector.length cases = numCons
+                                            then none ()
+                                            else keep (SOME l)
+                                        end
+                end
+             | Case {test, cases, default}
+             => Case {test = test,
+                      cases = cases,
+                      default = default}
+             | Goto {dst, args}
+             => Goto {dst = dst, 
+                      args = (Vector.keepAllMap2
+                              (args, LabelInfo.args (labelInfo dst),
+                               fn (x, (y, _)) => if VarInfo.isUsed y
+                                                   then SOME x
+                                                   else NONE))}
+             | Raise xs
+             => Raise (Vector.keepAllMap2
+                       (xs, valOf (FuncInfo.raises fi),
+                        fn (x, (y, _)) => if VarInfo.isUsed y
+                                            then SOME x
+                                            else NONE))
+             | Return xs 
+             => Return (Vector.keepAllMap2
+                        (xs, valOf (FuncInfo.returns fi),
+                         fn (x, (y, _)) => if VarInfo.isUsed y
+                                             then SOME x
+                                             else NONE))
+             | Runtime {prim, args, return}
+             => Runtime {prim = prim,
+                         args = args,
+                         return = getRuntimeWrapperLabel return}
       val simplifyTransfer
-	= Trace.trace ("RemoveUnused.simplifyTransfer",
-		       Layout.tuple2 (Transfer.layout, FuncInfo.layout),
-		       Transfer.layout)
-	              simplifyTransfer
+        = Trace.trace ("RemoveUnused.simplifyTransfer",
+                       Layout.tuple2 (Transfer.layout, FuncInfo.layout),
+                       Transfer.layout)
+                      simplifyTransfer
       fun simplifyBlock (Block.T {label, args, 
-				  statements, transfer}): Block.t option
-	= let
-	    val li = labelInfo label
-	  in 
-	    if LabelInfo.isUsed li
-	      then let
-		     val args
-		       = Vector.keepAllMap2
-		         (LabelInfo.args li, args, fn ((vi, _), (x, ty)) =>
-			  if VarInfo.isUsed vi
-			    then SOME (x, ty)
-			    else NONE)
-		     val statements = simplifyStatements statements
-		     val transfer
-			= simplifyTransfer (transfer, LabelInfo.func li)
-		   in
-		     SOME (Block.T {label = label,
-				    args = args,
-				    statements = statements,
-				    transfer = transfer})
-		   end
-	      else NONE
-	  end
+                                  statements, transfer}): Block.t option
+        = let
+            val li = labelInfo label
+          in 
+            if LabelInfo.isUsed li
+              then let
+                     val args
+                       = Vector.keepAllMap2
+                         (LabelInfo.args li, args, fn ((vi, _), (x, ty)) =>
+                          if VarInfo.isUsed vi
+                            then SOME (x, ty)
+                            else NONE)
+                     val statements = simplifyStatements statements
+                     val transfer
+                        = simplifyTransfer (transfer, LabelInfo.func li)
+                   in
+                     SOME (Block.T {label = label,
+                                    args = args,
+                                    statements = statements,
+                                    transfer = transfer})
+                   end
+              else NONE
+          end
       fun simplifyBlocks (bs: Block.t Vector.t): Block.t Vector.t
-	= Vector.keepAllMap (bs, simplifyBlock)
+        = Vector.keepAllMap (bs, simplifyBlock)
       val globals = simplifyStatements globals
       val shrink = shrinkFunction {globals = globals}
       fun simplifyFunction (f: Function.t): Function.t option
-	= let
-	    val {args, blocks, mayInline, name, start, ...} = Function.dest f
-	    val fi = funcInfo name
-	  in
-	    if FuncInfo.isUsed fi
-	      then let
-		     val args
-		       = Vector.keepAllMap2
-		         (FuncInfo.args fi, args, fn ((vi, _), (x, t)) =>
-			  if VarInfo.isUsed vi
-			    then SOME (x, t)
-			    else NONE)
-		     val blocks = simplifyBlocks blocks
-		     val wrappers = Vector.fromList (FuncInfo.wrappers fi)
-		     val blocks = Vector.concat [wrappers, blocks]
-		     val returns 
-		       = case FuncInfo.returns fi
-			   of NONE => NONE
-			    | SOME xts 
-			    => if FuncInfo.mayReturn fi
-				 then SOME (Vector.keepAllMap
-					    (xts, fn (x, t) => 
-					     if VarInfo.isUsed x
-					       then SOME t
-					       else NONE))
-				 else NONE
-		     val raises 
-		       = case FuncInfo.raises fi
-			   of NONE => NONE
-			    | SOME xts 
-			    => if FuncInfo.mayRaise fi
-				 then SOME (Vector.keepAllMap
-					    (xts, fn (x, t) => 
-					     if VarInfo.isUsed x
-					       then SOME t
-					       else NONE))
-				 else NONE
-		   in
-		      SOME (shrink (Function.new {args = args,
-						  blocks = blocks,
-						  mayInline = mayInline,
-						  name = name,
-						  raises = raises,
-						  returns = returns,
-						  start = start}))
-		   end
-	      else NONE
-	  end
+        = let
+            val {args, blocks, mayInline, name, start, ...} = Function.dest f
+            val fi = funcInfo name
+          in
+            if FuncInfo.isUsed fi
+              then let
+                     val args
+                       = Vector.keepAllMap2
+                         (FuncInfo.args fi, args, fn ((vi, _), (x, t)) =>
+                          if VarInfo.isUsed vi
+                            then SOME (x, t)
+                            else NONE)
+                     val blocks = simplifyBlocks blocks
+                     val wrappers = Vector.fromList (FuncInfo.wrappers fi)
+                     val blocks = Vector.concat [wrappers, blocks]
+                     val returns 
+                       = case FuncInfo.returns fi
+                           of NONE => NONE
+                            | SOME xts 
+                            => if FuncInfo.mayReturn fi
+                                 then SOME (Vector.keepAllMap
+                                            (xts, fn (x, t) => 
+                                             if VarInfo.isUsed x
+                                               then SOME t
+                                               else NONE))
+                                 else NONE
+                     val raises 
+                       = case FuncInfo.raises fi
+                           of NONE => NONE
+                            | SOME xts 
+                            => if FuncInfo.mayRaise fi
+                                 then SOME (Vector.keepAllMap
+                                            (xts, fn (x, t) => 
+                                             if VarInfo.isUsed x
+                                               then SOME t
+                                               else NONE))
+                                 else NONE
+                   in
+                      SOME (shrink (Function.new {args = args,
+                                                  blocks = blocks,
+                                                  mayInline = mayInline,
+                                                  name = name,
+                                                  raises = raises,
+                                                  returns = returns,
+                                                  start = start}))
+                   end
+              else NONE
+          end
       fun simplifyFunctions (fs: Function.t List.t): Function.t List.t
-	= List.keepAllMap (fs, simplifyFunction)
+        = List.keepAllMap (fs, simplifyFunction)
       val functions = simplifyFunctions functions
       val program = Program.T {datatypes = datatypes,
-			       globals = globals,
-			       functions = functions,
-			       main = main}
+                               globals = globals,
+                               functions = functions,
+                               main = main}
       val _ = destroy ()
       val _ = Program.clearTop program
     in

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ssa/remove-unused.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ssa/remove-unused.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ssa/remove-unused.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,11 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
-type int = Int.t
+
    
 signature REMOVE_UNUSED_STRUCTS = 
    sig
@@ -18,13 +18,3 @@
       
       val remove: Program.t -> Program.t
    end
-
-
-functor TestRemoveUnused(S: REMOVE_UNUSED) = 
-struct
-
-open S
-
-val _ = Assert.assert("RemoveUnused", fn () => true)
-
-end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ssa/remove-unused2.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ssa/remove-unused2.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ssa/remove-unused2.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 functor RemoveUnused2 (S: REMOVE_UNUSED2_STRUCTS): REMOVE_UNUSED2 = 
 struct
 
@@ -14,7 +15,7 @@
 structure Used =
   struct
      structure L = TwoPointLattice (val bottom = "unused"
-				    val top = "used")
+                                    val top = "used")
      open L
      val use = makeTop
      val isUsed = isTop
@@ -24,7 +25,7 @@
 structure Coned =
   struct
      structure L = TwoPointLattice (val bottom = "not coned"
-				    val top = "coned")
+                                    val top = "coned")
      open L
      val con = makeTop
      val isConed = isTop
@@ -34,7 +35,7 @@
 structure Deconed =
    struct
       structure L = TwoPointLattice (val bottom = "not deconed"
-				     val top = "deconed")
+                                     val top = "deconed")
       open L
       val decon = makeTop
       val isDeconed = isTop
@@ -43,7 +44,7 @@
 structure SideEffects =
    struct
       structure L = TwoPointLattice (val bottom = "does not side effect"
-				     val top = "side effects")
+                                     val top = "side effects")
       open L
       val sideEffect = makeTop
    end
@@ -51,7 +52,7 @@
 structure MayReturn =
    struct
       structure L = TwoPointLattice (val bottom = "does not return"
-				     val top = "may return")
+                                     val top = "may return")
       open L
       val return = makeTop
       val mayReturn = isTop
@@ -61,7 +62,7 @@
 structure MayRaise =
    struct
       structure L = TwoPointLattice (val bottom = "does not raise"
-				     val top = "may raise")
+                                     val top = "may raise")
       open L
       val raisee = makeTop
       val mayRaise = isTop
@@ -72,20 +73,20 @@
 structure VarInfo =
    struct
       datatype t = T of {ty: Type.t, 
-			 used: Used.t}
-	 
+                         used: Used.t}
+         
       fun layout (T {used, ...}) = Used.layout used
-	 
+         
       local
-	 fun make f (T r) = f r
+         fun make f (T r) = f r
       in
-	 val ty = make #ty
-	 val used = make #used
+         val ty = make #ty
+         val used = make #used
       end
    
       fun new (ty : Type.t): t = T {ty = ty,
-				    used = Used.new ()}
-	 
+                                    used = Used.new ()}
+         
       val use = Used.use o used
       val isUsed = Used.isUsed o used
       fun whenUsed (vi, th) = Used.whenUsed (used vi, th)
@@ -95,204 +96,199 @@
 structure ConInfo =
    struct
       datatype t = T of {args: (VarInfo.t * Type.t) Prod.t,
-			 coned: Coned.t,
-			 deconed: Deconed.t,
-			 dummy: ({con: Con.t, args: Type.t Prod.t} * Exp.t) option ref,
-			 used: Used.t}
-	 
+                         coned: Coned.t,
+                         deconed: Deconed.t,
+                         dummy: ({con: Con.t, args: Type.t Prod.t} * Exp.t) option ref,
+                         used: Used.t}
+         
       fun layout (T {args, coned, deconed, used, ...}) =
-	 Layout.record [("args", Prod.layout (args, VarInfo.layout o #1)),
-			("coned", Coned.layout coned),
-			("deconed", Deconed.layout deconed),
-			("used", Used.layout used)]
-	 
+         Layout.record [("args", Prod.layout (args, VarInfo.layout o #1)),
+                        ("coned", Coned.layout coned),
+                        ("deconed", Deconed.layout deconed),
+                        ("used", Used.layout used)]
+         
       local
-	 fun make f (T r) = f r
+         fun make f (T r) = f r
       in
-	 val args = make #args
-	 val coned = make #coned
-	 val deconed = make #deconed
-	 val dummy = make #dummy
-	 val used = make #used
+         val args = make #args
+         val coned = make #coned
+         val deconed = make #deconed
+         val dummy = make #dummy
+         val used = make #used
       end
    
       val con = Coned.con o coned
       val isConed = Coned.isConed o coned
       fun whenConed (ci, th) = Coned.whenConed (coned ci, th)
-	 
+         
       val decon = Deconed.decon o deconed
       val isDeconed = Deconed.isDeconed o deconed
-	 
+         
       val use = Used.use o used
-      val isUsed = Used.isUsed o used
       fun whenUsed (vi, th) = Used.whenUsed (used vi, th)
 
       fun new {args: Type.t Prod.t}: t =
-	 T {args = Prod.map (args, fn t => (VarInfo.new t, t)),
-	    coned = Coned.new (),
-	    deconed = Deconed.new (),
-	    dummy = ref NONE,
-	    used = Used.new ()}
+         T {args = Prod.map (args, fn t => (VarInfo.new t, t)),
+            coned = Coned.new (),
+            deconed = Deconed.new (),
+            dummy = ref NONE,
+            used = Used.new ()}
    end
 
 structure TyconInfo =
    struct
       datatype t = T of {cons: Con.t vector,
-			 numCons: int ref,
-			 used: Used.t}
-	 
+                         numCons: int ref,
+                         used: Used.t}
+         
       fun layout (T {used, ...}) =
-	 Layout.record [("used", Used.layout used)]
+         Layout.record [("used", Used.layout used)]
 
       local
-	 fun make f (T r) = f r
-	 fun make' f = (make f, ! o (make f))
+         fun make f (T r) = f r
+         fun make' f = (make f, ! o (make f))
       in
-	 val cons = make #cons
-	 val (numCons', numCons) = make' #numCons
-	 val used = make #used
+         val cons = make #cons
+         val (numCons', numCons) = make' #numCons
+         val used = make #used
       end
    
       fun new {cons: Con.t vector}: t = 
-	 T {cons = cons,
-	    numCons = ref ~1,
-	    used = Used.new ()}
-
-      val use = Used.use o used
-      val isUsed = Used.isUsed o used
-      fun whenUsed (vi, th) = Used.whenUsed (used vi, th)
+         T {cons = cons,
+            numCons = ref ~1,
+            used = Used.new ()}
    end
 
 structure TypeInfo = 
    struct
       datatype t = T of {deconed: bool ref,
-			 simplify: Type.t option ref,
-			 used: bool ref}
-	 
+                         simplify: Type.t option ref,
+                         used: bool ref}
+         
       local
-	 fun make f (T r) = f r
-	 fun make' f = (make f, ! o (make f))
+         fun make f (T r) = f r
+         fun make' f = (make f, ! o (make f))
       in
-	 val (deconed', _) = make' #deconed
-	 val (simplify', simplify) = make' #simplify
-	 val (used', _) = make' #used
+         val (deconed', _) = make' #deconed
+         val (simplify', _) = make' #simplify
+         val (used', _) = make' #used
       end
    
       fun new (): t = T {deconed = ref false,
-			 simplify = ref NONE,
-			 used = ref false}
+                         simplify = ref NONE,
+                         used = ref false}
    end
 
 
 structure FuncInfo =
    struct
       datatype t = T of {args: (VarInfo.t * Type.t) vector,
-			 bugLabel: Label.t option ref,
-			 mayRaise: MayRaise.t,
-			 mayReturn: MayReturn.t,
-			 raiseLabel: Label.t option ref,
-			 raises: (VarInfo.t * Type.t) vector option,
-			 returnLabel: Label.t option ref,
-			 returns: (VarInfo.t * Type.t) vector option,
-			 sideEffects: SideEffects.t,
-			 used: Used.t,
-			 wrappers: Block.t list ref}
-	 
+                         bugLabel: Label.t option ref,
+                         mayRaise: MayRaise.t,
+                         mayReturn: MayReturn.t,
+                         raiseLabel: Label.t option ref,
+                         raises: (VarInfo.t * Type.t) vector option,
+                         returnLabel: Label.t option ref,
+                         returns: (VarInfo.t * Type.t) vector option,
+                         sideEffects: SideEffects.t,
+                         used: Used.t,
+                         wrappers: Block.t list ref}
+         
       fun layout (T {args, 
-		     mayRaise, mayReturn, 
-		     raises, returns, 
-		     sideEffects, used,
-		     ...}) =
-	 Layout.record [("args", Vector.layout 
-			         (Layout.tuple2 (VarInfo.layout, Type.layout)) 
-				 args),
-			("mayRaise", MayRaise.layout mayRaise),
-			("mayReturn", MayReturn.layout mayReturn),
-			("raises", Option.layout
-			           (Vector.layout 
-				    (Layout.tuple2 (VarInfo.layout, Type.layout)))
-				   raises),
-			("returns", Option.layout
-			            (Vector.layout 
-				     (Layout.tuple2 (VarInfo.layout, Type.layout)))
-				    returns),
-			("sideEffects", SideEffects.layout sideEffects),
-			("used", Used.layout used)]
-	 
+                     mayRaise, mayReturn, 
+                     raises, returns, 
+                     sideEffects, used,
+                     ...}) =
+         Layout.record [("args", Vector.layout 
+                                 (Layout.tuple2 (VarInfo.layout, Type.layout)) 
+                                 args),
+                        ("mayRaise", MayRaise.layout mayRaise),
+                        ("mayReturn", MayReturn.layout mayReturn),
+                        ("raises", Option.layout
+                                   (Vector.layout 
+                                    (Layout.tuple2 (VarInfo.layout, Type.layout)))
+                                   raises),
+                        ("returns", Option.layout
+                                    (Vector.layout 
+                                     (Layout.tuple2 (VarInfo.layout, Type.layout)))
+                                    returns),
+                        ("sideEffects", SideEffects.layout sideEffects),
+                        ("used", Used.layout used)]
+         
       local
-	 fun make f (T r) = f r
-	 fun make' f = (make f, ! o (make f))
+         fun make f (T r) = f r
+         fun make' f = (make f, ! o (make f))
       in
-	 val args = make #args
-	 val mayRaise' = make #mayRaise
-	 val mayReturn' = make #mayReturn
-	 val raiseLabel = make #raiseLabel
-	 val raises = make #raises
-	 val returnLabel = make #returnLabel
-	 val returns = make #returns
-	 val sideEffects = make #sideEffects
-	 val used = make #used
-	 val (wrappers', wrappers) = make' #wrappers
+         val args = make #args
+         val mayRaise' = make #mayRaise
+         val mayReturn' = make #mayReturn
+         val raiseLabel = make #raiseLabel
+         val raises = make #raises
+         val returnLabel = make #returnLabel
+         val returns = make #returns
+         val sideEffects = make #sideEffects
+         val used = make #used
+         val (wrappers', wrappers) = make' #wrappers
       end
    
       val raisee = MayRaise.raisee o mayRaise'
       val mayRaise = MayRaise.mayRaise o mayRaise'
       fun whenRaises (fi, th) = MayRaise.whenRaises (mayRaise' fi, th)
       fun flowRaises (fi, fi') = MayRaise.<= (mayRaise' fi, mayRaise' fi')
-	 
+         
       val return = MayReturn.return o mayReturn'
       fun whenReturns (fi, th) = MayReturn.whenReturns (mayReturn' fi, th)
       val mayReturn = MayReturn.mayReturn o mayReturn'
       fun flowReturns (fi, fi') = MayReturn.<= (mayReturn' fi, mayReturn' fi')
-	 
+         
       val use = Used.use o used
       val isUsed = Used.isUsed o used
       fun whenUsed (fi, th) = Used.whenUsed (used fi, th)
-	 
+         
       val sideEffect = SideEffects.sideEffect o sideEffects
       fun flowSideEffects (fi, fi') = SideEffects.<= (sideEffects fi, sideEffects fi')
-	 
+         
       fun new {args: (VarInfo.t * Type.t) vector, 
-	       raises: (VarInfo.t * Type.t) vector option, 
-	       returns: (VarInfo.t * Type.t) vector option}: t =
-	 T {args = args,
-	    bugLabel = ref NONE,
-	    mayRaise = MayRaise.new (),
-	    mayReturn = MayReturn.new (),
-	    raiseLabel = ref NONE,
-	    raises = raises,
-	    returnLabel = ref NONE,
-	    returns = returns,
-	    sideEffects = SideEffects.new (),
-	    used = Used.new (),
-	    wrappers = ref []}
+               raises: (VarInfo.t * Type.t) vector option, 
+               returns: (VarInfo.t * Type.t) vector option}: t =
+         T {args = args,
+            bugLabel = ref NONE,
+            mayRaise = MayRaise.new (),
+            mayReturn = MayReturn.new (),
+            raiseLabel = ref NONE,
+            raises = raises,
+            returnLabel = ref NONE,
+            returns = returns,
+            sideEffects = SideEffects.new (),
+            used = Used.new (),
+            wrappers = ref []}
    end
 
 structure LabelInfo =
    struct
       datatype t = T of {args: (VarInfo.t * Type.t) vector,
-			 func: FuncInfo.t,
-			 used: Used.t,
-			 wrappers: (Type.t vector * Label.t) list ref}
-	 
+                         func: FuncInfo.t,
+                         used: Used.t,
+                         wrappers: (Type.t vector * Label.t) list ref}
+         
       fun layout (T {args, used, ...}) =
-	 Layout.record [("args", Vector.layout (VarInfo.layout o #1) args),
-			("used", Used.layout used)]
-	 
+         Layout.record [("args", Vector.layout (VarInfo.layout o #1) args),
+                        ("used", Used.layout used)]
+         
       fun new {args: (VarInfo.t * Type.t) vector, func: FuncInfo.t}: t =
-	 T {args = args,
-	    func = func,
-	    used = Used.new (),
-	    wrappers = ref []}
-	 
+         T {args = args,
+            func = func,
+            used = Used.new (),
+            wrappers = ref []}
+         
       local
-	 fun make f (T r) = f r
-	 fun make' f = (make f, ! o (make f))
+         fun make f (T r) = f r
+         fun make' f = (make f, ! o (make f))
       in
-	 val args = make #args
-	 val func = make #func
-	 val used = make #used
-	 val (wrappers', wrappers) = make' #wrappers
+         val args = make #args
+         val func = make #func
+         val used = make #used
+         val (wrappers', wrappers) = make' #wrappers
       end
    
       val use = Used.use o used
@@ -301,51 +297,51 @@
    end
 
 
-fun remove (program as Program.T {datatypes, globals, functions, main}) = 
+fun remove (Program.T {datatypes, globals, functions, main}) = 
    let
       val {get = conInfo: Con.t -> ConInfo.t, 
-	   set = setConInfo, ...} =
-	 Property.getSetOnce
-	 (Con.plist, 
-	  Property.initRaise ("RemoveUnused.conInfo", Con.layout))
+           set = setConInfo, ...} =
+         Property.getSetOnce
+         (Con.plist, 
+          Property.initRaise ("RemoveUnused.conInfo", Con.layout))
       fun newConInfo (con, args) =
-	 setConInfo (con, ConInfo.new {args = args})
+         setConInfo (con, ConInfo.new {args = args})
 
       val {get = tyconInfo: Tycon.t -> TyconInfo.t,
-	   set = setTyconInfo, ...} =
-	 Property.getSetOnce
-	 (Tycon.plist, 
-	  Property.initRaise ("RemoveUnused.tyconInfo", Tycon.layout))
+           set = setTyconInfo, ...} =
+         Property.getSetOnce
+         (Tycon.plist, 
+          Property.initRaise ("RemoveUnused.tyconInfo", Tycon.layout))
       fun newTyconInfo (tycon, cons) =
-	 setTyconInfo (tycon, TyconInfo.new {cons = cons})
+         setTyconInfo (tycon, TyconInfo.new {cons = cons})
 
       val {get = typeInfo: Type.t -> TypeInfo.t, 
-	   destroy, ...} =
-	 Property.destGet 
-	 (Type.plist, 
-	  Property.initFun (fn _ => TypeInfo.new ()))
+           destroy, ...} =
+         Property.destGet 
+         (Type.plist, 
+          Property.initFun (fn _ => TypeInfo.new ()))
 
 
       val {get = varInfo: Var.t -> VarInfo.t, 
-	   set = setVarInfo, ...} = 
-	 Property.getSetOnce
-	 (Var.plist, 
-	  Property.initRaise ("RemoveUnused.varInfo", Var.layout))
+           set = setVarInfo, ...} = 
+         Property.getSetOnce
+         (Var.plist, 
+          Property.initRaise ("RemoveUnused.varInfo", Var.layout))
       fun newVarInfo (var, ty) =
-	 setVarInfo (var, VarInfo.new ty)
+         setVarInfo (var, VarInfo.new ty)
 
 
       val {get = labelInfo: Label.t -> LabelInfo.t, 
-	   set = setLabelInfo, ...} =
-	 Property.getSetOnce
-	 (Label.plist,
-	  Property.initRaise ("RemoveUnused.labelInfo", Label.layout))
-	 
+           set = setLabelInfo, ...} =
+         Property.getSetOnce
+         (Label.plist,
+          Property.initRaise ("RemoveUnused.labelInfo", Label.layout))
+         
       val {get = funcInfo: Func.t -> FuncInfo.t, 
-	   set = setFuncInfo, ...} =
-	 Property.getSetOnce
-	 (Func.plist,
-	  Property.initRaise ("RemoveUnused.funcInfo", Func.layout))
+           set = setFuncInfo, ...} =
+         Property.getSetOnce
+         (Func.plist,
+          Property.initRaise ("RemoveUnused.funcInfo", Func.layout))
 
 
       val usedTycon = TyconInfo.used o tyconInfo
@@ -353,44 +349,43 @@
       val isUsedTycon = Used.isUsed o usedTycon
       val usedCon = ConInfo.used o conInfo
       val useCon = Used.use o usedCon
-      val isUsedCon = Used.isUsed o usedCon
       val whenUsedCon = fn (con, th) => ConInfo.whenUsed (conInfo con, th)
 
       fun visitTycon (tycon: Tycon.t) = useTycon tycon
       fun visitCon (con: Con.t) = useCon con
       fun visitType (ty: Type.t) =
-	 let
-	    val ti = typeInfo ty
-	    val used = TypeInfo.used' ti
-	 in
-	    if !used
-	       then ()
-	       else let
-		       val  () = used := true
-		       datatype z = datatype Type.dest
-		       datatype z = datatype ObjectCon.t
-		       val () =
-			  case Type.dest ty of
-			     Datatype tycon => visitTycon tycon
-			   | Object {args, con} => 
-				let
-				   val () = Prod.foreach (args, visitType)
-				   val () =
-				      case con of
-					 Con con => visitCon con
-				       | Tuple => ()
-				       | Vector => ()
-				in
-				   ()
-				end
-			   | Weak ty => visitType ty
-			   | _ => ()
-		    in
-		       ()
-		    end
-	 end
+         let
+            val ti = typeInfo ty
+            val used = TypeInfo.used' ti
+         in
+            if !used
+               then ()
+               else let
+                       val  () = used := true
+                       datatype z = datatype Type.dest
+                       datatype z = datatype ObjectCon.t
+                       val () =
+                          case Type.dest ty of
+                             Datatype tycon => visitTycon tycon
+                           | Object {args, con} => 
+                                let
+                                   val () = Prod.foreach (args, visitType)
+                                   val () =
+                                      case con of
+                                         Con con => visitCon con
+                                       | Tuple => ()
+                                       | Vector => ()
+                                in
+                                   ()
+                                end
+                           | Weak ty => visitType ty
+                           | _ => ()
+                    in
+                       ()
+                    end
+         end
       val visitTypeTh = fn ty => fn () => visitType ty
-	 
+         
 
       val tyVar = VarInfo.ty o varInfo
       val usedVar = VarInfo.used o varInfo
@@ -398,17 +393,17 @@
       val isUsedVar = Used.isUsed o usedVar
       val whenUsedVar = fn (var, th) => VarInfo.whenUsed (varInfo var, th)
       fun flowVarInfoTyVarInfoTy ((vi, _), (vi', _)) =
-	 Used.<= (VarInfo.used vi, VarInfo.used vi')
+         Used.<= (VarInfo.used vi, VarInfo.used vi')
       fun flowVarInfoTysVarInfoTys (xs, ys) =
-	 Vector.foreach2 (xs, ys, flowVarInfoTyVarInfoTy)
+         Vector.foreach2 (xs, ys, flowVarInfoTyVarInfoTy)
       fun flowVarInfoTyVar ((vi, _), x) =
-	 Used.<= (VarInfo.used vi, usedVar x)
+         Used.<= (VarInfo.used vi, usedVar x)
       fun flowVarInfoTysVars (xs, ys) =
-	 Vector.foreach2 (xs, ys, flowVarInfoTyVar)
+         Vector.foreach2 (xs, ys, flowVarInfoTyVar)
 
       val newVarInfo = fn (var, ty) =>
-	 (newVarInfo (var, ty)
-	  ; whenUsedVar (var, visitTypeTh ty))
+         (newVarInfo (var, ty)
+          ; whenUsedVar (var, visitTypeTh ty))
 
       val visitLabelInfo = LabelInfo.use
       val visitLabelInfoTh = fn li => fn () => visitLabelInfo li
@@ -420,1112 +415,1112 @@
       fun visitVar (x: Var.t) = useVar x
       fun visitVars (xs: Var.t Vector.t) = Vector.foreach (xs, visitVar)
       fun visitExp (e: Exp.t) =
-	 case e of
-	    Const _ => ()
-	  | Inject {sum, variant} => 
-	       (visitTycon sum
-		; visitVar variant)
-	  | Object {args, con} =>
-	       let
-		  val () = 
-		     case con of
-			NONE => visitVars args
-		      | SOME con =>
-			   let
-			      val ci = conInfo con
-			      val () = ConInfo.con ci
-			      val ciArgs =
-				 Vector.map 
-				 (Prod.dest (ConInfo.args ci), #elt)
-			      val () = flowVarInfoTysVars (ciArgs, args)
-			   in
-			      ()
-			   end
-	       in
-		  ()
-	       end
-	  | PrimApp {prim, args} =>
-	       let
-		  val () = visitVars args
-		  datatype z = datatype Type.dest
-		  datatype z = datatype ObjectCon.t
+         case e of
+            Const _ => ()
+          | Inject {sum, variant} => 
+               (visitTycon sum
+                ; visitVar variant)
+          | Object {args, con} =>
+               let
+                  val () = 
+                     case con of
+                        NONE => visitVars args
+                      | SOME con =>
+                           let
+                              val ci = conInfo con
+                              val () = ConInfo.con ci
+                              val ciArgs =
+                                 Vector.map 
+                                 (Prod.dest (ConInfo.args ci), #elt)
+                              val () = flowVarInfoTysVars (ciArgs, args)
+                           in
+                              ()
+                           end
+               in
+                  ()
+               end
+          | PrimApp {prim, args} =>
+               let
+                  val () = visitVars args
+                  datatype z = datatype Type.dest
+                  datatype z = datatype ObjectCon.t
 
-		  fun deconType (ty: Type.t) = 
-		     let
-		        val ti = typeInfo ty
-			val deconed = TypeInfo.deconed' ti
-		     in
-			if !deconed
-			   then ()
-			   else let
-				   val () = deconed := true
-				   val () =
-				      case Type.dest ty of 
-					 Datatype t => 
-					    Vector.foreach
-					    (TyconInfo.cons (tyconInfo t), 
-					     fn con => deconCon con)
-				       | Object {args, con} =>
-					    let
-					       fun default () =
-						  Prod.foreach (args, deconType)
-					       val () =
-						  case con of
-						     Con con => deconCon con
-						   | Tuple => default ()
-						   | Vector => default ()
-					    in
-					       ()
-					    end
-				       | _ => ()
-				in
-				   ()
-				end
-		     end
-		  and deconCon con =
-		     let
-			val ci = conInfo con
-			val () = ConInfo.decon ci
-			val () =
-			   Prod.foreach
-			   (ConInfo.args ci, fn (x, t) =>
-			    (VarInfo.use x; deconType t))
-		     in
-			()
-		     end
-		  val () =
-		     case Prim.name prim of 
-			Prim.Name.MLton_eq => 
-			   (* MLton_eq may be used on datatypes used as enums. *)
-			   deconType (tyVar (Vector.sub (args, 0)))
-		      | Prim.Name.MLton_equal =>
-			   (* MLton_equal will be expanded by poly-equal into uses
-			    * of constructors as patterns.
-			    *)
-			   deconType (tyVar (Vector.sub (args, 0)))
+                  fun deconType (ty: Type.t) = 
+                     let
+                        val ti = typeInfo ty
+                        val deconed = TypeInfo.deconed' ti
+                     in
+                        if !deconed
+                           then ()
+                           else let
+                                   val () = deconed := true
+                                   val () =
+                                      case Type.dest ty of 
+                                         Datatype t => 
+                                            Vector.foreach
+                                            (TyconInfo.cons (tyconInfo t), 
+                                             fn con => deconCon con)
+                                       | Object {args, con} =>
+                                            let
+                                               fun default () =
+                                                  Prod.foreach (args, deconType)
+                                               val () =
+                                                  case con of
+                                                     Con con => deconCon con
+                                                   | Tuple => default ()
+                                                   | Vector => default ()
+                                            in
+                                               ()
+                                            end
+                                       | _ => ()
+                                in
+                                   ()
+                                end
+                     end
+                  and deconCon con =
+                     let
+                        val ci = conInfo con
+                        val () = ConInfo.decon ci
+                        val () =
+                           Prod.foreach
+                           (ConInfo.args ci, fn (x, t) =>
+                            (VarInfo.use x; deconType t))
+                     in
+                        ()
+                     end
+                  val () =
+                     case Prim.name prim of 
+                        Prim.Name.MLton_eq => 
+                           (* MLton_eq may be used on datatypes used as enums. *)
+                           deconType (tyVar (Vector.sub (args, 0)))
+                      | Prim.Name.MLton_equal =>
+                           (* MLton_equal will be expanded by poly-equal into uses
+                            * of constructors as patterns.
+                            *)
+                           deconType (tyVar (Vector.sub (args, 0)))
 (*
-		      | (Prim.Name.MLton_size, 1) => 
-			   deconType (tyVar (Vector.sub (args, 0)))
+                      | (Prim.Name.MLton_size, 1) => 
+                           deconType (tyVar (Vector.sub (args, 0)))
 *)
-		      | _ => ()
-	       in
-		  ()
-	       end
-	  | Select {base, offset} => 
-	       let
-		  datatype z = datatype Base.t
-		  datatype z = datatype ObjectCon.t
-	       in
-		  case base of
-		     Object base => 
-			let
-			   val () = visitVar base
-			   val () =
-			      case Type.dest (tyVar base) of
-				 Type.Object {con, ...} =>
-				    (case con of
-					Con con => 
-					   let
-					      val ci = conInfo con
-					      val ciArgs = ConInfo.args ci
-					      val {elt = (vi, _), ...} =
-						 Prod.sub (ciArgs, offset)
+                      | _ => ()
+               in
+                  ()
+               end
+          | Select {base, offset} => 
+               let
+                  datatype z = datatype Base.t
+                  datatype z = datatype ObjectCon.t
+               in
+                  case base of
+                     Object base => 
+                        let
+                           val () = visitVar base
+                           val () =
+                              case Type.dest (tyVar base) of
+                                 Type.Object {con, ...} =>
+                                    (case con of
+                                        Con con => 
+                                           let
+                                              val ci = conInfo con
+                                              val ciArgs = ConInfo.args ci
+                                              val {elt = (vi, _), ...} =
+                                                 Prod.sub (ciArgs, offset)
 
-					      val () = ConInfo.decon ci
-					      val () = VarInfo.use vi
-					   in
-					      ()
-					   end
-				      | Tuple => ()
-				      | Vector => Error.bug "Select:non-Con|Tuple")
-			       | _ => Error.bug "Select:non-Object"
-			in
-			   ()
-			end
-		   | VectorSub {index, vector} =>
-			(visitVar index
-			 ; visitVar vector)
-	       end 
-	  | Var x => visitVar x
+                                              val () = ConInfo.decon ci
+                                              val () = VarInfo.use vi
+                                           in
+                                              ()
+                                           end
+                                      | Tuple => ()
+                                      | Vector => Error.bug "RemoveUnused2.visitExp: Select:non-Con|Tuple")
+                               | _ => Error.bug "RemovUnused2.visitExp: Select:non-Object"
+                        in
+                           ()
+                        end
+                   | VectorSub {index, vector} =>
+                        (visitVar index
+                         ; visitVar vector)
+               end 
+          | Var x => visitVar x
       val visitExpTh = fn e => fn () => visitExp e
       fun maybeVisitVarExp (var, exp) = 
-	 Option.app (var, fn var => 
-		     VarInfo.whenUsed (varInfo var, visitExpTh exp))
+         Option.app (var, fn var => 
+                     VarInfo.whenUsed (varInfo var, visitExpTh exp))
       fun visitStatement (s, fi: FuncInfo.t option) =
-	 case s of
-	    Bind {exp, ty, var} =>
-	       (Option.app (var, fn var => newVarInfo (var, ty))
-		; if Exp.maySideEffect exp
-		     then (Option.app(fi, FuncInfo.sideEffect)
-			   ; visitType ty
-			   ; visitExp exp)
-		     else maybeVisitVarExp (var, exp))
-	  | Profile _ => ()
-	  | Update {base, offset, value} =>
-	       let
-		  datatype z = datatype Base.t
-		  datatype z = datatype ObjectCon.t
-	       in
-		  case base of
-		     Object base =>
-			(case Type.dest (tyVar base) of
-			    Type.Object {con, ...} => 
-			       (case con of
-				   Con con =>
-				      let
-					 val ci = conInfo con
-					 val ciArgs = ConInfo.args ci
-					 val {elt = (vi, _), ...} =
-					    Prod.sub (ciArgs, offset)
-				      in
-					 VarInfo.whenUsed
-					 (vi, fn () =>
-					  (Option.app (fi, FuncInfo.sideEffect)
-					   ; ConInfo.decon ci
-					   ; visitVar base
-					   ; visitVar value))
-				      end
-				 | Tuple => 
-				      (Option.app (fi, FuncInfo.sideEffect)
-				       ; visitVar base
-				       ; visitVar value)
-				 | Vector => Error.bug "Update:non-Con|Tuple")
-			  | _ => Error.bug "Update:non-Object")
-		   | VectorSub {index, vector} =>
-			(Option.app(fi, FuncInfo.sideEffect)
-			 ; visitVar index
-			 ; visitVar vector
-			 ; visitVar value)
-	       end
+         case s of
+            Bind {exp, ty, var} =>
+               (Option.app (var, fn var => newVarInfo (var, ty))
+                ; if Exp.maySideEffect exp
+                     then (Option.app(fi, FuncInfo.sideEffect)
+                           ; visitType ty
+                           ; visitExp exp)
+                     else maybeVisitVarExp (var, exp))
+          | Profile _ => ()
+          | Update {base, offset, value} =>
+               let
+                  datatype z = datatype Base.t
+                  datatype z = datatype ObjectCon.t
+               in
+                  case base of
+                     Object base =>
+                        (case Type.dest (tyVar base) of
+                            Type.Object {con, ...} => 
+                               (case con of
+                                   Con con =>
+                                      let
+                                         val ci = conInfo con
+                                         val ciArgs = ConInfo.args ci
+                                         val {elt = (vi, _), ...} =
+                                            Prod.sub (ciArgs, offset)
+                                      in
+                                         VarInfo.whenUsed
+                                         (vi, fn () =>
+                                          (Option.app (fi, FuncInfo.sideEffect)
+                                           ; ConInfo.decon ci
+                                           ; visitVar base
+                                           ; visitVar value))
+                                      end
+                                 | Tuple => 
+                                      (Option.app (fi, FuncInfo.sideEffect)
+                                       ; visitVar base
+                                       ; visitVar value)
+                                 | Vector => Error.bug "RemoveUnused2.visitStatement: Update:non-Con|Tuple")
+                          | _ => Error.bug "RemoveUnused2.visitStatement: Update:non-Object")
+                   | VectorSub {index, vector} =>
+                        (Option.app(fi, FuncInfo.sideEffect)
+                         ; visitVar index
+                         ; visitVar vector
+                         ; visitVar value)
+               end
       fun visitTransfer (t: Transfer.t, fi: FuncInfo.t) =
-	 case t of
-	    Arith {args, overflow, success, ty, ...} =>
-	       (FuncInfo.sideEffect fi
-		; visitVars args
-		; visitLabel overflow
-		; visitLabel success
-		; visitType ty)
-	  | Bug => ()
-	  | Call {args, func, return} =>
-	       let
-		  datatype u = None
-		             | Caller
-		             | Some of Label.t
-		  val (cont, handler) =
-		     case return of
-			Return.Dead => (None, None)
-		      | Return.NonTail {cont, handler} =>
-			   (Some cont,
-			    case handler of
-			       Handler.Caller => Caller
-			     | Handler.Dead => None
-			     | Handler.Handle h => Some h)
-		      | Return.Tail => (Caller, Caller)
-		  val fi' = funcInfo func
+         case t of
+            Arith {args, overflow, success, ty, ...} =>
+               (FuncInfo.sideEffect fi
+                ; visitVars args
+                ; visitLabel overflow
+                ; visitLabel success
+                ; visitType ty)
+          | Bug => ()
+          | Call {args, func, return} =>
+               let
+                  datatype u = None
+                             | Caller
+                             | Some of Label.t
+                  val (cont, handler) =
+                     case return of
+                        Return.Dead => (None, None)
+                      | Return.NonTail {cont, handler} =>
+                           (Some cont,
+                            case handler of
+                               Handler.Caller => Caller
+                             | Handler.Dead => None
+                             | Handler.Handle h => Some h)
+                      | Return.Tail => (Caller, Caller)
+                  val fi' = funcInfo func
 
-		  val () = flowVarInfoTysVars (FuncInfo.args fi', args)
-		  val () = FuncInfo.flowSideEffects (fi', fi)
-		  val () = 
-		     case cont of
-			None => ()
-		      | Caller => 
-			   let
-			      val () =
-				 case (FuncInfo.returns fi, 
-				       FuncInfo.returns fi') of 
-				    (SOME xts, SOME xts') => 
-				       flowVarInfoTysVarInfoTys (xts, xts')
-				  | _ => ()
-			      val () = FuncInfo.flowReturns (fi', fi)
-			   in
-			      ()
-			   end
-		      | Some l =>
-			   let
-			      val li = labelInfo l
-			      val () =
-				 Option.app
-				 (FuncInfo.returns fi', fn xts =>
-				  flowVarInfoTysVarInfoTys 
-				  (LabelInfo.args li, xts))
-			      val () =
-				 FuncInfo.whenReturns 
-				 (fi', visitLabelInfoTh li)
-			   in
-			      ()
-			   end
-		  val () =
-		     case handler of
-			None => ()
-		      | Caller =>
-			   let
-			      val () =
-				 case (FuncInfo.raises fi,
-				       FuncInfo.raises fi') of
-				    (SOME xts, SOME xts') =>
-				       flowVarInfoTysVarInfoTys (xts, xts')
-				  | _ => ()
-			      val () = FuncInfo.flowRaises (fi', fi)
-			   in
-			      ()
-			   end
-		      | Some l =>
-			   let
-			      val li = labelInfo l
-			      val () =
-				 Option.app
-				 (FuncInfo.raises fi', fn xts =>
-				  flowVarInfoTysVarInfoTys 
-				  (LabelInfo.args li, xts))
-			      val () =
-				 FuncInfo.whenRaises (fi', visitLabelInfoTh li)
-			   in
-			      ()
-			   end
-		  val () = visitFuncInfo fi'
-	       in
-		  ()
-	       end
-	  | Case {test, cases, default} =>
-	       let
-		  val () = visitVar test
-	       in
-		  case cases of
-		     Cases.Word (_, cs) =>
-			(Vector.foreach (cs, visitLabel o #2)
-			 ; Option.app (default, visitLabel))
-		   | Cases.Con cases =>
-			if Vector.length cases = 0
-			   then Option.app (default, visitLabel)
-			   else let
-				   val () = 
-				      Vector.foreach
-				      (cases, fn (con, l) =>
-				       let
-					  val ci = conInfo con
-					  val () = ConInfo.decon ci
-					  val () = 
-					     ConInfo.whenConed
-					     (ci, fn () => visitLabel l)
-				       in
-					  ()
-				       end)
-				   val tycon = 
-				      case Type.dest (tyVar test) of
-					 Type.Datatype tycon => tycon
-				       | _ => Error.bug "Case:non-Datatype"
-				   val cons = TyconInfo.cons (tyconInfo tycon)
-				in
-				   case default of 
-				      NONE => ()
-				    | SOME l => 
-					 Vector.foreach
-					 (cons, fn con =>
-					  if Vector.exists
-					     (cases, fn (c, _) => 
-					      Con.equals(c, con))
-					     then ()
-					     else ConInfo.whenConed
-						  (conInfo con, fn () => 
-						   visitLabel l))
-				end
-	       end
-	  | Goto {dst, args} =>
-	       let
-		  val li = labelInfo dst
-		  val () = flowVarInfoTysVars (LabelInfo.args li, args)
-		  val () = visitLabelInfo li
-	       in
-		  ()
-	       end
-	  | Raise xs => 
-	       (FuncInfo.raisee fi
-		; flowVarInfoTysVars (valOf (FuncInfo.raises fi), xs))
-	  | Return xs =>
-	       (FuncInfo.return fi
-		; flowVarInfoTysVars (valOf (FuncInfo.returns fi), xs))
-	  | Runtime {args, return, ...} =>
-	       (FuncInfo.sideEffect fi
-		; visitVars args
-		; visitLabel return)
+                  val () = flowVarInfoTysVars (FuncInfo.args fi', args)
+                  val () = FuncInfo.flowSideEffects (fi', fi)
+                  val () = 
+                     case cont of
+                        None => ()
+                      | Caller => 
+                           let
+                              val () =
+                                 case (FuncInfo.returns fi, 
+                                       FuncInfo.returns fi') of 
+                                    (SOME xts, SOME xts') => 
+                                       flowVarInfoTysVarInfoTys (xts, xts')
+                                  | _ => ()
+                              val () = FuncInfo.flowReturns (fi', fi)
+                           in
+                              ()
+                           end
+                      | Some l =>
+                           let
+                              val li = labelInfo l
+                              val () =
+                                 Option.app
+                                 (FuncInfo.returns fi', fn xts =>
+                                  flowVarInfoTysVarInfoTys 
+                                  (LabelInfo.args li, xts))
+                              val () =
+                                 FuncInfo.whenReturns 
+                                 (fi', visitLabelInfoTh li)
+                           in
+                              ()
+                           end
+                  val () =
+                     case handler of
+                        None => ()
+                      | Caller =>
+                           let
+                              val () =
+                                 case (FuncInfo.raises fi,
+                                       FuncInfo.raises fi') of
+                                    (SOME xts, SOME xts') =>
+                                       flowVarInfoTysVarInfoTys (xts, xts')
+                                  | _ => ()
+                              val () = FuncInfo.flowRaises (fi', fi)
+                           in
+                              ()
+                           end
+                      | Some l =>
+                           let
+                              val li = labelInfo l
+                              val () =
+                                 Option.app
+                                 (FuncInfo.raises fi', fn xts =>
+                                  flowVarInfoTysVarInfoTys 
+                                  (LabelInfo.args li, xts))
+                              val () =
+                                 FuncInfo.whenRaises (fi', visitLabelInfoTh li)
+                           in
+                              ()
+                           end
+                  val () = visitFuncInfo fi'
+               in
+                  ()
+               end
+          | Case {test, cases, default} =>
+               let
+                  val () = visitVar test
+               in
+                  case cases of
+                     Cases.Word (_, cs) =>
+                        (Vector.foreach (cs, visitLabel o #2)
+                         ; Option.app (default, visitLabel))
+                   | Cases.Con cases =>
+                        if Vector.length cases = 0
+                           then Option.app (default, visitLabel)
+                           else let
+                                   val () = 
+                                      Vector.foreach
+                                      (cases, fn (con, l) =>
+                                       let
+                                          val ci = conInfo con
+                                          val () = ConInfo.decon ci
+                                          val () = 
+                                             ConInfo.whenConed
+                                             (ci, fn () => visitLabel l)
+                                       in
+                                          ()
+                                       end)
+                                   val tycon = 
+                                      case Type.dest (tyVar test) of
+                                         Type.Datatype tycon => tycon
+                                       | _ => Error.bug "RemoveUnused2.visitTransfer: Case:non-Datatype"
+                                   val cons = TyconInfo.cons (tyconInfo tycon)
+                                in
+                                   case default of 
+                                      NONE => ()
+                                    | SOME l => 
+                                         Vector.foreach
+                                         (cons, fn con =>
+                                          if Vector.exists
+                                             (cases, fn (c, _) => 
+                                              Con.equals(c, con))
+                                             then ()
+                                             else ConInfo.whenConed
+                                                  (conInfo con, fn () => 
+                                                   visitLabel l))
+                                end
+               end
+          | Goto {dst, args} =>
+               let
+                  val li = labelInfo dst
+                  val () = flowVarInfoTysVars (LabelInfo.args li, args)
+                  val () = visitLabelInfo li
+               in
+                  ()
+               end
+          | Raise xs => 
+               (FuncInfo.raisee fi
+                ; flowVarInfoTysVars (valOf (FuncInfo.raises fi), xs))
+          | Return xs =>
+               (FuncInfo.return fi
+                ; flowVarInfoTysVars (valOf (FuncInfo.returns fi), xs))
+          | Runtime {args, return, ...} =>
+               (FuncInfo.sideEffect fi
+                ; visitVars args
+                ; visitLabel return)
       fun visitBlock (Block.T {statements, transfer, ...}, fi: FuncInfo.t) =
-	 (Vector.foreach (statements, fn s => visitStatement (s, SOME fi))
-	  ; visitTransfer (transfer, fi))
+         (Vector.foreach (statements, fn s => visitStatement (s, SOME fi))
+          ; visitTransfer (transfer, fi))
       val visitBlockTh = fn (b, fi) => fn () => visitBlock (b, fi)
       (* Visit all reachable expressions. *)
       val () = 
-	 Vector.foreach
-	 (datatypes, fn Datatype.T {tycon, cons} =>
-	  (newTyconInfo (tycon, Vector.map (cons, fn {con, ...} => con))
-	   ; Vector.foreach 
-	     (cons, fn {con, args} => 
-	      (newConInfo (con, args)
-	       ; whenUsedCon (con, fn () => useTycon tycon)))))
+         Vector.foreach
+         (datatypes, fn Datatype.T {tycon, cons} =>
+          (newTyconInfo (tycon, Vector.map (cons, fn {con, ...} => con))
+           ; Vector.foreach 
+             (cons, fn {con, args} => 
+              (newConInfo (con, args)
+               ; whenUsedCon (con, fn () => useTycon tycon)))))
       val () = 
-	 let
-	    fun doit c = 
-	       let
-		  val ci = conInfo c
-	       in
-		  ConInfo.use ci
-		  ; ConInfo.con ci 
-		  ; ConInfo.decon ci
-	       end
-	 in
-	    doit Con.truee 
-	    ; doit Con.falsee 
-	 end 
+         let
+            fun doit c = 
+               let
+                  val ci = conInfo c
+               in
+                  ConInfo.use ci
+                  ; ConInfo.con ci 
+                  ; ConInfo.decon ci
+               end
+         in
+            doit Con.truee 
+            ; doit Con.falsee 
+         end 
       val () = 
-	 Vector.foreach (globals, fn s => visitStatement (s, NONE))
+         Vector.foreach (globals, fn s => visitStatement (s, NONE))
       val () = 
-	 List.foreach
-	 (functions, fn function =>
-	  let
-	     val {name, args, raises, returns, start, blocks, ...} = 
-		Function.dest function
-	     val () = Vector.foreach (args, newVarInfo)
-	     local
-		fun doitVarTys vts =
-		   Vector.map (vts, fn (x, t) => (varInfo x, t))
-		fun doitTys ts = 
-		   Vector.map (ts, fn t => (VarInfo.new t, t))
-		fun doitTys' ts = 
-		   Option.map (ts, doitTys)
-	     in
-		val fi = 
-		   FuncInfo.new
-		   {args = doitVarTys args,
-		    raises = doitTys' raises,
-		    returns = doitTys' returns}
-	     end
-	     val () = setFuncInfo (name, fi)
-	     val () = FuncInfo.whenUsed (fi, visitLabelTh start)
-	     val () =
-		Vector.foreach
-		(blocks, fn block as Block.T {label, args, ...} => 
-		 let
-		    val () = Vector.foreach (args, newVarInfo)
-		    local
-		       fun doitVarTys vts = 
-			  Vector.map (vts, fn (x, t) => (varInfo x, t))
-		    in
-		       val li = 
-			  LabelInfo.new 
-			  {args = doitVarTys args,
-			   func = fi}
-		    end
-		    val () = setLabelInfo (label, li)
-		    val () = LabelInfo.whenUsed (li, visitBlockTh (block, fi))
-		 in
-		    ()
-		 end)
-	  in
-	     ()
-	  end)
+         List.foreach
+         (functions, fn function =>
+          let
+             val {name, args, raises, returns, start, blocks, ...} = 
+                Function.dest function
+             val () = Vector.foreach (args, newVarInfo)
+             local
+                fun doitVarTys vts =
+                   Vector.map (vts, fn (x, t) => (varInfo x, t))
+                fun doitTys ts = 
+                   Vector.map (ts, fn t => (VarInfo.new t, t))
+                fun doitTys' ts = 
+                   Option.map (ts, doitTys)
+             in
+                val fi = 
+                   FuncInfo.new
+                   {args = doitVarTys args,
+                    raises = doitTys' raises,
+                    returns = doitTys' returns}
+             end
+             val () = setFuncInfo (name, fi)
+             val () = FuncInfo.whenUsed (fi, visitLabelTh start)
+             val () =
+                Vector.foreach
+                (blocks, fn block as Block.T {label, args, ...} => 
+                 let
+                    val () = Vector.foreach (args, newVarInfo)
+                    local
+                       fun doitVarTys vts = 
+                          Vector.map (vts, fn (x, t) => (varInfo x, t))
+                    in
+                       val li = 
+                          LabelInfo.new 
+                          {args = doitVarTys args,
+                           func = fi}
+                    end
+                    val () = setLabelInfo (label, li)
+                    val () = LabelInfo.whenUsed (li, visitBlockTh (block, fi))
+                 in
+                    ()
+                 end)
+          in
+             ()
+          end)
       val () = visitFunc main
 
       (* Diagnostics *)
       val () = 
-	 Control.diagnostics
-	 (fn display =>
-	  let open Layout
-	  in 
-	     Vector.foreach
-	     (datatypes, fn Datatype.T {tycon, cons} =>
-	      display (seq [Tycon.layout tycon,
-			    str ": ",
-			    TyconInfo.layout (tyconInfo tycon),
-			    str ": ",
-			    Vector.layout
-			    (fn {con, ...} =>
-			     seq [Con.layout con,
-				  str " ",
-				  ConInfo.layout (conInfo con)])
-			    cons]));
-	     display (str "\n");
-	     List.foreach
-	     (functions, fn f =>
-	      let
-		 val {name, blocks, ...} = Function.dest f
-	      in
-		 display (seq [Func.layout name,
-			       str ": ",
-			       FuncInfo.layout (funcInfo name)]);
-		 Vector.foreach
-		 (blocks, fn Block.T {label, ...} =>
-		  display (seq [Label.layout label,
-				str ": ",
-				LabelInfo.layout (labelInfo label)]));
-		 display (str "\n")
-	      end)
-	  end)
+         Control.diagnostics
+         (fn display =>
+          let open Layout
+          in 
+             Vector.foreach
+             (datatypes, fn Datatype.T {tycon, cons} =>
+              display (seq [Tycon.layout tycon,
+                            str ": ",
+                            TyconInfo.layout (tyconInfo tycon),
+                            str ": ",
+                            Vector.layout
+                            (fn {con, ...} =>
+                             seq [Con.layout con,
+                                  str " ",
+                                  ConInfo.layout (conInfo con)])
+                            cons]));
+             display (str "\n");
+             List.foreach
+             (functions, fn f =>
+              let
+                 val {name, blocks, ...} = Function.dest f
+              in
+                 display (seq [Func.layout name,
+                               str ": ",
+                               FuncInfo.layout (funcInfo name)]);
+                 Vector.foreach
+                 (blocks, fn Block.T {label, ...} =>
+                  display (seq [Label.layout label,
+                                str ": ",
+                                LabelInfo.layout (labelInfo label)]));
+                 display (str "\n")
+              end)
+          end)
 
       (* Analysis is done,  Now build the resulting program. *)
       fun getWrapperLabel (l: Label.t,
-			   args: (VarInfo.t * Type.t) vector) = 
-	 let
-	    val li = labelInfo l
-	 in
-	    if Vector.forall2 (args, LabelInfo.args li, fn ((x, _), (y, _)) =>
-			       VarInfo.isUsed x = VarInfo.isUsed y)
-	       then l
-	       else let
-		       val tys = 
-			  Vector.keepAllMap (args, fn (x, ty) =>
-					     if VarInfo.isUsed x
-						then SOME ty
-						else NONE)
-		    in 
-		       case List.peek 
-			    (LabelInfo.wrappers li, fn (args', _) =>
-			     Vector.length args' = Vector.length tys
-			     andalso
-			     Vector.forall2 (args', tys, fn (ty', ty) =>
-					     Type.equals (ty', ty))) of
-			  NONE => 
-			     let
-				val liArgs = LabelInfo.args li
-				val l' = Label.newNoname ()
-				val (args', args'') = 
-				   Vector.unzip
-				   (Vector.map2
-				    (args, liArgs, fn ((x, ty), (y, _)) =>
-				     let
-					val z = Var.newNoname ()
-				     in
-					(if VarInfo.isUsed x 
-					    then SOME (z, ty) else NONE,
-					 if VarInfo.isUsed y 
-					    then SOME z else NONE)
-				     end))
-				val args' = 
-				   Vector.keepAllMap (args', fn x => x)
-				val (_, tys') = Vector.unzip args'
-				val args'' = 
-				   Vector.keepAllMap (args'', fn x => x)
-				val block = 
-				   Block.T {label = l',
-					    args =  args',
-					    statements = Vector.new0 (),
-					    transfer = Goto {dst = l,
-							     args = args''}}
-				val () = 
-				   List.push (LabelInfo.wrappers' li, 
-					      (tys', l'))
-				val () =
-				   List.push (FuncInfo.wrappers' (LabelInfo.func li), 
-					      block)
-			     in
-				l'
-			     end
-			| SOME (_, l') => l'
-		    end
-	 end
+                           args: (VarInfo.t * Type.t) vector) = 
+         let
+            val li = labelInfo l
+         in
+            if Vector.forall2 (args, LabelInfo.args li, fn ((x, _), (y, _)) =>
+                               VarInfo.isUsed x = VarInfo.isUsed y)
+               then l
+               else let
+                       val tys = 
+                          Vector.keepAllMap (args, fn (x, ty) =>
+                                             if VarInfo.isUsed x
+                                                then SOME ty
+                                                else NONE)
+                    in 
+                       case List.peek 
+                            (LabelInfo.wrappers li, fn (args', _) =>
+                             Vector.length args' = Vector.length tys
+                             andalso
+                             Vector.forall2 (args', tys, fn (ty', ty) =>
+                                             Type.equals (ty', ty))) of
+                          NONE => 
+                             let
+                                val liArgs = LabelInfo.args li
+                                val l' = Label.newNoname ()
+                                val (args', args'') = 
+                                   Vector.unzip
+                                   (Vector.map2
+                                    (args, liArgs, fn ((x, ty), (y, _)) =>
+                                     let
+                                        val z = Var.newNoname ()
+                                     in
+                                        (if VarInfo.isUsed x 
+                                            then SOME (z, ty) else NONE,
+                                         if VarInfo.isUsed y 
+                                            then SOME z else NONE)
+                                     end))
+                                val args' = 
+                                   Vector.keepAllMap (args', fn x => x)
+                                val (_, tys') = Vector.unzip args'
+                                val args'' = 
+                                   Vector.keepAllMap (args'', fn x => x)
+                                val block = 
+                                   Block.T {label = l',
+                                            args =  args',
+                                            statements = Vector.new0 (),
+                                            transfer = Goto {dst = l,
+                                                             args = args''}}
+                                val () = 
+                                   List.push (LabelInfo.wrappers' li, 
+                                              (tys', l'))
+                                val () =
+                                   List.push (FuncInfo.wrappers' (LabelInfo.func li), 
+                                              block)
+                             in
+                                l'
+                             end
+                        | SOME (_, l') => l'
+                    end
+         end
       val getContWrapperLabel = getWrapperLabel
       val getHandlerWrapperLabel = getWrapperLabel
       fun getOriginalWrapperLabel l =
-	 getWrapperLabel 
-	 (l, Vector.map (LabelInfo.args (labelInfo l), fn (_, t) =>
-			 let 
-			    val x = VarInfo.new t
-			    val () = VarInfo.use x
-			 in
-			    (x, t)
-			 end))
+         getWrapperLabel 
+         (l, Vector.map (LabelInfo.args (labelInfo l), fn (_, t) =>
+                         let 
+                            val x = VarInfo.new t
+                            val () = VarInfo.use x
+                         in
+                            (x, t)
+                         end))
       val getArithOverflowWrapperLabel = getOriginalWrapperLabel
       val getArithSuccessWrapperLabel = getOriginalWrapperLabel
       val getRuntimeWrapperLabel = getOriginalWrapperLabel
       fun getBugFunc (fi: FuncInfo.t): Label.t =
-	 (* Can't share the Bug block across different places because the
-	  * profile sourceInfo stack might be different.
-	  *)
-	 let
-	    val l = Label.newNoname ()
-	    val block = Block.T {label = l,
-				 args = Vector.new0 (),
-				 statements = Vector.new0 (),
-				 transfer = Bug}
-	    val () = List.push (FuncInfo.wrappers' fi, block)
-	 in
-	    l
-	 end
+         (* Can't share the Bug block across different places because the
+          * profile sourceInfo stack might be different.
+          *)
+         let
+            val l = Label.newNoname ()
+            val block = Block.T {label = l,
+                                 args = Vector.new0 (),
+                                 statements = Vector.new0 (),
+                                 transfer = Bug}
+            val () = List.push (FuncInfo.wrappers' fi, block)
+         in
+            l
+         end
       fun getReturnFunc (fi: FuncInfo.t): Label.t =
-	 let
-	    val r = FuncInfo.returnLabel fi
-	 in
-	    case !r of 
-	       NONE => 
-		  let
-		     val l = Label.newNoname ()
-		     val returns = valOf (FuncInfo.returns fi)
-		     val args = 
-			Vector.keepAllMap
-		        (returns, fn (vi, ty) =>
-			 if VarInfo.isUsed vi
-			    then SOME (Var.newNoname (), ty)
-			    else NONE)
-		     val xs = Vector.map (args, #1)
-		     val block = Block.T {label = l,
-					  args = args,
-					  statements = Vector.new0 (),
-					  transfer = Return xs}
-		     val () = r := SOME l
-		     val () = List.push (FuncInfo.wrappers' fi, block)
-		     val () = setLabelInfo (l, LabelInfo.new {func = fi,
-							      args = returns})
-		  in
-		     l
-		  end
-	     | SOME l => l
-	 end
+         let
+            val r = FuncInfo.returnLabel fi
+         in
+            case !r of 
+               NONE => 
+                  let
+                     val l = Label.newNoname ()
+                     val returns = valOf (FuncInfo.returns fi)
+                     val args = 
+                        Vector.keepAllMap
+                        (returns, fn (vi, ty) =>
+                         if VarInfo.isUsed vi
+                            then SOME (Var.newNoname (), ty)
+                            else NONE)
+                     val xs = Vector.map (args, #1)
+                     val block = Block.T {label = l,
+                                          args = args,
+                                          statements = Vector.new0 (),
+                                          transfer = Return xs}
+                     val () = r := SOME l
+                     val () = List.push (FuncInfo.wrappers' fi, block)
+                     val () = setLabelInfo (l, LabelInfo.new {func = fi,
+                                                              args = returns})
+                  in
+                     l
+                  end
+             | SOME l => l
+         end
       fun getReturnContFunc (fi, args) = 
-	 getWrapperLabel (getReturnFunc fi, args)
+         getWrapperLabel (getReturnFunc fi, args)
       fun getRaiseFunc (fi: FuncInfo.t): Label.t =
-	 let
-	    val r = FuncInfo.raiseLabel fi
-	 in
-	    case !r of 
-	       NONE => 
-		  let
-		     val l = Label.newNoname ()
-		     val raises = valOf (FuncInfo.raises fi)
-		     val args = 
-			Vector.keepAllMap
-		        (raises, fn (vi, ty) =>
-			 if VarInfo.isUsed vi
-			    then SOME (Var.newNoname (), ty)
-			    else NONE)
-		     val xs = Vector.map (args, #1)
-		     val block = Block.T {label = l,
-					  args = args,
-					  statements = Vector.new0 (),
-					  transfer = Raise xs}
-		     val () = r := SOME l
-		     val () = List.push (FuncInfo.wrappers' fi, block)
-		     val () = setLabelInfo (l, LabelInfo.new {func = fi,
-							      args = raises})
-		  in
-		     l
-		  end
-	     | SOME l => l
-	 end
+         let
+            val r = FuncInfo.raiseLabel fi
+         in
+            case !r of 
+               NONE => 
+                  let
+                     val l = Label.newNoname ()
+                     val raises = valOf (FuncInfo.raises fi)
+                     val args = 
+                        Vector.keepAllMap
+                        (raises, fn (vi, ty) =>
+                         if VarInfo.isUsed vi
+                            then SOME (Var.newNoname (), ty)
+                            else NONE)
+                     val xs = Vector.map (args, #1)
+                     val block = Block.T {label = l,
+                                          args = args,
+                                          statements = Vector.new0 (),
+                                          transfer = Raise xs}
+                     val () = r := SOME l
+                     val () = List.push (FuncInfo.wrappers' fi, block)
+                     val () = setLabelInfo (l, LabelInfo.new {func = fi,
+                                                              args = raises})
+                  in
+                     l
+                  end
+             | SOME l => l
+         end
       fun getRaiseHandlerFunc (fi, args) = getWrapperLabel (getRaiseFunc fi, args)
 
 
       val () =
-	 Vector.foreach
-	 (datatypes, fn Datatype.T {tycon, cons} =>
-	  let
-	     val dummy : ({con: Con.t, args: Type.t Prod.t} * Exp.t) option ref = ref NONE
-	  in
-	     Vector.foreach
-	     (cons, fn {con, ...} =>
-	      let
-		 val ci = conInfo con
-	      in
-		 case (ConInfo.isConed ci,
-		       ConInfo.isDeconed ci) of
-		    (true, false) =>
-		       let
-			  val dummy =
-			     case !dummy of 
-				NONE => 
-				   let
-				      val con = Con.newString "dummy"
-				      val args = Prod.empty ()
-				      val () = newConInfo (con, args)
-				      val e = 
-					 Object 
-					 {con = SOME con,
-					  args = Vector.new0 ()}
-				      val res =
-					 ({con = con, args = args}, e)
-				   in
-				      dummy := SOME res
-				      ; res
-				   end
-			      | SOME dummy => dummy
-			  val () = ConInfo.dummy ci := SOME dummy
-		       in
-			  ()
-		       end
-		  | _ => ()
-	      end)
-	  end)
+         Vector.foreach
+         (datatypes, fn Datatype.T {cons, ...} =>
+          let
+             val dummy : ({con: Con.t, args: Type.t Prod.t} * Exp.t) option ref = ref NONE
+          in
+             Vector.foreach
+             (cons, fn {con, ...} =>
+              let
+                 val ci = conInfo con
+              in
+                 case (ConInfo.isConed ci,
+                       ConInfo.isDeconed ci) of
+                    (true, false) =>
+                       let
+                          val dummy =
+                             case !dummy of 
+                                NONE => 
+                                   let
+                                      val con = Con.newString "dummy"
+                                      val args = Prod.empty ()
+                                      val () = newConInfo (con, args)
+                                      val e = 
+                                         Object 
+                                         {con = SOME con,
+                                          args = Vector.new0 ()}
+                                      val res =
+                                         ({con = con, args = args}, e)
+                                   in
+                                      dummy := SOME res
+                                      ; res
+                                   end
+                              | SOME dummy => dummy
+                          val () = ConInfo.dummy ci := SOME dummy
+                       in
+                          ()
+                       end
+                  | _ => ()
+              end)
+          end)
 
       fun simplifyType (ty: Type.t): Type.t =
-	 let
-	    val ti = typeInfo ty
-	    val simplify = TypeInfo.simplify' ti
-	 in
-	    case !simplify of
-	       NONE => let
-			  datatype z = datatype Type.dest
-			  datatype z = datatype ObjectCon.t
-			  val ty =
-			     case Type.dest ty of
-				Object {args, con} => 
-				   (case con of
-				       Con con => 
-					  let
-					     val ci = conInfo con
-					  in
-					     case ! (ConInfo.dummy ci) of
-						SOME ({args, con}, _) => 
-						   Type.object
-						   {args = args,
-						    con = Con con}
-					      | NONE => 
-						   Type.object 
-						   {args = Prod.keepAllMap 
-						    (ConInfo.args ci, fn (x,t) =>
-						     if VarInfo.isUsed x
-							then SOME (simplifyType t)
-							else NONE),
-						    con = Con con}
-					  end
-				     | _ => Type.object {args = Prod.map (args, simplifyType),
-							 con = con})
-			      | Weak ty => Type.weak (simplifyType ty)
-			      | _ => ty
-		       in
-			  simplify := SOME ty
-			  ; ty
-		       end
-	     | SOME ty => ty 
-	 end
+         let
+            val ti = typeInfo ty
+            val simplify = TypeInfo.simplify' ti
+         in
+            case !simplify of
+               NONE => let
+                          datatype z = datatype Type.dest
+                          datatype z = datatype ObjectCon.t
+                          val ty =
+                             case Type.dest ty of
+                                Object {args, con} => 
+                                   (case con of
+                                       Con con => 
+                                          let
+                                             val ci = conInfo con
+                                          in
+                                             case ! (ConInfo.dummy ci) of
+                                                SOME ({args, con}, _) => 
+                                                   Type.object
+                                                   {args = args,
+                                                    con = Con con}
+                                              | NONE => 
+                                                   Type.object 
+                                                   {args = Prod.keepAllMap 
+                                                    (ConInfo.args ci, fn (x,t) =>
+                                                     if VarInfo.isUsed x
+                                                        then SOME (simplifyType t)
+                                                        else NONE),
+                                                    con = Con con}
+                                          end
+                                     | _ => Type.object {args = Prod.map (args, simplifyType),
+                                                         con = con})
+                              | Weak ty => Type.weak (simplifyType ty)
+                              | _ => ty
+                       in
+                          simplify := SOME ty
+                          ; ty
+                       end
+             | SOME ty => ty 
+         end
 
       val datatypes =
-	 Vector.keepAllMap
-	 (datatypes, fn Datatype.T {tycon, cons} =>
-	  if isUsedTycon tycon
-	     then let
-		     val dummy : bool ref = ref false
-		     val cons =
-			Vector.keepAllMap
-			(cons, fn {con, ...} =>
-			 let
-			    val ci = conInfo con
-			 in
-			    case (ConInfo.isConed ci, 
-				  ConInfo.isDeconed ci) of
-			       (false, _) => NONE
-			     | (true, true) => 
-				  SOME {con = con,
-					args = Prod.keepAllMap
-					(ConInfo.args ci, fn (x, ty) =>
-					 if VarInfo.isUsed x
-					    then SOME (simplifyType ty)
-					    else NONE)}
-			     | (true, false) =>
-				  if !dummy
-				     then NONE
-				     else let
-					     val ({con, args}, _) =
-						valOf (! (ConInfo.dummy ci))
-					  in
-					     dummy := true
-					     ; SOME {con = con,
-						     args = args}
-					  end
-			 end)
-		     val num = Vector.length cons
-		     val () = TyconInfo.numCons' (tyconInfo tycon) := num
-		  in
-		     if 0 = num
-			then NONE
-			else SOME (Datatype.T {tycon = tycon, cons = cons})
-		  end
-	     else NONE)
+         Vector.keepAllMap
+         (datatypes, fn Datatype.T {tycon, cons} =>
+          if isUsedTycon tycon
+             then let
+                     val dummy : bool ref = ref false
+                     val cons =
+                        Vector.keepAllMap
+                        (cons, fn {con, ...} =>
+                         let
+                            val ci = conInfo con
+                         in
+                            case (ConInfo.isConed ci, 
+                                  ConInfo.isDeconed ci) of
+                               (false, _) => NONE
+                             | (true, true) => 
+                                  SOME {con = con,
+                                        args = Prod.keepAllMap
+                                        (ConInfo.args ci, fn (x, ty) =>
+                                         if VarInfo.isUsed x
+                                            then SOME (simplifyType ty)
+                                            else NONE)}
+                             | (true, false) =>
+                                  if !dummy
+                                     then NONE
+                                     else let
+                                             val ({con, args}, _) =
+                                                valOf (! (ConInfo.dummy ci))
+                                          in
+                                             dummy := true
+                                             ; SOME {con = con,
+                                                     args = args}
+                                          end
+                         end)
+                     val num = Vector.length cons
+                     val () = TyconInfo.numCons' (tyconInfo tycon) := num
+                  in
+                     if 0 = num
+                        then NONE
+                        else SOME (Datatype.T {tycon = tycon, cons = cons})
+                  end
+             else NONE)
 
       fun simplifyExp (e: Exp.t): Exp.t =
-	 case e of
-	    Object {con, args} =>
-	       (case con of
-		   NONE => e
-		 | SOME con => 
-		      let
-			 val ci = conInfo con
-		      in
-			 if ConInfo.isDeconed ci
-			    then let
-				    val ciArgs =
-				       Vector.map 
-				       (Prod.dest (ConInfo.args ci), #elt)
-				 in 
-				    Object {con = SOME con,
-					    args = (Vector.keepAllMap2
-						    (args, ciArgs, 
-						     fn (x, (y, _)) =>
-						     if VarInfo.isUsed y
-							then SOME x
-							else NONE))}
-				 end
-			    else #2 (valOf (! (ConInfo.dummy ci)))
-		      end)
-	  | Select {base, offset} => 
-	       let
-		  datatype z = datatype Base.t
-	       in
-		  case base of 
-		     Object base => 
-			let
-			   datatype z = datatype ObjectCon.t
-			   datatype z = datatype Type.dest
-			in
-			   case Type.dest (tyVar base) of
-			      Object {con, ...} =>
-				 (case con of
-				     Con con =>
-					let
-					   val ci = conInfo con
-					   val ciArgs = ConInfo.args ci
-					   val offset =
-					      Int.fold
-					      (0, offset, 0, fn (i, offset) =>
-					       if (VarInfo.isUsed o #1 o #elt)
-						  (Prod.sub (ciArgs, i))
-						  then offset + 1
-						  else offset)
-					in
-					   Select {base = Base.Object base,
-						   offset = offset}
-					end
-				   | Tuple => e
-				   | Vector => Error.bug "Update:non-Con|Tuple")
-			    | _ => Error.bug "Select:non-Object"
-			end
-		   | _ => e
-	       end
-	  | _ => e
+         case e of
+            Object {con, args} =>
+               (case con of
+                   NONE => e
+                 | SOME con => 
+                      let
+                         val ci = conInfo con
+                      in
+                         if ConInfo.isDeconed ci
+                            then let
+                                    val ciArgs =
+                                       Vector.map 
+                                       (Prod.dest (ConInfo.args ci), #elt)
+                                 in 
+                                    Object {con = SOME con,
+                                            args = (Vector.keepAllMap2
+                                                    (args, ciArgs, 
+                                                     fn (x, (y, _)) =>
+                                                     if VarInfo.isUsed y
+                                                        then SOME x
+                                                        else NONE))}
+                                 end
+                            else #2 (valOf (! (ConInfo.dummy ci)))
+                      end)
+          | Select {base, offset} => 
+               let
+                  datatype z = datatype Base.t
+               in
+                  case base of 
+                     Object base => 
+                        let
+                           datatype z = datatype ObjectCon.t
+                           datatype z = datatype Type.dest
+                        in
+                           case Type.dest (tyVar base) of
+                              Object {con, ...} =>
+                                 (case con of
+                                     Con con =>
+                                        let
+                                           val ci = conInfo con
+                                           val ciArgs = ConInfo.args ci
+                                           val offset =
+                                              Int.fold
+                                              (0, offset, 0, fn (i, offset) =>
+                                               if (VarInfo.isUsed o #1 o #elt)
+                                                  (Prod.sub (ciArgs, i))
+                                                  then offset + 1
+                                                  else offset)
+                                        in
+                                           Select {base = Base.Object base,
+                                                   offset = offset}
+                                        end
+                                   | Tuple => e
+                                   | Vector => Error.bug "RemoveUnused2.simplifyExp: Update:non-Con|Tuple")
+                            | _ => Error.bug "RemoveUnused2.simplifyExp:Select:non-Object"
+                        end
+                   | _ => e
+               end
+          | _ => e
       val simplifyExp =
-	 Trace.trace 
-	 ("RemoveUnused.simplifyExp", 
-	  Exp.layout, Exp.layout)
-	 simplifyExp
+         Trace.trace 
+         ("RemoveUnused2.simplifyExp", 
+          Exp.layout, Exp.layout)
+         simplifyExp
       fun simplifyStatement (s : Statement.t) : Statement.t option =
-	 case s of
-	    Bind {exp, ty, var} =>
-	       let
-		  fun doit' var = 
-		     SOME (Statement.Bind 
-			   {var = var,
-			    ty = simplifyType ty,
-			    exp = simplifyExp exp})
-		  fun doit var' =
-		     if Exp.maySideEffect exp
-			then doit' var
-			else if isSome var'
-				then doit' var'
-				else NONE
-	       in
-		  case var of
-		     SOME var => if isUsedVar var
-				    then doit (SOME var)
-				    else doit NONE
-		   | NONE => doit NONE
-	       end
-	  | Profile _ => SOME s
-	  | Update {base, offset, value} =>
-	       let
-		  datatype z = datatype Base.t
-	       in
-		  case base of 
-		     Object base => 
-			let
-			   datatype z = datatype ObjectCon.t
-			   datatype z = datatype Type.dest
-			in
-			   case Type.dest (tyVar base) of
-			      Object {con, ...} =>
-				 (case con of
-				     Con con =>
-					let
-					   val ci = conInfo con
-					   val ciArgs = ConInfo.args ci
-					   fun argIsUsed i =
-					      VarInfo.isUsed
-					      (#1 (#elt (Prod.sub (ciArgs, i))))
-					in
-					   if argIsUsed offset
-					      then
-						 let
-						    val offset =
-						       Int.fold
-						       (0, offset, 0,
-							fn (i, offset) =>
-							if argIsUsed i
-							   then offset + 1
-							else offset)
-						 in
-						    SOME
-						    (Update
-						     {base = Base.Object base,
-						      offset = offset, 
-						      value = value})
-						 end
-					   else NONE
-					end
-				   | Tuple => SOME s
-				   | Vector => Error.bug "Update:non-Con|Tuple")
-			    | _ => Error.bug "Select:non-Object"
-			end
-		   | _ => SOME s
-	       end
+         case s of
+            Bind {exp, ty, var} =>
+               let
+                  fun doit' var = 
+                     SOME (Statement.Bind 
+                           {var = var,
+                            ty = simplifyType ty,
+                            exp = simplifyExp exp})
+                  fun doit var' =
+                     if Exp.maySideEffect exp
+                        then doit' var
+                        else if isSome var'
+                                then doit' var'
+                                else NONE
+               in
+                  case var of
+                     SOME var => if isUsedVar var
+                                    then doit (SOME var)
+                                    else doit NONE
+                   | NONE => doit NONE
+               end
+          | Profile _ => SOME s
+          | Update {base, offset, value} =>
+               let
+                  datatype z = datatype Base.t
+               in
+                  case base of 
+                     Object base => 
+                        let
+                           datatype z = datatype ObjectCon.t
+                           datatype z = datatype Type.dest
+                        in
+                           case Type.dest (tyVar base) of
+                              Object {con, ...} =>
+                                 (case con of
+                                     Con con =>
+                                        let
+                                           val ci = conInfo con
+                                           val ciArgs = ConInfo.args ci
+                                           fun argIsUsed i =
+                                              VarInfo.isUsed
+                                              (#1 (#elt (Prod.sub (ciArgs, i))))
+                                        in
+                                           if argIsUsed offset
+                                              then
+                                                 let
+                                                    val offset =
+                                                       Int.fold
+                                                       (0, offset, 0,
+                                                        fn (i, offset) =>
+                                                        if argIsUsed i
+                                                           then offset + 1
+                                                        else offset)
+                                                 in
+                                                    SOME
+                                                    (Update
+                                                     {base = Base.Object base,
+                                                      offset = offset, 
+                                                      value = value})
+                                                 end
+                                           else NONE
+                                        end
+                                   | Tuple => SOME s
+                                   | Vector => Error.bug "RemoveUnused2.simplifyStatement: Update:non-Con|Tuple")
+                            | _ => Error.bug "RemoveUnused2.simplifyStatement: Select:non-Object"
+                        end
+                   | _ => SOME s
+               end
       fun simplifyStatements (ss: Statement.t Vector.t) : Statement.t Vector.t =
-	 Vector.keepAllMap (ss, simplifyStatement)
+         Vector.keepAllMap (ss, simplifyStatement)
       fun simplifyTransfer (t: Transfer.t, fi: FuncInfo.t): Transfer.t =
-	 case t of
-	    Arith {prim, args, overflow, success, ty} =>
-	       Arith {prim = prim,
-		      args = args,
-		      overflow = getArithOverflowWrapperLabel overflow,
-		      success = getArithSuccessWrapperLabel success,
-		      ty = simplifyType ty}
-	  | Bug => Bug
-	  | Call {func, args, return} =>
-	       let
-		  val fi' = funcInfo func
-		  datatype u = None
-		             | Caller
-		             | Some of Label.t
-		  val (cont, handler) =
-		     case return of
-			Return.Dead => (None, None)
-		      | Return.NonTail {cont, handler} =>
-			   (Some cont,
-			    case handler of
-			       Handler.Caller => Caller
-			     | Handler.Dead => None
-			     | Handler.Handle h => Some h)
-		      | Return.Tail => (Caller, Caller)
-		  val cont = 
-		     if FuncInfo.mayReturn fi'
-			then case cont of 
-			        None => Error.bug "cont:None"
-			      | Caller =>
-				   if (case (FuncInfo.returns fi,
-					     FuncInfo.returns fi') of
-					  (SOME xts, SOME yts) =>
-					     Vector.forall2
-					     (xts, yts, fn ((x, _), (y, _)) =>
-					      VarInfo.isUsed x = VarInfo.isUsed y)
-					| _ => Error.bug "cont:Caller")
-				      then Caller
-				      else Some (getReturnContFunc
-						 (fi, valOf (FuncInfo.returns fi')))
-			      | Some l => 
-				   Some (getContWrapperLabel
-					 (l, valOf (FuncInfo.returns fi')))
-			else None
-		  val handler =
-		     if FuncInfo.mayRaise fi'
-			then case handler of
-			        None => Error.bug "handler:None"
-			      | Caller =>
-				   if (case (FuncInfo.raises fi,
-					     FuncInfo.raises fi') of
-					  (SOME xts, SOME yts) =>
-					     Vector.forall2
-					     (xts, yts, fn ((x, _), (y, _)) =>
-					      VarInfo.isUsed x = VarInfo.isUsed y)
-					| _ => Error.bug "handler:Caller")
-				      then Caller
-				      else Some (getRaiseHandlerFunc
-						 (fi, valOf (FuncInfo.raises fi')))
-			      | Some l =>
-				   Some (getHandlerWrapperLabel
-					 (l, valOf (FuncInfo.raises fi')))
-			else None
-		  val return =
-		     case (cont, handler) of
-			(None, None) => Return.Dead
-		      | (None, Caller) => Return.Tail
-		      | (None, Some h) =>
-			   Return.NonTail
-			   {cont = getBugFunc fi,
-			    handler = Handler.Handle h}
-		      | (Caller, None) => Return.Tail
-		      | (Caller, Caller) => Return.Tail
-		      | (Caller, Some h) =>
-			   Return.NonTail
-			   {cont = getReturnContFunc
-			    (fi, valOf (FuncInfo.returns fi')),
-			    handler = Handler.Handle h}
-		      | (Some c, None) =>
-			   Return.NonTail
-			   {cont = c,
-			    handler = Handler.Dead}
-		      | (Some c, Caller) =>
-			   Return.NonTail
-			   {cont = c,
-			    handler = Handler.Caller}
-		      | (Some c, Some h) =>
-			   Return.NonTail 
-			   {cont = c,
-			    handler = Handler.Handle h}
+         case t of
+            Arith {prim, args, overflow, success, ty} =>
+               Arith {prim = prim,
+                      args = args,
+                      overflow = getArithOverflowWrapperLabel overflow,
+                      success = getArithSuccessWrapperLabel success,
+                      ty = simplifyType ty}
+          | Bug => Bug
+          | Call {func, args, return} =>
+               let
+                  val fi' = funcInfo func
+                  datatype u = None
+                             | Caller
+                             | Some of Label.t
+                  val (cont, handler) =
+                     case return of
+                        Return.Dead => (None, None)
+                      | Return.NonTail {cont, handler} =>
+                           (Some cont,
+                            case handler of
+                               Handler.Caller => Caller
+                             | Handler.Dead => None
+                             | Handler.Handle h => Some h)
+                      | Return.Tail => (Caller, Caller)
+                  val cont = 
+                     if FuncInfo.mayReturn fi'
+                        then case cont of 
+                                None => Error.bug "RemoveUnused2.simplifyTransfer: cont:None"
+                              | Caller =>
+                                   if (case (FuncInfo.returns fi,
+                                             FuncInfo.returns fi') of
+                                          (SOME xts, SOME yts) =>
+                                             Vector.forall2
+                                             (xts, yts, fn ((x, _), (y, _)) =>
+                                              VarInfo.isUsed x = VarInfo.isUsed y)
+                                        | _ => Error.bug "RemoveUnused2.simplifyTransfer: cont:Caller")
+                                      then Caller
+                                      else Some (getReturnContFunc
+                                                 (fi, valOf (FuncInfo.returns fi')))
+                              | Some l => 
+                                   Some (getContWrapperLabel
+                                         (l, valOf (FuncInfo.returns fi')))
+                        else None
+                  val handler =
+                     if FuncInfo.mayRaise fi'
+                        then case handler of
+                                None => Error.bug "RemoveUnused2.simplifyTransfer: handler:None"
+                              | Caller =>
+                                   if (case (FuncInfo.raises fi,
+                                             FuncInfo.raises fi') of
+                                          (SOME xts, SOME yts) =>
+                                             Vector.forall2
+                                             (xts, yts, fn ((x, _), (y, _)) =>
+                                              VarInfo.isUsed x = VarInfo.isUsed y)
+                                        | _ => Error.bug "RemoveUnused2.simplifyTransfer: handler:Caller")
+                                      then Caller
+                                      else Some (getRaiseHandlerFunc
+                                                 (fi, valOf (FuncInfo.raises fi')))
+                              | Some l =>
+                                   Some (getHandlerWrapperLabel
+                                         (l, valOf (FuncInfo.raises fi')))
+                        else None
+                  val return =
+                     case (cont, handler) of
+                        (None, None) => Return.Dead
+                      | (None, Caller) => Return.Tail
+                      | (None, Some h) =>
+                           Return.NonTail
+                           {cont = getBugFunc fi,
+                            handler = Handler.Handle h}
+                      | (Caller, None) => Return.Tail
+                      | (Caller, Caller) => Return.Tail
+                      | (Caller, Some h) =>
+                           Return.NonTail
+                           {cont = getReturnContFunc
+                            (fi, valOf (FuncInfo.returns fi')),
+                            handler = Handler.Handle h}
+                      | (Some c, None) =>
+                           Return.NonTail
+                           {cont = c,
+                            handler = Handler.Dead}
+                      | (Some c, Caller) =>
+                           Return.NonTail
+                           {cont = c,
+                            handler = Handler.Caller}
+                      | (Some c, Some h) =>
+                           Return.NonTail 
+                           {cont = c,
+                            handler = Handler.Handle h}
 
-		  val args =
-		     Vector.keepAllMap2
-		     (args, FuncInfo.args fi', fn (x, (y, _)) =>
-		      if VarInfo.isUsed y
-			 then SOME x
-			 else NONE)
-	       in 
-		  Call {func = func,
-			args = args,
-			return = return}
-	       end 
-	  | Case {test, cases = Cases.Con cases, default} =>
-	       let
-		  val cases =
-		     Vector.keepAllMap
-		     (cases, fn (con, l) =>
-		      let
-			 val ci = conInfo con
-		      in
-			 if ConInfo.isConed ci
-			    then SOME (con, l)
-			    else NONE
-		      end)
-		  fun keep default = Case {test = test,
-					   cases = Cases.Con cases,
-					   default = default}
-		  fun none () = keep NONE
-	       in
-		  case default of
-		     NONE => none ()
-		   | SOME l => if Vector.length cases = 0
-				  then if LabelInfo.isUsed (labelInfo l)
-					  then Goto {dst = l, args = Vector.new0 ()}
-					  else Bug
-				  else let
-					  val tycon = 
-					     case Type.dest (tyVar test) of
-						Type.Datatype tycon => tycon
-					      | _ => Error.bug "Case:non-Datatype"
-					  val numCons = TyconInfo.numCons (tyconInfo tycon)
-				       in 
-					  if Vector.length cases = numCons
-					     then none ()
-					     else keep (SOME l)
-				       end
-	       end
-	  | Case {test, cases, default} =>
-	       Case {test = test,
-		     cases = cases,
-		     default = default}
-	  | Goto {dst, args} =>
-	       Goto {dst = dst, 
-		     args = (Vector.keepAllMap2
-			     (args, LabelInfo.args (labelInfo dst),
-			      fn (x, (y, _)) => if VarInfo.isUsed y
-						   then SOME x
-						   else NONE))}
-	  | Raise xs =>
-	       Raise (Vector.keepAllMap2
-		      (xs, valOf (FuncInfo.raises fi),
-		       fn (x, (y, _)) => if VarInfo.isUsed y
-					    then SOME x
-					    else NONE))
-	  | Return xs =>
-	       Return (Vector.keepAllMap2
-		       (xs, valOf (FuncInfo.returns fi),
-			fn (x, (y, _)) => if VarInfo.isUsed y
-					     then SOME x
-					     else NONE))
-	  | Runtime {prim, args, return} =>
-	       Runtime {prim = prim,
-			args = args,
-			return = getRuntimeWrapperLabel return}
+                  val args =
+                     Vector.keepAllMap2
+                     (args, FuncInfo.args fi', fn (x, (y, _)) =>
+                      if VarInfo.isUsed y
+                         then SOME x
+                         else NONE)
+               in 
+                  Call {func = func,
+                        args = args,
+                        return = return}
+               end 
+          | Case {test, cases = Cases.Con cases, default} =>
+               let
+                  val cases =
+                     Vector.keepAllMap
+                     (cases, fn (con, l) =>
+                      let
+                         val ci = conInfo con
+                      in
+                         if ConInfo.isConed ci
+                            then SOME (con, l)
+                            else NONE
+                      end)
+                  fun keep default = Case {test = test,
+                                           cases = Cases.Con cases,
+                                           default = default}
+                  fun none () = keep NONE
+               in
+                  case default of
+                     NONE => none ()
+                   | SOME l => if Vector.length cases = 0
+                                  then if LabelInfo.isUsed (labelInfo l)
+                                          then Goto {dst = l, args = Vector.new0 ()}
+                                          else Bug
+                                  else let
+                                          val tycon = 
+                                             case Type.dest (tyVar test) of
+                                                Type.Datatype tycon => tycon
+                                              | _ => Error.bug "RemoveUnused2.simplifyTransfer: Case:non-Datatype"
+                                          val numCons = TyconInfo.numCons (tyconInfo tycon)
+                                       in 
+                                          if Vector.length cases = numCons
+                                             then none ()
+                                             else keep (SOME l)
+                                       end
+               end
+          | Case {test, cases, default} =>
+               Case {test = test,
+                     cases = cases,
+                     default = default}
+          | Goto {dst, args} =>
+               Goto {dst = dst, 
+                     args = (Vector.keepAllMap2
+                             (args, LabelInfo.args (labelInfo dst),
+                              fn (x, (y, _)) => if VarInfo.isUsed y
+                                                   then SOME x
+                                                   else NONE))}
+          | Raise xs =>
+               Raise (Vector.keepAllMap2
+                      (xs, valOf (FuncInfo.raises fi),
+                       fn (x, (y, _)) => if VarInfo.isUsed y
+                                            then SOME x
+                                            else NONE))
+          | Return xs =>
+               Return (Vector.keepAllMap2
+                       (xs, valOf (FuncInfo.returns fi),
+                        fn (x, (y, _)) => if VarInfo.isUsed y
+                                             then SOME x
+                                             else NONE))
+          | Runtime {prim, args, return} =>
+               Runtime {prim = prim,
+                        args = args,
+                        return = getRuntimeWrapperLabel return}
       val simplifyTransfer =
-	 Trace.trace 
-	 ("RemoveUnused.simplifyTransfer",
-	  Layout.tuple2 (Transfer.layout, FuncInfo.layout), Transfer.layout)
-	 simplifyTransfer
+         Trace.trace 
+         ("RemoveUnused2.simplifyTransfer",
+          Layout.tuple2 (Transfer.layout, FuncInfo.layout), Transfer.layout)
+         simplifyTransfer
       fun simplifyBlock (Block.T {label, args, statements, transfer}): Block.t option =
-	 let
-	    val li = labelInfo label
-	 in 
-	    if LabelInfo.isUsed li
-	       then let
-		       val args =
-			  Vector.keepAllMap2
-			  (LabelInfo.args li, args, fn ((vi, _), (x, ty)) =>
-			   if VarInfo.isUsed vi
-			      then SOME (x, simplifyType ty)
-			      else NONE)
-		       val statements = simplifyStatements statements
-		       val transfer =
-			  simplifyTransfer (transfer, LabelInfo.func li)
-		    in
-		       SOME (Block.T {label = label,
-				      args = args,
-				      statements = statements,
-				      transfer = transfer})
-		    end
-	       else NONE
-	 end
+         let
+            val li = labelInfo label
+         in 
+            if LabelInfo.isUsed li
+               then let
+                       val args =
+                          Vector.keepAllMap2
+                          (LabelInfo.args li, args, fn ((vi, _), (x, ty)) =>
+                           if VarInfo.isUsed vi
+                              then SOME (x, simplifyType ty)
+                              else NONE)
+                       val statements = simplifyStatements statements
+                       val transfer =
+                          simplifyTransfer (transfer, LabelInfo.func li)
+                    in
+                       SOME (Block.T {label = label,
+                                      args = args,
+                                      statements = statements,
+                                      transfer = transfer})
+                    end
+               else NONE
+         end
       fun simplifyBlocks (bs: Block.t Vector.t): Block.t Vector.t =
-	 Vector.keepAllMap (bs, simplifyBlock)
+         Vector.keepAllMap (bs, simplifyBlock)
       val globals = simplifyStatements globals
       val shrink = shrinkFunction {globals = globals}
       fun simplifyFunction (f: Function.t): Function.t option =
-	 let
-	    val {args, blocks, mayInline, name, start, ...} = Function.dest f
-	    val fi = funcInfo name
-	 in
-	    if FuncInfo.isUsed fi
-	       then let
-		       val args =
-			  Vector.keepAllMap2
-			  (FuncInfo.args fi, args, fn ((vi, _), (x, ty)) =>
-			   if VarInfo.isUsed vi
-			      then SOME (x, simplifyType ty)
-			      else NONE)
-		       val blocks = simplifyBlocks blocks
-		       val wrappers = Vector.fromList (FuncInfo.wrappers fi)
-		       val blocks = Vector.concat [wrappers, blocks]
-		       val returns =
-			  case FuncInfo.returns fi of
-			     NONE => NONE
-			   | SOME xts =>
-				if FuncInfo.mayReturn fi
-				   then SOME (Vector.keepAllMap
-					      (xts, fn (x, ty) => 
-					       if VarInfo.isUsed x
-						  then SOME (simplifyType ty)
-						  else NONE))
-				   else NONE
-		       val raises =
-			  case FuncInfo.raises fi of
-			     NONE => NONE
-			   | SOME xts =>
-				if FuncInfo.mayRaise fi
-				   then SOME (Vector.keepAllMap
-					      (xts, fn (x, ty) => 
-					       if VarInfo.isUsed x
-						  then SOME (simplifyType ty)
-						  else NONE))
-				   else NONE
-		    in
-		       SOME (shrink (Function.new {args = args,
-						   blocks = blocks,
-						   mayInline = mayInline,
-						   name = name,
-						   raises = raises,
-						   returns = returns,
-						   start = start}))
-		    end
-	       else NONE
-	 end
+         let
+            val {args, blocks, mayInline, name, start, ...} = Function.dest f
+            val fi = funcInfo name
+         in
+            if FuncInfo.isUsed fi
+               then let
+                       val args =
+                          Vector.keepAllMap2
+                          (FuncInfo.args fi, args, fn ((vi, _), (x, ty)) =>
+                           if VarInfo.isUsed vi
+                              then SOME (x, simplifyType ty)
+                              else NONE)
+                       val blocks = simplifyBlocks blocks
+                       val wrappers = Vector.fromList (FuncInfo.wrappers fi)
+                       val blocks = Vector.concat [wrappers, blocks]
+                       val returns =
+                          case FuncInfo.returns fi of
+                             NONE => NONE
+                           | SOME xts =>
+                                if FuncInfo.mayReturn fi
+                                   then SOME (Vector.keepAllMap
+                                              (xts, fn (x, ty) => 
+                                               if VarInfo.isUsed x
+                                                  then SOME (simplifyType ty)
+                                                  else NONE))
+                                   else NONE
+                       val raises =
+                          case FuncInfo.raises fi of
+                             NONE => NONE
+                           | SOME xts =>
+                                if FuncInfo.mayRaise fi
+                                   then SOME (Vector.keepAllMap
+                                              (xts, fn (x, ty) => 
+                                               if VarInfo.isUsed x
+                                                  then SOME (simplifyType ty)
+                                                  else NONE))
+                                   else NONE
+                    in
+                       SOME (shrink (Function.new {args = args,
+                                                   blocks = blocks,
+                                                   mayInline = mayInline,
+                                                   name = name,
+                                                   raises = raises,
+                                                   returns = returns,
+                                                   start = start}))
+                    end
+               else NONE
+         end
       fun simplifyFunctions (fs: Function.t List.t): Function.t List.t =
-	 List.keepAllMap (fs, simplifyFunction)
+         List.keepAllMap (fs, simplifyFunction)
       val functions = simplifyFunctions functions
       val program = Program.T {datatypes = datatypes,
-			       globals = globals,
-			       functions = functions,
-			       main = main}
+                               globals = globals,
+                               functions = functions,
+                               main = main}
       val _ = destroy ()
       val _ = Program.clearTop program
    in

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ssa/remove-unused2.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ssa/remove-unused2.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ssa/remove-unused2.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 type int = Int.t
    
 signature REMOVE_UNUSED2_STRUCTS = 
@@ -18,13 +19,3 @@
       
       val remove: Program.t -> Program.t
    end
-
-
-functor TestRemoveUnused2(S: REMOVE_UNUSED2) = 
-struct
-
-open S
-
-val _ = Assert.assert("RemoveUnused", fn () => true)
-
-end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ssa/restore.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ssa/restore.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ssa/restore.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,9 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 (* Restore SSA
@@ -33,26 +33,26 @@
 structure LabelInfo =
   struct
     datatype t = T of {args: (Var.t * Type.t) vector ref,
-		       preds: Label.t list ref,
-		       defs: bool vector ref,
-		       uses: bool vector ref,
-		       live: bool array ref,
-		       dtindex: int ref,
-		       df: Label.t vector Promise.t ref,
-		       phi: Var.t list ref,
-		       phiArgs: Var.t vector ref,
-		       queued: bool ref}
+                       preds: Label.t list ref,
+                       defs: bool vector ref,
+                       uses: bool vector ref,
+                       live: bool array ref,
+                       dtindex: int ref,
+                       df: Label.t vector Promise.t ref,
+                       phi: Var.t list ref,
+                       phiArgs: Var.t vector ref,
+                       queued: bool ref}
 
     fun layout (T {preds, defs, uses, live, dtindex, df, phiArgs, ...})
       = let open Layout
-	in record [("preds", List.layout Label.layout (!preds)),
-		   ("defs", Vector.layout Bool.layout (!defs)),
-		   ("uses", Vector.layout Bool.layout (!uses)),
-		   ("live", Array.layout Bool.layout (!live)),
-		   ("dtindex", Int.layout (!dtindex)),
-		   ("df", Promise.layout (Vector.layout Label.layout) (!df)),
-		   ("phiArgs", Vector.layout Var.layout (!phiArgs))]
-	end
+        in record [("preds", List.layout Label.layout (!preds)),
+                   ("defs", Vector.layout Bool.layout (!defs)),
+                   ("uses", Vector.layout Bool.layout (!uses)),
+                   ("live", Array.layout Bool.layout (!live)),
+                   ("dtindex", Int.layout (!dtindex)),
+                   ("df", Promise.layout (Vector.layout Label.layout) (!df)),
+                   ("phiArgs", Vector.layout Var.layout (!phiArgs))]
+        end
 
     local 
       fun make f (T r) = f r
@@ -71,22 +71,22 @@
     end
 
     fun new (): t = T {args = ref (Vector.new0 ()),
-		       preds = ref [],
-		       defs = ref (Vector.new0 ()),
-		       uses = ref (Vector.new0 ()),
-		       live = ref (Array.new0 ()),
-		       dtindex = ref ~1,
-		       df = ref (Promise.delay (fn () => Vector.new0 ())),
-		       phi = ref [],
-		       phiArgs = ref (Vector.new0 ()),
-		       queued = ref false}
+                       preds = ref [],
+                       defs = ref (Vector.new0 ()),
+                       uses = ref (Vector.new0 ()),
+                       live = ref (Array.new0 ()),
+                       dtindex = ref ~1,
+                       df = ref (Promise.delay (fn () => Vector.new0 ())),
+                       phi = ref [],
+                       phiArgs = ref (Vector.new0 ()),
+                       queued = ref false}
   end
 
 structure Cardinality =
   struct
     structure L = ThreePointLattice(val bottom = "zero"
-				    val mid = "one"
-				    val top = "many")
+                                    val mid = "one"
+                                    val top = "many")
     open L
 
     val isZero = isBottom
@@ -98,29 +98,29 @@
 
     val inc: t -> unit
       = fn c => if isZero c
-		  then makeOne c
-		else if isOne c
-		  then makeMany c
-		else ()
+                  then makeOne c
+                else if isOne c
+                  then makeMany c
+                else ()
    end
 
 structure VarInfo =
   struct
     datatype t = T of {defs: Cardinality.t,
-		       ty: Type.t ref,
-		       index: int ref,
-		       defSites: Label.t list ref,
-		       useSites: Label.t list ref,
-		       vars: Var.t list ref}
+                       ty: Type.t ref,
+                       index: int ref,
+                       defSites: Label.t list ref,
+                       useSites: Label.t list ref,
+                       vars: Var.t list ref}
 
     fun layout (T {defs, index, defSites, useSites, vars, ...})
       = let open Layout
-	in record [("defs", Cardinality.layout defs),
-		   ("index", Int.layout (!index)),
-		   ("defSites", List.layout Label.layout (!defSites)),
-		   ("useSites", List.layout Label.layout (!useSites)),
-		   ("vars", List.layout Var.layout (!vars))]
-	end
+        in record [("defs", Cardinality.layout defs),
+                   ("index", Int.layout (!index)),
+                   ("defSites", List.layout Label.layout (!defSites)),
+                   ("useSites", List.layout Label.layout (!useSites)),
+                   ("vars", List.layout Var.layout (!vars))]
+        end
 
     local 
       fun make f (T r) = f r
@@ -139,17 +139,17 @@
     fun whenViolates (T {defs, ...}, th) = Cardinality.whenMany (defs, th)
 
     fun new (): t = T {defs = Cardinality.new (),
-		       index = ref ~1,
-		       defSites = ref [],
-		       useSites = ref [],
-		       ty = ref Type.unit,
-		       vars = ref []}
+                       index = ref ~1,
+                       defSites = ref [],
+                       useSites = ref [],
+                       ty = ref Type.unit,
+                       vars = ref []}
 
     fun pushVar (T {vars, ...}, var) = List.push (vars, var)
     fun popVar (T {vars, ...}) = ignore (List.pop vars)
     fun peekVar (T {vars, ...}) = case !vars
-				    of [] => NONE
-				     | h::_ => SOME h
+                                    of [] => NONE
+                                     | h::_ => SOME h
   end
 
 fun restoreFunction {globals: Statement.t vector}
@@ -157,511 +157,507 @@
       exception NoViolations
 
       val {get = varInfo: Var.t -> VarInfo.t, ...}
-	= Property.get
-	  (Var.plist, Property.initFun (fn _ => VarInfo.new ()))
+        = Property.get
+          (Var.plist, Property.initFun (fn _ => VarInfo.new ()))
 
       val {get = labelInfo: Label.t -> LabelInfo.t, ...}
-	= Property.get
-	  (Label.plist, Property.initFun (fn _ => LabelInfo.new ()))
+        = Property.get
+          (Label.plist, Property.initFun (fn _ => LabelInfo.new ()))
 
       fun mkQueue ()
-	= let
-	    val todo = ref []
-	  in
-	    {enque = fn (l, li) => let 
-				     val queued = LabelInfo.queued li
-				   in
-				     if !queued
-				       then ()
-				       else (queued := true ; 
-					     List.push (todo, (l,li)))
-				   end,
-	     deque = fn () => case !todo
-				of [] => NONE
-		                 | (l,li)::todo' 
-				 => (todo := todo';
-				     LabelInfo.queued li := false;
-				     SOME (l,li))}
-	  end
+        = let
+            val todo = ref []
+          in
+            {enque = fn (l, li) => let 
+                                     val queued = LabelInfo.queued li
+                                   in
+                                     if !queued
+                                       then ()
+                                       else (queued := true ; 
+                                             List.push (todo, (l,li)))
+                                   end,
+             deque = fn () => case !todo
+                                of [] => NONE
+                                 | (l,li)::todo' 
+                                 => (todo := todo';
+                                     LabelInfo.queued li := false;
+                                     SOME (l,li))}
+          end
 
       fun mkPost ()
-	= let
-	    val post = ref []
-	  in
-	    {addPost = fn th => List.push (post, th),
-	     post = fn () => List.foreach(!post, fn th => th ())}
-	  end
+        = let
+            val post = ref []
+          in
+            {addPost = fn th => List.push (post, th),
+             post = fn () => List.foreach(!post, fn th => th ())}
+          end
 
       (* check for violations in globals *)
       fun addDef (x, ty) 
-	= let
-	    val vi = varInfo x
-	  in
-	    VarInfo.ty vi := ty ;
-	    VarInfo.addDef vi ;
-	    VarInfo.whenViolates 
-	    (vi, fn () => Error.bug "Restore.restore: violation in globals")
-	  end
+        = let
+            val vi = varInfo x
+          in
+            VarInfo.ty vi := ty ;
+            VarInfo.addDef vi ;
+            VarInfo.whenViolates 
+            (vi, fn () => Error.bug "Restore.restore: violation in globals")
+          end
       val _
-	= Vector.foreach
-	  (globals, fn Statement.T {var, ty, ...} =>
-	   Option.app (var, fn x => addDef (x, ty)))
+        = Vector.foreach
+          (globals, fn Statement.T {var, ty, ...} =>
+           Option.app (var, fn x => addDef (x, ty)))
     in
       fn (f: Function.t) =>
       let
-	val {args, blocks, mayInline, name, returns, raises, start} =
-	   Function.dest f
-	(* check for violations *)
-	val violations = ref []
-	fun addDef (x, ty)
-	  = let
-	      val vi = varInfo x
-	    in
-	      if VarInfo.violates vi
-		then ()
-		else (VarInfo.ty vi := ty ;
-		      VarInfo.addDef vi ;
-		      if VarInfo.violates vi
-			then List.push (violations, x)
-			else ())
-	    end
-	val _ = Function.foreachVar (f, addDef)
+        val {args, blocks, mayInline, name, returns, raises, start} =
+           Function.dest f
+        (* check for violations *)
+        val violations = ref []
+        fun addDef (x, ty)
+          = let
+              val vi = varInfo x
+            in
+              if VarInfo.violates vi
+                then ()
+                else (VarInfo.ty vi := ty ;
+                      VarInfo.addDef vi ;
+                      if VarInfo.violates vi
+                        then List.push (violations, x)
+                        else ())
+            end
+        val _ = Function.foreachVar (f, addDef)
 
-	(* escape early *)
-	val _ = if List.isEmpty (!violations)
-		  then (Control.diagnostics
-			(fn display =>
-			 let
-			   open Layout
-			 in
-			   display (seq [Func.layout name,
-					 str " NoViolations"])
-			 end);
-			raise NoViolations)
-		  else ()
+        (* escape early *)
+        val _ = if List.isEmpty (!violations)
+                  then (Control.diagnostics
+                        (fn display =>
+                         let
+                           open Layout
+                         in
+                           display (seq [Func.layout name,
+                                         str " NoViolations"])
+                         end);
+                        raise NoViolations)
+                  else ()
 
-	(* init violations *)
-	val index = ref 0
-	val violations
-	  = Vector.fromListMap
-	    (!violations, fn x =>
-	     let
-	       val vi = varInfo x
-	       val _ = VarInfo.index vi := (!index)
-	       val _ = Int.inc index
-	     in
-	       x
-	     end)
-	val numViolations = !index
+        (* init violations *)
+        val index = ref 0
+        val violations
+          = Vector.fromListMap
+            (!violations, fn x =>
+             let
+               val vi = varInfo x
+               val _ = VarInfo.index vi := (!index)
+               val _ = Int.inc index
+             in
+               x
+             end)
+        val numViolations = !index
 
-	(* Diagnostics *)
-	val _ = Control.diagnostics
-	        (fn display =>
-		 let
-		   open Layout
-		 in
-		   display (seq [Func.layout name,
-				 str " Violations: ",
-				 Vector.layout Var.layout violations])
-		 end)
+        (* Diagnostics *)
+        val _ = Control.diagnostics
+                (fn display =>
+                 let
+                   open Layout
+                 in
+                   display (seq [Func.layout name,
+                                 str " Violations: ",
+                                 Vector.layout Var.layout violations])
+                 end)
 
-	(* init entryBlock *)
-	val entry = Label.newNoname ()
-	val entryBlock = Block.T {label = entry,
-				  args = args,
-				  statements = Vector.new0 (),
-				  transfer = Goto {dst = start,
-						   args = Vector.new0 ()}}
+        (* init entryBlock *)
+        val entry = Label.newNoname ()
+        val entryBlock = Block.T {label = entry,
+                                  args = args,
+                                  statements = Vector.new0 (),
+                                  transfer = Goto {dst = start,
+                                                   args = Vector.new0 ()}}
 
-	(* compute dominator tree *)
-	val dt = Function.dominatorTree f
-	val dt' = Tree.T (entryBlock, Vector.new1 dt)
+        (* compute dominator tree *)
+        val dt = Function.dominatorTree f
+        val dt' = Tree.T (entryBlock, Vector.new1 dt)
 
-	(* compute df (dominance frontier) *)
-	(*  based on section 19.1 of Appel's "Modern Compiler Implementation in ML" *)
-	(* also computes defSites and useSites of violating variables *)
-	(* also computes preds, defs, and uses *)
-	val dtindex = ref 0
-	fun doitTree (Tree.T (Block.T {label, args, statements, transfer},
-			      children))
-	  = let
-	      val li = labelInfo label
+        (* compute df (dominance frontier) *)
+        (*  based on section 19.1 of Appel's "Modern Compiler Implementation in ML" *)
+        (* also computes defSites and useSites of violating variables *)
+        (* also computes preds, defs, and uses *)
+        val dtindex = ref 0
+        fun doitTree (Tree.T (Block.T {label, args, statements, transfer},
+                              children))
+          = let
+              val li = labelInfo label
 
-	      val _ = LabelInfo.args li := args
+              val _ = LabelInfo.args li := args
 
-	      val _ = Transfer.foreachLabel 
-		      (transfer, fn l => 
-		       List.push (LabelInfo.preds (labelInfo l), label))
+              val _ = Transfer.foreachLabel 
+                      (transfer, fn l => 
+                       List.push (LabelInfo.preds (labelInfo l), label))
 
-	      val defs = Array.new (numViolations, false)
-	      val uses = Array.new (numViolations, false)
-	      fun addDef x
-		= let 
-		    val vi = varInfo x
-		  in 
-		    if VarInfo.violates vi
-		      then let
-			     val index = VarInfo.index' vi
-			   in
-			     VarInfo.addDefSite (varInfo x, label);
-			     Array.update (defs, index, true);
-			     Array.update (uses, index, false)
-			   end
-		      else ()
-		  end	
-	      fun addUse x
-		= let 
-		    val vi = varInfo x
-		  in 
-		    if VarInfo.violates vi
-		      then let
-			     val index = VarInfo.index' vi
-			   in 
-			     VarInfo.addUseSite (varInfo x, label);
-			     Array.update (uses, index, true)
-			   end
-		      else ()
-		  end
-	      val _ = Transfer.foreachVar (transfer, addUse)
-	      val _ = Vector.foreachr
-		      (statements, fn Statement.T {var, exp, ...} =>
-		       (Option.app (var, addDef);
-			Exp.foreachVar (exp, addUse)))
-	      val _ = Vector.foreach (args, addDef o #1)
-	      val _ = LabelInfo.defs li := Array.toVector defs
-	      val _ = LabelInfo.uses li := Array.toVector uses
-	      val _ = LabelInfo.live li := Array.new (numViolations, false)
+              val defs = Array.new (numViolations, false)
+              val uses = Array.new (numViolations, false)
+              fun addDef x
+                = let 
+                    val vi = varInfo x
+                  in 
+                    if VarInfo.violates vi
+                      then let
+                             val index = VarInfo.index' vi
+                           in
+                             VarInfo.addDefSite (varInfo x, label);
+                             Array.update (defs, index, true);
+                             Array.update (uses, index, false)
+                           end
+                      else ()
+                  end   
+              fun addUse x
+                = let 
+                    val vi = varInfo x
+                  in 
+                    if VarInfo.violates vi
+                      then let
+                             val index = VarInfo.index' vi
+                           in 
+                             VarInfo.addUseSite (varInfo x, label);
+                             Array.update (uses, index, true)
+                           end
+                      else ()
+                  end
+              val _ = Transfer.foreachVar (transfer, addUse)
+              val _ = Vector.foreachr
+                      (statements, fn Statement.T {var, exp, ...} =>
+                       (Option.app (var, addDef);
+                        Exp.foreachVar (exp, addUse)))
+              val _ = Vector.foreach (args, addDef o #1)
+              val _ = LabelInfo.defs li := Array.toVector defs
+              val _ = LabelInfo.uses li := Array.toVector uses
+              val _ = LabelInfo.live li := Array.new (numViolations, false)
 
-	      val _ = Int.inc dtindex
-	      val dtindexMin = !dtindex
-	      val _ = LabelInfo.dtindex li := dtindexMin
-	      val _ = Vector.foreach(children, doitTree)
-	      val dtindexMax = !dtindex
-	      fun dominates l 
-		= let val dtindex = LabelInfo.dtindex' (labelInfo l)
-		  in dtindexMin < dtindex andalso dtindex <= dtindexMax
-		  end
+              val _ = Int.inc dtindex
+              val dtindexMin = !dtindex
+              val _ = LabelInfo.dtindex li := dtindexMin
+              val _ = Vector.foreach(children, doitTree)
+              val dtindexMax = !dtindex
+              fun dominates l 
+                = let val dtindex = LabelInfo.dtindex' (labelInfo l)
+                  in dtindexMin < dtindex andalso dtindex <= dtindexMax
+                  end
 
-	      fun promise ()
-		= let
-		    val df = ref []
-		    fun addDF l
-		      = if List.contains(!df, l, Label.equals)
-			  then ()
-			  else List.push(df,l)
-		    val _ = Transfer.foreachLabel
-		            (transfer, fn l =>
-			     if Vector.exists
-			        (children, fn Tree.T (b, _) => 
-				 Label.equals (Block.label b, l))
-			       then ()
-			       else addDF l)
-		    val _ = Vector.foreach
-		            (children, fn Tree.T (Block.T {label, ...}, _) =>
-			     let
-			       val li = labelInfo label
-			     in
-			       Vector.foreach
-			       (Promise.force (LabelInfo.df' li), fn l =>
-				if dominates l
-				  then ()
-				  else addDF l)
-			     end)
-		  in
-		    Vector.fromList (!df)
-		  end
-	      val _ = LabelInfo.df li := Promise.delay promise
-	    in
-	      ()
-	    end
-	val _ = doitTree dt'
+              fun promise ()
+                = let
+                    val df = ref []
+                    fun addDF l
+                      = if List.contains(!df, l, Label.equals)
+                          then ()
+                          else List.push(df,l)
+                    val _ = Transfer.foreachLabel
+                            (transfer, fn l =>
+                             if Vector.exists
+                                (children, fn Tree.T (b, _) => 
+                                 Label.equals (Block.label b, l))
+                               then ()
+                               else addDF l)
+                    val _ = Vector.foreach
+                            (children, fn Tree.T (Block.T {label, ...}, _) =>
+                             let
+                               val li = labelInfo label
+                             in
+                               Vector.foreach
+                               (Promise.force (LabelInfo.df' li), fn l =>
+                                if dominates l
+                                  then ()
+                                  else addDF l)
+                             end)
+                  in
+                    Vector.fromList (!df)
+                  end
+              val _ = LabelInfo.df li := Promise.delay promise
+            in
+              ()
+            end
+        val _ = doitTree dt'
 
-	(* compute liveness *)
-	val _
-	  = Vector.foreach
-	    (violations, fn x =>
-	     let
-	       val {enque, deque} = mkQueue ()
-	       val enque = fn l => enque (l, labelInfo l)
+        (* compute liveness *)
+        val _
+          = Vector.foreach
+            (violations, fn x =>
+             let
+               val {enque, deque} = mkQueue ()
+               val enque = fn l => enque (l, labelInfo l)
 
-	       val vi = varInfo x
-	       val index = VarInfo.index' vi
-	       val useSites = VarInfo.useSites' vi
-	       val _ = List.foreach (useSites, enque)
+               val vi = varInfo x
+               val index = VarInfo.index' vi
+               val useSites = VarInfo.useSites' vi
+               val _ = List.foreach (useSites, enque)
 
-	       fun doit (_,li)
-		 = let
-		     val uses = LabelInfo.uses' li
-		     val defs = LabelInfo.defs' li
-		     val live = LabelInfo.live' li
-		   in
-		     if Array.sub (live, index)
-		        orelse
-			(Vector.sub(defs, index)
-			 andalso
-			 not (Vector.sub (uses, index)))
-		       then ()
-		       else (Array.update(live, index, true) ;
-			     List.foreach (LabelInfo.preds' li, enque))
-		   end
-	       fun loop ()
-		 = case deque ()
-		     of NONE => ()
-		      | SOME (l,li) => (doit (l, li); loop ())
-	     in
-	       loop ()
-	     end)
+               fun doit (_,li)
+                 = let
+                     val uses = LabelInfo.uses' li
+                     val defs = LabelInfo.defs' li
+                     val live = LabelInfo.live' li
+                   in
+                     if Array.sub (live, index)
+                        orelse
+                        (Vector.sub(defs, index)
+                         andalso
+                         not (Vector.sub (uses, index)))
+                       then ()
+                       else (Array.update(live, index, true) ;
+                             List.foreach (LabelInfo.preds' li, enque))
+                   end
+               fun loop ()
+                 = case deque ()
+                     of NONE => ()
+                      | SOME (l,li) => (doit (l, li); loop ())
+             in
+               loop ()
+             end)
 
-	(* insert phi-functions *)
-	(*  based on section 19.1 of Appel's "Modern Compiler Implementation in ML"
-	 *  (beware: Alg. 19.6 (both in the book and as corrected by the 
-	 *   errata) has numerous typos; and this implementation computes sets of 
-	 *   variables that must have phi-functions at a node, which is close to 
-	 *   the algorithm in the book, but the reverse of the algorithm as 
-	 *   corrected by the errata, which computes sets of nodes that must have 
-	 *   a phi-functions for a variable.)
-	 *)
-	val _
-	  = Vector.foreach
-	    (violations, fn x =>
-	     let
-	       val {enque, deque} = mkQueue ()
-		 
-	       val vi = varInfo x
-	       val index = VarInfo.index' vi
-	       val defSites = VarInfo.defSites' vi
-	       val _ = List.foreach
-		       (defSites, fn l =>
-			enque (l, labelInfo l))
-		       
-	       fun doit (_,li) 
-		 = Vector.foreach
-		   (Promise.force (LabelInfo.df' li), fn l =>
-		    let
-		      val li = labelInfo l
-		      val live = LabelInfo.live' li
-		      val phi = LabelInfo.phi li
-		    in
-		      if Array.sub(live, index) 
-			 andalso
-			 not (List.contains(!phi, x, Var.equals))
-			then (List.push(phi, x);
-			      enque (l, li))
-			else ()
-		    end)
-	       fun loop ()
-		 = case deque ()
-		     of NONE => ()
-		      | SOME (l,li) => (doit (l, li); loop ())
-	     in
-	       loop ()
-	     end)
+        (* insert phi-functions *)
+        (*  based on section 19.1 of Appel's "Modern Compiler Implementation in ML"
+         *  (beware: Alg. 19.6 (both in the book and as corrected by the 
+         *   errata) has numerous typos; and this implementation computes sets of 
+         *   variables that must have phi-functions at a node, which is close to 
+         *   the algorithm in the book, but the reverse of the algorithm as 
+         *   corrected by the errata, which computes sets of nodes that must have 
+         *   a phi-functions for a variable.)
+         *)
+        val _
+          = Vector.foreach
+            (violations, fn x =>
+             let
+               val {enque, deque} = mkQueue ()
+                 
+               val vi = varInfo x
+               val index = VarInfo.index' vi
+               val defSites = VarInfo.defSites' vi
+               val _ = List.foreach
+                       (defSites, fn l =>
+                        enque (l, labelInfo l))
+                       
+               fun doit (_,li) 
+                 = Vector.foreach
+                   (Promise.force (LabelInfo.df' li), fn l =>
+                    let
+                      val li = labelInfo l
+                      val live = LabelInfo.live' li
+                      val phi = LabelInfo.phi li
+                    in
+                      if Array.sub(live, index) 
+                         andalso
+                         not (List.contains(!phi, x, Var.equals))
+                        then (List.push(phi, x);
+                              enque (l, li))
+                        else ()
+                    end)
+               fun loop ()
+                 = case deque ()
+                     of NONE => ()
+                      | SOME (l,li) => (doit (l, li); loop ())
+             in
+               loop ()
+             end)
 
-	(* finalize phi args *)
-	fun visitBlock (Block.T {label, ...}) 
-	  = let
-	      val li = labelInfo label
-	      val phi = LabelInfo.phi li
-	      val phiArgs = LabelInfo.phiArgs li
-	    in
-	      phiArgs := Vector.fromList (!phi) ;
-	      phi := []
-	    end
-	val _ = visitBlock entryBlock
-	val _ = Vector.foreach (blocks, visitBlock)
+        (* finalize phi args *)
+        fun visitBlock (Block.T {label, ...}) 
+          = let
+              val li = labelInfo label
+              val phi = LabelInfo.phi li
+              val phiArgs = LabelInfo.phiArgs li
+            in
+              phiArgs := Vector.fromList (!phi) ;
+              phi := []
+            end
+        val _ = visitBlock entryBlock
+        val _ = Vector.foreach (blocks, visitBlock)
 
-	(* Diagnostics *)
-	val _ = Control.diagnostics
-	        (fn display =>
-		 let
-		   open Layout
-		 in
-		   Vector.foreach
-		   (violations, fn x =>
-		    display (seq [Var.layout x,
-				  str " ",
-				  VarInfo.layout (varInfo x)]));
-		   Vector.foreach
-		   (blocks, fn Block.T {label, ...} =>
-		    display (seq [Label.layout label,
-				  str " ",
-				  LabelInfo.layout (labelInfo label)]))
-		 end)
+        (* Diagnostics *)
+        val _ = Control.diagnostics
+                (fn display =>
+                 let
+                   open Layout
+                 in
+                   Vector.foreach
+                   (violations, fn x =>
+                    display (seq [Var.layout x,
+                                  str " ",
+                                  VarInfo.layout (varInfo x)]));
+                   Vector.foreach
+                   (blocks, fn Block.T {label, ...} =>
+                    display (seq [Label.layout label,
+                                  str " ",
+                                  LabelInfo.layout (labelInfo label)]))
+                 end)
 
-	(* rewrite *)
-	val blocks = ref []
-	fun rewriteVar (x: Var.t)
-	  = case VarInfo.peekVar (varInfo x)
-	      of NONE => x
-	       | SOME x' => x'
-	fun rewriteStatement addPost (Statement.T {var, ty, exp})
-	  = let
-	      val exp = Exp.replaceVar (exp, rewriteVar)
-	      val var
-		= case var
-		    of NONE => NONE
-		     | SOME x => let
-				   val vi = varInfo x
-				 in 
-				   if VarInfo.violates vi
-				     then let
-					    val x' = Var.new x
-					  in
-					    addPost (fn _ => VarInfo.popVar vi) ;
-					    VarInfo.pushVar (vi, x');
-					    SOME x'
-					  end
-				     else SOME x
-				 end
-	    in
-	      Statement.T {var = var,
-			   ty = ty,
-			   exp = exp}
-	    end
-	local
-	  type t = {dst: Label.t,
-		    phiArgs: Var.t vector,
-		    route: Label.t,
-		    hash: Word.t}
-	  val routeTable : t HashSet.t = HashSet.new {hash = #hash}
-	in
-	  fun route dst
-	    = let
-		val li = labelInfo dst
-		val phiArgs = LabelInfo.phiArgs' li
-	      in
-		if Vector.length phiArgs = 0
-		  then dst
-		  else let
-			 val phiArgs = Vector.map
-		                        (phiArgs, valOf o VarInfo.peekVar o varInfo)
-			 val hash = Vector.fold
-			            (phiArgs, Label.hash dst, fn (x, h) =>
-				     Word.xorb(Var.hash x, h))
-			 val {route, ...} 
-			   = HashSet.lookupOrInsert
-			     (routeTable, hash, 
-			      fn {dst = dst', phiArgs = phiArgs', ... } =>
-			      Label.equals (dst, dst') 
-			      andalso
-			      Vector.equals (phiArgs, phiArgs', Var.equals),
-			      fn () =>
-			      let
-				val route = Label.new dst
-				val args = Vector.map 
-				           (LabelInfo.args' li, fn (x,ty) =>
-					    (Var.new x, ty))
-				val args' = Vector.concat 
-				            [Vector.map(args, #1),
-					     phiArgs]
-				val block = Block.T
-				            {label = route,
-					     args = args,
-					     statements = Vector.new0 (),
-					     transfer = Goto {dst = dst,
-							      args = args'}}
-				val _ = List.push (blocks, block)
-			      in
-				{dst = dst,
-				 phiArgs = phiArgs,
-				 route = route,
-				 hash = hash}
-			      end)
-		       in
-			 route
-		       end
-	      end
-	end
-	fun rewriteTransfer (t: Transfer.t) 
-	  = Transfer.replaceLabelVar (t, route, rewriteVar)
-	fun visitBlock' (Block.T {label, args, statements, transfer})
-	  = let
-	      val {addPost, post} = mkPost ()
-	      val li = labelInfo label
-	      fun doit x = let
-			     val vi = varInfo x
-			     val ty = VarInfo.ty' vi
-			   in
-			     if VarInfo.violates vi
-			       then let
-				      val x' = Var.new x
-				    in
-				      addPost (fn _ => VarInfo.popVar vi) ;
-				      VarInfo.pushVar (vi, x') ;
-				      (x', ty)
-				    end
-			       else (x, ty)
-			   end
-	      val args = Vector.map
-		         (args, fn (x, _) => doit x)
-	      val phiArgs = Vector.map
-		            (LabelInfo.phiArgs' li, fn x => doit x)
-	      val args = Vector.concat [args, phiArgs]
-	      val statements 
-		= if Vector.exists(LabelInfo.defs' li, fn b => b)
-		     orelse
-		     Vector.exists(LabelInfo.uses' li, fn b => b)
-		    then Vector.map (statements, rewriteStatement addPost)
-		    else statements
-	      val transfer = rewriteTransfer transfer
-	      val block = Block.T {label = label,
-				   args = args,
-				   statements = statements,
-				   transfer = transfer}
-	    in
-	      (block, post)
-	    end
-	fun visitBlock block
-	  = let val (block, post) = visitBlock' block
-	    in List.push (blocks, block) ; post
-	    end
-	fun rewrite ()
-	  = let
-	      local
-		val (Block.T {label, args, statements, transfer}, post) 
-		  = visitBlock' entryBlock
-		val entryBlock = Block.T {label = label,
-					  args = Vector.new0 (),
-					  statements = statements,
-					  transfer = transfer}
-		val _ = List.push (blocks, entryBlock)
-	      in
-		val args = args
-		val post = post
-	      end
-	      val _ = Tree.traverse (Function.dominatorTree f, visitBlock)
-	      val _ = post ()
-	    in
-	      Function.new {args = args,
-			    blocks = Vector.fromList (!blocks),
-			    mayInline = mayInline,
-			    name = name,
-			    raises = raises,
-			    returns = returns,
-			    start = entry}
-	    end
-	val f = rewrite ()
+        (* rewrite *)
+        val blocks = ref []
+        fun rewriteVar (x: Var.t)
+          = case VarInfo.peekVar (varInfo x)
+              of NONE => x
+               | SOME x' => x'
+        fun rewriteStatement (addPost: (unit -> unit) -> unit) (Statement.T {var, ty, exp})
+          = let
+              val exp = Exp.replaceVar (exp, rewriteVar)
+              val var
+                = case var
+                    of NONE => NONE
+                     | SOME x => let
+                                   val vi = varInfo x
+                                 in 
+                                   if VarInfo.violates vi
+                                     then let
+                                            val x' = Var.new x
+                                          in
+                                            addPost (fn _ => VarInfo.popVar vi) ;
+                                            VarInfo.pushVar (vi, x');
+                                            SOME x'
+                                          end
+                                     else SOME x
+                                 end
+            in
+              Statement.T {var = var,
+                           ty = ty,
+                           exp = exp}
+            end
+        local
+          type t = {dst: Label.t,
+                    phiArgs: Var.t vector,
+                    route: Label.t,
+                    hash: Word.t}
+          val routeTable : t HashSet.t = HashSet.new {hash = #hash}
+        in
+          fun route dst
+            = let
+                val li = labelInfo dst
+                val phiArgs = LabelInfo.phiArgs' li
+              in
+                if Vector.length phiArgs = 0
+                  then dst
+                  else let
+                         val phiArgs = Vector.map
+                                        (phiArgs, valOf o VarInfo.peekVar o varInfo)
+                         val hash = Vector.fold
+                                    (phiArgs, Label.hash dst, fn (x, h) =>
+                                     Word.xorb(Var.hash x, h))
+                         val {route, ...} 
+                           = HashSet.lookupOrInsert
+                             (routeTable, hash, 
+                              fn {dst = dst', phiArgs = phiArgs', ... } =>
+                              Label.equals (dst, dst') 
+                              andalso
+                              Vector.equals (phiArgs, phiArgs', Var.equals),
+                              fn () =>
+                              let
+                                val route = Label.new dst
+                                val args = Vector.map 
+                                           (LabelInfo.args' li, fn (x,ty) =>
+                                            (Var.new x, ty))
+                                val args' = Vector.concat 
+                                            [Vector.map(args, #1),
+                                             phiArgs]
+                                val block = Block.T
+                                            {label = route,
+                                             args = args,
+                                             statements = Vector.new0 (),
+                                             transfer = Goto {dst = dst,
+                                                              args = args'}}
+                                val _ = List.push (blocks, block)
+                              in
+                                {dst = dst,
+                                 phiArgs = phiArgs,
+                                 route = route,
+                                 hash = hash}
+                              end)
+                       in
+                         route
+                       end
+              end
+        end
+        fun rewriteTransfer (t: Transfer.t) 
+          = Transfer.replaceLabelVar (t, route, rewriteVar)
+        fun visitBlock' (Block.T {label, args, statements, transfer})
+          = let
+              val {addPost, post} = mkPost ()
+              val li = labelInfo label
+              fun doit x = let
+                             val vi = varInfo x
+                             val ty = VarInfo.ty' vi
+                           in
+                             if VarInfo.violates vi
+                               then let
+                                      val x' = Var.new x
+                                    in
+                                      addPost (fn _ => VarInfo.popVar vi) ;
+                                      VarInfo.pushVar (vi, x') ;
+                                      (x', ty)
+                                    end
+                               else (x, ty)
+                           end
+              val args = Vector.map
+                         (args, fn (x, _) => doit x)
+              val phiArgs = Vector.map
+                            (LabelInfo.phiArgs' li, fn x => doit x)
+              val args = Vector.concat [args, phiArgs]
+              val statements 
+                = if Vector.exists(LabelInfo.defs' li, fn b => b)
+                     orelse
+                     Vector.exists(LabelInfo.uses' li, fn b => b)
+                    then Vector.map (statements, rewriteStatement addPost)
+                    else statements
+              val transfer = rewriteTransfer transfer
+              val block = Block.T {label = label,
+                                   args = args,
+                                   statements = statements,
+                                   transfer = transfer}
+            in
+              (block, post)
+            end
+        fun visitBlock block
+          = let val (block, post) = visitBlock' block
+            in List.push (blocks, block) ; post
+            end
+        fun rewrite ()
+          = let
+              local
+                val (Block.T {label, args, statements, transfer}, post) 
+                  = visitBlock' entryBlock
+                val entryBlock = Block.T {label = label,
+                                          args = Vector.new0 (),
+                                          statements = statements,
+                                          transfer = transfer}
+                val _ = List.push (blocks, entryBlock)
+              in
+                val args = args
+                val post = post
+              end
+              val _ = Tree.traverse (Function.dominatorTree f, visitBlock)
+              val _ = post ()
+            in
+              Function.new {args = args,
+                            blocks = Vector.fromList (!blocks),
+                            mayInline = mayInline,
+                            name = name,
+                            raises = raises,
+                            returns = returns,
+                            start = entry}
+            end
+        val f = rewrite ()
       in
-	f
+        f
       end
       handle NoViolations => f
     end
 
 val traceRestoreFunction
   = Trace.trace ("Restore.restoreFunction",
-		 Func.layout o Function.name,
-		 Func.layout o Function.name)
+                 Func.layout o Function.name,
+                 Func.layout o Function.name)
 
 val restoreFunction 
   = fn g =>
     let
       val r = restoreFunction g
     in
-      fn f =>
-      (traceRestoreFunction r f
-       handle e => (Error.bug (concat ["restore raised ",
-				       Layout.toString (Exn.layout e)])
-		    ; raise e))
+      fn f => traceRestoreFunction r f
    end
 
 fun restore (Program.T {datatypes, globals, functions, main})
@@ -669,8 +665,8 @@
       val r = restoreFunction {globals = globals}
     in
       Program.T {datatypes = datatypes,
-		 globals = globals,
-		 functions = List.revMap (functions, r),
-		 main = main}
+                 globals = globals,
+                 functions = List.revMap (functions, r),
+                 main = main}
     end
 end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ssa/restore.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ssa/restore.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ssa/restore.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature RESTORE_STRUCTS = 
    sig
       include SHRINK
@@ -15,6 +16,6 @@
       include RESTORE_STRUCTS
 
       val restoreFunction: 
-	 {globals: Statement.t vector} -> Function.t -> Function.t
+         {globals: Statement.t vector} -> Function.t -> Function.t
       val restore: Program.t -> Program.t
    end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ssa/restore2.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ssa/restore2.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ssa/restore2.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,9 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 (* Restore SSA
@@ -33,26 +33,26 @@
 structure LabelInfo =
   struct
     datatype t = T of {args: (Var.t * Type.t) vector ref,
-		       preds: Label.t list ref,
-		       defs: bool vector ref,
-		       uses: bool vector ref,
-		       live: bool array ref,
-		       dtindex: int ref,
-		       df: Label.t vector Promise.t ref,
-		       phi: Var.t list ref,
-		       phiArgs: Var.t vector ref,
-		       queued: bool ref}
+                       preds: Label.t list ref,
+                       defs: bool vector ref,
+                       uses: bool vector ref,
+                       live: bool array ref,
+                       dtindex: int ref,
+                       df: Label.t vector Promise.t ref,
+                       phi: Var.t list ref,
+                       phiArgs: Var.t vector ref,
+                       queued: bool ref}
 
     fun layout (T {preds, defs, uses, live, dtindex, df, phiArgs, ...})
       = let open Layout
-	in record [("preds", List.layout Label.layout (!preds)),
-		   ("defs", Vector.layout Bool.layout (!defs)),
-		   ("uses", Vector.layout Bool.layout (!uses)),
-		   ("live", Array.layout Bool.layout (!live)),
-		   ("dtindex", Int.layout (!dtindex)),
-		   ("df", Promise.layout (Vector.layout Label.layout) (!df)),
-		   ("phiArgs", Vector.layout Var.layout (!phiArgs))]
-	end
+        in record [("preds", List.layout Label.layout (!preds)),
+                   ("defs", Vector.layout Bool.layout (!defs)),
+                   ("uses", Vector.layout Bool.layout (!uses)),
+                   ("live", Array.layout Bool.layout (!live)),
+                   ("dtindex", Int.layout (!dtindex)),
+                   ("df", Promise.layout (Vector.layout Label.layout) (!df)),
+                   ("phiArgs", Vector.layout Var.layout (!phiArgs))]
+        end
 
     local 
       fun make f (T r) = f r
@@ -71,22 +71,22 @@
     end
 
     fun new (): t = T {args = ref (Vector.new0 ()),
-		       preds = ref [],
-		       defs = ref (Vector.new0 ()),
-		       uses = ref (Vector.new0 ()),
-		       live = ref (Array.new0 ()),
-		       dtindex = ref ~1,
-		       df = ref (Promise.delay (fn () => Vector.new0 ())),
-		       phi = ref [],
-		       phiArgs = ref (Vector.new0 ()),
-		       queued = ref false}
+                       preds = ref [],
+                       defs = ref (Vector.new0 ()),
+                       uses = ref (Vector.new0 ()),
+                       live = ref (Array.new0 ()),
+                       dtindex = ref ~1,
+                       df = ref (Promise.delay (fn () => Vector.new0 ())),
+                       phi = ref [],
+                       phiArgs = ref (Vector.new0 ()),
+                       queued = ref false}
   end
 
 structure Cardinality =
   struct
     structure L = ThreePointLattice(val bottom = "zero"
-				    val mid = "one"
-				    val top = "many")
+                                    val mid = "one"
+                                    val top = "many")
     open L
 
     val isZero = isBottom
@@ -98,29 +98,29 @@
 
     val inc: t -> unit
       = fn c => if isZero c
-		  then makeOne c
-		else if isOne c
-		  then makeMany c
-		else ()
+                  then makeOne c
+                else if isOne c
+                  then makeMany c
+                else ()
    end
 
 structure VarInfo =
   struct
     datatype t = T of {defs: Cardinality.t,
-		       ty: Type.t ref,
-		       index: int ref,
-		       defSites: Label.t list ref,
-		       useSites: Label.t list ref,
-		       vars: Var.t list ref}
+                       ty: Type.t ref,
+                       index: int ref,
+                       defSites: Label.t list ref,
+                       useSites: Label.t list ref,
+                       vars: Var.t list ref}
 
     fun layout (T {defs, index, defSites, useSites, vars, ...})
       = let open Layout
-	in record [("defs", Cardinality.layout defs),
-		   ("index", Int.layout (!index)),
-		   ("defSites", List.layout Label.layout (!defSites)),
-		   ("useSites", List.layout Label.layout (!useSites)),
-		   ("vars", List.layout Var.layout (!vars))]
-	end
+        in record [("defs", Cardinality.layout defs),
+                   ("index", Int.layout (!index)),
+                   ("defSites", List.layout Label.layout (!defSites)),
+                   ("useSites", List.layout Label.layout (!useSites)),
+                   ("vars", List.layout Var.layout (!vars))]
+        end
 
     local 
       fun make f (T r) = f r
@@ -139,17 +139,17 @@
     fun whenViolates (T {defs, ...}, th) = Cardinality.whenMany (defs, th)
 
     fun new (): t = T {defs = Cardinality.new (),
-		       index = ref ~1,
-		       defSites = ref [],
-		       useSites = ref [],
-		       ty = ref Type.unit,
-		       vars = ref []}
+                       index = ref ~1,
+                       defSites = ref [],
+                       useSites = ref [],
+                       ty = ref Type.unit,
+                       vars = ref []}
 
     fun pushVar (T {vars, ...}, var) = List.push (vars, var)
     fun popVar (T {vars, ...}) = ignore (List.pop vars)
     fun peekVar (T {vars, ...}) = case !vars
-				    of [] => NONE
-				     | h::_ => SOME h
+                                    of [] => NONE
+                                     | h::_ => SOME h
   end
 
 fun restoreFunction {globals: Statement.t vector}
@@ -157,509 +157,505 @@
       exception NoViolations
 
       val {get = varInfo: Var.t -> VarInfo.t, ...}
-	= Property.get
-	  (Var.plist, Property.initFun (fn _ => VarInfo.new ()))
+        = Property.get
+          (Var.plist, Property.initFun (fn _ => VarInfo.new ()))
 
       val {get = labelInfo: Label.t -> LabelInfo.t, ...}
-	= Property.get
-	  (Label.plist, Property.initFun (fn _ => LabelInfo.new ()))
+        = Property.get
+          (Label.plist, Property.initFun (fn _ => LabelInfo.new ()))
 
       fun mkQueue ()
-	= let
-	    val todo = ref []
-	  in
-	    {enque = fn (l, li) => let 
-				     val queued = LabelInfo.queued li
-				   in
-				     if !queued
-				       then ()
-				       else (queued := true ; 
-					     List.push (todo, (l,li)))
-				   end,
-	     deque = fn () => case !todo
-				of [] => NONE
-		                 | (l,li)::todo' 
-				 => (todo := todo';
-				     LabelInfo.queued li := false;
-				     SOME (l,li))}
-	  end
+        = let
+            val todo = ref []
+          in
+            {enque = fn (l, li) => let 
+                                     val queued = LabelInfo.queued li
+                                   in
+                                     if !queued
+                                       then ()
+                                       else (queued := true ; 
+                                             List.push (todo, (l,li)))
+                                   end,
+             deque = fn () => case !todo
+                                of [] => NONE
+                                 | (l,li)::todo' 
+                                 => (todo := todo';
+                                     LabelInfo.queued li := false;
+                                     SOME (l,li))}
+          end
 
       fun mkPost ()
-	= let
-	    val post = ref []
-	  in
-	    {addPost = fn th => List.push (post, th),
-	     post = fn () => List.foreach(!post, fn th => th ())}
-	  end
+        = let
+            val post = ref []
+          in
+            {addPost = fn th => List.push (post, th),
+             post = fn () => List.foreach(!post, fn th => th ())}
+          end
 
       (* check for violations in globals *)
       fun addDef (x, ty) 
-	= let
-	    val vi = varInfo x
-	  in
-	    VarInfo.ty vi := ty ;
-	    VarInfo.addDef vi ;
-	    VarInfo.whenViolates 
-	    (vi, fn () => Error.bug "Restore.restore: violation in globals")
-	  end
+        = let
+            val vi = varInfo x
+          in
+            VarInfo.ty vi := ty ;
+            VarInfo.addDef vi ;
+            VarInfo.whenViolates 
+            (vi, fn () => Error.bug "Restore2.restore: violation in globals")
+          end
       val _
-	= Vector.foreach
-	  (globals, fn Statement.T {var, ty, ...} =>
-	   Option.app (var, fn x => addDef (x, ty)))
+        = Vector.foreach
+          (globals, fn Statement.T {var, ty, ...} =>
+           Option.app (var, fn x => addDef (x, ty)))
     in
       fn (f: Function.t) =>
       let
-	val {args, blocks, name, returns, raises, start} = Function.dest f
-	(* check for violations *)
-	val violations = ref []
-	fun addDef (x, ty)
-	  = let
-	      val vi = varInfo x
-	    in
-	      if VarInfo.violates vi
-		then ()
-		else (VarInfo.ty vi := ty ;
-		      VarInfo.addDef vi ;
-		      if VarInfo.violates vi
-			then List.push (violations, x)
-			else ())
-	    end
-	val _ = Function.foreachVar (f, addDef)
+        val {args, blocks, name, returns, raises, start} = Function.dest f
+        (* check for violations *)
+        val violations = ref []
+        fun addDef (x, ty)
+          = let
+              val vi = varInfo x
+            in
+              if VarInfo.violates vi
+                then ()
+                else (VarInfo.ty vi := ty ;
+                      VarInfo.addDef vi ;
+                      if VarInfo.violates vi
+                        then List.push (violations, x)
+                        else ())
+            end
+        val _ = Function.foreachVar (f, addDef)
 
-	(* escape early *)
-	val _ = if List.isEmpty (!violations)
-		  then (Control.diagnostics
-			(fn display =>
-			 let
-			   open Layout
-			 in
-			   display (seq [Func.layout name,
-					 str " NoViolations"])
-			 end);
-			raise NoViolations)
-		  else ()
+        (* escape early *)
+        val _ = if List.isEmpty (!violations)
+                  then (Control.diagnostics
+                        (fn display =>
+                         let
+                           open Layout
+                         in
+                           display (seq [Func.layout name,
+                                         str " NoViolations"])
+                         end);
+                        raise NoViolations)
+                  else ()
 
-	(* init violations *)
-	val index = ref 0
-	val violations
-	  = Vector.fromListMap
-	    (!violations, fn x =>
-	     let
-	       val vi = varInfo x
-	       val _ = VarInfo.index vi := (!index)
-	       val _ = Int.inc index
-	     in
-	       x
-	     end)
-	val numViolations = !index
+        (* init violations *)
+        val index = ref 0
+        val violations
+          = Vector.fromListMap
+            (!violations, fn x =>
+             let
+               val vi = varInfo x
+               val _ = VarInfo.index vi := (!index)
+               val _ = Int.inc index
+             in
+               x
+             end)
+        val numViolations = !index
 
-	(* Diagnostics *)
-	val _ = Control.diagnostics
-	        (fn display =>
-		 let
-		   open Layout
-		 in
-		   display (seq [Func.layout name,
-				 str " Violations: ",
-				 Vector.layout Var.layout violations])
-		 end)
+        (* Diagnostics *)
+        val _ = Control.diagnostics
+                (fn display =>
+                 let
+                   open Layout
+                 in
+                   display (seq [Func.layout name,
+                                 str " Violations: ",
+                                 Vector.layout Var.layout violations])
+                 end)
 
-	(* init entryBlock *)
-	val entry = Label.newNoname ()
-	val entryBlock = Block.T {label = entry,
-				  args = args,
-				  statements = Vector.new0 (),
-				  transfer = Goto {dst = start,
-						   args = Vector.new0 ()}}
+        (* init entryBlock *)
+        val entry = Label.newNoname ()
+        val entryBlock = Block.T {label = entry,
+                                  args = args,
+                                  statements = Vector.new0 (),
+                                  transfer = Goto {dst = start,
+                                                   args = Vector.new0 ()}}
 
-	(* compute dominator tree *)
-	val dt = Function.dominatorTree f
-	val dt' = Tree.T (entryBlock, Vector.new1 dt)
+        (* compute dominator tree *)
+        val dt = Function.dominatorTree f
+        val dt' = Tree.T (entryBlock, Vector.new1 dt)
 
-	(* compute df (dominance frontier) *)
-	(*  based on section 19.1 of Appel's "Modern Compiler Implementation in ML" *)
-	(* also computes defSites and useSites of violating variables *)
-	(* also computes preds, defs, and uses *)
-	val dtindex = ref 0
-	fun doitTree (Tree.T (Block.T {label, args, statements, transfer},
-			      children))
-	  = let
-	      val li = labelInfo label
+        (* compute df (dominance frontier) *)
+        (*  based on section 19.1 of Appel's "Modern Compiler Implementation in ML" *)
+        (* also computes defSites and useSites of violating variables *)
+        (* also computes preds, defs, and uses *)
+        val dtindex = ref 0
+        fun doitTree (Tree.T (Block.T {label, args, statements, transfer},
+                              children))
+          = let
+              val li = labelInfo label
 
-	      val _ = LabelInfo.args li := args
+              val _ = LabelInfo.args li := args
 
-	      val _ = Transfer.foreachLabel 
-		      (transfer, fn l => 
-		       List.push (LabelInfo.preds (labelInfo l), label))
+              val _ = Transfer.foreachLabel 
+                      (transfer, fn l => 
+                       List.push (LabelInfo.preds (labelInfo l), label))
 
-	      val defs = Array.new (numViolations, false)
-	      val uses = Array.new (numViolations, false)
-	      fun addDef x
-		= let 
-		    val vi = varInfo x
-		  in 
-		    if VarInfo.violates vi
-		      then let
-			     val index = VarInfo.index' vi
-			   in
-			     VarInfo.addDefSite (varInfo x, label);
-			     Array.update (defs, index, true);
-			     Array.update (uses, index, false)
-			   end
-		      else ()
-		  end	
-	      fun addUse x
-		= let 
-		    val vi = varInfo x
-		  in 
-		    if VarInfo.violates vi
-		      then let
-			     val index = VarInfo.index' vi
-			   in 
-			     VarInfo.addUseSite (varInfo x, label);
-			     Array.update (uses, index, true)
-			   end
-		      else ()
-		  end
-	      val _ = Transfer.foreachVar (transfer, addUse)
-	      val _ = Vector.foreachr
-		      (statements, fn Statement.T {var, exp, ...} =>
-		       (Option.app (var, addDef);
-			Exp.foreachVar (exp, addUse)))
-	      val _ = Vector.foreach (args, addDef o #1)
-	      val _ = LabelInfo.defs li := Array.toVector defs
-	      val _ = LabelInfo.uses li := Array.toVector uses
-	      val _ = LabelInfo.live li := Array.new (numViolations, false)
+              val defs = Array.new (numViolations, false)
+              val uses = Array.new (numViolations, false)
+              fun addDef x
+                = let 
+                    val vi = varInfo x
+                  in 
+                    if VarInfo.violates vi
+                      then let
+                             val index = VarInfo.index' vi
+                           in
+                             VarInfo.addDefSite (varInfo x, label);
+                             Array.update (defs, index, true);
+                             Array.update (uses, index, false)
+                           end
+                      else ()
+                  end   
+              fun addUse x
+                = let 
+                    val vi = varInfo x
+                  in 
+                    if VarInfo.violates vi
+                      then let
+                             val index = VarInfo.index' vi
+                           in 
+                             VarInfo.addUseSite (varInfo x, label);
+                             Array.update (uses, index, true)
+                           end
+                      else ()
+                  end
+              val _ = Transfer.foreachVar (transfer, addUse)
+              val _ = Vector.foreachr
+                      (statements, fn Statement.T {var, exp, ...} =>
+                       (Option.app (var, addDef);
+                        Exp.foreachVar (exp, addUse)))
+              val _ = Vector.foreach (args, addDef o #1)
+              val _ = LabelInfo.defs li := Array.toVector defs
+              val _ = LabelInfo.uses li := Array.toVector uses
+              val _ = LabelInfo.live li := Array.new (numViolations, false)
 
-	      val _ = Int.inc dtindex
-	      val dtindexMin = !dtindex
-	      val _ = LabelInfo.dtindex li := dtindexMin
-	      val _ = Vector.foreach(children, doitTree)
-	      val dtindexMax = !dtindex
-	      fun dominates l 
-		= let val dtindex = LabelInfo.dtindex' (labelInfo l)
-		  in dtindexMin < dtindex andalso dtindex <= dtindexMax
-		  end
+              val _ = Int.inc dtindex
+              val dtindexMin = !dtindex
+              val _ = LabelInfo.dtindex li := dtindexMin
+              val _ = Vector.foreach(children, doitTree)
+              val dtindexMax = !dtindex
+              fun dominates l 
+                = let val dtindex = LabelInfo.dtindex' (labelInfo l)
+                  in dtindexMin < dtindex andalso dtindex <= dtindexMax
+                  end
 
-	      fun promise ()
-		= let
-		    val df = ref []
-		    fun addDF l
-		      = if List.contains(!df, l, Label.equals)
-			  then ()
-			  else List.push(df,l)
-		    val _ = Transfer.foreachLabel
-		            (transfer, fn l =>
-			     if Vector.exists
-			        (children, fn Tree.T (b, _) => 
-				 Label.equals (Block.label b, l))
-			       then ()
-			       else addDF l)
-		    val _ = Vector.foreach
-		            (children, fn Tree.T (Block.T {label, ...}, _) =>
-			     let
-			       val li = labelInfo label
-			     in
-			       Vector.foreach
-			       (Promise.force (LabelInfo.df' li), fn l =>
-				if dominates l
-				  then ()
-				  else addDF l)
-			     end)
-		  in
-		    Vector.fromList (!df)
-		  end
-	      val _ = LabelInfo.df li := Promise.delay promise
-	    in
-	      ()
-	    end
-	val _ = doitTree dt'
+              fun promise ()
+                = let
+                    val df = ref []
+                    fun addDF l
+                      = if List.contains(!df, l, Label.equals)
+                          then ()
+                          else List.push(df,l)
+                    val _ = Transfer.foreachLabel
+                            (transfer, fn l =>
+                             if Vector.exists
+                                (children, fn Tree.T (b, _) => 
+                                 Label.equals (Block.label b, l))
+                               then ()
+                               else addDF l)
+                    val _ = Vector.foreach
+                            (children, fn Tree.T (Block.T {label, ...}, _) =>
+                             let
+                               val li = labelInfo label
+                             in
+                               Vector.foreach
+                               (Promise.force (LabelInfo.df' li), fn l =>
+                                if dominates l
+                                  then ()
+                                  else addDF l)
+                             end)
+                  in
+                    Vector.fromList (!df)
+                  end
+              val _ = LabelInfo.df li := Promise.delay promise
+            in
+              ()
+            end
+        val _ = doitTree dt'
 
-	(* compute liveness *)
-	val _
-	  = Vector.foreach
-	    (violations, fn x =>
-	     let
-	       val {enque, deque} = mkQueue ()
-	       val enque = fn l => enque (l, labelInfo l)
+        (* compute liveness *)
+        val _
+          = Vector.foreach
+            (violations, fn x =>
+             let
+               val {enque, deque} = mkQueue ()
+               val enque = fn l => enque (l, labelInfo l)
 
-	       val vi = varInfo x
-	       val index = VarInfo.index' vi
-	       val useSites = VarInfo.useSites' vi
-	       val _ = List.foreach (useSites, enque)
+               val vi = varInfo x
+               val index = VarInfo.index' vi
+               val useSites = VarInfo.useSites' vi
+               val _ = List.foreach (useSites, enque)
 
-	       fun doit (_,li)
-		 = let
-		     val uses = LabelInfo.uses' li
-		     val defs = LabelInfo.defs' li
-		     val live = LabelInfo.live' li
-		   in
-		     if Array.sub (live, index)
-		        orelse
-			(Vector.sub(defs, index)
-			 andalso
-			 not (Vector.sub (uses, index)))
-		       then ()
-		       else (Array.update(live, index, true) ;
-			     List.foreach (LabelInfo.preds' li, enque))
-		   end
-	       fun loop ()
-		 = case deque ()
-		     of NONE => ()
-		      | SOME (l,li) => (doit (l, li); loop ())
-	     in
-	       loop ()
-	     end)
+               fun doit (_,li)
+                 = let
+                     val uses = LabelInfo.uses' li
+                     val defs = LabelInfo.defs' li
+                     val live = LabelInfo.live' li
+                   in
+                     if Array.sub (live, index)
+                        orelse
+                        (Vector.sub(defs, index)
+                         andalso
+                         not (Vector.sub (uses, index)))
+                       then ()
+                       else (Array.update(live, index, true) ;
+                             List.foreach (LabelInfo.preds' li, enque))
+                   end
+               fun loop ()
+                 = case deque ()
+                     of NONE => ()
+                      | SOME (l,li) => (doit (l, li); loop ())
+             in
+               loop ()
+             end)
 
-	(* insert phi-functions *)
-	(*  based on section 19.1 of Appel's "Modern Compiler Implementation in ML"
-	 *  (beware: Alg. 19.6 (both in the book and as corrected by the 
-	 *   errata) has numerous typos; and this implementation computes sets of 
-	 *   variables that must have phi-functions at a node, which is close to 
-	 *   the algorithm in the book, but the reverse of the algorithm as 
-	 *   corrected by the errata, which computes sets of nodes that must have 
-	 *   a phi-functions for a variable.)
-	 *)
-	val _
-	  = Vector.foreach
-	    (violations, fn x =>
-	     let
-	       val {enque, deque} = mkQueue ()
-		 
-	       val vi = varInfo x
-	       val index = VarInfo.index' vi
-	       val defSites = VarInfo.defSites' vi
-	       val _ = List.foreach
-		       (defSites, fn l =>
-			enque (l, labelInfo l))
-		       
-	       fun doit (_,li) 
-		 = Vector.foreach
-		   (Promise.force (LabelInfo.df' li), fn l =>
-		    let
-		      val li = labelInfo l
-		      val live = LabelInfo.live' li
-		      val phi = LabelInfo.phi li
-		    in
-		      if Array.sub(live, index) 
-			 andalso
-			 not (List.contains(!phi, x, Var.equals))
-			then (List.push(phi, x);
-			      enque (l, li))
-			else ()
-		    end)
-	       fun loop ()
-		 = case deque ()
-		     of NONE => ()
-		      | SOME (l,li) => (doit (l, li); loop ())
-	     in
-	       loop ()
-	     end)
+        (* insert phi-functions *)
+        (*  based on section 19.1 of Appel's "Modern Compiler Implementation in ML"
+         *  (beware: Alg. 19.6 (both in the book and as corrected by the 
+         *   errata) has numerous typos; and this implementation computes sets of 
+         *   variables that must have phi-functions at a node, which is close to 
+         *   the algorithm in the book, but the reverse of the algorithm as 
+         *   corrected by the errata, which computes sets of nodes that must have 
+         *   a phi-functions for a variable.)
+         *)
+        val _
+          = Vector.foreach
+            (violations, fn x =>
+             let
+               val {enque, deque} = mkQueue ()
+                 
+               val vi = varInfo x
+               val index = VarInfo.index' vi
+               val defSites = VarInfo.defSites' vi
+               val _ = List.foreach
+                       (defSites, fn l =>
+                        enque (l, labelInfo l))
+                       
+               fun doit (_,li) 
+                 = Vector.foreach
+                   (Promise.force (LabelInfo.df' li), fn l =>
+                    let
+                      val li = labelInfo l
+                      val live = LabelInfo.live' li
+                      val phi = LabelInfo.phi li
+                    in
+                      if Array.sub(live, index) 
+                         andalso
+                         not (List.contains(!phi, x, Var.equals))
+                        then (List.push(phi, x);
+                              enque (l, li))
+                        else ()
+                    end)
+               fun loop ()
+                 = case deque ()
+                     of NONE => ()
+                      | SOME (l,li) => (doit (l, li); loop ())
+             in
+               loop ()
+             end)
 
-	(* finalize phi args *)
-	fun visitBlock (Block.T {label, ...}) 
-	  = let
-	      val li = labelInfo label
-	      val phi = LabelInfo.phi li
-	      val phiArgs = LabelInfo.phiArgs li
-	    in
-	      phiArgs := Vector.fromList (!phi) ;
-	      phi := []
-	    end
-	val _ = visitBlock entryBlock
-	val _ = Vector.foreach (blocks, visitBlock)
+        (* finalize phi args *)
+        fun visitBlock (Block.T {label, ...}) 
+          = let
+              val li = labelInfo label
+              val phi = LabelInfo.phi li
+              val phiArgs = LabelInfo.phiArgs li
+            in
+              phiArgs := Vector.fromList (!phi) ;
+              phi := []
+            end
+        val _ = visitBlock entryBlock
+        val _ = Vector.foreach (blocks, visitBlock)
 
-	(* Diagnostics *)
-	val _ = Control.diagnostics
-	        (fn display =>
-		 let
-		   open Layout
-		 in
-		   Vector.foreach
-		   (violations, fn x =>
-		    display (seq [Var.layout x,
-				  str " ",
-				  VarInfo.layout (varInfo x)]));
-		   Vector.foreach
-		   (blocks, fn Block.T {label, ...} =>
-		    display (seq [Label.layout label,
-				  str " ",
-				  LabelInfo.layout (labelInfo label)]))
-		 end)
+        (* Diagnostics *)
+        val _ = Control.diagnostics
+                (fn display =>
+                 let
+                   open Layout
+                 in
+                   Vector.foreach
+                   (violations, fn x =>
+                    display (seq [Var.layout x,
+                                  str " ",
+                                  VarInfo.layout (varInfo x)]));
+                   Vector.foreach
+                   (blocks, fn Block.T {label, ...} =>
+                    display (seq [Label.layout label,
+                                  str " ",
+                                  LabelInfo.layout (labelInfo label)]))
+                 end)
 
-	(* rewrite *)
-	val blocks = ref []
-	fun rewriteVar (x: Var.t)
-	  = case VarInfo.peekVar (varInfo x)
-	      of NONE => x
-	       | SOME x' => x'
-	fun rewriteStatement addPost (Statement.T {var, ty, exp})
-	  = let
-	      val exp = Exp.replaceVar (exp, rewriteVar)
-	      val var
-		= case var
-		    of NONE => NONE
-		     | SOME x => let
-				   val vi = varInfo x
-				 in 
-				   if VarInfo.violates vi
-				     then let
-					    val x' = Var.new x
-					  in
-					    addPost (fn _ => VarInfo.popVar vi) ;
-					    VarInfo.pushVar (vi, x');
-					    SOME x'
-					  end
-				     else SOME x
-				 end
-	    in
-	      Statement.T {var = var,
-			   ty = ty,
-			   exp = exp}
-	    end
-	local
-	  type t = {dst: Label.t,
-		    phiArgs: Var.t vector,
-		    route: Label.t,
-		    hash: Word.t}
-	  val routeTable : t HashSet.t = HashSet.new {hash = #hash}
-	in
-	  fun route dst
-	    = let
-		val li = labelInfo dst
-		val phiArgs = LabelInfo.phiArgs' li
-	      in
-		if Vector.length phiArgs = 0
-		  then dst
-		  else let
-			 val phiArgs = Vector.map
-		                        (phiArgs, valOf o VarInfo.peekVar o varInfo)
-			 val hash = Vector.fold
-			            (phiArgs, Label.hash dst, fn (x, h) =>
-				     Word.xorb(Var.hash x, h))
-			 val {route, ...} 
-			   = HashSet.lookupOrInsert
-			     (routeTable, hash, 
-			      fn {dst = dst', phiArgs = phiArgs', ... } =>
-			      Label.equals (dst, dst') 
-			      andalso
-			      Vector.equals (phiArgs, phiArgs', Var.equals),
-			      fn () =>
-			      let
-				val route = Label.new dst
-				val args = Vector.map 
-				           (LabelInfo.args' li, fn (x,ty) =>
-					    (Var.new x, ty))
-				val args' = Vector.concat 
-				            [Vector.map(args, #1),
-					     phiArgs]
-				val block = Block.T
-				            {label = route,
-					     args = args,
-					     statements = Vector.new0 (),
-					     transfer = Goto {dst = dst,
-							      args = args'}}
-				val _ = List.push (blocks, block)
-			      in
-				{dst = dst,
-				 phiArgs = phiArgs,
-				 route = route,
-				 hash = hash}
-			      end)
-		       in
-			 route
-		       end
-	      end
-	end
-	fun rewriteTransfer (t: Transfer.t) 
-	  = Transfer.replaceLabelVar (t, route, rewriteVar)
-	fun visitBlock' (Block.T {label, args, statements, transfer})
-	  = let
-	      val {addPost, post} = mkPost ()
-	      val li = labelInfo label
-	      fun doit x = let
-			     val vi = varInfo x
-			     val ty = VarInfo.ty' vi
-			   in
-			     if VarInfo.violates vi
-			       then let
-				      val x' = Var.new x
-				    in
-				      addPost (fn _ => VarInfo.popVar vi) ;
-				      VarInfo.pushVar (vi, x') ;
-				      (x', ty)
-				    end
-			       else (x, ty)
-			   end
-	      val args = Vector.map
-		         (args, fn (x, _) => doit x)
-	      val phiArgs = Vector.map
-		            (LabelInfo.phiArgs' li, fn x => doit x)
-	      val args = Vector.concat [args, phiArgs]
-	      val statements 
-		= if Vector.exists(LabelInfo.defs' li, fn b => b)
-		     orelse
-		     Vector.exists(LabelInfo.uses' li, fn b => b)
-		    then Vector.map (statements, rewriteStatement addPost)
-		    else statements
-	      val transfer = rewriteTransfer transfer
-	      val block = Block.T {label = label,
-				   args = args,
-				   statements = statements,
-				   transfer = transfer}
-	    in
-	      (block, post)
-	    end
-	fun visitBlock block
-	  = let val (block, post) = visitBlock' block
-	    in List.push (blocks, block) ; post
-	    end
-	fun rewrite ()
-	  = let
-	      local
-		val (Block.T {label, args, statements, transfer}, post) 
-		  = visitBlock' entryBlock
-		val entryBlock = Block.T {label = label,
-					  args = Vector.new0 (),
-					  statements = statements,
-					  transfer = transfer}
-		val _ = List.push (blocks, entryBlock)
-	      in
-		val args = args
-		val post = post
-	      end
-	      val _ = Tree.traverse (Function.dominatorTree f, visitBlock)
-	      val _ = post ()
-	    in
-	      Function.new {args = args,
-			    blocks = Vector.fromList (!blocks),
-			    name = name,
-			    raises = raises,
-			    returns = returns,
-			    start = entry}
-	    end
-	val f = rewrite ()
+        (* rewrite *)
+        val blocks = ref []
+        fun rewriteVar (x: Var.t)
+          = case VarInfo.peekVar (varInfo x)
+              of NONE => x
+               | SOME x' => x'
+        fun rewriteStatement addPost (Statement.T {var, ty, exp})
+          = let
+              val exp = Exp.replaceVar (exp, rewriteVar)
+              val var
+                = case var
+                    of NONE => NONE
+                     | SOME x => let
+                                   val vi = varInfo x
+                                 in 
+                                   if VarInfo.violates vi
+                                     then let
+                                            val x' = Var.new x
+                                          in
+                                            addPost (fn _ => VarInfo.popVar vi) ;
+                                            VarInfo.pushVar (vi, x');
+                                            SOME x'
+                                          end
+                                     else SOME x
+                                 end
+            in
+              Statement.T {var = var,
+                           ty = ty,
+                           exp = exp}
+            end
+        local
+          type t = {dst: Label.t,
+                    phiArgs: Var.t vector,
+                    route: Label.t,
+                    hash: Word.t}
+          val routeTable : t HashSet.t = HashSet.new {hash = #hash}
+        in
+          fun route dst
+            = let
+                val li = labelInfo dst
+                val phiArgs = LabelInfo.phiArgs' li
+              in
+                if Vector.length phiArgs = 0
+                  then dst
+                  else let
+                         val phiArgs = Vector.map
+                                        (phiArgs, valOf o VarInfo.peekVar o varInfo)
+                         val hash = Vector.fold
+                                    (phiArgs, Label.hash dst, fn (x, h) =>
+                                     Word.xorb(Var.hash x, h))
+                         val {route, ...} 
+                           = HashSet.lookupOrInsert
+                             (routeTable, hash, 
+                              fn {dst = dst', phiArgs = phiArgs', ... } =>
+                              Label.equals (dst, dst') 
+                              andalso
+                              Vector.equals (phiArgs, phiArgs', Var.equals),
+                              fn () =>
+                              let
+                                val route = Label.new dst
+                                val args = Vector.map 
+                                           (LabelInfo.args' li, fn (x,ty) =>
+                                            (Var.new x, ty))
+                                val args' = Vector.concat 
+                                            [Vector.map(args, #1),
+                                             phiArgs]
+                                val block = Block.T
+                                            {label = route,
+                                             args = args,
+                                             statements = Vector.new0 (),
+                                             transfer = Goto {dst = dst,
+                                                              args = args'}}
+                                val _ = List.push (blocks, block)
+                              in
+                                {dst = dst,
+                                 phiArgs = phiArgs,
+                                 route = route,
+                                 hash = hash}
+                              end)
+                       in
+                         route
+                       end
+              end
+        end
+        fun rewriteTransfer (t: Transfer.t) 
+          = Transfer.replaceLabelVar (t, route, rewriteVar)
+        fun visitBlock' (Block.T {label, args, statements, transfer})
+          = let
+              val {addPost, post} = mkPost ()
+              val li = labelInfo label
+              fun doit x = let
+                             val vi = varInfo x
+                             val ty = VarInfo.ty' vi
+                           in
+                             if VarInfo.violates vi
+                               then let
+                                      val x' = Var.new x
+                                    in
+                                      addPost (fn _ => VarInfo.popVar vi) ;
+                                      VarInfo.pushVar (vi, x') ;
+                                      (x', ty)
+                                    end
+                               else (x, ty)
+                           end
+              val args = Vector.map
+                         (args, fn (x, _) => doit x)
+              val phiArgs = Vector.map
+                            (LabelInfo.phiArgs' li, fn x => doit x)
+              val args = Vector.concat [args, phiArgs]
+              val statements 
+                = if Vector.exists(LabelInfo.defs' li, fn b => b)
+                     orelse
+                     Vector.exists(LabelInfo.uses' li, fn b => b)
+                    then Vector.map (statements, rewriteStatement addPost)
+                    else statements
+              val transfer = rewriteTransfer transfer
+              val block = Block.T {label = label,
+                                   args = args,
+                                   statements = statements,
+                                   transfer = transfer}
+            in
+              (block, post)
+            end
+        fun visitBlock block
+          = let val (block, post) = visitBlock' block
+            in List.push (blocks, block) ; post
+            end
+        fun rewrite ()
+          = let
+              local
+                val (Block.T {label, args, statements, transfer}, post) 
+                  = visitBlock' entryBlock
+                val entryBlock = Block.T {label = label,
+                                          args = Vector.new0 (),
+                                          statements = statements,
+                                          transfer = transfer}
+                val _ = List.push (blocks, entryBlock)
+              in
+                val args = args
+                val post = post
+              end
+              val _ = Tree.traverse (Function.dominatorTree f, visitBlock)
+              val _ = post ()
+            in
+              Function.new {args = args,
+                            blocks = Vector.fromList (!blocks),
+                            name = name,
+                            raises = raises,
+                            returns = returns,
+                            start = entry}
+            end
+        val f = rewrite ()
       in
-	f
+        f
       end
       handle NoViolations => f
     end
 
 val traceRestoreFunction
   = Trace.trace ("Restore2.restoreFunction",
-		 Func.layout o Function.name,
-		 Func.layout o Function.name)
+                 Func.layout o Function.name,
+                 Func.layout o Function.name)
 
 val restoreFunction 
   = fn g =>
     let
       val r = restoreFunction g
     in
-      fn f =>
-      (traceRestoreFunction r f
-       handle e => (Error.bug (concat ["restore raised ",
-				       Layout.toString (Exn.layout e)])
-		    ; raise e))
+      fn f => traceRestoreFunction r f
    end
 
 fun restore (Program.T {datatypes, globals, functions, main})
@@ -667,8 +663,8 @@
       val r = restoreFunction globals
     in
       Program.T {datatypes = datatypes,
-		 globals = globals,
-		 functions = List.revMap (functions, r),
-		 main = main}
+                 globals = globals,
+                 functions = List.revMap (functions, r),
+                 main = main}
     end
 end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ssa/restore2.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ssa/restore2.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ssa/restore2.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature RESTORE2_STRUCTS = 
    sig
       include SHRINK2
@@ -15,6 +16,6 @@
       include RESTORE2_STRUCTS
 
       val restoreFunction: 
-	 {globals: Statement.t vector} -> Function.t -> Function.t
+         {globals: Statement.t vector} -> Function.t -> Function.t
       val restore: Program.t -> Program.t
    end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ssa/shrink.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ssa/shrink.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ssa/shrink.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,21 +1,38 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 functor Shrink (S: SHRINK_STRUCTS): SHRINK = 
 struct
 
+type int = Int.t
+
 open S
 
-type int = Int.t
+structure Exp =
+   struct
+      open Exp
 
+      val isProfile =
+         fn Profile _ => true
+          | _ => false
+   end
+
+structure Statement =
+   struct
+      open Statement
+
+      fun isProfile (T {exp, ...}) = Exp.isProfile exp
+   end
+
 structure Array =
    struct
       open Array
-	 
+         
       fun inc (a: int t, i: int): unit = update (a, i, 1 + sub (a, i))
       fun dec (a: int t, i: int): unit = update (a, i, sub (a, i) - 1)
    end
@@ -26,47 +43,47 @@
 structure VarInfo =
    struct
       datatype t = T of {isUsed: bool ref,
-			 numOccurrences: int ref,
-			 ty: Type.t option,
-			 value: value option ref,
-			 var: Var.t}
+                         numOccurrences: int ref,
+                         ty: Type.t option,
+                         value: value option ref,
+                         var: Var.t}
       and value =
-	 Con of {con: Con.t,
-		 args: t vector}
-	| Const of Const.t
-	| Select of {tuple: t, offset: int}
-	| Tuple of t vector
+         Con of {con: Con.t,
+                 args: t vector}
+        | Const of Const.t
+        | Select of {tuple: t, offset: int}
+        | Tuple of t vector
 
       fun equals (T {var = x, ...}, T {var = y, ...}) = Var.equals (x, y)
-	 
+         
       fun layout (T {isUsed, numOccurrences, ty, value, var}) =
-	 let open Layout
-	 in record [("isUsed", Bool.layout (!isUsed)),
-		    ("numOccurrences", Int.layout (!numOccurrences)),
-		    ("ty", Option.layout Type.layout ty),
-		    ("value", Option.layout layoutValue (!value)),
-		    ("var", Var.layout var)]
-	 end
+         let open Layout
+         in record [("isUsed", Bool.layout (!isUsed)),
+                    ("numOccurrences", Int.layout (!numOccurrences)),
+                    ("ty", Option.layout Type.layout ty),
+                    ("value", Option.layout layoutValue (!value)),
+                    ("var", Var.layout var)]
+         end
       and layoutValue v =
-	 let open Layout
-	 in case v of
-	    Con {con, args} => seq [Con.layout con,
-				    Vector.layout layout args]
-	  | Const c => Const.layout c
-	  | Select {tuple, offset} => seq [str "#", Int.layout (offset + 1), 
-					   str " ", layout tuple]
-	  | Tuple vis => Vector.layout layout vis
-	 end
+         let open Layout
+         in case v of
+            Con {con, args} => seq [Con.layout con,
+                                    Vector.layout layout args]
+          | Const c => Const.layout c
+          | Select {tuple, offset} => seq [str "#", Int.layout (offset + 1), 
+                                           str " ", layout tuple]
+          | Tuple vis => Vector.layout layout vis
+         end
 
       fun new (x: Var.t, ty: Type.t option) = T {isUsed = ref false,
-						 numOccurrences = ref 0,
-						 ty = ty,
-						 value = ref NONE,
-						 var = x}
+                                                 numOccurrences = ref 0,
+                                                 ty = ty,
+                                                 value = ref NONE,
+                                                 var = x}
 
       fun setValue (T {value, ...}, v) =
-	 (Assert.assert ("VarInfo.setValue", fn () => Option.isNone (!value))
-	  ; value := SOME v)
+         (Assert.assert ("Ssa.Shrink.VarInfo.setValue", fn () => Option.isNone (!value))
+          ; value := SOME v)
 
 
       fun numOccurrences (T {numOccurrences = r, ...}) = r
@@ -83,18 +100,18 @@
 structure Position =
    struct
       datatype t =
-	 Formal of int
+         Formal of int
        | Free of Var.t
 
       fun layout (p: t) =
-	 case p of
-	    Formal i => Int.layout i
-	  | Free x => Var.layout x
+         case p of
+            Formal i => Int.layout i
+          | Free x => Var.layout x
 
       val equals =
-	 fn (Formal i, Formal i') => i = i'
-	  | (Free x, Free x') => Var.equals (x, x')
-	  | _ => false
+         fn (Formal i, Formal i') => i = i'
+          | (Free x, Free x') => Var.equals (x, x')
+          | _ => false
    end
 
 structure Positions = MonoVector (Position)
@@ -102,1183 +119,1188 @@
 structure LabelMeaning =
    struct
       datatype t = T of {aux: aux,
-			 blockIndex: int, (* The index of the block *)
-			 label: Label.t} (* redundant, the label of the block *)
-			 
+                         blockIndex: int, (* The index of the block *)
+                         label: Label.t} (* redundant, the label of the block *)
+                         
       and aux =
-	 Block
+         Block
        | Bug
-       | Case of {cases: Cases.t,
-		  default: Label.t option}
-       | Goto of {dst: t,
-		  args: Positions.t}
+       | Case of {canMove: Statement.t list,
+                  cases: Cases.t,
+                  default: Label.t option}
+       | Goto of {canMove: Statement.t list,
+                  dst: t,
+                  args: Positions.t}
        | Raise of {args: Positions.t,
-		   canMove: Statement.t list}
+                   canMove: Statement.t list}
        | Return of {args: Positions.t,
-		    canMove: Statement.t list}
+                    canMove: Statement.t list}
 
       local
-	 fun make f (T r) = f r
+         fun make f (T r) = f r
       in
-	 val aux = make #aux
-	 val blockIndex = make #blockIndex
+         val aux = make #aux
+         val blockIndex = make #blockIndex
       end
 
       fun layout (T {aux, label, ...}) =
-	 let
-	    open Layout
-	 in
-	    seq [Label.layout label,
-		 str " ",
-		 case aux of
-		    Block => str "Block "
-		  | Bug => str "Bug"
-		  | Case _ => str "Case"
-		  | Goto {dst, args} =>
-		       seq [str "Goto ",
-			    tuple [layout dst, Positions.layout args]]
-		  | Raise {args, ...} =>
-		       seq [str "Raise ", Positions.layout args]
-		  | Return {args, ...} =>
-		       seq [str "Return ", Positions.layout args]]
-	 end
+         let
+            open Layout
+         in
+            seq [Label.layout label,
+                 str " ",
+                 case aux of
+                    Block => str "Block "
+                  | Bug => str "Bug"
+                  | Case _ => str "Case"
+                  | Goto {dst, args, ...} =>
+                       seq [str "Goto ",
+                            tuple [layout dst, Positions.layout args]]
+                  | Raise {args, ...} =>
+                       seq [str "Raise ", Positions.layout args]
+                  | Return {args, ...} =>
+                       seq [str "Return ", Positions.layout args]]
+         end
    end
 
 structure State =
    struct
       datatype state =
-	 Unvisited
+         Unvisited
        | Visited of LabelMeaning.t
        | Visiting
 
       val layout =
-	 let
-	    open Layout
-	 in
-	    fn Unvisited => str "Unvisited"
-	     | Visited m => LabelMeaning.layout m
-	     | Visiting => str "Visiting"
-	 end
+         let
+            open Layout
+         in
+            fn Unvisited => str "Unvisited"
+             | Visited m => LabelMeaning.layout m
+             | Visiting => str "Visiting"
+         end
    end
 
-val traceApplyInfo = Trace.info "Prim.apply"
+val traceApplyInfo = Trace.info "Ssa.Shrink.Prim.apply"
 
 fun shrinkFunction {globals: Statement.t vector} =
    let
       fun use (VarInfo.T {isUsed, var, ...}): Var.t =
-	 (isUsed := true
-	  ; var)
+         (isUsed := true
+          ; var)
       fun uses (vis: VarInfo.t vector): Var.t vector = Vector.map (vis, use)
       (* varInfo can't be getSetOnce because of setReplacement. *)
       val {get = varInfo: Var.t -> VarInfo.t, set = setVarInfo, ...} =
-	 Property.getSet (Var.plist, 
-			  Property.initFun (fn x => VarInfo.new (x, NONE)))
-(*	 Property.getSet (Var.plist, Property.initFun VarInfo.new) *)
+         Property.getSet (Var.plist, 
+                          Property.initFun (fn x => VarInfo.new (x, NONE)))
+(*       Property.getSet (Var.plist, Property.initFun VarInfo.new) *)
       val setVarInfo =
-	 Trace.trace2 ("Shrink.setVarInfo",
-		       Var.layout, VarInfo.layout, Unit.layout)
-	 setVarInfo
+         Trace.trace2 ("Ssa.Shrink.setVarInfo",
+                       Var.layout, VarInfo.layout, Unit.layout)
+         setVarInfo
       fun varInfos xs = Vector.map (xs, varInfo)
       fun simplifyVar (x: Var.t) = use (varInfo x)
       val simplifyVar =
-	 Trace.trace ("Shrink.simplifyVar", Var.layout, Var.layout) simplifyVar
+         Trace.trace ("Ssa.Shrink.simplifyVar", Var.layout, Var.layout) simplifyVar
       fun simplifyVars xs = Vector.map (xs, simplifyVar)
       fun incVarInfo (x: VarInfo.t): unit =
-	 Int.inc (VarInfo.numOccurrences x)
+         Int.inc (VarInfo.numOccurrences x)
       fun incVar (x: Var.t): unit = incVarInfo (varInfo x)
       fun incVars xs = Vector.foreach (xs, incVar)
       fun numVarOccurrences (x: Var.t): int =
-	 ! (VarInfo.numOccurrences (varInfo x))
+         ! (VarInfo.numOccurrences (varInfo x))
       val _ =
-	 Vector.foreach
-	 (globals, fn Statement.T {var, exp, ty} =>
-	  let
-	     val _ = Option.app
-	             (var, fn x =>
-		      setVarInfo (x, VarInfo.new (x, SOME ty)))
-	     fun construct v =
-		Option.app (var, fn x => VarInfo.setValue (varInfo x, v))
-	  in case exp of
-	     ConApp {con, args} =>
-		construct (Value.Con {con = con,
-				      args = Vector.map (args, varInfo)})
-	   | Const c => construct (Value.Const c)
-	   | Select {tuple, offset} =>
-		construct (Value.Select {tuple = varInfo tuple,
-					 offset = offset})
-	   | Tuple xs => construct (Value.Tuple (Vector.map (xs, varInfo)))
-	   | Var y => Option.app (var, fn x => setVarInfo (x, varInfo y))
-	   | _ => ()
-	  end)
+         Vector.foreach
+         (globals, fn Statement.T {var, exp, ty} =>
+          let
+             val _ = Option.app
+                     (var, fn x =>
+                      setVarInfo (x, VarInfo.new (x, SOME ty)))
+             fun construct v =
+                Option.app (var, fn x => VarInfo.setValue (varInfo x, v))
+          in case exp of
+             ConApp {con, args} =>
+                construct (Value.Con {con = con,
+                                      args = Vector.map (args, varInfo)})
+           | Const c => construct (Value.Const c)
+           | Select {tuple, offset} =>
+                construct (Value.Select {tuple = varInfo tuple,
+                                         offset = offset})
+           | Tuple xs => construct (Value.Tuple (Vector.map (xs, varInfo)))
+           | Var y => Option.app (var, fn x => setVarInfo (x, varInfo y))
+           | _ => ()
+          end)
    in
       fn f: Function.t =>
       let
-	 val _ = Function.clear f
-	 val {args, blocks, mayInline, name, raises, returns, start, ...} =
-	    Function.dest f
-	 val _ = Vector.foreach
-	         (args, fn (x, ty) => 
-		  setVarInfo (x, VarInfo.new (x, SOME ty)))
-	 (* Index the labels by their defining block in blocks. *)
-	 val {get = labelIndex, set = setLabelIndex, ...} =
-	    Property.getSetOnce (Label.plist,
-				 Property.initRaise ("index", Label.layout))
-	 val _ = Vector.foreachi (blocks, fn (i, Block.T {label, ...}) =>
-				  setLabelIndex (label, i))
-	 val numBlocks = Vector.length blocks
-	 (* Do a DFS to compute occurrence counts and set label meanings *)
-	 val states = Array.array (numBlocks, State.Unvisited)
-	 val inDegree = Array.array (numBlocks, 0)
-	 fun addLabelIndex i = Array.inc (inDegree, i)
-	 val isHeader = Array.array (numBlocks, false)
-	 val numHandlerUses = Array.array (numBlocks, 0)
-	 fun layoutLabel (l: Label.t): Layout.t =
-	    let
-	       val i = labelIndex l
-	    in
-	       Layout.record [("label", Label.layout l),
-			      ("inDegree", Int.layout (Array.sub (inDegree, i)))]
-	    end
-	 fun incAux aux =
-	    case aux of
-	       LabelMeaning.Goto {dst, ...} =>
-		  addLabelIndex (LabelMeaning.blockIndex dst)
-	     | _ => ()
-	 fun incLabel (l: Label.t): unit =
-	    incLabelMeaning (labelMeaning l)
-	 and incLabelMeaning (LabelMeaning.T {aux, blockIndex, ...}): unit =
-	    let
-	       val i = blockIndex
-	       val n = Array.sub (inDegree, i)
-	       val _ = Array.update (inDegree, i, 1 + n)
-	    in
-	       if n = 0
-		  then incAux aux
-	       else ()
-	    end
-	 and labelMeaning (l: Label.t): LabelMeaning.t =
-	    let
-	       val i = labelIndex l
-	    in
-	       case Array.sub (states, i) of
-		  State.Visited m => m
-		| State.Visiting =>
-		     (Array.update (isHeader, i, true)
-		      ; (LabelMeaning.T
-			 {aux = LabelMeaning.Block,
-			  blockIndex = i,
-			  label = Block.label (Vector.sub (blocks, i))}))
-		| State.Unvisited => 
-		     let
-			val _ = Array.update (states, i, State.Visiting)
-			val m = computeMeaning i
-			val _ = Array.update (states, i, State.Visited m)
-		     in
-			m
-		     end
-	    end
-	 and computeMeaning (i: int): LabelMeaning.t =
-	    let
-	       val Block.T {args, statements, transfer, ...} =
-		  Vector.sub (blocks, i)
-	       val _ =
-		  Vector.foreach (args, fn (x, ty) =>
-				  setVarInfo (x, VarInfo.new (x, SOME ty)))
-	       val _ =
-		  Vector.foreach
-		  (statements, fn s => Exp.foreachVar (Statement.exp s, incVar))
-	       fun extract (actuals: Var.t vector): Positions.t =
-		  let
-		     val {get: Var.t -> Position.t, set, destroy} =
-			Property.destGetSetOnce
-			(Var.plist, Property.initFun Position.Free)
-		     val _ = Vector.foreachi (args, fn (i, (x, _)) =>
-					      set (x, Position.Formal i))
-		     val ps = Vector.map (actuals, get)
-		     val _ = destroy ()
-		  in ps
-		  end
-	       fun doit aux =
-		  LabelMeaning.T {aux = aux,
-				  blockIndex = i,
-				  label = Block.label (Vector.sub (blocks, i))}
-	       fun normal () = doit LabelMeaning.Block
-	       fun rr (xs: Var.t vector, make) =
-		  let
-		     val _ = incVars xs
-		     val n = Vector.length statements
-		     fun loop (i, ac) =
-			if i = n
-			   then
-			      if 0 = Vector.length xs
-				 orelse 0 < Vector.length args
-				 then doit (make {args = extract xs,
-						  canMove = rev ac})
-			      else normal ()
-			else
-			   let
-			      val Statement.T {exp, ty, ...} =
-				 Vector.sub (statements, i)
-			   in
-			      if (case exp of
-				     Exp.Profile _ => true
-				   | _ => false)
-				 then loop (i + 1,
-					    Statement.T {exp = exp,
-							 ty = ty,
-							 var = NONE} :: ac)
-			      else normal ()
-			   end
-		  in
-		     loop (0, [])
-		  end
-	    in
-	       case transfer of
-		  Arith {args, overflow, success, ...} =>
-		     (incVars args
-		      ; incLabel overflow
-		      ; incLabel success
-		      ; normal ())
-		| Bug =>
-		     if 0 = Vector.length statements
-			andalso (case returns of
-				    NONE => true
-				  | SOME ts =>
-				       Vector.equals
-				       (ts, args, fn (t, (_, t')) =>
-					Type.equals (t, t')))
-			then doit LabelMeaning.Bug
-		     else normal ()
+         val _ = Function.clear f
+         val {args, blocks, mayInline, name, raises, returns, start, ...} =
+            Function.dest f
+         val _ = Vector.foreach
+                 (args, fn (x, ty) => 
+                  setVarInfo (x, VarInfo.new (x, SOME ty)))
+         (* Index the labels by their defining block in blocks. *)
+         val {get = labelIndex, set = setLabelIndex, ...} =
+            Property.getSetOnce (Label.plist,
+                                 Property.initRaise ("index", Label.layout))
+         val _ = Vector.foreachi (blocks, fn (i, Block.T {label, ...}) =>
+                                  setLabelIndex (label, i))
+         val numBlocks = Vector.length blocks
+         (* Do a DFS to compute occurrence counts and set label meanings *)
+         val states = Array.array (numBlocks, State.Unvisited)
+         val inDegree = Array.array (numBlocks, 0)
+         fun addLabelIndex i = Array.inc (inDegree, i)
+         val isHeader = Array.array (numBlocks, false)
+         val numHandlerUses = Array.array (numBlocks, 0)
+         fun layoutLabel (l: Label.t): Layout.t =
+            let
+               val i = labelIndex l
+            in
+               Layout.record [("label", Label.layout l),
+                              ("inDegree", Int.layout (Array.sub (inDegree, i)))]
+            end
+         fun incAux aux =
+            case aux of
+               LabelMeaning.Goto {dst, ...} =>
+                  addLabelIndex (LabelMeaning.blockIndex dst)
+             | _ => ()
+         fun incLabel (l: Label.t): unit =
+            incLabelMeaning (labelMeaning l)
+         and incLabelMeaning (LabelMeaning.T {aux, blockIndex, ...}): unit =
+            let
+               val i = blockIndex
+               val n = Array.sub (inDegree, i)
+               val _ = Array.update (inDegree, i, 1 + n)
+            in
+               if n = 0
+                  then incAux aux
+               else ()
+            end
+         and labelMeaning (l: Label.t): LabelMeaning.t =
+            let
+               val i = labelIndex l
+            in
+               case Array.sub (states, i) of
+                  State.Visited m => m
+                | State.Visiting =>
+                     (Array.update (isHeader, i, true)
+                      ; (LabelMeaning.T
+                         {aux = LabelMeaning.Block,
+                          blockIndex = i,
+                          label = Block.label (Vector.sub (blocks, i))}))
+                | State.Unvisited => 
+                     let
+                        val _ = Array.update (states, i, State.Visiting)
+                        val m = computeMeaning i
+                        val _ = Array.update (states, i, State.Visited m)
+                     in
+                        m
+                     end
+            end
+         and computeMeaning (i: int): LabelMeaning.t =
+            let
+               val Block.T {args, statements, transfer, ...} =
+                  Vector.sub (blocks, i)
+               val _ =
+                  Vector.foreach (args, fn (x, ty) =>
+                                  setVarInfo (x, VarInfo.new (x, SOME ty)))
+               val _ =
+                  Vector.foreach
+                  (statements, fn s => Exp.foreachVar (Statement.exp s, incVar))
+               fun extract (actuals: Var.t vector): Positions.t =
+                  let
+                     val {get: Var.t -> Position.t, set, destroy} =
+                        Property.destGetSetOnce
+                        (Var.plist, Property.initFun Position.Free)
+                     val _ = Vector.foreachi (args, fn (i, (x, _)) =>
+                                              set (x, Position.Formal i))
+                     val ps = Vector.map (actuals, get)
+                     val _ = destroy ()
+                  in ps
+                  end
+               fun doit aux =
+                  LabelMeaning.T {aux = aux,
+                                  blockIndex = i,
+                                  label = Block.label (Vector.sub (blocks, i))}
+               fun normal () = doit LabelMeaning.Block
+               fun canMove () =
+                  Vector.toListMap
+                  (statements, fn Statement.T {exp, ty, ...} =>
+                   Statement.T {exp = exp, ty = ty, var = NONE})
+               fun rr (xs: Var.t vector, make) =
+                  let
+                     val _ = incVars xs
+(*
+                     val n = Vector.length statements
+                     fun loop (i, ac) =
+                        if i = n
+                           then
+                              if 0 = Vector.length xs
+                                 orelse 0 < Vector.length args
+                                 then doit (make {args = extract xs,
+                                                  canMove = rev ac})
+                              else normal ()
+                        else
+                           let
+                              val Statement.T {exp, ty, ...} =
+                                 Vector.sub (statements, i)
+                           in
+                              if Exp.isProfile exp
+                                 then loop (i + 1,
+                                            Statement.T {exp = exp,
+                                                         ty = ty,
+                                                         var = NONE} :: ac)
+                              else normal ()
+                           end
+                  in
+                     loop (0, [])
+                  end
+*)
+                  in
+                     if Vector.forall (statements, Statement.isProfile)
+                        andalso (0 = Vector.length xs
+                                 orelse 0 < Vector.length args)
+                        then doit (make {args = extract xs,
+                                         canMove = canMove ()})
+                     else normal ()
+                  end
+            in
+               case transfer of
+                  Arith {args, overflow, success, ...} =>
+                     (incVars args
+                      ; incLabel overflow
+                      ; incLabel success
+                      ; normal ())
+                | Bug =>
+                     if Vector.forall (statements, Statement.isProfile)
+                        andalso (case returns of
+                                    NONE => true
+                                  | SOME ts =>
+                                       Vector.equals
+                                       (ts, args, fn (t, (_, t')) =>
+                                        Type.equals (t, t')))
+                        then doit LabelMeaning.Bug
+                     else normal ()
                 | Call {args, return, ...} =>
-		     let
-			val _ = incVars args
-			val _ =
-			   Return.foreachHandler
-			   (return, fn l =>
-			    Array.inc (numHandlerUses, labelIndex l))
-			val _ = Return.foreachLabel (return, incLabel)
-		     in
-			normal ()
-		     end
-		| Case {test, cases, default} =>
-		     let
-			val _ = incVar test
-			val _ = Cases.foreach (cases, incLabel)
-			val _ = Option.app (default, incLabel)
-		     in
-			if 0 = Vector.length statements
-			   andalso not (Array.sub (isHeader, i))
-			   andalso 1 = Vector.length args
-			   andalso 1 = numVarOccurrences test
-			   andalso Var.equals (test, #1 (Vector.sub (args, 0)))
-			   then
-			      doit (LabelMeaning.Case {cases = cases,
-						       default = default})
-			else
-			   normal ()
-		     end
-		| Goto {dst, args = actuals} =>
-		     let
-			val _ = incVars actuals
-			val m = labelMeaning dst
-		     in
-			if 0 <> Vector.length statements
-			   orelse Array.sub (isHeader, i)
-			   then (incLabelMeaning m
-				 ; normal ())
-			else
-			   if Vector.equals (args, actuals, fn ((x, _), x') =>
-					     Var.equals (x, x')
-					     andalso 1 = numVarOccurrences x)
-			      then m (* It's an eta. *)
-			   else
-			   let
-			      val ps = extract actuals
-			      val n =
-				 Vector.fold (args, 0, fn ((x, _), n) =>
-					      n + numVarOccurrences x)
-			      val n' =
-				 Vector.fold (ps, 0, fn (p, n) =>
-					      case p of
-						 Position.Formal _ => n + 1
-					       | _ => n)
-			      datatype z = datatype LabelMeaning.aux
-			   in
-			      if n <> n'
-				 then (incLabelMeaning m
-				       ; normal ())
-			      else
-				 let
-				    fun extract (ps': Positions.t)
-				       : Positions.t =
-				       Vector.map
-				       (ps', fn p =>
-					let
-					   datatype z = datatype Position.t
-					in
-					   case p of
-					      Free x => Free x
-					    | Formal i => Vector.sub (ps, i)
-					end)
-				    val a =
-				       case LabelMeaning.aux m of
-					  Block => Goto {dst = m,
-							 args = ps}
-					| Bug => Bug
-					| Case _ => Goto {dst = m,
-							  args = ps}
-					| Goto {dst, args} =>
-					     Goto {dst = dst,
-						   args = extract args}
-					| Raise {args, canMove} =>
-					     Raise {args = extract args,
-						    canMove = canMove}
-					| Return {args, canMove} =>
-					     Return {args = extract args,
-						     canMove = canMove}
-				 in
-				    doit a
-				 end
-			   end
-		     end
-		| Raise xs => rr (xs, LabelMeaning.Raise)
-		| Return xs => rr (xs, LabelMeaning.Return)
-		| Runtime {args, return, ...} =>
-		     (incVars args
-		      ; incLabel return
-		      ; normal ())
-	    end
-	 val _ = incLabel start
-	 fun indexMeaning i =
-	    case Array.sub (states, i) of
-	       State.Visited m => m
-	     | _ => Error.bug "indexMeaning not computed"
-	 val indexMeaning =
-	    Trace.trace ("Shrink.indexMeaning", Int.layout, LabelMeaning.layout)
-	    indexMeaning
-	 val labelMeaning = indexMeaning o labelIndex
-	 val labelMeaning =
-	    Trace.trace ("Shrink.labelMeaning",
-			 Label.layout, LabelMeaning.layout)
-	    labelMeaning
-	 fun meaningLabel m =
-	    Block.label (Vector.sub (blocks, LabelMeaning.blockIndex m))
-	 fun save (f, s) =
-	    File.withOut
-	    (concat ["/tmp/", Func.toString (Function.name f),
-		     ".", s, ".dot"],
-	     fn out =>
-	     Layout.outputl
-	     (#graph (Function.layoutDot (f, fn _ => NONE)),
-	      out))
-	 val _ = if true then () else save (f, "pre")
-	 (* *)
-	 val _ =
-	    if true
-	       then ()
-	    else
-	       Layout.outputl
-	       (Vector.layout
-		(fn i =>
-		 (Layout.record
-		  [("label",
-		    Label.layout (Block.label (Vector.sub (blocks, i)))),
-		   ("inDegree", Int.layout (Array.sub (inDegree, i))),
-		   ("state", State.layout (Array.sub (states, i)))]))
-		(Vector.tabulate (numBlocks, fn i => i)),
-		Out.error)
-	 val _ =
-	    Assert.assert
-	    ("Shrink.labelMeanings", fn () =>
-	     let
-		val inDegree' = Array.array (numBlocks, 0)
-		fun bumpIndex i = Array.inc (inDegree', i)
-		fun bumpMeaning m = bumpIndex (LabelMeaning.blockIndex m)
-		val bumpLabel = bumpMeaning o labelMeaning
-		fun doit (LabelMeaning.T {aux, blockIndex, ...}) =
-		   let
-		      datatype z = datatype LabelMeaning.aux
-		   in
-		      case aux of
-			 Block =>
-			    Transfer.foreachLabel
-			    (Block.transfer (Vector.sub (blocks, blockIndex)),
-			     bumpLabel)
-		       | Bug => ()
-		       | Case {cases, default, ...} =>
-			    (Cases.foreach (cases, bumpLabel)
-			     ; Option.app (default, bumpLabel))
-		       | Goto {dst, ...} => bumpMeaning dst
-		       | Raise _ => ()
-		       | Return _ => ()
-		   end
-		val _ =
-		   Array.foreachi
-		   (states, fn (i, s) =>
-		    if Array.sub (inDegree, i) > 0
-		       then
-			  (case s of
-			      State.Visited m => doit m
-			    | _ => ())
-		    else ())
-		val _ = bumpMeaning (labelMeaning start)
-	     in
-		Array.equals (inDegree, inDegree', Int.equals)
-		orelse
-		let
-		   val _ =
-		      Layout.outputl
-		      (Vector.layout
-		       (fn i =>
-			(Layout.record
-			 [("label",
-			   Label.layout (Block.label (Vector.sub (blocks, i)))),
-			  ("inDegree", Int.layout (Array.sub (inDegree, i))),
-			  ("inDegree'", Int.layout (Array.sub (inDegree', i))),
-			  ("state", State.layout (Array.sub (states, i)))]))
-		       (Vector.tabulate (numBlocks, fn i => i)),
-		       Out.error)
-		in
-		   false
-		end
-	     end)
-	 val isBlock = Array.array (numBlocks, false)
-	 (* Functions for maintaining inDegree. *)
-	 val addLabelIndex =
-	    fn i =>
-	    (Assert.assert ("addLabelIndex", fn () =>
-			    Array.sub (inDegree, i) > 0)
-	     ; addLabelIndex i)
-	 val addLabelMeaning = addLabelIndex o LabelMeaning.blockIndex
-	 fun layoutLabelMeaning m =
-	    Layout.record
-	    [("inDegree", Int.layout (Array.sub
-				      (inDegree, LabelMeaning.blockIndex m))),
-	     ("meaning", LabelMeaning.layout m)]
-	 val traceDeleteLabelMeaning =
-	    Trace.trace ("Shrink.deleteLabelMeaning",
-			 layoutLabelMeaning, Unit.layout)
-	 fun deleteLabel l = deleteLabelMeaning (labelMeaning l)
-	 and deleteLabelMeaning arg: unit =
-	    traceDeleteLabelMeaning
-	    (fn (m: LabelMeaning.t) =>
-	    let
-	       val i = LabelMeaning.blockIndex m
-	       val n = Array.sub (inDegree, i) - 1
-	       val _ = Array.update (inDegree, i, n)
-	       val _ = Assert.assert ("deleteLabelMeaning", fn () => n >= 0)
-	    in
-	       if n = 0 (* andalso not (Array.sub (isBlock, i)) *)
-		  then
-		     let
-			datatype z = datatype LabelMeaning.aux
-		     in
-			case LabelMeaning.aux m of
-			   Block =>
-			      let
-				 val t = Block.transfer (Vector.sub (blocks, i))
-				 val _ = Transfer.foreachLabel (t, deleteLabel)
-				 val _ =
-				    case t of
-				       Transfer.Call {return, ...} =>
-					  Return.foreachHandler
-					  (return, fn l =>
-					   Array.dec (numHandlerUses,
-						      (LabelMeaning.blockIndex
-						       (labelMeaning l))))
-				     | _ => ()
-			      in
-				 ()
-			      end
-			 | Bug => ()
-			 | Case {cases, default} =>
-			      (Cases.foreach (cases, deleteLabel)
-			       ; Option.app (default, deleteLabel))
-			 | Goto {dst, ...} => deleteLabelMeaning dst
-			 | Raise _ => ()
-			 | Return _ => ()
-		     end
-	       else ()
-	    end) arg
-	 fun primApp (prim: Type.t Prim.t, args: VarInfo.t vector)
-	    : (Type.t, VarInfo.t) Prim.ApplyResult.t =
-	    case Prim.name prim of
-	       Prim.Name.FFI _ => Prim.ApplyResult.Unknown
-	     | _ =>
-		  let
-		     val args' =
-			Vector.map
-			(args, fn vi =>
-			 case vi of
-			    VarInfo.T {value = ref (SOME v), ...} =>
-			       (case v of
-				   Value.Con {con, args} =>
-				      if Vector.isEmpty args
-					 then
-					    Prim.ApplyArg.Con
-					    {con = con,
-					     hasArg = not (Vector.isEmpty args)}
-				      else Prim.ApplyArg.Var vi
-				 | Value.Const c => Prim.ApplyArg.Const c
-				 | _ => Prim.ApplyArg.Var vi)
-			  | _ => Prim.ApplyArg.Var vi)
-		  in
-		     Trace.traceInfo'
-		     (traceApplyInfo,
-		      fn (p, args, _) =>
-		      let
-			 open Layout
-		      in
-			 seq [Prim.layout p, str " ",
-			      List.layout (Prim.ApplyArg.layout
-					   (Var.layout o VarInfo.var)) args]
-		      end,
-		      Prim.ApplyResult.layout (Var.layout o VarInfo.var))
-		     Prim.apply
-		     (prim, Vector.toList args', VarInfo.equals)
-		     handle e =>
-			Error.bug (concat ["Prim.apply raised ",
-					   Layout.toString (Exn.layout e)])
-		  end
-	 (* Another DFS, this time accumulating the new blocks. *)
-      	 val traceForceMeaningBlock =
-	    Trace.trace ("Shrink.forceMeaningBlock",
-			layoutLabelMeaning, Unit.layout)
-	 val traceSimplifyBlock =
-	    Trace.trace ("Shrink.simplifyBlock",
-			 layoutLabel o Block.label,
-			 Layout.tuple2 (List.layout Statement.layout,
-					Transfer.layout))
-	 val traceGotoMeaning =
-	    Trace.trace2
-	    ("Shrink.gotoMeaning",
-	     layoutLabelMeaning,
-	     Vector.layout VarInfo.layout,
-	     Layout.tuple2 (List.layout Statement.layout, Transfer.layout))
-	 val traceEvalStatement =
-	    Trace.trace
-	    ("Shrink.evalStatement",
-	     Statement.layout,
-	     Layout.ignore: (Statement.t list -> Statement.t list) -> Layout.t)
-	 val traceSimplifyTransfer =
-	    Trace.trace ("Shrink.simplifyTransfer",
-			 Transfer.layout,
-			 Layout.tuple2 (List.layout Statement.layout,
-					Transfer.layout))
-	 val newBlocks = ref []
-	 fun simplifyLabel l =
-	    let
-	       val m = labelMeaning l
-	       val _ = forceMeaningBlock m
-	    in
-	       meaningLabel m
-	    end
-	 and forceMeaningBlock arg =
-	    traceForceMeaningBlock
-	    (fn (LabelMeaning.T {aux, blockIndex = i, ...}) =>
-	     if Array.sub (isBlock, i)
-		then ()
-	     else
-		let
-		   val _ = Array.update (isBlock, i, true)
-		   val block as Block.T {label, args, ...} =
-		      Vector.sub (blocks, i)
-		   fun extract (p: Position.t): VarInfo.t =
-		      varInfo (case p of
-				  Position.Formal n => #1 (Vector.sub (args, n))
-				| Position.Free x => x)
-		   val (statements, transfer) =
-		      let
-			 fun rr ({args, canMove}, make) =
-			    (canMove,
-			     make (Vector.map (args, use o extract)))
-			 datatype z = datatype LabelMeaning.aux
-		      in
-			 case aux of
-			    Block => simplifyBlock block
-			  | Bug => ([], Transfer.Bug)
-			  | Case _ => simplifyBlock block
-			  | Goto {dst, args} =>
-			       gotoMeaning (dst, Vector.map (args, extract))
-			  | Raise z => rr (z, Transfer.Raise)
-			  | Return z => rr (z, Transfer.Return)
-		      end
-		   val _ =
-		      List.push
-		      (newBlocks,
-		       Block.T {label = label,
-				args = args,
-				statements = Vector.fromList statements,
-				transfer = transfer})
-		in
-		   ()
-		end) arg
-	 and simplifyBlock arg : Statement.t list * Transfer.t =
-	    traceSimplifyBlock
-	    (fn (Block.T {statements, transfer, ...}) =>
-	    let
-	       val fs = Vector.map (statements, evalStatement)
-	       val (ss, transfer) = simplifyTransfer transfer
-	       val statements = Vector.foldr (fs, ss, fn (f, ss) => f ss)
-	    in
-	       (statements, transfer)
-	    end) arg
-	 and simplifyTransfer arg : Statement.t list * Transfer.t =
-	    traceSimplifyTransfer
-	    (fn (t: Transfer.t) =>
-	    case t of
-	        Arith {prim, args, overflow, success, ty} =>
-		   let
-		      val args = varInfos args
-		   in
-		      case primApp (prim, args) of
-			 Prim.ApplyResult.Const c =>
-			    let
-			       val _ = deleteLabel overflow
-			       val x = Var.newNoname ()
-			       val isUsed = ref false
-			       val vi =
-				  VarInfo.T {isUsed = isUsed,
-					     numOccurrences = ref 0,
-					     ty = SOME ty,
-					     value = ref (SOME (Value.Const c)),
-					     var = x}
-			       val (ss, t) = goto (success, Vector.new1 vi)
-			       val ss =
-				  if !isUsed
-				     then Statement.T {var = SOME x,
-						       ty = Type.ofConst c,
-						       exp = Exp.Const c}
-					:: ss
-				  else ss
-			    in
-			       (ss, t)
-			    end
-		       | Prim.ApplyResult.Var x =>
-			    let
-			       val _ = deleteLabel overflow
-			    in
-			       goto (success, Vector.new1 x)
-			    end
-		       | Prim.ApplyResult.Overflow =>
-			    let
-			       val _ = deleteLabel success
-			    in
-			       goto (overflow, Vector.new0 ())
-			    end
-		       | Prim.ApplyResult.Apply (prim, args) =>
-			    let val args = Vector.fromList args
-			    in
-			       ([], Arith {prim = prim,
-					   args = uses args,
-					   overflow = simplifyLabel overflow,
-					   success = simplifyLabel success,
-					   ty = ty})
-			    end					
-		       | _ =>
-			    ([], Arith {prim = prim,
-					args = uses args,
-					overflow = simplifyLabel overflow,
-					success = simplifyLabel success,
-					ty = ty})
-		   end
-	     | Bug => ([], Bug)
-	     | Call {func, args, return} =>
-		  let
-		     val (statements, return) =
-			case return of
-			   Return.NonTail {cont, handler} =>
-			      let
-				 fun isEta (m: LabelMeaning.t,
-					    ps: Position.t vector): bool =
-				    Vector.length ps
-				    = (Vector.length
-				       (Block.args
-					(Vector.sub
-					 (blocks, LabelMeaning.blockIndex m))))
-				    andalso
-				    Vector.foralli
-				    (ps,
-				     fn (i, Position.Formal i') => i = i'
-				      | _ => false)
-				 val m = labelMeaning cont
-				 fun nonTail () =
-				    let
-				       val _ = forceMeaningBlock m
-				       val handler =
-					  Handler.map
-					  (handler, fn l =>
-					   let
-					      val m = labelMeaning l
-					      val _ = forceMeaningBlock m
-					   in
-					      meaningLabel m
-					   end)
-				    in
-				       ([],
-					Return.NonTail {cont = meaningLabel m,
-							handler = handler})
-				    end
-				 fun tail statements =
-				    (deleteLabelMeaning m
-				     ; (statements, Return.Tail))
-				 fun cont handlerEta =
-				    case LabelMeaning.aux m of
-				       LabelMeaning.Bug =>
-					  (case handlerEta of
-					      NONE => nonTail ()
-					    | SOME canMove => tail canMove)
-				     | LabelMeaning.Return {args, canMove} =>
-					  if isEta (m, args)
-					     then tail canMove
-					  else nonTail ()
-				     | _ => nonTail ()
+                     let
+                        val _ = incVars args
+                        val _ =
+                           Return.foreachHandler
+                           (return, fn l =>
+                            Array.inc (numHandlerUses, labelIndex l))
+                        val _ = Return.foreachLabel (return, incLabel)
+                     in
+                        normal ()
+                     end
+                | Case {test, cases, default} =>
+                     let
+                        val _ = incVar test
+                        val _ = Cases.foreach (cases, incLabel)
+                        val _ = Option.app (default, incLabel)
+                     in
+                        if Vector.forall (statements, Statement.isProfile)
+                           andalso not (Array.sub (isHeader, i))
+                           andalso 1 = Vector.length args
+                           andalso 1 = numVarOccurrences test
+                           andalso Var.equals (test, #1 (Vector.sub (args, 0)))
+                           then
+                              doit (LabelMeaning.Case {canMove = canMove (),
+                                                       cases = cases,
+                                                       default = default})
+                        else
+                           normal ()
+                     end
+                | Goto {dst, args = actuals} =>
+                     let
+                        val _ = incVars actuals
+                        val m = labelMeaning dst
+                     in
+                        if Vector.exists (statements, not o Statement.isProfile)
+                           orelse Array.sub (isHeader, i)
+                           then (incLabelMeaning m
+                                 ; normal ())
+                        else
+                           if 0 = Vector.length statements
+                              andalso
+                              Vector.equals (args, actuals, fn ((x, _), x') =>
+                                             Var.equals (x, x')
+                                             andalso 1 = numVarOccurrences x)
+                              then m (* It's an eta. *)
+                           else
+                           let
+                              val ps = extract actuals
+                              val n =
+                                 Vector.fold (args, 0, fn ((x, _), n) =>
+                                              n + numVarOccurrences x)
+                              val n' =
+                                 Vector.fold (ps, 0, fn (p, n) =>
+                                              case p of
+                                                 Position.Formal _ => n + 1
+                                               | _ => n)
+                              datatype z = datatype LabelMeaning.aux
+                           in
+                              if n <> n'
+                                 then (incLabelMeaning m
+                                       ; normal ())
+                              else
+                                 let
+                                    fun extract (ps': Positions.t)
+                                       : Positions.t =
+                                       Vector.map
+                                       (ps', fn p =>
+                                        let
+                                           datatype z = datatype Position.t
+                                        in
+                                           case p of
+                                              Free x => Free x
+                                            | Formal i => Vector.sub (ps, i)
+                                        end)
+                                    val canMove' = canMove ()
+                                    val a =
+                                       case LabelMeaning.aux m of
+                                          Block =>
+                                             Goto {canMove = canMove',
+                                                   dst = m,
+                                                   args = ps}
+                                        | Bug => Bug
+                                        | Case _ => 
+                                             Goto {canMove = canMove',
+                                                   dst = m,
+                                                   args = ps}
+                                        | Goto {canMove, dst, args} =>
+                                             Goto {canMove = canMove' @ canMove,
+                                                   dst = dst,
+                                                   args = extract args}
+                                        | Raise {args, canMove} =>
+                                             Raise {args = extract args,
+                                                    canMove = canMove' @ canMove}
+                                        | Return {args, canMove} =>
+                                             Return {args = extract args,
+                                                     canMove = canMove' @ canMove}
+                                 in
+                                    doit a
+                                 end
+                           end
+                     end
+                | Raise xs => rr (xs, LabelMeaning.Raise)
+                | Return xs => rr (xs, LabelMeaning.Return)
+                | Runtime {args, return, ...} =>
+                     (incVars args
+                      ; incLabel return
+                      ; normal ())
+            end
+         val _ = incLabel start
+         fun indexMeaning i =
+            case Array.sub (states, i) of
+               State.Visited m => m
+             | _ => Error.bug "Ssa.Shrink.indexMeaning: not computed"
+         val indexMeaning =
+            Trace.trace ("Ssa.Shrink.indexMeaning", Int.layout, LabelMeaning.layout)
+            indexMeaning
+         val labelMeaning = indexMeaning o labelIndex
+         val labelMeaning =
+            Trace.trace ("Ssa.Shrink.labelMeaning",
+                         Label.layout, LabelMeaning.layout)
+            labelMeaning
+         fun meaningLabel m =
+            Block.label (Vector.sub (blocks, LabelMeaning.blockIndex m))
+         fun save (f, s) =
+            File.withOut
+            (concat ["/tmp/", Func.toString (Function.name f),
+                     ".", s, ".dot"],
+             fn out =>
+             Layout.outputl
+             (#graph (Function.layoutDot (f, fn _ => NONE)),
+              out))
+         val _ = if true then () else save (f, "pre")
+         (* *)
+         val _ =
+            if true
+               then ()
+            else
+               Layout.outputl
+               (Vector.layout
+                (fn i =>
+                 (Layout.record
+                  [("label",
+                    Label.layout (Block.label (Vector.sub (blocks, i)))),
+                   ("inDegree", Int.layout (Array.sub (inDegree, i))),
+                   ("state", State.layout (Array.sub (states, i)))]))
+                (Vector.tabulate (numBlocks, fn i => i)),
+                Out.error)
+         val _ =
+            Assert.assert
+            ("Ssa.Shrink.labelMeanings", fn () =>
+             let
+                val inDegree' = Array.array (numBlocks, 0)
+                fun bumpIndex i = Array.inc (inDegree', i)
+                fun bumpMeaning m = bumpIndex (LabelMeaning.blockIndex m)
+                val bumpLabel = bumpMeaning o labelMeaning
+                fun doit (LabelMeaning.T {aux, blockIndex, ...}) =
+                   let
+                      datatype z = datatype LabelMeaning.aux
+                   in
+                      case aux of
+                         Block =>
+                            Transfer.foreachLabel
+                            (Block.transfer (Vector.sub (blocks, blockIndex)),
+                             bumpLabel)
+                       | Bug => ()
+                       | Case {cases, default, ...} =>
+                            (Cases.foreach (cases, bumpLabel)
+                             ; Option.app (default, bumpLabel))
+                       | Goto {dst, ...} => bumpMeaning dst
+                       | Raise _ => ()
+                       | Return _ => ()
+                   end
+                val _ =
+                   Array.foreachi
+                   (states, fn (i, s) =>
+                    if Array.sub (inDegree, i) > 0
+                       then
+                          (case s of
+                              State.Visited m => doit m
+                            | _ => ())
+                    else ())
+                val _ = bumpMeaning (labelMeaning start)
+             in
+                Array.equals (inDegree, inDegree', Int.equals)
+                orelse
+                let
+                   val _ =
+                      Layout.outputl
+                      (Vector.layout
+                       (fn i =>
+                        (Layout.record
+                         [("label",
+                           Label.layout (Block.label (Vector.sub (blocks, i)))),
+                          ("inDegree", Int.layout (Array.sub (inDegree, i))),
+                          ("inDegree'", Int.layout (Array.sub (inDegree', i))),
+                          ("state", State.layout (Array.sub (states, i)))]))
+                       (Vector.tabulate (numBlocks, fn i => i)),
+                       Out.error)
+                in
+                   false
+                end
+             end)
+         val isBlock = Array.array (numBlocks, false)
+         (* Functions for maintaining inDegree. *)
+         val addLabelIndex =
+            fn i =>
+            (Assert.assert ("Ssa.Shrink.addLabelIndex", fn () =>
+                            Array.sub (inDegree, i) > 0)
+             ; addLabelIndex i)
+         val addLabelMeaning = addLabelIndex o LabelMeaning.blockIndex
+         fun layoutLabelMeaning m =
+            Layout.record
+            [("inDegree", Int.layout (Array.sub
+                                      (inDegree, LabelMeaning.blockIndex m))),
+             ("meaning", LabelMeaning.layout m)]
+         val traceDeleteLabelMeaning =
+            Trace.trace ("SSa.Shrink.deleteLabelMeaning",
+                         layoutLabelMeaning, Unit.layout)
+         fun deleteLabel l = deleteLabelMeaning (labelMeaning l)
+         and deleteLabelMeaning arg: unit =
+            traceDeleteLabelMeaning
+            (fn (m: LabelMeaning.t) =>
+            let
+               val i = LabelMeaning.blockIndex m
+               val n = Array.sub (inDegree, i) - 1
+               val _ = Array.update (inDegree, i, n)
+               val _ = Assert.assert ("Ssa.Shrink.deleteLabelMeaning", fn () => n >= 0)
+            in
+               if n = 0 (* andalso not (Array.sub (isBlock, i)) *)
+                  then
+                     let
+                        datatype z = datatype LabelMeaning.aux
+                     in
+                        case LabelMeaning.aux m of
+                           Block =>
+                              let
+                                 val t = Block.transfer (Vector.sub (blocks, i))
+                                 val _ = Transfer.foreachLabel (t, deleteLabel)
+                                 val _ =
+                                    case t of
+                                       Transfer.Call {return, ...} =>
+                                          Return.foreachHandler
+                                          (return, fn l =>
+                                           Array.dec (numHandlerUses,
+                                                      (LabelMeaning.blockIndex
+                                                       (labelMeaning l))))
+                                     | _ => ()
+                              in
+                                 ()
+                              end
+                         | Bug => ()
+                         | Case {cases, default, ...} =>
+                              (Cases.foreach (cases, deleteLabel)
+                               ; Option.app (default, deleteLabel))
+                         | Goto {dst, ...} => deleteLabelMeaning dst
+                         | Raise _ => ()
+                         | Return _ => ()
+                     end
+               else ()
+            end) arg
+         fun primApp (prim: Type.t Prim.t, args: VarInfo.t vector)
+            : (Type.t, VarInfo.t) Prim.ApplyResult.t =
+            case Prim.name prim of
+               Prim.Name.FFI _ => Prim.ApplyResult.Unknown
+             | _ =>
+                  let
+                     val args' =
+                        Vector.map
+                        (args, fn vi =>
+                         case vi of
+                            VarInfo.T {value = ref (SOME v), ...} =>
+                               (case v of
+                                   Value.Con {con, args} =>
+                                      if Vector.isEmpty args
+                                         then
+                                            Prim.ApplyArg.Con
+                                            {con = con,
+                                             hasArg = not (Vector.isEmpty args)}
+                                      else Prim.ApplyArg.Var vi
+                                 | Value.Const c => Prim.ApplyArg.Const c
+                                 | _ => Prim.ApplyArg.Var vi)
+                          | _ => Prim.ApplyArg.Var vi)
+                  in
+                     Trace.traceInfo'
+                     (traceApplyInfo,
+                      fn (p, args, _) =>
+                      let
+                         open Layout
+                      in
+                         seq [Prim.layout p, str " ",
+                              List.layout (Prim.ApplyArg.layout
+                                           (Var.layout o VarInfo.var)) args]
+                      end,
+                      Prim.ApplyResult.layout (Var.layout o VarInfo.var))
+                     Prim.apply
+                     (prim, Vector.toList args', VarInfo.equals)
+                  end
+         (* Another DFS, this time accumulating the new blocks. *)
+         val traceForceMeaningBlock =
+            Trace.trace ("Ssa.Shrink.forceMeaningBlock",
+                        layoutLabelMeaning, Unit.layout)
+         val traceSimplifyBlock =
+            Trace.trace2 ("Ssa.Shrink.simplifyBlock",
+                          List.layout Statement.layout,
+                          layoutLabel o Block.label,
+                          Layout.tuple2 (List.layout Statement.layout,
+                                         Transfer.layout))
+         val traceGotoMeaning =
+            Trace.trace3
+            ("Ssa.Shrink.gotoMeaning",
+             List.layout Statement.layout,
+             layoutLabelMeaning,
+             Vector.layout VarInfo.layout,
+             Layout.tuple2 (List.layout Statement.layout, Transfer.layout))
+         val traceEvalStatement =
+            Trace.trace
+            ("Ssa.Shrink.evalStatement",
+             Statement.layout,
+             Layout.ignore: (Statement.t list -> Statement.t list) -> Layout.t)
+         val traceSimplifyTransfer =
+            Trace.trace ("Ssa.Shrink.simplifyTransfer",
+                         Transfer.layout,
+                         Layout.tuple2 (List.layout Statement.layout,
+                                        Transfer.layout))
+         val newBlocks = ref []
+         fun simplifyLabel l =
+            let
+               val m = labelMeaning l
+               val _ = forceMeaningBlock m
+            in
+               meaningLabel m
+            end
+         and forceMeaningBlock arg =
+            traceForceMeaningBlock
+            (fn (LabelMeaning.T {aux, blockIndex = i, ...}) =>
+             if Array.sub (isBlock, i)
+                then ()
+             else
+                let
+                   val _ = Array.update (isBlock, i, true)
+                   val block as Block.T {label, args, ...} =
+                      Vector.sub (blocks, i)
+                   fun extract (p: Position.t): VarInfo.t =
+                      varInfo (case p of
+                                  Position.Formal n => #1 (Vector.sub (args, n))
+                                | Position.Free x => x)
+                   val (statements, transfer) =
+                      let
+                         fun rr ({args, canMove}, make) =
+                            (canMove,
+                             make (Vector.map (args, use o extract)))
+                         datatype z = datatype LabelMeaning.aux
+                      in
+                         case aux of
+                            Block => simplifyBlock ([], block)
+                          | Bug => ([], Transfer.Bug)
+                          | Case _ => simplifyBlock ([], block)
+                          | Goto {canMove, dst, args} =>
+                               gotoMeaning
+                               (canMove,
+                                dst,
+                                Vector.map (args, extract))
+                          | Raise z => rr (z, Transfer.Raise)
+                          | Return z => rr (z, Transfer.Return)
+                      end
+                   val _ =
+                      List.push
+                      (newBlocks,
+                       Block.T {label = label,
+                                args = args,
+                                statements = Vector.fromList statements,
+                                transfer = transfer})
+                in
+                   ()
+                end) arg
+         and simplifyBlock arg : Statement.t list * Transfer.t =
+            traceSimplifyBlock
+            (fn (canMoveIn, Block.T {statements, transfer, ...}) =>
+            let
+               val f = evalStatements statements
+               val (ss, transfer) = simplifyTransfer transfer
+            in
+               (canMoveIn @ (f ss), transfer)
+            end) arg
+         and evalStatements (ss: Statement.t vector)
+            : Statement.t list -> Statement.t list =
+            let
+               val fs = Vector.map (ss, evalStatement)
+            in
+               fn ss => Vector.foldr (fs, ss, fn (f, ss) => f ss)
+            end
+         and simplifyTransfer arg : Statement.t list * Transfer.t =
+            traceSimplifyTransfer
+            (fn (t: Transfer.t) =>
+            case t of
+                Arith {prim, args, overflow, success, ty} =>
+                   let
+                      val args = varInfos args
+                   in
+                      case primApp (prim, args) of
+                         Prim.ApplyResult.Const c =>
+                            let
+                               val _ = deleteLabel overflow
+                               val x = Var.newNoname ()
+                               val isUsed = ref false
+                               val vi =
+                                  VarInfo.T {isUsed = isUsed,
+                                             numOccurrences = ref 0,
+                                             ty = SOME ty,
+                                             value = ref (SOME (Value.Const c)),
+                                             var = x}
+                               val (ss, t) = goto (success, Vector.new1 vi)
+                               val ss =
+                                  if !isUsed
+                                     then Statement.T {var = SOME x,
+                                                       ty = Type.ofConst c,
+                                                       exp = Exp.Const c}
+                                        :: ss
+                                  else ss
+                            in
+                               (ss, t)
+                            end
+                       | Prim.ApplyResult.Var x =>
+                            let
+                               val _ = deleteLabel overflow
+                            in
+                               goto (success, Vector.new1 x)
+                            end
+                       | Prim.ApplyResult.Overflow =>
+                            let
+                               val _ = deleteLabel success
+                            in
+                               goto (overflow, Vector.new0 ())
+                            end
+                       | Prim.ApplyResult.Apply (prim, args) =>
+                            let val args = Vector.fromList args
+                            in
+                               ([], Arith {prim = prim,
+                                           args = uses args,
+                                           overflow = simplifyLabel overflow,
+                                           success = simplifyLabel success,
+                                           ty = ty})
+                            end                                 
+                       | _ =>
+                            ([], Arith {prim = prim,
+                                        args = uses args,
+                                        overflow = simplifyLabel overflow,
+                                        success = simplifyLabel success,
+                                        ty = ty})
+                   end
+             | Bug => ([], Bug)
+             | Call {func, args, return} =>
+                  let
+                     val (statements, return) =
+                        case return of
+                           Return.NonTail {cont, handler} =>
+                              let
+                                 fun isEta (m: LabelMeaning.t,
+                                            ps: Position.t vector): bool =
+                                    Vector.length ps
+                                    = (Vector.length
+                                       (Block.args
+                                        (Vector.sub
+                                         (blocks, LabelMeaning.blockIndex m))))
+                                    andalso
+                                    Vector.foralli
+                                    (ps,
+                                     fn (i, Position.Formal i') => i = i'
+                                      | _ => false)
+                                 val m = labelMeaning cont
+                                 fun nonTail () =
+                                    let
+                                       val _ = forceMeaningBlock m
+                                       val handler =
+                                          Handler.map
+                                          (handler, fn l =>
+                                           let
+                                              val m = labelMeaning l
+                                              val _ = forceMeaningBlock m
+                                           in
+                                              meaningLabel m
+                                           end)
+                                    in
+                                       ([],
+                                        Return.NonTail {cont = meaningLabel m,
+                                                        handler = handler})
+                                    end
+                                 fun tail statements =
+                                    (deleteLabelMeaning m
+                                     ; (statements, Return.Tail))
+                                 fun cont handlerEta =
+                                    case LabelMeaning.aux m of
+                                       LabelMeaning.Bug =>
+                                          (case handlerEta of
+                                              NONE => nonTail ()
+                                            | SOME canMove => tail canMove)
+                                     | LabelMeaning.Return {args, canMove} =>
+                                          if isEta (m, args)
+                                             then tail canMove
+                                          else nonTail ()
+                                     | _ => nonTail ()
 
-			      in
-				 case handler of
-				    Handler.Caller => cont NONE
-				  | Handler.Dead => cont NONE
-				  | Handler.Handle l =>
-				       let
-					  val m = labelMeaning l
-				       in
-					  case LabelMeaning.aux m of
-					     LabelMeaning.Bug => cont NONE
-					   | LabelMeaning.Raise {args, canMove} =>
-						if isEta (m, args)
-						   then cont (SOME canMove)
-						else nonTail ()
-					   | _ => nonTail ()
-				       end
-			      end
-			 | _ => ([], return)
-		  in 
-		     (statements,
-		      Call {func = func,
-			    args = simplifyVars args,
-			    return = return})
-		  end
-	      | Case {test, cases, default} =>
-		   let
-		      val test = varInfo test
-		      fun cantSimplify () =
-			 ([],
-			  Case {test = use test,
-				cases = Cases.map (cases, simplifyLabel),
-				default = Option.map (default, simplifyLabel)})
-		   in
-		      simplifyCase
-		      {cantSimplify = cantSimplify,
-		       cases = cases,
-		       default = default,
-		       gone = fn () => (Cases.foreach (cases, deleteLabel)
-					; Option.app (default, deleteLabel)),
-		       test = test}
-		   end
-	      | Goto {dst, args} => goto (dst, varInfos args)
-	      | Raise xs => ([], Raise (simplifyVars xs))
-	      | Return xs => ([], Return (simplifyVars xs))
-	      | Runtime {prim, args, return} =>
-		   ([], Runtime {prim = prim, 
-				 args = simplifyVars args, 
-				 return = simplifyLabel return})
-		   ) arg
-	 and simplifyCase {cantSimplify, cases, default, gone, test: VarInfo.t}
-	    : Statement.t list * Transfer.t =
-	    let
-	       (* tryToEliminate makes sure that the destination meaning
-		* hasn't already been simplified.  If it has, then we can't
-		* simplify the case.
-		*)
-	       fun tryToEliminate m =
-		  let
-		     val i = LabelMeaning.blockIndex m
-		  in
-		     if Array.sub (inDegree, i) = 0
-			then cantSimplify ()
-		     else
-			let
-			   val _ = addLabelIndex i
-			   val _ = gone ()
-			in
-			   gotoMeaning (m, Vector.new0 ())
-			end
-		  end
-	    in
-	       if Cases.isEmpty cases
-		  then (case default of
-			   NONE => ([], Bug)
-			 | SOME l => tryToEliminate (labelMeaning l))
-	       else
-		  let
-		     val l = Cases.hd cases
-		     fun isOk (l': Label.t): bool = Label.equals (l, l')
-		  in
-		     if 0 = Vector.length (Block.args
-					   (Vector.sub (blocks, labelIndex l)))
-			andalso Cases.forall (cases, isOk)
-			andalso (case default of
-				    NONE => true
-				  | SOME l => isOk l)
-			then
-			   (* All cases the same -- eliminate the case. *)
-			   tryToEliminate (labelMeaning l)
-		     else
-			let
-			   fun findCase (cases, is, args) =
-			      let
-				 val n = Vector.length cases
-				 fun doit (j, args) =
-				    let
-				       val m = labelMeaning j
-				       val _ = addLabelMeaning m
-				       val _ = gone ()
-				    in
-				       gotoMeaning (m, args)
-				    end
-				 fun loop k =
-				    if k = n
-				       then
-					  (case default of
-					      NONE => (gone (); ([], Bug))
-					    | SOME j => doit (j, Vector.new0 ()))
-				    else
-				       let
-					  val (i, j) = Vector.sub (cases, k)
-				       in
-					  if is i
-					     then doit (j, args)
-					  else loop (k + 1)
-				       end
-			      in
-				 loop 0
-			      end
-			in
-			   case (VarInfo.value test, cases) of
-			      (SOME (Value.Const c), _) =>
-				 (case (cases, c) of
-				     (Cases.Word (_, cs), Const.Word w) =>
-					findCase (cs,
-						  fn w' => WordX.equals (w, w'),
-						  Vector.new0 ())
-				   | _ =>
-					Error.bug "strange constant for cases")
-			    | (SOME (Value.Con {con, args}), Cases.Con cases) =>
-				 findCase (cases,
-					   fn c => Con.equals (con, c),
-					   args)
-			    | _ => cantSimplify ()
-(*
-			    | (NONE, _) => cantSimplify ()
-			    | (_, _) =>
-				 Error.bug
-				 (concat
-				  ["strange bind for case test: ",
-				   Layout.toString (VarInfo.layout test)])
-*)
-			end
-		  end
-	    end
-	 and goto (dst: Label.t, args: VarInfo.t vector)
-	    : Statement.t list * Transfer.t =
-	    gotoMeaning (labelMeaning dst, args)
-	 and gotoMeaning arg : Statement.t list * Transfer.t =
-	    traceGotoMeaning
-	    (fn (m as LabelMeaning.T {aux, blockIndex = i, ...},
-		 args: VarInfo.t vector) =>
-	     let
-		val n = Array.sub (inDegree, i)
-		val _ = Assert.assert ("goto", fn () => n >= 1)
-		fun normal () =
-		   if n = 1
-		      then
-			 let
-			    val _ = Array.update (inDegree, i, 0)
-			    val b = Vector.sub (blocks, i)
-			    val _ =
-			       Vector.foreach2
-			       (Block.args b, args, fn ((x, _), vi) =>
-				setVarInfo (x, vi))
-			 in
-			    simplifyBlock b
-			 end
-		   else
-		      let
-			 val _ = forceMeaningBlock m
-		      in
-			 ([],
-			  Goto {dst = Block.label (Vector.sub (blocks, i)),
-				args = uses args})
-		      end
-		fun extract p =
-		   case p of
-		      Position.Formal n => Vector.sub (args, n)
-		    | Position.Free x => varInfo x
-		fun rr ({args, canMove}, make) =
-		   (canMove, make (Vector.map (args, use o extract)))
-		datatype z = datatype LabelMeaning.aux
-	     in
-		case aux of
-		   Block => normal ()
-		 | Bug => ([], Transfer.Bug)
-		 | Case {cases, default} =>
-		      simplifyCase {cantSimplify = normal,
-				    cases = cases,
-				    default = default,
-				    gone = fn () => deleteLabelMeaning m,
-				    test = Vector.sub (args, 0)}
-		 | Goto {dst, args} =>
-		      if Array.sub (isHeader, i)
-			 orelse Array.sub (isBlock, i)
-			 then normal ()
-		      else
-			 let
-			    val n' = n - 1
-			    val _ = Array.update (inDegree, i, n')
-			    val _ = 
-			       if n' > 0
-				  then addLabelMeaning dst
-			       else ()
-			 in
-			    gotoMeaning (dst, Vector.map (args, extract))
-			 end
-		 | Raise z => rr (z, Transfer.Raise)
-		 | Return z => rr (z, Transfer.Return)
-	     end) arg
-	 and evalStatement arg : Statement.t list -> Statement.t list =
-	    traceEvalStatement
-	    (fn (Statement.T {var, ty, exp}) =>
-	    let
-	       val _ = Option.app 
-		       (var, fn x => 
-			setVarInfo (x, VarInfo.new (x, SOME ty)))
-	       fun delete ss = ss
-	       fun doit {makeExp: unit -> Exp.t,
-			 sideEffect: bool,
-			 value: Value.t option} =
-		  let
-		     fun make var =
-			Statement.T {var = var,
-				     ty = ty,
-				     exp = makeExp ()}
-		  in
-		     case var of
-			NONE =>
-			   if sideEffect
-			      then (fn ss => make NONE :: ss)
-			   else delete
-		      | SOME x =>
-			   let
-			      val VarInfo.T {isUsed, value = r, ...} = varInfo x
-			      val _ = r := value
-			   in
-			      fn ss =>
-			      if !isUsed
-				 then make (SOME x) :: ss
-			      else if sideEffect
-				      then make NONE :: ss
-				   else ss
-			   end
-		  end
-	       fun setVar vi =
-		  (Option.app (var, fn x => setVarInfo (x, vi))
-		   ; delete)
-	       fun construct (v: Value.t, makeExp) =
-		  doit {makeExp = makeExp,
-			sideEffect = false,
-			value = SOME v}
-	    in
-	       case exp of
-		  ConApp {con, args} =>
-		     let
-			val args = varInfos args
-		     in
-			construct (Value.Con {con = con, args = args},
-				   fn () => ConApp {con = con,
-						    args = uses args})
-		     end
-		| Const c => construct (Value.Const c, fn () => exp)
-		| PrimApp {prim, targs, args} =>
-		     let
-			val args = varInfos args
-			fun apply {prim, targs, args} =
-			   doit {sideEffect = Prim.maySideEffect prim,
-				 makeExp = fn () => PrimApp {prim = prim,
-							     targs = targs,
-							     args = uses args},
-				 value = NONE}
-			datatype z = datatype Prim.ApplyResult.t
-		     in
-			case primApp (prim, args) of
-			   Apply (p, args) => apply {prim = p,
-						     targs = Vector.new0 (),
-						     args = Vector.fromList args}
-			 | Bool b =>
-			      let
-				 val con = Con.fromBool b
-			      in
-				 construct (Value.Con {con = con,
-						       args = Vector.new0 ()},
-					    fn () =>
-					    ConApp {con = con,
-						    args = Vector.new0 ()})
-			      end
-			 | Const c => construct (Value.Const c,
-						 fn () => Exp.Const c)
-			 | Var vi => setVar vi
-			 | _ => apply {prim = prim,
-				       targs = targs,
-				       args = args}
-		     end
-		| Select {tuple, offset} =>
-		     let
-			val tuple as VarInfo.T {value, ...} = varInfo tuple
-		     in
-			case !value of
-			   SOME (Value.Tuple vs) =>
-			      setVar (Vector.sub (vs, offset))
-			 | _ =>
-			      construct (Value.Select {tuple = tuple, 
-						       offset = offset},
-					 fn () => Select {tuple = use tuple,
-							  offset = offset})
-(*
-			 | _ => Error.bug
-				(concat
-				  ["select of non-tuple: ",
-				   Layout.toString (VarInfo.layout tuple)])
-*)
-		     end
-		| Tuple xs =>
-		     let
-			val xs = varInfos xs
-		     in
-                        case DynamicWind.withEscape
-			     (fn escape =>
-			      Vector.foldri
-			      (xs, NONE,
-			       fn (i, VarInfo.T {value, ...}, tuple') => 
-			       case !value of
-				  SOME (Value.Select {offset, tuple}) =>
-				     if offset = i
-				        then case tuple' of
-					        NONE => 
-						   (case VarInfo.ty tuple of
-						       SOME ty =>
-							  (case Type.deTupleOpt ty of
-							      SOME ts =>
-								 if Vector.length xs =
-								    Vector.length ts
-								    then SOME tuple
-								 else escape NONE
-							    | NONE => escape NONE)
-						     | NONE => escape NONE)
-					      | SOME tuple'' => 
-						   if VarInfo.equals (tuple'', tuple)
-						      then tuple'
-						   else escape NONE
-				     else escape NONE
-				| _ => escape NONE)) of
-			  SOME tuple => setVar tuple
-			| NONE => construct (Value.Tuple xs,
-					     fn () => Tuple (uses xs))
-		     end
-		| Var x => setVar (varInfo x)
-		| _ => doit {makeExp = fn () => exp,
-			     sideEffect = true,
-			     value = NONE}
-	    end) arg
-	 val start = labelMeaning start
-	 val _ = forceMeaningBlock start
-	 val f = 
-	    Function.new {args = args,
-			  blocks = Vector.fromList (!newBlocks),
-			  mayInline = mayInline,
-			  name = name,
-			  raises = raises,
-			  returns = returns,
-			  start = meaningLabel start}
-(*	 val _ = save (f, "post") *)
-	 val _ = Function.clear f
+                              in
+                                 case handler of
+                                    Handler.Caller => cont NONE
+                                  | Handler.Dead => cont NONE
+                                  | Handler.Handle l =>
+                                       let
+                                          val m = labelMeaning l
+                                       in
+                                          case LabelMeaning.aux m of
+                                             LabelMeaning.Bug => cont NONE
+                                           | LabelMeaning.Raise {args, canMove} =>
+                                                if isEta (m, args)
+                                                   then cont (SOME canMove)
+                                                else nonTail ()
+                                           | _ => nonTail ()
+                                       end
+                              end
+                         | _ => ([], return)
+                  in 
+                     (statements,
+                      Call {func = func,
+                            args = simplifyVars args,
+                            return = return})
+                  end
+              | Case {test, cases, default} =>
+                   let
+                      val test = varInfo test
+                      fun cantSimplify () =
+                         ([],
+                          Case {test = use test,
+                                cases = Cases.map (cases, simplifyLabel),
+                                default = Option.map (default, simplifyLabel)})
+                   in
+                      simplifyCase
+                      {canMove = [],
+                       cantSimplify = cantSimplify,
+                       cases = cases,
+                       default = default,
+                       gone = fn () => (Cases.foreach (cases, deleteLabel)
+                                        ; Option.app (default, deleteLabel)),
+                       test = test}
+                   end
+              | Goto {dst, args} => goto (dst, varInfos args)
+              | Raise xs => ([], Raise (simplifyVars xs))
+              | Return xs => ([], Return (simplifyVars xs))
+              | Runtime {prim, args, return} =>
+                   ([], Runtime {prim = prim, 
+                                 args = simplifyVars args, 
+                                 return = simplifyLabel return})
+                   ) arg
+         and simplifyCase {canMove, cantSimplify, 
+                           cases, default, gone, test: VarInfo.t}
+            : Statement.t list * Transfer.t =
+            let
+               (* tryToEliminate makes sure that the destination meaning
+                * hasn't already been simplified.  If it has, then we can't
+                * simplify the case.
+                *)
+               fun tryToEliminate m =
+                  let
+                     val i = LabelMeaning.blockIndex m
+                  in
+                     if Array.sub (inDegree, i) = 0
+                        then cantSimplify ()
+                     else
+                        let
+                           val _ = addLabelIndex i
+                           val _ = gone ()
+                        in
+                           gotoMeaning (canMove, m, Vector.new0 ())
+                        end
+                  end
+            in
+               if Cases.isEmpty cases
+                  then (case default of
+                           NONE => (canMove, Bug)
+                         | SOME l => tryToEliminate (labelMeaning l))
+               else
+                  let
+                     val l = Cases.hd cases
+                     fun isOk (l': Label.t): bool = Label.equals (l, l')
+                  in
+                     if 0 = Vector.length (Block.args
+                                           (Vector.sub (blocks, labelIndex l)))
+                        andalso Cases.forall (cases, isOk)
+                        andalso (case default of
+                                    NONE => true
+                                  | SOME l => isOk l)
+                        then
+                           (* All cases the same -- eliminate the case. *)
+                           tryToEliminate (labelMeaning l)
+                     else
+                        let
+                           fun findCase (cases, is, args) =
+                              let
+                                 val n = Vector.length cases
+                                 fun doit (j, args) =
+                                    let
+                                       val m = labelMeaning j
+                                       val _ = addLabelMeaning m
+                                       val _ = gone ()
+                                    in
+                                       gotoMeaning (canMove, m, args)
+                                    end
+                                 fun loop k =
+                                    if k = n
+                                       then
+                                          (case default of
+                                              NONE => (gone (); ([], Bug))
+                                            | SOME j => doit (j, Vector.new0 ()))
+                                    else
+                                       let
+                                          val (i, j) = Vector.sub (cases, k)
+                                       in
+                                          if is i
+                                             then doit (j, args)
+                                          else loop (k + 1)
+                                       end
+                              in
+                                 loop 0
+                              end
+                        in
+                           case (VarInfo.value test, cases) of
+                              (SOME (Value.Const c), _) =>
+                                 (case (cases, c) of
+                                     (Cases.Word (_, cs), Const.Word w) =>
+                                        findCase (cs,
+                                                  fn w' => WordX.equals (w, w'),
+                                                  Vector.new0 ())
+                                   | _ =>
+                                        Error.bug "Ssa.Shrink.simplifyCases: strange constant")
+                            | (SOME (Value.Con {con, args}), Cases.Con cases) =>
+                                 findCase (cases,
+                                           fn c => Con.equals (con, c),
+                                           args)
+                            | _ => cantSimplify ()
+                        end
+                  end
+            end
+         and goto (dst: Label.t, args: VarInfo.t vector)
+            : Statement.t list * Transfer.t =
+            gotoMeaning ([], labelMeaning dst, args)
+         and gotoMeaning arg : Statement.t list * Transfer.t =
+            traceGotoMeaning
+            (fn (canMoveIn,
+                 m as LabelMeaning.T {aux, blockIndex = i, ...},
+                 args: VarInfo.t vector) =>
+             let
+                val n = Array.sub (inDegree, i)
+                val _ = Assert.assert ("Ssa.Shrink.gotoMeaning", fn () => n >= 1)
+                fun normal () =
+                   if n = 1
+                      then
+                         let
+                            val _ = Array.update (inDegree, i, 0)
+                            val b = Vector.sub (blocks, i)
+                            val _ =
+                               Vector.foreach2
+                               (Block.args b, args, fn ((x, _), vi) =>
+                                setVarInfo (x, vi))
+                         in
+                            simplifyBlock (canMoveIn, b)
+                         end
+                   else
+                      let
+                         val _ = forceMeaningBlock m
+                      in
+                         (canMoveIn,
+                          Goto {dst = Block.label (Vector.sub (blocks, i)),
+                                args = uses args})
+                      end
+                fun extract p =
+                   case p of
+                      Position.Formal n => Vector.sub (args, n)
+                    | Position.Free x => varInfo x
+                fun rr ({args, canMove}, make) =
+                   (canMoveIn @ canMove, 
+                    make (Vector.map (args, use o extract)))
+                datatype z = datatype LabelMeaning.aux
+             in
+                case aux of
+                   Block => normal ()
+                 | Bug => ((*canMoveIn*)[], Transfer.Bug)
+                 | Case {canMove, cases, default} =>
+                      simplifyCase {canMove = canMoveIn @ canMove,
+                                    cantSimplify = normal,
+                                    cases = cases,
+                                    default = default,
+                                    gone = fn () => deleteLabelMeaning m,
+                                    test = Vector.sub (args, 0)}
+                 | Goto {canMove, dst, args} =>
+                      if Array.sub (isHeader, i)
+                         orelse Array.sub (isBlock, i)
+                         then normal ()
+                      else
+                         let
+                            val n' = n - 1
+                            val _ = Array.update (inDegree, i, n')
+                            val _ = 
+                               if n' > 0
+                                  then addLabelMeaning dst
+                               else ()
+                         in
+                            gotoMeaning (canMoveIn @ canMove, 
+                                         dst, 
+                                         Vector.map (args, extract))
+                         end
+                 | Raise z => rr (z, Transfer.Raise)
+                 | Return z => rr (z, Transfer.Return)
+             end) arg
+         and evalStatement arg : Statement.t list -> Statement.t list =
+            traceEvalStatement
+            (fn (Statement.T {var, ty, exp}) =>
+            let
+               val _ = Option.app 
+                       (var, fn x => 
+                        setVarInfo (x, VarInfo.new (x, SOME ty)))
+               fun delete ss = ss
+               fun doit {makeExp: unit -> Exp.t,
+                         sideEffect: bool,
+                         value: Value.t option} =
+                  let
+                     fun make var =
+                        Statement.T {var = var,
+                                     ty = ty,
+                                     exp = makeExp ()}
+                  in
+                     case var of
+                        NONE =>
+                           if sideEffect
+                              then (fn ss => make NONE :: ss)
+                           else delete
+                      | SOME x =>
+                           let
+                              val VarInfo.T {isUsed, value = r, ...} = varInfo x
+                              val _ = r := value
+                           in
+                              fn ss =>
+                              if !isUsed
+                                 then make (SOME x) :: ss
+                              else if sideEffect
+                                      then make NONE :: ss
+                                   else ss
+                           end
+                  end
+               fun setVar vi =
+                  (Option.app (var, fn x => setVarInfo (x, vi))
+                   ; delete)
+               fun construct (v: Value.t, makeExp) =
+                  doit {makeExp = makeExp,
+                        sideEffect = false,
+                        value = SOME v}
+            in
+               case exp of
+                  ConApp {con, args} =>
+                     let
+                        val args = varInfos args
+                     in
+                        construct (Value.Con {con = con, args = args},
+                                   fn () => ConApp {con = con,
+                                                    args = uses args})
+                     end
+                | Const c => construct (Value.Const c, fn () => exp)
+                | PrimApp {prim, targs, args} =>
+                     let
+                        val args = varInfos args
+                        fun apply {prim, targs, args} =
+                           doit {sideEffect = Prim.maySideEffect prim,
+                                 makeExp = fn () => PrimApp {prim = prim,
+                                                             targs = targs,
+                                                             args = uses args},
+                                 value = NONE}
+                        datatype z = datatype Prim.ApplyResult.t
+                     in
+                        case primApp (prim, args) of
+                           Apply (p, args) => apply {prim = p,
+                                                     targs = Vector.new0 (),
+                                                     args = Vector.fromList args}
+                         | Bool b =>
+                              let
+                                 val con = Con.fromBool b
+                              in
+                                 construct (Value.Con {con = con,
+                                                       args = Vector.new0 ()},
+                                            fn () =>
+                                            ConApp {con = con,
+                                                    args = Vector.new0 ()})
+                              end
+                         | Const c => construct (Value.Const c,
+                                                 fn () => Exp.Const c)
+                         | Var vi => setVar vi
+                         | _ => apply {prim = prim,
+                                       targs = targs,
+                                       args = args}
+                     end
+                | Select {tuple, offset} =>
+                     let
+                        val tuple as VarInfo.T {value, ...} = varInfo tuple
+                     in
+                        case !value of
+                           SOME (Value.Tuple vs) =>
+                              setVar (Vector.sub (vs, offset))
+                         | _ =>
+                              construct (Value.Select {tuple = tuple, 
+                                                       offset = offset},
+                                         fn () => Select {tuple = use tuple,
+                                                          offset = offset})
+                     end
+                | Tuple xs =>
+                     let
+                        val xs = varInfos xs
+                     in
+                        case Exn.withEscape
+                             (fn escape =>
+                              Vector.foldri
+                              (xs, NONE,
+                               fn (i, VarInfo.T {value, ...}, tuple') => 
+                               case !value of
+                                  SOME (Value.Select {offset, tuple}) =>
+                                     if offset = i
+                                        then case tuple' of
+                                                NONE => 
+                                                   (case VarInfo.ty tuple of
+                                                       SOME ty =>
+                                                          (case Type.deTupleOpt ty of
+                                                              SOME ts =>
+                                                                 if Vector.length xs =
+                                                                    Vector.length ts
+                                                                    then SOME tuple
+                                                                 else escape NONE
+                                                            | NONE => escape NONE)
+                                                     | NONE => escape NONE)
+                                              | SOME tuple'' => 
+                                                   if VarInfo.equals (tuple'', tuple)
+                                                      then tuple'
+                                                   else escape NONE
+                                     else escape NONE
+                                | _ => escape NONE)) of
+                          SOME tuple => setVar tuple
+                        | NONE => construct (Value.Tuple xs,
+                                             fn () => Tuple (uses xs))
+                     end
+                | Var x => setVar (varInfo x)
+                | _ => doit {makeExp = fn () => exp,
+                             sideEffect = true,
+                             value = NONE}
+            end) arg
+         val start = labelMeaning start
+         val _ = forceMeaningBlock start
+         val f = 
+            Function.new {args = args,
+                          blocks = Vector.fromList (!newBlocks),
+                          mayInline = mayInline,
+                          name = name,
+                          raises = raises,
+                          returns = returns,
+                          start = meaningLabel start}
+(*       val _ = save (f, "post") *)
+         val _ = Function.clear f
       in
-	 f
+         f
       end
    end
 
-structure Exp =
-   struct
-      open Exp
-
-      val isProfile =
-	 fn Profile _ => true
-	  | _ => false
-   end
-
-structure Statement =
-   struct
-      open Statement
-
-      fun isProfile (T {exp, ...}) = Exp.isProfile exp
-   end
-
 fun eliminateUselessProfile (f: Function.t): Function.t =
    if !Control.profile = Control.ProfileNone
       then f
    else
       let
-	 fun eliminateInBlock (b as Block.T {args, label, statements, transfer})
-	    : Block.t =
-	    if not (Vector.exists (statements, Statement.isProfile))
-	       then b
-	    else
-	       let
-		  datatype z = datatype Exp.t
-		  datatype z = datatype ProfileExp.t
-		  val stack =
-		     Vector.fold
-		     (statements, [], fn (s as Statement.T {exp, ...}, stack) =>
-		      case exp of
-			 Profile (Leave si) =>
-			    (case stack of
-				Statement.T {exp = Profile (Enter si'), ...}
-				:: rest =>
-				   if SourceInfo.equals (si, si')
-				      then rest
-				   else Error.bug "mismatched Leave\n"
-			      | _ => s :: stack)
-		       | _ => s :: stack)
-		  val statements = Vector.fromListRev stack
-	       in
-		  Block.T {args = args,
-			   label = label,
-			   statements = statements,
-			   transfer = transfer}
-	       end
-	 val {args, blocks, mayInline, name, raises, returns, start} =
-	    Function.dest f
-	 val blocks = Vector.map (blocks, eliminateInBlock)
+         fun eliminateInBlock (b as Block.T {args, label, statements, transfer})
+            : Block.t =
+            if not (Vector.exists (statements, Statement.isProfile))
+               then b
+            else
+               let
+                  datatype z = datatype Exp.t
+                  datatype z = datatype ProfileExp.t
+                  val stack =
+                     Vector.fold
+                     (statements, [], fn (s as Statement.T {exp, ...}, stack) =>
+                      case exp of
+                         Profile (Leave si) =>
+                            (case stack of
+                                Statement.T {exp = Profile (Enter si'), ...}
+                                :: rest =>
+                                   if SourceInfo.equals (si, si')
+                                      then rest
+                                   else Error.bug "Ssa.Shrink.eliminateUselessProfile: mismatched Leave"
+                              | _ => s :: stack)
+                       | _ => s :: stack)
+                  val statements = Vector.fromListRev stack
+               in
+                  Block.T {args = args,
+                           label = label,
+                           statements = statements,
+                           transfer = transfer}
+               end
+         val {args, blocks, mayInline, name, raises, returns, start} =
+            Function.dest f
+         val blocks = Vector.map (blocks, eliminateInBlock)
       in
-	 Function.new {args = args,
-		       blocks = blocks,
-		       mayInline = mayInline,
-		       name = name,
-		       raises = raises,
-		       returns = returns,
-		       start = start}
+         Function.new {args = args,
+                       blocks = blocks,
+                       mayInline = mayInline,
+                       name = name,
+                       raises = raises,
+                       returns = returns,
+                       start = start}
       end
 
 val traceShrinkFunction =
-   Trace.trace ("Shrink.shrinkFunction", Function.layout, Function.layout)
+   Trace.trace ("Ssa.Shrink.shrinkFunction", Function.layout, Function.layout)
 
 val shrinkFunction =
    fn g =>
    let
       val s = shrinkFunction g
    in
-      fn f => (traceShrinkFunction s (eliminateUselessProfile f)
-	       handle e => (Error.bug (concat ["shrinker raised ",
-					       Layout.toString (Exn.layout e)])
-			    ; raise e))
+      fn f => traceShrinkFunction s (eliminateUselessProfile f)
    end
 
 fun shrink (Program.T {datatypes, globals, functions, main})
@@ -1286,9 +1308,9 @@
       val s = shrinkFunction {globals = globals}
     in
       Program.T {datatypes = datatypes,
-		 globals = globals,
-		 functions = List.revMap (functions, s),
-		 main = main}
+                 globals = globals,
+                 functions = List.revMap (functions, s),
+                 main = main}
     end
 
 end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ssa/shrink.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ssa/shrink.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ssa/shrink.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature SHRINK_STRUCTS = 
    sig
       include PREPASSES
@@ -15,6 +16,6 @@
       include SHRINK_STRUCTS
 
       val shrinkFunction: 
-	 {globals: Statement.t vector} -> Function.t -> Function.t
+         {globals: Statement.t vector} -> Function.t -> Function.t
       val shrink: Program.t -> Program.t
    end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ssa/shrink2.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ssa/shrink2.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ssa/shrink2.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,22 +1,32 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 functor Shrink2 (S: SHRINK2_STRUCTS): SHRINK2 = 
 struct
 
+type int = Int.t
+
 open S
 
-type int = Int.t
+structure Statement =
+   struct
+      open Statement
 
+      fun isProfile (s: t): bool =
+         case s of
+            Profile _ => true
+          | _ => false
+   end
+
 structure Array =
    struct
       open Array
-	 
+         
       fun inc (a: int t, i: int): unit = update (a, i, 1 + sub (a, i))
       fun dec (a: int t, i: int): unit = update (a, i, sub (a, i) - 1)
    end
@@ -28,60 +38,60 @@
 structure VarInfo =
    struct
       datatype t = T of {isUsed: bool ref,
-			 numOccurrences: int ref,
-			 ty: Type.t option,
-			 value: value option ref,
-			 var: Var.t}
+                         numOccurrences: int ref,
+                         ty: Type.t option,
+                         value: value option ref,
+                         var: Var.t}
       and value =
-	 Const of Const.t
-	| Inject of {sum: Tycon.t,
-		     variant: t}
-	| Object of {args: t vector,
-		     con: Con.t option}
-	| Select of {object: t,
-		     offset: int}
+         Const of Const.t
+        | Inject of {sum: Tycon.t,
+                     variant: t}
+        | Object of {args: t vector,
+                     con: Con.t option}
+        | Select of {object: t,
+                     offset: int}
 
       fun equals (T {var = x, ...}, T {var = y, ...}) = Var.equals (x, y)
-	 
+         
       fun layout (T {isUsed, numOccurrences, ty, value, var}) =
-	 let open Layout
-	 in record [("isUsed", Bool.layout (!isUsed)),
-		    ("numOccurrences", Int.layout (!numOccurrences)),
-		    ("ty", Option.layout Type.layout ty),
-		    ("value", Option.layout layoutValue (!value)),
-		    ("var", Var.layout var)]
-	 end
+         let open Layout
+         in record [("isUsed", Bool.layout (!isUsed)),
+                    ("numOccurrences", Int.layout (!numOccurrences)),
+                    ("ty", Option.layout Type.layout ty),
+                    ("value", Option.layout layoutValue (!value)),
+                    ("var", Var.layout var)]
+         end
       and layoutValue v =
-	 let
-	    open Layout
-	 in
-	    case v of
-	       Const c => Const.layout c
-	     | Inject {sum, variant} =>
-		  seq [layout variant, str ": ", Tycon.layout sum]
-	     | Object {args, con} =>
-		  let
-		     val args = Vector.layout layout args
-		  in
-		     case con of
-			NONE => args
-		      | SOME con => seq [Con.layout con, args]
-		  end
-	     | Select {object, offset} =>
-		  seq [str "#", Int.layout (offset + 1), 
-		       str " ", layout object]
-	 end
+         let
+            open Layout
+         in
+            case v of
+               Const c => Const.layout c
+             | Inject {sum, variant} =>
+                  seq [layout variant, str ": ", Tycon.layout sum]
+             | Object {args, con} =>
+                  let
+                     val args = Vector.layout layout args
+                  in
+                     case con of
+                        NONE => args
+                      | SOME con => seq [Con.layout con, args]
+                  end
+             | Select {object, offset} =>
+                  seq [str "#", Int.layout (offset + 1), 
+                       str " ", layout object]
+         end
 
       fun new (x: Var.t, ty: Type.t option) =
-	 T {isUsed = ref false,
-	    numOccurrences = ref 0,
-	    ty = ty,
-	    value = ref NONE,
-	    var = x}
+         T {isUsed = ref false,
+            numOccurrences = ref 0,
+            ty = ty,
+            value = ref NONE,
+            var = x}
 
       fun setValue (T {value, ...}, v) =
-	 (Assert.assert ("VarInfo.setValue", fn () => Option.isNone (!value))
-	  ; value := SOME v)
+         (Assert.assert ("Ssa2.Shrink2.VarInfo.setValue", fn () => Option.isNone (!value))
+          ; value := SOME v)
 
       fun numOccurrences (T {numOccurrences = r, ...}) = r
       fun ty (T {ty, ...}): Type.t option = ty
@@ -97,18 +107,18 @@
 structure Position =
    struct
       datatype t =
-	 Formal of int
+         Formal of int
        | Free of Var.t
 
       fun layout (p: t) =
-	 case p of
-	    Formal i => Int.layout i
-	  | Free x => Var.layout x
+         case p of
+            Formal i => Int.layout i
+          | Free x => Var.layout x
 
       val equals =
-	 fn (Formal i, Formal i') => i = i'
-	  | (Free x, Free x') => Var.equals (x, x')
-	  | _ => false
+         fn (Formal i, Formal i') => i = i'
+          | (Free x, Free x') => Var.equals (x, x')
+          | _ => false
    end
 
 structure Positions = MonoVector (Position)
@@ -116,1234 +126,1259 @@
 structure LabelMeaning =
    struct
       datatype t = T of {aux: aux,
-			 blockIndex: int, (* The index of the block *)
-			 label: Label.t} (* redundant, the label of the block *)
-			 
+                         blockIndex: int, (* The index of the block *)
+                         label: Label.t} (* redundant, the label of the block *)
+                         
       and aux =
-	 Block
+         Block
        | Bug
-       | Case of {cases: Cases.t,
-		  default: Label.t option}
-       | Goto of {dst: t,
-		  args: Positions.t}
+       | Case of {canMove: Statement.t list,
+                  cases: Cases.t,
+                  default: Label.t option}
+       | Goto of {canMove: Statement.t list,
+                  dst: t,
+                  args: Positions.t}
        | Raise of {args: Positions.t,
-		   canMove: Statement.t list}
+                   canMove: Statement.t list}
        | Return of {args: Positions.t,
-		    canMove: Statement.t list}
+                    canMove: Statement.t list}
 
       local
-	 fun make f (T r) = f r
+         fun make f (T r) = f r
       in
-	 val aux = make #aux
-	 val blockIndex = make #blockIndex
+         val aux = make #aux
+         val blockIndex = make #blockIndex
       end
 
       fun layout (T {aux, label, ...}) =
-	 let
-	    open Layout
-	 in
-	    seq [Label.layout label,
-		 str " ",
-		 case aux of
-		    Block => str "Block "
-		  | Bug => str "Bug"
-		  | Case _ => str "Case"
-		  | Goto {dst, args} =>
-		       seq [str "Goto ",
-			    tuple [layout dst, Positions.layout args]]
-		  | Raise {args, ...} =>
-		       seq [str "Raise ", Positions.layout args]
-		  | Return {args, ...} =>
-		       seq [str "Return ", Positions.layout args]]
-	 end
+         let
+            open Layout
+         in
+            seq [Label.layout label,
+                 str " ",
+                 case aux of
+                    Block => str "Block "
+                  | Bug => str "Bug"
+                  | Case _ => str "Case"
+                  | Goto {dst, args, ...} =>
+                       seq [str "Goto ",
+                            tuple [layout dst, Positions.layout args]]
+                  | Raise {args, ...} =>
+                       seq [str "Raise ", Positions.layout args]
+                  | Return {args, ...} =>
+                       seq [str "Return ", Positions.layout args]]
+         end
    end
 
 structure State =
    struct
       datatype state =
-	 Unvisited
+         Unvisited
        | Visited of LabelMeaning.t
        | Visiting
 
       val layout =
-	 let
-	    open Layout
-	 in
-	    fn Unvisited => str "Unvisited"
-	     | Visited m => LabelMeaning.layout m
-	     | Visiting => str "Visiting"
-	 end
+         let
+            open Layout
+         in
+            fn Unvisited => str "Unvisited"
+             | Visited m => LabelMeaning.layout m
+             | Visiting => str "Visiting"
+         end
    end
 
-val traceApplyInfo = Trace.info "Prim.apply"
+val traceApplyInfo = Trace.info "Ssa2.Shrink2.Prim.apply"
 
 fun shrinkFunction {globals: Statement.t vector} =
    let
       fun use (VarInfo.T {isUsed, var, ...}): Var.t =
-	 (isUsed := true
-	  ; var)
+         (isUsed := true
+          ; var)
       fun uses (vis: VarInfo.t vector): Var.t vector = Vector.map (vis, use)
       (* varInfo can't be getSetOnce because of setReplacement. *)
       val {get = varInfo: Var.t -> VarInfo.t, set = setVarInfo, ...} =
-	 Property.getSet (Var.plist, 
-			  Property.initFun (fn x => VarInfo.new (x, NONE)))
+         Property.getSet (Var.plist, 
+                          Property.initFun (fn x => VarInfo.new (x, NONE)))
       val setVarInfo =
-	 Trace.trace2 ("Shrink2.setVarInfo",
-		       Var.layout, VarInfo.layout, Unit.layout)
-	 setVarInfo
+         Trace.trace2 ("Ssa2.Shrink2.setVarInfo",
+                       Var.layout, VarInfo.layout, Unit.layout)
+         setVarInfo
       fun varInfos xs = Vector.map (xs, varInfo)
       fun simplifyVar (x: Var.t) = use (varInfo x)
       val simplifyVar =
-	 Trace.trace ("Shrink2.simplifyVar", Var.layout, Var.layout) simplifyVar
+         Trace.trace ("Ssa2.Shrink2.simplifyVar", Var.layout, Var.layout) simplifyVar
       fun simplifyVars xs = Vector.map (xs, simplifyVar)
       fun incVarInfo (x: VarInfo.t): unit =
-	 Int.inc (VarInfo.numOccurrences x)
+         Int.inc (VarInfo.numOccurrences x)
       fun incVar (x: Var.t): unit = incVarInfo (varInfo x)
       fun incVars xs = Vector.foreach (xs, incVar)
       fun numVarOccurrences (x: Var.t): int =
-	 ! (VarInfo.numOccurrences (varInfo x))
+         ! (VarInfo.numOccurrences (varInfo x))
       val () =
-	 Vector.foreach
-	 (globals, fn s =>
-	  case s of
-	     Bind {exp, ty, var} =>
-		let
-		   val () = Option.app
-		      (var, fn x =>
-		       setVarInfo (x, VarInfo.new (x, SOME ty)))
-		   fun construct v =
-		      Option.app (var, fn x => VarInfo.setValue (varInfo x, v))
-		in
-		   case exp of
-		      Const c => construct (Value.Const c)
-		    | Object {args, con} =>
-			 construct
-			 (Value.Object {args = Vector.map (args, varInfo),
-					con = con})
-		    | Select {base, offset} =>
-			 (case base of
-			     Base.Object x =>
-				construct (Value.Select {object = varInfo x,
-							 offset = offset})
-			   | _ => ())
-		    | Var y =>
-			 Option.app (var, fn x => setVarInfo (x, varInfo y))
-		    | _ => ()
-		end
-	   | _ => ())
+         Vector.foreach
+         (globals, fn s =>
+          case s of
+             Bind {exp, ty, var} =>
+                let
+                   val () = Option.app
+                      (var, fn x =>
+                       setVarInfo (x, VarInfo.new (x, SOME ty)))
+                   fun construct v =
+                      Option.app (var, fn x => VarInfo.setValue (varInfo x, v))
+                in
+                   case exp of
+                      Const c => construct (Value.Const c)
+                    | Object {args, con} =>
+                         construct
+                         (Value.Object {args = Vector.map (args, varInfo),
+                                        con = con})
+                    | Select {base, offset} =>
+                         (case base of
+                             Base.Object x =>
+                                construct (Value.Select {object = varInfo x,
+                                                         offset = offset})
+                           | _ => ())
+                    | Var y =>
+                         Option.app (var, fn x => setVarInfo (x, varInfo y))
+                    | _ => ()
+                end
+           | _ => ())
    in
       fn f: Function.t =>
       let
-	 val () = Function.clear f
-	 val {args, blocks, mayInline, name, raises, returns, start, ...} =
-	    Function.dest f
-	 val () = Vector.foreach (args, fn (x, ty) => 
-				  setVarInfo (x, VarInfo.new (x, SOME ty)))
-	 (* Index the labels by their defining block in blocks. *)
-	 val {get = labelIndex, set = setLabelIndex, ...} =
-	    Property.getSetOnce (Label.plist,
-				 Property.initRaise ("index", Label.layout))
-	 val () = Vector.foreachi (blocks, fn (i, Block.T {label, ...}) =>
-				   setLabelIndex (label, i))
-	 val numBlocks = Vector.length blocks
-	 (* Do a DFS to compute occurrence counts and set label meanings *)
-	 val states = Array.array (numBlocks, State.Unvisited)
-	 val inDegree = Array.array (numBlocks, 0)
-	 fun addLabelIndex i = Array.inc (inDegree, i)
-	 val isHeader = Array.array (numBlocks, false)
-	 val numHandlerUses = Array.array (numBlocks, 0)
-	 fun layoutLabel (l: Label.t): Layout.t =
-	    let
-	       val i = labelIndex l
-	    in
-	       Layout.record [("label", Label.layout l),
-			      ("inDegree", Int.layout (Array.sub (inDegree, i)))]
-	    end
-	 fun incAux aux =
-	    case aux of
-	       LabelMeaning.Goto {dst, ...} =>
-		  addLabelIndex (LabelMeaning.blockIndex dst)
-	     | _ => ()
-	 fun incLabel (l: Label.t): unit =
-	    incLabelMeaning (labelMeaning l)
-	 and incLabelMeaning (LabelMeaning.T {aux, blockIndex, ...}): unit =
-	    let
-	       val i = blockIndex
-	       val n = Array.sub (inDegree, i)
-	       val () = Array.update (inDegree, i, 1 + n)
-	    in
-	       if n = 0
-		  then incAux aux
-	       else ()
-	    end
-	 and labelMeaning (l: Label.t): LabelMeaning.t =
-	    let
-	       val i = labelIndex l
-	    in
-	       case Array.sub (states, i) of
-		  State.Visited m => m
-		| State.Visiting =>
-		     (Array.update (isHeader, i, true)
-		      ; (LabelMeaning.T
-			 {aux = LabelMeaning.Block,
-			  blockIndex = i,
-			  label = Block.label (Vector.sub (blocks, i))}))
-		| State.Unvisited => 
-		     let
-			val () = Array.update (states, i, State.Visiting)
-			val m = computeMeaning i
-			val () = Array.update (states, i, State.Visited m)
-		     in
-			m
-		     end
-	    end
-	 and computeMeaning (i: int): LabelMeaning.t =
-	    let
-	       val Block.T {args, statements, transfer, ...} =
-		  Vector.sub (blocks, i)
-	       val () = Vector.foreach (args, fn (x, ty) =>
-					setVarInfo (x, VarInfo.new (x, SOME ty)))
-	       val () = Vector.foreach (statements, fn s =>
-					Statement.foreachUse (s, incVar))
-	       fun extract (actuals: Var.t vector): Positions.t =
-		  let
-		     val {get: Var.t -> Position.t, set, destroy} =
-			Property.destGetSetOnce
-			(Var.plist, Property.initFun Position.Free)
-		     val () = Vector.foreachi (args, fn (i, (x, _)) =>
-					      set (x, Position.Formal i))
-		     val ps = Vector.map (actuals, get)
-		     val () = destroy ()
-		  in ps
-		  end
-	       fun doit aux =
-		  LabelMeaning.T {aux = aux,
-				  blockIndex = i,
-				  label = Block.label (Vector.sub (blocks, i))}
-	       fun normal () = doit LabelMeaning.Block
-	       fun rr (xs: Var.t vector, make) =
-		  let
-		     val () = incVars xs
-		     val n = Vector.length statements
-		     fun loop (i, ac) =
-			if i = n
-			   then
-			      if 0 = Vector.length xs
-				 orelse 0 < Vector.length args
-				 then doit (make {args = extract xs,
-						  canMove = rev ac})
-			      else normal ()
-			else
-			   let
-			      val s = Vector.sub (statements, i)
-			   in
-			      case s of
-				 Profile _ => loop (i + 1, s :: ac)
-			       | _ => normal ()
-			   end
-		  in
-		     loop (0, [])
-		  end
-	    in
-	       case transfer of
-		  Arith {args, overflow, success, ...} =>
-		     (incVars args
-		      ; incLabel overflow
-		      ; incLabel success
-		      ; normal ())
-		| Bug =>
-		     if 0 = Vector.length statements
-			andalso (case returns of
-				    NONE => true
-				  | SOME ts =>
-				       Vector.equals
-				       (ts, args, fn (t, (_, t')) =>
-					Type.equals (t, t')))
-			then doit LabelMeaning.Bug
-		     else normal ()
+         val () = Function.clear f
+         val {args, blocks, mayInline, name, raises, returns, start, ...} =
+            Function.dest f
+         val () = Vector.foreach (args, fn (x, ty) => 
+                                  setVarInfo (x, VarInfo.new (x, SOME ty)))
+         (* Index the labels by their defining block in blocks. *)
+         val {get = labelIndex, set = setLabelIndex, ...} =
+            Property.getSetOnce (Label.plist,
+                                 Property.initRaise ("index", Label.layout))
+         val () = Vector.foreachi (blocks, fn (i, Block.T {label, ...}) =>
+                                   setLabelIndex (label, i))
+         val numBlocks = Vector.length blocks
+         (* Do a DFS to compute occurrence counts and set label meanings *)
+         val states = Array.array (numBlocks, State.Unvisited)
+         val inDegree = Array.array (numBlocks, 0)
+         fun addLabelIndex i = Array.inc (inDegree, i)
+         val isHeader = Array.array (numBlocks, false)
+         val numHandlerUses = Array.array (numBlocks, 0)
+         fun layoutLabel (l: Label.t): Layout.t =
+            let
+               val i = labelIndex l
+            in
+               Layout.record [("label", Label.layout l),
+                              ("inDegree", Int.layout (Array.sub (inDegree, i)))]
+            end
+         fun incAux aux =
+            case aux of
+               LabelMeaning.Goto {dst, ...} =>
+                  addLabelIndex (LabelMeaning.blockIndex dst)
+             | _ => ()
+         fun incLabel (l: Label.t): unit =
+            incLabelMeaning (labelMeaning l)
+         and incLabelMeaning (LabelMeaning.T {aux, blockIndex, ...}): unit =
+            let
+               val i = blockIndex
+               val n = Array.sub (inDegree, i)
+               val () = Array.update (inDegree, i, 1 + n)
+            in
+               if n = 0
+                  then incAux aux
+               else ()
+            end
+         and labelMeaning (l: Label.t): LabelMeaning.t =
+            let
+               val i = labelIndex l
+            in
+               case Array.sub (states, i) of
+                  State.Visited m => m
+                | State.Visiting =>
+                     (Array.update (isHeader, i, true)
+                      ; (LabelMeaning.T
+                         {aux = LabelMeaning.Block,
+                          blockIndex = i,
+                          label = Block.label (Vector.sub (blocks, i))}))
+                | State.Unvisited => 
+                     let
+                        val () = Array.update (states, i, State.Visiting)
+                        val m = computeMeaning i
+                        val () = Array.update (states, i, State.Visited m)
+                     in
+                        m
+                     end
+            end
+         and computeMeaning (i: int): LabelMeaning.t =
+            let
+               val Block.T {args, statements, transfer, ...} =
+                  Vector.sub (blocks, i)
+               val () = Vector.foreach (args, fn (x, ty) =>
+                                        setVarInfo (x, VarInfo.new (x, SOME ty)))
+               val () = Vector.foreach (statements, fn s =>
+                                        Statement.foreachUse (s, incVar))
+               fun extract (actuals: Var.t vector): Positions.t =
+                  let
+                     val {get: Var.t -> Position.t, set, destroy} =
+                        Property.destGetSetOnce
+                        (Var.plist, Property.initFun Position.Free)
+                     val () = Vector.foreachi (args, fn (i, (x, _)) =>
+                                              set (x, Position.Formal i))
+                     val ps = Vector.map (actuals, get)
+                     val () = destroy ()
+                  in ps
+                  end
+               fun doit aux =
+                  LabelMeaning.T {aux = aux,
+                                  blockIndex = i,
+                                  label = Block.label (Vector.sub (blocks, i))}
+               fun normal () = doit LabelMeaning.Block
+               fun canMove () =
+                  Vector.toList statements
+               fun rr (xs: Var.t vector, make) =
+                  let
+                     val () = incVars xs
+(*
+                     val n = Vector.length statements
+                     fun loop (i, ac) =
+                        if i = n
+                           then
+                              if 0 = Vector.length xs
+                                 orelse 0 < Vector.length args
+                                 then doit (make {args = extract xs,
+                                                  canMove = rev ac})
+                              else normal ()
+                        else
+                           let
+                              val s = Vector.sub (statements, i)
+                           in
+                              if Statement.isProfile s
+                                 then loop (i + 1, s :: ac)
+                              else normal ()
+                           end
+                  in
+                     loop (0, [])
+                  end
+*)
+                  in
+                     if Vector.forall (statements, Statement.isProfile)
+                        andalso (0 = Vector.length xs
+                                 orelse 0 < Vector.length args)
+                        then doit (make {args = extract xs,
+                                         canMove = canMove ()})
+                     else normal ()
+                  end
+            in
+               case transfer of
+                  Arith {args, overflow, success, ...} =>
+                     (incVars args
+                      ; incLabel overflow
+                      ; incLabel success
+                      ; normal ())
+                | Bug =>
+                     if 0 = Vector.length statements
+                        andalso (case returns of
+                                    NONE => true
+                                  | SOME ts =>
+                                       Vector.equals
+                                       (ts, args, fn (t, (_, t')) =>
+                                        Type.equals (t, t')))
+                        then doit LabelMeaning.Bug
+                     else normal ()
                 | Call {args, return, ...} =>
-		     let
-			val () = incVars args
-			val () =
-			   Return.foreachHandler
-			   (return, fn l =>
-			    Array.inc (numHandlerUses, labelIndex l))
-			val () = Return.foreachLabel (return, incLabel)
-		     in
-			normal ()
-		     end
-		| Case {test, cases, default} =>
-		     let
-			val () = incVar test
-			val () = Cases.foreach (cases, incLabel)
-			val () = Option.app (default, incLabel)
-		     in
-			if 0 = Vector.length statements
-			   andalso not (Array.sub (isHeader, i))
-			   andalso 1 = Vector.length args
-			   andalso 1 = numVarOccurrences test
-			   andalso Var.equals (test, #1 (Vector.sub (args, 0)))
-			   then
-			      doit (LabelMeaning.Case {cases = cases,
-						       default = default})
-			else
-			   normal ()
-		     end
-		| Goto {dst, args = actuals} =>
-		     let
-			val () = incVars actuals
-			val m = labelMeaning dst
-		     in
-			if 0 <> Vector.length statements
-			   orelse Array.sub (isHeader, i)
-			   then (incLabelMeaning m
-				 ; normal ())
-			else
-			   if Vector.equals (args, actuals, fn ((x, _), x') =>
-					     Var.equals (x, x')
-					     andalso 1 = numVarOccurrences x)
-			      then m (* It's an eta. *)
-			   else
-			   let
-			      val ps = extract actuals
-			      val n =
-				 Vector.fold (args, 0, fn ((x, _), n) =>
-					      n + numVarOccurrences x)
-			      val n' =
-				 Vector.fold (ps, 0, fn (p, n) =>
-					      case p of
-						 Position.Formal _ => n + 1
-					       | _ => n)
-			      datatype z = datatype LabelMeaning.aux
-			   in
-			      if n <> n'
-				 then (incLabelMeaning m
-				       ; normal ())
-			      else
-				 let
-				    fun extract (ps': Positions.t)
-				       : Positions.t =
-				       Vector.map
-				       (ps', fn p =>
-					let
-					   datatype z = datatype Position.t
-					in
-					   case p of
-					      Free x => Free x
-					    | Formal i => Vector.sub (ps, i)
-					end)
-				    val a =
-				       case LabelMeaning.aux m of
-					  Block => Goto {dst = m,
-							 args = ps}
-					| Bug => Bug
-					| Case _ => Goto {dst = m,
-							  args = ps}
-					| Goto {dst, args} =>
-					     Goto {dst = dst,
-						   args = extract args}
-					| Raise {args, canMove} =>
-					     Raise {args = extract args,
-						    canMove = canMove}
-					| Return {args, canMove} =>
-					     Return {args = extract args,
-						     canMove = canMove}
-				 in
-				    doit a
-				 end
-			   end
-		     end
-		| Raise xs => rr (xs, LabelMeaning.Raise)
-		| Return xs => rr (xs, LabelMeaning.Return)
-		| Runtime {args, return, ...} =>
-		     (incVars args
-		      ; incLabel return
-		      ; normal ())
-	    end
-	 val () = incLabel start
-	 fun indexMeaning i =
-	    case Array.sub (states, i) of
-	       State.Visited m => m
-	     | _ => Error.bug "indexMeaning not computed"
-	 val indexMeaning =
-	    Trace.trace ("Shrink2.indexMeaning", Int.layout, LabelMeaning.layout)
-	    indexMeaning
-	 val labelMeaning = indexMeaning o labelIndex
-	 val labelMeaning =
-	    Trace.trace ("Shrink2.labelMeaning",
-			 Label.layout, LabelMeaning.layout)
-	    labelMeaning
-	 fun meaningLabel m =
-	    Block.label (Vector.sub (blocks, LabelMeaning.blockIndex m))
-	 fun save (f, s) =
-	    File.withOut
-	    (concat ["/tmp/", Func.toString (Function.name f),
-		     ".", s, ".dot"],
-	     fn out =>
-	     Layout.outputl
-	     (#graph (Function.layoutDot (f, fn _ => NONE)),
-	      out))
-	 val () = if true then () else save (f, "pre")
-	 (* *)
-	 val () =
-	    if true
-	       then ()
-	    else
-	       Layout.outputl
-	       (Vector.layout
-		(fn i =>
-		 (Layout.record
-		  [("label",
-		    Label.layout (Block.label (Vector.sub (blocks, i)))),
-		   ("inDegree", Int.layout (Array.sub (inDegree, i))),
-		   ("state", State.layout (Array.sub (states, i)))]))
-		(Vector.tabulate (numBlocks, fn i => i)),
-		Out.error)
-	 val () =
-	    Assert.assert
-	    ("Shrink.labelMeanings", fn () =>
-	     let
-		val inDegree' = Array.array (numBlocks, 0)
-		fun bumpIndex i = Array.inc (inDegree', i)
-		fun bumpMeaning m = bumpIndex (LabelMeaning.blockIndex m)
-		val bumpLabel = bumpMeaning o labelMeaning
-		fun doit (LabelMeaning.T {aux, blockIndex, ...}) =
-		   let
-		      datatype z = datatype LabelMeaning.aux
-		   in
-		      case aux of
-			 Block =>
-			    Transfer.foreachLabel
-			    (Block.transfer (Vector.sub (blocks, blockIndex)),
-			     bumpLabel)
-		       | Bug => ()
-		       | Case {cases, default, ...} =>
-			    (Cases.foreach (cases, bumpLabel)
-			     ; Option.app (default, bumpLabel))
-		       | Goto {dst, ...} => bumpMeaning dst
-		       | Raise _ => ()
-		       | Return _ => ()
-		   end
-		val () =
-		   Array.foreachi
-		   (states, fn (i, s) =>
-		    if Array.sub (inDegree, i) > 0
-		       then
-			  (case s of
-			      State.Visited m => doit m
-			    | _ => ())
-		    else ())
-		val () = bumpMeaning (labelMeaning start)
-	     in
-		Array.equals (inDegree, inDegree', Int.equals)
-		orelse
-		let
-		   val () =
-		      Layout.outputl
-		      (Vector.layout
-		       (fn i =>
-			(Layout.record
-			 [("label",
-			   Label.layout (Block.label (Vector.sub (blocks, i)))),
-			  ("inDegree", Int.layout (Array.sub (inDegree, i))),
-			  ("inDegree'", Int.layout (Array.sub (inDegree', i))),
-			  ("state", State.layout (Array.sub (states, i)))]))
-		       (Vector.tabulate (numBlocks, fn i => i)),
-		       Out.error)
-		in
-		   false
-		end
-	     end)
-	 val isBlock = Array.array (numBlocks, false)
-	 (* Functions for maintaining inDegree. *)
-	 val addLabelIndex =
-	    fn i =>
-	    (Assert.assert ("addLabelIndex", fn () =>
-			    Array.sub (inDegree, i) > 0)
-	     ; addLabelIndex i)
-	 val addLabelMeaning = addLabelIndex o LabelMeaning.blockIndex
-	 fun layoutLabelMeaning m =
-	    Layout.record
-	    [("inDegree", Int.layout (Array.sub
-				      (inDegree, LabelMeaning.blockIndex m))),
-	     ("meaning", LabelMeaning.layout m)]
-	 val traceDeleteLabelMeaning =
-	    Trace.trace ("Shrink2.deleteLabelMeaning",
-			 layoutLabelMeaning, Unit.layout)
-	 fun deleteLabel l = deleteLabelMeaning (labelMeaning l)
-	 and deleteLabelMeaning arg: unit =
-	    traceDeleteLabelMeaning
-	    (fn (m: LabelMeaning.t) =>
-	    let
-	       val i = LabelMeaning.blockIndex m
-	       val n = Array.sub (inDegree, i) - 1
-	       val () = Array.update (inDegree, i, n)
-	       val () = Assert.assert ("deleteLabelMeaning", fn () => n >= 0)
-	    in
-	       if n = 0 (* andalso not (Array.sub (isBlock, i)) *)
-		  then
-		     let
-			datatype z = datatype LabelMeaning.aux
-		     in
-			case LabelMeaning.aux m of
-			   Block =>
-			      let
-				 val t = Block.transfer (Vector.sub (blocks, i))
-				 val () = Transfer.foreachLabel (t, deleteLabel)
-				 val () =
-				    case t of
-				       Transfer.Call {return, ...} =>
-					  Return.foreachHandler
-					  (return, fn l =>
-					   Array.dec (numHandlerUses,
-						      (LabelMeaning.blockIndex
-						       (labelMeaning l))))
-				     | _ => ()
-			      in
-				 ()
-			      end
-			 | Bug => ()
-			 | Case {cases, default} =>
-			      (Cases.foreach (cases, deleteLabel)
-			       ; Option.app (default, deleteLabel))
-			 | Goto {dst, ...} => deleteLabelMeaning dst
-			 | Raise _ => ()
-			 | Return _ => ()
-		     end
-	       else ()
-	    end) arg
-	 fun primApp (prim: Type.t Prim.t, args: VarInfo.t vector)
-	    : (Type.t, VarInfo.t) Prim.ApplyResult.t =
-	    case Prim.name prim of
-	       Prim.Name.FFI _ => Prim.ApplyResult.Unknown
-	     | _ =>
-		  let
-		     val args' =
-			Vector.map
-			(args, fn vi =>
-			 case vi of
-			    VarInfo.T {value = ref (SOME v), ...} =>
-			       (case v of
-				   Value.Const c => Prim.ApplyArg.Const c
-				 | Value.Object {args, con} =>
-				      (case (con, Vector.length args) of
-					  (SOME con, 0) =>
-					     Prim.ApplyArg.Con {con = con,
-								hasArg = false}
-					| _ => Prim.ApplyArg.Var vi)
-				 | _ => Prim.ApplyArg.Var vi)
-			  | _ => Prim.ApplyArg.Var vi)
-		  in
-		     Trace.traceInfo'
-		     (traceApplyInfo,
-		      fn (p, args, _) =>
-		      let
-			 open Layout
-		      in
-			 seq [Prim.layout p, str " ",
-			      List.layout (Prim.ApplyArg.layout
-					   (Var.layout o VarInfo.var)) args]
-		      end,
-		      Prim.ApplyResult.layout (Var.layout o VarInfo.var))
-		     Prim.apply
-		     (prim, Vector.toList args', VarInfo.equals)
-		     handle e =>
-			Error.bug (concat ["Prim.apply raised ",
-					   Layout.toString (Exn.layout e)])
-		  end
-	 (* Another DFS, this time accumulating the new blocks. *)
-      	 val traceForceMeaningBlock =
-	    Trace.trace ("Shrink2.forceMeaningBlock",
-			layoutLabelMeaning, Unit.layout)
-	 val traceSimplifyBlock =
-	    Trace.trace ("Shrink2.simplifyBlock",
-			 layoutLabel o Block.label,
-			 Layout.tuple2 (List.layout Statement.layout,
-					Transfer.layout))
-	 val traceGotoMeaning =
-	    Trace.trace2
-	    ("Shrink2.gotoMeaning",
-	     layoutLabelMeaning,
-	     Vector.layout VarInfo.layout,
-	     Layout.tuple2 (List.layout Statement.layout, Transfer.layout))
-	 val traceEvalStatement =
-	    Trace.trace
-	    ("Shrink2.evalStatement",
-	     Statement.layout,
-	     Layout.ignore: (Statement.t list -> Statement.t list) -> Layout.t)
-	 val traceSimplifyTransfer =
-	    Trace.trace ("Shrink2.simplifyTransfer",
-			 Transfer.layout,
-			 Layout.tuple2 (List.layout Statement.layout,
-					Transfer.layout))
-	 val newBlocks = ref []
-	 fun simplifyLabel l =
-	    let
-	       val m = labelMeaning l
-	       val () = forceMeaningBlock m
-	    in
-	       meaningLabel m
-	    end
-	 and forceMeaningBlock arg =
-	    traceForceMeaningBlock
-	    (fn (LabelMeaning.T {aux, blockIndex = i, ...}) =>
-	     if Array.sub (isBlock, i)
-		then ()
-	     else
-		let
-		   val () = Array.update (isBlock, i, true)
-		   val block as Block.T {label, args, ...} =
-		      Vector.sub (blocks, i)
-		   fun extract (p: Position.t): VarInfo.t =
-		      varInfo (case p of
-				  Position.Formal n => #1 (Vector.sub (args, n))
-				| Position.Free x => x)
-		   val (statements, transfer) =
-		      let
-			 fun rr ({args, canMove}, make) =
-			    (canMove, make (Vector.map (args, use o extract)))
-			 datatype z = datatype LabelMeaning.aux
-		      in
-			 case aux of
-			    Block => simplifyBlock block
-			  | Bug => ([], Transfer.Bug)
-			  | Case _ => simplifyBlock block
-			  | Goto {dst, args} =>
-			       gotoMeaning (dst, Vector.map (args, extract))
-			  | Raise z => rr (z, Transfer.Raise)
-			  | Return z => rr (z, Transfer.Return)
-		      end
-		   val () =
-		      List.push
-		      (newBlocks,
-		       Block.T {label = label,
-				args = args,
-				statements = Vector.fromList statements,
-				transfer = transfer})
-		in
-		   ()
-		end) arg
-	 and simplifyBlock arg : Statement.t list * Transfer.t =
-	    traceSimplifyBlock
-	    (fn (Block.T {statements, transfer, ...}) =>
-	    let
-	       val f = evalStatements statements
-	       val (ss, transfer) = simplifyTransfer transfer
-	    in
-	       (f ss, transfer)
-	    end) arg
-	 and evalStatements (ss: Statement.t vector)
-	    : Statement.t list -> Statement.t list =
-	    let
-	       val fs = Vector.map (ss, evalStatement)
-	    in
-	       fn ss => Vector.foldr (fs, ss, fn (f, ss) => f ss)
-	    end
-	 and simplifyTransfer arg : Statement.t list * Transfer.t =
-	    traceSimplifyTransfer
-	    (fn (t: Transfer.t) =>
-	    case t of
-	        Arith {prim, args, overflow, success, ty} =>
-		   let
-		      val args = varInfos args
-		   in
-		      case primApp (prim, args) of
-			 Prim.ApplyResult.Const c =>
-			    let
-			       val () = deleteLabel overflow
-			       val x = Var.newNoname ()
-			       val isUsed = ref false
-			       val vi =
-				  VarInfo.T {isUsed = isUsed,
-					     numOccurrences = ref 0,
-					     ty = SOME ty,
-					     value = ref (SOME (Value.Const c)),
-					     var = x}
-			       val (ss, t) = goto (success, Vector.new1 vi)
-			       val ss =
-				  if !isUsed
-				     then Bind {var = SOME x,
-						ty = Type.ofConst c,
-						exp = Exp.Const c} :: ss
-				  else ss
-			    in
-			       (ss, t)
-			    end
-		       | Prim.ApplyResult.Var x =>
-			    let
-			       val () = deleteLabel overflow
-			    in
-			       goto (success, Vector.new1 x)
-			    end
-		       | Prim.ApplyResult.Overflow =>
-			    let
-			       val () = deleteLabel success
-			    in
-			       goto (overflow, Vector.new0 ())
-			    end
-		       | Prim.ApplyResult.Apply (prim, args) =>
-			    let
-			       val args = Vector.fromList args
-			    in
-			       ([], Arith {prim = prim,
-					   args = uses args,
-					   overflow = simplifyLabel overflow,
-					   success = simplifyLabel success,
-					   ty = ty})
-			    end					
-		       | _ =>
-			    ([], Arith {prim = prim,
-					args = uses args,
-					overflow = simplifyLabel overflow,
-					success = simplifyLabel success,
-					ty = ty})
-		   end
-	     | Bug => ([], Bug)
-	     | Call {func, args, return} =>
-		  let
-		     val (statements, return) =
-			case return of
-			   Return.NonTail {cont, handler} =>
-			      let
-				 fun isEta (m: LabelMeaning.t,
-					    ps: Position.t vector): bool =
-				    Vector.length ps
-				    = (Vector.length
-				       (Block.args
-					(Vector.sub
-					 (blocks, LabelMeaning.blockIndex m))))
-				    andalso
-				    Vector.foralli
-				    (ps,
-				     fn (i, Position.Formal i') => i = i'
-				      | _ => false)
-				 val m = labelMeaning cont
-				 fun nonTail () =
-				    let
-				       val () = forceMeaningBlock m
-				       val handler =
-					  Handler.map
-					  (handler, fn l =>
-					   let
-					      val m = labelMeaning l
-					      val () = forceMeaningBlock m
-					   in
-					      meaningLabel m
-					   end)
-				    in
-				       ([],
-					Return.NonTail {cont = meaningLabel m,
-							handler = handler})
-				    end
-				 fun tail statements =
-				    (deleteLabelMeaning m
-				     ; (statements, Return.Tail))
-				 fun cont handlerEta =
-				    case LabelMeaning.aux m of
-				       LabelMeaning.Bug =>
-					  (case handlerEta of
-					      NONE => nonTail ()
-					    | SOME canMove => tail canMove)
-				     | LabelMeaning.Return {args, canMove} =>
-					  if isEta (m, args)
-					     then tail canMove
-					  else nonTail ()
-				     | _ => nonTail ()
+                     let
+                        val () = incVars args
+                        val () =
+                           Return.foreachHandler
+                           (return, fn l =>
+                            Array.inc (numHandlerUses, labelIndex l))
+                        val () = Return.foreachLabel (return, incLabel)
+                     in
+                        normal ()
+                     end
+                | Case {test, cases, default} =>
+                     let
+                        val () = incVar test
+                        val () = Cases.foreach (cases, incLabel)
+                        val () = Option.app (default, incLabel)
+                     in
+                        if Vector.forall(statements, Statement.isProfile)
+                           andalso not (Array.sub (isHeader, i))
+                           andalso 1 = Vector.length args
+                           andalso 1 = numVarOccurrences test
+                           andalso Var.equals (test, #1 (Vector.sub (args, 0)))
+                           then
+                              doit (LabelMeaning.Case {canMove = canMove (),
+                                                       cases = cases,
+                                                       default = default})
+                        else
+                           normal ()
+                     end
+                | Goto {dst, args = actuals} =>
+                     let
+                        val () = incVars actuals
+                        val m = labelMeaning dst
+                     in
+                        if Vector.exists (statements, not o Statement.isProfile)
+                           orelse Array.sub (isHeader, i)
+                           then (incLabelMeaning m
+                                 ; normal ())
+                        else
+                           if 0 = Vector.length statements
+                              andalso
+                              Vector.equals (args, actuals, fn ((x, _), x') =>
+                                             Var.equals (x, x')
+                                             andalso 1 = numVarOccurrences x)
+                              then m (* It's an eta. *)
+                           else
+                           let
+                              val ps = extract actuals
+                              val n =
+                                 Vector.fold (args, 0, fn ((x, _), n) =>
+                                              n + numVarOccurrences x)
+                              val n' =
+                                 Vector.fold (ps, 0, fn (p, n) =>
+                                              case p of
+                                                 Position.Formal _ => n + 1
+                                               | _ => n)
+                              datatype z = datatype LabelMeaning.aux
+                           in
+                              if n <> n'
+                                 then (incLabelMeaning m
+                                       ; normal ())
+                              else
+                                 let
+                                    fun extract (ps': Positions.t)
+                                       : Positions.t =
+                                       Vector.map
+                                       (ps', fn p =>
+                                        let
+                                           datatype z = datatype Position.t
+                                        in
+                                           case p of
+                                              Free x => Free x
+                                            | Formal i => Vector.sub (ps, i)
+                                        end)
+                                    val canMove' = canMove ()
+                                    val a =
+                                       case LabelMeaning.aux m of
+                                          Block => 
+                                             Goto {canMove = canMove',
+                                                   dst = m,
+                                                   args = ps}
+                                        | Bug => Bug
+                                        | Case _ => 
+                                             Goto {canMove = canMove',
+                                                   dst = m,
+                                                   args = ps}
+                                        | Goto {canMove, dst, args} =>
+                                             Goto {canMove = canMove' @ canMove,
+                                                   dst = dst,
+                                                   args = extract args}
+                                        | Raise {args, canMove} =>
+                                             Raise {args = extract args,
+                                                    canMove = canMove' @ canMove}
+                                        | Return {args, canMove} =>
+                                             Return {args = extract args,
+                                                     canMove = canMove' @ canMove}
+                                 in
+                                    doit a
+                                 end
+                           end
+                     end
+                | Raise xs => rr (xs, LabelMeaning.Raise)
+                | Return xs => rr (xs, LabelMeaning.Return)
+                | Runtime {args, return, ...} =>
+                     (incVars args
+                      ; incLabel return
+                      ; normal ())
+            end
+         val () = incLabel start
+         fun indexMeaning i =
+            case Array.sub (states, i) of
+               State.Visited m => m
+             | _ => Error.bug "Ssa2.Shrink2.indexMeaning: not computed"
+         val indexMeaning =
+            Trace.trace ("Ssa2.Shrink2.indexMeaning", Int.layout, LabelMeaning.layout)
+            indexMeaning
+         val labelMeaning = indexMeaning o labelIndex
+         val labelMeaning =
+            Trace.trace ("Ssa2.Shrink2.labelMeaning",
+                         Label.layout, LabelMeaning.layout)
+            labelMeaning
+         fun meaningLabel m =
+            Block.label (Vector.sub (blocks, LabelMeaning.blockIndex m))
+         fun save (f, s) =
+            File.withOut
+            (concat ["/tmp/", Func.toString (Function.name f),
+                     ".", s, ".dot"],
+             fn out =>
+             Layout.outputl
+             (#graph (Function.layoutDot (f, fn _ => NONE)),
+              out))
+         val () = if true then () else save (f, "pre")
+         (* *)
+         val () =
+            if true
+               then ()
+            else
+               Layout.outputl
+               (Vector.layout
+                (fn i =>
+                 (Layout.record
+                  [("label",
+                    Label.layout (Block.label (Vector.sub (blocks, i)))),
+                   ("inDegree", Int.layout (Array.sub (inDegree, i))),
+                   ("state", State.layout (Array.sub (states, i)))]))
+                (Vector.tabulate (numBlocks, fn i => i)),
+                Out.error)
+         val () =
+            Assert.assert
+            ("Ssa2.Shrink2.labelMeanings", fn () =>
+             let
+                val inDegree' = Array.array (numBlocks, 0)
+                fun bumpIndex i = Array.inc (inDegree', i)
+                fun bumpMeaning m = bumpIndex (LabelMeaning.blockIndex m)
+                val bumpLabel = bumpMeaning o labelMeaning
+                fun doit (LabelMeaning.T {aux, blockIndex, ...}) =
+                   let
+                      datatype z = datatype LabelMeaning.aux
+                   in
+                      case aux of
+                         Block =>
+                            Transfer.foreachLabel
+                            (Block.transfer (Vector.sub (blocks, blockIndex)),
+                             bumpLabel)
+                       | Bug => ()
+                       | Case {cases, default, ...} =>
+                            (Cases.foreach (cases, bumpLabel)
+                             ; Option.app (default, bumpLabel))
+                       | Goto {dst, ...} => bumpMeaning dst
+                       | Raise _ => ()
+                       | Return _ => ()
+                   end
+                val () =
+                   Array.foreachi
+                   (states, fn (i, s) =>
+                    if Array.sub (inDegree, i) > 0
+                       then
+                          (case s of
+                              State.Visited m => doit m
+                            | _ => ())
+                    else ())
+                val () = bumpMeaning (labelMeaning start)
+             in
+                Array.equals (inDegree, inDegree', Int.equals)
+                orelse
+                let
+                   val () =
+                      Layout.outputl
+                      (Vector.layout
+                       (fn i =>
+                        (Layout.record
+                         [("label",
+                           Label.layout (Block.label (Vector.sub (blocks, i)))),
+                          ("inDegree", Int.layout (Array.sub (inDegree, i))),
+                          ("inDegree'", Int.layout (Array.sub (inDegree', i))),
+                          ("state", State.layout (Array.sub (states, i)))]))
+                       (Vector.tabulate (numBlocks, fn i => i)),
+                       Out.error)
+                in
+                   false
+                end
+             end)
+         val isBlock = Array.array (numBlocks, false)
+         (* Functions for maintaining inDegree. *)
+         val addLabelIndex =
+            fn i =>
+            (Assert.assert ("Ssa2.Shrink2.addLabelIndex", fn () =>
+                            Array.sub (inDegree, i) > 0)
+             ; addLabelIndex i)
+         val addLabelMeaning = addLabelIndex o LabelMeaning.blockIndex
+         fun layoutLabelMeaning m =
+            Layout.record
+            [("inDegree", Int.layout (Array.sub
+                                      (inDegree, LabelMeaning.blockIndex m))),
+             ("meaning", LabelMeaning.layout m)]
+         val traceDeleteLabelMeaning =
+            Trace.trace ("Ssa2.Shrink2.deleteLabelMeaning",
+                         layoutLabelMeaning, Unit.layout)
+         fun deleteLabel l = deleteLabelMeaning (labelMeaning l)
+         and deleteLabelMeaning arg: unit =
+            traceDeleteLabelMeaning
+            (fn (m: LabelMeaning.t) =>
+            let
+               val i = LabelMeaning.blockIndex m
+               val n = Array.sub (inDegree, i) - 1
+               val () = Array.update (inDegree, i, n)
+               val () = Assert.assert ("Ssa2.Shrink2.deleteLabelMeaning", fn () => n >= 0)
+            in
+               if n = 0 (* andalso not (Array.sub (isBlock, i)) *)
+                  then
+                     let
+                        datatype z = datatype LabelMeaning.aux
+                     in
+                        case LabelMeaning.aux m of
+                           Block =>
+                              let
+                                 val t = Block.transfer (Vector.sub (blocks, i))
+                                 val () = Transfer.foreachLabel (t, deleteLabel)
+                                 val () =
+                                    case t of
+                                       Transfer.Call {return, ...} =>
+                                          Return.foreachHandler
+                                          (return, fn l =>
+                                           Array.dec (numHandlerUses,
+                                                      (LabelMeaning.blockIndex
+                                                       (labelMeaning l))))
+                                     | _ => ()
+                              in
+                                 ()
+                              end
+                         | Bug => ()
+                         | Case {cases, default, ...} =>
+                              (Cases.foreach (cases, deleteLabel)
+                               ; Option.app (default, deleteLabel))
+                         | Goto {dst, ...} => deleteLabelMeaning dst
+                         | Raise _ => ()
+                         | Return _ => ()
+                     end
+               else ()
+            end) arg
+         fun primApp (prim: Type.t Prim.t, args: VarInfo.t vector)
+            : (Type.t, VarInfo.t) Prim.ApplyResult.t =
+            case Prim.name prim of
+               Prim.Name.FFI _ => Prim.ApplyResult.Unknown
+             | _ =>
+                  let
+                     val args' =
+                        Vector.map
+                        (args, fn vi =>
+                         case vi of
+                            VarInfo.T {value = ref (SOME v), ...} =>
+                               (case v of
+                                   Value.Const c => Prim.ApplyArg.Const c
+                                 | Value.Object {args, con} =>
+                                      (case (con, Vector.length args) of
+                                          (SOME con, 0) =>
+                                             Prim.ApplyArg.Con {con = con,
+                                                                hasArg = false}
+                                        | _ => Prim.ApplyArg.Var vi)
+                                 | _ => Prim.ApplyArg.Var vi)
+                          | _ => Prim.ApplyArg.Var vi)
+                  in
+                     Trace.traceInfo'
+                     (traceApplyInfo,
+                      fn (p, args, _) =>
+                      let
+                         open Layout
+                      in
+                         seq [Prim.layout p, str " ",
+                              List.layout (Prim.ApplyArg.layout
+                                           (Var.layout o VarInfo.var)) args]
+                      end,
+                      Prim.ApplyResult.layout (Var.layout o VarInfo.var))
+                     Prim.apply
+                     (prim, Vector.toList args', VarInfo.equals)
+                  end
+         (* Another DFS, this time accumulating the new blocks. *)
+         val traceForceMeaningBlock =
+            Trace.trace ("Ssa2.Shrink2.forceMeaningBlock",
+                        layoutLabelMeaning, Unit.layout)
+         val traceSimplifyBlock =
+            Trace.trace2 ("Ssa2.Shrink2.simplifyBlock",
+                          List.layout Statement.layout,
+                          layoutLabel o Block.label,
+                          Layout.tuple2 (List.layout Statement.layout,
+                                         Transfer.layout))
+         val traceGotoMeaning =
+            Trace.trace3
+            ("Ssa2.Shrink2.gotoMeaning",
+             List.layout Statement.layout,
+             layoutLabelMeaning,
+             Vector.layout VarInfo.layout,
+             Layout.tuple2 (List.layout Statement.layout, Transfer.layout))
+         val traceEvalStatement =
+            Trace.trace
+            ("Ssa2.Shrink2.evalStatement",
+             Statement.layout,
+             Layout.ignore: (Statement.t list -> Statement.t list) -> Layout.t)
+         val traceSimplifyTransfer =
+            Trace.trace ("Ssa2.Shrink2.simplifyTransfer",
+                         Transfer.layout,
+                         Layout.tuple2 (List.layout Statement.layout,
+                                        Transfer.layout))
+         val newBlocks = ref []
+         fun simplifyLabel l =
+            let
+               val m = labelMeaning l
+               val () = forceMeaningBlock m
+            in
+               meaningLabel m
+            end
+         and forceMeaningBlock arg =
+            traceForceMeaningBlock
+            (fn (LabelMeaning.T {aux, blockIndex = i, ...}) =>
+             if Array.sub (isBlock, i)
+                then ()
+             else
+                let
+                   val () = Array.update (isBlock, i, true)
+                   val block as Block.T {label, args, ...} =
+                      Vector.sub (blocks, i)
+                   fun extract (p: Position.t): VarInfo.t =
+                      varInfo (case p of
+                                  Position.Formal n => #1 (Vector.sub (args, n))
+                                | Position.Free x => x)
+                   val (statements, transfer) =
+                      let
+                         fun rr ({args, canMove}, make) =
+                            (canMove, make (Vector.map (args, use o extract)))
+                         datatype z = datatype LabelMeaning.aux
+                      in
+                         case aux of
+                            Block => simplifyBlock ([], block)
+                          | Bug => ([], Transfer.Bug)
+                          | Case _ => simplifyBlock ([], block)
+                          | Goto {canMove, dst, args} =>
+                               gotoMeaning (canMove,
+                                            dst, 
+                                            Vector.map (args, extract))
+                          | Raise z => rr (z, Transfer.Raise)
+                          | Return z => rr (z, Transfer.Return)
+                      end
+                   val () =
+                      List.push
+                      (newBlocks,
+                       Block.T {label = label,
+                                args = args,
+                                statements = Vector.fromList statements,
+                                transfer = transfer})
+                in
+                   ()
+                end) arg
+         and simplifyBlock arg : Statement.t list * Transfer.t =
+            traceSimplifyBlock
+            (fn (canMoveIn, Block.T {statements, transfer, ...}) =>
+            let
+               val f = evalStatements statements
+               val (ss, transfer) = simplifyTransfer transfer
+            in
+               (canMoveIn @ (f ss), transfer)
+            end) arg
+         and evalStatements (ss: Statement.t vector)
+            : Statement.t list -> Statement.t list =
+            let
+               val fs = Vector.map (ss, evalStatement)
+            in
+               fn ss => Vector.foldr (fs, ss, fn (f, ss) => f ss)
+            end
+         and simplifyTransfer arg : Statement.t list * Transfer.t =
+            traceSimplifyTransfer
+            (fn (t: Transfer.t) =>
+            case t of
+                Arith {prim, args, overflow, success, ty} =>
+                   let
+                      val args = varInfos args
+                   in
+                      case primApp (prim, args) of
+                         Prim.ApplyResult.Const c =>
+                            let
+                               val () = deleteLabel overflow
+                               val x = Var.newNoname ()
+                               val isUsed = ref false
+                               val vi =
+                                  VarInfo.T {isUsed = isUsed,
+                                             numOccurrences = ref 0,
+                                             ty = SOME ty,
+                                             value = ref (SOME (Value.Const c)),
+                                             var = x}
+                               val (ss, t) = goto (success, Vector.new1 vi)
+                               val ss =
+                                  if !isUsed
+                                     then Bind {var = SOME x,
+                                                ty = Type.ofConst c,
+                                                exp = Exp.Const c} :: ss
+                                  else ss
+                            in
+                               (ss, t)
+                            end
+                       | Prim.ApplyResult.Var x =>
+                            let
+                               val () = deleteLabel overflow
+                            in
+                               goto (success, Vector.new1 x)
+                            end
+                       | Prim.ApplyResult.Overflow =>
+                            let
+                               val () = deleteLabel success
+                            in
+                               goto (overflow, Vector.new0 ())
+                            end
+                       | Prim.ApplyResult.Apply (prim, args) =>
+                            let
+                               val args = Vector.fromList args
+                            in
+                               ([], Arith {prim = prim,
+                                           args = uses args,
+                                           overflow = simplifyLabel overflow,
+                                           success = simplifyLabel success,
+                                           ty = ty})
+                            end                                 
+                       | _ =>
+                            ([], Arith {prim = prim,
+                                        args = uses args,
+                                        overflow = simplifyLabel overflow,
+                                        success = simplifyLabel success,
+                                        ty = ty})
+                   end
+             | Bug => ([], Bug)
+             | Call {func, args, return} =>
+                  let
+                     val (statements, return) =
+                        case return of
+                           Return.NonTail {cont, handler} =>
+                              let
+                                 fun isEta (m: LabelMeaning.t,
+                                            ps: Position.t vector): bool =
+                                    Vector.length ps
+                                    = (Vector.length
+                                       (Block.args
+                                        (Vector.sub
+                                         (blocks, LabelMeaning.blockIndex m))))
+                                    andalso
+                                    Vector.foralli
+                                    (ps,
+                                     fn (i, Position.Formal i') => i = i'
+                                      | _ => false)
+                                 val m = labelMeaning cont
+                                 fun nonTail () =
+                                    let
+                                       val () = forceMeaningBlock m
+                                       val handler =
+                                          Handler.map
+                                          (handler, fn l =>
+                                           let
+                                              val m = labelMeaning l
+                                              val () = forceMeaningBlock m
+                                           in
+                                              meaningLabel m
+                                           end)
+                                    in
+                                       ([],
+                                        Return.NonTail {cont = meaningLabel m,
+                                                        handler = handler})
+                                    end
+                                 fun tail statements =
+                                    (deleteLabelMeaning m
+                                     ; (statements, Return.Tail))
+                                 fun cont handlerEta =
+                                    case LabelMeaning.aux m of
+                                       LabelMeaning.Bug =>
+                                          (case handlerEta of
+                                              NONE => nonTail ()
+                                            | SOME canMove => tail canMove)
+                                     | LabelMeaning.Return {args, canMove} =>
+                                          if isEta (m, args)
+                                             then tail canMove
+                                          else nonTail ()
+                                     | _ => nonTail ()
 
-			      in
-				 case handler of
-				    Handler.Caller => cont NONE
-				  | Handler.Dead => cont NONE
-				  | Handler.Handle l =>
-				       let
-					  val m = labelMeaning l
-				       in
-					  case LabelMeaning.aux m of
-					     LabelMeaning.Bug => cont NONE
-					   | LabelMeaning.Raise {args, canMove} =>
-						if isEta (m, args)
-						   then cont (SOME canMove)
-						else nonTail ()
-					   | _ => nonTail ()
-				       end
-			      end
-			 | _ => ([], return)
-		  in 
-		     (statements,
-		      Call {func = func,
-			    args = simplifyVars args,
-			    return = return})
-		  end
-	      | Case {test, cases, default} =>
-		   let
-		      val test = varInfo test
-		      fun cantSimplify () =
-			 ([],
-			  Case {test = use test,
-				cases = Cases.map (cases, simplifyLabel),
-				default = Option.map (default, simplifyLabel)})
-		   in
-		      simplifyCase
-		      {cantSimplify = cantSimplify,
-		       cases = cases,
-		       default = default,
-		       gone = fn () => (Cases.foreach (cases, deleteLabel)
-					; Option.app (default, deleteLabel)),
-		       test = test}
-		   end
-	      | Goto {dst, args} => goto (dst, varInfos args)
-	      | Raise xs => ([], Raise (simplifyVars xs))
-	      | Return xs => ([], Return (simplifyVars xs))
-	      | Runtime {prim, args, return} =>
-		   ([], Runtime {prim = prim, 
-				 args = simplifyVars args, 
-				 return = simplifyLabel return})
-		   ) arg
-	 and simplifyCase {cantSimplify, cases, default, gone, test: VarInfo.t}
-	    : Statement.t list * Transfer.t =
-	    let
-	       (* tryToEliminate makes sure that the destination meaning
-		* hasn't already been simplified.  If it has, then we can't
-		* simplify the case.
-		*)
-	       fun tryToEliminate m =
-		  let
-		     val i = LabelMeaning.blockIndex m
-		  in
-		     if Array.sub (inDegree, i) = 0
-			then cantSimplify ()
-		     else
-			let
-			   val () = addLabelIndex i
-			   val () = gone ()
-			in
-			   gotoMeaning (m, Vector.new0 ())
-			end
-		  end
-	    in
-	       if Cases.isEmpty cases
-		  then (case default of
-			   NONE => ([], Bug)
-			 | SOME l => tryToEliminate (labelMeaning l))
-	       else
-		  let
-		     val l = Cases.hd cases
-		     fun isOk (l': Label.t): bool = Label.equals (l, l')
-		  in
-		     if 0 = Vector.length (Block.args
-					   (Vector.sub (blocks, labelIndex l)))
-			andalso Cases.forall (cases, isOk)
-			andalso (case default of
-				    NONE => true
-				  | SOME l => isOk l)
-			then
-			   (* All cases the same -- eliminate the case. *)
-			   tryToEliminate (labelMeaning l)
-		     else
-			let
-			   fun findCase (cases, is, args) =
-			      let
-				 val n = Vector.length cases
-				 fun doit (j, args) =
-				    let
-				       val m = labelMeaning j
-				       val () = addLabelMeaning m
-				       val () = gone ()
-				    in
-				       gotoMeaning (m, args)
-				    end
-				 fun loop k =
-				    if k = n
-				       then
-					  (case default of
-					      NONE => (gone (); ([], Bug))
-					    | SOME j => doit (j, Vector.new0 ()))
-				    else
-				       let
-					  val (i, j) = Vector.sub (cases, k)
-				       in
-					  if is i
-					     then doit (j, args)
-					  else loop (k + 1)
-				       end
-			      in
-				 loop 0
-			      end
-			in
-			   case (VarInfo.value test, cases) of
-			      (SOME (Value.Const c), _) =>
-				 (case (cases, c) of
-				     (Cases.Word (_, cs), Const.Word w) =>
-					findCase (cs,
-						  fn w' => WordX.equals (w, w'),
-						  Vector.new0 ())
-				   | _ =>
-					Error.bug "strange constant for cases")
-			    | (SOME (Value.Inject {variant, ...}),
-			       Cases.Con cases) =>
-				 let
-				    val VarInfo.T {value, ...} = variant
-				 in
-				    case !value of
-				       SOME (Value.Object
-					     {args, con = SOME con, ...}) => 
-					  findCase (cases,
-						    fn c => Con.equals (con, c),
-						    if 0 = Vector.length args
-						       then Vector.new0 ()
-						    else Vector.new1 variant)
-				     | _ => cantSimplify ()
-				 end
-			    | _ => cantSimplify ()
-			end
-		  end
-	    end
-	 and goto (dst: Label.t, args: VarInfo.t vector)
-	    : Statement.t list * Transfer.t =
-	    gotoMeaning (labelMeaning dst, args)
-	 and gotoMeaning arg : Statement.t list * Transfer.t =
-	    traceGotoMeaning
-	    (fn (m as LabelMeaning.T {aux, blockIndex = i, ...},
-		 args: VarInfo.t vector) =>
-	     let
-		val n = Array.sub (inDegree, i)
-		val () = Assert.assert ("goto", fn () => n >= 1)
-		fun normal () =
-		   if n = 1
-		      then
-			 let
-			    val () = Array.update (inDegree, i, 0)
-			    val b = Vector.sub (blocks, i)
-			    val () =
-			       Vector.foreach2
-			       (Block.args b, args, fn ((x, _), vi) =>
-				setVarInfo (x, vi))
-			 in
-			    simplifyBlock b
-			 end
-		   else
-		      let
-			 val () = forceMeaningBlock m
-		      in
-			 ([],
-			  Goto {dst = Block.label (Vector.sub (blocks, i)),
-				args = uses args})
-		      end
-		fun extract p =
-		   case p of
-		      Position.Formal n => Vector.sub (args, n)
-		    | Position.Free x => varInfo x
-		fun rr ({args, canMove}, make) =
-		   (canMove, make (Vector.map (args, use o extract)))
-		datatype z = datatype LabelMeaning.aux
-	     in
-		case aux of
-		   Block => normal ()
-		 | Bug => ([], Transfer.Bug)
-		 | Case {cases, default} =>
-		      simplifyCase {cantSimplify = normal,
-				    cases = cases,
-				    default = default,
-				    gone = fn () => deleteLabelMeaning m,
-				    test = Vector.sub (args, 0)}
-		 | Goto {dst, args} =>
-		      if Array.sub (isHeader, i)
-			 orelse Array.sub (isBlock, i)
-			 then normal ()
-		      else
-			 let
-			    val n' = n - 1
-			    val () = Array.update (inDegree, i, n')
-			    val () = 
-			       if n' > 0
-				  then addLabelMeaning dst
-			       else ()
-			 in
-			    gotoMeaning (dst, Vector.map (args, extract))
-			 end
-		 | Raise z => rr (z, Transfer.Raise)
-		 | Return z => rr (z, Transfer.Return)
-	     end) arg
-	 and evalBind {exp, ty, var} =
-	    let
-	       val () =
-		  Option.app (var, fn x => 
-			      setVarInfo (x, VarInfo.new (x, SOME ty)))
-	       fun delete ss = ss
-	       fun doit {makeExp: unit -> Exp.t,
-			 sideEffect: bool,
-			 value: Value.t option} =
-		  let
-		     fun make var = Bind {exp = makeExp (), ty = ty, var = var}
-		  in
-		     case var of
-			NONE =>
-			   if sideEffect
-			      then (fn ss => make NONE :: ss)
-			   else delete
-		      | SOME x =>
-			   let
-			      val VarInfo.T {isUsed, value = r, ...} = varInfo x
-			      val () = r := value
-			   in
-			      fn ss =>
-			      if !isUsed
-				 then make (SOME x) :: ss
-			      else if sideEffect
-				      then make NONE :: ss
-				   else ss
-			   end
-		  end
-	       fun simple {sideEffect} =
-		  let
-		     fun makeExp () = Exp.replaceVar (exp, use o varInfo)
-		  in
-		     doit {makeExp = makeExp,
-			   sideEffect = sideEffect,
-			   value = NONE}
-		  end
-	       fun setVar vi =
-		  (Option.app (var, fn x => setVarInfo (x, vi))
-		   ; delete)
-	       fun construct (v: Value.t, makeExp) =
-		  doit {makeExp = makeExp,
-			sideEffect = false,
-			value = SOME v}
-	       fun tuple (xs: VarInfo.t vector) =
-		  case (DynamicWind.withEscape
-			(fn escape =>
-			 let
-			    fun no () = escape NONE
-			 in
-			    Vector.foldri
-			    (xs, NONE,
-			     fn (i, VarInfo.T {value, ...}, tuple') => 
-			     case !value of
-				SOME (Value.Select {object, offset}) =>
-				   (if i = offset
-				       then
-					  case tuple' of
-					     NONE => 
-						(case VarInfo.ty object of
-						    NONE => no ()
-						  | SOME ty =>
-						       (case Type.dest ty of
-							   Type.Object {args, con = ObjectCon.Tuple} =>
-							      if Prod.length args
-								 = Vector.length xs
-								 andalso
-								 not (Prod.isMutable args)
-								 then SOME object
-							      else no ()
-							 | _ => no ()))
-					   | SOME tuple'' => 
-						if VarInfo.equals (tuple'', object)
-						   then tuple'
-						else no ()
-				    else no ())
-			      | _ => no ())
-			 end)) of
-		     NONE =>
-			construct (Value.Object {args = xs, con = NONE},
-				   fn () => Object {args = uses xs, con = NONE})
-		   | SOME object => setVar object
-	    in
-	       case exp of
-		  Const c => construct (Value.Const c, fn () => exp)
-		| Inject {sum, variant} =>
-		     let
-			val variant = varInfo variant
-		     in
-			construct (Value.Inject {sum = sum, variant = variant},
-				   fn () => Inject {sum = sum,
-						    variant = use variant})
-		     end
-		| Object {args, con} =>
-		     let
-			val args = varInfos args
-		     in
-			if isSome con
-			   then
-			      construct (Value.Object {args = args, con = con},
-					 fn () => Object {args = uses args,
-							  con = con})
-			else tuple args
-		     end
-		| PrimApp {args, prim} =>
-		     let
-			val args = varInfos args
-			fun apply {prim, args} =
-			   doit {makeExp = fn () => PrimApp {args = uses args,
-							     prim = prim},
-				 sideEffect = Prim.maySideEffect prim,
-				 value = NONE}
-			datatype z = datatype Prim.ApplyResult.t
-		     in
-			case primApp (prim, args) of
-			   Apply (p, args) => apply {prim = p,
-						     args = Vector.fromList args}
-			 | Bool b =>
-			      let
-				 val variant = Var.newNoname ()
-				 val con = Con.fromBool b
-			      in
-				 evalStatements
-				 (Vector.new2
-				  (Bind {exp = Object {args = Vector.new0 (),
-						       con = SOME con},
-					 ty = Type.object {args = Prod.empty (),
-							   con = ObjectCon.Con con},
-					 var = SOME variant},
-				   Bind {exp = Inject {sum = Tycon.bool,
-						       variant = variant},
-					 ty = Type.bool,
-					 var = var}))
-			      end
-			 | Const c => construct (Value.Const c,
-						 fn () => Exp.Const c)
-			 | Var vi => setVar vi
-			 | _ => apply {args = args, prim = prim}
-				       
-		     end
-		| Select {base, offset} =>
-		     (case base of
-			 Base.Object object =>
-			    let
-			       val object as VarInfo.T {ty, value, ...} =
-				  varInfo object
-			       fun dontChange () =
-				  construct
-				  (Value.Select {object = object,
-						 offset = offset},
-				   fn () =>
-				   Select {base = Base.Object (use object),
-					   offset = offset})
-			    in
-			       case (ty, !value) of
-				  (SOME ty, SOME (Value.Object {args, ...})) =>
-				     (case Type.dest ty of
-					 Type.Object {args = targs, ...} =>
-					    (* Can't simplify the select if the
-					     * field is mutable.
-					     *)
-					    if (#isMutable
-						(Vector.sub
-						 (Prod.dest targs, offset)))
-					       then dontChange ()
-					    else setVar (Vector.sub
-							 (args, offset))
-				       | _ => Error.bug "select of non object")
-				| _ => dontChange ()
-			    end
-		       | Base.VectorSub _ => simple {sideEffect = false})
-		| Var x => setVar (varInfo x)
-	    end
-	 and evalStatement arg : Statement.t list -> Statement.t list =
-	    traceEvalStatement
-	    (fn s =>
-	     let
-		fun simple () =
-		   fn ss => Statement.replaceUses (s, use o varInfo) :: ss
-	     in
-		case s of
-		   Bind b => evalBind b
-		 | Profile _ => simple ()
-		 | Update _ => simple ()
-	     end) arg
-	 val start = labelMeaning start
-	 val () = forceMeaningBlock start
-	 val f = 
-	    Function.new {args = args,
-			  blocks = Vector.fromList (!newBlocks),
-			  mayInline = mayInline,
-			  name = name,
-			  raises = raises,
-			  returns = returns,
-			  start = meaningLabel start}
-(*	 val () = save (f, "post") *)
-	 val () = Function.clear f
+                              in
+                                 case handler of
+                                    Handler.Caller => cont NONE
+                                  | Handler.Dead => cont NONE
+                                  | Handler.Handle l =>
+                                       let
+                                          val m = labelMeaning l
+                                       in
+                                          case LabelMeaning.aux m of
+                                             LabelMeaning.Bug => cont NONE
+                                           | LabelMeaning.Raise {args, canMove} =>
+                                                if isEta (m, args)
+                                                   then cont (SOME canMove)
+                                                else nonTail ()
+                                           | _ => nonTail ()
+                                       end
+                              end
+                         | _ => ([], return)
+                  in 
+                     (statements,
+                      Call {func = func,
+                            args = simplifyVars args,
+                            return = return})
+                  end
+              | Case {test, cases, default} =>
+                   let
+                      val test = varInfo test
+                      fun cantSimplify () =
+                         ([],
+                          Case {test = use test,
+                                cases = Cases.map (cases, simplifyLabel),
+                                default = Option.map (default, simplifyLabel)})
+                   in
+                      simplifyCase
+                      {canMove = [],
+                       cantSimplify = cantSimplify,
+                       cases = cases,
+                       default = default,
+                       gone = fn () => (Cases.foreach (cases, deleteLabel)
+                                        ; Option.app (default, deleteLabel)),
+                       test = test}
+                   end
+              | Goto {dst, args} => goto (dst, varInfos args)
+              | Raise xs => ([], Raise (simplifyVars xs))
+              | Return xs => ([], Return (simplifyVars xs))
+              | Runtime {prim, args, return} =>
+                   ([], Runtime {prim = prim, 
+                                 args = simplifyVars args, 
+                                 return = simplifyLabel return})
+                   ) arg
+         and simplifyCase {canMove, cantSimplify, 
+                           cases, default, gone, test: VarInfo.t}
+            : Statement.t list * Transfer.t =
+            let
+               (* tryToEliminate makes sure that the destination meaning
+                * hasn't already been simplified.  If it has, then we can't
+                * simplify the case.
+                *)
+               fun tryToEliminate m =
+                  let
+                     val i = LabelMeaning.blockIndex m
+                  in
+                     if Array.sub (inDegree, i) = 0
+                        then cantSimplify ()
+                     else
+                        let
+                           val () = addLabelIndex i
+                           val () = gone ()
+                        in
+                           gotoMeaning (canMove, m, Vector.new0 ())
+                        end
+                  end
+            in
+               if Cases.isEmpty cases
+                  then (case default of
+                           NONE => ([], Bug)
+                         | SOME l => tryToEliminate (labelMeaning l))
+               else
+                  let
+                     val l = Cases.hd cases
+                     fun isOk (l': Label.t): bool = Label.equals (l, l')
+                  in
+                     if 0 = Vector.length (Block.args
+                                           (Vector.sub (blocks, labelIndex l)))
+                        andalso Cases.forall (cases, isOk)
+                        andalso (case default of
+                                    NONE => true
+                                  | SOME l => isOk l)
+                        then
+                           (* All cases the same -- eliminate the case. *)
+                           tryToEliminate (labelMeaning l)
+                     else
+                        let
+                           fun findCase (cases, is, args) =
+                              let
+                                 val n = Vector.length cases
+                                 fun doit (j, args) =
+                                    let
+                                       val m = labelMeaning j
+                                       val () = addLabelMeaning m
+                                       val () = gone ()
+                                    in
+                                       gotoMeaning (canMove, m, args)
+                                    end
+                                 fun loop k =
+                                    if k = n
+                                       then
+                                          (case default of
+                                              NONE => (gone (); ([], Bug))
+                                            | SOME j => doit (j, Vector.new0 ()))
+                                    else
+                                       let
+                                          val (i, j) = Vector.sub (cases, k)
+                                       in
+                                          if is i
+                                             then doit (j, args)
+                                          else loop (k + 1)
+                                       end
+                              in
+                                 loop 0
+                              end
+                        in
+                           case (VarInfo.value test, cases) of
+                              (SOME (Value.Const c), _) =>
+                                 (case (cases, c) of
+                                     (Cases.Word (_, cs), Const.Word w) =>
+                                        findCase (cs,
+                                                  fn w' => WordX.equals (w, w'),
+                                                  Vector.new0 ())
+                                   | _ =>
+                                        Error.bug "Ssa2.Shrink2.simplifyCase: strange constant")
+                            | (SOME (Value.Inject {variant, ...}),
+                               Cases.Con cases) =>
+                                 let
+                                    val VarInfo.T {value, ...} = variant
+                                 in
+                                    case !value of
+                                       SOME (Value.Object
+                                             {args, con = SOME con, ...}) => 
+                                          findCase (cases,
+                                                    fn c => Con.equals (con, c),
+                                                    if 0 = Vector.length args
+                                                       then Vector.new0 ()
+                                                    else Vector.new1 variant)
+                                     | _ => cantSimplify ()
+                                 end
+                            | _ => cantSimplify ()
+                        end
+                  end
+            end
+         and goto (dst: Label.t, args: VarInfo.t vector)
+            : Statement.t list * Transfer.t =
+            gotoMeaning ([], labelMeaning dst, args)
+         and gotoMeaning arg : Statement.t list * Transfer.t =
+            traceGotoMeaning
+            (fn (canMoveIn, 
+                 m as LabelMeaning.T {aux, blockIndex = i, ...},
+                 args: VarInfo.t vector) =>
+             let
+                val n = Array.sub (inDegree, i)
+                val () = Assert.assert ("Ssa2.Shrink2.gotoMeaning", fn () => n >= 1)
+                fun normal () =
+                   if n = 1
+                      then
+                         let
+                            val () = Array.update (inDegree, i, 0)
+                            val b = Vector.sub (blocks, i)
+                            val () =
+                               Vector.foreach2
+                               (Block.args b, args, fn ((x, _), vi) =>
+                                setVarInfo (x, vi))
+                         in
+                            simplifyBlock (canMoveIn, b)
+                         end
+                   else
+                      let
+                         val () = forceMeaningBlock m
+                      in
+                         (canMoveIn,
+                          Goto {dst = Block.label (Vector.sub (blocks, i)),
+                                args = uses args})
+                      end
+                fun extract p =
+                   case p of
+                      Position.Formal n => Vector.sub (args, n)
+                    | Position.Free x => varInfo x
+                fun rr ({args, canMove}, make) =
+                   (canMoveIn @ canMove, 
+                    make (Vector.map (args, use o extract)))
+                datatype z = datatype LabelMeaning.aux
+             in
+                case aux of
+                   Block => normal ()
+                 | Bug => ((*canMoveIn*)[], Transfer.Bug)
+                 | Case {canMove, cases, default} =>
+                      simplifyCase {canMove = canMoveIn @ canMove, 
+                                    cantSimplify = normal,
+                                    cases = cases,
+                                    default = default,
+                                    gone = fn () => deleteLabelMeaning m,
+                                    test = Vector.sub (args, 0)}
+                 | Goto {canMove, dst, args} =>
+                      if Array.sub (isHeader, i)
+                         orelse Array.sub (isBlock, i)
+                         then normal ()
+                      else
+                         let
+                            val n' = n - 1
+                            val () = Array.update (inDegree, i, n')
+                            val () = 
+                               if n' > 0
+                                  then addLabelMeaning dst
+                               else ()
+                         in
+                            gotoMeaning (canMoveIn @ canMove,
+                                         dst, 
+                                         Vector.map (args, extract))
+                         end
+                 | Raise z => rr (z, Transfer.Raise)
+                 | Return z => rr (z, Transfer.Return)
+             end) arg
+         and evalBind {exp, ty, var} =
+            let
+               val () =
+                  Option.app (var, fn x => 
+                              setVarInfo (x, VarInfo.new (x, SOME ty)))
+               fun delete ss = ss
+               fun doit {makeExp: unit -> Exp.t,
+                         sideEffect: bool,
+                         value: Value.t option} =
+                  let
+                     fun make var = Bind {exp = makeExp (), ty = ty, var = var}
+                  in
+                     case var of
+                        NONE =>
+                           if sideEffect
+                              then (fn ss => make NONE :: ss)
+                           else delete
+                      | SOME x =>
+                           let
+                              val VarInfo.T {isUsed, value = r, ...} = varInfo x
+                              val () = r := value
+                           in
+                              fn ss =>
+                              if !isUsed
+                                 then make (SOME x) :: ss
+                              else if sideEffect
+                                      then make NONE :: ss
+                                   else ss
+                           end
+                  end
+               fun simple {sideEffect} =
+                  let
+                     fun makeExp () = Exp.replaceVar (exp, use o varInfo)
+                  in
+                     doit {makeExp = makeExp,
+                           sideEffect = sideEffect,
+                           value = NONE}
+                  end
+               fun setVar vi =
+                  (Option.app (var, fn x => setVarInfo (x, vi))
+                   ; delete)
+               fun construct (v: Value.t, makeExp) =
+                  doit {makeExp = makeExp,
+                        sideEffect = false,
+                        value = SOME v}
+               fun tuple (xs: VarInfo.t vector) =
+                  case (Exn.withEscape
+                        (fn escape =>
+                         let
+                            fun no () = escape NONE
+                         in
+                            Vector.foldri
+                            (xs, NONE,
+                             fn (i, VarInfo.T {value, ...}, tuple') => 
+                             case !value of
+                                SOME (Value.Select {object, offset}) =>
+                                   (if i = offset
+                                       then
+                                          case tuple' of
+                                             NONE => 
+                                                (case VarInfo.ty object of
+                                                    NONE => no ()
+                                                  | SOME ty =>
+                                                       (case Type.dest ty of
+                                                           Type.Object {args, con = ObjectCon.Tuple} =>
+                                                              if Prod.length args
+                                                                 = Vector.length xs
+                                                                 andalso
+                                                                 not (Prod.isMutable args)
+                                                                 then SOME object
+                                                              else no ()
+                                                         | _ => no ()))
+                                           | SOME tuple'' => 
+                                                if VarInfo.equals (tuple'', object)
+                                                   then tuple'
+                                                else no ()
+                                    else no ())
+                              | _ => no ())
+                         end)) of
+                     NONE =>
+                        construct (Value.Object {args = xs, con = NONE},
+                                   fn () => Object {args = uses xs, con = NONE})
+                   | SOME object => setVar object
+            in
+               case exp of
+                  Const c => construct (Value.Const c, fn () => exp)
+                | Inject {sum, variant} =>
+                     let
+                        val variant = varInfo variant
+                     in
+                        construct (Value.Inject {sum = sum, variant = variant},
+                                   fn () => Inject {sum = sum,
+                                                    variant = use variant})
+                     end
+                | Object {args, con} =>
+                     let
+                        val args = varInfos args
+                        val isMutable =
+                           case Type.dest ty of
+                              Type.Object {args, ...} => Prod.isMutable args
+                            | _ => Error.bug "strange Object type"
+                     in
+                        (* It would be nice to improve this code to do
+                         * reconstruction when isSome con, not just for
+                         * tuples.
+                         *)
+                        if isMutable orelse isSome con then
+                           construct (Value.Object {args = args, con = con},
+                                      fn () => Object {args = uses args,
+                                                       con = con})
+                        else tuple args
+                     end
+                | PrimApp {args, prim} =>
+                     let
+                        val args = varInfos args
+                        fun apply {prim, args} =
+                           doit {makeExp = fn () => PrimApp {args = uses args,
+                                                             prim = prim},
+                                 sideEffect = Prim.maySideEffect prim,
+                                 value = NONE}
+                        datatype z = datatype Prim.ApplyResult.t
+                     in
+                        case primApp (prim, args) of
+                           Apply (p, args) => apply {prim = p,
+                                                     args = Vector.fromList args}
+                         | Bool b =>
+                              let
+                                 val variant = Var.newNoname ()
+                                 val con = Con.fromBool b
+                              in
+                                 evalStatements
+                                 (Vector.new2
+                                  (Bind {exp = Object {args = Vector.new0 (),
+                                                       con = SOME con},
+                                         ty = Type.object {args = Prod.empty (),
+                                                           con = ObjectCon.Con con},
+                                         var = SOME variant},
+                                   Bind {exp = Inject {sum = Tycon.bool,
+                                                       variant = variant},
+                                         ty = Type.bool,
+                                         var = var}))
+                              end
+                         | Const c => construct (Value.Const c,
+                                                 fn () => Exp.Const c)
+                         | Var vi => setVar vi
+                         | _ => apply {args = args, prim = prim}
+                                       
+                     end
+                | Select {base, offset} =>
+                     (case base of
+                         Base.Object object =>
+                            let
+                               val object as VarInfo.T {ty, value, ...} =
+                                  varInfo object
+                               fun dontChange () =
+                                  construct
+                                  (Value.Select {object = object,
+                                                 offset = offset},
+                                   fn () =>
+                                   Select {base = Base.Object (use object),
+                                           offset = offset})
+                            in
+                               case (ty, !value) of
+                                  (SOME ty, SOME (Value.Object {args, ...})) =>
+                                     (case Type.dest ty of
+                                         Type.Object {args = targs, ...} =>
+                                            (* Can't simplify the select if the
+                                             * field is mutable.
+                                             *)
+                                            if (#isMutable
+                                                (Vector.sub
+                                                 (Prod.dest targs, offset)))
+                                               then dontChange ()
+                                            else setVar (Vector.sub
+                                                         (args, offset))
+                                       | _ => Error.bug "Ssa2.Shrink2.evalBind: Select:non object")
+                                | _ => dontChange ()
+                            end
+                       | Base.VectorSub _ => simple {sideEffect = false})
+                | Var x => setVar (varInfo x)
+            end
+         and evalStatement arg : Statement.t list -> Statement.t list =
+            traceEvalStatement
+            (fn s =>
+             let
+                fun simple () =
+                   fn ss => Statement.replaceUses (s, use o varInfo) :: ss
+             in
+                case s of
+                   Bind b => evalBind b
+                 | Profile _ => simple ()
+                 | Update _ => simple ()
+             end) arg
+         val start = labelMeaning start
+         val () = forceMeaningBlock start
+         val f = 
+            Function.new {args = args,
+                          blocks = Vector.fromList (!newBlocks),
+                          mayInline = mayInline,
+                          name = name,
+                          raises = raises,
+                          returns = returns,
+                          start = meaningLabel start}
+(*       val () = save (f, "post") *)
+         val () = Function.clear f
       in
-	 f
+         f
       end
    end
 
-structure Statement =
-   struct
-      open Statement
-
-      fun isProfile (s: t): bool =
-	 case s of
-	    Profile _ => true
-	  | _ => false
-   end
-
 fun eliminateUselessProfile (f: Function.t): Function.t =
    if !Control.profile = Control.ProfileNone
       then f
    else
       let
-	 fun eliminateInBlock (b as Block.T {args, label, statements, transfer})
-	    : Block.t =
-	    if not (Vector.exists (statements, Statement.isProfile))
-	       then b
-	    else
-	       let
-		  datatype z = datatype Exp.t
-		  datatype z = datatype ProfileExp.t
-		  val stack =
-		     Vector.fold
-		     (statements, [], fn (s, stack) =>
-		      case s of
-			 Profile (Leave si) =>
-			    (case stack of
-				Profile (Enter si') :: rest =>
-				   if SourceInfo.equals (si, si')
-				      then rest
-				   else Error.bug "mismatched Leave\n"
-			      | _ => s :: stack)
-		       | _ => s :: stack)
-		  val statements = Vector.fromListRev stack
-	       in
-		  Block.T {args = args,
-			   label = label,
-			   statements = statements,
-			   transfer = transfer}
-	       end
-	 val {args, blocks, mayInline, name, raises, returns, start} =
-	    Function.dest f
-	 val blocks = Vector.map (blocks, eliminateInBlock)
+         fun eliminateInBlock (b as Block.T {args, label, statements, transfer})
+            : Block.t =
+            if not (Vector.exists (statements, Statement.isProfile))
+               then b
+            else
+               let
+                  datatype z = datatype Exp.t
+                  datatype z = datatype ProfileExp.t
+                  val stack =
+                     Vector.fold
+                     (statements, [], fn (s, stack) =>
+                      case s of
+                         Profile (Leave si) =>
+                            (case stack of
+                                Profile (Enter si') :: rest =>
+                                   if SourceInfo.equals (si, si')
+                                      then rest
+                                   else Error.bug "Ssa2.Shrink2.eliminateUselessProfile: mismatched Leave"
+                              | _ => s :: stack)
+                       | _ => s :: stack)
+                  val statements = Vector.fromListRev stack
+               in
+                  Block.T {args = args,
+                           label = label,
+                           statements = statements,
+                           transfer = transfer}
+               end
+         val {args, blocks, mayInline, name, raises, returns, start} =
+            Function.dest f
+         val blocks = Vector.map (blocks, eliminateInBlock)
       in
-	 Function.new {args = args,
-		       blocks = blocks,
-		       mayInline = mayInline,
-		       name = name,
-		       raises = raises,
-		       returns = returns,
-		       start = start}
+         Function.new {args = args,
+                       blocks = blocks,
+                       mayInline = mayInline,
+                       name = name,
+                       raises = raises,
+                       returns = returns,
+                       start = start}
       end
 
 val traceShrinkFunction =
-   Trace.trace ("Shrink2.shrinkFunction", Function.layout, Function.layout)
+   Trace.trace ("Ssa2.Shrink2.shrinkFunction", Function.layout, Function.layout)
 
 val shrinkFunction =
    fn g =>
    let
       val s = shrinkFunction g
    in
-      fn f => (traceShrinkFunction s (eliminateUselessProfile f)
-	       handle e => (Error.bug (concat ["shrinker raised ",
-					       Layout.toString (Exn.layout e)])
-			    ; raise e))
+      fn f => traceShrinkFunction s (eliminateUselessProfile f)
    end
 
 fun shrink (Program.T {datatypes, globals, functions, main}) =
    let
       val s = shrinkFunction {globals = globals}
       val program = 
-	 Program.T {datatypes = datatypes,
-		    globals = globals,
-		    functions = List.revMap (functions, s),
-		    main = main}
+         Program.T {datatypes = datatypes,
+                    globals = globals,
+                    functions = List.revMap (functions, s),
+                    main = main}
       val () = Program.clear program
    in
       program
@@ -1352,29 +1387,29 @@
 fun eliminateDeadBlocksFunction f =
    let
       val {args, blocks, mayInline, name, raises, returns, start} =
-	 Function.dest f
+         Function.dest f
       val {get = isLive, set = setLive, rem} =
-	 Property.getSetOnce (Label.plist, Property.initConst false)
+         Property.getSetOnce (Label.plist, Property.initConst false)
       val () = Function.dfs (f, fn Block.T {label, ...} =>
-			    (setLive (label, true)
-			     ; fn () => ()))
+                            (setLive (label, true)
+                             ; fn () => ()))
       val f =
-	 if Vector.forall (blocks, isLive o Block.label)
-	    then f
-	 else
-	    let 
-	       val blocks =
-		  Vector.keepAll
-		  (blocks, isLive o Block.label)
-	    in
-	       Function.new {args = args,
-			     blocks = blocks,
-			     mayInline = mayInline,
-			     name = name,
-			     raises = raises,
-			     returns = returns,
-			     start = start}
-	    end
+         if Vector.forall (blocks, isLive o Block.label)
+            then f
+         else
+            let 
+               val blocks =
+                  Vector.keepAll
+                  (blocks, isLive o Block.label)
+            in
+               Function.new {args = args,
+                             blocks = blocks,
+                             mayInline = mayInline,
+                             name = name,
+                             raises = raises,
+                             returns = returns,
+                             start = start}
+            end
        val () = Vector.foreach (blocks, rem o Block.label)
    in
      f
@@ -1385,9 +1420,9 @@
       val functions = List.revMap (functions, eliminateDeadBlocksFunction)
    in
       Program.T {datatypes = datatypes,
-		 globals = globals,
-		 functions = functions,
-		 main = main}
+                 globals = globals,
+                 functions = functions,
+                 main = main}
    end
 
 end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ssa/shrink2.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ssa/shrink2.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ssa/shrink2.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,9 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 signature SHRINK2_STRUCTS = 
@@ -16,6 +16,6 @@
       include SHRINK2_STRUCTS
 
       val shrinkFunction:
-	 {globals: Statement.t vector} -> Function.t -> Function.t
+         {globals: Statement.t vector} -> Function.t -> Function.t
       val shrink: Program.t -> Program.t
    end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ssa/simplify-types.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ssa/simplify-types.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ssa/simplify-types.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 (* This pass must happen before polymorphic equality is implemented becuase
  * 1. it will make polymorphic equality faster because some types are simpler
  * 2. it removes uses of polymorphic equality that must return true
@@ -60,10 +61,10 @@
       datatype t = Zero | One | Many
 
       fun layout c =
-	 Layout.str (case c of
-			Zero => "zero"
-		      | One => "one"
-		      | Many => "many")
+         Layout.str (case c of
+                        Zero => "zero"
+                      | One => "one"
+                      | Many => "many")
 
       val equals: t * t -> bool = op =
    end
@@ -71,22 +72,22 @@
 structure ConRep =
    struct
       datatype t =
-	 Useless
+         Useless
        | Transparent
        | Useful
 
       val isUseful =
-	 fn Useful => true
-	  | _ => false
+         fn Useful => true
+          | _ => false
 
       val isUseless =
-	 fn Useless => true
-	  | _ => false
+         fn Useless => true
+          | _ => false
 
       val toString =
-	 fn Useless => "useless"
-	  | Transparent => "transparent"
-	  | Useful => "useful"
+         fn Useless => "useless"
+          | Transparent => "transparent"
+          | Useful => "useful"
 
       val layout = Layout.str o toString
    end
@@ -94,637 +95,639 @@
 structure Result =
    struct
       datatype 'a t =
-	 Bugg
+         Bugg
        | Delete
        | Keep of 'a
 
       fun layout layoutX =
-	 let open Layout
-	 in fn Bugg => str "Bug"
+         let open Layout
+         in fn Bugg => str "Bug"
        | Delete => str "Delete"
        | Keep x => seq [str "Keep ", layoutX x]
-	 end
+         end
    end
 
 fun simplify (Program.T {datatypes, globals, functions, main}) =
    let
       val {get = conInfo: Con.t -> {rep: ConRep.t ref,
-				    args: Type.t vector},
-	   set = setConInfo, ...} =
-	 Property.getSetOnce
-	 (Con.plist, Property.initRaise ("SimplifyTypes.conInfo", Con.layout))
+                                    args: Type.t vector},
+           set = setConInfo, ...} =
+         Property.getSetOnce
+         (Con.plist, Property.initRaise ("SimplifyTypes.conInfo", Con.layout))
       val conInfo =
-	 Trace.trace ("conInfo",
-		      Con.layout,
-		      fn {rep, args} =>
-		      Layout.record [("rep", ConRep.layout (!rep)),
-				     ("args", Vector.layout Type.layout args)])
-	 conInfo
+         Trace.trace ("SimplifyTypes.conInfo",
+                      Con.layout,
+                      fn {rep, args} =>
+                      Layout.record [("rep", ConRep.layout (!rep)),
+                                     ("args", Vector.layout Type.layout args)])
+         conInfo
       val conRep = ! o #rep o conInfo
       val conArgs = #args o conInfo
       fun setConRep (con, r) = #rep (conInfo con) := r
       val conIsUseful = ConRep.isUseful o conRep
       val conIsUseful =
-	 Trace.trace ("conIsUseful", Con.layout, Bool.layout) conIsUseful
+         Trace.trace 
+         ("SimplifyTypes.conIsUseful", Con.layout, Bool.layout) 
+         conIsUseful
       val setConRep =
-	 Trace.trace2 
-	 ("setConRep", Con.layout, ConRep.layout, Unit.layout)
-	 setConRep
+         Trace.trace2 
+         ("SimplifyTypes.setConRep", Con.layout, ConRep.layout, Unit.layout)
+         setConRep
       (* Initialize conInfo *)
       val _ =
-	 Vector.foreach
-	 (datatypes, fn Datatype.T {cons, ...} =>
-	  Vector.foreach (cons, fn {con, args} =>
-			  setConInfo (con, {rep = ref ConRep.Useless,
-					    args = args})))
+         Vector.foreach
+         (datatypes, fn Datatype.T {cons, ...} =>
+          Vector.foreach (cons, fn {con, args} =>
+                          setConInfo (con, {rep = ref ConRep.Useless,
+                                            args = args})))
       val {get = tyconReplacement: Tycon.t -> Type.t option,
-	   set = setTyconReplacement, ...} =
-	 Property.getSet (Tycon.plist, Property.initConst NONE)
+           set = setTyconReplacement, ...} =
+         Property.getSet (Tycon.plist, Property.initConst NONE)
       val setTyconReplacement = fn (c, t) => setTyconReplacement (c, SOME t)
       val {get = tyconInfo: Tycon.t -> {
-					cardinality: Cardinality.t ref,
-					cons: {
-					       con: Con.t,
-					       args: Type.t vector
-					       } vector ref,
-					numCons: int ref,
-					(* tycons whose cardinality depends on mine *)
-					dependents: Tycon.t list ref,
-					isOnWorklist: bool ref
-					},
-	   set = setTyconInfo, ...} =
-	 Property.getSetOnce
-	 (Tycon.plist, Property.initRaise ("SimplifyTypes.tyconInfo", Tycon.layout))
+                                        cardinality: Cardinality.t ref,
+                                        cons: {
+                                               con: Con.t,
+                                               args: Type.t vector
+                                               } vector ref,
+                                        numCons: int ref,
+                                        (* tycons whose cardinality depends on mine *)
+                                        dependents: Tycon.t list ref,
+                                        isOnWorklist: bool ref
+                                        },
+           set = setTyconInfo, ...} =
+         Property.getSetOnce
+         (Tycon.plist, Property.initRaise ("SimplifyTypes.tyconInfo", Tycon.layout))
 
       local
-	 fun make sel = (! o sel o tyconInfo,
-			 fn (t, x) => sel (tyconInfo t) := x)
+         fun make sel = (! o sel o tyconInfo,
+                         fn (t, x) => sel (tyconInfo t) := x)
       in
-	 val (tyconNumCons, setTyconNumCons) = make #numCons
-	 val (tyconCardinality, _) = make #cardinality
+         val (tyconNumCons, setTyconNumCons) = make #numCons
+         val (tyconCardinality, _) = make #cardinality
       end
       val _ =
-	 Vector.foreach
-	 (datatypes, fn Datatype.T {tycon, cons} =>
-	  setTyconInfo (tycon, {
-				cardinality = ref Cardinality.Zero,
-				numCons = ref 0,
-				cons = ref cons,
-				dependents = ref [],
-				isOnWorklist = ref false
-				}))
+         Vector.foreach
+         (datatypes, fn Datatype.T {tycon, cons} =>
+          setTyconInfo (tycon, {
+                                cardinality = ref Cardinality.Zero,
+                                numCons = ref 0,
+                                cons = ref cons,
+                                dependents = ref [],
+                                isOnWorklist = ref false
+                                }))
       (* Tentatively mark all constructors appearing in a ConApp as Useful
        * (some may later be marked as Transparent).
        *)
       val _ =
-	 let
-	    fun handleStatement (Statement.T {exp, ...}) =
-	       case exp of
-		  ConApp {con, ...} => setConRep (con, ConRep.Useful)
-		| _ => ()
-	    (* Booleans are special because they are generated by primitives. *)
-	    val _ =
-	       List.foreach ([Con.truee, Con.falsee], fn c =>
-			     setConRep (c, ConRep.Useful))
-	    val _ = Vector.foreach (globals, handleStatement)
-	    val _ = List.foreach 
-	            (functions, fn f =>
-		     Vector.foreach
-		     (Function.blocks f, fn Block.T {statements, ...} =>
-		      Vector.foreach (statements, handleStatement)))
-	 in ()
-	 end
+         let
+            fun handleStatement (Statement.T {exp, ...}) =
+               case exp of
+                  ConApp {con, ...} => setConRep (con, ConRep.Useful)
+                | _ => ()
+            (* Booleans are special because they are generated by primitives. *)
+            val _ =
+               List.foreach ([Con.truee, Con.falsee], fn c =>
+                             setConRep (c, ConRep.Useful))
+            val _ = Vector.foreach (globals, handleStatement)
+            val _ = List.foreach 
+                    (functions, fn f =>
+                     Vector.foreach
+                     (Function.blocks f, fn Block.T {statements, ...} =>
+                      Vector.foreach (statements, handleStatement)))
+         in ()
+         end
 
       (* Remove useless constructors from datatypes.
        * Remove datatypes which have no cons.
        *)
       val datatypes =
-	 Vector.keepAllMap
-	 (datatypes, fn Datatype.T {tycon, cons} =>
-	  let
-	     val cons = Vector.keepAll (cons, conIsUseful o #con)
-	  in
-	     if 0 = Vector.length cons
-		then (setTyconReplacement (tycon, Type.unit)
-		      ; NONE)
-	     else (#cons (tyconInfo tycon) := cons
-		   ; SOME (Datatype.T {tycon = tycon, cons = cons}))
-	  end)
+         Vector.keepAllMap
+         (datatypes, fn Datatype.T {tycon, cons} =>
+          let
+             val cons = Vector.keepAll (cons, conIsUseful o #con)
+          in
+             if 0 = Vector.length cons
+                then (setTyconReplacement (tycon, Type.unit)
+                      ; NONE)
+             else (#cons (tyconInfo tycon) := cons
+                   ; SOME (Datatype.T {tycon = tycon, cons = cons}))
+          end)
       (* Build the dependents for each tycon. *)
       val _ =
-	 let
-	    val {get = isDatatype, set = setDatatype, destroy} =
-	       Property.destGetSetOnce (Tycon.plist, Property.initConst false)
-	    val _ =
-	       Vector.foreach 
-	       (datatypes, fn Datatype.T {tycon, ...} =>
-		setDatatype (tycon, true))
-	    val _ =
-	       Vector.foreach
-	       (datatypes, fn Datatype.T {tycon, cons} =>
-		let
-		   val {get = isDependent, set = setDependent, destroy} =
-		      Property.destGetSet (Tycon.plist, Property.initConst false)
-		   fun setTypeDependents t =
-		      let val (tycon', ts) = Type.tyconArgs t
-		      in if isDatatype tycon'
-			    then if isDependent tycon'
-				    then ()
-				 else (setDependent (tycon', true)
-				       ; List.push (#dependents
-						    (tyconInfo tycon'),
-						    tycon))
-			 else Vector.foreach (ts, setTypeDependents)
-		      end
-		   val _ =
-		      Vector.foreach (cons, fn {args, ...} =>
-				      Vector.foreach (args, setTypeDependents))
-		   val _ = destroy ()
-		in ()
-		end)
-	    val _ = destroy ()
-	 in ()
-	 end
+         let
+            val {get = isDatatype, set = setDatatype, destroy} =
+               Property.destGetSetOnce (Tycon.plist, Property.initConst false)
+            val _ =
+               Vector.foreach 
+               (datatypes, fn Datatype.T {tycon, ...} =>
+                setDatatype (tycon, true))
+            val _ =
+               Vector.foreach
+               (datatypes, fn Datatype.T {tycon, cons} =>
+                let
+                   val {get = isDependent, set = setDependent, destroy} =
+                      Property.destGetSet (Tycon.plist, Property.initConst false)
+                   fun setTypeDependents t =
+                      let val (tycon', ts) = Type.tyconArgs t
+                      in if isDatatype tycon'
+                            then if isDependent tycon'
+                                    then ()
+                                 else (setDependent (tycon', true)
+                                       ; List.push (#dependents
+                                                    (tyconInfo tycon'),
+                                                    tycon))
+                         else Vector.foreach (ts, setTypeDependents)
+                      end
+                   val _ =
+                      Vector.foreach (cons, fn {args, ...} =>
+                                      Vector.foreach (args, setTypeDependents))
+                   val _ = destroy ()
+                in ()
+                end)
+            val _ = destroy ()
+         in ()
+         end
 
       (* diagnostic *)
       val _ =
-	 Control.diagnostics
-	 (fn display =>
-	  let open Layout
-	  in Vector.foreach
-	     (datatypes, fn Datatype.T {tycon, ...} =>
-	      display (seq [str "dependents of ",
-			    Tycon.layout tycon,
-			    str " = ",
-			    List.layout Tycon.layout 
-			    (!(#dependents (tyconInfo tycon)))]))
-	  end)
+         Control.diagnostics
+         (fn display =>
+          let open Layout
+          in Vector.foreach
+             (datatypes, fn Datatype.T {tycon, ...} =>
+              display (seq [str "dependents of ",
+                            Tycon.layout tycon,
+                            str " = ",
+                            List.layout Tycon.layout 
+                            (!(#dependents (tyconInfo tycon)))]))
+          end)
 
       local open Type Cardinality
       in
-	 fun typeCardinality t =
-	    case dest t of
-	       Ref t => pointerCardinality t
-	     | Weak t => pointerCardinality t
-	     | Tuple ts => tupleCardinality ts
-	     | Datatype tycon => tyconCardinality tycon
-	     | _ => Many
-	 and pointerCardinality (t: Type.t) =
-	    case typeCardinality t of
-	       Zero => Zero
-	     | _ => Many
-	 and tupleCardinality (ts: Type.t vector) =
-	    DynamicWind.withEscape
-	    (fn escape =>
-	     (Vector.foreach (ts, fn t =>
-			     let val c = typeCardinality t
-			     in case c of
-				Many => escape Many
-			      | One => ()
-			      | Zero => escape Zero
-			     end)
-	      ; One))
+         fun typeCardinality t =
+            case dest t of
+               Ref t => pointerCardinality t
+             | Weak t => pointerCardinality t
+             | Tuple ts => tupleCardinality ts
+             | Datatype tycon => tyconCardinality tycon
+             | _ => Many
+         and pointerCardinality (t: Type.t) =
+            case typeCardinality t of
+               Zero => Zero
+             | _ => Many
+         and tupleCardinality (ts: Type.t vector) =
+            Exn.withEscape
+            (fn escape =>
+             (Vector.foreach (ts, fn t =>
+                             let val c = typeCardinality t
+                             in case c of
+                                Many => escape Many
+                              | One => ()
+                              | Zero => escape Zero
+                             end)
+              ; One))
       end
       fun conCardinality {args, con = _} = tupleCardinality args
       (* Compute the tycon cardinalitues with a fixed point,
        * initially assuming every datatype tycon cardinality is Zero.
        *)
       val _ =
-	 let
-	    (* list of datatype tycons whose cardinality has not yet stabilized *)
-	    val worklist =
-	       ref (Vector.fold 
-		    (datatypes, [], fn (Datatype.T {tycon, ...}, ac) =>
-		     tycon :: ac))
-	    fun loop () =
-	       case !worklist of
-		  [] => ()
-		| tycon :: tycons =>
-		     (worklist := tycons
-		      ; let
-			   val {cons, cardinality, dependents, isOnWorklist,
-				...} = tyconInfo tycon
-			   val c =
-			      DynamicWind.withEscape
-			      (fn escape =>
-			       let datatype z = datatype Cardinality.t
-			       in Vector.fold
-				  (!cons, Zero, fn (c, ac) =>
-				   case conCardinality c of
-				      Many => escape Many
-				    | One => (case ac of
-						 Many => Error.bug "Many"
-					       | One => escape Many
-					       | Zero => One)
-				    | Zero => ac)
-			       end)
-			in isOnWorklist := false
-			   ; if Cardinality.equals (c, !cardinality)
-				then ()
-			     else (cardinality := c
-				   ; (List.foreach
-				      (!dependents, fn tycon =>
-				       let
-					  val {isOnWorklist, ...} =
-					     tyconInfo tycon
-				       in if !isOnWorklist
-					     then ()
-					  else (isOnWorklist := true
-						; List.push (worklist, tycon))
-				       end)))
-			end
-		      ; loop ())
-	 in loop ()
-	 end
+         let
+            (* list of datatype tycons whose cardinality has not yet stabilized *)
+            val worklist =
+               ref (Vector.fold 
+                    (datatypes, [], fn (Datatype.T {tycon, ...}, ac) =>
+                     tycon :: ac))
+            fun loop () =
+               case !worklist of
+                  [] => ()
+                | tycon :: tycons =>
+                     (worklist := tycons
+                      ; let
+                           val {cons, cardinality, dependents, isOnWorklist,
+                                ...} = tyconInfo tycon
+                           val c =
+                              Exn.withEscape
+                              (fn escape =>
+                               let datatype z = datatype Cardinality.t
+                               in Vector.fold
+                                  (!cons, Zero, fn (c, ac) =>
+                                   case conCardinality c of
+                                      Many => escape Many
+                                    | One => (case ac of
+                                                 Many => Error.bug "SimplifyTypes.simplify: Many"
+                                               | One => escape Many
+                                               | Zero => One)
+                                    | Zero => ac)
+                               end)
+                        in isOnWorklist := false
+                           ; if Cardinality.equals (c, !cardinality)
+                                then ()
+                             else (cardinality := c
+                                   ; (List.foreach
+                                      (!dependents, fn tycon =>
+                                       let
+                                          val {isOnWorklist, ...} =
+                                             tyconInfo tycon
+                                       in if !isOnWorklist
+                                             then ()
+                                          else (isOnWorklist := true
+                                                ; List.push (worklist, tycon))
+                                       end)))
+                        end
+                      ; loop ())
+         in loop ()
+         end
       (* diagnostic *)
       val _ =
-	 Control.diagnostics
-	 (fn display =>
-	  let open Layout
-	  in Vector.foreach 
-	     (datatypes, fn Datatype.T {tycon, ...} =>
-	      display (seq [str "cardinality of ",
-			    Tycon.layout tycon,
-			    str " = ",
-			    Cardinality.layout (tyconCardinality tycon)]))
-	  end)
+         Control.diagnostics
+         (fn display =>
+          let open Layout
+          in Vector.foreach 
+             (datatypes, fn Datatype.T {tycon, ...} =>
+              display (seq [str "cardinality of ",
+                            Tycon.layout tycon,
+                            str " = ",
+                            Cardinality.layout (tyconCardinality tycon)]))
+          end)
       fun transparent (tycon, con, args) =
-	 (setTyconReplacement (tycon, Type.tuple args)
-	  ; setConRep (con, ConRep.Transparent)
-	  ; setTyconNumCons (tycon, 1))
+         (setTyconReplacement (tycon, Type.tuple args)
+          ; setConRep (con, ConRep.Transparent)
+          ; setTyconNumCons (tycon, 1))
       (* "unary" is datatypes with one constructor whose rhs contains an
        * array (or vector) type.
        * For datatypes with one variant not containing an array type, eliminate
        * the datatype. 
        *)
       val (datatypes, unary) =
-	 Vector.fold
-	 (datatypes, ([], []), fn (Datatype.T {tycon, cons}, (datatypes, unary)) =>
-	  let
-	     (* remove all cons with zero cardinality and mark them as useless *)
-	     val cons =
-		Vector.keepAllMap
-		(cons, fn c as {con, ...} =>
-		 case conCardinality c of
-		    Cardinality.Zero => (setConRep (con, ConRep.Useless)
-					 ; NONE)
-		  | _ => SOME c)
-	  in case Vector.length cons of
-	     0 => (setTyconNumCons (tycon, 0)
-		    ; setTyconReplacement (tycon, Type.unit)
-		    ; (datatypes, unary))
-	   | 1 =>
-		let
-		   val {con, args} = Vector.sub (cons, 0)
-		in
-		   if Vector.exists (args, fn t =>
-				     Type.containsTycon (t, Tycon.array)
-				     orelse Type.containsTycon (t, Tycon.vector))
-		      then (datatypes,
-			    {tycon = tycon, con = con, args = args}
-			    :: unary)
-		   else (transparent (tycon, con, args)
-			 ; (datatypes, unary))
-		end
-	   | _ => (Datatype.T {tycon = tycon, cons = cons} :: datatypes,
-		   unary)
-	  end)
+         Vector.fold
+         (datatypes, ([], []), fn (Datatype.T {tycon, cons}, (datatypes, unary)) =>
+          let
+             (* remove all cons with zero cardinality and mark them as useless *)
+             val cons =
+                Vector.keepAllMap
+                (cons, fn c as {con, ...} =>
+                 case conCardinality c of
+                    Cardinality.Zero => (setConRep (con, ConRep.Useless)
+                                         ; NONE)
+                  | _ => SOME c)
+          in case Vector.length cons of
+             0 => (setTyconNumCons (tycon, 0)
+                    ; setTyconReplacement (tycon, Type.unit)
+                    ; (datatypes, unary))
+           | 1 =>
+                let
+                   val {con, args} = Vector.sub (cons, 0)
+                in
+                   if Vector.exists (args, fn t =>
+                                     Type.containsTycon (t, Tycon.array)
+                                     orelse Type.containsTycon (t, Tycon.vector))
+                      then (datatypes,
+                            {tycon = tycon, con = con, args = args}
+                            :: unary)
+                   else (transparent (tycon, con, args)
+                         ; (datatypes, unary))
+                end
+           | _ => (Datatype.T {tycon = tycon, cons = cons} :: datatypes,
+                   unary)
+          end)
       fun containsTycon (ty: Type.t, tyc: Tycon.t): bool =
-	 let open Type
-	    fun loop t =
-	       case dest t of
-		  Tuple ts => Vector.exists (ts, loop)
-		| Array t => loop t
-		| Vector t => loop t
-		| Ref t => loop t
-		| Weak t => loop t
-		| Datatype tyc' =>
-		     (case tyconReplacement tyc' of
-			 NONE => Tycon.equals (tyc, tyc')
-		       | SOME t => loop t)
-		| _ => false
-	 in loop ty
-	 end
+         let open Type
+            fun loop t =
+               case dest t of
+                  Tuple ts => Vector.exists (ts, loop)
+                | Array t => loop t
+                | Vector t => loop t
+                | Ref t => loop t
+                | Weak t => loop t
+                | Datatype tyc' =>
+                     (case tyconReplacement tyc' of
+                         NONE => Tycon.equals (tyc, tyc')
+                       | SOME t => loop t)
+                | _ => false
+         in loop ty
+         end
       (* Keep the circular transparent cons, ditch the rest. *)
       val datatypes =
-	 List.fold
-	 (unary, datatypes, fn ({tycon, con, args}, accum) =>
-	  if Vector.exists (args, fn arg => containsTycon (arg, tycon))
-	     then Datatype.T {tycon = tycon,
-			      cons = Vector.new1 {con = con, args = args}} 
-	          :: accum
-	  else (transparent (tycon, con, args)
-		; accum))
+         List.fold
+         (unary, datatypes, fn ({tycon, con, args}, accum) =>
+          if Vector.exists (args, fn arg => containsTycon (arg, tycon))
+             then Datatype.T {tycon = tycon,
+                              cons = Vector.new1 {con = con, args = args}} 
+                  :: accum
+          else (transparent (tycon, con, args)
+                ; accum))
       fun makeKeepSimplifyTypes simplifyType ts =
-	 Vector.keepAllMap (ts, fn t =>
-			    let
-			       val t = simplifyType t
-			    in
-			       if Type.isUnit t
-				  then NONE
-			       else SOME t
-			    end)
+         Vector.keepAllMap (ts, fn t =>
+                            let
+                               val t = simplifyType t
+                            in
+                               if Type.isUnit t
+                                  then NONE
+                               else SOME t
+                            end)
       val {get = simplifyType, destroy = destroySimplifyType} =
-	 Property.destGet
-	 (Type.plist,
-	  Property.initRec
-	  (fn (t, simplifyType) =>
-	   let
-	      val keepSimplifyTypes = makeKeepSimplifyTypes simplifyType
-	      open Type
-	   in case dest t of
-	      Tuple ts => Type.tuple (keepSimplifyTypes ts)
-	    | Array t => array (simplifyType t)
-	    | Vector t => vector (simplifyType t)
-	    | Ref t => reff (simplifyType t)
-	    | Weak t => weak (simplifyType t)
-	    | Datatype tycon => 
-		 (case tyconReplacement tycon of
-		     SOME t =>
-			let
-			   val t = simplifyType t
-			   val _ = setTyconReplacement (tycon, t)
-			in
-			   t
-			end
-		   | NONE => t)
-	    | _ => t
-	   end))
+         Property.destGet
+         (Type.plist,
+          Property.initRec
+          (fn (t, simplifyType) =>
+           let
+              val keepSimplifyTypes = makeKeepSimplifyTypes simplifyType
+              open Type
+           in case dest t of
+              Tuple ts => Type.tuple (keepSimplifyTypes ts)
+            | Array t => array (simplifyType t)
+            | Vector t => vector (simplifyType t)
+            | Ref t => reff (simplifyType t)
+            | Weak t => weak (simplifyType t)
+            | Datatype tycon => 
+                 (case tyconReplacement tycon of
+                     SOME t =>
+                        let
+                           val t = simplifyType t
+                           val _ = setTyconReplacement (tycon, t)
+                        in
+                           t
+                        end
+                   | NONE => t)
+            | _ => t
+           end))
       val simplifyType =
- 	 Trace.trace ("simplifyType", Type.layout, Type.layout)
- 	 simplifyType
+         Trace.trace ("SimplifyTypes.simplifyType", Type.layout, Type.layout)
+         simplifyType
       fun simplifyTypes ts = Vector.map (ts, simplifyType)
       val keepSimplifyTypes = makeKeepSimplifyTypes simplifyType
       (* Simplify constructor argument types. *)
       val datatypes =
-	 Vector.fromListMap
-	 (datatypes, fn Datatype.T {tycon, cons} =>
-	  (setTyconNumCons (tycon, Vector.length cons)
-	   ; Datatype.T {tycon = tycon,
-			 cons = Vector.map (cons, fn {con, args} =>
-					    {con = con,
-					     args = keepSimplifyTypes args})}))
+         Vector.fromListMap
+         (datatypes, fn Datatype.T {tycon, cons} =>
+          (setTyconNumCons (tycon, Vector.length cons)
+           ; Datatype.T {tycon = tycon,
+                         cons = Vector.map (cons, fn {con, args} =>
+                                            {con = con,
+                                             args = keepSimplifyTypes args})}))
       val unitVar = Var.newNoname ()
       val {get = varInfo: Var.t -> Type.t, set = setVarInfo, ...} =
-	 Property.getSetOnce  
-	 (Var.plist, Property.initRaise ("varInfo", Var.layout))
+         Property.getSetOnce  
+         (Var.plist, Property.initRaise ("varInfo", Var.layout))
       fun simplifyVarType (x: Var.t, t: Type.t): Type.t =
-	 (setVarInfo (x, t)
-	  ; simplifyType t)
+         (setVarInfo (x, t)
+          ; simplifyType t)
       fun simplifyMaybeVarType (x: Var.t option, t: Type.t): Type.t =
-	 case x of
-	    SOME x => simplifyVarType (x, t)
-	  | NONE => simplifyType t
+         case x of
+            SOME x => simplifyVarType (x, t)
+          | NONE => simplifyType t
       val oldVarType = varInfo
       val newVarType = simplifyType o oldVarType
       fun simplifyVar (x: Var.t): Var.t =
-	 if Type.isUnit (newVarType x)
-	    then unitVar
-	 else x
+         if Type.isUnit (newVarType x)
+            then unitVar
+         else x
       val varIsUseless = Type.isUnit o newVarType
       fun removeUselessVars xs = Vector.keepAll (xs, not o varIsUseless)
       fun tuple xs =
-	 let
-	    val xs = removeUselessVars xs
-	 in if 1 = Vector.length xs
-	       then Var (Vector.sub (xs, 0))
-	    else Tuple xs
-	 end
+         let
+            val xs = removeUselessVars xs
+         in if 1 = Vector.length xs
+               then Var (Vector.sub (xs, 0))
+            else Tuple xs
+         end
       fun simplifyFormals xts =
-	 Vector.keepAllMap
-	 (xts, fn (x, t) =>
-	  let val t = simplifyVarType (x, t)
-	  in if Type.isUnit t
-		then NONE
-	     else SOME (x, t)
-	  end)
+         Vector.keepAllMap
+         (xts, fn (x, t) =>
+          let val t = simplifyVarType (x, t)
+          in if Type.isUnit t
+                then NONE
+             else SOME (x, t)
+          end)
       val typeIsUseful = not o Type.isUnit o simplifyType
       datatype result = datatype Result.t
       fun simplifyExp (e: Exp.t): Exp.t result =
-	 case e of
-	    ConApp {con, args} =>
-	       (case conRep con of
-		   ConRep.Transparent => Keep (tuple args)
-		 | ConRep.Useful =>
-		      Keep (ConApp {con = con,
-				    args = removeUselessVars args})
-		 | ConRep.Useless => Bugg)
-	  | PrimApp {prim, targs, args} =>
-	       Keep
-	       (let 
-		   fun normal () =
-		      PrimApp {prim = prim,
-			       targs = simplifyTypes targs,
-			       args = Vector.map (args, simplifyVar)}
-		   fun equal () =
-		      if 2 = Vector.length args
-			 then
-			    if varIsUseless (Vector.sub (args, 0))
-			       then ConApp {con = Con.truee,
-					    args = Vector.new0 ()}
-			    else normal ()
-		      else Error.bug "strange eq/equal PrimApp"
-		   open Prim.Name
-		in case Prim.name prim of
-		   MLton_eq => equal ()
-		 | MLton_equal => equal ()
-		 | _ => normal ()
-		end)
-	  | Select {tuple, offset} =>
-	       let
-		  val ts = Type.deTuple (oldVarType tuple)
-	       in Vector.fold'
-		  (ts, 0, (offset, 0), fn (pos, t, (n, offset)) =>
-		   if n = 0
-		      then (Vector.Done
-			    (Keep
-			     (if offset = 0
-				 andalso not (Vector.existsR
-					      (ts, pos + 1, Vector.length ts,
-					       typeIsUseful))
-				 then Var tuple
-			      else Select {tuple = tuple,
-					   offset = offset})))
-		   else Vector.Continue (n - 1,
-					 if typeIsUseful t
-					    then offset + 1
-					 else offset),
-		      fn _ => Error.bug "newOffset")
-	       end
-	  | Tuple xs => Keep (tuple xs)
-	  | _ => Keep e
+         case e of
+            ConApp {con, args} =>
+               (case conRep con of
+                   ConRep.Transparent => Keep (tuple args)
+                 | ConRep.Useful =>
+                      Keep (ConApp {con = con,
+                                    args = removeUselessVars args})
+                 | ConRep.Useless => Bugg)
+          | PrimApp {prim, targs, args} =>
+               Keep
+               (let 
+                   fun normal () =
+                      PrimApp {prim = prim,
+                               targs = simplifyTypes targs,
+                               args = Vector.map (args, simplifyVar)}
+                   fun equal () =
+                      if 2 = Vector.length args
+                         then
+                            if varIsUseless (Vector.sub (args, 0))
+                               then ConApp {con = Con.truee,
+                                            args = Vector.new0 ()}
+                            else normal ()
+                      else Error.bug "SimplifyTypes.simplifyExp: strange eq/equal PrimApp"
+                   open Prim.Name
+                in case Prim.name prim of
+                   MLton_eq => equal ()
+                 | MLton_equal => equal ()
+                 | _ => normal ()
+                end)
+          | Select {tuple, offset} =>
+               let
+                  val ts = Type.deTuple (oldVarType tuple)
+               in Vector.fold'
+                  (ts, 0, (offset, 0), fn (pos, t, (n, offset)) =>
+                   if n = 0
+                      then (Vector.Done
+                            (Keep
+                             (if offset = 0
+                                 andalso not (Vector.existsR
+                                              (ts, pos + 1, Vector.length ts,
+                                               typeIsUseful))
+                                 then Var tuple
+                              else Select {tuple = tuple,
+                                           offset = offset})))
+                   else Vector.Continue (n - 1,
+                                         if typeIsUseful t
+                                            then offset + 1
+                                         else offset),
+                      fn _ => Error.bug "SimplifyTypes.simplifyExp: Select:newOffset")
+               end
+          | Tuple xs => Keep (tuple xs)
+          | _ => Keep e
       val simplifyExp =
-	 Trace.trace ("SimplifyTypes.simplifyExp",
-		      Exp.layout, Result.layout Exp.layout)
-	 simplifyExp
+         Trace.trace ("SimplifyTypes.simplifyExp",
+                      Exp.layout, Result.layout Exp.layout)
+         simplifyExp
       fun simplifyTransfer (t : Transfer.t): Statement.t vector * Transfer.t =
-	 case t of
-	    Arith {prim, args, overflow, success, ty} =>
-	       (Vector.new0 (), Arith {prim = prim,
-				       args = Vector.map (args, simplifyVar),
-				       overflow = overflow,
-				       success = success,
-				       ty = ty})
-	  | Bug => (Vector.new0 (), t)
-	  | Call {func, args, return} =>
-	       (Vector.new0 (),
-		Call {func = func, return = return,
-		      args = removeUselessVars args})
-	  | Case {test, cases = Cases.Con cases, default} =>
-	       let
-		  val cases =
-		     Vector.keepAll (cases, fn (con, _) =>
-				     not (ConRep.isUseless (conRep con)))
-		  val default =
-		     case (Vector.length cases, default) of
-			(_,     NONE)    => NONE
-		      | (0,     SOME l)  => SOME l
-		      | (n,     SOME l)  =>
-			   if n = tyconNumCons (Type.tycon (oldVarType test))
-			      then NONE
-			   else SOME l
-		  fun normal () =
-		     (Vector.new0 (),
-		      Case {test = test,
-			    cases = Cases.Con cases,
-			    default = default})
-	       in case (Vector.length cases, default) of
-		  (0,         NONE)   => (Vector.new0 (), Bug)
-		| (0,         SOME l) =>
-		     (Vector.new0 (), Goto {dst = l, args = Vector.new0 ()})
-		| (1, NONE)   =>
-		     let
-			val (con, l) = Vector.sub (cases, 0)
-		     in
-			if ConRep.isUseful (conRep con)
-			   then
-			      (* This case can occur because an array or vector
-			       * tycon was kept around.
-			       *)
-			      normal () 
-			else (* The type has become a tuple.  Do the selects. *)
-			   let
-			      val ts = keepSimplifyTypes (conArgs con)
-			      val (args, stmts) =
-				 if 1 = Vector.length ts
-				    then (Vector.new1 test, Vector.new0 ())
-				 else
-				    Vector.unzip
-				    (Vector.mapi
-				     (ts, fn (i, ty) =>
-				      let val x = Var.newNoname ()
-				      in (x,
-					  Statement.T 
-					  {var = SOME x, 
-					   ty = ty,
-					   exp = Select {tuple = test,
-							 offset = i}})
-				      end))
-			   in (stmts, Goto {dst = l, args = args})
-			   end
-		     end
-		| _ => normal ()
-	       end
-	  | Case _ => (Vector.new0 (), t)
-	  | Goto {dst, args} =>
-	       (Vector.new0 (), Goto {dst = dst, args = removeUselessVars args})
-	  | Raise xs => (Vector.new0 (), Raise (removeUselessVars xs))
-	  | Return xs => (Vector.new0 (), Return (removeUselessVars xs))
-	  | Runtime {prim, args, return} =>
-	       (Vector.new0 (), Runtime {prim = prim,
-					 args = Vector.map (args, simplifyVar),
-					 return = return})
+         case t of
+            Arith {prim, args, overflow, success, ty} =>
+               (Vector.new0 (), Arith {prim = prim,
+                                       args = Vector.map (args, simplifyVar),
+                                       overflow = overflow,
+                                       success = success,
+                                       ty = ty})
+          | Bug => (Vector.new0 (), t)
+          | Call {func, args, return} =>
+               (Vector.new0 (),
+                Call {func = func, return = return,
+                      args = removeUselessVars args})
+          | Case {test, cases = Cases.Con cases, default} =>
+               let
+                  val cases =
+                     Vector.keepAll (cases, fn (con, _) =>
+                                     not (ConRep.isUseless (conRep con)))
+                  val default =
+                     case (Vector.length cases, default) of
+                        (_,     NONE)    => NONE
+                      | (0,     SOME l)  => SOME l
+                      | (n,     SOME l)  =>
+                           if n = tyconNumCons (Type.tycon (oldVarType test))
+                              then NONE
+                           else SOME l
+                  fun normal () =
+                     (Vector.new0 (),
+                      Case {test = test,
+                            cases = Cases.Con cases,
+                            default = default})
+               in case (Vector.length cases, default) of
+                  (0,         NONE)   => (Vector.new0 (), Bug)
+                | (0,         SOME l) =>
+                     (Vector.new0 (), Goto {dst = l, args = Vector.new0 ()})
+                | (1, NONE)   =>
+                     let
+                        val (con, l) = Vector.sub (cases, 0)
+                     in
+                        if ConRep.isUseful (conRep con)
+                           then
+                              (* This case can occur because an array or vector
+                               * tycon was kept around.
+                               *)
+                              normal () 
+                        else (* The type has become a tuple.  Do the selects. *)
+                           let
+                              val ts = keepSimplifyTypes (conArgs con)
+                              val (args, stmts) =
+                                 if 1 = Vector.length ts
+                                    then (Vector.new1 test, Vector.new0 ())
+                                 else
+                                    Vector.unzip
+                                    (Vector.mapi
+                                     (ts, fn (i, ty) =>
+                                      let val x = Var.newNoname ()
+                                      in (x,
+                                          Statement.T 
+                                          {var = SOME x, 
+                                           ty = ty,
+                                           exp = Select {tuple = test,
+                                                         offset = i}})
+                                      end))
+                           in (stmts, Goto {dst = l, args = args})
+                           end
+                     end
+                | _ => normal ()
+               end
+          | Case _ => (Vector.new0 (), t)
+          | Goto {dst, args} =>
+               (Vector.new0 (), Goto {dst = dst, args = removeUselessVars args})
+          | Raise xs => (Vector.new0 (), Raise (removeUselessVars xs))
+          | Return xs => (Vector.new0 (), Return (removeUselessVars xs))
+          | Runtime {prim, args, return} =>
+               (Vector.new0 (), Runtime {prim = prim,
+                                         args = Vector.map (args, simplifyVar),
+                                         return = return})
       val simplifyTransfer =
-	 Trace.trace
-	 ("SimplifyTypes.simplifyTransfer", Transfer.layout,
-	  Layout.tuple2 (Vector.layout Statement.layout, Transfer.layout))
-	 simplifyTransfer
+         Trace.trace
+         ("SimplifyTypes.simplifyTransfer", Transfer.layout,
+          Layout.tuple2 (Vector.layout Statement.layout, Transfer.layout))
+         simplifyTransfer
       fun simplifyStatement (Statement.T {var, ty, exp}) =
-	 let
-	    val ty = simplifyMaybeVarType (var, ty)	 
-	 in
-	    (* It is wrong to omit calling simplifyExp when var = NONE because
-	     * targs in a PrimApp may still need to be simplified.
-	     *)
-	    if not (Type.isUnit ty)
-	       orelse Exp.maySideEffect exp
-	       orelse (case exp of
-			  Profile _ => true
-			| _ => false)
-	       then
-		  (case simplifyExp exp of
-		      Bugg => Bugg
-		    | Delete => Delete
-		    | Keep exp =>
-			 Keep (Statement.T {var = var, ty = ty, exp = exp}))
-	    else Delete
-	 end
+         let
+            val ty = simplifyMaybeVarType (var, ty)      
+         in
+            (* It is wrong to omit calling simplifyExp when var = NONE because
+             * targs in a PrimApp may still need to be simplified.
+             *)
+            if not (Type.isUnit ty)
+               orelse Exp.maySideEffect exp
+               orelse (case exp of
+                          Profile _ => true
+                        | _ => false)
+               then
+                  (case simplifyExp exp of
+                      Bugg => Bugg
+                    | Delete => Delete
+                    | Keep exp =>
+                         Keep (Statement.T {var = var, ty = ty, exp = exp}))
+            else Delete
+         end
       fun simplifyBlock (Block.T {label, args, statements, transfer}) =
-	 let
-	    val args = simplifyFormals args
-	    val statements =
-	       Vector.fold'
-	       (statements, 0, [], fn (_, statement, statements) =>
-		case simplifyStatement statement of
-		   Bugg => Vector.Done NONE
-		 | Delete => Vector.Continue statements
-		 | Keep s => Vector.Continue (s :: statements),
-		SOME o Vector.fromListRev)
-	 in
-	    case statements of
-	       NONE => Block.T {label = label,
-				args = args,
-				statements = Vector.new0 (),
-				transfer = Bug}
-	     | SOME statements =>
-		  let
-		     val (stmts, transfer) = simplifyTransfer transfer
-		     val statements = Vector.concat [statements, stmts]
-		  in
-		     Block.T {label = label,
-			      args = args,
-			      statements = statements,
-			      transfer = transfer}
-		  end
-	 end
+         let
+            val args = simplifyFormals args
+            val statements =
+               Vector.fold'
+               (statements, 0, [], fn (_, statement, statements) =>
+                case simplifyStatement statement of
+                   Bugg => Vector.Done NONE
+                 | Delete => Vector.Continue statements
+                 | Keep s => Vector.Continue (s :: statements),
+                SOME o Vector.fromListRev)
+         in
+            case statements of
+               NONE => Block.T {label = label,
+                                args = args,
+                                statements = Vector.new0 (),
+                                transfer = Bug}
+             | SOME statements =>
+                  let
+                     val (stmts, transfer) = simplifyTransfer transfer
+                     val statements = Vector.concat [statements, stmts]
+                  in
+                     Block.T {label = label,
+                              args = args,
+                              statements = statements,
+                              transfer = transfer}
+                  end
+         end
       fun simplifyFunction f =
-	 let
-	    val {args, mayInline, name, raises, returns, start, ...} =
-	       Function.dest f
-	     val args = simplifyFormals args
-	     val blocks = ref []
-	     val _ =
-		Function.dfs (f, fn block =>
-			      (List.push (blocks, simplifyBlock block)
-			       ; fn () => ()))
-	     val returns = Option.map (returns, keepSimplifyTypes)
-	     val raises = Option.map (raises, keepSimplifyTypes)
-	 in
-	    Function.new {args = args,
-			  blocks = Vector.fromList (!blocks),
-			  mayInline = mayInline,
-			  name = name,
-			  raises = raises,
-			  returns = returns,
-			  start = start}
-	 end
+         let
+            val {args, mayInline, name, raises, returns, start, ...} =
+               Function.dest f
+             val args = simplifyFormals args
+             val blocks = ref []
+             val _ =
+                Function.dfs (f, fn block =>
+                              (List.push (blocks, simplifyBlock block)
+                               ; fn () => ()))
+             val returns = Option.map (returns, keepSimplifyTypes)
+             val raises = Option.map (raises, keepSimplifyTypes)
+         in
+            Function.new {args = args,
+                          blocks = Vector.fromList (!blocks),
+                          mayInline = mayInline,
+                          name = name,
+                          raises = raises,
+                          returns = returns,
+                          start = start}
+         end
       val globals =
-	 Vector.concat
-	 [Vector.new1 (Statement.T {var = SOME unitVar,
-				    ty = Type.unit,
-				    exp = Exp.unit}),
-	  Vector.keepAllMap (globals, fn s =>
-			     case simplifyStatement s of
-			        Bugg => Error.bug "global bind can't fail"
-			      | Delete => NONE
-			      | Keep b => SOME b)]
+         Vector.concat
+         [Vector.new1 (Statement.T {var = SOME unitVar,
+                                    ty = Type.unit,
+                                    exp = Exp.unit}),
+          Vector.keepAllMap (globals, fn s =>
+                             case simplifyStatement s of
+                                Bugg => Error.bug "SimplifyTypes.globals: bind can't fail"
+                              | Delete => NONE
+                              | Keep b => SOME b)]
       val shrink = shrinkFunction {globals = globals}
       val functions = List.revMap (functions, shrink o simplifyFunction)
       val program =
-	 Program.T {datatypes = datatypes,
-		    globals = globals,
-		    functions = functions,
-		    main = main}
+         Program.T {datatypes = datatypes,
+                    globals = globals,
+                    functions = functions,
+                    main = main}
       val _ = destroySimplifyType ()
       val _ = Program.clearTop program
    in

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ssa/simplify-types.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ssa/simplify-types.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ssa/simplify-types.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature SIMPLIFY_TYPES_STRUCTS = 
    sig
       include SHRINK

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ssa/simplify.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ssa/simplify.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ssa/simplify.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 functor Simplify (S: SIMPLIFY_STRUCTS): SIMPLIFY = 
 struct
 
@@ -47,170 +48,188 @@
     fn () => Inline.inline p)
 
 type pass = {name: string,
-	     doit: Program.t -> Program.t}
+             doit: Program.t -> Program.t}
 
-val ssaPasses : pass list ref = ref
-   [
-    {name = "removeUnused1", doit = RemoveUnused.remove},
-    {name = "leafInline", doit = inlineLeaf 20},
-    (* contify should be run before constant propagation because of the once
-     * pass that only looks at main -- hence want as much in main as possible.
-     *)
-    {name = "contify1", doit = Contify.contify},
-    {name = "localFlatten1", doit = LocalFlatten.flatten},
-    (* constantPropagation cannot be omitted. It implements Array_array0. *)
-    {name = "constantPropagation", doit = ConstantPropagation.simplify},
-    (* useless should run after constantPropagation because constantPropagation
-     * makes slots of tuples that are constant useless.
-     *)
-    {name = "useless", doit = Useless.useless},
-    {name = "removeUnused2", doit = RemoveUnused.remove},
-    {name = "simplifyTypes", doit = SimplifyTypes.simplify},
-    (* polyEqual cannot be omitted.  It implements MLton_equal.
-     * polyEqual should run
-     *   - after types are simplified so that many equals are turned into eqs
-     *   - before inlining so that equality functions can be inlined
-     *)
-    {name = "polyEqual", doit = PolyEqual.polyEqual},
-    {name = "contify2", doit = Contify.contify},
-    {name = "inline", doit = Inline.inline},
-    {name = "localFlatten2", doit = LocalFlatten.flatten},
-    {name = "removeUnused3", doit = RemoveUnused.remove},
-    {name = "contify3", doit = Contify.contify},
-    {name = "introduceLoops", doit = IntroduceLoops.introduceLoops},
-    {name = "loopInvariant", doit = LoopInvariant.loopInvariant},
-    {name = "localRef", doit = LocalRef.eliminate},
-    {name = "flatten", doit = Flatten.flatten},
-    {name = "localFlatten3", doit = LocalFlatten.flatten},
-    {name = "commonArg", doit = CommonArg.eliminate},
-    {name = "commonSubexp", doit = CommonSubexp.eliminate},
-    {name = "commonBlock", doit = CommonBlock.eliminate},
-    {name = "redundantTests", doit = RedundantTests.simplify},
-    {name = "redundant", doit = Redundant.redundant},
-    {name = "knownCase", doit = KnownCase.simplify}, 
-    {name = "removeUnused4", doit = RemoveUnused.remove}
-    ]
+val ssaPassesDefault =
+   {name = "removeUnused1", doit = RemoveUnused.remove} ::
+   {name = "leafInline", doit = inlineLeaf 20} ::
+   {name = "contify1", doit = Contify.contify} ::
+   {name = "localFlatten1", doit = LocalFlatten.flatten} ::
+   {name = "constantPropagation", doit = ConstantPropagation.simplify} ::
+   (* useless should run 
+    *   - after constant propagation because constant propagation makes
+    *     slots of tuples that are constant useless
+    *)
+   {name = "useless", doit = Useless.useless} ::
+   {name = "removeUnused2", doit = RemoveUnused.remove} ::
+   {name = "simplifyTypes", doit = SimplifyTypes.simplify} ::
+   (* polyEqual should run
+    *   - after types are simplified so that many equals are turned into eqs
+    *   - before inlining so that equality functions can be inlined
+    *)
+   {name = "polyEqual", doit = PolyEqual.polyEqual} ::
+   {name = "contify2", doit = Contify.contify} ::
+   {name = "inline", doit = Inline.inline} ::
+   {name = "localFlatten2", doit = LocalFlatten.flatten} ::
+   {name = "removeUnused3", doit = RemoveUnused.remove} ::
+   {name = "contify3", doit = Contify.contify} ::
+   {name = "introduceLoops", doit = IntroduceLoops.introduceLoops} ::
+   {name = "loopInvariant", doit = LoopInvariant.loopInvariant} ::
+   {name = "localRef", doit = LocalRef.eliminate} ::
+   {name = "flatten", doit = Flatten.flatten} ::
+   {name = "localFlatten3", doit = LocalFlatten.flatten} ::
+   {name = "commonArg", doit = CommonArg.eliminate} ::
+   {name = "commonSubexp", doit = CommonSubexp.eliminate} ::
+   {name = "commonBlock", doit = CommonBlock.eliminate} ::
+   {name = "redundantTests", doit = RedundantTests.simplify} ::
+   {name = "redundant", doit = Redundant.redundant} ::
+   {name = "knownCase", doit = KnownCase.simplify} ::
+   {name = "removeUnused4", doit = RemoveUnused.remove} ::
+   nil
 
+val ssaPassesMinimal =
+   (* constantPropagation cannot be omitted. It implements Array_array0. *)
+   {name = "constantPropagation", doit = ConstantPropagation.simplify} ::
+   (* polyEqual cannot be omitted.  It implements MLton_equal. *)
+   {name = "polyEqual", doit = PolyEqual.polyEqual} ::
+   nil
+
+val ssaPasses : pass list ref = ref ssaPassesDefault
+
 local
    type passGen = string -> pass option
 
    fun mkSimplePassGen (name, doit): passGen =
       let val count = Counter.new 1
       in fn s => if s = name
-		    then SOME {name = concat [name, "#",
-					      Int.toString (Counter.next count)],
-			       doit = doit}
-		    else NONE
+                    then SOME {name = concat [name, "#",
+                                              Int.toString (Counter.next count)],
+                               doit = doit}
+                    else NONE
       end
    
    val inlinePassGen =
       let
-	 val count = Counter.new 1
-	 fun nums s =
-	    if s = ""
-	       then SOME []
-	    else if String.sub (s, 0) = #"(" 
-		  andalso String.sub (s, String.size s - 1)= #")"
-	       then let
-		       val s = String.dropFirst (String.dropLast s)
-		    in
-		       case List.fold (String.split (s, #","), SOME [],
-				       fn (s,SOME nums) => (case Int.fromString s of
-							       SOME i => SOME (i::nums)
-							     | NONE => NONE)
-					| (_, NONE) => NONE) of
-			  SOME (l as _::_) => SOME (List.rev l)
-			| _ => NONE
-		    end
-	    else NONE
+         val count = Counter.new 1
+         fun nums s =
+            if s = ""
+               then SOME []
+            else if String.sub (s, 0) = #"(" 
+                  andalso String.sub (s, String.size s - 1)= #")"
+               then let
+                       val s = String.dropFirst (String.dropLast s)
+                    in
+                       case List.fold (String.split (s, #","), SOME [],
+                                       fn (s,SOME nums) => (case Int.fromString s of
+                                                               SOME i => SOME (i::nums)
+                                                             | NONE => NONE)
+                                        | (_, NONE) => NONE) of
+                          SOME (l as _::_) => SOME (List.rev l)
+                        | _ => NONE
+                    end
+            else NONE
       in
-	 fn s =>
-	 if String.hasPrefix (s, {prefix = "inlineNonRecursive"})
-	    then let
-		    fun mk (product, small) =
-		       SOME {name = concat ["inlineNonRecursive(", 
-					    Int.toString product, ",",
-					    Int.toString small, ")#",
-					    Int.toString (Counter.next count)],
-			     doit = inlineNonRecursive (product, small)}
-		    val s = String.dropPrefix (s, String.size "inlineNonRecursive")
-		 in
-		    case nums s of
-		       SOME [] => mk (320, 60)
-		     | SOME [product, small] => mk (product, small)
-		     | _ => NONE
-		 end
-	 else if String.hasPrefix (s, {prefix = "inlineLeafNoLoop"})
-	    then let
-		    fun mk size =
-		       SOME {name = concat ["inlineLeafNoLoop(", 
-					    Int.toString size, ")#",
-					    Int.toString (Counter.next count)],
-			     doit = inlineLeafNoLoop size}
-		    val s = String.dropPrefix (s, String.size "inlineLeafNoLoop")
-		 in
-		    case nums s of
-		       SOME [] => mk 20
-		     | SOME [size] => mk size
-		     | _ => NONE
-		 end
-	 else if String.hasPrefix (s, {prefix = "inlineLeaf"})
-	    then let
-		    fun mk size =
-		       SOME {name = concat ["inlineLeaf(", 
-					    Int.toString size, ")#",
-					    Int.toString (Counter.next count)],
-			     doit = inlineLeaf size}
-		    val s = String.dropPrefix (s, String.size "inlineLeaf")
-		 in
-		    case nums s of
-		       SOME [] => mk 20
-		     | SOME [size] => mk size
-		     | _ => NONE
-		 end
+         fn s =>
+         if String.hasPrefix (s, {prefix = "inlineNonRecursive"})
+            then let
+                    fun mk (product, small) =
+                       SOME {name = concat ["inlineNonRecursive(", 
+                                            Int.toString product, ",",
+                                            Int.toString small, ")#",
+                                            Int.toString (Counter.next count)],
+                             doit = inlineNonRecursive (product, small)}
+                    val s = String.dropPrefix (s, String.size "inlineNonRecursive")
+                 in
+                    case nums s of
+                       SOME [] => mk (320, 60)
+                     | SOME [product, small] => mk (product, small)
+                     | _ => NONE
+                 end
+         else if String.hasPrefix (s, {prefix = "inlineLeafNoLoop"})
+            then let
+                    fun mk size =
+                       SOME {name = concat ["inlineLeafNoLoop(", 
+                                            Int.toString size, ")#",
+                                            Int.toString (Counter.next count)],
+                             doit = inlineLeafNoLoop size}
+                    val s = String.dropPrefix (s, String.size "inlineLeafNoLoop")
+                 in
+                    case nums s of
+                       SOME [] => mk 20
+                     | SOME [size] => mk size
+                     | _ => NONE
+                 end
+         else if String.hasPrefix (s, {prefix = "inlineLeaf"})
+            then let
+                    fun mk size =
+                       SOME {name = concat ["inlineLeaf(", 
+                                            Int.toString size, ")#",
+                                            Int.toString (Counter.next count)],
+                             doit = inlineLeaf size}
+                    val s = String.dropPrefix (s, String.size "inlineLeaf")
+                 in
+                    case nums s of
+                       SOME [] => mk 20
+                     | SOME [size] => mk size
+                     | _ => NONE
+                 end
          else NONE
       end
 
    val passGens = 
       inlinePassGen ::
       (List.map([("commonArg", CommonArg.eliminate),
-		 ("commonBlock", CommonBlock.eliminate),
-		 ("commonSubexp", CommonSubexp.eliminate),
-		 ("constantPropagation", ConstantPropagation.simplify),
-		 ("contify", Contify.contify),
-		 ("flatten", Flatten.flatten),
-		 ("introduceLoops", IntroduceLoops.introduceLoops),
-		 ("knownCase", KnownCase.simplify),
-		 ("localFlatten", LocalFlatten.flatten),
-		 ("localRef", LocalRef.eliminate),
-		 ("loopInvariant", LoopInvariant.loopInvariant),
-		 ("polyEqual", PolyEqual.polyEqual),
-		 ("redundant", Redundant.redundant),
-		 ("redundantTests", RedundantTests.simplify),
-		 ("removeUnused", RemoveUnused.remove),
-		 ("simplifyTypes", SimplifyTypes.simplify),
-		 ("useless", Useless.useless),
-		 ("breakCriticalEdges",fn p => 
-		  S.breakCriticalEdges (p, {codeMotion = true})),
-		 ("eliminateDeadBlocks",S.eliminateDeadBlocks),
-		 ("reverseFunctions",S.reverseFunctions),
-		 ("shrink", S.shrink)], 
-		mkSimplePassGen))
+                 ("commonBlock", CommonBlock.eliminate),
+                 ("commonSubexp", CommonSubexp.eliminate),
+                 ("constantPropagation", ConstantPropagation.simplify),
+                 ("contify", Contify.contify),
+                 ("dropProfile", S.dropProfile),
+                 ("flatten", Flatten.flatten),
+                 ("introduceLoops", IntroduceLoops.introduceLoops),
+                 ("knownCase", KnownCase.simplify),
+                 ("localFlatten", LocalFlatten.flatten),
+                 ("localRef", LocalRef.eliminate),
+                 ("loopInvariant", LoopInvariant.loopInvariant),
+                 ("polyEqual", PolyEqual.polyEqual),
+                 ("redundant", Redundant.redundant),
+                 ("redundantTests", RedundantTests.simplify),
+                 ("removeUnused", RemoveUnused.remove),
+                 ("simplifyTypes", SimplifyTypes.simplify),
+                 ("useless", Useless.useless),
+                 ("breakCriticalEdges",fn p => 
+                  S.breakCriticalEdges (p, {codeMotion = true})),
+                 ("eliminateDeadBlocks",S.eliminateDeadBlocks),
+                 ("reverseFunctions",S.reverseFunctions),
+                 ("shrink", S.shrink)], 
+                mkSimplePassGen))
 
-   fun ssaPassesSet s =
-      DynamicWind.withEscape
+   fun ssaPassesSetCustom s =
+      Exn.withEscape
       (fn esc =>
        (let val ss = String.split (s, #":")
-	in 
-	   ssaPasses := 
-	   List.map(ss, fn s =>
-		    case (List.peekMap (passGens, fn gen => gen s)) of
-		       NONE => esc (Result.No s)
-		     | SOME pass => pass)
-	   ; Result.Yes ss
-	end))
+        in 
+           ssaPasses := 
+           List.map(ss, fn s =>
+                    case (List.peekMap (passGens, fn gen => gen s)) of
+                       NONE => esc (Result.No s)
+                     | SOME pass => pass)
+           ; Control.ssaPasses := ss
+           ; Result.Yes ()
+        end))
+
+   datatype t = datatype Control.optimizationPasses
+   fun ssaPassesSet opt =
+      case opt of
+         OptPassesDefault => (ssaPasses := ssaPassesDefault
+                              ; Control.ssaPasses := ["default"]
+                              ; Result.Yes ())
+       | OptPassesMinimal => (ssaPasses := ssaPassesMinimal
+                              ; Control.ssaPasses := ["minimal"]
+                              ; Result.Yes ())
+       | OptPassesCustom s => ssaPassesSetCustom s
 in
    val _ = Control.ssaPassesSet := ssaPassesSet
+   val _ = List.push (Control.optimizationPassesSet, ("ssa", ssaPassesSet))
 end
 
 fun stats p = Control.message (Control.Detail, fn () => Program.layoutStats p)
@@ -218,62 +237,62 @@
 fun simplify p =
    let
       fun simplify' n p =
-	 let
-	    val mkSuffix = if n = 0
-			     then fn s => s
-			     else let val n' = Int.toString n
-				  in fn s => concat [n',".",s]
-				  end
-	 in
-	    if n = !Control.loopPasses
-	       then p
-	    else simplify' 
-	         (n + 1)
-		 (List.fold
-	          (!ssaPasses, p, fn ({name, doit}, p) =>
-		   if List.exists (!Control.dropPasses, fn re =>
-				   Regexp.Compiled.matchesAll (re, name))
-		      then p
-		   else
-		     let
-		       val _ =
-			  let open Control
-			  in maybeSaveToFile
-			     ({name = name, suffix = mkSuffix "pre.ssa"},
-			      Control.No, p, Control.Layouts Program.layouts)
-			  end
-		       val p =
-			  Control.passTypeCheck
-			  {name = name,
-			   suffix = mkSuffix "post.ssa",
-			   style = Control.No,
-			   thunk = fn () => doit p,
-			   display = Control.Layouts Program.layouts,
-			   typeCheck = typeCheck}
-		       val _ = stats p
-		     in
-		       p
-		     end))
-	 end
+         let
+            val mkSuffix = if n = 0
+                             then fn s => s
+                             else let val n' = Int.toString n
+                                  in fn s => concat [n',".",s]
+                                  end
+         in
+            if n = !Control.loopPasses
+               then p
+            else simplify' 
+                 (n + 1)
+                 (List.fold
+                  (!ssaPasses, p, fn ({name, doit}, p) =>
+                   if List.exists (!Control.dropPasses, fn re =>
+                                   Regexp.Compiled.matchesAll (re, name))
+                      then p
+                   else
+                     let
+                       val _ =
+                          let open Control
+                          in maybeSaveToFile
+                             ({name = name, suffix = mkSuffix "pre.ssa"},
+                              Control.No, p, Control.Layouts Program.layouts)
+                          end
+                       val p =
+                          Control.passTypeCheck
+                          {name = name,
+                           suffix = mkSuffix "post.ssa",
+                           style = Control.No,
+                           thunk = fn () => doit p,
+                           display = Control.Layouts Program.layouts,
+                           typeCheck = typeCheck}
+                       val _ = stats p
+                     in
+                       p
+                     end))
+         end
    in
      stats p
      ; simplify' 0 p
    end
 
 val simplify = fn p => let
-			 (* Always want to type check the initial and final SSA 
-			  * programs, even if type checking is turned off, just
-			  * to catch bugs.
-			  *)
-			 val _ = typeCheck p
-			 val p = simplify p
-			 val p =
-			    if !Control.profile <> Control.ProfileNone
-			       andalso !Control.profileIL = Control.ProfileSSA
-			       then Program.profile p
-			    else p
-			 val _ = typeCheck p
-		       in
-			 p
-		       end
+                         (* Always want to type check the initial and final SSA 
+                          * programs, even if type checking is turned off, just
+                          * to catch bugs.
+                          *)
+                         val _ = typeCheck p
+                         val p = simplify p
+                         val p =
+                            if !Control.profile <> Control.ProfileNone
+                               andalso !Control.profileIL = Control.ProfileSSA
+                               then Program.profile p
+                            else p
+                         val _ = typeCheck p
+                       in
+                         p
+                       end
 end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ssa/simplify.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ssa/simplify.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ssa/simplify.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature SIMPLIFY_STRUCTS = 
    sig
       include RESTORE

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ssa/simplify2.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ssa/simplify2.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ssa/simplify2.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,9 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 functor Simplify2 (S: SIMPLIFY2_STRUCTS): SIMPLIFY2 = 
@@ -52,177 +52,71 @@
 *)
 
 type pass = {name: string,
-	     doit: Program.t -> Program.t}
+             doit: Program.t -> Program.t}
 
-val ssa2Passes : pass list ref = ref
-   [
-(*     {name = "removeUnused1", doit = RemoveUnused.remove}, *)
-(*     {name = "leafInline", doit = inlineLeaf 20}, *)
-    (* contify should be run before constant propagation because of the once
-     * pass that only looks at main -- hence want as much in main as possible.
-     *)
-(*     {name = "contify1", doit = Contify.contify}, *)
-(*     {name = "localFlatten1", doit = LocalFlatten.flatten}, *)
-    (* constantPropagation cannot be omitted. It implements Array_array0. *)
-(*     {name = "constantPropagation", doit = ConstantPropagation.simplify}, *)
-    (* useless should run after constantPropagation because constantPropagation
-     * makes slots of tuples that are constant useless.
-     *)
-(*     {name = "useless", doit = Useless.useless}, *)
-(*     {name = "removeUnused2", doit = RemoveUnused.remove}, *)
-(*     {name = "simplifyTypes", doit = SimplifyTypes.simplify}, *)
-    (* polyEqual cannot be omitted.  It implements MLton_equal.
-     * polyEqual should run
-     *   - after types are simplified so that many equals are turned into eqs
-     *   - before inlining so that equality functions can be inlined
-     *)
-(*     {name = "polyEqual", doit = PolyEqual.polyEqual}, *)
-(*     {name = "contify2", doit = Contify.contify}, *)
-(*     {name = "inline", doit = Inline.inline}, *)
-(*     {name = "localFlatten2", doit = LocalFlatten.flatten}, *)
-(*     {name = "removeUnused3", doit = RemoveUnused.remove}, *)
-(*     {name = "contify3", doit = Contify.contify}, *)
-(*     {name = "introduceLoops", doit = IntroduceLoops.introduceLoops}, *)
-(*     {name = "loopInvariant", doit = LoopInvariant.loopInvariant}, *)
-(*     {name = "localRef", doit = LocalRef.eliminate}, *)
-(*     {name = "flatten", doit = Flatten.flatten}, *)
-(*     {name = "localFlatten3", doit = LocalFlatten.flatten}, *)
-(*     {name = "commonArg", doit = CommonArg.eliminate}, *)
-(*     {name = "commonSubexp", doit = CommonSubexp.eliminate}, *)
-(*     {name = "commonBlock", doit = CommonBlock.eliminate}, *)
-(*     {name = "redundantTests", doit = RedundantTests.simplify}, *)
-(*     {name = "redundant", doit = Redundant.redundant}, *)
-(*     {name = "knownCase", doit = KnownCase.simplify},  *)
-(*     {name = "removeUnused4", doit = RemoveUnused2.remove}, *)
-     {name = "deepFlatten", doit = DeepFlatten.flatten},
-     {name = "refFlatten", doit = RefFlatten.flatten},
-     {name = "removeUnused5", doit = RemoveUnused2.remove},
-     {name = "zone", doit = Zone.zone}
-    ]
+val ssa2PassesDefault = 
+   {name = "deepFlatten", doit = DeepFlatten.flatten} ::
+   {name = "refFlatten", doit = RefFlatten.flatten} ::
+   {name = "removeUnused5", doit = RemoveUnused2.remove} ::
+   {name = "zone", doit = Zone.zone} ::
+   nil
 
+val ssa2PassesMinimal =
+   nil
+
+val ssa2Passes : pass list ref = ref ssa2PassesDefault
+
 local
    type passGen = string -> pass option
 
    fun mkSimplePassGen (name, doit): passGen =
       let val count = Counter.new 1
       in fn s => if s = name
-		    then SOME {name = concat [name, "#",
-					      Int.toString (Counter.next count)],
-			       doit = doit}
-		    else NONE
+                    then SOME {name = concat [name, "#",
+                                              Int.toString (Counter.next count)],
+                               doit = doit}
+                    else NONE
       end
 
-(*   
-   val inlinePassGen =
-      let
-	 val count = Counter.new 1 
-	 fun nums s =
-	    if s = ""
-	       then SOME []
-	    else if String.sub (s, 0) = #"(" 
-		  andalso String.sub (s, String.size s - 1)= #")"
-	       then let
-		       val s = String.dropFirst (String.dropLast s)
-		    in
-		       case List.fold (String.split (s, #","), SOME [],
-				       fn (s,SOME nums) => (case Int.fromString s of
-							       SOME i => SOME (i::nums)
-							     | NONE => NONE)
-					| (_, NONE) => NONE) of
-			  SOME (l as _::_) => SOME (List.rev l)
-			| _ => NONE
-		    end
-	    else NONE
-      in
-	 fn _ =>
-	 if String.isPrefix {string = s, prefix = "inlineNonRecursive"}
-	    then let
-		    fun mk (product, small) =
-		       SOME {name = concat ["inlineNonRecursive(", 
-					    Int.toString product, ",",
-					    Int.toString small, ")#",
-					    Int.toString (Counter.next count)],
-			     doit = inlineNonRecursive (product, small)}
-		    val s = String.dropPrefix (s, String.size "inlineNonRecursive")
-		 in
-		    case nums s of
-		       SOME [] => mk (320, 60)
-		     | SOME [product, small] => mk (product, small)
-		     | _ => NONE
-		 end
-	 else if String.isPrefix {string = s, prefix = "inlineLeafNoLoop"}
-	    then let
-		    fun mk size =
-		       SOME {name = concat ["inlineLeafNoLoop(", 
-					    Int.toString size, ")#",
-					    Int.toString (Counter.next count)],
-			     doit = inlineLeafNoLoop size}
-		    val s = String.dropPrefix (s, String.size "inlineLeafNoLoop")
-		 in
-		    case nums s of
-		       SOME [] => mk 20
-		     | SOME [size] => mk size
-		     | _ => NONE
-		 end
-	 else if String.isPrefix {string = s, prefix = "inlineLeaf"}
-	    then let
-		    fun mk size =
-		       SOME {name = concat ["inlineLeaf(", 
-					    Int.toString size, ")#",
-					    Int.toString (Counter.next count)],
-			     doit = inlineLeaf size}
-		    val s = String.dropPrefix (s, String.size "inlineLeaf")
-		 in
-		    case nums s of
-		       SOME [] => mk 20
-		     | SOME [size] => mk size
-		     | _ => NONE
-		 end
-      end
-*)
 
    val passGens = 
-(*    inlinePassGen :: *)
-      (List.map([
-(* 		 ("commonArg", CommonArg.eliminate), *)
-(* 		 ("commonBlock", CommonBlock.eliminate), *)
-(* 		 ("commonSubexp", CommonSubexp.eliminate), *)
-(* 		 ("constantPropagation", ConstantPropagation.simplify), *)
-(* 		 ("contify", Contify.contify), *)
-                 ("deepFlatten", DeepFlatten.flatten),
-(* 		 ("flatten", Flatten.flatten), *)
-(* 		 ("introduceLoops", IntroduceLoops.introduceLoops), *)
-(* 		 ("knownCase", KnownCase.simplify), *)
-(* 		 ("localFlatten", LocalFlatten.flatten), *)
-(* 		 ("localRef", LocalRef.eliminate), *)
-(* 		 ("loopInvariant", LoopInvariant.loopInvariant), *)
-(* 		 ("polyEqual", PolyEqual.polyEqual), *)
-(* 		 ("redundant", Redundant.redundant), *)
-(* 		 ("redundantTests", RedundantTests.simplify), *)
-                 ("refFlatten", RefFlatten.flatten),
- 		 ("removeUnused", RemoveUnused2.remove), 
-(* 		 ("simplifyTypes", SimplifyTypes.simplify), *)
-(* 		 ("useless", Useless.useless), *)
-		 ("zone", Zone.zone),
-		 ("eliminateDeadBlocks",S.eliminateDeadBlocks),
-		 ("reverseFunctions",S.reverseFunctions),
- 		 ("shrink", S.shrink)],
-		mkSimplePassGen))
+      List.map([("deepFlatten", DeepFlatten.flatten),
+                ("dropProfile", S.dropProfile),
+                ("refFlatten", RefFlatten.flatten),
+                ("removeUnused", RemoveUnused2.remove), 
+                ("zone", Zone.zone),
+                ("eliminateDeadBlocks",S.eliminateDeadBlocks),
+                ("reverseFunctions",S.reverseFunctions),
+                ("shrink", S.shrink)],
+               mkSimplePassGen)
 
-   fun ssa2PassesSet s =
-      DynamicWind.withEscape
+   fun ssa2PassesSetCustom s =
+      Exn.withEscape
       (fn esc =>
        (let val ss = String.split (s, #":")
-	in 
-	   ssa2Passes := 
-	   List.map(ss, fn s =>
-		    case (List.peekMap (passGens, fn gen => gen s)) of
-		       NONE => esc (Result.No s)
-		     | SOME pass => pass)
-	   ; Result.Yes ss
-	end))
+        in 
+           ssa2Passes := 
+           List.map(ss, fn s =>
+                    case (List.peekMap (passGens, fn gen => gen s)) of
+                       NONE => esc (Result.No s)
+                     | SOME pass => pass)
+           ; Control.ssa2Passes := ss
+           ; Result.Yes ()
+        end))
+
+   datatype t = datatype Control.optimizationPasses
+   fun ssa2PassesSet opt =
+      case opt of
+         OptPassesDefault => (ssa2Passes := ssa2PassesDefault
+                              ; Control.ssa2Passes := ["default"]
+                              ; Result.Yes ())
+       | OptPassesMinimal => (ssa2Passes := ssa2PassesMinimal
+                              ; Control.ssa2Passes := ["minimal"]
+                              ; Result.Yes ())
+       | OptPassesCustom s => ssa2PassesSetCustom s
 in
    val _ = Control.ssa2PassesSet := ssa2PassesSet
+   val _ = List.push (Control.optimizationPassesSet, ("ssa2", ssa2PassesSet))
 end
 
 fun stats p = Control.message (Control.Detail, fn () => Program.layoutStats p)
@@ -230,62 +124,62 @@
 fun simplify p =
    let
       fun simplify' n p =
-	 let
-	    val mkSuffix = if n = 0
-			     then fn s => s
-			     else let val n' = Int.toString n
-				  in fn s => concat [n',".",s]
-				  end
-	 in
-	    if n = !Control.loopPasses
-	       then p
-	    else simplify' 
-	         (n + 1)
-		 (List.fold
-	          (!ssa2Passes, p, fn ({name, doit}, p) =>
-		   if List.exists (!Control.dropPasses, fn re =>
-				   Regexp.Compiled.matchesAll (re, name))
-		      then p
-		   else
-		     let
-		       val _ =
-			  let open Control
-			  in maybeSaveToFile
-			     ({name = name, suffix = mkSuffix "pre.ssa2"},
-			      Control.No, p, Control.Layouts Program.layouts)
-			  end
-		       val p =
-			  Control.passTypeCheck
-			  {name = name,
-			   suffix = mkSuffix "post.ssa2",
-			   style = Control.No,
-			   thunk = fn () => doit p,
-			   display = Control.Layouts Program.layouts,
-			   typeCheck = typeCheck}
-		       val _ = stats p
-		     in
-		       p
-		     end))
-	 end
+         let
+            val mkSuffix = if n = 0
+                             then fn s => s
+                             else let val n' = Int.toString n
+                                  in fn s => concat [n',".",s]
+                                  end
+         in
+            if n = !Control.loopPasses
+               then p
+            else simplify' 
+                 (n + 1)
+                 (List.fold
+                  (!ssa2Passes, p, fn ({name, doit}, p) =>
+                   if List.exists (!Control.dropPasses, fn re =>
+                                   Regexp.Compiled.matchesAll (re, name))
+                      then p
+                   else
+                     let
+                       val _ =
+                          let open Control
+                          in maybeSaveToFile
+                             ({name = name, suffix = mkSuffix "pre.ssa2"},
+                              Control.No, p, Control.Layouts Program.layouts)
+                          end
+                       val p =
+                          Control.passTypeCheck
+                          {name = name,
+                           suffix = mkSuffix "post.ssa2",
+                           style = Control.No,
+                           thunk = fn () => doit p,
+                           display = Control.Layouts Program.layouts,
+                           typeCheck = typeCheck}
+                       val _ = stats p
+                     in
+                       p
+                     end))
+         end
    in
      stats p
      ; simplify' 0 p
    end
 
 val simplify = fn p => let
-			 (* Always want to type check the initial and final SSA 
-			  * programs, even if type checking is turned off, just
-			  * to catch bugs.
-			  *)
-			 val _ = typeCheck p
-			 val p = simplify p
-			 val p =
-			    if !Control.profile <> Control.ProfileNone
-			       andalso !Control.profileIL = Control.ProfileSSA2
-			       then Program.profile p
-			    else p
-			 val _ = typeCheck p
-		       in
-			 p
-		       end
+                         (* Always want to type check the initial and final SSA 
+                          * programs, even if type checking is turned off, just
+                          * to catch bugs.
+                          *)
+                         val _ = typeCheck p
+                         val p = simplify p
+                         val p =
+                            if !Control.profile <> Control.ProfileNone
+                               andalso !Control.profileIL = Control.ProfileSSA2
+                               then Program.profile p
+                            else p
+                         val _ = typeCheck p
+                       in
+                         p
+                       end
 end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ssa/simplify2.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ssa/simplify2.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ssa/simplify2.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature SIMPLIFY2_STRUCTS = 
    sig
       include SHRINK2

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ssa/sources.cm
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ssa/sources.cm	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ssa/sources.cm	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 Group
 
 signature HANDLER

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ssa/sources.mlb
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ssa/sources.mlb	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ssa/sources.mlb	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,9 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 local
@@ -11,106 +11,106 @@
    ../atoms/sources.mlb
    ../control/sources.mlb
 
-    equatable.sig
-    equatable.sml
-    ssa-tree.sig
-    ssa-tree2.sig
-    ssa-tree.fun
-    ssa-tree2.fun
-    direct-exp.sig
-    direct-exp.fun
-    analyze.sig
-    analyze2.sig
-    analyze.fun
-    analyze2.fun
-    type-check.sig
-    type-check2.sig
-    type-check.fun
-    type-check2.fun
-    prepasses.sig
-    prepasses2.sig
-    prepasses.fun
-    prepasses2.fun
-    shrink.sig
-    shrink2.sig
-    shrink.fun
-    shrink2.fun
-    flat-lattice.sig
-    flat-lattice.fun
-    common-arg.sig
-    common-arg.fun
-    common-block.sig
-    common-block.fun
-    common-subexp.sig
-    common-subexp.fun
-    global.sig
-    global.fun
-    two-point-lattice.sig
-    two-point-lattice.fun
-    multi.sig
-    multi.fun
-    constant-propagation.sig
-    constant-propagation.fun
-    contify.sig
-    contify.fun
-    deep-flatten.sig
-    deep-flatten.fun
-    flatten.sig
-    flatten.fun
-    inline.sig
-    inline.fun
-    introduce-loops.sig
-    introduce-loops.fun
-    n-point-lattice.sig
-    n-point-lattice.fun
-    three-point-lattice.sig
-    three-point-lattice.fun
-    restore.sig
-    restore.fun
-    known-case.sig
-    known-case.fun
-    local-flatten.sig
-    local-flatten.fun
-    local-ref.sig
-    local-ref.fun
-    loop-invariant.sig
-    loop-invariant.fun
-    poly-equal.sig
-    poly-equal.fun
-    redundant-tests.sig
-    redundant-tests.fun
-    redundant.sig
-    redundant.fun
-    ref-flatten.sig
-    ref-flatten.fun
-    remove-unused.sig
-    remove-unused2.sig
-    remove-unused.fun
-    remove-unused2.fun
-    simplify-types.sig
-    simplify-types.fun
-    useless.sig
-    useless.fun
-    zone.sig
-    zone.fun
-    simplify.sig
-    simplify2.sig
-    simplify.fun
-    simplify2.fun
-    ssa.sig
-    ssa2.sig
-    ssa.fun
-    ssa2.fun
-    ssa-to-ssa2.sig
-    ssa-to-ssa2.fun
+   equatable.sig
+   equatable.sml
+   ssa-tree.sig
+   ssa-tree2.sig
+   ssa-tree.fun
+   ssa-tree2.fun
+   direct-exp.sig
+   direct-exp.fun
+   analyze.sig
+   analyze2.sig
+   analyze.fun
+   analyze2.fun
+   type-check.sig
+   type-check2.sig
+   type-check.fun
+   type-check2.fun
+   prepasses.sig
+   prepasses2.sig
+   prepasses.fun
+   prepasses2.fun
+   shrink.sig
+   shrink2.sig
+   shrink.fun
+   shrink2.fun
+   flat-lattice.sig
+   flat-lattice.fun
+   common-arg.sig
+   common-arg.fun
+   common-block.sig
+   common-block.fun
+   common-subexp.sig
+   common-subexp.fun
+   global.sig
+   global.fun
+   two-point-lattice.sig
+   two-point-lattice.fun
+   multi.sig
+   multi.fun
+   constant-propagation.sig
+   constant-propagation.fun
+   contify.sig
+   contify.fun
+   deep-flatten.sig
+   deep-flatten.fun
+   flatten.sig
+   flatten.fun
+   inline.sig
+   inline.fun
+   introduce-loops.sig
+   introduce-loops.fun
+   n-point-lattice.sig
+   n-point-lattice.fun
+   three-point-lattice.sig
+   three-point-lattice.fun
+   restore.sig
+   restore.fun
+   known-case.sig
+   known-case.fun
+   local-flatten.sig
+   local-flatten.fun
+   local-ref.sig
+   local-ref.fun
+   loop-invariant.sig
+   loop-invariant.fun
+   poly-equal.sig
+   poly-equal.fun
+   redundant-tests.sig
+   redundant-tests.fun
+   redundant.sig
+   redundant.fun
+   ref-flatten.sig
+   ref-flatten.fun
+   remove-unused.sig
+   remove-unused2.sig
+   remove-unused.fun
+   remove-unused2.fun
+   simplify-types.sig
+   simplify-types.fun
+   useless.sig
+   useless.fun
+   zone.sig
+   zone.fun
+   simplify.sig
+   simplify2.sig
+   simplify.fun
+   simplify2.fun
+   ssa.sig
+   ssa2.sig
+   ssa.fun
+   ssa2.fun
+   ssa-to-ssa2.sig
+   ssa-to-ssa2.fun
 in
-    signature HANDLER
-    signature RETURN
-    signature SSA
-    signature SSA2
+   signature HANDLER
+   signature RETURN
+   signature SSA
+   signature SSA2
 
-    functor FlatLattice
-    functor Ssa
-    functor Ssa2
-    functor SsaToSsa2
+   functor FlatLattice
+   functor Ssa
+   functor Ssa2
+   functor SsaToSsa2
 end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ssa/ssa-to-ssa2.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ssa/ssa-to-ssa2.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ssa/ssa-to-ssa2.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,8 +1,8 @@
-(* Copyright (C) 2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 2004-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 functor SsaToSsa2 (S: SSA_TO_SSA2_STRUCTS): SSA_TO_SSA2 = 
@@ -32,244 +32,244 @@
 fun convert (S.Program.T {datatypes, functions, globals, main}) =
    let
       val {get = convertType: S.Type.t -> S2.Type.t, ...} =
-	 Property.get
-	 (S.Type.plist,
-	  Property.initRec
-	  (fn (t, convertType)  =>
-	   case S.Type.dest t of
-	      S.Type.Array t => S2.Type.array (convertType t)
-	    | S.Type.Datatype tycon => S2.Type.datatypee tycon
-	    | S.Type.IntInf => S2.Type.intInf
-	    | S.Type.Real s => S2.Type.real s
-	    | S.Type.Ref t => S2.Type.reff (convertType t)
-	    | S.Type.Thread => S2.Type.thread
-	    | S.Type.Tuple ts =>
-		 S2.Type.tuple (Prod.make
-				(Vector.map (ts, fn t =>
-					     {elt = convertType t,
-					      isMutable = false})))
-	    | S.Type.Vector t => S2.Type.vector1 (convertType t)
-	    | S.Type.Weak t => S2.Type.weak (convertType t)
-	    | S.Type.Word s => S2.Type.word s))
+         Property.get
+         (S.Type.plist,
+          Property.initRec
+          (fn (t, convertType)  =>
+           case S.Type.dest t of
+              S.Type.Array t => S2.Type.array (convertType t)
+            | S.Type.Datatype tycon => S2.Type.datatypee tycon
+            | S.Type.IntInf => S2.Type.intInf
+            | S.Type.Real s => S2.Type.real s
+            | S.Type.Ref t => S2.Type.reff (convertType t)
+            | S.Type.Thread => S2.Type.thread
+            | S.Type.Tuple ts =>
+                 S2.Type.tuple (Prod.make
+                                (Vector.map (ts, fn t =>
+                                             {elt = convertType t,
+                                              isMutable = false})))
+            | S.Type.Vector t => S2.Type.vector1 (convertType t)
+            | S.Type.Weak t => S2.Type.weak (convertType t)
+            | S.Type.Word s => S2.Type.word s))
       fun convertTypes ts = Vector.map (ts, convertType)
       val {get = conType: Con.t -> S2.Type.t, set = setConType, ...} =
-	 Property.getSetOnce (Con.plist,
-			      Property.initRaise ("type", Con.layout))
+         Property.getSetOnce (Con.plist,
+                              Property.initRaise ("type", Con.layout))
       val datatypes =
-	 Vector.map
-	 (datatypes, fn S.Datatype.T {cons, tycon} =>
-	  S2.Datatype.T
-	  {cons = Vector.map (cons, fn {args, con} =>
-			      let
-				 val args =
-				    Prod.make
-				    (Vector.map (args, fn t =>
-						 {elt = convertType t,
-						  isMutable = false}))
-				 val () =
-				    setConType (con, S2.Type.conApp (con, args))
-			      in
-				 {args = args,
-				  con = con}
-			      end),
-	   tycon = tycon})
+         Vector.map
+         (datatypes, fn S.Datatype.T {cons, tycon} =>
+          S2.Datatype.T
+          {cons = Vector.map (cons, fn {args, con} =>
+                              let
+                                 val args =
+                                    Prod.make
+                                    (Vector.map (args, fn t =>
+                                                 {elt = convertType t,
+                                                  isMutable = false}))
+                                 val () =
+                                    setConType (con, S2.Type.conApp (con, args))
+                              in
+                                 {args = args,
+                                  con = con}
+                              end),
+           tycon = tycon})
       fun convertPrim p = S.Prim.map (p, convertType)
       fun convertStatement (S.Statement.T {exp, ty, var})
-	 : S2.Statement.t vector =
-	 let
-	    val ty = convertType ty
-	    fun simple (exp: S2.Exp.t): S2.Statement.t vector =
-	       Vector.new1 (S2.Statement.Bind {exp = exp, ty = ty, var = var})
-	 in
-	    case exp of
-	       S.Exp.ConApp {args, con} =>
-		  let
-		     val sum =
-			case S2.Type.dest ty of
-			   S2.Type.Datatype tycon => tycon
-			 | _ => Error.bug "convertStatement saw strange ConApp"
-		     val variant = Var.newNoname ()
-		  in
-		     Vector.new2
-		     (S2.Statement.Bind {exp = S2.Exp.Object {args = args,
-							      con = SOME con},
-					 ty = conType con,
-					 var = SOME variant},
-		      S2.Statement.Bind {exp = S2.Exp.Inject {variant = variant,
-							      sum = sum},
-					 ty = ty,
-					 var = var})
-		  end
-	     | S.Exp.Const c => simple (S2.Exp.Const c)
-	     | S.Exp.PrimApp {args, prim, ...} =>
-		  let
-		     fun arg i = Vector.sub (args, i)
-		     fun sub () =
-			simple
-			(S2.Exp.Select {base = Base.VectorSub {index = arg 1,
-							       vector = arg 0},
-					offset = 0})
-		     datatype z = datatype Prim.Name.t
-		   in
-		      case Prim.name prim of
-			 Array_sub => sub ()
-		       | Array_update =>
-			    Vector.new1
-			    (S2.Statement.Update
-			     {base = Base.VectorSub {index = arg 1,
-						     vector = arg 0},
-			      offset = 0,
-			      value = arg 2})
-		       | Ref_assign =>
-			    Vector.new1 (S2.Statement.Update
-					 {base = Base.Object (arg 0),
-					  offset = 0,
-					  value = arg 1})
-		       | Ref_deref =>
-			    simple (S2.Exp.Select {base = Base.Object (arg 0),
-						   offset = 0})
-		       | Ref_ref =>
-			    simple (S2.Exp.Object {args = Vector.new1 (arg 0),
-						   con = NONE})
-		       | Vector_length =>
-			    simple (S2.Exp.PrimApp {args = args,
-						    prim = Prim.arrayLength})
-		       | Vector_sub => sub ()
-		       | _ =>
-			    simple (S2.Exp.PrimApp {args = args,
-						    prim = convertPrim prim})
-		   end
-	     | S.Exp.Profile e => Vector.new1 (S2.Statement.Profile e)
-	     | S.Exp.Select {offset, tuple} =>
-		  simple (S2.Exp.Select {base = Base.Object tuple,
-					 offset = offset})
-	     | S.Exp.Tuple v => simple (S2.Exp.Object {args = v, con = NONE})
-	     | S.Exp.Var x => simple (S2.Exp.Var x)
-	 end
+         : S2.Statement.t vector =
+         let
+            val ty = convertType ty
+            fun simple (exp: S2.Exp.t): S2.Statement.t vector =
+               Vector.new1 (S2.Statement.Bind {exp = exp, ty = ty, var = var})
+         in
+            case exp of
+               S.Exp.ConApp {args, con} =>
+                  let
+                     val sum =
+                        case S2.Type.dest ty of
+                           S2.Type.Datatype tycon => tycon
+                         | _ => Error.bug "SsaToSsa2.convertStatement: strange ConApp"
+                     val variant = Var.newNoname ()
+                  in
+                     Vector.new2
+                     (S2.Statement.Bind {exp = S2.Exp.Object {args = args,
+                                                              con = SOME con},
+                                         ty = conType con,
+                                         var = SOME variant},
+                      S2.Statement.Bind {exp = S2.Exp.Inject {variant = variant,
+                                                              sum = sum},
+                                         ty = ty,
+                                         var = var})
+                  end
+             | S.Exp.Const c => simple (S2.Exp.Const c)
+             | S.Exp.PrimApp {args, prim, ...} =>
+                  let
+                     fun arg i = Vector.sub (args, i)
+                     fun sub () =
+                        simple
+                        (S2.Exp.Select {base = Base.VectorSub {index = arg 1,
+                                                               vector = arg 0},
+                                        offset = 0})
+                     datatype z = datatype Prim.Name.t
+                   in
+                      case Prim.name prim of
+                         Array_sub => sub ()
+                       | Array_update =>
+                            Vector.new1
+                            (S2.Statement.Update
+                             {base = Base.VectorSub {index = arg 1,
+                                                     vector = arg 0},
+                              offset = 0,
+                              value = arg 2})
+                       | Ref_assign =>
+                            Vector.new1 (S2.Statement.Update
+                                         {base = Base.Object (arg 0),
+                                          offset = 0,
+                                          value = arg 1})
+                       | Ref_deref =>
+                            simple (S2.Exp.Select {base = Base.Object (arg 0),
+                                                   offset = 0})
+                       | Ref_ref =>
+                            simple (S2.Exp.Object {args = Vector.new1 (arg 0),
+                                                   con = NONE})
+                       | Vector_length =>
+                            simple (S2.Exp.PrimApp {args = args,
+                                                    prim = Prim.arrayLength})
+                       | Vector_sub => sub ()
+                       | _ =>
+                            simple (S2.Exp.PrimApp {args = args,
+                                                    prim = convertPrim prim})
+                   end
+             | S.Exp.Profile e => Vector.new1 (S2.Statement.Profile e)
+             | S.Exp.Select {offset, tuple} =>
+                  simple (S2.Exp.Select {base = Base.Object tuple,
+                                         offset = offset})
+             | S.Exp.Tuple v => simple (S2.Exp.Object {args = v, con = NONE})
+             | S.Exp.Var x => simple (S2.Exp.Var x)
+         end
       val convertStatement =
-	 Trace.trace ("convertStatement",
-		      S.Statement.layout,
-		      Vector.layout S2.Statement.layout)
-	    convertStatement
+         Trace.trace ("SsaToSsa2.convertStatement",
+                      S.Statement.layout,
+                      Vector.layout S2.Statement.layout)
+            convertStatement
       fun convertHandler (h: S.Handler.t): S2.Handler.t =
-	 case h of
-	    S.Handler.Caller => S2.Handler.Caller
-	  | S.Handler.Dead => S2.Handler.Dead
-	  | S.Handler.Handle l => S2.Handler.Handle l
+         case h of
+            S.Handler.Caller => S2.Handler.Caller
+          | S.Handler.Dead => S2.Handler.Dead
+          | S.Handler.Handle l => S2.Handler.Handle l
       fun convertReturn (r: S.Return.t): S2.Return.t =
-	 case r of
-	    S.Return.Dead => S2.Return.Dead
-	  | S.Return.NonTail {cont, handler} =>
-	       S2.Return.NonTail {cont = cont,
-				  handler = convertHandler handler}
-	  | S.Return.Tail => S2.Return.Tail
+         case r of
+            S.Return.Dead => S2.Return.Dead
+          | S.Return.NonTail {cont, handler} =>
+               S2.Return.NonTail {cont = cont,
+                                  handler = convertHandler handler}
+          | S.Return.Tail => S2.Return.Tail
       val extraBlocks: S2.Block.t list ref = ref []
       fun convertCases (cs: S.Cases.t): S2.Cases.t =
-	 case cs of
-	    S.Cases.Con v =>
-	       S2.Cases.Con
-	       (Vector.map
-		(v, fn (c, l) =>
-		 let
-		    val objectTy = conType c
-		 in
-		    case S2.Type.dest objectTy of
-		       S2.Type.Object {args, ...} =>
-			  if Prod.isEmpty args
-			     then (c, l)
-			  else
-			     let
-				val l' = Label.newNoname ()
-				val object = Var.newNoname ()
-				val (xs, statements) =
-				   Vector.unzip
-				   (Vector.mapi
-				    (Prod.dest args, fn (i, {elt = ty, ...}) =>
-				     let
-					val x = Var.newNoname ()
-					val exp =
-					   S2.Exp.Select
-					   {base = Base.Object object,
-					    offset = i}
-				     in
-					(x,
-					 S2.Statement.Bind {exp = exp,
-							    ty = ty,
-							    var = SOME x})
-				     end))
-				val transfer =
-				   S2.Transfer.Goto {args = xs, dst = l}
-				val args = Vector.new1 (object, objectTy)
-				val () =
-				   List.push
-				   (extraBlocks,
-				    S2.Block.T {args = args,
-						label = l',
-						statements = statements,
-						transfer = transfer})
-			     in
-				(c, l')
-			     end
-		     | _ => Error.bug "strange object type"
-		 end))
-	  | S.Cases.Word v => S2.Cases.Word v
+         case cs of
+            S.Cases.Con v =>
+               S2.Cases.Con
+               (Vector.map
+                (v, fn (c, l) =>
+                 let
+                    val objectTy = conType c
+                 in
+                    case S2.Type.dest objectTy of
+                       S2.Type.Object {args, ...} =>
+                          if Prod.isEmpty args
+                             then (c, l)
+                          else
+                             let
+                                val l' = Label.newNoname ()
+                                val object = Var.newNoname ()
+                                val (xs, statements) =
+                                   Vector.unzip
+                                   (Vector.mapi
+                                    (Prod.dest args, fn (i, {elt = ty, ...}) =>
+                                     let
+                                        val x = Var.newNoname ()
+                                        val exp =
+                                           S2.Exp.Select
+                                           {base = Base.Object object,
+                                            offset = i}
+                                     in
+                                        (x,
+                                         S2.Statement.Bind {exp = exp,
+                                                            ty = ty,
+                                                            var = SOME x})
+                                     end))
+                                val transfer =
+                                   S2.Transfer.Goto {args = xs, dst = l}
+                                val args = Vector.new1 (object, objectTy)
+                                val () =
+                                   List.push
+                                   (extraBlocks,
+                                    S2.Block.T {args = args,
+                                                label = l',
+                                                statements = statements,
+                                                transfer = transfer})
+                             in
+                                (c, l')
+                             end
+                     | _ => Error.bug "SsaToSsa2.convertCases: strange object type"
+                 end))
+          | S.Cases.Word v => S2.Cases.Word v
       fun convertTransfer (t: S.Transfer.t): S2.Transfer.t =
-	 case t of
-	    S.Transfer.Arith {args, overflow, prim, success, ty} =>
-	       S2.Transfer.Arith {args = args,
-				  overflow = overflow,
-				  prim = convertPrim prim,
-				  success = success,
-				  ty = convertType ty}
-	  | S.Transfer.Bug => S2.Transfer.Bug
-	  | S.Transfer.Call {args, func, return} =>
-	       S2.Transfer.Call {args = args,
-				 func = func,
-				 return = convertReturn return}
-	  | S.Transfer.Case {cases, default, test} =>
-	       S2.Transfer.Case {cases = convertCases cases,
-				 default = default,
-				 test = test}
-	  | S.Transfer.Goto r => S2.Transfer.Goto r
-	  | S.Transfer.Raise v => S2.Transfer.Raise v
-	  | S.Transfer.Return v => S2.Transfer.Return v
-	  | S.Transfer.Runtime {args, prim, return} =>
-	       S2.Transfer.Runtime {args = args,
-				    prim = convertPrim prim,
-				    return = return}
+         case t of
+            S.Transfer.Arith {args, overflow, prim, success, ty} =>
+               S2.Transfer.Arith {args = args,
+                                  overflow = overflow,
+                                  prim = convertPrim prim,
+                                  success = success,
+                                  ty = convertType ty}
+          | S.Transfer.Bug => S2.Transfer.Bug
+          | S.Transfer.Call {args, func, return} =>
+               S2.Transfer.Call {args = args,
+                                 func = func,
+                                 return = convertReturn return}
+          | S.Transfer.Case {cases, default, test} =>
+               S2.Transfer.Case {cases = convertCases cases,
+                                 default = default,
+                                 test = test}
+          | S.Transfer.Goto r => S2.Transfer.Goto r
+          | S.Transfer.Raise v => S2.Transfer.Raise v
+          | S.Transfer.Return v => S2.Transfer.Return v
+          | S.Transfer.Runtime {args, prim, return} =>
+               S2.Transfer.Runtime {args = args,
+                                    prim = convertPrim prim,
+                                    return = return}
       fun convertStatements ss =
-	 Vector.concatV (Vector.map (ss, convertStatement))
+         Vector.concatV (Vector.map (ss, convertStatement))
       fun convertFormals xts = Vector.map (xts, fn (x, t) => (x, convertType t))
       fun convertBlock (S.Block.T {args, label, statements, transfer}) =
-	 S2.Block.T {args = convertFormals args,
-		     label = label,
-		     statements = convertStatements statements,
-		     transfer = convertTransfer transfer}
+         S2.Block.T {args = convertFormals args,
+                     label = label,
+                     statements = convertStatements statements,
+                     transfer = convertTransfer transfer}
       val functions =
-	 List.map
-	 (functions, fn f =>
-	  let
-	     val {args, blocks, mayInline, name, raises, returns, start} =
-		S.Function.dest f
-	     fun rr tvo = Option.map (tvo, convertTypes)
-	     val blocks = Vector.map (blocks, convertBlock)
-	     val blocks = Vector.concat [blocks, Vector.fromList (!extraBlocks)]
-	     val () = extraBlocks := []
-	  in
-	     S2.Function.new {args = convertFormals args,
-			      blocks = blocks,
-			      mayInline = mayInline,
-			      name = name,
-			      raises = rr raises,
-			      returns = rr returns,
-			      start = start}
-	  end)
+         List.map
+         (functions, fn f =>
+          let
+             val {args, blocks, mayInline, name, raises, returns, start} =
+                S.Function.dest f
+             fun rr tvo = Option.map (tvo, convertTypes)
+             val blocks = Vector.map (blocks, convertBlock)
+             val blocks = Vector.concat [blocks, Vector.fromList (!extraBlocks)]
+             val () = extraBlocks := []
+          in
+             S2.Function.new {args = convertFormals args,
+                              blocks = blocks,
+                              mayInline = mayInline,
+                              name = name,
+                              raises = rr raises,
+                              returns = rr returns,
+                              start = start}
+          end)
       val globals = convertStatements globals
       val program = 
-	 S2.Program.T {datatypes = datatypes,
-		       functions = functions,
-		       globals = globals,
-		       main = main}
+         S2.Program.T {datatypes = datatypes,
+                       functions = functions,
+                       globals = globals,
+                       main = main}
    in
       S2.shrink program
    end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ssa/ssa-to-ssa2.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ssa/ssa-to-ssa2.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ssa/ssa-to-ssa2.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,8 +1,8 @@
-(* Copyright (C) 2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 2004-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 signature SSA_TO_SSA2_STRUCTS = 

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ssa/ssa-tree.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ssa/ssa-tree.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ssa/ssa-tree.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 functor SsaTree (S: SSA_TREE_STRUCTS): SSA_TREE = 
 struct
 
@@ -19,152 +20,152 @@
       end
 
       fun tyconArgs t =
-	 case Dest.dest t of
-	    Dest.Con x => x
-	  | _ => Error.bug "FirstOrderType.tyconArgs"
-	       
+         case Dest.dest t of
+            Dest.Con x => x
+          | _ => Error.bug "SsaTree.Type.tyconArgs"
+               
       datatype dest =
-	  Array of t
-	| Datatype of Tycon.t
-	| IntInf
-	| Real of RealSize.t
-	| Ref of t
-	| Thread
-	| Tuple of t vector
-	| Vector of t
-	| Weak of t
-	| Word of WordSize.t
+          Array of t
+        | Datatype of Tycon.t
+        | IntInf
+        | Real of RealSize.t
+        | Ref of t
+        | Thread
+        | Tuple of t vector
+        | Vector of t
+        | Weak of t
+        | Word of WordSize.t
 
       local
-	 val {get, set, ...} =
-	    Property.getSetOnce (Tycon.plist, Property.initConst NONE)
+         val {get, set, ...} =
+            Property.getSetOnce (Tycon.plist, Property.initConst NONE)
 
-	 fun nullary c v =
-	    if Vector.isEmpty v
-	       then c
-	    else Error.bug "bogus application of nullary tycon"
+         fun nullary c v =
+            if Vector.isEmpty v
+               then c
+            else Error.bug "SsaTree.Type.nullary: bogus application of nullary tycon"
 
-	 fun unary make v =
-	    if 1 = Vector.length v
-	       then make (Vector.sub (v, 0))
-	    else Error.bug "bogus application of unary tycon"
+         fun unary make v =
+            if 1 = Vector.length v
+               then make (Vector.sub (v, 0))
+            else Error.bug "SsaTree.Type.unary: bogus application of unary tycon"
 
-	 val tycons =
-	    [(Tycon.array, unary Array)]
-	    @ [(Tycon.intInf, nullary IntInf)]
-	    @ Vector.toListMap (Tycon.reals, fn (t, s) => (t, nullary (Real s)))
-	    @ [(Tycon.reff, unary Ref),
-	       (Tycon.thread, nullary Thread),
-	       (Tycon.tuple, Tuple),
-	       (Tycon.vector, unary Vector),
-	       (Tycon.weak, unary Weak)]
-	    @ Vector.toListMap (Tycon.words, fn (t, s) => (t, nullary (Word s)))
+         val tycons =
+            [(Tycon.array, unary Array)]
+            @ [(Tycon.intInf, nullary IntInf)]
+            @ Vector.toListMap (Tycon.reals, fn (t, s) => (t, nullary (Real s)))
+            @ [(Tycon.reff, unary Ref),
+               (Tycon.thread, nullary Thread),
+               (Tycon.tuple, Tuple),
+               (Tycon.vector, unary Vector),
+               (Tycon.weak, unary Weak)]
+            @ Vector.toListMap (Tycon.words, fn (t, s) => (t, nullary (Word s)))
       in
-	 val _ = List.foreach (tycons, fn (tycon, f) => set (tycon, SOME f))
+         val _ = List.foreach (tycons, fn (tycon, f) => set (tycon, SOME f))
 
-	 fun dest t =
-	    case Dest.dest t of
-	       Dest.Con (tycon, ts) =>
-		  (case get tycon of
-		      NONE => Datatype tycon
-		    | SOME f => f ts)
-	     | _ => Error.bug "dest"
+         fun dest t =
+            case Dest.dest t of
+               Dest.Con (tycon, ts) =>
+                  (case get tycon of
+                      NONE => Datatype tycon
+                    | SOME f => f ts)
+             | _ => Error.bug "SsaTree.Type.dest"
       end
 
       local
-	 open Layout
+         open Layout
       in
-	 val {get = layout, ...} =
-	    Property.get
-	    (plist,
-	     Property.initRec
-	     (fn (t, layout) =>
-	      case dest t of
-		 Array t => seq [layout t, str " array"]
-	       | Datatype t => Tycon.layout t
-	       | IntInf => str "IntInf.int"
-	       | Real s => str (concat ["real", RealSize.toString s])
-	       | Ref t => seq [layout t, str " ref"]
-	       | Thread => str "thread"
-	       | Tuple ts =>
-		    if Vector.isEmpty ts
-		       then str "unit"
-		    else paren (seq (separate (Vector.toListMap (ts, layout),
-					       " * ")))
-	       | Vector t => seq [layout t, str " vector"]
-	       | Weak t => seq [layout t, str " weak"]
-	       | Word s => str (concat ["word", WordSize.toString s])))
+         val {get = layout, ...} =
+            Property.get
+            (plist,
+             Property.initRec
+             (fn (t, layout) =>
+              case dest t of
+                 Array t => seq [layout t, str " array"]
+               | Datatype t => Tycon.layout t
+               | IntInf => str "IntInf.int"
+               | Real s => str (concat ["real", RealSize.toString s])
+               | Ref t => seq [layout t, str " ref"]
+               | Thread => str "thread"
+               | Tuple ts =>
+                    if Vector.isEmpty ts
+                       then str "unit"
+                    else paren (seq (separate (Vector.toListMap (ts, layout),
+                                               " * ")))
+               | Vector t => seq [layout t, str " vector"]
+               | Weak t => seq [layout t, str " weak"]
+               | Word s => str (concat ["word", WordSize.toString s])))
       end
    end
 
 structure Cases =
    struct
       datatype t =
-	 Con of (Con.t * Label.t) vector
+         Con of (Con.t * Label.t) vector
        | Word of WordSize.t * (WordX.t * Label.t) vector
 
       fun equals (c1: t, c2: t): bool =
-	 let
-	    fun doit (l1, l2, eq') = 
-	       Vector.equals 
-	       (l1, l2, fn ((x1, a1), (x2, a2)) =>
-		eq' (x1, x2) andalso Label.equals (a1, a2))
-	 in
-	    case (c1, c2) of
-	       (Con l1, Con l2) => doit (l1, l2, Con.equals)
-	     | (Word (_, l1), Word (_, l2)) => doit (l1, l2, WordX.equals)
-	     | _ => false
-	 end
+         let
+            fun doit (l1, l2, eq') = 
+               Vector.equals 
+               (l1, l2, fn ((x1, a1), (x2, a2)) =>
+                eq' (x1, x2) andalso Label.equals (a1, a2))
+         in
+            case (c1, c2) of
+               (Con l1, Con l2) => doit (l1, l2, Con.equals)
+             | (Word (_, l1), Word (_, l2)) => doit (l1, l2, WordX.equals)
+             | _ => false
+         end
 
       fun hd (c: t): Label.t =
-	 let
-	    fun doit v =
-	       if Vector.length v >= 1
-		  then let val (_, a) = Vector.sub (v, 0)
-		       in a
-		       end
-	       else Error.bug "Cases.hd"
-	 in
-	    case c of
-	       Con cs => doit cs
-	     | Word (_, cs) => doit cs
-	 end
+         let
+            fun doit v =
+               if Vector.length v >= 1
+                  then let val (_, a) = Vector.sub (v, 0)
+                       in a
+                       end
+               else Error.bug "SsaTree.Cases.hd"
+         in
+            case c of
+               Con cs => doit cs
+             | Word (_, cs) => doit cs
+         end
 
       fun isEmpty (c: t): bool =
-	 let
-	    fun doit v = 0 = Vector.length v
-	 in
-	    case c of
-	       Con cs => doit cs
-	     | Word (_, cs) => doit cs
-	 end
+         let
+            fun doit v = 0 = Vector.length v
+         in
+            case c of
+               Con cs => doit cs
+             | Word (_, cs) => doit cs
+         end
 
       fun fold (c: t, b, f) =
-	 let
-	    fun doit l = Vector.fold (l, b, fn ((_, a), b) => f (a, b))
-	 in
-	    case c of
-	       Con l => doit l
-	     | Word (_, l) => doit l
-	 end
+         let
+            fun doit l = Vector.fold (l, b, fn ((_, a), b) => f (a, b))
+         in
+            case c of
+               Con l => doit l
+             | Word (_, l) => doit l
+         end
 
       fun map (c: t, f): t =
-	 let
-	    fun doit l = Vector.map (l, fn (i, x) => (i, f x))
-	 in
-	    case c of
-	       Con l => Con (doit l)
-	     | Word (s, l) => Word (s, doit l)
-	 end
+         let
+            fun doit l = Vector.map (l, fn (i, x) => (i, f x))
+         in
+            case c of
+               Con l => Con (doit l)
+             | Word (s, l) => Word (s, doit l)
+         end
       
       fun forall (c: t, f: Label.t -> bool): bool =
-	 let
-	    fun doit l = Vector.forall (l, fn (_, x) => f x)
-	 in
-	    case c of
-	       Con l => doit l
-	     | Word (_, l) => doit l
-	 end
+         let
+            fun doit l = Vector.forall (l, fn (_, x) => f x)
+         in
+            case c of
+               Con l => doit l
+             | Word (_, l) => doit l
+         end
 
       fun length (c: t): int = fold (c, 0, fn (_, i) => i + 1)
 
@@ -181,241 +182,241 @@
       open Var
 
       fun pretty (x, global) =
-	 case global x of
-	    NONE => toString x
-	  | SOME s => s
+         case global x of
+            NONE => toString x
+          | SOME s => s
 
       fun prettys (xs: Var.t vector, global: Var.t -> string option) =
-	 Layout.toString (Vector.layout
-			  (fn x =>
-			   case global x of
-			      NONE => layout x
-			    | SOME s => Layout.str s)
-			  xs)
+         Layout.toString (Vector.layout
+                          (fn x =>
+                           case global x of
+                              NONE => layout x
+                            | SOME s => Layout.str s)
+                          xs)
    end
 
 structure Exp =
    struct
       datatype t =
-	 ConApp of {con: Con.t,
-		    args: Var.t vector}
+         ConApp of {con: Con.t,
+                    args: Var.t vector}
        | Const of Const.t
        | PrimApp of {prim: Type.t Prim.t,
-		     targs: Type.t vector,
-		     args: Var.t vector}
+                     targs: Type.t vector,
+                     args: Var.t vector}
        | Profile of ProfileExp.t
        | Select of {tuple: Var.t,
-		    offset: int}
+                    offset: int}
        | Tuple of Var.t vector
        | Var of Var.t
 
       val unit = Tuple (Vector.new0 ())
-	 
+         
       fun foreachVar (e, v) =
-	 let
-	    fun vs xs = Vector.foreach (xs, v)
-	 in
-	    case e of
-	       ConApp {args, ...} => vs args
-	     | Const _ => ()
-	     | PrimApp {args, ...} => vs args
-	     | Profile _ => ()
-	     | Select {tuple, ...} => v tuple
-	     | Tuple xs => vs xs
-	     | Var x => v x
-	 end
+         let
+            fun vs xs = Vector.foreach (xs, v)
+         in
+            case e of
+               ConApp {args, ...} => vs args
+             | Const _ => ()
+             | PrimApp {args, ...} => vs args
+             | Profile _ => ()
+             | Select {tuple, ...} => v tuple
+             | Tuple xs => vs xs
+             | Var x => v x
+         end
 
       fun replaceVar (e, fx) =
-	 let
-	    fun fxs xs = Vector.map (xs, fx)
-	 in
-	    case e of
-	       ConApp {con, args} => ConApp {con = con, args = fxs args}
-	     | Const _ => e
-	     | PrimApp {prim, targs, args} =>
-		  PrimApp {prim = prim, targs = targs, args = fxs args}
-	     | Profile _ => e
-	     | Select {tuple, offset} =>
-		  Select {tuple = fx tuple, offset = offset}
-	     | Tuple xs => Tuple (fxs xs)
-	     | Var x => Var (fx x)
-	 end
+         let
+            fun fxs xs = Vector.map (xs, fx)
+         in
+            case e of
+               ConApp {con, args} => ConApp {con = con, args = fxs args}
+             | Const _ => e
+             | PrimApp {prim, targs, args} =>
+                  PrimApp {prim = prim, targs = targs, args = fxs args}
+             | Profile _ => e
+             | Select {tuple, offset} =>
+                  Select {tuple = fx tuple, offset = offset}
+             | Tuple xs => Tuple (fxs xs)
+             | Var x => Var (fx x)
+         end
 
       fun layout e =
-	 let
-	    open Layout
-	 in
-	    case e of
-	       ConApp {con, args} =>
-		  seq [Con.layout con, str " ", layoutTuple args]
-	     | Const c => Const.layout c
-	     | PrimApp {prim, targs, args} =>
-		  seq [Prim.layout prim,
-		       if !Control.showTypes
-			  then if 0 = Vector.length targs
-				  then empty
-			       else Vector.layout Type.layout targs
-		       else empty,
-		       seq [str " ", layoutTuple args]]
-	     | Profile p => ProfileExp.layout p
-	     | Select {tuple, offset} =>
-		  seq [str "#", Int.layout offset, str " ",
-		       Var.layout tuple]
-	     | Tuple xs => layoutTuple xs
-	     | Var x => Var.layout x
-	 end
-	       
+         let
+            open Layout
+         in
+            case e of
+               ConApp {con, args} =>
+                  seq [Con.layout con, str " ", layoutTuple args]
+             | Const c => Const.layout c
+             | PrimApp {prim, targs, args} =>
+                  seq [Prim.layout prim,
+                       if !Control.showTypes
+                          then if 0 = Vector.length targs
+                                  then empty
+                               else Vector.layout Type.layout targs
+                       else empty,
+                       seq [str " ", layoutTuple args]]
+             | Profile p => ProfileExp.layout p
+             | Select {tuple, offset} =>
+                  seq [str "#", Int.layout offset, str " ",
+                       Var.layout tuple]
+             | Tuple xs => layoutTuple xs
+             | Var x => Var.layout x
+         end
+               
       fun maySideEffect (e: t): bool =
-	 case e of
-	    ConApp _ => false
-	  | Const _ => false
-	  | PrimApp {prim,...} => Prim.maySideEffect prim
-	  | Profile _ => false
-	  | Select _ => false
-	  | Tuple _ => false
-	  | Var _ => false
+         case e of
+            ConApp _ => false
+          | Const _ => false
+          | PrimApp {prim,...} => Prim.maySideEffect prim
+          | Profile _ => false
+          | Select _ => false
+          | Tuple _ => false
+          | Var _ => false
 
       fun varsEquals (xs, xs') = Vector.equals (xs, xs', Var.equals)
 
       fun equals (e: t, e': t): bool =
-	 case (e, e') of
-	    (ConApp {con, args}, ConApp {con = con', args = args'}) =>
-	       Con.equals (con, con') andalso varsEquals (args, args')
-	  | (Const c, Const c') => Const.equals (c, c')
-	  | (PrimApp {prim, args, ...},
-	     PrimApp {prim = prim', args = args', ...}) =>
-	       Prim.equals (prim, prim') andalso varsEquals (args, args')
-	  | (Profile p, Profile p') => ProfileExp.equals (p, p')
-	  | (Select {tuple = t, offset = i}, Select {tuple = t', offset = i'}) =>
-	       Var.equals (t, t') andalso i = i'
-	  | (Tuple xs, Tuple xs') => varsEquals (xs, xs')
-	  | (Var x, Var x') => Var.equals (x, x')
-	  | _ => false
+         case (e, e') of
+            (ConApp {con, args}, ConApp {con = con', args = args'}) =>
+               Con.equals (con, con') andalso varsEquals (args, args')
+          | (Const c, Const c') => Const.equals (c, c')
+          | (PrimApp {prim, args, ...},
+             PrimApp {prim = prim', args = args', ...}) =>
+               Prim.equals (prim, prim') andalso varsEquals (args, args')
+          | (Profile p, Profile p') => ProfileExp.equals (p, p')
+          | (Select {tuple = t, offset = i}, Select {tuple = t', offset = i'}) =>
+               Var.equals (t, t') andalso i = i'
+          | (Tuple xs, Tuple xs') => varsEquals (xs, xs')
+          | (Var x, Var x') => Var.equals (x, x')
+          | _ => false
 
       local
-	 val newHash = Random.word
-	 val primApp = newHash ()
-	 val profile = newHash ()
-	 val select = newHash ()
-	 val tuple = newHash ()
-	 fun hashVars (xs: Var.t vector, w: Word.t): Word.t =
-	    Vector.fold (xs, w, fn (x, w) => Word.xorb (w, Var.hash x))
+         val newHash = Random.word
+         val primApp = newHash ()
+         val profile = newHash ()
+         val select = newHash ()
+         val tuple = newHash ()
+         fun hashVars (xs: Var.t vector, w: Word.t): Word.t =
+            Vector.fold (xs, w, fn (x, w) => Word.xorb (w, Var.hash x))
       in
-	 val hash: t -> Word.t =
-	    fn ConApp {con, args, ...} => hashVars (args, Con.hash con)
-	     | Const c => Const.hash c
-	     | PrimApp {args, ...} => hashVars (args, primApp)
-	     | Profile p => Word.xorb (profile, ProfileExp.hash p)
-	     | Select {tuple, offset} =>
-		  Word.xorb (select, Var.hash tuple + Word.fromInt offset)
-	     | Tuple xs => hashVars (xs, tuple)
-	     | Var x => Var.hash x
+         val hash: t -> Word.t =
+            fn ConApp {con, args, ...} => hashVars (args, Con.hash con)
+             | Const c => Const.hash c
+             | PrimApp {args, ...} => hashVars (args, primApp)
+             | Profile p => Word.xorb (profile, ProfileExp.hash p)
+             | Select {tuple, offset} =>
+                  Word.xorb (select, Var.hash tuple + Word.fromInt offset)
+             | Tuple xs => hashVars (xs, tuple)
+             | Var x => Var.hash x
       end
 
-      val hash = Trace.trace ("Exp.hash", layout, Word.layout) hash
+      val hash = Trace.trace ("SsaTree.Exp.hash", layout, Word.layout) hash
 
       val toString = Layout.toString o layout
 
       fun toPretty (e: t, global: Var.t -> string option): string =
-	 case e of
-	    ConApp {con, args} =>
-	       concat [Con.toString con, " ", Var.prettys (args, global)]
-	  | Const c => Const.toString c
-	  | PrimApp {prim, args, ...} =>
-	       Layout.toString
-	       (Prim.layoutApp (prim, args, fn x =>
-				case global x of
-				   NONE => Var.layout x
-				 | SOME s => Layout.str s))
-	  | Profile p => ProfileExp.toString p
-	  | Select {tuple, offset} =>
-	       concat ["#", Int.toString offset, " ", Var.toString tuple]
-	  | Tuple xs => Var.prettys (xs, global)
-	  | Var x => Var.toString x
+         case e of
+            ConApp {con, args} =>
+               concat [Con.toString con, " ", Var.prettys (args, global)]
+          | Const c => Const.toString c
+          | PrimApp {prim, args, ...} =>
+               Layout.toString
+               (Prim.layoutApp (prim, args, fn x =>
+                                case global x of
+                                   NONE => Var.layout x
+                                 | SOME s => Layout.str s))
+          | Profile p => ProfileExp.toString p
+          | Select {tuple, offset} =>
+               concat ["#", Int.toString offset, " ", Var.toString tuple]
+          | Tuple xs => Var.prettys (xs, global)
+          | Var x => Var.toString x
 
       val isProfile =
-	 fn Profile _ => true
-	  | _ => false
+         fn Profile _ => true
+          | _ => false
    end
 datatype z = datatype Exp.t
 
 structure Statement =
    struct
       datatype t = T of {var: Var.t option,
-			 ty: Type.t,
-			 exp: Exp.t}
+                         ty: Type.t,
+                         exp: Exp.t}
 
       local
-	 fun make f (T r) = f r
+         fun make f (T r) = f r
       in
-	 val var = make #var
-	 val exp = make #exp
+         val var = make #var
+         val exp = make #exp
       end
 
       fun layout (T {var, ty, exp}) =
-	 let
-	    open Layout
-	 in
-	    seq [seq [case var of
-			 NONE => empty
-		       | SOME var =>
-			    seq [Var.layout var,
-				 if !Control.showTypes
-				    then seq [str ": ", Type.layout ty]
-				 else empty,
-				 str " = "]],
+         let
+            open Layout
+         in
+            seq [seq [case var of
+                         NONE => empty
+                       | SOME var =>
+                            seq [Var.layout var,
+                                 if !Control.showTypes
+                                    then seq [str ": ", Type.layout ty]
+                                 else empty,
+                                 str " = "]],
                  Exp.layout exp]
-	 end
+         end
 
       fun equals (T {exp = e, ty = t, var = v},
-		  T {exp = e', ty = t', var = v'}): bool =
-	 Option.equals (v, v', Var.equals)
-	 andalso Type.equals (t, t')
-	 andalso Exp.equals (e, e')
+                  T {exp = e', ty = t', var = v'}): bool =
+         Option.equals (v, v', Var.equals)
+         andalso Type.equals (t, t')
+         andalso Exp.equals (e, e')
 
       local
-	 fun make f x =
-	    T {var = NONE,
-	       ty = Type.unit,
-	       exp = f x}
+         fun make f x =
+            T {var = NONE,
+               ty = Type.unit,
+               exp = f x}
       in
-	 val profile = make Exp.Profile
+         val profile = make Exp.Profile
       end
 
       fun clear s = Option.app (var s, Var.clear)
 
       fun prettifyGlobals (v: t vector): Var.t -> string option =
-	 let
-	    val {get = global: Var.t -> string option, set = setGlobal, ...} =
-	       Property.getSet (Var.plist, Property.initConst NONE)
-	    val _ = 
-	       Vector.foreach
-	       (v, fn T {var, exp, ...} =>
-		Option.app
-		(var, fn var =>
-		 let
-		    fun set s =
-		       let
-			  val maxSize = 10
-			  val s = 
-			     if String.size s > maxSize
-				then concat [String.prefix (s, maxSize), "..."]
-			     else s
-		       in
-			  setGlobal (var, SOME s)
-		       end
-		 in
-		    case exp of
-		       Const c => set (Layout.toString (Const.layout c))
-		     | ConApp {con, args, ...} =>
-			  if Vector.isEmpty args
-			     then set (Con.toString con)
-			  else set (concat [Con.toString con, "(...)"])
-		     | _ => ()
-		 end))
-	 in
-	    global
-	 end
+         let
+            val {get = global: Var.t -> string option, set = setGlobal, ...} =
+               Property.getSet (Var.plist, Property.initConst NONE)
+            val _ = 
+               Vector.foreach
+               (v, fn T {var, exp, ...} =>
+                Option.app
+                (var, fn var =>
+                 let
+                    fun set s =
+                       let
+                          val maxSize = 10
+                          val s = 
+                             if String.size s > maxSize
+                                then concat [String.prefix (s, maxSize), "..."]
+                             else s
+                       in
+                          setGlobal (var, SOME s)
+                       end
+                 in
+                    case exp of
+                       Const c => set (Layout.toString (Const.layout c))
+                     | ConApp {con, args, ...} =>
+                          if Vector.isEmpty args
+                             then set (Con.toString con)
+                          else set (concat [Con.toString con, "(...)"])
+                     | _ => ()
+                 end))
+         in
+            global
+         end
    end
 
 structure Handler =
@@ -423,51 +424,51 @@
       structure Label = Label
 
       datatype t =
-	 Caller
+         Caller
        | Dead
        | Handle of Label.t
 
       fun layout (h: t): Layout.t =
-	 let
-	    open Layout
-	 in
-	    case h of
-	       Caller => str "Caller"
-	     | Dead => str "Dead"
-	     | Handle l => seq [str "Handle ", Label.layout l]
-	 end
+         let
+            open Layout
+         in
+            case h of
+               Caller => str "Caller"
+             | Dead => str "Dead"
+             | Handle l => seq [str "Handle ", Label.layout l]
+         end
 
       val equals =
-	 fn (Caller, Caller) => true
-	  | (Dead, Dead) => true
-	  | (Handle l, Handle l') => Label.equals (l, l')
-	  | _ => false
+         fn (Caller, Caller) => true
+          | (Dead, Dead) => true
+          | (Handle l, Handle l') => Label.equals (l, l')
+          | _ => false
 
       fun foldLabel (h: t, a: 'a, f: Label.t * 'a -> 'a): 'a =
-	 case h of
-	    Caller => a
-	  | Dead => a
-	  | Handle l => f (l, a)
+         case h of
+            Caller => a
+          | Dead => a
+          | Handle l => f (l, a)
 
       fun foreachLabel (h, f) = foldLabel (h, (), f o #1)
 
       fun map (h, f) =
-	 case h of
-	    Caller => Caller
-	  | Dead => Dead
-	  | Handle l => Handle (f l)
+         case h of
+            Caller => Caller
+          | Dead => Dead
+          | Handle l => Handle (f l)
 
       local
-	 val newHash = Random.word
-	 val caller = newHash ()
-	 val dead = newHash ()
-	 val handlee = newHash ()
+         val newHash = Random.word
+         val caller = newHash ()
+         val dead = newHash ()
+         val handlee = newHash ()
       in
-	 fun hash (h: t): word =
-	    case h of
-	       Caller => caller
-	     | Dead => dead
-	     | Handle l => Word.xorb (handlee, Label.hash l)
+         fun hash (h: t): word =
+            case h of
+               Caller => caller
+             | Dead => dead
+             | Handle l => Word.xorb (handlee, Label.hash l)
       end
    end
 
@@ -477,86 +478,86 @@
       structure Handler = Handler
 
       datatype t =
-	 Dead
+         Dead
        | NonTail of {cont: Label.t,
-		     handler: Handler.t}
+                     handler: Handler.t}
        | Tail
 
       fun layout r =
-	 let
-	    open Layout
-	 in
-	    case r of
-	       Dead => str "Dead"
-	     | NonTail {cont, handler} =>
-		  seq [str "NonTail ",
-		       Layout.record
-		       [("cont", Label.layout cont),
-			("handler", Handler.layout handler)]]
-	     | Tail => str "Tail"
-	 end
+         let
+            open Layout
+         in
+            case r of
+               Dead => str "Dead"
+             | NonTail {cont, handler} =>
+                  seq [str "NonTail ",
+                       Layout.record
+                       [("cont", Label.layout cont),
+                        ("handler", Handler.layout handler)]]
+             | Tail => str "Tail"
+         end
 
       fun equals (r, r'): bool =
-	 case (r, r') of
-	    (Dead, Dead) => true
-	  | (NonTail {cont = c, handler = h},
-	     NonTail {cont = c', handler = h'}) =>
-	       Label.equals (c, c') andalso Handler.equals (h, h')
-	   | (Tail, Tail) => true
-	   | _ => false
+         case (r, r') of
+            (Dead, Dead) => true
+          | (NonTail {cont = c, handler = h},
+             NonTail {cont = c', handler = h'}) =>
+               Label.equals (c, c') andalso Handler.equals (h, h')
+           | (Tail, Tail) => true
+           | _ => false
 
       fun foldLabel (r: t, a, f) =
-	 case r of
-	    Dead => a
-	  | NonTail {cont, handler} =>
-	       Handler.foldLabel (handler, f (cont, a), f)
-	  | Tail => a
+         case r of
+            Dead => a
+          | NonTail {cont, handler} =>
+               Handler.foldLabel (handler, f (cont, a), f)
+          | Tail => a
 
       fun foreachLabel (r, f) = foldLabel (r, (), f o #1)
 
       fun foreachHandler (r, f) =
-	 case r of
-	    Dead => ()
-	  | NonTail {handler, ...} => Handler.foreachLabel (handler, f)
-	  | Tail => ()
+         case r of
+            Dead => ()
+          | NonTail {handler, ...} => Handler.foreachLabel (handler, f)
+          | Tail => ()
 
       fun map (r, f) =
-	 case r of
-	    Dead => Dead
-	  | NonTail {cont, handler} =>
-	       NonTail {cont = f cont,
-			handler = Handler.map (handler, f)}
-	  | Tail => Tail
+         case r of
+            Dead => Dead
+          | NonTail {cont, handler} =>
+               NonTail {cont = f cont,
+                        handler = Handler.map (handler, f)}
+          | Tail => Tail
 
       fun compose (r, r') =
-	 case r' of
-	    Dead => Dead
-	  | NonTail {cont, handler} =>
-	       NonTail
-	       {cont = cont,
-		handler = (case handler of
-			      Handler.Caller =>
-				 (case r of
-				     Dead => Handler.Caller
-				   | NonTail {handler, ...} => handler
-				   | Tail => Handler.Caller)
-			    | Handler.Dead => handler
-			    | Handler.Handle _ => handler)}
-	  | Tail => r
+         case r' of
+            Dead => Dead
+          | NonTail {cont, handler} =>
+               NonTail
+               {cont = cont,
+                handler = (case handler of
+                              Handler.Caller =>
+                                 (case r of
+                                     Dead => Handler.Caller
+                                   | NonTail {handler, ...} => handler
+                                   | Tail => Handler.Caller)
+                            | Handler.Dead => handler
+                            | Handler.Handle _ => handler)}
+          | Tail => r
 
       local
-	 val newHash = Random.word
-	 val dead = newHash ()
-	 val nonTail = newHash ()
-	 val tail = newHash ()
+         val newHash = Random.word
+         val dead = newHash ()
+         val nonTail = newHash ()
+         val tail = newHash ()
       in
-	 fun hash r =
-	    case r of
-	       Dead => dead
-	     | NonTail {cont, handler} =>
-		  Word.xorb (Word.xorb (nonTail, Label.hash cont),
-			     Handler.hash handler)
-	     | Tail => tail
+         fun hash r =
+            case r of
+               Dead => dead
+             | NonTail {cont, handler} =>
+                  Word.xorb (Word.xorb (nonTail, Label.hash cont),
+                             Handler.hash handler)
+             | Tail => tail
       end
    end
 
@@ -564,219 +565,219 @@
    struct
       datatype t =
          Arith of {prim: Type.t Prim.t,
-		   args: Var.t vector,
-		   overflow: Label.t, (* Must be nullary. *)
-		   success: Label.t, (* Must be unary. *)
-		   ty: Type.t}
+                   args: Var.t vector,
+                   overflow: Label.t, (* Must be nullary. *)
+                   success: Label.t, (* Must be unary. *)
+                   ty: Type.t}
        | Bug (* MLton thought control couldn't reach here. *)
        | Call of {args: Var.t vector,
-		  func: Func.t,
-		  return: Return.t}
+                  func: Func.t,
+                  return: Return.t}
        | Case of {test: Var.t,
-		  cases: Cases.t,
-		  default: Label.t option} (* Must be nullary. *)
+                  cases: Cases.t,
+                  default: Label.t option} (* Must be nullary. *)
        | Goto of {dst: Label.t,
-		  args: Var.t vector}
+                  args: Var.t vector}
        | Raise of Var.t vector
        | Return of Var.t vector
        | Runtime of {prim: Type.t Prim.t,
-		     args: Var.t vector,
-		     return: Label.t} (* Must be nullary. *)
+                     args: Var.t vector,
+                     return: Label.t} (* Must be nullary. *)
 
       fun iff (test: Var.t, {truee, falsee}) =
-	 let
-	    val s = WordSize.fromBits (Bits.fromInt 32)
-	 in
-	    Case {cases = Cases.Word (s, Vector.new2 ((WordX.zero s, falsee),
-						      (WordX.one s, truee))),
-		  default = NONE,
-		  test = test}
-	 end
-	 
-      fun foreachFuncLabelVar (t, func, label: Label.t -> unit, var) =
-	 let
-	    fun vars xs = Vector.foreach (xs, var)
-	 in
-	    case t of
-	       Arith {args, overflow, success, ...} =>
-		  (vars args
-		   ; label overflow 
-		   ; label success)
-	     | Bug => ()
-	     | Call {func = f, args, return, ...} =>
-		  (func f
-		   ; Return.foreachLabel (return, label)
-		   ; vars args)
-	     | Case {test, cases, default, ...} =>
-		  (var test
-		   ; Cases.foreach (cases, label)
-		   ; Option.app (default, label))
-	     | Goto {dst, args, ...} => (vars args; label dst)
-	     | Raise xs => vars xs
-	     | Return xs => vars xs
-	     | Runtime {args, return, ...} =>
-		  (vars args
-		   ; label return)
-	 end
+         let
+            val s = WordSize.fromBits (Bits.fromInt 32)
+         in
+            Case {cases = Cases.Word (s, Vector.new2 ((WordX.zero s, falsee),
+                                                      (WordX.one s, truee))),
+                  default = NONE,
+                  test = test}
+         end
+         
+      fun foreachFuncLabelVar (t, func: Func.t -> unit, label: Label.t -> unit, var) =
+         let
+            fun vars xs = Vector.foreach (xs, var)
+         in
+            case t of
+               Arith {args, overflow, success, ...} =>
+                  (vars args
+                   ; label overflow 
+                   ; label success)
+             | Bug => ()
+             | Call {func = f, args, return, ...} =>
+                  (func f
+                   ; Return.foreachLabel (return, label)
+                   ; vars args)
+             | Case {test, cases, default, ...} =>
+                  (var test
+                   ; Cases.foreach (cases, label)
+                   ; Option.app (default, label))
+             | Goto {dst, args, ...} => (vars args; label dst)
+             | Raise xs => vars xs
+             | Return xs => vars xs
+             | Runtime {args, return, ...} =>
+                  (vars args
+                   ; label return)
+         end
 
       fun foreachFunc (t, func) =
-	 foreachFuncLabelVar (t, func, fn _ => (), fn _ => ())
+         foreachFuncLabelVar (t, func, fn _ => (), fn _ => ())
 
       fun foreachLabelVar (t, label, var) =
-	 foreachFuncLabelVar (t, fn _ => (), label, var)
-	 
+         foreachFuncLabelVar (t, fn _ => (), label, var)
+         
       fun foreachLabel (t, j) = foreachLabelVar (t, j, fn _ => ())
       fun foreachVar (t, v) = foreachLabelVar (t, fn _ => (), v)
 
       fun replaceLabelVar (t, fl, fx) =
-	 let
-	    fun fxs xs = Vector.map (xs, fx)
-	 in
-	    case t of
-	       Arith {prim, args, overflow, success, ty} =>
-		  Arith {prim = prim,
-			 args = fxs args,
-			 overflow = fl overflow,
-			 success = fl success,
-			 ty = ty}
-	     | Bug => Bug
-	     | Call {func, args, return} =>
-		  Call {func = func, 
-			args = fxs args,
-			return = Return.map (return, fl)}
-	     | Case {test, cases, default} =>
-		  Case {test = fx test, 
-			cases = Cases.map(cases, fl),
-			default = Option.map(default, fl)}
-	     | Goto {dst, args} => 
-		  Goto {dst = fl dst, 
-			args = fxs args}
-	     | Raise xs => Raise (fxs xs)
-	     | Return xs => Return (fxs xs)
-	     | Runtime {prim, args, return} =>
-		  Runtime {prim = prim,
-			   args = fxs args,
-			   return = fl return}
-	 end
+         let
+            fun fxs xs = Vector.map (xs, fx)
+         in
+            case t of
+               Arith {prim, args, overflow, success, ty} =>
+                  Arith {prim = prim,
+                         args = fxs args,
+                         overflow = fl overflow,
+                         success = fl success,
+                         ty = ty}
+             | Bug => Bug
+             | Call {func, args, return} =>
+                  Call {func = func, 
+                        args = fxs args,
+                        return = Return.map (return, fl)}
+             | Case {test, cases, default} =>
+                  Case {test = fx test, 
+                        cases = Cases.map(cases, fl),
+                        default = Option.map(default, fl)}
+             | Goto {dst, args} => 
+                  Goto {dst = fl dst, 
+                        args = fxs args}
+             | Raise xs => Raise (fxs xs)
+             | Return xs => Return (fxs xs)
+             | Runtime {prim, args, return} =>
+                  Runtime {prim = prim,
+                           args = fxs args,
+                           return = fl return}
+         end
 
       fun replaceLabel (t, f) = replaceLabelVar (t, f, fn x => x)
       fun replaceVar (t, f) = replaceLabelVar (t, fn l => l, f)
 
       local open Layout
       in
-	 fun layoutCase {test, cases, default} =
-	    let
-	       fun doit (l, layout) =
-		  Vector.toListMap
-		  (l, fn (i, l) =>
-		   seq [layout i, str " => ", Label.layout l])
-	       datatype z = datatype Cases.t
-	       val cases =
-		  case cases of
-		     Con l => doit (l, Con.layout)
-		   | Word (_, l) => doit (l, WordX.layout)
-	       val cases =
-		  case default of
-		     NONE => cases
-		   | SOME j =>
-			cases @ [seq [str "_ => ", Label.layout j]]
-	    in
-	       align [seq [str "case ", Var.layout test, str " of"],
-		      indent (alignPrefix (cases, "| "), 2)]
-	    end
+         fun layoutCase {test, cases, default} =
+            let
+               fun doit (l, layout) =
+                  Vector.toListMap
+                  (l, fn (i, l) =>
+                   seq [layout i, str " => ", Label.layout l])
+               datatype z = datatype Cases.t
+               val cases =
+                  case cases of
+                     Con l => doit (l, Con.layout)
+                   | Word (_, l) => doit (l, WordX.layout)
+               val cases =
+                  case default of
+                     NONE => cases
+                   | SOME j =>
+                        cases @ [seq [str "_ => ", Label.layout j]]
+            in
+               align [seq [str "case ", Var.layout test, str " of"],
+                      indent (alignPrefix (cases, "| "), 2)]
+            end
 
-	 val layout =
-	    fn Arith {prim, args, overflow, success, ...} =>
-		  seq [Label.layout success, str " ",
-		       tuple [Prim.layoutApp (prim, args, Var.layout)],
-		       str " Overflow => ",
-		       Label.layout overflow, str " ()"]
-	     | Bug => str "Bug"
-	     | Call {func, args, return} =>
-		  seq [Func.layout func, str " ", layoutTuple args,
-		       str " ", Return.layout return]
-	     | Case arg => layoutCase arg
-	     | Goto {dst, args} =>
-		  seq [Label.layout dst, str " ", layoutTuple args]
-	     | Raise xs => seq [str "raise ", layoutTuple xs]
-	     | Return xs =>
-		  seq [str "return ",
-		       if 1 = Vector.length xs
-			  then Var.layout (Vector.sub (xs, 0))
-		       else layoutTuple xs]
-	     | Runtime {prim, args, return} =>
-		  seq [Label.layout return, str " ", 
-		       tuple [Prim.layoutApp (prim, args, Var.layout)]]
+         val layout =
+            fn Arith {prim, args, overflow, success, ...} =>
+                  seq [Label.layout success, str " ",
+                       tuple [Prim.layoutApp (prim, args, Var.layout)],
+                       str " Overflow => ",
+                       Label.layout overflow, str " ()"]
+             | Bug => str "Bug"
+             | Call {func, args, return} =>
+                  seq [Func.layout func, str " ", layoutTuple args,
+                       str " ", Return.layout return]
+             | Case arg => layoutCase arg
+             | Goto {dst, args} =>
+                  seq [Label.layout dst, str " ", layoutTuple args]
+             | Raise xs => seq [str "raise ", layoutTuple xs]
+             | Return xs =>
+                  seq [str "return ",
+                       if 1 = Vector.length xs
+                          then Var.layout (Vector.sub (xs, 0))
+                       else layoutTuple xs]
+             | Runtime {prim, args, return} =>
+                  seq [Label.layout return, str " ", 
+                       tuple [Prim.layoutApp (prim, args, Var.layout)]]
       end
 
       fun varsEquals (xs, xs') = Vector.equals (xs, xs', Var.equals)
 
       fun equals (e: t, e': t): bool =
-	 case (e, e') of
-	    (Arith {prim, args, overflow, success, ...},
-	     Arith {prim = prim', args = args', 
-		    overflow = overflow', success = success', ...}) =>
-	       Prim.equals (prim, prim') andalso
-	       varsEquals (args, args') andalso
-	       Label.equals (overflow, overflow') andalso
-	       Label.equals (success, success')
-	  | (Bug, Bug) => true
-	  | (Call {func, args, return}, 
-	     Call {func = func', args = args', return = return'}) =>
-	       Func.equals (func, func') andalso
-	       varsEquals (args, args') andalso
-	       Return.equals (return, return')
-	  | (Case {test, cases, default},
-	     Case {test = test', cases = cases', default = default'}) =>
-	       Var.equals (test, test')
-	       andalso Cases.equals (cases, cases')
-	       andalso Option.equals (default, default', Label.equals)
-	  | (Goto {dst, args}, Goto {dst = dst', args = args'}) =>
-	       Label.equals (dst, dst') andalso
-	       varsEquals (args, args')
-	  | (Raise xs, Raise xs') => varsEquals (xs, xs')
-	  | (Return xs, Return xs') => varsEquals (xs, xs')
-	  | (Runtime {prim, args, return},
-	     Runtime {prim = prim', args = args', return = return'}) =>
-	       Prim.equals (prim, prim') andalso
-	       varsEquals (args, args') andalso
-	       Label.equals (return, return')
-	  | _ => false
+         case (e, e') of
+            (Arith {prim, args, overflow, success, ...},
+             Arith {prim = prim', args = args', 
+                    overflow = overflow', success = success', ...}) =>
+               Prim.equals (prim, prim') andalso
+               varsEquals (args, args') andalso
+               Label.equals (overflow, overflow') andalso
+               Label.equals (success, success')
+          | (Bug, Bug) => true
+          | (Call {func, args, return}, 
+             Call {func = func', args = args', return = return'}) =>
+               Func.equals (func, func') andalso
+               varsEquals (args, args') andalso
+               Return.equals (return, return')
+          | (Case {test, cases, default},
+             Case {test = test', cases = cases', default = default'}) =>
+               Var.equals (test, test')
+               andalso Cases.equals (cases, cases')
+               andalso Option.equals (default, default', Label.equals)
+          | (Goto {dst, args}, Goto {dst = dst', args = args'}) =>
+               Label.equals (dst, dst') andalso
+               varsEquals (args, args')
+          | (Raise xs, Raise xs') => varsEquals (xs, xs')
+          | (Return xs, Return xs') => varsEquals (xs, xs')
+          | (Runtime {prim, args, return},
+             Runtime {prim = prim', args = args', return = return'}) =>
+               Prim.equals (prim, prim') andalso
+               varsEquals (args, args') andalso
+               Label.equals (return, return')
+          | _ => false
 
       local
-	 val newHash = Random.word
-	 val bug = newHash ()
-	 val raisee = newHash ()
-	 val return = newHash ()
-	 fun hashVars (xs: Var.t vector, w: Word.t): Word.t =
-	    Vector.fold (xs, w, fn (x, w) => Word.xorb (w, Var.hash x))
-	 fun hash2 (w1: Word.t, w2: Word.t) = Word.xorb (w1, w2)
+         val newHash = Random.word
+         val bug = newHash ()
+         val raisee = newHash ()
+         val return = newHash ()
+         fun hashVars (xs: Var.t vector, w: Word.t): Word.t =
+            Vector.fold (xs, w, fn (x, w) => Word.xorb (w, Var.hash x))
+         fun hash2 (w1: Word.t, w2: Word.t) = Word.xorb (w1, w2)
       in
-	 val hash: t -> Word.t =
-	    fn Arith {args, overflow, success, ...} =>
-	          hashVars (args, hash2 (Label.hash overflow,
-					 Label.hash success))
-	     | Bug => bug
-	     | Call {func, args, return} =>
-		  hashVars (args, hash2 (Func.hash func, Return.hash return))
-	     | Case {test, cases, default} =>
-		  hash2 (Var.hash test, 
-			 Cases.fold
-			 (cases, 
-			  Option.fold
-			  (default, 0wx55555555, 
-			   fn (l, w) => 
-			   hash2 (Label.hash l, w)),
-			  fn (l, w) => 
-			  hash2 (Label.hash l, w)))
-	     | Goto {dst, args} =>
-		  hashVars (args, Label.hash dst)
-	     | Raise xs => hashVars (xs, raisee)
-	     | Return xs => hashVars (xs, return)
-	     | Runtime {args, return, ...} => hashVars (args, Label.hash return)
+         val hash: t -> Word.t =
+            fn Arith {args, overflow, success, ...} =>
+                  hashVars (args, hash2 (Label.hash overflow,
+                                         Label.hash success))
+             | Bug => bug
+             | Call {func, args, return} =>
+                  hashVars (args, hash2 (Func.hash func, Return.hash return))
+             | Case {test, cases, default} =>
+                  hash2 (Var.hash test, 
+                         Cases.fold
+                         (cases, 
+                          Option.fold
+                          (default, 0wx55555555, 
+                           fn (l, w) => 
+                           hash2 (Label.hash l, w)),
+                          fn (l, w) => 
+                          hash2 (Label.hash l, w)))
+             | Goto {dst, args} =>
+                  hashVars (args, Label.hash dst)
+             | Raise xs => hashVars (xs, raisee)
+             | Return xs => hashVars (xs, return)
+             | Runtime {args, return, ...} => hashVars (args, Label.hash return)
       end
 
-      val hash = Trace.trace ("Transfer.hash", layout, Word.layout) hash
+      val hash = Trace.trace ("SsaTree.Transfer.hash", layout, Word.layout) hash
 
    end
 datatype z = datatype Transfer.t
@@ -786,82 +787,82 @@
 in
    fun layoutFormals (xts: (Var.t * Type.t) vector) =
       Vector.layout (fn (x, t) =>
-		    seq [Var.layout x,
-			 if !Control.showTypes
-			    then seq [str ": ", Type.layout t]
-			 else empty])
+                    seq [Var.layout x,
+                         if !Control.showTypes
+                            then seq [str ": ", Type.layout t]
+                         else empty])
       xts
 end
 
 structure Block =
    struct
       datatype t =
-	 T of {args: (Var.t * Type.t) vector,
-	       label: Label.t,
-	       statements: Statement.t vector,
-	       transfer: Transfer.t}
-	 
+         T of {args: (Var.t * Type.t) vector,
+               label: Label.t,
+               statements: Statement.t vector,
+               transfer: Transfer.t}
+         
       local
-	 fun make f (T r) = f r
+         fun make f (T r) = f r
       in
-	 val args = make #args
-	 val label = make #label
-	 val statements = make #statements
-	 val transfer = make #transfer
+         val args = make #args
+         val label = make #label
+         val statements = make #statements
+         val transfer = make #transfer
       end
    
       fun layout (T {label, args, statements, transfer}) =
-	 let
-	    open Layout
-	 in
-	    align [seq [Label.layout label, str " ",
-			Vector.layout (fn (x, t) =>
-				       if !Control.showTypes
-					  then seq [Var.layout x, str ": ",
-						    Type.layout t]
-				       else Var.layout x) args],
-		   indent (align
-			   [align
-			    (Vector.toListMap (statements, Statement.layout)),
-			    Transfer.layout transfer],
-			   2)]
-	 end
+         let
+            open Layout
+         in
+            align [seq [Label.layout label, str " ",
+                        Vector.layout (fn (x, t) =>
+                                       if !Control.showTypes
+                                          then seq [Var.layout x, str ": ",
+                                                    Type.layout t]
+                                       else Var.layout x) args],
+                   indent (align
+                           [align
+                            (Vector.toListMap (statements, Statement.layout)),
+                            Transfer.layout transfer],
+                           2)]
+         end
 
       fun clear (T {label, args, statements, ...}) =
-	 (Label.clear label
-	  ; Vector.foreach (args, Var.clear o #1)
-	  ; Vector.foreach (statements, Statement.clear))
+         (Label.clear label
+          ; Vector.foreach (args, Var.clear o #1)
+          ; Vector.foreach (statements, Statement.clear))
    end
 
 structure Datatype =
    struct
       datatype t =
-	 T of {
-	       tycon: Tycon.t,
-	       cons: {con: Con.t,
-		      args: Type.t vector} vector
-	       }
+         T of {
+               tycon: Tycon.t,
+               cons: {con: Con.t,
+                      args: Type.t vector} vector
+               }
 
       fun layout (T {tycon, cons}) =
-	 let
-	    open Layout
-	 in
-	    seq [Tycon.layout tycon,
-		 str " = ",
-		 alignPrefix
-		 (Vector.toListMap
-		  (cons, fn {con, args} =>
-		   seq [Con.layout con,
-			if Vector.isEmpty args
-			   then empty
-			else seq [str " of ",
-				  Vector.layout Type.layout args]]),
-		  "| ")]
-	 end
+         let
+            open Layout
+         in
+            seq [Tycon.layout tycon,
+                 str " = ",
+                 alignPrefix
+                 (Vector.toListMap
+                  (cons, fn {con, args} =>
+                   seq [Con.layout con,
+                        if Vector.isEmpty args
+                           then empty
+                        else seq [str " of ",
+                                  Vector.layout Type.layout args]]),
+                  "| ")]
+         end
 
       fun clear (T {tycon, cons}) =
-	 (Tycon.clear tycon
-	  ; Vector.foreach (cons, Con.clear o #con))
+         (Tycon.clear tycon
+          ; Vector.foreach (cons, Con.clear o #con))
    end
 
 structure Function =
@@ -869,12 +870,12 @@
       structure CPromise = ClearablePromise
      
       type dest = {args: (Var.t * Type.t) vector,
-		   blocks: Block.t vector,
-		   mayInline: bool,
-		   name: Func.t,
-		   raises: Type.t vector option,
-		   returns: Type.t vector option,
-		   start: Label.t}
+                   blocks: Block.t vector,
+                   mayInline: bool,
+                   name: Func.t,
+                   raises: Type.t vector option,
+                   returns: Type.t vector option,
+                   start: Label.t}
 
       (* There is a messy interaction between the laziness used in controlFlow
        * and the property lists on labels because the former stores
@@ -884,611 +885,599 @@
        * the laziness when the properties are cleared.
        *)
       datatype t =
-	 T of {controlFlow:
-	       {dfsTree: unit -> Block.t Tree.t,
-		dominatorTree: unit -> Block.t Tree.t,
-		graph: unit DirectedGraph.t,
-		labelNode: Label.t -> unit DirectedGraph.Node.t,
-		nodeBlock: unit DirectedGraph.Node.t -> Block.t} CPromise.t,
-	       dest: dest}
+         T of {controlFlow:
+               {dfsTree: unit -> Block.t Tree.t,
+                dominatorTree: unit -> Block.t Tree.t,
+                graph: unit DirectedGraph.t,
+                labelNode: Label.t -> unit DirectedGraph.Node.t,
+                nodeBlock: unit DirectedGraph.Node.t -> Block.t} CPromise.t,
+               dest: dest}
 
       local
-	 fun make f (T {dest, ...}) = f dest
+         fun make f (T {dest, ...}) = f dest
       in
-	 val blocks = make #blocks
-	 val dest = make (fn d => d)
-	 val mayInline = make #mayInline
-	 val name = make #name
-	 val start = make #start
+         val blocks = make #blocks
+         val dest = make (fn d => d)
+         val mayInline = make #mayInline
+         val name = make #name
+         val start = make #start
       end
 
       fun foreachVar (f: t, fx: Var.t * Type.t -> unit): unit =
-	 let
-	    val {args, blocks, ...} = dest f
-	    val _ = Vector.foreach (args, fx)
-	    val _ =
-	       Vector.foreach
-	       (blocks, fn Block.T {args, statements, ...} =>
-		(Vector.foreach (args, fx)
-		 ; Vector.foreach (statements, fn Statement.T {var, ty, ...} => 
-				   Option.app (var, fn x => fx (x, ty)))))
-	 in
-	    ()
-	 end
+         let
+            val {args, blocks, ...} = dest f
+            val _ = Vector.foreach (args, fx)
+            val _ =
+               Vector.foreach
+               (blocks, fn Block.T {args, statements, ...} =>
+                (Vector.foreach (args, fx)
+                 ; Vector.foreach (statements, fn Statement.T {var, ty, ...} => 
+                                   Option.app (var, fn x => fx (x, ty)))))
+         in
+            ()
+         end
 
       fun controlFlow (T {controlFlow, ...}) =
-	 let
-	    val {graph, labelNode, nodeBlock, ...} = CPromise.force controlFlow
-	 in
-	    {graph = graph, labelNode = labelNode, nodeBlock = nodeBlock}
-	 end
+         let
+            val {graph, labelNode, nodeBlock, ...} = CPromise.force controlFlow
+         in
+            {graph = graph, labelNode = labelNode, nodeBlock = nodeBlock}
+         end
 
       local
-	 fun make sel =
-	    fn T {controlFlow, ...} => sel (CPromise.force controlFlow) ()
+         fun make sel =
+            fn T {controlFlow, ...} => sel (CPromise.force controlFlow) ()
       in
-	 val dominatorTree = make #dominatorTree
+         val dominatorTree = make #dominatorTree
       end
 
       fun dfs (f, v) =
-	 let
-	    val {blocks, start, ...} = dest f
-	    val numBlocks = Vector.length blocks
-	    val {get = labelIndex, set = setLabelIndex, rem, ...} =
-	       Property.getSetOnce (Label.plist,
-				    Property.initRaise ("index", Label.layout))
-	    val _ = Vector.foreachi (blocks, fn (i, Block.T {label, ...}) =>
-				     setLabelIndex (label, i))
-	    val visited = Array.array (numBlocks, false)
-	    fun visit (l: Label.t): unit =
-	       let
-		  val i = labelIndex l
-	       in
-		  if Array.sub (visited, i)
-		     then ()
-		  else
-		     let
-			val _ = Array.update (visited, i, true)
-			val b as Block.T {transfer, ...} =
-			   Vector.sub (blocks, i)
-			val v' = v b
-			val _ = Transfer.foreachLabel (transfer, visit)
-			val _ = v' ()
-		     in
-			()
-		     end
-	       end
-	    val _ = visit start
-	    val _ = Vector.foreach (blocks, rem o Block.label)
-	 in
-	    ()
-	 end
-			    
+         let
+            val {blocks, start, ...} = dest f
+            val numBlocks = Vector.length blocks
+            val {get = labelIndex, set = setLabelIndex, rem, ...} =
+               Property.getSetOnce (Label.plist,
+                                    Property.initRaise ("index", Label.layout))
+            val _ = Vector.foreachi (blocks, fn (i, Block.T {label, ...}) =>
+                                     setLabelIndex (label, i))
+            val visited = Array.array (numBlocks, false)
+            fun visit (l: Label.t): unit =
+               let
+                  val i = labelIndex l
+               in
+                  if Array.sub (visited, i)
+                     then ()
+                  else
+                     let
+                        val _ = Array.update (visited, i, true)
+                        val b as Block.T {transfer, ...} =
+                           Vector.sub (blocks, i)
+                        val v' = v b
+                        val _ = Transfer.foreachLabel (transfer, visit)
+                        val _ = v' ()
+                     in
+                        ()
+                     end
+               end
+            val _ = visit start
+            val _ = Vector.foreach (blocks, rem o Block.label)
+         in
+            ()
+         end
+                            
       local
-	 structure Graph = DirectedGraph
-	 structure Node = Graph.Node
-	 structure Edge = Graph.Edge
+         structure Graph = DirectedGraph
+         structure Node = Graph.Node
+         structure Edge = Graph.Edge
       in
-	 fun determineControlFlow ({blocks, name, start, ...}: dest) =
-	    let
-    	       open Dot
-	       val g = Graph.new ()
-	       fun newNode () = Graph.newNode g
-	       val {get = labelNode, ...} =
-		  Property.get
-		  (Label.plist, Property.initFun (fn _ => newNode ()))
-	       val {get = nodeInfo: unit Node.t -> {block: Block.t},
-		    set = setNodeInfo, ...} =
-		  Property.getSetOnce
-		  (Node.plist, Property.initRaise ("info", Node.layout))
-	       val _ =
-		  Vector.foreach
-		  (blocks, fn b as Block.T {label, transfer, ...} =>
-		   let
-		      val from = labelNode label
-		      val _ = setNodeInfo (from, {block = b})
-		      val _ =
-			 Transfer.foreachLabel
-			 (transfer, fn to =>
-			  (ignore o Graph.addEdge) 
-			  (g, {from = from, to = labelNode to}))
-		   in
-		      ()
-		   end)
-	       val root = labelNode start
-	       val dfsTree =
-		  Promise.lazy
-		  (fn () =>
-		   Graph.dfsTree (g, {root = root,
-				      nodeValue = #block o nodeInfo})
-		   handle exn => Error.bug (concat ["dfsTree: ",
-						    Func.toString name,
-						    ":",
-						    case exn
-						      of Fail s => s
-						       | _ => "???"]))
-	       val dominatorTree =
-		  Promise.lazy
-		  (fn () =>
-		   Graph.dominatorTree (g, {root = root,
-					    nodeValue = #block o nodeInfo})
-		   handle exn => Error.bug (concat ["dominatorTree: ",
-						    Func.toString name,
-						    ":",
-						    case exn
-						       of Fail s => s
-						     | _ => "???"]))
-	    in
-	       {dfsTree = dfsTree,
-		dominatorTree = dominatorTree,
-		graph = g,
-		labelNode = labelNode,
-		nodeBlock = #block o nodeInfo}
-	    end
+         fun determineControlFlow ({blocks, start, ...}: dest) =
+            let
+               open Dot
+               val g = Graph.new ()
+               fun newNode () = Graph.newNode g
+               val {get = labelNode, ...} =
+                  Property.get
+                  (Label.plist, Property.initFun (fn _ => newNode ()))
+               val {get = nodeInfo: unit Node.t -> {block: Block.t},
+                    set = setNodeInfo, ...} =
+                  Property.getSetOnce
+                  (Node.plist, Property.initRaise ("info", Node.layout))
+               val _ =
+                  Vector.foreach
+                  (blocks, fn b as Block.T {label, transfer, ...} =>
+                   let
+                      val from = labelNode label
+                      val _ = setNodeInfo (from, {block = b})
+                      val _ =
+                         Transfer.foreachLabel
+                         (transfer, fn to =>
+                          (ignore o Graph.addEdge) 
+                          (g, {from = from, to = labelNode to}))
+                   in
+                      ()
+                   end)
+               val root = labelNode start
+               val dfsTree =
+                  Promise.lazy
+                  (fn () =>
+                   Graph.dfsTree (g, {root = root,
+                                      nodeValue = #block o nodeInfo}))
+               val dominatorTree =
+                  Promise.lazy
+                  (fn () =>
+                   Graph.dominatorTree (g, {root = root,
+                                            nodeValue = #block o nodeInfo}))
+            in
+               {dfsTree = dfsTree,
+                dominatorTree = dominatorTree,
+                graph = g,
+                labelNode = labelNode,
+                nodeBlock = #block o nodeInfo}
+            end
 
-	 fun layoutDot (f, global: Var.t -> string option) =
-	    let
-	       val {name, start, blocks, ...} = dest f
-	       fun makeName (name: string,
-			     formals: (Var.t * Type.t) vector): string =
-		  concat [name, " ",
-			  let
-			     open Layout
-			  in
-			     toString
-			     (vector
-			      (Vector.map
-			       (formals, fn (var, ty) =>
-				if !Control.showTypes
-				   then seq [Var.layout var,
-					     str ": ",
-					     Type.layout ty]
-				else Var.layout var)))
-			  end]
-	       open Dot
-	       val graph = Graph.new ()
-	       val {get = nodeOptions, ...} =
-		  Property.get (Node.plist, Property.initFun (fn _ => ref []))
-	       fun setNodeText (n: unit Node.t, l): unit =
-		  List.push (nodeOptions n, NodeOption.Label l)
-	       fun newNode () = Graph.newNode graph
-	       val {destroy, get = labelNode} =
-		  Property.destGet (Label.plist,
-				    Property.initFun (fn _ => newNode ()))
-	       val {get = edgeOptions, set = setEdgeOptions, ...} =
-		  Property.getSetOnce (Edge.plist, Property.initConst [])
-	       val _ =
-		  Vector.foreach
-		  (blocks, fn Block.T {label, args, statements, transfer} =>
-		   let
-		      val from = labelNode label
-		      fun edge (to: Label.t,
-				label: string,
-				style: style): unit =
-			 let
-			    val e = Graph.addEdge (graph, {from = from,
-							   to = labelNode to})
-			    val _ = setEdgeOptions (e, [EdgeOption.label label,
-							EdgeOption.Style style])
-			 in
-			    ()
-			 end
-		      val rest =
-			 case transfer of
-			    Arith {prim, args, overflow, success, ...} =>
-			       (edge (success, "", Solid)
-				; edge (overflow, "Overflow", Dashed)
-				; [Layout.toString
-				   (Prim.layoutApp (prim, args, fn x =>
-						    Layout.str
-						    (Var.pretty (x, global))))])
-			  | Bug => ["bug"]
-			  | Call {func, args, return} =>
-			       let
-				  val f = Func.toString func
-				  val args = Var.prettys (args, global)
-				  val _ =
-				     case return of
-					Return.Dead => ()
-				      | Return.NonTail {cont, handler} =>
-					   (edge (cont, "", Dotted)
-					    ; (Handler.foreachLabel
-					       (handler, fn l =>
-						edge (l, "", Dashed))))
-				      | Return.Tail => ()
-			       in
-				  [f, " ", args]
-			       end
-			  | Case {test, cases, default, ...} =>
-			       let
-				  fun doit (v, toString) =
-				     Vector.foreach
-				     (v, fn (x, j) =>
-				      edge (j, toString x, Solid))
-				  val _ =
-				     case cases of
-					Cases.Con v => doit (v, Con.toString)
-				      | Cases.Word (_, v) =>
-					   doit (v, WordX.toString)
-				  val _ = 
-				     case default of
-					NONE => ()
-				      | SOME j =>
-					   edge (j, "default", Solid)
-			       in
-				  ["case ", Var.toString test]
-			       end
-			  | Goto {dst, args} =>
-			       (edge (dst, "", Solid)
-				; [Label.toString dst, " ",
-				   Var.prettys (args, global)])
-			  | Raise xs => ["raise ", Var.prettys (xs, global)]
-			  | Return xs => ["return ", Var.prettys (xs, global)]
-			  | Runtime {prim, args, return} =>
-			       (edge (return, "", Solid)
-				; [Layout.toString
-				   (Prim.layoutApp (prim, args, fn x =>
-						    Layout.str
-						    (Var.pretty (x, global))))])
-		      val lab =
-			 Vector.foldr
-			 (statements, [(concat rest, Left)],
-			  fn (Statement.T {var, ty, exp, ...}, ac) =>
-			  let
-			     val exp = Exp.toPretty (exp, global)
-			     val s =
-				if Type.isUnit ty
-				   then exp
-				else
-				   case var of
-				      NONE => exp
-				    | SOME var =>
-					 concat [Var.toString var,
-						 if !Control.showTypes
-						    then concat [": ",
-								 Layout.toString
-								 (Type.layout ty)]
-						 else "",
-						    " = ", exp]
-			  in
-			     (s, Left) :: ac
-			  end)
-		      val name = makeName (Label.toString label, args)
-		      val _ = setNodeText (from, (name, Left) :: lab)
-		   in
-		      ()
-		   end)
-	       val root = labelNode start
-	       val graphLayout =
-		  Graph.layoutDot
-		  (graph, fn {nodeName} => 
-		   {title = concat [Func.toString name, " control-flow graph"],
-		    options = [GraphOption.Rank (Min, [{nodeName = nodeName root}])],
-		    edgeOptions = edgeOptions,
-		    nodeOptions =
-		    fn n => let
-			       val l = ! (nodeOptions n)
-			       open NodeOption
-			    in FontColor Black :: Shape Box :: l
-			    end})
-	       fun treeLayout () =
-		  let
-		     val _ =
-			Vector.foreach
-			(blocks, fn Block.T {label, ...} =>
-			 nodeOptions (labelNode label)
-			 := [NodeOption.label (Label.toString label)])
-		     val treeLayout =
-			Tree.layoutDot
-			(Graph.dominatorTree (graph,
-					      {root = root,
-					       nodeValue = ! o nodeOptions}),
-			 {title = concat [Func.toString name, " dominator tree"],
-			  options = [],
-			  nodeOptions = fn z => z})
-		     val _ = destroy ()
-		  in
-		     treeLayout
-		  end
-	    in
-	       {graph = graphLayout,
-		tree = treeLayout}
-	    end
+         fun layoutDot (f, global: Var.t -> string option) =
+            let
+               val {name, start, blocks, ...} = dest f
+               fun makeName (name: string,
+                             formals: (Var.t * Type.t) vector): string =
+                  concat [name, " ",
+                          let
+                             open Layout
+                          in
+                             toString
+                             (vector
+                              (Vector.map
+                               (formals, fn (var, ty) =>
+                                if !Control.showTypes
+                                   then seq [Var.layout var,
+                                             str ": ",
+                                             Type.layout ty]
+                                else Var.layout var)))
+                          end]
+               open Dot
+               val graph = Graph.new ()
+               val {get = nodeOptions, ...} =
+                  Property.get (Node.plist, Property.initFun (fn _ => ref []))
+               fun setNodeText (n: unit Node.t, l): unit =
+                  List.push (nodeOptions n, NodeOption.Label l)
+               fun newNode () = Graph.newNode graph
+               val {destroy, get = labelNode} =
+                  Property.destGet (Label.plist,
+                                    Property.initFun (fn _ => newNode ()))
+               val {get = edgeOptions, set = setEdgeOptions, ...} =
+                  Property.getSetOnce (Edge.plist, Property.initConst [])
+               val _ =
+                  Vector.foreach
+                  (blocks, fn Block.T {label, args, statements, transfer} =>
+                   let
+                      val from = labelNode label
+                      fun edge (to: Label.t,
+                                label: string,
+                                style: style): unit =
+                         let
+                            val e = Graph.addEdge (graph, {from = from,
+                                                           to = labelNode to})
+                            val _ = setEdgeOptions (e, [EdgeOption.label label,
+                                                        EdgeOption.Style style])
+                         in
+                            ()
+                         end
+                      val rest =
+                         case transfer of
+                            Arith {prim, args, overflow, success, ...} =>
+                               (edge (success, "", Solid)
+                                ; edge (overflow, "Overflow", Dashed)
+                                ; [Layout.toString
+                                   (Prim.layoutApp (prim, args, fn x =>
+                                                    Layout.str
+                                                    (Var.pretty (x, global))))])
+                          | Bug => ["bug"]
+                          | Call {func, args, return} =>
+                               let
+                                  val f = Func.toString func
+                                  val args = Var.prettys (args, global)
+                                  val _ =
+                                     case return of
+                                        Return.Dead => ()
+                                      | Return.NonTail {cont, handler} =>
+                                           (edge (cont, "", Dotted)
+                                            ; (Handler.foreachLabel
+                                               (handler, fn l =>
+                                                edge (l, "", Dashed))))
+                                      | Return.Tail => ()
+                               in
+                                  [f, " ", args]
+                               end
+                          | Case {test, cases, default, ...} =>
+                               let
+                                  fun doit (v, toString) =
+                                     Vector.foreach
+                                     (v, fn (x, j) =>
+                                      edge (j, toString x, Solid))
+                                  val _ =
+                                     case cases of
+                                        Cases.Con v => doit (v, Con.toString)
+                                      | Cases.Word (_, v) =>
+                                           doit (v, WordX.toString)
+                                  val _ = 
+                                     case default of
+                                        NONE => ()
+                                      | SOME j =>
+                                           edge (j, "default", Solid)
+                               in
+                                  ["case ", Var.toString test]
+                               end
+                          | Goto {dst, args} =>
+                               (edge (dst, "", Solid)
+                                ; [Label.toString dst, " ",
+                                   Var.prettys (args, global)])
+                          | Raise xs => ["raise ", Var.prettys (xs, global)]
+                          | Return xs => ["return ", Var.prettys (xs, global)]
+                          | Runtime {prim, args, return} =>
+                               (edge (return, "", Solid)
+                                ; [Layout.toString
+                                   (Prim.layoutApp (prim, args, fn x =>
+                                                    Layout.str
+                                                    (Var.pretty (x, global))))])
+                      val lab =
+                         Vector.foldr
+                         (statements, [(concat rest, Left)],
+                          fn (Statement.T {var, ty, exp, ...}, ac) =>
+                          let
+                             val exp = Exp.toPretty (exp, global)
+                             val s =
+                                if Type.isUnit ty
+                                   then exp
+                                else
+                                   case var of
+                                      NONE => exp
+                                    | SOME var =>
+                                         concat [Var.toString var,
+                                                 if !Control.showTypes
+                                                    then concat [": ",
+                                                                 Layout.toString
+                                                                 (Type.layout ty)]
+                                                 else "",
+                                                    " = ", exp]
+                          in
+                             (s, Left) :: ac
+                          end)
+                      val name = makeName (Label.toString label, args)
+                      val _ = setNodeText (from, (name, Left) :: lab)
+                   in
+                      ()
+                   end)
+               val root = labelNode start
+               val graphLayout =
+                  Graph.layoutDot
+                  (graph, fn {nodeName} => 
+                   {title = concat [Func.toString name, " control-flow graph"],
+                    options = [GraphOption.Rank (Min, [{nodeName = nodeName root}])],
+                    edgeOptions = edgeOptions,
+                    nodeOptions =
+                    fn n => let
+                               val l = ! (nodeOptions n)
+                               open NodeOption
+                            in FontColor Black :: Shape Box :: l
+                            end})
+               fun treeLayout () =
+                  let
+                     val _ =
+                        Vector.foreach
+                        (blocks, fn Block.T {label, ...} =>
+                         nodeOptions (labelNode label)
+                         := [NodeOption.label (Label.toString label)])
+                     val treeLayout =
+                        Tree.layoutDot
+                        (Graph.dominatorTree (graph,
+                                              {root = root,
+                                               nodeValue = ! o nodeOptions}),
+                         {title = concat [Func.toString name, " dominator tree"],
+                          options = [],
+                          nodeOptions = fn z => z})
+                     val _ = destroy ()
+                  in
+                     treeLayout
+                  end
+            in
+               {graph = graphLayout,
+                tree = treeLayout}
+            end
       end
 
       fun new (dest: dest) =
-	 let
-	    val controlFlow = CPromise.delay (fn () => determineControlFlow dest)
-	 in
-	    T {controlFlow = controlFlow,
-	       dest = dest}
-	 end
+         let
+            val controlFlow = CPromise.delay (fn () => determineControlFlow dest)
+         in
+            T {controlFlow = controlFlow,
+               dest = dest}
+         end
 
       fun clear (T {controlFlow, dest, ...}) =
-	 let
-	    val {args, blocks, ...} = dest
-	    val _ = (Vector.foreach (args, Var.clear o #1)
-		     ; Vector.foreach (blocks, Block.clear))
-      	    val _ = CPromise.clear controlFlow
-	 in
-	    ()
-	 end
+         let
+            val {args, blocks, ...} = dest
+            val _ = (Vector.foreach (args, Var.clear o #1)
+                     ; Vector.foreach (blocks, Block.clear))
+            val _ = CPromise.clear controlFlow
+         in
+            ()
+         end
 
       fun layoutHeader (f: t): Layout.t =
-	 let
-	    val {args, name, raises, returns, start, ...} = dest f
-	    open Layout
-	 in
-	    seq [str "fun ",
-		 Func.layout name,
-		 str " ",
-		 layoutFormals args,
-		 if !Control.showTypes
-		    then seq [str ": ",
-			      record [("raises",
-				       Option.layout
-				       (Vector.layout Type.layout) raises),
-				      ("returns",
-				       Option.layout
-				       (Vector.layout Type.layout) returns)]]
-		 else empty,
-		    str " = ", Label.layout start, str " ()"]
-	 end
+         let
+            val {args, name, raises, returns, start, ...} = dest f
+            open Layout
+         in
+            seq [str "fun ",
+                 Func.layout name,
+                 str " ",
+                 layoutFormals args,
+                 if !Control.showTypes
+                    then seq [str ": ",
+                              record [("raises",
+                                       Option.layout
+                                       (Vector.layout Type.layout) raises),
+                                      ("returns",
+                                       Option.layout
+                                       (Vector.layout Type.layout) returns)]]
+                 else empty,
+                    str " = ", Label.layout start, str " ()"]
+         end
 
       fun layout (f: t) =
-	 let
-	    val {blocks, ...} = dest f
-	    open Layout
-	 in
-	    align [layoutHeader f,
-		   indent (align (Vector.toListMap (blocks, Block.layout)), 2)]
-	 end
+         let
+            val {blocks, ...} = dest f
+            open Layout
+         in
+            align [layoutHeader f,
+                   indent (align (Vector.toListMap (blocks, Block.layout)), 2)]
+         end
       
       fun layouts (f: t, global, output: Layout.t -> unit): unit =
-	 let
-	    val {blocks, name, ...} = dest f
-	    val _ = output (layoutHeader f)
-	    val _ = Vector.foreach (blocks, fn b =>
-				    output (Layout.indent (Block.layout b, 2)))
-	    val _ =
-	       if not (!Control.keepDot)
-		  then ()
-	       else
-		  let
-		     val {graph, tree} = layoutDot (f, global)
-		     val name = Func.toString name
-		     fun doit (s, g) =
-			let
-			   open Control
-			in
-			   saveToFile
-			   ({suffix = concat [name, ".", s, ".dot"]},
-			    Dot, (), Layout (fn () => g))
-			end
-		     val _ = doit ("cfg", graph)
-			handle _ => Error.warning "couldn't layout cfg"
-		     val _ = doit ("dom", tree ())
-			handle _ => Error.warning "couldn't layout dom"
-		  in
-		     ()
-		  end
-	 in
-	    ()
-	 end
+         let
+            val {blocks, name, ...} = dest f
+            val _ = output (layoutHeader f)
+            val _ = Vector.foreach (blocks, fn b =>
+                                    output (Layout.indent (Block.layout b, 2)))
+            val _ =
+               if not (!Control.keepDot)
+                  then ()
+               else
+                  let
+                     val {graph, tree} = layoutDot (f, global)
+                     val name = Func.toString name
+                     fun doit (s, g) =
+                        let
+                           open Control
+                        in
+                           saveToFile
+                           ({suffix = concat [name, ".", s, ".dot"]},
+                            Dot, (), Layout (fn () => g))
+                        end
+                     val _ = doit ("cfg", graph)
+                        handle _ => Error.warning "SsaTree.layouts: couldn't layout cfg"
+                     val _ = doit ("dom", tree ())
+                        handle _ => Error.warning "SsaTree.layouts: couldn't layout dom"
+                  in
+                     ()
+                  end
+         in
+            ()
+         end
 
       fun alphaRename f =
-	 let
-	    local
-	       fun make (new, plist) =
-		  let
-		     val {get, set, destroy, ...} = 
-		        Property.destGetSetOnce (plist, Property.initConst NONE)
-		     fun bind x =
-			let
-			   val x' = new x
-			   val _ = set (x, SOME x')
-			in
-			   x'
-			end
-		     fun lookup x =
-		        case get x of
-			   NONE => x
-			 | SOME y => y
-		  in (bind, lookup, destroy)
-		  end
-	    in
-	       val (bindVar, lookupVar, destroyVar) =
-		  make (Var.new, Var.plist)
-	       val (bindLabel, lookupLabel, destroyLabel) =
-		  make (Label.new, Label.plist)
-	    end
-	    val {args, blocks, mayInline, name, raises, returns, start, ...} =
-	       dest f
-	    val args = Vector.map (args, fn (x, ty) => (bindVar x, ty))
-	    val bindLabel = ignore o bindLabel
-	    val bindVar = ignore o bindVar
-	    val _ = 
-	       Vector.foreach
-	       (blocks, fn Block.T {label, args, statements, ...} => 
-		(bindLabel label
-		 ; Vector.foreach (args, fn (x, _) => bindVar x)
-		 ; Vector.foreach (statements, 
-				   fn Statement.T {var, ...} => 
-				   Option.app (var, bindVar))))
-	    val blocks = 
-	       Vector.map
-	       (blocks, fn Block.T {label, args, statements, transfer} =>
-		Block.T {label = lookupLabel label,
-			 args = Vector.map (args, fn (x, ty) =>
-					    (lookupVar x, ty)),
-			 statements = Vector.map
-			              (statements, 
-				       fn Statement.T {var, ty, exp} =>
-				       Statement.T 
-				       {var = Option.map (var, lookupVar),
-					ty = ty,
-					exp = Exp.replaceVar
-					      (exp, lookupVar)}),
-			 transfer = Transfer.replaceLabelVar
-			            (transfer, lookupLabel, lookupVar)})
-	    val start = lookupLabel start
-	    val _ = destroyVar ()
-	    val _ = destroyLabel ()
-	 in
-	    new {args = args,
-		 blocks = blocks,
-		 mayInline = mayInline,
-		 name = name,
-		 raises = raises,
-		 returns = returns,
-		 start = start}
-	 end
+         let
+            local
+               fun make (new, plist) =
+                  let
+                     val {get, set, destroy, ...} = 
+                        Property.destGetSetOnce (plist, Property.initConst NONE)
+                     fun bind x =
+                        let
+                           val x' = new x
+                           val _ = set (x, SOME x')
+                        in
+                           x'
+                        end
+                     fun lookup x =
+                        case get x of
+                           NONE => x
+                         | SOME y => y
+                  in (bind, lookup, destroy)
+                  end
+            in
+               val (bindVar, lookupVar, destroyVar) =
+                  make (Var.new, Var.plist)
+               val (bindLabel, lookupLabel, destroyLabel) =
+                  make (Label.new, Label.plist)
+            end
+            val {args, blocks, mayInline, name, raises, returns, start, ...} =
+               dest f
+            val args = Vector.map (args, fn (x, ty) => (bindVar x, ty))
+            val bindLabel = ignore o bindLabel
+            val bindVar = ignore o bindVar
+            val _ = 
+               Vector.foreach
+               (blocks, fn Block.T {label, args, statements, ...} => 
+                (bindLabel label
+                 ; Vector.foreach (args, fn (x, _) => bindVar x)
+                 ; Vector.foreach (statements, 
+                                   fn Statement.T {var, ...} => 
+                                   Option.app (var, bindVar))))
+            val blocks = 
+               Vector.map
+               (blocks, fn Block.T {label, args, statements, transfer} =>
+                Block.T {label = lookupLabel label,
+                         args = Vector.map (args, fn (x, ty) =>
+                                            (lookupVar x, ty)),
+                         statements = Vector.map
+                                      (statements, 
+                                       fn Statement.T {var, ty, exp} =>
+                                       Statement.T 
+                                       {var = Option.map (var, lookupVar),
+                                        ty = ty,
+                                        exp = Exp.replaceVar
+                                              (exp, lookupVar)}),
+                         transfer = Transfer.replaceLabelVar
+                                    (transfer, lookupLabel, lookupVar)})
+            val start = lookupLabel start
+            val _ = destroyVar ()
+            val _ = destroyLabel ()
+         in
+            new {args = args,
+                 blocks = blocks,
+                 mayInline = mayInline,
+                 name = name,
+                 raises = raises,
+                 returns = returns,
+                 start = start}
+         end
 
       fun profile (f: t, sourceInfo): t =
-	 if !Control.profile = Control.ProfileNone
-	    orelse !Control.profileIL <> Control.ProfileSource
-	    then f
-	 else 
-	 let
-	    val _ = Control.diagnostic (fn () => layout f)
-	    val {args, blocks, mayInline, name, raises, returns, start} = dest f
-	    val extraBlocks = ref []
-	    val {get = labelBlock, set = setLabelBlock, rem} =
-	       Property.getSetOnce
-	       (Label.plist, Property.initRaise ("block", Label.layout))
-	    val _ =
-	       Vector.foreach
-	       (blocks, fn block as Block.T {label, ...} =>
-		setLabelBlock (label, block))
-	    val blocks =
-	       Vector.map
-	       (blocks, fn Block.T {args, label, statements, transfer} =>
-		let
-		   fun make (exp: Exp.t): Statement.t =
-		      Statement.T {exp = exp,
-				   ty = Type.unit,
-				   var = NONE}
-		   val statements =
-		      if Label.equals (label, start)
-			 then (Vector.concat
-			       [Vector.new1
-				(make (Exp.Profile
-				       (ProfileExp.Enter sourceInfo))),
-				statements])
-		      else statements
-		   fun leave () =
-		      make (Exp.Profile (ProfileExp.Leave sourceInfo))
-		   fun prefix (l: Label.t,
-			       statements: Statement.t vector): Label.t =
-		      let
-			 val Block.T {args, ...} = labelBlock l
-			 val c = Label.newNoname ()
-			 val xs = Vector.map (args, fn (x, _) => Var.new x)
-			 val _ =
-			    List.push
-			    (extraBlocks,
-			     Block.T
-			     {args = Vector.map2 (xs, args, fn (x, (_, t)) =>
-						  (x, t)),
-			      label = c,
-			      statements = statements,
-			      transfer = Goto {args = xs,
-					       dst = l}})
-		      in
-			 c
-		      end
-		   fun genHandler (cont: Label.t)
-		      : Statement.t vector * Label.t * Handler.t =
-		      case raises of
-			 NONE => (statements, cont, Handler.Caller)
-		       | SOME ts => 
-			    let
-			       val xs = Vector.map (ts, fn _ => Var.newNoname ())
-			       val l = Label.newNoname ()
-			       val _ =
-				  List.push
-				  (extraBlocks,
-				   Block.T
-				   {args = Vector.zip (xs, ts),
-				    label = l,
-				    statements = Vector.new1 (leave ()),
-				    transfer = Transfer.Raise xs})
-			    in
-			       (statements,
-				prefix (cont, Vector.new0 ()),
-				Handler.Handle l)
-			    end
-		   fun addLeave () =
-		      (Vector.concat [statements,
-				      Vector.new1 (leave ())],
-		       transfer)
-		   val (statements, transfer) =
-		      case transfer of
-			 Call {args, func, return} =>
-			    let
-			       datatype z = datatype Return.t
-			    in
-			       case return of
-				  Dead => (statements, transfer)
-				| NonTail {cont, handler} =>
-				     (case handler of
-					 Handler.Dead => (statements, transfer)
-				       | Handler.Caller =>
-					    let
-					       val (statements, cont, handler) =
-						  genHandler cont
-					       val return =
-						  Return.NonTail
-						  {cont = cont,
-						   handler = handler}
-					    in
-					       (statements,
-						Call {args = args,
-						      func = func,
-						      return = return})
-					    end
-				       | Handler.Handle _ =>
-					    (statements, transfer))
-				| Tail => addLeave ()
-			    end
-		       | Raise _ => addLeave ()
-		       | Return _ => addLeave ()
-		       | _ => (statements, transfer)
-		in
-		   Block.T {args = args,
-			    label = label,
-			    statements = statements,
-			    transfer = transfer}
-		end)
-	    val _ = Vector.foreach (blocks, rem o Block.label)
-	    val blocks = Vector.concat [Vector.fromList (!extraBlocks), blocks]
-	    val f = 
-	       new {args = args,
-		    blocks = blocks,
-		    mayInline = mayInline,
-		    name = name,
-		    raises = raises,
-		    returns = returns,
-		    start = start}
-	    val _ = Control.diagnostic (fn () => layout f)
-	 in
-	    f
-	 end
+         if !Control.profile = Control.ProfileNone
+            orelse !Control.profileIL <> Control.ProfileSource
+            then f
+         else 
+         let
+            val _ = Control.diagnostic (fn () => layout f)
+            val {args, blocks, mayInline, name, raises, returns, start} = dest f
+            val extraBlocks = ref []
+            val {get = labelBlock, set = setLabelBlock, rem} =
+               Property.getSetOnce
+               (Label.plist, Property.initRaise ("block", Label.layout))
+            val _ =
+               Vector.foreach
+               (blocks, fn block as Block.T {label, ...} =>
+                setLabelBlock (label, block))
+            val blocks =
+               Vector.map
+               (blocks, fn Block.T {args, label, statements, transfer} =>
+                let
+                   fun make (exp: Exp.t): Statement.t =
+                      Statement.T {exp = exp,
+                                   ty = Type.unit,
+                                   var = NONE}
+                   val statements =
+                      if Label.equals (label, start)
+                         then (Vector.concat
+                               [Vector.new1
+                                (make (Exp.Profile
+                                       (ProfileExp.Enter sourceInfo))),
+                                statements])
+                      else statements
+                   fun leave () =
+                      make (Exp.Profile (ProfileExp.Leave sourceInfo))
+                   fun prefix (l: Label.t,
+                               statements: Statement.t vector): Label.t =
+                      let
+                         val Block.T {args, ...} = labelBlock l
+                         val c = Label.newNoname ()
+                         val xs = Vector.map (args, fn (x, _) => Var.new x)
+                         val _ =
+                            List.push
+                            (extraBlocks,
+                             Block.T
+                             {args = Vector.map2 (xs, args, fn (x, (_, t)) =>
+                                                  (x, t)),
+                              label = c,
+                              statements = statements,
+                              transfer = Goto {args = xs,
+                                               dst = l}})
+                      in
+                         c
+                      end
+                   fun genHandler (cont: Label.t)
+                      : Statement.t vector * Label.t * Handler.t =
+                      case raises of
+                         NONE => (statements, cont, Handler.Caller)
+                       | SOME ts => 
+                            let
+                               val xs = Vector.map (ts, fn _ => Var.newNoname ())
+                               val l = Label.newNoname ()
+                               val _ =
+                                  List.push
+                                  (extraBlocks,
+                                   Block.T
+                                   {args = Vector.zip (xs, ts),
+                                    label = l,
+                                    statements = Vector.new1 (leave ()),
+                                    transfer = Transfer.Raise xs})
+                            in
+                               (statements,
+                                prefix (cont, Vector.new0 ()),
+                                Handler.Handle l)
+                            end
+                   fun addLeave () =
+                      (Vector.concat [statements,
+                                      Vector.new1 (leave ())],
+                       transfer)
+                   val (statements, transfer) =
+                      case transfer of
+                         Call {args, func, return} =>
+                            let
+                               datatype z = datatype Return.t
+                            in
+                               case return of
+                                  Dead => (statements, transfer)
+                                | NonTail {cont, handler} =>
+                                     (case handler of
+                                         Handler.Dead => (statements, transfer)
+                                       | Handler.Caller =>
+                                            let
+                                               val (statements, cont, handler) =
+                                                  genHandler cont
+                                               val return =
+                                                  Return.NonTail
+                                                  {cont = cont,
+                                                   handler = handler}
+                                            in
+                                               (statements,
+                                                Call {args = args,
+                                                      func = func,
+                                                      return = return})
+                                            end
+                                       | Handler.Handle _ =>
+                                            (statements, transfer))
+                                | Tail => addLeave ()
+                            end
+                       | Raise _ => addLeave ()
+                       | Return _ => addLeave ()
+                       | _ => (statements, transfer)
+                in
+                   Block.T {args = args,
+                            label = label,
+                            statements = statements,
+                            transfer = transfer}
+                end)
+            val _ = Vector.foreach (blocks, rem o Block.label)
+            val blocks = Vector.concat [Vector.fromList (!extraBlocks), blocks]
+            val f = 
+               new {args = args,
+                    blocks = blocks,
+                    mayInline = mayInline,
+                    name = name,
+                    raises = raises,
+                    returns = returns,
+                    start = start}
+            val _ = Control.diagnostic (fn () => layout f)
+         in
+            f
+         end
 
       val profile =
-	 Trace.trace2 ("Ssa.Function.profile", layout, SourceInfo.layout, layout)
-	 profile
+         Trace.trace2 ("SsaTree.Function.profile", layout, SourceInfo.layout, layout)
+         profile
    end
 
 structure Program =
    struct
       datatype t =
-	 T of {
-	       datatypes: Datatype.t vector,
-	       globals: Statement.t vector,
-	       functions: Function.t list,
-	       main: Func.t
-	       }
+         T of {
+               datatypes: Datatype.t vector,
+               globals: Statement.t vector,
+               functions: Function.t list,
+               main: Func.t
+               }
    end
 
 structure Program =
@@ -1496,277 +1485,277 @@
       open Program
  
       local
-	 structure Graph = DirectedGraph
-	 structure Node = Graph.Node
-	 structure Edge = Graph.Edge
+         structure Graph = DirectedGraph
+         structure Node = Graph.Node
+         structure Edge = Graph.Edge
       in
-	 fun layoutCallGraph (T {functions, main, ...},
-			      title: string): Layout.t =
-	    let
-	       open Dot
-	       val graph = Graph.new ()
-	       val {get = nodeOptions, set = setNodeOptions, ...} =
-		  Property.getSetOnce
-		  (Node.plist, Property.initRaise ("options", Node.layout))
-	       val {get = funcNode, destroy} =
-		  Property.destGet
-		  (Func.plist, Property.initFun
-		   (fn f =>
-		    let
-		       val n = Graph.newNode graph
-		       val _ =
-			  setNodeOptions
-			  (n,
-			   let open NodeOption
-			   in [FontColor Black, label (Func.toString f)]
-			   end)
-		    in
-		       n
-		    end))
-	       val {get = edgeOptions, set = setEdgeOptions, ...} =
-		  Property.getSetOnce (Edge.plist, Property.initConst [])
-	       val _ =
-		  List.foreach
-		  (functions, fn f =>
-		   let
-		      val {name, blocks, ...} = Function.dest f
-		      val from = funcNode name
-		      val {get, destroy} =
-			 Property.destGet
-			 (Node.plist,
-			  Property.initFun (fn _ => {nontail = ref false,
-						     tail = ref false}))
-		      val _ = 
-			 Vector.foreach
-			 (blocks, fn Block.T {transfer, ...} =>
-			  case transfer of
-			     Call {func, return, ...} =>
-				let
-				   val to = funcNode func
-				   val {tail, nontail} = get to
-				   datatype z = datatype Return.t
-				   val is =
-				      case return of
-					 Dead => false
-				       | NonTail _ => true
-				       | Tail => false
-				   val r = if is then nontail else tail
-				in
-				   if !r
-				      then ()
-				   else (r := true
-					 ; (setEdgeOptions
-					    (Graph.addEdge
-					     (graph, {from = from, to = to}),
-					     if is
-						then []
-					     else [EdgeOption.Style Dotted])))
-				end
-			   | _ => ())
-		      val _ = destroy ()
-		   in
-		      ()
-		   end)
-	       val root = funcNode main
-	       val l =
-		  Graph.layoutDot
-		  (graph, fn {nodeName} =>
-		   {title = title,
-		    options = [GraphOption.Rank (Min, [{nodeName = nodeName root}])],
-		    edgeOptions = edgeOptions,
-		    nodeOptions = nodeOptions})
-	       val _ = destroy ()
-	    in
-	       l
-	    end
+         fun layoutCallGraph (T {functions, main, ...},
+                              title: string): Layout.t =
+            let
+               open Dot
+               val graph = Graph.new ()
+               val {get = nodeOptions, set = setNodeOptions, ...} =
+                  Property.getSetOnce
+                  (Node.plist, Property.initRaise ("options", Node.layout))
+               val {get = funcNode, destroy} =
+                  Property.destGet
+                  (Func.plist, Property.initFun
+                   (fn f =>
+                    let
+                       val n = Graph.newNode graph
+                       val _ =
+                          setNodeOptions
+                          (n,
+                           let open NodeOption
+                           in [FontColor Black, label (Func.toString f)]
+                           end)
+                    in
+                       n
+                    end))
+               val {get = edgeOptions, set = setEdgeOptions, ...} =
+                  Property.getSetOnce (Edge.plist, Property.initConst [])
+               val _ =
+                  List.foreach
+                  (functions, fn f =>
+                   let
+                      val {name, blocks, ...} = Function.dest f
+                      val from = funcNode name
+                      val {get, destroy} =
+                         Property.destGet
+                         (Node.plist,
+                          Property.initFun (fn _ => {nontail = ref false,
+                                                     tail = ref false}))
+                      val _ = 
+                         Vector.foreach
+                         (blocks, fn Block.T {transfer, ...} =>
+                          case transfer of
+                             Call {func, return, ...} =>
+                                let
+                                   val to = funcNode func
+                                   val {tail, nontail} = get to
+                                   datatype z = datatype Return.t
+                                   val is =
+                                      case return of
+                                         Dead => false
+                                       | NonTail _ => true
+                                       | Tail => false
+                                   val r = if is then nontail else tail
+                                in
+                                   if !r
+                                      then ()
+                                   else (r := true
+                                         ; (setEdgeOptions
+                                            (Graph.addEdge
+                                             (graph, {from = from, to = to}),
+                                             if is
+                                                then []
+                                             else [EdgeOption.Style Dotted])))
+                                end
+                           | _ => ())
+                      val _ = destroy ()
+                   in
+                      ()
+                   end)
+               val root = funcNode main
+               val l =
+                  Graph.layoutDot
+                  (graph, fn {nodeName} =>
+                   {title = title,
+                    options = [GraphOption.Rank (Min, [{nodeName = nodeName root}])],
+                    edgeOptions = edgeOptions,
+                    nodeOptions = nodeOptions})
+               val _ = destroy ()
+            in
+               l
+            end
       end
-	 
+         
       fun layouts (p as T {datatypes, globals, functions, main},
-		   output': Layout.t -> unit) =
-	 let
-	    val global = Statement.prettifyGlobals globals
-	    open Layout
-	    (* Layout includes an output function, so we need to rebind output
-	     * to the one above.
-	     *)
-	    val output = output' 
-	 in
-	    output (str "\n\nDatatypes:")
-	    ; Vector.foreach (datatypes, output o Datatype.layout)
-	    ; output (str "\n\nGlobals:")
-	    ; Vector.foreach (globals, output o Statement.layout)
-	    ; output (seq [str "\n\nMain: ", Func.layout main])
-	    ; output (str "\n\nFunctions:")
-	    ; List.foreach (functions, fn f =>
-			    Function.layouts (f, global, output))
-	    ; if not (!Control.keepDot)
-		 then ()
-	      else
-		 let
-		    open Control
-		 in
-		    saveToFile
-		    ({suffix = "call-graph.dot"},
-		     Dot, (), Layout (fn () =>
-				      layoutCallGraph (p, !Control.inputFile)))
-		 end
-	 end
+                   output': Layout.t -> unit) =
+         let
+            val global = Statement.prettifyGlobals globals
+            open Layout
+            (* Layout includes an output function, so we need to rebind output
+             * to the one above.
+             *)
+            val output = output' 
+         in
+            output (str "\n\nDatatypes:")
+            ; Vector.foreach (datatypes, output o Datatype.layout)
+            ; output (str "\n\nGlobals:")
+            ; Vector.foreach (globals, output o Statement.layout)
+            ; output (seq [str "\n\nMain: ", Func.layout main])
+            ; output (str "\n\nFunctions:")
+            ; List.foreach (functions, fn f =>
+                            Function.layouts (f, global, output))
+            ; if not (!Control.keepDot)
+                 then ()
+              else
+                 let
+                    open Control
+                 in
+                    saveToFile
+                    ({suffix = "call-graph.dot"},
+                     Dot, (), Layout (fn () =>
+                                      layoutCallGraph (p, !Control.inputFile)))
+                 end
+         end
 
       fun layoutStats (T {globals, functions, main, ...}) =
-	 let
-	    open Layout
-	    val mainInfo =
-	       case List.peek (functions, fn f =>
-			       Func.equals (main, Function.name f)) of
-		  NONE => Error.bug "no main"
-		| SOME f =>
-		     let
-			val numVars = ref 0
-			val _ = Function.foreachVar (f, fn _ => Int.inc numVars)
-			val {blocks, ...} = Function.dest f
-			val numBlocks = Vector.length blocks
-		     in
-			align [seq [str "main num vars: ",
-				    Int.layout (!numVars)],
-			       seq [str "main num blocks: ",
-				    Int.layout numBlocks]]
-		     end
-	    val numTypes = ref 0
-	    fun inc _ = Int.inc numTypes
-	    val {hom = countType, destroy} =
-	       Type.makeHom
-	       {var = fn _ => Error.bug "ssa-tree saw var",
-		con = inc}
-	    val numStatements = ref (Vector.length globals)
-	    val numBlocks = ref 0
-	    val _ =
-	       List.foreach
-	       (functions, fn f =>
-		let
-		   val {args, blocks, ...} = Function.dest f
-		in
-		   Vector.foreach (args, countType o #2)
-		   ; (Vector.foreach
-		      (blocks, fn Block.T {statements, ...} =>
-		       (Int.inc numBlocks
-			; (Vector.foreach
-			   (statements, fn Statement.T {ty, ...} =>
-			    (countType ty
-			     ; Int.inc numStatements))))))
-		end)
-	    val numFunctions = List.length functions
-	    val _ = destroy ()
-	 in
-	    align
-	    [align (List.map
-		    ([("num functions", Int.layout numFunctions),
-		      ("num blocks", Int.layout (!numBlocks)),
-		      ("num statements", Int.layout (!numStatements))],
-		     fn (name, value) => seq [str (name ^ " "), value])),
-	     mainInfo]
-	 end
+         let
+            open Layout
+            val mainInfo =
+               case List.peek (functions, fn f =>
+                               Func.equals (main, Function.name f)) of
+                  NONE => Error.bug "SsaTree.Program.layoutStats: no main"
+                | SOME f =>
+                     let
+                        val numVars = ref 0
+                        val _ = Function.foreachVar (f, fn _ => Int.inc numVars)
+                        val {blocks, ...} = Function.dest f
+                        val numBlocks = Vector.length blocks
+                     in
+                        align [seq [str "main num vars: ",
+                                    Int.layout (!numVars)],
+                               seq [str "main num blocks: ",
+                                    Int.layout numBlocks]]
+                     end
+            val numTypes = ref 0
+            fun inc _ = Int.inc numTypes
+            val {hom = countType, destroy} =
+               Type.makeHom
+               {var = fn _ => Error.bug "SsaTree.Program.layoutStats: saw var",
+                con = inc}
+            val numStatements = ref (Vector.length globals)
+            val numBlocks = ref 0
+            val _ =
+               List.foreach
+               (functions, fn f =>
+                let
+                   val {args, blocks, ...} = Function.dest f
+                in
+                   Vector.foreach (args, countType o #2)
+                   ; (Vector.foreach
+                      (blocks, fn Block.T {statements, ...} =>
+                       (Int.inc numBlocks
+                        ; (Vector.foreach
+                           (statements, fn Statement.T {ty, ...} =>
+                            (countType ty
+                             ; Int.inc numStatements))))))
+                end)
+            val numFunctions = List.length functions
+            val _ = destroy ()
+         in
+            align
+            [align (List.map
+                    ([("num functions", Int.layout numFunctions),
+                      ("num blocks", Int.layout (!numBlocks)),
+                      ("num statements", Int.layout (!numStatements))],
+                     fn (name, value) => seq [str (name ^ " "), value])),
+             mainInfo]
+         end
 
       (* clear all property lists reachable from program *)
       fun clear (T {datatypes, globals, functions, ...}) =
-	 ((* Can't do Type.clear because it clears out the info needed for
-	   * Type.dest.
-	   *)
-	  Vector.foreach (datatypes, Datatype.clear)
-	  ; Vector.foreach (globals, Statement.clear)
-	  ; List.foreach (functions, Function.clear))
+         ((* Can't do Type.clear because it clears out the info needed for
+           * Type.dest.
+           *)
+          Vector.foreach (datatypes, Datatype.clear)
+          ; Vector.foreach (globals, Statement.clear)
+          ; List.foreach (functions, Function.clear))
 
       fun clearGlobals (T {globals, ...}) =
-	 Vector.foreach (globals, Statement.clear)
+         Vector.foreach (globals, Statement.clear)
 
       fun clearTop (p as T {datatypes, functions, ...}) =
-	 (Vector.foreach (datatypes, Datatype.clear)
-	  ; List.foreach (functions, Func.clear o Function.name)
-	  ; clearGlobals p)
+         (Vector.foreach (datatypes, Datatype.clear)
+          ; List.foreach (functions, Func.clear o Function.name)
+          ; clearGlobals p)
 
       fun foreachVar (T {globals, functions, ...}, f) =
-	 (Vector.foreach (globals, fn Statement.T {var, ty, ...} =>
-			  f (valOf var, ty))
-	  ; List.foreach (functions, fn g => Function.foreachVar (g, f)))
+         (Vector.foreach (globals, fn Statement.T {var, ty, ...} =>
+                          f (valOf var, ty))
+          ; List.foreach (functions, fn g => Function.foreachVar (g, f)))
 
       fun foreachPrim (T {globals, functions, ...}, f) =
-	 let
-	    fun loopStatement (Statement.T {exp, ...}) =
-		case exp of
-		   PrimApp {prim, ...} => f prim
-		 | _ => ()
-	     fun loopTransfer t =
-	        case t of
-		   Arith {prim, ...} => f prim
-		 | Runtime {prim, ...} => f prim
-		 | _ => ()
-	     val _ = Vector.foreach (globals, loopStatement)
-	     val _ =
-		List.foreach
-		(functions, fn f =>
-		 Vector.foreach
-		 (Function.blocks f, fn Block.T {statements, transfer, ...} =>
-		  (Vector.foreach (statements, loopStatement);
-		   loopTransfer transfer)))
-	 in
-	    ()
-	 end
+         let
+            fun loopStatement (Statement.T {exp, ...}) =
+                case exp of
+                   PrimApp {prim, ...} => f prim
+                 | _ => ()
+             fun loopTransfer t =
+                case t of
+                   Arith {prim, ...} => f prim
+                 | Runtime {prim, ...} => f prim
+                 | _ => ()
+             val _ = Vector.foreach (globals, loopStatement)
+             val _ =
+                List.foreach
+                (functions, fn f =>
+                 Vector.foreach
+                 (Function.blocks f, fn Block.T {statements, transfer, ...} =>
+                  (Vector.foreach (statements, loopStatement);
+                   loopTransfer transfer)))
+         in
+            ()
+         end
 
       fun hasPrim (p, f) =
-	 DynamicWind.withEscape
-	 (fn escape =>
-	  (foreachPrim (p, fn prim => if f prim then escape true else ())
-	   ; false))
+         Exn.withEscape
+         (fn escape =>
+          (foreachPrim (p, fn prim => if f prim then escape true else ())
+           ; false))
 
       fun mainFunction (T {functions, main, ...}) =
-	 case List.peek (functions, fn f =>
-			 Func.equals (main, Function.name f)) of
-	    NONE => Error.bug "no main function"
-	  | SOME f => f
+         case List.peek (functions, fn f =>
+                         Func.equals (main, Function.name f)) of
+            NONE => Error.bug "SsaTree.Program.mainFunction: no main function"
+          | SOME f => f
 
       fun profile (T {datatypes, functions, globals, main}) =
-	 let
-	    val functions =
-	       List.map
-	       (functions, fn f =>
-		let
-		   val {args, blocks, mayInline, name, raises, returns, start} =
-		      Function.dest f
-		   val blocks =
-		      Vector.map
-		      (blocks, fn Block.T {args, label, statements, transfer} =>
-		       let
-			  val si =
-			     SourceInfo.function
-			     {name = [Label.toString label],
-			      region = Region.bogus}
-			  fun prof f = Vector.new1 (Statement.profile (f si))
-			  val statements =
-			     Vector.concat
-			     [prof ProfileExp.Enter,
-			      statements,
-			      prof ProfileExp.Leave]
-		       in
-			  Block.T {args = args,
-				   label = label,
-				   statements = statements,
-				   transfer = transfer}
-		       end)
-		in
-		   Function.new {args = args,
-				 blocks = blocks,
-				 mayInline = mayInline,
-				 name = name,
-				 raises = raises,
-				 returns = returns,
-				 start = start}
-		end)
-	 in
-	    T {datatypes = datatypes,
-	       functions = functions,
-	       globals = globals,
-	       main = main}
-	 end
-	 
+         let
+            val functions =
+               List.map
+               (functions, fn f =>
+                let
+                   val {args, blocks, mayInline, name, raises, returns, start} =
+                      Function.dest f
+                   val blocks =
+                      Vector.map
+                      (blocks, fn Block.T {args, label, statements, transfer} =>
+                       let
+                          val si =
+                             SourceInfo.function
+                             {name = [Label.toString label],
+                              region = Region.bogus}
+                          fun prof f = Vector.new1 (Statement.profile (f si))
+                          val statements =
+                             Vector.concat
+                             [prof ProfileExp.Enter,
+                              statements,
+                              prof ProfileExp.Leave]
+                       in
+                          Block.T {args = args,
+                                   label = label,
+                                   statements = statements,
+                                   transfer = transfer}
+                       end)
+                in
+                   Function.new {args = args,
+                                 blocks = blocks,
+                                 mayInline = mayInline,
+                                 name = name,
+                                 raises = raises,
+                                 returns = returns,
+                                 start = start}
+                end)
+         in
+            T {datatypes = datatypes,
+               functions = functions,
+               globals = globals,
+               main = main}
+         end
+         
    end
 
 end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ssa/ssa-tree.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ssa/ssa-tree.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ssa/ssa-tree.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 type int = Int.t
 
 signature SSA_TREE_STRUCTS = 
@@ -17,7 +18,7 @@
       structure Label: LABEL
 
       datatype t =
-	 Caller
+         Caller
        | Dead
        | Handle of Label.t
 
@@ -36,11 +37,11 @@
       sharing Label = Handler.Label
 
       datatype t =
-	 Dead
+         Dead
        | NonTail of {cont: Label.t,
-		     handler: Handler.t}
+                     handler: Handler.t}
        | Tail
-	       
+               
       val compose: t * t -> t
       val foldLabel: t * 'a * (Label.t * 'a -> 'a) -> 'a
       val foreachHandler: t * (Label.t -> unit) -> unit
@@ -54,80 +55,80 @@
       include SSA_TREE_STRUCTS
 
       structure Type:
-	 sig
-	    include HASH_TYPE
-	       
-	    datatype dest =
-	       Array of t
-	     | Datatype of Tycon.t
-	     | IntInf
-	     | Real of RealSize.t
-	     | Ref of t
-	     | Thread
-	     | Tuple of t vector
-	     | Vector of t
-	     | Weak of t
-	     | Word of WordSize.t
+         sig
+            include HASH_TYPE
+               
+            datatype dest =
+               Array of t
+             | Datatype of Tycon.t
+             | IntInf
+             | Real of RealSize.t
+             | Ref of t
+             | Thread
+             | Tuple of t vector
+             | Vector of t
+             | Weak of t
+             | Word of WordSize.t
 
-	    val dest: t -> dest
-	    val tyconArgs: t -> Tycon.t * t vector
-	 end
+            val dest: t -> dest
+            val tyconArgs: t -> Tycon.t * t vector
+         end
       sharing Atoms = Type.Atoms
 
       structure Exp:
-	 sig
-	    datatype t =
-	       ConApp of {args: Var.t vector,
-			  con: Con.t}
-	     | Const of Const.t
-	     | PrimApp of {args: Var.t vector,
-			   prim: Type.t Prim.t,
-			   targs: Type.t vector}
-	     | Profile of ProfileExp.t
-	     | Select of {offset: int,
-			  tuple: Var.t}
-	     | Tuple of Var.t vector
-	     | Var of Var.t
+         sig
+            datatype t =
+               ConApp of {args: Var.t vector,
+                          con: Con.t}
+             | Const of Const.t
+             | PrimApp of {args: Var.t vector,
+                           prim: Type.t Prim.t,
+                           targs: Type.t vector}
+             | Profile of ProfileExp.t
+             | Select of {offset: int,
+                          tuple: Var.t}
+             | Tuple of Var.t vector
+             | Var of Var.t
 
-	    val equals: t * t -> bool
-	    val foreachVar: t * (Var.t -> unit) -> unit
-	    val isProfile: t -> bool
-	    val hash: t -> Word.t
-	    val layout: t -> Layout.t
-	    val maySideEffect: t -> bool
-	    val replaceVar: t * (Var.t -> Var.t) -> t
-	    val toString: t -> string
-	    val unit: t
-	 end
+            val equals: t * t -> bool
+            val foreachVar: t * (Var.t -> unit) -> unit
+            val isProfile: t -> bool
+            val hash: t -> Word.t
+            val layout: t -> Layout.t
+            val maySideEffect: t -> bool
+            val replaceVar: t * (Var.t -> Var.t) -> t
+            val toString: t -> string
+            val unit: t
+         end
 
       structure Statement:
-	 sig
-	    datatype t = T of {exp: Exp.t,
-			       ty: Type.t,
-			       var: Var.t option}
+         sig
+            datatype t = T of {exp: Exp.t,
+                               ty: Type.t,
+                               var: Var.t option}
 
-	    val clear: t -> unit (* clear the var *)
-	    val equals: t * t -> bool
-	    val exp: t -> Exp.t
-	    val layout: t -> Layout.t
-	    val prettifyGlobals: t vector -> (Var.t -> string option)
-	    val profile: ProfileExp.t -> t
-	    val var: t -> Var.t option
-	 end
+            val clear: t -> unit (* clear the var *)
+            val equals: t * t -> bool
+            val exp: t -> Exp.t
+            val layout: t -> Layout.t
+            val prettifyGlobals: t vector -> (Var.t -> string option)
+            val profile: ProfileExp.t -> t
+            val var: t -> Var.t option
+         end
       
       structure Cases:
-	 sig
-	    datatype t =
-	       Con of (Con.t * Label.t) vector
-	     | Word of WordSize.t * (WordX.t * Label.t) vector
+         sig
+            datatype t =
+               Con of (Con.t * Label.t) vector
+             | Word of WordSize.t * (WordX.t * Label.t) vector
 
-	    val forall: t * (Label.t -> bool) -> bool
-	    val foreach: t * (Label.t -> unit) -> unit
-	    val hd: t -> Label.t
-	    val isEmpty: t -> bool
-	    val length: t -> int
-	    val map: t * (Label.t -> Label.t) -> t
-	 end
+            val forall: t * (Label.t -> bool) -> bool
+            val foreach: t * (Label.t -> unit) -> unit
+            val hd: t -> Label.t
+            val isEmpty: t -> bool
+            val length: t -> int
+            val map: t * (Label.t -> Label.t) -> t
+         end
 
       structure Handler: HANDLER
       sharing Handler.Label = Label
@@ -136,131 +137,131 @@
       sharing Return.Handler = Handler
 
       structure Transfer:
-	 sig
-	    datatype t =
-	       Arith of {args: Var.t vector,
-			 overflow: Label.t, (* Must be nullary. *)
-			 prim: Type.t Prim.t,
-			 success: Label.t, (* Must be unary. *)
-			 ty: Type.t} (* int or word *)
-	     | Bug  (* MLton thought control couldn't reach here. *)
-	     | Call of {args: Var.t vector,
-			func: Func.t,
-			return: Return.t}
-	     | Case of {cases: Cases.t,
-			default: Label.t option, (* Must be nullary. *)
-			test: Var.t}
-	     | Goto of {args: Var.t vector,
-			dst: Label.t}
-	     (* Raise implicitly raises to the caller.  
-	      * I.E. the local handler stack must be empty.
-	      *)
-	     | Raise of Var.t vector
-	     | Return of Var.t vector
-	     | Runtime of {args: Var.t vector,
-			   prim: Type.t Prim.t,
-			   return: Label.t} (* Must be nullary. *)
+         sig
+            datatype t =
+               Arith of {args: Var.t vector,
+                         overflow: Label.t, (* Must be nullary. *)
+                         prim: Type.t Prim.t,
+                         success: Label.t, (* Must be unary. *)
+                         ty: Type.t} (* int or word *)
+             | Bug  (* MLton thought control couldn't reach here. *)
+             | Call of {args: Var.t vector,
+                        func: Func.t,
+                        return: Return.t}
+             | Case of {cases: Cases.t,
+                        default: Label.t option, (* Must be nullary. *)
+                        test: Var.t}
+             | Goto of {args: Var.t vector,
+                        dst: Label.t}
+             (* Raise implicitly raises to the caller.  
+              * I.E. the local handler stack must be empty.
+              *)
+             | Raise of Var.t vector
+             | Return of Var.t vector
+             | Runtime of {args: Var.t vector,
+                           prim: Type.t Prim.t,
+                           return: Label.t} (* Must be nullary. *)
 
-	    val equals: t * t -> bool
-	    val foreachFunc : t * (Func.t -> unit) -> unit
-	    val foreachLabel: t * (Label.t -> unit) -> unit
-	    val foreachLabelVar: t * (Label.t -> unit) * (Var.t -> unit) -> unit
-	    val foreachVar: t * (Var.t -> unit) -> unit
-	    val hash: t -> Word.t 
-	    val iff: Var.t * {falsee: Label.t, truee: Label.t} -> t
-	    val layout: t -> Layout.t
-	    val replaceLabelVar: t * (Label.t -> Label.t) * (Var.t -> Var.t) -> t
-	    val replaceLabel: t * (Label.t -> Label.t) -> t
-	    val replaceVar: t * (Var.t -> Var.t) -> t
-	 end
+            val equals: t * t -> bool
+            val foreachFunc : t * (Func.t -> unit) -> unit
+            val foreachLabel: t * (Label.t -> unit) -> unit
+            val foreachLabelVar: t * (Label.t -> unit) * (Var.t -> unit) -> unit
+            val foreachVar: t * (Var.t -> unit) -> unit
+            val hash: t -> Word.t 
+            val iff: Var.t * {falsee: Label.t, truee: Label.t} -> t
+            val layout: t -> Layout.t
+            val replaceLabelVar: t * (Label.t -> Label.t) * (Var.t -> Var.t) -> t
+            val replaceLabel: t * (Label.t -> Label.t) -> t
+            val replaceVar: t * (Var.t -> Var.t) -> t
+         end
 
       structure Block:
-	 sig
-	    datatype t =
-	       T of {args: (Var.t * Type.t) vector,
-		     label: Label.t,
-		     statements: Statement.t vector,
-		     transfer: Transfer.t}
+         sig
+            datatype t =
+               T of {args: (Var.t * Type.t) vector,
+                     label: Label.t,
+                     statements: Statement.t vector,
+                     transfer: Transfer.t}
 
-	    val args: t -> (Var.t * Type.t) vector
-	    val clear: t -> unit
-	    val label: t -> Label.t
-	    val layout: t -> Layout.t
-	    val statements: t -> Statement.t vector
-	    val transfer: t -> Transfer.t
-	 end
+            val args: t -> (Var.t * Type.t) vector
+            val clear: t -> unit
+            val label: t -> Label.t
+            val layout: t -> Layout.t
+            val statements: t -> Statement.t vector
+            val transfer: t -> Transfer.t
+         end
 
       structure Datatype:
-	 sig
-	    datatype t =
-	       T of {cons: {args: Type.t vector,
-			    con: Con.t} vector,
-		     tycon: Tycon.t}
+         sig
+            datatype t =
+               T of {cons: {args: Type.t vector,
+                            con: Con.t} vector,
+                     tycon: Tycon.t}
 
-	    val layout: t -> Layout.t
-	 end
+            val layout: t -> Layout.t
+         end
 
       structure Function:
-	 sig
-	    type t
+         sig
+            type t
 
-	    val alphaRename: t -> t
-	    val blocks: t -> Block.t vector
-	    (* clear the plists for all bound variables and labels that appear
-	     * in the function, but not the function name's plist.
-	     *)
-	    val clear: t -> unit
-	    val controlFlow:
-	       t -> {graph: unit DirectedGraph.t,
-		     labelNode: Label.t -> unit DirectedGraph.Node.t,
-		     nodeBlock: unit DirectedGraph.Node.t -> Block.t}
-	    val dest: t -> {args: (Var.t * Type.t) vector,
-			    blocks: Block.t vector,
-			    mayInline: bool,
-			    name: Func.t,
-			    raises: Type.t vector option,
-			    returns: Type.t vector option,
-			    start: Label.t}
-	    (* dfs (f, v) visits the blocks in depth-first order, applying v b
-	     * for block b to yield v', then visiting b's descendents,
-	     * then applying v' ().
-	     *)
-	    val dfs: t * (Block.t -> unit -> unit) -> unit
-	    val dominatorTree: t -> Block.t Tree.t
-	    val foreachVar: t * (Var.t * Type.t -> unit) -> unit
-	    val layout: t -> Layout.t
-	    val layoutDot:
-	       t * (Var.t -> string option) -> {graph: Layout.t,
-						tree: unit -> Layout.t}
-	    val mayInline: t -> bool
-	    val name: t -> Func.t
-	    val new: {args: (Var.t * Type.t) vector,
-		      blocks: Block.t vector,
-		      mayInline: bool,
-		      name: Func.t,
-		      raises: Type.t vector option,
-		      returns: Type.t vector option,
-		      start: Label.t} -> t
-	    val profile: t * SourceInfo.t -> t
-	    val start: t -> Label.t
-	 end
+            val alphaRename: t -> t
+            val blocks: t -> Block.t vector
+            (* clear the plists for all bound variables and labels that appear
+             * in the function, but not the function name's plist.
+             *)
+            val clear: t -> unit
+            val controlFlow:
+               t -> {graph: unit DirectedGraph.t,
+                     labelNode: Label.t -> unit DirectedGraph.Node.t,
+                     nodeBlock: unit DirectedGraph.Node.t -> Block.t}
+            val dest: t -> {args: (Var.t * Type.t) vector,
+                            blocks: Block.t vector,
+                            mayInline: bool,
+                            name: Func.t,
+                            raises: Type.t vector option,
+                            returns: Type.t vector option,
+                            start: Label.t}
+            (* dfs (f, v) visits the blocks in depth-first order, applying v b
+             * for block b to yield v', then visiting b's descendents,
+             * then applying v' ().
+             *)
+            val dfs: t * (Block.t -> unit -> unit) -> unit
+            val dominatorTree: t -> Block.t Tree.t
+            val foreachVar: t * (Var.t * Type.t -> unit) -> unit
+            val layout: t -> Layout.t
+            val layoutDot:
+               t * (Var.t -> string option) -> {graph: Layout.t,
+                                                tree: unit -> Layout.t}
+            val mayInline: t -> bool
+            val name: t -> Func.t
+            val new: {args: (Var.t * Type.t) vector,
+                      blocks: Block.t vector,
+                      mayInline: bool,
+                      name: Func.t,
+                      raises: Type.t vector option,
+                      returns: Type.t vector option,
+                      start: Label.t} -> t
+            val profile: t * SourceInfo.t -> t
+            val start: t -> Label.t
+         end
      
       structure Program:
-	 sig
-	    datatype t =
-	       T of {datatypes: Datatype.t vector,
-		     functions: Function.t list,
-		     globals: Statement.t vector,
-		     main: Func.t (* Must be nullary. *)}
+         sig
+            datatype t =
+               T of {datatypes: Datatype.t vector,
+                     functions: Function.t list,
+                     globals: Statement.t vector,
+                     main: Func.t (* Must be nullary. *)}
 
-	    val clear: t -> unit
-	    val clearTop: t -> unit
-	    val foreachPrim: t * (Type.t Prim.t -> unit) -> unit
-	    val foreachVar: t * (Var.t * Type.t -> unit) -> unit
-	    val hasPrim: t * (Type.t Prim.t -> bool) -> bool
-	    val layouts: t * (Layout.t -> unit) -> unit
-	    val layoutStats: t -> Layout.t
-	    val mainFunction: t -> Function.t
-	    val profile: t -> t
-	 end
+            val clear: t -> unit
+            val clearTop: t -> unit
+            val foreachPrim: t * (Type.t Prim.t -> unit) -> unit
+            val foreachVar: t * (Var.t * Type.t -> unit) -> unit
+            val hasPrim: t * (Type.t Prim.t -> bool) -> bool
+            val layouts: t * (Layout.t -> unit) -> unit
+            val layoutStats: t -> Layout.t
+            val mainFunction: t -> Function.t
+            val profile: t -> t
+         end
    end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ssa/ssa-tree2.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ssa/ssa-tree2.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ssa/ssa-tree2.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,9 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 functor SsaTree2 (S: SSA_TREE2_STRUCTS): SSA_TREE2 = 
@@ -24,7 +24,7 @@
       fun empty () = T (Vector.new0 ())
 
       fun fold (p, b, f) =
-	 Vector.fold (dest p, b, fn ({elt, ...}, b) => f (elt, b))
+         Vector.fold (dest p, b, fn ({elt, ...}, b) => f (elt, b))
 
       fun foreach (p, f) = Vector.foreach (dest p, f o #elt)
 
@@ -39,71 +39,71 @@
       fun length p = Vector.length (dest p)
 
       val equals: 'a t * 'a t * ('a * 'a -> bool) -> bool =
-	 fn (p1, p2, equals) =>
-	 Vector.equals (dest p1, dest p2,
-			fn ({elt = e1, isMutable = m1},
-			    {elt = e2, isMutable = m2}) =>
-			m1 = m2 andalso equals (e1, e2))
+         fn (p1, p2, equals) =>
+         Vector.equals (dest p1, dest p2,
+                        fn ({elt = e1, isMutable = m1},
+                            {elt = e2, isMutable = m2}) =>
+                        m1 = m2 andalso equals (e1, e2))
 
       local 
-	 open Layout
+         open Layout
       in
-	 fun layout (p, layout) =
-	    paren
-	    (#1 (Tycon.layoutApp
-		 (Tycon.tuple,
-		  Vector.map (dest p, fn {elt, isMutable} =>
-			      let
-				 val lay =
-				    if isMutable
-				       then seq [layout elt, str " ref"]
-				    else layout elt
-			      in
-				 (lay, {isChar = false, needsParen = false})
-			      end))))
+         fun layout (p, layout) =
+            paren
+            (#1 (Tycon.layoutApp
+                 (Tycon.tuple,
+                  Vector.map (dest p, fn {elt, isMutable} =>
+                              let
+                                 val lay =
+                                    if isMutable
+                                       then seq [layout elt, str " ref"]
+                                    else layout elt
+                              in
+                                 (lay, {isChar = false, needsParen = false})
+                              end))))
       end
 
       val map: 'a t * ('a -> 'b) -> 'b t =
-	 fn (p, f) =>
-	 make (Vector.map (dest p, fn {elt, isMutable} =>
-			   {elt = f elt,
-			    isMutable = isMutable}))
+         fn (p, f) =>
+         make (Vector.map (dest p, fn {elt, isMutable} =>
+                           {elt = f elt,
+                            isMutable = isMutable}))
 
       val keepAllMap: 'a t * ('a -> 'b option) -> 'b t =
-	 fn (p, f) =>
-	 make (Vector.keepAllMap (dest p, fn {elt, isMutable} =>
-				  Option.map (f elt, fn elt => 
-					      {elt = elt, 
-					       isMutable = isMutable})))
+         fn (p, f) =>
+         make (Vector.keepAllMap (dest p, fn {elt, isMutable} =>
+                                  Option.map (f elt, fn elt => 
+                                              {elt = elt, 
+                                               isMutable = isMutable})))
    end
 
 structure ObjectCon =
    struct
       datatype t =
-	 Con of Con.t
+         Con of Con.t
        | Tuple
        | Vector
 
       val equals: t * t -> bool =
-	 fn (Con c, Con c') => Con.equals (c, c')
-	  | (Tuple, Tuple) => true
-	  | (Vector, Vector) => true
-	  | _ => false
+         fn (Con c, Con c') => Con.equals (c, c')
+          | (Tuple, Tuple) => true
+          | (Vector, Vector) => true
+          | _ => false
 
       val isVector: t -> bool =
-	 fn Vector => true
-	  | _ => false
+         fn Vector => true
+          | _ => false
 
       val layout: t -> Layout.t =
-	 fn oc =>
-	 let
-	    open Layout
-	 in
-	    case oc of
-	       Con c => Con.layout c
-	     | Tuple => str "Tuple"
-	     | Vector => str "Vector"
-	 end
+         fn oc =>
+         let
+            open Layout
+         in
+            case oc of
+               Con c => Con.layout c
+             | Tuple => str "Tuple"
+             | Vector => str "Vector"
+         end
    end
 
 datatype z = datatype ObjectCon.t
@@ -111,25 +111,25 @@
 structure Type =
    struct
       datatype t =
-	 T of {hash: Word.t,
-	       plist: PropertyList.t,
-	       tree: tree}
+         T of {hash: Word.t,
+               plist: PropertyList.t,
+               tree: tree}
       and tree =
-	 Datatype of Tycon.t
-	| IntInf
-	| Object of {args: t Prod.t,
-		     con: ObjectCon.t}
-	| Real of RealSize.t
-	| Thread
-	| Weak of t
-	| Word of WordSize.t
-	 
+         Datatype of Tycon.t
+        | IntInf
+        | Object of {args: t Prod.t,
+                     con: ObjectCon.t}
+        | Real of RealSize.t
+        | Thread
+        | Weak of t
+        | Word of WordSize.t
+         
       local
-	 fun make f (T r) = f r
+         fun make f (T r) = f r
       in
-	 val hash = make #hash
-	 val plist = make #plist
-	 val tree = make #tree
+         val hash = make #hash
+         val plist = make #plist
+         val tree = make #tree
       end
 
       datatype dest = datatype tree
@@ -139,417 +139,417 @@
       fun equals (t, t') = PropertyList.equals (plist t, plist t')
 
       val deVectorOpt: t -> t Prod.t option =
-	 fn t =>
-	 case dest t of
-	    Object {args, con = Vector} => SOME args
-	  | _ => NONE
-	       
+         fn t =>
+         case dest t of
+            Object {args, con = Vector} => SOME args
+          | _ => NONE
+               
       val isVector: t -> bool = isSome o deVectorOpt
 
       fun isWeak t =
-	 case dest t of
-	    Weak _ => true
-	  | _ => false
+         case dest t of
+            Weak _ => true
+          | _ => false
 
       local
-	 val same: tree * tree -> bool =
-	    fn (Datatype t1, Datatype t2) => Tycon.equals (t1, t2)
-	     | (IntInf, IntInf) => true
-	     | (Object {args = a1, con = c1}, Object {args = a2, con = c2}) =>
-		  ObjectCon.equals (c1, c2)
-		  andalso Prod.equals (a1, a2, equals)
-	     | (Real s1, Real s2) => RealSize.equals (s1, s2)
-	     | (Thread, Thread) => true
-	     | (Weak t1, Weak t2) => equals (t1, t2)
-	     | (Word s1, Word s2) => WordSize.equals (s1, s2)
-	     | _ => false
-	 val table: t HashSet.t = HashSet.new {hash = hash}
+         val same: tree * tree -> bool =
+            fn (Datatype t1, Datatype t2) => Tycon.equals (t1, t2)
+             | (IntInf, IntInf) => true
+             | (Object {args = a1, con = c1}, Object {args = a2, con = c2}) =>
+                  ObjectCon.equals (c1, c2)
+                  andalso Prod.equals (a1, a2, equals)
+             | (Real s1, Real s2) => RealSize.equals (s1, s2)
+             | (Thread, Thread) => true
+             | (Weak t1, Weak t2) => equals (t1, t2)
+             | (Word s1, Word s2) => WordSize.equals (s1, s2)
+             | _ => false
+         val table: t HashSet.t = HashSet.new {hash = hash}
       in
-	 val lookup: word * tree -> t =
-	    fn (hash, tr) =>
-	    HashSet.lookupOrInsert (table, hash,
-				    fn t => same (tr, tree t),
-				    fn () => T {hash = hash,
-						plist = PropertyList.new (),
-						tree = tr})
+         val lookup: word * tree -> t =
+            fn (hash, tr) =>
+            HashSet.lookupOrInsert (table, hash,
+                                    fn t => same (tr, tree t),
+                                    fn () => T {hash = hash,
+                                                plist = PropertyList.new (),
+                                                tree = tr})
       end
 
       val newHash = Random.word
 
       local
-	 fun make f : t -> t =
-	    let
-	       val w = newHash ()
-	    in
-	       fn t => lookup (Word.xorb (w, hash t), f t)
-	    end
+         fun make f : t -> t =
+            let
+               val w = newHash ()
+            in
+               fn t => lookup (Word.xorb (w, hash t), f t)
+            end
       in
-	 val weak = make Weak
+         val weak = make Weak
       end
 
       val datatypee: Tycon.t -> t =
-	 fn t => lookup (Tycon.hash t, Datatype t)
+         fn t => lookup (Tycon.hash t, Datatype t)
 
       val bool = datatypee Tycon.bool
 
       local
-	 fun make (tycon, tree) = lookup (Tycon.hash tycon, tree)
+         fun make (tycon, tree) = lookup (Tycon.hash tycon, tree)
       in
-	 val intInf = make (Tycon.intInf, IntInf)
-	 val thread = make (Tycon.thread, Thread)
+         val intInf = make (Tycon.intInf, IntInf)
+         val thread = make (Tycon.thread, Thread)
       end
 
       val real: RealSize.t -> t =
-	 fn s => lookup (Tycon.hash (Tycon.real s), Real s)
-	 
+         fn s => lookup (Tycon.hash (Tycon.real s), Real s)
+         
       val word: WordSize.t -> t =
-	 fn s => lookup (Tycon.hash (Tycon.word s), Word s)
+         fn s => lookup (Tycon.hash (Tycon.word s), Word s)
 
       val defaultWord = word WordSize.default
 
       val word8 = word WordSize.byte
 
       local
-	 val generator: Word.t = 0wx5555
-	 val tuple = newHash ()
-	 val vector = newHash ()
-	 fun hashProd (p, base) =
-	    Vector.fold (Prod.dest p, base, fn ({elt, ...}, w) =>
-			 Word.xorb (w * generator, hash elt))
+         val generator: Word.t = 0wx5555
+         val tuple = newHash ()
+         val vector = newHash ()
+         fun hashProd (p, base) =
+            Vector.fold (Prod.dest p, base, fn ({elt, ...}, w) =>
+                         Word.xorb (w * generator, hash elt))
       in
-	 fun object {args, con}: t =
-	    let
-	       val base =
-		  case con of
-		     Con c => Con.hash c
-		   | Tuple => tuple
-		   | Vector => vector
-	       val hash = hashProd (args, base)
-	    in
-	       lookup (hash, Object {args = args, con = con})
-	    end
+         fun object {args, con}: t =
+            let
+               val base =
+                  case con of
+                     Con c => Con.hash c
+                   | Tuple => tuple
+                   | Vector => vector
+               val hash = hashProd (args, base)
+            in
+               lookup (hash, Object {args = args, con = con})
+            end
       end
 
       fun vector p = object {args = p, con = Vector}
 
       local
-	 fun make isMutable t =
-	    vector (Prod.make (Vector.new1 {elt = t, isMutable = isMutable}))
+         fun make isMutable t =
+            vector (Prod.make (Vector.new1 {elt = t, isMutable = isMutable}))
       in
-	 val array = make true
-	 val vector1 = make false
+         val array = make true
+         val vector1 = make false
       end
-	 
+         
       val word8Vector = vector1 word8
 
       val string = word8Vector
 
       fun ofConst c =
-	 let
-	    datatype z = datatype Const.t
-	 in
-	    case c of
-	       IntInf _ => intInf
-	     | Real r => real (RealX.size r)
-	     | Word w => word (WordX.size w)
-	     | WordVector v => vector1 (word (WordXVector.elementSize v))
-	 end
+         let
+            datatype z = datatype Const.t
+         in
+            case c of
+               IntInf _ => intInf
+             | Real r => real (RealX.size r)
+             | Word w => word (WordX.size w)
+             | WordVector v => vector1 (word (WordXVector.elementSize v))
+         end
 
       fun conApp (con, args) = object {args = args, con = Con con}
-	 
+         
       fun tuple ts = object {args = ts, con = Tuple}
 
       fun reff t =
-	 object {args = Prod.make (Vector.new1 {elt = t, isMutable = true}),
-		 con = Tuple}
-	 
+         object {args = Prod.make (Vector.new1 {elt = t, isMutable = true}),
+                 con = Tuple}
+         
       val unit: t = tuple (Prod.empty ())
 
       val isUnit: t -> bool =
-	 fn t =>
-	 case dest t of
-	    Object {args, con = Tuple} => Prod.isEmpty args
-	  | _ => false
+         fn t =>
+         case dest t of
+            Object {args, con = Tuple} => Prod.isEmpty args
+          | _ => false
 
       local
-	 open Layout
+         open Layout
       in
-	 val {get = layout, ...} =
-	    Property.get
-	    (plist,
-	     Property.initRec
-	     (fn (t, layout) =>
-	      case dest t of
-		 Datatype t => Tycon.layout t
-	       | IntInf => str "IntInf.int"
-	       | Object {args, con} =>
-		    if isUnit t
-		       then str "unit"
-		    else
-		       let
-			  val args = Prod.layout (args, layout)
-		       in
-			  case con of
-			     Con c => seq [Con.layout c, str " of ", args]
-			   | Tuple => args
-			   | Vector => seq [args, str " vector"]
-		       end
-	       | Real s => str (concat ["real", RealSize.toString s])
-	       | Thread => str "thread"
-	       | Weak t => seq [layout t, str " weak"]
-	       | Word s => str (concat ["word", WordSize.toString s])))
+         val {get = layout, ...} =
+            Property.get
+            (plist,
+             Property.initRec
+             (fn (t, layout) =>
+              case dest t of
+                 Datatype t => Tycon.layout t
+               | IntInf => str "IntInf.int"
+               | Object {args, con} =>
+                    if isUnit t
+                       then str "unit"
+                    else
+                       let
+                          val args = Prod.layout (args, layout)
+                       in
+                          case con of
+                             Con c => seq [Con.layout c, str " of ", args]
+                           | Tuple => args
+                           | Vector => seq [args, str " vector"]
+                       end
+               | Real s => str (concat ["real", RealSize.toString s])
+               | Thread => str "thread"
+               | Weak t => seq [layout t, str " weak"]
+               | Word s => str (concat ["word", WordSize.toString s])))
       end
    end
 
 structure Type =
    struct
       open Type
-	 
+         
       fun checkPrimApp {args, prim, result}: bool =
-	 let
-	    datatype z = datatype Prim.Name.t
-	    fun done (args', result') =
-	       Vector.equals (args, Vector.fromList args', equals)
-	       andalso equals (result, result')
-	    local
-	       fun make f s = let val t = f s in done ([t], t) end
-	    in
-	       val realUnary = make real
-	       val wordUnary = make word
-	    end
-	    local
-	       fun make f s = let val t = f s in done ([t, t], t) end
-	    in
-	       val realBinary = make real
-	       val wordBinary = make word
-	    end
-	    local
-	       fun make f s = let val t = f s in done ([t, t], bool) end
-	    in
-	       val realCompare = make real
-	       val wordCompare = make word
-	    end
-	    fun intInfBinary () = done ([intInf, intInf, defaultWord], intInf)
-	    fun intInfShift () =
-	       done ([intInf, defaultWord, defaultWord], intInf)
-	    fun intInfUnary () = done ([intInf, defaultWord], intInf)
-	    fun real3 s = done ([real s, real s, real s], real s)
-	    val pointer = defaultWord
-	    val word8Array = array word8
-	    val wordVector = vector1 defaultWord
-	    fun wordShift s = done ([word s, defaultWord], word s)
-	    fun arg i = Vector.sub (args, i)
-	    fun noArgs () = 0 = Vector.length args
-	    fun oneArg f = 1 = Vector.length args andalso f (arg 0)
-	    fun twoArgs f = 2 = Vector.length args andalso f (arg 0, arg 1)
-	    fun threeArgs f =
-	       3 = Vector.length args andalso f (arg 0, arg 1, arg 2)
-	    fun eq () =
-	       twoArgs (fn (x1, x2) =>
-			equals (x1, x2) andalso equals (result, bool))
-	 in
-	    case Prim.name prim of
-	       Array_array =>
-		  oneArg (fn n =>
-			  equals (n, defaultWord) andalso isVector result)
-	     | Array_length =>
-		  oneArg (fn a =>
-			  isVector a andalso equals (result, defaultWord))
-	     | Array_toVector =>
-		  oneArg
-		  (fn a =>
-		   case (deVectorOpt a, deVectorOpt result) of
-		      (SOME ap, SOME vp) =>
-			 Vector.equals (Prod.dest ap, Prod.dest vp,
-					fn ({elt = ae, isMutable = ai},
-					    {elt = ve, isMutable = vi}) =>
-					(not vi orelse ai)
-					andalso Type.equals (ae, ve))
-		    | _ => false)
-	     | FFI f => done (Vector.toList (CFunction.args f),
-			      CFunction.return f)
-	     | FFI_Symbol _ => done ([], pointer)
-	     | GC_collect => done ([], unit)
-	     | IntInf_add => intInfBinary ()
-	     | IntInf_andb => intInfBinary ()
-	     | IntInf_arshift => intInfShift ()
-	     | IntInf_compare => done ([intInf, intInf], defaultWord)
-	     | IntInf_equal => done ([intInf, intInf], bool)
-	     | IntInf_gcd => intInfBinary ()
-	     | IntInf_lshift => intInfShift ()
-	     | IntInf_mul => intInfBinary ()
-	     | IntInf_neg => intInfUnary ()
-	     | IntInf_notb => intInfUnary ()
-	     | IntInf_orb => intInfBinary ()
-	     | IntInf_quot => intInfBinary ()
-	     | IntInf_rem => intInfBinary ()
-	     | IntInf_sub => intInfBinary ()
-	     | IntInf_toString =>
-		  done ([intInf, defaultWord, defaultWord], string)
-	     | IntInf_toVector => done ([intInf], vector1 defaultWord)
-	     | IntInf_toWord => done ([intInf], defaultWord)
-	     | IntInf_xorb => intInfBinary ()
-	     | MLton_bogus => noArgs ()
-	     | MLton_bug => done ([string], unit)
-	     | MLton_eq => eq ()
-	     | MLton_equal => eq ()
-	     | MLton_halt => done ([defaultWord], unit)
-	     | MLton_handlesSignals => done ([], bool)
-	     | MLton_installSignalHandler => done ([], unit)
-	     | MLton_share => oneArg (fn x => done ([x], unit))
-	     | MLton_size => oneArg (fn x => done ([x], defaultWord))
-	     | MLton_touch => oneArg (fn x => done ([x], unit))
-	     | Pointer_getPointer =>
-		  twoArgs (fn _ => done ([pointer, defaultWord], result))
-	     | Pointer_getReal s => done ([pointer, defaultWord], real s)
-	     | Pointer_getWord s => done ([pointer, defaultWord], word s)
-	     | Pointer_setPointer =>
-		  threeArgs (fn (_, _, t) =>
-			     done ([pointer, defaultWord, t], unit))
-	     | Pointer_setReal s => done ([pointer, defaultWord, real s], unit)
-	     | Pointer_setWord s => done ([pointer, defaultWord, word s], unit)
-	     | Real_Math_acos s => realUnary s
-	     | Real_Math_asin s => realUnary s
-	     | Real_Math_atan s => realUnary s
-	     | Real_Math_atan2 s => realBinary s
-	     | Real_Math_cos s => realUnary s
-	     | Real_Math_exp s => realUnary s
-	     | Real_Math_ln s => realUnary s
-	     | Real_Math_log10 s => realUnary s
-	     | Real_Math_sin s => realUnary s
-	     | Real_Math_sqrt s => realUnary s
-	     | Real_Math_tan s => realUnary s
-	     | Real_abs s => realUnary s
-	     | Real_add s => realBinary s
-	     | Real_div s => realBinary s
-	     | Real_equal s => realCompare s
-	     | Real_ldexp s => done ([real s, defaultWord], real s)
-	     | Real_le s => realCompare s
-	     | Real_lt s => realCompare s
-	     | Real_mul s => realBinary s
-	     | Real_muladd s => real3 s
-	     | Real_mulsub s => real3 s
-	     | Real_neg s => realUnary s
-	     | Real_qequal s => realCompare s
-	     | Real_round s => realUnary s
-	     | Real_sub s => realBinary s
-	     | Real_toReal (s, s') => done ([real s], real s')
-	     | Real_toWord (s, s', _) => done ([real s], word s')
-	     | Thread_atomicBegin => done ([], unit)
-	     | Thread_atomicEnd => done ([], unit)
-	     | Thread_canHandle => done ([], defaultWord)
-	     | Thread_copy => done ([thread], thread)
-	     | Thread_copyCurrent => done ([], unit)
-	     | Thread_returnToC => done ([], unit)
-	     | Thread_switchTo => done ([thread], unit)
-	     | Weak_canGet =>
-		  oneArg (fn w => isWeak w andalso equals (result, bool))
-	     | Weak_get => oneArg (fn _ => done ([weak result], result))
-	     | Weak_new => oneArg (fn x => done ([x], weak x))
-	     | Word8Array_subWord =>
-		  done ([word8Array, defaultWord], defaultWord)
-	     | Word8Array_updateWord =>
-		  done ([word8Array, defaultWord, defaultWord], unit)
-	     | Word8Vector_subWord =>
-		  done ([word8Vector, defaultWord], defaultWord)
-	     | WordVector_toIntInf => done ([wordVector], intInf)
-	     | Word_add s => wordBinary s
-	     | Word_addCheck (s, _) => wordBinary s
-	     | Word_andb s => wordBinary s
-	     | Word_equal s => wordCompare s
-	     | Word_lshift s => wordShift s
-	     | Word_lt (s, _) => wordCompare s
-	     | Word_mul (s, _) => wordBinary s
-	     | Word_mulCheck (s, _) => wordBinary s
-	     | Word_neg s => wordUnary s
-	     | Word_negCheck s => wordUnary s
-	     | Word_notb s => wordUnary s
-	     | Word_orb s => wordBinary s
-	     | Word_quot (s, _) => wordBinary s
-	     | Word_rem (s, _) => wordBinary s
-	     | Word_rol s => wordShift s
-	     | Word_ror s => wordShift s
-	     | Word_rshift (s, _) => wordShift s
-	     | Word_sub s => wordBinary s
-	     | Word_subCheck (s, _) => wordBinary s
-	     | Word_toIntInf => done ([defaultWord], intInf)
-	     | Word_toReal (s, s', _) => done ([word s], real s')
-	     | Word_toWord (s, s', _) => done ([word s], word s')
-	     | Word_xorb s => wordBinary s
-	     | World_save => done ([defaultWord], unit)
-	     | _ => Error.bug (concat ["Type.checkPrimApp got strange prim: ",
-				       Prim.toString prim])
-	 end
+         let
+            datatype z = datatype Prim.Name.t
+            fun done (args', result') =
+               Vector.equals (args, Vector.fromList args', equals)
+               andalso equals (result, result')
+            local
+               fun make f s = let val t = f s in done ([t], t) end
+            in
+               val realUnary = make real
+               val wordUnary = make word
+            end
+            local
+               fun make f s = let val t = f s in done ([t, t], t) end
+            in
+               val realBinary = make real
+               val wordBinary = make word
+            end
+            local
+               fun make f s = let val t = f s in done ([t, t], bool) end
+            in
+               val realCompare = make real
+               val wordCompare = make word
+            end
+            fun intInfBinary () = done ([intInf, intInf, defaultWord], intInf)
+            fun intInfShift () =
+               done ([intInf, defaultWord, defaultWord], intInf)
+            fun intInfUnary () = done ([intInf, defaultWord], intInf)
+            fun real3 s = done ([real s, real s, real s], real s)
+            val pointer = defaultWord
+            val word8Array = array word8
+            val wordVector = vector1 defaultWord
+            fun wordShift s = done ([word s, defaultWord], word s)
+            fun arg i = Vector.sub (args, i)
+            fun noArgs () = 0 = Vector.length args
+            fun oneArg f = 1 = Vector.length args andalso f (arg 0)
+            fun twoArgs f = 2 = Vector.length args andalso f (arg 0, arg 1)
+            fun threeArgs f =
+               3 = Vector.length args andalso f (arg 0, arg 1, arg 2)
+            fun eq () =
+               twoArgs (fn (x1, x2) =>
+                        equals (x1, x2) andalso equals (result, bool))
+         in
+            case Prim.name prim of
+               Array_array =>
+                  oneArg (fn n =>
+                          equals (n, defaultWord) andalso isVector result)
+             | Array_length =>
+                  oneArg (fn a =>
+                          isVector a andalso equals (result, defaultWord))
+             | Array_toVector =>
+                  oneArg
+                  (fn a =>
+                   case (deVectorOpt a, deVectorOpt result) of
+                      (SOME ap, SOME vp) =>
+                         Vector.equals (Prod.dest ap, Prod.dest vp,
+                                        fn ({elt = ae, isMutable = ai},
+                                            {elt = ve, isMutable = vi}) =>
+                                        (not vi orelse ai)
+                                        andalso Type.equals (ae, ve))
+                    | _ => false)
+             | FFI f => done (Vector.toList (CFunction.args f),
+                              CFunction.return f)
+             | FFI_Symbol _ => done ([], pointer)
+             | GC_collect => done ([], unit)
+             | IntInf_add => intInfBinary ()
+             | IntInf_andb => intInfBinary ()
+             | IntInf_arshift => intInfShift ()
+             | IntInf_compare => done ([intInf, intInf], defaultWord)
+             | IntInf_equal => done ([intInf, intInf], bool)
+             | IntInf_gcd => intInfBinary ()
+             | IntInf_lshift => intInfShift ()
+             | IntInf_mul => intInfBinary ()
+             | IntInf_neg => intInfUnary ()
+             | IntInf_notb => intInfUnary ()
+             | IntInf_orb => intInfBinary ()
+             | IntInf_quot => intInfBinary ()
+             | IntInf_rem => intInfBinary ()
+             | IntInf_sub => intInfBinary ()
+             | IntInf_toString =>
+                  done ([intInf, defaultWord, defaultWord], string)
+             | IntInf_toVector => done ([intInf], vector1 defaultWord)
+             | IntInf_toWord => done ([intInf], defaultWord)
+             | IntInf_xorb => intInfBinary ()
+             | MLton_bogus => noArgs ()
+             | MLton_bug => done ([string], unit)
+             | MLton_eq => eq ()
+             | MLton_equal => eq ()
+             | MLton_halt => done ([defaultWord], unit)
+             | MLton_handlesSignals => done ([], bool)
+             | MLton_installSignalHandler => done ([], unit)
+             | MLton_share => oneArg (fn x => done ([x], unit))
+             | MLton_size => oneArg (fn x => done ([x], defaultWord))
+             | MLton_touch => oneArg (fn x => done ([x], unit))
+             | Pointer_getPointer =>
+                  twoArgs (fn _ => done ([pointer, defaultWord], result))
+             | Pointer_getReal s => done ([pointer, defaultWord], real s)
+             | Pointer_getWord s => done ([pointer, defaultWord], word s)
+             | Pointer_setPointer =>
+                  threeArgs (fn (_, _, t) =>
+                             done ([pointer, defaultWord, t], unit))
+             | Pointer_setReal s => done ([pointer, defaultWord, real s], unit)
+             | Pointer_setWord s => done ([pointer, defaultWord, word s], unit)
+             | Real_Math_acos s => realUnary s
+             | Real_Math_asin s => realUnary s
+             | Real_Math_atan s => realUnary s
+             | Real_Math_atan2 s => realBinary s
+             | Real_Math_cos s => realUnary s
+             | Real_Math_exp s => realUnary s
+             | Real_Math_ln s => realUnary s
+             | Real_Math_log10 s => realUnary s
+             | Real_Math_sin s => realUnary s
+             | Real_Math_sqrt s => realUnary s
+             | Real_Math_tan s => realUnary s
+             | Real_abs s => realUnary s
+             | Real_add s => realBinary s
+             | Real_div s => realBinary s
+             | Real_equal s => realCompare s
+             | Real_ldexp s => done ([real s, defaultWord], real s)
+             | Real_le s => realCompare s
+             | Real_lt s => realCompare s
+             | Real_mul s => realBinary s
+             | Real_muladd s => real3 s
+             | Real_mulsub s => real3 s
+             | Real_neg s => realUnary s
+             | Real_qequal s => realCompare s
+             | Real_round s => realUnary s
+             | Real_sub s => realBinary s
+             | Real_toReal (s, s') => done ([real s], real s')
+             | Real_toWord (s, s', _) => done ([real s], word s')
+             | Thread_atomicBegin => done ([], unit)
+             | Thread_atomicEnd => done ([], unit)
+             | Thread_canHandle => done ([], defaultWord)
+             | Thread_copy => done ([thread], thread)
+             | Thread_copyCurrent => done ([], unit)
+             | Thread_returnToC => done ([], unit)
+             | Thread_switchTo => done ([thread], unit)
+             | Weak_canGet =>
+                  oneArg (fn w => isWeak w andalso equals (result, bool))
+             | Weak_get => oneArg (fn _ => done ([weak result], result))
+             | Weak_new => oneArg (fn x => done ([x], weak x))
+             | Word8Array_subWord =>
+                  done ([word8Array, defaultWord], defaultWord)
+             | Word8Array_updateWord =>
+                  done ([word8Array, defaultWord, defaultWord], unit)
+             | Word8Vector_subWord =>
+                  done ([word8Vector, defaultWord], defaultWord)
+             | WordVector_toIntInf => done ([wordVector], intInf)
+             | Word_add s => wordBinary s
+             | Word_addCheck (s, _) => wordBinary s
+             | Word_andb s => wordBinary s
+             | Word_equal s => wordCompare s
+             | Word_lshift s => wordShift s
+             | Word_lt (s, _) => wordCompare s
+             | Word_mul (s, _) => wordBinary s
+             | Word_mulCheck (s, _) => wordBinary s
+             | Word_neg s => wordUnary s
+             | Word_negCheck s => wordUnary s
+             | Word_notb s => wordUnary s
+             | Word_orb s => wordBinary s
+             | Word_quot (s, _) => wordBinary s
+             | Word_rem (s, _) => wordBinary s
+             | Word_rol s => wordShift s
+             | Word_ror s => wordShift s
+             | Word_rshift (s, _) => wordShift s
+             | Word_sub s => wordBinary s
+             | Word_subCheck (s, _) => wordBinary s
+             | Word_toIntInf => done ([defaultWord], intInf)
+             | Word_toReal (s, s', _) => done ([word s], real s')
+             | Word_toWord (s, s', _) => done ([word s], word s')
+             | Word_xorb s => wordBinary s
+             | World_save => done ([defaultWord], unit)
+             | _ => Error.bug (concat ["SsaTree2.Type.checkPrimApp got strange prim: ",
+                                       Prim.toString prim])
+         end
    end
 
 structure Cases =
    struct
       datatype t =
-	 Con of (Con.t * Label.t) vector
+         Con of (Con.t * Label.t) vector
        | Word of WordSize.t * (WordX.t * Label.t) vector
 
       fun equals (c1: t, c2: t): bool =
-	 let
-	    fun doit (l1, l2, eq') = 
-	       Vector.equals 
-	       (l1, l2, fn ((x1, a1), (x2, a2)) =>
-		eq' (x1, x2) andalso Label.equals (a1, a2))
-	 in
-	    case (c1, c2) of
-	       (Con l1, Con l2) => doit (l1, l2, Con.equals)
-	     | (Word (_, l1), Word (_, l2)) => doit (l1, l2, WordX.equals)
-	     | _ => false
-	 end
+         let
+            fun doit (l1, l2, eq') = 
+               Vector.equals 
+               (l1, l2, fn ((x1, a1), (x2, a2)) =>
+                eq' (x1, x2) andalso Label.equals (a1, a2))
+         in
+            case (c1, c2) of
+               (Con l1, Con l2) => doit (l1, l2, Con.equals)
+             | (Word (_, l1), Word (_, l2)) => doit (l1, l2, WordX.equals)
+             | _ => false
+         end
 
       fun hd (c: t): Label.t =
-	 let
-	    fun doit v =
-	       if Vector.length v >= 1
-		  then let val (_, a) = Vector.sub (v, 0)
-		       in a
-		       end
-	       else Error.bug "Cases.hd"
-	 in
-	    case c of
-	       Con cs => doit cs
-	     | Word (_, cs) => doit cs
-	 end
+         let
+            fun doit v =
+               if Vector.length v >= 1
+                  then let val (_, a) = Vector.sub (v, 0)
+                       in a
+                       end
+               else Error.bug "SsaTree2.Cases.hd"
+         in
+            case c of
+               Con cs => doit cs
+             | Word (_, cs) => doit cs
+         end
 
       fun isEmpty (c: t): bool =
-	 let
-	    fun doit v = 0 = Vector.length v
-	 in
-	    case c of
-	       Con cs => doit cs
-	     | Word (_, cs) => doit cs
-	 end
+         let
+            fun doit v = 0 = Vector.length v
+         in
+            case c of
+               Con cs => doit cs
+             | Word (_, cs) => doit cs
+         end
 
       fun fold (c: t, b, f) =
-	 let
-	    fun doit l = Vector.fold (l, b, fn ((_, a), b) => f (a, b))
-	 in
-	    case c of
-	       Con l => doit l
-	     | Word (_, l) => doit l
-	 end
+         let
+            fun doit l = Vector.fold (l, b, fn ((_, a), b) => f (a, b))
+         in
+            case c of
+               Con l => doit l
+             | Word (_, l) => doit l
+         end
 
       fun map (c: t, f): t =
-	 let
-	    fun doit l = Vector.map (l, fn (i, x) => (i, f x))
-	 in
-	    case c of
-	       Con l => Con (doit l)
-	     | Word (s, l) => Word (s, doit l)
-	 end
+         let
+            fun doit l = Vector.map (l, fn (i, x) => (i, f x))
+         in
+            case c of
+               Con l => Con (doit l)
+             | Word (s, l) => Word (s, doit l)
+         end
       
       fun forall (c: t, f: Label.t -> bool): bool =
-	 let
-	    fun doit l = Vector.forall (l, fn (_, x) => f x)
-	 in
-	    case c of
-	       Con l => doit l
-	     | Word (_, l) => doit l
-	 end
+         let
+            fun doit l = Vector.forall (l, fn (_, x) => f x)
+         in
+            case c of
+               Con l => doit l
+             | Word (_, l) => doit l
+         end
 
       fun length (c: t): int = fold (c, 0, fn (_, i) => i + 1)
 
@@ -566,316 +566,316 @@
       open Var
 
       fun pretty (x, global) =
-	 case global x of
-	    NONE => toString x
-	  | SOME s => s
+         case global x of
+            NONE => toString x
+          | SOME s => s
 
       fun prettys (xs: Var.t vector, global: Var.t -> string option) =
-	 Layout.toString (Vector.layout
-			  (fn x =>
-			   case global x of
-			      NONE => layout x
-			    | SOME s => Layout.str s)
-			  xs)
+         Layout.toString (Vector.layout
+                          (fn x =>
+                           case global x of
+                              NONE => layout x
+                            | SOME s => Layout.str s)
+                          xs)
    end
 
 structure Base =
    struct
       datatype 'a t =
-	 Object of 'a
+         Object of 'a
        | VectorSub of {index: 'a,
-		       vector: 'a}
+                       vector: 'a}
 
       fun layout (b: 'a t, layoutX: 'a -> Layout.t): Layout.t =
-	 let
-	    open Layout
-	 in
-	    case b of
-	       Object x => layoutX x
-	     | VectorSub {index, vector} =>
-		  seq [layoutX vector, str "[", layoutX index, str "]"]
-	 end
+         let
+            open Layout
+         in
+            case b of
+               Object x => layoutX x
+             | VectorSub {index, vector} =>
+                  seq [layoutX vector, str "[", layoutX index, str "]"]
+         end
 
       val equals: 'a t * 'a t * ('a * 'a -> bool) -> bool =
-	 fn (b1, b2, equalsX) =>
-	 case (b1, b2) of
-	    (Object x1, Object x2) => equalsX (x1, x2)
-	  | (VectorSub {index = i1, vector = v1},
-	     VectorSub {index = i2, vector = v2}) =>
-	       equalsX (i1, i2) andalso equalsX (v1, v2)
-	  | _ => false
+         fn (b1, b2, equalsX) =>
+         case (b1, b2) of
+            (Object x1, Object x2) => equalsX (x1, x2)
+          | (VectorSub {index = i1, vector = v1},
+             VectorSub {index = i2, vector = v2}) =>
+               equalsX (i1, i2) andalso equalsX (v1, v2)
+          | _ => false
 
       fun object (b: 'a t): 'a =
-	 case b of
-	    Object x => x
-	  | VectorSub {vector = x, ...} => x
+         case b of
+            Object x => x
+          | VectorSub {vector = x, ...} => x
 
       local
-	 val newHash = Random.word
-	 val object = newHash ()
-	 val vectorSub = newHash ()
+         val newHash = Random.word
+         val object = newHash ()
+         val vectorSub = newHash ()
       in
-	 val hash: 'a t * ('a -> word) -> word =
-	    fn (b, hashX) =>
-	    case b of
-	       Object x => Word.xorb (object, hashX x)
-	     | VectorSub {index, vector} =>
-		  Word.xorb (Word.xorb (hashX index, hashX vector),
-			     vectorSub)
+         val hash: 'a t * ('a -> word) -> word =
+            fn (b, hashX) =>
+            case b of
+               Object x => Word.xorb (object, hashX x)
+             | VectorSub {index, vector} =>
+                  Word.xorb (Word.xorb (hashX index, hashX vector),
+                             vectorSub)
       end
 
       fun foreach (b: 'a t, f: 'a -> unit): unit =
-	 case b of
-	    Object x => f x
-	  | VectorSub {index, vector} => (f index; f vector)
+         case b of
+            Object x => f x
+          | VectorSub {index, vector} => (f index; f vector)
 
       fun map (b: 'a t, f: 'a -> 'b): 'b t =
-	 case b of
-	    Object x => Object (f x)
-	  | VectorSub {index, vector} => VectorSub {index = f index,
-						    vector = f vector}
+         case b of
+            Object x => Object (f x)
+          | VectorSub {index, vector} => VectorSub {index = f index,
+                                                    vector = f vector}
    end
 
 structure Exp =
    struct
       datatype t =
-	 Const of Const.t
+         Const of Const.t
        | Inject of {sum: Tycon.t,
-		    variant: Var.t}
+                    variant: Var.t}
        | Object of {con: Con.t option,
-		    args: Var.t vector}
+                    args: Var.t vector}
        | PrimApp of {prim: Type.t Prim.t,
-		     args: Var.t vector}
+                     args: Var.t vector}
        | Select of {base: Var.t Base.t,
-		    offset: int}
+                    offset: int}
        | Var of Var.t
 
       val unit = Object {con = NONE,
-			 args = Vector.new0 ()}
-	 
+                         args = Vector.new0 ()}
+         
       fun foreachVar (e, v) =
-	 let
-	    fun vs xs = Vector.foreach (xs, v)
-	 in
-	    case e of
-	       Const _ => ()
-	     | Inject {variant, ...} => v variant
-	     | Object {args, ...} => vs args
-	     | PrimApp {args, ...} => vs args
-	     | Select {base, ...} => Base.foreach (base, v)
-	     | Var x => v x
-	 end
+         let
+            fun vs xs = Vector.foreach (xs, v)
+         in
+            case e of
+               Const _ => ()
+             | Inject {variant, ...} => v variant
+             | Object {args, ...} => vs args
+             | PrimApp {args, ...} => vs args
+             | Select {base, ...} => Base.foreach (base, v)
+             | Var x => v x
+         end
 
       fun replaceVar (e, fx) =
-	 let
-	    fun fxs xs = Vector.map (xs, fx)
-	 in
-	    case e of
-	       Const _ => e
-	     | Inject {sum, variant} => Inject {sum = sum, variant = fx variant}
-	     | Object {con, args} => Object {con = con, args = fxs args}
-	     | PrimApp {prim, args} => PrimApp {args = fxs args, prim = prim}
-	     | Select {base, offset} =>
-		  Select {base = Base.map (base, fx), offset = offset}
-	     | Var x => Var (fx x)
-	 end
+         let
+            fun fxs xs = Vector.map (xs, fx)
+         in
+            case e of
+               Const _ => e
+             | Inject {sum, variant} => Inject {sum = sum, variant = fx variant}
+             | Object {con, args} => Object {con = con, args = fxs args}
+             | PrimApp {prim, args} => PrimApp {args = fxs args, prim = prim}
+             | Select {base, offset} =>
+                  Select {base = Base.map (base, fx), offset = offset}
+             | Var x => Var (fx x)
+         end
 
       fun layout' (e, layoutVar) =
-	 let
-	    open Layout
-	 in
-	    case e of
-	       Const c => Const.layout c
-	     | Inject {sum, variant} =>
-		  seq [layoutVar variant, str ": ", Tycon.layout sum]
-	     | Object {con, args} =>
-		  seq [(case con of
-			   NONE => empty
-			 | SOME c => seq [Con.layout c, str " "]),
-		       layoutTuple args]
-	     | PrimApp {args, prim} =>
-		  seq [Prim.layout prim, seq [str " ", layoutTuple args]]
-	     | Select {base, offset} =>
-		  seq [str "#", Int.layout offset, str " ",
-		       Base.layout (base, layoutVar)]
-	     | Var x => layoutVar x
-	 end
+         let
+            open Layout
+         in
+            case e of
+               Const c => Const.layout c
+             | Inject {sum, variant} =>
+                  seq [layoutVar variant, str ": ", Tycon.layout sum]
+             | Object {con, args} =>
+                  seq [(case con of
+                           NONE => empty
+                         | SOME c => seq [Con.layout c, str " "]),
+                       layoutTuple args]
+             | PrimApp {args, prim} =>
+                  seq [Prim.layout prim, seq [str " ", layoutTuple args]]
+             | Select {base, offset} =>
+                  seq [str "#", Int.layout offset, str " ",
+                       Base.layout (base, layoutVar)]
+             | Var x => layoutVar x
+         end
 
       fun layout e = layout' (e, Var.layout)
 
       val toString = Layout.toString o layout
 
       fun toPretty (e, global: Var.t -> string option): string =
-	 Layout.toString (layout' (e, fn x =>
-				   case global x of
-				      NONE => Var.layout x
-				    | SOME s => Layout.str s))
-	 
+         Layout.toString (layout' (e, fn x =>
+                                   case global x of
+                                      NONE => Var.layout x
+                                    | SOME s => Layout.str s))
+         
       fun maySideEffect (e: t): bool =
-	 case e of
-	    Const _ => false
-	  | Inject _ => false
-	  | Object _ => false
-	  | PrimApp {prim,...} => Prim.maySideEffect prim
-	  | Select _ => false
-	  | Var _ => false
+         case e of
+            Const _ => false
+          | Inject _ => false
+          | Object _ => false
+          | PrimApp {prim,...} => Prim.maySideEffect prim
+          | Select _ => false
+          | Var _ => false
 
       fun varsEquals (xs, xs') = Vector.equals (xs, xs', Var.equals)
 
       fun equals (e: t, e': t): bool =
-	 case (e, e') of
-	    (Const c, Const c') => Const.equals (c, c')
-	  | (Object {con, args}, Object {con = con', args = args'}) =>
-	       Option.equals (con, con', Con.equals)
-	       andalso varsEquals (args, args')
-	  | (PrimApp {prim, args, ...},
-	     PrimApp {prim = prim', args = args', ...}) =>
-	       Prim.equals (prim, prim') andalso varsEquals (args, args')
-	  | (Select {base = b1, offset = i1}, Select {base = b2, offset = i2}) =>
-	       Base.equals (b1, b2, Var.equals) andalso i1 = i2
-	  | (Var x, Var x') => Var.equals (x, x')
-	  | _ => false
+         case (e, e') of
+            (Const c, Const c') => Const.equals (c, c')
+          | (Object {con, args}, Object {con = con', args = args'}) =>
+               Option.equals (con, con', Con.equals)
+               andalso varsEquals (args, args')
+          | (PrimApp {prim, args, ...},
+             PrimApp {prim = prim', args = args', ...}) =>
+               Prim.equals (prim, prim') andalso varsEquals (args, args')
+          | (Select {base = b1, offset = i1}, Select {base = b2, offset = i2}) =>
+               Base.equals (b1, b2, Var.equals) andalso i1 = i2
+          | (Var x, Var x') => Var.equals (x, x')
+          | _ => false
 
       local
-	 val newHash = Random.word
-	 val inject = newHash ()
-	 val primApp = newHash ()
-	 val select = newHash ()
-	 val tuple = newHash ()
-	 fun hashVars (xs: Var.t vector, w: Word.t): Word.t =
-	    Vector.fold (xs, w, fn (x, w) => Word.xorb (w, Var.hash x))
+         val newHash = Random.word
+         val inject = newHash ()
+         val primApp = newHash ()
+         val select = newHash ()
+         val tuple = newHash ()
+         fun hashVars (xs: Var.t vector, w: Word.t): Word.t =
+            Vector.fold (xs, w, fn (x, w) => Word.xorb (w, Var.hash x))
       in
-	 val hash: t -> Word.t =
-	    fn Const c => Const.hash c
-	     | Inject {sum, variant} =>
-		  Word.xorb (inject,
-			     Word.xorb (Tycon.hash sum, Var.hash variant))
-	     | Object {con, args, ...} =>
-		  hashVars (args,
-			    case con of
-			       NONE => tuple
-			     | SOME c => Con.hash c)
-	     | PrimApp {args, ...} => hashVars (args, primApp)
-	     | Select {base, offset} =>
-		  Word.xorb (select,
-			     Base.hash (base, Var.hash) + Word.fromInt offset)
-	     | Var x => Var.hash x
+         val hash: t -> Word.t =
+            fn Const c => Const.hash c
+             | Inject {sum, variant} =>
+                  Word.xorb (inject,
+                             Word.xorb (Tycon.hash sum, Var.hash variant))
+             | Object {con, args, ...} =>
+                  hashVars (args,
+                            case con of
+                               NONE => tuple
+                             | SOME c => Con.hash c)
+             | PrimApp {args, ...} => hashVars (args, primApp)
+             | Select {base, offset} =>
+                  Word.xorb (select,
+                             Base.hash (base, Var.hash) + Word.fromInt offset)
+             | Var x => Var.hash x
       end
 
-      val hash = Trace.trace ("Exp.hash", layout, Word.layout) hash
+      val hash = Trace.trace ("SsaTree2.Exp.hash", layout, Word.layout) hash
    end
 datatype z = datatype Exp.t
 
 structure Statement =
    struct
       datatype t =
-	 Bind of {var: Var.t option,
-		  ty: Type.t,
-		  exp: Exp.t}
+         Bind of {var: Var.t option,
+                  ty: Type.t,
+                  exp: Exp.t}
        | Profile of ProfileExp.t
        | Update of {base: Var.t Base.t,
-		    offset: int,
-		    value: Var.t}
+                    offset: int,
+                    value: Var.t}
 
       fun layout' (s: t, layoutVar): Layout.t =
-	 let
-	    open Layout
-	 in
-	    case s of
-	       Bind {var, ty, exp} =>
-		  seq [seq [case var of
-			       NONE => empty
-			     | SOME var =>
-				  seq [Var.layout var,
-				       if !Control.showTypes
-					  then seq [str ": ", Type.layout ty]
-				       else empty,
-					  str " = "]],
-		       Exp.layout' (exp, layoutVar)]
-	     | Profile p => ProfileExp.layout p
-      	     | Update {base, offset, value} =>
-		  seq [(if 0 = offset
-			   then empty
-			else seq [str "#", Int.layout offset, str " "]),
-		       Base.layout (base, layoutVar),
-		       str " := ", layoutVar value]
-	 end
+         let
+            open Layout
+         in
+            case s of
+               Bind {var, ty, exp} =>
+                  seq [seq [case var of
+                               NONE => empty
+                             | SOME var =>
+                                  seq [Var.layout var,
+                                       if !Control.showTypes
+                                          then seq [str ": ", Type.layout ty]
+                                       else empty,
+                                          str " = "]],
+                       Exp.layout' (exp, layoutVar)]
+             | Profile p => ProfileExp.layout p
+             | Update {base, offset, value} =>
+                  seq [(if 0 = offset
+                           then empty
+                        else seq [str "#", Int.layout offset, str " "]),
+                       Base.layout (base, layoutVar),
+                       str " := ", layoutVar value]
+         end
 
       fun layout s = layout' (s, Var.layout)
 
       fun toPretty (s: t, global: Var.t -> string option): string =
-	 Layout.toString (layout' (s, fn x =>
-				   case global x of
-				      NONE => Var.layout x
-				    | SOME s => Layout.str s))
+         Layout.toString (layout' (s, fn x =>
+                                   case global x of
+                                      NONE => Var.layout x
+                                    | SOME s => Layout.str s))
 
       val profile = Profile
 
       fun foreachDef (s: t, f: Var.t * Type.t -> unit): unit =
-	 case s of
-	    Bind {ty, var, ...} => Option.app (var, fn x => f (x, ty))
-	  | _ => ()
+         case s of
+            Bind {ty, var, ...} => Option.app (var, fn x => f (x, ty))
+          | _ => ()
 
       fun clear s = foreachDef (s, Var.clear o #1)
-	 
+         
       fun prettifyGlobals (v: t vector): Var.t -> string option =
-	 let
-	    val {get = global: Var.t -> string option, set = setGlobal, ...} =
-	       Property.getSet (Var.plist, Property.initConst NONE)
-	    val _ = 
-	       Vector.foreach
-	       (v, fn s =>
-		case s of
-		   Bind {var, exp, ...} =>
-		      Option.app
-		      (var, fn var =>
-		       let
-			  fun set s =
-			     let
-				val maxSize = 10
-				val s = 
-				   if String.size s > maxSize
-				      then concat [String.prefix (s, maxSize),
-						   "..."]
-				   else s
-			     in
-				setGlobal (var, SOME s)
-			     end
-		       in
-			  case exp of
-			     Const c => set (Layout.toString (Const.layout c))
-			   | Object {con, args, ...} =>
-				(case con of
-				    NONE => ()
-				  | SOME c =>
-				       set (if Vector.isEmpty args
-					       then Con.toString c
-					    else concat [Con.toString c,
-							 "(...)"]))
-			   | _ => ()
-		       end)
-		 | _ => ())
-	 in
-	    global
-	 end
+         let
+            val {get = global: Var.t -> string option, set = setGlobal, ...} =
+               Property.getSet (Var.plist, Property.initConst NONE)
+            val _ = 
+               Vector.foreach
+               (v, fn s =>
+                case s of
+                   Bind {var, exp, ...} =>
+                      Option.app
+                      (var, fn var =>
+                       let
+                          fun set s =
+                             let
+                                val maxSize = 10
+                                val s = 
+                                   if String.size s > maxSize
+                                      then concat [String.prefix (s, maxSize),
+                                                   "..."]
+                                   else s
+                             in
+                                setGlobal (var, SOME s)
+                             end
+                       in
+                          case exp of
+                             Const c => set (Layout.toString (Const.layout c))
+                           | Object {con, args, ...} =>
+                                (case con of
+                                    NONE => ()
+                                  | SOME c =>
+                                       set (if Vector.isEmpty args
+                                               then Con.toString c
+                                            else concat [Con.toString c,
+                                                         "(...)"]))
+                           | _ => ()
+                       end)
+                 | _ => ())
+         in
+            global
+         end
 
       fun foreachUse (s: t, f: Var.t -> unit): unit =
-	 case s of
-	    Bind {exp, ...} => Exp.foreachVar (exp, f)
-	  | Profile _ => ()
-	  | Update {base, value, ...} => (Base.foreach (base, f); f value)
-	       
+         case s of
+            Bind {exp, ...} => Exp.foreachVar (exp, f)
+          | Profile _ => ()
+          | Update {base, value, ...} => (Base.foreach (base, f); f value)
+               
       fun replaceDefsUses (s: t, {def: Var.t -> Var.t, use: Var.t -> Var.t}): t =
-	 case s of
-	    Bind {exp, ty, var} =>
-	       Bind {exp = Exp.replaceVar (exp, use),
-		     ty = ty,
-		     var = Option.map (var, def)}
-	  | Profile _ => s
-	  | Update {base, offset, value} =>
-	       Update {base = Base.map (base, use),
-		       offset = offset,
-		       value = use value}
+         case s of
+            Bind {exp, ty, var} =>
+               Bind {exp = Exp.replaceVar (exp, use),
+                     ty = ty,
+                     var = Option.map (var, def)}
+          | Profile _ => s
+          | Update {base, offset, value} =>
+               Update {base = Base.map (base, use),
+                       offset = offset,
+                       value = use value}
 
       fun replaceUses (s, f) = replaceDefsUses (s, {def = fn x => x, use = f})
    end
@@ -887,51 +887,51 @@
       structure Label = Label
 
       datatype t =
-	 Caller
+         Caller
        | Dead
        | Handle of Label.t
 
       fun layout (h: t): Layout.t =
-	 let
-	    open Layout
-	 in
-	    case h of
-	       Caller => str "Caller"
-	     | Dead => str "Dead"
-	     | Handle l => seq [str "Handle ", Label.layout l]
-	 end
+         let
+            open Layout
+         in
+            case h of
+               Caller => str "Caller"
+             | Dead => str "Dead"
+             | Handle l => seq [str "Handle ", Label.layout l]
+         end
 
       val equals =
-	 fn (Caller, Caller) => true
-	  | (Dead, Dead) => true
-	  | (Handle l, Handle l') => Label.equals (l, l')
-	  | _ => false
+         fn (Caller, Caller) => true
+          | (Dead, Dead) => true
+          | (Handle l, Handle l') => Label.equals (l, l')
+          | _ => false
 
       fun foldLabel (h: t, a: 'a, f: Label.t * 'a -> 'a): 'a =
-	 case h of
-	    Caller => a
-	  | Dead => a
-	  | Handle l => f (l, a)
+         case h of
+            Caller => a
+          | Dead => a
+          | Handle l => f (l, a)
 
       fun foreachLabel (h, f) = foldLabel (h, (), f o #1)
 
       fun map (h, f) =
-	 case h of
-	    Caller => Caller
-	  | Dead => Dead
-	  | Handle l => Handle (f l)
+         case h of
+            Caller => Caller
+          | Dead => Dead
+          | Handle l => Handle (f l)
 
       local
-	 val newHash = Random.word
-	 val caller = newHash ()
-	 val dead = newHash ()
-	 val handlee = newHash ()
+         val newHash = Random.word
+         val caller = newHash ()
+         val dead = newHash ()
+         val handlee = newHash ()
       in
-	 fun hash (h: t): word =
-	    case h of
-	       Caller => caller
-	     | Dead => dead
-	     | Handle l => Word.xorb (handlee, Label.hash l)
+         fun hash (h: t): word =
+            case h of
+               Caller => caller
+             | Dead => dead
+             | Handle l => Word.xorb (handlee, Label.hash l)
       end
    end
 
@@ -941,86 +941,86 @@
       structure Handler = Handler
 
       datatype t =
-	 Dead
+         Dead
        | NonTail of {cont: Label.t,
-		     handler: Handler.t}
+                     handler: Handler.t}
        | Tail
 
       fun layout r =
-	 let
-	    open Layout
-	 in
-	    case r of
-	       Dead => str "Dead"
-	     | NonTail {cont, handler} =>
-		  seq [str "NonTail ",
-		       Layout.record
-		       [("cont", Label.layout cont),
-			("handler", Handler.layout handler)]]
-	     | Tail => str "Tail"
-	 end
+         let
+            open Layout
+         in
+            case r of
+               Dead => str "Dead"
+             | NonTail {cont, handler} =>
+                  seq [str "NonTail ",
+                       Layout.record
+                       [("cont", Label.layout cont),
+                        ("handler", Handler.layout handler)]]
+             | Tail => str "Tail"
+         end
 
       fun equals (r, r'): bool =
-	 case (r, r') of
-	    (Dead, Dead) => true
-	  | (NonTail {cont = c, handler = h},
-	     NonTail {cont = c', handler = h'}) =>
-	       Label.equals (c, c') andalso Handler.equals (h, h')
-	   | (Tail, Tail) => true
-	   | _ => false
+         case (r, r') of
+            (Dead, Dead) => true
+          | (NonTail {cont = c, handler = h},
+             NonTail {cont = c', handler = h'}) =>
+               Label.equals (c, c') andalso Handler.equals (h, h')
+           | (Tail, Tail) => true
+           | _ => false
 
       fun foldLabel (r: t, a, f) =
-	 case r of
-	    Dead => a
-	  | NonTail {cont, handler} =>
-	       Handler.foldLabel (handler, f (cont, a), f)
-	  | Tail => a
+         case r of
+            Dead => a
+          | NonTail {cont, handler} =>
+               Handler.foldLabel (handler, f (cont, a), f)
+          | Tail => a
 
       fun foreachLabel (r, f) = foldLabel (r, (), f o #1)
 
       fun foreachHandler (r, f) =
-	 case r of
-	    Dead => ()
-	  | NonTail {handler, ...} => Handler.foreachLabel (handler, f)
-	  | Tail => ()
+         case r of
+            Dead => ()
+          | NonTail {handler, ...} => Handler.foreachLabel (handler, f)
+          | Tail => ()
 
       fun map (r, f) =
-	 case r of
-	    Dead => Dead
-	  | NonTail {cont, handler} =>
-	       NonTail {cont = f cont,
-			handler = Handler.map (handler, f)}
-	  | Tail => Tail
+         case r of
+            Dead => Dead
+          | NonTail {cont, handler} =>
+               NonTail {cont = f cont,
+                        handler = Handler.map (handler, f)}
+          | Tail => Tail
 
       fun compose (r, r') =
-	 case r' of
-	    Dead => Dead
-	  | NonTail {cont, handler} =>
-	       NonTail
-	       {cont = cont,
-		handler = (case handler of
-			      Handler.Caller =>
-				 (case r of
-				     Dead => Handler.Caller
-				   | NonTail {handler, ...} => handler
-				   | Tail => Handler.Caller)
-			    | Handler.Dead => handler
-			    | Handler.Handle _ => handler)}
-	  | Tail => r
+         case r' of
+            Dead => Dead
+          | NonTail {cont, handler} =>
+               NonTail
+               {cont = cont,
+                handler = (case handler of
+                              Handler.Caller =>
+                                 (case r of
+                                     Dead => Handler.Caller
+                                   | NonTail {handler, ...} => handler
+                                   | Tail => Handler.Caller)
+                            | Handler.Dead => handler
+                            | Handler.Handle _ => handler)}
+          | Tail => r
 
       local
-	 val newHash = Random.word
-	 val dead = newHash ()
-	 val nonTail = newHash ()
-	 val tail = newHash ()
+         val newHash = Random.word
+         val dead = newHash ()
+         val nonTail = newHash ()
+         val tail = newHash ()
       in
-	 fun hash r =
-	    case r of
-	       Dead => dead
-	     | NonTail {cont, handler} =>
-		  Word.xorb (Word.xorb (nonTail, Label.hash cont),
-			     Handler.hash handler)
-	     | Tail => tail
+         fun hash r =
+            case r of
+               Dead => dead
+             | NonTail {cont, handler} =>
+                  Word.xorb (Word.xorb (nonTail, Label.hash cont),
+                             Handler.hash handler)
+             | Tail => tail
       end
    end
 
@@ -1028,219 +1028,219 @@
    struct
       datatype t =
          Arith of {prim: Type.t Prim.t,
-		   args: Var.t vector,
-		   overflow: Label.t, (* Must be nullary. *)
-		   success: Label.t, (* Must be unary. *)
-		   ty: Type.t}
+                   args: Var.t vector,
+                   overflow: Label.t, (* Must be nullary. *)
+                   success: Label.t, (* Must be unary. *)
+                   ty: Type.t}
        | Bug (* MLton thought control couldn't reach here. *)
        | Call of {args: Var.t vector,
-		  func: Func.t,
-		  return: Return.t}
+                  func: Func.t,
+                  return: Return.t}
        | Case of {test: Var.t,
-		  cases: Cases.t,
-		  default: Label.t option} (* Must be nullary. *)
+                  cases: Cases.t,
+                  default: Label.t option} (* Must be nullary. *)
        | Goto of {dst: Label.t,
-		  args: Var.t vector}
+                  args: Var.t vector}
        | Raise of Var.t vector
        | Return of Var.t vector
        | Runtime of {prim: Type.t Prim.t,
-		     args: Var.t vector,
-		     return: Label.t} (* Must be nullary. *)
+                     args: Var.t vector,
+                     return: Label.t} (* Must be nullary. *)
 
       fun iff (test: Var.t, {truee, falsee}) =
-	 let
-	    val s = WordSize.fromBits (Bits.fromInt 32)
-	 in
-	    Case {cases = Cases.Word (s, Vector.new2 ((WordX.zero s, falsee),
-						      (WordX.one s, truee))),
-		  default = NONE,
-		  test = test}
-	 end
-	 
-      fun foreachFuncLabelVar (t, func, label: Label.t -> unit, var) =
-	 let
-	    fun vars xs = Vector.foreach (xs, var)
-	 in
-	    case t of
-	       Arith {args, overflow, success, ...} =>
-		  (vars args
-		   ; label overflow 
-		   ; label success)
-	     | Bug => ()
-	     | Call {func = f, args, return, ...} =>
-		  (func f
-		   ; Return.foreachLabel (return, label)
-		   ; vars args)
-	     | Case {test, cases, default, ...} =>
-		  (var test
-		   ; Cases.foreach (cases, label)
-		   ; Option.app (default, label))
-	     | Goto {dst, args, ...} => (vars args; label dst)
-	     | Raise xs => vars xs
-	     | Return xs => vars xs
-	     | Runtime {args, return, ...} =>
-		  (vars args
-		   ; label return)
-	 end
+         let
+            val s = WordSize.fromBits (Bits.fromInt 32)
+         in
+            Case {cases = Cases.Word (s, Vector.new2 ((WordX.zero s, falsee),
+                                                      (WordX.one s, truee))),
+                  default = NONE,
+                  test = test}
+         end
+         
+      fun foreachFuncLabelVar (t, func: Func.t -> unit, label: Label.t -> unit, var) =
+         let
+            fun vars xs = Vector.foreach (xs, var)
+         in
+            case t of
+               Arith {args, overflow, success, ...} =>
+                  (vars args
+                   ; label overflow 
+                   ; label success)
+             | Bug => ()
+             | Call {func = f, args, return, ...} =>
+                  (func f
+                   ; Return.foreachLabel (return, label)
+                   ; vars args)
+             | Case {test, cases, default, ...} =>
+                  (var test
+                   ; Cases.foreach (cases, label)
+                   ; Option.app (default, label))
+             | Goto {dst, args, ...} => (vars args; label dst)
+             | Raise xs => vars xs
+             | Return xs => vars xs
+             | Runtime {args, return, ...} =>
+                  (vars args
+                   ; label return)
+         end
 
       fun foreachFunc (t, func) =
-	 foreachFuncLabelVar (t, func, fn _ => (), fn _ => ())
+         foreachFuncLabelVar (t, func, fn _ => (), fn _ => ())
 
       fun foreachLabelVar (t, label, var) =
-	 foreachFuncLabelVar (t, fn _ => (), label, var)
-	 
+         foreachFuncLabelVar (t, fn _ => (), label, var)
+         
       fun foreachLabel (t, j) = foreachLabelVar (t, j, fn _ => ())
       fun foreachVar (t, v) = foreachLabelVar (t, fn _ => (), v)
 
       fun replaceLabelVar (t, fl, fx) =
-	 let
-	    fun fxs xs = Vector.map (xs, fx)
-	 in
-	    case t of
-	       Arith {prim, args, overflow, success, ty} =>
-		  Arith {prim = prim,
-			 args = fxs args,
-			 overflow = fl overflow,
-			 success = fl success,
-			 ty = ty}
-	     | Bug => Bug
-	     | Call {func, args, return} =>
-		  Call {func = func, 
-			args = fxs args,
-			return = Return.map (return, fl)}
-	     | Case {test, cases, default} =>
-		  Case {test = fx test, 
-			cases = Cases.map(cases, fl),
-			default = Option.map(default, fl)}
-	     | Goto {dst, args} => 
-		  Goto {dst = fl dst, 
-			args = fxs args}
-	     | Raise xs => Raise (fxs xs)
-	     | Return xs => Return (fxs xs)
-	     | Runtime {prim, args, return} =>
-		  Runtime {prim = prim,
-			   args = fxs args,
-			   return = fl return}
-	 end
+         let
+            fun fxs xs = Vector.map (xs, fx)
+         in
+            case t of
+               Arith {prim, args, overflow, success, ty} =>
+                  Arith {prim = prim,
+                         args = fxs args,
+                         overflow = fl overflow,
+                         success = fl success,
+                         ty = ty}
+             | Bug => Bug
+             | Call {func, args, return} =>
+                  Call {func = func, 
+                        args = fxs args,
+                        return = Return.map (return, fl)}
+             | Case {test, cases, default} =>
+                  Case {test = fx test, 
+                        cases = Cases.map(cases, fl),
+                        default = Option.map(default, fl)}
+             | Goto {dst, args} => 
+                  Goto {dst = fl dst, 
+                        args = fxs args}
+             | Raise xs => Raise (fxs xs)
+             | Return xs => Return (fxs xs)
+             | Runtime {prim, args, return} =>
+                  Runtime {prim = prim,
+                           args = fxs args,
+                           return = fl return}
+         end
 
       fun replaceLabel (t, f) = replaceLabelVar (t, f, fn x => x)
       fun replaceVar (t, f) = replaceLabelVar (t, fn l => l, f)
 
       local open Layout
       in
-	 fun layoutCase {test, cases, default} =
-	    let
-	       fun doit (l, layout) =
-		  Vector.toListMap
-		  (l, fn (i, l) =>
-		   seq [layout i, str " => ", Label.layout l])
-	       datatype z = datatype Cases.t
-	       val cases =
-		  case cases of
-		     Con l => doit (l, Con.layout)
-		   | Word (_, l) => doit (l, WordX.layout)
-	       val cases =
-		  case default of
-		     NONE => cases
-		   | SOME j =>
-			cases @ [seq [str "_ => ", Label.layout j]]
-	    in
-	       align [seq [str "case ", Var.layout test, str " of"],
-		      indent (alignPrefix (cases, "| "), 2)]
-	    end
+         fun layoutCase {test, cases, default} =
+            let
+               fun doit (l, layout) =
+                  Vector.toListMap
+                  (l, fn (i, l) =>
+                   seq [layout i, str " => ", Label.layout l])
+               datatype z = datatype Cases.t
+               val cases =
+                  case cases of
+                     Con l => doit (l, Con.layout)
+                   | Word (_, l) => doit (l, WordX.layout)
+               val cases =
+                  case default of
+                     NONE => cases
+                   | SOME j =>
+                        cases @ [seq [str "_ => ", Label.layout j]]
+            in
+               align [seq [str "case ", Var.layout test, str " of"],
+                      indent (alignPrefix (cases, "| "), 2)]
+            end
 
-	 val layout =
-	    fn Arith {prim, args, overflow, success, ...} =>
-		  seq [Label.layout success, str " ",
-		       tuple [Prim.layoutApp (prim, args, Var.layout)],
-		       str " Overflow => ",
-		       Label.layout overflow, str " ()"]
-	     | Bug => str "Bug"
-	     | Call {func, args, return} =>
-		  seq [Func.layout func, str " ", layoutTuple args,
-		       str " ", Return.layout return]
-	     | Case arg => layoutCase arg
-	     | Goto {dst, args} =>
-		  seq [Label.layout dst, str " ", layoutTuple args]
-	     | Raise xs => seq [str "raise ", layoutTuple xs]
-	     | Return xs =>
-		  seq [str "return ",
-		       if 1 = Vector.length xs
-			  then Var.layout (Vector.sub (xs, 0))
-		       else layoutTuple xs]
-	     | Runtime {prim, args, return} =>
-		  seq [Label.layout return, str " ", 
-		       tuple [Prim.layoutApp (prim, args, Var.layout)]]
+         val layout =
+            fn Arith {prim, args, overflow, success, ...} =>
+                  seq [Label.layout success, str " ",
+                       tuple [Prim.layoutApp (prim, args, Var.layout)],
+                       str " Overflow => ",
+                       Label.layout overflow, str " ()"]
+             | Bug => str "Bug"
+             | Call {func, args, return} =>
+                  seq [Func.layout func, str " ", layoutTuple args,
+                       str " ", Return.layout return]
+             | Case arg => layoutCase arg
+             | Goto {dst, args} =>
+                  seq [Label.layout dst, str " ", layoutTuple args]
+             | Raise xs => seq [str "raise ", layoutTuple xs]
+             | Return xs =>
+                  seq [str "return ",
+                       if 1 = Vector.length xs
+                          then Var.layout (Vector.sub (xs, 0))
+                       else layoutTuple xs]
+             | Runtime {prim, args, return} =>
+                  seq [Label.layout return, str " ", 
+                       tuple [Prim.layoutApp (prim, args, Var.layout)]]
       end
 
       fun varsEquals (xs, xs') = Vector.equals (xs, xs', Var.equals)
 
       fun equals (e: t, e': t): bool =
-	 case (e, e') of
-	    (Arith {prim, args, overflow, success, ...},
-	     Arith {prim = prim', args = args', 
-		    overflow = overflow', success = success', ...}) =>
-	       Prim.equals (prim, prim') andalso
-	       varsEquals (args, args') andalso
-	       Label.equals (overflow, overflow') andalso
-	       Label.equals (success, success')
-	  | (Bug, Bug) => true
-	  | (Call {func, args, return}, 
-	     Call {func = func', args = args', return = return'}) =>
-	       Func.equals (func, func') andalso
-	       varsEquals (args, args') andalso
-	       Return.equals (return, return')
-	  | (Case {test, cases, default},
-	     Case {test = test', cases = cases', default = default'}) =>
-	       Var.equals (test, test')
-	       andalso Cases.equals (cases, cases')
-	       andalso Option.equals (default, default', Label.equals)
-	  | (Goto {dst, args}, Goto {dst = dst', args = args'}) =>
-	       Label.equals (dst, dst') andalso
-	       varsEquals (args, args')
-	  | (Raise xs, Raise xs') => varsEquals (xs, xs')
-	  | (Return xs, Return xs') => varsEquals (xs, xs')
-	  | (Runtime {prim, args, return},
-	     Runtime {prim = prim', args = args', return = return'}) =>
-	       Prim.equals (prim, prim') andalso
-	       varsEquals (args, args') andalso
-	       Label.equals (return, return')
-	  | _ => false
+         case (e, e') of
+            (Arith {prim, args, overflow, success, ...},
+             Arith {prim = prim', args = args', 
+                    overflow = overflow', success = success', ...}) =>
+               Prim.equals (prim, prim') andalso
+               varsEquals (args, args') andalso
+               Label.equals (overflow, overflow') andalso
+               Label.equals (success, success')
+          | (Bug, Bug) => true
+          | (Call {func, args, return}, 
+             Call {func = func', args = args', return = return'}) =>
+               Func.equals (func, func') andalso
+               varsEquals (args, args') andalso
+               Return.equals (return, return')
+          | (Case {test, cases, default},
+             Case {test = test', cases = cases', default = default'}) =>
+               Var.equals (test, test')
+               andalso Cases.equals (cases, cases')
+               andalso Option.equals (default, default', Label.equals)
+          | (Goto {dst, args}, Goto {dst = dst', args = args'}) =>
+               Label.equals (dst, dst') andalso
+               varsEquals (args, args')
+          | (Raise xs, Raise xs') => varsEquals (xs, xs')
+          | (Return xs, Return xs') => varsEquals (xs, xs')
+          | (Runtime {prim, args, return},
+             Runtime {prim = prim', args = args', return = return'}) =>
+               Prim.equals (prim, prim') andalso
+               varsEquals (args, args') andalso
+               Label.equals (return, return')
+          | _ => false
 
       local
-	 val newHash = Random.word
-	 val bug = newHash ()
-	 val raisee = newHash ()
-	 val return = newHash ()
-	 fun hashVars (xs: Var.t vector, w: Word.t): Word.t =
-	    Vector.fold (xs, w, fn (x, w) => Word.xorb (w, Var.hash x))
-	 fun hash2 (w1: Word.t, w2: Word.t) = Word.xorb (w1, w2)
+         val newHash = Random.word
+         val bug = newHash ()
+         val raisee = newHash ()
+         val return = newHash ()
+         fun hashVars (xs: Var.t vector, w: Word.t): Word.t =
+            Vector.fold (xs, w, fn (x, w) => Word.xorb (w, Var.hash x))
+         fun hash2 (w1: Word.t, w2: Word.t) = Word.xorb (w1, w2)
       in
-	 val hash: t -> Word.t =
-	    fn Arith {args, overflow, success, ...} =>
-	          hashVars (args, hash2 (Label.hash overflow,
-					 Label.hash success))
-	     | Bug => bug
-	     | Call {func, args, return} =>
-		  hashVars (args, hash2 (Func.hash func, Return.hash return))
-	     | Case {test, cases, default} =>
-		  hash2 (Var.hash test, 
-			 Cases.fold
-			 (cases, 
-			  Option.fold
-			  (default, 0wx55555555, 
-			   fn (l, w) => 
-			   hash2 (Label.hash l, w)),
-			  fn (l, w) => 
-			  hash2 (Label.hash l, w)))
-	     | Goto {dst, args} =>
-		  hashVars (args, Label.hash dst)
-	     | Raise xs => hashVars (xs, raisee)
-	     | Return xs => hashVars (xs, return)
-	     | Runtime {args, return, ...} => hashVars (args, Label.hash return)
+         val hash: t -> Word.t =
+            fn Arith {args, overflow, success, ...} =>
+                  hashVars (args, hash2 (Label.hash overflow,
+                                         Label.hash success))
+             | Bug => bug
+             | Call {func, args, return} =>
+                  hashVars (args, hash2 (Func.hash func, Return.hash return))
+             | Case {test, cases, default} =>
+                  hash2 (Var.hash test, 
+                         Cases.fold
+                         (cases, 
+                          Option.fold
+                          (default, 0wx55555555, 
+                           fn (l, w) => 
+                           hash2 (Label.hash l, w)),
+                          fn (l, w) => 
+                          hash2 (Label.hash l, w)))
+             | Goto {dst, args} =>
+                  hashVars (args, Label.hash dst)
+             | Raise xs => hashVars (xs, raisee)
+             | Return xs => hashVars (xs, return)
+             | Runtime {args, return, ...} => hashVars (args, Label.hash return)
       end
 
-      val hash = Trace.trace ("Transfer.hash", layout, Word.layout) hash
+      val hash = Trace.trace ("SsaTree2.Transfer.hash", layout, Word.layout) hash
 
    end
 datatype z = datatype Transfer.t
@@ -1250,77 +1250,77 @@
 in
    fun layoutFormals (xts: (Var.t * Type.t) vector) =
       Vector.layout (fn (x, t) =>
-		    seq [Var.layout x,
-			 if !Control.showTypes
-			    then seq [str ": ", Type.layout t]
-			 else empty])
+                    seq [Var.layout x,
+                         if !Control.showTypes
+                            then seq [str ": ", Type.layout t]
+                         else empty])
       xts
 end
 
 structure Block =
    struct
       datatype t =
-	 T of {args: (Var.t * Type.t) vector,
-	       label: Label.t,
-	       statements: Statement.t vector,
-	       transfer: Transfer.t}
-	 
+         T of {args: (Var.t * Type.t) vector,
+               label: Label.t,
+               statements: Statement.t vector,
+               transfer: Transfer.t}
+         
       local
-	 fun make f (T r) = f r
+         fun make f (T r) = f r
       in
-	 val args = make #args
-	 val label = make #label
-	 val statements = make #statements
-	 val transfer = make #transfer
+         val args = make #args
+         val label = make #label
+         val statements = make #statements
+         val transfer = make #transfer
       end
    
       fun layout (T {label, args, statements, transfer}) =
-	 let
-	    open Layout
-	 in
-	    align [seq [Label.layout label, str " ",
-			Vector.layout (fn (x, t) =>
-				       if !Control.showTypes
-					  then seq [Var.layout x, str ": ",
-						    Type.layout t]
-				       else Var.layout x) args],
-		   indent (align
-			   [align
-			    (Vector.toListMap (statements, Statement.layout)),
-			    Transfer.layout transfer],
-			   2)]
-	 end
+         let
+            open Layout
+         in
+            align [seq [Label.layout label, str " ",
+                        Vector.layout (fn (x, t) =>
+                                       if !Control.showTypes
+                                          then seq [Var.layout x, str ": ",
+                                                    Type.layout t]
+                                       else Var.layout x) args],
+                   indent (align
+                           [align
+                            (Vector.toListMap (statements, Statement.layout)),
+                            Transfer.layout transfer],
+                           2)]
+         end
 
       fun clear (T {label, args, statements, ...}) =
-	 (Label.clear label
-	  ; Vector.foreach (args, Var.clear o #1)
-	  ; Vector.foreach (statements, Statement.clear))
+         (Label.clear label
+          ; Vector.foreach (args, Var.clear o #1)
+          ; Vector.foreach (statements, Statement.clear))
    end
 
 structure Datatype =
    struct
       datatype t =
-	 T of {cons: {args: Type.t Prod.t,
-		      con: Con.t} vector,
-	       tycon: Tycon.t}
+         T of {cons: {args: Type.t Prod.t,
+                      con: Con.t} vector,
+               tycon: Tycon.t}
 
       fun layout (T {cons, tycon}) =
-	 let
-	    open Layout
-	 in
-	    seq [Tycon.layout tycon,
-		 str " = ",
-		 alignPrefix
-		 (Vector.toListMap
-		  (cons, fn {con, args} =>
-		   seq [Con.layout con, str " of ",
-			Prod.layout (args, Type.layout)]),
-		  "| ")]
-	 end
+         let
+            open Layout
+         in
+            seq [Tycon.layout tycon,
+                 str " = ",
+                 alignPrefix
+                 (Vector.toListMap
+                  (cons, fn {con, args} =>
+                   seq [Con.layout con, str " of ",
+                        Prod.layout (args, Type.layout)]),
+                  "| ")]
+         end
 
       fun clear (T {cons, tycon}) =
-	 (Tycon.clear tycon
-	  ; Vector.foreach (cons, Con.clear o #con))
+         (Tycon.clear tycon
+          ; Vector.foreach (cons, Con.clear o #con))
    end
 
 structure Function =
@@ -1328,12 +1328,12 @@
       structure CPromise = ClearablePromise
      
       type dest = {args: (Var.t * Type.t) vector,
-		   blocks: Block.t vector,
-		   mayInline: bool,
-		   name: Func.t,
-		   raises: Type.t vector option,
-		   returns: Type.t vector option,
-		   start: Label.t}
+                   blocks: Block.t vector,
+                   mayInline: bool,
+                   name: Func.t,
+                   raises: Type.t vector option,
+                   returns: Type.t vector option,
+                   start: Label.t}
 
       (* There is a messy interaction between the laziness used in controlFlow
        * and the property lists on labels because the former stores
@@ -1343,605 +1343,593 @@
        * the laziness when the properties are cleared.
        *)
       datatype t =
-	 T of {controlFlow:
-	       {dfsTree: unit -> Block.t Tree.t,
-		dominatorTree: unit -> Block.t Tree.t,
-		graph: unit DirectedGraph.t,
-		labelNode: Label.t -> unit DirectedGraph.Node.t,
-		nodeBlock: unit DirectedGraph.Node.t -> Block.t} CPromise.t,
-	       dest: dest}
+         T of {controlFlow:
+               {dfsTree: unit -> Block.t Tree.t,
+                dominatorTree: unit -> Block.t Tree.t,
+                graph: unit DirectedGraph.t,
+                labelNode: Label.t -> unit DirectedGraph.Node.t,
+                nodeBlock: unit DirectedGraph.Node.t -> Block.t} CPromise.t,
+               dest: dest}
 
       local
-	 fun make f (T {dest, ...}) = f dest
+         fun make f (T {dest, ...}) = f dest
       in
-	 val blocks = make #blocks
-	 val dest = make (fn d => d)
-	 val name = make #name
-	 val start = make #start
+         val blocks = make #blocks
+         val dest = make (fn d => d)
+         val name = make #name
+         val start = make #start
       end
 
       fun foreachVar (f: t, fx: Var.t * Type.t -> unit): unit =
-	 let
-	    val {args, blocks, ...} = dest f
-	    val _ = Vector.foreach (args, fx)
-	    val _ =
-	       Vector.foreach
-	       (blocks, fn Block.T {args, statements, ...} =>
-		(Vector.foreach (args, fx)
-		 ; Vector.foreach (statements, fn s =>
-				   Statement.foreachDef (s, fx))))
-	 in
-	    ()
-	 end
+         let
+            val {args, blocks, ...} = dest f
+            val _ = Vector.foreach (args, fx)
+            val _ =
+               Vector.foreach
+               (blocks, fn Block.T {args, statements, ...} =>
+                (Vector.foreach (args, fx)
+                 ; Vector.foreach (statements, fn s =>
+                                   Statement.foreachDef (s, fx))))
+         in
+            ()
+         end
 
       fun controlFlow (T {controlFlow, ...}) =
-	 let
-	    val {graph, labelNode, nodeBlock, ...} = CPromise.force controlFlow
-	 in
-	    {graph = graph, labelNode = labelNode, nodeBlock = nodeBlock}
-	 end
+         let
+            val {graph, labelNode, nodeBlock, ...} = CPromise.force controlFlow
+         in
+            {graph = graph, labelNode = labelNode, nodeBlock = nodeBlock}
+         end
 
       local
-	 fun make sel =
-	    fn T {controlFlow, ...} => sel (CPromise.force controlFlow) ()
+         fun make sel =
+            fn T {controlFlow, ...} => sel (CPromise.force controlFlow) ()
       in
-	 val dominatorTree = make #dominatorTree
+         val dominatorTree = make #dominatorTree
       end
 
       fun dfs (f, v) =
-	 let
-	    val {blocks, start, ...} = dest f
-	    val numBlocks = Vector.length blocks
-	    val {get = labelIndex, set = setLabelIndex, rem, ...} =
-	       Property.getSetOnce (Label.plist,
-				    Property.initRaise ("index", Label.layout))
-	    val _ = Vector.foreachi (blocks, fn (i, Block.T {label, ...}) =>
-				     setLabelIndex (label, i))
-	    val visited = Array.array (numBlocks, false)
-	    fun visit (l: Label.t): unit =
-	       let
-		  val i = labelIndex l
-	       in
-		  if Array.sub (visited, i)
-		     then ()
-		  else
-		     let
-			val _ = Array.update (visited, i, true)
-			val b as Block.T {transfer, ...} =
-			   Vector.sub (blocks, i)
-			val v' = v b
-			val _ = Transfer.foreachLabel (transfer, visit)
-			val _ = v' ()
-		     in
-			()
-		     end
-	       end
-	    val _ = visit start
-	    val _ = Vector.foreach (blocks, rem o Block.label)
-	 in
-	    ()
-	 end
-			    
+         let
+            val {blocks, start, ...} = dest f
+            val numBlocks = Vector.length blocks
+            val {get = labelIndex, set = setLabelIndex, rem, ...} =
+               Property.getSetOnce (Label.plist,
+                                    Property.initRaise ("index", Label.layout))
+            val _ = Vector.foreachi (blocks, fn (i, Block.T {label, ...}) =>
+                                     setLabelIndex (label, i))
+            val visited = Array.array (numBlocks, false)
+            fun visit (l: Label.t): unit =
+               let
+                  val i = labelIndex l
+               in
+                  if Array.sub (visited, i)
+                     then ()
+                  else
+                     let
+                        val _ = Array.update (visited, i, true)
+                        val b as Block.T {transfer, ...} =
+                           Vector.sub (blocks, i)
+                        val v' = v b
+                        val _ = Transfer.foreachLabel (transfer, visit)
+                        val _ = v' ()
+                     in
+                        ()
+                     end
+               end
+            val _ = visit start
+            val _ = Vector.foreach (blocks, rem o Block.label)
+         in
+            ()
+         end
+                            
       local
-	 structure Graph = DirectedGraph
-	 structure Node = Graph.Node
-	 structure Edge = Graph.Edge
+         structure Graph = DirectedGraph
+         structure Node = Graph.Node
+         structure Edge = Graph.Edge
       in
-	 fun determineControlFlow ({blocks, name, start, ...}: dest) =
-	    let
-    	       open Dot
-	       val g = Graph.new ()
-	       fun newNode () = Graph.newNode g
-	       val {get = labelNode, ...} =
-		  Property.get
-		  (Label.plist, Property.initFun (fn _ => newNode ()))
-	       val {get = nodeInfo: unit Node.t -> {block: Block.t},
-		    set = setNodeInfo, ...} =
-		  Property.getSetOnce
-		  (Node.plist, Property.initRaise ("info", Node.layout))
-	       val _ =
-		  Vector.foreach
-		  (blocks, fn b as Block.T {label, transfer, ...} =>
-		   let
-		      val from = labelNode label
-		      val _ = setNodeInfo (from, {block = b})
-		      val _ =
-			 Transfer.foreachLabel
-			 (transfer, fn to =>
-			  (ignore o Graph.addEdge) 
-			  (g, {from = from, to = labelNode to}))
-		   in
-		      ()
-		   end)
-	       val root = labelNode start
-	       val dfsTree =
-		  Promise.lazy
-		  (fn () =>
-		   Graph.dfsTree (g, {root = root,
-				      nodeValue = #block o nodeInfo})
-		   handle exn => Error.bug (concat ["dfsTree: ",
-						    Func.toString name,
-						    ":",
-						    case exn
-						      of Fail s => s
-						       | _ => "???"]))
-	       val dominatorTree =
-		  Promise.lazy
-		  (fn () =>
-		   Graph.dominatorTree (g, {root = root,
-					    nodeValue = #block o nodeInfo})
-		   handle exn => Error.bug (concat ["dominatorTree: ",
-						    Func.toString name,
-						    ":",
-						    case exn
-						       of Fail s => s
-						     | _ => "???"]))
-	    in
-	       {dfsTree = dfsTree,
-		dominatorTree = dominatorTree,
-		graph = g,
-		labelNode = labelNode,
-		nodeBlock = #block o nodeInfo}
-	    end
+         fun determineControlFlow ({blocks, start, ...}: dest) =
+            let
+               open Dot
+               val g = Graph.new ()
+               fun newNode () = Graph.newNode g
+               val {get = labelNode, ...} =
+                  Property.get
+                  (Label.plist, Property.initFun (fn _ => newNode ()))
+               val {get = nodeInfo: unit Node.t -> {block: Block.t},
+                    set = setNodeInfo, ...} =
+                  Property.getSetOnce
+                  (Node.plist, Property.initRaise ("info", Node.layout))
+               val _ =
+                  Vector.foreach
+                  (blocks, fn b as Block.T {label, transfer, ...} =>
+                   let
+                      val from = labelNode label
+                      val _ = setNodeInfo (from, {block = b})
+                      val _ =
+                         Transfer.foreachLabel
+                         (transfer, fn to =>
+                          (ignore o Graph.addEdge) 
+                          (g, {from = from, to = labelNode to}))
+                   in
+                      ()
+                   end)
+               val root = labelNode start
+               val dfsTree =
+                  Promise.lazy
+                  (fn () =>
+                   Graph.dfsTree (g, {root = root,
+                                      nodeValue = #block o nodeInfo}))
+               val dominatorTree =
+                  Promise.lazy
+                  (fn () =>
+                   Graph.dominatorTree (g, {root = root,
+                                            nodeValue = #block o nodeInfo}))
+            in
+               {dfsTree = dfsTree,
+                dominatorTree = dominatorTree,
+                graph = g,
+                labelNode = labelNode,
+                nodeBlock = #block o nodeInfo}
+            end
 
-	 fun layoutDot (f, global: Var.t -> string option) =
-	    let
-	       val {name, start, blocks, ...} = dest f
-	       fun makeName (name: string,
-			     formals: (Var.t * Type.t) vector): string =
-		  concat [name, " ",
-			  let
-			     open Layout
-			  in
-			     toString
-			     (vector
-			      (Vector.map
-			       (formals, fn (var, ty) =>
-				if !Control.showTypes
-				   then seq [Var.layout var,
-					     str ": ",
-					     Type.layout ty]
-				else Var.layout var)))
-			  end]
-	       open Dot
-	       val graph = Graph.new ()
-	       val {get = nodeOptions, ...} =
-		  Property.get (Node.plist, Property.initFun (fn _ => ref []))
-	       fun setNodeText (n: unit Node.t, l): unit =
-		  List.push (nodeOptions n, NodeOption.Label l)
-	       fun newNode () = Graph.newNode graph
-	       val {destroy, get = labelNode} =
-		  Property.destGet (Label.plist,
-				    Property.initFun (fn _ => newNode ()))
-	       val {get = edgeOptions, set = setEdgeOptions, ...} =
-		  Property.getSetOnce (Edge.plist, Property.initConst [])
-	       val _ =
-		  Vector.foreach
-		  (blocks, fn Block.T {label, args, statements, transfer} =>
-		   let
-		      val from = labelNode label
-		      fun edge (to: Label.t,
-				label: string,
-				style: style): unit =
-			 let
-			    val e = Graph.addEdge (graph, {from = from,
-							   to = labelNode to})
-			    val _ = setEdgeOptions (e, [EdgeOption.label label,
-							EdgeOption.Style style])
-			 in
-			    ()
-			 end
-		      val rest =
-			 case transfer of
-			    Arith {prim, args, overflow, success, ...} =>
-			       (edge (success, "", Solid)
-				; edge (overflow, "Overflow", Dashed)
-				; [Layout.toString
-				   (Prim.layoutApp (prim, args, fn x =>
-						    Layout.str
-						    (Var.pretty (x, global))))])
-			  | Bug => ["bug"]
-			  | Call {func, args, return} =>
-			       let
-				  val f = Func.toString func
-				  val args = Var.prettys (args, global)
-				  val _ =
-				     case return of
-					Return.Dead => ()
-				      | Return.NonTail {cont, handler} =>
-					   (edge (cont, "", Dotted)
-					    ; (Handler.foreachLabel
-					       (handler, fn l =>
-						edge (l, "", Dashed))))
-				      | Return.Tail => ()
-			       in
-				  [f, " ", args]
-			       end
-			  | Case {test, cases, default, ...} =>
-			       let
-				  fun doit (v, toString) =
-				     Vector.foreach
-				     (v, fn (x, j) =>
-				      edge (j, toString x, Solid))
-				  val _ =
-				     case cases of
-					Cases.Con v => doit (v, Con.toString)
-				      | Cases.Word (_, v) =>
-					   doit (v, WordX.toString)
-				  val _ = 
-				     case default of
-					NONE => ()
-				      | SOME j =>
-					   edge (j, "default", Solid)
-			       in
-				  ["case ", Var.toString test]
-			       end
-			  | Goto {dst, args} =>
-			       (edge (dst, "", Solid)
-				; [Label.toString dst, " ",
-				   Var.prettys (args, global)])
-			  | Raise xs => ["raise ", Var.prettys (xs, global)]
-			  | Return xs => ["return ", Var.prettys (xs, global)]
-			  | Runtime {prim, args, return} =>
-			       (edge (return, "", Solid)
-				; [Layout.toString
-				   (Prim.layoutApp (prim, args, fn x =>
-						    Layout.str
-						    (Var.pretty (x, global))))])
-		      val lab =
-			 Vector.foldr
-			 (statements, [(concat rest, Left)], fn (s, ac) =>
-			  let
-			     val s =
-				case s of
-				   Bind {exp, ty, var} =>
-				      let
-					 val exp = Exp.toPretty (exp, global)
-				      in
-					 if Type.isUnit ty
-					    then exp
-					 else
-					    case var of
-					       NONE => exp
-					     | SOME var =>
-						  concat [Var.toString var,
-							  if !Control.showTypes
-							     then concat [": ",
-									  Layout.toString
-									  (Type.layout ty)]
-							  else "",
-							     " = ", exp]
-				      end
-				 | _ => Statement.toPretty (s, global)
-			  in
-			     (s, Left) :: ac
-			  end)
-		      val name = makeName (Label.toString label, args)
-		      val _ = setNodeText (from, (name, Left) :: lab)
-		   in
-		      ()
-		   end)
-	       val root = labelNode start
-	       val graphLayout =
-		  Graph.layoutDot
-		  (graph, fn {nodeName} => 
-		   {title = concat [Func.toString name, " control-flow graph"],
-		    options = [GraphOption.Rank (Min, [{nodeName = nodeName root}])],
-		    edgeOptions = edgeOptions,
-		    nodeOptions =
-		    fn n => let
-			       val l = ! (nodeOptions n)
-			       open NodeOption
-			    in FontColor Black :: Shape Box :: l
-			    end})
-	       fun treeLayout () =
-		  let
-		     val _ =
-			Vector.foreach
-			(blocks, fn Block.T {label, ...} =>
-			 nodeOptions (labelNode label)
-			 := [NodeOption.label (Label.toString label)])
-		     val treeLayout =
-			Tree.layoutDot
-			(Graph.dominatorTree (graph,
-					      {root = root,
-					       nodeValue = ! o nodeOptions}),
-			 {title = concat [Func.toString name, " dominator tree"],
-			  options = [],
-			  nodeOptions = fn z => z})
-		     val _ = destroy ()
-		  in
-		     treeLayout
-		  end
-	    in
-	       {graph = graphLayout,
-		tree = treeLayout}
-	    end
+         fun layoutDot (f, global: Var.t -> string option) =
+            let
+               val {name, start, blocks, ...} = dest f
+               fun makeName (name: string,
+                             formals: (Var.t * Type.t) vector): string =
+                  concat [name, " ",
+                          let
+                             open Layout
+                          in
+                             toString
+                             (vector
+                              (Vector.map
+                               (formals, fn (var, ty) =>
+                                if !Control.showTypes
+                                   then seq [Var.layout var,
+                                             str ": ",
+                                             Type.layout ty]
+                                else Var.layout var)))
+                          end]
+               open Dot
+               val graph = Graph.new ()
+               val {get = nodeOptions, ...} =
+                  Property.get (Node.plist, Property.initFun (fn _ => ref []))
+               fun setNodeText (n: unit Node.t, l): unit =
+                  List.push (nodeOptions n, NodeOption.Label l)
+               fun newNode () = Graph.newNode graph
+               val {destroy, get = labelNode} =
+                  Property.destGet (Label.plist,
+                                    Property.initFun (fn _ => newNode ()))
+               val {get = edgeOptions, set = setEdgeOptions, ...} =
+                  Property.getSetOnce (Edge.plist, Property.initConst [])
+               val _ =
+                  Vector.foreach
+                  (blocks, fn Block.T {label, args, statements, transfer} =>
+                   let
+                      val from = labelNode label
+                      fun edge (to: Label.t,
+                                label: string,
+                                style: style): unit =
+                         let
+                            val e = Graph.addEdge (graph, {from = from,
+                                                           to = labelNode to})
+                            val _ = setEdgeOptions (e, [EdgeOption.label label,
+                                                        EdgeOption.Style style])
+                         in
+                            ()
+                         end
+                      val rest =
+                         case transfer of
+                            Arith {prim, args, overflow, success, ...} =>
+                               (edge (success, "", Solid)
+                                ; edge (overflow, "Overflow", Dashed)
+                                ; [Layout.toString
+                                   (Prim.layoutApp (prim, args, fn x =>
+                                                    Layout.str
+                                                    (Var.pretty (x, global))))])
+                          | Bug => ["bug"]
+                          | Call {func, args, return} =>
+                               let
+                                  val f = Func.toString func
+                                  val args = Var.prettys (args, global)
+                                  val _ =
+                                     case return of
+                                        Return.Dead => ()
+                                      | Return.NonTail {cont, handler} =>
+                                           (edge (cont, "", Dotted)
+                                            ; (Handler.foreachLabel
+                                               (handler, fn l =>
+                                                edge (l, "", Dashed))))
+                                      | Return.Tail => ()
+                               in
+                                  [f, " ", args]
+                               end
+                          | Case {test, cases, default, ...} =>
+                               let
+                                  fun doit (v, toString) =
+                                     Vector.foreach
+                                     (v, fn (x, j) =>
+                                      edge (j, toString x, Solid))
+                                  val _ =
+                                     case cases of
+                                        Cases.Con v => doit (v, Con.toString)
+                                      | Cases.Word (_, v) =>
+                                           doit (v, WordX.toString)
+                                  val _ = 
+                                     case default of
+                                        NONE => ()
+                                      | SOME j =>
+                                           edge (j, "default", Solid)
+                               in
+                                  ["case ", Var.toString test]
+                               end
+                          | Goto {dst, args} =>
+                               (edge (dst, "", Solid)
+                                ; [Label.toString dst, " ",
+                                   Var.prettys (args, global)])
+                          | Raise xs => ["raise ", Var.prettys (xs, global)]
+                          | Return xs => ["return ", Var.prettys (xs, global)]
+                          | Runtime {prim, args, return} =>
+                               (edge (return, "", Solid)
+                                ; [Layout.toString
+                                   (Prim.layoutApp (prim, args, fn x =>
+                                                    Layout.str
+                                                    (Var.pretty (x, global))))])
+                      val lab =
+                         Vector.foldr
+                         (statements, [(concat rest, Left)], fn (s, ac) =>
+                          let
+                             val s =
+                                case s of
+                                   Bind {exp, ty, var} =>
+                                      let
+                                         val exp = Exp.toPretty (exp, global)
+                                      in
+                                         if Type.isUnit ty
+                                            then exp
+                                         else
+                                            case var of
+                                               NONE => exp
+                                             | SOME var =>
+                                                  concat [Var.toString var,
+                                                          if !Control.showTypes
+                                                             then concat [": ",
+                                                                          Layout.toString
+                                                                          (Type.layout ty)]
+                                                          else "",
+                                                             " = ", exp]
+                                      end
+                                 | _ => Statement.toPretty (s, global)
+                          in
+                             (s, Left) :: ac
+                          end)
+                      val name = makeName (Label.toString label, args)
+                      val _ = setNodeText (from, (name, Left) :: lab)
+                   in
+                      ()
+                   end)
+               val root = labelNode start
+               val graphLayout =
+                  Graph.layoutDot
+                  (graph, fn {nodeName} => 
+                   {title = concat [Func.toString name, " control-flow graph"],
+                    options = [GraphOption.Rank (Min, [{nodeName = nodeName root}])],
+                    edgeOptions = edgeOptions,
+                    nodeOptions =
+                    fn n => let
+                               val l = ! (nodeOptions n)
+                               open NodeOption
+                            in FontColor Black :: Shape Box :: l
+                            end})
+               fun treeLayout () =
+                  let
+                     val _ =
+                        Vector.foreach
+                        (blocks, fn Block.T {label, ...} =>
+                         nodeOptions (labelNode label)
+                         := [NodeOption.label (Label.toString label)])
+                     val treeLayout =
+                        Tree.layoutDot
+                        (Graph.dominatorTree (graph,
+                                              {root = root,
+                                               nodeValue = ! o nodeOptions}),
+                         {title = concat [Func.toString name, " dominator tree"],
+                          options = [],
+                          nodeOptions = fn z => z})
+                     val _ = destroy ()
+                  in
+                     treeLayout
+                  end
+            in
+               {graph = graphLayout,
+                tree = treeLayout}
+            end
       end
 
       fun new (dest: dest) =
-	 let
-	    val controlFlow = CPromise.delay (fn () => determineControlFlow dest)
-	 in
-	    T {controlFlow = controlFlow,
-	       dest = dest}
-	 end
+         let
+            val controlFlow = CPromise.delay (fn () => determineControlFlow dest)
+         in
+            T {controlFlow = controlFlow,
+               dest = dest}
+         end
 
       fun clear (T {controlFlow, dest, ...}) =
-	 let
-	    val {args, blocks, ...} = dest
-	    val _ = (Vector.foreach (args, Var.clear o #1)
-		     ; Vector.foreach (blocks, Block.clear))
-      	    val _ = CPromise.clear controlFlow
-	 in
-	    ()
-	 end
+         let
+            val {args, blocks, ...} = dest
+            val _ = (Vector.foreach (args, Var.clear o #1)
+                     ; Vector.foreach (blocks, Block.clear))
+            val _ = CPromise.clear controlFlow
+         in
+            ()
+         end
 
       fun layoutHeader (f: t): Layout.t =
-	 let
-	    val {args, name, raises, returns, start, ...} = dest f
-	    open Layout
-	 in
-	    seq [str "fun ",
-		 Func.layout name,
-		 str " ",
-		 layoutFormals args,
-		 if !Control.showTypes
-		    then seq [str ": ",
-			      record [("raises",
-				       Option.layout
-				       (Vector.layout Type.layout) raises),
-				      ("returns",
-				       Option.layout
-				       (Vector.layout Type.layout) returns)]]
-		 else empty,
-		    str " = ", Label.layout start, str " ()"]
-	 end
+         let
+            val {args, name, raises, returns, start, ...} = dest f
+            open Layout
+         in
+            seq [str "fun ",
+                 Func.layout name,
+                 str " ",
+                 layoutFormals args,
+                 if !Control.showTypes
+                    then seq [str ": ",
+                              record [("raises",
+                                       Option.layout
+                                       (Vector.layout Type.layout) raises),
+                                      ("returns",
+                                       Option.layout
+                                       (Vector.layout Type.layout) returns)]]
+                 else empty,
+                    str " = ", Label.layout start, str " ()"]
+         end
 
       fun layout (f: t) =
-	 let
-	    val {blocks, ...} = dest f
-	    open Layout
-	 in
-	    align [layoutHeader f,
-		   indent (align (Vector.toListMap (blocks, Block.layout)), 2)]
-	 end
+         let
+            val {blocks, ...} = dest f
+            open Layout
+         in
+            align [layoutHeader f,
+                   indent (align (Vector.toListMap (blocks, Block.layout)), 2)]
+         end
       
       fun layouts (f: t, global, output: Layout.t -> unit): unit =
-	 let
-	    val {blocks, name, ...} = dest f
-	    val _ = output (layoutHeader f)
-	    val _ = Vector.foreach (blocks, fn b =>
-				    output (Layout.indent (Block.layout b, 2)))
-	    val _ =
-	       if not (!Control.keepDot)
-		  then ()
-	       else
-		  let
-		     val {graph, tree} = layoutDot (f, global)
-		     val name = Func.toString name
-		     fun doit (s, g) =
-			let
-			   open Control
-			in
-			   saveToFile
-			   ({suffix = concat [name, ".", s, ".dot"]},
-			    Dot, (), Layout (fn () => g))
-			end
-		     val _ = doit ("cfg", graph)
-			handle _ => Error.warning "couldn't layout cfg"
-		     val _ = doit ("dom", tree ())
-			handle _ => Error.warning "couldn't layout dom"
-		  in
-		     ()
-		  end
-	 in
-	    ()
-	 end
+         let
+            val {blocks, name, ...} = dest f
+            val _ = output (layoutHeader f)
+            val _ = Vector.foreach (blocks, fn b =>
+                                    output (Layout.indent (Block.layout b, 2)))
+            val _ =
+               if not (!Control.keepDot)
+                  then ()
+               else
+                  let
+                     val {graph, tree} = layoutDot (f, global)
+                     val name = Func.toString name
+                     fun doit (s, g) =
+                        let
+                           open Control
+                        in
+                           saveToFile
+                           ({suffix = concat [name, ".", s, ".dot"]},
+                            Dot, (), Layout (fn () => g))
+                        end
+                     val _ = doit ("cfg", graph)
+                        handle _ => Error.warning "SsaTree2.layouts: couldn't layout cfg"
+                     val _ = doit ("dom", tree ())
+                        handle _ => Error.warning "SsaTree2.layouts: couldn't layout dom"
+                  in
+                     ()
+                  end
+         in
+            ()
+         end
 
       fun alphaRename f =
-	 let
-	    local
-	       fun make (new, plist) =
-		  let
-		     val {get, set, destroy, ...} = 
-		        Property.destGetSetOnce (plist, Property.initConst NONE)
-		     fun bind x =
-			let
-			   val x' = new x
-			   val _ = set (x, SOME x')
-			in
-			   x'
-			end
-		     fun lookup x =
-		        case get x of
-			   NONE => x
-			 | SOME y => y
-		  in (bind, lookup, destroy)
-		  end
-	    in
-	       val (bindVar, lookupVar, destroyVar) =
-		  make (Var.new, Var.plist)
-	       val (bindLabel, lookupLabel, destroyLabel) =
-		  make (Label.new, Label.plist)
-	    end
-	    val {args, blocks, mayInline, name, raises, returns, start, ...} =
-	       dest f
-	    val args = Vector.map (args, fn (x, ty) => (bindVar x, ty))
-	    val bindLabel = ignore o bindLabel
-	    val bindVar = ignore o bindVar
-	    val _ = 
-	       Vector.foreach
-	       (blocks, fn Block.T {label, args, statements, ...} => 
-		(bindLabel label
-		 ; Vector.foreach (args, fn (x, _) => bindVar x)
-		 ; Vector.foreach (statements, fn s =>
-				   Statement.foreachDef (s, bindVar o #1))))
-	    val blocks = 
-	       Vector.map
-	       (blocks, fn Block.T {label, args, statements, transfer} =>
-		Block.T {label = lookupLabel label,
-			 args = Vector.map (args, fn (x, ty) =>
-					    (lookupVar x, ty)),
-			 statements = (Vector.map
-				       (statements, fn s =>
-					Statement.replaceDefsUses
-					(s, {def = lookupVar,
-					     use = lookupVar}))),
-			 transfer = Transfer.replaceLabelVar
-			            (transfer, lookupLabel, lookupVar)})
-	    val start = lookupLabel start
-	    val _ = destroyVar ()
-	    val _ = destroyLabel ()
-	 in
-	    new {args = args,
-		 blocks = blocks,
-		 mayInline = mayInline,
-		 name = name,
-		 raises = raises,
-		 returns = returns,
-		 start = start}
-	 end
+         let
+            local
+               fun make (new, plist) =
+                  let
+                     val {get, set, destroy, ...} = 
+                        Property.destGetSetOnce (plist, Property.initConst NONE)
+                     fun bind x =
+                        let
+                           val x' = new x
+                           val _ = set (x, SOME x')
+                        in
+                           x'
+                        end
+                     fun lookup x =
+                        case get x of
+                           NONE => x
+                         | SOME y => y
+                  in (bind, lookup, destroy)
+                  end
+            in
+               val (bindVar, lookupVar, destroyVar) =
+                  make (Var.new, Var.plist)
+               val (bindLabel, lookupLabel, destroyLabel) =
+                  make (Label.new, Label.plist)
+            end
+            val {args, blocks, mayInline, name, raises, returns, start, ...} =
+               dest f
+            val args = Vector.map (args, fn (x, ty) => (bindVar x, ty))
+            val bindLabel = ignore o bindLabel
+            val bindVar = ignore o bindVar
+            val _ = 
+               Vector.foreach
+               (blocks, fn Block.T {label, args, statements, ...} => 
+                (bindLabel label
+                 ; Vector.foreach (args, fn (x, _) => bindVar x)
+                 ; Vector.foreach (statements, fn s =>
+                                   Statement.foreachDef (s, bindVar o #1))))
+            val blocks = 
+               Vector.map
+               (blocks, fn Block.T {label, args, statements, transfer} =>
+                Block.T {label = lookupLabel label,
+                         args = Vector.map (args, fn (x, ty) =>
+                                            (lookupVar x, ty)),
+                         statements = (Vector.map
+                                       (statements, fn s =>
+                                        Statement.replaceDefsUses
+                                        (s, {def = lookupVar,
+                                             use = lookupVar}))),
+                         transfer = Transfer.replaceLabelVar
+                                    (transfer, lookupLabel, lookupVar)})
+            val start = lookupLabel start
+            val _ = destroyVar ()
+            val _ = destroyLabel ()
+         in
+            new {args = args,
+                 blocks = blocks,
+                 mayInline = mayInline,
+                 name = name,
+                 raises = raises,
+                 returns = returns,
+                 start = start}
+         end
 
       fun profile (f: t, sourceInfo): t =
-	 if !Control.profile = Control.ProfileNone
-	    orelse !Control.profileIL <> Control.ProfileSource
-	    then f
-	 else 
-	 let
-	    val _ = Control.diagnostic (fn () => layout f)
-	    val {args, blocks, mayInline, name, raises, returns, start} = dest f
-	    val extraBlocks = ref []
-	    val {get = labelBlock, set = setLabelBlock, rem} =
-	       Property.getSetOnce
-	       (Label.plist, Property.initRaise ("block", Label.layout))
-	    val _ =
-	       Vector.foreach
-	       (blocks, fn block as Block.T {label, ...} =>
-		setLabelBlock (label, block))
-	    val blocks =
-	       Vector.map
-	       (blocks, fn Block.T {args, label, statements, transfer} =>
-		let
-		   val statements =
-		      if Label.equals (label, start)
-			 then (Vector.concat
-			       [Vector.new1
-				(Profile (ProfileExp.Enter sourceInfo)),
-				statements])
-		      else statements
-		   fun leave () = Profile (ProfileExp.Leave sourceInfo)
-		   fun prefix (l: Label.t,
-			       statements: Statement.t vector): Label.t =
-		      let
-			 val Block.T {args, ...} = labelBlock l
-			 val c = Label.newNoname ()
-			 val xs = Vector.map (args, fn (x, _) => Var.new x)
-			 val _ =
-			    List.push
-			    (extraBlocks,
-			     Block.T
-			     {args = Vector.map2 (xs, args, fn (x, (_, t)) =>
-						  (x, t)),
-			      label = c,
-			      statements = statements,
-			      transfer = Goto {args = xs,
-					       dst = l}})
-		      in
-			 c
-		      end
-		   fun genHandler (cont: Label.t)
-		      : Statement.t vector * Label.t * Handler.t =
-		      case raises of
-			 NONE => (statements, cont, Handler.Caller)
-		       | SOME ts => 
-			    let
-			       val xs = Vector.map (ts, fn _ => Var.newNoname ())
-			       val l = Label.newNoname ()
-			       val _ =
-				  List.push
-				  (extraBlocks,
-				   Block.T
-				   {args = Vector.zip (xs, ts),
-				    label = l,
-				    statements = Vector.new1 (leave ()),
-				    transfer = Transfer.Raise xs})
-			    in
-			       (statements,
-				prefix (cont, Vector.new0 ()),
-				Handler.Handle l)
-			    end
-		   fun addLeave () =
-		      (Vector.concat [statements,
-				      Vector.new1 (leave ())],
-		       transfer)
-		   val (statements, transfer) =
-		      case transfer of
-			 Call {args, func, return} =>
-			    let
-			       datatype z = datatype Return.t
-			    in
-			       case return of
-				  Dead => (statements, transfer)
-				| NonTail {cont, handler} =>
-				     (case handler of
-					 Handler.Dead => (statements, transfer)
-				       | Handler.Caller =>
-					    let
-					       val (statements, cont, handler) =
-						  genHandler cont
-					       val return =
-						  Return.NonTail
-						  {cont = cont,
-						   handler = handler}
-					    in
-					       (statements,
-						Call {args = args,
-						      func = func,
-						      return = return})
-					    end
-				       | Handler.Handle _ =>
-					    (statements, transfer))
-				| Tail => addLeave ()
-			    end
-		       | Raise _ => addLeave ()
-		       | Return _ => addLeave ()
-		       | _ => (statements, transfer)
-		in
-		   Block.T {args = args,
-			    label = label,
-			    statements = statements,
-			    transfer = transfer}
-		end)
-	    val _ = Vector.foreach (blocks, rem o Block.label)
-	    val blocks = Vector.concat [Vector.fromList (!extraBlocks), blocks]
-	    val f = 
-	       new {args = args,
-		    blocks = blocks,
-		    mayInline = mayInline,
-		    name = name,
-		    raises = raises,
-		    returns = returns,
-		    start = start}
-	    val _ = Control.diagnostic (fn () => layout f)
-	 in
-	    f
-	 end
+         if !Control.profile = Control.ProfileNone
+            orelse !Control.profileIL <> Control.ProfileSource
+            then f
+         else 
+         let
+            val _ = Control.diagnostic (fn () => layout f)
+            val {args, blocks, mayInline, name, raises, returns, start} = dest f
+            val extraBlocks = ref []
+            val {get = labelBlock, set = setLabelBlock, rem} =
+               Property.getSetOnce
+               (Label.plist, Property.initRaise ("block", Label.layout))
+            val _ =
+               Vector.foreach
+               (blocks, fn block as Block.T {label, ...} =>
+                setLabelBlock (label, block))
+            val blocks =
+               Vector.map
+               (blocks, fn Block.T {args, label, statements, transfer} =>
+                let
+                   val statements =
+                      if Label.equals (label, start)
+                         then (Vector.concat
+                               [Vector.new1
+                                (Profile (ProfileExp.Enter sourceInfo)),
+                                statements])
+                      else statements
+                   fun leave () = Profile (ProfileExp.Leave sourceInfo)
+                   fun prefix (l: Label.t,
+                               statements: Statement.t vector): Label.t =
+                      let
+                         val Block.T {args, ...} = labelBlock l
+                         val c = Label.newNoname ()
+                         val xs = Vector.map (args, fn (x, _) => Var.new x)
+                         val _ =
+                            List.push
+                            (extraBlocks,
+                             Block.T
+                             {args = Vector.map2 (xs, args, fn (x, (_, t)) =>
+                                                  (x, t)),
+                              label = c,
+                              statements = statements,
+                              transfer = Goto {args = xs,
+                                               dst = l}})
+                      in
+                         c
+                      end
+                   fun genHandler (cont: Label.t)
+                      : Statement.t vector * Label.t * Handler.t =
+                      case raises of
+                         NONE => (statements, cont, Handler.Caller)
+                       | SOME ts => 
+                            let
+                               val xs = Vector.map (ts, fn _ => Var.newNoname ())
+                               val l = Label.newNoname ()
+                               val _ =
+                                  List.push
+                                  (extraBlocks,
+                                   Block.T
+                                   {args = Vector.zip (xs, ts),
+                                    label = l,
+                                    statements = Vector.new1 (leave ()),
+                                    transfer = Transfer.Raise xs})
+                            in
+                               (statements,
+                                prefix (cont, Vector.new0 ()),
+                                Handler.Handle l)
+                            end
+                   fun addLeave () =
+                      (Vector.concat [statements,
+                                      Vector.new1 (leave ())],
+                       transfer)
+                   val (statements, transfer) =
+                      case transfer of
+                         Call {args, func, return} =>
+                            let
+                               datatype z = datatype Return.t
+                            in
+                               case return of
+                                  Dead => (statements, transfer)
+                                | NonTail {cont, handler} =>
+                                     (case handler of
+                                         Handler.Dead => (statements, transfer)
+                                       | Handler.Caller =>
+                                            let
+                                               val (statements, cont, handler) =
+                                                  genHandler cont
+                                               val return =
+                                                  Return.NonTail
+                                                  {cont = cont,
+                                                   handler = handler}
+                                            in
+                                               (statements,
+                                                Call {args = args,
+                                                      func = func,
+                                                      return = return})
+                                            end
+                                       | Handler.Handle _ =>
+                                            (statements, transfer))
+                                | Tail => addLeave ()
+                            end
+                       | Raise _ => addLeave ()
+                       | Return _ => addLeave ()
+                       | _ => (statements, transfer)
+                in
+                   Block.T {args = args,
+                            label = label,
+                            statements = statements,
+                            transfer = transfer}
+                end)
+            val _ = Vector.foreach (blocks, rem o Block.label)
+            val blocks = Vector.concat [Vector.fromList (!extraBlocks), blocks]
+            val f = 
+               new {args = args,
+                    blocks = blocks,
+                    mayInline = mayInline,
+                    name = name,
+                    raises = raises,
+                    returns = returns,
+                    start = start}
+            val _ = Control.diagnostic (fn () => layout f)
+         in
+            f
+         end
 
       val profile =
-	 Trace.trace2 ("Ssa.Function.profile", layout, SourceInfo.layout, layout)
-	 profile
+         Trace.trace2 ("SsaTree2.Function.profile", layout, SourceInfo.layout, layout)
+         profile
    end
 
 structure Program =
    struct
       datatype t =
-	 T of {
-	       datatypes: Datatype.t vector,
-	       globals: Statement.t vector,
-	       functions: Function.t list,
-	       main: Func.t
-	       }
+         T of {
+               datatypes: Datatype.t vector,
+               globals: Statement.t vector,
+               functions: Function.t list,
+               main: Func.t
+               }
    end
 
 structure Program =
@@ -1949,244 +1937,244 @@
       open Program
  
       local
-	 structure Graph = DirectedGraph
-	 structure Node = Graph.Node
-	 structure Edge = Graph.Edge
+         structure Graph = DirectedGraph
+         structure Node = Graph.Node
+         structure Edge = Graph.Edge
       in
-	 fun layoutCallGraph (T {functions, main, ...},
-			      title: string): Layout.t =
-	    let
-	       open Dot
-	       val graph = Graph.new ()
-	       val {get = nodeOptions, set = setNodeOptions, ...} =
-		  Property.getSetOnce
-		  (Node.plist, Property.initRaise ("options", Node.layout))
-	       val {get = funcNode, destroy} =
-		  Property.destGet
-		  (Func.plist, Property.initFun
-		   (fn f =>
-		    let
-		       val n = Graph.newNode graph
-		       val _ =
-			  setNodeOptions
-			  (n,
-			   let open NodeOption
-			   in [FontColor Black, label (Func.toString f)]
-			   end)
-		    in
-		       n
-		    end))
-	       val {get = edgeOptions, set = setEdgeOptions, ...} =
-		  Property.getSetOnce (Edge.plist, Property.initConst [])
-	       val _ =
-		  List.foreach
-		  (functions, fn f =>
-		   let
-		      val {name, blocks, ...} = Function.dest f
-		      val from = funcNode name
-		      val {get, destroy} =
-			 Property.destGet
-			 (Node.plist,
-			  Property.initFun (fn _ => {nontail = ref false,
-						     tail = ref false}))
-		      val _ = 
-			 Vector.foreach
-			 (blocks, fn Block.T {transfer, ...} =>
-			  case transfer of
-			     Call {func, return, ...} =>
-				let
-				   val to = funcNode func
-				   val {tail, nontail} = get to
-				   datatype z = datatype Return.t
-				   val is =
-				      case return of
-					 Dead => false
-				       | NonTail _ => true
-				       | Tail => false
-				   val r = if is then nontail else tail
-				in
-				   if !r
-				      then ()
-				   else (r := true
-					 ; (setEdgeOptions
-					    (Graph.addEdge
-					     (graph, {from = from, to = to}),
-					     if is
-						then []
-					     else [EdgeOption.Style Dotted])))
-				end
-			   | _ => ())
-		      val _ = destroy ()
-		   in
-		      ()
-		   end)
-	       val root = funcNode main
-	       val l =
-		  Graph.layoutDot
-		  (graph, fn {nodeName} =>
-		   {title = title,
-		    options = [GraphOption.Rank (Min, [{nodeName = nodeName root}])],
-		    edgeOptions = edgeOptions,
-		    nodeOptions = nodeOptions})
-	       val _ = destroy ()
-	    in
-	       l
-	    end
+         fun layoutCallGraph (T {functions, main, ...},
+                              title: string): Layout.t =
+            let
+               open Dot
+               val graph = Graph.new ()
+               val {get = nodeOptions, set = setNodeOptions, ...} =
+                  Property.getSetOnce
+                  (Node.plist, Property.initRaise ("options", Node.layout))
+               val {get = funcNode, destroy} =
+                  Property.destGet
+                  (Func.plist, Property.initFun
+                   (fn f =>
+                    let
+                       val n = Graph.newNode graph
+                       val _ =
+                          setNodeOptions
+                          (n,
+                           let open NodeOption
+                           in [FontColor Black, label (Func.toString f)]
+                           end)
+                    in
+                       n
+                    end))
+               val {get = edgeOptions, set = setEdgeOptions, ...} =
+                  Property.getSetOnce (Edge.plist, Property.initConst [])
+               val _ =
+                  List.foreach
+                  (functions, fn f =>
+                   let
+                      val {name, blocks, ...} = Function.dest f
+                      val from = funcNode name
+                      val {get, destroy} =
+                         Property.destGet
+                         (Node.plist,
+                          Property.initFun (fn _ => {nontail = ref false,
+                                                     tail = ref false}))
+                      val _ = 
+                         Vector.foreach
+                         (blocks, fn Block.T {transfer, ...} =>
+                          case transfer of
+                             Call {func, return, ...} =>
+                                let
+                                   val to = funcNode func
+                                   val {tail, nontail} = get to
+                                   datatype z = datatype Return.t
+                                   val is =
+                                      case return of
+                                         Dead => false
+                                       | NonTail _ => true
+                                       | Tail => false
+                                   val r = if is then nontail else tail
+                                in
+                                   if !r
+                                      then ()
+                                   else (r := true
+                                         ; (setEdgeOptions
+                                            (Graph.addEdge
+                                             (graph, {from = from, to = to}),
+                                             if is
+                                                then []
+                                             else [EdgeOption.Style Dotted])))
+                                end
+                           | _ => ())
+                      val _ = destroy ()
+                   in
+                      ()
+                   end)
+               val root = funcNode main
+               val l =
+                  Graph.layoutDot
+                  (graph, fn {nodeName} =>
+                   {title = title,
+                    options = [GraphOption.Rank (Min, [{nodeName = nodeName root}])],
+                    edgeOptions = edgeOptions,
+                    nodeOptions = nodeOptions})
+               val _ = destroy ()
+            in
+               l
+            end
       end
-	 
+         
       fun layouts (p as T {datatypes, globals, functions, main},
-		   output': Layout.t -> unit) =
-	 let
-	    val global = Statement.prettifyGlobals globals
-	    open Layout
-	    (* Layout includes an output function, so we need to rebind output
-	     * to the one above.
-	     *)
-	    val output = output' 
-	 in
-	    output (str "\n\nDatatypes:")
-	    ; Vector.foreach (datatypes, output o Datatype.layout)
-	    ; output (str "\n\nGlobals:")
-	    ; Vector.foreach (globals, output o Statement.layout)
-	    ; output (seq [str "\n\nMain: ", Func.layout main])
-	    ; output (str "\n\nFunctions:")
-	    ; List.foreach (functions, fn f =>
-			    Function.layouts (f, global, output))
-	    ; if not (!Control.keepDot)
-		 then ()
-	      else
-		 let
-		    open Control
-		 in
-		    saveToFile
-		    ({suffix = "call-graph.dot"},
-		     Dot, (), Layout (fn () =>
-				      layoutCallGraph (p, !Control.inputFile)))
-		 end
-	 end
+                   output': Layout.t -> unit) =
+         let
+            val global = Statement.prettifyGlobals globals
+            open Layout
+            (* Layout includes an output function, so we need to rebind output
+             * to the one above.
+             *)
+            val output = output' 
+         in
+            output (str "\n\nDatatypes:")
+            ; Vector.foreach (datatypes, output o Datatype.layout)
+            ; output (str "\n\nGlobals:")
+            ; Vector.foreach (globals, output o Statement.layout)
+            ; output (seq [str "\n\nMain: ", Func.layout main])
+            ; output (str "\n\nFunctions:")
+            ; List.foreach (functions, fn f =>
+                            Function.layouts (f, global, output))
+            ; if not (!Control.keepDot)
+                 then ()
+              else
+                 let
+                    open Control
+                 in
+                    saveToFile
+                    ({suffix = "call-graph.dot"},
+                     Dot, (), Layout (fn () =>
+                                      layoutCallGraph (p, !Control.inputFile)))
+                 end
+         end
 
       fun layoutStats (T {globals, functions, ...}) =
-	 let
-	    val numStatements = ref (Vector.length globals)
-	    val numBlocks = ref 0
-	    val _ =
-	       List.foreach
-	       (functions, fn f =>
-		let
-		   val {blocks, ...} = Function.dest f
-		in
-		   Vector.foreach
-		   (blocks, fn Block.T {statements, ...} =>
-		    (Int.inc numBlocks
-		     ; numStatements := !numStatements + Vector.length statements))
-		end)
-	    val numFunctions = List.length functions
-	    open Layout
-	 in
-	    align
-	    (List.map
-	     ([("num functions", Int.layout numFunctions),
-	       ("num blocks", Int.layout (!numBlocks)),
-	       ("num statements", Int.layout (!numStatements))],
-	      fn (name, value) => seq [str (name ^ " "), value]))
-	 end
+         let
+            val numStatements = ref (Vector.length globals)
+            val numBlocks = ref 0
+            val _ =
+               List.foreach
+               (functions, fn f =>
+                let
+                   val {blocks, ...} = Function.dest f
+                in
+                   Vector.foreach
+                   (blocks, fn Block.T {statements, ...} =>
+                    (Int.inc numBlocks
+                     ; numStatements := !numStatements + Vector.length statements))
+                end)
+            val numFunctions = List.length functions
+            open Layout
+         in
+            align
+            (List.map
+             ([("num functions", Int.layout numFunctions),
+               ("num blocks", Int.layout (!numBlocks)),
+               ("num statements", Int.layout (!numStatements))],
+              fn (name, value) => seq [str (name ^ " "), value]))
+         end
 
       (* clear all property lists reachable from program *)
       fun clear (T {datatypes, globals, functions, ...}) =
-	 ((* Can't do Type.clear because it clears out the info needed for
-	   * Type.dest.
-	   *)
-	  Vector.foreach (datatypes, Datatype.clear)
-	  ; Vector.foreach (globals, Statement.clear)
-	  ; List.foreach (functions, Function.clear))
+         ((* Can't do Type.clear because it clears out the info needed for
+           * Type.dest.
+           *)
+          Vector.foreach (datatypes, Datatype.clear)
+          ; Vector.foreach (globals, Statement.clear)
+          ; List.foreach (functions, Function.clear))
 
       fun clearGlobals (T {globals, ...}) =
-	 Vector.foreach (globals, Statement.clear)
+         Vector.foreach (globals, Statement.clear)
 
       fun clearTop (p as T {datatypes, functions, ...}) =
-	 (Vector.foreach (datatypes, Datatype.clear)
-	  ; List.foreach (functions, Func.clear o Function.name)
-	  ; clearGlobals p)
+         (Vector.foreach (datatypes, Datatype.clear)
+          ; List.foreach (functions, Func.clear o Function.name)
+          ; clearGlobals p)
 
       fun foreachVar (T {globals, functions, ...}, f) =
-	 (Vector.foreach (globals, fn s => Statement.foreachDef (s, f))
-	  ; List.foreach (functions, fn g => Function.foreachVar (g, f)))
+         (Vector.foreach (globals, fn s => Statement.foreachDef (s, f))
+          ; List.foreach (functions, fn g => Function.foreachVar (g, f)))
 
       fun foreachPrimApp (T {globals, functions, ...}, f) =
-	 let
-	    fun loopStatement (s: Statement.t) =
-	       case s of
-		  Bind {exp = PrimApp {args, prim}, ...} =>
-		     f {args = args, prim = prim}
-		 | _ => ()
-	     fun loopTransfer t =
-	        case t of
-		   Arith {args, prim, ...} => f {args = args, prim = prim}
-		 | Runtime {args, prim, ...} => f {args = args, prim = prim}
-		 | _ => ()
-	     val _ = Vector.foreach (globals, loopStatement)
-	     val _ =
-		List.foreach
-		(functions, fn f =>
-		 Vector.foreach
-		 (Function.blocks f, fn Block.T {statements, transfer, ...} =>
-		  (Vector.foreach (statements, loopStatement);
-		   loopTransfer transfer)))
-	 in
-	    ()
-	 end
+         let
+            fun loopStatement (s: Statement.t) =
+               case s of
+                  Bind {exp = PrimApp {args, prim}, ...} =>
+                     f {args = args, prim = prim}
+                 | _ => ()
+             fun loopTransfer t =
+                case t of
+                   Arith {args, prim, ...} => f {args = args, prim = prim}
+                 | Runtime {args, prim, ...} => f {args = args, prim = prim}
+                 | _ => ()
+             val _ = Vector.foreach (globals, loopStatement)
+             val _ =
+                List.foreach
+                (functions, fn f =>
+                 Vector.foreach
+                 (Function.blocks f, fn Block.T {statements, transfer, ...} =>
+                  (Vector.foreach (statements, loopStatement);
+                   loopTransfer transfer)))
+         in
+            ()
+         end
 
       fun hasPrim (p, f) =
-	 DynamicWind.withEscape
-	 (fn escape =>
-	  (foreachPrimApp (p, fn {prim, ...} =>
-			   if f prim then escape true else ())
-	   ; false))
+         Exn.withEscape
+         (fn escape =>
+          (foreachPrimApp (p, fn {prim, ...} =>
+                           if f prim then escape true else ())
+           ; false))
 
       fun profile (T {datatypes, functions, globals, main}) =
-	 let
-	    val functions =
-	       List.map
-	       (functions, fn f =>
-		let
-		   val {args, blocks, mayInline, name, raises, returns, start} =
-		      Function.dest f
-		   val blocks =
-		      Vector.map
-		      (blocks, fn Block.T {args, label, statements, transfer} =>
-		       let
-			  val si =
-			     SourceInfo.function
-			     {name = [Label.toString label],
-			      region = Region.bogus}
-			  fun prof f = Vector.new1 (Statement.profile (f si))
-			  val statements =
-			     Vector.concat
-			     [prof ProfileExp.Enter,
-			      statements,
-			      prof ProfileExp.Leave]
-		       in
-			  Block.T {args = args,
-				   label = label,
-				   statements = statements,
-				   transfer = transfer}
-		       end)
-		in
-		   Function.new {args = args,
-				 blocks = blocks,
-				 mayInline = mayInline,
-				 name = name,
-				 raises = raises,
-				 returns = returns,
-				 start = start}
-		end)
-	 in
-	    T {datatypes = datatypes,
-	       functions = functions,
-	       globals = globals,
-	       main = main}
-	 end
-	 
+         let
+            val functions =
+               List.map
+               (functions, fn f =>
+                let
+                   val {args, blocks, mayInline, name, raises, returns, start} =
+                      Function.dest f
+                   val blocks =
+                      Vector.map
+                      (blocks, fn Block.T {args, label, statements, transfer} =>
+                       let
+                          val si =
+                             SourceInfo.function
+                             {name = [Label.toString label],
+                              region = Region.bogus}
+                          fun prof f = Vector.new1 (Statement.profile (f si))
+                          val statements =
+                             Vector.concat
+                             [prof ProfileExp.Enter,
+                              statements,
+                              prof ProfileExp.Leave]
+                       in
+                          Block.T {args = args,
+                                   label = label,
+                                   statements = statements,
+                                   transfer = transfer}
+                       end)
+                in
+                   Function.new {args = args,
+                                 blocks = blocks,
+                                 mayInline = mayInline,
+                                 name = name,
+                                 raises = raises,
+                                 returns = returns,
+                                 start = start}
+                end)
+         in
+            T {datatypes = datatypes,
+               functions = functions,
+               globals = globals,
+               main = main}
+         end
+         
    end
 
 end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ssa/ssa-tree2.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ssa/ssa-tree2.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ssa/ssa-tree2.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 type int = Int.t
 
 signature SSA_TREE2_STRUCTS = 
@@ -17,145 +18,145 @@
       include SSA_TREE2_STRUCTS
      
       structure Prod:
-	 sig
-	    type 'a t
+         sig
+            type 'a t
 
-	    val dest: 'a t -> {elt: 'a, isMutable: bool} vector
-	    val elt: 'a t * int -> 'a
-	    val empty: unit -> 'a t
-	    val fold: 'a t * 'b * ('a * 'b -> 'b) -> 'b
-	    val foreach: 'a t * ('a -> unit) -> unit
-	    val isEmpty: 'a t -> bool
-	    val isMutable: 'a t -> bool
-	    val keepAllMap: 'a t * ('a -> 'b option) -> 'b t
-	    val layout: 'a t * ('a -> Layout.t) -> Layout.t
-	    val length: 'a t -> int
-	    val make: {elt: 'a, isMutable: bool} vector -> 'a t
-	    val map: 'a t * ('a -> 'b) -> 'b t
-	    val sub: 'a t * int -> {elt: 'a, isMutable: bool}
-	 end
+            val dest: 'a t -> {elt: 'a, isMutable: bool} vector
+            val elt: 'a t * int -> 'a
+            val empty: unit -> 'a t
+            val fold: 'a t * 'b * ('a * 'b -> 'b) -> 'b
+            val foreach: 'a t * ('a -> unit) -> unit
+            val isEmpty: 'a t -> bool
+            val isMutable: 'a t -> bool
+            val keepAllMap: 'a t * ('a -> 'b option) -> 'b t
+            val layout: 'a t * ('a -> Layout.t) -> Layout.t
+            val length: 'a t -> int
+            val make: {elt: 'a, isMutable: bool} vector -> 'a t
+            val map: 'a t * ('a -> 'b) -> 'b t
+            val sub: 'a t * int -> {elt: 'a, isMutable: bool}
+         end
 
       structure ObjectCon:
-	 sig
-	    datatype t =
-	       Con of Con.t
-	     | Tuple
-	     | Vector
+         sig
+            datatype t =
+               Con of Con.t
+             | Tuple
+             | Vector
 
-	    val isVector: t -> bool
-	    val layout: t -> Layout.t
-	 end
+            val isVector: t -> bool
+            val layout: t -> Layout.t
+         end
       
       structure Type:
-	 sig
-	    type t
-	       
-	    datatype dest =
-	       Datatype of Tycon.t
-	     | IntInf
-	     | Object of {args: t Prod.t,
-			  con: ObjectCon.t}
-	     | Real of RealSize.t
-	     | Thread
-	     | Weak of t
-	     | Word of WordSize.t
+         sig
+            type t
+               
+            datatype dest =
+               Datatype of Tycon.t
+             | IntInf
+             | Object of {args: t Prod.t,
+                          con: ObjectCon.t}
+             | Real of RealSize.t
+             | Thread
+             | Weak of t
+             | Word of WordSize.t
 
-	    val array: t -> t
-	    val bool: t
-	    val conApp: Con.t * t Prod.t -> t
-	    val checkPrimApp: {args: t vector,
-			       prim: t Prim.t,
-			       result: t} -> bool
-	    val datatypee: Tycon.t -> t
-	    val dest: t -> dest
-	    val equals: t * t -> bool
-	    val intInf: t
-	    val isUnit: t -> bool
-	    val layout: t -> Layout.t
-	    val object: {args: t Prod.t, con: ObjectCon.t} -> t
-	    val ofConst: Const.t -> t
-	    val plist: t -> PropertyList.t
-	    val real: RealSize.t -> t
-	    val reff: t -> t
-	    val thread: t
-	    val tuple: t Prod.t -> t
-	    val vector: t Prod.t -> t
-	    val vector1: t -> t
-	    val weak: t -> t
-	    val word: WordSize.t -> t
-	    val unit: t
-	 end
+            val array: t -> t
+            val bool: t
+            val conApp: Con.t * t Prod.t -> t
+            val checkPrimApp: {args: t vector,
+                               prim: t Prim.t,
+                               result: t} -> bool
+            val datatypee: Tycon.t -> t
+            val dest: t -> dest
+            val equals: t * t -> bool
+            val intInf: t
+            val isUnit: t -> bool
+            val layout: t -> Layout.t
+            val object: {args: t Prod.t, con: ObjectCon.t} -> t
+            val ofConst: Const.t -> t
+            val plist: t -> PropertyList.t
+            val real: RealSize.t -> t
+            val reff: t -> t
+            val thread: t
+            val tuple: t Prod.t -> t
+            val vector: t Prod.t -> t
+            val vector1: t -> t
+            val weak: t -> t
+            val word: WordSize.t -> t
+            val unit: t
+         end
 
       structure Base:
-	 sig
-	    datatype 'a t =
-	       Object of 'a
-	     | VectorSub of {index: 'a,
-			     vector: 'a}
+         sig
+            datatype 'a t =
+               Object of 'a
+             | VectorSub of {index: 'a,
+                             vector: 'a}
 
-	    val foreach: 'a t * ('a -> unit) -> unit
-	    val layout: 'a t * ('a -> Layout.t) -> Layout.t
-	    val map: 'a t * ('a -> 'b) -> 'b t
-	    val object: 'a t -> 'a
-	 end
+            val foreach: 'a t * ('a -> unit) -> unit
+            val layout: 'a t * ('a -> Layout.t) -> Layout.t
+            val map: 'a t * ('a -> 'b) -> 'b t
+            val object: 'a t -> 'a
+         end
 
       structure Exp:
-	 sig
-	    datatype t =
-	       Const of Const.t
-	     | Inject of {sum: Tycon.t,
-			  variant: Var.t}
-	     | Object of {args: Var.t vector,
-			  con: Con.t option}
-	     | PrimApp of {args: Var.t vector,
-			   prim: Type.t Prim.t}
-	     | Select of {base: Var.t Base.t,
-			  offset: int}
-	     | Var of Var.t
+         sig
+            datatype t =
+               Const of Const.t
+             | Inject of {sum: Tycon.t,
+                          variant: Var.t}
+             | Object of {args: Var.t vector,
+                          con: Con.t option}
+             | PrimApp of {args: Var.t vector,
+                           prim: Type.t Prim.t}
+             | Select of {base: Var.t Base.t,
+                          offset: int}
+             | Var of Var.t
 
-	    val equals: t * t -> bool
-	    val foreachVar: t * (Var.t -> unit) -> unit
-	    val hash: t -> Word.t
-	    val layout: t -> Layout.t
-	    val maySideEffect: t -> bool
-	    val replaceVar: t * (Var.t -> Var.t) -> t
-	    val toString: t -> string
-	    val unit: t
-	 end
+            val equals: t * t -> bool
+            val foreachVar: t * (Var.t -> unit) -> unit
+            val hash: t -> Word.t
+            val layout: t -> Layout.t
+            val maySideEffect: t -> bool
+            val replaceVar: t * (Var.t -> Var.t) -> t
+            val toString: t -> string
+            val unit: t
+         end
 
       structure Statement:
-	 sig
-	    datatype t =
-	       Bind of {exp: Exp.t,
-			ty: Type.t,
-			var: Var.t option}
-	     | Profile of ProfileExp.t
-	     | Update of {base: Var.t Base.t,
-			  offset: int,
-			  value: Var.t}
+         sig
+            datatype t =
+               Bind of {exp: Exp.t,
+                        ty: Type.t,
+                        var: Var.t option}
+             | Profile of ProfileExp.t
+             | Update of {base: Var.t Base.t,
+                          offset: int,
+                          value: Var.t}
 
-	    val clear: t -> unit (* clear the var *)
-	    val foreachDef: t * (Var.t * Type.t -> unit) -> unit
-	    val foreachUse: t * (Var.t -> unit) -> unit
-	    val layout: t -> Layout.t
-	    val prettifyGlobals: t vector -> (Var.t -> string option)
-	    val profile: ProfileExp.t -> t
-	    val replaceUses: t * (Var.t -> Var.t) -> t
-	 end
+            val clear: t -> unit (* clear the var *)
+            val foreachDef: t * (Var.t * Type.t -> unit) -> unit
+            val foreachUse: t * (Var.t -> unit) -> unit
+            val layout: t -> Layout.t
+            val prettifyGlobals: t vector -> (Var.t -> string option)
+            val profile: ProfileExp.t -> t
+            val replaceUses: t * (Var.t -> Var.t) -> t
+         end
       
       structure Cases:
-	 sig
-	    datatype t =
-	       Con of (Con.t * Label.t) vector
-	     | Word of WordSize.t * (WordX.t * Label.t) vector
+         sig
+            datatype t =
+               Con of (Con.t * Label.t) vector
+             | Word of WordSize.t * (WordX.t * Label.t) vector
 
-	    val forall: t * (Label.t -> bool) -> bool
-	    val foreach: t * (Label.t -> unit) -> unit
-	    val hd: t -> Label.t
-	    val isEmpty: t -> bool
-	    val length: t -> int
-	    val map: t * (Label.t -> Label.t) -> t
-	 end
+            val forall: t * (Label.t -> bool) -> bool
+            val foreach: t * (Label.t -> unit) -> unit
+            val hd: t -> Label.t
+            val isEmpty: t -> bool
+            val length: t -> int
+            val map: t * (Label.t -> Label.t) -> t
+         end
 
       structure Handler: HANDLER
       sharing Handler.Label = Label
@@ -164,130 +165,130 @@
       sharing Return.Handler = Handler
 
       structure Transfer:
-	 sig
-	    datatype t =
-	       Arith of {args: Var.t vector,
-			 overflow: Label.t, (* Must be nullary. *)
-			 prim: Type.t Prim.t,
-			 success: Label.t, (* Must be unary. *)
-			 ty: Type.t} (* int or word *)
-	     | Bug  (* MLton thought control couldn't reach here. *)
-	     | Call of {args: Var.t vector,
-			func: Func.t,
-			return: Return.t}
-	     | Case of {cases: Cases.t,
-			default: Label.t option, (* Must be nullary. *)
-			test: Var.t}
-	     | Goto of {args: Var.t vector,
-			dst: Label.t}
-	     (* Raise implicitly raises to the caller.  
-	      * I.E. the local handler stack must be empty.
-	      *)
-	     | Raise of Var.t vector
-	     | Return of Var.t vector
-	     | Runtime of {args: Var.t vector,
-			   prim: Type.t Prim.t,
-			   return: Label.t} (* Must be nullary. *)
+         sig
+            datatype t =
+               Arith of {args: Var.t vector,
+                         overflow: Label.t, (* Must be nullary. *)
+                         prim: Type.t Prim.t,
+                         success: Label.t, (* Must be unary. *)
+                         ty: Type.t} (* int or word *)
+             | Bug  (* MLton thought control couldn't reach here. *)
+             | Call of {args: Var.t vector,
+                        func: Func.t,
+                        return: Return.t}
+             | Case of {cases: Cases.t,
+                        default: Label.t option, (* Must be nullary. *)
+                        test: Var.t}
+             | Goto of {args: Var.t vector,
+                        dst: Label.t}
+             (* Raise implicitly raises to the caller.  
+              * I.E. the local handler stack must be empty.
+              *)
+             | Raise of Var.t vector
+             | Return of Var.t vector
+             | Runtime of {args: Var.t vector,
+                           prim: Type.t Prim.t,
+                           return: Label.t} (* Must be nullary. *)
 
-	    val equals: t * t -> bool
-	    val foreachFunc : t * (Func.t -> unit) -> unit
-	    val foreachLabel: t * (Label.t -> unit) -> unit
-	    val foreachLabelVar: t * (Label.t -> unit) * (Var.t -> unit) -> unit
-	    val foreachVar: t * (Var.t -> unit) -> unit
-	    val hash: t -> Word.t 
-	    val iff: Var.t * {falsee: Label.t, truee: Label.t} -> t
-	    val layout: t -> Layout.t
-	    val replaceLabelVar: t * (Label.t -> Label.t) * (Var.t -> Var.t) -> t
-	    val replaceLabel: t * (Label.t -> Label.t) -> t
-	    val replaceVar: t * (Var.t -> Var.t) -> t
-	 end
+            val equals: t * t -> bool
+            val foreachFunc : t * (Func.t -> unit) -> unit
+            val foreachLabel: t * (Label.t -> unit) -> unit
+            val foreachLabelVar: t * (Label.t -> unit) * (Var.t -> unit) -> unit
+            val foreachVar: t * (Var.t -> unit) -> unit
+            val hash: t -> Word.t 
+            val iff: Var.t * {falsee: Label.t, truee: Label.t} -> t
+            val layout: t -> Layout.t
+            val replaceLabelVar: t * (Label.t -> Label.t) * (Var.t -> Var.t) -> t
+            val replaceLabel: t * (Label.t -> Label.t) -> t
+            val replaceVar: t * (Var.t -> Var.t) -> t
+         end
 
       structure Block:
-	 sig
-	    datatype t =
-	       T of {args: (Var.t * Type.t) vector,
-		     label: Label.t,
-		     statements: Statement.t vector,
-		     transfer: Transfer.t}
+         sig
+            datatype t =
+               T of {args: (Var.t * Type.t) vector,
+                     label: Label.t,
+                     statements: Statement.t vector,
+                     transfer: Transfer.t}
 
-	    val args: t -> (Var.t * Type.t) vector
-	    val clear: t -> unit
-	    val label: t -> Label.t
-	    val layout: t -> Layout.t
-	    val statements: t -> Statement.t vector
-	    val transfer: t -> Transfer.t
-	 end
+            val args: t -> (Var.t * Type.t) vector
+            val clear: t -> unit
+            val label: t -> Label.t
+            val layout: t -> Layout.t
+            val statements: t -> Statement.t vector
+            val transfer: t -> Transfer.t
+         end
 
       structure Datatype:
-	 sig
-	    datatype t =
-	       T of {cons: {args: Type.t Prod.t,
-			    con: Con.t} vector,
-		     tycon: Tycon.t}
+         sig
+            datatype t =
+               T of {cons: {args: Type.t Prod.t,
+                            con: Con.t} vector,
+                     tycon: Tycon.t}
 
-	    val layout: t -> Layout.t
-	 end
+            val layout: t -> Layout.t
+         end
 
       structure Function:
-	 sig
-	    type t
+         sig
+            type t
 
-	    val alphaRename: t -> t
-	    val blocks: t -> Block.t vector
-	    (* clear the plists for all bound variables and labels that appear
-	     * in the function, but not the function name's plist.
-	     *)
-	    val clear: t -> unit
-	    val controlFlow:
-	       t -> {graph: unit DirectedGraph.t,
-		     labelNode: Label.t -> unit DirectedGraph.Node.t,
-		     nodeBlock: unit DirectedGraph.Node.t -> Block.t}
-	    val dest: t -> {args: (Var.t * Type.t) vector,
-			    blocks: Block.t vector,
-			    mayInline: bool,
-			    name: Func.t,
-			    raises: Type.t vector option,
-			    returns: Type.t vector option,
-			    start: Label.t}
-	    (* dfs (f, v) visits the blocks in depth-first order, applying v b
-	     * for block b to yield v', then visiting b's descendents,
-	     * then applying v' ().
-	     *)
-	    val dfs: t * (Block.t -> unit -> unit) -> unit
-	    val dominatorTree: t -> Block.t Tree.t
-	    val foreachVar: t * (Var.t * Type.t -> unit) -> unit
-	    val layout: t -> Layout.t
-	    val layoutDot:
-	       t * (Var.t -> string option) -> {graph: Layout.t,
-						tree: unit -> Layout.t}
-	    val name: t -> Func.t
-	    val new: {args: (Var.t * Type.t) vector,
-		      blocks: Block.t vector,
-		      mayInline: bool,
-		      name: Func.t,
-		      raises: Type.t vector option,
-		      returns: Type.t vector option,
-		      start: Label.t} -> t
-	    val profile: t * SourceInfo.t -> t
-	    val start: t -> Label.t
-	 end
+            val alphaRename: t -> t
+            val blocks: t -> Block.t vector
+            (* clear the plists for all bound variables and labels that appear
+             * in the function, but not the function name's plist.
+             *)
+            val clear: t -> unit
+            val controlFlow:
+               t -> {graph: unit DirectedGraph.t,
+                     labelNode: Label.t -> unit DirectedGraph.Node.t,
+                     nodeBlock: unit DirectedGraph.Node.t -> Block.t}
+            val dest: t -> {args: (Var.t * Type.t) vector,
+                            blocks: Block.t vector,
+                            mayInline: bool,
+                            name: Func.t,
+                            raises: Type.t vector option,
+                            returns: Type.t vector option,
+                            start: Label.t}
+            (* dfs (f, v) visits the blocks in depth-first order, applying v b
+             * for block b to yield v', then visiting b's descendents,
+             * then applying v' ().
+             *)
+            val dfs: t * (Block.t -> unit -> unit) -> unit
+            val dominatorTree: t -> Block.t Tree.t
+            val foreachVar: t * (Var.t * Type.t -> unit) -> unit
+            val layout: t -> Layout.t
+            val layoutDot:
+               t * (Var.t -> string option) -> {graph: Layout.t,
+                                                tree: unit -> Layout.t}
+            val name: t -> Func.t
+            val new: {args: (Var.t * Type.t) vector,
+                      blocks: Block.t vector,
+                      mayInline: bool,
+                      name: Func.t,
+                      raises: Type.t vector option,
+                      returns: Type.t vector option,
+                      start: Label.t} -> t
+            val profile: t * SourceInfo.t -> t
+            val start: t -> Label.t
+         end
      
       structure Program:
-	 sig
-	    datatype t =
-	       T of {datatypes: Datatype.t vector,
-		     functions: Function.t list,
-		     globals: Statement.t vector,
-		     main: Func.t (* Must be nullary. *)}
+         sig
+            datatype t =
+               T of {datatypes: Datatype.t vector,
+                     functions: Function.t list,
+                     globals: Statement.t vector,
+                     main: Func.t (* Must be nullary. *)}
 
-	    val clear: t -> unit
-	    val clearTop: t -> unit
-	    val foreachPrimApp:
-	       t * ({args: Var.t vector, prim: Type.t Prim.t} -> unit) -> unit
-	    val foreachVar: t * (Var.t * Type.t -> unit) -> unit
-	    val hasPrim: t * (Type.t Prim.t -> bool) -> bool
-	    val layouts: t * (Layout.t -> unit) -> unit
-	    val layoutStats: t -> Layout.t
-	    val profile: t -> t
-	 end
+            val clear: t -> unit
+            val clearTop: t -> unit
+            val foreachPrimApp:
+               t * ({args: Var.t vector, prim: Type.t Prim.t} -> unit) -> unit
+            val foreachVar: t * (Var.t * Type.t -> unit) -> unit
+            val hasPrim: t * (Type.t Prim.t -> bool) -> bool
+            val layouts: t * (Layout.t -> unit) -> unit
+            val layoutStats: t -> Layout.t
+            val profile: t -> t
+         end
    end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ssa/ssa.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ssa/ssa.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ssa/ssa.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 functor Ssa (S: SSA_STRUCTS): SSA = 
    Simplify (Restore (Shrink (PrePasses (
    TypeCheck (Analyze (DirectExp (SsaTree (S))))))))

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ssa/ssa.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ssa/ssa.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ssa/ssa.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature SSA_STRUCTS = 
    sig
       include SSA_TREE_STRUCTS

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ssa/ssa2.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ssa/ssa2.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ssa/ssa2.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,9 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 functor Ssa2 (S: SSA2_STRUCTS): SSA2 = 

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ssa/ssa2.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ssa/ssa2.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ssa/ssa2.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,9 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 signature SSA2_STRUCTS = 

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ssa/three-point-lattice.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ssa/three-point-lattice.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ssa/three-point-lattice.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,9 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 functor ThreePointLattice(S: THREE_POINT_LATTICE_STRUCTS): THREE_POINT_LATTICE = 

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ssa/three-point-lattice.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ssa/three-point-lattice.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ssa/three-point-lattice.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature THREE_POINT_LATTICE_STRUCTS = 
    sig
       (* pretty print names *)

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ssa/two-point-lattice.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ssa/two-point-lattice.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ssa/two-point-lattice.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 functor TwoPointLattice (S: TWO_POINT_LATTICE_STRUCTS): TWO_POINT_LATTICE = 
 struct
 
@@ -58,7 +59,7 @@
       then ()
    else
       case (value from, value to) of
-	 (_, Top) => ()
+         (_, Top) => ()
        | (Top, _) => makeTop to
        | (Bottom hs, _) => hs := List.cons (fn () => makeTop to, !hs)
 
@@ -67,15 +68,15 @@
       then ()
    else
       let val e = Set.! s
-	 val e' = Set.! s'
-	 val _ = Set.union (s, s')
+         val e' = Set.! s'
+         val _ = Set.union (s, s')
       in
-	 case (e, e') of
-	    (Top, Top) => ()
-	  | (Bottom hs, Top) => (Set.:= (s, e'); runHandlers hs)
-	  | (Top, Bottom hs) => (Set.:= (s, e); runHandlers hs)
-	  | (Bottom hs, Bottom hs') =>
-	       Set.:= (s, Bottom (ref (List.append (!hs, !hs'))))
+         case (e, e') of
+            (Top, Top) => ()
+          | (Bottom hs, Top) => (Set.:= (s, e'); runHandlers hs)
+          | (Top, Bottom hs) => (Set.:= (s, e); runHandlers hs)
+          | (Bottom hs, Bottom hs') =>
+               Set.:= (s, Bottom (ref (List.append (!hs, !hs'))))
       end
 
 end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ssa/two-point-lattice.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ssa/two-point-lattice.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ssa/two-point-lattice.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature TWO_POINT_LATTICE_STRUCTS = 
    sig
       (* pretty print names *)

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ssa/type-check.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ssa/type-check.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ssa/type-check.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,9 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 functor TypeCheck (S: TYPE_CHECK_STRUCTS): TYPE_CHECK = 
@@ -18,37 +18,37 @@
 datatype z = datatype Transfer.t
 
 fun checkScopes (program as
-		 Program.T {datatypes, globals, functions, main}): unit =
+                 Program.T {datatypes, globals, functions, main}): unit =
    let
       datatype 'a status =
-	 Undefined
+         Undefined
        | InScope of 'a
        | Defined
 
       fun make' (layout, plist) =
-	 let
-	    val {get, set, ...} =
-	       Property.getSet (plist, Property.initConst Undefined)
-	    fun bind (x, v) =
-	       case get x of
-		  Undefined => set (x, InScope v)
-		| _ => Error.bug ("duplicate definition of "
-				  ^ (Layout.toString (layout x)))
-	    fun reference x =
-	       case get x of
-		  InScope v => v
-		| _ => Error.bug (concat
-				  ["reference to ",
-				   Layout.toString (layout x),
-				   " not in scope"])
+         let
+            val {get, set, ...} =
+               Property.getSet (plist, Property.initConst Undefined)
+            fun bind (x, v) =
+               case get x of
+                  Undefined => set (x, InScope v)
+                | _ => Error.bug ("Ssa.TypeCheck.checkScopes: duplicate definition of "
+                                  ^ (Layout.toString (layout x)))
+            fun reference x =
+               case get x of
+                  InScope v => v
+                | _ => Error.bug (concat
+                                  ["Ssa.TypeCheck.checkScopes: reference to ",
+                                   Layout.toString (layout x),
+                                   " not in scope"])
 
-	    fun unbind x = set (x, Defined)
-	 in (bind, ignore o reference, reference, unbind)
-	 end
+            fun unbind x = set (x, Defined)
+         in (bind, ignore o reference, reference, unbind)
+         end
       fun make (layout, plist) =
-	 let val (bind, reference, _, unbind) = make' (layout, plist)
-	 in (fn x => bind (x, ()), reference, unbind)
-	 end
+         let val (bind, reference, _, unbind) = make' (layout, plist)
+         in (fn x => bind (x, ()), reference, unbind)
+         end
 
       val (bindTycon, _, getTycon', _) = make' (Tycon.layout, Tycon.plist)
       val (bindCon, getCon, getCon', _) = make' (Con.layout, Con.plist)
@@ -57,122 +57,122 @@
       val (bindFunc, getFunc, _) = make (Func.layout, Func.plist)
       val (bindLabel, getLabel, unbindLabel) = make (Label.layout, Label.plist)
       fun loopStatement (Statement.T {var, ty, exp, ...}) =
-	 let
-	    val _ =
-	       case exp of
-		  ConApp {con, args, ...} => (getCon con
-					      ; Vector.foreach (args, getVar))
-		| Const _ => ()
-		| PrimApp {args, ...} => Vector.foreach (args, getVar)
-		| Profile _ => ()
-		| Select {tuple, ...} => getVar tuple
-		| Tuple xs => Vector.foreach (xs, getVar)
-		| Var x => getVar x
-	    val _ = Option.app (var, fn x => bindVar (x, ty))
-	 in
-	    ()
-	 end
+         let
+            val _ =
+               case exp of
+                  ConApp {con, args, ...} => (getCon con
+                                              ; Vector.foreach (args, getVar))
+                | Const _ => ()
+                | PrimApp {args, ...} => Vector.foreach (args, getVar)
+                | Profile _ => ()
+                | Select {tuple, ...} => getVar tuple
+                | Tuple xs => Vector.foreach (xs, getVar)
+                | Var x => getVar x
+            val _ = Option.app (var, fn x => bindVar (x, ty))
+         in
+            ()
+         end
       val loopTransfer =
-	 fn Arith {args, ...} => getVars args
-	  | Bug => ()
-	  | Call {func, args, ...} => (getFunc func; getVars args)
-	  | Case {test, cases, default, ...} =>
-	       let
-		  fun doit (cases: ('a * 'b) vector,
-			    equals: 'a * 'a -> bool,
-			    toWord: 'a -> word): unit =
-		     let
-		        val table = HashSet.new {hash = toWord}
-			val _ =
-			   Vector.foreach
-			   (cases, fn (x, _) =>
-			    let
-			       val _ = 
-				  HashSet.insertIfNew
-				  (table, toWord x, fn y => equals (x, y),
-				   fn () => x, 
-				   fn _ => Error.bug "redundant branch in case")
-			    in
-			       ()
-			    end)
-		     in
-			if isSome default
-			   then ()
-			else Error.bug "case has no default"
-		     end
-		  fun doitCon cases =
-		     let
-		        val numCons = 
-			   case Type.dest (getVar' test) of
-			      Type.Datatype t => getTycon' t
-			    | _ => Error.bug "case test is not a datatype"
-			val cons = Array.array (numCons, false)
-			val _ =
-			   Vector.foreach
-			   (cases, fn (con, _) =>
-			    let
-			       val i = getCon' con
-			    in
-			       if Array.sub (cons, i)
-				  then Error.bug "redundant branch in case"
-			       else Array.update (cons, i, true)
-			    end)
-		     in
-			case (Array.forall (cons, fn b => b), isSome default) of
-			   (true, true) =>
-			      Error.bug "exhaustive case has default"
-			 | (false, false) =>
-			      Error.bug "non-exhaustive case has no default"
-			 | _ => ()
-		     end
-		  val _ = getVar test
-	       in
-		  case cases of
-		     Cases.Con cs => doitCon cs 
-		   | Cases.Word (_, cs) =>
-			doit (cs, WordX.equals, Word.fromIntInf o WordX.toIntInf)
-	       end
-	  | Goto {args, ...} => getVars args
-	  | Raise xs => getVars xs
-	  | Return xs => getVars xs
-	  | Runtime {args, ...} => getVars args
+         fn Arith {args, ...} => getVars args
+          | Bug => ()
+          | Call {func, args, ...} => (getFunc func; getVars args)
+          | Case {test, cases, default, ...} =>
+               let
+                  fun doit (cases: ('a * 'b) vector,
+                            equals: 'a * 'a -> bool,
+                            toWord: 'a -> word): unit =
+                     let
+                        val table = HashSet.new {hash = toWord}
+                        val _ =
+                           Vector.foreach
+                           (cases, fn (x, _) =>
+                            let
+                               val _ = 
+                                  HashSet.insertIfNew
+                                  (table, toWord x, fn y => equals (x, y),
+                                   fn () => x, 
+                                   fn _ => Error.bug "Ssa.TypeCheck.loopTransfer: redundant branch in case")
+                            in
+                               ()
+                            end)
+                     in
+                        if isSome default
+                           then ()
+                        else Error.bug "Ssa.TypeCheck.loopTransfer: case has no default"
+                     end
+                  fun doitCon cases =
+                     let
+                        val numCons = 
+                           case Type.dest (getVar' test) of
+                              Type.Datatype t => getTycon' t
+                            | _ => Error.bug "Ssa.TypeCheck.loopTransfer: case test is not a datatype"
+                        val cons = Array.array (numCons, false)
+                        val _ =
+                           Vector.foreach
+                           (cases, fn (con, _) =>
+                            let
+                               val i = getCon' con
+                            in
+                               if Array.sub (cons, i)
+                                  then Error.bug "Ssa.TypeCheck.loopTransfer: redundant branch in case"
+                               else Array.update (cons, i, true)
+                            end)
+                     in
+                        case (Array.forall (cons, fn b => b), isSome default) of
+                           (true, true) =>
+                              Error.bug "Ssa.TypeCheck.loopTransfer: exhaustive case has default"
+                         | (false, false) =>
+                              Error.bug "Ssa.TypeCheck.loopTransfer: non-exhaustive case has no default"
+                         | _ => ()
+                     end
+                  val _ = getVar test
+               in
+                  case cases of
+                     Cases.Con cs => doitCon cs 
+                   | Cases.Word (_, cs) =>
+                        doit (cs, WordX.equals, Word.fromIntInf o WordX.toIntInf)
+               end
+          | Goto {args, ...} => getVars args
+          | Raise xs => getVars xs
+          | Return xs => getVars xs
+          | Runtime {args, ...} => getVars args
       fun loopFunc (f: Function.t) =
-	 let
-	    val {args, blocks, ...} = Function.dest f
-	    (* Descend the dominator tree, verifying that variable definitions
-	     * dominate variable uses.
-	     *)
-	    fun loop (Tree.T (block, children)): unit =
-	       let
-		  val Block.T {args, statements, transfer, ...} = block
-		  val _ = Vector.foreach (args, bindVar)
-		  val _ = Vector.foreach (statements, loopStatement)
-		  val _ = loopTransfer transfer
-		  val _ = Vector.foreach (children, loop)
-		  val _ =
-		     Vector.foreach (statements, fn s =>
-				     Option.app (Statement.var s, unbindVar))
-		  val _ = Vector.foreach (args, unbindVar o #1)
-	       in
-		  ()
-	       end
-	    val _ = Vector.foreach (args, bindVar)
-	    val _ = Vector.foreach (blocks, bindLabel o Block.label)
-	    val _ =
-	       Vector.foreach
-	       (blocks, fn Block.T {transfer, ...} =>
-		Transfer.foreachLabel (transfer, getLabel))
-	    val _ = loop (Function.dominatorTree f)
-	    val _ = Vector.foreach (blocks, unbindLabel o Block.label)
-	    val _ = Vector.foreach (args, unbindVar o #1)
-	    val _ = Function.clear f
-	 in
-	     ()
-	 end
+         let
+            val {args, blocks, ...} = Function.dest f
+            (* Descend the dominator tree, verifying that variable definitions
+             * dominate variable uses.
+             *)
+            fun loop (Tree.T (block, children)): unit =
+               let
+                  val Block.T {args, statements, transfer, ...} = block
+                  val _ = Vector.foreach (args, bindVar)
+                  val _ = Vector.foreach (statements, loopStatement)
+                  val _ = loopTransfer transfer
+                  val _ = Vector.foreach (children, loop)
+                  val _ =
+                     Vector.foreach (statements, fn s =>
+                                     Option.app (Statement.var s, unbindVar))
+                  val _ = Vector.foreach (args, unbindVar o #1)
+               in
+                  ()
+               end
+            val _ = Vector.foreach (args, bindVar)
+            val _ = Vector.foreach (blocks, bindLabel o Block.label)
+            val _ =
+               Vector.foreach
+               (blocks, fn Block.T {transfer, ...} =>
+                Transfer.foreachLabel (transfer, getLabel))
+            val _ = loop (Function.dominatorTree f)
+            val _ = Vector.foreach (blocks, unbindLabel o Block.label)
+            val _ = Vector.foreach (args, unbindVar o #1)
+            val _ = Function.clear f
+         in
+             ()
+         end
       val _ = Vector.foreach
-	      (datatypes, fn Datatype.T {tycon, cons} =>
-	       (bindTycon (tycon, Vector.length cons) ;
-		Vector.foreachi (cons, fn (i, {con, ...}) => bindCon (con, i))))
+              (datatypes, fn Datatype.T {tycon, cons} =>
+               (bindTycon (tycon, Vector.length cons) ;
+                Vector.foreachi (cons, fn (i, {con, ...}) => bindCon (con, i))))
       val _ = Vector.foreach (globals, loopStatement)
       val _ = List.foreach (functions, bindFunc o Function.name)
       val _ = List.foreach (functions, loopFunc)
@@ -187,124 +187,124 @@
 structure Function =
    struct
       open Function
-	 
+         
       fun checkProf (f: t): unit =
-	 let
-	    val debug = false
-	    val {blocks, start, ...} = dest f
-	    val {get = labelInfo, rem, set = setLabelInfo, ...} =
-	       Property.getSetOnce
-	       (Label.plist,
-		Property.initRaise ("info", Label.layout))
-	    val _ = Vector.foreach (blocks, fn b as Block.T {label, ...} =>
-				    setLabelInfo (label,
-						  {block = b,
-						   sources = ref NONE}))
-	    fun goto (l: Label.t, sources: SourceInfo.t list) =
-	       let
-		  fun bug (msg: string): 'a =
-		     let
-			val _ = 
-			   Vector.foreach
-			   (blocks, fn Block.T {label, ...} =>
-			    let
-			       val {sources, ...} = labelInfo label
-			       open Layout
-			    in
-			       outputl
-			       (seq [Label.layout label,
-				     str " ",
-				     Option.layout
-				     (List.layout SourceInfo.layout)
-				     (!sources)],
-				Out.error)
-			    end)
-		     in
-			Error.bug
-			(concat ["checkProf bug found in ", Label.toString l,
-				 ": ", msg])
-		     end
-		  val _ =
-		     if not debug
-			then ()
-		     else
-		     let
-			open Layout
-		     in
-			outputl (seq [str "goto (",
-				      Label.layout l,
-				      str ", ",
-				      List.layout SourceInfo.layout sources,
-				      str ")"],
-				 Out.error)
-		     end
-		  val {block, sources = r} = labelInfo l
-	       in
-		  case !r of
-		     NONE =>
-			let
-			   val _ = r := SOME sources
-			   val Block.T {statements, transfer, ...} = block
-			   datatype z = datatype Statement.t
-			   datatype z = datatype ProfileExp.t
-			   val sources =
-			      Vector.fold
-			      (statements, sources,
-			       fn (Statement.T {exp, ...}, sources) =>
-			       case exp of
-				  Profile pe =>
-				     (case pe of
-					 Enter s => s :: sources
-				       | Leave s =>
-					    (case sources of
-						[] => bug "unmatched Leave"
-					      | s' :: sources =>
-						   if SourceInfo.equals (s, s')
-						      then sources
-						   else bug "mismatched Leave"))
-				| _ => sources)
-			   val _ =
-			      if not debug
-				 then ()
-			      else
-			      let
-				 open Layout
-			      in
-				 outputl (List.layout SourceInfo.layout sources,
-					  Out.error)
-			      end
-			   val _ = 
-			      if (case transfer of
-				     Call {return, ...} =>
-					let
-					   datatype z = datatype Return.t
-					in
-					   case return of
-					      Dead => false
-					    | NonTail _ => false
-					    | Tail => true
-					end
-				   | Raise _ => true
-				   | Return _ => true
-				   | _ => false)
-				 then (case sources of
-					  [] => ()
-					| _ => bug "nonempty sources when leaving function")
-			      else ()
-			in
-			   Transfer.foreachLabel
-			   (transfer, fn l => goto (l, sources))
-			end
-		   | SOME sources' =>
-			if List.equals (sources, sources', SourceInfo.equals)
-			   then ()
-			else bug "mismatched block"
-	       end
-	    val _ = goto (start, [])
-	    val _ = Vector.foreach (blocks, fn Block.T {label, ...} => rem label)
-	 in
-	    ()
-	 end
+         let
+            val debug = false
+            val {blocks, start, ...} = dest f
+            val {get = labelInfo, rem, set = setLabelInfo, ...} =
+               Property.getSetOnce
+               (Label.plist,
+                Property.initRaise ("info", Label.layout))
+            val _ = Vector.foreach (blocks, fn b as Block.T {label, ...} =>
+                                    setLabelInfo (label,
+                                                  {block = b,
+                                                   sources = ref NONE}))
+            fun goto (l: Label.t, sources: SourceInfo.t list) =
+               let
+                  fun bug (msg: string): 'a =
+                     let
+                        val _ = 
+                           Vector.foreach
+                           (blocks, fn Block.T {label, ...} =>
+                            let
+                               val {sources, ...} = labelInfo label
+                               open Layout
+                            in
+                               outputl
+                               (seq [Label.layout label,
+                                     str " ",
+                                     Option.layout
+                                     (List.layout SourceInfo.layout)
+                                     (!sources)],
+                                Out.error)
+                            end)
+                     in
+                        Error.bug
+                        (concat ["Ssa.TypeCheck.checkProf: bug found in ", Label.toString l,
+                                 ": ", msg])
+                     end
+                  val _ =
+                     if not debug
+                        then ()
+                     else
+                     let
+                        open Layout
+                     in
+                        outputl (seq [str "goto (",
+                                      Label.layout l,
+                                      str ", ",
+                                      List.layout SourceInfo.layout sources,
+                                      str ")"],
+                                 Out.error)
+                     end
+                  val {block, sources = r} = labelInfo l
+               in
+                  case !r of
+                     NONE =>
+                        let
+                           val _ = r := SOME sources
+                           val Block.T {statements, transfer, ...} = block
+                           datatype z = datatype Statement.t
+                           datatype z = datatype ProfileExp.t
+                           val sources =
+                              Vector.fold
+                              (statements, sources,
+                               fn (Statement.T {exp, ...}, sources) =>
+                               case exp of
+                                  Profile pe =>
+                                     (case pe of
+                                         Enter s => s :: sources
+                                       | Leave s =>
+                                            (case sources of
+                                                [] => bug "unmatched Leave"
+                                              | s' :: sources =>
+                                                   if SourceInfo.equals (s, s')
+                                                      then sources
+                                                   else bug "mismatched Leave"))
+                                | _ => sources)
+                           val _ =
+                              if not debug
+                                 then ()
+                              else
+                              let
+                                 open Layout
+                              in
+                                 outputl (List.layout SourceInfo.layout sources,
+                                          Out.error)
+                              end
+                           val _ = 
+                              if (case transfer of
+                                     Call {return, ...} =>
+                                        let
+                                           datatype z = datatype Return.t
+                                        in
+                                           case return of
+                                              Dead => false
+                                            | NonTail _ => false
+                                            | Tail => true
+                                        end
+                                   | Raise _ => true
+                                   | Return _ => true
+                                   | _ => false)
+                                 then (case sources of
+                                          [] => ()
+                                        | _ => bug "nonempty sources when leaving function")
+                              else ()
+                        in
+                           Transfer.foreachLabel
+                           (transfer, fn l => goto (l, sources))
+                        end
+                   | SOME sources' =>
+                        if List.equals (sources, sources', SourceInfo.equals)
+                           then ()
+                        else bug "mismatched block"
+               end
+            val _ = goto (start, [])
+            val _ = Vector.foreach (blocks, fn Block.T {label, ...} => rem label)
+         in
+            ()
+         end
    end
 
 fun checkProf (Program.T {functions, ...}): unit =
@@ -316,103 +316,103 @@
    let
       val _ = checkScopes program
       val _ =
-	 if !Control.profile <> Control.ProfileNone
-	    then checkProf program
-	 else ()
+         if !Control.profile <> Control.ProfileNone
+            then checkProf program
+         else ()
       val out = Out.error
       val print = Out.outputc out
       exception TypeError
       fun error (msg, lay) =
-	 (print (concat ["Type error: ", msg, "\n"])
-	  ; Layout.output (lay, out)
-	  ; print "\n"
-	  ; raise TypeError)
+         (print (concat ["Type error: ", msg, "\n"])
+          ; Layout.output (lay, out)
+          ; print "\n"
+          ; raise TypeError)
       fun coerce {from: Type.t, to: Type.t}: unit =
-	 if Type.equals (from, to)
-	    then ()
-	 else error ("Type.equals",
-		     Layout.record [("from", Type.layout from),
-				    ("to", Type.layout to)])
+         if Type.equals (from, to)
+            then ()
+         else error ("Ssa.TypeCheck.coerce",
+                     Layout.record [("from", Type.layout from),
+                                    ("to", Type.layout to)])
       fun coerces (from, to) =
-	 Vector.foreach2 (from, to, fn (from, to) =>
-			 coerce {from = from, to = to})
+         Vector.foreach2 (from, to, fn (from, to) =>
+                         coerce {from = from, to = to})
       val coerce =
-	 Trace.trace ("TypeCheck.coerce",
-		      fn {from, to} => let open Layout
-				       in record [("from", Type.layout from),
-						  ("to", Type.layout to)]
-				       end,
-				    Unit.layout) coerce
+         Trace.trace ("Ssa.TypeCheck.coerce",
+                      fn {from, to} => let open Layout
+                                       in record [("from", Type.layout from),
+                                                  ("to", Type.layout to)]
+                                       end,
+                                    Unit.layout) coerce
       fun select {tuple: Type.t, offset: int, resultType = _}: Type.t =
-	 case Type.deTupleOpt tuple of
-	    NONE => error ("select of non tuple", Layout.empty)
-	  | SOME ts => Vector.sub (ts, offset)
+         case Type.deTupleOpt tuple of
+            NONE => error ("select of non tuple", Layout.empty)
+          | SOME ts => Vector.sub (ts, offset)
       val {get = conInfo: Con.t -> {args: Type.t vector,
-				    result: Type.t},
-	   set = setConInfo, ...} =
-	 Property.getSetOnce
-	 (Con.plist, Property.initRaise ("TypeCheck.info", Con.layout))
+                                    result: Type.t},
+           set = setConInfo, ...} =
+         Property.getSetOnce
+         (Con.plist, Property.initRaise ("TypeCheck.info", Con.layout))
       val _ =
-	 Vector.foreach
-	 (datatypes, fn Datatype.T {tycon, cons} =>
-	  let val result = Type.con (tycon, Vector.new0 ())
-	  in Vector.foreach
-	     (cons, fn {con, args} =>
-	      setConInfo (con, {args = args,
-				result = result}))
-	  end)
+         Vector.foreach
+         (datatypes, fn Datatype.T {tycon, cons} =>
+          let val result = Type.con (tycon, Vector.new0 ())
+          in Vector.foreach
+             (cons, fn {con, args} =>
+              setConInfo (con, {args = args,
+                                result = result}))
+          end)
       fun conApp {con, args} =
-	 let
-	    val {args = args', result, ...} = conInfo con
-	    val _ = coerces (args', args)
-	 in
-	    result
-	 end
+         let
+            val {args = args', result, ...} = conInfo con
+            val _ = coerces (args', args)
+         in
+            result
+         end
       fun filter (test, con, args) =
-	 let
-	    val {result, args = args'} = conInfo con
-	    val _ = coerce {from = test, to = result}
-	    val _ = coerces (args', args)
-	 in ()
-	 end
+         let
+            val {result, args = args'} = conInfo con
+            val _ = coerce {from = test, to = result}
+            val _ = coerces (args', args)
+         in ()
+         end
       fun primApp {args, prim, resultType, resultVar = _, targs} =
-	 let
-	    datatype z = datatype Prim.Name.t
-	    val () =
-	       if Type.checkPrimApp {args = args,
-				     prim = prim,
-				     result = resultType,
-				     targs = targs}
-		  then ()
-	       else error ("bad primapp",
-			   let
-			      open Layout
-			   in
-			      seq [Prim.layout prim,
-				   tuple (Vector.toListMap (args, Type.layout))]
-			   end)
-	 in
-	    resultType
-	 end
+         let
+            datatype z = datatype Prim.Name.t
+            val () =
+               if Type.checkPrimApp {args = args,
+                                     prim = prim,
+                                     result = resultType,
+                                     targs = targs}
+                  then ()
+               else error ("bad primapp",
+                           let
+                              open Layout
+                           in
+                              seq [Prim.layout prim,
+                                   tuple (Vector.toListMap (args, Type.layout))]
+                           end)
+         in
+            resultType
+         end
       val _ =
-	 analyze {
-		  coerce = coerce,
-		  conApp = conApp,
-		  const = Type.ofConst,
-		  filter = filter,
-		  filterWord = fn (from, s) => coerce {from = from,
-						       to = Type.word s},
-		  fromType = fn x => x,
-		  layout = Type.layout,
-		  primApp = primApp,
-		  program = program,
-		  select = select,
-		  tuple = Type.tuple,
-		  useFromTypeOnBinds = true
-		  }
-	 handle e => error (concat ["analyze raised exception ",
-				    Layout.toString (Exn.layout e)],
-			    Layout.empty)
+         analyze {
+                  coerce = coerce,
+                  conApp = conApp,
+                  const = Type.ofConst,
+                  filter = filter,
+                  filterWord = fn (from, s) => coerce {from = from,
+                                                       to = Type.word s},
+                  fromType = fn x => x,
+                  layout = Type.layout,
+                  primApp = primApp,
+                  program = program,
+                  select = select,
+                  tuple = Type.tuple,
+                  useFromTypeOnBinds = true
+                  }
+         handle e => error (concat ["analyze raised exception ",
+                                    Layout.toString (Exn.layout e)],
+                            Layout.empty)
       val _ = Program.clear program
    in
       ()

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ssa/type-check.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ssa/type-check.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ssa/type-check.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature TYPE_CHECK_STRUCTS = 
    sig
       include ANALYZE

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ssa/type-check2.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ssa/type-check2.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ssa/type-check2.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,9 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 functor TypeCheck2 (S: TYPE_CHECK2_STRUCTS): TYPE_CHECK2 = 
@@ -19,36 +19,36 @@
 datatype z = datatype Transfer.t
 
 fun checkScopes (program as
-		 Program.T {datatypes, globals, functions, main}): unit =
+                 Program.T {datatypes, globals, functions, main}): unit =
    let
       datatype 'a status =
-	 Undefined
+         Undefined
        | InScope of 'a
        | Defined
 
       fun make' (layout, plist) =
-	 let
-	    val {get, set, ...} =
-	       Property.getSet (plist, Property.initConst Undefined)
-	    fun bind (x, v) =
-	       case get x of
-		  Undefined => set (x, InScope v)
-		| _ => Error.bug (concat ["duplicate definition of ",
-					  Layout.toString (layout x)])
-	    fun reference x =
-	       case get x of
-		  InScope v => v
-		| _ => Error.bug (concat ["reference to ",
-					  Layout.toString (layout x),
-					  " not in scope"])
+         let
+            val {get, set, ...} =
+               Property.getSet (plist, Property.initConst Undefined)
+            fun bind (x, v) =
+               case get x of
+                  Undefined => set (x, InScope v)
+                | _ => Error.bug (concat ["Ssa2.TypeCheck2.checkScopes: duplicate definition of ",
+                                          Layout.toString (layout x)])
+            fun reference x =
+               case get x of
+                  InScope v => v
+                | _ => Error.bug (concat ["Ssa2.TypeCheck2.checkScopes: reference to ",
+                                          Layout.toString (layout x),
+                                          " not in scope"])
 
-	    fun unbind x = set (x, Defined)
-	 in (bind, ignore o reference, reference, unbind)
-	 end
+            fun unbind x = set (x, Defined)
+         in (bind, ignore o reference, reference, unbind)
+         end
       fun make (layout, plist) =
-	 let val (bind, reference, _, unbind) = make' (layout, plist)
-	 in (fn x => bind (x, ()), reference, unbind)
-	 end
+         let val (bind, reference, _, unbind) = make' (layout, plist)
+         in (fn x => bind (x, ()), reference, unbind)
+         end
       val (bindTycon, _, getTycon', _) = make' (Tycon.layout, Tycon.plist)
       val (bindCon, getCon, getCon', _) = make' (Con.layout, Con.plist)
       val (bindVar, getVar, getVar', unbindVar) = make' (Var.layout, Var.plist)
@@ -56,120 +56,120 @@
       val (bindFunc, getFunc, _) = make (Func.layout, Func.plist)
       val (bindLabel, getLabel, unbindLabel) = make (Label.layout, Label.plist)
       fun loopStatement (s: Statement.t): unit =
-	 let
-	    val () = Statement.foreachUse (s, getVar)
-	    val () = Statement.foreachDef (s, bindVar)
-	    val () =
-	       case s of
-		  Bind {exp = Object {con, ...}, ...} => Option.app (con, getCon)
-		| _ => ()
-	 in
-	    ()
-	 end
+         let
+            val () = Statement.foreachUse (s, getVar)
+            val () = Statement.foreachDef (s, bindVar)
+            val () =
+               case s of
+                  Bind {exp = Object {con, ...}, ...} => Option.app (con, getCon)
+                | _ => ()
+         in
+            ()
+         end
       val loopTransfer =
-	 fn Arith {args, ...} => getVars args
-	  | Bug => ()
-	  | Call {func, args, ...} => (getFunc func; getVars args)
-	  | Case {test, cases, default, ...} =>
-	       let
-		  fun doit (cases: ('a * 'b) vector,
-			    equals: 'a * 'a -> bool,
-			    toWord: 'a -> word): unit =
-		     let
-		        val table = HashSet.new {hash = toWord}
-			val _ =
-			   Vector.foreach
-			   (cases, fn (x, _) =>
-			    let
-			       val _ = 
-				  HashSet.insertIfNew
-				  (table, toWord x, fn y => equals (x, y),
-				   fn () => x, 
-				   fn _ => Error.bug "redundant branch in case")
-			    in
-			       ()
-			    end)
-		     in
-			if isSome default
-			   then ()
-			else Error.bug "case has no default"
-		     end
-		  fun doitCon cases =
-		     let
-		        val numCons = 
-			   case Type.dest (getVar' test) of
-			      Type.Datatype t => getTycon' t
-			    | _ => Error.bug (concat
-					      ["case test ",
-					       Var.toString test,
-					       " is not a datatype"])
-			val cons = Array.array (numCons, false)
-			val _ =
-			   Vector.foreach
-			   (cases, fn (con, _) =>
-			    let
-			       val i = getCon' con
-			    in
-			       if Array.sub (cons, i)
-				  then Error.bug "redundant branch in case"
-			       else Array.update (cons, i, true)
-			    end)
-		     in
-			case (Array.forall (cons, fn b => b), isSome default) of
-			   (true, true) =>
-			      Error.bug "exhaustive case has default"
-			 | (false, false) =>
-			      Error.bug "non-exhaustive case has no default"
-			 | _ => ()
-		     end
-		  val _ = getVar test
-	       in
-		  case cases of
-		     Cases.Con cs => doitCon cs 
-		   | Cases.Word (_, cs) =>
-			doit (cs, WordX.equals, Word.fromIntInf o WordX.toIntInf)
-	       end
-	  | Goto {args, ...} => getVars args
-	  | Raise xs => getVars xs
-	  | Return xs => getVars xs
-	  | Runtime {args, ...} => getVars args
+         fn Arith {args, ...} => getVars args
+          | Bug => ()
+          | Call {func, args, ...} => (getFunc func; getVars args)
+          | Case {test, cases, default, ...} =>
+               let
+                  fun doit (cases: ('a * 'b) vector,
+                            equals: 'a * 'a -> bool,
+                            toWord: 'a -> word): unit =
+                     let
+                        val table = HashSet.new {hash = toWord}
+                        val _ =
+                           Vector.foreach
+                           (cases, fn (x, _) =>
+                            let
+                               val _ = 
+                                  HashSet.insertIfNew
+                                  (table, toWord x, fn y => equals (x, y),
+                                   fn () => x, 
+                                   fn _ => Error.bug "Ssa2.TypeCheck2.loopTransfer: redundant branch in case")
+                            in
+                               ()
+                            end)
+                     in
+                        if isSome default
+                           then ()
+                        else Error.bug "Ssa2.TypeCheck2.loopTransfer: case has no default"
+                     end
+                  fun doitCon cases =
+                     let
+                        val numCons = 
+                           case Type.dest (getVar' test) of
+                              Type.Datatype t => getTycon' t
+                            | _ => Error.bug (concat
+                                              ["Ssa2.TypeCheck2.loopTransfer: case test ",
+                                               Var.toString test,
+                                               " is not a datatype"])
+                        val cons = Array.array (numCons, false)
+                        val _ =
+                           Vector.foreach
+                           (cases, fn (con, _) =>
+                            let
+                               val i = getCon' con
+                            in
+                               if Array.sub (cons, i)
+                                  then Error.bug "Ssa2.TypeCheck2.loopTransfer: redundant branch in case"
+                               else Array.update (cons, i, true)
+                            end)
+                     in
+                        case (Array.forall (cons, fn b => b), isSome default) of
+                           (true, true) =>
+                              Error.bug "Ssa2.TypeCheck2.loopTransfer: exhaustive case has default"
+                         | (false, false) =>
+                              Error.bug "Ssa2.TypeCheck2.loopTransfer: non-exhaustive case has no default"
+                         | _ => ()
+                     end
+                  val _ = getVar test
+               in
+                  case cases of
+                     Cases.Con cs => doitCon cs 
+                   | Cases.Word (_, cs) =>
+                        doit (cs, WordX.equals, Word.fromIntInf o WordX.toIntInf)
+               end
+          | Goto {args, ...} => getVars args
+          | Raise xs => getVars xs
+          | Return xs => getVars xs
+          | Runtime {args, ...} => getVars args
       fun loopFunc (f: Function.t) =
-	 let
-	    val {args, blocks, ...} = Function.dest f
-	    (* Descend the dominator tree, verifying that variable definitions
-	     * dominate variable uses.
-	     *)
-	    fun loop (Tree.T (block, children)): unit =
-	       let
-		  val Block.T {args, statements, transfer, ...} = block
-		  val _ = Vector.foreach (args, bindVar)
-		  val _ = Vector.foreach (statements, loopStatement)
-		  val _ = loopTransfer transfer
-		  val _ = Vector.foreach (children, loop)
-		  val _ =
-		     Vector.foreach (statements, fn s =>
-				     Statement.foreachDef (s, unbindVar o #1))
-		  val _ = Vector.foreach (args, unbindVar o #1)
-	       in
-		  ()
-	       end
-	    val _ = Vector.foreach (args, bindVar)
-	    val _ = Vector.foreach (blocks, bindLabel o Block.label)
-	    val _ =
-	       Vector.foreach
-	       (blocks, fn Block.T {transfer, ...} =>
-		Transfer.foreachLabel (transfer, getLabel))
-	    val _ = loop (Function.dominatorTree f)
-	    val _ = Vector.foreach (blocks, unbindLabel o Block.label)
-	    val _ = Vector.foreach (args, unbindVar o #1)
-	    val _ = Function.clear f
-	 in
-	     ()
-	 end
+         let
+            val {args, blocks, ...} = Function.dest f
+            (* Descend the dominator tree, verifying that variable definitions
+             * dominate variable uses.
+             *)
+            fun loop (Tree.T (block, children)): unit =
+               let
+                  val Block.T {args, statements, transfer, ...} = block
+                  val _ = Vector.foreach (args, bindVar)
+                  val _ = Vector.foreach (statements, loopStatement)
+                  val _ = loopTransfer transfer
+                  val _ = Vector.foreach (children, loop)
+                  val _ =
+                     Vector.foreach (statements, fn s =>
+                                     Statement.foreachDef (s, unbindVar o #1))
+                  val _ = Vector.foreach (args, unbindVar o #1)
+               in
+                  ()
+               end
+            val _ = Vector.foreach (args, bindVar)
+            val _ = Vector.foreach (blocks, bindLabel o Block.label)
+            val _ =
+               Vector.foreach
+               (blocks, fn Block.T {transfer, ...} =>
+                Transfer.foreachLabel (transfer, getLabel))
+            val _ = loop (Function.dominatorTree f)
+            val _ = Vector.foreach (blocks, unbindLabel o Block.label)
+            val _ = Vector.foreach (args, unbindVar o #1)
+            val _ = Function.clear f
+         in
+             ()
+         end
       val _ = Vector.foreach
-	      (datatypes, fn Datatype.T {tycon, cons} =>
-	       (bindTycon (tycon, Vector.length cons) ;
-		Vector.foreachi (cons, fn (i, {con, ...}) => bindCon (con, i))))
+              (datatypes, fn Datatype.T {tycon, cons} =>
+               (bindTycon (tycon, Vector.length cons) ;
+                Vector.foreachi (cons, fn (i, {con, ...}) => bindCon (con, i))))
       val _ = Vector.foreach (globals, loopStatement)
       val _ = List.foreach (functions, bindFunc o Function.name)
       val _ = List.foreach (functions, loopFunc)
@@ -184,123 +184,123 @@
 structure Function =
    struct
       open Function
-	 
+         
       fun checkProf (f: t): unit =
-	 let
-	    val debug = false
-	    val {blocks, start, ...} = dest f
-	    val {get = labelInfo, rem, set = setLabelInfo, ...} =
-	       Property.getSetOnce
-	       (Label.plist,
-		Property.initRaise ("info", Label.layout))
-	    val _ = Vector.foreach (blocks, fn b as Block.T {label, ...} =>
-				    setLabelInfo (label,
-						  {block = b,
-						   sources = ref NONE}))
-	    fun goto (l: Label.t, sources: SourceInfo.t list) =
-	       let
-		  fun bug (msg: string): 'a =
-		     let
-			val _ = 
-			   Vector.foreach
-			   (blocks, fn Block.T {label, ...} =>
-			    let
-			       val {sources, ...} = labelInfo label
-			       open Layout
-			    in
-			       outputl
-			       (seq [Label.layout label,
-				     str " ",
-				     Option.layout
-				     (List.layout SourceInfo.layout)
-				     (!sources)],
-				Out.error)
-			    end)
-		     in
-			Error.bug
-			(concat ["checkProf bug found in ", Label.toString l,
-				 ": ", msg])
-		     end
-		  val _ =
-		     if not debug
-			then ()
-		     else
-		     let
-			open Layout
-		     in
-			outputl (seq [str "goto (",
-				      Label.layout l,
-				      str ", ",
-				      List.layout SourceInfo.layout sources,
-				      str ")"],
-				 Out.error)
-		     end
-		  val {block, sources = r} = labelInfo l
-	       in
-		  case !r of
-		     NONE =>
-			let
-			   val _ = r := SOME sources
-			   val Block.T {statements, transfer, ...} = block
-			   datatype z = datatype Statement.t
-			   datatype z = datatype ProfileExp.t
-			   val sources =
-			      Vector.fold
-			      (statements, sources, fn (s, sources) =>
-			       case s of
-				  Profile pe =>
-				     (case pe of
-					 Enter s => s :: sources
-				       | Leave s =>
-					    (case sources of
-						[] => bug "unmatched Leave"
-					      | s' :: sources =>
-						   if SourceInfo.equals (s, s')
-						      then sources
-						   else bug "mismatched Leave"))
-				| _ => sources)
-			   val _ =
-			      if not debug
-				 then ()
-			      else
-			      let
-				 open Layout
-			      in
-				 outputl (List.layout SourceInfo.layout sources,
-					  Out.error)
-			      end
-			   val _ = 
-			      if (case transfer of
-				     Call {return, ...} =>
-					let
-					   datatype z = datatype Return.t
-					in
-					   case return of
-					      Dead => false
-					    | NonTail _ => false
-					    | Tail => true
-					end
-				   | Raise _ => true
-				   | Return _ => true
-				   | _ => false)
-				 then (case sources of
-					  [] => ()
-					| _ => bug "nonempty sources when leaving function")
-			      else ()
-			in
-			   Transfer.foreachLabel
-			   (transfer, fn l => goto (l, sources))
-			end
-		   | SOME sources' =>
-			if List.equals (sources, sources', SourceInfo.equals)
-			   then ()
-			else bug "mismatched block"
-	       end
-	    val _ = goto (start, [])
-	    val _ = Vector.foreach (blocks, fn Block.T {label, ...} => rem label)
-	 in
-	    ()
-	 end
+         let
+            val debug = false
+            val {blocks, start, ...} = dest f
+            val {get = labelInfo, rem, set = setLabelInfo, ...} =
+               Property.getSetOnce
+               (Label.plist,
+                Property.initRaise ("info", Label.layout))
+            val _ = Vector.foreach (blocks, fn b as Block.T {label, ...} =>
+                                    setLabelInfo (label,
+                                                  {block = b,
+                                                   sources = ref NONE}))
+            fun goto (l: Label.t, sources: SourceInfo.t list) =
+               let
+                  fun bug (msg: string): 'a =
+                     let
+                        val _ = 
+                           Vector.foreach
+                           (blocks, fn Block.T {label, ...} =>
+                            let
+                               val {sources, ...} = labelInfo label
+                               open Layout
+                            in
+                               outputl
+                               (seq [Label.layout label,
+                                     str " ",
+                                     Option.layout
+                                     (List.layout SourceInfo.layout)
+                                     (!sources)],
+                                Out.error)
+                            end)
+                     in
+                        Error.bug
+                        (concat ["Ssa2.TypeCheck2.checkProf: bug found in ", Label.toString l,
+                                 ": ", msg])
+                     end
+                  val _ =
+                     if not debug
+                        then ()
+                     else
+                     let
+                        open Layout
+                     in
+                        outputl (seq [str "goto (",
+                                      Label.layout l,
+                                      str ", ",
+                                      List.layout SourceInfo.layout sources,
+                                      str ")"],
+                                 Out.error)
+                     end
+                  val {block, sources = r} = labelInfo l
+               in
+                  case !r of
+                     NONE =>
+                        let
+                           val _ = r := SOME sources
+                           val Block.T {statements, transfer, ...} = block
+                           datatype z = datatype Statement.t
+                           datatype z = datatype ProfileExp.t
+                           val sources =
+                              Vector.fold
+                              (statements, sources, fn (s, sources) =>
+                               case s of
+                                  Profile pe =>
+                                     (case pe of
+                                         Enter s => s :: sources
+                                       | Leave s =>
+                                            (case sources of
+                                                [] => bug "unmatched Leave"
+                                              | s' :: sources =>
+                                                   if SourceInfo.equals (s, s')
+                                                      then sources
+                                                   else bug "mismatched Leave"))
+                                | _ => sources)
+                           val _ =
+                              if not debug
+                                 then ()
+                              else
+                              let
+                                 open Layout
+                              in
+                                 outputl (List.layout SourceInfo.layout sources,
+                                          Out.error)
+                              end
+                           val _ = 
+                              if (case transfer of
+                                     Call {return, ...} =>
+                                        let
+                                           datatype z = datatype Return.t
+                                        in
+                                           case return of
+                                              Dead => false
+                                            | NonTail _ => false
+                                            | Tail => true
+                                        end
+                                   | Raise _ => true
+                                   | Return _ => true
+                                   | _ => false)
+                                 then (case sources of
+                                          [] => ()
+                                        | _ => bug "nonempty sources when leaving function")
+                              else ()
+                        in
+                           Transfer.foreachLabel
+                           (transfer, fn l => goto (l, sources))
+                        end
+                   | SOME sources' =>
+                        if List.equals (sources, sources', SourceInfo.equals)
+                           then ()
+                        else bug "mismatched block"
+               end
+            val _ = goto (start, [])
+            val _ = Vector.foreach (blocks, fn Block.T {label, ...} => rem label)
+         in
+            ()
+         end
    end
 
 fun checkProf (Program.T {functions, ...}): unit =
@@ -312,146 +312,146 @@
    let
       val _ = checkScopes program
       val _ =
-	 if !Control.profile <> Control.ProfileNone
-	    then checkProf program
-	 else ()
+         if !Control.profile <> Control.ProfileNone
+            then checkProf program
+         else ()
       val out = Out.error
       val print = Out.outputc out
       exception TypeError
       fun error (msg, lay) =
-	 (print (concat ["Type error: ", msg, "\n"])
-	  ; Layout.output (lay, out)
-	  ; print "\n"
-	  ; raise TypeError)
+         (print (concat ["Type error: ", msg, "\n"])
+          ; Layout.output (lay, out)
+          ; print "\n"
+          ; raise TypeError)
       val {get = conInfo: Con.t -> {result: Type.t,
-				    ty: Type.t,
-				    tycon: Tycon.t},
-	   set = setConInfo, ...} =
-	 Property.getSetOnce
-	 (Con.plist, Property.initRaise ("TypeCheck.info", Con.layout))
+                                    ty: Type.t,
+                                    tycon: Tycon.t},
+           set = setConInfo, ...} =
+         Property.getSetOnce
+         (Con.plist, Property.initRaise ("TypeCheck.info", Con.layout))
       val conTycon = #tycon o conInfo
       val _ =
-	 Vector.foreach
-	 (datatypes, fn Datatype.T {tycon, cons} =>
-	  let
-	     val result = Type.datatypee tycon
-	  in
-	     Vector.foreach (cons, fn {con, args} =>
-			     setConInfo (con, {result = result,
-					       ty = Type.conApp (con, args),
-					       tycon = tycon}))
-	  end)
+         Vector.foreach
+         (datatypes, fn Datatype.T {tycon, cons} =>
+          let
+             val result = Type.datatypee tycon
+          in
+             Vector.foreach (cons, fn {con, args} =>
+                             setConInfo (con, {result = result,
+                                               ty = Type.conApp (con, args),
+                                               tycon = tycon}))
+          end)
       fun inject {sum: Tycon.t, variant: Type.t}: Type.t =
-	 let
-	    val error = fn msg =>
-	       error (concat ["inject: ", msg],
-		      Layout.record [("sum", Tycon.layout sum),
-				     ("variant", Type.layout variant)])
-	 in
-	    case Type.dest variant of
-	       Type.Object {con, ...} =>
-		  (case con of
-		      ObjectCon.Con c =>
-			 if Tycon.equals (conTycon c, sum)
-			    then Type.datatypee sum
-			 else error "inject into wrong sum"
-		    | _ => error "inject")
-	     | _ => error "inject of no object"
-	 end
+         let
+            val error = fn msg =>
+               error (concat ["inject: ", msg],
+                      Layout.record [("sum", Tycon.layout sum),
+                                     ("variant", Type.layout variant)])
+         in
+            case Type.dest variant of
+               Type.Object {con, ...} =>
+                  (case con of
+                      ObjectCon.Con c =>
+                         if Tycon.equals (conTycon c, sum)
+                            then Type.datatypee sum
+                         else error "inject into wrong sum"
+                    | _ => error "inject")
+             | _ => error "inject of no object"
+         end
       fun coerce {from: Type.t, to: Type.t}: unit =
-	 if Type.equals (from, to)
-	    then ()
-	 else error ("TypeCheck.coerce",
-		     Layout.record [("from", Type.layout from),
-				    ("to", Type.layout to)])
+         if Type.equals (from, to)
+            then ()
+         else error ("SSa2.TypeCheck2.coerce",
+                     Layout.record [("from", Type.layout from),
+                                    ("to", Type.layout to)])
       val coerce =
-	 Trace.trace ("TypeCheck.coerce",
-		      fn {from, to} => let open Layout
-				       in record [("from", Type.layout from),
-						  ("to", Type.layout to)]
-				       end,
-				    Unit.layout) coerce
+         Trace.trace ("Ssa2.TypeCheck2.coerce",
+                      fn {from, to} => let open Layout
+                                       in record [("from", Type.layout from),
+                                                  ("to", Type.layout to)]
+                                       end,
+                                    Unit.layout) coerce
       fun object {args, con, resultType} =
-	 let
-	    fun err () = error ("bad object", Layout.empty)
-	 in
-	    case Type.dest resultType of
-	       Type.Object {args = args', con = con'} =>
-		  (if (case (con, con') of
-			  (NONE, ObjectCon.Tuple) => true
-			| (SOME c, ObjectCon.Con c') => Con.equals (c, c')
-			| _ => false)
-		      andalso (Vector.foreach2
-			       (Prod.dest args, Prod.dest args',
-				fn ({elt = t, isMutable = _}, {elt = t', ...}) =>
-				coerce {from = t, to = t'})
-			       ; true)
-		      then resultType
-		   else err ())
-	     | _ => err ()
-	 end
+         let
+            fun err () = error ("bad object", Layout.empty)
+         in
+            case Type.dest resultType of
+               Type.Object {args = args', con = con'} =>
+                  (if (case (con, con') of
+                          (NONE, ObjectCon.Tuple) => true
+                        | (SOME c, ObjectCon.Con c') => Con.equals (c, c')
+                        | _ => false)
+                      andalso (Vector.foreach2
+                               (Prod.dest args, Prod.dest args',
+                                fn ({elt = t, isMutable = _}, {elt = t', ...}) =>
+                                coerce {from = t, to = t'})
+                               ; true)
+                      then resultType
+                   else err ())
+             | _ => err ()
+         end
       fun select {base: Type.t, offset: int, resultType = _}: Type.t =
-	 case Type.dest base of
-	    Type.Object {args, ...} => Prod.elt (args, offset)
-	  | _ => error ("select of non object", Layout.empty)
+         case Type.dest base of
+            Type.Object {args, ...} => Prod.elt (args, offset)
+          | _ => error ("select of non object", Layout.empty)
       fun update {base, offset, value} =
-	 case Type.dest base of
-	    Type.Object {args, ...} =>
-	       let
-		  val {elt, isMutable} = Prod.sub (args, offset)
-		  val () = coerce {from = value, to = elt}
-		  val () =
-		     if isMutable
-			then ()
-		     else error ("update of non-mutable field", Layout.empty)
-	       in
-		  ()
-	       end
-	  | _ => error ("update of non object", Layout.empty)
+         case Type.dest base of
+            Type.Object {args, ...} =>
+               let
+                  val {elt, isMutable} = Prod.sub (args, offset)
+                  val () = coerce {from = value, to = elt}
+                  val () =
+                     if isMutable
+                        then ()
+                     else error ("update of non-mutable field", Layout.empty)
+               in
+                  ()
+               end
+          | _ => error ("update of non object", Layout.empty)
       fun filter {con, test, variant} =
-	 let
-	    val {result, ty, ...} = conInfo con
-	    val () = coerce {from = test, to = result}
-	    val () = Option.app (variant, fn to => coerce {from = ty, to = to})
-	 in
-	    ()
-	 end
+         let
+            val {result, ty, ...} = conInfo con
+            val () = coerce {from = test, to = result}
+            val () = Option.app (variant, fn to => coerce {from = ty, to = to})
+         in
+            ()
+         end
       fun filterWord (from, s) = coerce {from = from, to = Type.word s}
       fun primApp {args, prim, resultType, resultVar = _} =
-	 let
-	    datatype z = datatype Prim.Name.t
-	    val () =
-	       if Type.checkPrimApp {args = args,
-				     prim = prim,
-				     result = resultType}
-		  then ()
-	       else error ("bad primapp",
-			   let
-			      open Layout
-			   in
-			      seq [Prim.layout prim, str " ",
-				   tuple (Vector.toListMap (args, Type.layout))]
-			   end)
-	 in
-	    resultType
-	 end
+         let
+            datatype z = datatype Prim.Name.t
+            val () =
+               if Type.checkPrimApp {args = args,
+                                     prim = prim,
+                                     result = resultType}
+                  then ()
+               else error ("bad primapp",
+                           let
+                              open Layout
+                           in
+                              seq [Prim.layout prim, str " ",
+                                   tuple (Vector.toListMap (args, Type.layout))]
+                           end)
+         in
+            resultType
+         end
       val _ =
-	 analyze {coerce = coerce,
-		  const = Type.ofConst,
-		  filter = filter,
-		  filterWord = filterWord,
-		  fromType = fn x => x,
-		  inject = inject,
-		  layout = Type.layout,
-		  object = object,
-		  primApp = primApp,
-		  program = program,
-		  select = select,
-		  update = update,
-		  useFromTypeOnBinds = true}
-	 handle e => error (concat ["analyze raised exception ",
-				    Layout.toString (Exn.layout e)],
-			    Layout.empty)
+         analyze {coerce = coerce,
+                  const = Type.ofConst,
+                  filter = filter,
+                  filterWord = filterWord,
+                  fromType = fn x => x,
+                  inject = inject,
+                  layout = Type.layout,
+                  object = object,
+                  primApp = primApp,
+                  program = program,
+                  select = select,
+                  update = update,
+                  useFromTypeOnBinds = true}
+         handle e => error (concat ["analyze raised exception ",
+                                    Layout.toString (Exn.layout e)],
+                            Layout.empty)
       val _ = Program.clear program
    in
       ()

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ssa/type-check2.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ssa/type-check2.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ssa/type-check2.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,9 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 signature TYPE_CHECK2_STRUCTS = 

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ssa/useless.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ssa/useless.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ssa/useless.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 functor Useless (S: USELESS_STRUCTS): USELESS = 
 struct
 
@@ -50,351 +51,351 @@
       structure Set = DisjointSet
 
       structure Exists =
-	 struct
-	    structure L = TwoPointLattice (val bottom = "not exists"
-					   val top = "exists")
-	    open L
-	    val mustExist = makeTop
-	    val doesExist = isTop
-	 end
+         struct
+            structure L = TwoPointLattice (val bottom = "not exists"
+                                           val top = "exists")
+            open L
+            val mustExist = makeTop
+            val doesExist = isTop
+         end
 
       structure Useful =
-	 struct
-	    structure L = TwoPointLattice (val bottom = "useless"
-					   val top = "useful")
-	    open L
-	    val makeUseful = makeTop
-	    val isUseful = isTop
-	 end
+         struct
+            structure L = TwoPointLattice (val bottom = "useless"
+                                           val top = "useful")
+            open L
+            val makeUseful = makeTop
+            val isUseful = isTop
+         end
       
       datatype t =
-	 T of {new: (Type.t * bool) option ref,
-	       ty: Type.t,
-	       value: value} Set.t
+         T of {new: (Type.t * bool) option ref,
+               ty: Type.t,
+               value: value} Set.t
       and value =
-	 Array of {elt: slot,
-		   length: t,
-		   useful: Useful.t}
-	| Ground of Useful.t
-	| Ref of {arg: slot,
-		  useful: Useful.t}
-	| Tuple of slot vector
-	| Vector of {elt: slot,
-		     length: t}
-	| Weak of {arg: slot,
-		   useful: Useful.t}
+         Array of {elt: slot,
+                   length: t,
+                   useful: Useful.t}
+        | Ground of Useful.t
+        | Ref of {arg: slot,
+                  useful: Useful.t}
+        | Tuple of slot vector
+        | Vector of {elt: slot,
+                     length: t}
+        | Weak of {arg: slot,
+                   useful: Useful.t}
       withtype slot = t * Exists.t
 
       local
-	 fun make sel (T s) = sel (Set.! s)
+         fun make sel (T s) = sel (Set.! s)
       in
-	 val value = make #value
-	 val ty = make #ty
+         val value = make #value
+         val ty = make #ty
       end
    
       local
-	 open Layout
+         open Layout
       in
-	 fun layout (T s) =
-	    let
-	       val {value, ...} = Set.! s
-	    in
-	       case value of
-		  Array {elt, length, ...} =>
-		     seq [str "array", tuple [layout length, layoutSlot elt]]
-		| Ground g => seq [str "ground ", Useful.layout g]
-		| Ref {arg, useful, ...} =>
-		     seq [str "ref ",
-			  record [("useful", Useful.layout useful),
-				  ("slot", layoutSlot arg)]]
-		| Tuple vs => Vector.layout layoutSlot vs
-		| Vector {elt, length} =>
-		     seq [str "vector", tuple [layout length, layoutSlot elt]]
-		| Weak {arg, useful} =>
-		     seq [str "weak ", 
-			  record [("useful", Useful.layout useful),
-				  ("slot", layoutSlot arg)]]
-	    end
-	 and layoutSlot (v, e) =
-	    tuple [Exists.layout e, layout v]
+         fun layout (T s) =
+            let
+               val {value, ...} = Set.! s
+            in
+               case value of
+                  Array {elt, length, ...} =>
+                     seq [str "array", tuple [layout length, layoutSlot elt]]
+                | Ground g => seq [str "ground ", Useful.layout g]
+                | Ref {arg, useful, ...} =>
+                     seq [str "ref ",
+                          record [("useful", Useful.layout useful),
+                                  ("slot", layoutSlot arg)]]
+                | Tuple vs => Vector.layout layoutSlot vs
+                | Vector {elt, length} =>
+                     seq [str "vector", tuple [layout length, layoutSlot elt]]
+                | Weak {arg, useful} =>
+                     seq [str "weak ", 
+                          record [("useful", Useful.layout useful),
+                                  ("slot", layoutSlot arg)]]
+            end
+         and layoutSlot (v, e) =
+            tuple [Exists.layout e, layout v]
       end
 
       fun unify (T s, T s') =
-	 if Set.equals (s, s')
-	    then ()
-	 else
-	    let
-	       val {value = v, ...} = Set.! s
-	       val {value = v', ...} = Set.! s'
-	       val _ = Set.union (s, s')
-	    in
-	       case (v, v') of
-		  (Array {length = n, elt = e, ...},
-		   Array {length = n', elt = e', ...}) =>
-		     (unify (n, n'); unifySlot (e, e'))
-		| (Ground g, Ground g') => Useful.== (g, g')
-		| (Ref {useful = u, arg = a},
-		   Ref {useful = u', arg = a'}) =>
-		     (Useful.== (u, u'); unifySlot (a, a'))
-		| (Tuple vs, Tuple vs') =>
-		     Vector.foreach2 (vs, vs', unifySlot)
-		| (Vector {length = n, elt = e},
-		   Vector {length = n', elt = e'}) =>
-		     (unify (n, n'); unifySlot (e, e'))
-		| (Weak {useful = u, arg = a}, Weak {useful = u', arg = a'}) =>
-		     (Useful.== (u, u'); unifySlot (a, a'))
-		| _ => Error.bug "strange unify"
-	    end
+         if Set.equals (s, s')
+            then ()
+         else
+            let
+               val {value = v, ...} = Set.! s
+               val {value = v', ...} = Set.! s'
+               val _ = Set.union (s, s')
+            in
+               case (v, v') of
+                  (Array {length = n, elt = e, ...},
+                   Array {length = n', elt = e', ...}) =>
+                     (unify (n, n'); unifySlot (e, e'))
+                | (Ground g, Ground g') => Useful.== (g, g')
+                | (Ref {useful = u, arg = a},
+                   Ref {useful = u', arg = a'}) =>
+                     (Useful.== (u, u'); unifySlot (a, a'))
+                | (Tuple vs, Tuple vs') =>
+                     Vector.foreach2 (vs, vs', unifySlot)
+                | (Vector {length = n, elt = e},
+                   Vector {length = n', elt = e'}) =>
+                     (unify (n, n'); unifySlot (e, e'))
+                | (Weak {useful = u, arg = a}, Weak {useful = u', arg = a'}) =>
+                     (Useful.== (u, u'); unifySlot (a, a'))
+                | _ => Error.bug "Useless.Value.unify: strange"
+            end
       and unifySlot ((v, e), (v', e')) = (unify (v, v'); Exists.== (e, e'))
-	 
+         
       fun coerce {from = from as T sfrom, to = to as T sto}: unit =
-	 if Set.equals (sfrom, sto)
-	    then ()
-	 else
-	    let
-	       fun coerceSlot ((v, e), (v', e')) =
-		  (coerce {from = v, to = v'}
-		   ; Exists.== (e, e'))
-	    in
-	       case (value from, value to) of
-		  (Array _, Array _) => unify (from, to)
-		| (Ground to, Ground from) => Useful.<= (from, to)
-		| (Ref _, Ref _) => unify (from, to)
-		| (Tuple vs, Tuple vs') =>
-		     Vector.foreach2 (vs, vs', coerceSlot)
-		| (Vector {length = n, elt = e},
-		   Vector {length = n', elt = e'}) =>
-		     (coerce {from = n, to = n'}
-		      ; coerceSlot (e, e'))
-		| (Weak _, Weak _) => unify (from, to)
-		| _ => Error.bug "strange coerce"
-	    end
+         if Set.equals (sfrom, sto)
+            then ()
+         else
+            let
+               fun coerceSlot ((v, e), (v', e')) =
+                  (coerce {from = v, to = v'}
+                   ; Exists.== (e, e'))
+            in
+               case (value from, value to) of
+                  (Array _, Array _) => unify (from, to)
+                | (Ground to, Ground from) => Useful.<= (from, to)
+                | (Ref _, Ref _) => unify (from, to)
+                | (Tuple vs, Tuple vs') =>
+                     Vector.foreach2 (vs, vs', coerceSlot)
+                | (Vector {length = n, elt = e},
+                   Vector {length = n', elt = e'}) =>
+                     (coerce {from = n, to = n'}
+                      ; coerceSlot (e, e'))
+                | (Weak _, Weak _) => unify (from, to)
+                | _ => Error.bug "Useles.Value.coerce: strange"
+            end
 
       val coerce =
-	 Trace.trace ("Useless.coerce",
-		      fn {from, to} => let open Layout
-				       in record [("from", layout from),
-						  ("to", layout to)]
-				       end,
-		      Unit.layout) 
-	 coerce
+         Trace.trace ("Useless.Value.coerce",
+                      fn {from, to} => let open Layout
+                                       in record [("from", layout from),
+                                                  ("to", layout to)]
+                                       end,
+                      Unit.layout) 
+         coerce
 
       fun coerces {from, to} =
-	 Vector.foreach2 (from, to, fn (from, to) =>
-			  coerce {from = from, to = to})
-	 
+         Vector.foreach2 (from, to, fn (from, to) =>
+                          coerce {from = from, to = to})
+         
       fun foreach (v: t, f: Useful.t -> unit): unit  =
-	 let
-	    fun loop (v: t): unit =
-	       case value v of
-		  Array {length, elt, useful} =>
-		     (f useful; loop length; slot elt)
-		| Ground u => f u
-		| Tuple vs => Vector.foreach (vs, slot)
-		| Ref {arg, useful} => (f useful; slot arg)
-		| Vector {length, elt} => (loop length; slot elt)
-		| Weak {arg, useful} => (f useful; slot arg)
-	    and slot (v, _) = loop v
-	 in
-	    loop v
-	 end
+         let
+            fun loop (v: t): unit =
+               case value v of
+                  Array {length, elt, useful} =>
+                     (f useful; loop length; slot elt)
+                | Ground u => f u
+                | Tuple vs => Vector.foreach (vs, slot)
+                | Ref {arg, useful} => (f useful; slot arg)
+                | Vector {length, elt} => (loop length; slot elt)
+                | Weak {arg, useful} => (f useful; slot arg)
+            and slot (v, _) = loop v
+         in
+            loop v
+         end
       
       (* Coerce every ground value in v to u. *)
       fun deepCoerce (v: t, u: Useful.t): unit =
-	 foreach (v, fn u' => Useful.<= (u', u))
+         foreach (v, fn u' => Useful.<= (u', u))
 
       val deepCoerce =
-	 Trace.trace2 ("Useless.deepCoerce", layout, Useful.layout, Unit.layout)
-	 deepCoerce
-	 
+         Trace.trace2 ("Useless.deepCoerce", layout, Useful.layout, Unit.layout)
+         deepCoerce
+         
       fun deground (v: t): Useful.t =
-	 case value v of
-	    Ground g => g
-	  | _ => Error.bug "deground"
+         case value v of
+            Ground g => g
+          | _ => Error.bug "Useless.deground"
 
       fun someUseful (v: t): Useful.t option =
-	 case value v of
-	    Array {useful = u, ...} => SOME u
-	  | Ground u => SOME u
-	  | Ref {useful = u, ...} => SOME u
-	  | Tuple slots => Vector.peekMap (slots, someUseful o #1)
-	  | Vector {length, ...} => SOME (deground length)
-	  | Weak {useful = u, ...} => SOME u
+         case value v of
+            Array {useful = u, ...} => SOME u
+          | Ground u => SOME u
+          | Ref {useful = u, ...} => SOME u
+          | Tuple slots => Vector.peekMap (slots, someUseful o #1)
+          | Vector {length, ...} => SOME (deground length)
+          | Weak {useful = u, ...} => SOME u
 
       fun allOrNothing (v: t): Useful.t option =
-	 case someUseful v of
-	    NONE => NONE
-	  | SOME u => (foreach (v, fn u' => Useful.== (u, u'))
-		       ; SOME u)
+         case someUseful v of
+            NONE => NONE
+          | SOME u => (foreach (v, fn u' => Useful.== (u, u'))
+                       ; SOME u)
 
       fun fromType (t: Type.t): t =
-	 let
-	    fun loop (t: Type.t, es: Exists.t list): t =
-	       let
-		  fun useful () =
-		     let val u = Useful.new ()
-		     in Useful.addHandler
-			(u, fn () => List.foreach (es, Exists.mustExist))
-			; u
-		     end
-		  fun slot t =
-		     let val e = Exists.new ()
-		     in (loop (t, e :: es), e)
-		     end
-		  val loop = fn t => loop (t, es)
-		  val value =
-		     case Type.dest t of
-			Type.Array t =>
-			   let val elt as (_, e) = slot t
-			       val length = loop Type.defaultWord
-			   in Exists.addHandler
-			      (e, fn () => Useful.makeUseful (deground length))
-			      ; Array {useful = useful (),
-				       length = length,
-				       elt = elt}
-			   end
-		      | Type.Ref t => Ref {arg = slot t,
-					   useful = useful ()}
-		      | Type.Tuple ts => Tuple (Vector.map (ts, slot))
-		      | Type.Vector t => Vector {length = loop Type.defaultWord,
-						 elt = slot t}
-		      | Type.Weak t => Weak {arg = slot t,
-					     useful = useful ()}
-		      | _ => Ground (useful ())
-	       in
-		  T (Set.singleton {ty = t,
-				    new = ref NONE,
-				    value = value})
-	       end
-	 in
-	    loop (t, [])
-	 end
+         let
+            fun loop (t: Type.t, es: Exists.t list): t =
+               let
+                  fun useful () =
+                     let val u = Useful.new ()
+                     in Useful.addHandler
+                        (u, fn () => List.foreach (es, Exists.mustExist))
+                        ; u
+                     end
+                  fun slot t =
+                     let val e = Exists.new ()
+                     in (loop (t, e :: es), e)
+                     end
+                  val loop = fn t => loop (t, es)
+                  val value =
+                     case Type.dest t of
+                        Type.Array t =>
+                           let val elt as (_, e) = slot t
+                               val length = loop Type.defaultWord
+                           in Exists.addHandler
+                              (e, fn () => Useful.makeUseful (deground length))
+                              ; Array {useful = useful (),
+                                       length = length,
+                                       elt = elt}
+                           end
+                      | Type.Ref t => Ref {arg = slot t,
+                                           useful = useful ()}
+                      | Type.Tuple ts => Tuple (Vector.map (ts, slot))
+                      | Type.Vector t => Vector {length = loop Type.defaultWord,
+                                                 elt = slot t}
+                      | Type.Weak t => Weak {arg = slot t,
+                                             useful = useful ()}
+                      | _ => Ground (useful ())
+               in
+                  T (Set.singleton {ty = t,
+                                    new = ref NONE,
+                                    value = value})
+               end
+         in
+            loop (t, [])
+         end
 
       fun const (c: Const.t): t =
-	 let
-	    val v = fromType (Type.ofConst c)
-	    (* allOrNothing v because constants are not transformed and their
-	     * type cannot change.  So they must either be completely eliminated
-	     * or completely kept.
-	     *)
-	    val _ = allOrNothing v
-	 in
-	    v
-	 end
+         let
+            val v = fromType (Type.ofConst c)
+            (* allOrNothing v because constants are not transformed and their
+             * type cannot change.  So they must either be completely eliminated
+             * or completely kept.
+             *)
+            val _ = allOrNothing v
+         in
+            v
+         end
 
       fun detupleSlots (v: t): slot vector =
-	 case value v of
-	    Tuple ss => ss
-	  | _ => Error.bug "detuple"
+         case value v of
+            Tuple ss => ss
+          | _ => Error.bug "Useless.detupleSlots"
       fun detuple v = Vector.map (detupleSlots v, #1)
       fun tuple (vs: t vector): t =
-	 let
-	    val t = Type.tuple (Vector.map (vs, ty))
-	    val v = fromType t
-	    val _ =
-	       Vector.foreach2 (vs, detuple v, fn (v, v') =>
-				coerce {from = v, to = v'})
-	 in
-	    v
-	 end
+         let
+            val t = Type.tuple (Vector.map (vs, ty))
+            val v = fromType t
+            val _ =
+               Vector.foreach2 (vs, detuple v, fn (v, v') =>
+                                coerce {from = v, to = v'})
+         in
+            v
+         end
       fun select {tuple, offset, resultType} =
-	 let
-	    val v = fromType resultType
-	    val _ = coerce {from = Vector.sub (detuple tuple, offset), to = v}
-	 in
-	    v
-	 end
+         let
+            val v = fromType resultType
+            val _ = coerce {from = Vector.sub (detuple tuple, offset), to = v}
+         in
+            v
+         end
       local
-	 fun make (err, sel) v =
-	    case value v of
-	       Vector fs => sel fs
-	     | _ => Error.bug err
+         fun make (err, sel) v =
+            case value v of
+               Vector fs => sel fs
+             | _ => Error.bug err
       in
-	 val devector = make ("devector", #1 o #elt)
-	 val vectorLength = make ("vectorLength", #length)
+         val devector = make ("Useless.devector", #1 o #elt)
+         val vectorLength = make ("Useless.vectorLength", #length)
       end
       local
-	 fun make (err, sel) v =
-	    case value v of
-	       Array fs => sel fs
-	     | _ => Error.bug err
+         fun make (err, sel) v =
+            case value v of
+               Array fs => sel fs
+             | _ => Error.bug err
       in
-	 val dearray: t -> t = make ("dearray", #1 o #elt)
-	 val arrayLength = make ("arrayLength", #length)
+         val dearray: t -> t = make ("Useless.dearray", #1 o #elt)
+         val arrayLength = make ("Useless.arrayLength", #length)
       end
 
       fun deref (r: t): t =
-	 case value r of
-	    Ref {arg, ...} => #1 arg
-	  | _ => Error.bug "deref"
+         case value r of
+            Ref {arg, ...} => #1 arg
+          | _ => Error.bug "Useless.deref"
 
       fun deweak (v: t): t =
-	 case value v of
-	    Weak {arg, ...} => #1 arg
-	  | _ => Error.bug "deweak"
+         case value v of
+            Weak {arg, ...} => #1 arg
+          | _ => Error.bug "Useless.deweak"
 
       fun newType (v: t): Type.t = #1 (getNew v)
       and isUseful (v: t): bool = #2 (getNew v)
       and getNew (T s): Type.t * bool =
-	 let
-	    val {value, ty, new, ...} = Set.! s
-	 in
-	    Ref.memoize
-	    (new, fn () =>
-	     let 
-		fun slot (arg: t, e: Exists.t) =
-		   let val (t, b) = getNew arg
-		   in (if Exists.doesExist e then t else Type.unit, b)
-		   end
-		fun wrap ((t, b), f) = (f t, b)
-		fun or ((t, b), b') = (t, b orelse b')
-		fun maybe (u: Useful.t, s: slot, make: Type.t -> Type.t) =
-		   wrap (or (slot s, Useful.isUseful u), make)
-	     in
-		case value of
-		   Array {useful, elt, length, ...} =>
-		      or (wrap (slot elt, Type.array),
-			  Useful.isUseful useful orelse isUseful length)
-		 | Ground u => (ty, Useful.isUseful u)
-		 | Ref {arg, useful, ...} =>
-		      maybe (useful, arg, Type.reff)
-		 | Tuple vs =>
-		      let
-			 val (v, b) =
-			    Vector.mapAndFold
-			    (vs, false, fn ((v, e), useful) =>
-			     let
-				val (t, u) = getNew v
-				val t =
-				   if Exists.doesExist e
-				      then SOME t
-				   else NONE
-			     in (t, u orelse useful)
-			     end)
-			 val v = Vector.keepAllMap (v, fn t => t)
-		      in
-			 (Type.tuple v, b)
-		      end
-		 | Vector {elt, length, ...} =>
-		      or (wrap (slot elt, Type.vector), isUseful length)
-		 | Weak {arg, useful} =>
-		      maybe (useful, arg, Type.weak)
-	     end)
-	 end
+         let
+            val {value, ty, new, ...} = Set.! s
+         in
+            Ref.memoize
+            (new, fn () =>
+             let 
+                fun slot (arg: t, e: Exists.t) =
+                   let val (t, b) = getNew arg
+                   in (if Exists.doesExist e then t else Type.unit, b)
+                   end
+                fun wrap ((t, b), f) = (f t, b)
+                fun or ((t, b), b') = (t, b orelse b')
+                fun maybe (u: Useful.t, s: slot, make: Type.t -> Type.t) =
+                   wrap (or (slot s, Useful.isUseful u), make)
+             in
+                case value of
+                   Array {useful, elt, length, ...} =>
+                      or (wrap (slot elt, Type.array),
+                          Useful.isUseful useful orelse isUseful length)
+                 | Ground u => (ty, Useful.isUseful u)
+                 | Ref {arg, useful, ...} =>
+                      maybe (useful, arg, Type.reff)
+                 | Tuple vs =>
+                      let
+                         val (v, b) =
+                            Vector.mapAndFold
+                            (vs, false, fn ((v, e), useful) =>
+                             let
+                                val (t, u) = getNew v
+                                val t =
+                                   if Exists.doesExist e
+                                      then SOME t
+                                   else NONE
+                             in (t, u orelse useful)
+                             end)
+                         val v = Vector.keepAllMap (v, fn t => t)
+                      in
+                         (Type.tuple v, b)
+                      end
+                 | Vector {elt, length, ...} =>
+                      or (wrap (slot elt, Type.vector), isUseful length)
+                 | Weak {arg, useful} =>
+                      maybe (useful, arg, Type.weak)
+             end)
+         end
 
       val getNew =
-	 Trace.trace ("getNew", layout, Layout.tuple2 (Type.layout, Bool.layout))
-	 getNew
+         Trace.trace ("Useless.getNew", layout, Layout.tuple2 (Type.layout, Bool.layout))
+         getNew
 
-      val isUseful = Trace.trace ("isUseful", layout, Bool.layout) isUseful
+      val isUseful = Trace.trace ("Useless.isUseful", layout, Bool.layout) isUseful
 
-      val newType = Trace.trace ("newType", layout, Type.layout) newType
-	 
+      val newType = Trace.trace ("Useless.newType", layout, Type.layout) newType
+         
       fun newTypes (vs: t vector): Type.t vector =
-	 Vector.keepAllMap (vs, fn v =>
-			    let val (t, b) = getNew v
-			    in if b then SOME t else NONE
-			    end)
+         Vector.keepAllMap (vs, fn v =>
+                            let val (t, b) = getNew v
+                            in if b then SOME t else NONE
+                            end)
    end
 
 structure Exists = Value.Exists
@@ -402,643 +403,643 @@
 fun useless (program: Program.t): Program.t =
    let
       val program as Program.T {datatypes, globals, functions, main} =
-	 eliminateDeadBlocks program
+         eliminateDeadBlocks program
       val {get = conInfo: Con.t -> {args: Value.t vector,
-				    argTypes: Type.t vector,
-				    value: unit -> Value.t},
-	   set = setConInfo, ...} =
-	 Property.getSetOnce 
-	 (Con.plist, Property.initRaise ("conInfo", Con.layout))
+                                    argTypes: Type.t vector,
+                                    value: unit -> Value.t},
+           set = setConInfo, ...} =
+         Property.getSetOnce 
+         (Con.plist, Property.initRaise ("conInfo", Con.layout))
       val {get = tyconInfo: Tycon.t -> {useful: bool ref,
-					cons: Con.t vector},
-	   set = setTyconInfo, ...} =
-	 Property.getSetOnce 
-	 (Tycon.plist, Property.initRaise ("tyconInfo", Tycon.layout))
+                                        cons: Con.t vector},
+           set = setTyconInfo, ...} =
+         Property.getSetOnce 
+         (Tycon.plist, Property.initRaise ("tyconInfo", Tycon.layout))
       local open Value
       in
-	 val _ =
-	    Vector.foreach
-	    (datatypes, fn Datatype.T {tycon, cons} =>
-	     let
-		val _ =
-		   setTyconInfo (tycon, {useful = ref false,
-					 cons = Vector.map (cons, #con)})
-		fun value () = fromType (Type.con (tycon, Vector.new0 ()))
-	     in Vector.foreach
-		(cons, fn {con, args} =>
-		 setConInfo (con, {value = value,
-				   argTypes = args,
-				   args = Vector.map (args, fromType)}))
-	     end)
-	 val conArgs = #args o conInfo
-	 fun conApp {con: Con.t,
-		     args: Value.t vector} =
-	    let val {args = args', value, ...} = conInfo con
-	    in coerces {from = args, to = args'}
-	       ; value ()
-	    end
-	 fun filter (v: Value.t, con: Con.t, to: Value.t vector): unit =
-	    case value v of
-	       Ground g =>
-		  (Useful.makeUseful g
-		   ; coerces {from = conArgs con, to = to})
-	     | _ => Error.bug "filter of non ground"
-	 fun filterGround (v: Value.t): unit =
-	    case value v of
-	       Ground g => Useful.makeUseful g
-	     | _ => Error.bug "filterInt of non ground"
-	 val filter =
-	    Trace.trace3 ("Useless.filter",
-			  Value.layout,
-			  Con.layout,
-			  Vector.layout Value.layout,
-			  Unit.layout)
-	    filter
-	 (* This is used for primitive args, since we have no idea what
-	  * components of its args that a primitive will look at.
-	  *)
-	 fun deepMakeUseful v =
-	    let
-	       val slot = deepMakeUseful o #1
-	    in
-	       case value v of
-		  Array {useful, length, elt} =>
-		     (Useful.makeUseful useful
-		      ; deepMakeUseful length
-		      ; slot elt)
-		| Ground u =>
-		     (Useful.makeUseful u
-		      (* Make all constructor args of this tycon useful *)
-		      ; (case Type.dest (ty v) of
-			    Type.Datatype tycon =>
-			       let val {useful, cons} = tyconInfo tycon
-			       in if !useful
-				     then ()
-				  else (useful := true
-					; Vector.foreach (cons, fn con =>
-							  Vector.foreach
-							  (#args (conInfo con),
-							   deepMakeUseful)))
-			       end
-			  | _ => ()))
-		| Ref {arg, useful} => (Useful.makeUseful useful; slot arg)
-		| Tuple vs => Vector.foreach (vs, slot)
-		| Vector {length, elt} => (deepMakeUseful length; slot elt)
-		| Weak {arg, useful} => (Useful.makeUseful useful; slot arg)
-	    end
+         val _ =
+            Vector.foreach
+            (datatypes, fn Datatype.T {tycon, cons} =>
+             let
+                val _ =
+                   setTyconInfo (tycon, {useful = ref false,
+                                         cons = Vector.map (cons, #con)})
+                fun value () = fromType (Type.con (tycon, Vector.new0 ()))
+             in Vector.foreach
+                (cons, fn {con, args} =>
+                 setConInfo (con, {value = value,
+                                   argTypes = args,
+                                   args = Vector.map (args, fromType)}))
+             end)
+         val conArgs = #args o conInfo
+         fun conApp {con: Con.t,
+                     args: Value.t vector} =
+            let val {args = args', value, ...} = conInfo con
+            in coerces {from = args, to = args'}
+               ; value ()
+            end
+         fun filter (v: Value.t, con: Con.t, to: Value.t vector): unit =
+            case value v of
+               Ground g =>
+                  (Useful.makeUseful g
+                   ; coerces {from = conArgs con, to = to})
+             | _ => Error.bug "Useless.filter: non ground"
+         fun filterGround (v: Value.t): unit =
+            case value v of
+               Ground g => Useful.makeUseful g
+             | _ => Error.bug "Useless.filterGround: non ground"
+         val filter =
+            Trace.trace3 ("Useless.filter",
+                          Value.layout,
+                          Con.layout,
+                          Vector.layout Value.layout,
+                          Unit.layout)
+            filter
+         (* This is used for primitive args, since we have no idea what
+          * components of its args that a primitive will look at.
+          *)
+         fun deepMakeUseful v =
+            let
+               val slot = deepMakeUseful o #1
+            in
+               case value v of
+                  Array {useful, length, elt} =>
+                     (Useful.makeUseful useful
+                      ; deepMakeUseful length
+                      ; slot elt)
+                | Ground u =>
+                     (Useful.makeUseful u
+                      (* Make all constructor args of this tycon useful *)
+                      ; (case Type.dest (ty v) of
+                            Type.Datatype tycon =>
+                               let val {useful, cons} = tyconInfo tycon
+                               in if !useful
+                                     then ()
+                                  else (useful := true
+                                        ; Vector.foreach (cons, fn con =>
+                                                          Vector.foreach
+                                                          (#args (conInfo con),
+                                                           deepMakeUseful)))
+                               end
+                          | _ => ()))
+                | Ref {arg, useful} => (Useful.makeUseful useful; slot arg)
+                | Tuple vs => Vector.foreach (vs, slot)
+                | Vector {length, elt} => (deepMakeUseful length; slot elt)
+                | Weak {arg, useful} => (Useful.makeUseful useful; slot arg)
+            end
 
-	 fun primApp {args: t vector, prim, resultVar = _, resultType,
-		      targs = _} =
-	    let
-	       val result = fromType resultType
-	       fun return v = coerce {from = v, to = result}
-	       infix dependsOn
-	       fun v1 dependsOn v2 = deepCoerce (v2, deground v1)
-	       fun arg i = Vector.sub (args, i)
-	       fun sub () =
-		  (arg 1 dependsOn result
-		   ; return (dearray (arg 0)))
-	       fun update () =
-		  let
-		     val a = dearray (arg 0)
-		  in arg 1 dependsOn a
-		     ; coerce {from = arg 2, to = a}
-		  end
-	       datatype z = datatype Prim.Name.t
-	       val _ =
-		  case Prim.name prim of
-		     Array_array =>
-			coerce {from = arg 0, to = arrayLength result}
-		   | Array_array0Const => ()
-		   | Array_length => return (arrayLength (arg 0))
-		   | Array_sub => sub ()
-		   | Array_toVector =>
-			(case (value (arg 0), value result) of
-			    (Array {length = l, elt = e, ...},
-			     Vector {length = l', elt = e', ...}) =>
-			       (unify (l, l'); unifySlot (e, e'))
-			   | _ => Error.bug "strange Array_toVector")
-		   | Array_update => update ()
-		   | MLton_equal => Vector.foreach (args, deepMakeUseful)
-		   | Ref_assign => coerce {from = arg 1, to = deref (arg 0)}
-		   | Ref_deref => return (deref (arg 0))
-		   | Ref_ref => coerce {from = arg 0, to = deref result}
-		   | Vector_length => return (vectorLength (arg 0))
-		   | Vector_sub => (arg 1 dependsOn result
-				    ; return (devector (arg 0)))
-		   | Weak_get => return (deweak (arg 0))
-		   | Weak_new => coerce {from = arg 0, to = deweak result}
-		   | Word8Array_subWord => sub ()
-		   | Word8Array_updateWord => update ()
-		   | _ =>
-			let (* allOrNothing so the type doesn't change *)
-			   val res = allOrNothing result
-			in if Prim.maySideEffect prim
-			      then Vector.foreach (args, deepMakeUseful)
-			   else
-			      Vector.foreach (args, fn a =>
-					      case (allOrNothing a, res) of
-						 (NONE, _) => ()
-					       | (SOME u, SOME u') =>
-						    Useful.<= (u', u)
-					       | _ => ())
-			end
-	    in
-	       result
-	    end
-	 val primApp =
-	    Trace.trace
-	    ("Useless.primApp",
-	     fn {prim, args, ...} =>
-	     Layout.seq [Prim.layout prim,
-			 Vector.layout layout args],
-	     layout)
-	    primApp
+         fun primApp {args: t vector, prim, resultVar = _, resultType,
+                      targs = _} =
+            let
+               val result = fromType resultType
+               fun return v = coerce {from = v, to = result}
+               infix dependsOn
+               fun v1 dependsOn v2 = deepCoerce (v2, deground v1)
+               fun arg i = Vector.sub (args, i)
+               fun sub () =
+                  (arg 1 dependsOn result
+                   ; return (dearray (arg 0)))
+               fun update () =
+                  let
+                     val a = dearray (arg 0)
+                  in arg 1 dependsOn a
+                     ; coerce {from = arg 2, to = a}
+                  end
+               datatype z = datatype Prim.Name.t
+               val _ =
+                  case Prim.name prim of
+                     Array_array =>
+                        coerce {from = arg 0, to = arrayLength result}
+                   | Array_array0Const => ()
+                   | Array_length => return (arrayLength (arg 0))
+                   | Array_sub => sub ()
+                   | Array_toVector =>
+                        (case (value (arg 0), value result) of
+                            (Array {length = l, elt = e, ...},
+                             Vector {length = l', elt = e', ...}) =>
+                               (unify (l, l'); unifySlot (e, e'))
+                           | _ => Error.bug "Useless.primApp: Array_toVector")
+                   | Array_update => update ()
+                   | MLton_equal => Vector.foreach (args, deepMakeUseful)
+                   | Ref_assign => coerce {from = arg 1, to = deref (arg 0)}
+                   | Ref_deref => return (deref (arg 0))
+                   | Ref_ref => coerce {from = arg 0, to = deref result}
+                   | Vector_length => return (vectorLength (arg 0))
+                   | Vector_sub => (arg 1 dependsOn result
+                                    ; return (devector (arg 0)))
+                   | Weak_get => return (deweak (arg 0))
+                   | Weak_new => coerce {from = arg 0, to = deweak result}
+                   | Word8Array_subWord => sub ()
+                   | Word8Array_updateWord => update ()
+                   | _ =>
+                        let (* allOrNothing so the type doesn't change *)
+                           val res = allOrNothing result
+                        in if Prim.maySideEffect prim
+                              then Vector.foreach (args, deepMakeUseful)
+                           else
+                              Vector.foreach (args, fn a =>
+                                              case (allOrNothing a, res) of
+                                                 (NONE, _) => ()
+                                               | (SOME u, SOME u') =>
+                                                    Useful.<= (u', u)
+                                               | _ => ())
+                        end
+            in
+               result
+            end
+         val primApp =
+            Trace.trace
+            ("Useless.primApp",
+             fn {prim, args, ...} =>
+             Layout.seq [Prim.layout prim,
+                         Vector.layout layout args],
+             layout)
+            primApp
       end
       val {value, func, label, ...} =
-	 analyze {
-		  coerce = Value.coerce,
-		  conApp = conApp,
-		  const = Value.const,
-		  filter = filter,
-		  filterWord = filterGround o #1,
-		  fromType = Value.fromType,
-		  layout = Value.layout,
-		  primApp = primApp,
-		  program = program,
-		  select = Value.select,
-		  tuple = Value.tuple,
-		  useFromTypeOnBinds = true
-		  }
+         analyze {
+                  coerce = Value.coerce,
+                  conApp = conApp,
+                  const = Value.const,
+                  filter = filter,
+                  filterWord = filterGround o #1,
+                  fromType = Value.fromType,
+                  layout = Value.layout,
+                  primApp = primApp,
+                  program = program,
+                  select = Value.select,
+                  tuple = Value.tuple,
+                  useFromTypeOnBinds = true
+                  }
       open Exp Transfer
       (* Unify all handler args so that raise/handle has a consistent calling
        * convention.
        *)
       val _ =
-	 List.foreach
-	 (functions, fn f =>
-	  let
-	     val {raises = fraisevs, ...} = func (Function.name f)
-	     fun coerce (x, y) = Value.coerce {from = x, to = y}
-	  in
-	     Vector.foreach
-	     (Function.blocks f, fn Block.T {transfer, ...} =>
-	      case transfer of
-		 Call {func = g, return, ...} =>
-		    let
-		       val {raises = graisevs, ...} = func g
-		       fun coerceRaise () =
-			  case (graisevs, fraisevs) of
-			     (NONE, NONE) => ()
-			   | (NONE, SOME _) => ()
-			   | (SOME _, NONE) =>
-				Error.bug "raise mismatch at Caller"
-			   | (SOME vs, SOME vs') =>
-				Vector.foreach2 (vs', vs, coerce)
-		    in
-		      case return of
-		         Return.Dead => ()
-		       | Return.NonTail {handler, ...} =>
-			    (case handler of
-				Handler.Caller => coerceRaise ()
-			      | Handler.Dead => ()
-			      | Handler.Handle h =>
-				   Option.app
-				   (graisevs, fn graisevs =>
-				    Vector.foreach2 
-				    (label h, graisevs, coerce)))
-		       | Return.Tail => coerceRaise ()
-		    end
-	       | _ => ())
-	  end)
+         List.foreach
+         (functions, fn f =>
+          let
+             val {raises = fraisevs, ...} = func (Function.name f)
+             fun coerce (x, y) = Value.coerce {from = x, to = y}
+          in
+             Vector.foreach
+             (Function.blocks f, fn Block.T {transfer, ...} =>
+              case transfer of
+                 Call {func = g, return, ...} =>
+                    let
+                       val {raises = graisevs, ...} = func g
+                       fun coerceRaise () =
+                          case (graisevs, fraisevs) of
+                             (NONE, NONE) => ()
+                           | (NONE, SOME _) => ()
+                           | (SOME _, NONE) =>
+                                Error.bug "Useless.useless: raise mismatch at Caller"
+                           | (SOME vs, SOME vs') =>
+                                Vector.foreach2 (vs', vs, coerce)
+                    in
+                      case return of
+                         Return.Dead => ()
+                       | Return.NonTail {handler, ...} =>
+                            (case handler of
+                                Handler.Caller => coerceRaise ()
+                              | Handler.Dead => ()
+                              | Handler.Handle h =>
+                                   Option.app
+                                   (graisevs, fn graisevs =>
+                                    Vector.foreach2 
+                                    (label h, graisevs, coerce)))
+                       | Return.Tail => coerceRaise ()
+                    end
+               | _ => ())
+          end)
       val _ =
-	 Control.diagnostics
-	 (fn display =>
-	  let
-	     open Layout
-	     val _ =
-		Vector.foreach
-		(datatypes, fn Datatype.T {tycon, cons} =>
-		 display
-		 (align
-		  [Tycon.layout tycon,
-		   indent (Vector.layout
-			   (fn {con, ...} =>
-			    seq [Con.layout con, str " ",
-				 Vector.layout Value.layout (conArgs con)])
-			   cons,
-			   2)]))
-	     val _ =
-		List.foreach
-		(functions, fn f =>
-		 let
-		    val {name, ...} = Function.dest f
-		    val _ = display (seq [str "Useless info for ",
-					  Func.layout name])
-		    val {args, returns, raises} = func name
-		    val _ =
-		       display
-		       (record [("args", Vector.layout Value.layout args),
-				("returns",
-				 Option.layout (Vector.layout Value.layout)
-				 returns),
-				("raises", 
-				 Option.layout (Vector.layout Value.layout)
-				 raises)])
-		    val _ =
-		       Function.foreachVar
-		       (f, fn (x, _) => 
-			display (seq [Var.layout x,
-				      str " ", Value.layout (value x)]))
-		 in
-		    ()
-		 end)
-	  in
-	     ()
-	  end)
+         Control.diagnostics
+         (fn display =>
+          let
+             open Layout
+             val _ =
+                Vector.foreach
+                (datatypes, fn Datatype.T {tycon, cons} =>
+                 display
+                 (align
+                  [Tycon.layout tycon,
+                   indent (Vector.layout
+                           (fn {con, ...} =>
+                            seq [Con.layout con, str " ",
+                                 Vector.layout Value.layout (conArgs con)])
+                           cons,
+                           2)]))
+             val _ =
+                List.foreach
+                (functions, fn f =>
+                 let
+                    val {name, ...} = Function.dest f
+                    val _ = display (seq [str "Useless info for ",
+                                          Func.layout name])
+                    val {args, returns, raises} = func name
+                    val _ =
+                       display
+                       (record [("args", Vector.layout Value.layout args),
+                                ("returns",
+                                 Option.layout (Vector.layout Value.layout)
+                                 returns),
+                                ("raises", 
+                                 Option.layout (Vector.layout Value.layout)
+                                 raises)])
+                    val _ =
+                       Function.foreachVar
+                       (f, fn (x, _) => 
+                        display (seq [Var.layout x,
+                                      str " ", Value.layout (value x)]))
+                 in
+                    ()
+                 end)
+          in
+             ()
+          end)
       val varExists = Value.isUseful o value
       val unitVar = Var.newString "unit"
       val bogusGlobals: Statement.t list ref = ref []
       val {get = bogus, ...} =
-	 Property.get
-	 (Type.plist,
-	  Property.initFun
-	  (fn ty =>
-	   let val var = Var.newString "bogus"
-	   in List.push (bogusGlobals,
-			 Statement.T
-			 {var = SOME var, 
-			  ty = ty,
-			  exp = PrimApp {prim = Prim.bogus,
-					 targs = Vector.new1 ty,
-					 args = Vector.new0 ()}})
-	      ; var
-	   end))
+         Property.get
+         (Type.plist,
+          Property.initFun
+          (fn ty =>
+           let val var = Var.newString "bogus"
+           in List.push (bogusGlobals,
+                         Statement.T
+                         {var = SOME var, 
+                          ty = ty,
+                          exp = PrimApp {prim = Prim.bogus,
+                                         targs = Vector.new1 ty,
+                                         args = Vector.new0 ()}})
+              ; var
+           end))
       fun keepUseful (xs: Var.t vector, vs: Value.t vector): Var.t vector =
-	 Vector.keepAllMap2
-	 (xs, vs, fn (x, v) =>
-	  let val (t, b) = Value.getNew v
-	  in if b
-		then SOME (if varExists x then x else bogus t)
-	     else NONE
-	  end)
+         Vector.keepAllMap2
+         (xs, vs, fn (x, v) =>
+          let val (t, b) = Value.getNew v
+          in if b
+                then SOME (if varExists x then x else bogus t)
+             else NONE
+          end)
       fun keepUsefulArgs (xts: (Var.t * Type.t) vector) =
-	 Vector.keepAllMap
-	 (xts, fn (x, _) =>
-	  let val (t, b) = Value.getNew (value x)
-	  in if b
-		then SOME (x, t)
-	     else NONE
-	  end)
+         Vector.keepAllMap
+         (xts, fn (x, _) =>
+          let val (t, b) = Value.getNew (value x)
+          in if b
+                then SOME (x, t)
+             else NONE
+          end)
       val keepUsefulArgs =
-	 Trace.trace ("keepUsefulArgs",
-		      Vector.layout (Layout.tuple2 (Var.layout, Type.layout)),
-		      Vector.layout (Layout.tuple2 (Var.layout, Type.layout)))
-	 keepUsefulArgs
+         Trace.trace ("Useless.keepUsefulArgs",
+                      Vector.layout (Layout.tuple2 (Var.layout, Type.layout)),
+                      Vector.layout (Layout.tuple2 (Var.layout, Type.layout)))
+         keepUsefulArgs
       fun dropUseless (vs: Value.t vector,
-		       vs': Value.t vector,
-		       makeTrans: Var.t vector -> Transfer.t): Label.t * Block.t =
-	 let
-	    val l = Label.newNoname ()
-	    val (formals, actuals) =
-	       Vector.unzip
-	       (Vector.map2
-		(vs, vs', fn (v, v') =>
-		 if Value.isUseful v
-		   then let val x = Var.newNoname ()
-			in (SOME (x, Value.newType v),
-			    if Value.isUseful v'
-			       then SOME x
-			    else NONE)
-			end
-		 else (NONE, NONE)))
-	 in (l, Block.T {label = l,
-			 args = Vector.keepAllSome formals,
-			 statements = Vector.new0 (),
-			 transfer = makeTrans (Vector.keepAllSome actuals)})
-	 end
+                       vs': Value.t vector,
+                       makeTrans: Var.t vector -> Transfer.t): Label.t * Block.t =
+         let
+            val l = Label.newNoname ()
+            val (formals, actuals) =
+               Vector.unzip
+               (Vector.map2
+                (vs, vs', fn (v, v') =>
+                 if Value.isUseful v
+                   then let val x = Var.newNoname ()
+                        in (SOME (x, Value.newType v),
+                            if Value.isUseful v'
+                               then SOME x
+                            else NONE)
+                        end
+                 else (NONE, NONE)))
+         in (l, Block.T {label = l,
+                         args = Vector.keepAllSome formals,
+                         statements = Vector.new0 (),
+                         transfer = makeTrans (Vector.keepAllSome actuals)})
+         end
       (* Returns true if the component is the only component of the tuple
        * that exists.
        *)
       fun newOffset (bs: bool vector, n: int): int * bool =
-	 let
-	    val len = Vector.length bs
-	    fun loop (pos, n, i) =
-	       let val b = Vector.sub (bs, pos)
-	       in if n = 0
-		     then (i, (i = 0
-			       andalso not (Int.exists (pos + 1, len, fn i =>
-							Vector.sub (bs, i)))))
-		  else loop (pos + 1, n - 1, if b then i + 1 else i)
-	       end
-	 in loop (0, n, 0)
-	 end
+         let
+            val len = Vector.length bs
+            fun loop (pos, n, i) =
+               let val b = Vector.sub (bs, pos)
+               in if n = 0
+                     then (i, (i = 0
+                               andalso not (Int.exists (pos + 1, len, fn i =>
+                                                        Vector.sub (bs, i)))))
+                  else loop (pos + 1, n - 1, if b then i + 1 else i)
+               end
+         in loop (0, n, 0)
+         end
 
       fun doitExp (e: Exp.t, resultType: Type.t, resultValue: Value.t option) =
-	 case e of
-	    ConApp {con, args} =>
-	       ConApp {con = con,
-		       args = keepUseful (args, conArgs con)}
-	  | Const _ => e
-	  | PrimApp {prim, args, ...} => 
-	       let
-		  val (args, argTypes) =
-		     Vector.unzip
-		     (Vector.map (args, fn x =>
-				  let val (t, b) = Value.getNew (value x)
-				  in if b then (x, t)
-				     else (unitVar, Type.unit)
-				  end))
-	       in
-		  PrimApp
-		  {prim = prim,
-		   args = args,
-		   targs = Prim.extractTargs (prim,
-					      {args = argTypes,
-					       result = resultType,
-					       deArray = Type.deArray,
-					       deArrow = Type.deArrow,
-					       deVector = Type.deVector,
-					       deWeak = Type.deWeak})}
-	       end
-	  | Select {tuple, offset} =>
-	       let
-		  val (offset, isOne) =
-		     newOffset (Vector.map (Value.detupleSlots (value tuple),
-					    Exists.doesExist o #2),
-				offset)
-	       in if isOne
-		     then Var tuple
-		  else Select {tuple = tuple,
-			       offset = offset}
-	       end
-	  | Tuple xs =>
-	       let
-		  val slots = Value.detupleSlots (valOf resultValue)
-		  val xs =
-		     Vector.keepAllMap2
-		     (xs, slots, fn (x, (v, e)) =>
-		      if Exists.doesExist e
-			 then SOME (if varExists x then x
-				    else bogus (Value.newType v))
-		      else NONE)
-	       in
-		  if 1 = Vector.length xs
-		     then Var (Vector.sub (xs, 0))
-		  else Tuple xs
-	       end
-	  | Var _ => e
-	  | _ => e
+         case e of
+            ConApp {con, args} =>
+               ConApp {con = con,
+                       args = keepUseful (args, conArgs con)}
+          | Const _ => e
+          | PrimApp {prim, args, ...} => 
+               let
+                  val (args, argTypes) =
+                     Vector.unzip
+                     (Vector.map (args, fn x =>
+                                  let val (t, b) = Value.getNew (value x)
+                                  in if b then (x, t)
+                                     else (unitVar, Type.unit)
+                                  end))
+               in
+                  PrimApp
+                  {prim = prim,
+                   args = args,
+                   targs = Prim.extractTargs (prim,
+                                              {args = argTypes,
+                                               result = resultType,
+                                               deArray = Type.deArray,
+                                               deArrow = Type.deArrow,
+                                               deVector = Type.deVector,
+                                               deWeak = Type.deWeak})}
+               end
+          | Select {tuple, offset} =>
+               let
+                  val (offset, isOne) =
+                     newOffset (Vector.map (Value.detupleSlots (value tuple),
+                                            Exists.doesExist o #2),
+                                offset)
+               in if isOne
+                     then Var tuple
+                  else Select {tuple = tuple,
+                               offset = offset}
+               end
+          | Tuple xs =>
+               let
+                  val slots = Value.detupleSlots (valOf resultValue)
+                  val xs =
+                     Vector.keepAllMap2
+                     (xs, slots, fn (x, (v, e)) =>
+                      if Exists.doesExist e
+                         then SOME (if varExists x then x
+                                    else bogus (Value.newType v))
+                      else NONE)
+               in
+                  if 1 = Vector.length xs
+                     then Var (Vector.sub (xs, 0))
+                  else Tuple xs
+               end
+          | Var _ => e
+          | _ => e
       val doitExp =
- 	 Trace.trace3 ("Useless.doitExp",
-		       Exp.layout, Layout.ignore, Layout.ignore,
-		       Exp.layout) 
-	 doitExp
+         Trace.trace3 ("Useless.doitExp",
+                       Exp.layout, Layout.ignore, Layout.ignore,
+                       Exp.layout) 
+         doitExp
       fun doitStatement (Statement.T {var, exp, ty}) =
-	 let
-	    val v = Option.map (var, value)
-	    val (ty, b) =
-	       case v of
-		  NONE => (ty, false)
-		| SOME v => Value.getNew v
-	    fun yes ty =
-	       SOME (Statement.T 
-		     {var = var, 
-		      ty = ty, 
-		      exp = doitExp (exp, ty, v)})
-	 in
-	    if b
-	       then yes ty
-	    else
-	       case exp of
-		  PrimApp {prim, args, ...} =>
-		     if Prim.maySideEffect prim
-			andalso let
-				   fun arg i = Vector.sub (args, i)
-				   fun array () =
-				      Value.isUseful
-				      (Value.dearray (value (arg 0)))
-				   datatype z = datatype Prim.Name.t
-				in case Prim.name prim of
-				   Array_update => array ()
-				 | Ref_assign =>
-				      Value.isUseful 
-				      (Value.deref (value (arg 0)))
-				 | Word8Array_updateWord => array ()
-				 | _ => true
-				end
-			then yes ty
-		     else NONE
-		| Profile _ => yes ty
-		| _ => NONE
-	 end
+         let
+            val v = Option.map (var, value)
+            val (ty, b) =
+               case v of
+                  NONE => (ty, false)
+                | SOME v => Value.getNew v
+            fun yes ty =
+               SOME (Statement.T 
+                     {var = var, 
+                      ty = ty, 
+                      exp = doitExp (exp, ty, v)})
+         in
+            if b
+               then yes ty
+            else
+               case exp of
+                  PrimApp {prim, args, ...} =>
+                     if Prim.maySideEffect prim
+                        andalso let
+                                   fun arg i = Vector.sub (args, i)
+                                   fun array () =
+                                      Value.isUseful
+                                      (Value.dearray (value (arg 0)))
+                                   datatype z = datatype Prim.Name.t
+                                in case Prim.name prim of
+                                   Array_update => array ()
+                                 | Ref_assign =>
+                                      Value.isUseful 
+                                      (Value.deref (value (arg 0)))
+                                 | Word8Array_updateWord => array ()
+                                 | _ => true
+                                end
+                        then yes ty
+                     else NONE
+                | Profile _ => yes ty
+                | _ => NONE
+         end
       val doitStatement =
-	 Trace.trace ("Useless.doitStatement", 
-		      Statement.layout, Option.layout Statement.layout)
-	 doitStatement
+         Trace.trace ("Useless.doitStatement", 
+                      Statement.layout, Option.layout Statement.layout)
+         doitStatement
       fun agree (v: Value.t, v': Value.t): bool =
-	 Value.isUseful v = Value.isUseful v'
+         Value.isUseful v = Value.isUseful v'
       fun agrees (vs, vs') = Vector.forall2 (vs, vs', agree)
       val agrees =
-	 Trace.trace2 ("Useless.agrees",
-		       Vector.layout Value.layout,
-		       Vector.layout Value.layout,
-		       Bool.layout)
-	 agrees
+         Trace.trace2 ("Useless.agrees",
+                       Vector.layout Value.layout,
+                       Vector.layout Value.layout,
+                       Bool.layout)
+         agrees
       fun doitTransfer (t: Transfer.t, 
-			returns: Value.t vector option,
-			raises: Value.t vector option)
-	 : Block.t list * Transfer.t =
-	 case t of
-	    Arith {prim, args, overflow, success, ty} =>
-	       let
-		  val v = Value.fromType ty
-		  val _ = Value.Useful.makeUseful (Value.deground v)
-		  val res = Vector.new1 v
-		  val sargs = label success
-	       in
-		  if agree (v, Vector.sub (sargs, 0))
-		     then ([], t)
-		  else let
-		          val (l, b) = dropUseless
-			               (res, sargs, fn args =>
-					Goto {dst = success, args = args})
-		       in
-			  ([b],
-			   Arith {prim = prim,
-				  args = args,
-				  overflow = overflow,
-				  success = l,
-				  ty = ty})
-		       end
-	       end
-	  | Bug => ([], Bug)
-	  | Call {func = f, args, return} =>
-	       let
-		  val {args = fargs, returns = freturns, ...} = func f
-		  val (blocks, return) =
-		     case return of
-			Return.Dead => ([], return)
-		      | Return.Tail =>
-			   (case (returns, freturns) of
-			       (NONE, NONE) => ([], Return.Tail)
-			     | (NONE, SOME _) => Error.bug "return mismatch"
-			     | (SOME _, NONE) => ([], Return.Tail)
-			     | (SOME returns, SOME freturns) =>
-				  if agrees (freturns, returns)
-				     then ([], Return.Tail)
-				  else
-				     let
-					val (l, b) =
-					   dropUseless
-					   (freturns, returns, Return)
-				     in ([b],
-					 Return.NonTail
-					 {cont = l,
-					  handler = Handler.Caller})
-				     end)
-		      | Return.NonTail {cont, handler} =>
-			   (case freturns of
-			       NONE => ([], return)
-			     | SOME freturns => 
-				  let val returns = label cont
-				  in if agrees (freturns, returns)
-					then ([], return)
-				     else let
-					     val (l, b) =
-						dropUseless
-						(freturns, returns, fn args =>
-						 Goto {dst = cont, args = args})
-					  in ([b],
-					      Return.NonTail
-					      {cont = l, handler = handler})
-					  end
-				  end)
-	       in (blocks,
-		   Call {func = f, 
-			 args = keepUseful (args, fargs), 
-			 return = return})
-	       end
-	  | Case {test, cases, default} => 
-	       let
-		  datatype z = datatype Cases.t
-	       in
-		  case cases of
-		     Con cases =>
-			(case (Vector.length cases, default) of
-			    (0, NONE) => ([], Bug)
-			  | _ => 
-			       let
-				  val (cases, blocks) =
-				     Vector.mapAndFold
-				     (cases, [], fn ((c, l), blocks) =>
-				      let
-					 val args = label l
-				      in if Vector.forall (args, Value.isUseful)
-					    then ((c, l), blocks)
-					 else
-					    let
-					       val (l', b) =
-						  dropUseless
-						  (conArgs c, args, fn args =>
-						   Goto {dst = l, args = args})
-					    in ((c, l'), b :: blocks)
-					    end
-				      end)
-			       in (blocks, 
-				   Case {test = test, 
-					 cases = Cases.Con cases,
-					 default = default})
-			       end)
-		   | Word (_, cs) =>
-			(* The test may be useless if there are no cases or
-			 * default, thus we must eliminate the case.
-			 *)
-			case (Vector.length cs, default) of
-			   (0, NONE) => ([], Bug)
-			 | _ => ([], t)
-	       end
-	  | Goto {dst, args} =>
-	       ([], Goto {dst = dst, args = keepUseful (args, label dst)})
-	  | Raise xs => ([], Raise (keepUseful (xs, valOf raises)))
-	  | Return xs => ([], Return (keepUseful (xs, valOf returns)))
-	  | Runtime {prim, args, return} =>
-	       ([], Runtime {prim = prim, args = args, return = return})
+                        returns: Value.t vector option,
+                        raises: Value.t vector option)
+         : Block.t list * Transfer.t =
+         case t of
+            Arith {prim, args, overflow, success, ty} =>
+               let
+                  val v = Value.fromType ty
+                  val _ = Value.Useful.makeUseful (Value.deground v)
+                  val res = Vector.new1 v
+                  val sargs = label success
+               in
+                  if agree (v, Vector.sub (sargs, 0))
+                     then ([], t)
+                  else let
+                          val (l, b) = dropUseless
+                                       (res, sargs, fn args =>
+                                        Goto {dst = success, args = args})
+                       in
+                          ([b],
+                           Arith {prim = prim,
+                                  args = args,
+                                  overflow = overflow,
+                                  success = l,
+                                  ty = ty})
+                       end
+               end
+          | Bug => ([], Bug)
+          | Call {func = f, args, return} =>
+               let
+                  val {args = fargs, returns = freturns, ...} = func f
+                  val (blocks, return) =
+                     case return of
+                        Return.Dead => ([], return)
+                      | Return.Tail =>
+                           (case (returns, freturns) of
+                               (NONE, NONE) => ([], Return.Tail)
+                             | (NONE, SOME _) => Error.bug "Useless.doitTransfer: return mismatch"
+                             | (SOME _, NONE) => ([], Return.Tail)
+                             | (SOME returns, SOME freturns) =>
+                                  if agrees (freturns, returns)
+                                     then ([], Return.Tail)
+                                  else
+                                     let
+                                        val (l, b) =
+                                           dropUseless
+                                           (freturns, returns, Return)
+                                     in ([b],
+                                         Return.NonTail
+                                         {cont = l,
+                                          handler = Handler.Caller})
+                                     end)
+                      | Return.NonTail {cont, handler} =>
+                           (case freturns of
+                               NONE => ([], return)
+                             | SOME freturns => 
+                                  let val returns = label cont
+                                  in if agrees (freturns, returns)
+                                        then ([], return)
+                                     else let
+                                             val (l, b) =
+                                                dropUseless
+                                                (freturns, returns, fn args =>
+                                                 Goto {dst = cont, args = args})
+                                          in ([b],
+                                              Return.NonTail
+                                              {cont = l, handler = handler})
+                                          end
+                                  end)
+               in (blocks,
+                   Call {func = f, 
+                         args = keepUseful (args, fargs), 
+                         return = return})
+               end
+          | Case {test, cases, default} => 
+               let
+                  datatype z = datatype Cases.t
+               in
+                  case cases of
+                     Con cases =>
+                        (case (Vector.length cases, default) of
+                            (0, NONE) => ([], Bug)
+                          | _ => 
+                               let
+                                  val (cases, blocks) =
+                                     Vector.mapAndFold
+                                     (cases, [], fn ((c, l), blocks) =>
+                                      let
+                                         val args = label l
+                                      in if Vector.forall (args, Value.isUseful)
+                                            then ((c, l), blocks)
+                                         else
+                                            let
+                                               val (l', b) =
+                                                  dropUseless
+                                                  (conArgs c, args, fn args =>
+                                                   Goto {dst = l, args = args})
+                                            in ((c, l'), b :: blocks)
+                                            end
+                                      end)
+                               in (blocks, 
+                                   Case {test = test, 
+                                         cases = Cases.Con cases,
+                                         default = default})
+                               end)
+                   | Word (_, cs) =>
+                        (* The test may be useless if there are no cases or
+                         * default, thus we must eliminate the case.
+                         *)
+                        case (Vector.length cs, default) of
+                           (0, NONE) => ([], Bug)
+                         | _ => ([], t)
+               end
+          | Goto {dst, args} =>
+               ([], Goto {dst = dst, args = keepUseful (args, label dst)})
+          | Raise xs => ([], Raise (keepUseful (xs, valOf raises)))
+          | Return xs => ([], Return (keepUseful (xs, valOf returns)))
+          | Runtime {prim, args, return} =>
+               ([], Runtime {prim = prim, args = args, return = return})
       val doitTransfer =
-	 Trace.trace3 ("Useless.doitTransfer",
-		       Transfer.layout,
-		       Option.layout (Vector.layout Value.layout),
-		       Option.layout (Vector.layout Value.layout),
-		       Layout.tuple2 (List.layout (Label.layout o Block.label), 
-				      Transfer.layout))
-	 doitTransfer
+         Trace.trace3 ("Useless.doitTransfer",
+                       Transfer.layout,
+                       Option.layout (Vector.layout Value.layout),
+                       Option.layout (Vector.layout Value.layout),
+                       Layout.tuple2 (List.layout (Label.layout o Block.label), 
+                                      Transfer.layout))
+         doitTransfer
       fun doitBlock (Block.T {label, args, statements, transfer},
-		     returns: Value.t vector option,
-		     raises: Value.t vector option)
-	 : Block.t list * Block.t =
-	 let
-	    val args = keepUsefulArgs args
-	    val statements = Vector.keepAllMap (statements, doitStatement)
-	    val (blocks, transfer) = doitTransfer (transfer, returns, raises)
-	 in
-	   (blocks, Block.T {label = label,
-			     args = args,
-			     statements = statements,
-			     transfer = transfer})
-	 end
+                     returns: Value.t vector option,
+                     raises: Value.t vector option)
+         : Block.t list * Block.t =
+         let
+            val args = keepUsefulArgs args
+            val statements = Vector.keepAllMap (statements, doitStatement)
+            val (blocks, transfer) = doitTransfer (transfer, returns, raises)
+         in
+           (blocks, Block.T {label = label,
+                             args = args,
+                             statements = statements,
+                             transfer = transfer})
+         end
       val doitBlock =
-	 Trace.trace3 ("Useless.doitBlock",
-		       Label.layout o Block.label,
-		       Option.layout (Vector.layout Value.layout),
-		       Option.layout (Vector.layout Value.layout),
-		       Layout.tuple2 (List.layout (Label.layout o Block.label), 
-				      (Label.layout o Block.label)))
-	 doitBlock
+         Trace.trace3 ("Useless.doitBlock",
+                       Label.layout o Block.label,
+                       Option.layout (Vector.layout Value.layout),
+                       Option.layout (Vector.layout Value.layout),
+                       Layout.tuple2 (List.layout (Label.layout o Block.label), 
+                                      (Label.layout o Block.label)))
+         doitBlock
       fun doitFunction f =
-	 let
-	    val {args, blocks, mayInline, name, start, ...} = Function.dest f
-	    val {returns = returnvs, raises = raisevs, ...} = func name
-	    val args = keepUsefulArgs args
-	    val (blocks, blocks') =
-	       Vector.mapAndFold
-	       (blocks, [], fn (block, blocks') =>
-		let val (blocks'', block) = doitBlock (block, returnvs, raisevs)
-		in (block, blocks''::blocks')
-		end)
-	    val blocks =
-	       Vector.concat (blocks :: List.map (blocks', Vector.fromList))
-	    val returns = Option.map (returnvs, Value.newTypes)
-	    val raises = Option.map (raisevs, Value.newTypes)
-	 in
-	    Function.new {args = args,
-			  blocks = blocks,
-			  mayInline = mayInline,
-			  name = name,
-			  raises = raises,
-			  returns = returns,
-			  start = start}
-	 end
+         let
+            val {args, blocks, mayInline, name, start, ...} = Function.dest f
+            val {returns = returnvs, raises = raisevs, ...} = func name
+            val args = keepUsefulArgs args
+            val (blocks, blocks') =
+               Vector.mapAndFold
+               (blocks, [], fn (block, blocks') =>
+                let val (blocks'', block) = doitBlock (block, returnvs, raisevs)
+                in (block, blocks''::blocks')
+                end)
+            val blocks =
+               Vector.concat (blocks :: List.map (blocks', Vector.fromList))
+            val returns = Option.map (returnvs, Value.newTypes)
+            val raises = Option.map (raisevs, Value.newTypes)
+         in
+            Function.new {args = args,
+                          blocks = blocks,
+                          mayInline = mayInline,
+                          name = name,
+                          raises = raises,
+                          returns = returns,
+                          start = start}
+         end
       val datatypes =
-	 Vector.map
-	 (datatypes, fn Datatype.T {tycon, cons} =>
-	  Datatype.T {tycon = tycon,
-		      cons = Vector.map (cons, fn {con, ...} =>
-					 {con = con,
-					  args = Value.newTypes (conArgs con)})})
+         Vector.map
+         (datatypes, fn Datatype.T {tycon, cons} =>
+          Datatype.T {tycon = tycon,
+                      cons = Vector.map (cons, fn {con, ...} =>
+                                         {con = con,
+                                          args = Value.newTypes (conArgs con)})})
       val globals =
-	 Vector.concat
-	 [Vector.new1 (Statement.T {var = SOME unitVar,
-				    ty = Type.unit,
-				    exp = Exp.unit}),
-	  Vector.keepAllMap (globals, doitStatement)]
+         Vector.concat
+         [Vector.new1 (Statement.T {var = SOME unitVar,
+                                    ty = Type.unit,
+                                    exp = Exp.unit}),
+          Vector.keepAllMap (globals, doitStatement)]
       val shrink = shrinkFunction {globals = globals}
       val functions = List.map (functions, shrink o doitFunction)
       val globals = Vector.concat [Vector.fromList (!bogusGlobals),
-				   globals]
+                                   globals]
       val program = Program.T {datatypes = datatypes,
-			       globals = globals,
-			       functions = functions,
-			       main = main}
+                               globals = globals,
+                               functions = functions,
+                               main = main}
       val _ = Program.clearTop program
    in
       program

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ssa/useless.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ssa/useless.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ssa/useless.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature USELESS_STRUCTS = 
    sig
       include SHRINK

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ssa/zone.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ssa/zone.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ssa/zone.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,8 +1,8 @@
-(* Copyright (C) 2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 2004-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 functor Zone (S: ZONE_STRUCTS): ZONE = 
@@ -27,242 +27,242 @@
       datatype z = datatype Exp.t
       datatype z = datatype Statement.t
       val {get = labelInfo: Label.t -> {isInLoop: bool ref,
-					isCut: bool ref}, ...} =
-	 Property.get (Label.plist,
-		       Property.initFun (fn _ => {isCut = ref false,
-						  isInLoop = ref false}))
+                                        isCut: bool ref}, ...} =
+         Property.get (Label.plist,
+                       Property.initFun (fn _ => {isCut = ref false,
+                                                  isInLoop = ref false}))
       (* Mark nodes that are in loops so that we can avoid inserting tuple
        * constructions there.
        *)
       val {graph, nodeBlock, ...} = Function.controlFlow f
       val () =
-	 List.foreach
-	 (Graph.stronglyConnectedComponents graph, fn ns =>
-	  let
-	     fun doit () =
-		List.foreach
-		(ns, fn n =>
-		 #isInLoop (labelInfo (Block.label (nodeBlock n))) := true)
-	  in
-	     case ns of
-		[n] => if Node.hasEdge {from = n, to = n}
-			  then doit ()
-		       else ()
-	      | _ => doit ()
-	  end)
+         List.foreach
+         (Graph.stronglyConnectedComponents graph, fn ns =>
+          let
+             fun doit () =
+                List.foreach
+                (ns, fn n =>
+                 #isInLoop (labelInfo (Block.label (nodeBlock n))) := true)
+          in
+             case ns of
+                [n] => if Node.hasEdge {from = n, to = n}
+                          then doit ()
+                       else ()
+              | _ => doit ()
+          end)
       val dominatorTree = Function.dominatorTree f
       (* Decide which labels to cut at. *)
       val cutDepth = !Control.zoneCutDepth
       fun addCuts (Tree.T (b, ts), depth: int) =
-	 let
-	    val depth =
-	       if depth = 0
-		  then
-		     let
-			val Block.T {label, ...} = b
-			val {isCut, isInLoop, ...} = labelInfo label
-			val () =
-			   if !isInLoop
-			      then
-				 Control.diagnostic
-				 (fn () =>
-				  let
-				     open Layout
-				  in
-				     seq [str "skipping cut at ",
-					  Label.layout label]
-				  end)
-			   else isCut := true
-		     in
-			cutDepth
-		     end
-	       else depth - 1
-	 in
-	    Vector.foreach (ts, fn t => addCuts (t, depth))
-	 end
+         let
+            val depth =
+               if depth = 0
+                  then
+                     let
+                        val Block.T {label, ...} = b
+                        val {isCut, isInLoop, ...} = labelInfo label
+                        val () =
+                           if !isInLoop
+                              then
+                                 Control.diagnostic
+                                 (fn () =>
+                                  let
+                                     open Layout
+                                  in
+                                     seq [str "skipping cut at ",
+                                          Label.layout label]
+                                  end)
+                           else isCut := true
+                     in
+                        cutDepth
+                     end
+               else depth - 1
+         in
+            Vector.foreach (ts, fn t => addCuts (t, depth))
+         end
       val () = addCuts (dominatorTree, cutDepth)
       (* Build a tuple of lives at each cut node. *)
       type info = {componentsRev: Var.t list ref,
-		   numComponents: int ref,
-		   scope: Scope.t,
-		   tuple: Var.t}
+                   numComponents: int ref,
+                   scope: Scope.t,
+                   tuple: Var.t}
       fun newInfo () =
-	 {componentsRev = ref [],
-	  numComponents = ref 0,
-	  scope = Scope.new (),
-	  tuple = Var.newNoname ()}
+         {componentsRev = ref [],
+          numComponents = ref 0,
+          scope = Scope.new (),
+          tuple = Var.newNoname ()}
       datatype varInfo =
-	 Global
-	| Local of {blockCache: Var.t option ref,
-		    defScope: Scope.t,
-		    ty: Type.t,
-		    uses: {exp: Exp.t,
-			   scope: Scope.t} list ref}
+         Global
+        | Local of {blockCache: Var.t option ref,
+                    defScope: Scope.t,
+                    ty: Type.t,
+                    uses: {exp: Exp.t,
+                           scope: Scope.t} list ref}
       val {get = varInfo: Var.t -> varInfo,
-	   set = setVarInfo, ...} =
-	 Property.getSetOnce (Var.plist,
-			      Property.initFun (fn _ => Global))
+           set = setVarInfo, ...} =
+         Property.getSetOnce (Var.plist,
+                              Property.initFun (fn _ => Global))
       val blockSelects: {blockCache: Var.t option ref,
-			 statement: Statement.t} list ref = ref []
+                         statement: Statement.t} list ref = ref []
       fun addBlockSelects (ss: Statement.t vector): Statement.t vector =
-	 let
-	    val blockSelectsV = Vector.fromList (!blockSelects)
-	    val () = Vector.foreach (blockSelectsV, fn {blockCache, ...} =>
-				     blockCache := NONE)
-	    val () = blockSelects := []
-	 in
-	    Vector.concat [Vector.map (blockSelectsV, #statement), ss]
-	 end
+         let
+            val blockSelectsV = Vector.fromList (!blockSelects)
+            val () = Vector.foreach (blockSelectsV, fn {blockCache, ...} =>
+                                     blockCache := NONE)
+            val () = blockSelects := []
+         in
+            Vector.concat [Vector.map (blockSelectsV, #statement), ss]
+         end
       fun define (x: Var.t, ty: Type.t, info: info): unit =
-	 setVarInfo (x, Local {blockCache = ref NONE,
-			       defScope = #scope info,
-			       ty = ty,
-			       uses = ref []})
+         setVarInfo (x, Local {blockCache = ref NONE,
+                               defScope = #scope info,
+                               ty = ty,
+                               uses = ref []})
       fun replaceVar (x: Var.t,
-		      {componentsRev, numComponents, scope, tuple}: info)
-	 : Var.t =
-	 case varInfo x of
-	    Global => x
-	  | Local {blockCache, defScope, ty, uses, ...} =>
-	       case !blockCache of
-		  SOME y => y
-		| _ => 
-		     if Scope.equals (defScope, scope)
-			then x
-		     else
-			let
-			   fun new () =
-			      let
-				 val offset = !numComponents
-				 val () = List.push (componentsRev, x)
-				 val () = numComponents := 1 + offset
-				 val exp = Select {base = Base.Object tuple,
-						   offset = offset}
-				 val () = List.push (uses, {exp = exp,
-							    scope = scope})
-			      in
-				 exp
-			      end
-			   val exp =
-			      case !uses of
-				 [] => new ()
-			       | {exp, scope = scope'} :: _ =>
-				    if Scope.equals (scope, scope')
-				       then exp
-				    else new ()
-			   val y = Var.new x
-			   val () = blockCache := SOME y
-			   val () =
-			      List.push
-			      (blockSelects,
-			       {blockCache = blockCache,
-				statement = Bind {exp = exp,
-						  ty = ty,
-						  var = SOME y}})
-			in
-			   y
-			end
+                      {componentsRev, numComponents, scope, tuple}: info)
+         : Var.t =
+         case varInfo x of
+            Global => x
+          | Local {blockCache, defScope, ty, uses, ...} =>
+               case !blockCache of
+                  SOME y => y
+                | _ => 
+                     if Scope.equals (defScope, scope)
+                        then x
+                     else
+                        let
+                           fun new () =
+                              let
+                                 val offset = !numComponents
+                                 val () = List.push (componentsRev, x)
+                                 val () = numComponents := 1 + offset
+                                 val exp = Select {base = Base.Object tuple,
+                                                   offset = offset}
+                                 val () = List.push (uses, {exp = exp,
+                                                            scope = scope})
+                              in
+                                 exp
+                              end
+                           val exp =
+                              case !uses of
+                                 [] => new ()
+                               | {exp, scope = scope'} :: _ =>
+                                    if Scope.equals (scope, scope')
+                                       then exp
+                                    else new ()
+                           val y = Var.new x
+                           val () = blockCache := SOME y
+                           val () =
+                              List.push
+                              (blockSelects,
+                               {blockCache = blockCache,
+                                statement = Bind {exp = exp,
+                                                  ty = ty,
+                                                  var = SOME y}})
+                        in
+                           y
+                        end
       val blocks = ref []
       fun loop (Tree.T (b, ts), info: info) =
-	 let
-	    val Block.T {args, label, statements, transfer} = b
-	    val {isCut = ref isCut, ...} = labelInfo label
-	    val info' = 
-	       if isCut
-		  then newInfo ()
-	       else info
-	    val define = fn (x, t) => define (x, t, info')
-	    val () = Vector.foreach (args, define)
-	    val statements =
-	       Vector.map
-	       (statements, fn s =>
-		let
-		   val s = Statement.replaceUses (s, fn x =>
-						  replaceVar (x, info'))
-		   val () = Statement.foreachDef (s, define)
-		in
-		   s
-		end)
-	    val transfer =
-		Transfer.replaceVar (transfer, fn x => replaceVar (x, info'))
-	    val statements = addBlockSelects statements
-	    val () = Vector.foreach (ts, fn t => loop (t, info'))
-	    val statements =
-	       if not isCut
-		  then statements
-	       else
-		  let
-		     val {componentsRev, tuple, ...} = info'
-		     val components = Vector.fromListRev (!componentsRev)
-		  in
-		     if 0 = Vector.length components
-			then statements
-		     else
-			let
-			   val componentTys =
-			      Vector.map
-			      (components, fn x =>
-			       case varInfo x of
-				  Global => Error.bug "global component"
-				| Local {ty, uses, ...} =>
-				     (ignore (List.pop uses)
-				      ; {elt = ty,
-					 isMutable = false}))
-			   val components =
-			      Vector.map (components, fn x =>
-					  replaceVar (x, info))
-			   val s =
-			      Bind
-			      {exp = Object {args = components, con = NONE},
-			       ty = Type.tuple (Prod.make componentTys),
-			       var = SOME tuple}
-			in
-			   addBlockSelects (Vector.concat [Vector.new1 s,
-							   statements])
-			end
-		  end
-	    val () = List.push (blocks,
-				Block.T {args = args,
-					 label = label,
-					 statements = statements,
-					 transfer = transfer})
-	 in
-	    ()
-	 end
+         let
+            val Block.T {args, label, statements, transfer} = b
+            val {isCut = ref isCut, ...} = labelInfo label
+            val info' = 
+               if isCut
+                  then newInfo ()
+               else info
+            val define = fn (x, t) => define (x, t, info')
+            val () = Vector.foreach (args, define)
+            val statements =
+               Vector.map
+               (statements, fn s =>
+                let
+                   val s = Statement.replaceUses (s, fn x =>
+                                                  replaceVar (x, info'))
+                   val () = Statement.foreachDef (s, define)
+                in
+                   s
+                end)
+            val transfer =
+                Transfer.replaceVar (transfer, fn x => replaceVar (x, info'))
+            val statements = addBlockSelects statements
+            val () = Vector.foreach (ts, fn t => loop (t, info'))
+            val statements =
+               if not isCut
+                  then statements
+               else
+                  let
+                     val {componentsRev, tuple, ...} = info'
+                     val components = Vector.fromListRev (!componentsRev)
+                  in
+                     if 0 = Vector.length components
+                        then statements
+                     else
+                        let
+                           val componentTys =
+                              Vector.map
+                              (components, fn x =>
+                               case varInfo x of
+                                  Global => Error.bug "Zone.zoneFunction: global component"
+                                | Local {ty, uses, ...} =>
+                                     (ignore (List.pop uses)
+                                      ; {elt = ty,
+                                         isMutable = false}))
+                           val components =
+                              Vector.map (components, fn x =>
+                                          replaceVar (x, info))
+                           val s =
+                              Bind
+                              {exp = Object {args = components, con = NONE},
+                               ty = Type.tuple (Prod.make componentTys),
+                               var = SOME tuple}
+                        in
+                           addBlockSelects (Vector.concat [Vector.new1 s,
+                                                           statements])
+                        end
+                  end
+            val () = List.push (blocks,
+                                Block.T {args = args,
+                                         label = label,
+                                         statements = statements,
+                                         transfer = transfer})
+         in
+            ()
+         end
       val () = loop (dominatorTree, newInfo ())
       val blocks = Vector.fromList (!blocks)
    in
       Function.new {args = args,
-		    blocks = blocks,
-		    mayInline = mayInline,
-		    name = name,
-		    raises = raises,
-		    returns = returns,
-		    start = start}
+                    blocks = blocks,
+                    mayInline = mayInline,
+                    name = name,
+                    raises = raises,
+                    returns = returns,
+                    start = start}
    end
 
 fun maybeZoneFunction (f, ac) =
    let
       val {blocks, name, ...} = Function.dest f
       val () =
-	 Control.diagnostic
-	 (fn () =>
-	  let
-	     open Layout
-	  in
-	     seq [Func.layout name, str " has ", str " blocks."]
-	  end)
+         Control.diagnostic
+         (fn () =>
+          let
+             open Layout
+          in
+             seq [Func.layout name, str " has ", str " blocks."]
+          end)
    in
       if Vector.length blocks <= !Control.maxFunctionSize
-	 then f :: ac
+         then f :: ac
       else zoneFunction f :: ac
    end
    
 fun zone (Program.T {datatypes, globals, functions, main}) =
    Program.T {datatypes = datatypes,
-	      globals = globals,
-	      functions = List.fold (functions, [], maybeZoneFunction),
-	      main = main}
+              globals = globals,
+              functions = List.fold (functions, [], maybeZoneFunction),
+              main = main}
 
 end
 

Modified: mlton/branches/on-20050420-cmm-branch/mlton/ssa/zone.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/ssa/zone.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/ssa/zone.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,8 +1,8 @@
-(* Copyright (C) 2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 2004-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 signature ZONE_STRUCTS = 

Modified: mlton/branches/on-20050420-cmm-branch/mlton/xml/call-count.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/xml/call-count.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/xml/call-count.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 functor CallCount(S: CALL_COUNT_STRUCTS): CALL_COUNT = 
 struct
 
@@ -14,112 +15,112 @@
 fun instrument(program as Program.T{datatypes, body}, passName: string) =
    if !Control.instrument
       then
-	 let
-	    datatype kind =
-	       None
-	     | Lam of int (* for curried lambdas, how many arrows remain *)
-	     | Prim
-	       
-	    val {get = kind: Var.t -> kind, set} =
-	       Property.new(Var.plist, Property.initConst None)
+         let
+            datatype kind =
+               None
+             | Lam of int (* for curried lambdas, how many arrows remain *)
+             | Prim
+               
+            val {get = kind: Var.t -> kind, set} =
+               Property.new(Var.plist, Property.initConst None)
 
-	    fun makeLam(l: Lambda.t): kind =
-	       let
-		  fun loop(l, n) =
-		     let val {decs, result} = Exp.dest(Lambda.body l)
-		     in case decs of
-			[MonoVal{var, exp = Lambda l, ...}] =>
-			   if Var.equals(var, VarExp.var result)
-			      then loop(l, n + 1)
-			   else n
-		      | _ => n
-		     end
-	       in Lam(loop(l, 0))
-	       end
+            fun makeLam(l: Lambda.t): kind =
+               let
+                  fun loop(l, n) =
+                     let val {decs, result} = Exp.dest(Lambda.body l)
+                     in case decs of
+                        [MonoVal{var, exp = Lambda l, ...}] =>
+                           if Var.equals(var, VarExp.var result)
+                              then loop(l, n + 1)
+                           else n
+                      | _ => n
+                     end
+               in Lam(loop(l, 0))
+               end
 
-	    fun inc(name: string) : unit -> Dec.t =
-	       let
-		  val exp =
-		     PrimApp
-		     {prim = Prim.newNullary(concat["MLTON_inc", passName, name]),
-		      targs = [], args = []}
-	       in fn () =>
-		  MonoVal{var = Var.newNoname(), ty = Type.unit, exp = exp}
-	       end
+            fun inc(name: string) : unit -> Dec.t =
+               let
+                  val exp =
+                     PrimApp
+                     {prim = Prim.newNullary(concat["MLTON_inc", passName, name]),
+                      targs = [], args = []}
+               in fn () =>
+                  MonoVal{var = Var.newNoname(), ty = Type.unit, exp = exp}
+               end
 
-	    val incCount = inc "Unknown"
-	    val incObvious = inc "Known"
-	    
-	    val program = Program.T{datatypes = datatypes,
-				    body = body}
-	    fun loopExp(e: Exp.t): Exp.t =
-	       let val {decs, result} = Exp.dest e
-	       in Exp.new{decs = loopDecs decs,
-			  result = result}
-	       end
-	    and loopDecs(ds: Dec.t list): Dec.t list =
-	       case ds of
-		  [] => []
-		| d :: ds =>
-		   case d of
-		      MonoVal{var, ty, exp} =>
-			 let
-			    fun keep exp =
-			       MonoVal{var = var, ty = ty, exp = exp}
-			       :: loopDecs ds
-			 in case exp of
-			     App{func, ...} =>
-				let fun rest() = d :: loopDecs ds
-				in case kind(VarExp.var func) of
-				   None => incCount() :: rest()
-				 | Prim => rest()
-				 | Lam n => (if n >= 0
-						then set(var, Lam(n - 1))
-					     else ()
-					     ; incObvious() :: rest())
-				end
-			   | Lambda l =>
-				(set(var, 
-				     case Exp.decs(Lambda.body l) of
-					[MonoVal{exp = PrimApp _, ...}] => Prim
-				      | _ => makeLam l)
-				 ; keep(Lambda(loopLambda l)))
-			   | Case{test, cases, default} =>
-				keep
-				(Case{test = test,
-				      cases = List.map(cases, fn (p, e) =>
-						       (p, loopExp e)),
-				      default = Option.map loopExp default})
-			   | Handle{try, catch, handler} =>
-				keep(Handle{try = loopExp try,
-					    catch = catch,
-					    handler = loopExp handler})
-			   | _ => d :: loopDecs ds
-			 end
-		    | PolyVal{var, tyvars, ty, exp} =>
-			 PolyVal{var = var, tyvars = tyvars, ty = ty,
-				 exp = loopExp exp}
-			 :: loopDecs ds
-		    | Fun{tyvars, decs} =>
-			 (List.foreach(decs, fn {var, lambda, ...} =>
-				       set(var, makeLam lambda))
-			 ; Fun{tyvars = tyvars,
-			       decs = List.map(decs, fn {var, ty, lambda} =>
-					       {var = var, ty = ty,
-						lambda = loopLambda lambda})}
-			  :: loopDecs ds)
-		    | Exception _ => d :: loopDecs ds
-	    and loopLambda(l: Lambda.t): Lambda.t =
-	       let val {arg, argType, body} = Lambda.dest l
-	       in Lambda.new{arg = arg, argType = argType,
-			     body = loopExp body}
-	       end
+            val incCount = inc "Unknown"
+            val incObvious = inc "Known"
+            
+            val program = Program.T{datatypes = datatypes,
+                                    body = body}
+            fun loopExp(e: Exp.t): Exp.t =
+               let val {decs, result} = Exp.dest e
+               in Exp.new{decs = loopDecs decs,
+                          result = result}
+               end
+            and loopDecs(ds: Dec.t list): Dec.t list =
+               case ds of
+                  [] => []
+                | d :: ds =>
+                   case d of
+                      MonoVal{var, ty, exp} =>
+                         let
+                            fun keep exp =
+                               MonoVal{var = var, ty = ty, exp = exp}
+                               :: loopDecs ds
+                         in case exp of
+                             App{func, ...} =>
+                                let fun rest() = d :: loopDecs ds
+                                in case kind(VarExp.var func) of
+                                   None => incCount() :: rest()
+                                 | Prim => rest()
+                                 | Lam n => (if n >= 0
+                                                then set(var, Lam(n - 1))
+                                             else ()
+                                             ; incObvious() :: rest())
+                                end
+                           | Lambda l =>
+                                (set(var, 
+                                     case Exp.decs(Lambda.body l) of
+                                        [MonoVal{exp = PrimApp _, ...}] => Prim
+                                      | _ => makeLam l)
+                                 ; keep(Lambda(loopLambda l)))
+                           | Case{test, cases, default} =>
+                                keep
+                                (Case{test = test,
+                                      cases = List.map(cases, fn (p, e) =>
+                                                       (p, loopExp e)),
+                                      default = Option.map loopExp default})
+                           | Handle{try, catch, handler} =>
+                                keep(Handle{try = loopExp try,
+                                            catch = catch,
+                                            handler = loopExp handler})
+                           | _ => d :: loopDecs ds
+                         end
+                    | PolyVal{var, tyvars, ty, exp} =>
+                         PolyVal{var = var, tyvars = tyvars, ty = ty,
+                                 exp = loopExp exp}
+                         :: loopDecs ds
+                    | Fun{tyvars, decs} =>
+                         (List.foreach(decs, fn {var, lambda, ...} =>
+                                       set(var, makeLam lambda))
+                         ; Fun{tyvars = tyvars,
+                               decs = List.map(decs, fn {var, ty, lambda} =>
+                                               {var = var, ty = ty,
+                                                lambda = loopLambda lambda})}
+                          :: loopDecs ds)
+                    | Exception _ => d :: loopDecs ds
+            and loopLambda(l: Lambda.t): Lambda.t =
+               let val {arg, argType, body} = Lambda.dest l
+               in Lambda.new{arg = arg, argType = argType,
+                             body = loopExp body}
+               end
 
-	    val program = Program.T{datatypes = datatypes,
-				    body = loopExp body}
-	       
-	 in Program.clear program
-	    ; program
-	 end
+            val program = Program.T{datatypes = datatypes,
+                                    body = loopExp body}
+               
+         in Program.clear program
+            ; program
+         end
    else program
 end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/xml/call-count.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/xml/call-count.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/xml/call-count.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature CALL_COUNT_STRUCTS = 
    sig
       include XML

Modified: mlton/branches/on-20050420-cmm-branch/mlton/xml/implement-exceptions.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/xml/implement-exceptions.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/xml/implement-exceptions.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,9 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 functor ImplementExceptions (S: IMPLEMENT_EXCEPTIONS_STRUCTS):
@@ -25,538 +25,547 @@
       val exnName = Var.newString "exnName"
       (* sumType is the type of the datatype with all of the exn constructors. *)
       val {dropVar,
-	   extendExtraType,
-	   extra,
-	   extraDatatypes,
-	   extract,
-	   extractSum,
-	   inject,
-	   raisee,
-	   sumTycon,
-	   sumType,
-	   wrapBody
-	   } =
-	 if not (!Control.exnHistory)
-	    then {dropVar = fn _ => false,
-		  extendExtraType = Type.unit,
-		  extra = fn _ => Error.bug "no extra",
-		  extraDatatypes = Vector.new0 (),
-		  extract = fn (exn, _, f) => f (Dexp.monoVar (exn, Type.exn)),
-		  extractSum = fn e => e,
-		  inject = fn e => e,
-		  raisee = (fn {exn, extend, ty, var} =>
-			    [MonoVal {var = var, ty = ty,
-				      exp = Raise {exn = exn,
-						   extend = extend}}]),
-		  sumTycon = Tycon.exn,
-		  sumType = Type.exn,
-		  wrapBody = Dexp.toExp}
-	 else
-	    let
-	       val sumTycon = Tycon.newNoname ()
-	       val sumType = Type.con (sumTycon, Vector.new0 ())
-	       fun find (nameString: string, isName: Type.t Prim.Name.t -> bool)
-		  : Var.t * Type.t * PrimExp.t =
-		  let
-		     val var =
-			DynamicWind.withEscape
-			(fn escape =>
-			 let
-			    val _ =
-			       Exp.foreachPrimExp
-			       (body, fn (_, _, e) =>
-				case e of
-				   PrimApp {args, prim, ...} =>
-				      if isName (Prim.name prim)
-					 then escape (VarExp.var
-						      (Vector.sub (args, 0)))
-				      else ()
-				 | _ => ())
-			 in
-			    Error.bug (concat ["can't find it", nameString])
-			 end)
-		     val (ty, exp) =
-			DynamicWind.withEscape
-			(fn escape =>
-			 let
-			    val _ = Exp.foreachPrimExp (body, fn (x, t, e) =>
-							if Var.equals (x, var)
-							   then escape (t, e)
-							else ())
-			 in
-			    Error.bug
-			    (concat ["can't find ", Var.toString var])
-			 end)
-		  in
-		     (var, ty, exp)
-		  end
-	       val (initExtraVar, initExtraType, initExtraExp) =
-		  find ("Exn_setInitExtra",
-			fn Prim.Name.Exn_setInitExtra => true | _ => false)
-	       val extraType = initExtraType
-	       val extendExtraType = Type.arrow (extraType, extraType)
-	       local
-		  open Type
-	       in
-		  val exnCon = Con.newNoname ()
-		  val exnConArgType = tuple (Vector.new2 (extraType, sumType))
-		  val seType = tuple (Vector.new2 (string, extraType))
-	       end
-	       fun wrapBody body =
-		  let
-		     val body =
-			Dexp.let1
-			{body = body,
-			 exp = (Dexp.reff
-				(Dexp.lambda
-				 {arg = Var.newNoname (),
-				  argType = extraType,
-				  body = Dexp.bug ("extendExtra unimplemented",
-						   extraType),
-				  bodyType = extraType,
-				  mayInline = true})),
-			 var = extendExtraVar}
-		  in
-		     Exp.prefix (Dexp.toExp body,
-				 Dec.MonoVal {var = initExtraVar,
-					      ty = initExtraType,
-					      exp = initExtraExp})
-		  end
-	       fun makeExn {exn, extra} =
-		  let
-		     open Dexp
-		  in
-		     conApp
-		     {con = exnCon,
-		      targs = Vector.new0 (),
-		      ty = Type.exn,
-		      arg = SOME (tuple {exps = Vector.new2 (extra, exn),
-					 ty = exnConArgType})}
-		  end
-	       fun inject (exn: Dexp.t): Dexp.t =
-		  makeExn {exn = exn,
-			   extra = Dexp.monoVar (initExtraVar, initExtraType)}
-	       fun extractSum x =
-		  Dexp.select {tuple = x, offset = 1, ty = sumType}
-	       fun extract (exn: Var.t, ty, f: Dexp.t -> Dexp.t): Dexp.t =
-		  let
-		     open Dexp
-		     val tuple = Var.newNoname ()
-		  in
-		     casee
-		     {test = monoVar (exn, Type.exn),
-		      default = NONE,
-		      ty = ty,
-		      cases =
-		      Cases.Con (Vector.new1
-				 (Pat.T {con = exnCon,
-					 targs = Vector.new0 (),
-					 arg = SOME (tuple, exnConArgType)},
-				  f (monoVar (tuple, exnConArgType))))}
-		  end
-	       fun extra (x: Var.t) =
-		  extract (x, extraType, fn tuple =>
-			   Dexp.select {tuple = tuple,
-					offset = 0,
-					ty = extraType})
-	       fun raisee {exn: VarExp.t,
-			   extend: bool,
-			   ty: Type.t,
-			   var = x : Var.t}: Dec.t list =
-		  let
-		     open Dexp
-		     val exp =
-			if not extend
-			   then raisee (varExp (exn, Type.exn),
-					{extend = false}, ty)
-			else
-			   extract
-			   (VarExp.var exn, ty, fn tup =>
-			    raisee
-			    (makeExn
-			     {exn = select {tuple = tup,
-					    offset = 1,
-					    ty = sumType},
-			      extra =
-			      app
-			      {func = deref (monoVar
-					     (extendExtraVar,
-					      Type.reff extendExtraType)),
-			       arg = tuple {exps = (Vector.new1
-						    (select {tuple = tup,
-							     offset = 0,
-							     ty = extraType})),
-					    ty = seType},
-			       ty = extraType}},
-			     {extend = false},
-			     ty))
-		  in
-		     vall {exp = exp, var = x}
-		  end
-	       val extraDatatypes =
-		  Vector.new1 {tycon = Tycon.exn,
-			       tyvars = Vector.new0 (),
-			       cons = Vector.new1 {con = exnCon,
-						   arg = SOME exnConArgType}}
-	       fun dropVar x = Var.equals (x, initExtraVar)
-	    in
-	       {dropVar = dropVar,
-		extendExtraType = extendExtraType,
-		extra = extra,
-		extraDatatypes = extraDatatypes,
-		extract = extract,
-		extractSum = extractSum,
-		inject = inject,
-		raisee = raisee,
-		sumTycon = sumTycon,
-		sumType = sumType,
-		wrapBody = wrapBody}
-	    end
+           extendExtraType,
+           extra,
+           extraDatatypes,
+           extract,
+           extractSum,
+           inject,
+           raisee,
+           sumTycon,
+           sumType,
+           wrapBody
+           } =
+         if not (!Control.exnHistory)
+            then {dropVar = fn _ => false,
+                  extendExtraType = Type.unit,
+                  extra = fn _ => Error.bug "ImplementExceptions: no extra",
+                  extraDatatypes = Vector.new0 (),
+                  extract = fn (exn, _, f) => f (Dexp.monoVar (exn, Type.exn)),
+                  extractSum = fn e => e,
+                  inject = fn e => e,
+                  raisee = (fn {exn, extend, ty, var} =>
+                            [MonoVal {var = var, ty = ty,
+                                      exp = Raise {exn = exn,
+                                                   extend = extend}}]),
+                  sumTycon = Tycon.exn,
+                  sumType = Type.exn,
+                  wrapBody = Dexp.toExp}
+         else
+            let
+               val sumTycon = Tycon.newNoname ()
+               val sumType = Type.con (sumTycon, Vector.new0 ())
+               fun find (nameString: string, isName: Type.t Prim.Name.t -> bool)
+                  : Var.t * Type.t * PrimExp.t =
+                  let
+                     val var =
+                        Exn.withEscape
+                        (fn escape =>
+                         let
+                            val _ =
+                               Exp.foreachPrimExp
+                               (body, fn (_, _, e) =>
+                                case e of
+                                   PrimApp {args, prim, ...} =>
+                                      if isName (Prim.name prim)
+                                         then escape (VarExp.var
+                                                      (Vector.sub (args, 0)))
+                                      else ()
+                                 | _ => ())
+                         in
+                            Error.bug 
+                            (concat ["ImplmentExceptions: can't find var for", 
+                                     nameString])
+                         end)
+                     val (ty, exp) =
+                        Exn.withEscape
+                        (fn escape =>
+                         let
+                            val _ = Exp.foreachPrimExp (body, fn (x, t, e) =>
+                                                        if Var.equals (x, var)
+                                                           then escape (t, e)
+                                                        else ())
+                         in
+                            Error.bug
+                            (concat ["ImplementExceptions: can't find ", 
+                                     Var.toString var])
+                         end)
+                  in
+                     (var, ty, exp)
+                  end
+               val (initExtraVar, initExtraType, initExtraExp) =
+                  find ("Exn_setInitExtra",
+                        fn Prim.Name.Exn_setInitExtra => true | _ => false)
+               val extraType = initExtraType
+               val extendExtraType = Type.arrow (extraType, extraType)
+               local
+                  open Type
+               in
+                  val exnCon = Con.newNoname ()
+                  val exnConArgType = tuple (Vector.new2 (extraType, sumType))
+                  val seType = tuple (Vector.new2 (string, extraType))
+               end
+               fun wrapBody body =
+                  let
+                     val body =
+                        Dexp.let1
+                        {body = body,
+                         exp = (Dexp.reff
+                                (Dexp.lambda
+                                 {arg = Var.newNoname (),
+                                  argType = extraType,
+                                  body = Dexp.bug ("extendExtra unimplemented",
+                                                   extraType),
+                                  bodyType = extraType,
+                                  mayInline = true})),
+                         var = extendExtraVar}
+                  in
+                     Exp.prefix (Dexp.toExp body,
+                                 Dec.MonoVal {var = initExtraVar,
+                                              ty = initExtraType,
+                                              exp = initExtraExp})
+                  end
+               fun makeExn {exn, extra} =
+                  let
+                     open Dexp
+                  in
+                     conApp
+                     {con = exnCon,
+                      targs = Vector.new0 (),
+                      ty = Type.exn,
+                      arg = SOME (tuple {exps = Vector.new2 (extra, exn),
+                                         ty = exnConArgType})}
+                  end
+               fun inject (exn: Dexp.t): Dexp.t =
+                  makeExn {exn = exn,
+                           extra = Dexp.monoVar (initExtraVar, initExtraType)}
+               fun extractSum x =
+                  Dexp.select {tuple = x, offset = 1, ty = sumType}
+               fun extract (exn: Var.t, ty, f: Dexp.t -> Dexp.t): Dexp.t =
+                  let
+                     open Dexp
+                     val tuple = Var.newNoname ()
+                  in
+                     casee
+                     {test = monoVar (exn, Type.exn),
+                      default = NONE,
+                      ty = ty,
+                      cases =
+                      Cases.Con (Vector.new1
+                                 (Pat.T {con = exnCon,
+                                         targs = Vector.new0 (),
+                                         arg = SOME (tuple, exnConArgType)},
+                                  f (monoVar (tuple, exnConArgType))))}
+                  end
+               fun extra (x: Var.t) =
+                  extract (x, extraType, fn tuple =>
+                           Dexp.select {tuple = tuple,
+                                        offset = 0,
+                                        ty = extraType})
+               fun raisee {exn: VarExp.t,
+                           extend: bool,
+                           ty: Type.t,
+                           var = x : Var.t}: Dec.t list =
+                  let
+                     open Dexp
+                     val exp =
+                        if not extend
+                           then raisee (varExp (exn, Type.exn),
+                                        {extend = false}, ty)
+                        else
+                           extract
+                           (VarExp.var exn, ty, fn tup =>
+                            raisee
+                            (makeExn
+                             {exn = select {tuple = tup,
+                                            offset = 1,
+                                            ty = sumType},
+                              extra =
+                              app
+                              {func = deref (monoVar
+                                             (extendExtraVar,
+                                              Type.reff extendExtraType)),
+                               arg = tuple {exps = (Vector.new1
+                                                    (select {tuple = tup,
+                                                             offset = 0,
+                                                             ty = extraType})),
+                                            ty = seType},
+                               ty = extraType}},
+                             {extend = false},
+                             ty))
+                  in
+                     vall {exp = exp, var = x}
+                  end
+               val extraDatatypes =
+                  Vector.new1 {tycon = Tycon.exn,
+                               tyvars = Vector.new0 (),
+                               cons = Vector.new1 {con = exnCon,
+                                                   arg = SOME exnConArgType}}
+               fun dropVar x = Var.equals (x, initExtraVar)
+            in
+               {dropVar = dropVar,
+                extendExtraType = extendExtraType,
+                extra = extra,
+                extraDatatypes = extraDatatypes,
+                extract = extract,
+                extractSum = extractSum,
+                inject = inject,
+                raisee = raisee,
+                sumTycon = sumTycon,
+                sumType = sumType,
+                wrapBody = wrapBody}
+            end
       val {get = exconInfo: Con.t -> {refVar: Var.t,
-				      make: VarExp.t option -> Dexp.t} option,
-	   set = setExconInfo, destroy} =
-	 Property.destGetSetOnce (Con.plist, Property.initConst NONE)
-      val setExconInfo = Trace.trace2 ("setExconInfo", Con.layout,
-				       Layout.ignore, Unit.layout) setExconInfo
+                                      make: VarExp.t option -> Dexp.t} option,
+           set = setExconInfo, destroy} =
+         Property.destGetSetOnce (Con.plist, Property.initConst NONE)
+      val setExconInfo = 
+         Trace.trace2 
+         ("ImplementExceptions.setExconInfo", 
+          Con.layout, Layout.ignore, Unit.layout) 
+         setExconInfo
       val exconInfo =
-	 Trace.trace ("exconInfo", Con.layout, Layout.ignore) exconInfo
+         Trace.trace 
+         ("ImplementExceptions.exconInfo", 
+          Con.layout, Layout.ignore) 
+         exconInfo
       fun isExcon c =
-	 case exconInfo c of
-	    NONE => false
-	  | SOME _ => true
+         case exconInfo c of
+            NONE => false
+          | SOME _ => true
       val exnValCons: {con: Con.t, arg: Type.t} list ref = ref []
       val overflow = ref NONE
       val traceLoopDec =
-	 Trace.trace
-	 ("ImplementExceptions.loopDec", Dec.layout, List.layout Dec.layout)
+         Trace.trace
+         ("ImplementExceptions.loopDec", Dec.layout, List.layout Dec.layout)
       fun loop (e: Exp.t): Exp.t =
-	 let
-	    val {decs, result} = Exp.dest e
-	    val decs = List.concatRev (List.fold (decs, [], fn (d, ds) =>
-						  loopDec d :: ds))
-	 in
-	    Exp.make {decs = decs,
-		      result = result}
-	 end
+         let
+            val {decs, result} = Exp.dest e
+            val decs = List.concatRev (List.fold (decs, [], fn (d, ds) =>
+                                                  loopDec d :: ds))
+         in
+            Exp.make {decs = decs,
+                      result = result}
+         end
       and loopDec arg: Dec.t list =
-	 traceLoopDec
-	 (fn (dec: Dec.t) =>
-	 case dec of
-	    MonoVal b => loopMonoVal b
-	  | Fun {decs, ...} =>
-	       [Fun {tyvars = Vector.new0 (),
-		     decs = Vector.map (decs, fn {var, ty, lambda} =>
-					{var = var,
-					 ty = ty,
-					 lambda = loopLambda lambda})}]
-	  | Exception {con, arg} =>
-	       let
-		  open Dexp
-		  val r = Var.newString "exnRef"
-		  val uniq = monoVar (r, Type.unitRef)
-		  fun conApp arg =
-		     inject (Dexp.conApp {con = con,
-					  targs = Vector.new0 (),
-					  ty = sumType,
-					  arg = SOME arg})
-		  val (arg, decs, make) =
-		     case arg of
-			NONE =>
-			   (* If the exception is not value carrying, then go
-			    * ahead and make it now.
-			    *)
-			   let
-			      val exn = Var.newNoname ()
-			      val _ =
-				 if Con.equals (con, Con.overflow)
-				    then overflow := SOME exn
-				 else ()
-			   in (Type.unitRef,
-			       Dexp.vall {var = exn, exp = conApp uniq},
-			       fn NONE => monoVar (exn, Type.exn)
-				| _ => Error.bug "nullary excon applied to arg")
-			   end
-		      | SOME t =>
-			   let
-			      val tupleType =
-				 Type.tuple (Vector.new2 (Type.unitRef, t))
-			   in (tupleType,
-			       [],
-			       fn SOME x =>
-			       conApp (tuple {exps = Vector.new2 (uniq,
-								  varExp (x, t)),
-					      ty = tupleType})
-				| _ =>
-				     Error.bug "unary excon not applied to arg")
-			   end
-	       in setExconInfo (con, SOME {refVar = r, make = make})
-		  ; List.push (exnValCons, {con = con, arg = arg})
-		  ; vall {var = r, exp = reff (unit ())} @ decs
-	       end
-	  | _ => Error.bug "implement exceptions saw unexpected dec") arg
+         traceLoopDec
+         (fn (dec: Dec.t) =>
+         case dec of
+            MonoVal b => loopMonoVal b
+          | Fun {decs, ...} =>
+               [Fun {tyvars = Vector.new0 (),
+                     decs = Vector.map (decs, fn {var, ty, lambda} =>
+                                        {var = var,
+                                         ty = ty,
+                                         lambda = loopLambda lambda})}]
+          | Exception {con, arg} =>
+               let
+                  open Dexp
+                  val r = Var.newString "exnRef"
+                  val uniq = monoVar (r, Type.unitRef)
+                  fun conApp arg =
+                     inject (Dexp.conApp {con = con,
+                                          targs = Vector.new0 (),
+                                          ty = sumType,
+                                          arg = SOME arg})
+                  val (arg, decs, make) =
+                     case arg of
+                        NONE =>
+                           (* If the exception is not value carrying, then go
+                            * ahead and make it now.
+                            *)
+                           let
+                              val exn = Var.newNoname ()
+                              val _ =
+                                 if Con.equals (con, Con.overflow)
+                                    then overflow := SOME exn
+                                 else ()
+                           in (Type.unitRef,
+                               Dexp.vall {var = exn, exp = conApp uniq},
+                               fn NONE => monoVar (exn, Type.exn)
+                                | _ => Error.bug "ImplementExceptions: nullary excon applied to arg")
+                           end
+                      | SOME t =>
+                           let
+                              val tupleType =
+                                 Type.tuple (Vector.new2 (Type.unitRef, t))
+                           in (tupleType,
+                               [],
+                               fn SOME x =>
+                               conApp (tuple {exps = Vector.new2 (uniq,
+                                                                  varExp (x, t)),
+                                              ty = tupleType})
+                                | _ =>
+                                     Error.bug "ImplmentExceptions: unary excon not applied to arg")
+                           end
+               in setExconInfo (con, SOME {refVar = r, make = make})
+                  ; List.push (exnValCons, {con = con, arg = arg})
+                  ; vall {var = r, exp = reff (unit ())} @ decs
+               end
+          | _ => Error.bug "ImplementExceptions: saw unexpected dec") arg
       and loopMonoVal {var, ty, exp} : Dec.t list =
-	 if dropVar var
-	    then []
-	 else
-	 let
-	    fun primExp e = [MonoVal {var = var, ty = ty, exp = e}]
-	    fun keep () = primExp exp
-	    fun makeExp e = Dexp.vall {var = var, exp = e}
-	 in
-	    case exp of
-	       Case {test, cases, default} =>
-		  let
-		     fun normal () =
-			primExp (Case {cases = Cases.map (cases, loop),
-				       default = (Option.map
-						  (default, fn (e, r) =>
-						   (loop e, r))),
-				       test = test})
-		  in
-		     case cases of
-			Cases.Con cases =>
-			   if Vector.isEmpty cases
-			      then normal ()
-			   else
-			      let
-				 val (Pat.T {con, ...}, _) =
-				    Vector.sub (cases, 0)
-			      in
-				 if not (isExcon con)
-				    then normal ()
-				 else (* convert to an exception match *)
-				    let
-				       open Dexp
-				       val defaultVar = Var.newString "default"
-				       fun callDefault () =
-					  app {func = (monoVar
-						       (defaultVar,
-							Type.arrow
-							(Type.unit, ty))),
-					       arg = unit (),
-					       ty = ty}
-				       val unit = Var.newString "unit"
-				       val (body, region) =
-					  case default of
-					     NONE =>
-						Error.bug "no default for exception case"
-					   | SOME (e, r) =>
-						(fromExp (loop e, ty), r)
-				       val decs =
-					  vall
-					  {var = defaultVar,
-					   exp = lambda {arg = unit,
-							 argType = Type.unit,
-							 body = body,
-							 bodyType = ty,
-							 mayInline = true}}
-				    in
-				       makeExp
-				       (lett
-					{decs = decs,
-					 body =
-					 extract
-					 (VarExp.var test, ty, fn tuple =>
-					  casee
-					  {test = extractSum tuple,
-					   ty = ty,
-					   default = SOME (callDefault (),
-							   region),
-					   cases =
-					   Cases.Con
-					   (Vector.map
-					    (cases, fn (Pat.T {con, arg, ...}, e) =>
-					     let
-						val refVar = Var.newNoname ()
-						val body =
-						   iff {test =
-							equal
-							(monoVar
-							 (refVar, Type.unitRef),
-							 monoVar
-							 (#refVar (valOf (exconInfo con)),
-							  Type.unitRef)),
-							ty = ty,
-							thenn = (fromExp
-								 (loop e, ty)),
-							elsee = callDefault ()}
-						fun make (arg, body) = 
-						   (Pat.T
-						    {con = con,
-						     targs = Vector.new0 (),
-						     arg = SOME arg},
-						    body)
-					     in case arg of
-						NONE => make ((refVar, Type.unitRef), body)
-					      | SOME (x, t) =>
-						   let
-						      val tuple =
-							 (Var.newNoname (),
-							  Type.tuple (Vector.new2
-								      (Type.unitRef, t)))
-						   in
-						      make (tuple,
-							    detupleBind
-							    {tuple = monoVar tuple,
-							     components =
-							     Vector.new2 (refVar, x),
-							     body = body})
-						   end
-					     end))})})
-				    end
-			      end
-		      | _ => normal ()
-		  end
-	     | ConApp {con, arg, ...} =>
-		  (case exconInfo con of
-		      NONE => keep ()
-		    | SOME {make, ...} => makeExp (make arg))
-	     | Handle {try, catch = (catch, ty), handler} =>
-		  primExp (Handle {try = loop try,
-				   catch = (catch, ty),
-				   handler = loop handler})
-	     | Lambda l => primExp (Lambda (loopLambda l))
-	     | PrimApp {args, prim, ...} =>
-		  let
-		     datatype z = datatype Prim.Name.t
-		     fun assign (var, ty) =
-			primExp
-			(PrimApp {prim = Prim.assign,
-				  targs = Vector.new1 ty,
-				  args = Vector.new2 (VarExp.mono var,
-						      Vector.sub (args, 0))})
-		  in
-		     case Prim.name prim of
-			Exn_extra => makeExp (extra (VarExp.var
-						     (Vector.sub (args, 0))))
-		      | Exn_name =>
-			   primExp (App {func = VarExp.mono exnName,
-					 arg = Vector.sub (args, 0)})
-		      | Exn_setExtendExtra =>
-			   assign (extendExtraVar, extendExtraType)
-		      | Exn_setInitExtra => primExp (Tuple (Vector.new0 ()))
-		      | TopLevel_setHandler =>
-			   assign (topLevelHandler,
-				   Type.arrow (Type.exn, Type.unit))
-		      | _ => primExp exp
-		  end
-	     | Raise {exn, extend} =>
-		  raisee {exn = exn, extend = extend, ty = ty, var = var}
-	     | _ => keep ()
-	 end
+         if dropVar var
+            then []
+         else
+         let
+            fun primExp e = [MonoVal {var = var, ty = ty, exp = e}]
+            fun keep () = primExp exp
+            fun makeExp e = Dexp.vall {var = var, exp = e}
+         in
+            case exp of
+               Case {test, cases, default} =>
+                  let
+                     fun normal () =
+                        primExp (Case {cases = Cases.map (cases, loop),
+                                       default = (Option.map
+                                                  (default, fn (e, r) =>
+                                                   (loop e, r))),
+                                       test = test})
+                  in
+                     case cases of
+                        Cases.Con cases =>
+                           if Vector.isEmpty cases
+                              then normal ()
+                           else
+                              let
+                                 val (Pat.T {con, ...}, _) =
+                                    Vector.sub (cases, 0)
+                              in
+                                 if not (isExcon con)
+                                    then normal ()
+                                 else (* convert to an exception match *)
+                                    let
+                                       open Dexp
+                                       val defaultVar = Var.newString "default"
+                                       fun callDefault () =
+                                          app {func = (monoVar
+                                                       (defaultVar,
+                                                        Type.arrow
+                                                        (Type.unit, ty))),
+                                               arg = unit (),
+                                               ty = ty}
+                                       val unit = Var.newString "unit"
+                                       val (body, region) =
+                                          case default of
+                                             NONE =>
+                                                Error.bug "ImplementExceptions: no default for exception case"
+                                           | SOME (e, r) =>
+                                                (fromExp (loop e, ty), r)
+                                       val decs =
+                                          vall
+                                          {var = defaultVar,
+                                           exp = lambda {arg = unit,
+                                                         argType = Type.unit,
+                                                         body = body,
+                                                         bodyType = ty,
+                                                         mayInline = true}}
+                                    in
+                                       makeExp
+                                       (lett
+                                        {decs = decs,
+                                         body =
+                                         extract
+                                         (VarExp.var test, ty, fn tuple =>
+                                          casee
+                                          {test = extractSum tuple,
+                                           ty = ty,
+                                           default = SOME (callDefault (),
+                                                           region),
+                                           cases =
+                                           Cases.Con
+                                           (Vector.map
+                                            (cases, fn (Pat.T {con, arg, ...}, e) =>
+                                             let
+                                                val refVar = Var.newNoname ()
+                                                val body =
+                                                   iff {test =
+                                                        equal
+                                                        (monoVar
+                                                         (refVar, Type.unitRef),
+                                                         monoVar
+                                                         (#refVar (valOf (exconInfo con)),
+                                                          Type.unitRef)),
+                                                        ty = ty,
+                                                        thenn = (fromExp
+                                                                 (loop e, ty)),
+                                                        elsee = callDefault ()}
+                                                fun make (arg, body) = 
+                                                   (Pat.T
+                                                    {con = con,
+                                                     targs = Vector.new0 (),
+                                                     arg = SOME arg},
+                                                    body)
+                                             in case arg of
+                                                NONE => make ((refVar, Type.unitRef), body)
+                                              | SOME (x, t) =>
+                                                   let
+                                                      val tuple =
+                                                         (Var.newNoname (),
+                                                          Type.tuple (Vector.new2
+                                                                      (Type.unitRef, t)))
+                                                   in
+                                                      make (tuple,
+                                                            detupleBind
+                                                            {tuple = monoVar tuple,
+                                                             components =
+                                                             Vector.new2 (refVar, x),
+                                                             body = body})
+                                                   end
+                                             end))})})
+                                    end
+                              end
+                      | _ => normal ()
+                  end
+             | ConApp {con, arg, ...} =>
+                  (case exconInfo con of
+                      NONE => keep ()
+                    | SOME {make, ...} => makeExp (make arg))
+             | Handle {try, catch = (catch, ty), handler} =>
+                  primExp (Handle {try = loop try,
+                                   catch = (catch, ty),
+                                   handler = loop handler})
+             | Lambda l => primExp (Lambda (loopLambda l))
+             | PrimApp {args, prim, ...} =>
+                  let
+                     datatype z = datatype Prim.Name.t
+                     fun assign (var, ty) =
+                        primExp
+                        (PrimApp {prim = Prim.assign,
+                                  targs = Vector.new1 ty,
+                                  args = Vector.new2 (VarExp.mono var,
+                                                      Vector.sub (args, 0))})
+                  in
+                     case Prim.name prim of
+                        Exn_extra => makeExp (extra (VarExp.var
+                                                     (Vector.sub (args, 0))))
+                      | Exn_name =>
+                           primExp (App {func = VarExp.mono exnName,
+                                         arg = Vector.sub (args, 0)})
+                      | Exn_setExtendExtra =>
+                           assign (extendExtraVar, extendExtraType)
+                      | Exn_setInitExtra => primExp (Tuple (Vector.new0 ()))
+                      | TopLevel_setHandler =>
+                           assign (topLevelHandler,
+                                   Type.arrow (Type.exn, Type.unit))
+                      | _ => primExp exp
+                  end
+             | Raise {exn, extend} =>
+                  raisee {exn = exn, extend = extend, ty = ty, var = var}
+             | _ => keep ()
+         end
       and loopLambda l =
-	 let
-	    val {arg, argType, body, mayInline} = Lambda.dest l
-	 in
-	    Lambda.make {arg = arg,
-			 argType = argType,
-			 body = loop body,
-			 mayInline = mayInline}
-	 end
+         let
+            val {arg, argType, body, mayInline} = Lambda.dest l
+         in
+            Lambda.make {arg = arg,
+                         argType = argType,
+                         body = loop body,
+                         mayInline = mayInline}
+         end
       val body =
-	 let
-	    val x = (Var.newNoname (), Type.exn)
-	 in
-	    Dexp.handlee
-	    {try = Dexp.fromExp (loop body, Type.unit),
-	     ty = Type.unit,
-	     catch = x,
-	     handler = Dexp.app {func = (Dexp.deref
-					 (Dexp.monoVar
-					  (topLevelHandler,
-					   let open Type
-					   in reff (arrow (exn, unit))
-					   end))),
-				 arg = Dexp.monoVar x,
-				 ty = Type.unit}}
-	 end
+         let
+            val x = (Var.newNoname (), Type.exn)
+         in
+            Dexp.handlee
+            {try = Dexp.fromExp (loop body, Type.unit),
+             ty = Type.unit,
+             catch = x,
+             handler = Dexp.app {func = (Dexp.deref
+                                         (Dexp.monoVar
+                                          (topLevelHandler,
+                                           let open Type
+                                           in reff (arrow (exn, unit))
+                                           end))),
+                                 arg = Dexp.monoVar x,
+                                 ty = Type.unit}}
+         end
       val body =
-	 Dexp.let1
-	 {var = topLevelHandler,
-	  exp = Dexp.reff (Dexp.lambda
-			   {arg = Var.newNoname (),
-			    argType = Type.exn,
-			    body = Dexp.bug ("toplevel handler not installed",
-					     Type.unit),
-			    bodyType = Type.unit,
-			    mayInline = true}),
-	  body = body}
+         Dexp.let1
+         {var = topLevelHandler,
+          exp = Dexp.reff (Dexp.lambda
+                           {arg = Var.newNoname (),
+                            argType = Type.exn,
+                            body = Dexp.bug ("toplevel handler not installed",
+                                             Type.unit),
+                            bodyType = Type.unit,
+                            mayInline = true}),
+          body = body}
       val body = wrapBody body
       val (datatypes, body) =
-	 case !exnValCons of
-	    [] => (datatypes, body)
-	  | cons =>
-	       let
-		  val cons = Vector.fromList cons
-		  val exnNameDec =
-		     MonoVal
-		     {var = exnName,
-		      ty = Type.arrow (Type.exn, Type.string),
-		      exp =
-		      let
-			 val exn = Var.newNoname ()
-		      in
-			 Lambda
-			 (Lambda.make
-			  {arg = exn,
-			   argType = Type.exn,
-			   mayInline = true,
-			   body =
-			   let
-			      open Dexp
-			   in toExp
-			      (extract
-			       (exn, Type.string, fn tuple =>
-				casee
-				{test = extractSum tuple,
-				 cases =
-				 Cases.Con
-				 (Vector.map
-				  (cons, fn {con, arg} =>
-				   (Pat.T {con = con,
-					   targs = Vector.new0 (),
-					   arg = SOME (Var.newNoname (), arg)},
-				    const
-				    (Const.string
-				     (Con.originalName con))))),
-				 default = NONE,
-				 ty = Type.string}))
-			   end})
-		       end}
-	       in
-		  (Vector.concat
-		   [Vector.new1
-		    {tycon = sumTycon,
-		     tyvars = Vector.new0 (),
-		     cons = Vector.map (cons, fn {con, arg} =>
-					{con = con, arg = SOME arg})},
-		    extraDatatypes,
-		    datatypes],
-		   Exp.prefix (body, exnNameDec))
-	       end
+         case !exnValCons of
+            [] => (datatypes, body)
+          | cons =>
+               let
+                  val cons = Vector.fromList cons
+                  val exnNameDec =
+                     MonoVal
+                     {var = exnName,
+                      ty = Type.arrow (Type.exn, Type.string),
+                      exp =
+                      let
+                         val exn = Var.newNoname ()
+                      in
+                         Lambda
+                         (Lambda.make
+                          {arg = exn,
+                           argType = Type.exn,
+                           mayInline = true,
+                           body =
+                           let
+                              open Dexp
+                           in toExp
+                              (extract
+                               (exn, Type.string, fn tuple =>
+                                casee
+                                {test = extractSum tuple,
+                                 cases =
+                                 Cases.Con
+                                 (Vector.map
+                                  (cons, fn {con, arg} =>
+                                   (Pat.T {con = con,
+                                           targs = Vector.new0 (),
+                                           arg = SOME (Var.newNoname (), arg)},
+                                    const
+                                    (Const.string
+                                     (Con.originalName con))))),
+                                 default = NONE,
+                                 ty = Type.string}))
+                           end})
+                       end}
+               in
+                  (Vector.concat
+                   [Vector.new1
+                    {tycon = sumTycon,
+                     tyvars = Vector.new0 (),
+                     cons = Vector.map (cons, fn {con, arg} =>
+                                        {con = con, arg = SOME arg})},
+                    extraDatatypes,
+                    datatypes],
+                   Exp.prefix (body, exnNameDec))
+               end
       val body =
-	 Exp.fromPrimExp
-	 (Handle {try = body,
-		  catch = (Var.newNoname (), Type.exn),
-		  handler =
-		  let
-		     val s = Var.newNoname ()
-		  in Exp.prefix
-		     (Exp.fromPrimExp
-		      (PrimApp {prim = Prim.bug,
-				targs = Vector.new1 Type.unit,
-				args = Vector.new1 (VarExp.mono s)},
-		       Type.unit),
-		      MonoVal {var = s,
-			       ty = Type.string,
-			       exp = Const (Const.string
-					    "toplevel handler not installed")})
-		  end},
-	  Type.unit)
+         Exp.fromPrimExp
+         (Handle {try = body,
+                  catch = (Var.newNoname (), Type.exn),
+                  handler =
+                  let
+                     val s = Var.newNoname ()
+                  in Exp.prefix
+                     (Exp.fromPrimExp
+                      (PrimApp {prim = Prim.bug,
+                                targs = Vector.new1 Type.unit,
+                                args = Vector.new1 (VarExp.mono s)},
+                       Type.unit),
+                      MonoVal {var = s,
+                               ty = Type.string,
+                               exp = Const (Const.string
+                                            "toplevel handler not installed")})
+                  end},
+          Type.unit)
       val program =
-	 Program.T {datatypes = datatypes,
-		    body = body,
-		    overflow = !overflow}
+         Program.T {datatypes = datatypes,
+                    body = body,
+                    overflow = !overflow}
       val _ = destroy ()
    in
       program

Modified: mlton/branches/on-20050420-cmm-branch/mlton/xml/implement-exceptions.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/xml/implement-exceptions.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/xml/implement-exceptions.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature IMPLEMENT_EXCEPTIONS_STRUCTS = 
    sig
       include SXML_TREE

Modified: mlton/branches/on-20050420-cmm-branch/mlton/xml/implement-suffix.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/xml/implement-suffix.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/xml/implement-suffix.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 functor ImplementSuffix (S: IMPLEMENT_SUFFIX_STRUCTS):
    IMPLEMENT_SUFFIX = 
 struct
@@ -22,98 +23,98 @@
       val topLevelSuffix = Var.newNoname ()
 
       fun loop (e: Exp.t): Exp.t =
-	 let
-	    val {decs, result} = Exp.dest e
-	    val decs = List.rev (List.fold (decs, [], fn (d, ds) =>
-					    loopDec d :: ds))
-	 in
-	    Exp.make {decs = decs,
-		      result = result}
-	 end
+         let
+            val {decs, result} = Exp.dest e
+            val decs = List.rev (List.fold (decs, [], fn (d, ds) =>
+                                            loopDec d :: ds))
+         in
+            Exp.make {decs = decs,
+                      result = result}
+         end
       and loopDec (dec: Dec.t): Dec.t =
-	 case dec of
-	    MonoVal b => loopMonoVal b
-	  | Fun {decs, ...} =>
-	       Fun {tyvars = Vector.new0 (),
-		    decs = Vector.map (decs, fn {var, ty, lambda} =>
-				       {var = var,
-					ty = ty,
-					lambda = loopLambda lambda})}
-	  | Exception {...} => dec
-	  | _ => Error.bug "implement suffix saw unexpected dec"
+         case dec of
+            MonoVal b => loopMonoVal b
+          | Fun {decs, ...} =>
+               Fun {tyvars = Vector.new0 (),
+                    decs = Vector.map (decs, fn {var, ty, lambda} =>
+                                       {var = var,
+                                        ty = ty,
+                                        lambda = loopLambda lambda})}
+          | Exception {...} => dec
+          | _ => Error.bug "ImplementSuffix: saw unexpected dec"
       and loopMonoVal {var, ty, exp} : Dec.t =
-	 let
-	    fun primExp e = MonoVal {var = var, ty = ty, exp = e}
-	    fun keep () = primExp exp
-	 in
-	    case exp of
-	       Case {test, cases, default} =>
-		  primExp (Case {cases = Cases.map (cases, loop),
-				 default = (Option.map
-					    (default, fn (e, r) =>
-					     (loop e, r))),
-				 test = test})
-	     | ConApp {...} => keep ()
-	     | Handle {try, catch = (catch, ty), handler} =>
-		  primExp (Handle {try = loop try,
-				   catch = (catch, ty),
-				   handler = loop handler})
-	     | Lambda l => primExp (Lambda (loopLambda l))
-	     | PrimApp {args, prim, ...} =>
-		  let
-		     datatype z = datatype Prim.Name.t
-		     fun assign (var, ty) =
-			primExp
-			(PrimApp {prim = Prim.assign,
-				  targs = Vector.new1 ty,
-				  args = Vector.new2 (VarExp.mono var,
-						      Vector.sub (args, 0))})
-		  in
-		     case Prim.name prim of
-			TopLevel_setSuffix =>
-			   assign (topLevelSuffix,
-				   Type.arrow (Type.unit, Type.unit))
-		      | _ => keep ()
-		  end
-	     | _ => keep ()
-	 end
+         let
+            fun primExp e = MonoVal {var = var, ty = ty, exp = e}
+            fun keep () = primExp exp
+         in
+            case exp of
+               Case {test, cases, default} =>
+                  primExp (Case {cases = Cases.map (cases, loop),
+                                 default = (Option.map
+                                            (default, fn (e, r) =>
+                                             (loop e, r))),
+                                 test = test})
+             | ConApp {...} => keep ()
+             | Handle {try, catch = (catch, ty), handler} =>
+                  primExp (Handle {try = loop try,
+                                   catch = (catch, ty),
+                                   handler = loop handler})
+             | Lambda l => primExp (Lambda (loopLambda l))
+             | PrimApp {args, prim, ...} =>
+                  let
+                     datatype z = datatype Prim.Name.t
+                     fun assign (var, ty) =
+                        primExp
+                        (PrimApp {prim = Prim.assign,
+                                  targs = Vector.new1 ty,
+                                  args = Vector.new2 (VarExp.mono var,
+                                                      Vector.sub (args, 0))})
+                  in
+                     case Prim.name prim of
+                        TopLevel_setSuffix =>
+                           assign (topLevelSuffix,
+                                   Type.arrow (Type.unit, Type.unit))
+                      | _ => keep ()
+                  end
+             | _ => keep ()
+         end
       and loopLambda l =
-	 let
-	    val {arg, argType, body, mayInline} = Lambda.dest l
-	 in
-	    Lambda.make {arg = arg,
-			 argType = argType,
-			 body = loop body,
-			 mayInline = mayInline}
-	 end
+         let
+            val {arg, argType, body, mayInline} = Lambda.dest l
+         in
+            Lambda.make {arg = arg,
+                         argType = argType,
+                         body = loop body,
+                         mayInline = mayInline}
+         end
       fun bug s =
-	 Dexp.primApp {prim = Prim.bug,
-		       targs = Vector.new1 Type.unit,
-		       args = Vector.new1 (Dexp.string s),
-		       ty = Type.unit}
+         Dexp.primApp {prim = Prim.bug,
+                       targs = Vector.new1 Type.unit,
+                       args = Vector.new1 (Dexp.string s),
+                       ty = Type.unit}
       val body =
-	 Dexp.let1
-	 {var = topLevelSuffix,
-	  exp = Dexp.reff (Dexp.lambda
-			   {arg = Var.newNoname (),
-			    argType = Type.unit,
-			    body = bug "toplevel suffix not installed",
-			    bodyType = Type.unit,
-			    mayInline = true}),
-	  body =
-	  (Dexp.sequence o Vector.new2)
-	  (Dexp.fromExp (loop body, Type.unit),
-	   Dexp.app {func = (Dexp.deref 
-			     (Dexp.monoVar
-			      (topLevelSuffix,
-			       let open Type
-			       in reff (arrow (unit, unit))
-			       end))),
-		     arg = Dexp.unit (),
-		     ty = Type.unit})}
+         Dexp.let1
+         {var = topLevelSuffix,
+          exp = Dexp.reff (Dexp.lambda
+                           {arg = Var.newNoname (),
+                            argType = Type.unit,
+                            body = bug "toplevel suffix not installed",
+                            bodyType = Type.unit,
+                            mayInline = true}),
+          body =
+          (Dexp.sequence o Vector.new2)
+          (Dexp.fromExp (loop body, Type.unit),
+           Dexp.app {func = (Dexp.deref 
+                             (Dexp.monoVar
+                              (topLevelSuffix,
+                               let open Type
+                               in reff (arrow (unit, unit))
+                               end))),
+                     arg = Dexp.unit (),
+                     ty = Type.unit})}
    in
       Program.T {datatypes = datatypes,
-		 body = Dexp.toExp body,
-		 overflow = overflow}
+                 body = Dexp.toExp body,
+                 overflow = overflow}
    end
 end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/xml/implement-suffix.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/xml/implement-suffix.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/xml/implement-suffix.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature IMPLEMENT_SUFFIX_STRUCTS = 
    sig
       include SXML_TREE

Modified: mlton/branches/on-20050420-cmm-branch/mlton/xml/monomorphise.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/xml/monomorphise.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/xml/monomorphise.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 functor Monomorphise (S: MONOMORPHISE_STRUCTS): MONOMORPHISE =
 struct
 
@@ -45,373 +46,378 @@
       val toList: 'a t -> (Stype.t vector * 'a) list
    end =
    struct
-      (* use a splay tree based on lexicographic ordering of vectors of hash
-       * values of types.  Use an alist (i.e. polycache) within each bucket
-       * of the splay tree
-       *)
-      structure Cache = PolyCache
-	       
-      structure S =
-	 SplayMapFn
-	 (type ord_key = Stype.t vector
-	  val compare =
-	     fn (ts, ts') =>
-	     Vector.compare (ts, ts',
-			     fn (t, t') =>
-			     Word.compare (Stype.hash t,
-					   Stype.hash t')))
+      type 'a t = (Stype.t vector * Word.t * 'a) HashSet.t
 
-      type 'a t = (Stype.t vector, 'a) Cache.t S.map ref
-
-      fun new () : 'a t = ref S.empty
-
       local
-	 fun equal (v, v') =
-	    Vector.equals (v, v', Stype.equals)
+         val generator: Word.t = 0wx5555
+         val base = Random.word ()
       in
-	 fun getOrAdd (m, k, th) =
-	    case S.find (!m, k) of
-	       NONE => let
-			  val x = th ()
-			  val cache =
-			     Cache.fromList {equal = equal, 
-					     elements = [(k, x)]}
-		       in m := S.insert (!m, k, cache); x
-		       end
-	     | SOME cache => Cache.getOrAdd (cache, k, th)
+         fun hash ts =
+            Vector.fold (ts, base, fn (t, w) =>
+                         Word.xorb (w * generator, Stype.hash t))
+         fun equal (ts, ts') =
+            Vector.equals (ts, ts', Stype.equals)
       end
-	 
-      fun toList c =
-	 List.fold (S.listItems (! c), [], fn (cache, items) =>
-		    Cache.toList cache @ items)
+
+      fun new () : 'a t = HashSet.new {hash = #2}
+
+      fun getOrAdd (c, ts, th) =
+         let
+            val hash = hash ts
+         in
+            (#3 o HashSet.lookupOrInsert)
+            (c, hash, fn (ts', _, _) => equal (ts, ts'), 
+             fn () => (ts, hash, th ()))
+         end
+
+      fun toList c = HashSet.fold (c, [], fn ((ts, _, v), l) => (ts, v) :: l)
    end
 
 fun monomorphise (Xprogram.T {datatypes, body, ...}): Sprogram.t =
    let
       val {get = getVar: Var.t -> Stype.t vector -> SvarExp.t,
-	   set = setVar, ...} =
-	 Property.getSet (Var.plist, Property.initRaise ("var", Var.layout))
+           set = setVar, ...} =
+         Property.getSet (Var.plist, Property.initRaise ("var", Var.layout))
       val setVar =
-	 Trace.trace2 ("setVar", Var.layout, Layout.ignore, Unit.layout) setVar
+         Trace.trace2 
+         ("Monomorphise.setVar", Var.layout, Layout.ignore, Unit.layout) 
+         setVar
       val getVar =
-	 Trace.trace ("getVar", Var.layout, Layout.ignore) getVar
+         Trace.trace 
+         ("Monomorphise.getVar", Var.layout, Layout.ignore) 
+         getVar
       val {get = getCon: Con.t -> (Stype.t vector -> Con.t),
-	   set = setCon, destroy = destroyCon} =
-	 Property.destGetSet (Con.plist, Property.initRaise ("mono", Con.layout))
+           set = setCon, destroy = destroyCon} =
+         Property.destGetSet (Con.plist, Property.initRaise ("mono", Con.layout))
       val {get = getTycon: Tycon.t -> Stype.t vector -> Stype.t,
-	   set = setTycon, destroy = destroyTycon} =
-	 Property.destGetSet (Tycon.plist,
-			      Property.initRaise ("mono", Tycon.layout))
+           set = setTycon, destroy = destroyTycon} =
+         Property.destGetSet (Tycon.plist,
+                              Property.initRaise ("mono", Tycon.layout))
       val _ =
-	 List.foreach (Tycon.prims, fn (t, _, _) =>
-		       setTycon (t, fn ts => Stype.con (t, ts)))
+         List.foreach (Tycon.prims, fn (t, _, _) =>
+                       setTycon (t, fn ts => Stype.con (t, ts)))
       val {set = setTyvar, get = getTyvar: Tyvar.t -> Stype.t, ...} =
-	 Property.getSet (Tyvar.plist,
-			  Property.initRaise ("tyvar", Tyvar.layout))
+         Property.getSet (Tyvar.plist,
+                          Property.initRaise ("tyvar", Tyvar.layout))
       val getTyvar =
-	 Trace.trace ("getTyvar", Tyvar.layout, Stype.layout) getTyvar
+         Trace.trace 
+         ("Monomorphise.getTyvar", Tyvar.layout, Stype.layout) 
+         getTyvar
       val setTyvar =
-	 Trace.trace2 ("setTyvar", Tyvar.layout, Stype.layout, Unit.layout)
-	 setTyvar
+         Trace.trace2 
+         ("Monomorphise.setTyvar", Tyvar.layout, Stype.layout, Unit.layout)
+         setTyvar
       fun setTyvars (tyvs, tys) = Vector.foreach2 (tyvs, tys, setTyvar)
       fun monoType (t: Xtype.t): Stype.t =
-	 Xtype.hom {ty = t,
-		    var = getTyvar,
-		    con = fn (c, ts) => getTycon c ts}
+         Xtype.hom {ty = t,
+                    var = getTyvar,
+                    con = fn (c, ts) => getTycon c ts}
       val monoType =
-	 Trace.trace ("monoType", Xtype.layout, Stype.layout) monoType
+         Trace.trace 
+         ("Monomorphise.monoType", Xtype.layout, Stype.layout) 
+         monoType
       fun monoTypeOpt (to: Xtype.t option): Stype.t option =
-	 case to of
-	    NONE => NONE
-	  | SOME t => SOME (monoType t)
+         case to of
+            NONE => NONE
+          | SOME t => SOME (monoType t)
       fun monoTypes ts = Vector.map (ts, monoType)
       fun monoCon (c: Con.t, ts: Xtype.t vector): Con.t = getCon c (monoTypes ts)
       val monoCon =
-	 Trace.trace2 ("monoCon", Con.layout, Vector.layout Xtype.layout,
-		       Con.layout)
-	 monoCon
+         Trace.trace2 
+         ("Monomorphise.monoCon", 
+          Con.layout, Vector.layout Xtype.layout, Con.layout)
+         monoCon
       (* It is necessary to create new variables for monomorphic variables
        * because they still may have type variables in their type.
        *)
       fun renameMono (x, t) =
-	 let
-	    val x' = Var.new x
-	    val ve = SvarExp.mono x'
-	    fun inst ts =
-	       if 0 = Vector.length ts
-		  then ve
-	       else Error.bug "monomorphise: expected monomorphic instance"
-	    val _ = setVar (x, inst)
-	 in
-	    (x', monoType t)
-	 end
+         let
+            val x' = Var.new x
+            val ve = SvarExp.mono x'
+            fun inst ts =
+               if 0 = Vector.length ts
+                  then ve
+               else Error.bug "Monomorphise.renameMono: expected monomorphic instance"
+            val _ = setVar (x, inst)
+         in
+            (x', monoType t)
+         end
       val renameMono =
-      	 Trace.trace2 ("renameMono", Var.layout, Xtype.layout,
-		       Layout.tuple2 (Var.layout, Stype.layout)) renameMono
+         Trace.trace2 
+         ("Monomorphise.renameMono", 
+          Var.layout, Xtype.layout, Layout.tuple2 (Var.layout, Stype.layout)) 
+         renameMono
       fun monoPat (Xpat.T {con, targs, arg}): Spat.t =
-	 let
-	    val con = monoCon (con, targs)
-	 in
-	    Spat.T {con = con, targs = Vector.new0 (),
-		    arg = (case arg of
-			      NONE => NONE
-			    | SOME x => SOME (renameMono x))}
-	 end
-      val monoPat = Trace.trace ("monoPat", Xpat.layout, Spat.layout) monoPat
+         let
+            val con = monoCon (con, targs)
+         in
+            Spat.T {con = con, targs = Vector.new0 (),
+                    arg = (case arg of
+                              NONE => NONE
+                            | SOME x => SOME (renameMono x))}
+         end
+      val monoPat = 
+         Trace.trace 
+         ("Monomorphise.monoPat", Xpat.layout, Spat.layout) 
+         monoPat
       val traceMonoExp =
-	 Trace.trace ("monoExp", Xexp.layout, Sexp.layout)
+         Trace.trace 
+         ("Monomorphise.monoExp", Xexp.layout, Sexp.layout)
       val traceMonoDec =
-	 Trace.trace ("monoDec", Xdec.layout,
-		      fn (_: unit -> Sdec.t list) => Layout.empty)
+         Trace.trace 
+         ("Monomorphise.monoDec", 
+          Xdec.layout, fn (_: unit -> Sdec.t list) => Layout.empty)
       (*------------------------------------*)
       (*             datatypes              *)
       (*------------------------------------*)
       val newDbs: {tyvars: Tyvar.t vector,
-		   types: Stype.t vector,
-		   tycon: Tycon.t,
-		   ty: Stype.t,
-		   cons: {con: Con.t,
-			  typ: Xtype.t option,
-			  used: bool} ref vector} list ref = ref []
+                   types: Stype.t vector,
+                   tycon: Tycon.t,
+                   ty: Stype.t,
+                   cons: {con: Con.t,
+                          typ: Xtype.t option,
+                          used: bool} ref vector} list ref = ref []
       val _ =
-	 Vector.foreach
-	 (datatypes, fn {tyvars, tycon, cons} =>
-	  let
-	     val cache = Cache.new ()
-	     fun instantiate ts =
-		Cache.getOrAdd
-		(cache, ts, fn () =>
-		 let
-		    val (tycon, cons) =
-		       if Tycon.equals (tycon, Tycon.bool)
-			  then (tycon,
-				Vector.map (cons, fn {con, ...} =>
-					    ref {con = con, typ = NONE,
-						 used = true}))
-		       else 
-			  (Tycon.new tycon,
-			   Vector.map (cons, fn {con, arg} =>
-				       ref {con = con, typ = arg,
-					    used = false}))
-		    val db =
-		       {tyvars = tyvars,
-			types = ts,
-			tycon = tycon,
-			ty = Stype.con (tycon, Vector.new0 ()),
-			cons = cons}
-		    val _ = List.push (newDbs, db)
-		 in
-		    db
-		 end)
-	     val _ = setTycon (tycon, #ty o instantiate)
-	     val _ =
-		Vector.foreachi
-		(cons, fn (n, {con, ...}) =>
-		 setCon (con, fn ts =>
-			 let
-			    val r as ref {con, typ, used} =
-			       Vector.sub (#cons (instantiate ts), n)
-			 in if used then con
-			    else let val con = Con.new con
-				 in r := {con = con, typ = typ,
-					  used = true}
-				    ; con
-				 end
-			 end))
-	  in ()
-	  end)
+         Vector.foreach
+         (datatypes, fn {tyvars, tycon, cons} =>
+          let
+             val cache = Cache.new ()
+             fun instantiate ts =
+                Cache.getOrAdd
+                (cache, ts, fn () =>
+                 let
+                    val (tycon, cons) =
+                       if Tycon.equals (tycon, Tycon.bool)
+                          then (tycon,
+                                Vector.map (cons, fn {con, ...} =>
+                                            ref {con = con, typ = NONE,
+                                                 used = true}))
+                       else 
+                          (Tycon.new tycon,
+                           Vector.map (cons, fn {con, arg} =>
+                                       ref {con = con, typ = arg,
+                                            used = false}))
+                    val db =
+                       {tyvars = tyvars,
+                        types = ts,
+                        tycon = tycon,
+                        ty = Stype.con (tycon, Vector.new0 ()),
+                        cons = cons}
+                    val _ = List.push (newDbs, db)
+                 in
+                    db
+                 end)
+             val _ = setTycon (tycon, #ty o instantiate)
+             val _ =
+                Vector.foreachi
+                (cons, fn (n, {con, ...}) =>
+                 setCon (con, fn ts =>
+                         let
+                            val r as ref {con, typ, used} =
+                               Vector.sub (#cons (instantiate ts), n)
+                         in if used then con
+                            else let val con = Con.new con
+                                 in r := {con = con, typ = typ,
+                                          used = true}
+                                    ; con
+                                 end
+                         end))
+          in ()
+          end)
       val _ = monoCon (Con.truee, Vector.new0 ())
       val _ = monoCon (Con.falsee, Vector.new0 ())
       fun finishDbs ac =
-	 let
-	    val dbs = !newDbs
-	    val _ = newDbs := []
-	 in case dbs of
-	    [] => ac
-	  | _ =>
-	       finishDbs
-	       (List.fold
-		(dbs, ac,
-		 fn ({tyvars, types, tycon, cons, ...}, ac) =>
-		 let
-		    val cons =
-		       Vector.keepAllMap
-		       (cons, fn ref {con, typ, used} =>
-			if used
-			   then (setTyvars (tyvars, types)
-				 ; SOME {con = con,
-					 arg = monoTypeOpt typ})
-			else NONE)
-		    val cons =
-		       if Vector.isEmpty cons
-			  then Vector.new1 {con = Con.newNoname (), arg = NONE}
-		       else cons
-		 in {tycon = tycon, tyvars = Vector.new0 (), cons = cons}
-		    :: ac
-		 end))
-	 end
+         let
+            val dbs = !newDbs
+            val _ = newDbs := []
+         in case dbs of
+            [] => ac
+          | _ =>
+               finishDbs
+               (List.fold
+                (dbs, ac,
+                 fn ({tyvars, types, tycon, cons, ...}, ac) =>
+                 let
+                    val cons =
+                       Vector.keepAllMap
+                       (cons, fn ref {con, typ, used} =>
+                        if used
+                           then (setTyvars (tyvars, types)
+                                 ; SOME {con = con,
+                                         arg = monoTypeOpt typ})
+                        else NONE)
+                    val cons =
+                       if Vector.isEmpty cons
+                          then Vector.new1 {con = Con.newNoname (), arg = NONE}
+                       else cons
+                 in {tycon = tycon, tyvars = Vector.new0 (), cons = cons}
+                    :: ac
+                 end))
+         end
       (*------------------------------------*)
       (*              monoExp               *)
       (*------------------------------------*)
       fun monoVarExp (XvarExp.T {var, targs}) =
-	 getVar var (monoTypes targs)
+         getVar var (monoTypes targs)
       val monoVarExp =
-       	 Trace.trace ("monoVarExp", XvarExp.layout, SvarExp.layout) monoVarExp
+         Trace.trace 
+         ("Monomorphise.monoVarExp", XvarExp.layout, SvarExp.layout) 
+         monoVarExp
       fun monoVarExps xs = Vector.map (xs, monoVarExp)
       fun monoExp (arg: Xexp.t): Sexp.t =
-	 traceMonoExp
-	 (fn (e: Xexp.t) =>
-	  let
-	     val {decs, result} = Xexp.dest e
-	     val thunks = List.fold (decs, [], fn (d, thunks) =>
-				     monoDec d :: thunks)
-	     val result = monoVarExp result
-	     val decs =
-		List.fold (thunks, [], fn (thunk, decs) => thunk () @ decs)
-	  in
-	     Sexp.make {decs = decs,
-			result = result}
-	  end) arg
+         traceMonoExp
+         (fn (e: Xexp.t) =>
+          let
+             val {decs, result} = Xexp.dest e
+             val thunks = List.fold (decs, [], fn (d, thunks) =>
+                                     monoDec d :: thunks)
+             val result = monoVarExp result
+             val decs =
+                List.fold (thunks, [], fn (thunk, decs) => thunk () @ decs)
+          in
+             Sexp.make {decs = decs,
+                        result = result}
+          end) arg
       and monoPrimExp (e: XprimExp.t): SprimExp.t =
-	 case e of
-	    XprimExp.App {func, arg} =>
-	       SprimExp.App {func = monoVarExp func, arg = monoVarExp arg}
-	  | XprimExp.Case {test, cases, default} =>
-	       let
-		  val cases =
-		     case cases of
-			Xcases.Con cases => 
-			   Scases.Con (Vector.map (cases, fn (pat, exp) =>
-						   (monoPat pat, monoExp exp)))
-		      | Xcases.Word (s, v) =>
-			   Scases.Word
-			   (s, Vector.map (v, fn (c, e) => (c, monoExp e)))
+         case e of
+            XprimExp.App {func, arg} =>
+               SprimExp.App {func = monoVarExp func, arg = monoVarExp arg}
+          | XprimExp.Case {test, cases, default} =>
+               let
+                  val cases =
+                     case cases of
+                        Xcases.Con cases => 
+                           Scases.Con (Vector.map (cases, fn (pat, exp) =>
+                                                   (monoPat pat, monoExp exp)))
+                      | Xcases.Word (s, v) =>
+                           Scases.Word
+                           (s, Vector.map (v, fn (c, e) => (c, monoExp e)))
 
-	       in
-		  SprimExp.Case
-		  {test = monoVarExp test,
-		   cases = cases,
-		   default = Option.map (default, fn (e, r) =>
-					 (monoExp e, r))}
-	       end
-	  | XprimExp.ConApp {con, targs, arg} =>
-	       let val con = monoCon (con, targs)
-	       in SprimExp.ConApp {con = con, targs = Vector.new0 (),
-				   arg = Option.map (arg, monoVarExp)}
-	       end
-	  | XprimExp.Const c => SprimExp.Const c
-	  | XprimExp.Handle {try, catch, handler} =>
-	       SprimExp.Handle {try = monoExp try,
-				catch = renameMono catch,
-				handler = monoExp handler}
-	  | XprimExp.Lambda l => SprimExp.Lambda (monoLambda l)
-	  | XprimExp.PrimApp {prim, targs, args} =>
-	       SprimExp.PrimApp {args = monoVarExps args,
-				 prim = Prim.map (prim, monoType),
-				 targs = monoTypes targs}
-	  | XprimExp.Profile e => SprimExp.Profile  e
-	  | XprimExp.Raise {exn, extend} =>
-	       SprimExp.Raise {exn = monoVarExp exn, extend = extend}
-	  | XprimExp.Select {tuple, offset} =>
-	       SprimExp.Select {tuple = monoVarExp tuple, offset = offset}
-	  | XprimExp.Tuple xs => SprimExp.Tuple (monoVarExps xs)
-	  | XprimExp.Var x => SprimExp.Var (monoVarExp x)
+               in
+                  SprimExp.Case
+                  {test = monoVarExp test,
+                   cases = cases,
+                   default = Option.map (default, fn (e, r) =>
+                                         (monoExp e, r))}
+               end
+          | XprimExp.ConApp {con, targs, arg} =>
+               let val con = monoCon (con, targs)
+               in SprimExp.ConApp {con = con, targs = Vector.new0 (),
+                                   arg = Option.map (arg, monoVarExp)}
+               end
+          | XprimExp.Const c => SprimExp.Const c
+          | XprimExp.Handle {try, catch, handler} =>
+               SprimExp.Handle {try = monoExp try,
+                                catch = renameMono catch,
+                                handler = monoExp handler}
+          | XprimExp.Lambda l => SprimExp.Lambda (monoLambda l)
+          | XprimExp.PrimApp {prim, targs, args} =>
+               SprimExp.PrimApp {args = monoVarExps args,
+                                 prim = Prim.map (prim, monoType),
+                                 targs = monoTypes targs}
+          | XprimExp.Profile e => SprimExp.Profile  e
+          | XprimExp.Raise {exn, extend} =>
+               SprimExp.Raise {exn = monoVarExp exn, extend = extend}
+          | XprimExp.Select {tuple, offset} =>
+               SprimExp.Select {tuple = monoVarExp tuple, offset = offset}
+          | XprimExp.Tuple xs => SprimExp.Tuple (monoVarExps xs)
+          | XprimExp.Var x => SprimExp.Var (monoVarExp x)
       and monoLambda l: Slambda.t =
-	 let
-	    val {arg, argType, body, mayInline} = Xlambda.dest l
-	    val (arg, argType) = renameMono (arg, argType)
-	 in
-	    Slambda.make {arg = arg,
-			  argType = argType,
-			  body = monoExp body,
-			  mayInline = mayInline}
-	 end
+         let
+            val {arg, argType, body, mayInline} = Xlambda.dest l
+            val (arg, argType) = renameMono (arg, argType)
+         in
+            Slambda.make {arg = arg,
+                          argType = argType,
+                          body = monoExp body,
+                          mayInline = mayInline}
+         end
       (*------------------------------------*)
       (*              monoDec               *)
       (*------------------------------------*)
       and monoDec arg: unit -> Sdec.t list =
-	 traceMonoDec
-	 (fn Xdec.MonoVal {var, ty, exp} =>
-	  let
-	     val (var, _) = renameMono (var, ty)
-	  in fn () => [Sdec.MonoVal {var = var,
-				     ty = monoType ty,
-				     exp = monoPrimExp exp}]
-	  end
+         traceMonoDec
+         (fn Xdec.MonoVal {var, ty, exp} =>
+          let
+             val (var, _) = renameMono (var, ty)
+          in fn () => [Sdec.MonoVal {var = var,
+                                     ty = monoType ty,
+                                     exp = monoPrimExp exp}]
+          end
        | Xdec.PolyVal {var, tyvars, ty, exp} =>
-	    let
-	       val cache = Cache.new ()
-	       val _ =
-		  setVar (var, fn ts =>
-			  (setTyvars (tyvars, ts)
-			   ; Cache.getOrAdd (cache, ts, fn () =>
-					     SvarExp.mono (Var.new var))))
-	    in
-	       fn () =>
-	       List.fold
-	       (Cache.toList cache, [], fn ((ts, ve), decs) =>
-		(setTyvars (tyvars, ts)
-		 ; let val {decs = decs', result} = Sexp.dest (monoExp exp)
-		   in decs'
-		      @ (Sdec.MonoVal {var = SvarExp.var ve,
-				       ty = monoType ty,
-				       exp = SprimExp.Var result} :: decs)
-		   end))
-	    end
+            let
+               val cache = Cache.new ()
+               val _ =
+                  setVar (var, fn ts =>
+                          (setTyvars (tyvars, ts)
+                           ; Cache.getOrAdd (cache, ts, fn () =>
+                                             SvarExp.mono (Var.new var))))
+            in
+               fn () =>
+               List.fold
+               (Cache.toList cache, [], fn ((ts, ve), decs) =>
+                (setTyvars (tyvars, ts)
+                 ; let val {decs = decs', result} = Sexp.dest (monoExp exp)
+                   in decs'
+                      @ (Sdec.MonoVal {var = SvarExp.var ve,
+                                       ty = monoType ty,
+                                       exp = SprimExp.Var result} :: decs)
+                   end))
+            end
        | Xdec.Fun {tyvars, decs} =>
-	    let
-	       val cache = Cache.new ()
-	       val _ =
-		  Vector.foreachi
-		  (decs, fn (n, {var, ...}) =>
-		   setVar
-		   (var, fn ts =>
-		    (setTyvars (tyvars, ts)
-		     ; Vector.sub (Cache.getOrAdd
-				   (cache, ts, fn () =>
-				    Vector.map (decs,
-						SvarExp.mono o Var.new o #var)),
-				   n))))
-	    in fn () =>
-	       List.revMap
-	       (Cache.toList cache, fn (ts, xs) =>
-		(setTyvars (tyvars, ts)
-		 ; Vector.foreach2 (decs, xs, fn ({var, ...}, var') =>
-				    setVar (var, fn _ => var'))
-		 ; (Sdec.Fun
-		    {tyvars = Vector.new0 (),
-		     decs = (Vector.map2
-			     (decs, xs, fn ({ty, lambda, ...}, ve) =>
-			      {var = SvarExp.var ve,
-			       ty = monoType ty,
-			       lambda = monoLambda lambda}))})))
-	    end
+            let
+               val cache = Cache.new ()
+               val _ =
+                  Vector.foreachi
+                  (decs, fn (n, {var, ...}) =>
+                   setVar
+                   (var, fn ts =>
+                    (setTyvars (tyvars, ts)
+                     ; Vector.sub (Cache.getOrAdd
+                                   (cache, ts, fn () =>
+                                    Vector.map (decs,
+                                                SvarExp.mono o Var.new o #var)),
+                                   n))))
+            in fn () =>
+               List.revMap
+               (Cache.toList cache, fn (ts, xs) =>
+                (setTyvars (tyvars, ts)
+                 ; Vector.foreach2 (decs, xs, fn ({var, ...}, var') =>
+                                    setVar (var, fn _ => var'))
+                 ; (Sdec.Fun
+                    {tyvars = Vector.new0 (),
+                     decs = (Vector.map2
+                             (decs, xs, fn ({ty, lambda, ...}, ve) =>
+                              {var = SvarExp.var ve,
+                               ty = monoType ty,
+                               lambda = monoLambda lambda}))})))
+            end
        | Xdec.Exception {con, arg} =>
-	    let
-	       val con' =
-		  if Con.equals (con, Con.overflow)
-		     then
-			(* We avoid renaming Overflow because the closure
-			 * converter needs to recognize it.  This is not
-			 * safe in general, but is OK in this case because
-			 * we know there is only one Overflow excon.
-			 *)
-			con
-		  else Con.new con
-	       val _ = setCon (con, fn _ => con')
-	    in
-	       fn () => [Sdec.Exception {con = con',
-					 arg = monoTypeOpt arg}]
-	    end) arg
+            let
+               val con' =
+                  if Con.equals (con, Con.overflow)
+                     then
+                        (* We avoid renaming Overflow because the closure
+                         * converter needs to recognize it.  This is not
+                         * safe in general, but is OK in this case because
+                         * we know there is only one Overflow excon.
+                         *)
+                        con
+                  else Con.new con
+               val _ = setCon (con, fn _ => con')
+            in
+               fn () => [Sdec.Exception {con = con',
+                                         arg = monoTypeOpt arg}]
+            end) arg
       (*------------------------------------*)
       (*     main code for monomorphise     *)
       (*------------------------------------*)
       val body = monoExp body
       val datatypes = finishDbs []
       val program =
-	 Sprogram.T {datatypes = Vector.fromList datatypes,
-		     body = body,
-		     overflow = NONE}
+         Sprogram.T {datatypes = Vector.fromList datatypes,
+                     body = body,
+                     overflow = NONE}
       val _ = Sprogram.clear program
       val _ = destroyCon ()
       val _ = destroyTycon ()

Modified: mlton/branches/on-20050420-cmm-branch/mlton/xml/monomorphise.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/xml/monomorphise.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/xml/monomorphise.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature MONOMORPHISE_STRUCTS = 
    sig
       structure Xml: XML

Modified: mlton/branches/on-20050420-cmm-branch/mlton/xml/polyvariance.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/xml/polyvariance.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/xml/polyvariance.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 (*
  * Duplicate a let bound function at each variable reference
  * if cost is smaller than threshold.
@@ -24,51 +25,55 @@
       fun containsArrow t = containsTycon (t, Tycon.arrow)
 
       fun isHigherOrder t =
-	 case deArrowOpt t of
-	    NONE => false
-	  | SOME (t1, t2) => containsArrow t1 orelse isHigherOrder t2
+         case deArrowOpt t of
+            NONE => false
+          | SOME (t1, t2) => containsArrow t1 orelse isHigherOrder t2
 
-   (*       val isHigherOrder =
-    * 	 Trace.trace ("isHigherOrder", layout, Bool.layout) isHigherOrder
-    *)
+(*
+      val isHigherOrder =
+         Trace.trace 
+         ("Polyvariance.isHigherOrder", layout, Bool.layout) 
+         isHigherOrder
+*)
+
    end
 
 fun lambdaSize (Program.T {body, ...}): Lambda.t -> int =
    let
       val {get = size: Lambda.t -> int, set, ...} =
-	 Property.getSetOnce (Lambda.plist,
-			      Property.initRaise ("size", Lambda.layout))
+         Property.getSetOnce (Lambda.plist,
+                              Property.initRaise ("size", Lambda.layout))
       fun loopExp (e: Exp.t, n: int): int =
-	 List.fold
-	 (Exp.decs e, n, fn (d, n) =>
-	  case d of
-	     MonoVal {exp, ...} => loopPrimExp (exp, n + 1)
-	   | PolyVal {exp, ...} => loopExp (exp, n + 1)
-	   | Fun {decs, ...} => Vector.fold (decs, n, fn ({lambda, ...}, n) =>
-					     loopLambda (lambda, n))
-	   | Exception _ => n + 1)
+         List.fold
+         (Exp.decs e, n, fn (d, n) =>
+          case d of
+             MonoVal {exp, ...} => loopPrimExp (exp, n + 1)
+           | PolyVal {exp, ...} => loopExp (exp, n + 1)
+           | Fun {decs, ...} => Vector.fold (decs, n, fn ({lambda, ...}, n) =>
+                                             loopLambda (lambda, n))
+           | Exception _ => n + 1)
       and loopLambda (l: Lambda.t, n): int =
-	 let val m = loopExp (Lambda.body l, 0)
-	 in set (l, m); m + n
-	 end
+         let val m = loopExp (Lambda.body l, 0)
+         in set (l, m); m + n
+         end
       and loopPrimExp (e: PrimExp.t, n: int): int =
-	 case e of
-	    Case {cases, default, ...} =>
-	       let
-		  val n = n + 1
-	       in
-		  Cases.fold
-		  (cases,
-		   (case default of
-		       NONE => n
-		     | SOME (e, _) => loopExp (e, n)),
-		       fn (e, n) => loopExp (e, n))
-	       end
-	  | Handle {try, handler, ...} =>
-	       loopExp (try, loopExp (handler, n + 1))
-	  | Lambda l => loopLambda (l, n + 1)
-	  | Profile _ => n
-	  | _ => n + 1
+         case e of
+            Case {cases, default, ...} =>
+               let
+                  val n = n + 1
+               in
+                  Cases.fold
+                  (cases,
+                   (case default of
+                       NONE => n
+                     | SOME (e, _) => loopExp (e, n)),
+                       fn (e, n) => loopExp (e, n))
+               end
+          | Handle {try, handler, ...} =>
+               loopExp (try, loopExp (handler, n + 1))
+          | Lambda l => loopLambda (l, n + 1)
+          | Profile _ => n
+          | _ => n + 1
       val _ = loopExp (body, 0)
    in 
       size
@@ -80,345 +85,345 @@
       val costs: (Var.t * int * int * int) list ref = ref []
       val lambdaSize = lambdaSize program
       fun isOK (var: Var.t, size: int, numOccurrences: int): bool =
-	 let val cost = (numOccurrences - 1) * (size - small)
-	 in List.push (costs, (var, size, numOccurrences, cost))
-	    ; cost <= product
-	 end
+         let val cost = (numOccurrences - 1) * (size - small)
+         in List.push (costs, (var, size, numOccurrences, cost))
+            ; cost <= product
+         end
       type info = {numOccurrences: int ref,
-		   shouldDuplicate: bool ref}
+                   shouldDuplicate: bool ref}
       val {get = varInfo: Var.t -> info option, set = setVarInfo, ...} =
-	 Property.getSetOnce (Var.plist, Property.initConst NONE)
+         Property.getSetOnce (Var.plist, Property.initConst NONE)
       fun new {lambda = _, ty, var}: unit =
-	 if Type.isHigherOrder ty
-	    then setVarInfo (var, SOME {numOccurrences = ref 0,
-					shouldDuplicate = ref false})
-	 else ()
+         if Type.isHigherOrder ty
+            then setVarInfo (var, SOME {numOccurrences = ref 0,
+                                        shouldDuplicate = ref false})
+         else ()
       fun loopExp (e: Exp.t, numDuplicates: int): unit =
-	 let
-	    fun loopVar (x: VarExp.t): unit =
-	       case varInfo (VarExp.var x) of
-		  NONE => ()
-		| SOME {numOccurrences, ...} =>
-		     numOccurrences := !numOccurrences + numDuplicates
-	    fun loopVars xs = Vector.foreach (xs, loopVar)
-	    val {decs, result} = Exp.dest e
-	    val rec loopDecs =
-	       fn [] => loopVar result
-		| dec :: decs =>
-		     case dec of
-			MonoVal {var, ty, exp} =>
-			   (case exp of
-			       Lambda l =>
-				  (new {var = var, ty = ty, lambda = l}
-				   ; loopDecs decs
-				   ; let
-					val body = Lambda.body l
-					val numDuplicates =
-					   case varInfo var of
-					      NONE => numDuplicates
-					       | SOME {numOccurrences,
-						       shouldDuplicate} =>
-						 if isOK (var, lambdaSize l,
-							  !numOccurrences)
-						    then (shouldDuplicate := true
-							  ; !numOccurrences)
-						 else numDuplicates
-				     in loopExp (body, numDuplicates)
-				     end)
-			     | _ =>
-				  let
-				     val loopExp =
-					fn e => loopExp (e, numDuplicates)
-				     val _ =
-					case exp of
-					   App {func, arg} =>
-					      (loopVar func; loopVar arg)
-					 | Case {test, cases, default} =>
-					      (loopVar test
-					       ; Cases.foreach (cases, loopExp)
-					       ; (Option.app
-						  (default, loopExp o #1)))
-					 | ConApp {arg, ...} =>
-					      Option.app (arg, loopVar)
-					 | Const _ => ()
-					 | Handle {try, handler, ...} =>
-					      (loopExp try; loopExp handler)
-					 | Lambda _ =>
-					      Error.bug "unexpected Lambda"
-					 | PrimApp {args, ...} => loopVars args
-					 | Profile _ => ()
-					 | Raise {exn, ...} => loopVar exn
-					 | Select {tuple, ...} => loopVar tuple
-					 | Tuple xs => loopVars xs
-					 | Var x => loopVar x
-				  in
-				     loopDecs decs
-				  end)
-		      | Fun {decs = lambdas, ...} =>
-			   let
-			      val _ = (Vector.foreach (lambdas, new)
-				       ; loopDecs decs)
-			      val dups =
-				 Vector.fold
-				 (lambdas, [], fn ({var, lambda, ...}, dups) =>
-				  let val body = Lambda.body lambda
-				  in case varInfo var of
-				     NONE =>
-					(loopExp (body, numDuplicates); dups)
-				   | SOME info =>
-					{body = body,
-					 size = lambdaSize lambda,
-					 info = info} :: dups
-				  end)
-			   in case dups of
-			      [] => ()
-			    | _ => 
-				 let
-				    val size =
-				       List.fold
-				       (dups, 0, fn ({size, ...}, n) => n + size)
-				    val numOccurrences =
-				       List.fold
-				       (dups, 0,
-					fn ({info = {numOccurrences, ...}, ...},
-					    n) => n + !numOccurrences)
-				 in if isOK (if Vector.isEmpty lambdas
-						then Error.bug "empty lambdas"
-					     else
-						#var (Vector.sub (lambdas, 0)),
-					     size, numOccurrences)
-				       then (List.foreach
-					     (dups,
-					      fn {body,
-						  info = {shouldDuplicate, ...},
-						  ...} =>
-					      (shouldDuplicate := true
-					       ; loopExp (body, numOccurrences))))
-				    else
-				       List.foreach
-				       (dups, fn {body, ...} =>
-					loopExp (body, numDuplicates))
-				 end
-			   end
-		      | _ => Error.bug "strange dec"
-	 in loopDecs decs
-	 end
+         let
+            fun loopVar (x: VarExp.t): unit =
+               case varInfo (VarExp.var x) of
+                  NONE => ()
+                | SOME {numOccurrences, ...} =>
+                     numOccurrences := !numOccurrences + numDuplicates
+            fun loopVars xs = Vector.foreach (xs, loopVar)
+            val {decs, result} = Exp.dest e
+            val rec loopDecs =
+               fn [] => loopVar result
+                | dec :: decs =>
+                     case dec of
+                        MonoVal {var, ty, exp} =>
+                           (case exp of
+                               Lambda l =>
+                                  (new {var = var, ty = ty, lambda = l}
+                                   ; loopDecs decs
+                                   ; let
+                                        val body = Lambda.body l
+                                        val numDuplicates =
+                                           case varInfo var of
+                                              NONE => numDuplicates
+                                               | SOME {numOccurrences,
+                                                       shouldDuplicate} =>
+                                                 if isOK (var, lambdaSize l,
+                                                          !numOccurrences)
+                                                    then (shouldDuplicate := true
+                                                          ; !numOccurrences)
+                                                 else numDuplicates
+                                     in loopExp (body, numDuplicates)
+                                     end)
+                             | _ =>
+                                  let
+                                     val loopExp =
+                                        fn e => loopExp (e, numDuplicates)
+                                     val _ =
+                                        case exp of
+                                           App {func, arg} =>
+                                              (loopVar func; loopVar arg)
+                                         | Case {test, cases, default} =>
+                                              (loopVar test
+                                               ; Cases.foreach (cases, loopExp)
+                                               ; (Option.app
+                                                  (default, loopExp o #1)))
+                                         | ConApp {arg, ...} =>
+                                              Option.app (arg, loopVar)
+                                         | Const _ => ()
+                                         | Handle {try, handler, ...} =>
+                                              (loopExp try; loopExp handler)
+                                         | Lambda _ =>
+                                              Error.bug "Polyvariance.loopExp.loopDecs: unexpected Lambda"
+                                         | PrimApp {args, ...} => loopVars args
+                                         | Profile _ => ()
+                                         | Raise {exn, ...} => loopVar exn
+                                         | Select {tuple, ...} => loopVar tuple
+                                         | Tuple xs => loopVars xs
+                                         | Var x => loopVar x
+                                  in
+                                     loopDecs decs
+                                  end)
+                      | Fun {decs = lambdas, ...} =>
+                           let
+                              val _ = (Vector.foreach (lambdas, new)
+                                       ; loopDecs decs)
+                              val dups =
+                                 Vector.fold
+                                 (lambdas, [], fn ({var, lambda, ...}, dups) =>
+                                  let val body = Lambda.body lambda
+                                  in case varInfo var of
+                                     NONE =>
+                                        (loopExp (body, numDuplicates); dups)
+                                   | SOME info =>
+                                        {body = body,
+                                         size = lambdaSize lambda,
+                                         info = info} :: dups
+                                  end)
+                           in case dups of
+                              [] => ()
+                            | _ => 
+                                 let
+                                    val size =
+                                       List.fold
+                                       (dups, 0, fn ({size, ...}, n) => n + size)
+                                    val numOccurrences =
+                                       List.fold
+                                       (dups, 0,
+                                        fn ({info = {numOccurrences, ...}, ...},
+                                            n) => n + !numOccurrences)
+                                 in if isOK (if Vector.isEmpty lambdas
+                                                then Error.bug "Polyvariance.loopExp.loopDecs: empty lambdas"
+                                             else
+                                                #var (Vector.sub (lambdas, 0)),
+                                             size, numOccurrences)
+                                       then (List.foreach
+                                             (dups,
+                                              fn {body,
+                                                  info = {shouldDuplicate, ...},
+                                                  ...} =>
+                                              (shouldDuplicate := true
+                                               ; loopExp (body, numOccurrences))))
+                                    else
+                                       List.foreach
+                                       (dups, fn {body, ...} =>
+                                        loopExp (body, numDuplicates))
+                                 end
+                           end
+                      | _ => Error.bug "Polyvariance.loopExp.loopDecs: strange dec"
+         in loopDecs decs
+         end
       val _ = loopExp (body, 1)
       fun sort l =
-	 List.insertionSort (l, fn ((_, _, _, c), (_, _, _, c')) => c < c')
+         List.insertionSort (l, fn ((_, _, _, c), (_, _, _, c')) => c < c')
       val _ =
-	 Control.diagnostics
-	 (fn layout => 
-	  List.foreach
-	  (sort (!costs), fn (x, size, numOcc, c) =>
-	   layout (let open Layout
-		   in seq [Var.layout x,
-			   str " ", Int.layout size,
-			   str " ", Int.layout numOcc,
-			   str " ", Int.layout c]
-		   end)))
+         Control.diagnostics
+         (fn layout => 
+          List.foreach
+          (sort (!costs), fn (x, size, numOcc, c) =>
+           layout (let open Layout
+                   in seq [Var.layout x,
+                           str " ", Int.layout size,
+                           str " ", Int.layout numOcc,
+                           str " ", Int.layout c]
+                   end)))
    in
       fn x =>
       case varInfo x of
-	 NONE => false
+         NONE => false
        | SOME {shouldDuplicate, ...} => !shouldDuplicate
    end
 
 fun duplicate (program as Program.T {datatypes, body, overflow},
-	       small: int,
-	       product: int) =
+               small: int,
+               product: int) =
    let
       val shouldDuplicate = shouldDuplicate (program, small, product)
       datatype info =
-	 Replace of Var.t
+         Replace of Var.t
        | Dup of {
-		 duplicates: Var.t list ref
-		 }
+                 duplicates: Var.t list ref
+                 }
       val {get = varInfo: Var.t -> info, set = setVarInfo, ...} =
-	 Property.getSet (Var.plist,
-			  Property.initRaise ("Polyvariance.info", Var.layout))
+         Property.getSet (Var.plist,
+                          Property.initRaise ("Polyvariance.info", Var.layout))
       fun loopVar (x: VarExp.t): VarExp.t =
-	 VarExp.mono
-	 (let val x = VarExp.var x
-	  in case varInfo x of
-	     Replace y => y
-	   | Dup {duplicates, ...} =>
-		let val x' = Var.new x
-		in List.push (duplicates, x')
-		   ; x'
-		end
-	  end)
+         VarExp.mono
+         (let val x = VarExp.var x
+          in case varInfo x of
+             Replace y => y
+           | Dup {duplicates, ...} =>
+                let val x' = Var.new x
+                in List.push (duplicates, x')
+                   ; x'
+                end
+          end)
       fun loopVars xs = Vector.map (xs, loopVar)
       fun bind (x: Var.t): Var.t =
-	 let val x' = Var.new x
-	 in setVarInfo (x, Replace x')
-	    ; x'
-	 end
+         let val x' = Var.new x
+         in setVarInfo (x, Replace x')
+            ; x'
+         end
       fun bindVarType (x, t) = (bind x, t)
       fun bindPat (Pat.T {con, targs, arg}) =
-	 Pat.T {con = con,
-		targs = targs,
-		arg = Option.map (arg, bindVarType)}
+         Pat.T {con = con,
+                targs = targs,
+                arg = Option.map (arg, bindVarType)}
       fun new {lambda = _, ty = _, var}: unit =
-	 if shouldDuplicate var
-	    then setVarInfo (var, Dup {duplicates = ref []})
-	 else ignore (bind var)
+         if shouldDuplicate var
+            then setVarInfo (var, Dup {duplicates = ref []})
+         else ignore (bind var)
       fun loopExp (e: Exp.t): Exp.t =
-	 let
-	    val {decs, result} = Exp.dest e
-	 in
-	    Exp.make (loopDecs (decs, result))
-	 end
+         let
+            val {decs, result} = Exp.dest e
+         in
+            Exp.make (loopDecs (decs, result))
+         end
       and loopLambda (l: Lambda.t): Lambda.t =
-	 let
-	    val {arg, argType, body, mayInline} = Lambda.dest l
-	 in
-	    Lambda.make {arg = bind arg,
-			 argType = argType,
-			 body = loopExp body,
-			 mayInline = mayInline}
-	 end
+         let
+            val {arg, argType, body, mayInline} = Lambda.dest l
+         in
+            Lambda.make {arg = bind arg,
+                         argType = argType,
+                         body = loopExp body,
+                         mayInline = mayInline}
+         end
       and loopDecs (ds: Dec.t list, result): {decs: Dec.t list,
-					      result: VarExp.t} =
-	 case ds of
-	    [] => {decs = [], result = loopVar result}
-	  | d :: ds =>
-	       case d of
-		  MonoVal {var, ty, exp} =>
-		     (case exp of
-			 Lambda l =>
-			    let
-			       val _ = new {var = var, ty = ty, lambda = l}
-			       val {decs, result} = loopDecs (ds, result)
-			       val decs =
-				  case varInfo var of
-				     Replace var =>
-					MonoVal {var = var, ty = ty,
-						 exp = Lambda (loopLambda l)}
-					:: decs
-				   | Dup {duplicates, ...} =>
-					List.fold
-					(!duplicates, decs, fn (var, decs) =>
-					 MonoVal {var = var, ty = ty,
-						  exp = Lambda (loopLambda l)}
-					 :: decs)
-			    in {decs = decs, result = result}
-			    end
-		       | _ => 
-			    let
-			       val exp =
-				  case exp of
-				     App {func, arg} =>
-					App {func = loopVar func,
-					     arg = loopVar arg}
-				   | Case {test, cases, default} =>
-					let
-					   datatype z = datatype Cases.t
-					   val cases =
-					      case cases of
-						 Con cases =>
-						    Con
-						    (Vector.map
-						     (cases, fn (p, e) =>
-						      (bindPat p, loopExp e)))
-					       | Word (s, v) =>
-						    Word
-						    (s, (Vector.map
-							 (v, fn (z, e) =>
-							  (z, loopExp e))))
-					in
-					   Case {test = loopVar test,
-						 cases = cases,
-						 default =
-						 Option.map
-						 (default, fn (e, r) =>
-						  (loopExp e, r))}
-					end
-				   | ConApp {con, targs, arg} =>
-					ConApp {con = con,
-						targs = targs,
-						arg = Option.map (arg, loopVar)}
-				   | Const _ => exp
-				   | Handle {try, catch, handler} =>
-					Handle {try = loopExp try,
-						catch = bindVarType catch,
-						handler = loopExp handler}
-				   | Lambda _ =>
-					Error.bug "unexpected Lambda"
-				   | PrimApp {prim, targs, args} =>
-					PrimApp {prim = prim,
-						 targs = targs,
-						 args = loopVars args}
-				   | Profile _ => exp
-				   | Raise {exn, extend} =>
-					Raise {exn = loopVar exn,
-					       extend = extend}
-				   | Select {tuple, offset} =>
-					Select {tuple = loopVar tuple,
-						offset = offset}
-				   | Tuple xs => Tuple (loopVars xs)
-				   | Var x => Var (loopVar x)
-			       val var = bind var
-			       val {decs, result} = loopDecs (ds, result)
-			    in {decs = (MonoVal {var = var, ty = ty, exp = exp}
-					:: decs),
-				result = result}
-			    end)
-		| Fun {decs, ...} =>
-		     let
-			val _ = Vector.foreach (decs, new)
-			val {decs = ds, result} = loopDecs (ds, result)
-			val ac =
-			   ref [Vector.keepAllMap
-				(decs, fn {var, ty, lambda} =>
-				 case varInfo var of
-				    Replace var =>
-				       SOME {var = var, ty = ty,
-					     lambda = loopLambda lambda}
-				  | Dup _ => NONE)]
-			val dups =
-			   Vector.keepAllMap
-			   (decs, fn dec as {var, ...} =>
-			    case varInfo var of
-			       Replace _ => NONE
-			     | Dup {duplicates, ...} => SOME (dec, !duplicates))
-			val _ =
-			   Vector.foreach
-			   (dups, fn ({var, ...}, duplicates) =>
-			    List.foreach
-			    (duplicates, fn var' =>
-			     let
-				val vars =
-				   Vector.map
-				   (dups, fn ({var = var'', ...}, _) =>
-				    if Var.equals (var, var'')
-				       then (setVarInfo (var, Replace var')
-					     ; var')
-				    else bind var'')
-			     in List.push
-				(ac,
-				 Vector.map2
-				 (dups, vars,
-				  fn (({ty, lambda, ...}, _), var) =>
-				  {var = var, ty = ty,
-				   lambda = loopLambda lambda}))
-			     end))
-			val decs = Vector.concat (!ac)
-		     in {decs = Fun {tyvars = Vector.new0 (),
-				     decs = decs} :: ds,
-			 result = result}
-		     end
-		| _ => Error.bug "polyvariance saw bogus dec"
+                                              result: VarExp.t} =
+         case ds of
+            [] => {decs = [], result = loopVar result}
+          | d :: ds =>
+               case d of
+                  MonoVal {var, ty, exp} =>
+                     (case exp of
+                         Lambda l =>
+                            let
+                               val _ = new {var = var, ty = ty, lambda = l}
+                               val {decs, result} = loopDecs (ds, result)
+                               val decs =
+                                  case varInfo var of
+                                     Replace var =>
+                                        MonoVal {var = var, ty = ty,
+                                                 exp = Lambda (loopLambda l)}
+                                        :: decs
+                                   | Dup {duplicates, ...} =>
+                                        List.fold
+                                        (!duplicates, decs, fn (var, decs) =>
+                                         MonoVal {var = var, ty = ty,
+                                                  exp = Lambda (loopLambda l)}
+                                         :: decs)
+                            in {decs = decs, result = result}
+                            end
+                       | _ => 
+                            let
+                               val exp =
+                                  case exp of
+                                     App {func, arg} =>
+                                        App {func = loopVar func,
+                                             arg = loopVar arg}
+                                   | Case {test, cases, default} =>
+                                        let
+                                           datatype z = datatype Cases.t
+                                           val cases =
+                                              case cases of
+                                                 Con cases =>
+                                                    Con
+                                                    (Vector.map
+                                                     (cases, fn (p, e) =>
+                                                      (bindPat p, loopExp e)))
+                                               | Word (s, v) =>
+                                                    Word
+                                                    (s, (Vector.map
+                                                         (v, fn (z, e) =>
+                                                          (z, loopExp e))))
+                                        in
+                                           Case {test = loopVar test,
+                                                 cases = cases,
+                                                 default =
+                                                 Option.map
+                                                 (default, fn (e, r) =>
+                                                  (loopExp e, r))}
+                                        end
+                                   | ConApp {con, targs, arg} =>
+                                        ConApp {con = con,
+                                                targs = targs,
+                                                arg = Option.map (arg, loopVar)}
+                                   | Const _ => exp
+                                   | Handle {try, catch, handler} =>
+                                        Handle {try = loopExp try,
+                                                catch = bindVarType catch,
+                                                handler = loopExp handler}
+                                   | Lambda _ =>
+                                        Error.bug "Polyvariance.loopDecs: unexpected Lambda"
+                                   | PrimApp {prim, targs, args} =>
+                                        PrimApp {prim = prim,
+                                                 targs = targs,
+                                                 args = loopVars args}
+                                   | Profile _ => exp
+                                   | Raise {exn, extend} =>
+                                        Raise {exn = loopVar exn,
+                                               extend = extend}
+                                   | Select {tuple, offset} =>
+                                        Select {tuple = loopVar tuple,
+                                                offset = offset}
+                                   | Tuple xs => Tuple (loopVars xs)
+                                   | Var x => Var (loopVar x)
+                               val var = bind var
+                               val {decs, result} = loopDecs (ds, result)
+                            in {decs = (MonoVal {var = var, ty = ty, exp = exp}
+                                        :: decs),
+                                result = result}
+                            end)
+                | Fun {decs, ...} =>
+                     let
+                        val _ = Vector.foreach (decs, new)
+                        val {decs = ds, result} = loopDecs (ds, result)
+                        val ac =
+                           ref [Vector.keepAllMap
+                                (decs, fn {var, ty, lambda} =>
+                                 case varInfo var of
+                                    Replace var =>
+                                       SOME {var = var, ty = ty,
+                                             lambda = loopLambda lambda}
+                                  | Dup _ => NONE)]
+                        val dups =
+                           Vector.keepAllMap
+                           (decs, fn dec as {var, ...} =>
+                            case varInfo var of
+                               Replace _ => NONE
+                             | Dup {duplicates, ...} => SOME (dec, !duplicates))
+                        val _ =
+                           Vector.foreach
+                           (dups, fn ({var, ...}, duplicates) =>
+                            List.foreach
+                            (duplicates, fn var' =>
+                             let
+                                val vars =
+                                   Vector.map
+                                   (dups, fn ({var = var'', ...}, _) =>
+                                    if Var.equals (var, var'')
+                                       then (setVarInfo (var, Replace var')
+                                             ; var')
+                                    else bind var'')
+                             in List.push
+                                (ac,
+                                 Vector.map2
+                                 (dups, vars,
+                                  fn (({ty, lambda, ...}, _), var) =>
+                                  {var = var, ty = ty,
+                                   lambda = loopLambda lambda}))
+                             end))
+                        val decs = Vector.concat (!ac)
+                     in {decs = Fun {tyvars = Vector.new0 (),
+                                     decs = decs} :: ds,
+                         result = result}
+                     end
+                | _ => Error.bug "Polyvariance.loopDecs: saw bogus dec"
       val body = loopExp body
       val overflow =
-	 Option.map (overflow, fn x =>
-		     case varInfo x of
-			Replace y => y
-		      | _ => Error.bug "duplicating Overflow?")
+         Option.map (overflow, fn x =>
+                     case varInfo x of
+                        Replace y => y
+                      | _ => Error.bug "Polyvariance.duplicate: duplicating Overflow?")
       val program =
-	 Program.T {datatypes = datatypes,
-		    body = body,
-		    overflow = overflow}
+         Program.T {datatypes = datatypes,
+                    body = body,
+                    overflow = overflow}
       val _ = Program.clear program
    in
       program
@@ -429,19 +434,19 @@
    case !Control.polyvariance of
       NONE => p
     | SOME {rounds, small, product} =>
-	 let
-	    fun loop (p, n) =
-	       if n = 0
-		  then p
-	       else let
-		       val p = shrink (duplicate (p, small, product))
-		       val _ =
-			  Control.message (Control.Detail, fn () =>
-					   Program.layoutStats p)
-		    in
-		       loop (p, n - 1)
-		    end
-	 in loop (p, rounds)
-	 end
+         let
+            fun loop (p, n) =
+               if n = 0
+                  then p
+               else let
+                       val p = shrink (duplicate (p, small, product))
+                       val _ =
+                          Control.message (Control.Detail, fn () =>
+                                           Program.layoutStats p)
+                    in
+                       loop (p, n - 1)
+                    end
+         in loop (p, rounds)
+         end
       
 end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/xml/polyvariance.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/xml/polyvariance.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/xml/polyvariance.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 type int = Int.t
    
 signature POLYVARIANCE_STRUCTS = 

Modified: mlton/branches/on-20050420-cmm-branch/mlton/xml/scc-funs.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/xml/scc-funs.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/xml/scc-funs.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 functor SccFuns (S: SCC_FUNS_STRUCTS): SCC_FUNS = 
 struct
 
@@ -21,112 +22,112 @@
        * if they appear in its body.
        *)
       val {get = funInfo: Var.t -> {
-				    node: unit Node.t,
-				    visit: (unit -> unit) ref
-				    } option,
-	   set = setFunInfo, ...} =
-	 Property.getSetOnce (Var.plist, Property.initConst NONE)
+                                    node: unit Node.t,
+                                    visit: (unit -> unit) ref
+                                    } option,
+           set = setFunInfo, ...} =
+         Property.getSetOnce (Var.plist, Property.initConst NONE)
       val {get = nodeLambda, set = setNodeLambda, ...} =
-	 Property.getSetOnce (Node.plist,
-			      Property.initRaise ("lambda", Node.layout))
+         Property.getSetOnce (Node.plist,
+                              Property.initRaise ("lambda", Node.layout))
       fun loopVar x =
-	 case funInfo x of
-	    NONE => ()
-	  | SOME {visit, ...} => !visit ()
+         case funInfo x of
+            NONE => ()
+          | SOME {visit, ...} => !visit ()
       val loopVarExp = loopVar o VarExp.var
       fun loopVarExps xs = Vector.foreach (xs, loopVarExp)
       fun loopLambda (l: Lambda.t): Lambda.t =
-	 let
-	    val {arg, argType, body, mayInline} = Lambda.dest l
-	 in
-	    Lambda.make {arg = arg,
-			 argType = argType,
-			 body = loopExp body,
-			 mayInline = mayInline}
-	 end
+         let
+            val {arg, argType, body, mayInline} = Lambda.dest l
+         in
+            Lambda.make {arg = arg,
+                         argType = argType,
+                         body = loopExp body,
+                         mayInline = mayInline}
+         end
       and loopPrimExp (e: PrimExp.t): PrimExp.t =
-	 case e of
-	    App {func, arg} => (loopVarExp func; loopVarExp arg; e)
-	  | Case {test, cases, default} =>
-	       (loopVarExp test
-		; Case {cases = Cases.map (cases, loopExp),
-			default = Option.map (default, fn (e, r) =>
-					      (loopExp e, r)),
-			test = test})
-	  | ConApp {arg, ...} => (Option.app (arg, loopVarExp); e)
-	  | Const _ => e
-	  | Handle {try, catch, handler} =>
-	       Handle {try = loopExp try,
-		       catch = catch,
-		       handler = loopExp handler}
-	  | Lambda l => Lambda (loopLambda l)
-	  | PrimApp {args, ...} => (loopVarExps args; e)
-	  | Profile _ => e
-	  | Raise {exn, ...} => (loopVarExp exn; e)
-	  | Select {tuple, ...} => (loopVarExp tuple; e)
-	  | Tuple xs => (loopVarExps xs; e)
-	  | Var x => (loopVarExp x; e)
+         case e of
+            App {func, arg} => (loopVarExp func; loopVarExp arg; e)
+          | Case {test, cases, default} =>
+               (loopVarExp test
+                ; Case {cases = Cases.map (cases, loopExp),
+                        default = Option.map (default, fn (e, r) =>
+                                              (loopExp e, r)),
+                        test = test})
+          | ConApp {arg, ...} => (Option.app (arg, loopVarExp); e)
+          | Const _ => e
+          | Handle {try, catch, handler} =>
+               Handle {try = loopExp try,
+                       catch = catch,
+                       handler = loopExp handler}
+          | Lambda l => Lambda (loopLambda l)
+          | PrimApp {args, ...} => (loopVarExps args; e)
+          | Profile _ => e
+          | Raise {exn, ...} => (loopVarExp exn; e)
+          | Select {tuple, ...} => (loopVarExp tuple; e)
+          | Tuple xs => (loopVarExps xs; e)
+          | Var x => (loopVarExp x; e)
       and loopExp (e: Exp.t): Exp.t =
-	 let
-	    val {decs, result} = Exp.dest e
-	    val decs =
-	       List.rev
-	       (List.fold
-		(decs, [], fn (dec, decs) =>
-		 case dec of
-		    MonoVal {var, ty, exp} =>
-		       MonoVal {var = var, ty = ty,
-				exp = loopPrimExp exp} :: decs
-		  | PolyVal {var, tyvars, ty, exp} =>
-		       PolyVal {var = var, tyvars = tyvars, ty = ty,
-				exp = loopExp exp} :: decs
-		  | Exception _ => dec :: decs
-		  | Fun {tyvars, decs = lambdas} =>
-		       let val g = Graph.new ()
-			  val _ =
-			     Vector.foreach
-			     (lambdas, fn {var, ...} =>
-			      setFunInfo (var, SOME {node = Graph.newNode g,
-						     visit = ref ignore}))
-			  val _ = 
-			     Vector.foreach
-			     (lambdas, fn {var, ty, lambda} =>
-			      let val {node = from, ...} = valOf (funInfo var)
-			      in Vector.foreach
-				 (lambdas, fn {var = x, ...} =>
-				  let val {visit, node = to} = valOf (funInfo x)
-				  in visit := (fn () =>
-					       let
-						  val _ = Graph.addEdge
-						          (g, {from = from, to = to})
-					       in
-						  visit := ignore
-					       end)
-				  end)
-				 ; (setNodeLambda
-				    (from, {var = var,
-					    ty = ty,
-					    lambda = loopLambda lambda}))
-				 ; (Vector.foreach
-				    (lambdas, fn {var, ...} =>
-				     let val {visit, ...} = valOf (funInfo var)
-				     in visit := ignore
-				     end))
-			      end)
-		       in List.map
-			  (Graph.stronglyConnectedComponents g, fn nodes =>
-			   Fun {tyvars = tyvars,
-				decs = Vector.fromListMap (nodes, nodeLambda)})
-			  @ decs
-		       end))
-	    val _ = loopVarExp result
-	 in
-	    Exp.make {decs = decs, result = result}
-	 end
+         let
+            val {decs, result} = Exp.dest e
+            val decs =
+               List.rev
+               (List.fold
+                (decs, [], fn (dec, decs) =>
+                 case dec of
+                    MonoVal {var, ty, exp} =>
+                       MonoVal {var = var, ty = ty,
+                                exp = loopPrimExp exp} :: decs
+                  | PolyVal {var, tyvars, ty, exp} =>
+                       PolyVal {var = var, tyvars = tyvars, ty = ty,
+                                exp = loopExp exp} :: decs
+                  | Exception _ => dec :: decs
+                  | Fun {tyvars, decs = lambdas} =>
+                       let val g = Graph.new ()
+                          val _ =
+                             Vector.foreach
+                             (lambdas, fn {var, ...} =>
+                              setFunInfo (var, SOME {node = Graph.newNode g,
+                                                     visit = ref ignore}))
+                          val _ = 
+                             Vector.foreach
+                             (lambdas, fn {var, ty, lambda} =>
+                              let val {node = from, ...} = valOf (funInfo var)
+                              in Vector.foreach
+                                 (lambdas, fn {var = x, ...} =>
+                                  let val {visit, node = to} = valOf (funInfo x)
+                                  in visit := (fn () =>
+                                               let
+                                                  val _ = Graph.addEdge
+                                                          (g, {from = from, to = to})
+                                               in
+                                                  visit := ignore
+                                               end)
+                                  end)
+                                 ; (setNodeLambda
+                                    (from, {var = var,
+                                            ty = ty,
+                                            lambda = loopLambda lambda}))
+                                 ; (Vector.foreach
+                                    (lambdas, fn {var, ...} =>
+                                     let val {visit, ...} = valOf (funInfo var)
+                                     in visit := ignore
+                                     end))
+                              end)
+                       in List.map
+                          (Graph.stronglyConnectedComponents g, fn nodes =>
+                           Fun {tyvars = tyvars,
+                                decs = Vector.fromListMap (nodes, nodeLambda)})
+                          @ decs
+                       end))
+            val _ = loopVarExp result
+         in
+            Exp.make {decs = decs, result = result}
+         end
    in
       Program.T {datatypes = datatypes,
-		 body = loopExp body,
-		 overflow = overflow}
+                 body = loopExp body,
+                 overflow = overflow}
    end
 
 end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/xml/scc-funs.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/xml/scc-funs.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/xml/scc-funs.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 (* Compute strongly connected components on fun decs to make them
  * as small as possible.
  *)

Modified: mlton/branches/on-20050420-cmm-branch/mlton/xml/shrink.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/xml/shrink.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/xml/shrink.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 (* This simplifier is based on the following article.
  *   Shrinking Lambda Expressions in Linear Time.
  *   Journal of Functional Programming. Vol 7, no 5, 1997.
@@ -19,84 +20,84 @@
 type int = Int.t
    
 val traceShrinkExp =
-   Trace.trace ("Xml.shrinkExp", Exp.layout, Exp.layout)
+   Trace.trace ("Xml.Shrink.shrinkExp", Exp.layout, Exp.layout)
 
 val traceShrinkLambda =
-   Trace.trace ("Xml.shrinkLambda", Lambda.layout, Lambda.layout)
+   Trace.trace ("Xml.Shrink.shrinkLambda", Lambda.layout, Lambda.layout)
    
 fun inc (r: int ref, n) =
    let val n = !r + n
-   in Assert.assert ("inc", fn () => n >= 0)
+   in Assert.assert ("Xml.Shrink.inc", fn () => n >= 0)
       ; r := n
    end
 
 structure VarInfo =
    struct
       datatype t =
-	 Mono of monoVarInfo
+         Mono of monoVarInfo
        | Poly of VarExp.t
       and value =
-	 ConApp of {con: Con.t,
-		    targs: Type.t vector,
-		    arg: t option}
-	| Const of Const.t
-	| Lambda of {isInlined: bool ref,
-		     lam: Lambda.t}
-	| Tuple of t vector
+         ConApp of {con: Con.t,
+                    targs: Type.t vector,
+                    arg: t option}
+        | Const of Const.t
+        | Lambda of {isInlined: bool ref,
+                     lam: Lambda.t}
+        | Tuple of t vector
       withtype monoVarInfo = {numOccurrences: int ref,
-			      value: value option ref,
-			      varExp: VarExp.t}
+                              value: value option ref,
+                              varExp: VarExp.t}
 
       local
-	 open Layout
+         open Layout
       in
-	 val rec layout =
-	    fn Mono {numOccurrences, value, varExp} =>
-	         record [("numOccurrences", Int.layout (!numOccurrences)),
-			 ("value", Option.layout layoutValue (!value)),
-			 ("varExp", VarExp.layout varExp)]
-	     | Poly x => seq [str "Poly ", VarExp.layout x]
-	 and layoutValue =
-	    fn ConApp {con, arg, ...} =>
-	         seq [Con.layout con,
-		      case arg of
-			 NONE => empty
-		       | SOME i => paren (layout i)]
-	     | Const c => Const.layout c
-	     | Lambda {isInlined, ...} =>
-		  seq [str "Lambda ", Bool.layout (!isInlined)]
-	     | Tuple is => Vector.layout layout is
+         val rec layout =
+            fn Mono {numOccurrences, value, varExp} =>
+                 record [("numOccurrences", Int.layout (!numOccurrences)),
+                         ("value", Option.layout layoutValue (!value)),
+                         ("varExp", VarExp.layout varExp)]
+             | Poly x => seq [str "Poly ", VarExp.layout x]
+         and layoutValue =
+            fn ConApp {con, arg, ...} =>
+                 seq [Con.layout con,
+                      case arg of
+                         NONE => empty
+                       | SOME i => paren (layout i)]
+             | Const c => Const.layout c
+             | Lambda {isInlined, ...} =>
+                  seq [str "Lambda ", Bool.layout (!isInlined)]
+             | Tuple is => Vector.layout layout is
       end
 
       val inc =
-	 fn (i, n) =>
-	 case i of
-	    Mono {numOccurrences = r, ...} => inc (r, n)
-	  | Poly _ => ()
+         fn (i, n) =>
+         case i of
+            Mono {numOccurrences = r, ...} => inc (r, n)
+          | Poly _ => ()
 
       val inc =
-	 Trace.trace2 ("VarInfo.inc", layout, Int.layout, Unit.layout) inc
+         Trace.trace2 ("Xml.Shrink.VarInfo.inc", layout, Int.layout, Unit.layout) inc
 
       fun delete i = inc (i, ~1)
 
-      val delete = Trace.trace ("VarInfo.delete", layout, Unit.layout) delete
-	 
+      val delete = Trace.trace ("Xml.Shrink.VarInfo.delete", layout, Unit.layout) delete
+         
       fun deletes is = Vector.foreach (is, delete)
 
       val varExp =
-	 fn Mono {varExp, ...} => varExp
-	  | Poly x => x
+         fn Mono {varExp, ...} => varExp
+          | Poly x => x
    end
 
 structure InternalVarInfo =
    struct
       datatype t =
-	 VarInfo of VarInfo.t
+         VarInfo of VarInfo.t
        | Self
 
       val layout =
-	 fn VarInfo i => VarInfo.layout i
-	  | Self => Layout.str "self"
+         fn VarInfo i => VarInfo.layout i
+          | Self => Layout.str "self"
    end
 
 structure MonoVarInfo =
@@ -109,14 +110,14 @@
       datatype t = datatype VarInfo.value
 
       fun toPrimExp v =
-	 case v of
-	    ConApp {con, targs, arg} =>
-	       PrimExp.ConApp {con = con,
-			       targs = targs,
-			       arg = Option.map (arg, VarInfo.varExp)}
-	  | Const c => PrimExp.Const c
-	  | Lambda {lam, ...} => PrimExp.Lambda lam
-	  | Tuple vs => PrimExp.Tuple (Vector.map (vs, VarInfo.varExp))
+         case v of
+            ConApp {con, targs, arg} =>
+               PrimExp.ConApp {con = con,
+                               targs = targs,
+                               arg = Option.map (arg, VarInfo.varExp)}
+          | Const c => PrimExp.Const c
+          | Lambda {lam, ...} => PrimExp.Lambda lam
+          | Tuple vs => PrimExp.Tuple (Vector.map (vs, VarInfo.varExp))
    end
 
 fun shrinkOnce (Program.T {datatypes, body, overflow}) =
@@ -125,398 +126,398 @@
        * we can eliminate redundant defaults.
        *)
       val {get = conNumCons: Con.t -> int , set = setConNumCons, ...} =
-	 Property.getSetOnce (Con.plist, Property.initConst ~1)
+         Property.getSetOnce (Con.plist, Property.initConst ~1)
       val _ =
-	 Vector.foreach
-	 (datatypes, fn {cons, ...} =>
-	  let
-	     val n = Vector.length cons
-	  in
-	     Vector.foreach (cons, fn {con, ...} => setConNumCons (con, n))
-	  end)
+         Vector.foreach
+         (datatypes, fn {cons, ...} =>
+          let
+             val n = Vector.length cons
+          in
+             Vector.foreach (cons, fn {con, ...} => setConNumCons (con, n))
+          end)
       fun isExhaustive (cases: exp Cases.t): bool =
-	 case cases of
-	    Cases.Con v =>
-	       ((0 < Vector.length v
-		 andalso (Vector.length v
-			  = conNumCons (Pat.con (#1 (Vector.sub (v, 0)))))))
-	  | _ => false
+         case cases of
+            Cases.Con v =>
+               ((0 < Vector.length v
+                 andalso (Vector.length v
+                          = conNumCons (Pat.con (#1 (Vector.sub (v, 0)))))))
+          | _ => false
       val {get = varInfo: Var.t -> InternalVarInfo.t, set = setVarInfo, ...} =
-	 Property.getSet (Var.plist,
-			  Property.initRaise ("shrink varInfo", Var.layout))
+         Property.getSet (Var.plist,
+                          Property.initRaise ("shrink varInfo", Var.layout))
       val setVarInfo =
-	 Trace.trace2 ("Xml.Shrink.setVarInfo",
-		       Var.layout, InternalVarInfo.layout, Unit.layout)
-	 setVarInfo
+         Trace.trace2 ("Xml.Shrink.setVarInfo",
+                       Var.layout, InternalVarInfo.layout, Unit.layout)
+         setVarInfo
       val varInfo =
-	 Trace.trace ("Xml.Shrink.varInfo", Var.layout, InternalVarInfo.layout)
-	 varInfo
+         Trace.trace ("Xml.Shrink.varInfo", Var.layout, InternalVarInfo.layout)
+         varInfo
       fun monoVarInfo x =
-	 case varInfo x of
-	    InternalVarInfo.VarInfo (VarInfo.Mono i) => i
-	  | _ => Error.bug "monoVarInfo"
+         case varInfo x of
+            InternalVarInfo.VarInfo (VarInfo.Mono i) => i
+          | _ => Error.bug "Xml.Shrink.monoVarInfo"
       fun varExpInfo (x as VarExp.T {var, ...}): VarInfo.t =
-	 case varInfo var of
-	    InternalVarInfo.Self => VarInfo.Poly x
-	  | InternalVarInfo.VarInfo i => i
+         case varInfo var of
+            InternalVarInfo.Self => VarInfo.Poly x
+          | InternalVarInfo.VarInfo i => i
       val varExpInfo =
-	 Trace.trace ("varExpInfo", VarExp.layout, VarInfo.layout) varExpInfo
+         Trace.trace ("Xml.Shrink.varExpInfo", VarExp.layout, VarInfo.layout) varExpInfo
       fun varExpInfos xs = Vector.map (xs, varExpInfo)
       fun replaceInfo (x: Var.t,
-		       {numOccurrences = r, ...}: MonoVarInfo.t,
-		       i: VarInfo.t): unit =
-	 (VarInfo.inc (i, !r)
-	  ; setVarInfo (x, InternalVarInfo.VarInfo i))
+                       {numOccurrences = r, ...}: MonoVarInfo.t,
+                       i: VarInfo.t): unit =
+         (VarInfo.inc (i, !r)
+          ; setVarInfo (x, InternalVarInfo.VarInfo i))
       val replaceInfo =
-	 Trace.trace ("replaceInfo",
-		      fn (x, _, i) => Layout.tuple [Var.layout x,
-						    VarInfo.layout i],
-		      Unit.layout)
-	 replaceInfo
+         Trace.trace ("Xml.Shrink.replaceInfo",
+                      fn (x, _, i) => Layout.tuple [Var.layout x,
+                                                    VarInfo.layout i],
+                      Unit.layout)
+         replaceInfo
       fun replace (x, i) = replaceInfo (x, monoVarInfo x, i)
       val shrinkVarExp = VarInfo.varExp o varExpInfo
       fun shrinkVarExps xs = Vector.map (xs, shrinkVarExp)
       local
-	 fun handleBoundVar (x, ts, _) =
-	    setVarInfo (x,
-			if Vector.isEmpty ts
-			   then (InternalVarInfo.VarInfo
-				 (VarInfo.Mono {numOccurrences = ref 0,
-						value = ref NONE,
-						varExp = VarExp.mono x}))
-			else InternalVarInfo.Self)
-	 fun handleVarExp x = VarInfo.inc (varExpInfo x, 1)
+         fun handleBoundVar (x, ts, _) =
+            setVarInfo (x,
+                        if Vector.isEmpty ts
+                           then (InternalVarInfo.VarInfo
+                                 (VarInfo.Mono {numOccurrences = ref 0,
+                                                value = ref NONE,
+                                                varExp = VarExp.mono x}))
+                        else InternalVarInfo.Self)
+         fun handleVarExp x = VarInfo.inc (varExpInfo x, 1)
       in
-	 fun countExp (e: Exp.t): unit =
-	    Exp.foreach {exp = e,
-			 handleBoundVar = handleBoundVar,
-			 handleExp = fn _ => (),
-			 handlePrimExp = fn _ => (),
-			 handleVarExp = handleVarExp}
+         fun countExp (e: Exp.t): unit =
+            Exp.foreach {exp = e,
+                         handleBoundVar = handleBoundVar,
+                         handleExp = fn _ => (),
+                         handlePrimExp = fn _ => (),
+                         handleVarExp = handleVarExp}
       end
       fun deleteVarExp (x: VarExp.t): unit =
-	 VarInfo.inc (varExpInfo x, ~1)
+         VarInfo.inc (varExpInfo x, ~1)
       fun deleteExp (e: Exp.t): unit = Exp.foreachVarExp (e, deleteVarExp)
       val deleteExp =
-	 Trace.trace ("deleteExp", Exp.layout, Unit.layout) deleteExp
+         Trace.trace ("Xml.Shrink.deleteExp", Exp.layout, Unit.layout) deleteExp
       fun deleteLambda l = deleteExp (Lambda.body l)
       (*---------------------------------------------------*)
       (*                    shrinkExp                    *)
       (*---------------------------------------------------*)
       fun shrinkExp arg: Exp.t =
-	 traceShrinkExp
-	 (fn (e: Exp.t) =>
-	  let
-	     val {decs, result} = Exp.dest e
-	  in
-	     Exp.make {decs = shrinkDecs decs,
-		       result = shrinkVarExp result}
-	  end) arg
+         traceShrinkExp
+         (fn (e: Exp.t) =>
+          let
+             val {decs, result} = Exp.dest e
+          in
+             Exp.make {decs = shrinkDecs decs,
+                       result = shrinkVarExp result}
+          end) arg
       and shrinkDecs (decs: Dec.t list): Dec.t list =
-	 case decs of
-	    [] => []
-	  | dec :: decs =>
-	       case dec of
-		  Exception _ => dec :: shrinkDecs decs
-		| PolyVal {var, tyvars, ty, exp} =>
-		     Dec.PolyVal {var = var, tyvars = tyvars, ty = ty,
-				  exp = shrinkExp exp}
-		     :: shrinkDecs decs
-		| Fun {tyvars, decs = decs'} =>
-		     if Vector.isEmpty tyvars
-			then
-			   let
-			      val decs' =
-				 Vector.keepAll
-				 (decs', fn {lambda, var, ...} =>
-				  let
-				     val {numOccurrences, value, ...} =
-					monoVarInfo var
-				  in if 0 = !numOccurrences
-					then (deleteLambda lambda; false)
-				     else (value := (SOME
-						     (Value.Lambda
-						      {isInlined = ref false,
-						       lam = lambda}))
-					   ; true)
-				  end)
-			      val decs = shrinkDecs decs
-			      (* Need to walk over all the decs and remove
-			       * their value before shrinking any of them
-			       * because they are mutually recursive.
-			       *)
-			      val decs' =
-				 Vector.keepAll
-				 (decs', fn {var, lambda, ...} =>
-				  let
-				     val {numOccurrences, value, ...} =
-					monoVarInfo var
-				  in
-				     case !value of
-					SOME (Value.Lambda {isInlined, ...}) =>
-					   not (!isInlined)
-					   andalso
-					   if 0 = !numOccurrences
-					      then (deleteLambda lambda
-						    ; false)
-					   else (value := NONE; true)
-				      | _ => Error.bug "should be a lambda"
-				  end)
-			   in
-			      if Vector.isEmpty decs'
-				 then decs
-			      else
-				 Dec.Fun {tyvars = tyvars,
-					  decs =
-					  Vector.map
-					  (decs', fn {var, ty, lambda} =>
-					   {var = var,
-					    ty = ty,
-					    lambda = shrinkLambda lambda})}
-				 :: decs
-			   end
-		     else
-			Dec.Fun {tyvars = tyvars,
-				 decs =
-				 Vector.map
-				 (decs', fn {var, ty, lambda} =>
-				  {var = var,
-				   ty = ty,
-				   lambda = shrinkLambda lambda})}
-			:: shrinkDecs decs
-		| MonoVal b =>
-		     shrinkMonoVal (b, fn () => shrinkDecs decs)
+         case decs of
+            [] => []
+          | dec :: decs =>
+               case dec of
+                  Exception _ => dec :: shrinkDecs decs
+                | PolyVal {var, tyvars, ty, exp} =>
+                     Dec.PolyVal {var = var, tyvars = tyvars, ty = ty,
+                                  exp = shrinkExp exp}
+                     :: shrinkDecs decs
+                | Fun {tyvars, decs = decs'} =>
+                     if Vector.isEmpty tyvars
+                        then
+                           let
+                              val decs' =
+                                 Vector.keepAll
+                                 (decs', fn {lambda, var, ...} =>
+                                  let
+                                     val {numOccurrences, value, ...} =
+                                        monoVarInfo var
+                                  in if 0 = !numOccurrences
+                                        then (deleteLambda lambda; false)
+                                     else (value := (SOME
+                                                     (Value.Lambda
+                                                      {isInlined = ref false,
+                                                       lam = lambda}))
+                                           ; true)
+                                  end)
+                              val decs = shrinkDecs decs
+                              (* Need to walk over all the decs and remove
+                               * their value before shrinking any of them
+                               * because they are mutually recursive.
+                               *)
+                              val decs' =
+                                 Vector.keepAll
+                                 (decs', fn {var, lambda, ...} =>
+                                  let
+                                     val {numOccurrences, value, ...} =
+                                        monoVarInfo var
+                                  in
+                                     case !value of
+                                        SOME (Value.Lambda {isInlined, ...}) =>
+                                           not (!isInlined)
+                                           andalso
+                                           if 0 = !numOccurrences
+                                              then (deleteLambda lambda
+                                                    ; false)
+                                           else (value := NONE; true)
+                                      | _ => Error.bug "Xml.Shrink.shrinkDecs: should be a lambda"
+                                  end)
+                           in
+                              if Vector.isEmpty decs'
+                                 then decs
+                              else
+                                 Dec.Fun {tyvars = tyvars,
+                                          decs =
+                                          Vector.map
+                                          (decs', fn {var, ty, lambda} =>
+                                           {var = var,
+                                            ty = ty,
+                                            lambda = shrinkLambda lambda})}
+                                 :: decs
+                           end
+                     else
+                        Dec.Fun {tyvars = tyvars,
+                                 decs =
+                                 Vector.map
+                                 (decs', fn {var, ty, lambda} =>
+                                  {var = var,
+                                   ty = ty,
+                                   lambda = shrinkLambda lambda})}
+                        :: shrinkDecs decs
+                | MonoVal b =>
+                     shrinkMonoVal (b, fn () => shrinkDecs decs)
       and shrinkMonoVal ({var, ty, exp},
-			 rest: unit -> Dec.t list) =
-	 let
-	    val info as {numOccurrences, value, ...} = monoVarInfo var
-	    fun finish (exp, decs) =
-	       MonoVal {var = var, ty = ty, exp = exp} :: decs
-	    fun nonExpansive (delete: unit -> unit,
-			      set: unit -> (unit -> PrimExp.t) option) =
-	       if 0 = !numOccurrences
-		  then (delete (); rest ())
-	       else let
-		       val s = set ()
-		       val decs = rest ()
-		    in if 0 = !numOccurrences
-			  then (delete (); decs)
-		       else (case s of
-				NONE => decs
-			      | SOME n => finish (n (), decs))
-		    end
-	    fun expansive (e: PrimExp.t) = finish (e, rest ())
-	    fun nonExpansiveCon (delete, v: Value.t) =
-	       nonExpansive
-	       (delete,
-		fn () => (value := SOME v
-			  ; SOME (fn () => Value.toPrimExp v)))
-	    fun expression (e: Exp.t): Dec.t list =
-	       let
-		  val {decs = decs', result} = Exp.dest (shrinkExp e)
-		  val _ = replaceInfo (var, info, varExpInfo result)
-		  val decs = rest ()
-	       in decs' @ decs
-	       end
-	 in
-	    case exp of
-	       App {func, arg} =>
-		  let
-		     val arg = varExpInfo arg
-		     fun normal func =
-			expansive (App {func = func,
-					arg = VarInfo.varExp arg})
-		  in case varExpInfo func of
-		     VarInfo.Poly x => normal x
-		   | VarInfo.Mono {numOccurrences, value, varExp, ...} => 
-			case (!numOccurrences, !value) of
-			   (1, SOME (Value.Lambda {isInlined, lam = l})) =>
-			      if not (Lambda.mayInline l)
-				 then normal varExp
-			      else
-				 let
-				    val {arg = form, body, ...} = Lambda.dest l
-				 in
-				    VarInfo.inc (arg, ~1)
-				    ; replace (form, arg)
-				    ; isInlined := true
-				    ; numOccurrences := 0
-				    ; expression body
-				 end
-			 | _ => normal varExp
-		  end
-	     | Case {test, cases, default} =>
-		  let
-		     fun match (cases, f): Dec.t list =
-			let
-			   val _ = deleteVarExp test
-			   fun step (i, (c, e), ()) =
-			      if f c
-				 then
-				    (Vector.foreachR (cases, i + 1,
-						      Vector.length cases,
-						      deleteExp o #2)
-				     ; Option.app (default, deleteExp o #1)
-				     ; Vector.Done (expression e))
-			      else (deleteExp e; Vector.Continue ())
-			   fun done () =
-			      case default of
-				 SOME (e, _) => expression e
-			       | NONE => Error.bug "shrinkPrimExp: Case"
-			in Vector.fold' (cases, 0, (), step, done)
-			end
-		     fun normal test =
-			let
-			   (* Eliminate redundant default case. *)
-			   val default =
-			      if isExhaustive cases
-				 then (Option.app (default, deleteExp o #1)
-				       ; NONE)
-			      else Option.map (default, fn (e, r) =>
-					       (shrinkExp e, r))
-			in
-			   expansive
-			   (Case {test = test,
-				  cases = Cases.map (cases, shrinkExp),
-				  default = default})
-			end
-		  in
-		     case varExpInfo test of
-			VarInfo.Poly test => normal test
-		      | VarInfo.Mono {value, varExp, ...} => 
-			   case (cases, !value) of
-			      (Cases.Con cases,
-			       SOME (Value.ConApp {con = c, arg, ...})) =>
-			      let
-				 val match =
-				    fn f =>
-				    match (cases,
-					   fn Pat.T {con = c', arg, ...} =>
-					   Con.equals (c, c')
-					   andalso f arg)
-			      in case arg of
-				 NONE => match Option.isNone
-			       | SOME v =>
-				    match
-				    (fn SOME (x, _) => (replace (x, v); true)
-				  | _ => false)
-			      end
-			     | (_, SOME (Value.Const c)) =>
-				  (case (cases, c) of
-				      (Cases.Word (_, l), Const.Word w) =>
-					 match (l, fn w' => WordX.equals (w, w'))
-				    | _ => Error.bug "strange case")
-			     | (_, NONE) => normal varExp
-			     | _ => Error.bug "shrinkMonoVal"
-		  end
-	     | ConApp {con, targs, arg} =>
-		  if Con.equals (con, Con.overflow)
-		     then
-			expansive
-			(ConApp
-			 {con = con,
-			  targs = targs,
-			  arg = Option.map (arg, shrinkVarExp)})
-		  else
-		     let
-			val arg = Option.map (arg, varExpInfo)
-		     in nonExpansiveCon
-			(fn () => Option.app (arg, VarInfo.delete),
-			 Value.ConApp {con = con, targs = targs, arg = arg})
-		     end			     
-	     | Const c => nonExpansiveCon (fn () => (), Value.Const c)
-	     | Handle {try, catch, handler} =>
-		  expansive (Handle {try = shrinkExp try,
-				     catch = catch,
-				     handler = shrinkExp handler})
-	     | Lambda l =>
-		  let val isInlined = ref false
-		  in nonExpansive
-		     (fn () => if !isInlined then () else deleteLambda l,
-		      fn () => (value := SOME (Value.Lambda
-					       {isInlined = isInlined,
-						lam = l})
-				; SOME (fn () => Lambda (shrinkLambda l))))
-		  end
-	     | PrimApp {prim, args, targs} =>
-		  let
-		     fun make () =
-			PrimApp {prim = prim, targs = targs,
-				 args = shrinkVarExps args}
-		  in if Prim.maySideEffect prim
-			then expansive (make ())
-		     else nonExpansive (fn () => (), fn () => SOME make)
-		  end
-	     | Profile _ => expansive exp
-	     | Raise {exn, extend} =>
-		  expansive (Raise {exn = shrinkVarExp exn, extend = extend})
-	     | Select {tuple, offset} =>
-		  let
-		     fun normal x = Select {tuple = x, offset = offset}
-		  in case varExpInfo tuple of
-		     VarInfo.Poly x => finish (normal x, rest ())
-		   | VarInfo.Mono {numOccurrences, value, varExp, ...} =>
-			nonExpansive
-			(fn () => inc (numOccurrences, ~1),
-			 fn () =>
-			 case !value of
-			    NONE => SOME (fn () => normal varExp)
-			  | SOME (Value.Tuple vs) => 
-			       (inc (numOccurrences, ~1)
-				; replaceInfo (var, info, Vector.sub (vs, offset))
-				; NONE)
-			  | _ => Error.bug "shrinkMonoVal: Select")
-		  end
-	     | Tuple xs =>
-		  let val xs = varExpInfos xs
-		  in nonExpansiveCon (fn () => VarInfo.deletes xs,
-				      Value.Tuple xs)
-		  end
-	     | Var x => let val x = varExpInfo x
-			in replaceInfo (var, info, x)
-			   ; VarInfo.inc (x, ~1)
-			   ; rest ()
-			end
-	 end
+                         rest: unit -> Dec.t list) =
+         let
+            val info as {numOccurrences, value, ...} = monoVarInfo var
+            fun finish (exp, decs) =
+               MonoVal {var = var, ty = ty, exp = exp} :: decs
+            fun nonExpansive (delete: unit -> unit,
+                              set: unit -> (unit -> PrimExp.t) option) =
+               if 0 = !numOccurrences
+                  then (delete (); rest ())
+               else let
+                       val s = set ()
+                       val decs = rest ()
+                    in if 0 = !numOccurrences
+                          then (delete (); decs)
+                       else (case s of
+                                NONE => decs
+                              | SOME n => finish (n (), decs))
+                    end
+            fun expansive (e: PrimExp.t) = finish (e, rest ())
+            fun nonExpansiveCon (delete, v: Value.t) =
+               nonExpansive
+               (delete,
+                fn () => (value := SOME v
+                          ; SOME (fn () => Value.toPrimExp v)))
+            fun expression (e: Exp.t): Dec.t list =
+               let
+                  val {decs = decs', result} = Exp.dest (shrinkExp e)
+                  val _ = replaceInfo (var, info, varExpInfo result)
+                  val decs = rest ()
+               in decs' @ decs
+               end
+         in
+            case exp of
+               App {func, arg} =>
+                  let
+                     val arg = varExpInfo arg
+                     fun normal func =
+                        expansive (App {func = func,
+                                        arg = VarInfo.varExp arg})
+                  in case varExpInfo func of
+                     VarInfo.Poly x => normal x
+                   | VarInfo.Mono {numOccurrences, value, varExp, ...} => 
+                        case (!numOccurrences, !value) of
+                           (1, SOME (Value.Lambda {isInlined, lam = l})) =>
+                              if not (Lambda.mayInline l)
+                                 then normal varExp
+                              else
+                                 let
+                                    val {arg = form, body, ...} = Lambda.dest l
+                                 in
+                                    VarInfo.inc (arg, ~1)
+                                    ; replace (form, arg)
+                                    ; isInlined := true
+                                    ; numOccurrences := 0
+                                    ; expression body
+                                 end
+                         | _ => normal varExp
+                  end
+             | Case {test, cases, default} =>
+                  let
+                     fun match (cases, f): Dec.t list =
+                        let
+                           val _ = deleteVarExp test
+                           fun step (i, (c, e), ()) =
+                              if f c
+                                 then
+                                    (Vector.foreachR (cases, i + 1,
+                                                      Vector.length cases,
+                                                      deleteExp o #2)
+                                     ; Option.app (default, deleteExp o #1)
+                                     ; Vector.Done (expression e))
+                              else (deleteExp e; Vector.Continue ())
+                           fun done () =
+                              case default of
+                                 SOME (e, _) => expression e
+                               | NONE => Error.bug "Xml.Shrink.shrinkMonoVal: Case, match"
+                        in Vector.fold' (cases, 0, (), step, done)
+                        end
+                     fun normal test =
+                        let
+                           (* Eliminate redundant default case. *)
+                           val default =
+                              if isExhaustive cases
+                                 then (Option.app (default, deleteExp o #1)
+                                       ; NONE)
+                              else Option.map (default, fn (e, r) =>
+                                               (shrinkExp e, r))
+                        in
+                           expansive
+                           (Case {test = test,
+                                  cases = Cases.map (cases, shrinkExp),
+                                  default = default})
+                        end
+                  in
+                     case varExpInfo test of
+                        VarInfo.Poly test => normal test
+                      | VarInfo.Mono {value, varExp, ...} => 
+                           case (cases, !value) of
+                              (Cases.Con cases,
+                               SOME (Value.ConApp {con = c, arg, ...})) =>
+                              let
+                                 val match =
+                                    fn f =>
+                                    match (cases,
+                                           fn Pat.T {con = c', arg, ...} =>
+                                           Con.equals (c, c')
+                                           andalso f arg)
+                              in case arg of
+                                 NONE => match Option.isNone
+                               | SOME v =>
+                                    match
+                                    (fn SOME (x, _) => (replace (x, v); true)
+                                  | _ => false)
+                              end
+                             | (_, SOME (Value.Const c)) =>
+                                  (case (cases, c) of
+                                      (Cases.Word (_, l), Const.Word w) =>
+                                         match (l, fn w' => WordX.equals (w, w'))
+                                    | _ => Error.bug "Xml.Shrink.shrinkMonoVal: Case, strange case")
+                             | (_, NONE) => normal varExp
+                             | _ => Error.bug "Xml.Shrink.shrinkMonoVal: Case, default"
+                  end
+             | ConApp {con, targs, arg} =>
+                  if Con.equals (con, Con.overflow)
+                     then
+                        expansive
+                        (ConApp
+                         {con = con,
+                          targs = targs,
+                          arg = Option.map (arg, shrinkVarExp)})
+                  else
+                     let
+                        val arg = Option.map (arg, varExpInfo)
+                     in nonExpansiveCon
+                        (fn () => Option.app (arg, VarInfo.delete),
+                         Value.ConApp {con = con, targs = targs, arg = arg})
+                     end                             
+             | Const c => nonExpansiveCon (fn () => (), Value.Const c)
+             | Handle {try, catch, handler} =>
+                  expansive (Handle {try = shrinkExp try,
+                                     catch = catch,
+                                     handler = shrinkExp handler})
+             | Lambda l =>
+                  let val isInlined = ref false
+                  in nonExpansive
+                     (fn () => if !isInlined then () else deleteLambda l,
+                      fn () => (value := SOME (Value.Lambda
+                                               {isInlined = isInlined,
+                                                lam = l})
+                                ; SOME (fn () => Lambda (shrinkLambda l))))
+                  end
+             | PrimApp {prim, args, targs} =>
+                  let
+                     fun make () =
+                        PrimApp {prim = prim, targs = targs,
+                                 args = shrinkVarExps args}
+                  in if Prim.maySideEffect prim
+                        then expansive (make ())
+                     else nonExpansive (fn () => (), fn () => SOME make)
+                  end
+             | Profile _ => expansive exp
+             | Raise {exn, extend} =>
+                  expansive (Raise {exn = shrinkVarExp exn, extend = extend})
+             | Select {tuple, offset} =>
+                  let
+                     fun normal x = Select {tuple = x, offset = offset}
+                  in case varExpInfo tuple of
+                     VarInfo.Poly x => finish (normal x, rest ())
+                   | VarInfo.Mono {numOccurrences, value, varExp, ...} =>
+                        nonExpansive
+                        (fn () => inc (numOccurrences, ~1),
+                         fn () =>
+                         case !value of
+                            NONE => SOME (fn () => normal varExp)
+                          | SOME (Value.Tuple vs) => 
+                               (inc (numOccurrences, ~1)
+                                ; replaceInfo (var, info, Vector.sub (vs, offset))
+                                ; NONE)
+                          | _ => Error.bug "Xml.Shrink.shrinkMonoVal: Select")
+                  end
+             | Tuple xs =>
+                  let val xs = varExpInfos xs
+                  in nonExpansiveCon (fn () => VarInfo.deletes xs,
+                                      Value.Tuple xs)
+                  end
+             | Var x => let val x = varExpInfo x
+                        in replaceInfo (var, info, x)
+                           ; VarInfo.inc (x, ~1)
+                           ; rest ()
+                        end
+         end
       and shrinkLambda l: Lambda.t =
-	 traceShrinkLambda
-	 (fn l => 
-	  let
-	     val {arg, argType, body, mayInline} = Lambda.dest l
-	  in
-	     Lambda.make {arg = arg,
-			  argType = argType,
-			  body = shrinkExp body,
-			  mayInline = mayInline}
-	  end) l
+         traceShrinkLambda
+         (fn l => 
+          let
+             val {arg, argType, body, mayInline} = Lambda.dest l
+          in
+             Lambda.make {arg = arg,
+                          argType = argType,
+                          body = shrinkExp body,
+                          mayInline = mayInline}
+          end) l
       val _ = countExp body
       val _ =
-	 Option.app
-	 (overflow, fn x =>
-	  case varInfo x of
-	     InternalVarInfo.VarInfo i => VarInfo.inc (i, 1)
-	   | _ => Error.bug "strange overflow var")
+         Option.app
+         (overflow, fn x =>
+          case varInfo x of
+             InternalVarInfo.VarInfo i => VarInfo.inc (i, 1)
+           | _ => Error.bug "Xml.Shrink.shrinkOnce: strange overflow var")
       val body = shrinkExp body
       (* Must lookup the overflow variable again because it may have been set
        * during shrinking.
        *)
       val overflow =
-	 Option.map
-	 (overflow, fn x =>
-	  case varInfo x of
-	     InternalVarInfo.VarInfo i => VarExp.var (VarInfo.varExp i)
-	   | _ => Error.bug "strange overflow var")
+         Option.map
+         (overflow, fn x =>
+          case varInfo x of
+             InternalVarInfo.VarInfo i => VarExp.var (VarInfo.varExp i)
+           | _ => Error.bug "Xml.Shrink.shrinkOnce: strange overflow var")
       val _ = Exp.clear body
       val _ = Vector.foreach (datatypes, fn {cons, ...} =>
-			      Vector.foreach (cons, Con.clear o #con))
+                              Vector.foreach (cons, Con.clear o #con))
    in
       Program.T {datatypes = datatypes,
-		 body = body,
-		 overflow = overflow}
+                 body = body,
+                 overflow = overflow}
    end
 
 val shrinkOnce =
-   Trace.trace ("Xml.shrinkOnce", Program.layout, Program.layout) shrinkOnce
+   Trace.trace ("Xml.Shrink.shrinkOnce", Program.layout, Program.layout) shrinkOnce
 
 val shrink = shrinkOnce o shrinkOnce
 
@@ -525,6 +526,6 @@
 val shrink = shrink o SccFuns.sccFuns
 
 val shrink =
-   Trace.trace ("Xml.shrink", Program.layout, Program.layout) shrink
+   Trace.trace ("Xml.Shrink.shrink", Program.layout, Program.layout) shrink
 
 end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/xml/shrink.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/xml/shrink.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/xml/shrink.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature SHRINK_STRUCTS = 
    sig
      include TYPE_CHECK

Modified: mlton/branches/on-20050420-cmm-branch/mlton/xml/simplify-types.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/xml/simplify-types.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/xml/simplify-types.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 functor SimplifyTypes (S: SIMPLIFY_TYPES_STRUCTS): SIMPLIFY_TYPES = 
 struct
 
@@ -16,112 +17,112 @@
 structure PowerSetLat =
    struct
       datatype t = T of {isIn: bool ref,
-			 whenIn: (unit -> unit) list ref} vector
+                         whenIn: (unit -> unit) list ref} vector
 
       fun isIn (T v, i) =
-	 ! (#isIn (Vector.sub (v, i)))
+         ! (#isIn (Vector.sub (v, i)))
 
       fun new (size: int) = T (Vector.tabulate (size, fn _ =>
-						{isIn = ref false,
-						 whenIn = ref []}))
+                                                {isIn = ref false,
+                                                 whenIn = ref []}))
 
       fun add (T v, i) =
-	 let
-	    val {isIn, whenIn, ...} = Vector.sub (v, i)
-	 in
-	    if !isIn
-	       then ()
-	    else (isIn := true
-		  ; List.foreach (!whenIn, fn f => f ()))
-	 end
+         let
+            val {isIn, whenIn, ...} = Vector.sub (v, i)
+         in
+            if !isIn
+               then ()
+            else (isIn := true
+                  ; List.foreach (!whenIn, fn f => f ()))
+         end
 
       fun whenIn (T v, i, f) =
-	 let
-	    val {isIn, whenIn, ...} = Vector.sub (v, i)
-	 in
-	    if !isIn
-	       then f ()
-	    else List.push (whenIn, f)
-	 end
+         let
+            val {isIn, whenIn, ...} = Vector.sub (v, i)
+         in
+            if !isIn
+               then f ()
+            else List.push (whenIn, f)
+         end
    end
 
 fun simplifyTypes (I.Program.T {body, datatypes, overflow}) =
    let
       val {get = tyconInfo: Tycon.t -> {used: PowerSetLat.t} option,
-	   set = setTyconInfo, ...} =
-	 Property.getSetOnce (Tycon.plist, Property.initConst NONE)
+           set = setTyconInfo, ...} =
+         Property.getSetOnce (Tycon.plist, Property.initConst NONE)
       val _ =
-	 Vector.foreach
-	 (datatypes, fn {tycon, tyvars, ...} =>
-	  setTyconInfo (tycon,
-			SOME {used = PowerSetLat.new (Vector.length tyvars)}))
+         Vector.foreach
+         (datatypes, fn {tycon, tyvars, ...} =>
+          setTyconInfo (tycon,
+                        SOME {used = PowerSetLat.new (Vector.length tyvars)}))
       val _ =
-	 Vector.foreach
-	 (datatypes, fn {cons, tycon, tyvars} =>
-	  let
-	     val {get = tyvarIndex, set = setTyvarIndex, rem, ...} =
-		Property.getSet
-		(Tyvar.plist, Property.initRaise ("index", Tyvar.layout))
-	     val _ = Vector.foreachi (tyvars, fn (i, a) => setTyvarIndex (a, i))
-	     val {used, ...} = valOf (tyconInfo tycon)
-	     val {destroy, hom} =
-		I.Type.makeHom
-		{con = (fn (_, tc, ts) =>
-			fn () =>
-			case tyconInfo tc of
-			   NONE => Vector.foreach (ts, fn t => t ())
-			 | SOME {used, ...} =>
-			      Vector.foreachi
-			      (ts, fn (i, t) =>
-			       PowerSetLat.whenIn (used, i, t))),
-		 var = (fn (_, a) =>
-			let
-			   val i = tyvarIndex a
-			in
-			   fn () => PowerSetLat.add (used, i)
-			end)}
-	     val _ =
-		Vector.foreach
-		(cons, fn {arg, ...} =>
-		 case arg of
-		    NONE => ()
-		  | SOME t => hom t ())
-	     val _ = Vector.foreach (tyvars, rem)
-	     val _ = destroy ()
-	  in
-	     ()
-	  end)
+         Vector.foreach
+         (datatypes, fn {cons, tycon, tyvars} =>
+          let
+             val {get = tyvarIndex, set = setTyvarIndex, rem, ...} =
+                Property.getSet
+                (Tyvar.plist, Property.initRaise ("index", Tyvar.layout))
+             val _ = Vector.foreachi (tyvars, fn (i, a) => setTyvarIndex (a, i))
+             val {used, ...} = valOf (tyconInfo tycon)
+             val {destroy, hom} =
+                I.Type.makeHom
+                {con = (fn (_, tc, ts) =>
+                        fn () =>
+                        case tyconInfo tc of
+                           NONE => Vector.foreach (ts, fn t => t ())
+                         | SOME {used, ...} =>
+                              Vector.foreachi
+                              (ts, fn (i, t) =>
+                               PowerSetLat.whenIn (used, i, t))),
+                 var = (fn (_, a) =>
+                        let
+                           val i = tyvarIndex a
+                        in
+                           fn () => PowerSetLat.add (used, i)
+                        end)}
+             val _ =
+                Vector.foreach
+                (cons, fn {arg, ...} =>
+                 case arg of
+                    NONE => ()
+                  | SOME t => hom t ())
+             val _ = Vector.foreach (tyvars, rem)
+             val _ = destroy ()
+          in
+             ()
+          end)
       val {get = tyconKeep: Tycon.t -> bool vector option,
-	   set = setTyconKeep, ...} =
-	 Property.getSetOnce (Tycon.plist, Property.initConst NONE)
+           set = setTyconKeep, ...} =
+         Property.getSetOnce (Tycon.plist, Property.initConst NONE)
       val {get = conKeep: Con.t -> bool vector option,
-	   set = setConKeep, ...} =
-	 Property.getSetOnce (Con.plist, Property.initConst NONE)
+           set = setConKeep, ...} =
+         Property.getSetOnce (Con.plist, Property.initConst NONE)
       val _ =
-	 Vector.foreach
-	 (datatypes, fn {cons, tycon, tyvars} =>
-	  let
-	     val {used, ...} = valOf (tyconInfo tycon)
-	     val v =
-		Vector.tabulate
-		(Vector.length tyvars, fn i => PowerSetLat.isIn (used, i))
-	     val _ = Vector.foreach (cons, fn {con, ...} =>
-				     setConKeep (con, SOME v))
-	     val u =
-		if Vector.forall (v, fn b => b)
-		   then NONE
-		else SOME v
-	     val _ = setTyconKeep (tycon, u)
-	  in
-	     ()
-	  end)
+         Vector.foreach
+         (datatypes, fn {cons, tycon, tyvars} =>
+          let
+             val {used, ...} = valOf (tyconInfo tycon)
+             val v =
+                Vector.tabulate
+                (Vector.length tyvars, fn i => PowerSetLat.isIn (used, i))
+             val _ = Vector.foreach (cons, fn {con, ...} =>
+                                     setConKeep (con, SOME v))
+             val u =
+                if Vector.forall (v, fn b => b)
+                   then NONE
+                else SOME v
+             val _ = setTyconKeep (tycon, u)
+          in
+             ()
+          end)
       fun keep (v: 'a vector, bv: bool vector): 'a vector =
-	 Vector.keepAllMapi (v, fn (i, a) =>
-			     if Vector.sub (bv, i)
-				then SOME a
-			     else NONE)
+         Vector.keepAllMapi (v, fn (i, a) =>
+                             if Vector.sub (bv, i)
+                                then SOME a
+                             else NONE)
       val {get = tyvarIsUsed: Tyvar.t -> bool ref, ...} =
-	 Property.get (Tyvar.plist, Property.initFun (fn _ => ref false))
+         Property.get (Tyvar.plist, Property.initFun (fn _ => ref false))
       (* There is some mesiness with promises here for two reasons:
        * 1. The thunk is to make sure that even though we are using a type
        *    homomorphism, a type variable is only marked as used if it appears
@@ -131,164 +132,168 @@
        *    mapping from type to thunk, *not* the thunk's output.
        *)
       val {hom = fixType: I.Type.t -> unit -> O.Type.t, ...} =
-	 I.Type.makeHom
-	 {con = (fn (_, tc, ts) =>
-		 Promise.lazy
-		 (fn () =>
-		  let
-		     val ts =
-			case tyconKeep tc of
-			   NONE => ts
-			 | SOME bv => keep (ts, bv)
-		     val ts = Vector.map (ts, fn t => t ())
-		  in
-		     O.Type.con (tc, ts)
-		  end)),
-	  var = (fn (_, a) =>
-		 Promise.lazy
-		 (fn () => (tyvarIsUsed a := true; O.Type.var a)))}
+         I.Type.makeHom
+         {con = (fn (_, tc, ts) =>
+                 Promise.lazy
+                 (fn () =>
+                  let
+                     val ts =
+                        case tyconKeep tc of
+                           NONE => ts
+                         | SOME bv => keep (ts, bv)
+                     val ts = Vector.map (ts, fn t => t ())
+                  in
+                     O.Type.con (tc, ts)
+                  end)),
+          var = (fn (_, a) =>
+                 Promise.lazy
+                 (fn () => (tyvarIsUsed a := true; O.Type.var a)))}
       val fixType = fn t => fixType t ()
       val fixType =
-	 Trace.trace ("fixType", I.Type.layout, O.Type.layout) fixType
+         Trace.trace 
+         ("SimplifyTypes.fixType", I.Type.layout, O.Type.layout) 
+         fixType
       val tyvarIsUsed = ! o tyvarIsUsed
       val datatypes =
-	 Vector.map (datatypes, fn {cons, tycon, tyvars} =>
-		     {cons = Vector.map (cons, fn {arg, con} =>
-					 {arg = Option.map (arg, fixType),
-					  con = con}),
-		      tycon = tycon,
-		      tyvars = (case tyconKeep tycon of
-				   NONE => tyvars
-				 | SOME bv => keep (tyvars, bv))})
+         Vector.map (datatypes, fn {cons, tycon, tyvars} =>
+                     {cons = Vector.map (cons, fn {arg, con} =>
+                                         {arg = Option.map (arg, fixType),
+                                          con = con}),
+                      tycon = tycon,
+                      tyvars = (case tyconKeep tycon of
+                                   NONE => tyvars
+                                 | SOME bv => keep (tyvars, bv))})
       val {get = varKeep: Var.t -> bool vector option,
-	   set = setVarKeep, ...} =
-	 Property.getSetOnce (Var.plist, Property.initConst NONE)
+           set = setVarKeep, ...} =
+         Property.getSetOnce (Var.plist, Property.initConst NONE)
       fun fixVarExp (I.VarExp.T {targs, var}): O.VarExp.t =
-	 let
-	    val targs =
-	       case varKeep var of
-		  NONE => targs
-		| SOME bv => keep (targs, bv)
-	 in
-	    O.VarExp.T {targs = Vector.map (targs, fixType),
-			var = var}
-	 end
+         let
+            val targs =
+               case varKeep var of
+                  NONE => targs
+                | SOME bv => keep (targs, bv)
+         in
+            O.VarExp.T {targs = Vector.map (targs, fixType),
+                        var = var}
+         end
       val fixVarExp =
-	 Trace.trace ("fixVarExp", I.VarExp.layout, O.VarExp.layout) fixVarExp
+         Trace.trace 
+         ("SimplifyTypes.fixVarExp", I.VarExp.layout, O.VarExp.layout) 
+         fixVarExp
       fun fixConTargs (con: Con.t, targs: I.Type.t vector): O.Type.t vector =
-	 let
-	    val targs =
-	       case conKeep con of
-		  NONE => targs
-		| SOME bv => keep (targs, bv)
-	 in
-	    Vector.map (targs, fixType)
-	 end
+         let
+            val targs =
+               case conKeep con of
+                  NONE => targs
+                | SOME bv => keep (targs, bv)
+         in
+            Vector.map (targs, fixType)
+         end
       fun fixPat (I.Pat.T {arg, con, targs}): O.Pat.t =
-	 O.Pat.T {arg = Option.map (arg, fn (x, t) => (x, fixType t)),
-		  con = con,
-		  targs = fixConTargs (con, targs)}
+         O.Pat.T {arg = Option.map (arg, fn (x, t) => (x, fixType t)),
+                  con = con,
+                  targs = fixConTargs (con, targs)}
       fun fixDec (d: I.Dec.t): O.Dec.t =
-	 case d of
-	    I.Dec.Exception {arg, con} =>
-	       O.Dec.Exception {arg = Option.map (arg, fixType),
-				con = con}
-	  | I.Dec.Fun {decs, tyvars} =>
-	       let
-		  val decs =
-		     Vector.map (decs, fn {lambda, ty, var} =>
-				 {lambda = fixLambda lambda,
-				  ty = fixType ty,
-				  var = var})
-		  val bv = Vector.map (tyvars, tyvarIsUsed)
-		  val tyvars = keep (tyvars, bv)
-		  val _ =
-		     Vector.foreach
-		     (decs, fn {var, ...} => setVarKeep (var, SOME bv))
-	       in
-		  O.Dec.Fun {decs = decs,
-			     tyvars = tyvars}
-	       end
-	  | I.Dec.MonoVal {exp, ty, var} =>
-	       O.Dec.MonoVal {exp = fixPrimExp exp,
-			      ty = fixType ty,
-			      var = var}
-	  | I.Dec.PolyVal {exp, ty, tyvars, var} =>
-	       let
-		  val exp = fixExp exp
-		  val ty = fixType ty
-		  val bv = Vector.map (tyvars, tyvarIsUsed)
-		  val _ = setVarKeep (var, SOME bv)
-	       in
-		  O.Dec.PolyVal {exp = exp,
-				 ty = ty,
-				 tyvars = keep (tyvars, bv),
-				 var = var}
-	       end
+         case d of
+            I.Dec.Exception {arg, con} =>
+               O.Dec.Exception {arg = Option.map (arg, fixType),
+                                con = con}
+          | I.Dec.Fun {decs, tyvars} =>
+               let
+                  val decs =
+                     Vector.map (decs, fn {lambda, ty, var} =>
+                                 {lambda = fixLambda lambda,
+                                  ty = fixType ty,
+                                  var = var})
+                  val bv = Vector.map (tyvars, tyvarIsUsed)
+                  val tyvars = keep (tyvars, bv)
+                  val _ =
+                     Vector.foreach
+                     (decs, fn {var, ...} => setVarKeep (var, SOME bv))
+               in
+                  O.Dec.Fun {decs = decs,
+                             tyvars = tyvars}
+               end
+          | I.Dec.MonoVal {exp, ty, var} =>
+               O.Dec.MonoVal {exp = fixPrimExp exp,
+                              ty = fixType ty,
+                              var = var}
+          | I.Dec.PolyVal {exp, ty, tyvars, var} =>
+               let
+                  val exp = fixExp exp
+                  val ty = fixType ty
+                  val bv = Vector.map (tyvars, tyvarIsUsed)
+                  val _ = setVarKeep (var, SOME bv)
+               in
+                  O.Dec.PolyVal {exp = exp,
+                                 ty = ty,
+                                 tyvars = keep (tyvars, bv),
+                                 var = var}
+               end
       and fixExp (e: I.Exp.t): O.Exp.t =
-	 let
-	    val {decs, result} = I.Exp.dest e
-	 in
-	    O.Exp.make {decs = List.map (decs, fixDec),
-			result = fixVarExp result}
-	 end
+         let
+            val {decs, result} = I.Exp.dest e
+         in
+            O.Exp.make {decs = List.map (decs, fixDec),
+                        result = fixVarExp result}
+         end
       and fixLambda (l: I.Lambda.t): O.Lambda.t =
-	 let
-	    val {arg, argType, body, mayInline} = I.Lambda.dest l
-	 in
-	    O.Lambda.make {arg = arg,
-			   argType = fixType argType,
-			   body = fixExp body,
-			   mayInline = mayInline}
-	 end
+         let
+            val {arg, argType, body, mayInline} = I.Lambda.dest l
+         in
+            O.Lambda.make {arg = arg,
+                           argType = fixType argType,
+                           body = fixExp body,
+                           mayInline = mayInline}
+         end
       and fixPrimExp (e: I.PrimExp.t): O.PrimExp.t =
-	 case e of
-	    I.PrimExp.App {arg, func} => O.PrimExp.App {arg = fixVarExp arg,
-							func = fixVarExp func}
-	  | I.PrimExp.Case {cases, default, test} =>
-	       let
-		  val cases =
-		     case cases of
-			I.Cases.Con v =>
-			   O.Cases.Con (Vector.map (v, fn (p, e) =>
-						    (fixPat p, fixExp e)))
-		      | I.Cases.Word (s, v) =>
-			   O.Cases.Word
-			   (s, Vector.map (v, fn (c, e) => (c, fixExp e)))
-	       in
-		  O.PrimExp.Case {cases = cases,
-				  default = Option.map (default, fn (e, r) =>
-							(fixExp e, r)),
-				  test = fixVarExp test}
-	       end
-	  | I.PrimExp.ConApp {arg, con, targs} =>
-	       O.PrimExp.ConApp {arg = Option.map (arg, fixVarExp),
-				 con = con,
-				 targs = fixConTargs (con, targs)}
-	  | I.PrimExp.Const c => O.PrimExp.Const c
-	  | I.PrimExp.Handle {catch = (x, t), handler, try} =>
-	       O.PrimExp.Handle {catch = (x, fixType t),
-				 handler = fixExp handler,
-				 try = fixExp try}
-	  | I.PrimExp.Lambda l => O.PrimExp.Lambda (fixLambda l)
-	  | I.PrimExp.PrimApp {args, prim, targs} =>
-	       O.PrimExp.PrimApp {args = Vector.map (args, fixVarExp),
-				  prim = Prim.map (prim, fixType),
-				  targs = Vector.map (targs, fixType)}
-	  | I.PrimExp.Profile e => O.PrimExp.Profile e
-	  | I.PrimExp.Raise {exn, extend} =>
-	       O.PrimExp.Raise {exn = fixVarExp exn,
-				extend = extend}
-	  | I.PrimExp.Select {offset, tuple} =>
-	       O.PrimExp.Select {offset = offset,
-				 tuple = fixVarExp tuple}
-	  | I.PrimExp.Tuple xs => O.PrimExp.Tuple (Vector.map (xs, fixVarExp))
-	  | I.PrimExp.Var x => O.PrimExp.Var (fixVarExp x)
+         case e of
+            I.PrimExp.App {arg, func} => O.PrimExp.App {arg = fixVarExp arg,
+                                                        func = fixVarExp func}
+          | I.PrimExp.Case {cases, default, test} =>
+               let
+                  val cases =
+                     case cases of
+                        I.Cases.Con v =>
+                           O.Cases.Con (Vector.map (v, fn (p, e) =>
+                                                    (fixPat p, fixExp e)))
+                      | I.Cases.Word (s, v) =>
+                           O.Cases.Word
+                           (s, Vector.map (v, fn (c, e) => (c, fixExp e)))
+               in
+                  O.PrimExp.Case {cases = cases,
+                                  default = Option.map (default, fn (e, r) =>
+                                                        (fixExp e, r)),
+                                  test = fixVarExp test}
+               end
+          | I.PrimExp.ConApp {arg, con, targs} =>
+               O.PrimExp.ConApp {arg = Option.map (arg, fixVarExp),
+                                 con = con,
+                                 targs = fixConTargs (con, targs)}
+          | I.PrimExp.Const c => O.PrimExp.Const c
+          | I.PrimExp.Handle {catch = (x, t), handler, try} =>
+               O.PrimExp.Handle {catch = (x, fixType t),
+                                 handler = fixExp handler,
+                                 try = fixExp try}
+          | I.PrimExp.Lambda l => O.PrimExp.Lambda (fixLambda l)
+          | I.PrimExp.PrimApp {args, prim, targs} =>
+               O.PrimExp.PrimApp {args = Vector.map (args, fixVarExp),
+                                  prim = Prim.map (prim, fixType),
+                                  targs = Vector.map (targs, fixType)}
+          | I.PrimExp.Profile e => O.PrimExp.Profile e
+          | I.PrimExp.Raise {exn, extend} =>
+               O.PrimExp.Raise {exn = fixVarExp exn,
+                                extend = extend}
+          | I.PrimExp.Select {offset, tuple} =>
+               O.PrimExp.Select {offset = offset,
+                                 tuple = fixVarExp tuple}
+          | I.PrimExp.Tuple xs => O.PrimExp.Tuple (Vector.map (xs, fixVarExp))
+          | I.PrimExp.Var x => O.PrimExp.Var (fixVarExp x)
       val body = fixExp body
    in
       O.Program.T {datatypes = datatypes,
-		   body = body,
-		   overflow = overflow}
+                   body = body,
+                   overflow = overflow}
    end
 
 end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/xml/simplify-types.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/xml/simplify-types.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/xml/simplify-types.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,9 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 type int = Int.t

Modified: mlton/branches/on-20050420-cmm-branch/mlton/xml/sources.cm
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/xml/sources.cm	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/xml/sources.cm	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 Group
 
 signature SXML

Modified: mlton/branches/on-20050420-cmm-branch/mlton/xml/sources.mlb
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/xml/sources.mlb	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/xml/sources.mlb	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,51 +1,50 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 local
-    ../../lib/mlton/sources.mlb
-    ../../lib/smlnj/sources.mlb
-    ../atoms/sources.mlb
-    ../control/sources.mlb
+   ../../lib/mlton/sources.mlb
+   ../atoms/sources.mlb
+   ../control/sources.mlb
 
-    xml-type.sig
-    xml-tree.sig
-    xml-tree.fun
-    type-check.sig
-    type-check.fun
-    scc-funs.sig
-    scc-funs.fun
-    simplify-types.sig
-    simplify-types.fun
-    shrink.sig
-    shrink.fun
-    xml-simplify.sig
-    xml-simplify.fun
-    xml.sig
-    xml.fun
-    sxml-exns.sig
-    monomorphise.sig
-    monomorphise.fun
-    sxml-tree.sig
-    implement-exceptions.sig
-    implement-exceptions.fun
-    implement-suffix.sig
-    implement-suffix.fun
-    polyvariance.sig
-    polyvariance.fun
-    sxml-simplify.sig
-    sxml-simplify.fun
-    sxml.sig
-    sxml.fun
+   xml-type.sig
+   xml-tree.sig
+   xml-tree.fun
+   type-check.sig
+   type-check.fun
+   scc-funs.sig
+   scc-funs.fun
+   simplify-types.sig
+   simplify-types.fun
+   shrink.sig
+   shrink.fun
+   xml-simplify.sig
+   xml-simplify.fun
+   xml.sig
+   xml.fun
+   sxml-exns.sig
+   monomorphise.sig
+   monomorphise.fun
+   sxml-tree.sig
+   implement-exceptions.sig
+   implement-exceptions.fun
+   implement-suffix.sig
+   implement-suffix.fun
+   polyvariance.sig
+   polyvariance.fun
+   sxml-simplify.sig
+   sxml-simplify.fun
+   sxml.sig
+   sxml.fun
 in
-    signature SXML
-    signature XML
-    signature XML_TYPE
+   signature SXML
+   signature XML
 
-    functor Monomorphise
-    functor Xml
-    functor Sxml
+   functor Monomorphise
+   functor Xml
+   functor Sxml
 end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/xml/sxml-exns.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/xml/sxml-exns.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/xml/sxml-exns.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature SXML_EXNS = XML
 
 (*

Modified: mlton/branches/on-20050420-cmm-branch/mlton/xml/sxml-simplify.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/xml/sxml-simplify.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/xml/sxml-simplify.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 functor SxmlSimplify (S: SXML_SIMPLIFY_STRUCTS): SXML_SIMPLIFY = 
 struct
 
@@ -22,96 +23,116 @@
     fn () => Polyvariance.duplicate p)
 
 type pass = {name: string,
-	     doit: Program.t -> Program.t}
+             doit: Program.t -> Program.t}
 
-val sxmlPasses : pass list ref = ref
-   [
-    {name = "sxmlShrink1", doit = S.shrink},
-    {name = "implementSuffix", doit = ImplementSuffix.doit},
-    {name = "sxmlShrink2", doit = S.shrink},
-    {name = "implementExceptions", doit = ImplementExceptions.doit},
-    {name = "sxmlShrink3", doit = S.shrink},
+val sxmlPassesDefault =
+   {name = "sxmlShrink1", doit = S.shrink} ::
+   {name = "implementSuffix", doit = ImplementSuffix.doit} ::
+   {name = "sxmlShrink2", doit = S.shrink} ::
+   {name = "implementExceptions", doit = ImplementExceptions.doit} ::
+   {name = "sxmlShrink3", doit = S.shrink} ::
 (*
-    {name = "uncurry", doit = Uncurry.uncurry},
-    {name = "sxmlShrink4", doit = S.shrink},
+   {name = "uncurry", doit = Uncurry.uncurry} ::
+   {name = "sxmlShrink4", doit = S.shrink} ::
 *)
-    {name = "polyvariance", doit = Polyvariance.duplicate}
-   ]
+   {name = "polyvariance", doit = Polyvariance.duplicate} ::
+   nil
 
+val sxmlPassesMinimal =
+   {name = "implementSuffix", doit = ImplementSuffix.doit} ::
+   {name = "sxmlShrink2", doit = S.shrink} ::
+   {name = "implementExceptions", doit = ImplementExceptions.doit} ::
+   nil
+
+val sxmlPasses : pass list ref = ref sxmlPassesDefault
+
 local
    type passGen = string -> pass option
      
    fun mkSimplePassGen (name, doit): passGen =
       let val count = Counter.new 1
       in fn s => if s = name
-		    then SOME {name = name ^ "#" ^ 
-			       (Int.toString (Counter.next count)),
-			       doit = doit}
-		    else NONE
+                    then SOME {name = name ^ "#" ^ 
+                               (Int.toString (Counter.next count)),
+                               doit = doit}
+                    else NONE
       end
 
    val polyvariancePassGen =
       let
-	 val count = Counter.new 1
-	 fun nums s =
-	    if s = ""
-	       then SOME []
-	    else if String.sub (s, 0) = #"(" 
-	            andalso String.sub (s, String.size s - 1)= #")"
-	       then let
-		       val s = String.dropFirst (String.dropLast s)
-		    in
-		       case List.fold (String.split (s, #","), SOME [],
-				       fn (s,SOME nums) => (case Int.fromString s of
-							       SOME i => SOME (i::nums)
-							     | NONE => NONE)
-					| (_, NONE) => NONE) of
-			  SOME (l as _::_) => SOME (List.rev l)
-			| _ => NONE
-		    end
-	    else NONE
+         val count = Counter.new 1
+         fun nums s =
+            if s = ""
+               then SOME []
+            else if String.sub (s, 0) = #"(" 
+                    andalso String.sub (s, String.size s - 1)= #")"
+               then let
+                       val s = String.dropFirst (String.dropLast s)
+                    in
+                       case List.fold (String.split (s, #","), SOME [],
+                                       fn (s,SOME nums) => (case Int.fromString s of
+                                                               SOME i => SOME (i::nums)
+                                                             | NONE => NONE)
+                                        | (_, NONE) => NONE) of
+                          SOME (l as _::_) => SOME (List.rev l)
+                        | _ => NONE
+                    end
+            else NONE
       in
-	 fn s =>
-	 if String.hasPrefix (s, {prefix = "polyvariance"})
-	    then let
-		    fun mk (rounds, small, product) =
-		       SOME {name = concat ["polyvariance(", 
-					    Int.toString rounds, ",",
-					    Int.toString small, ",",
-					    Int.toString product, ")#",
-					    Int.toString (Counter.next count)],
-			     doit = polyvariance (rounds, small, product)}
-		    val s = String.dropPrefix (s, String.size "polyvariance")
-		 in
-		    case nums s of
-		       SOME [] => mk (2, 30, 300)
-		     | SOME [rounds, small, product] => mk (rounds, small, product)
-		     | _ => NONE
-		 end
+         fn s =>
+         if String.hasPrefix (s, {prefix = "polyvariance"})
+            then let
+                    fun mk (rounds, small, product) =
+                       SOME {name = concat ["polyvariance(", 
+                                            Int.toString rounds, ",",
+                                            Int.toString small, ",",
+                                            Int.toString product, ")#",
+                                            Int.toString (Counter.next count)],
+                             doit = polyvariance (rounds, small, product)}
+                    val s = String.dropPrefix (s, String.size "polyvariance")
+                 in
+                    case nums s of
+                       SOME [] => mk (2, 30, 300)
+                     | SOME [rounds, small, product] => mk (rounds, small, product)
+                     | _ => NONE
+                 end
          else NONE
       end
 
    val passGens =
       polyvariancePassGen ::
       (List.map([("sxmlShrink", S.shrink),
-		 ("implementExceptions", ImplementExceptions.doit), 
-		 ("implementSuffix", ImplementSuffix.doit)],
-		mkSimplePassGen))
+                 ("implementExceptions", ImplementExceptions.doit), 
+                 ("implementSuffix", ImplementSuffix.doit)],
+                mkSimplePassGen))
 
-   fun sxmlPassesSet s =
-      DynamicWind.withEscape
+   fun sxmlPassesSetCustom s =
+      Exn.withEscape
       (fn esc =>
        (let val ss = String.split (s, #":")
-	in
-	   sxmlPasses :=
-	   List.map(ss, fn s =>
-		    case (List.peekMap (passGens, fn gen => gen s)) of
-		       NONE => esc (Result.No s)
-		     | SOME pass => pass)
-	   ; Result.Yes ss
-	end))
+        in
+           sxmlPasses :=
+           List.map(ss, fn s =>
+                    case (List.peekMap (passGens, fn gen => gen s)) of
+                       NONE => esc (Result.No s)
+                     | SOME pass => pass)
+           ; Control.sxmlPasses := ss
+           ; Result.Yes ()
+        end))
+
+   datatype t = datatype Control.optimizationPasses
+   fun sxmlPassesSet opt =
+      case opt of
+         OptPassesDefault => (sxmlPasses := sxmlPassesDefault
+                              ; Control.sxmlPasses := ["default"]
+                              ; Result.Yes ())
+       | OptPassesMinimal => (sxmlPasses := sxmlPassesMinimal
+                              ; Control.sxmlPasses := ["minimal"]
+                              ; Result.Yes ())
+       | OptPassesCustom s => sxmlPassesSetCustom s
 in
    val _ = Control.sxmlPassesSet := sxmlPassesSet
+   val _ = List.push (Control.optimizationPassesSet, ("sxml", sxmlPassesSet))
 end
    
 fun stats p =
@@ -122,16 +143,16 @@
     ; (List.fold
        (!sxmlPasses, p, fn ({name, doit}, p) =>
       if List.exists (!Control.dropPasses, fn re =>
-		      Regexp.Compiled.matchesAll (re, name))
+                      Regexp.Compiled.matchesAll (re, name))
          then p
       else
          let
             val _ =
-	       let open Control
-	       in maybeSaveToFile
-		  ({name = name, suffix = "pre.sxml"},
-		   Control.No, p, Control.Layout Program.layout)
-	       end
+               let open Control
+               in maybeSaveToFile
+                  ({name = name, suffix = "pre.sxml"},
+                   Control.No, p, Control.Layout Program.layout)
+               end
             val p =
                Control.passTypeCheck
                {name = name,
@@ -146,14 +167,14 @@
          end)))
 
 val simplify = fn p => let
-			 (* Always want to type check the initial and final XML
-			  * programs, even if type checking is turned off, just
-			  * to catch bugs.
-			  *)
-			 val _ = typeCheck p
-			 val p' = simplify p
-			 val _ = typeCheck p'
-		       in
-			 p'
-		       end
+                         (* Always want to type check the initial and final XML
+                          * programs, even if type checking is turned off, just
+                          * to catch bugs.
+                          *)
+                         val _ = typeCheck p
+                         val p' = simplify p
+                         val _ = typeCheck p'
+                       in
+                         p'
+                       end
 end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/xml/sxml-simplify.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/xml/sxml-simplify.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/xml/sxml-simplify.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature SXML_SIMPLIFY_STRUCTS = 
    sig
       include SXML_TREE

Modified: mlton/branches/on-20050420-cmm-branch/mlton/xml/sxml-tree.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/xml/sxml-tree.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/xml/sxml-tree.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,14 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
-signature SXML_TREE_STRUCTS =
-  sig
-    include XML_TREE
-  end
 
 signature SXML_TREE = XML_TREE
 

Modified: mlton/branches/on-20050420-cmm-branch/mlton/xml/sxml.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/xml/sxml.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/xml/sxml.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 functor Sxml (S: SXML_STRUCTS): SXML =
   SxmlSimplify (S)

Modified: mlton/branches/on-20050420-cmm-branch/mlton/xml/sxml.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/xml/sxml.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/xml/sxml.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature SXML_STRUCTS =
   sig
     include XML

Modified: mlton/branches/on-20050420-cmm-branch/mlton/xml/type-check.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/xml/type-check.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/xml/type-check.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 functor TypeCheck (S: TYPE_CHECK_STRUCTS): TYPE_CHECK = 
 struct
 
@@ -15,306 +16,314 @@
    let
       (* tyvarInScope is used to ensure that tyvars never shadow themselves. *)
       val {get = tyvarInScope: Tyvar.t -> bool ref, ...} =
-	 Property.get (Tyvar.plist,
-		       Property.initFun (fn _ => ref false))
+         Property.get (Tyvar.plist,
+                       Property.initFun (fn _ => ref false))
       fun bindTyvars (vs: Tyvar.t vector): unit =
-	 Vector.foreach (vs, fn v =>
-			 let
-			    val r = tyvarInScope v
-			 in
-			    if !r
-			       then Type.error ("tyvar already in scope",
-						Tyvar.layout v)
-			    else r := true
-			 end)
+         Vector.foreach (vs, fn v =>
+                         let
+                            val r = tyvarInScope v
+                         in
+                            if !r
+                               then Type.error ("tyvar already in scope",
+                                                Tyvar.layout v)
+                            else r := true
+                         end)
       fun unbindTyvars (vs: Tyvar.t vector): unit =
-	 Vector.foreach (vs, fn v => tyvarInScope v := false)
+         Vector.foreach (vs, fn v => tyvarInScope v := false)
       (* checkType makes sure all tyvars are bound. *)
       fun checkType (ty: Type.t): unit =
-	 Type.hom {ty = ty,
-		   con = fn _ => (),
-		   var = fn a => if !(tyvarInScope a)
-				    then ()
-				 else Type.error ("tyvar not in scope",
-						  Tyvar.layout a)}
+         Type.hom {ty = ty,
+                   con = fn _ => (),
+                   var = fn a => if !(tyvarInScope a)
+                                    then ()
+                                 else Type.error ("tyvar not in scope",
+                                                  Tyvar.layout a)}
       fun checkTypes v = Vector.foreach (v, checkType)
       val {get = getCon: Con.t -> {tyvars: Tyvar.t vector, ty: Type.t},
-	   set, ...} =
-	 Property.getSetOnce (Con.plist,
-			      Property.initRaise ("scheme", Con.layout))
+           set, ...} =
+         Property.getSetOnce (Con.plist,
+                              Property.initRaise ("scheme", Con.layout))
       fun setCon ({con, arg}, tyvars, result: Type.t): unit =
-	 (checkType result
-	  ; set (con, {tyvars = tyvars,
-		       ty = (case arg of
-				NONE => result
-			      | SOME ty => (checkType ty
-					    ; Type.arrow (ty, result)))}))
+         (checkType result
+          ; set (con, {tyvars = tyvars,
+                       ty = (case arg of
+                                NONE => result
+                              | SOME ty => (checkType ty
+                                            ; Type.arrow (ty, result)))}))
       fun checkConExp (c: Con.t, ts: Type.t vector): Type.t =
-	 let
-	    val _ = checkTypes ts
-	    val {tyvars, ty} = getCon c
-	 in
-	    Type.substitute (ty, Vector.zip (tyvars, ts))
-	 end
+         let
+            val _ = checkTypes ts
+            val {tyvars, ty} = getCon c
+         in
+            Type.substitute (ty, Vector.zip (tyvars, ts))
+         end
       val {get = getVar: Var.t -> {tyvars: Tyvar.t vector, ty: Type.t},
-	   set = setVar, ...} =
-	 Property.getSet (Var.plist,
-			  Property.initRaise ("var scheme", Var.layout))
-      (* val getVar = Trace.trace ("getVar", Var.layout, Layout.ignore) getVar *)
-      (* val setVar = Trace.trace2 ("setVar", Var.layout, Layout.ignore, Layout.ignore) setVar *)
+           set = setVar, ...} =
+         Property.getSet (Var.plist,
+                          Property.initRaise ("var scheme", Var.layout))
+(*
+      val getVar = 
+         Trace.trace 
+         ("Xml.TypeCheck.getVar", Var.layout, Layout.ignore) 
+         getVar
+      val setVar = 
+         Trace.trace2 
+         ("Xml.TypeCheck.setVar", Var.layout, Layout.ignore, Layout.ignore) 
+         setVar
+*)
       fun checkVarExp (VarExp.T {var, targs}): Type.t =
-	 let
-	    val _ = checkTypes targs
-	    val {tyvars, ty} = getVar var
-	 in if Vector.length targs = Vector.length tyvars
-	       then Type.substitute (ty, Vector.zip (tyvars, targs))
-	    else
-	       Type.error ("variable applied to wrong number of type args",
-			  let open Layout
-			  in align [Var.layout var,
-				   seq [str "tyvars: ",
-					Vector.layout Tyvar.layout tyvars],
-				   seq [str "targs: ",
-					Vector.layout Type.layout targs]]
-			    end)
-	 end
+         let
+            val _ = checkTypes targs
+            val {tyvars, ty} = getVar var
+         in if Vector.length targs = Vector.length tyvars
+               then Type.substitute (ty, Vector.zip (tyvars, targs))
+            else
+               Type.error ("variable applied to wrong number of type args",
+                          let open Layout
+                          in align [Var.layout var,
+                                   seq [str "tyvars: ",
+                                        Vector.layout Tyvar.layout tyvars],
+                                   seq [str "targs: ",
+                                        Vector.layout Type.layout targs]]
+                            end)
+         end
       fun checkVarExps xs = Vector.map (xs, checkVarExp)
       fun checkPat (p as Pat.T {con, targs, arg}): Type.t =
-	 let
-	    val t = checkConExp (con, targs)
-	 in
-	    case (arg, Type.deArrowOpt t) of
-	         (NONE, NONE) => t
-	       | (SOME (x, ty), SOME (t1, t2)) =>
-		    (checkType ty
-		     ; if Type.equals (t1, ty)
-			  then (setVar (x, {tyvars = Vector.new0 (),
-					    ty = t1}) ; t2)
-		       else (Type.error
-			     ("argument constraint of wrong type",
-			      let open Layout
-			      in align [seq [str "constructor expects : ", Type.layout t1],
-					seq [str "but got: ", Type.layout ty],
-					seq [str "p: ", Pat.layout p]]
-			      end)))
-	       | _ => Type.error ("constructor pattern mismatch", Pat.layout p)
-	 end
+         let
+            val t = checkConExp (con, targs)
+         in
+            case (arg, Type.deArrowOpt t) of
+                 (NONE, NONE) => t
+               | (SOME (x, ty), SOME (t1, t2)) =>
+                    (checkType ty
+                     ; if Type.equals (t1, ty)
+                          then (setVar (x, {tyvars = Vector.new0 (),
+                                            ty = t1}) ; t2)
+                       else (Type.error
+                             ("argument constraint of wrong type",
+                              let open Layout
+                              in align [seq [str "constructor expects : ", Type.layout t1],
+                                        seq [str "but got: ", Type.layout ty],
+                                        seq [str "p: ", Pat.layout p]]
+                              end)))
+               | _ => Type.error ("constructor pattern mismatch", Pat.layout p)
+         end
       val traceCheckExp =
- 	 Trace.trace ("Xml.checkExp", Exp.layout, Type.layout)
+         Trace.trace ("Xml.TypeCheck.checkExp", Exp.layout, Type.layout)
       val traceCheckPrimExp = 
- 	 Trace.trace2
- 	 ("Xml.checkPrimExp", PrimExp.layout, Type.layout, Type.layout)
+         Trace.trace2
+         ("Xml.TypeCheck.checkPrimExp", PrimExp.layout, Type.layout, Type.layout)
       local
-	 val exnType = ref NONE
+         val exnType = ref NONE
       in
-	 fun isExnType t =
-	    case !exnType of
-	       NONE => (exnType := SOME t; true)
-	     | SOME t' => Type.equals (t, t')
+         fun isExnType t =
+            case !exnType of
+               NONE => (exnType := SOME t; true)
+             | SOME t' => Type.equals (t, t')
       end
       fun check (t: Type.t, t': Type.t, layout: unit -> Layout.t): unit =
-	 if Type.equals (t, t')
-	    then ()
-	 else Type.error ("type mismatch",
-			  Layout.align [Type.layout t,
-					Type.layout t',
-					layout ()])
+         if Type.equals (t, t')
+            then ()
+         else Type.error ("type mismatch",
+                          Layout.align [Type.layout t,
+                                        Type.layout t',
+                                        layout ()])
       fun checkExp arg: Type.t =
-	 traceCheckExp
-	 (fn (exp: Exp.t) =>
-	  let val {decs, result} = Exp.dest exp
-	  in List.foreach (decs, checkDec)
-	     ; checkVarExp result
-	  end handle e => (Layout.outputl (Exp.layout exp, Out.error)
-			   ; raise e))
-	 arg
+         traceCheckExp
+         (fn (exp: Exp.t) =>
+          let val {decs, result} = Exp.dest exp
+          in List.foreach (decs, checkDec)
+             ; checkVarExp result
+          end handle e => (Layout.outputl (Exp.layout exp, Out.error)
+                           ; raise e))
+         arg
       and checkPrimExp arg: Type.t =
-	 traceCheckPrimExp
-	 (fn (e: PrimExp.t, ty: Type.t) => 
-	 let
-	    fun error msg =
-	       Type.error (msg, let open Layout
-				in seq [str "exp: ", PrimExp.layout e]
-				end)
-	    fun checkApp (t1, x) =
-	       let
-		  val t2 = checkVarExp x
-	       in
-		  case Type.deArrowOpt t1 of
-		     NONE => error "function not of arrow type"
-		   | SOME (t2', t3) =>
-			if Type.equals (t2, t2') then t3
-			else
-			   Type.error
-			   ("actual and formal not of same type",
-			    let open Layout
-			    in align [seq [str "actual: ", Type.layout t2],
-				      seq [str "formal: ", Type.layout t2'],
-				      seq [str "expression: ",
-					   PrimExp.layout e]]
-			    end)
-	       end
-	 in
-	    case e of
-	       App {arg, func} => checkApp (checkVarExp func, arg)
-	     | Case {cases, default, test} =>
-		  let
-		     val default = Option.map (default, checkExp o #1)
-		     fun equalss v =
-			if Vector.isEmpty v
-			   then Error.bug "equalss"
-			else
-			   let
-			      val t = Vector.sub (v, 0)
-			   in
-			      if Vector.forall (v, fn t' => Type.equals (t, t'))
-				 then SOME t
-			      else NONE
-			   end
-		     fun finish (ptys: Type.t vector,
-				 etys: Type.t vector): Type.t =
-			case (equalss ptys, equalss etys) of
-			   (NONE, _) => error "patterns not of same type"
-			 | (_, NONE) => error "branches not of same type"
-			 | (SOME pty, SOME ety) =>
-			      if Type.equals (checkVarExp test, pty)
-				 then
-				    case default of
-				       NONE => ety
-				     | SOME t =>
-					  if Type.equals (ety, t)
-					     then ety
-					  else error "default of wrong type"
-			      else error "test and patterns of different types"
-		     datatype z = datatype Cases.t
-		  in
-		     case cases of
-			Con cases =>
-			   finish (Vector.unzip
-				   (Vector.map (cases, fn (p, e) =>
-						(checkPat p, checkExp e))))
-		      | Word (s, cs) =>
-			   finish (Vector.new1 (Type.word s),
-				   Vector.map (cs, fn (_, e) => checkExp e))
-		  end
-	     | ConApp {con, targs, arg} =>
-		  let
-		     val t = checkConExp (con, targs)
-		  in
-		     case arg of
-			NONE => t
-		      | SOME e => checkApp (t, e)
-		  end
-	     | Const c => Type.ofConst c
-	     | Handle {try, catch = (catch, catchType), handler, ...} =>
-		  let
-		     val _ = if isExnType catchType
-				then ()
-			     else error "handle with non-exn type for catch"
-		     val ty = checkExp try
-		     val _ = setVar (catch, {tyvars = Vector.new0 (),
-					     ty = catchType})
-		     val ty' = checkExp handler
-		  in
-		     if Type.equals (ty, ty')
-			then ty
-		     else error "bad handle"
-		  end
-	     | Lambda l => checkLambda l
-	     | PrimApp {args, prim, targs} =>
-		  let
-		     val _ = checkTypes targs
-		     val () =
-			if Type.checkPrimApp {args = checkVarExps args,
-					      prim = prim,
-					      result = ty,
-					      targs = targs}
-			   then ()
-			else error "bad primapp"
-		  in
-		     ty
-		  end
-	     | Profile _ => Type.unit
-	     | Raise {exn, ...} =>
-		  if isExnType (checkVarExp exn)
-		     then ty
-		  else error "bad raise"
-	     | Select {tuple, offset} =>
-		  (case Type.deTupleOpt (checkVarExp tuple) of
-		      NONE => error "selection from nontuple"
-		    | SOME ts => Vector.sub (ts, offset))
-	     | Tuple xs =>
-		  if 1 = Vector.length xs
-		     then error "unary tuple"
-		  else Type.tuple (checkVarExps xs)
-	     | Var x => checkVarExp x
-	 end) arg
+         traceCheckPrimExp
+         (fn (e: PrimExp.t, ty: Type.t) => 
+         let
+            fun error msg =
+               Type.error (msg, let open Layout
+                                in seq [str "exp: ", PrimExp.layout e]
+                                end)
+            fun checkApp (t1, x) =
+               let
+                  val t2 = checkVarExp x
+               in
+                  case Type.deArrowOpt t1 of
+                     NONE => error "function not of arrow type"
+                   | SOME (t2', t3) =>
+                        if Type.equals (t2, t2') then t3
+                        else
+                           Type.error
+                           ("actual and formal not of same type",
+                            let open Layout
+                            in align [seq [str "actual: ", Type.layout t2],
+                                      seq [str "formal: ", Type.layout t2'],
+                                      seq [str "expression: ",
+                                           PrimExp.layout e]]
+                            end)
+               end
+         in
+            case e of
+               App {arg, func} => checkApp (checkVarExp func, arg)
+             | Case {cases, default, test} =>
+                  let
+                     val default = Option.map (default, checkExp o #1)
+                     fun equalss v =
+                        if Vector.isEmpty v
+                           then Error.bug "Xml.TypeCheck.equalss"
+                        else
+                           let
+                              val t = Vector.sub (v, 0)
+                           in
+                              if Vector.forall (v, fn t' => Type.equals (t, t'))
+                                 then SOME t
+                              else NONE
+                           end
+                     fun finish (ptys: Type.t vector,
+                                 etys: Type.t vector): Type.t =
+                        case (equalss ptys, equalss etys) of
+                           (NONE, _) => error "patterns not of same type"
+                         | (_, NONE) => error "branches not of same type"
+                         | (SOME pty, SOME ety) =>
+                              if Type.equals (checkVarExp test, pty)
+                                 then
+                                    case default of
+                                       NONE => ety
+                                     | SOME t =>
+                                          if Type.equals (ety, t)
+                                             then ety
+                                          else error "default of wrong type"
+                              else error "test and patterns of different types"
+                     datatype z = datatype Cases.t
+                  in
+                     case cases of
+                        Con cases =>
+                           finish (Vector.unzip
+                                   (Vector.map (cases, fn (p, e) =>
+                                                (checkPat p, checkExp e))))
+                      | Word (s, cs) =>
+                           finish (Vector.new1 (Type.word s),
+                                   Vector.map (cs, fn (_, e) => checkExp e))
+                  end
+             | ConApp {con, targs, arg} =>
+                  let
+                     val t = checkConExp (con, targs)
+                  in
+                     case arg of
+                        NONE => t
+                      | SOME e => checkApp (t, e)
+                  end
+             | Const c => Type.ofConst c
+             | Handle {try, catch = (catch, catchType), handler, ...} =>
+                  let
+                     val _ = if isExnType catchType
+                                then ()
+                             else error "handle with non-exn type for catch"
+                     val ty = checkExp try
+                     val _ = setVar (catch, {tyvars = Vector.new0 (),
+                                             ty = catchType})
+                     val ty' = checkExp handler
+                  in
+                     if Type.equals (ty, ty')
+                        then ty
+                     else error "bad handle"
+                  end
+             | Lambda l => checkLambda l
+             | PrimApp {args, prim, targs} =>
+                  let
+                     val _ = checkTypes targs
+                     val () =
+                        if Type.checkPrimApp {args = checkVarExps args,
+                                              prim = prim,
+                                              result = ty,
+                                              targs = targs}
+                           then ()
+                        else error "bad primapp"
+                  in
+                     ty
+                  end
+             | Profile _ => Type.unit
+             | Raise {exn, ...} =>
+                  if isExnType (checkVarExp exn)
+                     then ty
+                  else error "bad raise"
+             | Select {tuple, offset} =>
+                  (case Type.deTupleOpt (checkVarExp tuple) of
+                      NONE => error "selection from nontuple"
+                    | SOME ts => Vector.sub (ts, offset))
+             | Tuple xs =>
+                  if 1 = Vector.length xs
+                     then error "unary tuple"
+                  else Type.tuple (checkVarExps xs)
+             | Var x => checkVarExp x
+         end) arg
       and checkLambda l: Type.t =
-	 let
-	    val {arg, argType, body, ...} = Lambda.dest l
-	    val _ = checkType argType
-	    val _ = setVar (arg, {tyvars = Vector.new0 (), ty = argType})
-	 in
-	    Type.arrow (argType, checkExp body)
-	 end
+         let
+            val {arg, argType, body, ...} = Lambda.dest l
+            val _ = checkType argType
+            val _ = setVar (arg, {tyvars = Vector.new0 (), ty = argType})
+         in
+            Type.arrow (argType, checkExp body)
+         end
       and checkDec d =
-	 let
-	    val check = fn (t, t') => check (t, t', fn () => Dec.layout d)
-	 in
-	    case d of
-	       Exception c => setCon (c, Vector.new0 (), Type.exn)
-	     | Fun {tyvars, decs} =>
-		  (bindTyvars tyvars
-		   ; (Vector.foreach
-		      (decs, fn {ty, var, ...} =>
-		       (checkType ty
-			; setVar (var, {tyvars = tyvars, ty = ty}))))
-		   ; Vector.foreach (decs, fn {ty, lambda, ...} =>
-				     check (ty, checkLambda lambda))
-		   ; unbindTyvars tyvars)
-	     | MonoVal {var, ty, exp} =>
-		  (checkType ty
-		   ; check (ty, checkPrimExp (exp, ty))
-		   ; setVar (var, {tyvars = Vector.new0 (), ty = ty}))
-	     | PolyVal {tyvars, var, ty, exp} =>
-		  (bindTyvars tyvars
-		   ; checkType ty
-		   ; check (ty, checkExp exp)
-		   ; unbindTyvars tyvars
-		   ; setVar (var, {tyvars = tyvars, ty = ty}))
-	 end handle e => (Layout.outputl (Dec.layout d, Out.error)
-			  ; raise e)
+         let
+            val check = fn (t, t') => check (t, t', fn () => Dec.layout d)
+         in
+            case d of
+               Exception c => setCon (c, Vector.new0 (), Type.exn)
+             | Fun {tyvars, decs} =>
+                  (bindTyvars tyvars
+                   ; (Vector.foreach
+                      (decs, fn {ty, var, ...} =>
+                       (checkType ty
+                        ; setVar (var, {tyvars = tyvars, ty = ty}))))
+                   ; Vector.foreach (decs, fn {ty, lambda, ...} =>
+                                     check (ty, checkLambda lambda))
+                   ; unbindTyvars tyvars)
+             | MonoVal {var, ty, exp} =>
+                  (checkType ty
+                   ; check (ty, checkPrimExp (exp, ty))
+                   ; setVar (var, {tyvars = Vector.new0 (), ty = ty}))
+             | PolyVal {tyvars, var, ty, exp} =>
+                  (bindTyvars tyvars
+                   ; checkType ty
+                   ; check (ty, checkExp exp)
+                   ; unbindTyvars tyvars
+                   ; setVar (var, {tyvars = tyvars, ty = ty}))
+         end handle e => (Layout.outputl (Dec.layout d, Out.error)
+                          ; raise e)
       val _ =
-	 Vector.foreach
-	 (datatypes, fn {tycon, tyvars, cons} =>
-	  let
-	     val _ = bindTyvars tyvars
-	     val ty = Type.con (tycon, Vector.map (tyvars, Type.var))
-	     val _ = Vector.foreach (cons, fn c => setCon (c, tyvars, ty))
-	     val _ = unbindTyvars tyvars
-	  in
-	     ()
-	  end)
+         Vector.foreach
+         (datatypes, fn {tycon, tyvars, cons} =>
+          let
+             val _ = bindTyvars tyvars
+             val ty = Type.con (tycon, Vector.map (tyvars, Type.var))
+             val _ = Vector.foreach (cons, fn c => setCon (c, tyvars, ty))
+             val _ = unbindTyvars tyvars
+          in
+             ()
+          end)
       val _ =
-	 if Type.equals (checkExp body, Type.unit)
-	    then ()
-	 else Error.bug "program must be of type unit"
+         if Type.equals (checkExp body, Type.unit)
+            then ()
+         else Error.bug "Xml.TypeCheck.typeCheck: program must be of type unit"
       val _ =
-	 case overflow of
-	    NONE => true
-	  | SOME x =>
-	       let val {tyvars, ty} = getVar x
-	       in
-		  0 = Vector.length tyvars
-		  andalso Type.equals (ty, Type.exn)
-	       end
+         case overflow of
+            NONE => true
+          | SOME x =>
+               let val {tyvars, ty} = getVar x
+               in
+                  0 = Vector.length tyvars
+                  andalso Type.equals (ty, Type.exn)
+               end
       val _ = Program.clear program
    in
       ()
    end
 
 val typeCheck = 
-   Trace.trace ("Xml.typeCheck", Program.layout, Unit.layout) typeCheck
+   Trace.trace ("Xml.TypeCheck.typeCheck", Program.layout, Unit.layout) typeCheck
 
 val typeCheck = Control.trace (Control.Pass, "typeCheck") typeCheck
 

Modified: mlton/branches/on-20050420-cmm-branch/mlton/xml/type-check.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/xml/type-check.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/xml/type-check.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature TYPE_CHECK_STRUCTS = 
    sig
       include XML_TREE

Modified: mlton/branches/on-20050420-cmm-branch/mlton/xml/uncurry.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/xml/uncurry.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/xml/uncurry.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 functor Uncurry(S: UNCURRY_STRUCTS): UNCURRY = 
 struct
 
@@ -16,521 +17,521 @@
     datatype D = T of {var: Var.t, lambda : Lambda.t}
 
     val {get = getArity: Var.t -> int, 
-	 set = setArity, ...} =
+         set = setArity, ...} =
       Property.getSet(Var.plist, 
-		      Property.initConst 0)
+                      Property.initConst 0)
 
     val {get = curriedRep: Var.t -> {unCurriedFun: D, curriedFun: D} option,
-	 set = setCurriedRep, ...} = 
+         set = setCurriedRep, ...} = 
       Property.getSet(Var.plist, 
-		      Property.initConst NONE)
+                      Property.initConst NONE)
 
     val {get = getType: Var.t -> {args: Type.t vector, result: Type.t}, 
-	 set = setType, ...} =
+         set = setType, ...} =
       Property.getSet(Var.plist, 
-		      Property.initConst {args = Vector.new1 Type.unit,
-					  result = Type.unit})
+                      Property.initConst {args = Vector.new1 Type.unit,
+                                          result = Type.unit})
 
-    fun getResultType(exp) =							
+    fun getResultType(exp) =                                                    
       let 
-	val {decs,result} = Exp.dest(exp)
+        val {decs,result} = Exp.dest(exp)
       in 
-	List.fold
-	(decs, Type.unit, fn (d, i) => 
-	 case d of
-	   MonoVal {var, ty, exp} =>
-	     if Var.equals(var,VarExp.var(result))
-	       then ty
-	       else i
-	 | Fun {tyvars, decs} =>
-		 Vector.fold
-		 (decs, Type.unit, fn ({var,ty,lambda}, i) =>
-		  if Var.equals(var,VarExp.var(result))
-		    then ty
-		    else i)
-	 | _ => i)
+        List.fold
+        (decs, Type.unit, fn (d, i) => 
+         case d of
+           MonoVal {var, ty, exp} =>
+             if Var.equals(var,VarExp.var(result))
+               then ty
+               else i
+         | Fun {tyvars, decs} =>
+                 Vector.fold
+                 (decs, Type.unit, fn ({var,ty,lambda}, i) =>
+                  if Var.equals(var,VarExp.var(result))
+                    then ty
+                    else i)
+         | _ => i)
       end
 
     fun buildLambda(f,args,types,resultType) =
       let 
-	val newArg' = Var.newString("c")
-	val newArg'' = Var.newString("c")
+        val newArg' = Var.newString("c")
+        val newArg'' = Var.newString("c")
       in
-	Lambda.new
-	{arg = Vector.last(args),
-	 argType = Vector.last(types),
-	 body = Vector.fold2
-	        (Vector.tabulate(Vector.length args - 2,
-				 fn i => Vector.sub(args, i + 1)),
-		 Vector.tabulate(Vector.length types - 2,
-				 fn i => Vector.sub(types, i + 1)),
-		 let 
-		   val newVar = Var.newString("c")
-		   val arg = Vector.sub(args,0)
-		   val argType = Vector.sub(types,0)
-		   val decs =
-		     [MonoVal
-		      {var = newVar,
-		       ty = Type.arrow(argType,resultType),
-		       exp = Lambda 
-		             (Lambda.new
-			      {arg = arg,
-			       argType = argType,
-			       body = Exp.new 
-			              {decs =
-				       [MonoVal
-					{var = newArg',
-					 ty = Type.tuple(Vector.rev(types)),
-					 exp = Tuple(Vector.map
-						     (Vector.rev(args),
-						      fn a => VarExp.mono(a)))},
-					MonoVal
-					{var = newArg'',
-					 ty = resultType,
-					 exp = App {func = f,
-						    arg = VarExp.mono(newArg')}}],
-				       result = VarExp.mono(newArg'')}})}]
-		   val result = VarExp.mono(newVar)
-		 in 
-		   Exp.new
-		   {decs = decs, result = result}
-		 end,
-		 fn (a, atype, i) => 
-		 let
-		   val newVar = Var.newString("c")
-		 in 
-		   Exp.new
-		   {decs = [MonoVal
-			    {var = newVar,
-			     ty = Type.arrow(atype, getResultType(i)),
-			     exp = Lambda(Lambda.new {arg = a,
-						      argType = atype,
-						      body = i})}],
-		    result = VarExp.mono(newVar)}
-		 end)}
+        Lambda.new
+        {arg = Vector.last(args),
+         argType = Vector.last(types),
+         body = Vector.fold2
+                (Vector.tabulate(Vector.length args - 2,
+                                 fn i => Vector.sub(args, i + 1)),
+                 Vector.tabulate(Vector.length types - 2,
+                                 fn i => Vector.sub(types, i + 1)),
+                 let 
+                   val newVar = Var.newString("c")
+                   val arg = Vector.sub(args,0)
+                   val argType = Vector.sub(types,0)
+                   val decs =
+                     [MonoVal
+                      {var = newVar,
+                       ty = Type.arrow(argType,resultType),
+                       exp = Lambda 
+                             (Lambda.new
+                              {arg = arg,
+                               argType = argType,
+                               body = Exp.new 
+                                      {decs =
+                                       [MonoVal
+                                        {var = newArg',
+                                         ty = Type.tuple(Vector.rev(types)),
+                                         exp = Tuple(Vector.map
+                                                     (Vector.rev(args),
+                                                      fn a => VarExp.mono(a)))},
+                                        MonoVal
+                                        {var = newArg'',
+                                         ty = resultType,
+                                         exp = App {func = f,
+                                                    arg = VarExp.mono(newArg')}}],
+                                       result = VarExp.mono(newArg'')}})}]
+                   val result = VarExp.mono(newVar)
+                 in 
+                   Exp.new
+                   {decs = decs, result = result}
+                 end,
+                 fn (a, atype, i) => 
+                 let
+                   val newVar = Var.newString("c")
+                 in 
+                   Exp.new
+                   {decs = [MonoVal
+                            {var = newVar,
+                             ty = Type.arrow(atype, getResultType(i)),
+                             exp = Lambda(Lambda.new {arg = a,
+                                                      argType = atype,
+                                                      body = i})}],
+                    result = VarExp.mono(newVar)}
+                 end)}
       end
     
     fun uncurryFun(dec) = 
       let 
-	fun lamExp(decs,result,args,types,newDecs,e) =
-	  case decs of
-	    [] => (args,types,e)
-	  | d::rest =>
-	      case d of
-		Dec.MonoVal{var, ty, exp = Const c} =>
-		  lamExp(rest, result, args,types,d::newDecs,e)
-	      | Dec.MonoVal{var, ty, exp = Var v} =>
-		  lamExp(rest, result, args,types,d::newDecs,e)
-	      | Dec.MonoVal{var, ty, exp = Select tuple} =>
-		  lamExp(rest, result, args,types,d::newDecs,e)
-	      | Dec.MonoVal{var, ty, exp = Lambda l} =>
-		  let 
-		    val body = Lambda.body(l)
-		    val r = result
-		    val {decs,result} = Exp.dest(body)
-		    val newDecs = List.append(newDecs,decs)
-		    val new = Exp.new{decs = newDecs,result = result}
-		  in 
-		    if Var.equals(var, VarExp.var(r))
-		       andalso List.isEmpty(rest)
-		      then lamExp(newDecs,
-				  result,
-				  Lambda.arg(l)::args,
-				  Lambda.argType(l)::types,
-				  [],
-				  new)
-		      else (args,types,e)
-		  end
-	      | _ => (args,types,e)
-	val lamExp = fn x =>
-	  let val (args,types,e) = lamExp x 
-	  in (Vector.fromList args, Vector.fromList types, e)
-	  end
+        fun lamExp(decs,result,args,types,newDecs,e) =
+          case decs of
+            [] => (args,types,e)
+          | d::rest =>
+              case d of
+                Dec.MonoVal{var, ty, exp = Const c} =>
+                  lamExp(rest, result, args,types,d::newDecs,e)
+              | Dec.MonoVal{var, ty, exp = Var v} =>
+                  lamExp(rest, result, args,types,d::newDecs,e)
+              | Dec.MonoVal{var, ty, exp = Select tuple} =>
+                  lamExp(rest, result, args,types,d::newDecs,e)
+              | Dec.MonoVal{var, ty, exp = Lambda l} =>
+                  let 
+                    val body = Lambda.body(l)
+                    val r = result
+                    val {decs,result} = Exp.dest(body)
+                    val newDecs = List.append(newDecs,decs)
+                    val new = Exp.new{decs = newDecs,result = result}
+                  in 
+                    if Var.equals(var, VarExp.var(r))
+                       andalso List.isEmpty(rest)
+                      then lamExp(newDecs,
+                                  result,
+                                  Lambda.arg(l)::args,
+                                  Lambda.argType(l)::types,
+                                  [],
+                                  new)
+                      else (args,types,e)
+                  end
+              | _ => (args,types,e)
+        val lamExp = fn x =>
+          let val (args,types,e) = lamExp x 
+          in (Vector.fromList args, Vector.fromList types, e)
+          end
 
-	val T{var,lambda} = dec
-	val (f, r) = let 
-		       val arg = Lambda.arg(lambda)
-		       val argType = Lambda.argType(lambda)
-		       val body = Lambda.body(lambda)
-		       val {decs,result} = Exp.dest(body)
-		     in 
-		       (var,  lamExp(decs, result, [arg], [argType], [],body))
-		     end
-		   
-	fun buildCurried (f,args,types,e) =
-	  let 
-	    val newVar = Var.newString("c")
-	    val newArg = Var.newString("c")
-	    val (newDecs,n) = 
-	      Vector.fold2
-	      (Vector.rev(args),
-	       Vector.rev(types),
-	       ([],0), fn (a, mtype, (l, i)) =>
-	       (MonoVal 
-		{var = a,
-		 ty = mtype,
-		 exp = PrimExp.Select {tuple = VarExp.mono(newArg),
-				       offset = i}}::l,
-		i+1))
-	    val newExp = Exp.new {decs = List.append(newDecs, Exp.decs(e)),
-				  result = Exp.result(e)}
-	    val resultType = getResultType(newExp)
-	    val unCurriedFun =
-	      T{var = newVar,
-		lambda = Lambda.new {arg = newArg,
-				     argType = Type.tuple(Vector.rev(types)), 
-				     body = newExp}}
-	    val newArgs = Vector.map(args, fn z => Var.newString("c"))
-	    val newFun = buildLambda(VarExp.mono(newVar),newArgs,types,resultType)
+        val T{var,lambda} = dec
+        val (f, r) = let 
+                       val arg = Lambda.arg(lambda)
+                       val argType = Lambda.argType(lambda)
+                       val body = Lambda.body(lambda)
+                       val {decs,result} = Exp.dest(body)
+                     in 
+                       (var,  lamExp(decs, result, [arg], [argType], [],body))
+                     end
+                   
+        fun buildCurried (f,args,types,e) =
+          let 
+            val newVar = Var.newString("c")
+            val newArg = Var.newString("c")
+            val (newDecs,n) = 
+              Vector.fold2
+              (Vector.rev(args),
+               Vector.rev(types),
+               ([],0), fn (a, mtype, (l, i)) =>
+               (MonoVal 
+                {var = a,
+                 ty = mtype,
+                 exp = PrimExp.Select {tuple = VarExp.mono(newArg),
+                                       offset = i}}::l,
+                i+1))
+            val newExp = Exp.new {decs = List.append(newDecs, Exp.decs(e)),
+                                  result = Exp.result(e)}
+            val resultType = getResultType(newExp)
+            val unCurriedFun =
+              T{var = newVar,
+                lambda = Lambda.new {arg = newArg,
+                                     argType = Type.tuple(Vector.rev(types)), 
+                                     body = newExp}}
+            val newArgs = Vector.map(args, fn z => Var.newString("c"))
+            val newFun = buildLambda(VarExp.mono(newVar),newArgs,types,resultType)
 
-	    val newFunBinding = T{var = f,  lambda = newFun}
-	  in 
-	    setCurriedRep(f, SOME {unCurriedFun = unCurriedFun,
-				   curriedFun = newFunBinding})
-	  end
+            val newFunBinding = T{var = f,  lambda = newFun}
+          in 
+            setCurriedRep(f, SOME {unCurriedFun = unCurriedFun,
+                                   curriedFun = newFunBinding})
+          end
       in 
-	case r of
-	  (args,types,e) =>
-	    (setArity(f, Vector.length(args));
-	     setType(f, {args = types, result = getResultType(e)});
-	     if getArity(f) > 1 
-	       then buildCurried(f,args,types,e)
-	       else ())
+        case r of
+          (args,types,e) =>
+            (setArity(f, Vector.length(args));
+             setType(f, {args = types, result = getResultType(e)});
+             if getArity(f) > 1 
+               then buildCurried(f,args,types,e)
+               else ())
       end
     
     fun replaceVar(decs,old,new) =
       let 
-	fun compare(v) = if Var.equals(VarExp.var(v),old)
-			   then new
-			   else v
-	fun replaceExp(e) = let 
-			      val {decs,result} = Exp.dest(e)
-			      val newDecs = replaceVar(decs,old,new)
-			      val newResult = compare(result)
-			    in 
-			      Exp.new {decs = newDecs,
-				       result = newResult}
-			    end
+        fun compare(v) = if Var.equals(VarExp.var(v),old)
+                           then new
+                           else v
+        fun replaceExp(e) = let 
+                              val {decs,result} = Exp.dest(e)
+                              val newDecs = replaceVar(decs,old,new)
+                              val newResult = compare(result)
+                            in 
+                              Exp.new {decs = newDecs,
+                                       result = newResult}
+                            end
       in  
-	List.map
-	(decs, fn d =>
-	 (case d of
-	    MonoVal {var, ty, exp} =>
-	      MonoVal {var=var,
-		       ty = ty,
-		       exp = (case exp of
-				Var v => PrimExp.Var(compare(v))
-			      | Tuple vs =>
-				  Tuple(Vector.map(vs, fn v => compare(v)))
-			      | Select {tuple,offset} =>
-				  Select {tuple = compare(tuple),
-					  offset = offset}
-			      | Lambda l =>
-				  let 
-				    val {arg,argType,body} = Lambda.dest(l)
-				    val {decs,result} = Exp.dest(body)
-				    val newDecs = replaceVar(decs,old,new)
-				  in 
-				    Lambda (Lambda.new
-					    {arg=arg,
-					     argType=argType,
-					     body=Exp.new {decs = newDecs,
-							   result = result}})
-				  end
-			      | ConApp {con,targs,arg} =>
-				  (case arg of
-				     NONE => exp
-				   | SOME v => ConApp {con = con,
-						       targs = targs,
-						       arg = SOME (compare(v))})
-			      | PrimApp {prim,targs,args} =>
-				  PrimApp {prim = prim,
-					   targs = targs,
-					   args = Vector.map(args, fn a => compare(a))}
-			      | App {func,arg} =>
-				  App {func = compare(func),
-				       arg = compare(arg)}
-			      | Raise {exn,filePos} => 
-				  Raise {exn = compare(exn), 
-					 filePos = filePos}
-			      | Case {test,cases,default} =>
-				  Case {test=compare(test),
-					cases = Cases.map
-					        (cases,fn e =>
-						 replaceExp(e)),
-					default = Option.map
-					          (default, fn (e,r) =>
-						   (replaceExp e,r))}
-			      | Handle {try,catch,handler} =>
-				  Handle {try = replaceExp(try),
-					  catch = catch,
-					  handler = replaceExp(handler)}
-			      | _ => exp)}
-	  | Fun {tyvars,decs} =>
-	      Fun {tyvars=tyvars,
-		   decs = Vector.map
-		          (decs, fn {var,ty,lambda} =>
-			   {var = var,
-			    ty = ty,
-			    lambda = let 
-				       val {arg,argType,body} =
-					 Lambda.dest(lambda)
-				     in 
-				       Lambda.new
-				       ({arg = arg,
-					 argType = argType,
-					 body = replaceExp(body)})
-				     end})}
-	  | _ => d))
+        List.map
+        (decs, fn d =>
+         (case d of
+            MonoVal {var, ty, exp} =>
+              MonoVal {var=var,
+                       ty = ty,
+                       exp = (case exp of
+                                Var v => PrimExp.Var(compare(v))
+                              | Tuple vs =>
+                                  Tuple(Vector.map(vs, fn v => compare(v)))
+                              | Select {tuple,offset} =>
+                                  Select {tuple = compare(tuple),
+                                          offset = offset}
+                              | Lambda l =>
+                                  let 
+                                    val {arg,argType,body} = Lambda.dest(l)
+                                    val {decs,result} = Exp.dest(body)
+                                    val newDecs = replaceVar(decs,old,new)
+                                  in 
+                                    Lambda (Lambda.new
+                                            {arg=arg,
+                                             argType=argType,
+                                             body=Exp.new {decs = newDecs,
+                                                           result = result}})
+                                  end
+                              | ConApp {con,targs,arg} =>
+                                  (case arg of
+                                     NONE => exp
+                                   | SOME v => ConApp {con = con,
+                                                       targs = targs,
+                                                       arg = SOME (compare(v))})
+                              | PrimApp {prim,targs,args} =>
+                                  PrimApp {prim = prim,
+                                           targs = targs,
+                                           args = Vector.map(args, fn a => compare(a))}
+                              | App {func,arg} =>
+                                  App {func = compare(func),
+                                       arg = compare(arg)}
+                              | Raise {exn,filePos} => 
+                                  Raise {exn = compare(exn), 
+                                         filePos = filePos}
+                              | Case {test,cases,default} =>
+                                  Case {test=compare(test),
+                                        cases = Cases.map
+                                                (cases,fn e =>
+                                                 replaceExp(e)),
+                                        default = Option.map
+                                                  (default, fn (e,r) =>
+                                                   (replaceExp e,r))}
+                              | Handle {try,catch,handler} =>
+                                  Handle {try = replaceExp(try),
+                                          catch = catch,
+                                          handler = replaceExp(handler)}
+                              | _ => exp)}
+          | Fun {tyvars,decs} =>
+              Fun {tyvars=tyvars,
+                   decs = Vector.map
+                          (decs, fn {var,ty,lambda} =>
+                           {var = var,
+                            ty = ty,
+                            lambda = let 
+                                       val {arg,argType,body} =
+                                         Lambda.dest(lambda)
+                                     in 
+                                       Lambda.new
+                                       ({arg = arg,
+                                         argType = argType,
+                                         body = replaceExp(body)})
+                                     end})}
+          | _ => d))
       end
 
     fun uncurryApp(decs,expResult) =
       let 
-	fun makeUncurryApp(f,arguments,lastCall) =
-	  let 
-	    val newArg = Var.newString("c")
-	    val newArg' = Var.newString("c")
-	    val varF = VarExp.var(f)
-	    val {args,result} = getType(varF)
-	    val var = (case curriedRep(varF) of
-			 NONE => Error.bug("in uncurryApp")
-		       | SOME {unCurriedFun,curriedFun} =>
-			   let val T{var,lambda} = unCurriedFun
-			   in var
-			   end)
-	    val argDec = MonoVal{var = newArg,
-				 ty = Type.tuple(Vector.rev(args)),
-				 exp = Tuple(Vector.rev(arguments))}
-	    val appDec = MonoVal{var = newArg',
-				 ty = result,
-				 exp = App {func = VarExp.mono(var),
-					    arg = VarExp.mono(newArg)}}
-	    val newR = if Var.equals(lastCall, VarExp.var(expResult))
-			 then (SOME newArg')
-			 else NONE
-	  in (appDec::[argDec],newR,newArg')
-	  end
+        fun makeUncurryApp(f,arguments,lastCall) =
+          let 
+            val newArg = Var.newString("c")
+            val newArg' = Var.newString("c")
+            val varF = VarExp.var(f)
+            val {args,result} = getType(varF)
+            val var = (case curriedRep(varF) of
+                         NONE => Error.bug "Uncurry: uncurryApp"
+                       | SOME {unCurriedFun,curriedFun} =>
+                           let val T{var,lambda} = unCurriedFun
+                           in var
+                           end)
+            val argDec = MonoVal{var = newArg,
+                                 ty = Type.tuple(Vector.rev(args)),
+                                 exp = Tuple(Vector.rev(arguments))}
+            val appDec = MonoVal{var = newArg',
+                                 ty = result,
+                                 exp = App {func = VarExp.mono(var),
+                                            arg = VarExp.mono(newArg)}}
+            val newR = if Var.equals(lastCall, VarExp.var(expResult))
+                         then (SOME newArg')
+                         else NONE
+          in (appDec::[argDec],newR,newArg')
+          end
       in case decs of
-	[] => Error.bug("in uncurryApp")
+        [] => Error.bug "Uncurry: uncurryApp"
       | d::r => (case d of
-		   MonoVal {var, ty, exp = App {func,arg}} =>
-		     (case curriedRep(VarExp.var(func)) of
-			NONE => Error.bug("in uncurryApp")
-		      | SOME _ => let 
-				    val arity = getArity(VarExp.var(func))
-				    fun loop(args,arity,d,f) =
-				      if arity = 0
-					then SOME (Vector.fromList args,d,f)
-					else
-					  case d of
-					    [] => NONE
-					  |  h::r =>
-					      (case h of
-						 MonoVal {var,ty,
-							  exp = App {func,arg}} =>
-						   if Var.equals(VarExp.var(func),f)
-						     then loop(arg::args,
-							       arity-1,
-							       r,
-							       var)
-						     else NONE
-					       | _ => NONE)
-				  in 
-				    case loop([arg],arity-1,r,var) of
-				      NONE => ([d],r,NONE)
-				    | SOME (args,r,lastCall) =>
-					let 
-					  val (newDecs,newR,newArg) =
-					    makeUncurryApp(func,args,lastCall)
-					  val r = (replaceVar(r,lastCall,
-							      VarExp.mono(newArg)))
-					in 
-					  (newDecs,r,newR)
-					end
-				  end)
-		 | _ => Error.bug("in uncurryApp"))
+                   MonoVal {var, ty, exp = App {func,arg}} =>
+                     (case curriedRep(VarExp.var(func)) of
+                        NONE => Error.bug "Uncurry: uncurryApp"
+                      | SOME _ => let 
+                                    val arity = getArity(VarExp.var(func))
+                                    fun loop(args,arity,d,f) =
+                                      if arity = 0
+                                        then SOME (Vector.fromList args,d,f)
+                                        else
+                                          case d of
+                                            [] => NONE
+                                          |  h::r =>
+                                              (case h of
+                                                 MonoVal {var,ty,
+                                                          exp = App {func,arg}} =>
+                                                   if Var.equals(VarExp.var(func),f)
+                                                     then loop(arg::args,
+                                                               arity-1,
+                                                               r,
+                                                               var)
+                                                     else NONE
+                                               | _ => NONE)
+                                  in 
+                                    case loop([arg],arity-1,r,var) of
+                                      NONE => ([d],r,NONE)
+                                    | SOME (args,r,lastCall) =>
+                                        let 
+                                          val (newDecs,newR,newArg) =
+                                            makeUncurryApp(func,args,lastCall)
+                                          val r = (replaceVar(r,lastCall,
+                                                              VarExp.mono(newArg)))
+                                        in 
+                                          (newDecs,r,newR)
+                                        end
+                                  end)
+                 | _ => Error.bug "Uncurry: uncurryApp")
       end
     
     fun singleUse(var,decs) =
       let 
-	fun compare(e) = (case e of
-			    App {func,arg} => Var.equals(VarExp.var(func),var)
-			  | _ => false)
+        fun compare(e) = (case e of
+                            App {func,arg} => Var.equals(VarExp.var(func),var)
+                          | _ => false)
       in 
-	List.fold
-	(decs, false, fn (d,r) => 
-	 case d of
-	   MonoVal {var,ty,exp} => compare(exp)
-	 | _ => false)
+        List.fold
+        (decs, false, fn (d,r) => 
+         case d of
+           MonoVal {var,ty,exp} => compare(exp)
+         | _ => false)
       end
-				       
-		     
+                                       
+                     
     fun transform(body) =
       let 
-	val {decs,result} = Exp.dest(body)
-	val newR = ref NONE
+        val {decs,result} = Exp.dest(body)
+        val newR = ref NONE
       in
-	Exp.new
-	{decs =
-	 List.rev
-	 (let 
-	    fun loop(decs,newDecs) =
-	      case decs of
-		[] => newDecs
-	      | d::rest =>
-		  (case d of
-		     MonoVal {var,ty, exp = Lambda l} =>
-		       (case curriedRep(var) of
-			  NONE => 
-			    let 
-			      val lamBody = Lambda.body(l)
-			      val arg = Lambda.arg(l)
-			      val argType = Lambda.argType(l)
-			      val newLam =
-				Lambda.new{arg=arg,
-					   argType = argType,
-					   body = transform(lamBody)}
-			      val newDec = MonoVal{var=var,
-						   ty=ty,
-						   exp = Lambda newLam}
-			    in 
-			      loop(rest,newDec::newDecs)
-			    end
-			| SOME {unCurriedFun,curriedFun} =>
-			    let 
-			      val T{var,lambda} = unCurriedFun
-			      val body = Lambda.body(lambda)
-			      val newBody = transform(body)
-			      val resultType = getResultType(newBody)
-			      val argType = Lambda.argType(lambda)
-			      val l = Lambda(Lambda.new
-					     {arg =
-					      Lambda.arg(lambda),
-					      argType = argType,
-					      body = newBody})
-			      val b1 = MonoVal{var=var,
-					       ty = Type.arrow(argType,resultType),
-					       exp = l}
-			      val T{var,lambda} = curriedFun
-			      val argType = Lambda.argType(lambda)
-			      val resultType = getResultType(Lambda.body(lambda))
-			      val b2 = MonoVal{var=var,
-					       ty =
-					       Type.arrow(argType, resultType),
-					       exp = Lambda lambda}
-			    in loop(rest,b2::(b1::newDecs))
-			    end)
-		   | MonoVal {var,ty,exp = App {func,arg}} => 
-		       (case curriedRep(VarExp.var(func)) of
-			  NONE => loop(rest,d::newDecs)
-			| SOME _ => 
-			    if singleUse(var,rest)
-			      then 
-				let 
-				  val (appDecs,r,newResult) =
-				    uncurryApp(decs,result)
-				   in (newR := newResult;
-				       loop(r,List.append(appDecs,newDecs)))
-				end
-			      else loop(rest,d::newDecs))
-		   | MonoVal {var,ty,exp = Case {test,cases,default}} =>
-		       let 
-			 val newCases =
-			   Cases.map(cases, fn e => transform(e))
-			 val default = Option.map
-			               (default, fn (e,r) =>
-					(transform(e),r))
-		       in 
-			 loop(rest,
-			      (MonoVal{var=var,
-				       ty=ty,
-				       exp = Case {test = test,
-						   cases = newCases,
-						   default = default}}::
-			       newDecs))
-		       end
-		   | MonoVal {var,ty, exp = Handle {try,catch,handler}} =>
-		       loop(rest, 
-			    (MonoVal{var=var,
-				     ty=ty,
-				     exp = Handle {try = transform(try),
-						   catch = catch,
-						   handler = transform(handler)}}::
-			     newDecs))
-		   | Fun {tyvars,decs} => 
-		       loop(rest,
-			    Fun {tyvars = Vector.new0 (),
-				 decs =
-				 Vector.fromList(
-				 Vector.fold
-				 (decs,
-				  []:{var:Var.t,
-				      ty:Type.t,
-				      lambda:Lambda.t} list,
-				  fn (d as {var,
-					    ty,
-					    lambda:Lambda.t},
-				      acc) => 
-				  (case curriedRep(var) of
-				     NONE =>
-				       let 
-					 val body = Lambda.body(lambda)
-					 val arg = Lambda.arg(lambda)
-					 val argType = Lambda.argType(lambda)
-					 val newBody = transform(body)
-					 val newLam = Lambda.new{arg = arg,
-								 argType = argType,
-								 body = newBody}
-				       in 
-					 {var=var,
-					  ty=ty,
-					  lambda=newLam}::acc
-				       end
-				   | SOME {unCurriedFun,curriedFun} =>
-				       let 
-					 val T{var,lambda} = unCurriedFun
-					 val body = Lambda.body(lambda)
-					 val newBody = transform(body)
-					 val argType = Lambda.argType(lambda)
-					 val resultType = getResultType(newBody)
-					 val b1 = {var=var,
-						   ty = Type.arrow(argType,resultType),
-						   lambda =
-						   Lambda.new{arg =  Lambda.arg(lambda),
-							      argType = argType,
-							      body = newBody}}
-					 val T{var,lambda} = curriedFun
-					 val argType = Lambda.argType(lambda)
-					 val newBody = transform(Lambda.body(lambda))
-					 val resultType = getResultType(newBody)
-					 val b2 = {var=var,
-						   ty = Type.arrow(argType,resultType),
-						   lambda = lambda}
-				       in b1::(b2::acc)
-				       end)))}::newDecs)
-		   | _ => loop(rest,d::newDecs))
-	  in loop(decs,[])
-	  end),
-	 result = (case !newR of
-		     NONE => result
-		   | SOME r => VarExp.mono(r))}
+        Exp.new
+        {decs =
+         List.rev
+         (let 
+            fun loop(decs,newDecs) =
+              case decs of
+                [] => newDecs
+              | d::rest =>
+                  (case d of
+                     MonoVal {var,ty, exp = Lambda l} =>
+                       (case curriedRep(var) of
+                          NONE => 
+                            let 
+                              val lamBody = Lambda.body(l)
+                              val arg = Lambda.arg(l)
+                              val argType = Lambda.argType(l)
+                              val newLam =
+                                Lambda.new{arg=arg,
+                                           argType = argType,
+                                           body = transform(lamBody)}
+                              val newDec = MonoVal{var=var,
+                                                   ty=ty,
+                                                   exp = Lambda newLam}
+                            in 
+                              loop(rest,newDec::newDecs)
+                            end
+                        | SOME {unCurriedFun,curriedFun} =>
+                            let 
+                              val T{var,lambda} = unCurriedFun
+                              val body = Lambda.body(lambda)
+                              val newBody = transform(body)
+                              val resultType = getResultType(newBody)
+                              val argType = Lambda.argType(lambda)
+                              val l = Lambda(Lambda.new
+                                             {arg =
+                                              Lambda.arg(lambda),
+                                              argType = argType,
+                                              body = newBody})
+                              val b1 = MonoVal{var=var,
+                                               ty = Type.arrow(argType,resultType),
+                                               exp = l}
+                              val T{var,lambda} = curriedFun
+                              val argType = Lambda.argType(lambda)
+                              val resultType = getResultType(Lambda.body(lambda))
+                              val b2 = MonoVal{var=var,
+                                               ty =
+                                               Type.arrow(argType, resultType),
+                                               exp = Lambda lambda}
+                            in loop(rest,b2::(b1::newDecs))
+                            end)
+                   | MonoVal {var,ty,exp = App {func,arg}} => 
+                       (case curriedRep(VarExp.var(func)) of
+                          NONE => loop(rest,d::newDecs)
+                        | SOME _ => 
+                            if singleUse(var,rest)
+                              then 
+                                let 
+                                  val (appDecs,r,newResult) =
+                                    uncurryApp(decs,result)
+                                   in (newR := newResult;
+                                       loop(r,List.append(appDecs,newDecs)))
+                                end
+                              else loop(rest,d::newDecs))
+                   | MonoVal {var,ty,exp = Case {test,cases,default}} =>
+                       let 
+                         val newCases =
+                           Cases.map(cases, fn e => transform(e))
+                         val default = Option.map
+                                       (default, fn (e,r) =>
+                                        (transform(e),r))
+                       in 
+                         loop(rest,
+                              (MonoVal{var=var,
+                                       ty=ty,
+                                       exp = Case {test = test,
+                                                   cases = newCases,
+                                                   default = default}}::
+                               newDecs))
+                       end
+                   | MonoVal {var,ty, exp = Handle {try,catch,handler}} =>
+                       loop(rest, 
+                            (MonoVal{var=var,
+                                     ty=ty,
+                                     exp = Handle {try = transform(try),
+                                                   catch = catch,
+                                                   handler = transform(handler)}}::
+                             newDecs))
+                   | Fun {tyvars,decs} => 
+                       loop(rest,
+                            Fun {tyvars = Vector.new0 (),
+                                 decs =
+                                 Vector.fromList(
+                                 Vector.fold
+                                 (decs,
+                                  []:{var:Var.t,
+                                      ty:Type.t,
+                                      lambda:Lambda.t} list,
+                                  fn (d as {var,
+                                            ty,
+                                            lambda:Lambda.t},
+                                      acc) => 
+                                  (case curriedRep(var) of
+                                     NONE =>
+                                       let 
+                                         val body = Lambda.body(lambda)
+                                         val arg = Lambda.arg(lambda)
+                                         val argType = Lambda.argType(lambda)
+                                         val newBody = transform(body)
+                                         val newLam = Lambda.new{arg = arg,
+                                                                 argType = argType,
+                                                                 body = newBody}
+                                       in 
+                                         {var=var,
+                                          ty=ty,
+                                          lambda=newLam}::acc
+                                       end
+                                   | SOME {unCurriedFun,curriedFun} =>
+                                       let 
+                                         val T{var,lambda} = unCurriedFun
+                                         val body = Lambda.body(lambda)
+                                         val newBody = transform(body)
+                                         val argType = Lambda.argType(lambda)
+                                         val resultType = getResultType(newBody)
+                                         val b1 = {var=var,
+                                                   ty = Type.arrow(argType,resultType),
+                                                   lambda =
+                                                   Lambda.new{arg =  Lambda.arg(lambda),
+                                                              argType = argType,
+                                                              body = newBody}}
+                                         val T{var,lambda} = curriedFun
+                                         val argType = Lambda.argType(lambda)
+                                         val newBody = transform(Lambda.body(lambda))
+                                         val resultType = getResultType(newBody)
+                                         val b2 = {var=var,
+                                                   ty = Type.arrow(argType,resultType),
+                                                   lambda = lambda}
+                                       in b1::(b2::acc)
+                                       end)))}::newDecs)
+                   | _ => loop(rest,d::newDecs))
+          in loop(decs,[])
+          end),
+         result = (case !newR of
+                     NONE => result
+                   | SOME r => VarExp.mono(r))}
       end
   in
     Exp.foreachExp
     (body, fn e =>
      let 
        val {decs,result} = Exp.dest(e)
-     in	
+     in 
        List.foreach
        (decs, fn d =>
-	case d of
-	  MonoVal {var,ty,exp = Lambda l} =>
-	    uncurryFun(T{var=var,lambda=l})
-	| Fun {tyvars,decs} =>
-	    Vector.foreach
-	    (decs, fn {var,ty,lambda} =>
-	     uncurryFun(T{var=var,lambda=lambda}))
-	| _ => ())
+        case d of
+          MonoVal {var,ty,exp = Lambda l} =>
+            uncurryFun(T{var=var,lambda=l})
+        | Fun {tyvars,decs} =>
+            Vector.foreach
+            (decs, fn {var,ty,lambda} =>
+             uncurryFun(T{var=var,lambda=lambda}))
+        | _ => ())
      end); 
     let val newBody = transform(body)
     in 

Modified: mlton/branches/on-20050420-cmm-branch/mlton/xml/uncurry.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/xml/uncurry.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/xml/uncurry.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 type int = Int.t
 
 signature UNCURRY_STRUCTS = 
@@ -15,6 +16,6 @@
 signature UNCURRY = 
    sig
       include UNCURRY_STRUCTS
-	 
+         
       val uncurry: Program.t -> Program.t
    end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/xml/xml-simplify.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/xml/xml-simplify.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/xml/xml-simplify.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,58 +1,76 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 functor XmlSimplify (S: XML_SIMPLIFY_STRUCTS): XML_SIMPLIFY = 
 struct
 
 open S
 
 structure SimplifyTypes = SimplifyTypes (structure Input = S
-					 structure Output = S)
+                                         structure Output = S)
 
 type pass = {name: string,
-	     doit: Program.t -> Program.t}
+             doit: Program.t -> Program.t}
 
-val xmlPasses : pass list ref = ref
-   [
-    {name = "xmlShrink", doit = S.shrink},
-    {name = "xmlSimplifyTypes", doit = SimplifyTypes.simplifyTypes}
-   ]
+val xmlPassesDefault =
+   {name = "xmlShrink", doit = S.shrink} ::
+   {name = "xmlSimplifyTypes", doit = SimplifyTypes.simplifyTypes} ::
+   nil
 
+val xmlPassesMinimal =
+   nil
+
+val xmlPasses : pass list ref = ref xmlPassesDefault
+
 local
    type passGen = string -> pass option
      
    fun mkSimplePassGen (name, doit): passGen =
       let val count = Counter.new 1
       in fn s => if s = name
-		    then SOME {name = concat [name, "#",
-					      Int.toString (Counter.next count)],
-			       doit = doit}
-		    else NONE
+                    then SOME {name = concat [name, "#",
+                                              Int.toString (Counter.next count)],
+                               doit = doit}
+                    else NONE
       end
 
    val passGens =
       (List.map([("xmlShrink", S.shrink),
-		 ("xmlSimplifyTypes", SimplifyTypes.simplifyTypes)],
-		mkSimplePassGen))
+                 ("xmlSimplifyTypes", SimplifyTypes.simplifyTypes)],
+                mkSimplePassGen))
 
-   fun xmlPassesSet s =
-      DynamicWind.withEscape
+   fun xmlPassesSetCustom s =
+      Exn.withEscape
       (fn esc =>
        (let val ss = String.split (s, #":")
-	in
-	   xmlPasses :=
-	   List.map(ss, fn s =>
-		    case (List.peekMap (passGens, fn gen => gen s)) of
-		       NONE => esc (Result.No s)
-		     | SOME pass => pass)
-	   ; Result.Yes ss
-	end))
+        in
+           xmlPasses :=
+           List.map(ss, fn s =>
+                    case (List.peekMap (passGens, fn gen => gen s)) of
+                       NONE => esc (Result.No s)
+                     | SOME pass => pass)
+           ; Control.xmlPasses := ss
+           ; Result.Yes ()
+        end))
+
+   datatype t = datatype Control.optimizationPasses
+   fun xmlPassesSet opt =
+      case opt of
+         OptPassesDefault => (xmlPasses := xmlPassesDefault
+                              ; Control.xmlPasses := ["default"]
+                              ; Result.Yes ())
+       | OptPassesMinimal => (xmlPasses := xmlPassesMinimal
+                              ; Control.xmlPasses := ["minimal"]
+                              ; Result.Yes ())
+       | OptPassesCustom s => xmlPassesSetCustom s
 in
    val _ = Control.xmlPassesSet := xmlPassesSet
+   val _ = List.push (Control.optimizationPassesSet, ("xml", xmlPassesSet))
 end
 
    
@@ -64,16 +82,16 @@
     ; (List.fold
        (!xmlPasses, p, fn ({name, doit}, p) =>
       if List.exists (!Control.dropPasses, fn re =>
-		      Regexp.Compiled.matchesAll (re, name))
+                      Regexp.Compiled.matchesAll (re, name))
          then p
       else
          let
             val _ =
-	       let open Control
-	       in maybeSaveToFile
-		  ({name = name, suffix = "pre.xml"},
-		   Control.No, p, Control.Layout Program.layout)
-	       end
+               let open Control
+               in maybeSaveToFile
+                  ({name = name, suffix = "pre.xml"},
+                   Control.No, p, Control.Layout Program.layout)
+               end
             val p =
                Control.passTypeCheck
                {name = name,
@@ -88,15 +106,15 @@
          end)))
 
 val simplify = fn p => let
-			 (* Always want to type check the initial and final XML
-			  * programs, even if type checking is turned off, just
-			  * to catch bugs.
-			  *)
-			 val _ = typeCheck p
-			 val p' = simplify p
-			 val _ = typeCheck p'
-		       in
-			 p'
-		       end
+                         (* Always want to type check the initial and final XML
+                          * programs, even if type checking is turned off, just
+                          * to catch bugs.
+                          *)
+                         val _ = typeCheck p
+                         val p' = simplify p
+                         val _ = typeCheck p'
+                       in
+                         p'
+                       end
 
 end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/xml/xml-simplify.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/xml/xml-simplify.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/xml/xml-simplify.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature XML_SIMPLIFY_STRUCTS = 
    sig
       include XML_TREE

Modified: mlton/branches/on-20050420-cmm-branch/mlton/xml/xml-tree.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/xml/xml-tree.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/xml/xml-tree.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,9 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 functor XmlTree (S: XML_TREE_STRUCTS): XML_TREE =
@@ -17,13 +17,13 @@
       open T
 
       datatype dest =
-	 Var of Tyvar.t
+         Var of Tyvar.t
        | Con of Tycon.t * t vector
 
       fun dest t =
-	 case Dest.dest t of
-	    Dest.Var a => Var a
-	  | Dest.Con x => Con x
+         case Dest.dest t of
+            Dest.Var a => Var a
+          | Dest.Con x => Con x
    end
 
 fun maybeConstrain (x, t) =
@@ -31,7 +31,7 @@
       open Layout
    in
       if !Control.showTypes
-	 then seq [x, str ": ", Type.layout t]
+         then seq [x, str ": ", Type.layout t]
       else x
    end
 
@@ -40,112 +40,112 @@
 in
    fun layoutTargs (ts: Type.t vector) =
       if !Control.showTypes
-	 andalso 0 < Vector.length ts
-	 then list (Vector.toListMap (ts, Type.layout))
+         andalso 0 < Vector.length ts
+         then list (Vector.toListMap (ts, Type.layout))
       else empty
 end
 
 structure Pat =
    struct
       datatype t = T of {arg: (Var.t * Type.t) option,
-			 con: Con.t,
-			 targs: Type.t vector}
-	 
+                         con: Con.t,
+                         targs: Type.t vector}
+         
       local
-	 open Layout
+         open Layout
       in
-	 fun layout (T {arg, con, targs}) =
-	    seq [Con.layout con,
-		 layoutTargs targs,
-		 case arg of
-		    NONE => empty
-		  | SOME (x, t) =>
-		       maybeConstrain (seq [str " ", Var.layout x], t)]
+         fun layout (T {arg, con, targs}) =
+            seq [Con.layout con,
+                 layoutTargs targs,
+                 case arg of
+                    NONE => empty
+                  | SOME (x, t) =>
+                       maybeConstrain (seq [str " ", Var.layout x], t)]
       end
 
       fun con (T {con, ...}) = con
 
       local
-	 fun make c = T {con = c, targs = Vector.new0 (), arg = NONE}
+         fun make c = T {con = c, targs = Vector.new0 (), arg = NONE}
       in 
-	 val falsee = make Con.falsee
-	 val truee = make Con.truee
+         val falsee = make Con.falsee
+         val truee = make Con.truee
       end
    end
 
 structure Cases =
    struct
       datatype 'a t = 
-	 Con of (Pat.t * 'a) vector
+         Con of (Pat.t * 'a) vector
        | Word of WordSize.t * (WordX.t * 'a) vector
 
       fun layout (cs, layout) =
-	 let
-	    open Layout
-	    fun doit (v, f) =
-	       align (Vector.toListMap (v, fn (x, e) =>
-					align [seq [f x, str " => "],
-					       indent (layout e, 3)]))
-	 in
-	    case cs of
-	       Con v => doit (v, Pat.layout)
-	     | Word (_, v) => doit (v, WordX.layout)
-	 end
+         let
+            open Layout
+            fun doit (v, f) =
+               align (Vector.toListMap (v, fn (x, e) =>
+                                        align [seq [f x, str " => "],
+                                               indent (layout e, 3)]))
+         in
+            case cs of
+               Con v => doit (v, Pat.layout)
+             | Word (_, v) => doit (v, WordX.layout)
+         end
 
       fun fold (c: 'a t, b: 'b, f: 'a * 'b -> 'b): 'b =
-	 let
-	    fun doit l = Vector.fold (l, b, fn ((_, a), b) => f (a, b))
-	 in
-	    case c of
-	       Con l => doit l
-	     | Word (_, l) => doit l
-	 end
+         let
+            fun doit l = Vector.fold (l, b, fn ((_, a), b) => f (a, b))
+         in
+            case c of
+               Con l => doit l
+             | Word (_, l) => doit l
+         end
 
       fun map (c: 'a t, f: 'a -> 'b): 'b t =
-	 let
-	    fun doit l = Vector.map (l, fn (i, x) => (i, f x))
-	 in
-	    case c of
-	       Con l => Con (doit l)
-	     | Word (s, l) => Word (s, doit l)
-	 end
+         let
+            fun doit l = Vector.map (l, fn (i, x) => (i, f x))
+         in
+            case c of
+               Con l => Con (doit l)
+             | Word (s, l) => Word (s, doit l)
+         end
       
       fun foreach (c, f) = fold (c, (), fn (x, ()) => f x)
 
       fun foreach' (c: 'a t, f: 'a -> unit, fc: Pat.t -> unit): unit =
-	 let
-	    fun doit l = Vector.foreach (l, fn (_, a) => f a)
-	 in
-	    case c of
-	       Con l => Vector.foreach (l, fn (c, a) => (fc c; f a))
-	     | Word (_, l) => doit l
-	 end
+         let
+            fun doit l = Vector.foreach (l, fn (_, a) => f a)
+         in
+            case c of
+               Con l => Vector.foreach (l, fn (c, a) => (fc c; f a))
+             | Word (_, l) => doit l
+         end
    end
 
 structure VarExp =
    struct
       datatype t = T of {targs: Type.t vector,
-			 var: Var.t}
+                         var: Var.t}
 
       fun mono var = T {var = var, targs = Vector.new0 ()}
 
       local
-	 fun make f (T r) = f r
+         fun make f (T r) = f r
       in
-	 val targs = make #targs
-	 val var = make #var
+         val targs = make #targs
+         val var = make #var
       end
    
       fun layout (T {var, targs, ...}) =
-	 if !Control.showTypes
-	    then let open Layout
-		 in
-		    if Vector.isEmpty targs
-		       then Var.layout var
-		    else seq [Var.layout var, str " ",
-			      Vector.layout Type.layout targs]
-		 end
-	 else Var.layout var
+         if !Control.showTypes
+            then let open Layout
+                 in
+                    if Vector.isEmpty targs
+                       then Var.layout var
+                    else seq [Var.layout var, str " ",
+                              Vector.layout Type.layout targs]
+                 end
+         else Var.layout var
    end
    
 (*---------------------------------------------------*)
@@ -154,134 +154,134 @@
 
 datatype exp =
    Exp of {decs: dec list,
-	   result: VarExp.t}
+           result: VarExp.t}
 and primExp =
     App of {func: VarExp.t,
-	    arg: VarExp.t}
+            arg: VarExp.t}
   | Case of {test: VarExp.t,
-	     cases: exp Cases.t,
-	     default: (exp * Region.t) option}
+             cases: exp Cases.t,
+             default: (exp * Region.t) option}
   | ConApp of {con: Con.t,
-	       targs: Type.t vector,
-	       arg: VarExp.t option}
+               targs: Type.t vector,
+               arg: VarExp.t option}
   | Const of Const.t
   | Handle of {try: exp,
-	       catch: Var.t * Type.t,
-	       handler: exp}
+               catch: Var.t * Type.t,
+               handler: exp}
   | Lambda of lambda
   | PrimApp of {args: VarExp.t vector,
-		prim: Type.t Prim.t,
-		targs: Type.t vector}
+                prim: Type.t Prim.t,
+                targs: Type.t vector}
   | Profile of ProfileExp.t
   | Raise of {exn: VarExp.t, extend: bool}
   | Select of {tuple: VarExp.t,
-	       offset: int}
+               offset: int}
   | Tuple of VarExp.t vector
   | Var of VarExp.t
 and dec =
    Exception of {arg: Type.t option,
-		 con: Con.t}
+                 con: Con.t}
   | Fun of {decs: {lambda: lambda,
-		   ty: Type.t,
-		   var: Var.t} vector,
-	    tyvars: Tyvar.t vector}
+                   ty: Type.t,
+                   var: Var.t} vector,
+            tyvars: Tyvar.t vector}
   | MonoVal of {exp: primExp,
-		ty: Type.t,
-		var: Var.t}
+                ty: Type.t,
+                var: Var.t}
   | PolyVal of {exp: exp,
-		ty: Type.t,
-		tyvars: Tyvar.t vector,
-		var: Var.t}
+                ty: Type.t,
+                tyvars: Tyvar.t vector,
+                var: Var.t}
 and lambda = Lam of {arg: Var.t,
-		     argType: Type.t,
-		     body: exp,
-		     mayInline: bool,
-		     plist: PropertyList.t}
+                     argType: Type.t,
+                     body: exp,
+                     mayInline: bool,
+                     plist: PropertyList.t}
 
 local
    open Layout
 in
    fun layoutConArg {arg, con} =
       seq [Con.layout con,
-	   case arg of
-	      NONE => empty
-	    | SOME t => seq [str " of ", Type.layout t]]
+           case arg of
+              NONE => empty
+            | SOME t => seq [str " of ", Type.layout t]]
    fun layoutTyvars ts =
       case Vector.length ts of
-	 0 => empty
+         0 => empty
        | 1 => seq [str " ", Tyvar.layout (Vector.sub (ts, 0))]
        | _ => seq [str " ", tuple (Vector.toListMap (ts, Tyvar.layout))]
    fun layoutDec d =
       case d of
-	 Exception ca =>
-	    seq [str "exception ", layoutConArg ca]
+         Exception ca =>
+            seq [str "exception ", layoutConArg ca]
        | Fun {decs, tyvars} =>
-	    align [seq [str "val rec", layoutTyvars tyvars, str " "],
-		   indent (align (Vector.toListMap
-				  (decs, fn {lambda, ty, var} =>
-				   align [seq [maybeConstrain (Var.layout var, ty),
-					       str " = "],
-					  indent (layoutLambda lambda, 3)])),
-			   3)]
+            align [seq [str "val rec", layoutTyvars tyvars, str " "],
+                   indent (align (Vector.toListMap
+                                  (decs, fn {lambda, ty, var} =>
+                                   align [seq [maybeConstrain (Var.layout var, ty),
+                                               str " = "],
+                                          indent (layoutLambda lambda, 3)])),
+                           3)]
        | MonoVal {exp, ty, var} =>
-	    align [seq [str "val ",
-			maybeConstrain (Var.layout var, ty), str " = "],
-		   indent (layoutPrimExp exp, 3)]
+            align [seq [str "val ",
+                        maybeConstrain (Var.layout var, ty), str " = "],
+                   indent (layoutPrimExp exp, 3)]
        | PolyVal {exp, ty, tyvars, var} =>
-	    align [seq [str "val",
-			if !Control.showTypes
-			   then layoutTyvars tyvars
-			else empty,
-			   str " ",
-			   maybeConstrain (Var.layout var, ty),
-			   str " = "],
-		   indent (layoutExp exp, 3)]
+            align [seq [str "val",
+                        if !Control.showTypes
+                           then layoutTyvars tyvars
+                        else empty,
+                           str " ",
+                           maybeConstrain (Var.layout var, ty),
+                           str " = "],
+                   indent (layoutExp exp, 3)]
    and layoutExp (Exp {decs, result}) =
       align [str "let",
-	     indent (align (List.map (decs, layoutDec)), 3),
-	     str "in",
-	     indent (VarExp.layout result, 3),
-	     str "end"]
+             indent (align (List.map (decs, layoutDec)), 3),
+             str "in",
+             indent (VarExp.layout result, 3),
+             str "end"]
    and layoutPrimExp e =
       case e of
-	 App {arg, func} => seq [VarExp.layout func, str " ", VarExp.layout arg]
+         App {arg, func} => seq [VarExp.layout func, str " ", VarExp.layout arg]
        | Case {test, cases, default} =>
-	    align [seq [str "case ", VarExp.layout test, str " of"],
-		   indent
-		   (align
-		    [case default of
-			NONE => empty
-		      | SOME (e, _) => seq [str "_ => ", layoutExp e]],
-		    2),
-		   Cases.layout (cases, layoutExp)]
+            align [seq [str "case ", VarExp.layout test, str " of"],
+                   Cases.layout (cases, layoutExp),
+                   indent
+                   (align
+                    [case default of
+                        NONE => empty
+                      | SOME (e, _) => seq [str "_ => ", layoutExp e]],
+                    2)]
        | ConApp {arg, con, targs, ...} =>
-	    seq [Con.layout con,
-		 layoutTargs targs,
-		 case arg of
-		    NONE => empty
-		  | SOME x => seq [str " ", VarExp.layout x]]
+            seq [Con.layout con,
+                 layoutTargs targs,
+                 case arg of
+                    NONE => empty
+                  | SOME x => seq [str " ", VarExp.layout x]]
        | Const c => Const.layout c
        | Handle {catch, handler, try} =>
-	    align [layoutExp try,
-		   seq [str "handle ",
-			Var.layout (#1 catch),
-			str " => ", layoutExp handler]]
+            align [layoutExp try,
+                   seq [str "handle ",
+                        Var.layout (#1 catch),
+                        str " => ", layoutExp handler]]
        | Lambda l => layoutLambda l
        | PrimApp {args, prim, targs} =>
-	    seq [Prim.layout prim,
-		 layoutTargs targs,
-		 str " ", tuple (Vector.toListMap (args, VarExp.layout))]
+            seq [Prim.layout prim,
+                 layoutTargs targs,
+                 str " ", tuple (Vector.toListMap (args, VarExp.layout))]
        | Profile e => ProfileExp.layout e
        | Raise {exn, ...} => seq [str "raise ", VarExp.layout exn]
        | Select {offset, tuple} =>
-	    seq [str "#", Int.layout offset, str " ", VarExp.layout tuple]
+            seq [str "#", Int.layout offset, str " ", VarExp.layout tuple]
        | Tuple xs => tuple (Vector.toListMap (xs, VarExp.layout))
        | Var x => VarExp.layout x
    and layoutLambda (Lam {arg, argType, body, ...}) =
       align [seq [str "fn ", maybeConstrain (Var.layout arg, argType),
-		  str " => "],
-	     layoutExp body]
-	    
+                  str " => "],
+             layoutExp body]
+            
 end   
 
 structure Dec =
@@ -311,216 +311,218 @@
       val result = #result o dest
 
       fun fromPrimExp (exp: PrimExp.t, ty: Type.t): t =
-	 let val var = Var.newNoname ()
-	 in Exp {decs = [Dec.MonoVal {var = var, ty = ty, exp = exp}],
-		 result = VarExp.mono var}
-	 end
+         let val var = Var.newNoname ()
+         in Exp {decs = [Dec.MonoVal {var = var, ty = ty, exp = exp}],
+                 result = VarExp.mono var}
+         end
       
       local
-	 fun make f (Exp {decs, result}, d) =
-	    Exp {decs = f (d, decs),
-		 result = result}
+         fun make f (Exp {decs, result}, d) =
+            Exp {decs = f (d, decs),
+                 result = result}
       in val prefix = make (op ::)
-	 val prefixs = make (op @)
+         val prefixs = make (op @)
       end
 
       fun enterLeave (e: t, ty: Type.t, si: SourceInfo.t): t =
-	 let
-	    datatype z = datatype Dec.t
-	    datatype z = datatype PrimExp.t
-	    fun prof f =
-	       MonoVal {exp = Profile (f si),
-			ty = Type.unit,
-			var = Var.newNoname ()}
-	    val exn = Var.newNoname ()
-	    val res = Var.newNoname ()
-	    val handler =
-	       make {decs = [prof ProfileExp.Leave,
-			     MonoVal {exp = Raise {exn = VarExp.mono exn,
-						   extend = false},
-				      ty = ty,
-				      var = res}],
-		     result = VarExp.mono res}
-	    val touch =
-	       if !Control.profile = Control.ProfileCount
-		  then
-		     let
-			val unit = Var.newNoname ()
-		     in
-			[MonoVal {exp = Tuple (Vector.new0 ()),
-				  ty = Type.unit,
-				  var = unit},
-			 MonoVal
-			 {exp = PrimApp {args = Vector.new1 (VarExp.mono unit),
-					 prim = Prim.touch,
-					 targs = Vector.new1 Type.unit},
-			  ty = Type.unit,
-			  var = Var.newNoname ()}]
-		     end
-	       else []
-	    val {decs, result} = dest e
-	    val decs =
-	       List.concat [[prof ProfileExp.Enter],
-			    touch,
-			    decs,
-			    [prof ProfileExp.Leave]]
-	    val try = make {decs = decs, result = result}
-	 in
-	    fromPrimExp (Handle {catch = (exn, Type.exn),
-				 handler = handler,
-				 try = try},
-			 ty)
-	 end
+         let
+            datatype z = datatype Dec.t
+            datatype z = datatype PrimExp.t
+            fun prof f =
+               MonoVal {exp = Profile (f si),
+                        ty = Type.unit,
+                        var = Var.newNoname ()}
+            val exn = Var.newNoname ()
+            val res = Var.newNoname ()
+            val handler =
+               make {decs = [prof ProfileExp.Leave,
+                             MonoVal {exp = Raise {exn = VarExp.mono exn,
+                                                   extend = false},
+                                      ty = ty,
+                                      var = res}],
+                     result = VarExp.mono res}
+            val touch =
+               if !Control.profile = Control.ProfileCount
+                  then
+                     let
+                        val unit = Var.newNoname ()
+                     in
+                        [MonoVal {exp = Tuple (Vector.new0 ()),
+                                  ty = Type.unit,
+                                  var = unit},
+                         MonoVal
+                         {exp = PrimApp {args = Vector.new1 (VarExp.mono unit),
+                                         prim = Prim.touch,
+                                         targs = Vector.new1 Type.unit},
+                          ty = Type.unit,
+                          var = Var.newNoname ()}]
+                     end
+               else []
+            val {decs, result} = dest e
+            val decs =
+               List.concat [[prof ProfileExp.Enter],
+                            touch,
+                            decs,
+                            [prof ProfileExp.Leave]]
+            val try = make {decs = decs, result = result}
+         in
+            fromPrimExp (Handle {catch = (exn, Type.exn),
+                                 handler = handler,
+                                 try = try},
+                         ty)
+         end
 
       (*------------------------------------*)
       (*              foreach               *)
       (*------------------------------------*)
       fun foreach {exp: t,
-		   handleExp: t -> unit,
-		   handlePrimExp: Var.t * Type.t * PrimExp.t -> unit,
-		   handleBoundVar: Var.t * Tyvar.t vector * Type.t -> unit,
-		   handleVarExp: VarExp.t -> unit}: unit =
-	 let
-	    fun monoVar (x, t) = handleBoundVar (x, Vector.new0 (), t)
-	    fun handleVarExps xs = Vector.foreach (xs, handleVarExp)
-	    fun loopExp e =
-	       let val {decs, result} = dest e
-	       in List.foreach (decs, loopDec)
-		  ; handleVarExp result
-		  ; handleExp e
-	       end
-	    and loopPrimExp (x: Var.t, ty: Type.t, e: PrimExp.t): unit =
-	       (handlePrimExp (x, ty, e)
-		; (case e of
-		      Const _ => ()
-		    | Var x => handleVarExp x
-		    | Tuple xs => handleVarExps xs
-		    | Select {tuple, ...} => handleVarExp tuple
-		    | Lambda lambda => loopLambda lambda
-		    | PrimApp {args, ...} => handleVarExps args
-		    | Profile _ => ()
-		    | ConApp {arg, ...} => (case arg of
-					       NONE => ()
-					     | SOME x => handleVarExp x)
-		    | App {func, arg} => (handleVarExp func
-					  ; handleVarExp arg)
-		    | Raise {exn, ...} => handleVarExp exn
-		    | Handle {try, catch, handler, ...} =>
-			 (loopExp try
-			  ; monoVar catch
-			  ; loopExp handler)
-		    | Case {test, cases, default} =>
-			 (handleVarExp test
-			  ; Cases.foreach' (cases, loopExp,
-					    fn Pat.T {arg, ...} =>
-					    case arg of
-					       NONE => ()
-					     | SOME x => monoVar x)
-			  ; Option.app (default, loopExp o #1))))
-	    and loopDec d =
-	       case d of
-		  MonoVal {var, ty, exp} =>
-		     (monoVar (var, ty); loopPrimExp (var, ty, exp))
-		| PolyVal {var, tyvars, ty, exp} =>
-		     (handleBoundVar (var, tyvars, ty)
-		      ; loopExp exp)
-		| Exception _ => ()
-		| Fun {tyvars, decs, ...} =>
-		     (Vector.foreach (decs, fn {ty, var, ...} =>
-				      handleBoundVar (var, tyvars, ty))
-		      ; Vector.foreach (decs, fn {lambda, ...} =>
-					loopLambda lambda))
-	    and loopLambda (Lam {arg, argType, body, ...}): unit =
-	       (monoVar (arg, argType); loopExp body)
-	 in loopExp exp
-	 end
+                   handleExp: t -> unit,
+                   handlePrimExp: Var.t * Type.t * PrimExp.t -> unit,
+                   handleBoundVar: Var.t * Tyvar.t vector * Type.t -> unit,
+                   handleVarExp: VarExp.t -> unit}: unit =
+         let
+            fun monoVar (x, t) = handleBoundVar (x, Vector.new0 (), t)
+            fun handleVarExps xs = Vector.foreach (xs, handleVarExp)
+            fun loopExp e =
+               let val {decs, result} = dest e
+               in List.foreach (decs, loopDec)
+                  ; handleVarExp result
+                  ; handleExp e
+               end
+            and loopPrimExp (x: Var.t, ty: Type.t, e: PrimExp.t): unit =
+               (handlePrimExp (x, ty, e)
+                ; (case e of
+                      Const _ => ()
+                    | Var x => handleVarExp x
+                    | Tuple xs => handleVarExps xs
+                    | Select {tuple, ...} => handleVarExp tuple
+                    | Lambda lambda => loopLambda lambda
+                    | PrimApp {args, ...} => handleVarExps args
+                    | Profile _ => ()
+                    | ConApp {arg, ...} => (case arg of
+                                               NONE => ()
+                                             | SOME x => handleVarExp x)
+                    | App {func, arg} => (handleVarExp func
+                                          ; handleVarExp arg)
+                    | Raise {exn, ...} => handleVarExp exn
+                    | Handle {try, catch, handler, ...} =>
+                         (loopExp try
+                          ; monoVar catch
+                          ; loopExp handler)
+                    | Case {test, cases, default} =>
+                         (handleVarExp test
+                          ; Cases.foreach' (cases, loopExp,
+                                            fn Pat.T {arg, ...} =>
+                                            case arg of
+                                               NONE => ()
+                                             | SOME x => monoVar x)
+                          ; Option.app (default, loopExp o #1))))
+            and loopDec d =
+               case d of
+                  MonoVal {var, ty, exp} =>
+                     (monoVar (var, ty); loopPrimExp (var, ty, exp))
+                | PolyVal {var, tyvars, ty, exp} =>
+                     (handleBoundVar (var, tyvars, ty)
+                      ; loopExp exp)
+                | Exception _ => ()
+                | Fun {tyvars, decs, ...} =>
+                     (Vector.foreach (decs, fn {ty, var, ...} =>
+                                      handleBoundVar (var, tyvars, ty))
+                      ; Vector.foreach (decs, fn {lambda, ...} =>
+                                        loopLambda lambda))
+            and loopLambda (Lam {arg, argType, body, ...}): unit =
+               (monoVar (arg, argType); loopExp body)
+         in loopExp exp
+         end
 
       fun ignore _ = ()
 
       fun foreachPrimExp (e, f) =
-	 foreach {exp = e,
-		  handlePrimExp = f,
-		  handleExp = ignore,
-		  handleBoundVar = ignore,
-		  handleVarExp = ignore}
+         foreach {exp = e,
+                  handlePrimExp = f,
+                  handleExp = ignore,
+                  handleBoundVar = ignore,
+                  handleVarExp = ignore}
 
       fun foreachVarExp (e, f) =
-	 foreach {exp = e,
-		  handlePrimExp = ignore,
-		  handleExp = ignore,
-		  handleBoundVar = ignore,
-		  handleVarExp = f}
+         foreach {exp = e,
+                  handlePrimExp = ignore,
+                  handleExp = ignore,
+                  handleBoundVar = ignore,
+                  handleVarExp = f}
 
       fun foreachBoundVar (e, f) =
-	 foreach {exp = e,
-		  handlePrimExp = ignore,
-		  handleExp = ignore,
-		  handleBoundVar = f,
-		  handleVarExp = ignore}
+         foreach {exp = e,
+                  handlePrimExp = ignore,
+                  handleExp = ignore,
+                  handleBoundVar = f,
+                  handleVarExp = ignore}
 
       fun foreachExp (e, f) =
-	 foreach {exp = e,
-		  handlePrimExp = ignore,
-		  handleExp = f,
-		  handleBoundVar = ignore,
-		  handleVarExp = ignore}
+         foreach {exp = e,
+                  handlePrimExp = ignore,
+                  handleExp = f,
+                  handleBoundVar = ignore,
+                  handleVarExp = ignore}
 
       fun hasPrim (e, f) =
-	 DynamicWind.withEscape
-	 (fn escape =>
-	  (foreachPrimExp (e, fn (_, _, e) =>
-			   case e of
-			      PrimApp {prim, ...} => if f prim then escape true
-						     else ()
-			    | _ => ())
-	   ; false))
+         Exn.withEscape
+         (fn escape =>
+          (foreachPrimExp (e, fn (_, _, e) =>
+                           case e of
+                              PrimApp {prim, ...} => if f prim then escape true
+                                                     else ()
+                            | _ => ())
+           ; false))
 
       fun size e =
-	 let val n: int ref = ref 0
-	    fun inc () = n := 1 + !n
-	 in foreachPrimExp (e, fn _ => inc ());
-	    !n
-	 end
+         let val n: int ref = ref 0
+            fun inc () = n := 1 + !n
+         in foreachPrimExp (e, fn _ => inc ());
+            !n
+         end
 
-      (*      val size = Trace.trace ("size", Layout.ignore, Int.layout) size *)
+(*
+      val size = Trace.trace ("XmlTree.Exp.size", Layout.ignore, Int.layout) size
+*)
 
       fun clear (e: t): unit =
-	 let open PrimExp
-	    fun clearTyvars ts = Vector.foreach (ts, Tyvar.clear)
-	    fun clearPat (Pat.T {arg, ...}) =
-	       case arg of
-		  NONE => ()
-		| SOME (x, _) => Var.clear x
-	    fun clearExp e = clearDecs (decs e)
-	    and clearDecs ds = List.foreach (ds, clearDec)
-	    and clearDec d =
-	       case d of
-		  MonoVal {var, exp, ...} => (Var.clear var; clearPrimExp exp)
-		| PolyVal {var, tyvars, exp, ...} =>
-		     (Var.clear var
-		      ; clearTyvars tyvars
-		      ; clearExp exp)
-		| Fun {tyvars, decs} =>
-		     (clearTyvars tyvars
-		      ; Vector.foreach (decs, fn {var, lambda, ...} =>
-					(Var.clear var
-					 ; clearLambda lambda)))
-		| Exception {con, ...} => Con.clear con
-	    and clearPrimExp e =
-	       case e of
-		  Lambda l => clearLambda l
-		| Case {cases, default, ...} =>
-		     (Cases.foreach' (cases, clearExp, clearPat)
-		      ; Option.app (default, clearExp o #1))
-		| Handle {try, catch, handler, ...} => 
-		     (clearExp try
-		      ; Var.clear (#1 catch)
-		      ; clearExp handler)
-		| _ => ()
-	    and clearLambda (Lam {arg, body, ...}) =
-	       (Var.clear arg; clearExp body)
-	 in clearExp e
-	 end
+         let open PrimExp
+            fun clearTyvars ts = Vector.foreach (ts, Tyvar.clear)
+            fun clearPat (Pat.T {arg, ...}) =
+               case arg of
+                  NONE => ()
+                | SOME (x, _) => Var.clear x
+            fun clearExp e = clearDecs (decs e)
+            and clearDecs ds = List.foreach (ds, clearDec)
+            and clearDec d =
+               case d of
+                  MonoVal {var, exp, ...} => (Var.clear var; clearPrimExp exp)
+                | PolyVal {var, tyvars, exp, ...} =>
+                     (Var.clear var
+                      ; clearTyvars tyvars
+                      ; clearExp exp)
+                | Fun {tyvars, decs} =>
+                     (clearTyvars tyvars
+                      ; Vector.foreach (decs, fn {var, lambda, ...} =>
+                                        (Var.clear var
+                                         ; clearLambda lambda)))
+                | Exception {con, ...} => Con.clear con
+            and clearPrimExp e =
+               case e of
+                  Lambda l => clearLambda l
+                | Case {cases, default, ...} =>
+                     (Cases.foreach' (cases, clearExp, clearPat)
+                      ; Option.app (default, clearExp o #1))
+                | Handle {try, catch, handler, ...} => 
+                     (clearExp try
+                      ; Var.clear (#1 catch)
+                      ; clearExp handler)
+                | _ => ()
+            and clearLambda (Lam {arg, body, ...}) =
+               (Var.clear arg; clearExp body)
+         in clearExp e
+         end
    end
 
 (*---------------------------------------------------*)
@@ -533,26 +535,26 @@
       datatype t = datatype lambda
 
       local
-	 fun make f (Lam r) = f r
+         fun make f (Lam r) = f r
       in
-	 val arg = make #arg
-	 val argType = make #argType
-	 val body = make #body
-	 val mayInline = make #mayInline
+         val arg = make #arg
+         val argType = make #argType
+         val body = make #body
+         val mayInline = make #mayInline
       end
 
       fun make {arg, argType, body, mayInline} =
-	 Lam {arg = arg,
-	      argType = argType,
-	      body = body,
-	      mayInline = mayInline,
-	      plist = PropertyList.new ()}
+         Lam {arg = arg,
+              argType = argType,
+              body = body,
+              mayInline = mayInline,
+              plist = PropertyList.new ()}
 
       fun dest (Lam {arg, argType, body, mayInline, ...}) =
-	 {arg = arg, argType = argType, body = body, mayInline = mayInline}
-	 
+         {arg = arg, argType = argType, body = body, mayInline = mayInline}
+         
       fun plist (Lam {plist, ...}) = plist
-	 
+         
       val layout = layoutLambda
       fun equals (f:t, f':t) = PropertyList.equals (plist f, plist f')
    end
@@ -565,27 +567,27 @@
       open Dec PrimExp
 
       structure Cont =
-	 struct
-	    type t = PrimExp.t * Type.t -> Exp.t
+         struct
+            type t = PrimExp.t * Type.t -> Exp.t
 
-	    fun nameGen (k: VarExp.t * Type.t -> Exp.t): t =
-	       fn (e, t) =>
-	       case e of
-		  Var x => k (x, t)
-		| _ => let val x = Var.newNoname ()
-		       in Exp.prefix (k (VarExp.mono x, t),
-				      MonoVal {var = x, ty = t, exp = e})
-		       end
-		    
-	    fun name (k: VarExp.t * Type.t -> Exp.t): t = nameGen k
+            fun nameGen (k: VarExp.t * Type.t -> Exp.t): t =
+               fn (e, t) =>
+               case e of
+                  Var x => k (x, t)
+                | _ => let val x = Var.newNoname ()
+                       in Exp.prefix (k (VarExp.mono x, t),
+                                      MonoVal {var = x, ty = t, exp = e})
+                       end
+                    
+            fun name (k: VarExp.t * Type.t -> Exp.t): t = nameGen k
 
-	    val id: t = name (fn (x, _) => Exp {decs = [], result = x})
-	       
-	    fun return (k: t, xt) = k xt
-	 end
+            val id: t = name (fn (x, _) => Exp {decs = [], result = x})
+               
+            fun return (k: t, xt) = k xt
+         end
 
       type t = Cont.t -> Exp.t
-	 
+         
       fun send (e: t, k: Cont.t): Exp.t = e k
 
       fun toExp e = send (e, Cont.id)
@@ -593,243 +595,243 @@
       val layout = Exp.layout o toExp
 
       fun fromExp (Exp {decs, result}, ty): t =
-	 fn k => Exp.prefixs (k (Var result, ty), decs)
+         fn k => Exp.prefixs (k (Var result, ty), decs)
 
       fun sendName (e, k) = send (e, Cont.name k)
 
       fun simple (e: PrimExp.t * Type.t) k = Cont.return (k, e)
-	 
+         
       fun const c = simple (Const c, Type.ofConst c)
 
       val string = const o Const.string
-	 
+         
       fun varExp (x, t) = simple (Var x, t)
 
       fun var {var, targs, ty} =
-	 varExp (VarExp.T {var = var, targs = targs}, ty)
+         varExp (VarExp.T {var = var, targs = targs}, ty)
 
       fun monoVar (x, t) = var {var = x, targs = Vector.new0 (), ty = t}
 
       fun convertsGen (es: t vector,
-		       k: (VarExp.t * Type.t) vector -> Exp.t): Exp.t =
-	 let
-	    val n = Vector.length es
-	    fun loop (i, xs) =
-	       if i = n
-		  then k (Vector.fromListRev xs)
-	       else sendName (Vector.sub (es, i),
-			      fn x => loop (i + 1, x :: xs))
-	 in loop (0, [])
-	 end
+                       k: (VarExp.t * Type.t) vector -> Exp.t): Exp.t =
+         let
+            val n = Vector.length es
+            fun loop (i, xs) =
+               if i = n
+                  then k (Vector.fromListRev xs)
+               else sendName (Vector.sub (es, i),
+                              fn x => loop (i + 1, x :: xs))
+         in loop (0, [])
+         end
 
       fun converts (es: t vector,
-		    make: (VarExp.t * Type.t) vector -> PrimExp.t * Type.t): t =
-	 fn k => convertsGen (es, k o make)
+                    make: (VarExp.t * Type.t) vector -> PrimExp.t * Type.t): t =
+         fn k => convertsGen (es, k o make)
 
       fun convert (e: t, make: VarExp.t * Type.t -> PrimExp.t * Type.t): t =
-	 fn k => send (e, Cont.name (k o make))
+         fn k => send (e, Cont.name (k o make))
 
       fun convertOpt (e, make) =
-	 case e of
-	    NONE => simple (make NONE)
-	  | SOME e => convert (e, make o SOME o #1)
+         case e of
+            NONE => simple (make NONE)
+          | SOME e => convert (e, make o SOME o #1)
 
       fun tuple {exps: t vector, ty: Type.t}: t =
-	 if 1 = Vector.length exps
-	    then Vector.sub (exps, 0)
-	 else converts (exps, fn xs =>
-			(PrimExp.Tuple (Vector.map (xs, #1)), ty))
+         if 1 = Vector.length exps
+            then Vector.sub (exps, 0)
+         else converts (exps, fn xs =>
+                        (PrimExp.Tuple (Vector.map (xs, #1)), ty))
 
       fun select {tuple, offset, ty} =
-	 convert (tuple, fn (tuple, _) =>
-		  (Select {tuple = tuple, offset = offset}, ty))
+         convert (tuple, fn (tuple, _) =>
+                  (Select {tuple = tuple, offset = offset}, ty))
 
       fun conApp {con, targs, arg, ty} =
-	 convertOpt (arg, fn arg =>
-		     (ConApp {con = con, targs = targs, arg = arg}, ty))
+         convertOpt (arg, fn arg =>
+                     (ConApp {con = con, targs = targs, arg = arg}, ty))
 
       local
-	 fun make c () = 
-	    conApp {con = c,
-		    targs = Vector.new0 (),
-		    arg = NONE,
-		    ty = Type.bool}
+         fun make c () = 
+            conApp {con = c,
+                    targs = Vector.new0 (),
+                    arg = NONE,
+                    ty = Type.bool}
       in
-	 val truee = make Con.truee
-	 val falsee = make Con.falsee
+         val truee = make Con.truee
+         val falsee = make Con.falsee
       end
 
       fun primApp {prim, targs, args, ty} =
-	 converts (args, fn args =>
-		   (PrimApp {prim = prim,
-			     targs = targs,
-			     args = Vector.map (args, #1)},
-		    ty))
+         converts (args, fn args =>
+                   (PrimApp {prim = prim,
+                             targs = targs,
+                             args = Vector.map (args, #1)},
+                    ty))
 
       fun convert2 (e1, e2, make) =
-	 converts (Vector.new2 (e1, e2),
-		   fn xs => make (Vector.sub (xs, 0), Vector.sub (xs, 1)))
-	 
+         converts (Vector.new2 (e1, e2),
+                   fn xs => make (Vector.sub (xs, 0), Vector.sub (xs, 1)))
+         
       fun app {func, arg, ty} =
-	 convert2 (func, arg, fn ((func, _), (arg, _)) =>
-		   (App {func = func, arg = arg}, ty))
+         convert2 (func, arg, fn ((func, _), (arg, _)) =>
+                   (App {func = func, arg = arg}, ty))
 
       fun casee {test, cases, default, ty} =
-	 convert (test, fn (test, _) =>
-		  (Case
-		   {test = test,
-		    cases = Cases.map (cases, toExp),
-		    default = (Option.map
-			       (default, fn (e, r) => (toExp e, r)))},
-		   ty))
+         convert (test, fn (test, _) =>
+                  (Case
+                   {test = test,
+                    cases = Cases.map (cases, toExp),
+                    default = (Option.map
+                               (default, fn (e, r) => (toExp e, r)))},
+                   ty))
 
       fun raisee (exn: t, {extend: bool}, t: Type.t): t =
-	 convert (exn, fn (x, _) => (Raise {exn = x, extend = extend}, t))
-	 
+         convert (exn, fn (x, _) => (Raise {exn = x, extend = extend}, t))
+         
       fun handlee {try, catch, handler, ty} =
-	 simple (Handle {try = toExp try,
-			 catch = catch,
-			 handler = toExp handler},
-		 ty)
+         simple (Handle {try = toExp try,
+                         catch = catch,
+                         handler = toExp handler},
+                 ty)
 
       fun unit () = tuple {exps = Vector.new0 (), ty = Type.unit}
 
       fun reff (e: t): t =
-	 convert (e, fn (x, t) =>
-		  (PrimApp {prim = Prim.reff,
-			    targs = Vector.new1 t,
-			    args = Vector.new1 x},
-		   Type.reff t))
+         convert (e, fn (x, t) =>
+                  (PrimApp {prim = Prim.reff,
+                            targs = Vector.new1 t,
+                            args = Vector.new1 x},
+                   Type.reff t))
 
       fun deref (e: t): t =
-	 convert (e, fn (x, t) =>
-		  let
-		     val t = Type.deRef t
-		  in
-		     (PrimApp {prim = Prim.deref,
-			       targs = Vector.new1 t,
-			       args = Vector.new1 x},
-		      t)
-		  end)
+         convert (e, fn (x, t) =>
+                  let
+                     val t = Type.deRef t
+                  in
+                     (PrimApp {prim = Prim.deref,
+                               targs = Vector.new1 t,
+                               args = Vector.new1 x},
+                      t)
+                  end)
 
       fun equal (e1, e2) =
-	 convert2 (e1, e2, fn ((x1, t), (x2, _)) =>
-		   (PrimApp {prim = Prim.equal,
-			     targs = Vector.new1 t,
-			     args = Vector.new2 (x1, x2)},
-		    Type.bool))
+         convert2 (e1, e2, fn ((x1, t), (x2, _)) =>
+                   (PrimApp {prim = Prim.equal,
+                             targs = Vector.new1 t,
+                             args = Vector.new2 (x1, x2)},
+                    Type.bool))
 
       fun iff {test, thenn, elsee, ty} =
-	 casee {test = test,
-		cases = Cases.Con (Vector.new2 ((Pat.truee, thenn),
-						(Pat.falsee, elsee))),
-		default = NONE,
-		ty = ty}
+         casee {test = test,
+                cases = Cases.Con (Vector.new2 ((Pat.truee, thenn),
+                                                (Pat.falsee, elsee))),
+                default = NONE,
+                ty = ty}
 
       fun vall {var, exp}: Dec.t list =
-	 let val t = ref Type.unit
-	    val Exp {decs, result} =
-	       sendName (exp, fn (x, t') => (t := t';			 
-					     Exp {decs = [], result = x}))
-	 in decs @ [MonoVal {var = var, ty = !t, exp = Var result}]
-	 end
+         let val t = ref Type.unit
+            val Exp {decs, result} =
+               sendName (exp, fn (x, t') => (t := t';                    
+                                             Exp {decs = [], result = x}))
+         in decs @ [MonoVal {var = var, ty = !t, exp = Var result}]
+         end
 
       fun sequence es =
-    	 converts (es, fn xs => let val (x, t) = Vector.last xs
-				in (Var x, t)
-				end)
+         converts (es, fn xs => let val (x, t) = Vector.last xs
+                                in (Var x, t)
+                                end)
 
       val bug: string * Type.t -> t =
-	 fn (s, ty) =>
-	 sequence (Vector.new2
-		   (primApp {prim = Prim.bug,
-			     targs = Vector.new0 (),
-			     args = Vector.new1 (string s),
-			     ty = Type.unit},
-		    raisee (primApp {prim = Prim.bogus,
-				     targs = Vector.new1 Type.exn,
-				     args = Vector.new0 (),
-				     ty = Type.exn},
-			    {extend = false},
-			    ty)))
+         fn (s, ty) =>
+         sequence (Vector.new2
+                   (primApp {prim = Prim.bug,
+                             targs = Vector.new0 (),
+                             args = Vector.new1 (string s),
+                             ty = Type.unit},
+                    raisee (primApp {prim = Prim.bogus,
+                                     targs = Vector.new1 Type.exn,
+                                     args = Vector.new0 (),
+                                     ty = Type.exn},
+                            {extend = false},
+                            ty)))
 
       fun seq (es, make) =
-	 fn k => convertsGen (es, fn xts =>
-			      send (make (Vector.map (xts, varExp)), k))
+         fn k => convertsGen (es, fn xts =>
+                              send (make (Vector.map (xts, varExp)), k))
 
       fun lett {decs, body} = fn k => Exp.prefixs (send (body, k), decs)
 
       fun let1 {var, exp, body} =
-	 fn k => 
-	 send (exp, fn (exp, ty) =>
-	       Exp.prefix (send (body, k),
-			   Dec.MonoVal {var = var, ty = ty, exp = exp}))
-	 
+         fn k => 
+         send (exp, fn (exp, ty) =>
+               Exp.prefix (send (body, k),
+                           Dec.MonoVal {var = var, ty = ty, exp = exp}))
+         
       fun lambda {arg, argType, body, bodyType, mayInline} =
-	 simple (Lambda (Lambda.make {arg = arg,
-				      argType = argType,
-				      body = toExp body,
-				      mayInline = mayInline}),
-		 Type.arrow (argType, bodyType))
+         simple (Lambda (Lambda.make {arg = arg,
+                                      argType = argType,
+                                      body = toExp body,
+                                      mayInline = mayInline}),
+                 Type.arrow (argType, bodyType))
       
       fun detupleGen (e: PrimExp.t,
-		      t: Type.t,
-		      components: Var.t vector,
-		      body: Exp.t): Exp.t =
-	 Exp.prefixs
-	 (body,
-	  case Vector.length components of
-	     0 => []
-	   | 1 => [MonoVal {var = Vector.sub (components, 0), ty = t, exp = e}]
-	   | _ =>
-		let
-		   val ts = Type.deTuple t
-		   val tupleVar = Var.newNoname ()
-		in MonoVal {var = tupleVar, ty = t, exp = e}
-		   ::
-		   #2 (Vector.fold2
-		       (components, ts, (0, []),
-			fn (x, t, (i, ac)) =>
-			(i + 1,
-			 MonoVal {var = x, ty = t,
-				  exp = Select {tuple = VarExp.mono tupleVar,
-						offset = i}}
-			 :: ac)))
-		end)
-	 
+                      t: Type.t,
+                      components: Var.t vector,
+                      body: Exp.t): Exp.t =
+         Exp.prefixs
+         (body,
+          case Vector.length components of
+             0 => []
+           | 1 => [MonoVal {var = Vector.sub (components, 0), ty = t, exp = e}]
+           | _ =>
+                let
+                   val ts = Type.deTuple t
+                   val tupleVar = Var.newNoname ()
+                in MonoVal {var = tupleVar, ty = t, exp = e}
+                   ::
+                   #2 (Vector.fold2
+                       (components, ts, (0, []),
+                        fn (x, t, (i, ac)) =>
+                        (i + 1,
+                         MonoVal {var = x, ty = t,
+                                  exp = Select {tuple = VarExp.mono tupleVar,
+                                                offset = i}}
+                         :: ac)))
+                end)
+         
       fun detupleBind {tuple, components, body} =
-	 fn k => send (tuple, fn (e, t) => detupleGen (e, t, components, body k))
+         fn k => send (tuple, fn (e, t) => detupleGen (e, t, components, body k))
 
       fun detuple {tuple: t, body}: t =
-	 fn k =>
-	 tuple
-	 (fn (e, t) =>
-	  let
-	     val ts = Type.deTuple t
-	  in
-	     case e of
-		Tuple xs => send (body (Vector.zip (xs, ts)), k)
-	      | _ => let
-			val components =
-			   Vector.map (ts, fn _ => Var.newNoname ())
-		     in
-			detupleGen (e, t, components,
-				    send (body (Vector.map2
-						(components, ts, fn (x, t) =>
-						 (VarExp.mono x, t))),
-					  k))
-		     end
-	  end)
+         fn k =>
+         tuple
+         (fn (e, t) =>
+          let
+             val ts = Type.deTuple t
+          in
+             case e of
+                Tuple xs => send (body (Vector.zip (xs, ts)), k)
+              | _ => let
+                        val components =
+                           Vector.map (ts, fn _ => Var.newNoname ())
+                     in
+                        detupleGen (e, t, components,
+                                    send (body (Vector.map2
+                                                (components, ts, fn (x, t) =>
+                                                 (VarExp.mono x, t))),
+                                          k))
+                     end
+          end)
    end
 
 structure Exp =
    struct
       open Exp
-	 
+         
       fun unit () =
-	 let open DirectExp
-	 in toExp (tuple {exps = Vector.new0 (), ty = Type.unit})
-	 end
+         let open DirectExp
+         in toExp (tuple {exps = Vector.new0 (), ty = Type.unit})
+         end
    end
 
 (*---------------------------------------------------*)
@@ -839,19 +841,19 @@
 structure Datatype =
    struct
       type t = {cons: {arg: Type.t option,
-		       con: Con.t} vector,
-		tycon: Tycon.t,
-		tyvars: Tyvar.t vector}
+                       con: Con.t} vector,
+                tycon: Tycon.t,
+                tyvars: Tyvar.t vector}
 
       fun layout ({cons, tycon, tyvars}: t): Layout.t =
-	 let
-	    open Layout
-	 in
-	    seq [layoutTyvars tyvars, str " ", Tycon.layout tycon, str " = ",
-		 align
-		 (separateLeft (Vector.toListMap (cons, layoutConArg),
-				"| "))]
-	 end
+         let
+            open Layout
+         in
+            seq [layoutTyvars tyvars, str " ", Tycon.layout tycon, str " = ",
+                 align
+                 (separateLeft (Vector.toListMap (cons, layoutConArg),
+                                "| "))]
+         end
    end
 
 (*---------------------------------------------------*)
@@ -861,55 +863,55 @@
 structure Program =
    struct
       datatype t = T of {body: Exp.t,
-			 datatypes: Datatype.t vector,
-			 overflow: Var.t option}
+                         datatypes: Datatype.t vector,
+                         overflow: Var.t option}
 
       fun layout (T {body, datatypes, overflow, ...}) =
-	 let
-	    open Layout
-	 in
-	    align [seq [str "Overflow: ", Option.layout Var.layout overflow],
-		   str "Datatypes:",
-		   align (Vector.toListMap (datatypes, Datatype.layout)),
-		   str "Body:",
-		   Exp.layout body]
-	 end
+         let
+            open Layout
+         in
+            align [seq [str "Overflow: ", Option.layout Var.layout overflow],
+                   str "Datatypes:",
+                   align (Vector.toListMap (datatypes, Datatype.layout)),
+                   str "Body:",
+                   Exp.layout body]
+         end
 
       fun clear (T {datatypes, body, ...}) =
-	 (Vector.foreach (datatypes, fn {tycon, tyvars, cons} =>
-			  (Tycon.clear tycon
-			   ; Vector.foreach (tyvars, Tyvar.clear)
-			   ; Vector.foreach (cons, Con.clear o #con)))
-	  ; Exp.clear body)
+         (Vector.foreach (datatypes, fn {tycon, tyvars, cons} =>
+                          (Tycon.clear tycon
+                           ; Vector.foreach (tyvars, Tyvar.clear)
+                           ; Vector.foreach (cons, Con.clear o #con)))
+          ; Exp.clear body)
 
       val empty = T {datatypes = Vector.new0 (),
-		     body = Exp.unit (),
-		     overflow = NONE}
+                     body = Exp.unit (),
+                     overflow = NONE}
 
       fun layoutStats (T {datatypes, body, ...}) =
-	 let
-	    val numTypes = ref 0
-	    fun inc _ = numTypes := 1 + !numTypes
-	    val {hom, destroy} = Type.makeHom {var = inc, con = inc}
-	    val numPrimExps = ref 0
-	    open Layout
-	 in
-	    Vector.foreach (datatypes, fn {cons, ...} =>
-			    Vector.foreach (cons, fn {arg, ...} =>
-					    case arg of
-					       NONE => ()
-					     | SOME t => hom t))
-	    ; (Exp.foreach
-	       {exp = body,
-		handlePrimExp = fn _ => numPrimExps := 1 + !numPrimExps,
-		handleVarExp = fn _ => (),
-		handleBoundVar = hom o #3,
-		handleExp = fn _ => ()})
-	    ; destroy ()
-	    ; align [seq [str "size = ", Int.layout (!numPrimExps)],
-		     seq [str "num types in program = ", Int.layout (!numTypes)],
-		     Type.stats ()]
-	 end
+         let
+            val numTypes = ref 0
+            fun inc _ = numTypes := 1 + !numTypes
+            val {hom, destroy} = Type.makeHom {var = inc, con = inc}
+            val numPrimExps = ref 0
+            open Layout
+         in
+            Vector.foreach (datatypes, fn {cons, ...} =>
+                            Vector.foreach (cons, fn {arg, ...} =>
+                                            case arg of
+                                               NONE => ()
+                                             | SOME t => hom t))
+            ; (Exp.foreach
+               {exp = body,
+                handlePrimExp = fn _ => numPrimExps := 1 + !numPrimExps,
+                handleVarExp = fn _ => (),
+                handleBoundVar = hom o #3,
+                handleExp = fn _ => ()})
+            ; destroy ()
+            ; align [seq [str "size = ", Int.layout (!numPrimExps)],
+                     seq [str "num types in program = ", Int.layout (!numTypes)],
+                     Type.stats ()]
+         end
    end
 
 end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/xml/xml-tree.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/xml/xml-tree.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/xml/xml-tree.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 (* binding occurences:
  *   1. lambda arg
  *   2. pattern arg
@@ -27,229 +28,229 @@
 
       structure Type: XML_TYPE
       sharing Atoms = Type.Atoms
-	 
+         
       structure Pat:
-	 sig
-	    datatype t = T of {arg: (Var.t * Type.t) option,
-			       con: Con.t,
-			       targs: Type.t vector}
-	 
-	    val falsee: t
-	    val truee: t
-	    val con: t -> Con.t
-	    val layout: t -> Layout.t
-	 end
+         sig
+            datatype t = T of {arg: (Var.t * Type.t) option,
+                               con: Con.t,
+                               targs: Type.t vector}
+         
+            val falsee: t
+            val truee: t
+            val con: t -> Con.t
+            val layout: t -> Layout.t
+         end
 
       structure Cases:
-	 sig
-	    datatype 'a t =
-	       Con of (Pat.t * 'a) vector
-	     | Word of WordSize.t * (WordX.t * 'a) vector
+         sig
+            datatype 'a t =
+               Con of (Pat.t * 'a) vector
+             | Word of WordSize.t * (WordX.t * 'a) vector
 
-	    val fold: 'a t * 'b * ('a * 'b -> 'b) -> 'b
-	    val foreach: 'a t * ('a -> unit) -> unit
-	    val foreach': 'a t * ('a -> unit) * (Pat.t -> unit) -> unit
-	    val map: 'a t * ('a -> 'b) -> 'b t
-	 end
+            val fold: 'a t * 'b * ('a * 'b -> 'b) -> 'b
+            val foreach: 'a t * ('a -> unit) -> unit
+            val foreach': 'a t * ('a -> unit) * (Pat.t -> unit) -> unit
+            val map: 'a t * ('a -> 'b) -> 'b t
+         end
 
       structure Lambda:
-	 sig
-	    type exp
-	    type t
+         sig
+            type exp
+            type t
 
-	    val arg: t -> Var.t
-	    val argType: t -> Type.t
-	    val body: t -> exp
-	    val dest: t -> {arg: Var.t,
-			    argType: Type.t,
-			    body: exp,
-			    mayInline: bool}
-	    val equals: t * t -> bool
-	    val layout: t -> Layout.t
-	    val make: {arg: Var.t,
-		       argType: Type.t,
-		       body: exp,
-		       mayInline: bool} -> t
-	    val mayInline: t -> bool
-	    val plist: t -> PropertyList.t
-	 end
+            val arg: t -> Var.t
+            val argType: t -> Type.t
+            val body: t -> exp
+            val dest: t -> {arg: Var.t,
+                            argType: Type.t,
+                            body: exp,
+                            mayInline: bool}
+            val equals: t * t -> bool
+            val layout: t -> Layout.t
+            val make: {arg: Var.t,
+                       argType: Type.t,
+                       body: exp,
+                       mayInline: bool} -> t
+            val mayInline: t -> bool
+            val plist: t -> PropertyList.t
+         end
 
       (* VarExp is a type application, variable applied to type args. *)
       structure VarExp:
-	 sig
-	    datatype t = T of {var: Var.t,
-			       targs: Type.t vector}
+         sig
+            datatype t = T of {var: Var.t,
+                               targs: Type.t vector}
 
-	    val layout: t -> Layout.t
-	    val mono: Var.t -> t
-	    val targs: t -> Type.t vector
-	    val var: t -> Var.t
-	 end
+            val layout: t -> Layout.t
+            val mono: Var.t -> t
+            val targs: t -> Type.t vector
+            val var: t -> Var.t
+         end
 
       structure PrimExp:
-	 sig
-	    type exp = Lambda.exp
-	    datatype t =
-	       App of {arg: VarExp.t,
-		       func: VarExp.t}
-	     | Case of {cases: exp Cases.t,
-			default: (exp * Region.t) option,
-			test: VarExp.t}
-	     | ConApp of {arg: VarExp.t option,
-			  con: Con.t,
-			  targs: Type.t vector}
-	     | Const of Const.t
-	     | Handle of {(* catch binds the exception in the handler. *)
-			  catch: Var.t * Type.t,
-			  handler: exp,
-			  try: exp}
-	     | Lambda of Lambda.t
-	     | PrimApp of {args: VarExp.t vector,
-			   prim: Type.t Prim.t,
-			   targs: Type.t vector}
-	     | Profile of ProfileExp.t
-	     | Raise of {exn: VarExp.t, extend: bool}
-	     | Select of {offset: int,
-			  tuple: VarExp.t}
-	     | Tuple of VarExp.t vector
-	     | Var of VarExp.t
+         sig
+            type exp = Lambda.exp
+            datatype t =
+               App of {arg: VarExp.t,
+                       func: VarExp.t}
+             | Case of {cases: exp Cases.t,
+                        default: (exp * Region.t) option,
+                        test: VarExp.t}
+             | ConApp of {arg: VarExp.t option,
+                          con: Con.t,
+                          targs: Type.t vector}
+             | Const of Const.t
+             | Handle of {(* catch binds the exception in the handler. *)
+                          catch: Var.t * Type.t,
+                          handler: exp,
+                          try: exp}
+             | Lambda of Lambda.t
+             | PrimApp of {args: VarExp.t vector,
+                           prim: Type.t Prim.t,
+                           targs: Type.t vector}
+             | Profile of ProfileExp.t
+             | Raise of {exn: VarExp.t, extend: bool}
+             | Select of {offset: int,
+                          tuple: VarExp.t}
+             | Tuple of VarExp.t vector
+             | Var of VarExp.t
 
-	    val layout: t -> Layout.t
-	 end
-	       
+            val layout: t -> Layout.t
+         end
+               
       structure Dec:
-	 sig
-	    type exp = Lambda.exp
-	       
-	    datatype t =
-	       Exception of {arg: Type.t option,
-			     con: Con.t}
-	     | Fun of {decs: {lambda: Lambda.t,
-			      ty: Type.t,
-			      var: Var.t} vector,
-		       tyvars: Tyvar.t vector}
-	     | MonoVal of {exp: PrimExp.t,
-			   ty: Type.t,
-			   var: Var.t}
-	     | PolyVal of {exp: exp,
-			   ty: Type.t,
-			   tyvars: Tyvar.t vector,
-			   var: Var.t}
+         sig
+            type exp = Lambda.exp
+               
+            datatype t =
+               Exception of {arg: Type.t option,
+                             con: Con.t}
+             | Fun of {decs: {lambda: Lambda.t,
+                              ty: Type.t,
+                              var: Var.t} vector,
+                       tyvars: Tyvar.t vector}
+             | MonoVal of {exp: PrimExp.t,
+                           ty: Type.t,
+                           var: Var.t}
+             | PolyVal of {exp: exp,
+                           ty: Type.t,
+                           tyvars: Tyvar.t vector,
+                           var: Var.t}
 
-	    val layout: t -> Layout.t
-	 end
+            val layout: t -> Layout.t
+         end
 
       structure Exp:
-	 sig
-	    type t = Lambda.exp
-	       
-	    val clear: t -> unit
-	    val decs: t -> Dec.t list
-	    val dest: t -> {decs: Dec.t list, result: VarExp.t}
-	    val enterLeave: t * Type.t * SourceInfo.t -> t
-	    (* foreach {exp, handleExp, handleBoundVar, handleVarExp}
-	     * applies handleExp to each subexpresison of e (including e)
-	     * applies handleBoundVar to each variable bound in e
-	     * applies handleVarExp to each variable expression in e
-	     * handleBoundVar will be called on a variable binding before
-	     * handleVarExp is called on any occurrences
-	     * handleExp is called on an expression after it is called on
-	     * all of its subexpressions
-	     *)
-	    val foreach:
-	       {exp: t,
-		handleExp: t -> unit,
-		handlePrimExp: Var.t * Type.t * PrimExp.t -> unit,
-		handleBoundVar: Var.t * Tyvar.t vector * Type.t -> unit,
-		handleVarExp: VarExp.t -> unit} -> unit
-	    val foreachBoundVar:
-	       t * (Var.t * Tyvar.t vector * Type.t -> unit) -> unit
-	    val foreachExp: t * (t -> unit) -> unit
-	    val foreachPrimExp: t * (Var.t * Type.t * PrimExp.t -> unit) -> unit
-	    val foreachVarExp: t * (VarExp.t -> unit) -> unit
-	    val fromPrimExp: PrimExp.t * Type.t -> t
-	    val hasPrim: t * (Type.t Prim.t -> bool) -> bool
-	    val layout: t -> Layout.t
-	    val make: {decs: Dec.t list, result: VarExp.t} -> t
-	    val prefix: t * Dec.t -> t
-	    val result: t -> VarExp.t
-	    val size: t -> int
-	 end
+         sig
+            type t = Lambda.exp
+               
+            val clear: t -> unit
+            val decs: t -> Dec.t list
+            val dest: t -> {decs: Dec.t list, result: VarExp.t}
+            val enterLeave: t * Type.t * SourceInfo.t -> t
+            (* foreach {exp, handleExp, handleBoundVar, handleVarExp}
+             * applies handleExp to each subexpresison of e (including e)
+             * applies handleBoundVar to each variable bound in e
+             * applies handleVarExp to each variable expression in e
+             * handleBoundVar will be called on a variable binding before
+             * handleVarExp is called on any occurrences
+             * handleExp is called on an expression after it is called on
+             * all of its subexpressions
+             *)
+            val foreach:
+               {exp: t,
+                handleExp: t -> unit,
+                handlePrimExp: Var.t * Type.t * PrimExp.t -> unit,
+                handleBoundVar: Var.t * Tyvar.t vector * Type.t -> unit,
+                handleVarExp: VarExp.t -> unit} -> unit
+            val foreachBoundVar:
+               t * (Var.t * Tyvar.t vector * Type.t -> unit) -> unit
+            val foreachExp: t * (t -> unit) -> unit
+            val foreachPrimExp: t * (Var.t * Type.t * PrimExp.t -> unit) -> unit
+            val foreachVarExp: t * (VarExp.t -> unit) -> unit
+            val fromPrimExp: PrimExp.t * Type.t -> t
+            val hasPrim: t * (Type.t Prim.t -> bool) -> bool
+            val layout: t -> Layout.t
+            val make: {decs: Dec.t list, result: VarExp.t} -> t
+            val prefix: t * Dec.t -> t
+            val result: t -> VarExp.t
+            val size: t -> int
+         end
 
       structure DirectExp:
-	 sig
-	    type t
+         sig
+            type t
 
-	    val app: {func: t, arg: t, ty: Type.t} -> t
-	    val bug: string * Type.t -> t
-	    val casee:
-	       {cases: t Cases.t,
-		default: (t * Region.t) option,
-		test: t,
-		ty: Type.t} (* type of entire case expression *)
-	       -> t
-	    val conApp: {arg: t option,
-			 con: Con.t,
-			 targs: Type.t vector,
-			 ty: Type.t} -> t
-	    val const: Const.t -> t
-	    val deref: t -> t
-	    val detuple: {tuple: t, body: (VarExp.t * Type.t) vector -> t} -> t
-	    val detupleBind: {tuple: t, components: Var.t vector, body: t} -> t
-	    val equal: t * t -> t
-	    val falsee: unit -> t
-	    val fromExp: Exp.t * Type.t -> t
-	    val handlee: {catch: Var.t * Type.t,
-			  handler: t,
-			  try: t,
-			  ty: Type.t} -> t
-	    val iff: {test: t, thenn: t, elsee: t, ty: Type.t} -> t
-	    val lambda: {arg: Var.t,
-			 argType: Type.t,
-			 body: t,
-			 bodyType: Type.t,
-			 mayInline: bool} -> t
-	    val layout: t -> Layout.t
-	    val let1: {var: Var.t, exp: t, body: t} -> t
-	    val lett: {decs: Dec.t list, body: t} -> t
-	    val monoVar: Var.t * Type.t -> t
-	    val primApp: {args: t vector,
-			  prim: Type.t Prim.t,
-			  targs: Type.t vector,
-			  ty: Type.t} -> t
-	    val raisee: t * {extend: bool} * Type.t -> t
-	    val reff: t -> t
-	    val select: {tuple: t, offset: int, ty: Type.t} -> t
-	    val seq: t vector * (t vector -> t) -> t
-	    val sequence: t vector -> t
-	    val string: string -> t
-	    val toExp: t -> Exp.t
-	    val truee: unit -> t
-	    val tuple: {exps: t vector, ty: Type.t} -> t
-	    val unit: unit -> t
-	    val vall: {var: Var.t, exp: t} -> Dec.t list
-	    val var: {targs: Type.t vector,
-		      ty: Type.t,
-		      var: Var.t} -> t
-	    val varExp: VarExp.t * Type.t -> t
-	 end
+            val app: {func: t, arg: t, ty: Type.t} -> t
+            val bug: string * Type.t -> t
+            val casee:
+               {cases: t Cases.t,
+                default: (t * Region.t) option,
+                test: t,
+                ty: Type.t} (* type of entire case expression *)
+               -> t
+            val conApp: {arg: t option,
+                         con: Con.t,
+                         targs: Type.t vector,
+                         ty: Type.t} -> t
+            val const: Const.t -> t
+            val deref: t -> t
+            val detuple: {tuple: t, body: (VarExp.t * Type.t) vector -> t} -> t
+            val detupleBind: {tuple: t, components: Var.t vector, body: t} -> t
+            val equal: t * t -> t
+            val falsee: unit -> t
+            val fromExp: Exp.t * Type.t -> t
+            val handlee: {catch: Var.t * Type.t,
+                          handler: t,
+                          try: t,
+                          ty: Type.t} -> t
+            val iff: {test: t, thenn: t, elsee: t, ty: Type.t} -> t
+            val lambda: {arg: Var.t,
+                         argType: Type.t,
+                         body: t,
+                         bodyType: Type.t,
+                         mayInline: bool} -> t
+            val layout: t -> Layout.t
+            val let1: {var: Var.t, exp: t, body: t} -> t
+            val lett: {decs: Dec.t list, body: t} -> t
+            val monoVar: Var.t * Type.t -> t
+            val primApp: {args: t vector,
+                          prim: Type.t Prim.t,
+                          targs: Type.t vector,
+                          ty: Type.t} -> t
+            val raisee: t * {extend: bool} * Type.t -> t
+            val reff: t -> t
+            val select: {tuple: t, offset: int, ty: Type.t} -> t
+            val seq: t vector * (t vector -> t) -> t
+            val sequence: t vector -> t
+            val string: string -> t
+            val toExp: t -> Exp.t
+            val truee: unit -> t
+            val tuple: {exps: t vector, ty: Type.t} -> t
+            val unit: unit -> t
+            val vall: {var: Var.t, exp: t} -> Dec.t list
+            val var: {targs: Type.t vector,
+                      ty: Type.t,
+                      var: Var.t} -> t
+            val varExp: VarExp.t * Type.t -> t
+         end
 
       structure Program:
-	 sig
-	    datatype t =
-	       T of {body: Exp.t,
-		     datatypes: {cons: {arg: Type.t option,
-					con: Con.t} vector,
-				 tycon: Tycon.t,
-				 tyvars: Tyvar.t vector} vector,
-		     (* overflow is SOME only after exceptions have been
-		      * implemented.
-		      *)
-		     overflow: Var.t option}
+         sig
+            datatype t =
+               T of {body: Exp.t,
+                     datatypes: {cons: {arg: Type.t option,
+                                        con: Con.t} vector,
+                                 tycon: Tycon.t,
+                                 tyvars: Tyvar.t vector} vector,
+                     (* overflow is SOME only after exceptions have been
+                      * implemented.
+                      *)
+                     overflow: Var.t option}
 
-	    val clear: t -> unit (* clear all property lists *)
-	    val empty: t
-	    val layout: t -> Layout.t
-	    val layoutStats: t -> Layout.t
-	 end
+            val clear: t -> unit (* clear all property lists *)
+            val empty: t
+            val layout: t -> Layout.t
+            val layoutStats: t -> Layout.t
+         end
    end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/xml/xml-type.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/xml/xml-type.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/xml/xml-type.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,17 +1,18 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature XML_TYPE =
    sig
       include HASH_TYPE
-	 
+         
       datatype dest =
-	 Var of Tyvar.t
+         Var of Tyvar.t
        | Con of Tycon.t * t vector
-	 
+         
       val dest: t -> dest
    end

Modified: mlton/branches/on-20050420-cmm-branch/mlton/xml/xml.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/xml/xml.fun	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/xml/xml.fun	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 functor Xml (S: XML_STRUCTS): XML =
    XmlSimplify (Shrink (TypeCheck (XmlTree (S))))

Modified: mlton/branches/on-20050420-cmm-branch/mlton/xml/xml.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlton/xml/xml.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlton/xml/xml.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
+
 signature XML_STRUCTS =
    sig
       include XML_TREE_STRUCTS


Property changes on: mlton/branches/on-20050420-cmm-branch/mlyacc
___________________________________________________________________
Name: svn:ignore
   + *.call-graph.dot
*.ssa
mlyacc.ps
mlyacc.sml
mlyacc


Deleted: mlton/branches/on-20050420-cmm-branch/mlyacc/.cvsignore
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlyacc/.cvsignore	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlyacc/.cvsignore	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,5 +0,0 @@
-*.call-graph.dot
-*.ssa
-mlyacc.ps
-mlyacc.sml
-mlyacc

Copied: mlton/branches/on-20050420-cmm-branch/mlyacc/.ignore (from rev 4358, mlton/trunk/mlyacc/.ignore)

Modified: mlton/branches/on-20050420-cmm-branch/mlyacc/INSTALL
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlyacc/INSTALL	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlyacc/INSTALL	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,4 +1,26 @@
 Installation instructions for ML-Yacc
 -------------------------------------
 
+ML-Yacc will normally be automatically
+installed as part of the SML/NJ system
+by the SML/NJ installer.
 
+To install by hand (e.g., if you make
+your own modifications), run the
+
+    ./build
+
+script in this directory and then move
+the file
+
+    src/ml-yacc.$ARCH-$OS
+
+to the heap-file directory.
+
+Running ./build requires a properly
+functioning installation of SML/NJ.
+If you make modifications to lexer or
+parser, be sure to also have properly
+functioning instances of ml-lex and
+ml-yacc installed before you run
+./build.

Modified: mlton/branches/on-20050420-cmm-branch/mlyacc/Makefile
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlyacc/Makefile	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlyacc/Makefile	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,11 @@
+## Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ #    Jagannathan, and Stephen Weeks.
+ # Copyright (C) 1997-2000 NEC Research Institute.
+ #
+ # MLton is released under a BSD-style license.
+ # See the file MLton-LICENSE for details.
+ ##
+
 SRC = $(shell cd .. && pwd)
 BUILD = $(SRC)/build
 BIN = $(BUILD)/bin
@@ -13,7 +21,6 @@
 $(NAME): $(NAME).mlb $(shell PATH=$(BIN):$$PATH && $(MLTON) -stop f $(NAME).mlb)
 	@echo 'Compiling $(NAME)'
 	$(MLTON) $(FLAGS) $(NAME).mlb
-	size $(NAME)
 
 $(NAME).sml: $(NAME).cm $(shell $(MLTON) -stop f $(NAME).cm)
 	mlton -stop sml $(NAME).cm

Modified: mlton/branches/on-20050420-cmm-branch/mlyacc/README
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlyacc/README	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlyacc/README	2006-02-16 19:34:54 UTC (rev 4361)
@@ -7,13 +7,17 @@
 Files of interest (those marked with a * must be built by the person
 installing ML-Yacc):
 
-	README		- this file
-	INSTALL		- installation instructions.
-	COPYRIGHT	- this software is distributed subject to the
-		          terms of this file.
-	lib		- common source code used by both ML-Yacc and applications
-			  that use ML-Yacc.
-	src		- source code for the parser-generator part of ML-Yacc.
-	doc		- documentation for ML-Yacc.  Please read this before
-			  using ML-Yacc
-	examples	- sample parsers built with ML-Yacc
+        README          - this file
+        INSTALL         - installation instructions.
+        COPYRIGHT       - this software is distributed subject to the
+                          terms of this file.
+        lib             - implementation of the ML-Yacc library
+                          (aka $/ml-yacc-lib.cm);  this library is used
+                          by both by applications and by ML-Yacc itself
+                          (because ML-Yacc IS an ML-Yacc application)
+        src             - source code for the parser-generator part of ML-Yacc.
+        doc             - documentation for ML-Yacc.  Please read this before
+                          using ML-Yacc
+        examples        - sample parsers built with ML-Yacc
+        build           - script that invokes ../../bin/ml-build to construct
+                          the stand-alone version of ML-Yacc

Modified: mlton/branches/on-20050420-cmm-branch/mlyacc/README.MLton
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlyacc/README.MLton	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlyacc/README.MLton	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,4 +1,11 @@
 This is a modified version of the ml-yacc directory that comes with SML/NJ
+110.55.  I made a few changes so that the sources are compilable with MLton.
+
+mfluet@acm.org  2005-7-21
+
+*****
+
+This is a modified version of the ml-yacc directory that comes with SML/NJ
 110.9.1.  I made a few changes so that the sources are compilable with MLton.
 
 sweeks@acm.org  2000-8-23

Modified: mlton/branches/on-20050420-cmm-branch/mlyacc/call-main.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlyacc/call-main.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlyacc/call-main.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1 +1,9 @@
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 val _ = Main.main()


Property changes on: mlton/branches/on-20050420-cmm-branch/mlyacc/doc
___________________________________________________________________
Name: svn:ignore
   - html
mlyacc.aux
mlyacc.dvi
mlyacc.log
mlyacc.pdf
mlyacc.ps
mlyacc.toc
   + html
mlyacc.aux
mlyacc.dvi
mlyacc.log
mlyacc.pdf
mlyacc.ps
mlyacc.toc


Deleted: mlton/branches/on-20050420-cmm-branch/mlyacc/doc/.cvsignore
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlyacc/doc/.cvsignore	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlyacc/doc/.cvsignore	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,7 +0,0 @@
-html
-mlyacc.aux
-mlyacc.dvi
-mlyacc.log
-mlyacc.pdf
-mlyacc.ps
-mlyacc.toc

Copied: mlton/branches/on-20050420-cmm-branch/mlyacc/doc/.ignore (from rev 4358, mlton/trunk/mlyacc/doc/.ignore)

Modified: mlton/branches/on-20050420-cmm-branch/mlyacc/doc/Makefile
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlyacc/doc/Makefile	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlyacc/doc/Makefile	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,11 @@
+## Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ #    Jagannathan, and Stephen Weeks.
+ # Copyright (C) 1997-2000 NEC Research Institute.
+ #
+ # MLton is released under a BSD-style license.
+ # See the file MLton-LICENSE for details.
+ ##
+
 all: mlyacc.ps
 
 html/index.html: $(TEX_FILES)
@@ -15,3 +23,7 @@
 
 mlyacc.ps: mlyacc.dvi
 	dvips -o mlyacc.ps mlyacc.dvi
+
+.PHONY: clean
+clean:
+	../../bin/clean

Modified: mlton/branches/on-20050420-cmm-branch/mlyacc/doc/mlyacc.tex
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlyacc/doc/mlyacc.tex	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlyacc/doc/mlyacc.tex	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,19 +1,17 @@
 \documentstyle{article}
 \title{                        ML-Yacc User's Manual \\
-			       Version 2.3
+                               Version 2.4
       }
 \author{                David R. Tarditi$^1$\\
                         Andrew W. Appel$^2$\\
 \\              
-$^1$School of Computer Science \\
-Carnegie Mellon University \\
-Pittsburgh, PA 15213 \\
+$^1$Microsoft Research \\
 \\
 $^2$Department of Computer Science \\
     Princeton University \\
     Princeton, NJ 08544 
 }
-\date{October 6, 1994}
+\date{April 24, 2000}
 
 \begin{document}
 \maketitle
@@ -29,6 +27,8 @@
 
 New in this version:  Improved error correction directive \verb|%change|
 that allows multi-token insertions, deletions, substitutions.
+Explanation of how to build a parser (Section 5) and the Calc example
+(Section 7) revised for SML/NJ Version 110 and the use of CM.
 
 \newpage
 \tableofcontents
@@ -139,17 +139,17 @@
 
 \subsection{Error Recovery}
 
-The error recovery algorithm is able to accurately recover
-from many single token syntax errors.
-It tries to make a single token correction at the token in the
-input stream at which the syntax error was detected and any of
-the 15 tokens\footnote{An arbitrary number chosen because numbers
-above this do not seem to improve error correction much.} before that token.  The algorithm
-checks corrections before the point of error detection because
-a syntax error is often not detected until several tokens beyond
-the token which caused the error.\footnote{An LR parser detects a syntax error
-as soon as possible, but this does not necessarily mean that the
-token at which the error was detected caused the error.}
+The error recovery algorithm is able to accurately recover from many
+single token syntax errors.  It tries to make a single token
+correction at the token in the input stream at which the syntax error
+was detected and any of the 15 tokens\footnote{An arbitrary number
+chosen because numbers above this do not seem to improve error
+correction much.} before that token.  The algorithm checks corrections
+before the point of error detection because a syntax error is often
+not detected until several tokens beyond the token which caused the
+error.\footnote{An LR parser detects a syntax error as soon as
+possible, but this does not necessarily mean that the token at which
+the error was detected caused the error.}
 
 The algorithm works by trying corrections at each
 of the 16 tokens up to and including the token at which the
@@ -333,8 +333,7 @@
 \begin{quote}
 \raggedright
 \tt
-                \%arg \%eop \%header \%token\_sig\_info \%keyword
-		\%left \%name \%nodefault
+                \%arg \%eop \%header \%keyword \%left \%name \%nodefault
                 \%nonassoc \%nonterm \%noshift \%pos \%prec \%prefer
                 \%pure \%right \%start \%subst \%term \%value \%verbose
 \end{quote}
@@ -366,7 +365,6 @@
 \mbox{cmd} & ::= & \mbox{{\tt \%arg} (Any-ML-pattern) {\tt :} ML-type} \\
  & | & \mbox{{\tt \%eop} symbol-list} \\
  & | & \mbox{{\tt \%header} code} \\
- & | & \mbox{{\tt \%token\_sig\_info} code} \\
  & | & \mbox{{\tt \%keyword} symbol-list} \\
  & | & \mbox{{\tt \%left} symbol-list} \\
  & | & \mbox{{\tt \%name} identifier} \\
@@ -490,40 +488,22 @@
 while evaluating a correction to a syntax error otherwise.  This may
 confuse the lexer.
 \item[{\tt \%header}]
-\begin{samepage}
 You may define code to head the functor \{parser name\}LrValsFun here.  This
 may be useful for adding additonal parameter structures to the functor.
 The functor must be parameterized by the Token structure, so
 the declaration should always have the form:
-\begin{tt}
+\begin{quote}
 \begin{verbatim}
 %header (functor {parser name}LrValsFun(
                                 structure Token : TOKEN
                                        ...) 
         )
 \end{verbatim}
-\end{tt}
-\end{samepage}
-\item[{\tt \%token\_sig\_info}]
-\begin{samepage}
-You may add specifications to the signature \{parser name\}\_TOKENS
-here.  This may be useful in adding structures or types that
-subsequently occur as arguments to various tokens.  The declartion
-should be of the form:
-\begin{tt}
-\begin{verbatim}
-%token_sig_info (type mytype
-                 structure MyStructure : MyStructure_sig
-                 ...
-                )
-\end{verbatim}
-\end{tt}
-Any specification you put here must be satisfied by the code you give
-in the user declarations.%
-\end{samepage}
+\end{quote}
+
 \item[{\tt \%left},{\tt \%right},{\tt \%nonassoc}]
 You should list the precedence declarations in order of increasing (tighter-binding)
- precedence.  Each precedence declaration consists
+precedence.  Each precedence declaration consists
 of \% keyword specifying associativity followed by a list of terminals.
 The keywords are {\tt \%left}, {\tt \%right}, and {\tt \%nonassoc},
 standing for their respective associativities.
@@ -566,7 +546,7 @@
 \end{enumerate}
 \end{description}
 
-\subsection{Declarations for improving error-recovery.}
+\subsection{Declarations for improving error-recovery}
 
 These optional declarations improve error-recovery:
 
@@ -652,7 +632,7 @@
 The value is ignored if the nonterminal has no value, but is still
 evaluated for side-effects.
 
-\section{Producing files with ML-Yacc.}
+\section{Producing files with ML-Yacc}
 
 ML-Yacc may be used from the interactive system or built as a
 stand-alone program which may be run from the Unix command line.
@@ -747,56 +727,60 @@
 declaration, but you must follow special instructions for tying the parser
 and lexer together.
  
-\section{Creating the parser.}
+\section{Creating the parser}
 \label{create-parser}
-Let the name of the specification file be denoted by \{spec name\} and
-the parser name in the specification be \{n\}.
-To construct a parser, do the following:
+Let the name of the grammar specification file be denoted by
+\{grammar\} and the name of the lexer specification file be
+denoted by \{lexer\} (e.g. in our calculator example these would
+stand for calc.grm and calc.lex, respectively).
+Let the parser name in the specification be represented by \{n\}
+(e.g. Calc in our calculator example).
 
+To construct a parser, do the following:
 \begin{enumerate}
-
-\item Run ML-Yacc on the specification file for a grammar.
-\item Run ML-Lex to create the lexical analyzer.
-\item Load the file base.sml from the ML-Yacc directory.  This file contains
-the common modules.  If you have already loaded this file, you do not need
-to load it again.
-\item Load the file \{spec name\}.sig produced by ML-Yacc.
-\item Load the file produced by ML-Lex.
-\item Load the file \{spec name\}.sml by ML-Yacc.
+\item In the appropriate CM description file (e.g. for your main
+program or one of its subgroups or libraries), include the lines:
+\begin{quote}
+\begin{verbatim}
+ml-yacc-lib.cm
+{lexer}
+{grammar}
+\end{verbatim}  
+\end{quote}
+This will cause ML-Yacc to be run on \{grammar\}, producing source files
+\{grammar\}.sig and \{grammar\}.sml, and ML-Lex to be run on
+\{lexer\}, producing a source file \{lexer\}.sml.  Then these files
+will be compiled after loading the necessary signatures and modules
+from the ML-Yacc library as specified by {\tt ml-yacc-lib.cm}.
 \item Apply functors to create the parser:
-
-\end{enumerate}
 \begin{quote}
-\tt
 \begin{verbatim}
-   structure {n}LrVals =
-        {n}LrValsFun(structure Token = LrParser.Token)
-   structure {n}Lex = 
-        {n}LexFun(structure Tokens = 
-                             {n}LrVals.Tokens)
-   structure {n}Parser=
-         Join(structure ParserData = {n}LrVals.ParserData
-              structure Lex={n}Lex
-              structure LrParser=LrParser)
+structure {n}LrVals =
+  {n}LrValsFun(structure Token = LrParser.Token)
+structure {n}Lex = 
+  {n}LexFun(structure Tokens = {n}LrVals.Tokens)
+structure {n}Parser=
+  Join(structure ParserData = {n}LrVals.ParserData
+       structure Lex={n}Lex
+       structure LrParser=LrParser)
 \end{verbatim}
 \end{quote}
 If the lexer was created using the {\tt \%arg} declaration in ML-Lex,
-the last step
-must be changed to use another functor called JoinWithArg:
+the definition of \{n\}Parser must be changed to use another functor
+called JoinWithArg:
 \begin{quote}
-\tt
 \begin{verbatim}
-     structure {n}Parser=
-         JoinWithArg
-             (structure ParserData={n}LrVals.ParserData
-              structure Lex={n}Lex
-              structure LrParser=LrParser)
+structure {n}Parser=
+  JoinWithArg
+    (structure ParserData={n}LrVals.ParserData
+     structure Lex={n}Lex
+     structure LrParser=LrParser)
 \end{verbatim}
 \end{quote}
+\end{enumerate}
 
 The following outline summarizes this process:
 \begin{quote}
-\tt
 \begin{verbatim}
 (* available at top level *)
 
@@ -810,127 +794,128 @@
 (* printed out in .sig file created by parser generator: *)
 
 signature {n}_TOKENS = 
-  sig
-      structure Token : TOKEN
-      type svalue
-      val PLUS : 'pos * 'pos ->
-                         (svalue,'pos) Token.token
-      val INTLIT : int * 'pos * 'pos ->
-                         (svalue,'pos) Token.token
-      ...
-  end
+sig
+  structure Token : TOKEN
+  type svalue
+  val PLUS : 'pos * 'pos ->
+             (svalue,'pos) Token.token
+  val INTLIT : int * 'pos * 'pos ->
+               (svalue,'pos) Token.token
+  ...
+end
 
 signature {n}_LRVALS =
-  sig
-     structure Tokens : {n}_TOKENS
-     structure ParserData : PARSER_DATA
-     sharing ParserData.Token = Tokens.Token
-     sharing type ParserData.svalue = Tokens.svalue
-  end
+sig
+  structure Tokens : {n}_TOKENS
+  structure ParserData : PARSER_DATA
+  sharing ParserData.Token = Tokens.Token
+  sharing type ParserData.svalue = Tokens.svalue
+end
 
 (* printed out by lexer generator: *)
 
 functor {n}LexFun(structure Tokens : {n}_TOKENS)=
-   struct
-        ...
-   end
+struct
+  ...
+end
 
 (* printed out in .sml file created by parser generator: *)
 
 functor {n}LrValsFun(structure Token : TOKENS) =
+struct
+
+  structure ParserData =
   struct
+    structure Token = Token
 
-        structure ParserData =
-          struct
-            structure Token = Token
+    (* code in header section of specification *)
 
-        (* code in header section of specification *)
+    structure Header = ...
+    type svalue = ...
+    type result = ...
+    type pos = ...
+    structure Actions = ...
+    structure EC = ...
+    val table = ...
+  end
 
-            structure Header = ...
-            type svalue
-            type result
-            type pos
-            structure Actions = ...
-            structure EC = ...
-            val table = ...
-          end
-        structure Tokens : {n}_TOKENS =
-           struct
-             structure Token = ParserData.Token
-             type svalue
-             fun PLUS(p1,p2) = ...
-             fun INTLIT(i,p1,p2) = ... 
-          end
-   end
+  structure Tokens : {n}_TOKENS =
+  struct
+    structure Token = ParserData.Token
+    type svalue = ...
+    fun PLUS(p1,p2) = ...
+    fun INTLIT(i,p1,p2) = ... 
+  end
 
+end
+
 (* to be done by the user: *)
  
 structure {n}LrVals =
-         {n}LrValsFun(structure Token = LrParser.Token)
+  {n}LrValsFun(structure Token = LrParser.Token)
+
 structure {n}Lex = 
-         {n}LexFun(structure Tokens =
-                            {n}LrVals.Tokens)
+  {n}LexFun(structure Tokens = {n}LrVals.Tokens)
+
 structure {n}Parser =
-           Join(structure Lex = {n}Lex
-                ParserData = {n}ParserData
-                structure LrParser = LrParser)
+  Join(structure Lex = {n}Lex
+       structure ParserData = {n}ParserData
+       structure LrParser = LrParser)
 \end{verbatim}
 \end{quote}
 
 \section{Using the parser}
 \subsection{Parser Structure Signatures}
 The final structure created will have the signature PARSER:
-\begin{tt}
+\begin{quote}
 \begin{verbatim}
 signature PARSER =
-    sig
-        structure Token : TOKEN
-        structure Stream : STREAM
-        exception ParseError
+sig
+  structure Token : TOKEN
+  structure Stream : STREAM
+  exception ParseError
 
-        type pos    (* pos is the type of line numbers *)
-        type result (* value returned by the parser *)
-        type arg    (* type of the user-supplied argument  *)
-        type svalue (* the types of semantic values *)
+  type pos    (* pos is the type of line numbers *)
+  type result (* value returned by the parser *)
+  type arg    (* type of the user-supplied argument  *)
+  type svalue (* the types of semantic values *)
 
-        val makeLexer : (int -> string) ->
-                         (svalue,pos) Token.token Stream.stream
-
-        val parse :
-            int * ((svalue,pos) Token.token Stream.stream) *
-            (string * pos * pos -> unit) * arg ->
-                result * (svalue,pos) Token.token Stream.stream
-        val sameToken :
-          (svalue,pos) Token.token * (svalue,pos) Token.token ->
-              bool
-     end
+  val makeLexer : (int -> string) ->
+                    (svalue,pos) Token.token Stream.stream
+  val parse :
+      int * ((svalue,pos) Token.token Stream.stream) *
+      (string * pos * pos -> unit) * arg ->
+        result * (svalue,pos) Token.token Stream.stream
+  val sameToken :
+      (svalue,pos) Token.token * (svalue,pos) Token.token ->
+        bool
+end
 \end{verbatim}
-\end{tt}
+\end{quote}
 or the signature ARG\_PARSER if you used {\tt \%arg} to create the lexer.
 This signature differs from ARG\_PARSER in that it
 which has an additional type {\tt lexarg} and a different type
 for {\tt makeLexer}:
-\begin{tt}
+\begin{quote}
 \begin{verbatim}
-    type lexarg
-    val makeLexer : (int -> string)  -> lexarg ->
-                         (svalue,pos) token stream
+type lexarg
+val makeLexer : (int -> string)  -> lexarg ->
+                  (svalue,pos) token stream
 \end{verbatim}
-\end{tt}
+\end{quote}
 
-The signature STREAM is:
-\begin{tt}
+The signature STREAM (providing lazy streams) is:
+\begin{quote}
 \begin{verbatim}
-(* STREAM: signature for a lazy stream.*)
-
 signature STREAM =
- sig type 'a stream
-     val streamify : (unit -> '_a) -> '_a stream
-     val cons : '_a * '_a stream -> '_a stream
-     val get : '_a stream -> '_a * '_a stream
- end
+sig
+  type 'a stream
+  val streamify : (unit -> 'a) -> 'a stream
+  val cons : 'a * 'a stream -> 'a stream
+  val get : 'a stream -> 'a * 'a stream
+end
 \end{verbatim}
-\end{tt}
+\end{quote}
 
 \subsection{Using the parser structure}
 
@@ -991,14 +976,14 @@
 
 \section{Examples}
 
-  See the directory examples for examples of parsers constructed using
+See the directory examples for examples of parsers constructed using
 ML-Yacc.  Here is a small sample parser and lexer for an interactive
-calculator, from the directory examples/calc, along with code for 
-creating a parsing function.  The calculator reads one or
-more expressions from the standard input, evaluates the expression, and
-prints its value.  Expressions should be separated by semicolons, and may
-also be ended by using an end-of-file.  This shows
-how to construct an interactive parser which reads a top-level declaration
+calculator, from the directory examples/calc, along with code for
+creating a parsing function.  The calculator reads one or more
+expressions from the standard input, evaluates the expressions, and
+prints their values.  Expressions should be separated by semicolons,
+and may also be ended by using an end-of-file.  This shows how to
+construct an interactive parser which reads a top-level declaration
 and processes the declaration before reading the next top-level
 declaration.
 
@@ -1101,73 +1086,66 @@
 \end{tt}
 \subsection{Top-level code}
 
-You must follow instructions one through six in Section~\ref{create-parser}
+You must follow the instructions in Section~\ref{create-parser}
 to create the parser and lexer functors and load them.  After you have
 done this, you must then apply the functors to produce the {\tt CalcParser}
 structure.  The code for doing this is shown below.
+\begin{quote}
 \begin{verbatim}
 structure CalcLrVals =
-    CalcLrValsFun(structure Token = LrParser.Token)
+  CalcLrValsFun(structure Token = LrParser.Token)
+
 structure CalcLex =
-    CalcLexFun(structure Tokens = CalcLrVals.Tokens);
+  CalcLexFun(structure Tokens = CalcLrVals.Tokens);
+
 structure CalcParser =
-     Join(structure LrParser = LrParser
-          structure ParserData = CalcLrVals.ParserData
-          structure Lex = CalcLex)
+  Join(structure LrParser = LrParser
+       structure ParserData = CalcLrVals.ParserData
+       structure Lex = CalcLex)
 \end{verbatim}
+\end{quote}
  
 Now we need a function which given a lexer invokes the parser.  The
 function {\tt invoke} does this.
 
+\begin{quote}
 \begin{verbatim}
-val invoke = fn lexstream =>
-  let val print_error = fn (s,i:int,_) =>
-       output(std_out,"Error, line " ^
-                      (makestring i) ^ ", " ^ s ^ "\n")
-  in CalcParser.parse(0,lexstream,print_error,())
-  end
-\end{verbatim}
-
-We also need a function which reads a line of input from the terminal
-\footnote{Standard ML of New Jersey has a function input\_line in its
-built-in environment that also does this.}:
-\begin{verbatim}
-  val input_line = fn f =>
-    let fun loop result =
-          let val c = input (f,1)
-              val result = c :: result
-          in if String.size c = 0 orelse c = "\n" then
-                String.implode (rev result)
-             else loop result
-          end
-    in loop nil
+fun invoke lexstream =
+    let fun print_error (s,i:int,_) =
+            TextIO.output(TextIO.stdOut,
+                          "Error, line " ^ (Int.toString i) ^ ", " ^ s ^ "\n")
+     in CalcParser.parse(0,lexstream,print_error,())
     end
 \end{verbatim}
+\end{quote}
 
 Finally, we need a function which can read one or more expressions from
 the standard input.  The function {\tt parse}, shown below, does this.
 It runs the calculator on the standard input and terminates 
 when an end-of-file is encountered.
 
+\begin{quote}
 \begin{verbatim}
-val parse = fn () => 
-    let val lexer = CalcParser.makeLexer (fn _ => input_line std_in)
+fun parse () = 
+    let val lexer = CalcParser.makeLexer
+                      (fn _ => TextIO.inputLine TextIO.stdIn)
         val dummyEOF = CalcLrVals.Tokens.EOF(0,0)
         val dummySEMI = CalcLrVals.Tokens.SEMI(0,0)
         fun loop lexer =
-           let val (result,lexer) = invoke lexer
-               val (nextToken,lexer) = CalcParser.Stream.get lexer
-               val _ = case result
+            let val (result,lexer) = invoke lexer
+                val (nextToken,lexer) = CalcParser.Stream.get lexer
+             in case result
                   of SOME r =>
-                      output(std_out,
-                         "result = " ^ (makestring r) ^ "\n")
-                   | NONE => ()
-           in if CalcParser.sameToken(nextToken,dummyEOF) then ()
-              else loop lexer
-           end
+                      TextIO.output(TextIO.stdOut,
+                             "result = " ^ (Int.toString r) ^ "\n")
+                   | NONE => ();
+                if CalcParser.sameToken(nextToken,dummyEOF) then ()
+                else loop lexer
+            end
      in loop lexer
-     end
+    end
 \end{verbatim}
+\end{quote}
 
 \section{Signatures}
 
@@ -1177,272 +1155,277 @@
 
 \subsection{Parsing structure signatures}
 
-\begin{tt}
+\begin{quote}
 \begin{verbatim}
 (* STREAM: signature for a lazy stream.*)
 
 signature STREAM =
- sig type 'a stream
-     val streamify : (unit -> '_a) -> '_a stream
-     val cons : '_a * '_a stream -> '_a stream
-     val get : '_a stream -> '_a * '_a stream
- end
+sig
+  type 'a stream
+  val streamify : (unit -> 'a) -> 'a stream
+  val cons : 'a * 'a stream -> 'a stream
+  val get : 'a stream -> 'a * 'a stream
+end
 
 (* LR_TABLE: signature for an LR Table.*)
 
 signature LR_TABLE =
- sig
-   datatype ('a,'b) pairlist = EMPTY
-                             | PAIR of 'a * 'b * ('a,'b) pairlist
-   datatype state = STATE of int
-   datatype term = T of int
-   datatype nonterm = NT of int
-   datatype action = SHIFT of state
-                   | REDUCE of int
-                   | ACCEPT
-                   | ERROR
-   type table
-	
-   val numStates : table -> int
-   val numRules : table -> int
-   val describeActions : table -> state ->
-                     (term,action) pairlist * action
-   val describeGoto : table -> state -> (nonterm,state) pairlist
-   val action : table -> state * term -> action
-   val goto : table -> state * nonterm -> state
-   val initialState : table -> state
-   exception Goto of state * nonterm
+sig
+  datatype ('a,'b) pairlist
+    = EMPTY
+    | PAIR of 'a * 'b * ('a,'b) pairlist
+  datatype state = STATE of int
+  datatype term = T of int
+  datatype nonterm = NT of int
+  datatype action = SHIFT of state
+                  | REDUCE of int
+                  | ACCEPT
+                  | ERROR
+  type table
+        
+  val numStates : table -> int
+  val numRules : table -> int
+  val describeActions : table -> state ->
+                          (term,action) pairlist * action
+  val describeGoto : table -> state ->
+                       (nonterm,state) pairlist
+  val action : table -> state * term -> action
+  val goto : table -> state * nonterm -> state
+  val initialState : table -> state
+  exception Goto of state * nonterm
 
-   val mkLrTable :
-     {actions : ((term,action) pairlist * action) array,
-      gotos : (nonterm,state) pairlist array,
-      numStates : int, numRules : int,
-      initialState : state} -> table
- end
+  val mkLrTable :
+      {actions : ((term,action) pairlist * action) array,
+       gotos : (nonterm,state) pairlist array,
+       numStates : int, numRules : int,
+       initialState : state} -> table
+end
 
 (* TOKEN: signature for the internal structure of a token.*)
 
 signature TOKEN =
- sig
-   structure LrTable : LR_TABLE
-   datatype ('a,'b) token = TOKEN of LrTable.term *
-                                     ('a * 'b * 'b)
-   val sameToken : ('a,'b) token * ('a,'b) token -> bool
- end
+sig
+  structure LrTable : LR_TABLE
+  datatype ('a,'b) token = TOKEN of LrTable.term *
+                                    ('a * 'b * 'b)
+  val sameToken : ('a,'b) token * ('a,'b) token -> bool
+end
 
 (* LR_PARSER: signature for a polymorphic LR parser *)
 
 signature LR_PARSER =
-    sig
-      structure Stream: STREAM
-      structure LrTable : LR_TABLE
-      structure Token : TOKEN
+sig
+  structure Stream: STREAM
+  structure LrTable : LR_TABLE
+  structure Token : TOKEN
 
-      sharing LrTable = Token.LrTable
+  sharing LrTable = Token.LrTable
 
-      exception ParseError
+  exception ParseError
 
-      val parse:
+  val parse:
        {table : LrTable.table,
-        lexer : ('_b,'_c) Token.token Stream.stream,
+        lexer : ('b,'c) Token.token Stream.stream,
         arg: 'arg,
         saction : int *
-                 '_c *
-                 (LrTable.state * ('_b * '_c * '_c)) list * 
+                 'c *
+                 (LrTable.state * ('b * 'c * 'c)) list * 
                  'arg ->
                   LrTable.nonterm *
-                  ('_b * '_c * '_c) *
-                  ((LrTable.state *('_b * '_c * '_c)) list),
-        void : '_b,
-        ec : {is_keyword : LrTable.term -> bool,
-              noShift : LrTable.term -> bool,
-              preferred_subst:LrTable.term -> LrTable.term list,
-              preferred_insert : LrTable.term -> bool,
-              errtermvalue : LrTable.term -> '_b,
-              showTerminal : LrTable.term -> string,
-              terms: LrTable.term list,
-              error : string * '_c * '_c -> unit
-              },
-        lookahead : int  (* max amount of lookahead used in *)
-                         (* error correction *)
-       } -> '_b * (('_b,'_c) Token.token Stream.stream)
-  end
+                  ('b * 'c * 'c) *
+                  ((LrTable.state *('b * 'c * 'c)) list),
+        void : 'b,
+        ec: {is_keyword : LrTable.term -> bool,
+             noShift : LrTable.term -> bool,
+             preferred_subst:LrTable.term -> LrTable.term list,
+             preferred_insert : LrTable.term -> bool,
+             errtermvalue : LrTable.term -> 'b,
+             showTerminal : LrTable.term -> string,
+             terms: LrTable.term list,
+             error : string * 'c * 'c -> unit
+            },
+        lookahead : int (* max amount of lookahead used in
+                         * error correction *)
+       } -> 'b * (('b,'c) Token.token Stream.stream)
+end
 \end{verbatim}
-\end{tt}
+\end{quote}
 
 \subsection{Lexers}
 
 Lexers for use with ML-Yacc's output must match one of these signatures.
 
-\begin{tt}
+\begin{quote}
 \begin{verbatim}
 signature LEXER =
-   sig
-       structure UserDeclarations :
-           sig
-                type ('a,'b) token
-                type pos
-                type svalue
-           end
-        val makeLexer : (int -> string) -> unit -> 
-          (UserDeclarations.svalue,
-           UserDeclarations.pos) UserDeclarations.token
-   end
+sig
+  structure UserDeclarations :
+    sig
+      type ('a,'b) token
+      type pos
+      type svalue
+    end
+  val makeLexer : (int -> string) -> unit -> 
+       (UserDeclarations.svalue, UserDeclarations.pos)
+       UserDeclarations.token
+end
 
-(* ARG_LEXER: the %arg option of ML-Lex allows users to produce
-   lexers which also take an argument before yielding a function
-   from unit to a token.
+(* ARG_LEXER: the %arg option of ML-Lex allows users to
+   produce lexers which also take an argument before
+   yielding a function from unit to a token.
 *)
 
 signature ARG_LEXER =
-  sig
-    structure UserDeclarations :
-      sig
-        type ('a,'b) token
-        type pos
-        type svalue
-        type arg
-      end
-     val makeLexer : (int -> string) -> UserDeclarations.arg ->
-          unit -> 
-            (UserDeclarations.svalue,
-             UserDeclarations.pos) UserDeclarations.token
-   end
+sig
+  structure UserDeclarations :
+    sig
+      type ('a,'b) token
+      type pos
+      type svalue
+      type arg
+    end
+  val makeLexer :
+      (int -> string) ->
+      UserDeclarations.arg ->
+      unit -> 
+       (UserDeclarations.svalue, UserDeclarations.pos)
+       UserDeclarations.token
+end
 \end{verbatim}
-\end{tt}
+\end{quote}
 
 \subsection{Signatures for the functor produced by ML-Yacc}
 
 The following signature is used in signatures generated by
 ML-Yacc:
-\begin{tt}
+\begin{quote}
 \begin{verbatim}
 (* PARSER_DATA: the signature of ParserData structures in
-   {n}LrValsFun functor produced by ML-Yacc. All such structures
-   match this signature.*)
+   {n}LrValsFun functor produced by ML-Yacc. All such
+   structures match this signature. *)
 
 signature PARSER_DATA =
-   sig
-        type pos       (* the type of line numbers *)
-        type svalue    (* the type of semantic values *)
-        type arg       (* the type of the user-supplied *)
-                       (* argument to the parser *)
-        type result
+sig
+  type pos       (* the type of line numbers *)
+  type svalue    (* the type of semantic values *)
+  type arg       (* the type of the user-supplied *)
+                 (* argument to the parser *)
+  type result
 
-        structure LrTable : LR_TABLE
-        structure Token : TOKEN
-        sharing Token.LrTable = LrTable
+  structure LrTable : LR_TABLE
+  structure Token : TOKEN
+  sharing Token.LrTable = LrTable
 
-        structure Actions : 
-          sig
-            val actions : int * pos *
-             (LrTable.state * (svalue * pos * pos)) list * arg ->
-                     LrTable.nonterm * (svalue * pos * pos) *
-                   ((LrTable.state *(svalue * pos * pos)) list)
-            val void : svalue
-            val extract : svalue -> result
-          end
+  structure Actions : 
+    sig
+      val actions : int * pos *
+       (LrTable.state * (svalue * pos * pos)) list * arg ->
+               LrTable.nonterm * (svalue * pos * pos) *
+             ((LrTable.state *(svalue * pos * pos)) list)
+      val void : svalue
+      val extract : svalue -> result
+    end
 
-        (* structure EC contains information used to improve
-           error recovery in an error-correcting parser *)
+  (* structure EC contains information used to improve
+     error recovery in an error-correcting parser *)
 
-        structure EC :
-          sig
-           val is_keyword : LrTable.term -> bool
-           val noShift : LrTable.term -> bool
-           val preferred_subst: LrTable.term -> LrTable.term list
-           val preferred_insert : LrTable.term -> bool
-           val errtermvalue : LrTable.term -> svalue
-           val showTerminal : LrTable.term -> string
-           val terms: LrTable.term list
-          end
+  structure EC :
+    sig
+      val is_keyword : LrTable.term -> bool
+      val noShift : LrTable.term -> bool
+      val preferred_subst: LrTable.term -> LrTable.term list
+      val preferred_insert : LrTable.term -> bool
+      val errtermvalue : LrTable.term -> svalue
+      val showTerminal : LrTable.term -> string
+      val terms: LrTable.term list
+    end
 
-        (* table is the LR table for the parser *)
+  (* table is the LR table for the parser *)
 
-        val table : LrTable.table
-    end
+  val table : LrTable.table
+end
 \end{verbatim}
-\end{tt}
+\end{quote}
 
 ML-Yacc generates these two signatures:
-\begin{tt}
+\begin{quote}
 \begin{verbatim}
 (* printed out in .sig file created by parser generator: *)
 
 signature {n}_TOKENS = 
-  sig
-      type ('a,'b) token
-      type svalue
-      ...
-  end
+sig
+  type ('a,'b) token
+  type svalue
+  ...
+end
 
 signature {n}_LRVALS =
-  sig
-     structure Tokens : {n}_TOKENS
-     structure ParserData : PARSER_DATA
-     sharing type ParserData.Token.token = Tokens.token
-     sharing type ParserData.svalue = Tokens.svalue
-  end
+sig
+  structure Tokens : {n}_TOKENS
+  structure ParserData : PARSER_DATA
+  sharing type ParserData.Token.token = Tokens.token
+  sharing type ParserData.svalue = Tokens.svalue
+end
 \end{verbatim}
-\end{tt}
+\end{quote}
 \subsection{User parser signatures}
 
 Parsers created by applying the Join functor will match this signature:
-\begin{tt}
+\begin{quote}
 \begin{verbatim}
 signature PARSER =
-    sig
-        structure Token : TOKEN
-        structure Stream : STREAM
-        exception ParseError
+sig
+  structure Token : TOKEN
+  structure Stream : STREAM
+  exception ParseError
 
-        type pos    (* pos is the type of line numbers *)
-        type result (* value returned by the parser *)
-        type arg    (* type of the user-supplied argument  *)
-        type svalue (* the types of semantic values *)
+  type pos    (* pos is the type of line numbers *)
+  type result (* value returned by the parser *)
+  type arg    (* type of the user-supplied argument  *)
+  type svalue (* the types of semantic values *)
 
-        val makeLexer : (int -> string) ->
-                         (svalue,pos) Token.token Stream.stream
+  val makeLexer : (int -> string) ->
+                   (svalue,pos) Token.token Stream.stream
 
-        val parse :
-            int * ((svalue,pos) Token.token Stream.stream) *
-            (string * pos * pos -> unit) * arg ->
-                result * (svalue,pos) Token.token Stream.stream
-        val sameToken :
-          (svalue,pos) Token.token * (svalue,pos) Token.token ->
-              bool
-     end
+  val parse :
+      int * ((svalue,pos) Token.token Stream.stream) *
+      (string * pos * pos -> unit) * arg ->
+          result * (svalue,pos) Token.token Stream.stream
+  val sameToken :
+    (svalue,pos) Token.token * (svalue,pos) Token.token ->
+        bool
+end
 \end{verbatim}
-\end{tt}
+\end{quote}
 Parsers created by applying the JoinWithArg functor will match this
 signature:
-\begin{tt}
+\begin{quote}
 \begin{verbatim}
 signature ARG_PARSER = 
-  sig
-    structure Token : TOKEN
-    structure Stream : STREAM
-    exception ParseError
+sig
+  structure Token : TOKEN
+  structure Stream : STREAM
+  exception ParseError
 
-    type arg
-    type lexarg
-    type pos
-    type result
-    type svalue
+  type arg
+  type lexarg
+  type pos
+  type result
+  type svalue
 
-    val makeLexer : (int -> string) -> lexarg ->
-                       (svalue,pos) Token.token Stream.stream
-    val parse : int *
-                ((svalue,pos) Token.token Stream.stream) *
-                (string * pos * pos -> unit) *
-                arg ->
-                 result * (svalue,pos) Token.token Stream.stream
-    val sameToken :
-        (svalue,pos) Token.token * (svalue,pos) Token.token ->
-             bool
-  end
+  val makeLexer : (int -> string) -> lexarg ->
+                     (svalue,pos) Token.token Stream.stream
+  val parse : int *
+              ((svalue,pos) Token.token Stream.stream) *
+              (string * pos * pos -> unit) *
+              arg ->
+               result * (svalue,pos) Token.token Stream.stream
+  val sameToken :
+      (svalue,pos) Token.token * (svalue,pos) Token.token ->
+           bool
+end
 \end{verbatim}
-\end{tt}
+\end{quote}
 
 \section{Sharing constraints}
 
@@ -1450,7 +1433,7 @@
 you have not created a lexer which takes an argument, and
 you have followed the directions given earlier for creating the parser, you
 will have the following structures with the following signatures:
-\begin{tt}
+\begin{quote}
 \begin{verbatim}
 (* always present *)
 
@@ -1472,10 +1455,10 @@
 structure Lex : LEXER
 structure {n}Parser : PARSER
 \end{verbatim}
-\end{tt}
+\end{quote}
 
 The following sharing constraints will exist:
-\begin{tt}
+\begin{quote}
 \begin{verbatim}
 sharing {n}Parser.Token = LrParser.Token =
           {n}LrVals.ParserData.Token
@@ -1495,11 +1478,11 @@
 sharing {n}LrVals.LrTable = LrParser.LrTable
         
 \end{verbatim}
-\end{tt}
+\end{quote}
 
 If you used a lexer which takes an argument, then you will
 have:
-\begin{tt}
+\begin{quote}
 \begin{verbatim}
 structure ARG_LEXER
 structure {n}Parser : PARSER
@@ -1508,7 +1491,7 @@
 
 sharing type {n}Parser.lexarg = Lex.UserDeclarations.arg
 \end{verbatim}
-\end{tt}
+\end{quote}
 
 \section{Hints}
 \subsection{Multiple start symbols}
@@ -1522,7 +1505,7 @@
 Assuming that you have followed the naming conventions used before,
 create the lexer using the makeLexer function in the \{n\}Parser structure.
 Then, place the dummy token on the front of the lexer:
-\begin{tt}
+\begin{quote}
 \begin{verbatim}
 val dummyLexer =
     {n}Parser.Stream.cons
@@ -1530,14 +1513,14 @@
                  ({dummy lineno},{dummy lineno}),
         lexer)
 \end{verbatim}
-\end{tt}
-   You have to pass a Tokens structure to the lexer.  This Tokens structure
+\end{quote}
+You have to pass a Tokens structure to the lexer.  This Tokens structure
 contains functions which construct tokens from values and line numbers.
 So to create your dummy token just apply the appropriate token constructor
 function from this Tokens structure to a value (if there is one) and the
 line numbers.   This is exactly what you do in the lexer to construct tokens.
 
-   Then you must place the dummy token on the front of your lex stream.
+Then you must place the dummy token on the front of your lex stream.
 The structure \{n\}Parser contains a structure Stream which implements
 lazy streams.  So you just cons the dummy token on to stream returned
 by makeLexer.
@@ -1562,7 +1545,7 @@
 
 If you wish to encapsulate the code necessary to invoke the
 parser, your functor generally will have form:
-\begin{tt}
+\begin{quote}
 \begin{verbatim}
 functor Encapsulate(
      structure Parser : PARSER
@@ -1577,7 +1560,7 @@
         ...
   end
 \end{verbatim}
-\end{tt}
+\end{quote}
 
 The signature INTERFACE, defined below, is a possible signature for
 a structure
@@ -1587,21 +1570,21 @@
 because
 these types will be abstract types inside the body of your
 functor.
-\begin{tt}
+\begin{quote}
 \begin{verbatim}
 signature INTERFACE = 
-  sig
-     type pos
-     val line : pos ref
-     val reset : unit -> unit
-     val next : unit -> unit
-     val error : string * pos * pos -> unit
+sig
+   type pos
+   val line : pos ref
+   val reset : unit -> unit
+   val next : unit -> unit
+   val error : string * pos * pos -> unit
 
-     type arg
-     val nothing : arg
-  end
+   type arg
+   val nothing : arg
+end
 \end{verbatim}
-\end{tt}
+\end{quote}
 
 The directory example/fol contains a sample parser in which
 the code for tying together the lexer and parser has been

Modified: mlton/branches/on-20050420-cmm-branch/mlyacc/doc/tech.doc
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlyacc/doc/tech.doc	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlyacc/doc/tech.doc	2006-02-16 19:34:54 UTC (rev 4361)
@@ -38,18 +38,18 @@
 The LR(0) graph consists of sets of items.  Each set of items will be
 called a core set.  The basic algorithm is:
 
-	let fun add_gotos(graph,f,nil,r) = (graph,r)
-	      | add_gotos(graph,f,(a,symbol)::b,r)
-			let newgraph = graph + edge from f to a labelled
-			    with symbol
-			in if a exists in graph then
-				add_gotos(newgraph,f,b,r)
-			   else add_gotos(newgraph,f,b,a::r)
-			end
-	     fun f(graph,nil) = graph
-	       | f(graph,a::b) = f(add_gotos(graph,a,gotos of closure a,b))
-	in f(empty-graph,[initial core set])
-	end
+        let fun add_gotos(graph,f,nil,r) = (graph,r)
+              | add_gotos(graph,f,(a,symbol)::b,r)
+                        let newgraph = graph + edge from f to a labelled
+                            with symbol
+                        in if a exists in graph then
+                                add_gotos(newgraph,f,b,r)
+                           else add_gotos(newgraph,f,b,a::r)
+                        end
+             fun f(graph,nil) = graph
+               | f(graph,a::b) = f(add_gotos(graph,a,gotos of closure a,b))
+        in f(empty-graph,[initial core set])
+        end
 
 For each core, we compute the new cores which result from doing a shift
 or goto, and then add these new cores with the symbol used in the shift
@@ -61,9 +61,9 @@
 is in a core, the all productions derived by B must also be in the core.
 
 We want to be able to do the following operations efficently:
-	(1) check if a core is in the graph already
-	(2) compute the closure of a core
-	(3) compute the cores resulting from goto/shift operations.
+        (1) check if a core is in the graph already
+        (2) compute the closure of a core
+        (3) compute the cores resulting from goto/shift operations.
 
 (1) This can be done efficiently if a complete order exists for the cores. This
 can be done by imposing an ordering on items, giving each item a unique
@@ -96,44 +96,44 @@
 
 Lookaheads are attached to an item when
 
-	(1) an item is the result of a shift/goto.  The item
-	    must have the same lookahead as the item from which it
-	    is derived.
-	(2) an item is added as the result of a closure.  Note that
-	    in fact all productions derived from a given nonterminal
-	    are added here.  This can be used (perhaps) to our
-	    advantage, as we can represent a closure using just the
-	    nonterminal.
+        (1) an item is the result of a shift/goto.  The item
+            must have the same lookahead as the item from which it
+            is derived.
+        (2) an item is added as the result of a closure.  Note that
+            in fact all productions derived from a given nonterminal
+            are added here.  This can be used (perhaps) to our
+            advantage, as we can represent a closure using just the
+            nonterminal.
 
-    	    This can be divided into two cases:
+            This can be divided into two cases:
 
-		(a) A -> 'a .B 'c , where 'c derives epsilon,
-		(b) A -> 'a .B 'c , where 'c does not derive epsilon
+                (a) A -> 'a .B 'c , where 'c derives epsilon,
+                (b) A -> 'a .B 'c , where 'c does not derive epsilon
 
-	    In (a), lookahead(items derived from B) includes first('c)
-	    and lookahead(A -> 'a .B 'c)
-	
-	    In (b), lookahead(items derived from B) includes only first('c).
+            In (a), lookahead(items derived from B) includes first('c)
+            and lookahead(A -> 'a .B 'c)
+        
+            In (b), lookahead(items derived from B) includes only first('c).
 
-	    This is an example of back propagation. 
-	
-	Note that an item is either the result of a closure or the
-	result of a shift/goto.  It is never the result of both (that
-	would be a contradiction).
+            This is an example of back propagation. 
+        
+        Note that an item is either the result of a closure or the
+        result of a shift/goto.  It is never the result of both (that
+        would be a contradiction).
 
-	The following representation will be used:
-	
-	  goto/shift items:
-		an ordered list of item * lookahead ref *
-				          lookahead ref for the resulting
-					  shift/goto item in another core.
+        The following representation will be used:
+        
+          goto/shift items:
+                an ordered list of item * lookahead ref *
+                                          lookahead ref for the resulting
+                                          shift/goto item in another core.
 
-   	  closure items:
-		for each nonterminal:
-		   (1) lookahead ref
-		   (2) a list of item * lookahead ref for the
-					resulting shift/goto item in another
-				        core.
+          closure items:
+                for each nonterminal:
+                   (1) lookahead ref
+                   (2) a list of item * lookahead ref for the
+                                        resulting shift/goto item in another
+                                        core.
 
 Lookahead algorithms
 --------------------
@@ -172,18 +172,18 @@
 
 Consider the following productions
 
-		B -> S ;
-		S -> E
-		E -> F * E
-		F -> num
+                B -> S ;
+                S -> E
+                E -> F * E
+                F -> num
 
 in a kernal with the item
 
-		B -> .S
+                B -> .S
 
 The following derivations are possible:
 
-B -> .S   =c=>   S -> .E	=c+=>   S -> .E, E -> .F * E, F -> .num
+B -> .S   =c=>   S -> .E        =c+=>   S -> .E, E -> .F * E, F -> .num
 
 The nonterminals that are added through the closure operation
 are the nonterminals for some item j = A -> .B x such that j =c+=> .C y.
@@ -193,31 +193,31 @@
 
 The following algorithm computes the information for each nonterminal:
 
-	(1) nonterminals  such that c =c+=> .C y and y =*=> epsilon
+        (1) nonterminals  such that c =c+=> .C y and y =*=> epsilon
 
-	Let s = the set of nonterminals added through closure = B
-	
-	repeat
-		for all B which are elements of s,
-			if B -> .C z and z =*=> epsilon then
-			add B to s.
-	until s does not change.
+        Let s = the set of nonterminals added through closure = B
+        
+        repeat
+                for all B which are elements of s,
+                        if B -> .C z and z =*=> epsilon then
+                        add B to s.
+        until s does not change.
 
-	(2) nonterminals added through closure and their lookaheads
+        (2) nonterminals added through closure and their lookaheads
 
-	Let s = the set of nonterminals added through closure = B
-	where A -> x . B y
+        Let s = the set of nonterminals added through closure = B
+        where A -> x . B y
 
-	repeat
-		for all B which are elements of s,
-			if B -> .C z then add C to s, and
-		        add first(z) to lookahead(C)
-	until nothing changes.
+        repeat
+                for all B which are elements of s,
+                        if B -> .C z then add C to s, and
+                        add first(z) to lookahead(C)
+        until nothing changes.
 
-	Now, for each nonterminal A in s, find the set of nonterminals
-	such that A =c+=> .B z, and z =*=> epsilon (i.e. use the results
-	from 1).  Add the lookahead for nonterminal A to the lookahead
-	for each nonterminal in this set.
+        Now, for each nonterminal A in s, find the set of nonterminals
+        such that A =c+=> .B z, and z =*=> epsilon (i.e. use the results
+        from 1).  Add the lookahead for nonterminal A to the lookahead
+        for each nonterminal in this set.
 
 These algorithms can be restated as either breadth-first or depth-first search
 algorithms.   The loop invariant of the algorithms is that whenever a 
@@ -227,25 +227,25 @@
 This algorithm computes the lookahead for each item:
 
   for each state,
-	for each item of the form A -> u .B v in the state, where u may be
-	nullable,
-	   let	first_v = first(v)
-		l-ref  = ref for A -> u .B v
-		s = the set of nonterminals added through the closure of B.
+        for each item of the form A -> u .B v in the state, where u may be
+        nullable,
+           let  first_v = first(v)
+                l-ref  = ref for A -> u .B v
+                s = the set of nonterminals added through the closure of B.
 
-		for each element X of s,
+                for each element X of s,
 
-		  let r = the rules produced by an element X of s
-		      l = the lookahead ref cells for each rule, i.e.
-			  all items of A -> x. or A -> x .B y, where
-			  y =*=> epsilon, and x is not epsilon
+                  let r = the rules produced by an element X of s
+                      l = the lookahead ref cells for each rule, i.e.
+                          all items of A -> x. or A -> x .B y, where
+                          y =*=> epsilon, and x is not epsilon
 
-		      add the lookahead we have computed for X to the 
-		      elements of l
+                      add the lookahead we have computed for X to the 
+                      elements of l
 
-		      if B =c+=> X z, where z is nullable, add first(y) to
-		      the l.  If y =*=> epsilon, save l with the ref for
-		      A -> x .B y in a list.
+                      if B =c+=> X z, where z is nullable, add first(y) to
+                      the l.  If y =*=> epsilon, save l with the ref for
+                      A -> x .B y in a list.
 
  Now take the list of (lookahead ref, list of lookahead refs) and propagate
  each lookahead ref cell's contents to the elements of the list of lookahead

Modified: mlton/branches/on-20050420-cmm-branch/mlyacc/examples/calc/README
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlyacc/examples/calc/README	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlyacc/examples/calc/README	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,21 +1,46 @@
 This is a sample interactive calculator built using ML-Yacc and ML-Lex.
 
+The calculator is defined by the files
+
+  calc.lex       (* defines lexer *)
+  calc.grm       (* defines grammar *)
+  calc.sml       (* defines driver function, Calc.parse *)
+  sources.cm     (* cm description file *)
+
 To compile this example, type
 
-	- CM.make();
+        - CM.make "sources.cm";
 
-in this directory.
+in this directory.  CM will invoke ml-lex and ml-yacc to process the
+lexer specification calc.lex and the grammar specification calc.grm
+respectively.  Then it will compile the resulting SML source files
 
+  calc.lex.sml
+  calc.grm.sig
+  calc.grm.sml
+
+and the calc.sml file containing the driver code.
+
 The end result of loading these files is a structure Calc containing a
-function named parse.  The calculator can be invoked by applying that
-function to a value of type unit.  The calculator reads from the
-standard input.  There is no attempt to fix input errors since this
-is an interactive parser.
+top-level driver function named parse.  
 
+  Calc.parse : unit -> unit
+
+The calculator can be invoked by applying Calc.parse to the unit value.
+
+  - Calc.parse();
+  1+3;
+  result = 4
+
 The calculator reads a sequence of expressions from the standard input
 and prints the value of each expression after reading the expression.
 Expressions must be separated by semicolons.  An expression is not
 evaluated until the semicolon is encountered.  The calculator
-terminates when an end-of-file is encountered.
+terminates when an end-of-file is encountered. There is no attempt to
+fix input errors: a lexical error will cause exception LexError to be
+raised, while a syntax error will cause ParseError to be raised.
 
-
+NOTE: The CM description file sources.cm mentions the ml-yacc library
+(ml-yacc-lib.cm). CM's search path should be configured so that this
+library will be found.  This should normally be the case if SML/NJ is
+properly installed.

Modified: mlton/branches/on-20050420-cmm-branch/mlyacc/examples/calc/calc.lex
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlyacc/examples/calc/calc.lex	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlyacc/examples/calc/calc.lex	2006-02-16 19:34:54 UTC (rev 4361)
@@ -8,7 +8,7 @@
 val pos = ref 0
 fun eof () = Tokens.EOF(!pos,!pos)
 fun error (e,l : int,_) = TextIO.output (TextIO.stdOut, String.concat[
-	"line ", (Int.toString l), ": ", e, "\n"
+        "line ", (Int.toString l), ": ", e, "\n"
       ])
 
 %%

Copied: mlton/branches/on-20050420-cmm-branch/mlyacc/examples/calc/calc.sml (from rev 4358, mlton/trunk/mlyacc/examples/calc/calc.sml)

Modified: mlton/branches/on-20050420-cmm-branch/mlyacc/examples/calc/sources.cm
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlyacc/examples/calc/sources.cm	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlyacc/examples/calc/sources.cm	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,6 +1,13 @@
 Group is
 
+#if defined (NEW_CM)
+  $/basis.cm
+  $/ml-yacc-lib.cm
+#else
   ml-yacc-lib.cm
+#endif
+
   calc.grm
   calc.lex
+  calc.sml
 

Modified: mlton/branches/on-20050420-cmm-branch/mlyacc/examples/fol/README
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlyacc/examples/fol/README	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlyacc/examples/fol/README	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,15 +1,55 @@
+fol/README
+
 This is a sample parser for first-order logic.   The grammar
 was contributed by Frank Pfenning.
 
-To construct the parser, first use ML-Yacc on the file "fol.grm" to construct
-the files "fol.grm.sig" and "fol.grm.sml".  This can be done by loading
-ML-Yacc and typing ``ParseGen.parseGen "fol.grm"''.  Then construct the
-lexer by using ML_Lex on the file fol.lex (``LexGen.lexGen "fol.lex"'').
+The parser is defined by the files
 
-Finally, load the background file "base.sml".  Then use "load.sml" to
-load all the files.  The end result is a structure Parser with four
-functions.   The function parse_prog will parse a program in a string.
-Then function parse_query will parse a query in a string.  The function
-parse_file will parse a program in a file.  The function top_parse will
-parse a query from the standard input.
+  fol.lex       (* defines lexer *)
+  fol.grm       (* defines grammar *)
+  link.sml      (* constructs basic parser structures *)
+  absyn.sml     (* a trivial abstract syntax *)
+  interface.sml (* interface to lexer and parser properties *)
+  parse.sml     (* driver functions *)
+  sources.cm    (* cm description file *)
 
+To compile this example, type
+
+        - CM.make "sources.cm";
+
+in this directory.  CM will invoke ml-lex and ml-yacc to process the
+lexer specification calc.lex and the grammar specification calc.grm
+respectively.  Then it will compile the resulting SML source files
+
+  fol.lex.sml
+  fol.grm.sig
+  fol.grm.sml
+
+and the other sml source files.
+
+The end result of loading these files is a structure Parse containing
+the following top-level driver functions:
+
+  val prog_parse : string -> Absyn.absyn 
+   (* parse a program from a string *)
+
+  val query_parse : string -> Absyn.absyn
+   (* parse a query from a string *)
+
+  val file_parse : string -> Absyn.absyn
+   (* parse a program in a file *)
+
+  val top_parse : unit -> Absyn.absyn
+   (* parse a query from the standard input *)
+
+
+The file list.fol is a sample input file that can be parsed using
+the file_parse function:
+
+  - Parse.file_parse "list.fol";
+
+
+NOTE: The CM description file sources.cm mentions the ml-yacc library
+(ml-yacc-lib.cm). CM's search path should be configured so that this
+library will be found.  This should normally be the case if SML/NJ is
+properly installed.

Modified: mlton/branches/on-20050420-cmm-branch/mlyacc/examples/fol/absyn.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlyacc/examples/fol/absyn.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlyacc/examples/fol/absyn.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -4,7 +4,7 @@
      val null : absyn
   end
 
-abstraction Absyn : ABSYN =
+structure Absyn :> ABSYN =
    struct
       datatype absyn = NULL
       val null = NULL

Modified: mlton/branches/on-20050420-cmm-branch/mlyacc/examples/fol/fol.grm
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlyacc/examples/fol/fol.grm	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlyacc/examples/fol/fol.grm	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,6 +1,6 @@
 %%
 %header (functor FolLrValsFun (structure Token : TOKEN
-			       structure Absyn : ABSYN ) : Fol_LRVALS)
+                               structure Absyn : ABSYN ) : Fol_LRVALS)
 
 %term
     EOF | DOT | COMMA | SEMICOLON
@@ -41,42 +41,42 @@
 start : PARSEPROG clause (Absyn.null)
       | PARSEQUERY query (Absyn.null)
 
-clause : dform 			()
-       |			()
+clause : dform                  ()
+       |                        ()
 
-query : gform			()
-      |				()
+query : gform                   ()
+      |                         ()
 
-gform : TRUE			()
-      | gform COMMA gform	()      (* and *)
+gform : TRUE                    ()
+      | gform COMMA gform       ()      (* and *)
       | gform SEMICOLON gform   ()      (* disjunction *)
       | gform BACKARROW dform   ()      (* implication: dform implies gform *)
       | gform ARROW gform BAR gform ()  (* if-then-else *)
-      | FORALL varbd gform	()	(* universal quantification *)
-      | EXISTS varbd gform	()      (* existential quantification *)
-      | atom			()	(* atomic formula *)
+      | FORALL varbd gform      ()      (* universal quantification *)
+      | EXISTS varbd gform      ()      (* existential quantification *)
+      | atom                    ()      (* atomic formula *)
       | LPAREN gform RPAREN     ()      
 
-dform : TRUE		        ()
-      | dform COMMA dform	()      (* and *)
-      | dform BACKARROW gform   ()	(* gform implies dform *)
-      | FORALL varbd dform	()
-      | atom			()
-      | LPAREN dform RPAREN	()
+dform : TRUE                    ()
+      | dform COMMA dform       ()      (* and *)
+      | dform BACKARROW gform   ()      (* gform implies dform *)
+      | FORALL varbd dform      ()
+      | atom                    ()
+      | LPAREN dform RPAREN     ()
 
-atom : LCID			()
+atom : LCID                     ()
      | LCID LPAREN termlist RPAREN  ()
 
-termlist : term		()
-	 | term COMMA termlist  ()
+termlist : term         ()
+         | term COMMA termlist  ()
 
-term : id		()
-     | INT		()
+term : id               ()
+     | INT              ()
      | LCID LPAREN termlist RPAREN ()
 
-varbd : LCID DOT	()
-      | UCID DOT	()
+varbd : LCID DOT        ()
+      | UCID DOT        ()
 
-id : LCID		()
-   | UCID		()
+id : LCID               ()
+   | UCID               ()
 

Modified: mlton/branches/on-20050420-cmm-branch/mlyacc/examples/fol/fol.lex
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlyacc/examples/fol/fol.lex	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlyacc/examples/fol/fol.lex	2006-02-16 19:34:54 UTC (rev 4361)
@@ -12,7 +12,7 @@
 
 %%
 %header (functor FolLexFun(structure Tokens: Fol_TOKENS
-			   structure Interface: INTERFACE) : LEXER);
+                           structure Interface: INTERFACE) : LEXER);
 lcstart=[a-z!&$+/<=>?@~|#*`]|\-;
 ucstart=[A-Z_];
 idchars={lcstart}|{ucstart}|[0-9];
@@ -21,22 +21,22 @@
 ws=[\t\ ]*;
 num=[0-9]+;
 %%
-<INITIAL>{ws}	=> (lex());
-<INITIAL>\n	=> (next_line(); lex());
-<INITIAL>":-"	=> (Tokens.BACKARROW(!line,!line));
-<INITIAL>","	=> (Tokens.COMMA(!line,!line));
-<INITIAL>";"	=> (Tokens.SEMICOLON(!line,!line));
+<INITIAL>{ws}   => (lex());
+<INITIAL>\n     => (next_line(); lex());
+<INITIAL>":-"   => (Tokens.BACKARROW(!line,!line));
+<INITIAL>","    => (Tokens.COMMA(!line,!line));
+<INITIAL>";"    => (Tokens.SEMICOLON(!line,!line));
 <INITIAL>"."    => (Tokens.DOT(!line,!line));
-<INITIAL>"("	=> (Tokens.LPAREN(!line,!line));
-<INITIAL>")"	=> (Tokens.RPAREN(!line,!line));
-<INITIAL>"->"	=> (Tokens.ARROW(!line,!line));
-<INITIAL>"=>"	=> (Tokens.DOUBLEARROW(!line,!line));
-<INITIAL>"|"	=> (Tokens.BAR(!line,!line));
+<INITIAL>"("    => (Tokens.LPAREN(!line,!line));
+<INITIAL>")"    => (Tokens.RPAREN(!line,!line));
+<INITIAL>"->"   => (Tokens.ARROW(!line,!line));
+<INITIAL>"=>"   => (Tokens.DOUBLEARROW(!line,!line));
+<INITIAL>"|"    => (Tokens.BAR(!line,!line));
 <INITIAL>"true" => (Tokens.TRUE(!line,!line));
 <INITIAL>"forall" => (Tokens.FORALL(!line,!line));
 <INITIAL>"exists" => (Tokens.EXISTS(!line,!line));
 <INITIAL>{lcid} => (Tokens.LCID (yytext,!line,!line));
 <INITIAL>{ucid} => (Tokens.UCID (yytext,!line,!line));
-<INITIAL>{num}	=> (Tokens.INT (makeInt yytext,!line,!line));
-<INITIAL>.	=> (error ("ignoring illegal character" ^ yytext,
-			   !line,!line); lex());
+<INITIAL>{num}  => (Tokens.INT (makeInt yytext,!line,!line));
+<INITIAL>.      => (error ("ignoring illegal character" ^ yytext,
+                           !line,!line); lex());

Modified: mlton/branches/on-20050420-cmm-branch/mlyacc/examples/fol/interface.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlyacc/examples/fol/interface.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlyacc/examples/fol/interface.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,13 +1,4 @@
-(* Externally visible aspects of the lexer and parser 
- *
- * $Log: interface.sml,v $
- * Revision 1.1.1.1  1997/01/14 01:38:03  george
- *   Version 109.24
- *
- * Revision 1.1.1.1  1996/01/31  16:01:39  george
- * Version 109
- * 
- *)
+(* Externally visible aspects of the lexer and parser *)
 
 signature INTERFACE =
 sig
@@ -31,7 +22,7 @@
 fun init_line () = (line := 1)
 fun next_line () = (line := !line + 1)
 fun error (errmsg,line:pos,_) =
-  output(std_out,"Line " ^ (makestring line) ^ ": " ^ errmsg ^ "\n")
+  TextIO.output(TextIO.stdOut,"Line " ^ (Int.toString line) ^ ": " ^ errmsg ^ "\n")
 
 type arg = unit
 

Modified: mlton/branches/on-20050420-cmm-branch/mlyacc/examples/fol/link.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlyacc/examples/fol/link.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlyacc/examples/fol/link.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -10,10 +10,10 @@
 structure FolParser : PARSER =
    Join(structure ParserData = FolLrVals.ParserData
         structure Lex = FolLex
-	structure LrParser = LrParser);
+        structure LrParser = LrParser);
 
 structure Parse : PARSE =
    Parse (structure Absyn = Absyn
-	  structure Interface = Interface
-	  structure Parser = FolParser
-	  structure Tokens = FolLrVals.Tokens );
+          structure Interface = Interface
+          structure Parser = FolParser
+          structure Tokens = FolLrVals.Tokens );

Deleted: mlton/branches/on-20050420-cmm-branch/mlyacc/examples/fol/load.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlyacc/examples/fol/load.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlyacc/examples/fol/load.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,11 +0,0 @@
-use "absyn.sml";
-
-use "fol.grm.sig";
-use "fol.grm.sml";
-
-use "interface.sml";
-use "fol.lex.sml";
-
-use "parse.sml";
-use "link.sml";
-

Modified: mlton/branches/on-20050420-cmm-branch/mlyacc/examples/fol/parse.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlyacc/examples/fol/parse.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlyacc/examples/fol/parse.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,97 +1,79 @@
 (* Uses the generated lexer and parser to export parsing functions 
- *
- * $Log: parse.sml,v $
- * Revision 1.1.1.1  1997/01/14 01:38:03  george
- *   Version 109.24
- *
- * Revision 1.1.1.1  1996/01/31  16:01:39  george
- * Version 109
- * 
  *)
 
 signature PARSE =
 sig
 
-structure Absyn : ABSYN
+  structure Absyn : ABSYN
 
 (* parse a program from a string *)
 
-    val prog_parse : string -> Absyn.absyn 
+  val prog_parse : string -> Absyn.absyn 
 
 (* parse a query from a string *)
 
-    val query_parse : string -> Absyn.absyn
+  val query_parse : string -> Absyn.absyn
 
 (* parse a program in a file *)
 
-    val file_parse : string -> Absyn.absyn
+  val file_parse : string -> Absyn.absyn
  
 (* parse a query from the standard input *)
 
-    val top_parse : unit -> Absyn.absyn
+  val top_parse : unit -> Absyn.absyn
 
 end  (* signature PARSE *)
 
 
 functor Parse (structure Absyn : ABSYN
-	       structure Interface : INTERFACE
-	       structure Parser : PARSER
-	          sharing type Parser.arg = Interface.arg
-	          sharing type Parser.pos = Interface.pos
-		  sharing type Parser.result = Absyn.absyn
-	       structure Tokens : Fol_TOKENS
-	          sharing type Tokens.token = Parser.Token.token
-		  sharing type Tokens.svalue = Parser.svalue
+               structure Interface : INTERFACE
+               structure Parser : PARSER
+                  sharing type Parser.arg = Interface.arg
+                  sharing type Parser.pos = Interface.pos
+                  sharing type Parser.result = Absyn.absyn
+               structure Tokens : Fol_TOKENS
+                  sharing type Tokens.token = Parser.Token.token
+                  sharing type Tokens.svalue = Parser.svalue
                ) : PARSE =
 struct
 
 structure Absyn = Absyn
 
-val parse = fn (dummyToken,lookahead,reader : int -> string) =>
+fun parse (dummyToken,lookahead,reader : int -> string) =
     let val _ = Interface.init_line()
-	val empty = !Interface.line
-	val dummyEOF = Tokens.EOF(empty,empty)
-	val dummyTOKEN = dummyToken(empty,empty)
-	fun invoke lexer = 
-	   let val newLexer = Parser.Stream.cons(dummyTOKEN,lexer)
-	   in Parser.parse(lookahead,newLexer,Interface.error,
-				Interface.nothing)
-	   end
+        val empty = !Interface.line
+        val dummyEOF = Tokens.EOF(empty,empty)
+        val dummyTOKEN = dummyToken(empty,empty)
+        fun invoke lexer = 
+           let val newLexer = Parser.Stream.cons(dummyTOKEN,lexer)
+           in Parser.parse(lookahead,newLexer,Interface.error,
+                                Interface.nothing)
+           end
         fun loop lexer =
-	  let val (result,lexer) = invoke lexer
-	      val (nextToken,lexer) = Parser.Stream.get lexer
-	  in if Parser.sameToken(nextToken,dummyEOF) then result
-	     else loop lexer
-	  end
+          let val (result,lexer) = invoke lexer
+              val (nextToken,lexer) = Parser.Stream.get lexer
+          in if Parser.sameToken(nextToken,dummyEOF) then result
+             else loop lexer
+          end
      in loop (Parser.makeLexer reader)
-     end
+    end
 
 fun string_reader s =
- let val next = ref s
- in fn _ => !next before next := ""
- end
+    let val next = ref s
+     in fn _ => !next before next := ""
+    end
     
-val prog_parse = fn s => parse (Tokens.PARSEPROG,15,string_reader s)
+fun prog_parse s = parse (Tokens.PARSEPROG,15,string_reader s)
 
-val query_parse = fn s => parse (Tokens.PARSEQUERY,15,string_reader s)
+fun query_parse s = parse (Tokens.PARSEQUERY,15,string_reader s)
 
-val file_parse = fn name =>
-  let val dev = open_in name
-   in (parse (Tokens.PARSEPROG,15,fn i => input(dev,i))) before close_in dev
-   end
+fun file_parse name =
+    let val dev = TextIO.openIn name
+     in (parse (Tokens.PARSEPROG,15,fn i => TextIO.inputN(dev,i)))
+        before TextIO.closeIn dev
+    end
 
-val top_parse = 
-   let val input_line = fn f =>
-         let fun loop result =
-            let val c = input (f,1)
-                val result = c :: result
-            in if String.size c = 0 orelse c = "\n" then
-                  String.implode (rev result)
-                else loop result
-            end
-         in loop nil
-       end
-   in fn () =>
-      parse (Tokens.PARSEQUERY,0,fn i => input_line std_in)
-   end
+fun top_parse () = 
+    parse (Tokens.PARSEQUERY,0,(fn i => TextIO.inputLine TextIO.stdIn))
+
 end  (* functor Parse *)

Copied: mlton/branches/on-20050420-cmm-branch/mlyacc/examples/fol/sources.cm (from rev 4358, mlton/trunk/mlyacc/examples/fol/sources.cm)

Modified: mlton/branches/on-20050420-cmm-branch/mlyacc/examples/pascal/README
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlyacc/examples/pascal/README	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlyacc/examples/pascal/README	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,15 +1,32 @@
 This is a grammar for Berkeley Pascal, hacked to be SLR, though that is
 not necessary because ML-Yacc supports LALR(1).
 
-To construct the parser, first use ML-Yacc on the file "pascal.grm" to create
-the files "pascal.grm.sig" and "pascal.grm.sml".  This can be done by loading
-ML-Yacc and typing ``ParseGen.parseGen "pascal.grm"''.  Then construct the
-lexer by using ML_Lex on the file pascal.lex (``LexGen.lexGen "pascal.lex"'').
+To construct the parser, make this your current directory and run
 
-Finally, load the background file "base.sml".  Then use "load.sml" to
-load all the files.  The end result is a structure Parser with four
-functions.   The function parse_prog will parse a program in a string.
-Then function parse_query will parse a query in a string.  The function
-parse_file will parse a program in a file.  The function top_parse will
-parse a query from the standard input.
+  CM.make "sources.cm";
 
+This will apply ML-Yacc to the file "pascal.grm" to create
+the files "pascal.grm.sig" and "pascal.grm.sml", then 
+ML_Lex will be applied to pascal.lex to produce pascal.lex.sml.
+
+Then these generated files will be compiled together with necessary
+components from the ML-Yacc library supplied by the ml-yacc-lib.cm
+file. 
+
+The end result is a structure Parser with two functions.  The
+function 
+
+  parse: string ->
+         PascalParser.result *
+         (Parser.PascalParser.svalue,PascalParser.pos) LrParser.Token.token 
+            LrParser.stream
+
+parses input from a file, while
+
+  keybd: unit ->
+         Parser.PascalParser.result *
+         (Parser.PascalParser.svalue,Parser.PascalParser.pos) 
+           LrParser.Token.token LrParser.stream
+
+parses from the standard input.
+

Deleted: mlton/branches/on-20050420-cmm-branch/mlyacc/examples/pascal/join.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlyacc/examples/pascal/join.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlyacc/examples/pascal/join.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,39 +0,0 @@
-structure PascalLrVals = PascalLrValsFun(structure Token = LrParser.Token)
-structure PascalLex = PascalLexFun(structure Tokens = PascalLrVals.Tokens)
-structure PascalParser = Join(structure Lex= PascalLex
-		              structure LrParser = LrParser
-		              structure ParserData = PascalLrVals.ParserData)
-
-val parse = fn s =>
-  let val dev = open_in s
-      val stream = PascalParser.makeLexer(fn i => input(dev,i))
-      val _ = PascalLex.UserDeclarations.lineNum := 1
-      val error = fn (e,i:int,_) => output(std_out,s ^ "," ^
-		  " line " ^ (makestring i) ^ ", Error: " ^ e ^ "\n")
-  in PascalParser.parse(30,stream,error,()) before close_in dev
-  end
-
-val keybd = fn () =>
-  let val dev = std_in
-
-  (* note: some implementations of ML, such as SML of NJ,
-     have more efficient versions of input_line in their built-in
-     environment
-   *)
-
-      val input_line = fn f =>
-         let fun loop result =
-              let val c = input (f,1)
-	          val result = c :: result
-               in if String.size c = 0 orelse c = "\n" then
-		      String.implode (rev result)
-	          else loop result
-	       end
-         in loop nil
-         end
-      val stream = PascalParser.makeLexer (fn i => input_line dev)
-      val _ = PascalLex.UserDeclarations.lineNum := 1
-      val error = fn (e,i:int,_) => output(std_out,"std_in," ^
-		  " line " ^ (makestring i) ^ ", Error: " ^ e ^ "\n")
-  in PascalParser.parse(0,stream,error,())
-  end

Deleted: mlton/branches/on-20050420-cmm-branch/mlyacc/examples/pascal/load.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlyacc/examples/pascal/load.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlyacc/examples/pascal/load.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,4 +0,0 @@
-use "pascal.grm.sig";
-use "pascal.grm.sml";
-use "pascal.lex.sml";
-use "join.sml";

Copied: mlton/branches/on-20050420-cmm-branch/mlyacc/examples/pascal/parser.sml (from rev 4358, mlton/trunk/mlyacc/examples/pascal/parser.sml)

Modified: mlton/branches/on-20050420-cmm-branch/mlyacc/examples/pascal/pascal.grm
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlyacc/examples/pascal/pascal.grm	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlyacc/examples/pascal/pascal.grm	2006-02-16 19:34:54 UTC (rev 4361)
@@ -2,35 +2,36 @@
 
 %name Pascal
 %term
-	YAND	|	YARRAY	|	YBEGIN	|	YCASE |
-	YCONST	|	YDIV	|	YDO	|	YDOTDOT |
-	YTO	|	YELSE	|	YEND	|	YFILE |
-	YFOR	|	YFORWARD |	YPROCEDURE |	YGOTO |
-	YID	|	YIF	|	YIN	|	YINT |
-	YLABEL	|	YMOD	|	YNOT	|	YNUMB  |
-	YOF	|	YOR	|	YPACKED	|	YNIL |
-	YFUNCTION |	YPROG	|	YRECORD	|	YREPEAT |
-	YSET	|	YSTRING	|	YTHEN	|	YDOWNTO |
-	YTYPE	|	YUNTIL	|	YVAR	|	YWHILE |
-	YWITH	|	YBINT	|	YOCT	|	YHEX |
-	YCASELAB |	YILLCH	|	YEXTERN	 |
+        YAND    |       YARRAY  |       YBEGIN  |       YCASE |
+        YCONST  |       YDIV    |       YDO     |       YDOTDOT |
+        YTO     |       YELSE   |       YEND    |       YFILE |
+        YFOR    |       YFORWARD |      YPROCEDURE |    YGOTO |
+        YID     |       YIF     |       YIN     |       YINT |
+        YLABEL  |       YMOD    |       YNOT    |       YNUMB  |
+        YOF     |       YOR     |       YPACKED |       YNIL |
+        YFUNCTION |     YPROG   |       YRECORD |       YREPEAT |
+        YSET    |       YSTRING |       YTHEN   |       YDOWNTO |
+        YTYPE   |       YUNTIL  |       YVAR    |       YWHILE |
+        YWITH   |       YBINT   |       YOCT    |       YHEX |
+        YCASELAB |      YILLCH  |       YEXTERN  |
  YDOT | YLPAR  | YRPAR | YSEMI  | YCOMMA  | YCOLON |  YCARET |  YLBRA | 
  YRBRA | YTILDE |
  YLESS | YEQUAL | YGREATER 
-| YPLUS	| YMINUS | YBAR
+| YPLUS | YMINUS | YBAR
 | UNARYSIGN 
-| YSTAR	| YSLASH | YAMP
+| YSTAR | YSLASH | YAMP
 |  EOF
 
 %eop EOF
 %pos int
 %pure
+%noshift EOF
 
-%nonassoc YLESS	YEQUAL	YGREATER	YIN
-%left	YPLUS	YMINUS	YOR	YBAR
-%left	UNARYSIGN
-%left	YSTAR	YSLASH	YDIV	YMOD	YAND	YAMP
-%left	YNOT
+%nonassoc YLESS YEQUAL  YGREATER        YIN
+%left   YPLUS   YMINUS  YOR     YBAR
+%left   UNARYSIGN
+%left   YSTAR   YSLASH  YDIV    YMOD    YAND    YAMP
+%left   YNOT
 
 %nonterm goal | prog_hedr | block | decls | decl | labels | label_decl | 
 const_decl | type_decl | var_decl | proc_decl | pheadres | phead | 
@@ -44,18 +45,18 @@
 | begin
 
 %keyword
-	YAND		YARRAY		YBEGIN		YCASE 
-	YCONST		YDIV		YDO		
-	YTO		YELSE		YEND		YFILE 
-	YFOR		YFORWARD 	YPROCEDURE 	YGOTO 
-	YIF		YIN		
-	YLABEL		YMOD		YNOT		
-	YOF		YOR		YPACKED		YNIL 
-	YFUNCTION 	YPROG		YRECORD		YREPEAT
-	YSET		YSTRING		YTHEN		YDOWNTO 
-	YTYPE		YUNTIL		YVAR		YWHILE 
-	YWITH		YOCT		YHEX 
-	YEXTERN	 	YAMP 
+        YAND            YARRAY          YBEGIN          YCASE 
+        YCONST          YDIV            YDO             
+        YTO             YELSE           YEND            YFILE 
+        YFOR            YFORWARD        YPROCEDURE      YGOTO 
+        YIF             YIN             
+        YLABEL          YMOD            YNOT            
+        YOF             YOR             YPACKED         YNIL 
+        YFUNCTION       YPROG           YRECORD         YREPEAT
+        YSET            YSTRING         YTHEN           YDOWNTO 
+        YTYPE           YUNTIL          YVAR            YWHILE 
+        YWITH           YOCT            YHEX 
+        YEXTERN         YAMP 
 
 %prefer YID YSEMI YCOMMA  YLBRA
 
@@ -63,181 +64,181 @@
 
 %%
 begin: goal ()
-goal:	prog_hedr decls block YDOT	    ()
-|	decls	    ()
-prog_hedr:	YPROG YID YLPAR id_list YRPAR YSEMI     ()
-|	YPROG YID YSEMI    ()
-block:	YBEGIN stat_list YEND    ()
-decls:	decls decl    ()
-|	    ()
-decl:	labels    ()
-|	const_decl    ()
-|	type_decl    ()
-|	var_decl    ()
-|	proc_decl    ()
-labels:	YLABEL label_decl YSEMI    ()
-label_decl:	YINT    ()
-|	label_decl YCOMMA YINT    ()
-const_decl:	YCONST YID YEQUAL const YSEMI    ()
-|	const_decl YID YEQUAL const YSEMI    ()
-|	YCONST YID YEQUAL YID YSEMI    ()
-|	const_decl YID YEQUAL YID YSEMI    ()
-type_decl:	YTYPE YID YEQUAL type' YSEMI    ()
-|	type_decl YID YEQUAL type' YSEMI    ()
-var_decl:	YVAR id_list YCOLON type' YSEMI    ()
-|	var_decl id_list YCOLON type' YSEMI    ()
-proc_decl:	phead YFORWARD YSEMI    ()
-|	phead YEXTERN YSEMI    ()
-|	pheadres decls block YSEMI    ()
-pheadres:	phead    ()
-phead:	porf YID params ftype YSEMI    ()
-porf:	YPROCEDURE    ()
-|	YFUNCTION    ()
-params:	YLPAR param_list YRPAR    ()
-|	    ()
-param:	id_list YCOLON type'    ()
-|	YVAR id_list YCOLON type'    ()
-|	YFUNCTION id_list params ftype    ()
-|	YPROCEDURE id_list params ftype    ()
-ftype:	YCOLON type'    ()
-|	    ()
-param_list:	param    ()
-|	param_list YSEMI param    ()
-const:	YSTRING    ()
-|	number    ()
-|	YPLUS number    ()
-|	YMINUS number    ()
-|	YPLUS YID    ()
-|	YMINUS YID    ()
-number:	YINT    ()
-|	YBINT    ()
-|	YNUMB    ()
-const_list:	const    ()
-|	const_list YCOMMA const    ()
-|	YID    ()
-|	const_list YCOMMA YID    ()
-type':	simple_type    ()
-|	YCARET YID    ()
-|	struct_type    ()
-|	YPACKED struct_type    ()
-simple_type:	type_id    ()
-|	YLPAR id_list YRPAR    ()
-|	const YDOTDOT const    ()
-|	YID YDOTDOT const    ()
-|	const YDOTDOT YID    ()
-|	YID YDOTDOT YID    ()
-struct_type:	YARRAY YLBRA simple_type_list YRBRA YOF type'    ()
-|	YFILE YOF type'    ()
-|	YSET YOF simple_type    ()
-|	YRECORD field_list YEND    ()
-simple_type_list:	simple_type    ()
-|	simple_type_list YCOMMA simple_type    ()
-field_list:	fixed_part variant_part    ()
-fixed_part:	field    ()
-|	fixed_part YSEMI field    ()
-field:	    ()
-|	id_list YCOLON type'    ()
-variant_part:	    ()
-|	YCASE type_id YOF variant_list    ()
-|	YCASE YID YCOLON type_id YOF variant_list    ()
-variant_list:	variant    ()
-|	variant_list YSEMI variant    ()
-variant:	    ()
-|	const_list YCOLON YLPAR field_list YRPAR    ()
-stat_list:	stat    ()
-|	stat_lsth stat    ()
-stat_lsth:	stat_list YSEMI    ()
-cstat_list:	cstat    ()
-|	cstat_list YSEMI cstat    ()
-cstat:	const_list YCOLON stat    ()
-|	YCASELAB stat    ()
-|	    ()
-stat:	    ()
-|	YINT YCOLON stat    ()
-|	YID    ()
-|	YID YLPAR wexpr_list YRPAR ()
-|	assign ()
-|	YBEGIN stat_list YEND    ()
-|	YCASE expr YOF cstat_list YEND    ()
-|	YWITH var_list YDO stat    ()
-|	YWHILE expr YDO stat    ()
-|	YREPEAT stat_list YUNTIL expr    ()
-|	YFOR assign YTO expr YDO stat    ()
-|	YFOR assign YDOWNTO expr YDO stat    ()
-|	YGOTO YINT    ()
-|	YIF expr YTHEN stat    ()
-|	YIF expr YTHEN stat YELSE stat    ()
-assign:	variable YCOLON YEQUAL expr    ()
-|	YID YCOLON YEQUAL expr    ()
-expr:	expr relop expr			%prec YLESS    ()
-|	YPLUS expr			%prec UNARYSIGN    ()
-|	YMINUS expr			%prec UNARYSIGN    ()
-|	expr addop expr			%prec YPLUS    ()
-|	expr divop expr			%prec YSTAR    ()
-|	YNIL    ()
-|	YSTRING    ()
-|	YINT    ()
-|	YBINT    ()
-|	YNUMB    ()
-|	variable    ()
-|	YID ()
-|	YID YLPAR wexpr_list YRPAR    ()
-|	YLPAR expr YRPAR    ()
-|	negop expr			%prec YNOT    ()
-|	YLBRA element_list YRBRA    ()
-|	YLBRA YRBRA    ()
-element_list:	element    ()
-|	element_list YCOMMA element    ()
-element:	expr    ()
-|	expr YDOTDOT expr    ()
-variable:	qual_var    ()
-qual_var:	YID YLBRA expr_list YRBRA    ()
-|	qual_var YLBRA expr_list YRBRA    ()
-|	YID YDOT field_id    ()
-|	qual_var YDOT field_id    ()
-|	YID YCARET    ()
-|	qual_var YCARET    ()
-wexpr:	expr    ()
-|	expr YCOLON expr    ()
-|	expr YCOLON expr YCOLON expr    ()
-|	expr octhex    ()
-|	expr YCOLON expr octhex    ()
-octhex:	YOCT    ()
-|	YHEX    ()
-expr_list:	expr    ()
-|	expr_list YCOMMA expr    ()
-wexpr_list:	wexpr    ()
-|	wexpr_list YCOMMA wexpr    ()
-relop:	YEQUAL	()
-|	YLESS	()
-|	YGREATER	()
-|	YLESS YGREATER	()
-|	YLESS YEQUAL	()
-|	YGREATER YEQUAL	()
-|	YIN	()
-addop:	YPLUS	()
-|	YMINUS	()
-|	YOR	()
-|	YBAR	()
-divop:	YSTAR	()
-|	YSLASH	()
-|	YDIV	()
-|	YMOD	()
-|	YAND	()
-|	YAMP	()
-negop:	YNOT    ()
-|	YTILDE    ()
-var_list:	variable    ()
-|	var_list YCOMMA variable    ()
-|	YID    ()
-|	var_list YCOMMA YID    ()
-id_list:	YID    ()
-|	id_list YCOMMA YID    ()
-const_id:	YID    ()
-type_id:	YID    ()
-var_id:	YID    ()
-array_id:	YID    ()
-ptr_id:	YID    ()
-record_id:	YID    ()
-field_id:	YID    ()
-func_id:	YID    ()
+goal:   prog_hedr decls block YDOT          ()
+|       decls       ()
+prog_hedr:      YPROG YID YLPAR id_list YRPAR YSEMI     ()
+|       YPROG YID YSEMI    ()
+block:  YBEGIN stat_list YEND    ()
+decls:  decls decl    ()
+|           ()
+decl:   labels    ()
+|       const_decl    ()
+|       type_decl    ()
+|       var_decl    ()
+|       proc_decl    ()
+labels: YLABEL label_decl YSEMI    ()
+label_decl:     YINT    ()
+|       label_decl YCOMMA YINT    ()
+const_decl:     YCONST YID YEQUAL const YSEMI    ()
+|       const_decl YID YEQUAL const YSEMI    ()
+|       YCONST YID YEQUAL YID YSEMI    ()
+|       const_decl YID YEQUAL YID YSEMI    ()
+type_decl:      YTYPE YID YEQUAL type' YSEMI    ()
+|       type_decl YID YEQUAL type' YSEMI    ()
+var_decl:       YVAR id_list YCOLON type' YSEMI    ()
+|       var_decl id_list YCOLON type' YSEMI    ()
+proc_decl:      phead YFORWARD YSEMI    ()
+|       phead YEXTERN YSEMI    ()
+|       pheadres decls block YSEMI    ()
+pheadres:       phead    ()
+phead:  porf YID params ftype YSEMI    ()
+porf:   YPROCEDURE    ()
+|       YFUNCTION    ()
+params: YLPAR param_list YRPAR    ()
+|           ()
+param:  id_list YCOLON type'    ()
+|       YVAR id_list YCOLON type'    ()
+|       YFUNCTION id_list params ftype    ()
+|       YPROCEDURE id_list params ftype    ()
+ftype:  YCOLON type'    ()
+|           ()
+param_list:     param    ()
+|       param_list YSEMI param    ()
+const:  YSTRING    ()
+|       number    ()
+|       YPLUS number    ()
+|       YMINUS number    ()
+|       YPLUS YID    ()
+|       YMINUS YID    ()
+number: YINT    ()
+|       YBINT    ()
+|       YNUMB    ()
+const_list:     const    ()
+|       const_list YCOMMA const    ()
+|       YID    ()
+|       const_list YCOMMA YID    ()
+type':  simple_type    ()
+|       YCARET YID    ()
+|       struct_type    ()
+|       YPACKED struct_type    ()
+simple_type:    type_id    ()
+|       YLPAR id_list YRPAR    ()
+|       const YDOTDOT const    ()
+|       YID YDOTDOT const    ()
+|       const YDOTDOT YID    ()
+|       YID YDOTDOT YID    ()
+struct_type:    YARRAY YLBRA simple_type_list YRBRA YOF type'    ()
+|       YFILE YOF type'    ()
+|       YSET YOF simple_type    ()
+|       YRECORD field_list YEND    ()
+simple_type_list:       simple_type    ()
+|       simple_type_list YCOMMA simple_type    ()
+field_list:     fixed_part variant_part    ()
+fixed_part:     field    ()
+|       fixed_part YSEMI field    ()
+field:      ()
+|       id_list YCOLON type'    ()
+variant_part:       ()
+|       YCASE type_id YOF variant_list    ()
+|       YCASE YID YCOLON type_id YOF variant_list    ()
+variant_list:   variant    ()
+|       variant_list YSEMI variant    ()
+variant:            ()
+|       const_list YCOLON YLPAR field_list YRPAR    ()
+stat_list:      stat    ()
+|       stat_lsth stat    ()
+stat_lsth:      stat_list YSEMI    ()
+cstat_list:     cstat    ()
+|       cstat_list YSEMI cstat    ()
+cstat:  const_list YCOLON stat    ()
+|       YCASELAB stat    ()
+|           ()
+stat:       ()
+|       YINT YCOLON stat    ()
+|       YID    ()
+|       YID YLPAR wexpr_list YRPAR ()
+|       assign ()
+|       YBEGIN stat_list YEND    ()
+|       YCASE expr YOF cstat_list YEND    ()
+|       YWITH var_list YDO stat    ()
+|       YWHILE expr YDO stat    ()
+|       YREPEAT stat_list YUNTIL expr    ()
+|       YFOR assign YTO expr YDO stat    ()
+|       YFOR assign YDOWNTO expr YDO stat    ()
+|       YGOTO YINT    ()
+|       YIF expr YTHEN stat    ()
+|       YIF expr YTHEN stat YELSE stat    ()
+assign: variable YCOLON YEQUAL expr    ()
+|       YID YCOLON YEQUAL expr    ()
+expr:   expr relop expr                 %prec YLESS    ()
+|       YPLUS expr                      %prec UNARYSIGN    ()
+|       YMINUS expr                     %prec UNARYSIGN    ()
+|       expr addop expr                 %prec YPLUS    ()
+|       expr divop expr                 %prec YSTAR    ()
+|       YNIL    ()
+|       YSTRING    ()
+|       YINT    ()
+|       YBINT    ()
+|       YNUMB    ()
+|       variable    ()
+|       YID ()
+|       YID YLPAR wexpr_list YRPAR    ()
+|       YLPAR expr YRPAR    ()
+|       negop expr                      %prec YNOT    ()
+|       YLBRA element_list YRBRA    ()
+|       YLBRA YRBRA    ()
+element_list:   element    ()
+|       element_list YCOMMA element    ()
+element:        expr    ()
+|       expr YDOTDOT expr    ()
+variable:       qual_var    ()
+qual_var:       YID YLBRA expr_list YRBRA    ()
+|       qual_var YLBRA expr_list YRBRA    ()
+|       YID YDOT field_id    ()
+|       qual_var YDOT field_id    ()
+|       YID YCARET    ()
+|       qual_var YCARET    ()
+wexpr:  expr    ()
+|       expr YCOLON expr    ()
+|       expr YCOLON expr YCOLON expr    ()
+|       expr octhex    ()
+|       expr YCOLON expr octhex    ()
+octhex: YOCT    ()
+|       YHEX    ()
+expr_list:      expr    ()
+|       expr_list YCOMMA expr    ()
+wexpr_list:     wexpr    ()
+|       wexpr_list YCOMMA wexpr    ()
+relop:  YEQUAL  ()
+|       YLESS   ()
+|       YGREATER        ()
+|       YLESS YGREATER  ()
+|       YLESS YEQUAL    ()
+|       YGREATER YEQUAL ()
+|       YIN     ()
+addop:  YPLUS   ()
+|       YMINUS  ()
+|       YOR     ()
+|       YBAR    ()
+divop:  YSTAR   ()
+|       YSLASH  ()
+|       YDIV    ()
+|       YMOD    ()
+|       YAND    ()
+|       YAMP    ()
+negop:  YNOT    ()
+|       YTILDE    ()
+var_list:       variable    ()
+|       var_list YCOMMA variable    ()
+|       YID    ()
+|       var_list YCOMMA YID    ()
+id_list:        YID    ()
+|       id_list YCOMMA YID    ()
+const_id:       YID    ()
+type_id:        YID    ()
+var_id: YID    ()
+array_id:       YID    ()
+ptr_id: YID    ()
+record_id:      YID    ()
+field_id:       YID    ()
+func_id:        YID    ()

Modified: mlton/branches/on-20050420-cmm-branch/mlyacc/examples/pascal/pascal.lex
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlyacc/examples/pascal/pascal.lex	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlyacc/examples/pascal/pascal.lex	2006-02-16 19:34:54 UTC (rev 4361)
@@ -11,76 +11,76 @@
 
 
 structure KeyWord : sig
-	     		val find : string ->
-				 (int * int -> (svalue,int) token) option
-	  	    end =
+                        val find : string ->
+                                 (int * int -> (svalue,int) token) option
+                    end =
   struct
 
-	val TableSize = 211
-	val HashFactor = 5
+        val TableSize = 211
+        val HashFactor = 5
 
-	val hash = fn s =>
-	   fold (fn (c,v)=>(v*HashFactor+(ord c)) mod TableSize) (explode s) 0
+        val hash = fn s =>
+           foldl (fn (c,v)=>(v*HashFactor+(ord c)) mod TableSize) 0 (explode s)
 
 
-	val HashTable = Array.array(TableSize,nil) :
-		 (string * (int * int -> (svalue,int) token)) list Array.array
+        val HashTable = Array.array(TableSize,nil) :
+                 (string * (int * int -> (svalue,int) token)) list Array.array
 
 
-	val add = fn (s,v) =>
-	 let val i = hash s
-	 in Array.update(HashTable,i,(s,v) :: (Array.sub(HashTable, i)))
-	 end
+        val add = fn (s,v) =>
+         let val i = hash s
+         in Array.update(HashTable,i,(s,v) :: (Array.sub(HashTable, i)))
+         end
 
         val find = fn s =>
-	  let val i = hash s
-	      fun f ((key,v)::r) = if s=key then SOME v else f r
-	        | f nil = NONE
-	  in  f (Array.sub(HashTable, i))
-	  end
+          let val i = hash s
+              fun f ((key,v)::r) = if s=key then SOME v else f r
+                | f nil = NONE
+          in  f (Array.sub(HashTable, i))
+          end
  
-	val _ = 
-	    (List.app add
-	[("and",YAND),
-	 ("array",YARRAY),
-	 ("begin",YBEGIN),
-	 ("case",YCASE),
-	 ("const",YCONST),
-	 ("div",YDIV),
-	 ("do",YDO),
-	 ("downto",YDOWNTO),
-	 ("else",YELSE),
-	 ("end",YEND),
-	 ("extern",YEXTERN),
-	 ("file",YFILE),
-	 ("for",YFOR),
-	 ("forward",YFORWARD),
-	 ("function",YFUNCTION),
-	 ("goto",YGOTO),
-	 ("hex",YHEX),
-	 ("if",YIF),
-	 ("in",YIN),
-	 ("label",YLABEL),
-	 ("mod",YMOD),
-	 ("nil",YNIL),
-	 ("not",YNOT),
-	 ("oct",YOCT),
-	 ("of",YOF),
-	 ("or",YOR),
-	 ("packed",YPACKED),
-	 ("procedure",YPROCEDURE),
-	 ("program",YPROG),
-	 ("record",YRECORD),
-	 ("repeat",YREPEAT),
-	 ("set",YSET),
-	 ("then",YTHEN),
-	 ("to",YTO),
-	 ("type",YTYPE),
-	 ("until",YUNTIL),
-	 ("var",YVAR),
-	 ("while",YWHILE),
-	 ("with",YWITH)
-	])
+        val _ = 
+            (List.app add
+        [("and",YAND),
+         ("array",YARRAY),
+         ("begin",YBEGIN),
+         ("case",YCASE),
+         ("const",YCONST),
+         ("div",YDIV),
+         ("do",YDO),
+         ("downto",YDOWNTO),
+         ("else",YELSE),
+         ("end",YEND),
+         ("extern",YEXTERN),
+         ("file",YFILE),
+         ("for",YFOR),
+         ("forward",YFORWARD),
+         ("function",YFUNCTION),
+         ("goto",YGOTO),
+         ("hex",YHEX),
+         ("if",YIF),
+         ("in",YIN),
+         ("label",YLABEL),
+         ("mod",YMOD),
+         ("nil",YNIL),
+         ("not",YNOT),
+         ("oct",YOCT),
+         ("of",YOF),
+         ("or",YOR),
+         ("packed",YPACKED),
+         ("procedure",YPROCEDURE),
+         ("program",YPROG),
+         ("record",YRECORD),
+         ("repeat",YREPEAT),
+         ("set",YSET),
+         ("then",YTHEN),
+         ("to",YTO),
+         ("type",YTYPE),
+         ("until",YUNTIL),
+         ("var",YVAR),
+         ("while",YWHILE),
+         ("with",YWITH)
+        ])
    end
    open KeyWord
 
@@ -97,43 +97,43 @@
 octdigit=[0-7];
 ws = [\ \t];
 %%
-<INITIAL>{ws}+	=> (lex());
-<INITIAL>\n+	=> (lineNum := (!lineNum) + (String.length yytext); lex());
+<INITIAL>{ws}+  => (lex());
+<INITIAL>\n+    => (lineNum := (!lineNum) + (String.size yytext); lex());
 <INITIAL>{alpha}+ => (case find yytext of SOME v => v(!lineNum,!lineNum)
-						  | _ => YID(!lineNum,!lineNum));
+                                                  | _ => YID(!lineNum,!lineNum));
 <INITIAL>{alpha}({alpha}|{digit})*  => (YID(!lineNum,!lineNum));
 <INITIAL>{optsign}{integer}({frac}{exp}?|{frac}?{exp}) => (YNUMB(!lineNum,!lineNum));
 <INITIAL>{optsign}{integer} => (YINT(!lineNum,!lineNum));
 <INITIAL>{octdigit}+(b|B) => (YBINT(!lineNum,!lineNum));
 <INITIAL>"'"([^']|"''")*"'" => (YSTRING(!lineNum,!lineNum));
 <INITIAL>"(*" =>   (YYBEGIN C; lex());
-<INITIAL>".."	=> (YDOTDOT(!lineNum,!lineNum));
-<INITIAL>"."	=> (YDOT(!lineNum,!lineNum));
-<INITIAL>"("	=> (YLPAR(!lineNum,!lineNum));
-<INITIAL>")"	=> (YRPAR(!lineNum,!lineNum));
-<INITIAL>";"	=> (YSEMI(!lineNum,!lineNum));
-<INITIAL>","	=> (YCOMMA(!lineNum,!lineNum));
-<INITIAL>":"	=> (YCOLON(!lineNum,!lineNum));
-<INITIAL>"^"	=> (YCARET(!lineNum,!lineNum));
-<INITIAL>"["	=> (YLBRA(!lineNum,!lineNum));
-<INITIAL>"]"	=> (YRBRA(!lineNum,!lineNum));
-<INITIAL>"~"	=> (YTILDE(!lineNum,!lineNum));
-<INITIAL>"<"	=> (YLESS(!lineNum,!lineNum));
-<INITIAL>"="	=> (YEQUAL(!lineNum,!lineNum));
-<INITIAL>">"	=> (YGREATER(!lineNum,!lineNum));
-<INITIAL>"+"	=> (YPLUS(!lineNum,!lineNum));
-<INITIAL>"-"	=> (YMINUS(!lineNum,!lineNum));
-<INITIAL>"|"	=> (YBAR(!lineNum,!lineNum));
-<INITIAL>"*"	=> (YSTAR(!lineNum,!lineNum));
-<INITIAL>"/"	=> (YSLASH(!lineNum,!lineNum));
-<INITIAL>"{"	=> (YYBEGIN B; lex());
-<INITIAL>.	=> (YILLCH(!lineNum,!lineNum));
-<C>\n+		=> (lineNum := (!lineNum) + (String.length yytext); lex());
-<C>[^()*\n]+	=> (lex());
-<C>"(*"		=> (lex());
-<C>"*)"		=> (YYBEGIN INITIAL; lex());
-<C>[*()]	=> (lex());
-<B>\n+		=> (lineNum := (!lineNum) + (String.length yytext); lex());
-<B>[^{}\n]+	=> (lex());
-<B>"{"		=> (lex());
-<B>"}"		=> (YYBEGIN INITIAL; lex());
+<INITIAL>".."   => (YDOTDOT(!lineNum,!lineNum));
+<INITIAL>"."    => (YDOT(!lineNum,!lineNum));
+<INITIAL>"("    => (YLPAR(!lineNum,!lineNum));
+<INITIAL>")"    => (YRPAR(!lineNum,!lineNum));
+<INITIAL>";"    => (YSEMI(!lineNum,!lineNum));
+<INITIAL>","    => (YCOMMA(!lineNum,!lineNum));
+<INITIAL>":"    => (YCOLON(!lineNum,!lineNum));
+<INITIAL>"^"    => (YCARET(!lineNum,!lineNum));
+<INITIAL>"["    => (YLBRA(!lineNum,!lineNum));
+<INITIAL>"]"    => (YRBRA(!lineNum,!lineNum));
+<INITIAL>"~"    => (YTILDE(!lineNum,!lineNum));
+<INITIAL>"<"    => (YLESS(!lineNum,!lineNum));
+<INITIAL>"="    => (YEQUAL(!lineNum,!lineNum));
+<INITIAL>">"    => (YGREATER(!lineNum,!lineNum));
+<INITIAL>"+"    => (YPLUS(!lineNum,!lineNum));
+<INITIAL>"-"    => (YMINUS(!lineNum,!lineNum));
+<INITIAL>"|"    => (YBAR(!lineNum,!lineNum));
+<INITIAL>"*"    => (YSTAR(!lineNum,!lineNum));
+<INITIAL>"/"    => (YSLASH(!lineNum,!lineNum));
+<INITIAL>"{"    => (YYBEGIN B; lex());
+<INITIAL>.      => (YILLCH(!lineNum,!lineNum));
+<C>\n+          => (lineNum := (!lineNum) + (String.size yytext); lex());
+<C>[^()*\n]+    => (lex());
+<C>"(*"         => (lex());
+<C>"*)"         => (YYBEGIN INITIAL; lex());
+<C>[*()]        => (lex());
+<B>\n+          => (lineNum := (!lineNum) + (String.size yytext); lex());
+<B>[^{}\n]+     => (lex());
+<B>"{"          => (lex());
+<B>"}"          => (YYBEGIN INITIAL; lex());

Copied: mlton/branches/on-20050420-cmm-branch/mlyacc/examples/pascal/sources.cm (from rev 4358, mlton/trunk/mlyacc/examples/pascal/sources.cm)

Modified: mlton/branches/on-20050420-cmm-branch/mlyacc/main.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlyacc/main.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlyacc/main.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,11 @@
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 structure Main =
 struct
 
@@ -3,13 +11,13 @@
 fun usage s =
    Process.usage {usage = "file.grm",
-		  msg = s}
+                  msg = s}
 
 fun main args =
    let
       val rest =
-	 let open Popt
-	 in parse {switches = args,
-		   opts = []}
-	 end
+         let open Popt
+         in parse {switches = args,
+                   opts = []}
+         end
    in case rest of
       Result.No msg => usage msg

Modified: mlton/branches/on-20050420-cmm-branch/mlyacc/mlyacc.cm
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlyacc/mlyacc.cm	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlyacc/mlyacc.cm	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,11 @@
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 Group is
 
 sources.cm

Modified: mlton/branches/on-20050420-cmm-branch/mlyacc/mlyacc.mlb
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlyacc/mlyacc.mlb	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlyacc/mlyacc.mlb	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,5 +1,12 @@
+(* Copyright (C) 2004-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 local
-  sources.mlb
+   sources.mlb
 in
-  call-main.sml
+   call-main.sml
 end

Modified: mlton/branches/on-20050420-cmm-branch/mlyacc/sources.cm
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlyacc/sources.cm	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlyacc/sources.cm	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,8 +1,8 @@
-(* Copyright (C) 2004 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 2004-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  *)
 
 Group is

Modified: mlton/branches/on-20050420-cmm-branch/mlyacc/sources.mlb
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlyacc/sources.mlb	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlyacc/sources.mlb	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,17 @@
+(* Copyright (C) 2004-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
 local
-  src/sources.mlb
-  local
-    ../lib/mlton/sources.mlb
-  in
-    main.sml
-  end
+   src/sources.mlb
+   local
+      ../lib/mlton/sources.mlb
+   in
+      main.sml
+   end
 in
-  structure Main
+   structure Main
 end


Property changes on: mlton/branches/on-20050420-cmm-branch/mlyacc/src
___________________________________________________________________
Name: svn:ignore
   + yacc.grm.sig
yacc.grm.sml
yacc.lex.sml


Deleted: mlton/branches/on-20050420-cmm-branch/mlyacc/src/.cvsignore
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlyacc/src/.cvsignore	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlyacc/src/.cvsignore	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +0,0 @@
-yacc.grm.sig
-yacc.grm.sml
-yacc.lex.sml

Copied: mlton/branches/on-20050420-cmm-branch/mlyacc/src/.ignore (from rev 4358, mlton/trunk/mlyacc/src/.ignore)

Modified: mlton/branches/on-20050420-cmm-branch/mlyacc/src/absyn.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlyacc/src/absyn.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlyacc/src/absyn.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,6 @@
+(* Modified by mfluet@acm.org on 2005-8-01.
+ * Update with SML/NJ 110.55+.
+ *)
 (* Modified by sweeks@acm.org on 2000-8-24.
  * Ported to MLton.
  *)
@@ -3,14 +6,5 @@
 type int = Int.int
 
-(* ML-Yacc Parser Generator (c) 1989 Andrew W. Appel, David R. Tarditi 
- *
- * $Log: absyn.sig,v $
- * Revision 1.1.1.1  1997/01/14 01:38:05  george
- *   Version 109.24
- *
- * Revision 1.1.1.1  1996/01/31  16:01:44  george
- * Version 109
- * 
- *)
+(* ML-Yacc Parser Generator (c) 1989 Andrew W. Appel, David R. Tarditi *)
 
 signature ABSYN =
@@ -28,10 +22,10 @@
        and      pat = PVAR of string
                     | PAPP of string * pat
                     | PTUPLE of pat list
-                    | PLIST of pat list
+                    | PLIST of pat list * pat option
                     | PINT of int
                     | WILD
-                    | AS of pat * pat
+                    | AS of string * pat
        and     decl = VB of pat * exp
        and     rule = RULE of pat * exp
        val printRule : ((string -> unit) * (string -> unit)) -> rule -> unit

Modified: mlton/branches/on-20050420-cmm-branch/mlyacc/src/absyn.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlyacc/src/absyn.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlyacc/src/absyn.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,21 +1,4 @@
-(* ML-Yacc Parser Generator (c) 1991 Andrew W. Appel, David R. Tarditi 
- *
- * $Log: absyn.sml,v $
- * Revision 1.1.1.1  1997/01/14 01:38:05  george
- *   Version 109.24
- *
- * Revision 1.3  1996/02/26  15:02:30  george
- *    print no longer overloaded.
- *    use of makestring has been removed and replaced with Int.toString ..
- *    use of IO replaced with TextIO
- *
- * Revision 1.2  1996/02/15  01:51:38  jhr
- * Replaced character predicates (isalpha, isnum) with functions from Char.
- *
- * Revision 1.1.1.1  1996/01/31  16:01:44  george
- * Version 109
- * 
- *)
+(* ML-Yacc Parser Generator (c) 1991 Andrew W. Appel, David R. Tarditi *)
 
 structure Absyn : ABSYN =
   struct
@@ -33,10 +16,10 @@
       = PVAR of string
       | PAPP of string * pat
       | PINT of int
-      | PLIST of pat list
+      | PLIST of pat list * pat option
       | PTUPLE of pat list
       | WILD
-      | AS of pat * pat
+      | AS of string * pat
     and decl = VB of pat * exp
     and rule = RULE of pat * exp
 
@@ -45,11 +28,11 @@
       | idchar c = Char.isAlpha c orelse Char.isDigit c
 
     fun code_to_ids s = let
-	  fun g(nil,r) = r
+          fun g(nil,r) = r
             | g(a as (h::t),r) = if Char.isAlpha h then f(t,[h],r) else g(t,r)
           and f(nil,accum,r)= implode(rev accum)::r
             | f(a as (h::t),accum,r) =
-		if idchar h then f(t,h::accum,r) else g(a,implode (rev accum) :: r)
+                if idchar h then f(t,h::accum,r) else g(a,implode (rev accum) :: r)
           in g(explode s,nil)
           end
 
@@ -75,12 +58,17 @@
                          (case f pat
                           of WILD => WILD
                            | pat' => PAPP(s,pat'))
-                     | (PLIST l) =>
-	                  let val l' = map f l
-                          in if List.exists(fn WILD=>false | _ => true) l'
-                                then PLIST l'
-                             else WILD
-                          end
+                     | (PLIST (l, topt)) =>
+                         let val l' = map f l
+                             val topt' = Option.map f topt
+                             fun notWild WILD = false
+                               | notWild _ = true
+                         in case topt' of
+                                SOME WILD => if List.exists notWild l' then
+                                                 PLIST (l', topt')
+                                             else WILD
+                              | _ => PLIST (l', topt')
+                         end
                      | (PTUPLE l) =>
                           let val l' = map f l
                           in if List.exists(fn WILD=>false | _ => true) l'
@@ -88,13 +76,11 @@
                              else WILD
                           end
                      | (AS(a,b)) =>
-                         let val a'=f a
-                             val b'=f b
-                         in case(a',b')
-                            of (WILD,_) => b'
-                             | (_,WILD) => a'
-                             | _ => AS(a',b')
-                         end
+                         if used a then
+                             case f b of
+                                 WILD => PVAR a
+                               | b' => AS(a,b')
+                         else f b
                      | _ => a
                in f
                end
@@ -104,7 +90,7 @@
                      | f(FN(p,e)) = FN(simplifyPat p,f e) 
                      | f(LET(dl,e)) = 
                           LET(map (fn VB(p,e) =>
-	                          VB(simplifyPat p,f e)) dl,
+                                  VB(simplifyPat p,f e)) dl,
                               f e)
                      | f(SEQ(a,b)) = SEQ(f a,f b)
                      | f a = a
@@ -113,74 +99,64 @@
        in RULE(simplifyPat p,simplifyExp e)
        end
 
-       fun printRule (say : string -> unit, sayln:string -> unit) = let
-	 val lp = ["("]
-         val rp = [")"]
-         val sp = [" "]
-         val sm = [";"]
-         val cm = [","]
-         val cr = ["\n"]
-         val unit = ["()"]
-          fun printExp c =
-	   let fun f (CODE c) = ["(",c,")"]
-                 | f (EAPP(EVAR a,UNIT)) = [a," ","()"]
-                 | f (EAPP(EVAR a,EINT i)) =  [a," ",Int.toString i]
-                 | f (EAPP(EVAR a,EVAR b)) = [a," ",b]
-                 | f (EAPP(EVAR a,b)) = List.concat[[a],lp,f b,rp]
-                 | f (EAPP(a,b)) = List.concat [lp,f a,rp,lp,f b,rp]
-	         | f (EINT i) = [Int.toString i]
-                 | f (ETUPLE (a::r)) = 
-	              let fun scan nil = [rp]
-                            | scan (h :: t) = cm :: f h :: scan t
-                      in List.concat (lp :: f a :: scan r)
-                      end
-                 | f (ETUPLE _) = ["<bogus-tuple>"]
-                 | f (EVAR s) = [s]
-                 | f (FN (p,b)) = List.concat[["fn "],printPat p,[" => "],f b]
-                 | f (LET (nil,body)) = f body
-                 | f (LET (dl,body)) =
-	              let fun scan nil = [[" in "],f body,[" end"],cr]
-                            | scan (h :: t) = printDecl h :: scan t
-	              in List.concat(["let "] :: scan dl)
-	              end
-                 | f (SEQ (a,b)) = List.concat [lp,f a,sm,f b,rp]
-                 | f (UNIT) = unit
-          in f c
-          end
-         and printDecl (VB (pat,exp)) =
-                  List.concat[["val "],printPat pat,["="],printExp exp,cr]
-         and printPat c =
-	   let fun f (AS(PVAR a,PVAR b)) = [a," as ",b]
-                 | f (AS(a,b)) = List.concat [lp,f a,[") as ("],f b,rp]
-                 | f (PAPP(a,WILD)) = [a," ","_"]
-                 | f (PAPP(a,PINT i)) =  [a," ",Int.toString i]
-                 | f (PAPP(a,PVAR b)) = [a," ",b]
-                 | f (PAPP(a,b)) = List.concat [lp,[a],sp,f b,rp]
-	         | f (PINT i) = [Int.toString i]
-                 | f (PLIST nil) = ["<bogus-list>"]
-                 | f (PLIST l) =
-	              let fun scan (h :: nil) = [f h]
-                            | scan (h :: t) = f h :: ["::"] :: scan t
-			    | scan _ = raise Fail "scan"
-                      in List.concat (scan l)
-                      end
-                 | f (PTUPLE (a::r)) = 
-	              let fun scan nil = [rp]
-                            | scan (h :: t) = cm :: f h :: scan t
-                      in List.concat (lp :: f a :: scan r)
-                      end
-                 | f (PTUPLE nil) = ["<bogus-pattern-tuple>"]
-                 | f (PVAR a) = [a]
-                 | f WILD = ["_"]
-           in f c
-           end
-	   fun oursay "\n" = sayln ""
-	     | oursay a = say a
-         in fn a => 
-	      let val RULE(p,e) = simplifyRule a
-              in app oursay (printPat p);
-	         say " => ";
-                 app oursay (printExp e)
-              end
-         end
+       fun printRule (say : string -> unit, sayln:string -> unit) r = let
+           fun flat (a, []) = rev a
+             | flat (a, SEQ (e1, e2) :: el) = flat (a, e1 :: e2 :: el)
+             | flat (a, e :: el) = flat (e :: a, el)
+           fun pl (lb, rb, c, f, [], a) = " " :: lb :: rb :: a
+             | pl (lb, rb, c, f, h :: t, a) =
+                 " " :: lb :: f (h, foldr (fn (x, a) => c :: f (x, a))
+                                          (rb :: a)
+                                          t)
+           fun pe (CODE c, a) = " (" :: c :: ")" :: a
+             | pe (EAPP (x, y as (EAPP _)), a) =
+                 pe (x, " (" :: pe (y, ")" :: a))
+             | pe (EAPP (x, y), a) =
+                 pe (x, pe (y, a))
+             | pe (EINT i, a) =
+                 " " :: Int.toString i :: a
+             | pe (ETUPLE l, a) = pl ("(", ")", ",", pe, l, a)
+             | pe (EVAR v, a) =
+                 " " :: v :: a
+             | pe (FN (p, b), a) =
+                 " (fn" :: pp (p, " =>" :: pe (b, ")" :: a))
+             | pe (LET ([], b), a) =
+                 pe (b, a)
+             | pe (LET (dl, b), a) =
+               let fun pr (VB (p, e), a) =
+                       " val " :: pp (p, " =" :: pe (e, "\n" :: a))
+               in " let" :: foldr pr (" in" :: pe (b, "\nend" :: a)) dl
+               end
+             | pe (SEQ (e1, e2), a) =
+                 pl ("(", ")", ";", pe, flat ([], [e1, e2]), a)
+             | pe (UNIT, a) =
+                 " ()" :: a
+           and pp (PVAR v, a) =
+                 " " :: v :: a
+             | pp (PAPP (x, y as PAPP _), a) =
+                 " " :: x :: " (" :: pp (y, ")" :: a)
+             | pp (PAPP (x, y), a) =
+                 " " :: x :: pp (y, a)
+             | pp (PINT i, a) =
+                 " " :: Int.toString i :: a
+             | pp (PLIST (l, NONE), a) =
+                 pl ("[", "]", ",", pp, l, a)
+             | pp (PLIST (l, SOME t), a) =
+                 " (" :: foldr (fn (x, a) => pp (x, " ::" :: a))
+                               (pp (t, ")" :: a))
+                               l
+             | pp (PTUPLE l, a) =
+                 pl ("(", ")", ",", pp, l, a)
+             | pp (WILD, a) =
+                 " _" :: a
+             | pp (AS (v, PVAR v'), a) =
+                 " (" :: v :: " as " :: v' :: ")" :: a
+             | pp (AS (v, p), a) =
+                 " (" :: v :: " as (" :: pp (p, "))" :: a)
+           fun out "\n" = sayln ""
+             | out s = say s
+       in
+           case simplifyRule r of
+               RULE (p, e) => app out (pp (p, " =>" :: pe (e, ["\n"])))
+       end
 end;

Modified: mlton/branches/on-20050420-cmm-branch/mlyacc/src/core.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlyacc/src/core.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlyacc/src/core.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,87 +1,73 @@
-(* ML-Yacc Parser Generator (c) 1989 Andrew W. Appel, David R. Tarditi 
- *
- * $Log: core.sml,v $
- * Revision 1.1.1.1  1997/01/14 01:38:05  george
- *   Version 109.24
- *
- * Revision 1.2  1996/02/26  15:02:31  george
- *    print no longer overloaded.
- *    use of makestring has been removed and replaced with Int.toString ..
- *    use of IO replaced with TextIO
- *
- * Revision 1.1.1.1  1996/01/31  16:01:44  george
- * Version 109
- * 
- *)
+(* ML-Yacc Parser Generator (c) 1989 Andrew W. Appel, David R. Tarditi *)
 
 functor mkCore(structure IntGrammar : INTGRAMMAR) : CORE =
-	struct
-		open IntGrammar
-		open  Grammar
-		structure IntGrammar = IntGrammar
-		structure Grammar = Grammar
+        struct
+                open IntGrammar
+                open  Grammar
+                structure IntGrammar = IntGrammar
+                structure Grammar = Grammar
 
-		datatype item = ITEM of
-				{ rule : rule,
-				  dot : int,
-				  rhsAfter : symbol list
-				}
+                datatype item = ITEM of
+                                { rule : rule,
+                                  dot : int,
+                                  rhsAfter : symbol list
+                                }
 
-		val eqItem = fn (ITEM{rule=RULE{num=n,...},dot=d,...},
-				 ITEM{rule=RULE{num=m,...},dot=e,...}) =>
-					n=m andalso d=e
+                val eqItem = fn (ITEM{rule=RULE{num=n,...},dot=d,...},
+                                 ITEM{rule=RULE{num=m,...},dot=e,...}) =>
+                                        n=m andalso d=e
 
-		val gtItem =  fn (ITEM{rule=RULE{num=n,...},dot=d,...},
-				  ITEM{rule=RULE{num=m,...},dot=e,...}) =>
-					n>m orelse (n=m andalso d>e)
+                val gtItem =  fn (ITEM{rule=RULE{num=n,...},dot=d,...},
+                                  ITEM{rule=RULE{num=m,...},dot=e,...}) =>
+                                        n>m orelse (n=m andalso d>e)
 
-		structure ItemList = ListOrdSet
-			(struct
-				type elem = item
-				val eq = eqItem
-				val gt = gtItem
-			end)
-		
-		open ItemList
-		datatype core = CORE of item list * int
+                structure ItemList = ListOrdSet
+                        (struct
+                                type elem = item
+                                val eq = eqItem
+                                val gt = gtItem
+                        end)
+                
+                open ItemList
+                datatype core = CORE of item list * int
 
-		val gtCore = fn (CORE (a,_),CORE (b,_)) => ItemList.set_gt(a,b)
-		val eqCore = fn (CORE (a,_),CORE (b,_)) => ItemList.set_eq(a,b)
+                val gtCore = fn (CORE (a,_),CORE (b,_)) => ItemList.set_gt(a,b)
+                val eqCore = fn (CORE (a,_),CORE (b,_)) => ItemList.set_eq(a,b)
 
-		(* functions for printing and debugging *)
+                (* functions for printing and debugging *)
 
-		 val prItem = fn (symbolToString,nontermToString,print) =>
-		   let val printInt = print o (Int.toString : int -> string)
-		       val prSymbol = print o symbolToString
-		       val prNonterm = print o nontermToString
-		       fun showRest nil = ()
-			 | showRest (h::t) = (prSymbol h; print " "; showRest t)
-		       fun showRhs (l,0) = (print ". "; showRest l)
-			 | showRhs (nil,_) = ()
-			 | showRhs (h::t,n) = (prSymbol h;
-					       print " ";
-					       showRhs(t,n-1))
-		   in fn (ITEM {rule=RULE {lhs,rhs,rulenum,num,...},
-				dot,rhsAfter,...}) =>
-			(prNonterm lhs; print " : "; showRhs(rhs,dot);
-		 	 case rhsAfter 
-			 of nil => (print " (reduce by rule "; 
-				    printInt rulenum;
-				    print ")")
-			  | _ => ();
-			  if DEBUG then 
-			     (print " (num "; printInt num; print ")")
-			  else ())
-		   end
+                 val prItem = fn (symbolToString,nontermToString,print) =>
+                   let val printInt = print o (Int.toString : int -> string)
+                       val prSymbol = print o symbolToString
+                       val prNonterm = print o nontermToString
+                       fun showRest nil = ()
+                         | showRest (h::t) = (prSymbol h; print " "; showRest t)
+                       fun showRhs (l,0) = (print ". "; showRest l)
+                         | showRhs (nil,_) = ()
+                         | showRhs (h::t,n) = (prSymbol h;
+                                               print " ";
+                                               showRhs(t,n-1))
+                   in fn (ITEM {rule=RULE {lhs,rhs,rulenum,num,...},
+                                dot,rhsAfter,...}) =>
+                        (prNonterm lhs; print " : "; showRhs(rhs,dot);
+                         case rhsAfter 
+                         of nil => (print " (reduce by rule "; 
+                                    printInt rulenum;
+                                    print ")")
+                          | _ => ();
+                          if DEBUG then 
+                             (print " (num "; printInt num; print ")")
+                          else ())
+                   end
 
-	         val prCore = fn a as (_,_,print) =>
-		    let val prItem = prItem a
-		    in fn (CORE (items,state)) =>
-			  (print "state ";
-			   print (Int.toString state);
-		   	   print ":\n\n";
-		   	   app (fn i => (print "\t";
-					 prItem i; print "\n")) items;
-			   print "\n")
-		    end
+                 val prCore = fn a as (_,_,print) =>
+                    let val prItem = prItem a
+                    in fn (CORE (items,state)) =>
+                          (print "state ";
+                           print (Int.toString state);
+                           print ":\n\n";
+                           app (fn i => (print "\t";
+                                         prItem i; print "\n")) items;
+                           print "\n")
+                    end
 end;

Modified: mlton/branches/on-20050420-cmm-branch/mlyacc/src/coreutils.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlyacc/src/coreutils.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlyacc/src/coreutils.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,48 +1,39 @@
-(* ML-Yacc Parser Generator (c) 1989 Andrew W. Appel, David R. Tarditi 
- *
- * $Log: coreutils.sml,v $
- * Revision 1.1.1.1  1997/01/14 01:38:05  george
- *   Version 109.24
- *
- * Revision 1.1.1.1  1996/01/31  16:01:45  george
- * Version 109
- * 
- *)
+(* ML-Yacc Parser Generator (c) 1989 Andrew W. Appel, David R. Tarditi *)
 
 functor mkCoreUtils(structure Core : CORE) : CORE_UTILS =
-	struct
-	        open Array List
-		infix 9 sub
-		val DEBUG = true
-		structure Core = Core
-		structure IntGrammar = Core.IntGrammar
-		structure Grammar = IntGrammar.Grammar
+        struct
+                open Array List
+                infix 9 sub
+                val DEBUG = true
+                structure Core = Core
+                structure IntGrammar = Core.IntGrammar
+                structure Grammar = IntGrammar.Grammar
 
-		open Grammar IntGrammar Core
+                open Grammar IntGrammar Core
 
-		structure Assoc = SymbolAssoc
+                structure Assoc = SymbolAssoc
 
-		structure NtList = ListOrdSet
-			(struct
-				type elem = nonterm
-				val eq = eqNonterm
-				val gt = gtNonterm
-			 end)
+                structure NtList = ListOrdSet
+                        (struct
+                                type elem = nonterm
+                                val eq = eqNonterm
+                                val gt = gtNonterm
+                         end)
 
-	val mkFuncs = fn (GRAMMAR {rules,terms,nonterms,...}) =>
-	   let val derives=array(nonterms,nil : rule list)
+        val mkFuncs = fn (GRAMMAR {rules,terms,nonterms,...}) =>
+           let val derives=array(nonterms,nil : rule list)
 
 (* sort rules by their lhs nonterminal by placing them in an array indexed
    in their lhs nonterminal *)
 
-	       val _ =
-		 let val f = fn {lhs=lhs as (NT n), rhs, precedence,rulenum} =>
-			let val rule=RULE{lhs=lhs,rhs=rhs,precedence=precedence,
-					  rulenum=rulenum,num=0}
-		        in update(derives,n,rule::(derives sub n))
-			end
-		  in app f rules
-		  end
+               val _ =
+                 let val f = fn {lhs=lhs as (NT n), rhs, precedence,rulenum} =>
+                        let val rule=RULE{lhs=lhs,rhs=rhs,precedence=precedence,
+                                          rulenum=rulenum,num=0}
+                        in update(derives,n,rule::(derives sub n))
+                        end
+                  in app f rules
+                  end
 
 (* renumber rules so that rule numbers increase monotonically with
    the number of their lhs nonterminal, and so that rules are numbered
@@ -51,62 +42,62 @@
    productions for nonterm i+1 are numbered from k+1 to m, and
    productions for nonterm 0 start at 0 *)
 
-		val _ =
-		   let val f =
-		         fn (RULE{lhs,rhs,precedence,rulenum,num}, (l,i)) =>
-			    (RULE{lhs=lhs,rhs=rhs, precedence=precedence,
-				  rulenum=rulenum, num=i}::l,i+1)
-			fun g(i,num) =
-		          if i<nonterms then
-			    let val (l,n) =
-				        List.foldr f ([], num) (derives sub i)
-			    in update(derives,i,rev l); g(i+1,n)
-			    end
-			  else ()
-		    in g(0,0)
-		    end
+                val _ =
+                   let val f =
+                         fn (RULE{lhs,rhs,precedence,rulenum,num}, (l,i)) =>
+                            (RULE{lhs=lhs,rhs=rhs, precedence=precedence,
+                                  rulenum=rulenum, num=i}::l,i+1)
+                        fun g(i,num) =
+                          if i<nonterms then
+                            let val (l,n) =
+                                        List.foldr f ([], num) (derives sub i)
+                            in update(derives,i,rev l); g(i+1,n)
+                            end
+                          else ()
+                    in g(0,0)
+                    end
 
 (* list of rules - sorted by rule number. *)
 
-		 val rules = 
-		     let fun g i =
-			if i < nonterms then (derives sub i) @ (g (i+1))
-			else nil
-		     in g 0
-		     end
+                 val rules = 
+                     let fun g i =
+                        if i < nonterms then (derives sub i) @ (g (i+1))
+                        else nil
+                     in g 0
+                     end
 
 (* produces: set of productions with nonterminal n as the lhs.  The set
    of productions *must* be sorted by rule number, because functions
    below assume that this list is sorted *)
 
-		val produces = fn (NT n) =>
-		  if DEBUG andalso (n<0 orelse n>=nonterms) then
-		     let exception Produces of int in raise (Produces n) end
-		  else derives sub n
+                val produces = fn (NT n) =>
+                  if DEBUG andalso (n<0 orelse n>=nonterms) then
+                     let exception Produces of int in raise (Produces n) end
+                  else derives sub n
 
-		val memoize = fn f =>
-		   let fun loop i = if i = nonterms then nil
-				  else f (NT i) :: (loop (i+1))
-		       val data = Array.fromList(loop 0)
-		   in fn (NT i) => data sub i
-		   end
+                val memoize = fn f =>
+                   let fun loop i = if i = nonterms then nil
+                                  else f (NT i) :: (loop (i+1))
+                       val data = Array.fromList(loop 0)
+                   in fn (NT i) => data sub i
+                   end
 
  (* compute nonterminals which must be added to a closure when a given
     nonterminal is added, i.e all nonterminals C for each nonterminal A such
     that A =*=> Cx *)
 
-		val nontermClosure =
-			let val collectNonterms = fn n =>
-			      List.foldr (fn (r,l) =>
-				  case r
-				  of RULE {rhs=NONTERM n :: _,...} =>
-					    NtList.insert(n,l)
-				   | _ => l) NtList.empty (produces n)
-			    val closureNonterm = fn n =>
-				   NtList.closure(NtList.singleton n,
-						  collectNonterms)
-			in memoize closureNonterm
-			end
+                val nontermClosure =
+                        let val collectNonterms = fn n =>
+                              List.foldr (fn (r,l) =>
+                                  case r
+                                  of RULE {rhs=NONTERM n :: _,...} =>
+                                            NtList.insert(n,l)
+                                   | _ => l) NtList.empty (produces n)
+                            val closureNonterm = fn n =>
+                                   NtList.closure(NtList.singleton n,
+                                                  collectNonterms)
+                        in memoize closureNonterm
+                        end
 
 (* ntShifts: Take the items produced by a nonterminal, and sort them
    by their first symbol.  For each first symbol, make sure the item
@@ -120,36 +111,36 @@
    already in order, the list for each symbol will also end up in order.
  *)
 
-		fun sortItems nt =
-		 let fun add_item (a as RULE{rhs=symbol::rest,...},r) =
-		       let val item = ITEM{rule=a,dot=1,rhsAfter=rest}
-		       in Assoc.insert((symbol,case Assoc.find (symbol,r)
-			  			of SOME l => item::l
-			   			 | NONE => [item]),r)
-		       end
-		       | add_item (_,r) = r
-		 in List.foldr add_item Assoc.empty (produces nt)
-		 end
+                fun sortItems nt =
+                 let fun add_item (a as RULE{rhs=symbol::rest,...},r) =
+                       let val item = ITEM{rule=a,dot=1,rhsAfter=rest}
+                       in Assoc.insert((symbol,case Assoc.find (symbol,r)
+                                                of SOME l => item::l
+                                                 | NONE => [item]),r)
+                       end
+                       | add_item (_,r) = r
+                 in List.foldr add_item Assoc.empty (produces nt)
+                 end
 
-		 val ntShifts = memoize sortItems
+                 val ntShifts = memoize sortItems
 
 (* getNonterms: get the nonterminals with a .  before them in a core.
    Returns a list of nonterminals in ascending order *)
 
-		fun getNonterms l =
-		  List.foldr (fn (ITEM {rhsAfter=NONTERM sym ::_, ...},r) =>
-				NtList.insert(sym,r)
-			      | (_,r) => r) [] l
+                fun getNonterms l =
+                  List.foldr (fn (ITEM {rhsAfter=NONTERM sym ::_, ...},r) =>
+                                NtList.insert(sym,r)
+                              | (_,r) => r) [] l
 
 (* closureNonterms: compute the nonterminals that would have a . before them
    in the closure of the core.  Returns a list of nonterminals in ascending
    order *)
-		fun closureNonterms a =
-			let val nonterms = getNonterms a
-		 	in List.foldr (fn (nt,r) =>
-				   NtList.union(nontermClosure nt,r))
-			   nonterms nonterms
-			end
+                fun closureNonterms a =
+                        let val nonterms = getNonterms a
+                        in List.foldr (fn (nt,r) =>
+                                   NtList.union(nontermClosure nt,r))
+                           nonterms nonterms
+                        end
 
 (* shifts: compute the core sets that result from shift/gotoing on 
    the closure of a kernal set.  The items in core sets are sorted, of
@@ -172,64 +163,64 @@
 back to front (=> that the items end up in ascending order), and never had any
 duplicate items (each item is derived from only one nonterminal). *)
 
-	fun shifts (CORE (itemList,_)) =
-	    let
+        fun shifts (CORE (itemList,_)) =
+            let
 
 (* mergeShiftItems: add an item list for a shift/goto symbol to the table *)
 
 fun mergeShiftItems (args as ((k,l),r)) =
-		  case Assoc.find(k,r)
-		  of NONE => Assoc.insert args
-		   | SOME old => Assoc.insert ((k,l@old),r)
+                  case Assoc.find(k,r)
+                  of NONE => Assoc.insert args
+                   | SOME old => Assoc.insert ((k,l@old),r)
 
 (* mergeItems: add all items derived from a nonterminal to the table.  We've
    kept these items sorted by their shift/goto symbol (the first symbol on
    their rhs) *)
 
-		fun mergeItems (n,r) =
-			Assoc.fold mergeShiftItems (ntShifts n) r
+                fun mergeItems (n,r) =
+                        Assoc.fold mergeShiftItems (ntShifts n) r
 
 (* nonterms: a list of nonterminals that are in a core after the
    closure operation *)
 
-		val nonterms = closureNonterms itemList
+                val nonterms = closureNonterms itemList
 
 (* now create a table which for each shift/goto symbol gives the sorted list
    of closure items which would result from first taking all the closure items
    and then sorting them by the shift/goto symbols *)
 
-		val newsets = List.foldr mergeItems Assoc.empty nonterms
+                val newsets = List.foldr mergeItems Assoc.empty nonterms
 
 (* finally prepare to insert the kernal items of a core *)
 
-		fun insertItem ((k,i),r) =
-		   case (Assoc.find(k,r))
-		     of NONE => Assoc.insert((k,[i]),r)
-		      | SOME l => Assoc.insert((k,Core.insert(i,l)),r)
-		fun shiftCores(ITEM{rule,dot,rhsAfter=symbol::rest},r) =
-		   insertItem((symbol,
-			      ITEM{rule=rule,dot=dot+1,rhsAfter=rest}),r)
-		  | shiftCores(_,r) = r
+                fun insertItem ((k,i),r) =
+                   case (Assoc.find(k,r))
+                     of NONE => Assoc.insert((k,[i]),r)
+                      | SOME l => Assoc.insert((k,Core.insert(i,l)),r)
+                fun shiftCores(ITEM{rule,dot,rhsAfter=symbol::rest},r) =
+                   insertItem((symbol,
+                              ITEM{rule=rule,dot=dot+1,rhsAfter=rest}),r)
+                  | shiftCores(_,r) = r
 
 (* insert the kernal items of a core *)
 
-		val newsets = List.foldr shiftCores newsets itemList
-	   in Assoc.make_list newsets
-	   end
+                val newsets = List.foldr shiftCores newsets itemList
+           in Assoc.make_list newsets
+           end
 
 (* nontermEpsProds: returns a list of epsilon productions produced by a
    nonterminal sorted by rule number. ** Depends on produces returning
    an ordered list **.  It does not alter the order in which the rules
    were returned by produces; it only removes non-epsilon productions *)
 
-	   val nontermEpsProds =
-	      let val f = fn nt =>
-		  List.foldr
-		    (fn (rule as RULE {rhs=nil,...},results) => rule :: results
-		      | (_,results) => results)
-		    [] (produces nt)
-	       in memoize f
-	       end 
+           val nontermEpsProds =
+              let val f = fn nt =>
+                  List.foldr
+                    (fn (rule as RULE {rhs=nil,...},results) => rule :: results
+                      | (_,results) => results)
+                    [] (produces nt)
+               in memoize f
+               end 
 
 (* epsProds: take a core and compute a list of epsilon productions for it
    sorted by rule number.  ** Depends on closureNonterms returning a list
@@ -238,10 +229,10 @@
    an ordered item list for each production 
 *)
 
-	fun epsProds (CORE (itemList,state)) =
-	   let val prods = map nontermEpsProds (closureNonterms itemList)
-	   in List.concat prods
-	   end
+        fun epsProds (CORE (itemList,state)) =
+           let val prods = map nontermEpsProds (closureNonterms itemList)
+           in List.concat prods
+           end
 
      in {produces=produces,shifts=shifts,rules=rules,epsProds=epsProds}
      end

Modified: mlton/branches/on-20050420-cmm-branch/mlyacc/src/export-yacc.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlyacc/src/export-yacc.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlyacc/src/export-yacc.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,36 +1,10 @@
 (* export-yacc.sml
  *
  * ML-Yacc Parser Generator (c) 1991 Andrew W. Appel, David R. Tarditi
- *
- * $Log: export-yacc.sml,v $
- * Revision 1.1.1.1  1998/04/08 18:40:16  george
- * Version 110.5
- *
- * Revision 1.2  1997/03/03 17:10:37  george
- * moved callcc related functions to SMLofNJ.Cont
- *
-# Revision 1.1.1.1  1997/01/14  01:38:05  george
-#   Version 109.24
-#
- * Revision 1.3  1996/02/26  16:55:22  jhr
- * Moved exportFn/exportML to SMLofNJ structure.
- *
- * Revision 1.2  1996/02/26  15:02:32  george
- *    print no longer overloaded.
- *    use of makestring has been removed and replaced with Int.toString ..
- *    use of IO replaced with TextIO
- *
- * Revision 1.1.1.1  1996/01/31  16:01:45  george
- * Version 109
- * 
  *)
-
 structure ExportParseGen : sig
-
     val parseGen : (string * string list) -> OS.Process.status
-    val export : string -> unit
-
-  end = struct
+end = struct
     fun err msg = TextIO.output (TextIO.stdErr, msg)
 
     exception Interrupt;
@@ -57,22 +31,16 @@
     val exit = OS.Process.exit
 
     fun parseGen (_, argv) = let
-	  fun parse_gen () = (case argv
-		 of [file] => (ParseGen.parseGen file; exit OS.Process.success)
-		  | _ => (err("Usage: ml-yacc filename\n"); exit OS.Process.failure)
-		(* end case *))
-	  in
-	    (handleInterrupt parse_gen; OS.Process.success)
-	      handle Interrupt => OS.Process.failure
-		   | ex => (
-			err (String.concat[
-			    "? ml-yacc: uncaught exception ", exnMessage ex, "\n"
-			  ]);
-			OS.Process.failure)
-	  end
-
-fun export heap = SMLofNJ.exportFn(heap, parseGen);
-
-  end;
-
-
+        fun parse_gen () =
+            case argv of
+                [file] => (ParseGen.parseGen file; exit OS.Process.success)
+              | _ => (err("Usage: ml-yacc filename\n");
+                      exit OS.Process.failure)
+    in
+        (handleInterrupt parse_gen; OS.Process.success)
+        handle Interrupt => OS.Process.failure
+             | ex => (err (String.concat ["? ml-yacc: uncaught exception ",
+                                          General.exnMessage ex, "\n"]);
+                      OS.Process.failure)
+    end
+end

Modified: mlton/branches/on-20050420-cmm-branch/mlyacc/src/grammar.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlyacc/src/grammar.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlyacc/src/grammar.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,114 +1,101 @@
-(* ML-Yacc Parser Generator (c) 1989 Andrew W. Appel, David R. Tarditi 
- *
- * $Log: grammar.sml,v $
- * Revision 1.1.1.1  1997/01/14 01:38:05  george
- *   Version 109.24
- *
- * Revision 1.2  1996/02/26  15:02:33  george
- *    print no longer overloaded.
- *    use of makestring has been removed and replaced with Int.toString ..
- *    use of IO replaced with TextIO
- *
- * Revision 1.1.1.1  1996/01/31  16:01:45  george
- * Version 109
- * 
- *)
+(* ML-Yacc Parser Generator (c) 1989 Andrew W. Appel, David R. Tarditi *)
 
 structure Grammar : GRAMMAR =
-	struct
+        struct
 
-		(* define types term and nonterm using those in LrTable
-		   datatype term = T of int 
-		   datatype nonterm = NT of int *)
+                (* define types term and nonterm using those in LrTable
+                   datatype term = T of int 
+                   datatype nonterm = NT of int *)
 
-		open LrTable
-		datatype symbol = TERM of term | NONTERM of nonterm
-		datatype grammar = GRAMMAR of
-				{rules: {lhs: nonterm,
-				 	 rhs: symbol list, 
-				 	 precedence: int option,
-				 	 rulenum: int} list,
-				noshift : term list,
-				eop : term list,
-				terms: int,
-				nonterms: int,
-				start : nonterm,
-				precedence : term -> int option,
-				termToString : term -> string,
-				nontermToString : nonterm -> string}
+                open LrTable
+                datatype symbol = TERM of term | NONTERM of nonterm
+                datatype grammar = GRAMMAR of
+                                {rules: {lhs: nonterm,
+                                         rhs: symbol list, 
+                                         precedence: int option,
+                                         rulenum: int} list,
+                                noshift : term list,
+                                eop : term list,
+                                terms: int,
+                                nonterms: int,
+                                start : nonterm,
+                                precedence : term -> int option,
+                                termToString : term -> string,
+                                nontermToString : nonterm -> string}
 end;
 
 structure IntGrammar : INTGRAMMAR =
-	struct
-		structure Grammar = Grammar
-		open Grammar
+        struct
+                structure Grammar = Grammar
+                open Grammar
 
-		datatype rule = RULE of
-			 	{lhs: nonterm,
-				 rhs: symbol list,
-				 num: int,(* internal # assigned by coreutils *)
-				 rulenum: int,
-				 precedence: int option}
-		
-		val eqTerm = (op =)
-		val gtTerm = fn (T i,T j) => i>j
+                datatype rule = RULE of
+                                {lhs: nonterm,
+                                 rhs: symbol list,
+                                 num: int,(* internal # assigned by coreutils *)
+                                 rulenum: int,
+                                 precedence: int option}
+                
+                val eqTerm : term * term -> bool = (op =)
+                val gtTerm : term * term -> bool = fn (T i,T j) => i>j
 
-		val eqNonterm = (op =)
-		val gtNonterm = fn (NT i,NT j) => i>j
+                val eqNonterm : nonterm * nonterm -> bool = (op =)
+                val gtNonterm : nonterm * nonterm -> bool =
+                    fn (NT i,NT j) => i>j
 
-		val eqSymbol = (op =)
-		val gtSymbol = fn (TERM (T i),TERM (T j)) => i>j
-				| (NONTERM (NT i),NONTERM (NT j)) => i>j
-				| (TERM _,NONTERM _) => false
-				| (NONTERM _,TERM _) => true
+                val eqSymbol : symbol * symbol -> bool = (op =)
+                val gtSymbol = fn (TERM (T i),TERM (T j)) => i>j
+                                | (NONTERM (NT i),NONTERM (NT j)) => i>j
+                                | (TERM _,NONTERM _) => false
+                                | (NONTERM _,TERM _) => true
 
 
-		structure SymbolAssoc = Table(type key = symbol
-					      val gt = gtSymbol)
+                structure SymbolAssoc = Table(type key = symbol
+                                              val gt = gtSymbol)
 
-		structure NontermAssoc = Table(type key =  nonterm
-					       val gt = gtNonterm)
+                structure NontermAssoc = Table(type key =  nonterm
+                                               val gt = gtNonterm)
 
-		val DEBUG = false
+                val DEBUG = false
 
-		val prRule = fn (a as symbolToString,nontermToString,print) =>
-		   let val printSymbol = print o symbolToString
-		       fun printRhs (h::t) = (printSymbol h; print " ";
-					      printRhs t)
-			 | printRhs nil = ()
-		   in fn (RULE {lhs,rhs,num,rulenum,precedence,...}) =>
-			((print o nontermToString) lhs; print " : ";
-			 printRhs rhs;
-			 if DEBUG then (print " num = ";
-					print (Int.toString num);
-					print " rulenum = ";
-					print (Int.toString rulenum);
-					print " precedence = ";
-					case precedence
-					    of NONE => print " none"
-					     | (SOME i) =>
-						 print (Int.toString i);
-					())
-			else ())
-		   end
-			
-		val prGrammar =
-			 fn (a as (symbolToString,nontermToString,print)) =>
-			     fn (GRAMMAR {rules,terms,nonterms,start,...}) =>
-		 let val printRule =
-			let val prRule = prRule a
-			in  fn {lhs,rhs,precedence,rulenum} =>
-		   	     (prRule (RULE {lhs=lhs,rhs=rhs,num=0,
-				      rulenum=rulenum, precedence=precedence});
-			      print "\n")
-			end
-		 in print "grammar = \n";
-		    List.app printRule rules;
-		    print "\n";
-		    print (" terms = " ^ (Int.toString terms) ^
-			     " nonterms = " ^ (Int.toString nonterms) ^
-			     " start = ");
-		    (print o nontermToString) start;
-		    ()
-		 end
-	end;
+                val prRule = fn (a as symbolToString,nontermToString,print) =>
+                   let val printSymbol = print o symbolToString
+                       fun printRhs (h::t) = (printSymbol h; print " ";
+                                              printRhs t)
+                         | printRhs nil = ()
+                   in fn (RULE {lhs,rhs,num,rulenum,precedence,...}) =>
+                        ((print o nontermToString) lhs; print " : ";
+                         printRhs rhs;
+                         if DEBUG then (print " num = ";
+                                        print (Int.toString num);
+                                        print " rulenum = ";
+                                        print (Int.toString rulenum);
+                                        print " precedence = ";
+                                        case precedence
+                                            of NONE => print " none"
+                                             | (SOME i) =>
+                                                 print (Int.toString i);
+                                        ())
+                        else ())
+                   end
+                        
+                val prGrammar =
+                         fn (a as (symbolToString,nontermToString,print)) =>
+                             fn (GRAMMAR {rules,terms,nonterms,start,...}) =>
+                 let val printRule =
+                        let val prRule = prRule a
+                        in  fn {lhs,rhs,precedence,rulenum} =>
+                             (prRule (RULE {lhs=lhs,rhs=rhs,num=0,
+                                      rulenum=rulenum, precedence=precedence});
+                              print "\n")
+                        end
+                 in print "grammar = \n";
+                    List.app printRule rules;
+                    print "\n";
+                    print (" terms = " ^ (Int.toString terms) ^
+                             " nonterms = " ^ (Int.toString nonterms) ^
+                             " start = ");
+                    (print o nontermToString) start;
+                    ()
+                 end
+        end;

Modified: mlton/branches/on-20050420-cmm-branch/mlyacc/src/graph.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlyacc/src/graph.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlyacc/src/graph.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,113 +1,99 @@
-(* ML-Yacc Parser Generator (c) 1989 Andrew W. Appel, David R. Tarditi 
- *
- * $Log: graph.sml,v $
- * Revision 1.1.1.1  1997/01/14 01:38:05  george
- *   Version 109.24
- *
- * Revision 1.2  1996/02/26  15:02:34  george
- *    print no longer overloaded.
- *    use of makestring has been removed and replaced with Int.toString ..
- *    use of IO replaced with TextIO
- *
- * Revision 1.1.1.1  1996/01/31  16:01:45  george
- * Version 109
- * 
- *)
+(* ML-Yacc Parser Generator (c) 1989 Andrew W. Appel, David R. Tarditi *)
 
 functor mkGraph(structure IntGrammar : INTGRAMMAR
-		structure Core : CORE
-		structure CoreUtils : CORE_UTILS
-		sharing IntGrammar = Core.IntGrammar = CoreUtils.IntGrammar
-		sharing CoreUtils.Core = Core
-		) : LRGRAPH =
-	struct
-	        open Array List
-		infix 9 sub
-		structure Core = Core
-		structure Grammar = IntGrammar.Grammar
-		structure IntGrammar = IntGrammar
-		open Core Core.Grammar CoreUtils IntGrammar
+                structure Core : CORE
+                structure CoreUtils : CORE_UTILS
+                sharing IntGrammar = Core.IntGrammar = CoreUtils.IntGrammar
+                sharing CoreUtils.Core = Core
+                ) : LRGRAPH =
+        struct
+                open Array List
+                infix 9 sub
+                structure Core = Core
+                structure Grammar = IntGrammar.Grammar
+                structure IntGrammar = IntGrammar
+                open Core Core.Grammar CoreUtils IntGrammar
 
-		structure NodeSet = RbOrdSet
-			(struct
-				type elem = core
-				val eq = eqCore
-				val gt = gtCore
-			end)
+                structure NodeSet = RbOrdSet
+                        (struct
+                                type elem = core
+                                val eq = eqCore
+                                val gt = gtCore
+                        end)
 
-		open NodeSet
-		exception Shift of int * symbol
+                open NodeSet
+                exception Shift of int * symbol
 
-		type graph = {edges: {edge:symbol,to:core} list array,
-			      nodes: core list,nodeArray : core array}
-		val edges = fn (CORE (_,i),{edges,...}:graph) => edges sub i
-		val nodes = fn ({nodes,...} : graph) => nodes
-		val shift = fn ({edges,nodes,...} : graph) => fn a as (i,sym) =>
-			let fun find nil = raise (Shift a)
-			      | find ({edge,to=CORE (_,state)} :: r) =
-					if gtSymbol(sym,edge) then find r
-					else if eqSymbol(edge,sym) then state
-					else raise (Shift a)
-			in find (edges sub i)
-			end
+                type graph = {edges: {edge:symbol,to:core} list array,
+                              nodes: core list,nodeArray : core array}
+                val edges = fn (CORE (_,i),{edges,...}:graph) => edges sub i
+                val nodes = fn ({nodes,...} : graph) => nodes
+                val shift = fn ({edges,nodes,...} : graph) => fn a as (i,sym) =>
+                        let fun find nil = raise (Shift a)
+                              | find ({edge,to=CORE (_,state)} :: r) =
+                                        if gtSymbol(sym,edge) then find r
+                                        else if eqSymbol(edge,sym) then state
+                                        else raise (Shift a)
+                        in find (edges sub i)
+                        end
 
-		val core = fn ({nodeArray,...} : graph) =>
-				 fn i => nodeArray sub i
+                val core = fn ({nodeArray,...} : graph) =>
+                                 fn i => nodeArray sub i
 
-		val mkGraph = fn (g as (GRAMMAR {start,...})) =>
-		   let val {shifts,produces,rules,epsProds} =
-				  CoreUtils.mkFuncs g
-		       fun add_goto ((symbol,a),(nodes,edges,future,num)) =
-				case find(CORE (a,0),nodes)
-				  of NONE =>
-				     let val core =CORE (a,num)
-					 val edge = {edge=symbol,to=core}
-				     in (insert(core,nodes),edge::edges,
-					 core::future,num+1)
-				     end
-				   | (SOME c) =>
-					let val edge={edge=symbol,to=c}
-					in (nodes,edge::edges,future,num)
-					end
-		       fun f (nodes,node_list,edge_list,nil,nil,num) =
-			    let val nodes=rev node_list
-			    in {nodes=nodes,
-				edges=Array.fromList (rev edge_list),
-				nodeArray = Array.fromList nodes
-			 	}
-			    end
-			 | f (nodes,node_list,edge_list,nil,y,num) =
-				f (nodes,node_list,edge_list,rev y,nil,num)
-			 | f (nodes,node_list,edge_list,h::t,y,num) =
-			 	let val (nodes,edges,future,num) =
-				   List.foldr add_goto (nodes,[],y,num) (shifts h)
-				in f (nodes,h::node_list,
-				       edges::edge_list,t,future,num)
-				end
-		in {graph=
-		   let val makeItem = fn (r as (RULE {rhs,...})) =>
-						ITEM{rule=r,dot=0,rhsAfter=rhs}
-			val initialItemList = map makeItem (produces start)
-		        val orderedItemList =
-			   List.foldr Core.insert [] initialItemList
- 			val initial = CORE (orderedItemList,0)
-		   in f(empty,nil,nil,[initial],nil,1)
-		   end,
-		   produces=produces,
-		   rules=rules,
-		   epsProds=epsProds}
-		end
-	val prGraph = fn a as (nontermToString,termToString,print) => fn g =>
-	   let val printCore = prCore a
-	       val printSymbol = print o nontermToString
-	       val nodes = nodes g
-	       val printEdges = fn n => 
-		 List.app (fn {edge,to=CORE (_,state)} =>
-			(print "\tshift on ";
-			 printSymbol edge;
-			 print " to ";
-			 print (Int.toString state);
-			 print "\n")) (edges (n,g))
-	 in List.app (fn c => (printCore c; print "\n"; printEdges c)) nodes
-	 end
+                val mkGraph = fn (g as (GRAMMAR {start,...})) =>
+                   let val {shifts,produces,rules,epsProds} =
+                                  CoreUtils.mkFuncs g
+                       fun add_goto ((symbol,a),(nodes,edges,future,num)) =
+                                case find(CORE (a,0),nodes)
+                                  of NONE =>
+                                     let val core =CORE (a,num)
+                                         val edge = {edge=symbol,to=core}
+                                     in (insert(core,nodes),edge::edges,
+                                         core::future,num+1)
+                                     end
+                                   | (SOME c) =>
+                                        let val edge={edge=symbol,to=c}
+                                        in (nodes,edge::edges,future,num)
+                                        end
+                       fun f (nodes,node_list,edge_list,nil,nil,num) =
+                            let val nodes=rev node_list
+                            in {nodes=nodes,
+                                edges=Array.fromList (rev edge_list),
+                                nodeArray = Array.fromList nodes
+                                }
+                            end
+                         | f (nodes,node_list,edge_list,nil,y,num) =
+                                f (nodes,node_list,edge_list,rev y,nil,num)
+                         | f (nodes,node_list,edge_list,h::t,y,num) =
+                                let val (nodes,edges,future,num) =
+                                   List.foldr add_goto (nodes,[],y,num) (shifts h)
+                                in f (nodes,h::node_list,
+                                       edges::edge_list,t,future,num)
+                                end
+                in {graph=
+                   let val makeItem = fn (r as (RULE {rhs,...})) =>
+                                                ITEM{rule=r,dot=0,rhsAfter=rhs}
+                        val initialItemList = map makeItem (produces start)
+                        val orderedItemList =
+                           List.foldr Core.insert [] initialItemList
+                        val initial = CORE (orderedItemList,0)
+                   in f(empty,nil,nil,[initial],nil,1)
+                   end,
+                   produces=produces,
+                   rules=rules,
+                   epsProds=epsProds}
+                end
+        val prGraph = fn a as (nontermToString,termToString,print) => fn g =>
+           let val printCore = prCore a
+               val printSymbol = print o nontermToString
+               val nodes = nodes g
+               val printEdges = fn n => 
+                 List.app (fn {edge,to=CORE (_,state)} =>
+                        (print "\tshift on ";
+                         printSymbol edge;
+                         print " to ";
+                         print (Int.toString state);
+                         print "\n")) (edges (n,g))
+         in List.app (fn c => (printCore c; print "\n"; printEdges c)) nodes
+         end
 end;

Modified: mlton/branches/on-20050420-cmm-branch/mlyacc/src/hdr.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlyacc/src/hdr.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlyacc/src/hdr.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,6 @@
+(* Modified by mfluet@acm.org on 2005-8-01.
+ * Update with SML/NJ 110.55+.
+ *)
 (* Modified by sweeks@acm.org on 2000-8-24.
  * Ported to MLton.
  *)
@@ -3,124 +6,107 @@
 type int = Int.int
    
-(* ML-Yacc Parser Generator (c) 1989 Andrew W. Appel, David R. Tarditi 
- *
- * $Log: hdr.sml,v $
- * Revision 1.1.1.1  1998/04/08 18:40:16  george
- * Version 110.5
- *
- * Revision 1.1.1.1  1997/01/14 01:38:05  george
- *   Version 109.24
- *
- * Revision 1.2  1996/02/26  15:02:34  george
- *    print no longer overloaded.
- *    use of makestring has been removed and replaced with Int.toString ..
- *    use of IO replaced with TextIO
- *
- * Revision 1.1.1.1  1996/01/31  16:01:45  george
- * Version 109
- * 
- *)
+(* ML-Yacc Parser Generator (c) 1989 Andrew W. Appel, David R. Tarditi *)
 
 functor HeaderFun () : HEADER =
   struct
-	val DEBUG = true
+        val DEBUG = true
 
-	type pos = int
+        type pos = int
         val lineno: int ref = ref 0
         val text = ref (nil: string list)
         type inputSource = {name : string,
-			    errStream : TextIO.outstream,
-			    inStream : TextIO.instream,
-			    errorOccurred : bool ref}
+                            errStream : TextIO.outstream,
+                            inStream : TextIO.instream,
+                            errorOccurred : bool ref}
 
-	val newSource = 
-	  fn (s : string,i : TextIO.instream ,errs : TextIO.outstream) =>
-	      {name=s,errStream=errs,inStream=i,
-	       errorOccurred = ref false}
-			
-	val errorOccurred = fn (s : inputSource) =>fn () => !(#errorOccurred s)
+        val newSource = 
+          fn (s : string,i : TextIO.instream ,errs : TextIO.outstream) =>
+              {name=s,errStream=errs,inStream=i,
+               errorOccurred = ref false}
+                        
+        val errorOccurred = fn (s : inputSource) =>fn () => !(#errorOccurred s)
 
-	val pr = fn out : TextIO.outstream => fn s : string => TextIO.output(out,s)
+        val pr = fn out : TextIO.outstream => fn s : string => TextIO.output(out,s)
 
-	val error = fn {name,errStream, errorOccurred,...} : inputSource =>
-	      let val pr = pr errStream
-	      in fn l : pos => fn msg : string =>
-	          (pr name; pr ", line "; pr (Int.toString l); pr ": Error: ";
-	           pr msg; pr "\n"; errorOccurred := true)
-	      end
+        val error = fn {name,errStream, errorOccurred,...} : inputSource =>
+              let val pr = pr errStream
+              in fn l : pos => fn msg : string =>
+                  (pr name; pr ", line "; pr (Int.toString l); pr ": Error: ";
+                   pr msg; pr "\n"; errorOccurred := true)
+              end
 
-	val warn = fn {name,errStream, errorOccurred,...} : inputSource =>
-	      let val pr = pr errStream
-	      in fn l : pos => fn msg : string =>
-	          (pr name; pr ", line "; pr (Int.toString l); pr ": Warning: ";
-	           pr msg; pr "\n")
-	      end
+        val warn = fn {name,errStream, errorOccurred,...} : inputSource =>
+              let val pr = pr errStream
+              in fn l : pos => fn msg : string =>
+                  (pr name; pr ", line "; pr (Int.toString l); pr ": Warning: ";
+                   pr msg; pr "\n")
+              end
 
         datatype prec = LEFT | RIGHT | NONASSOC
 
-	datatype symbol = SYMBOL of string * pos
+        datatype symbol = SYMBOL of string * pos
         val symbolName = fn SYMBOL(s,_) => s
         val symbolPos = fn SYMBOL(_,p) => p
         val symbolMake = fn sp => SYMBOL sp
     
-	type ty = string
+        type ty = string
         val tyName = fn i => i
         val tyMake = fn i => i
  
-	datatype control = NODEFAULT | VERBOSE | PARSER_NAME of symbol |
-			   FUNCTOR of string  | START_SYM of symbol |
-			   NSHIFT of symbol list | POS of string | PURE |
-			   PARSE_ARG of string * string |
-			   TOKEN_SIG_INFO of string
-			   
-	datatype declData = DECL of
-			{eop : symbol list,
-			 keyword : symbol list,
-			 nonterm : (symbol*ty option) list option,
-			 prec : (prec * (symbol list)) list,
-			 change: (symbol list * symbol list) list,
-			 term : (symbol* ty option) list option,
-			 control : control list,
-			 value : (symbol * string) list}
+        datatype control = NODEFAULT | VERBOSE | PARSER_NAME of symbol |
+                           FUNCTOR of string  | START_SYM of symbol |
+                           NSHIFT of symbol list | POS of string | PURE |
+                           PARSE_ARG of string * string |
+                           TOKEN_SIG_INFO of string
+                           
+        datatype declData = DECL of
+                        {eop : symbol list,
+                         keyword : symbol list,
+                         nonterm : (symbol*ty option) list option,
+                         prec : (prec * (symbol list)) list,
+                         change: (symbol list * symbol list) list,
+                         term : (symbol* ty option) list option,
+                         control : control list,
+                         value : (symbol * string) list}
 
-	type rhsData = {rhs:symbol list,code:string, prec:symbol option} list
-	datatype rule = RULE of {lhs : symbol, rhs : symbol list,
-		                 code : string, prec : symbol option}
+        type rhsData = {rhs:symbol list,code:string, prec:symbol option} list
+        datatype rule = RULE of {lhs : symbol, rhs : symbol list,
+                                 code : string, prec : symbol option}
 
- 	type parseResult = string * declData * rule list
+        type parseResult = string * declData * rule list
         val getResult = fn p => p
 
-	fun join_decls
-	      (DECL {eop=e,control=c,keyword=k,nonterm=n,prec,
-		change=su,term=t,value=v}:declData,
-	       DECL {eop=e',control=c',keyword=k',nonterm=n',prec=prec',
-		     change=su',term=t',value=v'} : declData,
+        fun join_decls
+              (DECL {eop=e,control=c,keyword=k,nonterm=n,prec,
+                change=su,term=t,value=v}:declData,
+               DECL {eop=e',control=c',keyword=k',nonterm=n',prec=prec',
+                     change=su',term=t',value=v'} : declData,
                inputSource,pos) =
-	  let val ignore = fn s => 
-	                (warn inputSource pos ("ignoring duplicate " ^ s ^
-					    " declaration"))
-	      val join = fn (e,NONE,NONE) => NONE
-			  | (e,NONE,a) => a
-			  | (e,a,NONE) => a
-			  | (e,a,b) => (ignore e; a)
-	      fun mergeControl (nil,a) = [a]
-		| mergeControl (l as h::t,a) =
-		     case (h,a)
-	  	     of (PARSER_NAME _,PARSER_NAME n1) => (ignore "%name"; l)
-		      | (FUNCTOR _,FUNCTOR _) => (ignore "%header"; l)
-		      | (PARSE_ARG _,PARSE_ARG _) => (ignore "%arg"; l)
-		      | (START_SYM _,START_SYM s) => (ignore "%start"; l)
-		      | (POS _,POS _) => (ignore "%pos"; l)
-		      | (TOKEN_SIG_INFO _, TOKEN_SIG_INFO _)
-			 => (ignore "%token_sig_info"; l)
-		      | (NSHIFT a,NSHIFT b) => (NSHIFT (a@b)::t)
-		      | _ => h :: mergeControl(t,a)
-	      fun loop (nil,r) = r
-		| loop (h::t,r) = loop(t,mergeControl(r,h))
-	 in DECL {eop=e@e',control=loop(c',c),keyword=k'@k,
-	    nonterm=join("%nonterm",n,n'), prec=prec@prec',
-	    change=su@su', term=join("%term",t,t'),value=v@v'} :
-	           declData
-	end
+          let val ignore = fn s => 
+                        (warn inputSource pos ("ignoring duplicate " ^ s ^
+                                            " declaration"))
+              val join = fn (e,NONE,NONE) => NONE
+                          | (e,NONE,a) => a
+                          | (e,a,NONE) => a
+                          | (e,a,b) => (ignore e; a)
+              fun mergeControl (nil,a) = [a]
+                | mergeControl (l as h::t,a) =
+                     case (h,a)
+                     of (PARSER_NAME _,PARSER_NAME n1) => (ignore "%name"; l)
+                      | (FUNCTOR _,FUNCTOR _) => (ignore "%header"; l)
+                      | (PARSE_ARG _,PARSE_ARG _) => (ignore "%arg"; l)
+                      | (START_SYM _,START_SYM s) => (ignore "%start"; l)
+                      | (POS _,POS _) => (ignore "%pos"; l)
+                      | (TOKEN_SIG_INFO _, TOKEN_SIG_INFO _)
+                         => (ignore "%token_sig_info"; l)
+                      | (NSHIFT a,NSHIFT b) => (NSHIFT (a@b)::t)
+                      | _ => h :: mergeControl(t,a)
+              fun loop (nil,r) = r
+                | loop (h::t,r) = loop(t,mergeControl(r,h))
+         in DECL {eop=e@e',control=loop(c',c),keyword=k'@k,
+            nonterm=join("%nonterm",n,n'), prec=prec@prec',
+            change=su@su', term=join("%term",t,t'),value=v@v'} :
+                   declData
+        end
 end;
 

Modified: mlton/branches/on-20050420-cmm-branch/mlyacc/src/lalr.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlyacc/src/lalr.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlyacc/src/lalr.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,111 +1,94 @@
-(* ML-Yacc Parser Generator (c) 1989 Andrew W. Appel, David R. Tarditi 
- *
- * $Log: lalr.sml,v $
- * Revision 1.1.1.1  1997/01/14 01:38:05  george
- *   Version 109.24
- *
- * Revision 1.3  1996/10/03  03:37:12  jhr
- * Qualified identifiers that are no-longer top-level (quot, rem, min, max).
- *
- * Revision 1.2  1996/02/26  15:02:35  george
- *    print no longer overloaded.
- *    use of makestring has been removed and replaced with Int.toString ..
- *    use of IO replaced with TextIO
- *
- * Revision 1.1.1.1  1996/01/31  16:01:45  george
- * Version 109
- * 
- *)
+(* ML-Yacc Parser Generator (c) 1989 Andrew W. Appel, David R. Tarditi *)
 
 functor mkLalr ( structure IntGrammar : INTGRAMMAR
-		structure Core : CORE
-		structure Graph : LRGRAPH
-		structure Look: LOOK
-		sharing Graph.Core = Core
-		sharing Graph.IntGrammar = Core.IntGrammar =
-			Look.IntGrammar = IntGrammar) : LALR_GRAPH =
+                structure Core : CORE
+                structure Graph : LRGRAPH
+                structure Look: LOOK
+                sharing Graph.Core = Core
+                sharing Graph.IntGrammar = Core.IntGrammar =
+                        Look.IntGrammar = IntGrammar) : LALR_GRAPH =
     struct
-	open Array List
-	infix 9 sub
-	open IntGrammar.Grammar IntGrammar Core Graph Look
-	structure Graph = Graph
-	structure Core = Core
-	structure Grammar = IntGrammar.Grammar
-	structure IntGrammar = IntGrammar
+        open Array List
+        infix 9 sub
+        open IntGrammar.Grammar IntGrammar Core Graph Look
+        structure Graph = Graph
+        structure Core = Core
+        structure Grammar = IntGrammar.Grammar
+        structure IntGrammar = IntGrammar
 
-	datatype tmpcore = TMPCORE of (item * term list ref) list * int
-	datatype lcore = LCORE of (item * term list) list * int
-	
+        datatype tmpcore = TMPCORE of (item * term list ref) list * int
+        datatype lcore = LCORE of (item * term list) list * int
+        
 
-	 val prLcore =
-	  fn a as (SymbolToString,nontermToString,termToString,print) =>
-	    let val printItem = prItem (SymbolToString,nontermToString,print)
-		val printLookahead = prLook(termToString,print)
-	    in fn (LCORE (items,state)) =>
-		(print "\n";
-		 print "state ";
-		 print (Int.toString state);
-		 print " :\n\n";
-		 List.app (fn (item,lookahead) =>
-			(print "{";
-			 printItem item;
-			 print ",";
-			 printLookahead lookahead;
-			 print "}\n")) items)
-	    end
+         val prLcore =
+          fn a as (SymbolToString,nontermToString,termToString,print) =>
+            let val printItem = prItem (SymbolToString,nontermToString,print)
+                val printLookahead = prLook(termToString,print)
+            in fn (LCORE (items,state)) =>
+                (print "\n";
+                 print "state ";
+                 print (Int.toString state);
+                 print " :\n\n";
+                 List.app (fn (item,lookahead) =>
+                        (print "{";
+                         printItem item;
+                         print ",";
+                         printLookahead lookahead;
+                         print "}\n")) items)
+            end
 
-	exception Lalr of int
+        exception Lalr of int
 
-	structure ItemList = ListOrdSet
-		(struct
-		   type elem = item * term list ref
-		   val eq = fn ((a,_),(b,_)) => eqItem(a,b)
-		   val gt = fn ((a,_),(b,_)) => gtItem(a,b)
-		 end)
+        structure ItemList = ListOrdSet
+                (struct
+                   type elem = item * term list ref
+                   val eq = fn ((a,_),(b,_)) => eqItem(a,b)
+                   val gt = fn ((a,_),(b,_)) => gtItem(a,b)
+                 end)
 
-	structure NontermSet = ListOrdSet
-		(struct
-		   type elem = nonterm
-		   val gt = gtNonterm
-		   val eq = eqNonterm
-		 end)
+        structure NontermSet = ListOrdSet
+                (struct
+                   type elem = nonterm
+                   val gt = gtNonterm
+                   val eq = eqNonterm
+                 end)
 
 (* NTL: nonterms with lookahead *)
 
-	structure NTL = RbOrdSet
-		(struct
-		   type elem = nonterm * term list
-		   val gt = fn ((i,_),(j,_)) => gtNonterm(i,j)
-		   val eq = fn ((i,_),(j,_)) => eqNonterm(i,j)
-		 end)
+        structure NTL = RbOrdSet
+                (struct
+                   type elem = nonterm * term list
+                   val gt = fn ((i,_),(j,_)) => gtNonterm(i,j)
+                   val eq = fn ((i,_),(j,_)) => eqNonterm(i,j)
+                 end)
 
-	val DEBUG = false
+        val DEBUG = false
 
-	val addLookahead  = fn {graph,nullable,first,eop,
-				rules,produces,nonterms,epsProds,
-				print,termToString,nontermToString} =>
-	  let
+        val addLookahead  = fn {graph,nullable,first,eop,
+                                rules,produces,nonterms,epsProds,
+                                print,termToString,nontermToString} =>
+          let
 
-		val eop = Look.make_set eop
+                val eop = Look.make_set eop
 
-		val symbolToString = fn (TERM t) => termToString t
-				      | (NONTERM t) => nontermToString t
+                val symbolToString = fn (TERM t) => termToString t
+                                      | (NONTERM t) => nontermToString t
 
-		val print = if DEBUG then print
-			    else fn _ => ()
+                val print = if DEBUG then print
+                            else fn _ => ()
 
-		val prLook = if DEBUG then prLook (termToString,print)
-			     else fn _ => ()
+                val prLook = if DEBUG then prLook (termToString,print)
+                             else fn _ => ()
 
-		val prNonterm = print o nontermToString
+                val prNonterm = print o nontermToString
 
-		val prRule = if DEBUG
-			      then prRule(symbolToString,nontermToString,print)
-			      else fn _ => ()
+                val prRule = if DEBUG
+                              then prRule(symbolToString,nontermToString,print)
+                              else fn _ => ()
 
-		val printInt = print o (Int.toString : int -> string)
+                val printInt = print o (Int.toString : int -> string)
 
-		val printItem = prItem(symbolToString,nontermToString,print)
+                val printItem = prItem(symbolToString,nontermToString,print)
 
 (* look_pos: position in the rhs of a rule at which we should start placing
    lookahead ref cells, i.e. the minimum place at which A -> x .B y, where
@@ -113,272 +96,263 @@
    given by the number of symbols before the place.  The place before the first
    symbol is 0, etc. *)
 
-	     val look_pos =
-		 let val positions = array(length rules,0)
+             val look_pos =
+                 let val positions = array(length rules,0)
 
 (* rule_pos: calculate place in the rhs of a rule at which we should start
    placing lookahead ref cells *)
 
-		      val rule_pos = fn (RULE {rhs,...}) =>
-			case (rev rhs)
-			  of nil => 0
-			   | (TERM t) :: r => length rhs
-			   | (l as (NONTERM n) :: r) =>
+                      fun rule_pos (RULE {rhs,...}) =
+                          case (rev rhs) of
+                              nil => 0
+                            | (TERM t) :: r => length rhs
+                            | (NONTERM n :: r) => let
+                                  (* f assumes that everything after n in the
+                                   * rule has proven to be nullable so far.
+                                   * Remember that the rhs has been reversed,
+                                   * implying that this is true initially *)
+                                  (* A -> .z t B y, where y is nullable *)
+                                  fun f (b, (r as (TERM _ :: _))) = length r
+                                    (* A -> .z B C y *)
+                                    | f (c, (NONTERM b :: r)) =
+                                      if nullable c then f (b, r)
+                                      else length r + 1
+                                    (* A -> .B y, where y is nullable *)
+                                    | f (_, []) = 0
+                              in  f (n, r)
+                              end
+                             
+                        val check_rule = fn (rule as RULE {num,...}) =>
+                            let val pos = rule_pos rule
+                            in (print "look_pos: ";
+                                prRule rule;
+                                print " = ";
+                                printInt pos;
+                                print "\n";
+                                update(positions,num,rule_pos rule))
+                            end
+                   in app check_rule rules;
+                    fn RULE{num,...} => (positions sub num)
+                   end
 
-			      (* f assumes that everything after n in the
-				 rule has proven to be nullable so far.
-				 Remember that the rhs has been reversed,
-				 implying that this is true initially *)
-				
-					(* A -> .z t B y, where y is nullable *)
-
-			      let fun f (NONTERM b :: (r as (TERM _ :: _))) =
-					(length r)
-
-					(* A -> .z B C y *)
-
-				    | f (NONTERM c :: (r as (NONTERM b :: _))) =
-					 if nullable c then f r
-					 else (length r)
-
-					(* A -> .B y, where y is nullable *)
-
-				    | f (NONTERM b :: nil) = 0
-				    | f _ = raise Fail "f"
-			      in  f l
-			      end
-			     
-		 	val check_rule = fn (rule as RULE {num,...}) =>
-			    let val pos = rule_pos rule
-			    in (print "look_pos: ";
-			 	prRule rule;
-				print " = ";
-				printInt pos;
-				print "\n";
-				update(positions,num,rule_pos rule))
-			    end
-		   in app check_rule rules;
-		    fn RULE{num,...} => (positions sub num)
-		   end
-
 (* rest_is_null: true for items of the form A -> x .B y, where y is nullable *)
 
-	     val rest_is_null =
-		 fn (ITEM{rule,dot, rhsAfter=NONTERM _ :: _}) =>
-			 dot >= (look_pos rule)
-		  | _ => false
+             val rest_is_null =
+                 fn (ITEM{rule,dot, rhsAfter=NONTERM _ :: _}) =>
+                         dot >= (look_pos rule)
+                  | _ => false
 
 (* map core to a new core including only items of the form A -> x. or
    A -> x. B y, where y =*=> epsilon.  It also adds epsilon productions to the
    core. Each item is given a ref cell to hold the lookahead nonterminals for
    it.*)
 
-	      val map_core =
-		let val f = fn (item as ITEM {rhsAfter=nil,...},r) =>
-				(item,ref nil) :: r
-			     | (item,r) =>
-				 if (rest_is_null item)
-				    then (item,ref nil)::r
-				    else r
-		in fn (c as CORE (items,state)) =>
-		   let val epsItems =
-			   map  (fn rule=>(ITEM{rule=rule,dot=0,rhsAfter=nil},
-					   ref (nil : term list))
-				) (epsProds c)
-		   in TMPCORE(ItemList.union(List.foldr f [] items,epsItems),state)
-		   end
-		end
+              val map_core =
+                let val f = fn (item as ITEM {rhsAfter=nil,...},r) =>
+                                (item,ref nil) :: r
+                             | (item,r) =>
+                                 if (rest_is_null item)
+                                    then (item,ref nil)::r
+                                    else r
+                in fn (c as CORE (items,state)) =>
+                   let val epsItems =
+                           map  (fn rule=>(ITEM{rule=rule,dot=0,rhsAfter=nil},
+                                           ref (nil : term list))
+                                ) (epsProds c)
+                   in TMPCORE(ItemList.union(List.foldr f [] items,epsItems),state)
+                   end
+                end
 
-	      val new_nodes = map map_core (nodes graph)
+              val new_nodes = map map_core (nodes graph)
 
-	      exception Find
+              exception Find
 
 (* findRef: state * item -> lookahead ref cell for item *)
 
-	      val findRef = 
-		let val states = Array.fromList new_nodes
-		    val dummy = ref nil
-		in fn (state,item) =>
-		    let val TMPCORE (l,_) = states sub state
-		    in case ItemList.find((item,dummy),l)
-				   of SOME (_,look_ref) => look_ref
-				    | NONE => (print "find failed: state ";
-					       printInt state;
-					       print "\nitem =\n";
-					       printItem item;
-					       print "\nactual items =\n";
-					       app (fn (i,_) => (printItem i;
-						    print "\n")) l;
-						raise Find)
-		    end
-		end 
-			
+              val findRef = 
+                let val states = Array.fromList new_nodes
+                    val dummy = ref nil
+                in fn (state,item) =>
+                    let val TMPCORE (l,_) = states sub state
+                    in case ItemList.find((item,dummy),l)
+                                   of SOME (_,look_ref) => look_ref
+                                    | NONE => (print "find failed: state ";
+                                               printInt state;
+                                               print "\nitem =\n";
+                                               printItem item;
+                                               print "\nactual items =\n";
+                                               app (fn (i,_) => (printItem i;
+                                                    print "\n")) l;
+                                                raise Find)
+                    end
+                end 
+                        
 
 (* findRuleRefs: state -> rule -> lookahead refs for rule. *)
-		
-	       val findRuleRefs =
-		 let val shift = shift graph
-		 in fn state =>
-			(* handle epsilon productions *)
-		  fn (rule as RULE {rhs=nil,...}) => 
-			 [findRef(state,ITEM{rule=rule,dot=0,rhsAfter=nil})]
-		   | (rule as RULE {rhs=sym::rest,...}) =>
-		   let	val pos = Int.max(look_pos rule,1)
-			fun scan'(state,nil,pos,result) =
-				findRef(state,ITEM{rule=rule,
-						   dot=pos,
-						   rhsAfter=nil}) :: result
-			  | scan'(state,rhs as sym::rest,pos,result) =
-				scan'(shift(state,sym), rest, pos+1,
-				      findRef(state,ITEM{rule=rule,
-							 dot=pos,
-							 rhsAfter=rhs})::result)
-				
+                
+               val findRuleRefs =
+                 let val shift = shift graph
+                 in fn state =>
+                        (* handle epsilon productions *)
+                  fn (rule as RULE {rhs=nil,...}) => 
+                         [findRef(state,ITEM{rule=rule,dot=0,rhsAfter=nil})]
+                   | (rule as RULE {rhs=sym::rest,...}) =>
+                   let  val pos = Int.max(look_pos rule,1)
+                        fun scan'(state,nil,pos,result) =
+                                findRef(state,ITEM{rule=rule,
+                                                   dot=pos,
+                                                   rhsAfter=nil}) :: result
+                          | scan'(state,rhs as sym::rest,pos,result) =
+                                scan'(shift(state,sym), rest, pos+1,
+                                      findRef(state,ITEM{rule=rule,
+                                                         dot=pos,
+                                                         rhsAfter=rhs})::result)
+                                
 (* find first item of the form A -> x .B y, where y =*=> epsilon and
    x is not epsilon, or A -> x.  use scan' to pick up all refs after this
    point *)
 
-			 fun scan(state,nil,_) =
-			   [findRef(state,ITEM{rule=rule,dot=pos,rhsAfter=nil})]
-			   | scan(state,rhs,0) = scan'(state,rhs,pos,nil)
-			   | scan(state,sym::rest,place) =
-				    scan(shift(state,sym),rest,place-1)
+                         fun scan(state,nil,_) =
+                           [findRef(state,ITEM{rule=rule,dot=pos,rhsAfter=nil})]
+                           | scan(state,rhs,0) = scan'(state,rhs,pos,nil)
+                           | scan(state,sym::rest,place) =
+                                    scan(shift(state,sym),rest,place-1)
 
-		  in scan(shift(state,sym),rest,pos-1)
-		  end
+                  in scan(shift(state,sym),rest,pos-1)
+                  end
 
-	     end
+             end
 
 (* function to compute for some nonterminal n the set of nonterminals A added
    through the closure of nonterminal n such that n =c*=> .A x, where x is
    nullable *)
 
-	      val nonterms_w_null = fn nt =>
-		  let val collect_nonterms = fn n =>
-		    List.foldr (fn (rule as RULE {rhs=rhs as NONTERM n :: _,...},r) =>
-			   (case
-			     (rest_is_null(ITEM {dot=0,rhsAfter=rhs,rule=rule}))
-				 of true => n :: r
-				  | false => r)
-			   | (_,r) => r) [] (produces n)
-		       fun dfs(a as (n,r)) =
-			 if (NontermSet.exists a) then r 
-			 else List.foldr dfs (NontermSet.insert(n,r))
-				(collect_nonterms n)
-		  in dfs(nt,NontermSet.empty)
-		  end
+              val nonterms_w_null = fn nt =>
+                  let val collect_nonterms = fn n =>
+                    List.foldr (fn (rule as RULE {rhs=rhs as NONTERM n :: _,...},r) =>
+                           (case
+                             (rest_is_null(ITEM {dot=0,rhsAfter=rhs,rule=rule}))
+                                 of true => n :: r
+                                  | false => r)
+                           | (_,r) => r) [] (produces n)
+                       fun dfs(a as (n,r)) =
+                         if (NontermSet.exists a) then r 
+                         else List.foldr dfs (NontermSet.insert(n,r))
+                                (collect_nonterms n)
+                  in dfs(nt,NontermSet.empty)
+                  end
 
-		val nonterms_w_null =
-		   let val data = array(nonterms,NontermSet.empty)
-		       fun f n = if n=nonterms then ()
-				 else (update(data,n,nonterms_w_null (NT n));
-				       f (n+1))
-		   in (f 0; fn (NT nt) => data sub nt)
-		   end
+                val nonterms_w_null =
+                   let val data = array(nonterms,NontermSet.empty)
+                       fun f n = if n=nonterms then ()
+                                 else (update(data,n,nonterms_w_null (NT n));
+                                       f (n+1))
+                   in (f 0; fn (NT nt) => data sub nt)
+                   end
 
 (* look_info: for some nonterminal n the set of nonterms A added
    through the closure of the nonterminal such that n =c+=> .Ax and the
    lookahead accumlated for each nonterm A *)
 
-		val look_info = fn nt =>
-		   let val collect_nonterms = fn n =>
-		      List.foldr (fn (RULE {rhs=NONTERM n :: t,...},r) =>
-			     (case NTL.find ((n,nil),r)
-			      of SOME (key,data) =>
-			         NTL.insert((n,Look.union(data,first t)),r)
-			       | NONE => NTL.insert ((n,first t),r))
-			     | (_,r) => r)
-		            NTL.empty (produces n)
-			fun dfs(a as ((key1,data1),r)) =
-			  case (NTL.find a)
-			   of SOME (_,data2) =>
-			       NTL.insert((key1,Look.union(data1,data2)),r)
-			    | NONE => NTL.fold dfs (collect_nonterms key1)
-						   (NTL.insert a)
-		    in dfs((nt,nil),NTL.empty)
-		    end
+                val look_info = fn nt =>
+                   let val collect_nonterms = fn n =>
+                      List.foldr (fn (RULE {rhs=NONTERM n :: t,...},r) =>
+                             (case NTL.find ((n,nil),r)
+                              of SOME (key,data) =>
+                                 NTL.insert((n,Look.union(data,first t)),r)
+                               | NONE => NTL.insert ((n,first t),r))
+                             | (_,r) => r)
+                            NTL.empty (produces n)
+                        fun dfs(a as ((key1,data1),r)) =
+                          case (NTL.find a)
+                           of SOME (_,data2) =>
+                               NTL.insert((key1,Look.union(data1,data2)),r)
+                            | NONE => NTL.fold dfs (collect_nonterms key1)
+                                                   (NTL.insert a)
+                    in dfs((nt,nil),NTL.empty)
+                    end
 
-		val look_info = 
-		  if not DEBUG then look_info
-		  else fn nt =>
-		       (print "look_info of "; prNonterm nt; print "=\n";
-			let val info = look_info nt
-			in (NTL.app (fn (nt,lookahead) =>
-				    (prNonterm nt; print ": "; prLook lookahead;
-				     print "\n\n")) info;
-			   info)
-			end)
+                val look_info = 
+                  if not DEBUG then look_info
+                  else fn nt =>
+                       (print "look_info of "; prNonterm nt; print "=\n";
+                        let val info = look_info nt
+                        in (NTL.app (fn (nt,lookahead) =>
+                                    (prNonterm nt; print ": "; prLook lookahead;
+                                     print "\n\n")) info;
+                           info)
+                        end)
 
 (* prop_look: propagate lookaheads for nonterms added in the closure of a
    nonterm.  Lookaheads must be propagated from each nonterminal m to
    all nonterminals { n | m =c+=> nx, where x=*=>epsilon} *)
 
-		  val prop_look = fn ntl =>
-		    let val upd_lookhd = fn new_look => fn (nt,r) =>
-			  case NTL.find ((nt,new_look),r)
-			  of SOME (_,old_look) =>
-			     NTL.insert((nt, Look.union(new_look,old_look)),r)
-			   | NONE => raise (Lalr 241)
-		         val upd_nonterm = fn ((nt,look),r) =>
-			   NontermSet.fold (upd_lookhd look)
-					   (nonterms_w_null nt) r
-		     in NTL.fold upd_nonterm ntl ntl
-		     end
+                  val prop_look = fn ntl =>
+                    let val upd_lookhd = fn new_look => fn (nt,r) =>
+                          case NTL.find ((nt,new_look),r)
+                          of SOME (_,old_look) =>
+                             NTL.insert((nt, Look.union(new_look,old_look)),r)
+                           | NONE => raise (Lalr 241)
+                         val upd_nonterm = fn ((nt,look),r) =>
+                           NontermSet.fold (upd_lookhd look)
+                                           (nonterms_w_null nt) r
+                     in NTL.fold upd_nonterm ntl ntl
+                     end
 
-		val prop_look = 
-		  if not DEBUG then prop_look
-		  else fn ntl =>
-		    (print "prop_look =\n";
-		     let val info = prop_look ntl
-		     in (NTL.app (fn (nt,lookahead) =>
-				    (prNonterm nt;
-				     print ": ";
-				     prLook lookahead;
-				     print "\n\n")) info; info)
-		     end)
+                val prop_look = 
+                  if not DEBUG then prop_look
+                  else fn ntl =>
+                    (print "prop_look =\n";
+                     let val info = prop_look ntl
+                     in (NTL.app (fn (nt,lookahead) =>
+                                    (prNonterm nt;
+                                     print ": ";
+                                     prLook lookahead;
+                                     print "\n\n")) info; info)
+                     end)
 
 (* now put the information from these functions together.  Create a function
    which takes a nonterminal n and returns a list of triplets of
-	 (a nonterm added through closure,
-	  the lookahead for the nonterm,
-	  whether the nonterm should include the lookahead for the nonterminal
-	  whose closure is being taken (i.e. first(y) for an item j of the
-	  form A -> x .n y and lookahead(j) if y =*=> epsilon)
+         (a nonterm added through closure,
+          the lookahead for the nonterm,
+          whether the nonterm should include the lookahead for the nonterminal
+          whose closure is being taken (i.e. first(y) for an item j of the
+          form A -> x .n y and lookahead(j) if y =*=> epsilon)
 *)
 
-		 val closure_nonterms =
-		   let val data =
-			  array(nonterms,nil: (nonterm * term list * bool) list)
-		       val do_nonterm = fn i =>
-			let val nonterms_followed_by_null =
-				nonterms_w_null i
-			    val nonterms_added_through_closure = 
-			      NTL.make_list (prop_look (look_info i))
-			    val result =
-			    map (fn (nt,l) =>
-			 (nt,l,NontermSet.exists (nt,nonterms_followed_by_null))
-				) nonterms_added_through_closure
-			 in if DEBUG then
-			       (print "closure_nonterms = ";
-				prNonterm i;
-				print "\n";
-				app (fn (nt,look,nullable) =>
-				  (prNonterm nt;
-				   print ":";
-				   prLook look;
-				   case nullable
-				     of false => print "(false)\n"
-				      | true => print "(true)\n")) result;
-				print "\n")
-			     else ();
-			     result
-			 end
-		        fun f i =
-			  if i=nonterms then ()
-			  else (update(data,i,do_nonterm (NT i)); f (i+1))
-			val _ = f 0
-		    in fn (NT i) => data sub i
-		    end
+                 val closure_nonterms =
+                   let val data =
+                          array(nonterms,nil: (nonterm * term list * bool) list)
+                       val do_nonterm = fn i =>
+                        let val nonterms_followed_by_null =
+                                nonterms_w_null i
+                            val nonterms_added_through_closure = 
+                              NTL.make_list (prop_look (look_info i))
+                            val result =
+                            map (fn (nt,l) =>
+                         (nt,l,NontermSet.exists (nt,nonterms_followed_by_null))
+                                ) nonterms_added_through_closure
+                         in if DEBUG then
+                               (print "closure_nonterms = ";
+                                prNonterm i;
+                                print "\n";
+                                app (fn (nt,look,nullable) =>
+                                  (prNonterm nt;
+                                   print ":";
+                                   prLook look;
+                                   case nullable
+                                     of false => print "(false)\n"
+                                      | true => print "(true)\n")) result;
+                                print "\n")
+                             else ();
+                             result
+                         end
+                        fun f i =
+                          if i=nonterms then ()
+                          else (update(data,i,do_nonterm (NT i)); f (i+1))
+                        val _ = f 0
+                    in fn (NT i) => data sub i
+                    end
 
 (* add_nonterm_lookahead: Add lookahead to all completion items for rules added
    when the closure of a given nonterm in some state is taken.  It returns
@@ -388,103 +362,103 @@
    A -> x.
 *)
 
-		val add_nonterm_lookahead = fn (nt,state) =>
-		  let val f = fn ((nt,lookahead,nullable),r) =>
-			let val refs = map (findRuleRefs state) (produces nt)
-			    val refs = List.concat refs
-			    val _ = app (fn r =>
-				     r := (Look.union (!r,lookahead))) refs
-			in if nullable then refs @ r else r
-			end
-		 in List.foldr f [] (closure_nonterms nt)
-		 end
+                val add_nonterm_lookahead = fn (nt,state) =>
+                  let val f = fn ((nt,lookahead,nullable),r) =>
+                        let val refs = map (findRuleRefs state) (produces nt)
+                            val refs = List.concat refs
+                            val _ = app (fn r =>
+                                     r := (Look.union (!r,lookahead))) refs
+                        in if nullable then refs @ r else r
+                        end
+                 in List.foldr f [] (closure_nonterms nt)
+                 end
 
 (* scan_core: Scan a core for all items of the form A -> x .B y.  Applies
    add_nonterm_lookahead to each such B, and then merges first(y) into
    the list of refs returned by add_nonterm_lookahead.  It returns
    a list of ref * ref list for all the items where y =*=> epsilon *)
 
-		val scan_core = fn (CORE (l,state)) =>
-		  let fun f ((item as ITEM{rhsAfter= NONTERM b :: y,
-					   dot,rule})::t,r) =
-			(case (add_nonterm_lookahead(b,state))
-			  of nil => r
-			   | l =>
-			    let val first_y = first y
-			        val newr  = if dot >= (look_pos rule)
-					then (findRef(state,item),l)::r
-					else r
-			    in (app (fn r =>
-					 r := Look.union(!r,first_y)) l;
-			        f (t,newr))
-			    end)
-			| f (_ :: t,r) = f (t,r)
-			| f (nil,r) = r
-		  in f (l,nil)
-		  end
+                val scan_core = fn (CORE (l,state)) =>
+                  let fun f ((item as ITEM{rhsAfter= NONTERM b :: y,
+                                           dot,rule})::t,r) =
+                        (case (add_nonterm_lookahead(b,state))
+                          of nil => r
+                           | l =>
+                            let val first_y = first y
+                                val newr  = if dot >= (look_pos rule)
+                                        then (findRef(state,item),l)::r
+                                        else r
+                            in (app (fn r =>
+                                         r := Look.union(!r,first_y)) l;
+                                f (t,newr))
+                            end)
+                        | f (_ :: t,r) = f (t,r)
+                        | f (nil,r) = r
+                  in f (l,nil)
+                  end
 
 (* add end-of-parse symbols to set of items consisting of all items
    immediately derived from the start symbol *)
 
-		val add_eop = fn (c as CORE (l,state),eop) =>
-		  let fun f (item as ITEM {rule,dot,...}) =
-		    let val refs = findRuleRefs state rule
-		    in
+                val add_eop = fn (c as CORE (l,state),eop) =>
+                  let fun f (item as ITEM {rule,dot,...}) =
+                    let val refs = findRuleRefs state rule
+                    in
 
 (* first take care of kernal items.  Add the end-of-parse symbols to
    the lookahead sets for these items.  Epsilon productions of the
    start symbol do not need to be handled specially because they will
    be in the kernal also *)
 
-		       app (fn r => r := Look.union(!r,eop)) refs;
+                       app (fn r => r := Look.union(!r,eop)) refs;
 
 (* now take care of closure items.  These are all nonterminals C which
    have a derivation S =+=> .C x, where x is nullable *)
 
-		       if dot >= (look_pos rule) then
-		       	  case item
-			  of ITEM{rhsAfter=NONTERM b :: _,...} =>
-			     (case add_nonterm_lookahead(b,state)
-			      of nil => ()
-			       | l => app (fn r => r := Look.union(!r,eop)) l)
-			   | _ => ()
-		       else ()
-		    end
-		  in app f l
-		  end
+                       if dot >= (look_pos rule) then
+                          case item
+                          of ITEM{rhsAfter=NONTERM b :: _,...} =>
+                             (case add_nonterm_lookahead(b,state)
+                              of nil => ()
+                               | l => app (fn r => r := Look.union(!r,eop)) l)
+                           | _ => ()
+                       else ()
+                    end
+                  in app f l
+                  end
 
-		val iterate = fn l =>
-		   let fun f lookahead (nil,done) = done
-			 | f lookahead (h::t,done) =
-			    let val old = !h
-			    in h := Look.union (old,lookahead);
-			       if (length (!h)) <> (length old)
-					 then f lookahead (t,false)
-					 else f lookahead(t,done)
-			    end
-		       fun g ((from,to)::rest,done) =
-			let val new_done = f (!from) (to,done)
-			in g (rest,new_done)
-			end
-			 | g (nil,done) = done
-		       fun loop true = ()
-			 | loop false = loop (g (l,true))
-		   in loop false
-		   end
+                val iterate = fn l =>
+                   let fun f lookahead (nil,done) = done
+                         | f lookahead (h::t,done) =
+                            let val old = !h
+                            in h := Look.union (old,lookahead);
+                               if (length (!h)) <> (length old)
+                                         then f lookahead (t,false)
+                                         else f lookahead(t,done)
+                            end
+                       fun g ((from,to)::rest,done) =
+                        let val new_done = f (!from) (to,done)
+                        in g (rest,new_done)
+                        end
+                         | g (nil,done) = done
+                       fun loop true = ()
+                         | loop false = loop (g (l,true))
+                   in loop false
+                   end
 
-		val lookahead = List.concat (map scan_core (nodes graph))
+                val lookahead = List.concat (map scan_core (nodes graph))
 
 (* used to scan the item list of a TMPCORE and remove the items not
    being reduced *)
 
-		val create_lcore_list =
-			fn ((item as ITEM {rhsAfter=nil,...},ref l),r) =>
-				(item,l) :: r
-			 | (_,r) => r
+                val create_lcore_list =
+                        fn ((item as ITEM {rhsAfter=nil,...},ref l),r) =>
+                                (item,l) :: r
+                         | (_,r) => r
 
-	in  add_eop(Graph.core graph 0,eop);
-	    iterate lookahead;
-	    map (fn (TMPCORE (l,state)) =>
-		       LCORE (List.foldr create_lcore_list [] l, state)) new_nodes
-	end
+        in  add_eop(Graph.core graph 0,eop);
+            iterate lookahead;
+            map (fn (TMPCORE (l,state)) =>
+                       LCORE (List.foldr create_lcore_list [] l, state)) new_nodes
+        end
 end;

Modified: mlton/branches/on-20050420-cmm-branch/mlyacc/src/link.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlyacc/src/link.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlyacc/src/link.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,32 +1,23 @@
-(* ML-Yacc Parser Generator (c) 1989 Andrew W. Appel, David R. Tarditi 
- *
- * $Log: link.sml,v $
- * Revision 1.1.1.1  1997/01/14 01:38:05  george
- *   Version 109.24
- *
- * Revision 1.1.1.1  1996/01/31  16:01:45  george
- * Version 109
- * 
- *)
+(* ML-Yacc Parser Generator (c) 1989 Andrew W. Appel, David R. Tarditi *)
 local
 
 (* create parser *)
 
    structure LrVals = MlyaccLrValsFun(structure Token = LrParser.Token
-				      structure Hdr = Header)
+                                      structure Hdr = Header)
    structure Lex = LexMLYACC(structure Tokens = LrVals.Tokens
-			     structure Hdr = Header)
+                             structure Hdr = Header)
    structure Parser = JoinWithArg(structure Lex=Lex
-			         structure ParserData = LrVals.ParserData
-			         structure LrParser= LrParser)
+                                 structure ParserData = LrVals.ParserData
+                                 structure LrParser= LrParser)
    structure ParseGenParser =
-	   ParseGenParserFun(structure Parser = Parser
-	                     structure Header = Header)
+           ParseGenParserFun(structure Parser = Parser
+                             structure Header = Header)
 
 (* create structure for computing LALR table from a grammar *)
 
    structure MakeLrTable = mkMakeLrTable(structure IntGrammar =IntGrammar
-				     structure LrTable = LrTable)
+                                     structure LrTable = LrTable)
 
 (* create structures for printing LALR tables:
 
@@ -36,7 +27,7 @@
    structure Verbose = mkVerbose(structure Errs = MakeLrTable.Errs)
    structure PrintStruct =
        mkPrintStruct(structure LrTable = MakeLrTable.LrTable
-		     structure ShrinkLrTable =
+                     structure ShrinkLrTable =
                           ShrinkLrTableFun(structure LrTable=LrTable))
 in
 
@@ -44,9 +35,9 @@
   does semantic checks, creates table, and prints it *)
 
    structure ParseGen = ParseGenFun(structure ParseGenParser = ParseGenParser
-			            structure MakeTable = MakeLrTable
-			            structure Verbose = Verbose
-			            structure PrintStruct = PrintStruct
-				    structure Absyn = Absyn)
+                                    structure MakeTable = MakeLrTable
+                                    structure Verbose = Verbose
+                                    structure PrintStruct = PrintStruct
+                                    structure Absyn = Absyn)
 end
 

Deleted: mlton/branches/on-20050420-cmm-branch/mlyacc/src/load
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlyacc/src/load	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlyacc/src/load	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,47 +0,0 @@
-(* load file for parser-generator part of ML-Yacc *)
-
-(* first load the library *)
-app use [
-    "../lib/base.sig",
-    "../lib/join.sml",
-    "../lib/lrtable.sml",
-    "../lib/stream.sml",
-    "../lib/parser2.sml"	(* used by ML-Yacc's own parser *)
-  ];
-
-(* load signatures and parser for ML-Yacc *)
-app use [
-    "utils.sig",
-    "sigs.sml",
-    "hdr.sml",
-    "yacc.grm.sig",
-    "yacc.grm.sml",
-    "yacc.lex.sml",
-    "parse.sml"
-  ];
-
-(* load lr table generator: *)
-
-app use [
-    "utils.sml",
-    "sigs.sml",
-    "grammar.sml",
-    "core.sml",
-    "coreutils.sml",
-    "graph.sml",
-    "look.sml",
-    "lalr.sml",
-    "mklrtable.sml",
-    "mkprstruct.sml",
-    "shrink.sml",
-    "verbose.sml"
-  ];
-
-(* rest of ML-Yacc: *)
-app use [
-    "absyn.sig",
-    "absyn.sml",
-    "yacc.sml",
-    "link.sml"
-  ];
-

Modified: mlton/branches/on-20050420-cmm-branch/mlyacc/src/look.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlyacc/src/look.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlyacc/src/look.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,129 +1,119 @@
-(* ML-Yacc Parser Generator (c) 1989 Andrew W. Appel, David R. Tarditi 
- *
- * $Log: look.sml,v $
- * Revision 1.1.1.1  1997/01/14 01:38:05  george
- *   Version 109.24
- *
- * Revision 1.1.1.1  1996/01/31  16:01:46  george
- * Version 109
- * 
- *)
+(* ML-Yacc Parser Generator (c) 1989 Andrew W. Appel, David R. Tarditi *)
 
 functor mkLook (structure IntGrammar : INTGRAMMAR) : LOOK =
     struct
-	open Array List
-	infix 9 sub
-	structure Grammar = IntGrammar.Grammar
-	structure IntGrammar = IntGrammar
-	open Grammar IntGrammar
+        open Array List
+        infix 9 sub
+        structure Grammar = IntGrammar.Grammar
+        structure IntGrammar = IntGrammar
+        open Grammar IntGrammar
 
-	structure TermSet = ListOrdSet
-		(struct
-			type elem = term
-			val eq = eqTerm
-			val gt = gtTerm
-		end)
+        structure TermSet = ListOrdSet
+                (struct
+                        type elem = term
+                        val eq = eqTerm
+                        val gt = gtTerm
+                end)
 
-	val union = TermSet.union
-	val make_set = TermSet.make_set
+        val union = TermSet.union
+        val make_set = TermSet.make_set
 
-	val prLook = fn (termToString,print) =>
-		let val printTerm = print o termToString
-		    fun f nil = print " "
-		      | f (a :: b) = (printTerm a; print " "; f b)
-		in f
-		end
+        val prLook = fn (termToString,print) =>
+                let val printTerm = print o termToString
+                    fun f nil = print " "
+                      | f (a :: b) = (printTerm a; print " "; f b)
+                in f
+                end
 
-	structure NontermSet = ListOrdSet
-		(struct
-			type elem = nonterm
-			val eq = eqNonterm
-			val gt = gtNonterm
-		end)
-	
-	val mkFuncs = fn {rules : rule list, nonterms : int,
-			  produces : nonterm -> rule list} =>
+        structure NontermSet = ListOrdSet
+                (struct
+                        type elem = nonterm
+                        val eq = eqNonterm
+                        val gt = gtNonterm
+                end)
+        
+        val mkFuncs = fn {rules : rule list, nonterms : int,
+                          produces : nonterm -> rule list} =>
 
-	let
+        let
 
-	(* nullable: create a function which tells if a nonterminal is nullable
-	   or not.
+        (* nullable: create a function which tells if a nonterminal is nullable
+           or not.
 
-	   Method: Keep an array of booleans.  The nth entry is true if
-	   NT i is nullable.  If is false if we don't know whether NT i
-	   is nullable.
+           Method: Keep an array of booleans.  The nth entry is true if
+           NT i is nullable.  If is false if we don't know whether NT i
+           is nullable.
 
-	   Keep a list of rules whose remaining rhs we must prove to be
-	   null.  First, scan the list of rules and remove those rules
-	   whose rhs contains a terminal.  These rules are not nullable.
+           Keep a list of rules whose remaining rhs we must prove to be
+           null.  First, scan the list of rules and remove those rules
+           whose rhs contains a terminal.  These rules are not nullable.
 
-	   Now iterate through the rules that were left:
-		   (1) if there is no remaining rhs we have proved that
-		    the rule is nullable, mark the nonterminal for the
-		    rule as nullable
-		   (2) if the first element of the remaining rhs is
-		       nullable, place the rule back on the list with
-		       the rest of the rhs
-		   (3) if we don't know whether the nonterminal is nullable,
-		       place it back on the list
-		   (4) repeat until the list does not change.
+           Now iterate through the rules that were left:
+                   (1) if there is no remaining rhs we have proved that
+                    the rule is nullable, mark the nonterminal for the
+                    rule as nullable
+                   (2) if the first element of the remaining rhs is
+                       nullable, place the rule back on the list with
+                       the rest of the rhs
+                   (3) if we don't know whether the nonterminal is nullable,
+                       place it back on the list
+                   (4) repeat until the list does not change.
 
-	   We have found all the possible nullable rules. 
+           We have found all the possible nullable rules. 
       *)
 
-	val nullable =
-	  let fun ok_rhs nil = true
-		| ok_rhs ((TERM _)::_) = false
-		| ok_rhs ((NONTERM i)::r) = ok_rhs r
-	      fun add_rule (RULE {lhs,rhs,...},r) =
-		 if ok_rhs rhs
-		    then (lhs,
-			  map
-			  (fn NONTERM (NT i) => i | _ => raise Fail "add_rule")
-			  rhs) :: r
-		 else r
-	      val items = List.foldr add_rule [] rules
-	      val nullable = array(nonterms,false)
-	      val f = fn ((NT i,nil),(l,_)) => (update(nullable,i,true);
-				 	       (l,true))
-		       | (a as (lhs,(h::t)),(l,change)) =>
-				case (nullable sub h) 
-				  of false => (a::l,change)
-				   | true => ((lhs,t)::l,true)
-	      fun prove(l,true) = prove(List.foldr f (nil,false) l)
-		| prove(_,false) = ()
-	in (prove(items,true); fn (NT i) => nullable sub i)
-	end
+        val nullable = let
+            fun add_rule (RULE { lhs, rhs, ... }, r) = let
+                fun addNT (TERM _, _) = NONE
+                  | addNT (_, NONE) = NONE
+                  | addNT (NONTERM (NT i), SOME ntlist) = SOME (i :: ntlist)
+            in
+                case foldr addNT (SOME []) rhs of
+                    NONE => r
+                  | SOME ntlist => (lhs, ntlist) :: r
+            end
+            val items = List.foldr add_rule [] rules
+            val nullable = array(nonterms,false)
+            fun f ((NT i,nil),(l,_)) = (update(nullable,i,true);
+                                        (l,true))
+              | f (a as (lhs,(h::t)),(l,change)) =
+                (case (nullable sub h) of
+                     false => (a::l,change)
+                   | true => ((lhs,t)::l,true))
+            fun prove(l,true) = prove(List.foldr f (nil,false) l)
+              | prove(_,false) = ()
+        in (prove(items,true); fn (NT i) => nullable sub i)
+        end
 
      (* scanRhs : look at a list of symbols, scanning past nullable
-	nonterminals, applying addSymbol to the symbols scanned *)
+        nonterminals, applying addSymbol to the symbols scanned *)
 
     fun scanRhs addSymbol =
-	let fun f (nil,result) = result
-      	      | f ((sym as NONTERM nt) :: rest,result) =
-		if nullable nt then f (rest,addSymbol(sym,result))
-		else addSymbol(sym,result)
-      	      | f ((sym as TERM _) :: _,result) = addSymbol(sym,result)
-	in f 
-	end
+        let fun f (nil,result) = result
+              | f ((sym as NONTERM nt) :: rest,result) =
+                if nullable nt then f (rest,addSymbol(sym,result))
+                else addSymbol(sym,result)
+              | f ((sym as TERM _) :: _,result) = addSymbol(sym,result)
+        in f 
+        end
 
      (* accumulate: look at the start of the right-hand-sides of rules,
-	looking past nullable nonterminals, applying addObj to the visible
-	symbols. *)
+        looking past nullable nonterminals, applying addObj to the visible
+        symbols. *)
 
       fun accumulate(rules, empty, addObj) =
        List.foldr (fn (RULE {rhs,...},r) =>(scanRhs addObj) (rhs,r)) empty rules
 
       val nontermMemo = fn f =>
-	let val lookup = array(nonterms,nil)
-	    fun g i = if i=nonterms then ()
-		      else (update(lookup,i,f (NT i)); g (i+1))
-	in (g 0; fn (NT j) => lookup sub j)
-	end
+        let val lookup = array(nonterms,nil)
+            fun g i = if i=nonterms then ()
+                      else (update(lookup,i,f (NT i)); g (i+1))
+        in (g 0; fn (NT j) => lookup sub j)
+        end
 
      (* first1: the FIRST set of a nonterminal in the grammar. Only looks
-	at other terminals, but it is clever enough to move past nullable
-	nonterminals at the start of a production. *)
+        at other terminals, but it is clever enough to move past nullable
+        nonterminals at the start of a production. *)
 
       fun first1 nt = accumulate(produces nt, TermSet.empty,
                                  fn (TERM t, set) => TermSet.insert (t,set)
@@ -132,40 +122,40 @@
       val first1 = nontermMemo(first1)
 
      (* starters1: given a nonterminal "nt", return the set of nonterminals
-	which can start its productions. Looks past nullables, but doesn't
-	recurse *)
+        which can start its productions. Looks past nullables, but doesn't
+        recurse *)
 
       fun starters1 nt = accumulate(produces nt, nil,
                                     fn (NONTERM nt, set) =>
-					 NontermSet.insert(nt,set)
+                                         NontermSet.insert(nt,set)
                                      | (_, set) => set)
 
      val starters1 = nontermMemo(starters1)
 
      (* first: maps a nonterminal to its first-set. Get all the starters of
-	the nonterminal, get the first1 terminal set of each of these,
-	union the whole lot together *)
+        the nonterminal, get the first1 terminal set of each of these,
+        union the whole lot together *)
 
       fun first nt =
-	     List.foldr (fn (a,r) => TermSet.union(r,first1 a))
- 	       [] (NontermSet.closure (NontermSet.singleton nt, starters1))
+             List.foldr (fn (a,r) => TermSet.union(r,first1 a))
+               [] (NontermSet.closure (NontermSet.singleton nt, starters1))
 
       val first = nontermMemo(first)
 
      (* prefix: all possible terminals starting a symbol list *)
 
       fun prefix symbols =
-	  scanRhs (fn (TERM t,r) => TermSet.insert(t,r)
-		    | (NONTERM nt,r) => TermSet.union(first nt,r))
-	  (symbols,nil)
+          scanRhs (fn (TERM t,r) => TermSet.insert(t,r)
+                    | (NONTERM nt,r) => TermSet.union(first nt,r))
+          (symbols,nil)
 
       fun nullable_string ((TERM t) :: r) = false
-	| nullable_string ((NONTERM nt) :: r) =
-		(case (nullable nt)
-		   of true => nullable_string r
-		    | f => f)
-	| nullable_string nil = true
-	  
+        | nullable_string ((NONTERM nt) :: r) =
+                (case (nullable nt)
+                   of true => nullable_string r
+                    | f => f)
+        | nullable_string nil = true
+          
     in {nullable = nullable, first = prefix}
     end
 end;

Modified: mlton/branches/on-20050420-cmm-branch/mlyacc/src/mklrtable.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlyacc/src/mklrtable.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlyacc/src/mklrtable.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,6 @@
+(* Modified by mfluet@acm.org on 2005-8-01.
+ * Update with SML/NJ 110.55+.
+ *)
 (* Modified by sweeks@acm.org on 2000-8-24.
  * Ported to MLton.
  *)
@@ -2,127 +5,110 @@
 type int = Int.int
+   
+(* ML-Yacc Parser Generator (c) 1989 Andrew W. Appel, David R. Tarditi *)
 
-(* ML-Yacc Parser Generator (c) 1989 Andrew W. Appel, David R. Tarditi 
- *
- * $Log: mklrtable.sml,v $
- * Revision 1.1.1.1  1997/01/14 01:38:05  george
- *   Version 109.24
- *
- * Revision 1.3  1996/05/31  14:05:01  dbm
- * Rewrote definition of convert_to_pairlist to conform to value restriction.
- *
- * Revision 1.2  1996/02/26  15:02:36  george
- *    print no longer overloaded.
- *    use of makestring has been removed and replaced with Int.toString ..
- *    use of IO replaced with TextIO
- *
- * Revision 1.1.1.1  1996/01/31  16:01:46  george
- * Version 109
- * 
- *)
-
 functor mkMakeLrTable (structure IntGrammar : INTGRAMMAR
-		     structure LrTable : LR_TABLE
-		     sharing type LrTable.term = IntGrammar.Grammar.term
-		     sharing type LrTable.nonterm = IntGrammar.Grammar.nonterm
-		    ) : MAKE_LR_TABLE = 
+                     structure LrTable : LR_TABLE
+                     sharing type LrTable.term = IntGrammar.Grammar.term
+                     sharing type LrTable.nonterm = IntGrammar.Grammar.nonterm
+                    ) : MAKE_LR_TABLE = 
    struct 
         open Array List
-	infix 9 sub
-	structure Core = mkCore(structure IntGrammar = IntGrammar)
-	structure CoreUtils = mkCoreUtils(structure IntGrammar = IntGrammar
-				  	  structure Core = Core)
-	structure Graph = mkGraph(structure IntGrammar = IntGrammar
-			  	  structure Core = Core
-			  	  structure CoreUtils = CoreUtils)
-	structure Look = mkLook(structure IntGrammar = IntGrammar)
-	structure Lalr = mkLalr(structure IntGrammar = IntGrammar
-				structure Core = Core
-				structure Graph = Graph
-				structure Look = Look)
-	structure LrTable = LrTable
-	structure IntGrammar = IntGrammar
-	structure Grammar = IntGrammar.Grammar
-	structure GotoList = ListOrdSet
-		(struct
-		   type elem = Grammar.nonterm * LrTable.state
-		   val eq = fn ((Grammar.NT a,_),(Grammar.NT b,_)) => a=b
-		   val gt = fn ((Grammar.NT a,_),(Grammar.NT b,_)) => a>b
-		end)
-	structure Errs : LR_ERRS =
-	    struct
-		structure LrTable = LrTable
-		datatype err = RR of LrTable.term * LrTable.state * int * int
-			     | SR of LrTable.term * LrTable.state * int
-			     | NOT_REDUCED of int
-			     | NS of LrTable.term * int
-			     | START of int
+        infix 9 sub
+        structure Core = mkCore(structure IntGrammar = IntGrammar)
+        structure CoreUtils = mkCoreUtils(structure IntGrammar = IntGrammar
+                                          structure Core = Core)
+        structure Graph = mkGraph(structure IntGrammar = IntGrammar
+                                  structure Core = Core
+                                  structure CoreUtils = CoreUtils)
+        structure Look = mkLook(structure IntGrammar = IntGrammar)
+        structure Lalr = mkLalr(structure IntGrammar = IntGrammar
+                                structure Core = Core
+                                structure Graph = Graph
+                                structure Look = Look)
+        structure LrTable = LrTable
+        structure IntGrammar = IntGrammar
+        structure Grammar = IntGrammar.Grammar
+        structure GotoList = ListOrdSet
+                (struct
+                   type elem = Grammar.nonterm * LrTable.state
+                   val eq = fn ((Grammar.NT a,_),(Grammar.NT b,_)) => a=b
+                   val gt = fn ((Grammar.NT a,_),(Grammar.NT b,_)) => a>b
+                end)
+        structure Errs : LR_ERRS =
+            struct
+                structure LrTable = LrTable
+                datatype err = RR of LrTable.term * LrTable.state * int * int
+                             | SR of LrTable.term * LrTable.state * int
+                             | NOT_REDUCED of int
+                             | NS of LrTable.term * int
+                             | START of int
 
-	        val summary = fn l =>
-		   let val numRR: int ref = ref 0
-		       val numSR: int ref = ref 0
-		       val numSTART: int ref = ref 0
-		       val numNOT_REDUCED: int ref = ref 0
-		       val numNS: int ref = ref 0
-		       fun loop (h::t) = 
-		       (case h
-		         of RR _ => numRR := !numRR+1
-			  | SR _ => numSR := !numSR+1
-			  | START _ => numSTART := !numSTART+1
-			  | NOT_REDUCED _ => numNOT_REDUCED := !numNOT_REDUCED+1
-			  | NS _ => numNS := !numNS+1; loop t)
-		      | loop nil = {rr = !numRR, sr = !numSR,
-			        start = !numSTART,
-			        not_reduced = !numNOT_REDUCED,
-			        nonshift = !numNS}
-		  in loop l
-		  end
+                val summary = fn l =>
+                   let val numRR : int ref = ref 0
+                       val numSR : int ref = ref 0
+                       val numSTART : int ref = ref 0
+                       val numNOT_REDUCED : int ref = ref 0
+                       val numNS : int ref = ref 0
+                       fun loop (h::t) = 
+                       (case h
+                         of RR _ => numRR := !numRR+1
+                          | SR _ => numSR := !numSR+1
+                          | START _ => numSTART := !numSTART+1
+                          | NOT_REDUCED _ => numNOT_REDUCED := !numNOT_REDUCED+1
+                          | NS _ => numNS := !numNS+1; loop t)
+                      | loop nil = {rr = !numRR, sr = !numSR,
+                                start = !numSTART,
+                                not_reduced = !numNOT_REDUCED,
+                                nonshift = !numNS}
+                  in loop l
+                  end
 
-		  val printSummary = fn say => fn l =>
-		   let val {rr,sr,start,
-			    not_reduced,nonshift} = summary l
-		       val say_plural = fn (i,s) =>
-			  (say (Int.toString i); say " ";
-			   case i
-			     of 1 => (say s)
-			      | _ => (say s; say "s"))
-		       val say_error = fn (args as (i,s)) =>
-			  case i
-			  of 0 => ()
-			   | i => (say_plural args; say "\n")
-		   in say_error(rr,"reduce/reduce conflict");
-		      say_error(sr,"shift/reduce conflict");
-		      if nonshift<>0 then
-			   (say "non-shiftable terminal used on the rhs of ";
-			   say_plural(start,"rule"); say "\n")
-		      else ();
-		      if start<>0 then (say "start symbol used on the rhs of ";
-					say_plural(start,"rule"); say "\n")
-		      else ();
-		      if not_reduced<>0 then (say_plural(not_reduced,"rule");
-					      say " not reduced\n")
-		      else ()
-		end
-	    end
+                  val printSummary = fn say => fn l =>
+                   let val {rr,sr,start,
+                            not_reduced,nonshift} = summary l
+                       val say_plural = fn (i,s) =>
+                          (say (Int.toString i); say " ";
+                           case i
+                             of 1 => (say s)
+                              | _ => (say s; say "s"))
+                       val say_error = fn (args as (i,s)) =>
+                          case i
+                          of 0 => ()
+                           | i => (say_plural args; say "\n")
+                   in say_error(rr,"reduce/reduce conflict");
+                      say_error(sr,"shift/reduce conflict");
+                      if nonshift<>0 then
+                           (say "non-shiftable terminal used on the rhs of ";
+                           say_plural(start,"rule"); say "\n")
+                      else ();
+                      if start<>0 then (say "start symbol used on the rhs of ";
+                                        say_plural(start,"rule"); say "\n")
+                      else ();
+                      if not_reduced<>0 then (say_plural(not_reduced,"rule");
+                                              say " not reduced\n")
+                      else ()
+                end
+            end
 
 
-	open IntGrammar Grammar Errs LrTable Core 
+        open IntGrammar Grammar Errs LrTable Core 
 
 (* rules for resolving conflicts:
 
-	shift/reduce:
+        shift/reduce:
 
-		  If either the terminal or the rule has no
-		  precedence, a shift/reduce conflict is reported.
-		  A shift is chosen for the table.
+                  If either the terminal or the rule has no
+                  precedence, a shift/reduce conflict is reported.
+                  A shift is chosen for the table.
 
-		  If both have precedences, the action with the
-		  higher precedence is chosen.
+                  If both have precedences, the action with the
+                  higher precedence is chosen.
 
-		  If the precedences are equal, neither the
-		  shift nor the reduce is chosen.
+                  If the precedences are equal, neither the
+                  shift nor the reduce is chosen.
 
       reduce/reduce:
 
-		  A reduce/reduce conflict is reported.  The lowest
-		  numbered rule is chosen for reduction.
+                  A reduce/reduce conflict is reported.  The lowest
+                  numbered rule is chosen for reduction.
 *)
@@ -148,11 +134,11 @@
 can be compared against them.  All reduce/reduce conflicts, however,
 can be generated given a list of the reduce/reduce conflicts generated
 by this method.
-	
+        
    This can be done by taking the transitive closure of the relation given
 by the list.  If reduce/reduce (a,b) and reduce/reduce (b,c)  are true,
 then reduce/reduce (a,c) is true.   The relation is symmetric and transitive.
-		  
+                  
 Adding shifts:
 
     Finally scan the list merging in shifts and resolving conflicts
@@ -167,252 +153,244 @@
 is true.
 *)
 
+    fun unREDUCE (REDUCE num) = num
+      | unREDUCE _ = raise Fail "bug: unexpected action (expected REDUCE)"
+
     val mergeReduces =
-	let val merge = fn state =>
-	  let fun f (j as (pair1 as (T t1,action1)) :: r1,
-		     k as (pair2 as (T t2,action2)) :: r2,result,errs) =
-	  	    if t1 < t2 then f(r1,k,pair1::result,errs)
-		    else if t1 > t2 then f(j,r2,pair2::result,errs)
-		    else let
-			    val num1 =
-			       case action1 of
-				  REDUCE z => z
-				| _ => raise Fail "action1"
-			     val num2 =
-				case action2 of
-				   REDUCE z => z
-				 | _ => raise Fail "action2"
-			     val errs = RR(T t1,state,num1,num2) :: errs
-			     val action = if num1 < num2 then pair1 else pair2
-		         in f(r1,r2,action::result,errs)
-		          end
-		| f (nil,nil,result,errs) = (rev result,errs)
-		| f (pair1::r,nil,result,errs) = f(r,nil,pair1::result,errs)
-		| f (nil,pair2 :: r,result,errs) = f(nil,r,pair2::result,errs)
-	    in f
-	    end
-	 in fn state => fn ((ITEM {rule=RULE {rulenum,...},...}, lookahead),
-		 (reduces,errs)) =>
-		let val action = REDUCE rulenum
-		    val actions = map (fn a=>(a,action)) lookahead
-		in case reduces
-		   of nil => (actions,errs)
-		    | _ =>  merge state (reduces,actions,nil,errs)
-		end
-	 end
+        let val merge = fn state =>
+          let fun f (j as (pair1 as (T t1,action1)) :: r1,
+                     k as (pair2 as (T t2,action2)) :: r2,result,errs) =
+                    if t1 < t2 then f(r1,k,pair1::result,errs)
+                    else if t1 > t2 then f(j,r2,pair2::result,errs)
+                    else let val num1 = unREDUCE action1
+                             val num2 = unREDUCE action2
+                             val errs = RR(T t1,state,num1,num2) :: errs
+                             val action = if num1 < num2 then pair1 else pair2
+                         in f(r1,r2,action::result,errs)
+                          end
+                | f (nil,nil,result,errs) = (rev result,errs)
+                | f (pair1::r,nil,result,errs) = f(r,nil,pair1::result,errs)
+                | f (nil,pair2 :: r,result,errs) = f(nil,r,pair2::result,errs)
+            in f
+            end
+         in fn state => fn ((ITEM {rule=RULE {rulenum,...},...}, lookahead),
+                 (reduces,errs)) =>
+                let val action = REDUCE rulenum
+                    val actions = map (fn a=>(a,action)) lookahead
+                in case reduces
+                   of nil => (actions,errs)
+                    | _ =>  merge state (reduces,actions,nil,errs)
+                end
+         end
 
   val computeActions = fn (rules,precedence,graph,defaultReductions) =>
      
     let val rulePrec =
-	  let val precData = array(length rules,NONE : int option)
-	  in app (fn RULE {rulenum=r,precedence=p,...} => update(precData,r,p))
-	     rules;
-	     fn i => precData sub i
-	  end
+          let val precData = array(length rules,NONE : int option)
+          in app (fn RULE {rulenum=r,precedence=p,...} => update(precData,r,p))
+             rules;
+             fn i => precData sub i
+          end
 
-	fun mergeShifts(state,shifts,nil) = (shifts,nil)
-	  | mergeShifts(state,nil,reduces) = (reduces,nil)
-	  | mergeShifts(state,shifts,reduces) =
-	  let fun f(shifts as (pair1 as (T t1,_)) :: r1,
-			reduces as (pair2 as (T t2,action)) :: r2,
-			result,errs) =
-		if t1 < t2 then f(r1,reduces,pair1 :: result,errs)
-		else if t1 > t2 then f(shifts,r2,pair2 :: result,errs)
-		else let
-			val rulenum =
-			   case action of
-			      REDUCE z => z
-			    | _ => raise Fail "action"
-			val (term1,_) = pair1
-		     in case (precedence term1,rulePrec rulenum)
-		      of (SOME i,SOME j) =>
-		         if i>j then f(r1,r2,pair1 :: result,errs)
-		         else if j>i then f(r1,r2,pair2 :: result,errs)
-			 else f(r1,r2,(T t1, ERROR)::result,errs)
-		       | (_,_) =>
-			   f(r1,r2,pair1 :: result,
-			     SR (term1,state,rulenum)::errs)
-		     end
-	   	| f (nil,nil,result,errs) = (rev result,errs)
-	   	| f (nil,h::t,result,errs) =
-		   	f (nil,t,h::result,errs)
-	   	| f (h::t,nil,result,errs) = 
-		   	f (t,nil,h::result,errs)
-	  in f(shifts,reduces,nil,nil)
-	  end
+        fun mergeShifts(state,shifts,nil) = (shifts,nil)
+          | mergeShifts(state,nil,reduces) = (reduces,nil)
+          | mergeShifts(state,shifts,reduces) =
+          let fun f(shifts as (pair1 as (T t1,_)) :: r1,
+                        reduces as (pair2 as (T t2,action)) :: r2,
+                        result,errs) =
+                if t1 < t2 then f(r1,reduces,pair1 :: result,errs)
+                else if t1 > t2 then f(shifts,r2,pair2 :: result,errs)
+                else let val rulenum = unREDUCE action
+                         val (term1,_) = pair1
+                     in case (precedence term1,rulePrec rulenum)
+                      of (SOME i,SOME j) =>
+                         if i>j then f(r1,r2,pair1 :: result,errs)
+                         else if j>i then f(r1,r2,pair2 :: result,errs)
+                         else f(r1,r2,(T t1, ERROR)::result,errs)
+                       | (_,_) =>
+                           f(r1,r2,pair1 :: result,
+                             SR (term1,state,rulenum)::errs)
+                     end
+                | f (nil,nil,result,errs) = (rev result,errs)
+                | f (nil,h::t,result,errs) =
+                        f (nil,t,h::result,errs)
+                | f (h::t,nil,result,errs) = 
+                        f (t,nil,h::result,errs)
+          in f(shifts,reduces,nil,nil)
+          end
 
-	fun mapCore ({edge=symbol,to=CORE (_,state)}::r,shifts,gotos) =
-	        (case symbol
-		 of (TERM t) => mapCore (r,(t,SHIFT(STATE state))::shifts,gotos)
-		  | (NONTERM nt) => mapCore(r,shifts,(nt,STATE state)::gotos)
-		)
-	  | mapCore (nil,shifts,gotos) = (rev shifts,rev gotos)
+        fun mapCore ({edge=symbol,to=CORE (_,state)}::r,shifts,gotos) =
+                (case symbol
+                 of (TERM t) => mapCore (r,(t,SHIFT(STATE state))::shifts,gotos)
+                  | (NONTERM nt) => mapCore(r,shifts,(nt,STATE state)::gotos)
+                )
+          | mapCore (nil,shifts,gotos) = (rev shifts,rev gotos)
 
-	fun pruneError ((_,ERROR)::rest) = pruneError rest
-	  | pruneError (a::rest) = a :: pruneError rest
-	  | pruneError nil = nil
+        fun pruneError ((_,ERROR)::rest) = pruneError rest
+          | pruneError (a::rest) = a :: pruneError rest
+          | pruneError nil = nil
 
   in fn (Lalr.LCORE (reduceItems,state),c as CORE (shiftItems,state')) =>
-	if DEBUG andalso (state <> state') then
-		 let exception MkTable in raise MkTable end
-	else
-	 let val (shifts,gotos) = mapCore (Graph.edges(c,graph),nil,nil)
-	     val tableState = STATE state
-	 in case reduceItems
-		of nil => ((shifts,ERROR),gotos,nil)
-		 | h :: nil =>
-		    let val (ITEM {rule=RULE {rulenum,...},...}, l) = h
-		        val (reduces,_) = mergeReduces tableState (h,(nil,nil))
-			val (actions,errs) = mergeShifts(tableState,
-							 shifts,reduces)
-			val actions' = pruneError actions
-		        val (actions,default) =
-			   let fun hasReduce (nil,actions) = 
-			                      (rev actions,REDUCE rulenum)
-				 | hasReduce ((a as (_,SHIFT _)) :: r,actions) =
-						hasReduce(r,a::actions)
-				 | hasReduce (_ :: r,actions) =
-						 hasReduce(r,actions)
-			       fun loop (nil,actions) = (rev actions,ERROR)
-				 | loop ((a as (_,SHIFT _)) :: r,actions) =
-						loop(r,a::actions)
-				 | loop ((a as (_,REDUCE _)) :: r,actions) =
-						hasReduce(r,actions)
-				 | loop (_ :: r,actions) = loop(r,actions)
-			  in if defaultReductions 
-			       andalso length actions = length actions'
-			     then loop(actions,nil)
-			     else (actions',ERROR)
-			  end
-		     in ((actions,default), gotos,errs)
-		    end
-		 | l =>
-		  let val (reduces,errs1) =
-			 List.foldr (mergeReduces tableState) (nil,nil) l
-		      val (actions,errs2) =
-			 mergeShifts(tableState,shifts,reduces)
-	     	  in ((pruneError actions,ERROR),gotos,errs1@errs2)
-		  end
-	 end
-   end			
+        if DEBUG andalso (state <> state') then
+                 let exception MkTable in raise MkTable end
+        else
+         let val (shifts,gotos) = mapCore (Graph.edges(c,graph),nil,nil)
+             val tableState = STATE state
+         in case reduceItems
+                of nil => ((shifts,ERROR),gotos,nil)
+                 | h :: nil =>
+                    let val (ITEM {rule=RULE {rulenum,...},...}, l) = h
+                        val (reduces,_) = mergeReduces tableState (h,(nil,nil))
+                        val (actions,errs) = mergeShifts(tableState,
+                                                         shifts,reduces)
+                        val actions' = pruneError actions
+                        val (actions,default) =
+                           let fun hasReduce (nil,actions) = 
+                                              (rev actions,REDUCE rulenum)
+                                 | hasReduce ((a as (_,SHIFT _)) :: r,actions) =
+                                                hasReduce(r,a::actions)
+                                 | hasReduce (_ :: r,actions) =
+                                                 hasReduce(r,actions)
+                               fun loop (nil,actions) = (rev actions,ERROR)
+                                 | loop ((a as (_,SHIFT _)) :: r,actions) =
+                                                loop(r,a::actions)
+                                 | loop ((a as (_,REDUCE _)) :: r,actions) =
+                                                hasReduce(r,actions)
+                                 | loop (_ :: r,actions) = loop(r,actions)
+                          in if defaultReductions 
+                               andalso length actions = length actions'
+                             then loop(actions,nil)
+                             else (actions',ERROR)
+                          end
+                     in ((actions,default), gotos,errs)
+                    end
+                 | l =>
+                  let val (reduces,errs1) =
+                         List.foldr (mergeReduces tableState) (nil,nil) l
+                      val (actions,errs2) =
+                         mergeShifts(tableState,shifts,reduces)
+                  in ((pruneError actions,ERROR),gotos,errs1@errs2)
+                  end
+         end
+   end                  
 
-	val mkTable = fn (grammar as GRAMMAR{rules,terms,nonterms,start,
-				  precedence,termToString,noshift,
-				  nontermToString,eop},defaultReductions) =>
-	     let val symbolToString = fn (TERM t) => termToString t
-				       | (NONTERM nt) => nontermToString nt
-	         val {rules,graph,produces,epsProds,...} = Graph.mkGraph grammar
-		 val {nullable,first} =
-		   Look.mkFuncs{rules=rules,produces=produces,nonterms=nonterms}
-		 val lcores = Lalr.addLookahead
-					    {graph=graph,
-					     nullable=nullable,
-					     produces=produces,
-					     eop=eop,
-					     nonterms=nonterms,
-					     first=first,
-					     rules=rules,
-					     epsProds=epsProds,
-					     print=(fn s=>TextIO.output(TextIO.stdOut,s)),
-					     termToString = termToString,
-					     nontermToString = nontermToString}
+        val mkTable = fn (grammar as GRAMMAR{rules,terms,nonterms,start,
+                                  precedence,termToString,noshift,
+                                  nontermToString,eop},defaultReductions) =>
+             let val symbolToString = fn (TERM t) => termToString t
+                                       | (NONTERM nt) => nontermToString nt
+                 val {rules,graph,produces,epsProds,...} = Graph.mkGraph grammar
+                 val {nullable,first} =
+                   Look.mkFuncs{rules=rules,produces=produces,nonterms=nonterms}
+                 val lcores = Lalr.addLookahead
+                                            {graph=graph,
+                                             nullable=nullable,
+                                             produces=produces,
+                                             eop=eop,
+                                             nonterms=nonterms,
+                                             first=first,
+                                             rules=rules,
+                                             epsProds=epsProds,
+                                             print=(fn s=>TextIO.output(TextIO.stdOut,s)),
+                                             termToString = termToString,
+                                             nontermToString = nontermToString}
 
-		  fun zip (h::t,h'::t') = (h,h') :: zip(t,t')
-		    | zip (nil,nil) = nil
-		    | zip _ = let exception MkTable in raise MkTable end
-		  
-		  fun unzip l =
-		   let fun f ((a,b,c)::r,j,k,l) = f(r,a::j,b::k,c::l)
-			 | f (nil,j,k,l) = (rev j,rev k,rev l)
-		   in f(l,nil,nil,nil)
-		   end
-		
-		   val (actions,gotos,errs) =
-			let val doState =
-		            computeActions(rules,precedence,graph,
-					   defaultReductions)
-			in unzip (map doState (zip(lcores,Graph.nodes graph)))
-			end
+                  fun zip (h::t,h'::t') = (h,h') :: zip(t,t')
+                    | zip (nil,nil) = nil
+                    | zip _ = let exception MkTable in raise MkTable end
+                  
+                  fun unzip l =
+                   let fun f ((a,b,c)::r,j,k,l) = f(r,a::j,b::k,c::l)
+                         | f (nil,j,k,l) = (rev j,rev k,rev l)
+                   in f(l,nil,nil,nil)
+                   end
+                
+                   val (actions,gotos,errs) =
+                        let val doState =
+                            computeActions(rules,precedence,graph,
+                                           defaultReductions)
+                        in unzip (map doState (zip(lcores,Graph.nodes graph)))
+                        end
 
-		  (* add goto from state 0 to a new state.  The new state
-		     has accept actions for all of the end-of-parse symbols *)
+                  (* add goto from state 0 to a new state.  The new state
+                     has accept actions for all of the end-of-parse symbols *)
 
-		   val (actions,gotos,errs) =
-		     case gotos
-		     of nil => (actions,gotos,errs)
-		      | h :: t =>
-			let val newStateActions = 
-		           (map (fn t => (t,ACCEPT)) (Look.make_set eop),ERROR)
-			   val state0Goto = 
-			       GotoList.insert((start,STATE (length actions)),h)
-			in (actions @ [newStateActions],
-			    state0Goto :: (t @ [nil]),
-			    errs @ [nil])
-			end 
+                   val (actions,gotos,errs) =
+                     case gotos
+                     of nil => (actions,gotos,errs)
+                      | h :: t =>
+                        let val newStateActions = 
+                           (map (fn t => (t,ACCEPT)) (Look.make_set eop),ERROR)
+                           val state0Goto = 
+                               GotoList.insert((start,STATE (length actions)),h)
+                        in (actions @ [newStateActions],
+                            state0Goto :: (t @ [nil]),
+                            errs @ [nil])
+                        end 
 
-		val startErrs =
-	 	  List.foldr (fn (RULE {rhs,rulenum,...},r) =>
-			if (exists (fn NONTERM a => a=start
-				     | _ => false) rhs)
-			  then START rulenum :: r
-			  else r) [] rules
+                val startErrs =
+                  List.foldr (fn (RULE {rhs,rulenum,...},r) =>
+                        if (exists (fn NONTERM a => a=start
+                                     | _ => false) rhs)
+                          then START rulenum :: r
+                          else r) [] rules
 
-		val nonshiftErrs =
-	 	  List.foldr (fn (RULE {rhs,rulenum,...},r) =>
-		          (List.foldr (fn (nonshift,r) =>
-			   if (exists (fn TERM a => a=nonshift
-				     | _ => false) rhs)
-			    then NS(nonshift,rulenum) :: r
-			    else r) r noshift)
-		       ) [] rules
+                val nonshiftErrs =
+                  List.foldr (fn (RULE {rhs,rulenum,...},r) =>
+                          (List.foldr (fn (nonshift,r) =>
+                           if (exists (fn TERM a => a=nonshift
+                                     | _ => false) rhs)
+                            then NS(nonshift,rulenum) :: r
+                            else r) r noshift)
+                       ) [] rules
 
-		val notReduced =
-		  let val ruleReduced = array(length rules,false)
-		      val test = fn REDUCE i => update(ruleReduced,i,true)
-				  | _ => ()
-		      val _ = app (fn (actions,default) =>
-				     (app (fn (_,r) => test r) actions;
-				      test default)
-				  ) actions;
-		      fun scan (i,r) =
-			 if i >= 0 then
-			      scan(i-1, if ruleReduced sub i then r
-					else NOT_REDUCED i :: r)
-			else r
-		  in scan(Array.length ruleReduced-1,nil)
-	    	  end handle Subscript =>
-			(if DEBUG then
-				print "rules not numbered correctly!"
-			 else (); nil)
+                val notReduced =
+                  let val ruleReduced = array(length rules,false)
+                      val test = fn REDUCE i => update(ruleReduced,i,true)
+                                  | _ => ()
+                      val _ = app (fn (actions,default) =>
+                                     (app (fn (_,r) => test r) actions;
+                                      test default)
+                                  ) actions;
+                      fun scan (i,r) =
+                         if i >= 0 then
+                              scan(i-1, if ruleReduced sub i then r
+                                        else NOT_REDUCED i :: r)
+                        else r
+                  in scan(Array.length ruleReduced-1,nil)
+                  end handle Subscript =>
+                        (if DEBUG then
+                                print "rules not numbered correctly!"
+                         else (); nil)
 
-		val numstates = length actions
+                val numstates = length actions
 
-	        val allErrs = startErrs @ notReduced @ nonshiftErrs @ 
-			      (List.concat errs)
+                val allErrs = startErrs @ notReduced @ nonshiftErrs @ 
+                              (List.concat errs)
 
                 fun convert_to_pairlist(nil : ('a * 'b) list): ('a,'b) pairlist =
-		      EMPTY
+                      EMPTY
                   | convert_to_pairlist ((a,b) :: r) =
-		      PAIR(a,b,convert_to_pairlist r)
+                      PAIR(a,b,convert_to_pairlist r)
 
-	      in (mkLrTable {actions=Array.fromList(map (fn (a,b) =>
-				     (convert_to_pairlist a,b)) actions),
-			     gotos=Array.fromList (map convert_to_pairlist gotos),
-			     numRules=length rules,numStates=length actions,
-			     initialState=STATE 0},
-		  let val errArray = Array.fromList errs
-		  in fn (STATE state) => errArray sub state
-		  end,
+              in (mkLrTable {actions=Array.fromList(map (fn (a,b) =>
+                                     (convert_to_pairlist a,b)) actions),
+                             gotos=Array.fromList (map convert_to_pairlist gotos),
+                             numRules=length rules,numStates=length actions,
+                             initialState=STATE 0},
+                  let val errArray = Array.fromList errs
+                  in fn (STATE state) => errArray sub state
+                  end,
 
-		  fn print =>
- 		    let val printCore =
-			  prCore(symbolToString,nontermToString,print)
-			val core = Graph.core graph
-		    in fn STATE state =>
-			 printCore (if state=(numstates-1) then
-					 Core.CORE (nil,state)
-				        else (core state))
-		    end,
-		    allErrs)
+                  fn print =>
+                    let val printCore =
+                          prCore(symbolToString,nontermToString,print)
+                        val core = Graph.core graph
+                    in fn STATE state =>
+                         printCore (if state=(numstates-1) then
+                                         Core.CORE (nil,state)
+                                        else (core state))
+                    end,
+                    allErrs)
               end
 end;

Modified: mlton/branches/on-20050420-cmm-branch/mlyacc/src/mkprstruct.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlyacc/src/mkprstruct.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlyacc/src/mkprstruct.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,22 +1,8 @@
-(* ML-Yacc Parser Generator (c) 1989 Andrew W. Appel, David R. Tarditi 
- *
- * $Log: mkprstruct.sml,v $
- * Revision 1.1.1.1  1997/01/14 01:38:06  george
- *   Version 109.24
- *
- * Revision 1.2  1996/02/26  15:02:37  george
- *    print no longer overloaded.
- *    use of makestring has been removed and replaced with Int.toString ..
- *    use of IO replaced with TextIO
- *
- * Revision 1.1.1.1  1996/01/31  16:01:46  george
- * Version 109
- * 
- *)
+(* ML-Yacc Parser Generator (c) 1989 Andrew W. Appel, David R. Tarditi *)
 
 functor mkPrintStruct(structure LrTable : LR_TABLE
-		      structure ShrinkLrTable : SHRINK_LR_TABLE
-		      sharing LrTable = ShrinkLrTable.LrTable):PRINT_STRUCT =
+                      structure ShrinkLrTable : SHRINK_LR_TABLE
+                      sharing LrTable = ShrinkLrTable.LrTable):PRINT_STRUCT =
    struct
       open Array List
       infix 9 sub
@@ -25,15 +11,15 @@
       
      
       (* lineLength = approximately the largest number of characters to allow
-	 on a line when printing out an encode string *)
-	  
+         on a line when printing out an encode string *)
+          
       val lineLength = 72
 
       (* maxLength = length of a table entry.  All table entries are encoded
-	 using two 16-bit integers, one for the terminal number and the other
-	 for the entry.  Each integer is printed as two characters (low byte,
-	 high byte), using the ML ascii escape sequence.  We need 4
-	 characters for each escape sequence and 16 characters for each entry
+         using two 16-bit integers, one for the terminal number and the other
+         for the entry.  Each integer is printed as two characters (low byte,
+         high byte), using the ML ascii escape sequence.  We need 4
+         characters for each escape sequence and 16 characters for each entry
       *)
 
       val maxLength =  16
@@ -43,112 +29,112 @@
       val numEntries = lineLength div maxLength
 
       (* convert integer between 0 and 255 to the three character ascii
-	 decimal escape sequence for it *)
+         decimal escape sequence for it *)
 
       val chr =
-	let val lookup = Array.array(256,"\000")
-	    val intToString = fn i =>
-		if i>=100 then "\\" ^ (Int.toString i)
-		else if i>=10 then "\\0" ^ (Int.toString i)
-		else  "\\00" ^ (Int.toString i)
-	    fun loop n = if n=256 then ()
-			 else (Array.update(lookup,n,intToString n); loop (n+1))
-	in loop 0; fn i => lookup sub i
-	end
+        let val lookup = Array.array(256,"\000")
+            val intToString = fn i =>
+                if i>=100 then "\\" ^ (Int.toString i)
+                else if i>=10 then "\\0" ^ (Int.toString i)
+                else  "\\00" ^ (Int.toString i)
+            fun loop n = if n=256 then ()
+                         else (Array.update(lookup,n,intToString n); loop (n+1))
+        in loop 0; fn i => lookup sub i
+        end
 
       val makeStruct = fn {table,name,print,verbose} =>
        let
-	 val states = numStates table
-	 val rules = numRules table
+         val states = numStates table
+         val rules = numRules table
          fun printPairList (prEntry : 'a * 'b -> unit) l =
-	       let fun f (EMPTY,_) = ()
+               let fun f (EMPTY,_) = ()
                      | f (PAIR(a,b,r),count) =
-			    if count >= numEntries then
-			       (print "\\\n\\"; prEntry(a,b); f(r,1))
-			    else (prEntry(a,b); f(r,(count+1)))
+                            if count >= numEntries then
+                               (print "\\\n\\"; prEntry(a,b); f(r,1))
+                            else (prEntry(a,b); f(r,(count+1)))
                in f(l,0)
                end
          val printList : ('a -> unit) -> 'a list -> unit =
            fn prEntry => fn l =>
                 let fun f (nil,_) = ()
                       | f (a :: r,count) =
-			     if count >= numEntries then
-				 (print "\\\n\\"; prEntry a; f(r,1))
-				else (prEntry a; f(r,count+1))
+                             if count >= numEntries then
+                                 (print "\\\n\\"; prEntry a; f(r,1))
+                                else (prEntry a; f(r,count+1))
                 in f(l,0)
                 end
-	 val prEnd = fn _ => print "\\000\\000\\\n\\"
-	 fun printPairRow prEntry =
-	       let val printEntries = printPairList prEntry
-	       in fn l => (printEntries l; prEnd())
-	       end
-	 fun printPairRowWithDefault (prEntry,prDefault) =
-	       let val f = printPairRow prEntry
-	       in fn (l,default) => (prDefault default; f l)
-	       end
-	 fun printTable (printRow,count) =
-	       (print "\"\\\n\\";
-		let fun f i = if i=count then ()
-			       else (printRow i; f (i+1))
-		in f 0
-		end;
-		print"\"\n")
-	 val printChar = print o chr
+         val prEnd = fn _ => print "\\000\\000\\\n\\"
+         fun printPairRow prEntry =
+               let val printEntries = printPairList prEntry
+               in fn l => (printEntries l; prEnd())
+               end
+         fun printPairRowWithDefault (prEntry,prDefault) =
+               let val f = printPairRow prEntry
+               in fn (l,default) => (prDefault default; f l)
+               end
+         fun printTable (printRow,count) =
+               (print "\"\\\n\\";
+                let fun f i = if i=count then ()
+                               else (printRow i; f (i+1))
+                in f 0
+                end;
+                print"\"\n")
+         val printChar = print o chr
 
-	  (* print an integer between 0 and 2^16-1 as a 2-byte character,
-	     with the low byte first *)
+          (* print an integer between 0 and 2^16-1 as a 2-byte character,
+             with the low byte first *)
 
-	 val printInt = fn i => (printChar (i mod 256);
-				  printChar (i div 256))
+         val printInt = fn i => (printChar (i mod 256);
+                                  printChar (i div 256))
 
-	 (* encode actions as integers:
+         (* encode actions as integers:
 
-		ACCEPT => 0
-		ERROR => 1
-		SHIFT i => 2 + i
-		REDUCE rulenum => numstates+2+rulenum
-	 *)
+                ACCEPT => 0
+                ERROR => 1
+                SHIFT i => 2 + i
+                REDUCE rulenum => numstates+2+rulenum
+         *)
 
-	 val printAction =
-	      fn (REDUCE rulenum) => printInt (rulenum+states+2)
-		 | (SHIFT (STATE i)) => printInt (i+2)
-		 | ACCEPT => printInt 0
-		 | ERROR => printInt 1
-	
-	 val printTermAction = fn (T t,action) =>
-		(printInt (t+1); printAction action)
+         val printAction =
+              fn (REDUCE rulenum) => printInt (rulenum+states+2)
+                 | (SHIFT (STATE i)) => printInt (i+2)
+                 | ACCEPT => printInt 0
+                 | ERROR => printInt 1
+        
+         val printTermAction = fn (T t,action) =>
+                (printInt (t+1); printAction action)
 
-	 val printGoto = fn (NT n,STATE s) => (printInt (n+1); printInt s)
+         val printGoto = fn (NT n,STATE s) => (printInt (n+1); printInt s)
 
-	 val ((rowCount,rowNumbers,actionRows),entries)= 
-	           shrinkActionList(table,verbose)
+         val ((rowCount,rowNumbers,actionRows),entries)= 
+                   shrinkActionList(table,verbose)
          val getActionRow = let val a = Array.fromList actionRows
-	                    in fn i => a sub i
-			    end
-	 val printGotoRow : int -> unit = 
-	       let val f = printPairRow printGoto
+                            in fn i => a sub i
+                            end
+         val printGotoRow : int -> unit = 
+               let val f = printPairRow printGoto
                    val g = describeGoto table
                in fn i => f (g (STATE i))
                end
         val printActionRow =
-	      let val f = printPairRowWithDefault(printTermAction,printAction)
+              let val f = printPairRowWithDefault(printTermAction,printAction)
               in fn i => f (getActionRow i)
               end
-	in print "val ";
-	   print name;
-	   print "=";
-	   print "let val actionRows =\n";
-	   printTable(printActionRow,rowCount);
-	   print "val actionRowNumbers =\n\"";
-	   printList (fn i => printInt i) rowNumbers;
-	   print "\"\n";
-	   print "val gotoT =\n"; 
-	   printTable(printGotoRow,states);
-	   print "val numstates = ";
-	   print (Int.toString states);
-	   print "\nval numrules = ";
-	   print (Int.toString rules);
-	   print "\n\
+        in print "val ";
+           print name;
+           print "=";
+           print "let val actionRows =\n";
+           printTable(printActionRow,rowCount);
+           print "val actionRowNumbers =\n\"";
+           printList (fn i => printInt i) rowNumbers;
+           print "\"\n";
+           print "val gotoT =\n"; 
+           printTable(printGotoRow,states);
+           print "val numstates = ";
+           print (Int.toString states);
+           print "\nval numrules = ";
+           print (Int.toString rules);
+           print "\n\
 \val s = ref \"\" and index = ref 0\n\
 \val string_to_int = fn () => \n\
 \let val i = !index\n\

Modified: mlton/branches/on-20050420-cmm-branch/mlyacc/src/parse.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlyacc/src/parse.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlyacc/src/parse.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,43 +1,26 @@
-(* ML-Yacc Parser Generator (c) 1989 Andrew W. Appel, David R. Tarditi 
- *
- * $Log: parse.sml,v $
- * Revision 1.2  1997/05/23 16:21:10  dbm
- *   SML '97 sharing, where clauses.
- *
-# Revision 1.1.1.1  1997/01/14  01:38:06  george
-#   Version 109.24
-#
- * Revision 1.2  1996/02/26  15:02:38  george
- *    print no longer overloaded.
- *    use of makestring has been removed and replaced with Int.toString ..
- *    use of IO replaced with TextIO
- *
- * Revision 1.1.1.1  1996/01/31  16:01:46  george
- * Version 109
- * 
- *)
+(* ML-Yacc Parser Generator (c) 1989 Andrew W. Appel, David R. Tarditi *)
 
 functor ParseGenParserFun(structure Header : HEADER
-			  structure Parser : ARG_PARSER
-			    where type pos = Header.pos
-			  sharing type Parser.result = Header.parseResult
-			  sharing type Parser.arg = Header.inputSource =
-			                  Parser.lexarg
-			 ) : PARSE_GEN_PARSER =
+                          structure Parser : ARG_PARSER
+                            where type pos = Header.pos
+                          sharing type Parser.result = Header.parseResult
+                          sharing type Parser.arg = Header.inputSource =
+                                          Parser.lexarg
+                         ) : PARSE_GEN_PARSER =
 
  struct
       structure Header = Header
       val parse = fn file =>
           let
-	      val in_str = TextIO.openIn file
-	      val source = Header.newSource(file,in_str,TextIO.stdOut)
-	      val error = fn (s : string,i:int,_) =>
-		              Header.error source i s
-	      val stream =  Parser.makeLexer (fn i => (TextIO.inputN(in_str,i)))
-		            source
-	      val (result,_) = (Header.lineno := 1; 
-				Header.text := nil;
-		                Parser.parse(15,stream,error,source))
-	   in (TextIO.closeIn in_str; (result,source))
-	   end
+              val in_str = TextIO.openIn file
+              val source = Header.newSource(file,in_str,TextIO.stdOut)
+              val error = fn (s : string,i:int,_) =>
+                              Header.error source i s
+              val stream =  Parser.makeLexer (fn i => (TextIO.inputN(in_str,i)))
+                            source
+              val (result,_) = (Header.lineno := 1; 
+                                Header.text := nil;
+                                Parser.parse(15,stream,error,source))
+           in (TextIO.closeIn in_str; (result,source))
+           end
   end;

Modified: mlton/branches/on-20050420-cmm-branch/mlyacc/src/shrink.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlyacc/src/shrink.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlyacc/src/shrink.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,6 @@
+(* Modified by mfluet@acm.org on 2005-8-01.
+ * Update with SML/NJ 110.55+.
+ *)
 (* Modified by sweeks@acm.org on 2000-8-24.
  * Ported to MLton.
  *)
@@ -3,18 +6,5 @@
 type int = Int.int
 
-(* ML-Yacc Parser Generator (c) 1991 Andrew W. Appel, David R. Tarditi 
- *
- * $Log: shrink.sml,v $
- * Revision 1.1.1.1  1997/01/14 01:38:06  george
- *   Version 109.24
- *
- * Revision 1.2  1996/05/30  17:52:58  dbm
- * Lifted a let to a local in definition of createEquivalences to conform with
- * value restriction.
- *
- * Revision 1.1.1.1  1996/01/31  16:01:46  george
- * Version 109
- * 
- *)
+(* ML-Yacc Parser Generator (c) 1991 Andrew W. Appel, David R. Tarditi *)
 
 signature SORT_ARG =
@@ -43,7 +33,7 @@
 
         It returns a triple consisting of:
 
-	  * the number of equivalence classes
+          * the number of equivalence classes
           * a list which maps each original entry to an equivalence
             class.  The nth entry in this list gives the equivalence
             class for the nth entry in the original entry list.
@@ -81,7 +71,7 @@
                  fun scan (a :: b :: rest) = merge(a,b) :: scan rest
                    | scan l = l
 
-	         (* loop: calls scan on a list of lists until only
+                 (* loop: calls scan on a list of lists until only
                     one list is left.  It terminates only if the list of
                     lists is nonempty.  (The pattern match for sort
                     ensures this.) *)
@@ -118,14 +108,14 @@
 
          We then return the length of R, R, and the list that results from
          permuting SE by P.
-     *)	
+     *) 
 
        type entry = A.entry
              
        val gt = fn ((a,_),(b,_)) => A.gt(a,b)
 
        structure Sort = MergeSortFun(type entry = A.entry * int
-     				     val gt = gt)
+                                     val gt = gt)
        val assignIndex =
           fn l =>
              let fun loop (index,nil) = nil
@@ -134,13 +124,13 @@
              end 
     
        local fun loop ((e,_) :: t, prev, class, R , SE: int list) =
-	       if A.eq(e,prev)
-		 then loop(t,e,class,R, class :: SE)
-		 else loop(t,e,class+1,e :: R, (class + 1) :: SE)
-	     | loop (nil,_,_,R,SE) = (rev R, rev SE)
+               if A.eq(e,prev)
+                 then loop(t,e,class,R, class :: SE)
+                 else loop(t,e,class+1,e :: R, (class + 1) :: SE)
+             | loop (nil,_,_,R,SE) = (rev R, rev SE)
        in val createEquivalences =
-	   fn nil => (nil,nil)
-	    | (e,_) :: t => loop(t, e, 0, [e],[0: int])
+           fn nil => (nil,nil)
+            | (e,_) :: t => loop(t, e, 0, [e],[0: int])
        end
 
        val inversePermute = fn permutation =>
@@ -148,20 +138,20 @@
                | l as h :: _ =>
                    let val result = array(length l,h)
                        fun loop (elem :: r, dest :: s) =
-			     (update(result,dest,elem); loop(r,s))
+                             (update(result,dest,elem); loop(r,s))
                          | loop _ = ()
                        fun listofarray(i: int): int list =
-			  if i < Array.length result then 
-				(result sub i) :: listofarray (i+1)
+                          if i < Array.length result then 
+                                (result sub i) :: listofarray (i+1)
                           else nil
                     in loop (l,permutation); listofarray 0
-		    end
+                    end
 
        fun makePermutation x = map (fn (_,b) => b) x
 
        val equivalences = fn l =>
-	   let val EP = assignIndex l
-	       val sorted = Sort.sort EP
+           let val EP = assignIndex l
+               val sorted = Sort.sort EP
                val P = makePermutation sorted
                val (R, SE) = createEquivalences sorted
             in (length R, inversePermute P SE, R)
@@ -170,39 +160,41 @@
 
 functor ShrinkLrTableFun(structure LrTable : LR_TABLE) : SHRINK_LR_TABLE =
     struct
-	structure LrTable = LrTable
+        structure LrTable = LrTable
         open LrTable
         val gtAction = fn (a,b) =>
-	      case a
+              case a
               of SHIFT (STATE s) => 
-		   (case b of SHIFT (STATE s') => s>s' | _ => true)
+                   (case b of SHIFT (STATE s') => s>s' | _ => true)
                | REDUCE i => (case b of SHIFT _ => false | REDUCE i' => i>i'
                                       | _ => true)
                | ACCEPT => (case b of ERROR => true | _ => false)
                | ERROR =>  false
         structure ActionEntryList =
-	    struct
-		type entry = (term,action) pairlist * action
-		val rec eqlist =
-                      fn (EMPTY,EMPTY) => true
-                       | (PAIR (T t,d,r),PAIR(T t',d',r')) =>
-                             t=t' andalso d=d' andalso eqlist(r,r')
-                       | _ => false
-                 val rec gtlist =
-                            fn (PAIR _,EMPTY) => true
-                             | (PAIR(T t,d,r),PAIR(T t',d',r')) =>
-				     t>t' orelse (t=t' andalso
-                                       (gtAction(d,d') orelse
-					 (d=d' andalso gtlist(r,r'))))
-                             | _ => false
-		 val eq = fn ((l,a),(l',a')) => a=a' andalso eqlist(l,l')
-                 val gt = fn ((l,a),(l',a')) => gtAction(a,a')
-		                orelse (a=a' andalso gtlist(l,l'))
+            struct
+                type entry = (term, action) pairlist * action
+                local
+                    fun eqlist (EMPTY, EMPTY) = true
+                      | eqlist (PAIR (T t,d,r),PAIR(T t',d',r')) =
+                        t=t' andalso d=d' andalso eqlist(r,r')
+                      | eqlist _ = false
+                    fun gtlist (PAIR _,EMPTY) = true
+                      | gtlist (PAIR(T t,d,r),PAIR(T t',d',r')) =
+                        t>t' orelse (t=t' andalso
+                                     (gtAction(d,d') orelse
+                                      (d=d' andalso gtlist(r,r'))))
+                      | gtlist _ = false
+                in
+                    fun eq ((l,a): entry, (l',a'): entry) =
+                        a = a' andalso eqlist (l,l')
+                    fun gt ((l,a): entry, (l',a'): entry) =
+                        gtAction(a,a') orelse (a=a' andalso gtlist(l,l'))
+                end
             end
 (*        structure GotoEntryList =
             struct
-	       type entry = (nonterm,state) pairlist
-	       val rec eq = 
+               type entry = (nonterm,state) pairlist
+               val rec eq = 
                     fn (EMPTY,EMPTY) => true
                      | (PAIR (t,d,r),PAIR(t',d',r')) =>
                             t=t' andalso d=d' andalso eq(r,r')
@@ -216,23 +208,23 @@
             end *)
         structure EquivActionList = EquivFun(ActionEntryList)
         val states = fn max =>
-	    let fun f i=if i<max then STATE i :: f(i+1) else nil
+            let fun f i=if i<max then STATE i :: f(i+1) else nil
             in f 0
             end
         val length : ('a,'b) pairlist -> int =
            fn l =>
-	     let fun g(EMPTY,len) = len
+             let fun g(EMPTY,len) = len
                    | g(PAIR(_,_,r),len) = g(r,len+1)
              in g(l,0)
              end
         val size : (('a,'b) pairlist * 'c) list -> int =
-	   fn l =>
-	     let val c = ref 0
+           fn l =>
+             let val c = ref 0
              in (app (fn (row,_) => c := !c + length row) l; !c)
              end
        val shrinkActionList = 
-	 fn (table,verbose) =>
-	   case EquivActionList.equivalences
-	             (map (describeActions table) (states (numStates table)))
+         fn (table,verbose) =>
+           case EquivActionList.equivalences
+                     (map (describeActions table) (states (numStates table)))
            of result as (_,_,l) => (result,if verbose then size l else 0)
 end;

Modified: mlton/branches/on-20050420-cmm-branch/mlyacc/src/sigs.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlyacc/src/sigs.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlyacc/src/sigs.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,6 @@
+(* Modified by mfluet@acm.org on 2005-8-01.
+ * Update with SML/NJ 110.55+.
+ *)
 (* Modified by sweeks@acm.org on 2000-8-24.
  * Ported to MLton.
  *)
@@ -2,25 +5,5 @@
 type int = Int.int
-   
-(* ML-Yacc Parser Generator (c) 1989, 1991 Andrew W. Appel, David R. Tarditi 
- *
- * $Log: sigs.sml,v $
- * Revision 1.1.1.1  1998/04/08 18:40:17  george
- * Version 110.5
- *
- * Revision 1.2  1997/05/20 16:23:21  dbm
- *   SML '97 sharing.
- *
-# Revision 1.1.1.1  1997/01/14  01:38:06  george
-#   Version 109.24
-#
- * Revision 1.2  1996/02/26  15:02:38  george
- *    print no longer overloaded.
- *    use of makestring has been removed and replaced with Int.toString ..
- *    use of IO replaced with TextIO
- *
- * Revision 1.1.1.1  1996/01/31  16:01:46  george
- * Version 109
- * 
- *)
 
+(* ML-Yacc Parser Generator (c) 1989, 1991 Andrew W. Appel, David R. Tarditi *)
+
 signature HEADER =
@@ -51,23 +34,23 @@
 
     datatype prec = LEFT | RIGHT | NONASSOC
     datatype control = NODEFAULT | VERBOSE | PARSER_NAME of symbol |
-	               FUNCTOR of string  | START_SYM of symbol |
-		       NSHIFT of symbol list | POS of string | PURE |
-		       PARSE_ARG of string * string |
-		       TOKEN_SIG_INFO of string
-			   
+                       FUNCTOR of string  | START_SYM of symbol |
+                       NSHIFT of symbol list | POS of string | PURE |
+                       PARSE_ARG of string * string |
+                       TOKEN_SIG_INFO of string
+                           
     datatype rule = RULE of {lhs : symbol, rhs : symbol list,
-		             code : string, prec : symbol option}
+                             code : string, prec : symbol option}
 
     datatype declData = DECL of 
-			{eop : symbol list,
-			 keyword : symbol list,
-			 nonterm : (symbol * ty option) list option,
-			 prec : (prec * (symbol list)) list,
-			 change: (symbol list * symbol list) list,
-			 term : (symbol * ty option) list option,
-			 control : control list,
-			 value : (symbol * string) list}
+                        {eop : symbol list,
+                         keyword : symbol list,
+                         nonterm : (symbol * ty option) list option,
+                         prec : (prec * (symbol list)) list,
+                         change: (symbol list * symbol list) list,
+                         term : (symbol * ty option) list option,
+                         control : control list,
+                         value : (symbol * string) list}
 
      val join_decls : declData * declData * inputSource * pos -> declData
 
@@ -88,215 +71,215 @@
 
 signature GRAMMAR =
     sig
-	
-	datatype term = T of int
-	datatype nonterm = NT of int
-	datatype symbol = TERM of term | NONTERM of nonterm
+        
+        datatype term = T of int
+        datatype nonterm = NT of int
+        datatype symbol = TERM of term | NONTERM of nonterm
 
-	(* grammar:
-	     terminals should be numbered from 0 to terms-1,
-	     nonterminals should be numbered from 0 to nonterms-1,
-	     rules should be numbered between 0 and (length rules) - 1,
-	     higher precedence binds tighter,
-	     start nonterminal should not occur on the rhs of any rule
-	*)
+        (* grammar:
+             terminals should be numbered from 0 to terms-1,
+             nonterminals should be numbered from 0 to nonterms-1,
+             rules should be numbered between 0 and (length rules) - 1,
+             higher precedence binds tighter,
+             start nonterminal should not occur on the rhs of any rule
+        *)
 
-	datatype grammar = GRAMMAR of
-			{rules: {lhs : nonterm, rhs : symbol list,
-				 precedence : int option, rulenum : int } list,
-			terms: int,
-			nonterms: int,
-			start : nonterm,
-			eop : term list,
-			noshift : term list,
-			precedence : term -> int option,
-			termToString : term -> string,
-			nontermToString : nonterm -> string} 
+        datatype grammar = GRAMMAR of
+                        {rules: {lhs : nonterm, rhs : symbol list,
+                                 precedence : int option, rulenum : int } list,
+                        terms: int,
+                        nonterms: int,
+                        start : nonterm,
+                        eop : term list,
+                        noshift : term list,
+                        precedence : term -> int option,
+                        termToString : term -> string,
+                        nontermToString : nonterm -> string} 
    end
 
 (* signature for internal version of grammar *)
 
 signature INTGRAMMAR =
     sig
-	structure Grammar  : GRAMMAR
-	structure SymbolAssoc : TABLE
-	structure NontermAssoc : TABLE
+        structure Grammar  : GRAMMAR
+        structure SymbolAssoc : TABLE
+        structure NontermAssoc : TABLE
 
-	sharing type SymbolAssoc.key = Grammar.symbol
-	sharing type NontermAssoc.key = Grammar.nonterm
+        sharing type SymbolAssoc.key = Grammar.symbol
+        sharing type NontermAssoc.key = Grammar.nonterm
 
-	datatype rule = RULE of
-		{lhs : Grammar.nonterm,
-		 rhs : Grammar.symbol list,
+        datatype rule = RULE of
+                {lhs : Grammar.nonterm,
+                 rhs : Grammar.symbol list,
 
-	(* internal number of rule - convenient for producing LR graph *)
+        (* internal number of rule - convenient for producing LR graph *)
 
-		 num : int,	
-		 rulenum : int,
-		 precedence : int option}
+                 num : int,     
+                 rulenum : int,
+                 precedence : int option}
 
-	val gtTerm : Grammar.term * Grammar.term -> bool
-	val eqTerm : Grammar.term * Grammar.term -> bool
+        val gtTerm : Grammar.term * Grammar.term -> bool
+        val eqTerm : Grammar.term * Grammar.term -> bool
 
-	val gtNonterm : Grammar.nonterm * Grammar.nonterm -> bool
-	val eqNonterm : Grammar.nonterm * Grammar.nonterm -> bool
+        val gtNonterm : Grammar.nonterm * Grammar.nonterm -> bool
+        val eqNonterm : Grammar.nonterm * Grammar.nonterm -> bool
 
-	val gtSymbol : Grammar.symbol * Grammar.symbol -> bool
-	val eqSymbol : Grammar.symbol * Grammar.symbol -> bool
+        val gtSymbol : Grammar.symbol * Grammar.symbol -> bool
+        val eqSymbol : Grammar.symbol * Grammar.symbol -> bool
 
-	(* Debugging information will be generated only if DEBUG is true. *)
+        (* Debugging information will be generated only if DEBUG is true. *)
 
-	val DEBUG : bool
+        val DEBUG : bool
 
-	val prRule : (Grammar.symbol -> string) * (Grammar.nonterm -> string) *
-				(string -> 'b) -> rule -> unit
-	val prGrammar : (Grammar.symbol -> string)*(Grammar.nonterm -> string) *
-				(string -> unit) -> Grammar.grammar -> unit
+        val prRule : (Grammar.symbol -> string) * (Grammar.nonterm -> string) *
+                                (string -> 'b) -> rule -> unit
+        val prGrammar : (Grammar.symbol -> string)*(Grammar.nonterm -> string) *
+                                (string -> unit) -> Grammar.grammar -> unit
     end
 
 signature CORE =
     sig
-	structure Grammar : GRAMMAR
-	structure IntGrammar : INTGRAMMAR
-	sharing Grammar = IntGrammar.Grammar
+        structure Grammar : GRAMMAR
+        structure IntGrammar : INTGRAMMAR
+        sharing Grammar = IntGrammar.Grammar
 
-	datatype item = ITEM of
-			{ rule : IntGrammar.rule,
-			  dot : int,
+        datatype item = ITEM of
+                        { rule : IntGrammar.rule,
+                          dot : int,
 
 (* rhsAfter: The portion of the rhs of a rule that lies after the dot *)
 
-			  rhsAfter: Grammar.symbol list }
+                          rhsAfter: Grammar.symbol list }
 
 (* eqItem and gtItem compare items *)
 
-	val eqItem : item * item -> bool
-	val gtItem : item * item -> bool
+        val eqItem : item * item -> bool
+        val gtItem : item * item -> bool
 
 (* functions for maintaining ordered item lists *)
 
-	val insert : item * item list -> item list
-	val union : item list * item list -> item list
+        val insert : item * item list -> item list
+        val union : item list * item list -> item list
 
 (* core:  a set of items.  It is represented by an ordered list of items. 
    The list is in ascending order The rule numbers and the positions of the
    dots are used to order the items. *)
 
-	datatype core = CORE of item list * int (* state # *)
+        datatype core = CORE of item list * int (* state # *)
 
 (* gtCore and eqCore compare the lists of items *)
 
-	val gtCore : core * core -> bool
-	val eqCore : core * core -> bool
+        val gtCore : core * core -> bool
+        val eqCore : core * core -> bool
 
 (* functions for debugging *)
 
-	val prItem : (Grammar.symbol -> string) * (Grammar.nonterm -> string) *
-				(string -> unit) -> item -> unit
-	val prCore : (Grammar.symbol -> string) * (Grammar.nonterm -> string) *
-				(string -> unit) -> core -> unit
+        val prItem : (Grammar.symbol -> string) * (Grammar.nonterm -> string) *
+                                (string -> unit) -> item -> unit
+        val prCore : (Grammar.symbol -> string) * (Grammar.nonterm -> string) *
+                                (string -> unit) -> core -> unit
 end
 
 signature CORE_UTILS =
     sig
 
-	structure Grammar : GRAMMAR
-	structure IntGrammar : INTGRAMMAR
-	structure Core : CORE
+        structure Grammar : GRAMMAR
+        structure IntGrammar : INTGRAMMAR
+        structure Core : CORE
 
-	sharing Grammar = IntGrammar.Grammar = Core.Grammar
-	sharing IntGrammar = Core.IntGrammar
+        sharing Grammar = IntGrammar.Grammar = Core.Grammar
+        sharing IntGrammar = Core.IntGrammar
 
 (* mkFuncs: create functions for the set of productions derived from a
    nonterminal, the cores that result from shift/gotos from a core,
     and return a list of rules *)
 
-	val mkFuncs : Grammar.grammar ->
-		{ produces : Grammar.nonterm -> IntGrammar.rule list,
+        val mkFuncs : Grammar.grammar ->
+                { produces : Grammar.nonterm -> IntGrammar.rule list,
 
 (* shifts: take a core and compute all the cores that result from shifts/gotos
    on symbols *)
 
-		  shifts : Core.core -> (Grammar.symbol*Core.item list) list,
-		  rules: IntGrammar.rule list,
+                  shifts : Core.core -> (Grammar.symbol*Core.item list) list,
+                  rules: IntGrammar.rule list,
 
 (* epsProds: take a core compute epsilon productions for it *)
 
-		  epsProds : Core.core -> IntGrammar.rule list}
-	end
+                  epsProds : Core.core -> IntGrammar.rule list}
+        end
 
 signature LRGRAPH =
     sig
-	structure Grammar : GRAMMAR
-	structure IntGrammar : INTGRAMMAR
-	structure Core : CORE
+        structure Grammar : GRAMMAR
+        structure IntGrammar : INTGRAMMAR
+        structure Core : CORE
 
-	sharing Grammar = IntGrammar.Grammar = Core.Grammar
-	sharing IntGrammar = Core.IntGrammar
+        sharing Grammar = IntGrammar.Grammar = Core.Grammar
+        sharing IntGrammar = Core.IntGrammar
 
-	type graph
-	val edges : Core.core * graph -> {edge:Grammar.symbol,to:Core.core} list
-	val nodes : graph -> Core.core list
-	val shift : graph -> int * Grammar.symbol -> int (* int = state # *)
-	val core : graph -> int -> Core.core (* get core for a state *)
+        type graph
+        val edges : Core.core * graph -> {edge:Grammar.symbol,to:Core.core} list
+        val nodes : graph -> Core.core list
+        val shift : graph -> int * Grammar.symbol -> int (* int = state # *)
+        val core : graph -> int -> Core.core (* get core for a state *)
 
 (* mkGraph: compute the LR(0) sets of items *)
 
-	val mkGraph :  Grammar.grammar ->
-			 {graph : graph,
-			  produces : Grammar.nonterm -> IntGrammar.rule list,
-			  rules : IntGrammar.rule list,
-			  epsProds: Core.core -> IntGrammar.rule list}
+        val mkGraph :  Grammar.grammar ->
+                         {graph : graph,
+                          produces : Grammar.nonterm -> IntGrammar.rule list,
+                          rules : IntGrammar.rule list,
+                          epsProds: Core.core -> IntGrammar.rule list}
 
-	val prGraph: (Grammar.symbol -> string)*(Grammar.nonterm -> string) *
-				(string -> unit) -> graph -> unit
+        val prGraph: (Grammar.symbol -> string)*(Grammar.nonterm -> string) *
+                                (string -> unit) -> graph -> unit
     end
 
 signature LOOK =
     sig
- 	structure Grammar : GRAMMAR
-	structure IntGrammar : INTGRAMMAR
-	sharing Grammar = IntGrammar.Grammar
+        structure Grammar : GRAMMAR
+        structure IntGrammar : INTGRAMMAR
+        sharing Grammar = IntGrammar.Grammar
 
-	val union : Grammar.term list * Grammar.term list -> Grammar.term list
-	val make_set : Grammar.term list -> Grammar.term list
+        val union : Grammar.term list * Grammar.term list -> Grammar.term list
+        val make_set : Grammar.term list -> Grammar.term list
 
-	val mkFuncs :  {rules : IntGrammar.rule list, nonterms : int,
-			produces : Grammar.nonterm -> IntGrammar.rule list} ->
-		 	    {nullable: Grammar.nonterm -> bool,
-			     first : Grammar.symbol list -> Grammar.term list}
+        val mkFuncs :  {rules : IntGrammar.rule list, nonterms : int,
+                        produces : Grammar.nonterm -> IntGrammar.rule list} ->
+                            {nullable: Grammar.nonterm -> bool,
+                             first : Grammar.symbol list -> Grammar.term list}
 
-	val prLook : (Grammar.term -> string) * (string -> unit) -> 
-			Grammar.term list -> unit
+        val prLook : (Grammar.term -> string) * (string -> unit) -> 
+                        Grammar.term list -> unit
    end
 
 signature LALR_GRAPH =
     sig
-	structure Grammar : GRAMMAR
-	structure IntGrammar : INTGRAMMAR
-	structure Core : CORE
-	structure Graph : LRGRAPH
+        structure Grammar : GRAMMAR
+        structure IntGrammar : INTGRAMMAR
+        structure Core : CORE
+        structure Graph : LRGRAPH
 
-	sharing Grammar = IntGrammar.Grammar = Core.Grammar = Graph.Grammar
-	sharing IntGrammar = Core.IntGrammar = Graph.IntGrammar
-	sharing Core = Graph.Core
+        sharing Grammar = IntGrammar.Grammar = Core.Grammar = Graph.Grammar
+        sharing IntGrammar = Core.IntGrammar = Graph.IntGrammar
+        sharing Core = Graph.Core
 
-	datatype lcore = LCORE of (Core.item * Grammar.term list) list * int
-	val addLookahead : {graph : Graph.graph,
-			    first : Grammar.symbol list -> Grammar.term list,
-			    eop : Grammar.term list,
-			    nonterms : int,
-			    nullable: Grammar.nonterm -> bool,
-			    produces : Grammar.nonterm -> IntGrammar.rule list,
-			    rules : IntGrammar.rule list,
-			    epsProds : Core.core -> IntGrammar.rule list,
-			    print : string -> unit,  (* for debugging *)
-			    termToString : Grammar.term -> string,
-			    nontermToString : Grammar.nonterm -> string} ->
-				lcore list
-	val prLcore : (Grammar.symbol -> string) * (Grammar.nonterm -> string) *
-		      (Grammar.term -> string) * (string -> unit) ->
-					 lcore -> unit
+        datatype lcore = LCORE of (Core.item * Grammar.term list) list * int
+        val addLookahead : {graph : Graph.graph,
+                            first : Grammar.symbol list -> Grammar.term list,
+                            eop : Grammar.term list,
+                            nonterms : int,
+                            nullable: Grammar.nonterm -> bool,
+                            produces : Grammar.nonterm -> IntGrammar.rule list,
+                            rules : IntGrammar.rule list,
+                            epsProds : Core.core -> IntGrammar.rule list,
+                            print : string -> unit,  (* for debugging *)
+                            termToString : Grammar.term -> string,
+                            nontermToString : Grammar.nonterm -> string} ->
+                                lcore list
+        val prLcore : (Grammar.symbol -> string) * (Grammar.nonterm -> string) *
+                      (Grammar.term -> string) * (string -> unit) ->
+                                         lcore -> unit
     end
 
 (* LR_ERRS: errors found while constructing an LR table *)
@@ -312,16 +295,16 @@
        START n : start symbol found on the rhs of rule n *)
 
     datatype err = RR of LrTable.term * LrTable.state * int * int
-		 | SR of LrTable.term * LrTable.state * int
-		 | NS of LrTable.term * int  
-		 | NOT_REDUCED of int
-	         | START of int
+                 | SR of LrTable.term * LrTable.state * int
+                 | NS of LrTable.term * int  
+                 | NOT_REDUCED of int
+                 | START of int
 
      val summary : err list -> {rr : int, sr: int,
-			    not_reduced : int, start : int,nonshift : int}
+                            not_reduced : int, start : int,nonshift : int}
 
      val printSummary : (string -> unit) -> err list -> unit
-				      
+                                      
   end
 
 (* PRINT_STRUCT: prints a structure which includes a value 'table' and a
@@ -332,13 +315,13 @@
   
 signature PRINT_STRUCT =
   sig
-	structure LrTable : LR_TABLE
-	val makeStruct :
-		{table : LrTable.table,
-		 name : string,
-		 print: string -> unit,
+        structure LrTable : LR_TABLE
+        val makeStruct :
+                {table : LrTable.table,
+                 name : string,
+                 print: string -> unit,
                  verbose : bool
-		} -> int
+                } -> int
   end
 
 (* VERBOSE: signature for a structure which takes a table and creates a
@@ -346,17 +329,17 @@
 
 signature VERBOSE =
   sig
-	structure Errs : LR_ERRS
-	val printVerbose :
-		{table : Errs.LrTable.table,
+        structure Errs : LR_ERRS
+        val printVerbose :
+                {table : Errs.LrTable.table,
                  entries : int,
-	         termToString : Errs.LrTable.term -> string,
-	         nontermToString : Errs.LrTable.nonterm -> string,
-		 stateErrs : Errs.LrTable.state -> Errs.err list,
-		 errs : Errs.err list,
-		 print: string -> unit,
-		 printCores : (string -> unit) -> Errs.LrTable.state -> unit,
-		 printRule : (string -> unit) -> int -> unit} -> unit
+                 termToString : Errs.LrTable.term -> string,
+                 nontermToString : Errs.LrTable.nonterm -> string,
+                 stateErrs : Errs.LrTable.state -> Errs.err list,
+                 errs : Errs.err list,
+                 print: string -> unit,
+                 printCores : (string -> unit) -> Errs.LrTable.state -> unit,
+                 printRule : (string -> unit) -> int -> unit} -> unit
   end
 
 (* MAKE_LR_TABLE: signature for a structure which includes a structure
@@ -365,22 +348,22 @@
 
 signature MAKE_LR_TABLE =
    sig
-	structure Grammar : GRAMMAR
-	structure Errs : LR_ERRS
-	structure LrTable : LR_TABLE
-	sharing Errs.LrTable = LrTable
+        structure Grammar : GRAMMAR
+        structure Errs : LR_ERRS
+        structure LrTable : LR_TABLE
+        sharing Errs.LrTable = LrTable
 
-	sharing type LrTable.term = Grammar.term
-	sharing type LrTable.nonterm = Grammar.nonterm
+        sharing type LrTable.term = Grammar.term
+        sharing type LrTable.nonterm = Grammar.nonterm
 
-	(* boolean value determines whether default reductions will be used.
-	   If it is true, reductions will be used. *)
+        (* boolean value determines whether default reductions will be used.
+           If it is true, reductions will be used. *)
 
-	val mkTable : Grammar.grammar * bool ->
-	       LrTable.table *
-	      (LrTable.state -> Errs.err list) *   (* errors in a state *)
-	      ((string -> unit) -> LrTable.state -> unit) *
-	       Errs.err list	(* list of all errors *)
+        val mkTable : Grammar.grammar * bool ->
+               LrTable.table *
+              (LrTable.state -> Errs.err list) *   (* errors in a state *)
+              ((string -> unit) -> LrTable.state -> unit) *
+               Errs.err list    (* list of all errors *)
    end;
 
 (* SHRINK_LR_TABLE: finds unique action entry rows in the  action table
@@ -394,7 +377,7 @@
           row, and a list of unique rows *)
        structure LrTable : LR_TABLE
        val shrinkActionList : LrTable.table * bool ->
-	        (int * int list *
-	           ((LrTable.term,LrTable.action) LrTable.pairlist *
-		    LrTable.action) list) * int
+                (int * int list *
+                   ((LrTable.term,LrTable.action) LrTable.pairlist *
+                    LrTable.action) list) * int
     end

Modified: mlton/branches/on-20050420-cmm-branch/mlyacc/src/sources.mlb
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlyacc/src/sources.mlb	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlyacc/src/sources.mlb	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,33 +1,35 @@
 local
-  $(SML_LIB)/basis/basis.mlb
-  $(SML_LIB)/mlyacc-lib/mlyacc-lib.mlb
-
-  utils.sig
-  utils.sml
-  sigs.sml
-  hdr.sml
-  yacc.grm.sig
-  yacc.grm.sml
-  local
-     $(SML_LIB)/basis/unsafe.mlb
-  in
-     yacc.lex.sml
-  end
-  parse.sml
-  grammar.sml
-  core.sml
-  coreutils.sml
-  graph.sml
-  look.sml
-  lalr.sml
-  mklrtable.sml
-  mkprstruct.sml
-  shrink.sml
-  verbose.sml
-  absyn.sig
-  absyn.sml
-  yacc.sml
-  link.sml
+   $(SML_LIB)/basis/basis.mlb
+   $(SML_LIB)/mlyacc-lib/mlyacc-lib.mlb
+   utils.sig
+   utils.sml
+   sigs.sml
+   hdr.sml
+   yacc.grm.sig
+   yacc.grm.sml
+   local
+      (* import Unsafe in case yacc.lex.sml is generated by an old version of
+       * mllex that creates references to Unsafe.
+       *)
+      $(SML_LIB)/basis/unsafe.mlb
+   in
+      yacc.lex.sml
+   end
+   parse.sml
+   grammar.sml
+   core.sml
+   coreutils.sml
+   graph.sml
+   look.sml
+   lalr.sml
+   mklrtable.sml
+   mkprstruct.sml
+   shrink.sml
+   verbose.sml
+   absyn.sig
+   absyn.sml
+   yacc.sml
+   link.sml
 in
-  structure ParseGen
+   structure ParseGen
 end

Modified: mlton/branches/on-20050420-cmm-branch/mlyacc/src/utils.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlyacc/src/utils.sig	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlyacc/src/utils.sig	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,6 @@
+(* Modified by mfluet@acm.org on 2005-8-01.
+ * Update with SML/NJ 110.55+.
+ *)
 (* Modified by sweeks@acm.org on 2000-8-24.
  * Ported to MLton.
  *)
@@ -2,14 +5,5 @@
 type int = Int.int
-   
-(* ML-Yacc Parser Generator (c) 1989 Andrew W. Appel, David R. Tarditi 
- *
- * $Log: utils.sig,v $
- * Revision 1.1.1.1  1997/01/14 01:38:06  george
- *   Version 109.24
- *
- * Revision 1.1.1.1  1996/01/31  16:01:46  george
- * Version 109
- * 
- *)
 
+(* ML-Yacc Parser Generator (c) 1989 Andrew W. Appel, David R. Tarditi *)
+
 signature ORDSET =
@@ -20,41 +14,41 @@
       type elem
       exception Select_arb
       val app : (elem -> unit) -> set -> unit
-	  and card: set -> int
+          and card: set -> int
           and closure: set * (elem -> set) -> set
           and difference: set * set -> set
           and elem_eq: (elem * elem -> bool)
-	  and elem_gt : (elem * elem -> bool)
+          and elem_gt : (elem * elem -> bool)
           and empty: set
-	  and exists: (elem * set) -> bool
-	  and find : (elem * set)  ->  elem option
-	  and fold: ((elem * 'b) -> 'b) -> set -> 'b -> 'b
+          and exists: (elem * set) -> bool
+          and find : (elem * set)  ->  elem option
+          and fold: ((elem * 'b) -> 'b) -> set -> 'b -> 'b
           and insert: (elem * set) -> set
           and is_empty: set -> bool
           and make_list: set -> elem list
           and make_set: (elem list -> set)
           and partition: (elem -> bool) -> (set -> set * set)
           and remove: (elem * set) -> set
-	  and revfold: ((elem * 'b) -> 'b) -> set -> 'b -> 'b
+          and revfold: ((elem * 'b) -> 'b) -> set -> 'b -> 'b
           and select_arb: set -> elem
-	  and set_eq: (set * set) -> bool
-	  and set_gt: (set * set) -> bool
+          and set_eq: (set * set) -> bool
+          and set_gt: (set * set) -> bool
           and singleton: (elem -> set)
           and union: set * set -> set
    end
 
 signature TABLE =
    sig
-	type 'a table
-	type key
-	val size : 'a table -> int
-	val empty: 'a table
-	val exists: (key * 'a table) -> bool
-	val find : (key * 'a table)  ->  'a option
-	val insert: ((key * 'a) * 'a table) -> 'a table
-	val make_table : (key * 'a ) list -> 'a table
-	val make_list : 'a table -> (key * 'a) list
-	val fold : ((key * 'a) * 'b -> 'b) -> 'a table -> 'b -> 'b
+        type 'a table
+        type key
+        val size : 'a table -> int
+        val empty: 'a table
+        val exists: (key * 'a table) -> bool
+        val find : (key * 'a table)  ->  'a option
+        val insert: ((key * 'a) * 'a table) -> 'a table
+        val make_table : (key * 'a ) list -> 'a table
+        val make_list : 'a table -> (key * 'a) list
+        val fold : ((key * 'a) * 'b -> 'b) -> 'a table -> 'b -> 'b
    end
 
 signature HASH =

Modified: mlton/branches/on-20050420-cmm-branch/mlyacc/src/utils.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlyacc/src/utils.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlyacc/src/utils.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,6 @@
+(* Modified by mfluet@acm.org on 2005-8-01.
+ * Update with SML/NJ 110.55+.
+ *)
 (* Modified by sweeks@acm.org on 2000-8-24.
  * Ported to MLton.
  *)
@@ -3,17 +6,5 @@
 type int = Int.int
 
-(* ML-Yacc Parser Generator (c) 1989 Andrew W. Appel, David R. Tarditi 
- *
- * $Log: utils.sml,v $
- * Revision 1.1.1.1  1998/04/08 18:40:17  george
- * Version 110.5
- *
- * Revision 1.1.1.1  1997/01/14 01:38:06  george
- *   Version 109.24
- *
- * Revision 1.1.1.1  1996/01/31  16:01:47  george
- * Version 109
- * 
- *)
+(* ML-Yacc Parser Generator (c) 1989 Andrew W. Appel, David R. Tarditi *)
 
 (* Implementation of ordered sets using ordered lists and red-black trees.  The
@@ -49,9 +40,9 @@
 *)
 
 functor ListOrdSet(B : sig type elem
-		  	val gt : elem * elem -> bool
-			val eq : elem * elem -> bool
-		    end ) : ORDSET =
+                        val gt : elem * elem -> bool
+                        val eq : elem * elem -> bool
+                    end ) : ORDSET =
 
 struct
  type elem = B.elem
@@ -63,56 +54,56 @@
  val empty = nil
 
  val insert = fn (key,s) =>
-	let fun f (l as (h::t)) =
-		 if elem_gt(key,h) then h::(f t)
-		 else if elem_eq(key,h) then key::t
-		 else key::l
- 	      | f nil = [key]
-	in f s
-	end
-		
+        let fun f (l as (h::t)) =
+                 if elem_gt(key,h) then h::(f t)
+                 else if elem_eq(key,h) then key::t
+                 else key::l
+              | f nil = [key]
+        in f s
+        end
+                
  val select_arb = fn nil => raise Select_arb
- 		   | a::b => a
+                   | a::b => a
 
  val exists = fn (key,s) =>
-	let fun f (h::t) = if elem_gt(key,h) then f t
-			   else elem_eq(h,key) 
- 	      | f nil = false
-	in f s
-	end
+        let fun f (h::t) = if elem_gt(key,h) then f t
+                           else elem_eq(h,key) 
+              | f nil = false
+        in f s
+        end
 
  val find = fn (key,s) =>
-	let fun f (h::t) = if elem_gt(key,h) then f t
-			   else if elem_eq(h,key) then SOME h
-			   else NONE
- 	      | f nil = NONE
-	in f s
-	end
+        let fun f (h::t) = if elem_gt(key,h) then f t
+                           else if elem_eq(h,key) then SOME h
+                           else NONE
+              | f nil = NONE
+        in f s
+        end
    
  fun revfold f lst init = List.foldl f init lst
  fun fold f lst init = List.foldr f init lst
  val app = List.app
 
 fun set_eq(h::t,h'::t') = 
-	(case elem_eq(h,h')
-	  of true => set_eq(t,t')
-	   | a => a)
+        (case elem_eq(h,h')
+          of true => set_eq(t,t')
+           | a => a)
   | set_eq(nil,nil) = true
   | set_eq _ = false
 
 fun set_gt(h::t,h'::t') =
-	(case elem_gt(h,h')
-	  of false => (case (elem_eq(h,h'))
-			of true => set_gt(t,t')
-			 | a => a)
-	   |  a => a)
+        (case elem_gt(h,h')
+          of false => (case (elem_eq(h,h'))
+                        of true => set_gt(t,t')
+                         | a => a)
+           |  a => a)
   | set_gt(_::_,nil) = true
   | set_gt _ = false
-		
+                
 fun union(a as (h::t),b as (h'::t')) =
-	  if elem_gt(h',h) then h::union(t,b)
-	  else if elem_eq(h,h') then h::union(t,t')
-	  else h'::union(a,t')
+          if elem_gt(h',h) then h::union(t,b)
+          else if elem_eq(h,h') then h::union(t,t')
+          else h'::union(a,t')
   | union(nil,s) = s
   | union(s,nil) = s
 
@@ -124,13 +115,13 @@
 
 val partition = fn f => fn s =>
     fold (fn (e,(yes,no)) =>
-	    if (f e) then (e::yes,no) else (e::no,yes)) s (nil,nil)
+            if (f e) then (e::yes,no) else (e::no,yes)) s (nil,nil)
 
 val remove = fn (e,s) =>
     let fun f (l as (h::t)) = if elem_gt(h,e) then l
-			      else if elem_eq(h,e) then t
-			      else h::(f t)
-	  | f nil = nil
+                              else if elem_eq(h,e) then t
+                              else h::(f t)
+          | f nil = nil
     in f s
     end
 
@@ -139,27 +130,27 @@
  fun difference (nil,_) = nil
    | difference (r,nil) = r
    | difference (a as (h::t),b as (h'::t')) =
-	  if elem_gt (h',h) then h::difference(t,b)
-	  else if elem_eq(h',h) then difference(t,t')
-	  else difference(a,t')
+          if elem_gt (h',h) then h::difference(t,b)
+          else if elem_eq(h',h) then difference(t,t')
+          else difference(a,t')
 
  fun singleton X = [X]
 
  fun card(S): int = fold (fn (a,count) => count+1) S 0
 
       local
-	    fun closure'(from, f, result) =
-	      if is_empty from then result
-	      else
-		let val (more,result) =
-			fold (fn (a,(more',result')) =>
-				let val more = f a
-				    val new = difference(more,result)
-				in (union(more',new),union(result',new))
-				end) from
-				 (empty,result)
-		in closure'(more,f,result)
-		end
+            fun closure'(from, f, result) =
+              if is_empty from then result
+              else
+                let val (more,result) =
+                        fold (fn (a,(more',result')) =>
+                                let val more = f a
+                                    val new = difference(more,result)
+                                in (union(more',new),union(result',new))
+                                end) from
+                                 (empty,result)
+                in closure'(more,f,result)
+                end
       in
          fun closure(start, f) = closure'(start, f, start)
       end
@@ -192,10 +183,10 @@
 *)
 
 functor RbOrdSet (B : sig type elem
-			 val eq : (elem*elem) -> bool
-		 	 val gt : (elem*elem) -> bool
-		     end
-		) : ORDSET =
+                         val eq : (elem*elem) -> bool
+                         val gt : (elem*elem) -> bool
+                     end
+                ) : ORDSET =
 struct
 
  type elem = B.elem
@@ -211,43 +202,43 @@
  fun insert(key,t) =
   let fun f EMPTY = TREE(key,RED,EMPTY,EMPTY)
         | f (TREE(k,BLACK,l,r)) =
-	    if elem_gt (key,k)
-	    then case f r
-		 of r as TREE(rk,RED, rl as TREE(rlk,RED,rll,rlr),rr) =>
-			(case l
-			 of TREE(lk,RED,ll,lr) =>
-				TREE(k,RED,TREE(lk,BLACK,ll,lr),
-					   TREE(rk,BLACK,rl,rr))
-			  | _ => TREE(rlk,BLACK,TREE(k,RED,l,rll),
-						TREE(rk,RED,rlr,rr)))
-		  | r as TREE(rk,RED,rl, rr as TREE(rrk,RED,rrl,rrr)) =>
-			(case l
-			 of TREE(lk,RED,ll,lr) =>
-				TREE(k,RED,TREE(lk,BLACK,ll,lr),
-					   TREE(rk,BLACK,rl,rr))
-			  | _ => TREE(rk,BLACK,TREE(k,RED,l,rl),rr))
-	          | r => TREE(k,BLACK,l,r)
-	    else if elem_gt(k,key)
-	    then case f l
-	         of l as TREE(lk,RED,ll, lr as TREE(lrk,RED,lrl,lrr)) =>
-			(case r
-			 of TREE(rk,RED,rl,rr) =>
-				TREE(k,RED,TREE(lk,BLACK,ll,lr),
-					   TREE(rk,BLACK,rl,rr))
-			  | _ => TREE(lrk,BLACK,TREE(lk,RED,ll,lrl),
-						TREE(k,RED,lrr,r)))
-		  | l as TREE(lk,RED, ll as TREE(llk,RED,lll,llr), lr) =>
-			(case r
-			 of TREE(rk,RED,rl,rr) =>
-				TREE(k,RED,TREE(lk,BLACK,ll,lr),
-					   TREE(rk,BLACK,rl,rr))
-			  | _ => TREE(lk,BLACK,ll,TREE(k,RED,lr,r)))
-	          | l => TREE(k,BLACK,l,r)
-	    else TREE(key,BLACK,l,r)
+            if elem_gt (key,k)
+            then case f r
+                 of r as TREE(rk,RED, rl as TREE(rlk,RED,rll,rlr),rr) =>
+                        (case l
+                         of TREE(lk,RED,ll,lr) =>
+                                TREE(k,RED,TREE(lk,BLACK,ll,lr),
+                                           TREE(rk,BLACK,rl,rr))
+                          | _ => TREE(rlk,BLACK,TREE(k,RED,l,rll),
+                                                TREE(rk,RED,rlr,rr)))
+                  | r as TREE(rk,RED,rl, rr as TREE(rrk,RED,rrl,rrr)) =>
+                        (case l
+                         of TREE(lk,RED,ll,lr) =>
+                                TREE(k,RED,TREE(lk,BLACK,ll,lr),
+                                           TREE(rk,BLACK,rl,rr))
+                          | _ => TREE(rk,BLACK,TREE(k,RED,l,rl),rr))
+                  | r => TREE(k,BLACK,l,r)
+            else if elem_gt(k,key)
+            then case f l
+                 of l as TREE(lk,RED,ll, lr as TREE(lrk,RED,lrl,lrr)) =>
+                        (case r
+                         of TREE(rk,RED,rl,rr) =>
+                                TREE(k,RED,TREE(lk,BLACK,ll,lr),
+                                           TREE(rk,BLACK,rl,rr))
+                          | _ => TREE(lrk,BLACK,TREE(lk,RED,ll,lrl),
+                                                TREE(k,RED,lrr,r)))
+                  | l as TREE(lk,RED, ll as TREE(llk,RED,lll,llr), lr) =>
+                        (case r
+                         of TREE(rk,RED,rl,rr) =>
+                                TREE(k,RED,TREE(lk,BLACK,ll,lr),
+                                           TREE(rk,BLACK,rl,rr))
+                          | _ => TREE(lk,BLACK,ll,TREE(k,RED,lr,r)))
+                  | l => TREE(k,BLACK,l,r)
+            else TREE(key,BLACK,l,r)
         | f (TREE(k,RED,l,r)) =
-	    if elem_gt(key,k) then TREE(k,RED,l, f r)
-	    else if elem_gt(k,key) then TREE(k,RED, f l, r)
-	    else TREE(key,RED,l,r)
+            if elem_gt(key,k) then TREE(k,RED,l, f r)
+            else if elem_gt(k,key) then TREE(k,RED, f l, r)
+            else TREE(key,RED,l,r)
    in case f t
       of TREE(k,RED, l as TREE(_,RED,_,_), r) => TREE(k,BLACK,l,r)
        | TREE(k,RED, l, r as TREE(_,RED,_,_)) => TREE(k,BLACK,l,r)
@@ -259,33 +250,33 @@
    
  fun exists(key,t) =
   let fun look EMPTY = false
-	| look (TREE(k,_,l,r)) =
-		if elem_gt(k,key) then look l
-		else if elem_gt(key,k) then look r
-		else true
+        | look (TREE(k,_,l,r)) =
+                if elem_gt(k,key) then look l
+                else if elem_gt(key,k) then look r
+                else true
    in look t
    end
 
  fun find(key,t) =
   let fun look EMPTY = NONE
-	| look (TREE(k,_,l,r)) =
-		if elem_gt(k,key) then look l
-		else if elem_gt(key,k) then look r
-		else SOME k
+        | look (TREE(k,_,l,r)) =
+                if elem_gt(k,key) then look l
+                else if elem_gt(key,k) then look r
+                else SOME k
    in look t
   end
 
   fun revfold f t start =
      let fun scan (EMPTY,value) = value
-	   | scan (TREE(k,_,l,r),value) = scan(r,f(k,scan(l,value)))
+           | scan (TREE(k,_,l,r),value) = scan(r,f(k,scan(l,value)))
      in scan(t,start)
      end
 
    fun fold f t start =
-	let fun scan(EMPTY,value) = value
-	      | scan(TREE(k,_,l,r),value) = scan(l,f(k,scan(r,value)))
-	in scan(t,start)
-	end
+        let fun scan(EMPTY,value) = value
+              | scan(TREE(k,_,l,r),value) = scan(l,f(k,scan(r,value)))
+        in scan(t,start)
+        end
 
    fun app f t =
       let fun scan EMPTY = ()
@@ -298,25 +289,25 @@
 
    fun set_eq (tree1 as (TREE _),tree2 as (TREE _)) =
      let datatype pos = L | R | M
-	 exception Done
-	 fun getvalue(stack as ((a,position)::b)) =
-	    (case a
-	     of (TREE(k,_,l,r)) =>
-		(case position
-		 of L => getvalue ((l,L)::(a,M)::b)
-		  | M => (k,case r of  EMPTY => b | _ => (a,R)::b)
-		  | R => getvalue ((r,L)::b)
-		 )
-	      | EMPTY => getvalue b
-	     )
-	    | getvalue(nil) = raise Done
-	  fun f (nil,nil) = true
-	    | f (s1 as (_ :: _),s2 as (_ :: _ )) =
-			  let val (v1,news1) = getvalue s1
-			      and (v2,news2) = getvalue s2
-			  in (elem_eq(v1,v2)) andalso f(news1,news2)
-			  end
-	    | f _ = false
+         exception Done
+         fun getvalue(stack as ((a,position)::b)) =
+            (case a
+             of (TREE(k,_,l,r)) =>
+                (case position
+                 of L => getvalue ((l,L)::(a,M)::b)
+                  | M => (k,case r of  EMPTY => b | _ => (a,R)::b)
+                  | R => getvalue ((r,L)::b)
+                 )
+              | EMPTY => getvalue b
+             )
+            | getvalue(nil) = raise Done
+          fun f (nil,nil) = true
+            | f (s1 as (_ :: _),s2 as (_ :: _ )) =
+                          let val (v1,news1) = getvalue s1
+                              and (v2,news2) = getvalue s2
+                          in (elem_eq(v1,v2)) andalso f(news1,news2)
+                          end
+            | f _ = false
       in f ((tree1,L)::nil,(tree2,L)::nil) handle Done => false
       end
     | set_eq (EMPTY,EMPTY) = true
@@ -326,26 +317,26 @@
 
    fun set_gt (tree1,tree2) =
      let datatype pos = L | R | M
-	 exception Done
-	 fun getvalue(stack as ((a,position)::b)) =
-	    (case a
-	     of (TREE(k,_,l,r)) =>
-		(case position
-		 of L => getvalue ((l,L)::(a,M)::b)
-		  | M => (k,case r of EMPTY => b | _ => (a,R)::b)
-		  | R => getvalue ((r,L)::b)
-		 )
-	      | EMPTY => getvalue b
-	     )
-	    | getvalue(nil) = raise Done
-	  fun f (nil,nil) = false
-	    | f (s1 as (_ :: _),s2 as (_ :: _ )) =
-			  let val (v1,news1) = getvalue s1
-			      and (v2,news2) = getvalue s2
-			  in (elem_gt(v1,v2)) orelse (elem_eq(v1,v2) andalso f(news1,news2))
-			  end
-	    | f (_,nil) = true
-	    | f (nil,_) = false
+         exception Done
+         fun getvalue(stack as ((a,position)::b)) =
+            (case a
+             of (TREE(k,_,l,r)) =>
+                (case position
+                 of L => getvalue ((l,L)::(a,M)::b)
+                  | M => (k,case r of EMPTY => b | _ => (a,R)::b)
+                  | R => getvalue ((r,L)::b)
+                 )
+              | EMPTY => getvalue b
+             )
+            | getvalue(nil) = raise Done
+          fun f (nil,nil) = false
+            | f (s1 as (_ :: _),s2 as (_ :: _ )) =
+                          let val (v1,news1) = getvalue s1
+                              and (v2,news2) = getvalue s2
+                          in (elem_gt(v1,v2)) orelse (elem_eq(v1,v2) andalso f(news1,news2))
+                          end
+            | f (_,nil) = true
+            | f (nil,_) = false
       in f ((tree1,L)::nil,(tree2,L)::nil) handle Done => false
       end
 
@@ -357,9 +348,9 @@
       fun make_set l = List.foldr insert empty l
 
       fun partition F S = fold (fn (a,(Yes,No)) =>
-				if F(a) then (insert(a,Yes),No)
-				else (Yes,insert(a,No)))
-			     S (empty,empty)
+                                if F(a) then (insert(a,Yes),No)
+                                else (Yes,insert(a,No)))
+                             S (empty,empty)
 
       fun remove(X, XSet) =
              let val (YSet, _) =
@@ -368,9 +359,9 @@
              end
 
       fun difference(Xs, Ys) =
-	   fold (fn (p as (a,Xs')) =>
-		      if exists(a,Ys) then Xs' else insert p)
-	   Xs empty
+           fold (fn (p as (a,Xs')) =>
+                      if exists(a,Ys) then Xs' else insert p)
+           Xs empty
 
       fun singleton X = insert(X,empty)
 
@@ -379,18 +370,18 @@
       fun union(Xs,Ys)= fold insert Ys Xs
 
       local
-	    fun closure'(from, f, result) =
-	      if is_empty from then result
-	      else
-		let val (more,result) =
-			fold (fn (a,(more',result')) =>
-				let val more = f a
-				    val new = difference(more,result)
-				in (union(more',new),union(result',new))
-				end) from
-				 (empty,result)
-		in closure'(more,f,result)
-		end
+            fun closure'(from, f, result) =
+              if is_empty from then result
+              else
+                let val (more,result) =
+                        fold (fn (a,(more',result')) =>
+                                let val more = f a
+                                    val new = difference(more,result)
+                                in (union(more',new),union(result',new))
+                                end) from
+                                 (empty,result)
+                in closure'(more,f,result)
+                end
       in
          fun closure(start, f) = closure'(start, f, start)
       end
@@ -400,30 +391,30 @@
 (* In utils.sig
 signature TABLE =
    sig
-	type 'a table
-	type key
-	val size : 'a table -> int
-	val empty: 'a table
-	val exists: (key * 'a table) -> bool
-	val find : (key * 'a table)  ->  'a option
-	val insert: ((key * 'a) * 'a table) -> 'a table
-	val make_table : (key * 'a ) list -> 'a table
-	val make_list : 'a table -> (key * 'a) list
-	val fold : ((key * 'a) * 'b -> 'b) -> 'a table -> 'b -> 'b
+        type 'a table
+        type key
+        val size : 'a table -> int
+        val empty: 'a table
+        val exists: (key * 'a table) -> bool
+        val find : (key * 'a table)  ->  'a option
+        val insert: ((key * 'a) * 'a table) -> 'a table
+        val make_table : (key * 'a ) list -> 'a table
+        val make_list : 'a table -> (key * 'a) list
+        val fold : ((key * 'a) * 'b -> 'b) -> 'a table -> 'b -> 'b
    end
 *)
 
 functor Table (B : sig type key
-		      val gt : (key * key) -> bool
-		     end
-		) : TABLE =
+                      val gt : (key * key) -> bool
+                     end
+                ) : TABLE =
 struct
 
  datatype Color = RED | BLACK
  type key = B.key
 
  abstype 'a table = EMPTY
-		  | TREE of ((B.key * 'a ) * Color * 'a table * 'a table)
+                  | TREE of ((B.key * 'a ) * Color * 'a table * 'a table)
  with
 
  val empty = EMPTY
@@ -431,45 +422,45 @@
  fun insert(elem as (key,data),t) =
   let val key_gt = fn (a,_) => B.gt(key,a)
       val key_lt = fn (a,_) => B.gt(a,key)
-	fun f EMPTY = TREE(elem,RED,EMPTY,EMPTY)
+        fun f EMPTY = TREE(elem,RED,EMPTY,EMPTY)
         | f (TREE(k,BLACK,l,r)) =
-	    if key_gt k
-	    then case f r
-		 of r as TREE(rk,RED, rl as TREE(rlk,RED,rll,rlr),rr) =>
-			(case l
-			 of TREE(lk,RED,ll,lr) =>
-				TREE(k,RED,TREE(lk,BLACK,ll,lr),
-					   TREE(rk,BLACK,rl,rr))
-			  | _ => TREE(rlk,BLACK,TREE(k,RED,l,rll),
-						TREE(rk,RED,rlr,rr)))
-		  | r as TREE(rk,RED,rl, rr as TREE(rrk,RED,rrl,rrr)) =>
-			(case l
-			 of TREE(lk,RED,ll,lr) =>
-				TREE(k,RED,TREE(lk,BLACK,ll,lr),
-					   TREE(rk,BLACK,rl,rr))
-			  | _ => TREE(rk,BLACK,TREE(k,RED,l,rl),rr))
-	          | r => TREE(k,BLACK,l,r)
-	    else if key_lt k
-	    then case f l
-	         of l as TREE(lk,RED,ll, lr as TREE(lrk,RED,lrl,lrr)) =>
-			(case r
-			 of TREE(rk,RED,rl,rr) =>
-				TREE(k,RED,TREE(lk,BLACK,ll,lr),
-					   TREE(rk,BLACK,rl,rr))
-			  | _ => TREE(lrk,BLACK,TREE(lk,RED,ll,lrl),
-						TREE(k,RED,lrr,r)))
-		  | l as TREE(lk,RED, ll as TREE(llk,RED,lll,llr), lr) =>
-			(case r
-			 of TREE(rk,RED,rl,rr) =>
-				TREE(k,RED,TREE(lk,BLACK,ll,lr),
-					   TREE(rk,BLACK,rl,rr))
-			  | _ => TREE(lk,BLACK,ll,TREE(k,RED,lr,r)))
-	          | l => TREE(k,BLACK,l,r)
-	    else TREE(elem,BLACK,l,r)
+            if key_gt k
+            then case f r
+                 of r as TREE(rk,RED, rl as TREE(rlk,RED,rll,rlr),rr) =>
+                        (case l
+                         of TREE(lk,RED,ll,lr) =>
+                                TREE(k,RED,TREE(lk,BLACK,ll,lr),
+                                           TREE(rk,BLACK,rl,rr))
+                          | _ => TREE(rlk,BLACK,TREE(k,RED,l,rll),
+                                                TREE(rk,RED,rlr,rr)))
+                  | r as TREE(rk,RED,rl, rr as TREE(rrk,RED,rrl,rrr)) =>
+                        (case l
+                         of TREE(lk,RED,ll,lr) =>
+                                TREE(k,RED,TREE(lk,BLACK,ll,lr),
+                                           TREE(rk,BLACK,rl,rr))
+                          | _ => TREE(rk,BLACK,TREE(k,RED,l,rl),rr))
+                  | r => TREE(k,BLACK,l,r)
+            else if key_lt k
+            then case f l
+                 of l as TREE(lk,RED,ll, lr as TREE(lrk,RED,lrl,lrr)) =>
+                        (case r
+                         of TREE(rk,RED,rl,rr) =>
+                                TREE(k,RED,TREE(lk,BLACK,ll,lr),
+                                           TREE(rk,BLACK,rl,rr))
+                          | _ => TREE(lrk,BLACK,TREE(lk,RED,ll,lrl),
+                                                TREE(k,RED,lrr,r)))
+                  | l as TREE(lk,RED, ll as TREE(llk,RED,lll,llr), lr) =>
+                        (case r
+                         of TREE(rk,RED,rl,rr) =>
+                                TREE(k,RED,TREE(lk,BLACK,ll,lr),
+                                           TREE(rk,BLACK,rl,rr))
+                          | _ => TREE(lk,BLACK,ll,TREE(k,RED,lr,r)))
+                  | l => TREE(k,BLACK,l,r)
+            else TREE(elem,BLACK,l,r)
         | f (TREE(k,RED,l,r)) =
-	    if key_gt k then TREE(k,RED,l, f r)
-	    else if key_lt k then TREE(k,RED, f l, r)
-	    else TREE(elem,RED,l,r)
+            if key_gt k then TREE(k,RED,l, f r)
+            else if key_lt k then TREE(k,RED, f l, r)
+            else TREE(elem,RED,l,r)
    in case f t
       of TREE(k,RED, l as TREE(_,RED,_,_), r) => TREE(k,BLACK,l,r)
        | TREE(k,RED, l, r as TREE(_,RED,_,_)) => TREE(k,BLACK,l,r)
@@ -478,27 +469,27 @@
 
  fun exists(key,t) =
   let fun look EMPTY = false
-	| look (TREE((k,_),_,l,r)) =
-		if B.gt(k,key) then look l
-		else if B.gt(key,k) then look r
-		else true
+        | look (TREE((k,_),_,l,r)) =
+                if B.gt(k,key) then look l
+                else if B.gt(key,k) then look r
+                else true
    in look t
    end
 
  fun find(key,t) =
   let fun look EMPTY = NONE
-	| look (TREE((k,data),_,l,r)) =
-		if B.gt(k,key) then look l
-		else if B.gt(key,k) then look r
-		else SOME data
+        | look (TREE((k,data),_,l,r)) =
+                if B.gt(k,key) then look l
+                else if B.gt(key,k) then look r
+                else SOME data
    in look t
   end
 
   fun fold f t start =
-	let fun scan(EMPTY,value) = value
-	      | scan(TREE(k,_,l,r),value) = scan(l,f(k,scan(r,value)))
-	in scan(t,start)
-	end
+        let fun scan(EMPTY,value) = value
+              | scan(TREE(k,_,l,r),value) = scan(l,f(k,scan(r,value)))
+        in scan(t,start)
+        end
 
   fun make_table l = List.foldr insert empty l
 
@@ -530,12 +521,12 @@
    a unique integer between 0 and n-1 *)
 
 functor Hash(B : sig type elem
-		     val gt : elem * elem -> bool
-		 end) : HASH =
+                     val gt : elem * elem -> bool
+                 end) : HASH =
 struct
     type elem=B.elem
     structure HashTable = Table(type key=B.elem
-				val gt = B.gt)
+                                val gt = B.gt)
 
     type table = {count : int, table : int HashTable.table}
 

Modified: mlton/branches/on-20050420-cmm-branch/mlyacc/src/verbose.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlyacc/src/verbose.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlyacc/src/verbose.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,6 @@
+(* Modified by mfluet@acm.org on 2005-8-01.
+ * Update with SML/NJ 110.55+.
+ *)
 (* Modified by sweeks@acm.org on 2000-8-24.
  * Ported to MLton.
  *)
@@ -3,19 +6,5 @@
 type int = Int.int
 
-(* ML-Yacc Parser Generator (c) 1989 Andrew W. Appel, David R. Tarditi 
- *
- * $Log: verbose.sml,v $
- * Revision 1.1.1.1  1997/01/14 01:38:06  george
- *   Version 109.24
- *
- * Revision 1.2  1996/02/26  15:02:39  george
- *    print no longer overloaded.
- *    use of makestring has been removed and replaced with Int.toString ..
- *    use of IO replaced with TextIO
- *
- * Revision 1.1.1.1  1996/01/31  16:01:47  george
- * Version 109
- * 
- *)
+(* ML-Yacc Parser Generator (c) 1989 Andrew W. Appel, David R. Tarditi *)
 
 functor mkVerbose(structure Errs : LR_ERRS) : VERBOSE =
@@ -24,82 +13,82 @@
    structure Errs = Errs
    open Errs Errs.LrTable
    val mkPrintAction = fn print =>
-	let val printInt = print o (Int.toString : int -> string)
-	in fn (SHIFT (STATE i)) =>
-			(print "\tshift ";
-		 	 printInt i;
-		 	print "\n")
-	     | (REDUCE rulenum) =>
-			(print "\treduce by rule ";
-		 	 printInt rulenum;
-		 	 print "\n")
-	     | ACCEPT => print "\taccept\n"
-	     | ERROR => print "\terror\n"
-	end
+        let val printInt = print o (Int.toString : int -> string)
+        in fn (SHIFT (STATE i)) =>
+                        (print "\tshift ";
+                         printInt i;
+                        print "\n")
+             | (REDUCE rulenum) =>
+                        (print "\treduce by rule ";
+                         printInt rulenum;
+                         print "\n")
+             | ACCEPT => print "\taccept\n"
+             | ERROR => print "\terror\n"
+        end
    val mkPrintGoto = fn (printNonterm,print) =>
       let val printInt = print o (Int.toString : int -> string)
       in fn (nonterm,STATE i) =>
-		(print "\t";
-		 printNonterm nonterm;
-		 print "\tgoto ";
-		 printInt i;
-		 print "\n")
+                (print "\t";
+                 printNonterm nonterm;
+                 print "\tgoto ";
+                 printInt i;
+                 print "\n")
       end
 
    val mkPrintTermAction = fn (printTerm,print) =>
- 	let val printAction = mkPrintAction print
-	in fn (term,action) =>
-		(print "\t";
-		 printTerm term;
-		 printAction action)
-	end
+        let val printAction = mkPrintAction print
+        in fn (term,action) =>
+                (print "\t";
+                 printTerm term;
+                 printAction action)
+        end
    val mkPrintGoto = fn (printNonterm,print) =>
-	fn (nonterm,STATE i) =>
-	    let val printInt = print o (Int.toString : int -> string)
-	    in (print "\t";
-		printNonterm nonterm;
-		print "\tgoto ";
-		printInt i;
-		print "\n")
-	    end
+        fn (nonterm,STATE i) =>
+            let val printInt = print o (Int.toString : int -> string)
+            in (print "\t";
+                printNonterm nonterm;
+                print "\tgoto ";
+                printInt i;
+                print "\n")
+            end
    val mkPrintError = fn (printTerm,printRule,print) =>
      let val printInt = print o (Int.toString : int -> string)
-	 val printState = fn STATE s => (print " state "; printInt s)
+         val printState = fn STATE s => (print " state "; printInt s)
      in fn (RR (term,state,r1,r2)) =>
-		(print "error: ";
-		 printState state;
-		 print ": reduce/reduce conflict between rule ";
-		 printInt r1;
-		 print " and rule ";
-		 printInt r2;
-		 print " on ";
-		 printTerm term;
-		 print "\n")
-	 | (SR (term,state,r1)) =>
-		(print "error: ";
-		 printState state;
-		 print ": shift/reduce conflict ";
-		 print "(shift ";
-		 printTerm term;
-		 print ", reduce by rule ";
-		 printInt r1;
-		 print ")\n")
-	 | NOT_REDUCED i =>
-		(print "warning: rule <";
-		 printRule i;
-		 print "> will never be reduced\n")
-	 | START i => 
-	        (print "warning: start symbol appears on the rhs of ";
-	         print "<";
-	         printRule i;
-		 print ">\n")
-	 | NS (term,i) =>
-	        (print "warning: non-shiftable terminal ";
-		 printTerm term;
-		 print  "appears on the rhs of ";
-	         print "<";
-	         printRule i;
-		 print ">\n")
+                (print "error: ";
+                 printState state;
+                 print ": reduce/reduce conflict between rule ";
+                 printInt r1;
+                 print " and rule ";
+                 printInt r2;
+                 print " on ";
+                 printTerm term;
+                 print "\n")
+         | (SR (term,state,r1)) =>
+                (print "error: ";
+                 printState state;
+                 print ": shift/reduce conflict ";
+                 print "(shift ";
+                 printTerm term;
+                 print ", reduce by rule ";
+                 printInt r1;
+                 print ")\n")
+         | NOT_REDUCED i =>
+                (print "warning: rule <";
+                 printRule i;
+                 print "> will never be reduced\n")
+         | START i => 
+                (print "warning: start symbol appears on the rhs of ";
+                 print "<";
+                 printRule i;
+                 print ">\n")
+         | NS (term,i) =>
+                (print "warning: non-shiftable terminal ";
+                 printTerm term;
+                 print  "appears on the rhs of ";
+                 print "<";
+                 printRule i;
+                 print ">\n")
       end
    structure PairList : sig 
                           val app : ('a * 'b -> unit) -> ('a,'b) pairlist -> unit
@@ -108,70 +97,70 @@
        =
       struct
          val app = fn f =>
-	     let fun g EMPTY = ()
+             let fun g EMPTY = ()
                    | g (PAIR(a,b,r)) = (f(a,b); g r)
              in g
              end
          val length = fn l =>
-	     let fun g(EMPTY,len) = len
+             let fun g(EMPTY,len) = len
                    | g(PAIR(_,_,r),len) = g(r,len+1)
              in g(l,0: int)
              end
       end
    val printVerbose =
-	fn {termToString,nontermToString,table,stateErrs,entries:int,
-	    print,printRule,errs,printCores} =>
-	   let 
-		val printTerm = print o termToString
-		val printNonterm = print o nontermToString
+        fn {termToString,nontermToString,table,stateErrs,entries:int,
+            print,printRule,errs,printCores} =>
+           let 
+                val printTerm = print o termToString
+                val printNonterm = print o nontermToString
 
-		val printCore = printCores print
-		val printTermAction = mkPrintTermAction(printTerm,print)
-		val printAction = mkPrintAction print
-		val printGoto = mkPrintGoto(printNonterm,print)
-		val printError = mkPrintError(printTerm,printRule print,print)
+                val printCore = printCores print
+                val printTermAction = mkPrintTermAction(printTerm,print)
+                val printAction = mkPrintAction print
+                val printGoto = mkPrintGoto(printNonterm,print)
+                val printError = mkPrintError(printTerm,printRule print,print)
 
-		val gotos = LrTable.describeGoto table
-		val actions = LrTable.describeActions table
-		val states = numStates table
+                val gotos = LrTable.describeGoto table
+                val actions = LrTable.describeActions table
+                val states = numStates table
 
                 val gotoTableSize = ref 0
                 val actionTableSize = ref 0
-		
-		val _ = if length errs > 0 
-			   then (printSummary print errs;
-			         print "\n";
-				 app printError errs)
-			   else ()  
-		fun loop i =
-		  if i=states then ()
-		  else let val s = STATE i
-		       in (app printError (stateErrs s);
-			   print "\n";
-			   printCore s;
-			   let val (actionList,default) = actions s
-			       val gotoList = gotos s
-			   in (PairList.app printTermAction actionList;
-			       print "\n";
-			       PairList.app printGoto gotoList;
-			       print "\n";
-			       print "\t.";
-			       printAction default;
-			       print "\n";
-			       gotoTableSize:=(!gotoTableSize)+
-			                      PairList.length gotoList;
-			       actionTableSize := (!actionTableSize) +
-			                       PairList.length actionList + 1
-			       ) 
-			   end;
-			   loop (i+1))
-			end
-	  in loop 0;
-	      print (Int.toString entries ^ " of " ^
-		     Int.toString (!actionTableSize)^
-		     " action table entries left after compaction\n");
-	      print (Int.toString (!gotoTableSize)^ " goto table entries\n")
-	  end
+                
+                val _ = if length errs > 0 
+                           then (printSummary print errs;
+                                 print "\n";
+                                 app printError errs)
+                           else ()  
+                fun loop i =
+                  if i=states then ()
+                  else let val s = STATE i
+                       in (app printError (stateErrs s);
+                           print "\n";
+                           printCore s;
+                           let val (actionList,default) = actions s
+                               val gotoList = gotos s
+                           in (PairList.app printTermAction actionList;
+                               print "\n";
+                               PairList.app printGoto gotoList;
+                               print "\n";
+                               print "\t.";
+                               printAction default;
+                               print "\n";
+                               gotoTableSize:=(!gotoTableSize)+
+                                              PairList.length gotoList;
+                               actionTableSize := (!actionTableSize) +
+                                               PairList.length actionList + 1
+                               ) 
+                           end;
+                           loop (i+1))
+                        end
+          in loop 0;
+              print (Int.toString entries ^ " of " ^
+                     Int.toString (!actionTableSize)^
+                     " action table entries left after compaction\n");
+              print (Int.toString (!gotoTableSize)^ " goto table entries\n")
+          end
 end;
 
 

Modified: mlton/branches/on-20050420-cmm-branch/mlyacc/src/yacc.grm
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlyacc/src/yacc.grm	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlyacc/src/yacc.grm	2006-02-16 19:34:54 UTC (rev 4361)
@@ -12,217 +12,217 @@
 %left  ASTERISK
 %pos int
 
-%term	ARROW | ASTERISK | BLOCK | BAR | CHANGE | COLON | 
-	COMMA | DELIMITER | EOF | FOR |
-	HEADER of string | ID of string*int | IDDOT of string |
-	PERCENT_HEADER | INT of string | KEYWORD | LBRACE | LPAREN |
-	NAME | NODEFAULT | NONTERM | NOSHIFT | OF |
-	PERCENT_EOP | PERCENT_PURE | PERCENT_POS | PERCENT_ARG |
-	PERCENT_TOKEN_SIG_INFO |
-	PREC of Header.prec | PREC_TAG | PREFER |
-	PROG of string | RBRACE | RPAREN | SUBST | START |
-	TERM | TYVAR of string | VERBOSE | VALUE |
-	UNKNOWN of string | BOGUS_VALUE
+%term   ARROW | ASTERISK | BLOCK | BAR | CHANGE | COLON | 
+        COMMA | DELIMITER | EOF | FOR |
+        HEADER of string | ID of string*int | IDDOT of string |
+        PERCENT_HEADER | INT of string | KEYWORD | LBRACE | LPAREN |
+        NAME | NODEFAULT | NONTERM | NOSHIFT | OF |
+        PERCENT_EOP | PERCENT_PURE | PERCENT_POS | PERCENT_ARG |
+        PERCENT_TOKEN_SIG_INFO |
+        PREC of Header.prec | PREC_TAG | PREFER |
+        PROG of string | RBRACE | RPAREN | SUBST | START |
+        TERM | TYVAR of string | VERBOSE | VALUE |
+        UNKNOWN of string | BOGUS_VALUE
 
 %nonterm
-	BEGIN of string * Hdr.declData * (Hdr.rule list) |
-	CONSTR_LIST of (Hdr.symbol * Hdr.ty option) list |
-	ID_LIST of Hdr.symbol list |
- 	LABEL of string |
- 	MPC_DECL of Hdr.declData |
-	MPC_DECLS of Hdr.declData |
-	QUAL_ID of string |
-	RECORD_LIST of string |
-	RHS_LIST of {rhs:Hdr.symbol list,code:string,
-		     prec:Hdr.symbol option} list |
-	G_RULE of Hdr.rule list |
-	G_RULE_LIST of Hdr.rule list |
-	G_RULE_PREC of Hdr.symbol option |
-	SUBST_DECL of (Hdr.symbol list * Hdr.symbol list) list |
-	SUBST_DEC of (Hdr.symbol list * Hdr.symbol list) |
-	CHANGE_DECL of (Hdr.symbol list * Hdr.symbol list) list |
-	CHANGE_DEC of (Hdr.symbol list * Hdr.symbol list) |
- 	TY of string
+        BEGIN of string * Hdr.declData * (Hdr.rule list) |
+        CONSTR_LIST of (Hdr.symbol * Hdr.ty option) list |
+        ID_LIST of Hdr.symbol list |
+        LABEL of string |
+        MPC_DECL of Hdr.declData |
+        MPC_DECLS of Hdr.declData |
+        QUAL_ID of string |
+        RECORD_LIST of string |
+        RHS_LIST of {rhs:Hdr.symbol list,code:string,
+                     prec:Hdr.symbol option} list |
+        G_RULE of Hdr.rule list |
+        G_RULE_LIST of Hdr.rule list |
+        G_RULE_PREC of Hdr.symbol option |
+        SUBST_DECL of (Hdr.symbol list * Hdr.symbol list) list |
+        SUBST_DEC of (Hdr.symbol list * Hdr.symbol list) |
+        CHANGE_DECL of (Hdr.symbol list * Hdr.symbol list) list |
+        CHANGE_DEC of (Hdr.symbol list * Hdr.symbol list) |
+        TY of string
 %header (
 functor MlyaccLrValsFun(structure Hdr : HEADER
-		          where type prec = Header.prec
-			structure Token : TOKEN)
+                          where type prec = Header.prec
+                        structure Token : TOKEN)
 )
 %arg (inputSource) : Hdr.inputSource
 %%
 
 BEGIN : HEADER MPC_DECLS DELIMITER G_RULE_LIST
-	(HEADER,MPC_DECLS,rev G_RULE_LIST)
+        (HEADER,MPC_DECLS,rev G_RULE_LIST)
 
 MPC_DECLS : MPC_DECLS MPC_DECL
-	      (join_decls(MPC_DECLS,MPC_DECL,inputSource,MPC_DECLleft))
+              (join_decls(MPC_DECLS,MPC_DECL,inputSource,MPC_DECLleft))
 
 MPC_DECLS:  (DECL {prec=nil,nonterm=NONE,term=NONE,eop=nil,control=nil,
-		   keyword=nil,change=nil,
-		   value=nil})
+                   keyword=nil,change=nil,
+                   value=nil})
 
 MPC_DECL: TERM CONSTR_LIST
-	    (DECL { prec=nil,nonterm=NONE,
-	       term = SOME CONSTR_LIST, eop =nil,control=nil,
-		change=nil,keyword=nil,
-		value=nil})
+            (DECL { prec=nil,nonterm=NONE,
+               term = SOME CONSTR_LIST, eop =nil,control=nil,
+                change=nil,keyword=nil,
+                value=nil})
 
-	| NONTERM CONSTR_LIST
-	    (DECL { prec=nil,control=nil,nonterm= SOME CONSTR_LIST,
-	       term = NONE, eop=nil,change=nil,keyword=nil,
-	       value=nil})
+        | NONTERM CONSTR_LIST
+            (DECL { prec=nil,control=nil,nonterm= SOME CONSTR_LIST,
+               term = NONE, eop=nil,change=nil,keyword=nil,
+               value=nil})
 
-	| PREC ID_LIST
-	    (DECL {prec= [(PREC,ID_LIST)],control=nil,
-	      nonterm=NONE,term=NONE,eop=nil,change=nil,
-	      keyword=nil,value=nil})
+        | PREC ID_LIST
+            (DECL {prec= [(PREC,ID_LIST)],control=nil,
+              nonterm=NONE,term=NONE,eop=nil,change=nil,
+              keyword=nil,value=nil})
 
-	| START ID
-	     (DECL {prec=nil,control=[START_SYM (symbolMake ID)],nonterm=NONE,
-	       term = NONE, eop = nil,change=nil,keyword=nil,
-	       value=nil})
+        | START ID
+             (DECL {prec=nil,control=[START_SYM (symbolMake ID)],nonterm=NONE,
+               term = NONE, eop = nil,change=nil,keyword=nil,
+               value=nil})
 
-	| PERCENT_EOP ID_LIST
-	     (DECL {prec=nil,control=nil,nonterm=NONE,term=NONE,
-		eop=ID_LIST, change=nil,keyword=nil,
-	 	value=nil})
+        | PERCENT_EOP ID_LIST
+             (DECL {prec=nil,control=nil,nonterm=NONE,term=NONE,
+                eop=ID_LIST, change=nil,keyword=nil,
+                value=nil})
 
-	| KEYWORD ID_LIST
-	     (DECL {prec=nil,control=nil,nonterm=NONE,term=NONE,eop=nil,
-		change=nil,keyword=ID_LIST,
-	 	value=nil})
+        | KEYWORD ID_LIST
+             (DECL {prec=nil,control=nil,nonterm=NONE,term=NONE,eop=nil,
+                change=nil,keyword=ID_LIST,
+                value=nil})
 
-	| PREFER ID_LIST
-	     (DECL {prec=nil,control=nil,nonterm=NONE,term=NONE,eop=nil,
-		    change=map (fn i=>([],[i])) ID_LIST,keyword=nil,
-		    value=nil})
+        | PREFER ID_LIST
+             (DECL {prec=nil,control=nil,nonterm=NONE,term=NONE,eop=nil,
+                    change=map (fn i=>([],[i])) ID_LIST,keyword=nil,
+                    value=nil})
 
         | CHANGE CHANGE_DECL
-	     (DECL {prec=nil,control=nil,nonterm=NONE,term=NONE,eop=nil,
-		change=CHANGE_DECL,keyword=nil,
-		value=nil})
-	| SUBST SUBST_DECL
-	     (DECL {prec=nil,control=nil,nonterm=NONE,term=NONE,eop=nil,
-		change=SUBST_DECL,keyword=nil,
-		value=nil})
-	| NOSHIFT ID_LIST
-	     (DECL {prec=nil,control=[NSHIFT ID_LIST],nonterm=NONE,term=NONE,
-	            eop=nil,change=nil,keyword=nil,
-		    value=nil})
-	| PERCENT_HEADER PROG
-	     (DECL {prec=nil,control=[FUNCTOR PROG],nonterm=NONE,term=NONE,
-	            eop=nil,change=nil,keyword=nil,
-		    value=nil})
-	| PERCENT_TOKEN_SIG_INFO PROG
-	     (DECL {prec=nil,control=[TOKEN_SIG_INFO PROG],
+             (DECL {prec=nil,control=nil,nonterm=NONE,term=NONE,eop=nil,
+                change=CHANGE_DECL,keyword=nil,
+                value=nil})
+        | SUBST SUBST_DECL
+             (DECL {prec=nil,control=nil,nonterm=NONE,term=NONE,eop=nil,
+                change=SUBST_DECL,keyword=nil,
+                value=nil})
+        | NOSHIFT ID_LIST
+             (DECL {prec=nil,control=[NSHIFT ID_LIST],nonterm=NONE,term=NONE,
+                    eop=nil,change=nil,keyword=nil,
+                    value=nil})
+        | PERCENT_HEADER PROG
+             (DECL {prec=nil,control=[FUNCTOR PROG],nonterm=NONE,term=NONE,
+                    eop=nil,change=nil,keyword=nil,
+                    value=nil})
+        | PERCENT_TOKEN_SIG_INFO PROG
+             (DECL {prec=nil,control=[TOKEN_SIG_INFO PROG],
                     nonterm=NONE,term=NONE,
-	            eop=nil,change=nil,keyword=nil,
-		    value=nil})
-	| NAME ID
-	     (DECL {prec=nil,control=[PARSER_NAME (symbolMake ID)],
-	            nonterm=NONE,term=NONE,
-		    eop=nil,change=nil,keyword=nil, value=nil})
+                    eop=nil,change=nil,keyword=nil,
+                    value=nil})
+        | NAME ID
+             (DECL {prec=nil,control=[PARSER_NAME (symbolMake ID)],
+                    nonterm=NONE,term=NONE,
+                    eop=nil,change=nil,keyword=nil, value=nil})
 
-	| PERCENT_ARG PROG COLON TY
-	     (DECL {prec=nil,control=[PARSE_ARG(PROG,TY)],nonterm=NONE,
-	            term=NONE,eop=nil,change=nil,keyword=nil,
-		     value=nil})
+        | PERCENT_ARG PROG COLON TY
+             (DECL {prec=nil,control=[PARSE_ARG(PROG,TY)],nonterm=NONE,
+                    term=NONE,eop=nil,change=nil,keyword=nil,
+                     value=nil})
 
-	| VERBOSE
-	     (DECL {prec=nil,control=[Hdr.VERBOSE],
-	        nonterm=NONE,term=NONE,eop=nil,
-	        change=nil,keyword=nil,
-		value=nil})
-	| NODEFAULT
-	     (DECL {prec=nil,control=[Hdr.NODEFAULT],
-	        nonterm=NONE,term=NONE,eop=nil,
-	        change=nil,keyword=nil,
-		value=nil})
-	| PERCENT_PURE
-	     (DECL {prec=nil,control=[Hdr.PURE],
-	        nonterm=NONE,term=NONE,eop=nil,
-	        change=nil,keyword=nil,
-		value=nil})
-	| PERCENT_POS TY
-	     (DECL {prec=nil,control=[Hdr.POS TY],
-	        nonterm=NONE,term=NONE,eop=nil,
-	        change=nil,keyword=nil,
-		value=nil})
-	| VALUE ID PROG
-	     (DECL {prec=nil,control=nil,
-	        nonterm=NONE,term=NONE,eop=nil,
-	        change=nil,keyword=nil,
-		value=[(symbolMake ID,PROG)]})
+        | VERBOSE
+             (DECL {prec=nil,control=[Hdr.VERBOSE],
+                nonterm=NONE,term=NONE,eop=nil,
+                change=nil,keyword=nil,
+                value=nil})
+        | NODEFAULT
+             (DECL {prec=nil,control=[Hdr.NODEFAULT],
+                nonterm=NONE,term=NONE,eop=nil,
+                change=nil,keyword=nil,
+                value=nil})
+        | PERCENT_PURE
+             (DECL {prec=nil,control=[Hdr.PURE],
+                nonterm=NONE,term=NONE,eop=nil,
+                change=nil,keyword=nil,
+                value=nil})
+        | PERCENT_POS TY
+             (DECL {prec=nil,control=[Hdr.POS TY],
+                nonterm=NONE,term=NONE,eop=nil,
+                change=nil,keyword=nil,
+                value=nil})
+        | VALUE ID PROG
+             (DECL {prec=nil,control=nil,
+                nonterm=NONE,term=NONE,eop=nil,
+                change=nil,keyword=nil,
+                value=[(symbolMake ID,PROG)]})
 
 CHANGE_DECL : CHANGE_DEC BAR CHANGE_DECL
-	            (CHANGE_DEC :: CHANGE_DECL)
+                    (CHANGE_DEC :: CHANGE_DECL)
             | CHANGE_DEC
-		    ([CHANGE_DEC])
+                    ([CHANGE_DEC])
 
 CHANGE_DEC  : ID_LIST ARROW ID_LIST
-	          (ID_LIST1, ID_LIST2)
+                  (ID_LIST1, ID_LIST2)
 
 SUBST_DECL : SUBST_DEC BAR SUBST_DECL
-	      (SUBST_DEC :: SUBST_DECL)
+              (SUBST_DEC :: SUBST_DECL)
            | SUBST_DEC
-	      ([SUBST_DEC])
+              ([SUBST_DEC])
 
 SUBST_DEC:   ID FOR ID
-	      ([symbolMake ID2],[symbolMake ID1])
+              ([symbolMake ID2],[symbolMake ID1])
 
 CONSTR_LIST : CONSTR_LIST BAR ID OF TY
-	     ((symbolMake ID,SOME (tyMake TY))::CONSTR_LIST)
+             ((symbolMake ID,SOME (tyMake TY))::CONSTR_LIST)
 
-	| CONSTR_LIST BAR ID
-	     ((symbolMake ID,NONE)::CONSTR_LIST)
+        | CONSTR_LIST BAR ID
+             ((symbolMake ID,NONE)::CONSTR_LIST)
 
-	| ID OF TY ([(symbolMake ID,SOME (tyMake TY))])
+        | ID OF TY ([(symbolMake ID,SOME (tyMake TY))])
 
-	| ID ([(symbolMake ID,NONE)])
+        | ID ([(symbolMake ID,NONE)])
 
 G_RULE : ID COLON RHS_LIST
-	(map (fn {rhs,code,prec} =>
-    	          Hdr.RULE {lhs=symbolMake ID,rhs=rhs,
-			       code=code,prec=prec})
-	 RHS_LIST)
+        (map (fn {rhs,code,prec} =>
+                  Hdr.RULE {lhs=symbolMake ID,rhs=rhs,
+                               code=code,prec=prec})
+         RHS_LIST)
 
 G_RULE_LIST:  G_RULE_LIST G_RULE (G_RULE@G_RULE_LIST)
-	|   G_RULE	 (G_RULE)
+        |   G_RULE       (G_RULE)
 
 ID_LIST : ID ID_LIST (symbolMake ID :: ID_LIST)
-	| 	 (nil)
+        |        (nil)
 
 RHS_LIST : ID_LIST G_RULE_PREC PROG
-	    ([{rhs=ID_LIST,code=PROG,prec=G_RULE_PREC}])
+            ([{rhs=ID_LIST,code=PROG,prec=G_RULE_PREC}])
 
-	| RHS_LIST BAR ID_LIST G_RULE_PREC PROG
-	    ({rhs=ID_LIST,code=PROG,prec=G_RULE_PREC}::RHS_LIST)
+        | RHS_LIST BAR ID_LIST G_RULE_PREC PROG
+            ({rhs=ID_LIST,code=PROG,prec=G_RULE_PREC}::RHS_LIST)
 
 TY : TYVAR
- 	(TYVAR)
+        (TYVAR)
    | LBRACE RECORD_LIST RBRACE
-	("{ "^RECORD_LIST^" } ")
+        ("{ "^RECORD_LIST^" } ")
    | LBRACE RBRACE
-	("{}")
+        ("{}")
    | PROG
-	(" ( "^PROG^" ) ")
+        (" ( "^PROG^" ) ")
    | TY QUAL_ID
-	(TY^" "^QUAL_ID)
+        (TY^" "^QUAL_ID)
    | QUAL_ID
-	(QUAL_ID)
+        (QUAL_ID)
    | TY ASTERISK TY
-	(TY1^"*"^TY2)
+        (TY1^"*"^TY2)
    | TY ARROW TY
-	(TY1 ^ " -> " ^ TY2)
+        (TY1 ^ " -> " ^ TY2)
 
 RECORD_LIST : RECORD_LIST COMMA LABEL COLON TY
-		(RECORD_LIST^","^LABEL^":"^TY)
-	   | LABEL COLON TY
-		(LABEL^":"^TY)
+                (RECORD_LIST^","^LABEL^":"^TY)
+           | LABEL COLON TY
+                (LABEL^":"^TY)
 
-QUAL_ID : ID	((fn (a,_) => a) ID)
+QUAL_ID : ID    ((fn (a,_) => a) ID)
        | IDDOT QUAL_ID (IDDOT^QUAL_ID)
-	 
+         
 LABEL : ID  ((fn (a,_) => a) ID)
       | INT (INT)
 

Modified: mlton/branches/on-20050420-cmm-branch/mlyacc/src/yacc.lex
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlyacc/src/yacc.lex	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlyacc/src/yacc.lex	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,6 @@
+(* Modified by mfluet@acm.org on 2005-8-01.
+ * Update with SML/NJ 110.55+.
+ *)
 (* Modified by sweeks@acm.org on 2000-8-24.
  * Ported to MLton.
  *)
@@ -26,29 +29,30 @@
 val actionstart: int ref = ref 0
 
 val eof = fn i => (if (!pcount)>0 then
-			error i (!actionstart)
-			      " eof encountered in action beginning here !"
-		   else (); EOF(!lineno,!lineno))
+                        error i (!actionstart)
+                              " eof encountered in action beginning here !"
+                   else (); EOF(!lineno,!lineno))
 
 val Add = fn s => (text := s::(!text))
 
 
 local val dict = [("%prec",PREC_TAG),("%term",TERM),
-	       ("%nonterm",NONTERM), ("%eop",PERCENT_EOP),("%start",START),
-	       ("%prefer",PREFER),("%subst",SUBST),("%change",CHANGE),
-	       ("%keyword",KEYWORD),("%name",NAME),
-	       ("%verbose",VERBOSE), ("%nodefault",NODEFAULT),
-	       ("%value",VALUE), ("%noshift",NOSHIFT),
-	       ("%header",PERCENT_HEADER),("%pure",PERCENT_PURE),
-	       ("%token_sig_info",PERCENT_TOKEN_SIG_INFO),
-	       ("%arg",PERCENT_ARG),
-	       ("%pos",PERCENT_POS)]
-in val lookup =
-     fn (s,left,right) =>
-	 let fun f ((a,d)::b) = if a=s then d(left,right) else f b
-	       | f nil = UNKNOWN(s,left,right)
-	 in f dict
-	 end
+               ("%nonterm",NONTERM), ("%eop",PERCENT_EOP),("%start",START),
+               ("%prefer",PREFER),("%subst",SUBST),("%change",CHANGE),
+               ("%keyword",KEYWORD),("%name",NAME),
+               ("%verbose",VERBOSE), ("%nodefault",NODEFAULT),
+               ("%value",VALUE), ("%noshift",NOSHIFT),
+               ("%header",PERCENT_HEADER),("%pure",PERCENT_PURE),
+               ("%token_sig_info",PERCENT_TOKEN_SIG_INFO),
+               ("%arg",PERCENT_ARG),
+               ("%pos",PERCENT_POS)]
+in
+fun lookup (s,left,right) = let
+       fun f ((a,d)::b) = if a=s then d(left,right) else f b
+         | f nil = UNKNOWN(s,left,right)
+       in
+          f dict
+       end
 end
 
 fun inc (ri as ref i : int ref) = (ri := i+1)
@@ -57,87 +61,87 @@
 %%
 %header (
 functor LexMLYACC(structure Tokens : Mlyacc_TOKENS
-		  structure Hdr : HEADER (* = Header *)
-		    where type prec = Header.prec
-		      and type inputSource = Header.inputSource) : ARG_LEXER
+                  structure Hdr : HEADER (* = Header *)
+                    where type prec = Header.prec
+                      and type inputSource = Header.inputSource) : ARG_LEXER
 );
 %arg (inputSource);
 %s A CODE F COMMENT STRING EMPTYCOMMENT;
 ws = [\t\ ]+;
+eol=("\n"|"\013\n"|"\013");
 idchars = [A-Za-z_'0-9];
 id=[A-Za-z]{idchars}*;
 tyvar="'"{idchars}*;
 qualid ={id}".";
 %%
-<INITIAL>"(*"	=> (Add yytext; YYBEGIN COMMENT; commentLevel := 1;
-		    continue() before YYBEGIN INITIAL);
-<A>"(*"		=> (YYBEGIN EMPTYCOMMENT; commentLevel := 1; continue());
-<CODE>"(*"	=> (Add yytext; YYBEGIN COMMENT; commentLevel := 1;
-		    continue() before YYBEGIN CODE);
-<INITIAL>[^%\n]+ => (Add yytext; continue());
-<INITIAL>"%%"	 => (YYBEGIN A; HEADER (concat (rev (!text)),!lineno,!lineno));
-<INITIAL,CODE,COMMENT,F,EMPTYCOMMENT>\n  => (Add yytext; inc lineno; continue());
-<INITIAL>.	 => (Add yytext; continue());
+<INITIAL>"(*"   => (Add yytext; YYBEGIN COMMENT; commentLevel := 1;
+                    continue() before YYBEGIN INITIAL);
+<A>"(*"         => (YYBEGIN EMPTYCOMMENT; commentLevel := 1; continue());
+<CODE>"(*"      => (Add yytext; YYBEGIN COMMENT; commentLevel := 1;
+                    continue() before YYBEGIN CODE);
+<INITIAL>[^%\013\n]+ => (Add yytext; continue());
+<INITIAL>"%%"    => (YYBEGIN A; HEADER (concat (rev (!text)),!lineno,!lineno));
+<INITIAL,CODE,COMMENT,F,EMPTYCOMMENT>{eol}  => (Add yytext; inc lineno; continue());
+<INITIAL>.       => (Add yytext; continue());
 
-<A>\n		=> (inc lineno; continue ());
-<A>{ws}+	=> (continue());
-<A>of		=> (OF(!lineno,!lineno));
-<A>for		=> (FOR(!lineno,!lineno));
-<A>"{"		=> (LBRACE(!lineno,!lineno));
-<A>"}"		=> (RBRACE(!lineno,!lineno));
-<A>","		=> (COMMA(!lineno,!lineno));
-<A>"*"		=> (ASTERISK(!lineno,!lineno));
-<A>"->"		=> (ARROW(!lineno,!lineno));
-<A>"%left"	=> (PREC(Hdr.LEFT,!lineno,!lineno));
-<A>"%right"	=> (PREC(Hdr.RIGHT,!lineno,!lineno));
-<A>"%nonassoc" 	=> (PREC(Hdr.NONASSOC,!lineno,!lineno));
-<A>"%"[a-z_]+	=> (lookup(yytext,!lineno,!lineno));
-<A>{tyvar}	=> (TYVAR(yytext,!lineno,!lineno));
-<A>{qualid}	=> (IDDOT(yytext,!lineno,!lineno));
-<A>[0-9]+	=> (INT (yytext,!lineno,!lineno));
-<A>"%%"		=> (DELIMITER(!lineno,!lineno));
-<A>":"		=> (COLON(!lineno,!lineno));
-<A>"|"		=> (BAR(!lineno,!lineno));
-<A>{id}		=> (ID ((yytext,!lineno),!lineno,!lineno));
-<A>"("		=> (pcount := 1; actionstart := (!lineno);
-		    text := nil; YYBEGIN CODE; continue() before YYBEGIN A);
-<A>.		=> (UNKNOWN(yytext,!lineno,!lineno));
-<CODE>"("	=> (inc pcount; Add yytext; continue());
-<CODE>")"	=> (dec pcount;
-		    if !pcount = 0 then
-			 PROG (concat (rev (!text)),!lineno,!lineno)
-		    else (Add yytext; continue()));
-<CODE>"\""	=> (Add yytext; YYBEGIN STRING; continue());
-<CODE>[^()"\n]+	=> (Add yytext; continue());
+<A>{eol}        => (inc lineno; continue ());
+<A>{ws}+        => (continue());
+<A>of           => (OF(!lineno,!lineno));
+<A>for          => (FOR(!lineno,!lineno));
+<A>"{"          => (LBRACE(!lineno,!lineno));
+<A>"}"          => (RBRACE(!lineno,!lineno));
+<A>","          => (COMMA(!lineno,!lineno));
+<A>"*"          => (ASTERISK(!lineno,!lineno));
+<A>"->"         => (ARROW(!lineno,!lineno));
+<A>"%left"      => (PREC(Hdr.LEFT,!lineno,!lineno));
+<A>"%right"     => (PREC(Hdr.RIGHT,!lineno,!lineno));
+<A>"%nonassoc"  => (PREC(Hdr.NONASSOC,!lineno,!lineno));
+<A>"%"[a-z_]+   => (lookup(yytext,!lineno,!lineno));
+<A>{tyvar}      => (TYVAR(yytext,!lineno,!lineno));
+<A>{qualid}     => (IDDOT(yytext,!lineno,!lineno));
+<A>[0-9]+       => (INT (yytext,!lineno,!lineno));
+<A>"%%"         => (DELIMITER(!lineno,!lineno));
+<A>":"          => (COLON(!lineno,!lineno));
+<A>"|"          => (BAR(!lineno,!lineno));
+<A>{id}         => (ID ((yytext,!lineno),!lineno,!lineno));
+<A>"("          => (pcount := 1; actionstart := (!lineno);
+                    text := nil; YYBEGIN CODE; continue() before YYBEGIN A);
+<A>.            => (UNKNOWN(yytext,!lineno,!lineno));
+<CODE>"("       => (inc pcount; Add yytext; continue());
+<CODE>")"       => (dec pcount;
+                    if !pcount = 0 then
+                         PROG (concat (rev (!text)),!lineno,!lineno)
+                    else (Add yytext; continue()));
+<CODE>"\""      => (Add yytext; YYBEGIN STRING; continue());
+<CODE>[^()"\n\013]+ => (Add yytext; continue());
 
-<COMMENT>[(*)]	=> (Add yytext; continue());
-<COMMENT>"*)"	=> (Add yytext; dec commentLevel;
-		    if !commentLevel=0
-			 then BOGUS_VALUE(!lineno,!lineno)
-			 else continue()
-		   );
-<COMMENT>"(*"	=> (Add yytext; inc commentLevel; continue());
-<COMMENT>[^*()\n]+ => (Add yytext; continue());
+<COMMENT>[(*)]  => (Add yytext; continue());
+<COMMENT>"*)"   => (Add yytext; dec commentLevel;
+                    if !commentLevel=0
+                         then BOGUS_VALUE(!lineno,!lineno)
+                         else continue()
+                   );
+<COMMENT>"(*"   => (Add yytext; inc commentLevel; continue());
+<COMMENT>[^*()\n\013]+ => (Add yytext; continue());
 
 <EMPTYCOMMENT>[(*)]  => (continue());
 <EMPTYCOMMENT>"*)"   => (dec commentLevel;
-		          if !commentLevel=0 then YYBEGIN A else ();
-			  continue ());
+                          if !commentLevel=0 then YYBEGIN A else ();
+                          continue ());
 <EMPTYCOMMENT>"(*"   => (inc commentLevel; continue());
-<EMPTYCOMMENT>[^*()\n]+ => (continue());
+<EMPTYCOMMENT>[^*()\n\013]+ => (continue());
 
-<STRING>"\""	=> (Add yytext; YYBEGIN CODE; continue());
-<STRING>\\	=> (Add yytext; continue());
-<STRING>\n	=> (Add yytext; error inputSource (!lineno) "unclosed string";
- 	            inc lineno; YYBEGIN CODE; continue());
-<STRING>[^"\\\n]+ => (Add yytext; continue());
-<STRING>\\\"	=> (Add yytext; continue());
-<STRING>\\[\ \t\n]   => (Add yytext;
-			if substring(yytext,1,1)="\n" then inc lineno else ();
-		     	YYBEGIN F; continue());
+<STRING>"\""    => (Add yytext; YYBEGIN CODE; continue());
+<STRING>\\      => (Add yytext; continue());
+<STRING>{eol}   => (Add yytext; error inputSource (!lineno) "unclosed string";
+                    inc lineno; YYBEGIN CODE; continue());
+<STRING>[^"\\\n\013]+ => (Add yytext; continue());
+<STRING>\\\"    => (Add yytext; continue());
+<STRING>\\{eol} => (Add yytext; inc lineno; YYBEGIN F; continue());
+<STRING>\\[\ \t] => (Add yytext; YYBEGIN F; continue());
 
-<F>{ws}		=> (Add yytext; continue());
-<F>\\		=> (Add yytext; YYBEGIN STRING; continue());
-<F>.		=> (Add yytext; error inputSource (!lineno) "unclosed string";
-		    YYBEGIN CODE; continue());
+<F>{ws}         => (Add yytext; continue());
+<F>\\           => (Add yytext; YYBEGIN STRING; continue());
+<F>.            => (Add yytext; error inputSource (!lineno) "unclosed string";
+                    YYBEGIN CODE; continue());
 

Modified: mlton/branches/on-20050420-cmm-branch/mlyacc/src/yacc.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/mlyacc/src/yacc.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/mlyacc/src/yacc.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,6 @@
+(* Modified by mfluet@acm.org on 2005-8-01.
+ * Update with SML/NJ 110.55+.
+ *)
 (* Modified by sweeks@acm.org on 2000-8-24.
  * Ported to MLton.
  *)
@@ -2,39 +5,15 @@
 type int = Int.int
-   
-(* ML-Yacc Parser Generator (c) 1989, 1990 Andrew W. Appel, David R. Tarditi 
- *
- * $Log: yacc.sml,v $
- * Revision 1.1.1.1  1998/04/08 18:40:17  george
- * Version 110.5
- *
- * Revision 1.2  1997/07/25 16:01:29  jhr
- *   Fixed bug with long constructor names (#1237).
- *
-# Revision 1.1.1.1  1997/01/14  01:38:06  george
-#   Version 109.24
-#
- * Revision 1.3  1996/05/30  18:05:09  dbm
- * Made changes to generate code that conforms to the value restriction by
- * lifting lets to locals in the code generated to define errtermvalue and action.
- *
- * Revision 1.2  1996/02/26  15:02:40  george
- *    print no longer overloaded.
- *    use of makestring has been removed and replaced with Int.toString ..
- *    use of IO replaced with TextIO
- *
- * Revision 1.1.1.1  1996/01/31  16:01:48  george
- * Version 109
- * 
- *)
 
+(* ML-Yacc Parser Generator (c) 1989, 1990 Andrew W. Appel, David R. Tarditi *)
+
 functor ParseGenFun(structure ParseGenParser : PARSE_GEN_PARSER
-		    structure MakeTable : MAKE_LR_TABLE
-		    structure Verbose : VERBOSE
-		    structure PrintStruct : PRINT_STRUCT
+                    structure MakeTable : MAKE_LR_TABLE
+                    structure Verbose : VERBOSE
+                    structure PrintStruct : PRINT_STRUCT
 
-		    sharing MakeTable.LrTable = PrintStruct.LrTable
-		    sharing MakeTable.Errs = Verbose.Errs
+                    sharing MakeTable.LrTable = PrintStruct.LrTable
+                    sharing MakeTable.Errs = Verbose.Errs
 
                     structure Absyn : ABSYN
-		    ) : PARSE_GEN =
+                    ) : PARSE_GEN =
   struct
@@ -49,26 +28,26 @@
 
     (* approx. maximum length of a line *)
 
-    val lineLength: int = 70
+    val lineLength : int = 70
 
     (* record type describing names of structures in the program being
- 	generated *)
+        generated *)
 
     datatype names = NAMES 
-			of {miscStruct : string,  (* Misc{n} struct name *)
-			    tableStruct : string, (* LR table structure *)
-			    tokenStruct : string, (* Tokens{n} struct name *)
-			    actionsStruct : string, (* Actions structure *)
-			    valueStruct: string, (* semantic value structure *)
-			    ecStruct : string,  (* error correction structure *)
-			    arg: string, (* user argument for parser *)
-			    tokenSig : string,  (* TOKENS{n} signature *)
-			    miscSig :string, (* Signature for Misc structure *)
-			    dataStruct:string, (* name of structure in Misc *)
-						(* which holds parser data *)
-			    dataSig:string (* signature for this structure *)
-					
-		 	    }
+                        of {miscStruct : string,  (* Misc{n} struct name *)
+                            tableStruct : string, (* LR table structure *)
+                            tokenStruct : string, (* Tokens{n} struct name *)
+                            actionsStruct : string, (* Actions structure *)
+                            valueStruct: string, (* semantic value structure *)
+                            ecStruct : string,  (* error correction structure *)
+                            arg: string, (* user argument for parser *)
+                            tokenSig : string,  (* TOKENS{n} signature *)
+                            miscSig :string, (* Signature for Misc structure *)
+                            dataStruct:string, (* name of structure in Misc *)
+                                                (* which holds parser data *)
+                            dataSig:string (* signature for this structure *)
+                                        
+                            }
 
     val DEBUG = true
     exception Semantic
@@ -76,288 +55,291 @@
     (* common functions and values used in printing out program *)
 
     datatype values = VALS
-		      of {say : string -> unit,
-			  saydot : string -> unit,
-			  sayln : string -> unit,
-			  pureActions: bool,
-			  pos_type : string,
-			  arg_type : string,
-			  ntvoid : string,
-			  termvoid : string,
-			  start : Grammar.nonterm,
-			  hasType : Grammar.symbol -> bool,
+                      of {say : string -> unit,
+                          saydot : string -> unit,
+                          sayln : string -> unit,
+                          pureActions: bool,
+                          pos_type : string,
+                          arg_type : string,
+                          ntvoid : string,
+                          termvoid : string,
+                          start : Grammar.nonterm,
+                          hasType : Grammar.symbol -> bool,
 
-			  (* actual (user) name of terminal *)
+                          (* actual (user) name of terminal *)
 
-			  termToString : Grammar.term -> string,
-			  symbolToString : Grammar.symbol -> string,
+                          termToString : Grammar.term -> string,
+                          symbolToString : Grammar.symbol -> string,
 
-			  (* type symbol comes from the HDR structure,
-			     and is now abstract *)
+                          (* type symbol comes from the HDR structure,
+                             and is now abstract *)
 
-			  term : (Header.symbol * ty option) list,
-			  nonterm : (Header.symbol * ty option) list,
-			  terms : Grammar.term list,
+                          term : (Header.symbol * ty option) list,
+                          nonterm : (Header.symbol * ty option) list,
+                          terms : Grammar.term list,
 
-			  (* tokenInfo is the user inserted spec in
-			     the *_TOKEN sig*)
-			  tokenInfo : string option}
-			  
+                          (* tokenInfo is the user inserted spec in
+                             the *_TOKEN sig*)
+                          tokenInfo : string option}
+                          
     structure SymbolHash = Hash(type elem = string
-	    		        val gt = (op >) : string*string -> bool)
+                                val gt = (op >) : string*string -> bool)
 
     structure TermTable = Table(type key = Grammar.term
-				val gt = fn (T i,T j) => i > j)
+                                val gt = fn (T i,T j) => i > j)
 
     structure SymbolTable = Table(
-	type key = Grammar.symbol
-	val gt = fn (TERM(T i),TERM(T j)) => i>j
-		  | (NONTERM(NT i),NONTERM(NT j)) => i>j
-		  | (NONTERM _,TERM _) => true
-		  | (TERM _,NONTERM _) => false)
+        type key = Grammar.symbol
+        val gt = fn (TERM(T i),TERM(T j)) => i>j
+                  | (NONTERM(NT i),NONTERM(NT j)) => i>j
+                  | (NONTERM _,TERM _) => true
+                  | (TERM _,NONTERM _) => false)
 
     (* printTypes: function to print the following types in the LrValues
        structure and a structure containing the datatype svalue:
 
-		type svalue -- it holds semantic values on the parse
-				   stack
-		type pos -- the type of line numbers
-		type result -- the type of the value that results
-				   from the parse
+                type svalue -- it holds semantic values on the parse
+                                   stack
+                type pos -- the type of line numbers
+                type result -- the type of the value that results
+                                   from the parse
 
-	The type svalue is set equal to the datatype svalue declared
-	in the structure named by valueStruct.  The datatype svalue
-	is declared inside the structure named by valueStruct to deal
-	with the scope of constructors.
+        The type svalue is set equal to the datatype svalue declared
+        in the structure named by valueStruct.  The datatype svalue
+        is declared inside the structure named by valueStruct to deal
+        with the scope of constructors.
     *)
 
     val printTypes = fn (VALS {say,sayln,term,nonterm,symbolToString,pos_type,
-				 arg_type,
-				 termvoid,ntvoid,saydot,hasType,start,
-				 pureActions,...},
-			   NAMES {valueStruct,...},symbolType) =>
+                                 arg_type,
+                                 termvoid,ntvoid,saydot,hasType,start,
+                                 pureActions,...},
+                           NAMES {valueStruct,...},symbolType) =>
      let val prConstr = fn (symbol,SOME s) => 
-			   say (" | " ^ (symbolName symbol) ^ " of " ^
-			          (if pureActions then "" else "unit -> ") ^
-				" (" ^ tyName s ^ ")"
-				)
-			 | _ => ()
+                           say (" | " ^ (symbolName symbol) ^ " of " ^
+                                  (if pureActions then "" else "unit -> ") ^
+                                " (" ^ tyName s ^ ")"
+                                )
+                         | _ => ()
      in sayln "local open Header in";
-	sayln ("type pos = " ^ pos_type);
-	sayln ("type arg = " ^ arg_type);
-	sayln ("structure " ^ valueStruct ^ " = ");
-	sayln "struct";
-	say ("datatype svalue = " ^ termvoid ^ " | " ^ ntvoid ^ " of" ^
-	     (if pureActions then "" else " unit -> ") ^ " unit");
-	app prConstr term;
-	app prConstr nonterm;
-	sayln "\nend";
-	sayln ("type svalue = " ^ valueStruct ^ ".svalue");
-	say "type result = ";
-	case symbolType (NONTERM start)
-	of NONE => sayln "unit"
-	 | SOME t => (say (tyName t); sayln "");
-	sayln "end"
+        sayln ("type pos = " ^ pos_type);
+        sayln ("type arg = " ^ arg_type);
+        sayln ("structure " ^ valueStruct ^ " = ");
+        sayln "struct";
+        say ("datatype svalue = " ^ termvoid ^ " | " ^ ntvoid ^ " of" ^
+             (if pureActions then "" else " unit -> ") ^ " unit");
+        app prConstr term;
+        app prConstr nonterm;
+        sayln "\nend";
+        sayln ("type svalue = " ^ valueStruct ^ ".svalue");
+        say "type result = ";
+        case symbolType (NONTERM start)
+        of NONE => sayln "unit"
+         | SOME t => (say (tyName t); sayln "");
+        sayln "end"
     end
 
      (* function to print Tokens{n} structure *)
 
     val printTokenStruct =
      fn (VALS {say, sayln, termToString, hasType,termvoid,terms,
-	       pureActions,tokenInfo,...},
-	 NAMES {miscStruct,tableStruct,valueStruct,
-		tokenStruct,tokenSig,dataStruct,...}) =>
-		(sayln ("structure " ^ tokenStruct ^ " : " ^ tokenSig ^ " =");
-		 sayln "struct";
-		 (case tokenInfo of
-		      NONE => ()
-		    | _ => sayln ("open "^dataStruct^".Header"));
-	         sayln ("type svalue = " ^ dataStruct ^ ".svalue");
-		 sayln "type ('a,'b) token = ('a,'b) Token.token";
-		 let val f = fn term as T i =>
-			(say "fun "; say (termToString term);
-			 say " (";
-		         if (hasType (TERM term)) then say "i," else ();
-			 say "p1,p2) = Token.TOKEN (";
-			 say (dataStruct ^ "." ^ tableStruct ^ ".T ");
-			 say (Int.toString i);
-			 say ",(";
-			 say (dataStruct ^ "." ^ valueStruct ^ ".");
-			 if (hasType (TERM term)) then 
-			    (say (termToString term);
-			     if pureActions then say " i"
-			     else say " (fn () => i)")
-			 else say termvoid;
-			 say ",";
-			 sayln "p1,p2))")
-		in app f terms
-		end;
-		sayln "end")
-			  
+               pureActions,tokenInfo,...},
+         NAMES {miscStruct,tableStruct,valueStruct,
+                tokenStruct,tokenSig,dataStruct,...}) =>
+                (sayln ("structure " ^ tokenStruct ^ " : " ^ tokenSig ^ " =");
+                 sayln "struct";
+                 (case tokenInfo of
+                      NONE => ()
+                    | _ => sayln ("open "^dataStruct^".Header"));
+                 sayln ("type svalue = " ^ dataStruct ^ ".svalue");
+                 sayln "type ('a,'b) token = ('a,'b) Token.token";
+                 let val f = fn term as T i =>
+                        (say "fun "; say (termToString term);
+                         say " (";
+                         if (hasType (TERM term)) then say "i," else ();
+                         say "p1,p2) = Token.TOKEN (";
+                         say (dataStruct ^ "." ^ tableStruct ^ ".T ");
+                         say (Int.toString i);
+                         say ",(";
+                         say (dataStruct ^ "." ^ valueStruct ^ ".");
+                         if (hasType (TERM term)) then 
+                            (say (termToString term);
+                             if pureActions then say " i"
+                             else say " (fn () => i)")
+                         else say termvoid;
+                         say ",";
+                         sayln "p1,p2))")
+                in app f terms
+                end;
+                sayln "end")
+                          
     (* function to print signatures out - takes print function which
-	does not need to insert line breaks *)
+        does not need to insert line breaks *)
 
     val printSigs = fn (VALS {term,tokenInfo,...},
-			NAMES {tokenSig,tokenStruct,miscSig,
-				dataStruct, dataSig, ...},
-			say) =>
+                        NAMES {tokenSig,tokenStruct,miscSig,
+                                dataStruct, dataSig, ...},
+                        say) =>
           say  ("signature " ^ tokenSig ^ " =\nsig\n"^
-		(case tokenInfo of NONE => "" | SOME s => (s^"\n"))^
-		 "type ('a,'b) token\ntype svalue\n" ^
-		 (List.foldr (fn ((s,ty),r) => String.concat [
-		    "val ", symbolName s,
-		    (case ty
-		     of NONE => ": " 
-		      | SOME l => ": (" ^ (tyName l) ^ ") * "),
-		    " 'a * 'a -> (svalue,'a) token\n", r]) "" term) ^
-		 "end\nsignature " ^ miscSig ^
-		  "=\nsig\nstructure Tokens : " ^ tokenSig ^
-		  "\nstructure " ^ dataStruct ^ ":" ^ dataSig ^
-		  "\nsharing type " ^ dataStruct ^
-		  ".Token.token = Tokens.token\nsharing type " ^
-		  dataStruct ^ ".svalue = Tokens.svalue\nend\n")
-		
+                (case tokenInfo of NONE => "" | SOME s => (s^"\n"))^
+                 "type ('a,'b) token\ntype svalue\n" ^
+                 (List.foldr (fn ((s,ty),r) => String.concat [
+                    "val ", symbolName s,
+                    (case ty
+                     of NONE => ": " 
+                      | SOME l => ": (" ^ (tyName l) ^ ") * "),
+                    " 'a * 'a -> (svalue,'a) token\n", r]) "" term) ^
+                 "end\nsignature " ^ miscSig ^
+                  "=\nsig\nstructure Tokens : " ^ tokenSig ^
+                  "\nstructure " ^ dataStruct ^ ":" ^ dataSig ^
+                  "\nsharing type " ^ dataStruct ^
+                  ".Token.token = Tokens.token\nsharing type " ^
+                  dataStruct ^ ".svalue = Tokens.svalue\nend\n")
+                
     (* function to print structure for error correction *)
 
     val printEC = fn (keyword : term list,
-		      preferred_change : (term list * term list) list,
-		      noshift : term list,
-		      value : (term * string) list,
-		      VALS {termToString, say,sayln,terms,saydot,hasType,
-			    termvoid,pureActions,...},
-		      NAMES {ecStruct,tableStruct,valueStruct,...}) =>
+                      preferred_change : (term list * term list) list,
+                      noshift : term list,
+                      value : (term * string) list,
+                      VALS {termToString, say,sayln,terms,saydot,hasType,
+                            termvoid,pureActions,...},
+                      NAMES {ecStruct,tableStruct,valueStruct,...}) =>
        let
 
-	 val sayterm = fn (T i) => (say "(T "; say (Int.toString i); say ")")
+         val sayterm = fn (T i) => (say "(T "; say (Int.toString i); say ")")
 
-	 val printBoolCase = fn ( l : term list) =>
-	    (say "fn ";
-	     app (fn t => (sayterm t; say " => true"; say " | ")) l;
-	     sayln "_ => false")
+         val printBoolCase = fn ( l : term list) =>
+            (say "fn ";
+             app (fn t => (sayterm t; say " => true"; say " | ")) l;
+             sayln "_ => false")
 
-	 val printTermList = fn (l : term list) =>
-	    (app (fn t => (sayterm t; say " :: ")) l; sayln "nil")
+         val printTermList = fn (l : term list) =>
+           (sayln "nil"; app (fn t => (say " $$ "; sayterm t)) (rev l))
 
-	 fun printChange () =
-	    (sayln "val preferred_change = ";
-	     app (fn (d,i) =>
-		    (say"("; printTermList d; say ","; printTermList i; 
-		     sayln ")::"
-		    )
-		 ) preferred_change;
-	     sayln "nil")
 
-	 val printErrValues = fn (l : (term * string) list) =>
-	    (sayln "local open Header in";
-	     sayln "val errtermvalue=";
-	     say "fn ";
-	     app (fn (t,s) =>
-		    (sayterm t; say " => ";
-		     saydot valueStruct; say (termToString t);
-		     say "(";
-		     if pureActions then () else say "fn () => ";
-		     say "("; say s; say "))";
-		     sayln " | "
-		    )
-		 ) l;
-	    say "_ => ";
-	    say (valueStruct ^ ".");
-	    sayln termvoid; sayln "end")
-	      
+         fun printChange () =
+            (sayln "val preferred_change : (term list * term list) list = ";
+             app (fn (d,i) =>
+                    (say"("; printTermList d; say ","; printTermList i; 
+                     sayln ")::"
+                    )
+                 ) preferred_change;
+             sayln "nil")
 
-	  val printNames = fn () =>
-		let val f = fn term => (
-			sayterm term; say " => ";
-			sayln (String.concat["\"", termToString term, "\""]);
-			say "  | ")
-		in (sayln "val showTerminal =";
-		    say "fn ";
-		    app f terms;
-		    sayln "_ => \"bogus-term\"")
-		end
+         val printErrValues = fn (l : (term * string) list) =>
+            (sayln "local open Header in";
+             sayln "val errtermvalue=";
+             say "fn ";
+             app (fn (t,s) =>
+                    (sayterm t; say " => ";
+                     saydot valueStruct; say (termToString t);
+                     say "(";
+                     if pureActions then () else say "fn () => ";
+                     say "("; say s; say "))";
+                     sayln " | "
+                    )
+                 ) l;
+            say "_ => ";
+            say (valueStruct ^ ".");
+            sayln termvoid; sayln "end")
+              
 
-	   val ecTerms = 
-		List.foldr (fn (t,r) =>
-		  if hasType (TERM t) orelse exists (fn (a,_)=>a=t) value
-		    then r
-		    else t::r)
-		[] terms
-				  
-	in  say "structure ";
-	    say ecStruct;
-	    sayln "=";
-	    sayln "struct";
-	    say "open ";
-	    sayln tableStruct;
-	    sayln "val is_keyword =";
-	    printBoolCase keyword;
-	    printChange();
-	    sayln "val noShift = ";
-	    printBoolCase noshift;
-	    printNames ();
-	    printErrValues value;
-	    say "val terms = ";
-	    printTermList ecTerms;
-	    sayln "end"
-	end
+          val printNames = fn () =>
+                let val f = fn term => (
+                        sayterm term; say " => ";
+                        sayln (String.concat["\"", termToString term, "\""]);
+                        say "  | ")
+                in (sayln "val showTerminal =";
+                    say "fn ";
+                    app f terms;
+                    sayln "_ => \"bogus-term\"")
+                end
 
+           val ecTerms = 
+                List.foldr (fn (t,r) =>
+                  if hasType (TERM t) orelse exists (fn (a,_)=>a=t) value
+                    then r
+                    else t::r)
+                [] terms
+                                  
+        in  say "structure ";
+            say ecStruct;
+            sayln "=";
+            sayln "struct";
+            say "open ";
+            sayln tableStruct;
+            sayln "infix 5 $$";
+            sayln "fun x $$ y = y::x";
+            sayln "val is_keyword =";
+            printBoolCase keyword;
+            printChange();
+            sayln "val noShift = ";
+            printBoolCase noshift;
+            printNames ();
+            printErrValues value;
+            say "val terms : term list = ";
+            printTermList ecTerms;
+            sayln "end"
+        end
+
 val printAction = fn (rules,
-			  VALS {hasType,say,sayln,termvoid,ntvoid,
-			        symbolToString,saydot,start,pureActions,...},
-			  NAMES {actionsStruct,valueStruct,tableStruct,arg,...}) =>
+                          VALS {hasType,say,sayln,termvoid,ntvoid,
+                                symbolToString,saydot,start,pureActions,...},
+                          NAMES {actionsStruct,valueStruct,tableStruct,arg,...}) =>
 let val printAbsynRule = Absyn.printRule(say,sayln)
     val is_nonterm = fn (NONTERM i) => true | _ => false
     val numberRhs = fn r =>
-	List.foldl (fn (e,(r,table)) =>
-		let val num = case SymbolTable.find(e,table)
-			       of SOME i => i
-				| NONE => 1
-		 in ((e,num,hasType e orelse is_nonterm e)::r,
-		     SymbolTable.insert((e,num+1),table))
-		 end) (nil,SymbolTable.empty) r
+        List.foldl (fn (e,(r,table)) =>
+                let val num = case SymbolTable.find(e,table)
+                               of SOME i => i
+                                | NONE => 1
+                 in ((e,num,hasType e orelse is_nonterm e)::r,
+                     SymbolTable.insert((e,num+1),table))
+                 end) (nil,SymbolTable.empty) r
 
     val saySym = symbolToString
 
     val printCase = fn (i:int, r as {lhs=lhs as (NT lhsNum),prec,
-				        rhs,code,rulenum}) =>
+                                        rhs,code,rulenum}) =>
 
        (* mkToken: Build an argument *)
 
        let open Absyn
-	   val mkToken = fn (sym,num : int,typed) =>
-	     let val symString = symbolToString sym
-	       val symNum = symString ^ (Int.toString num)
-	     in PTUPLE[WILD,
-		     PTUPLE[if not (hasType sym) then
-			      (if is_nonterm sym then
-				   PAPP(valueStruct^"."^ntvoid,
-					PVAR symNum)
-			      else WILD)
-			   else	
-			       PAPP(valueStruct^"."^symString,
-			         if num=1 andalso pureActions
-				     then AS(PVAR symNum,PVAR symString)
-				 else PVAR symNum),
-			     if num=1 then AS(PVAR (symString^"left"),
-					      PVAR(symNum^"left"))
-			     else PVAR(symNum^"left"),
-			     if num=1 then AS(PVAR(symString^"right"),
-					      PVAR(symNum^"right"))
-			     else PVAR(symNum^"right")]]
-	     end
+           val mkToken = fn (sym,num : int,typed) =>
+             let val symString = symbolToString sym
+               val symNum = symString ^ (Int.toString num)
+             in PTUPLE[WILD,
+                     PTUPLE[if not (hasType sym) then
+                              (if is_nonterm sym then
+                                   PAPP(valueStruct^"."^ntvoid,
+                                        PVAR symNum)
+                              else WILD)
+                           else 
+                               PAPP(valueStruct^"."^symString,
+                                 if num=1 andalso pureActions
+                                     then AS(symNum,PVAR symString)
+                                 else PVAR symNum),
+                             if num=1 then AS(symString^"left",
+                                              PVAR(symNum^"left"))
+                             else PVAR(symNum^"left"),
+                             if num=1 then AS(symString^"right",
+                                              PVAR(symNum^"right"))
+                             else PVAR(symNum^"right")]]
+             end
 
             val numberedRhs = #1 (numberRhs rhs)
 
-	(* construct case pattern *)
+        (* construct case pattern *)
 
-	   val pat = PTUPLE[PINT i,PLIST(map mkToken numberedRhs @
-					   [PVAR "rest671"])]
+           val pat = PTUPLE[PINT i,PLIST(map mkToken numberedRhs,
+                                         SOME (PVAR "rest671"))]
 
-	(* remove terminals in argument list w/o types *)
+        (* remove terminals in argument list w/o types *)
 
-	   val argsWithTypes =
-		  List.foldr (fn ((_,_,false),r) => r
-			 | (s as (_,_,true),r) => s::r) nil numberedRhs
+           val argsWithTypes =
+                  List.foldr (fn ((_,_,false),r) => r
+                         | (s as (_,_,true),r) => s::r) nil numberedRhs
 
         (* construct case body *)
 
@@ -367,307 +349,307 @@
            val code = CODE code
            val rest = EVAR "rest671"
 
-	   val body =
-	     LET([VB(resultpat,
-		     EAPP(EVAR(valueStruct^"."^
-			     (if hasType (NONTERM lhs)
-				  then saySym(NONTERM lhs)
+           val body =
+             LET([VB(resultpat,
+                     EAPP(EVAR(valueStruct^"."^
+                             (if hasType (NONTERM lhs)
+                                  then saySym(NONTERM lhs)
                                   else ntvoid)),
                           if pureActions then code
-		          else if argsWithTypes=nil then FN(WILD,code)
+                          else if argsWithTypes=nil then FN(WILD,code)
                           else
-			   FN(WILD,
-			     let val body =
-				LET(map (fn (sym,num:int,_) =>
-				  let val symString = symbolToString sym
-				      val symNum = symString ^ Int.toString num
-				  in VB(if num=1 then
-					     AS(PVAR symString,PVAR symNum)
-					else PVAR symNum,
-					EAPP(EVAR symNum,UNIT))
-				  end) (rev argsWithTypes),
-		                      code)
-			     in if hasType (NONTERM lhs) then
-				    body else SEQ(body,UNIT)
-			     end)))],
+                           FN(WILD,
+                             let val body =
+                                LET(map (fn (sym,num:int,_) =>
+                                  let val symString = symbolToString sym
+                                      val symNum = symString ^ Int.toString num
+                                  in VB(if num=1 then
+                                             AS(symString,PVAR symNum)
+                                        else PVAR symNum,
+                                        EAPP(EVAR symNum,UNIT))
+                                  end) (rev argsWithTypes),
+                                      code)
+                             in if hasType (NONTERM lhs) then
+                                    body else SEQ(body,UNIT)
+                             end)))],
                    ETUPLE[EAPP(EVAR(tableStruct^".NT"),EINT(lhsNum)),
-			  case rhs
-			  of nil => ETUPLE[resultexp,defaultPos,defaultPos]
-			   | r =>let val (rsym,rnum,_) = hd(numberedRhs)
-				     val (lsym,lnum,_) = hd(rev numberedRhs)
-				 in ETUPLE[resultexp,
-					   EVAR (symbolToString lsym ^
-						 Int.toString lnum ^ "left"),
-					   EVAR (symbolToString rsym ^
-						  Int.toString rnum ^ "right")]
-				 end,
+                          case rhs
+                          of nil => ETUPLE[resultexp,defaultPos,defaultPos]
+                           | r =>let val (rsym,rnum,_) = hd(numberedRhs)
+                                     val (lsym,lnum,_) = hd(rev numberedRhs)
+                                 in ETUPLE[resultexp,
+                                           EVAR (symbolToString lsym ^
+                                                 Int.toString lnum ^ "left"),
+                                           EVAR (symbolToString rsym ^
+                                                  Int.toString rnum ^ "right")]
+                                 end,
                            rest])
     in printAbsynRule (RULE(pat,body))
     end
 
-	  val prRules = fn () =>
-	     (sayln "fn (i392:int,defaultPos,stack,";
-	      say   "    ("; say arg; sayln "):arg) =>";
-	      sayln "case (i392,stack)";
-	      say "of ";
-	      app (fn (rule as {rulenum,...}) =>
-		   (printCase(rulenum,rule); say "| ")) rules;
-	     sayln "_ => raise (mlyAction i392)")
+          val prRules = fn () =>
+             (sayln "fn (i392:int,defaultPos,stack,";
+              say   "    ("; say arg; sayln "):arg) =>";
+              sayln "case (i392,stack)";
+              say "of ";
+              app (fn (rule as {rulenum,...}) =>
+                   (printCase(rulenum,rule); say "| ")) rules;
+             sayln "_ => raise (mlyAction i392)")
 
-   	in say "structure ";
-	   say actionsStruct;
-	   sayln " =";
-	   sayln "struct ";
-	   sayln "type int = Int.int";
-	   sayln "exception mlyAction of int";
-	   sayln "local open Header in";
-	   sayln "val actions = ";
-	   prRules();
-	   sayln "end";
-	   say "val void = ";
-	   saydot valueStruct;
-	   sayln termvoid;
-	   say "val extract = ";
-	   say "fn a => (fn ";
-	   saydot valueStruct;
-	   if hasType (NONTERM start)
-	      then say (symbolToString (NONTERM start))
-	      else say "ntVOID";
-	   sayln " x => x";
-	   sayln "| _ => let exception ParseInternal";
-	   say "\tin raise ParseInternal end) a ";
-	   sayln (if pureActions then "" else "()");
-	   sayln "end"
-	end
+        in say "structure ";
+           say actionsStruct;
+           sayln " =";
+           sayln "struct ";
+           sayln "type int = Int.int";
+           sayln "exception mlyAction of int";
+           sayln "local open Header in";
+           sayln "val actions = ";
+           prRules();
+           sayln "end";
+           say "val void = ";
+           saydot valueStruct;
+           sayln termvoid;
+           say "val extract = ";
+           say "fn a => (fn ";
+           saydot valueStruct;
+           if hasType (NONTERM start)
+              then say (symbolToString (NONTERM start))
+              else say "ntVOID";
+           sayln " x => x";
+           sayln "| _ => let exception ParseInternal";
+           say "\tin raise ParseInternal end) a ";
+           sayln (if pureActions then "" else "()");
+           sayln "end"
+        end
 
     val make_parser = fn ((header,
-	 DECL {eop,change,keyword,nonterm,prec,
-	       term, control,value} : declData,
-	       rules : rule list),spec,error : pos -> string -> unit,
-	       wasError : unit -> bool) =>
+         DECL {eop,change,keyword,nonterm,prec,
+               term, control,value} : declData,
+               rules : rule list),spec,error : pos -> string -> unit,
+               wasError : unit -> bool) =>
      let
-	val verbose = List.exists (fn VERBOSE=>true | _ => false) control
-	val defaultReductions = not (List.exists (fn NODEFAULT=>true | _ => false) control)
-	val pos_type =
-	   let fun f nil = NONE
-		 | f ((POS s)::r) = SOME s 
-		 | f (_::r) = f r
-	   in f control
-	   end
-	val start =
-	   let fun f nil = NONE
-		 | f ((START_SYM s)::r) = SOME s 
-		 | f (_::r) = f r
-	   in f control
-	   end
-	val name =
-	   let fun f nil = NONE
-		 | f ((PARSER_NAME s)::r) = SOME s 
-		 | f (_::r) = f r
-	   in f control
-	   end
-	val header_decl =
-	   let fun f nil = NONE
-		 | f ((FUNCTOR s)::r) = SOME s 
-		 | f (_::r) = f r
-	   in f control
-	   end
+        val verbose = List.exists (fn VERBOSE=>true | _ => false) control
+        val defaultReductions = not (List.exists (fn NODEFAULT=>true | _ => false) control)
+        val pos_type =
+           let fun f nil = NONE
+                 | f ((POS s)::r) = SOME s 
+                 | f (_::r) = f r
+           in f control
+           end
+        val start =
+           let fun f nil = NONE
+                 | f ((START_SYM s)::r) = SOME s 
+                 | f (_::r) = f r
+           in f control
+           end
+        val name =
+           let fun f nil = NONE
+                 | f ((PARSER_NAME s)::r) = SOME s 
+                 | f (_::r) = f r
+           in f control
+           end
+        val header_decl =
+           let fun f nil = NONE
+                 | f ((FUNCTOR s)::r) = SOME s 
+                 | f (_::r) = f r
+           in f control
+           end
 
-	val token_sig_info_decl =
-	    let fun f nil = NONE
-		  | f ((TOKEN_SIG_INFO s)::_) = SOME s
-		  | f (_::r) = f r
-	    in f control
-	    end
+        val token_sig_info_decl =
+            let fun f nil = NONE
+                  | f ((TOKEN_SIG_INFO s)::_) = SOME s
+                  | f (_::r) = f r
+            in f control
+            end
 
-	val arg_decl =
-	   let fun f nil = ("()","unit")
-		 | f ((PARSE_ARG s)::r) = s 
-		 | f (_::r) = f r
-	   in f control
-	   end
+        val arg_decl =
+           let fun f nil = ("()","unit")
+                 | f ((PARSE_ARG s)::r) = s 
+                 | f (_::r) = f r
+           in f control
+           end
 
-	val noshift =
-	   let fun f nil = nil
-		 | f ((NSHIFT s)::r) = s 
-		 | f (_::r) = f r
-	   in f control
-	   end
+        val noshift =
+           let fun f nil = nil
+                 | f ((NSHIFT s)::r) = s 
+                 | f (_::r) = f r
+           in f control
+           end
 
-	val pureActions =
-	   let fun f nil = false
-		 | f ((PURE)::r) = true 
-		 | f (_::r) = f r
-	   in f control
-	   end
+        val pureActions =
+           let fun f nil = false
+                 | f ((PURE)::r) = true 
+                 | f (_::r) = f r
+           in f control
+           end
 
-	val term =
-	 case term
-	   of NONE => (error 1 "missing %term definition"; nil)
-	    | SOME l => l
+        val term =
+         case term
+           of NONE => (error 1 "missing %term definition"; nil)
+            | SOME l => l
 
-	val nonterm =
-	 case nonterm
-	  of NONE => (error 1 "missing %nonterm definition"; nil)
-	   | SOME l => l
+        val nonterm =
+         case nonterm
+          of NONE => (error 1 "missing %nonterm definition"; nil)
+           | SOME l => l
 
-	val pos_type =
-	 case pos_type
-	  of NONE => (error 1 "missing %pos definition"; "")
-	   | SOME l => l
+        val pos_type =
+         case pos_type
+          of NONE => (error 1 "missing %pos definition"; "")
+           | SOME l => l
 
 
-	val termHash = 
-	  List.foldr (fn ((symbol,_),table) =>
-	      let val name = symbolName symbol
-	      in if SymbolHash.exists(name,table) then
-		   (error (symbolPos symbol)
-		          ("duplicate definition of " ^ name ^ " in %term");
-		    table)
-		else SymbolHash.add(name,table)
+        val termHash = 
+          List.foldr (fn ((symbol,_),table) =>
+              let val name = symbolName symbol
+              in if SymbolHash.exists(name,table) then
+                   (error (symbolPos symbol)
+                          ("duplicate definition of " ^ name ^ " in %term");
+                    table)
+                else SymbolHash.add(name,table)
               end) SymbolHash.empty term
 
-	val isTerm = fn name => SymbolHash.exists(name,termHash)
+        val isTerm = fn name => SymbolHash.exists(name,termHash)
 
-	val symbolHash = 
-	  List.foldr (fn ((symbol,_),table) =>
-	    let val name = symbolName symbol
-	    in if SymbolHash.exists(name,table) then
-		 (error (symbolPos symbol)
-	             (if isTerm name then
-		          name ^ " is defined as a terminal and a nonterminal"
-		      else 
-			  "duplicate definition of " ^ name ^ " in %nonterm");
-		     table)
+        val symbolHash = 
+          List.foldr (fn ((symbol,_),table) =>
+            let val name = symbolName symbol
+            in if SymbolHash.exists(name,table) then
+                 (error (symbolPos symbol)
+                     (if isTerm name then
+                          name ^ " is defined as a terminal and a nonterminal"
+                      else 
+                          "duplicate definition of " ^ name ^ " in %nonterm");
+                     table)
              else SymbolHash.add(name,table)
             end) termHash nonterm
 
-	fun makeUniqueId s =
-		if SymbolHash.exists(s,symbolHash) then makeUniqueId (s ^ "'")
-		else s
+        fun makeUniqueId s =
+                if SymbolHash.exists(s,symbolHash) then makeUniqueId (s ^ "'")
+                else s
 
-	val _ = if wasError() then raise Semantic else ()
+        val _ = if wasError() then raise Semantic else ()
 
-	val numTerms = SymbolHash.size termHash
-	val numNonterms = SymbolHash.size symbolHash - numTerms
+        val numTerms = SymbolHash.size termHash
+        val numNonterms = SymbolHash.size symbolHash - numTerms
 
-	val symError = fn sym => fn err => fn symbol =>
-	  error (symbolPos symbol)
-	        (symbolName symbol^" in "^err^" is not defined as a " ^ sym)
+        val symError = fn sym => fn err => fn symbol =>
+          error (symbolPos symbol)
+                (symbolName symbol^" in "^err^" is not defined as a " ^ sym)
 
-	val termNum : string -> Header.symbol -> term =
-	  let val termError = symError "terminal" 
-	  in fn stmt =>
-	     let val stmtError = termError stmt
-	     in fn symbol =>
-	        case SymbolHash.find(symbolName symbol,symbolHash)
-	        of NONE => (stmtError symbol; T ~1)
-	         | SOME i => T (if i<numTerms then i
-			        else (stmtError symbol; ~1))
-	     end
-	  end
-			
-	val nontermNum : string -> Header.symbol -> nonterm =
-	  let val nontermError = symError "nonterminal" 
-	  in fn stmt =>
-	     let val stmtError = nontermError stmt
-	     in fn symbol =>
-	        case SymbolHash.find(symbolName symbol,symbolHash)
-	        of NONE => (stmtError symbol; NT ~1)
-	         | SOME i => if i>=numTerms then NT (i-numTerms)
-			     else (stmtError symbol;NT ~1)
-	     end
-	  end
+        val termNum : string -> Header.symbol -> term =
+          let val termError = symError "terminal" 
+          in fn stmt =>
+             let val stmtError = termError stmt
+             in fn symbol =>
+                case SymbolHash.find(symbolName symbol,symbolHash)
+                of NONE => (stmtError symbol; T ~1)
+                 | SOME i => T (if i<numTerms then i
+                                else (stmtError symbol; ~1))
+             end
+          end
+                        
+        val nontermNum : string -> Header.symbol -> nonterm =
+          let val nontermError = symError "nonterminal" 
+          in fn stmt =>
+             let val stmtError = nontermError stmt
+             in fn symbol =>
+                case SymbolHash.find(symbolName symbol,symbolHash)
+                of NONE => (stmtError symbol; NT ~1)
+                 | SOME i => if i>=numTerms then NT (i-numTerms)
+                             else (stmtError symbol;NT ~1)
+             end
+          end
 
-	val symbolNum : string -> Header.symbol -> Grammar.symbol =
-	  let val symbolError = symError "symbol" 
-	  in fn stmt =>
-	     let val stmtError = symbolError stmt
-	     in fn symbol =>
-	        case SymbolHash.find(symbolName symbol,symbolHash)
-	        of NONE => (stmtError symbol; NONTERM (NT ~1))
-	         | SOME i => if i>=numTerms then NONTERM(NT (i-numTerms))
-			     else TERM(T i)
-	     end
-	  end
+        val symbolNum : string -> Header.symbol -> Grammar.symbol =
+          let val symbolError = symError "symbol" 
+          in fn stmt =>
+             let val stmtError = symbolError stmt
+             in fn symbol =>
+                case SymbolHash.find(symbolName symbol,symbolHash)
+                of NONE => (stmtError symbol; NONTERM (NT ~1))
+                 | SOME i => if i>=numTerms then NONTERM(NT (i-numTerms))
+                             else TERM(T i)
+             end
+          end
 
 (* map all symbols in the following values to terminals and check that
    the symbols are defined as terminals:
 
-	eop : symbol list
-	keyword: symbol list
-	prec: (lexvalue * (symbol list)) list
-	change: (symbol list * symbol list) list
+        eop : symbol list
+        keyword: symbol list
+        prec: (lexvalue * (symbol list)) list
+        change: (symbol list * symbol list) list
 *)
 
-	val eop = map (termNum "%eop") eop
-	val keyword = map (termNum "%keyword") keyword
-	val prec = map (fn (a,l) => 
-			(a,case a
-			   of LEFT => map (termNum "%left") l
-			    | RIGHT => map (termNum "%right") l
-			    | NONASSOC => map (termNum "%nonassoc") l
-			)) prec
-	val change =
-	 let val mapTerm = termNum "%prefer, %subst, or %change"
-	 in map (fn (a,b) => (map mapTerm a, map mapTerm b)) change
-	 end
-	val noshift = map (termNum "%noshift") noshift
-	val value =
-	  let val mapTerm = termNum "%value"
-	  in map (fn (a,b) => (mapTerm a,b)) value
-	  end
-	val (rules,_) =
-	   let val symbolNum = symbolNum "rule"
-	       val nontermNum = nontermNum "rule"
-	       val termNum = termNum "%prec tag"
+        val eop = map (termNum "%eop") eop
+        val keyword = map (termNum "%keyword") keyword
+        val prec = map (fn (a,l) => 
+                        (a,case a
+                           of LEFT => map (termNum "%left") l
+                            | RIGHT => map (termNum "%right") l
+                            | NONASSOC => map (termNum "%nonassoc") l
+                        )) prec
+        val change =
+         let val mapTerm = termNum "%prefer, %subst, or %change"
+         in map (fn (a,b) => (map mapTerm a, map mapTerm b)) change
+         end
+        val noshift = map (termNum "%noshift") noshift
+        val value =
+          let val mapTerm = termNum "%value"
+          in map (fn (a,b) => (mapTerm a,b)) value
+          end
+        val (rules,_) =
+           let val symbolNum = symbolNum "rule"
+               val nontermNum = nontermNum "rule"
+               val termNum = termNum "%prec tag"
            in List.foldr
-	   (fn (RULE {lhs,rhs,code,prec},(l,n)) =>
-	     ( {lhs=nontermNum lhs,rhs=map symbolNum rhs,
-	        code=code,prec=case prec
-				of NONE => NONE
-				 | SOME t => SOME (termNum t),
-		 rulenum=n}::l,n-1))
-		 (nil,length rules-1) rules
-	end
+           (fn (RULE {lhs,rhs,code,prec},(l,n)) =>
+             ( {lhs=nontermNum lhs,rhs=map symbolNum rhs,
+                code=code,prec=case prec
+                                of NONE => NONE
+                                 | SOME t => SOME (termNum t),
+                 rulenum=n}::l,n-1))
+                 (nil,length rules-1) rules
+        end
 
-	val _ = if wasError() then raise Semantic else ()
+        val _ = if wasError() then raise Semantic else ()
 
-	(* termToString: map terminals back to strings *)
+        (* termToString: map terminals back to strings *)
 
-	val termToString =
-	   let val data = array(numTerms,"")
-	       val unmap = fn (symbol,_) =>
-		   let val name = symbolName symbol
+        val termToString =
+           let val data = array(numTerms,"")
+               val unmap = fn (symbol,_) =>
+                   let val name = symbolName symbol
                    in update(data,
-			     case SymbolHash.find (name,symbolHash) of
-				NONE => raise Fail "termToString"
-			      | SOME i => i,
-		             name)
+                             case SymbolHash.find(name,symbolHash) of
+                                 SOME i => i
+                               | NONE => raise Fail "termToString",
+                             name)
                    end
-	       val _ = app unmap term
-	   in fn T i =>
-		if DEBUG andalso (i<0 orelse i>=numTerms)
-		  then "bogus-num" ^ (Int.toString i)
-		  else data sub i
-	   end
+               val _ = app unmap term
+           in fn T i =>
+                if DEBUG andalso (i<0 orelse i>=numTerms)
+                  then "bogus-num" ^ (Int.toString i)
+                  else data sub i
+           end
 
-	val nontermToString = 
-	   let val data = array(numNonterms,"")
-	       val unmap = fn (symbol,_) =>
-		    let val name = symbolName symbol
-		    in update(data,
-			      case SymbolHash.find (name,symbolHash) of
-				 NONE => raise Fail "nontermToString"
-			       | SOME i => i-numTerms,
+        val nontermToString = 
+           let val data = array(numNonterms,"")
+               val unmap = fn (symbol,_) =>
+                    let val name = symbolName symbol
+                    in update(data,
+                              case SymbolHash.find(name,symbolHash) of
+                                  SOME i => i-numTerms
+                                | NONE => raise Fail "nontermToString",
                               name)
-		    end
-	       val _ = app unmap nonterm
-	   in fn NT i =>
-		if DEBUG andalso (i<0 orelse i>=numNonterms)
-		  then "bogus-num" ^ (Int.toString i)
-		  else data sub i
-	   end
+                    end
+               val _ = app unmap nonterm
+           in fn NT i =>
+                if DEBUG andalso (i<0 orelse i>=numNonterms)
+                  then "bogus-num" ^ (Int.toString i)
+                  else data sub i
+           end
 
 (* create functions mapping terminals to precedence numbers and rules to
   precedence numbers.
@@ -681,9 +663,9 @@
   Internally, a tighter binding has a higher precedence number.  We give
   precedences using multiples of 3:
 
-		p+2 = right associative (force shift of symbol)
-		p+1 = precedence for rule
-		p = left associative (force reduction of rule)
+                p+2 = right associative (force shift of symbol)
+                p+1 = precedence for rule
+                p = left associative (force reduction of rule)
 
   Nonassociative terminals are given also given a precedence of p+1.  The
 table generator detects when the associativity of a nonassociative terminal
@@ -692,222 +674,221 @@
 
   A rule is given the precedence of its rightmost terminal *)
 
-	val termPrec =
-	    let val precData = array(numTerms, NONE : int option)
-	        val addPrec = fn termPrec => fn term as (T i) =>
-		   case precData sub i
-		   of SOME _ =>
-		     error 1 ("multiple precedences specified for terminal " ^
-			    (termToString term))
-		    | NONE => update(precData,i,termPrec)
-		val termPrec = fn ((LEFT,_) ,i) => i
-			      | ((RIGHT,_),i) => i+2
-			      | ((NONASSOC,l),i) => i+1
-		val _ = List.foldl (fn (args as ((_,l),i)) =>
-			        (app (addPrec (SOME (termPrec args))) l; i+3))
-			  0 prec
-	   in fn (T i) =>
-		if  DEBUG andalso (i < 0 orelse i >= numTerms) then
-			NONE
-		else precData sub i
-	   end
+        val termPrec =
+            let val precData = array(numTerms, NONE : int option)
+                val addPrec = fn termPrec => fn term as (T i) =>
+                   case precData sub i
+                   of SOME _ =>
+                     error 1 ("multiple precedences specified for terminal " ^
+                            (termToString term))
+                    | NONE => update(precData,i,termPrec)
+                val termPrec = fn ((LEFT,_) ,i) => i
+                              | ((RIGHT,_),i) => i+2
+                              | ((NONASSOC,l),i) => i+1
+                val _ = List.foldl (fn (args as ((_,l),i)) =>
+                                (app (addPrec (SOME (termPrec args))) l; i+3))
+                          0 prec
+           in fn (T i) =>
+                if  DEBUG andalso (i < 0 orelse i >= numTerms) then
+                        NONE
+                else precData sub i
+           end
 
         val elimAssoc =  fn i => (i - (i mod 3) + 1)
-	val rulePrec = 
-	   let fun findRightTerm (nil,r) = r
-	         | findRightTerm (TERM t :: tail,r) =
-				 findRightTerm(tail,SOME t)
-		 | findRightTerm (_ :: tail,r) = findRightTerm(tail,r)
-	   in fn rhs =>
-		 case findRightTerm(rhs,NONE)
-		 of NONE => NONE
-		  | SOME term => 
-		       case termPrec term
-		       of SOME i => SOME  (elimAssoc i)
-		        | a => a
-	   end
+        val rulePrec = 
+           let fun findRightTerm (nil,r) = r
+                 | findRightTerm (TERM t :: tail,r) =
+                                 findRightTerm(tail,SOME t)
+                 | findRightTerm (_ :: tail,r) = findRightTerm(tail,r)
+           in fn rhs =>
+                 case findRightTerm(rhs,NONE)
+                 of NONE => NONE
+                  | SOME term => 
+                       case termPrec term
+                       of SOME i => SOME  (elimAssoc i)
+                        | a => a
+           end
 
-	val grammarRules =
-	  let val conv = fn {lhs,rhs,code,prec,rulenum} =>
-		{lhs=lhs,rhs =rhs,precedence=
-			case prec
-			  of SOME t => (case termPrec t
-			                of SOME i => SOME(elimAssoc i)
+        val grammarRules =
+          let val conv = fn {lhs,rhs,code,prec,rulenum} =>
+                {lhs=lhs,rhs =rhs,precedence=
+                        case prec
+                          of SOME t => (case termPrec t
+                                        of SOME i => SOME(elimAssoc i)
                                          | a => a)
-			   | _ => rulePrec rhs,
-	         rulenum=rulenum}
-	  in map conv rules
-	  end
+                           | _ => rulePrec rhs,
+                 rulenum=rulenum}
+          in map conv rules
+          end
 
     (* get start symbol *)
 
-	val start =
-	 case start
-	   of NONE => #lhs (hd grammarRules)
-	    | SOME name => 
-		nontermNum "%start" name
+        val start =
+         case start
+           of NONE => #lhs (hd grammarRules)
+            | SOME name => 
+                nontermNum "%start" name
 
-	val symbolType = 
-	   let val data = array(numTerms+numNonterms,NONE : ty option)
-	       val unmap =
-		  fn (symbol,ty) =>
-		  update (data,
-			  case SymbolHash.find(symbolName symbol,symbolHash) of
-			     NONE => raise Fail "unmap"
-			   | SOME i => i,
+        val symbolType = 
+           let val data = array(numTerms+numNonterms,NONE : ty option)
+               fun unmap (symbol,ty) =
+                   update(data,
+                          case SymbolHash.find(symbolName symbol,symbolHash) of
+                              SOME i => i
+                            | NONE => raise Fail "symbolType",
                           ty)
-	       val _ = (app unmap term; app unmap nonterm)
-	   in fn NONTERM(NT i) =>
-		if DEBUG andalso (i<0 orelse i>=numNonterms)
-		  then NONE
-		  else data sub (i+numTerms)
-	       | TERM (T i) =>
-		if DEBUG andalso (i<0 orelse i>=numTerms)
-		  then NONE
-		  else data sub i
-	   end
+               val _ = (app unmap term; app unmap nonterm)
+           in fn NONTERM(NT i) =>
+                if DEBUG andalso (i<0 orelse i>=numNonterms)
+                  then NONE
+                  else data sub (i+numTerms)
+               | TERM (T i) =>
+                if DEBUG andalso (i<0 orelse i>=numTerms)
+                  then NONE
+                  else data sub i
+           end
 
-	val symbolToString = 
-	     fn NONTERM i => nontermToString i
-	      | TERM i => termToString i
+        val symbolToString = 
+             fn NONTERM i => nontermToString i
+              | TERM i => termToString i
 
-	val grammar  = GRAMMAR {rules=grammarRules,
-				 terms=numTerms,nonterms=numNonterms,
-				 eop = eop, start=start,noshift=noshift,
-				 termToString = termToString,
-				 nontermToString = nontermToString,
-				 precedence = termPrec}
+        val grammar  = GRAMMAR {rules=grammarRules,
+                                 terms=numTerms,nonterms=numNonterms,
+                                 eop = eop, start=start,noshift=noshift,
+                                 termToString = termToString,
+                                 nontermToString = nontermToString,
+                                 precedence = termPrec}
 
-	(* Debugging output added by sweeks@acm.org. *)
-	val _ =
-	   if false
-	      then
-		 (List.foldl
-		  (fn ({lhs, rhs, rulenum, ...}, i) =>
-		   (print (String.concat [Int.toString rulenum, ": ",
-					  nontermToString lhs, " ->"])
-		    ; List.app (fn s => (print (String.concat
-						[" ", symbolToString s]))) rhs
-		    ; print "\n"
-		    ; i + 1))
-		  0 grammarRules
-		  ; ())
-	   else ()
+        (* Debugging output added by sweeks@acm.org. *)
+        val _ =
+           if false
+              then
+                 (List.foldl
+                  (fn ({lhs, rhs, rulenum, ...}, i) =>
+                   (print (String.concat [Int.toString rulenum, ": ",
+                                          nontermToString lhs, " ->"])
+                    ; List.app (fn s => (print (String.concat
+                                                [" ", symbolToString s]))) rhs
+                    ; print "\n"
+                    ; i + 1))
+                  0 grammarRules
+                  ; ())
+           else ()
 
-	val name' = case name 
-	            of NONE => ""
-		     | SOME s => symbolName s
+        val name' = case name 
+                    of NONE => ""
+                     | SOME s => symbolName s
 
-	val names = NAMES {miscStruct=name' ^ "LrValsFun",
-			   valueStruct="MlyValue",
-			   tableStruct="LrTable",
-			   tokenStruct="Tokens",
-			   actionsStruct="Actions",
-			   ecStruct="EC",
-			   arg= #1 arg_decl,
-			   tokenSig = name' ^ "_TOKENS",
-			   miscSig = name' ^ "_LRVALS",
-			   dataStruct = "ParserData",
-			   dataSig = "PARSER_DATA"}
-		       
-	val (table,stateErrs,corePrint,errs) =
-		 MakeTable.mkTable(grammar,defaultReductions)
+        val names = NAMES {miscStruct=name' ^ "LrValsFun",
+                           valueStruct="MlyValue",
+                           tableStruct="LrTable",
+                           tokenStruct="Tokens",
+                           actionsStruct="Actions",
+                           ecStruct="EC",
+                           arg= #1 arg_decl,
+                           tokenSig = name' ^ "_TOKENS",
+                           miscSig = name' ^ "_LRVALS",
+                           dataStruct = "ParserData",
+                           dataSig = "PARSER_DATA"}
+                       
+        val (table,stateErrs,corePrint,errs) =
+                 MakeTable.mkTable(grammar,defaultReductions)
 
         val entries = ref 0 (* save number of action table entries here *)
-	
+        
     in  let val result = TextIO.openOut (spec ^ ".sml")
- 	    val sigs = TextIO.openOut (spec ^ ".sig")
-	    val pos = ref 0
-	    val pr = fn s => TextIO.output(result,s)
-	    val say = fn s => let val l = String.size s
-			           val newPos = (!pos) + l
-			      in if newPos > lineLength 
-				    then (pr "\n"; pos := l)
-				    else (pos := newPos);
-				   pr s
-			      end
-	    val saydot = fn s => (say (s ^ "."))
-	    val sayln = fn t => (pr t; pr "\n"; pos := 0)
-	    val termvoid = makeUniqueId "VOID"
-	    val ntvoid = makeUniqueId "ntVOID"
-	    val hasType = fn s => case symbolType s
-				  of NONE => false
-				   | _ => true
-	    val terms = let fun f n = if n=numTerms then nil
-				      else (T n) :: f(n+1)
-		        in f 0
-		        end
+            val sigs = TextIO.openOut (spec ^ ".sig")
+            val pos = ref 0
+            val pr = fn s => TextIO.output(result,s)
+            val say = fn s => let val l = String.size s
+                                   val newPos = (!pos) + l
+                              in if newPos > lineLength 
+                                    then (pr "\n"; pos := l)
+                                    else (pos := newPos);
+                                   pr s
+                              end
+            val saydot = fn s => (say (s ^ "."))
+            val sayln = fn t => (pr t; pr "\n"; pos := 0)
+            val termvoid = makeUniqueId "VOID"
+            val ntvoid = makeUniqueId "ntVOID"
+            val hasType = fn s => case symbolType s
+                                  of NONE => false
+                                   | _ => true
+            val terms = let fun f n = if n=numTerms then nil
+                                      else (T n) :: f(n+1)
+                        in f 0
+                        end
             val values = VALS {say=say,sayln=sayln,saydot=saydot,
-		 	       termvoid=termvoid, ntvoid = ntvoid,
-			       hasType=hasType, pos_type = pos_type,
-			       arg_type = #2 arg_decl,
-			       start=start,pureActions=pureActions,
-			       termToString=termToString,
-			       symbolToString=symbolToString,term=term,
-			       nonterm=nonterm,terms=terms,
-			       tokenInfo=token_sig_info_decl}
+                               termvoid=termvoid, ntvoid = ntvoid,
+                               hasType=hasType, pos_type = pos_type,
+                               arg_type = #2 arg_decl,
+                               start=start,pureActions=pureActions,
+                               termToString=termToString,
+                               symbolToString=symbolToString,term=term,
+                               nonterm=nonterm,terms=terms,
+                               tokenInfo=token_sig_info_decl}
 
-	    val (NAMES {miscStruct,tableStruct,dataStruct,tokenSig,tokenStruct,dataSig,...}) = names
+            val (NAMES {miscStruct,tableStruct,dataStruct,tokenSig,tokenStruct,dataSig,...}) = names
          in case header_decl
-	    of NONE => (say "functor "; say miscStruct; 
-			sayln "(structure Token : TOKEN)";
-			say " : sig structure ";
-			say dataStruct;
-			say " : "; sayln dataSig;
-			say "       structure ";
-			say tokenStruct; say " : "; sayln tokenSig;
-			sayln "   end")
-	     | SOME s => say s;
-	    sayln " = ";
-	    sayln "struct";
-	    sayln ("structure " ^ dataStruct ^ "=");
-	    sayln "struct";
-	    sayln "structure Header = ";
-	    sayln "struct";
-	    sayln header;
-	    sayln "end";
-	    sayln "structure LrTable = Token.LrTable";
-	    sayln "structure Token = Token";
-	    sayln "local open LrTable in ";
-	    entries := PrintStruct.makeStruct{table=table,print=pr,
-					      name = "table",
-				              verbose=verbose};
-	    sayln "end";
-	    printTypes(values,names,symbolType);
-	    printEC (keyword,change,noshift,value,values,names);
-	    printAction(rules,values,names);
-	    sayln "end";
-	    printTokenStruct(values,names);
-	    sayln "end";
-	    printSigs(values,names,fn s => TextIO.output(sigs,s));    
-	    TextIO.closeOut sigs;
-	    TextIO.closeOut result;
-	    MakeTable.Errs.printSummary (fn s => TextIO.output(TextIO.stdOut,s)) errs
-	end;
+            of NONE => (say "functor "; say miscStruct; 
+                        sayln "(structure Token : TOKEN)";
+                        say " : sig structure ";
+                        say dataStruct;
+                        say " : "; sayln dataSig;
+                        say "       structure ";
+                        say tokenStruct; say " : "; sayln tokenSig;
+                        sayln "   end")
+             | SOME s => say s;
+            sayln " = ";
+            sayln "struct";
+            sayln ("structure " ^ dataStruct ^ "=");
+            sayln "struct";
+            sayln "structure Header = ";
+            sayln "struct";
+            sayln header;
+            sayln "end";
+            sayln "structure LrTable = Token.LrTable";
+            sayln "structure Token = Token";
+            sayln "local open LrTable in ";
+            entries := PrintStruct.makeStruct{table=table,print=pr,
+                                              name = "table",
+                                              verbose=verbose};
+            sayln "end";
+            printTypes(values,names,symbolType);
+            printEC (keyword,change,noshift,value,values,names);
+            printAction(rules,values,names);
+            sayln "end";
+            printTokenStruct(values,names);
+            sayln "end";
+            printSigs(values,names,fn s => TextIO.output(sigs,s));    
+            TextIO.closeOut sigs;
+            TextIO.closeOut result;
+            MakeTable.Errs.printSummary (fn s => TextIO.output(TextIO.stdOut,s)) errs
+        end;
         if verbose then
-	 let val f = TextIO.openOut (spec ^ ".desc")
-	     val say = fn s=> TextIO.output(f,s)
-	     val printRule =
-	        let val rules = Array.fromList grammarRules
-	        in fn say => 
-		   let val prRule = fn {lhs,rhs,precedence,rulenum} =>
-		     ((say o nontermToString) lhs; say " : ";
-		      app (fn s => (say (symbolToString s); say " ")) rhs)
-	           in fn i => prRule (rules sub i)
-	           end
-	        end
-	 in Verbose.printVerbose
-	    {termToString=termToString,nontermToString=nontermToString,
-	     table=table, stateErrs=stateErrs,errs = errs,entries = !entries,
-	     print=say, printCores=corePrint,printRule=printRule};
-	    TextIO.closeOut f
-	 end
+         let val f = TextIO.openOut (spec ^ ".desc")
+             val say = fn s=> TextIO.output(f,s)
+             val printRule =
+                let val rules = Array.fromList grammarRules
+                in fn say => 
+                   let val prRule = fn {lhs,rhs,precedence,rulenum} =>
+                     ((say o nontermToString) lhs; say " : ";
+                      app (fn s => (say (symbolToString s); say " ")) rhs)
+                   in fn i => prRule (rules sub i)
+                   end
+                end
+         in Verbose.printVerbose
+            {termToString=termToString,nontermToString=nontermToString,
+             table=table, stateErrs=stateErrs,errs = errs,entries = !entries,
+             print=say, printCores=corePrint,printRule=printRule};
+            TextIO.closeOut f
+         end
         else ()
     end
 
     val parseGen = fn spec =>
-		let val (result,inputSource) = ParseGenParser.parse spec
-		in make_parser(getResult result,spec,Header.error inputSource,
-				errorOccurred inputSource)
-		end
+                let val (result,inputSource) = ParseGenParser.parse spec
+                in make_parser(getResult result,spec,Header.error inputSource,
+                                errorOccurred inputSource)
+                end
 end;

Copied: mlton/branches/on-20050420-cmm-branch/package (from rev 4358, mlton/trunk/package)


Property changes on: mlton/branches/on-20050420-cmm-branch/regression
___________________________________________________________________
Name: svn:ignore
   - *.dat
*.dot
*.mlb
*.ssa
*.ui
*.uo
PM
RepeatParserCombinator.txt
hardlinkA
hardlinkA
hardlinkB
hardlinkB
log
outFuhMishra*
testBinIO.txt
testTextIO.txt
testbadl
testcycl
testlink
test.txt
textio.tmp
   + *.dat
*.dot
*.mlb
*.ssa
*.ui
*.uo
PM
RepeatParserCombinator.txt
hardlinkA
hardlinkA
hardlinkB
hardlinkB
log
outFuhMishra*
testBinIO.txt
testTextIO.txt
testbadl
testcycl
testlink
test.txt
textio.tmp


Deleted: mlton/branches/on-20050420-cmm-branch/regression/.cvsignore
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/.cvsignore	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/.cvsignore	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,21 +0,0 @@
-*.dat
-*.dot
-*.mlb
-*.ssa
-*.ui
-*.uo
-PM
-RepeatParserCombinator.txt
-hardlinkA
-hardlinkA
-hardlinkB
-hardlinkB
-log
-outFuhMishra*
-testBinIO.txt
-testTextIO.txt
-testbadl
-testcycl
-testlink
-test.txt
-textio.tmp

Copied: mlton/branches/on-20050420-cmm-branch/regression/.ignore (from rev 4358, mlton/trunk/regression/.ignore)

Modified: mlton/branches/on-20050420-cmm-branch/regression/7.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/7.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/7.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,8 +1,8 @@
 fun h f = f 13
    
 fun f x = let fun z x = z(x + 1)
-	  in h z
-	  end
+          in h z
+          end
    
 val r : (int -> int) ref = ref f
 

Modified: mlton/branches/on-20050420-cmm-branch/regression/FuhMishra.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/FuhMishra.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/FuhMishra.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -97,12 +97,12 @@
                         
     fun add_S (S,(found_fixpt, oldsets)) : bool * 'a set list =
       let
-	val (found_fixpt1, _, L1, S1) = 
+        val (found_fixpt1, _, L1, S1) = 
           foldl add (found_fixpt, false, oldsets, emptyset) S
        in 
-	 case S1 of 
-	   [] => (found_fixpt andalso found_fixpt1, L1)
-	 | _  => (found_fixpt andalso found_fixpt1, S1::L1)
+         case S1 of 
+           [] => (found_fixpt andalso found_fixpt1, L1)
+         | _  => (found_fixpt andalso found_fixpt1, S1::L1)
       end
 
    in

Modified: mlton/branches/on-20050420-cmm-branch/regression/Makefile
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/Makefile	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/Makefile	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,11 @@
+## Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ #    Jagannathan, and Stephen Weeks.
+ # Copyright (C) 1997-2000 NEC Research Institute.
+ #
+ # MLton is released under a BSD-style license.
+ # See the file MLton-LICENSE for details.
+ ##
+
 all: 
 
 .PHONY: clean

Modified: mlton/branches/on-20050420-cmm-branch/regression/README
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/README	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/README	2006-02-16 19:34:54 UTC (rev 4361)
@@ -2,8 +2,8 @@
 MLton built by SML/NJ.  This happens because of bugs in SML/NJ.
 
    pack-real.sml
-	fails because SML/NJ has the wrong sign for 
-	Real.fromString "~0.0".
+        fails because SML/NJ has the wrong sign for 
+        Real.fromString "~0.0".
 
 ----------------------------------------------------------------------
 
@@ -15,21 +15,21 @@
 look at the "log" file to see what went wrong.  There should be only
 two warnings in the log file.
 
-	filesys.sml
-		warning due to the use of tmpnam
-	real.sml 
-		fails due to MLton's incorrect handling of real to string
-		conversions.   
+        filesys.sml
+                warning due to the use of tmpnam
+        real.sml 
+                fails due to MLton's incorrect handling of real to string
+                conversions.   
 
 The following subdirectories contain tests that have not yet been integrated
 into the regression script.
 
 fail/
-	contains tests that should fail to compile.
+        contains tests that should fail to compile.
 
 modules/
-	contains tests of the module system.
+        contains tests of the module system.
 
 nonterminate/
- 	contains tests that should compile, but when run, should not terminate.
+        contains tests that should compile, but when run, should not terminate.
 

Modified: mlton/branches/on-20050420-cmm-branch/regression/README.kit
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/README.kit	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/README.kit	2006-02-16 19:34:54 UTC (rev 4361)
@@ -9,9 +9,9 @@
 The directory must contain this file `README' and three symbolic
 links:
 
-	testlink -> README
-	testcycl -> testcycl
-	testbadl -> exists.not
+        testlink -> README
+        testcycl -> testcycl
+        testbadl -> exists.not
 
 Moreover, it must contain a file `hardlinkA' and a hard link
 `hardlinkB' to `hardlinkA' (or vice versa). The directory must not

Modified: mlton/branches/on-20050420-cmm-branch/regression/array.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/array.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/array.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -8,7 +8,7 @@
 fun range (from, to) p = 
     let open Int 
     in
-	(from > to) orelse (p from) andalso (range (from+1, to) p)
+        (from > to) orelse (p from) andalso (range (from+1, to) p)
     end;
 
 fun checkrange bounds = check o range bounds;
@@ -31,7 +31,7 @@
     fun extract (arr, s, l) = ArraySlice.vector (ArraySlice.slice (arr, s, l))
     val copy = fn {src, si, len, dst, di} =>
       ArraySlice.copy {src = ArraySlice.slice (src, si, len),
-		       dst = dst, di = di}
+                       dst = dst, di = di}
     fun foldli f b (arr, s, l) = 
       ArraySlice.foldli (fn (i,x,y) => f (i+s,x,y)) b (ArraySlice.slice (arr, s, l))
     fun foldri f b (arr, s, l) = 
@@ -52,12 +52,12 @@
 
 val test2 = 
     tst' "test2" (fn () => 
-	   array(0, 11) <> array0
-	   andalso array(0,()) <> tabulate(0, fn _ => ())
-	   andalso tabulate(0, fn _ => ()) <> fromList [] 
-	   andalso fromList [] <> fromList [] 
-	   andalso array(0, ()) <> array(0, ())
-	   andalso tabulate(0, fn _ => ()) <> tabulate(0, fn _ => ()));
+           array(0, 11) <> array0
+           andalso array(0,()) <> tabulate(0, fn _ => ())
+           andalso tabulate(0, fn _ => ()) <> fromList [] 
+           andalso fromList [] <> fromList [] 
+           andalso array(0, ()) <> array(0, ())
+           andalso tabulate(0, fn _ => ()) <> tabulate(0, fn _ => ()));
 
 val d = tabulate(100, fn i => i mod 7 * 10 + 1);
 
@@ -86,9 +86,9 @@
 
 val e = array(203, 0);
 val _ = (copy{src=d, si=0, dst=e, di=0,        len=NONE}; 
-	 copy{src=b, si=0, dst=e, di=length d, len=NONE};
-	 copy{src=d, si=0, dst=e, di=length d + length b, len=NONE});
-	 
+         copy{src=b, si=0, dst=e, di=length d, len=NONE};
+         copy{src=d, si=0, dst=e, di=length d + length b, len=NONE});
+         
 fun a2v a = extract(a, 0, NONE);
 val ev = Vector.concat [a2v d, a2v b, a2v d]; (* length e = 203 *)
 
@@ -105,7 +105,7 @@
 
 val test9a = 
     tst' "test9a" (fn () => ev = extract(e, 0, SOME (length e))
-	   andalso ev = extract(e, 0, NONE));
+           andalso ev = extract(e, 0, NONE));
 val test9b = 
     tst' "test9b" (fn () => Vector.fromList [] = extract(e, 100, SOME 0));
 val test9c = (extract(e, ~1, SOME (length e))  seq "WRONG") 
@@ -122,7 +122,7 @@
              handle Subscript => "OK" | _ => "WRONG"
 val test9i = 
     tst' "test9i" (fn () => a2v (fromList []) = extract(e, length e, SOME 0)
-	    andalso a2v (fromList []) = extract(e, length e, NONE));
+            andalso a2v (fromList []) = extract(e, length e, NONE));
 val test9j =
     tst' "test9j" (fn () => extract(e, 3, SOME(length e - 3)) = extract(e, 3, NONE));
 
@@ -131,9 +131,9 @@
 val _ = copy{src=e, si=0, dst=g, di=0, len=NONE};
 
 val test10a = tst' "test10a" (fn () => ev = extract(e, 0, SOME (length e)) 
- 		      andalso ev = extract(e, 0, NONE));
+                      andalso ev = extract(e, 0, NONE));
 val test10b = tst' "test10b" (fn () => ev = extract(g, 0, SOME (length g))
-		      andalso ev = extract(g, 0, NONE));
+                      andalso ev = extract(g, 0, NONE));
 
 val _ = copy{src=g, si=203, dst=g, di=0, len=SOME 0};
 val test10c = tst' "test10c" (fn () => ev = extract(g, 0, SOME (length g)));
@@ -153,10 +153,10 @@
     tst' "test10g" (fn () => g sub 202 = 10 * (202-1-103) mod 7 + 1);
 val test10h = 
     tst' "test10h" (fn () => (copy{src=array0, si=0, dst=array0, di=0, len=SOME 0}; 
-		     array0 <> array(0, 999999)));
+                     array0 <> array(0, 999999)));
 val test10i = 
     tst' "test10i" (fn () => (copy{src=array0, si=0, dst=array0, di=0, len=NONE}; 
-		     array0 <> array(0, 999999)));
+                     array0 <> array(0, 999999)));
 
 val test11a = tst0 "test11a" ((copy{src=g, si= ~1, dst=g, di=0, len=NONE}; "WRONG") 
               handle Subscript => "OK" | _ => "WRONG")
@@ -194,69 +194,69 @@
     val inp = fromList inplist
     val pni = fromList (rev inplist)
     fun copyinp a = 
-	copy{src=inp, si=0, dst=a, di=0, len=NONE}
+        copy{src=inp, si=0, dst=a, di=0, len=NONE}
 in 
 
 val array0 = fromList [] : int array;
 
 val test12a =
     tst' "test12a" (fn _ =>
-	           foldl cons [1,2] array0 = [1,2]
-	   andalso foldl cons [1,2] inp = [13,9,7,1,2]
-	   andalso (foldl (fn (x, _) => setv x) () inp; !v = 13));
+                   foldl cons [1,2] array0 = [1,2]
+           andalso foldl cons [1,2] inp = [13,9,7,1,2]
+           andalso (foldl (fn (x, _) => setv x) () inp; !v = 13));
 
 val test12b =
     tst' "test12b" (fn _ =>
-	           foldr cons [1,2] array0 = [1,2]
-	   andalso foldr cons [1,2] inp = [7,9,13,1,2]
-	   andalso (foldr (fn (x, _) => setv x) () inp; !v = 7));
+                   foldr cons [1,2] array0 = [1,2]
+           andalso foldr cons [1,2] inp = [7,9,13,1,2]
+           andalso (foldr (fn (x, _) => setv x) () inp; !v = 7));
 
 val test12c =
     tst' "test12c" (fn _ =>
-	           find (fn _ => true) array0 = NONE
-	   andalso find (fn _ => false) inp = NONE
-	   andalso find (fn x => x=7) inp = SOME 7
-	   andalso find (fn x => x=9) inp = SOME 9
-	   andalso (setv 0; find (fn x => (addv x; x=9)) inp; !v = 7+9));
+                   find (fn _ => true) array0 = NONE
+           andalso find (fn _ => false) inp = NONE
+           andalso find (fn x => x=7) inp = SOME 7
+           andalso find (fn x => x=9) inp = SOME 9
+           andalso (setv 0; find (fn x => (addv x; x=9)) inp; !v = 7+9));
 
 val test12d = 
     tst' "test12d" (fn _ =>
            (setv 117; app setv array0; !v = 117)
-	   andalso (setv 0; app addv inp; !v = 7+9+13)
-	   andalso (app setv inp; !v = 13));
+           andalso (setv 0; app addv inp; !v = 7+9+13)
+           andalso (app setv inp; !v = 13));
 
 val test12e = 
     let val a = array(length inp, inp sub 0)
     in 
-	tst' "test12e" (fn _ =>
+        tst' "test12e" (fn _ =>
            (modify (~ : int -> int) array0; true)
-	   andalso (copyinp a; modify ~ a; foldr (op::) [] a = map ~ inplist)
-	   andalso (setv 117; modify (fn x => (setv x; 37)) a; !v = ~13))
+           andalso (copyinp a; modify ~ a; foldr (op::) [] a = map ~ inplist)
+           andalso (setv 117; modify (fn x => (setv x; 37)) a; !v = ~13))
     end
 
 val test13a =
     tst' "test13a" (fn _ =>
-	           foldli consi [] (array0, 0, NONE) = []
-	   andalso foldri consi [] (array0, 0, NONE) = []
-	   andalso foldli consi [] (inp, 0, NONE) = [(2,13),(1,9),(0,7)]
-	   andalso foldri consi [] (inp, 0, NONE) = [(0,7),(1,9),(2,13)])
+                   foldli consi [] (array0, 0, NONE) = []
+           andalso foldri consi [] (array0, 0, NONE) = []
+           andalso foldli consi [] (inp, 0, NONE) = [(2,13),(1,9),(0,7)]
+           andalso foldri consi [] (inp, 0, NONE) = [(0,7),(1,9),(2,13)])
 
 val test13b =
     tst' "test13b" (fn _ =>
-	           foldli consi [] (array0, 0, SOME 0) = []
-	   andalso foldri consi [] (array0, 0, SOME 0) = []
-	   andalso foldli consi [] (inp, 0, SOME 0) = []
-	   andalso foldri consi [] (inp, 0, SOME 0) = []
-	   andalso foldli consi [] (inp, 3, SOME 0) = []
-	   andalso foldri consi [] (inp, 3, SOME 0) = []
-	   andalso foldli consi [] (inp, 0, SOME 3) = [(2,13),(1,9),(0,7)]
-	   andalso foldri consi [] (inp, 0, SOME 3) = [(0,7),(1,9),(2,13)]
-	   andalso foldli consi [] (inp, 0, SOME 2) = [(1,9),(0,7)]
-	   andalso foldri consi [] (inp, 0, SOME 2) = [(0,7),(1,9)]
-	   andalso foldli consi [] (inp, 1, SOME 2) = [(2,13),(1,9)]
-	   andalso foldri consi [] (inp, 1, SOME 2) = [(1,9),(2,13)]
-	   andalso foldli consi [] (inp, 2, SOME 1) = [(2,13)]
-	   andalso foldri consi [] (inp, 2, SOME 1) = [(2,13)]);
+                   foldli consi [] (array0, 0, SOME 0) = []
+           andalso foldri consi [] (array0, 0, SOME 0) = []
+           andalso foldli consi [] (inp, 0, SOME 0) = []
+           andalso foldri consi [] (inp, 0, SOME 0) = []
+           andalso foldli consi [] (inp, 3, SOME 0) = []
+           andalso foldri consi [] (inp, 3, SOME 0) = []
+           andalso foldli consi [] (inp, 0, SOME 3) = [(2,13),(1,9),(0,7)]
+           andalso foldri consi [] (inp, 0, SOME 3) = [(0,7),(1,9),(2,13)]
+           andalso foldli consi [] (inp, 0, SOME 2) = [(1,9),(0,7)]
+           andalso foldri consi [] (inp, 0, SOME 2) = [(0,7),(1,9)]
+           andalso foldli consi [] (inp, 1, SOME 2) = [(2,13),(1,9)]
+           andalso foldri consi [] (inp, 1, SOME 2) = [(1,9),(2,13)]
+           andalso foldli consi [] (inp, 2, SOME 1) = [(2,13)]
+           andalso foldri consi [] (inp, 2, SOME 1) = [(2,13)]);
 
 val test13c = tst0 "test13c" ((foldli consi [] (inp, ~1, NONE) seq "WRONG")
            handle Subscript => "OK" | _ => "WRONG");
@@ -286,17 +286,17 @@
 
 val test14a =
     tst' "test14a" (fn _ =>
-	   findi (fn _ => true) (array0, 0, NONE) = NONE
+           findi (fn _ => true) (array0, 0, NONE) = NONE
    andalso findi (fn _ => false) (inp, 0, NONE) = NONE
    andalso findi (fn (i, x) => x=9 orelse 117 div (2-i) = 0) (inp, 0, NONE)
-	   = SOME (1,9));
+           = SOME (1,9));
 
 val test14b =
     tst' "test14b" (fn _ =>
-	   findi (fn _ => true) (array0, 0, SOME 0) = NONE
+           findi (fn _ => true) (array0, 0, SOME 0) = NONE
    andalso findi (fn _ => false) (inp, 0, NONE) = NONE
    andalso findi (fn (i, x) => x=9 orelse 117 div (2-i) = 0) (inp, 0, NONE)
-	   = SOME (1,9));
+           = SOME (1,9));
 
 val test14c = (findi (fn _ => true) (inp, ~1, NONE) seq "WRONG")
            handle Subscript => "OK" | _ => "WRONG";
@@ -314,20 +314,20 @@
 val test15a = 
     tst' "test15a" (fn _ =>
            (setvi (0,117); appi setvi (array0, 0, NONE); !v = 117)
-	   andalso (setvi (0,0); appi addvi (inp, 0, NONE); !v = 0+7+1+9+2+13)
-	   andalso (appi setvi (inp, 0, NONE); !v = 2+13));
+           andalso (setvi (0,0); appi addvi (inp, 0, NONE); !v = 0+7+1+9+2+13)
+           andalso (appi setvi (inp, 0, NONE); !v = 2+13));
 val test15b = 
     tst' "test15b" (fn _ =>
            (setvi (0,117); appi setvi (array0, 0, SOME 0); !v = 117)
-	   andalso (setvi (0,0); appi addvi (inp, 0, SOME 0); !v = 0)
-	   andalso (setvi (0,0); appi addvi (inp, 3, SOME 0); !v = 0)
-	   andalso (setvi (0,0); appi addvi (inp, 0, SOME 2); !v = 0+7+1+9)
-	   andalso (setvi (0,0); appi addvi (inp, 1, SOME 2); !v = 1+9+2+13)
-	   andalso (setvi (0,0); appi addvi (inp, 0, SOME 3); !v = 0+7+1+9+2+13)
-	   andalso (appi setvi (inp, 1, SOME 2); !v = 2+13)
-	   andalso (appi setvi (inp, 0, SOME 2); !v = 1+9)
-	   andalso (appi setvi (inp, 0, SOME 1); !v = 0+7)
-	   andalso (appi setvi (inp, 0, SOME 3); !v = 2+13));
+           andalso (setvi (0,0); appi addvi (inp, 0, SOME 0); !v = 0)
+           andalso (setvi (0,0); appi addvi (inp, 3, SOME 0); !v = 0)
+           andalso (setvi (0,0); appi addvi (inp, 0, SOME 2); !v = 0+7+1+9)
+           andalso (setvi (0,0); appi addvi (inp, 1, SOME 2); !v = 1+9+2+13)
+           andalso (setvi (0,0); appi addvi (inp, 0, SOME 3); !v = 0+7+1+9+2+13)
+           andalso (appi setvi (inp, 1, SOME 2); !v = 2+13)
+           andalso (appi setvi (inp, 0, SOME 2); !v = 1+9)
+           andalso (appi setvi (inp, 0, SOME 1); !v = 0+7)
+           andalso (appi setvi (inp, 0, SOME 3); !v = 2+13));
 
 val test15c = tst0 "test15c" ((appi setvi (inp, ~1, NONE) seq "WRONG")
            handle Subscript => "OK" | _ => "WRONG");
@@ -345,33 +345,33 @@
 val test16a = 
     let val a = array(length inp, inp sub 0)
     in 
-	tst' "test16a" (fn _ =>
+        tst' "test16a" (fn _ =>
            (modifyi (op +) (array0, 0, NONE); true)
-	   andalso (modifyi (op +) (array0, 0, SOME 0); true)
-	   andalso (copyinp a; modifyi (op -) (a, 0, SOME 0); 
-		    foldr (op::) [] a = [7,9,13])
-	   andalso (copyinp a; modifyi (op -) (a, 3, SOME 0); 
-		    foldr (op::) [] a = [7,9,13])
-	   andalso (copyinp a; modifyi (op -) (a, 0, NONE); 
-		    foldr (op::) [] a = [~7,~8,~11])
-	   andalso (copyinp a; modifyi (op -) (a, 0, SOME 3); 
-		    foldr (op::) [] a = [~7,~8,~11])
-	   andalso (copyinp a; modifyi (op -) (a, 0, SOME 2); 
-		    foldr (op::) [] a = [~7,~8,13])
-	   andalso (copyinp a; modifyi (op -) (a, 1, SOME 2); 
-		    foldr (op::) [] a = [7,~8,~11])
-	   andalso (copyinp a; setv 117; 
-		    modifyi (fn x => (setvi x; 37)) (a, 0, NONE); !v = 2+13)
-	   andalso (copyinp a; setv 117; 
-		    modifyi (fn x => (setvi x; 37)) (a, 0, SOME 3); !v = 2+13)
-	   andalso (copyinp a; setv 117; 
-		    modifyi (fn x => (setvi x; 37)) (a, 1, SOME 2); !v = 2+13)
-	   andalso (copyinp a; setv 117; 
-		    modifyi (fn x => (setvi x; 37)) (a, 0, SOME 2); !v = 1+9)
-	   andalso (copyinp a; setv 117; 
-		    modifyi (fn x => (setvi x; 37)) (a, 0, SOME 0); !v = 117)
-	   andalso (copyinp a; setv 117; 
-		    modifyi (fn x => (setvi x; 37)) (a, 3, SOME 0); !v = 117))
+           andalso (modifyi (op +) (array0, 0, SOME 0); true)
+           andalso (copyinp a; modifyi (op -) (a, 0, SOME 0); 
+                    foldr (op::) [] a = [7,9,13])
+           andalso (copyinp a; modifyi (op -) (a, 3, SOME 0); 
+                    foldr (op::) [] a = [7,9,13])
+           andalso (copyinp a; modifyi (op -) (a, 0, NONE); 
+                    foldr (op::) [] a = [~7,~8,~11])
+           andalso (copyinp a; modifyi (op -) (a, 0, SOME 3); 
+                    foldr (op::) [] a = [~7,~8,~11])
+           andalso (copyinp a; modifyi (op -) (a, 0, SOME 2); 
+                    foldr (op::) [] a = [~7,~8,13])
+           andalso (copyinp a; modifyi (op -) (a, 1, SOME 2); 
+                    foldr (op::) [] a = [7,~8,~11])
+           andalso (copyinp a; setv 117; 
+                    modifyi (fn x => (setvi x; 37)) (a, 0, NONE); !v = 2+13)
+           andalso (copyinp a; setv 117; 
+                    modifyi (fn x => (setvi x; 37)) (a, 0, SOME 3); !v = 2+13)
+           andalso (copyinp a; setv 117; 
+                    modifyi (fn x => (setvi x; 37)) (a, 1, SOME 2); !v = 2+13)
+           andalso (copyinp a; setv 117; 
+                    modifyi (fn x => (setvi x; 37)) (a, 0, SOME 2); !v = 1+9)
+           andalso (copyinp a; setv 117; 
+                    modifyi (fn x => (setvi x; 37)) (a, 0, SOME 0); !v = 117)
+           andalso (copyinp a; setv 117; 
+                    modifyi (fn x => (setvi x; 37)) (a, 3, SOME 0); !v = 117))
     end
 
 val test16b = tst0 "test16b" ((modifyi (op+) (inp, ~1, NONE) seq "WRONG")

Modified: mlton/branches/on-20050420-cmm-branch/regression/array2.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/array2.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/array2.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -7,10 +7,10 @@
 fun test trv =
    let
       val a =
-	 tabulate trv
-	 (3, 4, fn (r, c) =>
-	  (x := !x + 1
-	   ; concat["(", i2s r, ", ", i2s c, ", ", i2s(!x), ")"]))
+         tabulate trv
+         (3, 4, fn (r, c) =>
+          (x := !x + 1
+           ; concat["(", i2s r, ", ", i2s c, ", ", i2s(!x), ")"]))
       val _ = app trv (fn s => (print s; print "\n")) a
    in ()
    end

Modified: mlton/branches/on-20050420-cmm-branch/regression/array5.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/array5.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/array5.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -3,27 +3,27 @@
 fun printa a =
    let val (rows, cols) = dimensions a
       fun loopRows r =
-	 if r = rows
-	    then ()
-	 else (let
-		  fun loopCols c =
-		     if c = cols
-			then ()
-		     else (print(Int.toString(sub(a, r, c))) ;
-			   print " " ;
-			   loopCols(c + 1))
-	       in loopCols 0
-	       end;
-	       print "\n";
-	       loopRows(r + 1))
+         if r = rows
+            then ()
+         else (let
+                  fun loopCols c =
+                     if c = cols
+                        then ()
+                     else (print(Int.toString(sub(a, r, c))) ;
+                           print " " ;
+                           loopCols(c + 1))
+               in loopCols 0
+               end;
+               print "\n";
+               loopRows(r + 1))
    in loopRows 0
    end
 
 val a1 = array(4, 5, 13)
 val _ = (printa a1;
-	 modifyi RowMajor (fn (x, y, _) => x + y)
-	 {base = a1, row = 0, col = 0, nrows = NONE, ncols = NONE};
-	 printa a1)
+         modifyi RowMajor (fn (x, y, _) => x + y)
+         {base = a1, row = 0, col = 0, nrows = NONE, ncols = NONE};
+         printa a1)
 
 val a2 = fromList[[1, 2], [3, 4], [5, 6]]
 val _ = printa a2
@@ -31,7 +31,7 @@
 fun bogus l = (fromList l; false) handle Size => true
 
 val _ = (bogus[[1], [2, 3]];
-	 bogus[[], [1]])
+         bogus[[], [1]])
    
 val a3 =
    let val r = ref 0

Modified: mlton/branches/on-20050420-cmm-branch/regression/array6.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/array6.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/array6.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -21,7 +21,7 @@
    fun extract (arr, s, l) = ArraySlice.vector (ArraySlice.slice (arr, s, l))
    val copy = fn {src, si, len, dst, di} =>
       ArraySlice.copy {src = ArraySlice.slice (src, si, len),
-		       dst = dst, di = di}
+                       dst = dst, di = di}
    fun appi f (arr, s, l) = 
       ArraySlice.appi (fn (i,x) => f (i+s,x)) (ArraySlice.slice (arr, s, l))
 
@@ -40,7 +40,7 @@
 
    val a4 = array (10,47)
    val _ = copy {src = a3, si = 10, len = SOME 3,
-		dst = a4, di = 1}
+                dst = a4, di = 1}
 
    val a5 = array (100, 0)
    val _ = appi (fn (i,_) => update (a5,i,i)) (a5, 0, NONE)
@@ -65,33 +65,33 @@
    fun swap (a,i,j) =
       let val t = sub (a,i)
       in update (a, i, sub (a,j)) ;
-	 update (a, j, t)
+         update (a, j, t)
       end
    
    fun bubbleSort (a, op <) =
       let val n = length a
-	 fun loop i =
-	    if i = n
-	       then ()
-	    else (let
-		     fun loop j =
-			if j = 0
-			   then ()
-			else if sub (a,j) < sub (a,j-1)
-				then (swap (a,j,j-1) ; loop (j-1))
-			     else ()
-		  in loop i
-		  end ;
-		     loop (i+1))
+         fun loop i =
+            if i = n
+               then ()
+            else (let
+                     fun loop j =
+                        if j = 0
+                           then ()
+                        else if sub (a,j) < sub (a,j-1)
+                                then (swap (a,j,j-1) ; loop (j-1))
+                             else ()
+                  in loop i
+                  end ;
+                     loop (i+1))
       in loop 0
       end
 
    fun isSorted (a, op <=) =
       let
-	 val max = length a - 1
-	 fun loop i =
-	    i = max orelse (sub (a, i) <= sub (a, i + 1)
-			    andalso loop (i + 1))
+         val max = length a - 1
+         fun loop i =
+            i = max orelse (sub (a, i) <= sub (a, i + 1)
+                            andalso loop (i + 1))
       in loop 0
       end
 

Modified: mlton/branches/on-20050420-cmm-branch/regression/array7.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/array7.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/array7.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -5,8 +5,8 @@
 val a = array (2, #"a")
 val _ = update (a, 0, #"b")
 val n = if sub (a, 0) = #"b"
-	   then 2
-	else 1
+           then 2
+        else 1
 val _ =
    if 2 = length (array (n, 13))
       then ()

Modified: mlton/branches/on-20050420-cmm-branch/regression/bytechar.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/bytechar.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/bytechar.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -8,7 +8,7 @@
 fun range (from, to) p = 
     let open Int 
     in
-	(from > to) orelse (p from) andalso (range (from+1, to) p)
+        (from > to) orelse (p from) andalso (range (from+1, to) p)
     end;
 
 fun checkrange bounds = check o range bounds;
@@ -47,14 +47,14 @@
 val test5 = tst0 "test5" ((Char.chr ~1 seq "WRONG") handle Chr => "OK" | _ => "WRONG")
 
 val test6 = tst0 "test6" ((Char.chr (Char.maxOrd+1) seq "WRONG") 
-			  handle Chr => "OK" | _ => "WRONG")
-	
+                          handle Chr => "OK" | _ => "WRONG")
+        
 val test7 = tst "test7" ("" = Byte.bytesToString (Word8Vector.fromList []));
 
 val test8 = 
     tst "test8" ("ABDC" = 
-	  (Byte.bytesToString o Word8Vector.fromList o map Word8.fromInt)
-	   [65, 66, 68, 67]);
+          (Byte.bytesToString o Word8Vector.fromList o map Word8.fromInt)
+           [65, 66, 68, 67]);
 
 val unpackString = Byte.unpackString o Word8ArraySlice.slice
    
@@ -65,22 +65,22 @@
 in
 val test10a = tst "test10a" ("" = unpackString(arr, 0, SOME 0));
 val test10b = tst "test10b" ("" = unpackString(arr, 10, SOME 0) 
-			     andalso "" = unpackString(arr, 10, NONE));
+                             andalso "" = unpackString(arr, 10, NONE));
 val test10c = tst "test10c" ("BCDE" = unpackString(arr, 1, SOME 4));
 val test10d = tst0 "test10d" ((unpackString(arr, ~1, SOME 0) seq "WRONG")
-			      handle Subscript => "OK" | _ => "WRONG")
+                              handle Subscript => "OK" | _ => "WRONG")
 val test10e = tst0 "test10e" ((unpackString(arr, 11, SOME 0) seq "WRONG")
-			      handle Subscript => "OK" | _ => "WRONG")
+                              handle Subscript => "OK" | _ => "WRONG")
 val test10f = tst0 "test10f" ((unpackString(arr, 0, SOME ~1) seq "WRONG")
-			      handle Subscript => "OK" | _ => "WRONG")
+                              handle Subscript => "OK" | _ => "WRONG")
 val test10g = tst0 "test10g" ((unpackString(arr, 0, SOME 11) seq "WRONG")
-			      handle Subscript => "OK" | _ => "WRONG")
+                              handle Subscript => "OK" | _ => "WRONG")
 val test10h = tst0 "test10h" ((unpackString(arr, 10, SOME 1) seq "WRONG")
-			      handle Subscript => "OK" | _ => "WRONG")
+                              handle Subscript => "OK" | _ => "WRONG")
 val test10i = tst0 "test10i" ((unpackString(arr, ~1, NONE) seq "WRONG")
-			      handle Subscript => "OK" | _ => "WRONG")
+                              handle Subscript => "OK" | _ => "WRONG")
 val test10j = tst0 "test10j" ((unpackString(arr, 11, NONE) seq "WRONG")
-			      handle Subscript => "OK" | _ => "WRONG")
+                              handle Subscript => "OK" | _ => "WRONG")
 end
 
 val unpackStringVec = Byte.unpackStringVec o Word8VectorSlice.slice
@@ -89,31 +89,31 @@
 in
 val test11a = tst "test11a" ("" = unpackStringVec(vec, 0, SOME 0));
 val test11b = tst "test11b" ("" = unpackStringVec(vec, 10, SOME 0) 
-			     andalso "" = unpackStringVec(vec, 10, NONE));
+                             andalso "" = unpackStringVec(vec, 10, NONE));
 val test11c = tst "test11c" ("BCDE" = unpackStringVec(vec, 1, SOME 4));
 val test11d = tst0 "test11d" ((unpackStringVec(vec, ~1, SOME 0) seq "WRONG")
-			      handle Subscript => "OK" | _ => "WRONG")
+                              handle Subscript => "OK" | _ => "WRONG")
 val test11e = tst0 "test11e" ((unpackStringVec(vec, 11, SOME 0) seq "WRONG")
-			      handle Subscript => "OK" | _ => "WRONG")
+                              handle Subscript => "OK" | _ => "WRONG")
 val test11f = tst0 "test11f" ((unpackStringVec(vec, 0, SOME ~1) seq "WRONG")
-			      handle Subscript => "OK" | _ => "WRONG")
+                              handle Subscript => "OK" | _ => "WRONG")
 val test11g = tst0 "test11g" ((unpackStringVec(vec, 0, SOME 11) seq "WRONG")
-			      handle Subscript => "OK" | _ => "WRONG")
+                              handle Subscript => "OK" | _ => "WRONG")
 val test11h = tst0 "test11h" ((unpackStringVec(vec, 10, SOME 1) seq "WRONG")
-			      handle Subscript => "OK" | _ => "WRONG")
+                              handle Subscript => "OK" | _ => "WRONG")
 val test11i = tst0 "test11i" ((unpackStringVec(vec, ~1, NONE) seq "WRONG")
-			    handle Subscript => "OK" | _ => "WRONG")
+                            handle Subscript => "OK" | _ => "WRONG")
 val test11j = tst0 "test11j" ((unpackStringVec(vec, 11, NONE) seq "WRONG")
-			      handle Subscript => "OK" | _ => "WRONG")
+                              handle Subscript => "OK" | _ => "WRONG")
 end
 
 val test18 = tst "test18" (not (Char.contains "" (Char.chr 65))
                    andalso not (Char.contains "aBCDE" (Char.chr 65))
                    andalso (Char.contains "ABCD" (Char.chr 67))
-		   andalso not (Char.contains "" #"\000")
-		   andalso not (Char.contains "" #"\255")
-		   andalso not (Char.contains "azAZ09" #"\000")
-		   andalso not (Char.contains "azAZ09" #"\255"));
+                   andalso not (Char.contains "" #"\000")
+                   andalso not (Char.contains "" #"\255")
+                   andalso not (Char.contains "azAZ09" #"\000")
+                   andalso not (Char.contains "azAZ09" #"\255"));
 
 val test19 = tst "test19" (Char.notContains "" (Char.chr 65)
                    andalso Char.notContains "aBCDE" (Char.chr 65)
@@ -128,14 +128,14 @@
 local 
 fun mycontains s c = 
     let val stop = String.size s
-	fun h i = i < stop andalso (c = String.sub(s, i) orelse h(i+1))
+        fun h i = i < stop andalso (c = String.sub(s, i) orelse h(i+1))
     in h 0 end;
 
 (* Check that p(c) = (mycontains s c) for all characters: *)
 fun equivalent p s = 
     let fun h n =
-	n > 255 orelse 
-	(p (chr n) = mycontains s (chr n)) andalso h(n+1)
+        n > 255 orelse 
+        (p (chr n) = mycontains s (chr n)) andalso h(n+1)
     in h 0 end
 
 fun checkset p s = tst' "checkset" (fn _ => equivalent p s);
@@ -160,7 +160,7 @@
 
 val allchars = 
     let fun h 0 res = chr 0 :: res
-	  | h n res = h (n-1) (chr n :: res)
+          | h n res = h (n-1) (chr n :: res)
     in h 255 [] end
 
 open Char
@@ -194,20 +194,20 @@
     tst' "test32" (fn _ => map toUpper (explode ascii) = explode upperascii)
 val test33 = 
     tst' "test33" (fn _ => 
-	   map toUpper (explode graphchars)
-	   seq map toLower (explode graphchars)
-	   seq true)
+           map toUpper (explode graphchars)
+           seq map toLower (explode graphchars)
+           seq true)
 
 val test34a =
     tst' "test34a" (fn _ => 
-	   map pred (List.drop(allchars, 1)) = List.take(allchars, 255));
+           map pred (List.drop(allchars, 1)) = List.take(allchars, 255));
 val test34b = tst0 "test34b" ((pred minChar seq "WRONG")
-			      handle Chr => "OK" | _ => "WRONG")
+                              handle Chr => "OK" | _ => "WRONG")
 val test35a =
     tst' "test35a" (fn _ => 
-	   map succ (List.take(allchars, 255)) = List.drop(allchars, 1));
+           map succ (List.take(allchars, 255)) = List.drop(allchars, 1));
 val test35b = tst0 "test35b" ((succ maxChar seq "WRONG")
-			      handle Chr => "OK" | _ => "WRONG")
+                              handle Chr => "OK" | _ => "WRONG")
 end
 
 
@@ -216,185 +216,185 @@
 val test36 = 
     let fun chk (arg, res) = Char.toString arg = res
     in tst' "test36" (fn _ => List.all chk 
-	      [(#"\000", "\\^@"),
-	       (#"\001", "\\^A"),
-	       (#"\006", "\\^F"),
-	       (#"\007", "\\a"),
-	       (#"\008", "\\b"),
-	       (#"\009", "\\t"),
-	       (#"\010", "\\n"),
-	       (#"\011", "\\v"),
-	       (#"\012", "\\f"),
-	       (#"\013", "\\r"),
-	       (#"\014", "\\^N"),
-	       (#"\031", "\\^_"),
-	       (#"\032", " "),
-	       (#"\126", "~"),
-	       (#"\\", "\\\\"),
-	       (#"\"", "\\\""),
-	       (#"A", "A"),
-	       (#"\127", "\\127"),
-	       (#"\128", "\\128"),
-	       (#"\255", "\\255")])
+              [(#"\000", "\\^@"),
+               (#"\001", "\\^A"),
+               (#"\006", "\\^F"),
+               (#"\007", "\\a"),
+               (#"\008", "\\b"),
+               (#"\009", "\\t"),
+               (#"\010", "\\n"),
+               (#"\011", "\\v"),
+               (#"\012", "\\f"),
+               (#"\013", "\\r"),
+               (#"\014", "\\^N"),
+               (#"\031", "\\^_"),
+               (#"\032", " "),
+               (#"\126", "~"),
+               (#"\\", "\\\\"),
+               (#"\"", "\\\""),
+               (#"A", "A"),
+               (#"\127", "\\127"),
+               (#"\128", "\\128"),
+               (#"\255", "\\255")])
     end;
 
 val test37 = 
     let val chars = List.tabulate(256, chr)
-	fun chk c = Char.fromString(Char.toString c) = SOME c
+        fun chk c = Char.fromString(Char.toString c) = SOME c
     in tst' "test37" (fn _ => List.all chk chars) end
 
-val test38 =   		     
+val test38 =                 
     let fun chkFromString (arg, res) = Char.fromString arg = SOME res
-	val argResList = 
-	    [("A", #"A"),
-	     ("z", #"z"),
-	     ("@", #"@"),
-	     ("~", #"~"),
-	     ("\\a", #"\007"),
-	     ("\\b", #"\008"),
-	     ("\\t", #"\009"),
-	     ("\\n", #"\010"),
-	     ("\\v", #"\011"),
-	     ("\\f", #"\012"),
-	     ("\\r", #"\013"),
-	     ("\\\\", #"\\"),
-	     ("\\\"", #"\""),
-	     ("\\^@", #"\000"),
-	     ("\\^A", #"\001"),
-	     ("\\^Z", #"\026"),
-	     ("\\^_", #"\031"), 
-	     ("\\000", #"\000"),
-	     ("\\097", #"a"),
-	     ("\\255", #"\255"),
-	     ("\\   \t\n\n \\A", #"A"),
-	     ("\\   \t\n\n \\z", #"z"),
-	     ("\\   \t\n\n \\@", #"@"),
-	     ("\\   \t\n\n \\~", #"~"),
-	     ("\\   \t\n\n \\\\n", #"\n"),
-	     ("\\   \t\n\n \\\\t", #"\t"),
-	     ("\\   \t\n\n \\\\\\", #"\\"),
-	     ("\\   \t\n\n \\\\\"", #"\""),
-	     ("\\   \t\n\n \\\\^@", #"\000"),
-	     ("\\   \t\n\n \\\\^A", #"\001"),
-	     ("\\   \t\n\n \\\\^Z", #"\026"),
-	     ("\\   \t\n\n \\\\^_", #"\031"), 
-	     ("\\   \t\n\n \\\\000", #"\000"),
-	     ("\\   \t\n\n \\\\097", #"a"),
-	     ("\\   \t\n\n \\\\255", #"\255")]
+        val argResList = 
+            [("A", #"A"),
+             ("z", #"z"),
+             ("@", #"@"),
+             ("~", #"~"),
+             ("\\a", #"\007"),
+             ("\\b", #"\008"),
+             ("\\t", #"\009"),
+             ("\\n", #"\010"),
+             ("\\v", #"\011"),
+             ("\\f", #"\012"),
+             ("\\r", #"\013"),
+             ("\\\\", #"\\"),
+             ("\\\"", #"\""),
+             ("\\^@", #"\000"),
+             ("\\^A", #"\001"),
+             ("\\^Z", #"\026"),
+             ("\\^_", #"\031"), 
+             ("\\000", #"\000"),
+             ("\\097", #"a"),
+             ("\\255", #"\255"),
+             ("\\   \t\n\n \\A", #"A"),
+             ("\\   \t\n\n \\z", #"z"),
+             ("\\   \t\n\n \\@", #"@"),
+             ("\\   \t\n\n \\~", #"~"),
+             ("\\   \t\n\n \\\\n", #"\n"),
+             ("\\   \t\n\n \\\\t", #"\t"),
+             ("\\   \t\n\n \\\\\\", #"\\"),
+             ("\\   \t\n\n \\\\\"", #"\""),
+             ("\\   \t\n\n \\\\^@", #"\000"),
+             ("\\   \t\n\n \\\\^A", #"\001"),
+             ("\\   \t\n\n \\\\^Z", #"\026"),
+             ("\\   \t\n\n \\\\^_", #"\031"), 
+             ("\\   \t\n\n \\\\000", #"\000"),
+             ("\\   \t\n\n \\\\097", #"a"),
+             ("\\   \t\n\n \\\\255", #"\255")]
     in 
-	tst' "test38" (fn _ => List.all chkFromString argResList)
+        tst' "test38" (fn _ => List.all chkFromString argResList)
     end;
 
 val test39 = 
     tst' "test39" (fn _ => List.all (fn arg => Char.fromString arg = NONE)
-	   ["\\",
-	    "\\c",
-	    "\\F",
-	    "\\e",
-	    "\\g",
-	    "\\N",
-	    "\\T",
-	    "\\1",
-	    "\\11",
-	    "\\256",
-	    "\\-65",
-	    "\\~65",
-	    "\\?",
-	    "\\^`",
-	    "\\^a",
-	    "\\^z",
-	    "\\   a",
-	    "\\   a\\B",
-	    "\\   \\"]);
+           ["\\",
+            "\\c",
+            "\\F",
+            "\\e",
+            "\\g",
+            "\\N",
+            "\\T",
+            "\\1",
+            "\\11",
+            "\\256",
+            "\\-65",
+            "\\~65",
+            "\\?",
+            "\\^`",
+            "\\^a",
+            "\\^z",
+            "\\   a",
+            "\\   a\\B",
+            "\\   \\"]);
 
 (* Test cases for C string escape functions *)
 
 val test40 = 
     let val chars = List.tabulate(256, chr)
     in tst' "test40" (fn _ => 
-	      List.map SOME chars 
-	      = List.map Char.fromCString (List.map Char.toCString chars))
+              List.map SOME chars 
+              = List.map Char.fromCString (List.map Char.toCString chars))
     end;
 
 val test41 = 
     let val argResList = 
-	    [(#"\010", "\\n"),
-	     (#"\009", "\\t"),
-	     (#"\011", "\\v"),
-	     (#"\008", "\\b"),
-	     (#"\013", "\\r"),
-	     (#"\012", "\\f"),
-	     (#"\007", "\\a"),
-	     (#"\\", "\\\\"),
-	     (#"?", "\\?"),
-	     (#"'", "\\'"),
-	     (#"\"", "\\\"")]
+            [(#"\010", "\\n"),
+             (#"\009", "\\t"),
+             (#"\011", "\\v"),
+             (#"\008", "\\b"),
+             (#"\013", "\\r"),
+             (#"\012", "\\f"),
+             (#"\007", "\\a"),
+             (#"\\", "\\\\"),
+             (#"?", "\\?"),
+             (#"'", "\\'"),
+             (#"\"", "\\\"")]
     in
-	tst' "test41" (fn _ => 
-	       List.all (fn (arg, res) => Char.toCString arg = res) argResList)
+        tst' "test41" (fn _ => 
+               List.all (fn (arg, res) => Char.toCString arg = res) argResList)
     end;
 
 val test42 = 
     let fun checkFromCStringSucc (arg, res) = 
             str (valOf (Char.fromCString arg)) = res
-	val argResList = 
-	    [("\\n", "\010"),
-	     ("\\t", "\009"),
-	     ("\\v", "\011"),
-	     ("\\b", "\008"),
-	     ("\\r", "\013"),
-	     ("\\f", "\012"),
-	     ("\\a", "\007"),
-	     ("\\\\",  "\\"),
-	     ("\\?", "?"),
-	     ("\\'", "'"),
-	     ("\\\"", "\""),
-	     ("\\1", "\001"),
-	     ("\\11", "\009"),
-	     ("\\111", "\073"),
-	     ("\\1007", "\064"),
-	     ("\\100A", "\064"),
-	     ("\\0",   "\000"),
-	     ("\\377", "\255"),
-	     ("\\18", "\001"),
-	     ("\\178", "\015"),
-	     ("\\1C", "\001"),
-	     ("\\17C", "\015"),
-	     ("\\x0", "\000"),
-	     ("\\xff", "\255"),
-	     ("\\xFF", "\255"),
-	     ("\\x1", "\001"),
-	     ("\\x11", "\017"),
-	     ("\\xag", "\010"),
-	     ("\\xAAg", "\170"),
-	     ("\\x0000000a", "\010"),
-	     ("\\x0000000a2", "\162"),
-	     ("\\x0000000ag", "\010"),
-	     ("\\x0000000A", "\010"),
-	     ("\\x0000000A2", "\162"),
-	     ("\\x0000000Ag", "\010"),
-	     ("\\x00000000000000000000000000000000000000000000000000000000000000011+",
-	      "\017")
-	     ]
+        val argResList = 
+            [("\\n", "\010"),
+             ("\\t", "\009"),
+             ("\\v", "\011"),
+             ("\\b", "\008"),
+             ("\\r", "\013"),
+             ("\\f", "\012"),
+             ("\\a", "\007"),
+             ("\\\\",  "\\"),
+             ("\\?", "?"),
+             ("\\'", "'"),
+             ("\\\"", "\""),
+             ("\\1", "\001"),
+             ("\\11", "\009"),
+             ("\\111", "\073"),
+             ("\\1007", "\064"),
+             ("\\100A", "\064"),
+             ("\\0",   "\000"),
+             ("\\377", "\255"),
+             ("\\18", "\001"),
+             ("\\178", "\015"),
+             ("\\1C", "\001"),
+             ("\\17C", "\015"),
+             ("\\x0", "\000"),
+             ("\\xff", "\255"),
+             ("\\xFF", "\255"),
+             ("\\x1", "\001"),
+             ("\\x11", "\017"),
+             ("\\xag", "\010"),
+             ("\\xAAg", "\170"),
+             ("\\x0000000a", "\010"),
+             ("\\x0000000a2", "\162"),
+             ("\\x0000000ag", "\010"),
+             ("\\x0000000A", "\010"),
+             ("\\x0000000A2", "\162"),
+             ("\\x0000000Ag", "\010"),
+             ("\\x00000000000000000000000000000000000000000000000000000000000000011+",
+              "\017")
+             ]
     in 
-	tst' "test42" (fn _ => List.all checkFromCStringSucc argResList)
+        tst' "test42" (fn _ => List.all checkFromCStringSucc argResList)
     end;
 
 val test43 = 
     let fun checkFromCStringFail arg = Char.fromCString arg = NONE
     in
-	tst' "test43" (fn _ => List.all checkFromCStringFail 
-	       ["\\",
-		"\\X",
-		"\\=",
-		"\\400",
-		"\\777",
-		"\\8",
-		"\\9",
-		"\\c",
-		"\\d",
-		"\\x",
-		"\\x100",
-		"\\xG"])
+        tst' "test43" (fn _ => List.all checkFromCStringFail 
+               ["\\",
+                "\\X",
+                "\\=",
+                "\\400",
+                "\\777",
+                "\\8",
+                "\\9",
+                "\\c",
+                "\\d",
+                "\\x",
+                "\\x100",
+                "\\xG"])
     end;
 end

Modified: mlton/branches/on-20050420-cmm-branch/regression/callcc2.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/callcc2.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/callcc2.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -44,27 +44,27 @@
 
 fun abort thunk = 
     let val v = thunk () in
-	!metaCont v
+        !metaCont v
     end
 
 fun reset thunk = 
     let val mc = !metaCont in
-	SMLofNJ.Cont.callcc 
-	(fn k => let (* new marker which restores old one *)
-		     val _ = metaCont := (fn v => 
-					  let val _ = metaCont := mc in
-					      SMLofNJ.Cont.throw k v
-					  end)
-		 in
-		     abort thunk
-		 end)
+        SMLofNJ.Cont.callcc 
+        (fn k => let (* new marker which restores old one *)
+                     val _ = metaCont := (fn v => 
+                                          let val _ = metaCont := mc in
+                                              SMLofNJ.Cont.throw k v
+                                          end)
+                 in
+                     abort thunk
+                 end)
     end
 
 fun shift f =
     SMLofNJ.Cont.callcc
     (fn k => abort (fn () => f 
-		    (fn v => reset 
-		     (fn () => SMLofNJ.Cont.throw k v))))
+                    (fn v => reset 
+                     (fn () => SMLofNJ.Cont.throw k v))))
 
 (*********************)
 
@@ -72,7 +72,7 @@
 exception UnboundVar of ident
 
 fun update r var value = (var, value) :: r
-	
+        
 fun lookup [] var = raise (UnboundVar var)
   | lookup ((var, value) :: r) var' =
     if var = var' then value else lookup r var'
@@ -81,166 +81,166 @@
    patterns are linear and pairwise disjoint *)
 fun patterneq (p, value) r =
     case p of
-	PVar x => (update r x value, true)
+        PVar x => (update r x value, true)
       | PAlias (x, p) => 
-	    let val (r', eq) = patterneq (p, value) r in
-		(update r' x value, eq)
-	    end
+            let val (r', eq) = patterneq (p, value) r in
+                (update r' x value, eq)
+            end
       | PConstruct (c, ps) =>
-	    let val Con(c', vs) = value 
-		val eq = (c = c')
-		val eq = eq andalso (List.length vs = List.length ps) 
-	    in
-		List.foldl (fn ((p, v), (r', eq')) =>
-			    let val (r'', eq'') = patterneq (p, v) r' in
-				(r'', eq'' andalso eq')
-			    end) (r, eq) (ListPair.zip (ps, vs))
-	    end
+            let val Con(c', vs) = value 
+                val eq = (c = c')
+                val eq = eq andalso (List.length vs = List.length ps) 
+            in
+                List.foldl (fn ((p, v), (r', eq')) =>
+                            let val (r'', eq'') = patterneq (p, v) r' in
+                                (r'', eq'' andalso eq')
+                            end) (r, eq) (ListPair.zip (ps, vs))
+            end
 
 val gensym = 
     let val count = ref 0 in
-	(fn x => (count := !count + 1;
-		  (x^(Int.toString (!count)))))
+        (fn x => (count := !count + 1;
+                  (x^(Int.toString (!count)))))
     end
 
 (* copies pattern with fresh variables bound in new environment *)
 fun generatePattern (r, p) =
     case p of
-	PVar x => 
-	    let val xx = gensym x in 
-		(update r x (Code (Var xx)), PVar xx) 
-	    end
+        PVar x => 
+            let val xx = gensym x in 
+                (update r x (Code (Var xx)), PVar xx) 
+            end
       | PAliasD (x, p) => 
-	    let val (r', p') = generatePattern (r, p) 
-		val xx = gensym x 
-	    in
-		(update r x (Code (Var xx)),
-		 PAlias (xx, p'))
-	    end
+            let val (r', p') = generatePattern (r, p) 
+                val xx = gensym x 
+            in
+                (update r x (Code (Var xx)),
+                 PAlias (xx, p'))
+            end
       | PConstructD (c, ps) =>
-	    let val (r, ps) = 
-		List.foldr (fn (p, (r, ps)) => 
-			    let val (r', p') = generatePattern (r, p) in
-				(r', p' :: ps)
-			    end) (r, []) ps
-	    in
-		(r, PConstruct (c, ps))
-	    end
-	
+            let val (r, ps) = 
+                List.foldr (fn (p, (r, ps)) => 
+                            let val (r', p') = generatePattern (r, p) in
+                                (r', p' :: ps)
+                            end) (r, []) ps
+            in
+                (r, PConstruct (c, ps))
+            end
+        
 (* the specializer *)
 fun spec e r =
     case e of
-	Var x => lookup r x
-	    
+        Var x => lookup r x
+            
       (* Specialization of Static Stuff - standard semantics *)
       | Lam (x, e) => Fun (fn y => spec e (update r x y))
-	    
+            
       | App (f, a) => 
-	    let val Fun ff = spec f r in 
-		ff (spec a r) 
-	    end 
-	
+            let val Fun ff = spec f r in 
+                ff (spec a r) 
+            end 
+        
       | Construct (c, es) =>
-	    let val vs = List.map (fn e => spec e r) es in
-		Con (c, vs)
-	    end
-	
+            let val vs = List.map (fn e => spec e r) es in
+                Con (c, vs)
+            end
+        
       | Case (test, cls) =>
-	    let val testv = spec test r 
-		(* exhaustive by restriction on patterns *)
-		fun loop cls =
-		    (case cls of
-			 ((p, e) :: cls) =>
-			     let val (r', eq) = patterneq (p, testv) r in
-				 if eq then spec e r' else loop cls
-			     end
-		       | [] => Wrong)
-	    in loop cls end
-	
+            let val testv = spec test r 
+                (* exhaustive by restriction on patterns *)
+                fun loop cls =
+                    (case cls of
+                         ((p, e) :: cls) =>
+                             let val (r', eq) = patterneq (p, testv) r in
+                                 if eq then spec e r' else loop cls
+                             end
+                       | [] => Wrong)
+            in loop cls end
+        
       | Let (x, e1, e2) => let val v1 = spec e1 r in spec e2 (update r x v1) end
   
       (* Specialization of Dynamic stuff *)
       | LamD (x, e) => 
-		let val xx = gensym x  
-		    val Code body = 
-			reset (fn () => spec e (update r x (Code (Var xx)))) 
-		in
-		    Code (Lam (xx, body))
-		end
-	    
+                let val xx = gensym x  
+                    val Code body = 
+                        reset (fn () => spec e (update r x (Code (Var xx)))) 
+                in
+                    Code (Lam (xx, body))
+                end
+            
       | AppD (f, a) => 
-		let val Code ff = spec f r 
-		    val Code aa = spec a r 
-		in
-		    Code (App (ff, aa))
-		end
-	    
+                let val Code ff = spec f r 
+                    val Code aa = spec a r 
+                in
+                    Code (App (ff, aa))
+                end
+            
       | ConstructD (c, es) =>
-		let val es' = List.map (fn e => let val Code v = spec e r
-						in v end) es
-		in
-		    Code (Construct (c, es'))
-		end
-	    
+                let val es' = List.map (fn e => let val Code v = spec e r
+                                                in v end) es
+                in
+                    Code (Construct (c, es'))
+                end
+            
       | LetD (x, e1, e2) => 
-		let val xx = gensym x in
-		    shift (fn k => 
-			   let val Code e1' = spec e1 r 
-			       val Code e2' = 
-				   reset (fn () => k (spec e2 (update r x (Code (Var xx))))) 
-			   in
-			       Code (Let (xx, e1', e2'))
-			   end)
-		end
-	    
+                let val xx = gensym x in
+                    shift (fn k => 
+                           let val Code e1' = spec e1 r 
+                               val Code e2' = 
+                                   reset (fn () => k (spec e2 (update r x (Code (Var xx))))) 
+                           in
+                               Code (Let (xx, e1', e2'))
+                           end)
+                end
+            
       | CaseD (test, cls) =>
-		shift (fn k =>
-		       let val Code testd = spec test r  
-			   val newCls = List.map (fn (p, e) =>
-						  let val (r', p') = generatePattern(r, p) 
-						      val Code branch = reset (fn () => k (spec e r')) 
-						  in
-						      (p', branch)
-						  end) cls
-		       in
-			   Code (Case(testd, newCls))
-		       end)
-		
+                shift (fn k =>
+                       let val Code testd = spec test r  
+                           val newCls = List.map (fn (p, e) =>
+                                                  let val (r', p') = generatePattern(r, p) 
+                                                      val Code branch = reset (fn () => k (spec e r')) 
+                                                  in
+                                                      (p', branch)
+                                                  end) cls
+                       in
+                           Code (Case(testd, newCls))
+                       end)
+                
       (* first-order lifting *)
       | Lift e => 
-		let val Con(c, []) = spec e r in
-		    Code(Construct (c, []))
-		end
+                let val Con(c, []) = spec e r in
+                    Code(Construct (c, []))
+                end
 
 fun specialize p = spec p []
 
 (* standard evaluation *)
 val sampleProg1 = Lam("q", App(Let("id",
-				   App(Var "q", Var "q"),
-				   Lam("z", Var "z")),
-			       Var "q"))
+                                   App(Var "q", Var "q"),
+                                   Lam("z", Var "z")),
+                               Var "q"))
 
 val sampleProg2 = Lam("f", App(Lam("x",
-				   Case(Var "x", 
-					[(PConstruct("True",[]), 
-					  Lam("x",Lam("y",Var "x"))), 
-					 (PConstruct("False",[]), 
-					  Lam("x",Lam("y",Var "y")))])), 
-			       Var "f"))
+                                   Case(Var "x", 
+                                        [(PConstruct("True",[]), 
+                                          Lam("x",Lam("y",Var "x"))), 
+                                         (PConstruct("False",[]), 
+                                          Lam("x",Lam("y",Var "y")))])), 
+                               Var "f"))
 
 (* partial evaluation *)
 val sampleProg1D = LamD("q", App(LetD("id",
-				      AppD(Var "q", Var "q"),
-				      Lam("z", Var "z")),
-				 Var "q"))
+                                      AppD(Var "q", Var "q"),
+                                      Lam("z", Var "z")),
+                                 Var "q"))
          
 val sampleProg2D = LamD("f", LamD("x", 
-				  App(CaseD(Var "x", 
-					    [(PConstructD("True",[]), 
-					      Lam("z",LamD("y", Var "z"))), 
-					     (PConstructD("False",[]),  
-					      Lam("z",LamD("y", Var "y")))]), 
-				      Var "f")))
+                                  App(CaseD(Var "x", 
+                                            [(PConstructD("True",[]), 
+                                              Lam("z",LamD("y", Var "z"))), 
+                                             (PConstructD("False",[]),  
+                                              Lam("z",LamD("y", Var "y")))]), 
+                                      Var "f")))
 
 val specialize =
    fn p =>

Modified: mlton/branches/on-20050420-cmm-branch/regression/callcc3.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/callcc3.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/callcc3.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -9,8 +9,8 @@
 val _ =
    case !rr of
       NONE =>
-	 (rr := SOME r
-	  ; throw (valOf (!kr), ()))
+         (rr := SOME r
+          ; throw (valOf (!kr), ()))
     | SOME r' => if r = r'
-		    then raise Fail "bug"
-		 else ()
+                    then raise Fail "bug"
+                 else ()

Modified: mlton/branches/on-20050420-cmm-branch/regression/char.scan.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/char.scan.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/char.scan.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -7,16 +7,16 @@
    let
       val n = String.size s
       fun reader i =
-	 if i = n
-	    then NONE
-	 else SOME (String.sub (s, i), i + 1)
+         if i = n
+            then NONE
+         else SOME (String.sub (s, i), i + 1)
    in
       case Char.scan reader 0 of
-	 NONE => print "NONE\n"
+         NONE => print "NONE\n"
        | SOME (c, i) => print (concat [str c, " at ", Int.toString i,
-				       " of ", Int.toString n, "\n"])
+                                       " of ", Int.toString n, "\n"])
    end
 
 val _ =
    List.app scan ["a\\ \\", "\\ \\a", "\\ \\a\\ \\", "\\ \\\\ \\a",
-		  "\\ \\"]
+                  "\\ \\"]

Modified: mlton/branches/on-20050420-cmm-branch/regression/check_arrays.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/check_arrays.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/check_arrays.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -8,7 +8,7 @@
 fun range (from, to) p = 
     let open Int 
     in
-	(from > to) orelse (p from) andalso (range (from+1, to) p)
+        (from > to) orelse (p from) andalso (range (from+1, to) p)
     end;
 
 fun checkrange bounds = check o range bounds;
@@ -44,22 +44,22 @@
      (dot ();
       if Word8Array.sub (a, !i) <> 0w42
       then impossible ("check 1 failed: it is "
-		       ^ Int.toString (Word8.toInt (Word8Array.sub (a, !i))))
+                       ^ Int.toString (Word8.toInt (Word8Array.sub (a, !i))))
       else ();
       i := !i + 1);
    phase "\ncheck length:";
    if Word8Array.length a <> n then
      impossible ("length was "
-		 ^ Int.toString (Word8Array.length a)
-		 ^ " and not "
-		 ^ Int.toString n)
+                 ^ Int.toString (Word8Array.length a)
+                 ^ " and not "
+                 ^ Int.toString n)
    else ();
    phase "\ncheck foldr:";
    if (Word8Array.foldr (fn (e,a) => Word8.toInt e + a) 0 a) <> Word8Array.length a * 42 then
      impossible ("foldr check failed: it was "
-		 ^ Int.toString (Word8Array.foldr (fn (e,a) => Word8.toInt e + a) 0 a)
-		 ^ " and not "
-		 ^ Int.toString (Word8Array.length a * 42))
+                 ^ Int.toString (Word8Array.foldr (fn (e,a) => Word8.toInt e + a) 0 a)
+                 ^ " and not "
+                 ^ Int.toString (Word8Array.length a * 42))
    else ();
    phase "\ninit:";
    i := 0;
@@ -73,9 +73,9 @@
      (dot ();
       if Word8Array.sub (a, !i) <> (0w2 * (Word8.fromInt (!i) mod 0w20))
       then impossible (concat["check 2 failed: found ",
-			      (Int.toString o Word8.toInt)(Word8Array.sub (a, !i)),
-			      " and not ",
-			      (Int.toString o Word8.toInt)(0w2 * (Word8.fromInt (!i) mod 0w20))])
+                              (Int.toString o Word8.toInt)(Word8Array.sub (a, !i)),
+                              " and not ",
+                              (Int.toString o Word8.toInt)(0w2 * (Word8.fromInt (!i) mod 0w20))])
       else ();
       i := !i - 1);
    print "    \tok"
@@ -119,16 +119,16 @@
    phase "\ncheck length:";
    if Array.length a <> n then
      impossible ("length was "
-		 ^ Int.toString (Array.length a)
-		 ^ " and not "
-		 ^ Int.toString n)
+                 ^ Int.toString (Array.length a)
+                 ^ " and not "
+                 ^ Int.toString n)
    else ();
    phase "\ncheck foldr:";
    if Array.foldr (op +) 0 a <> Array.length a * 42 then
      impossible ("foldr check failed: it was "
-		 ^ Int.toString (Array.foldr (op +) 0 a)
-		 ^ " and not "
-		 ^ Int.toString (Array.length a * 42))
+                 ^ Int.toString (Array.foldr (op +) 0 a)
+                 ^ " and not "
+                 ^ Int.toString (Array.length a * 42))
    else ();
    phase "\ninit:";
    i := 0;
@@ -191,9 +191,9 @@
    phase "\ncheck length:";
    if CharArray.length a <> n then
      impossible ("length was "
-		 ^ Int.toString (CharArray.length a)
-		 ^ " and not "
-		 ^ Int.toString n)
+                 ^ Int.toString (CharArray.length a)
+                 ^ " and not "
+                 ^ Int.toString n)
    else ();
    phase "\ncheck foldr:";
    if CharArray.foldr f b_init a <> x_summasumarum then

Modified: mlton/branches/on-20050420-cmm-branch/regression/cmdline.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/cmdline.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/cmdline.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -8,7 +8,7 @@
 fun range (from, to) p = 
     let open Int 
     in
-	(from > to) orelse (p from) andalso (range (from+1, to) p)
+        (from > to) orelse (p from) andalso (range (from+1, to) p)
     end;
 
 fun checkrange bounds = check o range bounds;
@@ -23,5 +23,5 @@
 
 val _ = 
     (app print ["This program is invoked as `", CommandLine.name(), "'\n",
-		"with arguments:\n"];
+                "with arguments:\n"];
      app (fn a => (print a; print "\n")) (CommandLine.arguments ()))

Modified: mlton/branches/on-20050420-cmm-branch/regression/cobol.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/cobol.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/cobol.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -73,7 +73,7 @@
 
   datatype identifier =
     QUALIFIED_IDENTIFIER of string * qualifications * subscript_phrase
-			    * pos * pos
+                            * pos * pos
   | SPECIAL_REGISTER of special_register * pos * pos
 
   datatype identifiers =
@@ -86,7 +86,7 @@
 
   datatype identifier_or_literals =
     SEVERAL_IDENTIFIER_OR_LITERALS of identifier_or_literals
-				    * identifier_or_literal
+                                    * identifier_or_literal
   | ONE_IDENTIFIER_OR_LITERAL of identifier_or_literal
 
   datatype rounded =
@@ -141,7 +141,7 @@
 
   datatype special_names_clauses =
     SEVERAL_SPECIAL_NAMES_CLAUSES of special_names_clauses
-				   * special_names_clause
+                                   * special_names_clause
   | NO_SPECIAL_NAMES_CLAUSES
 
   datatype special_names_paragraph =
@@ -150,7 +150,7 @@
 
   datatype configuration_section =
     CONFIGURATION_SECTION of
-	source_computer_paragraph
+        source_computer_paragraph
       * object_computer_paragraph
       * special_names_paragraph
 
@@ -222,31 +222,31 @@
 
   datatype data_description_clause =
     DATA_DESCRIPTION_CLAUSE_IS_USAGE_CLAUSE of usage_specifier
-	            * pos * pos
+                    * pos * pos
   | DATA_DESCRIPTION_CLAUSE_IS_SIGN_CLAUSE of leading_trailing *
                                               separate_character
-	            * pos * pos
+                    * pos * pos
   | DATA_DESCRIPTION_CLAUSE_IS_OCCURS_CLAUSE
        of table_length_description *
           ascending_descending_key_phrases *
           indexed_by_phrase
-	            * pos * pos
+                    * pos * pos
   | DATA_DESCRIPTION_CLAUSE_IS_SYNCHRONIZED_CLAUSE of left_right
-	            * pos * pos
+                    * pos * pos
   | DATA_DESCRIPTION_CLAUSE_IS_JUSTIFIED_CLAUSE of
-	            pos * pos
+                    pos * pos
   | DATA_DESCRIPTION_CLAUSE_IS_BLANK_WHEN_ZERO_CLAUSE of
-	            pos * pos
+                    pos * pos
   | DATA_DESCRIPTION_CLAUSE_IS_VALUE_CLAUSE of literal_ranges
-	            * pos * pos
+                    * pos * pos
   | DATA_DESCRIPTION_CLAUSE_IS_PICTURE_CLAUSE of string
-	            * pos * pos
+                    * pos * pos
   | DATA_DESCRIPTION_CLAUSE_IS_INDICATOR_CLAUSE of string
-	            * pos * pos
+                    * pos * pos
 
   datatype data_description_clauses =
     DATA_DESCRIPTION_CLAUSES of data_description_clauses *
-				data_description_clause
+                                data_description_clause
   | NO_DATA_DESCRIPTION_CLAUSES
 
   datatype redefines_clause =
@@ -266,12 +266,12 @@
                                 * data_name_or_filler
                                 * redefines_clause
                                 * data_description_clauses
-			        * pos * pos
+                                * pos * pos
   | RENAMES_CLAUSE of string               (* levelnumber *)
                     * string               (* data-name *)
                     * string               (* data-name *)
                     * through_data_name
-	            * pos * pos
+                    * pos * pos
   | TS2K_NOARROW of ts2k * pos * pos
   | TS2K_ARROW  of ts2k * ts2k * pos * pos
   | TS2K_ALL of ts2k * ts2k * pos * pos
@@ -317,13 +317,13 @@
 
   datatype sort_description_clause =
     SORT_DESCRIPTION_CLAUSE_IS_RECORD of record_contains_clause
-	            * pos * pos
+                    * pos * pos
   | SORT_DESCRIPTION_CLAUSE_IS_DATA of data_records_clause
-	            * pos * pos
+                    * pos * pos
 
   datatype sort_description_clauses =
     SORT_DESCRIPTION_CLAUSES of sort_description_clauses *
-				sort_description_clause
+                                sort_description_clause
   | NO_SORT_DESCRIPTION_CLAUSE
 
   datatype sort_description_entry =
@@ -339,7 +339,7 @@
 
   datatype top_bottom_specifications =
     TOP_BOTTOM_SPECIFICATIONS of top_bottom_specifications *
-				 top_bottom_specification
+                                 top_bottom_specification
   | NO_TOP_BOTTOM_SPECIFICATION
 
   datatype value_of_phrase =
@@ -365,7 +365,7 @@
   | FILE_DESCRIPTION_CLAUSE_IS_DATA of data_records_clause
            * pos * pos
   | LINAGE_CLAUSE of data_name_or_integer *
-		     footing_specification *
+                     footing_specification *
                      top_bottom_specifications
            * pos * pos
   | CODE_SET_CLAUSE of string
@@ -373,7 +373,7 @@
 
   datatype file_description_clauses =
     FILE_DESCRIPTION_CLAUSES of file_description_clauses *
-				file_description_clause
+                                file_description_clause
   | NO_FILE_DESCRIPTION_CLAUSES
 
   datatype file_description_entry =
@@ -385,11 +385,11 @@
     
   datatype file_description_paragraph =
     FILE_DESCRIPTION_PARAGRAPH of file_and_sort_description_entry *
-			          record_description_entries
+                                  record_description_entries
 
   datatype file_description_paragraphs =
     FILE_DESCRIPTION_PARAGRAPHS of file_description_paragraphs *
-			           file_description_paragraph
+                                   file_description_paragraph
   | NO_FILE_DESCRIPTION_PARAGRAPHS
 
   datatype file_section =
@@ -406,28 +406,28 @@
   | ARITHMETIC_EXPRESSION_IS_NONNUMERICLITERAL of string * pos * pos
   | ARITHMETIC_EXPRESSION_IS_BOOLEANLITERAL of bool * pos * pos
   | ARITHMETIC_EXPRESSION_IS_FIGURATIVE_CONSTANT of figurative_constant *
-						    pos * pos
+                                                    pos * pos
   | ARITHMETIC_EXPRESSION_IS_IDENTIFIER of identifier
   | ARITHMETIC_EXPRESSION_IS_PLUS_SIGN of arithmetic_expression
   | ARITHMETIC_EXPRESSION_IS_MINUS_SIGN of arithmetic_expression
   | ARITHMETIC_EXPRESSION_IS_EXPONENTIATION of arithmetic_expression *
-					       arithmetic_expression
+                                               arithmetic_expression
   | ARITHMETIC_EXPRESSION_IS_MULTIPLY of arithmetic_expression *
-					 arithmetic_expression
+                                         arithmetic_expression
   | ARITHMETIC_EXPRESSION_IS_DIVIDE of arithmetic_expression *
-				       arithmetic_expression
+                                       arithmetic_expression
   | ARITHMETIC_EXPRESSION_IS_ADD of arithmetic_expression *
-				    arithmetic_expression
+                                    arithmetic_expression
   | ARITHMETIC_EXPRESSION_IS_SUBTRACT of arithmetic_expression *
-					 arithmetic_expression
+                                         arithmetic_expression
 
   datatype simple_condition =
     CLASS_CONDITION of identifier * is_not * data_class
   | CONDITION_NAME of identifier
   | RELATION_CONDITION of arithmetic_expression *
-			  is_not *
-			  relational_operator *
-			  arithmetic_expression * pos * pos
+                          is_not *
+                          relational_operator *
+                          arithmetic_expression * pos * pos
   (* Unclear if TRUE and FALSE are allowed in conditions  *)
   (* at all (TRUE is reserved word but not FALSE)         *)
   | SIMPLE_CONDITION_IS_TRUE of pos * pos
@@ -489,65 +489,65 @@
 
   and add_or_subtract_statement =
     ADD_OR_SUBTRACT of add_or_subtract * identifier_or_literals
-	 * identifier_roundeds
-	 * size_error_clause * pos * pos
+         * identifier_roundeds
+         * size_error_clause * pos * pos
   | ADD_OR_SUBTRACT_GIVING of add_or_subtract * identifier_or_literals
-		* identifier_or_literal
-		* identifier_roundeds
-		* size_error_clause * pos * pos
+                * identifier_or_literal
+                * identifier_roundeds
+                * size_error_clause * pos * pos
   | ADD_OR_SUBTRACT_CORRESPONDING of add_or_subtract * identifier
-		       * identifier
-		       * rounded
-		       * size_error_clause * pos * pos
+                       * identifier
+                       * rounded
+                       * size_error_clause * pos * pos
 
   and compute_statement =
     COMPUTE of identifier_roundeds *
-	       arithmetic_expression *
-	       size_error_clause * pos * pos
+               arithmetic_expression *
+               size_error_clause * pos * pos
 
   and multiply_statement =
     MULTIPLY of identifier_or_literal
-	 * identifier_roundeds
-	 * size_error_clause * pos * pos
+         * identifier_roundeds
+         * size_error_clause * pos * pos
   | MULTIPLY_GIVING of identifier_or_literal
-		* identifier_or_literal
-		* identifier_roundeds
-		* size_error_clause * pos * pos
+                * identifier_or_literal
+                * identifier_roundeds
+                * size_error_clause * pos * pos
 
   (* NOTE: the following is not checked against the manual *)
   (*       neither is it tested                            *)
   and divide_statement =
   (* DIVIDE a INTO b [[ON] SIZE ERROR c]                         *)
     DIVIDE_INTO of identifier_or_literal                    (* a *)
-		 * identifier_roundeds                      (* b *)
-		 * size_error_clause                        (* c *)
-		 * pos * pos
+                 * identifier_roundeds                      (* b *)
+                 * size_error_clause                        (* c *)
+                 * pos * pos
   (* DIVIDE a INTO b GIVING c [[ON] SIZE ERROR d]                *)
   | DIVIDE_INTO_GIVING of identifier_or_literal             (* a *)
-		 * identifier_or_literal                    (* b *)
-		 * identifier_roundeds                      (* c *)
-		 * size_error_clause                        (* d *)
-		 * pos * pos
+                 * identifier_or_literal                    (* b *)
+                 * identifier_roundeds                      (* c *)
+                 * size_error_clause                        (* d *)
+                 * pos * pos
   (* DIVIDE a INTO b GIVING c REMAINDER d [[ON] SIZE ERROR e]    *)
   | DIVIDE_INTO_GIVING_REMAINDER of identifier_or_literal   (* a *)
-		 * identifier_or_literal                    (* b *)
-		 * identifier_roundeds                      (* c *)
-		 * identifier                               (* d *)
-		 * size_error_clause                        (* e *)
-		 * pos * pos
+                 * identifier_or_literal                    (* b *)
+                 * identifier_roundeds                      (* c *)
+                 * identifier                               (* d *)
+                 * size_error_clause                        (* e *)
+                 * pos * pos
   (* DIVIDE a BY b GIVING c [[ON] SIZE ERROR d]                  *)
   | DIVIDE_BY_GIVING of identifier_or_literal               (* a *)
-		 * identifier_or_literal                    (* b *)
-		 * identifier_roundeds                      (* c *)
-		 * size_error_clause                        (* d *)
-		 * pos * pos
+                 * identifier_or_literal                    (* b *)
+                 * identifier_roundeds                      (* c *)
+                 * size_error_clause                        (* d *)
+                 * pos * pos
   (* DIVIDE a BY b GIVING c REMAINDER d [[ON] SIZE ERROR e]      *)
   | DIVIDE_BY_GIVING_REMAINDER of identifier_or_literal     (* a *)
-		 * identifier_or_literal                    (* b *)
-		 * identifier_roundeds                      (* c *)
-		 * identifier                               (* d *)
-		 * size_error_clause                        (* e *)
-		 * pos * pos
+                 * identifier_or_literal                    (* b *)
+                 * identifier_roundeds                      (* c *)
+                 * identifier                               (* d *)
+                 * size_error_clause                        (* e *)
+                 * pos * pos
 
   and size_error_clause =
     SIZE_ERROR of statements
@@ -593,11 +593,11 @@
   datatype sections =
     NO_BODY_SECTION of section_name * segment_number_opt
   | NO_BODY_SECTION_FOLLOWED_BY_SECTION of section_name *
-					   segment_number_opt *
-					   sections
+                                           segment_number_opt *
+                                           sections
   | SECTION of section_name *
-	       segment_number_opt *
-	       paragraphs_and_sections
+               segment_number_opt *
+               paragraphs_and_sections
 
   and paragraphs_and_sections =
     SEVERAL_PARAGRAPHS_AND_SECTIONS of paragraph * paragraphs_and_sections
@@ -610,15 +610,15 @@
 
   datatype procedure_division =
     PROCEDURE_DIVISION_FORMAT_1_DECLARATIVES of using_clause *
-						declaratives_section *
-						sections *
-						pos * pos
+                                                declaratives_section *
+                                                sections *
+                                                pos * pos
   | PROCEDURE_DIVISION_FORMAT_1_NO_DECLARATIVES of using_clause *
-						   sections *
-						   pos * pos
+                                                   sections *
+                                                   pos * pos
   | PROCEDURE_DIVISION_FORMAT_2 of using_clause *
-				   paragraphs * 
-				   pos * pos
+                                   paragraphs * 
+                                   pos * pos
   | EMPTY_PROCEDURE_DIVISION
      (* no procedure division allowed by our parser though mandatory in S/36 *)
 
@@ -635,15 +635,15 @@
   datatype environment_division =
     ENVIRONMENT_DIVISION of 
                             configuration_section *
-			    input_output_section
+                            input_output_section
   | NO_ENVIRONMENT_DIVISION
 
   type identification_division = unit
 
   datatype cobol_program =
     PROGRAM of identification_division *
-	       environment_division *
-	       data_division *
+               environment_division *
+               data_division *
                procedure_division
 
   datatype test_cobol_programs =
@@ -661,17 +661,17 @@
 datatype cexpression =
   CE_AE of Cobol.arithmetic_expression * Cobol.pos * Cobol.pos
 | CE_SINGLE_REL of Cobol.relational_operator * Cobol.arithmetic_expression *
-		   Cobol.pos * Cobol.pos
+                   Cobol.pos * Cobol.pos
 | CE_REL of Cobol.arithmetic_expression *
-	    Cobol.is_not *
-	    Cobol.relational_operator *
-	    Cobol.arithmetic_expression * Cobol.pos * Cobol.pos
+            Cobol.is_not *
+            Cobol.relational_operator *
+            Cobol.arithmetic_expression * Cobol.pos * Cobol.pos
 | CE_DC of Cobol.arithmetic_expression *
-	   Cobol.is_not *
-	   Cobol.data_class
+           Cobol.is_not *
+           Cobol.data_class
 | CE_SIGN of Cobol.arithmetic_expression *
-	     Cobol.is_not *
-	     Cobol.sign_specification
+             Cobol.is_not *
+             Cobol.sign_specification
 | CE_SWITCH of Cobol.pos * Cobol.pos
 | CE_TRUE of Cobol.pos * Cobol.pos
 | CE_FALSE of Cobol.pos * Cobol.pos
@@ -684,7 +684,7 @@
 
 
 
-	     
+             
 structure MlyValue = 
 struct
 datatype svalue = VOID | ntVOID of unit | PSEUDOTEXT of  (string)
@@ -824,14 +824,14 @@
  | cobol_program of  (Cobol.cobol_program)
 end
 type svalue = MlyValue.svalue
-(*TODO 13/01/1998 14:54. hojfeld.: mine erklæringer:*)
+(*TODO 13/01/1998 14:54. hojfeld.: mine erklringer:*)
 type pos = unit
 type arg = unit
 datatype nonterm = hojfelds_NT of int
 exception Hojfeld of string
-(*og så: LrTable.NT |-> hojfelds_NT*)
+(*og s: LrTable.NT |-> hojfelds_NT*)
 
-(*TODO 13/01/1998 14:54. hojfeld.: mine erklæringer slut*)
+(*TODO 13/01/1998 14:54. hojfeld.: mine erklringer slut*)
   
 fun actions(i392:int, defaultPos:pos, stack:(unit (*LrTable.state*) * (svalue * pos * pos)) list,  
             ():arg
@@ -1585,10 +1585,10 @@
 USERDEFINEDWORD1left,_))::rest671) => let val result=
 MlyValue.identifier((
 Cobol.QUALIFIED_IDENTIFIER(USERDEFINEDWORD,
-				       qualifications,
-				       subscript_phrase,
+                                       qualifications,
+                                       subscript_phrase,
                                        USERDEFINEDWORDleft,
-				       subscript_phraseright)
+                                       subscript_phraseright)
 ))
  in (hojfelds_NT 228,(result,USERDEFINEDWORD1left,
 subscript_phrase1right),rest671) end
@@ -1682,7 +1682,7 @@
 identifier_or_literals,identifier_or_literals1left,_))::rest671) => 
 let val result=MlyValue.identifier_or_literals((
 Cobol.SEVERAL_IDENTIFIER_OR_LITERALS(identifier_or_literals,
-					  identifier_or_literal)
+                                          identifier_or_literal)
 ))
  in (hojfelds_NT 234,(result,identifier_or_literals1left,
 identifier_or_literal1right),rest671) end
@@ -1804,10 +1804,10 @@
 _,process_statement1left,_))::rest671) => let val result=
 MlyValue.cobol_program((
 condition_names := [];
-			    Cobol.PROGRAM(identification_division,
-					  environment_division,
-					  data_division,
-					  procedure_division)
+                            Cobol.PROGRAM(identification_division,
+                                          environment_division,
+                                          data_division,
+                                          procedure_division)
 ))
  in (hojfelds_NT 0,(result,process_statement1left,
 procedure_division1right),rest671) end
@@ -1917,7 +1917,7 @@
 configuration_section,_,_))::_::_::(_,(_,ENVIRONMENT1left,_))::rest671
 ) => let val result=MlyValue.environment_division((
 Cobol.ENVIRONMENT_DIVISION
-		   (configuration_section,input_output_section)
+                   (configuration_section,input_output_section)
 ))
  in (hojfelds_NT 153,(result,ENVIRONMENT1left,
 input_output_section1right),rest671) end
@@ -1931,8 +1931,8 @@
 _::_::(_,(_,CONFIGURATION1left,_))::rest671) => let val result=
 MlyValue.configuration_section((
 Cobol.CONFIGURATION_SECTION
-	      (source_computer_paragraph,object_computer_paragraph
-	       ,special_names_paragraph)
+              (source_computer_paragraph,object_computer_paragraph
+               ,special_names_paragraph)
 ))
  in (hojfelds_NT 77,(result,CONFIGURATION1left,
 special_names_paragraph1right),rest671) end
@@ -2011,7 +2011,7 @@
 special_names_clauses,special_names_clauses1left,_))::rest671) => let 
 val result=MlyValue.special_names_clauses((
 Cobol.SEVERAL_SPECIAL_NAMES_CLAUSES(special_names_clauses,
-					       special_names_clause)
+                                               special_names_clause)
 ))
  in (hojfelds_NT 102,(result,special_names_clauses1left,
 special_names_clause1right),rest671) end
@@ -2402,8 +2402,8 @@
 _,_))::_::_::(_,(_,DATA1left,_))::rest671) => let val result=
 MlyValue.data_division((
 Cobol.DATA_DIVISION(file_section,
-					     working_storage_section,
-					     linkage_section)
+                                             working_storage_section,
+                                             linkage_section)
 ))
  in (hojfelds_NT 91,(result,DATA1left,linkage_section1right),rest671)
  end
@@ -2427,7 +2427,7 @@
 file_description_paragraphs1left,_))::rest671) => let val result=
 MlyValue.file_description_paragraphs((
 Cobol.FILE_DESCRIPTION_PARAGRAPHS(file_description_paragraphs,
-					      file_description_paragraph)
+                                              file_description_paragraph)
 ))
  in (hojfelds_NT 195,(result,file_description_paragraphs1left,
 file_description_paragraph1right),rest671) end
@@ -2485,8 +2485,8 @@
 record_contains_clauseright as record_contains_clause1right))::rest671
 ) => let val result=MlyValue.file_description_clause((
 Cobol.FILE_DESCRIPTION_CLAUSE_IS_RECORD(record_contains_clause,
-						   record_contains_clauseleft,
-						   record_contains_clauseright)
+                                                   record_contains_clauseleft,
+                                                   record_contains_clauseright)
 ))
  in (hojfelds_NT 191,(result,record_contains_clause1left,
 record_contains_clause1right),rest671) end
@@ -2506,8 +2506,8 @@
 data_records_clauseright as data_records_clause1right))::rest671) => 
 let val result=MlyValue.file_description_clause((
 Cobol.FILE_DESCRIPTION_CLAUSE_IS_DATA(data_records_clause,
-						 data_records_clauseleft,
-						 data_records_clauseright)
+                                                 data_records_clauseleft,
+                                                 data_records_clauseright)
 ))
  in (hojfelds_NT 191,(result,data_records_clause1left,
 data_records_clause1right),rest671) end
@@ -2527,7 +2527,7 @@
 BLOCK1left,_))::rest671) => let val result=
 MlyValue.block_contains_clause((
 Cobol.BLOCK(integer_range,
-		     characters_or_records,
+                     characters_or_records,
                      BLOCKleft,
                      characters_or_recordsright)
 ))
@@ -2576,7 +2576,7 @@
 MlyValue.value_of_clause((
 Cobol.VALUE_OF_CLAUSE(value_of_phrases,
                                  VALUEleft,
-				 value_of_phrasesright)
+                                 value_of_phrasesright)
 ))
  in (hojfelds_NT 518,(result,VALUE1left,value_of_phrases1right),rest671
 ) end
@@ -2611,10 +2611,10 @@
 data_name_or_integer,_,_))::_::(_,(_,LINAGEleft as LINAGE1left,_))::
 rest671) => let val result=MlyValue.linage_clause((
 Cobol.LINAGE_CLAUSE(data_name_or_integer,
-				 footing_specification,
-				 top_bottom_specifications,
-				 LINAGEleft,
-				 top_bottom_specificationsright)
+                                 footing_specification,
+                                 top_bottom_specifications,
+                                 LINAGEleft,
+                                 top_bottom_specificationsright)
 ))
  in (hojfelds_NT 293,(result,LINAGE1left,
 top_bottom_specifications1right),rest671) end
@@ -2655,8 +2655,8 @@
  as alphabet_name1right))::_::(_,(_,CODESETleft as CODESET1left,_))::
 rest671) => let val result=MlyValue.code_set_clause((
 Cobol.CODE_SET_CLAUSE(alphabet_name,
-				 CODESETleft,
-				 alphabet_nameright)
+                                 CODESETleft,
+                                 alphabet_nameright)
 ))
  in (hojfelds_NT 65,(result,CODESET1left,alphabet_name1right),rest671)
  end
@@ -2683,9 +2683,9 @@
 record_contains_clauseright as record_contains_clause1right))::rest671
 ) => let val result=MlyValue.sort_description_clause((
 Cobol.SORT_DESCRIPTION_CLAUSE_IS_RECORD
-		(record_contains_clause,
-		 record_contains_clauseleft,
-		 record_contains_clauseright)
+                (record_contains_clause,
+                 record_contains_clauseleft,
+                 record_contains_clauseright)
 ))
  in (hojfelds_NT 445,(result,record_contains_clause1left,
 record_contains_clause1right),rest671) end
@@ -2694,8 +2694,8 @@
 data_records_clauseright as data_records_clause1right))::rest671) => 
 let val result=MlyValue.sort_description_clause((
 Cobol.SORT_DESCRIPTION_CLAUSE_IS_DATA(data_records_clause,
-						 data_records_clauseleft,
-						 data_records_clauseright)
+                                                 data_records_clauseleft,
+                                                 data_records_clauseright)
 ))
  in (hojfelds_NT 445,(result,data_records_clause1left,
 data_records_clause1right),rest671) end
@@ -2783,17 +2783,17 @@
 level_number1left,_))::rest671) => let val result=
 MlyValue.data_description_entry_134((
 (if (level_number = "88")
-	   then (case data_name_or_filler of
-		  Cobol.DATA_NAME_OR_FILLER_IS_DATA_NAME(data_name)
-		   => condition_names := data_name :: (!condition_names)
-		| _ => ())
-	   else ());
+           then (case data_name_or_filler of
+                  Cobol.DATA_NAME_OR_FILLER_IS_DATA_NAME(data_name)
+                   => condition_names := data_name :: (!condition_names)
+                | _ => ())
+           else ());
            Cobol.DATA_DESCRIPTION_ENTRY_134(level_number,
-					    data_name_or_filler,
-					    redefines_clause,
-					    data_description_clauses,
-					    level_numberleft,
-					    PERIODright)
+                                            data_name_or_filler,
+                                            redefines_clause,
+                                            data_description_clauses,
+                                            level_numberleft,
+                                            PERIODright)
 ))
  in (hojfelds_NT 90,(result,level_number1left,PERIOD1right),rest671)
  end
@@ -2810,7 +2810,7 @@
  data_description_clauses,data_description_clauses1left,_))::rest671)
  => let val result=MlyValue.data_description_clauses((
 Cobol.DATA_DESCRIPTION_CLAUSES(data_description_clauses,
-					  data_description_clause)
+                                          data_description_clause)
 ))
  in (hojfelds_NT 88,(result,data_description_clauses1left,
 data_description_clause1right),rest671) end
@@ -2821,8 +2821,8 @@
 usage_clause1left,usage_clauseright as usage_clause1right))::rest671)
  => let val result=MlyValue.data_description_clause((
 Cobol.DATA_DESCRIPTION_CLAUSE_IS_USAGE_CLAUSE(usage_clause,
-							 usage_clauseleft,
-							 usage_clauseright)
+                                                         usage_clauseleft,
+                                                         usage_clauseright)
 ))
  in (hojfelds_NT 87,(result,usage_clause1left,usage_clause1right),
 rest671) end
@@ -2831,7 +2831,7 @@
 let val result=MlyValue.data_description_clause((
 let val (lt,sc) = sign_clause
                  in Cobol.DATA_DESCRIPTION_CLAUSE_IS_SIGN_CLAUSE
-		     (lt,sc,sign_clauseleft,sign_clauseright)
+                     (lt,sc,sign_clauseleft,sign_clauseright)
                  end
 ))
  in (hojfelds_NT 87,(result,sign_clause1left,sign_clause1right),rest671
@@ -2840,9 +2840,9 @@
 occurs_clause1left,occurs_clauseright as occurs_clause1right))::
 rest671) => let val result=MlyValue.data_description_clause((
 let val (tld, adkp, ibp) = occurs_clause
-	   in Cobol.DATA_DESCRIPTION_CLAUSE_IS_OCCURS_CLAUSE
-		(tld, adkp, ibp, occurs_clauseleft, occurs_clauseright)
-	   end
+           in Cobol.DATA_DESCRIPTION_CLAUSE_IS_OCCURS_CLAUSE
+                (tld, adkp, ibp, occurs_clauseleft, occurs_clauseright)
+           end
 ))
  in (hojfelds_NT 87,(result,occurs_clause1left,occurs_clause1right),
 rest671) end
@@ -2879,8 +2879,8 @@
 value_clause1left,value_clauseright as value_clause1right))::rest671)
  => let val result=MlyValue.data_description_clause((
 Cobol.DATA_DESCRIPTION_CLAUSE_IS_VALUE_CLAUSE(value_clause,
-							 value_clauseleft,
-							 value_clauseright)
+                                                         value_clauseleft,
+                                                         value_clauseright)
 ))
  in (hojfelds_NT 87,(result,value_clause1left,value_clause1right),
 rest671) end
@@ -2888,8 +2888,8 @@
  as picture_clause1left,picture_clauseright as picture_clause1right))
 ::rest671) => let val result=MlyValue.data_description_clause((
 Cobol.DATA_DESCRIPTION_CLAUSE_IS_PICTURE_CLAUSE(picture_clause,
-							   picture_clauseleft,
-							   picture_clauseright)
+                                                           picture_clauseleft,
+                                                           picture_clauseright)
 ))
  in (hojfelds_NT 87,(result,picture_clause1left,picture_clause1right),
 rest671) end
@@ -2899,8 +2899,8 @@
 MlyValue.data_description_clause((
 Cobol.DATA_DESCRIPTION_CLAUSE_IS_INDICATOR_CLAUSE
                 (indicator_clause,
-		 indicator_clauseleft,
-		 indicator_clauseright)
+                 indicator_clauseleft,
+                 indicator_clauseright)
 ))
  in (hojfelds_NT 87,(result,indicator_clause1left,
 indicator_clause1right),rest671) end
@@ -3086,8 +3086,8 @@
                                 data_name1,
                                 data_name2,
                                 through_data_name,
-				level_numberleft,
-				PERIODright)
+                                level_numberleft,
+                                PERIODright)
 ))
  in (hojfelds_NT 401,(result,level_number1left,PERIOD1right),rest671)
  end
@@ -3104,7 +3104,7 @@
 WORKINGSTORAGEleft as WORKINGSTORAGE1left,_))::rest671) => let val 
 result=MlyValue.working_storage_section((
 Cobol.WORKINGSTORAGE_SECTION(record_description_entries_opt,
-	                                WORKINGSTORAGEleft,record_description_entries_optright)
+                                        WORKINGSTORAGEleft,record_description_entries_optright)
 ))
  in (hojfelds_NT 529,(result,WORKINGSTORAGE1left,
 record_description_entries_opt1right),rest671) end
@@ -3117,7 +3117,7 @@
  as LINKAGE1left,_))::rest671) => let val result=
 MlyValue.linkage_section((
 Cobol.LINKAGE_SECTION(record_description_entries_opt,
-	                         LINKAGEleft,record_description_entries_optright)
+                                 LINKAGEleft,record_description_entries_optright)
 ))
  in (hojfelds_NT 297,(result,LINKAGE1left,
 record_description_entries_opt1right),rest671) end
@@ -3130,9 +3130,9 @@
 _,_))::_::(_,(_,PROCEDUREleft as PROCEDURE1left,_))::rest671) => let 
 val result=MlyValue.procedure_division((
 Cobol.PROCEDURE_DIVISION_FORMAT_1_DECLARATIVES(using_clause,
-							  declaratives_section,
-							  sections,
-	                                                  PROCEDUREleft,
+                                                          declaratives_section,
+                                                          sections,
+                                                          PROCEDUREleft,
                                                           sectionsright)
 ))
  in (hojfelds_NT 367,(result,PROCEDURE1left,sections1right),rest671)
@@ -3142,7 +3142,7 @@
 (_,(_,PROCEDUREleft as PROCEDURE1left,_))::rest671) => let val result=
 MlyValue.procedure_division((
 Cobol.PROCEDURE_DIVISION_FORMAT_1_NO_DECLARATIVES(using_clause,
-							     sections,
+                                                             sections,
                                                              PROCEDUREleft,
                                                              sectionsright)
 ))
@@ -3208,8 +3208,8 @@
 MlyValue.section_name section_name,section_name1left,_))::rest671) => 
 let val result=MlyValue.sections((
 Cobol.NO_BODY_SECTION_FOLLOWED_BY_SECTION(section_name,
-						     segment_number_opt,
-						     sections)
+                                                     segment_number_opt,
+                                                     sections)
 ))
  in (hojfelds_NT 424,(result,section_name1left,sections1right),rest671)
  end
@@ -3218,8 +3218,8 @@
 segment_number_opt,_,_))::_::(_,(MlyValue.section_name section_name,
 section_name1left,_))::rest671) => let val result=MlyValue.sections((
 Cobol.SECTION(section_name,
-			 segment_number_opt,
-			 paragraphs_and_sections)
+                         segment_number_opt,
+                         paragraphs_and_sections)
 ))
  in (hojfelds_NT 424,(result,section_name1left,
 paragraphs_and_sections1right),rest671) end
@@ -3228,7 +3228,7 @@
 paragraph1left,_))::rest671) => let val result=
 MlyValue.paragraphs_and_sections((
 Cobol.SEVERAL_PARAGRAPHS_AND_SECTIONS(paragraph,
-						 paragraphs_and_sections)
+                                                 paragraphs_and_sections)
 ))
  in (hojfelds_NT 359,(result,paragraph1left,
 paragraphs_and_sections1right),rest671) end
@@ -3298,7 +3298,7 @@
 DECIMALNUMBER1left,DECIMALNUMBERright as DECIMALNUMBER1right))::
 rest671) => let val result=MlyValue.arithmetic_expression((
 Cobol.ARITHMETIC_EXPRESSION_IS_DECIMALNUMBER
-		(DECIMALNUMBER,DECIMALNUMBERleft,DECIMALNUMBERright)
+                (DECIMALNUMBER,DECIMALNUMBERleft,DECIMALNUMBERright)
 ))
  in (hojfelds_NT 476,(result,DECIMALNUMBER1left,DECIMALNUMBER1right),
 rest671) end
@@ -3307,8 +3307,8 @@
  as NONNUMERICLITERAL1right))::rest671) => let val result=
 MlyValue.arithmetic_expression((
 Cobol.ARITHMETIC_EXPRESSION_IS_NONNUMERICLITERAL(NONNUMERICLITERAL,
-							    NONNUMERICLITERALleft,
-							    NONNUMERICLITERALright)
+                                                            NONNUMERICLITERALleft,
+                                                            NONNUMERICLITERALright)
 ))
  in (hojfelds_NT 476,(result,NONNUMERICLITERAL1left,
 NONNUMERICLITERAL1right),rest671) end
@@ -3316,7 +3316,7 @@
  as BOOLEANLITERAL1left,BOOLEANLITERALright as BOOLEANLITERAL1right))
 ::rest671) => let val result=MlyValue.arithmetic_expression((
 Cobol.ARITHMETIC_EXPRESSION_IS_BOOLEANLITERAL
-		(BOOLEANLITERAL,BOOLEANLITERALleft,BOOLEANLITERALright)
+                (BOOLEANLITERAL,BOOLEANLITERALleft,BOOLEANLITERALright)
 ))
  in (hojfelds_NT 476,(result,BOOLEANLITERAL1left,BOOLEANLITERAL1right),
 rest671) end
@@ -3409,8 +3409,8 @@
 arithmetic_expressionright as arithmetic_expression1right))::rest671)
  => let val result=MlyValue.expression((
 CE_AE(arithmetic_expression,
-		 arithmetic_expressionleft,
-		 arithmetic_expressionright)
+                 arithmetic_expressionleft,
+                 arithmetic_expressionright)
 ))
  in (hojfelds_NT 42,(result,arithmetic_expression1left,
 arithmetic_expression1right),rest671) end
@@ -3420,9 +3420,9 @@
 relational_operatorleft as relational_operator1left,_))::rest671) => 
 let val result=MlyValue.expression((
 CE_SINGLE_REL(relational_operator,
-			 arithmetic_expression,
-			 relational_operatorleft,
-			 arithmetic_expressionright)
+                         arithmetic_expression,
+                         relational_operatorleft,
+                         arithmetic_expressionright)
 ))
  in (hojfelds_NT 42,(result,relational_operator1left,
 arithmetic_expression1right),rest671) end
@@ -3433,11 +3433,11 @@
 arithmetic_expression1left,_))::rest671) => let val result=
 MlyValue.expression((
 CE_REL(arithmetic_expression1,
-		  is_not,
-		  relational_operator,
-		  arithmetic_expression2,
-		  arithmetic_expression1left,
-		  arithmetic_expression2right)
+                  is_not,
+                  relational_operator,
+                  arithmetic_expression2,
+                  arithmetic_expression1left,
+                  arithmetic_expression2right)
 ))
  in (hojfelds_NT 42,(result,arithmetic_expression1left,
 arithmetic_expression2right),rest671) end
@@ -3778,8 +3778,8 @@
 ADDleft as ADD1left,_))::rest671) => let val result=
 MlyValue.add_statement((
 Cobol.ADD_OR_SUBTRACT
-		    (Cobol.ADD,identifier_or_literals,identifier_roundeds,
-		     size_error_clauses,
+                    (Cobol.ADD,identifier_or_literals,identifier_roundeds,
+                     size_error_clauses,
                      ADDleft,end_addright)
 ))
  in (hojfelds_NT 10,(result,ADD1left,end_add1right),rest671) end
@@ -3792,8 +3792,8 @@
 MlyValue.add_statement((
 Cobol.ADD_OR_SUBTRACT_GIVING
            (Cobol.ADD,identifier_or_literals,identifier_or_literal,
-	    identifier_roundeds,
-	    size_error_clauses,ADDleft,end_addright)
+            identifier_roundeds,
+            size_error_clauses,ADDleft,end_addright)
 ))
  in (hojfelds_NT 10,(result,ADD1left,end_add1right),rest671) end
 | (686,(_,(_,_,end_addright as end_add1right))::(_,(
@@ -3802,8 +3802,8 @@
 _))::_::(_,(MlyValue.identifier identifier1,_,_))::_::(_,(_,ADDleft
  as ADD1left,_))::rest671) => let val result=MlyValue.add_statement((
 Cobol.ADD_OR_SUBTRACT_CORRESPONDING
-		(Cobol.ADD,identifier1,identifier2,rounded,
-	         size_error_clauses,ADDleft,end_addright)
+                (Cobol.ADD,identifier1,identifier2,rounded,
+                 size_error_clauses,ADDleft,end_addright)
 ))
  in (hojfelds_NT 10,(result,ADD1left,end_add1right),rest671) end
 | (687,(_,(MlyValue.identifier_rounded identifier_rounded,_,
@@ -3811,7 +3811,7 @@
 identifier_roundeds,identifier_roundeds1left,_))::rest671) => let val 
 result=MlyValue.identifier_roundeds((
 Cobol.SEVERAL_IDENTIFIER_ROUNDEDS(identifier_roundeds,
-					     identifier_rounded)
+                                             identifier_rounded)
 ))
  in (hojfelds_NT 236,(result,identifier_roundeds1left,
 identifier_rounded1right),rest671) end
@@ -3915,9 +3915,9 @@
 COMPUTEleft as COMPUTE1left,_))::rest671) => let val result=
 MlyValue.compute_statement((
 Cobol.COMPUTE(identifier_roundeds,
-				   arithmetic_expression,
-				   size_error_clauses,
-				   COMPUTEleft,end_computeright)
+                                   arithmetic_expression,
+                                   size_error_clauses,
+                                   COMPUTEleft,end_computeright)
 ))
  in (hojfelds_NT 72,(result,COMPUTE1left,end_compute1right),rest671)
  end
@@ -3969,9 +3969,9 @@
 DIVIDEleft as DIVIDE1left,_))::rest671) => let val result=
 MlyValue.divide_statement((
 Cobol.DIVIDE_INTO_GIVING
-			    (identifier_or_literal1,identifier_or_literal2,
-			     identifier_roundeds, size_error_clauses,
-			     DIVIDEleft,end_divideright)
+                            (identifier_or_literal1,identifier_or_literal2,
+                             identifier_roundeds, size_error_clauses,
+                             DIVIDEleft,end_divideright)
 ))
  in (hojfelds_NT 127,(result,DIVIDE1left,end_divide1right),rest671) end
 | (724,(_,(_,_,end_divideright as end_divide1right))::(_,(
@@ -3982,9 +3982,9 @@
 DIVIDEleft as DIVIDE1left,_))::rest671) => let val result=
 MlyValue.divide_statement((
 Cobol.DIVIDE_BY_GIVING
-			    (identifier_or_literal1,identifier_or_literal2,
-			     identifier_roundeds,size_error_clauses,
-			     DIVIDEleft,end_divideright)
+                            (identifier_or_literal1,identifier_or_literal2,
+                             identifier_roundeds,size_error_clauses,
+                             DIVIDEleft,end_divideright)
 ))
  in (hojfelds_NT 127,(result,DIVIDE1left,end_divide1right),rest671) end
 | (725,(_,(_,_,end_divideright as end_divide1right))::(_,(
@@ -3996,9 +3996,9 @@
 DIVIDEleft as DIVIDE1left,_))::rest671) => let val result=
 MlyValue.divide_statement((
 Cobol.DIVIDE_INTO_GIVING_REMAINDER
-			    (identifier_or_literal1,identifier_or_literal2,
-			     identifier_roundeds,identifier,size_error_clauses,
-			     DIVIDEleft,end_divideright)
+                            (identifier_or_literal1,identifier_or_literal2,
+                             identifier_roundeds,identifier,size_error_clauses,
+                             DIVIDEleft,end_divideright)
 ))
  in (hojfelds_NT 127,(result,DIVIDE1left,end_divide1right),rest671) end
 | (726,(_,(_,_,end_divideright as end_divide1right))::(_,(
@@ -4010,9 +4010,9 @@
 DIVIDEleft as DIVIDE1left,_))::rest671) => let val result=
 MlyValue.divide_statement((
 Cobol.DIVIDE_BY_GIVING_REMAINDER
-			    (identifier_or_literal1,identifier_or_literal2,
-			     identifier_roundeds,identifier,size_error_clauses,
-			     DIVIDEleft,end_divideright)
+                            (identifier_or_literal1,identifier_or_literal2,
+                             identifier_roundeds,identifier,size_error_clauses,
+                             DIVIDEleft,end_divideright)
 ))
  in (hojfelds_NT 127,(result,DIVIDE1left,end_divide1right),rest671) end
 | (727,(_,(_,_,routine_name_opt1right))::_::(_,(_,ENTER1left,_))::
@@ -4268,7 +4268,7 @@
 MULTIPLYleft as MULTIPLY1left,_))::rest671) => let val result=
 MlyValue.multiply_statement((
 Cobol.MULTIPLY(identifier_or_literal,identifier_roundeds
-			  ,size_error_clauses,MULTIPLYleft,end_multiplyright)
+                          ,size_error_clauses,MULTIPLYleft,end_multiplyright)
 ))
  in (hojfelds_NT 317,(result,MULTIPLY1left,end_multiply1right),rest671)
  end
@@ -4280,8 +4280,8 @@
 MULTIPLYleft as MULTIPLY1left,_))::rest671) => let val result=
 MlyValue.multiply_statement((
 Cobol.MULTIPLY_GIVING(identifier_or_literal1,identifier_or_literal2
-				 ,identifier_roundeds,size_error_clauses
-				 ,MULTIPLYleft,end_multiplyright)
+                                 ,identifier_roundeds,size_error_clauses
+                                 ,MULTIPLYleft,end_multiplyright)
 ))
  in (hojfelds_NT 317,(result,MULTIPLY1left,end_multiply1right),rest671)
  end
@@ -4592,8 +4592,8 @@
 SUBTRACTleft as SUBTRACT1left,_))::rest671) => let val result=
 MlyValue.subtract_statement((
 Cobol.ADD_OR_SUBTRACT
-		    (Cobol.SUBTRACT,identifier_or_literals,identifier_roundeds,
-		     size_error_clauses,
+                    (Cobol.SUBTRACT,identifier_or_literals,identifier_roundeds,
+                     size_error_clauses,
                      SUBTRACTleft,end_subtractright)
 ))
  in (hojfelds_NT 473,(result,SUBTRACT1left,end_subtract1right),rest671)
@@ -4607,8 +4607,8 @@
 MlyValue.subtract_statement((
 Cobol.ADD_OR_SUBTRACT_GIVING
            (Cobol.SUBTRACT,identifier_or_literals,identifier_or_literal,
-	    identifier_roundeds,
-	    size_error_clauses,SUBTRACTleft,end_subtractright)
+            identifier_roundeds,
+            size_error_clauses,SUBTRACTleft,end_subtractright)
 ))
  in (hojfelds_NT 473,(result,SUBTRACT1left,end_subtract1right),rest671)
  end
@@ -4619,8 +4619,8 @@
 SUBTRACTleft as SUBTRACT1left,_))::rest671) => let val result=
 MlyValue.subtract_statement((
 Cobol.ADD_OR_SUBTRACT_CORRESPONDING
-		(Cobol.SUBTRACT,identifier1,identifier2,rounded,
-	         size_error_clauses,SUBTRACTleft,end_subtractright)
+                (Cobol.SUBTRACT,identifier1,identifier2,rounded,
+                 size_error_clauses,SUBTRACTleft,end_subtractright)
 ))
  in (hojfelds_NT 473,(result,SUBTRACT1left,end_subtract1right),rest671)
  end
@@ -4868,4 +4868,4 @@
 val void = MlyValue.VOID
 val extract = fn a => (fn MlyValue.test_cobol x => x
 | _ => let exception ParseInternal
-	in raise ParseInternal end) a 
+        in raise ParseInternal end) a 

Modified: mlton/branches/on-20050420-cmm-branch/regression/constraint.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/constraint.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/constraint.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,7 +1,7 @@
 signature S = sig type ('a, 'b) t 
-		  val A : 'a * int -> ('a, int) t
-		  val pr : ('a -> string) -> ('b -> string) -> ('a, 'b) t -> string
-	      end
+                  val A : 'a * int -> ('a, int) t
+                  val pr : ('a -> string) -> ('b -> string) -> ('a, 'b) t -> string
+              end
 
 structure S = 
   struct

Modified: mlton/branches/on-20050420-cmm-branch/regression/conv.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/conv.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/conv.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -2,33 +2,33 @@
 
 fun try (barg: IntInf.int): unit =
        let val small = SOME (IntInf.toInt barg)
-		  handle Overflow => NONE
-	   val bstr = IntInf.toString barg
-	   fun fail msg = print ("Fail " ^ msg ^ ": " ^ bstr ^ "\n")
-	   val isSmall = ~ big <= barg andalso barg < big
+                  handle Overflow => NONE
+           val bstr = IntInf.toString barg
+           fun fail msg = print ("Fail " ^ msg ^ ": " ^ bstr ^ "\n")
+           val isSmall = ~ big <= barg andalso barg < big
        in case small of
-	     NONE => if isSmall
-			then fail "1"
-			else ()
-	     | SOME sarg => if isSmall
-			       then let val sstr = Int.toString sarg
-				    in if bstr = sstr
-				       andalso barg = IntInf.fromInt sarg
-					  then ()
-					  else fail "2"
-				    end
-			       else fail "3"
+             NONE => if isSmall
+                        then fail "1"
+                        else ()
+             | SOME sarg => if isSmall
+                               then let val sstr = Int.toString sarg
+                                    in if bstr = sstr
+                                       andalso barg = IntInf.fromInt sarg
+                                          then ()
+                                          else fail "2"
+                                    end
+                               else fail "3"
        end
 
 fun spin (low: IntInf.int, limit: IntInf.int): unit =
        let fun loop (arg: IntInf.int): unit =
-		  if arg = limit
-		     then ()
-		     else (
-			try arg;
-			try (~ arg);
-			loop (arg + 1)
-		     )
+                  if arg = limit
+                     then ()
+                     else (
+                        try arg;
+                        try (~ arg);
+                        loop (arg + 1)
+                     )
        in loop low
        end
 

Modified: mlton/branches/on-20050420-cmm-branch/regression/conv2.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/conv2.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/conv2.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,447 +1,447 @@
 val arg: { v: IntInf.int, b: string, oc: string, d: string, x: string} list = [
-	{v = 0, b = "0", oc = "0", d = "0", x = "0"},
-	{v = ~0, b = "~0", oc = "~0", d = "~0", x = "~0"},
-	{v = 1, b = "1", oc = "1", d = "1", x = "1"},
-	{v = ~1, b = "~1", oc = "~1", d = "~1", x = "~1"},
-	{v = 2, b = "10", oc = "2", d = "2", x = "2"},
-	{v = ~2, b = "~10", oc = "~2", d = "~2", x = "~2"},
-	{v = 3, b = "11", oc = "3", d = "3", x = "3"},
-	{v = ~3, b = "~11", oc = "~3", d = "~3", x = "~3"},
-	{v = 4, b = "100", oc = "4", d = "4", x = "4"},
-	{v = ~4, b = "~100", oc = "~4", d = "~4", x = "~4"},
-	{v = 5, b = "101", oc = "5", d = "5", x = "5"},
-	{v = ~5, b = "~101", oc = "~5", d = "~5", x = "~5"},
-	{v = 6, b = "110", oc = "6", d = "6", x = "6"},
-	{v = ~6, b = "~110", oc = "~6", d = "~6", x = "~6"},
-	{v = 7, b = "111", oc = "7", d = "7", x = "7"},
-	{v = ~7, b = "~111", oc = "~7", d = "~7", x = "~7"},
-	{v = 8, b = "1000", oc = "10", d = "8", x = "8"},
-	{v = ~8, b = "~1000", oc = "~10", d = "~8", x = "~8"},
-	{v = 9, b = "1001", oc = "11", d = "9", x = "9"},
-	{v = ~9, b = "~1001", oc = "~11", d = "~9", x = "~9"},
-	{v = 10, b = "1010", oc = "12", d = "10", x = "A"},
-	{v = ~10, b = "~1010", oc = "~12", d = "~10", x = "~A"},
-	{v = 11, b = "1011", oc = "13", d = "11", x = "B"},
-	{v = ~11, b = "~1011", oc = "~13", d = "~11", x = "~B"},
-	{v = 12, b = "1100", oc = "14", d = "12", x = "C"},
-	{v = ~12, b = "~1100", oc = "~14", d = "~12", x = "~C"},
-	{v = 13, b = "1101", oc = "15", d = "13", x = "D"},
-	{v = ~13, b = "~1101", oc = "~15", d = "~13", x = "~D"},
-	{v = 14, b = "1110", oc = "16", d = "14", x = "E"},
-	{v = ~14, b = "~1110", oc = "~16", d = "~14", x = "~E"},
-	{v = 15, b = "1111", oc = "17", d = "15", x = "F"},
-	{v = ~15, b = "~1111", oc = "~17", d = "~15", x = "~F"},
-	{v = 16, b = "10000", oc = "20", d = "16", x = "10"},
-	{v = ~16, b = "~10000", oc = "~20", d = "~16", x = "~10"},
-	{v = 17, b = "10001", oc = "21", d = "17", x = "11"},
-	{v = ~17, b = "~10001", oc = "~21", d = "~17", x = "~11"},
-	{v = 18, b = "10010", oc = "22", d = "18", x = "12"},
-	{v = ~18, b = "~10010", oc = "~22", d = "~18", x = "~12"},
-	{v = 19, b = "10011", oc = "23", d = "19", x = "13"},
-	{v = ~19, b = "~10011", oc = "~23", d = "~19", x = "~13"},
-	{v = 20, b = "10100", oc = "24", d = "20", x = "14"},
-	{v = ~20, b = "~10100", oc = "~24", d = "~20", x = "~14"},
-	{v = 21, b = "10101", oc = "25", d = "21", x = "15"},
-	{v = ~21, b = "~10101", oc = "~25", d = "~21", x = "~15"},
-	{v = 22, b = "10110", oc = "26", d = "22", x = "16"},
-	{v = ~22, b = "~10110", oc = "~26", d = "~22", x = "~16"},
-	{v = 23, b = "10111", oc = "27", d = "23", x = "17"},
-	{v = ~23, b = "~10111", oc = "~27", d = "~23", x = "~17"},
-	{v = 24, b = "11000", oc = "30", d = "24", x = "18"},
-	{v = ~24, b = "~11000", oc = "~30", d = "~24", x = "~18"},
-	{v = 25, b = "11001", oc = "31", d = "25", x = "19"},
-	{v = ~25, b = "~11001", oc = "~31", d = "~25", x = "~19"},
-	{v = 26, b = "11010", oc = "32", d = "26", x = "1A"},
-	{v = ~26, b = "~11010", oc = "~32", d = "~26", x = "~1A"},
-	{v = 27, b = "11011", oc = "33", d = "27", x = "1B"},
-	{v = ~27, b = "~11011", oc = "~33", d = "~27", x = "~1B"},
-	{v = 28, b = "11100", oc = "34", d = "28", x = "1C"},
-	{v = ~28, b = "~11100", oc = "~34", d = "~28", x = "~1C"},
-	{v = 29, b = "11101", oc = "35", d = "29", x = "1D"},
-	{v = ~29, b = "~11101", oc = "~35", d = "~29", x = "~1D"},
-	{v = 30, b = "11110", oc = "36", d = "30", x = "1E"},
-	{v = ~30, b = "~11110", oc = "~36", d = "~30", x = "~1E"},
-	{v = 31, b = "11111", oc = "37", d = "31", x = "1F"},
-	{v = ~31, b = "~11111", oc = "~37", d = "~31", x = "~1F"},
-	{v = 32, b = "100000", oc = "40", d = "32", x = "20"},
-	{v = ~32, b = "~100000", oc = "~40", d = "~32", x = "~20"},
-	{v = 33, b = "100001", oc = "41", d = "33", x = "21"},
-	{v = ~33, b = "~100001", oc = "~41", d = "~33", x = "~21"},
-	{v = 34, b = "100010", oc = "42", d = "34", x = "22"},
-	{v = ~34, b = "~100010", oc = "~42", d = "~34", x = "~22"},
-	{v = 35, b = "100011", oc = "43", d = "35", x = "23"},
-	{v = ~35, b = "~100011", oc = "~43", d = "~35", x = "~23"},
-	{v = 36, b = "100100", oc = "44", d = "36", x = "24"},
-	{v = ~36, b = "~100100", oc = "~44", d = "~36", x = "~24"},
-	{v = 37, b = "100101", oc = "45", d = "37", x = "25"},
-	{v = ~37, b = "~100101", oc = "~45", d = "~37", x = "~25"},
-	{v = 38, b = "100110", oc = "46", d = "38", x = "26"},
-	{v = ~38, b = "~100110", oc = "~46", d = "~38", x = "~26"},
-	{v = 39, b = "100111", oc = "47", d = "39", x = "27"},
-	{v = ~39, b = "~100111", oc = "~47", d = "~39", x = "~27"},
-	{v = 40, b = "101000", oc = "50", d = "40", x = "28"},
-	{v = ~40, b = "~101000", oc = "~50", d = "~40", x = "~28"},
-	{v = 41, b = "101001", oc = "51", d = "41", x = "29"},
-	{v = ~41, b = "~101001", oc = "~51", d = "~41", x = "~29"},
-	{v = 42, b = "101010", oc = "52", d = "42", x = "2A"},
-	{v = ~42, b = "~101010", oc = "~52", d = "~42", x = "~2A"},
-	{v = 43, b = "101011", oc = "53", d = "43", x = "2B"},
-	{v = ~43, b = "~101011", oc = "~53", d = "~43", x = "~2B"},
-	{v = 44, b = "101100", oc = "54", d = "44", x = "2C"},
-	{v = ~44, b = "~101100", oc = "~54", d = "~44", x = "~2C"},
-	{v = 45, b = "101101", oc = "55", d = "45", x = "2D"},
-	{v = ~45, b = "~101101", oc = "~55", d = "~45", x = "~2D"},
-	{v = 46, b = "101110", oc = "56", d = "46", x = "2E"},
-	{v = ~46, b = "~101110", oc = "~56", d = "~46", x = "~2E"},
-	{v = 47, b = "101111", oc = "57", d = "47", x = "2F"},
-	{v = ~47, b = "~101111", oc = "~57", d = "~47", x = "~2F"},
-	{v = 48, b = "110000", oc = "60", d = "48", x = "30"},
-	{v = ~48, b = "~110000", oc = "~60", d = "~48", x = "~30"},
-	{v = 49, b = "110001", oc = "61", d = "49", x = "31"},
-	{v = ~49, b = "~110001", oc = "~61", d = "~49", x = "~31"},
-	{v = 50, b = "110010", oc = "62", d = "50", x = "32"},
-	{v = ~50, b = "~110010", oc = "~62", d = "~50", x = "~32"},
-	{v = 51, b = "110011", oc = "63", d = "51", x = "33"},
-	{v = ~51, b = "~110011", oc = "~63", d = "~51", x = "~33"},
-	{v = 52, b = "110100", oc = "64", d = "52", x = "34"},
-	{v = ~52, b = "~110100", oc = "~64", d = "~52", x = "~34"},
-	{v = 53, b = "110101", oc = "65", d = "53", x = "35"},
-	{v = ~53, b = "~110101", oc = "~65", d = "~53", x = "~35"},
-	{v = 54, b = "110110", oc = "66", d = "54", x = "36"},
-	{v = ~54, b = "~110110", oc = "~66", d = "~54", x = "~36"},
-	{v = 55, b = "110111", oc = "67", d = "55", x = "37"},
-	{v = ~55, b = "~110111", oc = "~67", d = "~55", x = "~37"},
-	{v = 56, b = "111000", oc = "70", d = "56", x = "38"},
-	{v = ~56, b = "~111000", oc = "~70", d = "~56", x = "~38"},
-	{v = 57, b = "111001", oc = "71", d = "57", x = "39"},
-	{v = ~57, b = "~111001", oc = "~71", d = "~57", x = "~39"},
-	{v = 58, b = "111010", oc = "72", d = "58", x = "3A"},
-	{v = ~58, b = "~111010", oc = "~72", d = "~58", x = "~3A"},
-	{v = 59, b = "111011", oc = "73", d = "59", x = "3B"},
-	{v = ~59, b = "~111011", oc = "~73", d = "~59", x = "~3B"},
-	{v = 60, b = "111100", oc = "74", d = "60", x = "3C"},
-	{v = ~60, b = "~111100", oc = "~74", d = "~60", x = "~3C"},
-	{v = 61, b = "111101", oc = "75", d = "61", x = "3D"},
-	{v = ~61, b = "~111101", oc = "~75", d = "~61", x = "~3D"},
-	{v = 62, b = "111110", oc = "76", d = "62", x = "3E"},
-	{v = ~62, b = "~111110", oc = "~76", d = "~62", x = "~3E"},
-	{v = 63, b = "111111", oc = "77", d = "63", x = "3F"},
-	{v = ~63, b = "~111111", oc = "~77", d = "~63", x = "~3F"},
-	{v = 64, b = "1000000", oc = "100", d = "64", x = "40"},
-	{v = ~64, b = "~1000000", oc = "~100", d = "~64", x = "~40"},
-	{v = 65, b = "1000001", oc = "101", d = "65", x = "41"},
-	{v = ~65, b = "~1000001", oc = "~101", d = "~65", x = "~41"},
-	{v = 66, b = "1000010", oc = "102", d = "66", x = "42"},
-	{v = ~66, b = "~1000010", oc = "~102", d = "~66", x = "~42"},
-	{v = 67, b = "1000011", oc = "103", d = "67", x = "43"},
-	{v = ~67, b = "~1000011", oc = "~103", d = "~67", x = "~43"},
-	{v = 68, b = "1000100", oc = "104", d = "68", x = "44"},
-	{v = ~68, b = "~1000100", oc = "~104", d = "~68", x = "~44"},
-	{v = 69, b = "1000101", oc = "105", d = "69", x = "45"},
-	{v = ~69, b = "~1000101", oc = "~105", d = "~69", x = "~45"},
-	{v = 70, b = "1000110", oc = "106", d = "70", x = "46"},
-	{v = ~70, b = "~1000110", oc = "~106", d = "~70", x = "~46"},
-	{v = 71, b = "1000111", oc = "107", d = "71", x = "47"},
-	{v = ~71, b = "~1000111", oc = "~107", d = "~71", x = "~47"},
-	{v = 72, b = "1001000", oc = "110", d = "72", x = "48"},
-	{v = ~72, b = "~1001000", oc = "~110", d = "~72", x = "~48"},
-	{v = 73, b = "1001001", oc = "111", d = "73", x = "49"},
-	{v = ~73, b = "~1001001", oc = "~111", d = "~73", x = "~49"},
-	{v = 74, b = "1001010", oc = "112", d = "74", x = "4A"},
-	{v = ~74, b = "~1001010", oc = "~112", d = "~74", x = "~4A"},
-	{v = 75, b = "1001011", oc = "113", d = "75", x = "4B"},
-	{v = ~75, b = "~1001011", oc = "~113", d = "~75", x = "~4B"},
-	{v = 76, b = "1001100", oc = "114", d = "76", x = "4C"},
-	{v = ~76, b = "~1001100", oc = "~114", d = "~76", x = "~4C"},
-	{v = 77, b = "1001101", oc = "115", d = "77", x = "4D"},
-	{v = ~77, b = "~1001101", oc = "~115", d = "~77", x = "~4D"},
-	{v = 78, b = "1001110", oc = "116", d = "78", x = "4E"},
-	{v = ~78, b = "~1001110", oc = "~116", d = "~78", x = "~4E"},
-	{v = 79, b = "1001111", oc = "117", d = "79", x = "4F"},
-	{v = ~79, b = "~1001111", oc = "~117", d = "~79", x = "~4F"},
-	{v = 80, b = "1010000", oc = "120", d = "80", x = "50"},
-	{v = ~80, b = "~1010000", oc = "~120", d = "~80", x = "~50"},
-	{v = 81, b = "1010001", oc = "121", d = "81", x = "51"},
-	{v = ~81, b = "~1010001", oc = "~121", d = "~81", x = "~51"},
-	{v = 82, b = "1010010", oc = "122", d = "82", x = "52"},
-	{v = ~82, b = "~1010010", oc = "~122", d = "~82", x = "~52"},
-	{v = 83, b = "1010011", oc = "123", d = "83", x = "53"},
-	{v = ~83, b = "~1010011", oc = "~123", d = "~83", x = "~53"},
-	{v = 84, b = "1010100", oc = "124", d = "84", x = "54"},
-	{v = ~84, b = "~1010100", oc = "~124", d = "~84", x = "~54"},
-	{v = 85, b = "1010101", oc = "125", d = "85", x = "55"},
-	{v = ~85, b = "~1010101", oc = "~125", d = "~85", x = "~55"},
-	{v = 86, b = "1010110", oc = "126", d = "86", x = "56"},
-	{v = ~86, b = "~1010110", oc = "~126", d = "~86", x = "~56"},
-	{v = 87, b = "1010111", oc = "127", d = "87", x = "57"},
-	{v = ~87, b = "~1010111", oc = "~127", d = "~87", x = "~57"},
-	{v = 88, b = "1011000", oc = "130", d = "88", x = "58"},
-	{v = ~88, b = "~1011000", oc = "~130", d = "~88", x = "~58"},
-	{v = 89, b = "1011001", oc = "131", d = "89", x = "59"},
-	{v = ~89, b = "~1011001", oc = "~131", d = "~89", x = "~59"},
-	{v = 90, b = "1011010", oc = "132", d = "90", x = "5A"},
-	{v = ~90, b = "~1011010", oc = "~132", d = "~90", x = "~5A"},
-	{v = 91, b = "1011011", oc = "133", d = "91", x = "5B"},
-	{v = ~91, b = "~1011011", oc = "~133", d = "~91", x = "~5B"},
-	{v = 92, b = "1011100", oc = "134", d = "92", x = "5C"},
-	{v = ~92, b = "~1011100", oc = "~134", d = "~92", x = "~5C"},
-	{v = 93, b = "1011101", oc = "135", d = "93", x = "5D"},
-	{v = ~93, b = "~1011101", oc = "~135", d = "~93", x = "~5D"},
-	{v = 94, b = "1011110", oc = "136", d = "94", x = "5E"},
-	{v = ~94, b = "~1011110", oc = "~136", d = "~94", x = "~5E"},
-	{v = 95, b = "1011111", oc = "137", d = "95", x = "5F"},
-	{v = ~95, b = "~1011111", oc = "~137", d = "~95", x = "~5F"},
-	{v = 96, b = "1100000", oc = "140", d = "96", x = "60"},
-	{v = ~96, b = "~1100000", oc = "~140", d = "~96", x = "~60"},
-	{v = 97, b = "1100001", oc = "141", d = "97", x = "61"},
-	{v = ~97, b = "~1100001", oc = "~141", d = "~97", x = "~61"},
-	{v = 98, b = "1100010", oc = "142", d = "98", x = "62"},
-	{v = ~98, b = "~1100010", oc = "~142", d = "~98", x = "~62"},
-	{v = 99, b = "1100011", oc = "143", d = "99", x = "63"},
-	{v = ~99, b = "~1100011", oc = "~143", d = "~99", x = "~63"},
-	{v = 128, b = "10000000", oc = "200", d = "128", x = "80"},
-	{v = ~128, b = "~10000000", oc = "~200", d = "~128", x = "~80"},
-	{v = 256, b = "100000000", oc = "400", d = "256", x = "100"},
-	{v = ~256, b = "~100000000", oc = "~400", d = "~256", x = "~100"},
-	{v = 512, b = "1000000000", oc = "1000", d = "512", x = "200"},
-	{v = ~512, b = "~1000000000", oc = "~1000", d = "~512", x = "~200"},
-	{v = 1024, b = "10000000000", oc = "2000", d = "1024", x = "400"},
-	{v = ~1024, b = "~10000000000", oc = "~2000", d = "~1024", x = "~400"},
-	{v = 2048, b = "100000000000", oc = "4000", d = "2048", x = "800"},
-	{v = ~2048, b = "~100000000000", oc = "~4000", d = "~2048", x = "~800"},
-	{v = 4096, b = "1000000000000", oc = "10000", d = "4096", x = "1000"},
-	{v = ~4096, b = "~1000000000000", oc = "~10000", d = "~4096", x = "~1000"},
-	{v = 8192, b = "10000000000000", oc = "20000", d = "8192", x = "2000"},
-	{v = ~8192, b = "~10000000000000", oc = "~20000", d = "~8192", x = "~2000"},
-	{v = 16384, b = "100000000000000", oc = "40000", d = "16384", x = "4000"},
-	{v = ~16384, b = "~100000000000000", oc = "~40000", d = "~16384", x = "~4000"},
-	{v = 32768, b = "1000000000000000", oc = "100000", d = "32768", x = "8000"},
-	{v = ~32768, b = "~1000000000000000", oc = "~100000", d = "~32768", x = "~8000"},
-	{v = 65536, b = "10000000000000000", oc = "200000", d = "65536", x = "10000"},
-	{v = ~65536, b = "~10000000000000000", oc = "~200000", d = "~65536", x = "~10000"},
-	{v = 131072, b = "100000000000000000", oc = "400000", d = "131072", x = "20000"},
-	{v = ~131072, b = "~100000000000000000", oc = "~400000", d = "~131072", x = "~20000"},
-	{v = 262144, b = "1000000000000000000", oc = "1000000", d = "262144", x = "40000"},
-	{v = ~262144, b = "~1000000000000000000", oc = "~1000000", d = "~262144", x = "~40000"},
-	{v = 524288, b = "10000000000000000000", oc = "2000000", d = "524288", x = "80000"},
-	{v = ~524288, b = "~10000000000000000000", oc = "~2000000", d = "~524288", x = "~80000"},
-	{v = 1048576, b = "100000000000000000000", oc = "4000000", d = "1048576", x = "100000"},
-	{v = ~1048576, b = "~100000000000000000000", oc = "~4000000", d = "~1048576", x = "~100000"},
-	{v = 2097152, b = "1000000000000000000000", oc = "10000000", d = "2097152", x = "200000"},
-	{v = ~2097152, b = "~1000000000000000000000", oc = "~10000000", d = "~2097152", x = "~200000"},
-	{v = 4194304, b = "10000000000000000000000", oc = "20000000", d = "4194304", x = "400000"},
-	{v = ~4194304, b = "~10000000000000000000000", oc = "~20000000", d = "~4194304", x = "~400000"},
-	{v = 8388608, b = "100000000000000000000000", oc = "40000000", d = "8388608", x = "800000"},
-	{v = ~8388608, b = "~100000000000000000000000", oc = "~40000000", d = "~8388608", x = "~800000"},
-	{v = 16777216, b = "1000000000000000000000000", oc = "100000000", d = "16777216", x = "1000000"},
-	{v = ~16777216, b = "~1000000000000000000000000", oc = "~100000000", d = "~16777216", x = "~1000000"},
-	{v = 33554432, b = "10000000000000000000000000", oc = "200000000", d = "33554432", x = "2000000"},
-	{v = ~33554432, b = "~10000000000000000000000000", oc = "~200000000", d = "~33554432", x = "~2000000"},
-	{v = 67108864, b = "100000000000000000000000000", oc = "400000000", d = "67108864", x = "4000000"},
-	{v = ~67108864, b = "~100000000000000000000000000", oc = "~400000000", d = "~67108864", x = "~4000000"},
-	{v = 100000000, b = "101111101011110000100000000", oc = "575360400", d = "100000000", x = "5F5E100"},
-	{v = ~100000000, b = "~101111101011110000100000000", oc = "~575360400", d = "~100000000", x = "~5F5E100"},
-	{v = 134217728, b = "1000000000000000000000000000", oc = "1000000000", d = "134217728", x = "8000000"},
-	{v = ~134217728, b = "~1000000000000000000000000000", oc = "~1000000000", d = "~134217728", x = "~8000000"},
-	{v = 268435456, b = "10000000000000000000000000000", oc = "2000000000", d = "268435456", x = "10000000"},
-	{v = ~268435456, b = "~10000000000000000000000000000", oc = "~2000000000", d = "~268435456", x = "~10000000"},
-	{v = 536870912, b = "100000000000000000000000000000", oc = "4000000000", d = "536870912", x = "20000000"},
-	{v = ~536870912, b = "~100000000000000000000000000000", oc = "~4000000000", d = "~536870912", x = "~20000000"},
-	{v = 1073741822, b = "111111111111111111111111111110", oc = "7777777776", d = "1073741822", x = "3FFFFFFE"},
-	{v = ~1073741822, b = "~111111111111111111111111111110", oc = "~7777777776", d = "~1073741822", x = "~3FFFFFFE"},
-	{v = 1073741823, b = "111111111111111111111111111111", oc = "7777777777", d = "1073741823", x = "3FFFFFFF"},
-	{v = ~1073741823, b = "~111111111111111111111111111111", oc = "~7777777777", d = "~1073741823", x = "~3FFFFFFF"},
-	{v = 1073741824, b = "1000000000000000000000000000000", oc = "10000000000", d = "1073741824", x = "40000000"},
-	{v = ~1073741824, b = "~1000000000000000000000000000000", oc = "~10000000000", d = "~1073741824", x = "~40000000"},
-	{v = 1073741825, b = "1000000000000000000000000000001", oc = "10000000001", d = "1073741825", x = "40000001"},
-	{v = ~1073741825, b = "~1000000000000000000000000000001", oc = "~10000000001", d = "~1073741825", x = "~40000001"},
-	{v = 1073741826, b = "1000000000000000000000000000010", oc = "10000000002", d = "1073741826", x = "40000002"},
-	{v = ~1073741826, b = "~1000000000000000000000000000010", oc = "~10000000002", d = "~1073741826", x = "~40000002"},
-	{v = 2147483648, b = "10000000000000000000000000000000", oc = "20000000000", d = "2147483648", x = "80000000"},
-	{v = ~2147483648, b = "~10000000000000000000000000000000", oc = "~20000000000", d = "~2147483648", x = "~80000000"},
-	{v = 4294967296, b = "100000000000000000000000000000000", oc = "40000000000", d = "4294967296", x = "100000000"},
-	{v = ~4294967296, b = "~100000000000000000000000000000000", oc = "~40000000000", d = "~4294967296", x = "~100000000"},
-	{v = 4304967296, b = "100000000100110001001011010000000", oc = "40046113200", d = "4304967296", x = "100989680"},
-	{v = ~4304967296, b = "~100000000100110001001011010000000", oc = "~40046113200", d = "~4304967296", x = "~100989680"},
-	{v = 8589934592, b = "1000000000000000000000000000000000", oc = "100000000000", d = "8589934592", x = "200000000"},
-	{v = ~8589934592, b = "~1000000000000000000000000000000000", oc = "~100000000000", d = "~8589934592", x = "~200000000"},
-	{v = 17179869184, b = "10000000000000000000000000000000000", oc = "200000000000", d = "17179869184", x = "400000000"},
-	{v = ~17179869184, b = "~10000000000000000000000000000000000", oc = "~200000000000", d = "~17179869184", x = "~400000000"},
-	{v = 34359738368, b = "100000000000000000000000000000000000", oc = "400000000000", d = "34359738368", x = "800000000"},
-	{v = ~34359738368, b = "~100000000000000000000000000000000000", oc = "~400000000000", d = "~34359738368", x = "~800000000"},
-	{v = 68719476736, b = "1000000000000000000000000000000000000", oc = "1000000000000", d = "68719476736", x = "1000000000"},
-	{v = ~68719476736, b = "~1000000000000000000000000000000000000", oc = "~1000000000000", d = "~68719476736", x = "~1000000000"},
-	{v = 137438953472, b = "10000000000000000000000000000000000000", oc = "2000000000000", d = "137438953472", x = "2000000000"},
-	{v = ~137438953472, b = "~10000000000000000000000000000000000000", oc = "~2000000000000", d = "~137438953472", x = "~2000000000"},
-	{v = 274877906944, b = "100000000000000000000000000000000000000", oc = "4000000000000", d = "274877906944", x = "4000000000"},
-	{v = ~274877906944, b = "~100000000000000000000000000000000000000", oc = "~4000000000000", d = "~274877906944", x = "~4000000000"},
-	{v = 549755813888, b = "1000000000000000000000000000000000000000", oc = "10000000000000", d = "549755813888", x = "8000000000"},
-	{v = ~549755813888, b = "~1000000000000000000000000000000000000000", oc = "~10000000000000", d = "~549755813888", x = "~8000000000"},
-	{v = 1099511627776, b = "10000000000000000000000000000000000000000", oc = "20000000000000", d = "1099511627776", x = "10000000000"},
-	{v = ~1099511627776, b = "~10000000000000000000000000000000000000000", oc = "~20000000000000", d = "~1099511627776", x = "~10000000000"},
-	{v = 2199023255552, b = "100000000000000000000000000000000000000000", oc = "40000000000000", d = "2199023255552", x = "20000000000"},
-	{v = ~2199023255552, b = "~100000000000000000000000000000000000000000", oc = "~40000000000000", d = "~2199023255552", x = "~20000000000"},
-	{v = 4398046511104, b = "1000000000000000000000000000000000000000000", oc = "100000000000000", d = "4398046511104", x = "40000000000"},
-	{v = ~4398046511104, b = "~1000000000000000000000000000000000000000000", oc = "~100000000000000", d = "~4398046511104", x = "~40000000000"},
-	{v = 8796093022208, b = "10000000000000000000000000000000000000000000", oc = "200000000000000", d = "8796093022208", x = "80000000000"},
-	{v = ~8796093022208, b = "~10000000000000000000000000000000000000000000", oc = "~200000000000000", d = "~8796093022208", x = "~80000000000"},
-	{v = 17592186044416, b = "100000000000000000000000000000000000000000000", oc = "400000000000000", d = "17592186044416", x = "100000000000"},
-	{v = ~17592186044416, b = "~100000000000000000000000000000000000000000000", oc = "~400000000000000", d = "~17592186044416", x = "~100000000000"},
-	{v = 35184372088832, b = "1000000000000000000000000000000000000000000000", oc = "1000000000000000", d = "35184372088832", x = "200000000000"},
-	{v = ~35184372088832, b = "~1000000000000000000000000000000000000000000000", oc = "~1000000000000000", d = "~35184372088832", x = "~200000000000"},
-	{v = 70368744177664, b = "10000000000000000000000000000000000000000000000", oc = "2000000000000000", d = "70368744177664", x = "400000000000"},
-	{v = ~70368744177664, b = "~10000000000000000000000000000000000000000000000", oc = "~2000000000000000", d = "~70368744177664", x = "~400000000000"},
-	{v = 140737488355328, b = "100000000000000000000000000000000000000000000000", oc = "4000000000000000", d = "140737488355328", x = "800000000000"},
-	{v = ~140737488355328, b = "~100000000000000000000000000000000000000000000000", oc = "~4000000000000000", d = "~140737488355328", x = "~800000000000"},
-	{v = 281474976710656, b = "1000000000000000000000000000000000000000000000000", oc = "10000000000000000", d = "281474976710656", x = "1000000000000"},
-	{v = ~281474976710656, b = "~1000000000000000000000000000000000000000000000000", oc = "~10000000000000000", d = "~281474976710656", x = "~1000000000000"},
-	{v = 562949953421312, b = "10000000000000000000000000000000000000000000000000", oc = "20000000000000000", d = "562949953421312", x = "2000000000000"},
-	{v = ~562949953421312, b = "~10000000000000000000000000000000000000000000000000", oc = "~20000000000000000", d = "~562949953421312", x = "~2000000000000"},
-	{v = 1125899906842624, b = "100000000000000000000000000000000000000000000000000", oc = "40000000000000000", d = "1125899906842624", x = "4000000000000"},
-	{v = ~1125899906842624, b = "~100000000000000000000000000000000000000000000000000", oc = "~40000000000000000", d = "~1125899906842624", x = "~4000000000000"},
-	{v = 2251799813685248, b = "1000000000000000000000000000000000000000000000000000", oc = "100000000000000000", d = "2251799813685248", x = "8000000000000"},
-	{v = ~2251799813685248, b = "~1000000000000000000000000000000000000000000000000000", oc = "~100000000000000000", d = "~2251799813685248", x = "~8000000000000"},
-	{v = 4503599627370496, b = "10000000000000000000000000000000000000000000000000000", oc = "200000000000000000", d = "4503599627370496", x = "10000000000000"},
-	{v = ~4503599627370496, b = "~10000000000000000000000000000000000000000000000000000", oc = "~200000000000000000", d = "~4503599627370496", x = "~10000000000000"},
-	{v = 9007199254740992, b = "100000000000000000000000000000000000000000000000000000", oc = "400000000000000000", d = "9007199254740992", x = "20000000000000"},
-	{v = ~9007199254740992, b = "~100000000000000000000000000000000000000000000000000000", oc = "~400000000000000000", d = "~9007199254740992", x = "~20000000000000"},
-	{v = 18014398509481984, b = "1000000000000000000000000000000000000000000000000000000", oc = "1000000000000000000", d = "18014398509481984", x = "40000000000000"},
-	{v = ~18014398509481984, b = "~1000000000000000000000000000000000000000000000000000000", oc = "~1000000000000000000", d = "~18014398509481984", x = "~40000000000000"},
-	{v = 36028797018963968, b = "10000000000000000000000000000000000000000000000000000000", oc = "2000000000000000000", d = "36028797018963968", x = "80000000000000"},
-	{v = ~36028797018963968, b = "~10000000000000000000000000000000000000000000000000000000", oc = "~2000000000000000000", d = "~36028797018963968", x = "~80000000000000"},
-	{v = 72057594037927936, b = "100000000000000000000000000000000000000000000000000000000", oc = "4000000000000000000", d = "72057594037927936", x = "100000000000000"},
-	{v = ~72057594037927936, b = "~100000000000000000000000000000000000000000000000000000000", oc = "~4000000000000000000", d = "~72057594037927936", x = "~100000000000000"},
-	{v = 144115188075855872, b = "1000000000000000000000000000000000000000000000000000000000", oc = "10000000000000000000", d = "144115188075855872", x = "200000000000000"},
-	{v = ~144115188075855872, b = "~1000000000000000000000000000000000000000000000000000000000", oc = "~10000000000000000000", d = "~144115188075855872", x = "~200000000000000"},
-	{v = 288230376151711744, b = "10000000000000000000000000000000000000000000000000000000000", oc = "20000000000000000000", d = "288230376151711744", x = "400000000000000"},
-	{v = ~288230376151711744, b = "~10000000000000000000000000000000000000000000000000000000000", oc = "~20000000000000000000", d = "~288230376151711744", x = "~400000000000000"},
-	{v = 576460752303423488, b = "100000000000000000000000000000000000000000000000000000000000", oc = "40000000000000000000", d = "576460752303423488", x = "800000000000000"},
-	{v = ~576460752303423488, b = "~100000000000000000000000000000000000000000000000000000000000", oc = "~40000000000000000000", d = "~576460752303423488", x = "~800000000000000"},
-	{v = 1152921504606846976, b = "1000000000000000000000000000000000000000000000000000000000000", oc = "100000000000000000000", d = "1152921504606846976", x = "1000000000000000"},
-	{v = ~1152921504606846976, b = "~1000000000000000000000000000000000000000000000000000000000000", oc = "~100000000000000000000", d = "~1152921504606846976", x = "~1000000000000000"},
-	{v = 2305843009213693952, b = "10000000000000000000000000000000000000000000000000000000000000", oc = "200000000000000000000", d = "2305843009213693952", x = "2000000000000000"},
-	{v = ~2305843009213693952, b = "~10000000000000000000000000000000000000000000000000000000000000", oc = "~200000000000000000000", d = "~2305843009213693952", x = "~2000000000000000"},
-	{v = 4611686018427387904, b = "100000000000000000000000000000000000000000000000000000000000000", oc = "400000000000000000000", d = "4611686018427387904", x = "4000000000000000"},
-	{v = ~4611686018427387904, b = "~100000000000000000000000000000000000000000000000000000000000000", oc = "~400000000000000000000", d = "~4611686018427387904", x = "~4000000000000000"},
-	{v = 9223372036854775808, b = "1000000000000000000000000000000000000000000000000000000000000000", oc = "1000000000000000000000", d = "9223372036854775808", x = "8000000000000000"},
-	{v = ~9223372036854775808, b = "~1000000000000000000000000000000000000000000000000000000000000000", oc = "~1000000000000000000000", d = "~9223372036854775808", x = "~8000000000000000"},
-	{v = 18446744073709551616, b = "10000000000000000000000000000000000000000000000000000000000000000", oc = "2000000000000000000000", d = "18446744073709551616", x = "10000000000000000"},
-	{v = ~18446744073709551616, b = "~10000000000000000000000000000000000000000000000000000000000000000", oc = "~2000000000000000000000", d = "~18446744073709551616", x = "~10000000000000000"},
-	{v = 36893488147419103232, b = "100000000000000000000000000000000000000000000000000000000000000000", oc = "4000000000000000000000", d = "36893488147419103232", x = "20000000000000000"},
-	{v = ~36893488147419103232, b = "~100000000000000000000000000000000000000000000000000000000000000000", oc = "~4000000000000000000000", d = "~36893488147419103232", x = "~20000000000000000"},
-	{v = 73786976294838206464, b = "1000000000000000000000000000000000000000000000000000000000000000000", oc = "10000000000000000000000", d = "73786976294838206464", x = "40000000000000000"},
-	{v = ~73786976294838206464, b = "~1000000000000000000000000000000000000000000000000000000000000000000", oc = "~10000000000000000000000", d = "~73786976294838206464", x = "~40000000000000000"},
-	{v = 147573952589676412928, b = "10000000000000000000000000000000000000000000000000000000000000000000", oc = "20000000000000000000000", d = "147573952589676412928", x = "80000000000000000"},
-	{v = ~147573952589676412928, b = "~10000000000000000000000000000000000000000000000000000000000000000000", oc = "~20000000000000000000000", d = "~147573952589676412928", x = "~80000000000000000"},
-	{v = 295147905179352825856, b = "100000000000000000000000000000000000000000000000000000000000000000000", oc = "40000000000000000000000", d = "295147905179352825856", x = "100000000000000000"},
-	{v = ~295147905179352825856, b = "~100000000000000000000000000000000000000000000000000000000000000000000", oc = "~40000000000000000000000", d = "~295147905179352825856", x = "~100000000000000000"},
-	{v = 590295810358705651712, b = "1000000000000000000000000000000000000000000000000000000000000000000000", oc = "100000000000000000000000", d = "590295810358705651712", x = "200000000000000000"},
-	{v = ~590295810358705651712, b = "~1000000000000000000000000000000000000000000000000000000000000000000000", oc = "~100000000000000000000000", d = "~590295810358705651712", x = "~200000000000000000"},
-	{v = 1180591620717411303424, b = "10000000000000000000000000000000000000000000000000000000000000000000000", oc = "200000000000000000000000", d = "1180591620717411303424", x = "400000000000000000"},
-	{v = ~1180591620717411303424, b = "~10000000000000000000000000000000000000000000000000000000000000000000000", oc = "~200000000000000000000000", d = "~1180591620717411303424", x = "~400000000000000000"},
-	{v = 2361183241434822606848, b = "100000000000000000000000000000000000000000000000000000000000000000000000", oc = "400000000000000000000000", d = "2361183241434822606848", x = "800000000000000000"},
-	{v = ~2361183241434822606848, b = "~100000000000000000000000000000000000000000000000000000000000000000000000", oc = "~400000000000000000000000", d = "~2361183241434822606848", x = "~800000000000000000"},
-	{v = 4722366482869645213696, b = "1000000000000000000000000000000000000000000000000000000000000000000000000", oc = "1000000000000000000000000", d = "4722366482869645213696", x = "1000000000000000000"},
-	{v = ~4722366482869645213696, b = "~1000000000000000000000000000000000000000000000000000000000000000000000000", oc = "~1000000000000000000000000", d = "~4722366482869645213696", x = "~1000000000000000000"},
-	{v = 9444732965739290427392, b = "10000000000000000000000000000000000000000000000000000000000000000000000000", oc = "2000000000000000000000000", d = "9444732965739290427392", x = "2000000000000000000"},
-	{v = ~9444732965739290427392, b = "~10000000000000000000000000000000000000000000000000000000000000000000000000", oc = "~2000000000000000000000000", d = "~9444732965739290427392", x = "~2000000000000000000"},
-	{v = 18889465931478580854784, b = "100000000000000000000000000000000000000000000000000000000000000000000000000", oc = "4000000000000000000000000", d = "18889465931478580854784", x = "4000000000000000000"},
-	{v = ~18889465931478580854784, b = "~100000000000000000000000000000000000000000000000000000000000000000000000000", oc = "~4000000000000000000000000", d = "~18889465931478580854784", x = "~4000000000000000000"},
-	{v = 37778931862957161709568, b = "1000000000000000000000000000000000000000000000000000000000000000000000000000", oc = "10000000000000000000000000", d = "37778931862957161709568", x = "8000000000000000000"},
-	{v = ~37778931862957161709568, b = "~1000000000000000000000000000000000000000000000000000000000000000000000000000", oc = "~10000000000000000000000000", d = "~37778931862957161709568", x = "~8000000000000000000"},
-	{v = 75557863725914323419136, b = "10000000000000000000000000000000000000000000000000000000000000000000000000000", oc = "20000000000000000000000000", d = "75557863725914323419136", x = "10000000000000000000"},
-	{v = ~75557863725914323419136, b = "~10000000000000000000000000000000000000000000000000000000000000000000000000000", oc = "~20000000000000000000000000", d = "~75557863725914323419136", x = "~10000000000000000000"},
-	{v = 151115727451828646838272, b = "100000000000000000000000000000000000000000000000000000000000000000000000000000", oc = "40000000000000000000000000", d = "151115727451828646838272", x = "20000000000000000000"},
-	{v = ~151115727451828646838272, b = "~100000000000000000000000000000000000000000000000000000000000000000000000000000", oc = "~40000000000000000000000000", d = "~151115727451828646838272", x = "~20000000000000000000"},
-	{v = 302231454903657293676544, b = "1000000000000000000000000000000000000000000000000000000000000000000000000000000", oc = "100000000000000000000000000", d = "302231454903657293676544", x = "40000000000000000000"},
-	{v = ~302231454903657293676544, b = "~1000000000000000000000000000000000000000000000000000000000000000000000000000000", oc = "~100000000000000000000000000", d = "~302231454903657293676544", x = "~40000000000000000000"},
-	{v = 604462909807314587353088, b = "10000000000000000000000000000000000000000000000000000000000000000000000000000000", oc = "200000000000000000000000000", d = "604462909807314587353088", x = "80000000000000000000"},
-	{v = ~604462909807314587353088, b = "~10000000000000000000000000000000000000000000000000000000000000000000000000000000", oc = "~200000000000000000000000000", d = "~604462909807314587353088", x = "~80000000000000000000"},
-	{v = 1208925819614629174706176, b = "100000000000000000000000000000000000000000000000000000000000000000000000000000000", oc = "400000000000000000000000000", d = "1208925819614629174706176", x = "100000000000000000000"},
-	{v = ~1208925819614629174706176, b = "~100000000000000000000000000000000000000000000000000000000000000000000000000000000", oc = "~400000000000000000000000000", d = "~1208925819614629174706176", x = "~100000000000000000000"},
-	{v = 2417851639229258349412352, b = "1000000000000000000000000000000000000000000000000000000000000000000000000000000000", oc = "1000000000000000000000000000", d = "2417851639229258349412352", x = "200000000000000000000"},
-	{v = ~2417851639229258349412352, b = "~1000000000000000000000000000000000000000000000000000000000000000000000000000000000", oc = "~1000000000000000000000000000", d = "~2417851639229258349412352", x = "~200000000000000000000"},
-	{v = 4835703278458516698824704, b = "10000000000000000000000000000000000000000000000000000000000000000000000000000000000", oc = "2000000000000000000000000000", d = "4835703278458516698824704", x = "400000000000000000000"},
-	{v = ~4835703278458516698824704, b = "~10000000000000000000000000000000000000000000000000000000000000000000000000000000000", oc = "~2000000000000000000000000000", d = "~4835703278458516698824704", x = "~400000000000000000000"},
-	{v = 9671406556917033397649408, b = "100000000000000000000000000000000000000000000000000000000000000000000000000000000000", oc = "4000000000000000000000000000", d = "9671406556917033397649408", x = "800000000000000000000"},
-	{v = ~9671406556917033397649408, b = "~100000000000000000000000000000000000000000000000000000000000000000000000000000000000", oc = "~4000000000000000000000000000", d = "~9671406556917033397649408", x = "~800000000000000000000"},
-	{v = 19342813113834066795298816, b = "1000000000000000000000000000000000000000000000000000000000000000000000000000000000000", oc = "10000000000000000000000000000", d = "19342813113834066795298816", x = "1000000000000000000000"},
-	{v = ~19342813113834066795298816, b = "~1000000000000000000000000000000000000000000000000000000000000000000000000000000000000", oc = "~10000000000000000000000000000", d = "~19342813113834066795298816", x = "~1000000000000000000000"},
-	{v = 38685626227668133590597632, b = "10000000000000000000000000000000000000000000000000000000000000000000000000000000000000", oc = "20000000000000000000000000000", d = "38685626227668133590597632", x = "2000000000000000000000"},
-	{v = ~38685626227668133590597632, b = "~10000000000000000000000000000000000000000000000000000000000000000000000000000000000000", oc = "~20000000000000000000000000000", d = "~38685626227668133590597632", x = "~2000000000000000000000"},
-	{v = 77371252455336267181195264, b = "100000000000000000000000000000000000000000000000000000000000000000000000000000000000000", oc = "40000000000000000000000000000", d = "77371252455336267181195264", x = "4000000000000000000000"},
-	{v = ~77371252455336267181195264, b = "~100000000000000000000000000000000000000000000000000000000000000000000000000000000000000", oc = "~40000000000000000000000000000", d = "~77371252455336267181195264", x = "~4000000000000000000000"},
-	{v = 154742504910672534362390528, b = "1000000000000000000000000000000000000000000000000000000000000000000000000000000000000000", oc = "100000000000000000000000000000", d = "154742504910672534362390528", x = "8000000000000000000000"},
-	{v = ~154742504910672534362390528, b = "~1000000000000000000000000000000000000000000000000000000000000000000000000000000000000000", oc = "~100000000000000000000000000000", d = "~154742504910672534362390528", x = "~8000000000000000000000"},
-	{v = 309485009821345068724781056, b = "10000000000000000000000000000000000000000000000000000000000000000000000000000000000000000", oc = "200000000000000000000000000000", d = "309485009821345068724781056", x = "10000000000000000000000"},
-	{v = ~309485009821345068724781056, b = "~10000000000000000000000000000000000000000000000000000000000000000000000000000000000000000", oc = "~200000000000000000000000000000", d = "~309485009821345068724781056", x = "~10000000000000000000000"},
-	{v = 618970019642690137449562112, b = "100000000000000000000000000000000000000000000000000000000000000000000000000000000000000000", oc = "400000000000000000000000000000", d = "618970019642690137449562112", x = "20000000000000000000000"},
-	{v = ~618970019642690137449562112, b = "~100000000000000000000000000000000000000000000000000000000000000000000000000000000000000000", oc = "~400000000000000000000000000000", d = "~618970019642690137449562112", x = "~20000000000000000000000"},
-	{v = 1237940039285380274899124224, b = "1000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000", oc = "1000000000000000000000000000000", d = "1237940039285380274899124224", x = "40000000000000000000000"},
-	{v = ~1237940039285380274899124224, b = "~1000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000", oc = "~1000000000000000000000000000000", d = "~1237940039285380274899124224", x = "~40000000000000000000000"},
-	{v = 2475880078570760549798248448, b = "10000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000", oc = "2000000000000000000000000000000", d = "2475880078570760549798248448", x = "80000000000000000000000"},
-	{v = ~2475880078570760549798248448, b = "~10000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000", oc = "~2000000000000000000000000000000", d = "~2475880078570760549798248448", x = "~80000000000000000000000"},
-	{v = 4951760157141521099596496896, b = "100000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000", oc = "4000000000000000000000000000000", d = "4951760157141521099596496896", x = "100000000000000000000000"},
-	{v = ~4951760157141521099596496896, b = "~100000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000", oc = "~4000000000000000000000000000000", d = "~4951760157141521099596496896", x = "~100000000000000000000000"},
-	{v = 9903520314283042199192993792, b = "1000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000", oc = "10000000000000000000000000000000", d = "9903520314283042199192993792", x = "200000000000000000000000"},
-	{v = ~9903520314283042199192993792, b = "~1000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000", oc = "~10000000000000000000000000000000", d = "~9903520314283042199192993792", x = "~200000000000000000000000"},
-	{v = 19807040628566084398385987584, b = "10000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000", oc = "20000000000000000000000000000000", d = "19807040628566084398385987584", x = "400000000000000000000000"},
-	{v = ~19807040628566084398385987584, b = "~10000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000", oc = "~20000000000000000000000000000000", d = "~19807040628566084398385987584", x = "~400000000000000000000000"},
-	{v = 39614081257132168796771975168, b = "100000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000", oc = "40000000000000000000000000000000", d = "39614081257132168796771975168", x = "800000000000000000000000"},
-	{v = ~39614081257132168796771975168, b = "~100000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000", oc = "~40000000000000000000000000000000", d = "~39614081257132168796771975168", x = "~800000000000000000000000"},
-	{v = 79228162514264337593543950336, b = "1000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000", oc = "100000000000000000000000000000000", d = "79228162514264337593543950336", x = "1000000000000000000000000"},
-	{v = ~79228162514264337593543950336, b = "~1000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000", oc = "~100000000000000000000000000000000", d = "~79228162514264337593543950336", x = "~1000000000000000000000000"},
-	{v = 158456325028528675187087900672, b = "10000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000", oc = "200000000000000000000000000000000", d = "158456325028528675187087900672", x = "2000000000000000000000000"},
-	{v = ~158456325028528675187087900672, b = "~10000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000", oc = "~200000000000000000000000000000000", d = "~158456325028528675187087900672", x = "~2000000000000000000000000"},
-	{v = 316912650057057350374175801344, b = "100000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000", oc = "400000000000000000000000000000000", d = "316912650057057350374175801344", x = "4000000000000000000000000"},
-	{v = ~316912650057057350374175801344, b = "~100000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000", oc = "~400000000000000000000000000000000", d = "~316912650057057350374175801344", x = "~4000000000000000000000000"},
-	{v = 633825300114114700748351602688, b = "1000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000", oc = "1000000000000000000000000000000000", d = "633825300114114700748351602688", x = "8000000000000000000000000"},
-	{v = ~633825300114114700748351602688, b = "~1000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000", oc = "~1000000000000000000000000000000000", d = "~633825300114114700748351602688", x = "~8000000000000000000000000"}
+        {v = 0, b = "0", oc = "0", d = "0", x = "0"},
+        {v = ~0, b = "~0", oc = "~0", d = "~0", x = "~0"},
+        {v = 1, b = "1", oc = "1", d = "1", x = "1"},
+        {v = ~1, b = "~1", oc = "~1", d = "~1", x = "~1"},
+        {v = 2, b = "10", oc = "2", d = "2", x = "2"},
+        {v = ~2, b = "~10", oc = "~2", d = "~2", x = "~2"},
+        {v = 3, b = "11", oc = "3", d = "3", x = "3"},
+        {v = ~3, b = "~11", oc = "~3", d = "~3", x = "~3"},
+        {v = 4, b = "100", oc = "4", d = "4", x = "4"},
+        {v = ~4, b = "~100", oc = "~4", d = "~4", x = "~4"},
+        {v = 5, b = "101", oc = "5", d = "5", x = "5"},
+        {v = ~5, b = "~101", oc = "~5", d = "~5", x = "~5"},
+        {v = 6, b = "110", oc = "6", d = "6", x = "6"},
+        {v = ~6, b = "~110", oc = "~6", d = "~6", x = "~6"},
+        {v = 7, b = "111", oc = "7", d = "7", x = "7"},
+        {v = ~7, b = "~111", oc = "~7", d = "~7", x = "~7"},
+        {v = 8, b = "1000", oc = "10", d = "8", x = "8"},
+        {v = ~8, b = "~1000", oc = "~10", d = "~8", x = "~8"},
+        {v = 9, b = "1001", oc = "11", d = "9", x = "9"},
+        {v = ~9, b = "~1001", oc = "~11", d = "~9", x = "~9"},
+        {v = 10, b = "1010", oc = "12", d = "10", x = "A"},
+        {v = ~10, b = "~1010", oc = "~12", d = "~10", x = "~A"},
+        {v = 11, b = "1011", oc = "13", d = "11", x = "B"},
+        {v = ~11, b = "~1011", oc = "~13", d = "~11", x = "~B"},
+        {v = 12, b = "1100", oc = "14", d = "12", x = "C"},
+        {v = ~12, b = "~1100", oc = "~14", d = "~12", x = "~C"},
+        {v = 13, b = "1101", oc = "15", d = "13", x = "D"},
+        {v = ~13, b = "~1101", oc = "~15", d = "~13", x = "~D"},
+        {v = 14, b = "1110", oc = "16", d = "14", x = "E"},
+        {v = ~14, b = "~1110", oc = "~16", d = "~14", x = "~E"},
+        {v = 15, b = "1111", oc = "17", d = "15", x = "F"},
+        {v = ~15, b = "~1111", oc = "~17", d = "~15", x = "~F"},
+        {v = 16, b = "10000", oc = "20", d = "16", x = "10"},
+        {v = ~16, b = "~10000", oc = "~20", d = "~16", x = "~10"},
+        {v = 17, b = "10001", oc = "21", d = "17", x = "11"},
+        {v = ~17, b = "~10001", oc = "~21", d = "~17", x = "~11"},
+        {v = 18, b = "10010", oc = "22", d = "18", x = "12"},
+        {v = ~18, b = "~10010", oc = "~22", d = "~18", x = "~12"},
+        {v = 19, b = "10011", oc = "23", d = "19", x = "13"},
+        {v = ~19, b = "~10011", oc = "~23", d = "~19", x = "~13"},
+        {v = 20, b = "10100", oc = "24", d = "20", x = "14"},
+        {v = ~20, b = "~10100", oc = "~24", d = "~20", x = "~14"},
+        {v = 21, b = "10101", oc = "25", d = "21", x = "15"},
+        {v = ~21, b = "~10101", oc = "~25", d = "~21", x = "~15"},
+        {v = 22, b = "10110", oc = "26", d = "22", x = "16"},
+        {v = ~22, b = "~10110", oc = "~26", d = "~22", x = "~16"},
+        {v = 23, b = "10111", oc = "27", d = "23", x = "17"},
+        {v = ~23, b = "~10111", oc = "~27", d = "~23", x = "~17"},
+        {v = 24, b = "11000", oc = "30", d = "24", x = "18"},
+        {v = ~24, b = "~11000", oc = "~30", d = "~24", x = "~18"},
+        {v = 25, b = "11001", oc = "31", d = "25", x = "19"},
+        {v = ~25, b = "~11001", oc = "~31", d = "~25", x = "~19"},
+        {v = 26, b = "11010", oc = "32", d = "26", x = "1A"},
+        {v = ~26, b = "~11010", oc = "~32", d = "~26", x = "~1A"},
+        {v = 27, b = "11011", oc = "33", d = "27", x = "1B"},
+        {v = ~27, b = "~11011", oc = "~33", d = "~27", x = "~1B"},
+        {v = 28, b = "11100", oc = "34", d = "28", x = "1C"},
+        {v = ~28, b = "~11100", oc = "~34", d = "~28", x = "~1C"},
+        {v = 29, b = "11101", oc = "35", d = "29", x = "1D"},
+        {v = ~29, b = "~11101", oc = "~35", d = "~29", x = "~1D"},
+        {v = 30, b = "11110", oc = "36", d = "30", x = "1E"},
+        {v = ~30, b = "~11110", oc = "~36", d = "~30", x = "~1E"},
+        {v = 31, b = "11111", oc = "37", d = "31", x = "1F"},
+        {v = ~31, b = "~11111", oc = "~37", d = "~31", x = "~1F"},
+        {v = 32, b = "100000", oc = "40", d = "32", x = "20"},
+        {v = ~32, b = "~100000", oc = "~40", d = "~32", x = "~20"},
+        {v = 33, b = "100001", oc = "41", d = "33", x = "21"},
+        {v = ~33, b = "~100001", oc = "~41", d = "~33", x = "~21"},
+        {v = 34, b = "100010", oc = "42", d = "34", x = "22"},
+        {v = ~34, b = "~100010", oc = "~42", d = "~34", x = "~22"},
+        {v = 35, b = "100011", oc = "43", d = "35", x = "23"},
+        {v = ~35, b = "~100011", oc = "~43", d = "~35", x = "~23"},
+        {v = 36, b = "100100", oc = "44", d = "36", x = "24"},
+        {v = ~36, b = "~100100", oc = "~44", d = "~36", x = "~24"},
+        {v = 37, b = "100101", oc = "45", d = "37", x = "25"},
+        {v = ~37, b = "~100101", oc = "~45", d = "~37", x = "~25"},
+        {v = 38, b = "100110", oc = "46", d = "38", x = "26"},
+        {v = ~38, b = "~100110", oc = "~46", d = "~38", x = "~26"},
+        {v = 39, b = "100111", oc = "47", d = "39", x = "27"},
+        {v = ~39, b = "~100111", oc = "~47", d = "~39", x = "~27"},
+        {v = 40, b = "101000", oc = "50", d = "40", x = "28"},
+        {v = ~40, b = "~101000", oc = "~50", d = "~40", x = "~28"},
+        {v = 41, b = "101001", oc = "51", d = "41", x = "29"},
+        {v = ~41, b = "~101001", oc = "~51", d = "~41", x = "~29"},
+        {v = 42, b = "101010", oc = "52", d = "42", x = "2A"},
+        {v = ~42, b = "~101010", oc = "~52", d = "~42", x = "~2A"},
+        {v = 43, b = "101011", oc = "53", d = "43", x = "2B"},
+        {v = ~43, b = "~101011", oc = "~53", d = "~43", x = "~2B"},
+        {v = 44, b = "101100", oc = "54", d = "44", x = "2C"},
+        {v = ~44, b = "~101100", oc = "~54", d = "~44", x = "~2C"},
+        {v = 45, b = "101101", oc = "55", d = "45", x = "2D"},
+        {v = ~45, b = "~101101", oc = "~55", d = "~45", x = "~2D"},
+        {v = 46, b = "101110", oc = "56", d = "46", x = "2E"},
+        {v = ~46, b = "~101110", oc = "~56", d = "~46", x = "~2E"},
+        {v = 47, b = "101111", oc = "57", d = "47", x = "2F"},
+        {v = ~47, b = "~101111", oc = "~57", d = "~47", x = "~2F"},
+        {v = 48, b = "110000", oc = "60", d = "48", x = "30"},
+        {v = ~48, b = "~110000", oc = "~60", d = "~48", x = "~30"},
+        {v = 49, b = "110001", oc = "61", d = "49", x = "31"},
+        {v = ~49, b = "~110001", oc = "~61", d = "~49", x = "~31"},
+        {v = 50, b = "110010", oc = "62", d = "50", x = "32"},
+        {v = ~50, b = "~110010", oc = "~62", d = "~50", x = "~32"},
+        {v = 51, b = "110011", oc = "63", d = "51", x = "33"},
+        {v = ~51, b = "~110011", oc = "~63", d = "~51", x = "~33"},
+        {v = 52, b = "110100", oc = "64", d = "52", x = "34"},
+        {v = ~52, b = "~110100", oc = "~64", d = "~52", x = "~34"},
+        {v = 53, b = "110101", oc = "65", d = "53", x = "35"},
+        {v = ~53, b = "~110101", oc = "~65", d = "~53", x = "~35"},
+        {v = 54, b = "110110", oc = "66", d = "54", x = "36"},
+        {v = ~54, b = "~110110", oc = "~66", d = "~54", x = "~36"},
+        {v = 55, b = "110111", oc = "67", d = "55", x = "37"},
+        {v = ~55, b = "~110111", oc = "~67", d = "~55", x = "~37"},
+        {v = 56, b = "111000", oc = "70", d = "56", x = "38"},
+        {v = ~56, b = "~111000", oc = "~70", d = "~56", x = "~38"},
+        {v = 57, b = "111001", oc = "71", d = "57", x = "39"},
+        {v = ~57, b = "~111001", oc = "~71", d = "~57", x = "~39"},
+        {v = 58, b = "111010", oc = "72", d = "58", x = "3A"},
+        {v = ~58, b = "~111010", oc = "~72", d = "~58", x = "~3A"},
+        {v = 59, b = "111011", oc = "73", d = "59", x = "3B"},
+        {v = ~59, b = "~111011", oc = "~73", d = "~59", x = "~3B"},
+        {v = 60, b = "111100", oc = "74", d = "60", x = "3C"},
+        {v = ~60, b = "~111100", oc = "~74", d = "~60", x = "~3C"},
+        {v = 61, b = "111101", oc = "75", d = "61", x = "3D"},
+        {v = ~61, b = "~111101", oc = "~75", d = "~61", x = "~3D"},
+        {v = 62, b = "111110", oc = "76", d = "62", x = "3E"},
+        {v = ~62, b = "~111110", oc = "~76", d = "~62", x = "~3E"},
+        {v = 63, b = "111111", oc = "77", d = "63", x = "3F"},
+        {v = ~63, b = "~111111", oc = "~77", d = "~63", x = "~3F"},
+        {v = 64, b = "1000000", oc = "100", d = "64", x = "40"},
+        {v = ~64, b = "~1000000", oc = "~100", d = "~64", x = "~40"},
+        {v = 65, b = "1000001", oc = "101", d = "65", x = "41"},
+        {v = ~65, b = "~1000001", oc = "~101", d = "~65", x = "~41"},
+        {v = 66, b = "1000010", oc = "102", d = "66", x = "42"},
+        {v = ~66, b = "~1000010", oc = "~102", d = "~66", x = "~42"},
+        {v = 67, b = "1000011", oc = "103", d = "67", x = "43"},
+        {v = ~67, b = "~1000011", oc = "~103", d = "~67", x = "~43"},
+        {v = 68, b = "1000100", oc = "104", d = "68", x = "44"},
+        {v = ~68, b = "~1000100", oc = "~104", d = "~68", x = "~44"},
+        {v = 69, b = "1000101", oc = "105", d = "69", x = "45"},
+        {v = ~69, b = "~1000101", oc = "~105", d = "~69", x = "~45"},
+        {v = 70, b = "1000110", oc = "106", d = "70", x = "46"},
+        {v = ~70, b = "~1000110", oc = "~106", d = "~70", x = "~46"},
+        {v = 71, b = "1000111", oc = "107", d = "71", x = "47"},
+        {v = ~71, b = "~1000111", oc = "~107", d = "~71", x = "~47"},
+        {v = 72, b = "1001000", oc = "110", d = "72", x = "48"},
+        {v = ~72, b = "~1001000", oc = "~110", d = "~72", x = "~48"},
+        {v = 73, b = "1001001", oc = "111", d = "73", x = "49"},
+        {v = ~73, b = "~1001001", oc = "~111", d = "~73", x = "~49"},
+        {v = 74, b = "1001010", oc = "112", d = "74", x = "4A"},
+        {v = ~74, b = "~1001010", oc = "~112", d = "~74", x = "~4A"},
+        {v = 75, b = "1001011", oc = "113", d = "75", x = "4B"},
+        {v = ~75, b = "~1001011", oc = "~113", d = "~75", x = "~4B"},
+        {v = 76, b = "1001100", oc = "114", d = "76", x = "4C"},
+        {v = ~76, b = "~1001100", oc = "~114", d = "~76", x = "~4C"},
+        {v = 77, b = "1001101", oc = "115", d = "77", x = "4D"},
+        {v = ~77, b = "~1001101", oc = "~115", d = "~77", x = "~4D"},
+        {v = 78, b = "1001110", oc = "116", d = "78", x = "4E"},
+        {v = ~78, b = "~1001110", oc = "~116", d = "~78", x = "~4E"},
+        {v = 79, b = "1001111", oc = "117", d = "79", x = "4F"},
+        {v = ~79, b = "~1001111", oc = "~117", d = "~79", x = "~4F"},
+        {v = 80, b = "1010000", oc = "120", d = "80", x = "50"},
+        {v = ~80, b = "~1010000", oc = "~120", d = "~80", x = "~50"},
+        {v = 81, b = "1010001", oc = "121", d = "81", x = "51"},
+        {v = ~81, b = "~1010001", oc = "~121", d = "~81", x = "~51"},
+        {v = 82, b = "1010010", oc = "122", d = "82", x = "52"},
+        {v = ~82, b = "~1010010", oc = "~122", d = "~82", x = "~52"},
+        {v = 83, b = "1010011", oc = "123", d = "83", x = "53"},
+        {v = ~83, b = "~1010011", oc = "~123", d = "~83", x = "~53"},
+        {v = 84, b = "1010100", oc = "124", d = "84", x = "54"},
+        {v = ~84, b = "~1010100", oc = "~124", d = "~84", x = "~54"},
+        {v = 85, b = "1010101", oc = "125", d = "85", x = "55"},
+        {v = ~85, b = "~1010101", oc = "~125", d = "~85", x = "~55"},
+        {v = 86, b = "1010110", oc = "126", d = "86", x = "56"},
+        {v = ~86, b = "~1010110", oc = "~126", d = "~86", x = "~56"},
+        {v = 87, b = "1010111", oc = "127", d = "87", x = "57"},
+        {v = ~87, b = "~1010111", oc = "~127", d = "~87", x = "~57"},
+        {v = 88, b = "1011000", oc = "130", d = "88", x = "58"},
+        {v = ~88, b = "~1011000", oc = "~130", d = "~88", x = "~58"},
+        {v = 89, b = "1011001", oc = "131", d = "89", x = "59"},
+        {v = ~89, b = "~1011001", oc = "~131", d = "~89", x = "~59"},
+        {v = 90, b = "1011010", oc = "132", d = "90", x = "5A"},
+        {v = ~90, b = "~1011010", oc = "~132", d = "~90", x = "~5A"},
+        {v = 91, b = "1011011", oc = "133", d = "91", x = "5B"},
+        {v = ~91, b = "~1011011", oc = "~133", d = "~91", x = "~5B"},
+        {v = 92, b = "1011100", oc = "134", d = "92", x = "5C"},
+        {v = ~92, b = "~1011100", oc = "~134", d = "~92", x = "~5C"},
+        {v = 93, b = "1011101", oc = "135", d = "93", x = "5D"},
+        {v = ~93, b = "~1011101", oc = "~135", d = "~93", x = "~5D"},
+        {v = 94, b = "1011110", oc = "136", d = "94", x = "5E"},
+        {v = ~94, b = "~1011110", oc = "~136", d = "~94", x = "~5E"},
+        {v = 95, b = "1011111", oc = "137", d = "95", x = "5F"},
+        {v = ~95, b = "~1011111", oc = "~137", d = "~95", x = "~5F"},
+        {v = 96, b = "1100000", oc = "140", d = "96", x = "60"},
+        {v = ~96, b = "~1100000", oc = "~140", d = "~96", x = "~60"},
+        {v = 97, b = "1100001", oc = "141", d = "97", x = "61"},
+        {v = ~97, b = "~1100001", oc = "~141", d = "~97", x = "~61"},
+        {v = 98, b = "1100010", oc = "142", d = "98", x = "62"},
+        {v = ~98, b = "~1100010", oc = "~142", d = "~98", x = "~62"},
+        {v = 99, b = "1100011", oc = "143", d = "99", x = "63"},
+        {v = ~99, b = "~1100011", oc = "~143", d = "~99", x = "~63"},
+        {v = 128, b = "10000000", oc = "200", d = "128", x = "80"},
+        {v = ~128, b = "~10000000", oc = "~200", d = "~128", x = "~80"},
+        {v = 256, b = "100000000", oc = "400", d = "256", x = "100"},
+        {v = ~256, b = "~100000000", oc = "~400", d = "~256", x = "~100"},
+        {v = 512, b = "1000000000", oc = "1000", d = "512", x = "200"},
+        {v = ~512, b = "~1000000000", oc = "~1000", d = "~512", x = "~200"},
+        {v = 1024, b = "10000000000", oc = "2000", d = "1024", x = "400"},
+        {v = ~1024, b = "~10000000000", oc = "~2000", d = "~1024", x = "~400"},
+        {v = 2048, b = "100000000000", oc = "4000", d = "2048", x = "800"},
+        {v = ~2048, b = "~100000000000", oc = "~4000", d = "~2048", x = "~800"},
+        {v = 4096, b = "1000000000000", oc = "10000", d = "4096", x = "1000"},
+        {v = ~4096, b = "~1000000000000", oc = "~10000", d = "~4096", x = "~1000"},
+        {v = 8192, b = "10000000000000", oc = "20000", d = "8192", x = "2000"},
+        {v = ~8192, b = "~10000000000000", oc = "~20000", d = "~8192", x = "~2000"},
+        {v = 16384, b = "100000000000000", oc = "40000", d = "16384", x = "4000"},
+        {v = ~16384, b = "~100000000000000", oc = "~40000", d = "~16384", x = "~4000"},
+        {v = 32768, b = "1000000000000000", oc = "100000", d = "32768", x = "8000"},
+        {v = ~32768, b = "~1000000000000000", oc = "~100000", d = "~32768", x = "~8000"},
+        {v = 65536, b = "10000000000000000", oc = "200000", d = "65536", x = "10000"},
+        {v = ~65536, b = "~10000000000000000", oc = "~200000", d = "~65536", x = "~10000"},
+        {v = 131072, b = "100000000000000000", oc = "400000", d = "131072", x = "20000"},
+        {v = ~131072, b = "~100000000000000000", oc = "~400000", d = "~131072", x = "~20000"},
+        {v = 262144, b = "1000000000000000000", oc = "1000000", d = "262144", x = "40000"},
+        {v = ~262144, b = "~1000000000000000000", oc = "~1000000", d = "~262144", x = "~40000"},
+        {v = 524288, b = "10000000000000000000", oc = "2000000", d = "524288", x = "80000"},
+        {v = ~524288, b = "~10000000000000000000", oc = "~2000000", d = "~524288", x = "~80000"},
+        {v = 1048576, b = "100000000000000000000", oc = "4000000", d = "1048576", x = "100000"},
+        {v = ~1048576, b = "~100000000000000000000", oc = "~4000000", d = "~1048576", x = "~100000"},
+        {v = 2097152, b = "1000000000000000000000", oc = "10000000", d = "2097152", x = "200000"},
+        {v = ~2097152, b = "~1000000000000000000000", oc = "~10000000", d = "~2097152", x = "~200000"},
+        {v = 4194304, b = "10000000000000000000000", oc = "20000000", d = "4194304", x = "400000"},
+        {v = ~4194304, b = "~10000000000000000000000", oc = "~20000000", d = "~4194304", x = "~400000"},
+        {v = 8388608, b = "100000000000000000000000", oc = "40000000", d = "8388608", x = "800000"},
+        {v = ~8388608, b = "~100000000000000000000000", oc = "~40000000", d = "~8388608", x = "~800000"},
+        {v = 16777216, b = "1000000000000000000000000", oc = "100000000", d = "16777216", x = "1000000"},
+        {v = ~16777216, b = "~1000000000000000000000000", oc = "~100000000", d = "~16777216", x = "~1000000"},
+        {v = 33554432, b = "10000000000000000000000000", oc = "200000000", d = "33554432", x = "2000000"},
+        {v = ~33554432, b = "~10000000000000000000000000", oc = "~200000000", d = "~33554432", x = "~2000000"},
+        {v = 67108864, b = "100000000000000000000000000", oc = "400000000", d = "67108864", x = "4000000"},
+        {v = ~67108864, b = "~100000000000000000000000000", oc = "~400000000", d = "~67108864", x = "~4000000"},
+        {v = 100000000, b = "101111101011110000100000000", oc = "575360400", d = "100000000", x = "5F5E100"},
+        {v = ~100000000, b = "~101111101011110000100000000", oc = "~575360400", d = "~100000000", x = "~5F5E100"},
+        {v = 134217728, b = "1000000000000000000000000000", oc = "1000000000", d = "134217728", x = "8000000"},
+        {v = ~134217728, b = "~1000000000000000000000000000", oc = "~1000000000", d = "~134217728", x = "~8000000"},
+        {v = 268435456, b = "10000000000000000000000000000", oc = "2000000000", d = "268435456", x = "10000000"},
+        {v = ~268435456, b = "~10000000000000000000000000000", oc = "~2000000000", d = "~268435456", x = "~10000000"},
+        {v = 536870912, b = "100000000000000000000000000000", oc = "4000000000", d = "536870912", x = "20000000"},
+        {v = ~536870912, b = "~100000000000000000000000000000", oc = "~4000000000", d = "~536870912", x = "~20000000"},
+        {v = 1073741822, b = "111111111111111111111111111110", oc = "7777777776", d = "1073741822", x = "3FFFFFFE"},
+        {v = ~1073741822, b = "~111111111111111111111111111110", oc = "~7777777776", d = "~1073741822", x = "~3FFFFFFE"},
+        {v = 1073741823, b = "111111111111111111111111111111", oc = "7777777777", d = "1073741823", x = "3FFFFFFF"},
+        {v = ~1073741823, b = "~111111111111111111111111111111", oc = "~7777777777", d = "~1073741823", x = "~3FFFFFFF"},
+        {v = 1073741824, b = "1000000000000000000000000000000", oc = "10000000000", d = "1073741824", x = "40000000"},
+        {v = ~1073741824, b = "~1000000000000000000000000000000", oc = "~10000000000", d = "~1073741824", x = "~40000000"},
+        {v = 1073741825, b = "1000000000000000000000000000001", oc = "10000000001", d = "1073741825", x = "40000001"},
+        {v = ~1073741825, b = "~1000000000000000000000000000001", oc = "~10000000001", d = "~1073741825", x = "~40000001"},
+        {v = 1073741826, b = "1000000000000000000000000000010", oc = "10000000002", d = "1073741826", x = "40000002"},
+        {v = ~1073741826, b = "~1000000000000000000000000000010", oc = "~10000000002", d = "~1073741826", x = "~40000002"},
+        {v = 2147483648, b = "10000000000000000000000000000000", oc = "20000000000", d = "2147483648", x = "80000000"},
+        {v = ~2147483648, b = "~10000000000000000000000000000000", oc = "~20000000000", d = "~2147483648", x = "~80000000"},
+        {v = 4294967296, b = "100000000000000000000000000000000", oc = "40000000000", d = "4294967296", x = "100000000"},
+        {v = ~4294967296, b = "~100000000000000000000000000000000", oc = "~40000000000", d = "~4294967296", x = "~100000000"},
+        {v = 4304967296, b = "100000000100110001001011010000000", oc = "40046113200", d = "4304967296", x = "100989680"},
+        {v = ~4304967296, b = "~100000000100110001001011010000000", oc = "~40046113200", d = "~4304967296", x = "~100989680"},
+        {v = 8589934592, b = "1000000000000000000000000000000000", oc = "100000000000", d = "8589934592", x = "200000000"},
+        {v = ~8589934592, b = "~1000000000000000000000000000000000", oc = "~100000000000", d = "~8589934592", x = "~200000000"},
+        {v = 17179869184, b = "10000000000000000000000000000000000", oc = "200000000000", d = "17179869184", x = "400000000"},
+        {v = ~17179869184, b = "~10000000000000000000000000000000000", oc = "~200000000000", d = "~17179869184", x = "~400000000"},
+        {v = 34359738368, b = "100000000000000000000000000000000000", oc = "400000000000", d = "34359738368", x = "800000000"},
+        {v = ~34359738368, b = "~100000000000000000000000000000000000", oc = "~400000000000", d = "~34359738368", x = "~800000000"},
+        {v = 68719476736, b = "1000000000000000000000000000000000000", oc = "1000000000000", d = "68719476736", x = "1000000000"},
+        {v = ~68719476736, b = "~1000000000000000000000000000000000000", oc = "~1000000000000", d = "~68719476736", x = "~1000000000"},
+        {v = 137438953472, b = "10000000000000000000000000000000000000", oc = "2000000000000", d = "137438953472", x = "2000000000"},
+        {v = ~137438953472, b = "~10000000000000000000000000000000000000", oc = "~2000000000000", d = "~137438953472", x = "~2000000000"},
+        {v = 274877906944, b = "100000000000000000000000000000000000000", oc = "4000000000000", d = "274877906944", x = "4000000000"},
+        {v = ~274877906944, b = "~100000000000000000000000000000000000000", oc = "~4000000000000", d = "~274877906944", x = "~4000000000"},
+        {v = 549755813888, b = "1000000000000000000000000000000000000000", oc = "10000000000000", d = "549755813888", x = "8000000000"},
+        {v = ~549755813888, b = "~1000000000000000000000000000000000000000", oc = "~10000000000000", d = "~549755813888", x = "~8000000000"},
+        {v = 1099511627776, b = "10000000000000000000000000000000000000000", oc = "20000000000000", d = "1099511627776", x = "10000000000"},
+        {v = ~1099511627776, b = "~10000000000000000000000000000000000000000", oc = "~20000000000000", d = "~1099511627776", x = "~10000000000"},
+        {v = 2199023255552, b = "100000000000000000000000000000000000000000", oc = "40000000000000", d = "2199023255552", x = "20000000000"},
+        {v = ~2199023255552, b = "~100000000000000000000000000000000000000000", oc = "~40000000000000", d = "~2199023255552", x = "~20000000000"},
+        {v = 4398046511104, b = "1000000000000000000000000000000000000000000", oc = "100000000000000", d = "4398046511104", x = "40000000000"},
+        {v = ~4398046511104, b = "~1000000000000000000000000000000000000000000", oc = "~100000000000000", d = "~4398046511104", x = "~40000000000"},
+        {v = 8796093022208, b = "10000000000000000000000000000000000000000000", oc = "200000000000000", d = "8796093022208", x = "80000000000"},
+        {v = ~8796093022208, b = "~10000000000000000000000000000000000000000000", oc = "~200000000000000", d = "~8796093022208", x = "~80000000000"},
+        {v = 17592186044416, b = "100000000000000000000000000000000000000000000", oc = "400000000000000", d = "17592186044416", x = "100000000000"},
+        {v = ~17592186044416, b = "~100000000000000000000000000000000000000000000", oc = "~400000000000000", d = "~17592186044416", x = "~100000000000"},
+        {v = 35184372088832, b = "1000000000000000000000000000000000000000000000", oc = "1000000000000000", d = "35184372088832", x = "200000000000"},
+        {v = ~35184372088832, b = "~1000000000000000000000000000000000000000000000", oc = "~1000000000000000", d = "~35184372088832", x = "~200000000000"},
+        {v = 70368744177664, b = "10000000000000000000000000000000000000000000000", oc = "2000000000000000", d = "70368744177664", x = "400000000000"},
+        {v = ~70368744177664, b = "~10000000000000000000000000000000000000000000000", oc = "~2000000000000000", d = "~70368744177664", x = "~400000000000"},
+        {v = 140737488355328, b = "100000000000000000000000000000000000000000000000", oc = "4000000000000000", d = "140737488355328", x = "800000000000"},
+        {v = ~140737488355328, b = "~100000000000000000000000000000000000000000000000", oc = "~4000000000000000", d = "~140737488355328", x = "~800000000000"},
+        {v = 281474976710656, b = "1000000000000000000000000000000000000000000000000", oc = "10000000000000000", d = "281474976710656", x = "1000000000000"},
+        {v = ~281474976710656, b = "~1000000000000000000000000000000000000000000000000", oc = "~10000000000000000", d = "~281474976710656", x = "~1000000000000"},
+        {v = 562949953421312, b = "10000000000000000000000000000000000000000000000000", oc = "20000000000000000", d = "562949953421312", x = "2000000000000"},
+        {v = ~562949953421312, b = "~10000000000000000000000000000000000000000000000000", oc = "~20000000000000000", d = "~562949953421312", x = "~2000000000000"},
+        {v = 1125899906842624, b = "100000000000000000000000000000000000000000000000000", oc = "40000000000000000", d = "1125899906842624", x = "4000000000000"},
+        {v = ~1125899906842624, b = "~100000000000000000000000000000000000000000000000000", oc = "~40000000000000000", d = "~1125899906842624", x = "~4000000000000"},
+        {v = 2251799813685248, b = "1000000000000000000000000000000000000000000000000000", oc = "100000000000000000", d = "2251799813685248", x = "8000000000000"},
+        {v = ~2251799813685248, b = "~1000000000000000000000000000000000000000000000000000", oc = "~100000000000000000", d = "~2251799813685248", x = "~8000000000000"},
+        {v = 4503599627370496, b = "10000000000000000000000000000000000000000000000000000", oc = "200000000000000000", d = "4503599627370496", x = "10000000000000"},
+        {v = ~4503599627370496, b = "~10000000000000000000000000000000000000000000000000000", oc = "~200000000000000000", d = "~4503599627370496", x = "~10000000000000"},
+        {v = 9007199254740992, b = "100000000000000000000000000000000000000000000000000000", oc = "400000000000000000", d = "9007199254740992", x = "20000000000000"},
+        {v = ~9007199254740992, b = "~100000000000000000000000000000000000000000000000000000", oc = "~400000000000000000", d = "~9007199254740992", x = "~20000000000000"},
+        {v = 18014398509481984, b = "1000000000000000000000000000000000000000000000000000000", oc = "1000000000000000000", d = "18014398509481984", x = "40000000000000"},
+        {v = ~18014398509481984, b = "~1000000000000000000000000000000000000000000000000000000", oc = "~1000000000000000000", d = "~18014398509481984", x = "~40000000000000"},
+        {v = 36028797018963968, b = "10000000000000000000000000000000000000000000000000000000", oc = "2000000000000000000", d = "36028797018963968", x = "80000000000000"},
+        {v = ~36028797018963968, b = "~10000000000000000000000000000000000000000000000000000000", oc = "~2000000000000000000", d = "~36028797018963968", x = "~80000000000000"},
+        {v = 72057594037927936, b = "100000000000000000000000000000000000000000000000000000000", oc = "4000000000000000000", d = "72057594037927936", x = "100000000000000"},
+        {v = ~72057594037927936, b = "~100000000000000000000000000000000000000000000000000000000", oc = "~4000000000000000000", d = "~72057594037927936", x = "~100000000000000"},
+        {v = 144115188075855872, b = "1000000000000000000000000000000000000000000000000000000000", oc = "10000000000000000000", d = "144115188075855872", x = "200000000000000"},
+        {v = ~144115188075855872, b = "~1000000000000000000000000000000000000000000000000000000000", oc = "~10000000000000000000", d = "~144115188075855872", x = "~200000000000000"},
+        {v = 288230376151711744, b = "10000000000000000000000000000000000000000000000000000000000", oc = "20000000000000000000", d = "288230376151711744", x = "400000000000000"},
+        {v = ~288230376151711744, b = "~10000000000000000000000000000000000000000000000000000000000", oc = "~20000000000000000000", d = "~288230376151711744", x = "~400000000000000"},
+        {v = 576460752303423488, b = "100000000000000000000000000000000000000000000000000000000000", oc = "40000000000000000000", d = "576460752303423488", x = "800000000000000"},
+        {v = ~576460752303423488, b = "~100000000000000000000000000000000000000000000000000000000000", oc = "~40000000000000000000", d = "~576460752303423488", x = "~800000000000000"},
+        {v = 1152921504606846976, b = "1000000000000000000000000000000000000000000000000000000000000", oc = "100000000000000000000", d = "1152921504606846976", x = "1000000000000000"},
+        {v = ~1152921504606846976, b = "~1000000000000000000000000000000000000000000000000000000000000", oc = "~100000000000000000000", d = "~1152921504606846976", x = "~1000000000000000"},
+        {v = 2305843009213693952, b = "10000000000000000000000000000000000000000000000000000000000000", oc = "200000000000000000000", d = "2305843009213693952", x = "2000000000000000"},
+        {v = ~2305843009213693952, b = "~10000000000000000000000000000000000000000000000000000000000000", oc = "~200000000000000000000", d = "~2305843009213693952", x = "~2000000000000000"},
+        {v = 4611686018427387904, b = "100000000000000000000000000000000000000000000000000000000000000", oc = "400000000000000000000", d = "4611686018427387904", x = "4000000000000000"},
+        {v = ~4611686018427387904, b = "~100000000000000000000000000000000000000000000000000000000000000", oc = "~400000000000000000000", d = "~4611686018427387904", x = "~4000000000000000"},
+        {v = 9223372036854775808, b = "1000000000000000000000000000000000000000000000000000000000000000", oc = "1000000000000000000000", d = "9223372036854775808", x = "8000000000000000"},
+        {v = ~9223372036854775808, b = "~1000000000000000000000000000000000000000000000000000000000000000", oc = "~1000000000000000000000", d = "~9223372036854775808", x = "~8000000000000000"},
+        {v = 18446744073709551616, b = "10000000000000000000000000000000000000000000000000000000000000000", oc = "2000000000000000000000", d = "18446744073709551616", x = "10000000000000000"},
+        {v = ~18446744073709551616, b = "~10000000000000000000000000000000000000000000000000000000000000000", oc = "~2000000000000000000000", d = "~18446744073709551616", x = "~10000000000000000"},
+        {v = 36893488147419103232, b = "100000000000000000000000000000000000000000000000000000000000000000", oc = "4000000000000000000000", d = "36893488147419103232", x = "20000000000000000"},
+        {v = ~36893488147419103232, b = "~100000000000000000000000000000000000000000000000000000000000000000", oc = "~4000000000000000000000", d = "~36893488147419103232", x = "~20000000000000000"},
+        {v = 73786976294838206464, b = "1000000000000000000000000000000000000000000000000000000000000000000", oc = "10000000000000000000000", d = "73786976294838206464", x = "40000000000000000"},
+        {v = ~73786976294838206464, b = "~1000000000000000000000000000000000000000000000000000000000000000000", oc = "~10000000000000000000000", d = "~73786976294838206464", x = "~40000000000000000"},
+        {v = 147573952589676412928, b = "10000000000000000000000000000000000000000000000000000000000000000000", oc = "20000000000000000000000", d = "147573952589676412928", x = "80000000000000000"},
+        {v = ~147573952589676412928, b = "~10000000000000000000000000000000000000000000000000000000000000000000", oc = "~20000000000000000000000", d = "~147573952589676412928", x = "~80000000000000000"},
+        {v = 295147905179352825856, b = "100000000000000000000000000000000000000000000000000000000000000000000", oc = "40000000000000000000000", d = "295147905179352825856", x = "100000000000000000"},
+        {v = ~295147905179352825856, b = "~100000000000000000000000000000000000000000000000000000000000000000000", oc = "~40000000000000000000000", d = "~295147905179352825856", x = "~100000000000000000"},
+        {v = 590295810358705651712, b = "1000000000000000000000000000000000000000000000000000000000000000000000", oc = "100000000000000000000000", d = "590295810358705651712", x = "200000000000000000"},
+        {v = ~590295810358705651712, b = "~1000000000000000000000000000000000000000000000000000000000000000000000", oc = "~100000000000000000000000", d = "~590295810358705651712", x = "~200000000000000000"},
+        {v = 1180591620717411303424, b = "10000000000000000000000000000000000000000000000000000000000000000000000", oc = "200000000000000000000000", d = "1180591620717411303424", x = "400000000000000000"},
+        {v = ~1180591620717411303424, b = "~10000000000000000000000000000000000000000000000000000000000000000000000", oc = "~200000000000000000000000", d = "~1180591620717411303424", x = "~400000000000000000"},
+        {v = 2361183241434822606848, b = "100000000000000000000000000000000000000000000000000000000000000000000000", oc = "400000000000000000000000", d = "2361183241434822606848", x = "800000000000000000"},
+        {v = ~2361183241434822606848, b = "~100000000000000000000000000000000000000000000000000000000000000000000000", oc = "~400000000000000000000000", d = "~2361183241434822606848", x = "~800000000000000000"},
+        {v = 4722366482869645213696, b = "1000000000000000000000000000000000000000000000000000000000000000000000000", oc = "1000000000000000000000000", d = "4722366482869645213696", x = "1000000000000000000"},
+        {v = ~4722366482869645213696, b = "~1000000000000000000000000000000000000000000000000000000000000000000000000", oc = "~1000000000000000000000000", d = "~4722366482869645213696", x = "~1000000000000000000"},
+        {v = 9444732965739290427392, b = "10000000000000000000000000000000000000000000000000000000000000000000000000", oc = "2000000000000000000000000", d = "9444732965739290427392", x = "2000000000000000000"},
+        {v = ~9444732965739290427392, b = "~10000000000000000000000000000000000000000000000000000000000000000000000000", oc = "~2000000000000000000000000", d = "~9444732965739290427392", x = "~2000000000000000000"},
+        {v = 18889465931478580854784, b = "100000000000000000000000000000000000000000000000000000000000000000000000000", oc = "4000000000000000000000000", d = "18889465931478580854784", x = "4000000000000000000"},
+        {v = ~18889465931478580854784, b = "~100000000000000000000000000000000000000000000000000000000000000000000000000", oc = "~4000000000000000000000000", d = "~18889465931478580854784", x = "~4000000000000000000"},
+        {v = 37778931862957161709568, b = "1000000000000000000000000000000000000000000000000000000000000000000000000000", oc = "10000000000000000000000000", d = "37778931862957161709568", x = "8000000000000000000"},
+        {v = ~37778931862957161709568, b = "~1000000000000000000000000000000000000000000000000000000000000000000000000000", oc = "~10000000000000000000000000", d = "~37778931862957161709568", x = "~8000000000000000000"},
+        {v = 75557863725914323419136, b = "10000000000000000000000000000000000000000000000000000000000000000000000000000", oc = "20000000000000000000000000", d = "75557863725914323419136", x = "10000000000000000000"},
+        {v = ~75557863725914323419136, b = "~10000000000000000000000000000000000000000000000000000000000000000000000000000", oc = "~20000000000000000000000000", d = "~75557863725914323419136", x = "~10000000000000000000"},
+        {v = 151115727451828646838272, b = "100000000000000000000000000000000000000000000000000000000000000000000000000000", oc = "40000000000000000000000000", d = "151115727451828646838272", x = "20000000000000000000"},
+        {v = ~151115727451828646838272, b = "~100000000000000000000000000000000000000000000000000000000000000000000000000000", oc = "~40000000000000000000000000", d = "~151115727451828646838272", x = "~20000000000000000000"},
+        {v = 302231454903657293676544, b = "1000000000000000000000000000000000000000000000000000000000000000000000000000000", oc = "100000000000000000000000000", d = "302231454903657293676544", x = "40000000000000000000"},
+        {v = ~302231454903657293676544, b = "~1000000000000000000000000000000000000000000000000000000000000000000000000000000", oc = "~100000000000000000000000000", d = "~302231454903657293676544", x = "~40000000000000000000"},
+        {v = 604462909807314587353088, b = "10000000000000000000000000000000000000000000000000000000000000000000000000000000", oc = "200000000000000000000000000", d = "604462909807314587353088", x = "80000000000000000000"},
+        {v = ~604462909807314587353088, b = "~10000000000000000000000000000000000000000000000000000000000000000000000000000000", oc = "~200000000000000000000000000", d = "~604462909807314587353088", x = "~80000000000000000000"},
+        {v = 1208925819614629174706176, b = "100000000000000000000000000000000000000000000000000000000000000000000000000000000", oc = "400000000000000000000000000", d = "1208925819614629174706176", x = "100000000000000000000"},
+        {v = ~1208925819614629174706176, b = "~100000000000000000000000000000000000000000000000000000000000000000000000000000000", oc = "~400000000000000000000000000", d = "~1208925819614629174706176", x = "~100000000000000000000"},
+        {v = 2417851639229258349412352, b = "1000000000000000000000000000000000000000000000000000000000000000000000000000000000", oc = "1000000000000000000000000000", d = "2417851639229258349412352", x = "200000000000000000000"},
+        {v = ~2417851639229258349412352, b = "~1000000000000000000000000000000000000000000000000000000000000000000000000000000000", oc = "~1000000000000000000000000000", d = "~2417851639229258349412352", x = "~200000000000000000000"},
+        {v = 4835703278458516698824704, b = "10000000000000000000000000000000000000000000000000000000000000000000000000000000000", oc = "2000000000000000000000000000", d = "4835703278458516698824704", x = "400000000000000000000"},
+        {v = ~4835703278458516698824704, b = "~10000000000000000000000000000000000000000000000000000000000000000000000000000000000", oc = "~2000000000000000000000000000", d = "~4835703278458516698824704", x = "~400000000000000000000"},
+        {v = 9671406556917033397649408, b = "100000000000000000000000000000000000000000000000000000000000000000000000000000000000", oc = "4000000000000000000000000000", d = "9671406556917033397649408", x = "800000000000000000000"},
+        {v = ~9671406556917033397649408, b = "~100000000000000000000000000000000000000000000000000000000000000000000000000000000000", oc = "~4000000000000000000000000000", d = "~9671406556917033397649408", x = "~800000000000000000000"},
+        {v = 19342813113834066795298816, b = "1000000000000000000000000000000000000000000000000000000000000000000000000000000000000", oc = "10000000000000000000000000000", d = "19342813113834066795298816", x = "1000000000000000000000"},
+        {v = ~19342813113834066795298816, b = "~1000000000000000000000000000000000000000000000000000000000000000000000000000000000000", oc = "~10000000000000000000000000000", d = "~19342813113834066795298816", x = "~1000000000000000000000"},
+        {v = 38685626227668133590597632, b = "10000000000000000000000000000000000000000000000000000000000000000000000000000000000000", oc = "20000000000000000000000000000", d = "38685626227668133590597632", x = "2000000000000000000000"},
+        {v = ~38685626227668133590597632, b = "~10000000000000000000000000000000000000000000000000000000000000000000000000000000000000", oc = "~20000000000000000000000000000", d = "~38685626227668133590597632", x = "~2000000000000000000000"},
+        {v = 77371252455336267181195264, b = "100000000000000000000000000000000000000000000000000000000000000000000000000000000000000", oc = "40000000000000000000000000000", d = "77371252455336267181195264", x = "4000000000000000000000"},
+        {v = ~77371252455336267181195264, b = "~100000000000000000000000000000000000000000000000000000000000000000000000000000000000000", oc = "~40000000000000000000000000000", d = "~77371252455336267181195264", x = "~4000000000000000000000"},
+        {v = 154742504910672534362390528, b = "1000000000000000000000000000000000000000000000000000000000000000000000000000000000000000", oc = "100000000000000000000000000000", d = "154742504910672534362390528", x = "8000000000000000000000"},
+        {v = ~154742504910672534362390528, b = "~1000000000000000000000000000000000000000000000000000000000000000000000000000000000000000", oc = "~100000000000000000000000000000", d = "~154742504910672534362390528", x = "~8000000000000000000000"},
+        {v = 309485009821345068724781056, b = "10000000000000000000000000000000000000000000000000000000000000000000000000000000000000000", oc = "200000000000000000000000000000", d = "309485009821345068724781056", x = "10000000000000000000000"},
+        {v = ~309485009821345068724781056, b = "~10000000000000000000000000000000000000000000000000000000000000000000000000000000000000000", oc = "~200000000000000000000000000000", d = "~309485009821345068724781056", x = "~10000000000000000000000"},
+        {v = 618970019642690137449562112, b = "100000000000000000000000000000000000000000000000000000000000000000000000000000000000000000", oc = "400000000000000000000000000000", d = "618970019642690137449562112", x = "20000000000000000000000"},
+        {v = ~618970019642690137449562112, b = "~100000000000000000000000000000000000000000000000000000000000000000000000000000000000000000", oc = "~400000000000000000000000000000", d = "~618970019642690137449562112", x = "~20000000000000000000000"},
+        {v = 1237940039285380274899124224, b = "1000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000", oc = "1000000000000000000000000000000", d = "1237940039285380274899124224", x = "40000000000000000000000"},
+        {v = ~1237940039285380274899124224, b = "~1000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000", oc = "~1000000000000000000000000000000", d = "~1237940039285380274899124224", x = "~40000000000000000000000"},
+        {v = 2475880078570760549798248448, b = "10000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000", oc = "2000000000000000000000000000000", d = "2475880078570760549798248448", x = "80000000000000000000000"},
+        {v = ~2475880078570760549798248448, b = "~10000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000", oc = "~2000000000000000000000000000000", d = "~2475880078570760549798248448", x = "~80000000000000000000000"},
+        {v = 4951760157141521099596496896, b = "100000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000", oc = "4000000000000000000000000000000", d = "4951760157141521099596496896", x = "100000000000000000000000"},
+        {v = ~4951760157141521099596496896, b = "~100000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000", oc = "~4000000000000000000000000000000", d = "~4951760157141521099596496896", x = "~100000000000000000000000"},
+        {v = 9903520314283042199192993792, b = "1000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000", oc = "10000000000000000000000000000000", d = "9903520314283042199192993792", x = "200000000000000000000000"},
+        {v = ~9903520314283042199192993792, b = "~1000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000", oc = "~10000000000000000000000000000000", d = "~9903520314283042199192993792", x = "~200000000000000000000000"},
+        {v = 19807040628566084398385987584, b = "10000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000", oc = "20000000000000000000000000000000", d = "19807040628566084398385987584", x = "400000000000000000000000"},
+        {v = ~19807040628566084398385987584, b = "~10000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000", oc = "~20000000000000000000000000000000", d = "~19807040628566084398385987584", x = "~400000000000000000000000"},
+        {v = 39614081257132168796771975168, b = "100000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000", oc = "40000000000000000000000000000000", d = "39614081257132168796771975168", x = "800000000000000000000000"},
+        {v = ~39614081257132168796771975168, b = "~100000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000", oc = "~40000000000000000000000000000000", d = "~39614081257132168796771975168", x = "~800000000000000000000000"},
+        {v = 79228162514264337593543950336, b = "1000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000", oc = "100000000000000000000000000000000", d = "79228162514264337593543950336", x = "1000000000000000000000000"},
+        {v = ~79228162514264337593543950336, b = "~1000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000", oc = "~100000000000000000000000000000000", d = "~79228162514264337593543950336", x = "~1000000000000000000000000"},
+        {v = 158456325028528675187087900672, b = "10000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000", oc = "200000000000000000000000000000000", d = "158456325028528675187087900672", x = "2000000000000000000000000"},
+        {v = ~158456325028528675187087900672, b = "~10000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000", oc = "~200000000000000000000000000000000", d = "~158456325028528675187087900672", x = "~2000000000000000000000000"},
+        {v = 316912650057057350374175801344, b = "100000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000", oc = "400000000000000000000000000000000", d = "316912650057057350374175801344", x = "4000000000000000000000000"},
+        {v = ~316912650057057350374175801344, b = "~100000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000", oc = "~400000000000000000000000000000000", d = "~316912650057057350374175801344", x = "~4000000000000000000000000"},
+        {v = 633825300114114700748351602688, b = "1000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000", oc = "1000000000000000000000000000000000", d = "633825300114114700748351602688", x = "8000000000000000000000000"},
+        {v = ~633825300114114700748351602688, b = "~1000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000", oc = "~1000000000000000000000000000000000", d = "~633825300114114700748351602688", x = "~8000000000000000000000000"}
 ]
 
 fun makeReader str =
-	let val len = String.size str
-	    fun reader pos =
-		   if pos = String.size str
-		   then NONE
-		   else SOME (String.sub (str, pos), pos + 1)
-	in reader
-	end
+        let val len = String.size str
+            fun reader pos =
+                   if pos = String.size str
+                   then NONE
+                   else SOME (String.sub (str, pos), pos + 1)
+        in reader
+        end
 
 exception FailRead of StringCvt.radix * string
 exception FailWrite of StringCvt.radix * IntInf.int
 
 fun read2 str = case IntInf.scan StringCvt.BIN (makeReader str) 0 of
-		    NONE => raise (FailRead (StringCvt.BIN, str))
-		    | SOME (v, p) => if p = String.size str
-					then v
-					else raise (FailRead (StringCvt.BIN,
-							      str))
+                    NONE => raise (FailRead (StringCvt.BIN, str))
+                    | SOME (v, p) => if p = String.size str
+                                        then v
+                                        else raise (FailRead (StringCvt.BIN,
+                                                              str))
 
 fun read8 str = case IntInf.scan StringCvt.OCT (makeReader str) 0 of
-		    NONE => raise (FailRead (StringCvt.OCT, str))
-		    | SOME (v, p) => if p = String.size str
-					then v
-					else raise (FailRead (StringCvt.OCT,
-							      str))
+                    NONE => raise (FailRead (StringCvt.OCT, str))
+                    | SOME (v, p) => if p = String.size str
+                                        then v
+                                        else raise (FailRead (StringCvt.OCT,
+                                                              str))
 
 fun read10 str = case IntInf.scan StringCvt.DEC (makeReader str) 0 of
-		    NONE => raise (FailRead (StringCvt.DEC, str))
-		    | SOME (v, p) => if p = String.size str
-					then v
-					else raise (FailRead (StringCvt.DEC,
-							      str))
+                    NONE => raise (FailRead (StringCvt.DEC, str))
+                    | SOME (v, p) => if p = String.size str
+                                        then v
+                                        else raise (FailRead (StringCvt.DEC,
+                                                              str))
 
 fun read16 str = case IntInf.scan StringCvt.HEX (makeReader str) 0 of
-		    NONE => raise (FailRead (StringCvt.HEX, str))
-		    | SOME (v, p) => if p = String.size str
-					then v
-					else raise (FailRead (StringCvt.HEX,
-							      str))
+                    NONE => raise (FailRead (StringCvt.HEX, str))
+                    | SOME (v, p) => if p = String.size str
+                                        then v
+                                        else raise (FailRead (StringCvt.HEX,
+                                                              str))
 
 fun read str = case IntInf.fromString str of
-		    NONE => raise (FailRead (StringCvt.DEC, str))
-		    | SOME v => v
+                    NONE => raise (FailRead (StringCvt.DEC, str))
+                    | SOME v => v
 
 fun toStr2 v = IntInf.fmt StringCvt.BIN v
 
@@ -462,46 +462,46 @@
 
 fun f ({ v: IntInf.int, b: string, oc: string, d: string, x: string}): unit =
        let val bv = read2 b
-	   val ov = read8 oc
-	   val dv = read10 d
-	   val xv = read16 x
-	   val vv = read d
+           val ov = read8 oc
+           val dv = read10 d
+           val xv = read16 x
+           val vv = read d
        in if bv <> v
-	     then raise (FailRead (StringCvt.BIN, b))
-	  else if ov <> v
-	     then raise (FailRead (StringCvt.OCT, oc))
-	  else if dv <> v
-	     then raise (FailRead (StringCvt.DEC, d))
-	  else if xv <> v
-	     then raise (FailRead (StringCvt.HEX, x))
-	  else if vv <> v
-	     then raise (FailRead (StringCvt.DEC, d))
-	  else let val vb = toStr2 v
-		   val vo = toStr8 v
-		   val vd = toStr10 v
-		   val vx = toStr16 v
-		   val vv = toStr v
-		   val (b, oc, d, x) = if v = 0 andalso String.sub (d, 0) = #"~"
-					 then ("0", "0", "0", "0")
-					 else (b, oc, d, x)
-	       in if vb <> b
-		     then raise (FailWrite (StringCvt.BIN, v))
-		  else if vo <> oc
-		     then raise (FailWrite (StringCvt.OCT, v))
-		  else if vd <> d
-		     then raise (FailWrite (StringCvt.DEC, v))
-		  else if vx <> x
-		     then raise (FailWrite (StringCvt.HEX, v))
-		  else if vv <> d
-		     then raise (FailWrite (StringCvt.DEC, v))
-		  else ()
-	       end
+             then raise (FailRead (StringCvt.BIN, b))
+          else if ov <> v
+             then raise (FailRead (StringCvt.OCT, oc))
+          else if dv <> v
+             then raise (FailRead (StringCvt.DEC, d))
+          else if xv <> v
+             then raise (FailRead (StringCvt.HEX, x))
+          else if vv <> v
+             then raise (FailRead (StringCvt.DEC, d))
+          else let val vb = toStr2 v
+                   val vo = toStr8 v
+                   val vd = toStr10 v
+                   val vx = toStr16 v
+                   val vv = toStr v
+                   val (b, oc, d, x) = if v = 0 andalso String.sub (d, 0) = #"~"
+                                         then ("0", "0", "0", "0")
+                                         else (b, oc, d, x)
+               in if vb <> b
+                     then raise (FailWrite (StringCvt.BIN, v))
+                  else if vo <> oc
+                     then raise (FailWrite (StringCvt.OCT, v))
+                  else if vd <> d
+                     then raise (FailWrite (StringCvt.DEC, v))
+                  else if vx <> x
+                     then raise (FailWrite (StringCvt.HEX, v))
+                  else if vv <> d
+                     then raise (FailWrite (StringCvt.DEC, v))
+                  else ()
+               end
        end handle FailRead (base, str) =>
-		     print ("FailRead, base = " ^ (baseToStr base)
-			    ^ ", str = |" ^ str ^ "|\n")
-		  | FailWrite (base, v) =>
-		     print ("FailWrite, base = " ^ (baseToStr base)
-			    ^ ", d = |" ^ d ^ "|\n")
+                     print ("FailRead, base = " ^ (baseToStr base)
+                            ^ ", str = |" ^ str ^ "|\n")
+                  | FailWrite (base, v) =>
+                     print ("FailWrite, base = " ^ (baseToStr base)
+                            ^ ", d = |" ^ d ^ "|\n")
 
 val _ = List.app f arg
 val _ = print "All ok\n"

Modified: mlton/branches/on-20050420-cmm-branch/regression/datatype-with-free-tyvars.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/datatype-with-free-tyvars.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/datatype-with-free-tyvars.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -6,7 +6,7 @@
       val _: u = U y1
       val y2 = T (x2, "foo")
       fun 'b g (T (a, b), bToString: 'b -> string): unit =
-	 print (concat [aToString a, " ", bToString b, "\n"])
+         print (concat [aToString a, " ", bToString b, "\n"])
       val _ = g (y1, Int.toString)
       val _ = g (y2, fn s => s)
    in

Modified: mlton/branches/on-20050420-cmm-branch/regression/date.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/date.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/date.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -8,7 +8,7 @@
 fun range (from, to) p = 
     let open Int 
     in
-	(from > to) orelse (p from) andalso (range (from+1, to) p)
+        (from > to) orelse (p from) andalso (range (from+1, to) p)
     end;
 
 fun checkrange bounds = check o range bounds;
@@ -30,30 +30,30 @@
 local
     open Time Date 
     fun later h = 
-	toString(fromTimeLocal(now() + fromReal (3600.0 * real h))) ^ "\n";
+        toString(fromTimeLocal(now() + fromReal (3600.0 * real h))) ^ "\n";
     fun nowdate () = Date.fromTimeLocal(now());
     fun mkdate(y,mo,d,h,mi,s) =
-	date {year=y, month=mo, day=d, hour=h, minute=mi, second=s,
-	      offset = NONE}
+        date {year=y, month=mo, day=d, hour=h, minute=mi, second=s,
+              offset = NONE}
     fun cmp(dt1, dt2) = compare(mkdate dt1, mkdate dt2)
 
     fun fromto dt = 
-	toString (valOf (fromString (toString dt))) = toString dt
+        toString (valOf (fromString (toString dt))) = toString dt
 
     fun tofrom s =
-	toString (valOf (fromString s)) = s
+        toString (valOf (fromString s)) = s
 
     val y2k = 
-	date {year=2000, month=Jan, day=1, hour=0, minute=0, second=0,
-	      offset = SOME Time.zeroTime}
+        date {year=2000, month=Jan, day=1, hour=0, minute=0, second=0,
+              offset = SOME Time.zeroTime}
 
     val y2kE1 = 
-	date {year=2000, month=Jan, day=1, hour=0, minute=0, second=0,
-	      offset = SOME (Time.fromSeconds 82800) }
+        date {year=2000, month=Jan, day=1, hour=0, minute=0, second=0,
+              offset = SOME (Time.fromSeconds 82800) }
 
     val y2kW1 = 
-	date {year=2000, month=Jan, day=1, hour=0, minute=0, second=0,
-	      offset = SOME (Time.fromSeconds 3600) }
+        date {year=2000, month=Jan, day=1, hour=0, minute=0, second=0,
+              offset = SOME (Time.fromSeconds 3600) }
     
 val _ = 
     ((*print "This is (local time) now:        "; print (later 0);
@@ -73,13 +73,13 @@
      print (toString y2k ^ "\n");   
      print "The UTC millenium minus 5 sec:   "; 
      print (toString (date {year=2000, month=Jan, day=1, hour=0, 
-			    minute=0, second= ~5, offset = SOME Time.zeroTime})
-	    ^ "\n")
+                            minute=0, second= ~5, offset = SOME Time.zeroTime})
+            ^ "\n")
 (*     print "The UTC millenium (local time):  "; 
      print (toString (fromTimeLocal (toTime y2k)) ^ "\n");   
      print "The local millenium (UTC time):  "; 
      print (toString (fromTimeUniv (toTime (mkdate(2000, Jan, 1, 0, 0, 0))))
-	    ^ "\n");   
+            ^ "\n");   
      print "The UTC+01 millenium (UTC):      "; 
      print (toString (fromTimeUniv (toTime y2kE1)) ^ "\n");
      print "The UTC-01 millenium (UTC):      "; 
@@ -113,63 +113,63 @@
 
 val test2 = 
     tst' "test2" (fn _ => 
-	   fmt "%A" (mkdate(1995,May,22,4,0,1)) = "Monday");
+           fmt "%A" (mkdate(1995,May,22,4,0,1)) = "Monday");
 
 val test3 = 
     tst' "test3" (fn _ => 
-	   List.all fromto 
-	   [mkdate(1995,Aug,22,4,0,1),
-	    mkdate(1996,Apr, 5, 0, 7, 21),
-	    mkdate(1996,Mar, 5, 6, 13, 58)]);
+           List.all fromto 
+           [mkdate(1995,Aug,22,4,0,1),
+            mkdate(1996,Apr, 5, 0, 7, 21),
+            mkdate(1996,Mar, 5, 6, 13, 58)]);
 
 val test4 = 
     tst' "test4" (fn _ => 
-	   List.all tofrom 
-	   ["Fri Jul 05 14:25:16 1996",
-	   "Mon Feb 05 04:25:16 1996",
-	   "Sat Jan 06 04:25:16 1996"])
+           List.all tofrom 
+           ["Fri Jul 05 14:25:16 1996",
+           "Mon Feb 05 04:25:16 1996",
+           "Sat Jan 06 04:25:16 1996"])
 
 val test5 = 
     tst' "test5" (fn _ => 
-	   weekDay(mkdate(1962, Jun, 25, 1, 2, 3)) = Mon
-	   andalso weekDay(mkdate(1998, Mar, 6, 1, 2, 3)) = Fri
-	   andalso weekDay(mkdate(1998, Apr, 6, 1, 2, 3)) = Mon
-	   andalso weekDay(mkdate(1900, Feb, 28, 1, 2, 3)) = Wed
-	   andalso weekDay(mkdate(1900, Mar, 1, 1, 2, 3)) = Thu
-	   andalso weekDay(mkdate(1850, Feb, 28, 1, 2, 3)) = Thu
-	   andalso weekDay(mkdate(1850, Mar, 1, 1, 2, 3)) = Fri
-	   andalso weekDay(mkdate(1860, Feb, 28, 1, 2, 3)) = Tue
-	   andalso weekDay(mkdate(1860, Feb, 29, 1, 2, 3)) = Wed
-	   andalso weekDay(mkdate(1860, Mar, 1, 1, 2, 3)) = Thu
-	   andalso weekDay(mkdate(2000, Feb, 28, 1, 2, 3)) = Mon
-	   andalso weekDay(mkdate(2000, Feb, 29, 1, 2, 3)) = Tue
-	   andalso weekDay(mkdate(2000, Mar, 1, 1, 2, 3)) = Wed)
+           weekDay(mkdate(1962, Jun, 25, 1, 2, 3)) = Mon
+           andalso weekDay(mkdate(1998, Mar, 6, 1, 2, 3)) = Fri
+           andalso weekDay(mkdate(1998, Apr, 6, 1, 2, 3)) = Mon
+           andalso weekDay(mkdate(1900, Feb, 28, 1, 2, 3)) = Wed
+           andalso weekDay(mkdate(1900, Mar, 1, 1, 2, 3)) = Thu
+           andalso weekDay(mkdate(1850, Feb, 28, 1, 2, 3)) = Thu
+           andalso weekDay(mkdate(1850, Mar, 1, 1, 2, 3)) = Fri
+           andalso weekDay(mkdate(1860, Feb, 28, 1, 2, 3)) = Tue
+           andalso weekDay(mkdate(1860, Feb, 29, 1, 2, 3)) = Wed
+           andalso weekDay(mkdate(1860, Mar, 1, 1, 2, 3)) = Thu
+           andalso weekDay(mkdate(2000, Feb, 28, 1, 2, 3)) = Mon
+           andalso weekDay(mkdate(2000, Feb, 29, 1, 2, 3)) = Tue
+           andalso weekDay(mkdate(2000, Mar, 1, 1, 2, 3)) = Wed)
 
 val test6 = 
     tst' "test6" (fn _ => 
-	   yearDay(mkdate(1962, Jan, 1, 1, 2, 3)) = 0
-	   andalso yearDay(mkdate(1998, Mar, 6, 1, 2, 3)) = 64
-	   andalso yearDay(mkdate(1900, Feb, 28, 1, 2, 3)) = 58
-	   andalso yearDay(mkdate(1900, Mar, 1, 1, 2, 3)) = 59
-	   andalso yearDay(mkdate(1900, Dec, 31, 1, 2, 3)) = 364
-	   andalso yearDay(mkdate(1850, Feb, 28, 1, 2, 3)) = 58
-	   andalso yearDay(mkdate(1850, Mar, 1, 1, 2, 3)) = 59
-	   andalso yearDay(mkdate(1850, Dec, 31, 1, 2, 3)) = 364
-	   andalso yearDay(mkdate(1860, Feb, 28, 1, 2, 3)) = 58
-	   andalso yearDay(mkdate(1860, Feb, 29, 1, 2, 3)) = 59
-	   andalso yearDay(mkdate(1860, Mar, 1, 1, 2, 3)) = 60
-	   andalso yearDay(mkdate(1860, Dec, 31, 1, 2, 3)) = 365
-	   andalso yearDay(mkdate(2000, Feb, 28, 1, 2, 3)) = 58
-	   andalso yearDay(mkdate(2000, Feb, 29, 1, 2, 3)) = 59
-	   andalso yearDay(mkdate(2000, Mar, 1, 1, 2, 3)) = 60
-	   andalso yearDay(mkdate(2000, Dec, 31, 1, 2, 3)) = 365
-	   andalso yearDay(mkdate(1959, Feb, 28, 1, 2, 3)) = 58
-	   andalso yearDay(mkdate(1959, Mar, 1, 1, 2, 3)) = 59
-	   andalso yearDay(mkdate(1959, Dec, 31, 1, 2, 3)) = 364
-	   andalso yearDay(mkdate(1960, Feb, 28, 1, 2, 3)) = 58
-	   andalso yearDay(mkdate(1960, Feb, 29, 1, 2, 3)) = 59
-	   andalso yearDay(mkdate(1960, Mar, 1, 1, 2, 3)) = 60
-	   andalso yearDay(mkdate(1960, Dec, 31, 1, 2, 3)) = 365)
+           yearDay(mkdate(1962, Jan, 1, 1, 2, 3)) = 0
+           andalso yearDay(mkdate(1998, Mar, 6, 1, 2, 3)) = 64
+           andalso yearDay(mkdate(1900, Feb, 28, 1, 2, 3)) = 58
+           andalso yearDay(mkdate(1900, Mar, 1, 1, 2, 3)) = 59
+           andalso yearDay(mkdate(1900, Dec, 31, 1, 2, 3)) = 364
+           andalso yearDay(mkdate(1850, Feb, 28, 1, 2, 3)) = 58
+           andalso yearDay(mkdate(1850, Mar, 1, 1, 2, 3)) = 59
+           andalso yearDay(mkdate(1850, Dec, 31, 1, 2, 3)) = 364
+           andalso yearDay(mkdate(1860, Feb, 28, 1, 2, 3)) = 58
+           andalso yearDay(mkdate(1860, Feb, 29, 1, 2, 3)) = 59
+           andalso yearDay(mkdate(1860, Mar, 1, 1, 2, 3)) = 60
+           andalso yearDay(mkdate(1860, Dec, 31, 1, 2, 3)) = 365
+           andalso yearDay(mkdate(2000, Feb, 28, 1, 2, 3)) = 58
+           andalso yearDay(mkdate(2000, Feb, 29, 1, 2, 3)) = 59
+           andalso yearDay(mkdate(2000, Mar, 1, 1, 2, 3)) = 60
+           andalso yearDay(mkdate(2000, Dec, 31, 1, 2, 3)) = 365
+           andalso yearDay(mkdate(1959, Feb, 28, 1, 2, 3)) = 58
+           andalso yearDay(mkdate(1959, Mar, 1, 1, 2, 3)) = 59
+           andalso yearDay(mkdate(1959, Dec, 31, 1, 2, 3)) = 364
+           andalso yearDay(mkdate(1960, Feb, 28, 1, 2, 3)) = 58
+           andalso yearDay(mkdate(1960, Feb, 29, 1, 2, 3)) = 59
+           andalso yearDay(mkdate(1960, Mar, 1, 1, 2, 3)) = 60
+           andalso yearDay(mkdate(1960, Dec, 31, 1, 2, 3)) = 365)
 
 fun addh h = 
     let val dt = mkdate(1998, Apr, 6, h, 0, 0)
@@ -177,18 +177,18 @@
 
 val test7 = 
     tst' "test7" (fn _ => 
-	   addh 0 = (Apr, 6, 0)
-	   andalso addh 23 = (Apr, 6, 23)
-	   andalso addh 24 = (Apr, 7, 0)
-	   andalso addh 36 = (Apr, 7, 12)
-	   andalso addh 600 = (May, 1, 0)
-	   andalso addh 610 = (May, 1, 10)
-	   andalso addh 625 = (May, 2, 1))
+           addh 0 = (Apr, 6, 0)
+           andalso addh 23 = (Apr, 6, 23)
+           andalso addh 24 = (Apr, 7, 0)
+           andalso addh 36 = (Apr, 7, 12)
+           andalso addh 600 = (May, 1, 0)
+           andalso addh 610 = (May, 1, 10)
+           andalso addh 625 = (May, 2, 1))
 
 val test8 = 
     tst' "test8" (fn _ => 
-	   hour (mkdate(1998, Mar, 28, 12, 0, 0)) = 12
-	   andalso hour (mkdate(1998, Mar, 28, 36, 0, 0)) = 12)
+           hour (mkdate(1998, Mar, 28, 12, 0, 0)) = 12
+           andalso hour (mkdate(1998, Mar, 28, 36, 0, 0)) = 12)
 
 in
 end

Modified: mlton/branches/on-20050420-cmm-branch/regression/deep-flatten.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/deep-flatten.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/deep-flatten.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -7,4 +7,4 @@
 val _ = r := (3, 4)
 val _ = f r
 val _ = print (concat [Int.toString (#1 (!r)), " ",
-		       Int.toString (#2 (!r)), "\n"])
+                       Int.toString (#2 (!r)), "\n"])

Modified: mlton/branches/on-20050420-cmm-branch/regression/echo.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/echo.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/echo.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -21,15 +21,15 @@
                 NONE => let in
                           Posix.Process.wait ();
                           print (concat ["server processed ",
-					 Int.toString b,
-					 " bytes\n"])
+                                         Int.toString b,
+                                         " bytes\n"])
                       end
               | SOME i =>
-		   let in 
-		      TextIO.output(outs, i);
-		      TextIO.flushOut outs;
-		      s (b + 19)
-		   end
+                   let in 
+                      TextIO.output(outs, i);
+                      TextIO.flushOut outs;
+                      s (b + 19)
+                   end
     in s 0
     end
 
@@ -42,7 +42,7 @@
                   end
           | c n = let in
                       TextIO.output(outs, data);
-		      TextIO.flushOut outs;
+                      TextIO.flushOut outs;
                       TextIO.inputLine ins = SOME data
                           orelse raise Error "Didn't receive the same data";
                       c (n - 1)

Modified: mlton/branches/on-20050420-cmm-branch/regression/eqtype.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/eqtype.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/eqtype.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,88 +1,88 @@
-signature T =	
+signature T =   
    sig
       eqtype s
       structure V:
-	 sig
-	    datatype v = V
-	 end where type v = s
+         sig
+            datatype v = V
+         end where type v = s
    end 
 
 signature S =
    sig
       eqtype v
       structure T: sig
-		      eqtype t
-		   end where type t = v
+                      eqtype t
+                   end where type t = v
    end
 
 signature S =
    sig
       eqtype v
       structure S: sig
-		      type 'a t
-		   end where type 'a t = v
+                      type 'a t
+                   end where type 'a t = v
       structure T: sig
-		      eqtype t
-		   end where type t = int S.t
+                      eqtype t
+                   end where type t = int S.t
    end
 
 signature S =
    sig
       eqtype v
       structure S: sig
-		      type 'a t
-		   end where type 'a t = v
+                      type 'a t
+                   end where type 'a t = v
       structure T: sig
-		      eqtype t
-		   end where type t = real S.t
+                      eqtype t
+                   end where type t = real S.t
    end
 
 signature S =
    sig
       eqtype v
       structure S: sig
-		      type 'a t
-		      type u = real t
-		   end where type 'a t = v
+                      type 'a t
+                      type u = real t
+                   end where type 'a t = v
       structure T: sig
-		      eqtype t
-		   end where type t = S.u
+                      eqtype t
+                   end where type t = S.u
    end
 
 functor F (eqtype v
-	   structure S: sig
-			   type 'a t
-			   type u = real t
-			end where type 'a t = v) =
+           structure S: sig
+                           type 'a t
+                           type u = real t
+                        end where type 'a t = v) =
    struct
       fun f (x: 'a S.t) = x = x
       fun f (x: S.u) = x = x
    end
 
-signature T =	
+signature T =   
    sig
       eqtype s
       structure U:
-	 sig
-	    type 'a t
-	    type u = (int * real) t
-	 end where type 'a t = s
+         sig
+            type 'a t
+            type u = (int * real) t
+         end where type 'a t = s
       structure V:
-	 sig
-	    datatype v = V
-	 end where type v = U.u
+         sig
+            datatype v = V
+         end where type v = U.u
    end
 
 structure T: T =
    struct
       datatype s = V
       structure U =
-	 struct
-	    type 'a t = s
-	    type u = (int * real) t
-	 end
+         struct
+            type 'a t = s
+            type u = (int * real) t
+         end
       structure V =
-	 struct
-	    datatype v = datatype s
-	 end
+         struct
+            datatype v = datatype s
+         end
    end

Modified: mlton/branches/on-20050420-cmm-branch/regression/ex.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/ex.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/ex.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,12 +1,12 @@
 exception Foo of unit ref
 
 fun f (x, r): int = if x then raise (Foo r) 
-		   else (f (true, r); 1 + 2)
+                   else (f (true, r); 1 + 2)
    
 fun loop (r: unit ref): int =
    let val r' = ref ()
    in if r = r'
-	 then 13
+         then 13
       else f (false, r') handle Foo r => loop r
    end
 

Modified: mlton/branches/on-20050420-cmm-branch/regression/exnHistory.ok
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/exnHistory.ok	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/exnHistory.ok	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,4 @@
+f.raise exnHistory.sml 3.18
 f exnHistory.sml 1.5
 f exnHistory.sml 1.5
 f exnHistory.sml 1.5

Modified: mlton/branches/on-20050420-cmm-branch/regression/exnHistory.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/exnHistory.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/exnHistory.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -4,4 +4,4 @@
    else f (x - 1) handle Overflow => 13
 
 val _ = (f 10; ()) handle e => (List.app (fn s => print (concat [s, "\n"]))
-				(SMLofNJ.exnHistory e))
+                                (SMLofNJ.exnHistory e))

Modified: mlton/branches/on-20050420-cmm-branch/regression/exnHistory3.ok
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/exnHistory3.ok	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/exnHistory3.ok	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,4 @@
+f.raise exnHistory3.sml 5.18
 f exnHistory3.sml 3.5
 f exnHistory3.sml 3.5
 f exnHistory3.sml 3.5
@@ -10,6 +11,7 @@
 f exnHistory3.sml 3.5
 f exnHistory3.sml 3.5
 ZZZ
+f.raise exnHistory3.sml 5.18
 f exnHistory3.sml 3.5
 f exnHistory3.sml 3.5
 f exnHistory3.sml 3.5

Modified: mlton/branches/on-20050420-cmm-branch/regression/exnHistory3.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/exnHistory3.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/exnHistory3.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -6,7 +6,7 @@
    else f (x - 1) handle Overflow => 13
 
 val _ = (f 10; ()) handle e => (List.app (fn s => print (concat [s, "\n"]))
-				(SMLofNJ.exnHistory e))
+                                (SMLofNJ.exnHistory e))
 val _ = print "ZZZ\n"
 val _ = (f 10; ()) handle e => (List.app (fn s => print (concat [s, "\n"]))
-				(SMLofNJ.exnHistory e))
+                                (SMLofNJ.exnHistory e))


Property changes on: mlton/branches/on-20050420-cmm-branch/regression/fail
___________________________________________________________________
Name: svn:ignore
   - PM
run
   + PM
run


Deleted: mlton/branches/on-20050420-cmm-branch/regression/fail/.cvsignore
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/fail/.cvsignore	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/fail/.cvsignore	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,2 +0,0 @@
-PM
-run

Copied: mlton/branches/on-20050420-cmm-branch/regression/fail/.ignore (from rev 4358, mlton/trunk/regression/fail/.ignore)

Modified: mlton/branches/on-20050420-cmm-branch/regression/fail/eqtype.1.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/fail/eqtype.1.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/fail/eqtype.1.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,11 +1,11 @@
 (* This should fail because v is an eqtype and s does not admit equality.
  * Hence, the side condition on rule 64 fails.
  *)
-signature T =	
+signature T =   
    sig
       type s
       structure V:
-	 sig
-	    datatype v = V
-	 end where type v = s
+         sig
+            datatype v = V
+         end where type v = s
    end 

Modified: mlton/branches/on-20050420-cmm-branch/regression/fail/functor.1.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/fail/functor.1.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/fail/functor.1.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,17 +1,17 @@
 val b = ref false
 val r = ref NONE
 functor F (type t
-	   val x: t
-	   val f: t -> string) =
+           val x: t
+           val f: t -> string) =
    struct
       val _ =
-	 if !b
-	    then print (concat [f (valOf (! r)), "\n"])
-	 else (b := true; r := SOME x)
+         if !b
+            then print (concat [f (valOf (! r)), "\n"])
+         else (b := true; r := SOME x)
    end
 structure S = F (type t = int
-		 val x = 13
-		 val f = Int.toString)
+                 val x = 13
+                 val f = Int.toString)
 structure S = F (type t = real
-		 val x = 13.0
-		 val f = Real.toString)
+                 val x = 13.0
+                 val f = Real.toString)

Modified: mlton/branches/on-20050420-cmm-branch/regression/fail/modules.15.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/fail/modules.15.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/fail/modules.15.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -3,7 +3,7 @@
    sig
       type t
       structure Z:
-	 sig
-	    datatype u = U
-	 end where type u = t
+         sig
+            datatype u = U
+         end where type u = t
    end

Modified: mlton/branches/on-20050420-cmm-branch/regression/fail/modules.16.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/fail/modules.16.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/fail/modules.16.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -2,19 +2,19 @@
    sig
       eqtype t
       structure Z:
-	 sig
-	    datatype u = U
-	 end
+         sig
+            datatype u = U
+         end
    end =
    struct
       structure Z =
-	 struct
-	    datatype u = U
-	 end
+         struct
+            datatype u = U
+         end
       datatype t = datatype Z.u
       structure Z =
-	 struct
-	    type u = Z.u
-	    datatype z = datatype Z.u
-	 end
+         struct
+            type u = Z.u
+            datatype z = datatype Z.u
+         end
    end

Modified: mlton/branches/on-20050420-cmm-branch/regression/fail/modules.17.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/fail/modules.17.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/fail/modules.17.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -2,19 +2,19 @@
    sig
       eqtype t
       structure Z:
-	 sig
-	    datatype u = U
-	 end where type u = t
+         sig
+            datatype u = U
+         end where type u = t
    end =
    struct
       structure Z =
-	 struct
-	    datatype u = U
-	 end
+         struct
+            datatype u = U
+         end
       datatype t = datatype Z.u
       structure Z =
-	 struct
-	    type u = Z.u
-	    datatype z = datatype Z.u
-	 end
+         struct
+            type u = Z.u
+            datatype z = datatype Z.u
+         end
    end

Modified: mlton/branches/on-20050420-cmm-branch/regression/fail/modules.18.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/fail/modules.18.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/fail/modules.18.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,9 @@
 structure T =
    struct
       structure X =
-	 struct
-	    type t = int
-	 end
+         struct
+            type t = int
+         end
    end
 signature S =
    sig

Modified: mlton/branches/on-20050420-cmm-branch/regression/fail/modules.19.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/fail/modules.19.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/fail/modules.19.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,5 +1,5 @@
 functor F (type t
-	   type u) =
+           type u) =
    struct
       val id: t -> u = fn x => x
    end

Modified: mlton/branches/on-20050420-cmm-branch/regression/fail/modules.23.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/fail/modules.23.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/fail/modules.23.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -4,7 +4,7 @@
    end =
    struct
       fun f x =
-	 if x = x
-	    then []
-	 else [x]
+         if x = x
+            then []
+         else [x]
    end

Modified: mlton/branches/on-20050420-cmm-branch/regression/fail/modules.25.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/fail/modules.25.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/fail/modules.25.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,13 +1,13 @@
 structure S:
    sig
       structure T:
-	 sig
-	    datatype t = A | B
-	 end
+         sig
+            datatype t = A | B
+         end
    end =
    struct
       structure T =
-	 struct
-	    datatype t = B | C
-	 end
+         struct
+            datatype t = B | C
+         end
    end

Modified: mlton/branches/on-20050420-cmm-branch/regression/fail/modules.3.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/fail/modules.3.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/fail/modules.3.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,7 +1,7 @@
 functor F (type t
-	   datatype u = U of t
-	   eqtype v
-	   sharing type t = v) =
+           datatype u = U of t
+           eqtype v
+           sharing type t = v) =
    struct
       fun f (u: u) = u = u
    end

Modified: mlton/branches/on-20050420-cmm-branch/regression/fail/modules.40.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/fail/modules.40.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/fail/modules.40.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -2,9 +2,9 @@
    sig
       type t
       structure S:
-	 sig
-	    type u = t
-	    type v
-	    sharing type u = v
-	 end
+         sig
+            type u = t
+            type v
+            sharing type u = v
+         end
    end

Modified: mlton/branches/on-20050420-cmm-branch/regression/fail/modules.49.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/fail/modules.49.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/fail/modules.49.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -4,12 +4,12 @@
    end
 
 functor F (structure S1: SIG
-	   structure S2: SIG
-	   sharing S1 = S2) =
+           structure S2: SIG
+           sharing S1 = S2) =
    struct
    end
 
 structure S1: SIG = struct type t = int end
 structure S2: SIG = struct type t = real end
 structure Z = F (structure S1 = S1
-		 structure S2 = S2)
+                 structure S2 = S2)

Modified: mlton/branches/on-20050420-cmm-branch/regression/fail/modules.50.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/fail/modules.50.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/fail/modules.50.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -9,7 +9,7 @@
    end where type S1.t = int =
    struct
       structure S1: SIG =
-	 struct
-	    type t = real
-	 end
+         struct
+            type t = real
+         end
    end

Modified: mlton/branches/on-20050420-cmm-branch/regression/fail/modules.51.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/fail/modules.51.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/fail/modules.51.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -8,11 +8,11 @@
    end =
    struct
       val f =
-	 let
-	    val r = ref NONE
-	 in
-	    fn z => (!r before (r := z))
-	 end
+         let
+            val r = ref NONE
+         in
+            fn z => (!r before (r := z))
+         end
    end
 
 val _ = S.f (SOME 13)

Modified: mlton/branches/on-20050420-cmm-branch/regression/fail/rank.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/fail/rank.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/fail/rank.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,16 +1,16 @@
 local
 val f = let val f = (fn x => x) (fn x => x)
-	in f
-	end
+        in f
+        end
 
 datatype t = A
 
 val g = fn x => let val d = #1 x
-		    val k = #2 x
-		    val s = f (d,k)
-		    val _ = if true then (d,k) else x
-		in s
-		end
+                    val k = #2 x
+                    val s = f (d,k)
+                    val _ = if true then (d,k) else x
+                in s
+                end
 in
 val a : t * t = g (A,A)
 end
\ No newline at end of file

Modified: mlton/branches/on-20050420-cmm-branch/regression/fail/sharing.2.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/fail/sharing.2.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/fail/sharing.2.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,8 +1,8 @@
 functor F (structure A: sig type t end
-	   structure B: sig end
-	   structure C: sig type t end
-	   sharing A = B
-	   sharing B = C) =
+           structure B: sig end
+           structure C: sig type t end
+           sharing A = B
+           sharing B = C) =
    struct
       val _: A.t -> C.t = fn x => x
    end

Modified: mlton/branches/on-20050420-cmm-branch/regression/fast.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/fast.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/fast.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,8 +1,8 @@
 fun loop (left: Int.int): unit =
-	case Int.compare (left, 0) of
-	LESS => ()
-	| EQUAL => ()
-	| GREATER => loop (left + ~1)
+        case Int.compare (left, 0) of
+        LESS => ()
+        | EQUAL => ()
+        | GREATER => loop (left + ~1)
 
 val _ = loop 100000000
 

Modified: mlton/branches/on-20050420-cmm-branch/regression/fast2.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/fast2.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/fast2.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,7 +1,7 @@
 fun loop (left: Int.int): unit =
-	if left = 0
-	   then ()
-	   else loop (left + ~1)
+        if left = 0
+           then ()
+           else loop (left + ~1)
 
 val _ = loop 100000000
 

Modified: mlton/branches/on-20050420-cmm-branch/regression/ffi-opaque.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/ffi-opaque.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/ffi-opaque.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -17,7 +17,7 @@
 
 val _ = fn () => f S.x
 
-val e = _export "g1": S.t -> unit;
+val e = _export "g1": (S.t -> unit) -> unit;
 
 val _ = fn () => e S.g
 
@@ -40,6 +40,6 @@
 
 val _ = fn () => S.f p
 
-val e = _export "g2": S.t;
+val e = _export "g2": S.t -> unit;
 
 val _ = fn () => e S.x

Modified: mlton/branches/on-20050420-cmm-branch/regression/fft.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/fft.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/fft.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -45,10 +45,10 @@
         val a = fft (evens x, n)
         val cb = fmul (0.0,pi/(real n),fft (odds x, n))
     in
-	let val l1 =  zipWith ~+ (a,cb)
-	    val l2 =  zipWith ~- (a,cb)
-	in (*resetRegions a; resetRegions cb;*) l1 @ l2
-	end
+        let val l1 =  zipWith ~+ (a,cb)
+            val l2 =  zipWith ~- (a,cb)
+        in (*resetRegions a; resetRegions cb;*) l1 @ l2
+        end
     end
 
 local val a = 16807.0 and m = 2147483678.0
@@ -65,8 +65,8 @@
 val n = 256 * 256
 
 fun run () = (pr "\nfft by Torben Mogensen (torbenm@diku.dk)\n\nfft'ing... ";
-	      let val r = fft (zip (#3(mkList(7.0,n,[])),
-				    #3(mkList(8.0,n,[]))), n) in
-	      pr " done\n" end);
+              let val r = fft (zip (#3(mkList(7.0,n,[])),
+                                    #3(mkList(8.0,n,[]))), n) in
+              pr " done\n" end);
 
 val _ = run ()

Modified: mlton/branches/on-20050420-cmm-branch/regression/filesys.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/filesys.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/filesys.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -8,7 +8,7 @@
 fun range (from, to) p = 
     let open Int 
     in
-	(from > to) orelse (p from) andalso (range (from+1, to) p)
+        (from > to) orelse (p from) andalso (range (from+1, to) p)
     end;
 
 fun checkrange bounds = check o range bounds;
@@ -28,9 +28,9 @@
  *)
 
 (* The test requires three symbolic links to be present in the current directory:
-	testlink -> README
-	testcycl -> testcycl 
-	testbadl -> exists.not
+        testlink -> README
+        testcycl -> testcycl 
+        testbadl -> exists.not
    Moreover, the file README must exist and the file exists.not not.
    Also, the test requires one hard link between file hardlinkA and file hardlinkB. 
 *)
@@ -45,7 +45,7 @@
 
 val test1a = tst0 "test1a" ((mkDir "testdir" seq "OK") handle _ => "WRONG")
 val test1b = tst0 "test1b" ((mkDir "testdir" seq "WRONG")
-			    handle OS.SysErr _ => "OK" | _ => "WRONG")
+                            handle OS.SysErr _ => "OK" | _ => "WRONG")
 
 val test2 = tst' "test2" (fn _ => isDir "testdir");
     
@@ -67,27 +67,27 @@
 val test5 = tst0 "test5" ((rmDir "exists.not" seq "OK") handle _ => "WRONG")
 
 val test6a = tst0 "test6a" ((openDir "exists.not" seq "WRONG") 
-			    handle OS.SysErr _ => "OK" | _ => "WRONG")
+                            handle OS.SysErr _ => "OK" | _ => "WRONG")
 val test6b = tst0 "test6b" ((isDir "exists.not" seq "WRONG")
-			    handle OS.SysErr _ => "OK" | _ => "WRONG")
+                            handle OS.SysErr _ => "OK" | _ => "WRONG")
 val test6c = tst0 "test6c" ((rmDir "exists.not" seq "WRONG")
-			    handle OS.SysErr _ => "OK" | _ => "WRONG")
+                            handle OS.SysErr _ => "OK" | _ => "WRONG")
 val test6d = tst0 "test6d" ((chDir "exists.not" seq "WRONG")
-			    handle OS.SysErr _ => "OK" | _ => "WRONG")
+                            handle OS.SysErr _ => "OK" | _ => "WRONG")
 val test6e = tst0 "test6e" ((fullPath "exists.not" seq "WRONG")
-			    handle OS.SysErr _ => "OK" | _ => "WRONG")
+                            handle OS.SysErr _ => "OK" | _ => "WRONG")
 val test6f = tst0 "test6f" ((realPath "exists.not" seq "WRONG")
-			    handle OS.SysErr _ => "OK" | _ => "WRONG")
+                            handle OS.SysErr _ => "OK" | _ => "WRONG")
 val test6g = tst0 "test6g" ((modTime "exists.not" seq "WRONG")
-			    handle OS.SysErr _ => "OK" | _ => "WRONG")
+                            handle OS.SysErr _ => "OK" | _ => "WRONG")
 val test6h = tst0 "test6h" ((setTime("exists.not", NONE) seq "WRONG")
-			    handle OS.SysErr _ => "OK" | _ => "WRONG")
+                            handle OS.SysErr _ => "OK" | _ => "WRONG")
 val test6i = tst0 "test6i" ((remove "exists.not" seq "WRONG")
-			    handle OS.SysErr _ => "OK" | _ => "WRONG")
+                            handle OS.SysErr _ => "OK" | _ => "WRONG")
 val test6j = tst0 "test6j" ((rename{old="exists.not", new="testdir2"} seq "WRONG")
-			    handle OS.SysErr _ => "OK" | _ => "WRONG")
+                            handle OS.SysErr _ => "OK" | _ => "WRONG")
 val test6k = tst0 "test6k" ((fileSize "exists.not" seq "WRONG")
-			    handle OS.SysErr _ => "OK" | _ => "WRONG")
+                            handle OS.SysErr _ => "OK" | _ => "WRONG")
 val test6l = tst' "test6l" (fn _ => not (access("exists.not", [])));
 
 val _ = mkDir "testdir";
@@ -96,17 +96,17 @@
     val dstr = openDir "testdir";
 in
     val test7a = 
-	tst' "test7a" (fn _ => NONE = readDir dstr);
+        tst' "test7a" (fn _ => NONE = readDir dstr);
     val _ = rewindDir dstr;
     val test7b = 
-	tst' "test7b" (fn _ => NONE = readDir dstr);
+        tst' "test7b" (fn _ => NONE = readDir dstr);
     val _ = closeDir dstr;
     val test7c = tst0 "test7c" ((readDir dstr seq "WRONG")
-				handle OS.SysErr _ => "OK" | _ => "WRONG")
+                                handle OS.SysErr _ => "OK" | _ => "WRONG")
     val test7d = tst0 "test7d" ((rewindDir dstr seq "WRONG")
-				handle OS.SysErr _ => "OK" | _ => "WRONG")
+                                handle OS.SysErr _ => "OK" | _ => "WRONG")
     val test7e = tst0 "test7e" ((closeDir dstr seq "OK")
-				handle _ => "WRONG")
+                                handle _ => "WRONG")
 end
 
 val _ =
@@ -124,27 +124,27 @@
 val test8b = 
     tst' "test8b" (fn _ => fullPath "testlink" = getDir() ^ "/README");
 val test8c = tst0 "test8c" ((fullPath "testcycl" seq "WRONG")
-			    handle OS.SysErr _ => "OK" | _ => "WRONG")
+                            handle OS.SysErr _ => "OK" | _ => "WRONG")
 val test8d = tst0 "test8d" ((fullPath "testbadl" seq "WRONG")
-			    handle OS.SysErr _ => "OK" | _ => "WRONG")
+                            handle OS.SysErr _ => "OK" | _ => "WRONG")
 val test8e = tst' "test8e" (fn _ => realPath "." = ".");
 val test8f = tst' "test8f" (fn _ => realPath "testlink" = "README");
 val test8g = tst0 "test8g" ((realPath "testcycl" seq "WRONG")
-			    handle OS.SysErr _ => "OK" | _ => "WRONG")
+                            handle OS.SysErr _ => "OK" | _ => "WRONG")
 val test8h = tst0 "test8h" ((realPath "testbadl" seq "WRONG")
-			    handle OS.SysErr _ => "OK" | _ => "WRONG")
+                            handle OS.SysErr _ => "OK" | _ => "WRONG")
 
 val test9a = 
     tst' "test9a" (fn _ => 
-	   setTime ("README", SOME (Time.fromReal 1E6)) = ());
+           setTime ("README", SOME (Time.fromReal 1E6)) = ());
 val test9b = 
     tst' "test9b" (fn _ => modTime "README" = Time.fromReal 1E6);
     
 val test10a = tst0 "test10a" ((remove "testdir" seq "WRONG")
-			      handle OS.SysErr _ => "OK" | _ => "WRONG")
+                              handle OS.SysErr _ => "OK" | _ => "WRONG")
 val test10b = 
     tst' "test10b" (fn _ => 
-	   rename{old = "testdir", new = "testdir2"} = ());
+           rename{old = "testdir", new = "testdir2"} = ());
 val test10c = 
     tst' "test10c" (fn _ => isDir "testdir2");
 
@@ -157,13 +157,13 @@
 
 val test12a = 
     tst' "test12a" (fn _ => isLink "testcycl" 
-	   andalso isLink "testlink"
-	   andalso isLink "testbadl");
+           andalso isLink "testlink"
+           andalso isLink "testbadl");
 val test12b = 
     tst' "test12b" (fn _ => not (isLink "testdir2"
-			orelse isLink "README"));
+                        orelse isLink "README"));
 val test12c = tst0 "test12c" ((isLink "exists.not" seq "WRONG")
-			      handle OS.SysErr _ => "OK" | _ => "WRONG")
+                              handle OS.SysErr _ => "OK" | _ => "WRONG")
 
 val test13a = 
     tst' "test13a" (fn _ => readLink "testcycl" = "testcycl");
@@ -172,17 +172,17 @@
 val test13c = 
     tst' "test13c" (fn _ => readLink "testbadl" = "exists.not");
 val test13d = tst0 "test13d" ((readLink "testdir2" seq "WRONG")
-			      handle OS.SysErr _ => "OK" | _ => "WRONG")
+                              handle OS.SysErr _ => "OK" | _ => "WRONG")
 val test13e = tst0 "test13e" ((readLink "exists.not" seq "WRONG")
-			      handle OS.SysErr _ => "OK" | _ => "WRONG")
+                              handle OS.SysErr _ => "OK" | _ => "WRONG")
 
 val test14 = tst0 "test14" ((tmpName () seq "OK"))
 
 val test15a = 
     tst' "test15a" (fn _ => 
-	   fileId "." = fileId "."
-	   andalso fileId "testlink" = fileId "README"
- 	   andalso fileId "." <> fileId "README");
+           fileId "." = fileId "."
+           andalso fileId "testlink" = fileId "README"
+           andalso fileId "." <> fileId "README");
 val test15b = 
     tst' "test15b" (fn _ => compare(fileId ".", fileId ".") = EQUAL)
 val test15b1 =
@@ -191,17 +191,17 @@
     tst' "test15b2" (fn _ => compare(fileId "testlink", fileId "README") = EQUAL)
 val test15b3 =
     tst' "test15b3" (fn _ => 
-		     (compare(fileId ".", fileId "README") = LESS 
-		      andalso compare(fileId "README", fileId ".") = GREATER
-		      orelse 
-		      compare(fileId ".", fileId "README") = GREATER 
-		      andalso compare(fileId "README", fileId ".") = LESS));
+                     (compare(fileId ".", fileId "README") = LESS 
+                      andalso compare(fileId "README", fileId ".") = GREATER
+                      orelse 
+                      compare(fileId ".", fileId "README") = GREATER 
+                      andalso compare(fileId "README", fileId ".") = LESS));
 val test15c = tst0 "test15c" ((fileId "exists.not" seq "WRONG")
-			      handle OS.SysErr _ => "OK" | _ => "WRONG")
+                              handle OS.SysErr _ => "OK" | _ => "WRONG")
 val test15d = tst0 "test15d" ((fileId "testbadl" seq "WRONG")
-			      handle OS.SysErr _ => "OK" | _ => "WRONG")
+                              handle OS.SysErr _ => "OK" | _ => "WRONG")
 val test15e = tst0 "test15e" ((fileId "testcycl" seq "WRONG")
-			      handle OS.SysErr _ => "OK" | _ => "WRONG")
+                              handle OS.SysErr _ => "OK" | _ => "WRONG")
 (* Unix only: *)
 
 val _ =
@@ -209,7 +209,7 @@
        then ()
     else TextIO.closeOut (TextIO.openOut "hardlinkA")
     ; if access ("hardlinkB", [])
-	 then ()
+         then ()
       else Posix.FileSys.link {old = "hardlinkA", new = "hardlinkB"})
    
 val test15f = 

Copied: mlton/branches/on-20050420-cmm-branch/regression/filesys.x86-cygwin.ok (from rev 4358, mlton/trunk/regression/filesys.x86-cygwin.ok)

Modified: mlton/branches/on-20050420-cmm-branch/regression/finalize.2.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/finalize.2.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/finalize.2.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -5,13 +5,13 @@
       then ()
    else
       let
-	 val f' = F.new n
-	 val _ = F.addFinalizer (f', fn _ =>
-				 F.withValue
-				 (f, fn n =>
-				  print (concat [Int.toString n, "\n"])))
+         val f' = F.new n
+         val _ = F.addFinalizer (f', fn _ =>
+                                 F.withValue
+                                 (f, fn n =>
+                                  print (concat [Int.toString n, "\n"])))
       in
-	 loop (n - 1, f')
+         loop (n - 1, f')
       end
 
 val r = loop (10, F.new 13)

Copied: mlton/branches/on-20050420-cmm-branch/regression/finalize.3.ok (from rev 4358, mlton/trunk/regression/finalize.3.ok)

Copied: mlton/branches/on-20050420-cmm-branch/regression/finalize.3.sml (from rev 4358, mlton/trunk/regression/finalize.3.sml)

Copied: mlton/branches/on-20050420-cmm-branch/regression/finalize.4.ok (from rev 4358, mlton/trunk/regression/finalize.4.ok)

Copied: mlton/branches/on-20050420-cmm-branch/regression/finalize.4.sml (from rev 4358, mlton/trunk/regression/finalize.4.sml)

Copied: mlton/branches/on-20050420-cmm-branch/regression/finalize.5.ok (from rev 4358, mlton/trunk/regression/finalize.5.ok)

Copied: mlton/branches/on-20050420-cmm-branch/regression/finalize.5.sml (from rev 4358, mlton/trunk/regression/finalize.5.sml)

Modified: mlton/branches/on-20050420-cmm-branch/regression/finalize.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/finalize.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/finalize.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -2,15 +2,15 @@
 
 val n = 4
 val fs = Array.tabulate (n, fn i =>
-			 let
-			    val f = F.new i
-			    val _ = 
-			       F.addFinalizer
-			       (f, fn i =>
-				print (concat [Int.toString i, " gone.\n"]))
-			 in
-			    f
-			 end)
+                         let
+                            val f = F.new i
+                            val _ = 
+                               F.addFinalizer
+                               (f, fn i =>
+                                print (concat [Int.toString i, " gone.\n"]))
+                         in
+                            f
+                         end)
 fun sub i = F.withValue (Array.sub (fs, i), fn i => i)
 val f = F.new 13
 fun clear i = Array.update (fs, i, f)

Modified: mlton/branches/on-20050420-cmm-branch/regression/fixed-integer.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/fixed-integer.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/fixed-integer.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -3,211 +3,211 @@
       fun foreach (l, f) = List.app f l
 
       val m = concat ["Int", Int.toString (valOf I.precision)]
-	 
+         
       val _ = print (concat ["Testing ", m, "\n"])
-	 
+         
       val nums =
-	 [valOf I.maxInt,
-	  I.- (valOf I.maxInt, I.fromInt 1)]
-	 @ (List.foldl
-	    (fn (i, ac) =>
-	     case SOME (I.fromInt i) handle Overflow => NONE of
-		NONE => ac
-	      | SOME i => i :: ac)
-	    []
-	    [100, 10, 5, 2, 1, 0, ~1, ~2, ~5, ~10, ~100])
-	 @ [I.+ (I.fromInt 1, valOf I.minInt),
-	    valOf I.minInt]
+         [valOf I.maxInt,
+          I.- (valOf I.maxInt, I.fromInt 1)]
+         @ (List.foldl
+            (fn (i, ac) =>
+             case SOME (I.fromInt i) handle Overflow => NONE of
+                NONE => ac
+              | SOME i => i :: ac)
+            []
+            [100, 10, 5, 2, 1, 0, ~1, ~2, ~5, ~10, ~100])
+         @ [I.+ (I.fromInt 1, valOf I.minInt),
+            valOf I.minInt]
 
       fun err msg = print (concat [m, ": ", concat msg, "\n"])
 
       datatype z = datatype StringCvt.radix
       val _ =
-	 foreach
-	 (nums, fn i =>
-	  foreach
-	  ([("toString", I.toString, LargeInt.toString),
-	    ("fmt BIN", I.fmt BIN, LargeInt.fmt BIN),
-	    ("fmt OCT", I.fmt OCT, LargeInt.fmt OCT),
-	    ("fmt DEC", I.fmt DEC, LargeInt.fmt DEC),
-	    ("fmt HEX", I.fmt HEX, LargeInt.fmt HEX)],
-	   fn (name, f, f') =>
-	   let
-	      val s = f i
-	      val s' = f' (I.toLarge i) handle Overflow => "Overflow"
-	   in
-	      if s = s'
-		 then ()
-	      else err [name, " ", s, " <> ", name, " ", s']
-	   end))
+         foreach
+         (nums, fn i =>
+          foreach
+          ([("toString", I.toString, LargeInt.toString),
+            ("fmt BIN", I.fmt BIN, LargeInt.fmt BIN),
+            ("fmt OCT", I.fmt OCT, LargeInt.fmt OCT),
+            ("fmt DEC", I.fmt DEC, LargeInt.fmt DEC),
+            ("fmt HEX", I.fmt HEX, LargeInt.fmt HEX)],
+           fn (name, f, f') =>
+           let
+              val s = f i
+              val s' = f' (I.toLarge i) handle Overflow => "Overflow"
+           in
+              if s = s'
+                 then ()
+              else err [name, " ", s, " <> ", name, " ", s']
+           end))
 
       structure Answer =
-	 struct
-	    datatype t =
-	       Div
-	     | Int of I.int
-	     | Overflow
+         struct
+            datatype t =
+               Div
+             | Int of I.int
+             | Overflow
 
-	    val toString =
-	       fn Div => "Div"
-		| Int i => I.toString i
-		| Overflow => "Overflow"
+            val toString =
+               fn Div => "Div"
+                | Int i => I.toString i
+                | Overflow => "Overflow"
 
-	    fun run (f: unit -> I.int): t =
-	       Int (f ())
-	       handle General.Div => Div
-		    | General.Overflow => Overflow
+            fun run (f: unit -> I.int): t =
+               Int (f ())
+               handle General.Div => Div
+                    | General.Overflow => Overflow
 
-	    val equals: t * t -> bool = op =
-	 end
+            val equals: t * t -> bool = op =
+         end
 
       val _ =
-	 foreach
-	 (nums, fn i =>
-	  let
-	     val a1 = Answer.Int i
-	     val a2 = Answer.run (fn () => I.fromLarge (I.toLarge i))
-	  in
-	     if Answer.equals (a1, a2)
-		then ()
-	     else err ["fromLarge (toLarge ", I.toString i, ") = ",
-		       Answer.toString a2]
-	  end)
+         foreach
+         (nums, fn i =>
+          let
+             val a1 = Answer.Int i
+             val a2 = Answer.run (fn () => I.fromLarge (I.toLarge i))
+          in
+             if Answer.equals (a1, a2)
+                then ()
+             else err ["fromLarge (toLarge ", I.toString i, ") = ",
+                       Answer.toString a2]
+          end)
 
       val _ =
-	 foreach
-	 ([("abs", I.abs, LargeInt.abs),
-	   ("~", I.~, LargeInt.~),
-	   ("fromString o toString",
-	    valOf o I.fromString o I.toString,
-	    valOf o LargeInt.fromString o LargeInt.toString)],
-	  fn (name, f, f') =>
-	  foreach
-	  (nums, fn i =>
-	   let
-	      val a = Answer.run (fn () => f i)
-	      val a' = Answer.run (fn () => I.fromLarge (f' (I.toLarge i)))
-	   in
-	      if Answer.equals (a, a')
-		 then ()
-	      else err [name, " ", I.toString i,
-			" = ", Answer.toString a,
-			" <> ", Answer.toString a']
-	   end))
+         foreach
+         ([("abs", I.abs, LargeInt.abs),
+           ("~", I.~, LargeInt.~),
+           ("fromString o toString",
+            valOf o I.fromString o I.toString,
+            valOf o LargeInt.fromString o LargeInt.toString)],
+          fn (name, f, f') =>
+          foreach
+          (nums, fn i =>
+           let
+              val a = Answer.run (fn () => f i)
+              val a' = Answer.run (fn () => I.fromLarge (f' (I.toLarge i)))
+           in
+              if Answer.equals (a, a')
+                 then ()
+              else err [name, " ", I.toString i,
+                        " = ", Answer.toString a,
+                        " <> ", Answer.toString a']
+           end))
 
       val _ =
-	 foreach
-	 (nums, fn i =>
-	  foreach
-	  ([("BIN", BIN), ("OCT", OCT), ("DEC", DEC), ("HEX", HEX)],
-	   fn (rName, r) =>
-	   let
-	      val i' = valOf (StringCvt.scanString (I.scan r) (I.fmt r i))
-	   in
-	      if i = i'
-		 then ()
-	      else err ["scan ", rName, " ", I.toString i, " = ", I.toString i']
-	   end))
+         foreach
+         (nums, fn i =>
+          foreach
+          ([("BIN", BIN), ("OCT", OCT), ("DEC", DEC), ("HEX", HEX)],
+           fn (rName, r) =>
+           let
+              val i' = valOf (StringCvt.scanString (I.scan r) (I.fmt r i))
+           in
+              if i = i'
+                 then ()
+              else err ["scan ", rName, " ", I.toString i, " = ", I.toString i']
+           end))
 
       val _ =
-	 foreach
-	 ([("sign", I.sign, LargeInt.sign),
-	   ("toInt", I.toInt, LargeInt.toInt)],
-	  fn (name, f, f') =>
-	  foreach
-	  (nums, fn i =>
-	   let
-	      val a = Answer.run (fn () => I.fromInt (f i))
-	      val a' = Answer.run (fn () => I.fromInt (f' (I.toLarge i)))
-	   in
-	      if Answer.equals (a, a')
-		 then ()
-	      else err [name, " ", I.toString i,
-			" = ", Answer.toString a,
-			" <> ", Answer.toString a']
-	   end))
-	 
+         foreach
+         ([("sign", I.sign, LargeInt.sign),
+           ("toInt", I.toInt, LargeInt.toInt)],
+          fn (name, f, f') =>
+          foreach
+          (nums, fn i =>
+           let
+              val a = Answer.run (fn () => I.fromInt (f i))
+              val a' = Answer.run (fn () => I.fromInt (f' (I.toLarge i)))
+           in
+              if Answer.equals (a, a')
+                 then ()
+              else err [name, " ", I.toString i,
+                        " = ", Answer.toString a,
+                        " <> ", Answer.toString a']
+           end))
+         
       val _ =
-	 foreach
-	 ([("+", I.+, LargeInt.+),
-	   ("-", I.-, LargeInt.-),
-	   ("*", I.*, LargeInt.* ),
-	   ("div", I.div, LargeInt.div),
-	   ("max", I.max, LargeInt.max),
-	   ("min", I.min, LargeInt.min),
-	   ("mod", I.mod, LargeInt.mod),
-	   ("quot", I.quot, LargeInt.quot),
-	   ("rem", I.rem, LargeInt.rem)],
-	  fn (name,
-	      f: I.int * I.int -> I.int,
-	      f': LargeInt.int * LargeInt.int -> LargeInt.int) =>
-	  foreach
-	  (nums, fn i: I.int =>
-	   foreach
-	   (nums, fn j: I.int =>
-	    let
-	       val a = Answer.run (fn () => f (i, j))
-	       val a' = Answer.run (fn () =>
-				    I.fromLarge (f' (I.toLarge i, I.toLarge j)))
-	    in
-	       if Answer.equals (a, a')
-		  then ()
-	       else err [I.toString i, " ", name, " ", I.toString j,
-			 " = ", Answer.toString a, " <> ", Answer.toString a']
-	    end)))
+         foreach
+         ([("+", I.+, LargeInt.+),
+           ("-", I.-, LargeInt.-),
+           ("*", I.*, LargeInt.* ),
+           ("div", I.div, LargeInt.div),
+           ("max", I.max, LargeInt.max),
+           ("min", I.min, LargeInt.min),
+           ("mod", I.mod, LargeInt.mod),
+           ("quot", I.quot, LargeInt.quot),
+           ("rem", I.rem, LargeInt.rem)],
+          fn (name,
+              f: I.int * I.int -> I.int,
+              f': LargeInt.int * LargeInt.int -> LargeInt.int) =>
+          foreach
+          (nums, fn i: I.int =>
+           foreach
+           (nums, fn j: I.int =>
+            let
+               val a = Answer.run (fn () => f (i, j))
+               val a' = Answer.run (fn () =>
+                                    I.fromLarge (f' (I.toLarge i, I.toLarge j)))
+            in
+               if Answer.equals (a, a')
+                  then ()
+               else err [I.toString i, " ", name, " ", I.toString j,
+                         " = ", Answer.toString a, " <> ", Answer.toString a']
+            end)))
 
       val _ =
-	 foreach
-	 ([(">", I.>, LargeInt.>),
-	   (">=", I.>=, LargeInt.>=),
-	   ("<", I.<, LargeInt.<),
-	   ("<=", I.<=, LargeInt.<=),
-	   ("sameSign", I.sameSign, LargeInt.sameSign)],
-	  fn (name, f, f') =>
-	  foreach
-	  (nums, fn i: I.int =>
-	   foreach
-	   (nums, fn j: I.int =>
-	    let
-	       val b = f (i, j)
-	       val b' = f' (I.toLarge i, I.toLarge j)
-	    in
-	       if b = b'
-		  then ()
-	       else err [I.toString i, " ", name, " ", I.toString j,
-			 " = ", Bool.toString b, " <> ", Bool.toString b']
-	    end)))
+         foreach
+         ([(">", I.>, LargeInt.>),
+           (">=", I.>=, LargeInt.>=),
+           ("<", I.<, LargeInt.<),
+           ("<=", I.<=, LargeInt.<=),
+           ("sameSign", I.sameSign, LargeInt.sameSign)],
+          fn (name, f, f') =>
+          foreach
+          (nums, fn i: I.int =>
+           foreach
+           (nums, fn j: I.int =>
+            let
+               val b = f (i, j)
+               val b' = f' (I.toLarge i, I.toLarge j)
+            in
+               if b = b'
+                  then ()
+               else err [I.toString i, " ", name, " ", I.toString j,
+                         " = ", Bool.toString b, " <> ", Bool.toString b']
+            end)))
 
       structure Order =
-	 struct
-	    datatype t = datatype order
+         struct
+            datatype t = datatype order
 
-	    val equals: t * t -> bool = op =
+            val equals: t * t -> bool = op =
 
-	    val toString =
-	       fn EQUAL => "EQUAL"
-		| GREATER => "GREATER"
-		| LESS => "LESS"
-	 end
+            val toString =
+               fn EQUAL => "EQUAL"
+                | GREATER => "GREATER"
+                | LESS => "LESS"
+         end
       
       val _ =
-	 foreach
-	 (nums, fn i =>
-	  foreach
-	  (nums, fn j =>
-	   let
-	      val ord = I.compare (i, j)
-	      val ord' = LargeInt.compare (I.toLarge i, I.toLarge j)
-	   in
-	      if Order.equals (ord, ord')
-		 then ()
-	      else err ["compare (", I.toString i, ", ",
-			I.toString j, ") = ",
-			Order.toString ord,
-			" <> ",
-			Order.toString ord']
-	   end))
-		 
+         foreach
+         (nums, fn i =>
+          foreach
+          (nums, fn j =>
+           let
+              val ord = I.compare (i, j)
+              val ord' = LargeInt.compare (I.toLarge i, I.toLarge j)
+           in
+              if Order.equals (ord, ord')
+                 then ()
+              else err ["compare (", I.toString i, ", ",
+                        I.toString j, ") = ",
+                        Order.toString ord,
+                        " <> ",
+                        Order.toString ord']
+           end))
+                 
    end
 
 structure S = Test (Int2)

Modified: mlton/branches/on-20050420-cmm-branch/regression/flat-array.2.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/flat-array.2.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/flat-array.2.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -8,5 +8,5 @@
 
 val _ =
    print (concat [Int.toString (#1 (Array.sub (a, 12))), " ",
-		  Int.toString (Array.sub (#2 (Array.sub (a, 13)), 0)), "\n"])
-		  
+                  Int.toString (Array.sub (#2 (Array.sub (a, 13)), 0)), "\n"])
+                  

Modified: mlton/branches/on-20050420-cmm-branch/regression/flat-array.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/flat-array.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/flat-array.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,7 +1,7 @@
 val n = 20
 
 val a = Array.tabulate (n, fn _ => (Array.array (1, 0),
-				    Array.array (1, 1)))
+                                    Array.array (1, 1)))
 
 val (a1, a2) = Array.sub (a, 13)
 
@@ -10,5 +10,5 @@
 
 val _ =
    print (concat [Int.toString (Array.sub (#1 (Array.sub (a, 12)), 0)), " ",
-		  Int.toString (Array.sub (#2 (Array.sub (a, 13)), 0)), "\n"])
-		  
+                  Int.toString (Array.sub (#2 (Array.sub (a, 13)), 0)), "\n"])
+                  

Modified: mlton/branches/on-20050420-cmm-branch/regression/flexrecord.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/flexrecord.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/flexrecord.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -63,10 +63,10 @@
       val _: string = #1 x
       fun id z = z
       fun g () =
-	 let
-	    val (_, a) = x
-	 in a
-	 end
+         let
+            val (_, a) = x
+         in a
+         end
    in
       g ()
    end
@@ -93,3 +93,9 @@
       ()
    end
 (* flexrecord8 *)
+
+(* flexrecord9 *)
+val g = fn {...} => ()
+and h = fn () => ()
+val () = (h (); g {a = 13})
+(* flexrecord9 *)

Modified: mlton/branches/on-20050420-cmm-branch/regression/format.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/format.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/format.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -39,13 +39,13 @@
    fn f => fn (k, ss) =>
    fn [] => k ("[]" :: ss)
     | x :: xs =>
-	 let
-	    fun loop xs ss =
-	       case xs of
-		  [] => k ("]" :: ss)
-		| x :: xs => f (loop xs, ", " :: ss) x
-	 in f (loop xs, "[" :: ss) x
-	 end
+         let
+            fun loop xs ss =
+               case xs of
+                  [] => k ("]" :: ss)
+                | x :: xs => f (loop xs, ", " :: ss) x
+         in f (loop xs, "[" :: ss) x
+         end
 
 val op o: ('a, 'b) t * ('c, 'a) t -> ('c, 'b) t =
    fn (f, g) => fn (k, ss) => f (fn ss => g (k, ss), ss)

Modified: mlton/branches/on-20050420-cmm-branch/regression/functor.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/functor.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/functor.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -9,9 +9,9 @@
   struct type t = A.t val b = A.a end
 
 functor H(A : sig type t type s val a : s
-	          sharing type t = s 
-	          val pr : t -> string 
-	      end) =
+                  sharing type t = s 
+                  val pr : t -> string 
+              end) =
   struct
     structure A1 : sig type t val pr : t -> string end = A
     structure A2 = F(A1)

Modified: mlton/branches/on-20050420-cmm-branch/regression/general.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/general.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/general.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -8,7 +8,7 @@
 fun range (from, to) p = 
     let open Int 
     in
-	(from > to) orelse (p from) andalso (range (from+1, to) p)
+        (from > to) orelse (p from) andalso (range (from+1, to) p)
     end;
 
 fun checkrange bounds = check o range bounds;

Modified: mlton/branches/on-20050420-cmm-branch/regression/generate/all-overloads.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/generate/all-overloads.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/generate/all-overloads.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -7,19 +7,19 @@
 
 val int =
    List.map (["Int", "IntInf", "LargeInt", "FixedInt", "Position"]
-	     @ List.map (List.tabulate (31, fn i => i + 2) @ [64],
-			 fn i => concat ["Int", Int.toString i]),
-	     fn s => concat [s, ".int"])
+             @ List.map (List.tabulate (31, fn i => i + 2) @ [64],
+                         fn i => concat ["Int", Int.toString i]),
+             fn s => concat [s, ".int"])
 
 val real =
    List.map (["Real", "Real32", "Real64", "LargeReal"],
-	     fn s => concat [s, ".real"])
+             fn s => concat [s, ".real"])
 
 val word =
    List.map (["Word", "LargeWord", "SysWord"]
-	     @ List.map (List.tabulate (31, fn i => i + 2) @ [64],
-			 fn i => concat ["Word", Int.toString i]),
-	     fn s => concat [s, ".word"])
+             @ List.map (List.tabulate (31, fn i => i + 2) @ [64],
+                         fn i => concat ["Word", Int.toString i]),
+             fn s => concat [s, ".word"])
 
 val text = ["Char.char", "String.string"]
 
@@ -53,8 +53,8 @@
     List.foreach
     (class, fn c =>
      print (concat ["fun f (x: ", c, ") = ",
-		    case ty of
-		      Binary => concat ["x ", f,  " x"]
-		    | Compare => concat ["x ", f, " x"]
-		    | Unary => concat [f, " x"],
-	            "\n"])))
+                    case ty of
+                      Binary => concat ["x ", f,  " x"]
+                    | Compare => concat ["x ", f, " x"]
+                    | Unary => concat [f, " x"],
+                    "\n"])))

Modified: mlton/branches/on-20050420-cmm-branch/regression/harmonic.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/harmonic.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/harmonic.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -4,68 +4,68 @@
        )
 
 local fun loop (big: IntInf.int, small: IntInf.int): IntInf.int =
-	     if small = 0
-		then big
-		else loop (small,
-			   IntInf.rem (big, small))
+             if small = 0
+                then big
+                else loop (small,
+                           IntInf.rem (big, small))
 in fun gcd (x: IntInf.int, y: IntInf.int): IntInf.int =
-	  let val x = IntInf.abs x
-	      val y = IntInf.abs y
-	      val (x, y) = if x >= y
-			      then (x, y)
-			      else (y, x)
-	  in loop (x, y)
-	  end
+          let val x = IntInf.abs x
+              val y = IntInf.abs y
+              val (x, y) = if x >= y
+                              then (x, y)
+                              else (y, x)
+          in loop (x, y)
+          end
 end
 
 fun reduce (num: IntInf.int, den: IntInf.int) : IntInf.int * IntInf.int =
        let val g = gcd (num, den)
-	   val gs = if den >= 0
-		       then g
-		       else ~ g
+           val gs = if den >= 0
+                       then g
+                       else ~ g
        in if gs = 1
-	     then (num, den)
-	  else let val rnum = IntInf.quot (num, gs)
-		   val badn = IntInf.rem (num, gs)
-		   val rden = IntInf.quot (den, gs)
-		   val badd = IntInf.rem (den, gs)
-	       in if badn <> 0
-		  orelse num <> rnum * gs
-		  orelse badd <> 0
-		  orelse den <> rden * gs
-		     then die ("Bad: num " ^ (IntInf.toString num)
-			       ^ ", den " ^ (IntInf.toString den)
-			       ^ ", gcds " ^ (IntInf.toString gs)
-			       ^ ", rnum " ^ (IntInf.toString rnum)
-			       ^ ", rden " ^ (IntInf.toString rden)
-			       ^ ", badn " ^ (IntInf.toString badn)
-			       ^ ", badd " ^ (IntInf.toString badd))
-		  else ();
-		       (rnum, rden)
-	       end
+             then (num, den)
+          else let val rnum = IntInf.quot (num, gs)
+                   val badn = IntInf.rem (num, gs)
+                   val rden = IntInf.quot (den, gs)
+                   val badd = IntInf.rem (den, gs)
+               in if badn <> 0
+                  orelse num <> rnum * gs
+                  orelse badd <> 0
+                  orelse den <> rden * gs
+                     then die ("Bad: num " ^ (IntInf.toString num)
+                               ^ ", den " ^ (IntInf.toString den)
+                               ^ ", gcds " ^ (IntInf.toString gs)
+                               ^ ", rnum " ^ (IntInf.toString rnum)
+                               ^ ", rden " ^ (IntInf.toString rden)
+                               ^ ", badn " ^ (IntInf.toString badn)
+                               ^ ", badd " ^ (IntInf.toString badd))
+                  else ();
+                       (rnum, rden)
+               end
        end
 
 fun addrecip (xxx: int, (num: IntInf.int, den: IntInf.int))
-	     : IntInf.int * IntInf.int =
+             : IntInf.int * IntInf.int =
        let val xxx = IntInf.fromInt xxx
-	   val xnum = xxx * num + den
-	   val xden = xxx * den
+           val xnum = xxx * num + den
+           val xden = xxx * den
        in reduce (xnum, xden)
        end
 
 fun printRat (num: IntInf.int, den: IntInf.int): unit =
-	print (IntInf.toString num ^ "/" ^ IntInf.toString den ^ "\n")
+        print (IntInf.toString num ^ "/" ^ IntInf.toString den ^ "\n")
 
 fun spin (limit: int): IntInf.int * IntInf.int =
        let fun loop (n: int, res: IntInf.int * IntInf.int)
-		    : IntInf.int * IntInf.int =
-		  if n = limit
-		     then res
-		  else loop (n + 1,
-			     addrecip (n, res))
+                    : IntInf.int * IntInf.int =
+                  if n = limit
+                     then res
+                  else loop (n + 1,
+                             addrecip (n, res))
        in if limit <= 0
-	     then die "Bad limit"
-	     else loop (1, (0, 1))
+             then die "Bad limit"
+             else loop (1, (0, 1))
        end
 
 val (n, d) = spin 3000

Modified: mlton/branches/on-20050420-cmm-branch/regression/int-inf.1.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/int-inf.1.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/int-inf.1.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -5,10 +5,10 @@
       val bstr = IntInf.toString barg
       val _ = print (concat ["trying ", bstr, "\n"])
    in print (if ~ big <= barg
-		then if barg < big
-			then "ok\n"
-		     else "positive\n"
-	     else "negative\n")
+                then if barg < big
+                        then "ok\n"
+                     else "positive\n"
+             else "negative\n")
    end
 
 val _ = try 0

Modified: mlton/branches/on-20050420-cmm-branch/regression/int-inf.2.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/int-inf.2.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/int-inf.2.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -2,35 +2,35 @@
 
 fun try (barg: IntInf.int): unit =
        let
-	  val small = SOME (IntInf.toInt barg)
-		  handle Overflow => NONE
-	   val bstr = IntInf.toString barg
-	   val _ = print (concat ["trying ", bstr, "\n"])
-	   fun fail msg = print ("Fail " ^ msg ^ ": " ^ bstr ^ "\n")
-	   val isSmall = ~ big <= barg andalso barg < big
+          val small = SOME (IntInf.toInt barg)
+                  handle Overflow => NONE
+           val bstr = IntInf.toString barg
+           val _ = print (concat ["trying ", bstr, "\n"])
+           fun fail msg = print ("Fail " ^ msg ^ ": " ^ bstr ^ "\n")
+           val isSmall = ~ big <= barg andalso barg < big
        in case small of
-	     NONE => if isSmall
-			then fail "1"
-			else ()
-	     | SOME sarg => if isSmall
-			       then let val sstr = Int.toString sarg
-				    in if bstr = sstr
-				       andalso barg = IntInf.fromInt sarg
-					  then ()
-					  else fail "2"
-				    end
-			       else fail "3"
+             NONE => if isSmall
+                        then fail "1"
+                        else ()
+             | SOME sarg => if isSmall
+                               then let val sstr = Int.toString sarg
+                                    in if bstr = sstr
+                                       andalso barg = IntInf.fromInt sarg
+                                          then ()
+                                          else fail "2"
+                                    end
+                               else fail "3"
        end
 
 fun spin (low: IntInf.int, limit: IntInf.int): unit =
        let fun loop (arg: IntInf.int): unit =
-		  if arg = limit
-		     then ()
-		     else (
-			try arg;
-			try (~ arg);
-			loop (arg + 1)
-		     )
+                  if arg = limit
+                     then ()
+                     else (
+                        try arg;
+                        try (~ arg);
+                        loop (arg + 1)
+                     )
        in loop low
        end
 

Modified: mlton/branches/on-20050420-cmm-branch/regression/int-inf.4.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/int-inf.4.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/int-inf.4.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,9 @@
 fun dump (x: IntInf.int): unit =
        let val rest = IntInf.quot (x, 10)
        in (print o Int.toString o IntInf.toInt o IntInf.rem) (x, 10);
-	  if rest = 0
-	     then print "\n"
-	     else dump rest
+          if rest = 0
+             then print "\n"
+             else dump rest
        end
-		  
+                  
 val _ = dump 12345678901234567890

Modified: mlton/branches/on-20050420-cmm-branch/regression/int-inf.5.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/int-inf.5.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/int-inf.5.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,9 @@
 open IntInf MLton.IntInf
 
 fun p (a, b) = (print (toString (gcd (a, b)))
-		; print "\n")
+                ; print "\n")
    
 val _ = List.app p [(1000, 205),
-		    (1000000000000, 205),
-		    (100000000000000000000, 500000000),
-		    (100000000000000000000, 500000001)]
+                    (1000000000000, 205),
+                    (100000000000000000000, 500000000),
+                    (100000000000000000000, 500000001)]

Modified: mlton/branches/on-20050420-cmm-branch/regression/int-inf.bitops.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/int-inf.bitops.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/int-inf.bitops.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,5 +1,5 @@
 fun pr i = (print (IntInf.fmt StringCvt.HEX i);
-	    print "\n")
+            print "\n")
 
 fun prBin oper a b c =
   (print "    A: ";
@@ -27,8 +27,8 @@
   end
 
 fun mkInt i n = if n = 0
-		  then i
-		  else mkInt (IntInf.+ (IntInf.* (i, IntInf.fromInt 10),i)) 
+                  then i
+                  else mkInt (IntInf.+ (IntInf.* (i, IntInf.fromInt 10),i)) 
                              (n - 1)
 
 val mkInt = fn i => fn n => mkInt (IntInf.fromInt i) n
@@ -86,20 +86,20 @@
   let
     fun loop' i =
       let
-	fun loop'' j = 
-	  if j > m
-	    then loop' (i + 1)
-	    else (tryBin (mkInt i j, mkInt i j);
-		  tryBin (mkInt i j, mkInt (i + 1) j);
-		  tryBin (mkInt i j, mkInt i (j + 1));
-		  tryBin (mkInt i j, mkInt (i + 1) (j + 1));
-		  tryUn (mkInt i j);
+        fun loop'' j = 
+          if j > m
+            then loop' (i + 1)
+            else (tryBin (mkInt i j, mkInt i j);
+                  tryBin (mkInt i j, mkInt (i + 1) j);
+                  tryBin (mkInt i j, mkInt i (j + 1));
+                  tryBin (mkInt i j, mkInt (i + 1) (j + 1));
+                  tryUn (mkInt i j);
                   trySh (mkInt i j);
-		  loop'' (j + 1))
+                  loop'' (j + 1))
       in
-	if i > n
-	  then ()
-	  else loop'' m'
+        if i > n
+          then ()
+          else loop'' m'
       end
   in
     loop' n'

Modified: mlton/branches/on-20050420-cmm-branch/regression/int-inf.compare.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/int-inf.compare.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/int-inf.compare.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,28 +1,28 @@
 val l = [12345678901234567890,
-	 1234567890,
-	 1234,
-	 12,
-	 1,
-	 0,
-	 ~1,
-	 ~12,
-	 ~1234,
-	 ~1234567890,
-	 ~12345678901234567890]
-	 
+         1234567890,
+         1234,
+         12,
+         1,
+         0,
+         ~1,
+         ~12,
+         ~1234,
+         ~1234567890,
+         ~12345678901234567890]
+         
 val _ =
    List.app
    (fn i =>
     List.app
     (fn i' =>
      let
-	val s =
-	   case IntInf.compare (i, i') of
-	      EQUAL => "equal"
-	    | GREATER => "greater"
-	    | LESS => "less"
+        val s =
+           case IntInf.compare (i, i') of
+              EQUAL => "equal"
+            | GREATER => "greater"
+            | LESS => "less"
      in
-	print (concat [s, "\n"])
+        print (concat [s, "\n"])
      end)
     l)
    l

Modified: mlton/branches/on-20050420-cmm-branch/regression/int.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/int.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/int.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -8,7 +8,7 @@
 fun range (from, to) p = 
     let open Int 
     in
-	(from > to) orelse (p from) andalso (range (from+1, to) p)
+        (from > to) orelse (p from) andalso (range (from+1, to) p)
     end;
 
 fun checkrange bounds = check o range bounds;
@@ -34,7 +34,7 @@
     infix 7 quot rem
     fun divmod s (i, d, q, r)  = tst s (i div d = q andalso i mod d = r);
     fun quotrem s (i, d, q, r) = tst s (i quot d = q andalso i rem d = r);
-in	
+in      
 
 val test1a = divmod "test1a" (10, 3, 3, 1);
 val test1b = divmod "test1b" (~10, 3, ~4, 2);
@@ -51,155 +51,155 @@
 
 val test5 = tst "test5" (sign ~57 = ~1 andalso sign 99 = 1 andalso sign 0 = 0);
 val test6 = tst "test6" (sameSign(~255, ~256) andalso sameSign(255, 256) 
-		  andalso sameSign(0, 0));
+                  andalso sameSign(0, 0));
 
 val test12 = 
     tst0 "test12" (case (minInt, maxInt) of
-		     (SOME mi, SOME ma) => check(sign mi = ~1 andalso sign ma = 1 
-						 andalso sameSign(mi, ~1) andalso sameSign(ma, 1))
-		   | (NONE, NONE)       => "OK"
-		   | _                  => "WRONG")
+                     (SOME mi, SOME ma) => check(sign mi = ~1 andalso sign ma = 1 
+                                                 andalso sameSign(mi, ~1) andalso sameSign(ma, 1))
+                   | (NONE, NONE)       => "OK"
+                   | _                  => "WRONG")
 
 fun chk f (s, r) = 
     tst' "chk" (fn _ => 
-	   case f s of
-	       SOME res => res = r
-	     | NONE     => false)
+           case f s of
+               SOME res => res = r
+             | NONE     => false)
 
 fun chkScan fmt = chk (StringCvt.scanString (scan fmt))
 
 val test13a = 
     List.map (chk fromString)
              [("10789", 10789),
-	      ("+10789", 10789),
-	      ("~10789", ~10789),
-	      ("-10789", ~10789),
-	      (" \n\t10789crap", 10789),
-	      (" \n\t+10789crap", 10789),
-	      (" \n\t~10789crap", ~10789),
-	      (" \n\t-10789crap", ~10789),
-	      ("0w123", 0),
-	      ("0W123", 0),
-	      ("0x123", 0),
-	      ("0X123", 0),
-	      ("0wx123", 0),
-	      ("0wX123", 0)];
+              ("+10789", 10789),
+              ("~10789", ~10789),
+              ("-10789", ~10789),
+              (" \n\t10789crap", 10789),
+              (" \n\t+10789crap", 10789),
+              (" \n\t~10789crap", ~10789),
+              (" \n\t-10789crap", ~10789),
+              ("0w123", 0),
+              ("0W123", 0),
+              ("0x123", 0),
+              ("0X123", 0),
+              ("0wx123", 0),
+              ("0wX123", 0)];
 
 val test13b = 
     List.map (fn s => tst0 "test13b" (case fromString s of NONE => "OK" | _ => "WRONG"))
-	   ["", "-", "~", "+", " \n\t", " \n\t-", " \n\t~", " \n\t+", 
-	    "+ 1", "~ 1", "- 1", "ff"];	    
+           ["", "-", "~", "+", " \n\t", " \n\t-", " \n\t~", " \n\t+", 
+            "+ 1", "~ 1", "- 1", "ff"];     
 
 val test14a = 
     List.map (chkScan StringCvt.DEC)
              [("10789", 10789),
-	      ("+10789", 10789),
-	      ("~10789", ~10789),
-	      ("-10789", ~10789),
-	      (" \n\t10789crap", 10789),
-	      (" \n\t+10789crap", 10789),
-	      (" \n\t~10789crap", ~10789),
-	      (" \n\t-10789crap", ~10789),
-	      ("0w123", 0),
-	      ("0W123", 0),
-	      ("0x123", 0),
-	      ("0X123", 0),
-	      ("0wx123", 0),
-	      ("0wX123", 0)];
+              ("+10789", 10789),
+              ("~10789", ~10789),
+              ("-10789", ~10789),
+              (" \n\t10789crap", 10789),
+              (" \n\t+10789crap", 10789),
+              (" \n\t~10789crap", ~10789),
+              (" \n\t-10789crap", ~10789),
+              ("0w123", 0),
+              ("0W123", 0),
+              ("0x123", 0),
+              ("0X123", 0),
+              ("0wx123", 0),
+              ("0wX123", 0)];
 
 val test14b = 
     List.map (fn s => tst0 "test14b" (case StringCvt.scanString (scan StringCvt.DEC) s 
-	              of NONE => "OK" | _ => "WRONG"))
-	   ["", "-", "~", "+", " \n\t", " \n\t-", " \n\t~", " \n\t+", 
-	    "+ 1", "~ 1", "- 1", "ff"];	    
+                      of NONE => "OK" | _ => "WRONG"))
+           ["", "-", "~", "+", " \n\t", " \n\t-", " \n\t~", " \n\t+", 
+            "+ 1", "~ 1", "- 1", "ff"];     
 
 val test15a = 
     List.map (chkScan StringCvt.BIN)
              [("10010", 18),
-	      ("+10010", 18),
-	      ("~10010", ~18),
-	      ("-10010", ~18),
-	      (" \n\t10010crap", 18),
-	      (" \n\t+10010crap", 18),
-	      (" \n\t~10010crap", ~18),
-	      (" \n\t-10010crap", ~18),
-	      ("0w101", 0),
-	      ("0W101", 0),
-	      ("0x101", 0),
-	      ("0X101", 0),
-	      ("0wx101", 0),
-	      ("0wX101", 0)];
+              ("+10010", 18),
+              ("~10010", ~18),
+              ("-10010", ~18),
+              (" \n\t10010crap", 18),
+              (" \n\t+10010crap", 18),
+              (" \n\t~10010crap", ~18),
+              (" \n\t-10010crap", ~18),
+              ("0w101", 0),
+              ("0W101", 0),
+              ("0x101", 0),
+              ("0X101", 0),
+              ("0wx101", 0),
+              ("0wX101", 0)];
 
 val test15b = 
     List.map (fn s => tst0 "test15b" (case StringCvt.scanString (scan StringCvt.BIN) s 
-	              of NONE => "OK" | _ => "WRONG"))
-	   ["", "-", "~", "+", " \n\t", " \n\t-", " \n\t~", " \n\t+", 
-	    "+ 1", "~ 1", "- 1", "2", "8", "ff"];
+                      of NONE => "OK" | _ => "WRONG"))
+           ["", "-", "~", "+", " \n\t", " \n\t-", " \n\t~", " \n\t+", 
+            "+ 1", "~ 1", "- 1", "2", "8", "ff"];
 
 val test16a = 
     List.map (chkScan StringCvt.OCT)
              [("2071", 1081),
-	      ("+2071", 1081),
-	      ("~2071", ~1081),
-	      ("-2071", ~1081),
-	      (" \n\t2071crap", 1081),
-	      (" \n\t+2071crap", 1081),
-	      (" \n\t~2071crap", ~1081),
-	      (" \n\t-2071crap", ~1081),
-	      ("0w123", 0),
-	      ("0W123", 0),
-	      ("0x123", 0),
-	      ("0X123", 0),
-	      ("0wx123", 0),
-	      ("0wX123", 0)];
+              ("+2071", 1081),
+              ("~2071", ~1081),
+              ("-2071", ~1081),
+              (" \n\t2071crap", 1081),
+              (" \n\t+2071crap", 1081),
+              (" \n\t~2071crap", ~1081),
+              (" \n\t-2071crap", ~1081),
+              ("0w123", 0),
+              ("0W123", 0),
+              ("0x123", 0),
+              ("0X123", 0),
+              ("0wx123", 0),
+              ("0wX123", 0)];
 
 val test16b = 
     List.map (fn s => tst0 "test16b" (case StringCvt.scanString (scan StringCvt.OCT) s 
-	              of NONE => "OK" | _ => "WRONG"))
-	   ["", "-", "~", "+", " \n\t", " \n\t-", " \n\t~", " \n\t+", 
-	    "+ 1", "~ 1", "- 1", "8", "ff"];
+                      of NONE => "OK" | _ => "WRONG"))
+           ["", "-", "~", "+", " \n\t", " \n\t-", " \n\t~", " \n\t+", 
+            "+ 1", "~ 1", "- 1", "8", "ff"];
 
 val test17a = 
     List.map (chkScan StringCvt.HEX)
              [("20Af", 8367),
-	      ("+20Af", 8367),
-	      ("~20Af", ~8367),
-	      ("-20Af", ~8367),
-	      (" \n\t20AfGrap", 8367),
-	      (" \n\t+20AfGrap", 8367),
-	      (" \n\t~20AfGrap", ~8367),
-	      (" \n\t-20AfGrap", ~8367),
-	      ("0w123", 0),
-	      ("0W123", 0),
-	      ("0x", 0),
-	      ("0x ", 0),
-	      ("0xG", 0),
-	      ("0X", 0),
-	      ("0XG", 0),
-	      ("0x123", 291),
-	      ("0X123", 291),
-	      ("-0x123", ~291),
-	      ("-0X123", ~291),
-	      ("~0x123", ~291),
-	      ("~0X123", ~291),
-	      ("+0x123", 291),
-	      ("+0X123", 291),
-	      ("0wx123", 0),
-	      ("0wX123", 0)];
+              ("+20Af", 8367),
+              ("~20Af", ~8367),
+              ("-20Af", ~8367),
+              (" \n\t20AfGrap", 8367),
+              (" \n\t+20AfGrap", 8367),
+              (" \n\t~20AfGrap", ~8367),
+              (" \n\t-20AfGrap", ~8367),
+              ("0w123", 0),
+              ("0W123", 0),
+              ("0x", 0),
+              ("0x ", 0),
+              ("0xG", 0),
+              ("0X", 0),
+              ("0XG", 0),
+              ("0x123", 291),
+              ("0X123", 291),
+              ("-0x123", ~291),
+              ("-0X123", ~291),
+              ("~0x123", ~291),
+              ("~0X123", ~291),
+              ("+0x123", 291),
+              ("+0X123", 291),
+              ("0wx123", 0),
+              ("0wX123", 0)];
 
 val test17b = 
     List.map (fn s => tst0 "test17b" (case StringCvt.scanString (scan StringCvt.HEX) s 
-	              of NONE => "OK" | _ => "WRONG"))
-	   ["", "-", "~", "+", " \n\t", " \n\t-", " \n\t~", " \n\t+", 
-	    "+ 1", "~ 1", "- 1"];
+                      of NONE => "OK" | _ => "WRONG"))
+           ["", "-", "~", "+", " \n\t", " \n\t-", " \n\t~", " \n\t+", 
+            "+ 1", "~ 1", "- 1"];
 
 
 local 
     fun fromToString i = 
-	fromString (toString i) = SOME i;
+        fromString (toString i) = SOME i;
 
     fun scanFmt radix i = 
-	StringCvt.scanString (scan radix) (fmt radix i) = SOME i;
+        StringCvt.scanString (scan radix) (fmt radix i) = SOME i;
 
 in
 val test18 = 

Modified: mlton/branches/on-20050420-cmm-branch/regression/kitkbjul9.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/kitkbjul9.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/kitkbjul9.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -37,32 +37,32 @@
   struct
 *)
     fun length l = let
-	  fun j(k, nil) = k
-	    | j(k, a::x) = j(k+1,x)
-	  in
-	    j(0,l)
-	  end
+          fun j(k, nil) = k
+            | j(k, a::x) = j(k+1,x)
+          in
+            j(0,l)
+          end
     fun op @ (nil, l) = l
       | op @ (a::r, l) = a :: (r@l)
     fun rev l = let
-	  fun f (nil, h) = h
-	    | f (a::r, h) = f(r, a::h)
-	  in
-	    f(l,nil)
-	  end
+          fun f (nil, h) = h
+            | f (a::r, h) = f(r, a::h)
+          in
+            f(l,nil)
+          end
     fun app f = let
-	  fun app_rec [] = ()
+          fun app_rec [] = ()
             | app_rec (a::L) = (f a; app_rec L)
         in
-	  app_rec
+          app_rec
         end
 (*
     fun map f = let
-	  fun map_rec [] = []
+          fun map_rec [] = []
             | map_rec (a::L) = f a :: map_rec L
           in
-	    map_rec
-  	  end
+            map_rec
+          end
 *)
 
 (******* Quelques definitions du prelude CAML **************)
@@ -272,7 +272,7 @@
           else
             (v,M) :: subst
         | match_rec subst (Term(op1,sons1), Term(op2,sons2)) =
-	  if eq_string(op1,op2) then it_list2 match_rec subst sons1 sons2
+          if eq_string(op1,op2) then it_list2 match_rec subst sons1 sons2
                        else raise FailMatching
         | match_rec _ _ = raise FailMatching
   in match_rec [] (term1,term2)
@@ -298,7 +298,7 @@
       else [(n2,term1)]
   | unify (Term(op1,sons1), Term(op2,sons2)) =
       if eq_string(op1,op2) then 
-	it_list2 (fn s => fn (t1,t2) => compsubst (unify(substitute s t1,
+        it_list2 (fn s => fn (t1,t2) => compsubst (unify(substitute s t1,
                                                          substitute s t2)) s)
                  [] sons1 sons2
       else raise FailUnify
@@ -320,7 +320,7 @@
       else
        (print_string oper;
         case sons of
-	     []   => ()
+             []   => ()
           | t::lt =>(print_string "(";
                      pretty_term t;
                      app (fn t => (print_string ","; pretty_term t)) lt;

Modified: mlton/branches/on-20050420-cmm-branch/regression/kitlife35u.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/kitlife35u.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/kitlife35u.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -125,9 +125,9 @@
                 | ( xover, x3, x2, x1, (a::x)) =>
                    if member eq_int_pair_curry xover a then f( xover, x3, x2, x1, x) else
                    if member eq_int_pair_curry x3 a then f ((a::xover), x3, x2, x1, x) else
-		   if member eq_int_pair_curry x2 a then f (xover, (a::x3), x2, x1, x) else
+                   if member eq_int_pair_curry x2 a then f (xover, (a::x3), x2, x1, x) else
                    if member eq_int_pair_curry x1 a then f (xover, x3, (a::x2), x1, x) else
-		                       f (xover, x3, x2, (a::x1), x)
+                                       f (xover, x3, x2, (a::x1), x)
               fun diff x y = filter (fn x => not(member eq_int_pair_curry y x)) x  (* unfolded o *)
               val (xover, x3, _, _, _) = f ([],[],[],[],x)
            in diff x3 xover end
@@ -137,8 +137,8 @@
         | copy_bool false = false
 
       fun neighbours (i,j) = [(i-1,j-1),(i-1,j),(i-1,j+1),
-			    (i,j-1),(i,j+1),
-			    (i+1,j-1),(i+1,j),(i+1,j+1)]
+                            (i,j-1),(i,j+1),
+                            (i+1,j-1),(i+1,j),(i+1,j+1)]
 
 
       abstype generation = GEN of (int*int) list
@@ -152,10 +152,10 @@
                   fun isalive x = copy_bool(member eq_int_pair_curry living x) (* eta *)
                   fun liveneighbours x = length( filter isalive ( neighbours x)) (*eta*)
                   fun twoorthree n = eq_integer(n,2) orelse eq_integer(n,3)
-	          val survivors = copy_list(filter (twoorthree o liveneighbours) living)
-	          val newnbrlist = copy_list(collect (fn z => filter (fn x => not( isalive x)) ( neighbours z)) living) (* unfolded o twice*)
-	          val newborn = copy_list(occurs3 newnbrlist)
-	       in mkgen (survivors @ newborn) end
+                  val survivors = copy_list(filter (twoorthree o liveneighbours) living)
+                  val newnbrlist = copy_list(collect (fn z => filter (fn x => not( isalive x)) ( neighbours z)) living) (* unfolded o twice*)
+                  val newborn = copy_list(occurs3 newnbrlist)
+               in mkgen (survivors @ newborn) end
               else gen
      end
 
@@ -191,7 +191,7 @@
        end
 
     val genB = mkgen(glider at (2,2) @ bail at (2,12)
-		     @ rotate (barberpole 4) at (5,20))
+                     @ rotate (barberpole 4) at (5,20))
 
     fun copy_whole_arg (p, g) = (copy_int p, copy g)
 

Modified: mlton/branches/on-20050420-cmm-branch/regression/kitmandelbrot.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/kitmandelbrot.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/kitmandelbrot.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -25,15 +25,15 @@
     val sum_iterations = ref 0
 
     fun loop1 i = if (i >= sz)
-	  then ()
-	  else let
+          then ()
+          else let
             val c_im : real = y_base - (delta * real i)
             fun loop2 j = if (j >= sz)
-		  then ()
-		  else let
+                  then ()
+                  else let
                     val c_re = x_base * (delta + real j)
-		    fun loop3 (count, z_re : real, z_im : real) = if (count < maxCount)
-			  then let
+                    fun loop3 (count, z_re : real, z_im : real) = if (count < maxCount)
+                          then let
                             val z_re_sq = z_re * z_re
                             val z_im_sq = z_im * z_im
                             in
@@ -47,12 +47,12 @@
                                        z_re_im + z_re_im + c_im)
                                   end
                             end (* loop3 *)
-			  else count
-		    val count = loop3 (0, c_re, c_im)
-		    in
-		      sum_iterations := !sum_iterations + 1(*count*);
-		      loop2 (j+1)
-		    end
+                          else count
+                    val count = loop3 (0, c_re, c_im)
+                    in
+                      sum_iterations := !sum_iterations + 1(*count*);
+                      loop2 (j+1)
+                    end
             in
               loop2 0;
               loop1 (i+1)
@@ -61,9 +61,9 @@
     fun doit () = (sum_iterations := 0; loop1 0)
 
     fun testit () = (
-	  sum_iterations := 0;
-	  loop1 0;
-	  print(int_to_string(!sum_iterations) ^ " iterations\n"))
+          sum_iterations := 0;
+          loop1 0;
+          print(int_to_string(!sum_iterations) ^ " iterations\n"))
 (*
   end (* Mandelbrot *)
 *)

Modified: mlton/branches/on-20050420-cmm-branch/regression/kitqsort.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/kitqsort.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/kitqsort.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -2,8 +2,8 @@
 
 (* quicksort-random.sml
  *
- * Input....:	Random list (pseudo-random integers)
- * Optimised:	'arg as ...' in quickSort'() and  partition(). 
+ * Input....:   Random list (pseudo-random integers)
+ * Optimised:   'arg as ...' in quickSort'() and  partition(). 
  *              Copying left-parts after partitioning inside quickSort'().
  *              `Bertelsen transformation' of argument to tail-recursive
  *              call to quickSort'().
@@ -52,23 +52,23 @@
     | quickSort' ([a], sorted) = ([], a::sorted)
     | quickSort' (a::bs, sorted) =  (* "a" is the pivot *)
         let 
-  	  fun partition (arg as (_, _, []: elem list)) = arg
-	    | partition (left, right, x::xr) =
-	        if x<=a then partition(x::left, right, xr)
-	                else partition(left, x::right, xr)
-	  val arg' =
-	    let val (left', right) = 
+          fun partition (arg as (_, _, []: elem list)) = arg
+            | partition (left, right, x::xr) =
+                if x<=a then partition(x::left, right, xr)
+                        else partition(left, x::right, xr)
+          val arg' =
+            let val (left', right) = 
                  let val (left, right, _) = partition([], [], bs)
                  in  (*forceResetting bs; *)
                      (copyList left, right)
                  end
                 val sorted' = #2 (quickSort'(right, sorted))
-	    in
-	      (left', a::sorted')
-	    end
-	in
-	  quickSort' arg'
-	end
+            in
+              (left', a::sorted')
+            end
+        in
+          quickSort' arg'
+        end
   fun quickSort l = #2 (quickSort'(l, []))
 
 
@@ -91,10 +91,10 @@
     | randomList' (i, seed, res) =
       let val res' = min+floor(seed*w) :: res
           (* NOTE: It is significant to use seed for
-	   * calculating res' before calling nextRand()... 
+           * calculating res' before calling nextRand()... 
            *)
       in
-	randomList'(i-1, nextRand seed, res')
+        randomList'(i-1, nextRand seed, res')
       end
   fun randomList n = #3 (randomList'(n, seed0(), []))
 

Modified: mlton/branches/on-20050420-cmm-branch/regression/kitreynolds2.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/kitreynolds2.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/kitreynolds2.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -38,5 +38,5 @@
                 in Br(n,t,t)
                 end
 val it = if search (fn _ => false) (mk_tree 20) then print "true\n"
-	 else print "false\n"
+         else print "false\n"
 

Modified: mlton/branches/on-20050420-cmm-branch/regression/kitsimple.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/kitsimple.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/kitsimple.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -42,8 +42,8 @@
 
   fun sub'(nil,i) = raise Subscript
     | sub' (a::r,i) = if i > 0 then sub' (r,i-1)
-		      else if i < 0 then raise Subscript
-			   else a 
+                      else if i < 0 then raise Subscript
+                           else a 
 
   fun op sub (a, i) =  !(sub'(a,i))
 
@@ -130,8 +130,8 @@
     type 'a array2 = {size : (int*int), value : 'a array}
     exception Subscript = Subscript
     fun index22 ((i1:int,i2:int),(s1,s2)) =
-	if i1>=0 andalso i1<s1 andalso i2>=0 andalso i2<s2 then i1*s2+i2 
-	else raise Subscript
+        if i1>=0 andalso i1<s1 andalso i2>=0 andalso i2<s2 then i1*s2+i2 
+        else raise Subscript
     fun array22(bnds as (i1,i2), v) = {size=bnds, value=array(i1*i2, v)}
     fun op sub22 ({size,value}, indx) = (op sub) (value, index22(indx,size))
     fun update22 ({size=size,value=A},i,v) = update(A,index22(i,size),v)
@@ -170,13 +170,13 @@
 
 fun for {from=start:int,step=delta:int, to=endd:int} body =
     if delta>0 andalso endd>=start then 
-	let fun f x = if x > endd then () else (body x; f(x+delta))
-	in f start
-	end
+        let fun f x = if x > endd then () else (body x; f(x+delta))
+        in f start
+        end
     else if endd<=start then
-	let fun f x = if x < endd then () else (body x; f(x+delta))
-	in f start
-	end
+        let fun f x = if x < endd then () else (body x; f(x+delta))
+        in f start
+        end
     else ()
 fun from(n,m) = if n>m then [] else n::from(n+1,m)
 fun flatten [] = []
@@ -191,9 +191,9 @@
 fun printarray2 (A as (M:real array2,((l1,u1),(l2,u2)))) =
     for {from=l1,step=1,to=u1} (fn i =>
         (print "[";
-	 for {from=l2,step=1,to=u2-1} (fn j => 
-	      print ( (* makestring(sub2(A,(i,j))) ^ *) ", "));
-	 print ( (* makestring (sub2(A,(i,u2))) ^ *) "]\n")))
+         for {from=l2,step=1,to=u2-1} (fn j => 
+              print ( (* makestring(sub2(A,(i,j))) ^ *) ", "));
+         print ( (* makestring (sub2(A,(i,u2))) ^ *) "]\n")))
 fun array1((l,u),v) = (array(u-l+1,v),(l,u))
 fun sub1((A,(l:int,u:int)),i:int) = (op sub)(A,i-l) 
 fun update1((A,(l,_)),i,v) = update(A,i-l,v)
@@ -204,28 +204,28 @@
  *)
 val grid_size = ((2,grid_max), (2,grid_max))
 
-fun north (k,l) = (k-1,l)	
-fun south (k,l) = (k+1,l)		
+fun north (k,l) = (k-1,l)       
+fun south (k,l) = (k+1,l)               
 
 fun east (k,l) = (k,l+1)
 fun west (k,l) = (k,l-1)
 
 val northeast = north o east
 val southeast = south o east
-val northwest = north o west		
+val northwest = north o west            
 val southwest = south o west
 
 type dir = int * int -> int * int
 
 val farnorth : dir = north o north 
 val farsouth : dir = south o south
-val fareast : dir = east o east		
+val fareast : dir = east o east         
 val farwest : dir = west o west
 
 fun zone_A(k,l) = (k,l)
 fun zone_B(k,l) = (k+1,l)
 
-fun zone_C(k,l) = (k+1,l+1)		
+fun zone_C(k,l) = (k+1,l+1)             
 fun zone_D(k,l) = (k,l+1)
 
 val  zone_corner_northeast = north   
@@ -233,35 +233,35 @@
 fun  zone_corner_southeast zone = zone
 val  zone_corner_southwest = west
 
-val ((kmin,kmax),(lmin,lmax)) 	= grid_size
-val dimension_all_nodes   	= ((kmin-1,kmax+1),(lmin-1,lmax+1))
+val ((kmin,kmax),(lmin,lmax))   = grid_size
+val dimension_all_nodes         = ((kmin-1,kmax+1),(lmin-1,lmax+1))
 fun for_all_nodes f =
     for {from=kmin-1, step=1, to=kmax+1} (fn k =>
        for {from=lmin-1, step=1, to=lmax+1} (fn l => f k l))
 
-val dimension_interior_nodes  	= ((kmin,kmax),(lmin,lmax))
+val dimension_interior_nodes    = ((kmin,kmax),(lmin,lmax))
 fun for_interior_nodes f =
     for {from=kmin, step=1, to=kmax} (fn k =>
        for {from=lmin, step=1, to=lmax} (fn l => f k l))
 
-val dimension_all_zones  	= ((kmin,kmax+1),(lmin,lmax+1))
+val dimension_all_zones         = ((kmin,kmax+1),(lmin,lmax+1))
 fun for_all_zones f =
     for {from=kmin, step=1, to=kmax+1} (fn k =>
        for {from=lmin, step=1, to=lmax+1} (fn l => f (k,l)))
 
-val dimension_interior_zones  	= ((kmin+1,kmax),(lmin+1,lmax))
+val dimension_interior_zones    = ((kmin+1,kmax),(lmin+1,lmax))
 fun for_interior_zones f =
     for {from=kmin+1, step=1, to=kmax} (fn k =>
        for {from=lmin+1, step=1, to=lmax} (fn l => f (k,l)))
 
 fun map_interior_nodes f =
     flatten(map (fn k => (map (fn l => f (k,l)) 
-			      (from(lmin,lmax))))
-	        (from(kmin,kmax)))
+                              (from(lmin,lmax))))
+                (from(kmin,kmax)))
 fun map_interior_zones f =
     flatten(map (fn k => (map (fn l => f (k,l)) 
                                (from(lmin+1,lmax))))
-	         (from(kmin+1,kmax)))
+                 (from(kmin+1,kmax)))
 
 fun for_north_ward_interior_zones f =
     for {from=kmax, step= ~1, to=kmin+1} (fn k =>
@@ -313,44 +313,44 @@
 val  deltat_maximum = 0.01
 val  specific_heat = 0.1
 val  p_coeffs = let val M = array2(((0,2),(0,2)), 0.0)
-		in update2(M, (1,1), 0.06698); M
-		end
+                in update2(M, (1,1), 0.06698); M
+                end
 val e_coeffs = let val M = array2(((0,2),(0,2)), 0.0)
-	       in update2(M, (0,1), 0.1); M
-	       end
+               in update2(M, (0,1), 0.1); M
+               end
 val p_poly   = array2(((1,4),(1,5)),p_coeffs)
 
 val e_poly   = array2(((1,4),(1,5)), e_coeffs)
 
 val rho_table = let val V = array1((1,3), 0.0)
-		in  update1(V,2,1.0);
-		    update1(V,3,100.0);
-		    V
-		end
+                in  update1(V,2,1.0);
+                    update1(V,3,100.0);
+                    V
+                end
 val theta_table = let val V = array1((1,4), 0.0)
-		  in update1(V,2,3.0);
-		      update1(V,3,300.0);
-		      update1(V,4,3000.0);
-		      V
-		  end
+                  in update1(V,2,3.0);
+                      update1(V,3,300.0);
+                      update1(V,4,3000.0);
+                      V
+                  end
 
 val extract_energy_tables_from_constants  = (e_poly,2,rho_table,theta_table)
 val extract_pressure_tables_from_constants = (p_poly,2,rho_table,theta_table)
 
 val nbc = let val M = array2(dimension_all_zones, 1)
-	  in for {from=lmin+1,step=1,to=lmax} (fn j => update2(M,(kmax+1, j),2));
-	      update2(M,(kmin,lmin),4);
-	      update2(M,(kmin,lmax+1),4);
-	      update2(M,(kmax+1,lmin),4);
-	      update2(M,(kmax+1,lmax+1),4);
-	      M
-	  end
+          in for {from=lmin+1,step=1,to=lmax} (fn j => update2(M,(kmax+1, j),2));
+              update2(M,(kmin,lmin),4);
+              update2(M,(kmin,lmax+1),4);
+              update2(M,(kmax+1,lmin),4);
+              update2(M,(kmax+1,lmax+1),4);
+              M
+          end
 val pbb = let val A = array1((1,4), 0.0)
-	  in update1(A,2,6.0); A
-	  end
+          in update1(A,2,6.0); A
+          end
 val pb  = let val A = array1((1,4), 1.0)
-	  in update1(A,2,0.0); update1(A,3,0.0); A
-	  end
+          in update1(A,2,0.0); update1(A,3,0.0); A
+          end
 val qb  =     pb
 
 val all_zero_nodes = array2(dimension_all_nodes, 0.0)
@@ -364,48 +364,48 @@
 
 fun make_position_matrix interior_function =
     let val r' = array2(dimension_all_nodes, 0.0)
-	val z' = array2(dimension_all_nodes, 0.0)
-	fun boundary_position (rx,zx,ry,zy,ra,za) =
-	    let val (rax, zax)  =  (ra - rx, za - zx)
-		val (ryx, zyx)  =  (ry - rx, zy - zx)
-		val omega       =  2.0*(rax*ryx + zax*zyx)/(ryx*ryx + zyx*zyx)
-		val rb 	    	=  rx - rax + omega*ryx
-		val zb 	    	=  zx - zax + omega*zyx
-	    in (rb, zb)
-	    end
-	
-	fun reflect_node (x_dir, y_dir, a_dir, node) =
-	    let val rx = reflect x_dir  node  r'
-		val zx = reflect x_dir  node  z'
-		val ry = reflect y_dir  node  r'
-		val zy = reflect y_dir  node  z'
-		val ra = reflect a_dir  node  r'
-		val za = reflect a_dir  node  z'
-	    in boundary_position (rx, zx, ry, zy, ra, za)
-	    end
-	fun u2 (rv,zv) n = (update2(r',n,rv); update2(z',n,zv))
+        val z' = array2(dimension_all_nodes, 0.0)
+        fun boundary_position (rx,zx,ry,zy,ra,za) =
+            let val (rax, zax)  =  (ra - rx, za - zx)
+                val (ryx, zyx)  =  (ry - rx, zy - zx)
+                val omega       =  2.0*(rax*ryx + zax*zyx)/(ryx*ryx + zyx*zyx)
+                val rb          =  rx - rax + omega*ryx
+                val zb          =  zx - zax + omega*zyx
+            in (rb, zb)
+            end
+        
+        fun reflect_node (x_dir, y_dir, a_dir, node) =
+            let val rx = reflect x_dir  node  r'
+                val zx = reflect x_dir  node  z'
+                val ry = reflect y_dir  node  r'
+                val zy = reflect y_dir  node  z'
+                val ra = reflect a_dir  node  r'
+                val za = reflect a_dir  node  z'
+            in boundary_position (rx, zx, ry, zy, ra, za)
+            end
+        fun u2 (rv,zv) n = (update2(r',n,rv); update2(z',n,zv))
     in
-	for_interior_nodes (fn k => fn l => u2 (interior_function (k,l)) (k,l));
-	for_north_nodes(fn n => u2 (reflect_node(south,southeast,farsouth,n)) n);
-	for_south_nodes (fn n => u2(reflect_node(north,northeast,farnorth,n)) n);
-	for_east_nodes (fn n => u2(reflect_node(west, southwest, farwest, n)) n);
-	for_west_nodes (fn n => u2(reflect_node(east, southeast, fareast, n)) n);
-	u2 (reflect_node(south, southwest, farsouth, west_of_north_east))
-	   west_of_north_east;
+        for_interior_nodes (fn k => fn l => u2 (interior_function (k,l)) (k,l));
+        for_north_nodes(fn n => u2 (reflect_node(south,southeast,farsouth,n)) n);
+        for_south_nodes (fn n => u2(reflect_node(north,northeast,farnorth,n)) n);
+        for_east_nodes (fn n => u2(reflect_node(west, southwest, farwest, n)) n);
+        for_west_nodes (fn n => u2(reflect_node(east, southeast, fareast, n)) n);
+        u2 (reflect_node(south, southwest, farsouth, west_of_north_east))
+           west_of_north_east;
         u2 (reflect_node(north, northwest, farnorth, west_of_south_east)) 
-	   west_of_south_east;
-	u2 (reflect_node(west, northwest, farwest, north_of_south_east))
-	   north_of_south_east;
-	u2 (reflect_node(east, northeast, fareast, north_of_south_west))
-	   north_of_south_west;
-	u2 (reflect_node(southwest, west, farwest, north_east_corner))
-	   north_east_corner;
-	u2 (reflect_node(northwest, west, farwest, south_east_corner))
-	   south_east_corner;
-	u2 (reflect_node(southeast, south, farsouth, north_west_corner))
-	   north_west_corner;
-	u2 (reflect_node(northeast, east, fareast, south_west_corner))
-	   south_west_corner; 
+           west_of_south_east;
+        u2 (reflect_node(west, northwest, farwest, north_of_south_east))
+           north_of_south_east;
+        u2 (reflect_node(east, northeast, fareast, north_of_south_west))
+           north_of_south_west;
+        u2 (reflect_node(southwest, west, farwest, north_east_corner))
+           north_east_corner;
+        u2 (reflect_node(northwest, west, farwest, south_east_corner))
+           south_east_corner;
+        u2 (reflect_node(southeast, south, farsouth, north_west_corner))
+           north_west_corner;
+        u2 (reflect_node(northeast, east, fareast, south_west_corner))
+           south_west_corner; 
         (r',z')
     end
 
@@ -416,19 +416,19 @@
  *)
 fun zone_area_vol ((r,z), zone) =
     let val (r1,z1)=(sub2(r,zone_corner_southwest zone),
-		     sub2(z,zone_corner_southwest zone))
-	val (r2,z2)=(sub2(r,zone_corner_southeast zone),
-		     sub2(z,zone_corner_southeast zone))
-	val (r3,z3)=(sub2(r,zone_corner_northeast zone),
-		     sub2(z,zone_corner_northeast zone))
-	val (r4,z4)=(sub2(r,zone_corner_northwest zone),
-		     sub2(z,zone_corner_northwest zone))
-	val area1  =  (r2-r1)*(z3-z1) - (r3-r2)*(z3-z2)
-	val radius1  =  0.3333  *(r1+r2+r3)
-	val volume1  =  area1 * radius1
-	val area2  =  (r3-r1)*(z4-z3) - (r4-r3)*(z3-z1)
-	val radius2  =  0.3333 *(r1+r3+r4)
-	val volume2  =  area2 * radius2
+                     sub2(z,zone_corner_southwest zone))
+        val (r2,z2)=(sub2(r,zone_corner_southeast zone),
+                     sub2(z,zone_corner_southeast zone))
+        val (r3,z3)=(sub2(r,zone_corner_northeast zone),
+                     sub2(z,zone_corner_northeast zone))
+        val (r4,z4)=(sub2(r,zone_corner_northwest zone),
+                     sub2(z,zone_corner_northwest zone))
+        val area1  =  (r2-r1)*(z3-z1) - (r3-r2)*(z3-z2)
+        val radius1  =  0.3333  *(r1+r2+r3)
+        val volume1  =  area1 * radius1
+        val area2  =  (r3-r1)*(z4-z3) - (r4-r3)*(z3-z1)
+        val radius2  =  0.3333 *(r1+r3+r4)
+        val volume2  =  area2 * radius2
     in  (area1+area2, volume1+volume2)
     end
 
@@ -437,29 +437,29 @@
  *)
 fun make_velocity((u,w),(r,z),p,q,alpha,rho,delta_t: real) =
     let fun line_integral (p,z,node) : real =
- 	    sub2(p,zone_A node)*(sub2(z,west node) - sub2(z,north node)) +
-	    sub2(p,zone_B node)*(sub2(z,south node) - sub2(z,west node)) +
-	    sub2(p,zone_C node)*(sub2(z,east node) - sub2(z,south node)) +
-	    sub2(p,zone_D node)*(sub2(z,north node) - sub2(z,east node))
-	fun regional_mass node =
-	    0.5 * (sub2(rho, zone_A node)*sub2(alpha,zone_A node) +
-		   sub2(rho, zone_B node)*sub2(alpha,zone_B node) +
-		   sub2(rho, zone_C node)*sub2(alpha,zone_C node) +
-		   sub2(rho, zone_D node)*sub2(alpha,zone_D node))
-	fun velocity node =
-	    let val d = regional_mass node
-		val n1 = ~(line_integral(p,z,node)) - line_integral(q,z,node)
-		val n2 = line_integral(p,r,node) + line_integral(q,r,node)
-		val u_dot = n1/d
-		val w_dot = n2/d
-	    in (sub2(u,node)+delta_t*u_dot, sub2(w,node)+delta_t*w_dot)
-	    end
-	val U = array2(dimension_interior_nodes,0.0)
-	val W = array2(dimension_interior_nodes,0.0)
+            sub2(p,zone_A node)*(sub2(z,west node) - sub2(z,north node)) +
+            sub2(p,zone_B node)*(sub2(z,south node) - sub2(z,west node)) +
+            sub2(p,zone_C node)*(sub2(z,east node) - sub2(z,south node)) +
+            sub2(p,zone_D node)*(sub2(z,north node) - sub2(z,east node))
+        fun regional_mass node =
+            0.5 * (sub2(rho, zone_A node)*sub2(alpha,zone_A node) +
+                   sub2(rho, zone_B node)*sub2(alpha,zone_B node) +
+                   sub2(rho, zone_C node)*sub2(alpha,zone_C node) +
+                   sub2(rho, zone_D node)*sub2(alpha,zone_D node))
+        fun velocity node =
+            let val d = regional_mass node
+                val n1 = ~(line_integral(p,z,node)) - line_integral(q,z,node)
+                val n2 = line_integral(p,r,node) + line_integral(q,r,node)
+                val u_dot = n1/d
+                val w_dot = n2/d
+            in (sub2(u,node)+delta_t*u_dot, sub2(w,node)+delta_t*w_dot)
+            end
+        val U = array2(dimension_interior_nodes,0.0)
+        val W = array2(dimension_interior_nodes,0.0)
     in for_interior_nodes (fn k => fn l => let val (uv,wv) = velocity (k,l)
-					   in update2(U,(k,l),uv);
-					      update2(W,(k,l),wv)
-					   end);
+                                           in update2(U,(k,l),uv);
+                                              update2(W,(k,l),wv)
+                                           end);
        (U,W)
     end
 
@@ -468,36 +468,36 @@
 fun make_position ((r,z),delta_t:real,(u',w')) =
     let fun interior_position node = 
             (sub2(r,node) + delta_t*sub2(u',node), 
-	     sub2(z,node) + delta_t*sub2(w',node))
+             sub2(z,node) + delta_t*sub2(w',node))
     in make_position_matrix interior_position
     end
-	
+        
 
 fun make_area_density_volume(rho, s, x') =
     let val alpha' = array2(dimension_all_zones, 0.0)
-	val s' = array2(dimension_all_zones, 0.0)
-	val rho' = array2(dimension_all_zones, 0.0)
-	fun interior_area zone = 
- 	    let val (area, vol) = zone_area_vol (x', zone)
-		val density =  sub2(rho,zone)*sub2(s,zone) / vol
-	    in (area,vol,density)
-	    end
-	fun reflect_area_vol_density reflect_function = 
-	    (reflect_function alpha',reflect_function s',reflect_function rho')
-	fun update_asr (zone,(a,s,r)) = (update2(alpha',zone,a);
-					 update2(s',zone,s);
-					 update2(rho',zone,r))
-	fun r_area_vol_den (reflect_dir,zone) =
-	    let val asr =  reflect_area_vol_density (reflect_dir zone)
-	    in update_asr(zone, asr)
-	    end
+        val s' = array2(dimension_all_zones, 0.0)
+        val rho' = array2(dimension_all_zones, 0.0)
+        fun interior_area zone = 
+            let val (area, vol) = zone_area_vol (x', zone)
+                val density =  sub2(rho,zone)*sub2(s,zone) / vol
+            in (area,vol,density)
+            end
+        fun reflect_area_vol_density reflect_function = 
+            (reflect_function alpha',reflect_function s',reflect_function rho')
+        fun update_asr (zone,(a,s,r)) = (update2(alpha',zone,a);
+                                         update2(s',zone,s);
+                                         update2(rho',zone,r))
+        fun r_area_vol_den (reflect_dir,zone) =
+            let val asr =  reflect_area_vol_density (reflect_dir zone)
+            in update_asr(zone, asr)
+            end
     in
-	for_interior_zones (fn zone => update_asr(zone, interior_area zone));
+        for_interior_zones (fn zone => update_asr(zone, interior_area zone));
         for_south_zones (fn zone => r_area_vol_den(reflect_north, zone));
         for_east_zones (fn zone => r_area_vol_den(reflect_west, zone));
         for_west_zones (fn zone => r_area_vol_den(reflect_east, zone));
         for_north_zones (fn zone => r_area_vol_den(reflect_south, zone));
-	(alpha', rho', s')
+        (alpha', rho', s')
     end 
 
 
@@ -505,49 +505,49 @@
  * Artifical Viscosity (page 11)
  *)
 fun make_viscosity(p,(u',w'),(r',z'), alpha',rho') = 
-    let	fun interior_viscosity zone =
-	let fun upper_del f = 
-	    0.5 * ((sub2(f,zone_corner_southeast zone) - 
-		    sub2(f,zone_corner_northeast zone)) +
-		   (sub2(f,zone_corner_southwest zone) - 
-		    sub2(f,zone_corner_northwest zone)))
-	    fun lower_del f = 
-		0.5 * ((sub2(f,zone_corner_southeast zone) - 
-			sub2(f,zone_corner_southwest zone)) +
-		       (sub2(f,zone_corner_northeast zone) - 
-			sub2(f,zone_corner_northwest zone)))
-	    val xi 	= pow(upper_del   r',2) + pow(upper_del   z',2)
-	    val eta = pow(lower_del   r',2) + pow(lower_del   z',2)
-	    val upper_disc =  (upper_del r')*(lower_del w') - 
-		              (upper_del z')*(lower_del u')
-	    val lower_disc = (upper_del u')*(lower_del z') -
-		             (upper_del w') * (lower_del r')
-	    val upper_ubar = if upper_disc<0.0   then upper_disc/xi    else 0.0
-	    val lower_ubar = if lower_disc<0.0   then lower_disc/eta    else 0.0
-	    val gamma    = 1.6
-	    val speed_of_sound  =  gamma*sub2(p,zone)/sub2(rho',zone)
-	    val ubar  =  pow(upper_ubar,2) + pow(lower_ubar,2)
-	    val viscosity   =  
-		sub2(rho',zone)*(1.5*ubar + 0.5*speed_of_sound*(Math.sqrt ubar))
-	    val length   = Math.sqrt(pow(upper_del r',2) + pow(lower_del r',2))
-	    val courant_delta = 0.5* sub2(alpha',zone)/(speed_of_sound*length)
-	in (viscosity, courant_delta)
-	end
-	val q' = array2(dimension_all_zones, 0.0)
-	val d  = array2(dimension_all_zones, 0.0)
-	fun reflect_viscosity_cdelta (direction, zone) =
-	    sub2(q',direction zone) * sub1(qb, sub2(nbc,zone))
-	fun do_zones (dir,zone) = 
-	    update2(q',zone,reflect_viscosity_cdelta (dir,zone))
+    let fun interior_viscosity zone =
+        let fun upper_del f = 
+            0.5 * ((sub2(f,zone_corner_southeast zone) - 
+                    sub2(f,zone_corner_northeast zone)) +
+                   (sub2(f,zone_corner_southwest zone) - 
+                    sub2(f,zone_corner_northwest zone)))
+            fun lower_del f = 
+                0.5 * ((sub2(f,zone_corner_southeast zone) - 
+                        sub2(f,zone_corner_southwest zone)) +
+                       (sub2(f,zone_corner_northeast zone) - 
+                        sub2(f,zone_corner_northwest zone)))
+            val xi      = pow(upper_del   r',2) + pow(upper_del   z',2)
+            val eta = pow(lower_del   r',2) + pow(lower_del   z',2)
+            val upper_disc =  (upper_del r')*(lower_del w') - 
+                              (upper_del z')*(lower_del u')
+            val lower_disc = (upper_del u')*(lower_del z') -
+                             (upper_del w') * (lower_del r')
+            val upper_ubar = if upper_disc<0.0   then upper_disc/xi    else 0.0
+            val lower_ubar = if lower_disc<0.0   then lower_disc/eta    else 0.0
+            val gamma    = 1.6
+            val speed_of_sound  =  gamma*sub2(p,zone)/sub2(rho',zone)
+            val ubar  =  pow(upper_ubar,2) + pow(lower_ubar,2)
+            val viscosity   =  
+                sub2(rho',zone)*(1.5*ubar + 0.5*speed_of_sound*(Math.sqrt ubar))
+            val length   = Math.sqrt(pow(upper_del r',2) + pow(lower_del r',2))
+            val courant_delta = 0.5* sub2(alpha',zone)/(speed_of_sound*length)
+        in (viscosity, courant_delta)
+        end
+        val q' = array2(dimension_all_zones, 0.0)
+        val d  = array2(dimension_all_zones, 0.0)
+        fun reflect_viscosity_cdelta (direction, zone) =
+            sub2(q',direction zone) * sub1(qb, sub2(nbc,zone))
+        fun do_zones (dir,zone) = 
+            update2(q',zone,reflect_viscosity_cdelta (dir,zone))
     in
-	for_interior_zones (fn zone => let val (qv,dv) = interior_viscosity zone
-				       in update2(q',zone,qv);
-					   update2(d,zone,dv)
-				       end);
-	for_south_zones (fn zone => do_zones(north,zone));
-	for_east_zones (fn zone => do_zones(west,zone));
-	for_west_zones (fn zone => do_zones(east,zone));
-	for_north_zones (fn zone => do_zones(south,zone));
+        for_interior_zones (fn zone => let val (qv,dv) = interior_viscosity zone
+                                       in update2(q',zone,qv);
+                                           update2(d,zone,dv)
+                                       end);
+        for_south_zones (fn zone => do_zones(north,zone));
+        for_east_zones (fn zone => do_zones(west,zone));
+        for_west_zones (fn zone => do_zones(east,zone));
+        for_north_zones (fn zone => do_zones(south,zone));
         (q', d) 
     end
 
@@ -557,35 +557,35 @@
 
 fun polynomial(G,degree,rho_table,theta_table,rho_value,theta_value) =
     let fun table_search (table, value : real) =
-	    let val (low, high) = bounds1  table
-		fun search_down  i =
-		   if  value > sub1(table,i-1)  then i
-				      else search_down (i-1)
-	    in  
-		if  value>sub1(table,high)  then  high+1
-		else if  value <= sub1(table,low)  then low
-		     else search_down   high
-	    end
-	val rho_index = table_search(rho_table, rho_value)
-	val theta_index = table_search(theta_table, theta_value)
-	val A =  sub2(G, (rho_index, theta_index))
-	fun from(n,m) = if n>m then [] else n::from(n+1,m)
-	fun f(i,j) = sub2(A,(i,j))*pow(rho_value,i)*pow(theta_value,j)
+            let val (low, high) = bounds1  table
+                fun search_down  i =
+                   if  value > sub1(table,i-1)  then i
+                                      else search_down (i-1)
+            in  
+                if  value>sub1(table,high)  then  high+1
+                else if  value <= sub1(table,low)  then low
+                     else search_down   high
+            end
+        val rho_index = table_search(rho_table, rho_value)
+        val theta_index = table_search(theta_table, theta_value)
+        val A =  sub2(G, (rho_index, theta_index))
+        fun from(n,m) = if n>m then [] else n::from(n+1,m)
+        fun f(i,j) = sub2(A,(i,j))*pow(rho_value,i)*pow(theta_value,j)
     in
-	sum_list (map (fn i => sum_list(map (fn j => f (i,j)) (from(0,degree))))
-		      (from (0,degree)))
+        sum_list (map (fn i => sum_list(map (fn j => f (i,j)) (from(0,degree))))
+                      (from (0,degree)))
     end
 fun zonal_pressure  (rho_value:real,  theta_value:real)  =
     let
        val (G,degree,rho_table,theta_table) = 
-		            extract_pressure_tables_from_constants
+                            extract_pressure_tables_from_constants
     in polynomial(G, degree, rho_table, theta_table, rho_value, theta_value)
     end
 
 
 fun zonal_energy (rho_value, theta_value) = 
     let val (G, degree, rho_table, theta_table) = 
-	   		    extract_energy_tables_from_constants
+                            extract_energy_tables_from_constants
     in polynomial(G, degree, rho_table, theta_table, rho_value, theta_value)
     end
 val dx =   0.000001
@@ -593,14 +593,14 @@
 
 
 fun newton_raphson (f,x) =
-    let	fun iter (x,fx) =
-	    if fx > tiny then 
-		let val fxdx = f(x+dx)
-		    val denom = fxdx - fx
-		in if denom < tiny then iter(x,tiny)
-		   else iter(x-fx*dx/denom, fxdx)
-		end
-	    else x
+    let fun iter (x,fx) =
+            if fx > tiny then 
+                let val fxdx = f(x+dx)
+                    val denom = fxdx - fx
+                in if denom < tiny then iter(x,tiny)
+                   else iter(x-fx*dx/denom, fxdx)
+                end
+            else x
     in iter(x, f x)
     end
 
@@ -610,31 +610,31 @@
 
 fun make_temperature(p,epsilon,rho,theta,rho_prime,q_prime) =
     let fun interior_temperature   zone =
-	    let val qkl = sub2(q_prime,zone)
-		val rho_kl = sub2(rho,zone)
-		val rho_prime_kl = sub2(rho_prime,zone)
-		val tau_kl = (1.0 /rho_prime_kl - 1.0/rho_kl)
-		fun energy_equation epsilon_kl   theta_kl =
-		    epsilon_kl -  zonal_energy(rho_kl,theta_kl)
-		val epsilon_0 = sub2(epsilon,zone)
-		fun revised_energy pkl =  epsilon_0 - (pkl + qkl) * tau_kl
-		fun revised_temperature  epsilon_kl   theta_kl =
-		    newton_raphson ((energy_equation epsilon_kl), theta_kl)
-		fun revised_pressure  theta_kl = zonal_pressure(rho_kl, theta_kl)
-		val p_0 = sub2(p,zone)
-		val theta_0 = sub2(theta,zone)
-		val epsilon_1 =  revised_energy    p_0
-		val theta_1 =  revised_temperature    epsilon_1    theta_0
-		val p_1 =  revised_pressure    theta_1
-		val epsilon_2 =  revised_energy    p_1
-		val theta_2 =  revised_temperature    epsilon_2    theta_1
-	    in  theta_2
-	    end
-	val M = array2(dimension_all_zones, constant_heat_source)
+            let val qkl = sub2(q_prime,zone)
+                val rho_kl = sub2(rho,zone)
+                val rho_prime_kl = sub2(rho_prime,zone)
+                val tau_kl = (1.0 /rho_prime_kl - 1.0/rho_kl)
+                fun energy_equation epsilon_kl   theta_kl =
+                    epsilon_kl -  zonal_energy(rho_kl,theta_kl)
+                val epsilon_0 = sub2(epsilon,zone)
+                fun revised_energy pkl =  epsilon_0 - (pkl + qkl) * tau_kl
+                fun revised_temperature  epsilon_kl   theta_kl =
+                    newton_raphson ((energy_equation epsilon_kl), theta_kl)
+                fun revised_pressure  theta_kl = zonal_pressure(rho_kl, theta_kl)
+                val p_0 = sub2(p,zone)
+                val theta_0 = sub2(theta,zone)
+                val epsilon_1 =  revised_energy    p_0
+                val theta_1 =  revised_temperature    epsilon_1    theta_0
+                val p_1 =  revised_pressure    theta_1
+                val epsilon_2 =  revised_energy    p_1
+                val theta_2 =  revised_temperature    epsilon_2    theta_1
+            in  theta_2
+            end
+        val M = array2(dimension_all_zones, constant_heat_source)
     in
-	for_interior_zones
-	      (fn zone => update2(M, zone, interior_temperature zone));
-	M
+        for_interior_zones
+              (fn zone => update2(M, zone, interior_temperature zone));
+        M
     end
 
 
@@ -644,14 +644,14 @@
 
 fun make_cc(alpha_prime, theta_hat) =
     let fun interior_cc zone =  
-	    (0.0001 * pow(sub2(theta_hat,zone),2) *
-	    (Math.sqrt (abs(sub2(theta_hat,zone)))) / sub2(alpha_prime,zone))
-	    handle Sqrt => (print ("<real>" (*Real.makestring (sub2(theta_hat, zone))*));
-			    print ("\nzone =(" (* ^ makestring (#1 zone) *) ^ "," ^ 
-				   (* makestring (#2 zone) ^ *) ")\n");
-			    printarray2 theta_hat;
-			    raise Sqrt)
-	val cc = array2(dimension_all_zones, 0.0)
+            (0.0001 * pow(sub2(theta_hat,zone),2) *
+            (Math.sqrt (abs(sub2(theta_hat,zone)))) / sub2(alpha_prime,zone))
+            handle Sqrt => (print ("<real>" (*Real.makestring (sub2(theta_hat, zone))*));
+                            print ("\nzone =(" (* ^ makestring (#1 zone) *) ^ "," ^ 
+                                   (* makestring (#2 zone) ^ *) ")\n");
+                            printarray2 theta_hat;
+                            raise Sqrt)
+        val cc = array2(dimension_all_zones, 0.0)
     in
        for_interior_zones(fn zone => update2(cc,zone, interior_cc zone));
        for_south_zones(fn zone => update2(cc,zone, reflect_north zone cc));
@@ -663,100 +663,100 @@
 
 fun make_sigma(deltat, rho_prime, alpha_prime) =
     let fun interior_sigma   zone =  
-	    sub2(rho_prime,zone)*sub2(alpha_prime,zone)*specific_heat/ deltat
-	val M = array2(dimension_interior_zones, 0.0)
-	fun ohandle zone =
-	    (print ( (* makestring (sub2(rho_prime, zone)) ^ *)" ");
-	     print ( (* makestring (sub2(alpha_prime, zone)) ^ *)" ");
-	     print ( (* makestring specific_heat ^ *) " ");
-	     print ( (* makestring deltat ^ *) "\n");
-	     raise Overflow)
-		    
+            sub2(rho_prime,zone)*sub2(alpha_prime,zone)*specific_heat/ deltat
+        val M = array2(dimension_interior_zones, 0.0)
+        fun ohandle zone =
+            (print ( (* makestring (sub2(rho_prime, zone)) ^ *)" ");
+             print ( (* makestring (sub2(alpha_prime, zone)) ^ *)" ");
+             print ( (* makestring specific_heat ^ *) " ");
+             print ( (* makestring deltat ^ *) "\n");
+             raise Overflow)
+                    
     in  if !trace 
         then print ("\t\tmake_sigma:deltat = " (* ^ makestring deltat *) ^ "\n")
-	else ();
-(***	for_interior_zones(fn zone => update2(M,zone, interior_sigma zone)) **)
-	for_interior_zones(fn zone => (update2(M,zone, interior_sigma zone)
-				       handle _ => (*old: Overflow => *)
-					 ohandle zone));
-	M
+        else ();
+(***    for_interior_zones(fn zone => update2(M,zone, interior_sigma zone)) **)
+        for_interior_zones(fn zone => (update2(M,zone, interior_sigma zone)
+                                       handle _ => (*old: Overflow => *)
+                                         ohandle zone));
+        M
     end
 
 fun make_gamma  ((r_prime,z_prime), cc, succeeding, adjacent) =
     let fun interior_gamma   zone =
-	    let val r1 = sub2(r_prime, zone_corner_southeast   zone)
-		val z1 = sub2(z_prime, zone_corner_southeast   zone)
-		val r2 = sub2(r_prime, zone_corner_southeast (adjacent   zone))
-		val z2 = sub2(z_prime, zone_corner_southeast (adjacent   zone))
-		val cross_section = 0.5*(r1+r2)*(pow(r1 - r2,2)+pow(z1 - z2,2))
-		val (c1,c2) = (sub2(cc, zone), sub2(cc, succeeding zone))
-		val specific_conductivity =  2.0 * c1 * c2 / (c1 + c2)
-	    in cross_section  *  specific_conductivity
-	    end
-	val M = array2(dimension_all_zones, 0.0)
+            let val r1 = sub2(r_prime, zone_corner_southeast   zone)
+                val z1 = sub2(z_prime, zone_corner_southeast   zone)
+                val r2 = sub2(r_prime, zone_corner_southeast (adjacent   zone))
+                val z2 = sub2(z_prime, zone_corner_southeast (adjacent   zone))
+                val cross_section = 0.5*(r1+r2)*(pow(r1 - r2,2)+pow(z1 - z2,2))
+                val (c1,c2) = (sub2(cc, zone), sub2(cc, succeeding zone))
+                val specific_conductivity =  2.0 * c1 * c2 / (c1 + c2)
+            in cross_section  *  specific_conductivity
+            end
+        val M = array2(dimension_all_zones, 0.0)
     in
-	for_interior_zones(fn zone => update2(M,zone,interior_gamma zone));
- 	M
+        for_interior_zones(fn zone => update2(M,zone,interior_gamma zone));
+        M
     end
 
 fun make_ab(theta, sigma, Gamma, preceding) =
     let val a = array2(dimension_all_zones, 0.0)
-	val b = array2(dimension_all_zones, 0.0)
-	fun interior_ab   zone =
-  	    let val denom = sub2(sigma, zone) + sub2(Gamma, zone) +
-		            sub2(Gamma, preceding zone) * 
-			    (1.0 - sub2(a, preceding zone))
-		val nume1 = sub2(Gamma,zone)
-		val nume2 = sub2(Gamma,preceding zone)*sub2(b,preceding zone) +
-		            sub2(sigma,zone) * sub2(theta,zone)
-	    in  (nume1/denom,  nume2 / denom)  
-	    end
-	val f  = fn zone => update2(b,zone,sub2(theta,zone))
+        val b = array2(dimension_all_zones, 0.0)
+        fun interior_ab   zone =
+            let val denom = sub2(sigma, zone) + sub2(Gamma, zone) +
+                            sub2(Gamma, preceding zone) * 
+                            (1.0 - sub2(a, preceding zone))
+                val nume1 = sub2(Gamma,zone)
+                val nume2 = sub2(Gamma,preceding zone)*sub2(b,preceding zone) +
+                            sub2(sigma,zone) * sub2(theta,zone)
+            in  (nume1/denom,  nume2 / denom)  
+            end
+        val f  = fn zone => update2(b,zone,sub2(theta,zone))
     in
-	for_north_zones f;
-	for_south_zones f;
-	for_west_zones f;
-	for_east_zones f;
-	for_interior_zones(fn zone => let val ab = interior_ab zone
-				      in update2(a,zone,#1 ab);
-					  update2(b,zone,#2 ab)
-				      end);
-	(a,b)
+        for_north_zones f;
+        for_south_zones f;
+        for_west_zones f;
+        for_east_zones f;
+        for_interior_zones(fn zone => let val ab = interior_ab zone
+                                      in update2(a,zone,#1 ab);
+                                          update2(b,zone,#2 ab)
+                                      end);
+        (a,b)
     end
 
 fun make_theta (a, b, succeeding, int_zones) =
     let val theta = array2(dimension_all_zones, constant_heat_source)
-	fun interior_theta zone =  
-	    sub2(a,zone) * sub2(theta,succeeding zone)+ sub2(b,zone)
+        fun interior_theta zone =  
+            sub2(a,zone) * sub2(theta,succeeding zone)+ sub2(b,zone)
     in
-	int_zones (fn (k,l) => update2(theta, (k,l), interior_theta (k,l)));
-	theta
+        int_zones (fn (k,l) => update2(theta, (k,l), interior_theta (k,l)));
+        theta
     end
 
 fun compute_heat_conduction(theta_hat, deltat, x', alpha', rho') =
-    let val sigma 	= make_sigma(deltat,  rho',  alpha')
-	val _ = if !trace then print "\tdone make_sigma\n" else ()
+    let val sigma       = make_sigma(deltat,  rho',  alpha')
+        val _ = if !trace then print "\tdone make_sigma\n" else ()
 
-	val cc 		= make_cc(alpha',  theta_hat)
-	val _ = if !trace then print "\tdone make_cc\n" else ()
+        val cc          = make_cc(alpha',  theta_hat)
+        val _ = if !trace then print "\tdone make_cc\n" else ()
 
-	val Gamma_k  	= make_gamma(  x', cc, north, east)
-	val _ = if !trace then print "\tdone make_gamma\n" else ()
+        val Gamma_k     = make_gamma(  x', cc, north, east)
+        val _ = if !trace then print "\tdone make_gamma\n" else ()
 
-	val (a_k,b_k)  	= make_ab(theta_hat, sigma, Gamma_k, north)
-	val _ = if !trace then print "\tdone make_ab\n" else ()
+        val (a_k,b_k)   = make_ab(theta_hat, sigma, Gamma_k, north)
+        val _ = if !trace then print "\tdone make_ab\n" else ()
 
-	val theta_k  	= make_theta(a_k,b_k,south,for_north_ward_interior_zones)
-	val _ = if !trace then print "\tdone make_theta\n" else ()
+        val theta_k     = make_theta(a_k,b_k,south,for_north_ward_interior_zones)
+        val _ = if !trace then print "\tdone make_theta\n" else ()
 
-	val Gamma_l  	= make_gamma(x', cc, west, south)
-	val _ = if !trace then print "\tdone make_gamma\n" else ()
+        val Gamma_l     = make_gamma(x', cc, west, south)
+        val _ = if !trace then print "\tdone make_gamma\n" else ()
 
-	val (a_l,b_l) 	= make_ab(theta_k, sigma, Gamma_l, west)
-	val _ = if !trace then print "\tdone make_ab\n" else ()
+        val (a_l,b_l)   = make_ab(theta_k, sigma, Gamma_l, west)
+        val _ = if !trace then print "\tdone make_ab\n" else ()
 
-	val theta_l  	= make_theta(a_l,b_l,east,for_west_ward_interior_zones)
-	val _ = if !trace then print "\tdone make_theta\n" else ()
+        val theta_l     = make_theta(a_l,b_l,east,for_west_ward_interior_zones)
+        val _ = if !trace then print "\tdone make_theta\n" else ()
     in  (theta_l, Gamma_k, Gamma_l)
     end
 
@@ -766,36 +766,36 @@
  *)
 fun make_pressure(rho', theta')  =
     let val p = array2(dimension_all_zones, 0.0)
-	fun boundary_p(direction, zone) = 
-	    sub1(pbb, sub2(nbc, zone)) + 
-	    sub1(pb,sub2(nbc,zone)) * sub2(p, direction zone)
+        fun boundary_p(direction, zone) = 
+            sub1(pbb, sub2(nbc, zone)) + 
+            sub1(pb,sub2(nbc,zone)) * sub2(p, direction zone)
     in
-	for_interior_zones
-	    (fn zone =>
-	     update2(p,zone,zonal_pressure(sub2(rho',zone),
-						      sub2(theta',zone))));
-	for_south_zones(fn zone => update2(p,zone,boundary_p(north,zone)));
-	for_east_zones(fn zone => update2(p,zone,boundary_p(west,zone)));
-	for_west_zones(fn zone => update2(p,zone,boundary_p(east,zone)));
-	for_north_zones(fn zone => update2(p,zone,boundary_p(south,zone)));
-	p
+        for_interior_zones
+            (fn zone =>
+             update2(p,zone,zonal_pressure(sub2(rho',zone),
+                                                      sub2(theta',zone))));
+        for_south_zones(fn zone => update2(p,zone,boundary_p(north,zone)));
+        for_east_zones(fn zone => update2(p,zone,boundary_p(west,zone)));
+        for_west_zones(fn zone => update2(p,zone,boundary_p(east,zone)));
+        for_north_zones(fn zone => update2(p,zone,boundary_p(south,zone)));
+        p
     end
 
 fun make_energy(rho', theta')  =
     let val epsilon' = array2(dimension_all_zones, 0.0)
     in
-	for_interior_zones
-	  (fn zone => update2(epsilon', zone, zonal_energy(sub2(rho',zone),
-							   sub2(theta',zone))));
+        for_interior_zones
+          (fn zone => update2(epsilon', zone, zonal_energy(sub2(rho',zone),
+                                                           sub2(theta',zone))));
         for_south_zones
-	  (fn zone => update2(epsilon',zone, reflect_north zone epsilon'));
+          (fn zone => update2(epsilon',zone, reflect_north zone epsilon'));
         for_west_zones
-	  (fn zone => update2(epsilon',zone, reflect_east zone epsilon'));
+          (fn zone => update2(epsilon',zone, reflect_east zone epsilon'));
         for_east_zones
-	  (fn zone => update2(epsilon',zone, reflect_west  zone epsilon'));
-	for_north_zones
-	  (fn zone => update2(epsilon',zone, reflect_south zone epsilon'));
-	epsilon'
+          (fn zone => update2(epsilon',zone, reflect_west  zone epsilon'));
+        for_north_zones
+          (fn zone => update2(epsilon',zone, reflect_south zone epsilon'));
+        epsilon'
     end
 
 
@@ -804,41 +804,41 @@
  *)
 
 fun compute_energy_error  ((u',w'),(r',z'),p',q',epsilon',theta',rho',alpha',
-			   Gamma_k,Gamma_l,deltat)  =
+                           Gamma_k,Gamma_l,deltat)  =
     let fun mass zone =  sub2(rho',zone) * sub2(alpha',zone):real
-	val internal_energy = 
-	    sum_list (map_interior_zones (fn z => sub2(epsilon',z)*(mass z)))
-	fun kinetic   node =
-	    let val average_mass =  0.25*((mass (zone_A  node)) + 
-					  (mass (zone_B  node)) +
-					  (mass (zone_C  node)) + 
-					  (mass (zone_D  node)))
-		val v_square = pow(sub2(u',node),2) + pow(sub2(w',node),2)
-	    in 0.5 * average_mass * v_square
-	    end
-	val kinetic_energy =  sum_list (map_interior_nodes kinetic)
+        val internal_energy = 
+            sum_list (map_interior_zones (fn z => sub2(epsilon',z)*(mass z)))
+        fun kinetic   node =
+            let val average_mass =  0.25*((mass (zone_A  node)) + 
+                                          (mass (zone_B  node)) +
+                                          (mass (zone_C  node)) + 
+                                          (mass (zone_D  node)))
+                val v_square = pow(sub2(u',node),2) + pow(sub2(w',node),2)
+            in 0.5 * average_mass * v_square
+            end
+        val kinetic_energy =  sum_list (map_interior_nodes kinetic)
       fun work_done (node1, node2)  =
-	  let val (r1, r2) = (sub2(r',node1), sub2(r',node2))
-	      val (z1, z2) = (sub2(z',node1), sub2(z',node2))
-	      val (u1, u2) = (sub2(p',node1), sub2(p',node2))
-	      val (w1, w2) = (sub2(z',node1), sub2(z',node2))
-	      val (p1, p2) = (sub2(p',node1), sub2(p',node2))
-	      val (q1, q2) = (sub2(q',node1), sub2(q',node2))
-	      val force =  0.5*(p1+p2+q1+q2)
-	      val radius = 0.5* (r1+r2)
-	      val area =   0.5* ((r1-r2)*(u1-u2) - (z1-z2)*(w1-w2))
-	  in  force * radius * area * deltat
-	  end
+          let val (r1, r2) = (sub2(r',node1), sub2(r',node2))
+              val (z1, z2) = (sub2(z',node1), sub2(z',node2))
+              val (u1, u2) = (sub2(p',node1), sub2(p',node2))
+              val (w1, w2) = (sub2(z',node1), sub2(z',node2))
+              val (p1, p2) = (sub2(p',node1), sub2(p',node2))
+              val (q1, q2) = (sub2(q',node1), sub2(q',node2))
+              val force =  0.5*(p1+p2+q1+q2)
+              val radius = 0.5* (r1+r2)
+              val area =   0.5* ((r1-r2)*(u1-u2) - (z1-z2)*(w1-w2))
+          in  force * radius * area * deltat
+          end
 
       fun from(n,m) = if n > m then [] else n::from(n+1,m)
       val north_line = 
-	  map (fn l => (west(kmin,l),(kmin,l))) (from(lmin+1,lmax))
+          map (fn l => (west(kmin,l),(kmin,l))) (from(lmin+1,lmax))
       val south_line =
-	  map (fn l => (west(kmax,l),(kmax,l))) (from(lmin+1,lmax))
+          map (fn l => (west(kmax,l),(kmax,l))) (from(lmin+1,lmax))
       val east_line  =
-	  map (fn k => (south(k,lmax),(k,lmax))) (from(kmin+1,kmax))
+          map (fn k => (south(k,lmax),(k,lmax))) (from(kmin+1,kmax))
       val west_line  =
-	  map (fn k => (south(k,lmin+1),(k,lmin+1))) (from(kmin+1,kmax))
+          map (fn k => (south(k,lmin+1),(k,lmin+1))) (from(kmin+1,kmax))
 
       val w1 = sum_list (map work_done north_line)
       val w2  = sum_list (map work_done south_line)
@@ -847,24 +847,24 @@
       val boundary_work =  w1 + w2 + w3 + w4
 
       fun heat_flow  Gamma (zone1,zone2)  =
-	deltat * sub2(Gamma, zone1) * (sub2(theta',zone1) - sub2(theta',zone2))
+        deltat * sub2(Gamma, zone1) * (sub2(theta',zone1) - sub2(theta',zone2))
 
       val north_flow =
-	  let val k = kmin+1 
-	  in map (fn l => (north(k,l),(k,l))) (from(lmin+1,lmax))
-	  end
+          let val k = kmin+1 
+          in map (fn l => (north(k,l),(k,l))) (from(lmin+1,lmax))
+          end
       val south_flow =
-	  let val k = kmax
-	  in map (fn l => (south(k,l),(k,l))) (from(lmin+2,lmax-1))
-	  end
+          let val k = kmax
+          in map (fn l => (south(k,l),(k,l))) (from(lmin+2,lmax-1))
+          end
       val east_flow  =
-	  let val l = lmax
-	  in map (fn k => (east(k,l),(k,l))) (from(kmin+2,kmax))
-	  end
+          let val l = lmax
+          in map (fn k => (east(k,l),(k,l))) (from(kmin+2,kmax))
+          end
       val west_flow  =
-	  let val l = lmin+1
-	  in map (fn k => (west(k,l),(k,l))) (from(kmin+2,kmax))
-	  end
+          let val l = lmin+1
+          in map (fn k => (west(k,l),(k,l))) (from(kmin+2,kmax))
+          end
 
      val h1  = sum_list    (map (heat_flow  Gamma_k)   north_flow)
      val h2  = sum_list    (map (heat_flow  Gamma_k)   south_flow)
@@ -872,17 +872,17 @@
      val h4  = sum_list    (map (heat_flow  Gamma_l)   west_flow)
      val boundary_heat =  h1 + h2 + h3 + h4
     in 
-	internal_energy  +  kinetic_energy  -  boundary_heat  -  boundary_work
+        internal_energy  +  kinetic_energy  -  boundary_heat  -  boundary_work
     end
 
 fun compute_time_step(d, theta_hat,  theta') =
     let val deltat_courant =
-	    min_list (map_interior_zones (fn zone => sub2(d,zone)))
-	val deltat_conduct =
-	    max_list (map_interior_zones 
-		        (fn z => (abs(sub2(theta_hat,z) - sub2(theta', z))/
-				  sub2(theta_hat,z))))
-	val deltat_minimum = min (deltat_courant, deltat_conduct)
+            min_list (map_interior_zones (fn zone => sub2(d,zone)))
+        val deltat_conduct =
+            max_list (map_interior_zones 
+                        (fn z => (abs(sub2(theta_hat,z) - sub2(theta', z))/
+                                  sub2(theta_hat,z))))
+        val deltat_minimum = min (deltat_courant, deltat_conduct)
     in min   (deltat_maximum,  deltat_minimum)
     end
 
@@ -890,107 +890,107 @@
 fun compute_initial_state () = 
     let 
         val v  = (all_zero_nodes, all_zero_nodes)
-	val x  = let fun interior_position  (k,l)  =
-	                 let val pi = 3.1415926535898
-			     val rp = real (lmax - lmin)
-			     val z1 = real(10 + k - kmin)
-			     val zz = (~0.5 + real(l - lmin) / rp) * pi
-			 in (z1 * Math.cos zz,  z1 * Math.sin zz)
-			 end
-		 in  make_position_matrix interior_position
-		 end
-	val (alpha,s) = 
-	    let val (alpha_prime,s_prime) = 
-		    let val A = array2(dimension_all_zones, 0.0)
-			val S = array2(dimension_all_zones, 0.0)
-			fun reflect_area_vol f = (f A, f S)
+        val x  = let fun interior_position  (k,l)  =
+                         let val pi = 3.1415926535898
+                             val rp = real (lmax - lmin)
+                             val z1 = real(10 + k - kmin)
+                             val zz = (~0.5 + real(l - lmin) / rp) * pi
+                         in (z1 * Math.cos zz,  z1 * Math.sin zz)
+                         end
+                 in  make_position_matrix interior_position
+                 end
+        val (alpha,s) = 
+            let val (alpha_prime,s_prime) = 
+                    let val A = array2(dimension_all_zones, 0.0)
+                        val S = array2(dimension_all_zones, 0.0)
+                        fun reflect_area_vol f = (f A, f S)
 
-			fun u2 (f,z) = 
-			    let val (a,s) = reflect_area_vol(f z)
-			    in update2(A,z,a);
-				update2(S,z,s)
-			    end
-		    in
-			for_interior_zones 
-			   (fn z => let val (a,s) = zone_area_vol(x, z)
-				    in update2(A,z,a);
-					update2(S,z,s)
-				    end);
-			for_south_zones (fn z => u2 (reflect_north, z));
-			for_east_zones (fn z => u2 (reflect_west, z));
-			for_west_zones (fn z => u2 (reflect_east, z));
-			for_north_zones (fn z => u2 (reflect_south, z));
-			(A,S)
-		    end
-	    in  (alpha_prime,s_prime)
-	    end
-	val rho  = let val R = array2(dimension_all_zones, 0.0)
-		   in for_all_zones (fn z => update2(R,z,1.4)); R
-		   end
-	val theta = 
-	    let val T = array2(dimension_all_zones, constant_heat_source)
-	    in for_interior_zones(fn z => update2(T,z,0.0001));
-		T
-	    end
-	val p       = make_pressure(rho, theta)
-	val q       = all_zero_zones
-	val epsilon = make_energy(rho, theta)
-	val  deltat  = 0.01
-	val  c       = 0.0
+                        fun u2 (f,z) = 
+                            let val (a,s) = reflect_area_vol(f z)
+                            in update2(A,z,a);
+                                update2(S,z,s)
+                            end
+                    in
+                        for_interior_zones 
+                           (fn z => let val (a,s) = zone_area_vol(x, z)
+                                    in update2(A,z,a);
+                                        update2(S,z,s)
+                                    end);
+                        for_south_zones (fn z => u2 (reflect_north, z));
+                        for_east_zones (fn z => u2 (reflect_west, z));
+                        for_west_zones (fn z => u2 (reflect_east, z));
+                        for_north_zones (fn z => u2 (reflect_south, z));
+                        (A,S)
+                    end
+            in  (alpha_prime,s_prime)
+            end
+        val rho  = let val R = array2(dimension_all_zones, 0.0)
+                   in for_all_zones (fn z => update2(R,z,1.4)); R
+                   end
+        val theta = 
+            let val T = array2(dimension_all_zones, constant_heat_source)
+            in for_interior_zones(fn z => update2(T,z,0.0001));
+                T
+            end
+        val p       = make_pressure(rho, theta)
+        val q       = all_zero_zones
+        val epsilon = make_energy(rho, theta)
+        val  deltat  = 0.01
+        val  c       = 0.0
     in
-	(v,x,alpha,s,rho,p,q,epsilon,theta,deltat,c)
+        (v,x,alpha,s,rho,p,q,epsilon,theta,deltat,c)
     end
 
 
 fun compute_next_state state =
     let
-	val (v,x,alpha,s,rho,p,q,epsilon,theta,deltat,c) = state
-	val v'  = make_velocity (v, x, p, q, alpha, rho, deltat)
-	val _ = if !trace then print "done make_velocity\n" else ()
+        val (v,x,alpha,s,rho,p,q,epsilon,theta,deltat,c) = state
+        val v'  = make_velocity (v, x, p, q, alpha, rho, deltat)
+        val _ = if !trace then print "done make_velocity\n" else ()
 
-	val x'  = make_position(x,deltat,v') 
-	          handle _ => ( (* old: handle Overflow => *)
-				     printarray2 (#1 v'); 
-				     printarray2 (#2 v');
-				     raise Overflow)
-	val _ = if !trace then print "done make_position\n" else ()
+        val x'  = make_position(x,deltat,v') 
+                  handle _ => ( (* old: handle Overflow => *)
+                                     printarray2 (#1 v'); 
+                                     printarray2 (#2 v');
+                                     raise Overflow)
+        val _ = if !trace then print "done make_position\n" else ()
 
-	val (alpha',rho',s')  = make_area_density_volume (rho,  s , x')
-	val _ = if !trace then print "done make_area_density_volume\n"
-		else ()
+        val (alpha',rho',s')  = make_area_density_volume (rho,  s , x')
+        val _ = if !trace then print "done make_area_density_volume\n"
+                else ()
 
-	val (q',d)  = make_viscosity (p,  v',  x',  alpha',  rho')
-	val _ = if !trace then print "done make_viscosity\n" else ()
+        val (q',d)  = make_viscosity (p,  v',  x',  alpha',  rho')
+        val _ = if !trace then print "done make_viscosity\n" else ()
 
-	val theta_hat  = make_temperature (p, epsilon, rho, theta, rho', q')
-	val _ = if !trace then print "done make_temperature\n" else ()
+        val theta_hat  = make_temperature (p, epsilon, rho, theta, rho', q')
+        val _ = if !trace then print "done make_temperature\n" else ()
 
-	val (theta',Gamma_k,Gamma_l) =
-	    compute_heat_conduction (theta_hat, deltat, x', alpha', rho')
-	val _ = if !trace then print "done compute_heat_conduction\n"
-		else ()
+        val (theta',Gamma_k,Gamma_l) =
+            compute_heat_conduction (theta_hat, deltat, x', alpha', rho')
+        val _ = if !trace then print "done compute_heat_conduction\n"
+                else ()
 
-	val p'  = make_pressure(rho', theta')
-	val _ = if !trace then print "done make_pressure\n" else ()
+        val p'  = make_pressure(rho', theta')
+        val _ = if !trace then print "done make_pressure\n" else ()
 
-	val epsilon'  = make_energy (rho', theta')
-	val _ = if !trace then print "done make_energy\n" else ()
+        val epsilon'  = make_energy (rho', theta')
+        val _ = if !trace then print "done make_energy\n" else ()
 
-	val c'  = compute_energy_error (v', x', p', q', epsilon', theta', rho', 
-					alpha', Gamma_k, Gamma_l,  deltat)
-	val _ = if !trace then print "done compute_energy_error\n" 
-		else ()
+        val c'  = compute_energy_error (v', x', p', q', epsilon', theta', rho', 
+                                        alpha', Gamma_k, Gamma_l,  deltat)
+        val _ = if !trace then print "done compute_energy_error\n" 
+                else ()
 
-	val deltat'  = compute_time_step (d, theta_hat, theta')
-	val _ = if !trace then print "done compute_time_step\n\n" else ()
+        val deltat'  = compute_time_step (d, theta_hat, theta')
+        val _ = if !trace then print "done compute_time_step\n\n" else ()
     in
-	(v',x',alpha',s',rho',p',q',  epsilon',theta',deltat',c')
+        (v',x',alpha',s',rho',p',q',  epsilon',theta',deltat',c')
     end
 
 fun runit () = 
     let fun iter (i,state) = if i = 0 then state
-			     else (print ".";
-				   iter(i-1, compute_next_state state))
+                             else (print ".";
+                                   iter(i-1, compute_next_state state))
     in iter(step_count, compute_initial_state())
     end
 
@@ -1030,20 +1030,20 @@
     fun testit outstrm = print_state (runit())
 
     fun doit () = let
-	  val (_, _, _, _, _, _, _, _, _, delta', c') = runit()
-	  val delta : int = floor (* truncate *) delta'
-	  val c : int = floor (* truncate *) (c' * 10000.0)
-	  val _ = print(int_to_string(c))
-	  val _ = print("\n")
-	  val _ = print(int_to_string(delta))
-	  val _ = print("\n")
-	  in
-	    if (c = 3072 andalso delta = ~61403) (* for grid_max = 30 *)
-	      (* (c = 6787 andalso delta = ~33093) *)
-	      then ()
-	      else print("*** ERROR ***\n")
-		  (*old : IO.output (IO.std_err, "*** ERROR ***\n") *)
-	  end
+          val (_, _, _, _, _, _, _, _, _, delta', c') = runit()
+          val delta : int = floor (* truncate *) delta'
+          val c : int = floor (* truncate *) (c' * 10000.0)
+          val _ = print(int_to_string(c))
+          val _ = print("\n")
+          val _ = print(int_to_string(delta))
+          val _ = print("\n")
+          in
+            if (c = 3072 andalso delta = ~61403) (* for grid_max = 30 *)
+              (* (c = 6787 andalso delta = ~33093) *)
+              then ()
+              else print("*** ERROR ***\n")
+                  (*old : IO.output (IO.std_err, "*** ERROR ***\n") *)
+          end
 
 (*
   end; (* functor Simple *)

Modified: mlton/branches/on-20050420-cmm-branch/regression/kkb36c.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/kkb36c.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/kkb36c.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -38,32 +38,32 @@
     struct
   *)
       fun length l = let
-  	  fun j(k, nil) = k
-  	    | j(k, a::x) = j(k+1,x)
-  	  in
-  	    j(0,l)
-  	  end
+          fun j(k, nil) = k
+            | j(k, a::x) = j(k+1,x)
+          in
+            j(0,l)
+          end
       fun op @ (nil, l) = l
         | op @ (a::r, l) = a :: (r@l)
       fun rev l = let
-  	  fun f (nil, h) = h
-  	    | f (a::r, h) = f(r, a::h)
-  	  in
-  	    f(l,nil)
-  	  end
+          fun f (nil, h) = h
+            | f (a::r, h) = f(r, a::h)
+          in
+            f(l,nil)
+          end
       fun app f = let
-  	  fun app_rec [] = ()
+          fun app_rec [] = ()
               | app_rec (a::L) = (f a; app_rec L)
           in
-  	  app_rec
+          app_rec
           end
   (*
       fun map f = let
-  	  fun map_rec [] = []
+          fun map_rec [] = []
               | map_rec (a::L) = f a :: map_rec L
             in
-  	    map_rec
-    	  end
+            map_rec
+          end
   *)
   
   (******* Quelques definitions du prelude CAML **************)
@@ -273,7 +273,7 @@
             else
               (v,M) :: subst
           | match_rec subst (Term(op1,sons1), Term(op2,sons2)) =
-  	  if eq_string(op1,op2) then it_list2 match_rec subst sons1 sons2
+          if eq_string(op1,op2) then it_list2 match_rec subst sons1 sons2
                          else raise FailMatching
           | match_rec _ _ = raise FailMatching
     in match_rec [] (term1,term2)
@@ -299,7 +299,7 @@
         else [(n2,term1)]
     | unify (Term(op1,sons1), Term(op2,sons2)) =
         if eq_string(op1,op2) then 
-  	it_list2 (fn s => fn (t1,t2) => compsubst (unify(substitute s t1,
+        it_list2 (fn s => fn (t1,t2) => compsubst (unify(substitute s t1,
                                                            substitute s t2)) s)
                    [] sons1 sons2
         else raise FailUnify
@@ -321,7 +321,7 @@
         else
          (print_string oper;
           case sons of
-  	     []   => ()
+             []   => ()
             | t::lt =>(print_string "(";
                        pretty_term t;
                        app (fn t => (print_string ","; pretty_term t)) lt;

Modified: mlton/branches/on-20050420-cmm-branch/regression/kkb_eq.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/kkb_eq.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/kkb_eq.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -36,31 +36,31 @@
   struct
 *)
     fun length l = let
-	  fun j(k, nil) = k
-	    | j(k, a::x) = j(k+1,x)
-	  in
-	    j(0,l)
-	  end
+          fun j(k, nil) = k
+            | j(k, a::x) = j(k+1,x)
+          in
+            j(0,l)
+          end
     fun op @ (nil, l) = l
       | op @ (a::r, l) = a :: (r@l)
     fun rev l = let
-	  fun f (nil, h) = h
-	    | f (a::r, h) = f(r, a::h)
-	  in
-	    f(l,nil)
-	  end
+          fun f (nil, h) = h
+            | f (a::r, h) = f(r, a::h)
+          in
+            f(l,nil)
+          end
     fun app f = let
-	  fun app_rec [] = ()
+          fun app_rec [] = ()
             | app_rec (a::L) = (f a; app_rec L)
         in
-	  app_rec
+          app_rec
         end
     fun map f = let
-	  fun map_rec [] = []
+          fun map_rec [] = []
             | map_rec (a::L) = f a :: map_rec L
           in
-	    map_rec
-  	  end
+            map_rec
+          end
 
 (******* Quelques definitions du prelude CAML **************)
 
@@ -239,7 +239,7 @@
           else
             (v,M) :: subst
         | match_rec subst (Term(op1,sons1), Term(op2,sons2)) =
-	  if op1 = op2 then it_list2 match_rec subst sons1 sons2
+          if op1 = op2 then it_list2 match_rec subst sons1 sons2
                        else raise FailMatching
         | match_rec _ _ = raise FailMatching
   in match_rec [] (term1,term2)
@@ -265,7 +265,7 @@
       else [(n2,term1)]
   | unify (Term(op1,sons1), Term(op2,sons2)) =
       if op1 = op2 then 
-	it_list2 (fn s => fn (t1,t2) => compsubst (unify(substitute s t1,
+        it_list2 (fn s => fn (t1,t2) => compsubst (unify(substitute s t1,
                                                          substitute s t2)) s)
                  [] sons1 sons2
       else raise FailUnify
@@ -287,7 +287,7 @@
       else
        (print_string oper;
         case sons of
-	     []   => ()
+             []   => ()
           | t::lt =>(print_string "(";
                      pretty_term t;
                      app (fn t => (print_string ","; pretty_term t)) lt;
@@ -314,7 +314,7 @@
 fun check_rules x =
   it_list (fn n => fn (k,_) =>
              if k = n+1 then k
-	     else raise Fail (*failwith "Rule numbers not in sequence"*)
+             else raise Fail (*failwith "Rule numbers not in sequence"*)
           ) 0 x
 
 fun pretty_rule (k,(n,(M,N))) =
@@ -339,10 +339,10 @@
 fun reducible L =
   let
      fun redrec M =
-	(matching L M; true)
-	handle _ =>
-	   case M of Term(_,sons) => exists redrec sons
-	 |        _     => false
+        (matching L M; true)
+        handle _ =>
+           case M of Term(_,sons) => exists redrec sons
+         |        _     => false
   in redrec
   end
 
@@ -356,15 +356,15 @@
 fun mrewrite1 rules =
   let
      fun rewrec M =
-	(mreduce rules M)
-	handle _ =>
-	   let fun tryrec [] = raise FailMrewrite1 (*failwith "mrewrite1"*)
-		 | tryrec (son::rest) =
-		   (rewrec son :: rest) handle _ => son :: tryrec rest
-	   in case M of
-	      Term(f, sons) => Term(f, tryrec sons)
-	    | _ => raise FailMrewrite1 (*failwith "mrewrite1"*)
-	   end
+        (mreduce rules M)
+        handle _ =>
+           let fun tryrec [] = raise FailMrewrite1 (*failwith "mrewrite1"*)
+                 | tryrec (son::rest) =
+                   (rewrec son :: rest) handle _ => son :: tryrec rest
+           in case M of
+              Term(f, sons) => Term(f, tryrec sons)
+            | _ => raise FailMrewrite1 (*failwith "mrewrite1"*)
+           end
   in rewrec
   end
 
@@ -373,7 +373,7 @@
 fun mrewrite_all rules M =
   let
      fun rew_loop M =
-	rew_loop(mrewrite1 rules M)  handle  _ => M
+        rew_loop(mrewrite1 rules M)  handle  _ => M
   in rew_loop M
   end
 

Modified: mlton/branches/on-20050420-cmm-branch/regression/klife_eq.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/klife_eq.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/klife_eq.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -71,14 +71,14 @@
       fun occurs3 x = 
           (* finds coords which occur exactly 3 times in coordlist x *)
           let
-	    fun diff x y = filter (fn x => not(member x y)) x  (* unfolded o *)
-	    fun f xover x3 x2 x1 [] = diff x3 xover
+            fun diff x y = filter (fn x => not(member x y)) x  (* unfolded o *)
+            fun f xover x3 x2 x1 [] = diff x3 xover
                 | f xover x3 x2 x1 (a::x) = 
                    if member a xover then f xover x3 x2 x1 x else
                    if member a x3 then f (a::xover) x3 x2 x1 x else
-		   if member a x2 then f xover (a::x3) x2 x1 x else
+                   if member a x2 then f xover (a::x3) x2 x1 x else
                    if member a x1 then f xover x3 (a::x2) x1 x else
-		                       f xover x3 x2 (a::x1) x
+                                       f xover x3 x2 (a::x1) x
            in f [] [] [] [] x end
 (*     in 
 *)
@@ -100,17 +100,17 @@
                   fun isalive x = copy_bool(member x living) (* eta *)
                   fun liveneighbours x = length( filter isalive ( neighbours x)) (*eta*)
                   fun twoorthree n = n = 2 orelse n = 3
-	          val survivors = copy_list(filter (twoorthree o liveneighbours) living)
-	          val newnbrlist = copy_list(collect (fn z => filter (fn x => not( isalive x)) ( neighbours z)) living) (* unfolded o twice*)
-	          val newborn = copy_list(occurs3 newnbrlist)
-	       in mkgen (survivors @ newborn) end
+                  val survivors = copy_list(filter (twoorthree o liveneighbours) living)
+                  val newnbrlist = copy_list(collect (fn z => filter (fn x => not( isalive x)) ( neighbours z)) living) (* unfolded o twice*)
+                  val newborn = copy_list(occurs3 newnbrlist)
+               in mkgen (survivors @ newborn) end
               else gen
      end
 (*    end*)
 
     fun neighbours (i,j) = [(i-1,j-1),(i-1,j),(i-1,j+1),
-			    (i,j-1),(i,j+1),
-			    (i+1,j-1),(i+1,j),(i+1,j+1)]
+                            (i,j-1),(i,j+1),
+                            (i+1,j-1),(i+1,j),(i+1,j+1)]
 
     local val xstart = 0 and ystart = 0
           fun markafter n string = string ^ spaces n ^ "0"
@@ -138,12 +138,12 @@
     val bail = [(0,0),(0,1),(1,0),(1,1)]
     fun barberpole n =
        let fun f i = if i = n then (n+n-1,n+n)::(n+n,n+n)::nil
-		     else (i+i,i+i+1)::(i+i+2,i+i+1)::f(i+1)
+                     else (i+i,i+i+1)::(i+i+2,i+i+1)::f(i+1)
         in (0,0)::(1,0):: f 0
        end
 
     val genB = mkgen(glider at (2,2) @ bail at (2,12)
-		     @ rotate (barberpole 4) at (5,20))
+                     @ rotate (barberpole 4) at (5,20))
 
     fun copy_whole_arg (p, g) = (p, copy g)
 

Modified: mlton/branches/on-20050420-cmm-branch/regression/lambda-list-ref.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/lambda-list-ref.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/lambda-list-ref.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -4,5 +4,5 @@
 val _ = r := (fn x => x + 2) :: ! r
 
 val _ = app (fn f => (f 13; ())) (!r)
-				     
+                                     
    

Modified: mlton/branches/on-20050420-cmm-branch/regression/lib.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/lib.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/lib.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -22,10 +22,10 @@
 fun seek (pred: char -> bool) (is: TextIO.instream): char list = 
   let fun readLoop() =
             (case explode (TextIO.inputN(is, 1)) of
-	       []  =>  []
-	     | [char] => char :: (if pred char then  []
-				  else readLoop())
-	     | _ => (print "lib.seek: impossible"; raise Impossible))
+               []  =>  []
+             | [char] => char :: (if pred char then  []
+                                  else readLoop())
+             | _ => (print "lib.seek: impossible"; raise Impossible))
   in readLoop()
   end
 

Modified: mlton/branches/on-20050420-cmm-branch/regression/life.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/life.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/life.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -126,17 +126,17 @@
                   | ( xover, x3, x2, x1, (a::x)) =>
                      if member eq_int_pair_curry xover a then f( xover, x3, x2, x1, x) else
                      if member eq_int_pair_curry x3 a then f ((a::xover), x3, x2, x1, x) else
-  		   if member eq_int_pair_curry x2 a then f (xover, (a::x3), x2, x1, x) else
+                   if member eq_int_pair_curry x2 a then f (xover, (a::x3), x2, x1, x) else
                      if member eq_int_pair_curry x1 a then f (xover, x3, (a::x2), x1, x) else
-  		                       f (xover, x3, x2, (a::x1), x)
+                                       f (xover, x3, x2, (a::x1), x)
                 fun diff x y = filter (fn x => not(member eq_int_pair_curry y x)) x  (* unfolded o *)
                 val (xover, x3, _, _, _) = f ([],[],[],[],x)
              in diff x3 xover end
   
   
   fun neighbours (i,j) = [(i-1,j-1),(i-1,j),(i-1,j+1),
-  			    (i,j-1),(i,j+1),
-  			    (i+1,j-1),(i+1,j),(i+1,j+1)]
+                            (i,j-1),(i,j+1),
+                            (i+1,j-1),(i+1,j),(i+1,j+1)]
   
   infix footnote
   fun x footnote y = x

Modified: mlton/branches/on-20050420-cmm-branch/regression/list.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/list.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/list.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -8,7 +8,7 @@
 fun range (from, to) p = 
     let open Int 
     in
-	(from > to) orelse (p from) andalso (range (from+1, to) p)
+        (from > to) orelse (p from) andalso (range (from+1, to) p)
     end;
 
 fun checkrange bounds = check o range bounds;
@@ -52,7 +52,7 @@
 val test11 = tst "test11" ([1,2,3,4,5,6] = v16);
 
 val test12 = tst "test12" (concat [] = [] andalso concat [v16] = v16 
-			   andalso concat [v123, [4,5,6]] = v16);
+                           andalso concat [v123, [4,5,6]] = v16);
 
 val test13 = tst "test13"(rev v16 = revAppend([4,5,6], [3,2,1]));
 
@@ -72,7 +72,7 @@
 
 val test16 = 
     tst "test16" ([3,9,15] = 
-	  mapPartial (fn i => if even i then NONE else SOME (3*i)) v16);
+          mapPartial (fn i => if even i then NONE else SOME (3*i)) v16);
 
 val test17 = tst "test17" (NONE = find (fn i => i>7) v16);
 
@@ -97,10 +97,10 @@
 val test28 = tst "test28" (21 = foldr op+ 0 v16 andalso 21 = foldl op+ 0 v16);
 
 val test29 = tst "test29" (all (fn _ => false) [] 
-		   andalso not (exists (fn _ => true) [])); 
+                   andalso not (exists (fn _ => true) [])); 
 
 val test30 = tst "test30" (exists even [1,1,1,1,1,1,2,1] 
-		   andalso all even [6,6,6,6,6,6,6,6]);
+                   andalso all even [6,6,6,6,6,6,6,6]);
 
 val test31 = tst "test31" (v16 = tabulate (6, fn i => i+1));
 
@@ -109,19 +109,19 @@
 val test33 = tst "test33" ([] = tabulate (0, fn i => 1 div i));
 
 val test34 = tst0 "test36b" ((tabulate(~1, fn _ => raise Div) seq "WRONG") 
-			     handle Size => "OK" | _ => "WRONG")
+                             handle Size => "OK" | _ => "WRONG")
 
 val test35a = tst "test35a" (drop([], 0) = [] 
-		   andalso drop(v123, 0) = v123 
-		   andalso drop(v123, 3) = []);
+                   andalso drop(v123, 0) = v123 
+                   andalso drop(v123, 3) = []);
 val test35b = tst0 "test36b" ((drop(v123, ~1) seq "WRONG") 
               handle Subscript => "OK" | _ => "WRONG")
 val test35c = tst0 "test35c" ((drop(v123, 4) seq "WRONG") 
               handle Subscript => "OK" | _ => "WRONG")
 
 val test36a = tst "test36a" (take([], 0) = [] 
-		   andalso take(v123, 3) = v123
-		   andalso take(v123, 0) = []);
+                   andalso take(v123, 3) = v123
+                   andalso take(v123, 0) = []);
 val test36b = tst0 "test36b" ((take(v123, ~1) seq "WRONG") 
               handle Subscript => "OK" | _ => "WRONG")
 val test36c = tst0 "test36c" ((take(v123, 4) seq "WRONG") 
@@ -129,6 +129,6 @@
 
 val test37a = 
     tst' "test37a" (fn _ => getItem [] = NONE
-	   andalso getItem [#"A"] = SOME(#"A", [])
-	   andalso getItem [#"B", #"C"] = SOME(#"B", [#"C"]));
+           andalso getItem [#"A"] = SOME(#"A", [])
+           andalso getItem [#"B", #"C"] = SOME(#"B", [#"C"]));
 end;

Modified: mlton/branches/on-20050420-cmm-branch/regression/listpair.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/listpair.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/listpair.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -8,7 +8,7 @@
 fun range (from, to) p = 
     let open Int 
     in
-	(from > to) orelse (p from) andalso (range (from+1, to) p)
+        (from > to) orelse (p from) andalso (range (from+1, to) p)
     end;
 
 fun checkrange bounds = check o range bounds;
@@ -41,19 +41,19 @@
 in 
 
 val test1 = tst "test1" (zip([], []) = [] 
-		  andalso zip ([], a) = [] 
-		  andalso zip(a, []) = []
-		  andalso zip(a, b) = ab
-		  andalso zip(b, a) = List.map (fn (x,y) => (y,x)) ab);
+                  andalso zip ([], a) = [] 
+                  andalso zip(a, []) = []
+                  andalso zip(a, b) = ab
+                  andalso zip(b, a) = List.map (fn (x,y) => (y,x)) ab);
 
 val test2a = tst "test2a" (([], []) = unzip []
-		   andalso (a, a) = unzip(zip(a,a))
-		   andalso (take (length b) a, b) = unzip(zip(a, b))
-		   andalso (b, take (length b) a) = unzip(zip(b, a)));
+                   andalso (a, a) = unzip(zip(a,a))
+                   andalso (take (length b) a, b) = unzip(zip(a, b))
+                   andalso (b, take (length b) a) = unzip(zip(b, a)));
 val test2b = tst "test2b" (ab = zip(unzip ab));
 
 val test3a = tst "test3a" (map (fn (x, y) => x + y) (a, b) = 
-		  List.map (fn (x,y) => x + y) (zip(a, b)));
+                  List.map (fn (x,y) => x + y) (zip(a, b)));
 
 local 
     val v = ref 0
@@ -70,28 +70,28 @@
 val test4 = (reset (); app (incrv o #1) (a, b); checkv());
 
 val test5a = tst "test5a" (all (fn _ => false) (a, [])
-		   andalso not (exists (fn _ => true) ([], b))); 
+                   andalso not (exists (fn _ => true) ([], b))); 
 
 val test5b = tst "test5b" (exists (fn (x, y) => x = 3) (a, b) 
-		   andalso all (fn (x, y) => y <= 50) (a, b));
+                   andalso all (fn (x, y) => y <= 50) (a, b));
 
 val test5c = tst "test5c" (not (exists (fn (x, y) => x = 5) (a, b))
-		   andalso not (exists (fn (x, y) => y = 5) (b, a))
-		   andalso all (fn (x, y) => x <> 6) (a, b)
-		   andalso all (fn (x, y) => y <> 6) (b, a));
+                   andalso not (exists (fn (x, y) => y = 5) (b, a))
+                   andalso all (fn (x, y) => x <> 6) (a, b)
+                   andalso all (fn (x, y) => y <> 6) (b, a));
 
 val test5d = (reset(); all (fn (x,y) => (incrv x; true)) (a, b) seq (); 
-	      checkv());
+              checkv());
 val test5e = (reset(); exists (fn (x,y) => (incrv x; false)) (a, b) seq (); 
-	      checkv());
+              checkv());
 
 local 
     fun foldrchk f e xs ys = 
-	foldr f e (xs, ys) = 
-	List.foldr (fn ((x, y), r) => f(x, y, r)) e (zip(xs, ys))
+        foldr f e (xs, ys) = 
+        List.foldr (fn ((x, y), r) => f(x, y, r)) e (zip(xs, ys))
     fun foldlchk f e xs ys = 
-	foldl f e (xs, ys) = 
-	List.foldl (fn ((x, y), r) => f(x, y, r)) e (zip(xs, ys))
+        foldl f e (xs, ys) = 
+        List.foldl (fn ((x, y), r) => f(x, y, r)) e (zip(xs, ys))
 in
 val test6 = tst' "test6" (fn _ => 
     foldrchk (fn (x, y, (r1, r2)) => (x-r1, y div r2)) (0, 10) a b

Modified: mlton/branches/on-20050420-cmm-branch/regression/llv.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/llv.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/llv.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -8,7 +8,7 @@
 
   datatype 'a tr = TR of 'a exp * info | K of 'a -> int
        and 'a exp = SWITCH_I of ('a, int) switch
-	          | SWITCH_S of ('a, string) switch
+                  | SWITCH_S of ('a, string) switch
                   | STRING of string * 'a
        and ('a,'c) switch = SWITCH of 'a tr * ('c * 'a tr) list
 
@@ -29,11 +29,11 @@
     and llvExp(e: mulexp) : mulexp_llv =
       let 
         fun llv_switch(SWITCH(e,branches)) =
-  	  (* Note: e is trivial *)
-  	  let val branches' = map (fn (c,e) => (c,llv e)) branches
-  	  in  
+          (* Note: e is trivial *)
+          let val branches' = map (fn (c,e) => (c,llv e)) branches
+          in  
                SWITCH(llv e, branches')
-  	  end
+          end
       in
       case e of
        SWITCH_I(switch) => 

Modified: mlton/branches/on-20050420-cmm-branch/regression/local-ref.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/local-ref.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/local-ref.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -6,7 +6,7 @@
      = let
           val _ = if !c mod 5 = 0
                     then print (concat [Int.toString (!c),
-					"th invocation of fib\n"])
+                                        "th invocation of fib\n"])
                     else ()
           val _ = c := !c + 1
        in

Modified: mlton/branches/on-20050420-cmm-branch/regression/math.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/math.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/math.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -8,7 +8,7 @@
 fun range (from, to) p = 
     let open Int 
     in
-	(from > to) orelse (p from) andalso (range (from+1, to) p)
+        (from > to) orelse (p from) andalso (range (from+1, to) p)
     end;
 
 fun checkrange bounds = check o range bounds;
@@ -35,11 +35,11 @@
     val eps = 1E~8
     infix 4 ===
     fun x === y = 
-	abs (x - y) <= eps orelse abs(x-y) <= eps * (abs x + abs y)
+        abs (x - y) <= eps orelse abs(x-y) <= eps * (abs x + abs y)
 
     fun check1 (opr, a, r) = if opr a === r then "OK" else "WRONG"
     fun check2 (opr, a1, a2, r) =
-	if opr(a1, a2) === r then "OK" else "WRONG"
+        if opr(a1, a2) === r then "OK" else "WRONG"
     fun tst1 s (opr, a, r) = tst0 s (check1 (opr, a, r))
     fun tst2 s (opr, a1, a2, r) = tst0 s (check2 (opr, a1, a2, r))
 

Modified: mlton/branches/on-20050420-cmm-branch/regression/mlton.share.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/mlton.share.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/mlton.share.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -8,13 +8,13 @@
 fun msg () =
    (print (concat ["size of a is ", Int.toString (MLton.size a), "\n"])
     ; Array.appi (fn (i, z) =>
-		  print (concat [Int.toString i, " => ",
-				 case z of
-				    NONE => "NONE"
-				  | SOME (a, b) => 
-				       concat ["(", Int.toString a, ", ",
-					       Int.toString b, ")"],
-				 "\n"])) a)
+                  print (concat [Int.toString i, " => ",
+                                 case z of
+                                    NONE => "NONE"
+                                  | SOME (a, b) => 
+                                       concat ["(", Int.toString a, ", ",
+                                               Int.toString b, ")"],
+                                 "\n"])) a)
 
 val () = msg ()
 val () = MLton.share a
@@ -22,20 +22,20 @@
 
 (* tuple option array with pre-existing sharing *)
 val a = Array.tabulate (100, fn i =>
-			if i mod 2 = 0
-			   then SOME (1, 1)
-			else SOME (i mod 3, i mod 3))
+                        if i mod 2 = 0
+                           then SOME (1, 1)
+                        else SOME (i mod 3, i mod 3))
 val () = Array.update (a, 0, NONE)
 fun msg () =
    (print (concat ["size of a is ", Int.toString (MLton.size a), "\n"])
     ; Array.appi (fn (i, z) =>
-		  print (concat [Int.toString i, " => ",
-				 case z of
-				    NONE => "NONE"
-				  | SOME (a, b) => 
-				       concat ["(", Int.toString a, ", ",
-					       Int.toString b, ")"],
-				       "\n"])) a)
+                  print (concat [Int.toString i, " => ",
+                                 case z of
+                                    NONE => "NONE"
+                                  | SOME (a, b) => 
+                                       concat ["(", Int.toString a, ", ",
+                                               Int.toString b, ")"],
+                                       "\n"])) a)
 val () = msg ()
 val () = MLton.share a
 val () = msg ()
@@ -48,19 +48,19 @@
 fun msg () =
    (print (concat ["size of a is ", Int.toString (MLton.size a), "\n"])
     ; Array.appi (fn (i, z) =>
-		  print (concat [Int.toString i, " => ",
-				 case !z of
-				    NONE => "NONE"
-				  | SOME (a, b) => 
-				       concat ["(", Int.toString a, ", ",
-					       Int.toString b, ")"],
-				 "\n"])) a)
+                  print (concat [Int.toString i, " => ",
+                                 case !z of
+                                    NONE => "NONE"
+                                  | SOME (a, b) => 
+                                       concat ["(", Int.toString a, ", ",
+                                               Int.toString b, ")"],
+                                 "\n"])) a)
 
 val () = msg ()
 val () = MLton.share a
 val () = msg ()
 val () = Array.appi (fn (i, r) =>
-		     r := (if i = 0 then NONE else (SOME (i mod 2, i mod 3)))) a
+                     r := (if i = 0 then NONE else (SOME (i mod 2, i mod 3)))) a
 val () = msg ()
 
 (* big tuple option array *)
@@ -69,11 +69,11 @@
 
 fun msg () =
    print (concat ["size of a is ", Int.toString (MLton.size a), "\n",
-		  case Array.sub (a, 1) of
-		     NONE => "NONE"
-		   | SOME (a, b) => 
-			concat ["(", Int.toString a, ", ", Int.toString b, ")"],
-			"\n"])
+                  case Array.sub (a, 1) of
+                     NONE => "NONE"
+                   | SOME (a, b) => 
+                        concat ["(", Int.toString a, ", ", Int.toString b, ")"],
+                        "\n"])
    
 val () = msg ()
 val () = MLton.share a
@@ -85,9 +85,9 @@
 val v2 = Vector.fromList [A, B, A, B, A, B, A, B, A, B, A, A]
 
 val a = Array.tabulate (4, fn i =>
-			if i mod 2 = 0
-			   then v1
-			else v2)
+                        if i mod 2 = 0
+                           then v1
+                        else v2)
 
 val () = MLton.share a
 
@@ -99,9 +99,9 @@
 (* sharing of vectors *)
 val a =
    Array.tabulate (10, fn i =>
-		   if i mod 2 = 0
-		     then "abcdef"
-		   else concat ["abc", "def"])
+                   if i mod 2 = 0
+                     then "abcdef"
+                   else concat ["abc", "def"])
 
 fun p () = print (concat ["size is ", Int.toString (MLton.size a), "\n"])
 
@@ -136,9 +136,9 @@
 (* non-sharing of similar looking strings of different lengths. *)
 val a =
    Array.tabulate (10, fn i =>
-		   if 0 = i mod 2
-		      then "a"
-		   else concat ["a", "\000"])
+                   if 0 = i mod 2
+                      then "a"
+                   else concat ["a", "\000"])
 
 val () = MLton.share a
 
@@ -147,5 +147,5 @@
 
 val () =
    print (concat [Int.toString (size s0), " ",
-		  Int.toString (size s1), "\n"])
+                  Int.toString (size s1), "\n"])
    

Modified: mlton/branches/on-20050420-cmm-branch/regression/mlton.word.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/mlton.word.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/mlton.word.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,16 +1,16 @@
 functor F (S: sig
-		 type word
+                 type word
 
-		 val trials: word list
-		 val ~ : word -> word
-		 val fromInt: int -> word
-		 val max: word
-		 val rol: word * Word.word -> word
-		 val ror: word * Word.word -> word
-		 val toString: word -> string
-		 val wordSize: int
-		 val zero: word
-	      end) =
+                 val trials: word list
+                 val ~ : word -> word
+                 val fromInt: int -> word
+                 val max: word
+                 val rol: word * Word.word -> word
+                 val ror: word * Word.word -> word
+                 val toString: word -> string
+                 val wordSize: int
+                 val zero: word
+              end) =
    struct
       open S
 
@@ -20,7 +20,7 @@
 
       (* Test ~ *)
       val _ = List.app (p o ~) trials
-	 
+         
       (* Test Algebraic simplifications. *)
       val _ = List.app (fn w => p (rol (w, 0w0))) trials
       val _ = List.app (fn w => p (ror (w, 0w0))) trials
@@ -32,24 +32,24 @@
       val _ = List.app (fn w => p (ror (max, w))) [0w1, 0w2, 0w3]
 
       val _ =
-	 List.app
-	 (fn oper =>
-	  List.app
-	  (fn w => List.app (fn w' => p (oper (w, w'))) rots)
-	  trials)
-	 [rol, ror]
+         List.app
+         (fn oper =>
+          List.app
+          (fn w => List.app (fn w' => p (oper (w, w'))) rots)
+          trials)
+         [rol, ror]
    end
 
 structure Z = F (open Word MLton.Word
-		 val zero: word = 0w0
-		 val max: word = 0wxFFFFFFFF
-		 val trials: word list =
-		    [0w0, 0w1, 0wxF, 0wx7F7F7F7F, 0wxFFFFFFFF])
+                 val zero: word = 0w0
+                 val max: word = 0wxFFFFFFFF
+                 val trials: word list =
+                    [0w0, 0w1, 0wxF, 0wx7F7F7F7F, 0wxFFFFFFFF])
 structure Z = F (open Word8 MLton.Word8
-		 val zero: word = 0w0
-		 val max: word = 0wxFF
-		 val trials: word list =
-		    [0w0, 0w1, 0wxF, 0wx7F, 0wxFF])
+                 val zero: word = 0w0
+                 val max: word = 0wxFF
+                 val trials: word list =
+                    [0w0, 0w1, 0wxF, 0wx7F, 0wxFF])
 
 
 (* Test unsigned addition and multiplication with overflow checking. *)
@@ -63,7 +63,7 @@
  *    (fn (w, w') =>
  *     let
  *        val _ = print (concat ["0x", Word.toString w, " ", name, " ",
- * 			      "0x", Word.toString w'])
+ *                            "0x", Word.toString w'])
  *        val res = f (w, w')
  *        val _ = print (concat [" = ", Word.toString res, "\n"])
  *     in
@@ -72,14 +72,14 @@
  *    all
  * 
  * val _ = doit ("+", MLton.Word.addCheck,
- * 	      [(0wx7FFFFFFF, 0wx1),
- * 	       (0wxFFFFFFFE, 0wx1),
- * 	       (0wxFFFFFFFD, 0wx2),
- * 	       (0wxFFFFFFFF, 0wx1)])
+ *            [(0wx7FFFFFFF, 0wx1),
+ *             (0wxFFFFFFFE, 0wx1),
+ *             (0wxFFFFFFFD, 0wx2),
+ *             (0wxFFFFFFFF, 0wx1)])
  * 
  * val _ = doit ("*", MLton.Word.mulCheck,
- * 	      [(0wxFFFFFFFF, 0wx1),
- * 	       (0wx7FFFFFFF, 0wx2),
- * 	       (0wx80000000, 0wx2),
- * 	       (0wxFFFFFFFF, 0wx2)])
+ *            [(0wxFFFFFFFF, 0wx1),
+ *             (0wx7FFFFFFF, 0wx2),
+ *             (0wx80000000, 0wx2),
+ *             (0wxFFFFFFFF, 0wx2)])
  *)

Modified: mlton/branches/on-20050420-cmm-branch/regression/modules.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/modules.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/modules.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -2,10 +2,10 @@
    sig
       type t
       structure S:
-	 sig
-	    type 'a t
-	    val x: 'a t
-	 end
+         sig
+            type 'a t
+            val x: 'a t
+         end
    end
 
 structure S:
@@ -17,16 +17,16 @@
    end
 
 functor F (eqtype t
-	   datatype u = U of t
-	   eqtype v
-	   sharing type t = v) =
+           datatype u = U of t
+           eqtype v
+           sharing type t = v) =
    struct
       fun f (u: u) = u = u
    end
 
 functor F (type t
-	   eqtype u
-	   sharing type t = u) =
+           eqtype u
+           sharing type t = u) =
    struct
       fun f (x: t) = x = x
    end
@@ -85,9 +85,9 @@
    sig
       type t
       structure Z:
-	 sig
-	    datatype u = U
-	 end
+         sig
+            datatype u = U
+         end
       sharing type Z.u = t
    end
 
@@ -95,24 +95,24 @@
    sig
       eqtype t
       structure Z:
-	 sig
-	    datatype u = U
-	 end where type u = t
+         sig
+            datatype u = U
+         end where type u = t
    end
 
 structure S:
    sig
       eqtype t
       structure Z:
-	 sig
-	    datatype u = U
-	 end where type u = t
+         sig
+            datatype u = U
+         end where type u = t
    end =
    struct
       structure Z =
-	 struct
-	    datatype u = U
-	 end
+         struct
+            datatype u = U
+         end
       type t = Z.u
    end
 
@@ -125,8 +125,8 @@
 functor F (structure S: sig end) = struct open S end
 
 functor F (type t
-	   type u
-	   sharing type t = u) =
+           type u
+           sharing type t = u) =
    struct
       val id: t -> u = fn x => x
    end
@@ -134,14 +134,14 @@
 functor F (eqtype t) = struct fun f (x: t) = x = x end
 
 functor F (structure S:
-	      sig
-		 type t
-	      end
-	   structure T:
-	      sig
-		 type t
-	      end
-	   sharing S = T) =
+              sig
+                 type t
+              end
+           structure T:
+              sig
+                 type t
+              end
+           sharing S = T) =
    struct
       val id: S.t -> T.t = fn x => x
    end
@@ -152,15 +152,15 @@
    end
 
 functor F (type ('a, 'b) t
-	   type 'a u = ('a, int) t
-	   val f: (bool, 'b) t -> real
-	   val u: bool u) =
+           type 'a u = ('a, int) t
+           val f: (bool, 'b) t -> real
+           val u: bool u) =
    struct
       val _ = f u
    end
-	      
+              
 functor F (datatype t = T
-	   datatype u = U of t) =
+           datatype u = U of t) =
    struct
       fun f (x: u) = x = x
    end

Modified: mlton/branches/on-20050420-cmm-branch/regression/mutex.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/mutex.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/mutex.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -3,9 +3,9 @@
 fun for (start, stop, f) =
    let
       fun loop i =
-	 if i >= stop
-	    then ()
-	 else (f i; loop (i + 1))
+         if i >= stop
+            then ()
+         else (f i; loop (i + 1))
    in
       loop start
    end
@@ -26,15 +26,15 @@
       fun enque (T {back, ...}, x) = back := x :: !back
 
       fun deque (T {front, back}) =
-	 case !front of
-	    [] => (case !back of
-		      [] => NONE
-		    | l => let val l = rev l
-			   in case l of
-			      [] => raise Fail "deque"
-			    | x :: l => (back := []; front := l; SOME x)
-			   end)
-	  | x :: l => (front := l; SOME x) 
+         case !front of
+            [] => (case !back of
+                      [] => NONE
+                    | l => let val l = rev l
+                           in case l of
+                              [] => raise Fail "deque"
+                            | x :: l => (back := []; front := l; SOME x)
+                           end)
+          | x :: l => (front := l; SOME x) 
    end
 
 structure Thread:
@@ -44,13 +44,13 @@
       val spawn: (unit -> unit) -> unit
       val yield: unit -> unit
       structure Mutex:
-	 sig
-	    type t
+         sig
+            type t
 
-	    val new: unit -> t
-	    val lock: t -> unit
-	    val unlock: t -> unit
-	 end
+            val new: unit -> t
+            val lock: t -> unit
+            val unlock: t -> unit
+         end
    end =
    struct
       open MLton
@@ -59,25 +59,25 @@
       val topLevel: Thread.Runnable.t option ref = ref NONE
 
       local
-	 val threads: Thread.Runnable.t Queue.t = Queue.new ()
+         val threads: Thread.Runnable.t Queue.t = Queue.new ()
       in
-	 fun ready t = Queue.enque (threads, t)
-	 fun next () : Thread.Runnable.t =
-	    case Queue.deque threads of
-	       NONE => valOf (!topLevel)
-	     | SOME t => t
+         fun ready t = Queue.enque (threads, t)
+         fun next () : Thread.Runnable.t =
+            case Queue.deque threads of
+               NONE => valOf (!topLevel)
+             | SOME t => t
       end
       
       fun 'a exit (): 'a = switch (fn _ =>
-				   (print "exiting\n"
-				    ; next ()))
+                                   (print "exiting\n"
+                                    ; next ()))
    
       fun new (f: unit -> unit): Thread.Runnable.t =
-	 Thread.prepare
-	 (Thread.new (fn () => ((f () handle _ => exit ())
-				; exit ())),
-	  ())
-	    
+         Thread.prepare
+         (Thread.new (fn () => ((f () handle _ => exit ())
+                                ; exit ())),
+          ())
+            
       fun schedule t = (ready t; next ())
 
       fun yield (): unit = switch (fn t => schedule (Thread.prepare (t, ())))
@@ -85,55 +85,55 @@
       val spawn = ready o new
 
       fun setItimer t =
-	 Itimer.set (Itimer.Real,
-		     {value = t,
-		      interval = t})
+         Itimer.set (Itimer.Real,
+                     {value = t,
+                      interval = t})
 
       fun run (): unit =
-	 (switch (fn t =>
-		  (topLevel := SOME (Thread.prepare (t, ()))
-		   ; new (fn () =>
-			  (setHandler (alrm, Handler.handler schedule)
-			   ; setItimer (Time.fromMilliseconds 10)))))
-	  ; setItimer Time.zeroTime
-	  ; setHandler (alrm, Handler.ignore)
-	  ; topLevel := NONE)
-	    
+         (switch (fn t =>
+                  (topLevel := SOME (Thread.prepare (t, ()))
+                   ; new (fn () =>
+                          (setHandler (alrm, Handler.handler schedule)
+                           ; setItimer (Time.fromMilliseconds 10)))))
+          ; setItimer Time.zeroTime
+          ; setHandler (alrm, Handler.ignore)
+          ; topLevel := NONE)
+            
       structure Mutex =
-	 struct
-	    datatype t = T of {locked: bool ref,
-			       waiting: unit Thread.t Queue.t}
-		  
-	    fun new () =
-	       T {locked = ref false,
-		  waiting = Queue.new ()}
+         struct
+            datatype t = T of {locked: bool ref,
+                               waiting: unit Thread.t Queue.t}
+                  
+            fun new () =
+               T {locked = ref false,
+                  waiting = Queue.new ()}
 
-	    fun lock (T {locked, waiting, ...}) =
-	       let
-		  fun loop () =
-		     (Thread.atomicBegin ()
-		      ; if !locked
-			   then (Thread.atomicEnd ()
-				 ; switch (fn t =>
-					   (Queue.enque (waiting, t)
-					    ; next ()))
-				 ; loop ())
-			else (locked := true
-			      ; Thread.atomicEnd ()))
-	       in loop ()
-	       end
-	       
-	    fun safeUnlock (T {locked, waiting, ...}) =
-	       (locked := false
-		; (case Queue.deque waiting of
-		      NONE => ()
-		    | SOME t => ready (Thread.prepare (t,()))))
+            fun lock (T {locked, waiting, ...}) =
+               let
+                  fun loop () =
+                     (Thread.atomicBegin ()
+                      ; if !locked
+                           then (Thread.atomicEnd ()
+                                 ; switch (fn t =>
+                                           (Queue.enque (waiting, t)
+                                            ; next ()))
+                                 ; loop ())
+                        else (locked := true
+                              ; Thread.atomicEnd ()))
+               in loop ()
+               end
+               
+            fun safeUnlock (T {locked, waiting, ...}) =
+               (locked := false
+                ; (case Queue.deque waiting of
+                      NONE => ()
+                    | SOME t => ready (Thread.prepare (t,()))))
 
-	    fun unlock (m: t) =
-	       (Thread.atomicBegin ()
-		; safeUnlock m
-		; Thread.atomicEnd ())
-	 end
+            fun unlock (m: t) =
+               (Thread.atomicBegin ()
+                ; safeUnlock m
+                ; Thread.atomicEnd ())
+         end
    end
 
 open Thread
@@ -143,24 +143,24 @@
       val m = Mutex.new ()
       val gotIt = ref false
       val _ = 
-	 for (0, 10, fn _ =>
-	      Thread.spawn
-	      (fn () =>
-	       let
-		  val _ = print "starting\n"
-		  fun loop i =
-		     if i = 0
-			then ()
-		     else (Mutex.lock m
-			   ; if !gotIt
-				then raise Fail "bug"
-			     else (gotIt := true
-				   ; for (0, 1000, fn _ => ())
-				   ; gotIt := false
-				   ; Mutex.unlock m
-				   ; loop (i - 1)))
-	       in loop 10000
-	       end))
+         for (0, 10, fn _ =>
+              Thread.spawn
+              (fn () =>
+               let
+                  val _ = print "starting\n"
+                  fun loop i =
+                     if i = 0
+                        then ()
+                     else (Mutex.lock m
+                           ; if !gotIt
+                                then raise Fail "bug"
+                             else (gotIt := true
+                                   ; for (0, 1000, fn _ => ())
+                                   ; gotIt := false
+                                   ; Mutex.unlock m
+                                   ; loop (i - 1)))
+               in loop 10000
+               end))
    in
       run ()
    end

Modified: mlton/branches/on-20050420-cmm-branch/regression/nested-loop.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/nested-loop.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/nested-loop.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -2,12 +2,12 @@
    if x = 0
       then ()
    else (let
-	    fun loop2 y =
-	       if y = 0
-		  then ()
-	       else loop2 (y - 1)
-	 in loop2 x
-	 end;
-	 loop1 (x - 1))
+            fun loop2 y =
+               if y = 0
+                  then ()
+               else loop2 (y - 1)
+         in loop2 x
+         end;
+         loop1 (x - 1))
 
 val _ = loop1 13

Modified: mlton/branches/on-20050420-cmm-branch/regression/nonexhaustive.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/nonexhaustive.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/nonexhaustive.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -4,7 +4,7 @@
    case 2 of
       2 => 3
     | 3 => 4
-	 
+         
 val _ =
    case [] of
       [] => 1

Modified: mlton/branches/on-20050420-cmm-branch/regression/once.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/once.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/once.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -12,9 +12,9 @@
 val _ = b := !b - 1
 
 val _ = print(concat["a = ", Int.toString(!a),
-		     "  b = ", Int.toString(!b),
-		     "\n"])
+                     "  b = ", Int.toString(!b),
+                     "\n"])
 
 val _ = if !a = 0
-	   then ()
-	else throw (valOf(!r)) ()
+           then ()
+        else throw (valOf(!r)) ()

Modified: mlton/branches/on-20050420-cmm-branch/regression/opaque.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/opaque.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/opaque.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -5,26 +5,26 @@
 
 functor f() = struct type a = int 
                      val a = 232
-	             val pr = Int.toString 
-	      end :> sig type a
-	                 val a : a			   
-		         val pr : a -> string
-		     end
+                     val pr = Int.toString 
+              end :> sig type a
+                         val a : a                         
+                         val pr : a -> string
+                     end
 
 structure f = f()
 val _ = print ("f.a = " ^ f.pr f.a ^ "\n")
 
 functor g() = struct datatype a = A | B
                      fun pr_a A = "A"
-		       | pr_a B = "B"
-		     val pr_b = pr_a
+                       | pr_a B = "B"
+                     val pr_b = pr_a
                      type b = a
               end :> sig type a type b 
-		         val A : a
-		         val B : b
-			 val pr_a : a -> string
-			 val pr_b : b -> string
-		     end
+                         val A : a
+                         val B : b
+                         val pr_a : a -> string
+                         val pr_b : b -> string
+                     end
 
 structure g = g()
 val _ = print ("g.A = " ^ g.pr_a g.A ^ "\n")
@@ -37,9 +37,9 @@
     val b = s.a
     type b = s.a 
   end :> sig type b 
-	     val pr : b -> string 
-	     val b : b 
-	 end
+             val pr : b -> string 
+             val b : b 
+         end
 
 structure h = h(struct type a = int val pr = Int.toString val a = 343 end)
 val _ = print ("h.b = " ^ h.pr h.b ^ "\n")
@@ -48,11 +48,11 @@
 
 functor i() = struct datatype a = A
                      and b = B | C
-	             type c = a * b
-		     val c = (A,C)
-		     fun pr (A,B) = "(A,B)"
-		       | pr (A,C) = "(A,C)"
-	      end :> sig type c val c : c val pr : c -> string end
+                     type c = a * b
+                     val c = (A,C)
+                     fun pr (A,B) = "(A,B)"
+                       | pr (A,C) = "(A,C)"
+              end :> sig type c val c : c val pr : c -> string end
 
 structure i = i()
 val _ = print ("i.c = " ^ i.pr i.c ^ "\n")
@@ -63,7 +63,7 @@
  * elaborate, however. *)
 
 structure S = struct type s = int * int
-	      end :> sig eqtype s end
+              end :> sig eqtype s end
 
 signature S = sig datatype u = A 
-	      end where type u = S.s
+              end where type u = S.s

Modified: mlton/branches/on-20050420-cmm-branch/regression/opaque2.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/opaque2.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/opaque2.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,13 +1,13 @@
 structure S :> sig type ('a,'b) t 
-		   val f : ('a,'b) t -> ('b,'a) t
-		   val mk : 'a * 'b -> ('a,'b) t 
-	       end
-	     =
-	   struct
-	     type ('a,'b) t = 'b * 'a
-	     fun f (x,y) = (y,x)
-	     fun mk (a,b) = (b,a)
-	   end
+                   val f : ('a,'b) t -> ('b,'a) t
+                   val mk : 'a * 'b -> ('a,'b) t 
+               end
+             =
+           struct
+             type ('a,'b) t = 'b * 'a
+             fun f (x,y) = (y,x)
+             fun mk (a,b) = (b,a)
+           end
 
 val a = S.mk (5, "hello")
 

Modified: mlton/branches/on-20050420-cmm-branch/regression/os-exit.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/os-exit.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/os-exit.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,2 +1,2 @@
 val _ = (TextIO.output (TextIO.stdOut, "hello\n")
-	 ; OS.Process.exit OS.Process.success)
+         ; OS.Process.exit OS.Process.success)

Modified: mlton/branches/on-20050420-cmm-branch/regression/pack-real.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/pack-real.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/pack-real.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,30 +1,30 @@
 functor Test (structure PackReal: PACK_REAL
-	      structure Real: REAL
-	      val tests: Real.real list
-	      sharing type PackReal.real = Real.real) =
+              structure Real: REAL
+              val tests: Real.real list
+              sharing type PackReal.real = Real.real) =
 struct
    
 val _ =
    if List.all (fn r =>
-		let
-		   val v = PackReal.toBytes r
-		   val _ =
-		      print (concat ["r = ", Real.fmt StringCvt.EXACT r, "\t"])
-		   val _ =
-		      Word8Vector.app
-		      (fn w =>
-		       let
-			  val s = Word8.toString w
-		       in
-			  print (if String.size s = 1
-				    then concat ["0", s]
-				 else s)
-		       end)
-		      v
-		   val _ = print "\n"
-		in 
-		   Real.== (r, PackReal.fromBytes v)
-		end)
+                let
+                   val v = PackReal.toBytes r
+                   val _ =
+                      print (concat ["r = ", Real.fmt StringCvt.EXACT r, "\t"])
+                   val _ =
+                      Word8Vector.app
+                      (fn w =>
+                       let
+                          val s = Word8.toString w
+                       in
+                          print (if String.size s = 1
+                                    then concat ["0", s]
+                                 else s)
+                       end)
+                      v
+                   val _ = print "\n"
+                in 
+                   Real.== (r, PackReal.fromBytes v)
+                end)
       tests
       then ()
    else raise Fail "failure"
@@ -70,14 +70,14 @@
    end
 
 structure Z = Test (structure PackReal = PackReal32Big
-		    structure Real = Real32
-		    val tests = real32Tests)
+                    structure Real = Real32
+                    val tests = real32Tests)
 structure Z = Test (structure PackReal = PackReal32Little
-		    structure Real = Real32
-		    val tests = real32Tests)
+                    structure Real = Real32
+                    val tests = real32Tests)
 structure Z = Test (structure PackReal = PackReal64Big
-		    structure Real = Real64
-		    val tests = real64Tests)
+                    structure Real = Real64
+                    val tests = real64Tests)
 structure Z = Test (structure PackReal = PackReal64Little
-		    structure Real = Real64
-		    val tests = real64Tests)
+                    structure Real = Real64
+                    val tests = real64Tests)

Modified: mlton/branches/on-20050420-cmm-branch/regression/pack-word.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/pack-word.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/pack-word.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,15 +1,15 @@
 functor F (P: PACK_WORD) =
    struct
       val v = Word8Vector.tabulate (11, Word8.fromInt)
-	 
+         
       fun p i = print (concat [LargeWord.toString (P.subVec (v, i)), "\n"])
 
       val _ = (p 0; p 1)
 
       val _ =
-	 List.app
-	 (fn i => p i handle Subscript => print "OK\n")
-	 [~1, 2, valOf Int.maxInt]
+         List.app
+         (fn i => p i handle Subscript => print "OK\n")
+         [~1, 2, valOf Int.maxInt]
    end
 
 structure S = F (PackWord32Little)
@@ -26,9 +26,9 @@
       val _ = (p 0; p 1)
 
       val _ =
-	 List.app
-	 (fn i => p i handle Subscript => print "OK\n")
-	 [~1, 2, valOf Int.maxInt]
+         List.app
+         (fn i => p i handle Subscript => print "OK\n")
+         [~1, 2, valOf Int.maxInt]
    end
 
 structure S = F (PackWord32Little)

Modified: mlton/branches/on-20050420-cmm-branch/regression/poly-equal.2.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/poly-equal.2.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/poly-equal.2.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -16,9 +16,9 @@
     assert ("pair list equal", [(1,2), (3,4)] = [(1,2), (3,4)]) ;
     assert ("pair list not equal", [(1,2), (3,4)] <> [(1,2), (3,5)]) ;
     assert ("tree equal",
-	   let val t = Node (1, Leaf 2, Node (3, Leaf 4, Leaf 5))
-	   in t = t
-	   end))
+           let val t = Node (1, Leaf 2, Node (3, Leaf 4, Leaf 5))
+           in t = t
+           end))
 
     
 

Modified: mlton/branches/on-20050420-cmm-branch/regression/poly-equal.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/poly-equal.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/poly-equal.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,4 +1,4 @@
 val _ =
    print(if ([1, 2, 3], [4, 5]) = ([1, 2, 3], [4])
-	    then "true\n"
-	 else "false\n")
+            then "true\n"
+         else "false\n")

Modified: mlton/branches/on-20050420-cmm-branch/regression/polymorphic-recursion.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/polymorphic-recursion.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/polymorphic-recursion.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -8,7 +8,7 @@
    fn R _ => 0
     | L (R z) => 1 + depth z
     | _ => raise Match
-	 
+         
 val n = depth (build 13)
 val _ =
    if n = 13
@@ -26,11 +26,11 @@
 val _ = f 13
   *) 
 (*
-	 
+         
 val rec f =
    fn R _ => 0
     | L (R z) => 1 + f z
-	 
+         
 val v0: int t = R 13
 val v2: int t t = R v0
 val v1: int t = L (v2: int t t)

Modified: mlton/branches/on-20050420-cmm-branch/regression/posix-exit.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/posix-exit.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/posix-exit.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,2 +1,2 @@
 val _ = (TextIO.output (TextIO.stdOut, "hello\n")
-	 ; Posix.Process.exit 0w0)
+         ; Posix.Process.exit 0w0)

Modified: mlton/branches/on-20050420-cmm-branch/regression/prodcons.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/prodcons.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/prodcons.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -4,9 +4,9 @@
 fun for (start, stop, f) =
    let
       fun loop i =
-	 if i > stop
-	    then ()
-	 else (f i; loop (i + 1))
+         if i > stop
+            then ()
+         else (f i; loop (i + 1))
    in
       loop start
    end
@@ -29,15 +29,15 @@
       fun enque (T {back, ...}, x) = back := x :: !back
 
       fun deque (T {front, back}) =
-	 case !front of
-	    [] => (case !back of
-		      [] => NONE
-		    | l => let val l = rev l
-			   in case l of
-			      [] => raise Fail "deque"
-			    | x :: l => (back := []; front := l; SOME x)
-			   end)
-	  | x :: l => (front := l; SOME x) 
+         case !front of
+            [] => (case !back of
+                      [] => NONE
+                    | l => let val l = rev l
+                           in case l of
+                              [] => raise Fail "deque"
+                            | x :: l => (back := []; front := l; SOME x)
+                           end)
+          | x :: l => (front := l; SOME x) 
    end
 
 structure Thread:
@@ -47,21 +47,21 @@
       val spawn: (unit -> unit) -> unit
       val yield: unit -> unit
       structure Mutex:
-	 sig
-	    type t
+         sig
+            type t
 
-	    val new: unit -> t
-	    val lock: t * string -> unit
-	    val unlock: t -> unit
-	 end
+            val new: unit -> t
+            val lock: t * string -> unit
+            val unlock: t -> unit
+         end
       structure Condition:
-      	 sig
-	    type t
-	       
-	    val new: unit -> t
-	    val signal: t -> unit
-	    val wait: t * Mutex.t -> unit
-	 end
+         sig
+            type t
+               
+            val new: unit -> t
+            val signal: t -> unit
+            val wait: t * Mutex.t -> unit
+         end
    end =
    struct
       open MLton
@@ -70,107 +70,107 @@
       val topLevel: Thread.Runnable.t option ref = ref NONE
 
       local
-	 val threads: Thread.Runnable.t Queue.t = Queue.new ()
+         val threads: Thread.Runnable.t Queue.t = Queue.new ()
       in
-	 fun ready t: unit = Queue.enque (threads, t)
-	 fun next () : Thread.Runnable.t =
-	    case Queue.deque threads of
-	       NONE => (print "switching to toplevel\n"
-			; valOf (!topLevel))
-	     | SOME t => t
+         fun ready t: unit = Queue.enque (threads, t)
+         fun next () : Thread.Runnable.t =
+            case Queue.deque threads of
+               NONE => (print "switching to toplevel\n"
+                        ; valOf (!topLevel))
+             | SOME t => t
       end
    
       fun 'a exit (): 'a = switch (fn _ => next ())
       
       fun new (f: unit -> unit): Thread.Runnable.t =
-	 Thread.prepare
-	 (Thread.new (fn () => ((f () handle _ => exit ())
-				; exit ())),
-	  ())
-	 
+         Thread.prepare
+         (Thread.new (fn () => ((f () handle _ => exit ())
+                                ; exit ())),
+          ())
+         
       fun schedule t =
-	 (print "scheduling\n"
-	  ; ready t
-	  ; next ())
+         (print "scheduling\n"
+          ; ready t
+          ; next ())
 
       fun yield (): unit = switch (fn t => schedule (Thread.prepare (t, ())))
 
       val spawn = ready o new
 
       fun setItimer t =
-	 Itimer.set (Itimer.Real,
-		     {value = t,
-		      interval = t})
+         Itimer.set (Itimer.Real,
+                     {value = t,
+                      interval = t})
 
       fun run (): unit =
-	 (switch (fn t =>
-		  (topLevel := SOME (Thread.prepare (t, ()))
-		   ; new (fn () => (setHandler (alrm, Handler.handler schedule)
-				    ; setItimer (Time.fromMilliseconds 20)))))
-	  ; setItimer Time.zeroTime
-	  ; ignore alrm
-	  ; topLevel := NONE)
-	 
+         (switch (fn t =>
+                  (topLevel := SOME (Thread.prepare (t, ()))
+                   ; new (fn () => (setHandler (alrm, Handler.handler schedule)
+                                    ; setItimer (Time.fromMilliseconds 20)))))
+          ; setItimer Time.zeroTime
+          ; ignore alrm
+          ; topLevel := NONE)
+         
       structure Mutex =
-	 struct
-	    datatype t = T of {locked: bool ref,
-			       waiting: unit Thread.t Queue.t}
-	       
-	    fun new () =
-	       T {locked = ref false,
-		  waiting = Queue.new ()}
+         struct
+            datatype t = T of {locked: bool ref,
+                               waiting: unit Thread.t Queue.t}
+               
+            fun new () =
+               T {locked = ref false,
+                  waiting = Queue.new ()}
 
-	    fun lock (T {locked, waiting, ...}, name) =
-	       let
-		  fun loop () =
-		     (print (concat [name, " lock looping\n"])
-		      ; Thread.atomicBegin ()
-		      ; if !locked
-			   then (print "mutex is locked\n"
-				 ; switch (fn t =>
-					   (Thread.atomicEnd ()
-					    ; Queue.enque (waiting, t)
-					    ; next ()))
-				 ; loop ())
-			else (print "mutex is not locked\n"
-			      ; locked := true
-			      ; Thread.atomicEnd ()))
-	       in loop ()
-	       end
-	    
-	    fun safeUnlock (T {locked, waiting, ...}) =
-	       (locked := false
-		; (case Queue.deque waiting of
-		      NONE => ()
-		    | SOME t => (print "unlock found waiting thread\n"
-				 ; ready (Thread.prepare (t, ())))))
+            fun lock (T {locked, waiting, ...}, name) =
+               let
+                  fun loop () =
+                     (print (concat [name, " lock looping\n"])
+                      ; Thread.atomicBegin ()
+                      ; if !locked
+                           then (print "mutex is locked\n"
+                                 ; switch (fn t =>
+                                           (Thread.atomicEnd ()
+                                            ; Queue.enque (waiting, t)
+                                            ; next ()))
+                                 ; loop ())
+                        else (print "mutex is not locked\n"
+                              ; locked := true
+                              ; Thread.atomicEnd ()))
+               in loop ()
+               end
+            
+            fun safeUnlock (T {locked, waiting, ...}) =
+               (locked := false
+                ; (case Queue.deque waiting of
+                      NONE => ()
+                    | SOME t => (print "unlock found waiting thread\n"
+                                 ; ready (Thread.prepare (t, ())))))
 
-	    fun unlock (m: t) =
-	       (print "unlock atomicBegin\n"
-		; Thread.atomicBegin ()
-		; safeUnlock m
-		; Thread.atomicEnd ())
-	 end
+            fun unlock (m: t) =
+               (print "unlock atomicBegin\n"
+                ; Thread.atomicBegin ()
+                ; safeUnlock m
+                ; Thread.atomicEnd ())
+         end
 
       structure Condition =
-	 struct
-	    datatype t = T of {waiting: unit Thread.t Queue.t}
+         struct
+            datatype t = T of {waiting: unit Thread.t Queue.t}
 
-	    fun new () = T {waiting = Queue.new ()}
+            fun new () = T {waiting = Queue.new ()}
 
-	    fun wait (T {waiting, ...}, m) =
-	       (switch (fn t =>
-			(Mutex.safeUnlock m
-			 ; print "wait unlocked mutex\n"
-			 ; Queue.enque (waiting, t)
-			 ; next ()))
-		; Mutex.lock (m, "wait"))
+            fun wait (T {waiting, ...}, m) =
+               (switch (fn t =>
+                        (Mutex.safeUnlock m
+                         ; print "wait unlocked mutex\n"
+                         ; Queue.enque (waiting, t)
+                         ; next ()))
+                ; Mutex.lock (m, "wait"))
 
-	    fun signal (T {waiting, ...}) =
-	       case Queue.deque waiting of
-		  NONE => ()
-		| SOME t => ready (Thread.prepare (t, ()))
-	 end
+            fun signal (T {waiting, ...}) =
+               case Queue.deque waiting of
+                  NONE => ()
+                | SOME t => ready (Thread.prepare (t, ()))
+         end
 
    end
 
@@ -186,34 +186,34 @@
 
 fun producer n =
    for (1, n, fn i =>
-	(print (concat ["producer acquiring lock ", Int.toString i, "\n"])
-	 ; Mutex.lock (m, "producer")
-	 ; print "producer acquired lock\n"
-	 ; while !count = 1 do Condition.wait (c, m)
-	 ; print "producer passed condition\n"
-	 ; data := i
-	 ; count := 1
-	 ; Condition.signal c
-	 ; print "producer releasing lock\n"
-	 ; Mutex.unlock m
-	 ; print "producer released lock\n"
-	 ; produced := !produced + 1))
+        (print (concat ["producer acquiring lock ", Int.toString i, "\n"])
+         ; Mutex.lock (m, "producer")
+         ; print "producer acquired lock\n"
+         ; while !count = 1 do Condition.wait (c, m)
+         ; print "producer passed condition\n"
+         ; data := i
+         ; count := 1
+         ; Condition.signal c
+         ; print "producer releasing lock\n"
+         ; Mutex.unlock m
+         ; print "producer released lock\n"
+         ; produced := !produced + 1))
 
 fun consumer n =
    let val i = ref 0
    in
       while !i <> n do
-	 (print (concat ["consumer acquiring lock ", Int.toString (!i), "\n"])
-	  ; Mutex.lock (m, "consumer")
-	  ; print "consumer acquired lock\n"
-	  ; while !count = 0 do Condition.wait (c, m)
-	  ; i := !data
-	  ; count := 0
-	  ; Condition.signal c
-	  ; print "consumer releasing lock\n"
-	  ; Mutex.unlock m
-	  ; print "consumer released lock\n"
-	  ; consumed := !consumed + 1)
+         (print (concat ["consumer acquiring lock ", Int.toString (!i), "\n"])
+          ; Mutex.lock (m, "consumer")
+          ; print "consumer acquired lock\n"
+          ; while !count = 0 do Condition.wait (c, m)
+          ; i := !data
+          ; count := 0
+          ; Condition.signal c
+          ; print "consumer releasing lock\n"
+          ; Mutex.unlock m
+          ; print "consumer released lock\n"
+          ; consumed := !consumed + 1)
    end
 
 fun atoi s = case Int.fromString s of SOME num => num | NONE => 0
@@ -227,8 +227,8 @@
       val _ = Thread.run ()
       val _ = Posix.Process.sleep (Time.fromSeconds 1)
       val _ = printl [Int.toString (!produced),
-		      " ",  
-		      Int.toString (!consumed)]
+                      " ",  
+                      Int.toString (!consumed)]
    in
       ()
    end

Modified: mlton/branches/on-20050420-cmm-branch/regression/pseudokit.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/pseudokit.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/pseudokit.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -13,8 +13,8 @@
 
 (*
 functor Basics(structure Tools : sig
-				   structure FinMapEq : sig type map val dom : map -> Set.Set end
-				 end) =
+                                   structure FinMapEq : sig type map val dom : map -> Set.Set end
+                                 end) =
 *)
 
 functor Basics(structure Tools : TOOLS) =

Modified: mlton/branches/on-20050420-cmm-branch/regression/real.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/real.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/real.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,5 +1,5 @@
 functor Test (structure Real: REAL
-	      val size: int) =
+              val size: int) =
 struct
 
 open Real
@@ -62,27 +62,27 @@
        open StringCvt
     in
        [EXACT, SCI NONE, FIX NONE, GEN NONE,
-	SCI (SOME 0), FIX (SOME 0), GEN (SOME 1),
-	SCI (SOME 10), FIX (SOME 10), GEN (SOME 10)]
+        SCI (SOME 0), FIX (SOME 0), GEN (SOME 1),
+        SCI (SOME 10), FIX (SOME 10), GEN (SOME 10)]
     end)
 
 val _ =
    let
       fun doit (s,r, s0, s1, s2, s6) =
-	 if (fmt (StringCvt.FIX (SOME 0)) r = s0
-	     andalso fmt (StringCvt.FIX (SOME 1)) r = s1
-	     andalso fmt (StringCvt.FIX (SOME 2)) r = s2
-	     andalso fmt (StringCvt.FIX (SOME 6)) r = s6
-	     andalso fmt (StringCvt.FIX NONE) r = s6)
-	    then ()
-	 else raise Fail (concat ["fmt bug: ", s, " ", exact r])
+         if (fmt (StringCvt.FIX (SOME 0)) r = s0
+             andalso fmt (StringCvt.FIX (SOME 1)) r = s1
+             andalso fmt (StringCvt.FIX (SOME 2)) r = s2
+             andalso fmt (StringCvt.FIX (SOME 6)) r = s6
+             andalso fmt (StringCvt.FIX NONE) r = s6)
+            then ()
+         else raise Fail (concat ["fmt bug: ", s, " ", exact r])
    in
       List.app
       (fn (s,r, s0, s1, s2, s6) =>
        (doit (s,r, s0, s1, s2, s6)
-	; if r == zero
-	     then ()
-	  else doit (s^"~",~r, "~"^s0, "~"^s1, "~"^s2, "~"^s6)))
+        ; if r == zero
+             then ()
+          else doit (s^"~",~r, "~"^s0, "~"^s1, "~"^s2, "~"^s6)))
       [("a", s2r "0.0", "0", "0.0", "0.00", "0.000000"),
        ("b", s2r "1.0", "1", "1.0", "1.00", "1.000000"),
        ("c", s2r "1.4", "1", "1.4", "1.40", "1.400000"),
@@ -91,23 +91,23 @@
        ("f", s2r "1.6", "2", "1.6", "1.60", "1.600000"),
        ("h", s2r "3.141592653589", "3", "3.1", "3.14", "3.141593"),
        ("j", s2r "91827365478400.0", "91827365478400", "91827365478400.0", 
-	"91827365478400.00", "91827365478400.000000")]
+        "91827365478400.00", "91827365478400.000000")]
    end
 
 val _ =
    let
       fun chkSCI (r, s0, s1, s2, s6) = 
-	 fmt (StringCvt.SCI (SOME 0)) r = s0
-	 andalso fmt (StringCvt.SCI (SOME 1)) r = s1
-	 andalso fmt (StringCvt.SCI (SOME 2)) r = s2
-	 andalso fmt (StringCvt.SCI (SOME 6)) r = s6
-	 andalso fmt (StringCvt.SCI NONE) r = s6
+         fmt (StringCvt.SCI (SOME 0)) r = s0
+         andalso fmt (StringCvt.SCI (SOME 1)) r = s1
+         andalso fmt (StringCvt.SCI (SOME 2)) r = s2
+         andalso fmt (StringCvt.SCI (SOME 6)) r = s6
+         andalso fmt (StringCvt.SCI NONE) r = s6
    in
       List.app
       (fn (r, s0, s1, s2, s6) =>
        if chkSCI(r, s0, s1, s2, s6) 
-	  andalso (r == zero orelse chkSCI(~r, "~"^s0, "~"^s1, "~"^s2, "~"^s6))
-	  then ()
+          andalso (r == zero orelse chkSCI(~r, "~"^s0, "~"^s1, "~"^s2, "~"^s6))
+          then ()
        else raise Fail (concat ["fmt SCI bug: ", exact r]))
       [(s2r "0.0", "0E0", "0.0E0", "0.00E0", "0.000000E0"),
        (s2r "0.0012345678", "1E~3", "1.2E~3", "1.23E~3", "1.234568E~3"),
@@ -122,47 +122,47 @@
 val _ =
    let
       fun chkGEN (r, s1, s2, s6, s12) = 
-	 fmt (StringCvt.GEN (SOME 1)) r = s1
-	 andalso fmt (StringCvt.GEN (SOME 2)) r = s2
-	 andalso fmt (StringCvt.GEN (SOME 6)) r = s6
-	 andalso fmt (StringCvt.GEN (SOME 12)) r = s12
-	 andalso fmt (StringCvt.GEN NONE) r = s12
-	 andalso toString r = s12;
+         fmt (StringCvt.GEN (SOME 1)) r = s1
+         andalso fmt (StringCvt.GEN (SOME 2)) r = s2
+         andalso fmt (StringCvt.GEN (SOME 6)) r = s6
+         andalso fmt (StringCvt.GEN (SOME 12)) r = s12
+         andalso fmt (StringCvt.GEN NONE) r = s12
+         andalso toString r = s12;
    in
       List.app
       (fn (r, s1, s2, s6, s12) =>
        if chkGEN(r, s1, s2, s6, s12) 
-	  andalso (r == zero orelse 
-		   chkGEN(~r, "~"^s1, "~"^s2, "~"^s6, "~"^s12))
-	  then ()
+          andalso (r == zero orelse 
+                   chkGEN(~r, "~"^s1, "~"^s2, "~"^s6, "~"^s12))
+          then ()
        else raise Fail (concat ["fmt GEN bug: ", exact r]))
       [(s2r "0.0",               "0", "0",     "0", "0"),
        (s2r "1.0",              "1", "1",  "1", "1"),
        (s2r "1.5",              "2", "1.5",  "1.5", "1.5"),
        (s2r "91827365478400.0", "9E13", "9.2E13",  "9.18274E13", 
-	"91827365478400")]
+        "91827365478400")]
    end
 
 val _ = print "\nTesting scan"
 
 val _ = for' (fn r =>
-	      let
-		 val r' = valOf (StringCvt.scanString scan (exact r))
-		 val _ = print (concat [exact r, "\t", exact r', "\n"])
-	      in
-		 if r == r' orelse unordered (r, r')
-		    then ()
-		 else raise Fail "scan bug"
-	      end)
+              let
+                 val r' = valOf (StringCvt.scanString scan (exact r))
+                 val _ = print (concat [exact r, "\t", exact r', "\n"])
+              in
+                 if r == r' orelse unordered (r, r')
+                    then ()
+                 else raise Fail "scan bug"
+              end)
 
 val _ = print "\nTesting checkFloat\n"
 val _ =
    for'
    (fn r =>
     if (case class r of
-	   INF => ((checkFloat r; false) handle Overflow => true | _ => false)
-	 | NAN => ((checkFloat r; false) handle Div => true | _ => false)
-	 | _ => (checkFloat r; true) handle _ => false)
+           INF => ((checkFloat r; false) handle Overflow => true | _ => false)
+         | NAN => ((checkFloat r; false) handle Div => true | _ => false)
+         | _ => (checkFloat r; true) handle _ => false)
        then ()
     else raise Fail "checkFloat bug")
    
@@ -172,18 +172,18 @@
    (fn r =>
     let
        val c = 
-	  case class r of
-	     INF => "inf"
-	   | NAN => "nan"
-	   | NORMAL => "normal"
-	   | SUBNORMAL => "subnormal"
-	   | ZERO => "zero"
+          case class r of
+             INF => "inf"
+           | NAN => "nan"
+           | NORMAL => "normal"
+           | SUBNORMAL => "subnormal"
+           | ZERO => "zero"
     in
        print (concat [exact r, "\t", c, "\n",
-		      "\tisFinite = ", b2s (isFinite r),
-		      "\tisNan = ", b2s (isNan r),
-		      "\tisNormal = ", b2s (isNormal r),
-		      "\n"])
+                      "\tisFinite = ", b2s (isFinite r),
+                      "\tisNan = ", b2s (isNan r),
+                      "\tisNormal = ", b2s (isNormal r),
+                      "\n"])
     end)
 
 val _ = print "\nTesting maxFinite, minPos, minNormalPos\n"
@@ -200,13 +200,13 @@
   fun min (p: real -> bool): real =
     let
       fun loop (x: real): real =
-	let
-	  val y = x / two
-	in
-	  if p y
-	    then loop y
-	    else x
-	end
+        let
+          val y = x / two
+        in
+          if p y
+            then loop y
+            else x
+        end
     in
        loop one
     end
@@ -217,22 +217,22 @@
   val maxFinite =
     let
       fun up (x: real): real =
-	let
-	  val y = x * two
-	in
-	  if isFinite y
-	    then up y
-	    else x
-	end
+        let
+          val y = x * two
+        in
+          if isFinite y
+            then up y
+            else x
+        end
       fun down (x: real, y: real): real =
-		  let
-		    val y = y / two
-		    val z = x + y
-		  in
-		    if isFinite z
-		      then down (z, y)
-		      else x
-		  end
+                  let
+                    val y = y / two
+                    val z = x + y
+                  in
+                    if isFinite z
+                      then down (z, y)
+                      else x
+                  end
       val z = up one
     in
        down (z, z)
@@ -381,16 +381,16 @@
    
 val _ =
    List.app (fn r =>
-	     let
-		val da = valOf (IEEEReal.fromString r)
-		val s1 = IEEEReal.toString da
-		val x = valOf (fromDecimal da)
-		val s2 = exact x
-		val da' = toDecimal x
-		val b = Bool.toString (da = da')
-	     in
-		print (concat [s1, " ", s2, " ", b, "\n"])
-	     end)
+             let
+                val da = valOf (IEEEReal.fromString r)
+                val s1 = IEEEReal.toString da
+                val x = valOf (fromDecimal da)
+                val s2 = exact x
+                val da' = toDecimal x
+                val b = Bool.toString (da = da')
+             in
+                print (concat [s1, " ", s2, " ", b, "\n"])
+             end)
    ["inf", "+inF", "~iNf", "-Inf",
     "infinity", "+infinity", "~infinity", "-infinity",
     "nan", "+naN", "~nAn", "-Nan",
@@ -416,12 +416,12 @@
        val i = toLargeInt IEEEReal.TO_NEGINF r
        val r' = fromLargeInt i
        val _ = print (concat [exact r,
-			      "\t", LargeInt.toString i,
-			      "\t", exact r',
-			      "\n"])
+                              "\t", LargeInt.toString i,
+                              "\t", exact r',
+                              "\n"])
     in
        if r' == realFloor r
-	  then ()
+          then ()
        else raise Fail "bug"
     end)
 
@@ -434,25 +434,25 @@
 val _ =
    let
       fun doit (x, mode, name) =
-	 let
-	    val i = toLargeInt mode x
-	 in
-	    print (concat [name, "\t", exact x, "\t", LargeInt.toString i, "\n"])
-	 end
+         let
+            val i = toLargeInt mode x
+         in
+            print (concat [name, "\t", exact x, "\t", LargeInt.toString i, "\n"])
+         end
    in
       List.app
       (fn (mode, name) =>
        List.app (fn s =>
-		 let
-		    val x = s2r s
-		 in
-		    doit (x, mode, name)
-		    ; doit (~ x, mode, name)
-		    ; doit (s2r "1E12" + x, mode, name)
-		    ; doit (s2r "~1E12" + x, mode, name)
-		 end)
+                 let
+                    val x = s2r s
+                 in
+                    doit (x, mode, name)
+                    ; doit (~ x, mode, name)
+                    ; doit (s2r "1E12" + x, mode, name)
+                    ; doit (s2r "~1E12" + x, mode, name)
+                 end)
        ["0.0", "0.25", "0.5", "0.75", "1.0", "1.25", "1.5", "1.75", "2.0",
-	"2.5", "3.0"])
+        "2.5", "3.0"])
       roundingModes
    end
 
@@ -464,13 +464,13 @@
     case SOME (round r) handle Overflow => NONE of
        NONE => ()
      | SOME i =>
-	  let
-	     val r = fromInt i
-	  in
-	     if r == fromInt (round r)
-		then ()
-	     else raise Fail "fromInt bug"
-	  end)
+          let
+             val r = fromInt i
+          in
+             if r == fromInt (round r)
+                then ()
+             else raise Fail "fromInt bug"
+          end)
 
 val _ = print "\nTesting toInt\n"
 
@@ -480,10 +480,10 @@
     List.app
     (fn (mode, name) =>
      case SOME (toInt mode r) handle Overflow => NONE of
-	NONE => ()
+        NONE => ()
       | SOME i => if i = LargeInt.toInt (toLargeInt mode r)
-		     then ()
-		  else raise Fail "bug")
+                     then ()
+                  else raise Fail "bug")
     roundingModes)
 
 val _ = print "\nTesting ceil,floor,round,trunc\n"
@@ -494,10 +494,10 @@
     List.app
     (fn (mode, f) =>
      case SOME (toInt mode r) handle Overflow => NONE of
-	NONE => ()
+        NONE => ()
       | SOME i => if i = f r
-		     then ()
-		  else raise Fail "bug")
+                     then ()
+                  else raise Fail "bug")
     [(TO_NEAREST, round),
      (TO_NEGINF, floor),
      (TO_POSINF, ceil),
@@ -510,18 +510,18 @@
      (for'
       (fn r2 =>
        if unordered (r1, r2)
-	  orelse (if false
-		     then print (concat [b2s (signBit r1), "\t",
-					 b2s (signBit r2), "\t",
-					 i2s (sign r1), "\t",
-					 b2s (sameSign (r1, r2)), "\t",
-					 exact (copySign (r1, r2)), "\n"])
-		  else ()
-		     ; (signBit r1 = Int.< (sign r1, 0)
-			orelse r1 == zero)
-		     andalso (sameSign (r1, r2)) = (signBit r1 = signBit r2)
-		     andalso sameSign (r2, copySign (r1, r2)))
-	  then ()
+          orelse (if false
+                     then print (concat [b2s (signBit r1), "\t",
+                                         b2s (signBit r2), "\t",
+                                         i2s (sign r1), "\t",
+                                         b2s (sameSign (r1, r2)), "\t",
+                                         exact (copySign (r1, r2)), "\n"])
+                  else ()
+                     ; (signBit r1 = Int.< (sign r1, 0)
+                        orelse r1 == zero)
+                     andalso (sameSign (r1, r2)) = (signBit r1 = signBit r2)
+                     andalso sameSign (r2, copySign (r1, r2)))
+          then ()
        else raise Fail "bug")))
 
 val _ = print "\nTesting max, min\n"
@@ -532,51 +532,51 @@
     for'
     (fn r2 =>
      let
-	val max = max (r1, r2)
-	val min = min (r1, r2)
+        val max = max (r1, r2)
+        val min = min (r1, r2)
      in
-	if (isNan r1 orelse (r1 <= max andalso min <= r1))
-	   andalso (isNan r2 orelse (r2 <= max andalso min <= r2))
-	   andalso (r1 == max orelse r2 == max
-		    orelse (isNan r1 andalso isNan r2))
-	   andalso (r1 == min orelse r2 == min
-		    orelse (isNan r1 andalso isNan r2))
-	   then ()
-	else raise Fail "bug"
+        if (isNan r1 orelse (r1 <= max andalso min <= r1))
+           andalso (isNan r2 orelse (r2 <= max andalso min <= r2))
+           andalso (r1 == max orelse r2 == max
+                    orelse (isNan r1 andalso isNan r2))
+           andalso (r1 == min orelse r2 == min
+                    orelse (isNan r1 andalso isNan r2))
+           then ()
+        else raise Fail "bug"
      end))
 
 val _ = print "\nTesting Real.Math.{acos,asin,atan,cos,cosh,exp,ln,log10,sin,sinh,sqrt,tan,tanh}\n"
    
 val _ =
    for' (fn r =>
-	 List.app
-	 (fn (name, f, except) =>
-	  if List.exists (fn r' => r == r') except
-	     then ()
-	  else
-	     print (concat [(*name, " ", exact r, " = ", *)
-			    fmt (StringCvt.GEN (SOME 10)) (f r), "\n"]))
-	 let
-	    open Real.Math
-	 in
-	    [("acos", acos, []),
-	     ("asin", asin, []),
-	     ("atan", atan, []),
-	     ("cos", cos, [maxFinite, halfMaxFinite,
-			   ~maxFinite, ~halfMaxFinite]),
-	     ("cosh", cosh, [s2r "12.3", s2r "~12.3", e, ~e]),
-	     ("exp", exp, [s2r "12.3", pi, s2r "1.23",
-			   s2r "~12.3", ~pi, s2r "~1.23"]),
-	     ("ln", ln, []),
-	     ("log10", log10, [s2r "1.23", pi]),
-	     ("sin", sin, [maxFinite, halfMaxFinite,
-			   ~maxFinite, ~halfMaxFinite, pi, ~pi]),
-	     ("sinh", sinh, [pi, ~pi, s2r "0.123", s2r "~0.123"]),
-	     ("sqrt", sqrt, [maxFinite]),
-	     ("tan", tan, [maxFinite, halfMaxFinite,
-			   ~maxFinite, ~halfMaxFinite, pi, ~pi]),
-	     ("tanh", tanh, [s2r "0.123", s2r "~0.123"])]
-	 end)
+         List.app
+         (fn (name, f, except) =>
+          if List.exists (fn r' => r == r') except
+             then ()
+          else
+             print (concat [(*name, " ", exact r, " = ", *)
+                            fmt (StringCvt.GEN (SOME 10)) (f r), "\n"]))
+         let
+            open Real.Math
+         in
+            [("acos", acos, []),
+             ("asin", asin, []),
+             ("atan", atan, []),
+             ("cos", cos, [maxFinite, halfMaxFinite,
+                           ~maxFinite, ~halfMaxFinite]),
+             ("cosh", cosh, [s2r "12.3", s2r "~12.3", e, ~e]),
+             ("exp", exp, [s2r "12.3", pi, s2r "1.23",
+                           s2r "~12.3", ~pi, s2r "~1.23"]),
+             ("ln", ln, []),
+             ("log10", log10, [s2r "1.23", pi]),
+             ("sin", sin, [maxFinite, halfMaxFinite,
+                           ~maxFinite, ~halfMaxFinite, pi, ~pi]),
+             ("sinh", sinh, [pi, ~pi, s2r "0.123", s2r "~0.123"]),
+             ("sqrt", sqrt, [maxFinite]),
+             ("tan", tan, [maxFinite, halfMaxFinite,
+                           ~maxFinite, ~halfMaxFinite, pi, ~pi]),
+             ("tanh", tanh, [s2r "0.123", s2r "~0.123"])]
+         end)
 
 val _ = print "\nTesting Real.{*,+,-,/,nextAfter,rem} Real.Math.{atan2,pow}\n"
 val _ =
@@ -587,18 +587,18 @@
      List.app
      (fn (name, f, except) =>
       if List.exists (fn (r1', r2') => r1 == r1' andalso r2 == r2') except
-	 then ()
+         then ()
       else
-	 print (concat [(*name, " (", exact r1, ", ", exact r2, ") = ", *)
-			exact (f (r1, r2)), "\n"]))
+         print (concat [(*name, " (", exact r1, ", ", exact r2, ") = ", *)
+                        exact (f (r1, r2)), "\n"]))
      [("*", op *, []),
       ("+", op +, []),
       ("-", op -, []),
       ("/", op /, [(s2r "1.23", halfMaxFinite),
-		   (s2r "1.23", ~halfMaxFinite),
-		   (s2r "~1.23", halfMaxFinite),
-		   (s2r "~1.23", ~halfMaxFinite)
-		   ]),
+                   (s2r "1.23", ~halfMaxFinite),
+                   (s2r "~1.23", halfMaxFinite),
+                   (s2r "~1.23", ~halfMaxFinite)
+                   ]),
       ("nextAfter", nextAfter, [])
 (*      ("rem", rem, []), *)
 (*      ("atan2", Math.atan2, []), *)
@@ -607,12 +607,12 @@
 
 val _ =
    if List.all (op ==) [(posInf + posInf, posInf),
-			(negInf + negInf, negInf),
-			(posInf - negInf, posInf),
-			(negInf - posInf, negInf)]
+                        (negInf + negInf, negInf),
+                        (posInf - negInf, posInf),
+                        (negInf - posInf, negInf)]
       andalso List.all isNan [nan, nan + one, nan - one, nan * one, nan / one]
       andalso List.all isNan [posInf + negInf, negInf + posInf, posInf - posInf,
-			      negInf - negInf]
+                              negInf - negInf]
       then ()
    else raise Fail "bug"
 
@@ -625,7 +625,7 @@
      for
      (fn r3 =>
       if *+ (r1, r2, r3) == r1 * r2 + r3
-	 then ()
+         then ()
       else raise Fail "*+ bug")))
 
 val _ = print "\nTesting Real.{realCeil,realFloor,realTrunc}\n"
@@ -637,14 +637,14 @@
        val floor = realFloor r
        val trunc = realTrunc r
        val _ = print (concat [exact r, "  ",
-			      exact ceil, " ",
-			      exact floor, " ",
-			      exact trunc, "\n"])
+                              exact ceil, " ",
+                              exact floor, " ",
+                              exact trunc, "\n"])
     in
        if floor <= r
-	  andalso r <= ceil
-	  andalso abs trunc <= abs r
-	  then ()
+          andalso r <= ceil
+          andalso abs trunc <= abs r
+          then ()
        else raise Fail "bug"
     end)
 
@@ -656,31 +656,31 @@
     for
     (fn r2 =>
      let
-	val _ = 
-	   List.app
-	   (fn (f, name) =>
-	    print (concat [(* name, " (", exact r1, ", ", exact r2, ") = ", *)
-			   b2s (f (r1, r2)), "\n"]))
-	   [(Real.<, "<"),
-	    (Real.>, ">"),
-	    (Real.==, "=="),
-	    (Real.?=, "?=")]
+        val _ = 
+           List.app
+           (fn (f, name) =>
+            print (concat [(* name, " (", exact r1, ", ", exact r2, ") = ", *)
+                           b2s (f (r1, r2)), "\n"]))
+           [(Real.<, "<"),
+            (Real.>, ">"),
+            (Real.==, "=="),
+            (Real.?=, "?=")]
      in
-	if unordered (r1, r2) = (isNan r1 orelse isNan r2)
-	   andalso (r1 != r2) = not (r1 == r2)
-	   andalso if unordered (r1, r2)
-		      then (false = (r1 <= r2)
-			    andalso false = (r1 < r2)
-			    andalso false = (r1 >= r2)
-			    andalso false = (r1 > r2)
-			    andalso false = (r1 == r2)
-			    andalso if isNan r1 andalso isNan r2
-				       then true = ?= (r1, r2) 
-				    else true)
-		   else ((r1 < r2) = not (r1 >= r2)
-			 andalso (r1 > r2) = not (r1 <= r2))
-	   then ()
-	else raise Fail "bug"
+        if unordered (r1, r2) = (isNan r1 orelse isNan r2)
+           andalso (r1 != r2) = not (r1 == r2)
+           andalso if unordered (r1, r2)
+                      then (false = (r1 <= r2)
+                            andalso false = (r1 < r2)
+                            andalso false = (r1 >= r2)
+                            andalso false = (r1 > r2)
+                            andalso false = (r1 == r2)
+                            andalso if isNan r1 andalso isNan r2
+                                       then true = ?= (r1, r2) 
+                                    else true)
+                   else ((r1 < r2) = not (r1 >= r2)
+                         andalso (r1 > r2) = not (r1 <= r2))
+           then ()
+        else raise Fail "bug"
      end))
 
 val _ = print "\nTesting compare, compareReal\n"
@@ -691,99 +691,99 @@
     for
     (fn r' =>
      let
-	val c =
-	   case SOME (compare (r, r')) handle IEEEReal.Unordered => NONE of
-	      NONE => "Unordered"
-	    | SOME z =>
-		 case z of
-		    EQUAL => "EQUAL"
-		  | GREATER => "GREATER"
-		  | LESS => "LESS"
-	datatype z = datatype IEEEReal.real_order
-	val cr =
-	   case compareReal (r, r') of
-	      EQUAL => "EQUAL"
-	    | GREATER => "GREATER"
-	    | LESS => "LESS"
-	    | UNORDERED => "UNORDERED"
-	val _ =
-	   print (concat [(* exact r, " ", exact r', "\t", *)
-			  c, "\t", cr, "\n"])
+        val c =
+           case SOME (compare (r, r')) handle IEEEReal.Unordered => NONE of
+              NONE => "Unordered"
+            | SOME z =>
+                 case z of
+                    EQUAL => "EQUAL"
+                  | GREATER => "GREATER"
+                  | LESS => "LESS"
+        datatype z = datatype IEEEReal.real_order
+        val cr =
+           case compareReal (r, r') of
+              EQUAL => "EQUAL"
+            | GREATER => "GREATER"
+            | LESS => "LESS"
+            | UNORDERED => "UNORDERED"
+        val _ =
+           print (concat [(* exact r, " ", exact r', "\t", *)
+                          c, "\t", cr, "\n"])
      in
-	if compareReal (r, r') = (case compareReal (r', r) of
-				     EQUAL => EQUAL
-				   | GREATER => LESS
-				   | LESS => GREATER
-				   | UNORDERED => UNORDERED)
-	   then ()
-	else raise Fail "compareReal bug"
+        if compareReal (r, r') = (case compareReal (r', r) of
+                                     EQUAL => EQUAL
+                                   | GREATER => LESS
+                                   | LESS => GREATER
+                                   | UNORDERED => UNORDERED)
+           then ()
+        else raise Fail "compareReal bug"
      end))
 
 val _ = print "\nTesting abs\n"
 
 val _ = for (fn r =>
-	     if abs r == abs (~ r)
-		then ()
-	     else raise Fail "abs bug")
+             if abs r == abs (~ r)
+                then ()
+             else raise Fail "abs bug")
 
 val _ = print "\nTesting {from,to}ManExp\n"
-	 
+         
 val _ =
    for
    (fn x =>
     if List.exists (fn y => x == y) [halfMinNormalPos, minPos,
-				     ~halfMinNormalPos, ~minPos]
+                                     ~halfMinNormalPos, ~minPos]
        then ()
     else
        let
-	  val {exp, man} = toManExp x
-	  val _ =
-	     if true
-		then
-		   print (concat [exact x, " = ", exact man, " * 2^", i2s exp,
-				  "\n"])
-	     else ()
-	  val x' = fromManExp {exp = exp, man = man}
-	  val _ =
-	     if true
-		then
-		   print (concat ["\t = ", exact x', "\n"])
-	     else ()
+          val {exp, man} = toManExp x
+          val _ =
+             if true
+                then
+                   print (concat [exact x, " = ", exact man, " * 2^", i2s exp,
+                                  "\n"])
+             else ()
+          val x' = fromManExp {exp = exp, man = man}
+          val _ =
+             if true
+                then
+                   print (concat ["\t = ", exact x', "\n"])
+             else ()
        in
-	  if x == x'
-	     then ()
-	  else raise Fail "bug"
+          if x == x'
+             then ()
+          else raise Fail "bug"
        end)
 
 val _ = print "\nTesting split\n"
 
 val _ =
    for (fn r =>
-	let
-	   val {whole, frac} = split r
- 	   val _ =
-	      if false
-		 then
-		    print (concat ["split ", exact r, " = {whole = ",
-				   exact whole, ", frac = ", exact frac, "}\n",
-				   "realMod ", exact whole, " = ",
-				   exact (realMod whole), "\t",
-				   b2s (sameSign (r, whole)), "\t",
-				   b2s (sameSign (r, frac)), "\n"])
-	      else ()
-	in
-	   if realMod r == frac
-	      andalso realMod whole == zero
-	      andalso abs frac < one
-	      andalso sameSign (r, whole)
-	      andalso sameSign (r, frac)
-	      andalso (case class r of
-			  INF => whole == r andalso frac == zero
-			| NAN => isNan whole andalso isNan frac
-			| _ => r == whole + frac)
-	      then ()
-	   else raise Fail "bug"
-	end)
+        let
+           val {whole, frac} = split r
+           val _ =
+              if false
+                 then
+                    print (concat ["split ", exact r, " = {whole = ",
+                                   exact whole, ", frac = ", exact frac, "}\n",
+                                   "realMod ", exact whole, " = ",
+                                   exact (realMod whole), "\t",
+                                   b2s (sameSign (r, whole)), "\t",
+                                   b2s (sameSign (r, frac)), "\n"])
+              else ()
+        in
+           if realMod r == frac
+              andalso realMod whole == zero
+              andalso abs frac < one
+              andalso sameSign (r, whole)
+              andalso sameSign (r, frac)
+              andalso (case class r of
+                          INF => whole == r andalso frac == zero
+                        | NAN => isNan whole andalso isNan frac
+                        | _ => r == whole + frac)
+              then ()
+           else raise Fail "bug"
+        end)
 
 val _ = print "\nTesting {from,to}Large\n"
 
@@ -797,6 +797,6 @@
 end
 
 structure Z = Test (structure Real = Real32
-		    val size = 32)
+                    val size = 32)
 structure Z = Test (structure Real = Real64
-		    val size = 64)
+                    val size = 64)

Modified: mlton/branches/on-20050420-cmm-branch/regression/ref-flatten.2.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/ref-flatten.2.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/ref-flatten.2.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -3,25 +3,25 @@
  | B
 
 val a = Array.tabulate (100, fn i =>
-			let
-			   val l = [100 + i, 2, 3]
-			in
-			   case i mod 2 of
-			      0 => A (ref 0w13, ref 0w123, l)
-			    | 1 => B
-			end)
+                        let
+                           val l = [100 + i, 2, 3]
+                        in
+                           case i mod 2 of
+                              0 => A (ref 0w13, ref 0w123, l)
+                            | 1 => B
+                        end)
 
 val _ =
    Array.app
    (fn B => ()
      | A (r, r', l) => (r := !r + Word16.fromLarge (LargeWord.fromInt (hd l))
-			; r' := !r' + !r))
+                        ; r' := !r' + !r))
    a
 
 val A (w, w', _) = Array.sub (a, 0)
 
 val _ = print (concat [Word16.toString (!w), " ",
-		       Word16.toString (!w'), "\n"])
-	 
-			   
-				      
+                       Word16.toString (!w'), "\n"])
+         
+                           
+                                      

Modified: mlton/branches/on-20050420-cmm-branch/regression/ref-flatten.3.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/ref-flatten.3.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/ref-flatten.3.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -10,14 +10,14 @@
       then ()
    else
       let
-	 val r = ref 13
-	 val l = List.tabulate (10, fn i => (r, ref i))
-	 val (r1, r2) = List.nth (l, 0)
-	 val () = r1 := !r2
-	 val (r1, _) = List.nth (l, 1)
-	 val () = print (concat [Int.toString (!r1), "\n"])
+         val r = ref 13
+         val l = List.tabulate (10, fn i => (r, ref i))
+         val (r1, r2) = List.nth (l, 0)
+         val () = r1 := !r2
+         val (r1, _) = List.nth (l, 1)
+         val () = print (concat [Int.toString (!r1), "\n"])
       in
-	 loop (i - 1)
+         loop (i - 1)
       end
 
 val () = loop 2

Modified: mlton/branches/on-20050420-cmm-branch/regression/ref-flatten.4.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/ref-flatten.4.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/ref-flatten.4.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -7,34 +7,34 @@
       fun ccons (h, t) = SOME (Cons (h, ref t))
 
       fun match cl nilCase consCase =
-	 case cl of
-	    NONE => nilCase ()
-	  | SOME (Cons (h, t)) => consCase (h, !t)
+         case cl of
+            NONE => nilCase ()
+          | SOME (Cons (h, t)) => consCase (h, !t)
 
       fun fromList l =
-	 case l of
-	    [] => cnil ()
-	  | h::t => ccons (h, fromList t)
+         case l of
+            [] => cnil ()
+          | h::t => ccons (h, fromList t)
 
       fun repeat x =
-	 let
-	    val r = ref NONE
-	    val cl = SOME (Cons (x, r))
-	    val () = r := cl
-	 in
-	    cl
-	 end
+         let
+            val r = ref NONE
+            val cl = SOME (Cons (x, r))
+            val () = r := cl
+         in
+            cl
+         end
 
       local
-	 val max = 1000
-	 fun length' (cl, n) =
-	    if n >= max
-	       then NONE
-	       else match cl
-		          (fn () => SOME n)
-			  (fn (_,t) => length' (t, n + 1))
+         val max = 1000
+         fun length' (cl, n) =
+            if n >= max
+               then NONE
+               else match cl
+                          (fn () => SOME n)
+                          (fn (_,t) => length' (t, n + 1))
       in
-	 fun length cl = length' (cl, 0)
+         fun length cl = length' (cl, 0)
       end
    end
 

Modified: mlton/branches/on-20050420-cmm-branch/regression/ref-flatten.5.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/ref-flatten.5.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/ref-flatten.5.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -5,10 +5,10 @@
 val n = 100
 
 val a = Array.tabulate (n, fn i =>
-			case i mod 3 of
-			   0 => B
-			 | 1 => A (ref 13, 14)
-			 | 2 => A (ref 15, 16))
+                        case i mod 3 of
+                           0 => B
+                         | 1 => A (ref 13, 14)
+                         | 2 => A (ref 15, 16))
 
 datatype t =
    A' of int ref * int
@@ -16,9 +16,9 @@
 
 val a' =
    Array.tabulate (n, fn i =>
-		   case Array.sub (a, i) of
-		      B => B'
-		    | A (r, n) => A' (r, n + 1))
+                   case Array.sub (a, i) of
+                      B => B'
+                    | A (r, n) => A' (r, n + 1))
 
 val _ = Array.app (fn A (r, n) => r := 17 + n + !r  | B => ()) a
 

Copied: mlton/branches/on-20050420-cmm-branch/regression/ref-flatten.6.ok (from rev 4358, mlton/trunk/regression/ref-flatten.6.ok)

Copied: mlton/branches/on-20050420-cmm-branch/regression/ref-flatten.6.sml (from rev 4358, mlton/trunk/regression/ref-flatten.6.sml)

Modified: mlton/branches/on-20050420-cmm-branch/regression/ref-flatten.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/ref-flatten.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/ref-flatten.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -5,16 +5,16 @@
 val n = 100
 
 val a = Array.tabulate (n, fn i =>
-			case i mod 3 of
-			   0 => B
-			 | 1 => A (ref 13, 14)
-			 | 2 => A (ref 15, 16))
+                        case i mod 3 of
+                           0 => B
+                         | 1 => A (ref 13, 14)
+                         | 2 => A (ref 15, 16))
 
 val a' =
    Array.tabulate (n, fn i =>
-		   case Array.sub (a, i) of
-		      B => B
-		    | A (r, n) => A (r, n + 1))
+                   case Array.sub (a, i) of
+                      B => B
+                    | A (r, n) => A (r, n + 1))
 
 val _ = Array.app (fn A (r, n) => r := 17 + n + !r  | B => ()) a
 

Modified: mlton/branches/on-20050420-cmm-branch/regression/ring.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/ring.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/ring.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -4,11 +4,11 @@
       type elt
 
       val make : {zero : 'a,
-		  one : 'a,
-		  + : 'a * 'a -> 'a,
-		  * : 'a * 'a -> 'a} -> {ring : ring,
-					 valOf : elt -> 'a}
-	 
+                  one : 'a,
+                  + : 'a * 'a -> 'a,
+                  * : 'a * 'a -> 'a} -> {ring : ring,
+                                         valOf : elt -> 'a}
+         
       val zero : ring -> elt
       val one : ring -> elt
       val ringOf : elt -> ring
@@ -21,10 +21,10 @@
 structure Ring : RING =
    struct
       datatype ring =
-	 Ring of unit -> {zero : elt,
-			  one : elt,
-			  + : elt * elt -> elt,
-			  * : elt * elt -> elt}
+         Ring of unit -> {zero : elt,
+                          one : elt,
+                          + : elt * elt -> elt,
+                          * : elt * elt -> elt}
       and elt = Elt of unit -> {ring : ring}
 
       fun ringOf(Elt th) = #ring(th())
@@ -35,45 +35,45 @@
       val one = extract #one
 
       local
-	 fun make sel (x,y) = extract sel (ringOf x) (x,y)
+         fun make sel (x,y) = extract sel (ringOf x) (x,y)
       in
-   	 val op * = make(# * )
-	 val op + = make(# +)
+         val op * = make(# * )
+         val op + = make(# +)
       end
 
       exception TypeError
       
       fun 'a make{zero, one, +, * = op *} =
-	 let
-	    val r : 'a option ref = ref NONE
+         let
+            val r : 'a option ref = ref NONE
 
-	    fun valOf(Elt th) =
-	       (th() ;
-		case !r of
-		   NONE => raise TypeError
-		 | SOME x => (x before r := NONE))
-		      
-	    fun ring() = {zero = elt zero,
-			  one = elt one,
-			  + = binary(op +),
-			  * = binary(op * )}
-	    and elt(x : 'a) =
-	       Elt(fn () => (r := SOME x ;
-			     {ring = Ring ring}))
-	    and binary (f : 'a * 'a -> 'a) (x : elt, y : elt) =
-	       elt(f(valOf x, valOf y))
-	       
-	 in
-	    {ring = Ring ring,
-	     valOf = valOf}
-	 end
+            fun valOf(Elt th) =
+               (th() ;
+                case !r of
+                   NONE => raise TypeError
+                 | SOME x => (x before r := NONE))
+                      
+            fun ring() = {zero = elt zero,
+                          one = elt one,
+                          + = binary(op +),
+                          * = binary(op * )}
+            and elt(x : 'a) =
+               Elt(fn () => (r := SOME x ;
+                             {ring = Ring ring}))
+            and binary (f : 'a * 'a -> 'a) (x : elt, y : elt) =
+               elt(f(valOf x, valOf y))
+               
+         in
+            {ring = Ring ring,
+             valOf = valOf}
+         end
    end
 
 val {ring = ints, valOf} = Ring.make{zero = 0,
-				     one = 1,
-				     + = op +,
-				     * = op *}
+                                     one = 1,
+                                     + = op +,
+                                     * = op *}
 
 val _ = (print(Int.toString(valOf(Ring.+(Ring.one ints,
-					 Ring.one ints)))) ;
-	 print "\n")
+                                         Ring.one ints)))) ;
+         print "\n")

Modified: mlton/branches/on-20050420-cmm-branch/regression/same-fringe.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/same-fringe.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/same-fringe.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -8,17 +8,17 @@
       val paused: 'a option Thread.t option ref = ref NONE
       val gen: unit Thread.t option ref = ref NONE
       fun return(a: 'a option): unit =
-	 Thread.switch(fn t' =>
-		       let val _ = gen := SOME t'
-			  val t = valOf(!paused)
-			  val _ = paused := NONE
-		       in Thread.prepare (t, a)
-		       end)
+         Thread.switch(fn t' =>
+                       let val _ = gen := SOME t'
+                          val t = valOf(!paused)
+                          val _ = paused := NONE
+                       in Thread.prepare (t, a)
+                       end)
       val _ =
-	 gen := SOME(Thread.new(fn () => (f (return o SOME)
-					  ; return NONE)))
+         gen := SOME(Thread.new(fn () => (f (return o SOME)
+                                          ; return NONE)))
    in fn () => Thread.switch(fn t => (paused := SOME t
-				      ; Thread.prepare (valOf(!gen), ())))
+                                      ; Thread.prepare (valOf(!gen), ())))
    end
    
 datatype 'a tree =
@@ -28,20 +28,20 @@
 fun foreach(t: 'a tree, f: 'a -> unit): unit =
    let
       val rec loop =
-	 fn L a => f a
-	  | N(l, r) => (loop l; loop r)
+         fn L a => f a
+          | N(l, r) => (loop l; loop r)
    in loop t
    end
 
 fun same(f: unit -> 'a option,
-	 g: unit -> 'a option,
-	 eq: 'a * 'a -> bool): bool =
+         g: unit -> 'a option,
+         eq: 'a * 'a -> bool): bool =
    let
       fun loop() =
-	 case (f(), g()) of
-	    (NONE, NONE) => true
-	  | (SOME x, SOME y) => eq(x, y) andalso loop()
-	  | _ => false
+         case (f(), g()) of
+            (NONE, NONE) => true
+          | (SOME x, SOME y) => eq(x, y) andalso loop()
+          | _ => false
    in loop()
    end
 
@@ -58,5 +58,5 @@
    if sameFringe(t1, t2, op =)
       then print "success\n"
    else print "failure\n"
-	 
+         
 end

Modified: mlton/branches/on-20050420-cmm-branch/regression/serialize.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/serialize.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/serialize.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -9,7 +9,7 @@
 val t = (r, r)
 
 fun pv v = (V.app (fn w => (print(W.toString w); print " ")) v
-	    ; print "\n")
+            ; print "\n")
 
 fun pr s = (print s; print "\n")
 
@@ -24,8 +24,8 @@
     ; pl(ds l) ; print "\n"
     ; pb(l = ds l)
     ; pb(let val t: int ref * int ref = ds t
-	 in #1 t = #2 t
-	 end)
+         in #1 t = #2 t
+         end)
     ; pi(ds (fn x => x) 13)
     ; pi(ds (fn x => x + 1) 14)
     ; print "\n")

Modified: mlton/branches/on-20050420-cmm-branch/regression/sharing.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/sharing.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/sharing.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -9,7 +9,7 @@
     sharing type t = s
 end;
 
-signature T =	(* from SML/NJ doc *)
+signature T =   (* from SML/NJ doc *)
 sig
     type s
     structure A :
@@ -29,9 +29,9 @@
    end
 
 functor F (structure A: sig type t end
-	   structure B: sig end
-	   structure C: sig type t end
-	   sharing A = B = C) =
+           structure B: sig end
+           structure C: sig type t end
+           sharing A = B = C) =
    struct
       val _: A.t -> C.t = fn x => x
    end
@@ -44,9 +44,9 @@
    sig
       type t
       structure U:
-	 sig
-	    val x: t
-	 end
+         sig
+            val x: t
+         end
    end
 
 structure S:
@@ -57,20 +57,20 @@
    end =
    struct
       structure T1 =
-	 struct
-	    type t = int
-	    structure U =
-	       struct
-		  val x = 13
-	       end
-	 end
+         struct
+            type t = int
+            structure U =
+               struct
+                  val x = 13
+               end
+         end
       structure T2 =
-	 struct
-	    type t = real
-	    structure U =
-	       struct
-		  val x = 13.0
-	       end
-	 end
+         struct
+            type t = real
+            structure U =
+               struct
+                  val x = 13.0
+               end
+         end
    end
 ;

Modified: mlton/branches/on-20050420-cmm-branch/regression/signals.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/signals.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/signals.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -8,39 +8,39 @@
 open Process Posix.Signal MLton.Signal 
 
 fun print s = let open TextIO
-	      in output (stdErr, s)
-		 ; output (stdErr, "\n")
-	      end
+              in output (stdErr, s)
+                 ; output (stdErr, "\n")
+              end
 
 val sleep = sleep o Time.fromSeconds
    
 val _ =
    case fork () of
       NONE =>
-	 let
-	    val _ =
-	       List.foreach
-	       ([(hup, "Got a hup."),
-		 (int, "You can't int me you loser."),
-		 (term, "Don't even try to term me.")],
-		fn (signal, msg) =>
-		setHandler (signal, Handler.simple (fn () => print msg)))
-	    fun loop' () = (sleep 1; loop' ())
-	 in loop' ()
-	 end
+         let
+            val _ =
+               List.foreach
+               ([(hup, "Got a hup."),
+                 (int, "You can't int me you loser."),
+                 (term, "Don't even try to term me.")],
+                fn (signal, msg) =>
+                setHandler (signal, Handler.simple (fn () => print msg)))
+            fun loop' () = (sleep 1; loop' ())
+         in loop' ()
+         end
     | SOME pid => 
-	 let
-	    fun signal s = Process.kill (K_PROC pid, s)
-	 in 
-	    sleep 1
-	    ; print "sending 1"
-	    ; List.foreach ([hup, int, term], signal)
-	    ; sleep 3
-	    ; print "sending 2"
-	    ; List.foreach ([hup, int], signal)
-	    ; sleep 3
-	    ; print "sending 3"
-	    ; signal kill
-	    ; wait ()
-	 end
+         let
+            fun signal s = Process.kill (K_PROC pid, s)
+         in 
+            sleep 1
+            ; print "sending 1"
+            ; List.foreach ([hup, int, term], signal)
+            ; sleep 3
+            ; print "sending 2"
+            ; List.foreach ([hup, int], signal)
+            ; sleep 3
+            ; print "sending 3"
+            ; signal kill
+            ; wait ()
+         end
 

Modified: mlton/branches/on-20050420-cmm-branch/regression/signals2.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/signals2.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/signals2.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -17,39 +17,39 @@
    struct
       structure Signal = MLton.Signal
       structure Itimer = MLton.Itimer
-	 
+         
       val alrmHandler = fn t => t
       fun setItimer t =
-	 Itimer.set (Itimer.Real,
-		     {value = t,
-		      interval = t})
+         Itimer.set (Itimer.Real,
+                     {value = t,
+                      interval = t})
       fun setAlrmHandler h =
-	 Signal.setHandler (Itimer.signal Itimer.Real, h)
+         Signal.setHandler (Itimer.signal Itimer.Real, h)
 
       fun print s =
-	 Critical.doAtomic (fn () => TextIO.print s)
+         Critical.doAtomic (fn () => TextIO.print s)
 
       fun doit n =
-	 let
-	    val () = setAlrmHandler (Signal.Handler.handler alrmHandler)
-	    val () = setItimer (Time.fromMilliseconds 10)
+         let
+            val () = setAlrmHandler (Signal.Handler.handler alrmHandler)
+            val () = setItimer (Time.fromMilliseconds 10)
 
-	    fun loop i =
-	       if i > n 
-		  then OS.Process.exit OS.Process.success
-		  else let
-			  val i' = (Int.toString i) ^ "\n"
-			  fun loop' j =
-			     if j > i then ()
-			     else (print i'
-				   ; loop' (j + 1))
-		       in
-			  loop' 0
-			  ; loop (i + 1)
-		       end
-	 in
-	    loop 0
-	 end
+            fun loop i =
+               if i > n 
+                  then OS.Process.exit OS.Process.success
+                  else let
+                          val i' = (Int.toString i) ^ "\n"
+                          fun loop' j =
+                             if j > i then ()
+                             else (print i'
+                                   ; loop' (j + 1))
+                       in
+                          loop' 0
+                          ; loop (i + 1)
+                       end
+         in
+            loop 0
+         end
    end
 
 val _ = Main.doit 500

Modified: mlton/branches/on-20050420-cmm-branch/regression/sigs.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/sigs.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/sigs.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -11,7 +11,7 @@
 signature A = 
   sig type t val a : t
   end
-	    
+            
 signature B =
   sig
     type s

Modified: mlton/branches/on-20050420-cmm-branch/regression/size.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/size.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/size.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,11 +1,11 @@
 fun 'a printSize (name: string, min: int, value: 'a): unit=
    if MLton.size value >= min
       then
-	 (print "The size of "
-	  ; print name
-	  ; print " is >= "
-	  ; print (Int.toString min)
-	  ; print " bytes.\n")
+         (print "The size of "
+          ; print name
+          ; print " is >= "
+          ; print (Int.toString min)
+          ; print " bytes.\n")
    else ()
 
 val l = [1, 2, 3, 4]
@@ -17,9 +17,9 @@
     ; printSize ("a string of length 10", 24, "0123456789")
     ; printSize ("an int array of length 10", 52, Array.tabulate (10, fn _ => 0))
     ; printSize ("a double array of length 10",
-		 92, Array.tabulate (10, fn _ => 0.0))
+                 92, Array.tabulate (10, fn _ => 0.0))
     ; printSize ("an array of length 10 of 2-ples of ints",
- 		 92, Array.tabulate (10, fn i => (i, i + 1)))
+                 92, Array.tabulate (10, fn i => (i, i + 1)))
     ; printSize ("a useless function", 0, fn _ => 13)
     )
 
@@ -28,8 +28,8 @@
  * would remove l entirely.
  *)
 val _ = if 10 = foldl (op +) 0 l
-	   then ()
-	else raise Fail "bug"
+           then ()
+        else raise Fail "bug"
    
 local
    open MLton.Cont
@@ -37,14 +37,14 @@
    val rc: int option t option ref = ref NONE
    val _ =
       case callcc (fn k: int option t => (rc := SOME k; throw (k, NONE))) of
-	 NONE => ()
+         NONE => ()
        | SOME i => print (concat [Int.toString i, "\n"])
 end
 
 val _ =
    (print "The size of a continuation option ref is "
     ; if MLton.size rc > 1000
-	 then print "> 1000.\n"
+         then print "> 1000.\n"
       else print "< 1000.\n")
 
 val _ =

Modified: mlton/branches/on-20050420-cmm-branch/regression/slow.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/slow.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/slow.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,8 +1,8 @@
 fun loop (left: IntInf.int): unit =
-	case IntInf.compare (left, 0) of
-	LESS => ()
-	| EQUAL => ()
-	| GREATER => loop (left + ~1)
+        case IntInf.compare (left, 0) of
+        LESS => ()
+        | EQUAL => ()
+        | GREATER => loop (left + ~1)
 
 val _ = loop 100000000
 

Modified: mlton/branches/on-20050420-cmm-branch/regression/slow2.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/slow2.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/slow2.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,7 +1,7 @@
 fun loop (left: IntInf.int): unit =
-	if left = 0
-	   then ()
-	   else loop (left + ~1)
+        if left = 0
+           then ()
+           else loop (left + ~1)
 
 val _ = loop 100000000
 

Modified: mlton/branches/on-20050420-cmm-branch/regression/slower.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/slower.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/slower.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,8 +1,8 @@
 fun loop (left: IntInf.int): unit =
-	case IntInf.compare (left, 4294967296) of
-	LESS => ()
-	| EQUAL => ()
-	| GREATER => loop (left + ~1)
+        case IntInf.compare (left, 4294967296) of
+        LESS => ()
+        | EQUAL => ()
+        | GREATER => loop (left + ~1)
 
 val _ = loop 4304967296
 

Modified: mlton/branches/on-20050420-cmm-branch/regression/smith-normal-form.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/smith-normal-form.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/smith-normal-form.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -30,224 +30,224 @@
       exception foldError
    
       fun make (height: int, width: int, generator: int * int -> 'entry)
-	 : 'entry matrix =
-	 if height < 0 orelse width < 0
-	    then raise sizeError
-	 else (height,
-	       width,
-	       Array.tabulate (height*width,
-			       fn z => generator (z div width,
-						  z mod width)))
+         : 'entry matrix =
+         if height < 0 orelse width < 0
+            then raise sizeError
+         else (height,
+               width,
+               Array.tabulate (height*width,
+                               fn z => generator (z div width,
+                                                  z mod width)))
    
       fun height (height, _, _) = height
    
       fun width (width, _, _) = width
    
       fun fetch ((height, width, mat), row, col) =
-	 if 0 <= row
-	    andalso row < height
-	    andalso 0 <= col
-	    andalso col < width
-	    then Array.sub (mat, col + width*row)
-	 else raise index
+         if 0 <= row
+            andalso row < height
+            andalso 0 <= col
+            andalso col < width
+            then Array.sub (mat, col + width*row)
+         else raise index
    
       fun fetchRow ((height, width, mat), row) =
-	 if 0 <= row andalso row < height
-	    then let val offset = width * row
-		 in fn col =>
-		    if 0 <= col andalso col < width
-		       then Array.sub (mat, col + offset)
-		    else raise index
-		 end
-	 else raise index
+         if 0 <= row andalso row < height
+            then let val offset = width * row
+                 in fn col =>
+                    if 0 <= col andalso col < width
+                       then Array.sub (mat, col + offset)
+                    else raise index
+                 end
+         else raise index
    
       fun fetchCol ((height, width, mat), col) =
-	 if 0 <= col andalso col < width
-	    then fn row =>
-	       if 0 <= row andalso row < height
-		  then Array.sub (mat, col + width*row)
-	       else raise index
-	 else raise index
+         if 0 <= col andalso col < width
+            then fn row =>
+               if 0 <= row andalso row < height
+                  then Array.sub (mat, col + width*row)
+               else raise index
+         else raise index
    
       fun store ((height, width, mat), row, col, entry) =
-	 if 0 <= row
-	    andalso row < height
-	    andalso 0 <= col
-	    andalso col < width
-	    then Array.update (mat, col + width*row, entry)
-	 else raise index
+         if 0 <= row
+            andalso row < height
+            andalso 0 <= col
+            andalso col < width
+            then Array.update (mat, col + width*row, entry)
+         else raise index
    
       fun storeRow ((height, width, mat), row) =
-	 if 0 <= row andalso row < height
-	    then let val offset = width * row
-		 in fn (col, entry) =>
-		    if 0 <= col andalso col < width
-		       then Array.update (mat, col + offset, entry)
-		    else raise index
-		 end
-	 else raise index
+         if 0 <= row andalso row < height
+            then let val offset = width * row
+                 in fn (col, entry) =>
+                    if 0 <= col andalso col < width
+                       then Array.update (mat, col + offset, entry)
+                    else raise index
+                 end
+         else raise index
    
       fun storeCol ((height, width, mat), col) =
-	 if 0 <= col andalso col < width
-	    then fn (row, entry) =>
-	       if 0 <= row andalso row < height
-		  then Array.update (mat, col + width*row, entry)
-	       else raise index
-	 else raise index
+         if 0 <= col andalso col < width
+            then fn (row, entry) =>
+               if 0 <= row andalso row < height
+                  then Array.update (mat, col + width*row, entry)
+               else raise index
+         else raise index
    
       fun swapLoop (from1: int -> 'entry,
-		    to1: int * 'entry -> unit,
-		    from2: int -> 'entry,
-		    to2: int * 'entry -> unit,
-		    limit: int): unit =
-	 let fun loop (i: int): unit =
-	    if i = limit
-	       then ()
-	    else let val tmp = from1 i
-		 in to1 (i, from2 i);
-		    to2 (i, tmp);
-		    loop (i + 1)
-		 end
-	 in loop 0
-	 end
+                    to1: int * 'entry -> unit,
+                    from2: int -> 'entry,
+                    to2: int * 'entry -> unit,
+                    limit: int): unit =
+         let fun loop (i: int): unit =
+            if i = limit
+               then ()
+            else let val tmp = from1 i
+                 in to1 (i, from2 i);
+                    to2 (i, tmp);
+                    loop (i + 1)
+                 end
+         in loop 0
+         end
    
       fun rowSwap (mat as (height, width, _), row1, row2): unit =
-	 if 0 <= row1 andalso row1 < height
-	    andalso 0 <= row2 andalso row2 < height
-	    then if row1 = row2
-		    then ()
-		 else swapLoop (fetchRow (mat, row1),
-				storeRow (mat, row1),
-				fetchRow (mat, row2),
-				storeRow (mat, row2),
-				width)
-	 else raise index
+         if 0 <= row1 andalso row1 < height
+            andalso 0 <= row2 andalso row2 < height
+            then if row1 = row2
+                    then ()
+                 else swapLoop (fetchRow (mat, row1),
+                                storeRow (mat, row1),
+                                fetchRow (mat, row2),
+                                storeRow (mat, row2),
+                                width)
+         else raise index
    
       fun colSwap (mat as (height, width, _), col1, col2): unit =
-	 if 0 <= col1 andalso col1 < width
-	    andalso 0 <= col2 andalso col2 < width
-	    then if col1 = col2
-		    then ()
-		 else swapLoop (fetchCol (mat, col1),
-				storeCol (mat, col1),
-				fetchCol (mat, col2),
-				storeCol (mat, col2),
-				height)
-	 else raise index
+         if 0 <= col1 andalso col1 < width
+            andalso 0 <= col2 andalso col2 < width
+            then if col1 = col2
+                    then ()
+                 else swapLoop (fetchCol (mat, col1),
+                                storeCol (mat, col1),
+                                fetchCol (mat, col2),
+                                storeCol (mat, col2),
+                                height)
+         else raise index
    
       fun opLoop (from1: int -> 'entry,
-		  from2: int -> 'entry,
-		  to2: int * 'entry -> unit,
-		  limit: int,
-		  f: 'entry * 'entry -> 'entry): unit =
-	 let fun loop (i: int): unit =
-	    if i = limit
-	       then ()
-	    else (
-		  to2 (i,
-		       f (from1 i, from2 i));
-		  loop (i + 1))
-	 in loop 0
-	 end
+                  from2: int -> 'entry,
+                  to2: int * 'entry -> unit,
+                  limit: int,
+                  f: 'entry * 'entry -> 'entry): unit =
+         let fun loop (i: int): unit =
+            if i = limit
+               then ()
+            else (
+                  to2 (i,
+                       f (from1 i, from2 i));
+                  loop (i + 1))
+         in loop 0
+         end
    
       fun rowOp (mat as (height, width, _),
-		 row1,
-		 row2,
-		 f: 'entry * 'entry -> 'entry): unit =
-	 if 0 <= row1 andalso row1 < height
-	    andalso 0 <= row2 andalso row2 < height
-	    andalso row1 <> row2
-	    then opLoop (fetchRow (mat, row1),
-			 fetchRow (mat, row2),
-			 storeRow (mat, row2),
-			 width,
-			 f)
-	 else raise index
+                 row1,
+                 row2,
+                 f: 'entry * 'entry -> 'entry): unit =
+         if 0 <= row1 andalso row1 < height
+            andalso 0 <= row2 andalso row2 < height
+            andalso row1 <> row2
+            then opLoop (fetchRow (mat, row1),
+                         fetchRow (mat, row2),
+                         storeRow (mat, row2),
+                         width,
+                         f)
+         else raise index
    
       fun colOp (mat as (height, width, _),
-		 col1,
-		 col2,
-		 f: 'entry * 'entry -> 'entry): unit =
-	 if 0 <= col1 andalso col1 < width
-	    andalso 0 <= col2 andalso col2 < width
-	    andalso col1 <> col2
-	    then opLoop (fetchCol (mat, col1),
-			 fetchCol (mat, col2),
-			 storeCol (mat, col2),
-			 height,
-			 f)
-	 else raise index
+                 col1,
+                 col2,
+                 f: 'entry * 'entry -> 'entry): unit =
+         if 0 <= col1 andalso col1 < width
+            andalso 0 <= col2 andalso col2 < width
+            andalso col1 <> col2
+            then opLoop (fetchCol (mat, col1),
+                         fetchCol (mat, col2),
+                         storeCol (mat, col2),
+                         height,
+                         f)
+         else raise index
    
       fun copy ((height, width, mat)) =
-	 (height,
-	  width,
-	  Array.tabulate (Array.length mat,
-			  fn i => Array.sub (mat, i)))
+         (height,
+          width,
+          Array.tabulate (Array.length mat,
+                          fn i => Array.sub (mat, i)))
    
       fun map ((height, width, mat: 'entry1 Array.array),
-	       f: 'entry1 -> 'entry2)
-	 : 'entry2 matrix =
-	 (height,
-	  width,
-	  Array.tabulate (Array.length mat,
-			  fn i => f (Array.sub (mat, i))))
+               f: 'entry1 -> 'entry2)
+         : 'entry2 matrix =
+         (height,
+          width,
+          Array.tabulate (Array.length mat,
+                          fn i => f (Array.sub (mat, i))))
    
       (* Natural fold a range of integers in reverse. *)
       fun naturalFold (limit: int,
-		       state: 'state,
-		       folder: int * 'state -> 'state): 'state =
-	 let fun loop (i: int, state: 'state) =
-	    if i = 0
-	       then state
-	    else loop (i - 1, folder (i - 1, state))
-	 in if limit < 0
-	       then raise foldError
-	    else loop (limit, state)
-	 end
+                       state: 'state,
+                       folder: int * 'state -> 'state): 'state =
+         let fun loop (i: int, state: 'state) =
+            if i = 0
+               then state
+            else loop (i - 1, folder (i - 1, state))
+         in if limit < 0
+               then raise foldError
+            else loop (limit, state)
+         end
    
    
       local val blank8 = Byte.charToByte #" "
    
-	 fun makeBlanks size =
-	    let val blanks = Word8Vector.tabulate (size,
-						   fn _ => blank8)
-	    in Byte.bytesToString blanks
-	    end
+         fun makeBlanks size =
+            let val blanks = Word8Vector.tabulate (size,
+                                                   fn _ => blank8)
+            in Byte.bytesToString blanks
+            end
    
       in fun toString (mat: 'entry matrix, f: 'entry -> string): string =
-	 let val mat as (height, width, _) = map (mat, f)
-	    fun maxSize from (i, width) = Int.max (String.size (from i),
-						   width)
-	    fun colWidth col = naturalFold (height,
-					    0,
-					    maxSize (fetchCol (mat,
-							       col)))
-	    val widths = Vector.tabulate (width, colWidth)
-	    fun doRow (row: int, ac: string list): string list =
-	       let val from = fetchRow (mat, row)
-		  fun loop (col: int, ac: string list) =
-		     let val next = from col
-			val ac = next::ac
-			val s = String.size next
-			val pad = Vector.sub (widths, col) - s
-			val ac = if pad <= 0
-				    then ac
-				 else (makeBlanks pad)::ac
-		     in if col = 0
-			   then ac
-			else loop (col - 1,
-				   " "::ac)
-		     end
-		  val ac = "\n"::ac
-	       in if width = 0
-		     then ac
-		  else loop (width - 1, ac)
-	       end
-	    val pieces = naturalFold (height,
-				      [],
-				      doRow)
-	 in String.concat pieces
-	 end
+         let val mat as (height, width, _) = map (mat, f)
+            fun maxSize from (i, width) = Int.max (String.size (from i),
+                                                   width)
+            fun colWidth col = naturalFold (height,
+                                            0,
+                                            maxSize (fetchCol (mat,
+                                                               col)))
+            val widths = Vector.tabulate (width, colWidth)
+            fun doRow (row: int, ac: string list): string list =
+               let val from = fetchRow (mat, row)
+                  fun loop (col: int, ac: string list) =
+                     let val next = from col
+                        val ac = next::ac
+                        val s = String.size next
+                        val pad = Vector.sub (widths, col) - s
+                        val ac = if pad <= 0
+                                    then ac
+                                 else (makeBlanks pad)::ac
+                     in if col = 0
+                           then ac
+                        else loop (col - 1,
+                                   " "::ac)
+                     end
+                  val ac = "\n"::ac
+               in if width = 0
+                     then ac
+                  else loop (width - 1, ac)
+               end
+            val pieces = naturalFold (height,
+                                      [],
+                                      doRow)
+         in String.concat pieces
+         end
       end
    end
 
@@ -263,115 +263,115 @@
       val mat = Matrix.copy mat
       val range = Int.min (width, height)
       fun dd pos =
-	 let val matCol = Matrix.fetchCol (mat, pos)
-	    val matRow = Matrix.fetchRow (mat, pos)
-	    val _ = print ("dd: pos = " ^ (Int.toString pos) ^ "\n")
-	    fun swapRowLoop (best, bestRow, bestCol, row) =
-	       if row >= height
-		  then (Matrix.rowSwap (mat, pos, bestRow);
-			Matrix.colSwap (mat, pos, bestCol))
-	       else let val matRow = Matrix.fetchRow (mat, row)
-			fun swapColLoop (best, bestRow, bestCol, col) =
-			   if col >= width
-			      then swapRowLoop (best, bestRow, bestCol, row + 1)
-			   else let val next = matRow col
-				in if smaller (next, best)
-				      then swapColLoop (next, row, col, col + 1)
-				   else swapColLoop (best, bestRow, bestCol, col + 1)
-				end
-		    in swapColLoop (best, bestRow, bestCol, pos)
-		    end
-	    fun rowLoop row =
-	       if row < height
-		  then if (matCol row) = zero
-			  then rowLoop (row + 1)
-		       else (Matrix.rowOp (mat,
-					   pos,
-					   row,
-					   let val x = IntInf.~ (IntInf.quot(matCol row, matCol pos))
-					   in fn (lhs, rhs) => IntInf.+ (IntInf.* (lhs, x), rhs)
-					   end);
-			     if (matCol row) = zero
-				then rowLoop (row + 1)
-			     else hitPosAgain ())
-	       else let fun colLoop col =
-		  if col < width
-		     then if (matRow col) = zero
-			     then colLoop (col + 1)
-			  else (Matrix.colOp (mat,
-					      pos,
-					      col,
-					      let val x = IntInf.~ (IntInf.quot (matRow col, matRow pos))
-					      in fn (lhs, rhs) => IntInf.+ (IntInf.* (lhs, x), rhs)
-					      end);
-				if (matRow col) = zero
-				   then colLoop (col + 1)
-				else hitPosAgain ())
-		  else ()
-		    in colLoop (pos + 1)
-		    end
-	    and hitPosAgain () = (swapRowLoop (zero, pos, pos, pos);
-				  rowLoop (pos + 1))
-	 in hitPosAgain ()
-	 end
+         let val matCol = Matrix.fetchCol (mat, pos)
+            val matRow = Matrix.fetchRow (mat, pos)
+            val _ = print ("dd: pos = " ^ (Int.toString pos) ^ "\n")
+            fun swapRowLoop (best, bestRow, bestCol, row) =
+               if row >= height
+                  then (Matrix.rowSwap (mat, pos, bestRow);
+                        Matrix.colSwap (mat, pos, bestCol))
+               else let val matRow = Matrix.fetchRow (mat, row)
+                        fun swapColLoop (best, bestRow, bestCol, col) =
+                           if col >= width
+                              then swapRowLoop (best, bestRow, bestCol, row + 1)
+                           else let val next = matRow col
+                                in if smaller (next, best)
+                                      then swapColLoop (next, row, col, col + 1)
+                                   else swapColLoop (best, bestRow, bestCol, col + 1)
+                                end
+                    in swapColLoop (best, bestRow, bestCol, pos)
+                    end
+            fun rowLoop row =
+               if row < height
+                  then if (matCol row) = zero
+                          then rowLoop (row + 1)
+                       else (Matrix.rowOp (mat,
+                                           pos,
+                                           row,
+                                           let val x = IntInf.~ (IntInf.quot(matCol row, matCol pos))
+                                           in fn (lhs, rhs) => IntInf.+ (IntInf.* (lhs, x), rhs)
+                                           end);
+                             if (matCol row) = zero
+                                then rowLoop (row + 1)
+                             else hitPosAgain ())
+               else let fun colLoop col =
+                  if col < width
+                     then if (matRow col) = zero
+                             then colLoop (col + 1)
+                          else (Matrix.colOp (mat,
+                                              pos,
+                                              col,
+                                              let val x = IntInf.~ (IntInf.quot (matRow col, matRow pos))
+                                              in fn (lhs, rhs) => IntInf.+ (IntInf.* (lhs, x), rhs)
+                                              end);
+                                if (matRow col) = zero
+                                   then colLoop (col + 1)
+                                else hitPosAgain ())
+                  else ()
+                    in colLoop (pos + 1)
+                    end
+            and hitPosAgain () = (swapRowLoop (zero, pos, pos, pos);
+                                  rowLoop (pos + 1))
+         in hitPosAgain ()
+         end
       fun loop pos =
-	 if pos = range
-	    then mat
-	 else (dd pos;
-	       loop (pos + 1))
+         if pos = range
+            then mat
+         else (dd pos;
+               loop (pos + 1))
    in loop 0
    end
 
 val table = [[ 8,  ~3,   1,   3,   6,   9,  ~2,   4,  ~9,  ~9,   2,   3,   8,  ~1,   3,  ~5,   4,  ~3,  ~5,  ~6,   8,   1,   4,  ~5,   7,  ~4,  ~4,  ~7,   7,   1,   4,  ~3,   8,   4,  ~4,  ~8,   5,  ~9,   3,  ~4,   1,   9,  ~8,  ~6,  ~2,   8,  ~9,  ~5,  ~3,  ~3],
-	     [ 0,   8,  ~6,  ~2,  ~3,   4,   5,  ~2,   7,  ~7,  ~6,  ~7,  ~3,  ~4,   9,   7,  ~3,   3,   0,   3,   3,  ~8,  ~8,   2,   3,   8,   3,  ~2,  ~4,   3,  ~6,  ~6,  ~2,   6,   5,  ~1,  ~3,   1,   8,  ~8,   2,   1,  ~7,  ~7,  ~7,  ~3,  ~6,   6,  ~4,  ~9],
-	     [ 0,  ~5,   8,  ~9,   2,   4,   2,   7,  ~4,   9,  ~3,   6,  ~2,   3,  ~3,   0,  ~9,   5,   8,  ~1,   2,  ~8,   3,   4,  ~6,   5,  ~6,  ~5,  ~8,   0,  ~5,   3,  ~2,  ~5,   8,   7,  ~1,   1,  ~1,   7,   6,   3,   6,   5,   6,   8,   7,   9,   7,  ~3],
-	     [ 5,   4,   7,   2,   3,  ~9,   7,  ~7,   3,  ~8,   7,   5,   5,  ~2,  ~6,  ~3,   6,   5,   3,  ~1,  ~1,   4,   5,  ~5,   5,   9,   9,   3,   8,  ~3,  ~1,   9,  ~9,   6,  ~7,   7,   4,   6,  ~8,  ~9,   0,  ~3,  ~2,  ~7,   1,  ~2,  ~6,   7,   7,   7],
-	     [ 2,   9,   9,   3,  ~4,   0,   9,   2,   5,   3,  ~5,  ~3,  ~1,   1,   8,  ~6,   2,  ~4,  ~8,  ~7,  ~8,   4,   5,   8,  ~1,  ~1,   7,   2,   5,   5,  ~4,  ~7,  ~3,  ~7,   6,  ~4,  ~5,  ~8,  ~5,  ~9,  ~8,   5,  ~5,  ~5,   0,   8,   8,   6,   4,  ~1],
-	     [ 5,   5,   1,  ~7,   3,  ~5,   4,   9,   3,   4,   4,  ~5,   7,  ~1,   7,   4,  ~7,   7,  ~7,  ~2,   9,  ~9,   0,  ~4,  ~4,   0,   2,   6,   3,  ~1,   6,   6,   8,  ~6,  ~4,  ~9,   3,  ~2,  ~5,   5,  ~3,   2,  ~1,  ~6,   9,   3,  ~3,  ~8,  ~9,   7],
-	     [ 7,   1,   2,   7,   6,   5,  ~6,  ~3,  ~4,  ~8,   0,   9,   6,   1,   2,  ~5,   4,   4,   4,  ~6,  ~7,  ~9,  ~6,   2,  ~4,   5,  ~2,   1,   0,   1,  ~8,   7,  ~7,  ~5,   4,   1,  ~5,   4,  ~4,  ~2,  ~3,   1,   1,   3,   4,  ~4,  ~5,   9,   8,  ~2],
-	     [ 6,   2,  ~1,  ~8,   4,  ~7,   7,  ~3,  ~2,  ~5,   3,   0,   3,  ~9,   3,   3,   9,  ~1,   4,   8,  ~9,   6,  ~5,   9,   5,  ~1,  ~1,  ~9,   7,  ~2,   3,   9,   8,   9,   2,   7,   7,   6,  ~1,  ~1,  ~2,  ~2,  ~7,   3,  ~6,   0,  ~9,   4,   3,   7],
-	     [ 0,  ~6,  ~3,  ~7,  ~1,   5,  ~2,   8,  ~5,  ~3,  ~8,   7,  ~2,  ~2,   0,  ~8,   4,   8,   9,  ~5,  ~4,  ~8,  ~1,   7,   1,   1,   6,  ~9,  ~4,   0,   8,   4,   3,  ~7,   6,   0,   1,   8,   6,  ~1,  ~1,  ~7,   9,  ~9,  ~5,  ~2,  ~2,  ~1,   1,   0],
-	     [~4,   9,   6,  ~3,  ~2,  ~6,  ~3,   4,   8,  ~8,   1,  ~5,   9,   7,   9,   7,  ~9,  ~6,   6,   1,  ~3,   3,  ~3,  ~7,   1,   7,  ~7,   0,  ~2,   7,  ~4,  ~6,   0,   1,  ~3,  ~5,  ~9,  ~7,   8,   4,   9,  ~8,  ~8,  ~7,  ~6,   7,   6,  ~3,  ~8,   5],
-	     [ 6,   7,  ~5,  ~9,   6,   1,   8,   4,  ~2,   7,  ~7,  ~1,  ~9,   1,  ~6,  ~5,   4,   9,   6,   0,  ~8,  ~3,   1,  ~3,   8,  ~3,   2,   9,  ~3,  ~9,  ~1,  ~3,   4,   3,   2,  ~9,  ~5,  ~3,   8,  ~4,   8,   5,  ~4,   7,   6,  ~8,   7,   6,  ~5,   5],
-	     [ 1,   7,  ~8,  ~9,  ~7,  ~3,   8,   9,  ~7,  ~1,  ~7,   4,   0,   0,   1,  ~5,   9,  ~8,  ~1,  ~2,   3,   5,   9,  ~9,   5,   4,  ~9,   1,  ~4,  ~2,   3,  ~4,   8,  ~6,  ~4,  ~8,  ~5,  ~5,   4,  ~2,  ~4,  ~1,  ~9,  ~5,   2,  ~9,   2,  ~9,  ~2,  ~3],
-	     [~5,  ~4,  ~4,   9,   2,   7,  ~2,   6,   7,   2,  ~9,   4,   2,   7,   8,  ~9,   2,   5,   3,   9,   6,   3,   0,  ~7,  ~6,  ~7,   6,  ~2,   9,  ~3,  ~6,   9,  ~9,   2,   2,  ~6,  ~1,   4,  ~3,   3,   0,   6,  ~3,   4,   9,   9,  ~6,   5,   5,  ~5],
-	     [ 5,  ~7,   8,  ~4,   8,   8,  ~4,  ~9,   6,   0,  ~3,   6,   0,   8,   8,  ~6,  ~2,   5,   4,  ~1,  ~8,   1,  ~3,  ~1,   2,   3,  ~9,  ~9,  ~5,   1,   8,  ~5,  ~3,   0,  ~4,  ~9,   0,  ~6,   3,  ~1,  ~7,   0,   8,   9,  ~6,  ~1,  ~9,   1,  ~6,   2],
-	     [ 7,  ~5,  ~1,   5,  ~2,   7,   0,  ~7,  ~1,   8,   8,  ~3,   9,  ~5,   7,  ~8,  ~8,  ~4,   3,   2,  ~1,   8,  ~2,   1,   2,   5,   0,  ~6,   7,   3,   3,   7,  ~5,   5,  ~1,   1,   0,  ~8,   1,   0,   0,  ~4,   6,   9,  ~5,  ~6,   3,  ~5,   8,   5],
-	     [~4,  ~2,   3,  ~3,  ~1,   2,  ~2,  ~1,  ~9,  ~5,   1,   0,   0,   2,   9,  ~3,  ~9,   2,   9,   3,   8,  ~3,   4,   8,   8,   3,  ~3,  ~1,  ~4,   4,  ~6,  ~9,   5,  ~2,   1,   3,  ~7,  ~5,  ~6,  ~5,  ~8,   4,  ~8,  ~3,   5,   0,   7,  ~9,   6,   2],
-	     [ 5,   1,   4,  ~3,  ~1,  ~9,   5,  ~8,  ~8,   6,   1,   1,  ~2,   7,   5,   6,  ~4,   2,  ~7,   0,  ~7,  ~3,  ~5,   9,   3,   4,  ~6,   8,  ~4,   3,   6,   0,   2,   3,  ~6,   3,   9,   4,   1,  ~4,   6,  ~5,  ~7,   0,  ~1,  ~8,  ~3,  ~9,   9,   7],
-	     [ 2,  ~6,  ~1,   8,   4,  ~3,  ~1,  ~6,  ~2,  ~8,  ~2,  ~1,  ~1,  ~5,  ~9,  ~8,   9,  ~9,   5,   1,   9,  ~1,  ~6,   9,  ~7,   2,   8,  ~7,   4,  ~9,   7,   6,  ~2,   1,  ~2,  ~7,   8,   0,   5,   0,  ~5,  ~7,  ~6,   0,   4,   0,   3,  ~8,   5,   4],
-	     [~2,   9,  ~9,  ~6,   1,  ~8,   8,   4,  ~6,   8,   1,  ~3,  ~7,   8,  ~5,   2,  ~8,   1,   3,  ~2,   6,   6,   6,   1,   0,   0,  ~7,   7,  ~3,  ~3,   0,  ~4,   3,  ~7,  ~6,   7,   5,   9,  ~5,   7,  ~8,   2,   3,  ~8,  ~7,   6,  ~5,  ~5,  ~8,  ~9],
-	     [~7,  ~4,   4,   1,  ~1,  ~3,  ~8,   3,   7,   9,   8,   3,   0,   4,   4,  ~1,  ~5,   4,   2,   2,   0,   6,  ~6,   2,  ~9,   8,  ~9,   3,  ~2,   2,   6,   6,   1,   7,   1,   0,  ~8,   2,   3,  ~3,   8,   9,   5,   5,  ~6,   4,  ~7,  ~4,  ~2,  ~3],
-	     [~5,   8,   6,   1,  ~6,  ~6,   6,   1,   1,  ~3,  ~9,  ~6,   2,  ~7,   2,  ~1,   6,  ~6,   0,   2,  ~7,   8,  ~8,   4,   9,  ~3,   9,  ~7,  ~9,  ~6,  ~4,  ~4,  ~5,   8,   2,  ~5,  ~4,  ~3,   5,   2,   1,  ~3,  ~3,  ~7,  ~9,   3,   7,  ~7,   3,  ~8],
-	     [~4,  ~7,  ~2,   2,  ~4,  ~2,   6,  ~3,  ~1,  ~4,   0,  ~5,   9,   7,  ~6,  ~9,   7,  ~9,  ~6,   2,  ~3,   1,   5,  ~9,   4,  ~5,   4,  ~9,   1,  ~2,  ~2,   4,   0,   4,  ~8,  ~8,   3,  ~1,  ~5,  ~4,  ~9,  ~7,   7,   6,   3,  ~9,   6,   4,  ~4,  ~7],
-	     [~9,   6,   6,  ~5,  ~1,  ~7,   4,  ~9,   4,  ~1,   6,  ~4,   7,   2,   8,   7,   3,   1,  ~7,   7,   7,   9,   8,  ~9,   7,   2,   1,   2,  ~8,   4,   5,   6,   7,   2,  ~7,   6,   8,   4,  ~9,   7,  ~5,   6,   9,  ~1,   9,   2,   0,   9,   3,   6],
-	     [ 4,  ~3,   8,   0,  ~2,  ~2,   2,  ~3,   8,   3,   1,  ~8,  ~5,  ~2,   5,   6,   8,   0,  ~3,   4,  ~2,   4,  ~9,  ~5,   7,   6,  ~4,  ~7,   2,   4,  ~3,  ~8,  ~9,   9,   8,  ~9,   3,  ~7,   4,  ~7,  ~5,   4,   9,   3,  ~6,  ~3,  ~7,   4,   2,  ~2],
-	     [~8,  ~8,   6,  ~2,  ~6,   8,  ~3,   3,  ~1,  ~7,   1,   9,   1,   7,  ~6,   8,  ~2,  ~9,  ~1,   3,  ~4,   7,   8,  ~1,   9,  ~9,   6,  ~3,   5,   0,   2,   5,  ~1,  ~6,  ~6,   1,   8,   6,  ~3,  ~9,  ~1,   9,  ~2,   9,  ~8,  ~7,  ~3,   6,  ~3,  ~3],
-	     [ 5,  ~2,   3,   0,  ~9,  ~8,  ~6,   1,   8,   0,   1,   2,  ~8,  ~2,   0,  ~9,  ~8,   0,   5,  ~3,  ~4,   5,   6,  ~2,  ~5,   0,  ~9,   9,  ~9,  ~5,   9,   9,  ~5,  ~2,   4,   3,   8,  ~8,  ~7,   5,  ~3,  ~2,   2,   3,   9,   7,  ~1,   0,   4,  ~1],
-	     [~4,   5,  ~5,   7,   8,   9,   7,  ~3,   1,   9,  ~7,  ~1,   8,  ~5,  ~1,   2,  ~8,   1,   0,   9,  ~8,  ~1,   6,  ~1,   9,  ~8,   7,   4,  ~8,   7,   0,  ~6,   2,   3,   7,   4,  ~3,  ~5,   9,  ~3,   0,   6,  ~9,   2,   4,  ~8,   6,  ~7,   9,   1],
-	     [ 7,   0,  ~9,   6,   8,   2,   2,   5,  ~6,  ~6,   9,  ~5,   9,   2,   2,  ~8,   0,  ~6,  ~9,  ~6,  ~4,  ~9,   8,  ~2,   9,   7,  ~5,  ~1,   7,   2,  ~7,   7,  ~1,  ~3,   6,   6,   1,  ~4,   0,  ~1,  ~6,  ~5,   6,  ~7,  ~3,  ~2,   8,   2,  ~9,   8],
-	     [ 8,  ~7,  ~9,  ~6,   9,  ~7,  ~7,   6,  ~8,   9,   5,  ~4,   1,  ~7,  ~8,  ~6,  ~3,   8,  ~8,   1,  ~8,   6,   9,  ~3,  ~7,   7,   1,   6,   1,   0,   8,  ~5,  ~8,   8,  ~9,   0,   4,   4,   3,  ~4,   6,  ~3,  ~9,   0,   4,  ~4,  ~5,  ~9,  ~5,  ~8],
-	     [~3,  ~2,   8,   1,  ~1,  ~1,  ~4,   3,   7,  ~2,  ~9,   9,  ~8,  ~9,   6,  ~4,   7,  ~1,  ~5,  ~3,  ~9,   0,  ~3,   0,   7,   9,   1,  ~2,   7,  ~9,  ~6,   3,   3,  ~4,  ~7,  ~3,  ~4,  ~8,  ~2,  ~3,  ~9,  ~2,  ~6,   3,  ~6,  ~4,   7,  ~5,  ~8,  ~1],
-	     [~9,  ~9,  ~2,  ~9,  ~9,   9,   6,   6,   7,   5,  ~1,  ~2,   1,   5,   2,  ~3,  ~4,   1,  ~6,   0,  ~3,  ~9,  ~1,   7,   0,  ~9,   5,  ~2,  ~2,   5,   3,   4,  ~1,   6,  ~6,   3,  ~6,   7,  ~1,   5,  ~8,  ~4,  ~2,  ~2,  ~6,  ~5,  ~6,   3,  ~1,   4],
-	     [ 7,   7,   8,   7,   6,   1,  ~2,   5,  ~6,   9,   4,   8,   5,   0,  ~4,  ~2,  ~2,  ~5,  ~2,  ~6,   9,  ~8,  ~2,  ~5,  ~9,   3,  ~6,  ~3,  ~4,  ~5,  ~2,   6,   1,   6,  ~5,   0,  ~3,  ~2,   4,  ~6,   1,   6,  ~1,   3,  ~9,   2,  ~3,   1,   5,  ~6],
-	     [ 6,   4,  ~7,   3,  ~7,   9,   1,  ~7,  ~8,   0,  ~6,   8,   4,   1,   9,   6,   8,   3,   0,   9,   0,   4,   9,  ~7,  ~7,   1,   5,   1,  ~5,   6,   9,   2,   4,   1,  ~9,   8,   4,   5,   8,   3,   2,  ~9,  ~6,  ~9,   9,  ~9,   7,  ~6,  ~4,   3],
-	     [~3,  ~9,  ~4,   2,   3,   9,  ~9,   8,  ~9,   9,  ~4,  ~9,  ~5,   5,   0,   7,   3,  ~5,  ~8,   2,  ~3,   0,  ~9,  ~3,   1,   9,   4,   5,  ~1,   8,   0,  ~4,  ~2,   9,  ~4,  ~1,   3,   5,   9,  ~1,   1,   4,  ~8,  ~2,  ~3,   5,   1,   5,  ~6,   7],
-	     [ 9,  ~3,   2,  ~9,   3,   4,   0,   7,  ~5,   9,   0,  ~6,   7,  ~2,   3,  ~7,   2,  ~5,  ~2,   6,   3,  ~9,  ~5,  ~9,   5,   2,  ~5,  ~3,   8,  ~5,   6,   2,   9,  ~7,  ~7,  ~7,  ~6,   9,  ~3,   6,   0,   6,  ~6,  ~9,   4,  ~3,  ~9,   0,  ~4,  ~9],
-	     [~4,  ~8,   8,  ~7,   7,   0,  ~6,  ~6,   8,  ~9,  ~4,   5,  ~3,  ~1,   7,  ~5,  ~6,  ~1,   8,   6,  ~2,   1,  ~1,   5,  ~9,   1,  ~1,  ~7,  ~6,  ~6,  ~6,  ~4,   6,   3,  ~5,  ~5,  ~6,   2,   3,  ~6,  ~8,  ~3,   8,  ~2,  ~5,  ~4,  ~3,   1,   4,  ~4],
-	     [ 4,  ~6,   2,   6,   2,  ~8,   8,   5,   8,  ~2,   0,  ~6,  ~1,  ~6,  ~2,   2,   6,  ~9,  ~7,  ~6,  ~4,  ~4,  ~7,  ~2,   8,   6,   3,  ~7,  ~6,   8,   2,   3,   4,   5,   3,   4,  ~6,   8,   8,  ~1,   4,  ~5,   6,   2,   8,  ~3,  ~9,  ~2,   6,   7],
-	     [ 3,  ~4,   0,  ~3,  ~5,   0,  ~2,  ~6,  ~2,   8,   5,  ~9,  ~4,  ~8,  ~6,   0,   8,   9,   1,  ~2,   8,   2,  ~2,   8,   9,   3,   3,   5,  ~9,  ~3,  ~2,   7,   2,   9,   0,   4,   8,  ~9,   0,  ~6,   9,  ~9,   9,  ~4,   8,  ~8,  ~8,   2,  ~3,   2],
-	     [~1,   3,  ~9,  ~8,  ~7,   6,  ~6,   3,   0,   5,  ~5,   1,   2,  ~2,  ~3,   7,   7,   3,  ~4,  ~2,  ~9,  ~5,  ~1,   9,   6,   8,   2,   8,   7,  ~3,   4,   6,   6,   0,  ~2,   2,  ~7,  ~7,   6,  ~3,   8,   2,   1,   0,   8,  ~1,   3,   9,   8,   6],
-	     [ 1,  ~2,  ~3,   6,   5,   5,  ~6,  ~4,  ~5,   1,   1,   6,  ~7,  ~4,  ~3,   4,   4,  ~8,  ~9,   7,  ~2,  ~3,  ~7,  ~2,   1,   2,   0,   8,  ~6,  ~5,  ~5,   7,   8,   5,  ~2,   3,   9,   0,   5,   1,   3,  ~4,  ~6,   1,   4,  ~9,  ~2,   5,   4,   3],
-	     [ 3,   3,   9,  ~2,   6,   9,   4,   9,   4,  ~8,   5,  ~1,   3,  ~2,   1,  ~7,  ~3,   2,   2,   0,  ~3,   3,   8,   2,   0,  ~5,   7,   1,   4,  ~8,   8,  ~9,  ~1,   1,  ~9,  ~4,   5,   2,   2,   8,   6,   1,   6,  ~2,   2,   7,   1,  ~6,  ~1,  ~1],
-	     [ 4,  ~2,   4,  ~1,  ~5,  ~1,   5,  ~2,   3,  ~4,  ~5,   0,   2,  ~4,   6,   4,  ~3,   2,   2,   5,  ~6,  ~7,  ~9,  ~1,  ~9,  ~9,   6,   0,   6,   5,   9,  ~1,   3,  ~3,  ~8,   8,  ~8,   8,   4,   5,  ~1,  ~5,   1,   0,   3,  ~2,   5,   6,   6,   5],
-	     [~4,   9,   6,   8,  ~9,   5,   5,  ~3,  ~7,   7,   6,   8,  ~8,   0,   4,  ~1,   9,   5,  ~7,   0,  ~1,  ~2,   3,   6,   0,   4,  ~3,   1,   4,   6,   4,   0,   5,  ~1,   7,  ~7,  ~6,  ~8,  ~3,  ~6,   7,  ~1,  ~3,  ~2,  ~3,  ~5,   3,   1,  ~8,  ~9],
-	     [~6,   4,  ~5,   9,   9,  ~7,  ~1,  ~8,  ~4,   2,  ~6,   0,  ~6,  ~6,   7,   6,   0,   1,   7,  ~7,   0,  ~4,  ~6,  ~8,  ~9,   5,  ~6,  ~9,   2,  ~7,  ~2,  ~6,   9,   4,  ~5,   0,   4,  ~4,  ~5,   6,   9,   1,  ~6,  ~5,   3,  ~1,   7,  ~7,  ~6,   7],
-	     [~8,   7,   7,  ~6,   7,  ~4,   8,   0,  ~9,  ~8,  ~3,   7,  ~3,   3,   8,  ~7,  ~2,  ~7,   5,   5,  ~5,   4,   6,   2,   4,   1,   4,  ~9,  ~3,   8,   8,  ~9,  ~4,  ~2,   1,  ~3,   1,   3,   9,  ~5,  ~8,  ~2,   7,   8,   9,   2,   0,   1,  ~9,   6],
-	     [~7,   1,  ~9,   5,  ~5,  ~5,   7,   6,  ~5,  ~9,  ~6,  ~8,  ~6,   9,   7,   9,   0,  ~5,   7,   7,  ~6,   4,   5,  ~9,  ~1,  ~2,  ~7,   3,  ~5,  ~2,  ~5,   5,  ~3,  ~4,  ~2,  ~8,   2,  ~8,   0,  ~8,   0,  ~8,   9,   8,  ~5,  ~5,   1,   3,   5,  ~4],
-	     [~8,  ~8,   0,  ~5,  ~8,  ~6,   3,  ~6,  ~4,   6,   1,  ~5,  ~6,  ~8,  ~4,  ~6,  ~2,  ~6,   6,  ~4,   8,   8,   4,  ~5,  ~1,   0,   9,  ~8,  ~3,  ~1,  ~8,   7,  ~3,   0,  ~7,   1,  ~7,  ~1,  ~7,   3,  ~7,   3,  ~4,  ~8,   8,  ~7,  ~9,  ~8,   3,   2],
-	     [ 3,   6,   8,  ~9,   7,   1,  ~9,   9,   3,   8,   6,   4,  ~2,   1,  ~8,   4,  ~7,  ~4,  ~3,   3,  ~5,  ~6,  ~7,  ~2,   0,  ~4,   5,   2,   5,   6,   3,  ~8,   2,  ~5,  ~7,   6,   8,  ~2,  ~5,  ~4,   9,   9,   2,  ~2,  ~2,   7,   4,   4,  ~2,   3],
-	     [ 6,   6,  ~5,  ~2,  ~8,  ~2,  ~9,   0,   2,   4,  ~6,  ~9,   9,   0,  ~8,  ~3,  ~1,  ~2,  ~1,   6,   8,   2,  ~9,   5,  ~2,   1,   7,  ~6,   5,   1,  ~1,   4,  ~4,  ~7,  ~6,  ~3,  ~8,   2,   2,   5,   5,  ~6,   5,   3,   3,   7,   4,   7,  ~3,  ~9],
-	     [~9,   6,  ~4,   1,   3,  ~8,  ~8,  ~8,  ~1,   5,   1,   1,  ~1,   6,   5,   1,  ~1,   5,  ~8,   8,  ~7,  ~5,  ~1,  ~1,   6,  ~8,  ~3,  ~1,  ~2,  ~6,  ~5,  ~5,  ~6,   0,   2,   2,   7,  ~1,  ~5,  ~7,  ~1,  ~3,   7,   6,   0,   2,   4,  ~5,   0,  ~4]]
+             [ 0,   8,  ~6,  ~2,  ~3,   4,   5,  ~2,   7,  ~7,  ~6,  ~7,  ~3,  ~4,   9,   7,  ~3,   3,   0,   3,   3,  ~8,  ~8,   2,   3,   8,   3,  ~2,  ~4,   3,  ~6,  ~6,  ~2,   6,   5,  ~1,  ~3,   1,   8,  ~8,   2,   1,  ~7,  ~7,  ~7,  ~3,  ~6,   6,  ~4,  ~9],
+             [ 0,  ~5,   8,  ~9,   2,   4,   2,   7,  ~4,   9,  ~3,   6,  ~2,   3,  ~3,   0,  ~9,   5,   8,  ~1,   2,  ~8,   3,   4,  ~6,   5,  ~6,  ~5,  ~8,   0,  ~5,   3,  ~2,  ~5,   8,   7,  ~1,   1,  ~1,   7,   6,   3,   6,   5,   6,   8,   7,   9,   7,  ~3],
+             [ 5,   4,   7,   2,   3,  ~9,   7,  ~7,   3,  ~8,   7,   5,   5,  ~2,  ~6,  ~3,   6,   5,   3,  ~1,  ~1,   4,   5,  ~5,   5,   9,   9,   3,   8,  ~3,  ~1,   9,  ~9,   6,  ~7,   7,   4,   6,  ~8,  ~9,   0,  ~3,  ~2,  ~7,   1,  ~2,  ~6,   7,   7,   7],
+             [ 2,   9,   9,   3,  ~4,   0,   9,   2,   5,   3,  ~5,  ~3,  ~1,   1,   8,  ~6,   2,  ~4,  ~8,  ~7,  ~8,   4,   5,   8,  ~1,  ~1,   7,   2,   5,   5,  ~4,  ~7,  ~3,  ~7,   6,  ~4,  ~5,  ~8,  ~5,  ~9,  ~8,   5,  ~5,  ~5,   0,   8,   8,   6,   4,  ~1],
+             [ 5,   5,   1,  ~7,   3,  ~5,   4,   9,   3,   4,   4,  ~5,   7,  ~1,   7,   4,  ~7,   7,  ~7,  ~2,   9,  ~9,   0,  ~4,  ~4,   0,   2,   6,   3,  ~1,   6,   6,   8,  ~6,  ~4,  ~9,   3,  ~2,  ~5,   5,  ~3,   2,  ~1,  ~6,   9,   3,  ~3,  ~8,  ~9,   7],
+             [ 7,   1,   2,   7,   6,   5,  ~6,  ~3,  ~4,  ~8,   0,   9,   6,   1,   2,  ~5,   4,   4,   4,  ~6,  ~7,  ~9,  ~6,   2,  ~4,   5,  ~2,   1,   0,   1,  ~8,   7,  ~7,  ~5,   4,   1,  ~5,   4,  ~4,  ~2,  ~3,   1,   1,   3,   4,  ~4,  ~5,   9,   8,  ~2],
+             [ 6,   2,  ~1,  ~8,   4,  ~7,   7,  ~3,  ~2,  ~5,   3,   0,   3,  ~9,   3,   3,   9,  ~1,   4,   8,  ~9,   6,  ~5,   9,   5,  ~1,  ~1,  ~9,   7,  ~2,   3,   9,   8,   9,   2,   7,   7,   6,  ~1,  ~1,  ~2,  ~2,  ~7,   3,  ~6,   0,  ~9,   4,   3,   7],
+             [ 0,  ~6,  ~3,  ~7,  ~1,   5,  ~2,   8,  ~5,  ~3,  ~8,   7,  ~2,  ~2,   0,  ~8,   4,   8,   9,  ~5,  ~4,  ~8,  ~1,   7,   1,   1,   6,  ~9,  ~4,   0,   8,   4,   3,  ~7,   6,   0,   1,   8,   6,  ~1,  ~1,  ~7,   9,  ~9,  ~5,  ~2,  ~2,  ~1,   1,   0],
+             [~4,   9,   6,  ~3,  ~2,  ~6,  ~3,   4,   8,  ~8,   1,  ~5,   9,   7,   9,   7,  ~9,  ~6,   6,   1,  ~3,   3,  ~3,  ~7,   1,   7,  ~7,   0,  ~2,   7,  ~4,  ~6,   0,   1,  ~3,  ~5,  ~9,  ~7,   8,   4,   9,  ~8,  ~8,  ~7,  ~6,   7,   6,  ~3,  ~8,   5],
+             [ 6,   7,  ~5,  ~9,   6,   1,   8,   4,  ~2,   7,  ~7,  ~1,  ~9,   1,  ~6,  ~5,   4,   9,   6,   0,  ~8,  ~3,   1,  ~3,   8,  ~3,   2,   9,  ~3,  ~9,  ~1,  ~3,   4,   3,   2,  ~9,  ~5,  ~3,   8,  ~4,   8,   5,  ~4,   7,   6,  ~8,   7,   6,  ~5,   5],
+             [ 1,   7,  ~8,  ~9,  ~7,  ~3,   8,   9,  ~7,  ~1,  ~7,   4,   0,   0,   1,  ~5,   9,  ~8,  ~1,  ~2,   3,   5,   9,  ~9,   5,   4,  ~9,   1,  ~4,  ~2,   3,  ~4,   8,  ~6,  ~4,  ~8,  ~5,  ~5,   4,  ~2,  ~4,  ~1,  ~9,  ~5,   2,  ~9,   2,  ~9,  ~2,  ~3],
+             [~5,  ~4,  ~4,   9,   2,   7,  ~2,   6,   7,   2,  ~9,   4,   2,   7,   8,  ~9,   2,   5,   3,   9,   6,   3,   0,  ~7,  ~6,  ~7,   6,  ~2,   9,  ~3,  ~6,   9,  ~9,   2,   2,  ~6,  ~1,   4,  ~3,   3,   0,   6,  ~3,   4,   9,   9,  ~6,   5,   5,  ~5],
+             [ 5,  ~7,   8,  ~4,   8,   8,  ~4,  ~9,   6,   0,  ~3,   6,   0,   8,   8,  ~6,  ~2,   5,   4,  ~1,  ~8,   1,  ~3,  ~1,   2,   3,  ~9,  ~9,  ~5,   1,   8,  ~5,  ~3,   0,  ~4,  ~9,   0,  ~6,   3,  ~1,  ~7,   0,   8,   9,  ~6,  ~1,  ~9,   1,  ~6,   2],
+             [ 7,  ~5,  ~1,   5,  ~2,   7,   0,  ~7,  ~1,   8,   8,  ~3,   9,  ~5,   7,  ~8,  ~8,  ~4,   3,   2,  ~1,   8,  ~2,   1,   2,   5,   0,  ~6,   7,   3,   3,   7,  ~5,   5,  ~1,   1,   0,  ~8,   1,   0,   0,  ~4,   6,   9,  ~5,  ~6,   3,  ~5,   8,   5],
+             [~4,  ~2,   3,  ~3,  ~1,   2,  ~2,  ~1,  ~9,  ~5,   1,   0,   0,   2,   9,  ~3,  ~9,   2,   9,   3,   8,  ~3,   4,   8,   8,   3,  ~3,  ~1,  ~4,   4,  ~6,  ~9,   5,  ~2,   1,   3,  ~7,  ~5,  ~6,  ~5,  ~8,   4,  ~8,  ~3,   5,   0,   7,  ~9,   6,   2],
+             [ 5,   1,   4,  ~3,  ~1,  ~9,   5,  ~8,  ~8,   6,   1,   1,  ~2,   7,   5,   6,  ~4,   2,  ~7,   0,  ~7,  ~3,  ~5,   9,   3,   4,  ~6,   8,  ~4,   3,   6,   0,   2,   3,  ~6,   3,   9,   4,   1,  ~4,   6,  ~5,  ~7,   0,  ~1,  ~8,  ~3,  ~9,   9,   7],
+             [ 2,  ~6,  ~1,   8,   4,  ~3,  ~1,  ~6,  ~2,  ~8,  ~2,  ~1,  ~1,  ~5,  ~9,  ~8,   9,  ~9,   5,   1,   9,  ~1,  ~6,   9,  ~7,   2,   8,  ~7,   4,  ~9,   7,   6,  ~2,   1,  ~2,  ~7,   8,   0,   5,   0,  ~5,  ~7,  ~6,   0,   4,   0,   3,  ~8,   5,   4],
+             [~2,   9,  ~9,  ~6,   1,  ~8,   8,   4,  ~6,   8,   1,  ~3,  ~7,   8,  ~5,   2,  ~8,   1,   3,  ~2,   6,   6,   6,   1,   0,   0,  ~7,   7,  ~3,  ~3,   0,  ~4,   3,  ~7,  ~6,   7,   5,   9,  ~5,   7,  ~8,   2,   3,  ~8,  ~7,   6,  ~5,  ~5,  ~8,  ~9],
+             [~7,  ~4,   4,   1,  ~1,  ~3,  ~8,   3,   7,   9,   8,   3,   0,   4,   4,  ~1,  ~5,   4,   2,   2,   0,   6,  ~6,   2,  ~9,   8,  ~9,   3,  ~2,   2,   6,   6,   1,   7,   1,   0,  ~8,   2,   3,  ~3,   8,   9,   5,   5,  ~6,   4,  ~7,  ~4,  ~2,  ~3],
+             [~5,   8,   6,   1,  ~6,  ~6,   6,   1,   1,  ~3,  ~9,  ~6,   2,  ~7,   2,  ~1,   6,  ~6,   0,   2,  ~7,   8,  ~8,   4,   9,  ~3,   9,  ~7,  ~9,  ~6,  ~4,  ~4,  ~5,   8,   2,  ~5,  ~4,  ~3,   5,   2,   1,  ~3,  ~3,  ~7,  ~9,   3,   7,  ~7,   3,  ~8],
+             [~4,  ~7,  ~2,   2,  ~4,  ~2,   6,  ~3,  ~1,  ~4,   0,  ~5,   9,   7,  ~6,  ~9,   7,  ~9,  ~6,   2,  ~3,   1,   5,  ~9,   4,  ~5,   4,  ~9,   1,  ~2,  ~2,   4,   0,   4,  ~8,  ~8,   3,  ~1,  ~5,  ~4,  ~9,  ~7,   7,   6,   3,  ~9,   6,   4,  ~4,  ~7],
+             [~9,   6,   6,  ~5,  ~1,  ~7,   4,  ~9,   4,  ~1,   6,  ~4,   7,   2,   8,   7,   3,   1,  ~7,   7,   7,   9,   8,  ~9,   7,   2,   1,   2,  ~8,   4,   5,   6,   7,   2,  ~7,   6,   8,   4,  ~9,   7,  ~5,   6,   9,  ~1,   9,   2,   0,   9,   3,   6],
+             [ 4,  ~3,   8,   0,  ~2,  ~2,   2,  ~3,   8,   3,   1,  ~8,  ~5,  ~2,   5,   6,   8,   0,  ~3,   4,  ~2,   4,  ~9,  ~5,   7,   6,  ~4,  ~7,   2,   4,  ~3,  ~8,  ~9,   9,   8,  ~9,   3,  ~7,   4,  ~7,  ~5,   4,   9,   3,  ~6,  ~3,  ~7,   4,   2,  ~2],
+             [~8,  ~8,   6,  ~2,  ~6,   8,  ~3,   3,  ~1,  ~7,   1,   9,   1,   7,  ~6,   8,  ~2,  ~9,  ~1,   3,  ~4,   7,   8,  ~1,   9,  ~9,   6,  ~3,   5,   0,   2,   5,  ~1,  ~6,  ~6,   1,   8,   6,  ~3,  ~9,  ~1,   9,  ~2,   9,  ~8,  ~7,  ~3,   6,  ~3,  ~3],
+             [ 5,  ~2,   3,   0,  ~9,  ~8,  ~6,   1,   8,   0,   1,   2,  ~8,  ~2,   0,  ~9,  ~8,   0,   5,  ~3,  ~4,   5,   6,  ~2,  ~5,   0,  ~9,   9,  ~9,  ~5,   9,   9,  ~5,  ~2,   4,   3,   8,  ~8,  ~7,   5,  ~3,  ~2,   2,   3,   9,   7,  ~1,   0,   4,  ~1],
+             [~4,   5,  ~5,   7,   8,   9,   7,  ~3,   1,   9,  ~7,  ~1,   8,  ~5,  ~1,   2,  ~8,   1,   0,   9,  ~8,  ~1,   6,  ~1,   9,  ~8,   7,   4,  ~8,   7,   0,  ~6,   2,   3,   7,   4,  ~3,  ~5,   9,  ~3,   0,   6,  ~9,   2,   4,  ~8,   6,  ~7,   9,   1],
+             [ 7,   0,  ~9,   6,   8,   2,   2,   5,  ~6,  ~6,   9,  ~5,   9,   2,   2,  ~8,   0,  ~6,  ~9,  ~6,  ~4,  ~9,   8,  ~2,   9,   7,  ~5,  ~1,   7,   2,  ~7,   7,  ~1,  ~3,   6,   6,   1,  ~4,   0,  ~1,  ~6,  ~5,   6,  ~7,  ~3,  ~2,   8,   2,  ~9,   8],
+             [ 8,  ~7,  ~9,  ~6,   9,  ~7,  ~7,   6,  ~8,   9,   5,  ~4,   1,  ~7,  ~8,  ~6,  ~3,   8,  ~8,   1,  ~8,   6,   9,  ~3,  ~7,   7,   1,   6,   1,   0,   8,  ~5,  ~8,   8,  ~9,   0,   4,   4,   3,  ~4,   6,  ~3,  ~9,   0,   4,  ~4,  ~5,  ~9,  ~5,  ~8],
+             [~3,  ~2,   8,   1,  ~1,  ~1,  ~4,   3,   7,  ~2,  ~9,   9,  ~8,  ~9,   6,  ~4,   7,  ~1,  ~5,  ~3,  ~9,   0,  ~3,   0,   7,   9,   1,  ~2,   7,  ~9,  ~6,   3,   3,  ~4,  ~7,  ~3,  ~4,  ~8,  ~2,  ~3,  ~9,  ~2,  ~6,   3,  ~6,  ~4,   7,  ~5,  ~8,  ~1],
+             [~9,  ~9,  ~2,  ~9,  ~9,   9,   6,   6,   7,   5,  ~1,  ~2,   1,   5,   2,  ~3,  ~4,   1,  ~6,   0,  ~3,  ~9,  ~1,   7,   0,  ~9,   5,  ~2,  ~2,   5,   3,   4,  ~1,   6,  ~6,   3,  ~6,   7,  ~1,   5,  ~8,  ~4,  ~2,  ~2,  ~6,  ~5,  ~6,   3,  ~1,   4],
+             [ 7,   7,   8,   7,   6,   1,  ~2,   5,  ~6,   9,   4,   8,   5,   0,  ~4,  ~2,  ~2,  ~5,  ~2,  ~6,   9,  ~8,  ~2,  ~5,  ~9,   3,  ~6,  ~3,  ~4,  ~5,  ~2,   6,   1,   6,  ~5,   0,  ~3,  ~2,   4,  ~6,   1,   6,  ~1,   3,  ~9,   2,  ~3,   1,   5,  ~6],
+             [ 6,   4,  ~7,   3,  ~7,   9,   1,  ~7,  ~8,   0,  ~6,   8,   4,   1,   9,   6,   8,   3,   0,   9,   0,   4,   9,  ~7,  ~7,   1,   5,   1,  ~5,   6,   9,   2,   4,   1,  ~9,   8,   4,   5,   8,   3,   2,  ~9,  ~6,  ~9,   9,  ~9,   7,  ~6,  ~4,   3],
+             [~3,  ~9,  ~4,   2,   3,   9,  ~9,   8,  ~9,   9,  ~4,  ~9,  ~5,   5,   0,   7,   3,  ~5,  ~8,   2,  ~3,   0,  ~9,  ~3,   1,   9,   4,   5,  ~1,   8,   0,  ~4,  ~2,   9,  ~4,  ~1,   3,   5,   9,  ~1,   1,   4,  ~8,  ~2,  ~3,   5,   1,   5,  ~6,   7],
+             [ 9,  ~3,   2,  ~9,   3,   4,   0,   7,  ~5,   9,   0,  ~6,   7,  ~2,   3,  ~7,   2,  ~5,  ~2,   6,   3,  ~9,  ~5,  ~9,   5,   2,  ~5,  ~3,   8,  ~5,   6,   2,   9,  ~7,  ~7,  ~7,  ~6,   9,  ~3,   6,   0,   6,  ~6,  ~9,   4,  ~3,  ~9,   0,  ~4,  ~9],
+             [~4,  ~8,   8,  ~7,   7,   0,  ~6,  ~6,   8,  ~9,  ~4,   5,  ~3,  ~1,   7,  ~5,  ~6,  ~1,   8,   6,  ~2,   1,  ~1,   5,  ~9,   1,  ~1,  ~7,  ~6,  ~6,  ~6,  ~4,   6,   3,  ~5,  ~5,  ~6,   2,   3,  ~6,  ~8,  ~3,   8,  ~2,  ~5,  ~4,  ~3,   1,   4,  ~4],
+             [ 4,  ~6,   2,   6,   2,  ~8,   8,   5,   8,  ~2,   0,  ~6,  ~1,  ~6,  ~2,   2,   6,  ~9,  ~7,  ~6,  ~4,  ~4,  ~7,  ~2,   8,   6,   3,  ~7,  ~6,   8,   2,   3,   4,   5,   3,   4,  ~6,   8,   8,  ~1,   4,  ~5,   6,   2,   8,  ~3,  ~9,  ~2,   6,   7],
+             [ 3,  ~4,   0,  ~3,  ~5,   0,  ~2,  ~6,  ~2,   8,   5,  ~9,  ~4,  ~8,  ~6,   0,   8,   9,   1,  ~2,   8,   2,  ~2,   8,   9,   3,   3,   5,  ~9,  ~3,  ~2,   7,   2,   9,   0,   4,   8,  ~9,   0,  ~6,   9,  ~9,   9,  ~4,   8,  ~8,  ~8,   2,  ~3,   2],
+             [~1,   3,  ~9,  ~8,  ~7,   6,  ~6,   3,   0,   5,  ~5,   1,   2,  ~2,  ~3,   7,   7,   3,  ~4,  ~2,  ~9,  ~5,  ~1,   9,   6,   8,   2,   8,   7,  ~3,   4,   6,   6,   0,  ~2,   2,  ~7,  ~7,   6,  ~3,   8,   2,   1,   0,   8,  ~1,   3,   9,   8,   6],
+             [ 1,  ~2,  ~3,   6,   5,   5,  ~6,  ~4,  ~5,   1,   1,   6,  ~7,  ~4,  ~3,   4,   4,  ~8,  ~9,   7,  ~2,  ~3,  ~7,  ~2,   1,   2,   0,   8,  ~6,  ~5,  ~5,   7,   8,   5,  ~2,   3,   9,   0,   5,   1,   3,  ~4,  ~6,   1,   4,  ~9,  ~2,   5,   4,   3],
+             [ 3,   3,   9,  ~2,   6,   9,   4,   9,   4,  ~8,   5,  ~1,   3,  ~2,   1,  ~7,  ~3,   2,   2,   0,  ~3,   3,   8,   2,   0,  ~5,   7,   1,   4,  ~8,   8,  ~9,  ~1,   1,  ~9,  ~4,   5,   2,   2,   8,   6,   1,   6,  ~2,   2,   7,   1,  ~6,  ~1,  ~1],
+             [ 4,  ~2,   4,  ~1,  ~5,  ~1,   5,  ~2,   3,  ~4,  ~5,   0,   2,  ~4,   6,   4,  ~3,   2,   2,   5,  ~6,  ~7,  ~9,  ~1,  ~9,  ~9,   6,   0,   6,   5,   9,  ~1,   3,  ~3,  ~8,   8,  ~8,   8,   4,   5,  ~1,  ~5,   1,   0,   3,  ~2,   5,   6,   6,   5],
+             [~4,   9,   6,   8,  ~9,   5,   5,  ~3,  ~7,   7,   6,   8,  ~8,   0,   4,  ~1,   9,   5,  ~7,   0,  ~1,  ~2,   3,   6,   0,   4,  ~3,   1,   4,   6,   4,   0,   5,  ~1,   7,  ~7,  ~6,  ~8,  ~3,  ~6,   7,  ~1,  ~3,  ~2,  ~3,  ~5,   3,   1,  ~8,  ~9],
+             [~6,   4,  ~5,   9,   9,  ~7,  ~1,  ~8,  ~4,   2,  ~6,   0,  ~6,  ~6,   7,   6,   0,   1,   7,  ~7,   0,  ~4,  ~6,  ~8,  ~9,   5,  ~6,  ~9,   2,  ~7,  ~2,  ~6,   9,   4,  ~5,   0,   4,  ~4,  ~5,   6,   9,   1,  ~6,  ~5,   3,  ~1,   7,  ~7,  ~6,   7],
+             [~8,   7,   7,  ~6,   7,  ~4,   8,   0,  ~9,  ~8,  ~3,   7,  ~3,   3,   8,  ~7,  ~2,  ~7,   5,   5,  ~5,   4,   6,   2,   4,   1,   4,  ~9,  ~3,   8,   8,  ~9,  ~4,  ~2,   1,  ~3,   1,   3,   9,  ~5,  ~8,  ~2,   7,   8,   9,   2,   0,   1,  ~9,   6],
+             [~7,   1,  ~9,   5,  ~5,  ~5,   7,   6,  ~5,  ~9,  ~6,  ~8,  ~6,   9,   7,   9,   0,  ~5,   7,   7,  ~6,   4,   5,  ~9,  ~1,  ~2,  ~7,   3,  ~5,  ~2,  ~5,   5,  ~3,  ~4,  ~2,  ~8,   2,  ~8,   0,  ~8,   0,  ~8,   9,   8,  ~5,  ~5,   1,   3,   5,  ~4],
+             [~8,  ~8,   0,  ~5,  ~8,  ~6,   3,  ~6,  ~4,   6,   1,  ~5,  ~6,  ~8,  ~4,  ~6,  ~2,  ~6,   6,  ~4,   8,   8,   4,  ~5,  ~1,   0,   9,  ~8,  ~3,  ~1,  ~8,   7,  ~3,   0,  ~7,   1,  ~7,  ~1,  ~7,   3,  ~7,   3,  ~4,  ~8,   8,  ~7,  ~9,  ~8,   3,   2],
+             [ 3,   6,   8,  ~9,   7,   1,  ~9,   9,   3,   8,   6,   4,  ~2,   1,  ~8,   4,  ~7,  ~4,  ~3,   3,  ~5,  ~6,  ~7,  ~2,   0,  ~4,   5,   2,   5,   6,   3,  ~8,   2,  ~5,  ~7,   6,   8,  ~2,  ~5,  ~4,   9,   9,   2,  ~2,  ~2,   7,   4,   4,  ~2,   3],
+             [ 6,   6,  ~5,  ~2,  ~8,  ~2,  ~9,   0,   2,   4,  ~6,  ~9,   9,   0,  ~8,  ~3,  ~1,  ~2,  ~1,   6,   8,   2,  ~9,   5,  ~2,   1,   7,  ~6,   5,   1,  ~1,   4,  ~4,  ~7,  ~6,  ~3,  ~8,   2,   2,   5,   5,  ~6,   5,   3,   3,   7,   4,   7,  ~3,  ~9],
+             [~9,   6,  ~4,   1,   3,  ~8,  ~8,  ~8,  ~1,   5,   1,   1,  ~1,   6,   5,   1,  ~1,   5,  ~8,   8,  ~7,  ~5,  ~1,  ~1,   6,  ~8,  ~3,  ~1,  ~2,  ~6,  ~5,  ~5,  ~6,   0,   2,   2,   7,  ~1,  ~5,  ~7,  ~1,  ~3,   7,   6,   0,   2,   4,  ~5,   0,  ~4]]
 
 fun f (x, y) = List.nth (List.nth (table, x), y)
 fun show m = print (Matrix.toString (m, IntInf.toString))

Modified: mlton/branches/on-20050420-cmm-branch/regression/socket.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/socket.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/socket.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -17,34 +17,34 @@
 
 val _ =
    print (case Socket.acceptNB socket of
-	     NONE => "OK\n"
-	   | SOME _ => "WRONG\n")
+             NONE => "OK\n"
+           | SOME _ => "WRONG\n")
 
 val _ =
    case Posix.Process.fork () of
       NONE =>
-	 let
-	    val _ = Posix.Process.sleep (Time.fromSeconds 1)
-	    val (socket, _) = Socket.accept socket
-	    val _ = print (read socket)
-	    val _ = print (case readNB socket of
-			      NONE => "NONE\n"
-			    | SOME s => s)
-	    val _ = write (socket, "goodbye, world\n");
-	    val _ = Socket.close socket
-	 in
-	    ()
-	 end
+         let
+            val _ = Posix.Process.sleep (Time.fromSeconds 1)
+            val (socket, _) = Socket.accept socket
+            val _ = print (read socket)
+            val _ = print (case readNB socket of
+                              NONE => "NONE\n"
+                            | SOME s => s)
+            val _ = write (socket, "goodbye, world\n");
+            val _ = Socket.close socket
+         in
+            ()
+         end
     | SOME pid => 
-	 let
-	    val socket' = INetSock.TCP.socket ()
-	    val _ = Socket.connect (socket', addr)
-	    val _ = write (socket', "hello, world\n")
-	    val _ = print (read socket')
-	    val _ = Socket.close socket'
-	    val (pid', status)  = Posix.Process.wait ()
-	 in
-	    if pid = pid' andalso status = Posix.Process.W_EXITED
-	       then ()
-	    else print "child failed\n"
-	 end
+         let
+            val socket' = INetSock.TCP.socket ()
+            val _ = Socket.connect (socket', addr)
+            val _ = write (socket', "hello, world\n")
+            val _ = print (read socket')
+            val _ = Socket.close socket'
+            val (pid', status)  = Posix.Process.wait ()
+         in
+            if pid = pid' andalso status = Posix.Process.W_EXITED
+               then ()
+            else print "child failed\n"
+         end

Modified: mlton/branches/on-20050420-cmm-branch/regression/string.fromString.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/string.fromString.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/string.fromString.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -2,9 +2,9 @@
    case String.fromString s of
       NONE => print "WRONG  NONE\n"
     | SOME s'' =>
-	 if s' = s''
-	    then print (concat ["OK  [", s', "]\n"])
-	 else print (concat ["WRONG  [", s', "] [", s'', "]\n"])
+         if s' = s''
+            then print (concat ["OK  [", s', "]\n"])
+         else print (concat ["WRONG  [", s', "] [", s'', "]\n"])
 
 val _ =
    List.app check

Modified: mlton/branches/on-20050420-cmm-branch/regression/string.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/string.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/string.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -8,7 +8,7 @@
 fun range (from, to) p = 
     let open Int 
     in
-	(from > to) orelse (p from) andalso (range (from+1, to) p)
+        (from > to) orelse (p from) andalso (range (from+1, to) p)
     end;
 
 fun checkrange bounds = check o range bounds;
@@ -34,8 +34,8 @@
     open Char String
     val map = map'
 
-    val s1 = ""				(* size s1 =  0 *)
-    and s2 = "ABCDE\tFGHI";		(* size s2 = 10 *)
+    val s1 = ""                         (* size s1 =  0 *)
+    and s2 = "ABCDE\tFGHI";             (* size s2 = 10 *)
     val ABCDE = List.map chr [65,66,67,68,69];  
 in
 
@@ -47,9 +47,9 @@
 
 val test6 = 
     tst' "test6" (fn _ => 
-		  "" = concat [] andalso "" = concat [s1] 
-		  andalso s2 = concat [s2] andalso s2^s2 = concat [s2,s2]
-		  andalso "ABCD" = concat ["A","B","C","D"]);
+                  "" = concat [] andalso "" = concat [s1] 
+                  andalso s2 = concat [s2] andalso s2^s2 = concat [s2,s2]
+                  andalso "ABCD" = concat ["A","B","C","D"]);
     
 val test7 = tst' "test7" (fn _ => "A" = str(chr 65));
 
@@ -61,133 +61,133 @@
 
 val test10 = 
     tst' "test10" (fn _ => 
-		   s1 < s2 andalso s1 <= s1 
-		   andalso s2 > s1 andalso s2 >=s2);
+                   s1 < s2 andalso s1 <= s1 
+                   andalso s2 > s1 andalso s2 >=s2);
 
 val test11a = 
     tst' "test11a" (fn _ => 
-		    s2 = extract(s2, 0, SOME (size s2))
-		    andalso s2 = extract(s2, 0, NONE)
-		    andalso "" = extract(s2, size s2, SOME 0)
-		    andalso "" = extract(s2, size s2, NONE)
-		    andalso "" = extract(s1, 0, SOME 0)
-		    andalso "" = extract(s1, 0, NONE));
+                    s2 = extract(s2, 0, SOME (size s2))
+                    andalso s2 = extract(s2, 0, NONE)
+                    andalso "" = extract(s2, size s2, SOME 0)
+                    andalso "" = extract(s2, size s2, NONE)
+                    andalso "" = extract(s1, 0, SOME 0)
+                    andalso "" = extract(s1, 0, NONE));
 
 val test11b = tst0 "test11b" ((extract(s2, ~1, SOME 0) seq "WRONG") 
-			      handle Subscript => "OK" | _ => "WRONG");
+                              handle Subscript => "OK" | _ => "WRONG");
 val test11c = tst0 "test11c" ((extract(s2, 11, SOME 0) seq "WRONG") 
-			      handle Subscript => "OK" | _ => "WRONG");
+                              handle Subscript => "OK" | _ => "WRONG");
 val test11d = tst0 "test11d" ((extract(s2, 0, SOME 11) seq "WRONG") 
-			      handle Subscript => "OK" | _ => "WRONG");
+                              handle Subscript => "OK" | _ => "WRONG");
 val test11e = tst0 "test11e" ((extract(s2, 10, SOME 1) seq "WRONG") 
-			      handle Subscript => "OK" | _ => "WRONG");
+                              handle Subscript => "OK" | _ => "WRONG");
 val test11f = tst0 "test11f" ((extract(s2, ~1, NONE) seq "WRONG") 
-			      handle Subscript => "OK" | _ => "WRONG");
+                              handle Subscript => "OK" | _ => "WRONG");
 val test11g = tst0 "test11g" ((extract(s2, 11, NONE) seq "WRONG") 
-			      handle Subscript => "OK" | _ => "WRONG");
+                              handle Subscript => "OK" | _ => "WRONG");
 
 val test11h = 
     tst' "test11h" (fn _ => 
-		    "ABCDE" = extract(s2, 0, SOME 5)
-		    andalso "FGHI" = extract(s2, 6, SOME 4)
-		    andalso "FGHI" = extract(s2, 6, NONE));
+                    "ABCDE" = extract(s2, 0, SOME 5)
+                    andalso "FGHI" = extract(s2, 6, SOME 4)
+                    andalso "FGHI" = extract(s2, 6, NONE));
 
 val test12a = 
     tst' "test12a" (fn _ => 
-		    s2 = substring(s2, 0, size s2)
-		    andalso "" = substring(s2, size s2, 0)
-		    andalso "" = substring(s1, 0, 0));
+                    s2 = substring(s2, 0, size s2)
+                    andalso "" = substring(s2, size s2, 0)
+                    andalso "" = substring(s1, 0, 0));
 
 val test12b = tst0 "test12b" ((substring(s2, ~1, 0) seq "WRONG") 
-			      handle Subscript => "OK" | _ => "WRONG");
+                              handle Subscript => "OK" | _ => "WRONG");
 val test12c = tst0 "test12c" ((substring(s2, 11, 0) seq "WRONG") 
-			      handle Subscript => "OK" | _ => "WRONG");
+                              handle Subscript => "OK" | _ => "WRONG");
 val test12d = tst0 "test12d" ((substring(s2, 0, 11) seq "WRONG") 
-			      handle Subscript => "OK" | _ => "WRONG");
+                              handle Subscript => "OK" | _ => "WRONG");
 val test12e = tst0 "test12e" ((substring(s2, 10, 1) seq "WRONG") 
-			      handle Subscript => "OK" | _ => "WRONG");
+                              handle Subscript => "OK" | _ => "WRONG");
 val test12f = 
     tst' "test12f" (fn _ => 
-		    "ABCDE" = substring(s2, 0, 5)
-		    andalso "FGHI" = substring(s2, 6, 4));
+                    "ABCDE" = substring(s2, 0, 5)
+                    andalso "FGHI" = substring(s2, 6, 4));
 val test12g = 
   tst0 "test12g" (case (Int.minInt, Int.maxInt) of
-		    (SOME min, SOME max) => 
-		      ((substring("", max, max); substring("", min, min); "WRONG")
-		       handle Subscript => "OK" | _ => "WRONG")
-		  | _ => "OK");
+                    (SOME min, SOME max) => 
+                      ((substring("", max, max); substring("", min, min); "WRONG")
+                       handle Subscript => "OK" | _ => "WRONG")
+                  | _ => "OK");
 
 val test13a = 
   tst' "test13a" (fn _ => 
-		  (translate (fn _ => "") s2 = ""
-		   andalso translate (fn x => str x) "" = ""
-		   andalso translate (fn x => str x) s2 = s2));
+                  (translate (fn _ => "") s2 = ""
+                   andalso translate (fn x => str x) "" = ""
+                   andalso translate (fn x => str x) s2 = s2));
 
 val test13b = 
     tst' "test13b" (fn _ => 
-		    (translate (fn c => if c = #"\t" then "XYZ " else str c) s2 
-		     = "ABCDEXYZ FGHI"));
+                    (translate (fn c => if c = #"\t" then "XYZ " else str c) s2 
+                     = "ABCDEXYZ FGHI"));
 
 val test14 = 
     tst' "test14" (fn _ => 
-		   (tokens isSpace "" = []
-		    andalso tokens isSpace "   \t \n" = []
-		    andalso tokens (fn c => c = #",") ",asd,,def,fgh" 
-	            = ["asd","def","fgh"]));
+                   (tokens isSpace "" = []
+                    andalso tokens isSpace "   \t \n" = []
+                    andalso tokens (fn c => c = #",") ",asd,,def,fgh" 
+                    = ["asd","def","fgh"]));
 
 val test15 = 
     tst' "test15" (fn _ => 
-		   (fields isSpace "" = [""]
-		    andalso fields isSpace "   \t \n" = ["","","","","","",""]
-		    andalso fields (fn c => c = #",") ",asd,,def,fgh" 
-	            = ["","asd","","def","fgh"]));
+                   (fields isSpace "" = [""]
+                    andalso fields isSpace "   \t \n" = ["","","","","","",""]
+                    andalso fields (fn c => c = #",") ",asd,,def,fgh" 
+                    = ["","asd","","def","fgh"]));
 
 val test16a = 
   tst' "test16a" (fn _ => 
-		  EQUAL = compare(s1,s1) andalso EQUAL = compare(s2,s2)
-		  andalso LESS = compare("A", "B")
-		  andalso GREATER = compare("B", "A")
-		  andalso LESS = compare("ABCD", "ABCDE")
-		  andalso GREATER = compare("ABCDE", "ABCD"));
+                  EQUAL = compare(s1,s1) andalso EQUAL = compare(s2,s2)
+                  andalso LESS = compare("A", "B")
+                  andalso GREATER = compare("B", "A")
+                  andalso LESS = compare("ABCD", "ABCDE")
+                  andalso GREATER = compare("ABCDE", "ABCD"));
 
 val test16b = 
     tst' "test16b" (fn _ => 
-		    EQUAL = compare(s1,s1) andalso EQUAL = compare(s2,s2)
-		    andalso LESS = compare("A", "a")
-		    andalso GREATER = compare("b", "B")
-		    andalso LESS = compare("abcd", "abcde")
-		    andalso GREATER = compare("abcde", "abcd"));
+                    EQUAL = compare(s1,s1) andalso EQUAL = compare(s2,s2)
+                    andalso LESS = compare("A", "a")
+                    andalso GREATER = compare("b", "B")
+                    andalso LESS = compare("abcd", "abcde")
+                    andalso GREATER = compare("abcde", "abcd"));
 
 
 (* Test cases for SML string escape functions. *)
 
 val test17 = 
     let fun chk (arg, res) = toString (str arg) = res
-	val argResList =
+        val argResList =
 [(#"\000", "\\^@"),
-	       (#"\001", "\\^A"),
-	       (#"\006", "\\^F"),
-	       (#"\007", "\\a"),
-	       (#"\008", "\\b"),
-	       (#"\009", "\\t"),
-	       (#"\010", "\\n"),
-	       (#"\011", "\\v"),
-	       (#"\012", "\\f"),
-	       (#"\013", "\\r"),
-	       (#"\014", "\\^N"),
-	       (#"\031", "\\^_"),
-	       (#"\032", " "),
-	       (#"\126", "~"),
-	       (#"\\", "\\\\"),
-	       (#"\"", "\\\""),
-	       (#"A", "A"),
-	       (#"\127", "\\127"),
-	       (#"\128", "\\128"),
-	       (#"\255", "\\255")]
-	val (arg, res) = (implode (map #1 argResList), 
-			  concat (map #2 argResList))
+               (#"\001", "\\^A"),
+               (#"\006", "\\^F"),
+               (#"\007", "\\a"),
+               (#"\008", "\\b"),
+               (#"\009", "\\t"),
+               (#"\010", "\\n"),
+               (#"\011", "\\v"),
+               (#"\012", "\\f"),
+               (#"\013", "\\r"),
+               (#"\014", "\\^N"),
+               (#"\031", "\\^_"),
+               (#"\032", " "),
+               (#"\126", "~"),
+               (#"\\", "\\\\"),
+               (#"\"", "\\\""),
+               (#"A", "A"),
+               (#"\127", "\\127"),
+               (#"\128", "\\128"),
+               (#"\255", "\\255")]
+        val (arg, res) = (implode (map #1 argResList), 
+                          concat (map #2 argResList))
     in tst' "test17" (fn _ => List.all chk argResList
-	              andalso toString arg = res)
+                      andalso toString arg = res)
     end;
 
 val test18 = 
@@ -196,72 +196,72 @@
         val chars = implode l
     in tst' "test18" (fn _ => fromString(toString chars) = SOME chars) end
 
-val test19 =   		     
+val test19 =                 
     let fun chkFromString (arg, res) = fromString arg = SOME (str res)
-	val argResList = 
-	    [("A", #"A"),
-	     ("z", #"z"),
-	     ("@", #"@"),
-	     ("~", #"~"),
-	     ("\\a", #"\007"),
-	     ("\\b", #"\008"),
-	     ("\\t", #"\009"),
-	     ("\\n", #"\010"),
-	     ("\\v", #"\011"),
-	     ("\\f", #"\012"),
-	     ("\\r", #"\013"),
-	     ("\\\\", #"\\"),
-	     ("\\\"", #"\""),
-	     ("\\^@", #"\000"),
-	     ("\\^A", #"\001"),
-	     ("\\^Z", #"\026"),
-	     ("\\^_", #"\031"), 
-	     ("\\000", #"\000"),
-	     ("\\097", #"a"),
-	     ("\\255", #"\255"),
-	     ("\\   \t\n\n \\A", #"A"),
-	     ("\\   \t\n\n \\z", #"z"),
-	     ("\\   \t\n\n \\@", #"@"),
-	     ("\\   \t\n\n \\~", #"~"),
-	     ("\\   \t\n\n \\\\n", #"\n"),
-	     ("\\   \t\n\n \\\\t", #"\t"),
-	     ("\\   \t\n\n \\\\\\", #"\\"),
-	     ("\\   \t\n\n \\\\\"", #"\""),
-	     ("\\   \t\n\n \\\\^@", #"\000"),
-	     ("\\   \t\n\n \\\\^A", #"\001"),
-	     ("\\   \t\n\n \\\\^Z", #"\026"),
-	     ("\\   \t\n\n \\\\^_", #"\031"), 
-	     ("\\   \t\n\n \\\\000", #"\000"),
-	     ("\\   \t\n\n \\\\097", #"a"),
-	     ("\\   \t\n\n \\\\255", #"\255")]
-	val (arg, res) = (concat (map #1 argResList), 
-			  implode (map #2 argResList))
+        val argResList = 
+            [("A", #"A"),
+             ("z", #"z"),
+             ("@", #"@"),
+             ("~", #"~"),
+             ("\\a", #"\007"),
+             ("\\b", #"\008"),
+             ("\\t", #"\009"),
+             ("\\n", #"\010"),
+             ("\\v", #"\011"),
+             ("\\f", #"\012"),
+             ("\\r", #"\013"),
+             ("\\\\", #"\\"),
+             ("\\\"", #"\""),
+             ("\\^@", #"\000"),
+             ("\\^A", #"\001"),
+             ("\\^Z", #"\026"),
+             ("\\^_", #"\031"), 
+             ("\\000", #"\000"),
+             ("\\097", #"a"),
+             ("\\255", #"\255"),
+             ("\\   \t\n\n \\A", #"A"),
+             ("\\   \t\n\n \\z", #"z"),
+             ("\\   \t\n\n \\@", #"@"),
+             ("\\   \t\n\n \\~", #"~"),
+             ("\\   \t\n\n \\\\n", #"\n"),
+             ("\\   \t\n\n \\\\t", #"\t"),
+             ("\\   \t\n\n \\\\\\", #"\\"),
+             ("\\   \t\n\n \\\\\"", #"\""),
+             ("\\   \t\n\n \\\\^@", #"\000"),
+             ("\\   \t\n\n \\\\^A", #"\001"),
+             ("\\   \t\n\n \\\\^Z", #"\026"),
+             ("\\   \t\n\n \\\\^_", #"\031"), 
+             ("\\   \t\n\n \\\\000", #"\000"),
+             ("\\   \t\n\n \\\\097", #"a"),
+             ("\\   \t\n\n \\\\255", #"\255")]
+        val (arg, res) = (concat (map #1 argResList), 
+                          implode (map #2 argResList))
     in 
-	tst' "test19" (fn _ => List.all chkFromString argResList 
-	               andalso fromString arg = SOME res)
+        tst' "test19" (fn _ => List.all chkFromString argResList 
+                       andalso fromString arg = SOME res)
     end;
 
 val test20 = 
     tst' "test20" (fn _ => List.all (fn arg => isSome (fromString arg))
-	   ["\\",
-	    "\\c",
-	    "\\F",
-	    "\\e",
-	    "\\g",
-	    "\\N",
-	    "\\T",
-	    "\\1",
-	    "\\11",
-	    "\\256",
-	    "\\-65",
-	    "\\~65",
-	    "\\?",
-	    "\\^`",
-	    "\\^a",
-	    "\\^z",
-	    "\\   a",
-	    "\\   a\\B",
-	    "\\   \\"]);
+           ["\\",
+            "\\c",
+            "\\F",
+            "\\e",
+            "\\g",
+            "\\N",
+            "\\T",
+            "\\1",
+            "\\11",
+            "\\256",
+            "\\-65",
+            "\\~65",
+            "\\?",
+            "\\^`",
+            "\\^a",
+            "\\^z",
+            "\\   a",
+            "\\   a\\B",
+            "\\   \\"]);
 
 
 (* Test cases for C string escape functions *)
@@ -275,100 +275,100 @@
 
 val test22 = 
     let val argResList = 
-	    [("\010", "\\n"),
-	     ("\009", "\\t"),
-	     ("\011", "\\v"),
-	     ("\008", "\\b"),
-	     ("\013", "\\r"),
-	     ("\012", "\\f"),
-	     ("\007", "\\a"),
-	     ("\\", "\\\\"),
-	     ("?", "\\?"),
-	     ("'", "\\'"),
-	     ("\"", "\\\"")]
-	val (arg, res) = (concat (map #1 argResList), 
-			  concat (map #2 argResList))
+            [("\010", "\\n"),
+             ("\009", "\\t"),
+             ("\011", "\\v"),
+             ("\008", "\\b"),
+             ("\013", "\\r"),
+             ("\012", "\\f"),
+             ("\007", "\\a"),
+             ("\\", "\\\\"),
+             ("?", "\\?"),
+             ("'", "\\'"),
+             ("\"", "\\\"")]
+        val (arg, res) = (concat (map #1 argResList), 
+                          concat (map #2 argResList))
     in
-	tst' "test22" (fn _ => 
-		       List.all (fn (arg, res) => toCString arg = res) argResList
-		       andalso toCString arg = res)
+        tst' "test22" (fn _ => 
+                       List.all (fn (arg, res) => toCString arg = res) argResList
+                       andalso toCString arg = res)
     end;
 
 val test23 = 
     let fun checkFromCStringSucc (arg, res) = fromCString arg = SOME res
-	val argResList = 
-	    [("\\n", "\010"),
-	     ("\\t", "\009"),
-	     ("\\v", "\011"),
-	     ("\\b", "\008"),
-	     ("\\r", "\013"),
-	     ("\\f", "\012"),
-	     ("\\a", "\007"),
-	     ("\\\\",  "\\"),
-	     ("\\?", "?"),
-	     ("\\'", "'"),
-	     ("\\\"", "\""),
-	     ("\\1", "\001"),
-	     ("\\11", "\009"),
-	     ("\\111", "\073"),
-	     ("\\1007", "\0647"),
-	     ("\\100A", "\064A"),
-	     ("\\0",   "\000"),
-	     ("\\377", "\255"),
-	     ("\\18", "\0018"),
-	     ("\\178", "\0158"),
-	     ("\\1C", "\001C"),
-	     ("\\17C", "\015C"),
-	     ("\\x0", "\000"),
-	     ("\\xff", "\255"),
-	     ("\\xFF", "\255"),
-	     ("\\x1", "\001"),
-	     ("\\x11", "\017"),
-	     ("\\xag", "\010g"),
-	     ("\\xAAg", "\170g"),
-	     ("\\x0000000a", "\010"),
-	     ("\\x0000000a2", "\162"),
-	     ("\\x0000000ag", "\010g"),
-	     ("\\x0000000A", "\010"),
-	     ("\\x0000000A2", "\162"),
-	     ("\\x0000000Ag", "\010g"),
-	     ("\\x00000000000000000000000000000000000000000000000000000000000000011+",
-	      "\017+")]
-	val (arg, res) = (concat (map #1 argResList), 
-			  concat (map #2 argResList))
+        val argResList = 
+            [("\\n", "\010"),
+             ("\\t", "\009"),
+             ("\\v", "\011"),
+             ("\\b", "\008"),
+             ("\\r", "\013"),
+             ("\\f", "\012"),
+             ("\\a", "\007"),
+             ("\\\\",  "\\"),
+             ("\\?", "?"),
+             ("\\'", "'"),
+             ("\\\"", "\""),
+             ("\\1", "\001"),
+             ("\\11", "\009"),
+             ("\\111", "\073"),
+             ("\\1007", "\0647"),
+             ("\\100A", "\064A"),
+             ("\\0",   "\000"),
+             ("\\377", "\255"),
+             ("\\18", "\0018"),
+             ("\\178", "\0158"),
+             ("\\1C", "\001C"),
+             ("\\17C", "\015C"),
+             ("\\x0", "\000"),
+             ("\\xff", "\255"),
+             ("\\xFF", "\255"),
+             ("\\x1", "\001"),
+             ("\\x11", "\017"),
+             ("\\xag", "\010g"),
+             ("\\xAAg", "\170g"),
+             ("\\x0000000a", "\010"),
+             ("\\x0000000a2", "\162"),
+             ("\\x0000000ag", "\010g"),
+             ("\\x0000000A", "\010"),
+             ("\\x0000000A2", "\162"),
+             ("\\x0000000Ag", "\010g"),
+             ("\\x00000000000000000000000000000000000000000000000000000000000000011+",
+              "\017+")]
+        val (arg, res) = (concat (map #1 argResList), 
+                          concat (map #2 argResList))
     in 
-	tst' "test23" (fn _ => List.all checkFromCStringSucc argResList
-	               andalso fromCString arg = SOME res)
+        tst' "test23" (fn _ => List.all checkFromCStringSucc argResList
+                       andalso fromCString arg = SOME res)
     end;
 
 val test24 = 
     let fun checkFromCStringFail arg = isSome (fromCString arg)
     in
-	tst' "test24" (fn _ => List.all checkFromCStringFail 
-	       ["\\",
-		"\\X",
-		"\\=",
-		"\\400",
-		"\\777",
-		"\\8",
-		"\\9",
-		"\\c",
-		"\\d",
-		"\\x",
-		"\\x100",
-		"\\xG"])
+        tst' "test24" (fn _ => List.all checkFromCStringFail 
+               ["\\",
+                "\\X",
+                "\\=",
+                "\\400",
+                "\\777",
+                "\\8",
+                "\\9",
+                "\\c",
+                "\\d",
+                "\\x",
+                "\\x100",
+                "\\xG"])
     end;
 
 val test25 = 
     tst' "test25" (fn _ => 
-		   isPrefix "" ""
-		   andalso isPrefix ""  "abcde"
-		   andalso isPrefix "a"  "abcde"
-		   andalso isPrefix "abcd"  "abcde"
-		   andalso isPrefix "abcde"  "abcde"
-		   andalso not (isPrefix "abcde"  "")
-		   andalso not (isPrefix "abcdef"  "abcde")
-		   andalso not (isPrefix "Abcde"  "abcde")
-		   andalso not (isPrefix "abcdE"  "abcde"))
+                   isPrefix "" ""
+                   andalso isPrefix ""  "abcde"
+                   andalso isPrefix "a"  "abcde"
+                   andalso isPrefix "abcd"  "abcde"
+                   andalso isPrefix "abcde"  "abcde"
+                   andalso not (isPrefix "abcde"  "")
+                   andalso not (isPrefix "abcdef"  "abcde")
+                   andalso not (isPrefix "Abcde"  "abcde")
+                   andalso not (isPrefix "abcdE"  "abcde"))
 
 end

Modified: mlton/branches/on-20050420-cmm-branch/regression/string2.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/string2.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/string2.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,3 @@
 val _ = print(concat[Char.toCString #"\000",
-		     String.toCString "\000",
-		     "\n"])
+                     String.toCString "\000",
+                     "\n"])

Modified: mlton/branches/on-20050420-cmm-branch/regression/stringcvt.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/stringcvt.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/stringcvt.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -8,7 +8,7 @@
 fun range (from, to) p = 
     let open Int 
     in
-	(from > to) orelse (p from) andalso (range (from+1, to) p)
+        (from > to) orelse (p from) andalso (range (from+1, to) p)
     end;
 
 fun checkrange bounds = check o range bounds;
@@ -34,69 +34,69 @@
      * integer, and return the excess characters: *)
 
     fun triple getc src =
-	let open StringCvt
-	    val (str1, src1) = splitl Char.isUpper getc src
-	    val src2         = dropl Char.isLower getc src1
-	in case Int.scan DEC getc src2 of
-	    NONE            => NONE
-	  | SOME (i, src3)  => 
-		let val str2 = takel (fn _ => true) getc src3
-		in SOME((str1, i, str2), src3) end
-	end
+        let open StringCvt
+            val (str1, src1) = splitl Char.isUpper getc src
+            val src2         = dropl Char.isLower getc src1
+        in case Int.scan DEC getc src2 of
+            NONE            => NONE
+          | SOME (i, src3)  => 
+                let val str2 = takel (fn _ => true) getc src3
+                in SOME((str1, i, str2), src3) end
+        end
 
     (* Testing TextIO.scanStream: *)
 
     val tmpfile = "textio.tmp";
     fun putandscan scan s = 
-	let open TextIO 
-	    val os = openOut tmpfile
-	    val _  = output(os, s)
-	    val _  = closeOut os 
-	    val is = openIn tmpfile
-	in
-	    scanStream scan is
-	    before 
-	    closeIn is
-	end;
-	    
+        let open TextIO 
+            val os = openOut tmpfile
+            val _  = output(os, s)
+            val _  = closeOut os 
+            val is = openIn tmpfile
+        in
+            scanStream scan is
+            before 
+            closeIn is
+        end;
+            
     fun testtrip (s, res) = 
-	scanString triple s = res
-	andalso putandscan triple s = res
+        scanString triple s = res
+        andalso putandscan triple s = res
 
     datatype result = Bool of bool | Int of int
 
     fun backtrack getc src = 
-	case Bool.scan getc src of
-	    SOME(b, rest) => SOME (Bool b, rest)
-	  | NONE          => 
-		case Int.scan StringCvt.DEC getc src of
-		    SOME(i, rest) => SOME(Int i, rest)
-		  | NONE   => 
-			case Int.scan StringCvt.HEX getc src of
-			    SOME(i, rest) => SOME(Int i, rest)
-			  | NONE   => NONE
+        case Bool.scan getc src of
+            SOME(b, rest) => SOME (Bool b, rest)
+          | NONE          => 
+                case Int.scan StringCvt.DEC getc src of
+                    SOME(i, rest) => SOME(Int i, rest)
+                  | NONE   => 
+                        case Int.scan StringCvt.HEX getc src of
+                            SOME(i, rest) => SOME(Int i, rest)
+                          | NONE   => NONE
 
     fun testback (s, res) =
-	scanString backtrack s = res
-	andalso putandscan backtrack s = res
+        scanString backtrack s = res
+        andalso putandscan backtrack s = res
 
 in
 
 val test1 = 
     tst' "test1" (fn _ =>
-	   padLeft #"#" 0 "abcdef" = "abcdef"
-	   andalso padLeft #"#" 6 "abcdef" = "abcdef"
-	   andalso padLeft #"#" 7 "abcdef" = "#abcdef"
-	   andalso padLeft #"#" 10 "abcdef" = "####abcdef"
-	   andalso padLeft #"#" ~3 "abcdef" = "abcdef");
+           padLeft #"#" 0 "abcdef" = "abcdef"
+           andalso padLeft #"#" 6 "abcdef" = "abcdef"
+           andalso padLeft #"#" 7 "abcdef" = "#abcdef"
+           andalso padLeft #"#" 10 "abcdef" = "####abcdef"
+           andalso padLeft #"#" ~3 "abcdef" = "abcdef");
 
 val test2 = 
     tst' "test2" (fn _ =>
-	   padRight #"#" 0 "abcdef" = "abcdef"
-	   andalso padRight #"#" 6 "abcdef" = "abcdef"
-	   andalso padRight #"#" 7 "abcdef" = "abcdef#"
-	   andalso padRight #"#" 10 "abcdef" = "abcdef####"
-	   andalso padRight #"#" ~3 "abcdef" = "abcdef");
+           padRight #"#" 0 "abcdef" = "abcdef"
+           andalso padRight #"#" 6 "abcdef" = "abcdef"
+           andalso padRight #"#" 7 "abcdef" = "abcdef#"
+           andalso padRight #"#" 10 "abcdef" = "abcdef####"
+           andalso padRight #"#" ~3 "abcdef" = "abcdef");
 
 val test3 = 
     tst' "test3" (fn _ =>
@@ -166,30 +166,30 @@
 val test9 = 
     tst' "test9" (fn _ =>
     let fun getstring b getc src = 
-	    SOME(takel (fn _ => b) getc src, src)
-	fun dup 0 s = s
-	  | dup n s = dup (n-1) (s^s);
-	val longstring = dup 13 "abcDEFGHI"
+            SOME(takel (fn _ => b) getc src, src)
+        fun dup 0 s = s
+          | dup n s = dup (n-1) (s^s);
+        val longstring = dup 13 "abcDEFGHI"
     in 
-	scanString (getstring true) longstring = SOME longstring 
-	andalso scanString (getstring false) longstring = SOME ""
+        scanString (getstring true) longstring = SOME longstring 
+        andalso scanString (getstring false) longstring = SOME ""
         andalso putandscan (getstring true) longstring = SOME longstring
     end)
 
 val test10 = 
     tst' "test10" (fn _ => 
-	   List.all testback
-	   [("false",  SOME (Bool false)),
-	    ("true",   SOME (Bool true)),
-	    ("tru e",  NONE),
-	    ("fals e", SOME (Int 250)),
-	    ("fa",     SOME (Int 250)),
-	    ("fa00",   SOME (Int 64000)),
-	    ("21a",    SOME (Int 21)),
-	    ("a21",    SOME (Int 2593)),
-	    ("",       NONE),
-	    ("gryf",   NONE)
-	    ]);
+           List.all testback
+           [("false",  SOME (Bool false)),
+            ("true",   SOME (Bool true)),
+            ("tru e",  NONE),
+            ("fals e", SOME (Int 250)),
+            ("fa",     SOME (Int 250)),
+            ("fa00",   SOME (Int 64000)),
+            ("21a",    SOME (Int 21)),
+            ("a21",    SOME (Int 2593)),
+            ("",       NONE),
+            ("gryf",   NONE)
+            ]);
     
 (*val _ = FileSys.remove tmpfile*)
 

Modified: mlton/branches/on-20050420-cmm-branch/regression/substring.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/substring.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/substring.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -8,7 +8,7 @@
 fun range (from, to) p = 
     let open Int 
     in
-	(from > to) orelse (p from) andalso (range (from+1, to) p)
+        (from > to) orelse (p from) andalso (range (from+1, to) p)
     end;
 
 fun tst0 s s' = print (s ^ "    \t" ^ s' ^ "\n");
@@ -23,16 +23,16 @@
     val all = full
     fun base2 (a, b) = (base a, base b)
 
-    val s1 = ""				(* String.size s1 =  0 *)
-    and s2 = "ABCDE\tFGHI";		(* String.size s2 = 10 *)
-    val ss1 = all s1			(* size s1 =  0 *)
-    and ss2 = all s2;			(* size s2 = 10 *)
+    val s1 = ""                         (* String.size s1 =  0 *)
+    and s2 = "ABCDE\tFGHI";             (* String.size s2 = 10 *)
+    val ss1 = all s1                    (* size s1 =  0 *)
+    and ss2 = all s2;                   (* size s2 = 10 *)
 
-    val sa = "AAAAaAbAABBBB";		(* String.size sa = 14 *)
+    val sa = "AAAAaAbAABBBB";           (* String.size sa = 14 *)
     (*            45678      *)
 
-    val ssa1 = extract(sa, 4, SOME 0)	(* size ssa1 = 0 *)
-    val ssa2 = extract(sa, 4, SOME 5)	(* size ssa2 = 5 *)
+    val ssa1 = extract(sa, 4, SOME 0)   (* size ssa1 = 0 *)
+    val ssa2 = extract(sa, 4, SOME 5)   (* size ssa2 = 5 *)
 
     val ss3 = extract("junk this is a   (clear)textjunk", 4, SOME 24);
     (*                       456789012345678901234567        *)
@@ -42,97 +42,97 @@
 
 val test1a = tst' "test1a"
     (fn _ => 
-	   (s2, 10, 0) = base(extract(s2, 10, SOME 0))
-	   andalso (s2, 10, 0) = base(extract(s2, 10, NONE))
-	   andalso (s2, 0,  0) = base(extract(s2, 0, SOME 0))
-	   andalso (s2, 4,  3) = base(extract(s2, 4, SOME 3))
-	   andalso (s2, 4,  6) = base(extract(s2, 4, SOME 6))
-	   andalso (s2, 4,  6) = base(extract(s2, 4, NONE))
-	   andalso (s2, 0, 10) = base(extract(s2, 0, SOME 10))
-	   andalso (s2, 0, 10) = base(extract(s2, 0, NONE)));
+           (s2, 10, 0) = base(extract(s2, 10, SOME 0))
+           andalso (s2, 10, 0) = base(extract(s2, 10, NONE))
+           andalso (s2, 0,  0) = base(extract(s2, 0, SOME 0))
+           andalso (s2, 4,  3) = base(extract(s2, 4, SOME 3))
+           andalso (s2, 4,  6) = base(extract(s2, 4, SOME 6))
+           andalso (s2, 4,  6) = base(extract(s2, 4, NONE))
+           andalso (s2, 0, 10) = base(extract(s2, 0, SOME 10))
+           andalso (s2, 0, 10) = base(extract(s2, 0, NONE)));
 
 val test1b = tst0 "test1b" ((extract(s2, ~1, SOME 0) seq "WRONG") 
-			    handle Subscript => "OK" | _ => "WRONG")
+                            handle Subscript => "OK" | _ => "WRONG")
 val test1c = tst0 "test1c" ((extract(s2, 11, SOME 0) seq "WRONG") 
-			    handle Subscript => "OK" | _ => "WRONG")
+                            handle Subscript => "OK" | _ => "WRONG")
 val test1d = tst0 "test1d" ((extract(s2, 0, SOME 11) seq "WRONG") 
-			    handle Subscript => "OK" | _ => "WRONG")
+                            handle Subscript => "OK" | _ => "WRONG")
 val test1e = tst0 "test1e" ((extract(s2, 10, SOME 1) seq "WRONG") 
-			    handle Subscript => "OK" | _ => "WRONG")
+                            handle Subscript => "OK" | _ => "WRONG")
 val test1f = tst0 "test1f" ((extract(s2, ~1, NONE) seq "WRONG") 
-			    handle Subscript => "OK" | _ => "WRONG")
+                            handle Subscript => "OK" | _ => "WRONG")
 val test1g = tst0 "test1g" ((extract(s2, 11, NONE) seq "WRONG") 
-			    handle Subscript => "OK" | _ => "WRONG")
+                            handle Subscript => "OK" | _ => "WRONG")
 
 val test1h = tst' "test1h"
     (fn _ =>
-	   string ssa1 = ""
-	   andalso string ssa2 = "aAbAA"
-	   andalso s1 = string (all s1) 
-	   andalso s2 = string (all s2));
+           string ssa1 = ""
+           andalso string ssa2 = "aAbAA"
+           andalso s1 = string (all s1) 
+           andalso s2 = string (all s2));
 
 val test2a = tst' "test2a" 
     (fn _ => 
-	   string(triml 6 ss2) = "FGHI"
-	   andalso s2 = string(triml 0 ss2)
-	   andalso s1 = string(triml 0 ss1)
-	   andalso (s2, 10, 0) = base(triml 10 ss2)
-	   andalso (s2, 10, 0) = base(triml 11 ss2)
-	   andalso (sa, 6, 3) = base(triml 2 ssa2)
-	   andalso (sa, 9, 0) = base(triml 5 ssa2)
-	   andalso (sa, 9, 0) = base(triml 6 ssa2));
+           string(triml 6 ss2) = "FGHI"
+           andalso s2 = string(triml 0 ss2)
+           andalso s1 = string(triml 0 ss1)
+           andalso (s2, 10, 0) = base(triml 10 ss2)
+           andalso (s2, 10, 0) = base(triml 11 ss2)
+           andalso (sa, 6, 3) = base(triml 2 ssa2)
+           andalso (sa, 9, 0) = base(triml 5 ssa2)
+           andalso (sa, 9, 0) = base(triml 6 ssa2));
 
 val test2b = tst0 "test2b" ((triml ~1 ss2 seq "WRONG") 
-			    handle Subscript => "OK" | _ => "WRONG")
+                            handle Subscript => "OK" | _ => "WRONG")
 val test2c = tst0 "test2c" ((triml ~1 ssa2 seq "WRONG") 
-			    handle Subscript => "OK" | _ => "WRONG")
+                            handle Subscript => "OK" | _ => "WRONG")
 
 val test3a = tst' "test3a" 
     (fn _ => 
-	   string(trimr 6 ss2) = "ABCD"
-	   andalso s2 = string(trimr 0 ss2)
-	   andalso s1 = string(trimr 0 ss1)
-	   andalso (s2, 0, 0) = base(trimr 10 ss2)
-	   andalso (s2, 0, 0) = base(trimr 11 ss2)
-	   andalso (sa, 4, 3) = base(trimr 2 ssa2)
-	   andalso (sa, 4, 0) = base(trimr 5 ssa2)
-	   andalso (sa, 4, 0) = base(trimr 6 ssa2));
+           string(trimr 6 ss2) = "ABCD"
+           andalso s2 = string(trimr 0 ss2)
+           andalso s1 = string(trimr 0 ss1)
+           andalso (s2, 0, 0) = base(trimr 10 ss2)
+           andalso (s2, 0, 0) = base(trimr 11 ss2)
+           andalso (sa, 4, 3) = base(trimr 2 ssa2)
+           andalso (sa, 4, 0) = base(trimr 5 ssa2)
+           andalso (sa, 4, 0) = base(trimr 6 ssa2));
 
 val test3b = tst0 "test3b" ((trimr ~1 ss2 seq "WRONG") 
-			    handle Subscript => "OK" | _ => "WRONG")
+                            handle Subscript => "OK" | _ => "WRONG")
 val test3c = tst0 "test3c" ((trimr ~1 ssa2 seq "WRONG") 
-			    handle Subscript => "OK" | _ => "WRONG")
+                            handle Subscript => "OK" | _ => "WRONG")
 
 val test4 = tst' "test4" 
     (fn _ => 
-	   isEmpty ss1 
-	   andalso not (isEmpty ss2)
-	   andalso isEmpty ssa1
-	   andalso not (isEmpty ssa2));
+           isEmpty ss1 
+           andalso not (isEmpty ss2)
+           andalso isEmpty ssa1
+           andalso not (isEmpty ssa2));
 
 val test5a = tst' "test5a" 
     (fn _ =>
-	   case getc ssa1 of NONE => true | _ => false);
+           case getc ssa1 of NONE => true | _ => false);
 
 val test5b = tst' "test5b" 
     (fn _ =>
-	   case getc ssa2 of
-	       NONE             => false 
-	     | SOME(#"a", rest) => "AbAA" = string rest
-	     | _                => false);
+           case getc ssa2 of
+               NONE             => false 
+             | SOME(#"a", rest) => "AbAA" = string rest
+             | _                => false);
 
 val test6 = tst' "test6" 
     (fn _ =>
-	   first ssa1 = NONE
-	   andalso first ssa2 = SOME #"a")
+           first ssa1 = NONE
+           andalso first ssa2 = SOME #"a")
 
 val test7 = tst' "test7" 
     (fn _ => (size ss1 = 0 andalso size ss2 = 10
-		    andalso size ssa1 = 0 andalso size ssa2 = 5));
+                    andalso size ssa1 = 0 andalso size ssa2 = 5));
 
 val test8a = tst' "test8a" 
     (fn _ => (sub(ss2,6) = chr 70 andalso sub(ss2,9) = chr 73
-		    andalso sub(ssa2, 1) = chr 65));
+                    andalso sub(ssa2, 1) = chr 65));
 val test8b = tst0 "test8b" 
    ((sub(ss1, 0)  seq "WRONG") handle Subscript => "OK" | _ => "WRONG")
 val test8c = tst0 "test8c" 
@@ -146,154 +146,154 @@
 
 val test9a = tst' "test9a" 
     (fn _ => 
-	   base ss2 = base(slice(ss2, 0, SOME (size ss2)))
-	   andalso base ss2 = base(slice(ss2, 0, NONE))
-	   andalso (s2, 10, 0) = base(slice(ss2, size ss2, SOME 0))
-	   andalso (s2, 10, 0) = base(slice(ss2, size ss2, NONE))
-	   andalso base ss1 = base(slice(ss1, 0, SOME 0))
-	   andalso base ss1 = base(slice(ss1, 0, NONE)));
+           base ss2 = base(slice(ss2, 0, SOME (size ss2)))
+           andalso base ss2 = base(slice(ss2, 0, NONE))
+           andalso (s2, 10, 0) = base(slice(ss2, size ss2, SOME 0))
+           andalso (s2, 10, 0) = base(slice(ss2, size ss2, NONE))
+           andalso base ss1 = base(slice(ss1, 0, SOME 0))
+           andalso base ss1 = base(slice(ss1, 0, NONE)));
 
 val test9b = tst' "test9b" 
     (fn _ => 
-	           (sa, 4, 5) = base(slice(ssa2, 0, SOME 5))
-	   andalso (sa, 4, 5) = base(slice(ssa2, 0, NONE))
-	   andalso (sa, 4, 0) = base(slice(ssa2, 0, SOME 0))
-	   andalso (sa, 9, 0) = base(slice(ssa2, 5, SOME 0))
-	   andalso (sa, 9, 0) = base(slice(ssa2, 5, NONE))
-	   andalso (sa, 5, 3) = base(slice(ssa2, 1, SOME 3))
-	   andalso (sa, 5, 4) = base(slice(ssa2, 1, SOME 4))
-	   andalso (sa, 5, 4) = base(slice(ssa2, 1, NONE)));
+                   (sa, 4, 5) = base(slice(ssa2, 0, SOME 5))
+           andalso (sa, 4, 5) = base(slice(ssa2, 0, NONE))
+           andalso (sa, 4, 0) = base(slice(ssa2, 0, SOME 0))
+           andalso (sa, 9, 0) = base(slice(ssa2, 5, SOME 0))
+           andalso (sa, 9, 0) = base(slice(ssa2, 5, NONE))
+           andalso (sa, 5, 3) = base(slice(ssa2, 1, SOME 3))
+           andalso (sa, 5, 4) = base(slice(ssa2, 1, SOME 4))
+           andalso (sa, 5, 4) = base(slice(ssa2, 1, NONE)));
 
 val test9c = tst0 "test9c" ((slice(ssa2, ~1, SOME 0) seq "WRONG") 
-			    handle Subscript => "OK" | _ => "WRONG")
+                            handle Subscript => "OK" | _ => "WRONG")
 val test9d = tst0 "test9d" ((slice(ssa2, 6, SOME 0) seq "WRONG") 
-			    handle Subscript => "OK" | _ => "WRONG")
+                            handle Subscript => "OK" | _ => "WRONG")
 val test9e = tst0 "test9e" ((slice(ssa2, 0, SOME 6) seq "WRONG") 
-			    handle Subscript => "OK" | _ => "WRONG")
+                            handle Subscript => "OK" | _ => "WRONG")
 val test9f = tst0 "test9f" ((slice(ssa2, 5, SOME 1) seq "WRONG") 
-			    handle Subscript => "OK" | _ => "WRONG")
+                            handle Subscript => "OK" | _ => "WRONG")
 val test9g = tst0 "test9g" ((slice(ssa2, ~1, NONE) seq "WRONG") 
-			    handle Subscript => "OK" | _ => "WRONG")
+                            handle Subscript => "OK" | _ => "WRONG")
 val test9h = tst0 "test9h" ((slice(ssa2, 6, NONE) seq "WRONG") 
-			    handle Subscript => "OK" | _ => "WRONG")
+                            handle Subscript => "OK" | _ => "WRONG")
 
 val test12 = tst' "test12"
     (fn _ => 
-	   concat [] = ""
-	   andalso concat [ssa1, ssa1, ssa1] = ""
-	   andalso concat [ssa2, ssa2, ssa2] = "aAbAAaAbAAaAbAA"
-	   andalso concat [ssa2, ssa1, ss2, ss1] = "aAbAAABCDE\tFGHI");
+           concat [] = ""
+           andalso concat [ssa1, ssa1, ssa1] = ""
+           andalso concat [ssa2, ssa2, ssa2] = "aAbAAaAbAAaAbAA"
+           andalso concat [ssa2, ssa1, ss2, ss1] = "aAbAAABCDE\tFGHI");
 
 val test13 = tst' "test13" 
     (fn _ => 
-	   explode ss1 = []
-	   andalso explode ssa1 = []
-	   andalso explode ssa2 = [#"a", #"A", #"b", #"A", #"A"]);
+           explode ss1 = []
+           andalso explode ssa1 = []
+           andalso explode ssa2 = [#"a", #"A", #"b", #"A", #"A"]);
 
 val test14 = tst' "test14" 
     (fn _ => 
-	   EQUAL = compare(ssa1,ssa1) andalso EQUAL = compare(ssa2,ssa2)
-	   andalso LESS = compare(triml 1 ssa2, ssa2)
-	   andalso GREATER = compare(ssa2, triml 1 ssa2)
-	   andalso LESS = compare(trimr 1 ssa2, ssa2)
-	   andalso GREATER = compare(ssa2, trimr 1 ssa2)
-	   andalso LESS = compare(all "AB", ssa2)
-	   andalso GREATER = compare(ssa2, all "AB"));
+           EQUAL = compare(ssa1,ssa1) andalso EQUAL = compare(ssa2,ssa2)
+           andalso LESS = compare(triml 1 ssa2, ssa2)
+           andalso GREATER = compare(ssa2, triml 1 ssa2)
+           andalso LESS = compare(trimr 1 ssa2, ssa2)
+           andalso GREATER = compare(ssa2, trimr 1 ssa2)
+           andalso LESS = compare(all "AB", ssa2)
+           andalso GREATER = compare(ssa2, all "AB"));
 
 fun finda c = c <> #"A";
 fun findb c = c <> #"B";
 
 val test15 = tst' "test15" 
     (fn _ =>
-	   (sa, 5, 4) = base(dropl finda ssa2)
-	   andalso (sa, 9, 0) = base(dropl findb ssa2)
-	   andalso base ssa1 = base(dropl finda ssa1));
+           (sa, 5, 4) = base(dropl finda ssa2)
+           andalso (sa, 9, 0) = base(dropl findb ssa2)
+           andalso base ssa1 = base(dropl finda ssa1));
 
 val test16 = tst' "test16" 
     (fn _ =>
-	   (sa, 4, 5) = base(dropr finda ssa2)
-	   andalso (sa, 4, 0) = base(dropr findb ssa2)
-	   andalso base ssa1 = base(dropr finda ssa1));
+           (sa, 4, 5) = base(dropr finda ssa2)
+           andalso (sa, 4, 0) = base(dropr findb ssa2)
+           andalso base ssa1 = base(dropr finda ssa1));
 
 val test17 = tst' "test17" 
     (fn _ =>
-	   (sa, 4, 1) = base(takel finda ssa2)
-	   andalso (sa, 4, 5) = base(takel findb ssa2)
-	   andalso base ssa1 = base(takel finda ssa1));
+           (sa, 4, 1) = base(takel finda ssa2)
+           andalso (sa, 4, 5) = base(takel findb ssa2)
+           andalso base ssa1 = base(takel finda ssa1));
     
 val test18 = tst' "test18" 
     (fn _ =>
-	   (sa, 9, 0) = base(taker finda ssa2)
-	   andalso (sa, 4, 5) = base(taker findb ssa2)
-	   andalso base ssa1 = base(taker finda ssa1));
+           (sa, 9, 0) = base(taker finda ssa2)
+           andalso (sa, 4, 5) = base(taker findb ssa2)
+           andalso base ssa1 = base(taker finda ssa1));
 
 val test19 = tst' "test19"
     (fn _ => 
-	   ((sa, 4, 1), (sa, 5, 4)) = base2(splitl finda ssa2)
-	   andalso ((sa, 4, 5), (sa, 9, 0)) = base2(splitl findb ssa2)
-	   andalso base2(ssa1, ssa1) = base2(splitl finda ssa1));
+           ((sa, 4, 1), (sa, 5, 4)) = base2(splitl finda ssa2)
+           andalso ((sa, 4, 5), (sa, 9, 0)) = base2(splitl findb ssa2)
+           andalso base2(ssa1, ssa1) = base2(splitl finda ssa1));
 
 val test20 = tst' "test20"
     (fn _ => 
-	   ((sa, 4, 5), (sa, 9, 0)) = base2(splitr finda ssa2)
-	   andalso ((sa, 4, 0), (sa, 4, 5)) = base2(splitr findb ssa2)
-	   andalso base2(ssa1, ssa1) = base2 (splitr finda ssa1));
+           ((sa, 4, 5), (sa, 9, 0)) = base2(splitr finda ssa2)
+           andalso ((sa, 4, 0), (sa, 4, 5)) = base2(splitr findb ssa2)
+           andalso base2(ssa1, ssa1) = base2 (splitr finda ssa1));
 
 val test21 = tst' "test21" 
     (fn _ => 
-	   ((sa, 4, 0), (sa, 4, 5)) = base2(position "" ssa2)
-	   andalso ((sa, 4, 1), (sa, 5, 4)) = base2(position "Ab" ssa2)
-	   andalso ((sa, 4, 5), (sa, 9, 0)) = base2(position "B" ssa2)
-	   andalso ((sa, 4, 5), (sa, 9, 0)) = base2(position "AAB" ssa2)
-	   andalso ((sa, 4, 0), (sa, 4, 5)) = base2(position "aA" ssa2)
-	   andalso ((sa, 4, 2), (sa, 6, 3)) = base2(position "bAA" ssa2)
-	   andalso (base ssa1, base ssa1) = base2(position "A" ssa1)
-	   andalso (base ssa1, base ssa1) = base2(position "" ssa1));
+           ((sa, 4, 0), (sa, 4, 5)) = base2(position "" ssa2)
+           andalso ((sa, 4, 1), (sa, 5, 4)) = base2(position "Ab" ssa2)
+           andalso ((sa, 4, 5), (sa, 9, 0)) = base2(position "B" ssa2)
+           andalso ((sa, 4, 5), (sa, 9, 0)) = base2(position "AAB" ssa2)
+           andalso ((sa, 4, 0), (sa, 4, 5)) = base2(position "aA" ssa2)
+           andalso ((sa, 4, 2), (sa, 6, 3)) = base2(position "bAA" ssa2)
+           andalso (base ssa1, base ssa1) = base2(position "A" ssa1)
+           andalso (base ssa1, base ssa1) = base2(position "" ssa1));
 
 (* For the pre-November 1995 version of position: 
 val test21 = tst' "test21" 
     (fn _ => 
-	   (sa, 4, 5) = base(position "" ssa2)
-	   andalso (sa, 5, 4) = base(position "Ab" ssa2)
-	   andalso (sa, 9, 0) = base(position "B" ssa2)
-	   andalso (sa, 9, 0) = base(position "AAB" ssa2)
-	   andalso (sa, 4, 5) = base(position "aA" ssa2)
-	   andalso (sa, 6, 3) = base(position "bAA" ssa2)
-	   andalso base ssa1 = base(position "A" ssa1)
-	   andalso base ssa1 = base(position "" ssa1));
+           (sa, 4, 5) = base(position "" ssa2)
+           andalso (sa, 5, 4) = base(position "Ab" ssa2)
+           andalso (sa, 9, 0) = base(position "B" ssa2)
+           andalso (sa, 9, 0) = base(position "AAB" ssa2)
+           andalso (sa, 4, 5) = base(position "aA" ssa2)
+           andalso (sa, 6, 3) = base(position "bAA" ssa2)
+           andalso base ssa1 = base(position "A" ssa1)
+           andalso base ssa1 = base(position "" ssa1));
 *)
 
 val test22a = tst' "test22a" 
     (fn _ => 
-	   (translate (fn _ => "") ssa2 = ""
-	    andalso translate (fn x => str x) ssa1 = ""
-	    andalso translate (fn x => str x) ssa2 = string ssa2));
+           (translate (fn _ => "") ssa2 = ""
+            andalso translate (fn x => str x) ssa1 = ""
+            andalso translate (fn x => str x) ssa2 = string ssa2));
 
 val test22b = tst' "test22b" 
     (fn _ => 
-	   (translate (fn c => if c = #"b" then "XYZ " else str c) ssa2
-	              = "aAXYZ AA"));
+           (translate (fn c => if c = #"b" then "XYZ " else str c) ssa2
+                      = "aAXYZ AA"));
 
 val test23 = tst' "test23" 
     (fn _ => 
-	   (null(tokens isSpace ssa1)
-	    andalso null(tokens (Char.contains "Aab") ssa2)
-	    andalso map string (tokens (fn c => c = #"A") ssa2) = ["a","b"]));
+           (null(tokens isSpace ssa1)
+            andalso null(tokens (Char.contains "Aab") ssa2)
+            andalso map string (tokens (fn c => c = #"A") ssa2) = ["a","b"]));
 
 val test24 = tst' "test24" 
     (fn _ => 
-	   (map base (fields isSpace ssa1) = [base ssa1]
-	    andalso map base (fields (contains "Aab") ssa2)
-	            = [(sa,4,0),(sa,5,0),(sa,6,0),(sa,7,0),(sa,8,0),(sa,9,0)]
-	    andalso map string (fields (fn c => c = #"A") ssa2) 
-	            = ["a","b","",""]));
+           (map base (fields isSpace ssa1) = [base ssa1]
+            andalso map base (fields (contains "Aab") ssa2)
+                    = [(sa,4,0),(sa,5,0),(sa,6,0),(sa,7,0),(sa,8,0),(sa,9,0)]
+            andalso map string (fields (fn c => c = #"A") ssa2) 
+                    = ["a","b","",""]));
 
 val test25 = tst' "test25" 
     (fn _ => 
-	   null(tokens (fn _ => true) ss3)
-	   andalso null(tokens (fn _ => false) (all ""))
-	   andalso null(tokens (contains " ()") (all "(()())(( ()"))
-	   andalso ["this","is","a","clear","text"] = 
+           null(tokens (fn _ => true) ss3)
+           andalso null(tokens (fn _ => false) (all ""))
+           andalso null(tokens (contains " ()") (all "(()())(( ()"))
+           andalso ["this","is","a","clear","text"] = 
                            map string (tokens (contains " ()") ss3));
 
 local 
@@ -303,79 +303,79 @@
     
 val test26a = tst' "test26a" 
     (fn _ => 
-	   (v := 0;
-	    foldl (fn (x, _) => setv x) () ssa2;
-	    !v = 65));
+           (v := 0;
+            foldl (fn (x, _) => setv x) () ssa2;
+            !v = 65));
 
 val test26b = tst' "test26b" 
     (fn _ => 
-	   implode(foldl (op ::) [] ssa2) = "AAbAa");
+           implode(foldl (op ::) [] ssa2) = "AAbAa");
 
 val test27a = tst' "test27a" 
     (fn _ => 
-	   (v := 0;
-	   foldr (fn (x, _) => setv x) () ssa2;
-	   !v = 97));
+           (v := 0;
+           foldr (fn (x, _) => setv x) () ssa2;
+           !v = 97));
 
 val test27b = tst' "test27b" 
     (fn _ => 
-	   implode(foldr (op ::) [] ssa2) = "aAbAA");
+           implode(foldr (op ::) [] ssa2) = "aAbAA");
 
 val test28 = tst' "test28" 
     (fn _ => 
-	   (v := 0;
-	    app setv ssa2;
-	    !v = 65));
+           (v := 0;
+            app setv ssa2;
+            !v = 65));
 end
 
 val test29a = tst' "test29a" 
     (fn _ =>
-	   base2(splitAt(ssa1, 0)) = ((sa, 4, 0), (sa, 4, 0))
-	   andalso base2(splitAt(ssa2, 0)) = ((sa, 4, 0), (sa, 4, 5))
-	   andalso base2(splitAt(ssa2, 1)) = ((sa, 4, 1), (sa, 5, 4))
-	   andalso base2(splitAt(ssa2, 4)) = ((sa, 4, 4), (sa, 8, 1))
-	   andalso base2(splitAt(ssa2, 5)) = ((sa, 4, 5), (sa, 9, 0)));
+           base2(splitAt(ssa1, 0)) = ((sa, 4, 0), (sa, 4, 0))
+           andalso base2(splitAt(ssa2, 0)) = ((sa, 4, 0), (sa, 4, 5))
+           andalso base2(splitAt(ssa2, 1)) = ((sa, 4, 1), (sa, 5, 4))
+           andalso base2(splitAt(ssa2, 4)) = ((sa, 4, 4), (sa, 8, 1))
+           andalso base2(splitAt(ssa2, 5)) = ((sa, 4, 5), (sa, 9, 0)));
 val test29b = tst0 "test29b" ((splitAt(ssa2, ~1) seq "WRONG")
-			      handle Subscript => "OK" | _ => "WRONG")
+                              handle Subscript => "OK" | _ => "WRONG")
 val test29c = tst0 "test29c" ((splitAt(ssa2, 6) seq "WRONG")
-			      handle Subscript => "OK" | _ => "WRONG")
+                              handle Subscript => "OK" | _ => "WRONG")
 
 val test30a = tst' "test30a" 
     (fn _ => 
-	   (s2, 10, 0) = base(substring(s2, 10, 0))
-	   andalso (s2, 0,  0) = base(substring(s2, 0, 0))
-	   andalso (s2, 4,  3) = base(substring(s2, 4, 3))
-	   andalso (s2, 4,  6) = base(substring(s2, 4, 6))
-	   andalso (s2, 0, 10) = base(substring(s2, 0, 10)));
+           (s2, 10, 0) = base(substring(s2, 10, 0))
+           andalso (s2, 0,  0) = base(substring(s2, 0, 0))
+           andalso (s2, 4,  3) = base(substring(s2, 4, 3))
+           andalso (s2, 4,  6) = base(substring(s2, 4, 6))
+           andalso (s2, 0, 10) = base(substring(s2, 0, 10)));
 
 val test30b = tst0 "test30b" ((substring(s2, ~1, 0) seq "WRONG") 
-			      handle Subscript => "OK" | _ => "WRONG")
+                              handle Subscript => "OK" | _ => "WRONG")
 val test30c = tst0 "test30c" ((substring(s2, 11, 0) seq "WRONG") 
-			      handle Subscript => "OK" | _ => "WRONG")
+                              handle Subscript => "OK" | _ => "WRONG")
 val test30d = tst0 "test30d" ((substring(s2, 0, 11) seq "WRONG") 
-			      handle Subscript => "OK" | _ => "WRONG")
+                              handle Subscript => "OK" | _ => "WRONG")
 val test30e = tst0 "test30e" ((substring(s2, 10, 1) seq "WRONG") 
-			      handle Subscript => "OK" | _ => "WRONG")
+                              handle Subscript => "OK" | _ => "WRONG")
 val test30f = tst0 "test30f" 
    ((case (Int.minInt, Int.maxInt) of
-	(SOME min, SOME max) => 
-	    ((substring("", max, max); "WRONG")
-	     handle Subscript => 
-		 ((substring("", min, min); "WRONG")
-		  handle Subscript => "OK" | _ => "WRONG"))
+        (SOME min, SOME max) => 
+            ((substring("", max, max); "WRONG")
+             handle Subscript => 
+                 ((substring("", min, min); "WRONG")
+                  handle Subscript => "OK" | _ => "WRONG"))
        | _ => "OK")
-	    handle _ => "EXN")
+            handle _ => "EXN")
 
 (* val sa = "AAAAaAbAABBBB"; *)
 val test31 = tst' "test31" 
     (fn _ => 
-	   isPrefix "" (substring(sa, 0, 0))
-	   andalso isPrefix "" (substring(sa, 13, 0))
-	   andalso isPrefix "" ssa1
-	   andalso isPrefix "aAbAA" ssa2
-	   andalso isPrefix "aAbA" ssa2
-	   andalso not (isPrefix "aAbAAB" ssa2)
-	   andalso not (isPrefix "aAbAAB" ssa1))
+           isPrefix "" (substring(sa, 0, 0))
+           andalso isPrefix "" (substring(sa, 13, 0))
+           andalso isPrefix "" ssa1
+           andalso isPrefix "aAbAA" ssa2
+           andalso isPrefix "aAbA" ssa2
+           andalso not (isPrefix "aAbAAB" ssa2)
+           andalso not (isPrefix "aAbAAB" ssa1))
 
 fun eqspan(sus1, sus2, res) = base(span(sus1, sus2)) = base res
 
@@ -388,19 +388,19 @@
    andalso eqspan(substring(sa, 5, 4), substring(sa, 2, 4), substring(sa,5,1))
    andalso eqspan(substring(sa, 2, 5), substring(sa, 6, 3), substring(sa, 2,7))
    andalso eqspan(substring("abcd", 1, 0), substring("abcd", 1, 2), 
-		  substring("abcd", 1, 2))
+                  substring("abcd", 1, 2))
    andalso eqspan(substring("", 0, 0), substring("", 0, 0), all ""))
 
 val test32b = tst0 "test32b" ((span(substring("a", 0, 0), substring("b", 0, 0)) seq "WRONG") 
-			      handle Span => "OK" | _ => "WRONG")
+                              handle Span => "OK" | _ => "WRONG")
 
 val test32c = tst0 "test32c" ((span(substring(sa, 1, 0), substring(sa, 0, 0)) seq "WRONG") 
-			      handle Span => "OK" | _ => "WRONG")
+                              handle Span => "OK" | _ => "WRONG")
 
 val test32d = tst0 "test32d" ((span(substring(sa, 3, 2), substring("abcd", 2, 1)) seq "WRONG") 
-			      handle Span => "OK" | _ => "WRONG")
+                              handle Span => "OK" | _ => "WRONG")
 
 val test32e = tst0 "test32e" ((span(substring("a", 0, 0), substring("b", 0, 0)) seq "WRONG") 
-			      handle Span => "OK" | _ => "WRONG")
+                              handle Span => "OK" | _ => "WRONG")
 
 end; 

Modified: mlton/branches/on-20050420-cmm-branch/regression/suspend.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/suspend.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/suspend.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -3,13 +3,13 @@
 val _ =
    case fork () of
       NONE =>
-	 (setHandler (int, Handler.simple (fn () => print "child got an int\n"))
- 	  ; print "child suspending\n"
- 	  ; suspend Mask.none
-	  ; print "done\n")
+         (setHandler (int, Handler.simple (fn () => print "child got an int\n"))
+          ; print "child suspending\n"
+          ; suspend Mask.none
+          ; print "done\n")
     | SOME pid =>
-	 (sleep (Time.fromSeconds 1)
-	  ; print "parent sending int\n"
-	  ; kill (K_PROC pid, int)
-	  ; wait ()
-	  ; print "done\n")
+         (sleep (Time.fromSeconds 1)
+          ; print "parent sending int\n"
+          ; kill (K_PROC pid, int)
+          ; wait ()
+          ; print "done\n")

Modified: mlton/branches/on-20050420-cmm-branch/regression/tak.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/tak.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/tak.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -2,7 +2,7 @@
    if y >= x
       then z
    else tak(tak(x - 1, y, z),
-	    tak(y - 1, z, x),
-	    tak(z - 1, x, y))
+            tak(y - 1, z, x),
+            tak(z - 1, x, y))
 
 val _ = print(concat[Int.toString(tak(18,12,6)), "\n"])

Modified: mlton/branches/on-20050420-cmm-branch/regression/testdyn1.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/testdyn1.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/testdyn1.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -20,7 +20,7 @@
     else digits (n div 10, digit(n mod 10) :: acc)
 
   fun int_to_string(n) = if n >= 0 then implode(digits(n,[]))
-			 else "~" ^ int_to_string(~n)
+                         else "~" ^ int_to_string(~n)
 
   fun error b s = print ((if b then "Ok - " else "Error - ") ^ s ^ "...\n")
 
@@ -40,7 +40,7 @@
       val _ = print "Testing string operations:\n\
        \  [implode, explode, chr, ord, size]...\n"
       fun hds [] = #"-"
-	| hds (x::_) = x
+        | hds (x::_) = x
     in
       error (int_to_string 232 = "232") "int_to_string";
       error (implode [#"h", #"e", #"l", #"l", #" "] = "hell ") "implode";
@@ -93,15 +93,15 @@
       val _ = print "Testing arithmetic integer operations:\n\
        \  [~, abs, floor, +, -, *, div, mod, <, >, <=, >=] ...\n"
       fun checkdivmod (i, d) =
-	let
-	  val (r, q) = (i mod d, i div d)
-	  val gt_zero = fn a => a > 0
-	in
-	  error (gt_zero r = gt_zero d andalso d * q + r = i) 
-	  ("intdivmod - " ^ int_to_string i ^ " mod " ^ int_to_string d ^ 
-	   " = " ^ int_to_string r ^ ", " ^  int_to_string i ^ " div " 
-	   ^ int_to_string d ^ " = " ^ int_to_string q)  
-	end
+        let
+          val (r, q) = (i mod d, i div d)
+          val gt_zero = fn a => a > 0
+        in
+          error (gt_zero r = gt_zero d andalso d * q + r = i) 
+          ("intdivmod - " ^ int_to_string i ^ " mod " ^ int_to_string d ^ 
+           " = " ^ int_to_string r ^ ", " ^  int_to_string i ^ " div " 
+           ^ int_to_string d ^ " = " ^ int_to_string q)  
+        end
     in
       error (~ 5 = ~5) "~1";
       error (~ (~2) = 2) "~2";
@@ -176,17 +176,17 @@
     let
       val _ = print "Testing generative exceptions:\n"
       fun g a =
-	let
-	  fun f x =
-	    let
-	      exception E
-	    in
-	      if x < 1 then raise E 
-	      else ((f (x-1)) handle E => 7) (* should not handle this.. *)
-	    end
-	in
-	  (f a) handle _ => a
-	end (* a *)
+        let
+          fun f x =
+            let
+              exception E
+            in
+              if x < 1 then raise E 
+              else ((f (x-1)) handle E => 7) (* should not handle this.. *)
+            end
+        in
+          (f a) handle _ => a
+        end (* a *)
     in
       error (g 10 = 10) "exn - generative"
     end
@@ -197,6 +197,6 @@
             "backslash u does not work or somepin";
 
   val _ = etst (map ord [#"a", #"A", #" ", chr 42, #"\117"] =
-		[97, 65, 32, 42, 117]) "char problem, maybe #"
+                [97, 65, 32, 42, 117]) "char problem, maybe #"
 
   val _ = print "End of test.\n"

Modified: mlton/branches/on-20050420-cmm-branch/regression/textio.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/textio.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/textio.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -8,7 +8,7 @@
 fun range (from, to) p = 
     let open Int 
     in
-	(from > to) orelse (p from) andalso (range (from+1, to) p)
+        (from > to) orelse (p from) andalso (range (from+1, to) p)
     end;
 
 fun checkrange bounds = check o range bounds;
@@ -33,14 +33,14 @@
     open TextIO
 
     fun fileSize s = 
-	let val is = openIn s
-	in size (inputAll is) before closeIn is end;
+        let val is = openIn s
+        in size (inputAll is) before closeIn is end;
 
     fun dup 0 s = s
       | dup n s = dup (n-1) (s^s)
 
     val longstring = dup 5 "abcdefg"  (* was 16 but because `limit stack` = 8192 kbytes on frigg
-				       * I received a SIGSEGV for stack growth failure. *)
+                                       * I received a SIGSEGV for stack growth failure. *)
 in
 
 val empty  = openOut "empty.dat";
@@ -50,49 +50,49 @@
 
 val test1 = 
     tst' "test1" (fn _ => 
-	   (closeOut empty; 
-	    fileSize "empty.dat" = 0 
-	    andalso fileSize "empty.dat" = 0));
+           (closeOut empty; 
+            fileSize "empty.dat" = 0 
+            andalso fileSize "empty.dat" = 0));
     
 val test2 = 
     tst' "test2" (fn _ => 
-	   (output1(small, #"+");
-	    closeOut small;
-	    fileSize "small1.dat" = 1
-	    andalso fileSize "small1.dat" = 1));
+           (output1(small, #"+");
+            closeOut small;
+            fileSize "small1.dat" = 1
+            andalso fileSize "small1.dat" = 1));
 
 val test3 = 
     tst' "test3" (fn _ =>
-	   let val small = openOut "small2.dat"
-	   in 
-	       output(small, "*");
-	       closeOut small;
-	       fileSize "small2.dat" = 1 andalso fileSize "small2.dat" = 1
-	   end);
+           let val small = openOut "small2.dat"
+           in 
+               output(small, "*");
+               closeOut small;
+               fileSize "small2.dat" = 1 andalso fileSize "small2.dat" = 1
+           end);
 
 val test4 = 
     tst' "test4" (fn _ => 
-	   (output(medium, longstring);
-	    closeOut medium;
-	    fileSize "medium.dat" = size longstring
-	    andalso fileSize "medium.dat" = size longstring))
+           (output(medium, longstring);
+            closeOut medium;
+            fileSize "medium.dat" = size longstring
+            andalso fileSize "medium.dat" = size longstring))
 
 val test5 = 
     tst' "test5" (fn _ => 
-	   let val small = openAppend "small2.dat"
-	   in 
-	       output(small, "1");
-	       closeOut small;
-	       fileSize "small2.dat" = 2 andalso fileSize "small2.dat" = 2
-	   end);
+           let val small = openAppend "small2.dat"
+           in 
+               output(small, "1");
+               closeOut small;
+               fileSize "small2.dat" = 2 andalso fileSize "small2.dat" = 2
+           end);
 
 val test6 = 
     tst' "test6" (fn _ => 
-	   (output(text, "Line 1\n");
-	    output(text, "Line 2\n");
-	    output(text, "Line 3");
-	    closeOut text;
-	    fileSize "text.dat" = 20 andalso fileSize "text.dat" = 20));
+           (output(text, "Line 1\n");
+            output(text, "Line 2\n");
+            output(text, "Line 3");
+            closeOut text;
+            fileSize "text.dat" = 20 andalso fileSize "text.dat" = 20));
     
 (* Test that stdErr is flushed immediately, that flushOut works, and
  * that print flushes stdOut.  Assumes that stdOut is *not* flushed
@@ -100,247 +100,247 @@
 
 val _ = 
     let fun stdo s = output(stdOut, s)
-	fun stde s = output(stdErr, s)
+        fun stde s = output(stdErr, s)
     in
-	print "Two lines of output follow:\n";
-	stdo "3"; stde "1"; stdo "4"; stde "2";
-	flushOut stdOut; 
-	stde "  <--- this should read 1234\n";
-	stdo "2"; stde "1"; print "3"; stde "4"; stdo "5"; 
-	flushOut stdOut; 
-	stde " <--- this should read 12345\n"
+        print "Two lines of output follow:\n";
+        stdo "3"; stde "1"; stdo "4"; stde "2";
+        flushOut stdOut; 
+        stde "  <--- this should read 1234\n";
+        stdo "2"; stde "1"; print "3"; stde "4"; stdo "5"; 
+        flushOut stdOut; 
+        stde " <--- this should read 12345\n"
     end;
 
 val test7a = 
     tst' "test7a" (fn _ => 
-	   let val is = openIn "empty.dat"
-	   in 
-	       (endOfStream is 
-		andalso input1 is = NONE 
-		andalso endOfStream is 
-		andalso input1 is = NONE)
-	       before closeIn is 
-	   end);
+           let val is = openIn "empty.dat"
+           in 
+               (endOfStream is 
+                andalso input1 is = NONE 
+                andalso endOfStream is 
+                andalso input1 is = NONE)
+               before closeIn is 
+           end);
 
 val test7b = 
     tst' "test7b" (fn _ => 
-	   let val is = openIn "small1.dat"
-	   in 
-	       (not (endOfStream is)
-		andalso input1 is = SOME #"+" 
-		andalso endOfStream is
-		andalso input1 is = NONE 
-		andalso input1 is = NONE)
-	       before closeIn is 
-	   end);
+           let val is = openIn "small1.dat"
+           in 
+               (not (endOfStream is)
+                andalso input1 is = SOME #"+" 
+                andalso endOfStream is
+                andalso input1 is = NONE 
+                andalso input1 is = NONE)
+               before closeIn is 
+           end);
 
 val test7c = 
     tst' "test7c" (fn _ => 
-	   let val is = openIn "small2.dat"
-	   in 
-	       (not (endOfStream is)
-		andalso input1 is = SOME #"*" 
-		andalso not (endOfStream is)
-		andalso input1 is = SOME #"1" 
-		andalso endOfStream is
-		andalso input1 is = NONE 
-		andalso input1 is = NONE)
-	       before closeIn is 
-	   end);
+           let val is = openIn "small2.dat"
+           in 
+               (not (endOfStream is)
+                andalso input1 is = SOME #"*" 
+                andalso not (endOfStream is)
+                andalso input1 is = SOME #"1" 
+                andalso endOfStream is
+                andalso input1 is = NONE 
+                andalso input1 is = NONE)
+               before closeIn is 
+           end);
 
 val test8a =
     tst' "test8a" (fn _ =>
-	   let val is = openIn "empty.dat"
-	   in 
-	       (inputN(is, 0) = ""
-		andalso inputN(is, 1) = ""
-		andalso inputN(is, 100) = ""
-		andalso endOfStream is)
-	       before closeIn is 
-	   end);
+           let val is = openIn "empty.dat"
+           in 
+               (inputN(is, 0) = ""
+                andalso inputN(is, 1) = ""
+                andalso inputN(is, 100) = ""
+                andalso endOfStream is)
+               before closeIn is 
+           end);
 
 val test8b =
     tst' "test8b" (fn _ =>
-	   let val is = openIn "small1.dat"
-	   in 
-	       (inputN(is, 0) = ""
-		andalso inputN(is, 1) = "+"
-		andalso inputN(is, 100) = "")
-	       before closeIn is 
-	   end);
+           let val is = openIn "small1.dat"
+           in 
+               (inputN(is, 0) = ""
+                andalso inputN(is, 1) = "+"
+                andalso inputN(is, 100) = "")
+               before closeIn is 
+           end);
 
 val test8c =
     tst' "test8c" (fn _ =>
-	   let val is = openIn "small1.dat"
-	   in 
-	       (inputN(is, 0) = ""
-		andalso inputN(is, 100) = "+"
-		andalso inputN(is, 100) = "")
-	       before closeIn is 
-	   end);
+           let val is = openIn "small1.dat"
+           in 
+               (inputN(is, 0) = ""
+                andalso inputN(is, 100) = "+"
+                andalso inputN(is, 100) = "")
+               before closeIn is 
+           end);
 
 val test8d =
     tst' "test8d" (fn _ =>
-	   let val is = openIn "small2.dat"
-	   in 
-	       (inputN(is, 0) = ""
-		andalso inputN(is, 1) = "*"
-		andalso inputN(is, 100) = "1"
-		andalso inputN(is, 100) = "")
-	       before closeIn is 
-	   end);
+           let val is = openIn "small2.dat"
+           in 
+               (inputN(is, 0) = ""
+                andalso inputN(is, 1) = "*"
+                andalso inputN(is, 100) = "1"
+                andalso inputN(is, 100) = "")
+               before closeIn is 
+           end);
 
 val test8e =
     tst' "test8e" (fn _ =>
-	   let val is = openIn "medium.dat"
-	   in 
-	       (inputN(is, 0) = ""
-		andalso inputN(is, 15) = "abcdefgabcdefga"
-		andalso inputN(is, 15) = "bcdefgabcdefgab"
-		andalso inputN(is, 0) = ""
-		andalso not (endOfStream is))
-	       before closeIn is 
-	   end);
+           let val is = openIn "medium.dat"
+           in 
+               (inputN(is, 0) = ""
+                andalso inputN(is, 15) = "abcdefgabcdefga"
+                andalso inputN(is, 15) = "bcdefgabcdefgab"
+                andalso inputN(is, 0) = ""
+                andalso not (endOfStream is))
+               before closeIn is 
+           end);
    
 val test8f =
     tst' "test8f" (fn _ =>
-	   let val is = openIn "medium.dat"
-	   in 
-	       (inputN(is, 500000) = longstring
-		andalso inputN(is, 100) = ""
-		andalso endOfStream is)
-	       before closeIn is 
-	   end);
+           let val is = openIn "medium.dat"
+           in 
+               (inputN(is, 500000) = longstring
+                andalso inputN(is, 100) = ""
+                andalso endOfStream is)
+               before closeIn is 
+           end);
    
 val test9a =
     tst' "test9a" (fn _ =>
-	   let val is = openIn "empty.dat"
-	   in 
-	       (lookahead is = NONE 
-		andalso input is = "" 
-		andalso lookahead is = NONE
-		andalso input is = "")
-	       before closeIn is 
-	   end);
+           let val is = openIn "empty.dat"
+           in 
+               (lookahead is = NONE 
+                andalso input is = "" 
+                andalso lookahead is = NONE
+                andalso input is = "")
+               before closeIn is 
+           end);
 
 val test9b =
     tst' "test9b" (fn _ =>
-	   let val is = openIn "small1.dat"
-	   in 
-	       (lookahead is = SOME #"+"
-		andalso input is = "+" 
-		andalso input is = ""
-		andalso lookahead is = NONE)
-	       before closeIn is 
-	   end);
+           let val is = openIn "small1.dat"
+           in 
+               (lookahead is = SOME #"+"
+                andalso input is = "+" 
+                andalso input is = ""
+                andalso lookahead is = NONE)
+               before closeIn is 
+           end);
 
 val test9c =
     tst' "test9c" (fn _ =>
-	   let val is = openIn "small2.dat"
-	   in 
-	       (lookahead is = SOME #"*"
-		andalso input is = "*1" 
-		andalso input is = ""
-		andalso lookahead is = NONE)
-	       before closeIn is 
-	   end);
+           let val is = openIn "small2.dat"
+           in 
+               (lookahead is = SOME #"*"
+                andalso input is = "*1" 
+                andalso input is = ""
+                andalso lookahead is = NONE)
+               before closeIn is 
+           end);
 
 val test9d =
     tst' "test9d" (fn _ =>
-	   let val is = openIn "small2.dat"
-	   in 
-	       (input is = "*1" 
-		andalso input is = "")
-	       before closeIn is 
-	   end);
+           let val is = openIn "small2.dat"
+           in 
+               (input is = "*1" 
+                andalso input is = "")
+               before closeIn is 
+           end);
 
 val test9e =
     tst' "test9e" (fn _ =>
-	   let val is = openIn "medium.dat"
-	   in 
-	       lookahead is = SOME #"a"
-	       andalso String.substring(input is, 0, 15) = "abcdefgabcdefga"
-	       before closeIn is 
-	   end);
+           let val is = openIn "medium.dat"
+           in 
+               lookahead is = SOME #"a"
+               andalso String.substring(input is, 0, 15) = "abcdefgabcdefga"
+               before closeIn is 
+           end);
    
 val test10 = 
     tst' "test10" (fn _ =>
-	   let val is = openIn "medium.dat"
-	   in 
-	       (lookahead is = SOME #"a"
-		andalso input1 is = SOME #"a"
-		andalso lookahead is = SOME #"b"
-		andalso input1 is = SOME #"b"
-		andalso lookahead is = SOME #"c")
-	       before closeIn is 
-	   end);
+           let val is = openIn "medium.dat"
+           in 
+               (lookahead is = SOME #"a"
+                andalso input1 is = SOME #"a"
+                andalso lookahead is = SOME #"b"
+                andalso input1 is = SOME #"b"
+                andalso lookahead is = SOME #"c")
+               before closeIn is 
+           end);
 
 val test11 = 
     tst' "test11" (fn _ =>
-	   let val is = openIn "medium.dat"
-	   in 
-	       (lookahead is = SOME #"a"
-		andalso inputN(is, 5) = "abcde"
-		andalso lookahead is = SOME #"f"
-		andalso inputN(is, 4) = "fgab"
-		andalso lookahead is = SOME #"c")
-	       before closeIn is 
-	   end);
+           let val is = openIn "medium.dat"
+           in 
+               (lookahead is = SOME #"a"
+                andalso inputN(is, 5) = "abcde"
+                andalso lookahead is = SOME #"f"
+                andalso inputN(is, 4) = "fgab"
+                andalso lookahead is = SOME #"c")
+               before closeIn is 
+           end);
 
 val test12a =
     tst' "test12a" (fn _ => 
-	   let val is = openIn "empty.dat"
-	   in 
-	       (inputLine is = NONE
-		andalso inputLine is = NONE)
-	       before closeIn is
-	   end);
+           let val is = openIn "empty.dat"
+           in 
+               (inputLine is = NONE
+                andalso inputLine is = NONE)
+               before closeIn is
+           end);
 
 val test12b =
     tst' "test12b" (fn _ => 
-	   let val is = openIn "small1.dat"
-	   in 
-	       (inputLine is = SOME "+\n"
-		andalso inputLine is = NONE)
-	       before closeIn is
-	   end);
+           let val is = openIn "small1.dat"
+           in 
+               (inputLine is = SOME "+\n"
+                andalso inputLine is = NONE)
+               before closeIn is
+           end);
 
 val test12c =
     tst' "test12c" (fn _ => 
-	   let val is = openIn "text.dat"
-	   in 
-	       (inputLine is = SOME "Line 1\n"
-	       andalso inputLine is = SOME "Line 2\n"
-	       andalso inputLine is = SOME "Line 3\n"
-	       andalso inputLine is = NONE)
-	       before closeIn is
-	   end);
+           let val is = openIn "text.dat"
+           in 
+               (inputLine is = SOME "Line 1\n"
+               andalso inputLine is = SOME "Line 2\n"
+               andalso inputLine is = SOME "Line 3\n"
+               andalso inputLine is = NONE)
+               before closeIn is
+           end);
 
 val test12d =
     tst' "test12d" (fn _ => 
-	   let val is = openIn "medium.dat"
-	   in 
-	       (inputLine is = SOME (longstring ^ "\n")
-	       andalso inputLine is = NONE)
-	       before closeIn is
-	   end);
+           let val is = openIn "medium.dat"
+           in 
+               (inputLine is = SOME (longstring ^ "\n")
+               andalso inputLine is = NONE)
+               before closeIn is
+           end);
 
 (* Test that outputSubstr works *)
 
 val _ = 
     let fun stdo s i n = outputSubstr(stdOut, Substring.substring(s, i, n))
-	fun stde s = output(stdErr, s)
-	val abcde = "abcde"
+        fun stde s = output(stdErr, s)
+        val abcde = "abcde"
     in
-	print "Two lines of output follow:\n";
-	stdo abcde 0 1; stdo abcde 1 3; 
-	stdo "" 0 0; stdo abcde 0 0; stdo abcde 5 0; stdo abcde 3 0; 
-	stdo abcde 4 1;
-	flushOut stdOut; 
-	stde " <--- this should read abcde\n";
-	stdo abcde 0 5;
-	flushOut stdOut; 
-	stde " <--- this should read abcde\n"
+        print "Two lines of output follow:\n";
+        stdo abcde 0 1; stdo abcde 1 3; 
+        stdo "" 0 0; stdo abcde 0 0; stdo abcde 5 0; stdo abcde 3 0; 
+        stdo abcde 4 1;
+        flushOut stdOut; 
+        stde " <--- this should read abcde\n";
+        stdo abcde 0 5;
+        flushOut stdOut; 
+        stde " <--- this should read abcde\n"
     end;
 
 end

Modified: mlton/branches/on-20050420-cmm-branch/regression/thread-switch.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/thread-switch.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/thread-switch.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -19,21 +19,21 @@
       then switch (fn _ => valOf (!done))
    else
       let
-	 val (n, t) = switch (fn t' => prepare (t, (n - 1, T t')))
+         val (n, t) = switch (fn t' => prepare (t, (n - 1, T t')))
       in
-	 loop(n, t)
+         loop(n, t)
       end
    
 fun main () =
    let
       val numSwitches =
-	 case CommandLine.arguments () of
-	    [] => 1000
-	  | s :: _ => valOf (Int.fromString s)
+         case CommandLine.arguments () of
+            [] => 1000
+          | s :: _ => valOf (Int.fromString s)
    in
       switch (fn cur =>
-	      (done := SOME (prepare (cur, ()))
-	       ; prepare (new loop, (numSwitches, T (new loop)))))
+              (done := SOME (prepare (cur, ()))
+               ; prepare (new loop, (numSwitches, T (new loop)))))
       ; print "ok\n"
    end
 

Modified: mlton/branches/on-20050420-cmm-branch/regression/thread0.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/thread0.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/thread0.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -7,7 +7,7 @@
 
 val _ =
    if 13 = 1 + switch(fn t =>
-		      prepare (new(fn () => switch(fn _ => prepare (t, 12))), ()))
+                      prepare (new(fn () => switch(fn _ => prepare (t, 12))), ()))
       then print "2 succeeded\n"
    else ()
       
@@ -18,10 +18,10 @@
 
 val _ =
    if 13 = switch(fn t =>
-		  prepare (new(fn () =>
-			       let val t = prepend(t, fn n => n + 1)
-			       in switch(fn _ => prepare (t, 12))
-			       end),
-			   ()))
+                  prepare (new(fn () =>
+                               let val t = prepend(t, fn n => n + 1)
+                               in switch(fn _ => prepare (t, 12))
+                               end),
+                           ()))
       then print "4 succeeded\n"
    else ()

Modified: mlton/branches/on-20050420-cmm-branch/regression/thread1.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/thread1.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/thread1.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -14,15 +14,15 @@
       fun enque(T{back, ...}, x) = back := x :: !back
 
       fun deque(T{front, back}) =
-	 case !front of
-	    [] => (case !back of
-		      [] => NONE
-		    | l => let val l = rev l
-			   in case l of
-			      [] => raise Fail "deque"
-			    | x :: l => (back := []; front := l; SOME x)
-			   end)
-	  | x :: l => (front := l; SOME x) 
+         case !front of
+            [] => (case !back of
+                      [] => NONE
+                    | l => let val l = rev l
+                           in case l of
+                              [] => raise Fail "deque"
+                            | x :: l => (back := []; front := l; SOME x)
+                           end)
+          | x :: l => (front := l; SOME x) 
    end
 
 structure Thread:
@@ -39,24 +39,24 @@
       val topLevel: Thread.Runnable.t option ref = ref NONE
 
       local
-	 val threads: Thread.Runnable.t Queue.t = Queue.new()
+         val threads: Thread.Runnable.t Queue.t = Queue.new()
       in
-	 fun ready (t: Thread.Runnable.t) : unit = 
-	    Queue.enque(threads, t)
-	 fun next () : Thread.Runnable.t =
-	    case Queue.deque threads of
-	       NONE => valOf(!topLevel)
-	     | SOME t => t
+         fun ready (t: Thread.Runnable.t) : unit = 
+            Queue.enque(threads, t)
+         fun next () : Thread.Runnable.t =
+            case Queue.deque threads of
+               NONE => valOf(!topLevel)
+             | SOME t => t
       end
    
       fun 'a exit(): 'a = switch(fn _ => next())
       
       fun new(f: unit -> unit): Thread.Runnable.t =
-	 Thread.prepare
-	 (Thread.new (fn () => ((f() handle _ => exit())
-				; exit())),
-	  ())
-	 
+         Thread.prepare
+         (Thread.new (fn () => ((f() handle _ => exit())
+                                ; exit())),
+          ())
+         
       fun schedule t = (ready t; next())
 
       fun yield(): unit = switch(fn t => schedule (Thread.prepare (t, ())))
@@ -64,17 +64,17 @@
       val spawn = ready o new
 
       fun run(): unit =
-	 (switch(fn t =>
-		 (topLevel := SOME (Thread.prepare (t, ()))
-		  ; next()))
-	  ; topLevel := NONE)
+         (switch(fn t =>
+                 (topLevel := SOME (Thread.prepare (t, ()))
+                  ; next()))
+          ; topLevel := NONE)
    end
 
 val rec loop =
    fn 0 => ()
     | n => (print(concat[Int.toString n, "\n"])
-	    ; Thread.yield()
-	    ; loop(n - 1))
+            ; Thread.yield()
+            ; loop(n - 1))
 
 val rec loop' =
    fn 0 => ()

Modified: mlton/branches/on-20050420-cmm-branch/regression/thread2.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/thread2.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/thread2.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -14,15 +14,15 @@
       fun enque (T {back, ...}, x) = back := x :: !back
 
       fun deque (T {front, back}) =
-	 case !front of
-	    [] => (case !back of
-		      [] => NONE
-		    | l => let val l = rev l
-			   in case l of
-			      [] => raise Fail "deque"
-			    | x :: l => (back := []; front := l; SOME x)
-			   end)
-	  | x :: l => (front := l; SOME x) 
+         case !front of
+            [] => (case !back of
+                      [] => NONE
+                    | l => let val l = rev l
+                           in case l of
+                              [] => raise Fail "deque"
+                            | x :: l => (back := []; front := l; SOME x)
+                           end)
+          | x :: l => (front := l; SOME x) 
    end
 
 structure Thread:
@@ -40,23 +40,23 @@
       val topLevel: Thread.Runnable.t option ref = ref NONE
 
       local
-	 val threads: Thread.Runnable.t Queue.t = Queue.new ()
+         val threads: Thread.Runnable.t Queue.t = Queue.new ()
       in
-	 fun ready t = Queue.enque (threads, t)
-	 fun next () =
-	    case Queue.deque threads of
-	       NONE => valOf (!topLevel)
-	     | SOME t => t
+         fun ready t = Queue.enque (threads, t)
+         fun next () =
+            case Queue.deque threads of
+               NONE => valOf (!topLevel)
+             | SOME t => t
       end
    
       fun 'a exit (): 'a = switch (fn _ => next ())
       
       fun new (f: unit -> unit): Thread.Runnable.t =
-	 Thread.prepare
-	 (Thread.new (fn () => ((f () handle _ => exit ())
-				; exit ())),
-	  ())
-	 
+         Thread.prepare
+         (Thread.new (fn () => ((f () handle _ => exit ())
+                                ; exit ())),
+          ())
+         
       fun schedule t = (ready t; next ())
 
       fun yield (): unit = switch (fn t => schedule (Thread.prepare (t, ())))
@@ -64,24 +64,24 @@
       val spawn = ready o new
 
       fun setItimer t =
-	 Itimer.set (Itimer.Real,
-		     {value = t,
-		      interval = t})
+         Itimer.set (Itimer.Real,
+                     {value = t,
+                      interval = t})
 
       fun run (): unit =
-	 (switch (fn t =>
-		  (topLevel := SOME (Thread.prepare (t, ()))
-		   ; new (fn () => (setHandler (alrm, Handler.handler schedule)
-				    ; setItimer (Time.fromMilliseconds 20)))))
-	  ; setItimer Time.zeroTime
-	  ; ignore alrm
-	  ; topLevel := NONE)
+         (switch (fn t =>
+                  (topLevel := SOME (Thread.prepare (t, ()))
+                   ; new (fn () => (setHandler (alrm, Handler.handler schedule)
+                                    ; setItimer (Time.fromMilliseconds 20)))))
+          ; setItimer Time.zeroTime
+          ; ignore alrm
+          ; topLevel := NONE)
    end
 
 val rec delay =
    fn 0 => ()
     | n => delay (n - 1)
-	 
+         
 val rec loop =
    fn 0 => ()
     | n => (delay 500000; loop (n - 1))

Modified: mlton/branches/on-20050420-cmm-branch/regression/time.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/time.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/time.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -8,7 +8,7 @@
 fun range (from, to) p = 
     let open Int 
     in
-	(from > to) orelse (p from) andalso (range (from+1, to) p)
+        (from > to) orelse (p from) andalso (range (from+1, to) p)
     end;
 
 fun checkrange bounds = check o range bounds;
@@ -36,79 +36,79 @@
 
 val test2a = 
     tst' "test2a" (fn _ => toSeconds zeroTime = 0
-	   andalso zeroTime = fromSeconds 0
-	   andalso zeroTime = fromMilliseconds 0
-	   andalso zeroTime = fromMicroseconds 0);
+           andalso zeroTime = fromSeconds 0
+           andalso zeroTime = fromMilliseconds 0
+           andalso zeroTime = fromMicroseconds 0);
 val test2b = 
     tst' "test2b" (fn _ => toSeconds bigt = 987654321
-	   andalso toSeconds litt = 454
-	   andalso toMilliseconds litt = 454501
-	   andalso toMicroseconds litt = 454501701);
+           andalso toSeconds litt = 454
+           andalso toMilliseconds litt = 454501
+           andalso toMicroseconds litt = 454501701);
 val test2c = tst0 "test2c" ((fromSeconds ~1 seq "OK")
-			   handle _ => "WRONG")
+                           handle _ => "WRONG")
 val test2d = tst0 "test2d" ((fromMilliseconds ~1 seq "OK")
-			   handle _ => "WRONG")
+                           handle _ => "WRONG")
 val test2e = tst0 "test2e" ((fromMicroseconds ~1 seq "OK")
-			   handle _ => "WRONG")
+                           handle _ => "WRONG")
 
 val test3a = 
     tst' "test3a" (fn _ => fromReal 0.0 = zeroTime
-		   andalso fromReal 10.25 = fromSeconds 10 + fromMilliseconds 250);
+                   andalso fromReal 10.25 = fromSeconds 10 + fromMilliseconds 250);
 val test3b = tst0 "test3b" ((fromReal ~1.0 seq "OK")
-			   handle _ => "WRONG")
+                           handle _ => "WRONG")
 val test3c = tst0 "test3c" ((fromReal 1E300 seq "OK")
-			   handle Time => "OK" | _ => "WRONG") 
+                           handle Time => "OK" | _ => "WRONG") 
 
 val test4a = 
     tst' "test4a" (fn _ => Real.==(toReal (fromReal 100.25), 100.25));
 
 val test6a = 
     tst' "test6a" (fn _ => bigt + litt = litt + bigt
-		   andalso (bigt + litt) - litt = bigt
-		   andalso (bigt - litt) + litt = bigt);
+                   andalso (bigt + litt) - litt = bigt
+                   andalso (bigt - litt) + litt = bigt);
 
 val test7a = 
     tst' "test7a" (fn _ => litt <= litt andalso litt >= litt
-	   andalso zeroTime < litt andalso litt > zeroTime
-	   andalso litt < bigt andalso bigt > litt
-	   andalso not (litt > bigt) 
-	   andalso not (bigt < litt) 
-	   andalso not(litt < litt)
-	   andalso not(litt > litt));
+           andalso zeroTime < litt andalso litt > zeroTime
+           andalso litt < bigt andalso bigt > litt
+           andalso not (litt > bigt) 
+           andalso not (bigt < litt) 
+           andalso not(litt < litt)
+           andalso not(litt > litt));
 
 val test8a = 
     tst' "test8a" (fn _ => now() <= now() 
-	   andalso (now () before fib 27 seq ()) <= now());
+           andalso (now () before fib 27 seq ()) <= now());
 
 val test9a = 
     tst' "test9a" (fn _ => fmt 0 litt = "455")
 
 val test9b = 
     tst' "test9b" (fn _ => fmt 1 litt = "454.5"
-	   andalso fmt 2 litt = "454.50"
-	   andalso fmt 3 litt = "454.502"
-	   andalso fmt 4 litt = "454.5017"
-	   andalso fmt 5 litt = "454.50170"
-	   andalso fmt 6 litt = "454.501701");
+           andalso fmt 2 litt = "454.50"
+           andalso fmt 3 litt = "454.502"
+           andalso fmt 4 litt = "454.5017"
+           andalso fmt 5 litt = "454.50170"
+           andalso fmt 6 litt = "454.501701");
     
 fun chk (s, r) = 
     tst' "test10a" (fn _ => 
-	   case fromString s of
-	       SOME res => res = fromMicroseconds r
-	     | NONE     => false)
+           case fromString s of
+               SOME res => res = fromMicroseconds r
+             | NONE     => false)
 
 val test10a = 
     List.map chk
          [("189", 189000000),
-	  ("189.1", 189100000),
-	  ("189.125125", 189125125),
-	  (".1", 100000),
-	  (".125125", 125125),
-	  (" \n\t189crap", 189000000),
-	  (" \n\t189.1crap", 189100000),
-	  (" \n\t189.125125crap", 189125125),
-	  (" \n\t.1crap", 100000),
-	  (" \n\t.125125crap", 125125)];
+          ("189.1", 189100000),
+          ("189.125125", 189125125),
+          (".1", 100000),
+          (".125125", 125125),
+          (" \n\t189crap", 189000000),
+          (" \n\t189.1crap", 189100000),
+          (" \n\t189.125125crap", 189125125),
+          (" \n\t.1crap", 100000),
+          (" \n\t.125125crap", 125125)];
 
 val test10b = 
     List.app (fn s => tst0 "test10b" (case fromString s of NONE => "OK" | _ => "WRONG"))

Modified: mlton/branches/on-20050420-cmm-branch/regression/time3.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/time3.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/time3.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -5,10 +5,10 @@
 val messy = fromReal 123.456789
    
 val _ = (pt zeroTime;
-	 pt messy;
-	 app (fn d => (print(fmt d messy) ; print "\n")) [0,1,2,3,4,5,6,7];
-	 pt(fromReal 123.456789);
-	 pt(fromSeconds 123);
-	 pt(fromMilliseconds 123456);
-	 pt(fromMicroseconds 123456789)
-	 )
+         pt messy;
+         app (fn d => (print(fmt d messy) ; print "\n")) [0,1,2,3,4,5,6,7];
+         pt(fromReal 123.456789);
+         pt(fromSeconds 123);
+         pt(fromMilliseconds 123456);
+         pt(fromMicroseconds 123456789)
+         )

Copied: mlton/branches/on-20050420-cmm-branch/regression/time4.ok (from rev 4358, mlton/trunk/regression/time4.ok)

Copied: mlton/branches/on-20050420-cmm-branch/regression/time4.sml (from rev 4358, mlton/trunk/regression/time4.sml)

Modified: mlton/branches/on-20050420-cmm-branch/regression/timeout.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/timeout.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/timeout.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -5,30 +5,30 @@
       val which = Itimer.Real
       val signal = Itimer.signal which
       val res =
-	 Thread.switch
-	 (fn cur: 'a option Thread.t =>
-	  let
-	     val _ = setHandler (signal,
-				 Handler.handler
-				 (fn _ => Thread.prepare (cur, NONE)))
-	     val _ =
-		Itimer.set (which, {value = t,
-				    interval = Time.zeroTime})
-	     val t = Thread.new (fn () =>
-				 let val res = SOME (f ()) handle _ => NONE
-				 in Thread.switch (fn _ => Thread.prepare (cur, res))
-				 end)
-	  in Thread.prepare (t, ())
-	  end)
+         Thread.switch
+         (fn cur: 'a option Thread.t =>
+          let
+             val _ = setHandler (signal,
+                                 Handler.handler
+                                 (fn _ => Thread.prepare (cur, NONE)))
+             val _ =
+                Itimer.set (which, {value = t,
+                                    interval = Time.zeroTime})
+             val t = Thread.new (fn () =>
+                                 let val res = SOME (f ()) handle _ => NONE
+                                 in Thread.switch (fn _ => Thread.prepare (cur, res))
+                                 end)
+          in Thread.prepare (t, ())
+          end)
       val _ = setHandler (signal, Handler.default)
    in
       res
    end
-		 
+                 
 val _ =
    case timeLimit (Time.fromSeconds 10,
-		   let fun loop () = loop ()
-		   in loop
-		   end) of
+                   let fun loop () = loop ()
+                   in loop
+                   end) of
       NONE => print "success\n"
     | SOME _ => print "failure\n"

Modified: mlton/branches/on-20050420-cmm-branch/regression/tststrcmp.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/tststrcmp.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/tststrcmp.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -23,7 +23,7 @@
 in
 fun etst s e1 e2 =
       prl (int_to_string (r := !r + 1; !r)
-	   ^ (if e1 = e2 then " ok" else " * n o t   o k ! *"))
+           ^ (if e1 = e2 then " ok" else " * n o t   o k ! *"))
 end
 
 val () = etst "1" ("" < "abc") true;         (*den ene tom*)
@@ -50,25 +50,25 @@
 val () = etst "6" ("" <= "") true;
 val () = etst "6" ("" = "") true;
 val () = etst "6" ("" <> "") false;
-val () = etst "7" ("abc" < "abcd") true;    (*den ene længere*)
+val () = etst "7" ("abc" < "abcd") true;    (*den ene lngere*)
 val () = etst "8" ("abc" > "abcd") false;
 val () = etst "8" ("abc" >= "abcd") false;
 val () = etst "8" ("abc" <= "abcd") true;
 val () = etst "8" ("abc" = "abcd") false;
 val () = etst "8" ("abc" <> "abcd") true;
-val () = etst "-" ("abcd" < "abc") false;   (*den anden længere*)
+val () = etst "-" ("abcd" < "abc") false;   (*den anden lngere*)
 val () = etst "-" ("abcd" > "abc") true;
 val () = etst "-" ("abcd" >= "abc") true;
 val () = etst "-" ("abcd" <= "abc") false;
 val () = etst "-" ("abcd" = "abc") false;
 val () = etst "-" ("abcd" <> "abc") true;
-val () = etst "-" ("abc" < "abd") true;     (*lige lange, sidste størst*)
+val () = etst "-" ("abc" < "abd") true;     (*lige lange, sidste strst*)
 val () = etst "-" ("abc" > "abd") false;
 val () = etst "-" ("abc" >= "abd") false;
 val () = etst "-" ("abc" <= "abd") true;
 val () = etst "-" ("abc" = "abd") false;
 val () = etst "-" ("abc" <> "abd") true;
-val () = etst "-" ("abd" < "abc") false;    (*lige lange, første størst*)
+val () = etst "-" ("abd" < "abc") false;    (*lige lange, frste strst*)
 val () = etst "-" ("abd" > "abc") true;
 val () = etst "-" ("abd" >= "abc") true;
 val () = etst "-" ("abd" <= "abc") false;
@@ -83,17 +83,17 @@
   | repeat n s = s ^ repeat (n-1) s
 val long = repeat  50 "Der laa den Ridder i Graesset og drev.\n\
                       \Hejsa, nu sadler vi af.\n\
-		      \Der laa hans Harnisk, hans Skjold og Vaerge,\n\
-		      \Hans Tanker de floej over alle Bjerge.\n\
-		      \De floej paa Skyer gennem Luften den blaa ---\n\
-		      \Den Rejse man bruger ej Vaaben paa.\n\
-		      \\n\
-		      \Den Ridder han laa, hvor han steded sig foerst\n\
-		      \Han kendte ej Sult, han kendte ej Toerst\n\
-		      \Og Solen kom og Stedet og gik;\n\
-		      \Han lytted som efter en sagte Musik.\n\
-		      \\n\
-		      \\n"
+                      \Der laa hans Harnisk, hans Skjold og Vaerge,\n\
+                      \Hans Tanker de floej over alle Bjerge.\n\
+                      \De floej paa Skyer gennem Luften den blaa ---\n\
+                      \Den Rejse man bruger ej Vaaben paa.\n\
+                      \\n\
+                      \Den Ridder han laa, hvor han steded sig foerst\n\
+                      \Han kendte ej Sult, han kendte ej Toerst\n\
+                      \Og Solen kom og Stedet og gik;\n\
+                      \Han lytted som efter en sagte Musik.\n\
+                      \\n\
+                      \\n"
 
 val () = etst "1" (long ^ "" < long ^ "abc") true;         (*den ene tom*)
 val () = etst "2" (long ^ "" > long ^ "abc") false;
@@ -119,25 +119,25 @@
 val () = etst "6" (long ^ "" <= long ^ "") true;
 val () = etst "6" (long ^ "" = long ^ "") true;
 val () = etst "6" (long ^ "" <> long ^ "") false;
-val () = etst "7" (long ^ "abc" < long ^ "abcd") true;    (*den ene længere*)
+val () = etst "7" (long ^ "abc" < long ^ "abcd") true;    (*den ene lngere*)
 val () = etst "8" (long ^ "abc" > long ^ "abcd") false;
 val () = etst "8" (long ^ "abc" >= long ^ "abcd") false;
 val () = etst "8" (long ^ "abc" <= long ^ "abcd") true;
 val () = etst "8" (long ^ "abc" = long ^ "abcd") false;
 val () = etst "8" (long ^ "abc" <> long ^ "abcd") true;
-val () = etst "-" (long ^ "abcd" < long ^ "abc") false;   (*den anden længere*)
+val () = etst "-" (long ^ "abcd" < long ^ "abc") false;   (*den anden lngere*)
 val () = etst "-" (long ^ "abcd" > long ^ "abc") true;
 val () = etst "-" (long ^ "abcd" >= long ^ "abc") true;
 val () = etst "-" (long ^ "abcd" <= long ^ "abc") false;
 val () = etst "-" (long ^ "abcd" = long ^ "abc") false;
 val () = etst "-" (long ^ "abcd" <> long ^ "abc") true;
-val () = etst "-" (long ^ "abc" < long ^ "abd") true;     (*lige lange, sidste størst*)
+val () = etst "-" (long ^ "abc" < long ^ "abd") true;     (*lige lange, sidste strst*)
 val () = etst "-" (long ^ "abc" > long ^ "abd") false;
 val () = etst "-" (long ^ "abc" >= long ^ "abd") false;
 val () = etst "-" (long ^ "abc" <= long ^ "abd") true;
 val () = etst "-" (long ^ "abc" = long ^ "abd") false;
 val () = etst "-" (long ^ "abc" <> long ^ "abd") true;
-val () = etst "-" (long ^ "abd" < long ^ "abc") false;    (*lige lange, første størst*)
+val () = etst "-" (long ^ "abd" < long ^ "abc") false;    (*lige lange, frste strst*)
 val () = etst "-" (long ^ "abd" > long ^ "abc") true;
 val () = etst "-" (long ^ "abd" >= long ^ "abc") true;
 val () = etst "-" (long ^ "abd" <= long ^ "abc") false;

Modified: mlton/branches/on-20050420-cmm-branch/regression/unary.2.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/unary.2.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/unary.2.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -13,4 +13,4 @@
     | n as S m => times (n, fact m)
 
 val x = fact (S (S (S Z)))
-	      
+              

Modified: mlton/branches/on-20050420-cmm-branch/regression/unixpath.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/unixpath.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/unixpath.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -8,7 +8,7 @@
 fun range (from, to) p = 
     let open Int 
     in
-	(from > to) orelse (p from) andalso (range (from+1, to) p)
+        (from > to) orelse (p from) andalso (range (from+1, to) p)
     end;
 
 fun checkrange bounds = check o range bounds;
@@ -84,9 +84,9 @@
 val test2n = 
     tst' "test2n" (fn _ => toString {isAbs=true, vol="", arcs=["a", "..", "c"]} = "/a/../c");
 val test2o = tst0 "test2o" ((toString {isAbs=false, vol = "", arcs =  ["", "a"]} seq "WRONG")
-			    handle Path => "OK" | _ => "WRONG")
+                            handle Path => "OK" | _ => "WRONG")
 val test2p = tst0 "test2p" ((toString {isAbs=true, vol = "C:", arcs =  ["windows"]} seq "WRONG")
-			    handle Path => "OK" | _ => "WRONG")
+                            handle Path => "OK" | _ => "WRONG")
 
 val test3b = 
     tst' "test3b" (fn _ => getVolume "/" = "");
@@ -105,138 +105,138 @@
 
 val test4a = 
     tst' "test4a" (fn _ => 
-	   List.all isRelative ["", ".", "..", "a//"]
-	   andalso not (List.exists isRelative ["/", "/a", "//"]));
+           List.all isRelative ["", ".", "..", "a//"]
+           andalso not (List.exists isRelative ["/", "/a", "//"]));
 val test4b = 
     tst' "test4b" (fn _ => 
-	   List.all isAbsolute ["/", "/a", "//", "/.", "/.."]
-	   andalso not (List.exists isAbsolute ["", ".", "..", "a//"]));
+           List.all isAbsolute ["/", "/a", "//", "/.", "/.."]
+           andalso not (List.exists isAbsolute ["", ".", "..", "a//"]));
 
 val test5a = 
     tst' "test5a" (fn _ => 
-	   getParent "/" = "/"
-	   andalso getParent "a" = "."
-	   andalso getParent "a/" = "a/.."
-	   andalso getParent "a///" = "a///.."
-	   andalso getParent "a/b" = "a"
-	   andalso getParent "a/b/" = "a/b/.."
-	   andalso getParent "/a/b" = "/a"
-	   andalso getParent "/a/b/" = "/a/b/.."
-	   andalso getParent ".." = "../.."
-	   andalso getParent "." = ".."
-	   andalso getParent "../" = "../.."
-	   andalso getParent "./" = "./.."
-	   andalso getParent "" = "..");
+           getParent "/" = "/"
+           andalso getParent "a" = "."
+           andalso getParent "a/" = "a/.."
+           andalso getParent "a///" = "a///.."
+           andalso getParent "a/b" = "a"
+           andalso getParent "a/b/" = "a/b/.."
+           andalso getParent "/a/b" = "/a"
+           andalso getParent "/a/b/" = "/a/b/.."
+           andalso getParent ".." = "../.."
+           andalso getParent "." = ".."
+           andalso getParent "../" = "../.."
+           andalso getParent "./" = "./.."
+           andalso getParent "" = "..");
 
 val test6a = 
     tst' "test6a" (fn _ => 
-	   concat("a", "b") = "a/b"
-	   andalso concat("a", "b/c") = "a/b/c"
-	   andalso concat("/", "b/c") = "/b/c"
-	   andalso concat("", "b/c") = "b/c"
-	   andalso concat("/a", "b/c") = "/a/b/c"
-	   andalso concat("a/", "b/c") = "a/b/c"
-	   andalso concat("a//", "b/c") = "a//b/c"
-	   andalso concat(".", "b/c") = "./b/c"
-	   andalso concat("a/b", "..") = "a/b/.."
-	   andalso concat("a/b", "../c") = "a/b/../c");
+           concat("a", "b") = "a/b"
+           andalso concat("a", "b/c") = "a/b/c"
+           andalso concat("/", "b/c") = "/b/c"
+           andalso concat("", "b/c") = "b/c"
+           andalso concat("/a", "b/c") = "/a/b/c"
+           andalso concat("a/", "b/c") = "a/b/c"
+           andalso concat("a//", "b/c") = "a//b/c"
+           andalso concat(".", "b/c") = "./b/c"
+           andalso concat("a/b", "..") = "a/b/.."
+           andalso concat("a/b", "../c") = "a/b/../c");
 val test6b = tst0 "test6b" ((concat ("a", "/b") seq "WRONG")
-			    handle Path => "OK" | _ => "WRONG")
+                            handle Path => "OK" | _ => "WRONG")
 
 val mkAbsolute = fn (p, r) => mkAbsolute {path = p, relativeTo = r}
    
 val test7a = 
     tst' "test7a" (fn _ => 
-	   mkAbsolute("/a/b", "/c/d") = "/a/b"
-	   andalso mkAbsolute("/", "/c/d") = "/"
-	   andalso mkAbsolute("a/b", "/c/d") = "/c/d/a/b");
+           mkAbsolute("/a/b", "/c/d") = "/a/b"
+           andalso mkAbsolute("/", "/c/d") = "/"
+           andalso mkAbsolute("a/b", "/c/d") = "/c/d/a/b");
 val test7b = tst0 "test7b" ((mkAbsolute("a", "c/d") seq "WRONG")
-			    handle Path => "OK" | _ => "WRONG")
+                            handle Path => "OK" | _ => "WRONG")
 val test7c = tst0 "test7c" ((mkAbsolute("/a", "c/d") seq "WRONG")
-			    handle Path => "OK" | _ => "WRONG")
+                            handle Path => "OK" | _ => "WRONG")
 
 val mkRelative = fn (p, r) => mkRelative {path = p, relativeTo = r}
 
 val test8a = 
     tst' "test8a" (fn _ => 
-	   mkRelative("a/b", "/c/d") = "a/b"
-	   andalso mkRelative("/", "/a/b/c")	   = "../../.." 
-	   andalso mkRelative("/a/", "/a/b/c")	   = "../../" 
-	   andalso mkRelative("/a/b/", "/a/c")	   = "../b/"     
-	   andalso mkRelative("/a/b", "/a/c/")	   = "../b"      
-	   andalso mkRelative("/a/b/", "/a/c/")	   = "../b/"     
-	   andalso mkRelative("/", "/")		   = "."	      
-	   andalso mkRelative("/", "/.")	   = "."	      
-	   andalso mkRelative("/", "/..")	   = "."	      
-	   andalso mkRelative("/", "/a")	   = ".."	      
-	   andalso mkRelative("/a/b/../c", "/a/d") = "../b/../c" 
-	   andalso mkRelative("/a/b", "/c/d")      = "../../a/b"
-	   andalso mkRelative("/c/a/b", "/c/d")    = "../a/b"
-	   andalso mkRelative("/c/d/a/b", "/c/d")  = "a/b");
+           mkRelative("a/b", "/c/d") = "a/b"
+           andalso mkRelative("/", "/a/b/c")       = "../../.." 
+           andalso mkRelative("/a/", "/a/b/c")     = "../../" 
+           andalso mkRelative("/a/b/", "/a/c")     = "../b/"     
+           andalso mkRelative("/a/b", "/a/c/")     = "../b"      
+           andalso mkRelative("/a/b/", "/a/c/")    = "../b/"     
+           andalso mkRelative("/", "/")            = "."              
+           andalso mkRelative("/", "/.")           = "."              
+           andalso mkRelative("/", "/..")          = "."              
+           andalso mkRelative("/", "/a")           = ".."             
+           andalso mkRelative("/a/b/../c", "/a/d") = "../b/../c" 
+           andalso mkRelative("/a/b", "/c/d")      = "../../a/b"
+           andalso mkRelative("/c/a/b", "/c/d")    = "../a/b"
+           andalso mkRelative("/c/d/a/b", "/c/d")  = "a/b");
 val test8b = tst0 "test8b" ((mkRelative("/a", "c/d") seq "WRONG")
-			    handle Path => "OK" | _ => "WRONG")
+                            handle Path => "OK" | _ => "WRONG")
 val test8c = tst0 "test8c" ((mkRelative("a", "c/d") seq "WRONG")
-			    handle Path => "OK" | _ => "WRONG")
+                            handle Path => "OK" | _ => "WRONG")
 
 val test9a = let
     fun chkCanon (a, b) =
-	  (mkCanonical a = b) 
-	  andalso (mkCanonical b = b)
-	  andalso (isCanonical b)
+          (mkCanonical a = b) 
+          andalso (mkCanonical b = b)
+          andalso (isCanonical b)
     in
       tst' "test9a" (fn _ => 
-	   chkCanon("", ".")
-	   andalso chkCanon(".", ".")
-	   andalso chkCanon("./.", ".")
-	   andalso chkCanon("/.", "/")
-	   andalso chkCanon("..", "..")
-	   andalso chkCanon("../..", "../..")
-	   andalso chkCanon("b", "b")
-	   andalso chkCanon("a/b", "a/b")
-	   andalso chkCanon("/a/b", "/a/b")
-	   andalso chkCanon("a/b/", "a/b")
-	   andalso chkCanon("a/b//", "a/b")
-	   andalso chkCanon("a/../b", "b")
-	   andalso chkCanon("a/..", ".")
-	   andalso chkCanon("a/.", "a")
-	   andalso chkCanon("a/", "a")
-	   andalso chkCanon("/a/../b/", "/b")
-	   andalso chkCanon("/..", "/")
-	   andalso chkCanon("/../../a/b", "/a/b")
-	   andalso chkCanon("/./../../a/b", "/a/b")
-	   andalso chkCanon("/./../..", "/")
-	   andalso chkCanon("a/../b", "b")
-	   andalso chkCanon("a/./b", "a/b")
-	   andalso chkCanon("a////b", "a/b")
+           chkCanon("", ".")
+           andalso chkCanon(".", ".")
+           andalso chkCanon("./.", ".")
+           andalso chkCanon("/.", "/")
+           andalso chkCanon("..", "..")
+           andalso chkCanon("../..", "../..")
+           andalso chkCanon("b", "b")
+           andalso chkCanon("a/b", "a/b")
+           andalso chkCanon("/a/b", "/a/b")
+           andalso chkCanon("a/b/", "a/b")
+           andalso chkCanon("a/b//", "a/b")
+           andalso chkCanon("a/../b", "b")
+           andalso chkCanon("a/..", ".")
+           andalso chkCanon("a/.", "a")
+           andalso chkCanon("a/", "a")
+           andalso chkCanon("/a/../b/", "/b")
+           andalso chkCanon("/..", "/")
+           andalso chkCanon("/../../a/b", "/a/b")
+           andalso chkCanon("/./../../a/b", "/a/b")
+           andalso chkCanon("/./../..", "/")
+           andalso chkCanon("a/../b", "b")
+           andalso chkCanon("a/./b", "a/b")
+           andalso chkCanon("a////b", "a/b")
            andalso chkCanon("a////b", "a/b"))
     end
 
 val test10a = 
     tst' "test10a" (fn _ => 
-	   not (isCanonical "./."
-		orelse isCanonical "/.."
-		orelse isCanonical "/."
-		orelse isCanonical "//"
-		orelse isCanonical "a/.."
-		orelse isCanonical "a//b"
-		orelse isCanonical "a/."
-	        orelse isCanonical "a/b/"
-		orelse isCanonical "a/.."))
-		
+           not (isCanonical "./."
+                orelse isCanonical "/.."
+                orelse isCanonical "/."
+                orelse isCanonical "//"
+                orelse isCanonical "a/.."
+                orelse isCanonical "a//b"
+                orelse isCanonical "a/."
+                orelse isCanonical "a/b/"
+                orelse isCanonical "a/.."))
+                
 val test11a = 
     tst' "test11a" (fn _ => 
-	   splitDirFile "" = {dir = "", file = ""}
-	   andalso splitDirFile "." = {dir = "", file = "."}
-	   andalso splitDirFile ".." = {dir = "", file = ".."}
-	   andalso splitDirFile "b" = {dir = "", file = "b"}
-	   andalso splitDirFile "b/" = {dir = "b", file = ""}
-	   andalso splitDirFile "a/b" = {dir = "a", file = "b"}
-	   andalso splitDirFile "/a" = {dir = "/", file = "a"}
-	   andalso splitDirFile "/a/b" = {dir = "/a", file = "b"}
-	   andalso splitDirFile "/c/a/b" = {dir = "/c/a", file = "b"}
-	   andalso splitDirFile "/c/a/b/" = {dir = "/c/a/b", file = ""}
-	   andalso splitDirFile "/c/a/b.foo.bar" = {dir = "/c/a", file="b.foo.bar"}
-	   andalso splitDirFile "/c/a/b.foo" = {dir = "/c/a", file = "b.foo"});
+           splitDirFile "" = {dir = "", file = ""}
+           andalso splitDirFile "." = {dir = "", file = "."}
+           andalso splitDirFile ".." = {dir = "", file = ".."}
+           andalso splitDirFile "b" = {dir = "", file = "b"}
+           andalso splitDirFile "b/" = {dir = "b", file = ""}
+           andalso splitDirFile "a/b" = {dir = "a", file = "b"}
+           andalso splitDirFile "/a" = {dir = "/", file = "a"}
+           andalso splitDirFile "/a/b" = {dir = "/a", file = "b"}
+           andalso splitDirFile "/c/a/b" = {dir = "/c/a", file = "b"}
+           andalso splitDirFile "/c/a/b/" = {dir = "/c/a/b", file = ""}
+           andalso splitDirFile "/c/a/b.foo.bar" = {dir = "/c/a", file="b.foo.bar"}
+           andalso splitDirFile "/c/a/b.foo" = {dir = "/c/a", file = "b.foo"});
 
 (*    
 val test11b = (splitDirFile "" seq "WRONG") 
@@ -244,119 +244,121 @@
 *)
 
 val test12 = 
-    tst' "test12" (fn _ => 
-	   "" = joinDirFile {dir = "", file = ""}
-	   andalso "b" = joinDirFile {dir = "", file = "b"}
-	   andalso "/" = joinDirFile {dir = "/", file = ""}
-	   andalso "/b" = joinDirFile {dir = "/", file = "b"}
-	   andalso "a/b" = joinDirFile {dir = "a", file = "b"}
-	   andalso "/a/b" = joinDirFile {dir = "/a", file = "b"}
-	   andalso "/c/a/b" = joinDirFile {dir = "/c/a", file = "b"}
-	   andalso "/c/a/b/" = joinDirFile {dir = "/c/a/b", file = ""}
-	   andalso "/c/a/b.foo.bar" = joinDirFile {dir = "/c/a", file="b.foo.bar"}
-	   andalso "/c/a/b.foo" = joinDirFile {dir = "/c/a", file = "b.foo"});
+    tst' "test12" (fn _ =>
+                   List.all (fn (res, dir, file) =>
+                             res = joinDirFile {dir = dir, file = file})
+                   [("", "", ""),
+                    ("b", "", "b"),
+                    ("/", "/", ""),
+                    ("/b", "/", "b"),
+                    ("a/b", "a", "b"),
+                    ("/a/b", "/a", "b"),
+                    ("/c/a/b", "/c/a", "b"),
+                    ("/c/a/b/", "/c/a/b", ""),
+                    ("/c/a/b.foo.bar", "/c/a","b.foo.bar"),
+                    ("/c/a/b.foo", "/c/a", "b.foo")])
 
 val test13 = 
     tst' "test13" (fn _ => 
-	   dir "b" = ""
-	   andalso dir "a/b" = "a"
-	   andalso dir "/" = "/"
-	   andalso dir "/b" = "/"
-	   andalso dir "/a/b" = "/a"
-	   andalso dir "/c/a/b" = "/c/a"
-	   andalso dir "/c/a/b/" = "/c/a/b"
-	   andalso dir "/c/a/b.foo.bar" = "/c/a"
-	   andalso dir "/c/a/b.foo" = "/c/a");
+           dir "b" = ""
+           andalso dir "a/b" = "a"
+           andalso dir "/" = "/"
+           andalso dir "/b" = "/"
+           andalso dir "/a/b" = "/a"
+           andalso dir "/c/a/b" = "/c/a"
+           andalso dir "/c/a/b/" = "/c/a/b"
+           andalso dir "/c/a/b.foo.bar" = "/c/a"
+           andalso dir "/c/a/b.foo" = "/c/a");
 
 val test14 = 
     tst' "test14" (fn _ => 
-	   file "b" = "b"
-	   andalso file "a/b" = "b"
-	   andalso file "/" = ""
-	   andalso file "/b" = "b"
-	   andalso file "/a/b" = "b"
-	   andalso file "/c/a/b" = "b"
-	   andalso file "/c/a/b/" = ""
-	   andalso file "/c/a/b.foo.bar" = "b.foo.bar"
-	   andalso file "/c/a/b.foo" = "b.foo");
+           file "b" = "b"
+           andalso file "a/b" = "b"
+           andalso file "/" = ""
+           andalso file "/b" = "b"
+           andalso file "/a/b" = "b"
+           andalso file "/c/a/b" = "b"
+           andalso file "/c/a/b/" = ""
+           andalso file "/c/a/b.foo.bar" = "b.foo.bar"
+           andalso file "/c/a/b.foo" = "b.foo");
 
 val test15 = 
     tst' "test15" (fn _ => 
-	   splitBaseExt "" = {base = "", ext = NONE}
-	   andalso splitBaseExt ".login" = {base = ".login", ext = NONE}
-	   andalso splitBaseExt "/.login" = {base = "/.login", ext = NONE}
-	   andalso splitBaseExt "a" = {base = "a", ext = NONE}
-	   andalso splitBaseExt "a." = {base = "a.", ext = NONE}
-	   andalso splitBaseExt "a.b" = {base = "a", ext = SOME "b"}
-	   andalso splitBaseExt "a.b.c" = {base = "a.b", ext = SOME "c"}
-	   andalso splitBaseExt "/a.b" = {base = "/a", ext = SOME "b"}
-	   andalso splitBaseExt "/c/a.b" = {base = "/c/a", ext = SOME "b"}
-	   andalso splitBaseExt "/c/a/b/.d" = {base = "/c/a/b/.d", ext = NONE}
-	   andalso splitBaseExt "/c.a/b.d" = {base = "/c.a/b", ext = SOME "d"}
-	   andalso splitBaseExt "/c.a/bd" = {base = "/c.a/bd", ext = NONE}
-	   andalso splitBaseExt "/c/a/b.foo.bar" = {base="/c/a/b.foo",ext=SOME "bar"}
-	   andalso splitBaseExt "/c/a/b.foo" = {base = "/c/a/b", ext = SOME "foo"});
+           splitBaseExt "" = {base = "", ext = NONE}
+           andalso splitBaseExt ".login" = {base = ".login", ext = NONE}
+           andalso splitBaseExt "/.login" = {base = "/.login", ext = NONE}
+           andalso splitBaseExt "a" = {base = "a", ext = NONE}
+           andalso splitBaseExt "a." = {base = "a.", ext = NONE}
+           andalso splitBaseExt "a.b" = {base = "a", ext = SOME "b"}
+           andalso splitBaseExt "a.b.c" = {base = "a.b", ext = SOME "c"}
+           andalso splitBaseExt "/a.b" = {base = "/a", ext = SOME "b"}
+           andalso splitBaseExt "/c/a.b" = {base = "/c/a", ext = SOME "b"}
+           andalso splitBaseExt "/c/a/b/.d" = {base = "/c/a/b/.d", ext = NONE}
+           andalso splitBaseExt "/c.a/b.d" = {base = "/c.a/b", ext = SOME "d"}
+           andalso splitBaseExt "/c.a/bd" = {base = "/c.a/bd", ext = NONE}
+           andalso splitBaseExt "/c/a/b.foo.bar" = {base="/c/a/b.foo",ext=SOME "bar"}
+           andalso splitBaseExt "/c/a/b.foo" = {base = "/c/a/b", ext = SOME "foo"});
 
 val test16 = 
     tst' "test16" (fn _ => 
-	   "" = joinBaseExt {base = "", ext = NONE}
-	   andalso ".login" = joinBaseExt {base = ".login", ext = NONE}
-	   andalso "a" = joinBaseExt {base = "a", ext = NONE}
-	   andalso "a" = joinBaseExt {base = "a", ext = SOME ""}
-	   andalso "a.b" = joinBaseExt {base = "a", ext = SOME "b"}
-	   andalso "a.b.c" = joinBaseExt {base = "a.b", ext = SOME "c"}
-	   andalso "a.b.c.d" = joinBaseExt {base = "a.b", ext = SOME "c.d"}
-	   andalso "/a.b" = joinBaseExt {base = "/a", ext = SOME "b"}
-	   andalso "/c/a.b" = joinBaseExt {base = "/c/a", ext = SOME "b"}
-	   andalso "/c/a/b/.d" = joinBaseExt {base = "/c/a/b/", ext = SOME "d"}
-	   andalso "/c/a/b.foo.bar" = joinBaseExt {base="/c/a/b",ext=SOME "foo.bar"}
-	   andalso "/c/a/b.foo" = joinBaseExt {base = "/c/a/b", ext = SOME "foo"});
+           "" = joinBaseExt {base = "", ext = NONE}
+           andalso ".login" = joinBaseExt {base = ".login", ext = NONE}
+           andalso "a" = joinBaseExt {base = "a", ext = NONE}
+           andalso "a" = joinBaseExt {base = "a", ext = SOME ""}
+           andalso "a.b" = joinBaseExt {base = "a", ext = SOME "b"}
+           andalso "a.b.c" = joinBaseExt {base = "a.b", ext = SOME "c"}
+           andalso "a.b.c.d" = joinBaseExt {base = "a.b", ext = SOME "c.d"}
+           andalso "/a.b" = joinBaseExt {base = "/a", ext = SOME "b"}
+           andalso "/c/a.b" = joinBaseExt {base = "/c/a", ext = SOME "b"}
+           andalso "/c/a/b/.d" = joinBaseExt {base = "/c/a/b/", ext = SOME "d"}
+           andalso "/c/a/b.foo.bar" = joinBaseExt {base="/c/a/b",ext=SOME "foo.bar"}
+           andalso "/c/a/b.foo" = joinBaseExt {base = "/c/a/b", ext = SOME "foo"});
 
 val test17 = 
     tst' "test17" (fn _ => 
-	   ext "" = NONE
-	   andalso ext ".login" = NONE
-	   andalso ext "/.login" = NONE
-	   andalso ext "a" = NONE
-	   andalso ext "a." = NONE
-	   andalso ext "a.b" = SOME "b"
-	   andalso ext "a.b.c" = SOME "c"
-	   andalso ext "a.b.c.d" = SOME "d"
-	   andalso ext "/a.b" = SOME "b"
-	   andalso ext "/c/a.b" = SOME "b"
-	   andalso ext "/c/a/b/.d" = NONE
-	   andalso ext "/c.a/b.d" = SOME "d"
-	   andalso ext "/c.a/bd" = NONE
-	   andalso ext "/c/a/b.foo.bar" = SOME "bar"
-	   andalso ext "/c/a/b.foo" = SOME "foo");
+           ext "" = NONE
+           andalso ext ".login" = NONE
+           andalso ext "/.login" = NONE
+           andalso ext "a" = NONE
+           andalso ext "a." = NONE
+           andalso ext "a.b" = SOME "b"
+           andalso ext "a.b.c" = SOME "c"
+           andalso ext "a.b.c.d" = SOME "d"
+           andalso ext "/a.b" = SOME "b"
+           andalso ext "/c/a.b" = SOME "b"
+           andalso ext "/c/a/b/.d" = NONE
+           andalso ext "/c.a/b.d" = SOME "d"
+           andalso ext "/c.a/bd" = NONE
+           andalso ext "/c/a/b.foo.bar" = SOME "bar"
+           andalso ext "/c/a/b.foo" = SOME "foo");
 
 val test18 = 
     tst' "test18" (fn _ => 
-	   base "" = ""
-	   andalso base ".d" = ".d"
-	   andalso base ".login" = ".login"
-	   andalso base "/.login" = "/.login"
-	   andalso base "a" = "a"
-	   andalso base "a." = "a."
-	   andalso base "a.b" = "a"
-	   andalso base "a.b.c" = "a.b" 
-	   andalso base "a.b.c.d" = "a.b.c"
-	   andalso base "/a.b" = "/a"
-	   andalso base "/c/a.b" = "/c/a"
-	   andalso base "/c/a/b/.d" = "/c/a/b/.d"
-	   andalso base "/c.a/b.d" = "/c.a/b"
-	   andalso base "/c.a/bd" = "/c.a/bd"
-	   andalso base "/c/a/b.foo.bar" = "/c/a/b.foo"
-	   andalso base "/c/a/b.foo" = "/c/a/b");
+           base "" = ""
+           andalso base ".d" = ".d"
+           andalso base ".login" = ".login"
+           andalso base "/.login" = "/.login"
+           andalso base "a" = "a"
+           andalso base "a." = "a."
+           andalso base "a.b" = "a"
+           andalso base "a.b.c" = "a.b" 
+           andalso base "a.b.c.d" = "a.b.c"
+           andalso base "/a.b" = "/a"
+           andalso base "/c/a.b" = "/c/a"
+           andalso base "/c/a/b/.d" = "/c/a/b/.d"
+           andalso base "/c.a/b.d" = "/c.a/b"
+           andalso base "/c.a/bd" = "/c.a/bd"
+           andalso base "/c/a/b.foo.bar" = "/c/a/b.foo"
+           andalso base "/c/a/b.foo" = "/c/a/b");
 
 val test19 = 
     tst' "test19" (fn () => validVolume{isAbs=false, vol=""}
-	   andalso validVolume{isAbs=true, vol=""}
-	   andalso not (validVolume{isAbs=true, vol="/"}
-			orelse validVolume{isAbs=false, vol="/"} 
-			orelse validVolume{isAbs=true, vol="C:"}
-			orelse validVolume{isAbs=false, vol="C:"}
-			orelse validVolume{isAbs=true, vol=" "}
-			orelse validVolume{isAbs=false, vol=" "})); 
+           andalso validVolume{isAbs=true, vol=""}
+           andalso not (validVolume{isAbs=true, vol="/"}
+                        orelse validVolume{isAbs=false, vol="/"} 
+                        orelse validVolume{isAbs=true, vol="C:"}
+                        orelse validVolume{isAbs=false, vol="C:"}
+                        orelse validVolume{isAbs=true, vol=" "}
+                        orelse validVolume{isAbs=false, vol=" "})); 
 in
 end

Copied: mlton/branches/on-20050420-cmm-branch/regression/unixpath.x86-cygwin.ok (from rev 4358, mlton/trunk/regression/unixpath.x86-cygwin.ok)

Modified: mlton/branches/on-20050420-cmm-branch/regression/useless-string.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/useless-string.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/useless-string.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -2,8 +2,8 @@
 val y = "defg"
 val _ =
    if 3 = (String.size
-	   (if 0 = length (CommandLine.arguments ())
-	       then x
-	    else y))
+           (if 0 = length (CommandLine.arguments ())
+               then x
+            else y))
       then ()
    else raise Fail "bug"

Modified: mlton/branches/on-20050420-cmm-branch/regression/vector.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/vector.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/vector.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -8,7 +8,7 @@
 fun range (from, to) p = 
     let open Int 
     in
-	(from > to) orelse (p from) andalso (range (from+1, to) p)
+        (from > to) orelse (p from) andalso (range (from+1, to) p)
     end;
 
 fun checkrange bounds = check o range bounds;
@@ -75,7 +75,7 @@
 val test9 = check'(fn _ => f = b);
 val _ = prtest("test9", test9);
 val test9a = check'(fn _ => e = extract(e, 0, SOME (length e)) 
-		    andalso e = extract(e, 0, NONE));
+                    andalso e = extract(e, 0, NONE));
 val _ = prtest("test9a", test9a);
 val test9b = check'(fn _ => fromList [] = extract(e, 100, SOME 0));
 val _ = prtest("test9b", test9b);
@@ -98,19 +98,19 @@
              handle Subscript => "OK" | _ => "WRONG"
 val _ = prtest("test9h", test9h);
 val test9i = check'(fn _ => fromList [] = extract(e, length e, SOME 0)
-		    andalso fromList [] = extract(e, length e, NONE));
+                    andalso fromList [] = extract(e, length e, NONE));
 val _ = prtest("test9i", test9i);
 fun chkiter iter f vec reslast =
     check'(fn _ =>
-	   let val last = ref ~1
-	       val res = iter (fn x => (last := x; f x)) vec
-	   in (res, !last) = reslast end)
+           let val last = ref ~1
+               val res = iter (fn x => (last := x; f x)) vec
+           in (res, !last) = reslast end)
 
 fun chkiteri iter f vec reslast =
     check'(fn _ =>
-	   let val last = ref ~1
-	       val res = iter (fn (i, x) => (last := i; f x)) vec
-	   in (res, !last) = reslast end)
+           let val last = ref ~1
+               val res = iter (fn (i, x) => (last := i; f x)) vec
+           in (res, !last) = reslast end)
 
 val test10a = 
     chkiter map (fn x => 2*x) b (fromList [88,110,132], 66)

Modified: mlton/branches/on-20050420-cmm-branch/regression/vector4.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/vector4.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/vector4.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -8,10 +8,10 @@
 val v2 = fromList[1,2,3]
 
 val _ = assert("vector equality",
-	       v1 = v2
-	       andalso fromList[v1, v2] = fromList[v2, v1]
-	       andalso v1 <> fromList[1,2]
-	       andalso v1 <> fromList[1,2,4])
+               v1 = v2
+               andalso fromList[v1, v2] = fromList[v2, v1]
+               andalso v1 <> fromList[1,2]
+               andalso v1 <> fromList[1,2,4])
 
 open Array
 

Modified: mlton/branches/on-20050420-cmm-branch/regression/weak.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/weak.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/weak.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -10,9 +10,9 @@
    let
       val w = Weak.new i
       val _ =
-	 case Weak.get w of
-	    NONE => raise Fail "bug IntInf"
-	  | SOME i => print (concat [IntInf.toString i, "\n"])
+         case Weak.get w of
+            NONE => raise Fail "bug IntInf"
+          | SOME i => print (concat [IntInf.toString i, "\n"])
    in
       ()
    end

Modified: mlton/branches/on-20050420-cmm-branch/regression/where.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/where.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/where.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -9,12 +9,12 @@
 end where type s = int;
 
 (* Due to Martin Elsman, also see SML/NJ bug 1330. *)
-signature T =	
+signature T =   
    sig
       type s
       structure U :
-	 sig
-	    type 'a t
-	    type u = (int * real) t
-	 end where type 'a t = s
+         sig
+            type 'a t
+            type u = (int * real) t
+         end where type 'a t = s
    end where type U.u = int;

Modified: mlton/branches/on-20050420-cmm-branch/regression/word-all.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/word-all.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/word-all.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -24,19 +24,19 @@
 structure Answer =
    struct
       datatype t =
-	 Div
+         Div
        | Overflow
        | Word of W.word
 
       val toString =
-	 fn Div => "Div"
-	  | Overflow => "Overflow"
-	  | Word w => W.toString w
+         fn Div => "Div"
+          | Overflow => "Overflow"
+          | Word w => W.toString w
 
       fun run (f: unit -> W.word): t =
-	 Word (f ())
-	 handle General.Div => Div
-	      | General.Overflow => Overflow
+         Word (f ())
+         handle General.Div => Div
+              | General.Overflow => Overflow
 
       val equals: t * t -> bool = op =
    end
@@ -48,11 +48,11 @@
 fun err msg = print (concat [m, ": ", concat msg, "\n"])
 
 val _ = for (fn w =>
-	     print (concat [W.toString w, "\n",
-			    "\t", W.fmt StringCvt.BIN w, "\n",
-			    "\t", W.fmt StringCvt.OCT w, "\n",
-			    "\t", W.fmt StringCvt.DEC w, "\n",
-			    "\t", W.fmt StringCvt.HEX w, "\n"]))
+             print (concat [W.toString w, "\n",
+                            "\t", W.fmt StringCvt.BIN w, "\n",
+                            "\t", W.fmt StringCvt.OCT w, "\n",
+                            "\t", W.fmt StringCvt.DEC w, "\n",
+                            "\t", W.fmt StringCvt.HEX w, "\n"]))
 
 val _ =
    foreach
@@ -72,22 +72,22 @@
      for
      (fn w' =>
       let
-	 val a = Answer.run (fn () => f (w, w'))
-	 val a' = Answer.run (fn () =>
-			      W.fromLarge (f' (W.toLarge w, W.toLarge w')))
+         val a = Answer.run (fn () => f (w, w'))
+         val a' = Answer.run (fn () =>
+                              W.fromLarge (f' (W.toLarge w, W.toLarge w')))
 
       in
-	 if Answer.equals (a, a')
-	    then ()
-	 else err [W.toString w, " ", name, " ", W.toString w',
-		   " = ", Answer.toString a, " <> ", Answer.toString a']
+         if Answer.equals (a, a')
+            then ()
+         else err [W.toString w, " ", name, " ", W.toString w',
+                   " = ", Answer.toString a, " <> ", Answer.toString a']
       end)))
 
 val _ =
    for (fn w =>
-	if w = valOf (W.fromString (W.toString w))
-	   then ()
-	else err ["{from,to}String"])
+        if w = valOf (W.fromString (W.toString w))
+           then ()
+        else err ["{from,to}String"])
    
 val _ =
    foreach
@@ -100,13 +100,13 @@
      ([0w0, 0w1, 0w2, 0w4, 0w8, 0w15, 0w30, 0wxFF],
       fn w' =>
       let
-	 val a = f (w, w')
-	 val a' = W.fromLarge (f' (W.toLarge w, w'))
+         val a = f (w, w')
+         val a' = W.fromLarge (f' (W.toLarge w, w'))
       in
-	 if a = a'
-	    then ()
-	 else err [W.toString w, " ", name, " ", Word.toString w',
-		   " = ", W.toString a, " <> ", W.toString a']
+         if a = a'
+            then ()
+         else err [W.toString w, " ", name, " ", Word.toString w',
+                   " = ", W.toString a, " <> ", W.toString a']
       end)))
 
 val _ =
@@ -119,13 +119,13 @@
      ([0w0, 0w1, 0w2, 0w4, 0w8, 0w15, 0w30, 0wxFF],
       fn w' =>
       let
-	 val a = f (w, w')
-	 val a' = W.fromLarge (f' (W.toLargeX w, w'))
+         val a = f (w, w')
+         val a' = W.fromLarge (f' (W.toLargeX w, w'))
       in
-	 if a = a'
-	    then ()
-	 else err [W.toString w, " ", name, " ", Word.toString w',
-		   " = ", W.toString a, " <> ", W.toString a']
+         if a = a'
+            then ()
+         else err [W.toString w, " ", name, " ", Word.toString w',
+                   " = ", W.toString a, " <> ", W.toString a']
       end)))
 
 val _ =
@@ -140,13 +140,13 @@
      for
      (fn w' =>
       let
-	 val b = f (w, w')
-	 val b' = f' (W.toLarge w, W.toLarge w')
+         val b = f (w, w')
+         val b' = f' (W.toLarge w, W.toLarge w')
       in
-	 if b = b'
-	    then ()
-	 else err [W.toString w, " ", name, " ", W.toString w',
-		   " = ", Bool.toString b, " <> ", Bool.toString b']
+         if b = b'
+            then ()
+         else err [W.toString w, " ", name, " ", W.toString w',
+                   " = ", Bool.toString b, " <> ", Bool.toString b']
       end)))
 
 val _ =
@@ -158,12 +158,12 @@
      for
      (fn w' =>
       let
-	 val or = f (w, w')
-	 val or' = f' (W.toLarge w, W.toLarge w')
+         val or = f (w, w')
+         val or' = f' (W.toLarge w, W.toLarge w')
       in
-	 if or = or'
-	    then ()
-	 else err [W.toString w, " ", name, " ", W.toString w']
+         if or = or'
+            then ()
+         else err [W.toString w, " ", name, " ", W.toString w']
       end)))
 
 val _ =
@@ -172,31 +172,31 @@
     if w = W.fromLargeInt (W.toLargeInt w)
        andalso w = W.fromLargeInt (W.toLargeIntX w)
        andalso (case SOME (W.toInt w) handle Overflow => NONE of
-		   NONE => true
-		 | SOME i => w = W.fromInt i)
+                   NONE => true
+                 | SOME i => w = W.fromInt i)
        andalso (case SOME (W.toIntX w) handle Overflow => NONE of
-		   NONE => true
-		 | SOME i => w = W.fromInt i)
+                   NONE => true
+                 | SOME i => w = W.fromInt i)
        then ()
     else err ["{from,to}Large"])
 
 val _ =
    for (fn w =>
-	let
-	   val a = W.notb w
-	   val a' = W.fromLarge (LW.notb (W.toLarge w))
-	in
-	   if a = a'
-	      then ()
-	   else err ["notb ", W.toString w, " = ", W.toString a, " <> ",
-		     W.toString a']
-	end)
+        let
+           val a = W.notb w
+           val a' = W.fromLarge (LW.notb (W.toLarge w))
+        in
+           if a = a'
+              then ()
+           else err ["notb ", W.toString w, " = ", W.toString a, " <> ",
+                     W.toString a']
+        end)
 
 val _ =
    for (fn w =>
-	if W.~ w = W.- (zero, w)
-	   then ()
-	else err ["~"])
+        if W.~ w = W.- (zero, w)
+           then ()
+        else err ["~"])
 
 end
 

Modified: mlton/branches/on-20050420-cmm-branch/regression/word.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/word.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/word.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -8,7 +8,7 @@
 fun range (from, to) p = 
     let open Int 
     in
-	(from > to) orelse (p from) andalso (range (from+1, to) p)
+        (from > to) orelse (p from) andalso (range (from+1, to) p)
     end;
 
 fun checkrange bounds = check o range bounds;
@@ -33,9 +33,9 @@
 local 
     (* Isn't this disgusting: *)
     val [gt,  lt,  ge,   le] = 
-	[op>, op<, op>=, op<=] : (int * int -> bool) list
+        [op>, op<, op>=, op<=] : (int * int -> bool) list
     val [add, sub, mul, idiv,   imod] = 
-	[op+, op-, op*, op div, op mod] : (int * int -> int) list
+        [op+, op-, op*, op div, op mod] : (int * int -> int) list
     open Word;
     val op > = gt and op < = lt and op >= = ge and op <= = le;
     val op + = add and op - = sub and op * = mul 
@@ -197,137 +197,137 @@
 val _ = pr_ln "test12s" test12s
 fun chk f (s, r) = 
     check'(fn _ => 
-	   case f s of
-	       SOME res => res = i2w r
-	     | NONE     => false)
+           case f s of
+               SOME res => res = i2w r
+             | NONE     => false)
 
 fun chkScan fmt = chk (StringCvt.scanString (scan fmt))
 
 val test13a = 
     List.map (chk fromString)
              [("20Af", 8367),
-	      (" \n\t20AfGrap", 8367),
-	      ("0w20Af", 0 (*8367*)),
-	      (" \n\t0w20AfGrap", 0 (*8367*)),
-	      ("0", 0),
-	      ("0w", 0),
-	      ("0W1", 0),
-	      ("0w ", 0),
-	      ("0wx", 0),
-	      ("0wX", 0),
-	      ("0wx1", 1),
-	      ("0wX1", 1),
-	      ("0wx ", 0),
-	      ("0wX ", 0)];
+              (" \n\t20AfGrap", 8367),
+              ("0w20Af", 0 (*8367*)),
+              (" \n\t0w20AfGrap", 0 (*8367*)),
+              ("0", 0),
+              ("0w", 0),
+              ("0W1", 0),
+              ("0w ", 0),
+              ("0wx", 0),
+              ("0wX", 0),
+              ("0wx1", 1),
+              ("0wX1", 1),
+              ("0wx ", 0),
+              ("0wX ", 0)];
 val _ = pr_ln "test13a" (concat test13a)
 val test13b = 
     List.map (fn s => case fromString s of NONE => "OK" | _ => "WRONG")
-	   ["", "-", "~", "+", " \n\t", " \n\t-", " \n\t~", " \n\t+", 
-	    "+1", "~1", "-1", "GG"];	    
+           ["", "-", "~", "+", " \n\t", " \n\t-", " \n\t~", " \n\t+", 
+            "+1", "~1", "-1", "GG"];        
 val _ = pr_ln "test13b" (concat test13b)
 
 val test14a = 
     List.map (chkScan StringCvt.DEC)
              [("10789", 10789),
-	      (" \n\t10789crap", 10789),
-	      ("0w10789", 10789),
-	      (" \n\t0w10789crap", 10789),
-	      ("0", 0),
-	      ("0w", 0),
-	      ("0W1", 0),
-	      ("0w ", 0),
-	      ("0wx", 0),
-	      ("0wX", 0),
-	      ("0wx1", 0),
-	      ("0wX1", 0),
-	      ("0wx ", 0),
-	      ("0wX ", 0)];
+              (" \n\t10789crap", 10789),
+              ("0w10789", 10789),
+              (" \n\t0w10789crap", 10789),
+              ("0", 0),
+              ("0w", 0),
+              ("0W1", 0),
+              ("0w ", 0),
+              ("0wx", 0),
+              ("0wX", 0),
+              ("0wx1", 0),
+              ("0wX1", 0),
+              ("0wx ", 0),
+              ("0wX ", 0)];
 val _ = pr_ln "test14a" (concat test14a)
 val test14b = 
     List.map (fn s => case StringCvt.scanString (scan StringCvt.DEC) s 
-	              of NONE => "OK" | _ => "WRONG")
-	   ["", "-", "~", "+", " \n\t", " \n\t-", " \n\t~", " \n\t+", 
-	    "+1", "~1", "-1", "ff"];	    
+                      of NONE => "OK" | _ => "WRONG")
+           ["", "-", "~", "+", " \n\t", " \n\t-", " \n\t~", " \n\t+", 
+            "+1", "~1", "-1", "ff"];        
 val _ = pr_ln "test14b" (concat test14b)
 val test15a = 
     List.map (chkScan StringCvt.BIN)
              [("10010", 18),
-	      (" \n\t10010crap", 18),
-	      ("0w10010", 18),
-	      (" \n\t0w10010crap", 18),
-	      ("0", 0),
-	      ("0w", 0),
-	      ("0W1", 0),
-	      ("0w ", 0),
-	      ("0wx", 0),
-	      ("0wX", 0),
-	      ("0wx1", 0),
-	      ("0wX1", 0),
-	      ("0wx ", 0),
-	      ("0wX ", 0)];
+              (" \n\t10010crap", 18),
+              ("0w10010", 18),
+              (" \n\t0w10010crap", 18),
+              ("0", 0),
+              ("0w", 0),
+              ("0W1", 0),
+              ("0w ", 0),
+              ("0wx", 0),
+              ("0wX", 0),
+              ("0wx1", 0),
+              ("0wX1", 0),
+              ("0wx ", 0),
+              ("0wX ", 0)];
 val _ = pr_ln "test15a" (concat test15a)
 val test15b = 
     List.map (fn s => case StringCvt.scanString (scan StringCvt.BIN) s 
-	              of NONE => "OK" | _ => "WRONG")
-	   ["", "-", "~", "+", " \n\t", " \n\t-", " \n\t~", " \n\t+", 
-	    "+1", "~1", "-1", "2", "8", "ff"];
+                      of NONE => "OK" | _ => "WRONG")
+           ["", "-", "~", "+", " \n\t", " \n\t-", " \n\t~", " \n\t+", 
+            "+1", "~1", "-1", "2", "8", "ff"];
 val _ = pr_ln "test15b" (concat test15b)
 val test16a = 
     List.map (chkScan StringCvt.OCT)
              [("2071", 1081),
-	      (" \n\t2071crap", 1081),
-	      ("0w2071", 1081),
-	      (" \n\t0w2071crap", 1081),
-	      ("0", 0),
-	      ("0w", 0),
-	      ("0W1", 0),
-	      ("0w ", 0),
-	      ("0wx", 0),
-	      ("0wX", 0),
-	      ("0wx1", 0),
-	      ("0wX1", 0),
-	      ("0wx ", 0),
-	      ("0wX ", 0)];
+              (" \n\t2071crap", 1081),
+              ("0w2071", 1081),
+              (" \n\t0w2071crap", 1081),
+              ("0", 0),
+              ("0w", 0),
+              ("0W1", 0),
+              ("0w ", 0),
+              ("0wx", 0),
+              ("0wX", 0),
+              ("0wx1", 0),
+              ("0wX1", 0),
+              ("0wx ", 0),
+              ("0wX ", 0)];
 val _ = pr_ln "test16a" (concat test16a)
 val test16b = 
     List.map (fn s => case StringCvt.scanString (scan StringCvt.OCT) s 
-	              of NONE => "OK" | _ => "WRONG")
-	   ["", "-", "~", "+", " \n\t", " \n\t-", " \n\t~", " \n\t+", 
-	    "+1", "~1", "-1", "8", "ff"];
+                      of NONE => "OK" | _ => "WRONG")
+           ["", "-", "~", "+", " \n\t", " \n\t-", " \n\t~", " \n\t+", 
+            "+1", "~1", "-1", "8", "ff"];
 val _ = pr_ln "test16b" (concat test16b)
 val test17a = 
     List.map (chkScan StringCvt.HEX)
              [("20Af", 8367), (" \n\t20AfGrap", 8367),
-	      ("0wx20Af", 8367), (" \n\t0wx20AfGrap", 8367),
-	      ("0wX20Af", 8367), (" \n\t0wX20AfGrap", 8367),
-	      ("0x20Af", 8367), (" \n\t0x20AfGrap", 8367),
-	      ("0X20Af", 8367), (" \n\t0X20AfGrap", 8367),
-	      ("0", 0),
-	      ("0w", 0),
-	      ("0w ", 0),
-	      ("0w1", 0 (*1*)),
-	      ("0W1", 0),
-	      ("0wx", 0),
-	      ("0wX", 0),
-	      ("0wx1", 1),
-	      ("0wX1", 1)];
+              ("0wx20Af", 8367), (" \n\t0wx20AfGrap", 8367),
+              ("0wX20Af", 8367), (" \n\t0wX20AfGrap", 8367),
+              ("0x20Af", 8367), (" \n\t0x20AfGrap", 8367),
+              ("0X20Af", 8367), (" \n\t0X20AfGrap", 8367),
+              ("0", 0),
+              ("0w", 0),
+              ("0w ", 0),
+              ("0w1", 0 (*1*)),
+              ("0W1", 0),
+              ("0wx", 0),
+              ("0wX", 0),
+              ("0wx1", 1),
+              ("0wX1", 1)];
 val _ = pr_ln "test17a" (concat test17a)
 val test17b = 
     List.map (fn s => case StringCvt.scanString (scan StringCvt.HEX) s 
-	              of NONE => "OK" | _ => "WRONG")
-	   ["", "-", "~", "+", " \n\t", " \n\t-", " \n\t~", " \n\t+", 
-	    "+1", "~1", "-1"];
+                      of NONE => "OK" | _ => "WRONG")
+           ["", "-", "~", "+", " \n\t", " \n\t-", " \n\t~", " \n\t+", 
+            "+1", "~1", "-1"];
 val _ = pr_ln "test17b" (concat test17b)
 end;
 
 local 
     fun fromToString i = 
-	fromString (toString (fromInt i)) = SOME (fromInt i);
+        fromString (toString (fromInt i)) = SOME (fromInt i);
 
     fun scanFmt radix i = 
-	let val w = fromInt i
-	    val s = fmt radix w
-	in StringCvt.scanString (scan radix) s = SOME w end;
+        let val w = fromInt i
+            val s = fmt radix w
+        in StringCvt.scanString (scan radix) s = SOME w end;
 
 in
 val test18 = 

Modified: mlton/branches/on-20050420-cmm-branch/regression/word8array.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/word8array.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/word8array.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -8,7 +8,7 @@
 fun range (from, to) p = 
     let open Int 
     in
-	(from > to) orelse (p from) andalso (range (from+1, to) p)
+        (from > to) orelse (p from) andalso (range (from+1, to) p)
     end;
 
 fun checkrange bounds = check o range bounds;
@@ -34,7 +34,7 @@
     val array0 = fromList [];
     val copy = fn {src, si, len, dst, di} =>
       Word8ArraySlice.copy {src = Word8ArraySlice.slice (src, si, len),
-			    dst = dst, di = di}
+                            dst = dst, di = di}
     val extract = fn (a, i, sz) =>
       Word8ArraySlice.vector (Word8ArraySlice.slice (a, i, sz))
 in
@@ -50,22 +50,22 @@
 val test1:unit = tst' "test1" (fn () => a<>c);
 val test2:unit = tst' "test2" 
   (fn () => 
-	   array(0, w127) <> array0
-	   andalso array(0, w127) <> tabulate(0, fn _ => w127)
-	   andalso tabulate(0, fn _ => w127) <> fromList []
-	   andalso array(0, w127) <> array(0, w127)
-	   andalso tabulate(0, fn _ => w127) <> tabulate(0, fn _ => w127)
-	   andalso fromList [] <> fromList [])
+           array(0, w127) <> array0
+           andalso array(0, w127) <> tabulate(0, fn _ => w127)
+           andalso tabulate(0, fn _ => w127) <> fromList []
+           andalso array(0, w127) <> array(0, w127)
+           andalso tabulate(0, fn _ => w127) <> tabulate(0, fn _ => w127)
+           andalso fromList [] <> fromList [])
 
 val d = tabulate(100, fn i => i2w (i mod 7))
 
 val test3:unit = tst' "test3" (fn () => d sub 27 = i2w 6)
 
 val test4a:unit = tst0 "test4a" ((tabulate(maxLen+1, i2w) seq "WRONG")
-			    handle Overflow => "OK" | Size => "OK" | _ => "WRONG")
+                            handle Overflow => "OK" | Size => "OK" | _ => "WRONG")
 
 val test4b:unit = tst0 "test4b" ((tabulate(~1, i2w)       seq "WRONG")
-			    handle Size => "OK" | _ => "WRONG")
+                            handle Size => "OK" | _ => "WRONG")
 
 val test4c:unit = 
     tst' "test4c" (fn () => length (tabulate(0, fn i => i2w (i div 0))) = 0);
@@ -79,18 +79,18 @@
 
 val e = array(203, i2w 0);
 val _ = (copy{src=d, si=0, dst=e, di=0,        len=NONE}; 
-	 copy{src=b, si=0, dst=e, di=length d, len=NONE};
-	 copy{src=d, si=0, dst=e, di=length d + length b, len=NONE});
-	 
+         copy{src=b, si=0, dst=e, di=length d, len=NONE};
+         copy{src=d, si=0, dst=e, di=length d + length b, len=NONE});
+         
 fun a2v a = extract(a, 0, NONE);
 val ev = Word8Vector.concat [a2v d, a2v b, a2v d];
 
 val test7:unit = tst' "test7" (fn () => length e = 203);
 
 val test8a:unit = tst0 "test8a" ((update(e, ~1, w127); "WRONG")
-			    handle Subscript => "OK" | _ => "WRONG")
+                            handle Subscript => "OK" | _ => "WRONG")
 val test8b:unit = tst0 "test8b" ((update(e, length e, w127); "WRONG")
-			    handle Subscript => "OK" | _ => "WRONG")
+                            handle Subscript => "OK" | _ => "WRONG")
 
 val f = extract (e, 100, SOME 3);
 
@@ -99,9 +99,9 @@
       val n = Word8Vector.length v
       val n' = Word8Vector.length v'
       fun loop i =
-	 i = n
-	 orelse (Word8Vector.sub (v, i) = Word8Vector.sub (v', i)
-		 andalso loop (i + 1))
+         i = n
+         orelse (Word8Vector.sub (v, i) = Word8Vector.sub (v', i)
+                 andalso loop (i + 1))
    in
       n = n' andalso loop 0
    end
@@ -109,36 +109,36 @@
 val test9:unit = tst' "test9" (fn () => equal (f, a2v b));
 
 val test9a:unit = tst' "test9a" (fn () => equal (ev, extract(e, 0, NONE))
-				 andalso equal (ev, extract(e, 0, SOME (length e))));
+                                 andalso equal (ev, extract(e, 0, SOME (length e))));
 val test9b:unit = 
     tst' "test9b" (fn () => equal (Word8Vector.fromList [],
-				   extract(e, 100, SOME 0)));
+                                   extract(e, 100, SOME 0)));
 val test9c:unit = tst0 "test9c" ((extract(e, ~1, SOME (length e))  seq "WRONG") 
-			    handle Subscript => "OK" | _ => "WRONG")
+                            handle Subscript => "OK" | _ => "WRONG")
 val test9d:unit = tst0 "test9d" ((extract(e, length e+1, SOME 0) seq "WRONG") 
-			    handle Subscript => "OK" | _ => "WRONG")
+                            handle Subscript => "OK" | _ => "WRONG")
 val test9e:unit = tst0 "test9e" ((extract(e, 0, SOME (length e+1)) seq "WRONG") 
-			    handle Subscript => "OK" | _ => "WRONG")
+                            handle Subscript => "OK" | _ => "WRONG")
 val test9f:unit = tst0 "test9f" ((extract(e, 20, SOME ~1)        seq "WRONG") 
-			    handle Subscript => "OK" | _ => "WRONG")
+                            handle Subscript => "OK" | _ => "WRONG")
 val test9g:unit = tst0 "test9g" ((extract(e, ~1, NONE)  seq "WRONG") 
-			    handle Subscript => "OK" | _ => "WRONG")
+                            handle Subscript => "OK" | _ => "WRONG")
 val test9h:unit = tst0 "test9h" ((extract(e, length e+1, NONE) seq "WRONG") 
-			    handle Subscript => "OK" | _ => "WRONG")
+                            handle Subscript => "OK" | _ => "WRONG")
 val test9i:unit = 
     tst' "test9i" (fn () => equal (a2v (fromList []),
-				   extract(e, length e, SOME 0))
-		   andalso equal (a2v (fromList []),
-				  extract(e, length e, NONE)));
+                                   extract(e, length e, SOME 0))
+                   andalso equal (a2v (fromList []),
+                                  extract(e, length e, NONE)));
 
 val _ = copy{src=e, si=0, dst=e, di=0, len=NONE};
 val g = array(203, w127);
 val _ = copy{src=e, si=0, dst=g, di=0, len=NONE};
 
 val test10a:unit = tst' "test10a" (fn () => equal (ev, extract(e, 0, NONE))
-			      andalso equal (ev, extract(e, 0, SOME (length e))));
+                              andalso equal (ev, extract(e, 0, SOME (length e))));
 val test10b:unit = tst' "test10b" (fn () => equal (ev, extract(g, 0, NONE))
-			      andalso equal (ev, extract(g, 0, SOME (length g))));
+                              andalso equal (ev, extract(g, 0, SOME (length g))));
 
 val _ = copy{src=g, si=203, dst=g, di=0, len=SOME 0};
 val test10c:unit = tst' "test10c" (fn () => equal (ev, extract(g, 0, NONE)));
@@ -155,34 +155,34 @@
 val _ = copy{src=g, si=202, dst=g, di=202, len=SOME 1};
 val test10g:unit = tst' "test10g" (fn () => g sub 202 = i2w ((202-1-103) mod 7));
 val test10h:unit = tst' "test10h" (fn () =>
-			      (copy{src=array0, si=0, dst=array0, di=0, len=NONE}; 
-			       array0 <> array(0, w127)));
+                              (copy{src=array0, si=0, dst=array0, di=0, len=NONE}; 
+                               array0 <> array(0, w127)));
 val test10i:unit = tst' "test10i" (fn () =>
-			       (copy{src=array0, si=0, dst=array0, di=0, len=SOME 0}; 
-				array0 <> array(0, w127)));
+                               (copy{src=array0, si=0, dst=array0, di=0, len=SOME 0}; 
+                                array0 <> array(0, w127)));
 
 val test11a:unit = tst0 "test11a" ((copy{src=g, si= ~1, dst=g, di=0, len=NONE}; "WRONG") 
-			      handle Subscript => "OK" | _ => "WRONG")
+                              handle Subscript => "OK" | _ => "WRONG")
 val test11b:unit = tst0 "test11b" ((copy{src=g, si=0, dst=g, di= ~1, len=NONE}; "WRONG") 
-			      handle Subscript => "OK" | _ => "WRONG")
+                              handle Subscript => "OK" | _ => "WRONG")
 val test11c:unit = tst0 "test11c" ((copy{src=g, si=1, dst=g, di=0, len=NONE}; "OK") 
-			      handle _ => "WRONG")
+                              handle _ => "WRONG")
 val test11d:unit = tst0 "test11d" ((copy{src=g, si=0, dst=g, di=1, len=NONE}; "WRONG") 
-			      handle Subscript => "OK" | _ => "WRONG")
+                              handle Subscript => "OK" | _ => "WRONG")
 val test11e:unit = tst0 "test11e" ((copy{src=g, si=203, dst=g, di=0, len=NONE}; "OK") 
-			      handle _ => "WRONG")
+                              handle _ => "WRONG")
 
 val test11f:unit = tst0 "test11f" ((copy{src=g, si= ~1, dst=g, di=0, len=SOME (length g)}; "WRONG") 
-			      handle Subscript => "OK" | _ => "WRONG")
+                              handle Subscript => "OK" | _ => "WRONG")
 val test11g:unit = tst0 "test11g" ((copy{src=g, si=0, dst=g, di= ~1, len=SOME (length g)}; "WRONG") 
-			      handle Subscript => "OK" | _ => "WRONG")
+                              handle Subscript => "OK" | _ => "WRONG")
 val test11h:unit = tst0 "test11h" ((copy{src=g, si=1, dst=g, di=0, len=SOME (length g)}; "WRONG") 
-			      handle Subscript => "OK" | _ => "WRONG")
+                              handle Subscript => "OK" | _ => "WRONG")
 val test11i:unit = tst0 "test11i" ((copy{src=g, si=0, dst=g, di=1, len=SOME (length g)}; "WRONG") 
-			      handle Subscript => "OK" | _ => "WRONG")
+                              handle Subscript => "OK" | _ => "WRONG")
 val test11j:unit = tst0 "test11j" ((copy{src=g, si=0, dst=g, di=0, len=SOME (length g+1)}; "WRONG") 
-			      handle Subscript => "OK" | _ => "WRONG")
+                              handle Subscript => "OK" | _ => "WRONG")
 val test11k:unit = tst0 "test11k" ((copy{src=g, si=203, dst=g, di=0, len=SOME 1}; "WRONG") 
-			      handle Subscript => "OK" | _ => "WRONG")
+                              handle Subscript => "OK" | _ => "WRONG")
 
 end;

Modified: mlton/branches/on-20050420-cmm-branch/regression/word8vector.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/word8vector.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/word8vector.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -10,7 +10,7 @@
 fun range (from, to) p = 
     let open Int 
     in
-	(from > to) orelse (p from) andalso (range (from+1, to) p)
+        (from > to) orelse (p from) andalso (range (from+1, to) p)
     end;
 
 fun checkrange bounds = check o range bounds;
@@ -47,9 +47,9 @@
       val n = Word8Vector.length v
       val n' = Word8Vector.length v'
       fun loop i =
-	 i = n
-	 orelse (Word8Vector.sub (v, i) = Word8Vector.sub (v', i)
-		 andalso loop (i + 1))
+         i = n
+         orelse (Word8Vector.sub (v, i) = Word8Vector.sub (v', i)
+                 andalso loop (i + 1))
    in
       n = n' andalso loop 0
    end
@@ -62,10 +62,10 @@
 val test3:unit = tst' "test3" (fn _ => d sub 27 = i2w 6);
 
 val test4a:unit = tst0 "test4a" ((tabulate(maxLen+1, i2w) seq "WRONG")
-			    handle Overflow => "OK" | Size => "OK" | _ => "WRONG")
+                            handle Overflow => "OK" | Size => "OK" | _ => "WRONG")
 
 val test4b:unit = tst0 "test4b" ((tabulate(~1, i2w)       seq "WRONG")
-			    handle Size => "OK" | _ => "WRONG")
+                            handle Size => "OK" | _ => "WRONG")
 
 val test4c:unit = tst' "test4c" (fn _ => length (tabulate(0, fn i => i2w (i div 0))) = 0);
 
@@ -86,35 +86,35 @@
 val test9:unit = tst' "test9" (fn _ => equal (f, b));
 
 val test9a:unit = tst' "test9a" (fn _ => equal (e, extract(e, 0, SOME (length e))) 
-				 andalso equal (e, extract(e, 0, NONE)));
+                                 andalso equal (e, extract(e, 0, NONE)));
 val test9b:unit = tst' "test9b" (fn _ => equal (fromList [],
-						extract(e, 100, SOME 0)));
+                                                extract(e, 100, SOME 0)));
 val test9c:unit = tst0 "test9c" ((extract(e, ~1, SOME (length e))  seq "WRONG") 
-			    handle Subscript => "OK" | _ => "WRONG")
+                            handle Subscript => "OK" | _ => "WRONG")
 val test9d:unit = tst0 "test9d" ((extract(e, length e + 1, SOME 0)  seq "WRONG") 
-			    handle Subscript => "OK" | _ => "WRONG")
+                            handle Subscript => "OK" | _ => "WRONG")
 val test9e:unit = tst0 "test9e" ((extract(e, 0, SOME (length e+1)) seq "WRONG") 
-			    handle Subscript => "OK" | _ => "WRONG")
+                            handle Subscript => "OK" | _ => "WRONG")
 val test9f:unit = tst0 "test9f" ((extract(e, 20, SOME ~1)        seq "WRONG") 
-			    handle Subscript => "OK" | _ => "WRONG")
+                            handle Subscript => "OK" | _ => "WRONG")
 val test9g:unit = tst0 "test9g" ((extract(e, ~1, NONE)  seq "WRONG") 
-			    handle Subscript => "OK" | _ => "WRONG")
+                            handle Subscript => "OK" | _ => "WRONG")
 val test9h:unit = tst0 "test9h" ((extract(e, length e + 1, NONE)  seq "WRONG") 
-			    handle Subscript => "OK" | _ => "WRONG")
+                            handle Subscript => "OK" | _ => "WRONG")
 val test9i:unit = tst' "test9i" (fn _ => equal (fromList [], extract (e, length e, SOME 0))
-				 andalso equal (fromList [], extract(e, length e, NONE)));
+                                 andalso equal (fromList [], extract(e, length e, NONE)));
 
 fun chkiter iter f vec (res', last') =
     tst' "test_chkiter" (fn _ =>
-	   let val last = ref (0w255:word8)
-	       val res = iter (fn x => (last := x; f x)) vec
-	   in equal (res, res') andalso !last = last' end)
+           let val last = ref (0w255:word8)
+               val res = iter (fn x => (last := x; f x)) vec
+           in equal (res, res') andalso !last = last' end)
 
 fun chkiteri iter f vec (res', last') =
     tst' "test_chkiteri" (fn _ =>
-	   let val last = ref ~1
-	       val res = iter (fn (i, x) => (last := i; f x)) vec
-	   in equal (res, res') andalso  !last = last' end)
+           let val last = ref ~1
+               val res = iter (fn (i, x) => (last := i; f x)) vec
+           in equal (res, res') andalso  !last = last' end)
 
 val test10a:unit = 
     chkiter map (fn x => 0w2*x) b (fromList [0w88,0w110,0w132], 0w66)
@@ -132,14 +132,14 @@
 
 val test11f:unit =
     tst0 "test11f" ((mapi #2 (b, 0, SOME 4) seq "WRONG") 
-		    handle Subscript => "OK" | _ => "WRONG")
+                    handle Subscript => "OK" | _ => "WRONG")
 val test11g:unit =
     tst0 "test11g" ((mapi #2 (b, 3, SOME 1) seq "WRONG") 
-		    handle Subscript => "OK" | _ => "WRONG")
+                    handle Subscript => "OK" | _ => "WRONG")
 val test11h:unit =
     tst0 "test11h" ((mapi #2 (b, 4, SOME 0) seq "WRONG") 
-		    handle Subscript => "OK" | _ => "WRONG")
+                    handle Subscript => "OK" | _ => "WRONG")
 val test11i:unit =
     tst0 "test11i" ((mapi #2 (b, 4, NONE) seq "WRONG") 
-		    handle Subscript => "OK" | _ => "WRONG")
+                    handle Subscript => "OK" | _ => "WRONG")
 end;

Modified: mlton/branches/on-20050420-cmm-branch/regression/world1.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/world1.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/world1.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,16 +1,16 @@
 fun run (f: unit -> unit) =
    case Posix.Process.fork () of
       SOME pid =>
-	 let
-	    open Posix.Process
-	    val (pid', status) = waitpid (W_CHILD pid, [])
-	 in if pid = pid' andalso status = W_EXITED
-	       then ()
-	    else raise Fail "child failed"
-	 end
+         let
+            open Posix.Process
+            val (pid', status) = waitpid (W_CHILD pid, [])
+         in if pid = pid' andalso status = W_EXITED
+               then ()
+            else raise Fail "child failed"
+         end
     | NONE => let open OS.Process
-	      in exit ((f (); success) handle _ => failure)
-	      end
+              in exit ((f (); success) handle _ => failure)
+              end
 
 fun succeed () =
    let open OS.Process

Modified: mlton/branches/on-20050420-cmm-branch/regression/world2.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/world2.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/world2.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,16 +1,16 @@
 fun run (f: unit -> unit) =
    case Posix.Process.fork () of
       SOME pid =>
-	 let
-	    open Posix.Process
-	    val (pid', status) = waitpid (W_CHILD pid, [])
-	 in if pid = pid' andalso status = W_EXITED
-	       then ()
-	    else raise Fail "child failed"
-	 end
+         let
+            open Posix.Process
+            val (pid', status) = waitpid (W_CHILD pid, [])
+         in if pid = pid' andalso status = W_EXITED
+               then ()
+            else raise Fail "child failed"
+         end
     | NONE => let open OS.Process
-	      in exit ((f (); success) handle _ => failure)
-	      end
+              in exit ((f (); success) handle _ => failure)
+              end
 
 fun succeed () =
    let open OS.Process
@@ -28,9 +28,9 @@
     case save w of
        Original => ()
      | Clone => (Array.update (a, 0, 13)
-		 ; print (concat [Int.toString (Array.sub (a, 0) + Array.sub (a, 1)),
-				"\n"])
-		 ; succeed ())
+                 ; print (concat [Int.toString (Array.sub (a, 0) + Array.sub (a, 1)),
+                                "\n"])
+                 ; succeed ())
 
 val _ = run (fn () => load w)
    

Modified: mlton/branches/on-20050420-cmm-branch/regression/world3.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/world3.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/world3.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,16 +1,16 @@
 fun run (f: unit -> unit) =
    case Posix.Process.fork () of
       SOME pid =>
-	 let
-	    open Posix.Process
-	    val (pid', status) = waitpid (W_CHILD pid, [])
-	 in if pid = pid' andalso status = W_EXITED
-	       then ()
-	    else raise Fail "child failed"
-	 end
+         let
+            open Posix.Process
+            val (pid', status) = waitpid (W_CHILD pid, [])
+         in if pid = pid' andalso status = W_EXITED
+               then ()
+            else raise Fail "child failed"
+         end
     | NONE => let open OS.Process
-	      in exit ((f (); success) handle _ => failure)
-	      end
+              in exit ((f (); success) handle _ => failure)
+              end
 
 fun succeed () =
    let open OS.Process
@@ -27,8 +27,8 @@
 fun f n =
    if n = 0
       then (case save w of
-	       Original => 0
-	     | Clone => raise Foo)
+               Original => 0
+             | Clone => raise Foo)
    else f (n - 1) + 1
 
 val _ = (f 13; ()) handle Foo => (print "caught foo\n"; succeed ())

Modified: mlton/branches/on-20050420-cmm-branch/regression/world4.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/world4.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/world4.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,16 +1,16 @@
 fun run (f: unit -> unit) =
    case Posix.Process.fork () of
       SOME pid =>
-	 let
-	    open Posix.Process
-	    val (pid', status) = waitpid (W_CHILD pid, [])
-	 in if pid = pid' andalso status = W_EXITED
-	       then ()
-	    else raise Fail "child failed"
-	 end
+         let
+            open Posix.Process
+            val (pid', status) = waitpid (W_CHILD pid, [])
+         in if pid = pid' andalso status = W_EXITED
+               then ()
+            else raise Fail "child failed"
+         end
     | NONE => let open OS.Process
-	      in exit ((f (); success) handle _ => failure)
-	      end
+              in exit ((f (); success) handle _ => failure)
+              end
 
 fun succeed () =
    let open OS.Process
@@ -29,20 +29,20 @@
 val original = ref true
    
 val _ = (case save w1 of
-	    Clone => original := false
-	  | Original => ())
+            Clone => original := false
+          | Original => ())
 
 val _ = print "between saves\n"
 
 val _ = (case save w2 of
-	    Clone => original := false
-	  | Original => ())
+            Clone => original := false
+          | Original => ())
 
 val _ = print "after saves\n"
 
 val _ = if !original
-	   then (run (fn () => load w1)
-		 ; run (fn () => load w2)
-		 ; OS.FileSys.remove w1
-		 ; OS.FileSys.remove w2)
-	else ()
+           then (run (fn () => load w1)
+                 ; run (fn () => load w2)
+                 ; OS.FileSys.remove w1
+                 ; OS.FileSys.remove w2)
+        else ()

Modified: mlton/branches/on-20050420-cmm-branch/regression/world5.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/world5.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/world5.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,16 +1,16 @@
 fun run (f: unit -> unit) =
    case Posix.Process.fork () of
       SOME pid =>
-	 let
-	    open Posix.Process
-	    val (pid', status) = waitpid (W_CHILD pid, [])
-	 in if pid = pid' andalso status = W_EXITED
-	       then ()
-	    else raise Fail "child failed"
-	 end
+         let
+            open Posix.Process
+            val (pid', status) = waitpid (W_CHILD pid, [])
+         in if pid = pid' andalso status = W_EXITED
+               then ()
+            else raise Fail "child failed"
+         end
     | NONE => let open OS.Process
-	      in exit ((f (); success) handle _ => failure)
-	      end
+              in exit ((f (); success) handle _ => failure)
+              end
 
 fun succeed () =
    let open OS.Process
@@ -33,29 +33,29 @@
 val _ =
    case fork () of
       NONE =>
-	 let
-	    val canExit = ref false
-	 in
-	    setHandler (usr1, Handler.handler (fn t => (canExit := true
-							; saveThread (w, t)
-							; t)))
-	    ; kill (K_PROC parent, usr1)
-	    ; let
-		 fun loop () = if !canExit then print "success\n" else loop ()
-	      in
-		 loop ()
-	      end
-	    ; let open OS.Process
-	      in exit success
-	      end
-	 end
+         let
+            val canExit = ref false
+         in
+            setHandler (usr1, Handler.handler (fn t => (canExit := true
+                                                        ; saveThread (w, t)
+                                                        ; t)))
+            ; kill (K_PROC parent, usr1)
+            ; let
+                 fun loop () = if !canExit then print "success\n" else loop ()
+              in
+                 loop ()
+              end
+            ; let open OS.Process
+              in exit success
+              end
+         end
     | SOME child =>
-	 let
-	    fun loop () = if !childReady then () else loop ()
-	 in
-	    loop ()
-	    ; kill (K_PROC child, usr1)
-	    ; wait ()
-	    ; run (fn () => load w)
-	    ; OS.FileSys.remove w
-	 end
+         let
+            fun loop () = if !childReady then () else loop ()
+         in
+            loop ()
+            ; kill (K_PROC child, usr1)
+            ; wait ()
+            ; run (fn () => load w)
+            ; OS.FileSys.remove w
+         end

Modified: mlton/branches/on-20050420-cmm-branch/regression/world6.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/regression/world6.sml	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/regression/world6.sml	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,16 +1,16 @@
 fun run(f: unit -> unit) =
    case Posix.Process.fork() of
       SOME pid =>
-	 let
-	    open Posix.Process
-	    val (pid', status) = waitpid(W_CHILD pid, [])
-	 in if pid = pid' andalso status = W_EXITED
-	       then ()
-	    else raise Fail "child failed"
-	 end
+         let
+            open Posix.Process
+            val (pid', status) = waitpid(W_CHILD pid, [])
+         in if pid = pid' andalso status = W_EXITED
+               then ()
+            else raise Fail "child failed"
+         end
     | NONE => let open OS.Process
-	      in exit((f(); success) handle _ => failure)
-	      end
+              in exit((f(); success) handle _ => failure)
+              end
 
 fun succeed() =
    let open OS.Process
@@ -25,15 +25,15 @@
 val _ =
    case save w of
       Clone =>
-	 let
-	    fun p s = (print s; print "\n")
-	 in p (CommandLine.name ())
-	    ; List.app p (CommandLine.arguments ())
-	    ; succeed ()
-	 end
+         let
+            fun p s = (print s; print "\n")
+         in p (CommandLine.name ())
+            ; List.app p (CommandLine.arguments ())
+            ; succeed ()
+         end
     | Original => ()
-	 
+         
 val _ = OS.Process.system (concat[CommandLine.name (),
-				  " @MLton load-world ", w, " -- a b c"])
+                                  " @MLton load-world ", w, " -- a b c"])
    
 val _ = OS.FileSys.remove w


Property changes on: mlton/branches/on-20050420-cmm-branch/runtime
___________________________________________________________________
Name: svn:ignore
   - gdtoa
runtime.c
   + *.a
gdtoa
runtime.c


Deleted: mlton/branches/on-20050420-cmm-branch/runtime/.cvsignore
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/.cvsignore	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/.cvsignore	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,2 +0,0 @@
-gdtoa
-runtime.c

Copied: mlton/branches/on-20050420-cmm-branch/runtime/.ignore (from rev 4358, mlton/trunk/runtime/.ignore)

Modified: mlton/branches/on-20050420-cmm-branch/runtime/Makefile
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/Makefile	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/Makefile	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,10 @@
-# Copyright (C) 2004 Henry Cejtin, Matthew Fluet, Suresh
-#    Jagannathan, and Stephen Weeks.
-#
-# MLton is released under the GNU General Public License (GPL).
-# Please see the file MLton-LICENSE for license information.
-#
+## Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ #    Jagannathan, and Stephen Weeks.
+ # Copyright (C) 1997-2000 NEC Research Institute.
+ #
+ # MLton is released under a BSD-style license.
+ # See the file MLton-LICENSE for details.
+ ##
 
 PATH = ../bin:$(shell echo $$PATH)
 
@@ -15,18 +16,27 @@
 FLAGS = -fomit-frame-pointer
 
 ifeq ($(TARGET_ARCH), x86)
-FLAGS += -mcpu=pentiumpro 
-ifeq ($(GCC_VERSION), 3)
+ifneq ($(findstring $(GCC_VERSION), 3 4),)
 FLAGS += -falign-loops=2 -falign-jumps=2 -falign-functions=5
 else
 FLAGS += -malign-loops=2 -malign-jumps=2 -malign-functions=5
 endif
 endif
+
+ifeq ($(TARGET_ARCH), amd64)
+FLAGS += -mtune=opteron -m32
+endif
+
 ifeq ($(TARGET_ARCH), sparc)
-FLAGS += -mv8 -m32
+FLAGS += -mcpu=v8 -m32
 endif
+
+ifeq ($(TARGET_OS), freebsd)
+FLAGS += -I/usr/local/include
+endif
+
 ifeq ($(TARGET_OS), solaris)
-FLAGS += -Wa,-xarch=v8plusa -fcall-used-g5 -fcall-used-g7 -funroll-all-loops -mcpu=ultrasparc
+FLAGS += -Wa,-xarch=v8plusa -funroll-all-loops -mcpu=ultrasparc
 endif
 
 ifeq ($(TARGET), self)
@@ -38,7 +48,7 @@
 FLAGS += -b $(TARGET)
 endif
 
-CC = gcc -std=c99
+CC = gcc -std=gnu99
 CFLAGS = -O2 -Wall -I. -Iplatform -D_FILE_OFFSET_BITS=32 $(FLAGS)
 DEBUGFLAGS = $(CFLAGS) -gstabs+ -g2
 
@@ -93,7 +103,7 @@
 	$(RANLIB) libgdtoa.a
 
 gdtoa/arithchk.c:
-	zcat gdtoa.tgz | tar xf -	
+	gzip -dc gdtoa.tgz | tar xf -	
 	patch -p0 <gdtoa-patch
 
 gdtoa/arithchk.out: gdtoa/arithchk.c
@@ -119,7 +129,9 @@
 # are class.c and gdtoa.c.  But there may be others.  So, we compile
 # with -fno-strict-aliasing to prevent gcc from taking advantage of
 # this aspect of the C spec.
-basis/Real/%.o: basis/Real/%.c
+basis/Real/%-gdb.o: basis/Real/%.c gdtoa/arith.h
+	$(CC) $(DEBUGFLAGS) -O1 -DASSERT=1 -c -o $@ $<
+basis/Real/%.o: basis/Real/%.c gdtoa/arith.h
 	$(CC) $(CFLAGS) -O1 -fno-strict-aliasing -c -o $@ $<
 
 %-gdb.o: %.c $(HFILES)
@@ -142,7 +154,7 @@
 gdtoa-patch:
 	cd gdtoa && $(MAKE) clean && rm -f &~
 	mv gdtoa gdtoa-new
-	zcat gdtoa.tgz | tar xf -
+	gzip -dc gdtoa.tgz | tar xf -
 	diff -P -C 2 -r gdtoa gdtoa-new >gdtoa-patch || exit 0
 	rm -rf gdtoa
 	mv gdtoa-new gdtoa

Modified: mlton/branches/on-20050420-cmm-branch/runtime/Posix/Error.c
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/Posix/Error.c	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/Posix/Error.c	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,13 +1,13 @@
 #include "platform.h"
 
 void Posix_Error_clearErrno () {
-	errno = 0;
+        errno = 0;
 }
 
 int Posix_Error_getErrno () {
-	return errno;
+        return errno;
 }
 
 Cstring Posix_Error_strerror (Syserror n) {
-	return (Cstring)(strerror (n));
+        return (Cstring)(strerror (n));
 }

Modified: mlton/branches/on-20050420-cmm-branch/runtime/Posix/FileSys/Dirstream.c
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/Posix/FileSys/Dirstream.c	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/Posix/FileSys/Dirstream.c	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,43 +1,43 @@
 #include "platform.h"
 
 enum {
-	DEBUG_DIRSTREAM = FALSE,
+        DEBUG_DIRSTREAM = FALSE,
 };
 
 Int Posix_FileSys_Dirstream_closedir (Cpointer p) {
-	Int res;
+        Int res;
 
-	res = (Int)(closedir ((DIR *) p));
-	if (DEBUG_DIRSTREAM)
-		fprintf (stderr, "%d = closedir (0x%08x)\n", (uint)res, (uint)p);
-	return res;
+        res = (Int)(closedir ((DIR *) p));
+        if (DEBUG_DIRSTREAM)
+                fprintf (stderr, "%d = closedir (0x%08x)\n", (uint)res, (uint)p);
+        return res;
 }
 
 Cpointer Posix_FileSys_Dirstream_opendir (Cpointer p) {
-	Cpointer res;
+        Cpointer res;
 
-	res = (Cpointer)(opendir ((char *) p));
-	if (DEBUG_DIRSTREAM)
-		fprintf (stderr, "0x%08x = opendir (%s)\n", 
-				(uint)res, (char *)p);
-	return res;
+        res = (Cpointer)(opendir ((char *) p));
+        if (DEBUG_DIRSTREAM)
+                fprintf (stderr, "0x%08x = opendir (%s)\n", 
+                                (uint)res, (char *)p);
+        return res;
 }
 
 Cstring Posix_FileSys_Dirstream_readdir (Cpointer d) {
-	struct dirent *e;
-	Cstring res;
-	
-	e = readdir ((DIR *) d);
-	res = (Cstring)((NULL == e) ? NULL : e->d_name);
-	if (DEBUG_DIRSTREAM)
-		fprintf (stderr, "%s = readdir (0x%08x)\n", 
-				((Cstring)NULL == res) ? "NULL": (char*)res,
-				(uint)d);
-	return res;
+        struct dirent *e;
+        Cstring res;
+        
+        e = readdir ((DIR *) d);
+        res = (Cstring)((NULL == e) ? NULL : e->d_name);
+        if (DEBUG_DIRSTREAM)
+                fprintf (stderr, "%s = readdir (0x%08x)\n", 
+                                ((Cstring)NULL == res) ? "NULL": (char*)res,
+                                (uint)d);
+        return res;
 }
 
 void Posix_FileSys_Dirstream_rewinddir (Cpointer p) {
-	if (DEBUG_DIRSTREAM)
-		fprintf (stderr, "rewinddir (0x%08x)\n", (uint)p);
-       	rewinddir ((DIR *) p);
+        if (DEBUG_DIRSTREAM)
+                fprintf (stderr, "rewinddir (0x%08x)\n", (uint)p);
+        rewinddir ((DIR *) p);
 }

Modified: mlton/branches/on-20050420-cmm-branch/runtime/Posix/FileSys/ST.c
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/Posix/FileSys/ST.c	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/Posix/FileSys/ST.c	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,29 +1,29 @@
 #include "platform.h"
 
 Bool Posix_FileSys_ST_isBlk (Word w) {
-	return S_ISBLK(w);
+        return S_ISBLK(w);
 }
 
 Bool Posix_FileSys_ST_isChr (Word w) {
-	return S_ISCHR (w);
+        return S_ISCHR (w);
 }
 
 Bool Posix_FileSys_ST_isDir (Word w) {
-	return S_ISDIR (w);
+        return S_ISDIR (w);
 }
 
 Bool Posix_FileSys_ST_isFIFO (Word w) {
-	return S_ISFIFO (w);
+        return S_ISFIFO (w);
 }
 
 Bool Posix_FileSys_ST_isLink (Word w) {
-	return S_ISLNK (w);
+        return S_ISLNK (w);
 }
 
 Bool Posix_FileSys_ST_isReg (Word w) {
-	return S_ISREG (w);
+        return S_ISREG (w);
 }
 
 Bool Posix_FileSys_ST_isSock (Word w) {
-	return S_ISSOCK (w);
+        return S_ISSOCK (w);
 }

Modified: mlton/branches/on-20050420-cmm-branch/runtime/Posix/FileSys/Stat.c
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/Posix/FileSys/Stat.c	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/Posix/FileSys/Stat.c	2006-02-16 19:34:54 UTC (rev 4361)
@@ -3,57 +3,57 @@
 static struct stat statbuf;
 
 Word Posix_FileSys_Stat_dev () {
-	return statbuf.st_dev;
+        return statbuf.st_dev;
 }
 
 Int Posix_FileSys_Stat_ino () {
-	return statbuf.st_ino;
+        return statbuf.st_ino;
 }
 
 Word Posix_FileSys_Stat_mode () {
-	return statbuf.st_mode;
+        return statbuf.st_mode;
 }
 
 Int Posix_FileSys_Stat_nlink () {
-	return statbuf.st_nlink;
+        return statbuf.st_nlink;
 }
 
 Word Posix_FileSys_Stat_uid () {
-	return statbuf.st_uid;
+        return statbuf.st_uid;
 }
 
 Word Posix_FileSys_Stat_gid () {
-	return statbuf.st_gid;
+        return statbuf.st_gid;
 }
 
 Word Posix_FileSys_Stat_rdev () {
-	return statbuf.st_rdev;
+        return statbuf.st_rdev;
 }
 
 Position Posix_FileSys_Stat_size () {
-	return statbuf.st_size;
+        return statbuf.st_size;
 }
 
 Int Posix_FileSys_Stat_atime () {
-	return statbuf.st_atime;
+        return statbuf.st_atime;
 }
 
 Int Posix_FileSys_Stat_mtime () {
-	return statbuf.st_mtime;
+        return statbuf.st_mtime;
 }
 
 Int Posix_FileSys_Stat_ctime () {
-	return statbuf.st_ctime;
+        return statbuf.st_ctime;
 }
 
 Int Posix_FileSys_Stat_fstat (Fd f) {
-	return fstat (f, &statbuf);
+        return fstat (f, &statbuf);
 }
 
 Int Posix_FileSys_Stat_lstat (NullString f) {
-	return lstat ((char*)f, &statbuf);
+        return lstat ((char*)f, &statbuf);
 }
 
-Int Posix_FileSys_Stat_stat (NullString f) {	
-	return stat ((char*)f, &statbuf);
+Int Posix_FileSys_Stat_stat (NullString f) {    
+        return stat ((char*)f, &statbuf);
 }

Modified: mlton/branches/on-20050420-cmm-branch/runtime/Posix/FileSys/Utimbuf.c
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/Posix/FileSys/Utimbuf.c	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/Posix/FileSys/Utimbuf.c	2006-02-16 19:34:54 UTC (rev 4361)
@@ -3,13 +3,13 @@
 static struct utimbuf utimbuf;
 
 void Posix_FileSys_Utimbuf_setActime (Int i) {
-	utimbuf.actime = i;
+        utimbuf.actime = i;
 }
 
 void Posix_FileSys_Utimbuf_setModTime (Int i) {
-	utimbuf.modtime = i;
+        utimbuf.modtime = i;
 } 
 
 Int Posix_FileSys_Utimbuf_utime (NullString s) {
-	return (Int)utime((char *)s, &utimbuf);
+        return (Int)utime((char *)s, &utimbuf);
 }

Modified: mlton/branches/on-20050420-cmm-branch/runtime/Posix/FileSys/access.c
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/Posix/FileSys/access.c	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/Posix/FileSys/access.c	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,5 +1,5 @@
 #include "platform.h"
 
 Int Posix_FileSys_access (NullString f, Word w) {
-	return access ((char *) f, w);
+        return access ((char *) f, w);
 }

Modified: mlton/branches/on-20050420-cmm-branch/runtime/Posix/FileSys/chdir.c
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/Posix/FileSys/chdir.c	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/Posix/FileSys/chdir.c	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,5 +1,5 @@
 #include "platform.h"
 
 Int Posix_FileSys_chdir(Cpointer p) {
-	return chdir((char *) p);
+        return chdir((char *) p);
 }

Modified: mlton/branches/on-20050420-cmm-branch/runtime/Posix/FileSys/chmod.c
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/Posix/FileSys/chmod.c	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/Posix/FileSys/chmod.c	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,5 +1,5 @@
 #include "platform.h"
 
 Int Posix_FileSys_chmod (NullString p, Mode m) {
-	return chmod ((char *) p, m);
+        return chmod ((char *) p, m);
 }

Modified: mlton/branches/on-20050420-cmm-branch/runtime/Posix/FileSys/chown.c
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/Posix/FileSys/chown.c	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/Posix/FileSys/chown.c	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,5 +1,5 @@
 #include "platform.h"
 
 Int Posix_FileSys_chown (NullString p, Uid u, Gid g) {
-	return chown ((char *) p, u, g);
+        return chown ((char *) p, u, g);
 }

Modified: mlton/branches/on-20050420-cmm-branch/runtime/Posix/FileSys/fchmod.c
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/Posix/FileSys/fchmod.c	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/Posix/FileSys/fchmod.c	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,5 +1,5 @@
 #include "platform.h"
 
 Int Posix_FileSys_fchmod (Fd f, Mode m) {
-	return fchmod (f, m);
+        return fchmod (f, m);
 }

Modified: mlton/branches/on-20050420-cmm-branch/runtime/Posix/FileSys/fchown.c
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/Posix/FileSys/fchown.c	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/Posix/FileSys/fchown.c	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,5 +1,5 @@
 #include "platform.h"
 
 Int Posix_FileSys_fchown (Fd f, Uid u, Gid g) {
-	return fchown (f, u, g);
+        return fchown (f, u, g);
 }

Modified: mlton/branches/on-20050420-cmm-branch/runtime/Posix/FileSys/fpathconf.c
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/Posix/FileSys/fpathconf.c	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/Posix/FileSys/fpathconf.c	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,5 +1,5 @@
 #include "platform.h"
 
 Int Posix_FileSys_fpathconf (Fd f, Int n) {
-	return fpathconf (f, n);
+        return fpathconf (f, n);
 }

Modified: mlton/branches/on-20050420-cmm-branch/runtime/Posix/FileSys/ftruncate.c
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/Posix/FileSys/ftruncate.c	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/Posix/FileSys/ftruncate.c	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,5 +1,5 @@
 #include "platform.h"
 
 Int Posix_FileSys_ftruncate (Fd f, Position n) {
-	return ftruncate (f, n);
+        return ftruncate (f, n);
 }

Modified: mlton/branches/on-20050420-cmm-branch/runtime/Posix/FileSys/getcwd.c
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/Posix/FileSys/getcwd.c	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/Posix/FileSys/getcwd.c	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,5 +1,5 @@
 #include "platform.h"
 
 Cstring Posix_FileSys_getcwd (Pointer buf, Size n) {
-	return (Cstring)(getcwd (buf, n));
+        return (Cstring)(getcwd (buf, n));
 }

Modified: mlton/branches/on-20050420-cmm-branch/runtime/Posix/FileSys/link.c
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/Posix/FileSys/link.c	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/Posix/FileSys/link.c	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,5 +1,5 @@
 #include "platform.h"
 
 Int Posix_FileSys_link (NullString p1, NullString p2) {
-	return link ((char *) p1, (char *) p2);
+        return link ((char *) p1, (char *) p2);
 }

Modified: mlton/branches/on-20050420-cmm-branch/runtime/Posix/FileSys/mkdir.c
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/Posix/FileSys/mkdir.c	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/Posix/FileSys/mkdir.c	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,5 +1,5 @@
 #include "platform.h"
 
 Int Posix_FileSys_mkdir (NullString p, Word w) {
-	return mkdir2 ((char *) p, w);
+        return mkdir2 ((char *) p, w);
 }

Modified: mlton/branches/on-20050420-cmm-branch/runtime/Posix/FileSys/mkfifo.c
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/Posix/FileSys/mkfifo.c	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/Posix/FileSys/mkfifo.c	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,5 +1,5 @@
 #include "platform.h"
 
 Int Posix_FileSys_mkfifo (NullString p, Word w) {
-	return mkfifo ((char *) p, w);
+        return mkfifo ((char *) p, w);
 }

Modified: mlton/branches/on-20050420-cmm-branch/runtime/Posix/FileSys/open.c
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/Posix/FileSys/open.c	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/Posix/FileSys/open.c	2006-02-16 19:34:54 UTC (rev 4361)
@@ -5,15 +5,15 @@
 #endif
 
 Int Posix_FileSys_open (NullString p, Word w, Mode m) {
-	Int res;
+        Int res;
 
-	res = open ((char *) p, w, m);
+        res = open ((char *) p, w, m);
 
-	if (DEBUG)
-		fprintf (stderr, "%d = Posix_FileSys_open (%s, 0x%08x, 0x%08x)\n", 
-				(int)res, 
-				(char *)p, 
-				(unsigned int)w,
-				(unsigned int)m);
-	return res;
+        if (DEBUG)
+                fprintf (stderr, "%d = Posix_FileSys_open (%s, 0x%08x, 0x%08x)\n", 
+                                (int)res, 
+                                (char *)p, 
+                                (unsigned int)w,
+                                (unsigned int)m);
+        return res;
 }

Modified: mlton/branches/on-20050420-cmm-branch/runtime/Posix/FileSys/pathconf.c
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/Posix/FileSys/pathconf.c	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/Posix/FileSys/pathconf.c	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,5 +1,5 @@
 #include "platform.h"
 
 Int Posix_FileSys_pathconf (NullString p, Int n) {
-	return pathconf ((char *)p, n);
+        return pathconf ((char *)p, n);
 }

Modified: mlton/branches/on-20050420-cmm-branch/runtime/Posix/FileSys/readlink.c
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/Posix/FileSys/readlink.c	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/Posix/FileSys/readlink.c	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,5 +1,5 @@
 #include "platform.h"
 
 Int Posix_FileSys_readlink (NullString p, Pointer b, Int n) {
-	return readlink ((char *) p, b, n);
+        return readlink ((char *) p, b, n);
 }

Modified: mlton/branches/on-20050420-cmm-branch/runtime/Posix/FileSys/rename.c
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/Posix/FileSys/rename.c	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/Posix/FileSys/rename.c	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,5 +1,5 @@
 #include "platform.h"
 
 Int Posix_FileSys_rename (NullString p1, NullString p2) {
-	return rename ((char *) p1, (char *) p2);
+        return rename ((char *) p1, (char *) p2);
 }

Modified: mlton/branches/on-20050420-cmm-branch/runtime/Posix/FileSys/rmdir.c
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/Posix/FileSys/rmdir.c	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/Posix/FileSys/rmdir.c	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,5 +1,5 @@
 #include "platform.h"
 
 Int Posix_FileSys_rmdir (NullString p) {
-	return rmdir ((char *) p);
+        return rmdir ((char *) p);
 }

Modified: mlton/branches/on-20050420-cmm-branch/runtime/Posix/FileSys/symlink.c
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/Posix/FileSys/symlink.c	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/Posix/FileSys/symlink.c	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,5 +1,5 @@
 #include "platform.h"
 
 Int Posix_FileSys_symlink (NullString p1, NullString p2) {
-	return symlink ((char *) p1, (char *) p2);
+        return symlink ((char *) p1, (char *) p2);
 }

Modified: mlton/branches/on-20050420-cmm-branch/runtime/Posix/FileSys/umask.c
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/Posix/FileSys/umask.c	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/Posix/FileSys/umask.c	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,5 +1,5 @@
 #include "platform.h"
 
 Word Posix_FileSys_umask (Word w) {
-	return umask (w);
+        return umask (w);
 }

Modified: mlton/branches/on-20050420-cmm-branch/runtime/Posix/FileSys/unlink.c
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/Posix/FileSys/unlink.c	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/Posix/FileSys/unlink.c	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,5 +1,5 @@
 #include "platform.h"
 
 Word Posix_FileSys_unlink (NullString p) {
-	return unlink ((char *) p);
+        return unlink ((char *) p);
 }

Modified: mlton/branches/on-20050420-cmm-branch/runtime/Posix/IO/FLock.c
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/Posix/IO/FLock.c	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/Posix/IO/FLock.c	2006-02-16 19:34:54 UTC (rev 4361)
@@ -3,45 +3,45 @@
 static struct flock s_flock;
 
 Int Posix_IO_FLock_fcntl (Fd f, Int cmd) {
-	return fcntl (f, cmd, (int)&s_flock);
+        return fcntl (f, cmd, (int)&s_flock);
 }
 
 Int Posix_IO_FLock_type () {
-	return s_flock.l_type;
+        return s_flock.l_type;
 }
 
 Int Posix_IO_FLock_whence () {
-	return s_flock.l_whence;
+        return s_flock.l_whence;
 }
 
 Position Posix_IO_FLock_start () {
-	return s_flock.l_start;
+        return s_flock.l_start;
 }
 
 Position Posix_IO_FLock_len () {
-	return s_flock.l_len;
+        return s_flock.l_len;
 }
 
 Int Posix_IO_FLock_pid () {
-	return s_flock.l_pid;
+        return s_flock.l_pid;
 }
 
 void Posix_IO_FLock_setType (Int x) {
-	s_flock.l_type = x;
+        s_flock.l_type = x;
 }
 
 void Posix_IO_FLock_setWhence (Int x) {
-	s_flock.l_whence = x;
+        s_flock.l_whence = x;
 } 
 
 void Posix_IO_FLock_setStart (Position x) {
-	s_flock.l_start = x;
+        s_flock.l_start = x;
 } 
 
 void Posix_IO_FLock_setLen (Position x) {
-	s_flock.l_len = x;
+        s_flock.l_len = x;
 } 
 
 void Posix_IO_FLock_setPid (Int x) {
-	s_flock.l_pid = x;
+        s_flock.l_pid = x;
 } 

Modified: mlton/branches/on-20050420-cmm-branch/runtime/Posix/IO/close.c
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/Posix/IO/close.c	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/Posix/IO/close.c	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,5 +1,5 @@
 #include "platform.h"
 
 Int Posix_IO_close (Fd f) {
-	return close (f);
+        return close (f);
 }

Modified: mlton/branches/on-20050420-cmm-branch/runtime/Posix/IO/dup.c
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/Posix/IO/dup.c	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/Posix/IO/dup.c	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,5 +1,5 @@
 #include "platform.h"
 
 Fd Posix_IO_dup (Fd f) {
-	return dup( f);
+        return dup( f);
 }

Modified: mlton/branches/on-20050420-cmm-branch/runtime/Posix/IO/dup2.c
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/Posix/IO/dup2.c	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/Posix/IO/dup2.c	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,5 +1,5 @@
 #include "platform.h"
 
 Fd Posix_IO_dup2 (Fd f1, Fd f2) {
-	return dup2 (f1, f2);
+        return dup2 (f1, f2);
 }

Modified: mlton/branches/on-20050420-cmm-branch/runtime/Posix/IO/fcntl2.c
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/Posix/IO/fcntl2.c	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/Posix/IO/fcntl2.c	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,5 +1,5 @@
 #include "platform.h"
 
 Int Posix_IO_fcntl2 (Fd f, Int i) {
-	return fcntl (f, i);
+        return fcntl (f, i);
 }

Modified: mlton/branches/on-20050420-cmm-branch/runtime/Posix/IO/fcntl3.c
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/Posix/IO/fcntl3.c	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/Posix/IO/fcntl3.c	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,5 +1,5 @@
 #include "platform.h"
 
 Int Posix_IO_fcntl3 (Fd f, Int i, Int j) {
-	return fcntl (f, i, j);
+        return fcntl (f, i, j);
 }

Modified: mlton/branches/on-20050420-cmm-branch/runtime/Posix/IO/fsync.c
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/Posix/IO/fsync.c	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/Posix/IO/fsync.c	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,5 +1,5 @@
 #include "platform.h"
 
 Int Posix_IO_fsync (Fd f) {
-	return fsync (f);
+        return fsync (f);
 }

Modified: mlton/branches/on-20050420-cmm-branch/runtime/Posix/IO/lseek.c
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/Posix/IO/lseek.c	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/Posix/IO/lseek.c	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,5 +1,5 @@
 #include "platform.h"
 
 Position Posix_IO_lseek (Fd f, Position i, Int j) {
-	return lseek (f, i, j);
+        return lseek (f, i, j);
 }

Modified: mlton/branches/on-20050420-cmm-branch/runtime/Posix/IO/pipe.c
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/Posix/IO/pipe.c	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/Posix/IO/pipe.c	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,5 +1,5 @@
 #include "platform.h"
 
 Int Posix_IO_pipe (Pointer fds) {
-	return pipe ((int *) fds);
+        return pipe ((int *) fds);
 }

Modified: mlton/branches/on-20050420-cmm-branch/runtime/Posix/IO/read.c
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/Posix/IO/read.c	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/Posix/IO/read.c	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,5 +1,5 @@
 #include "platform.h"
 
 Ssize Posix_IO_read (Fd fd, Pointer b, Int i, Size s) {
-	return (Ssize)(read (fd, (void *) ((char *) b + i), s));
+        return (Ssize)(read (fd, (void *) ((char *) b + i), s));
 }

Modified: mlton/branches/on-20050420-cmm-branch/runtime/Posix/IO/write.c
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/Posix/IO/write.c	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/Posix/IO/write.c	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,15 +1,15 @@
 #include "platform.h"
 
 enum {
-	DEBUG_WRITE = FALSE,
+        DEBUG_WRITE = FALSE,
 };
 
 Ssize Posix_IO_write (Fd fd, Pointer b, Int i, Size s) {
-	Ssize res;
-	
-	res = (Ssize)(write (fd, (void *) ((char *) b + i), s));
-	if (DEBUG_WRITE)
-		fprintf (stderr, "%d = Posix_IO_write (%d, 0x%08x, %d, %d)\n",
-				(int)res, (int)fd, (uint)b, (int)i, (int)s);
-	return res;
+        Ssize res;
+        
+        res = (Ssize)(write (fd, (void *) ((char *) b + i), s));
+        if (DEBUG_WRITE)
+                fprintf (stderr, "%d = Posix_IO_write (%d, 0x%08x, %d, %d)\n",
+                                (int)res, (int)fd, (uint)b, (int)i, (int)s);
+        return res;
 }

Modified: mlton/branches/on-20050420-cmm-branch/runtime/Posix/ProcEnv/ProcEnv.c
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/Posix/ProcEnv/ProcEnv.c	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/Posix/ProcEnv/ProcEnv.c	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,45 +1,45 @@
 #include "platform.h"
 
 Cstring Posix_ProcEnv_ctermid () {
-	return (Cstring)(ctermid (NULL));
+        return (Cstring)(ctermid (NULL));
 }
 
 Gid Posix_ProcEnv_getegid () {
-	return getegid ();
+        return getegid ();
 }
 
 Uid Posix_ProcEnv_geteuid () {
-	return geteuid ();
+        return geteuid ();
 }
 
 Gid Posix_ProcEnv_getgid () {
-	return getgid ();
+        return getgid ();
 }
 
 Pid Posix_ProcEnv_getpid  () {
-	return getpid ();
+        return getpid ();
 }
 
 Pid Posix_ProcEnv_getppid () {
-	return getppid ();
+        return getppid ();
 }
 
 Uid Posix_ProcEnv_getuid () {
-	return getuid ();
+        return getuid ();
 }
 
 Int Posix_ProcEnv_setgid (Gid g) {
-	return setgid (g);
+        return setgid (g);
 }
 
 Int Posix_ProcEnv_setpgid (Pid p, Gid g) {
-	return setpgid (p, g);
+        return setpgid (p, g);
 }
 
 Pid Posix_ProcEnv_setsid () {
-	return setsid ();
+        return setsid ();
 }
 
 Int Posix_ProcEnv_setuid (Uid u) {
-	return setuid (u);
+        return setuid (u);
 }

Modified: mlton/branches/on-20050420-cmm-branch/runtime/Posix/ProcEnv/Tms.c
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/Posix/ProcEnv/Tms.c	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/Posix/ProcEnv/Tms.c	2006-02-16 19:34:54 UTC (rev 4361)
@@ -3,21 +3,21 @@
 static struct tms tms;
 
 Int Posix_ProcEnv_Tms_utime() {
-	return tms.tms_utime;
+        return tms.tms_utime;
 }
 
 Int Posix_ProcEnv_Tms_stime() {
-	return tms.tms_stime;
+        return tms.tms_stime;
 }
 
 Int Posix_ProcEnv_Tms_cutime() {
-	return tms.tms_cutime;
+        return tms.tms_cutime;
 }
 
 Int Posix_ProcEnv_Tms_cstime() {
-	return tms.tms_cstime;
+        return tms.tms_cstime;
 }
 
 Int Posix_ProcEnv_times() {
-	return times(&tms);
+        return times(&tms);
 }

Modified: mlton/branches/on-20050420-cmm-branch/runtime/Posix/ProcEnv/Uname.c
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/Posix/ProcEnv/Uname.c	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/Posix/ProcEnv/Uname.c	2006-02-16 19:34:54 UTC (rev 4361)
@@ -7,31 +7,31 @@
 static struct utsname utsname;
 
 Int Posix_ProcEnv_Uname_uname () {
-	Int res;
-	
-	res = uname (&utsname);
-	if (DEBUG)
-		fprintf (stderr, "%d = Posix_ProcEnv_Uname_uname ()\n",
-				(int)res);
-	return res;
+        Int res;
+        
+        res = uname (&utsname);
+        if (DEBUG)
+                fprintf (stderr, "%d = Posix_ProcEnv_Uname_uname ()\n",
+                                (int)res);
+        return res;
 }
 
 Cstring Posix_ProcEnv_Uname_sysname () {
-	return (Cstring)utsname.sysname;
+        return (Cstring)utsname.sysname;
 }
 
 Cstring Posix_ProcEnv_Uname_nodename () {
-	return (Cstring)utsname.nodename;
+        return (Cstring)utsname.nodename;
 }
 
 Cstring Posix_ProcEnv_Uname_release () {
-	return (Cstring)utsname.release;
+        return (Cstring)utsname.release;
 }
 
 Cstring Posix_ProcEnv_Uname_version () {
-	return (Cstring)utsname.version;
+        return (Cstring)utsname.version;
 }
 
 Cstring Posix_ProcEnv_Uname_machine () {
-	return (Cstring)utsname.machine;
+        return (Cstring)utsname.machine;
 }

Modified: mlton/branches/on-20050420-cmm-branch/runtime/Posix/ProcEnv/getenv.c
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/Posix/ProcEnv/getenv.c	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/Posix/ProcEnv/getenv.c	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,5 +1,5 @@
 #include "platform.h"
 
 Cstring Posix_ProcEnv_getenv(NullString s) {
-	return (Cstring)getenv((char *)s);
+        return (Cstring)getenv((char *)s);
 }

Modified: mlton/branches/on-20050420-cmm-branch/runtime/Posix/ProcEnv/getgroups.c
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/Posix/ProcEnv/getgroups.c	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/Posix/ProcEnv/getgroups.c	2006-02-16 19:34:54 UTC (rev 4361)
@@ -7,14 +7,14 @@
  */
 
 Int Posix_ProcEnv_getgroups (Pointer groups) {
-	int             i;
-	int 		result;
-	gid_t           groupList[Posix_ProcEnv_numgroups];
+        int             i;
+        int             result;
+        gid_t           groupList[Posix_ProcEnv_numgroups];
 
-	result = getgroups (Posix_ProcEnv_numgroups, groupList);
+        result = getgroups (Posix_ProcEnv_numgroups, groupList);
 
-	for (i = 0; i < result; i++)
-		((Word *) groups)[i] = groupList[i];
+        for (i = 0; i < result; i++)
+                ((Word *) groups)[i] = groupList[i];
 
-	return result;
+        return result;
 }

Modified: mlton/branches/on-20050420-cmm-branch/runtime/Posix/ProcEnv/getlogin.c
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/Posix/ProcEnv/getlogin.c	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/Posix/ProcEnv/getlogin.c	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,5 +1,5 @@
 #include "platform.h"
 
 Cstring Posix_ProcEnv_getlogin () {
-	return (Cstring)(getlogin ());
+        return (Cstring)(getlogin ());
 }

Modified: mlton/branches/on-20050420-cmm-branch/runtime/Posix/ProcEnv/getpgrp.c
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/Posix/ProcEnv/getpgrp.c	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/Posix/ProcEnv/getpgrp.c	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,5 +1,5 @@
 #include "platform.h"
 
 Pid Posix_ProcEnv_getpgrp () {
-	return getpgrp ();
+        return getpgrp ();
 }

Modified: mlton/branches/on-20050420-cmm-branch/runtime/Posix/ProcEnv/isatty.c
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/Posix/ProcEnv/isatty.c	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/Posix/ProcEnv/isatty.c	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,5 +1,5 @@
 #include "platform.h"
 
 Bool Posix_ProcEnv_isatty (Fd f) {
-	return isatty (f);
+        return isatty (f);
 }

Modified: mlton/branches/on-20050420-cmm-branch/runtime/Posix/ProcEnv/setenv.c
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/Posix/ProcEnv/setenv.c	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/Posix/ProcEnv/setenv.c	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,5 +1,5 @@
 #include "platform.h"
 
 Int Posix_ProcEnv_setenv (NullString s, NullString v) {
-	return setenv ((char *)s, (char *)v, 1);
+        return setenv ((char *)s, (char *)v, 1);
 }

Copied: mlton/branches/on-20050420-cmm-branch/runtime/Posix/ProcEnv/setgroups.c (from rev 4358, mlton/trunk/runtime/Posix/ProcEnv/setgroups.c)

Modified: mlton/branches/on-20050420-cmm-branch/runtime/Posix/ProcEnv/sysconf.c
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/Posix/ProcEnv/sysconf.c	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/Posix/ProcEnv/sysconf.c	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,5 +1,5 @@
 #include "platform.h"
 
 Int Posix_ProcEnv_sysconf (Int i) {
-	return sysconf (i);
+        return sysconf (i);
 }

Modified: mlton/branches/on-20050420-cmm-branch/runtime/Posix/ProcEnv/ttyname.c
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/Posix/ProcEnv/ttyname.c	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/Posix/ProcEnv/ttyname.c	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,5 +1,5 @@
 #include "platform.h"
 
 Cstring Posix_ProcEnv_ttyname (Fd f) {
-	return (Cstring)(ttyname (f));
+        return (Cstring)(ttyname (f));
 }

Modified: mlton/branches/on-20050420-cmm-branch/runtime/Posix/Process/alarm.c
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/Posix/Process/alarm.c	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/Posix/Process/alarm.c	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,5 +1,5 @@
 #include "platform.h"
 
 Int Posix_Process_alarm (Int i) {
-	return alarm (i);
+        return alarm (i);
 }

Modified: mlton/branches/on-20050420-cmm-branch/runtime/Posix/Process/exece.c
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/Posix/Process/exece.c	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/Posix/Process/exece.c	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,27 +1,27 @@
 #include "platform.h"
 
 Int Posix_Process_exece (NullString p, Pointer a, Pointer e) {
-	char		*path;
-	char		*asaved;
-	char 		*esaved;
-	char 		**args;
-	char 		**env;
-	int             an;
-	int 		en;
-	int 		result;
+        char            *path;
+        char            *asaved;
+        char            *esaved;
+        char            **args;
+        char            **env;
+        int             an;
+        int             en;
+        int             result;
 
-	path = (char *) p;
-	args = (char **) a;
-	env = (char **) e;
-	an = GC_arrayNumElements (a) - 1;
-	asaved = args[an];
-	en = GC_arrayNumElements (e) - 1;
-	esaved = env[en];
-	args[an] = (char *) NULL;
-	env[en] = (char *) NULL;
-	result = EXECVE (path, args, env);
-	/* exece failed */
-	args[an] = asaved;
-	env[en] = esaved;
-	return result;
+        path = (char *) p;
+        args = (char **) a;
+        env = (char **) e;
+        an = GC_arrayNumElements (a) - 1;
+        asaved = args[an];
+        en = GC_arrayNumElements (e) - 1;
+        esaved = env[en];
+        args[an] = (char *) NULL;
+        env[en] = (char *) NULL;
+        result = EXECVE (path, args, env);
+        /* exece failed */
+        args[an] = asaved;
+        env[en] = esaved;
+        return result;
 }

Modified: mlton/branches/on-20050420-cmm-branch/runtime/Posix/Process/execp.c
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/Posix/Process/execp.c	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/Posix/Process/execp.c	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,19 +1,19 @@
 #include "platform.h"
 
 Int Posix_Process_execp (NullString f, Pointer a) {
-	char		*file;
-	char		*saved;
- 	char		**args;
-	int             n;
-	int 		result;
+        char            *file;
+        char            *saved;
+        char            **args;
+        int             n;
+        int             result;
 
-	file = (char *) f;
-	args = (char **) a;
-	n = GC_arrayNumElements (a) - 1;
-	saved = args[n];
-	args[n] = (char *) NULL;
-	result = EXECVP (file, args);
-	/* execp failed */
-	args[n] = saved;
-	return result;
+        file = (char *) f;
+        args = (char **) a;
+        n = GC_arrayNumElements (a) - 1;
+        saved = args[n];
+        args[n] = (char *) NULL;
+        result = EXECVP (file, args);
+        /* execp failed */
+        args[n] = saved;
+        return result;
 }

Modified: mlton/branches/on-20050420-cmm-branch/runtime/Posix/Process/exit.c
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/Posix/Process/exit.c	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/Posix/Process/exit.c	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,5 +1,5 @@
 #include "platform.h"
 
 void Posix_Process_exit (Int i) {
-	exit (i);
+        exit (i);
 }

Modified: mlton/branches/on-20050420-cmm-branch/runtime/Posix/Process/exitStatus.c
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/Posix/Process/exitStatus.c	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/Posix/Process/exitStatus.c	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,8 +1,8 @@
 #include "platform.h"
 
 Int Posix_Process_exitStatus (Status s) {
-	int i;
+        int i;
 
-	i = s;
-	return WEXITSTATUS (i);
+        i = s;
+        return WEXITSTATUS (i);
 }

Modified: mlton/branches/on-20050420-cmm-branch/runtime/Posix/Process/fork.c
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/Posix/Process/fork.c	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/Posix/Process/fork.c	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,5 +1,5 @@
 #include "platform.h"
 
 Pid Posix_Process_fork () {
-	return fork ();
+        return fork ();
 }

Modified: mlton/branches/on-20050420-cmm-branch/runtime/Posix/Process/ifExited.c
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/Posix/Process/ifExited.c	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/Posix/Process/ifExited.c	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,8 +1,8 @@
 #include "platform.h"
 
 Bool Posix_Process_ifExited (Status s) {
-	int i;
+        int i;
 
-	i = s;
-	return WIFEXITED (i);
+        i = s;
+        return WIFEXITED (i);
 }

Modified: mlton/branches/on-20050420-cmm-branch/runtime/Posix/Process/ifSignaled.c
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/Posix/Process/ifSignaled.c	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/Posix/Process/ifSignaled.c	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,8 +1,8 @@
 #include "platform.h"
 
 Bool Posix_Process_ifSignaled (Status s) {
-	int i;
+        int i;
 
-	i = s;
-	return WIFSIGNALED (i);
+        i = s;
+        return WIFSIGNALED (i);
 }

Modified: mlton/branches/on-20050420-cmm-branch/runtime/Posix/Process/ifStopped.c
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/Posix/Process/ifStopped.c	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/Posix/Process/ifStopped.c	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,8 +1,8 @@
 #include "platform.h"
 
 Bool Posix_Process_ifStopped (Status s) {
-	int i;
+        int i;
 
-	i = s;
-	return WIFSTOPPED (i);
+        i = s;
+        return WIFSTOPPED (i);
 }

Modified: mlton/branches/on-20050420-cmm-branch/runtime/Posix/Process/kill.c
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/Posix/Process/kill.c	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/Posix/Process/kill.c	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,5 +1,5 @@
 #include "platform.h"
 
 Int Posix_Process_kill (Pid p, Signal s) {
-	return kill (p, s);
+        return kill (p, s);
 }

Copied: mlton/branches/on-20050420-cmm-branch/runtime/Posix/Process/nanosleep.c (from rev 4358, mlton/trunk/runtime/Posix/Process/nanosleep.c)

Modified: mlton/branches/on-20050420-cmm-branch/runtime/Posix/Process/pause.c
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/Posix/Process/pause.c	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/Posix/Process/pause.c	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,5 +1,5 @@
 #include "platform.h"
 
 Int Posix_Process_pause () {
-	return pause ();
+        return pause ();
 }

Modified: mlton/branches/on-20050420-cmm-branch/runtime/Posix/Process/sleep.c
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/Posix/Process/sleep.c	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/Posix/Process/sleep.c	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,5 +1,5 @@
 #include "platform.h"
 
 Int Posix_Process_sleep (Int i) {
-	return sleep (i);
+        return sleep (i);
 }

Modified: mlton/branches/on-20050420-cmm-branch/runtime/Posix/Process/stopSig.c
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/Posix/Process/stopSig.c	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/Posix/Process/stopSig.c	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,8 +1,8 @@
 #include "platform.h"
 
 Signal Posix_Process_stopSig (Status s) {
-	int i;
+        int i;
 
-	i = s;
-	return WSTOPSIG (i);
+        i = s;
+        return WSTOPSIG (i);
 }

Copied: mlton/branches/on-20050420-cmm-branch/runtime/Posix/Process/system.c (from rev 4358, mlton/trunk/runtime/Posix/Process/system.c)

Modified: mlton/branches/on-20050420-cmm-branch/runtime/Posix/Process/termSig.c
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/Posix/Process/termSig.c	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/Posix/Process/termSig.c	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,8 +1,8 @@
 #include "platform.h"
 
 Signal Posix_Process_termSig (Status s) {
-	int i;
+        int i;
 
-	i = s;
-	return WTERMSIG (i);
+        i = s;
+        return WTERMSIG (i);
 }

Modified: mlton/branches/on-20050420-cmm-branch/runtime/Posix/Process/waitpid.c
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/Posix/Process/waitpid.c	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/Posix/Process/waitpid.c	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,5 +1,5 @@
 #include "platform.h"
 
 Pid Posix_Process_waitpid (Pid p, Pointer s, Int i) {
-	return waitpid (p, (int*)s, i);
+        return waitpid (p, (int*)s, i);
 }

Modified: mlton/branches/on-20050420-cmm-branch/runtime/Posix/Signal.c
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/Posix/Signal.c	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/Posix/Signal.c	2006-02-16 19:34:54 UTC (rev 4361)
@@ -3,115 +3,115 @@
 extern struct GC_state gcState;
 
 static void handler (int signum) {
-	GC_handler (&gcState, signum);
+        GC_handler (&gcState, signum);
 }
 
 enum {
 #if  (defined (SA_ONSTACK))
-	SA_FLAGS = SA_ONSTACK,
+        SA_FLAGS = SA_ONSTACK,
 #else
-	SA_FLAGS = 0,
+        SA_FLAGS = 0,
 #endif
 };
 
 Int Posix_Signal_default (Int signum) {
-	struct sigaction sa;
+        struct sigaction sa;
 
-	sigdelset (&gcState.signalsHandled, signum);
-	memset (&sa, 0, sizeof(sa));
-	sa.sa_handler = SIG_DFL;
- 	sa.sa_flags = SA_FLAGS;
-	return sigaction (signum, &sa, NULL);
+        sigdelset (&gcState.signalsHandled, signum);
+        memset (&sa, 0, sizeof(sa));
+        sa.sa_handler = SIG_DFL;
+        sa.sa_flags = SA_FLAGS;
+        return sigaction (signum, &sa, NULL);
 }
 
 bool Posix_Signal_isGCPending () {
-	Bool res;
+        Bool res;
 
-	res = gcState.gcSignalIsPending;
-	if (DEBUG_SIGNALS)
-		fprintf (stderr, "%s = Posix_Signal_isGCPending ()\n",
-				boolToString (res));
- 	return res;
+        res = gcState.gcSignalIsPending;
+        if (DEBUG_SIGNALS)
+                fprintf (stderr, "%s = Posix_Signal_isGCPending ()\n",
+                                boolToString (res));
+        return res;
 }
 
 Bool Posix_Signal_isPending (Int signum) {
-	return sigismember (&gcState.signalsPending, signum);
+        return sigismember (&gcState.signalsPending, signum);
 }
 
 Int Posix_Signal_handle (Int signum) {
-	static struct sigaction sa;
+        static struct sigaction sa;
 
-	sigaddset (&gcState.signalsHandled, signum);
-	memset (&sa, 0, sizeof(sa));
-	/* The mask must be full because GC_handler reads and writes 
-	 * s->signalsPending  (else there is a race condition).
-	 */
-	sigfillset (&sa.sa_mask);
-	sa.sa_handler = handler;
- 	sa.sa_flags = SA_FLAGS;
-	return sigaction (signum, &sa, NULL);
+        sigaddset (&gcState.signalsHandled, signum);
+        memset (&sa, 0, sizeof(sa));
+        /* The mask must be full because GC_handler reads and writes 
+         * s->signalsPending  (else there is a race condition).
+         */
+        sigfillset (&sa.sa_mask);
+        sa.sa_handler = handler;
+        sa.sa_flags = SA_FLAGS;
+        return sigaction (signum, &sa, NULL);
 }
 
 void Posix_Signal_handleGC () {
-	gcState.handleGCSignal = TRUE;
+        gcState.handleGCSignal = TRUE;
 }
 
 Int Posix_Signal_ignore (Int signum) {
-	struct sigaction sa;
+        struct sigaction sa;
 
-	sigdelset (&gcState.signalsHandled, signum);
-	memset (&sa, 0, sizeof(sa));
-	sa.sa_handler = SIG_IGN;
- 	sa.sa_flags = SA_FLAGS;
-	return sigaction (signum, &sa, NULL);
+        sigdelset (&gcState.signalsHandled, signum);
+        memset (&sa, 0, sizeof(sa));
+        sa.sa_handler = SIG_IGN;
+        sa.sa_flags = SA_FLAGS;
+        return sigaction (signum, &sa, NULL);
 }
 
 Int Posix_Signal_isDefault (Int signum, Bool *isDef) {
-	Int res;
-	struct sigaction sa;
+        Int res;
+        struct sigaction sa;
 
- 	sa.sa_flags = SA_FLAGS;
-	res = sigaction (signum, NULL, &sa);
-	*isDef = sa.sa_handler == SIG_DFL;
-	return res;
+        sa.sa_flags = SA_FLAGS;
+        res = sigaction (signum, NULL, &sa);
+        *isDef = sa.sa_handler == SIG_DFL;
+        return res;
 }
 
 void Posix_Signal_resetPending () {
-	if (DEBUG_SIGNALS)
-		fprintf (stderr, "Posix_Signal_resetPending ()\n");
-	sigemptyset (&gcState.signalsPending);
-	gcState.gcSignalIsPending = FALSE;
+        if (DEBUG_SIGNALS)
+                fprintf (stderr, "Posix_Signal_resetPending ()\n");
+        sigemptyset (&gcState.signalsPending);
+        gcState.gcSignalIsPending = FALSE;
 }
 
 static sigset_t set;
 
 Int Posix_Signal_sigaddset (Int signum) {
-	return sigaddset (&set, signum);
+        return sigaddset (&set, signum);
 }
 
 Int Posix_Signal_sigdelset (Int signum) {
-	return sigdelset (&set, signum);
+        return sigdelset (&set, signum);
 }
 
 Int Posix_Signal_sigemptyset () {
-	return sigemptyset (&set);
+        return sigemptyset (&set);
 }
 
 Int Posix_Signal_sigfillset () {
-	return sigfillset (&set);
+        return sigfillset (&set);
 }
 
 Int Posix_Signal_sigismember (Int signum) {
-	return sigismember (&set, signum);
+        return sigismember (&set, signum);
 }
 
 Int Posix_Signal_sigprocmask (Int how) {
-	return sigprocmask (how, &set, &set);
+        return sigprocmask (how, &set, &set);
 }
 
 void Posix_Signal_suspend () {
-	int res;
+        int res;
 
-	res = sigsuspend (&set);
-	assert (-1 == res);
+        res = sigsuspend (&set);
+        assert (-1 == res);
 }

Modified: mlton/branches/on-20050420-cmm-branch/runtime/Posix/SysDB/Group.c
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/Posix/SysDB/Group.c	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/Posix/SysDB/Group.c	2006-02-16 19:34:54 UTC (rev 4361)
@@ -3,21 +3,21 @@
 static struct group *group;
 
 Cstring Posix_SysDB_Group_name() {
-	return (Cstring)group->gr_name;
+        return (Cstring)group->gr_name;
 }
 
 Gid Posix_SysDB_Group_gid() {
-	return group->gr_gid;
+        return group->gr_gid;
 }
 
 CstringArray Posix_SysDB_Group_mem() {
-	return (CstringArray)group->gr_mem;
+        return (CstringArray)group->gr_mem;
 }
 
 Bool Posix_SysDB_getgrgid(Gid g) {
- 	return NULL != (group = getgrgid ((gid_t)g));
+        return NULL != (group = getgrgid ((gid_t)g));
 }
 
 Bool Posix_SysDB_getgrnam(NullString s) {
- 	return NULL != (group = getgrnam ((char*)s));
+        return NULL != (group = getgrnam ((char*)s));
 }

Modified: mlton/branches/on-20050420-cmm-branch/runtime/Posix/SysDB/Passwd.c
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/Posix/SysDB/Passwd.c	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/Posix/SysDB/Passwd.c	2006-02-16 19:34:54 UTC (rev 4361)
@@ -3,29 +3,29 @@
 static struct passwd *passwd;
 
 Cstring Posix_SysDB_Passwd_name() {
-	return (Cstring)passwd->pw_name;
+        return (Cstring)passwd->pw_name;
 }
 
 Uid Posix_SysDB_Passwd_uid() {
-	return passwd->pw_uid;
+        return passwd->pw_uid;
 }
 
 Gid Posix_SysDB_Passwd_gid() {
-	return passwd->pw_gid;
+        return passwd->pw_gid;
 }
 
 Cstring Posix_SysDB_Passwd_dir() {
-	return (Cstring)passwd->pw_dir;
+        return (Cstring)passwd->pw_dir;
 }
 
 Cstring Posix_SysDB_Passwd_shell() {
-	return (Cstring)passwd->pw_shell;
+        return (Cstring)passwd->pw_shell;
 }
 
 Bool Posix_SysDB_getpwnam(Pointer p) {
-	return NULL != (passwd = getpwnam((char *) p));
+        return NULL != (passwd = getpwnam((char *) p));
 }
 
 Bool Posix_SysDB_getpwuid(Uid u) {
-	return NULL != (passwd = getpwuid(u));
+        return NULL != (passwd = getpwuid(u));
 }

Modified: mlton/branches/on-20050420-cmm-branch/runtime/Posix/TTY.c
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/Posix/TTY.c	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/Posix/TTY.c	2006-02-16 19:34:54 UTC (rev 4361)
@@ -3,85 +3,85 @@
 static struct termios termios;
 
 Flag Posix_TTY_Termios_iflag () {
-	return termios.c_iflag;
+        return termios.c_iflag;
 }
 
 Flag Posix_TTY_Termios_oflag () {
-	return termios.c_oflag;
+        return termios.c_oflag;
 }
 
 Flag Posix_TTY_Termios_cflag () {
-	return termios.c_cflag;
+        return termios.c_cflag;
 }
 
 Flag Posix_TTY_Termios_lflag () {
-	return termios.c_lflag;
+        return termios.c_lflag;
 }
 
 Cstring Posix_TTY_Termios_cc () {
-	return (Cstring)termios.c_cc;
+        return (Cstring)termios.c_cc;
 }
 
 Speed Posix_TTY_Termios_cfgetospeed () {
-	return cfgetospeed (&termios);
+        return cfgetospeed (&termios);
 }
 
 Speed Posix_TTY_Termios_cfgetispeed () {
-	return cfgetispeed (&termios);
+        return cfgetispeed (&termios);
 }
 
 void Posix_TTY_Termios_setiflag (Flag f) {
-	termios.c_iflag = f;
+        termios.c_iflag = f;
 }
 
 void Posix_TTY_Termios_setoflag (Flag f) {
-	termios.c_oflag = f;
+        termios.c_oflag = f;
 }
 
 void Posix_TTY_Termios_setcflag (Flag f) {
-	termios.c_cflag = f;
+        termios.c_cflag = f;
 }
 
 void Posix_TTY_Termios_setlflag (Flag f) {
-	termios.c_lflag = f;
+        termios.c_lflag = f;
 }
 
 Int Posix_TTY_Termios_setospeed (Speed s) {
-	return cfsetospeed (&termios, s);
+        return cfsetospeed (&termios, s);
 }
 
 Int Posix_TTY_Termios_setispeed (Speed s) {
-	return cfsetispeed (&termios, s);
+        return cfsetispeed (&termios, s);
 }
 
 Int Posix_TTY_drain (Fd f) {
-	return tcdrain (f);
+        return tcdrain (f);
 }
 
 Int Posix_TTY_flow (Fd f, Int i) {
-	return tcflow (f, i);
+        return tcflow (f, i);
 }
 
 Int Posix_TTY_flush (Fd f, Int i) {
-	return tcflush (f, i);
+        return tcflush (f, i);
 }
 
 Int Posix_TTY_getattr (Fd f) {
-	return tcgetattr (f, &termios);
+        return tcgetattr (f, &termios);
 }
 
 Int Posix_TTY_getpgrp (Fd f) {
-	return tcgetpgrp (f);
+        return tcgetpgrp (f);
 }
 
 Int Posix_TTY_sendbreak (Fd f, Int i) {
-	return tcsendbreak (f, i);
+        return tcsendbreak (f, i);
 }
 
 Int Posix_TTY_setattr (Fd f, Int i) {
-	return tcsetattr (f, i, &termios);
+        return tcsetattr (f, i, &termios);
 }
 
 Int Posix_TTY_setpgrp (Fd f, Pid p) {
-	return tcsetpgrp (f, p);
+        return tcsetpgrp (f, p);
 }

Modified: mlton/branches/on-20050420-cmm-branch/runtime/assert.h
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/assert.h	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/assert.h	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,10 @@
+/* Copyright (C) 2004-2005 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ */
+
 #ifndef ASSERT
 #define ASSERT 0
 #endif
@@ -7,7 +14,7 @@
 
 /* Assertion verifier */
 #if ASSERT
-#define	assert(p) ((p) ? (void)0 : asfail(__FILE__, __LINE__, #p))
+#define assert(p) ((p) ? (void)0 : asfail(__FILE__, __LINE__, #p))
 #else
-#define	assert(p) ((void)0)
+#define assert(p) ((void)0)
 #endif

Modified: mlton/branches/on-20050420-cmm-branch/runtime/basis/Array/numElements.c
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/basis/Array/numElements.c	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/basis/Array/numElements.c	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,5 +1,5 @@
 #include "platform.h"
 
 Int Array_numElements (Pointer p) {
-	return GC_arrayNumElements (p);
+        return GC_arrayNumElements (p);
 }

Modified: mlton/branches/on-20050420-cmm-branch/runtime/basis/Date.c
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/basis/Date.c	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/basis/Date.c	2006-02-16 19:34:54 UTC (rev 4361)
@@ -8,101 +8,101 @@
 static struct tm *tmp;
 
 Int Date_Tm_sec() {
-	return tmp->tm_sec;
+        return tmp->tm_sec;
 }
 
 Int Date_Tm_min() {
-	return tmp->tm_min;
+        return tmp->tm_min;
 }
 
 Int Date_Tm_hour() {
-	return tmp->tm_hour;
+        return tmp->tm_hour;
 }
 
 Int Date_Tm_mday() {
-	return tmp->tm_mday;
+        return tmp->tm_mday;
 }
 
 Int Date_Tm_mon() {
-	return tmp->tm_mon;
+        return tmp->tm_mon;
 }
 
 Int Date_Tm_year() {
-	return tmp->tm_year;
+        return tmp->tm_year;
 }
 
 Int Date_Tm_wday() {
-	return tmp->tm_wday;
+        return tmp->tm_wday;
 }
 
 Int Date_Tm_yday() {
-	return tmp->tm_yday;
+        return tmp->tm_yday;
 }
 
 Int Date_Tm_isdst() {
-	return tmp->tm_isdst;
+        return tmp->tm_isdst;
 }
 
 void Date_Tm_setSec(Int x) {
-	tm.tm_sec = x;
+        tm.tm_sec = x;
 }
 
 void Date_Tm_setMin(Int x) {
-	tm.tm_min = x;
+        tm.tm_min = x;
 }
 
 void Date_Tm_setHour(Int x) {
-	tm.tm_hour = x;
+        tm.tm_hour = x;
 }
 
 void Date_Tm_setMday(Int x) {
-	tm.tm_mday = x;
+        tm.tm_mday = x;
 }
 
 void Date_Tm_setMon(Int x) {
-	tm.tm_mon = x;
+        tm.tm_mon = x;
 }
 
 void Date_Tm_setYear(Int x) {
-	tm.tm_year = x;
+        tm.tm_year = x;
 }
 
 void Date_Tm_setWday(Int x) {
-	tm.tm_wday = x;
+        tm.tm_wday = x;
 }
 
 void Date_Tm_setYday(Int x) {
-	tm.tm_yday = x;
+        tm.tm_yday = x;
 }
 
 void Date_Tm_setIsdst(Int x) {
-	tm.tm_isdst = x;
+        tm.tm_isdst = x;
 }
 
 void Date_gmTime(Pointer p) {
-	tmp = gmtime((time_t*)p);
+        tmp = gmtime((time_t*)p);
 }
 
 /* The idea for Date_localOffset comes from KitV3 src/Runtime/Time.c */
 Int Date_localOffset() {
-	time_t t1, t2;
+        time_t t1, t2;
 
-	t1 = time(NULL);
-	t2 = mktime(gmtime(&t1));
-	return difftime(t2, t1);
+        t1 = time(NULL);
+        t2 = mktime(gmtime(&t1));
+        return difftime(t2, t1);
 }
 
 void Date_localTime(Pointer p) {
-	tmp = localtime((time_t*)p);
-	if (DEBUG)
-		fprintf (stderr, "0x%08x = Date_localTime (0x%08x)\n", 
-				(unsigned int)tmp, (unsigned int)p);
+        tmp = localtime((time_t*)p);
+        if (DEBUG)
+                fprintf (stderr, "0x%08x = Date_localTime (0x%08x)\n", 
+                                (unsigned int)tmp, (unsigned int)p);
 }
 
 Int Date_mkTime() {
-	return mktime(&tm);
+        return mktime(&tm);
 }
 
 Int Date_strfTime(Pointer buf, Int n, NullString fmt) {
-	return strftime((char*)(buf), n, (char*)(fmt), &tm);
+        return strftime((char*)(buf), n, (char*)(fmt), &tm);
 }

Modified: mlton/branches/on-20050420-cmm-branch/runtime/basis/Debug.c
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/basis/Debug.c	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/basis/Debug.c	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,31 +1,31 @@
 #include "platform.h"
 
 enum {
-	INDENTATION = 1,
+        INDENTATION = 1,
 };
 
 static int depth = 0;
 
 static void spaces(int depth) {
-	int i;
+        int i;
 
-	depth %= 40;
-	for (i = 0; i < depth; ++i)
-		fprintf(stderr, " ");
+        depth %= 40;
+        for (i = 0; i < depth; ++i)
+                fprintf(stderr, " ");
 }
 
 void Debug_enter(Pointer name) {
-	depth += INDENTATION;
-	spaces(depth);
-	fprintf(stderr, "Entering ");
-	Stdio_print(name);
-	fprintf(stderr, "\n");
+        depth += INDENTATION;
+        spaces(depth);
+        fprintf(stderr, "Entering ");
+        Stdio_print(name);
+        fprintf(stderr, "\n");
 }
 
 void Debug_leave(Pointer name) {
-	spaces(depth);
-	fprintf(stderr, "Leaving ");
-	Stdio_print(name);
-	fprintf(stderr, "\n");
-	depth -= INDENTATION;
+        spaces(depth);
+        fprintf(stderr, "Leaving ");
+        Stdio_print(name);
+        fprintf(stderr, "\n");
+        depth -= INDENTATION;
 }

Modified: mlton/branches/on-20050420-cmm-branch/runtime/basis/GC.c
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/basis/GC.c	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/basis/GC.c	2006-02-16 19:34:54 UTC (rev 4361)
@@ -5,21 +5,25 @@
 extern struct GC_state gcState;
 
 void GC_setHashConsDuringGC (Int b) {
-	gcState.hashConsDuringGC = b;
+        gcState.hashConsDuringGC = b;
 }
 
 void GC_setMessages (Int b) {
-	gcState.messages = b;
+        gcState.messages = b;
 }
 
 void GC_setSummary (Int b) {
-	gcState.summary = b;
+        gcState.summary = b;
 }
 
+void GC_setRusageMeasureGC (Int b) {
+        gcState.rusageMeasureGC = b;
+}
+
 void MLton_GC_pack () {
-	GC_pack (&gcState);
+        GC_pack (&gcState);
 }
 
 void MLton_GC_unpack () {
-	GC_unpack (&gcState);
+        GC_unpack (&gcState);
 }

Modified: mlton/branches/on-20050420-cmm-branch/runtime/basis/IEEEReal.c
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/basis/IEEEReal.c	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/basis/IEEEReal.c	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,45 @@
 #include "platform.h"
 
+#if !HAS_FEROUND
+
+#if (defined __i386__)
+
+/* Macros for accessing the hardware control word. */
+#define _FPU_GETCW(cw) __asm__ ("fnstcw %0" : "=m" (*&cw))
+#define _FPU_SETCW(cw) __asm__ ("fldcw %0" : : "m" (*&cw))
+
+#define ROUNDING_CONTROL_MASK 0x0C00
+#define ROUNDING_CONTROL_SHIFT 10
+
+int fegetround () {
+        unsigned short controlWord;
+
+        _FPU_GETCW (controlWord);
+        return (controlWord & ROUNDING_CONTROL_MASK) >> ROUNDING_CONTROL_SHIFT;
+}
+
+static inline void fesetround (int mode) {
+        unsigned short controlWord;
+
+        _FPU_GETCW (controlWord);
+        controlWord &= ~ROUNDING_CONTROL_MASK;
+        controlWord |= mode << ROUNDING_CONTROL_SHIFT;
+        _FPU_SETCW (controlWord);
+}
+
+#else
+
+#error fe{get,set}round not implemented
+
+#endif
+
+#endif
+
 Int IEEEReal_getRoundingMode () {
-	return fegetround ();
+        return fegetround ();
 }
 
 void IEEEReal_setRoundingMode (Int m) {
-	assert (m != FE_NOSUPPORT);
-	fesetround (m);
+        assert (m != FE_NOSUPPORT);
+        fesetround (m);
 }

Modified: mlton/branches/on-20050420-cmm-branch/runtime/basis/Int/Word.c
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/basis/Int/Word.c	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/basis/Int/Word.c	2006-02-16 19:34:54 UTC (rev 4361)
@@ -28,79 +28,156 @@
 #define DEBUG FALSE
 #endif
 
-/* Uhm, why wouldn't they?
-#if ! (defined (__i386__) || defined (__ppc__) || defined (__sparc__))
+#if ! (defined (__hppa__) || defined (__i386__) || defined (__ppc__) || defined (__powerpc__) || defined (__sparc__))
 #error check that C {/,%} correctly implement {quot,rem} from the basis library
 #endif
-*/
 
-#define coerce(f, t)				\
-	t f##_to##t (f x) {			\
-		return (t)x;			\
-	}
+#define coerce(f, t)                            \
+        t f##_to##t (f x) {                     \
+                return (t)x;                    \
+        }
 
-#define bothCoerce(from, to)			\
-	coerce (Word##S##from, Word##to)	\
-	coerce (Word##U##from, Word##to)
+#define bothCoerce(from, to)                    \
+        coerce (Word##S##from, Word##to)        \
+        coerce (Word##U##from, Word##to)
 
-#define binary(kind, name, op)						\
-	Word##kind Word##kind##_##name (Word##kind w1, Word##kind w2) {	\
-		return w1 op w2;					\
-	}
+#define WordS8_max (WordS8)0x7F
+#define WordS8_min (WordS8)0x80
+#define WordS16_max (WordS16)0x7FFF
+#define WordS16_min (WordS16)0x8000
+#define WordS32_max (WordS32)0x7FFFFFFF
+#define WordS32_min (WordS32)0x80000000
+#define WordS64_max (WordS64)0x7FFFFFFFFFFFFFFFll
+#define WordS64_min (WordS64)0x8000000000000000ll
+#define WordU8_max (WordU8)0xFF
+#define WordU16_max (WordU16)0xFFFF
+#define WordU32_max (WordU32)0xFFFFFFFF
+#define WordU64_max (WordU64)0xFFFFFFFFFFFFFFFFull
 
-#define bothBinary(size, name, op)		\
-	binary (S##size, name, op)		\
-	binary (U##size, name, op)
+#define binary(kind, name, op)                                          \
+        Word##kind Word##kind##_##name (Word##kind w1, Word##kind w2) { \
+                return w1 op w2;                                        \
+        }
 
-#define compare(kind, name, op)						\
-	Bool Word##kind##_##name (Word##kind w1, Word##kind w2) {	\
-		return w1 op w2;					\
-	}
+#define bothBinary(size, name, op)              \
+        binary (S##size, name, op)              \
+        binary (U##size, name, op)
 
-#define bothCompare(size, name, op)		\
-	compare (S##size, name, op)		\
-	compare (U##size, name, op)
+#define SaddCheckOverflows(size)                                        \
+        Bool WordS##size##_addCheckOverflows (WordS##size x, WordS##size y) {   \
+                if (x >= 0) {                                           \
+                        if (y > WordS##size##_max - x)                  \
+                                return TRUE;                            \
+                } else if (y < WordS##size##_min - x)                   \
+                        return TRUE;                                    \
+                return FALSE;                                           \
+        }
 
-#define unary(kind,name, op)				\
-	Word##kind Word##kind##_##name (Word##kind w) {	\
-		return op w;				\
-	}
+#define UaddCheckOverflows(size)                                        \
+        Bool WordU##size##_addCheckOverflows (WordU##size x, WordU##size y) {   \
+                if (y > WordU##size##_max - x)                          \
+                        return TRUE;                                    \
+                return FALSE;                                           \
+        }
 
-#define shift(kind, name, op)						\
-	Word##kind Word##kind##_##name (Word##kind w1, Word w2) {	\
-		return w1 op w2;					\
-	}
+#define SmulCheckOverflows(size)                                        \
+        Bool WordS##size##_mulCheckOverflows (WordS##size x, WordS##size y) {   \
+                if ((x == (WordS##size)0) or (y == (WordS##size)0))     \
+                        return FALSE;                                   \
+                if (x > (WordS##size)0) {                               \
+                        if (y > (WordS##size)0) {                       \
+                                if (x > WordS##size##_quot (WordS##size##_max, y))      \
+                                        return TRUE;                    \
+                                return FALSE;                           \
+                        } else /* (y < (WordS##size)0) */ {             \
+                                if (y < WordS##size##_quot (WordS##size##_min, x))      \
+                                        return TRUE;                    \
+                                return FALSE;                           \
+                        }                                               \
+                } else /* (x < (WordS##size)0) */ {                     \
+                        if (y > (WordS##size)0) {                       \
+                                if (x < WordS##size##_quot (WordS##size##_min, y))      \
+                                        return TRUE;                    \
+                                return FALSE;                           \
+                        } else /* (y < (WordS##size)0) */ {             \
+                                if (y < WordS##size##_quot (WordS##size##_max, x))      \
+                                        return TRUE;                    \
+                                return FALSE;                           \
+                        }                                               \
+                }                                                       \
+        }
 
-#define all(size)						\
-	binary (size, add, +)					\
-	binary (size, andb, &)					\
-	compare (size, equal, ==)				\
-	bothCompare (size, ge, >=)				\
-	bothCompare (size, gt, >)				\
-	bothCompare (size, le, <=)				\
-	shift (size, lshift, <<)				\
-	bothCompare (size, lt, <)				\
-	bothBinary (size, mul, *)				\
-	unary (size, neg, -)					\
-	unary (size, notb, ~)					\
-	binary (size, orb, |)					\
-	bothBinary (size, quot, /)				\
-	bothBinary (size, rem, %)				\
-	Word##size Word##size##_rol (Word##size w1, Word w2) {	\
-		return (w1 >> (size - w2)) | (w1 << w2);	\
-	}							\
-	Word##size Word##size##_ror (Word##size w1, Word w2) {	\
-		return (w1 >> w2) | (w1 << (size - w2));	\
-	}							\
-	shift (S##size, rshift, >>)				\
-	shift (U##size, rshift, >>)				\
-	binary (size, sub, -)					\
-	binary (size, xorb, ^)					\
-	bothCoerce (size, 64)					\
-	bothCoerce (size, 32)					\
-	bothCoerce (size, 16)					\
-	bothCoerce (size, 8)
+#define negCheckOverflows(size)                                         \
+        Bool Word##size##_negCheckOverflows (WordS##size x) {           \
+                if (x == WordS##size##_min)                             \
+                        return TRUE;                                    \
+                return FALSE;                                           \
+        }
 
+#define SsubCheckOverflows(size)                                        \
+        Bool WordS##size##_subCheckOverflows (WordS##size x, WordS##size y) {   \
+                if (x >= 0) {                                           \
+                        if (y < x - WordS##size##_max)                  \
+                                return TRUE;                            \
+                } else if (y > x - WordS##size##_min)                   \
+                        return TRUE;                                    \
+                return FALSE;                                           \
+        }
+
+#define compare(kind, name, op)                                         \
+        Bool Word##kind##_##name (Word##kind w1, Word##kind w2) {       \
+                return w1 op w2;                                        \
+        }
+
+#define bothCompare(size, name, op)             \
+        compare (S##size, name, op)             \
+        compare (U##size, name, op)
+
+#define unary(kind,name, op)                            \
+        Word##kind Word##kind##_##name (Word##kind w) { \
+                return op w;                            \
+        }
+
+#define shift(kind, name, op)                                           \
+        Word##kind Word##kind##_##name (Word##kind w1, Word w2) {       \
+                return w1 op w2;                                        \
+        }
+
+#define all(size)                                               \
+        binary (size, add, +)                                   \
+        SaddCheckOverflows (size)                               \
+        UaddCheckOverflows (size)                               \
+        binary (size, andb, &)                                  \
+        compare (size, equal, ==)                               \
+        bothCompare (size, ge, >=)                              \
+        bothCompare (size, gt, >)                               \
+        bothCompare (size, le, <=)                              \
+        shift (size, lshift, <<)                                \
+        bothCompare (size, lt, <)                               \
+        bothBinary (size, mul, *)                               \
+        unary (size, neg, -)                                    \
+        negCheckOverflows (size)                                \
+        unary (size, notb, ~)                                   \
+        binary (size, orb, |)                                   \
+        bothBinary (size, quot, /)                              \
+        SmulCheckOverflows (size)                               \
+        bothBinary (size, rem, %)                               \
+        Word##size Word##size##_rol (Word##size w1, Word w2) {  \
+                return (w1 >> (size - w2)) | (w1 << w2);        \
+        }                                                       \
+        Word##size Word##size##_ror (Word##size w1, Word w2) {  \
+                return (w1 >> w2) | (w1 << (size - w2));        \
+        }                                                       \
+        shift (S##size, rshift, >>)                             \
+        shift (U##size, rshift, >>)                             \
+        binary (size, sub, -)                                   \
+        SsubCheckOverflows (size)                               \
+        binary (size, xorb, ^)                                  \
+        bothCoerce (size, 64)                                   \
+        bothCoerce (size, 32)                                   \
+        bothCoerce (size, 16)                                   \
+        bothCoerce (size, 8)
+
 all (8)
 all (16)
 all (32)
@@ -110,6 +187,11 @@
 #undef bothCoerce
 #undef binary
 #undef bothBinary
+#undef SaddCheckOverflows
+#undef UaddCheckOverflows
+#undef SmulCheckOverflows
+#undef negCheckOverflows
+#undef SsubCheckOverflows
 #undef compare
 #undef bothCompare
 #undef unary

Modified: mlton/branches/on-20050420-cmm-branch/runtime/basis/Int/Word8Array.c
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/basis/Int/Word8Array.c	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/basis/Int/Word8Array.c	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,26 +1,26 @@
 #include "platform.h"
 
 Word32 Word8Array_subWord32Rev (Pointer v, Int offset) {
-	Word32 w;
-	char *p;
-	char *s;
-	int i;
+        Word32 w;
+        char *p;
+        char *s;
+        int i;
 
-	p = (char*)&w;
-	s = v + (offset * 4);
-	for (i = 0; i < 4; ++i)
-		p[i] = s[3 - i];
- 	return w;
+        p = (char*)&w;
+        s = v + (offset * 4);
+        for (i = 0; i < 4; ++i)
+                p[i] = s[3 - i];
+        return w;
 }
 
 void Word8Array_updateWord32Rev (Pointer a, Int offset, Word32 w) {
-	char *p;
-	char *s;
-	int i;
+        char *p;
+        char *s;
+        int i;
 
-	p = (char*)&w;
-	s = a + (offset * 4);
-	for (i = 0; i < 4; ++i) {
-		s[i] = p[3 - i];
-	}
+        p = (char*)&w;
+        s = a + (offset * 4);
+        for (i = 0; i < 4; ++i) {
+                s[i] = p[3 - i];
+        }
 }

Modified: mlton/branches/on-20050420-cmm-branch/runtime/basis/Int/Word8Vector.c
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/basis/Int/Word8Vector.c	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/basis/Int/Word8Vector.c	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,14 +1,14 @@
 #include "platform.h"
 
 Word32 Word8Vector_subWord32Rev (Pointer v, Int offset) {
-	Word32 w;
-	char *p;
-	char *s;
-	int i;
+        Word32 w;
+        char *p;
+        char *s;
+        int i;
 
-	p = (char*)&w;
-	s = v + (offset * 4);
-	for (i = 0; i < 4; ++i)
-		p[i] = s[3 - i];
- 	return w;
+        p = (char*)&w;
+        s = v + (offset * 4);
+        for (i = 0; i < 4; ++i)
+                p[i] = s[3 - i];
+        return w;
 }

Modified: mlton/branches/on-20050420-cmm-branch/runtime/basis/IntInf.c
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/basis/IntInf.c	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/basis/IntInf.c	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,15 +1,15 @@
-/* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+/* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  */
 
 #include "platform.h"
 
 enum {
-	DEBUG_INT_INF = FALSE,
+        DEBUG_INT_INF = FALSE,
 };
 
 /* Import the global gcState so we can get and set the frontier. */
@@ -19,40 +19,40 @@
  * Layout of strings.  Note, the value passed around is a pointer to
  * the chars member.
  */
-typedef struct	strng {
-	uint	counter,	/* used by GC. */
-		card,		/* number of chars */
-		magic;		/* STRMAGIC */
-	char	chars[0];	/* actual chars */
-}	strng;
+typedef struct  strng {
+        uint    counter,        /* used by GC. */
+                card,           /* number of chars */
+                magic;          /* STRMAGIC */
+        char    chars[0];       /* actual chars */
+}       strng;
 
 /*
  * Test if a intInf is a fixnum.
  */
 static inline uint isSmall (pointer arg) {
-	return ((uint)arg & 1);
+        return ((uint)arg & 1);
 }
 
 static inline uint eitherIsSmall (pointer arg1, pointer arg2) {
-	return (1 & ((uint)arg1 | (uint)arg2));
+        return (1 & ((uint)arg1 | (uint)arg2));
 }
 
 static inline uint areSmall (pointer arg1, pointer arg2) {
-	return ((uint)arg1 & (uint)arg2 & 1);
+        return ((uint)arg1 & (uint)arg2 & 1);
 }
 
 /*
  * Convert a bignum intInf to a bignum pointer.
  */
 static inline bignum * toBignum (pointer arg) {
-	bignum	*bp;
+        bignum  *bp;
 
-	assert(not isSmall(arg));
-	bp = (bignum *)((uint)arg - offsetof(struct bignum, isneg));
-	if (DEBUG_INT_INF)
-		fprintf (stderr, "bp->magic = 0x%08x\n", bp->magic);
-	assert (bp->magic == BIGMAGIC);
-	return bp;
+        assert(not isSmall(arg));
+        bp = (bignum *)((uint)arg - offsetof(struct bignum, isneg));
+        if (DEBUG_INT_INF)
+                fprintf (stderr, "bp->magic = 0x%08x\n", bp->magic);
+        assert (bp->magic == BIGMAGIC);
+        return bp;
 }
 
 /*
@@ -60,45 +60,45 @@
  * to contain 2 limbs, fill in the __mpz_struct.
  */
 static inline void fill (pointer arg, __mpz_struct *res, mp_limb_t space[2]) {
-	bignum	*bp;
+        bignum  *bp;
 
-	if (DEBUG_INT_INF)
-		fprintf (stderr, "fill (0x%08x, 0x%08x, 0x%08x)\n",
-				(uint)arg, (uint)res, (uint)space);
-	if (isSmall(arg)) {
-		res->_mp_alloc = 2;
-		res->_mp_d = space;
-		if ((int)arg > 1) {
-			res->_mp_size = 1;
-			space[0] = (uint)arg >> 1;
-		} else if ((int)arg < 0) {
-			res->_mp_size = -1;
-			space[0] = - (int)((uint)arg>>1 | (uint)1<<31);
-		} else
-			res->_mp_size = 0;
-	} else {
-		bp = toBignum(arg);
-		res->_mp_alloc = bp->card - 1;
-		res->_mp_d = bp->limbs;
-		res->_mp_size = bp->isneg ? - res->_mp_alloc
-					: res->_mp_alloc;
-	}
+        if (DEBUG_INT_INF)
+                fprintf (stderr, "fill (0x%08x, 0x%08x, 0x%08x)\n",
+                                (uint)arg, (uint)res, (uint)space);
+        if (isSmall(arg)) {
+                res->_mp_alloc = 2;
+                res->_mp_d = space;
+                if ((int)arg > 1) {
+                        res->_mp_size = 1;
+                        space[0] = (uint)arg >> 1;
+                } else if ((int)arg < 0) {
+                        res->_mp_size = -1;
+                        space[0] = - (int)((uint)arg>>1 | (uint)1<<31);
+                } else
+                        res->_mp_size = 0;
+        } else {
+                bp = toBignum(arg);
+                res->_mp_alloc = bp->card - 1;
+                res->_mp_d = bp->limbs;
+                res->_mp_size = bp->isneg ? - res->_mp_alloc
+                                        : res->_mp_alloc;
+        }
 }
 
 /*
  * Initialize an __mpz_struct to use the space provided by an ML array.
  */
 static inline void initRes (__mpz_struct *mpzp, uint bytes) {
-	struct bignum *bp;
+        struct bignum *bp;
 
-	assert (bytes <= gcState.limitPlusSlop - gcState.frontier);
-	bp = (bignum*)gcState.frontier;
-	/* We have as much space for the limbs as there is to the end of the 
+        assert (bytes <= gcState.limitPlusSlop - gcState.frontier);
+        bp = (bignum*)gcState.frontier;
+        /* We have as much space for the limbs as there is to the end of the 
          * heap.  Divide by 4 to get number of words. 
          */
-	mpzp->_mp_alloc = (gcState.limitPlusSlop - (pointer)bp->limbs) / 4;
-	mpzp->_mp_size = 0; /* is this necessary? */
-	mpzp->_mp_d = bp->limbs;
+        mpzp->_mp_alloc = (gcState.limitPlusSlop - (pointer)bp->limbs) / 4;
+        mpzp->_mp_size = 0; /* is this necessary? */
+        mpzp->_mp_d = bp->limbs;
 }
 
 /*
@@ -106,23 +106,23 @@
  * This MUST be replaced with assembler.
  */
 static inline uint leadingZeros (mp_limb_t word) {
-	uint	res;
+        uint    res;
 
-	assert(word != 0);
-	res = 0;
-	while ((int)word > 0) {
-		++res;
-		word <<= 1;
-	}
-	return (res);
+        assert(word != 0);
+        res = 0;
+        while ((int)word > 0) {
+                ++res;
+                word <<= 1;
+        }
+        return (res);
 }
 
 static inline void setFrontier (pointer p, uint bytes) {
-	p = GC_alignFrontier (&gcState, p);
-	assert (p - gcState.frontier <= bytes);
-	GC_profileAllocInc (&gcState, p - gcState.frontier);
-	gcState.frontier = p;
-	assert (gcState.frontier <= gcState.limitPlusSlop);
+        p = GC_alignFrontier (&gcState, p);
+        assert (p - gcState.frontier <= bytes);
+        GC_profileAllocInc (&gcState, p - gcState.frontier);
+        gcState.frontier = p;
+        assert (gcState.frontier <= gcState.limitPlusSlop);
 }
 
 /*
@@ -134,180 +134,180 @@
  * the array size and roll the frontier slightly back.
  */
 static pointer answer (__mpz_struct *ans, uint bytes) {
-	bignum			*bp;
-	int			size;
+        bignum                  *bp;
+        int                     size;
 
-	bp = (bignum *)((pointer)ans->_mp_d - offsetof(struct bignum, limbs));
-	assert(ans->_mp_d == bp->limbs);
-	size = ans->_mp_size;
-	if (size < 0) {
-		bp->isneg = TRUE;
-		size = - size;
-	} else
-		bp->isneg = FALSE;
-	if (size <= 1) {
-		uint	val,
-			ans;
+        bp = (bignum *)((pointer)ans->_mp_d - offsetof(struct bignum, limbs));
+        assert(ans->_mp_d == bp->limbs);
+        size = ans->_mp_size;
+        if (size < 0) {
+                bp->isneg = TRUE;
+                size = - size;
+        } else
+                bp->isneg = FALSE;
+        if (size <= 1) {
+                uint    val,
+                        ans;
 
-		if (size == 0)
-			val = 0;
-		else
-			val = bp->limbs[0];
-		if (bp->isneg) {
-			/*
-			 * We only fit if val in [1, 2^30].
-			 */
-			ans = - val;
-			val = val - 1;
-		} else
-			/*
-			 * We only fit if val in [0, 2^30 - 1].
-			 */
-			ans = val;
-		if (val < (uint)1<<30) {
-			return (pointer)(ans<<1 | 1);
-		}
-	}
-	setFrontier ((pointer)&bp->limbs[size], bytes);
-	bp->counter = 0;
-	bp->card = size + 1; /* +1 for isNeg word */
-	bp->magic = BIGMAGIC;
-	return (pointer)&bp->isneg;
+                if (size == 0)
+                        val = 0;
+                else
+                        val = bp->limbs[0];
+                if (bp->isneg) {
+                        /*
+                         * We only fit if val in [1, 2^30].
+                         */
+                        ans = - val;
+                        val = val - 1;
+                } else
+                        /*
+                         * We only fit if val in [0, 2^30 - 1].
+                         */
+                        ans = val;
+                if (val < (uint)1<<30) {
+                        return (pointer)(ans<<1 | 1);
+                }
+        }
+        setFrontier ((pointer)&bp->limbs[size], bytes);
+        bp->counter = 0;
+        bp->card = size + 1; /* +1 for isNeg word */
+        bp->magic = BIGMAGIC;
+        return (pointer)&bp->isneg;
 }
 
 static inline pointer binary (pointer lhs, pointer rhs, uint bytes,
-				void(*binop)(__mpz_struct *resmpz, 
-					__gmp_const __mpz_struct *lhsspace,
-					__gmp_const __mpz_struct *rhsspace)) {
-	__mpz_struct	lhsmpz,
-			rhsmpz,
-			resmpz;
-	mp_limb_t	lhsspace[2],
-			rhsspace[2];
+                                void(*binop)(__mpz_struct *resmpz, 
+                                        __gmp_const __mpz_struct *lhsspace,
+                                        __gmp_const __mpz_struct *rhsspace)) {
+        __mpz_struct    lhsmpz,
+                        rhsmpz,
+                        resmpz;
+        mp_limb_t       lhsspace[2],
+                        rhsspace[2];
 
-	initRes (&resmpz, bytes);
-	fill (lhs, &lhsmpz, lhsspace);
-	fill (rhs, &rhsmpz, rhsspace);
-	binop (&resmpz, &lhsmpz, &rhsmpz);
-	return answer (&resmpz, bytes);
+        initRes (&resmpz, bytes);
+        fill (lhs, &lhsmpz, lhsspace);
+        fill (rhs, &rhsmpz, rhsspace);
+        binop (&resmpz, &lhsmpz, &rhsmpz);
+        return answer (&resmpz, bytes);
 }
 
 pointer IntInf_add (pointer lhs, pointer rhs, uint bytes) {
-	if (DEBUG_INT_INF)
-		fprintf (stderr, "IntInf_add (0x%08x, 0x%08x, %u)\n",
-				(uint)lhs, (uint)rhs, bytes);
-	return binary (lhs, rhs, bytes, &mpz_add);
+        if (DEBUG_INT_INF)
+                fprintf (stderr, "IntInf_add (0x%08x, 0x%08x, %u)\n",
+                                (uint)lhs, (uint)rhs, bytes);
+        return binary (lhs, rhs, bytes, &mpz_add);
 }
 
 pointer IntInf_gcd (pointer lhs, pointer rhs, uint bytes) {
-	if (DEBUG_INT_INF)
-		fprintf (stderr, "IntInf_gcd (0x%08x, 0x%08x, %u)\n",
-				(uint)lhs, (uint)rhs, bytes);
-	return binary (lhs, rhs, bytes, &mpz_gcd);
+        if (DEBUG_INT_INF)
+                fprintf (stderr, "IntInf_gcd (0x%08x, 0x%08x, %u)\n",
+                                (uint)lhs, (uint)rhs, bytes);
+        return binary (lhs, rhs, bytes, &mpz_gcd);
 }
 
 pointer IntInf_mul (pointer lhs, pointer rhs, uint bytes) {
-	if (DEBUG_INT_INF)
-		fprintf (stderr, "IntInf_mul (0x%08x, 0x%08x, %u)\n",
-				(uint)lhs, (uint)rhs, bytes);
-	return binary (lhs, rhs, bytes, &mpz_mul);
+        if (DEBUG_INT_INF)
+                fprintf (stderr, "IntInf_mul (0x%08x, 0x%08x, %u)\n",
+                                (uint)lhs, (uint)rhs, bytes);
+        return binary (lhs, rhs, bytes, &mpz_mul);
 }
 
 pointer IntInf_sub (pointer lhs, pointer rhs, uint bytes) {
-	if (DEBUG_INT_INF)
-		fprintf (stderr, "IntInf_sub (0x%08x, 0x%08x, %u)\n",
-				(uint)lhs, (uint)rhs, bytes);
-	return binary (lhs, rhs, bytes, &mpz_sub);
+        if (DEBUG_INT_INF)
+                fprintf (stderr, "IntInf_sub (0x%08x, 0x%08x, %u)\n",
+                                (uint)lhs, (uint)rhs, bytes);
+        return binary (lhs, rhs, bytes, &mpz_sub);
 }
 
 pointer IntInf_andb(pointer lhs, pointer rhs, uint bytes) {
-	if (DEBUG_INT_INF)
-		fprintf (stderr, "IntInf_andb (0x%08x, 0x%08x, %u)\n",
-				(uint)lhs, (uint)rhs, bytes);
-	return binary(lhs, rhs, bytes, &mpz_and);
+        if (DEBUG_INT_INF)
+                fprintf (stderr, "IntInf_andb (0x%08x, 0x%08x, %u)\n",
+                                (uint)lhs, (uint)rhs, bytes);
+        return binary(lhs, rhs, bytes, &mpz_and);
 }
 
 pointer IntInf_orb(pointer lhs, pointer rhs, uint bytes) {
-	if (DEBUG_INT_INF)
-		fprintf (stderr, "IntInf_orb (0x%08x, 0x%08x, %u)\n",
-				(uint)lhs, (uint)rhs, bytes);
-	return binary(lhs, rhs, bytes, &mpz_ior);
+        if (DEBUG_INT_INF)
+                fprintf (stderr, "IntInf_orb (0x%08x, 0x%08x, %u)\n",
+                                (uint)lhs, (uint)rhs, bytes);
+        return binary(lhs, rhs, bytes, &mpz_ior);
 }
 
 pointer IntInf_xorb(pointer lhs, pointer rhs, uint bytes) {
-	if (DEBUG_INT_INF)
-		fprintf (stderr, "IntInf_xorb (0x%08x, 0x%08x, %u)\n",
-				(uint)lhs, (uint)rhs, bytes);
-	return binary(lhs, rhs, bytes, &mpz_xor);
+        if (DEBUG_INT_INF)
+                fprintf (stderr, "IntInf_xorb (0x%08x, 0x%08x, %u)\n",
+                                (uint)lhs, (uint)rhs, bytes);
+        return binary(lhs, rhs, bytes, &mpz_xor);
 }
 
 static pointer
 unary(pointer arg, uint bytes,
       void(*unop)(__mpz_struct *resmpz, 
-		  __gmp_const __mpz_struct *argspace))
+                  __gmp_const __mpz_struct *argspace))
 {
-	__mpz_struct	argmpz,
-			resmpz;
-	mp_limb_t	argspace[2];
+        __mpz_struct    argmpz,
+                        resmpz;
+        mp_limb_t       argspace[2];
 
-	initRes(&resmpz, bytes);
-	fill(arg, &argmpz, argspace);
-	unop(&resmpz, &argmpz);
-	return answer (&resmpz, bytes);
+        initRes(&resmpz, bytes);
+        fill(arg, &argmpz, argspace);
+        unop(&resmpz, &argmpz);
+        return answer (&resmpz, bytes);
 }
 
 pointer IntInf_neg(pointer arg, uint bytes) {
-	if (DEBUG_INT_INF)
-		fprintf (stderr, "IntInf_neg (0x%08x, %u)\n",
-				(uint)arg, bytes);
-	return unary(arg, bytes, &mpz_neg);
+        if (DEBUG_INT_INF)
+                fprintf (stderr, "IntInf_neg (0x%08x, %u)\n",
+                                (uint)arg, bytes);
+        return unary(arg, bytes, &mpz_neg);
 }
 
 pointer IntInf_notb(pointer arg, uint bytes) {
-	if (DEBUG_INT_INF)
-		fprintf (stderr, "IntInf_notb (0x%08x, %u)\n",
-				(uint)arg, bytes);
-	return unary(arg, bytes, &mpz_com);
+        if (DEBUG_INT_INF)
+                fprintf (stderr, "IntInf_notb (0x%08x, %u)\n",
+                                (uint)arg, bytes);
+        return unary(arg, bytes, &mpz_com);
 }
 
 static pointer
 shary(pointer arg, uint shift, uint bytes,
       void(*shop)(__mpz_struct *resmpz, 
-		  __gmp_const __mpz_struct *argspace,
-		  ulong shift))
+                  __gmp_const __mpz_struct *argspace,
+                  ulong shift))
 {
-	__mpz_struct	argmpz,
-			resmpz;
-	mp_limb_t	argspace[2];
+        __mpz_struct    argmpz,
+                        resmpz;
+        mp_limb_t       argspace[2];
 
-	initRes(&resmpz, bytes);
-	fill(arg, &argmpz, argspace);
-	shop(&resmpz, &argmpz, (ulong)shift);
-	return answer (&resmpz, bytes);
+        initRes(&resmpz, bytes);
+        fill(arg, &argmpz, argspace);
+        shop(&resmpz, &argmpz, (ulong)shift);
+        return answer (&resmpz, bytes);
 }
 
 pointer IntInf_arshift(pointer arg, uint shift, uint bytes) {
-	if (DEBUG_INT_INF)
-		fprintf (stderr, "IntInf_arshift (0x%08x, %u, %u)\n",
-				(uint)arg, shift, bytes);
-	return shary(arg, shift, bytes, &mpz_fdiv_q_2exp);
+        if (DEBUG_INT_INF)
+                fprintf (stderr, "IntInf_arshift (0x%08x, %u, %u)\n",
+                                (uint)arg, shift, bytes);
+        return shary(arg, shift, bytes, &mpz_fdiv_q_2exp);
 }
 
 pointer IntInf_lshift(pointer arg, uint shift, uint bytes) {
-	if (DEBUG_INT_INF)
-		fprintf (stderr, "IntInf_lshift (0x%08x, %u, %u)\n",
-				(uint)arg, shift, bytes);
-	return shary(arg, shift, bytes, &mpz_mul_2exp);
+        if (DEBUG_INT_INF)
+                fprintf (stderr, "IntInf_lshift (0x%08x, %u, %u)\n",
+                                (uint)arg, shift, bytes);
+        return shary(arg, shift, bytes, &mpz_mul_2exp);
 }
 
 Word
 IntInf_smallMul(Word lhs, Word rhs, pointer carry)
 {
-	llong	prod;
+        llong   prod;
 
-	prod = (llong)(int)lhs * (int)rhs;
-	*(uint *)carry = (ullong)prod >> 32;
-	return ((uint)(ullong)prod);
+        prod = (llong)(int)lhs * (int)rhs;
+        *(uint *)carry = (ullong)prod >> 32;
+        return ((uint)(ullong)prod);
 }
 
 /*
@@ -315,29 +315,29 @@
  * to each other.
  */
 Int IntInf_compare (pointer lhs, pointer rhs) {
-	__mpz_struct		lhsmpz,
-				rhsmpz;
-	mp_limb_t		lhsspace[2],
-				rhsspace[2];
+        __mpz_struct            lhsmpz,
+                                rhsmpz;
+        mp_limb_t               lhsspace[2],
+                                rhsspace[2];
 
-	if (DEBUG_INT_INF)
-		fprintf (stderr, "IntInf_compare (0x%08x, 0x%08x)\n",
-				(uint)lhs, (uint)rhs);
-	fill (lhs, &lhsmpz, lhsspace);
-	fill (rhs, &rhsmpz, rhsspace);
-	return mpz_cmp (&lhsmpz, &rhsmpz);
+        if (DEBUG_INT_INF)
+                fprintf (stderr, "IntInf_compare (0x%08x, 0x%08x)\n",
+                                (uint)lhs, (uint)rhs);
+        fill (lhs, &lhsmpz, lhsspace);
+        fill (rhs, &rhsmpz, rhsspace);
+        return mpz_cmp (&lhsmpz, &rhsmpz);
 }
 
 /*
  * Check if two IntInf.int's are equal.
  */
 Bool IntInf_equal (pointer lhs, pointer rhs) {
-	if (lhs == rhs)
-		return TRUE;
-	if (eitherIsSmall (lhs, rhs))
-		return FALSE;
-	else
-		return 0 == IntInf_compare (lhs, rhs);
+        if (lhs == rhs)
+                return TRUE;
+        if (eitherIsSmall (lhs, rhs))
+                return FALSE;
+        else
+                return 0 == IntInf_compare (lhs, rhs);
 }
 
 /*
@@ -346,209 +346,209 @@
  * string (mutable) which is large enough.
  */
 pointer IntInf_toString (pointer arg, int base, uint bytes) {
-	strng		*sp;
-	__mpz_struct	argmpz;
-	mp_limb_t	argspace[2];
-	char		*str;
-	uint		size;
-	int		i;
-	char		c;
+        strng           *sp;
+        __mpz_struct    argmpz;
+        mp_limb_t       argspace[2];
+        char            *str;
+        uint            size;
+        int             i;
+        char            c;
 
-	if (DEBUG_INT_INF)
-		fprintf (stderr, "IntInf_toString (0x%08x, %d, %u)\n",
-				(uint)arg, base, bytes);
-	assert (base == 2 || base == 8 || base == 10 || base == 16);
-	fill (arg, &argmpz, argspace);
-	sp = (strng*)gcState.frontier;
-	str = mpz_get_str(sp->chars, base, &argmpz);
-	assert(str == sp->chars);
-	size = strlen(str);
-	if (*sp->chars == '-')
-		*sp->chars = '~';
+        if (DEBUG_INT_INF)
+                fprintf (stderr, "IntInf_toString (0x%08x, %d, %u)\n",
+                                (uint)arg, base, bytes);
+        assert (base == 2 || base == 8 || base == 10 || base == 16);
+        fill (arg, &argmpz, argspace);
+        sp = (strng*)gcState.frontier;
+        str = mpz_get_str(sp->chars, base, &argmpz);
+        assert(str == sp->chars);
+        size = strlen(str);
+        if (*sp->chars == '-')
+                *sp->chars = '~';
         if (base > 0)
-		for (i = 0; i < size; i++) {
-			c = sp->chars[i];
-			if (('a' <= c) && (c <= 'z'))
-				sp->chars[i] = c + ('A' - 'a');
-		}
-	sp->counter = 0;
-	sp->card = size;
-	sp->magic = STRMAGIC;
-	setFrontier (&sp->chars[wordAlign(size)], bytes);
-	return (pointer)str;
+                for (i = 0; i < size; i++) {
+                        c = sp->chars[i];
+                        if (('a' <= c) && (c <= 'z'))
+                                sp->chars[i] = c + ('A' - 'a');
+                }
+        sp->counter = 0;
+        sp->card = size;
+        sp->magic = STRMAGIC;
+        setFrontier (&sp->chars[wordAlign(size)], bytes);
+        return (pointer)str;
 }
 
 /*
  * Quotient (round towards 0, remainder is returned by IntInf_rem).
  * space is a word array with enough space for the quotient
- *	num limbs + 1 - den limbs
+ *      num limbs + 1 - den limbs
  * shifted numerator
- *	num limbs + 1
+ *      num limbs + 1
  * and shifted denominator
- *	den limbs
+ *      den limbs
  * and the isNeg word.
  * It must be the last thing allocated.
  * num is the numerator bignum, den is the denominator and frontier is
  * the current frontier.
  */
 pointer IntInf_quot (pointer num, pointer den, uint bytes) {
-	__mpz_struct	resmpz,
-			nmpz,
-			dmpz;
-	mp_limb_t	nss[2],
-			dss[2],
-			carry,
-			*np,
-			*dp;
-	int		nsize,
-			dsize,
-			qsize;
-	bool		resIsNeg;
-	uint		shift;
+        __mpz_struct    resmpz,
+                        nmpz,
+                        dmpz;
+        mp_limb_t       nss[2],
+                        dss[2],
+                        carry,
+                        *np,
+                        *dp;
+        int             nsize,
+                        dsize,
+                        qsize;
+        bool            resIsNeg;
+        uint            shift;
 
-	initRes(&resmpz, bytes);
-	fill(num, &nmpz, nss);
-	resIsNeg = FALSE;
-	nsize = nmpz._mp_size;
-	if (nsize < 0) {
-		nsize = - nsize;
-		resIsNeg = TRUE;
-	}
-	fill(den, &dmpz, dss);
-	dsize = dmpz._mp_size;
-	if (dsize < 0) {
-		dsize = - dsize;
-		resIsNeg = not resIsNeg;
-	}
-	assert(dsize != 0 && dmpz._mp_d[dsize - 1] != 0);
-	assert((nsize == 0 && dsize == 1)
-	or (nsize >= dsize && nmpz._mp_d[nsize - 1] != 0));
-	qsize = 1 + nsize - dsize;
-	if (dsize == 1) {
-		if (nsize == 0)
-			return (pointer)1; /* tagged 0 */
-		mpn_divrem_1(resmpz._mp_d,
-			     (mp_size_t)0,
-			     nmpz._mp_d,
-			     nsize,
-			     dmpz._mp_d[0]);
-		if (resmpz._mp_d[qsize - 1] == 0)
-			--qsize;
-	} else {
-		np = &resmpz._mp_d[qsize];
-		shift = leadingZeros(dmpz._mp_d[dsize - 1]);
-		if (shift == 0) {
-			dp = dmpz._mp_d;
-			memcpy((void *)np,
-			       nmpz._mp_d,
-			       nsize * sizeof(*nmpz._mp_d));
-		} else {
-			carry = mpn_lshift(np, nmpz._mp_d, nsize, shift);
-			unless (carry == 0)
-				np[nsize++] = carry;
-			dp = &np[nsize];
-			mpn_lshift(dp, dmpz._mp_d, dsize, shift);
-		}
-		carry = mpn_divrem(resmpz._mp_d,
-				   (mp_size_t)0,
-				   np,
-				   nsize,
-				   dp,
-				   dsize);
-		qsize = nsize - dsize;
-		if (carry != 0)
-			resmpz._mp_d[qsize++] = carry;
-	}
-	resmpz._mp_size = resIsNeg ? - qsize : qsize;
-	return answer (&resmpz, bytes);
+        initRes(&resmpz, bytes);
+        fill(num, &nmpz, nss);
+        resIsNeg = FALSE;
+        nsize = nmpz._mp_size;
+        if (nsize < 0) {
+                nsize = - nsize;
+                resIsNeg = TRUE;
+        }
+        fill(den, &dmpz, dss);
+        dsize = dmpz._mp_size;
+        if (dsize < 0) {
+                dsize = - dsize;
+                resIsNeg = not resIsNeg;
+        }
+        assert(dsize != 0 && dmpz._mp_d[dsize - 1] != 0);
+        assert((nsize == 0 && dsize == 1)
+        or (nsize >= dsize && nmpz._mp_d[nsize - 1] != 0));
+        qsize = 1 + nsize - dsize;
+        if (dsize == 1) {
+                if (nsize == 0)
+                        return (pointer)1; /* tagged 0 */
+                mpn_divrem_1(resmpz._mp_d,
+                             (mp_size_t)0,
+                             nmpz._mp_d,
+                             nsize,
+                             dmpz._mp_d[0]);
+                if (resmpz._mp_d[qsize - 1] == 0)
+                        --qsize;
+        } else {
+                np = &resmpz._mp_d[qsize];
+                shift = leadingZeros(dmpz._mp_d[dsize - 1]);
+                if (shift == 0) {
+                        dp = dmpz._mp_d;
+                        memcpy((void *)np,
+                               nmpz._mp_d,
+                               nsize * sizeof(*nmpz._mp_d));
+                } else {
+                        carry = mpn_lshift(np, nmpz._mp_d, nsize, shift);
+                        unless (carry == 0)
+                                np[nsize++] = carry;
+                        dp = &np[nsize];
+                        mpn_lshift(dp, dmpz._mp_d, dsize, shift);
+                }
+                carry = mpn_divrem(resmpz._mp_d,
+                                   (mp_size_t)0,
+                                   np,
+                                   nsize,
+                                   dp,
+                                   dsize);
+                qsize = nsize - dsize;
+                if (carry != 0)
+                        resmpz._mp_d[qsize++] = carry;
+        }
+        resmpz._mp_size = resIsNeg ? - qsize : qsize;
+        return answer (&resmpz, bytes);
 }
 
 
 /*
  * Remainder (sign taken from numerator, quotient is returned by IntInf_quot).
  * space is a word array with enough space for the remainder
- *	den limbs
+ *      den limbs
  * shifted numerator
- *	num limbs + 1
+ *      num limbs + 1
  * and shifted denominator
- *	den limbs
+ *      den limbs
  * and the isNeg word.
  * It must be the last thing allocated.
  * num is the numerator bignum, den is the denominator and frontier is
  * the current frontier.
  */
 pointer IntInf_rem (pointer num, pointer den, uint bytes) {
-	__mpz_struct	resmpz,
-			nmpz,
-			dmpz;
-	mp_limb_t	nss[2],
-			dss[2],
-			carry,
-			*dp;
-	int		nsize,
-			dsize;
-	bool		resIsNeg;
-	uint		shift;
+        __mpz_struct    resmpz,
+                        nmpz,
+                        dmpz;
+        mp_limb_t       nss[2],
+                        dss[2],
+                        carry,
+                        *dp;
+        int             nsize,
+                        dsize;
+        bool            resIsNeg;
+        uint            shift;
 
-	initRes(&resmpz, bytes);
-	fill(num, &nmpz, nss);
-	nsize = nmpz._mp_size;
-	resIsNeg = nsize < 0;
-	if (resIsNeg)
-		nsize = - nsize;
-	fill(den, &dmpz, dss);
-	dsize = dmpz._mp_size;
-	if (dsize < 0)
-		dsize = - dsize;
-	assert(dsize != 0 && dmpz._mp_d[dsize - 1] != 0);
-	assert((nsize == 0 && dsize == 1)
-	or (nsize >= dsize && nmpz._mp_d[nsize - 1] != 0));
-	if (dsize == 1) {
-		if (nsize == 0)
-			resmpz._mp_size = 0;
-		else {
-			carry = mpn_mod_1(nmpz._mp_d, nsize, dmpz._mp_d[0]);
-			if (carry == 0)
-				nsize = 0;
-			else {
-				resmpz._mp_d[0] = carry;
-				nsize = 1;
-			}
-		}
-	} else {
-		shift = leadingZeros(dmpz._mp_d[dsize - 1]);
-		if (shift == 0) {
-			dp = dmpz._mp_d;
-			memcpy((void *)resmpz._mp_d,
-			       (void *)nmpz._mp_d,
-			       nsize * sizeof(*nmpz._mp_d));
-		} else {
-			carry = mpn_lshift(resmpz._mp_d,
-					   nmpz._mp_d,
-					   nsize,
-					   shift);
-			unless (carry == 0)
-				resmpz._mp_d[nsize++] = carry;
-			dp = &resmpz._mp_d[nsize];
-			mpn_lshift(dp, dmpz._mp_d, dsize, shift);
-		}
-		mpn_divrem(&resmpz._mp_d[dsize],
-			   (mp_size_t)0,
-			   resmpz._mp_d,
-			   nsize,
-			   dp,
-			   dsize);
-		nsize = dsize;
-		assert(nsize > 0);
-		while (resmpz._mp_d[nsize - 1] == 0)
-			if (--nsize == 0)
-				break;
-		unless (nsize == 0 || shift == 0) {
-			mpn_rshift(resmpz._mp_d, resmpz._mp_d, nsize, shift);
-			if (resmpz._mp_d[nsize - 1] == 0)
-				--nsize;
-		}
-	}
-	resmpz._mp_size = resIsNeg ? - nsize : nsize;
-	return answer (&resmpz, bytes);
+        initRes(&resmpz, bytes);
+        fill(num, &nmpz, nss);
+        nsize = nmpz._mp_size;
+        resIsNeg = nsize < 0;
+        if (resIsNeg)
+                nsize = - nsize;
+        fill(den, &dmpz, dss);
+        dsize = dmpz._mp_size;
+        if (dsize < 0)
+                dsize = - dsize;
+        assert(dsize != 0 && dmpz._mp_d[dsize - 1] != 0);
+        assert((nsize == 0 && dsize == 1)
+        or (nsize >= dsize && nmpz._mp_d[nsize - 1] != 0));
+        if (dsize == 1) {
+                if (nsize == 0)
+                        resmpz._mp_size = 0;
+                else {
+                        carry = mpn_mod_1(nmpz._mp_d, nsize, dmpz._mp_d[0]);
+                        if (carry == 0)
+                                nsize = 0;
+                        else {
+                                resmpz._mp_d[0] = carry;
+                                nsize = 1;
+                        }
+                }
+        } else {
+                shift = leadingZeros(dmpz._mp_d[dsize - 1]);
+                if (shift == 0) {
+                        dp = dmpz._mp_d;
+                        memcpy((void *)resmpz._mp_d,
+                               (void *)nmpz._mp_d,
+                               nsize * sizeof(*nmpz._mp_d));
+                } else {
+                        carry = mpn_lshift(resmpz._mp_d,
+                                           nmpz._mp_d,
+                                           nsize,
+                                           shift);
+                        unless (carry == 0)
+                                resmpz._mp_d[nsize++] = carry;
+                        dp = &resmpz._mp_d[nsize];
+                        mpn_lshift(dp, dmpz._mp_d, dsize, shift);
+                }
+                mpn_divrem(&resmpz._mp_d[dsize],
+                           (mp_size_t)0,
+                           resmpz._mp_d,
+                           nsize,
+                           dp,
+                           dsize);
+                nsize = dsize;
+                assert(nsize > 0);
+                while (resmpz._mp_d[nsize - 1] == 0)
+                        if (--nsize == 0)
+                                break;
+                unless (nsize == 0 || shift == 0) {
+                        mpn_rshift(resmpz._mp_d, resmpz._mp_d, nsize, shift);
+                        if (resmpz._mp_d[nsize - 1] == 0)
+                                --nsize;
+                }
+        }
+        resmpz._mp_size = resIsNeg ? - nsize : nsize;
+        return answer (&resmpz, bytes);
 }

Modified: mlton/branches/on-20050420-cmm-branch/runtime/basis/Itimer/set.c
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/basis/Itimer/set.c	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/basis/Itimer/set.c	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,15 +1,15 @@
 #include "platform.h"
 
 void Itimer_set (Int which,
-			Int interval_tv_sec, Int interval_tv_usec,
-			Int value_tv_sec, Int value_tv_usec) {
-	struct itimerval	v;
-	int i;
+                        Int interval_tv_sec, Int interval_tv_usec,
+                        Int value_tv_sec, Int value_tv_usec) {
+        struct itimerval        v;
+        int i;
 
-	v.it_interval.tv_sec = interval_tv_sec;
-	v.it_interval.tv_usec = interval_tv_usec;
-	v.it_value.tv_sec = value_tv_sec;
-	v.it_value.tv_usec = value_tv_usec;
-       	i = setitimer (which, &v, (struct itimerval *)NULL);
-	assert(i == 0);
+        v.it_interval.tv_sec = interval_tv_sec;
+        v.it_interval.tv_usec = interval_tv_usec;
+        v.it_value.tv_sec = value_tv_sec;
+        v.it_value.tv_usec = value_tv_usec;
+        i = setitimer (which, &v, (struct itimerval *)NULL);
+        assert(i == 0);
 }

Modified: mlton/branches/on-20050420-cmm-branch/runtime/basis/MLton/allocTooLarge.c
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/basis/MLton/allocTooLarge.c	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/basis/MLton/allocTooLarge.c	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,6 +1,6 @@
 #include "platform.h"
 
 void MLton_allocTooLarge () {
-	fprintf (stderr, "Out of memory: attempt to allocate more than %d bytes.\n", 0x7FFFFFFF);
- 	exit (2);
+        fprintf (stderr, "Out of memory: attempt to allocate more than %d bytes.\n", 0x7FFFFFFF);
+        exit (2);
 }

Modified: mlton/branches/on-20050420-cmm-branch/runtime/basis/MLton/bug.c
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/basis/MLton/bug.c	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/basis/MLton/bug.c	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,8 +1,8 @@
 #include "platform.h"
 
 void MLton_bug (Pointer msg) {
-	fprintf (stderr, "MLton bug: %s.\n%s\n",
-			(char*)msg,
-			"Please send a bug report to MLton@mlton.org.");
- 	exit (2);
+        fprintf (stderr, "MLton bug: %s.\n%s\n",
+                        (char*)msg,
+                        "Please send a bug report to MLton@mlton.org.");
+        exit (2);
 }

Modified: mlton/branches/on-20050420-cmm-branch/runtime/basis/MLton/errno.c
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/basis/MLton/errno.c	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/basis/MLton/errno.c	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,5 +1,5 @@
 #include "platform.h"
 
 Int MLton_errno () {
-	return errno;
+        return errno;
 }

Modified: mlton/branches/on-20050420-cmm-branch/runtime/basis/MLton/exit.c
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/basis/MLton/exit.c	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/basis/MLton/exit.c	2006-02-16 19:34:54 UTC (rev 4361)
@@ -3,6 +3,6 @@
 extern struct GC_state gcState;
 
 void MLton_exit (Int status) {
-	GC_done (&gcState);
-	exit (status);
+        GC_done (&gcState);
+        exit (status);
 }

Modified: mlton/branches/on-20050420-cmm-branch/runtime/basis/MLton/profile.c
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/basis/MLton/profile.c	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/basis/MLton/profile.c	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,46 +1,46 @@
 #include "platform.h"
 
 #ifndef DEBUG_PROFILE
-#define	DEBUG_PROFILE FALSE
+#define DEBUG_PROFILE FALSE
 #endif
 
 extern struct GC_state gcState;
 
 void MLton_Profile_Data_free (Pointer p) {
-	GC_profileFree (&gcState, (GC_profile)p);
+        GC_profileFree (&gcState, (GC_profile)p);
 }
 
 Pointer MLton_Profile_Data_malloc (void) {
-	return (Pointer)GC_profileNew (&gcState);
+        return (Pointer)GC_profileNew (&gcState);
 }
 
 void MLton_Profile_Data_write (Pointer p, Word fd) {
-	if (DEBUG_PROFILE)
-		fprintf (stderr, "MLton_Profile_Data_write (0x%08x)\n", (uint)p);
-	GC_profileWrite (&gcState, (GC_profile)p, (int)fd);
+        if (DEBUG_PROFILE)
+                fprintf (stderr, "MLton_Profile_Data_write (0x%08x)\n", (uint)p);
+        GC_profileWrite (&gcState, (GC_profile)p, (int)fd);
 }
 
 Pointer MLton_Profile_current (void) {
-	GC_state s;
-	Pointer res;
+        GC_state s;
+        Pointer res;
 
-	s = &gcState;
-	res = (Pointer)s->profile;
-	if (DEBUG_PROFILE)
-		fprintf (stderr, "0x%08x = MLton_Profile_current ()\n", 
-				(uint)res);
-	return res;
+        s = &gcState;
+        res = (Pointer)s->profile;
+        if (DEBUG_PROFILE)
+                fprintf (stderr, "0x%08x = MLton_Profile_current ()\n", 
+                                (uint)res);
+        return res;
 }
 
 void MLton_Profile_done () {
-	GC_profileDone (&gcState);
+        GC_profileDone (&gcState);
 }
 
 void MLton_Profile_setCurrent (Pointer d) {
-	GC_state s;
+        GC_state s;
 
-	s = &gcState;
-	if (DEBUG_PROFILE)
-		fprintf (stderr, "MLton_Profile_setCurrent (0x%08x)\n", (uint)d);
-	s->profile = (GC_profile)d;
+        s = &gcState;
+        if (DEBUG_PROFILE)
+                fprintf (stderr, "MLton_Profile_setCurrent (0x%08x)\n", (uint)d);
+        s->profile = (GC_profile)d;
 }

Modified: mlton/branches/on-20050420-cmm-branch/runtime/basis/MLton/rlimit.c
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/basis/MLton/rlimit.c	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/basis/MLton/rlimit.c	2006-02-16 19:34:54 UTC (rev 4361)
@@ -3,19 +3,19 @@
 static struct rlimit rlimit;
 
 Int MLton_Rlimit_get (Resource r) {
-	return getrlimit (r, &rlimit);
+        return getrlimit (r, &rlimit);
 }
 
 Rlimit MLton_Rlimit_getHard () {
-	return rlimit.rlim_max;
+        return rlimit.rlim_max;
 }
 
 Rlimit MLton_Rlimit_getSoft () {
-	return rlimit.rlim_cur;
+        return rlimit.rlim_cur;
 }
 
 Int MLton_Rlimit_set (Resource r, Rlimit hard, Rlimit soft) {
-	rlimit.rlim_max = hard;
-	rlimit.rlim_cur = soft;
-	return setrlimit (r, &rlimit);
+        rlimit.rlim_max = hard;
+        rlimit.rlim_cur = soft;
+        return setrlimit (r, &rlimit);
 }

Modified: mlton/branches/on-20050420-cmm-branch/runtime/basis/MLton/rusage.c
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/basis/MLton/rusage.c	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/basis/MLton/rusage.c	2006-02-16 19:34:54 UTC (rev 4361)
@@ -7,55 +7,55 @@
 static struct rusage gc;
 
 Int MLton_Rusage_self_utime_sec () {
-	return self.ru_utime.tv_sec;
+        return self.ru_utime.tv_sec;
 }
 
 Int MLton_Rusage_self_utime_usec () {
-	return self.ru_utime.tv_usec;
+        return self.ru_utime.tv_usec;
 }
 
 Int MLton_Rusage_self_stime_sec () {
-	return self.ru_stime.tv_sec;
+        return self.ru_stime.tv_sec;
 }
 
 Int MLton_Rusage_self_stime_usec () {
-	return self.ru_stime.tv_usec;
+        return self.ru_stime.tv_usec;
 }
 
 Int MLton_Rusage_children_utime_sec () {
-	return children.ru_utime.tv_sec;
+        return children.ru_utime.tv_sec;
 }
 
 Int MLton_Rusage_children_utime_usec () {
-	return children.ru_utime.tv_usec;
+        return children.ru_utime.tv_usec;
 }
 
 Int MLton_Rusage_children_stime_sec () {
-	return children.ru_stime.tv_sec;
+        return children.ru_stime.tv_sec;
 }
 
 Int MLton_Rusage_children_stime_usec () {
-	return children.ru_stime.tv_usec;
+        return children.ru_stime.tv_usec;
 }
 
 Int MLton_Rusage_gc_utime_sec () {
-	return gc.ru_utime.tv_sec;
+        return gc.ru_utime.tv_sec;
 }
 
 Int MLton_Rusage_gc_utime_usec () {
-	return gc.ru_utime.tv_usec;
+        return gc.ru_utime.tv_usec;
 }
 
 Int MLton_Rusage_gc_stime_sec () {
-	return gc.ru_stime.tv_sec;
+        return gc.ru_stime.tv_sec;
 }
 
 Int MLton_Rusage_gc_stime_usec () {
-	return gc.ru_stime.tv_usec;
+        return gc.ru_stime.tv_usec;
 }
 
 void MLton_Rusage_ru () {
-	gc = gcState.ru_gc;
-	fixedGetrusage (RUSAGE_SELF, &self);
-	fixedGetrusage (RUSAGE_CHILDREN, &children);
+        gc = gcState.ru_gc;
+        fixedGetrusage (RUSAGE_SELF, &self);
+        fixedGetrusage (RUSAGE_CHILDREN, &children);
 }

Modified: mlton/branches/on-20050420-cmm-branch/runtime/basis/MLton/share.c
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/basis/MLton/share.c	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/basis/MLton/share.c	2006-02-16 19:34:54 UTC (rev 4361)
@@ -3,5 +3,5 @@
 extern struct GC_state gcState;
 
 void MLton_share (Pointer p) {
-	GC_share (&gcState, p);
+        GC_share (&gcState, p);
 }

Modified: mlton/branches/on-20050420-cmm-branch/runtime/basis/MLton/size.c
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/basis/MLton/size.c	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/basis/MLton/size.c	2006-02-16 19:34:54 UTC (rev 4361)
@@ -3,5 +3,5 @@
 extern struct GC_state gcState;
 
 Word MLton_size(Pointer p) {
-	return GC_size(&gcState, p);
+        return GC_size(&gcState, p);
 }

Modified: mlton/branches/on-20050420-cmm-branch/runtime/basis/MLton/spawne.c
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/basis/MLton/spawne.c	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/basis/MLton/spawne.c	2006-02-16 19:34:54 UTC (rev 4361)
@@ -2,29 +2,33 @@
 
 #if HAS_SPAWN
 Int MLton_Process_spawne (NullString p, Pointer a, Pointer e) {
-	char	*path;
-	char	*asaved;
-	char	*esaved;
-	char	**args;
-	char 	**env;
-	int	an;
-	int	en;
-	int	result;
+        char    *path;
+        char    *asaved;
+        char    *esaved;
+        char    **args;
+        char    **env;
+        int     an;
+        int     en;
+        int     result;
 
-	path = (char *) p;
-	args = (char **) a;
-	env = (char **) e;
-	an = GC_arrayNumElements(a) - 1;
-	asaved = args[an];
-	en = GC_arrayNumElements(e) - 1;
-	esaved = env[en];
-	args[an] = (char *) NULL;
-	env[en] = (char *) NULL;
-	result = spawnve (SPAWN_MODE, path, 
-				(const char * const *)args,
-				(const char * const *)env);
-	args[an] = asaved;
-	env[en] = esaved;
-	return result;
+        path = (char *) p;
+        args = (char **) a;
+        env = (char **) e;
+        an = GC_arrayNumElements(a) - 1;
+        asaved = args[an];
+        en = GC_arrayNumElements(e) - 1;
+        esaved = env[en];
+        args[an] = (char *) NULL;
+        env[en] = (char *) NULL;
+        result = spawnve (SPAWN_MODE, path, 
+                                (const char * const *)args,
+                                (const char * const *)env);
+        args[an] = asaved;
+        env[en] = esaved;
+        return result;
 }
+#else
+Int MLton_Process_spawne (NullString p, Pointer a, Pointer e) {
+        die ("MLton_Process_spawne not implemented");
+}
 #endif

Modified: mlton/branches/on-20050420-cmm-branch/runtime/basis/MLton/spawnp.c
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/basis/MLton/spawnp.c	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/basis/MLton/spawnp.c	2006-02-16 19:34:54 UTC (rev 4361)
@@ -2,19 +2,23 @@
 
 #if HAS_SPAWN
 Int MLton_Process_spawnp (NullString p, Pointer a) {
-	char	*path;
-	char	*asaved;
-	char	**args;
-	int	an;
-	int 	result;
+        char    *path;
+        char    *asaved;
+        char    **args;
+        int     an;
+        int     result;
 
-	path = (char *) p;
-	args = (char **) a;
-	an = GC_arrayNumElements(a) - 1;
-	asaved = args[an];
-	args[an] = (char *) NULL;
-	result = spawnvp (SPAWN_MODE, path, (const char * const *)args);
-	args[an] = asaved;
-	return result;
+        path = (char *) p;
+        args = (char **) a;
+        an = GC_arrayNumElements(a) - 1;
+        asaved = args[an];
+        args[an] = (char *) NULL;
+        result = spawnvp (SPAWN_MODE, path, (const char * const *)args);
+        args[an] = asaved;
+        return result;
 }
+#else
+Int MLton_Process_spawnp (NullString p, Pointer a) {
+        die ("MLton_Process_spawnp not implemented");
+}
 #endif

Modified: mlton/branches/on-20050420-cmm-branch/runtime/basis/MLton/world.c
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/basis/MLton/world.c	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/basis/MLton/world.c	2006-02-16 19:34:54 UTC (rev 4361)
@@ -3,10 +3,10 @@
 extern struct GC_state gcState;
 
 Bool World_isOriginal() {
-	return gcState.isOriginal;
+        return gcState.isOriginal;
 }
 
 
 void World_makeOriginal() {
-	gcState.isOriginal = TRUE;
+        gcState.isOriginal = TRUE;
 }

Modified: mlton/branches/on-20050420-cmm-branch/runtime/basis/Net/Net.c
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/basis/Net/Net.c	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/basis/Net/Net.c	2006-02-16 19:34:54 UTC (rev 4361)
@@ -4,17 +4,17 @@
 #include "platform.h"
 
 Int Net_htonl (Int i) {
-	return htonl (i);
+        return htonl (i);
 }
 
 Int Net_ntohl (Int i) {
-	return ntohl (i);
+        return ntohl (i);
 }
 
 Int Net_htons (Int i) {
-	return htons (i);
+        return htons (i);
 }
 
 Int Net_ntohs (Int i) {
-	return ntohs (i);
+        return ntohs (i);
 }

Modified: mlton/branches/on-20050420-cmm-branch/runtime/basis/Net/NetHostDB.c
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/basis/Net/NetHostDB.c	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/basis/Net/NetHostDB.c	2006-02-16 19:34:54 UTC (rev 4361)
@@ -3,51 +3,51 @@
 static struct hostent *hostent;
 
 Cstring NetHostDB_Entry_name() {
-	return (Cstring)hostent->h_name;
+        return (Cstring)hostent->h_name;
 }
 
 Int NetHostDB_Entry_numAliases() {
-	int num = 0;
-	while (hostent->h_aliases[num] != NULL) num++;
-	return num;
+        int num = 0;
+        while (hostent->h_aliases[num] != NULL) num++;
+        return num;
 }
 
 Cstring NetHostDB_Entry_aliasesN(Int n) {
-	return (Cstring)hostent->h_aliases[n];
+        return (Cstring)hostent->h_aliases[n];
 }
 
 Int NetHostDB_Entry_addrType() {
-	return hostent->h_addrtype;
+        return hostent->h_addrtype;
 }
 
 Int NetHostDB_Entry_length() {
-	return hostent->h_length;
+        return hostent->h_length;
 }
 
 Int NetHostDB_Entry_numAddrs() {
-	int num = 0;
-	while (hostent->h_addr_list[num] != NULL) num++;
-	return num;
+        int num = 0;
+        while (hostent->h_addr_list[num] != NULL) num++;
+        return num;
 }
 
 void NetHostDB_Entry_addrsN(Int n, Pointer addr) {
-	int i;
-	for (i = 0; i < hostent->h_length; i++) {
-		addr[i] = hostent->h_addr_list[n][i];
-	}
-	return;
+        int i;
+        for (i = 0; i < hostent->h_length; i++) {
+                addr[i] = hostent->h_addr_list[n][i];
+        }
+        return;
 }
 
 Bool NetHostDB_getByAddress(Pointer addr, Int len) {
-	hostent = gethostbyaddr(addr, len, AF_INET);
-	return (hostent != NULL and hostent->h_name != NULL);
+        hostent = gethostbyaddr(addr, len, AF_INET);
+        return (hostent != NULL and hostent->h_name != NULL);
 }
 
 Bool NetHostDB_getByName(Cstring name) {
-	hostent = gethostbyname((char*)name);
-	return (hostent != NULL and hostent->h_name != NULL);
+        hostent = gethostbyname((char*)name);
+        return (hostent != NULL and hostent->h_name != NULL);
 }
 
 Int NetHostDB_getHostName(Pointer buf, Int len) {
-	return (gethostname (buf, len));
+        return (gethostname (buf, len));
 }

Modified: mlton/branches/on-20050420-cmm-branch/runtime/basis/Net/NetProtDB.c
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/basis/Net/NetProtDB.c	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/basis/Net/NetProtDB.c	2006-02-16 19:34:54 UTC (rev 4361)
@@ -3,29 +3,29 @@
 static struct protoent *protoent;
 
 Cstring NetProtDB_Entry_name() {
-	return (Cstring)protoent->p_name;
+        return (Cstring)protoent->p_name;
 }
 
 Int NetProtDB_Entry_numAliases() {
-	int num = 0;
-	while (protoent->p_aliases[num] != NULL) num++;
-	return num;
+        int num = 0;
+        while (protoent->p_aliases[num] != NULL) num++;
+        return num;
 }
 
 Cstring NetProtDB_Entry_aliasesN(Int n) {
-	return (Cstring)protoent->p_aliases[n];
+        return (Cstring)protoent->p_aliases[n];
 }
 
 Int NetProtDB_Entry_protocol() {
-	return protoent->p_proto;
+        return protoent->p_proto;
 }
 
 Int NetProtDB_getByName(Cstring name) {
-	protoent = getprotobyname((char*)name);
-	return (protoent != NULL and protoent->p_name != NULL);
+        protoent = getprotobyname((char*)name);
+        return (protoent != NULL and protoent->p_name != NULL);
 }
 
 Int NetProtDB_getByNumber(Int proto) {
-	protoent = getprotobynumber(proto);
-	return (protoent != NULL and protoent->p_name != NULL);
+        protoent = getprotobynumber(proto);
+        return (protoent != NULL and protoent->p_name != NULL);
 }

Modified: mlton/branches/on-20050420-cmm-branch/runtime/basis/Net/NetServDB.c
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/basis/Net/NetServDB.c	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/basis/Net/NetServDB.c	2006-02-16 19:34:54 UTC (rev 4361)
@@ -6,41 +6,41 @@
 static struct servent *servent;
 
 Cstring NetServDB_Entry_name() {
-	return (Cstring)servent->s_name;
+        return (Cstring)servent->s_name;
 }
 
 Int NetServDB_Entry_numAliases() {
-	int num = 0;
-	while (servent->s_aliases[num] != NULL) num++;
-	return num;
+        int num = 0;
+        while (servent->s_aliases[num] != NULL) num++;
+        return num;
 }
 
 Cstring NetServDB_Entry_aliasesN(Int n) {
-	return (Cstring)servent->s_aliases[n];
+        return (Cstring)servent->s_aliases[n];
 }
 
 Int NetServDB_Entry_port() {
-	return servent->s_port;
+        return servent->s_port;
 }
 
 Cstring NetServDB_Entry_protocol() {
-	return (Cstring)servent->s_proto;
+        return (Cstring)servent->s_proto;
 }
 
 Int NetServDB_getByName(Cstring name, Cstring proto) {
-	servent = getservbyname((char*)name, (char*)proto);
-	return (servent != NULL and servent->s_name != NULL);
+        servent = getservbyname((char*)name, (char*)proto);
+        return (servent != NULL and servent->s_name != NULL);
 }
 
 Int NetServDB_getByNameNull(Cstring name) {
-	return NetServDB_getByName(name, (Cstring)NULL);
+        return NetServDB_getByName(name, (Cstring)NULL);
 }
 
 Int NetServDB_getByPort(Int port, Cstring proto) {
-	servent = getservbyport(port, (char*)proto);
-	return (servent != NULL and servent->s_name != NULL);
+        servent = getservbyport(port, (char*)proto);
+        return (servent != NULL and servent->s_name != NULL);
 }
 
 Int NetServDB_getByPortNull(Int port) {
-	return NetServDB_getByPort(port, (Cstring)NULL);
+        return NetServDB_getByPort(port, (Cstring)NULL);
 }

Modified: mlton/branches/on-20050420-cmm-branch/runtime/basis/Net/Socket/INetSock.c
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/basis/Net/Socket/INetSock.c	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/basis/Net/Socket/INetSock.c	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,29 +1,29 @@
 #include "platform.h"
 
 void INetSock_toAddr (Pointer in_addr, Int port, Char* addr, Int *addrlen) {
-	struct sockaddr_in *sa = (struct sockaddr_in*)addr;
+        struct sockaddr_in *sa = (struct sockaddr_in*)addr;
 
-	sa->sin_family = AF_INET;
-	sa->sin_port = port;
-	sa->sin_addr = *(struct in_addr*)in_addr;
-	*addrlen = sizeof(struct sockaddr_in);
+        sa->sin_family = AF_INET;
+        sa->sin_port = port;
+        sa->sin_addr = *(struct in_addr*)in_addr;
+        *addrlen = sizeof(struct sockaddr_in);
 }
 
 static int port;
 static struct in_addr in_addr;
 
 void INetSock_fromAddr (Char* addr) {
-	struct sockaddr_in *sa = (struct sockaddr_in*)addr;
+        struct sockaddr_in *sa = (struct sockaddr_in*)addr;
 
-	assert(sa->sin_family == AF_INET);
-	port = sa->sin_port;
-	in_addr = sa->sin_addr;
+        assert(sa->sin_family == AF_INET);
+        port = sa->sin_port;
+        in_addr = sa->sin_addr;
 }
 
 Int INetSock_getPort () {
-	return port;
+        return port;
 }
 
 void INetSock_getInAddr (Pointer addr) {
-	*(struct in_addr*)addr = in_addr;
+        *(struct in_addr*)addr = in_addr;
 }

Modified: mlton/branches/on-20050420-cmm-branch/runtime/basis/Net/Socket/Socket.c
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/basis/Net/Socket/Socket.c	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/basis/Net/Socket/Socket.c	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,95 +1,95 @@
 #include "platform.h"
 
 Int Socket_accept (Int s, Char *addr, Int *addrlen) {
-	MLton_initSockets ();
-	return accept (s, (struct sockaddr*)addr, (socklen_t*)addrlen);
+        MLton_initSockets ();
+        return accept (s, (struct sockaddr*)addr, (socklen_t*)addrlen);
 }
 
 Int Socket_bind (Int s, Char *addr, Int addrlen) {
-	MLton_initSockets ();
-	return bind (s, (struct sockaddr*)addr, (socklen_t)addrlen);
+        MLton_initSockets ();
+        return bind (s, (struct sockaddr*)addr, (socklen_t)addrlen);
 }
 
 Int Socket_close(Int s) {
-	return close(s);
+        return close(s);
 }
 
 Int Socket_connect (Int s, Char *addr, Int addrlen) {
-	MLton_initSockets ();
-	return connect (s, (struct sockaddr*)addr, (socklen_t)addrlen);
+        MLton_initSockets ();
+        return connect (s, (struct sockaddr*)addr, (socklen_t)addrlen);
 }
 
 Int Socket_familyOfAddr(Char *addr) {
-	return ((struct sockaddr*)addr)->sa_family;
+        return ((struct sockaddr*)addr)->sa_family;
 }
 
 Int Socket_listen (Int s, Int backlog) {
-	MLton_initSockets ();
-	return listen (s, backlog);
+        MLton_initSockets ();
+        return listen (s, backlog);
 }
 
 Int Socket_recv (Int s, Char *msg, Int start, Int len, Word flags) {
-	MLton_initSockets ();
-	return recv (s, (void*)((char *)msg + start), (size_t)len, flags);
+        MLton_initSockets ();
+        return recv (s, (void*)((char *)msg + start), (size_t)len, flags);
 }
 
 Int Socket_recvFrom (Int s, Char *msg, Int start, Int len, Word flags,
                     Char* addr, Int *addrlen) {
-	MLton_initSockets ();
-	return recvfrom (s, (void*)((char *)msg + start), (size_t)len, flags,
-	                        (struct sockaddr*)addr, (socklen_t*)addrlen);
+        MLton_initSockets ();
+        return recvfrom (s, (void*)((char *)msg + start), (size_t)len, flags,
+                                (struct sockaddr*)addr, (socklen_t*)addrlen);
 }
 
 Int Socket_send (Int s, Char *msg, Int start, Int len, Word flags) {
-	MLton_initSockets ();
-	return send (s, (void*)((char *)msg + start), (size_t)len, flags);
+        MLton_initSockets ();
+        return send (s, (void*)((char *)msg + start), (size_t)len, flags);
 }
 
 Int Socket_sendTo (Int s, Char *msg, Int start, Int len, Word flags,
                   Char* addr, Int addrlen) {
-	MLton_initSockets ();
-	return sendto (s, (void*)((char *)msg + start), (size_t)len, flags,
+        MLton_initSockets ();
+        return sendto (s, (void*)((char *)msg + start), (size_t)len, flags,
                       (struct sockaddr*)addr, (socklen_t)addrlen);
 }
 
 Int Socket_shutdown (Int s, Int how) {
-	MLton_initSockets ();
-	return shutdown (s, how);
+        MLton_initSockets ();
+        return shutdown (s, how);
 }
 
 Int GenericSock_socket (Int domain, Int type, Int protocol) {
-	MLton_initSockets ();
-	return socket (domain, type, protocol);
+        MLton_initSockets ();
+        return socket (domain, type, protocol);
 }
 
 Int Socket_socketPair (Int domain, Int type, Int protocol, Int sv[2]) {
-	MLton_initSockets ();
-	return socketpair (domain, type, protocol, (int*)sv);
+        MLton_initSockets ();
+        return socketpair (domain, type, protocol, (int*)sv);
 }
 
 Int Socket_Ctl_getSockOpt (Int s, Int level, Int optname, Char *optval,
-				 Int *optlen) {
-	MLton_initSockets ();
-	return getsockopt (s, level, optname, (void*)optval, (socklen_t*)optlen);
+                                 Int *optlen) {
+        MLton_initSockets ();
+        return getsockopt (s, level, optname, (void*)optval, (socklen_t*)optlen);
 }
 
 Int Socket_Ctl_setSockOpt (Int s, Int level, Int optname, Char *optval, 
-				Int optlen) {
-	MLton_initSockets ();
-	return setsockopt (s, level, optname, (void*)optval, (socklen_t)optlen);
+                                Int optlen) {
+        MLton_initSockets ();
+        return setsockopt (s, level, optname, (void*)optval, (socklen_t)optlen);
 }
 
 Int Socket_Ctl_getsetIOCtl (Int s, Int request, Char* argp) {
-	MLton_initSockets ();
-	return ioctl (s, request, argp);
+        MLton_initSockets ();
+        return ioctl (s, request, argp);
 }
 
 Int Socket_Ctl_getPeerName (Int s, Char *name, Int *namelen) {
-	MLton_initSockets ();
-	return getpeername (s, (struct sockaddr*)name, (socklen_t*)namelen);
+        MLton_initSockets ();
+        return getpeername (s, (struct sockaddr*)name, (socklen_t*)namelen);
 }
 
 Int Socket_Ctl_getSockName (Int s, Char *name, Int *namelen) {
-	MLton_initSockets ();
-	return getsockname (s, (struct sockaddr*)name, (socklen_t*)namelen);
+        MLton_initSockets ();
+        return getsockname (s, (struct sockaddr*)name, (socklen_t*)namelen);
 }

Modified: mlton/branches/on-20050420-cmm-branch/runtime/basis/Net/Socket/UnixSock.c
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/basis/Net/Socket/UnixSock.c	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/basis/Net/Socket/UnixSock.c	2006-02-16 19:34:54 UTC (rev 4361)
@@ -3,43 +3,43 @@
 #define UNIX_PATH_MAX 108
 
 void UnixSock_toAddr (Char* path, Int pathlen, Char* addr, Int *addrlen) {
-	int i;
-	struct sockaddr_un *sa = (struct sockaddr_un*)addr;
+        int i;
+        struct sockaddr_un *sa = (struct sockaddr_un*)addr;
 
-	sa->sun_family = AF_UNIX;
-	i = 0;
-	if (pathlen <= UNIX_PATH_MAX) {
-		for (i = 0; i < pathlen; i++) {
-			sa->sun_path[i] = path[i];
-		}
-	} else {
-		for (i = 0; i < UNIX_PATH_MAX-1; i++) {
-			sa->sun_path[i] = path[i];
-		}
-		sa->sun_path[UNIX_PATH_MAX-1] = '\000';
-	}
-	*addrlen = sizeof(struct sockaddr_un);
+        sa->sun_family = AF_UNIX;
+        i = 0;
+        if (pathlen <= UNIX_PATH_MAX) {
+                for (i = 0; i < pathlen; i++) {
+                        sa->sun_path[i] = path[i];
+                }
+        } else {
+                for (i = 0; i < UNIX_PATH_MAX-1; i++) {
+                        sa->sun_path[i] = path[i];
+                }
+                sa->sun_path[UNIX_PATH_MAX-1] = '\000';
+        }
+        *addrlen = sizeof(struct sockaddr_un);
 }
 
 Int UnixSock_pathLen (Char* addr) {
-	int i;
-	struct sockaddr_un *sa = (struct sockaddr_un*)addr;
+        int i;
+        struct sockaddr_un *sa = (struct sockaddr_un*)addr;
 
-	i = 0;
-	if (sa->sun_path[i] == '\000') {
-		return UNIX_PATH_MAX;
-	} else {
-		while (i < UNIX_PATH_MAX && sa->sun_path[i] != '\000') i++;
-		return i;
-	}
+        i = 0;
+        if (sa->sun_path[i] == '\000') {
+                return UNIX_PATH_MAX;
+        } else {
+                while (i < UNIX_PATH_MAX && sa->sun_path[i] != '\000') i++;
+                return i;
+        }
 }
 
 void UnixSock_fromAddr (Char* addr, Char* path, Int pathlen) {
-	int i;
-	struct sockaddr_un *sa = (struct sockaddr_un*)addr;
+        int i;
+        struct sockaddr_un *sa = (struct sockaddr_un*)addr;
 
-	assert (sa->sun_family == AF_UNIX);
-	for (i = 0; i < pathlen; i++) {
-		path[i] = sa->sun_path[i];
-	}
+        assert (sa->sun_family == AF_UNIX);
+        for (i = 0; i < pathlen; i++) {
+                path[i] = sa->sun_path[i];
+        }
 }

Modified: mlton/branches/on-20050420-cmm-branch/runtime/basis/OS/IO/poll.c
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/basis/OS/IO/poll.c	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/basis/OS/IO/poll.c	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,16 +1,16 @@
 #include "platform.h"
 
 Int OS_IO_poll (Fd *fds, Word *eventss, Int n, Int timeout, Word *reventss) {
-	int i, res;
-	struct pollfd ufds[n];
+        int i, res;
+        struct pollfd ufds[n];
 
-	for (i = 0; i < n; i++) {
-		ufds[i].fd = fds[i];
-		ufds[i].events = eventss[i];
-	}
-	res = poll (ufds, n, timeout);
-	for (i = 0; i < n; i++) {
-		reventss[i] = ufds[i].revents;
-	}
-	return res;
+        for (i = 0; i < n; i++) {
+                ufds[i].fd = fds[i];
+                ufds[i].events = eventss[i];
+        }
+        res = poll (ufds, n, timeout);
+        for (i = 0; i < n; i++) {
+                reventss[i] = ufds[i].revents;
+        }
+        return res;
 }

Modified: mlton/branches/on-20050420-cmm-branch/runtime/basis/PackReal.c
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/basis/PackReal.c	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/basis/PackReal.c	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,85 +1,85 @@
 #include "platform.h"
 
 Real32 PackReal32_subVec (Pointer v, Int offset) {
-	Real32 r;
-	char *p = (char*)&r;
-	char *s = v + offset;
-	int i;
+        Real32 r;
+        char *p = (char*)&r;
+        char *s = v + offset;
+        int i;
 
-	for (i = 0; i < 4; ++i)
-		p[i] = s[i];
- 	return r;
+        for (i = 0; i < 4; ++i)
+                p[i] = s[i];
+        return r;
 }
 
 Real32 PackReal32_subVecRev (Pointer v, Int offset) {
-	Real32 r;
-	char *p = (char*)&r;
-	char *s = v + offset;
-	int i;
+        Real32 r;
+        char *p = (char*)&r;
+        char *s = v + offset;
+        int i;
 
-	for (i = 0; i < 4; ++i)
-		p[i] = s[3 - i];
- 	return r;
+        for (i = 0; i < 4; ++i)
+                p[i] = s[3 - i];
+        return r;
 }
 
 Real64 PackReal64_subVec (Pointer v, Int offset) {
-	Real64 r;
-	char *p = (char*)&r;
-	char *s = v + offset;
-	int i;
+        Real64 r;
+        char *p = (char*)&r;
+        char *s = v + offset;
+        int i;
 
-	for (i = 0; i < 8; ++i)
-		p[i] = s[i];
- 	return r;
+        for (i = 0; i < 8; ++i)
+                p[i] = s[i];
+        return r;
 }
 
 Real64 PackReal64_subVecRev (Pointer v, Int offset) {
-	Real64 r;
-	char *p = (char*)&r;
-	char *s = v + offset;
-	int i;
+        Real64 r;
+        char *p = (char*)&r;
+        char *s = v + offset;
+        int i;
 
-	for (i = 0; i < 8; ++i)
-		p[i] = s[7 - i];
- 	return r;
+        for (i = 0; i < 8; ++i)
+                p[i] = s[7 - i];
+        return r;
 }
 
 void PackReal32_update (Pointer a, Int offset, Real32 r) {
-	char *p = (char*)&r;
-	char *s = a + offset;
-	int i;
+        char *p = (char*)&r;
+        char *s = a + offset;
+        int i;
 
-	for (i = 0; i < 4; ++i) {
-		s[i] = p[i];
-	}
+        for (i = 0; i < 4; ++i) {
+                s[i] = p[i];
+        }
 }
 
 void PackReal32_updateRev (Pointer a, Int offset, Real32 r) {
-	char *p = (char*)&r;
-	char *s = a + offset;
-	int i;
+        char *p = (char*)&r;
+        char *s = a + offset;
+        int i;
 
-	for (i = 0; i < 4; ++i) {
-		s[i] = p[3 - i];
-	}
+        for (i = 0; i < 4; ++i) {
+                s[i] = p[3 - i];
+        }
 }
 
 void PackReal64_update (Pointer a, Int offset, Real64 r) {
-	char *p = (char*)&r;
-	char *s = a + offset;
-	int i;
+        char *p = (char*)&r;
+        char *s = a + offset;
+        int i;
 
-	for (i = 0; i < 8; ++i) {
-		s[i] = p[i];
-	}
+        for (i = 0; i < 8; ++i) {
+                s[i] = p[i];
+        }
 }
 
 void PackReal64_updateRev (Pointer a, Int offset, Real64 r) {
-	char *p = (char*)&r;
-	char *s = a + offset;
-	int i;
+        char *p = (char*)&r;
+        char *s = a + offset;
+        int i;
 
-	for (i = 0; i < 8; ++i) {
-		s[i] = p[7 - i];
-	}
+        for (i = 0; i < 8; ++i) {
+                s[i] = p[7 - i];
+        }
 }

Modified: mlton/branches/on-20050420-cmm-branch/runtime/basis/Ptrace.c
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/basis/Ptrace.c	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/basis/Ptrace.c	2006-02-16 19:34:54 UTC (rev 4361)
@@ -3,11 +3,11 @@
 #if HAS_PTRACE
 
 Int Ptrace_ptrace2 (Int request, Int pid) {
-	return ptrace (request, pid, 0, 0);
+        return ptrace (request, pid, 0, 0);
 }
 
 Int Ptrace_ptrace4 (Int request, Int pid, Word addr, Pointer data) {
-	return ptrace (request, pid, (int) addr, (int) data);
+        return ptrace (request, pid, (int) addr, (int) data);
 }
 
 #endif

Modified: mlton/branches/on-20050420-cmm-branch/runtime/basis/Real/Math.c
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/basis/Real/Math.c	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/basis/Real/Math.c	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,35 +1,36 @@
 #include "platform.h"
 
-#define unaryReal(f, g)						\
-	Real64 g (Real64 x);					\
-	Real64 Real64_##f (Real64 x) {		\
-		return g (x);					\
-	}							\
-	Real32 Real32_##f (Real32 x) {		\
-		return (Real32)(Real64_##f ((Real64)x));	\
-	}
+#define unaryReal(f, g)                                         \
+        Real64 g (Real64 x);                                    \
+        Real64 Real64_##f (Real64 x) {          \
+                return g (x);                                   \
+        }                                                       \
+        Real32 Real32_##f (Real32 x) {          \
+                return (Real32)(Real64_##f ((Real64)x));        \
+        }
+unaryReal(abs, fabs)
 unaryReal(round, rint)
 #undef unaryReal
 
-#define binaryReal(f, g)							\
-	Real64 g (Real64 x, Real64 y);						\
-	Real64 Real64_Math_##f (Real64 x, Real64 y) {		\
-		return g (x, y);						\
-	}									\
-	Real32 Real32_Math_##f (Real32 x, Real32 y) {		\
-		return (Real32)(Real64_Math_##f ((Real64)x, (Real64)y));	\
-	}
+#define binaryReal(f, g)                                                        \
+        Real64 g (Real64 x, Real64 y);                                          \
+        Real64 Real64_Math_##f (Real64 x, Real64 y) {           \
+                return g (x, y);                                                \
+        }                                                                       \
+        Real32 Real32_Math_##f (Real32 x, Real32 y) {           \
+                return (Real32)(Real64_Math_##f ((Real64)x, (Real64)y));        \
+        }
 binaryReal(atan2, atan2)
 #undef binaryReal
 
-#define unaryReal(f, g)						\
-	Real64 g (Real64 x);					\
-	Real64 Real64_Math_##f (Real64 x) {	\
-		return g (x);					\
-	}							\
-	Real32 Real32_Math_##f (Real32 x) {	\
-		return (Real32)(Real64_Math_##f ((Real64)x));	\
-	}
+#define unaryReal(f, g)                                         \
+        Real64 g (Real64 x);                                    \
+        Real64 Real64_Math_##f (Real64 x) {     \
+                return g (x);                                   \
+        }                                                       \
+        Real32 Real32_Math_##f (Real32 x) {     \
+                return (Real32)(Real64_Math_##f ((Real64)x));   \
+        }
 unaryReal(acos, acos)
 unaryReal(asin, asin)
 unaryReal(atan, atan)
@@ -44,9 +45,9 @@
 
 double ldexp (double x, int i);
 Real64 Real64_ldexp (Real64 x, Int32 i) {
-	return ldexp (x, i);
+        return ldexp (x, i);
 }
 
 Real32 Real32_ldexp (Real32 x, Int32 i) {
-	return (Real32)Real64_ldexp ((Real64)x, i);
+        return (Real32)Real64_ldexp ((Real64)x, i);
 }

Modified: mlton/branches/on-20050420-cmm-branch/runtime/basis/Real/class.c
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/basis/Real/class.c	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/basis/Real/class.c	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,119 @@
 #include "platform.h"
 
-Int Real64_class (Real64 d) {
-	return fpclassify (d);
+#if HAS_FPCLASSIFY
+
+Int Real32_class (Real32 f) {
+        return fpclassify (f);
 }
 
+#elif HAS_FPCLASSIFY32
+
 Int Real32_class (Real32 f) {
-	return fpclassify (f);
+        return fpclassify32 (f);
 }
+
+#else
+
+/* masks for word 0 */
+#define EXPONENT_MASK32 0x7F800000
+#define MANTISSA_MASK32 0x007FFFFF
+#define SIGNBIT_MASK32  0x80000000
+#define MANTISSA_HIGHBIT_MASK32 0x00400000
+
+Int Real32_class (Real32 f) {
+        uint word0;
+        int res;
+
+        word0 = ((uint *)&f)[0];  /* this generates a gcc warning */
+        if ((word0 & EXPONENT_MASK32) == EXPONENT_MASK32) {
+                if (word0 & MANTISSA_MASK32)
+                        res = FP_NAN;
+                else
+                        res = FP_INFINITE;
+        } else if (word0 & EXPONENT_MASK32)
+                res = FP_NORMAL;
+        else if (word0 & MANTISSA_MASK32)
+                res = FP_SUBNORMAL;
+        else
+                res = FP_ZERO;
+        return res;
+}
+
+#endif
+
+
+#if HAS_FPCLASSIFY
+
+Int Real64_class (Real64 d) {
+        return fpclassify (d);
+}
+
+#elif HAS_FPCLASSIFY64
+
+Int Real64_class (Real64 d) {
+        return fpclassify64 (d);
+}
+
+#else
+
+#if (defined __i386__)
+
+/* This code assumes IEEE 754/854 and little endian.
+ *
+ * In memory, the 64 bits of a double are layed out as follows.
+ *
+ * d[0]  bits 7-0 of mantissa
+ * d[1]  bits 15-8 of mantissa
+ * d[2]  bits 23-16 of mantissa
+ * d[3]  bits 31-24 of mantissa
+ * d[4]  bits 39-32 of mantissa
+ * d[5]  bits 47-40 of mantissa
+ * d[6]  bits 3-0 of exponent
+ *       bits 51-48 of mantissa
+ * d[7]  sign bit
+ *       bits 10-4 of exponent
+ *
+ *
+ * In memory, the 32 bits of a float are layed out as follows.
+ *
+ * d[0]  bits 7-0 of mantissa
+ * d[1]  bits 15-8 of mantissa
+ * d[2]  bit  0 of exponent
+ *       bits 22-16 of mantissa
+ * d[7]  sign bit
+ *       bits 7-2 of exponent
+ */
+
+/* masks for word 1 */
+#define EXPONENT_MASK64 0x7FF00000
+#define MANTISSA_MASK64 0x000FFFFF
+#define SIGNBIT_MASK64  0x80000000
+#define MANTISSA_HIGHBIT_MASK64 0x00080000
+
+Int Real64_class (Real64 d) {
+        Word word0, word1;
+        Int res;
+
+        word0 = ((Word *)&d)[0];
+        word1 = ((Word *)&d)[1];
+        if ((word1 & EXPONENT_MASK64) == EXPONENT_MASK64) {
+                if (word0 or (word1 & MANTISSA_MASK64))
+                        res = FP_NAN;
+                else
+                        res = FP_INFINITE;
+        } else if (word1 & EXPONENT_MASK64)
+                res = FP_NORMAL;
+        else if (word0 or (word1 & MANTISSA_MASK64))
+                res = FP_SUBNORMAL;
+        else
+                res = FP_ZERO;
+        return res;
+}
+
+#else
+
+#error Real64_class not implemented
+
+#endif
+
+#endif

Modified: mlton/branches/on-20050420-cmm-branch/runtime/basis/Real/frexp.c
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/basis/Real/frexp.c	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/basis/Real/frexp.c	2006-02-16 19:34:54 UTC (rev 4361)
@@ -3,9 +3,9 @@
 double frexp (double x, int* exp);
 
 Real64 Real64_frexp (Real64 x, Int *exp) {
-	int exp_;
+        int exp_;
         Real64 res;
-	res = frexp (x, &exp_);
-	*exp = exp_;
-	return res;
+        res = frexp (x, &exp_);
+        *exp = exp_;
+        return res;
 }

Modified: mlton/branches/on-20050420-cmm-branch/runtime/basis/Real/gdtoa.c
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/basis/Real/gdtoa.c	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/basis/Real/gdtoa.c	2006-02-16 19:34:54 UTC (rev 4361)
@@ -7,68 +7,68 @@
 
 /* This code is patterned on g_dfmt from the gdtoa sources. */
 char * Real64_gdtoa (double d, int mode, int ndig, int *decpt) {
-	ULong bits[2];
-	int ex;
-	static FPI fpi = { 53, 1-1023-53+1, 2046-1023-53+1, 1, 0 };
-	int i;
-	ULong *L;
-	char *result;
-	ULong sign;
-	int x0, x1;
-	
-	if (MLton_Platform_Arch_bigendian) {
-		x0 = 0;
-		x1 = 1;
-	} else {
-		x0 = 1;
-		x1 = 0;
-	}
-	L = (ULong*)&d;
-	sign = L[x0] & 0x80000000L;
-	bits[0] = L[x1];
-	bits[1] = L[x0] & 0xfffff;
-	if (0 != (ex = (L[x0] >> 20) & 0x7ff))
-		bits[1] |= 0x100000;
-	else
-		ex = 1;
-	ex -= 0x3ff + 52;
-	i = STRTOG_Normal;
-	result = gdtoa (&fpi, ex, bits, &i, mode, ndig, decpt, NULL);
-	if (DEBUG)
-		fprintf (stderr, "%s = gdtoa (%g, %d, %d)   decpt = %d\n", 
-				result, d, mode, ndig, *decpt);
-	return result;
+        ULong bits[2];
+        int ex;
+        static FPI fpi = { 53, 1-1023-53+1, 2046-1023-53+1, 1, 0 };
+        int i;
+        ULong *L;
+        char *result;
+        ULong sign;
+        int x0, x1;
+        
+        if (MLton_Platform_Arch_bigendian) {
+                x0 = 0;
+                x1 = 1;
+        } else {
+                x0 = 1;
+                x1 = 0;
+        }
+        L = (ULong*)&d;
+        sign = L[x0] & 0x80000000L;
+        bits[0] = L[x1];
+        bits[1] = L[x0] & 0xfffff;
+        if (0 != (ex = (L[x0] >> 20) & 0x7ff))
+                bits[1] |= 0x100000;
+        else
+                ex = 1;
+        ex -= 0x3ff + 52;
+        i = STRTOG_Normal;
+        result = gdtoa (&fpi, ex, bits, &i, mode, ndig, decpt, NULL);
+        if (DEBUG)
+                fprintf (stderr, "%s = gdtoa (%g, %d, %d)   decpt = %d\n", 
+                                result, d, mode, ndig, *decpt);
+        return result;
 }
 
 char * Real32_gdtoa (float f, int mode, int ndig, int *decpt) {
-	ULong bits[1];
-	int ex;
-	static FPI fpi = { 24, 1-127-24+1,  254-127-24+1, 1, 0 };
-	int i;
-	ULong *L;
-	char *result;
-	ULong sign;
-	int x0, x1;
+        ULong bits[1];
+        int ex;
+        static FPI fpi = { 24, 1-127-24+1,  254-127-24+1, 1, 0 };
+        int i;
+        ULong *L;
+        char *result;
+        ULong sign;
+        int x0, x1;
 
-	if (MLton_Platform_Arch_bigendian) {
-		x0 = 0;
-		x1 = 1;
-	} else {
-		x0 = 1;
-		x1 = 0;
-	}
-	L = (ULong*)&f;
-	sign = L[0] & 0x80000000L;
-	bits[0] = L[0] & 0x7fffff;
-	if (0 != (ex = (L[0] >> 23) & 0xff))
-		bits[0] |= 0x800000;
-	else
-		ex = 1;
-	ex -= 0x7f + 23;
-	i = STRTOG_Normal;
-	result = gdtoa (&fpi, ex, bits, &i, mode, ndig, decpt, NULL);
-	if (DEBUG)
-		fprintf (stderr, "%s = gdtoa (%g, %d, %d)   decpt = %d\n", 
-				result, (double)f, mode, ndig, *decpt);
-	return result;
+        if (MLton_Platform_Arch_bigendian) {
+                x0 = 0;
+                x1 = 1;
+        } else {
+                x0 = 1;
+                x1 = 0;
+        }
+        L = (ULong*)&f;
+        sign = L[0] & 0x80000000L;
+        bits[0] = L[0] & 0x7fffff;
+        if (0 != (ex = (L[0] >> 23) & 0xff))
+                bits[0] |= 0x800000;
+        else
+                ex = 1;
+        ex -= 0x7f + 23;
+        i = STRTOG_Normal;
+        result = gdtoa (&fpi, ex, bits, &i, mode, ndig, decpt, NULL);
+        if (DEBUG)
+                fprintf (stderr, "%s = gdtoa (%g, %d, %d)   decpt = %d\n", 
+                                result, (double)f, mode, ndig, *decpt);
+        return result;
 }

Modified: mlton/branches/on-20050420-cmm-branch/runtime/basis/Real/modf.c
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/basis/Real/modf.c	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/basis/Real/modf.c	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,12 +1,12 @@
 #include "platform.h"
 
 Real32 Real32_modf (Real32 x, Real32 *exp) {
-	Real64 exp_, res;
+        Real64 exp_, res;
         res = modf ((Real64) x, &exp_);
         *exp = (Real32)exp_;
-	return (Real32)res;
+        return (Real32)res;
 }
 
 Real64 Real64_modf (Real64 x, Real64 *exp) {
-	return modf (x, exp);
+        return modf (x, exp);
 }

Modified: mlton/branches/on-20050420-cmm-branch/runtime/basis/Real/nextAfter.c
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/basis/Real/nextAfter.c	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/basis/Real/nextAfter.c	2006-02-16 19:34:54 UTC (rev 4361)
@@ -2,5 +2,5 @@
 
 /* nextafter is a macro, so we must have a C wrapper to work correctly. */
 Real64 Real64_nextAfter (Real64 x1, Real64 x2) {
-	return nextafter (x1, x2);
+        return nextafter (x1, x2);
 }

Modified: mlton/branches/on-20050420-cmm-branch/runtime/basis/Real/real.c
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/basis/Real/real.c	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/basis/Real/real.c	2006-02-16 19:34:54 UTC (rev 4361)
@@ -14,11 +14,11 @@
 Real64 Real64_minNormalPos = 2.2250738585072014e-308;
 Real64 Real64_minPos =       4.9406564584124654e-324;
 
-#define ternary(size, name, op)					\
-	Real##size Real##size##_mul##name 			\
-		(Real##size r1, Real##size r2, Real##size r3) {	\
-		return r1 * r2 op r3;				\
-	}
+#define ternary(size, name, op)                                 \
+        Real##size Real##size##_mul##name                       \
+                (Real##size r1, Real##size r2, Real##size r3) { \
+                return r1 * r2 op r3;                           \
+        }
 ternary(32, add, +)
 ternary(64, add, +)
 ternary(32, sub, -)

Modified: mlton/branches/on-20050420-cmm-branch/runtime/basis/Real/signBit.c
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/basis/Real/signBit.c	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/basis/Real/signBit.c	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,43 @@
 #include "platform.h"
 
+#if HAS_SIGNBIT
+
 Int Real32_signBit (Real32 f) {
-	return signbit (f);
+        return signbit (f);
 }
 
 Int Real64_signBit (Real64 d) {
-	return signbit (d);
+        return signbit (d);
 }
+
+#else
+
+#if (defined __i386__)
+
+enum {
+        R32_byte = 3,
+        R64_byte = 7,
+};
+
+#elif (defined __ppc__ || defined __sparc__)
+
+enum {
+        R32_byte = 0,
+        R64_byte = 0,
+};
+
+#else
+
+#error Real_signBit not implemented
+
+#endif
+
+Int Real32_signBit (Real32 f) {
+        return (((unsigned char *)&f)[R32_byte] & 0x80) >> 7;
+}
+
+Int Real64_signBit (Real64 d) {
+        return (((unsigned char *)&d)[R64_byte] & 0x80) >> 7;
+}
+
+#endif

Modified: mlton/branches/on-20050420-cmm-branch/runtime/basis/Real/strto.c
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/basis/Real/strto.c	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/basis/Real/strto.c	2006-02-16 19:34:54 UTC (rev 4361)
@@ -4,19 +4,19 @@
 Real64 gdtoa_strtod (char *s, char **endptr);
 
 Real32 Real32_strto (char *s) {
-	char *endptr;
-	Real32 res;
+        char *endptr;
+        Real32 res;
 
-	res = gdtoa_strtof (s, &endptr);
-	assert (NULL != endptr);
-	return res;
+        res = gdtoa_strtof (s, &endptr);
+        assert (NULL != endptr);
+        return res;
 }
 
 Real64 Real64_strto (char *s) {
-	char *endptr;
-	Real64 res;
+        char *endptr;
+        Real64 res;
 
-	res = gdtoa_strtod (s, &endptr);
-	assert (NULL != endptr);
-	return res;
+        res = gdtoa_strtod (s, &endptr);
+        assert (NULL != endptr);
+        return res;
 }

Modified: mlton/branches/on-20050420-cmm-branch/runtime/basis/Stdio.c
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/basis/Stdio.c	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/basis/Stdio.c	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,12 +1,12 @@
 #include "platform.h"
 
 void Stdio_print (Pointer s) {
-	if (0 == Array_numElements (s))
-		return;
-	while (1 != fwrite (s, Array_numElements(s), 1, stderr))
-		/* nothing */;
+        if (0 == Array_numElements (s))
+                return;
+        while (1 != fwrite (s, Array_numElements(s), 1, stderr))
+                /* nothing */;
 }
 
 Int Stdio_sprintf (Pointer buf, Pointer fmt, Real x) {
-	return sprintf (buf, (char*) fmt, x);
+        return sprintf (buf, (char*) fmt, x);
 }

Modified: mlton/branches/on-20050420-cmm-branch/runtime/basis/Thread.c
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/basis/Thread.c	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/basis/Thread.c	2006-02-16 19:34:54 UTC (rev 4361)
@@ -3,53 +3,53 @@
 extern struct GC_state gcState;
 
 enum {
-	DEBUG_THREAD = FALSE,
+        DEBUG_THREAD = FALSE,
 };
 
 Thread Thread_current () {
-	Thread t;
+        Thread t;
 
-	t = (Thread)gcState.currentThread;
-	if (DEBUG_THREAD)
-		fprintf (stderr, "0x%08x = Thread_current ()\n", (uint)t);
-	return t;
+        t = (Thread)gcState.currentThread;
+        if (DEBUG_THREAD)
+                fprintf (stderr, "0x%08x = Thread_current ()\n", (uint)t);
+        return t;
 }
 
 void Thread_finishHandler () {
-	GC_finishHandler (&gcState);
+        GC_finishHandler (&gcState);
 }
 
 Thread Thread_saved () {
-	Thread t;
+        Thread t;
 
-	t = (Thread)gcState.savedThread;
-	gcState.savedThread = (GC_thread)0x1;
-	if (DEBUG_THREAD)
-		fprintf (stderr, "0x%08x = Thread_saved ()\n", (uint)t);
-	return t;
+        t = (Thread)gcState.savedThread;
+        gcState.savedThread = (GC_thread)0x1;
+        if (DEBUG_THREAD)
+                fprintf (stderr, "0x%08x = Thread_saved ()\n", (uint)t);
+        return t;
 }
 
 void Thread_setCallFromCHandler (Thread t) {
-	gcState.callFromCHandler = (GC_thread)t;
+        gcState.callFromCHandler = (GC_thread)t;
 }
 
 void Thread_setSaved (Thread t) {
-	if (DEBUG_THREAD)
-		fprintf (stderr, "Thread_setSaved (0x%08x)\n", (uint)t);
-	gcState.savedThread = (GC_thread)t;
+        if (DEBUG_THREAD)
+                fprintf (stderr, "Thread_setSaved (0x%08x)\n", (uint)t);
+        gcState.savedThread = (GC_thread)t;
 }
 
 void Thread_setHandler (Thread t) {
-	gcState.signalHandler = (GC_thread)t;
+        gcState.signalHandler = (GC_thread)t;
 }
 
 void Thread_startHandler () {
-	GC_startHandler (&gcState);
+        GC_startHandler (&gcState);
 }
 
 void Thread_switchTo (Thread thread, Word ensureBytesFree) {
-	if (DEBUG_THREAD)
-		fprintf (stderr, "Thread_switchTo (0x%08x, %u)\n",
-				(uint)thread, (uint)ensureBytesFree);
-	GC_switchToThread (&gcState, (GC_thread)thread, ensureBytesFree);
+        if (DEBUG_THREAD)
+                fprintf (stderr, "Thread_switchTo (0x%08x, %u)\n",
+                                (uint)thread, (uint)ensureBytesFree);
+        GC_switchToThread (&gcState, (GC_thread)thread, ensureBytesFree);
 }

Modified: mlton/branches/on-20050420-cmm-branch/runtime/basis/Time.c
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/basis/Time.c	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/basis/Time.c	2006-02-16 19:34:54 UTC (rev 4361)
@@ -7,18 +7,18 @@
 static struct timeval timeval;
 
 Int Time_gettimeofday () {
-	Int res;
+        Int res;
 
-	res = gettimeofday (&timeval, (struct timezone*)NULL);
-	if (DEBUG)
-		fprintf (stderr, "%d = Time_gettimeofday ()\n", (int)res);
-	return res;
+        res = gettimeofday (&timeval, (struct timezone*)NULL);
+        if (DEBUG)
+                fprintf (stderr, "%d = Time_gettimeofday ()\n", (int)res);
+        return res;
 }
 
 Int Time_sec () {
-	return timeval.tv_sec;
+        return timeval.tv_sec;
 }
 
 Int Time_usec () {
-	return timeval.tv_usec;
+        return timeval.tv_usec;
 }

Modified: mlton/branches/on-20050420-cmm-branch/runtime/gc.c
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/gc.c	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/gc.c	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,11 @@
-/* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+/* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  */
+
 #include "platform.h"
 
 /* The mutator should maintain the invariants
@@ -22,37 +23,38 @@
 #endif
 
 #ifndef DEBUG_PROFILE
-#define	DEBUG_PROFILE FALSE
+#define DEBUG_PROFILE FALSE
 #endif
 
 enum {
-	BOGUS_EXN_STACK = 0xFFFFFFFF,
-	COPY_CHUNK_SIZE = 0x2000000, /* 32M */
-	CROSS_MAP_EMPTY = 255,
-	CURRENT_SOURCE_UNDEFINED = 0xFFFFFFFF,
-	DEBUG_ARRAY = FALSE,
-	DEBUG_CALL_STACK = FALSE,
-	DEBUG_CARD_MARKING = FALSE,
-	DEBUG_DETAILED = FALSE,
-	DEBUG_ENTER_LEAVE = FALSE,
-	DEBUG_GENERATIONAL = FALSE,
-	DEBUG_MARK_COMPACT = FALSE,
-	DEBUG_RESIZING = FALSE,
-	DEBUG_SHARE = FALSE,
-	DEBUG_SIZE = FALSE,
-	DEBUG_STACKS = FALSE,
-	DEBUG_THREADS = FALSE,
-	DEBUG_WEAK = FALSE,
-	DEBUG_WORLD = FALSE,
-	FORCE_GENERATIONAL = FALSE,
-	FORCE_MARK_COMPACT = FALSE,
-	FORWARDED = 0xFFFFFFFF,
-	STACK_HEADER_SIZE = WORD_SIZE,
+        BOGUS_EXN_STACK = 0xFFFFFFFF,
+        CARD_SIZE_LOG2 = 8, /* must agree w/ cardSizeLog2 in ssa-to-rssa.fun */
+        COPY_CHUNK_SIZE = 0x2000000, /* 32M */
+        CROSS_MAP_EMPTY = 255,
+        CURRENT_SOURCE_UNDEFINED = 0xFFFFFFFF,
+        DEBUG_ARRAY = FALSE,
+        DEBUG_CALL_STACK = FALSE,
+        DEBUG_CARD_MARKING = FALSE,
+        DEBUG_DETAILED = FALSE,
+        DEBUG_ENTER_LEAVE = FALSE,
+        DEBUG_GENERATIONAL = FALSE,
+        DEBUG_MARK_COMPACT = FALSE,
+        DEBUG_RESIZING = FALSE,
+        DEBUG_SHARE = FALSE,
+        DEBUG_SIZE = FALSE,
+        DEBUG_STACKS = FALSE,
+        DEBUG_THREADS = FALSE,
+        DEBUG_WEAK = FALSE,
+        DEBUG_WORLD = FALSE,
+        FORCE_GENERATIONAL = FALSE,
+        FORCE_MARK_COMPACT = FALSE,
+        FORWARDED = 0xFFFFFFFF,
+        STACK_HEADER_SIZE = WORD_SIZE,
 };
 
 typedef enum {
-	MARK_MODE,
-	UNMARK_MODE,
+        MARK_MODE,
+        UNMARK_MODE,
 } MarkMode;
 
 #define EMPTY_HEADER GC_objectHeader (EMPTY_TYPE_INDEX)
@@ -62,121 +64,121 @@
 #define WEAK_GONE_HEADER GC_objectHeader (WEAK_GONE_TYPE_INDEX)
 #define WORD8_VECTOR_HEADER GC_objectHeader (WORD8_TYPE_INDEX)
 
-#define SPLIT_HEADER()								\
-	do {									\
-		int objectTypeIndex;						\
-		GC_ObjectType *t;						\
-										\
-		assert (1 == (header & 1));					\
-		objectTypeIndex = (header & TYPE_INDEX_MASK) >> 1;		\
-		assert (0 <= objectTypeIndex					\
-				and objectTypeIndex < s->objectTypesSize);	\
-		t = &s->objectTypes [objectTypeIndex];				\
-		tag = t->tag;							\
-		hasIdentity = t->hasIdentity;					\
-		numNonPointers = t->numNonPointers;				\
-		numPointers = t->numPointers;					\
-		if (DEBUG_DETAILED)						\
-			fprintf (stderr, "SPLIT_HEADER (0x%08x)  numNonPointers = %u  numPointers = %u\n", \
-					(uint)header, numNonPointers, numPointers);	\
-	} while (0)
+#define SPLIT_HEADER()                                                          \
+        do {                                                                    \
+                int objectTypeIndex;                                            \
+                GC_ObjectType *t;                                               \
+                                                                                \
+                assert (1 == (header & 1));                                     \
+                objectTypeIndex = (header & TYPE_INDEX_MASK) >> 1;              \
+                assert (0 <= objectTypeIndex                                    \
+                                and objectTypeIndex < s->objectTypesSize);      \
+                t = &s->objectTypes [objectTypeIndex];                          \
+                tag = t->tag;                                                   \
+                hasIdentity = t->hasIdentity;                                   \
+                numNonPointers = t->numNonPointers;                             \
+                numPointers = t->numPointers;                                   \
+                if (DEBUG_DETAILED)                                             \
+                        fprintf (stderr, "SPLIT_HEADER (0x%08x)  numNonPointers = %u  numPointers = %u\n", \
+                                        (uint)header, numNonPointers, numPointers);     \
+        } while (0)
 
 static char* tagToString (GC_ObjectTypeTag t) {
-	switch (t) {
-	case ARRAY_TAG:
-	return "ARRAY";
-	case NORMAL_TAG:
-	return "NORMAL";
-	case STACK_TAG:
-	return "STACK";
-	case WEAK_TAG:
-	return "WEAK";
-	default:
-	die ("bad tag %u", t);
-	}
+        switch (t) {
+        case ARRAY_TAG:
+        return "ARRAY";
+        case NORMAL_TAG:
+        return "NORMAL";
+        case STACK_TAG:
+        return "STACK";
+        case WEAK_TAG:
+        return "WEAK";
+        default:
+        die ("bad tag %u", t);
+        }
 }
 
 static inline ulong meg (uint n) {
-	return n / (1024ul * 1024ul);
+        return n / (1024ul * 1024ul);
 }
 
 static inline uint toBytes (uint n) {
-	return n << 2;
+        return n << 2;
 }
 
 static inline W64 min64 (W64 x, W64 y) {
-	return ((x < y) ? x : y);
+        return ((x < y) ? x : y);
 }
 
 static inline W64 max64 (W64 x, W64 y) {
-	return ((x > y) ? x : y);
+        return ((x > y) ? x : y);
 }
 
 static inline uint roundDown (uint a, uint b) {
-	return a - (a % b);
+        return a - (a % b);
 }
 
 static inline uint align (uint a, uint b) {
-	assert (a >= 0);
-	assert (b >= 1);
-	a += b - 1;
-	a -= a % b;
-	return a;	
+        assert (a >= 0);
+        assert (b >= 1);
+        a += b - 1;
+        a -= a % b;
+        return a;       
 }
 
 static inline W64 w64align (W64 a, uint b) {
-	W64 res;
+        W64 res;
 
-	assert (a >= 0);
-	assert (b >= 1);
-	res = a + b - 1;
-	res = res - res % b;
-	if (FALSE)
-		fprintf (stderr, "%llu = w64Align (%llu, %u)\n", res, a, b);
-	return res;
+        assert (a >= 0);
+        assert (b >= 1);
+        res = a + b - 1;
+        res = res - res % b;
+        if (FALSE)
+                fprintf (stderr, "%llu = w64Align (%llu, %u)\n", res, a, b);
+        return res;
 }
 
 static bool isAligned (uint a, uint b) {
-	return 0 == a % b;
+        return 0 == a % b;
 }
 
 #if ASSERT
 static bool isAlignedFrontier (GC_state s, pointer p) {
-	return isAligned ((uint)p + GC_NORMAL_HEADER_SIZE, s->alignment);
+        return isAligned ((uint)p + GC_NORMAL_HEADER_SIZE, s->alignment);
 }
 
 static bool isAlignedReserved (GC_state s, uint r) {
-	return isAligned (STACK_HEADER_SIZE + sizeof (struct GC_stack) + r, 
-				s->alignment);
+        return isAligned (STACK_HEADER_SIZE + sizeof (struct GC_stack) + r, 
+                                s->alignment);
 }
 #endif
 
 static inline uint pad (GC_state s, uint bytes, uint extra) {
-	return align (bytes + extra, s->alignment) - extra;
+        return align (bytes + extra, s->alignment) - extra;
 }
 
 static inline pointer alignFrontier (GC_state s, pointer p) {
-	return (pointer) pad (s, (uint)p, GC_NORMAL_HEADER_SIZE);
+        return (pointer) pad (s, (uint)p, GC_NORMAL_HEADER_SIZE);
 }
 
 pointer GC_alignFrontier (GC_state s, pointer p) {
-	return alignFrontier (s, p);
+        return alignFrontier (s, p);
 }
 
 static inline uint stackReserved (GC_state s, uint r) {
-	uint res;
+        uint res;
 
-	res = pad (s, r, STACK_HEADER_SIZE + sizeof (struct GC_stack));
-	if (DEBUG_STACKS)
-		fprintf (stderr, "%s = stackReserved (%s)\n",
-				uintToCommaString (res),
-				uintToCommaString (r));
-	return res;
+        res = pad (s, r, STACK_HEADER_SIZE + sizeof (struct GC_stack));
+        if (DEBUG_STACKS)
+                fprintf (stderr, "%s = stackReserved (%s)\n",
+                                uintToCommaString (res),
+                                uintToCommaString (r));
+        return res;
 }
 
 static void sunlink (char *path) {
-	unless (0 == unlink (path))
-		diee ("unlink (%s) failed", path);
+        unless (0 == unlink (path))
+                diee ("unlink (%s) failed", path);
 }
 
 /* ---------------------------------------------------------------- */
@@ -184,61 +186,61 @@
 /* ---------------------------------------------------------------- */
 
 static inline void *GC_mmapAnon (void *start, size_t length) {
-	void *res;
+        void *res;
 
-	res = mmapAnon (start, length);
-	if (DEBUG_MEM)
-		fprintf (stderr, "0x%08x = mmapAnon (0x%08x, %s)\n",
-					(uint)res,
-					(uint)start, 
-					uintToCommaString (length));
-	return res;
+        res = mmapAnon (start, length);
+        if (DEBUG_MEM)
+                fprintf (stderr, "0x%08x = mmapAnon (0x%08x, %s)\n",
+                                        (uint)res,
+                                        (uint)start, 
+                                        uintToCommaString (length));
+        return res;
 }
 
 void *smmap (size_t length) {
-	void *result;
+        void *result;
 
-	result = GC_mmapAnon (NULL, length);
-	if ((void*)-1 == result) {
-		showMem ();
-		die ("Out of memory.");
-	}
-	return result;
+        result = GC_mmapAnon (NULL, length);
+        if ((void*)-1 == result) {
+                showMem ();
+                die ("Out of memory.");
+        }
+        return result;
 }
 
 static inline void GC_release (void *base, size_t length) {
-	if (DEBUG_MEM)
-		fprintf (stderr, "release (0x%08x, %s)\n",
-				(uint)base, uintToCommaString (length));
-	release (base, length);
+        if (DEBUG_MEM)
+                fprintf (stderr, "release (0x%08x, %s)\n",
+                                (uint)base, uintToCommaString (length));
+        release (base, length);
 }
 
 static inline void GC_decommit (void *base, size_t length) {
-	if (DEBUG_MEM)
-		fprintf (stderr, "decommit (0x%08x, %s)\n",
-				(uint)base, uintToCommaString (length));
-	decommit (base, length);
+        if (DEBUG_MEM)
+                fprintf (stderr, "decommit (0x%08x, %s)\n",
+                                (uint)base, uintToCommaString (length));
+        decommit (base, length);
 }
 
 static inline void copy (pointer src, pointer dst, uint size) {
-	uint	*to,
-		*from,
-		*limit;
+        uint    *to,
+                *from,
+                *limit;
 
-	if (DEBUG_DETAILED)
-		fprintf (stderr, "copy (0x%08x, 0x%08x, %u)\n",
-				(uint)src, (uint)dst, size);
-	assert (isAligned ((uint)src, WORD_SIZE));
-	assert (isAligned ((uint)dst, WORD_SIZE));
-	assert (isAligned (size, WORD_SIZE));
-	assert (dst <= src or src + size <= dst);
-	if (src == dst)
-		return;
-	from = (uint*)src;
-	to = (uint*)dst;
-	limit = (uint*)(src + size);
-	until (from == limit)
-		*to++ = *from++;
+        if (DEBUG_DETAILED)
+                fprintf (stderr, "copy (0x%08x, 0x%08x, %u)\n",
+                                (uint)src, (uint)dst, size);
+        assert (isAligned ((uint)src, WORD_SIZE));
+        assert (isAligned ((uint)dst, WORD_SIZE));
+        assert (isAligned (size, WORD_SIZE));
+        assert (dst <= src or src + size <= dst);
+        if (src == dst)
+                return;
+        from = (uint*)src;
+        to = (uint*)dst;
+        limit = (uint*)(src + size);
+        until (from == limit)
+                *to++ = *from++;
 }
 
 /* ---------------------------------------------------------------- */
@@ -246,83 +248,83 @@
 /* ---------------------------------------------------------------- */
 
 static inline void rusageZero (struct rusage *ru) {
-	memset (ru, 0, sizeof (*ru));
+        memset (ru, 0, sizeof (*ru));
 }
 
 static void rusagePlusMax (struct rusage *ru1,
-			      struct rusage *ru2,
-			      struct rusage *ru) {
-	const int	million = 1000000;
-	time_t		sec,
-			usec;
+                              struct rusage *ru2,
+                              struct rusage *ru) {
+        const int       million = 1000000;
+        time_t          sec,
+                        usec;
 
-	sec = ru1->ru_utime.tv_sec + ru2->ru_utime.tv_sec;
-	usec = ru1->ru_utime.tv_usec + ru2->ru_utime.tv_usec;
-	sec += (usec / million);
-	usec %= million;
-	ru->ru_utime.tv_sec = sec;
-	ru->ru_utime.tv_usec = usec;
+        sec = ru1->ru_utime.tv_sec + ru2->ru_utime.tv_sec;
+        usec = ru1->ru_utime.tv_usec + ru2->ru_utime.tv_usec;
+        sec += (usec / million);
+        usec %= million;
+        ru->ru_utime.tv_sec = sec;
+        ru->ru_utime.tv_usec = usec;
 
-	sec = ru1->ru_stime.tv_sec + ru2->ru_stime.tv_sec;
-	usec = ru1->ru_stime.tv_usec + ru2->ru_stime.tv_usec;
-	sec += (usec / million);
-	usec %= million;
-	ru->ru_stime.tv_sec = sec;
-	ru->ru_stime.tv_usec = usec;
+        sec = ru1->ru_stime.tv_sec + ru2->ru_stime.tv_sec;
+        usec = ru1->ru_stime.tv_usec + ru2->ru_stime.tv_usec;
+        sec += (usec / million);
+        usec %= million;
+        ru->ru_stime.tv_sec = sec;
+        ru->ru_stime.tv_usec = usec;
 }
 
 static void rusageMinusMax (struct rusage *ru1,
-				struct rusage *ru2,
-				struct rusage *ru) {
-	const int	million = 1000000;
-	time_t		sec,
-			usec;
+                                struct rusage *ru2,
+                                struct rusage *ru) {
+        const int       million = 1000000;
+        time_t          sec,
+                        usec;
 
-	sec = (ru1->ru_utime.tv_sec - ru2->ru_utime.tv_sec) - 1;
-	usec = ru1->ru_utime.tv_usec + million - ru2->ru_utime.tv_usec;
-	sec += (usec / million);
-	usec %= million;
-	ru->ru_utime.tv_sec = sec;
-	ru->ru_utime.tv_usec = usec;
+        sec = (ru1->ru_utime.tv_sec - ru2->ru_utime.tv_sec) - 1;
+        usec = ru1->ru_utime.tv_usec + million - ru2->ru_utime.tv_usec;
+        sec += (usec / million);
+        usec %= million;
+        ru->ru_utime.tv_sec = sec;
+        ru->ru_utime.tv_usec = usec;
 
-	sec = (ru1->ru_stime.tv_sec - ru2->ru_stime.tv_sec) - 1;
-	usec = ru1->ru_stime.tv_usec + million - ru2->ru_stime.tv_usec;
-	sec += (usec / million);
-	usec %= million;
-	ru->ru_stime.tv_sec = sec;
-	ru->ru_stime.tv_usec = usec;
+        sec = (ru1->ru_stime.tv_sec - ru2->ru_stime.tv_sec) - 1;
+        usec = ru1->ru_stime.tv_usec + million - ru2->ru_stime.tv_usec;
+        sec += (usec / million);
+        usec %= million;
+        ru->ru_stime.tv_sec = sec;
+        ru->ru_stime.tv_usec = usec;
 }
 
 static uint rusageTime (struct rusage *ru) {
-	uint	result;
+        uint    result;
 
-	result = 0;
-	result += 1000 * ru->ru_utime.tv_sec;
-	result += 1000 * ru->ru_stime.tv_sec;
-	result += ru->ru_utime.tv_usec / 1000;
-	result += ru->ru_stime.tv_usec / 1000;
-	return result;
+        result = 0;
+        result += 1000 * ru->ru_utime.tv_sec;
+        result += 1000 * ru->ru_stime.tv_sec;
+        result += ru->ru_utime.tv_usec / 1000;
+        result += ru->ru_stime.tv_usec / 1000;
+        return result;
 }
 
 /* Return time as number of milliseconds. */
 static uint currentTime () {
-	struct rusage	ru;
+        struct rusage   ru;
 
-	fixedGetrusage (RUSAGE_SELF, &ru);
-	return rusageTime (&ru);
+        fixedGetrusage (RUSAGE_SELF, &ru);
+        return rusageTime (&ru);
 }
 
 static inline void startTiming (struct rusage *ru_start) {
-	fixedGetrusage (RUSAGE_SELF, ru_start);
+        fixedGetrusage (RUSAGE_SELF, ru_start);
 }
 
 static uint stopTiming (struct rusage *ru_start, struct rusage *ru_gc) {
-	struct rusage ru_finish, ru_total;
+        struct rusage ru_finish, ru_total;
 
-	fixedGetrusage (RUSAGE_SELF, &ru_finish);
-	rusageMinusMax (&ru_finish, ru_start, &ru_total);
-	rusagePlusMax (ru_gc, &ru_total, ru_gc);
-	return rusageTime (&ru_total);
+        fixedGetrusage (RUSAGE_SELF, &ru_finish);
+        rusageMinusMax (&ru_finish, ru_start, &ru_total);
+        rusagePlusMax (ru_gc, &ru_total, ru_gc);
+        return rusageTime (&ru_total);
 }
 
 /* ---------------------------------------------------------------- */
@@ -330,64 +332,64 @@
 /* ---------------------------------------------------------------- */
 
 void GC_display (GC_state s, FILE *stream) {
-	fprintf (stream, "GC state\n\tcardMap = 0x%08x\n\toldGen = 0x%08x\n\toldGenSize = %s\n\toldGen + oldGenSize = 0x%08x\n\tnursery = 0x%08x\n\tfrontier = 0x%08x\n\tfrontier - nursery = %u\n\tlimitPlusSlop - frontier = %d\n",
-			(uint) s->cardMap,
-   			(uint) s->heap.start,
-			uintToCommaString (s->oldGenSize),
-			(uint) s->heap.start + s->oldGenSize,
-			(uint) s->nursery, 
-			(uint) s->frontier,
-			s->frontier - s->nursery,
-			s->limitPlusSlop - s->frontier);
-	fprintf (stream, "\tcanHandle = %d\n\tsignalsIsPending = %d\n", s->canHandle, s->signalIsPending);
-	fprintf (stderr, "\tcurrentThread = 0x%08x\n", (uint) s->currentThread);
-	fprintf (stream, "\tstackBottom = 0x%08x\n\tstackTop - stackBottom = %u\n\tstackLimit - stackTop = %u\n",
-			(uint)s->stackBottom,
-			s->stackTop - s->stackBottom,
-			(s->stackLimit - s->stackTop));
-	fprintf (stream, "\texnStack = %u\n\tbytesNeeded = %u\n\treserved = %u\n\tused = %u\n",
-			s->currentThread->exnStack,
-			s->currentThread->bytesNeeded,
-			s->currentThread->stack->reserved,
-			s->currentThread->stack->used);
-	if (DEBUG_GENERATIONAL and DEBUG_DETAILED) {
-		int i;
+        fprintf (stream, "GC state\n\tcardMap = 0x%08x\n\toldGen = 0x%08x\n\toldGenSize = %s\n\toldGen + oldGenSize = 0x%08x\n\tnursery = 0x%08x\n\tfrontier = 0x%08x\n\tfrontier - nursery = %u\n\tlimitPlusSlop - frontier = %d\n",
+                        (uint) s->cardMap,
+                        (uint) s->heap.start,
+                        uintToCommaString (s->oldGenSize),
+                        (uint) s->heap.start + s->oldGenSize,
+                        (uint) s->nursery, 
+                        (uint) s->frontier,
+                        s->frontier - s->nursery,
+                        s->limitPlusSlop - s->frontier);
+        fprintf (stream, "\tcanHandle = %d\n\tsignalsIsPending = %d\n", s->canHandle, s->signalIsPending);
+        fprintf (stderr, "\tcurrentThread = 0x%08x\n", (uint) s->currentThread);
+        fprintf (stream, "\tstackBottom = 0x%08x\n\tstackTop - stackBottom = %u\n\tstackLimit - stackTop = %u\n",
+                        (uint)s->stackBottom,
+                        s->stackTop - s->stackBottom,
+                        (s->stackLimit - s->stackTop));
+        fprintf (stream, "\texnStack = %u\n\tbytesNeeded = %u\n\treserved = %u\n\tused = %u\n",
+                        s->currentThread->exnStack,
+                        s->currentThread->bytesNeeded,
+                        s->currentThread->stack->reserved,
+                        s->currentThread->stack->used);
+        if (DEBUG_GENERATIONAL and DEBUG_DETAILED) {
+                int i;
 
-		fprintf (stderr, "crossMap trues\n");
-		for (i = 0; i < s->crossMapSize; ++i)
-			unless (CROSS_MAP_EMPTY == s->crossMap[i])
-				fprintf (stderr, "\t%u\n", i);
-		fprintf (stderr, "\n");
-	}		
+                fprintf (stderr, "crossMap trues\n");
+                for (i = 0; i < s->crossMapSize; ++i)
+                        unless (CROSS_MAP_EMPTY == s->crossMap[i])
+                                fprintf (stderr, "\t%u\n", i);
+                fprintf (stderr, "\n");
+        }               
 }
 
 static inline uint cardNumToSize (GC_state s, uint n) {
-	return n << s->cardSizeLog2;
+        return n << CARD_SIZE_LOG2;
 }
 
 static inline uint divCardSize (GC_state s, uint n) {
-	return n >> s->cardSizeLog2;
+        return n >> CARD_SIZE_LOG2;
 }
 
 static inline pointer cardMapAddr (GC_state s, pointer p) {
-	pointer res;
+        pointer res;
 
-	res = &s->cardMapForMutator [divCardSize (s, (uint)p)];
-	if (DEBUG_CARD_MARKING)
-		fprintf (stderr, "0x%08x = cardMapAddr (0x%08x)\n",
-				(uint)res, (uint)p);
-	return res;
+        res = &s->cardMapForMutator [divCardSize (s, (uint)p)];
+        if (DEBUG_CARD_MARKING)
+                fprintf (stderr, "0x%08x = cardMapAddr (0x%08x)\n",
+                                (uint)res, (uint)p);
+        return res;
 }
 
 static inline bool cardIsMarked (GC_state s, pointer p) {
-	return *cardMapAddr (s, p);
+        return *cardMapAddr (s, p);
 }
 
 static inline void markCard (GC_state s, pointer p) {
-	if (DEBUG_CARD_MARKING)
-		fprintf (stderr, "markCard (0x%08x)\n", (uint)p);
-	if (s->mutatorMarksCards)
-		*cardMapAddr (s, p) = '\001';
+        if (DEBUG_CARD_MARKING)
+                fprintf (stderr, "markCard (0x%08x)\n", (uint)p);
+        if (s->mutatorMarksCards)
+                *cardMapAddr (s, p) = '\001';
 }
 
 /* ---------------------------------------------------------------- */
@@ -398,197 +400,197 @@
  * the stack and the end of the stack space.
  */
 static inline uint stackSlop (GC_state s) {
-	return 2 * s->maxFrameSize;
+        return 2 * s->maxFrameSize;
 }
 
 static inline uint initialStackSize (GC_state s) {
-	return stackSlop (s);
+        return stackSlop (s);
 }
 
 static inline uint stackBytes (GC_state s, uint size) {
-	uint res;
+        uint res;
 
-	res = align (STACK_HEADER_SIZE + sizeof (struct GC_stack) + size,
-			s->alignment);
-	if (DEBUG_STACKS)
-		fprintf (stderr, "%s = stackBytes (%s)\n",
-				uintToCommaString (res),
-				uintToCommaString (size));
-	return res;
+        res = align (STACK_HEADER_SIZE + sizeof (struct GC_stack) + size,
+                        s->alignment);
+        if (DEBUG_STACKS)
+                fprintf (stderr, "%s = stackBytes (%s)\n",
+                                uintToCommaString (res),
+                                uintToCommaString (size));
+        return res;
 }
 
 static inline pointer stackBottom (GC_state s, GC_stack stack) {
-	pointer res;
+        pointer res;
 
-	res = ((pointer)stack) + sizeof (struct GC_stack);
-	assert (isAligned ((uint)res, s->alignment));
-	return res;
+        res = ((pointer)stack) + sizeof (struct GC_stack);
+        assert (isAligned ((uint)res, s->alignment));
+        return res;
 }
 
 /* Pointer to the topmost word in use on the stack. */
 static inline pointer stackTop (GC_state s, GC_stack stack) {
-	return stackBottom (s, stack) + stack->used;
+        return stackBottom (s, stack) + stack->used;
 }
 
 /* Pointer to the end of stack. */
 static inline pointer endOfStack (GC_state s, GC_stack stack) {
-	return stackBottom (s, stack) + stack->reserved;
+        return stackBottom (s, stack) + stack->reserved;
 }
 
 /* The maximum value stackTop may take on. */
 static inline pointer stackLimit (GC_state s, GC_stack stack) {
-	return endOfStack (s, stack) - stackSlop (s);
+        return endOfStack (s, stack) - stackSlop (s);
 }
 
 static inline bool stackIsEmpty (GC_stack stack) {
-	return 0 == stack->used;
+        return 0 == stack->used;
 }
 
 static inline uint getFrameIndex (GC_state s, word returnAddress) {
-	uint res;
+        uint res;
 
-	res = s->returnAddressToFrameIndex (returnAddress);
-	if (DEBUG_DETAILED)
-		fprintf (stderr, "%u = getFrameIndex (0x%08x)\n",
-				returnAddress, res);
-	return res;
+        res = s->returnAddressToFrameIndex (returnAddress);
+        if (DEBUG_DETAILED)
+                fprintf (stderr, "%u = getFrameIndex (0x%08x)\n",
+                                returnAddress, res);
+        return res;
 }
 
 static inline uint topFrameIndex (GC_state s) {
-	uint res;
+        uint res;
 
-	assert (s->stackTop > s->stackBottom);
-	res = getFrameIndex (s, *(word*)(s->stackTop - WORD_SIZE));
-	if (DEBUG_PROFILE)
-		fprintf (stderr, "topFrameIndex = %u\n", res);
-	return res;
+        assert (s->stackTop > s->stackBottom);
+        res = getFrameIndex (s, *(word*)(s->stackTop - WORD_SIZE));
+        if (DEBUG_PROFILE)
+                fprintf (stderr, "topFrameIndex = %u\n", res);
+        return res;
 }
 
 static inline uint topFrameSourceSeqIndex (GC_state s) {
-	return s->frameSources[topFrameIndex (s)];
+        return s->frameSources[topFrameIndex (s)];
 }
 
 static inline GC_frameLayout * getFrameLayout (GC_state s, word returnAddress) {
-	GC_frameLayout *layout;
-	uint index;
+        GC_frameLayout *layout;
+        uint index;
 
-	index = getFrameIndex (s, returnAddress);
-	if (DEBUG_DETAILED)
-		fprintf (stderr, "returnAddress = 0x%08x  index = %d  frameLayoutsSize = %d\n",
-				returnAddress, index, s->frameLayoutsSize);
-	assert (0 <= index and index < s->frameLayoutsSize);
-	layout = &(s->frameLayouts[index]);
-	assert (layout->numBytes > 0);
-	return layout;
+        index = getFrameIndex (s, returnAddress);
+        if (DEBUG_DETAILED)
+                fprintf (stderr, "returnAddress = 0x%08x  index = %d  frameLayoutsSize = %d\n",
+                                returnAddress, index, s->frameLayoutsSize);
+        assert (0 <= index and index < s->frameLayoutsSize);
+        layout = &(s->frameLayouts[index]);
+        assert (layout->numBytes > 0);
+        return layout;
 }
 
 static inline uint topFrameSize (GC_state s, GC_stack stack) {
-	GC_frameLayout *layout;
-	
-	assert (not (stackIsEmpty (stack)));
-	layout = getFrameLayout (s, *(word*)(stackTop (s, stack) - WORD_SIZE));
-	return layout->numBytes;
+        GC_frameLayout *layout;
+        
+        assert (not (stackIsEmpty (stack)));
+        layout = getFrameLayout (s, *(word*)(stackTop (s, stack) - WORD_SIZE));
+        return layout->numBytes;
 }
 
 static inline uint stackNeedsReserved (GC_state s, GC_stack stack) {
-	return stack->used + stackSlop (s) - topFrameSize (s, stack);
+        return stack->used + stackSlop (s) - topFrameSize (s, stack);
 }
 
 #if ASSERT
 static bool hasBytesFree (GC_state s, W32 oldGen, W32 nursery) {
-	bool res;
+        bool res;
 
-	res = s->oldGenSize + oldGen 
-			+ (s->canMinor ? 2 : 1) 
-				* (s->limitPlusSlop - s->nursery)
-			<= s->heap.size
-		and nursery <= s->limitPlusSlop - s->frontier;
-	if (DEBUG_DETAILED)
-		fprintf (stderr, "%s = hasBytesFree (%s, %s)\n",
-				boolToString (res),
-				uintToCommaString (oldGen),
-				uintToCommaString (nursery));
-	return res;
+        res = s->oldGenSize + oldGen 
+                        + (s->canMinor ? 2 : 1) 
+                                * (s->limitPlusSlop - s->nursery)
+                        <= s->heap.size
+                and nursery <= s->limitPlusSlop - s->frontier;
+        if (DEBUG_DETAILED)
+                fprintf (stderr, "%s = hasBytesFree (%s, %s)\n",
+                                boolToString (res),
+                                uintToCommaString (oldGen),
+                                uintToCommaString (nursery));
+        return res;
 }
 #endif
 
 /* bytesRequested includes the header. */
 static pointer object (GC_state s, uint header, W32 bytesRequested,
-				bool allocInOldGen,
-				Bool hasDouble) {
-	pointer frontier;
-	pointer result;
+                                bool allocInOldGen,
+                                Bool hasDouble) {
+        pointer frontier;
+        pointer result;
 
-	if (DEBUG)
-		fprintf (stderr, "object (0x%08x, %u, %s)\n",
-				header, 
-				(uint)bytesRequested,
-				boolToString (allocInOldGen));
-	assert (isAligned (bytesRequested, s->alignment));
-	assert (allocInOldGen
-			? hasBytesFree (s, bytesRequested, 0)
-			: hasBytesFree (s, 0, bytesRequested));
-	if (allocInOldGen) {
-		frontier = s->heap.start + s->oldGenSize;
-		s->oldGenSize += bytesRequested;
-		s->bytesAllocated += bytesRequested;
-	} else {
-		if (DEBUG_DETAILED)
-			fprintf (stderr, "frontier changed from 0x%08x to 0x%08x\n",
-					(uint)s->frontier, 
-					(uint)(s->frontier + bytesRequested));
-		frontier = s->frontier;
-		s->frontier += bytesRequested;
-	}
-	GC_profileAllocInc (s, bytesRequested);
-	*(uint*)(frontier) = header;
-	result = frontier + GC_NORMAL_HEADER_SIZE;
-	return result;
+        if (DEBUG)
+                fprintf (stderr, "object (0x%08x, %u, %s)\n",
+                                header, 
+                                (uint)bytesRequested,
+                                boolToString (allocInOldGen));
+        assert (isAligned (bytesRequested, s->alignment));
+        assert (allocInOldGen
+                        ? hasBytesFree (s, bytesRequested, 0)
+                        : hasBytesFree (s, 0, bytesRequested));
+        if (allocInOldGen) {
+                frontier = s->heap.start + s->oldGenSize;
+                s->oldGenSize += bytesRequested;
+                s->bytesAllocated += bytesRequested;
+        } else {
+                if (DEBUG_DETAILED)
+                        fprintf (stderr, "frontier changed from 0x%08x to 0x%08x\n",
+                                        (uint)s->frontier, 
+                                        (uint)(s->frontier + bytesRequested));
+                frontier = s->frontier;
+                s->frontier += bytesRequested;
+        }
+        GC_profileAllocInc (s, bytesRequested);
+        *(uint*)(frontier) = header;
+        result = frontier + GC_NORMAL_HEADER_SIZE;
+        return result;
 }
 
 static GC_stack newStack (GC_state s, uint reserved, bool allocInOldGen) {
-	GC_stack stack;
+        GC_stack stack;
 
-	reserved = stackReserved (s, reserved);
-	if (reserved > s->maxStackSizeSeen)
-		s->maxStackSizeSeen = reserved;
-	stack = (GC_stack) object (s, STACK_HEADER, stackBytes (s, reserved),
-					allocInOldGen, TRUE);
-	stack->reserved = reserved;
-	stack->used = 0;
-	if (DEBUG_STACKS)
-		fprintf (stderr, "0x%x = newStack (%u)\n", (uint)stack, 
-				reserved);
-	return stack;
+        reserved = stackReserved (s, reserved);
+        if (reserved > s->maxStackSizeSeen)
+                s->maxStackSizeSeen = reserved;
+        stack = (GC_stack) object (s, STACK_HEADER, stackBytes (s, reserved),
+                                        allocInOldGen, TRUE);
+        stack->reserved = reserved;
+        stack->used = 0;
+        if (DEBUG_STACKS)
+                fprintf (stderr, "0x%x = newStack (%u)\n", (uint)stack, 
+                                reserved);
+        return stack;
 }
 
 static void setStack (GC_state s) {
-	GC_stack stack;
+        GC_stack stack;
 
-	s->exnStack = s->currentThread->exnStack;
-	stack = s->currentThread->stack;
-	s->stackBottom = stackBottom (s, stack);
-	s->stackTop = stackTop (s, stack);
-	s->stackLimit = stackLimit (s, stack);
-	/* We must card mark the stack because it will be updated by the mutator.
-	 */
-	markCard (s, (pointer)stack);
+        s->exnStack = s->currentThread->exnStack;
+        stack = s->currentThread->stack;
+        s->stackBottom = stackBottom (s, stack);
+        s->stackTop = stackTop (s, stack);
+        s->stackLimit = stackLimit (s, stack);
+        /* We must card mark the stack because it will be updated by the mutator.
+         */
+        markCard (s, (pointer)stack);
 }
 
 static void stackCopy (GC_state s, GC_stack from, GC_stack to) {
-	assert (from->used <= to->reserved);
-	to->used = from->used;
-	if (DEBUG_STACKS)
-		fprintf (stderr, "stackCopy from 0x%08x to 0x%08x of length %u\n",
-				(uint) stackBottom (s, from), 
-				(uint) stackBottom (s, to),
-				from->used);
-	memcpy (stackBottom (s, to), stackBottom (s, from), from->used);
+        assert (from->used <= to->reserved);
+        to->used = from->used;
+        if (DEBUG_STACKS)
+                fprintf (stderr, "stackCopy from 0x%08x to 0x%08x of length %u\n",
+                                (uint) stackBottom (s, from), 
+                                (uint) stackBottom (s, to),
+                                from->used);
+        memcpy (stackBottom (s, to), stackBottom (s, from), from->used);
 }
 
 /* Number of bytes used by the stack. */
 static inline uint currentStackUsed (GC_state s) {
-	return s->stackTop - s->stackBottom;
+        return s->stackTop - s->stackBottom;
 }
 
 /* ---------------------------------------------------------------- */
@@ -598,64 +600,64 @@
 typedef void (*GC_pointerFun) (GC_state s, pointer *p);
 
 static inline void maybeCall (GC_pointerFun f, GC_state s, pointer *pp) {
-	if (GC_isPointer (*pp))
-		f (s, pp);
+        if (GC_isPointer (*pp))
+                f (s, pp);
 }
 
 /* Apply f to each global pointer into the heap. */
 static inline void foreachGlobal (GC_state s, GC_pointerFun f) {
-	int i;
+        int i;
 
- 	for (i = 0; i < s->globalsSize; ++i) {
-		if (DEBUG_DETAILED)
-			fprintf (stderr, "foreachGlobal %u\n", i);
-		maybeCall (f, s, &s->globals [i]);
-	}
-	if (DEBUG_DETAILED)
-		fprintf (stderr, "foreachGlobal threads\n");
-	maybeCall (f, s, (pointer*)&s->callFromCHandler);
-	maybeCall (f, s, (pointer*)&s->currentThread);
-	maybeCall (f, s, (pointer*)&s->savedThread);
-	maybeCall (f, s, (pointer*)&s->signalHandler);
+        for (i = 0; i < s->globalsSize; ++i) {
+                if (DEBUG_DETAILED)
+                        fprintf (stderr, "foreachGlobal %u\n", i);
+                maybeCall (f, s, &s->globals [i]);
+        }
+        if (DEBUG_DETAILED)
+                fprintf (stderr, "foreachGlobal threads\n");
+        maybeCall (f, s, (pointer*)&s->callFromCHandler);
+        maybeCall (f, s, (pointer*)&s->currentThread);
+        maybeCall (f, s, (pointer*)&s->savedThread);
+        maybeCall (f, s, (pointer*)&s->signalHandler);
 }
 
 #if ASSERT
 static pointer arrayPointer (GC_state s, 
-				pointer a, 
-				uint arrayIndex, 
-				uint pointerIndex) {
-	Bool hasIdentity;
-	word header;
-	uint numPointers;
-	uint numNonPointers;
-	uint tag;
+                                pointer a, 
+                                uint arrayIndex, 
+                                uint pointerIndex) {
+        Bool hasIdentity;
+        word header;
+        uint numPointers;
+        uint numNonPointers;
+        uint tag;
 
-	header = GC_getHeader (a);
-	SPLIT_HEADER();
-	assert (tag == ARRAY_TAG);
-	return a 
-		+ arrayIndex * (numNonPointers + toBytes (numPointers))
-		+ numNonPointers
-		+ pointerIndex * POINTER_SIZE;
+        header = GC_getHeader (a);
+        SPLIT_HEADER();
+        assert (tag == ARRAY_TAG);
+        return a 
+                + arrayIndex * (numNonPointers + toBytes (numPointers))
+                + numNonPointers
+                + pointerIndex * POINTER_SIZE;
 }
 #endif
 
 /* The number of bytes in an array, not including the header. */
 static inline uint arrayNumBytes (GC_state s,
-					pointer p, 
-					uint numPointers,
-					uint numNonPointers) {
-	uint bytesPerElement;
-	uint numElements;
-	uint result;
-	
-	numElements = GC_arrayNumElements (p);
-	bytesPerElement = numNonPointers + toBytes (numPointers);
-	result = numElements * bytesPerElement;
-	/* Empty arrays have POINTER_SIZE bytes for the forwarding pointer */
-	if (0 == result) 
-		result = POINTER_SIZE;
-	return pad (s, result, GC_ARRAY_HEADER_SIZE);
+                                        pointer p, 
+                                        uint numPointers,
+                                        uint numNonPointers) {
+        uint bytesPerElement;
+        uint numElements;
+        uint result;
+        
+        numElements = GC_arrayNumElements (p);
+        bytesPerElement = numNonPointers + toBytes (numPointers);
+        result = numElements * bytesPerElement;
+        /* Empty arrays have POINTER_SIZE bytes for the forwarding pointer */
+        if (0 == result) 
+                result = POINTER_SIZE;
+        return pad (s, result, GC_ARRAY_HEADER_SIZE);
 }
 
 /* ---------------------------------------------------------------- */
@@ -669,121 +671,121 @@
  */
 
 static inline pointer foreachPointerInObject (GC_state s, pointer p,
-						Bool skipWeaks,
-						GC_pointerFun f) {
-	Bool hasIdentity;
-	word header;
-	uint numPointers;
-	uint numNonPointers;
-	uint tag;
+                                                Bool skipWeaks,
+                                                GC_pointerFun f) {
+        Bool hasIdentity;
+        word header;
+        uint numPointers;
+        uint numNonPointers;
+        uint tag;
 
-	header = GC_getHeader (p);
-	SPLIT_HEADER();
-	if (DEBUG_DETAILED)
-		fprintf (stderr, "foreachPointerInObject p = 0x%x  header = 0x%x  tag = %s  numNonPointers = %d  numPointers = %d\n", 
-			(uint)p, header, tagToString (tag), 
-			numNonPointers, numPointers);
-	if (NORMAL_TAG == tag) {
-		pointer max;
+        header = GC_getHeader (p);
+        SPLIT_HEADER();
+        if (DEBUG_DETAILED)
+                fprintf (stderr, "foreachPointerInObject p = 0x%x  header = 0x%x  tag = %s  numNonPointers = %d  numPointers = %d\n", 
+                        (uint)p, header, tagToString (tag), 
+                        numNonPointers, numPointers);
+        if (NORMAL_TAG == tag) {
+                pointer max;
 
-		p += toBytes (numNonPointers);
-		max = p + toBytes (numPointers);
-		/* Apply f to all internal pointers. */
-		for ( ; p < max; p += POINTER_SIZE) {
-			if (DEBUG_DETAILED)
-				fprintf (stderr, "p = 0x%08x  *p = 0x%08x\n",
-						(uint)p, *(uint*)p);
-			maybeCall (f, s, (pointer*)p);
-		}
-	} else if (WEAK_TAG == tag) {
-		if (not skipWeaks and 1 == numPointers)
-			maybeCall (f, s, (pointer*)&(((GC_weak)p)->object));
-		p += sizeof (struct GC_weak);
-	} else if (ARRAY_TAG == tag) {
-		uint bytesPerElement;
-		uint dataBytes;
-		pointer max;
-		uint numElements;
+                p += toBytes (numNonPointers);
+                max = p + toBytes (numPointers);
+                /* Apply f to all internal pointers. */
+                for ( ; p < max; p += POINTER_SIZE) {
+                        if (DEBUG_DETAILED)
+                                fprintf (stderr, "p = 0x%08x  *p = 0x%08x\n",
+                                                (uint)p, *(uint*)p);
+                        maybeCall (f, s, (pointer*)p);
+                }
+        } else if (WEAK_TAG == tag) {
+                if (not skipWeaks and 1 == numPointers)
+                        maybeCall (f, s, (pointer*)&(((GC_weak)p)->object));
+                p += sizeof (struct GC_weak);
+        } else if (ARRAY_TAG == tag) {
+                uint bytesPerElement;
+                uint dataBytes;
+                pointer max;
+                uint numElements;
 
-		numElements = GC_arrayNumElements (p);
-		bytesPerElement = numNonPointers + toBytes (numPointers);
-		dataBytes = numElements * bytesPerElement;
-		/* Must check 0 == dataBytes before 0 == numPointers to correctly
-		 * handle arrays when both are true.
-		 */
-		if (0 == dataBytes)
-			/* Empty arrays have space for forwarding pointer. */
-			dataBytes = POINTER_SIZE;
-		else if (0 == numPointers)
-			/* No pointers to process. */
-			;
-		else {
-			max = p + dataBytes;
-			if (0 == numNonPointers)
-			  	/* Array with only pointers. */
-				for (; p < max; p += POINTER_SIZE)
-					maybeCall (f, s, (pointer*)p);
-			else {
-				/* Array with a mix of pointers and non-pointers.
- 			         */
-				uint numBytesPointers;
-			
-				numBytesPointers = toBytes (numPointers);
-				/* For each array element. */
-				while (p < max) {
-					pointer max2;
+                numElements = GC_arrayNumElements (p);
+                bytesPerElement = numNonPointers + toBytes (numPointers);
+                dataBytes = numElements * bytesPerElement;
+                /* Must check 0 == dataBytes before 0 == numPointers to correctly
+                 * handle arrays when both are true.
+                 */
+                if (0 == dataBytes)
+                        /* Empty arrays have space for forwarding pointer. */
+                        dataBytes = POINTER_SIZE;
+                else if (0 == numPointers)
+                        /* No pointers to process. */
+                        ;
+                else {
+                        max = p + dataBytes;
+                        if (0 == numNonPointers)
+                                /* Array with only pointers. */
+                                for (; p < max; p += POINTER_SIZE)
+                                        maybeCall (f, s, (pointer*)p);
+                        else {
+                                /* Array with a mix of pointers and non-pointers.
+                                 */
+                                uint numBytesPointers;
+                        
+                                numBytesPointers = toBytes (numPointers);
+                                /* For each array element. */
+                                while (p < max) {
+                                        pointer max2;
 
-					/* Skip the non-pointers. */
-					p += numNonPointers;
-					max2 = p + numBytesPointers;
-					/* For each internal pointer. */
-					for ( ; p < max2; p += POINTER_SIZE) 
-						maybeCall (f, s, (pointer*)p);
-				}
-			}
-			assert (p == max);
-			p -= dataBytes;
-		}
-		p += pad (s, dataBytes, GC_ARRAY_HEADER_SIZE);
-	} else { /* stack */
-		GC_stack stack;
-		pointer top, bottom;
-		int i;
-		word returnAddress;
-		GC_frameLayout *layout;
-		GC_offsets frameOffsets;
+                                        /* Skip the non-pointers. */
+                                        p += numNonPointers;
+                                        max2 = p + numBytesPointers;
+                                        /* For each internal pointer. */
+                                        for ( ; p < max2; p += POINTER_SIZE) 
+                                                maybeCall (f, s, (pointer*)p);
+                                }
+                        }
+                        assert (p == max);
+                        p -= dataBytes;
+                }
+                p += pad (s, dataBytes, GC_ARRAY_HEADER_SIZE);
+        } else { /* stack */
+                GC_stack stack;
+                pointer top, bottom;
+                int i;
+                word returnAddress;
+                GC_frameLayout *layout;
+                GC_offsets frameOffsets;
 
-		assert (STACK_TAG == tag);
-		stack = (GC_stack)p;
-		bottom = stackBottom (s, stack);
-		top = stackTop (s, stack);
-		assert (stack->used <= stack->reserved);
-		while (top > bottom) {
-			/* Invariant: top points just past a "return address". */
-			returnAddress = *(word*) (top - WORD_SIZE);
-			if (DEBUG) {
-				fprintf (stderr, "  top = %d  return address = ",
-						top - bottom);
-				fprintf (stderr, "0x%08x.\n", returnAddress);
-			}
-			layout = getFrameLayout (s, returnAddress); 
-			frameOffsets = layout->offsets;
-			top -= layout->numBytes;
-			for (i = 0 ; i < frameOffsets[0] ; ++i) {
-				if (DEBUG)
-					fprintf(stderr, 
-						"    offset %u  address 0x%08x\n", 
-						frameOffsets[i + 1],
-						(uint)(*(pointer*)(top + frameOffsets[i + 1])));
-				maybeCall(f, s, 
-					  (pointer*)
-					  (top + frameOffsets[i + 1]));
-			}
-		}
-		assert(top == bottom);
-		p += sizeof (struct GC_stack) + stack->reserved;
-	}
-	return p;
+                assert (STACK_TAG == tag);
+                stack = (GC_stack)p;
+                bottom = stackBottom (s, stack);
+                top = stackTop (s, stack);
+                assert (stack->used <= stack->reserved);
+                while (top > bottom) {
+                        /* Invariant: top points just past a "return address". */
+                        returnAddress = *(word*) (top - WORD_SIZE);
+                        if (DEBUG) {
+                                fprintf (stderr, "  top = %d  return address = ",
+                                                top - bottom);
+                                fprintf (stderr, "0x%08x.\n", returnAddress);
+                        }
+                        layout = getFrameLayout (s, returnAddress); 
+                        frameOffsets = layout->offsets;
+                        top -= layout->numBytes;
+                        for (i = 0 ; i < frameOffsets[0] ; ++i) {
+                                if (DEBUG)
+                                        fprintf(stderr, 
+                                                "    offset %u  address 0x%08x\n", 
+                                                frameOffsets[i + 1],
+                                                (uint)(*(pointer*)(top + frameOffsets[i + 1])));
+                                maybeCall(f, s, 
+                                          (pointer*)
+                                          (top + frameOffsets[i + 1]));
+                        }
+                }
+                assert(top == bottom);
+                p += sizeof (struct GC_stack) + stack->reserved;
+        }
+        return p;
 }
 
 /* ---------------------------------------------------------------- */
@@ -794,19 +796,19 @@
  * to the start of the object data.
  */
 static inline pointer toData (GC_state s, pointer p) {
-	word header;
-	pointer res;
+        word header;
+        pointer res;
 
-	assert (isAlignedFrontier (s, p));
-	header = *(word*)p;
-	if (0 == header)
-		/* Looking at the counter word in an array. */
-		res = p + GC_ARRAY_HEADER_SIZE;
-	else
-		/* Looking at a header word. */
-		res = p + GC_NORMAL_HEADER_SIZE;
-	assert (isAligned ((uint)res, s->alignment));
-	return res;
+        assert (isAlignedFrontier (s, p));
+        header = *(word*)p;
+        if (0 == header)
+                /* Looking at the counter word in an array. */
+                res = p + GC_ARRAY_HEADER_SIZE;
+        else
+                /* Looking at a header word. */
+                res = p + GC_NORMAL_HEADER_SIZE;
+        assert (isAligned ((uint)res, s->alignment));
+        return res;
 }
 
 /* ---------------------------------------------------------------- */
@@ -825,30 +827,30 @@
  */
 
 static inline pointer foreachPointerInRange (GC_state s, 
-						pointer front, 
-						pointer *back,
-						Bool skipWeaks,
-						GC_pointerFun f) {
-	pointer b;
+                                                pointer front, 
+                                                pointer *back,
+                                                Bool skipWeaks,
+                                                GC_pointerFun f) {
+        pointer b;
 
-	assert (isAlignedFrontier (s, front));
-	if (DEBUG_DETAILED)
-		fprintf (stderr, "foreachPointerInRange  front = 0x%08x  *back = 0x%08x\n",
-				(uint)front, *(uint*)back);
-	b = *back;
-	assert (front <= b);
- 	while (front < b) {
-		while (front < b) {
-			assert (isAligned ((uint)front, WORD_SIZE));
-	       		if (DEBUG_DETAILED)
-				fprintf (stderr, "front = 0x%08x  *back = 0x%08x\n",
-						(uint)front, *(uint*)back);
-			front = foreachPointerInObject 
-					(s, toData (s, front), skipWeaks, f);
-		}
-		b = *back;
-	}
-	return front;
+        assert (isAlignedFrontier (s, front));
+        if (DEBUG_DETAILED)
+                fprintf (stderr, "foreachPointerInRange  front = 0x%08x  *back = 0x%08x\n",
+                                (uint)front, *(uint*)back);
+        b = *back;
+        assert (front <= b);
+        while (front < b) {
+                while (front < b) {
+                        assert (isAligned ((uint)front, WORD_SIZE));
+                        if (DEBUG_DETAILED)
+                                fprintf (stderr, "front = 0x%08x  *back = 0x%08x\n",
+                                                (uint)front, *(uint*)back);
+                        front = foreachPointerInObject 
+                                        (s, toData (s, front), skipWeaks, f);
+                }
+                b = *back;
+        }
+        return front;
 }
 
 /* ---------------------------------------------------------------- */
@@ -856,143 +858,143 @@
 /* ---------------------------------------------------------------- */
 
 static bool mutatorFrontierInvariant (GC_state s) {
-	return (s->currentThread->bytesNeeded <= 
-			s->limitPlusSlop - s->frontier);
+        return (s->currentThread->bytesNeeded <= 
+                        s->limitPlusSlop - s->frontier);
 }
 
 static bool mutatorStackInvariant (GC_state s) {
-	return (stackTop (s, s->currentThread->stack) <= 
-			stackLimit (s, s->currentThread->stack) + 
-			topFrameSize (s, s->currentThread->stack));
+        return (stackTop (s, s->currentThread->stack) <= 
+                        stackLimit (s, s->currentThread->stack) + 
+                        topFrameSize (s, s->currentThread->stack));
 }
 
 static bool ratiosOk (GC_state s) {
-	return 1.0 < s->growRatio
-			and 1.0 < s->nurseryRatio
-			and 1.0 < s->markCompactRatio
-			and s->markCompactRatio <= s->copyRatio
-			and s->copyRatio <= s->liveRatio;
+        return 1.0 < s->growRatio
+                        and 1.0 < s->nurseryRatio
+                        and 1.0 < s->markCompactRatio
+                        and s->markCompactRatio <= s->copyRatio
+                        and s->copyRatio <= s->liveRatio;
 }
 
 static inline bool isInNursery (GC_state s, pointer p) {
-	return s->nursery <= p and p < s->frontier;
+        return s->nursery <= p and p < s->frontier;
 }
 
 #if ASSERT
 
 static inline bool isInOldGen (GC_state s, pointer p) {
-	return s->heap.start <= p and p < s->heap.start + s->oldGenSize;
+        return s->heap.start <= p and p < s->heap.start + s->oldGenSize;
 }
 
 static inline bool isInFromSpace (GC_state s, pointer p) {
- 	return (isInOldGen (s, p) or isInNursery (s, p));
+        return (isInOldGen (s, p) or isInNursery (s, p));
 }
 
 static inline void assertIsInFromSpace (GC_state s, pointer *p) {
 #if ASSERT
-	unless (isInFromSpace (s, *p))
-		die ("gc.c: assertIsInFromSpace p = 0x%08x  *p = 0x%08x);\n",
-			(uint)p, *(uint*)p);
-	/* The following checks that intergenerational pointers have the
-	 * appropriate card marked.  Unfortunately, it doesn't work because
-	 * for stacks, the card containing the beginning of the stack is marked,
-	 * but any remaining cards aren't.
-	 */
-	if (FALSE and s->mutatorMarksCards 
-		and isInOldGen (s, (pointer)p) 
- 		and isInNursery (s, *p)
-		and not cardIsMarked (s, (pointer)p)) {
-		GC_display (s, stderr);
-		die ("gc.c: intergenerational pointer from 0x%08x to 0x%08x with unmarked card.\n",
-			(uint)p, *(uint*)p);
-	}
+        unless (isInFromSpace (s, *p))
+                die ("gc.c: assertIsInFromSpace p = 0x%08x  *p = 0x%08x);\n",
+                        (uint)p, *(uint*)p);
+        /* The following checks that intergenerational pointers have the
+         * appropriate card marked.  Unfortunately, it doesn't work because
+         * for stacks, the card containing the beginning of the stack is marked,
+         * but any remaining cards aren't.
+         */
+        if (FALSE and s->mutatorMarksCards 
+                and isInOldGen (s, (pointer)p) 
+                and isInNursery (s, *p)
+                and not cardIsMarked (s, (pointer)p)) {
+                GC_display (s, stderr);
+                die ("gc.c: intergenerational pointer from 0x%08x to 0x%08x with unmarked card.\n",
+                        (uint)p, *(uint*)p);
+        }
 #endif
 }
 
 static inline bool isInToSpace (GC_state s, pointer p) {
-	return (not (GC_isPointer (p))
-			or (s->toSpace <= p and p < s->toLimit));
+        return (not (GC_isPointer (p))
+                        or (s->toSpace <= p and p < s->toLimit));
 }
 
 static bool invariant (GC_state s) {
-	int i;
-	pointer back;
-	GC_stack stack;
+        int i;
+        pointer back;
+        GC_stack stack;
 
-	if (DEBUG)
-		fprintf (stderr, "invariant\n");
-	assert (ratiosOk (s));
-	/* Frame layouts */
-	for (i = 0; i < s->frameLayoutsSize; ++i) {
-		GC_frameLayout *layout;
+        if (DEBUG)
+                fprintf (stderr, "invariant\n");
+        assert (ratiosOk (s));
+        /* Frame layouts */
+        for (i = 0; i < s->frameLayoutsSize; ++i) {
+                GC_frameLayout *layout;
 
-		layout = &(s->frameLayouts[i]);
-		if (layout->numBytes > 0) {
-			GC_offsets offsets;
-//			int j;
+                layout = &(s->frameLayouts[i]);
+                if (layout->numBytes > 0) {
+                        GC_offsets offsets;
+//                      int j;
 
-			assert (layout->numBytes <= s->maxFrameSize);
-			offsets = layout->offsets;
+                        assert (layout->numBytes <= s->maxFrameSize);
+                        offsets = layout->offsets;
 // No longer correct, since handler frames have a "size" (i.e. return address)
 // pointing into the middle of the frame.
-//			for (j = 0; j < offsets[0]; ++j)
-//				assert (offsets[j + 1] < layout->numBytes);
-		}
-	}
-	if (s->mutatorMarksCards) {
-		assert (s->cardMap == 
-				&s->cardMapForMutator[divCardSize(s, (uint)s->heap.start)]);
-		assert (&s->cardMapForMutator[divCardSize (s, (uint)s->heap.start + s->heap.size - WORD_SIZE)]
-				< s->cardMap + s->cardMapSize);
-	}
-	/* Heap */
-	assert (isAligned (s->heap.size, s->pageSize));
-	assert (isAligned ((uint)s->heap.start, s->cardSize));
-	assert (isAlignedFrontier (s, s->heap.start + s->oldGenSize));
-	assert (isAlignedFrontier (s, s->nursery));
-	assert (isAlignedFrontier (s, s->frontier));
-	assert (s->nursery <= s->frontier);
-	unless (0 == s->heap.size) {
-		assert (s->nursery <= s->frontier);
-		assert (s->frontier <= s->limitPlusSlop);
-		assert (s->limit == s->limitPlusSlop - LIMIT_SLOP);
-		assert (hasBytesFree (s, 0, 0));
-	}
-	assert (s->heap2.start == NULL or s->heap.size == s->heap2.size);
-	/* Check that all pointers are into from space. */
-	foreachGlobal (s, assertIsInFromSpace);
-	back = s->heap.start + s->oldGenSize;
-	if (DEBUG_DETAILED)
-		fprintf (stderr, "Checking old generation.\n");
-	foreachPointerInRange (s, alignFrontier (s, s->heap.start), &back, FALSE,
-				assertIsInFromSpace);
-	if (DEBUG_DETAILED)
-		fprintf (stderr, "Checking nursery.\n");
-	foreachPointerInRange (s, s->nursery, &s->frontier, FALSE,
-				assertIsInFromSpace);
-	/* Current thread. */
-	stack = s->currentThread->stack;
-	assert (isAlignedReserved (s, stack->reserved));
-	assert (s->stackBottom == stackBottom (s, stack));
-	assert (s->stackTop == stackTop (s, stack));
- 	assert (s->stackLimit == stackLimit (s, stack));
-	assert (stack->used == currentStackUsed (s));
-	assert (stack->used <= stack->reserved);
- 	assert (s->stackBottom <= s->stackTop);
-	if (DEBUG)
-		fprintf (stderr, "invariant passed\n");
-	return TRUE;
+//                      for (j = 0; j < offsets[0]; ++j)
+//                              assert (offsets[j + 1] < layout->numBytes);
+                }
+        }
+        if (s->mutatorMarksCards) {
+                assert (s->cardMap == 
+                                &s->cardMapForMutator[divCardSize(s, (uint)s->heap.start)]);
+                assert (&s->cardMapForMutator[divCardSize (s, (uint)s->heap.start + s->heap.size - WORD_SIZE)]
+                                < s->cardMap + s->cardMapSize);
+        }
+        /* Heap */
+        assert (isAligned (s->heap.size, s->pageSize));
+        assert (isAligned ((uint)s->heap.start, s->cardSize));
+        assert (isAlignedFrontier (s, s->heap.start + s->oldGenSize));
+        assert (isAlignedFrontier (s, s->nursery));
+        assert (isAlignedFrontier (s, s->frontier));
+        assert (s->nursery <= s->frontier);
+        unless (0 == s->heap.size) {
+                assert (s->nursery <= s->frontier);
+                assert (s->frontier <= s->limitPlusSlop);
+                assert (s->limit == s->limitPlusSlop - LIMIT_SLOP);
+                assert (hasBytesFree (s, 0, 0));
+        }
+        assert (s->heap2.start == NULL or s->heap.size == s->heap2.size);
+        /* Check that all pointers are into from space. */
+        foreachGlobal (s, assertIsInFromSpace);
+        back = s->heap.start + s->oldGenSize;
+        if (DEBUG_DETAILED)
+                fprintf (stderr, "Checking old generation.\n");
+        foreachPointerInRange (s, alignFrontier (s, s->heap.start), &back, FALSE,
+                                assertIsInFromSpace);
+        if (DEBUG_DETAILED)
+                fprintf (stderr, "Checking nursery.\n");
+        foreachPointerInRange (s, s->nursery, &s->frontier, FALSE,
+                                assertIsInFromSpace);
+        /* Current thread. */
+        stack = s->currentThread->stack;
+        assert (isAlignedReserved (s, stack->reserved));
+        assert (s->stackBottom == stackBottom (s, stack));
+        assert (s->stackTop == stackTop (s, stack));
+        assert (s->stackLimit == stackLimit (s, stack));
+        assert (stack->used == currentStackUsed (s));
+        assert (stack->used <= stack->reserved);
+        assert (s->stackBottom <= s->stackTop);
+        if (DEBUG)
+                fprintf (stderr, "invariant passed\n");
+        return TRUE;
 }
 
 static bool mutatorInvariant (GC_state s, bool frontier, bool stack) {
-	if (DEBUG)
-		GC_display (s, stderr);
-	if (frontier)
-		assert (mutatorFrontierInvariant(s));
-	if (stack)
-		assert (mutatorStackInvariant(s));
-	assert (invariant (s));
-	return TRUE;
+        if (DEBUG)
+                GC_display (s, stderr);
+        if (frontier)
+                assert (mutatorFrontierInvariant(s));
+        if (stack)
+                assert (mutatorStackInvariant(s));
+        assert (invariant (s));
+        return TRUE;
 }
 #endif /* #if ASSERT */
 
@@ -1001,15 +1003,15 @@
 /* ---------------------------------------------------------------- */
 
 static inline void atomicBegin (GC_state s) {
-	s->canHandle++;
-	if (0 == s->limit)
-		s->limit = s->limitPlusSlop - LIMIT_SLOP;
+        s->canHandle++;
+        if (0 == s->limit)
+                s->limit = s->limitPlusSlop - LIMIT_SLOP;
 }
 
 static inline void atomicEnd (GC_state s) {
-	s->canHandle--;
-	if (0 == s->canHandle and s->signalIsPending)
-		s->limit = 0;
+        s->canHandle--;
+        if (0 == s->canHandle and s->signalIsPending)
+                s->limit = 0;
 }
 
 /* enter and leave should be called at the start and end of every GC function
@@ -1017,29 +1019,29 @@
  * is run in a critical section and check the GC invariant.
  */
 static void enter (GC_state s) {
-	if (DEBUG)
-		fprintf (stderr, "enter\n");
-	/* used needs to be set because the mutator has changed s->stackTop. */
-	s->currentThread->stack->used = currentStackUsed (s);
-	s->currentThread->exnStack = s->exnStack;
-	if (DEBUG) 
-		GC_display (s, stderr);
-	atomicBegin (s);
-	assert (invariant (s));
-	if (DEBUG)
-		fprintf (stderr, "enter ok\n");
+        if (DEBUG)
+                fprintf (stderr, "enter\n");
+        /* used needs to be set because the mutator has changed s->stackTop. */
+        s->currentThread->stack->used = currentStackUsed (s);
+        s->currentThread->exnStack = s->exnStack;
+        if (DEBUG) 
+                GC_display (s, stderr);
+        atomicBegin (s);
+        assert (invariant (s));
+        if (DEBUG)
+                fprintf (stderr, "enter ok\n");
 }
 
 static void leave (GC_state s) {
-	if (DEBUG)
-		fprintf (stderr, "leave\n");
-	/* The mutator frontier invariant may not hold
-	 * for functions that don't ensureBytesFree.
-	 */
-	assert (mutatorInvariant (s, FALSE, TRUE));
-	atomicEnd (s);
-	if (DEBUG)
-		fprintf (stderr, "leave ok\n");
+        if (DEBUG)
+                fprintf (stderr, "leave\n");
+        /* The mutator frontier invariant may not hold
+         * for functions that don't ensureBytesFree.
+         */
+        assert (mutatorInvariant (s, FALSE, TRUE));
+        atomicEnd (s);
+        if (DEBUG)
+                fprintf (stderr, "leave ok\n");
 }
 
 /* ---------------------------------------------------------------- */
@@ -1050,231 +1052,231 @@
  * l bytes live, given that the current heap size is c.
  */
 static W32 heapDesiredSize (GC_state s, W64 live, W32 currentSize) {
-	W32 res;
-	float ratio;
+        W32 res;
+        float ratio;
 
-	ratio = (float)s->ram / (float)live;
+        ratio = (float)s->ram / (float)live;
         if (ratio >= s->liveRatio + s->growRatio) {
-		/* Cheney copying fits in RAM with desired liveRatio. */
-		res = live * s->liveRatio;
-		/* If the heap is currently close in size to what we want, leave
-		 * it alone.  Favor growing over shrinking.
-		 */
-		unless (res >= 1.1 * currentSize 
-				or res <= .5 * currentSize)
-			res = currentSize;
-	} else if (s->growRatio >= s->copyRatio
-			and ratio >= 2 * s->copyRatio) {
-		/* Split RAM in half.  Round down by pageSize so that the total
-		 * amount of space taken isn't greater than RAM once rounding
-		 * happens.  This is so resizeHeap2 doesn't get confused and
-		 * free a semispace in a misguided attempt to avoid paging.
-		 */
-		res = roundDown (s->ram / 2, s->pageSize) ;
-	} else if (ratio >= s->copyRatio + s->growRatio) {
-		/* Cheney copying fits in RAM. */
-		res = s->ram - s->growRatio * live;
-		/* If the heap isn't too much smaller than what we want, leave
-		 * it alone.  On the other hand, if it is bigger we want to
-		 * leave res as is so that the heap is shrunk, to try to avoid
-		 * paging.
-		 */
-		if (0.9 * res <= currentSize and currentSize <= res)
-			res = currentSize;
-	} else if (ratio >= s->markCompactRatio) {
-		/* Mark compact fits in ram.  It doesn't matter what the current
-		 * size is.  If the heap is currently smaller, we are using
-		 * copying and should switch to mark-compact.  If the heap is
-		 * currently bigger, we want to shrink back to ram size to avoid
-		 * paging.
-		 */
-		res = s->ram;
-	} else { /* Required live ratio. */
-		res = live * s->markCompactRatio;
-		/* If the current heap is bigger than res, the shrinking always
-		 * sounds like a good idea.  However, depending on what pages
-		 * the VM keeps around, growing could be very expensive, if it
-		 * involves paging the entire heap.  Hopefully the copy loop
-		 * in growFromSpace will make the right thing happen.
-		 */ 
-	}
-	if (s->fixedHeap > 0) {
-		if (res > s->fixedHeap / 2)
-			res = s->fixedHeap;
-		else
-			res = s->fixedHeap / 2;
-		if (res < live)
-			die ("Out of memory with fixed heap size %s.",
-				uintToCommaString (s->fixedHeap));
-	} else if (s->maxHeap > 0) {
-		if (res > s->maxHeap)
-			res = s->maxHeap;
-		if (res < live)
-			die ("Out of memory with max heap size %s.",
-				uintToCommaString (s->maxHeap));
-	}
-	if (DEBUG_RESIZING)
-		fprintf (stderr, "%s = heapDesiredSize (%s)\n",
-				uintToCommaString (res),
-				ullongToCommaString (live));
-	assert (res >= live);
-	return res;
+                /* Cheney copying fits in RAM with desired liveRatio. */
+                res = live * s->liveRatio;
+                /* If the heap is currently close in size to what we want, leave
+                 * it alone.  Favor growing over shrinking.
+                 */
+                unless (res >= 1.1 * currentSize 
+                                or res <= .5 * currentSize)
+                        res = currentSize;
+        } else if (s->growRatio >= s->copyRatio
+                        and ratio >= 2 * s->copyRatio) {
+                /* Split RAM in half.  Round down by pageSize so that the total
+                 * amount of space taken isn't greater than RAM once rounding
+                 * happens.  This is so resizeHeap2 doesn't get confused and
+                 * free a semispace in a misguided attempt to avoid paging.
+                 */
+                res = roundDown (s->ram / 2, s->pageSize) ;
+        } else if (ratio >= s->copyRatio + s->growRatio) {
+                /* Cheney copying fits in RAM. */
+                res = s->ram - s->growRatio * live;
+                /* If the heap isn't too much smaller than what we want, leave
+                 * it alone.  On the other hand, if it is bigger we want to
+                 * leave res as is so that the heap is shrunk, to try to avoid
+                 * paging.
+                 */
+                if (0.9 * res <= currentSize and currentSize <= res)
+                        res = currentSize;
+        } else if (ratio >= s->markCompactRatio) {
+                /* Mark compact fits in ram.  It doesn't matter what the current
+                 * size is.  If the heap is currently smaller, we are using
+                 * copying and should switch to mark-compact.  If the heap is
+                 * currently bigger, we want to shrink back to ram size to avoid
+                 * paging.
+                 */
+                res = s->ram;
+        } else { /* Required live ratio. */
+                res = live * s->markCompactRatio;
+                /* If the current heap is bigger than res, the shrinking always
+                 * sounds like a good idea.  However, depending on what pages
+                 * the VM keeps around, growing could be very expensive, if it
+                 * involves paging the entire heap.  Hopefully the copy loop
+                 * in growFromSpace will make the right thing happen.
+                 */ 
+        }
+        if (s->fixedHeap > 0) {
+                if (res > s->fixedHeap / 2)
+                        res = s->fixedHeap;
+                else
+                        res = s->fixedHeap / 2;
+                if (res < live)
+                        die ("Out of memory with fixed heap size %s.",
+                                uintToCommaString (s->fixedHeap));
+        } else if (s->maxHeap > 0) {
+                if (res > s->maxHeap)
+                        res = s->maxHeap;
+                if (res < live)
+                        die ("Out of memory with max heap size %s.",
+                                uintToCommaString (s->maxHeap));
+        }
+        if (DEBUG_RESIZING)
+                fprintf (stderr, "%s = heapDesiredSize (%s)\n",
+                                uintToCommaString (res),
+                                ullongToCommaString (live));
+        assert (res >= live);
+        return res;
 }
 
 static inline void heapInit (GC_heap h) {
-	h->size = 0;
-	h->start = NULL;
+        h->size = 0;
+        h->start = NULL;
 }
 
 static inline bool heapIsInit (GC_heap h) {
-	return 0 == h->size;
+        return 0 == h->size;
 }
 
 static void heapRelease (GC_state s, GC_heap h) {
-	if (NULL == h->start)
-		return;
-	if (DEBUG or s->messages)
-		fprintf (stderr, "Releasing heap at 0x%08x of size %s.\n", 
-				(uint)h->start, 
-				uintToCommaString (h->size));
-	GC_release (h->start, h->size);
-	heapInit (h);
+        if (NULL == h->start)
+                return;
+        if (DEBUG or s->messages)
+                fprintf (stderr, "Releasing heap at 0x%08x of size %s.\n", 
+                                (uint)h->start, 
+                                uintToCommaString (h->size));
+        GC_release (h->start, h->size);
+        heapInit (h);
 }
 
 static void heapShrink (GC_state s, GC_heap h, W32 keep) {
-	assert (keep <= h->size);
-	if (0 == keep) {
-		heapRelease (s, h);
-		return;
-	}
-	keep = align (keep, s->pageSize);
-	if (keep < h->size) {
-		if (DEBUG or s->messages)
-			fprintf (stderr, 
-				"Shrinking heap at 0x%08x of size %s to %s bytes.\n",
-				(uint)h->start, 
-				uintToCommaString (h->size),
-				uintToCommaString (keep));
-		GC_decommit (h->start + keep, h->size - keep);
-		h->size = keep;
-	}
+        assert (keep <= h->size);
+        if (0 == keep) {
+                heapRelease (s, h);
+                return;
+        }
+        keep = align (keep, s->pageSize);
+        if (keep < h->size) {
+                if (DEBUG or s->messages)
+                        fprintf (stderr, 
+                                "Shrinking heap at 0x%08x of size %s to %s bytes.\n",
+                                (uint)h->start, 
+                                uintToCommaString (h->size),
+                                uintToCommaString (keep));
+                GC_decommit (h->start + keep, h->size - keep);
+                h->size = keep;
+        }
 }
 
 static void clearCardMap (GC_state s) {
-	memset (s->cardMap, 0, s->cardMapSize);
+        memset (s->cardMap, 0, s->cardMapSize);
 }
 
 static void setNursery (GC_state s, W32 oldGenBytesRequested,
-				W32 nurseryBytesRequested) {
-	GC_heap h;
-	uint nurserySize;
+                                W32 nurseryBytesRequested) {
+        GC_heap h;
+        uint nurserySize;
 
-	if (DEBUG_DETAILED)
-		fprintf (stderr, "setNursery.  oldGenBytesRequested = %s  frontier = 0x%08x\n",  
-				uintToCommaString (oldGenBytesRequested),
-				(uint)s->frontier);
-	h = &s->heap;
-	assert (isAlignedFrontier (s, h->start + s->oldGenSize 
-					+ oldGenBytesRequested));
-	nurserySize = h->size - s->oldGenSize - oldGenBytesRequested;
-	s->limitPlusSlop = h->start + h->size;
-	s->limit = s->limitPlusSlop - LIMIT_SLOP;
-	assert (isAligned (nurserySize, WORD_SIZE));
-	if (	/* The mutator marks cards. */
-       		s->mutatorMarksCards
-		/* There is enough space in the nursery. */
-		and (nurseryBytesRequested 
-			<= s->limitPlusSlop
-				- alignFrontier (s, s->limitPlusSlop
-							- nurserySize/2 + 2))
-		/* The nursery is large enough to be worth it. */
-		and (((float)(h->size - s->bytesLive) 
-			/ (float)nurserySize) <= s->nurseryRatio)
-		and /* There is a reason to use generational GC. */
-		(
-		/* We must use it for debugging pruposes. */
-		FORCE_GENERATIONAL
-		/* We just did a mark compact, so it will be advantageous to
-		 * to use it.
-		 */
-		or (s->lastMajor == GC_MARK_COMPACT)
-		/* The live ratio is low enough to make it worthwhile. */
-		or (float)h->size / (float)s->bytesLive 
-			<= (h->size < s->ram
-				? s->copyGenerationalRatio
-				: s->markCompactGenerationalRatio)
-		)) {
-		s->canMinor = TRUE;
-		nurserySize /= 2;
-		unless (isAligned (nurserySize, WORD_SIZE))
-			nurserySize -= 2;
-		clearCardMap (s);
-	} else {
-		unless (nurseryBytesRequested 
-				<= s->limitPlusSlop
-					- alignFrontier (s, s->limitPlusSlop
-								- nurserySize))
-			die ("Out of memory.  Insufficient space in nursery.");
-		s->canMinor = FALSE;
-	}
-	assert (nurseryBytesRequested 
-			<= s->limitPlusSlop
-				- alignFrontier (s, s->limitPlusSlop 
-							- nurserySize));
-	s->nursery = alignFrontier (s, s->limitPlusSlop - nurserySize);
-	s->frontier = s->nursery;
-	assert (nurseryBytesRequested <= s->limitPlusSlop - s->frontier);
-	assert (isAlignedFrontier (s, s->nursery));
-	assert (hasBytesFree (s, oldGenBytesRequested, nurseryBytesRequested));
+        if (DEBUG_DETAILED)
+                fprintf (stderr, "setNursery.  oldGenBytesRequested = %s  frontier = 0x%08x\n",  
+                                uintToCommaString (oldGenBytesRequested),
+                                (uint)s->frontier);
+        h = &s->heap;
+        assert (isAlignedFrontier (s, h->start + s->oldGenSize 
+                                        + oldGenBytesRequested));
+        nurserySize = h->size - s->oldGenSize - oldGenBytesRequested;
+        s->limitPlusSlop = h->start + h->size;
+        s->limit = s->limitPlusSlop - LIMIT_SLOP;
+        assert (isAligned (nurserySize, WORD_SIZE));
+        if (    /* The mutator marks cards. */
+                s->mutatorMarksCards
+                /* There is enough space in the nursery. */
+                and (nurseryBytesRequested 
+                        <= s->limitPlusSlop
+                                - alignFrontier (s, s->limitPlusSlop
+                                                        - nurserySize/2 + 2))
+                /* The nursery is large enough to be worth it. */
+                and (((float)(h->size - s->bytesLive) 
+                        / (float)nurserySize) <= s->nurseryRatio)
+                and /* There is a reason to use generational GC. */
+                (
+                /* We must use it for debugging pruposes. */
+                FORCE_GENERATIONAL
+                /* We just did a mark compact, so it will be advantageous to
+                 * to use it.
+                 */
+                or (s->lastMajor == GC_MARK_COMPACT)
+                /* The live ratio is low enough to make it worthwhile. */
+                or (float)h->size / (float)s->bytesLive 
+                        <= (h->size < s->ram
+                                ? s->copyGenerationalRatio
+                                : s->markCompactGenerationalRatio)
+                )) {
+                s->canMinor = TRUE;
+                nurserySize /= 2;
+                unless (isAligned (nurserySize, WORD_SIZE))
+                        nurserySize -= 2;
+                clearCardMap (s);
+        } else {
+                unless (nurseryBytesRequested 
+                                <= s->limitPlusSlop
+                                        - alignFrontier (s, s->limitPlusSlop
+                                                                - nurserySize))
+                        die ("Out of memory.  Insufficient space in nursery.");
+                s->canMinor = FALSE;
+        }
+        assert (nurseryBytesRequested 
+                        <= s->limitPlusSlop
+                                - alignFrontier (s, s->limitPlusSlop 
+                                                        - nurserySize));
+        s->nursery = alignFrontier (s, s->limitPlusSlop - nurserySize);
+        s->frontier = s->nursery;
+        assert (nurseryBytesRequested <= s->limitPlusSlop - s->frontier);
+        assert (isAlignedFrontier (s, s->nursery));
+        assert (hasBytesFree (s, oldGenBytesRequested, nurseryBytesRequested));
 }
 
 static inline void clearCrossMap (GC_state s) {
-	if (DEBUG_GENERATIONAL and DEBUG_DETAILED)
-		fprintf (stderr, "clearCrossMap ()\n");
-	s->crossMapValidSize = 0;
-	memset (s->crossMap, CROSS_MAP_EMPTY, s->crossMapSize);
+        if (DEBUG_GENERATIONAL and DEBUG_DETAILED)
+                fprintf (stderr, "clearCrossMap ()\n");
+        s->crossMapValidSize = 0;
+        memset (s->crossMap, CROSS_MAP_EMPTY, s->crossMapSize);
 }
 
 static void setCardMapForMutator (GC_state s) {
-	unless (s->mutatorMarksCards)
-		return;
-	/* It's OK if the subtraction below underflows because all the 
+        unless (s->mutatorMarksCards)
+                return;
+        /* It's OK if the subtraction below underflows because all the 
          * subsequent additions to mark the cards will overflow and put us
-	 * in the right place.
+         * in the right place.
          */
-	s->cardMapForMutator = s->cardMap - divCardSize (s, (uint)s->heap.start);
-	if (DEBUG_CARD_MARKING)
-		fprintf (stderr, "cardMapForMutator = 0x%08x\n",
-				(uint)s->cardMapForMutator);
+        s->cardMapForMutator = s->cardMap - divCardSize (s, (uint)s->heap.start);
+        if (DEBUG_CARD_MARKING)
+                fprintf (stderr, "cardMapForMutator = 0x%08x\n",
+                                (uint)s->cardMapForMutator);
 }
 
 static void createCardMapAndCrossMap (GC_state s) {
-	GC_heap h;
+        GC_heap h;
 
-	unless (s->mutatorMarksCards) {
-		s->cardMapSize = 0;
-		s->cardMap = NULL;
-		s->cardMapForMutator = NULL;
-		s->crossMapSize = 0;
-		s->crossMap = NULL;
-		return;
-	}
-	h = &s->heap;
-	assert (isAligned (h->size, s->cardSize));
-	s->cardMapSize = align (divCardSize (s, h->size), s->pageSize);
-	s->crossMapSize = s->cardMapSize;
-	if (DEBUG_MEM)
-		fprintf (stderr, "Creating card/cross map of size %s\n",
-				uintToCommaString
-					(s->cardMapSize + s->crossMapSize));
-	s->cardMap = smmap (s->cardMapSize + s->crossMapSize);
-	s->crossMap = s->cardMap + s->cardMapSize;
-	if (DEBUG_CARD_MARKING)
-		fprintf (stderr, "cardMap = 0x%08x  crossMap = 0x%08x\n", 
-				(uint)s->cardMap,
-				(uint)s->crossMap);
-	setCardMapForMutator (s);
-	clearCrossMap (s);
+        unless (s->mutatorMarksCards) {
+                s->cardMapSize = 0;
+                s->cardMap = NULL;
+                s->cardMapForMutator = NULL;
+                s->crossMapSize = 0;
+                s->crossMap = NULL;
+                return;
+        }
+        h = &s->heap;
+        assert (isAligned (h->size, s->cardSize));
+        s->cardMapSize = align (divCardSize (s, h->size), s->pageSize);
+        s->crossMapSize = s->cardMapSize;
+        if (DEBUG_MEM)
+                fprintf (stderr, "Creating card/cross map of size %s\n",
+                                uintToCommaString
+                                        (s->cardMapSize + s->crossMapSize));
+        s->cardMap = smmap (s->cardMapSize + s->crossMapSize);
+        s->crossMap = (uchar *)s->cardMap + s->cardMapSize;
+        if (DEBUG_CARD_MARKING)
+                fprintf (stderr, "cardMap = 0x%08x  crossMap = 0x%08x\n", 
+                                (uint)s->cardMap,
+                                (uint)s->crossMap);
+        setCardMapForMutator (s);
+        clearCrossMap (s);
 }
 
 /* heapCreate (s, h, need, minSize) allocates a heap of the size necessary to
@@ -1284,82 +1286,82 @@
  * leaves it.
  */
 static bool heapCreate (GC_state s, GC_heap h, W32 desiredSize, W32 minSize) {
-	W32 backoff;
+        W32 backoff;
 
-	if (DEBUG_MEM)
-		fprintf (stderr, "heapCreate  desired size = %s  min size = %s\n",
-				uintToCommaString (desiredSize),
-				uintToCommaString (minSize));
-	assert (heapIsInit (h));
-	if (desiredSize < minSize)
-		desiredSize = minSize;
- 	desiredSize = align (desiredSize, s->pageSize);
-	assert (0 == h->size and NULL == h->start);
-	backoff = (desiredSize - minSize) / 20;
-	if (0 == backoff)
-		backoff = 1; /* enough to terminate the loop below */
-	backoff = align (backoff, s->pageSize);
-	/* mmap toggling back and forth between high and low addresses to
+        if (DEBUG_MEM)
+                fprintf (stderr, "heapCreate  desired size = %s  min size = %s\n",
+                                uintToCommaString (desiredSize),
+                                uintToCommaString (minSize));
+        assert (heapIsInit (h));
+        if (desiredSize < minSize)
+                desiredSize = minSize;
+        desiredSize = align (desiredSize, s->pageSize);
+        assert (0 == h->size and NULL == h->start);
+        backoff = (desiredSize - minSize) / 20;
+        if (0 == backoff)
+                backoff = 1; /* enough to terminate the loop below */
+        backoff = align (backoff, s->pageSize);
+        /* mmap toggling back and forth between high and low addresses to
          * decrease the chance of virtual memory fragmentation causing an mmap
-	 * to fail.  This is important for large heaps.
-	 */
-	for (h->size = desiredSize; h->size >= minSize; h->size -= backoff) {
-		static int direction = 1;
-		int i;
+         * to fail.  This is important for large heaps.
+         */
+        for (h->size = desiredSize; h->size >= minSize; h->size -= backoff) {
+                static int direction = 1;
+                int i;
 
-		assert (isAligned (h->size, s->pageSize));
-		for (i = 0; i < 32; i++) {
-			unsigned long address;
+                assert (isAligned (h->size, s->pageSize));
+                for (i = 0; i < 32; i++) {
+                        unsigned long address;
 
-			address = i * 0x08000000ul;
-			if (direction)
-				address = 0xf8000000ul - address;
-			h->start = GC_mmapAnon ((void*)address, h->size);
-			if ((void*)-1 == h->start)
-				h->start = (void*)NULL;
-			unless ((void*)NULL == h->start) {
-				direction = (0 == direction);
-				if (h->size > s->maxHeapSizeSeen)
-					s->maxHeapSizeSeen = h->size;
-				if (DEBUG or s->messages)
-					fprintf (stderr, "Created heap of size %s at 0x%08x.\n",
-							uintToCommaString (h->size),
-							(uint)h->start);
-				assert (h->size >= minSize);
-				return TRUE;
-			}
-		}
-		if (s->messages)
-			fprintf(stderr, "[Requested %luM cannot be satisfied, backing off by %luM (min size = %luM).\n",
-				meg (h->size), meg (backoff), meg (minSize));
-	}
-	h->size = 0;
-	return FALSE;
+                        address = i * 0x08000000ul;
+                        if (direction)
+                                address = 0xf8000000ul - address;
+                        h->start = GC_mmapAnon ((void*)address, h->size);
+                        if ((void*)-1 == h->start)
+                                h->start = (void*)NULL;
+                        unless ((void*)NULL == h->start) {
+                                direction = (0 == direction);
+                                if (h->size > s->maxHeapSizeSeen)
+                                        s->maxHeapSizeSeen = h->size;
+                                if (DEBUG or s->messages)
+                                        fprintf (stderr, "Created heap of size %s at 0x%08x.\n",
+                                                        uintToCommaString (h->size),
+                                                        (uint)h->start);
+                                assert (h->size >= minSize);
+                                return TRUE;
+                        }
+                }
+                if (s->messages)
+                        fprintf(stderr, "[Requested %luM cannot be satisfied, backing off by %luM (min size = %luM).\n",
+                                meg (h->size), meg (backoff), meg (minSize));
+        }
+        h->size = 0;
+        return FALSE;
 }
 
 static inline uint objectSize (GC_state s, pointer p) {
-	Bool hasIdentity;
-	uint headerBytes, objectBytes;
-       	word header;
-	uint tag, numPointers, numNonPointers;
+        Bool hasIdentity;
+        uint headerBytes, objectBytes;
+        word header;
+        uint tag, numPointers, numNonPointers;
 
-	header = GC_getHeader (p);
-	SPLIT_HEADER();
-	if (NORMAL_TAG == tag) { /* Fixed size object. */
-		headerBytes = GC_NORMAL_HEADER_SIZE;
-		objectBytes = toBytes (numPointers + numNonPointers);
-	} else if (ARRAY_TAG == tag) {
-		headerBytes = GC_ARRAY_HEADER_SIZE;
-		objectBytes = arrayNumBytes (s, p, numPointers, numNonPointers);
-	} else if (WEAK_TAG == tag) {
-		headerBytes = GC_NORMAL_HEADER_SIZE;
-		objectBytes = sizeof (struct GC_weak);
-	} else { /* Stack. */
-		assert (STACK_TAG == tag);
-		headerBytes = STACK_HEADER_SIZE;
-		objectBytes = sizeof (struct GC_stack) + ((GC_stack)p)->reserved;
-	}
-	return headerBytes + objectBytes;
+        header = GC_getHeader (p);
+        SPLIT_HEADER();
+        if (NORMAL_TAG == tag) { /* Fixed size object. */
+                headerBytes = GC_NORMAL_HEADER_SIZE;
+                objectBytes = toBytes (numPointers + numNonPointers);
+        } else if (ARRAY_TAG == tag) {
+                headerBytes = GC_ARRAY_HEADER_SIZE;
+                objectBytes = arrayNumBytes (s, p, numPointers, numNonPointers);
+        } else if (WEAK_TAG == tag) {
+                headerBytes = GC_NORMAL_HEADER_SIZE;
+                objectBytes = sizeof (struct GC_weak);
+        } else { /* Stack. */
+                assert (STACK_TAG == tag);
+                headerBytes = STACK_HEADER_SIZE;
+                objectBytes = sizeof (struct GC_stack) + ((GC_stack)p)->reserved;
+        }
+        return headerBytes + objectBytes;
 }
 
 /* ---------------------------------------------------------------- */
@@ -1371,195 +1373,195 @@
  * It also updates the crossMap.
  */
 static inline void forward (GC_state s, pointer *pp) {
-	pointer p;
-	word header;
-	word tag;
+        pointer p;
+        word header;
+        word tag;
 
-	if (DEBUG_DETAILED)
-		fprintf (stderr, "forward  pp = 0x%x  *pp = 0x%x\n", (uint)pp, *(uint*)pp);
-	assert (isInFromSpace (s, *pp));
-	p = *pp;
-	header = GC_getHeader (p);
-	if (DEBUG_DETAILED and FORWARDED == header)
-		fprintf (stderr, "already FORWARDED\n");
-	if (header != FORWARDED) { /* forward the object */
-		Bool hasIdentity;
-		uint headerBytes, objectBytes, size, skip;
-		uint numPointers, numNonPointers;
+        if (DEBUG_DETAILED)
+                fprintf (stderr, "forward  pp = 0x%x  *pp = 0x%x\n", (uint)pp, *(uint*)pp);
+        assert (isInFromSpace (s, *pp));
+        p = *pp;
+        header = GC_getHeader (p);
+        if (DEBUG_DETAILED and FORWARDED == header)
+                fprintf (stderr, "already FORWARDED\n");
+        if (header != FORWARDED) { /* forward the object */
+                Bool hasIdentity;
+                uint headerBytes, objectBytes, size, skip;
+                uint numPointers, numNonPointers;
 
-		/* Compute the space taken by the header and object body. */
-		SPLIT_HEADER();
-		if (NORMAL_TAG == tag) { /* Fixed size object. */
-			headerBytes = GC_NORMAL_HEADER_SIZE;
-			objectBytes = toBytes (numPointers + numNonPointers);
-			skip = 0;
-		} else if (ARRAY_TAG == tag) {
-			headerBytes = GC_ARRAY_HEADER_SIZE;
-			objectBytes = arrayNumBytes (s, p, numPointers,
-							numNonPointers);
-			skip = 0;
-		} else if (WEAK_TAG == tag) {
-			headerBytes = GC_NORMAL_HEADER_SIZE;
-			objectBytes = sizeof (struct GC_weak);
-			skip = 0;
-		} else { /* Stack. */
-			GC_stack stack;
+                /* Compute the space taken by the header and object body. */
+                SPLIT_HEADER();
+                if (NORMAL_TAG == tag) { /* Fixed size object. */
+                        headerBytes = GC_NORMAL_HEADER_SIZE;
+                        objectBytes = toBytes (numPointers + numNonPointers);
+                        skip = 0;
+                } else if (ARRAY_TAG == tag) {
+                        headerBytes = GC_ARRAY_HEADER_SIZE;
+                        objectBytes = arrayNumBytes (s, p, numPointers,
+                                                        numNonPointers);
+                        skip = 0;
+                } else if (WEAK_TAG == tag) {
+                        headerBytes = GC_NORMAL_HEADER_SIZE;
+                        objectBytes = sizeof (struct GC_weak);
+                        skip = 0;
+                } else { /* Stack. */
+                        GC_stack stack;
 
-			assert (STACK_TAG == tag);
-			headerBytes = STACK_HEADER_SIZE;
-			stack = (GC_stack)p;
+                        assert (STACK_TAG == tag);
+                        headerBytes = STACK_HEADER_SIZE;
+                        stack = (GC_stack)p;
 
-			if (s->currentThread->stack == stack) {
-				/* Shrink stacks that don't use a lot 
-				 * of their reserved space;
-				 * but don't violate the stack invariant.
-				 */
-				if (stack->used <= stack->reserved / 4) {
-					uint new = stackReserved (s, max (stack->reserved / 2,
-										stackNeedsReserved (s, stack)));
-					/* It's possible that new > stack->reserved if
-					 * the stack invariant is violated. In that case, 
-					 * we want to leave the stack alone, because some 
-					 * other part of the gc will grow the stack.  We 
-					 * cannot do any growing here because we may run 
-					 * out of to space.
-					 */
-					if (new <= stack->reserved) {
-						stack->reserved = new;
-						if (DEBUG_STACKS)
-							fprintf (stderr, "Shrinking stack to size %s.\n",
-									uintToCommaString (stack->reserved));
-					}
-				}
-			} else {
-				/* Shrink heap stacks.
-				 */
-				stack->reserved = stackReserved (s, max(s->threadShrinkRatio * stack->reserved, 
-									stack->used));
-				if (DEBUG_STACKS)
-					fprintf (stderr, "Shrinking stack to size %s.\n",
-							uintToCommaString (stack->reserved));
-			}
-			objectBytes = sizeof (struct GC_stack) + stack->used;
-			skip = stack->reserved - stack->used;
-		}
-		size = headerBytes + objectBytes;
-		assert (s->back + size + skip <= s->toLimit);
-  		/* Copy the object. */
-		copy (p - headerBytes, s->back, size);
-		/* If the object has a valid weak pointer, link it into the weaks
-		 * for update after the copying GC is done.
-		 */
-		if (WEAK_TAG == tag and 1 == numPointers) {
-			GC_weak w;
+                        if (s->currentThread->stack == stack) {
+                                /* Shrink stacks that don't use a lot 
+                                 * of their reserved space;
+                                 * but don't violate the stack invariant.
+                                 */
+                                if (stack->used <= stack->reserved / 4) {
+                                        uint new = stackReserved (s, max (stack->reserved / 2,
+                                                                                stackNeedsReserved (s, stack)));
+                                        /* It's possible that new > stack->reserved if
+                                         * the stack invariant is violated. In that case, 
+                                         * we want to leave the stack alone, because some 
+                                         * other part of the gc will grow the stack.  We 
+                                         * cannot do any growing here because we may run 
+                                         * out of to space.
+                                         */
+                                        if (new <= stack->reserved) {
+                                                stack->reserved = new;
+                                                if (DEBUG_STACKS)
+                                                        fprintf (stderr, "Shrinking stack to size %s.\n",
+                                                                        uintToCommaString (stack->reserved));
+                                        }
+                                }
+                        } else {
+                                /* Shrink heap stacks.
+                                 */
+                                stack->reserved = stackReserved (s, max(s->threadShrinkRatio * stack->reserved, 
+                                                                        stack->used));
+                                if (DEBUG_STACKS)
+                                        fprintf (stderr, "Shrinking stack to size %s.\n",
+                                                        uintToCommaString (stack->reserved));
+                        }
+                        objectBytes = sizeof (struct GC_stack) + stack->used;
+                        skip = stack->reserved - stack->used;
+                }
+                size = headerBytes + objectBytes;
+                assert (s->back + size + skip <= s->toLimit);
+                /* Copy the object. */
+                copy (p - headerBytes, s->back, size);
+                /* If the object has a valid weak pointer, link it into the weaks
+                 * for update after the copying GC is done.
+                 */
+                if (WEAK_TAG == tag and 1 == numPointers) {
+                        GC_weak w;
 
-			w = (GC_weak)(s->back + GC_NORMAL_HEADER_SIZE);
-			if (DEBUG_WEAK)
-				fprintf (stderr, "forwarding weak 0x%08x ",
-						(uint)w);
-			if (GC_isPointer (w->object)
-				and (not s->amInMinorGC
-					or isInNursery (s, w->object))) {
-				if (DEBUG_WEAK)
-					fprintf (stderr, "linking\n");
-				w->link = s->weaks;
-				s->weaks = w;
-			} else {
-				if (DEBUG_WEAK)
-					fprintf (stderr, "not linking\n");
-			}
-		}
- 		/* Store the forwarding pointer in the old object. */
-		*(word*)(p - WORD_SIZE) = FORWARDED;
-		*(pointer*)p = s->back + headerBytes;
-		/* Update the back of the queue. */
-		s->back += size + skip;
-		assert (isAligned ((uint)s->back + GC_NORMAL_HEADER_SIZE,
-					s->alignment));
-	}
-	*pp = *(pointer*)p;
-	assert (isInToSpace (s, *pp));
+                        w = (GC_weak)(s->back + GC_NORMAL_HEADER_SIZE);
+                        if (DEBUG_WEAK)
+                                fprintf (stderr, "forwarding weak 0x%08x ",
+                                                (uint)w);
+                        if (GC_isPointer (w->object)
+                                and (not s->amInMinorGC
+                                        or isInNursery (s, w->object))) {
+                                if (DEBUG_WEAK)
+                                        fprintf (stderr, "linking\n");
+                                w->link = s->weaks;
+                                s->weaks = w;
+                        } else {
+                                if (DEBUG_WEAK)
+                                        fprintf (stderr, "not linking\n");
+                        }
+                }
+                /* Store the forwarding pointer in the old object. */
+                *(word*)(p - WORD_SIZE) = FORWARDED;
+                *(pointer*)p = s->back + headerBytes;
+                /* Update the back of the queue. */
+                s->back += size + skip;
+                assert (isAligned ((uint)s->back + GC_NORMAL_HEADER_SIZE,
+                                        s->alignment));
+        }
+        *pp = *(pointer*)p;
+        assert (isInToSpace (s, *pp));
 }
 
 static void updateWeaks (GC_state s) {
-	GC_weak w;
+        GC_weak w;
 
-	for (w = s->weaks; w != NULL; w = w->link) {
-		assert ((pointer)BOGUS_POINTER != w->object);
+        for (w = s->weaks; w != NULL; w = w->link) {
+                assert ((pointer)BOGUS_POINTER != w->object);
 
-		if (DEBUG_WEAK)
-			fprintf (stderr, "updateWeaks  w = 0x%08x  ", (uint)w);
-		if (FORWARDED == GC_getHeader ((pointer)w->object)) {
-			if (DEBUG_WEAK)
-				fprintf (stderr, "forwarded from 0x%08x to 0x%08x\n",
-						(uint)w->object,
-						(uint)*(pointer*)w->object);
-			w->object = *(pointer*)w->object;
-		} else {
-			if (DEBUG_WEAK)
-				fprintf (stderr, "cleared\n");
-			*(GC_getHeaderp((pointer)w)) = WEAK_GONE_HEADER;
-			w->object = (pointer)BOGUS_POINTER;
-		}
-	}
-	s->weaks = NULL;
+                if (DEBUG_WEAK)
+                        fprintf (stderr, "updateWeaks  w = 0x%08x  ", (uint)w);
+                if (FORWARDED == GC_getHeader ((pointer)w->object)) {
+                        if (DEBUG_WEAK)
+                                fprintf (stderr, "forwarded from 0x%08x to 0x%08x\n",
+                                                (uint)w->object,
+                                                (uint)*(pointer*)w->object);
+                        w->object = *(pointer*)w->object;
+                } else {
+                        if (DEBUG_WEAK)
+                                fprintf (stderr, "cleared\n");
+                        *(GC_getHeaderp((pointer)w)) = WEAK_GONE_HEADER;
+                        w->object = (pointer)BOGUS_POINTER;
+                }
+        }
+        s->weaks = NULL;
 }
 
 static void swapSemis (GC_state s) {
-	struct GC_heap h;
+        struct GC_heap h;
 
-	h = s->heap2;
-	s->heap2 = s->heap;
-	s->heap = h;
-	setCardMapForMutator (s);
+        h = s->heap2;
+        s->heap2 = s->heap;
+        s->heap = h;
+        setCardMapForMutator (s);
 }
 
 static inline bool detailedGCTime (GC_state s) {
-	return s->summary;
+        return s->summary;
 }
 
 static void cheneyCopy (GC_state s) {
-	struct rusage ru_start;
-	pointer toStart;
+        struct rusage ru_start;
+        pointer toStart;
 
-	assert (s->heap2.size >= s->oldGenSize);
-	if (detailedGCTime (s))
-		startTiming (&ru_start);
-	s->numCopyingGCs++;
-	s->toSpace = s->heap2.start;
-	s->toLimit = s->heap2.start + s->heap2.size;
- 	if (DEBUG or s->messages) {
-		fprintf (stderr, "Major copying GC.\n");
-	 	fprintf (stderr, "fromSpace = 0x%08x of size %s\n", 
-				(uint) s->heap.start,
-				uintToCommaString (s->heap.size));
-		fprintf (stderr, "toSpace = 0x%08x of size %s\n",
-				(uint) s->heap2.start,
-				uintToCommaString (s->heap2.size));
-	}
-	assert (s->heap2.start != (void*)NULL);
-	/* The next assert ensures there is enough space for the copy to succeed.
-	 * It does not assert (s->heap2.size >= s->heap.size) because that
+        assert (s->heap2.size >= s->oldGenSize);
+        if (detailedGCTime (s))
+                startTiming (&ru_start);
+        s->numCopyingGCs++;
+        s->toSpace = s->heap2.start;
+        s->toLimit = s->heap2.start + s->heap2.size;
+        if (DEBUG or s->messages) {
+                fprintf (stderr, "Major copying GC.\n");
+                fprintf (stderr, "fromSpace = 0x%08x of size %s\n", 
+                                (uint) s->heap.start,
+                                uintToCommaString (s->heap.size));
+                fprintf (stderr, "toSpace = 0x%08x of size %s\n",
+                                (uint) s->heap2.start,
+                                uintToCommaString (s->heap2.size));
+        }
+        assert (s->heap2.start != (void*)NULL);
+        /* The next assert ensures there is enough space for the copy to succeed.
+         * It does not assert (s->heap2.size >= s->heap.size) because that
          * is too strong.
-	 */
-	assert (s->heap2.size >= s->oldGenSize);
-	toStart = alignFrontier (s, s->heap2.start);
-	s->back = toStart;
-	foreachGlobal (s, forward);
-	foreachPointerInRange (s, toStart, &s->back, TRUE, forward);
-	updateWeaks (s);
-	s->oldGenSize = s->back - s->heap2.start;
-	s->bytesCopied += s->oldGenSize;
-	if (DEBUG)
-		fprintf (stderr, "%s bytes live.\n", 
-				uintToCommaString (s->oldGenSize));
-	swapSemis (s);
-	clearCrossMap (s);
-	s->lastMajor = GC_COPYING;
-	if (detailedGCTime (s))
-		stopTiming (&ru_start, &s->ru_gcCopy);		
- 	if (DEBUG or s->messages)
-		fprintf (stderr, "Major copying GC done.\n");
+         */
+        assert (s->heap2.size >= s->oldGenSize);
+        toStart = alignFrontier (s, s->heap2.start);
+        s->back = toStart;
+        foreachGlobal (s, forward);
+        foreachPointerInRange (s, toStart, &s->back, TRUE, forward);
+        updateWeaks (s);
+        s->oldGenSize = s->back - s->heap2.start;
+        s->bytesCopied += s->oldGenSize;
+        if (DEBUG)
+                fprintf (stderr, "%s bytes live.\n", 
+                                uintToCommaString (s->oldGenSize));
+        swapSemis (s);
+        clearCrossMap (s);
+        s->lastMajor = GC_COPYING;
+        if (detailedGCTime (s))
+                stopTiming (&ru_start, &s->ru_gcCopy);          
+        if (DEBUG or s->messages)
+                fprintf (stderr, "Major copying GC done.\n");
 }
 
 /* ---------------------------------------------------------------- */
@@ -1569,12 +1571,12 @@
 #if ASSERT
 
 static inline pointer crossMapCardStart (GC_state s, pointer p) {
-	/* The p - 1 is so that a pointer to the beginning of a card
-	 * falls into the index for the previous crossMap entry.
-	 */
-	return (p == s->heap.start)
-		? s->heap.start
-		: (p - 1) - ((uint)(p - 1) % s->cardSize);
+        /* The p - 1 is so that a pointer to the beginning of a card
+         * falls into the index for the previous crossMap entry.
+         */
+        return (p == s->heap.start)
+                ? s->heap.start
+                : (p - 1) - ((uint)(p - 1) % s->cardSize);
 }
 
 /* crossMapIsOK is a slower, but easier to understand, way of computing the
@@ -1584,252 +1586,252 @@
  * the incremental update is working correctly.
  */
 static bool crossMapIsOK (GC_state s) {
-	pointer back;
-	uint cardIndex;
-	pointer cardStart;
-	pointer front;
-	uint i;
-	static uchar *m;
+        pointer back;
+        uint cardIndex;
+        pointer cardStart;
+        pointer front;
+        uint i;
+        static uchar *m;
 
-	if (DEBUG)
-		fprintf (stderr, "crossMapIsOK ()\n");
-	m = smmap (s->crossMapSize);
-	memset (m, CROSS_MAP_EMPTY, s->crossMapSize);
-	back = s->heap.start + s->oldGenSize;
-	cardIndex = 0;
-	front = alignFrontier (s, s->heap.start);
+        if (DEBUG)
+                fprintf (stderr, "crossMapIsOK ()\n");
+        m = smmap (s->crossMapSize);
+        memset (m, CROSS_MAP_EMPTY, s->crossMapSize);
+        back = s->heap.start + s->oldGenSize;
+        cardIndex = 0;
+        front = alignFrontier (s, s->heap.start);
 loopObjects:
-	assert (front <= back);
-	cardStart = crossMapCardStart (s, front);
-	cardIndex = divCardSize (s, cardStart - s->heap.start);
-	m[cardIndex] = (front - cardStart) / WORD_SIZE;
-	if (front < back) {
-		front += objectSize (s, toData (s, front));
-		goto loopObjects;
-	}
-	for (i = 0; i < cardIndex; ++i)
-		assert (m[i] == s->crossMap[i]);
-	GC_release (m, s->crossMapSize);
-	return TRUE;
+        assert (front <= back);
+        cardStart = crossMapCardStart (s, front);
+        cardIndex = divCardSize (s, cardStart - s->heap.start);
+        m[cardIndex] = (front - cardStart) / WORD_SIZE;
+        if (front < back) {
+                front += objectSize (s, toData (s, front));
+                goto loopObjects;
+        }
+        for (i = 0; i < cardIndex; ++i)
+                assert (m[i] == s->crossMap[i]);
+        GC_release (m, s->crossMapSize);
+        return TRUE;
 }
 
 #endif /* ASSERT */
 
 static void updateCrossMap (GC_state s) {
-	GC_heap h;
-	pointer cardEnd;
-	uint cardIndex;
-	pointer cardStart;
-	pointer next;
-	pointer objectStart;
-	pointer oldGenEnd;
+        GC_heap h;
+        pointer cardEnd;
+        uint cardIndex;
+        pointer cardStart;
+        pointer next;
+        pointer objectStart;
+        pointer oldGenEnd;
 
-	h = &(s->heap);
-	if (s->crossMapValidSize == s->oldGenSize)
-		goto done;
-	oldGenEnd = h->start + s->oldGenSize;
-	objectStart = h->start + s->crossMapValidSize;
-	if (objectStart == h->start) {
-		cardIndex = 0;
-		objectStart = alignFrontier (s, objectStart);
-	} else
-		cardIndex = divCardSize (s, (uint)(objectStart - 1 - h->start));
-	cardStart = h->start + cardNumToSize (s, cardIndex);
-	cardEnd = cardStart + s->cardSize;
+        h = &(s->heap);
+        if (s->crossMapValidSize == s->oldGenSize)
+                goto done;
+        oldGenEnd = h->start + s->oldGenSize;
+        objectStart = h->start + s->crossMapValidSize;
+        if (objectStart == h->start) {
+                cardIndex = 0;
+                objectStart = alignFrontier (s, objectStart);
+        } else
+                cardIndex = divCardSize (s, (uint)(objectStart - 1 - h->start));
+        cardStart = h->start + cardNumToSize (s, cardIndex);
+        cardEnd = cardStart + s->cardSize;
 loopObjects:
-	assert (objectStart < oldGenEnd);
-	assert ((objectStart == h->start or cardStart < objectStart)
-			and objectStart <= cardEnd);
-	next = objectStart + objectSize (s, toData (s, objectStart));
-	if (next > cardEnd) {
-		/* We're about to move to a new card, so we are looking at the
-		 * last object boundary in the current card.  Store it in the 
-		 * crossMap.
-		 */
-		uint offset;
+        assert (objectStart < oldGenEnd);
+        assert ((objectStart == h->start or cardStart < objectStart)
+                        and objectStart <= cardEnd);
+        next = objectStart + objectSize (s, toData (s, objectStart));
+        if (next > cardEnd) {
+                /* We're about to move to a new card, so we are looking at the
+                 * last object boundary in the current card.  Store it in the 
+                 * crossMap.
+                 */
+                uint offset;
 
-		offset = (objectStart - cardStart) / WORD_SIZE;
-		assert (offset < CROSS_MAP_EMPTY);
-		if (DEBUG_GENERATIONAL)
-			fprintf (stderr, "crossMap[%u] = %u\n", 
-					cardIndex, offset);
-		s->crossMap[cardIndex] = offset;
-		cardIndex = divCardSize (s, next - 1 - h->start);
-		cardStart = h->start + cardNumToSize (s, cardIndex);
-		cardEnd = cardStart + s->cardSize;
-	}
-	objectStart = next;
-	if (objectStart < oldGenEnd) 
-		goto loopObjects;
-	assert (objectStart == oldGenEnd);
-	s->crossMap[cardIndex] = (oldGenEnd - cardStart) / WORD_SIZE;
-	s->crossMapValidSize = s->oldGenSize;
+                offset = (objectStart - cardStart) / WORD_SIZE;
+                assert (offset < CROSS_MAP_EMPTY);
+                if (DEBUG_GENERATIONAL)
+                        fprintf (stderr, "crossMap[%u] = %u\n", 
+                                        cardIndex, offset);
+                s->crossMap[cardIndex] = offset;
+                cardIndex = divCardSize (s, next - 1 - h->start);
+                cardStart = h->start + cardNumToSize (s, cardIndex);
+                cardEnd = cardStart + s->cardSize;
+        }
+        objectStart = next;
+        if (objectStart < oldGenEnd) 
+                goto loopObjects;
+        assert (objectStart == oldGenEnd);
+        s->crossMap[cardIndex] = (oldGenEnd - cardStart) / WORD_SIZE;
+        s->crossMapValidSize = s->oldGenSize;
 done:
-	assert (s->crossMapValidSize == s->oldGenSize);
-	assert (crossMapIsOK (s));
+        assert (s->crossMapValidSize == s->oldGenSize);
+        assert (crossMapIsOK (s));
 }
 
 static inline void forwardIfInNursery (GC_state s, pointer *pp) {
-	pointer p;
+        pointer p;
 
-	p = *pp;
-	if (p < s->nursery)
-		return;
-	if (DEBUG_GENERATIONAL)
-		fprintf (stderr, "intergenerational pointer from 0x%08x to 0x%08x\n",
-			(uint)pp, *(uint*)pp);
-	assert (s->nursery <= p and p < s->limitPlusSlop);
-	forward (s, pp);
+        p = *pp;
+        if (p < s->nursery)
+                return;
+        if (DEBUG_GENERATIONAL)
+                fprintf (stderr, "intergenerational pointer from 0x%08x to 0x%08x\n",
+                        (uint)pp, *(uint*)pp);
+        assert (s->nursery <= p and p < s->limitPlusSlop);
+        forward (s, pp);
 }
 
 
 /* Walk through all the cards and forward all intergenerational pointers. */
 static void forwardInterGenerationalPointers (GC_state s) {
-	pointer cardMap;
-	uint cardNum;
-	pointer cardStart;
-	uchar *crossMap;
-	GC_heap h;
-	uint numCards;
-	pointer objectStart;
-	pointer oldGenStart;
-	pointer oldGenEnd;
+        pointer cardMap;
+        uint cardNum;
+        pointer cardStart;
+        uchar *crossMap;
+        GC_heap h;
+        uint numCards;
+        pointer objectStart;
+        pointer oldGenStart;
+        pointer oldGenEnd;
 
-	if (DEBUG_GENERATIONAL)
-		fprintf (stderr, "Forwarding inter-generational pointers.\n");
-	updateCrossMap (s);
-	h = &s->heap;
-	/* Constants. */
-	cardMap = s->cardMap;
-	crossMap = s->crossMap;
-	numCards = divCardSize (s, align (s->oldGenSize, s->cardSize));
-	oldGenStart = s->heap.start;
-	oldGenEnd = oldGenStart + s->oldGenSize;
-	/* Loop variables*/
-	objectStart = alignFrontier (s, s->heap.start);
-	cardNum = 0;
-	cardStart = oldGenStart;
+        if (DEBUG_GENERATIONAL)
+                fprintf (stderr, "Forwarding inter-generational pointers.\n");
+        updateCrossMap (s);
+        h = &s->heap;
+        /* Constants. */
+        cardMap = s->cardMap;
+        crossMap = s->crossMap;
+        numCards = divCardSize (s, align (s->oldGenSize, s->cardSize));
+        oldGenStart = s->heap.start;
+        oldGenEnd = oldGenStart + s->oldGenSize;
+        /* Loop variables*/
+        objectStart = alignFrontier (s, s->heap.start);
+        cardNum = 0;
+        cardStart = oldGenStart;
 checkAll:
-	assert (cardNum <= numCards);
-	assert (isAlignedFrontier (s, objectStart));
-	if (cardNum == numCards)
-		goto done;
+        assert (cardNum <= numCards);
+        assert (isAlignedFrontier (s, objectStart));
+        if (cardNum == numCards)
+                goto done;
 checkCard:
-	if (DEBUG_GENERATIONAL)
-		fprintf (stderr, "checking card %u  objectStart = 0x%08x  cardEnd = 0x%08x\n",
-				cardNum, 
-				(uint)objectStart,
-				(uint)oldGenStart + cardNumToSize (s, cardNum + 1));
-	assert (objectStart < oldGenStart + cardNumToSize (s, cardNum + 1));
-	if (cardMap[cardNum]) {
-		pointer cardEnd;
-		pointer orig;
-		uint size;
+        if (DEBUG_GENERATIONAL)
+                fprintf (stderr, "checking card %u  objectStart = 0x%08x  cardEnd = 0x%08x\n",
+                                cardNum, 
+                                (uint)objectStart,
+                                (uint)oldGenStart + cardNumToSize (s, cardNum + 1));
+        assert (objectStart < oldGenStart + cardNumToSize (s, cardNum + 1));
+        if (cardMap[cardNum]) {
+                pointer cardEnd;
+                pointer orig;
+                uint size;
 
-		s->markedCards++;
-		if (DEBUG_GENERATIONAL)
-			fprintf (stderr, "card %u is marked  objectStart = 0x%08x\n", 
-					cardNum, (uint)objectStart);
-		orig = objectStart;
+                s->markedCards++;
+                if (DEBUG_GENERATIONAL)
+                        fprintf (stderr, "card %u is marked  objectStart = 0x%08x\n", 
+                                        cardNum, (uint)objectStart);
+                orig = objectStart;
 skipObjects:
-		assert (isAlignedFrontier (s, objectStart));
-		size = objectSize (s, toData (s, objectStart));
-		if (objectStart + size < cardStart) {
-			objectStart += size;
-			goto skipObjects;
-		}
-		s->minorBytesSkipped += objectStart - orig;
-		cardEnd = cardStart + s->cardSize;
-		if (oldGenEnd < cardEnd) 
-			cardEnd = oldGenEnd;
-		assert (objectStart < cardEnd);
-		orig = objectStart;
-		/* If we ever add Weak.set, then there could be intergenerational
-		 * weak pointers, in which case we would need to link the weak
-		 * objects into s->weaks.  But for now, since there is no 
-		 * Weak.set, the foreachPointerInRange will do the right thing
-		 * on weaks, since the weak pointer will never be into the 
-		 * nursery.
-		 */
-		objectStart = 
-			foreachPointerInRange (s, objectStart, &cardEnd, FALSE,
-						forwardIfInNursery);
-		s->minorBytesScanned += objectStart - orig;
-		if (objectStart == oldGenEnd)
-			goto done;
-		cardNum = divCardSize (s, objectStart - oldGenStart);
-		cardStart = oldGenStart + cardNumToSize (s, cardNum);
-		goto checkCard;
-	} else {
-		unless (CROSS_MAP_EMPTY == crossMap[cardNum])
-			objectStart = cardStart + crossMap[cardNum] * WORD_SIZE;
-		if (DEBUG_GENERATIONAL)
-			fprintf (stderr, "card %u is not marked  crossMap[%u] == %u  objectStart = 0x%08x\n", 
-					cardNum,
-					cardNum, 
-					crossMap[cardNum] * WORD_SIZE,
-					(uint)objectStart);
-		cardNum++;
-		cardStart += s->cardSize;
-		goto checkAll;
-	}
-	assert (FALSE);
+                assert (isAlignedFrontier (s, objectStart));
+                size = objectSize (s, toData (s, objectStart));
+                if (objectStart + size < cardStart) {
+                        objectStart += size;
+                        goto skipObjects;
+                }
+                s->minorBytesSkipped += objectStart - orig;
+                cardEnd = cardStart + s->cardSize;
+                if (oldGenEnd < cardEnd) 
+                        cardEnd = oldGenEnd;
+                assert (objectStart < cardEnd);
+                orig = objectStart;
+                /* If we ever add Weak.set, then there could be intergenerational
+                 * weak pointers, in which case we would need to link the weak
+                 * objects into s->weaks.  But for now, since there is no 
+                 * Weak.set, the foreachPointerInRange will do the right thing
+                 * on weaks, since the weak pointer will never be into the 
+                 * nursery.
+                 */
+                objectStart = 
+                        foreachPointerInRange (s, objectStart, &cardEnd, FALSE,
+                                                forwardIfInNursery);
+                s->minorBytesScanned += objectStart - orig;
+                if (objectStart == oldGenEnd)
+                        goto done;
+                cardNum = divCardSize (s, objectStart - oldGenStart);
+                cardStart = oldGenStart + cardNumToSize (s, cardNum);
+                goto checkCard;
+        } else {
+                unless (CROSS_MAP_EMPTY == crossMap[cardNum])
+                        objectStart = cardStart + crossMap[cardNum] * WORD_SIZE;
+                if (DEBUG_GENERATIONAL)
+                        fprintf (stderr, "card %u is not marked  crossMap[%u] == %u  objectStart = 0x%08x\n", 
+                                        cardNum,
+                                        cardNum, 
+                                        crossMap[cardNum] * WORD_SIZE,
+                                        (uint)objectStart);
+                cardNum++;
+                cardStart += s->cardSize;
+                goto checkAll;
+        }
+        assert (FALSE);
 done:
-	if (DEBUG_GENERATIONAL)
-		fprintf (stderr, "Forwarding inter-generational pointers done.\n");
+        if (DEBUG_GENERATIONAL)
+                fprintf (stderr, "Forwarding inter-generational pointers done.\n");
 }
 
 static void minorGC (GC_state s) {
-	W32 bytesAllocated;
-	W32 bytesCopied;
-	struct rusage ru_start;
+        W32 bytesAllocated;
+        W32 bytesCopied;
+        struct rusage ru_start;
 
-	if (DEBUG_GENERATIONAL)
-		fprintf (stderr, "minorGC  nursery = 0x%08x  frontier = 0x%08x\n", 
-				(uint)s->nursery,
-				(uint)s->frontier);
-	assert (invariant (s));
-	bytesAllocated = s->frontier - s->nursery;
-	if (bytesAllocated == 0)
-		return;
- 	s->bytesAllocated += bytesAllocated;
-	if (not s->canMinor) {
-		s->oldGenSize += bytesAllocated;
-		bytesCopied = 0;
-	} else {
-		if (DEBUG_GENERATIONAL or s->messages)
-			fprintf (stderr, "Minor GC.\n");
-		if (detailedGCTime (s))
-			startTiming (&ru_start);
-		s->amInMinorGC = TRUE;
-		s->toSpace = s->heap.start + s->oldGenSize;
-		if (DEBUG_GENERATIONAL)
-			fprintf (stderr, "toSpace = 0x%08x\n",
-					(uint)s->toSpace);
-		assert (isAlignedFrontier (s, s->toSpace));
-		s->toLimit = s->toSpace + bytesAllocated;
-		assert (invariant (s));
-		s->numMinorGCs++;
-		s->numMinorsSinceLastMajor++;
-		s->back = s->toSpace;
-		/* Forward all globals.  Would like to avoid doing this once all
-	 	 * the globals have been assigned.
-		 */
-		foreachGlobal (s, forwardIfInNursery);
-		forwardInterGenerationalPointers (s);
-		foreachPointerInRange (s, s->toSpace, &s->back, TRUE,
-					forwardIfInNursery);
-		updateWeaks (s);
-		bytesCopied = s->back - s->toSpace;
-		s->bytesCopiedMinor += bytesCopied;
-		s->oldGenSize += bytesCopied;
-		s->amInMinorGC = FALSE;
-		if (detailedGCTime (s))
-			stopTiming (&ru_start, &s->ru_gcMinor);
-		if (DEBUG_GENERATIONAL or s->messages)
-			fprintf (stderr, "Minor GC done.  %s bytes copied.\n",
-					uintToCommaString (bytesCopied));
-	}
+        if (DEBUG_GENERATIONAL)
+                fprintf (stderr, "minorGC  nursery = 0x%08x  frontier = 0x%08x\n", 
+                                (uint)s->nursery,
+                                (uint)s->frontier);
+        assert (invariant (s));
+        bytesAllocated = s->frontier - s->nursery;
+        if (bytesAllocated == 0)
+                return;
+        s->bytesAllocated += bytesAllocated;
+        if (not s->canMinor) {
+                s->oldGenSize += bytesAllocated;
+                bytesCopied = 0;
+        } else {
+                if (DEBUG_GENERATIONAL or s->messages)
+                        fprintf (stderr, "Minor GC.\n");
+                if (detailedGCTime (s))
+                        startTiming (&ru_start);
+                s->amInMinorGC = TRUE;
+                s->toSpace = s->heap.start + s->oldGenSize;
+                if (DEBUG_GENERATIONAL)
+                        fprintf (stderr, "toSpace = 0x%08x\n",
+                                        (uint)s->toSpace);
+                assert (isAlignedFrontier (s, s->toSpace));
+                s->toLimit = s->toSpace + bytesAllocated;
+                assert (invariant (s));
+                s->numMinorGCs++;
+                s->numMinorsSinceLastMajor++;
+                s->back = s->toSpace;
+                /* Forward all globals.  Would like to avoid doing this once all
+                 * the globals have been assigned.
+                 */
+                foreachGlobal (s, forwardIfInNursery);
+                forwardInterGenerationalPointers (s);
+                foreachPointerInRange (s, s->toSpace, &s->back, TRUE,
+                                        forwardIfInNursery);
+                updateWeaks (s);
+                bytesCopied = s->back - s->toSpace;
+                s->bytesCopiedMinor += bytesCopied;
+                s->oldGenSize += bytesCopied;
+                s->amInMinorGC = FALSE;
+                if (detailedGCTime (s))
+                        stopTiming (&ru_start, &s->ru_gcMinor);
+                if (DEBUG_GENERATIONAL or s->messages)
+                        fprintf (stderr, "Minor GC done.  %s bytes copied.\n",
+                                        uintToCommaString (bytesCopied));
+        }
 }
 
 /* ---------------------------------------------------------------- */
@@ -1852,255 +1854,255 @@
  */
 
 static GC_ObjectHashTable newTable (GC_state s) {
-	int i;
-	uint maxElementsSize;
-	pointer regionStart;
-	pointer regionEnd;
-	GC_ObjectHashTable t;
+        int i;
+        uint maxElementsSize;
+        pointer regionStart;
+        pointer regionEnd;
+        GC_ObjectHashTable t;
 
-	NEW (GC_ObjectHashTable, t);
-	// Try to use space in the heap for the elements.
-	if (not (heapIsInit (&s->heap2))) {
-		if (DEBUG_SHARE)
-			fprintf (stderr, "using heap2\n");
-		// We have all of heap2 available.  Use it.
-		regionStart = s->heap2.start;
-		regionEnd = s->heap2.start + s->heap2.size;
-	} else if (s->amInGC or not s->canMinor) {
-		if (DEBUG_SHARE)
-			fprintf (stderr, "using end of heap\n");
-		regionStart = s->frontier;
-		regionEnd = s->limitPlusSlop;
-	} else {
-		if (DEBUG_SHARE)
-			fprintf (stderr, "using minor space\n");
-		// Use the space available for a minor GC.
-		assert (s->canMinor);
-		regionStart = s->heap.start + s->oldGenSize;
-		regionEnd = s->nursery;
-	}
-	maxElementsSize = (regionEnd - regionStart) / sizeof (*(t->elements));
-	if (DEBUG_SHARE)
-		fprintf (stderr, "maxElementsSize = %u\n", maxElementsSize);
-	t->elementsSize = 64;  // some small power of two
-	t->log2ElementsSize = 6;  // and its log base 2
-	if (maxElementsSize < t->elementsSize) {
-		if (DEBUG_SHARE)
-			fprintf (stderr, "too small -- using malloc\n");
-		t->elementsIsInHeap = FALSE;
-		ARRAY (struct GC_ObjectHashElement *, t->elements, t->elementsSize);
-	} else {
-		t->elementsIsInHeap = TRUE;
-		t->elements = (struct GC_ObjectHashElement*)regionStart;
-		// Find the largest power of two that fits.
-		for (; t->elementsSize <= maxElementsSize; 
-			t->elementsSize <<= 1, t->log2ElementsSize++)
-			; // nothing
-		t->elementsSize >>= 1;
-		t->log2ElementsSize--;
-		assert (t->elementsSize <= maxElementsSize);
-		for (i = 0; i < t->elementsSize; ++i)
-			t->elements[i].object = NULL;
-	}
-	t->numElements = 0;
-	t->mayInsert = TRUE;
-	if (DEBUG_SHARE) {
-		fprintf (stderr, "elementsIsInHeap = %s\n", 
-				boolToString (t->elementsIsInHeap));
-		fprintf (stderr, "elementsSize = %u\n", t->elementsSize);
-		fprintf (stderr, "0x%08x = newTable ()\n", (uint)t);
-	}
-	return t;
+        NEW (GC_ObjectHashTable, t);
+        // Try to use space in the heap for the elements.
+        if (not (heapIsInit (&s->heap2))) {
+                if (DEBUG_SHARE)
+                        fprintf (stderr, "using heap2\n");
+                // We have all of heap2 available.  Use it.
+                regionStart = s->heap2.start;
+                regionEnd = s->heap2.start + s->heap2.size;
+        } else if (s->amInGC or not s->canMinor) {
+                if (DEBUG_SHARE)
+                        fprintf (stderr, "using end of heap\n");
+                regionStart = s->frontier;
+                regionEnd = s->limitPlusSlop;
+        } else {
+                if (DEBUG_SHARE)
+                        fprintf (stderr, "using minor space\n");
+                // Use the space available for a minor GC.
+                assert (s->canMinor);
+                regionStart = s->heap.start + s->oldGenSize;
+                regionEnd = s->nursery;
+        }
+        maxElementsSize = (regionEnd - regionStart) / sizeof (*(t->elements));
+        if (DEBUG_SHARE)
+                fprintf (stderr, "maxElementsSize = %u\n", maxElementsSize);
+        t->elementsSize = 64;  // some small power of two
+        t->log2ElementsSize = 6;  // and its log base 2
+        if (maxElementsSize < t->elementsSize) {
+                if (DEBUG_SHARE)
+                        fprintf (stderr, "too small -- using malloc\n");
+                t->elementsIsInHeap = FALSE;
+                ARRAY (struct GC_ObjectHashElement *, t->elements, t->elementsSize);
+        } else {
+                t->elementsIsInHeap = TRUE;
+                t->elements = (struct GC_ObjectHashElement*)regionStart;
+                // Find the largest power of two that fits.
+                for (; t->elementsSize <= maxElementsSize; 
+                        t->elementsSize <<= 1, t->log2ElementsSize++)
+                        ; // nothing
+                t->elementsSize >>= 1;
+                t->log2ElementsSize--;
+                assert (t->elementsSize <= maxElementsSize);
+                for (i = 0; i < t->elementsSize; ++i)
+                        t->elements[i].object = NULL;
+        }
+        t->numElements = 0;
+        t->mayInsert = TRUE;
+        if (DEBUG_SHARE) {
+                fprintf (stderr, "elementsIsInHeap = %s\n", 
+                                boolToString (t->elementsIsInHeap));
+                fprintf (stderr, "elementsSize = %u\n", t->elementsSize);
+                fprintf (stderr, "0x%08x = newTable ()\n", (uint)t);
+        }
+        return t;
 }
 
 static void destroyTable (GC_ObjectHashTable t) {
-	unless (t->elementsIsInHeap)
-		free (t->elements);
-	free (t);
+        unless (t->elementsIsInHeap)
+                free (t->elements);
+        free (t);
 }
 
 static inline Pointer tableInsert 
-	(GC_state s, GC_ObjectHashTable t, W32 hash, Pointer object, 
-		Bool mightBeThere, Header header, W32 tag, Pointer max) {
-	GC_ObjectHashElement e;
-	Header header2;
-	static Bool init = FALSE;
-	static int maxNumProbes = 0;
-	static W64 mult; // magic multiplier for hashing
-	int numProbes;
-	W32 probe;
-	word *p;
-	word *p2;
-	W32 slot; // slot in hash table we are considering
+        (GC_state s, GC_ObjectHashTable t, W32 hash, Pointer object, 
+                Bool mightBeThere, Header header, W32 tag, Pointer max) {
+        GC_ObjectHashElement e;
+        Header header2;
+        static Bool init = FALSE;
+        static int maxNumProbes = 0;
+        static W64 mult; // magic multiplier for hashing
+        int numProbes;
+        W32 probe;
+        word *p;
+        word *p2;
+        W32 slot; // slot in hash table we are considering
 
-	if (DEBUG_SHARE)
-		fprintf (stderr, "tableInsert (%u, 0x%08x, %s, 0x%08x, 0x%08x)\n",
-				(uint)hash, (uint)object, 
-				boolToString (mightBeThere),
-				(uint)header, (uint)max);
-	if (! init) {
-		init = TRUE;
-		mult = floor (((sqrt (5.0) - 1.0) / 2.0)
-				* (double)0x100000000llu);
-	}
-	slot = (W32)(mult * (W64)hash) >> (32 - t->log2ElementsSize);
-	probe = (1 == slot % 2) ? slot : slot - 1;
-	if (DEBUG_SHARE)
-		fprintf (stderr, "probe = 0x%08x\n", (uint)probe);
-	assert (1 == probe % 2);
-	numProbes = 0;
+        if (DEBUG_SHARE)
+                fprintf (stderr, "tableInsert (%u, 0x%08x, %s, 0x%08x, 0x%08x)\n",
+                                (uint)hash, (uint)object, 
+                                boolToString (mightBeThere),
+                                (uint)header, (uint)max);
+        if (! init) {
+                init = TRUE;
+                mult = floor (((sqrt (5.0) - 1.0) / 2.0)
+                                * (double)0x100000000llu);
+        }
+        slot = (W32)(mult * (W64)hash) >> (32 - t->log2ElementsSize);
+        probe = (1 == slot % 2) ? slot : slot - 1;
+        if (DEBUG_SHARE)
+                fprintf (stderr, "probe = 0x%08x\n", (uint)probe);
+        assert (1 == probe % 2);
+        numProbes = 0;
 look:
-	if (DEBUG_SHARE)
-		fprintf (stderr, "slot = 0x%08x\n", (uint)slot);
-	assert (0 <= slot and slot < t->elementsSize);
-	numProbes++;
-	e = &t->elements[slot];
-	if (NULL == e->object) {
-		/* It's not in the table.  Add it. */
-		unless (t->mayInsert) {
-			if (DEBUG_SHARE)
-				fprintf (stderr, "not inserting\n");
-			return object;
-		}
-		e->hash = hash;
-		e->object = object;
-		t->numElements++;
-		if (numProbes > maxNumProbes) {
-			maxNumProbes = numProbes;
-			if (DEBUG_SHARE)
-				fprintf (stderr, "numProbes = %d\n", numProbes);
-		}
-		return object;
-	}
-	unless (hash == e->hash) {
+        if (DEBUG_SHARE)
+                fprintf (stderr, "slot = 0x%08x\n", (uint)slot);
+        assert (0 <= slot and slot < t->elementsSize);
+        numProbes++;
+        e = &t->elements[slot];
+        if (NULL == e->object) {
+                /* It's not in the table.  Add it. */
+                unless (t->mayInsert) {
+                        if (DEBUG_SHARE)
+                                fprintf (stderr, "not inserting\n");
+                        return object;
+                }
+                e->hash = hash;
+                e->object = object;
+                t->numElements++;
+                if (numProbes > maxNumProbes) {
+                        maxNumProbes = numProbes;
+                        if (DEBUG_SHARE)
+                                fprintf (stderr, "numProbes = %d\n", numProbes);
+                }
+                return object;
+        }
+        unless (hash == e->hash) {
 lookNext:
-		slot = (slot + probe) % t->elementsSize;
-		goto look;
-	}
-	unless (mightBeThere)
-		goto lookNext;
-	if (DEBUG_SHARE)
-		fprintf (stderr, "comparing 0x%08x to 0x%08x\n",
-				(uint)object, (uint)e->object);
-	/* Compare object to e->object. */
-	unless (object == e->object) {
-		header2 = GC_getHeader (e->object);
-		unless (header == header2)
-			goto lookNext;
-		for (p = (word*)object, p2 = (word*)e->object; 
-				p < (word*)max; 
-				++p, ++p2)
-			unless (*p == *p2)
-				goto lookNext;
-		if (ARRAY_TAG == tag
-			and (GC_arrayNumElements (object)
-				!= GC_arrayNumElements (e->object)))
-			goto lookNext;
-	}
-	/* object is equal to e->object. */
-	return e->object;
+                slot = (slot + probe) % t->elementsSize;
+                goto look;
+        }
+        unless (mightBeThere)
+                goto lookNext;
+        if (DEBUG_SHARE)
+                fprintf (stderr, "comparing 0x%08x to 0x%08x\n",
+                                (uint)object, (uint)e->object);
+        /* Compare object to e->object. */
+        unless (object == e->object) {
+                header2 = GC_getHeader (e->object);
+                unless (header == header2)
+                        goto lookNext;
+                for (p = (word*)object, p2 = (word*)e->object; 
+                                p < (word*)max; 
+                                ++p, ++p2)
+                        unless (*p == *p2)
+                                goto lookNext;
+                if (ARRAY_TAG == tag
+                        and (GC_arrayNumElements (object)
+                                != GC_arrayNumElements (e->object)))
+                        goto lookNext;
+        }
+        /* object is equal to e->object. */
+        return e->object;
 }
 
-static void maybeGrowTable (GC_state s, GC_ObjectHashTable t) {	
-	int i;
-	GC_ObjectHashElement oldElement;
-	struct GC_ObjectHashElement *oldElements;
-	uint oldSize;
-	uint newSize;
+static void maybeGrowTable (GC_state s, GC_ObjectHashTable t) { 
+        int i;
+        GC_ObjectHashElement oldElement;
+        struct GC_ObjectHashElement *oldElements;
+        uint oldSize;
+        uint newSize;
 
-	if (not t->mayInsert or t->numElements * 2 <= t->elementsSize)
-		return;
-	oldElements = t->elements;
-	oldSize = t->elementsSize;
-	newSize = oldSize * 2;
-	if (DEBUG_SHARE)
-		fprintf (stderr, "trying to grow table to size %d\n", newSize);
-	// Try to alocate the new table.
-	ARRAY_UNSAFE (struct GC_ObjectHashElement *, t->elements, newSize);
-	if (NULL == t->elements) {
-		t->mayInsert = FALSE;
-		t->elements = oldElements;
-		if (DEBUG_SHARE)
-			fprintf (stderr, "unable to grow table\n");
-		return;
-	}
-	t->elementsSize = newSize;
-	t->log2ElementsSize++;
-	for (i = 0; i < oldSize; ++i) {
-		oldElement = &oldElements[i];
-		unless (NULL == oldElement->object)
-			tableInsert (s, t, oldElement->hash, oldElement->object,
-					FALSE, 0, 0, 0);
-	}
-	if (t->elementsIsInHeap)
-		t->elementsIsInHeap = FALSE;
-	else
-		free (oldElements);
-	if (DEBUG_SHARE)
-		fprintf (stderr, "done growing table\n");
+        if (not t->mayInsert or t->numElements * 2 <= t->elementsSize)
+                return;
+        oldElements = t->elements;
+        oldSize = t->elementsSize;
+        newSize = oldSize * 2;
+        if (DEBUG_SHARE)
+                fprintf (stderr, "trying to grow table to size %d\n", newSize);
+        // Try to alocate the new table.
+        ARRAY_UNSAFE (struct GC_ObjectHashElement *, t->elements, newSize);
+        if (NULL == t->elements) {
+                t->mayInsert = FALSE;
+                t->elements = oldElements;
+                if (DEBUG_SHARE)
+                        fprintf (stderr, "unable to grow table\n");
+                return;
+        }
+        t->elementsSize = newSize;
+        t->log2ElementsSize++;
+        for (i = 0; i < oldSize; ++i) {
+                oldElement = &oldElements[i];
+                unless (NULL == oldElement->object)
+                        tableInsert (s, t, oldElement->hash, oldElement->object,
+                                        FALSE, 0, 0, 0);
+        }
+        if (t->elementsIsInHeap)
+                t->elementsIsInHeap = FALSE;
+        else
+                free (oldElements);
+        if (DEBUG_SHARE)
+                fprintf (stderr, "done growing table\n");
 }
 
 static Pointer hashCons (GC_state s, Pointer object, Bool countBytesHashConsed) {
-	Bool hasIdentity;
-	Word32 hash;
-	Header header;
-	pointer max;
-	uint numNonPointers;
-	uint numPointers;
-	word *p;
-	Pointer res;
-	GC_ObjectHashTable t;
-	uint tag;
+        Bool hasIdentity;
+        Word32 hash;
+        Header header;
+        pointer max;
+        uint numNonPointers;
+        uint numPointers;
+        word *p;
+        Pointer res;
+        GC_ObjectHashTable t;
+        uint tag;
 
-	if (DEBUG_SHARE)
-		fprintf (stderr, "hashCons (0x%08x)\n", (uint)object);
-	t = s->objectHashTable;
-	header = GC_getHeader (object);
-	SPLIT_HEADER ();
-	if (hasIdentity) {
-		/* Don't hash cons. */
-		res = object;
-		goto done;
-	}
-	assert (ARRAY_TAG == tag or NORMAL_TAG == tag);
-	max = object
-		+ (ARRAY_TAG == tag
-			? arrayNumBytes (s, object,
-						numPointers, numNonPointers)
-			: toBytes (numPointers + numNonPointers));
-	// Compute the hash.
-	hash = header;
-	for (p = (word*)object; p < (word*)max; ++p)
-		hash = hash * 31 + *p;
-	/* Insert into table. */
-       	res = tableInsert (s, t, hash, object, TRUE, header, tag, (Pointer)max);
-	maybeGrowTable (s, t);
-	if (countBytesHashConsed and res != object) {
-		uint amount;
+        if (DEBUG_SHARE)
+                fprintf (stderr, "hashCons (0x%08x)\n", (uint)object);
+        t = s->objectHashTable;
+        header = GC_getHeader (object);
+        SPLIT_HEADER ();
+        if (hasIdentity) {
+                /* Don't hash cons. */
+                res = object;
+                goto done;
+        }
+        assert (ARRAY_TAG == tag or NORMAL_TAG == tag);
+        max = object
+                + (ARRAY_TAG == tag
+                        ? arrayNumBytes (s, object,
+                                                numPointers, numNonPointers)
+                        : toBytes (numPointers + numNonPointers));
+        // Compute the hash.
+        hash = header;
+        for (p = (word*)object; p < (word*)max; ++p)
+                hash = hash * 31 + *p;
+        /* Insert into table. */
+        res = tableInsert (s, t, hash, object, TRUE, header, tag, (Pointer)max);
+        maybeGrowTable (s, t);
+        if (countBytesHashConsed and res != object) {
+                uint amount;
 
-		amount = max - object;
-		if (ARRAY_TAG == tag)
-			amount += GC_ARRAY_HEADER_SIZE;
-		else
-			amount += GC_NORMAL_HEADER_SIZE;
-		s->bytesHashConsed += amount;
-	}
+                amount = max - object;
+                if (ARRAY_TAG == tag)
+                        amount += GC_ARRAY_HEADER_SIZE;
+                else
+                        amount += GC_NORMAL_HEADER_SIZE;
+                s->bytesHashConsed += amount;
+        }
 done:
-	if (DEBUG_SHARE)
-		fprintf (stderr, "0x%08x = hashCons (0x%08x)\n", 
-				(uint)res, (uint)object);
-	return res;
+        if (DEBUG_SHARE)
+                fprintf (stderr, "0x%08x = hashCons (0x%08x)\n", 
+                                (uint)res, (uint)object);
+        return res;
 }
 
 static inline void maybeSharePointer (GC_state s,
-					Pointer *pp, 
-					Bool shouldHashCons) {
-	unless (shouldHashCons)
-		return;
-	if (DEBUG_SHARE)
-		fprintf (stderr, "maybeSharePointer  pp = 0x%08x  *pp = 0x%08x\n",
-				(uint)pp, (uint)*pp);
-	*pp = hashCons (s, *pp, FALSE);	
+                                        Pointer *pp, 
+                                        Bool shouldHashCons) {
+        unless (shouldHashCons)
+                return;
+        if (DEBUG_SHARE)
+                fprintf (stderr, "maybeSharePointer  pp = 0x%08x  *pp = 0x%08x\n",
+                                (uint)pp, (uint)*pp);
+        *pp = hashCons (s, *pp, FALSE); 
 }
 
 /* ---------------------------------------------------------------- */
@@ -2108,19 +2110,19 @@
 /* ---------------------------------------------------------------- */
 
 static inline uint *arrayCounterp (pointer a) {
-	return ((uint*)a - 3);
+        return ((uint*)a - 3);
 }
 
 static inline uint arrayCounter (pointer a) {
-	return *(arrayCounterp (a));
+        return *(arrayCounterp (a));
 }
 
 static inline bool isMarked (pointer p) {
-	return MARK_MASK & GC_getHeader (p);
+        return MARK_MASK & GC_getHeader (p);
 }
 
 static bool modeEqMark (MarkMode m, pointer p) {
-	return (MARK_MODE == m) ? isMarked (p): not isMarked (p);
+        return (MARK_MODE == m) ? isMarked (p): not isMarked (p);
 }
 
 /* mark (s, p, m) sets all the mark bits in the object graph pointed to by p. 
@@ -2130,297 +2132,297 @@
  * It returns the total size in bytes of the objects marked.
  */
 W32 mark (GC_state s, pointer root, MarkMode mode, Bool shouldHashCons) {
-	uint arrayIndex;
-	pointer cur;  /* The current object being marked. */
-	GC_offsets frameOffsets;
-	Bool hasIdentity;
-	Header* headerp;
-	Header header;
-	uint index; /* The i'th pointer in the object (element) being marked. */
-	GC_frameLayout *layout;
-	Header mark; /* Used to set or clear the mark bit. */
-	pointer next; /* The next object to mark. */
-	Header *nextHeaderp;
-	Header nextHeader;
-	uint numNonPointers;
-	uint numPointers;
-	pointer prev; /* The previous object on the mark stack. */
-	W32 size; /* Total number of bytes marked. */
-	uint tag;
-	pointer todo; /* A pointer to the pointer in cur to next. */
-	pointer top; /* The top of the next stack frame to mark. */
+        uint arrayIndex;
+        pointer cur;  /* The current object being marked. */
+        GC_offsets frameOffsets;
+        Bool hasIdentity;
+        Header* headerp;
+        Header header;
+        uint index; /* The i'th pointer in the object (element) being marked. */
+        GC_frameLayout *layout;
+        Header mark; /* Used to set or clear the mark bit. */
+        pointer next; /* The next object to mark. */
+        Header *nextHeaderp;
+        Header nextHeader;
+        uint numNonPointers;
+        uint numPointers;
+        pointer prev; /* The previous object on the mark stack. */
+        W32 size; /* Total number of bytes marked. */
+        uint tag;
+        pointer todo; /* A pointer to the pointer in cur to next. */
+        pointer top; /* The top of the next stack frame to mark. */
 
-	if (modeEqMark (mode, root))
-		/* Object has already been marked. */
-		return 0;
-	mark = (MARK_MODE == mode) ? MARK_MASK : 0;
-	size = 0;
-	cur = root;
-	prev = NULL;
-	headerp = GC_getHeaderp (cur);
-	header = *(Header*)headerp;
-	goto mark;	
+        if (modeEqMark (mode, root))
+                /* Object has already been marked. */
+                return 0;
+        mark = (MARK_MODE == mode) ? MARK_MASK : 0;
+        size = 0;
+        cur = root;
+        prev = NULL;
+        headerp = GC_getHeaderp (cur);
+        header = *(Header*)headerp;
+        goto mark;      
 markNext:
-	/* cur is the object that was being marked.
-	 * prev is the mark stack.
-	 * next is the unmarked object to be marked.
-	 * nextHeaderp points to the header of next.
-	 * nextHeader is the header of next.
-	 * todo is a pointer to the pointer inside cur that points to next.
-	 */
-	if (DEBUG_MARK_COMPACT)
-		fprintf (stderr, "markNext  cur = 0x%08x  next = 0x%08x  prev = 0x%08x  todo = 0x%08x\n",
-				(uint)cur, (uint)next, (uint)prev, (uint)todo);
-	assert (not modeEqMark (mode, next));
-	assert (nextHeaderp == GC_getHeaderp (next));
-	assert (nextHeader == GC_getHeader (next));
-	assert (*(pointer*) todo == next);
-	headerp = nextHeaderp;
-	header = nextHeader;
-	*(pointer*)todo = prev;
-	prev = cur;
-	cur = next;
+        /* cur is the object that was being marked.
+         * prev is the mark stack.
+         * next is the unmarked object to be marked.
+         * nextHeaderp points to the header of next.
+         * nextHeader is the header of next.
+         * todo is a pointer to the pointer inside cur that points to next.
+         */
+        if (DEBUG_MARK_COMPACT)
+                fprintf (stderr, "markNext  cur = 0x%08x  next = 0x%08x  prev = 0x%08x  todo = 0x%08x\n",
+                                (uint)cur, (uint)next, (uint)prev, (uint)todo);
+        assert (not modeEqMark (mode, next));
+        assert (nextHeaderp == GC_getHeaderp (next));
+        assert (nextHeader == GC_getHeader (next));
+        assert (*(pointer*) todo == next);
+        headerp = nextHeaderp;
+        header = nextHeader;
+        *(pointer*)todo = prev;
+        prev = cur;
+        cur = next;
 mark:
-	if (DEBUG_MARK_COMPACT)
-		fprintf (stderr, "mark  cur = 0x%08x  prev = 0x%08x  mode = %s\n",
-				(uint)cur, (uint)prev,
-				(mode == MARK_MODE) ? "mark" : "unmark");
-	/* cur is the object to mark. 
-	 * prev is the mark stack.
-	 * headerp points to the header of cur.
-	 * header is the header of cur.
-	 */
-	assert (not modeEqMark (mode, cur));
-	assert (header == GC_getHeader (cur));
-	assert (headerp == GC_getHeaderp (cur));
-	header ^= 0x80000000;
-	/* Store the mark.  In the case of an object that contains a pointer to
-	 * itself, it is essential that we store the marked header before marking
-	 * the internal pointers (markInNormal below).  If we didn't, then we
-	 * would see the object as unmarked and traverse it again.
+        if (DEBUG_MARK_COMPACT)
+                fprintf (stderr, "mark  cur = 0x%08x  prev = 0x%08x  mode = %s\n",
+                                (uint)cur, (uint)prev,
+                                (mode == MARK_MODE) ? "mark" : "unmark");
+        /* cur is the object to mark. 
+         * prev is the mark stack.
+         * headerp points to the header of cur.
+         * header is the header of cur.
          */
-	*headerp = header;
-	SPLIT_HEADER();
-	if (NORMAL_TAG == tag) {
-		if (0 == numPointers) {
-			/* There is nothing to mark. */
-			size += GC_NORMAL_HEADER_SIZE + toBytes (numNonPointers);
+        assert (not modeEqMark (mode, cur));
+        assert (header == GC_getHeader (cur));
+        assert (headerp == GC_getHeaderp (cur));
+        header ^= 0x80000000;
+        /* Store the mark.  In the case of an object that contains a pointer to
+         * itself, it is essential that we store the marked header before marking
+         * the internal pointers (markInNormal below).  If we didn't, then we
+         * would see the object as unmarked and traverse it again.
+         */
+        *headerp = header;
+        SPLIT_HEADER();
+        if (NORMAL_TAG == tag) {
+                if (0 == numPointers) {
+                        /* There is nothing to mark. */
+                        size += GC_NORMAL_HEADER_SIZE + toBytes (numNonPointers);
 normalDone:
-			if (shouldHashCons)
-				cur = hashCons (s, cur, TRUE);
-			goto ret;
-		}
-		todo = cur + toBytes (numNonPointers);
-		size += todo + toBytes (numPointers) - (pointer)headerp;
-		index = 0;
+                        if (shouldHashCons)
+                                cur = hashCons (s, cur, TRUE);
+                        goto ret;
+                }
+                todo = cur + toBytes (numNonPointers);
+                size += todo + toBytes (numPointers) - (pointer)headerp;
+                index = 0;
 markInNormal:
-		if (DEBUG_MARK_COMPACT)
-			fprintf (stderr, "markInNormal  index = %d\n", index);
-		assert (index < numPointers);
-		next = *(pointer*)todo;
-		if (not GC_isPointer (next)) {
+                if (DEBUG_MARK_COMPACT)
+                        fprintf (stderr, "markInNormal  index = %d\n", index);
+                assert (index < numPointers);
+                next = *(pointer*)todo;
+                if (not GC_isPointer (next)) {
 markNextInNormal:
-			assert (index < numPointers);
-       			index++;
-			if (index == numPointers) {
-				*headerp = header & ~COUNTER_MASK;
-				goto normalDone;
-			}
-			todo += POINTER_SIZE;
-			goto markInNormal;
-		}
-		nextHeaderp = GC_getHeaderp (next);
-		nextHeader = *nextHeaderp;
-		if (mark == (nextHeader & MARK_MASK)) {
-			maybeSharePointer (s, (pointer*)todo, shouldHashCons);
-			goto markNextInNormal;
-		}
-		*headerp = (header & ~COUNTER_MASK) |
-				(index << COUNTER_SHIFT);
-		goto markNext;
-	} else if (WEAK_TAG == tag) {
-		/* Store the marked header and don't follow any pointers. */
-		goto ret;
-	} else if (ARRAY_TAG == tag) {
-		/* When marking arrays:
-		 *   arrayIndex is the index of the element to mark.
-		 *   cur is the pointer to the array.
-		 *   index is the index of the pointer within the element
-		 *     (i.e. the i'th pointer is at index i).
-		 *   todo is the start of the element.
-		 */
-		size += GC_ARRAY_HEADER_SIZE
-			+ arrayNumBytes (s, cur, numPointers, numNonPointers);
-		if (0 == numPointers or 0 == GC_arrayNumElements (cur)) {
-			/* There is nothing to mark. */
+                        assert (index < numPointers);
+                        index++;
+                        if (index == numPointers) {
+                                *headerp = header & ~COUNTER_MASK;
+                                goto normalDone;
+                        }
+                        todo += POINTER_SIZE;
+                        goto markInNormal;
+                }
+                nextHeaderp = GC_getHeaderp (next);
+                nextHeader = *nextHeaderp;
+                if (mark == (nextHeader & MARK_MASK)) {
+                        maybeSharePointer (s, (pointer*)todo, shouldHashCons);
+                        goto markNextInNormal;
+                }
+                *headerp = (header & ~COUNTER_MASK) |
+                                (index << COUNTER_SHIFT);
+                goto markNext;
+        } else if (WEAK_TAG == tag) {
+                /* Store the marked header and don't follow any pointers. */
+                goto ret;
+        } else if (ARRAY_TAG == tag) {
+                /* When marking arrays:
+                 *   arrayIndex is the index of the element to mark.
+                 *   cur is the pointer to the array.
+                 *   index is the index of the pointer within the element
+                 *     (i.e. the i'th pointer is at index i).
+                 *   todo is the start of the element.
+                 */
+                size += GC_ARRAY_HEADER_SIZE
+                        + arrayNumBytes (s, cur, numPointers, numNonPointers);
+                if (0 == numPointers or 0 == GC_arrayNumElements (cur)) {
+                        /* There is nothing to mark. */
 arrayDone:
-			if (shouldHashCons)
-				cur = hashCons (s, cur, TRUE);
-			goto ret;
-		}
-		/* Begin marking first element. */
-		arrayIndex = 0;
-		todo = cur;
+                        if (shouldHashCons)
+                                cur = hashCons (s, cur, TRUE);
+                        goto ret;
+                }
+                /* Begin marking first element. */
+                arrayIndex = 0;
+                todo = cur;
 markArrayElt:
-		assert (arrayIndex < GC_arrayNumElements (cur));
-		index = 0;
-		/* Skip to the first pointer. */
-		todo += numNonPointers;
+                assert (arrayIndex < GC_arrayNumElements (cur));
+                index = 0;
+                /* Skip to the first pointer. */
+                todo += numNonPointers;
 markInArray:
-		if (DEBUG_MARK_COMPACT)
-			fprintf (stderr, "markInArray arrayIndex = %u index = %u\n",
-					arrayIndex, index);
-		assert (arrayIndex < GC_arrayNumElements (cur));
-		assert (index < numPointers);
-		assert (todo == arrayPointer (s, cur, arrayIndex, index));
-		next = *(pointer*)todo;
-		if (not (GC_isPointer (next))) {
+                if (DEBUG_MARK_COMPACT)
+                        fprintf (stderr, "markInArray arrayIndex = %u index = %u\n",
+                                        arrayIndex, index);
+                assert (arrayIndex < GC_arrayNumElements (cur));
+                assert (index < numPointers);
+                assert (todo == arrayPointer (s, cur, arrayIndex, index));
+                next = *(pointer*)todo;
+                if (not (GC_isPointer (next))) {
 markNextInArray:
-			assert (arrayIndex < GC_arrayNumElements (cur));
-			assert (index < numPointers);
-			assert (todo == arrayPointer (s, cur, arrayIndex, index));
-			todo += POINTER_SIZE;
-			index++;
-			if (index < numPointers)
-				goto markInArray;
-			arrayIndex++;
-			if (arrayIndex < GC_arrayNumElements (cur))
-				goto markArrayElt;
-			/* Done.  Clear out the counters and return. */
-			*arrayCounterp (cur) = 0;
-			*headerp = header & ~COUNTER_MASK;
-			goto arrayDone;
-		}
-		nextHeaderp = GC_getHeaderp (next);
-		nextHeader = *nextHeaderp;
-		if (mark == (nextHeader & MARK_MASK)) {
-			maybeSharePointer (s, (pointer*)todo, shouldHashCons);
-			goto markNextInArray;
-		}
-		/* Recur and mark next. */
-		*arrayCounterp (cur) = arrayIndex;
-		*headerp = (header & ~COUNTER_MASK) |
-				(index << COUNTER_SHIFT);
-		goto markNext;
-	} else {
-		assert (STACK_TAG == tag);
-		size += stackBytes (s, ((GC_stack)cur)->reserved);
-		top = stackTop (s, (GC_stack)cur);
-		assert (((GC_stack)cur)->used <= ((GC_stack)cur)->reserved);
+                        assert (arrayIndex < GC_arrayNumElements (cur));
+                        assert (index < numPointers);
+                        assert (todo == arrayPointer (s, cur, arrayIndex, index));
+                        todo += POINTER_SIZE;
+                        index++;
+                        if (index < numPointers)
+                                goto markInArray;
+                        arrayIndex++;
+                        if (arrayIndex < GC_arrayNumElements (cur))
+                                goto markArrayElt;
+                        /* Done.  Clear out the counters and return. */
+                        *arrayCounterp (cur) = 0;
+                        *headerp = header & ~COUNTER_MASK;
+                        goto arrayDone;
+                }
+                nextHeaderp = GC_getHeaderp (next);
+                nextHeader = *nextHeaderp;
+                if (mark == (nextHeader & MARK_MASK)) {
+                        maybeSharePointer (s, (pointer*)todo, shouldHashCons);
+                        goto markNextInArray;
+                }
+                /* Recur and mark next. */
+                *arrayCounterp (cur) = arrayIndex;
+                *headerp = (header & ~COUNTER_MASK) |
+                                (index << COUNTER_SHIFT);
+                goto markNext;
+        } else {
+                assert (STACK_TAG == tag);
+                size += stackBytes (s, ((GC_stack)cur)->reserved);
+                top = stackTop (s, (GC_stack)cur);
+                assert (((GC_stack)cur)->used <= ((GC_stack)cur)->reserved);
 markInStack:
-		/* Invariant: top points just past the return address of the
-		 * frame to be marked.
-		 */
-		assert (stackBottom (s, (GC_stack)cur) <= top);
-		if (DEBUG_MARK_COMPACT)
-			fprintf (stderr, "markInStack  top = %d\n",
-					top - stackBottom (s, (GC_stack)cur));
-					
-		if (top == stackBottom (s, (GC_stack)(cur)))
-			goto ret;
-		index = 0;
-		layout = getFrameLayout (s, *(word*) (top - WORD_SIZE));
-		frameOffsets = layout->offsets;
-		((GC_stack)cur)->markTop = top;
+                /* Invariant: top points just past the return address of the
+                 * frame to be marked.
+                 */
+                assert (stackBottom (s, (GC_stack)cur) <= top);
+                if (DEBUG_MARK_COMPACT)
+                        fprintf (stderr, "markInStack  top = %d\n",
+                                        top - stackBottom (s, (GC_stack)cur));
+                                        
+                if (top == stackBottom (s, (GC_stack)(cur)))
+                        goto ret;
+                index = 0;
+                layout = getFrameLayout (s, *(word*) (top - WORD_SIZE));
+                frameOffsets = layout->offsets;
+                ((GC_stack)cur)->markTop = top;
 markInFrame:
-		if (index == frameOffsets [0]) {
-			top -= layout->numBytes;
-			goto markInStack;
-		}
-		todo = top - layout->numBytes + frameOffsets [index + 1];
-		next = *(pointer*)todo;
-		if (DEBUG_MARK_COMPACT)
-			fprintf (stderr, 
-				"    offset %u  todo 0x%08x  next = 0x%08x\n", 
-				frameOffsets [index + 1], 
-				(uint)todo, (uint)next);
-		if (not GC_isPointer (next)) {
-			index++;
-			goto markInFrame;
-		}
-		nextHeaderp = GC_getHeaderp (next);
-		nextHeader = *nextHeaderp;
-		if (mark == (nextHeader & MARK_MASK)) {
-			index++;
-			maybeSharePointer (s, (pointer*)todo, shouldHashCons);
-			goto markInFrame;
-		}
-		((GC_stack)cur)->markIndex = index;		
-		goto markNext;
-	}
-	assert (FALSE);
+                if (index == frameOffsets [0]) {
+                        top -= layout->numBytes;
+                        goto markInStack;
+                }
+                todo = top - layout->numBytes + frameOffsets [index + 1];
+                next = *(pointer*)todo;
+                if (DEBUG_MARK_COMPACT)
+                        fprintf (stderr, 
+                                "    offset %u  todo 0x%08x  next = 0x%08x\n", 
+                                frameOffsets [index + 1], 
+                                (uint)todo, (uint)next);
+                if (not GC_isPointer (next)) {
+                        index++;
+                        goto markInFrame;
+                }
+                nextHeaderp = GC_getHeaderp (next);
+                nextHeader = *nextHeaderp;
+                if (mark == (nextHeader & MARK_MASK)) {
+                        index++;
+                        maybeSharePointer (s, (pointer*)todo, shouldHashCons);
+                        goto markInFrame;
+                }
+                ((GC_stack)cur)->markIndex = index;             
+                goto markNext;
+        }
+        assert (FALSE);
 ret:
-	/* Done marking cur, continue with prev.
-	 * Need to set the pointer in the prev object that pointed to cur 
-	 * to point back to prev, and restore prev.
- 	 */
-	if (DEBUG_MARK_COMPACT)
-		fprintf (stderr, "return  cur = 0x%08x  prev = 0x%08x\n",
-				(uint)cur, (uint)prev);
-	assert (modeEqMark (mode, cur));
-	if (NULL == prev)
-		return size;
-	next = cur;
-	cur = prev;
-	headerp = GC_getHeaderp (cur);
-	header = *headerp;
-	SPLIT_HEADER();
-	/* It's impossible to get a WEAK_TAG here, since we would never follow
-	 * the weak object pointer.
-	 */
-	assert (WEAK_TAG != tag);
-	if (NORMAL_TAG == tag) {
-		todo = cur + toBytes (numNonPointers);
-		index = (header & COUNTER_MASK) >> COUNTER_SHIFT;
-		todo += index * POINTER_SIZE;
-		prev = *(pointer*)todo;
-		*(pointer*)todo = next;
-		goto markNextInNormal;
-	} else if (ARRAY_TAG == tag) {
-		arrayIndex = arrayCounter (cur);
-		todo = cur + arrayIndex * (numNonPointers 
-						+ toBytes (numPointers));
-		index = (header & COUNTER_MASK) >> COUNTER_SHIFT;
-		todo += numNonPointers + index * POINTER_SIZE;
-		prev = *(pointer*)todo;
-		*(pointer*)todo = next;
-		goto markNextInArray;
-	} else {
-		assert (STACK_TAG == tag);
-		index = ((GC_stack)cur)->markIndex;
-		top = ((GC_stack)cur)->markTop;
-		layout = getFrameLayout (s, *(word*) (top - WORD_SIZE));
-		frameOffsets = layout->offsets;
-		todo = top - layout->numBytes + frameOffsets [index + 1];
-		prev = *(pointer*)todo;
-		*(pointer*)todo = next;
-		index++;
-		goto markInFrame;
-	}
-	assert (FALSE);
+        /* Done marking cur, continue with prev.
+         * Need to set the pointer in the prev object that pointed to cur 
+         * to point back to prev, and restore prev.
+         */
+        if (DEBUG_MARK_COMPACT)
+                fprintf (stderr, "return  cur = 0x%08x  prev = 0x%08x\n",
+                                (uint)cur, (uint)prev);
+        assert (modeEqMark (mode, cur));
+        if (NULL == prev)
+                return size;
+        next = cur;
+        cur = prev;
+        headerp = GC_getHeaderp (cur);
+        header = *headerp;
+        SPLIT_HEADER();
+        /* It's impossible to get a WEAK_TAG here, since we would never follow
+         * the weak object pointer.
+         */
+        assert (WEAK_TAG != tag);
+        if (NORMAL_TAG == tag) {
+                todo = cur + toBytes (numNonPointers);
+                index = (header & COUNTER_MASK) >> COUNTER_SHIFT;
+                todo += index * POINTER_SIZE;
+                prev = *(pointer*)todo;
+                *(pointer*)todo = next;
+                goto markNextInNormal;
+        } else if (ARRAY_TAG == tag) {
+                arrayIndex = arrayCounter (cur);
+                todo = cur + arrayIndex * (numNonPointers 
+                                                + toBytes (numPointers));
+                index = (header & COUNTER_MASK) >> COUNTER_SHIFT;
+                todo += numNonPointers + index * POINTER_SIZE;
+                prev = *(pointer*)todo;
+                *(pointer*)todo = next;
+                goto markNextInArray;
+        } else {
+                assert (STACK_TAG == tag);
+                index = ((GC_stack)cur)->markIndex;
+                top = ((GC_stack)cur)->markTop;
+                layout = getFrameLayout (s, *(word*) (top - WORD_SIZE));
+                frameOffsets = layout->offsets;
+                todo = top - layout->numBytes + frameOffsets [index + 1];
+                prev = *(pointer*)todo;
+                *(pointer*)todo = next;
+                index++;
+                goto markInFrame;
+        }
+        assert (FALSE);
 }
 
 static void bytesHashConsedMessage (GC_state s, ullong total) {
-	fprintf (stderr, "%s bytes hash consed (%.1f%%).\n",
-		ullongToCommaString (s->bytesHashConsed),
-		100.0 * ((double)s->bytesHashConsed / (double)total));
+        fprintf (stderr, "%s bytes hash consed (%.1f%%).\n",
+                ullongToCommaString (s->bytesHashConsed),
+                100.0 * ((double)s->bytesHashConsed / (double)total));
 }
 
 void GC_share (GC_state s, Pointer object) {
-	W32 total;
+        W32 total;
 
-	if (DEBUG_SHARE)
-		fprintf (stderr, "GC_share 0x%08x\n", (uint)object);
-	if (DEBUG_SHARE or s->messages)
-		s->bytesHashConsed = 0;
-	// Don't hash cons during the first round of marking.
-	total = mark (s, object, MARK_MODE, FALSE);
-	s->objectHashTable = newTable (s);
-	// Hash cons during the second round of marking.
-	mark (s, object, UNMARK_MODE, TRUE);
-	destroyTable (s->objectHashTable);
-	if (DEBUG_SHARE or s->messages)
-		bytesHashConsedMessage (s, total);
+        if (DEBUG_SHARE)
+                fprintf (stderr, "GC_share 0x%08x\n", (uint)object);
+        if (DEBUG_SHARE or s->messages)
+                s->bytesHashConsed = 0;
+        // Don't hash cons during the first round of marking.
+        total = mark (s, object, MARK_MODE, FALSE);
+        s->objectHashTable = newTable (s);
+        // Hash cons during the second round of marking.
+        mark (s, object, UNMARK_MODE, TRUE);
+        destroyTable (s->objectHashTable);
+        if (DEBUG_SHARE or s->messages)
+                bytesHashConsedMessage (s, total);
 }
 
 /* ---------------------------------------------------------------- */
@@ -2428,274 +2430,274 @@
 /* ---------------------------------------------------------------- */
 
 static inline void markGlobalTrue (GC_state s, pointer *pp) {
-	mark (s, *pp, MARK_MODE, TRUE);
+        mark (s, *pp, MARK_MODE, TRUE);
 }
 
 static inline void markGlobalFalse (GC_state s, pointer *pp) {
-	mark (s, *pp, MARK_MODE, FALSE);
+        mark (s, *pp, MARK_MODE, FALSE);
 }
 
 static inline void unmarkGlobal (GC_state s, pointer *pp) {
-       	mark (s, *pp, UNMARK_MODE, FALSE);
+        mark (s, *pp, UNMARK_MODE, FALSE);
 }
 
 static inline void threadInternal (GC_state s, pointer *pp) {
-	Header *headerp;
+        Header *headerp;
 
-	if (FALSE)
-		fprintf (stderr, "threadInternal pp = 0x%08x  *pp = 0x%08x  header = 0x%08x\n",
-				(uint)pp, *(uint*)pp, (uint)GC_getHeader (*pp));
-	headerp = GC_getHeaderp (*pp);
-	*(Header*)pp = *headerp;
-	*headerp = (Header)pp;
+        if (FALSE)
+                fprintf (stderr, "threadInternal pp = 0x%08x  *pp = 0x%08x  header = 0x%08x\n",
+                                (uint)pp, *(uint*)pp, (uint)GC_getHeader (*pp));
+        headerp = GC_getHeaderp (*pp);
+        *(Header*)pp = *headerp;
+        *headerp = (Header)pp;
 }
 
 /* If p is weak, the object pointer was valid, and points to an unmarked object,
  * then clear the object pointer.
  */
 static inline void maybeClearWeak (GC_state s, pointer p) {
-	Bool hasIdentity;
-	Header header;
-	Header *headerp;
-	uint numPointers;
-	uint numNonPointers;
-	uint tag;
+        Bool hasIdentity;
+        Header header;
+        Header *headerp;
+        uint numPointers;
+        uint numNonPointers;
+        uint tag;
 
-	headerp = GC_getHeaderp (p);
-	header = *headerp;
-	SPLIT_HEADER();
-	if (WEAK_TAG == tag and 1 == numPointers) { 
-		Header h2;
+        headerp = GC_getHeaderp (p);
+        header = *headerp;
+        SPLIT_HEADER();
+        if (WEAK_TAG == tag and 1 == numPointers) { 
+                Header h2;
 
-		if (DEBUG_WEAK)
-			fprintf (stderr, "maybeClearWeak (0x%08x)  header = 0x%08x\n",
-					(uint)p, (uint)header);
-		h2 = GC_getHeader (((GC_weak)p)->object);
-		/* If it's unmarked not threaded, clear the weak pointer. */
-		if (1 == ((MARK_MASK | 1) & h2)) {
-			((GC_weak)p)->object = (pointer)BOGUS_POINTER;
-			header = WEAK_GONE_HEADER | MARK_MASK;
-			if (DEBUG_WEAK)
-				fprintf (stderr, "cleared.  new header = 0x%08x\n",
-						(uint)header);
-			*headerp = header;
-		}
-	}
+                if (DEBUG_WEAK)
+                        fprintf (stderr, "maybeClearWeak (0x%08x)  header = 0x%08x\n",
+                                        (uint)p, (uint)header);
+                h2 = GC_getHeader (((GC_weak)p)->object);
+                /* If it's unmarked not threaded, clear the weak pointer. */
+                if (1 == ((MARK_MASK | 1) & h2)) {
+                        ((GC_weak)p)->object = (pointer)BOGUS_POINTER;
+                        header = WEAK_GONE_HEADER | MARK_MASK;
+                        if (DEBUG_WEAK)
+                                fprintf (stderr, "cleared.  new header = 0x%08x\n",
+                                                (uint)header);
+                        *headerp = header;
+                }
+        }
 }
 
 static void updateForwardPointers (GC_state s) {
-	pointer back;
-	pointer front;
-	uint gap;
-	pointer endOfLastMarked;
-	Header header;
-	Header *headerp;
-	pointer p;
-	uint size;
+        pointer back;
+        pointer front;
+        uint gap;
+        pointer endOfLastMarked;
+        Header header;
+        Header *headerp;
+        pointer p;
+        uint size;
 
-	if (DEBUG_MARK_COMPACT)
-		fprintf (stderr, "Update forward pointers.\n");
-	front = alignFrontier (s, s->heap.start);
-	back = s->heap.start + s->oldGenSize;
-	endOfLastMarked = front;
-	gap = 0;
+        if (DEBUG_MARK_COMPACT)
+                fprintf (stderr, "Update forward pointers.\n");
+        front = alignFrontier (s, s->heap.start);
+        back = s->heap.start + s->oldGenSize;
+        endOfLastMarked = front;
+        gap = 0;
 updateObject:
-	if (DEBUG_MARK_COMPACT)
-		fprintf (stderr, "updateObject  front = 0x%08x  back = 0x%08x\n",
-				(uint)front, (uint)back);
-	if (front == back)
-		goto done;
-	headerp = (Header*)front;
-	header = *headerp;
-	if (0 == header) {
-		/* We're looking at an array.  Move to the header. */
-		p = front + 3 * WORD_SIZE;
-		headerp = (Header*)(p - WORD_SIZE);
-		header = *headerp;
-	} else 
-		p = front + WORD_SIZE;
-	if (1 == (1 & header)) {
-		/* It's a header */
-		if (MARK_MASK & header) {
-			/* It is marked, but has no forward pointers. 
-			 * Thread internal pointers.
-			 */
+        if (DEBUG_MARK_COMPACT)
+                fprintf (stderr, "updateObject  front = 0x%08x  back = 0x%08x\n",
+                                (uint)front, (uint)back);
+        if (front == back)
+                goto done;
+        headerp = (Header*)front;
+        header = *headerp;
+        if (0 == header) {
+                /* We're looking at an array.  Move to the header. */
+                p = front + 3 * WORD_SIZE;
+                headerp = (Header*)(p - WORD_SIZE);
+                header = *headerp;
+        } else 
+                p = front + WORD_SIZE;
+        if (1 == (1 & header)) {
+                /* It's a header */
+                if (MARK_MASK & header) {
+                        /* It is marked, but has no forward pointers. 
+                         * Thread internal pointers.
+                         */
 thread:
-			maybeClearWeak (s, p);
-			size = objectSize (s, p);
-			if (DEBUG_MARK_COMPACT)
-	       			fprintf (stderr, "threading 0x%08x of size %u\n", 
-						(uint)p, size);
-			if (front - endOfLastMarked >= 4 * WORD_SIZE) {
-				/* Compress all of the unmarked into one string.
-				 * We require 4 * WORD_SIZE space to be available
-				 * because that is the smallest possible array.
-				 * You cannot use 3 * WORD_SIZE because even
-				 * zero-length arrays require an extra word for
-				 * the forwarding pointer.  If you did use
-				 * 3 * WORD_SIZE, updateBackwardPointersAndSlide
-				 * would skip the extra word and be completely
-				 * busted.
-				 */
-				if (DEBUG_MARK_COMPACT)
-					fprintf (stderr, "compressing from 0x%08x to 0x%08x (length = %u)\n",
-							(uint)endOfLastMarked,
-							(uint)front,
-							front - endOfLastMarked);
-				*(uint*)endOfLastMarked = 0;
-				*(uint*)(endOfLastMarked + WORD_SIZE) = 
-					front - endOfLastMarked - 3 * WORD_SIZE;
-				*(uint*)(endOfLastMarked + 2 * WORD_SIZE) =
-					GC_objectHeader (STRING_TYPE_INDEX);
-			}
-			front += size;
-			endOfLastMarked = front;
-			foreachPointerInObject (s, p, FALSE, threadInternal);
-			goto updateObject;
-		} else {
-			/* It's not marked. */
-			size = objectSize (s, p);
-			gap += size;
-			front += size;
-			goto updateObject;
-		}
-	} else {
-		pointer new;
+                        maybeClearWeak (s, p);
+                        size = objectSize (s, p);
+                        if (DEBUG_MARK_COMPACT)
+                                fprintf (stderr, "threading 0x%08x of size %u\n", 
+                                                (uint)p, size);
+                        if (front - endOfLastMarked >= 4 * WORD_SIZE) {
+                                /* Compress all of the unmarked into one string.
+                                 * We require 4 * WORD_SIZE space to be available
+                                 * because that is the smallest possible array.
+                                 * You cannot use 3 * WORD_SIZE because even
+                                 * zero-length arrays require an extra word for
+                                 * the forwarding pointer.  If you did use
+                                 * 3 * WORD_SIZE, updateBackwardPointersAndSlide
+                                 * would skip the extra word and be completely
+                                 * busted.
+                                 */
+                                if (DEBUG_MARK_COMPACT)
+                                        fprintf (stderr, "compressing from 0x%08x to 0x%08x (length = %u)\n",
+                                                        (uint)endOfLastMarked,
+                                                        (uint)front,
+                                                        front - endOfLastMarked);
+                                *(uint*)endOfLastMarked = 0;
+                                *(uint*)(endOfLastMarked + WORD_SIZE) = 
+                                        front - endOfLastMarked - 3 * WORD_SIZE;
+                                *(uint*)(endOfLastMarked + 2 * WORD_SIZE) =
+                                        GC_objectHeader (STRING_TYPE_INDEX);
+                        }
+                        front += size;
+                        endOfLastMarked = front;
+                        foreachPointerInObject (s, p, FALSE, threadInternal);
+                        goto updateObject;
+                } else {
+                        /* It's not marked. */
+                        size = objectSize (s, p);
+                        gap += size;
+                        front += size;
+                        goto updateObject;
+                }
+        } else {
+                pointer new;
 
-		assert (0 == (3 & header));
-		/* It's a pointer.  This object must be live.  Fix all the
-		 * forward pointers to it, store its header, then thread
+                assert (0 == (3 & header));
+                /* It's a pointer.  This object must be live.  Fix all the
+                 * forward pointers to it, store its header, then thread
                  * its internal pointers.
-		 */
-		new = p - gap;
-		do {
-			pointer cur;
+                 */
+                new = p - gap;
+                do {
+                        pointer cur;
 
-			cur = (pointer)header;
-			header = *(word*)cur;
-			*(word*)cur = (word)new;
-		} while (0 == (1 & header));
-		*headerp = header;
-		goto thread;
-	}
-	assert (FALSE);
+                        cur = (pointer)header;
+                        header = *(word*)cur;
+                        *(word*)cur = (word)new;
+                } while (0 == (1 & header));
+                *headerp = header;
+                goto thread;
+        }
+        assert (FALSE);
 done:
-	return;
+        return;
 }
 
 static void updateBackwardPointersAndSlide (GC_state s) {
-	pointer back;
-	pointer front;
-	uint gap;
-	Header header;
-	pointer p;
-	uint size;
+        pointer back;
+        pointer front;
+        uint gap;
+        Header header;
+        pointer p;
+        uint size;
 
-	if (DEBUG_MARK_COMPACT)
-		fprintf (stderr, "Update backward pointers and slide.\n");
-	front = alignFrontier (s, s->heap.start);
-	back = s->heap.start + s->oldGenSize;
-	gap = 0;
+        if (DEBUG_MARK_COMPACT)
+                fprintf (stderr, "Update backward pointers and slide.\n");
+        front = alignFrontier (s, s->heap.start);
+        back = s->heap.start + s->oldGenSize;
+        gap = 0;
 updateObject:
-	if (DEBUG_MARK_COMPACT)
-		fprintf (stderr, "updateObject  front = 0x%08x  back = 0x%08x\n",
-				(uint)front, (uint)back);
-	if (front == back)
-		goto done;
-	header = *(word*)front;
-	if (0 == header) {
-		/* We're looking at an array.  Move to the header. */
-		p = front + 3 * WORD_SIZE;
-		header = *(Header*)(p - WORD_SIZE);
-	} else 
-		p = front + WORD_SIZE;
-	if (1 == (1 & header)) {
-		/* It's a header */
-		if (MARK_MASK & header) {
-			/* It is marked, but has no backward pointers to it.
-			 * Unmark it.
-			 */
+        if (DEBUG_MARK_COMPACT)
+                fprintf (stderr, "updateObject  front = 0x%08x  back = 0x%08x\n",
+                                (uint)front, (uint)back);
+        if (front == back)
+                goto done;
+        header = *(word*)front;
+        if (0 == header) {
+                /* We're looking at an array.  Move to the header. */
+                p = front + 3 * WORD_SIZE;
+                header = *(Header*)(p - WORD_SIZE);
+        } else 
+                p = front + WORD_SIZE;
+        if (1 == (1 & header)) {
+                /* It's a header */
+                if (MARK_MASK & header) {
+                        /* It is marked, but has no backward pointers to it.
+                         * Unmark it.
+                         */
 unmark:
-			*GC_getHeaderp (p) = header & ~MARK_MASK;
-			size = objectSize (s, p);
-			if (DEBUG_MARK_COMPACT)
-				fprintf (stderr, "unmarking 0x%08x of size %u\n", 
-						(uint)p, size);
-			/* slide */
-			if (DEBUG_MARK_COMPACT)
-				fprintf (stderr, "sliding 0x%08x down %u\n",
-						(uint)front, gap);
-			copy (front, front - gap, size);
-			front += size;
-			goto updateObject;
-		} else {
-			/* It's not marked. */
-			size = objectSize (s, p);
-			if (DEBUG_MARK_COMPACT)
-				fprintf (stderr, "skipping 0x%08x of size %u\n",
-						(uint)p, size);
-			gap += size;
-			front += size;
-			goto updateObject;
-		}
-	} else {
-		pointer new;
+                        *GC_getHeaderp (p) = header & ~MARK_MASK;
+                        size = objectSize (s, p);
+                        if (DEBUG_MARK_COMPACT)
+                                fprintf (stderr, "unmarking 0x%08x of size %u\n", 
+                                                (uint)p, size);
+                        /* slide */
+                        if (DEBUG_MARK_COMPACT)
+                                fprintf (stderr, "sliding 0x%08x down %u\n",
+                                                (uint)front, gap);
+                        copy (front, front - gap, size);
+                        front += size;
+                        goto updateObject;
+                } else {
+                        /* It's not marked. */
+                        size = objectSize (s, p);
+                        if (DEBUG_MARK_COMPACT)
+                                fprintf (stderr, "skipping 0x%08x of size %u\n",
+                                                (uint)p, size);
+                        gap += size;
+                        front += size;
+                        goto updateObject;
+                }
+        } else {
+                pointer new;
 
-		/* It's a pointer.  This object must be live.  Fix all the
-		 * backward pointers to it.  Then unmark it.
-		 */
-		new = p - gap;
-		do {
-			pointer cur;
+                /* It's a pointer.  This object must be live.  Fix all the
+                 * backward pointers to it.  Then unmark it.
+                 */
+                new = p - gap;
+                do {
+                        pointer cur;
 
-			assert (0 == (3 & header));
-			cur = (pointer)header;
-			header = *(word*)cur;
-			*(word*)cur = (word)new;
-		} while (0 == (1 & header));
-		/* The header will be stored by unmark. */
-		goto unmark;
-	}
-	assert (FALSE);
+                        assert (0 == (3 & header));
+                        cur = (pointer)header;
+                        header = *(word*)cur;
+                        *(word*)cur = (word)new;
+                } while (0 == (1 & header));
+                /* The header will be stored by unmark. */
+                goto unmark;
+        }
+        assert (FALSE);
 done:
-	s->oldGenSize = front - gap - s->heap.start;
-	if (DEBUG_MARK_COMPACT)
-		fprintf (stderr, "bytesLive = %u\n", s->bytesLive);
-	return;
+        s->oldGenSize = front - gap - s->heap.start;
+        if (DEBUG_MARK_COMPACT)
+                fprintf (stderr, "bytesLive = %u\n", s->bytesLive);
+        return;
 }
 
 static void markCompact (GC_state s) {
-	struct rusage ru_start;
+        struct rusage ru_start;
 
-	if (DEBUG or s->messages)
-		fprintf (stderr, "Major mark-compact GC.\n");
-	if (detailedGCTime (s))
-		startTiming (&ru_start);
-	s->numMarkCompactGCs++;
-	if (s->hashConsDuringGC) {
-		s->bytesHashConsed = 0;
-		s->numHashConsGCs++;
-		s->objectHashTable = newTable (s);
-	}
-	foreachGlobal (s, s->hashConsDuringGC 
-				? markGlobalTrue 
-				: markGlobalFalse);
-	if (s->hashConsDuringGC)
-		destroyTable (s->objectHashTable);
-	foreachGlobal (s, threadInternal);
-	updateForwardPointers (s);
-	updateBackwardPointersAndSlide (s);
-	clearCrossMap (s);
-	s->bytesMarkCompacted += s->oldGenSize;
-	s->lastMajor = GC_MARK_COMPACT;
-	if (detailedGCTime (s))
-		stopTiming (&ru_start, &s->ru_gcMarkCompact);
-	if (DEBUG or s->messages) {
-		fprintf (stderr, "Major mark-compact GC done.\n");
-		if (s->hashConsDuringGC)
-			bytesHashConsedMessage 
-				(s, s->bytesHashConsed + s->oldGenSize);
-	}
+        if (DEBUG or s->messages)
+                fprintf (stderr, "Major mark-compact GC.\n");
+        if (detailedGCTime (s))
+                startTiming (&ru_start);
+        s->numMarkCompactGCs++;
+        if (s->hashConsDuringGC) {
+                s->bytesHashConsed = 0;
+                s->numHashConsGCs++;
+                s->objectHashTable = newTable (s);
+        }
+        foreachGlobal (s, s->hashConsDuringGC 
+                                ? markGlobalTrue 
+                                : markGlobalFalse);
+        if (s->hashConsDuringGC)
+                destroyTable (s->objectHashTable);
+        foreachGlobal (s, threadInternal);
+        updateForwardPointers (s);
+        updateBackwardPointersAndSlide (s);
+        clearCrossMap (s);
+        s->bytesMarkCompacted += s->oldGenSize;
+        s->lastMajor = GC_MARK_COMPACT;
+        if (detailedGCTime (s))
+                stopTiming (&ru_start, &s->ru_gcMarkCompact);
+        if (DEBUG or s->messages) {
+                fprintf (stderr, "Major mark-compact GC done.\n");
+                if (s->hashConsDuringGC)
+                        bytesHashConsedMessage 
+                                (s, s->bytesHashConsed + s->oldGenSize);
+        }
 }
 
 /* ---------------------------------------------------------------- */
@@ -2703,36 +2705,36 @@
 /* ---------------------------------------------------------------- */
 
 static void translatePointer (GC_state s, pointer *p) {
-	if (s->translateUp)
-		*p += s->translateDiff;
-	else
-		*p -= s->translateDiff;
+        if (s->translateUp)
+                *p += s->translateDiff;
+        else
+                *p -= s->translateDiff;
 }
 
 /* Translate all pointers to the heap from within the stack and the heap for
  * a heap that has moved from from to to.
  */
 static void translateHeap (GC_state s, pointer from, pointer to, uint size) {
-	pointer limit;
+        pointer limit;
 
-	if (DEBUG or s->messages)
-		fprintf (stderr, "Translating heap of size %s from 0x%08x to 0x%08x.\n",
-				uintToCommaString (size),
-				(uint)from, (uint)to);
-	if (from == to)
-		return;
-	else if (to > from) {
-		s->translateDiff = to - from;
-		s->translateUp = TRUE;
-	} else {
-		s->translateDiff = from - to;
-		s->translateUp = FALSE;
-	}
-	/* Translate globals and heap. */
-	foreachGlobal (s, translatePointer);
-	limit = to + size;
-	foreachPointerInRange (s, alignFrontier (s, to), &limit, FALSE,
-				translatePointer);
+        if (DEBUG or s->messages)
+                fprintf (stderr, "Translating heap of size %s from 0x%08x to 0x%08x.\n",
+                                uintToCommaString (size),
+                                (uint)from, (uint)to);
+        if (from == to)
+                return;
+        else if (to > from) {
+                s->translateDiff = to - from;
+                s->translateUp = TRUE;
+        } else {
+                s->translateDiff = from - to;
+                s->translateUp = FALSE;
+        }
+        /* Translate globals and heap. */
+        foreachGlobal (s, translatePointer);
+        limit = to + size;
+        foreachPointerInRange (s, alignFrontier (s, to), &limit, FALSE,
+                                translatePointer);
 }
 
 /* ---------------------------------------------------------------- */
@@ -2740,33 +2742,33 @@
 /* ---------------------------------------------------------------- */
 
 bool heapRemap (GC_state s, GC_heap h, W32 desired, W32 minSize) {
-	W32 backoff;
-	W32 size;
+        W32 backoff;
+        W32 size;
 
 #if not HAS_REMAP
-	return FALSE;
+        return FALSE;
 #endif
-	assert (minSize <= desired);
-	assert (desired >= h->size);
-	desired = align (desired, s->pageSize);
-	backoff = (desired - minSize) / 20;
-	if (0 == backoff)
-		backoff = 1; /* enough to terminate the loop below */
-	backoff = align (backoff, s->pageSize);
-	for (size = desired; size >= minSize; size -= backoff) {
-		pointer new;
+        assert (minSize <= desired);
+        assert (desired >= h->size);
+        desired = align (desired, s->pageSize);
+        backoff = (desired - minSize) / 20;
+        if (0 == backoff)
+                backoff = 1; /* enough to terminate the loop below */
+        backoff = align (backoff, s->pageSize);
+        for (size = desired; size >= minSize; size -= backoff) {
+                pointer new;
 
-		new = remap (h->start, h->size, size);
-		unless ((void*)-1 == new) {
-			h->start = new;
-			h->size = size;
-			if (h->size > s->maxHeapSizeSeen)
-				s->maxHeapSizeSeen = h->size;
-			assert (minSize <= h->size and h->size <= desired);
-			return TRUE;
-		}
-	}
-	return FALSE;
+                new = remap (h->start, h->size, size);
+                unless ((void*)-1 == new) {
+                        h->start = new;
+                        h->size = size;
+                        if (h->size > s->maxHeapSizeSeen)
+                                s->maxHeapSizeSeen = h->size;
+                        assert (minSize <= h->size and h->size <= desired);
+                        return TRUE;
+                }
+        }
+        return FALSE;
 }
 
 /* ---------------------------------------------------------------- */
@@ -2774,95 +2776,95 @@
 /* ---------------------------------------------------------------- */
 
 static void growHeap (GC_state s, W32 desired, W32 minSize) {
-	GC_heap h;
-	struct GC_heap h2;
-	pointer old;
-	uint size;
+        GC_heap h;
+        struct GC_heap h2;
+        pointer old;
+        uint size;
 
-	h = &s->heap;
-	assert (desired >= h->size);
-	if (DEBUG_RESIZING)
-		fprintf (stderr, "Growing heap at 0x%08x of size %s to %s bytes.\n",
-				(uint)h->start,
-				uintToCommaString (h->size),
-       				uintToCommaString (desired));
-	old = s->heap.start;
-	size = s->oldGenSize;
-	assert (size <= h->size);
-	if (heapRemap (s, h, desired, minSize))
-		goto done;
-	heapShrink (s, h, size);
-	heapInit (&h2);
-	/* Allocate a space of the desired size. */
-	if (heapCreate (s, &h2, desired, minSize)) {
-		pointer from;
-		uint remaining;
-		pointer to;
+        h = &s->heap;
+        assert (desired >= h->size);
+        if (DEBUG_RESIZING)
+                fprintf (stderr, "Growing heap at 0x%08x of size %s to %s bytes.\n",
+                                (uint)h->start,
+                                uintToCommaString (h->size),
+                                uintToCommaString (desired));
+        old = s->heap.start;
+        size = s->oldGenSize;
+        assert (size <= h->size);
+        if (heapRemap (s, h, desired, minSize))
+                goto done;
+        heapShrink (s, h, size);
+        heapInit (&h2);
+        /* Allocate a space of the desired size. */
+        if (heapCreate (s, &h2, desired, minSize)) {
+                pointer from;
+                uint remaining;
+                pointer to;
 
-		from = old + size;
-		to = h2.start + size;
-		remaining = size;
-copy:			
-		assert (remaining == from - old 
-				and from >= old and to >= h2.start);
-		if (remaining < COPY_CHUNK_SIZE) {
-			copy (old, h2.start, remaining);
-		} else {
-			remaining -= COPY_CHUNK_SIZE;
-			from -= COPY_CHUNK_SIZE;
-			to -= COPY_CHUNK_SIZE;
-			copy (from, to, COPY_CHUNK_SIZE);
-			heapShrink (s, h, remaining);
-			goto copy;
-		}
-		heapRelease (s, h);
-		*h = h2;
-	} else {
-		/* Write the heap to a file and try again. */
-		int fd;
-		FILE *stream;
-		char template[80];
-		char *tmpDefault;
-		char *tmpDir;
-		char *tmpVar;
+                from = old + size;
+                to = h2.start + size;
+                remaining = size;
+copy:                   
+                assert (remaining == from - old 
+                                and from >= old and to >= h2.start);
+                if (remaining < COPY_CHUNK_SIZE) {
+                        copy (old, h2.start, remaining);
+                } else {
+                        remaining -= COPY_CHUNK_SIZE;
+                        from -= COPY_CHUNK_SIZE;
+                        to -= COPY_CHUNK_SIZE;
+                        copy (from, to, COPY_CHUNK_SIZE);
+                        heapShrink (s, h, remaining);
+                        goto copy;
+                }
+                heapRelease (s, h);
+                *h = h2;
+        } else {
+                /* Write the heap to a file and try again. */
+                int fd;
+                FILE *stream;
+                char template[80];
+                char *tmpDefault;
+                char *tmpDir;
+                char *tmpVar;
 
 #if (defined (__MSVCRT__))
-		tmpVar = "TEMP";
-		tmpDefault = "C:/WINNT/TEMP";
+                tmpVar = "TEMP";
+                tmpDefault = "C:/WINNT/TEMP";
 #else
-		tmpVar = "TMPDIR";
-		tmpDefault = "/tmp";
+                tmpVar = "TMPDIR";
+                tmpDefault = "/tmp";
 #endif
-		tmpDir = getenv (tmpVar);
-		strcpy (template, (NULL == tmpDir) ? tmpDefault : tmpDir);
-		strcat (template, "/FromSpaceXXXXXX");
-		fd = smkstemp (template);
-		sclose (fd);
-		if (s->messages)
-			fprintf (stderr, "Paging from space to %s.\n", 
-					template);
-		stream = sfopen (template, "wb");
-		sfwrite (old, 1, size, stream);
-		sfclose (stream);
-		heapRelease (s, h);
-		if (heapCreate (s, h, desired, minSize)) {
-			stream = sfopen (template, "rb");
-			sfread (h->start, 1, size, stream);
-			sfclose (stream);
-			sunlink (template);
-		} else {
-			sunlink (template);
-			if (s->messages)
-				showMem ();
-			die ("Out of memory.  Unable to allocate %s bytes.\n",
-				uintToCommaString (minSize));
-		}
-	}
+                tmpDir = getenv (tmpVar);
+                strcpy (template, (NULL == tmpDir) ? tmpDefault : tmpDir);
+                strcat (template, "/FromSpaceXXXXXX");
+                fd = smkstemp (template);
+                sclose (fd);
+                if (s->messages)
+                        fprintf (stderr, "Paging from space to %s.\n", 
+                                        template);
+                stream = sfopen (template, "wb");
+                sfwrite (old, 1, size, stream);
+                sfclose (stream);
+                heapRelease (s, h);
+                if (heapCreate (s, h, desired, minSize)) {
+                        stream = sfopen (template, "rb");
+                        sfread (h->start, 1, size, stream);
+                        sfclose (stream);
+                        sunlink (template);
+                } else {
+                        sunlink (template);
+                        if (s->messages)
+                                showMem ();
+                        die ("Out of memory.  Unable to allocate %s bytes.\n",
+                                uintToCommaString (minSize));
+                }
+        }
 done:
-	unless (old == s->heap.start) {
-		translateHeap (s, old, s->heap.start, s->oldGenSize);
-		setCardMapForMutator (s);
-	}
+        unless (old == s->heap.start) {
+                translateHeap (s, old, s->heap.start, s->oldGenSize);
+                setCardMapForMutator (s);
+        }
 }
 
 
@@ -2871,25 +2873,25 @@
 /* ---------------------------------------------------------------- */
 
 static void resizeCardMapAndCrossMap (GC_state s) {
-	if (s->mutatorMarksCards 
-		and s->cardMapSize != 
-			align (divCardSize (s, s->heap.size), s->pageSize)) {
-		pointer oldCardMap;
-		pointer oldCrossMap;
-		uint oldCardMapSize;
-		uint oldCrossMapSize;
+        if (s->mutatorMarksCards 
+                and s->cardMapSize != 
+                        align (divCardSize (s, s->heap.size), s->pageSize)) {
+                pointer oldCardMap;
+                uchar *oldCrossMap;
+                uint oldCardMapSize;
+                uint oldCrossMapSize;
 
-		oldCardMap = s->cardMap;
-		oldCardMapSize = s->cardMapSize;
-		oldCrossMap = s->crossMap;
-		oldCrossMapSize = s->crossMapSize;
-		createCardMapAndCrossMap (s);
-		copy (oldCrossMap, s->crossMap,
-			min (s->crossMapSize, oldCrossMapSize));
-		if (DEBUG_MEM)
-			fprintf (stderr, "Releasing card/cross map.\n");
-		GC_release (oldCardMap, oldCardMapSize + oldCrossMapSize);
-	}
+                oldCardMap = s->cardMap;
+                oldCardMapSize = s->cardMapSize;
+                oldCrossMap = s->crossMap;
+                oldCrossMapSize = s->crossMapSize;
+                createCardMapAndCrossMap (s);
+                copy ((pointer)oldCrossMap, (pointer)s->crossMap,
+                        min (s->crossMapSize, oldCrossMapSize));
+                if (DEBUG_MEM)
+                        fprintf (stderr, "Releasing card/cross map.\n");
+                GC_release (oldCardMap, oldCardMapSize + oldCrossMapSize);
+        }
 }
 
 /* ---------------------------------------------------------------- */
@@ -2899,64 +2901,64 @@
  * available in from space.
  */
 static void resizeHeap (GC_state s, W64 need) {
-	W32 desired;
+        W32 desired;
 
-	if (DEBUG_RESIZING)
-		fprintf (stderr, "resizeHeap  need = %s fromSize = %s\n",
-				ullongToCommaString (need), 
-				uintToCommaString (s->heap.size));
-	desired = heapDesiredSize (s, need, s->heap.size);
-	assert (need <= desired);
-	if (desired <= s->heap.size)
-		heapShrink (s, &s->heap, desired);
-	else {
-		heapRelease (s, &s->heap2);
-		growHeap (s, desired, need);
-	}
-	resizeCardMapAndCrossMap (s);
-	assert (s->heap.size >= need);
+        if (DEBUG_RESIZING)
+                fprintf (stderr, "resizeHeap  need = %s fromSize = %s\n",
+                                ullongToCommaString (need), 
+                                uintToCommaString (s->heap.size));
+        desired = heapDesiredSize (s, need, s->heap.size);
+        assert (need <= desired);
+        if (desired <= s->heap.size)
+                heapShrink (s, &s->heap, desired);
+        else {
+                heapRelease (s, &s->heap2);
+                growHeap (s, desired, need);
+        }
+        resizeCardMapAndCrossMap (s);
+        assert (s->heap.size >= need);
 }
 
 /* Guarantee that heap2 is either the same size as heap or is unmapped. */
 static void resizeHeap2 (GC_state s) {
-	uint size;
-	uint size2;
+        uint size;
+        uint size2;
 
-	size = s->heap.size;
-	size2 = s->heap2.size;
-	if (DEBUG_RESIZING)
-		fprintf (stderr, "resizeHeap2\n");
-	if (0 == size2)
-		return;
-	if (2 * size > s->ram)
-		/* Holding on to heap2 might cause paging.  So don't. */
-		heapRelease (s, &s->heap2);
-	else if (size2 < size) {
-		unless (heapRemap (s, &s->heap2, size, size))
-			heapRelease (s, &s->heap2);
+        size = s->heap.size;
+        size2 = s->heap2.size;
+        if (DEBUG_RESIZING)
+                fprintf (stderr, "resizeHeap2\n");
+        if (0 == size2)
+                return;
+        if (2 * size > s->ram)
+                /* Holding on to heap2 might cause paging.  So don't. */
+                heapRelease (s, &s->heap2);
+        else if (size2 < size) {
+                unless (heapRemap (s, &s->heap2, size, size))
+                        heapRelease (s, &s->heap2);
         } else if (size2 > size)
-		heapShrink (s, &s->heap2, size);
-	assert (0 == s->heap2.size or s->heap.size == s->heap2.size);
+                heapShrink (s, &s->heap2, size);
+        assert (0 == s->heap2.size or s->heap.size == s->heap2.size);
 }
 
 static inline uint growStackSize (GC_state s) {
-	return max (2 * s->currentThread->stack->reserved, 
-			stackNeedsReserved (s, s->currentThread->stack));
+        return max (2 * s->currentThread->stack->reserved, 
+                        stackNeedsReserved (s, s->currentThread->stack));
 }
 
 static void growStack (GC_state s) {
-	uint size;
-	GC_stack stack;
+        uint size;
+        GC_stack stack;
 
-	size = growStackSize (s);
-	if (DEBUG_STACKS or s->messages)
-		fprintf (stderr, "Growing stack to size %s.\n",
-				uintToCommaString (stackBytes (s, size)));
-	assert (hasBytesFree (s, stackBytes (s, size), 0));
-	stack = newStack (s, size, TRUE);
-	stackCopy (s, s->currentThread->stack, stack);
-	s->currentThread->stack = stack;
-	markCard (s, (pointer)s->currentThread);
+        size = growStackSize (s);
+        if (DEBUG_STACKS or s->messages)
+                fprintf (stderr, "Growing stack to size %s.\n",
+                                uintToCommaString (stackBytes (s, size)));
+        assert (hasBytesFree (s, stackBytes (s, size), 0));
+        stack = newStack (s, size, TRUE);
+        stackCopy (s, s->currentThread->stack, stack);
+        s->currentThread->stack = stack;
+        markCard (s, (pointer)s->currentThread);
 }
 
 /* ---------------------------------------------------------------- */
@@ -2964,169 +2966,158 @@
 /* ---------------------------------------------------------------- */
 
 static bool heapAllocateSecondSemi (GC_state s, W32 size) {
-	if ((s->fixedHeap > 0 and s->heap.size + size > s->fixedHeap)
-		or (s->maxHeap > 0 and s->heap.size + size > s->maxHeap))
-		return FALSE;
-	return heapCreate (s, &s->heap2, size, s->oldGenSize);
+        if ((s->fixedHeap > 0 and s->heap.size + size > s->fixedHeap)
+                or (s->maxHeap > 0 and s->heap.size + size > s->maxHeap))
+                return FALSE;
+        return heapCreate (s, &s->heap2, size, s->oldGenSize);
 }
 
 static void majorGC (GC_state s, W32 bytesRequested, bool mayResize) {
-	s->numMinorsSinceLastMajor = 0;
-	if (0 < (s->numCopyingGCs + s->numMarkCompactGCs)
-		and ((float)s->numHashConsGCs 
-			/ (float)(s->numCopyingGCs + s->numMarkCompactGCs)
-			< s->hashConsFrequency))
-		s->hashConsDuringGC = TRUE;
+        s->numMinorsSinceLastMajor = 0;
+        if (0 < (s->numCopyingGCs + s->numMarkCompactGCs)
+                and ((float)s->numHashConsGCs 
+                        / (float)(s->numCopyingGCs + s->numMarkCompactGCs)
+                        < s->hashConsFrequency))
+                s->hashConsDuringGC = TRUE;
         if ((not FORCE_MARK_COMPACT)
-		and not s->hashConsDuringGC // only markCompact can hash cons
- 		and s->heap.size < s->ram
-		and (not heapIsInit (&s->heap2)
-			or heapAllocateSecondSemi (s, heapDesiredSize (s, (W64)s->bytesLive + bytesRequested, 0))))
-		cheneyCopy (s);
-	else
-		markCompact (s);
-	s->hashConsDuringGC = FALSE;
-	s->bytesLive = s->oldGenSize;
-	if (s->bytesLive > s->maxBytesLive)
-		s->maxBytesLive = s->bytesLive;
-	/* Notice that the s->bytesLive below is different than the s->bytesLive
-	 * used as an argument to heapAllocateSecondSemi above.  Above, it was 
+                and not s->hashConsDuringGC // only markCompact can hash cons
+                and s->heap.size < s->ram
+                and (not heapIsInit (&s->heap2)
+                        or heapAllocateSecondSemi (s, heapDesiredSize (s, (W64)s->bytesLive + bytesRequested, 0))))
+                cheneyCopy (s);
+        else
+                markCompact (s);
+        s->hashConsDuringGC = FALSE;
+        s->bytesLive = s->oldGenSize;
+        if (s->bytesLive > s->maxBytesLive)
+                s->maxBytesLive = s->bytesLive;
+        /* Notice that the s->bytesLive below is different than the s->bytesLive
+         * used as an argument to heapAllocateSecondSemi above.  Above, it was 
          * an estimate.  Here, it is exactly how much was live after the GC.
-	 */
-	if (mayResize)
-		resizeHeap (s, (W64)s->bytesLive + bytesRequested);
-	resizeHeap2 (s);
-	assert (s->oldGenSize + bytesRequested <= s->heap.size);
+         */
+        if (mayResize)
+                resizeHeap (s, (W64)s->bytesLive + bytesRequested);
+        resizeHeap2 (s);
+        assert (s->oldGenSize + bytesRequested <= s->heap.size);
 }
 
 static inline void enterGC (GC_state s) {
-	if (s->profilingIsOn) {
-		/* We don't need to profileEnter for count profiling because it
-		 * has already bumped the counter.  If we did allow the bump,
-		 * then the count would look like function(s) had run an extra
- 		 * time.
-		 */  
-		if (s->profileStack and not (PROFILE_COUNT == s->profileKind))
-			GC_profileEnter (s);
-		s->amInGC = TRUE;
-	}
+        if (s->profilingIsOn) {
+                /* We don't need to profileEnter for count profiling because it
+                 * has already bumped the counter.  If we did allow the bump,
+                 * then the count would look like function(s) had run an extra
+                 * time.
+                 */  
+                if (s->profileStack and not (PROFILE_COUNT == s->profileKind))
+                        GC_profileEnter (s);
+                s->amInGC = TRUE;
+        }
 }
 
 static inline void leaveGC (GC_state s) {
-	if (s->profilingIsOn) {
-		if (s->profileStack and not (PROFILE_COUNT == s->profileKind))
-			GC_profileLeave (s);
-		s->amInGC = FALSE;
-	}
+        if (s->profilingIsOn) {
+                if (s->profileStack and not (PROFILE_COUNT == s->profileKind))
+                        GC_profileLeave (s);
+                s->amInGC = FALSE;
+        }
 }
 
-/* MLton_Rusage_ru is the only code outside of gc.c that uses gcState.ru_gc.
- * So, we only need to keep gcTime if gc.c needs it due to s->summary or 
- * s->messages, or if MLton_Rusage_ru is called.  Because MLton_Rusage_ru is
- * defined in a file all to itself (basis/MLton/rusage.c), it is called iff it
- * is linked in, which we can test via a weak symbol.
- */
-#if SUPPORTS_WEAK
-void MLton_Rusage_ru () __attribute__ ((weak));
-#else
-void MLton_Rusage_ru ();
-#endif
 static inline bool needGCTime (GC_state s) {
-	return DEBUG or s->summary or s->messages or (0 != MLton_Rusage_ru);
+        return DEBUG or s->summary or s->messages or s->rusageMeasureGC;
 }
 
 static void doGC (GC_state s, 
-			W32 oldGenBytesRequested,
-			W32 nurseryBytesRequested, 
-			bool forceMajor,
-			bool mayResize) {
-	uint gcTime;
-	bool stackTopOk;
-	W64 stackBytesRequested;
-	struct rusage ru_start;
-	W64 totalBytesRequested;
-	
-	enterGC (s);
-	if (DEBUG or s->messages)
-		fprintf (stderr, "Starting gc.  Request %s nursery bytes and %s old gen bytes.\n",
-				uintToCommaString (nurseryBytesRequested),
-				uintToCommaString (oldGenBytesRequested));
-	assert (invariant (s));
-	if (needGCTime (s))
-		startTiming (&ru_start);
-	minorGC (s);
-	stackTopOk = mutatorStackInvariant (s);
-	stackBytesRequested = 
-		stackTopOk ? 0 : stackBytes (s, growStackSize (s));
-	totalBytesRequested = 
-		(W64)oldGenBytesRequested 
-		+ stackBytesRequested
-		+ nurseryBytesRequested;
-	if (forceMajor 
-		or totalBytesRequested > s->heap.size - s->oldGenSize)
-		majorGC (s, totalBytesRequested, mayResize);
-	setNursery (s, oldGenBytesRequested + stackBytesRequested,
-			nurseryBytesRequested);
-	assert (hasBytesFree (s, oldGenBytesRequested + stackBytesRequested,
-					nurseryBytesRequested));
-	unless (stackTopOk)
-		growStack (s);
-	setStack (s);
-	if (needGCTime (s)) {
-		gcTime = stopTiming (&ru_start, &s->ru_gc);
-		s->maxPause = max (s->maxPause, gcTime);
-	} else
-		gcTime = 0;  /* Assign gcTime to quell gcc warning. */
-	if (DEBUG or s->messages) {
-		fprintf (stderr, "Finished gc.\n");
-		fprintf (stderr, "time: %s ms\n", intToCommaString (gcTime));
-		fprintf (stderr, "old gen size: %s bytes (%.1f%%)\n", 
-				intToCommaString (s->oldGenSize),
-				100.0 * ((double) s->oldGenSize) 
-					/ s->heap.size);
-	}
-	/* Send a GC signal. */
-	if (s->handleGCSignal and s->signalHandler != BOGUS_THREAD) {
-		if (DEBUG_SIGNALS)
-			fprintf (stderr, "GC Signal pending.\n");
-		s->gcSignalIsPending = TRUE;
-		unless (s->inSignalHandler) 
-			s->signalIsPending = TRUE;
-	}
-	if (DEBUG) 
-		GC_display (s, stderr);
-	assert (hasBytesFree (s, oldGenBytesRequested, nurseryBytesRequested));
-	assert (invariant (s));
-	leaveGC (s);
+                        W32 oldGenBytesRequested,
+                        W32 nurseryBytesRequested, 
+                        bool forceMajor,
+                        bool mayResize) {
+        uint gcTime;
+        bool stackTopOk;
+        W64 stackBytesRequested;
+        struct rusage ru_start;
+        W64 totalBytesRequested;
+        
+        enterGC (s);
+        if (DEBUG or s->messages)
+                fprintf (stderr, "Starting gc.  Request %s nursery bytes and %s old gen bytes.\n",
+                                uintToCommaString (nurseryBytesRequested),
+                                uintToCommaString (oldGenBytesRequested));
+        assert (invariant (s));
+        if (needGCTime (s))
+                startTiming (&ru_start);
+        minorGC (s);
+        stackTopOk = mutatorStackInvariant (s);
+        stackBytesRequested = 
+                stackTopOk ? 0 : stackBytes (s, growStackSize (s));
+        totalBytesRequested = 
+                (W64)oldGenBytesRequested 
+                + stackBytesRequested
+                + nurseryBytesRequested;
+        if (forceMajor 
+                or totalBytesRequested > s->heap.size - s->oldGenSize)
+                majorGC (s, totalBytesRequested, mayResize);
+        setNursery (s, oldGenBytesRequested + stackBytesRequested,
+                        nurseryBytesRequested);
+        assert (hasBytesFree (s, oldGenBytesRequested + stackBytesRequested,
+                                        nurseryBytesRequested));
+        unless (stackTopOk)
+                growStack (s);
+        setStack (s);
+        if (needGCTime (s)) {
+                gcTime = stopTiming (&ru_start, &s->ru_gc);
+                s->maxPause = max (s->maxPause, gcTime);
+        } else
+                gcTime = 0;  /* Assign gcTime to quell gcc warning. */
+        if (DEBUG or s->messages) {
+                fprintf (stderr, "Finished gc.\n");
+                fprintf (stderr, "time: %s ms\n", intToCommaString (gcTime));
+                fprintf (stderr, "old gen size: %s bytes (%.1f%%)\n", 
+                                intToCommaString (s->oldGenSize),
+                                100.0 * ((double) s->oldGenSize) 
+                                        / s->heap.size);
+        }
+        /* Send a GC signal. */
+        if (s->handleGCSignal and s->signalHandler != BOGUS_THREAD) {
+                if (DEBUG_SIGNALS)
+                        fprintf (stderr, "GC Signal pending.\n");
+                s->gcSignalIsPending = TRUE;
+                unless (s->inSignalHandler) 
+                        s->signalIsPending = TRUE;
+        }
+        if (DEBUG) 
+                GC_display (s, stderr);
+        assert (hasBytesFree (s, oldGenBytesRequested, nurseryBytesRequested));
+        assert (invariant (s));
+        leaveGC (s);
 }
 
 static inline void ensureMutatorInvariant (GC_state s, bool force) {
-	if (force
-		or not (mutatorFrontierInvariant(s))
-		or not (mutatorStackInvariant(s))) {
-		/* This GC will grow the stack, if necessary. */
-		doGC (s, 0, s->currentThread->bytesNeeded, force, TRUE);
-	}
-	assert (mutatorFrontierInvariant(s));
-	assert (mutatorStackInvariant(s));
+        if (force
+                or not (mutatorFrontierInvariant(s))
+                or not (mutatorStackInvariant(s))) {
+                /* This GC will grow the stack, if necessary. */
+                doGC (s, 0, s->currentThread->bytesNeeded, force, TRUE);
+        }
+        assert (mutatorFrontierInvariant(s));
+        assert (mutatorStackInvariant(s));
 }
 
 /* ensureFree (s, b) ensures that upon return
  *      b <= s->limitPlusSlop - s->frontier
  */
 static inline void ensureFree (GC_state s, uint b) {
-	assert (s->frontier <= s->limitPlusSlop);
-	if (b > s->limitPlusSlop - s->frontier)
-		doGC (s, 0, b, FALSE, TRUE);
-	assert (b <= s->limitPlusSlop - s->frontier);
+        assert (s->frontier <= s->limitPlusSlop);
+        if (b > s->limitPlusSlop - s->frontier)
+                doGC (s, 0, b, FALSE, TRUE);
+        assert (b <= s->limitPlusSlop - s->frontier);
 }
 
 static void switchToThread (GC_state s, GC_thread t) {
-	if (DEBUG_THREADS)
-		fprintf (stderr, "switchToThread (0x%08x)  used = %u  reserved = %u\n", 
-				(uint)t, t->stack->used, t->stack->reserved);
-	s->currentThread = t;
-	setStack (s);
+        if (DEBUG_THREADS)
+                fprintf (stderr, "switchToThread (0x%08x)  used = %u  reserved = %u\n", 
+                                (uint)t, t->stack->used, t->stack->reserved);
+        s->currentThread = t;
+        setStack (s);
 }
 
 /* GC_startHandler does not do an enter()/leave(), even though it is exported.
@@ -3138,91 +3129,91 @@
  * compiling with COMPILE_FAST, they may appear out of order.
  */
 void GC_startHandler (GC_state s) {
-	/* Switch to the signal handler thread. */
-	if (DEBUG_SIGNALS) {
-		fprintf (stderr, "switching to signal handler\n");
-		GC_display (s, stderr);
-	}
-	assert (s->canHandle == 1);
-	assert (s->signalIsPending);
-	s->signalIsPending = FALSE;
-	s->inSignalHandler = TRUE;
-	s->savedThread = s->currentThread;
-	/* Set s->canHandle to 2 when switching to the signal handler thread;
-	 * leaving the runtime will decrement s->canHandle to 1,
+        /* Switch to the signal handler thread. */
+        if (DEBUG_SIGNALS) {
+                fprintf (stderr, "switching to signal handler\n");
+                GC_display (s, stderr);
+        }
+        assert (s->canHandle == 1);
+        assert (s->signalIsPending);
+        s->signalIsPending = FALSE;
+        s->inSignalHandler = TRUE;
+        s->savedThread = s->currentThread;
+        /* Set s->canHandle to 2 when switching to the signal handler thread;
+         * leaving the runtime will decrement s->canHandle to 1,
          * the signal handler will then run atomically and will finish by
          * switching to the thread to continue with, which will decrement
-	 * s->canHandle to 0.
- 	 */
-	s->canHandle = 2;
+         * s->canHandle to 0.
+         */
+        s->canHandle = 2;
 }
 
 static inline void maybeSwitchToHandler (GC_state s) {
-	if (s->canHandle == 1 and s->signalIsPending) {
-		GC_startHandler (s);
-		switchToThread (s, s->signalHandler);
-	}
+        if (s->canHandle == 1 and s->signalIsPending) {
+                GC_startHandler (s);
+                switchToThread (s, s->signalHandler);
+        }
 }
 
 void GC_switchToThread (GC_state s, GC_thread t, uint ensureBytesFree) {
-	if (DEBUG_THREADS)
-		fprintf (stderr, "GC_switchToThread (0x%08x, %u)\n", (uint)t, ensureBytesFree);
-	if (FALSE) {
-		/* This branch is slower than the else branch, especially 
-		 * when debugging is turned on, because it does an invariant
-		 * check on every thread switch.
-		 * So, we'll stick with the else branch for now.
-		 */
-	 	enter (s);
-		s->currentThread->bytesNeeded = ensureBytesFree;
-		switchToThread (s, t);
-		s->canHandle--;
-		maybeSwitchToHandler (s);
-		ensureMutatorInvariant (s, FALSE);
-		assert (mutatorFrontierInvariant(s));
-		assert (mutatorStackInvariant(s));
-	 	leave (s);
-	} else {
-		/* BEGIN: enter(s); */
-		s->currentThread->stack->used = currentStackUsed (s);
-		s->currentThread->exnStack = s->exnStack;
-		atomicBegin (s);
-		/* END: enter(s); */
-		s->currentThread->bytesNeeded = ensureBytesFree;
-		switchToThread (s, t);
-		s->canHandle--;
-		maybeSwitchToHandler (s);
-		/* BEGIN: ensureMutatorInvariant */
-		if (not (mutatorFrontierInvariant(s))
-			or not (mutatorStackInvariant(s))) {
-			/* This GC will grow the stack, if necessary. */
-			doGC (s, 0, s->currentThread->bytesNeeded, FALSE, TRUE);
-		} 
-		/* END: ensureMutatorInvariant */
-       		/* BEGIN: leave(s); */
-	       	atomicEnd (s);
-		/* END: leave(s); */
-	}
-	assert (mutatorFrontierInvariant(s));
-	assert (mutatorStackInvariant(s));
+        if (DEBUG_THREADS)
+                fprintf (stderr, "GC_switchToThread (0x%08x, %u)\n", (uint)t, ensureBytesFree);
+        if (FALSE) {
+                /* This branch is slower than the else branch, especially 
+                 * when debugging is turned on, because it does an invariant
+                 * check on every thread switch.
+                 * So, we'll stick with the else branch for now.
+                 */
+                enter (s);
+                s->currentThread->bytesNeeded = ensureBytesFree;
+                switchToThread (s, t);
+                s->canHandle--;
+                maybeSwitchToHandler (s);
+                ensureMutatorInvariant (s, FALSE);
+                assert (mutatorFrontierInvariant(s));
+                assert (mutatorStackInvariant(s));
+                leave (s);
+        } else {
+                /* BEGIN: enter(s); */
+                s->currentThread->stack->used = currentStackUsed (s);
+                s->currentThread->exnStack = s->exnStack;
+                atomicBegin (s);
+                /* END: enter(s); */
+                s->currentThread->bytesNeeded = ensureBytesFree;
+                switchToThread (s, t);
+                s->canHandle--;
+                maybeSwitchToHandler (s);
+                /* BEGIN: ensureMutatorInvariant */
+                if (not (mutatorFrontierInvariant(s))
+                        or not (mutatorStackInvariant(s))) {
+                        /* This GC will grow the stack, if necessary. */
+                        doGC (s, 0, s->currentThread->bytesNeeded, FALSE, TRUE);
+                } 
+                /* END: ensureMutatorInvariant */
+                /* BEGIN: leave(s); */
+                atomicEnd (s);
+                /* END: leave(s); */
+        }
+        assert (mutatorFrontierInvariant(s));
+        assert (mutatorStackInvariant(s));
 }
 
 void GC_gc (GC_state s, uint bytesRequested, bool force,
-		string file, int line) {
-	if (DEBUG or s->messages)
-		fprintf (stderr, "%s %d: GC_gc\n", file, line);
-	enter (s);
-	/* When the mutator requests zero bytes, it may actually need as much
-	 * as LIMIT_SLOP.
-	 */
-	if (0 == bytesRequested)
-		bytesRequested = LIMIT_SLOP;
-	s->currentThread->bytesNeeded = bytesRequested;
- 	maybeSwitchToHandler (s);
-	ensureMutatorInvariant (s, force);
-	assert (mutatorFrontierInvariant(s));
-	assert (mutatorStackInvariant(s));
-	leave (s);
+                string file, int line) {
+        if (DEBUG or s->messages)
+                fprintf (stderr, "%s %d: GC_gc\n", file, line);
+        enter (s);
+        /* When the mutator requests zero bytes, it may actually need as much
+         * as LIMIT_SLOP.
+         */
+        if (0 == bytesRequested)
+                bytesRequested = LIMIT_SLOP;
+        s->currentThread->bytesNeeded = bytesRequested;
+        maybeSwitchToHandler (s);
+        ensureMutatorInvariant (s, force);
+        assert (mutatorFrontierInvariant(s));
+        assert (mutatorStackInvariant(s));
+        leave (s);
 }
 
 /* ---------------------------------------------------------------- */
@@ -3230,202 +3221,202 @@
 /* ---------------------------------------------------------------- */
 
 pointer GC_arrayAllocate (GC_state s, W32 ensureBytesFree, W32 numElts, 
-				W32 header) {
-	W64 arraySize64;
-	W32 arraySize;
-	uint eltSize;
-	W32 *frontier;
-	Bool hasIdentity;
-	Pointer last;
-	uint numPointers;
-	uint numNonPointers;
-	pointer res;
-	uint tag;
+                                W32 header) {
+        W64 arraySize64;
+        W32 arraySize;
+        uint eltSize;
+        W32 *frontier;
+        Bool hasIdentity;
+        Pointer last;
+        uint numPointers;
+        uint numNonPointers;
+        pointer res;
+        uint tag;
 
-	SPLIT_HEADER();
-	if (DEBUG)
-		fprintf (stderr, "GC_arrayAllocate (0x%08x, %u, %u, 0x%08x)\n",
-				(uint)s, (uint)ensureBytesFree, 
-				(uint)numElts, (uint)header);
-	eltSize = numPointers * POINTER_SIZE + numNonPointers;
-	arraySize64 = 
-		w64align ((W64)eltSize * (W64)numElts + GC_ARRAY_HEADER_SIZE,
-				s->alignment);
-	if (arraySize64 >= 0x100000000llu)
-		die ("Out of memory: cannot allocate array with %s bytes.",
-			ullongToCommaString (arraySize64));
-	arraySize = (W32)arraySize64;
-	if (arraySize < GC_ARRAY_HEADER_SIZE + WORD_SIZE)
-		/* Create space for forwarding pointer. */
- 		arraySize = GC_ARRAY_HEADER_SIZE + WORD_SIZE;
-	if (DEBUG_ARRAY)
-		fprintf (stderr, "array with %s elts of size %u and total size %s.  Ensure %s bytes free.\n",
-			uintToCommaString (numElts), 
-			(uint)eltSize, 
-			uintToCommaString (arraySize),
-			uintToCommaString (ensureBytesFree));
-	if (arraySize >= s->oldGenArraySize) {
-		enter (s);
-		doGC (s,  arraySize, ensureBytesFree, FALSE, TRUE);
-		leave (s);
-		frontier = (W32*)(s->heap.start + s->oldGenSize);
-		last = (pointer)frontier + arraySize;
-		s->oldGenSize += arraySize;
-		s->bytesAllocated += arraySize;
-	} else {
-		W32 require;
+        SPLIT_HEADER();
+        if (DEBUG)
+                fprintf (stderr, "GC_arrayAllocate (0x%08x, %u, %u, 0x%08x)\n",
+                                (uint)s, (uint)ensureBytesFree, 
+                                (uint)numElts, (uint)header);
+        eltSize = numPointers * POINTER_SIZE + numNonPointers;
+        arraySize64 = 
+                w64align ((W64)eltSize * (W64)numElts + GC_ARRAY_HEADER_SIZE,
+                                s->alignment);
+        if (arraySize64 >= 0x100000000llu)
+                die ("Out of memory: cannot allocate array with %s bytes.",
+                        ullongToCommaString (arraySize64));
+        arraySize = (W32)arraySize64;
+        if (arraySize < GC_ARRAY_HEADER_SIZE + WORD_SIZE)
+                /* Create space for forwarding pointer. */
+                arraySize = GC_ARRAY_HEADER_SIZE + WORD_SIZE;
+        if (DEBUG_ARRAY)
+                fprintf (stderr, "array with %s elts of size %u and total size %s.  Ensure %s bytes free.\n",
+                        uintToCommaString (numElts), 
+                        (uint)eltSize, 
+                        uintToCommaString (arraySize),
+                        uintToCommaString (ensureBytesFree));
+        if (arraySize >= s->oldGenArraySize) {
+                enter (s);
+                doGC (s,  arraySize, ensureBytesFree, FALSE, TRUE);
+                leave (s);
+                frontier = (W32*)(s->heap.start + s->oldGenSize);
+                last = (pointer)frontier + arraySize;
+                s->oldGenSize += arraySize;
+                s->bytesAllocated += arraySize;
+        } else {
+                W32 require;
 
-		require = arraySize + ensureBytesFree;
-		if (require > s->limitPlusSlop - s->frontier) {
-			enter (s);
-			doGC (s, 0, require, FALSE, TRUE);
-			leave (s);
-		}
-		frontier = (W32*)s->frontier;
-		last = (pointer)frontier + arraySize;
-		assert (isAlignedFrontier (s, last));
-		s->frontier = last;
-	}
-	*frontier++ = 0; /* counter word */
-	*frontier++ = numElts;
-	*frontier++ = header;
-	res = (pointer)frontier;
-	/* Initialize all pointers with BOGUS_POINTER. */
-	if (1 <= numPointers and 0 < numElts) {
-		pointer p;
+                require = arraySize + ensureBytesFree;
+                if (require > s->limitPlusSlop - s->frontier) {
+                        enter (s);
+                        doGC (s, 0, require, FALSE, TRUE);
+                        leave (s);
+                }
+                frontier = (W32*)s->frontier;
+                last = (pointer)frontier + arraySize;
+                assert (isAlignedFrontier (s, last));
+                s->frontier = last;
+        }
+        *frontier++ = 0; /* counter word */
+        *frontier++ = numElts;
+        *frontier++ = header;
+        res = (pointer)frontier;
+        /* Initialize all pointers with BOGUS_POINTER. */
+        if (1 <= numPointers and 0 < numElts) {
+                pointer p;
 
-		if (0 == numNonPointers)
-			for (p = (pointer)frontier; 
-				p < last; 
-				p += POINTER_SIZE)
-				*(Pointer*)p = (Pointer)BOGUS_POINTER;
-		else
-			for (p = (Pointer)frontier; p < last; ) {
-				pointer next;
+                if (0 == numNonPointers)
+                        for (p = (pointer)frontier; 
+                                p < last; 
+                                p += POINTER_SIZE)
+                                *(Pointer*)p = (Pointer)BOGUS_POINTER;
+                else
+                        for (p = (Pointer)frontier; p < last; ) {
+                                pointer next;
 
-				p += numNonPointers;
-				next = p + numPointers * POINTER_SIZE;
-				assert (next <= last);
-				while (p < next) {
-					*(Pointer*)p = (Pointer)BOGUS_POINTER;
-					p += POINTER_SIZE;
-				}	
-			}
-	}
-	GC_profileAllocInc (s, arraySize);
-	if (DEBUG_ARRAY) {
-		fprintf (stderr, "GC_arrayAllocate done.  res = 0x%x  frontier = 0x%x\n",
-				(uint)res, (uint)s->frontier);
-		GC_display (s, stderr);
-	}
-	assert (ensureBytesFree <= s->limitPlusSlop - s->frontier);
-	/* Unfortunately, the invariant isn't quite true here, because unless we
- 	 * did the GC, we never set s->currentThread->stack->used to reflect
-	 * what the mutator did with stackTop.
- 	 */
-	return res;
-}	
+                                p += numNonPointers;
+                                next = p + numPointers * POINTER_SIZE;
+                                assert (next <= last);
+                                while (p < next) {
+                                        *(Pointer*)p = (Pointer)BOGUS_POINTER;
+                                        p += POINTER_SIZE;
+                                }       
+                        }
+        }
+        GC_profileAllocInc (s, arraySize);
+        if (DEBUG_ARRAY) {
+                fprintf (stderr, "GC_arrayAllocate done.  res = 0x%x  frontier = 0x%x\n",
+                                (uint)res, (uint)s->frontier);
+                GC_display (s, stderr);
+        }
+        assert (ensureBytesFree <= s->limitPlusSlop - s->frontier);
+        /* Unfortunately, the invariant isn't quite true here, because unless we
+         * did the GC, we never set s->currentThread->stack->used to reflect
+         * what the mutator did with stackTop.
+         */
+        return res;
+}       
 
 /* ---------------------------------------------------------------- */
 /*                             Threads                              */
 /* ---------------------------------------------------------------- */
 
 static inline uint threadBytes (GC_state s) {
-	uint res;
+        uint res;
 
-	res = GC_NORMAL_HEADER_SIZE + sizeof (struct GC_thread);
-	/* The following assert depends on struct GC_thread being the right
- 	 * size.  Right now, it happens that res = 16, which is aligned mod 4
-	 * and mod 8, which is all that we need.  If the struct every changes
-	 * (possible) or we need more alignment (doubtful), we may need to put
-	 * some padding at the beginning.
-	 */
-	assert (isAligned (res, s->alignment));
-	return res;
+        res = GC_NORMAL_HEADER_SIZE + sizeof (struct GC_thread);
+        /* The following assert depends on struct GC_thread being the right
+         * size.  Right now, it happens that res = 16, which is aligned mod 4
+         * and mod 8, which is all that we need.  If the struct every changes
+         * (possible) or we need more alignment (doubtful), we may need to put
+         * some padding at the beginning.
+         */
+        assert (isAligned (res, s->alignment));
+        return res;
 }
 
 static GC_thread newThreadOfSize (GC_state s, uint stackSize) {
-	GC_stack stack;
-	GC_thread t;
+        GC_stack stack;
+        GC_thread t;
 
-	ensureFree (s, stackBytes (s, stackSize) + threadBytes (s));
-	stack = newStack (s, stackSize, FALSE);
-	t = (GC_thread) object (s, THREAD_HEADER, threadBytes (s), FALSE, FALSE);
-	t->bytesNeeded = 0;
-	t->exnStack = BOGUS_EXN_STACK;
-	t->stack = stack;
-	if (DEBUG_THREADS)
-		fprintf (stderr, "0x%x = newThreadOfSize (%u)\n",
-				(uint)t, stackSize);;
-	return t;
+        ensureFree (s, stackBytes (s, stackSize) + threadBytes (s));
+        stack = newStack (s, stackSize, FALSE);
+        t = (GC_thread) object (s, THREAD_HEADER, threadBytes (s), FALSE, FALSE);
+        t->bytesNeeded = 0;
+        t->exnStack = BOGUS_EXN_STACK;
+        t->stack = stack;
+        if (DEBUG_THREADS)
+                fprintf (stderr, "0x%x = newThreadOfSize (%u)\n",
+                                (uint)t, stackSize);;
+        return t;
 }
 
 static GC_thread copyThread (GC_state s, GC_thread from, uint size) {
-	GC_thread to;
+        GC_thread to;
 
-	if (DEBUG_THREADS)
-		fprintf (stderr, "copyThread (0x%08x)\n", (uint)from);
-	/* newThreadOfSize may do a GC, which invalidates from.  
-	 * Hence we need to stash from where the GC can find it.
-	 */
-	s->savedThread = from;
-	to = newThreadOfSize (s, size);	
-	from = s->savedThread;
-	s->savedThread = BOGUS_THREAD;
-	if (DEBUG_THREADS) {
-		fprintf (stderr, "free space = %u\n",
-				s->limitPlusSlop - s->frontier);
-		fprintf (stderr, "0x%08x = copyThread (0x%08x)\n", 
-				(uint)to, (uint)from);
-	}
-	stackCopy (s, from->stack, to->stack);
-	to->exnStack = from->exnStack;
-	return to;
+        if (DEBUG_THREADS)
+                fprintf (stderr, "copyThread (0x%08x)\n", (uint)from);
+        /* newThreadOfSize may do a GC, which invalidates from.  
+         * Hence we need to stash from where the GC can find it.
+         */
+        s->savedThread = from;
+        to = newThreadOfSize (s, size); 
+        from = s->savedThread;
+        s->savedThread = BOGUS_THREAD;
+        if (DEBUG_THREADS) {
+                fprintf (stderr, "free space = %u\n",
+                                s->limitPlusSlop - s->frontier);
+                fprintf (stderr, "0x%08x = copyThread (0x%08x)\n", 
+                                (uint)to, (uint)from);
+        }
+        stackCopy (s, from->stack, to->stack);
+        to->exnStack = from->exnStack;
+        return to;
 }
 
 void GC_copyCurrentThread (GC_state s) {
-	GC_thread res;
-	GC_thread t;
-	
-	if (DEBUG_THREADS)
-		fprintf (stderr, "GC_copyCurrentThread\n");
-	enter (s);
-	t = s->currentThread;
-	res = copyThread (s, t, t->stack->used);
+        GC_thread res;
+        GC_thread t;
+        
+        if (DEBUG_THREADS)
+                fprintf (stderr, "GC_copyCurrentThread\n");
+        enter (s);
+        t = s->currentThread;
+        res = copyThread (s, t, t->stack->used);
 /* The following assert is no longer true, since alignment restrictions can force
  * the reserved to be slightly larger than the used.
  */
-/*	assert (res->stack->reserved == res->stack->used); */
-	assert (res->stack->reserved >= res->stack->used);
-	leave (s);
-	if (DEBUG_THREADS)
-		fprintf (stderr, "0x%08x = GC_copyCurrentThread\n", (uint)res);
-	s->savedThread = res;
+/*      assert (res->stack->reserved == res->stack->used); */
+        assert (res->stack->reserved >= res->stack->used);
+        leave (s);
+        if (DEBUG_THREADS)
+                fprintf (stderr, "0x%08x = GC_copyCurrentThread\n", (uint)res);
+        s->savedThread = res;
 }
 
 pointer GC_copyThread (GC_state s, pointer thread) {
-	GC_thread res;
-	GC_thread t;
+        GC_thread res;
+        GC_thread t;
 
-	if (DEBUG_THREADS)
-		fprintf (stderr, "GC_copyThread (0x%08x)\n", (uint)thread);
-	enter (s);
-	t = (GC_thread)thread;
+        if (DEBUG_THREADS)
+                fprintf (stderr, "GC_copyThread (0x%08x)\n", (uint)thread);
+        enter (s);
+        t = (GC_thread)thread;
 /* The following assert is no longer true, since alignment restrictions can force
  * the reserved to be slightly larger than the used.
  */
-/*	assert (t->stack->reserved == t->stack->used); */
-	assert (t->stack->reserved >= t->stack->used);
-	res = copyThread (s, t, t->stack->used);
+/*      assert (t->stack->reserved == t->stack->used); */
+        assert (t->stack->reserved >= t->stack->used);
+        res = copyThread (s, t, t->stack->used);
 /* The following assert is no longer true, since alignment restrictions can force
  * the reserved to be slightly larger than the used.
  */
-/*	assert (res->stack->reserved == res->stack->used); */
-	assert (res->stack->reserved >= res->stack->used);
-	leave (s);
-	if (DEBUG_THREADS)
-		fprintf (stderr, "0x%08x = GC_copyThread (0x%08x)\n", (uint)res, (uint)thread);
-	return (pointer)res;
+/*      assert (res->stack->reserved == res->stack->used); */
+        assert (res->stack->reserved >= res->stack->used);
+        leave (s);
+        if (DEBUG_THREADS)
+                fprintf (stderr, "0x%08x = GC_copyThread (0x%08x)\n", (uint)res, (uint)thread);
+        return (pointer)res;
 }
 
 /* ---------------------------------------------------------------- */
@@ -3434,416 +3425,420 @@
 
 /* Apply f to the frame index of each frame in the current thread's stack. */
 void GC_foreachStackFrame (GC_state s, void (*f) (GC_state s, uint i)) {
-	pointer bottom;
-	word index;
-	GC_frameLayout *layout;
-	word returnAddress;
-	pointer top;
+        pointer bottom;
+        word index;
+        GC_frameLayout *layout;
+        word returnAddress;
+        pointer top;
 
-	if (DEBUG_PROFILE)
-		fprintf (stderr, "walking stack");
-	bottom = stackBottom (s, s->currentThread->stack);
-	if (DEBUG_PROFILE)
-		fprintf (stderr, "  bottom = 0x%08x  top = 0x%08x.\n",
-				(uint)bottom, (uint)s->stackTop);
-	for (top = s->stackTop; top > bottom; top -= layout->numBytes) {
-		returnAddress = *(word*)(top - WORD_SIZE);
-		index = getFrameIndex (s, returnAddress);
-		if (DEBUG_PROFILE)
-			fprintf (stderr, "top = 0x%08x  index = %u\n",
-					(uint)top, index);
-		unless (0 <= index and index < s->frameLayoutsSize)
-			die ("top = 0x%08x  returnAddress = 0x%08x  index = %u\n",
-					(uint)top, returnAddress, index);
-		f (s, index);
-		layout = &(s->frameLayouts[index]);
-		assert (layout->numBytes > 0);
-	}
-	if (DEBUG_PROFILE)
-		fprintf (stderr, "done walking stack\n");
+        if (DEBUG_PROFILE)
+                fprintf (stderr, "walking stack");
+        bottom = stackBottom (s, s->currentThread->stack);
+        if (DEBUG_PROFILE)
+                fprintf (stderr, "  bottom = 0x%08x  top = 0x%08x.\n",
+                                (uint)bottom, (uint)s->stackTop);
+        for (top = s->stackTop; top > bottom; top -= layout->numBytes) {
+                returnAddress = *(word*)(top - WORD_SIZE);
+                index = getFrameIndex (s, returnAddress);
+                if (DEBUG_PROFILE)
+                        fprintf (stderr, "top = 0x%08x  index = %u\n",
+                                        (uint)top, index);
+                unless (0 <= index and index < s->frameLayoutsSize)
+                        die ("top = 0x%08x  returnAddress = 0x%08x  index = %u\n",
+                                        (uint)top, returnAddress, index);
+                f (s, index);
+                layout = &(s->frameLayouts[index]);
+                assert (layout->numBytes > 0);
+        }
+        if (DEBUG_PROFILE)
+                fprintf (stderr, "done walking stack\n");
 }
 
 static int numStackFrames;
 static int *callStack;
 
 static void addToCallStack (GC_state s, uint i) {
-	if (DEBUG_CALL_STACK)
-		fprintf (stderr, "addToCallStack (%u)\n", i);
-	callStack[numStackFrames] = i;
-	numStackFrames++;
+        if (DEBUG_CALL_STACK)
+                fprintf (stderr, "addToCallStack (%u)\n", i);
+        callStack[numStackFrames] = i;
+        numStackFrames++;
 }
 
 void GC_callStack (GC_state s, Pointer p) {
-	if (DEBUG_CALL_STACK)
-		fprintf (stderr, "GC_callStack\n");
-	numStackFrames = 0;
-	callStack = (int*)p;
-	GC_foreachStackFrame (s, addToCallStack);
+        if (DEBUG_CALL_STACK)
+                fprintf (stderr, "GC_callStack\n");
+        numStackFrames = 0;
+        callStack = (int*)p;
+        GC_foreachStackFrame (s, addToCallStack);
 }
 
 uint * GC_frameIndexSourceSeq (GC_state s, int frameIndex) {
-	uint *res;
+        uint *res;
 
-	res = s->sourceSeqs[s->frameSources[frameIndex]];
-	if (DEBUG_CALL_STACK)
-		fprintf (stderr, "0x%08x = GC_frameIndexSourceSeq (%u)\n",
-				(uint)res, frameIndex);
-	return res;
+        res = s->sourceSeqs[s->frameSources[frameIndex]];
+        if (DEBUG_CALL_STACK)
+                fprintf (stderr, "0x%08x = GC_frameIndexSourceSeq (%u)\n",
+                                (uint)res, frameIndex);
+        return res;
 }
 
 static void bumpStackFrameCount (GC_state s, uint i) {
-	numStackFrames++;
+        numStackFrames++;
 }
 
 int GC_numStackFrames (GC_state s) {
-	numStackFrames = 0;
-	GC_foreachStackFrame (s, bumpStackFrameCount);
-	if (DEBUG_CALL_STACK)
-		fprintf (stderr, "%u = GC_numStackFrames\n", numStackFrames);
-	return numStackFrames;
+        numStackFrames = 0;
+        GC_foreachStackFrame (s, bumpStackFrameCount);
+        if (DEBUG_CALL_STACK)
+                fprintf (stderr, "%u = GC_numStackFrames\n", numStackFrames);
+        return numStackFrames;
 }
 
 inline string GC_sourceName (GC_state s, uint i) {
-	if (i < s->sourcesSize)
-		return s->sourceNames[s->sources[i].nameIndex];
-	else
-		return s->sourceNames[i - s->sourcesSize];
+        if (i < s->sourcesSize)
+                return s->sourceNames[s->sources[i].nameIndex];
+        else
+                return s->sourceNames[i - s->sourcesSize];
 }
 
 static inline GC_profileStack profileStackInfo (GC_state s, uint i) {
-	assert (s->profile != NULL);
-	return &(s->profile->stack[i]);
+        assert (s->profile != NULL);
+        return &(s->profile->stack[i]);
 }
 
 static inline uint profileMaster (GC_state s, uint i) {
-	return s->sources[i].nameIndex + s->sourcesSize;
+        return s->sources[i].nameIndex + s->sourcesSize;
 }
 
 static inline void removeFromStack (GC_state s, uint i) {
-	GC_profile p;
-	GC_profileStack ps;
-	ullong totalInc;
+        GC_profile p;
+        GC_profileStack ps;
+        ullong totalInc;
 
-	p = s->profile;
-	ps = profileStackInfo (s, i);
-	totalInc = p->total - ps->lastTotal;
-	if (DEBUG_PROFILE)
-		fprintf (stderr, "removing %s from stack  ticksInc = %llu  ticksInGCInc = %llu\n",
-				GC_sourceName (s, i), totalInc,
-				p->totalGC - ps->lastTotalGC);
-	ps->ticks += totalInc;
-	ps->ticksInGC += p->totalGC - ps->lastTotalGC;
+        p = s->profile;
+        ps = profileStackInfo (s, i);
+        totalInc = p->total - ps->lastTotal;
+        if (DEBUG_PROFILE)
+                fprintf (stderr, "removing %s from stack  ticksInc = %llu  ticksInGCInc = %llu\n",
+                                GC_sourceName (s, i), totalInc,
+                                p->totalGC - ps->lastTotalGC);
+        ps->ticks += totalInc;
+        ps->ticksInGC += p->totalGC - ps->lastTotalGC;
 }
 
 static void setProfTimer (long usec) {
-	struct itimerval iv;
+        struct itimerval iv;
 
-	iv.it_interval.tv_sec = 0;
-	iv.it_interval.tv_usec = usec;
-	iv.it_value.tv_sec = 0;
-	iv.it_value.tv_usec = usec;
-	unless (0 == setitimer (ITIMER_PROF, &iv, NULL))
-		die ("setProfTimer failed");
+        iv.it_interval.tv_sec = 0;
+        iv.it_interval.tv_usec = usec;
+        iv.it_value.tv_sec = 0;
+        iv.it_value.tv_usec = usec;
+        unless (0 == setitimer (ITIMER_PROF, &iv, NULL))
+                die ("setProfTimer failed");
 }
 
 void GC_profileDone (GC_state s) {
-	GC_profile p;
-	uint sourceIndex;
+        GC_profile p;
+        uint sourceIndex;
 
-	if (DEBUG_PROFILE) 
-		fprintf (stderr, "GC_profileDone ()\n");
-	assert (s->profilingIsOn);
-	if (PROFILE_TIME == s->profileKind)
-		setProfTimer (0);
-	s->profilingIsOn = FALSE;
-	p = s->profile;
-	if (s->profileStack) {
-		for (sourceIndex = 0; 
-			sourceIndex < s->sourcesSize + s->sourceNamesSize;
-			++sourceIndex) {
-			if (p->stack[sourceIndex].numOccurrences > 0) {
-				if (DEBUG_PROFILE)
-					fprintf (stderr, "done leaving %s\n", 
-							GC_sourceName (s, sourceIndex));
-				removeFromStack (s, sourceIndex);
-			}
-		}
-	}
+        if (DEBUG_PROFILE) 
+                fprintf (stderr, "GC_profileDone ()\n");
+        assert (s->profilingIsOn);
+        if (PROFILE_TIME_FIELD == s->profileKind
+            or PROFILE_TIME_LABEL == s->profileKind)
+                setProfTimer (0);
+        s->profilingIsOn = FALSE;
+        p = s->profile;
+        if (s->profileStack) {
+                for (sourceIndex = 0; 
+                        sourceIndex < s->sourcesSize + s->sourceNamesSize;
+                        ++sourceIndex) {
+                        if (p->stack[sourceIndex].numOccurrences > 0) {
+                                if (DEBUG_PROFILE)
+                                        fprintf (stderr, "done leaving %s\n", 
+                                                        GC_sourceName (s, sourceIndex));
+                                removeFromStack (s, sourceIndex);
+                        }
+                }
+        }
 }
 
 static int profileDepth = 0;
 
 static void profileIndent () {
-	int i;
+        int i;
 
-	for (i = 0; i < profileDepth; ++i)
-		fprintf (stderr, " ");
+        for (i = 0; i < profileDepth; ++i)
+                fprintf (stderr, " ");
 }
 
 static inline void profileEnterSource (GC_state s, uint i) {
-	GC_profile p;
-	GC_profileStack ps;
+        GC_profile p;
+        GC_profileStack ps;
 
-	p = s->profile;
-	ps = profileStackInfo (s, i);
-	if (0 == ps->numOccurrences) {
-		ps->lastTotal = p->total;
-		ps->lastTotalGC = p->totalGC;
-	}
-	ps->numOccurrences++;
+        p = s->profile;
+        ps = profileStackInfo (s, i);
+        if (0 == ps->numOccurrences) {
+                ps->lastTotal = p->total;
+                ps->lastTotalGC = p->totalGC;
+        }
+        ps->numOccurrences++;
 }
 
 static void profileEnter (GC_state s, uint sourceSeqIndex) {
-	int i;
-	GC_profile p;
-	uint sourceIndex;
-	uint *sourceSeq;
+        int i;
+        GC_profile p;
+        uint sourceIndex;
+        uint *sourceSeq;
 
-	if (DEBUG_PROFILE)
-		fprintf (stderr, "profileEnter (%u)\n", sourceSeqIndex);
-	assert (s->profileStack);
-	assert (sourceSeqIndex < s->sourceSeqsSize);
-	p = s->profile;
-	sourceSeq = s->sourceSeqs[sourceSeqIndex];
-	for (i = 1; i <= sourceSeq[0]; ++i) {
-		sourceIndex = sourceSeq[i];
-		if (DEBUG_ENTER_LEAVE or DEBUG_PROFILE) {
-			profileIndent ();
-			fprintf (stderr, "(entering %s\n", 
-					GC_sourceName (s, sourceIndex));
-			profileDepth++;
-		}
-		profileEnterSource (s, sourceIndex);
-		profileEnterSource (s, profileMaster (s, sourceIndex));
-	}
+        if (DEBUG_PROFILE)
+                fprintf (stderr, "profileEnter (%u)\n", sourceSeqIndex);
+        assert (s->profileStack);
+        assert (sourceSeqIndex < s->sourceSeqsSize);
+        p = s->profile;
+        sourceSeq = s->sourceSeqs[sourceSeqIndex];
+        for (i = 1; i <= sourceSeq[0]; ++i) {
+                sourceIndex = sourceSeq[i];
+                if (DEBUG_ENTER_LEAVE or DEBUG_PROFILE) {
+                        profileIndent ();
+                        fprintf (stderr, "(entering %s\n", 
+                                        GC_sourceName (s, sourceIndex));
+                        profileDepth++;
+                }
+                profileEnterSource (s, sourceIndex);
+                profileEnterSource (s, profileMaster (s, sourceIndex));
+        }
 }
 
 static void enterFrame (GC_state s, uint i) {
-	profileEnter (s, s->frameSources[i]);
+        profileEnter (s, s->frameSources[i]);
 }
 
 static inline void profileLeaveSource (GC_state s, uint i) {
-	GC_profile p;
-	GC_profileStack ps;
+        GC_profile p;
+        GC_profileStack ps;
 
-	if (DEBUG_PROFILE)
-		fprintf (stderr, "profileLeaveSource (%u)\n", i);
-	p = s->profile;
-	ps = profileStackInfo (s, i);
-	assert (ps->numOccurrences > 0);
-	ps->numOccurrences--;
-	if (0 == ps->numOccurrences)
-		removeFromStack (s, i);
+        if (DEBUG_PROFILE)
+                fprintf (stderr, "profileLeaveSource (%u)\n", i);
+        p = s->profile;
+        ps = profileStackInfo (s, i);
+        assert (ps->numOccurrences > 0);
+        ps->numOccurrences--;
+        if (0 == ps->numOccurrences)
+                removeFromStack (s, i);
 }
 
 static void profileLeave (GC_state s, uint sourceSeqIndex) {
-	int i;
-	GC_profile p;
-	uint sourceIndex;
-	uint *sourceSeq;
+        int i;
+        GC_profile p;
+        uint sourceIndex;
+        uint *sourceSeq;
 
-	if (DEBUG_PROFILE)
-		fprintf (stderr, "profileLeave (%u)\n", sourceSeqIndex);
-	assert (s->profileStack);
-	assert (sourceSeqIndex < s->sourceSeqsSize);
-	p = s->profile;
-	sourceSeq = s->sourceSeqs[sourceSeqIndex];
-	for (i = sourceSeq[0]; i > 0; --i) {
-		sourceIndex = sourceSeq[i];
-		if (DEBUG_ENTER_LEAVE or DEBUG_PROFILE) {
-			profileDepth--;
-			profileIndent ();
-			fprintf (stderr, "leaving %s)\n",
-					GC_sourceName (s, sourceIndex));
-		}
-		profileLeaveSource (s, sourceIndex);
-		profileLeaveSource (s, profileMaster (s, sourceIndex));
-	}
+        if (DEBUG_PROFILE)
+                fprintf (stderr, "profileLeave (%u)\n", sourceSeqIndex);
+        assert (s->profileStack);
+        assert (sourceSeqIndex < s->sourceSeqsSize);
+        p = s->profile;
+        sourceSeq = s->sourceSeqs[sourceSeqIndex];
+        for (i = sourceSeq[0]; i > 0; --i) {
+                sourceIndex = sourceSeq[i];
+                if (DEBUG_ENTER_LEAVE or DEBUG_PROFILE) {
+                        profileDepth--;
+                        profileIndent ();
+                        fprintf (stderr, "leaving %s)\n",
+                                        GC_sourceName (s, sourceIndex));
+                }
+                profileLeaveSource (s, sourceIndex);
+                profileLeaveSource (s, profileMaster (s, sourceIndex));
+        }
 }
 
 static inline void profileInc (GC_state s, W32 amount, uint sourceSeqIndex) {
-	uint *sourceSeq;
-	uint topSourceIndex;
+        uint *sourceSeq;
+        uint topSourceIndex;
 
-	if (DEBUG_PROFILE)
-		fprintf (stderr, "profileInc (%u, %u)\n", 
-				(uint)amount, sourceSeqIndex);
-	assert (sourceSeqIndex < s->sourceSeqsSize);
-	sourceSeq = s->sourceSeqs[sourceSeqIndex];
-	topSourceIndex = sourceSeq[0] > 0
-		? sourceSeq[sourceSeq[0]]
-		: SOURCES_INDEX_UNKNOWN;
-	if (DEBUG_PROFILE) {
-		profileIndent ();
-		fprintf (stderr, "bumping %s by %u\n",
-				GC_sourceName (s, topSourceIndex), (uint)amount);
-	}
-	s->profile->countTop[topSourceIndex] += amount;
-	s->profile->countTop[profileMaster (s, topSourceIndex)] += amount;
-	if (s->profileStack)
-		profileEnter (s, sourceSeqIndex);
-	if (SOURCES_INDEX_GC == topSourceIndex)
-		s->profile->totalGC += amount;
-	else
-		s->profile->total += amount;
-	if (s->profileStack)
-		profileLeave (s, sourceSeqIndex);
+        if (DEBUG_PROFILE)
+                fprintf (stderr, "profileInc (%u, %u)\n", 
+                                (uint)amount, sourceSeqIndex);
+        assert (sourceSeqIndex < s->sourceSeqsSize);
+        sourceSeq = s->sourceSeqs[sourceSeqIndex];
+        topSourceIndex = sourceSeq[0] > 0
+                ? sourceSeq[sourceSeq[0]]
+                : SOURCES_INDEX_UNKNOWN;
+        if (DEBUG_PROFILE) {
+                profileIndent ();
+                fprintf (stderr, "bumping %s by %u\n",
+                                GC_sourceName (s, topSourceIndex), (uint)amount);
+        }
+        s->profile->countTop[topSourceIndex] += amount;
+        s->profile->countTop[profileMaster (s, topSourceIndex)] += amount;
+        if (s->profileStack)
+                profileEnter (s, sourceSeqIndex);
+        if (SOURCES_INDEX_GC == topSourceIndex)
+                s->profile->totalGC += amount;
+        else
+                s->profile->total += amount;
+        if (s->profileStack)
+                profileLeave (s, sourceSeqIndex);
 }
 
 void GC_profileEnter (GC_state s) {
-	profileEnter (s, topFrameSourceSeqIndex (s));
+        profileEnter (s, topFrameSourceSeqIndex (s));
 }
 
 void GC_profileLeave (GC_state s) {
-	profileLeave (s, topFrameSourceSeqIndex (s));
+        profileLeave (s, topFrameSourceSeqIndex (s));
 }
 
 void GC_profileInc (GC_state s, W32 amount) {
-	if (DEBUG_PROFILE)
-		fprintf (stderr, "GC_profileInc (%u)\n", (uint)amount);
-	profileInc (s, amount, 
-			 s->amInGC
-				? SOURCE_SEQ_GC 
-				: topFrameSourceSeqIndex (s));
+        if (DEBUG_PROFILE)
+                fprintf (stderr, "GC_profileInc (%u)\n", (uint)amount);
+        profileInc (s, amount, 
+                         s->amInGC
+                                ? SOURCE_SEQ_GC 
+                                : topFrameSourceSeqIndex (s));
 }
 
 void GC_profileAllocInc (GC_state s, W32 amount) {
-	if (s->profilingIsOn and (PROFILE_ALLOC == s->profileKind)) {
-		if (DEBUG_PROFILE)
-			fprintf (stderr, "GC_profileAllocInc (%u)\n", (uint)amount);
-		GC_profileInc (s, amount);
-	}
+        if (s->profilingIsOn and (PROFILE_ALLOC == s->profileKind)) {
+                if (DEBUG_PROFILE)
+                        fprintf (stderr, "GC_profileAllocInc (%u)\n", (uint)amount);
+                GC_profileInc (s, amount);
+        }
 }
 
 static void showProf (GC_state s) {
-	int i;
-	int j;
+        int i;
+        int j;
 
-	fprintf (stdout, "0x%08x\n", s->magic);
-	fprintf (stdout, "%u\n", s->sourceNamesSize);
-	for (i = 0; i < s->sourceNamesSize; ++i)
-		fprintf (stdout, "%s\n", s->sourceNames[i]);
-	fprintf (stdout, "%u\n", s->sourcesSize);
-	for (i = 0; i < s->sourcesSize; ++i)
-		fprintf (stdout, "%u %u\n", 
-				s->sources[i].nameIndex,
-				s->sources[i].successorsIndex);
-	fprintf (stdout, "%u\n", s->sourceSeqsSize);
-	for (i = 0; i < s->sourceSeqsSize; ++i) {
-		uint *sourceSeq;
+        fprintf (stdout, "0x%08x\n", s->magic);
+        fprintf (stdout, "%u\n", s->sourceNamesSize);
+        for (i = 0; i < s->sourceNamesSize; ++i)
+                fprintf (stdout, "%s\n", s->sourceNames[i]);
+        fprintf (stdout, "%u\n", s->sourcesSize);
+        for (i = 0; i < s->sourcesSize; ++i)
+                fprintf (stdout, "%u %u\n", 
+                                s->sources[i].nameIndex,
+                                s->sources[i].successorsIndex);
+        fprintf (stdout, "%u\n", s->sourceSeqsSize);
+        for (i = 0; i < s->sourceSeqsSize; ++i) {
+                uint *sourceSeq;
 
-		sourceSeq = s->sourceSeqs[i];
-		for (j = 1; j <= sourceSeq[0]; ++j)
-			fprintf (stdout, "%u ", sourceSeq[j]);
-		fprintf (stdout, "\n");
-	}
+                sourceSeq = s->sourceSeqs[i];
+                for (j = 1; j <= sourceSeq[0]; ++j)
+                        fprintf (stdout, "%u ", sourceSeq[j]);
+                fprintf (stdout, "\n");
+        }
 }
 
 GC_profile GC_profileNew (GC_state s) {
-	GC_profile p;
-	uint size;
+        GC_profile p;
+        uint size;
 
-	NEW (GC_profile, p);
-	p->total = 0;
-	p->totalGC = 0;
-	size = s->sourcesSize + s->sourceNamesSize;
-	ARRAY (ullong*, p->countTop, size);
-	if (s->profileStack)
-		ARRAY (struct GC_profileStack *, p->stack, size);
-	if (DEBUG_PROFILE)
-		fprintf (stderr, "0x%08x = GC_profileNew ()\n", (uint)p);
-	return p;
+        NEW (GC_profile, p);
+        p->total = 0;
+        p->totalGC = 0;
+        size = s->sourcesSize + s->sourceNamesSize;
+        ARRAY (ullong*, p->countTop, size);
+        if (s->profileStack)
+                ARRAY (struct GC_profileStack *, p->stack, size);
+        if (DEBUG_PROFILE)
+                fprintf (stderr, "0x%08x = GC_profileNew ()\n", (uint)p);
+        return p;
 }
 
 void GC_profileFree (GC_state s, GC_profile p) {
-	free (p->countTop);
-	if (s->profileStack)
-		free (p->stack);
-	free (p);
+        free (p->countTop);
+        if (s->profileStack)
+                free (p->stack);
+        free (p);
 }
 
 static void writeString (int fd, string s) {
-	swrite (fd, s, strlen(s));
+        swrite (fd, s, strlen(s));
 }
 
 static void writeUint (int fd, uint u) {
-	char buf[20];
+        char buf[20];
 
-	sprintf (buf, "%u", u);
-	writeString (fd, buf);
+        sprintf (buf, "%u", u);
+        writeString (fd, buf);
 }
 
 static void writeUllong (int fd, ullong u) {
-	char buf[20];
+        char buf[20];
 
-	sprintf (buf, "%llu", u);
-	writeString (fd, buf);
+        sprintf (buf, "%llu", u);
+        writeString (fd, buf);
 }
 
 static void writeWord (int fd, word w) {
-	char buf[20];
+        char buf[20];
 
-	sprintf (buf, "0x%08x", w);
-	writeString (fd, buf);
+        sprintf (buf, "0x%08x", w);
+        writeString (fd, buf);
 }
 
 static inline void newline (int fd) {
-	writeString (fd, "\n");
+        writeString (fd, "\n");
 }
 
 static void profileWriteCount (GC_state s, GC_profile p, int fd, uint i) {
-	writeUllong (fd, p->countTop[i]);
-	if (s->profileStack) {
-		GC_profileStack ps;
-	
-		ps = &(p->stack[i]);
-		writeString (fd, " ");
-		writeUllong (fd, ps->ticks);
-		writeString (fd, " ");
-		writeUllong (fd, ps->ticksInGC);
-	}
-	newline (fd);
+        writeUllong (fd, p->countTop[i]);
+        if (s->profileStack) {
+                GC_profileStack ps;
+        
+                ps = &(p->stack[i]);
+                writeString (fd, " ");
+                writeUllong (fd, ps->ticks);
+                writeString (fd, " ");
+                writeUllong (fd, ps->ticksInGC);
+        }
+        newline (fd);
 }
 
 void GC_profileWrite (GC_state s, GC_profile p, int fd) {
-	int i;
-	string kind;
+        int i;
+        string kind;
 
-	if (DEBUG_PROFILE)
-		fprintf (stderr, "GC_profileWrite\n");
-	writeString (fd, "MLton prof\n");
-	kind = "";
-	switch (s->profileKind) {
-	case PROFILE_ALLOC:
-		kind = "alloc\n";
-	break;
-	case PROFILE_COUNT:
-		kind = "count\n";
-	break;
-	case PROFILE_NONE:
-		die ("impossible PROFILE_NONE");
-	break;
-	case PROFILE_TIME:
-		kind = "time\n";
-	break;
-	}
-	writeString (fd, kind);
-	writeString (fd, s->profileStack 
-				? "stack\n" : "current\n");
-	writeWord (fd, s->magic);
-	newline (fd);
-	writeUllong (fd, p->total);
-	writeString (fd, " ");
-	writeUllong (fd, p->totalGC);
-	newline (fd);
-	writeUint (fd, s->sourcesSize);
-	newline (fd);
-	for (i = 0; i < s->sourcesSize; ++i)
-		profileWriteCount (s, p, fd, i);
-	writeUint (fd, s->sourceNamesSize);
-	newline (fd);
-	for (i = 0; i < s->sourceNamesSize; ++i)
-		profileWriteCount (s, p, fd, i + s->sourcesSize);
+        if (DEBUG_PROFILE)
+                fprintf (stderr, "GC_profileWrite\n");
+        writeString (fd, "MLton prof\n");
+        kind = "";
+        switch (s->profileKind) {
+        case PROFILE_ALLOC:
+                kind = "alloc\n";
+        break;
+        case PROFILE_COUNT:
+                kind = "count\n";
+        break;
+        case PROFILE_NONE:
+                die ("impossible PROFILE_NONE");
+        break;
+        case PROFILE_TIME_FIELD:
+                kind = "time\n";
+        break;
+        case PROFILE_TIME_LABEL:
+                kind = "time\n";
+        break;
+        }
+        writeString (fd, kind);
+        writeString (fd, s->profileStack 
+                                ? "stack\n" : "current\n");
+        writeWord (fd, s->magic);
+        newline (fd);
+        writeUllong (fd, p->total);
+        writeString (fd, " ");
+        writeUllong (fd, p->totalGC);
+        newline (fd);
+        writeUint (fd, s->sourcesSize);
+        newline (fd);
+        for (i = 0; i < s->sourcesSize; ++i)
+                profileWriteCount (s, p, fd, i);
+        writeUint (fd, s->sourceNamesSize);
+        newline (fd);
+        for (i = 0; i < s->sourceNamesSize; ++i)
+                profileWriteCount (s, p, fd, i + s->sourcesSize);
 }
 
 #if not HAS_TIME_PROFILING
@@ -3852,7 +3847,7 @@
  * to make sure that time profiling is never turned on.
  */
 static void profileTimeInit (GC_state s) {
-	die ("no time profiling");
+        die ("no time profiling");
 }
 
 #else
@@ -3860,104 +3855,113 @@
 static GC_state catcherState;
 
 void GC_handleSigProf (pointer pc) {
-	uint frameIndex;
-	GC_state s;
-	uint sourceSeqIndex;
+        uint frameIndex;
+        GC_state s;
+        uint sourceSeqsIndex;
 
-	s = catcherState;
-	if (DEBUG_PROFILE)
-		fprintf (stderr, "GC_handleSigProf (0x%08x)\n", (uint)pc);
-	if (s->amInGC)
-		sourceSeqIndex = SOURCE_SEQ_GC;
-	else {
-		frameIndex = topFrameIndex (s);
-		if (s->frameLayouts[frameIndex].isC)
-			sourceSeqIndex = s->frameSources[frameIndex];
-		else {
-			if (s->textStart <= pc and pc < s->textEnd)
-				sourceSeqIndex = s->textSources [pc - s->textStart];
-			else {
-				if (DEBUG_PROFILE)
-					fprintf (stderr, "pc out of bounds\n");
-		       		sourceSeqIndex = SOURCE_SEQ_UNKNOWN;
-			}
-		}
-	}
-	profileInc (s, 1, sourceSeqIndex);
+        s = catcherState;
+        if (DEBUG_PROFILE)
+                fprintf (stderr, "GC_handleSigProf (0x%08x)\n", (uint)pc);
+        if (s->amInGC)
+                sourceSeqsIndex = SOURCE_SEQ_GC;
+        else {
+                frameIndex = topFrameIndex (s);
+                if (s->frameLayouts[frameIndex].isC)
+                        sourceSeqsIndex = s->frameSources[frameIndex];
+                else {
+                        if (PROFILE_TIME_LABEL == s->profileKind) {
+                                if (s->textStart <= pc and pc < s->textEnd)
+                                        sourceSeqsIndex = 
+                                                s->textSources [pc - s->textStart];
+                                else {
+                                        if (DEBUG_PROFILE)
+                                                fprintf (stderr, "pc out of bounds\n");
+                                        sourceSeqsIndex = SOURCE_SEQ_UNKNOWN;
+                                }
+                        } else {
+                                sourceSeqsIndex = s->curSourceSeqsIndex;
+                        }
+                }
+        }
+        profileInc (s, 1, sourceSeqsIndex);
 }
 
 static int compareProfileLabels (const void *v1, const void *v2) {
-	GC_profileLabel l1;
-	GC_profileLabel l2;
+        GC_profileLabel l1;
+        GC_profileLabel l2;
 
-	l1 = (GC_profileLabel)v1;
-	l2 = (GC_profileLabel)v2;
-	return (int)l1->label - (int)l2->label;
+        l1 = (GC_profileLabel)v1;
+        l2 = (GC_profileLabel)v2;
+        return (int)l1->label - (int)l2->label;
 }
 
 static void profileTimeInit (GC_state s) {
-	int i;
-	pointer p;
-	struct sigaction sa;
-	uint sourceSeqsIndex;
+        int i;
+        pointer p;
+        struct sigaction sa;
+        uint sourceSeqsIndex;
 
-	s->profile = GC_profileNew (s);
-	/* Sort sourceLabels by address. */
-	qsort (s->sourceLabels, s->sourceLabelsSize, sizeof (*s->sourceLabels),
-		compareProfileLabels);
-	if (0 == s->sourceLabels[s->sourceLabelsSize - 1].label)
-		die ("Max profile label is 0 -- something is wrong.");
-	if (DEBUG_PROFILE)
-		for (i = 0; i < s->sourceLabelsSize; ++i)
-			fprintf (stderr, "0x%08x  %u\n",
-					(uint)s->sourceLabels[i].label,
-					s->sourceLabels[i].sourceSeqsIndex);
-	if (ASSERT)
-		for (i = 1; i < s->sourceLabelsSize; ++i)
-			assert (s->sourceLabels[i-1].label
-				<= s->sourceLabels[i].label);
-	/* Initialize s->textSources. */
-	s->textEnd = (pointer)(getTextEnd());
-	s->textStart = (pointer)(getTextStart());
-	if (ASSERT)
-		for (i = 0; i < s->sourceLabelsSize; ++i) {
-			pointer label;
+        s->profile = GC_profileNew (s);
+        if (PROFILE_TIME_LABEL == s->profileKind) {
+        /* Sort sourceLabels by address. */
+        qsort (s->sourceLabels, s->sourceLabelsSize, sizeof (*s->sourceLabels),
+                compareProfileLabels);
+        if (0 == s->sourceLabels[s->sourceLabelsSize - 1].label)
+                die ("Max profile label is 0 -- something is wrong.");
+        if (DEBUG_PROFILE)
+                for (i = 0; i < s->sourceLabelsSize; ++i)
+                        fprintf (stderr, "0x%08x  %u\n",
+                                        (uint)s->sourceLabels[i].label,
+                                        s->sourceLabels[i].sourceSeqsIndex);
+        if (ASSERT)
+                for (i = 1; i < s->sourceLabelsSize; ++i)
+                        assert (s->sourceLabels[i-1].label
+                                <= s->sourceLabels[i].label);
+        /* Initialize s->textSources. */
+        s->textEnd = (pointer)(getTextEnd());
+        s->textStart = (pointer)(getTextStart());
+        if (ASSERT)
+                for (i = 0; i < s->sourceLabelsSize; ++i) {
+                        pointer label;
 
-			label = s->sourceLabels[i].label;
-			assert (0 == label
-				or (s->textStart <= label 
-					and label < s->textEnd));
-		}
-	ARRAY (uint*, s->textSources, s->textEnd - s->textStart);
-	p = s->textStart;
-	sourceSeqsIndex = SOURCE_SEQ_UNKNOWN;
-	for (i = 0; i < s->sourceLabelsSize; ++i) {
-		for ( ; p < s->sourceLabels[i].label; ++p)
-			s->textSources[p - s->textStart] = sourceSeqsIndex;
-		sourceSeqsIndex = s->sourceLabels[i].sourceSeqsIndex;
-	}
-	for ( ; p < s->textEnd; ++p)
-		s->textSources[p - s->textStart] = sourceSeqsIndex;
- 	/*
-	 * Install catcher, which handles SIGPROF and calls MLton_Profile_inc.
-	 * 
-	 * One thing I should point out that I discovered the hard way: If
-	 * the call to sigaction does NOT specify the SA_ONSTACK flag, then
-	 * even if you have called sigaltstack(), it will NOT switch stacks,
-	 * so you will probably die.  Worse, if the call to sigaction DOES
-	 * have SA_ONSTACK and you have NOT called sigaltstack(), it still
-	 * switches stacks (to location 0) and you die of a SEGV.  Thus the
-	 * sigaction() call MUST occur after the call to sigaltstack(), and
-	 * in order to have profiling cover as much as possible, you want it
-	 * to occur right after the sigaltstack() call.
-	 */
-	catcherState = s;
-	sigemptyset (&sa.sa_mask);
-	setSigProfHandler (&sa);
-	unless (sigaction (SIGPROF, &sa, NULL) == 0)
-		diee ("sigaction() failed");
-	/* Start the SIGPROF timer. */
-	setProfTimer (10000);
+                        label = s->sourceLabels[i].label;
+                        assert (0 == label
+                                or (s->textStart <= label 
+                                        and label < s->textEnd));
+                }
+        ARRAY (uint*, s->textSources, s->textEnd - s->textStart);
+        p = s->textStart;
+        sourceSeqsIndex = SOURCE_SEQ_UNKNOWN;
+        for (i = 0; i < s->sourceLabelsSize; ++i) {
+                for ( ; p < s->sourceLabels[i].label; ++p)
+                        s->textSources[p - s->textStart] = sourceSeqsIndex;
+                sourceSeqsIndex = s->sourceLabels[i].sourceSeqsIndex;
+        }
+        for ( ; p < s->textEnd; ++p)
+                s->textSources[p - s->textStart] = sourceSeqsIndex;
+        } else {
+        s->curSourceSeqsIndex = SOURCE_SEQ_UNKNOWN;
+        }
+        /*
+         * Install catcher, which handles SIGPROF and calls MLton_Profile_inc.
+         * 
+         * One thing I should point out that I discovered the hard way: If
+         * the call to sigaction does NOT specify the SA_ONSTACK flag, then
+         * even if you have called sigaltstack(), it will NOT switch stacks,
+         * so you will probably die.  Worse, if the call to sigaction DOES
+         * have SA_ONSTACK and you have NOT called sigaltstack(), it still
+         * switches stacks (to location 0) and you die of a SEGV.  Thus the
+         * sigaction() call MUST occur after the call to sigaltstack(), and
+         * in order to have profiling cover as much as possible, you want it
+         * to occur right after the sigaltstack() call.
+         */
+        catcherState = s;
+        sigemptyset (&sa.sa_mask);
+        setSigProfHandler (&sa);
+        unless (sigaction (SIGPROF, &sa, NULL) == 0)
+                diee ("sigaction() failed");
+        /* Start the SIGPROF timer. */
+        setProfTimer (10000);
 }
 
 #endif
@@ -3969,18 +3973,18 @@
 static GC_state profileEndState;
 
 static void profileEnd () {
-	int fd;
-	GC_state s;
+        int fd;
+        GC_state s;
 
-	if (DEBUG_PROFILE)
-		fprintf (stderr, "profileEnd ()\n");
-	s = profileEndState;
-	if (s->profilingIsOn) {
-		fd = creat ("mlmon.out", 0666);
-		if (fd < 0)
-			diee ("Cannot create mlmon.out");
-		GC_profileWrite (s, s->profile, fd);
-	}
+        if (DEBUG_PROFILE)
+                fprintf (stderr, "profileEnd ()\n");
+        s = profileEndState;
+        if (s->profilingIsOn) {
+                fd = creat ("mlmon.out", 0666);
+                if (fd < 0)
+                        diee ("Cannot create mlmon.out");
+                GC_profileWrite (s, s->profile, fd);
+        }
 }
 
 /* ---------------------------------------------------------------- */
@@ -3990,260 +3994,260 @@
 static void initSignalStack (GC_state s) {
 #if HAS_SIGALTSTACK
         static stack_t altstack;
-	size_t ss_size = align (SIGSTKSZ, s->pageSize);
-	size_t psize = s->pageSize;
-	void *ss_sp = ssmmap (2 * ss_size, psize, psize);
-	altstack.ss_sp = ss_sp + ss_size;
-	altstack.ss_size = ss_size;
-	altstack.ss_flags = 0;
-	sigaltstack (&altstack, NULL);
+        size_t ss_size = align (SIGSTKSZ, s->pageSize);
+        size_t psize = s->pageSize;
+        void *ss_sp = ssmmap (2 * ss_size, psize, psize);
+        altstack.ss_sp = ss_sp + ss_size;
+        altstack.ss_size = ss_size;
+        altstack.ss_flags = 0;
+        sigaltstack (&altstack, NULL);
 #endif
 }
 
 #if FALSE
 static bool stringToBool (string s) {
-	if (0 == strcmp (s, "false"))
-		return FALSE;
-	if (0 == strcmp (s, "true"))
-		return TRUE;
-	die ("Invalid @MLton bool: %s.", s);
+        if (0 == strcmp (s, "false"))
+                return FALSE;
+        if (0 == strcmp (s, "true"))
+                return TRUE;
+        die ("Invalid @MLton bool: %s.", s);
 }
 #endif
 
 static float stringToFloat (string s) {
-	float f;
+        float f;
 
-	unless (1 == sscanf (s, "%f", &f))
-		die ("Invalid @MLton float: %s.", s);
-	return f;
+        unless (1 == sscanf (s, "%f", &f))
+                die ("Invalid @MLton float: %s.", s);
+        return f;
 }
 
 static uint stringToBytes (string s) {
-	double d;
-	char *endptr;
-	uint factor;
-	
-	d = strtod (s, &endptr);
-	if (0.0 == d and s == endptr)
-		goto bad;
-	switch (*endptr++) {
-	case 'g':
-	case 'G':
-		factor = 1024 * 1024 * 1024;
-	break;
-	case 'k':
-	case 'K':
-		factor = 1024;
-	break;
-	case 'm':
-	case 'M':
-		factor = 1024 * 1024;
-	break;
-	default:
-		goto bad;
-	}
-	d *= factor;
-	unless (strlen (s) == endptr - s
-			and (double)INT_MIN <= d 
-			and d <= (double)INT_MAX)
-		goto bad;
-	return (uint)d;
+        double d;
+        char *endptr;
+        uint factor;
+        
+        d = strtod (s, &endptr);
+        if (0.0 == d and s == endptr)
+                goto bad;
+        switch (*endptr++) {
+        case 'g':
+        case 'G':
+                factor = 1024 * 1024 * 1024;
+        break;
+        case 'k':
+        case 'K':
+                factor = 1024;
+        break;
+        case 'm':
+        case 'M':
+                factor = 1024 * 1024;
+        break;
+        default:
+                goto bad;
+        }
+        d *= factor;
+        unless (strlen (s) == endptr - s
+                        and (double)INT_MIN <= d 
+                        and d <= (double)INT_MAX)
+                goto bad;
+        return (uint)d;
 bad:
-	die ("Invalid @MLton memory amount: %s.", s);
+        die ("Invalid @MLton memory amount: %s.", s);
 }
 
 static void setInitialBytesLive (GC_state s) {
-	int i;
-	int numBytes;
-	int numElements;
+        int i;
+        int numBytes;
+        int numElements;
 
-	s->bytesLive = 0;
-	for (i = 0; i < s->intInfInitsSize; ++i) {
-		numElements = strlen (s->intInfInits[i].mlstr);
-		s->bytesLive +=
-			align (GC_ARRAY_HEADER_SIZE 
-				+ WORD_SIZE // for the sign
-				+ numElements,
-				s->alignment);
-	}
-	for (i = 0; i < s->vectorInitsSize; ++i) {
-		numBytes = s->vectorInits[i].bytesPerElement
-			* s->vectorInits[i].numElements;
-		s->bytesLive +=
-			align (GC_ARRAY_HEADER_SIZE
-				+ ((0 == numBytes) 
-					? POINTER_SIZE
-					: numBytes),
-				s->alignment);
-	}
+        s->bytesLive = 0;
+        for (i = 0; i < s->intInfInitsSize; ++i) {
+                numElements = strlen (s->intInfInits[i].mlstr);
+                s->bytesLive +=
+                        align (GC_ARRAY_HEADER_SIZE 
+                                + WORD_SIZE // for the sign
+                                + numElements,
+                                s->alignment);
+        }
+        for (i = 0; i < s->vectorInitsSize; ++i) {
+                numBytes = s->vectorInits[i].bytesPerElement
+                        * s->vectorInits[i].numElements;
+                s->bytesLive +=
+                        align (GC_ARRAY_HEADER_SIZE
+                                + ((0 == numBytes) 
+                                        ? POINTER_SIZE
+                                        : numBytes),
+                                s->alignment);
+        }
 }
 
 /*
  * For each entry { globalIndex, mlstr } in the inits array (which is terminated
  * by one with an mlstr of NULL), set
- *	state->globals[globalIndex]
+ *      state->globals[globalIndex]
  * to the corresponding IntInf.int value.
  * On exit, the GC_state pointed to by s is adjusted to account for any
  * space used.
  */
 static void initIntInfs (GC_state s) {
-	struct GC_intInfInit *inits;
-	pointer frontier;
-	char	*str;
-	uint	slen,
-		llen,
-		alen,
-		i,
-		index;
-	bool	neg,
-		hex;
-	bignum	*bp;
-	char	*cp;
+        struct GC_intInfInit *inits;
+        pointer frontier;
+        char    *str;
+        uint    slen,
+                llen,
+                alen,
+                i,
+                index;
+        bool    neg,
+                hex;
+        bignum  *bp;
+        uchar   *cp;
 
-	assert (isAlignedFrontier (s, s->frontier));
-	frontier = s->frontier;
-	for (index = 0; index < s->intInfInitsSize; ++index) {
-		inits = &s->intInfInits[index];
-		str = inits->mlstr;
-		assert (inits->globalIndex < s->globalsSize);
-		neg = *str == '~';
-		if (neg)
-			++str;
-		slen = strlen (str);
-		hex = str[0] == '0' && str[1] == 'x';
-		if (hex) {
-			str += 2;
-			slen -= 2;
-			llen = (slen + 7) / 8;
-		} else
-			llen = (slen + 8) / 9;
-		assert (slen > 0);
-		bp = (bignum *)frontier;
-		cp = (char *)&bp->limbs[llen];
-		for (i = 0; i != slen; ++i)
-			if ('0' <= str[i] && str[i] <= '9')
-				cp[i] = str[i] - '0' + 0;
-			else if ('a' <= str[i] && str[i] <= 'f')
-				cp[i] = str[i] - 'a' + 0xa;
-			else {
-				assert('A' <= str[i] && str[i] <= 'F');
-				cp[i] = str[i] - 'A' + 0xA;
-			}
-		alen = mpn_set_str (bp->limbs, cp, slen, hex ? 0x10 : 10);
-		assert (alen <= llen);
-		if (alen <= 1) {
-			uint	val,
-				ans;
+        assert (isAlignedFrontier (s, s->frontier));
+        frontier = s->frontier;
+        for (index = 0; index < s->intInfInitsSize; ++index) {
+                inits = &s->intInfInits[index];
+                str = inits->mlstr;
+                assert (inits->globalIndex < s->globalsSize);
+                neg = *str == '~';
+                if (neg)
+                        ++str;
+                slen = strlen (str);
+                hex = str[0] == '0' && str[1] == 'x';
+                if (hex) {
+                        str += 2;
+                        slen -= 2;
+                        llen = (slen + 7) / 8;
+                } else
+                        llen = (slen + 8) / 9;
+                assert (slen > 0);
+                bp = (bignum *)frontier;
+                cp = (uchar *)&bp->limbs[llen];
+                for (i = 0; i != slen; ++i)
+                        if ('0' <= str[i] && str[i] <= '9')
+                                cp[i] = str[i] - '0' + 0;
+                        else if ('a' <= str[i] && str[i] <= 'f')
+                                cp[i] = str[i] - 'a' + 0xa;
+                        else {
+                                assert('A' <= str[i] && str[i] <= 'F');
+                                cp[i] = str[i] - 'A' + 0xA;
+                        }
+                alen = mpn_set_str (bp->limbs, cp, slen, hex ? 0x10 : 10);
+                assert (alen <= llen);
+                if (alen <= 1) {
+                        uint    val,
+                                ans;
 
-			if (alen == 0)
-				val = 0;
-			else
-				val = bp->limbs[0];
-			if (neg) {
-				/*
-				 * We only fit if val in [1, 2^30].
-				 */
-				ans = - val;
-				val = val - 1;
-			} else
-				/*
-				 * We only fit if val in [0, 2^30 - 1].
-				 */
-				ans = val;
-			if (val < (uint)1<<30) {
-				s->globals[inits->globalIndex] = 
-					(pointer)(ans<<1 | 1);
-				continue;
-			}
-		}
-		s->globals[inits->globalIndex] = (pointer)&bp->isneg;
-		bp->counter = 0;
-		bp->card = alen + 1;
-		bp->magic = BIGMAGIC;
-		bp->isneg = neg;
-		frontier = alignFrontier (s, (pointer)&bp->limbs[alen]);
-	}
-	assert (isAlignedFrontier (s, frontier));
-	s->frontier = frontier;
-	GC_profileAllocInc (s, frontier - s->frontier);
-	s->bytesAllocated += frontier - s->frontier;
+                        if (alen == 0)
+                                val = 0;
+                        else
+                                val = bp->limbs[0];
+                        if (neg) {
+                                /*
+                                 * We only fit if val in [1, 2^30].
+                                 */
+                                ans = - val;
+                                val = val - 1;
+                        } else
+                                /*
+                                 * We only fit if val in [0, 2^30 - 1].
+                                 */
+                                ans = val;
+                        if (val < (uint)1<<30) {
+                                s->globals[inits->globalIndex] = 
+                                        (pointer)(ans<<1 | 1);
+                                continue;
+                        }
+                }
+                s->globals[inits->globalIndex] = (pointer)&bp->isneg;
+                bp->counter = 0;
+                bp->card = alen + 1;
+                bp->magic = BIGMAGIC;
+                bp->isneg = neg;
+                frontier = alignFrontier (s, (pointer)&bp->limbs[alen]);
+        }
+        assert (isAlignedFrontier (s, frontier));
+        s->frontier = frontier;
+        GC_profileAllocInc (s, frontier - s->frontier);
+        s->bytesAllocated += frontier - s->frontier;
 }
 
 static void initStrings (GC_state s) {
-	struct GC_vectorInit *inits;
-	pointer frontier;
-	int i;
+        struct GC_vectorInit *inits;
+        pointer frontier;
+        int i;
 
-	assert (isAlignedFrontier (s, s->frontier));
-	inits = s->vectorInits;
-	frontier = s->frontier;
-	for (i = 0; i < s->vectorInitsSize; ++i) {
-		uint bytesPerElement;
-		uint numBytes;
-		uint objectSize;
-		uint typeIndex;
+        assert (isAlignedFrontier (s, s->frontier));
+        inits = s->vectorInits;
+        frontier = s->frontier;
+        for (i = 0; i < s->vectorInitsSize; ++i) {
+                uint bytesPerElement;
+                uint numBytes;
+                uint objectSize;
+                uint typeIndex;
 
-		bytesPerElement = inits[i].bytesPerElement;
-		numBytes = bytesPerElement * inits[i].numElements;
-		objectSize = align (GC_ARRAY_HEADER_SIZE
-					+ ((0 == numBytes) 
-						? POINTER_SIZE
-						: numBytes),
-					s->alignment);
-		assert (objectSize <= s->heap.start + s->heap.size - frontier);
-		*(word*)frontier = 0; /* counter word */
-		*(word*)(frontier + WORD_SIZE) = inits[i].numElements;
-		switch (bytesPerElement) {
-		case 1:
-			typeIndex = WORD8_VECTOR_TYPE_INDEX;
-		break;
-		case 2:
-			typeIndex = WORD16_VECTOR_TYPE_INDEX;
-		break;
-		case 4:
-			typeIndex = WORD32_VECTOR_TYPE_INDEX;
-		break;
-		default:
-			die ("unknown bytes per element in vectorInit: %d",
-				bytesPerElement);
-		}
-		*(word*)(frontier + 2 * WORD_SIZE) = GC_objectHeader (typeIndex);
-		s->globals[inits[i].globalIndex] = 
-			frontier + GC_ARRAY_HEADER_SIZE;
-		if (DEBUG_DETAILED)
-			fprintf (stderr, "allocated string at 0x%x\n",
-					(uint)s->globals[inits[i].globalIndex]);
-		memcpy (frontier + GC_ARRAY_HEADER_SIZE, inits[i].bytes, 
-				numBytes);
-		frontier += objectSize;
-	}
-	if (DEBUG_DETAILED)
-		fprintf (stderr, "frontier after string allocation is 0x%08x\n",
-				(uint)frontier);
-	GC_profileAllocInc (s, frontier - s->frontier);
-	s->bytesAllocated += frontier - s->frontier;
-	assert (isAlignedFrontier (s, frontier));
-	s->frontier = frontier;
+                bytesPerElement = inits[i].bytesPerElement;
+                numBytes = bytesPerElement * inits[i].numElements;
+                objectSize = align (GC_ARRAY_HEADER_SIZE
+                                        + ((0 == numBytes) 
+                                                ? POINTER_SIZE
+                                                : numBytes),
+                                        s->alignment);
+                assert (objectSize <= s->heap.start + s->heap.size - frontier);
+                *(word*)frontier = 0; /* counter word */
+                *(word*)(frontier + WORD_SIZE) = inits[i].numElements;
+                switch (bytesPerElement) {
+                case 1:
+                        typeIndex = WORD8_VECTOR_TYPE_INDEX;
+                break;
+                case 2:
+                        typeIndex = WORD16_VECTOR_TYPE_INDEX;
+                break;
+                case 4:
+                        typeIndex = WORD32_VECTOR_TYPE_INDEX;
+                break;
+                default:
+                        die ("unknown bytes per element in vectorInit: %d",
+                                bytesPerElement);
+                }
+                *(word*)(frontier + 2 * WORD_SIZE) = GC_objectHeader (typeIndex);
+                s->globals[inits[i].globalIndex] = 
+                        frontier + GC_ARRAY_HEADER_SIZE;
+                if (DEBUG_DETAILED)
+                        fprintf (stderr, "allocated string at 0x%x\n",
+                                        (uint)s->globals[inits[i].globalIndex]);
+                memcpy (frontier + GC_ARRAY_HEADER_SIZE, inits[i].bytes, 
+                                numBytes);
+                frontier += objectSize;
+        }
+        if (DEBUG_DETAILED)
+                fprintf (stderr, "frontier after string allocation is 0x%08x\n",
+                                (uint)frontier);
+        GC_profileAllocInc (s, frontier - s->frontier);
+        s->bytesAllocated += frontier - s->frontier;
+        assert (isAlignedFrontier (s, frontier));
+        s->frontier = frontier;
 }
 
 static void newWorld (GC_state s) {
-	int i;
-	pointer start;
+        int i;
+        pointer start;
 
-	for (i = 0; i < s->globalsSize; ++i)
-		s->globals[i] = (pointer)BOGUS_POINTER;
-	setInitialBytesLive (s);
-	heapCreate (s, &s->heap, heapDesiredSize (s, s->bytesLive, 0),
-			s->bytesLive);
-	createCardMapAndCrossMap (s);
-	start = alignFrontier (s, s->heap.start);
-	s->frontier = start;
-	initIntInfs (s);
-	initStrings (s);
-	assert (s->frontier - start <= s->bytesLive);
-	s->oldGenSize = s->frontier - s->heap.start;
-	setNursery (s, 0, 0);
-	switchToThread (s, newThreadOfSize (s, initialStackSize (s)));
+        for (i = 0; i < s->globalsSize; ++i)
+                s->globals[i] = (pointer)BOGUS_POINTER;
+        setInitialBytesLive (s);
+        heapCreate (s, &s->heap, heapDesiredSize (s, s->bytesLive, 0),
+                        s->bytesLive);
+        createCardMapAndCrossMap (s);
+        start = alignFrontier (s, s->heap.start);
+        s->frontier = start;
+        initIntInfs (s);
+        initStrings (s);
+        assert (s->frontier - start <= s->bytesLive);
+        s->oldGenSize = s->frontier - s->heap.start;
+        setNursery (s, 0, 0);
+        switchToThread (s, newThreadOfSize (s, initialStackSize (s)));
 }
 
 /* worldTerminator is used to separate the human readable messages at the 
@@ -4252,39 +4256,39 @@
 static const char worldTerminator = '\000';
 
 static void loadWorld (GC_state s, char *fileName) {
-	FILE *file;
-	uint magic;
-	pointer oldGen;
-	int c;
-	
-	if (DEBUG_WORLD)
-		fprintf (stderr, "loadWorld (%s)\n", fileName);
-	file = sfopen (fileName, "rb");
-	until ((c = fgetc (file)) == worldTerminator or EOF == c);
-	if (EOF == c) die ("Invalid world.");
-	magic = sfreadUint (file);
-	unless (s->magic == magic)
-		die ("Invalid world: wrong magic number.");
-	oldGen = (pointer) sfreadUint (file);
-	s->oldGenSize = sfreadUint (file);
-	s->callFromCHandler = (GC_thread) sfreadUint (file);
-	s->canHandle = sfreadUint (file);
-	s->currentThread = (GC_thread) sfreadUint (file);
-	s->signalHandler = (GC_thread) sfreadUint (file);
-       	heapCreate (s, &s->heap, heapDesiredSize (s, s->oldGenSize, 0),
-			s->oldGenSize);
-	createCardMapAndCrossMap (s);
-	sfread (s->heap.start, 1, s->oldGenSize, file);
-	(*s->loadGlobals) (file);
-	unless (EOF == fgetc (file))
-		die ("Invalid world: junk at end of file.");
-	fclose (file);
-	/* translateHeap must occur after loading the heap and globals, since it
-	 * changes pointers in all of them.
-	 */
-	translateHeap (s, oldGen, s->heap.start, s->oldGenSize);
-	setNursery (s, 0, 0);
-	setStack (s);
+        FILE *file;
+        uint magic;
+        pointer oldGen;
+        int c;
+        
+        if (DEBUG_WORLD)
+                fprintf (stderr, "loadWorld (%s)\n", fileName);
+        file = sfopen (fileName, "rb");
+        until ((c = fgetc (file)) == worldTerminator or EOF == c);
+        if (EOF == c) die ("Invalid world.");
+        magic = sfreadUint (file);
+        unless (s->magic == magic)
+                die ("Invalid world: wrong magic number.");
+        oldGen = (pointer) sfreadUint (file);
+        s->oldGenSize = sfreadUint (file);
+        s->callFromCHandler = (GC_thread) sfreadUint (file);
+        s->canHandle = sfreadUint (file);
+        s->currentThread = (GC_thread) sfreadUint (file);
+        s->signalHandler = (GC_thread) sfreadUint (file);
+        heapCreate (s, &s->heap, heapDesiredSize (s, s->oldGenSize, 0),
+                        s->oldGenSize);
+        createCardMapAndCrossMap (s);
+        sfread (s->heap.start, 1, s->oldGenSize, file);
+        (*s->loadGlobals) (file);
+        unless (EOF == fgetc (file))
+                die ("Invalid world: junk at end of file.");
+        fclose (file);
+        /* translateHeap must occur after loading the heap and globals, since it
+         * changes pointers in all of them.
+         */
+        translateHeap (s, oldGen, s->heap.start, s->oldGenSize);
+        setNursery (s, 0, 0);
+        setStack (s);
 }
 
 /* ---------------------------------------------------------------- */
@@ -4294,381 +4298,383 @@
 Bool MLton_Platform_CygwinUseMmap;
 
 static int processAtMLton (GC_state s, int argc, char **argv, 
-				string *worldFile) {
-	int i;
+                                string *worldFile) {
+        int i;
 
-	i = 1;
-	while (s->mayProcessAtMLton 
-		and i < argc 
-		and (0 == strcmp (argv [i], "@MLton"))) {
-		bool done;
+        i = 1;
+        while (s->mayProcessAtMLton 
+                and i < argc 
+                and (0 == strcmp (argv [i], "@MLton"))) {
+                bool done;
 
-		i++;
-		done = FALSE;
-		while (!done) {
-			if (i == argc)
-				die ("Missing -- at end of @MLton args.");
-			else {
-				string arg;
+                i++;
+                done = FALSE;
+                while (!done) {
+                        if (i == argc)
+                                die ("Missing -- at end of @MLton args.");
+                        else {
+                                string arg;
 
-				arg = argv[i];
-				if (0 == strcmp (arg, "copy-ratio")) {
-					++i;
-					if (i == argc)
-						die ("@MLton copy-ratio missing argument.");
-					s->copyRatio =
-						stringToFloat (argv[i++]);
-				} else if (0 == strcmp(arg, "fixed-heap")) {
-					++i;
-					if (i == argc)
-						die ("@MLton fixed-heap missing argument.");
-					s->fixedHeap = 
-						align (stringToBytes (argv[i++]),
-							2 * s->pageSize);
-				} else if (0 == strcmp (arg, "gc-messages")) {
-					++i;
-					s->messages = TRUE;
-				} else if (0 == strcmp (arg, "gc-summary")) {
-					++i;
+                                arg = argv[i];
+                                if (0 == strcmp (arg, "copy-ratio")) {
+                                        ++i;
+                                        if (i == argc)
+                                                die ("@MLton copy-ratio missing argument.");
+                                        s->copyRatio =
+                                                stringToFloat (argv[i++]);
+                                } else if (0 == strcmp(arg, "fixed-heap")) {
+                                        ++i;
+                                        if (i == argc)
+                                                die ("@MLton fixed-heap missing argument.");
+                                        s->fixedHeap = 
+                                                align (stringToBytes (argv[i++]),
+                                                        2 * s->pageSize);
+                                } else if (0 == strcmp (arg, "gc-messages")) {
+                                        ++i;
+                                        s->messages = TRUE;
+                                } else if (0 == strcmp (arg, "gc-summary")) {
+                                        ++i;
 #if (defined (__MINGW32__))
-					fprintf (stderr, "Warning: MinGW doesn't yet support gc-summary\n");
+                                        fprintf (stderr, "Warning: MinGW doesn't yet support gc-summary\n");
 #else
-					s->summary = TRUE;
+                                        s->summary = TRUE;
 #endif
-				} else if (0 == strcmp (arg, "copy-generational-ratio")) {
-					++i;
-					if (i == argc)
-						die ("@MLton copy-generational-ratio missing argument.");
-					s->copyGenerationalRatio =
-						stringToFloat (argv[i++]);
-				} else if (0 == strcmp (arg, "grow-ratio")) {
-					++i;
-					if (i == argc)
-						die ("@MLton grow-ratio missing argument.");
-					s->growRatio =
-						stringToFloat (argv[i++]);
-				} else if (0 == strcmp (arg, "hash-cons")) {
-					++i;
-					if (i == argc)
-						die ("@MLton hash-cons missing argument.");
-					s->hashConsFrequency =
-						stringToFloat (argv[i++]);
-					unless (0.0 <= s->hashConsFrequency
-						and s->hashConsFrequency <= 1.0)
-						die ("@MLton hash-cons argument must be between 0.0 and 1.0");
-				} else if (0 == strcmp (arg, "live-ratio")) {
-					++i;
-					if (i == argc)
-						die ("@MLton live-ratio missing argument.");
-					s->liveRatio =
-						stringToFloat (argv[i++]);
-				} else if (0 == strcmp (arg, "load-world")) {
-					unless (s->mayLoadWorld)
-						die ("May not load world.");
-					++i;
-					s->isOriginal = FALSE;
-					if (i == argc) 
-						die ("@MLton load-world missing argument.");
-					*worldFile = argv[i++];
-				} else if (0 == strcmp (arg, "max-heap")) {
-					++i;
-					if (i == argc) 
-						die ("@MLton max-heap missing argument.");
-					s->maxHeap = align (stringToBytes (argv[i++]),
-								2 * s->pageSize);
-				} else if (0 == strcmp (arg, "mark-compact-generational-ratio")) {
-					++i;
-					if (i == argc)
-						die ("@MLton mark-compact-generational-ratio missing argument.");
-					s->markCompactGenerationalRatio =
-						stringToFloat (argv[i++]);
-				} else if (0 == strcmp (arg, "mark-compact-ratio")) {
-					++i;
-					if (i == argc)
-						die ("@MLton mark-compact-ratio missing argument.");
-					s->markCompactRatio =
-						stringToFloat (argv[i++]);
-				} else if (0 == strcmp (arg, "no-load-world")) {
-					++i;
-					s->mayLoadWorld = FALSE;
-				} else if (0 == strcmp (arg, "nursery-ratio")) {
-					++i;
-					if (i == argc)
-						die ("@MLton nursery-ratio missing argument.");
-					s->nurseryRatio =
-						stringToFloat (argv[i++]);
-				} else if (0 == strcmp (arg, "ram-slop")) {
-					++i;
-					if (i == argc)
-						die ("@MLton ram-slop missing argument.");
-					s->ramSlop =
-						stringToFloat (argv[i++]);
-				} else if (0 == strcmp (arg, "show-prof")) {
-					showProf (s);
-					exit (0);
-				} else if (0 == strcmp (arg, "stop")) {
-					++i;
-					s->mayProcessAtMLton = FALSE;
-				} else if (0 == strcmp (arg, "thread-shrink-ratio")) {
-					++i;
-					if (i == argc)
-						die ("@MLton thread-shrink-ratio missing argument.");
-					s->threadShrinkRatio =
-						stringToFloat (argv[i++]);
-				} else if (0 == strcmp (arg, "use-mmap")) {
-					++i;
-					MLton_Platform_CygwinUseMmap = TRUE;
-				} else if (0 == strcmp (arg, "--")) {
-					++i;
-					done = TRUE;
-				} else if (i > 1)
-					die ("Strange @MLton arg: %s", argv[i]);
-			        else done = TRUE;
-			}
-		}
-	}
-	return i;
+                                } else if (0 == strcmp (arg, "copy-generational-ratio")) {
+                                        ++i;
+                                        if (i == argc)
+                                                die ("@MLton copy-generational-ratio missing argument.");
+                                        s->copyGenerationalRatio =
+                                                stringToFloat (argv[i++]);
+                                } else if (0 == strcmp (arg, "grow-ratio")) {
+                                        ++i;
+                                        if (i == argc)
+                                                die ("@MLton grow-ratio missing argument.");
+                                        s->growRatio =
+                                                stringToFloat (argv[i++]);
+                                } else if (0 == strcmp (arg, "hash-cons")) {
+                                        ++i;
+                                        if (i == argc)
+                                                die ("@MLton hash-cons missing argument.");
+                                        s->hashConsFrequency =
+                                                stringToFloat (argv[i++]);
+                                        unless (0.0 <= s->hashConsFrequency
+                                                and s->hashConsFrequency <= 1.0)
+                                                die ("@MLton hash-cons argument must be between 0.0 and 1.0");
+                                } else if (0 == strcmp (arg, "live-ratio")) {
+                                        ++i;
+                                        if (i == argc)
+                                                die ("@MLton live-ratio missing argument.");
+                                        s->liveRatio =
+                                                stringToFloat (argv[i++]);
+                                } else if (0 == strcmp (arg, "load-world")) {
+                                        unless (s->mayLoadWorld)
+                                                die ("May not load world.");
+                                        ++i;
+                                        s->isOriginal = FALSE;
+                                        if (i == argc) 
+                                                die ("@MLton load-world missing argument.");
+                                        *worldFile = argv[i++];
+                                } else if (0 == strcmp (arg, "max-heap")) {
+                                        ++i;
+                                        if (i == argc) 
+                                                die ("@MLton max-heap missing argument.");
+                                        s->maxHeap = align (stringToBytes (argv[i++]),
+                                                                2 * s->pageSize);
+                                } else if (0 == strcmp (arg, "mark-compact-generational-ratio")) {
+                                        ++i;
+                                        if (i == argc)
+                                                die ("@MLton mark-compact-generational-ratio missing argument.");
+                                        s->markCompactGenerationalRatio =
+                                                stringToFloat (argv[i++]);
+                                } else if (0 == strcmp (arg, "mark-compact-ratio")) {
+                                        ++i;
+                                        if (i == argc)
+                                                die ("@MLton mark-compact-ratio missing argument.");
+                                        s->markCompactRatio =
+                                                stringToFloat (argv[i++]);
+                                } else if (0 == strcmp (arg, "no-load-world")) {
+                                        ++i;
+                                        s->mayLoadWorld = FALSE;
+                                } else if (0 == strcmp (arg, "nursery-ratio")) {
+                                        ++i;
+                                        if (i == argc)
+                                                die ("@MLton nursery-ratio missing argument.");
+                                        s->nurseryRatio =
+                                                stringToFloat (argv[i++]);
+                                } else if (0 == strcmp (arg, "ram-slop")) {
+                                        ++i;
+                                        if (i == argc)
+                                                die ("@MLton ram-slop missing argument.");
+                                        s->ramSlop =
+                                                stringToFloat (argv[i++]);
+                                } else if (0 == strcmp (arg, "show-prof")) {
+                                        showProf (s);
+                                        exit (0);
+                                } else if (0 == strcmp (arg, "stop")) {
+                                        ++i;
+                                        s->mayProcessAtMLton = FALSE;
+                                } else if (0 == strcmp (arg, "thread-shrink-ratio")) {
+                                        ++i;
+                                        if (i == argc)
+                                                die ("@MLton thread-shrink-ratio missing argument.");
+                                        s->threadShrinkRatio =
+                                                stringToFloat (argv[i++]);
+                                } else if (0 == strcmp (arg, "use-mmap")) {
+                                        ++i;
+                                        MLton_Platform_CygwinUseMmap = TRUE;
+                                } else if (0 == strcmp (arg, "--")) {
+                                        ++i;
+                                        done = TRUE;
+                                } else if (i > 1)
+                                        die ("Strange @MLton arg: %s", argv[i]);
+                                else done = TRUE;
+                        }
+                }
+        }
+        return i;
 }
 
 int GC_init (GC_state s, int argc, char **argv) {
-	char *worldFile;
-	int i;
+        char *worldFile;
+        int i;
 
-	assert (isAligned (sizeof (struct GC_stack), s->alignment));
-	assert (isAligned (GC_NORMAL_HEADER_SIZE + sizeof (struct GC_thread),
-				s->alignment));
-	assert (isAligned (GC_NORMAL_HEADER_SIZE + sizeof (struct GC_weak),
-				s->alignment));
- 	MLton_Platform_CygwinUseMmap = FALSE;
-	s->amInGC = TRUE;
-	s->amInMinorGC = FALSE;
-	s->bytesAllocated = 0;
-	s->bytesCopied = 0;
-	s->bytesCopiedMinor = 0;
-	s->bytesMarkCompacted = 0;
-	s->callFromCHandler = BOGUS_THREAD;
-	s->canHandle = 0;
-	s->cardSize = 0x1 << s->cardSizeLog2;
-	s->copyRatio = 4.0;
-	s->copyGenerationalRatio = 4.0;
-	s->currentThread = BOGUS_THREAD;
-	s->fixedHeap = 0.0;
-	s->gcSignalIsPending = FALSE;
-	s->growRatio = 8.0;
-	s->handleGCSignal = FALSE;
-	s->hashConsDuringGC = FALSE;
-	s->hashConsFrequency = 0.0;
-	s->inSignalHandler = FALSE;
-	s->isOriginal = TRUE;
-	s->lastMajor = GC_COPYING;
-	s->liveRatio = 8.0;
-	s->markCompactRatio = 1.04;
-	s->markCompactGenerationalRatio = 8.0;
-	s->markedCards = 0;
-	s->maxBytesLive = 0;
-	s->maxHeap = 0;
-	s->maxHeapSizeSeen = 0;
-	s->maxPause = 0;
-	s->maxStackSizeSeen = 0;
-	s->mayLoadWorld = TRUE;
-	s->mayProcessAtMLton = TRUE;
-	s->messages = FALSE;
-	s->minorBytesScanned = 0;
-	s->minorBytesSkipped = 0;
-	s->numCopyingGCs = 0;
-	s->numLCs = 0;
-	s->numHashConsGCs = 0;
-	s->numMarkCompactGCs = 0;
-	s->numMinorGCs = 0;
-	s->numMinorsSinceLastMajor = 0;
-	s->nurseryRatio = 10.0;
-	s->oldGenArraySize = 0x100000;
-	s->pageSize = getpagesize ();
-	s->ramSlop = 0.5;
-	s->savedThread = BOGUS_THREAD;
-	s->signalHandler = BOGUS_THREAD;
-	s->signalIsPending = FALSE;
-	s->startTime = currentTime ();
-	s->summary = FALSE;
-	s->threadShrinkRatio = 0.5;
-	s->weaks = NULL;
-	heapInit (&s->heap);
-	heapInit (&s->heap2);
-	sigemptyset (&s->signalsHandled);
-	initSignalStack (s);
-	sigemptyset (&s->signalsPending);
-	rusageZero (&s->ru_gc);
-	rusageZero (&s->ru_gcCopy);
-	rusageZero (&s->ru_gcMarkCompact);
-	rusageZero (&s->ru_gcMinor);
-	worldFile = NULL;
-	unless (isAligned (s->pageSize, s->cardSize))
-		die ("Page size must be a multiple of card size.");
-	processAtMLton (s, s->atMLtonsSize, s->atMLtons, &worldFile);
-	i = processAtMLton (s, argc, argv, &worldFile);
-	if (s->fixedHeap > 0 and s->maxHeap > 0)
-		die ("Cannot use both fixed-heap and max-heap.\n");
-	unless (ratiosOk (s))
-		die ("invalid ratios");
-	s->totalRam = totalRam (s);
-	/* We align s->ram by pageSize so that we can test whether or not we
-	 * we are using mark-compact by comparing heap size to ram size.  If 
-	 * we didn't round, the size might be slightly off.
+        assert (isAligned (sizeof (struct GC_stack), s->alignment));
+        assert (isAligned (GC_NORMAL_HEADER_SIZE + sizeof (struct GC_thread),
+                                s->alignment));
+        assert (isAligned (GC_NORMAL_HEADER_SIZE + sizeof (struct GC_weak),
+                                s->alignment));
+        MLton_Platform_CygwinUseMmap = TRUE;
+        s->amInGC = TRUE;
+        s->amInMinorGC = FALSE;
+        s->bytesAllocated = 0;
+        s->bytesCopied = 0;
+        s->bytesCopiedMinor = 0;
+        s->bytesMarkCompacted = 0;
+        s->callFromCHandler = BOGUS_THREAD;
+        s->canHandle = 0;
+        s->cardSize = 0x1 << CARD_SIZE_LOG2;
+        s->copyRatio = 4.0;
+        s->copyGenerationalRatio = 4.0;
+        s->currentThread = BOGUS_THREAD;
+        s->fixedHeap = 0.0;
+        s->gcSignalIsPending = FALSE;
+        s->growRatio = 8.0;
+        s->handleGCSignal = FALSE;
+        s->hashConsDuringGC = FALSE;
+        s->hashConsFrequency = 0.0;
+        s->inSignalHandler = FALSE;
+        s->isOriginal = TRUE;
+        s->lastMajor = GC_COPYING;
+        s->liveRatio = 8.0;
+        s->markCompactRatio = 1.04;
+        s->markCompactGenerationalRatio = 8.0;
+        s->markedCards = 0;
+        s->maxBytesLive = 0;
+        s->maxHeap = 0;
+        s->maxHeapSizeSeen = 0;
+        s->maxPause = 0;
+        s->maxStackSizeSeen = 0;
+        s->mayLoadWorld = TRUE;
+        s->mayProcessAtMLton = TRUE;
+        s->messages = FALSE;
+        s->minorBytesScanned = 0;
+        s->minorBytesSkipped = 0;
+        s->numCopyingGCs = 0;
+        s->numLCs = 0;
+        s->numHashConsGCs = 0;
+        s->numMarkCompactGCs = 0;
+        s->numMinorGCs = 0;
+        s->numMinorsSinceLastMajor = 0;
+        s->nurseryRatio = 10.0;
+        s->oldGenArraySize = 0x100000;
+        s->pageSize = getpagesize ();
+        s->ramSlop = 0.5;
+        s->rusageMeasureGC = FALSE;
+        s->savedThread = BOGUS_THREAD;
+        s->signalHandler = BOGUS_THREAD;
+        s->signalIsPending = FALSE;
+        s->startTime = currentTime ();
+        s->summary = FALSE;
+        s->threadShrinkRatio = 0.5;
+        s->weaks = NULL;
+        heapInit (&s->heap);
+        heapInit (&s->heap2);
+        sigemptyset (&s->signalsHandled);
+        initSignalStack (s);
+        sigemptyset (&s->signalsPending);
+        rusageZero (&s->ru_gc);
+        rusageZero (&s->ru_gcCopy);
+        rusageZero (&s->ru_gcMarkCompact);
+        rusageZero (&s->ru_gcMinor);
+        worldFile = NULL;
+        unless (isAligned (s->pageSize, s->cardSize))
+                die ("Page size must be a multiple of card size.");
+        processAtMLton (s, s->atMLtonsSize, s->atMLtons, &worldFile);
+        i = processAtMLton (s, argc, argv, &worldFile);
+        if (s->fixedHeap > 0 and s->maxHeap > 0)
+                die ("Cannot use both fixed-heap and max-heap.\n");
+        unless (ratiosOk (s))
+                die ("invalid ratios");
+        s->totalRam = totalRam (s);
+        /* We align s->ram by pageSize so that we can test whether or not we
+         * we are using mark-compact by comparing heap size to ram size.  If 
+         * we didn't round, the size might be slightly off.
          */
-	s->ram = align (s->ramSlop * s->totalRam, s->pageSize);
-	if (DEBUG or DEBUG_RESIZING or s->messages)
-		fprintf (stderr, "total RAM = %s  RAM = %s\n",
-				uintToCommaString (s->totalRam), 
-				uintToCommaString (s->ram));
-	if (DEBUG_PROFILE) {
-		int i;
-			for (i = 0; i < s->frameSourcesSize; ++i) {
-			int j;
-			uint *sourceSeq;
-				fprintf (stderr, "%d\n", i);
-			sourceSeq = s->sourceSeqs[s->frameSources[i]];
-			for (j = 1; j <= sourceSeq[0]; ++j)
-				fprintf (stderr, "\t%s\n",
-						s->sourceNames[s->sources[sourceSeq[j]].nameIndex]);
-		}
-	}
-	/* Initialize profiling.  This must occur after processing command-line 
+        s->ram = align (s->ramSlop * s->totalRam, s->pageSize);
+        if (DEBUG or DEBUG_RESIZING or s->messages)
+                fprintf (stderr, "total RAM = %s  RAM = %s\n",
+                                uintToCommaString (s->totalRam), 
+                                uintToCommaString (s->ram));
+        if (DEBUG_PROFILE) {
+                int i;
+                        for (i = 0; i < s->frameSourcesSize; ++i) {
+                        int j;
+                        uint *sourceSeq;
+                                fprintf (stderr, "%d\n", i);
+                        sourceSeq = s->sourceSeqs[s->frameSources[i]];
+                        for (j = 1; j <= sourceSeq[0]; ++j)
+                                fprintf (stderr, "\t%s\n",
+                                                s->sourceNames[s->sources[sourceSeq[j]].nameIndex]);
+                }
+        }
+        /* Initialize profiling.  This must occur after processing command-line 
          * arguments, because those may just be doing a show prof, in which 
          * case we don't want to initialize the atExit.
          */
-	if (PROFILE_NONE == s->profileKind)
-		s->profilingIsOn = FALSE;
-	else {
-		s->profilingIsOn = TRUE;
-		assert (s->frameSourcesSize == s->frameLayoutsSize);
-		switch (s->profileKind) {
-		case PROFILE_ALLOC:
-		case PROFILE_COUNT:
-			s->profile = GC_profileNew (s);
-		break;
-		case PROFILE_NONE:
-			die ("impossible PROFILE_NONE");
-		case PROFILE_TIME:
-			profileTimeInit (s);
-		break;
-		}
-		profileEndState = s;
-		atexit (profileEnd);
-	}
-	if (s->isOriginal) {
-		newWorld (s);
-		/* The mutator stack invariant doesn't hold,
-		 * because the mutator has yet to run.
-		 */
-		assert (mutatorInvariant (s, TRUE, FALSE));
-	} else {
-		loadWorld (s, worldFile);
-		if (s->profilingIsOn and s->profileStack)
-			GC_foreachStackFrame (s, enterFrame);
-		assert (mutatorInvariant (s, TRUE, TRUE));
-	}
-	s->amInGC = FALSE;
-	return i;
+        if (PROFILE_NONE == s->profileKind)
+                s->profilingIsOn = FALSE;
+        else {
+                s->profilingIsOn = TRUE;
+                assert (s->frameSourcesSize == s->frameLayoutsSize);
+                switch (s->profileKind) {
+                case PROFILE_ALLOC:
+                case PROFILE_COUNT:
+                        s->profile = GC_profileNew (s);
+                break;
+                case PROFILE_NONE:
+                        die ("impossible PROFILE_NONE");
+                case PROFILE_TIME_FIELD:
+                case PROFILE_TIME_LABEL:
+                        profileTimeInit (s);
+                break;
+                }
+                profileEndState = s;
+                atexit (profileEnd);
+        }
+        if (s->isOriginal) {
+                newWorld (s);
+                /* The mutator stack invariant doesn't hold,
+                 * because the mutator has yet to run.
+                 */
+                assert (mutatorInvariant (s, TRUE, FALSE));
+        } else {
+                loadWorld (s, worldFile);
+                if (s->profilingIsOn and s->profileStack)
+                        GC_foreachStackFrame (s, enterFrame);
+                assert (mutatorInvariant (s, TRUE, TRUE));
+        }
+        s->amInGC = FALSE;
+        return i;
 }
 
 extern char **environ; /* for Posix_ProcEnv_environ */
 
 void MLton_init (int argc, char **argv, GC_state s) {
-	int start;
+        int start;
 
-	Posix_ProcEnv_environ = (CstringArray)environ;
-	start = GC_init (s, argc, argv);
-	/* Setup argv and argc that SML sees. */
-	/* start is now the index of the first real arg. */
-	CommandLine_commandName = (uint)(argv[0]);
-	CommandLine_argc = argc - start;
-	CommandLine_argv = (uint)(argv + start);
+        Posix_ProcEnv_environ = (CstringArray)environ;
+        start = GC_init (s, argc, argv);
+        /* Setup argv and argc that SML sees. */
+        /* start is now the index of the first real arg. */
+        CommandLine_commandName = (uint)(argv[0]);
+        CommandLine_argc = argc - start;
+        CommandLine_argv = (uint)(argv + start);
 }
 
 static void displayCol (FILE *out, int width, string s) {
-	int extra;
-	int i;
-	int len;
+        int extra;
+        int i;
+        int len;
 
-	len = strlen (s);
-	if (len < width) {
-	        extra = width - len;
-		for (i = 0; i < extra; ++i)
-			fprintf (out, " ");
-	}
-	fprintf (out, "%s\t", s);
+        len = strlen (s);
+        if (len < width) {
+                extra = width - len;
+                for (i = 0; i < extra; ++i)
+                        fprintf (out, " ");
+        }
+        fprintf (out, "%s\t", s);
 }
 
 static void displayCollectionStats (FILE *out, string name, struct rusage *ru, 
-					uint num, ullong bytes) {
-	uint ms;
+                                        uint num, ullong bytes) {
+        uint ms;
 
-	ms = rusageTime (ru);
-	fprintf (out, "%s", name);
-	displayCol (out, 7, uintToCommaString (ms));
-	displayCol (out, 7, uintToCommaString (num));
-	displayCol (out, 15, ullongToCommaString (bytes));
-	displayCol (out, 15, 
-			(ms > 0)
-			? uintToCommaString (1000.0 * (float)bytes/(float)ms)
-			: "-");
-	fprintf (out, "\n");
+        ms = rusageTime (ru);
+        fprintf (out, "%s", name);
+        displayCol (out, 7, uintToCommaString (ms));
+        displayCol (out, 7, uintToCommaString (num));
+        displayCol (out, 15, ullongToCommaString (bytes));
+        displayCol (out, 15, 
+                        (ms > 0)
+                        ? uintToCommaString (1000.0 * (float)bytes/(float)ms)
+                        : "-");
+        fprintf (out, "\n");
 }
 
 void GC_done (GC_state s) {
-	FILE *out;
+        FILE *out;
 
-	enter (s);
-	minorGC (s);
-	out = stderr;
-	if (s->summary) {
-		double time;
-		uint gcTime;
+        enter (s);
+        minorGC (s);
+        out = stderr;
+        if (s->summary) {
+                double time;
+                uint gcTime;
 
-		gcTime = rusageTime (&s->ru_gc);
-		fprintf (out, "GC type\t\ttime ms\t number\t\t  bytes\t      bytes/sec\n");
-		fprintf (out, "-------------\t-------\t-------\t---------------\t---------------\n");
-		displayCollectionStats
-			(out, "copying\t\t", &s->ru_gcCopy, s->numCopyingGCs, 
-				s->bytesCopied);
-		displayCollectionStats
-			(out, "mark-compact\t", &s->ru_gcMarkCompact, 
-				s->numMarkCompactGCs, s->bytesMarkCompacted);
-		displayCollectionStats
-			(out, "minor\t\t", &s->ru_gcMinor, s->numMinorGCs, 
-				s->bytesCopiedMinor);
-		time = (double)(currentTime () - s->startTime);
-		fprintf (out, "total GC time: %s ms (%.1f%%)\n",
-				intToCommaString (gcTime), 
-				(0.0 == time) 
-					? 0.0 
-					: 100.0 * ((double) gcTime) / time);
-		fprintf (out, "max pause: %s ms\n",
-				uintToCommaString (s->maxPause));
-		fprintf (out, "total allocated: %s bytes\n",
-	 			ullongToCommaString (s->bytesAllocated));
-		fprintf (out, "max live: %s bytes\n",
-				uintToCommaString (s->maxBytesLive));
-		fprintf (out, "max semispace: %s bytes\n", 
-				uintToCommaString (s->maxHeapSizeSeen));
-		fprintf (out, "max stack size: %s bytes\n", 
-				uintToCommaString (s->maxStackSizeSeen));
-		fprintf (out, "marked cards: %s\n", 
-				ullongToCommaString (s->markedCards));
-		fprintf (out, "minor scanned: %s bytes\n",
-				uintToCommaString (s->minorBytesScanned));
-		fprintf (out, "minor skipped: %s bytes\n", 
-				uintToCommaString (s->minorBytesSkipped));
-	}
-	heapRelease (s, &s->heap);
-	heapRelease (s, &s->heap2);
+                gcTime = rusageTime (&s->ru_gc);
+                fprintf (out, "GC type\t\ttime ms\t number\t\t  bytes\t      bytes/sec\n");
+                fprintf (out, "-------------\t-------\t-------\t---------------\t---------------\n");
+                displayCollectionStats
+                        (out, "copying\t\t", &s->ru_gcCopy, s->numCopyingGCs, 
+                                s->bytesCopied);
+                displayCollectionStats
+                        (out, "mark-compact\t", &s->ru_gcMarkCompact, 
+                                s->numMarkCompactGCs, s->bytesMarkCompacted);
+                displayCollectionStats
+                        (out, "minor\t\t", &s->ru_gcMinor, s->numMinorGCs, 
+                                s->bytesCopiedMinor);
+                time = (double)(currentTime () - s->startTime);
+                fprintf (out, "total GC time: %s ms (%.1f%%)\n",
+                                intToCommaString (gcTime), 
+                                (0.0 == time) 
+                                        ? 0.0 
+                                        : 100.0 * ((double) gcTime) / time);
+                fprintf (out, "max pause: %s ms\n",
+                                uintToCommaString (s->maxPause));
+                fprintf (out, "total allocated: %s bytes\n",
+                                ullongToCommaString (s->bytesAllocated));
+                fprintf (out, "max live: %s bytes\n",
+                                uintToCommaString (s->maxBytesLive));
+                fprintf (out, "max semispace: %s bytes\n", 
+                                uintToCommaString (s->maxHeapSizeSeen));
+                fprintf (out, "max stack size: %s bytes\n", 
+                                uintToCommaString (s->maxStackSizeSeen));
+                fprintf (out, "marked cards: %s\n", 
+                                ullongToCommaString (s->markedCards));
+                fprintf (out, "minor scanned: %s bytes\n",
+                                uintToCommaString (s->minorBytesScanned));
+                fprintf (out, "minor skipped: %s bytes\n", 
+                                uintToCommaString (s->minorBytesSkipped));
+        }
+        heapRelease (s, &s->heap);
+        heapRelease (s, &s->heap2);
 }
 
 void GC_finishHandler (GC_state s) {
-	if (DEBUG_SIGNALS)
-		fprintf (stderr, "GC_finishHandler ()\n");
-	assert (s->canHandle == 1);
-	s->inSignalHandler = FALSE;	
+        if (DEBUG_SIGNALS)
+                fprintf (stderr, "GC_finishHandler ()\n");
+        assert (s->canHandle == 1);
+        s->inSignalHandler = FALSE;     
 }
 
 /* GC_handler sets s->limit = 0 so that the next limit check will fail. 
@@ -4677,102 +4683,102 @@
  * The signals are blocked by Posix_Signal_handle (see Posix/Signal/Signal.c).
  */
 void GC_handler (GC_state s, int signum) {
-	if (DEBUG_SIGNALS)
-		fprintf (stderr, "GC_handler signum = %d\n", signum);
-	assert (sigismember (&s->signalsHandled, signum));
-	if (s->canHandle == 0)
-		s->limit = 0;
-	s->signalIsPending = TRUE;
-	sigaddset (&s->signalsPending, signum);
-	if (DEBUG_SIGNALS)
-		fprintf (stderr, "GC_handler done\n");
+        if (DEBUG_SIGNALS)
+                fprintf (stderr, "GC_handler signum = %d\n", signum);
+        assert (sigismember (&s->signalsHandled, signum));
+        if (s->canHandle == 0)
+                s->limit = 0;
+        s->signalIsPending = TRUE;
+        sigaddset (&s->signalsPending, signum);
+        if (DEBUG_SIGNALS)
+                fprintf (stderr, "GC_handler done\n");
 }
 
 uint GC_size (GC_state s, pointer root) {
-	uint res;
+        uint res;
 
-	if (DEBUG_SIZE)
-		fprintf (stderr, "GC_size marking\n");
-	res = mark (s, root, MARK_MODE, FALSE);
-	if (DEBUG_SIZE)
-		fprintf (stderr, "GC_size unmarking\n");
-	mark (s, root, UNMARK_MODE, FALSE);
-	return res;
+        if (DEBUG_SIZE)
+                fprintf (stderr, "GC_size marking\n");
+        res = mark (s, root, MARK_MODE, FALSE);
+        if (DEBUG_SIZE)
+                fprintf (stderr, "GC_size unmarking\n");
+        mark (s, root, UNMARK_MODE, FALSE);
+        return res;
 }
 
 void GC_saveWorld (GC_state s, int fd) {
-	char buf[80];
+        char buf[80];
 
-	if (DEBUG_WORLD)
-		fprintf (stderr, "GC_saveWorld (%d).\n", fd);
-	enter (s);
-	/* Compact the heap. */
-	doGC (s, 0, 0, TRUE, TRUE);
-	sprintf (buf,
-		"Heap file created by MLton.\nheap.start = 0x%08x\nbytesLive = %u\n",
-		(uint)s->heap.start, (uint)s->bytesLive);
-	swrite (fd, buf, 1 + strlen(buf)); /* +1 to get the '\000' */
-	swriteUint (fd, s->magic);
-	swriteUint (fd, (uint)s->heap.start);
-	swriteUint (fd, (uint)s->oldGenSize);
-	swriteUint (fd, (uint)s->callFromCHandler);
-	/* canHandle must be saved in the heap, because the saveWorld may be
-	 * run in the context of a critical section, which will expect to be in	
-	 * the same context when it is restored.
-	 */
-	swriteUint (fd, s->canHandle);
-	swriteUint (fd, (uint)s->currentThread);
-	swriteUint (fd, (uint)s->signalHandler);
- 	swrite (fd, s->heap.start, s->oldGenSize);
-	(*s->saveGlobals) (fd);
-	leave (s);
+        if (DEBUG_WORLD)
+                fprintf (stderr, "GC_saveWorld (%d).\n", fd);
+        enter (s);
+        /* Compact the heap. */
+        doGC (s, 0, 0, TRUE, TRUE);
+        sprintf (buf,
+                "Heap file created by MLton.\nheap.start = 0x%08x\nbytesLive = %u\n",
+                (uint)s->heap.start, (uint)s->bytesLive);
+        swrite (fd, buf, 1 + strlen(buf)); /* +1 to get the '\000' */
+        swriteUint (fd, s->magic);
+        swriteUint (fd, (uint)s->heap.start);
+        swriteUint (fd, (uint)s->oldGenSize);
+        swriteUint (fd, (uint)s->callFromCHandler);
+        /* canHandle must be saved in the heap, because the saveWorld may be
+         * run in the context of a critical section, which will expect to be in 
+         * the same context when it is restored.
+         */
+        swriteUint (fd, s->canHandle);
+        swriteUint (fd, (uint)s->currentThread);
+        swriteUint (fd, (uint)s->signalHandler);
+        swrite (fd, s->heap.start, s->oldGenSize);
+        (*s->saveGlobals) (fd);
+        leave (s);
 }
 
 void GC_pack (GC_state s) {
-	uint keep;
+        uint keep;
 
-	enter (s);
-	if (DEBUG or s->messages)
-		fprintf (stderr, "Packing heap of size %s.\n",
-				uintToCommaString (s->heap.size));
-	/* Could put some code here to skip the GC if there hasn't been much
-	 * allocated since the last collection.  But you would still need to 
-	 * do a minor GC to make all objects contiguous.
- 	 */
-	doGC (s, 0, 0, TRUE, FALSE);
-	keep = s->oldGenSize * 1.1;
-	if (keep <= s->heap.size) {
-		heapShrink (s, &s->heap, keep);
-		setNursery (s, 0, 0);
-		setStack (s);
-	}
-	heapRelease (s, &s->heap2);
-	if (DEBUG or s->messages)
-		fprintf (stderr, "Packed heap to size %s.\n",
-				uintToCommaString (s->heap.size));
-	leave (s);
+        enter (s);
+        if (DEBUG or s->messages)
+                fprintf (stderr, "Packing heap of size %s.\n",
+                                uintToCommaString (s->heap.size));
+        /* Could put some code here to skip the GC if there hasn't been much
+         * allocated since the last collection.  But you would still need to 
+         * do a minor GC to make all objects contiguous.
+         */
+        doGC (s, 0, 0, TRUE, FALSE);
+        keep = s->oldGenSize * 1.1;
+        if (keep <= s->heap.size) {
+                heapShrink (s, &s->heap, keep);
+                setNursery (s, 0, 0);
+                setStack (s);
+        }
+        heapRelease (s, &s->heap2);
+        if (DEBUG or s->messages)
+                fprintf (stderr, "Packed heap to size %s.\n",
+                                uintToCommaString (s->heap.size));
+        leave (s);
 }
 
 void GC_unpack (GC_state s) {
-	enter (s);
-	if (DEBUG or s->messages)
-		fprintf (stderr, "Unpacking heap of size %s.\n",
-				uintToCommaString (s->heap.size));
-	/* The enterGC is needed here because minorGC and resizeHeap might move
-	 * the stack, and the SIGPROF catcher would then see a bogus stack.  The
- 	 * leaveGC has to happen after the setStack.
-	 */
-	enterGC (s);
-	minorGC (s);
-	resizeHeap (s, s->oldGenSize);
-	resizeHeap2 (s);
-	setNursery (s, 0, 0);
-	setStack (s);
-	leaveGC (s);
-	if (DEBUG or s->messages)
-		fprintf (stderr, "Unpacked heap to size %s.\n",
-				uintToCommaString (s->heap.size));
-	leave (s);
+        enter (s);
+        if (DEBUG or s->messages)
+                fprintf (stderr, "Unpacking heap of size %s.\n",
+                                uintToCommaString (s->heap.size));
+        /* The enterGC is needed here because minorGC and resizeHeap might move
+         * the stack, and the SIGPROF catcher would then see a bogus stack.  The
+         * leaveGC has to happen after the setStack.
+         */
+        enterGC (s);
+        minorGC (s);
+        resizeHeap (s, s->oldGenSize);
+        resizeHeap2 (s);
+        setNursery (s, 0, 0);
+        setStack (s);
+        leaveGC (s);
+        if (DEBUG or s->messages)
+                fprintf (stderr, "Unpacked heap to size %s.\n",
+                                uintToCommaString (s->heap.size));
+        leave (s);
 }
 
 /* ------------------------------------------------- */
@@ -4792,33 +4798,33 @@
  */ 
 
 bool GC_weakCanGet (pointer p) {
-	Bool res;
+        Bool res;
 
-	res = WEAK_GONE_HEADER != GC_getHeader (p);
-	if (DEBUG_WEAK)
-		fprintf (stderr, "%s = GC_weakCanGet (0x%08x)\n",
-				boolToString (res), (uint)p);
-	return res;
+        res = WEAK_GONE_HEADER != GC_getHeader (p);
+        if (DEBUG_WEAK)
+                fprintf (stderr, "%s = GC_weakCanGet (0x%08x)\n",
+                                boolToString (res), (uint)p);
+        return res;
 }
 
 Pointer GC_weakGet (Pointer p) {
-	pointer res;
+        pointer res;
 
-	res = ((GC_weak)p)->object;
-	if (DEBUG_WEAK)
-		fprintf (stderr, "0x%08x = GC_weakGet (0x%08x)\n",
-				(uint)res, (uint)p);
-	return res;
+        res = ((GC_weak)p)->object;
+        if (DEBUG_WEAK)
+                fprintf (stderr, "0x%08x = GC_weakGet (0x%08x)\n",
+                                (uint)res, (uint)p);
+        return res;
 }
 
 Pointer GC_weakNew (GC_state s, Word32 header, Pointer p) {
-	pointer res;
+        pointer res;
 
-	res = object (s, header, GC_NORMAL_HEADER_SIZE + 3 * WORD_SIZE, 
-			FALSE, FALSE);
-	((GC_weak)res)->object = p;
-	if (DEBUG_WEAK)
-		fprintf (stderr, "0x%08x = GC_weakNew (0x%08x, 0x%08x)\n",
-				(uint)res, (uint)header, (uint)p);
-	return res;
+        res = object (s, header, GC_NORMAL_HEADER_SIZE + 3 * WORD_SIZE, 
+                        FALSE, FALSE);
+        ((GC_weak)res)->object = p;
+        if (DEBUG_WEAK)
+                fprintf (stderr, "0x%08x = GC_weakNew (0x%08x, 0x%08x)\n",
+                                (uint)res, (uint)header, (uint)p);
+        return res;
 }

Modified: mlton/branches/on-20050420-cmm-branch/runtime/gc.h
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/gc.h	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/gc.h	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,9 @@
-/* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+/* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  */
 
 /*
@@ -19,10 +19,10 @@
 
 /*
  * Header word bits look as follows:
- * 31		mark bit
- * 30 - 20	counter bits
- * 19 - 1	type index bits
- * 0		1
+ * 31           mark bit
+ * 30 - 20      counter bits
+ * 19 - 1       type index bits
+ * 0            1
  *
  * The mark bit is used by the mark compact GC and GC_size to mark an object
  * as reachable.  The counter bits are used during the mark phase in conjunction
@@ -47,37 +47,37 @@
  * of all nonpointer data followed by all pointer data.  
  *
  * 19 bits means that there are only 2^19 different different object layouts,
- * which appears to be plenty, since there were < 128 different types required
- * for a self-compile.
+ * which appears to be plenty, since there were < 10,000 different types 
+ * required for a self-compile.
  */
 
 /* Sizes are (almost) always measured in bytes. */
 enum {
-	BOGUS_POINTER = 	0x1,
-	WORD_SIZE = 		4,
-	COUNTER_MASK =		0x7FF00000,
-	COUNTER_SHIFT =		20,
-	GC_ARRAY_HEADER_SIZE = 	3 * WORD_SIZE,
-	GC_NORMAL_HEADER_SIZE =	WORD_SIZE,
-	TYPE_INDEX_BITS =	19,
-	TYPE_INDEX_MASK =	0x000FFFFE,
-	LIMIT_SLOP = 		512,
-	MARK_MASK =		0x80000000,
-	POINTER_SIZE =		WORD_SIZE,
-	SOURCES_INDEX_UNKNOWN = 0,
-	SOURCES_INDEX_GC =	1,
-	SOURCE_SEQ_GC = 	1,
-	SOURCE_SEQ_UNKNOWN = 	0,
-	/* The type indices here must agree with those in
-	 * backend/rep-type.fun.
-	 */
-	STACK_TYPE_INDEX =	0,
-	STRING_TYPE_INDEX = 	1,
-	THREAD_TYPE_INDEX =	2,
-	WEAK_GONE_TYPE_INDEX = 	3,
-	WORD8_VECTOR_TYPE_INDEX = STRING_TYPE_INDEX,
-	WORD32_VECTOR_TYPE_INDEX = 4,
-	WORD16_VECTOR_TYPE_INDEX = 5,
+        BOGUS_POINTER =         0x1,
+        WORD_SIZE =             4,
+        COUNTER_MASK =          0x7FF00000,
+        COUNTER_SHIFT =         20,
+        GC_ARRAY_HEADER_SIZE =  3 * WORD_SIZE,
+        GC_NORMAL_HEADER_SIZE = WORD_SIZE,
+        TYPE_INDEX_BITS =       19,
+        TYPE_INDEX_MASK =       0x000FFFFE,
+        LIMIT_SLOP =            512,
+        MARK_MASK =             0x80000000,
+        POINTER_SIZE =          WORD_SIZE,
+        SOURCES_INDEX_UNKNOWN = 0,
+        SOURCES_INDEX_GC =      1,
+        SOURCE_SEQ_GC =         1,
+        SOURCE_SEQ_UNKNOWN =    0,
+        /* The type indices here must agree with those in
+         * backend/rep-type.fun.
+         */
+        STACK_TYPE_INDEX =      0,
+        STRING_TYPE_INDEX =     1,
+        THREAD_TYPE_INDEX =     2,
+        WEAK_GONE_TYPE_INDEX =  3,
+        WORD8_VECTOR_TYPE_INDEX = STRING_TYPE_INDEX,
+        WORD32_VECTOR_TYPE_INDEX = 4,
+        WORD16_VECTOR_TYPE_INDEX = 5,
 };
 
 #define BOGUS_THREAD (GC_thread)BOGUS_POINTER
@@ -85,9 +85,9 @@
 #define TWOPOWER(n) (1 << (n))
 
 typedef enum {
-	CODEGEN_BYTECODE,
-	CODEGEN_C,
-	CODEGEN_NATIVE,
+        CODEGEN_BYTECODE,
+        CODEGEN_C,
+        CODEGEN_NATIVE,
 } Codegen;
 
 /* ------------------------------------------------- */
@@ -95,23 +95,23 @@
 /* ------------------------------------------------- */
 
 typedef enum { 
-	ARRAY_TAG,
-	NORMAL_TAG,
-	STACK_TAG,
-	WEAK_TAG,
+        ARRAY_TAG,
+        NORMAL_TAG,
+        STACK_TAG,
+        WEAK_TAG,
 } GC_ObjectTypeTag;
 
 typedef struct {
-	/* Keep tag first, at zero offset, since it is referenced most often. */
-	GC_ObjectTypeTag tag;
-	Bool hasIdentity;
-	ushort numNonPointers;
-	ushort numPointers;
+        /* Keep tag first, at zero offset, since it is referenced most often. */
+        GC_ObjectTypeTag tag;
+        Bool hasIdentity;
+        ushort numNonPointers;
+        ushort numPointers;
 } GC_ObjectType;
 
 typedef enum {
-	GC_COPYING,
-	GC_MARK_COMPACT,
+        GC_COPYING,
+        GC_MARK_COMPACT,
 } GC_MajorKind;
 
 /* ------------------------------------------------- */
@@ -125,22 +125,22 @@
  * IntInf.int whose value corresponds to the mlstr string.
  *
  * The strings pointed to by the mlstr fields consist of
- *	an optional ~
- *	either one or more of [0-9] or
- *		0x followed by one or more of [0-9a-fA-F]
- *	a trailing EOS
+ *      an optional ~
+ *      either one or more of [0-9] or
+ *              0x followed by one or more of [0-9a-fA-F]
+ *      a trailing EOS
  */
 struct GC_intInfInit {
-	uint	globalIndex;
-	char	*mlstr;
+        uint    globalIndex;
+        char    *mlstr;
 };
 
 /* GC_init allocates a collection of arrays/vectors in the heap. */
 struct GC_vectorInit {
-	char *bytes;
-	uint bytesPerElement;
-	uint globalIndex;
-	uint numElements;
+        char *bytes;
+        uint bytesPerElement;
+        uint globalIndex;
+        uint numElements;
 };
 
 /* ------------------------------------------------- */
@@ -150,15 +150,15 @@
 typedef ushort *GC_offsets;
 
 typedef struct GC_frameLayout {
-	/* isC is a boolean identifying whether or not the frame is for a C call.
-	 */
-	char isC;
-	/* Number of bytes in frame, including space for return address. */
-	ushort numBytes;
-	/* Offsets from stackTop pointing at bottom of frame at which pointers
-	 * are located. 
-	 */
-	GC_offsets offsets;
+        /* isC is a boolean identifying whether or not the frame is for a C call.
+         */
+        char isC;
+        /* Number of bytes in frame, including space for return address. */
+        ushort numBytes;
+        /* Offsets from stackTop pointing at bottom of frame at which pointers
+         * are located. 
+         */
+        GC_offsets offsets;
 } GC_frameLayout;
 
 /* ------------------------------------------------- */
@@ -168,42 +168,42 @@
 typedef Word32 Hash;
 
 typedef struct GC_ObjectHashElement {
-	Hash hash;
-	Pointer object;
+        Hash hash;
+        Pointer object;
 } *GC_ObjectHashElement;
 
 typedef struct GC_ObjectHashTable {
-	struct GC_ObjectHashElement *elements;
-	Bool elementsIsInHeap;
-	int elementsSize;
-	int log2ElementsSize;
-	Bool mayInsert;
-	int numElements;
+        struct GC_ObjectHashElement *elements;
+        Bool elementsIsInHeap;
+        int elementsSize;
+        int log2ElementsSize;
+        Bool mayInsert;
+        int numElements;
 } *GC_ObjectHashTable;
 
 /* ------------------------------------------------- */
 /*                     GC_stack                      */
 /* ------------------------------------------------- */
 
-typedef struct GC_stack {	
-	/* markTop and markIndex are only used during marking.  They record the
-	 * current pointer in the stack that is being followed.  markTop points
-	 * to the top of the stack frame containing the pointer and markI is the
-	 * index in that frames frameOffsets of the pointer slot.  So, when the
-	 * GC pointer reversal gets back to the stack, it can continue with the
-	 * next pointer (either in the current frame or the next frame).
-	 */
-	pointer markTop;
-	W32 markIndex;
-	/* reserved is the number of bytes reserved for stack, i.e. its maximum
-	 * size.
-	 */
-	uint reserved;
-	/* used is the number of bytes in use by the stack.  
+typedef struct GC_stack {       
+        /* markTop and markIndex are only used during marking.  They record the
+         * current pointer in the stack that is being followed.  markTop points
+         * to the top of the stack frame containing the pointer and markI is the
+         * index in that frames frameOffsets of the pointer slot.  So, when the
+         * GC pointer reversal gets back to the stack, it can continue with the
+         * next pointer (either in the current frame or the next frame).
+         */
+        pointer markTop;
+        W32 markIndex;
+        /* reserved is the number of bytes reserved for stack, i.e. its maximum
+         * size.
+         */
+        uint reserved;
+        /* used is the number of bytes in use by the stack.  
          * Stacks with used == reserved are continuations.
-	 */
-	uint used;	
-	/* The next address is the bottom of the stack, and the following
+         */
+        uint used;      
+        /* The next address is the bottom of the stack, and the following
          * reserved bytes hold space for the stack.
          */
 } *GC_stack;
@@ -213,19 +213,19 @@
 /* ------------------------------------------------- */
 
 typedef struct GC_thread {
-	/* The order of these fields is important.  The nonpointer fields
-	 * must be first, because this object must appear to be a normal heap
-	 * object.
-	 * Furthermore, the exnStack field must be first, because the native
-	 * codegen depends on this (which is bad and should be fixed).
-	 */
-	uint exnStack;    	/* An offset added to stackBottom that specifies 
-				 * where the top of the exnStack is.
-				 */
-	uint bytesNeeded;       /* The number of bytes needed when returning
-				 * to this thread.
-				 */
-	GC_stack stack;		/* The stack for this thread. */
+        /* The order of these fields is important.  The nonpointer fields
+         * must be first, because this object must appear to be a normal heap
+         * object.
+         * Furthermore, the exnStack field must be first, because the native
+         * codegen depends on this (which is bad and should be fixed).
+         */
+        uint exnStack;          /* An offset added to stackBottom that specifies 
+                                 * where the top of the exnStack is.
+                                 */
+        uint bytesNeeded;       /* The number of bytes needed when returning
+                                 * to this thread.
+                                 */
+        GC_stack stack;         /* The stack for this thread. */
 } *GC_thread;
 
 /* ------------------------------------------------- */
@@ -233,9 +233,9 @@
 /* ------------------------------------------------- */
 
 typedef struct GC_weak {
-	uint unused;
-	struct GC_weak *link;
-	pointer object;
+        uint unused;
+        struct GC_weak *link;
+        pointer object;
 } *GC_weak;
 
 /* ------------------------------------------------- */
@@ -243,41 +243,42 @@
 /* ------------------------------------------------- */
 
 typedef enum {
-	PROFILE_ALLOC,
-	PROFILE_COUNT,
-	PROFILE_NONE,
-	PROFILE_TIME,
+        PROFILE_ALLOC,
+        PROFILE_COUNT,
+        PROFILE_NONE,
+        PROFILE_TIME_FIELD,
+        PROFILE_TIME_LABEL
 } ProfileKind;
 
 typedef struct GC_source {
-	uint nameIndex;
-	uint successorsIndex;
+        uint nameIndex;
+        uint successorsIndex;
 } *GC_source;
 
 typedef struct GC_sourceLabel {
-	pointer label;
-	uint sourceSeqsIndex;
+        pointer label;
+        uint sourceSeqsIndex;
 } *GC_profileLabel;
 
 /* If profileStack, then there is one struct GC_profileStackInfo for each
  * function.
  */
 typedef struct GC_profileStack {
-	/* ticks counts ticks while the function was on the stack. */
-	ullong ticks;
-	/* ticksInGC counts ticks in GC while the function was on the stack. */
-	ullong ticksInGC; 
+        /* ticks counts ticks while the function was on the stack. */
+        ullong ticks;
+        /* ticksInGC counts ticks in GC while the function was on the stack. */
+        ullong ticksInGC; 
         /* lastTotal is the value of total when the oldest occurrence of f on the
          * stack was pushed, i.e., the most recent time that numTimesOnStack
          * changed from 0 to 1.  lastTotal is used to compute the amount to
          * attribute to f when the oldest occurrence is finally popped.
          */
-	ullong lastTotal;
-	/* lastTotalGC is like lastTotal, but for GC ticks. */
-	ullong lastTotalGC;
-	/* numOccurrences is the number of times this function is on the stack.
+        ullong lastTotal;
+        /* lastTotalGC is like lastTotal, but for GC ticks. */
+        ullong lastTotalGC;
+        /* numOccurrences is the number of times this function is on the stack.
          */
-	uint numOccurrences;
+        uint numOccurrences;
 } *GC_profileStack;
 
 /* GC_profile is used for both time and allocation profiling.
@@ -289,18 +290,18 @@
  * functions, and the next sourceNamesSize entries are for the master versions.
  */
 typedef struct GC_profile {
-	/* countTop is an array that counts for each function the number of ticks
+        /* countTop is an array that counts for each function the number of ticks
          * that occurred while the function was on top of the stack.
-	 */
-	ullong *countTop;
-	/* stack is an array that gives stack info for each function.  It is
-	 * only used if profileStack.
          */
-	struct GC_profileStack *stack;
-	/* The total number of mutator ticks. */
-	ullong total;
-	/* The total number of GC ticks. */
-	ullong totalGC;
+        ullong *countTop;
+        /* stack is an array that gives stack info for each function.  It is
+         * only used if profileStack.
+         */
+        struct GC_profileStack *stack;
+        /* The total number of mutator ticks. */
+        ullong total;
+        /* The total number of GC ticks. */
+        ullong totalGC;
 } *GC_profile;
 
 /* ------------------------------------------------- */
@@ -318,8 +319,8 @@
  */
 
 typedef struct GC_heap {
-	uint size;
-	pointer start;		/* start of memory area */
+        uint size;
+        pointer start;          /* start of memory area */
 } *GC_heap;
 
 /* ------------------------------------------------- */
@@ -335,196 +336,198 @@
  */
 
 typedef struct GC_state {
-	/* These fields are at the front because they are the most commonly
-	 * referenced, and having them at smaller offsets may decrease code size.
+        /* These fields are at the front because they are the most commonly
+         * referenced, and having them at smaller offsets may decrease code size.
          */
-	pointer frontier; 	/* base <= frontier < limit */
-	pointer limit; 		/* end of from space */
-	pointer stackTop;
-	pointer stackLimit;	/* stackBottom + stackSize - maxFrameSize */
-	uint exnStack;
+        pointer frontier;       /* base <= frontier < limit */
+        pointer limit;          /* end of from space */
+        pointer stackTop;
+        pointer stackLimit;     /* stackBottom + stackSize - maxFrameSize */
+        uint exnStack;
 
-	uint alignment;		/* Either WORD_SIZE or 2 * WORD_SIZE. */
-	bool amInGC;
-	bool amInMinorGC;
-	string *atMLtons;	/* Initial @MLton args, processed before command
-				 * line.
-				 */
-	int atMLtonsSize;
-	pointer back;     	/* Points at next available word in toSpace. */
-	ullong bytesAllocated;
- 	ullong bytesCopied;
-	ullong bytesCopiedMinor;
-	ullong bytesHashConsed;
-	int bytesLive; /* Number of bytes live at most recent major GC. */
-	ullong bytesMarkCompacted;
-	GC_thread callFromCHandler; /* For C calls. */
-	bool canMinor; /* TRUE iff there is space for a minor gc. */
-	pointer cardMap;
-	pointer cardMapForMutator;
-	uint cardMapSize;
-	uint cardSize;
-	uint cardSizeLog2;
-	/* Only use generational GC with copying collection if the ratio of 
- 	 * semispace size to live data size is below copyGenerationalRatio.
-	 */
-	float copyGenerationalRatio;
-	float copyRatio;	/* Minimum live ratio to use copying GC. */
-	uchar *crossMap;
-	uint crossMapSize;
-	/* crossMapValidEnd is the size of the prefix of the old generation for
-	 * which the crossMap is valid.
-	 */
-	uint crossMapValidSize;
-	GC_thread currentThread; /* This points to a thread in the heap. */
-	uint fixedHeap;	/* If 0, then no fixed heap. */
-	GC_frameLayout *frameLayouts;
-	uint frameLayoutsSize;
-	/* frameSources is an array of length frameLayoutsSize that for each
-	 * stack frame, gives an index into sourceSeqs of the sequence of 
-	 * source functions corresponding to the frame.
-	 */
-	uint *frameSources;
-	uint frameSourcesSize;
-	bool gcSignalIsPending;
-	pointer *globals;
-	uint globalsSize;
-	float growRatio;
-	bool handleGCSignal;
-	Bool hashConsDuringGC;
-	float hashConsFrequency;  /* What fraction of GC's should hash cons. */
-	struct GC_heap heap;
-	struct GC_heap heap2;	/* Used for major copying collection. */
-	bool inSignalHandler; 	/* TRUE iff a signal handler is running. */
-	struct GC_intInfInit *intInfInits;
-	uint intInfInitsSize;
-	/* canHandle == 0 iff GC may switch to the signal handler
- 	 * thread.  This is used to implement critical sections.
-	 */
-	volatile int canHandle;
-	bool isOriginal;
-	GC_MajorKind lastMajor;
-	pointer limitPlusSlop; /* limit + LIMIT_SLOP */
-	float liveRatio;	/* Desired ratio of heap size to live data. */
-	/* loadGlobals loads the globals from the stream. */
-	void (*loadGlobals)(FILE *file);
-	uint magic; /* The magic number for this executable. */
-	/* Minimum live ratio to us mark-compact GC. */
-	float markCompactRatio; 
-	ullong markedCards; /* Number of marked cards seen during minor GCs. */
-	/* Only use generational GC with mark-compact collection if the ratio of 
- 	 * heap size to live data size is below markCompactGenerationalRatio.
-	 */
-	float markCompactGenerationalRatio;
-	uint maxBytesLive;
-	uint maxFrameSize;
-	uint maxHeap; /* if zero, then unlimited, else limit total heap */
-	uint maxHeapSizeSeen;
-	uint maxPause;		/* max time spent in any gc in milliseconds. */
-	uint maxStackSizeSeen;
-	bool mayLoadWorld;
-	bool mayProcessAtMLton;
-	bool messages; /* Print out a message at the start and end of each gc. */
-	ullong minorBytesScanned;
-	ullong minorBytesSkipped;
-	bool mutatorMarksCards;
-	uint numCopyingGCs;
- 	ullong numLCs;
-	uint numHashConsGCs;
- 	uint numMarkCompactGCs;
-	uint numMinorGCs;
-	uint numMinorsSinceLastMajor;
-	/* As long as the ratio of bytes live to nursery size is greater than
-	 * nurseryRatio, use minor GCs.
-	 */
-	float nurseryRatio;
-	pointer nursery;
-	GC_ObjectHashTable objectHashTable;
-	GC_ObjectType *objectTypes; /* Array of object types. */
-	uint objectTypesSize;
-	/* Arrays larger than oldGenArraySize are allocated in the old generation
-	 * instead of the nursery, if possible.
-	 */
-	W32 oldGenArraySize; 
-	uint oldGenSize;
-	uint pageSize; /* bytes */
-	GC_profile profile;
- 	ProfileKind profileKind;
-	bool profileStack;
-	bool profilingIsOn;
-	W32 ram;		/* ramSlop * totalRam */
-	W32 (*returnAddressToFrameIndex) (W32 w);
-	float ramSlop;
- 	struct rusage ru_gc; /* total resource usage spent in gc */
-	struct rusage ru_gcCopy; /* resource usage in major copying gcs. */
-	struct rusage ru_gcMarkCompact; /* resource usage in mark-compact gcs. */
-	struct rusage ru_gcMinor; /* resource usage in minor gcs. */
-	/* savedThread is only set
+        uint alignment;         /* Either WORD_SIZE or 2 * WORD_SIZE. */
+        bool amInGC;
+        bool amInMinorGC;
+        string *atMLtons;       /* Initial @MLton args, processed before command
+                                 * line.
+                                 */
+        int atMLtonsSize;
+        pointer back;           /* Points at next available word in toSpace. */
+        ullong bytesAllocated;
+        ullong bytesCopied;
+        ullong bytesCopiedMinor;
+        ullong bytesHashConsed;
+        int bytesLive; /* Number of bytes live at most recent major GC. */
+        ullong bytesMarkCompacted;
+        GC_thread callFromCHandler; /* For C calls. */
+        bool canMinor; /* TRUE iff there is space for a minor gc. */
+        pointer cardMap;
+        pointer cardMapForMutator;
+        uint cardMapSize;
+        uint cardSize;
+        uint cardSizeLog2;
+        /* Only use generational GC with copying collection if the ratio of 
+         * semispace size to live data size is below copyGenerationalRatio.
+         */
+        float copyGenerationalRatio;
+        float copyRatio;        /* Minimum live ratio to use copying GC. */
+        uchar *crossMap;
+        uint crossMapSize;
+        /* crossMapValidEnd is the size of the prefix of the old generation for
+         * which the crossMap is valid.
+         */
+        uint crossMapValidSize;
+        GC_thread currentThread; /* This points to a thread in the heap. */
+        volatile uint curSourceSeqsIndex; /* Used by time profiling. */
+        uint fixedHeap; /* If 0, then no fixed heap. */
+        GC_frameLayout *frameLayouts;
+        uint frameLayoutsSize;
+        /* frameSources is an array of length frameLayoutsSize that for each
+         * stack frame, gives an index into sourceSeqs of the sequence of 
+         * source functions corresponding to the frame.
+         */
+        uint *frameSources;
+        uint frameSourcesSize;
+        bool gcSignalIsPending;
+        pointer *globals;
+        uint globalsSize;
+        float growRatio;
+        bool handleGCSignal;
+        Bool hashConsDuringGC;
+        float hashConsFrequency;  /* What fraction of GC's should hash cons. */
+        struct GC_heap heap;
+        struct GC_heap heap2;   /* Used for major copying collection. */
+        bool inSignalHandler;   /* TRUE iff a signal handler is running. */
+        struct GC_intInfInit *intInfInits;
+        uint intInfInitsSize;
+        /* canHandle == 0 iff GC may switch to the signal handler
+         * thread.  This is used to implement critical sections.
+         */
+        volatile int canHandle;
+        bool isOriginal;
+        GC_MajorKind lastMajor;
+        pointer limitPlusSlop; /* limit + LIMIT_SLOP */
+        float liveRatio;        /* Desired ratio of heap size to live data. */
+        /* loadGlobals loads the globals from the stream. */
+        void (*loadGlobals)(FILE *file);
+        uint magic; /* The magic number for this executable. */
+        /* Minimum live ratio to us mark-compact GC. */
+        float markCompactRatio; 
+        ullong markedCards; /* Number of marked cards seen during minor GCs. */
+        /* Only use generational GC with mark-compact collection if the ratio of 
+         * heap size to live data size is below markCompactGenerationalRatio.
+         */
+        float markCompactGenerationalRatio;
+        uint maxBytesLive;
+        uint maxFrameSize;
+        uint maxHeap; /* if zero, then unlimited, else limit total heap */
+        uint maxHeapSizeSeen;
+        uint maxPause;          /* max time spent in any gc in milliseconds. */
+        uint maxStackSizeSeen;
+        bool mayLoadWorld;
+        bool mayProcessAtMLton;
+        bool messages; /* Print out a message at the start and end of each gc. */
+        ullong minorBytesScanned;
+        ullong minorBytesSkipped;
+        bool mutatorMarksCards;
+        uint numCopyingGCs;
+        ullong numLCs;
+        uint numHashConsGCs;
+        uint numMarkCompactGCs;
+        uint numMinorGCs;
+        uint numMinorsSinceLastMajor;
+        /* As long as the ratio of bytes live to nursery size is greater than
+         * nurseryRatio, use minor GCs.
+         */
+        float nurseryRatio;
+        pointer nursery;
+        GC_ObjectHashTable objectHashTable;
+        GC_ObjectType *objectTypes; /* Array of object types. */
+        uint objectTypesSize;
+        /* Arrays larger than oldGenArraySize are allocated in the old generation
+         * instead of the nursery, if possible.
+         */
+        W32 oldGenArraySize; 
+        uint oldGenSize;
+        uint pageSize; /* bytes */
+        GC_profile profile;
+        ProfileKind profileKind;
+        bool profileStack;
+        bool profilingIsOn;
+        W32 ram;                /* ramSlop * totalRam */
+        W32 (*returnAddressToFrameIndex) (W32 w);
+        float ramSlop;
+        bool rusageMeasureGC;
+        struct rusage ru_gc; /* total resource usage spent in gc */
+        struct rusage ru_gcCopy; /* resource usage in major copying gcs. */
+        struct rusage ru_gcMarkCompact; /* resource usage in mark-compact gcs. */
+        struct rusage ru_gcMinor; /* resource usage in minor gcs. */
+        /* savedThread is only set
          *    when executing a signal handler.  It is set to the thread that
-	 *    was running when the signal arrived.
+         *    was running when the signal arrived.
          * GC_copyCurrentThread also uses it to store its result.
-	 */
-	GC_thread savedThread;
-	/* saveGlobals writes out the values of all of the globals to fd. */
-	void (*saveGlobals)(int fd);
-	GC_thread signalHandler; /* The mutator signal handler thread. */
+         */
+        GC_thread savedThread;
+        /* saveGlobals writes out the values of all of the globals to fd. */
+        void (*saveGlobals)(int fd);
+        GC_thread signalHandler; /* The mutator signal handler thread. */
         /* signalsHandled is the set of signals for which a mutator signal
-	 * handler needs to run in order to handle the signal.
-	 */
-	sigset_t signalsHandled;
-	/* signalIsPending is TRUE iff a signal has been received but not
-	 * processed by the mutator signal handler.
-	 */
-	volatile bool signalIsPending;
-	/* The signals that have been recieved but not processed by the mutator
-	 * signal handler.
-	 */
-	sigset_t signalsPending;
-	struct GC_sourceLabel *sourceLabels;
-	uint sourceLabelsSize;
-	/* sourcesNames is an array of strings identifying source positions. */
-	string *sourceNames;
-	uint sourceNamesSize;
-	/* Each entry in sourceSeqs is a vector, whose first element is
+         * handler needs to run in order to handle the signal.
+         */
+        sigset_t signalsHandled;
+        /* signalIsPending is TRUE iff a signal has been received but not
+         * processed by the mutator signal handler.
+         */
+        volatile bool signalIsPending;
+        /* The signals that have been recieved but not processed by the mutator
+         * signal handler.
+         */
+        sigset_t signalsPending;
+        struct GC_sourceLabel *sourceLabels;
+        uint sourceLabelsSize;
+        /* sourcesNames is an array of strings identifying source positions. */
+        string *sourceNames;
+        uint sourceNamesSize;
+        /* Each entry in sourceSeqs is a vector, whose first element is
          * a length, and subsequent elements index into sources.
-	 */
-	uint **sourceSeqs;
-	uint sourceSeqsSize;
-	/* sources is an array of length sourcesSize.  Each entry specifies 
+         */
+        uint **sourceSeqs;
+        uint sourceSeqsSize;
+        /* sources is an array of length sourcesSize.  Each entry specifies 
          * an index into sourceNames and an index into sourceSeqs, giving the
-	 * name of the function and the successors, respectively.
-	 */
-	struct GC_source *sources;
-	uint sourcesSize;
-	pointer stackBottom; /* The bottom of the stack in the current thread. */
- 	uint startTime; /* The time when GC_init or GC_loadWorld was called. */
-	/* If summary is TRUE, then print a summary of gc info when the program 
-	 * is done .
-	 */
-	bool summary; 
-	pointer textEnd;
-	/* An array of indices, one entry for each address in the text segment,
-	 * giving and index into profileSourceSeqs.
-	 */
-	uint *textSources;
-	pointer textStart;
-	float threadShrinkRatio;
-	pointer toSpace;	/* used during copying */
-	pointer toLimit;	/* used during copying */
-	uint totalRam;		/* bytes */
-	uint translateDiff;	/* used by translateHeap */
- 	bool translateUp;	/* used by translateHeap */
-	struct GC_vectorInit *vectorInits;
-	uint vectorInitsSize;
-	GC_weak weaks;
+         * name of the function and the successors, respectively.
+         */
+        struct GC_source *sources;
+        uint sourcesSize;
+        pointer stackBottom; /* The bottom of the stack in the current thread. */
+        uint startTime; /* The time when GC_init or GC_loadWorld was called. */
+        /* If summary is TRUE, then print a summary of gc info when the program 
+         * is done .
+         */
+        bool summary; 
+        pointer textEnd;
+        /* An array of indices, one entry for each address in the text segment,
+         * giving an index into profileSourceSeqs.
+         */
+        uint *textSources;
+        pointer textStart;
+        float threadShrinkRatio;
+        pointer toSpace;        /* used during copying */
+        pointer toLimit;        /* used during copying */
+        uint totalRam;          /* bytes */
+        uint translateDiff;     /* used by translateHeap */
+        bool translateUp;       /* used by translateHeap */
+        struct GC_vectorInit *vectorInits;
+        uint vectorInitsSize;
+        GC_weak weaks;
 } *GC_state;
 
 static inline uint wordAlign(uint p) {
- 	return ((p + 3) & ~ 3);
+        return ((p + 3) & ~ 3);
 }
 
 static inline bool isWordAligned(uint x) {
-	return 0 == (x & 0x3);
+        return 0 == (x & 0x3);
 }
 
 /* ---------------------------------------------------------------- */
@@ -543,11 +546,11 @@
 
 /* The array size is stored before the header */
 static inline uint* GC_arrayNumElementsp (pointer a) {
-	return ((uint*)a - 2);
+        return ((uint*)a - 2);
 }
 
 static inline int GC_arrayNumElements (pointer a) {
-	return *(GC_arrayNumElementsp (a));
+        return *(GC_arrayNumElementsp (a));
 }
 
 /* GC_copyThread (s, t) returns a copy of the thread pointed to by t.
@@ -592,18 +595,18 @@
  * It will also switch to the signal handler thread if there is a pending signal.
  */
 void GC_gc (GC_state s, uint bytesRequested, bool force,
-		string file, int line);
+                string file, int line);
 
 /* GC_getHeaderp returns a pointer to the header for the object pointed to by 
  * p. 
  */
 static inline Header* GC_getHeaderp (pointer p) {
-	return (Header*)(p - WORD_SIZE);
+        return (Header*)(p - WORD_SIZE);
 }
 
 /* GC_gerHeader returns the header for the object pointed to by p. */
 static inline Header GC_getHeader (pointer p) {
-	return *(GC_getHeaderp(p));
+        return *(GC_getHeaderp(p));
 }
 
 /* GC_handler is the baked-in C signal handler. 
@@ -639,16 +642,16 @@
 
 /* GC_isPointer returns true if p looks like a pointer, i.e. if p = 0 mod 4. */
 static inline bool GC_isPointer (pointer p) {
-	return (0 == ((word)p & 0x3));
+        return (0 == ((word)p & 0x3));
 }
 
 static inline bool GC_isValidFrontier (GC_state s, pointer frontier) {
-	return s->nursery <= frontier and frontier <= s->limit;
+        return s->nursery <= frontier and frontier <= s->limit;
 }
 
 static inline bool GC_isValidSlot (GC_state s, pointer slot) {
-	return s->stackBottom <= slot 
-		and slot < s->stackBottom + s->currentThread->stack->reserved;
+        return s->stackBottom <= slot 
+                and slot < s->stackBottom + s->currentThread->stack->reserved;
 }
 
 
@@ -656,8 +659,8 @@
  * Build the header for an object, given the index to its type info.
  */
 static inline word GC_objectHeader (W32 t) {
-	assert (t < TWOPOWER (TYPE_INDEX_BITS));
-	return 1 | (t << 1);
+        assert (t < TWOPOWER (TYPE_INDEX_BITS));
+        return 1 | (t << 1);
 }
 
 /* Pack the heap into a small amount of RAM. */


Property changes on: mlton/branches/on-20050420-cmm-branch/runtime/gdtoa.tgz
___________________________________________________________________
Name: svn:mime-type
   + application/octet-stream

Modified: mlton/branches/on-20050420-cmm-branch/runtime/platform/cygwin.c
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/platform/cygwin.c	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/platform/cygwin.c	2006-02-16 19:34:54 UTC (rev 4361)
@@ -9,28 +9,28 @@
 #include "windows.c"
 
 void decommit (void *base, size_t length) {
-	if (MLton_Platform_CygwinUseMmap)
-		smunmap (base, length);
-	else
-		Windows_decommit (base, length);
+        if (MLton_Platform_CygwinUseMmap)
+                smunmap (base, length);
+        else
+                Windows_decommit (base, length);
 }
 
 HANDLE fileDesHandle (int fd) {
-	return (HANDLE)(get_osfhandle (fd));
+        return (HANDLE)(get_osfhandle (fd));
 }
 
 void *mmapAnon (void *start, size_t length) {
-	if (MLton_Platform_CygwinUseMmap)
-		return mmapAnonMmap (start, length);
-	else
-		return Windows_mmapAnon (start, length);
+        if (MLton_Platform_CygwinUseMmap)
+                return mmapAnonMmap (start, length);
+        else
+                return Windows_mmapAnon (start, length);
 }
 
 void release (void *base, size_t length) {
-	if (MLton_Platform_CygwinUseMmap)
-		smunmap (base, length);
-	else
-		Windows_release (base);
+        if (MLton_Platform_CygwinUseMmap)
+                smunmap (base, length);
+        else
+                Windows_release (base);
 }
 
 /* ------------------------------------------------- */
@@ -38,10 +38,10 @@
 /* ------------------------------------------------- */
 
 char *Cygwin_toFullWindowsPath (char *path) {
-	static char res[MAX_PATH];
+        static char res[MAX_PATH];
 
-	cygwin_conv_to_full_win32_path ((char*)path, &res[0]);
-	return &res[0];
+        cygwin_conv_to_full_win32_path ((char*)path, &res[0]);
+        return &res[0];
 }
 
 /* ------------------------------------------------- */
@@ -49,13 +49,13 @@
 /* ------------------------------------------------- */
 
 void Posix_IO_setbin (Fd fd) {
-	/* cygwin has a different method for working with its fds */
-	setmode (fd, O_BINARY);
+        /* cygwin has a different method for working with its fds */
+        setmode (fd, O_BINARY);
 }
 
 void Posix_IO_settext (Fd fd) {
-	/* cygwin has a different method for working with its fds */
-	setmode (fd, O_TEXT);
+        /* cygwin has a different method for working with its fds */
+        setmode (fd, O_TEXT);
 }
 
 /* ------------------------------------------------- */
@@ -68,31 +68,31 @@
  * Screw that. We implement our own cwait using pure win32.
  */
 Pid MLton_Process_cwait (Pid pid, Pointer status) {
-	HANDLE h;
-	
-	h = (HANDLE)pid;
-	/* This all works on Win95+ */
-	while (1) {
-		/* Using an open handle we can get the exit status */
-		unless (GetExitCodeProcess (h, (DWORD*)status)) {
-			/* An error probably means the child does not exist */
-			errno = ECHILD;
-			return -1;
-		}
-		/* Thank you windows API.
-		 * I hope no process ever exits with STILL_ACTIVE.
-		 * At least most other windows programs have this bug too.
-		 */
-		if (*(DWORD*)status != STILL_ACTIVE) /* 259 */
-			break;
-		/* Wait for h to change state for up to one second.
-		 * We don't wait longer b/c there is a race condition
-		 * between checking the exit status and calling this method.
-		 * By only waiting 1s, no infinite loop can result.
-		 */
-		WaitForSingleObject (h, 1000);
-	}
-	/* Cleanup the process handle -- don't call this method again */
-	CloseHandle (h);
-	return pid;
+        HANDLE h;
+        
+        h = (HANDLE)pid;
+        /* This all works on Win95+ */
+        while (1) {
+                /* Using an open handle we can get the exit status */
+                unless (GetExitCodeProcess (h, (DWORD*)status)) {
+                        /* An error probably means the child does not exist */
+                        errno = ECHILD;
+                        return -1;
+                }
+                /* Thank you windows API.
+                 * I hope no process ever exits with STILL_ACTIVE.
+                 * At least most other windows programs have this bug too.
+                 */
+                if (*(DWORD*)status != STILL_ACTIVE) /* 259 */
+                        break;
+                /* Wait for h to change state for up to one second.
+                 * We don't wait longer b/c there is a race condition
+                 * between checking the exit status and calling this method.
+                 * By only waiting 1s, no infinite loop can result.
+                 */
+                WaitForSingleObject (h, 1000);
+        }
+        /* Cleanup the process handle -- don't call this method again */
+        CloseHandle (h);
+        return pid;
 }

Modified: mlton/branches/on-20050420-cmm-branch/runtime/platform/cygwin.h
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/platform/cygwin.h	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/platform/cygwin.h	2006-02-16 19:34:54 UTC (rev 4361)
@@ -23,12 +23,14 @@
 
 #define MLton_Platform_OS_host "cygwin"
 
+#define HAS_FPCLASSIFY TRUE
+#define HAS_FEROUND FALSE
 #define HAS_PTRACE FALSE
 #define HAS_REMAP FALSE
 #define HAS_SIGALTSTACK FALSE
+#define HAS_SIGNBIT TRUE
 #define HAS_SPAWN TRUE
 #define HAS_TIME_PROFILING FALSE
-#define HAS_WEAK 0
 
 #define _SC_BOGUS 0xFFFFFFFF
 #define _SC_2_FORT_DEV _SC_BOGUS

Modified: mlton/branches/on-20050420-cmm-branch/runtime/platform/darwin.c
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/platform/darwin.c	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/platform/darwin.c	2006-02-16 19:34:54 UTC (rev 4361)
@@ -10,42 +10,42 @@
 #include "use-mmap.c"
 
 static void catcher (int sig, siginfo_t *sip, ucontext_t *ucp) {
-	GC_handleSigProf ((pointer) ucp->uc_mcontext->ss.srr0);
+        GC_handleSigProf ((pointer) ucp->uc_mcontext->ss.srr0);
 }
 
 void setSigProfHandler (struct sigaction *sa) {
-	sa->sa_flags = SA_ONSTACK | SA_RESTART | SA_SIGINFO;
-	sa->sa_sigaction = (void (*)(int, siginfo_t*, void*))catcher;
+        sa->sa_flags = SA_ONSTACK | SA_RESTART | SA_SIGINFO;
+        sa->sa_sigaction = (void (*)(int, siginfo_t*, void*))catcher;
 }
 
 void *getTextEnd () {
-	return (void*)(get_etext ());
+        return (void*)(get_etext ());
 }
 
 void *getTextStart () {
-	unsigned long address;
-	void *module;
-	struct mach_header *mh;
+        unsigned long address;
+        void *module;
+        struct mach_header *mh;
 
-	_dyld_lookup_and_bind ("_main", &address, &module);
-	mh = _dyld_get_image_header_containing_address (address);
-	return mh;
+        _dyld_lookup_and_bind ("_main", &address, &module);
+        mh = _dyld_get_image_header_containing_address (address);
+        return mh;
 }
 
 void showMem () {
-	/* FIXME: this won't actually work. */
-	static char buffer[256];
+        /* FIXME: this won't actually work. */
+        static char buffer[256];
 
-	sprintf (buffer, "/bin/cat /proc/%d/map\n", (int)getpid ());
-	(void)system (buffer);
+        sprintf (buffer, "/bin/cat /proc/%d/map\n", (int)getpid ());
+        (void)system (buffer);
 }
 
 W32 totalRam (GC_state s) {
-	int mem;
-	size_t len;
+        int mem;
+        size_t len;
 
-	len = sizeof (int);
-	if (-1 == sysctlbyname ("hw.physmem", &mem, &len, NULL, 0))
-		diee ("sysctl failed");
-	return mem;
+        len = sizeof (int);
+        if (-1 == sysctlbyname ("hw.physmem", &mem, &len, NULL, 0))
+                diee ("sysctl failed");
+        return mem;
 }

Modified: mlton/branches/on-20050420-cmm-branch/runtime/platform/darwin.h
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/platform/darwin.h	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/platform/darwin.h	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,6 @@
+#include <fenv.h>
+#include <stdint.h>
+
 #include <grp.h>
 #include <limits.h>
 #include <netdb.h>
@@ -20,11 +23,13 @@
 #include <termios.h>
 #include <ucontext.h>
 
+#define HAS_FEROUND TRUE
+#define HAS_FPCLASSIFY TRUE
 #define HAS_PTRACE FALSE
 #define HAS_REMAP FALSE
 #define HAS_SIGALTSTACK TRUE
+#define HAS_SIGNBIT TRUE
 #define HAS_SPAWN FALSE
 #define HAS_TIME_PROFILING TRUE
-#define HAS_WEAK 0
 
 #define MLton_Platform_OS_host "darwin"

Copied: mlton/branches/on-20050420-cmm-branch/runtime/platform/feround.c (from rev 4358, mlton/trunk/runtime/platform/feround.c)

Copied: mlton/branches/on-20050420-cmm-branch/runtime/platform/feround.h (from rev 4358, mlton/trunk/runtime/platform/feround.h)

Modified: mlton/branches/on-20050420-cmm-branch/runtime/platform/freebsd.c
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/platform/freebsd.c	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/platform/freebsd.c	2006-02-16 19:34:54 UTC (rev 4361)
@@ -7,26 +7,26 @@
 #include "use-mmap.c"
 
 static void catcher (int sig, siginfo_t *sip, ucontext_t *ucp) {
-	GC_handleSigProf ((pointer) ucp->uc_mcontext.mc_eip);
+        GC_handleSigProf ((pointer) ucp->uc_mcontext.mc_eip);
 }
 
 void setSigProfHandler (struct sigaction *sa) {
-	sa->sa_flags = SA_ONSTACK | SA_RESTART | SA_SIGINFO;
-	sa->sa_sigaction = (void (*)(int, siginfo_t*, void*))catcher;
+        sa->sa_flags = SA_ONSTACK | SA_RESTART | SA_SIGINFO;
+        sa->sa_sigaction = (void (*)(int, siginfo_t*, void*))catcher;
 }
 
 void showMem () {
-	static char buffer[256];
+        static char buffer[256];
 
-	sprintf (buffer, "/bin/cat /proc/%d/map\n", (int)getpid ());
-	(void)system (buffer);
+        sprintf (buffer, "/bin/cat /proc/%d/map\n", (int)getpid ());
+        (void)system (buffer);
 }
 
 W32 totalRam (GC_state s) {
-	int mem, len;
+        int mem, len;
 
-	len = sizeof (int);
-	if (-1 == sysctlbyname ("hw.physmem", &mem, &len, NULL, 0))
-		diee ("sysctl failed");
-	return mem;
+        len = sizeof (int);
+        if (-1 == sysctlbyname ("hw.physmem", &mem, &len, NULL, 0))
+                diee ("sysctl failed");
+        return mem;
 }

Modified: mlton/branches/on-20050420-cmm-branch/runtime/platform/freebsd.h
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/platform/freebsd.h	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/platform/freebsd.h	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,6 @@
+#include <fenv.h>
+#include <stdint.h>
+
 #include <grp.h>
 #include <limits.h>
 #include <netdb.h>
@@ -20,11 +23,13 @@
 #include <termios.h>
 #include <ucontext.h>
 
+#define HAS_FEROUND TRUE
+#define HAS_FPCLASSIFY TRUE
 #define HAS_PTRACE TRUE
 #define HAS_REMAP FALSE
 #define HAS_SIGALTSTACK TRUE
+#define HAS_SIGNBIT TRUE
 #define HAS_SPAWN FALSE
 #define HAS_TIME_PROFILING TRUE
-#define HAS_WEAK 1
 
 #define MLton_Platform_OS_host "freebsd"

Modified: mlton/branches/on-20050420-cmm-branch/runtime/platform/getText.c
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/platform/getText.c	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/platform/getText.c	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,10 +1,10 @@
 /* To get the beginning and end of the text segment. */
-extern void _start(void);
-extern void etext(void);
+extern char _start;
+extern char etext;
 
 void *getTextStart () {
-	return &_start;
+        return &_start;
 }
 void *getTextEnd () {
-	return &etext;
+        return &etext;
 }

Modified: mlton/branches/on-20050420-cmm-branch/runtime/platform/getrusage.c
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/platform/getrusage.c	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/platform/getrusage.c	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,3 @@
 int fixedGetrusage (int who, struct rusage *rup) {
-	return getrusage (who, rup);
+        return getrusage (who, rup);
 }

Modified: mlton/branches/on-20050420-cmm-branch/runtime/platform/linux.c
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/platform/linux.c	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/platform/linux.c	2006-02-16 19:34:54 UTC (rev 4361)
@@ -10,55 +10,87 @@
 #include "use-mmap.c"
 
 #ifndef EIP
-#define EIP	14
+#define EIP     14
 #endif
 
-static void catcher (int sig, siginfo_t *sip, ucontext_t *ucp) {
-	GC_handleSigProf ((pointer) ucp->uc_mcontext.gregs[EIP]);
+/* potentially correct for other archs:
+ *  alpha: ucp->m_context.sc_pc
+ *  arm: ucp->m_context.ctx.arm_pc
+ *  ia64: ucp->m_context.sc_ip & ~0x3UL
+ *  mips: ucp->m_context.sc_pc
+ *  s390: ucp->m_context.sregs->regs.psw.addr
+ */
+static void catcher (int sig, siginfo_t* sip, void* mystery) {
+#if (defined (__x86_64__))
+#define REG_INDEX(NAME) (offsetof(struct sigcontext, NAME) / sizeof(greg_t))
+#ifndef REG_RIP
+#define REG_RIP REG_INDEX(rip) /* seems to be 16 */
+#endif
+        ucontext_t* ucp = (ucontext_t*)mystery;
+        GC_handleSigProf ((pointer) ucp->uc_mcontext.gregs[REG_RIP]);
+#elif (defined (__hppa__))
+        ucontext_t* ucp = (ucontext_t*)mystery;
+        GC_handleSigProf ((pointer) (ucp->uc_mcontext.sc_iaoq[0] & ~0x3UL));
+#elif (defined (__ppc__)) || (defined (__powerpc__))
+        ucontext_t* ucp = (ucontext_t*)mystery;
+        GC_handleSigProf ((pointer) ucp->uc_mcontext.regs->nip);
+#elif (defined (__sparc__))
+        struct sigcontext* scp = (struct sigcontext*)mystery;
+#if __WORDSIZE == 64
+        GC_handleSigProf ((pointer) scp->sigc_regs.tpc);
+#else
+        GC_handleSigProf ((pointer) scp->si_regs.pc);
+#endif
+#elif (defined (__i386__))
+        ucontext_t* ucp = (ucontext_t*)mystery;
+        GC_handleSigProf ((pointer) ucp->uc_mcontext.gregs[EIP]);
+#else
+#error Profiling handler is missing for this architecture
+#endif
 }
 
 void setSigProfHandler (struct sigaction *sa) {
-	sa->sa_flags = SA_ONSTACK | SA_RESTART | SA_SIGINFO;
-	sa->sa_sigaction = (void (*)(int, siginfo_t*, void*))catcher;
+        sa->sa_flags = SA_ONSTACK | SA_RESTART | SA_SIGINFO;
+        sa->sa_sigaction = (void (*)(int, siginfo_t*, void*))catcher;
 }
 
 /* Work around Linux kernel bugs associated with the user and system times. */
 
 int fixedGetrusage (int who, struct rusage *rup) {
-	struct tms	tbuff;
-	int		res;
-	clock_t		user,
-			sys;
-	static bool	first = TRUE;
-	static long	hz;
+        struct tms      tbuff;
+        int             res;
+        clock_t         user,
+                        sys;
+        static bool     first = TRUE;
+        static long     hz;
 
-	if (first) {
-		first = FALSE;
-		hz = sysconf (_SC_CLK_TCK);
-	}
-	res = getrusage (who, rup);
-	unless (res == 0)
-		return (res);
-	if (times (&tbuff) == -1)
-		diee ("Impossible: times() failed");
-	switch (who) {
-	case RUSAGE_SELF:
-		user = tbuff.tms_utime;
-		sys = tbuff.tms_stime;
-		break;
-	case RUSAGE_CHILDREN:
-		user = tbuff.tms_cutime;
-		sys = tbuff.tms_cstime;
-		break;
-	default:
-		die ("getrusage() accepted unknown who: %d", who);
-		exit (1);  /* needed to keep gcc from whining. */
-	}
-	rup->ru_utime.tv_sec = user / hz;
-	rup->ru_utime.tv_usec = (user % hz) * (1000000 / hz);
-	rup->ru_stime.tv_sec = sys / hz;
-	rup->ru_stime.tv_usec = (sys % hz) * (1000000 / hz);
-	return (0);
+        if (first) {
+                first = FALSE;
+                hz = sysconf (_SC_CLK_TCK);
+        }
+        res = getrusage (who, rup);
+        unless (res == 0)
+                return (res);
+        if (times (&tbuff) == -1)
+                diee ("Impossible: times() failed");
+        switch (who) {
+        case RUSAGE_SELF:
+                user = tbuff.tms_utime;
+                sys = tbuff.tms_stime;
+                break;
+        case RUSAGE_CHILDREN:
+                user = tbuff.tms_cutime;
+                sys = tbuff.tms_cstime;
+                break;
+        default:
+                die ("getrusage() accepted unknown who: %d", who);
+                exit (1);  /* needed to keep gcc from whining. */
+        }
+        rup->ru_utime.tv_sec = user / hz;
+        rup->ru_utime.tv_usec = (user % hz) * (1000000 / hz);
+        rup->ru_stime.tv_sec = sys / hz;
+        rup->ru_stime.tv_usec = (sys % hz) * (1000000 / hz);
+        return (0);
 }
 
 /* We need the value of MREMAP_MAYMOVE, which should come from sys/mman.h, but
@@ -71,5 +103,25 @@
 #define MREMAP_MAYMOVE 1
 
 void *remap (void *old,  size_t oldSize, size_t newSize) {
-	return mremap (old, oldSize, newSize, MREMAP_MAYMOVE);
+        return mremap (old, oldSize, newSize, MREMAP_MAYMOVE);
 }
+
+/* ------------------------------------------------- */
+/*                       Posix                       */
+/* ------------------------------------------------- */
+
+void Posix_IO_setbin (Fd fd) {
+        die("Posix_IO_setbin not implemented");
+}
+
+void Posix_IO_settext (Fd fd) {
+        die("Posix_IO_settext not implemented");
+}
+
+/* ------------------------------------------------- */
+/*                      Process                      */
+/* ------------------------------------------------- */
+
+Pid MLton_Process_cwait (Pid pid, Pointer status) {
+        die("MLton_Process_cwait not implemented");
+}

Modified: mlton/branches/on-20050420-cmm-branch/runtime/platform/linux.h
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/platform/linux.h	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/platform/linux.h	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,6 @@
+#include <fenv.h>
+#include <stdint.h>
+
 #include <grp.h>
 #include <netdb.h>
 #include <netinet/in.h>
@@ -19,16 +22,14 @@
 #include <termios.h>
 #include <values.h>
 
+#define HAS_FEROUND TRUE
+#define HAS_FPCLASSIFY TRUE
 #define HAS_PTRACE TRUE
 #define HAS_REMAP TRUE
 #define HAS_SIGALTSTACK TRUE
+#define HAS_SIGNBIT TRUE
 #define HAS_SPAWN FALSE
-#ifdef __i386__
 #define HAS_TIME_PROFILING TRUE
-#else
-#define HAS_TIME_PROFILING FALSE
-#endif
-#define HAS_WEAK 1
 
 #define MLton_Platform_OS_host "linux"
 

Modified: mlton/branches/on-20050420-cmm-branch/runtime/platform/mingw.c
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/platform/mingw.c	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/platform/mingw.c	2006-02-16 19:34:54 UTC (rev 4361)
@@ -5,47 +5,47 @@
 #include "windows.c"
 
 void decommit (void *base, size_t length) {
-	Windows_decommit (base, length);
+        Windows_decommit (base, length);
 }
 
 HANDLE fileDesHandle (int fd) {
-	return (HANDLE)(_get_osfhandle (fd));
+        return (HANDLE)(_get_osfhandle (fd));
 }
 
 int getpagesize (void) {
-	SYSTEM_INFO sysinfo;
-	GetSystemInfo(&sysinfo);
-	return sysinfo.dwPageSize;
+        SYSTEM_INFO sysinfo;
+        GetSystemInfo(&sysinfo);
+        return sysinfo.dwPageSize;
 }
 
 int mkstemp (char *template) {
-	char file_path[255];
-	char file_name[255];
-	char templ[4];
+        char file_path[255];
+        char file_name[255];
+        char templ[4];
 
-	if (0 == GetTempPath (sizeof (file_path), file_path))
-		diee ("unable to make temporary file");
-	strncpy (templ, template, sizeof (templ) - 1);
-	templ[sizeof (templ) - 1] = 0x00;
-	if (0 == GetTempFileName (file_path, templ, 0, file_name))
-		diee ("unable to make temporary file");
-	return _open (file_name, _O_CREAT | _O_RDWR, _S_IREAD | _S_IWRITE);
+        if (0 == GetTempPath (sizeof (file_path), file_path))
+                diee ("unable to make temporary file");
+        strncpy (templ, template, sizeof (templ) - 1);
+        templ[sizeof (templ) - 1] = 0x00;
+        if (0 == GetTempFileName (file_path, templ, 0, file_name))
+                diee ("unable to make temporary file");
+        return _open (file_name, _O_CREAT | _O_RDWR, _S_IREAD | _S_IWRITE);
 }
 
 void *mmapAnon (void *start, size_t length) {
-	return Windows_mmapAnon (start, length);
+        return Windows_mmapAnon (start, length);
 }
 
 void release (void *base, size_t length) {
-	Windows_release (base);
+        Windows_release (base);
 }
 
 Word32 totalRam (GC_state s) {
-	MEMORYSTATUS memStat;
+        MEMORYSTATUS memStat;
 
-	memStat.dwLength = sizeof(memStat);
-	GlobalMemoryStatus(&memStat);
-	return memStat.dwTotalPhys;
+        memStat.dwLength = sizeof(memStat);
+        GlobalMemoryStatus(&memStat);
+        return memStat.dwTotalPhys;
 }
 
 /* ------------------------------------------------- */
@@ -62,24 +62,24 @@
  *   http://mywebpage.netscape.com/yongweiwutime.htm 
  */
 int gettimeofday (struct timeval *tv, struct timezone *tz) {
-	FILETIME ft;
-	LARGE_INTEGER li;
-	__int64 t;
-	static bool tzInit = FALSE;
-	
-	unless (tzInit) {
-		tzInit = TRUE;
-		_tzset();
-	}
-	GetSystemTimeAsFileTime (&ft);
-	li.LowPart = ft.dwLowDateTime;
-	li.HighPart = ft.dwHighDateTime;
-	t = li.QuadPart;
-	t -= EPOCHFILETIME;
-	t /= 10;
-	tv->tv_sec = (long)(t / 1000000);
-	tv->tv_usec = (long)(t % 1000000);
-	return 0;
+        FILETIME ft;
+        LARGE_INTEGER li;
+        __int64 t;
+        static bool tzInit = FALSE;
+        
+        unless (tzInit) {
+                tzInit = TRUE;
+                _tzset();
+        }
+        GetSystemTimeAsFileTime (&ft);
+        li.LowPart = ft.dwLowDateTime;
+        li.HighPart = ft.dwHighDateTime;
+        t = li.QuadPart;
+        t -= EPOCHFILETIME;
+        t /= 10;
+        tv->tv_sec = (long)(t / 1000000);
+        tv->tv_usec = (long)(t % 1000000);
+        return 0;
 }
 
 /* ------------------------------------------------- */
@@ -87,9 +87,9 @@
 /* ------------------------------------------------- */
 
 int setitimer (int which, 
-		const struct itimerval *value, 
-		struct itimerval *ovalue) {
-	die ("setitimer not implemented");
+                const struct itimerval *value, 
+                struct itimerval *ovalue) {
+        die ("setitimer not implemented");
 }
 
 /* ------------------------------------------------- */
@@ -99,42 +99,42 @@
 static struct rlimit rlimits[RLIM_NLIMITS];
 
 static void initRlimits () {
-	static int done = FALSE;
- 	int lim;
+        static int done = FALSE;
+        int lim;
 
-	if (done)
-		return;
-	done = TRUE;
-	for (lim = 0; lim < RLIM_NLIMITS; ++lim ) {
-		rlimits[lim].rlim_cur = 0;
-		rlimits[lim].rlim_max = UINT_MAX;
-	}
+        if (done)
+                return;
+        done = TRUE;
+        for (lim = 0; lim < RLIM_NLIMITS; ++lim ) {
+                rlimits[lim].rlim_cur = 0;
+                rlimits[lim].rlim_max = UINT_MAX;
+        }
 }
 
 int getrlimit (int resource, struct rlimit *rlp) {
-	initRlimits ();
-	if (resource < 0 or resource >= RLIM_NLIMITS) {
-		errno = EINVAL;
-		return -1;
-	}
-	*rlp = rlimits[resource];
-	return 0;
+        initRlimits ();
+        if (resource < 0 or resource >= RLIM_NLIMITS) {
+                errno = EINVAL;
+                return -1;
+        }
+        *rlp = rlimits[resource];
+        return 0;
 }
 
 int setrlimit (int resource, const struct rlimit *rlp) {
-	initRlimits ();
-	if (resource < 0 or resource >= RLIM_NLIMITS) {
-		errno = EINVAL;
-		return -1;
-	}
-	if (rlp->rlim_cur < rlimits[resource].rlim_max)
-		rlimits[resource].rlim_cur = rlp->rlim_cur;
-	else {
-		errno = EPERM;
-		return -1;
-	}
-	rlimits[resource].rlim_max = rlp->rlim_max;
-	return 0;
+        initRlimits ();
+        if (resource < 0 or resource >= RLIM_NLIMITS) {
+                errno = EINVAL;
+                return -1;
+        }
+        if (rlp->rlim_cur < rlimits[resource].rlim_max)
+                rlimits[resource].rlim_cur = rlp->rlim_cur;
+        else {
+                errno = EPERM;
+                return -1;
+        }
+        rlimits[resource].rlim_max = rlp->rlim_max;
+        return 0;
 }
 
 /* ------------------------------------------------- */
@@ -146,11 +146,11 @@
  */
 
 int fixedGetrusage (int who, struct rusage *usage) {
-	usage->ru_utime.tv_sec = 0;
-	usage->ru_utime.tv_usec = 0;
-	usage->ru_stime.tv_sec = 0;
-	usage->ru_stime.tv_usec = 0;
-	return 0;
+        usage->ru_utime.tv_sec = 0;
+        usage->ru_utime.tv_usec = 0;
+        usage->ru_stime.tv_sec = 0;
+        usage->ru_stime.tv_usec = 0;
+        return 0;
 }
 
 /* ------------------------------------------------- */
@@ -158,7 +158,7 @@
 /* ------------------------------------------------- */
 
 int poll (struct pollfd *ufds, unsigned int nfds, int timeout) {
-	die ("poll not implemented");
+        die ("poll not implemented");
 }
 
 /* ------------------------------------------------- */
@@ -167,76 +167,76 @@
 
 #if FALSE
 static void GetWin32FileName (int fd, char* fname) {
-	HANDLE fh, fhmap;
-	DWORD fileSize, fileSizeHi;
-	void* pMem = NULL;
-	
-	fh = (HANDLE)_get_osfhandle (fd);
-	fileSize = GetFileSize (fh, &fileSizeHi);
-	fhmap = CreateFileMapping (fh, NULL, PAGE_READONLY, 0, fileSize, NULL);
-	if (fhmap) {
-	    pMem = MapViewOfFile (fhmap, FILE_MAP_READ, 0, 0, 1);
-	    if (pMem) {
-		GetMappedFileNameA (GetCurrentProcess(), pMem, fname, MAX_PATH);
-		UnmapViewOfFile (pMem);
-	    }
-	    CloseHandle (fhmap);
-	}
-	return;	
+        HANDLE fh, fhmap;
+        DWORD fileSize, fileSizeHi;
+        void* pMem = NULL;
+        
+        fh = (HANDLE)_get_osfhandle (fd);
+        fileSize = GetFileSize (fh, &fileSizeHi);
+        fhmap = CreateFileMapping (fh, NULL, PAGE_READONLY, 0, fileSize, NULL);
+        if (fhmap) {
+            pMem = MapViewOfFile (fhmap, FILE_MAP_READ, 0, 0, 1);
+            if (pMem) {
+                GetMappedFileNameA (GetCurrentProcess(), pMem, fname, MAX_PATH);
+                UnmapViewOfFile (pMem);
+            }
+            CloseHandle (fhmap);
+        }
+        return; 
 }
 #endif
 
 int chown (const char *path, uid_t owner, gid_t group) {
-	die ("chown not implemented");
+        die ("chown not implemented");
 }
 
 int fchmod (int filedes, mode_t mode) {
-	die ("chown not implemented");
-//	char fname[MAX_PATH + 1];
+        die ("chown not implemented");
+//      char fname[MAX_PATH + 1];
 //
-//	GetWin32FileName (filedes, fname);
-//	return _chmod (fname, mode);
+//      GetWin32FileName (filedes, fname);
+//      return _chmod (fname, mode);
 }
 
 int fchown (int fd, uid_t owner, gid_t group) {
-	die ("fchown not implemented");
+        die ("fchown not implemented");
 }
 
 long fpathconf (int filedes, int name) {
-	die ("fpathconf not implemented");
+        die ("fpathconf not implemented");
 }
 
 int ftruncate (int fd, off_t length) {
-	return _chsize (fd, length);
+        return _chsize (fd, length);
 }
 
 int link (const char *oldpath, const char *newpath) {
-	die ("link not implemented");
+        die ("link not implemented");
 }
 
 int lstat (const char *file_name, struct stat *buf) {
-	/* Win32 doesn't really have links. */
-	return stat (file_name, buf);
+        /* Win32 doesn't really have links. */
+        return stat (file_name, buf);
 }
 
 int mkdir2 (const char *pathname, mode_t mode) {
-	return mkdir (pathname);
+        return mkdir (pathname);
 }
 
 int mkfifo (const char *pathname, mode_t mode) {
-	die ("mkfifo not implemented");
+        die ("mkfifo not implemented");
 }
 
 long pathconf (char *path, int name) {
-	die ("pathconf not implemented");
+        die ("pathconf not implemented");
 }
 
 int readlink (const char *path, char *buf, size_t bufsiz) {
-	die ("readlink not implemented");
+        die ("readlink not implemented");
 }
 
 int symlink (const char *oldpath, const char *newpath) {
-	die ("symlink not implemented");
+        die ("symlink not implemented");
 }
 
 /* ------------------------------------------------- */
@@ -244,43 +244,43 @@
 /* ------------------------------------------------- */
 
 int fcntl (int fd, int cmd, ...) {
-	die ("fcntl not implemented");
+        die ("fcntl not implemented");
 }
 
 int fsync (int fd) {
-	return _commit (fd);
+        return _commit (fd);
 }
 
 int pipe (int filedes[2]) {
-	HANDLE read;
-	HANDLE write;
-	
-	/* We pass no security attributes (0), so the current policy gets
-	 * inherited. The pipe is set to NOT stay open in child processes.
-	 * This will be corrected using DuplicateHandle in create()
-	 * The 4k buffersize is choosen b/c that's what linux uses.
-	 */
-	if (!CreatePipe(&read, &write, 0, 4096)) {
-		errno = ENOMEM; /* fake errno: out of resources */
-		return -1;
-	}
-	/* This requires Win98+
-	 * Choosing text/binary mode is defered till a later setbin/text call
-	 */
-	filedes[0] = _open_osfhandle((long)read,  _O_RDONLY);
-	filedes[1] = _open_osfhandle((long)write, _O_WRONLY);
-	if (filedes[0] == -1 or filedes[1] == -1) {
-		if (filedes[0] == -1) 
-			CloseHandle(read); 
-		else	close(filedes[0]);
-		if (filedes[1] == -1) 
-			CloseHandle(write);
-		else	close(filedes[1]);
-		
-		errno = ENFILE;
-		return -1;
-	}
-	return 0;
+        HANDLE read;
+        HANDLE write;
+        
+        /* We pass no security attributes (0), so the current policy gets
+         * inherited. The pipe is set to NOT stay open in child processes.
+         * This will be corrected using DuplicateHandle in create()
+         * The 4k buffersize is choosen b/c that's what linux uses.
+         */
+        if (!CreatePipe(&read, &write, 0, 4096)) {
+                errno = ENOMEM; /* fake errno: out of resources */
+                return -1;
+        }
+        /* This requires Win98+
+         * Choosing text/binary mode is defered till a later setbin/text call
+         */
+        filedes[0] = _open_osfhandle((long)read,  _O_RDONLY);
+        filedes[1] = _open_osfhandle((long)write, _O_WRONLY);
+        if (filedes[0] == -1 or filedes[1] == -1) {
+                if (filedes[0] == -1) 
+                        CloseHandle(read); 
+                else    close(filedes[0]);
+                if (filedes[1] == -1) 
+                        CloseHandle(write);
+                else    close(filedes[1]);
+                
+                errno = ENFILE;
+                return -1;
+        }
+        return 0;
 }
 
 /* ------------------------------------------------- */
@@ -288,136 +288,146 @@
 /* ------------------------------------------------- */
 
 char *ctermid (char *s) {
-	die ("*ctermid not implemented");
+        die ("*ctermid not implemented");
 }
 gid_t getegid (void) {
-	die ("getegid not implemented");
+        die ("getegid not implemented");
 }
 uid_t geteuid (void) {
-	die ("geteuid not implemented");
+        die ("geteuid not implemented");
 }
 gid_t getgid (void) {
-	die ("getgid not implemented");
+        die ("getgid not implemented");
 }
 int getgroups (int size, gid_t list[]) {
-	die ("getgroups not implemented");
+        die ("getgroups not implemented");
 }
 char *getlogin (void) {
-	die ("*getlogin not implemented");
+        die ("*getlogin not implemented");
 }
 pid_t getpgid(pid_t pid) {
-	die ("getpgid not implemented");
+        die ("getpgid not implemented");
 }
 pid_t getpgrp(void) {
-	die ("getpgrp not implemented");
+        die ("getpgrp not implemented");
 }
 pid_t getpid (void) {
-	die ("getpid not implemented");
+        die ("getpid not implemented");
 }
 pid_t getppid (void) {
-	die ("getppid not implemented");
+        die ("getppid not implemented");
 }
 uid_t getuid (void) {
-	die ("getuid not implemented");
+        die ("getuid not implemented");
 }
 
 int setenv (const char *name, const char *value, int overwrite) {
-	/* We could use _putenv, but then we'd need a temporary buffer for
-	 * use to concat name=value. 
+        /* We could use _putenv, but then we'd need a temporary buffer for
+         * use to concat name=value. 
          */
-	if (overwrite or not (getenv (name)))
-		unless (SetEnvironmentVariable (name, value)) {
-			errno = ENOMEM; /* this happens often in Windows.. */
-			return -1;
-		}
-	return 0;
+        if (not overwrite and getenv (name)) {
+                errno = EEXIST;
+                return -1; /* previous mingw setenv was buggy and returned 0 */
+        }
+        
+        if (SetEnvironmentVariable (name, value)) {
+                errno = ENOMEM; /* this happens often in Windows.. */
+                return -1;
+        }
+        
+        return 0;
 }
 
 int setgid (gid_t gid) {
-	die ("setgid not implemented");
+        die ("setgid not implemented");
 }
+
+int setgroups (size_t size, gid_t *list) {
+        die ("setgroups not implemented");
+}
+
 int setpgid (pid_t pid, pid_t pgid) {
-	die ("setpgid not implemented");
+        die ("setpgid not implemented");
 }
 pid_t setsid (void) {
-	die ("setsid not implemented");
+        die ("setsid not implemented");
 }
 int setuid (uid_t uid) {
-	die ("setuid not implemented");
+        die ("setuid not implemented");
 }
 long sysconf (int name) {
-	die ("sysconf not implemented");
+        die ("sysconf not implemented");
 }
 clock_t times (struct tms *buf) {
-	die ("times not implemented");
+        die ("times not implemented");
 }
 char *ttyname (int desc) {
-	die ("*ttyname not implemented");
+        die ("*ttyname not implemented");
 }
 
 static void setMachine (struct utsname *buf) {
-	int level;
-	const char* platform = "unknown";
-	SYSTEM_INFO si;
+        int level;
+        const char* platform = "unknown";
+        SYSTEM_INFO si;
 
-	GetSystemInfo (&si);
-	level = si.dwProcessorType;
-	switch (si.wProcessorArchitecture) {
-	case PROCESSOR_ARCHITECTURE_INTEL:
-		if (level < 3) level = 3;
-		if (level > 6) level = 6;
-		platform = "i%d86"; 
-		break;
-	case PROCESSOR_ARCHITECTURE_IA64:  platform = "ia64";  break;
+        GetSystemInfo (&si);
+        level = si.dwProcessorType;
+        switch (si.wProcessorArchitecture) {
+        case PROCESSOR_ARCHITECTURE_INTEL:
+                if (level < 3) level = 3;
+                if (level > 6) level = 6;
+                platform = "i%d86"; 
+                break;
+        case PROCESSOR_ARCHITECTURE_IA64:  platform = "ia64";  break;
 #ifndef PROCESSOR_ARCHITECTURE_AMD64
 #define PROCESSOR_ARCHITECTURE_AMD64 9
 #endif
-	case PROCESSOR_ARCHITECTURE_AMD64: platform = "amd64"; break; 
+        case PROCESSOR_ARCHITECTURE_AMD64: platform = "amd64"; break; 
 
-	case PROCESSOR_ARCHITECTURE_ALPHA: platform = "alpha"; break;
-	case PROCESSOR_ARCHITECTURE_MIPS:  platform = "mips";  break;
-	}
-	sprintf (buf->machine, platform, level);
+        case PROCESSOR_ARCHITECTURE_ALPHA: platform = "alpha"; break;
+        case PROCESSOR_ARCHITECTURE_MIPS:  platform = "mips";  break;
+        }
+        sprintf (buf->machine, platform, level);
 }
 
 static void setSysname (struct utsname *buf) {
-	OSVERSIONINFO osv;
-	const char* os = "??";
+        OSVERSIONINFO osv;
+        const char* os = "??";
 
-	osv.dwOSVersionInfoSize = sizeof (osv);
-	GetVersionEx (&osv);
-	switch (osv.dwPlatformId) {
-	case VER_PLATFORM_WIN32_NT:
-		if (osv.dwMinorVersion == 0) {
-			if (osv.dwMajorVersion <= 4)	os = "NT";
-			else				os = "2000";
-		} else if (osv.dwMinorVersion <= 1)	os = "XP";
-		else if (osv.dwMinorVersion <= 2)	os = "2003";
-		else					os = "NTx";
-		break;
-	case VER_PLATFORM_WIN32_WINDOWS:
-		if (osv.dwMinorVersion == 0)		os = "95";
-		else if (osv.dwMinorVersion < 90)	os = "98";
-		else if (osv.dwMinorVersion == 90)	os = "Me";
-		else					os = "9X";
-		break;
-	case VER_PLATFORM_WIN32s:
-		os = "31"; /* aka DOS + Windows 3.1 */
-		break;
-	}
-	sprintf (buf->sysname, "MINGW32_%s-%d.%d",
-		os, (int)osv.dwMajorVersion, (int)osv.dwMinorVersion);
+        osv.dwOSVersionInfoSize = sizeof (osv);
+        GetVersionEx (&osv);
+        switch (osv.dwPlatformId) {
+        case VER_PLATFORM_WIN32_NT:
+                if (osv.dwMinorVersion == 0) {
+                        if (osv.dwMajorVersion <= 4)    os = "NT";
+                        else                            os = "2000";
+                } else if (osv.dwMinorVersion <= 1)     os = "XP";
+                else if (osv.dwMinorVersion <= 2)       os = "2003";
+                else                                    os = "NTx";
+                break;
+        case VER_PLATFORM_WIN32_WINDOWS:
+                if (osv.dwMinorVersion == 0)            os = "95";
+                else if (osv.dwMinorVersion < 90)       os = "98";
+                else if (osv.dwMinorVersion == 90)      os = "Me";
+                else                                    os = "9X";
+                break;
+        case VER_PLATFORM_WIN32s:
+                os = "31"; /* aka DOS + Windows 3.1 */
+                break;
+        }
+        sprintf (buf->sysname, "MINGW32_%s-%d.%d",
+                os, (int)osv.dwMajorVersion, (int)osv.dwMinorVersion);
 }
 
 int uname (struct utsname *buf) {
-	setMachine (buf);
-	unless (0 == gethostname (buf->nodename, sizeof (buf->nodename))) {
-		strcpy (buf->nodename, "unknown");
-	}
-	sprintf (buf->release, "%d", __MINGW32_MINOR_VERSION);
-	setSysname (buf);
-	sprintf (buf->version, "%d", __MINGW32_MAJOR_VERSION);
-	return 0;
+        setMachine (buf);
+        unless (0 == gethostname (buf->nodename, sizeof (buf->nodename))) {
+                strcpy (buf->nodename, "unknown");
+        }
+        sprintf (buf->release, "%d", __MINGW32_MINOR_VERSION);
+        setSysname (buf);
+        sprintf (buf->version, "%d", __MINGW32_MAJOR_VERSION);
+        return 0;
 }
 
 /* ------------------------------------------------- */
@@ -429,7 +439,7 @@
 static LARGE_INTEGER timer_start_val;
 
 VOID CALLBACK alarm_signalled(HWND window, UINT message,
-	UINT_PTR timer_id, DWORD time)
+        UINT_PTR timer_id, DWORD time)
 {
     printf("Timer fired\n");
 }
@@ -438,62 +448,69 @@
  * Win32 alarm implementation
  */
 int alarm (int secs) {
-	LARGE_INTEGER timer_end_val, frequency;
-	int remaining = 0;
-	long elapse = secs * 1000;	/* win32 uses usecs */
+        LARGE_INTEGER timer_end_val, frequency;
+        int remaining = 0;
+        long elapse = secs * 1000;      /* win32 uses usecs */
     
-	/* Unsetting the alarm */
-	if (secs == 0 && curr_timer == 0) {
-	    return 0;
-	}
-	if (curr_timer != 0) {
-		KillTimer(0, curr_timer);
-		QueryPerformanceCounter(&timer_end_val);
-		QueryPerformanceFrequency(&frequency);
-		if (frequency.QuadPart != 0) {
-			remaining = curr_timer_dur - ((int)(timer_end_val.QuadPart
-				- timer_start_val.QuadPart)/frequency.QuadPart);
-			if (remaining < 0) {
-				remaining = 0;
-			}
-		}
+        /* Unsetting the alarm */
+        if (secs == 0 && curr_timer == 0) {
+            return 0;
+        }
+        if (curr_timer != 0) {
+                KillTimer(0, curr_timer);
+                QueryPerformanceCounter(&timer_end_val);
+                QueryPerformanceFrequency(&frequency);
+                if (frequency.QuadPart != 0) {
+                        remaining = curr_timer_dur - ((int)(timer_end_val.QuadPart
+                                - timer_start_val.QuadPart)/frequency.QuadPart);
+                        if (remaining < 0) {
+                                remaining = 0;
+                        }
+                }
 
-		timer_start_val.QuadPart = 0;
-		curr_timer_dur = 0;
-		curr_timer = 0;
-	}
-	if (secs != 0) {
-		/* Otherwise, set a timer */
-		curr_timer = SetTimer(0, 0, elapse, alarm_signalled);
-		QueryPerformanceCounter(&timer_start_val);
-		curr_timer_dur = secs;
-	}
-	return remaining;
+                timer_start_val.QuadPart = 0;
+                curr_timer_dur = 0;
+                curr_timer = 0;
+        }
+        if (secs != 0) {
+                /* Otherwise, set a timer */
+                curr_timer = SetTimer(0, 0, elapse, alarm_signalled);
+                QueryPerformanceCounter(&timer_start_val);
+                curr_timer_dur = secs;
+        }
+        return remaining;
 }
 
 pid_t fork (void) {
-	die ("fork not implemented");
+        die ("fork not implemented");
 }
 
 int kill (pid_t pid, int sig) {
-	die ("kill not implemented");
+        die ("kill not implemented");
 }
 
+int nanosleep (const struct timespec *req, struct timespec *rem) {
+        Sleep (req->tv_sec * 1000 + (req->tv_nsec + 999) / 1000);
+        rem->tv_nsec = 0;
+        rem->tv_sec = 0;
+        return 0;
+}
+
 int pause (void) {
-	die ("pause not implemented");
+        die ("pause not implemented");
 }
 
 unsigned int sleep (unsigned int seconds) {
-	Sleep (seconds * 1000);
-	return 0;
+        Sleep (seconds * 1000);
+        return 0;
 }
 
 pid_t wait (int *status) {
-	die ("wait not implemented");
+        die ("wait not implemented");
 }
 
 pid_t waitpid (pid_t pid, int *status, int options) {
-	die ("waitpid not implemented");
+        die ("waitpid not implemented");
 }
 
 /* ------------------------------------------------- */
@@ -501,100 +518,100 @@
 /* ------------------------------------------------- */
 
 int sigaction (int signum, 
-			const struct sigaction *newact,
-			struct sigaction *oldact) {
+                        const struct sigaction *newact,
+                        struct sigaction *oldact) {
 
-	struct sigaction oa;
+        struct sigaction oa;
 
-	if (signum < 0 or signum >= NSIG) {
-		errno = EINVAL;
-		return -1;
-	}
-	if (newact) {
-		if (signum == SIGKILL or signum == SIGSTOP) {
-			errno = EINVAL;
-			return -1;
-		}
-		oa.sa_handler = signal (signum, newact->sa_handler);
-	}
-	if (oldact)
-		oldact->sa_handler = oa.sa_handler;
-	return 0;
+        if (signum < 0 or signum >= NSIG) {
+                errno = EINVAL;
+                return -1;
+        }
+        if (newact) {
+                if (signum == SIGKILL or signum == SIGSTOP) {
+                        errno = EINVAL;
+                        return -1;
+                }
+                oa.sa_handler = signal (signum, newact->sa_handler);
+        }
+        if (oldact)
+                oldact->sa_handler = oa.sa_handler;
+        return 0;
 }
 
 int sigaddset (sigset_t *set, const int signum) {
-	if (signum < 0 or signum >= NSIG) {
-		errno = EINVAL;
-		return -1;
-	}
-	*set |= SIGTOMASK (signum);
-	return 0;
+        if (signum < 0 or signum >= NSIG) {
+                errno = EINVAL;
+                return -1;
+        }
+        *set |= SIGTOMASK (signum);
+        return 0;
 }
 
 int sigdelset (sigset_t *set, const int signum) {
-	if (signum < 0 or signum >= NSIG) {
-		errno = EINVAL;
-		return -1;
-	}
-	*set &= ~SIGTOMASK (signum);
-	return 0;
+        if (signum < 0 or signum >= NSIG) {
+                errno = EINVAL;
+                return -1;
+        }
+        *set &= ~SIGTOMASK (signum);
+        return 0;
 }
 
 int sigemptyset (sigset_t *set) {
-	*set = (sigset_t) 0;
-	return 0;
+        *set = (sigset_t) 0;
+        return 0;
 }
 
 int sigfillset (sigset_t *set) {
-	*set = ~((sigset_t) 0);
-	return 0;
+        *set = ~((sigset_t) 0);
+        return 0;
 }
 
 int sigismember (const sigset_t *set, const int signum) {
-	if (signum < 0 or signum >= NSIG) {
-		errno = EINVAL;
-		return -1;
-	}
-	return (*set & SIGTOMASK(signum)) ? 1 : 0;
+        if (signum < 0 or signum >= NSIG) {
+                errno = EINVAL;
+                return -1;
+        }
+        return (*set & SIGTOMASK(signum)) ? 1 : 0;
 }
 
 int sigpending (sigset_t *set) {
-	die ("sigpending not implemented");
+        die ("sigpending not implemented");
 }
 
 int sigprocmask (int how, const sigset_t *set, sigset_t *oldset) {
 
-	sigset_t opmask;
+        sigset_t opmask;
 
-	if (oldset) {
-		//*oldset = opmask;
-	}
-	if (set) {
-		sigset_t newmask = opmask;
+        if (oldset) {
+                //*oldset = opmask;
+        }
+        if (set) {
+                sigset_t newmask = opmask;
 
-		switch (how) {
-			case SIG_BLOCK:
-				/* add set to current mask */
-				newmask |= *set;
-			break;
-			case SIG_UNBLOCK:
-				/* remove set from current mask */
-				newmask &= ~*set;
-			break;
-			case SIG_SETMASK:
-				/* just set it */
-				newmask = *set;
-			break;
-			default:
-				return -1;
-		}
-		//(void) set_signal_mask (newmask, opmask);
-	}
-	return 0;
+                switch (how) {
+                        case SIG_BLOCK:
+                                /* add set to current mask */
+                                newmask |= *set;
+                        break;
+                        case SIG_UNBLOCK:
+                                /* remove set from current mask */
+                                newmask &= ~*set;
+                        break;
+                        case SIG_SETMASK:
+                                /* just set it */
+                                newmask = *set;
+                        break;
+                        default:
+                                return -1;
+                }
+                //(void) set_signal_mask (newmask, opmask);
+        }
+        return 0;
 }
 
 int sigsuspend (const sigset_t *mask) {
-	die ("sigsuspend not implemented");
+        die ("sigsuspend not implemented");
 }
 
 /* ------------------------------------------------- */
@@ -602,11 +619,11 @@
 /* ------------------------------------------------- */
 
 void Posix_IO_setbin (Fd fd) {
-	_setmode (fd, _O_BINARY);
+        _setmode (fd, _O_BINARY);
 }
 
 void Posix_IO_settext (Fd fd) {
-	_setmode (fd, _O_TEXT);
+        _setmode (fd, _O_TEXT);
 }
 
 /* ------------------------------------------------- */
@@ -619,29 +636,29 @@
 static struct passwd passwd;
 
 struct group *getgrgid (gid_t gid) {
-	die ("getgrgid not implemented");
+        die ("getgrgid not implemented");
 }
 
 struct group *getgrnam (const char *name) {
-	die ("getgrnam not implemented");
+        die ("getgrnam not implemented");
 }
 
 struct passwd *getpwnam (const char *name) {
-	return NULL;
-//	unless (NERR_Success == 
-//			NetUserGetInfo (NULL, (LPCWSTR)name, INFO_LEVEL, 
-//					(LPBYTE*)&usrData))
-//		return NULL;
-	passwd.pw_dir = (char*)usrData->usri3_home_dir;
-	passwd.pw_gid = usrData->usri3_primary_group_id;
-	passwd.pw_name = (char*)usrData->usri3_name;
-	passwd.pw_shell = (char*)usrData->usri3_script_path;
-	passwd.pw_uid = usrData->usri3_user_id;
-	return &passwd;
+        return NULL;
+//      unless (NERR_Success == 
+//                      NetUserGetInfo (NULL, (LPCWSTR)name, INFO_LEVEL, 
+//                                      (LPBYTE*)&usrData))
+//              return NULL;
+        passwd.pw_dir = (char*)usrData->usri3_home_dir;
+        passwd.pw_gid = usrData->usri3_primary_group_id;
+        passwd.pw_name = (char*)usrData->usri3_name;
+        passwd.pw_shell = (char*)usrData->usri3_script_path;
+        passwd.pw_uid = usrData->usri3_user_id;
+        return &passwd;
 }
 
 struct passwd *getpwuid (uid_t uid) {
-	die ("getpwuid not implemented");
+        die ("getpwuid not implemented");
 }
 
 /* ------------------------------------------------- */
@@ -649,51 +666,51 @@
 /* ------------------------------------------------- */
 
 speed_t cfgetispeed (struct termios *termios_p) {
-	die ("cfgetispeed not implemented");
+        die ("cfgetispeed not implemented");
 }
 
 speed_t cfgetospeed (struct termios *termios_p) {
-	die ("cfgetospeed not implemented");
+        die ("cfgetospeed not implemented");
 }
 
 int cfsetispeed (struct termios *termios_p, speed_t speed) {
-	die ("cfsetispeed not implemented");
+        die ("cfsetispeed not implemented");
 }
 
 int cfsetospeed (struct termios *termios_p, speed_t speed) {
-	die ("cfsetospeed not implemented");
+        die ("cfsetospeed not implemented");
 }
 
 int tcdrain (int fd) {
-	die ("tcdrain not implemented");
+        die ("tcdrain not implemented");
 }
 
 int tcflow (int fd, int action) {
-	die ("tcflow not implemented");
+        die ("tcflow not implemented");
 }
 
 int tcflush (int fd, int queue_selector) {
-	die ("tcflush not implemented");
+        die ("tcflush not implemented");
 }
 
 int tcgetattr (int fd, struct termios *termios_p) {
-	die ("tcgetattr not implemented");
+        die ("tcgetattr not implemented");
 }
 
 pid_t tcgetpgrp (int fd) {
-	die ("tcgetpgrp not implemented");
+        die ("tcgetpgrp not implemented");
 }
 
 int tcsendbreak (int fd, int duration) {
-	die ("tcsendbreak not implemented");
+        die ("tcsendbreak not implemented");
 }
 
 int tcsetattr (int fd, int optional_actions, struct termios *termios_p) {
-	die ("tcsetattr not implemented");
+        die ("tcsetattr not implemented");
 }
 
 int tcsetpgrp (int fd, pid_t pgrpid) {
-	die ("tcsetpgrp not implemented");
+        die ("tcsetpgrp not implemented");
 }
 
 /* ------------------------------------------------- */
@@ -701,11 +718,11 @@
 /* ------------------------------------------------- */
 
 Pid MLton_Process_cwait (Pid pid, Pointer status) {
-	HANDLE h;
-	
-	h = (HANDLE)pid;
-	/* -1 on error, the casts here are due to bad types on both sides */
-	return _cwait ((int*)status, (_pid_t)h, 0);
+        HANDLE h;
+        
+        h = (HANDLE)pid;
+        /* -1 on error, the casts here are due to bad types on both sides */
+        return _cwait ((int*)status, (_pid_t)h, 0);
 }
 
 /* ------------------------------------------------- */
@@ -713,21 +730,21 @@
 /* ------------------------------------------------- */
 
 int ioctl (int d, int request, ...) {
-	die ("ioctl not implemented");
+        die ("ioctl not implemented");
 }
 
 int socketpair (int d, int type, int protocol, int sv[2]) {
-	die ("socketpair not implemented");
+        die ("socketpair not implemented");
 }
 
 void MLton_initSockets () {
-	static Bool isInitialized = FALSE;
-	WORD version;
-	WSADATA wsaData;
-	
-	unless (isInitialized) {
-		isInitialized = TRUE;
-		version = MAKEWORD (2,2);
-		WSAStartup (version, &wsaData);
-	}
+        static Bool isInitialized = FALSE;
+        WORD version;
+        WSADATA wsaData;
+        
+        unless (isInitialized) {
+                isInitialized = TRUE;
+                version = MAKEWORD (2,2);
+                WSAStartup (version, &wsaData);
+        }
 }

Modified: mlton/branches/on-20050420-cmm-branch/runtime/platform/mingw.h
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/platform/mingw.h	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/platform/mingw.h	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,6 @@
+#include <fenv.h>
+#include <stdint.h>
+
 #include <windows.h> // lots of stuff depends on this
 #include <io.h>
 #include <limits.h>
@@ -11,12 +14,17 @@
 #include <ws2tcpip.h>
 #undef max
 
+#define HAS_FEROUND TRUE
+// As of 20051104, MinGW has fpclassify, but it is broken.  In particular, it
+// classifies subnormals as normals.  So, we disable it here, which causes the
+// runtime to use our own version.
+#define HAS_FPCLASSIFY FALSE
 #define HAS_PTRACE FALSE
 #define HAS_REMAP FALSE
 #define HAS_SIGALTSTACK FALSE
+#define HAS_SIGNBIT TRUE
 #define HAS_SPAWN TRUE
 #define HAS_TIME_PROFILING FALSE
-#define HAS_WEAK FALSE
 
 #define MLton_Platform_OS_host "mingw"
 
@@ -55,7 +63,7 @@
 
 #define MSG_DONTWAIT 0
 
-#define SHUT_RD	SD_RECEIVE
+#define SHUT_RD SD_RECEIVE
 #define SHUT_WR SD_SEND
 #define SHUT_RDWR SD_BOTH
 
@@ -80,12 +88,12 @@
 #define ITIMER_PROF    2                /*generates sigprof */ 
 
 struct itimerval {
-	struct timeval it_interval;
-	struct timeval it_value;
+        struct timeval it_interval;
+        struct timeval it_value;
 };
 int setitimer (int which,
-		 const struct itimerval *value,
-		 struct itimerval *ovalue);
+                 const struct itimerval *value,
+                 struct itimerval *ovalue);
 
 /* ------------------------------------------------- */
 /*                   MLton.Rlimit                    */
@@ -110,8 +118,8 @@
 typedef unsigned long rlim_t;
 
 struct rlimit {
-	rlim_t	rlim_cur;
-	rlim_t	rlim_max;
+        rlim_t  rlim_cur;
+        rlim_t  rlim_max;
 };
 
 int getrlimit (int resource, struct rlimit *rlim);
@@ -136,9 +144,9 @@
 /* ------------------------------------------------- */
 
 struct pollfd {
- 	short events;
-	int fd;
- 	short revents;
+        short events;
+        int fd;
+        short revents;
 };
 
 int poll (struct pollfd *ufds, unsigned int nfds, int timeout);
@@ -190,11 +198,11 @@
 /* ------------------------------------------------- */
 
 struct flock {
-	off_t l_len;
-	pid_t l_pid;
-	off_t l_start;
-	short l_type;
-	short l_whence;
+        off_t l_len;
+        pid_t l_pid;
+        off_t l_start;
+        short l_type;
+        short l_whence;
 };
 
 int fcntl (int fd, int cmd, ...);
@@ -230,18 +238,18 @@
 #define _SC_VERSION 7
 
 struct tms {
-	int tms_utime;
-	int tms_stime;
-	int tms_cutime;
-	int tms_cstime;
+        int tms_utime;
+        int tms_stime;
+        int tms_cutime;
+        int tms_cstime;
 };
 
 struct utsname {
-	char machine[20];
-	char nodename[256];
-	char release[20];
-	char sysname[20];
-	char version[20];
+        char machine[20];
+        char nodename[256];
+        char release[20];
+        char sysname[20];
+        char version[20];
 };
 
 char *ctermid (char *s);
@@ -257,6 +265,7 @@
 uid_t getuid (void);
 int setenv (const char *name, const char *value, int overwrite);
 int setgid (gid_t gid);
+int setgroups (size_t size, gid_t *list);
 int setpgid (pid_t pid, pid_t pgid);
 pid_t setsid (void);
 int setuid (uid_t uid);
@@ -269,8 +278,8 @@
 /*                   Posix.Process                   */
 /* ------------------------------------------------- */
 
-#define EXECVE(path, args, env) 	\
-	execve (path, (const char* const*)args, (const char* const*)env)
+#define EXECVE(path, args, env)         \
+        execve (path, (const char* const*)args, (const char* const*)env)
 #define EXECVP(file, args)  execvp (file, (const char* const*) args)
 #define SPAWN_MODE _P_NOWAIT
 
@@ -296,6 +305,11 @@
 pid_t fork (void);
 int kill (pid_t pid, int sig);
 int pause (void);
+struct timespec {
+ time_t tv_sec;
+ long tv_nsec;
+};
+int nanosleep (const struct timespec *req, struct timespec *rem);
 unsigned int sleep (unsigned int seconds);
 pid_t wait (int *status);
 pid_t waitpid (pid_t pid, int *status, int options);
@@ -322,24 +336,24 @@
 #define SIGCONT 25
 #define SIGUSR1 25
 #define SIGUSR2 26
-#define SIGVTALRM 26	/* virtual time alarm */
-#define SIGPROF 27	/* profiling time alarm */
+#define SIGVTALRM 26    /* virtual time alarm */
+#define SIGPROF 27      /* profiling time alarm */
 
 #define _NSIG 32
 
 typedef void (*_sig_func_ptr)();
 
 struct sigaction {
-	int		sa_flags;
-	sigset_t	sa_mask;
-	_sig_func_ptr	sa_handler;
+        int             sa_flags;
+        sigset_t        sa_mask;
+        _sig_func_ptr   sa_handler;
 };
 
-#define SIGTOMASK(sn)	(1 << ((sn)-1))
+#define SIGTOMASK(sn)   (1 << ((sn)-1))
 
 int sigaction (int signum, 
-			const struct sigaction *act, 
-			struct sigaction *oldact);
+                        const struct sigaction *act, 
+                        struct sigaction *oldact);
 int sigaddset (sigset_t *set, int signum);
 int sigdelset (sigset_t *set, int signum);
 int sigemptyset (sigset_t *set);
@@ -354,18 +368,18 @@
 /* ------------------------------------------------- */
 
 struct group {
- 	gid_t   gr_gid;
-	char    **gr_mem;
- 	char    *gr_name;
-	char    *gr_passwd;
+        gid_t   gr_gid;
+        char    **gr_mem;
+        char    *gr_name;
+        char    *gr_passwd;
 };
 
 struct passwd {
-	char    *pw_dir;
-	gid_t   pw_gid;
-	char    *pw_name;
-	char    *pw_shell;
-	uid_t   pw_uid;
+        char    *pw_dir;
+        gid_t   pw_gid;
+        char    *pw_name;
+        char    *pw_shell;
+        uid_t   pw_uid;
 };
 
 struct group *getgrgid (gid_t gid);
@@ -472,16 +486,16 @@
 #define TCSADRAIN       3
 #define TCSADFLUSH      4
 
-typedef unsigned char	cc_t;
-typedef unsigned int	speed_t;
-typedef unsigned int	tcflag_t;
+typedef unsigned char   cc_t;
+typedef unsigned int    speed_t;
+typedef unsigned int    tcflag_t;
 
 struct termios {
-	cc_t c_cc[NCCS];
-	tcflag_t c_cflag;
-	tcflag_t c_iflag;
-	tcflag_t c_lflag;
-	tcflag_t c_oflag;
+        cc_t c_cc[NCCS];
+        tcflag_t c_cflag;
+        tcflag_t c_iflag;
+        tcflag_t c_lflag;
+        tcflag_t c_oflag;
 };
 
 speed_t cfgetispeed (struct termios *termios_p);
@@ -502,13 +516,13 @@
 /* ------------------------------------------------- */
 
 #define MSG_DONTWAIT 0
-#define UNIX_PATH_MAX	108
+#define UNIX_PATH_MAX   108
 
-typedef unsigned short	sa_family_t;
+typedef unsigned short  sa_family_t;
 
 struct sockaddr_un {
-	sa_family_t sun_family;
-	char sun_path[UNIX_PATH_MAX];
+        sa_family_t sun_family;
+        char sun_path[UNIX_PATH_MAX];
 };
 
 int ioctl (int d, int request, ...);

Modified: mlton/branches/on-20050420-cmm-branch/runtime/platform/mkdir2.c
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/platform/mkdir2.c	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/platform/mkdir2.c	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,3 @@
 int mkdir2 (const char *pathname, mode_t mode) {
-	return mkdir (pathname, mode);
+        return mkdir (pathname, mode);
 }

Modified: mlton/branches/on-20050420-cmm-branch/runtime/platform/mmap.c
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/platform/mmap.c	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/platform/mmap.c	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,16 +1,16 @@
 static inline void *mmapAnonMmap (void *start, size_t length) {
-	return mmap (start, length, PROT_READ | PROT_WRITE, 
-			MAP_PRIVATE | MAP_ANON, -1, 0);
+        return mmap (start, length, PROT_READ | PROT_WRITE, 
+                        MAP_PRIVATE | MAP_ANON, -1, 0);
 }
 
 static void smunmap (void *base, size_t length) {
-	if (DEBUG_MEM)
-		fprintf (stderr, "smunmap (0x%08x, %s)\n",
-				(uint)base,
-				uintToCommaString (length));
-	assert (base != NULL);
-	if (0 == length)
-		return;
-	if (0 != munmap (base, length))
-		diee ("munmap failed");
+        if (DEBUG_MEM)
+                fprintf (stderr, "smunmap (0x%08x, %s)\n",
+                                (uint)base,
+                                uintToCommaString (length));
+        assert (base != NULL);
+        if (0 == length)
+                return;
+        if (0 != munmap (base, length))
+                diee ("munmap failed");
 }

Modified: mlton/branches/on-20050420-cmm-branch/runtime/platform/netbsd.c
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/platform/netbsd.c	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/platform/netbsd.c	2006-02-16 19:34:54 UTC (rev 4361)
@@ -9,10 +9,10 @@
 #include "use-mmap.c"
 
 static void catcher (int sig, int code, struct sigcontext *ucp) {
-	GC_catcher ((pointer) ucp->sc_eip);
+        GC_handleSigProf ((pointer) ucp->sc_eip);
 }
 
 void setSigProfHandler (struct sigaction *sa) {
-	sa.sa_flags = SA_ONSTACK | SA_RESTART;
-	sa.sa_handler = (void (*)(int))catcher;
+        sa->sa_flags = SA_ONSTACK | SA_RESTART;
+        sa->sa_handler = (void (*)(int))catcher;
 }

Modified: mlton/branches/on-20050420-cmm-branch/runtime/platform/netbsd.h
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/platform/netbsd.h	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/platform/netbsd.h	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,3 +1,5 @@
+#include <stdint.h>
+
 #include <grp.h>
 #include <netdb.h>
 #include <netinet/in.h>
@@ -18,11 +20,13 @@
 #include <syslog.h>
 #include <termios.h>
 
+#define HAS_FEROUND FALSE
+#define HAS_FPCLASSIFY TRUE
 #define HAS_PTRACE FALSE
 #define HAS_REMAP FALSE
 #define HAS_SIGALTSTACK TRUE
+#define HAS_SIGNBIT TRUE
 #define HAS_SPAWN FALSE
 #define HAS_TIME_PROFILING TRUE
-#define HAS_WEAK 1
 
 #define MLton_Platform_OS_host "netbsd"

Modified: mlton/branches/on-20050420-cmm-branch/runtime/platform/openbsd.c
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/platform/openbsd.c	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/platform/openbsd.c	2006-02-16 19:34:54 UTC (rev 4361)
@@ -4,15 +4,16 @@
 #include "getText.c"
 #include "mkdir2.c"
 #include "showMem.linux.c"
+#include "signbit.c"
 #include "ssmmap.c"
 #include "totalRam.sysctl.c"
 #include "use-mmap.c"
 
 static void catcher (int sig, siginfo_t *sip, ucontext_t *ucp) {
-	GC_handleSigProf ((pointer) ucp->sc_eip);
+        GC_handleSigProf ((pointer) ucp->sc_eip);
 }
 
 void setSigProfHandler (struct sigaction *sa) {
-	sa->sa_flags = SA_ONSTACK | SA_RESTART | SA_SIGINFO;
-	sa->sa_sigaction = (void (*)(int, siginfo_t*, void*))catcher;
+        sa->sa_flags = SA_ONSTACK | SA_RESTART | SA_SIGINFO;
+        sa->sa_sigaction = (void (*)(int, siginfo_t*, void*))catcher;
 }

Modified: mlton/branches/on-20050420-cmm-branch/runtime/platform/openbsd.h
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/platform/openbsd.h	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/platform/openbsd.h	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,4 +1,5 @@
 #include <grp.h>
+#include <inttypes.h>
 #include <netdb.h>
 #include <netinet/in.h>
 #include <netinet/tcp.h>
@@ -18,11 +19,18 @@
 #include <syslog.h>
 #include <termios.h>
 
+#define HAS_FEROUND FALSE
+#define HAS_FPCLASSIFY FALSE
 #define HAS_PTRACE FALSE
 #define HAS_REMAP FALSE
 #define HAS_SIGALTSTACK TRUE
+#define HAS_SIGNBIT FALSE
 #define HAS_SPAWN FALSE
 #define HAS_TIME_PROFILING TRUE
-#define HAS_WEAK 1
 
 #define MLton_Platform_OS_host "openbsd"
+
+int fpclassify32 (float f);
+int fpclassify64 (double d);
+int signbit32 (float f);
+int signbit64 (double f);

Modified: mlton/branches/on-20050420-cmm-branch/runtime/platform/release.virtual.c
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/platform/release.virtual.c	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/platform/release.virtual.c	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,4 +1,4 @@
 static inline void releaseVirtual (void *base) {
-	if (0 == VirtualFree (base, 0, MEM_RELEASE))
-		die ("VirtualFree release failed");
+        if (0 == VirtualFree (base, 0, MEM_RELEASE))
+                die ("VirtualFree release failed");
 }

Modified: mlton/branches/on-20050420-cmm-branch/runtime/platform/showMem.linux.c
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/platform/showMem.linux.c	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/platform/showMem.linux.c	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,6 +1,6 @@
 void showMem () {
-	static char buffer[256];
+        static char buffer[256];
 
-	sprintf (buffer, "/bin/cat /proc/%d/maps\n", (int)(getpid ()));
-	system (buffer);
+        sprintf (buffer, "/bin/cat /proc/%d/maps\n", (int)(getpid ()));
+        system (buffer);
 }

Copied: mlton/branches/on-20050420-cmm-branch/runtime/platform/signbit.c (from rev 4358, mlton/trunk/runtime/platform/signbit.c)

Modified: mlton/branches/on-20050420-cmm-branch/runtime/platform/solaris.c
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/platform/solaris.c	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/platform/solaris.c	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,52 +1,103 @@
 #include "platform.h"
 
+#include <ieeefp.h>
+
 #include "getrusage.c"
 #include "getText.c"
 #include "mkdir2.c"
 #include "mmap.c"
+#include "signbit.c"
 #include "ssmmap.c"
 #include "totalRam.sysconf.c"
 
 static void catcher (int sig, siginfo_t *sip, ucontext_t *ucp) {
-	GC_handleSigProf ((pointer) ucp->uc_mcontext.gregs[REG_PC]);
+        GC_handleSigProf ((pointer) ucp->uc_mcontext.gregs[REG_PC]);
 }
 
 void setSigProfHandler (struct sigaction *sa) {
-	sa->sa_flags = SA_ONSTACK | SA_RESTART | SA_SIGINFO;
-	sa->sa_sigaction = (void (*)(int, siginfo_t*, void*))catcher;
+        sa->sa_flags = SA_ONSTACK | SA_RESTART | SA_SIGINFO;
+        sa->sa_sigaction = (void (*)(int, siginfo_t*, void*))catcher;
 }
 
-
 void decommit (void *base, size_t length) {
-	smunmap (base, length);
+        smunmap (base, length);
 }
 
-/* On Solaris 5.7, MAP_ANON causes EINVAL and mmap requires a file descriptor. */
+int fegetround () {
+        int mode;
+
+        mode = fpgetround ();
+        switch (mode) {
+        case FP_RN: mode = 0; break;
+        case FP_RM: mode = 1; break;
+        case FP_RP: mode = 2; break;
+        case FP_RZ: mode = 3; break;
+        }
+        return mode;
+}
+
+void fesetround (int mode) {
+        switch (mode) {
+        case 0: mode = FP_RN; break;
+        case 1: mode = FP_RM; break;
+        case 2: mode = FP_RP; break;
+        case 3: mode = FP_RZ; break;
+        }
+        fpsetround (mode);
+}
+
+int fpclassify64 (double d) {
+        fpclass_t c;
+
+        c = fpclass (d);
+        switch (c) {
+        case FP_SNAN:
+        case FP_QNAN: 
+                return FP_NAN;
+        case FP_NINF:
+        case FP_PINF:
+                return FP_INFINITE;
+        case FP_NDENORM:
+        case FP_PDENORM:
+                return FP_SUBNORMAL;
+        case FP_NZERO:
+        case FP_PZERO:
+                return FP_ZERO;
+        case FP_NNORM:
+        case FP_PNORM:
+                return FP_NORMAL;
+        default:
+                die ("Real_class error: invalid class %d\n", c);
+        }
+}
+ 
+/* On Solaris 5.7, MAP_ANON causes EINVAL and mmap requires a file descriptor.
+ */
 void *mmapAnon (void *start, size_t length) {
-	static int fd = -1;
+        static int fd = -1;
 
-	if (-1 == fd)
-		fd = open ("/dev/zero", O_RDONLY);
-	return mmap (start, length, PROT_READ | PROT_WRITE, MAP_PRIVATE, fd, 0);
+        if (-1 == fd)
+                fd = open ("/dev/zero", O_RDONLY);
+        return mmap (start, length, PROT_READ | PROT_WRITE, MAP_PRIVATE, fd, 0);
 }
 
 void release (void *base, size_t length) {
-	smunmap (base, length);
+        smunmap (base, length);
 }
 
 /* This implementation of setenv has a space leak, but I don't see how to avoid 
  * it, since the specification of putenv is that it uses the memory for its arg.
  */
 int setenv (const char *name, const char *value, int overwrite) {
-	char *b;
+        char *b;
 
-	b = malloc (strlen (name) + strlen (value) + 2 /* = and \000 */);
-	sprintf (b, "%s=%s", name, value);
-	return putenv (b);
+        b = malloc (strlen (name) + strlen (value) + 2 /* = and \000 */);
+        sprintf (b, "%s=%s", name, value);
+        return putenv (b);
 }
 
 void showMem () {
-	static char buffer[256];
-	sprintf (buffer, "pmap %d\n", (int)(getpid ()));
-	system (buffer);
+        static char buffer[256];
+        sprintf (buffer, "pmap %d\n", (int)(getpid ()));
+        system (buffer);
 }

Modified: mlton/branches/on-20050420-cmm-branch/runtime/platform/solaris.h
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/platform/solaris.h	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/platform/solaris.h	2006-02-16 19:34:54 UTC (rev 4361)
@@ -23,14 +23,31 @@
 
 #include "setenv.h"
 
+#define FE_TONEAREST 0
+#define FE_DOWNWARD 1
+#define FE_UPWARD 2
+#define FE_TOWARDZERO 3
+int fegetround ();
+void fesetround (int mode);
+int fpclassify64 (double d);
+
+#define HAS_FEROUND TRUE
+#define HAS_FPCLASSIFY FALSE
+#define HAS_FPCLASSIFY64 TRUE
 #define HAS_PTRACE TRUE
 #define HAS_REMAP FALSE
 #define HAS_SIGALTSTACK TRUE
+#define HAS_SIGNBIT FALSE
 #define HAS_SPAWN FALSE
 #define HAS_TIME_PROFILING TRUE
-#define HAS_WEAK 1
 
 #define MLton_Platform_OS_host "solaris"
 
 #define LOG_AUTHPRIV LOG_AUTH
 #define LOG_PERROR 0
+
+int fpclassify32 (float f);
+int fpclassify64 (double d);
+int signbit32 (float f);
+int signbit64 (double f);
+

Modified: mlton/branches/on-20050420-cmm-branch/runtime/platform/ssmmap.c
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/platform/ssmmap.c	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/platform/ssmmap.c	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,15 +1,15 @@
 void *ssmmap (size_t length, size_t dead_low, size_t dead_high) {
-	void *base,*low,*result,*high;
+        void *base,*low,*result,*high;
 
-	base = smmap (length + dead_low + dead_high);
-	low = base;
-	if (mprotect (low, dead_low, PROT_NONE))
-		diee ("mprotect failed");
-	result = low + dead_low;
-	if (mprotect (result, length, PROT_READ | PROT_WRITE | PROT_EXEC))
-		diee ("mprotect failed");
-	high = result + length;
-	if (mprotect (high, dead_high, PROT_NONE))
-		diee ("mprotect failed");
-	return result;
+        base = smmap (length + dead_low + dead_high);
+        low = base;
+        if (mprotect (low, dead_low, PROT_NONE))
+                diee ("mprotect failed");
+        result = low + dead_low;
+        if (mprotect (result, length, PROT_READ | PROT_WRITE | PROT_EXEC))
+                diee ("mprotect failed");
+        high = result + length;
+        if (mprotect (high, dead_high, PROT_NONE))
+                diee ("mprotect failed");
+        return result;
 }

Modified: mlton/branches/on-20050420-cmm-branch/runtime/platform/totalRam.sysconf.c
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/platform/totalRam.sysconf.c	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/platform/totalRam.sysconf.c	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,8 +1,8 @@
 W32 totalRam (GC_state s) {
-	W32 maxMem;
-	W64 tmp;
+        W32 maxMem;
+        W64 tmp;
 
-	maxMem = 0x100000000llu - s->pageSize;
-	tmp = sysconf (_SC_PHYS_PAGES) * (W64)s->pageSize;
-	return (tmp >= maxMem) ? maxMem: (W32)tmp;
+        maxMem = 0x100000000llu - s->pageSize;
+        tmp = sysconf (_SC_PHYS_PAGES) * (W64)s->pageSize;
+        return (tmp >= maxMem) ? maxMem: (W32)tmp;
 }

Modified: mlton/branches/on-20050420-cmm-branch/runtime/platform/totalRam.sysctl.c
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/platform/totalRam.sysctl.c	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/platform/totalRam.sysctl.c	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,11 +1,11 @@
 W32 totalRam (GC_state s) {
-	uint mem;
-	int len, mib[2];
-	
-	mib[0] = CTL_HW;
-	mib[1] = HW_PHYSMEM;
-	len = sizeof(mem);
-	if (-1 == sysctl (mib, 2, &mem, &len, NULL, 0))
-		diee ("sysctl failed");
- 	return mem;
+        uint mem;
+        int len, mib[2];
+        
+        mib[0] = CTL_HW;
+        mib[1] = HW_PHYSMEM;
+        len = sizeof(mem);
+        if (-1 == sysctl (mib, 2, &mem, &len, NULL, 0))
+                diee ("sysctl failed");
+        return mem;
 }

Modified: mlton/branches/on-20050420-cmm-branch/runtime/platform/use-mmap.c
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/platform/use-mmap.c	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/platform/use-mmap.c	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,13 +1,13 @@
 #include "mmap.c"
 
 void decommit (void *base, size_t length) {
-	smunmap (base, length);
+        smunmap (base, length);
 }
 
 void release (void *base, size_t length) {
-	smunmap (base, length);
+        smunmap (base, length);
 }
 
 void *mmapAnon (void *start, size_t length) {
-	return mmapAnonMmap (start, length);
+        return mmapAnonMmap (start, length);
 }

Modified: mlton/branches/on-20050420-cmm-branch/runtime/platform/windows.c
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/platform/windows.c	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/platform/windows.c	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,193 +1,196 @@
 HANDLE fileDesHandle (int fd);
 
 static void showMaps () {
-	MEMORY_BASIC_INFORMATION buf;
-	LPCVOID lpAddress;
-	char *state = "<unset>";
-	char *protect = "<unset>";
+        MEMORY_BASIC_INFORMATION buf;
+        LPCVOID lpAddress;
+        char *state = "<unset>";
+        char *protect = "<unset>";
 
-	for (lpAddress = 0; lpAddress < (LPCVOID)0x80000000; ) {
-		VirtualQuery (lpAddress, &buf, sizeof (buf));
+        for (lpAddress = 0; lpAddress < (LPCVOID)0x80000000; ) {
+                VirtualQuery (lpAddress, &buf, sizeof (buf));
 
-		switch (buf.Protect) {
-		case PAGE_READONLY:
-			protect = "PAGE_READONLY";
-			break;
-		case PAGE_READWRITE:
-			protect = "PAGE_READWRITE";
-			break;
-		case PAGE_WRITECOPY:
-			protect = "PAGE_WRITECOPY";
-			break;
-		case PAGE_EXECUTE:
-			protect = "PAGE_EXECUTE";
-			break;
-		case PAGE_EXECUTE_READ:
-			protect = "PAGE_EXECUTE_READ";
-			break;
-		case PAGE_EXECUTE_READWRITE:
-			protect = "PAGE_EXECUTE_READWRITE";
-			break;
-		case PAGE_EXECUTE_WRITECOPY:
-			protect = "PAGE_EXECUTE_WRITECOPY";
-			break;
-		case PAGE_GUARD:
-			protect = "PAGE_GUARD";
-			break;
-		case PAGE_NOACCESS:
-			protect = "PAGE_NOACCESS";
-			break;
-		case PAGE_NOCACHE:
-			protect = "PAGE_NOCACHE";
-			break;
-		}
-		switch (buf.State) {
-		case MEM_COMMIT:
-			state = "MEM_COMMIT";
-			break;
-		case MEM_FREE:
-			state = "MEM_FREE";
-			break;
-		case MEM_RESERVE:
-			state = "MEM_RESERVE";
-			break;
-		}
-		fprintf(stderr, "0x%8x %10u  %s %s\n",
-			(uint)buf.BaseAddress,
-			(uint)buf.RegionSize,
-			state, protect);
-		lpAddress += buf.RegionSize;
-	}
+                switch (buf.Protect) {
+                case PAGE_READONLY:
+                        protect = "PAGE_READONLY";
+                        break;
+                case PAGE_READWRITE:
+                        protect = "PAGE_READWRITE";
+                        break;
+                case PAGE_WRITECOPY:
+                        protect = "PAGE_WRITECOPY";
+                        break;
+                case PAGE_EXECUTE:
+                        protect = "PAGE_EXECUTE";
+                        break;
+                case PAGE_EXECUTE_READ:
+                        protect = "PAGE_EXECUTE_READ";
+                        break;
+                case PAGE_EXECUTE_READWRITE:
+                        protect = "PAGE_EXECUTE_READWRITE";
+                        break;
+                case PAGE_EXECUTE_WRITECOPY:
+                        protect = "PAGE_EXECUTE_WRITECOPY";
+                        break;
+                case PAGE_GUARD:
+                        protect = "PAGE_GUARD";
+                        break;
+                case PAGE_NOACCESS:
+                        protect = "PAGE_NOACCESS";
+                        break;
+                case PAGE_NOCACHE:
+                        protect = "PAGE_NOCACHE";
+                        break;
+                }
+                switch (buf.State) {
+                case MEM_COMMIT:
+                        state = "MEM_COMMIT";
+                        break;
+                case MEM_FREE:
+                        state = "MEM_FREE";
+                        break;
+                case MEM_RESERVE:
+                        state = "MEM_RESERVE";
+                        break;
+                }
+                fprintf(stderr, "0x%8x %10u  %s %s\n",
+                        (uint)buf.BaseAddress,
+                        (uint)buf.RegionSize,
+                        state, protect);
+                lpAddress += buf.RegionSize;
+        }
 }
 
 void showMem () {
-	MEMORYSTATUS ms; 
+        MEMORYSTATUS ms; 
 
-	ms.dwLength = sizeof (MEMORYSTATUS); 
-	GlobalMemoryStatus (&ms); 
-	fprintf(stderr, "Total Phys. Mem: %ld\nAvail Phys. Mem: %ld\nTotal Page File: %ld\nAvail Page File: %ld\nTotal Virtual: %ld\nAvail Virtual: %ld\n",
-			 ms.dwTotalPhys, 
-			 ms.dwAvailPhys, 
-			 ms.dwTotalPageFile, 
-			 ms.dwAvailPageFile, 
-			 ms.dwTotalVirtual, 
-			 ms.dwAvailVirtual); 
-	showMaps ();
+        ms.dwLength = sizeof (MEMORYSTATUS); 
+        GlobalMemoryStatus (&ms); 
+        fprintf(stderr, "Total Phys. Mem: %ld\nAvail Phys. Mem: %ld\nTotal Page File: %ld\nAvail Page File: %ld\nTotal Virtual: %ld\nAvail Virtual: %ld\n",
+                         ms.dwTotalPhys, 
+                         ms.dwAvailPhys, 
+                         ms.dwTotalPageFile, 
+                         ms.dwAvailPageFile, 
+                         ms.dwTotalVirtual, 
+                         ms.dwAvailVirtual); 
+        showMaps ();
 }
 
 static HANDLE dupHandle (int fd) {
-	HANDLE dupd;
-	HANDLE raw;
+        HANDLE dupd;
+        HANDLE raw;
 
-	raw = fileDesHandle (fd);
-	if (raw == (HANDLE)-1 or raw == 0) {
-		errno = EBADF;
-		return 0;
-	}
-	/* 'Inspired' by http://msdn.microsoft.com/library/default.asp?url=/library/en-us/dllproc/base/creating_a_child_process_with_redirected_input_and_output.asp
-	 * It's interesting that you can open files for/from other processes...
-	 */
-	unless (DuplicateHandle (
-	 GetCurrentProcess(),	/* source process */
-	 raw,			/* source handle */
-	 GetCurrentProcess(),	/* target process */
-	 &dupd,			/* target handle - valid in target proc */
-	 0,			/* ignored b/c DUPLICATE_SAME_ACCESS used */
-	 TRUE,			/* this can be inherited by children */
-	 DUPLICATE_SAME_ACCESS))/* keep the same permissions */
-	{
-		errno = ENOMEM;
-		return 0;
-	}
-	return dupd;
+        raw = fileDesHandle (fd);
+        if (raw == (HANDLE)-1 or raw == 0) {
+                errno = EBADF;
+                return 0;
+        }
+        /* 'Inspired' by http://msdn.microsoft.com/library/default.asp?url=/library/en-us/dllproc/base/creating_a_child_process_with_redirected_input_and_output.asp
+         * It's interesting that you can open files for/from other processes...
+         */
+        unless (DuplicateHandle (
+         GetCurrentProcess(),   /* source process */
+         raw,                   /* source handle */
+         GetCurrentProcess(),   /* target process */
+         &dupd,                 /* target handle - valid in target proc */
+         0,                     /* ignored b/c DUPLICATE_SAME_ACCESS used */
+         TRUE,                  /* this can be inherited by children */
+         DUPLICATE_SAME_ACCESS))/* keep the same permissions */
+        {
+                errno = ENOMEM;
+                return 0;
+        }
+        return dupd;
 }
 
 static inline void Windows_decommit (void *base, size_t length) {
-	if (0 == VirtualFree (base, length, MEM_DECOMMIT))
-		die ("VirtualFree decommit failed");
+        if (0 == VirtualFree (base, length, MEM_DECOMMIT))
+                die ("VirtualFree decommit failed");
 }
 
 static inline void *Windows_mmapAnon (void *start, size_t length) {
-	void *res;
+        void *res;
 
-	res = VirtualAlloc ((LPVOID)start, length, MEM_COMMIT, PAGE_READWRITE);
-	if (NULL == res)
-		res = (void*)-1;
-	return res;
+        /* Use "0" instead of "start" as the first argument to VirtualAlloc
+         * because it is more stable on MinGW (at least).
+         */
+        res = VirtualAlloc ((LPVOID)0/*start*/, length, MEM_COMMIT, PAGE_READWRITE);
+        if (NULL == res)
+                res = (void*)-1;
+        return res;
 }
 
 static inline void Windows_release (void *base) {
-	if (0 == VirtualFree (base, 0, MEM_RELEASE))
-		die ("VirtualFree release failed");
+        if (0 == VirtualFree (base, 0, MEM_RELEASE))
+                die ("VirtualFree release failed");
 }
 
 Pid Windows_Process_create (NullString cmds, NullString args, NullString envs,
-				Fd in, Fd out, Fd err) {
-	char	*cmd;
-	char	*arg;
-	char	*env;
-	int	result;
-	STARTUPINFO si;
-	PROCESS_INFORMATION proc;
-	
-	cmd = (char*)cmds;
-	arg = (char*)args;
-	env = (char*)envs;
-	memset (&proc, 0, sizeof (proc));
-	memset (&si, 0, sizeof (si));
-	si.cb = sizeof(si);
-	si.hStdInput = dupHandle (in);
-	si.hStdOutput = dupHandle (out);
-	si.hStdError = dupHandle (err);
-	si.dwFlags = STARTF_USESTDHANDLES; /* use the above */
-	if (!si.hStdInput or !si.hStdOutput or !si.hStdError) {
-		if (si.hStdInput) CloseHandle (si.hStdInput);
-		if (si.hStdOutput) CloseHandle (si.hStdOutput);
-		if (si.hStdError) CloseHandle (si.hStdError);
-		/* errno already faked by create_dup_handle */
-		return -1;
-	}
-	result = CreateProcess (
-		 cmd,		/* The executable as a windows path */
-		 arg,		/* Command-line as a string */
-		 0,		/* Process inherits security params */
-		 0,		/* Initial thread inherits security params */
-		 TRUE,		/* Inherit HANDLEs set as inherit */
-		 0,		/* Normal priority + no special flags */
-		 env,	 	/* Environment as a string {n=v\0}\0 */
-		 0,		/* Current directory = parent's */
-		 &si,		/* Start info from above */
-		 &proc);	/* returned handle */
-	if (0 == result) {
-		errno = ENOENT; /* probably does not exist (aka ENOFILE)*/
-		result = -1;
-	} else {
-		/* Process created successfully */
-		/* We will return the process handle for the 'pid'.
-		 * This way we can TerminateProcess (kill) it and
-		 * _cwait (waitpid) for it.
-		 * The thread handle is not needed, so clean it.
-		 */
-		CloseHandle (proc.hThread);
-		result = (int)proc.hProcess;
-	}
-	CloseHandle (si.hStdInput);
-	CloseHandle (si.hStdOutput);
-	CloseHandle (si.hStdError);
-	return result;
+                                Fd in, Fd out, Fd err) {
+        char    *cmd;
+        char    *arg;
+        char    *env;
+        int     result;
+        STARTUPINFO si;
+        PROCESS_INFORMATION proc;
+        
+        cmd = (char*)cmds;
+        arg = (char*)args;
+        env = (char*)envs;
+        memset (&proc, 0, sizeof (proc));
+        memset (&si, 0, sizeof (si));
+        si.cb = sizeof(si);
+        si.hStdInput = dupHandle (in);
+        si.hStdOutput = dupHandle (out);
+        si.hStdError = dupHandle (err);
+        si.dwFlags = STARTF_USESTDHANDLES; /* use the above */
+        if (!si.hStdInput or !si.hStdOutput or !si.hStdError) {
+                if (si.hStdInput) CloseHandle (si.hStdInput);
+                if (si.hStdOutput) CloseHandle (si.hStdOutput);
+                if (si.hStdError) CloseHandle (si.hStdError);
+                /* errno already faked by create_dup_handle */
+                return -1;
+        }
+        result = CreateProcess (
+                 cmd,           /* The executable as a windows path */
+                 arg,           /* Command-line as a string */
+                 0,             /* Process inherits security params */
+                 0,             /* Initial thread inherits security params */
+                 TRUE,          /* Inherit HANDLEs set as inherit */
+                 0,             /* Normal priority + no special flags */
+                 env,           /* Environment as a string {n=v\0}\0 */
+                 0,             /* Current directory = parent's */
+                 &si,           /* Start info from above */
+                 &proc);        /* returned handle */
+        if (0 == result) {
+                errno = ENOENT; /* probably does not exist (aka ENOFILE)*/
+                result = -1;
+        } else {
+                /* Process created successfully */
+                /* We will return the process handle for the 'pid'.
+                 * This way we can TerminateProcess (kill) it and
+                 * _cwait (waitpid) for it.
+                 * The thread handle is not needed, so clean it.
+                 */
+                CloseHandle (proc.hThread);
+                result = (int)proc.hProcess;
+        }
+        CloseHandle (si.hStdInput);
+        CloseHandle (si.hStdOutput);
+        CloseHandle (si.hStdError);
+        return result;
 }
 
 Int Windows_Process_terminate (Pid pid, Int sig) {
-	HANDLE h;
-	
-	h = (HANDLE)pid;
-	/* We terminate with 'sig' for the _return_ code + 0x80
-	 * Then in the basis library I test for this to decide W_SIGNALED.
-	 * Perhaps not the best choice, but I have no better idea.
-	 */
+        HANDLE h;
+        
+        h = (HANDLE)pid;
+        /* We terminate with 'sig' for the _return_ code + 0x80
+         * Then in the basis library I test for this to decide W_SIGNALED.
+         * Perhaps not the best choice, but I have no better idea.
+         */
         unless (TerminateProcess (h, sig | 0x80)) {
-		errno = ECHILD;
-		return -1;
-	}
-	return 0;
+                errno = ECHILD;
+                return -1;
+        }
+        return 0;
 }

Modified: mlton/branches/on-20050420-cmm-branch/runtime/platform.c
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/platform.c	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/platform.c	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,200 +1,200 @@
-/* Copyright (C) 2004 Henry Cejtin, Matthew Fluet, Suresh
+/* Copyright (C) 2004-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  */
 
 #include "platform.h"
 
 void die (char *fmt, ...) {
-	va_list	args;
+        va_list args;
 
-	fflush(stdout);
-	va_start(args, fmt);
-	vfprintf(stderr, fmt, args);
-	va_end(args);
-	fprintf(stderr, "\n");
-	exit(1);
+        fflush(stdout);
+        va_start(args, fmt);
+        vfprintf(stderr, fmt, args);
+        va_end(args);
+        fprintf(stderr, "\n");
+        exit(1);
 }
 
 void diee (char * fmt, ...) {
-	va_list	args;
+        va_list args;
 
-	fflush(stdout);
-	va_start(args, fmt);
-	vfprintf(stderr, fmt, args);
-	va_end(args);
-	
-	fprintf(stderr, " (%s)\n", strerror(errno));
-	exit(1);
+        fflush(stdout);
+        va_start(args, fmt);
+        vfprintf(stderr, fmt, args);
+        va_end(args);
+        
+        fprintf(stderr, " (%s)\n", strerror(errno));
+        exit(1);
 }
 
 void asfail(char *file, int line, char *prop) {
-	fflush(stdout);
-	fprintf(stderr, "%s:%d: assert(%s) failed.\n", file, line, prop);
-	abort();
+        fflush(stdout);
+        fprintf(stderr, "%s:%d: assert(%s) failed.\n", file, line, prop);
+        abort();
 }
 
 string boolToString (bool b) {
-	return b ? "TRUE" : "FALSE";
+        return b ? "TRUE" : "FALSE";
 }
 
 #define BUF_SIZE 81
 string intToCommaString (int n) {
-	static char buf[BUF_SIZE];
-	int i;
-	
-	i = BUF_SIZE - 1;
-	buf[i--] = '\000';
-	
-	if (0 == n)
-		buf[i--] = '0';
- 	else if (INT_MIN == n) {
-		/* must treat INT_MIN specially, because I negate stuff later */
-		strcpy (buf + 1, "-2,147,483,648");
-		i = 0;
-	} else {
-		int m;
-	
- 		if (n > 0) m = n; else m = -n;
-	
-		while (m > 0) {
- 			buf[i--] = m % 10 + '0';
-			m = m / 10;
- 			if (i % 4 == 0 and m > 0) buf[i--] = ',';
- 		}
- 		if (n < 0) buf[i--] = '-';
- 	}
- 	return buf + i + 1;
+        static char buf[BUF_SIZE];
+        int i;
+        
+        i = BUF_SIZE - 1;
+        buf[i--] = '\000';
+        
+        if (0 == n)
+                buf[i--] = '0';
+        else if (INT_MIN == n) {
+                /* must treat INT_MIN specially, because I negate stuff later */
+                strcpy (buf + 1, "-2,147,483,648");
+                i = 0;
+        } else {
+                int m;
+        
+                if (n > 0) m = n; else m = -n;
+        
+                while (m > 0) {
+                        buf[i--] = m % 10 + '0';
+                        m = m / 10;
+                        if (i % 4 == 0 and m > 0) buf[i--] = ',';
+                }
+                if (n < 0) buf[i--] = '-';
+        }
+        return buf + i + 1;
 }
 
 void *scalloc (size_t nmemb, size_t size) {
-	void *res;
+        void *res;
 
-	res = calloc (nmemb, size);
-	if (NULL == res)
-		die ("calloc (%s, %s) failed.\n", 
-			uintToCommaString (nmemb),
-			uintToCommaString (size));
-	return res;
+        res = calloc (nmemb, size);
+        if (NULL == res)
+                die ("calloc (%s, %s) failed.\n", 
+                        uintToCommaString (nmemb),
+                        uintToCommaString (size));
+        return res;
 }
 
 void sclose (int fd) {
-	unless (0 == close (fd)) 
-		diee ("unable to close %d", fd);
+        unless (0 == close (fd)) 
+                diee ("unable to close %d", fd);
 }
 
 void sfclose (FILE *file) {
-	unless (0 == fclose (file))
-		diee ("unable to close file");
+        unless (0 == fclose (file))
+                diee ("unable to close file");
 }
 
 FILE *sfopen (char *fileName, char *mode) {
-	FILE *file;
-	
-	if (NULL == (file = fopen ((char*)fileName, mode)))
-		diee ("sfopen unable to open file %s", fileName);
-	return file;
+        FILE *file;
+        
+        if (NULL == (file = fopen ((char*)fileName, mode)))
+                diee ("sfopen unable to open file %s", fileName);
+        return file;
 }
 
 void sfread (void *ptr, size_t size, size_t nmemb, FILE *file) {
-	size_t bytes;
+        size_t bytes;
 
-	bytes = size * nmemb;
-	if (0 == bytes) return;
-	unless (1 == fread (ptr, bytes, 1, file))
-		diee("sfread failed");
+        bytes = size * nmemb;
+        if (0 == bytes) return;
+        unless (1 == fread (ptr, bytes, 1, file))
+                diee("sfread failed");
 }
 
 uint sfreadUint (FILE *file) {
-	uint n;
+        uint n;
 
-	sfread (&n, sizeof(uint), 1, file);
-	return n;
+        sfread (&n, sizeof(uint), 1, file);
+        return n;
 }
 
 void sfwrite (void *ptr, size_t size, size_t nmemb, FILE *file) {
-	size_t bytes;
+        size_t bytes;
 
-	bytes = size * nmemb;
-	if (0 == bytes) return;
-	unless (1 == fwrite (ptr, size * nmemb, 1, file))
-		diee ("sfwrite failed");
+        bytes = size * nmemb;
+        if (0 == bytes) return;
+        unless (1 == fwrite (ptr, size * nmemb, 1, file))
+                diee ("sfwrite failed");
 }
 
 void *smalloc (size_t length) {
-	void *res;
+        void *res;
 
-	res = malloc (length);
-	if (NULL == res)
-		die ("Unable to malloc %s bytes.\n", uintToCommaString (length));
-	return res;
+        res = malloc (length);
+        if (NULL == res)
+                die ("Unable to malloc %s bytes.\n", uintToCommaString (length));
+        return res;
 }
 
 int smkstemp (char *template) {
-	int fd;
+        int fd;
 
-	fd = mkstemp (template);
-	if (-1 == fd)
-		diee ("unable to make temporary file");
-	return fd;
+        fd = mkstemp (template);
+        if (-1 == fd)
+                diee ("unable to make temporary file");
+        return fd;
 }
 
 void swrite (int fd, const void *buf, size_t count) {
-	if (0 == count) return;
-	unless (count == write (fd, buf, count))
-		diee ("swrite failed");
+        if (0 == count) return;
+        unless (count == write (fd, buf, count))
+                diee ("swrite failed");
 }
 
 void swriteUint (int fd, uint n) {
-	swrite (fd, &n, sizeof(uint));
+        swrite (fd, &n, sizeof(uint));
 }
 
 string uintToCommaString (uint n) {
-	static char buf1[BUF_SIZE];
-	static char buf2[BUF_SIZE];
-	static char buf3[BUF_SIZE];
-	static char buf4[BUF_SIZE];
-	static char buf5[BUF_SIZE];
-	static char *bufs[] = {buf1, buf2, buf3, buf4, buf5};
-	static int bufIndex = 0;
-	static char *buf;
-	int i;
+        static char buf1[BUF_SIZE];
+        static char buf2[BUF_SIZE];
+        static char buf3[BUF_SIZE];
+        static char buf4[BUF_SIZE];
+        static char buf5[BUF_SIZE];
+        static char *bufs[] = {buf1, buf2, buf3, buf4, buf5};
+        static int bufIndex = 0;
+        static char *buf;
+        int i;
 
-	buf = bufs[bufIndex++];
-	bufIndex %= 5;
+        buf = bufs[bufIndex++];
+        bufIndex %= 5;
 
-	i = BUF_SIZE - 1;
-	buf[i--] = '\000';
-	if (0 == n)
-		buf[i--] = '0';
+        i = BUF_SIZE - 1;
+        buf[i--] = '\000';
+        if (0 == n)
+                buf[i--] = '0';
         else {
-		while (n > 0) {
- 			buf[i--] = n % 10 + '0';
-			n = n / 10;
- 			if (i % 4 == 0 and n > 0) buf[i--] = ',';
- 		}
- 	}
- 	return buf + i + 1;
+                while (n > 0) {
+                        buf[i--] = n % 10 + '0';
+                        n = n / 10;
+                        if (i % 4 == 0 and n > 0) buf[i--] = ',';
+                }
+        }
+        return buf + i + 1;
 }
 
 string ullongToCommaString (ullong n) {
-	static char buf[BUF_SIZE];
-	int i;
-	
-	i = BUF_SIZE - 1;
-	buf[i--] = '\000';
-	
-	if (0 == n)
-		buf[i--] = '0';
+        static char buf[BUF_SIZE];
+        int i;
+        
+        i = BUF_SIZE - 1;
+        buf[i--] = '\000';
+        
+        if (0 == n)
+                buf[i--] = '0';
         else {
-		while (n > 0) {
- 			buf[i--] = n % 10 + '0';
-			n = n / 10;
- 			if (i % 4 == 0 and n > 0) buf[i--] = ',';
- 		}
- 	}
- 	return buf + i + 1;
+                while (n > 0) {
+                        buf[i--] = n % 10 + '0';
+                        n = n / 10;
+                        if (i % 4 == 0 and n > 0) buf[i--] = ',';
+                }
+        }
+        return buf + i + 1;
 }
 

Modified: mlton/branches/on-20050420-cmm-branch/runtime/platform.h
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/platform.h	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/platform.h	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,9 +1,9 @@
-/* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
+/* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
+ * Copyright (C) 1997-2000 NEC Research Institute.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  */
 
 #ifndef _PLATFORM_H_
@@ -11,7 +11,13 @@
 
 #define _ISOC99_SOURCE
 #define _BSD_SOURCE
+
+/* Only enable _POSIX_C_SOURCE on platforms that don't have broken system
+ * headers.
+ */
+#if (defined (__linux__))
 #define _POSIX_C_SOURCE 200112L
+#endif
 
 #include <sys/types.h> // lots of includes depend on this
 #include <dirent.h>
@@ -31,20 +37,18 @@
 #include <utime.h>
 
 /* C99-specific headers */
-#include <fenv.h>
-#include <stdint.h>
 #include <inttypes.h>
 
 /* On FreeBSD and OpenBSD the default gmp.h is installed in /usr/include, 
- * but that is version 2.  We want gmp version 4, which the is installed in 
+ * but that is version 2.  We want gmp version 4, which is installed in 
  * /usr/local/include, and is ensured to exist because it is required by the
  * MLton package.
  * On NetBSD, we want gmp to be installed into the pkg tree (which represents
  * the FreeBSD ports tree). For now we use the same method as in the FreeBSD
  * case, but we note that this should be changed so the makefile provides the
  * correct -I flags to the compiler.
- * As far as I can tell, gmp does not come with Mac OS X, so the user will
- * install it himself.
+ * On MacOS X, many users will use fink to install gmp, in which case gmp.h
+ * will be installed in /sw/include.
  */
 #include "gmp.h"
 
@@ -74,18 +78,62 @@
 #error unknown platform
 #endif
 
-#ifndef EXECVP
-#define EXECVP execvp
+#ifndef bool
+#define bool    int                     /* boolean type */
 #endif
+#define uint    unsigned int            /* short names for unsigned types */
+#define ulong   unsigned long
+#define ullong  unsigned long long      /* GCC extension */
+#define llong   long long               /* GCC extension */
+#define uchar   unsigned char
+#define ushort  unsigned short int
+#define not     !                       /* logical negation operator */
+#define and     &&                      /* logical conjunction */
+#define or      ||                      /* logical disjunction */
+#ifndef TRUE
+#define TRUE    (0 == 0)
+#endif
+#ifndef FALSE
+#define FALSE   (not TRUE)
+#endif
+#define loop    while (TRUE)            /* loop until break */
+#define EOS     '\0'                    /* end-of-string char */
+#ifndef NULL
+#define NULL    0                       /* invalid pointer */
+#endif
 
-#ifndef EXECVE
-#define EXECVE execve
+#define NEW(t, x)               x = (t)(smalloc (sizeof(*x)))
+#define ARRAY(t, a, s)  a = (t)(scalloc (s, sizeof(*a)))
+#define ARRAY_UNSAFE(t, a, s)   a = (t)(calloc (s, sizeof(*a)))
+
+#define string char*
+
+#define unless(p)       if (not (p))
+#define until(p)        while (not (p))
+#define cardof(a)       (sizeof(a) / sizeof(*(a)))
+#define endof(a)        ((a) + cardof(a))
+#define bitsof(a)       (sizeof(a) * 8)
+
+#ifndef max
+#define max(a, b) ((a)>(b)?(a):(b))
 #endif
 
+#ifndef min
+#define min(a, b) ((a)<(b)?(a):(b))
+#endif
+
 #ifndef MLton_Platform_OS_host
 #error MLton_Platform_OS_host not defined
 #endif
 
+#ifndef HAS_FPCLASSIFY
+#error HAS_FPCLASSIFY not defined
+#endif
+
+#ifndef HAS_FEROUND
+#error HAS_FEROUND not defined
+#endif
+
 #ifndef HAS_PTRACE
 #error HAS_PTRACE not defined
 #endif
@@ -98,6 +146,10 @@
 #error HAS_SIGALTSTACK not defined
 #endif
 
+#ifndef HAS_SIGNBIT
+#error HAS_SIGNBIT not defined
+#endif
+
 #ifndef HAS_SPAWN
 #error HAS_SPAWN not defined
 #endif
@@ -106,71 +158,65 @@
 #error HAS_TIME_PROFILING not defined
 #endif
 
-/* If HAS_TIME_PROFILING, then you must define these. */
-void *getTextStart ();
-void *getTextEnd ();
-
-/* HAS_WEAK is true if the platform supports the weak attribute. */
-#ifndef HAS_WEAK
-#error HAS_WEAK not defined
+#ifndef EXECVP
+#define EXECVP execvp
 #endif
 
-#ifndef SPAWN_MODE
-#define SPAWN_MODE 0
+#ifndef EXECVE
+#define EXECVE execve
 #endif
 
-#ifndef INT_MIN
-#define INT_MIN ((int)0x80000000)
+#if not HAS_FEROUND
+#ifndef FE_TONEAREST
+#define FE_TONEAREST 0
 #endif
-#ifndef INT_MAX
-#define	INT_MAX ((int)0x7FFFFFFF)
+#ifndef FE_DOWNWARD
+#define FE_DOWNWARD 1
 #endif
+#ifndef FE_UPWARD
+#define FE_UPWARD 2
+#endif
+#ifndef FE_TOWARDZERO
+#define FE_TOWARDZERO 3
+#endif
+#endif
 
-#define	bool	int			/* boolean type */
-#define	uint	unsigned int		/* short names for unsigned types */
-#define	ulong	unsigned long
-#define	ullong	unsigned long long	/* GCC extension */
-#define	llong	long long		/* GCC extension */
-#define	uchar	unsigned char
-#define	ushort	unsigned short int
-#define	not	!			/* logical negation operator */
-#define	and	&&			/* logical conjunction */
-#define	or	||			/* logical disjunction */
-#ifndef TRUE
-#define	TRUE	(0 == 0)
+#if not HAS_FPCLASSIFY
+#ifndef FP_INFINITE
+#define FP_INFINITE 1
 #endif
-#ifndef FALSE
-#define	FALSE	(not TRUE)
+#ifndef FP_NAN
+#define FP_NAN 0
 #endif
-#define	loop	while (TRUE)		/* loop until break */
-#define	EOS	'\0'			/* end-of-string char */
-#ifndef	NULL
-#define	NULL	0			/* invalid pointer */
+#ifndef FP_NORMAL
+#define FP_NORMAL 4
 #endif
+#ifndef FP_SUBNORMAL
+#define FP_SUBNORMAL 3
+#endif
+#ifndef FP_ZERO
+#define FP_ZERO 2
+#endif
+#endif
 
-#define NEW(t, x)		x = (t)(smalloc (sizeof(*x)))
-#define ARRAY(t, a, s)	a = (t)(scalloc (s, sizeof(*a)))
-#define ARRAY_UNSAFE(t, a, s)	a = (t)(calloc (s, sizeof(*a)))
+/* If HAS_TIME_PROFILING, then you must define these. */
+void *getTextStart ();
+void *getTextEnd ();
 
-#define string char*
-
-#define	unless(p)	if (not (p))
-#define	until(p)	while (not (p))
-#define	cardof(a)	(sizeof(a) / sizeof(*(a)))
-#define	endof(a)	((a) + cardof(a))
-#define	bitsof(a)	(sizeof(a) * 8)
-
-#ifndef max
-#define max(a, b) ((a)>(b)?(a):(b))
+#ifndef SPAWN_MODE
+#define SPAWN_MODE 0
 #endif
 
-#ifndef min
-#define min(a, b) ((a)<(b)?(a):(b))
+#ifndef INT_MIN
+#define INT_MIN ((int)0x80000000)
 #endif
+#ifndef INT_MAX
+#define INT_MAX ((int)0x7FFFFFFF)
+#endif
 
 enum {
-	DEBUG_MEM = FALSE,
-	DEBUG_SIGNALS = FALSE,
+        DEBUG_MEM = FALSE,
+        DEBUG_SIGNALS = FALSE,
 };
 
 #include "types.h"
@@ -184,12 +230,12 @@
 void decommit (void *base, size_t length);
 /* issue error message and exit */
 extern void die (char *fmt, ...)
-			__attribute__ ((format(printf, 1, 2)))
-			__attribute__ ((noreturn));
+                        __attribute__ ((format(printf, 1, 2)))
+                        __attribute__ ((noreturn));
 /* issue error message and exit.  Also print strerror(errno). */
 extern void diee (char *fmt, ...)
-			__attribute__ ((format(printf, 1, 2)))
-			__attribute__ ((noreturn));
+                        __attribute__ ((format(printf, 1, 2)))
+                        __attribute__ ((noreturn));
 /*
  * fixedGetrusage() works just like getrusage().  We have a wrapper because on 
  * some platforms (e.g. Linux) we need to work around kernel bugs in getrusage.
@@ -232,17 +278,17 @@
 string ullongToCommaString (ullong n);
 
 static inline bool isBigEndian(void) {
-	union {
-		Word16 x;
-	        Word8 y;
-	} z;
-	
-	/* gcc optimizes the following code to just return the result. */
-	z.x = 0xABCDU;
-	if (z.y == 0xAB) return TRUE; /* big endian */
-	if (z.y == 0xCD) return FALSE; /* little endian */
-	die ("Could not detect endian --- neither big nor little!\n");
-	return 0;
+        union {
+                Word16 x;
+                Word8 y;
+        } z;
+        
+        /* gcc optimizes the following code to just return the result. */
+        z.x = 0xABCDU;
+        if (z.y == 0xAB) return TRUE; /* big endian */
+        if (z.y == 0xCD) return FALSE; /* little endian */
+        die ("Could not detect endian --- neither big nor little!\n");
+        return 0;
 }
 
 #define MLton_Platform_Arch_bigendian isBigEndian()
@@ -316,19 +362,14 @@
 /* ------------------------------------------------- */
 
 #define FE_NOSUPPORT -1
-#ifndef FE_TONEAREST
-#define FE_TONEAREST FE_NOSUPPORT
-#endif
-#ifndef FE_DOWNWARD
-#define FE_DOWNWARD FE_NOSUPPORT
-#endif
-#ifndef FE_UPWARD
-#define FE_UPWARD FE_NOSUPPORT
-#endif
-#ifndef FE_TOWARDZERO
-#define FE_TOWARDZERO FE_NOSUPPORT
-#endif
-
+/* Can't handle undefined rounding modes with code like the following.
+ *  #ifndef FE_TONEAREST
+ *  #define FE_TONEAREST FE_NOSUPPORT
+ *  #endif
+ * On some platforms, FE_* are defined via an enum, not the preprocessor,
+ * and hence don't show up as #defined.  In that case, the above code 
+ * overwrites them.
+ */
 void IEEEReal_setRoundingMode (Int mode);
 Int IEEEReal_getRoundingMode ();
 
@@ -339,20 +380,20 @@
 /*
  * Third header word for bignums and strings.
  */
-#define	BIGMAGIC	GC_objectHeader (WORD32_VECTOR_TYPE_INDEX)
-#define	STRMAGIC	GC_objectHeader (STRING_TYPE_INDEX)
+#define BIGMAGIC        GC_objectHeader (WORD32_VECTOR_TYPE_INDEX)
+#define STRMAGIC        GC_objectHeader (STRING_TYPE_INDEX)
 
 /*
  * Layout of bignums.  Note, the value passed around is a pointer to
  * the isneg member.
  */
-typedef struct	bignum {
-	uint	counter,	/* used by GC. */
-		card,		/* one more than the number of limbs */
-		magic,		/* BIGMAGIC */
-		isneg;		/* iff bignum is negative */
-	ulong	limbs[0];	/* big digits, least significant first */
-}	bignum;
+typedef struct  bignum {
+        uint    counter,        /* used by GC. */
+                card,           /* one more than the number of limbs */
+                magic,          /* BIGMAGIC */
+                isneg;          /* iff bignum is negative */
+        ulong   limbs[0];       /* big digits, least significant first */
+}       bignum;
 
 /* All of these routines modify the frontier in gcState.  They assume that 
  * there are bytes bytes free, and allocate an array to store the result
@@ -389,8 +430,8 @@
 #define Itimer_virtual ITIMER_VIRTUAL
 
 void Itimer_set (Int which,
-			Int interval_tv_sec, Int interval_tv_usec,
-			Int value_tv_sec, Int value_tv_usec);
+                        Int interval_tv_sec, Int interval_tv_usec,
+                        Int value_tv_sec, Int value_tv_usec);
 
 /* ------------------------------------------------- */
 /*                       MLton                       */
@@ -423,7 +464,7 @@
 #define MLton_Platform_Arch_host "m68k"
 #elif (defined (__mips__))
 #define MLton_Platform_Arch_host "mips"
-#elif (defined (__ppc__))
+#elif (defined (__ppc__)) || (defined (__powerpc__))
 #define MLton_Platform_Arch_host "powerpc"
 #elif (defined (__s390__))
 #define MLton_Platform_Arch_host "s390"
@@ -453,8 +494,6 @@
 /*           MLton.Process            */
 /* ---------------------------------- */
 
-Pid MLton_Process_create (NullString cmds, NullString args, NullString envs,
-				Fd in, Fd out, Fd err);
 Pid MLton_Process_cwait (Pid p, Pointer s);
 Int MLton_Process_spawne (NullString p, Pointer a, Pointer e);
 Int MLton_Process_spawnp (NullString p, Pointer a);
@@ -800,7 +839,7 @@
 #define Posix_ProcEnv_VERSION _SC_VERSION
 
 enum {
-	Posix_ProcEnv_numgroups = 100,
+        Posix_ProcEnv_numgroups = 100,
 };
 
 Pid Posix_ProcEnv_getpid ();
@@ -1044,9 +1083,9 @@
 #define NetHostDB_inAddrLen sizeof(struct in_addr)
 #define NetHostDB_INADDR_ANY INADDR_ANY
 #define Socket_sockAddrLenMax max(sizeof(struct sockaddr), \
-			      max(sizeof(struct sockaddr_un), \
-			      max(sizeof(struct sockaddr_in), \
-				  sizeof(struct sockaddr_in6))))
+                              max(sizeof(struct sockaddr_un), \
+                              max(sizeof(struct sockaddr_in), \
+                                  sizeof(struct sockaddr_in6))))
 #define Socket_AF_UNIX PF_UNIX
 #define Socket_AF_INET PF_INET
 #define Socket_AF_INET6 PF_INET6

Modified: mlton/branches/on-20050420-cmm-branch/runtime/types.h
===================================================================
--- mlton/branches/on-20050420-cmm-branch/runtime/types.h	2006-02-16 18:25:08 UTC (rev 4360)
+++ mlton/branches/on-20050420-cmm-branch/runtime/types.h	2006-02-16 19:34:54 UTC (rev 4361)
@@ -1,8 +1,8 @@
-/* Copyright (C) 2004 Henry Cejtin, Matthew Fluet, Suresh
+/* Copyright (C) 2004-2005 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
  */
 
 /* Can't use _TYPES_H_ because MSVCRT uses it.  So, we use _MLTON_TYPES_H_. */
@@ -13,8 +13,16 @@
 /* We need these because in header files for exported SML functions, types.h is
  * included without platform.h.
  */
+#ifndef _ISOC99_SOURCE
 #define _ISOC99_SOURCE
+#endif
+#if (defined (__OpenBSD__))
+#include <inttypes.h>
+#elif (defined (__sun__))
+#include <sys/int_types.h>
+#else
 #include <stdint.h>
+#endif
 
 typedef int8_t Int8;
 typedef int16_t Int16;

Copied: mlton/branches/on-20050420-cmm-branch/util (from rev 4358, mlton/trunk/util)